[SCM] snd/master: Imported Upstream version 16.1
umlaeute at users.alioth.debian.org
umlaeute at users.alioth.debian.org
Mon Jan 25 11:18:38 UTC 2016
The following commit has been merged in the master branch:
commit 110d59c341b8c50c04f30d90e85e9b8f6f329a0e
Author: IOhannes m zmölnig <zmoelnig at umlautQ.umlaeute.mur.at>
Date: Mon Jan 25 11:25:59 2016 +0100
Imported Upstream version 16.1
diff --git a/CM_patterns.scm b/CM_patterns.scm
new file mode 100644
index 0000000..c148528
--- /dev/null
+++ b/CM_patterns.scm
@@ -0,0 +1,1367 @@
+;;; **********************************************************************
+;;; Copyright (c) 2008, 2009 Rick Taube.
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the Lisp Lesser Gnu Public License. The text of
+;;; this agreement is available at http://www.cliki.net/LLGPL
+;;; **********************************************************************
+
+;;; [2015-06-11, AV]: adapting to stand-alone loading in a running 's7' (i.e. snd), start
+;;; snd, then load this file
+
+(require r7rs.scm)
+
+;; some functions collect from various places (s7.scm, utilities.scm)
+
+(define-macro (with-optkeys spec . body)
+ ((lambda (user rawspec body)
+
+ (define (string->keyword str) (symbol->keyword (string->symbol str)))
+
+ (define (key-parse-clause info mode args argn user)
+ ;; return a cond clause that parses one keyword. info for each
+ ;; var is: (<got> <var> <val>)
+ (let* ((got (car info))
+ (var (cadr info))
+ (key (string->keyword (symbol->string var))))
+ `((eq? (car ,args) ,key )
+ (if ,got (error "duplicate keyword: ~S" , key))
+ (set! ,var (if (null? (cdr ,args))
+ (error "missing value for keyword: ~S"
+ , user)
+ (cadr ,args)))
+ (set! ,got #t) ; mark that we have a value for this param
+ (set! ,mode #t) ; mark that we are now parsing keywords
+ (set! ,argn (+ ,argn 1))
+ (set! ,args (cddr ,args)))))
+
+ (define (pos-parse-clause info mode args argn I)
+ ;; return a cond clause that parses one positional. info for
+ ;; each var is: (<got> <var> <val>)
+ (let ((got (car info))
+ (var (cadr info)))
+ `((= ,argn ,I)
+ (set! ,var (car ,args))
+ (set! ,got #t) ; mark that we have a value for this param
+ (set! ,argn (+ ,argn 1))
+ (set! ,args (cdr ,args)))))
+
+ (let* ((otherkeys? (member '&allow-other-keys rawspec))
+ ;; remove &allow-other-keys from spec
+ (spec (if otherkeys? (reverse (cdr (reverse rawspec))) rawspec))
+ (data (map (lambda (v)
+ ;; for each optkey variable v return a list
+ ;; (<got> <var> <val>) where the <got>
+ ;; variable indicates that <var> has been
+ ;; set, <var> is the optkey variable itself
+ ;; and <val> is its default value
+ (if (pair? v)
+ (cons (gensym (symbol->string (car v))) v)
+ (list (gensym (symbol->string v)) v #f)))
+ spec))
+ (args (gensym "args")) ; holds arg data as its parsed
+ (argn (gensym "argn"))
+ (SIZE (length data))
+ (mode (gensym "keyp")) ; true if parsing keywords
+ ;; keyc are cond clauses that parse valid keyword
+ (keyc (map (lambda (d) (key-parse-clause d mode args argn user))
+ data))
+ (posc (let lup ((tail data) (I 0))
+ (if (null? tail) (list)
+ (cons (pos-parse-clause (car tail) mode args argn I)
+ (lup (cdr tail) (+ I 1))))))
+ (bindings (map cdr data)) ; optkey variable bindings
+ )
+
+ (if otherkeys?
+ (set! bindings (cons '(&allow-other-keys (list)) bindings)))
+
+ `(let* ,bindings ; bind all the optkey variables with default values
+ ;; bind status and parsing vars
+ (let ,(append (map (lambda (i) (list (car i) #f)) data)
+ `((,args ,user)
+ (,argn 0)
+ (,mode #f)))
+ ;; iterate arglist and set opt/key values
+ (do ()
+ ((null? ,args) #f)
+ (cond
+ ;; add valid keyword clauses first
+ ,@ keyc
+ ;; a keyword in (car args) is now either added to
+ ;; &allow-other-keys or an error
+ , (if otherkeys?
+ `((keyword? (car ,args))
+ (if (not (pair? (cdr ,args)))
+ (error "missing value for keyword ~S" (car ,args)))
+ (set! &allow-other-keys (append &allow-other-keys
+ (list (car ,args)
+ (cadr ,args))))
+ (set! ,mode #t) ; parsing keys now...
+ (set! ,args (cddr ,args)) )
+ `((keyword? (car ,args)) ;(and ,mode (keyword? (car ,args)))
+ (error "invalid keyword: ~S" (car ,args)) )
+ )
+ ;; positional clauses illegal if keywords have happened
+ (,mode (error "positional after keywords: ~S" (car ,args)))
+ ;; too many value specified
+ ((not (< ,argn ,SIZE)) (error "too many args: ~S" , args))
+ ;; add the valid positional clauses
+ ,@ posc
+ ))
+ ,@ body))
+ ))
+ (car spec)
+ (cdr spec)
+ body
+ ))
+
+;;; based on define-record-type from snd/r7rs.scm. Works with srfi-17?
+
+(define-macro (define-record typename . fields)
+ `(define-record-type ,typename
+ (,(symbol (format #f "make-~A" typename)) , at fields)
+ ,(symbol (format #f "~A?" typename))
+ ,@(map (lambda (x) `(,x
+ ,(symbol (format #f "~A-~A" typename x))
+ ,(symbol (format #f "~A-~A-set!" typename x))))
+ fields)))
+
+
+;; grabbed from s7.scm:
+
+(define (string->keyword s)
+ (make-keyword s))
+
+(define (logtest a b)
+ (not (zero? (logand a b))))
+
+(define sort sort!)
+
+;; grabbed from utilities.scm:
+
+(define (list-index p l)
+ (do ((tail l (cdr tail))
+ (i 0 (+ i 1))
+ (f #f))
+ ((or f (null? tail ))
+ f)
+ (if ( p (car tail)) (set! f i))))
+
+;; (autoload 'with-optkeys "scm/utilities.scm") ; + quite some others
+;; (autoload 'string->keyword "scm/s7.scm")
+
+;; scm/toolboox.scm:
+
+(define (decimals value places)
+ (let ((n (expt 10.0 places)))
+ (if (list? value)
+ (map (lambda (v) (/ (round (* v n)) n)) value)
+ (/ (round (* value n)) n))))
+
+;;;
+;;; patterns using structs instead of classes.
+;;; requires with-optkeys, arithmetic-test, list-set, tb:rani tb:ranf
+;;;
+;;;
+;;; [AV, 2015-06-11]: various ffi_ random functions are substituded
+;;; with schemes standard random
+
+
+(define-constant +constant-data+ (ash 1 0)) ; avoid hair when possible
+(define-constant +default-period+ (ash 1 1)) ; no period specified
+(define-constant +constant-weights+ (ash 1 2)) ; avoid random index recalc
+(define-constant +count-periods+ (ash 1 3)) ; period counts subperiods
+(define-constant +count-values+ (ash 1 4)) ; period counts values
+(define-constant +depth-first+ (ash 1 5)) ; pattern moves on eop
+(define-constant +breadth-first+ (ash 1 6)) ; pattern moves each time
+
+(define-constant +nad+ '#:nad) ; "not a datum" marker
+(define-constant +eop+ '#:eop) ; "end of period" marker
+(define-constant +eod+ '#:eod) ; "end of data" marker
+
+;;; the period struct holds information for period calculation. count
+;;; is number of reads remaining in current period. when count=0 the
+;;; period is reinitialized. length is maximum count of the period,
+;;; either a number or #t if dynamic length. if stream is not #f a new
+;;; length will be read from it each time the period is initialized.
+;;; omit is the number of times this stream is skipped in its parent's
+;;; pattern, if dynamic. Reps keeps track of the number of
+;;; periods. Max is the max number of periods allowed, after which the
+;;; pattern always returns +eod+
+
+(define-record period count length stream default omit reps )
+
+(define (pperiod obj )
+ (list 'period
+ (period-count obj) (period-length obj) (period-stream obj)
+ (period-default obj) (period-omit obj) (period-reps obj)
+ ))
+
+(define-record pattern flags data length datum period value state
+ repeat returning counting traversing next mapr cache)
+
+(define (ppattern obj )
+ (list 'pattern
+ #:flags (pattern-flags obj)
+ #:data (pattern-data obj)
+ #:length (pattern-length obj)
+ #:datum (pattern-datum obj)
+ #:period (pperiod (pattern-period obj))
+ #:value (pattern-value obj)
+ #:state (pattern-state obj)
+ #:repeat (pattern-repeat obj)
+ #:returning (pattern-returning obj)
+ #:cache (pattern-cache obj)
+ ))
+
+(define (%alloc-pattern)
+ ;; flags data length datum period value state limit returning counting traversing next mapr cache
+ (make-pattern 0 (list) #f +nad+ #f +nad+ +nad+ most-positive-fixnum #f #:periods #:depth-first
+ #f #f #f))
+
+(define (initialize-pattern obj data for rep flags len dper getr mapr)
+ (pattern-data-set! obj data)
+ (pattern-length-set! obj len)
+ (pattern-mapr-set! obj mapr)
+ (pattern-next-set! obj getr)
+ ;; map data to see if it is constant data or has subpatterns
+ (let ((con? #t))
+ (map-pattern-data (lambda (x) (if (pattern? x) (set! con? #f)))
+ obj)
+ (if con? (set! flags (logior flags +constant-data+))))
+ ;; parse counting option
+ (let ((counting (pattern-counting obj)))
+ (case counting
+ ((#:periods )
+ (set! flags (logior flags +count-periods+)))
+ ((#:values )
+ (set! flags (logior flags +count-values+)))
+ (else
+ (error "illegal counting value ~S" counting))))
+ ;; parse traversing option
+ (let ((traversing (pattern-traversing obj)))
+ (case traversing
+ ((#:depth-first )
+ (set! flags (logior flags +depth-first+)))
+ ((#:breadth-first )
+ (set! flags (logior flags +breadth-first+)))
+ (else
+ (error "illegal traversing value ~S" traversing))))
+ ;; if constant data and counting subperiods, switch to counting
+ ;; values instead since its the same thing and we can avoid
+ ;; resetting subperiods if period length is nevertheless expressed
+ ;; dynamically.
+ (cond ((logtest flags +count-values+)
+ (set! flags (logand flags (lognot +count-periods+))))
+ (else
+ (if (logtest flags +constant-data+)
+ (set! flags (logior
+ (logand
+ flags (lognot +count-periods+))
+ +count-values+))
+ (set! flags (logior flags +count-periods+)))))
+ (pattern-repeat-set! obj (if (and (number? rep) (> rep 0))
+ rep most-positive-fixnum))
+ (let ((per (or for dper)))
+ ;; period not specified so mark that we are using default period
+ (when (not for)
+ (set! flags (logior flags +default-period+)))
+ (pattern-period-set! obj
+ (if (or (number? per)
+ (eqv? per #t))
+ ;; count len src dper omit reps
+ (make-period 0 per #f dper 0 0)
+ ;; count len src dper omit reps
+ (make-period 0 #f per dper 0 0))))
+ (pattern-flags-set! obj flags)
+ (values))
+
+;;;
+;;; Predicates for testing end-of-period and end-of-data.
+;;;
+
+(define (eop? x)
+ (if (pattern? x)
+ (eop? (pattern-state x))
+ (eqv? x +eop+)))
+
+(define (eod? x)
+ (if (pattern? x)
+ (eod? (pattern-value x))
+ (eqv? x +eod+)))
+
+;;;
+;;; next returns the next value read from the object. this around
+;;; method implements the basic behavior of patterns. it first checks
+;;; the stream's period length and calls reset-period if at end. if
+;;; the next period length is 0 it immediately returns +nad+, which
+;;; causes a superior stream (if any) to skip over the current stream
+;;; as it increments its pattern. otherwise, the method then
+;;; increments the streams pattern until it yields a datum that is not
+;;; +nad+ and that call-next-method does not return +nad+ from. if the
+;;; stream's data is known to contain only constant values, ie no
+;;; substreams, the testing loop is skipped. once call-next-method
+;;; returns a value (not +nad+), the period and pattern of the stream
+;;; are incremented according to their mode. for period incrementing,
+;;; +count-periods+ increments the period count only on +eop+, and
+;;; +count-values+ increments the period count every time. for pattern
+;;; incrementing, +depth-first+ increments the pattern only on +eop+,
+;;; and +breadth-first+ increments the pattern every time.
+;;;
+
+(define (next obj . args)
+ (let ((num (if (null? args) #f (car args))))
+ (if num
+ (if (number? num )
+ (let ((l (list #f)))
+ (do ((i 0 (+ 1 i))
+ (e l (cdr e)))
+ ((>= i num)
+ (cdr l))
+ (set-cdr! e (list (next-1 obj)))))
+ (if (pattern? obj)
+ (let ((l (list #f)))
+ (do ((n (next-1 obj) )
+ (e l (cdr e))
+ (f #f))
+ ((or (eqv? n +eod+) f)
+ (cdr l))
+ (set-cdr! e (list n))
+ (if (eop? obj)
+ (set! f #t)
+ (set! n (next-1 obj)))))
+ (list obj)))
+ (next-1 obj))))
+
+(define (next-1 obj)
+ (cond ((pattern? obj)
+ (let ((period (pattern-period obj))
+ (nomore #f))
+ ;; reset period, return
+ (when (= (period-count period) 0)
+ (when (>= (period-reps period)
+ (pattern-repeat obj))
+ (pattern-value-set! obj +eod+)
+ (pattern-state-set! obj +eop+)
+ (set! nomore +eod+))
+ (when (and (not nomore)
+ (= (reset-period obj) 0))
+ (set! nomore +nad+)
+ (pattern-value-set! obj +nad+)
+ (pattern-state-set! obj +eop+)))
+ (if nomore
+ nomore
+ (let ((flags (pattern-flags obj))
+ (retfn (pattern-returning obj))
+ (value #f)
+ (state #f))
+ ;; increment datum until not +nad+
+ (if (logtest flags +constant-data+)
+ (begin
+ (pattern-datum-set! obj (next-in-pattern obj))
+ (set! value (next-1 (pattern-datum obj)))
+ (set! state +eop+)
+ ;;(print (list #:consant!))
+ )
+ (do ((dyn? (and (logtest flags +count-periods+)
+ (eqv? (period-length period) #t)))
+ (stop #f))
+ (stop #f)
+ ;; increment over 0 length substreams
+ (do ()
+ ((not (eqv? (pattern-datum obj) +nad+)) #f)
+ (pattern-datum-set! obj
+ (if dyn?
+ (skip-datum? (next-in-pattern obj))
+ (next-in-pattern obj))))
+ (set! value (next-1 (pattern-datum obj)))
+ (if (pattern? (pattern-datum obj))
+ (set! state (pattern-state (pattern-datum obj)))
+ (set! state +eop+))
+ ;; increment over +nad+ values returned by obj.
+ (if (eqv? value +nad+)
+ (pattern-datum-set! obj value)
+ (set! stop #t ))) )
+ ;; increment period and pattern as appropriate.
+ (cond ((eqv? state +eop+)
+ ;;(print (list #:state-eop!))
+ (period-count-set! period (- (period-count period) 1))
+ (pattern-datum-set! obj +nad+)
+ (set! state #f))
+ (else
+ (if (logtest flags +breadth-first+)
+ (pattern-datum-set! obj +nad+))
+ (if (logtest flags +count-values+)
+ (period-count-set! period
+ (- (period-count period) 1)))))
+ ;;(print (list #:period-count (period-count period)))
+ (if (= (period-count period) 0)
+ (begin (set! state +eop+)
+ (period-reps-set! period
+ (+ 1 (period-reps period))))
+ (set! state state))
+
+ (if retfn
+ (set! value ( retfn value)));; thunk
+
+ (pattern-state-set! obj state)
+ (pattern-value-set! obj value)
+ value))))
+ ((procedure? obj)
+ (obj ) )
+
+ (else
+ obj)))
+
+(define (next-in-pattern obj)
+ ( (pattern-next obj) obj)
+ )
+
+(define (map-pattern-data fn obj)
+ ( (pattern-mapr obj) fn obj)
+ )
+
+;;;
+;;; skip-datum? returns +nad+ if the current stream should be skipped
+;;; in the pattern. this only happens if we have dynamic periodicity
+;;; and the datum had a 0 length period when it was encountered by
+;;; reset-period.
+;;;
+
+(define (skip-datum? obj)
+ (if (not (pattern? obj))
+ obj
+ (let ((period (pattern-period obj)))
+ (if (> (period-omit period) 0)
+ (begin (period-omit-set! period
+ (- (period-omit period) 1))
+ +nad+)
+ obj))))
+
+;;;
+;;; reset-period sets and returns the length of the next
+;;; period. period length of constant datum is always 1.
+;;;
+
+(define (reset-period obj)
+ (if (not (pattern? obj)) 1
+ (let ((period (pattern-period obj))
+ (dyn #f)
+ (len #f))
+
+ ;; if period is supplied as a stream get next length via item
+ (when (period-stream period)
+ (period-length-set! period
+ (next-1 (period-stream period))))
+ (set! dyn (eqv? (period-length period) #t))
+ (set! len
+ (if dyn
+ (period-default period)
+ (period-length period)))
+ ;; if we have dynamic period length we adjust next period
+ ;; length for the number of 0 subperiods that this period will
+ ;; encounter. in order for this to work, all substream
+ ;; periods must be reset now, at the same that the super
+ ;; stream is reset. we can only do this if we know that all
+ ;; subperiods are currently at end of period, ie if we are
+ ;; counting by subperiods. if so, then by definition all the
+ ;; substreams must be at end-of-period or we couldn't have
+ ;; gotton here in the first place. after resetting substream
+ ;; period lengths we decrement our current stream's period
+ ;; length by the number of zero periods found.
+ (when (and dyn
+ (logtest (pattern-flags obj) +count-periods+))
+ (let ((zeros 0))
+ (map-pattern-data
+ (lambda (x)
+ (when (= (reset-period x) 0)
+ (let ((p (pattern-period x)))
+ (period-omit-set! p
+ (+ (period-omit p)
+ 1)))
+ (set! zeros (+ zeros 1))
+ ))
+ obj)
+ (when (> zeros 0)
+ (set! len (max (- len zeros) 0)))))
+ (period-count-set! period len)
+
+ len)))
+
+;;;
+;;; pattern implementations.
+;;;
+;;; cycle continously loops over its data. the data are held in a list
+;;; of the form: (data . data). successive elements are popped from
+;;; the cdr and when the cdr is null it's reset to the car.
+;;;
+
+(define (make-cycle data . args)
+ (unless (pair? data) (set! data (list data)))
+ (with-optkeys (args for limit)
+ (let ((obj (%alloc-pattern))
+ (flags 0)
+ (len (length data)))
+ (initialize-pattern obj (cons data data) for limit
+ flags len len next-in-cycle
+ (lambda (fn obj)
+ (for-each fn (car (pattern-data obj)))))
+ obj)))
+
+(define (next-in-cycle obj)
+ (let ((data (pattern-data obj)))
+ (if (null? (cdr data))
+ (set-cdr! data (car data)))
+ (let ((x (cadr data)))
+ (set-cdr! data (cddr data))
+ x)))
+
+; (define aaa (make-cycle (list 1 2 3)))
+; (next aaa #t)
+; (define aaa (make-cycle (list 1 2 3) :for 2))
+; (next aaa #t)
+; (define aaa (make-cycle (list 1 2 3) :for (make-cycle (list 3 2 1))))
+; (next aaa #t)
+; (define aaa (make-cycle (list 1 2 3) :limit 2))
+; (next aaa #t)
+; (define aaa (make-cycle (list (make-cycle (list 'a 'b) ) (make-cycle (list 1 2) ))))
+; (next aaa #t)
+; (define aaa (make-cycle (list 1 (make-cycle (list 'a 'b)))))
+; (next aaa #t)
+; (define aaa (make-cycle (list 1 (make-cycle (list 'a 'b) :for (make-cycle (list 3 2 1 0))))))
+; (next aaa #t)
+
+;;;
+;;; palindrome
+;;;
+
+(define-record-type palin
+ (make-palin pos len inc mode elide)
+ palin?
+ (pos palin-pos palin-pos-set!)
+ (len palin-len palin-len-set!)
+ (inc palin-inc palin-inc-set!)
+ (mode palin-mode palin-mode-set!)
+ (elide palin-elide palin-elide-set!))
+
+
+(define (ppalin obj port)
+ (list 'palin
+ (palin-pos obj) (palin-len obj) (palin-inc obj)
+ (palin-mode obj) (palin-elide obj)))
+
+(define (make-palindrome data . args)
+ (unless (pair? data) (set! data (list data)))
+ (with-optkeys (args for limit elide)
+ (let ((obj (%alloc-pattern))
+ (flags 0)
+ (len (length data)))
+ (initialize-pattern obj data for limit
+ flags len (* len 2) next-in-palindrome
+ (lambda (fn obj)
+ (for-each fn (pattern-data obj))))
+ ;; pattern cache holds palin structure
+ (pattern-cache-set! obj (make-palin -2 (length data) #f #f
+ elide))
+ obj)))
+
+(define (next-in-palindrome obj)
+ (let* ((cache (pattern-cache obj))
+ (pos (palin-pos cache)))
+ (cond ((< pos 0 )
+ ;; starting new up-and-back cycle
+ (let ((m (next-1 (palin-elide cache)))
+ (l (palin-len cache))
+ (i (= pos -2)))
+ (palin-mode-set! cache m)
+ (palin-inc-set! cache 1)
+ ;; see if we skip repeat of first element
+ (if (or (eqv? m #t) (and (pair? m) (eqv? (car m) #t)))
+ ;; -2 marks very first call, dont skip inital element
+ (if i (set! pos 0) (set! pos 1))
+ (set! pos 0))
+ (if (logtest (pattern-flags obj) +default-period+)
+ (let* ((p (pattern-period obj))
+ (c (* l 2)))
+ (cond ((eqv? m #f)
+ (period-count-set! p c))
+ ((eqv? m #t)
+ (period-count-set! p (if i (- c 2) (- c 3))))
+ ((equal? m '(#f #t))
+ (period-count-set! p (- c 1)))
+ ((equal? m '(#t #f))
+ (period-count-set! p (if i (- c 1) (- c 2))))
+ (else (period-count-set! p c)))
+ ))
+ ))
+ ((= pos (palin-len cache))
+ ;; reversing direction
+ (palin-inc-set! cache -1)
+ (let ((m (palin-mode cache)))
+ ;; test if we skip repeat of last element
+ (if (or (eqv? m #t) (and (pair? m) (pair? (cdr m))
+ (eqv? (cadr m) #t)))
+ (set! pos (- pos 2))
+ (set! pos (- pos 1))))
+ ))
+ (palin-pos-set! cache (+ pos (palin-inc cache)))
+ (list-ref (pattern-data obj) pos)))
+
+; (define aaa (make-palindrome '(a b c d) ))
+; (next aaa #t)
+; (define aaa (make-palindrome '(a b c d) :elide #t))
+; (next aaa #t)
+; (define aaa (make-palindrome '(a b c d) :elide '(#f #t)))
+; (next aaa #t)
+; (define aaa (make-palindrome '(a b c d) :elide '(#t #f)))
+; (next aaa #t)
+; (define aaa (make-palindrome '(a b c d) :for 3))
+; (next aaa #t)
+
+;;;
+;;; line sticks on the last element.
+;;;
+
+(define (make-line data . args)
+ (unless (pair? data) (set! data (list data)))
+ (with-optkeys (args for limit)
+ (let ((obj (%alloc-pattern))
+ (flags 0)
+ (len (length data)))
+ (initialize-pattern obj data for limit flags
+ len len next-in-line
+ (lambda (fn obj)
+ (for-each fn (pattern-data obj))))
+ obj)))
+
+(define (next-in-line obj)
+ (let ((line (pattern-data obj)))
+ (if (null? (cdr line))
+ (begin
+ (period-count-set! (pattern-period obj) 1)
+ (car line)
+ )
+ (let ((x (car line)))
+ (pattern-data-set! obj (cdr line))
+ x))))
+
+;;; (define aaa (make-line '(a b c)))
+;;; (next aaa #t)
+;;; (define aaa (make-line (list 'a 'b (make-cycle '(1 2 3 4)))))
+;;; (next aaa #t)
+;;; (define aaa (make-line (list 'a 'b (make-cycle '(1 2 3 4) :for (lambda () (+ 1 (random 4)))))))
+;;; (next aaa #t)
+;;; aaa
+
+;;;
+;;; heap shuffles its elements each time through
+;;;
+
+(define (make-heap data . args)
+ ;; copy data because heap destructively modifies it
+ (if (pair? data)
+ (set! data (append data (list)))
+ (set! data (list data)))
+ (with-optkeys (args for limit)
+ (let ((obj (%alloc-pattern))
+ (flags 0)
+ (len (length data)))
+ (initialize-pattern obj (list data) for limit
+ flags len len next-in-heap
+ (lambda (fn obj)
+ (for-each fn (car (pattern-data obj)))))
+ obj)))
+
+(define (next-in-heap obj)
+ (let ((data (pattern-data obj)))
+ (when (null? (cdr data))
+ (let ((len (pattern-length obj))
+ (lis (car data)))
+ (do ((i 0 (+ i 1))
+ (j (random len) (random len))
+ ;; (j (ffi_ranint len ) (ffi_ranint len))
+ (v #f))
+ ((= i len)
+ (set-cdr! data lis))
+ (set! v (list-ref lis i))
+ (list-set! lis i (list-ref lis j))
+ (list-set! lis j v))))
+ (let ((x (cadr data)))
+ (set-cdr! data (cddr data))
+ x)))
+
+;; (define xxx '(1 2 3 4))
+;; (define aaa (make-heap xxx))
+;; (next aaa #t)
+;; xxx
+;; (define aaa (make-heap (list 1 2 3 (make-cycle '(a b c)) 4 5)))
+;; (next aaa #t)
+
+;;;
+;;; rotation
+;;;
+
+(define (make-rotation data . args)
+ ;; copy user's data (rotation side effects data)
+ (if (pair? data)
+ (set! data (append data (list)))
+ (set! data (list data)))
+ (with-optkeys (args for limit (rotate 0))
+ (let ((obj (%alloc-pattern))
+ (flags 0)
+ (len (length data)))
+ ;; cdr of data initialized now so that rotations only happen
+ ;; after the first cycle.
+ ;; (initialize-pattern obj data args flags len dper getr mapr allow)
+ (initialize-pattern obj (cons data data) for limit
+ flags len len next-in-rotation
+ (lambda (fn obj)
+ (for-each fn (car (pattern-data obj)))))
+ ;; pattern cache holds palin structure
+ (pattern-cache-set! obj rotate)
+ obj)))
+
+(define (next-in-rotation obj)
+ (define (rotate-items items start step width end)
+ (do ((i start (+ i step)))
+ ((not (< i end)) items)
+ (let ((a (list-ref items i))
+ (b (list-ref items (+ i width))))
+ (list-set! items i b)
+ (list-set! items (+ i width) a))))
+ (let ((data (pattern-data obj)))
+ (when (null? (cdr data))
+ (let ((l (car data))
+ (r (next-1 (pattern-cache obj))))
+ ;; start step width end
+ (set-cdr! data
+ (if (pair? r)
+ (if (pair? (cdr r))
+ (if (pair? (cddr r))
+ (if (pair? (cdddr r))
+ (apply rotate-items l r)
+ (rotate-items l (car r)
+ (cadr r) (caddr r)
+ ;; len - width
+ (- (pattern-length obj)
+ (caddr r))))
+ (rotate-items l (car r) (cadr r) 1
+ (- (pattern-length obj) 1)))
+ (rotate-items l (car r) 1 1
+ (- (pattern-length obj) 1)))
+ (rotate-items l r 1 1
+ (- (pattern-length obj) 1))))))
+ (let ((x (car (cdr data))))
+ (set-cdr! data (cddr data))
+ x)))
+
+; (define aaa (make-rotation '(a b c d)))
+; (next aaa #t)
+; (define aaa (make-rotation '(a b c d) :rotations '(1 2)))
+; (next aaa #t)
+
+;;;
+;;; weighting chooses items using weighted selection. its data are
+;;; kept in a list of the form#: ((&rest choices) . last-choice).
+;;;
+
+;; (define-record random-item datum index weight min max count id minmax)
+(define-record-type random-item
+ (make-random-item datum index weight min max count id minmax)
+ random-item?
+ (datum random-item-datum random-item-datum-set!)
+ (index random-item-index random-item-index-set!)
+ (weight random-item-weight random-item-weight-set!)
+ (min random-item-min random-item-min-set!)
+ (max random-item-max random-item-max-set!)
+ (count random-item-count random-item-count-set!)
+ (id random-item-id random-item-id-set!)
+ (minmax random-item-minmax random-item-minmax-set!))
+
+(define (prandom-item obj )
+ (list 'random-item
+ #:datum (random-item-datum obj)
+ #:index (random-item-index obj)
+ #:weight (random-item-weight obj)
+ #:min (random-item-min obj)
+ #:max (random-item-max obj)
+ #:count (random-item-count obj)
+ #:id (random-item-id obj)
+ #:minmax (random-item-minmax obj)))
+
+(define (make-weighting data . args)
+ (let* ((pool (canonicalize-weighting-data data))
+ (obj (%alloc-pattern))
+ (len (length pool))
+ (dper #f)
+ (const-weight #t)
+ (const-datums #t)
+ (num-patterns 0)
+ (flags 0))
+ (for-each (lambda (item)
+ (let ((min (random-item-min item))
+ (max (random-item-max item))
+ (wei (random-item-weight item))
+ (dat (random-item-datum item)))
+ (when (pattern? dat)
+ (set! const-datums #f)
+ (set! num-patterns (+ num-patterns 1)))
+ ;; check the stream for constant weights. if true,
+ ;; calculate the range now and set a flag so we dont
+ ;; recalulate each period.
+ (unless (number? wei)
+ (set! const-weight #f))))
+ pool)
+ ;; set the default period length of an all-subpattern weighting to
+ ;; 1 otherwise to the number of elements. since a weighting
+ ;; pattern establishes no particular order itself, setting the
+ ;; period to 1 allows the number of elements in the current period
+ ;; to reflect the sub patterns.
+ (set! dper (if (= num-patterns len) 1 len))
+ (if const-weight (set! flags (logior flags +constant-weights+)))
+ ;; pool is ((&rest choices) . last-choice) no initial last
+ ;; choice. a first choice for the stream could be implemented as a
+ ;; last with min=1
+ (with-optkeys (args for limit)
+ (initialize-pattern obj (list pool) for limit
+ flags len dper next-in-weighting
+ (lambda (fn obj)
+ (for-each (lambda (i)
+ ( fn (random-item-datum i)))
+ (car (pattern-data obj))))))
+ ;; if we have constant weights calculate the range now as fixnums
+ (if const-weight (recalc-weightings obj #t))
+ obj))
+
+(define (canonicalize-weighting-data data)
+ (define (%make-random-item w)
+ (let ((item #f)
+ (args (list)))
+ (cond ((pair? w)
+ (set! item (car w))
+ (set! args (cdr w)))
+ (else (set! item w)))
+ (with-optkeys (args (weight 1) (min 1) max)
+ (make-random-item item #f weight min max 0 #f #f))))
+ (map %make-random-item data))
+
+;;; (canonicalize-weighting-data '(a b c))
+;;; (canonicalize-weighting-data '(a (b 33) c))
+;;; (canonicalize-weighting-data '(a (b :max 33) c))
+
+(define (recalc-weightings obj fix?)
+ (let ((data (car (pattern-data obj)))
+ (range 0.0))
+ (do ((tail data (cdr tail)))
+ ((null? tail) #f)
+ (set! range (+ range (next-1 (random-item-weight (car tail)))))
+ (random-item-index-set! (car tail) range))
+ (if fix?
+ (do ((tail data (cdr tail))
+ (index 0)
+ (total 0))
+ ((null? tail)
+ (pattern-cache-set! obj total) )
+ (set! index (/ (random-item-index (car tail))
+ range))
+ (random-item-index-set! (car tail) index)
+ (set! total index))
+ (pattern-cache-set! obj range))))
+
+(define (next-in-weighting obj)
+ ;; pool is ((&rest choices) . last-item)
+ (let* ((pool (pattern-data obj))
+ (per (pattern-period obj))
+ (flags (pattern-flags obj))
+ (last (cdr pool)))
+ (unless (logtest flags +constant-weights+)
+ ;; at beginning of new period?
+ (when (= (period-count per) (period-length per))
+ (recalc-weightings obj #f)))
+ ;; if we have a last item with an unfulfilled :min value return it
+ (if (and (not (null? last))
+ (begin
+ (random-item-count-set! last
+ (+ 1 (random-item-count last)))
+ (< (random-item-count last)
+ (random-item-min last))))
+ (random-item-datum last)
+ (let ((range (pattern-cache obj))
+ (choices (car pool))
+ (pick (lambda (c r)
+ (do ((tail c (cdr tail))
+ (index (random r))
+ ;; (index (ffi_ranfloat r ))
+ )
+ ( (< index (random-item-index (car tail)))
+ (car tail)))))
+ (next #f))
+ (do ((item (pick choices range) (pick choices range)))
+ ((not (and (random-item-max item)
+ (= (random-item-count item)
+ (random-item-max item))))
+ (set! next item))
+ )
+ (unless (eqv? next last)
+ (do ((tail choices (cdr tail)))
+ ((null? tail) #f)
+ (random-item-count-set! (car tail) 0)))
+ (set-cdr! pool next)
+ ;; adjust the weight of the newly selected item
+ (random-item-datum next)))))
+
+;;; (define aaa (make-weighting '(a b c d e)))
+;;; (next aaa #t)
+;;; (define aaa (make-weighting '(a b (c :weight 10) d e)))
+;;; (next aaa #t)
+;;; (define aaa (make-weighting '(a b (c :min 4) d e)))
+;;; (next aaa #t)
+
+;;;
+;;; markov
+;;;
+
+(define (canonicalize-markov-data data)
+ (define (parse-markov-spec spec)
+ (if (not (pair? spec))
+ (error "transition ~S is not a list" spec))
+ (let ((rhside (or (member '-> spec)
+ (member '#:-> spec)
+ (error "no right hand side in transition ~S"
+ spec)))
+ (lhside (list))
+ (range 0)
+ (outputs (list)))
+ ;; separate lh and rh sides
+ (let* ((head (list #f))
+ (tail head))
+ (do ()
+ ((eqv? spec rhside)
+ (set! lhside (cdr head))
+ (set! rhside (cdr rhside)))
+ (set-cdr! tail (list (car spec)))
+ (set! tail (cdr tail))
+ (set! spec (cdr spec))))
+ (for-each (lambda (s)
+ (let ((val #f)
+ (pat #f)
+ (wei #f))
+ (if (pair? s)
+ (begin (set! val (car s))
+ (set! wei (if (null? (cdr s)) 1 (cadr s)))
+ ;; weight may be number or pattern
+ (set! pat wei)
+ (unless (number? wei)
+ (set! wei #f)))
+ (begin (set! val s) (set! wei 1) (set! pat 1)))
+ ;; set range to #f if any weight is pattern
+ ;; else precalc range for the constant weights
+ (if (and wei range)
+ (set! range (+ range wei))
+ (set! range #f))
+ ;;(push (list val range pat) outputs)
+ (set! outputs (cons (list val range pat) outputs))
+ ))
+ rhside)
+ (cons lhside (cons range (reverse outputs)))))
+ (let ((transitions (list #f)))
+ (do ((tail data (cdr tail))
+ (order #f)
+ (lis transitions)
+ (p #f))
+ ((null? tail)
+ (cdr transitions) )
+ (set! p (parse-markov-spec (car tail)))
+ (if (not order)
+ (set! order (length (car p)))
+ ;;(set! order (max order (length (first p))))
+ (if (not (= order (length (car p))))
+ (error "found left hand sides with different number of items in ~S"
+ data))
+ )
+ (set-cdr! lis (list p))
+ (set! lis (cdr lis)))))
+
+;;; (parse-markov-spec '(a a -> b c ))
+;;; (canonicalize-markov-data '((a a -> b c ) ( a b -> a) (c a -> c a)))
+
+(define (make-markov data . args)
+ (if (not (pair? data))
+ (error "~S is not list of markov transitions" data)
+ (set! data (canonicalize-markov-data data)))
+ (with-optkeys (args for limit past)
+ (let* ((obj (%alloc-pattern))
+ (len (length data))
+ (flags 0))
+ (initialize-pattern obj data for limit
+ flags len len next-in-markov
+ (lambda (fn obj)
+ (for-each fn (pattern-data obj))))
+ (unless (pair? past)
+ (set! past (make-list (length (car (car data))) '*)))
+ (pattern-cache-set! obj past)
+ obj)))
+
+(define (next-in-markov obj)
+ ;; markov data kept as a list of lists. each list is in the form#:
+ ;; ((<inputs>) range . <output>)
+ (letrec ((select-output
+ (lambda (range outputs)
+ ;; if range is #f then one or more weights in the
+ ;; outputs are patterns. in this case we map all the
+ ;; outputs to update weights of every outcome and then
+ ;; select. otherwise (range is number) we simply select
+ ;; an outcome from the precalculated distribution.
+ (if (not range)
+ (do ((tail outputs (cdr tail))
+ (out #f)
+ (sum 0))
+ ((null? tail)
+ (select-output sum outputs))
+ ;; out is outcome#: (val rng <pat/wei>)
+ (set! out (car tail))
+ ;; if third element is number use it else read it
+ (set! sum (+ sum (if (number? (caddr out))
+ (caddr out)
+ (next-1 (caddr out)))))
+ ;; always update second element to new value
+ (set-car! (cdr out) sum))
+ (let (
+ (n (random range))
+ ;; (n (ffi_ranfloat range))
+ )
+ (do ((tail outputs (cdr tail)))
+ ((< n (cadr (car tail)))
+ (car (car tail)))))
+ )))
+ (match-past
+ (lambda (inputs past)
+ (do ((i inputs (cdr i))
+ (j past (cdr j))
+ (f #t))
+ ((or (null? i) (null? j) (not f))
+ f)
+ (set! f (or (eqv? (car i) '*)
+ (equal? (car i) (car j))
+ (eqv? (car j) '*))))
+ )))
+ (do ((tail (pattern-data obj) (cdr tail))
+ (past (pattern-cache obj))
+ (item #f)
+ )
+ ((or (null? tail) (null? past)
+ (match-past (car (car tail)) past))
+ (when (null? tail)
+ (error "no transition matches past ~S" past))
+ (set! item (select-output (cadr (car tail))
+ (cddr (car tail))))
+ (unless (null? past)
+ (if (null? (cdr past))
+ (set-car! past item)
+ (do ((last past (cdr last)))
+ ((null? (cdr last))
+ ;; rotate past choices leftward
+ (set-car! past item)
+ (set-cdr! last past)
+ (pattern-cache-set! obj (cdr past))
+ (set-cdr! (cdr last) (list))))))
+ item))
+ ))
+
+;;; (define aaa (make-markov '((a -> b c d) (b -> a) (c -> d) (d -> (a 3) b c))))
+;;; (next aaa 30)
+
+(define (last-pair l)
+ (if (pair? (cdr l))
+ (last-pair (cdr l)) l))
+
+(define (markov-analyze seq . args)
+ (let* ((morder #f) ; markov order
+ (result #f) ; what to return
+ (len (length seq))
+ (labels '()) ; the set of all outcomes
+ (table '())
+ (row-label-width 8)
+ (print-decimals 3)
+ (field (+ print-decimals 2))) ; n.nnn
+ (with-optkeys (args (order 1) (mode 1))
+ (set! morder order)
+ (set! result mode))
+ (unless (member result '(1 2 3))
+ (error "~S is not a valid mode value" result))
+ (letrec ((add-outcome
+ (lambda (prev next)
+ (let ((entry (find-if (lambda (x)
+ (equal? prev (car x)))
+ table)))
+ (if (not entry)
+ (set! table (cons (list prev
+ (format #f "~s" prev)
+ (list next 1))
+ table))
+ (let ((e (assoc next (cddr entry))))
+ (if e
+ (set-car! (cdr e) (+ 1 (cadr e)))
+ (set-cdr! (last-pair (cdr entry))
+ (list (list next 1)))))))))
+ (before?
+ (lambda (x y l)
+ (if (null? x) #t
+ (let ((p1 (list-index (lambda (z) (equal? (car x) z))
+ l))
+ (p2 (list-index (lambda (z) (equal? (car y) z))
+ l)))
+ (cond ((< p1 p2) #t)
+ ; bug!
+ ;((= p1 p2) (before? (cdr x) (cdr y) l))
+ (else #f))))))
+ (liststring
+ (lambda (l)
+ (if (null? l) ""
+ (let ((a (format #f "~a" (car l))))
+ (do ((x (cdr l) (cdr x)))
+ ((null? x) a)
+ (set! a
+ (string-append
+ a (format #f " ~a" (car x))))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i len) #f)
+ (do ((prev (list))
+ (j 0 (+ j 1)) ; j to morder
+ (x #f))
+ ((> j morder)
+ (add-outcome (reverse prev) x )
+ (if (not (member x labels))
+ (set! labels (cons x labels))))
+ (set! x (list-ref seq (modulo (+ i j) len)))
+ ;; gather history in reverse order
+ (when (< j morder) (set! prev (cons x prev)))))
+ ;; sort the outcomes according to data
+ (cond ((number? (car labels))
+ (set! labels (sort labels <)))
+ ((and (car labels) (symbol? (car labels)))
+ (set! labels (sort labels
+ (lambda (x y)
+ (string-ci<? (format #f "~a" x)
+ (format #f "~a" y))))))
+ (else
+ (set! labels (reverse labels))))
+ ;; map over data, normalize weights
+ (do ((tail table (cdr tail))
+ (len 0))
+ ((null? tail)
+ (set! row-label-width (max len row-label-width)) )
+ (let* ((row (car tail))
+ (lab (cadr row)) ; label
+ (val (cddr row)))
+ (set! len (max len (string-length lab)))
+ (let ((total (do ((e val (cdr e)) ; sum all e
+ (s 0))
+ ((null? e) s)
+ (set! s (+ s (cadr (car e)))))))
+ (set! total (* total 1.0))
+ (do ((e val (cdr e)))
+ ((null? e) #f)
+ (set-car! (cdr (car e))
+ (decimals (/ (cadr (car e)) total)
+ print-decimals))))))
+ ;; sort table by labels
+ (set! table
+ (sort table (lambda (x y) (before? (car x) (car y) labels))))
+ ;; print table
+ (when (eqv? result 1)
+ (let* ((port (open-output-string))
+ (sp " ")
+ (ln (make-string field #\-)))
+ ;; print column header row
+ (newline port)
+ (do ((i 0 (+ i 1)))
+ ((= i row-label-width) #f)
+ (write-char #\* port))
+ (do ((l labels (cdr l)))
+ ((null? l) #f)
+ (display sp port) ;; column separator
+ (let* ((s (format #f "~a" (car l)))
+ (n (string-length s)))
+ ;; write column pad
+ (do ((i 0 (+ i 1))
+ (m (max (- field n) 0)))
+ ((= i m) #f)
+ (write-char #\space port))
+ (display s port)))
+ ;; print each row
+ (do ((tail table (cdr tail)))
+ ((null? tail) #f)
+ (let ((row (car tail)))
+ (newline port)
+ (let* ((s (liststring (car row)))
+ (n (string-length s)))
+ ;; print left pad for row label
+ (do ((i 0 (+ i 1))
+ (m (max (- row-label-width n) 0)))
+ ((= i m) #f)
+ (write-char #\space port))
+ ;; print row label min row-label-width.
+ (do ((i 0 (+ i 1))
+ (m (min row-label-width n)))
+ ((= i m) #f)
+ (write-char (string-ref s i) port)))
+ (do ((l labels (cdr l)))
+ ((null? l) #f)
+ (let ((v (assoc (car l) (cddr row))))
+ (if (not v)
+ (begin (display sp port) (display ln port))
+ (let* ((s (number->string (cadr v)))
+ (n (string-length s)))
+ (display sp port)
+ ;; s7: trim number to fit field
+ (if (>= n field)
+ (let ((d (char-position #\. s)))
+ (set! s (substring s 0 (min (+ d 4) n)))
+ (set! n (string-length s))))
+ ;; pad number
+ (do ((i 0 (+ i 1))
+ (m (max (- field n) 0)))
+ ((= i m) #f)
+ (write-char #\space port))
+ (display s port)
+ ))))))
+ (newline port)
+ (display (get-output-string port))
+ (close-output-port port)
+ )))
+
+ (if (= result 1)
+ (values)
+ ;; if returning pattern or data convert table to markov lists
+ (let ((pat (map (lambda (row)
+ (append (car row) '(->) (cddr row)))
+ table)))
+ (if (= result 2)
+ (make-markov pat)
+ pat)))))
+
+; (define aaa '(c4 c4 d4 c4 f4 e4 c4 c4 d4 c4 g4 f4 c4 c4 c5 a4 f4 e4 d4 bf4 bf4 a4 f4 g4 f4))
+; (define markovpat (markov-analyze aaa 1 2))
+; (next markovpat 30)
+
+;;;
+;;; Graph
+;;;
+
+;; (define-record graph-node datum to id)
+(define-record-type graph-node
+ (make-graph-node datum to id)
+ graph-node?
+ (datum graph-node-datum graph-node-datum-set!)
+ (to graph-node-to graph-node-to-set!)
+ (id graph-node-id graph-node-id-set!))
+
+
+(define (pgraph-node obj port)
+ (list 'graph-node
+ (graph-node-datum obj) (graph-node-to obj)
+ (graph-node-id obj)))
+
+(define (make-graph data . args)
+ (if (not (pair? data))
+ (error "~S is not a list of graph data" data)
+ (set! data (canonicalize-graph-data data)))
+ (with-optkeys (args for limit)
+ (let* ((obj (%alloc-pattern))
+ (len (length data))
+ (flags 0))
+ (initialize-pattern obj (cons #f data ) for limit
+ flags len len next-in-graph
+ (lambda (fn obj)
+ (for-each (lambda (n) ( fn (graph-node-datum n)))
+ (cdr (pattern-data obj)))))
+ obj)))
+
+(define (canonicalize-graph-data data)
+ (let ((pos 1))
+ (define (parse-graph-item extern)
+ (unless (pair? extern)
+ (error "~S is not a graph node list" extern))
+ (apply (lambda (item . args)
+ (with-optkeys (args to id)
+ (unless id (set! id pos))
+ (set! pos (+ pos 1))
+ (make-graph-node item to id)))
+ extern))
+ (map parse-graph-item data)))
+
+;; (canonicalize-graph-data '((a :to 2) (b :id 2 :to a)))
+;; (canonicalize-graph-data '((a :id 1 :to b) (b :id 2 :to a)))
+
+(define (next-in-graph obj)
+ (let* ((graph (pattern-data obj))
+ (nodes (cdr graph))
+ (this (car graph)))
+ (if (not this)
+ (begin
+ (set-car! graph (car nodes))
+ (graph-node-datum (car nodes)))
+ ;; read the to: link and search for next node
+ (let ((link (next-1 (graph-node-to this)))
+ (next #f))
+ (do ((tail nodes (cdr tail)))
+ ((or next (null? tail))
+ (if (not next)
+ (error "no graph node for id ~S" link)
+ (set-car! graph next))
+ (graph-node-datum next))
+ (if (eqv? link (graph-node-id (car tail)))
+ (set! next (car tail))))))))
+
+;;; (define aaa (make-graph '((a :to b) (b :to a))))
+;;; (next aaa)
+;;; (define aaa (make-graph `((a :to 2) (b :id 2 :to 3) (c :id 3 :to ,(make-weighting '(1 2 3))))))
+;;; (next aaa 20)
+
+
+;;;
+;;; Repeater
+;;;
+
+(define (make-repeater pat . args)
+ (with-optkeys (args for repeat limit)
+ (let ((obj (%alloc-pattern))
+ (flags 0)
+ )
+ (initialize-pattern obj (list) for stop
+ flags
+ 0
+ 1
+ next-in-repeater
+ (lambda (fn obj)
+ (for-each fn (pattern-data obj))))
+ ;; pattern cache holds palin structure
+ (pattern-cache-set! obj (list pat repeat))
+ obj)))
+
+(define (next-in-repeater obj)
+ (let ((data (pattern-data obj)))
+ (if (null? data)
+ (let* ((per (pattern-period obj))
+ (res (next (car (pattern-cache obj)) #t))
+ (len (length res))
+ (for (period-length per))
+ (rep (cadr (pattern-cache obj))))
+ (if rep
+ (begin
+ (set! for (next rep))
+ (period-length-set! per len)
+ (period-count-set! per len))
+ (period-count-set! per (* len for)))
+ (let ((sav res)
+ (don (- for 1)))
+ (do ((i 0 (+ i 1)))
+ ((not (< i don)) #f)
+ (set! res (append res sav))))
+ (pattern-data-set! obj (cdr res))
+ (car res))
+ (begin
+ (pattern-data-set! obj (cdr data))
+ (car data)))))
+
diff --git a/COPYING b/COPYING
index 4a99b5b..c6e8611 100644
--- a/COPYING
+++ b/COPYING
@@ -1,6 +1,5 @@
Snd is a sound editor written by Bill Schottstaedt (bil at ccrma.stanford.edu).
-Except where otherwise noted, it is Copyright 1996-2006 The Board of Trustees
-of Stanford University.
+Except where otherwise noted, it is Copyright 1996-2013 Bill Schottstaedt.
diff --git a/HISTORY.Snd b/HISTORY.Snd
index 7837a3f..54ea4b7 100644
--- a/HISTORY.Snd
+++ b/HISTORY.Snd
@@ -1,5 +1,100 @@
Snd change log
+ 30-Nov: Snd 16.1.
+ 19-Oct: Snd 16.0.
+ 11-Sep: Snd 15.9.
+ 1-Aug: Snd 15.8.
+ 15-Jun: Snd 15.7.
+ 11-May: Snd 15.6.
+ 3-Apr: Snd 15.5.
+ 20-Mar: changed the no-gui repl to use repl.scm in the s7 case.
+ 27-Feb: Snd 15.4.
+ 25-Jan: Snd 15.3.
+
+2015 ----------------------------------------------------------------
+
+ 18-Dec: Snd 15.2.
+ 5-Nov: moved all the motif stuff (xm.c, snd-motif.scm etc) to the *motif* environment,
+ OpenGL (gl.c, snd-gl.scm) to *gl*, and gtk (xg.c, snd-gtk.scm etc) to *gtk*.
+ 4-Nov: Snd 15.1.
+ 25-Sep: Snd 15.0.
+ 17-Sep: moved snd-x*.c to snd-motif.c
+ 18-Aug: Snd 14.9.
+ 9-July: Snd 14.8.
+ 31-May: Snd 14.7.
+ 23-Apr: Snd 14.6.
+ 18-Mar: Snd 14.5.
+ 12-Feb: Snd 14.4.
+ 4-Jan: Snd 14.3.
+
+2014 ----------------------------------------------------------------
+
+ 22-Nov: Snd 14.2.
+ 15-Oct: Snd 14.1.
+ 11-Oct: removed frame.scm and mixer.scm: frames and mixers are obsolete in the scheme version of Snd.
+ 11-Sep: Snd 14.0. Homogenous vectors, write readably, libc.scm, libgsl.scm.
+ 5-Sep: removed kmenu.scm and oscope.scm.
+ 9-Aug: write.scm, removed pretty-print.scm.
+ 3-Aug: Snd 13.9.
+ 17-Jul: many changes to the configure script, added tools/make-config-pc.rb.
+ 30-Jun: Snd 13.8.
+ 11-Jun: removed the view files dialog from the gtk version, including all the
+ related extension language functions, and view-files-select-hook.
+ 25-May: Snd 13.7.
+ 14-May: glistener.c/h (gtk listener).
+ 22-Apr: Snd 13.6.
+ 12-Mar: Snd 13.5.
+ 4-Feb: Snd 13.4.
+
+2013 ----------------------------------------------------------------
+
+ 25-Dec: Snd 13.3.
+ 30-Oct: Snd 13.2.
+ 20-Sep: Snd 13.1.
+ 8-Aug: Snd 13.0.
+ 3-July: removed ptree-channel and max-virtual-ptrees, optimization, run.c.
+ (clm 5.0, sndlib 22.0).
+ 26-Jun: Snd 12.12.
+ 4-Jun: removed the --with-static-* configuration switches.
+ 21-May: Snd 12.11.
+ 11-May: all scheme-side hook code changed. removed print-hook.
+ 1-May: removed mus-audio-describe, ESD audio support, audinfo.
+ 12-Apr: Snd 12.10.
+ 5-Mar: Snd 12.9.
+ Feb: s7: added random-state?, hash-table-iterator?, and morally-equal?
+ clm/cmn/snd/s7: removed snd1.html and snd-contents.html (these were
+ using Javascript for stuff that is now built into html), and
+ translated the rest of the html files to html5.
+ snd: removed the recorder, recorder-dialog, snd-g|xrec.c,
+ changed various menu names and added a view:with-grid menu
+ moved dialog buttons around at random,
+ removed save-macros and named keyboard macros,
+ added context-sensitive tooltips to the gtk version,
+ changed the gtk listener default font to Monospace 11,
+ the "minibuffer" is now a "statusbar". This means it is not
+ editable, so all the key sequences that used to prompt for
+ info are either undefined now, or use a dialog instead.
+ removed minibuffer-history-length, prompt-in-minibuffer, clear-minibuffer,
+ and report-in-minibuffer. Replaced the latter two with status-report.
+ removed sound-specific search-procedures (i.e. there is only one search procedure)
+ removed the bomb function
+ 2-Feb: Snd 12.8.
+ 27-Jan: removed snd10.scm.
+
+2012 ----------------------------------------------------------------
+
+ 30-Dec: Snd 12.7.
+ 8-Nov: Snd 12.6.
+ 29-Sep: Snd 12.5.
+ 19-Aug: Snd 12.4.
+ 18-Aug: removed snd9.scm.
+ 14-Jul: removed thread stuff.
+ 11-Jul: Snd 12.3.
+ 30-May: Snd 12.2.
+ 24-Apr: Snd 12.1.
+ 5-Apr: lint.scm.
+ 25-Mar: show-full-range, info-popup-hook.
+ 21-Mar: with-interrupts.
18-Mar: Snd 12.0.
18-Mar: removed time-graph-hook; replaced by combined-data-color.
10-Mar: space=play or pause, tracking-cursor stuff changed.
@@ -169,7 +264,7 @@ Snd change log
track-colors.scm, mix-menu.scm
moved mix-properties into C.
added edit-properties, mix-sync.
- spokenword.scm thanks to Ville Koskinen.\n\
+ spokenword.scm thanks to Ville Koskinen.
23-Mar: recorder dialog removed.
22-Mar: Snd 8.9.
14-Mar: cairo graphics backend (--with-cairo configure choice).
@@ -1068,7 +1163,7 @@ Snd change log
11-Nov: insert-silence.
10-Nov: snd 4.8.
8-Nov: filter text field also has history (M-p) now.
- 7-Nov: shell (readline) style M-p and M-n in minibuffer with variable minibuffer-history-length (8).
+ 7-Nov: shell style M-p and M-n in minibuffer with variable minibuffer-history-length (8).
6-Nov: various cosmetic changes for the new g++ (Redhat 7.0).
insert-sound arguments changed (to match mix-sound more closely).
TODO.Snd.
diff --git a/NEWS b/NEWS
index 6c347aa..e20683a 100644
--- a/NEWS
+++ b/NEWS
@@ -1,86 +1,11 @@
-Snd 12.0
+Snd 16.1:
- selection has a loop play triangle
- mix and cursor have play triangles
- if mouse click would trigger play, the cursor is a right or left arrow.
- removed draggable mark play triangle and mark-drag-triangle-hook.
- added variable play-arrow-size (default: 10)
+most of my time went into lint.scm, but the harder I work
+on it, the longer my TODO list.
- added Edit:Unselect menu option
- added with-menu-icons (gtk only).
- added optional "alpha" arg to make-color.
- moved delete-selection-and-smooth from selection.scm to C.
- added delete-samples-and-smooth.
- typing space in a graph plays from the cursor, space while playing = pause/continue
- startup window size is 700x300
- auto-resize defaults to false in Gtk, true in Motif.
- in gtk, the trailing cr argument to draw-axes in not optional.
- in Motif, libXpm is no longer optional.
- the Region browser print option has been removed.
- removed click-for-listener-help.
- removed Snd.gtkrc, Snd.ad, and the obsolete X resources stuff.
- removed time-graph-hook; replaced by combined-data-color.
+s7: :key and :optional removed.
- tracking-cursor-style defaults to cursor-line.
- cursor-follows-play moved to snd11.scm.
- with-tracking-cursor is now a global (not sound-local).
+checked: gtk 3.19.1|2|3, sbcl 1.3.0|1, GSL 2.0
- removed c-g! function; it can be replaced by stop-playing.
- removed c-g? in Scheme -- it is superfluous.
+Thanks!: Norman Gray
- added 'src' and 'auto' buttons to the Save-as dialogs for automatic srate conversion
- and a blog-style commentary. In the extension language, these are
- save-as-dialog-src and save-as-dialog-auto-comment.
-
- added sync-style variable: sync-none, sync-all, or sync-by-sound (now the default).
- this used to be handled in extensions.* under names like global-sync-choice.
- sync-none was the previous default. examp.scm sync-all function renamed sync-everything.
-
- moved with-reopen-menu to snd11.scm, and removed it from the preferences dialog.
- This menu is almost the same as the built-in File:Open recent menu.
-
- moved make-hidden-controls-dialog from snd-motif|gtk.scm to snd11.scm, and removed it
- from the preferences dialog. It is now built-in as Options:Controls
-
- moved show-selection from extensions.* to C, added unselect-all (in C)
- which replaces clear-selection (selection.scm).
-
- added show-full-duration, initial-beg, initial-dur, ask-about-unsaved-edits,
- with-toolbar, remember-sound-state, with-smpte-label. removed old
- show-smpte-label in *.scm.
-
- remember-sound-state in extensions has been moved to C (old scheme code is in snd11.scm).
- it now reads/writes a file named "remembered-<soundfile-name>.scm|fs|rb" where
- <soundfile-name> is the current sound's file name.
-
- with-toolbar defaults to true in gtk, false otherwise. It replaces toolbar.scm
- and panic.scm. Also with-tooltips to turn tooltips on or off.
-
- The built-in popup menus are now context sensitive, and the files popup.scm
- and gtk-popup.scm have been removed. In s7/Motif, the listener popup can
- show a stacktrace of code as it is running!
-
- In the beginning, before the libxm library, I thought it made sense to include
- functions like draw-line which would draw a line, no matter what graphics
- environment Snd was built with. Unfortunately, cairo needs an explicitly
- handled cairo_t structure. So, draw-line, draw-lines, draw-dot, draw-dots,
- draw-string, fill-rectangle, and fill-polygon now have a required trailing
- cairo_t argument (it's ignored in Motif). Also two new kludges to get and
- free this structure: make-cairo and free-cairo. There aren't that many
- uses of these functions (most the fancy graphic stuff uses direct cairo
- or Motif calls from libxm), so perhaps eventually, they'll be removed.
-
- To make it easier to zoom in on the FFT, the keypad arrow keys are bound
- to zoom and move the FFT bounds, analogous to the normal arrow keys which
- affect the time domain graph. (There isn't any place to put sliders for
- this, and the Options:Transform sliders aren't always handy).
-
- in s7, random-state->list and a C tie-in for the random number functions.
-
- Snd now needs Gtk 2.12 or later.
-
-checked: sbcl 1.0.46, gtk 3.0.1|2|3, mpc 0.9
-
-
-Thanks!: Louis Gorenfeld, Hartmut Noack, Philipp Uberbacher, Fernando Lopez-Lezcano,
- Mike Scholz, Rick Taube.
diff --git a/README.Snd b/README.Snd
index 41a28e8..382733f 100644
--- a/README.Snd
+++ b/README.Snd
@@ -4,13 +4,16 @@ Snd is a sound editor. It currently runs on nearly all
Unix-based systems, including Mac OSX and Cygwin.
To build Snd, get the sources from
- ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-12.tar.gz
+ ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz
- gzip -d snd-12.tar.gz
- tar xf snd-12.tar
- cd snd-12
+ gzip -d snd-16.tar.gz
+ tar xf snd-16.tar
+ cd snd-16
./configure
make
+
+and if you like, su root, then
+
make install
@@ -18,91 +21,68 @@ The configure script has a bunch of arguments:
Extension language:
- --with-s7 use S7 (the default, a version of Scheme).
+ --with-s7 use s7 (the default, a version of Scheme).
- --with-ruby use Ruby as the extension language
- --with-ruby-prefix set location of Ruby
+ --with-ruby use Ruby as the extension language. If you build Ruby from the sources,
+ remember to use the --enable-shared switch. Otherwise ruby.pc is messed up.
+ If ruby.pc (or equivalent) is missing, tools/make-config-pc.rb can make one:
+ make-config-pc.rb > ruby.pc
+ mv ruby.pc /usr/local/lib/pkgconfig/ruby.pc
+ You may also have to set PKG_CONFIG_PATH:
+ PKG_CONFIG_PATH=.:/opt/X11/lib/pkgconfig/ ./configure --with-gtk --with-ruby --with-portaudio
- --with-forth use Forth (Mike Scholz's FTH) as the extension language.
+ --with-forth use Forth (Mike Scholz's FTH) as the extension language.
-
- To build Snd without any extension language, use --without-extension-language
+ --without-extension-language build Snd without any extension language
Graphics:
- --with-motif use Motif (the default, if it exists)
- --with-static-motif same, but load Motif statically
- --with-motif-prefix set Motif location (will append lib and include)
- on my machine: --with-motif-prefix=/usr/X11R6
-
- --with-gtk use Gtk+
-
- --with-no-gui make Snd without any graphics support
-
- --with-gl include support for OpenGL (default: no, Motif only)
- --with-just-gl same but omit extension language bindings in gl.c (default: no)
- The gl module is only useful if you want to write
- code to add your own OpenGL graphics to Snd.
- --with-just-gl will give you the GL spectrograms
- without any extras.
-
- --with-gl2ps include gl2ps (postscript output from OpenGL graphics)
-
- --with-static-xm include the xm module (rather than loading it dynamically)
- this option affects xm.c for Motif, xg.c for Gtk.
- You'll need this (or need to "make xm" and load xm.so
- at runtime) if you want to use Dave Phillips'
- extensions described in the tutorial.
- --with-static-xg same as above, but refers to the gtk xg module.
- To build xg.so separately, use "make xg".
-
- Audio:
+ --with-motif use Motif. If it's in some odd location, you can provide that info:
+ ./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --with-motif
- --with-alsa use ALSA if possible (the default in Linux)
- --with-static-alsa use ALSA statically loaded
+ in FC, install the motif, motif-devel, and libXpm-devel packages.
+ in *BSD, pkg install open-motif, or perhaps use pkgin?
+ in Debian, apt-get install libmotif4, libmotif-dev, libxt-dev, libxpm-dev
- --with-oss use OSS (not tested in a long time)
+ --with-gtk use Gtk+
- --with-esd use the enlightened sound daemon, if possible
+ --with-gui make Snd with graphics support (actually intended for use as --without-gui)
+
+ --with-gl include support for OpenGL (default: no, Motif only)
+ --with-gl2ps include gl2ps (postscript output from OpenGL graphics)
- --with-jack use the Jack library (can be used in conjunction
- with --with-alsa)
-
- --with-pulseaudio use PulseAudio (untested)
- --without-audio
+ Audio:
- Numerics:
+ --with-alsa use ALSA if possible (the default in Linux)
- --with-doubles use doubles throughout (default=yes)
+ --with-oss use OSS (not tested in a long time)
+
+ --with-jack use the Jack library which needs libsamplerate
- --with-gmp use gmp, mpfr, and mpc to implement multiprecision arithmetic
+ --with-pulseaudio use PulseAudio (untested)
- --with-float-samples represent samples internally as floats (default=yes)
- --with-sample-width=N use N bits of samples (default: 24). N = 32 or so is
- not recommended because it does not leave you any
- "head room" during mixes. N < 16 isn't supported.
+ --without-audio do not include audio support. This also affects the
+ GUI (play buttons are omitted).
Other options:
- --with-ladspa include LADSPA plugin support (default: yes in Linux)
-
- --with-snd-as-widget make Snd a loadable widget, not a standalone program
+ --with-gmp use gmp, mpfr, and mpc to implement multiprecision arithmetic
- --with-temp-dir directory to use for temp files (default: ".")
- --with-save-dir directory to use for saved-state files (default: ".")
- --with-doc-dir directory to search for documentation
-
- --with-shared-sndlib try to use libsndlib.so (default: no). The path to
- sndlib-config can be specified via SNDLIB_CONFIG_path.
- Normally, sndlib is built into Snd at compile time.
+ --with-ladspa include LADSPA plugin support (default: yes in Linux)
+
+ --with-temp-dir directory to use for temp files (default: ".")
+ --with-save-dir directory to use for saved-state files (default: ".")
+ --with-doc-dir directory to search for documentation
If the configure/make process fails, please send me
(bil at ccrma.stanford.edu) the files mus-config.h, config.log, and makefile,
-created (or updated) by configure.
+created (or updated) by configure. In general, if some switch is ignored,
+check that you have installed the "devel" package. For example, --with-ruby
+won't work unless you have installed the ruby-devel package.
Snd comes with s7, but if you insist on building Snd without any extension
language, you'll find that it's severely limited in what it can do.
@@ -111,21 +91,17 @@ or an extension language, however, there's nothing it can do.
Here at CCRMA, we use this configure invocation:
- ./configure --with-jack --with-temp-dir=/zap --with-static-xm --with-gl --with-gl2ps
-
-but I'd recommend --with-just-gl elsewhere (the various GL implementations
-are different enough that gl.c can be a pain to build).
+ ./configure --with-jack --with-temp-dir=/zap
Version info:
- if Gtk, then Gtk+ 2.12 or later and Cairo 1.6.4 or later
+ if Gtk, then Gtk+ 2.13 or later and Cairo 1.6.4 or later
if Motif, then Motif 2.n but not Lesstif
in Linux, if ALSA, then ALSA 1.0 or later
if Ruby, Ruby 1.8.0 or later.
if Forth, any version
- if s7, any version
+ if s7, version 3.0 or later (it comes with Snd).
if GSL, version 1.0 or later
- if gamin, version 0.1.0 or later
----------------------------------------------------------------
@@ -151,9 +127,9 @@ Forth: "/home/bil/cl" add-load-path
----------------------------------------------------------------
The documentation is in snd.html, extsnd.html, grfsnd.html, sndscm.html,
-sndlib.html, sndclm.html, fm.html, s7.html, and libxm.html. There's also a fancier
-wrapper for the documentation: snd1.html. A brief change log is in HISTORY.Snd.
-Dave Phillips has written a tutorial: see the tutorial directory.
+sndlib.html, sndclm.html, fm.html, and s7.html.
+
+A brief change log is in HISTORY.Snd.
The mailing list for Snd is the same as that for Common Music:
@@ -172,11 +148,6 @@ After that, you go to your local cvs-snd directory and
cvs update
-Included with Snd are three command-line programs that might
-be of interest: sndplay, sndinfo, and audinfo:
-
- make sndplay
-
----------------------------------------------------------------
This software is available to anyone who is interested, free gratis
@@ -189,22 +160,24 @@ Authors:
Bill Schottstaedt
Michael Scholz
-Kjetil S. Matheussen
-
-Rick Taube and Andrew Burnson: C++ and Windows wizardry.
-Dave Phillips: the tutorial, new-effects.scm, and many other files.
-Fernando Lopez-Lezcano: the current ALSA support.
-Richard W.E. Furse: the original LADSPA support.
-Nick Bailey: the ESD support.
-Volker Kuhlmann and Seppo Ingalsuo: the Solaris port.
-Seppo Ingalsuo: the HPUX port.
-Juan Reyes: the DEC Alpha port.
-Guenter Geiger and Stefan Schwandter: the Linux Alpha port.
-Paul Davis: the original ALSA support.
-Steven Schultz and Mike Scholz: the *BSD ports.
-Ludger Brummer and Charles Nichols: the Mac-OSX port.
-Thomas Klausner: the NetBSD port.
-Steve Beet: minGW
+
+Rick Taube, Andrew Burnson, Donny Ward: C++ and Windows wizardry.
+Kjetil S. Matheussen: the Jack support and many other improvements.
+Dave Phillips: the tutorial, new-effects.scm, and many other files.
+Fernando Lopez-Lezcano: the current ALSA support.
+Rick Taube and Anders Vinjar: CM scheme files ported to Snd
+Tito Latini: many bugfixes.
+Richard W.E. Furse: the original LADSPA support.
+Nick Bailey: the ESD support.
+Volker Kuhlmann and Seppo Ingalsuo: the Solaris port.
+Seppo Ingalsuo: the HPUX port.
+Juan Reyes: the DEC Alpha port.
+Guenter Geiger and Stefan Schwandter: the Linux Alpha port.
+Paul Davis: the original ALSA support.
+Steven Schultz and Mike Scholz: the *BSD ports.
+Ludger Brummer and Charles Nichols: the Mac-OSX port.
+Thomas Klausner and Mike Scholz: the NetBSD port.
+Steve Beet: minGW
Plus many other contributions from
Fernando Lopez-Lezcano,
@@ -218,8 +191,7 @@ Plus many other contributions from
In terms of number of lines, the languages used in Snd/Sndlib are:
-C, Scheme, Ruby, Forth, m4, Emacs Lisp, javascript,
-Fortran, and postscript (altogether about 700,000 lines).
+C, Scheme, Ruby, Forth, Emacs Lisp, Fortran, and Lua (altogether about 750k lines).
----------------------------------------------------------------
@@ -246,7 +218,6 @@ that's all I need to fix the bug immediately. If Snd
appears to be hung, you can
gdb snd
-break exit
run
<now get it to hang, then type control-C to exit>
where
@@ -255,100 +226,16 @@ where
----------------------------------------------------------------
-URLS
-
-CCRMA:
- http://ccrma.stanford.edu/
- http://ccrma.stanford.edu/~jos/
- http://ccrma.stanford.edu/planetccrma/software/
- http://ccrma.stanford.edu/planetccrma/software/soundapps.html#snd
- http://ccrma-mail.stanford.edu/pipermail/cmdist/
- http://ccrma-mail.stanford.edu/mailman/listinfo/planetccrma
-
-Snd:
- ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-12.tar.gz
- http://ccrma.stanford.edu/software/snd/
- http://sourceforge.net/projects/snd/
- http://www.notam02.no/arkiv/doc/snd-rt/
- http://linux.oreillynet.com/pub/a/linux/2001/10/05/snd_partone.html
- http://linux.oreillynet.com/pub/a/linux/2001/10/18/snd_parttwo.html
- http://www.saunalahti.fi/~mjkoskin/
- http://www.notam02.no/9
- http://www.linuxjournal.com/article.php?sid=7274
- http://www.blastwave.org/packages/snd (Solaris package)
- http://www.notam02.no/arkiv/src/snd/ (snd-ls)
- http://www.notam02.no/~kjetism/sandysth/
-
-Scheme:
- http://www.cs.utexas.edu/~novak/schemevscl.html
- http://www.cs.indiana.edu/scheme-repository
- http://www.schemers.org/
- http://www.ccs.neu.edu/home/dorai/t-y-scheme/t-y-scheme.html
- http://www.cs.utexas.edu/users/wilson/schintro/schintro_toc.html
- http://www.swiss.ai.mit.edu/~jaffer/SLIB.html
- http://mitpress.mit.edu/sicp/full-text/book/book.html
-
-Forth:
- http://sourceforge.net/projects/fth
-
-Motif:
- http://www.motifzone.net
- there's also a soundforge project for Motif
-
-Gtk+:
- http://www.gtk.org
- ftp://ftp.gtk.org/pub/gtk/
-
-OpenGL:
- http://www.mesa3d.org/
- http://mesa3d.sourceforge.net/
- http://www.geuz.org/gl2ps/
-
-GSL:
- ftp://ftp.gnu.org/gnu/gsl
-
-Ruby:
- comp.lang.ruby
- http://www.ruby-lang.org
-
-fftw:
- http://www.fftw.org
-
-
-On LADSPA, Dave Phillips adds: "I have used the LADSPA plugins as standalone
-effects processing modules. The Help texts for the LADSPA effects are courtesy
-Steve Harris, with edits and emendations from yours truly. You will need the
-latest plugin sets from www.ladspa.org and plugin.org.uk to make full use of
-the LADSPA effects in Snd."
-
-
-
-----------------------------------------------------------------
-
TROUBLES:
---- audio (a can of worms) ----
-In Linux, Snd sometimes can't seem to play or record when other
-applications are happy -- if this happens, please evaluate the function
-mus-audio-describe, and send me whatever it prints out.
-
If nothing plays in Linux (try aplay for example), and the sound preferences
have no effect, look for the pulseaudio daemon, and kill it.
-If you're running esd, you need to build Snd with the configuration
-switch --with-esd. Otherwise, it's likely you'll get an error
-from the 'play' button complaining about data formats, probably
-that it can't handle big-endian shorts.
-
-
-The Record dialog only works in Linux (OSS, perhaps ALSA), Sun (not x86),
-some SGI systems, and perhaps Mac OSX. In Linux, someone below the level
-of my code randomly switches input between the microphone and the line-in
-jack -- I don't know why or how to stop it! If this is happening to you,
-the recorder will appear to stop working, then if you leave it and
-return, it will be happy again -- extremely annoying!
+In OpenBSD, use pulseaudio:
+ ./configure --with-gmp --with-gtk --with-pulseaudio CFLAGS=-ftrampolines LDFLAGS=-pthread
In X86 Solaris, you may need to install Jurgen Keil's audio drivers.
@@ -379,42 +266,6 @@ the audio card thinks it's the local network controller or something.
Only versions from 1.0 of ALSA are supported.
-On recording, here's a note from Fernando from cmdist:
-
- > Recently I installed a sound card with digital in (with cmi8738 chip)
- > in my linux system with alsa. With 'arecord -D hw:0.2' I can succesfully record
- > from my digital input. How can I do the same with with Snd? The
- > digital inputs do not appear on the record window. I compiled Snd with alsa support.
-
- You could try to set up an environment variable before starting snd to
- point to that particular device. This is the way snd reacts to env
- variables:
-
- - searched for in the following order:
- MUS_ALSA_PLAYBACK_DEVICE
- defines the name of the playback device
- MUS_ALSA_CAPTURE_DEVICE
- defines the name of the capture device
- MUS_ALSA_DEVICE
- defines the name of the playback and capture device
- use the first two if the playback and capture devices are different or the
- third if they are the same.
-
- So you could try:
- MUS_ALSA_DEVICE="hw:0,2" snd
- if you are using bash as your shell
-
- This should use the digital i/o as the input output device. It would also
- be possible to concatenate several devices using a definition in the
- .asoundrc file but that would involve understanding its arcane
- configuration language, which I don't. The current snd alss 0.9 code only
- looks at the first device it finds (normally hw:0,0).
-
- -- Fernando
-
-There's also a discussion of RME cards in the cmdist archives.
-
-
An addendum: in my system, I have a wretched sound card in my machine,
and an EMI 2|6 connected to a USB connector. So the EMI device is "hw:1"
in Alsa terms, and since I never want to use the internal sound card,
@@ -446,6 +297,10 @@ try setting:
(set! (mus-alsa-device) "plughw:0")
+or
+
+ (set! (mus-alsa-device) "plughw:1")
+
then try playing again. The "default" device is always completely
broken.
@@ -456,20 +311,13 @@ broken.
Only Motif 2.n is supported. Be sure to get the Motif development
package if you want to build Snd (you need the Motif headers).
-If you have installed Motif in some weird place, use the --with-motif-prefix
-configure argument.
-
-In Fedora 7 and later, openMotif will need /usr/include/X11/extensions/Print.h
-/usr/include/X11/bitmaps/gray, and /usr/X11R6/lib/libXp.so. I copy these
-from old machines, but there must be a better way...
-
On 64-bit machines, use motif 2.3.2 or later.
---- Gtk+: ----
-Only Gtk 2.10 or later is supported.
+Only Gtk 2.13 or later is supported.
If you get an error like:
@@ -486,10 +334,6 @@ In some cases, if you installed gtk from an RPM file, you
also need to install gtk-devel.
-Gtk is changing rapidly these days, moving toward Gtk 3. Snd is struggling
-to keep pace, but expect trouble!
-
-
---- Mac OSX: ----
@@ -502,11 +346,10 @@ ordinary shell, use the open-x11 command:
or (in later versions of OSX) just start snd, and X should start automatically.
To install X11, first, install the X11SDK and X11User packages.
-The first is in one of the Installer directories, the second (in 10.4)
+The first is in one of the Installer directories, the second (in OSX 10.4)
is on the first install disk under System/Installation/Packages/X11User.pkg
or some such name. These give you the X11 server and its header files.
-
There are several ways to go from here; the simplest is probably
to use Darwin Ports as outlined by Hans Fugal:
@@ -538,17 +381,7 @@ If the openmotif package forgot to include libXm.a (Motif), a version is
at ccrma-ftp. If the Mac loader complains that it it out of date,
run ranlib: ranlib libXm.a (you may need to admin privileges to do this).
-
-On my OSX 10.4 Mac, the configuration command I use is:
-
-./configure --with-motif-prefix=/usr/OpenMotif --with-static-xm
-
-So, I believe all the rest of these instructions are obsolete,
-but if the simple case above fails, they may help you get going.
-
-
See also the cmdist archives for tips from Juan Pampin and others.
-
Here's some info from Josh Mattoon:
"It turns out everything required for snd is now in fink!
@@ -560,7 +393,7 @@ Here's some info from Josh Mattoon:
simple solution was to pass in the CFLAGS and LDFLAGS as so:
CFLAGS=-I/sw/include LDFLAGS="-L/sw/lib -lmx -bind_at_load" ./configure \
- --with-gl --with-editres --with-static-xm
+ --with-gl --with-editres
This was after a bit of trial and error. The linker couldn't find
some symbols that turned out to be in libmx, so I added that, and the
@@ -571,7 +404,7 @@ Here's some info from Josh Mattoon:
(fftw is optional in Snd). Adam Tinsdale had better luck with this:
CFLAGS=-I/sw/include LDFLAGS="-L/sw/lib -lmx -bind_at_load" ./configure \
- --with-motif --without-fftw --with-static-xm
+ --with-motif --without-fftw
The dac-size variable seems to matter a lot in OSX. If you're
@@ -620,7 +453,7 @@ So, here's the detailed step-by-step method, thanks to Cris Ewing:
Next, download and untar the latest snd sources from ccrma
- $ ./configure CFLAGS="-I/sw/include" LDFLAGS="-L/sw/lib -lmx -bind_at_load" --disable-nls --with-motif --with-static-xm --with-motif-prefix=/sw
+ $ ./configure CFLAGS="-I/sw/include" LDFLAGS="-L/sw/lib -lmx -bind_at_load" --with-motif --with-motif-prefix=/sw
This config was run from a bash shell. If you are using tcsh (and you
might be if you upgraded to panther) then you will have to omit the part
@@ -642,26 +475,101 @@ So, here's the detailed step-by-step method, thanks to Cris Ewing:
In OSX 10.5, I had to add Xft, Xmu, and fontconfig to the MOTIF_LIBS line in makefile:
-MOTIF_LIBS = -L/usr/X11/lib -R/usr/X11/lib -lSM -lICE -lXft -lXmu -lfontconfig /usr/X11R6-old/lib/libXm.a -L/usr/X11R6-old/lib -lXt -lXp -lX11 -lSM -lICE -lXext -lXpm
+ MOTIF_LIBS = -L/usr/X11/lib -R/usr/X11/lib -lSM -lICE -lXft -lXmu -lfontconfig /usr/X11R6-old/lib/libXm.a -L/usr/X11R6-old/lib -lXt -lXp -lX11 -lSM -lICE -lXext -lXpm
(the X11R6-old business came about because I didn't remake libXm, but the OSX installation
process moved the previous X11R6 directory to X11R6 1, which is untypable).
--------- Ruby 1.9.2 --------
+In OSX 10.6.8, Ludger Brummer suggests:
+
+ ./configure CFLAGS="-arch i386 -I/sw/include" LDFLAGS="-L/sw/lib -lmx -bind_at_load" --with-motif
+
+
+Here's a note from Brooke Mitchell:
+
+How to install snd on Mac OSX Snow Leopard using homebrew:
+--have you installed Developer Tools???
+
+1) install openmotif osx package
+(http://www.ist.co.uk/downloads/motif_download.html)
+open terminal:
+ export DYLD_LIBRARY_PATH=/usr/OpenMotif/lib
+
+2) install homebrew:
+ /usr/bin/ruby -e "$(curl -fsSL https://raw.github.com/gist/323731)"
+
+3) install dependencies.
+ brew install libffi
+(repository link should be fixed, otherwise terminal:
+ brew edit libffi
+change line 4:" url'sourceware.org:/pub/libffi/libffi-3.0.9.tar.gz'"
+
+ brew install --HEAD guile
+
+then:
+ brew install fftw
+...wait
+
+4) compile the source
+
+ ./configure \
+ --with-motif-prefix=/usr/OpenMotif
+ (--with-ruby //if you want ruby)
+
+edit makefile. add to line 19: ORIGINAL_LDFLAGS = /usr/OpenMotif/lib
+
+make
+sudo make install
+
+
+--------
+For homebrew+gtk, here are the CFLAGS and LDFLAGS I used:
+
+GTK_CFLAGS = -pthread -I/usr/local/include/gtk-3.0 -I/usr/local/include/atk-1.0 -I/usr/local/include/cairo -I/usr/local/include/pango-1.0 -I/usr/local/include/glib-2.0 -I/usr/local/include/pixman-1 -I/usr/local/include/freetype2 -I/usr/local/include/libpng12 -I/usr/local/Cellar/glib/2.40.0_1/lib/glib-2.0/include -D_REENTRANT -I/usr/local/Cellar/gdk-pixbuf/2.30.7/include/gdk-pixbuf-2.0 -I/usr/local/Cellar/libpng/1.6.10/include/libpng16 -I/usr/local/Cellar/glib/2.40.0_1/include/glib-2.0 -I/usr/local/Cellar/glib/2.40.0_1/lib/glib-2.0/include -I/usr/local/opt/gettext/include
+LDFLAGS = -L/usr/local/lib /usr/local/lib/libcairo.a /usr/local/lib/libpng.a /usr/local/lib/libcairo-gobject.a -lgtk-3.0 -lglib-2.0 -lpango-1.0 /usr/local/lib/libpixman-1.a -lgmodule-2.0 -lgobject-2.0 -lfontconfig -lfreetype -lgdk_pixbuf-2.0 -lpangocairo-1.0 -lgdk-3.0 -lgio-2.0 -lharfbuzz -lpangoft2-1.0 /usr/local/lib/liblzma.a -L/usr/lib -lz -framework Foundation -framework CoreGraphics
+
+but don't waste your time; it looks like crap, and dies with "No GSetting schemas" or something.
+
+
+
+
+-------- FreeBSD 9.n --------
+
+If the Snd compilation fails with complaints about the complex trig functions (ccosh etc),
+here are some suggestions from Mike Scholz:
+
+
+FBSD has CFLAGS=-fno-strict-aliasing as a default for base and ports. With
+GCC you can use:
+
+ % ./configure CFLAGS=-fno-strict-aliasing
+
+Or at least set -fno-builtin:
+
+ % ./configure CFLAGS=-fno-builtin
+
+Or use clang without the aforementioned flags:
+
+ % ./configure CC=clang
+
+There is also a port in /usr/ports/audio/snd with version 13.0 from August
+2012.
+
-The CFLAGS setting is messed up (not to mention all the directory names).
-After running configure, add
+-------- Debian --------
--I/usr/local/include/ruby-1.9.1/x86_64-linux -I/usr/local/include/ruby-1.9.1/ruby -I/usr/local/include/ruby-1.9.1
- to XEN_CFLAGS in makefile, then define all the RB_* macros in mus-config.h:
+The last time I installed Debian (via netinstall) I installed the following
+Snd-related packages by hand:
+ libgmp-dev fftw-dev libgtk-3-dev libmpfr-dev libmpc-dev
+ libgsl0-dev libasound2-dev libgl1-mesa-dev
-#define HAVE_RB_GC_DISABLE 1
-#define HAVE_RB_ARY_DUP 1
-#define HAVE_REASONABLE_RB_GC_MARK 1
-#define RB_FIND_FILE_TAKES_VALUE 1
-#define HAVE_RB_ERRINFO 1
-#define HAVE_RB_GET_LOAD_PATH 1
-and also change HAVE_VSNPRINTF to 0 -- Ruby's version of vsnprintf segfaults
-when passed %lld and 64-bit ints.
\ No newline at end of file
+and for Fedora Core 22:
+ yum install gcc tcsh rxvt emacs fftw3 fftw3-devel gtk3 gtk3-devel
+ alsa-lib alsa-lib-devel gsl gsl-devel gmp gmp-devel
+ mpfr mpfr-devel libmpc libmpc-devel ruby ruby-devel motif
+ motif-devel libXpm-devel clang mesa-libGLU-devel
+ xorg-x11-fonts-misc valgrind
+ yum groupinstall "LXDE"
+ reboot to get LXDE listed in the login settings
diff --git a/_sndlib.h b/_sndlib.h
index e952cd3..3edb47c 100644
--- a/_sndlib.h
+++ b/_sndlib.h
@@ -1,121 +1,17 @@
-#ifndef SNDLIB_H
-#define SNDLIB_H
-
-#define SNDLIB_VERSION 21
-#define SNDLIB_REVISION 2
-#define SNDLIB_DATE "11-Dec-09"
+#ifndef _SNDLIB_H
+#define _SNDLIB_H
#include <mus-config.h>
-#if HAVE_UNISTD_H && (!(defined(_MSC_VER)))
+#ifndef _MSC_VER
#include <unistd.h>
#endif
#include <sys/types.h>
#include <stdio.h>
-#ifndef __cplusplus
-#if HAVE_STDBOOL_H
- #include <stdbool.h>
-#else
-#ifndef true
- #define bool int
- #define true 1
- #define false 0
-#endif
-#endif
-#endif
-
-
-#if HAVE_WINDOZE
- /* I got these from gmp.h */
- #if defined (__GNUC__)
- #define MUS_EXPORT __declspec(__dllexport__)
- #else
- #define MUS_EXPORT __declspec(dllexport)
- #endif
-#else
- #define MUS_EXPORT
-#endif
-
-
-#if (SIZEOF_INT64_T == SIZEOF_LONG)
- #define MUS_LD "%ld"
-#else
- #if (SIZEOF_INT64_T == SIZEOF_LONG_LONG)
- #define MUS_LD "%lld"
- #else
- #define MUS_LD "%d"
- #endif
-#endif
-
-#if (SIZEOF_SSIZE_T == SIZEOF_INT) && (!HAVE_OSX)
- #define SSIZE_TD "%d"
-#else
- #define SSIZE_TD "%ld"
-#endif
-
-
-/* these used to be in configure.ac, but the 2.62 change to AC_C_BIGENDIAN ruins that */
-#ifndef MUS_LITTLE_ENDIAN
- #if WORDS_BIGENDIAN
- #define MUS_LITTLE_ENDIAN 0
- #else
- #define MUS_LITTLE_ENDIAN 1
- #endif
-#endif
-
-#ifndef MUS_AUDIO_COMPATIBLE_FORMAT
- #if WORDS_BIGENDIAN
- #if MUS_MAC_OSX
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_BFLOAT
- #else
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_BSHORT
- #endif
- #else
- #if MUS_MAC_OSX
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_LFLOAT
- #else
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_LSHORT
- #endif
- #endif
-#endif
-
-#ifndef MUS_OUT_FORMAT
- #if WORDS_BIGENDIAN
- #if SNDLIB_USE_FLOATS
- #if WITH_DOUBLES
- #define MUS_OUT_FORMAT MUS_BDOUBLE
- #else
- #define MUS_OUT_FORMAT MUS_BFLOAT
- #endif
- #else
- #define MUS_OUT_FORMAT MUS_BINT
- #endif
- #else
- #if SNDLIB_USE_FLOATS
- #if WITH_DOUBLES
- #define MUS_OUT_FORMAT MUS_LDOUBLE
- #else
- #define MUS_OUT_FORMAT MUS_LFLOAT
- #endif
- #else
- #define MUS_OUT_FORMAT MUS_LINT
- #endif
- #endif
-#endif
-
-
-#ifndef c__FUNCTION__
-#if (HAVE___FUNC__) || (defined(__STDC__) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L))
- #define c__FUNCTION__ __func__
-#else
-#ifdef __GNUC__
- #define c__FUNCTION__ __FUNCTION__
-#else
- #define c__FUNCTION__ ""
-#endif
-#endif
+#if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L))))
+ #define __func__ __FUNCTION__
#endif
#if (!defined(M_PI))
@@ -123,152 +19,17 @@
#define M_PI_2 (M_PI / 2.0)
#endif
-#define POWER_OF_2_P(x) ((((x) - 1) & (x)) == 0)
-/* from sys/param.h */
+#define is_power_of_2(x) ((((x) - 1) & (x)) == 0)
#define MUS_MAX_MALLOC_DEFAULT (1 << 26)
#define MUS_MAX_TABLE_SIZE_DEFAULT (1024 * 1024 * 20) /* delay line allocation etc */
-
#ifndef SEEK_SET
#define SEEK_SET 0
#define SEEK_END 2
#endif
-#if (!SNDLIB_USE_FLOATS)
- #define mus_sample_t int
- #ifndef MUS_SAMPLE_BITS
- #define MUS_SAMPLE_BITS 24
- #endif
- #define MUS_SAMPLE_0 0
- #define MUS_BYTE_TO_SAMPLE(n) ((mus_sample_t)((n) << (MUS_SAMPLE_BITS - 8)))
- #define MUS_SAMPLE_TO_BYTE(n) ((n) >> (MUS_SAMPLE_BITS - 8))
- #define MUS_SHORT_TO_SAMPLE(n) ((mus_sample_t)((n) << (MUS_SAMPLE_BITS - 16)))
- #define MUS_SAMPLE_TO_SHORT(n) ((short)((n) >> (MUS_SAMPLE_BITS - 16)))
- #if (MUS_SAMPLE_BITS < 24)
- #define MUS_INT24_TO_SAMPLE(n) ((mus_sample_t)((n) >> (24 - MUS_SAMPLE_BITS)))
- #define MUS_SAMPLE_TO_INT24(n) ((int)((n) << (24 - MUS_SAMPLE_BITS)))
- #else
- #define MUS_INT24_TO_SAMPLE(n) ((mus_sample_t)((n) << (MUS_SAMPLE_BITS - 24)))
- #define MUS_SAMPLE_TO_INT24(n) ((int)((n) >> (MUS_SAMPLE_BITS - 24)))
- #endif
- #define MUS_INT_TO_SAMPLE(n) ((mus_sample_t)(n))
- #define MUS_SAMPLE_TO_INT(n) ((int)(n))
- /* these are for direct read/write (no cross-image assumption is made about 32 bit int scaling) */
- #define MUS_FLOAT_TO_FIX ((MUS_SAMPLE_BITS < 32) ? (1 << (MUS_SAMPLE_BITS - 1)) : 0x7fffffff)
- #define MUS_FIX_TO_FLOAT (1.0 / (float)(MUS_FLOAT_TO_FIX))
- #define MUS_FLOAT_TO_SAMPLE(n) ((mus_sample_t)((n) * MUS_FLOAT_TO_FIX))
- #define MUS_SAMPLE_TO_FLOAT(n) ((float)((n) * MUS_FIX_TO_FLOAT))
- #define MUS_DOUBLE_TO_SAMPLE(n) ((mus_sample_t)((n) * MUS_FLOAT_TO_FIX))
- #define MUS_SAMPLE_TO_DOUBLE(n) ((double)((n) * MUS_FIX_TO_FLOAT))
- #define MUS_SAMPLE_MAX ((mus_sample_t)((MUS_SAMPLE_BITS < 32) ? (MUS_FLOAT_TO_FIX - 1) : 0x7fffffff))
- #define MUS_SAMPLE_MIN ((mus_sample_t)((MUS_SAMPLE_BITS < 32) ? (-(MUS_FLOAT_TO_FIX)) : -0x7fffffff))
- #define mus_sample_abs(Sample) abs(Sample)
-#else
- #define mus_sample_t mus_float_t
- #ifndef MUS_SAMPLE_BITS
- #define MUS_SAMPLE_BITS 24
- #endif
- #define MUS_SAMPLE_0 0.0
- #define MUS_BYTE_TO_SAMPLE(n) ((mus_sample_t)((mus_float_t)(n) / (mus_float_t)(1 << 7)))
- #define MUS_SHORT_TO_SAMPLE(n) ((mus_sample_t)((mus_float_t)(n) / (mus_float_t)(1 << 15)))
- #define MUS_INT_TO_SAMPLE(n) ((mus_sample_t)((mus_float_t)(n) / (mus_float_t)(1 << (MUS_SAMPLE_BITS - 1))))
- #define MUS_INT24_TO_SAMPLE(n) ((mus_sample_t)((mus_float_t)(n) / (mus_float_t)(1 << 23)))
- #define MUS_FLOAT_TO_FIX 1.0
- #define MUS_FIX_TO_FLOAT 1.0
- #define MUS_FLOAT_TO_SAMPLE(n) ((mus_sample_t)(n))
- #define MUS_DOUBLE_TO_SAMPLE(n) ((mus_sample_t)(n))
- #define MUS_SAMPLE_TO_FLOAT(n) ((mus_float_t)(n))
- #define MUS_SAMPLE_TO_DOUBLE(n) ((double)(n))
- #define MUS_SAMPLE_TO_INT(n) ((int)((n) * (1 << (MUS_SAMPLE_BITS - 1))))
- #define MUS_SAMPLE_TO_INT24(n) ((int)((n) * (1 << 23)))
- #define MUS_SAMPLE_TO_SHORT(n) ((short)((n) * (1 << 15)))
- #define MUS_SAMPLE_TO_BYTE(n) ((char)((n) * (1 << 7)))
- #define MUS_SAMPLE_MAX 0.99999
- #define MUS_SAMPLE_MIN (-1.0)
- #define mus_sample_abs(Sample) fabs(Sample)
-#endif
-
-
-enum {MUS_UNSUPPORTED, MUS_NEXT, MUS_AIFC, MUS_RIFF, MUS_RF64, MUS_BICSF, MUS_NIST, MUS_INRS, MUS_ESPS, MUS_SVX, MUS_VOC,
- MUS_SNDT, MUS_RAW, MUS_SMP, MUS_AVR, MUS_IRCAM, MUS_SD1, MUS_SPPACK, MUS_MUS10, MUS_HCOM, MUS_PSION, MUS_MAUD,
- MUS_IEEE, MUS_MATLAB, MUS_ADC, MUS_MIDI, MUS_SOUNDFONT, MUS_GRAVIS, MUS_COMDISCO, MUS_GOLDWAVE, MUS_SRFS,
- MUS_MIDI_SAMPLE_DUMP, MUS_DIAMONDWARE, MUS_ADF, MUS_SBSTUDIOII, MUS_DELUSION,
- MUS_FARANDOLE, MUS_SAMPLE_DUMP, MUS_ULTRATRACKER, MUS_YAMAHA_SY85, MUS_YAMAHA_TX16W, MUS_DIGIPLAYER,
- MUS_COVOX, MUS_AVI, MUS_OMF, MUS_QUICKTIME, MUS_ASF, MUS_YAMAHA_SY99, MUS_KURZWEIL_2000,
- MUS_AIFF, MUS_PAF, MUS_CSL, MUS_FILE_SAMP, MUS_PVF, MUS_SOUNDFORGE, MUS_TWINVQ, MUS_AKAI4,
- MUS_IMPULSETRACKER, MUS_KORG, MUS_NVF, MUS_CAFF, MUS_MAUI, MUS_SDIF, MUS_OGG, MUS_FLAC, MUS_SPEEX, MUS_MPEG,
- MUS_SHORTEN, MUS_TTA, MUS_WAVPACK, MUS_SOX,
- MUS_NUM_HEADER_TYPES};
-
-
-enum {MUS_UNKNOWN, MUS_BSHORT, MUS_MULAW, MUS_BYTE, MUS_BFLOAT, MUS_BINT, MUS_ALAW, MUS_UBYTE, MUS_B24INT,
- MUS_BDOUBLE, MUS_LSHORT, MUS_LINT, MUS_LFLOAT, MUS_LDOUBLE, MUS_UBSHORT, MUS_ULSHORT, MUS_L24INT,
- MUS_BINTN, MUS_LINTN, MUS_BFLOAT_UNSCALED, MUS_LFLOAT_UNSCALED, MUS_BDOUBLE_UNSCALED, MUS_LDOUBLE_UNSCALED,
- MUS_NUM_DATA_FORMATS};
-
-/* MUS_LINTN and MUS_BINTN refer to 32 bit ints with 31 bits of "fraction" -- the data is "left justified"
- */
-
-/* "unscaled" means the float value is not between -1.0 to 1.0, but -32768.0 to 32768.0 -- although io.c
- * promptly scales the unscaled value back down to -1.0..1.0, it's "unscaled" in the sense that the
- * original user thought it would go directly (after float->int conversion) to a 16-bit DAC. Such were
- * the gyrations of the ancients.
- */
-
-
-#if MUS_MAC_OSX
- #if MUS_LITTLE_ENDIAN
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_LFLOAT
- #else
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_BFLOAT
- #endif
-#else
- #if MUS_LITTLE_ENDIAN
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_LSHORT
- #else
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_BSHORT
- #endif
-#endif
-
-#define MUS_NIST_SHORTPACK 2
-#define MUS_AIFF_IMA_ADPCM 99
-
-#define MUS_AUDIO_PACK_SYSTEM(n) ((n) << 16)
-#define MUS_AUDIO_SYSTEM(n) (((n) >> 16) & 0xffff)
-#define MUS_AUDIO_DEVICE(n) ((n) & 0xffff)
-
-
-#define MUS_AUDIO_DEFAULT 0
-#define MUS_ERROR -1
-
-enum {MUS_NO_ERROR, MUS_NO_FREQUENCY, MUS_NO_PHASE, MUS_NO_GEN, MUS_NO_LENGTH,
- MUS_NO_FREE, MUS_NO_DESCRIBE, MUS_NO_DATA, MUS_NO_SCALER,
- MUS_MEMORY_ALLOCATION_FAILED, MUS_UNSTABLE_TWO_POLE_ERROR,
- MUS_CANT_OPEN_FILE, MUS_NO_SAMPLE_INPUT, MUS_NO_SAMPLE_OUTPUT,
- MUS_NO_SUCH_CHANNEL, MUS_NO_FILE_NAME_PROVIDED, MUS_NO_LOCATION, MUS_NO_CHANNEL,
- MUS_NO_SUCH_FFT_WINDOW, MUS_UNSUPPORTED_DATA_FORMAT, MUS_HEADER_READ_FAILED,
- MUS_UNSUPPORTED_HEADER_TYPE,
- MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, MUS_NOT_A_SOUND_FILE, MUS_FILE_CLOSED, MUS_WRITE_ERROR,
- MUS_HEADER_WRITE_FAILED, MUS_CANT_OPEN_TEMP_FILE, MUS_INTERRUPTED, MUS_BAD_ENVELOPE,
-
- MUS_AUDIO_CHANNELS_NOT_AVAILABLE, MUS_AUDIO_SRATE_NOT_AVAILABLE, MUS_AUDIO_FORMAT_NOT_AVAILABLE,
- MUS_AUDIO_NO_INPUT_AVAILABLE, MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
- MUS_AUDIO_WRITE_ERROR, MUS_AUDIO_SIZE_NOT_AVAILABLE, MUS_AUDIO_DEVICE_NOT_AVAILABLE,
- MUS_AUDIO_CANT_CLOSE, MUS_AUDIO_CANT_OPEN, MUS_AUDIO_READ_ERROR,
- MUS_AUDIO_CANT_WRITE, MUS_AUDIO_CANT_READ, MUS_AUDIO_NO_READ_PERMISSION,
-
- MUS_CANT_CLOSE_FILE, MUS_ARG_OUT_OF_RANGE, MUS_WRONG_TYPE_ARG,
- MUS_NO_CHANNELS, MUS_NO_HOP, MUS_NO_WIDTH, MUS_NO_FILE_NAME, MUS_NO_RAMP, MUS_NO_RUN,
- MUS_NO_INCREMENT, MUS_NO_OFFSET,
- MUS_NO_XCOEFF, MUS_NO_YCOEFF, MUS_NO_XCOEFFS, MUS_NO_YCOEFFS, MUS_NO_RESET, MUS_BAD_SIZE, MUS_CANT_CONVERT,
- MUS_READ_ERROR, MUS_NO_SAFETY,
- MUS_INITIAL_ERROR_TAG};
-
-/* keep this list in sync with mus_error_names in sound.c and snd-test.scm|rb */
-
-
-#if HAVE_WINDOZE
+#ifdef _MSC_VER
#ifdef FOPEN
#undef FOPEN
#endif
@@ -301,337 +62,33 @@ enum {MUS_NO_ERROR, MUS_NO_FREQUENCY, MUS_NO_PHASE, MUS_NO_GEN, MUS_NO_LENGTH,
#define FCLOSE(Fd, Name) fclose(Fd)
#endif
-#ifndef S_setB
+#ifndef S_set
+ #if (!HAVE_EXTENSION_LANGUAGE)
+ #define S_set "set-"
+ #else
#if HAVE_RUBY
- #define S_setB "set_"
- #endif
+ #define S_set "set_"
+ #else
#if HAVE_SCHEME
- #define S_setB "set! "
- #endif
+ #define S_set "set! "
+ #else
#if HAVE_FORTH
- #define S_setB "set-"
+ #define S_set "set-"
+ #endif
+ #endif
#endif
- #if (!HAVE_EXTENSION_LANGUAGE)
- #define S_setB "set-"
#endif
#endif
#define MUS_LOOP_INFO_SIZE 8
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* -------- sound.c -------- */
-
-#ifdef __GNUC__
- MUS_EXPORT int mus_error(int error, const char *format, ...) __attribute__ ((format (printf, 2, 3)));
- MUS_EXPORT void mus_print(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
- MUS_EXPORT char *mus_format(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
- MUS_EXPORT void mus_snprintf(char *buffer, int buffer_len, const char *format, ...) __attribute__ ((format (printf, 3, 4)));
-#else
- MUS_EXPORT int mus_error(int error, const char *format, ...);
- MUS_EXPORT void mus_print(const char *format, ...);
- MUS_EXPORT char *mus_format(const char *format, ...);
- MUS_EXPORT void mus_snprintf(char *buffer, int buffer_len, const char *format, ...);
-#endif
-
-typedef void mus_error_handler_t(int type, char *msg);
-MUS_EXPORT mus_error_handler_t *mus_error_set_handler(mus_error_handler_t *new_error_handler);
-MUS_EXPORT int mus_make_error(const char *error_name);
-MUS_EXPORT const char *mus_error_type_to_string(int err);
-
-typedef void mus_print_handler_t(char *msg);
-MUS_EXPORT mus_print_handler_t *mus_print_set_handler(mus_print_handler_t *new_print_handler);
-
-typedef mus_sample_t mus_clip_handler_t(mus_sample_t val);
-MUS_EXPORT mus_clip_handler_t *mus_clip_set_handler(mus_clip_handler_t *new_clip_handler);
-
-MUS_EXPORT mus_long_t mus_sound_samples(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_frames(const char *arg);
-MUS_EXPORT int mus_sound_datum_size(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_data_location(const char *arg);
-MUS_EXPORT int mus_sound_chans(const char *arg);
-MUS_EXPORT int mus_sound_srate(const char *arg);
-MUS_EXPORT int mus_sound_header_type(const char *arg);
-MUS_EXPORT int mus_sound_data_format(const char *arg);
-MUS_EXPORT int mus_sound_original_format(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_comment_start(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_comment_end(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_length(const char *arg);
-MUS_EXPORT int mus_sound_fact_samples(const char *arg);
-MUS_EXPORT time_t mus_sound_write_date(const char *arg);
-MUS_EXPORT int mus_sound_type_specifier(const char *arg);
-MUS_EXPORT int mus_sound_block_align(const char *arg);
-MUS_EXPORT int mus_sound_bits_per_sample(const char *arg);
-
-MUS_EXPORT int mus_sound_set_chans(const char *arg, int val);
-MUS_EXPORT int mus_sound_set_srate(const char *arg, int val);
-MUS_EXPORT int mus_sound_set_header_type(const char *arg, int val);
-MUS_EXPORT int mus_sound_set_data_format(const char *arg, int val);
-MUS_EXPORT int mus_sound_set_data_location(const char *arg, mus_long_t val);
-MUS_EXPORT int mus_sound_set_samples(const char *arg, mus_long_t val);
-
-MUS_EXPORT const char *mus_header_type_name(int type);
-MUS_EXPORT const char *mus_data_format_name(int format);
-MUS_EXPORT const char *mus_header_type_to_string(int type);
-MUS_EXPORT const char *mus_data_format_to_string(int format);
-MUS_EXPORT const char *mus_data_format_short_name(int format);
-MUS_EXPORT char *mus_sound_comment(const char *name);
-MUS_EXPORT int mus_bytes_per_sample(int format);
-MUS_EXPORT float mus_sound_duration(const char *arg);
-MUS_EXPORT int mus_sound_initialize(void);
-MUS_EXPORT int mus_sample_bits(void);
-MUS_EXPORT int mus_sound_override_header(const char *arg, int srate, int chans, int format, int type, mus_long_t location, mus_long_t size);
-MUS_EXPORT int mus_sound_forget(const char *name);
-MUS_EXPORT int mus_sound_prune(void);
-MUS_EXPORT void mus_sound_report_cache(FILE *fp);
-MUS_EXPORT int *mus_sound_loop_info(const char *arg);
-MUS_EXPORT void mus_sound_set_loop_info(const char *arg, int *loop);
-MUS_EXPORT int mus_sound_mark_info(const char *arg, int **mark_ids, int **mark_positions);
-
-MUS_EXPORT int mus_sound_open_input(const char *arg);
-MUS_EXPORT int mus_sound_open_output(const char *arg, int srate, int chans, int data_format, int header_type, const char *comment);
-MUS_EXPORT int mus_sound_reopen_output(const char *arg, int chans, int format, int type, mus_long_t data_loc);
-MUS_EXPORT int mus_sound_close_input(int fd);
-MUS_EXPORT int mus_sound_close_output(int fd, mus_long_t bytes_of_data);
-#define mus_sound_seek_frame(Ifd, Frm) mus_file_seek_frame(Ifd, Frm)
-#define mus_sound_read(Fd, Beg, End, Chans, Bufs) mus_file_read(Fd, Beg, End, Chans, Bufs)
-#define mus_sound_write(Fd, Beg, End, Chans, Bufs) mus_file_write(Fd, Beg, End, Chans, Bufs)
-
-MUS_EXPORT mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_long_t *times);
-MUS_EXPORT int mus_sound_set_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_long_t *times);
-MUS_EXPORT bool mus_sound_maxamp_exists(const char *ifile);
-MUS_EXPORT mus_long_t mus_file_to_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_sample_t *array);
-MUS_EXPORT int mus_array_to_file(const char *filename, mus_sample_t *ddata, mus_long_t len, int srate, int channels);
-MUS_EXPORT const char *mus_array_to_file_with_error(const char *filename, mus_sample_t *ddata, mus_long_t len, int srate, int channels);
-MUS_EXPORT mus_long_t mus_file_to_float_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_float_t *array);
-MUS_EXPORT int mus_float_array_to_file(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels);
-
-
-
-/* -------- audio.c -------- */
-
#define MUS_ALSA_API 0
#define MUS_OSS_API 1
#define MUS_JACK_API 2
-MUS_EXPORT char *mus_audio_describe(void);
-MUS_EXPORT int mus_audio_open_output(int dev, int srate, int chans, int format, int size);
-MUS_EXPORT int mus_audio_open_input(int dev, int srate, int chans, int format, int size);
-MUS_EXPORT int mus_audio_write(int line, char *buf, int bytes);
-MUS_EXPORT int mus_audio_close(int line);
-MUS_EXPORT int mus_audio_read(int line, char *buf, int bytes);
-MUS_EXPORT int mus_audio_write_buffers(int line, int frames, int chans, mus_sample_t **bufs, int output_format, bool clipped);
-MUS_EXPORT int mus_audio_read_buffers(int line, int frames, int chans, mus_sample_t **bufs, int input_format);
-MUS_EXPORT int mus_audio_initialize(void);
-
-#if HAVE_OSS || HAVE_ALSA
- MUS_EXPORT int mus_audio_reinitialize(void); /* 29-Aug-01 for CLM/Snd bugfix? */
- MUS_EXPORT char *mus_alsa_playback_device(void);
- MUS_EXPORT char *mus_alsa_set_playback_device(const char *name);
- MUS_EXPORT char *mus_alsa_capture_device(void);
- MUS_EXPORT char *mus_alsa_set_capture_device(const char *name);
- MUS_EXPORT char *mus_alsa_device(void);
- MUS_EXPORT char *mus_alsa_set_device(const char *name);
- MUS_EXPORT int mus_alsa_buffer_size(void);
- MUS_EXPORT int mus_alsa_set_buffer_size(int size);
- MUS_EXPORT int mus_alsa_buffers(void);
- MUS_EXPORT int mus_alsa_set_buffers(int num);
- MUS_EXPORT bool mus_alsa_squelch_warning(void);
- MUS_EXPORT bool mus_alsa_set_squelch_warning(bool val);
- MUS_EXPORT int mus_audio_api(void);
- MUS_EXPORT void mus_oss_set_buffers(int num, int size);
-#endif
-
-MUS_EXPORT int mus_audio_systems(void);
-MUS_EXPORT char *mus_audio_moniker(void);
-MUS_EXPORT int mus_audio_compatible_format(int dev);
-
-int mus_audio_device_channels(int dev);
-int mus_audio_device_format(int dev);
-
-#if (!HAVE_STRERROR)
- MUS_EXPORT char *strerror(int errnum);
-#endif
-
-#if MUS_MAC_OSX
- MUS_EXPORT bool mus_audio_output_properties_mutable(bool mut);
-#endif
-
-
-
-/* -------- io.c -------- */
-
-MUS_EXPORT int mus_file_open_descriptors(int tfd, const char *arg, int df, int ds, mus_long_t dl, int dc, int dt);
-MUS_EXPORT int mus_file_open_read(const char *arg);
-MUS_EXPORT bool mus_file_probe(const char *arg);
-MUS_EXPORT int mus_file_open_write(const char *arg);
-MUS_EXPORT int mus_file_create(const char *arg);
-MUS_EXPORT int mus_file_reopen_write(const char *arg);
-MUS_EXPORT int mus_file_close(int fd);
-MUS_EXPORT mus_long_t mus_file_seek_frame(int tfd, mus_long_t frame);
-MUS_EXPORT mus_long_t mus_file_read(int fd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs);
-MUS_EXPORT mus_long_t mus_file_read_chans(int fd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs, mus_sample_t **cm);
-MUS_EXPORT int mus_file_write(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs);
-MUS_EXPORT mus_long_t mus_file_read_any(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs, mus_sample_t **cm);
-MUS_EXPORT mus_long_t mus_file_read_file(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs);
-MUS_EXPORT mus_long_t mus_file_read_buffer(int charbuf_data_format, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs, char *charbuf);
-MUS_EXPORT int mus_file_write_file(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs);
-MUS_EXPORT int mus_file_write_buffer(int charbuf_data_format, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs, char *charbuf, bool clipped);
-MUS_EXPORT char *mus_expand_filename(const char *name);
-MUS_EXPORT char *mus_getcwd(void);
-
-MUS_EXPORT bool mus_clipping(void);
-MUS_EXPORT bool mus_set_clipping(bool new_value);
-MUS_EXPORT bool mus_file_clipping(int tfd);
-MUS_EXPORT int mus_file_set_clipping(int tfd, bool clipped);
-
-MUS_EXPORT int mus_file_set_header_type(int tfd, int type);
-MUS_EXPORT int mus_file_header_type(int tfd);
-MUS_EXPORT char *mus_file_fd_name(int tfd);
-MUS_EXPORT int mus_file_set_chans(int tfd, int chans);
-
-MUS_EXPORT mus_float_t mus_file_prescaler(int tfd);
-MUS_EXPORT mus_float_t mus_file_set_prescaler(int tfd, mus_float_t val);
-MUS_EXPORT mus_float_t mus_prescaler(void);
-MUS_EXPORT mus_float_t mus_set_prescaler(mus_float_t new_value);
-
-MUS_EXPORT int mus_iclamp(int lo, int val, int hi);
-MUS_EXPORT mus_long_t mus_oclamp(mus_long_t lo, mus_long_t val, mus_long_t hi);
-MUS_EXPORT mus_float_t mus_fclamp(mus_float_t lo, mus_float_t val, mus_float_t hi);
-
-/* for CLM */
-/* these are needed to clear a saved lisp image to the just-initialized state */
-MUS_EXPORT void mus_reset_io_c(void);
-MUS_EXPORT void mus_reset_headers_c(void);
-MUS_EXPORT void mus_reset_audio_c(void);
-
-MUS_EXPORT int mus_samples_peak(unsigned char *data, int bytes, int chans, int format, mus_float_t *maxes);
-MUS_EXPORT int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, int format, mus_float_t *min_samp, mus_float_t *max_samp);
-
-MUS_EXPORT mus_long_t mus_max_malloc(void);
-MUS_EXPORT mus_long_t mus_set_max_malloc(mus_long_t new_max);
-MUS_EXPORT mus_long_t mus_max_table_size(void);
-MUS_EXPORT mus_long_t mus_set_max_table_size(mus_long_t new_max);
-
-MUS_EXPORT char *mus_strdup(const char *str);
-MUS_EXPORT int mus_strlen(const char *str);
-MUS_EXPORT bool mus_strcmp(const char *str1, const char *str2);
-MUS_EXPORT char *mus_strcat(char *errmsg, const char *str, int *err_size);
-
-
-/* -------- run.c -------- */
+#define G7XX 0
+#include "sndlib.h"
#include "xen.h"
#include "vct.h"
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_1_b(XEN code);
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_1_f(XEN code);
-MUS_EXPORT mus_float_t mus_run_evaluate_ptree_1f2f(struct ptree *pt, mus_float_t arg);
-MUS_EXPORT int mus_run_evaluate_ptree_1f2b(struct ptree *pt, mus_float_t arg);
-MUS_EXPORT void mus_run_free_ptree(struct ptree *pt);
-MUS_EXPORT void mus_init_run(void);
-MUS_EXPORT XEN mus_run_ptree_code(struct ptree *pt);
-MUS_EXPORT mus_float_t mus_run_evaluate_ptree_1f1v1b2f(struct ptree *pt, mus_float_t arg, vct *v, bool dir);
-MUS_EXPORT mus_float_t mus_run_evaluate_ptreec(struct ptree *pt, mus_float_t arg, XEN object, bool dir, int type);
-MUS_EXPORT int mus_run_xen_to_run_type(XEN val);
-
-#if HAVE_SCHEME
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_1_b_without_env(XEN code);
-MUS_EXPORT mus_float_t mus_run_evaluate_ptree_0f2f(struct ptree *pt);
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_0_f(XEN code);
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_3_f(XEN code);
-#endif
-
-
-/* -------- headers.c -------- */
-
-MUS_EXPORT bool mus_data_format_p(int n);
-MUS_EXPORT bool mus_header_type_p(int n);
-
-MUS_EXPORT mus_long_t mus_header_samples(void);
-MUS_EXPORT mus_long_t mus_header_data_location(void);
-MUS_EXPORT int mus_header_chans(void);
-MUS_EXPORT int mus_header_srate(void);
-MUS_EXPORT int mus_header_type(void);
-MUS_EXPORT int mus_header_format(void);
-MUS_EXPORT mus_long_t mus_header_comment_start(void);
-MUS_EXPORT mus_long_t mus_header_comment_end(void);
-MUS_EXPORT int mus_header_type_specifier(void);
-MUS_EXPORT int mus_header_bits_per_sample(void);
-MUS_EXPORT int mus_header_fact_samples(void);
-MUS_EXPORT int mus_header_block_align(void);
-MUS_EXPORT int mus_header_loop_mode(int which);
-MUS_EXPORT int mus_header_loop_start(int which);
-MUS_EXPORT int mus_header_loop_end(int which);
-MUS_EXPORT int mus_header_mark_position(int id);
-MUS_EXPORT int mus_header_mark_info(int **marker_ids, int **marker_positions);
-MUS_EXPORT int mus_header_base_note(void);
-MUS_EXPORT int mus_header_base_detune(void);
-MUS_EXPORT void mus_header_set_raw_defaults(int sr, int chn, int frm);
-MUS_EXPORT void mus_header_raw_defaults(int *sr, int *chn, int *frm);
-MUS_EXPORT mus_long_t mus_header_true_length(void);
-MUS_EXPORT int mus_header_original_format(void);
-MUS_EXPORT mus_long_t mus_samples_to_bytes(int format, mus_long_t size);
-MUS_EXPORT mus_long_t mus_bytes_to_samples(int format, mus_long_t size);
-MUS_EXPORT int mus_header_read(const char *name);
-MUS_EXPORT int mus_header_write(const char *name, int type, int srate, int chans, mus_long_t loc, mus_long_t size_in_samples, int format, const char *comment, int len);
-MUS_EXPORT int mus_write_header(const char *name, int type, int in_srate, int in_chans, mus_long_t size_in_samples, int format, const char *comment);
-MUS_EXPORT mus_long_t mus_header_aux_comment_start(int n);
-MUS_EXPORT mus_long_t mus_header_aux_comment_end(int n);
-MUS_EXPORT int mus_header_initialize(void);
-MUS_EXPORT bool mus_header_writable(int type, int format);
-MUS_EXPORT void mus_header_set_aiff_loop_info(int *data);
-MUS_EXPORT int mus_header_sf2_entries(void);
-MUS_EXPORT char *mus_header_sf2_name(int n);
-MUS_EXPORT int mus_header_sf2_start(int n);
-MUS_EXPORT int mus_header_sf2_end(int n);
-MUS_EXPORT int mus_header_sf2_loop_start(int n);
-MUS_EXPORT int mus_header_sf2_loop_end(int n);
-MUS_EXPORT const char *mus_header_original_format_name(int format, int type);
-MUS_EXPORT bool mus_header_no_header(const char *name);
-
-MUS_EXPORT char *mus_header_riff_aux_comment(const char *name, mus_long_t *starts, mus_long_t *ends);
-MUS_EXPORT char *mus_header_aiff_aux_comment(const char *name, mus_long_t *starts, mus_long_t *ends);
-
-MUS_EXPORT int mus_header_change_chans(const char *filename, int type, int new_chans);
-MUS_EXPORT int mus_header_change_srate(const char *filename, int type, int new_srate);
-MUS_EXPORT int mus_header_change_type(const char *filename, int new_type, int new_format);
-MUS_EXPORT int mus_header_change_format(const char *filename, int type, int new_format);
-MUS_EXPORT int mus_header_change_location(const char *filename, int type, mus_long_t new_location);
-MUS_EXPORT int mus_header_change_comment(const char *filename, int type, const char *new_comment);
-MUS_EXPORT int mus_header_change_data_size(const char *filename, int type, mus_long_t bytes);
-
-typedef void mus_header_write_hook_t(const char *filename);
-MUS_EXPORT mus_header_write_hook_t *mus_header_write_set_hook(mus_header_write_hook_t *new_hook);
-
-
-#if HAVE_PTHREADS
- MUS_EXPORT void mus_thread_restore_error_handler(void);
- MUS_EXPORT mus_error_handler_t *mus_thread_get_previous_error_handler(void);
-
- typedef pthread_mutex_t mus_lock_t;
- #define MUS_LOCK_INITIALIZER PTHREAD_MUTEX_INITIALIZER
- #define MUS_ALREADY_LOCKED EBUSY
- #define MUS_LOCK_DESTROY(Lock) pthread_mutex_destroy(Lock)
- #define MUS_LOCK_INIT(Lock) pthread_mutex_init(Lock, NULL)
- #define MUS_LOCK(Lock) pthread_mutex_lock(Lock)
- #define MUS_TRY_LOCK(Lock) pthread_mutex_trylock(Lock)
- #define MUS_UNLOCK(Lock) pthread_mutex_unlock(Lock)
-
-#else
- #define MUS_LOCK(Lock) do {} while(0)
- #define MUS_TRY_LOCK(Lock) 0
- #define MUS_UNLOCK(Lock) do {} while(0)
- typedef int mus_lock_t;
- #define MUS_LOCK_INITIALIZER 0
- #define MUS_ALREADY_LOCKED 1
-#endif
-
-
-#ifdef __cplusplus
-}
-#endif
-
#endif
diff --git a/aclocal.m4 b/aclocal.m4
deleted file mode 100644
index 7d1dfdb..0000000
--- a/aclocal.m4
+++ /dev/null
@@ -1,733 +0,0 @@
-AC_DEFUN([VL_PROG_CC_WARNINGS], [
- ansi=$1
- if test -z "$ansi"; then
- msg="for C compiler warning flags"
- else
- msg="for C compiler warning and ANSI conformance flags"
- fi
- AC_CACHE_CHECK($msg, vl_cv_prog_cc_warnings, [
- if test -n "$CC"; then
- cat > conftest.c <<EOF
-int main(int argc, char **argv) { return 0; }
-EOF
-
- dnl GCC
- if test "$GCC" = "yes"; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-g3 -Wall"
- else
- vl_cv_prog_cc_warnings="-g3 -Wall -ansi -pedantic"
- fi
-
- dnl Most compilers print some kind of a version string with some command
- dnl line options (often "-V"). The version string should be checked
- dnl before doing a test compilation run with compiler-specific flags.
- dnl This is because some compilers (like the Cray compiler) only
- dnl produce a warning message for unknown flags instead of returning
- dnl an error, resulting in a false positive. Also, compilers may do
- dnl erratic things when invoked with flags meant for a different
- dnl compiler.
-
- dnl Solaris C compiler
- elif $CC -V 2>&1 | grep -i "WorkShop" > /dev/null 2>&1 &&
- $CC -c -v -Xc conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-v"
- else
- vl_cv_prog_cc_warnings="-v -Xc"
- fi
-
- dnl Digital Unix C compiler
- elif $CC -V 2>&1 | grep -i "Digital UNIX Compiler" > /dev/null 2>&1 &&
- $CC -c -verbose -w0 -warnprotos -std1 conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-verbose -w0 -warnprotos"
- else
- vl_cv_prog_cc_warnings="-verbose -w0 -warnprotos -std1"
- fi
-
- dnl C for AIX Compiler
- elif $CC 2>&1 | grep -i "C for AIX Compiler" > /dev/null 2>&1 &&
- $CC -c -qlanglvl=ansi -qinfo=all conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-qsrcmsg -qinfo=all:noppt:noppc:noobs:nocnd"
- else
- vl_cv_prog_cc_warnings="-qsrcmsg -qinfo=all:noppt:noppc:noobs:nocnd -qlanglvl=ansi"
- fi
-
- dnl IRIX C compiler
- elif $CC -version 2>&1 | grep -i "MIPSpro Compilers" > /dev/null 2>&1 &&
- $CC -c -fullwarn -ansi -ansiE conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-fullwarn"
- else
- vl_cv_prog_cc_warnings="-fullwarn -ansi -ansiE"
- fi
-
- dnl HP-UX C compiler
- elif what $CC 2>&1 | grep -i "HP C Compiler" > /dev/null 2>&1 &&
- $CC -c -Aa +w1 conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="+w1"
- else
- vl_cv_prog_cc_warnings="+w1 -Aa"
- fi
-
- dnl The NEC SX-5 (Super-UX 10) C compiler
- elif $CC -V 2>&1 | grep "/SX" > /dev/null 2>&1 &&
- $CC -c -pvctl[,]fullmsg -Xc conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-pvctl[,]fullmsg"
- else
- vl_cv_prog_cc_warnings="-pvctl[,]fullmsg -Xc"
- fi
-
- dnl The Cray C compiler (Unicos)
- elif $CC -V 2>&1 | grep -i "Cray" > /dev/null 2>&1 &&
- $CC -c -h msglevel 2 conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-h msglevel 2"
- else
- vl_cv_prog_cc_warnings="-h msglevel 2 -h conform"
- fi
-
- fi
- rm -f conftest.*
- fi
- if test -n "$vl_cv_prog_cc_warnings"; then
- CFLAGS="$CFLAGS $vl_cv_prog_cc_warnings"
- else
- vl_cv_prog_cc_warnings="unknown"
- fi
- ])
-])dnl
-
-# Configure paths for ESD
-# Manish Singh 98-9-30
-# stolen back from Frank Belew
-# stolen from Manish Singh
-# Shamelessly stolen from Owen Taylor
-
-dnl AM_PATH_ESD([MINIMUM-VERSION, [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]]])
-dnl Test for ESD, and define ESD_CFLAGS and ESD_LIBS
-dnl
-AC_DEFUN(AM_PATH_ESD,
-[dnl
-dnl Get the cflags and libraries from the esd-config script
-dnl
-AC_ARG_WITH(esd-prefix,[ --with-esd-prefix=PFX Prefix where ESD is installed (optional)],
- esd_prefix="$withval", esd_prefix="")
-AC_ARG_WITH(esd-exec-prefix,[ --with-esd-exec-prefix=PFX Exec prefix where ESD is installed (optional)],
- esd_exec_prefix="$withval", esd_exec_prefix="")
-AC_ARG_ENABLE(esdtest, [ --disable-esdtest Do not try to compile and run a test ESD program],
- , enable_esdtest=yes)
-
- if test x$esd_exec_prefix != x ; then
- esd_args="$esd_args --exec-prefix=$esd_exec_prefix"
- if test x${ESD_CONFIG+set} != xset ; then
- ESD_CONFIG=$esd_exec_prefix/bin/esd-config
- fi
- fi
- if test x$esd_prefix != x ; then
- esd_args="$esd_args --prefix=$esd_prefix"
- if test x${ESD_CONFIG+set} != xset ; then
- ESD_CONFIG=$esd_prefix/bin/esd-config
- fi
- fi
-
- AC_PATH_PROG(ESD_CONFIG, esd-config, no)
- min_esd_version=ifelse([$1], ,0.2.7,$1)
- AC_MSG_CHECKING(for ESD - version >= $min_esd_version)
- no_esd=""
- if test "$ESD_CONFIG" = "no" ; then
- no_esd=yes
- else
- ESD_CFLAGS=`$ESD_CONFIG $esdconf_args --cflags`
- ESD_LIBS=`$ESD_CONFIG $esdconf_args --libs`
-
- esd_major_version=`$ESD_CONFIG $esd_args --version | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\1/'`
- esd_minor_version=`$ESD_CONFIG $esd_args --version | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\2/'`
- esd_micro_version=`$ESD_CONFIG $esd_config_args --version | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\3/'`
- if test "x$enable_esdtest" = "xyes" ; then
- ac_save_CFLAGS="$CFLAGS"
- ac_save_LIBS="$LIBS"
- CFLAGS="$CFLAGS $ESD_CFLAGS"
- LIBS="$LIBS $ESD_LIBS"
-dnl
-dnl Now check if the installed ESD is sufficiently new. (Also sanity
-dnl checks the results of esd-config to some extent
-dnl
- rm -f conf.esdtest
- AC_TRY_RUN([
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <esd.h>
-
-char*
-my_strdup (char *str)
-{
- char *new_str;
-
- if (str)
- {
- new_str = malloc ((strlen (str) + 1) * sizeof(char));
- strcpy (new_str, str);
- }
- else
- new_str = NULL;
-
- return new_str;
-}
-
-int main ()
-{
- int major, minor, micro;
- char *tmp_version;
-
- system ("touch conf.esdtest");
-
- /* HP/UX 9 (%@#!) writes to sscanf strings */
- tmp_version = my_strdup("$min_esd_version");
- if (sscanf(tmp_version, "%d.%d.%d", &major, &minor, µ) != 3) {
- printf("%s, bad version string\n", "$min_esd_version");
- exit(1);
- }
-
- if (($esd_major_version > major) ||
- (($esd_major_version == major) && ($esd_minor_version > minor)) ||
- (($esd_major_version == major) && ($esd_minor_version == minor) && ($esd_micro_version >= micro)))
- {
- return 0;
- }
- else
- {
- printf("\n*** 'esd-config --version' returned %d.%d.%d, but the minimum version\n", $esd_major_version, $esd_minor_version, $esd_micro_version);
- printf("*** of ESD required is %d.%d.%d. If esd-config is correct, then it is\n", major, minor, micro);
- printf("*** best to upgrade to the required version.\n");
- printf("*** If esd-config was wrong, set the environment variable ESD_CONFIG\n");
- printf("*** to point to the correct copy of esd-config, and remove the file\n");
- printf("*** config.cache before re-running configure\n");
- return 1;
- }
-}
-
-],, no_esd=yes,[echo $ac_n "cross compiling; assumed OK... $ac_c"])
- CFLAGS="$ac_save_CFLAGS"
- LIBS="$ac_save_LIBS"
- fi
- fi
- if test "x$no_esd" = x ; then
- AC_MSG_RESULT(yes)
- ifelse([$2], , :, [$2])
- else
- AC_MSG_RESULT(no)
- if test "$ESD_CONFIG" = "no" ; then
- echo "*** The esd-config script installed by ESD could not be found"
- echo "*** If ESD was installed in PREFIX, make sure PREFIX/bin is in"
- echo "*** your path, or set the ESD_CONFIG environment variable to the"
- echo "*** full path to esd-config."
- else
- if test -f conf.esdtest ; then
- :
- else
- echo "*** Could not run ESD test program, checking why..."
- CFLAGS="$CFLAGS $ESD_CFLAGS"
- LIBS="$LIBS $ESD_LIBS"
- AC_TRY_LINK([
-#include <stdio.h>
-#include <esd.h>
-], [ return 0; ],
- [ echo "*** The test program compiled, but did not run. This usually means"
- echo "*** that the run-time linker is not finding ESD or finding the wrong"
- echo "*** version of ESD. If it is not finding ESD, you'll need to set your"
- echo "*** LD_LIBRARY_PATH environment variable, or edit /etc/ld.so.conf to point"
- echo "*** to the installed location Also, make sure you have run ldconfig if that"
- echo "*** is required on your system"
- echo "***"
- echo "*** If you have an old version installed, it is best to remove it, although"
- echo "*** you may also be able to get things to work by modifying LD_LIBRARY_PATH"],
- [ echo "*** The test program failed to compile or link. See the file config.log for the"
- echo "*** exact error that occured. This usually means ESD was incorrectly installed"
- echo "*** or that you have moved ESD since it was installed. In the latter case, you"
- echo "*** may want to edit the esd-config script: $ESD_CONFIG" ])
- CFLAGS="$ac_save_CFLAGS"
- LIBS="$ac_save_LIBS"
- fi
- fi
- ESD_CFLAGS=""
- ESD_LIBS=""
- ifelse([$3], , :, [$3])
- fi
- AC_SUBST(ESD_CFLAGS)
- AC_SUBST(ESD_LIBS)
- rm -f conf.esdtest
-])
-
-
-
-AC_DEFUN([AC_CHECK_STRUCT_FOR],[
- ac_safe_struct=`echo "$2" | sed 'y%./+-%__p_%'`
- ac_safe_member=`echo "$3" | sed 'y%./+-%__p_%'`
- ac_safe_all="ac_cv_struct_${ac_safe_struct}_has_${ac_safe_member}"
- changequote(, )dnl
- ac_uc_define=STRUCT_`echo "${ac_safe_struct}_HAS_${ac_safe_member}" | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
- changequote([, ])dnl
-
- AC_MSG_CHECKING([for $2.$3])
- AC_CACHE_VAL($ac_safe_all,
- [
- if test "x$4" = "x"; then
- defineit="= 0"
- elif test "x$4" = "xno"; then
- defineit=""
- else
- defineit="$4"
- fi
- AC_TRY_COMPILE([
- $1
- ],[
- struct $2 testit;
- testit.$3 $defineit;
- ], eval "${ac_safe_all}=yes", eval "${ac_safe_all}=no" )
- ])
-
- if eval "test \"x$`echo ${ac_safe_all}`\" = \"xyes\""; then
- AC_MSG_RESULT(yes)
- AC_DEFINE_UNQUOTED($ac_uc_define)
- else
- AC_MSG_RESULT(no)
- fi
- ])
-
-
-# Configure paths for GTK+
-# Owen Taylor 1997-2001
-#
-# changed by bil to fit Snd configure better
-
-dnl AM_PATH_GTK_2_0([MINIMUM-VERSION, [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND [, MODULES]]]])
-dnl Test for GTK+, and define GTK_CFLAGS and GTK_LIBS, if gthread is specified in MODULES,
-dnl pass to pkg-config
-dnl
-AC_DEFUN(AM_PATH_GTK_2_0,
-[dnl
-dnl Get the cflags and libraries from pkg-config
-dnl
-
- pkg_config_args=gtk+-2.0
- for module in . $4
- do
- case "$module" in
- gthread)
- pkg_config_args="$pkg_config_args gthread-2.0"
- ;;
- esac
- done
-
- no_gtk=""
-
- AC_PATH_PROG(PKG_CONFIG, pkg-config, no)
-
- if test x$PKG_CONFIG != xno ; then
- if pkg-config --atleast-pkgconfig-version 0.7 ; then
- :
- else
- echo *** pkg-config too old; version 0.7 or better required.
- no_gtk=yes
- PKG_CONFIG=no
- fi
- else
- no_gtk=yes
- fi
-
- min_gtk_version=ifelse([$1], ,1.3.3,$1)
- AC_MSG_CHECKING(for GTK+ - version >= $min_gtk_version)
-
- if test x$PKG_CONFIG != xno ; then
- ## don't try to run the test against uninstalled libtool libs
- if $PKG_CONFIG --uninstalled $pkg_config_args; then
- echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH"
- fi
-
- if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then
- :
- else
- no_gtk=yes
- fi
- fi
-
- if test x"$no_gtk" = x ; then
- AC_MSG_RESULT(yes)
- GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags`
- GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs`
- gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\1/'`
- gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\2/'`
- gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\3/'`
- ifelse([$2], , :, [$2])
- AC_SUBST(GTK_CFLAGS)
- AC_SUBST(GTK_LIBS)
- else
- AC_MSG_RESULT(no)
- ifelse([$3], , :, [$3])
- fi
-])
-
-
-dnl AM_PATH_GTK_3_0([MINIMUM-VERSION, [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND [, MODULES]]]])
-dnl Test for GTK+, and define GTK_CFLAGS and GTK_LIBS, if gthread is specified in MODULES,
-dnl pass to pkg-config
-dnl
-AC_DEFUN(AM_PATH_GTK_3_0,
-[dnl
-dnl Get the cflags and libraries from pkg-config
-dnl
- pkg_config_args=gtk+-3.0
- for module in . $4
- do
- case "$module" in
- gthread)
- pkg_config_args="$pkg_config_args gthread-3.0"
- ;;
- esac
- done
-
- no_gtk=""
-
- AC_PATH_PROG(PKG_CONFIG, pkg-config, no)
-
- if test x$PKG_CONFIG != xno ; then
- if pkg-config --atleast-pkgconfig-version 0.7 ; then
- :
- else
- echo *** pkg-config too old; version 0.7 or better required.
- no_gtk=yes
- PKG_CONFIG=no
- fi
- else
- no_gtk=yes
- fi
-
- min_gtk_version=ifelse([$1], ,1.3.3,$1)
- AC_MSG_CHECKING(for GTK+ - version >= $min_gtk_version)
-
- if test x$PKG_CONFIG != xno ; then
- ## don't try to run the test against uninstalled libtool libs
- if $PKG_CONFIG --uninstalled $pkg_config_args; then
- echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH"
- fi
-
- if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then
- :
- else
- no_gtk=yes
- fi
- fi
-
- if test x"$no_gtk" = x ; then
- AC_MSG_RESULT(yes)
- GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags`
- GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs`
- gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\1/'`
- gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\2/'`
- gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
- sed 's/\([[0-9]]*\).\([[0-9]]*\).\([[0-9]]*\)/\3/'`
- ifelse([$2], , :, [$2])
- AC_SUBST(GTK_CFLAGS)
- AC_SUBST(GTK_LIBS)
- else
- AC_MSG_RESULT(no)
- ifelse([$3], , :, [$3])
- fi
-])
-
-
-## fth.m4 -- Autoconf macros for configuring FTH -*- Autoconf -*-
-
-## Copyright (C) 2006 Michael Scholz
-
-## Author: Michael Scholz <scholz-micha at gmx.de>
-## Created: Mon Mar 13 17:14:46 CET 2006
-## Changed: Thu Mar 23 13:46:43 CET 2006
-## Ident: $Id: fth.m4,v 1.1.1.1 2006/03/25 21:29:50 mi-scholz Exp $
-
-## This file is part of FTH.
-
-## 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 2 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, write to the Free Software
-## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-## Commentary:
-
-# FTH_CHECK_LIB(action-if-found, [action-if-not-found])
-#
-# Usage: FTH_CHECK_LIB([AC_DEFINE([HAVE_FORTH])])
-#
-# Don't quote this macro: [FTH_CHECK_LIB(...)] isn't correct.
-# Instead call it FTH_CHECK_LIB(...).
-#
-# Six variables will be substituted:
-#
-# FTH fth program path or no
-# FTH_VERSION version string or ""
-# FTH_CFLAGS -I${prefix}/include/fth or ""
-# FTH_LIBS -L${prefix}/lib -lfth or ""
-# FTH_HAVE_COMPLEX yes or no
-# FTH_HAVE_RATIO yes or no
-
-## Code:
-
-# AC_CHECK_LIB was written by David MacKenzie.
-# This version is slightly changed to fit to FTH_CHECK_LIB.
-
-AC_DEFUN([fth_AC_CHECK_LIB],
-[
- m4_ifval([$3], , [AH_CHECK_LIB([$1])])dnl
- AS_LITERAL_IF([$1],
- [AS_VAR_PUSHDEF([ac_Lib], [ac_cv_lib_$1_$2])],
- [AS_VAR_PUSHDEF([ac_Lib], [ac_cv_lib_$1''_$2])])dnl
- AC_CACHE_CHECK([m4_default([$4], [for $2 in -l$1])], ac_Lib,
- [fth_check_lib_save_LIBS=$LIBS
- LIBS="-l$1 $5 $LIBS"
- AC_LINK_IFELSE([AC_LANG_CALL([], [$2])],
- [AS_VAR_SET(ac_Lib, yes)],
- [AS_VAR_SET(ac_Lib, no)])
- LIBS=$fth_check_lib_save_LIBS])
- AS_IF([test AS_VAR_GET(ac_Lib) = yes],
- [m4_default([$3], [AC_DEFINE_UNQUOTED(AS_TR_CPP(HAVE_LIB$1)) LIBS="-l$1 $LIBS"])])dnl
- AS_VAR_POPDEF([ac_Lib])dnl
-])# fth_AC_CHECK_LIB
-
-AC_DEFUN([FTH_CHECK_LIB],
-[
- [AC_PATH_PROG([FTH], [fth], [no])]
- FTH_VERSION=""
- FTH_CFLAGS=""
- FTH_LIBS=""
- FTH_HAVE_COMPLEX=no
- FTH_HAVE_RATIO=no
- AC_MSG_CHECKING([for Forth])
- if test "${FTH}" != no ; then
- FTH_VERSION=`${FTH} --no-init-file --eval .version`
- FTH_CFLAGS=`${FTH} --no-init-file --eval .cflags`
- FTH_LIBS=`${FTH} --no-init-file --eval .libs`
- AC_MSG_RESULT([FTH version ${FTH_VERSION}])
- fth_AC_CHECK_LIB([fth], [fth_make_complex], [FTH_HAVE_COMPLEX=yes],
- [whether FTH supports complex numbers], [${FTH_LIBS}])
- fth_AC_CHECK_LIB([fth], [fth_ratio_floor], [FTH_HAVE_RATIO=yes],
- [whether FTH supports rational numbers], [${FTH_LIBS}])
- [$1]
- else
- AC_MSG_RESULT([no])
- [$2]
- fi
- AC_SUBST([FTH_VERSION])
- AC_SUBST([FTH_CFLAGS])
- AC_SUBST([FTH_LIBS])
- AC_SUBST([FTH_HAVE_COMPLEX])
- AC_SUBST([FTH_HAVE_RATIO])
-])# FTH_CHECK_LIB
-
-## fth.m4 ends here
-
-
-
-# autoconf 2.62 makes AC_C_BIGENDIAN completely useless, so
-# here is the 2.61 version (!$%%@#$%) -- 2.63 returned to this I think
-
-# AC_OLD_BIGENDIAN ([ACTION-IF-TRUE], [ACTION-IF-FALSE], [ACTION-IF-UNKNOWN])
-# -------------------------------------------------------------------------
-AC_DEFUN([AC_OLD_BIGENDIAN],
-[AC_CACHE_CHECK(whether byte ordering is bigendian, ac_cv_c_bigendian,
-[# See if sys/param.h defines the BYTE_ORDER macro.
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include <sys/types.h>
-#include <sys/param.h>
-],
-[#if ! (defined BYTE_ORDER && defined BIG_ENDIAN && defined LITTLE_ENDIAN \
- && BYTE_ORDER && BIG_ENDIAN && LITTLE_ENDIAN)
- bogus endian macros
-#endif
-])],
-[# It does; now see whether it defined to BIG_ENDIAN or not.
-AC_COMPILE_IFELSE([AC_LANG_PROGRAM([#include <sys/types.h>
-#include <sys/param.h>
-], [#if BYTE_ORDER != BIG_ENDIAN
- not big endian
-#endif
-])], [ac_cv_c_bigendian=yes], [ac_cv_c_bigendian=no])],
-[# It does not; compile a test program.
-AC_RUN_IFELSE(
-[AC_LANG_PROGRAM([AC_INCLUDES_DEFAULT], [[
- /* Are we little or big endian? From Harbison&Steele. */
- union
- {
- long int l;
- char c[sizeof (long int)];
- } u;
- u.l = 1;
- return u.c[sizeof (long int) - 1] == 1;
-]])],
- [ac_cv_c_bigendian=no],
- [ac_cv_c_bigendian=yes],
-[# try to guess the endianness by grepping values into an object file
- ac_cv_c_bigendian=unknown
- AC_COMPILE_IFELSE([AC_LANG_PROGRAM(
-[[short int ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
-short int ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
-void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; }
-short int ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
-short int ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
-void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; }]],
-[[ _ascii (); _ebcdic (); ]])],
-[if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then
- ac_cv_c_bigendian=yes
-fi
-if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
- if test "$ac_cv_c_bigendian" = unknown; then
- ac_cv_c_bigendian=no
- else
- # finding both strings is unlikely to happen, but who knows?
- ac_cv_c_bigendian=unknown
- fi
-fi])])])])
-case $ac_cv_c_bigendian in
- yes)
- m4_default([$1],
- [AC_DEFINE([WORDS_BIGENDIAN], 1,
- [Define to 1 if your processor stores words with the most significant
- byte first (like Motorola and SPARC, unlike Intel and VAX).])]) ;;
- no)
- $2 ;;
- *)
- m4_default([$3],
- [AC_MSG_ERROR([unknown endianness
-presetting ac_cv_c_bigendian=no (or yes) will help])]) ;;
-esac
-])# AC_OLD_BIGENDIAN
-
-
-dnl From libtool-1.4. Sets the variable with_gnu_ld to yes or no.
-AC_DEFUN([AC_LIB_PROG_LD_GNU],
-[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], acl_cv_prog_gnu_ld,
-[# I'd rather use --version here, but apparently some GNU ld's only accept -v.
-case `$LD -v 2>&1 </dev/null` in
-*GNU* | *'with BFD'*)
- acl_cv_prog_gnu_ld=yes ;;
-*)
- acl_cv_prog_gnu_ld=no ;;
-esac])
-with_gnu_ld=$acl_cv_prog_gnu_ld
-])
-
-dnl From libtool-1.4. Sets the variable LD.
-AC_DEFUN([AC_LIB_PROG_LD],
-[AC_ARG_WITH(gnu-ld,
-[ --with-gnu-ld assume the C compiler uses GNU ld [default=no]],
-test "$withval" = no || with_gnu_ld=yes, with_gnu_ld=no)
-AC_REQUIRE([AC_PROG_CC])dnl
-AC_REQUIRE([AC_CANONICAL_HOST])dnl
-# Prepare PATH_SEPARATOR.
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-ac_prog=ld
-if test "$GCC" = yes; then
- # Check if gcc -print-prog-name=ld gives a path.
- AC_MSG_CHECKING([for ld used by GCC])
- case $host in
- *-*-mingw*)
- # gcc leaves a trailing carriage return which upsets mingw
- ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
- *)
- ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
- esac
- case $ac_prog in
- # Accept absolute paths.
- [[\\/]* | [A-Za-z]:[\\/]*)]
- [re_direlt='/[^/][^/]*/\.\./']
- # Canonicalize the path of ld
- ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
- while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
- ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
- done
- test -z "$LD" && LD="$ac_prog"
- ;;
- "")
- # If it fails, then pretend we aren't using GCC.
- ac_prog=ld
- ;;
- *)
- # If it is relative, then search for the first ld in PATH.
- with_gnu_ld=unknown
- ;;
- esac
-elif test "$with_gnu_ld" = yes; then
- AC_MSG_CHECKING([for GNU ld])
-else
- AC_MSG_CHECKING([for non-GNU ld])
-fi
-AC_CACHE_VAL(acl_cv_path_LD,
-[if test -z "$LD"; then
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
- for ac_dir in $PATH; do
- test -z "$ac_dir" && ac_dir=.
- if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
- acl_cv_path_LD="$ac_dir/$ac_prog"
- # Check to see if the program is GNU ld. I'd rather use --version,
- # but apparently some GNU ld's only accept -v.
- # Break only if it was the GNU/non-GNU ld that we prefer.
- case `"$acl_cv_path_LD" -v 2>&1 < /dev/null` in
- *GNU* | *'with BFD'*)
- test "$with_gnu_ld" != no && break ;;
- *)
- test "$with_gnu_ld" != yes && break ;;
- esac
- fi
- done
- IFS="$ac_save_ifs"
-else
- acl_cv_path_LD="$LD" # Let the user override the test with a path.
-fi])
-LD="$acl_cv_path_LD"
-if test -n "$LD"; then
- AC_MSG_RESULT($LD)
-else
- AC_MSG_RESULT(no)
-fi
-test -z "$LD" && AC_MSG_ERROR([no acceptable ld found in \$PATH])
-AC_LIB_PROG_LD_GNU
-])
diff --git a/analog-filter.scm b/analog-filter.scm
index c4e6d3c..5298ee1 100644
--- a/analog-filter.scm
+++ b/analog-filter.scm
@@ -8,83 +8,83 @@
;;; bessel-lowpass|highpass|bandstop|bandpass
;;; elliptic-lowpass|highpass|bandstop|bandpass
;;;
-;;; build Snd --with-doubles --with-gsl for best results
+;;; build Snd with gsl for best results
(provide 'snd-analog-filter.scm)
-
(define* (analog->digital n num den fz)
- (let* ((g 1.0)
- (Q 1.0)
- (wc (tan (* pi fz)))
- (c (make-vct (* 2 n))))
-
+ (let ((g 1.0)
+ (Q 1.0)
+ (wc (tan (* pi fz)))
+ (c (make-float-vector (* 2 n))))
+
(define (cascade->canonical A)
- "(cascade->canonical A) converts cascade filter coeffs to canonical form"
+ ;; (cascade->canonical A) converts cascade filter coeffs to canonical form
;; from Orfanidis "Introduction to Signal Processing"
-
+
(define (conv M h L x y)
;; x * h -> y
(do ((n 0 (+ n 1)))
((= n (+ L M)))
- (set! (y n) 0.0)
- (do ((m (max 0 (- n (+ 1 L))) (+ 1 m)))
- ((> m (min n M)))
- (set! (y n) (+ (y n) (* (h m) (x (- n m))))))))
-
+ (let ((sum 0.0)
+ (start (max 0 (- n (+ L 1))))
+ (end (min n M)))
+ (do ((m start (+ m 1)))
+ ((> m end))
+ (set! sum (+ sum (* (h m) (x (- n m))))))
+ (set! (y n) sum))))
+
(let* ((K (length A))
- (d (make-vct (+ 1 (* 2 K))))
- (a1 (make-vct (+ 1 (* 2 K)))))
+ (d (make-float-vector (+ 1 (* 2 K))))
+ (a1 (make-float-vector (+ 1 (* 2 K)))))
(set! (a1 0) 1.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i K))
- (conv 2 (list-ref A i) (+ 1 (* 2 i)) a1 d)
- (do ((j 0 (+ 1 j)))
- ((= j (+ 3 (* 2 i))))
- (set! (a1 j) (d j))))
+ (conv 2 (A i) (+ 1 (* 2 i)) a1 d)
+ (copy d a1 0 (+ 3 (* 2 i))))
a1))
-
+
(do ((i 0 (+ i 2))
(j 0 (+ j 3))
(k 0 (+ k 4)))
((>= i n))
(let* ((nt0 (/ (num (+ j 0)) (* wc wc)))
- (nt1 (/ (num (+ j 1)) wc))
- (nt2 (num (+ j 2)))
- (dt0 (/ (den (+ j 0)) (* wc wc)))
- (dt1 (/ (den (+ j 1)) (* wc Q)))
- (dt2 (den (+ j 2)))
- (kd (+ dt0 dt1 dt2))
- (kn (+ nt0 nt1 nt2)))
- (set! (c (+ k 0)) (/ (- (* 2.0 dt2) (* 2.0 dt0)) kd))
+ (nt1 (/ (num (+ j 1)) wc))
+ (nt2 (num (+ j 2)))
+ (dt0 (/ (den (+ j 0)) (* wc wc)))
+ (dt1 (/ (den (+ j 1)) (* wc Q)))
+ (dt2 (den (+ j 2)))
+ (kd (+ dt0 dt1 dt2))
+ (kn (+ nt0 nt1 nt2)))
+ (set! (c k ) (/ (- (* 2.0 dt2) (* 2.0 dt0)) kd))
(set! (c (+ k 1)) (/ (+ dt0 (- dt1) dt2) kd))
(set! (c (+ k 2)) (/ (- (* 2.0 nt2) (* 2.0 nt0)) kn))
(set! (c (+ k 3)) (/ (+ nt0 (- nt1) nt2) kn))
(set! g (* g (/ kn kd)))))
-
- (let ((a '())
- (b '()))
+
+ (let ((a ())
+ (b ()))
(do ((i 0 (+ i 2))
(k 0 (+ k 4))) ; c
((>= i n))
- (set! a (cons (vct (c (+ k 3)) (c (+ k 2)) (c (+ k 3))) a))
- (set! b (cons (vct 1.0 (c k) (c (+ k 1))) b)))
-
- (list (vct-scale! (cascade->canonical a) g) ; scale entire numerator because this is the convolved form
+ (set! a (cons (float-vector (c (+ k 3)) (c (+ k 2)) (c (+ k 3))) a))
+ (set! b (cons (float-vector 1.0 (c k) (c (+ k 1))) b)))
+
+ (list (float-vector-scale! (cascade->canonical a) g) ; scale entire numerator because this is the convolved form
(cascade->canonical b)))))
(define (prototype->highpass n num den)
- (let* ((g 1.0)
- (numt (make-vct (length num)))
- (dent (make-vct (length den))))
+ (let ((g 1.0)
+ (numt (make-float-vector (length num)))
+ (dent (make-float-vector (length den))))
(do ((k 0 (+ k 2))
(i 0 (+ i 3)))
((>= k n))
(set! g (* g (/ (num (+ i 2)) (den (+ i 2)))))
- (set! (numt (+ i 0)) 1.0)
+ (set! (numt i ) 1.0)
(set! (numt (+ i 1)) (/ (num (+ i 1)) (num (+ i 2))))
(set! (numt (+ i 2)) (/ (num i) (num (+ i 2))))
- (set! (dent (+ i 0)) 1.0)
+ (set! (dent i ) 1.0)
(set! (dent (+ i 1)) (/ (den (+ i 1)) (den (+ i 2))))
(set! (dent (+ i 2)) (/ (den i) (den (+ i 2)))))
(set! (numt 0) g)
@@ -96,8 +96,8 @@
(define (butterworth-prototype n)
(let* ((len (/ (* n 3) 2))
- (num (make-vct len))
- (den (make-vct len)))
+ (num (make-float-vector len))
+ (den (make-float-vector len)))
(do ((w 1 (+ w 2))
(j 0 (+ j 3)))
((>= w n))
@@ -109,41 +109,45 @@
(set! (den (+ j 2)) 1.0))
(list num den)))
-(define (make-butterworth-lowpass n fc)
- "(make-butterworth-lowpass n fc) returns a lowpass Buttterworth filter; n = order, fc = cutoff \
-freq (srate = 1.0): (make-butterworth-lowpass 8 .1)"
- ;; identical to make-butter-lp except for fc (freq->1.0) fixup
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (butterworth-prototype n))
- (coeffs (analog->digital n (car proto) (cadr proto) fc)))
- (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))
-
-(define (make-butterworth-highpass n fc)
- "(make-butterworth-highpass n fc) returns a highpass Butterworth filter; n = order, fc = cutoff \
-freq (srate = 1.0): (make-butterworth-highpass 8 .1)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (butterworth-prototype n))
- (hproto (prototype->highpass n (car proto) (cadr proto)))
- (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
- (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))
-
-(define (make-butterworth-bandpass n fl fh)
- "(make-butterworth-bandpass n fl fh) returns a bandpass Butterworth filter; n = order, fl and fh \
-are (1.0-based) edge freqs: (make-butterworth-bandpass 4 .1 .2)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-butterworth-lowpass n fh))
- (hp (make-butterworth-highpass n fl)))
- (lambda (y)
- (filter lp (filter hp y)))))
-
-(define (make-butterworth-bandstop n fl fh)
- "(make-butterworth-bandstop n fl fh) returns a bandstop Butterworth filter; n = order, fl and fh \
-are (1.0-based) edge freqs: (make-butterworth-bandstop 4 .1 .2)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-butterworth-lowpass n fl))
- (hp (make-butterworth-highpass n fh)))
- (lambda (y)
- (+ (filter lp y) (filter hp y)))))
+(define make-butterworth-lowpass
+ (let ((documentation "(make-butterworth-lowpass n fc) returns a lowpass Buttterworth filter; n = order, fc = cutoff \
+freq (srate = 1.0): (make-butterworth-lowpass 8 .1)"))
+ (lambda (n fc)
+ ;; identical to make-butter-lp except for fc (freq->1.0) fixup
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (butterworth-prototype n))
+ (coeffs (analog->digital n (car proto) (cadr proto) fc)))
+ (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))
+
+(define make-butterworth-highpass
+ (let ((documentation "(make-butterworth-highpass n fc) returns a highpass Butterworth filter; n = order, fc = cutoff \
+freq (srate = 1.0): (make-butterworth-highpass 8 .1)"))
+ (lambda (n fc)
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (butterworth-prototype n))
+ (hproto (prototype->highpass n (car proto) (cadr proto)))
+ (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
+ (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))
+
+(define make-butterworth-bandpass
+ (let ((documentation "(make-butterworth-bandpass n fl fh) returns a bandpass Butterworth filter; n = order, fl and fh \
+are (1.0-based) edge freqs: (make-butterworth-bandpass 4 .1 .2)"))
+ (lambda (n fl fh)
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-butterworth-lowpass n fh))
+ (hp (make-butterworth-highpass n fl)))
+ (lambda (y)
+ (filter lp (filter hp y)))))))
+
+(define make-butterworth-bandstop
+ (let ((documentation "(make-butterworth-bandstop n fl fh) returns a bandstop Butterworth filter; n = order, fl and fh \
+are (1.0-based) edge freqs: (make-butterworth-bandstop 4 .1 .2)"))
+ (lambda (n fl fh)
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-butterworth-lowpass n fl))
+ (hp (make-butterworth-highpass n fh)))
+ (lambda (y)
+ (+ (filter lp y) (filter hp y)))))))
@@ -153,57 +157,61 @@ are (1.0-based) edge freqs: (make-butterworth-bandstop 4 .1 .2)"
(let* ((e (sqrt (- (expt 10.0 (* 0.1 ripple)) 1.0)))
(v0 (/ (asinh (/ 1.0 e)) n))
(len (/ (* n 3) 2))
- (num (make-vct len))
- (den (make-vct len)))
+ (num (make-float-vector len))
+ (den (make-float-vector len)))
(do ((l 1.0 (+ l 2.0))
(j 0 (+ j 3)))
((>= l n))
- (let* ((u (- (* (sinh v0) (sin (/ (* l pi) (* 2.0 n))))))
- (w (* (cosh v0) (cos (/ (* l pi) (* 2.0 n))))))
- (set! (num (+ j 0)) 0.0)
- (set! (num (+ j 1)) 0.0)
- (set! (num (+ j 2)) 1.0)
- (set! (den (+ j 0)) 1.0)
- (set! (den (+ j 1)) (* -2.0 u))
- (set! (den (+ j 2)) (+ (* u u) (* w w)))))
+ (let ((u (- (* (sinh v0) (sin (/ (* l pi) (* 2.0 n))))))
+ (w (* (cosh v0) (cos (/ (* l pi) (* 2.0 n))))))
+ (set! (num j ) 0.0)
+ (set! (num (+ j 1)) 0.0)
+ (set! (num (+ j 2)) 1.0)
+ (set! (den j ) 1.0)
+ (set! (den (+ j 1)) (* -2.0 u))
+ (set! (den (+ j 2)) (+ (* u u) (* w w)))))
(set! (num 2) (/ (expt 2.0 (- 2 n))
- (expt 3.2 (/ (log ripple) (log 10.0))))) ; whatever works...
+ (expt 3.2 (log ripple 10.0)))) ; whatever works...
(list num den)))
-(define* (make-chebyshev-lowpass n fc (ripple 1.0))
- "(make-chebyshev-lowpass n fc (ripple 1.0)) returns a lowpass Chebyshev filter; n = order, \
-fc = cutoff freq (srate = 1.0): (make-chebyshev-lowpass 8 .1)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (chebyshev-prototype n ripple))
- (coeffs (analog->digital n (car proto) (cadr proto) fc)))
- (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))
-
-(define* (make-chebyshev-highpass n fc (ripple 1.0))
- "(make-chebyshev-highpass n fc (ripple 1.0)) returns a highpass Chebyshev filter; n = order, \
-fc = cutoff freq (srate = 1.0): (make-chebyshev-highpass 8 .1 .01)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (chebyshev-prototype n ripple))
- (hproto (prototype->highpass n (car proto) (cadr proto)))
- (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
- (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))
-
-(define* (make-chebyshev-bandpass n fl fh (ripple 1.0))
- "(make-chebyshev-bandpass n fl fh (ripple 1.0)) returns a bandpass Chebyshev filter; n = order, \
-fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandpass 4 .1 .2)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-chebyshev-lowpass n fh ripple))
- (hp (make-chebyshev-highpass n fl ripple)))
- (lambda (y)
- (filter lp (filter hp y)))))
-
-(define* (make-chebyshev-bandstop n fl fh (ripple 1.0))
- "(make-chebyshev-bandstop n fl fh (ripple 1.0)) returns a bandstop Chebyshev filter; n = order, \
-fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandstop 8 .1 .4 .01)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-chebyshev-lowpass n fl ripple))
- (hp (make-chebyshev-highpass n fh ripple)))
- (lambda (y)
- (+ (filter lp y) (filter hp y)))))
+(define make-chebyshev-lowpass
+ (let ((documentation "(make-chebyshev-lowpass n fc (ripple 1.0)) returns a lowpass Chebyshev filter; n = order, \
+fc = cutoff freq (srate = 1.0): (make-chebyshev-lowpass 8 .1)"))
+ (lambda* (n fc (ripple 1.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (chebyshev-prototype n ripple))
+ (coeffs (analog->digital n (car proto) (cadr proto) fc)))
+ (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))
+
+(define make-chebyshev-highpass
+ (let ((documentation "(make-chebyshev-highpass n fc (ripple 1.0)) returns a highpass Chebyshev filter; n = order, \
+fc = cutoff freq (srate = 1.0): (make-chebyshev-highpass 8 .1 .01)"))
+ (lambda* (n fc (ripple 1.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (chebyshev-prototype n ripple))
+ (hproto (prototype->highpass n (car proto) (cadr proto)))
+ (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
+ (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))
+
+(define make-chebyshev-bandpass
+ (let ((documentation "(make-chebyshev-bandpass n fl fh (ripple 1.0)) returns a bandpass Chebyshev filter; n = order, \
+fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandpass 4 .1 .2)"))
+ (lambda* (n fl fh (ripple 1.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-chebyshev-lowpass n fh ripple))
+ (hp (make-chebyshev-highpass n fl ripple)))
+ (lambda (y)
+ (filter lp (filter hp y)))))))
+
+(define make-chebyshev-bandstop
+ (let ((documentation "(make-chebyshev-bandstop n fl fh (ripple 1.0)) returns a bandstop Chebyshev filter; n = order, \
+fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandstop 8 .1 .4 .01)"))
+ (lambda* (n fl fh (ripple 1.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-chebyshev-lowpass n fl ripple))
+ (hp (make-chebyshev-highpass n fh ripple)))
+ (lambda (y)
+ (+ (filter lp y) (filter hp y)))))))
@@ -213,172 +221,180 @@ fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandstop 8 .1 .4 .01)"
(let* ((e (sqrt (/ 1.0 (- (expt 10.0 (* 0.1 loss-dB)) 1.0))))
(v0 (/ (asinh (/ 1.0 e)) n))
(len (/ (* n 3) 2))
- (num (make-vct len))
- (den (make-vct len)))
+ (num (make-float-vector len))
+ (den (make-float-vector len)))
(let ((pl 0.0))
(do ((l 1.0 (+ l 2.0))
(j 0 (+ j 3)))
((>= l n))
- (let* ((u (- (* (sinh v0) (sin (/ (* l pi) (* 2.0 n))))))
- (w (* (cosh v0) (cos (/ (* l pi) (* 2.0 n)))))
- (t (/ 1.0 (sin (/ (* (+ l pl) pi) (* 2.0 n))))))
- (set! (num (+ j 0)) 1.0)
+ (let ((u (- (* (sinh v0) (sin (/ (* l pi) (* 2.0 n))))))
+ (w (* (cosh v0) (cos (/ (* l pi) (* 2.0 n)))))
+ (t (/ 1.0 (sin (/ (* (+ l pl) pi) (* 2.0 n))))))
+ (set! (num j ) 1.0)
(set! (num (+ j 1)) 0.0)
(set! (num (+ j 2)) (* t t))
- (set! (den (+ j 0)) 1.0)
+ (set! (den j ) 1.0)
(set! (den (+ j 1)) (/ (* -2.0 u) (+ (* u u) (* w w))))
(set! (den (+ j 2)) (/ 1.0 (+ (* u u) (* w w)))))))
(list num den
(expt 1.122 (- loss-dB))))) ; argh
-(define* (make-inverse-chebyshev-lowpass n fc (loss-dB 60.0))
- "(make-inverse-chebyshev-lowpass n fc (loss-dB 60.0)) returns a lowpass inverse-Chebyshev filter; n = order, \
-fc = cutoff freq (srate = 1.0): (make-inverse-chebyshev-lowpass 10 .4 120)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (inverse-chebyshev-prototype n loss-dB))
- (coeffs (analog->digital n (car proto) (cadr proto) fc)))
- (make-filter :xcoeffs (vct-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))
-
-(define* (make-inverse-chebyshev-highpass n fc (loss-dB 60.0))
- "(make-inverse-chebyshev-highpass n fc (loss-dB 60.0)) returns a highpass inverse-Chebyshev filter; n = order, \
-fc = cutoff freq (srate = 1.0): (make-inverse-chebyshev-highpass 10 .1 120)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (inverse-chebyshev-prototype n loss-dB))
- (hproto (prototype->highpass n (car proto) (cadr proto)))
- (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
- (make-filter :xcoeffs (vct-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))
-
-(define* (make-inverse-chebyshev-bandpass n fl fh (loss-dB 60.0))
- "(make-inverse-chebyshev-bandpass n fl fh (loss-dB 60.0)) returns a bandpass inverse-Chebyshev filter; n = order, \
-fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandpass 8 .1 .4)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-inverse-chebyshev-lowpass n fh loss-dB))
- (hp (make-inverse-chebyshev-highpass n fl loss-dB)))
- (lambda (y) (filter lp (filter hp y)))))
-
-(define* (make-inverse-chebyshev-bandstop n fl fh (loss-dB 60.0))
- "(make-inverse-chebyshev-bandstop n fl fh (loss-dB 60.0)) returns a bandstop inverse-Chebyshev filter; n = order, \
-fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 90)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-inverse-chebyshev-lowpass n fl loss-dB))
- (hp (make-inverse-chebyshev-highpass n fh loss-dB)))
- (lambda (y) (+ (filter lp y) (filter hp y)))))
+(define make-inverse-chebyshev-lowpass
+ (let ((documentation "(make-inverse-chebyshev-lowpass n fc (loss-dB 60.0)) returns a lowpass inverse-Chebyshev filter; n = order, \
+fc = cutoff freq (srate = 1.0): (make-inverse-chebyshev-lowpass 10 .4 120)"))
+ (lambda* (n fc (loss-dB 60.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (inverse-chebyshev-prototype n loss-dB))
+ (coeffs (analog->digital n (car proto) (cadr proto) fc)))
+ (make-filter :xcoeffs (float-vector-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))))
+
+(define make-inverse-chebyshev-highpass
+ (let ((documentation "(make-inverse-chebyshev-highpass n fc (loss-dB 60.0)) returns a highpass inverse-Chebyshev filter; n = order, \
+fc = cutoff freq (srate = 1.0): (make-inverse-chebyshev-highpass 10 .1 120)"))
+ (lambda* (n fc (loss-dB 60.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (inverse-chebyshev-prototype n loss-dB))
+ (hproto (prototype->highpass n (car proto) (cadr proto)))
+ (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
+ (make-filter :xcoeffs (float-vector-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))))
+
+(define make-inverse-chebyshev-bandpass
+ (let ((documentation "(make-inverse-chebyshev-bandpass n fl fh (loss-dB 60.0)) returns a bandpass inverse-Chebyshev filter; n = order, \
+fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandpass 8 .1 .4)"))
+ (lambda* (n fl fh (loss-dB 60.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-inverse-chebyshev-lowpass n fh loss-dB))
+ (hp (make-inverse-chebyshev-highpass n fl loss-dB)))
+ (lambda (y) (filter lp (filter hp y)))))))
+
+(define make-inverse-chebyshev-bandstop
+ (let ((documentation "(make-inverse-chebyshev-bandstop n fl fh (loss-dB 60.0)) returns a bandstop inverse-Chebyshev filter; n = order, \
+fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 90)"))
+ (lambda* (n fl fh (loss-dB 60.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-inverse-chebyshev-lowpass n fl loss-dB))
+ (hp (make-inverse-chebyshev-highpass n fh loss-dB)))
+ (lambda (y) (+ (filter lp y) (filter hp y)))))))
;;; ---------------- Bessel (-Thompson) ----------------
(define (bessel-prototype n)
-
+
(define (fact n)
(let ((x 1))
- (do ((i 2 (+ 1 i)))
+ (do ((i 2 (+ i 1)))
((> i n))
(set! x (* x i)))
x))
-; this form overflows if we don't have bignums
-; (define (bessel-i n)
-; (let ((cs (make-vct (+ n 1))))
-; (do ((i 0 (+ 1 i)))
-; ((> i n))
-; (set! (cs i) (/ (fact (- (* 2 n) i))
-; (* (expt 2 (- n i))
-; (fact i)
-; (fact (- n i))))))
-; cs))
+ ; this form overflows if we don't have bignums
+ ; (define (bessel-i n)
+ ; (let ((cs (make-float-vector (+ n 1))))
+ ; (do ((i 0 (+ i 1)))
+ ; ((> i n))
+ ; (set! (cs i) (/ (fact (- (* 2 n) i))
+ ; (* (expt 2 (- n i))
+ ; (fact i)
+ ; (fact (- n i))))))
+ ; cs))
(define (bessel-i n)
- (let ((cs (make-vct (+ n 1))))
- (do ((i 0 (+ 1 i)))
+ (let ((cs (make-float-vector (+ n 1))))
+ (do ((i 0 (+ i 1)))
((> i n))
(let ((val (/ 1.0 (* (fact i) (expt 2 (- n i))))))
(do ((k 1 (+ k 1))
- (f (+ 1 (- n i)) (+ 1 f)))
+ (f (- n i -1) (+ f 1))) ; (f (+ 1 (- n i)) (+ 1 f))
((> k n))
(set! val (* val f)))
(set! (cs i) val)))
cs))
-
+
(let* ((len (/ (* n 3) 2))
- (num (make-vct len))
- (den (make-vct len))
+ (num (make-float-vector len))
+ (den (make-float-vector len))
(b2 (bessel-i n)))
- (let* ((p (gsl-roots (vct->vector b2))))
- (do ((i 0 (+ 1 i)))
+ (let ((p (gsl-roots (copy b2 (make-vector (length b2))))))
+ (do ((i 0 (+ i 1)))
((= i n))
(set! (p i) (/ (p i) (expt (b2 0) (/ 1.0 n)))))
(do ((j 0 (+ j 3))
(i 0 (+ i 2)))
((>= i n))
- (set! (num (+ j 0)) 0.0)
+ (set! (num j ) 0.0)
(set! (num (+ j 1)) 0.0)
(set! (num (+ j 2)) 1.0)
- (set! (den (+ j 0)) 1.0)
+ (set! (den j ) 1.0)
(set! (den (+ j 1)) (* -2.0 (real-part (p i))))
(set! (den (+ j 2)) (real-part (* (p i) (p (+ i 1)))))))
(list num den)))
-(define (make-bessel-lowpass n fc)
- "(make-bessel-lowpass n fc) returns a lowpass Bessel filter; n = order, fc = cutoff freq (srate = 1.0): (make-bessel-lowpass 4 .1)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (bessel-prototype n))
- (coeffs (analog->digital n (car proto) (cadr proto) fc)))
- (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))
-
-(define* (make-bessel-highpass n fc)
- "(make-bessel-highpass n fc) returns a highpass Bessel filter; n = order, fc = cutoff freq (srate = 1.0): (make-bessel-highpass 8 .1)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (bessel-prototype n))
- (hproto (prototype->highpass n (car proto) (cadr proto)))
- (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
- (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))
-
-(define* (make-bessel-bandpass n fl fh)
- "(make-bessel-bandpass n fl fh) returns a bandpass Bessel filter; n = order, fl and fh are edge freqs (srate=1.0): (make-bessel-bandpass 4 .1 .2)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-bessel-lowpass n fh))
- (hp (make-bessel-highpass n fl)))
- (lambda (y)
- (filter lp (filter hp y)))))
-
-(define* (make-bessel-bandstop n fl fh)
- "(make-bessel-bandstop n fl fh) returns a bandstop Bessel filter; n = order, fl and fh are edge freqs (srate=1.0): (make-bessel-bandstop 8 .1 .2)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-bessel-lowpass n fl))
- (hp (make-bessel-highpass n fh)))
- (lambda (y)
- (+ (filter lp y) (filter hp y)))))
+(define make-bessel-lowpass
+ (let ((documentation "(make-bessel-lowpass n fc) returns a lowpass Bessel filter; n = order, fc = cutoff freq (srate = 1.0): (make-bessel-lowpass 4 .1)"))
+ (lambda (n fc)
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (bessel-prototype n))
+ (coeffs (analog->digital n (car proto) (cadr proto) fc)))
+ (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))
+
+(define make-bessel-highpass
+ (let ((documentation "(make-bessel-highpass n fc) returns a highpass Bessel filter; n = order, fc = cutoff freq (srate = 1.0): (make-bessel-highpass 8 .1)"))
+ (lambda* (n fc)
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (bessel-prototype n))
+ (hproto (prototype->highpass n (car proto) (cadr proto)))
+ (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
+ (make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))
+
+(define make-bessel-bandpass
+ (let ((documentation "(make-bessel-bandpass n fl fh) returns a bandpass Bessel filter; n = order, fl and fh are edge freqs (srate=1.0): (make-bessel-bandpass 4 .1 .2)"))
+ (lambda* (n fl fh)
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-bessel-lowpass n fh))
+ (hp (make-bessel-highpass n fl)))
+ (lambda (y)
+ (filter lp (filter hp y)))))))
+
+(define make-bessel-bandstop
+ (let ((documentation "(make-bessel-bandstop n fl fh) returns a bandstop Bessel filter; n = order, fl and fh are edge freqs (srate=1.0): (make-bessel-bandstop 8 .1 .2)"))
+ (lambda* (n fl fh)
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-bessel-lowpass n fl))
+ (hp (make-bessel-highpass n fh)))
+ (lambda (y)
+ (+ (filter lp y) (filter hp y)))))))
;;; ---------------- Elliptic ----------------
(define* (elliptic-prototype n (ripple 1.0) (loss-dB 60.0))
-
+
(define* (minimize-function f xmin xmax arg1 arg2)
(let* ((n 20)
- (x (make-vct n))
+ (x (make-float-vector n))
(fx (f xmin arg1 arg2)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i n))
(let ((step (/ (- xmax xmin) (- n 1.0))))
- (do ((j 0 (+ 1 j))
+ (do ((j 0 (+ j 1))
(s xmin (+ s step)))
((= j (- n 1)))
- (set! (x j) s))
+ (float-vector-set! x j s))
(set! (x (- n 1)) xmax))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((= j n))
(let ((ft (f (x j) arg1 arg2)))
(if (< ft fx)
(begin
(set! fx ft)
- (set! xmax (if (< j (- n 1)) (x (+ 1 j)) (x (- n 1))))
+ (set! xmax (if (< j (- n 1)) (x (+ j 1)) (x (- n 1))))
(set! xmin (if (> j 0) (x (- j 1)) (x 0))))))))
(/ (+ xmax xmin) 2.0)))
-
+
(define (findm m arg1 arg2)
(abs (- (/ (gsl-ellipk m) (gsl-ellipk (- 1.0 m))) arg1)))
-
+
(define (findv u arg1 arg2)
(let ((vals (gsl-ellipj u arg1)))
(abs (- arg2 (/ (car vals) (cadr vals))))))
@@ -390,15 +406,15 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
(m 0.0)
(k 0.0)
(len (/ (* n 3) 2))
- (num (make-vct len))
- (den (make-vct len))
+ (num (make-float-vector len))
+ (den (make-float-vector len))
(g 1.0)
(eps 0.0000001))
(if (> (abs (- 1.0 (* k1p k1p))) eps)
(set! kr (* n (/ (gsl-ellipk (* k1 k1)) (gsl-ellipk (* k1p k1p))))))
(set! m (minimize-function findm 0.001 0.999 kr))
(set! k (gsl-ellipk m))
- (let* ((cv (make-vct (floor (* 0.5 (* 3 (+ n 1)))))))
+ (let ((cv (make-float-vector (floor (* 0.5 3 (+ n 1))))))
(do ((i 0 (+ i 2))
(j 0 (+ j 3)))
((>= i n))
@@ -406,13 +422,13 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
(sn (car vals))
(cn (cadr vals))
(dn (caddr vals)))
- (set! (cv (+ j 0)) sn)
+ (set! (cv j ) sn)
(set! (cv (+ j 1)) cn)
(set! (cv (+ j 2)) dn)
(let* ((z (/ 0.0-i (* (sqrt m) sn)))
- (pz (real-part (* z (make-rectangular (real-part z) (- (imag-part z)))))))
+ (pz (real-part (* z (complex (real-part z) (- (imag-part z)))))))
(set! g (/ g pz))
- (set! (num (+ j 0)) 1.0)
+ (set! (num j ) 1.0)
(set! (num (+ j 1)) (* -2.0 (real-part z)))
(set! (num (+ j 2)) pz))))
(let* ((optarg0 (* k1p k1p))
@@ -427,50 +443,54 @@ fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 9
(do ((i 0 (+ i 2))
(j 0 (+ j 3)))
((>= i n))
- (let* ((p (/ (- (+ (* (cv (+ j 1)) (cv (+ j 2)) sn cn)
- (* 0.0+i (cv (+ j 0)) dn)))
- (- 1.0 (* (cv (+ j 2)) sn
- (cv (+ j 2)) sn)))))
- (let ((pp (real-part (* p (make-rectangular (real-part p) (- (imag-part p)))))))
+ (let ((p (/ (- (+ (* (cv (+ j 1)) (cv (+ j 2)) sn cn)
+ (* 0.0+i (cv j) dn)))
+ (- 1.0 (* (cv (+ j 2)) sn
+ (cv (+ j 2)) sn)))))
+ (let ((pp (real-part (* p (complex (real-part p) (- (imag-part p)))))))
(set! g (* g pp))
- (set! (den (+ j 0)) 1.0)
+ (set! (den j ) 1.0)
(set! (den (+ j 1)) (* -2.0 (real-part p)))
(set! (den (+ j 2)) pp))))))
(set! g (abs (/ g (sqrt (+ 1.0 (* e e))))))
(list num den g)))
-(define* (make-elliptic-lowpass n fc (ripple 1.0) (loss-dB 60.0))
- "(make-elliptic-lowpass n fc (ripple 1.0) (loss-dB 60.0)) returns a lowpass elliptic filter; n = order, \
-fc = cutoff freq (srate = 1.0): (make-elliptic-lowpass 8 .25 .01 90)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (elliptic-prototype n ripple loss-dB))
- (coeffs (analog->digital n (car proto) (cadr proto) fc)))
- (make-filter :xcoeffs (vct-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))
-
-(define* (make-elliptic-highpass n fc (ripple 1.0) (loss-dB 60.0))
- "(make-elliptic-highpass n fc (ripple 1.0) (loss-dB 60.0)) returns a highpass elliptic filter; n = order, \
-fc = cutoff freq (srate = 1.0): (make-elliptic-highpass 8 .25 .01 90)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((proto (elliptic-prototype n ripple loss-dB))
- (hproto (prototype->highpass n (car proto) (cadr proto)))
- (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
- (make-filter :xcoeffs (vct-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))
-
-(define* (make-elliptic-bandpass n fl fh (ripple 1.0) (loss-dB 60.0))
- "(make-elliptic-bandpass n fl fh (ripple 1.0) (loss-dB 60.0)) returns a bandpass elliptic filter; n = order, \
-fl and fh are edge freqs (srate=1.0): (make-elliptic-bandpass 6 .1 .2 .1 90)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-elliptic-lowpass n fh ripple loss-dB))
- (hp (make-elliptic-highpass n fl ripple loss-dB)))
- (lambda (y)
- (filter lp (filter hp y)))))
-
-(define* (make-elliptic-bandstop n fl fh (ripple 1.0) (loss-dB 60.0))
- "(make-elliptic-bandstop n fl fh (ripple 1.0) (loss-dB 60.0)) returns a bandstop elliptic filter; n = order, \
-fl and fh are edge freqs (srate=1.0): (make-elliptic-bandstop 6 .1 .2 .1 90)"
- (if (odd? n) (set! n (+ n 1)))
- (let* ((lp (make-elliptic-lowpass n fl ripple loss-dB))
- (hp (make-elliptic-highpass n fh ripple loss-dB)))
- (lambda (y)
- (+ (filter lp y) (filter hp y)))))
+(define make-elliptic-lowpass
+ (let ((documentation "(make-elliptic-lowpass n fc (ripple 1.0) (loss-dB 60.0)) returns a lowpass elliptic filter; n = order, \
+fc = cutoff freq (srate = 1.0): (make-elliptic-lowpass 8 .25 .01 90)"))
+ (lambda* (n fc (ripple 1.0) (loss-dB 60.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (elliptic-prototype n ripple loss-dB))
+ (coeffs (analog->digital n (car proto) (cadr proto) fc)))
+ (make-filter :xcoeffs (float-vector-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))))
+
+(define make-elliptic-highpass
+ (let ((documentation "(make-elliptic-highpass n fc (ripple 1.0) (loss-dB 60.0)) returns a highpass elliptic filter; n = order, \
+fc = cutoff freq (srate = 1.0): (make-elliptic-highpass 8 .25 .01 90)"))
+ (lambda* (n fc (ripple 1.0) (loss-dB 60.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let* ((proto (elliptic-prototype n ripple loss-dB))
+ (hproto (prototype->highpass n (car proto) (cadr proto)))
+ (coeffs (analog->digital n (car hproto) (cadr hproto) fc)))
+ (make-filter :xcoeffs (float-vector-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))))
+
+(define make-elliptic-bandpass
+ (let ((documentation "(make-elliptic-bandpass n fl fh (ripple 1.0) (loss-dB 60.0)) returns a bandpass elliptic filter; n = order, \
+fl and fh are edge freqs (srate=1.0): (make-elliptic-bandpass 6 .1 .2 .1 90)"))
+ (lambda* (n fl fh (ripple 1.0) (loss-dB 60.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-elliptic-lowpass n fh ripple loss-dB))
+ (hp (make-elliptic-highpass n fl ripple loss-dB)))
+ (lambda (y)
+ (filter lp (filter hp y)))))))
+
+(define make-elliptic-bandstop
+ (let ((documentation "(make-elliptic-bandstop n fl fh (ripple 1.0) (loss-dB 60.0)) returns a bandstop elliptic filter; n = order, \
+fl and fh are edge freqs (srate=1.0): (make-elliptic-bandstop 6 .1 .2 .1 90)"))
+ (lambda* (n fl fh (ripple 1.0) (loss-dB 60.0))
+ (if (odd? n) (set! n (+ n 1)))
+ (let ((lp (make-elliptic-lowpass n fl ripple loss-dB))
+ (hp (make-elliptic-highpass n fh ripple loss-dB)))
+ (lambda (y)
+ (+ (filter lp y) (filter hp y)))))))
diff --git a/animals.scm b/animals.scm
index c2a1554..4fe41c0 100644
--- a/animals.scm
+++ b/animals.scm
@@ -224,14 +224,44 @@
;;; Eared grebe
;;; Killdeer
-
(provide 'snd-animals.scm)
-(if (not (provided? 'snd-generators.scm)) (load "generators.scm"))
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+(require snd-generators.scm)
+;; rk!cos blackman=polywave rcos rxycos
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(set! *clm-default-frequency* 0.0)
+(define-macro (defanimal args . body)
+ (let ((name (car args))
+ (targs (cdr args)))
+ `(begin
+ (define (,name , at targs)
+ (if *clm-notehook*
+ (*clm-notehook* (symbol->string ',name) , at targs))
+ , at body)
+ ,@(if *definstrument-hook*
+ (list (*definstrument-hook* name targs))
+ (list)))))
+
+#|
+(define-macro (defanimal args . body)
+ (let ((name (car args))
+ (targs (cdr args)))
+ `(begin
+ (define (,name , at targs)
+ (if *clm-notehook*
+ (*clm-notehook* (symbol->string ',name) , at targs))
+ (let ((start (get-internal-real-time)))
+ , at body
+ (format #t "~A: ~A~%" (- (get-internal-real-time) start) ,name)))
+ ,@(if *definstrument-hook*
+ (list (*definstrument-hook* name targs))
+ (list)))))
+|#
+
#|
;;; ================================================================================
@@ -242,7 +272,7 @@
(format #f "(~{~,3F~^ ~})" e))
(define (seldur)
- (list (/ (selection-frames) 44100.0)
+ (list (/ (selection-framples) 44100.0)
(selection-maxamp)))
(define (sp)
@@ -265,24 +295,25 @@
(if (null? (hook-functions start-playing-hook))
(hook-push start-playing-hook
- (lambda (snd)
- (if (sound? snd) ; meaning not 123456 = temp-sound-index from View:Files play button
- (if (and (selection?)
- (selection-member? snd))
- (begin
- (play (selection))
- #t)
- (if (> (frames snd) (* 10 (srate snd)))
- (let ((chn (or (selected-channel) 0)))
- (with-temporary-selection
- (lambda () (play (selection)))
- (left-sample snd chn)
- (- (right-sample snd chn)
- (left-sample snd chn))
- snd chn)
- #t)
- #f))
- #f))))
+ (lambda (hook)
+ (let ((snd (hook 'snd)))
+ (if (sound? snd) ; meaning not 123456 = temp-sound-index from View:Files play button
+ (if (and (selection?)
+ (selection-member? snd))
+ (begin
+ (play (selection))
+ #t)
+ (if (> (framples snd) (* 10 (srate snd)))
+ (let ((chn (or (selected-channel) 0)))
+ (with-temporary-selection
+ (lambda () (play (selection)))
+ (left-sample snd chn)
+ (- (right-sample snd chn)
+ (left-sample snd chn))
+ snd chn)
+ #t)
+ #f))
+ #f)))))
;;; precision window movements via arrow keys
@@ -295,9 +326,9 @@
(hi-pix (ax 12))
(samps-per-pixel (max 1 (round (/ (- hi lo) (- hi-pix lo-pix)))))
(change (if right
- (- (min (+ hi samps-per-pixel) (frames s c)) hi)
+ (- (min (+ hi samps-per-pixel) (framples s c)) hi)
(- (max 0 (- lo samps-per-pixel)) lo))))
- (set! (left-sample) (min (max 0 (+ lo change)) (frames s c)))
+ (set! (left-sample) (min (max 0 (+ lo change)) (framples s c)))
keyboard-no-action))
(bind-key "Left" 0 (lambda () "move one pixel backward" (move-one-pixel (selected-sound) (selected-channel) #f)))
@@ -311,9 +342,9 @@
(hi-pix (ax 12))
(samps-per-pixel (* 8 (max 1 (round (/ (- hi lo) (- hi-pix lo-pix))))))
(change (if right
- (- (min (+ hi samps-per-pixel) (frames s c)) hi)
+ (- (min (+ hi samps-per-pixel) (framples s c)) hi)
(- (max 0 (- lo samps-per-pixel)) lo))))
- (set! (left-sample) (min (max 0 (+ lo change)) (frames s c)))
+ (set! (left-sample) (min (max 0 (+ lo change)) (framples s c)))
keyboard-no-action))
(bind-key "Left" 4 (lambda () "move some pixels backward" (move-more-pixels (selected-sound) (selected-channel) #f)))
@@ -326,7 +357,7 @@
(lo-pix (ax 10))
(hi-pix (ax 12))
(samps-per-pixel (max 1 (round (/ (- hi lo) (- hi-pix lo-pix)))))
- (len (frames s c)))
+ (len (framples s c)))
(if in
(if (> (- hi-pix lo-pix) samps-per-pixel)
(begin
@@ -400,22 +431,20 @@
;;;
;;; Knudsen's frog
-(definstrument (a-frog beg dur freq amp amp-env gliss gliss-env pulse-dur pulse-env fm-index fm-freq)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (base (make-oscil freq))
- (modm (if (and fm-index (> fm-index 0.0)) (make-oscil fm-freq) #f))
- (frqf (if gliss-env (make-env gliss-env :duration dur :base 32 :scaler (hz->radians gliss)) #f))
- (pulse (make-pulsed-env pulse-env pulse-dur (/ 1.0 pulse-dur)))
- (ampf (make-env amp-env :duration dur :scaler amp))
- (index (hz->radians (* fm-freq fm-index))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (pulsed-env pulse)
- (oscil base (+ (if frqf (env frqf) 0.0)
- (if modm (* index (oscil modm)) 0.0)))))))))
+(defanimal (a-frog beg dur freq amp amp-env gliss gliss-env pulse-dur pulse-env fm-index fm-freq)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (base (make-oscil freq))
+ (modm (make-oscil fm-freq))
+ (frqf (make-env (or gliss-env '(0 0 1 0)) :duration dur :base 32 :scaler (hz->radians gliss)))
+ (pulse (make-pulsed-env pulse-env pulse-dur (/ 1.0 pulse-dur)))
+ (ampf (make-env amp-env :duration dur :scaler amp))
+ (index (hz->radians (* fm-freq fm-index))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (pulsed-env pulse)
+ (oscil base (+ (env frqf) (* index (oscil modm)))))))))
(define (knudsens-frog beg amp)
(a-frog beg .25 480 amp '(0 0 1 1 3 1 4 0)
@@ -426,39 +455,38 @@
#|
;;; cricket-like:
(with-sound (:play #t)
- (a-frog 0 .25 2000 .5 '(0 0 1 1 3 1 4 0) ; or 3000 6000 etc
- 50 '(0 0 .5 .2 .8 1 1 1)
- (/ .25 5) '(0 0 1 0 5 1 8 0 20 0)
- 0.01 40))
+ (a-frog 0 .25 2000 .5 '(0 0 1 1 3 1 4 0) ; or 3000 6000 etc
+ 50 '(0 0 .5 .2 .8 1 1 1)
+ (/ .25 5) '(0 0 1 0 5 1 8 0 20 0)
+ 0.01 40))
(with-sound (:play #t)
- (a-frog 0 .25 4000 .5 '(0 0 1 1 3 1 4 0)
- 0 #f
- (/ .25 10) '(0 0 1 1 2 1 4 0 10 0)
- 0.0 10))
+ (a-frog 0 .25 4000 .5 '(0 0 1 1 3 1 4 0)
+ 0 #f
+ (/ .25 10) '(0 0 1 1 2 1 4 0 10 0)
+ 0.0 10))
;;; frog-like
(with-sound (:play #t)
- (a-frog 0 .25 2000 .5 '(0 0 1 1 3 1 4 0)
- 50 '(0 0 .5 .2 .8 1 1 1)
- (/ .25 10) '(0 0 1 1 2 1 3 0 4 0 5 1 7 1 8 0 20 0)
- 0.0 10))
+ (a-frog 0 .25 2000 .5 '(0 0 1 1 3 1 4 0)
+ 50 '(0 0 .5 .2 .8 1 1 1)
+ (/ .25 10) '(0 0 1 1 2 1 3 0 4 0 5 1 7 1 8 0 20 0)
+ 0.0 10))
|#
-(definstrument (a-cricket beg dur freq freq1 amp amp-env pulse-dur pulse-env)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (base (make-oscil freq))
- (base1 (make-oscil freq1))
- (pulse (make-pulsed-env pulse-env pulse-dur (/ 1.0 pulse-dur)))
- (ampf (make-env amp-env :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (pulsed-env pulse)
- (+ (* .8 (oscil base))
- (* .2 (oscil base1)))))))))
+(defanimal (a-cricket beg dur freq freq1 amp amp-env pulse-dur pulse-env)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (base (make-oscil freq))
+ (base1 (make-oscil freq1))
+ (pulse (make-pulsed-env pulse-env pulse-dur (/ 1.0 pulse-dur)))
+ (ampf (make-env amp-env :duration dur :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (pulsed-env pulse)
+ (+ (* .8 (oscil base))
+ (* .2 (oscil base1))))))))
;; (with-sound (:play #t) (a-cricket 0 .12 4500 5400 .5 '(0 0 1 1 3 1 4 0) (/ .11 3) '(0 0 1 .8 5 1 6 0 15 0)))
@@ -469,174 +497,216 @@
;;; Oak Toad
;;; might be slightly too much noise (the peep I worked on turned out to be a raspy one)
-(definstrument (oak-toad beg amp)
- (let* ((dur .43)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 10 1 15 0 43 0) :base .3 :duration dur :scaler amp))
- (gen1 (make-polywave 2150 (list 1 .01 2 1.0 3 .001 4 .005 6 .02)))
- (frqf (make-env '(0 -.5 1 1 5 -1) :duration .15 :scaler (hz->radians (+ 50 (random 40)))))
- (noise (make-rand-interp 1000 (+ .01 (random .005)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp noise)))))))))
+(defanimal (oak-toad beg amp)
+ (let ((dur .15)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 10 1 15 0) :base .3 :duration dur :scaler amp))
+ (gen1 (make-polywave 2150 '(1 .01 2 1.0 3 .001 4 .005 6 .02)))
+ (frqf (make-env '(0 -.5 1 1 5 -1) :duration .15 :scaler (hz->radians (+ 50 (random 40)))))
+ (noise (make-rand-interp 1000 (+ .01 (random .005)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp noise)))))))))
#|
(with-sound (:play #t)
- (let ((last-beg 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k 12))
- (let ((beg (+ last-beg .37 (random .08))))
- (oak-toad beg (+ .25 (random .3)))
- (set! last-beg beg)))))
+ (let ((last-beg 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k 12))
+ (let ((beg (+ last-beg .37 (random .08))))
+ (oak-toad beg (+ .25 (random .3)))
+ (set! last-beg beg)))))
|#
+;;; (with-sound (:play #t) (oak-toad 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Southern cricket frog
-(definstrument (southern-cricket-frog beg amp)
- (let* ((dur1 .03)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur1)))
- (ampf (make-env '(0 0 .75 1 5 1 10 0) :scaler amp :duration dur1))
- (gen1 (make-oscil 3500))
- (gen2 (make-oscil 6400))
- (pulse (make-pulsed-env '(0 .1 1 .6 2 .8 3 1 6 .1 8 .1) (/ dur1 8) (/ 8 dur1)))
- (index (hz->radians (* 150 2)))
- (f1 (make-env '(0 .9 9 .9 10 0) :duration dur1))
- (f2 (make-env '(0 .05 8 .1 10 .8 11 .1) :duration dur1))
- (fm (make-oscil 150)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((fm (* index (oscil fm))))
- (outa i (* (env ampf)
- (pulsed-env pulse)
- (+ (* (env f1) (oscil gen1 fm))
- (* (env f2) (oscil gen2 (* 2 fm)))))))))))
+(defanimal (southern-cricket-frog beg amp)
+ (let ((dur1 .03)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur1)))
+ (ampf (make-env '(0 0 .75 1 5 1 10 0) :scaler amp :duration dur1))
+ (gen1 (make-oscil 3500))
+ (gen2 (make-oscil 6400))
+ (pulse (make-pulsed-env '(0 .1 1 .6 2 .8 3 1 6 .1 8 .1) (/ dur1 8) (/ 8 dur1)))
+ (index (hz->radians 300))
+ (f1 (make-env '(0 .9 9 .9 10 0) :duration dur1))
+ (f2 (make-env '(0 .05 8 .1 10 .8 11 .1) :duration dur1))
+ (fm (make-oscil 150)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((fm1 (* index (oscil fm))))
+ (outa i (* (env ampf)
+ (pulsed-env pulse)
+ (+ (* (env f1) (oscil gen1 fm1))
+ (* (env f2) (oscil gen2 (* 2 fm1)))))))))))
-;; (with-sound () (southern-cricket-frog 0 0.5))
+;; (with-sound (:play #t) (southern-cricket-frog 0 0.5))
;;; --------------------------------------------------------------------------------
;;;
;;; Northern leopard frog (2)
-(definstrument (northern-leopard-frog-1 beg amp)
+(defanimal (northern-leopard-frog-1 beg amp)
;; this is slightly low-passed, and I don't quite have the vowel right at the end
- (let* ((dur 4.2)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil 440))
- (gen2 (make-oscil 1030)) ; there's also a 1500 formant that follows the 1000 case -- looks a lot like FM index 1 ca 600Hz
- (gen3 (make-oscil 2600))
- (pulse (make-pulse-train (/ 1.0 0.09)))
- (pulsef1 (make-env '(0 0 .1 1 10 0) :duration .013 :base 32.0))
- (pulsef2 (make-env '(0 0 4 1 10 0) :duration .013 :base 3.0))
- (interpf (make-env '(0 0 6 1 8 1 10 .5) :duration dur))
- (ampf (make-env '(0 0 3 1 9.5 1 10 0) :base .2 :duration dur :scaler amp))
- (gen1f (make-env '(0 1 8 1 10 0) :duration dur :scaler .65 :base 3))
- (gen2f (make-env '(0 0 8 0 10 1) :duration dur :scaler (hz->radians 90)))
- (gen3f (make-env '(0 1 6 1 10 0) :duration dur :offset (hz->radians 2200) :scaler (hz->radians 400)))
- (gen4f (make-env '(0 0 8 0 10 .02) :duration dur))
- (gen5f (make-env '(0 0 5 0 10 -1) :duration dur :scaler (hz->radians 200)))
- (pulf (make-env '(0 1 2 0 10 0) :scaler (hz->radians 3) :duration dur))
- (gen6 (make-oscil 170)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (> (pulse-train pulse (env pulf)) 0.1)
- (begin
- (mus-reset pulsef1)
- (mus-reset pulsef2)
- (mus-reset gen1)
- (mus-reset gen2)))
- (let* ((intrp (env interpf))
- (gentrp (env gen1f))
- (gen4trp (env gen4f))
- (result (* (env ampf)
- (+ (* intrp (env pulsef1))
- (* (- 1.0 intrp) (env pulsef2)))
- (+ (* gentrp (oscil gen2 (env gen5f)))
- (* (- 1.0 gentrp) (+ (* (- 1.0 gen4trp) (oscil gen1 (env gen2f)))
- (* gen4trp (oscil gen3 (+ (env gen3f)
- (* .075 (oscil gen6)))))))))))
- (outa i result))))))
+ (let ((dur 4.2))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil 440))
+ (gen2 (make-oscil 1030)) ; there's also a 1500 formant that follows the 1000 case -- looks a lot like FM index 1 ca 600Hz
+ (gen3 (make-oscil 2600))
+ (pulsef1 (make-env '(0 0 .1 1 10 0) :duration .013 :base 32.0))
+ (pulsef2 (make-env '(0 0 4 1 10 0) :duration .013 :base 3.0))
+ (interpf (make-env '(0 0 6 1 8 1 10 .5) :duration dur))
+ (ampf (make-env '(0 0 3 1 9.5 1 10 0) :base .2 :duration dur :scaler amp))
+ (gen1f (make-env '(0 1 8 1 10 0) :duration dur :scaler .65 :base 3))
+ (gen2f (make-env '(0 0 8 0 10 1) :duration dur :scaler (hz->radians 90)))
+ (gen3f (make-env '(0 1 6 1 10 0) :duration dur :offset (hz->radians 2200) :scaler (hz->radians 400)))
+ (gen4f (make-env '(0 0 8 0 10 .02) :duration dur))
+ (gen5f (make-env '(0 0 5 0 10 -1) :duration dur :scaler (hz->radians 200)))
+ (pulf (make-env (list 0.0 (/ 1.0 14.0) 2.0 (/ 1.0 11.0) 10.0 (/ 1.0 11.0)) :duration dur))
+ (gen6 (make-polywave 170 '(1 .075)))
+ (pulse-samps (seconds->samples 0.013)))
+
+ (let ((pulse-sep (seconds->samples (env pulf))))
+ (do ((i start (+ i pulse-sep)))
+ ((>= i stop))
+ (let ((pstop (+ i pulse-samps)))
+
+ (set! (mus-location interpf) (- i start))
+ (set! (mus-location ampf) (- i start))
+ (set! (mus-location gen1f) (- i start))
+ (set! (mus-location gen2f) (- i start))
+ (set! (mus-location gen3f) (- i start))
+ (set! (mus-location gen4f) (- i start))
+ (set! (mus-location gen5f) (- i start))
+
+ (let ((intrp (env interpf))
+ (gen1trp (env gen1f))
+ (gen2trp (env gen2f))
+ (gen3trp (env gen3f))
+ (gen4trp (env gen4f))
+ (gen5trp (env gen5f))
+ (pulse-amp (env ampf)))
+ (let ((intrp-1 (- 1.0 intrp))
+ (gen1trp-1 (- 1.0 gen1trp))
+ (gen4trp-1 (- 1.0 gen4trp)))
+ (do ((k i (+ k 1)))
+ ((= k pstop))
+ (outa k (* pulse-amp
+ (+ (* intrp (env pulsef1))
+ (* intrp-1 (env pulsef2)))
+ (+ (* gen1trp (oscil gen2 gen5trp))
+ (* gen1trp-1 (+ (* gen4trp-1 (oscil gen1 gen2trp))
+ (* gen4trp (oscil gen3 (+ gen3trp
+ (polywave gen6))))))))))))
+ (mus-reset pulsef1)
+ (mus-reset pulsef2)
+ (mus-reset gen1)
+ (mus-reset gen2)
+ (set! (mus-location pulf) (- (+ i pulse-sep) start))
+ (set! pulse-sep (seconds->samples (env pulf)))))))))
;; (with-sound (:statistics #t :play #t) (northern-leopard-frog-1 0 .5))
-(definstrument (northern-leopard-frog-2 beg amp)
+(defanimal (northern-leopard-frog-2 beg amp)
;; rocky 57 2
- (let* ((start (seconds->samples beg))
- (dur 1.53)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.108 0.118 0.596 0.167 0.719 0.357 0.827 0.604 0.838 0.745 0.912 0.860 1.000 0.929 0.962 0.984 0.831 1.000 0.000)
- :duration dur :scaler amp))
-
- (frqf2 (make-env '(0.000 0.198 0.021 0.209 0.110 0.239 0.178 0.239 0.294 0.247 0.343 0.260 0.463 0.255
- 0.593 0.265 0.704 0.252 0.788 0.244 0.881 0.228 0.941 0.204 1.000 0.18)
- :duration dur :scaler 6100.0))
- (frqf1 (make-env '(0.000 0.086 0.462 0.110 1.000 0.118)
- :duration dur :scaler 6100.0))
- (frqf3 (make-env '(0.000 0.721 0.508 0.786 0.698 0.761 0.876 0.689 0.935 0.563 1.000 0.509)
- :duration dur :scaler 6100.0))
- (frqf4 (make-env '(0 7200 .5 7600 .9 7000 1 5400) :duration dur))
-
- (frm1 (make-formant 900 .995))
- (frm2 (make-formant 1260 .99))
- (frm3 (make-formant 4500 .99))
- (frm4 (make-formant 7200 .9))
-
- (ampfr1 (make-env '(0 .5 1 3) :duration dur :scaler (* 2 5 (sin (hz->radians 900))) :base 3))
- (ampfr2 (make-env '(0 .25 .5 .4 1 1) :duration dur :scaler (* 2 5 (sin (hz->radians 1260)))))
- (ampfr4 (make-env '(0 0 .3 1 1 1) :duration dur :scaler (* 2 5 (sin (hz->radians 7200)))))
- (ampfr3 (* 2 5 (sin (hz->radians 4500))))
-
- (gen1 (make-rk!cos 100 13.0))
- (ampf1 (make-env '(0 1 1 0) :base 3 :duration dur))
-
- (pulse-dur .03)
- (pulse-samps (seconds->samples .045))
- (pulsef (make-env '(0.000 0.000 0.01 1 0.15 0.936 0.2 0.100 0.792 0.000 0.906 0.107 1.000 0.000)
- :duration pulse-dur))
- (pulse-frqf (make-env '(0 0 1 .9 2 1 ) :base .1 :duration pulse-dur :scaler (hz->radians 100)))
- (pulse-stop (+ start pulse-samps)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
-
- (if (>= i pulse-stop)
- (begin
- (set! (rk!cos-angle gen1) (* -0.1 pi))
- (set! pulse-stop (+ pulse-stop pulse-samps))
- (mus-reset pulse-frqf)
- (mus-reset pulsef)))
-
- (set! (mus-frequency frm1) (env frqf1))
- (set! (mus-frequency frm2) (env frqf2))
- (set! (mus-frequency frm3) (env frqf3))
- (set! (mus-frequency frm4) (env frqf4))
-
- (let ((val (* (env ampf)
- (env pulsef)
- (rk!cos gen1 (env pulse-frqf)))))
-
- (outa i (+ (* (env ampf1)
- val)
- (* (env ampfr1)
- (formant frm1 val))
- (* (env ampfr2)
- (formant frm2 val))
- (* ampfr3 (formant frm3 val))
- (* (env ampfr4)
- (formant frm4 val)))))))))
+ (let ((start (seconds->samples beg))
+ (dur 1.53)
+ (pulse-dur .03))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (pulse-samps (seconds->samples .045))
+ (pulse-out (seconds->samples pulse-dur))
+ (ampf (make-env '(0.000 0.108 0.118 0.596 0.167 0.719 0.357 0.827 0.604 0.838 0.745 0.912 0.860 1.000 0.929 0.962 0.984 0.831 1.000 0.000)
+ :duration dur :scaler amp))
+
+ (frqf2 (make-env '(0.000 0.198 0.021 0.209 0.110 0.239 0.178 0.239 0.294 0.247 0.343 0.260 0.463 0.255
+ 0.593 0.265 0.704 0.252 0.788 0.244 0.881 0.228 0.941 0.204 1.000 0.18)
+ :duration dur :scaler 6100.0))
+ (frqf1 (make-env '(0.000 0.086 0.462 0.110 1.000 0.118)
+ :duration dur :scaler 6100.0))
+ (frqf3 (make-env '(0.000 0.721 0.508 0.786 0.698 0.761 0.876 0.689 0.935 0.563 1.000 0.509)
+ :duration dur :scaler 6100.0))
+ (frqf4 (make-env '(0 7200 .5 7600 .9 7000 1 5400) :duration dur))
+
+ (frm1 (make-formant 900 .995))
+ (frm2 (make-formant 1260 .99))
+ (frm3 (make-formant 4500 .99))
+ (frm4 (make-formant 7200 .9))
+
+ (ampfr1 (make-env '(0 .5 1 3) :duration dur :scaler (* 2 5 (sin (hz->radians 900))) :base 3))
+ (ampfr2 (make-env '(0 .25 .5 .4 1 1) :duration dur :scaler (* 2 5 (sin (hz->radians 1260)))))
+ (ampfr4 (make-env '(0 0 .3 1 1 1) :duration dur :scaler (* 2 5 (sin (hz->radians 7200)))))
+ (ampfr3 (* 2 5 (sin (hz->radians 4500))))
+
+ (gen1 (make-rk!cos 100 13.0))
+ (ampf1 (make-env '(0 1 1 0) :base 3 :duration dur))
+
+ (pulsef (make-env '(0.000 0.000 0.01 1 0.15 0.936 0.2 0.100 0.792 0.000 0.906 0.107 1.000 0.000)
+ :duration pulse-dur))
+ (pulse-frqf (make-env '(0 0 1 .9 2 1 ) :base .1 :duration pulse-dur :scaler (hz->radians 100))))
+
+ (let ((fb (vector frm1 frm2 frm3 frm4))
+ (fs (float-vector 0.0 0.0 ampfr3 0.0))
+ (rk (make-float-vector pulse-out)))
+ (set! fb (make-formant-bank fb fs))
+
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+
+ (set! (mus-location ampf) (- i start))
+ (set! (mus-location ampf1) (- i start))
+ (set! (mus-location ampfr1) (- i start))
+ (set! (mus-location ampfr2) (- i start))
+ (set! (mus-location ampfr4) (- i start))
+
+ (set! (mus-location frqf1) (- i start))
+ (set! (mus-location frqf2) (- i start))
+ (set! (mus-location frqf3) (- i start))
+ (set! (mus-location frqf4) (- i start))
+ (set! (mus-location ampfr1) (- i start))
+ (set! (mus-location ampfr2) (- i start))
+ (set! (mus-location ampfr4) (- i start))
+
+ (set! (mus-frequency frm1) (env frqf1))
+ (set! (mus-frequency frm2) (env frqf2))
+ (set! (mus-frequency frm3) (env frqf3))
+ (set! (mus-frequency frm4) (env frqf4))
+
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf))
+ (val-amp (env ampf1)))
+
+ (set! (fs 0) (env ampfr1))
+ (set! (fs 1) (env ampfr2))
+ (set! (fs 3) (env ampfr4))
+
+ (do ((k 0 (+ k 1)))
+ ((= k pulse-out))
+ (set! (rk k) (rk!cos gen1 (env pulse-frqf))))
+
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((val (* pulse-amp
+ (env pulsef)
+ (rk (- k i)))))
+ ;(rk!cos gen1 (env pulse-frqf)))))
+ (outa k (+ (* val val-amp)
+ (formant-bank fb val)))))
+
+ (set! (mus-phase gen1) (* -0.1 pi))
+ (mus-reset pulse-frqf)
+ (mus-reset pulsef)))))))
-;; (with-sound (:play #t :statistics #t :clipped #f) (northern-leopard-frog-2 0 .5))
+;; (with-sound (:play #t :statistics #t) (northern-leopard-frog-2 0 .5))
@@ -644,95 +714,81 @@
;;;
;;; Green tree-frog
-(definstrument (green-tree-frog beg amp)
- (let* ((dur 0.2)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 8 1 12 0) :scaler amp :duration dur))
- (pitch 277)
- (gen2770 (make-oscil (* 10 pitch) (* 0.5 pi)))
- (mod277 (make-oscil pitch (* 0.5 pi)))
- (gen7479 (make-oscil (* pitch 27)))
- (poly (make-polywave pitch (list 3 .3 8 .2 9 .2 10 .9 11 1.0 12 .5)))
- (poly2 (make-polywave 860 (list 1 .4 2 .1 3 .03 4 .3 5 .03)))
- (index (hz->radians 277))
- (frqf (make-env '(0 -.3 1 .3 2 0 5 0 6 -1) :duration dur :scaler (hz->radians 70)))
- (pulsef (make-pulsed-env '(0 .2 1 1 3 .7 5 .2) (/ 1.0 pitch) pitch)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((md (* index (oscil mod277)))
+(defanimal (green-tree-frog beg amp)
+ (let ((dur 0.2)
+ (pitch 277)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 8 1 12 0) :scaler (* .333 amp) :duration dur))
+ (gen2770 (make-oscil (* 10 pitch) (* 0.5 pi)))
+ (mod277 (make-oscil pitch (* 0.5 pi)))
+ (gen7479 (make-oscil (* pitch 27)))
+ (poly (make-polywave pitch (list 3 (* .78 .3) 8 (* .78 .2) 9 (* .78 .2) 10 (* .78 .9) 11 0.78 12 (* .78 .5))))
+ (poly2 (make-polywave 860 (list 1 (* .25 .4) 2 (* .25 .1) 3 (* .25 .03) 4 (* .25 .3) 5 (* .25 .03))))
+ (index (hz->radians 277))
+ (frqf (make-env '(0 -.3 1 .3 2 0 5 0 6 -1) :duration dur :scaler (hz->radians 70)))
+ (pulsef (make-pulsed-env '(0 .2 1 1 3 .7 5 .2) (/ 1.0 pitch) pitch)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((md (* index (oscil mod277)))
(frq (env frqf)))
- (outa i (* (env ampf)
- (* .333 (pulsed-env pulsef frq))
- (+ (* .78 (polywave poly frq))
- (* .2 (oscil gen2770 (* 10 (+ frq md))))
- (* .02 (oscil gen7479 (* 27 (+ frq md))))
- (* .25 (polywave poly2 (* 3 frq)))))))))))
+ (outa i (* (env ampf)
+ (pulsed-env pulsef frq)
+ (+ (polywave poly frq)
+ (* .2 (oscil gen2770 (* 10 (+ frq md))))
+ (* .02 (oscil gen7479 (* 27 (+ frq md))))
+ (polywave poly2 (* 3.0 frq))))))))))
-;; (with-sound () (green-tree-frog 0 .5))
+;; (with-sound (:play #t) (green-tree-frog 0 .5))
;;; --------------------------------------------------------------------------------
;;;
;;; Pinewoods tree-frog
-(definstrument (pinewoods-tree-frog beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 20 1 21 0) :scaler amp :duration dur))
-
- (pulse-dur .009)
- (pulsef (make-env '(0.000 0.000 0.065 0.5 0.117 0.85 0.179 1.0 0.236 0.9 0.503 0.4 0.606 0.2 1.000 0.000) :duration pulse-dur))
- (pulses (if (> (random 1.0) .6) 5 4))
- (pulse-amps (vct .7 .9 1.0 .9 .6))
-
- (pitch 205.0)
- (gen1 (make-oscil (* 10 pitch) (* 0.5 pi)))
- (gen3 (make-oscil (* pitch 18) (* 0.5 pi)))
- (gen4 (make-oscil (* pitch 28) (* 0.5 pi)))
-
- (pulse-ctr 0)
- (next-pulse (seconds->samples pulse-dur))
- (pulse-beg start)
-
- (rnd (make-rand-interp (* 10 pitch) (hz->radians (* 3 pitch))))) ; not sure this actually helps
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
-
- (if (<= next-pulse 0)
- (begin
-
- (if (< pulse-ctr 3)
- (set! (mus-frequency gen1) (* pitch 10))
- (set! (mus-frequency gen1) (* pitch 11)))
-
- (set! pulse-ctr (+ 1 pulse-ctr))
- (if (>= pulse-ctr pulses)
- (begin
- (set! pulse-ctr 0)
- (if (> (random 1.0) .6)
- (set! pulses 5)
- (set! pulses 4))
- (set! pulse-beg (+ pulse-beg (seconds->samples .078)))
- (set! next-pulse (- pulse-beg i)))
- (set! next-pulse (seconds->samples pulse-dur)))
-
- (mus-reset pulsef)
- (set! (mus-phase gen1) (* 0.5 pi))
- (set! (mus-phase gen3) (* 0.5 pi))
- (set! (mus-phase gen4) (* 0.5 pi))))
-
- (let* ((noise (rand-interp rnd))
- (pulse-amp (pulse-amps pulse-ctr)))
- (outa i (* (env ampf)
- (env pulsef)
- pulse-amp
- (+ (* .9 (oscil gen1 (* .1 noise)))
- (* .08 (oscil gen3 (* .18 noise)))
- (* .02 (oscil gen4 (* .28 noise)))))))
- (set! next-pulse (- next-pulse 1))))))
+(defanimal (pinewoods-tree-frog beg dur amp)
+ (let ((pitch 205.0)
+ (pulse-dur .009)
+ (start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur))))
+ (let ((pulsef (make-env '(0.000 0.000 0.065 0.5 0.117 0.85 0.179 1.0 0.236 0.9 0.503 0.4 0.606 0.2 1.000 0.000) :duration pulse-dur))
+ (pulses (if (> (random 1.0) .6) 5 4))
+ (pulse-amps (apply vector (map (lambda (x) (* amp x)) '(.7 .9 1.0 .9 .6))))
+
+ (gen1 (make-oscil (* pitch 10) (* 0.5 pi)))
+ (gen3 (make-oscil (* pitch 18) (* 0.5 pi)))
+ (gen4 (make-oscil (* pitch 28) (* 0.5 pi)))
+
+ (pulse-samps (seconds->samples pulse-dur))
+ (pulse-sep (seconds->samples 0.078))
+
+ (rnd (make-rand-interp (* 10 pitch) (hz->radians (* 3 pitch))))) ; not sure this actually helps
+ (do ((i start (+ i pulse-sep)))
+ ((>= i stop))
+ (do ((pulse 0 (+ pulse 1))
+ (pulse-start i (+ pulse-start pulse-samps)))
+ ((= pulse pulses))
+ (let ((pulse-amp (pulse-amps pulse))
+ (pulse-stop (+ pulse-start pulse-samps)))
+
+ (if (< pulse 3)
+ (set! (mus-frequency gen1) (* pitch 10))
+ (set! (mus-frequency gen1) (* pitch 11)))
+
+ (do ((k pulse-start (+ k 1)))
+ ((= k pulse-stop))
+ (let ((noise (rand-interp rnd)))
+ (outa k (* pulse-amp
+ (env pulsef)
+ (+ (* .9 (oscil gen1 (* .1 noise)))
+ (* .08 (oscil gen3 (* .18 noise)))
+ (* .02 (oscil gen4 (* .28 noise))))))))
+ (mus-reset pulsef)
+ (set! (mus-phase gen1) (* 0.5 pi))
+ (set! (mus-phase gen3) (* 0.5 pi))
+ (set! (mus-phase gen4) (* 0.5 pi))))
+
+ (set! pulses (if (> (random 1.0) .6) 5 4))))))
;; (with-sound (:play #t) (pinewoods-tree-frog 0 1 .5))
@@ -741,74 +797,75 @@
;;;
;;; Squirrel tree frog
-(definstrument (squirrel-tree-frog-1 beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 30 1 31 0) :scaler amp :duration dur))
- (pitch 120)
- (gen1 (make-blackman pitch 4))
- (gen2 (make-oscil (* 10 pitch)))
- (gen3 (make-oscil (* 24 pitch)))
- (gen4 (make-oscil pitch))
- (index (hz->radians .1))
- (gen5 (make-oscil (* 14 pitch)))
- (gen6 (make-oscil (* 6 pitch)))
- (pulse-dur 0.24)
- (rnd (make-rand-interp 100 (hz->radians 5)))
- (frqf (make-env '(0 0 .2 0 .4 .75 .8 1 1.0 .5) :duration pulse-dur :scaler (hz->radians 15)))
- (pulsef (make-env '(0 0 .5 .7 2 1 3.5 .7 4 0) :duration pulse-dur))
- (pulser (make-pulse-train (/ 1.0 0.52)))
- (indf (make-env '(0 .3 1 .5 2 .5 3 0) :duration pulse-dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (> (pulse-train pulser) .1)
- (begin
- (mus-reset frqf)
- (mus-reset pulsef)
- (mus-reset indf)))
- (let* ((frq (env frqf))
- (ind (+ frq
- (* index (oscil gen4))
- (rand-interp rnd)))
- (intrp (env indf)))
- (outa i (* (env ampf)
- (env pulsef)
- (blackman gen1)
- (+ (* intrp (oscil gen2 (* 10 ind)))
- (* (- 1.0 intrp) (oscil gen3 (* 24 ind)))
- (* .1 (oscil gen5 (* 14 ind)))
- (* .1 (oscil gen6 (* 6 ind)))))))))))
-
-;; (with-sound (:play #t) (squirrel-tree-frog-1 0 1.0 .5))
+(defanimal (squirrel-tree-frog beg dur amp)
+ (let ((pitch 120)
+ (pulse-dur 0.24))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+
+ (gen1 (make-blackman pitch 4))
+ (gen2 (make-oscil (* 10 pitch)))
+ (gen3 (make-oscil (* 24 pitch)))
+ (gen4 (make-polywave pitch (list 1 (hz->radians .1))))
+ (gen5 (make-oscil (* 14 pitch)))
+ (gen6 (make-oscil (* 6 pitch)))
+
+ (rnd (make-rand-interp 100 (hz->radians 5)))
+ (frqf (make-env '(0 0 .2 0 .4 .75 .8 1 1.0 .5) :duration pulse-dur :scaler (hz->radians 15)))
+ (pulsef (make-env '(0 0 .5 .7 2 1 3.5 .7 4 0) :duration pulse-dur :scaler amp))
+ (pulse-samps (seconds->samples 0.52))
+ (pulse-out (seconds->samples pulse-dur))
+ (indf (make-env '(0 .3 1 .5 2 .5 3 0) :duration pulse-dur))
+ (indf-1 (make-env '(0 .3 1 .5 2 .5 3 0) :offset 1.0 :scaler -1.0 :duration pulse-dur)))
+
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-out))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((ind (+ (env frqf)
+ (polywave gen4)
+ (rand-interp rnd))))
+ (outa k (* (env pulsef)
+ (blackman gen1)
+ (+ (* (env indf) (oscil gen2 (* 10.0 ind)))
+ (* (env indf-1) (oscil gen3 (* 24.0 ind)))
+ (* .1 (oscil gen5 (* 14.0 ind)))
+ (* .1 (oscil gen6 (* 6.0 ind))))))))
+ (mus-reset frqf)
+ (mus-reset pulsef)
+ (mus-reset indf-1)
+ (mus-reset indf))))))
+
+;;; (with-sound (:play #t) (squirrel-tree-frog 0 1.0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Ornate chorus frog
-(definstrument (ornate-chorus-frog beg dur amp)
- (let* ((pulse-dur 0.024)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 .1 1 20 1 20.1 0) :scaler amp :duration dur))
- (pulsef (make-env '(0.000 0.000 0.057 0.445 0.124 0.797 0.220 0.977 0.337 1.000 0.477 0.987 0.634 0.907 0.760 0.791 0.828 0.475 0.913 0.206 1.000 0.000)
- :duration pulse-dur))
- (pitch 1210)
- (gen1 (make-polywave pitch (list 1 .02 2 .95 3 .01 4 .02 5 .01 6 .04 7 .01 8 .02)))
- (next-pulse (+ start (seconds->samples .4))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (= i next-pulse)
- (begin
- (mus-reset pulsef)
- (if (> (random 1.0) .8)
- (set! next-pulse (+ next-pulse (seconds->samples (+ .25 (random .3)))))
- (set! next-pulse (+ next-pulse (seconds->samples .4))))))
- (outa i (* (env ampf)
- (env pulsef)
- (polywave gen1)))))))
+(defanimal (ornate-chorus-frog beg dur amp)
+ (let ((pulse-dur 0.024)
+ (pitch 1210)
+ (start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur))))
+ (let ((pulsef (make-env '(0.000 0.000 0.057 0.445 0.124 0.797 0.220 0.977 0.337 1.000 0.477 0.987 0.634 0.907 0.760 0.791 0.828 0.475 0.913 0.206 1.000 0.000)
+ :scaler amp :duration pulse-dur))
+ (gen1 (make-polywave pitch '(1 .02 2 .95 3 .01 4 .02 5 .01 6 .04 7 .01 8 .02)))
+ (next-pulse (seconds->samples .4))
+ (pulse-samps (seconds->samples pulse-dur)))
+
+ (do ((i start (+ i next-pulse)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef) (polywave gen1))))
+ (mus-reset pulsef)
+ (if (> (random 1.0) .8)
+ (set! next-pulse (seconds->samples (+ .25 (random .3))))
+ (set! next-pulse (seconds->samples .4))))))))
;; (with-sound (:play #t) (ornate-chorus-frog 0 4 .5))
@@ -817,82 +874,81 @@
;;;
;;; Spring peeper
-(definstrument (spring-peeper beg amp)
- (let* (;; first note
- (dur 0.17)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 .25 .6 8 1 10 .8 10.5 0) :scaler amp :duration dur :base .03))
- (gen1 (make-oscil 2400))
- (gen2 (make-oscil (/ 2400 2)))
- (gen2a (make-oscil 2400))
- (frqf (make-env '(0 0 1 1) :scaler (hz->radians 600) :duration dur :base 30.0))
-
- ;; second note
- (pause 0.23)
- (start2 (+ stop (seconds->samples pause)))
- (dur2 .13)
- (stop2 (+ start2 (seconds->samples dur2)))
- (ampf2 (make-env '(0 0 .125 .8 1 .9 2 .7 4 1 10 0) :base .1 :duration dur2 :scaler (* .4 amp)))
- (frqf2 (make-env '(0 0 2 1 3 .75) :duration dur2 :base .03 :scaler (hz->radians 300)))
- (gen3 (make-oscil 2900))
- (gen4 (make-oscil (/ 2900 2)))
- (index (hz->radians (* 0.1 2900))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (env frqf)))
- (outa i (* (env ampf)
- (oscil gen1 (+ frq
- (* index
- (+ (* 0.2 (oscil gen2 (* 0.5 frq)))
- (* 1.5 (oscil gen2a frq)))))))))) ; end is not quite right (original has a catch)
- (do ((i start2 (+ i 1)))
- ((= i stop2))
- (let* ((frq (env frqf2)))
- (outa i (* (env ampf2)
- (oscil gen3 (+ frq (* index (oscil gen4 (* 0.5 frq))))))))))))
-
-;; (with-sound () (spring-peeper 0 .5))
+(defanimal (spring-peeper beg amp)
+ (let ((dur 0.17)
+ (pause 0.23)
+ (dur2 .13)
+ (index (hz->radians (* 0.1 2900))))
+ ;; first note
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 .25 .6 8 1 10 .8 10.5 0) :scaler amp :duration dur :base .03))
+ (gen1 (make-oscil 2400))
+ (gen2 (make-oscil 1200))
+ (gen2a (make-oscil 2400))
+ (frqf (make-env '(0 0 1 1) :scaler (hz->radians 600) :duration dur :base 30.0)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (oscil gen1 (+ frq
+ (* index
+ (+ (* 0.2 (oscil gen2 (* 0.5 frq)))
+ (* 1.5 (oscil gen2a frq)))))))))) ; end is not quite right (original has a catch)
+ ;; second note
+ (let ((start2 (+ stop (seconds->samples pause))))
+ (let ((stop2 (+ start2 (seconds->samples dur2)))
+ (ampf2 (make-env '(0 0 .125 .8 1 .9 2 .7 4 1 10 0) :base .1 :duration dur2 :scaler (* .4 amp)))
+ (frqf2 (make-env '(0 0 2 1 3 .75) :duration dur2 :base .03 :scaler (hz->radians 300)))
+ (gen3 (make-oscil 2900))
+ (gen4 (make-oscil 1450)))
+ (do ((i start2 (+ i 1)))
+ ((= i stop2))
+ (let ((frq (env frqf2)))
+ (outa i (* (env ampf2)
+ (oscil gen3 (+ frq (* index (oscil gen4 (* 0.5 frq))))))))))))))
+
+;; (with-sound (:play #t) (spring-peeper 0 .5))
;;;--------------------------------------------------------------------------------
;;;
;;; Crawfish frog
-(definstrument (crawfish-frog beg amp)
- (let* ((dur 0.6)
- (pitch 58)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 4 1 8 1 9 .7 10 0) :scaler amp :duration dur))
- (pulser (make-pulse-train pitch))
- (pulsef (make-env '(0 0 1 1 10 0) :base 32.0 :duration (/ 1.0 pitch)))
- (fmd (make-oscil pitch))
- (gen1 (make-oscil (* pitch 15)))
- (frqf (make-env '(0 .5 .2 0 1 1) :scaler (hz->radians pitch) :base 10.0 :duration dur))
- (index (hz->radians pitch))
- (poly1 (make-polywave (* pitch 6) '(1 .5 2 1 5 .5)))
- (poly2 (make-polywave (* pitch 6) '(2 .5 3 1 7 .25)))
- (intrp (make-env '(0 1 1 0) :duration dur :scaler .2 :base 4)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (env frqf))
- (wha (env intrp)))
- (if (> (pulse-train pulser) 0.1)
- (begin
- (mus-reset pulsef)
- (mus-reset gen1)
- (mus-reset fmd)))
- (outa i (* (env ampf)
- (env pulsef)
- (+ (* .5 (oscil gen1 (+ frq
- (* index (oscil fmd (/ frq 15))))))
- (* wha (polywave poly1 frq))
- (* (- 0.2 wha) (polywave poly2 frq))))))))))
-
-;; (with-sound () (crawfish-frog 0 .5))
+(defanimal (crawfish-frog beg amp)
+ (let ((dur 0.6)
+ (pitch 58))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 4 1 8 1 9 .7 10 0) :scaler amp :duration dur))
+ (pulse-samps (seconds->samples (/ 1.0 pitch)))
+ (pulsef (make-env '(0 0 1 1 10 0) :base 32.0 :duration (/ 1.0 pitch)))
+ (fmd (make-oscil pitch))
+ (gen1 (make-oscil (* pitch 15)))
+ (frqf (make-env '(0 .5 .2 0 1 1) :scaler (hz->radians pitch) :base 10.0 :duration dur))
+ (index (hz->radians pitch))
+ (poly1 (make-polywave (* pitch 6) '(1 .5 2 1 5 .5)))
+ (poly2 (make-polywave (* pitch 6) '(2 .5 3 1 7 .25)))
+ (intrp (make-env '(0 1 1 0) :duration dur :scaler .2 :base 4))
+ (intrp-1 (make-env '(0 0 1 1) :duration dur :scaler .2 :base .25)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-samps)))
+ (pulse-amp (env ampf)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((frq (env frqf)))
+ (outa k (* pulse-amp
+ (env pulsef)
+ (+ (* .5 (oscil gen1 (+ frq (* index (oscil fmd (* frq .067))))))
+ (* (env intrp) (polywave poly1 frq))
+ (* (env intrp-1) (polywave poly2 frq)))))))
+ (mus-reset pulsef)
+ (mus-reset gen1)
+ (mus-reset fmd))))))
+
+;; (with-sound (:play #t) (crawfish-frog 0 .5))
;;; --------------------------------------------------------------------------------
@@ -902,86 +958,95 @@
;;; original formants were much sharper, but using rxyk!cos to sharpen ours didn't seem to help
;;; animal seems to group these in 3's
-(definstrument (river-frog beg amp)
- (let* ((dur 1.85)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 2 1 7 .9 10 0) :scaler amp :duration dur :base .1))
- (pulse-pitch 42)
- (pulsef (make-pulsed-env '(0 .1 3 .1 3.1 1 4 1 6 .1 9 .1) (/ 1.0 pulse-pitch) pulse-pitch))
- (mid-pitch 185)
- (mid-pitch-change 10)
- (frqf (make-env '(0 .1 .2 -.02 .5 0 .65 0 1 1) :scaler (hz->radians mid-pitch-change) :duration dur))
- (vib (make-rand-interp 100 (hz->radians 10.0)))
- (fm (make-oscil pulse-pitch))
- (index (hz->radians (* 1.0 pulse-pitch)))
- (poly1 (make-polywave mid-pitch (normalize-partials (list 2 1.2 4 .1 7 0.75 8 .1 10 .5))))
- (poly2 (make-polywave mid-pitch (normalize-partials (list 2 1.0 7 .5 9 .7 12 .01))))
- (interpf (make-env '(0 0 2 0 5 1 7 1) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (+ (env frqf)
- (rand-interp vib)
- (* index (oscil fm))))
- (intrp (env interpf)))
- (outa i (* (env ampf)
- (pulsed-env pulsef)
- (+ (* (- 1.0 intrp)
- (polywave poly1 frq))
- (* intrp
- (polywave poly2 frq))))))))))
-
-;; (with-sound () (river-frog 0 .5))
+(defanimal (river-frog beg amp)
+ (let ((dur 1.85)
+ (pulse-pitch 42)
+ (mid-pitch 185)
+ (mid-pitch-change 10))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 2 1 7 .9 10 0) :scaler amp :duration dur :base .1))
+ (pulsef #f)
+ (pulse-samps (seconds->samples (/ 1.0 pulse-pitch)))
+ (frqf (make-env '(0 .1 .2 -.02 .5 0 .65 0 1 1) :scaler (hz->radians mid-pitch-change) :duration dur))
+ (vib (make-rand-interp 100 (hz->radians 10.0)))
+ (fm (make-polywave pulse-pitch (list 1 (hz->radians pulse-pitch)) mus-chebyshev-second-kind))
+ ;; cheb2 is needed here to match the original code which used (* index (oscil fm))
+ ;; if cheb1, the main sideband is below rather than above, giving the frog a deeper call
+ ;; does this make any sense?!?
+ (poly1 (make-polywave mid-pitch (normalize-partials '(2 1.2 4 .1 7 0.75 8 .1 10 .5))))
+ (poly2 (make-polywave mid-pitch (normalize-partials '(2 1.0 7 .5 9 .7 12 .01))))
+ (interpf (make-env '(0 0 2 0 5 1 7 1) :duration dur))
+ (interpf-1 (make-env '(0 0 2 0 5 1 7 1) :duration dur :offset 1.0 :scaler -1.0)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-samps)))
+ (pulse-amp (env ampf)))
+ (set! pulsef (make-env '(0 .1 3 .1 3.1 1 4 1 6 .1 9 .1) :scaler pulse-amp :duration (/ 1.0 pulse-pitch)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp vib)
+ (polywave fm))))
+ (outa k (* (env pulsef)
+ (+ (* (env interpf-1) (polywave poly1 frq))
+ (* (env interpf) (polywave poly2 frq))))))))))))
+
+
+;;; pulsed-env here was basically the same speed as using the nested do loop
+;;; pulsed-env doesn't buy us anything if there's no run-time modulation
+
+;; (with-sound (:play #t :statistics #t) (river-frog 0 .5))
;;; --------------------------------------------------------------------------------
;;;
;;; Bullfrog
-(definstrument (bullfrog beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.81)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 2 1 3 0) :duration dur :scaler amp :base 10))
- (frqf (make-env '(0 0 1 6 2 0) :duration dur :scaler (hz->radians 1.0)))
-
- (f1 (make-rxyk!cos 200 (/ 100 200) 0.6))
- (f2 (make-rxyk!cos 230 (/ 100 230) 1.2))
-
- (f3 (make-rxyk!cos 600 (/ 100 600) 8.0))
- (f4 (make-rxyk!cos 630 (/ 100 630) 8.0))
-
- (rnd (make-rand-interp 4000 .2))
- (rnd1 (make-rand-interp 200 (hz->radians 2)))
-
- (frm1 (make-formant 400 .99))
- (frm2 (make-formant 1200 .98))
- (frm3 (make-formant 5000 .97))
-
- (frm1f (* 2 7.0 (sin (hz->radians 400))))
- (frm2f (* 2 14.0 (sin (hz->radians 1200))))
- (frm3f (* 2 4.0 (sin (hz->radians 5000))))
-
- (intrpf (make-env '(0 1 .6 0 1 1) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (+ (env frqf)
- (rand-interp rnd1)))
- (intrp (env intrpf))
- (val (* (env ampf)
- (+ .8 (rand-interp rnd))
- (+ (rxyk!cos f1 (* (/ 200 100) frq))
- (* .5 (rxyk!cos f2 (* (/ 230 100) frq)))
- (* .1 (rxyk!cos f3 (* (/ 600 100) frq)))
- (* .1 (rxyk!cos f4 (* (/ 630 100) frq)))))))
- (set! (mus-frequency frm2) (+ 1000 (* intrp 200)))
- (outa i (+ (* frm1f (formant frm1 val))
- (* frm2f (formant frm2 val))
- (* frm3f (formant frm3 val)))))))))
-
-;; (with-sound (:play #t) (bullfrog 0 .5))
+(defanimal (bullfrog beg amp)
+ (let ((start (seconds->samples beg))
+ (dur 0.81))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 2 1 3 0) :duration dur :scaler amp :base 10))
+ (frqf (make-env '(0 0 1 6 2 0) :duration dur :scaler (hz->radians 1.0)))
+
+ (f1 (make-rxyk!cos 200 (/ 100 200) 0.6))
+ (f2 (make-rxyk!cos 230 (/ 100 230) 1.2))
+
+ (f3 (make-rxyk!cos 600 (/ 100 600) 8.0))
+ (f4 (make-rxyk!cos 630 (/ 100 630) 8.0))
+
+ (rnd (make-rand-interp 4000 .2))
+ (rnd1 (make-rand-interp 200 (hz->radians 2)))
+
+ (frm1 (make-formant 400 .99))
+ (frm2 (make-formant 1200 .98))
+ (frm3 (make-formant 5000 .97))
+
+ (frm1f (* 2 7.0 (sin (hz->radians 400))))
+ (frm2f (* 2 14.0 (sin (hz->radians 1200))))
+ (frm3f (* 2 4.0 (sin (hz->radians 5000))))
+
+ (intrpf (make-env '(0 1 .6 0 1 1) :offset 1000.0 :scaler 200.0 :duration dur)))
+
+ (let ((fb (vector frm1 frm2 frm3))
+ (fs (float-vector frm1f frm2f frm3f)))
+ (set! fb (make-formant-bank fb fs))
+
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd1))))
+ (mus-set-formant-frequency frm2 (env intrpf))
+ (outa i (formant-bank fb (* (env ampf)
+ (+ .8 (rand-interp rnd))
+ (+ (rxyk!cos f1 (* 2.0 frq))
+ (* .5 (rxyk!cos f2 (* 2.3 frq)))
+ (* .1 (rxyk!cos f3 (* 6.0 frq)))
+ (* .1 (rxyk!cos f4 (* 6.3 frq)))))))))))))
+
+;; (with-sound (:statistics #t) (bullfrog 0 .5))
;;; --------------------------------------------------------------------------------
@@ -990,30 +1055,30 @@
(define (texas-toad beg1 dur1 amp1)
- (definstrument (texas-toad-1 beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 .1 1 25 1 26 0) :duration dur :scaler amp))
- (pulse-dur .0173)
- (gen (make-polywave 2460 (list 1 .9 2 .01 3 .05 4 .005 5 .01)))
- (pulsef (make-env '(0 0 1 1 3 1 4 0) :duration pulse-dur))
- (pulse2 (make-blackman (/ 4.0 pulse-dur) 2))
- (pulser (make-pulse-train (/ 1.0 .02666)))
- (rnd (make-rand-interp 4000 (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (> (pulse-train pulser) .1)
- (begin
- (mus-reset pulsef)
- (mus-reset pulse2)))
- (outa i (* (env ampf)
- (env pulsef)
- (blackman pulse2)
- (polywave gen (rand-interp rnd))))))))
+ (defanimal (texas-toad-1 beg dur amp)
+ (let ((pulse-dur .0173))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen (make-polywave 2460 '(1 .9 2 .01 3 .05 4 .005 5 .01)))
+ (pulsef (make-env '(0 0 1 1 3 1 4 0) :duration pulse-dur :scaler amp))
+ (pulse2 (make-blackman (/ 4.0 pulse-dur) 2))
+ (pulse-samps (seconds->samples .02666))
+ (pulse-out (seconds->samples pulse-dur))
+ (rnd (make-rand-interp 4000 (hz->radians 200))))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (+ i pulse-out)))
+ (if (<= reset-stop stop)
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (blackman pulse2)
+ (polywave gen (rand-interp rnd))))))
+ (mus-reset pulsef)
+ (mus-reset pulse2))))))
(let ((last-dur 0.0)
- (last-call (+ beg1 dur1 (- 0.4))))
+ (last-call (+ beg1 dur1 -0.4)))
(do ((call-beg beg1 (+ call-beg last-dur 0.3 (random 0.2))))
((>= call-beg last-call))
(set! last-dur (+ .6 (random .25)))
@@ -1026,30 +1091,37 @@
;;;
;;; American toad
-(definstrument (american-toad beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 4 1 20 1 21 0) :duration dur :scaler amp))
- (gen1 (make-polywave 0.0 (list 1 .94 2 .03 3 .01 4 .003 5 .005 7 .002)))
- (pulse-dur .024)
- (frqf (make-env '(0 150 .1 250 .5 300 .9 200 1 0) :duration pulse-dur :scaler (hz->radians 1.0)))
- (pulsef (make-env '(0.000 0.000 0.147 0.700 0.261 0.968 0.405 0.996 0.601 0.830 0.878 0.198 1.000 0.000) :duration pulse-dur))
- (pulse-sep .045)
- (pulse-samps (seconds->samples pulse-sep))
- (next-pulse (+ start pulse-samps))
- (pulse-frqf (make-env (list 0 1100 .4 1300 dur (- 1300 (* dur 8))) :duration dur :scaler (hz->radians 1.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (set! next-pulse (+ i pulse-samps))
- (mus-reset pulsef)
- (mus-reset frqf)))
- (outa i (* (env ampf)
- (env pulsef)
- (polywave gen1 (+ (env frqf)
- (env pulse-frqf)))))))))
+(defanimal (american-toad beg dur amp)
+ (let ((pulse-dur .024)
+ (pulse-sep .045)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (pulse-samps (seconds->samples pulse-sep))
+ (pulse-out (seconds->samples pulse-dur))
+ (ampf (make-env '(0 0.05 4 1 20 1 21 0) :duration dur :scaler amp))
+ (gen1 #f)
+ (frqf (make-env '(0 150 .1 250 .5 300 .9 200 1 0) :duration pulse-dur :scaler (hz->radians 1.0)))
+ (pulsef (make-env '(0.000 0.000 0.147 0.700 0.261 0.968 0.405 0.996 0.601 0.830 0.878 0.198 1.000 0.000) :duration pulse-dur))
+ (pulse-frqf (make-env (list 0 1100 .4 1300 dur (- 1300 (* dur 8))) :duration dur :scaler (hz->radians 1.0))))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! gen1 (make-polywave 0.0 (list 1 (* pulse-amp .94)
+ 2 (* pulse-amp .03)
+ 3 (* pulse-amp .01)
+ 4 (* pulse-amp .003)
+ 5 (* pulse-amp .005)
+ 7 (* pulse-amp .002))))
+ (set! (mus-location ampf) (- i start))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (polywave gen1 (+ (env frqf)
+ (env pulse-frqf))))))
+ (mus-reset pulsef)
+ (mus-reset frqf))))))
;; (with-sound (:play #t) (american-toad 0 2 .25))
@@ -1058,34 +1130,45 @@
;;;
;;; Plains spadefoot
-(definstrument (plains-spadefoot beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.73)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.098 0.423 0.310 0.747 0.630 0.929 0.785 0.830 0.902 0.553 1.000 0.000) :scaler amp :duration dur))
- (gen1 (make-oscil))
- (gen2 (make-polywave 0.0 (list 1 .01 2 .01 6 .01 8 .1 10 .01)))
- (ampf2 (make-env '(0 0 .3 0 .8 1 1 1) :duration dur :scaler 0.4))
- (pulse-dur .019)
- (frqf (make-env '(0 1520 .4 1650 1 1630) :duration dur :scaler (hz->radians 1.0)))
- (pulsef (make-env '(0.000 0.000 0.03 1.000 0.08 1.0 0.160 0.486 0.304 0.202 0.508 0.087 1.000 0.000) :duration pulse-dur))
- (pulse-samps (seconds->samples pulse-dur))
- (next-pulse (+ start pulse-samps))
- (rnd (make-rand-interp 100 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (set! next-pulse (+ i pulse-samps))
- (mus-reset pulsef)))
- (let* ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (env pulsef)
- (+ (oscil gen1 frq)
- (* (env ampf2)
- (polywave gen2 (* 0.25 frq)))))))))))
+(defanimal (plains-spadefoot beg amp)
+ (let ((dur 0.73)
+ (pulse-dur .019)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (pulse-samps (seconds->samples pulse-dur))
+ (ampf (make-env '(0.000 0.000 0.098 0.423 0.310 0.747 0.630 0.929 0.785 0.830 0.902 0.553 1.000 0.000) :scaler amp :duration dur))
+ (gen1 (make-oscil))
+ (gen2 #f)
+ (ampf2 (make-env '(0 0 .3 0 .8 1 1 1) :duration dur :scaler 0.4))
+ (frqf (make-env '(0 1520 .4 1650 1 1630) :duration dur :scaler (hz->radians 1.0)))
+ (pulsef #f)
+ (rnd (make-rand-interp 100 (hz->radians 100))))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (set! (mus-location frqf) (- i start))
+ (set! (mus-location ampf2) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-samps)))
+ (pulse-amp (env ampf))
+ (pulse-amp2 (env ampf2))
+ (pulse-frq (env frqf)))
+ (if (= pulse-amp2 0.0)
+ (set! gen2 (make-polywave 0.0 (list 1 0.0)))
+ (set! gen2 (make-polywave 0.0 (list 1 (* pulse-amp2 .01)
+ 2 (* pulse-amp2 .01)
+ 6 (* pulse-amp2 .01)
+ 8 (* pulse-amp2 .1)
+ 10 (* pulse-amp2 .01)))))
+ (set! pulsef (make-env (list 0.000 0.000 0.03 pulse-amp 0.08 pulse-amp
+ 0.160 (* pulse-amp 0.486) 0.304 (* pulse-amp 0.202)
+ 0.508 (* pulse-amp 0.087) 1.000 0.000)
+ :duration pulse-dur))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((frq (+ pulse-frq (rand-interp rnd))))
+ (outa k (* (env pulsef)
+ (+ (oscil gen1 frq)
+ (polywave gen2 (* 0.25 frq))))))))))))
;; (with-sound (:play #t) (plains-spadefoot 0 .5))
@@ -1094,37 +1177,36 @@
;;;
;;; Barking tree-frog
-(definstrument (barking-tree-frog beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.165)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.015 0.131 0.038 0.110 0.066 0.621 0.078 0.488 0.090 0.977 0.104 0.423
- 0.108 0.013 0.113 0.504 0.122 0.005 0.129 0.979 0.138 0.337 0.142 0.470 0.152 0.008
- 0.156 0.561 0.160 0.008 0.165 1.000 0.177 0.535 0.183 0.744 0.189 0.290 0.193 0.731
- 0.200 0.381 0.209 0.977 0.217 0.499 0.237 0.846 0.247 0.896 0.260 0.898 0.464 0.846
- 0.623 0.689 0.801 0.305 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 480 .3 430 1 425) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (normalize-partials (list 1 .9 2 .06 3 .25 4 .79 5 .18 6 .03 7 .02 8 .03 9 .01 10 .02 11 .005 12 .005))))
- (rnd (make-rand-interp 1000 (hz->radians 10)))
-
- (gen2 (make-oscil))
- (frqf2 (make-env '(0 4750 .2 4790 .5 4710 1 4300) :duration dur :scaler (hz->radians 1.0)))
- (attack (make-rand-interp 4000 (hz->radians 400)))
- (gen3 (make-oscil 1720))
- (attackf (make-env '(0.000 0.000 0.068 0.000 0.093 0.614 0.098 0.000 0.114 0.000 0.120 0.969 0.131 0.000
- 0.155 0.000 0.159 0.997 0.175 0.000 0.198 0.000 0.2 1.000 0.224 0.000 0.241 0.000
- 0.243 0.984 0.260 0.000 1.000 0.000)
- :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (+ (* (env ampf)
- (+ (polywave gen1 (+ (env frqf)
- (rand-interp rnd)))
- (* .02 (oscil gen2 (env frqf2)))))
- (* (env attackf)
- (oscil gen3 (rand-interp attack)))))))))
+(defanimal (barking-tree-frog beg amp)
+ (let ((dur 0.165))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.015 0.131 0.038 0.110 0.066 0.621 0.078 0.488 0.090 0.977 0.104 0.423
+ 0.108 0.013 0.113 0.504 0.122 0.005 0.129 0.979 0.138 0.337 0.142 0.470 0.152 0.008
+ 0.156 0.561 0.160 0.008 0.165 1.000 0.177 0.535 0.183 0.744 0.189 0.290 0.193 0.731
+ 0.200 0.381 0.209 0.977 0.217 0.499 0.237 0.846 0.247 0.896 0.260 0.898 0.464 0.846
+ 0.623 0.689 0.801 0.305 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 480 .3 430 1 425) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 .9 2 .06 3 .25 4 .79 5 .18 6 .03 7 .02 8 .03 9 .01 10 .02 11 .005 12 .005))))
+ (rnd (make-rand-interp 1000 (hz->radians 10)))
+
+ (gen2 (make-oscil))
+ (frqf2 (make-env '(0 4750 .2 4790 .5 4710 1 4300) :duration dur :scaler (hz->radians 1.0)))
+ (attack (make-rand-interp 4000 (hz->radians 400)))
+ (gen3 (make-oscil 1720))
+ (attackf (make-env '(0.000 0.000 0.068 0.000 0.093 0.614 0.098 0.000 0.114 0.000 0.120 0.969 0.131 0.000
+ 0.155 0.000 0.159 0.997 0.175 0.000 0.198 0.000 0.2 1.000 0.224 0.000 0.241 0.000
+ 0.243 0.984 0.260 0.000 1.000 0.000)
+ :duration dur :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (+ (* (env ampf)
+ (+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd)))
+ (* .02 (oscil gen2 (env frqf2)))))
+ (* (env attackf)
+ (oscil gen3 (rand-interp attack)))))))))
;; (with-sound (:play #t) (barking-tree-frog 0 .5))
@@ -1133,45 +1215,44 @@
;;;
;;; Western toad
-(definstrument (western-toad beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen (make-polywave :partials (list 1 .95 2 .02 3 .03 4 .005)))
- (ampf (make-env '(0 0 1 1 8 1 9 0) :duration dur :scaler amp))
- (cur-start start)
- (cur-is-long #t))
- (do ()
- ((>= cur-start stop))
- (let* ((pulse-samps (seconds->samples (if cur-is-long
- (+ 0.04 (random .04))
- (+ .01 (random .02)))))
- (pulse-ampf (make-env (if cur-is-long
- (vct 0 0 .1 .5 2 1 3 0)
- (vct 0 0 1 1 1.5 .3 2 0))
- :scaler (if cur-is-long (+ .6 (random .4)) (+ .1 (random .7)))
- :length pulse-samps
- :base (if cur-is-long 6.0 3.0)))
- (pulse-frqf (make-env (if cur-is-long
- '(0 -.5 .5 0 1 -.3)
- '(0 -1 .1 0 1 0))
- :length pulse-samps
- :base .1
- :offset (hz->radians (if cur-is-long (if (> (random 1.0) .6) 1340 1260) 1200))
- :scaler (hz->radians (random 500.0)))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i pulse-samps))
- (outa (+ cur-start i)
- (* (env ampf)
- (env pulse-ampf)
- (polywave gen (env pulse-frqf))))))
-
- (if cur-is-long
- (set! cur-start (+ cur-start pulse-samps (seconds->samples (+ .015 (if (> (random 1.0) .8)
- (random .15)
- (random .04))))))
- (set! cur-start (+ cur-start pulse-samps (seconds->samples (+ .01 (random .01))))))
- (set! cur-is-long (or (not cur-is-long) (> (random 1.0) .3)))))))
+(defanimal (western-toad beg dur amp)
+ (let ((start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (gen (make-polywave 0.0 '(1 .95 2 .02 3 .03 4 .005)))
+ (cur-start start)
+ (cur-is-long #t))
+ (do ()
+ ((>= cur-start stop))
+ (let ((pulse-samps (seconds->samples (if cur-is-long
+ (+ 0.04 (random .04))
+ (+ .01 (random .02))))))
+ (let ((pulse-ampf (make-env (if cur-is-long
+ (vector 0 0 .1 .5 2 1 3 0)
+ (vector 0 0 1 1 1.5 .3 2 0))
+ :scaler (* amp (if cur-is-long (+ .6 (random .4)) (+ .1 (random .7))))
+ :length pulse-samps
+ :base (if cur-is-long 6.0 3.0)))
+ (pulse-frqf (make-env (if cur-is-long
+ '(0 -.5 .5 0 1 -.3)
+ '(0 -1 .1 0 1 0))
+ :length pulse-samps
+ :base .1
+ :offset (hz->radians (if cur-is-long (if (> (random 1.0) .6) 1340 1260) 1200))
+ :scaler (hz->radians (random 500.0))))
+ (cur-end (+ cur-start pulse-samps)))
+ (do ((i cur-start (+ i 1)))
+ ((= i cur-end))
+ (outa i (* (env pulse-ampf)
+ (polywave gen (env pulse-frqf)))))
+
+ (if cur-is-long
+ (set! cur-start (+ cur-end
+ (seconds->samples (+ .015 (if (> (random 1.0) .8)
+ (random .15)
+ (random .04))))))
+ (set! cur-start (+ cur-end
+ (seconds->samples (+ .01 (random .01))))))
+ (set! cur-is-long (or (not cur-is-long) (> (random 1.0) .3)))))))))
;; (with-sound (:play #t) (western-toad 0 2 .5))
@@ -1180,32 +1261,35 @@
;;;
;;; Southwestern toad
-(definstrument (southwestern-toad beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env (list 0 0 1.3 1 dur 1 (* 1.01 dur) 0) :duration dur :scaler amp :base .3))
- (frqf (make-env (list 0 940 1 1230 dur 1230) :base 3.0 :duration dur :scaler (hz->radians 1.0) :offset (hz->radians -300)))
- (gen1 (make-polywave :partials (list 1 .95 2 .02 3 .03)))
- (rnd (make-rand-interp 4000 (hz->radians 80)))
- (pulse-dur 0.0135)
- (pulse-space 0.0236)
- (pulse-samps (seconds->samples pulse-space))
- (pulse-ampf (make-env '(0 0 1 1 1.5 1 2 .5 3 0) :base .3 :duration pulse-dur))
- (pulse-frqf (make-env '(0 0 .3 .8 1.5 1 2.7 .8 3 .3) :duration pulse-dur :scaler (hz->radians 300)))
- (next-pulse (+ start pulse-samps)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)
- (set! next-pulse (+ next-pulse pulse-samps))))
- (outa i (* (env ampf)
- (env pulse-ampf)
- (polywave gen1 (+ (env frqf)
- (env pulse-frqf)
- (rand-interp rnd)))))))))
+(defanimal (southwestern-toad beg dur amp)
+ (let ((pulse-dur 0.0135)
+ (pulse-space 0.0236)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (pulse-samps (seconds->samples pulse-space))
+ (pulse-out (seconds->samples pulse-dur))
+ (ampf (make-env (list 0 0 1.3 1 dur 1 (* 1.01 dur) 0) :duration dur :scaler amp :base .3))
+ (frqf (make-env (list 0 940 1 1230 dur 1230) :base 3.0 :duration dur :scaler (hz->radians 1.0) :offset (hz->radians -300)))
+ (gen1 #f)
+ (rnd (make-rand-interp 4000 (hz->radians 80)))
+ (pulse-ampf (make-env '(0 0 1 1 1.5 1 2 .5 3 0) :base .3 :duration pulse-dur))
+ (pulse-frqf (make-env '(0 0 .3 .8 1.5 1 2.7 .8 3 .3) :duration pulse-dur :scaler (hz->radians 300))))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! (mus-location ampf) (- i start))
+ (set! (mus-location frqf) (- i start))
+ (set! gen1 (make-polywave 0.0 (list 1 (* pulse-amp .95) 2 (* pulse-amp .02) 3 (* pulse-amp .03))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulse-ampf)
+ (polywave gen1 (+ (env frqf)
+ (env pulse-frqf)
+ (rand-interp rnd))))))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf))))))
;; (with-sound (:play #t) (southwestern-toad 0 2 .5))
@@ -1214,108 +1298,112 @@
;;;
;;; Great Plains Narrow-mouthed toad
-(definstrument (great-plains-narrow-mouthed-toad beg dur1 amp)
+(defanimal (great-plains-narrow-mouthed-toad beg dur1 amp)
;; rocky 75 28
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples (max dur1 0.3))))
-
- ;; attack portion
- (attack-dur 0.155)
- (attack-stop (seconds->samples (+ beg attack-dur)))
- (attack-ampf (make-env '(0.000 0.000 0.015 0.078 0.020 0.289 0.042 0.000 0.057 0.000 0.069 0.409 0.093 0.425
- 0.101 0.520 0.113 0.588 0.141 0.218 0.159 0.537 0.182 0.695 0.221 0.140 0.223 0.640
- 0.233 0.872 0.253 0.602 0.269 0.000 0.280 0.000 0.292 0.915 0.319 0.520 0.322 0.000
- 0.333 0.000 0.347 0.912 0.359 0.777 0.371 0.509 0.381 0.000 0.391 0.000 0.399 0.611
- 0.407 0.948 0.428 0.475 0.433 0.000 0.448 0.000 0.468 0.905 0.491 0.206 0.504 0.000
- 0.513 0.000 0.528 0.909 0.537 0.583 0.543 0.125 0.554 0.000 0.572 0.911 0.578 0.957
- 0.597 0.132 0.611 0.000 0.619 0.000 0.639 0.803 0.648 0.643 0.655 0.108 0.660 0.000
- 0.677 0.000 0.683 0.629 0.693 0.902 0.706 0.186 0.716 0.000 0.731 0.000 0.736 0.568
- 0.747 0.985 0.767 0.000 0.790 0.000 0.791 0.358 0.804 0.666 0.818 0.145 0.825 0.000
- 0.842 0.000 0.848 0.408 0.857 0.768 0.878 0.000 0.898 0.000 0.904 0.511 0.915 0.883
- 0.929 0.000 0.952 0.000 0.970 0.688 0.977 0.280 0.988 0.052 1.000 0.000)
- :duration attack-dur :scaler amp))
- (attack-frqf (make-env '(0.000 0.124 0.037 0.145 0.060 0.205 0.067 0.152 0.091 0.132 0.107 0.145 0.126 0.175
- 0.147 0.150 0.166 0.173 0.190 0.173 0.206 0.137 0.219 0.179 0.232 0.192 0.245 0.177
- 0.260 0.158 0.274 0.177 0.288 0.203 0.298 0.186 0.312 0.167 0.325 0.147 0.336 0.190
- 0.347 0.207 0.362 0.184 0.377 0.158 0.393 0.190 0.403 0.220 0.421 0.190 0.434 0.158
- 0.453 0.197 0.465 0.229 0.480 0.199 0.496 0.169 0.515 0.197 0.525 0.218 0.532 0.194
- 0.544 0.171 0.558 0.197 0.573 0.222 0.584 0.197 0.606 0.177 0.623 0.201 0.633 0.222
- 0.645 0.203 0.661 0.182 0.676 0.209 0.690 0.222 0.700 0.203 0.717 0.177 0.735 0.207
- 0.749 0.207 0.771 0.179 0.791 0.205 0.805 0.203 0.814 0.179 0.846 0.209 0.862 0.212
- 0.869 0.186 0.912 0.207 0.969 0.220 1.000 0.218)
- :duration attack-dur :scaler (hz->radians 8900.0)))
- (attack-gen1 (make-polywave :partials (list 1 .92 2 .05 3 .02 4 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i attack-stop))
- (outa i (* (env attack-ampf)
- (polywave attack-gen1 (env attack-frqf))))))
-
- ;; main portion
- (let* ((dur (- dur1 attack-dur))
- (ampf (make-env '(0 1 1 1 10 1 11 0) :duration dur :scaler amp))
- (frqf (make-env (list 0 2000 .9 2000 1 1700) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .92 2 .05 3 .02 4 .01)))
- (frqf2 (make-env '(0 0 .1 25 4 20) :duration dur :scaler (hz->radians 1.0)))
- (gen2 (make-ncos2 100 17))
- (gen3 (make-oscil 900))
- (gen4 (make-oscil 400))
- (low-ampf (make-env (list 0 0 .2 1 dur 1) :duration dur :scaler .15))
- (pulser (make-pulse-train 100))
- (pulse-ampf (make-env '(0.000 0.000 0.227 0.057 0.319 0.164 0.407 0.946 0.554 0.706 0.707 0.036 0.839 0.031
- 0.930 0.097 1.000 0.000) :duration .008))
- (rnd (make-rand-interp 20 (hz->radians 3))))
- (run
- (do ((i attack-stop (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf))
- (frq2 (+ (env frqf2)
- (rand-interp rnd))))
- (if (> (pulse-train pulser frq2) 0.1)
- (begin
- (mus-reset pulse-ampf)
- (set! (mus-phase gen1) (* pi .75))))
- (outa i (* (env ampf)
- (env pulse-ampf)
- (+ (* (env low-ampf)
- (+ (oscil gen3 (* 9 frq2))
- (oscil gen4 (* 4 frq2))))
- (polywave gen1 frq))))))))))
+ (let ((attack-dur 0.155))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg (max dur1 0.3))))
+
+ ;; attack portion
+ (attack-stop (seconds->samples (+ beg attack-dur)))
+ (attack-ampf (make-env '(0.000 0.000 0.015 0.078 0.020 0.289 0.042 0.000 0.057 0.000 0.069 0.409 0.093 0.425
+ 0.101 0.520 0.113 0.588 0.141 0.218 0.159 0.537 0.182 0.695 0.221 0.140 0.223 0.640
+ 0.233 0.872 0.253 0.602 0.269 0.000 0.280 0.000 0.292 0.915 0.319 0.520 0.322 0.000
+ 0.333 0.000 0.347 0.912 0.359 0.777 0.371 0.509 0.381 0.000 0.391 0.000 0.399 0.611
+ 0.407 0.948 0.428 0.475 0.433 0.000 0.448 0.000 0.468 0.905 0.491 0.206 0.504 0.000
+ 0.513 0.000 0.528 0.909 0.537 0.583 0.543 0.125 0.554 0.000 0.572 0.911 0.578 0.957
+ 0.597 0.132 0.611 0.000 0.619 0.000 0.639 0.803 0.648 0.643 0.655 0.108 0.660 0.000
+ 0.677 0.000 0.683 0.629 0.693 0.902 0.706 0.186 0.716 0.000 0.731 0.000 0.736 0.568
+ 0.747 0.985 0.767 0.000 0.790 0.000 0.791 0.358 0.804 0.666 0.818 0.145 0.825 0.000
+ 0.842 0.000 0.848 0.408 0.857 0.768 0.878 0.000 0.898 0.000 0.904 0.511 0.915 0.883
+ 0.929 0.000 0.952 0.000 0.970 0.688 0.977 0.280 0.988 0.052 1.000 0.000)
+ :duration attack-dur :scaler amp))
+ (attack-frqf (make-env '(0.000 0.124 0.037 0.145 0.060 0.205 0.067 0.152 0.091 0.132 0.107 0.145 0.126 0.175
+ 0.147 0.150 0.166 0.173 0.190 0.173 0.206 0.137 0.219 0.179 0.232 0.192 0.245 0.177
+ 0.260 0.158 0.274 0.177 0.288 0.203 0.298 0.186 0.312 0.167 0.325 0.147 0.336 0.190
+ 0.347 0.207 0.362 0.184 0.377 0.158 0.393 0.190 0.403 0.220 0.421 0.190 0.434 0.158
+ 0.453 0.197 0.465 0.229 0.480 0.199 0.496 0.169 0.515 0.197 0.525 0.218 0.532 0.194
+ 0.544 0.171 0.558 0.197 0.573 0.222 0.584 0.197 0.606 0.177 0.623 0.201 0.633 0.222
+ 0.645 0.203 0.661 0.182 0.676 0.209 0.690 0.222 0.700 0.203 0.717 0.177 0.735 0.207
+ 0.749 0.207 0.771 0.179 0.791 0.205 0.805 0.203 0.814 0.179 0.846 0.209 0.862 0.212
+ 0.869 0.186 0.912 0.207 0.969 0.220 1.000 0.218)
+ :duration attack-dur :scaler (hz->radians 8900.0)))
+ (attack-gen1 (make-polywave 0.0 '(1 .92 2 .05 3 .02 4 .01))))
+ (do ((i start (+ i 1)))
+ ((= i attack-stop))
+ (outa i (* (env attack-ampf)
+ (polywave attack-gen1 (env attack-frqf)))))
+
+ ;; main portion
+ (let ((dur (- dur1 attack-dur)))
+ (let ((ampf (make-env '(0 1 1 1 10 1 11 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 2000 .9 2000 1 1700) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .92 2 .05 3 .02 4 .01)))
+ (frqf2 (make-env '(0 0 .1 25 4 20) :duration dur :scaler (hz->radians 1.0)))
+ (gp (make-polywave 100 '(4 1 9 1)))
+ (low-ampf (make-env (list 0 0 .2 1 dur 1) :duration dur :scaler .15))
+ (pulser (make-pulse-train 100))
+ (pulse-ampf (make-env '(0.000 0.000 0.227 0.057 0.319 0.164 0.407 0.946 0.554 0.706 0.707 0.036 0.839 0.031
+ 0.930 0.097 1.000 0.000) :duration .008))
+ (rnd (make-rand-interp 20 (hz->radians 3)))
+ (pulse-amp amp)
+ (saved-frq (make-float-vector (floor (* .03 *clm-srate*)))) ; 100 hz in pulser, so this is 3 times bigger than expected
+ (last-stop attack-stop))
+ (pulse-train pulser 0.0) ; flush the startup pulse
+ (do ((i attack-stop (+ i 1))
+ (j 0 (+ j 1)))
+ ((= i stop))
+ (if (> (pulse-train pulser (float-vector-set! saved-frq j (+ (env frqf2) (rand-interp rnd)))) 0.1)
+ (begin
+ (do ((k 0 (+ k 1))
+ (n last-stop (+ n 1)))
+ ((= k j))
+ (outa n (* pulse-amp
+ (env pulse-ampf)
+ (+ (* (env low-ampf)
+ (polywave gp (ina k saved-frq)))
+ (polywave gen1 (env frqf))))))
+ (mus-reset pulse-ampf)
+ (set! (mus-location ampf) (- i attack-stop))
+ (set! pulse-amp (env ampf))
+ (set! (mus-phase gen1) (* pi .75))
+ (set! last-stop i)
+ (set! j 0)))))))))
;; (with-sound (:play #t) (great-plains-narrow-mouthed-toad 0 2 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Pacific chorus frog
-(definstrument (pacific-chorus-frog beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.25)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.011 0.147 0.023 0.131 0.028 0.034 0.059 0.000 0.063 0.153 0.067 0.113
- 0.072 0.391 0.081 0.095 0.088 0.052 0.102 0.025 0.124 0.000 0.131 0.452 0.139 0.327
- 0.144 0.099 0.156 0.097 0.160 0.048 0.186 0.000 0.194 0.438 0.200 0.366 0.201 0.156
- 0.211 0.063 0.247 0.000 0.256 0.628 0.268 0.154 0.274 0.190 0.285 0.027 0.296 0.059
- 0.309 0.031 0.312 0.481 0.322 0.939 0.331 0.314 0.351 0.061 0.363 0.099 0.374 0.056
- 0.377 0.438 0.389 0.858 0.394 0.467 0.403 0.241 0.414 0.197 0.415 0.127 0.425 0.075
- 0.436 0.090 0.441 0.526 0.454 0.869 0.471 0.239 0.490 0.029 0.503 0.117 0.505 0.485
- 0.514 0.811 0.528 0.415 0.538 0.088 0.552 0.056 0.561 0.106 0.580 0.075 0.597 0.000
- 0.776 0.000 0.777 0.573 0.786 0.145 0.801 0.054 0.826 0.000 0.827 0.632 0.844 1.000
- 0.856 0.524 0.866 0.031 0.883 0.074 0.891 0.136 0.896 0.745 0.907 0.424 0.915 0.765
- 0.934 0.059 0.951 0.048 0.962 0.079 0.970 0.436 0.986 0.266 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.220 0.074 0.249 0.133 0.249 0.194 0.240 0.258 0.252 0.324 0.264 0.389 0.267
- 0.456 0.270 0.520 0.264 0.847 0.270 0.920 0.273 1.000 0.279)
- :duration dur :scaler (hz->radians (* 0.5 0.205 22050.0))))
- (gen1 (make-polywave :partials (list 2 .35 3 .1 4 .8 5 .01 6 .03 8 .005)))
- (rnd (make-rand-interp 600 (hz->radians 50))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp rnd)))))))))
+(defanimal (pacific-chorus-frog beg amp)
+ (let ((dur 0.25))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.011 0.147 0.023 0.131 0.028 0.034 0.059 0.000 0.063 0.153 0.067 0.113
+ 0.072 0.391 0.081 0.095 0.088 0.052 0.102 0.025 0.124 0.000 0.131 0.452 0.139 0.327
+ 0.144 0.099 0.156 0.097 0.160 0.048 0.186 0.000 0.194 0.438 0.200 0.366 0.201 0.156
+ 0.211 0.063 0.247 0.000 0.256 0.628 0.268 0.154 0.274 0.190 0.285 0.027 0.296 0.059
+ 0.309 0.031 0.312 0.481 0.322 0.939 0.331 0.314 0.351 0.061 0.363 0.099 0.374 0.056
+ 0.377 0.438 0.389 0.858 0.394 0.467 0.403 0.241 0.414 0.197 0.415 0.127 0.425 0.075
+ 0.436 0.090 0.441 0.526 0.454 0.869 0.471 0.239 0.490 0.029 0.503 0.117 0.505 0.485
+ 0.514 0.811 0.528 0.415 0.538 0.088 0.552 0.056 0.561 0.106 0.580 0.075 0.597 0.000
+ 0.776 0.000 0.777 0.573 0.786 0.145 0.801 0.054 0.826 0.000 0.827 0.632 0.844 1.000
+ 0.856 0.524 0.866 0.031 0.883 0.074 0.891 0.136 0.896 0.745 0.907 0.424 0.915 0.765
+ 0.934 0.059 0.951 0.048 0.962 0.079 0.970 0.436 0.986 0.266 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.220 0.074 0.249 0.133 0.249 0.194 0.240 0.258 0.252 0.324 0.264 0.389 0.267
+ 0.456 0.270 0.520 0.264 0.847 0.270 0.920 0.273 1.000 0.279)
+ :duration dur :scaler (hz->radians (* 0.5 0.205 22050.0))))
+ (gen1 (make-polywave 0.0 '(2 .35 3 .1 4 .8 5 .01 6 .03 8 .005)))
+ (rnd (make-rand-interp 600 (hz->radians 50))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd)))))))))
;; (with-sound (:play #t) (pacific-chorus-frog 0 .5))
@@ -1324,31 +1412,33 @@
;;;
;;; Red-spotted toad
-(definstrument (red-spotted-toad beg dur amp)
+(defanimal (red-spotted-toad beg dur amp)
;; rocky 23 1
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env (list 0 0 .5 .8 .8 .8 .9 1 .98 1 1 0) :duration dur :scaler amp))
- (frqf (make-env (list 0 1900 .2 2200 .4 2250 .9 2200 1 2100) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .99 3 .005)))
- (rnd (make-rand-interp 1000 (hz->radians 40)))
-
- (pulse-dur 0.0138)
- (pulse-space 0.0234)
- (pulse-samps (seconds->samples pulse-space))
- (pulse-ampf (make-env '(0 0 1 1 1.25 1 2 .5 3 0) :base .3 :duration pulse-dur))
- (next-pulse (+ start pulse-samps)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (mus-reset pulse-ampf)
- (set! next-pulse (+ next-pulse pulse-samps))))
- (outa i (* (env ampf)
- (env pulse-ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp rnd)))))))))
+ (let ((pulse-dur 0.0138)
+ (pulse-space 0.0234)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (pulse-samps (seconds->samples pulse-space))
+ (pulse-out (seconds->samples pulse-dur))
+ (ampf (make-env '(0 0 .5 .8 .8 .8 .9 1 .98 1 1 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 1900 .2 2200 .4 2250 .9 2200 1 2100) :duration dur :scaler (hz->radians 1.0)))
+ (rnd (make-rand-interp 1000 (hz->radians 40)))
+ (gen1 #f)
+ (pulse-ampf (make-env '(0 0 1 1 1.25 1 2 .5 3 0) :base .3 :duration pulse-dur)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! gen1 (make-polywave 0.0 (list 1 (* pulse-amp .99) 3 (* pulse-amp .005))))
+ (set! (mus-location ampf) (- i start))
+ (set! (mus-location frqf) (- i start))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulse-ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd))))))
+ (mus-reset pulse-ampf))))))
;; (with-sound (:play #t) (red-spotted-toad 0 4 .5))
@@ -1357,34 +1447,34 @@
;;;
;;; Green toad
-(definstrument (green-toad beg dur amp)
+(defanimal (green-toad beg dur amp)
;; rocky 31 1
;; (an experiment with wave-train in place of pulsed env)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env (list 0 0 .2 .9 .3 .7 .4 1 (max .5 (- dur .01)) 1 (max .51 dur) 0) :duration dur :scaler amp))
- (frqf (make-env (list 0 2540 .2 3250 (max .5 dur) 3200) :base 10 :duration dur :scaler (hz->radians 1.0)))
- (wave-len 256)
- (pulse (let ((v (make-vct wave-len))
+ (let* ((wave-len 256)
+ (pulse (let ((v (make-float-vector wave-len 0.0))
(pulse-ampf (make-env '(0.000 0.000 0.063 0.312 0.277 0.937 0.405 1.000 0.617 0.696 0.929 0.146 2.000 0.000) :length wave-len)))
(do ((i 0 (+ i 1)))
((= i wave-len))
(set! (v i) (env pulse-ampf)))
- v))
- (pulse1 (make-wave-train 56.0 :wave pulse))
- (pulse2 (make-delay (seconds->samples .0078))) ; pulses come in pairs
- (gen1 (make-polywave :partials (list 1 .95 2 .04 3 .01)))
- (rnd (make-rand-interp 100 (hz->radians 2.0)))
- (rnd1 (make-rand-interp 1000 (hz->radians 80))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((val (wave-train pulse1 (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ val
- (delay pulse2 val))
- (polywave gen1 (+ (env frqf)
- (rand-interp rnd1))))))))))
+ v)))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env (list 0 0 .2 .9 .3 .7 .4 1 (max .5 (- dur .01)) 1 (max .51 dur) 0) :duration dur :scaler amp))
+ (frqf (make-env (list 0 2540 .2 3250 (max .5 dur) 3200) :base 10 :duration dur :scaler (hz->radians 1.0)))
+
+ (pulse1 (make-wave-train 56.0 :wave pulse))
+ (pulse2 (make-delay (seconds->samples .0078))) ; pulses come in pairs
+ (gen1 (make-polywave 0.0 '(1 .95 2 .04 3 .01)))
+ (rnd (make-rand-interp 100 (hz->radians 2.0)))
+ (rnd1 (make-rand-interp 1000 (hz->radians 80))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((val (wave-train pulse1 (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ val
+ (delay pulse2 val))
+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd1))))))))))
;; (with-sound (:play #t) (green-toad 0 1 .5))
@@ -1393,45 +1483,43 @@
;;;
;;; Little grass frog
-(definstrument (little-grass-frog beg amp)
+(defanimal (little-grass-frog beg amp)
;; frogs 26 8.5
-
- ;; initial note
- (let* ((start (seconds->samples beg))
- (dur .032)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.061 0.739 0.124 0.998 0.358 0.902 0.630 0.419 0.727
- 0.469 0.813 0.391 0.857 0.046 0.884 0.256 0.918 0.121 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.289 0.534 0.302 0.793 0.299 1.000 0.307)
- :duration dur :scaler (hz->radians (* 0.5 21900.0))))
- (gen1 (make-polywave :partials (list 1 .005 2 .97 3 .02 4 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf)))))))
-
- ;; 4 tinks
- (let ((begs (vct 0.085 0.118 0.141 0.162))
- (amps (vct 1.0 1.0 .8 .6))
- (frqs (vct 6840 6940 6890 6940)))
- (do ((call 0 (+ 1 call)))
- ((= call 4))
-
- (let* ((start (seconds->samples (+ beg (begs call))))
- (dur .01)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.082 0.967 0.149 1.000 0.183 0.977 0.299 0.529
- 0.334 0.595 0.451 0.312 0.520 0.176 0.639 0.155 0.753 0.077 1.000 0.000)
- :duration dur :scaler (* amp (amps call))))
- (frq (hz->radians (* 0.5 (frqs call))))
- (gen1 (make-polywave :partials (list 1 .005 2 .97 3 .02 4 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 frq)))))))))
+ (let ((dur .032))
+ ;; initial note
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.061 0.739 0.124 0.998 0.358 0.902 0.630 0.419 0.727
+ 0.469 0.813 0.391 0.857 0.046 0.884 0.256 0.918 0.121 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.289 0.534 0.302 0.793 0.299 1.000 0.307)
+ :duration dur :scaler (hz->radians (* 0.5 21900.0))))
+ (gen1 (make-polywave 0.0 '(1 .005 2 .97 3 .02 4 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))
+
+ ;; 4 tinks
+ (let ((begs (vector 0.085 0.118 0.141 0.162))
+ (amps (vector 1.0 1.0 .8 .6))
+ (frqs (vector 6840 6940 6890 6940)))
+ (do ((call 0 (+ call 1)))
+ ((= call 4))
+
+ (let ((start (seconds->samples (+ beg (begs call))))
+ (dur .01))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.082 0.967 0.149 1.000 0.183 0.977 0.299 0.529
+ 0.334 0.595 0.451 0.312 0.520 0.176 0.639 0.155 0.753 0.077 1.000 0.000)
+ :duration dur :scaler (* amp (amps call))))
+ (frq (hz->radians (* 0.5 (frqs call))))
+ (gen1 (make-polywave 0.0 '(1 .005 2 .97 3 .02 4 .01))))
+
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 frq))))))))))
;; (with-sound (:play #t) (little-grass-frog 0 .5))
@@ -1440,53 +1528,56 @@
;;;
;;; Sonoran desert toad
-(definstrument (sonoran-desert-toad beg dur amp)
+(defanimal (sonoran-desert-toad beg dur amp)
;; rocky 13 1
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env (list 0.000 0.000 0.011 0.201 0.193 0.704 0.338 0.878 0.593 0.986 0.865 0.972 0.954 0.895
- 0.970 0.645 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env (list 0.000 0.360 0.069 0.387 0.144 0.411 0.500 0.428 0.649 0.432 0.746 0.425 0.877 0.435
- 0.974 0.418 1.000 0.291)
- :duration dur :scaler (hz->radians 2800.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (ampf2 (make-env (list 0 .1 .05 1 .2 .1 .3 .01 (- dur .1) .1 dur 1) :duration dur :scaler .2))
- (gen3 (make-polywave :partials (list 3 .5 4 .2 5 .1 6 .08 7 .05 9 .03)))
- (ampf3 (make-env (list 0 .2 .1 1 (- dur .2) 1 dur .5) :duration dur :scaler .1))
- (rnd (make-rand-interp 4000 (hz->radians 200)))
-
- (env1 (vct 0 0 .6 1 1 0))
- (env2 (vct 0 0 .3 .7 .5 1 .8 .9 1 0))
- (env3 (vct 0 0 .2 .7 .3 .1 .5 1 .7 .8 1 0))
-
- (next-pulse start)
- (pulse-samps 0)
- (pulse-ampf #f))
- (do ((i start (+ i pulse-samps)))
- ((>= i stop))
- (if (>= i next-pulse)
- (let* ((pulse-dur (+ .01 (random .003)))
- (env-choice (random 3)))
- (set! pulse-ampf (make-env (if (= env-choice 0) env1
- (if (= env-choice 1) env2
- env3))
- :duration pulse-dur
- :scaler (+ .7 (random .3))))
- (set! pulse-samps (seconds->samples (+ pulse-dur (random 0.005))))
- (set! next-pulse (+ next-pulse pulse-samps))))
- (run
- (do ((k 0 (+ 1 k)))
- ((= k pulse-samps))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa (+ i k)
- (* (env ampf)
- (env pulse-ampf)
- (+ (* .7 (oscil gen1 frq))
- (* (env ampf2) (oscil gen2 (* 2 frq)))
- (* (env ampf3) (polywave gen3 frq)))))))))))
+ (let ((start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.011 0.201 0.193 0.704 0.338 0.878 0.593 0.986 0.865 0.972 0.954 0.895
+ 0.970 0.645 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.360 0.069 0.387 0.144 0.411 0.500 0.428 0.649 0.432 0.746 0.425 0.877 0.435
+ 0.974 0.418 1.000 0.291)
+ :duration dur :scaler (hz->radians 2800.0)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (ampf2 (make-env (list 0 .1 .05 1 .2 .1 .3 .01 (- dur .1) .1 dur 1) :duration dur :scaler .2))
+ (gen3 (make-polywave 0.0 '(3 .5 4 .2 5 .1 6 .08 7 .05 9 .03)))
+ (ampf3 (make-env (list 0 .2 .1 1 (- dur .2) 1 dur .5) :duration dur :scaler .1))
+ (rnd (make-rand-interp 4000 (hz->radians 200)))
+
+ (env1 (vector 0 0 .6 1 1 0))
+ (env2 (vector 0 0 .3 .7 .5 1 .8 .9 1 0))
+ (env3 (vector 0 0 .2 .7 .3 .1 .5 1 .7 .8 1 0))
+
+ (next-pulse start)
+ (pulse-samps 0)
+ (pulse-ampf #f))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (if (>= i next-pulse)
+ (let ((pulse-dur (+ .01 (random .003)))
+ (env-choice (random 3)))
+ (set! pulse-ampf (make-env (if (= env-choice 0) env1
+ (if (= env-choice 1) env2
+ env3))
+ :duration pulse-dur
+ :scaler (+ .7 (random .3))))
+ (set! pulse-samps (seconds->samples (+ pulse-dur (random 0.005))))
+ (set! next-pulse (+ next-pulse pulse-samps))))
+ (set! (mus-location ampf) (- i start))
+ (set! (mus-location frqf) (- i start))
+ (let ((pulse-end (+ i pulse-samps))
+ (pulse-amp (env ampf))
+ (pulse-frq (env frqf)))
+ (do ((k i (+ k 1)))
+ ((= k pulse-end))
+ (let ((frq (+ pulse-frq
+ (rand-interp rnd))))
+ (outa k (* pulse-amp
+ (env pulse-ampf)
+ (+ (* .7 (oscil gen1 frq))
+ (* (env ampf2) (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3) (polywave gen3 frq))))))))))))
;; (with-sound (:play #t) (sonoran-desert-toad 0 .8 .5))
@@ -1499,25 +1590,24 @@
(define (amargosa-toad beg1 amp1)
;; rocky 17 0
- (definstrument (amargosa-toad-1 beg dur frqscl frqenv ampscl ampenv)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env ampenv :duration dur :scaler ampscl))
- (frqf (make-env frqenv :duration dur :scaler (hz->radians frqscl)))
- (gen1 (make-polywave
- :partials
- (normalize-partials
- (list 1 1 2 .18 3 .19 4 .04 5 .03 6 .04 8 .01 9 .01 10 .005 11 .01 12 .005)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (let* ((begs (vct 0.0 0.15 0.325 0.47 0.61))
- (durs (vct 0.027 0.06 0.065 0.042 0.05))
- (amps (vct 0.9 1.0 1.0 0.4 0.1))
- (frqs (vct 14800 14020 (* 1/3 14800) 14800 (* 1/2 14800)))
+ (defanimal (amargosa-toad-1 beg dur frqscl frqenv ampscl ampenv)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env ampenv :duration dur :scaler ampscl))
+ (frqf (make-env frqenv :duration dur :scaler (hz->radians frqscl)))
+ (gen1 (make-polywave
+ :partials
+ (normalize-partials
+ '(1 1 2 .18 3 .19 4 .04 5 .03 6 .04 8 .01 9 .01 10 .005 11 .01 12 .005)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
+
+ (let ((begs (vector 0.0 0.15 0.325 0.47 0.61))
+ (durs (vector 0.027 0.06 0.065 0.042 0.05))
+ (amps (vector 0.9 1.0 1.0 0.4 0.1))
+ (frqs (vector 14800 14020 (* 1/3 14800) 14800 (* 1/2 14800)))
(ampenvs (vector '(0.000 0.000 0.085 0.906 0.117 1.000 0.328 0.909 0.715 0.464 0.892 0.118 1.000 0.000)
'(0.000 0.000 0.025 1.000 0.056 0.201 0.121 0.848 0.151 0.503 0.217 0.395 0.441 0.556
@@ -1536,7 +1626,7 @@
'(0.000 0.071 0.063 0.081 0.097 0.083 0.155 0.073 0.195 0.069 0.832 0.069 1.000 0.053)
'(0.000 0.120 0.132 0.128 0.218 0.126 0.272 0.120 0.326 0.120 0.513 0.120 0.730 0.118
1.000 0.096))))
- (do ((call 0 (+ 1 call)))
+ (do ((call 0 (+ call 1)))
((= call 5))
(amargosa-toad-1
(+ beg1 (begs call))
@@ -1559,33 +1649,31 @@
;;; close in spectrum, amp, freq, but the original has what sounds like a ton of reverb
;;; if I add the reverb, it's close -- is this really what this animal sounds like?
-(definstrument (indri beg amp)
- (let* ((pitch 900)
- (dur 1.5)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil (* 2 pitch)))
- (gen4 (make-oscil pitch))
- (gen2 (make-oscil (* 8 pitch)))
- (gen3 (make-oscil pitch))
- (ampf (make-env '(0.0 0.0 0.05 0.4 0.1 0.65 0.2 0.5 0.27 1.0 0.4 0.43 0.43 0.53
- 0.5 0.5 0.53 0.36 0.6 1.0 0.64 0.99 0.69 0.6 0.7 0.3 0.77 0.15
- 0.8 0.04 1.0 0.0) :duration dur :scaler amp))
- (frqf (make-env '(0 1 2 0 6 0 7 3 9 3) :scaler (hz->radians 60) :duration dur))
- (vib (make-oscil 2)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (+ (env frqf)
- (* (hz->radians 10) (oscil vib))))
- (md (+ (* 2 frq)
- (* .125 (oscil gen4 frq)))))
- (outa i (* (env ampf)
- (+ (* .9 (oscil gen1 md))
- (* .1 (oscil gen2 (+ (* 8 frq)
- (* .2 (oscil gen3 frq)))))))))))))
-
-;; (with-sound () (indri 0 .5))
+(defanimal (indri beg amp)
+ (let ((pitch 900)
+ (dur 1.5))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-polywave (* 2 pitch) '(1 .9)))
+ (gen4 (make-polywave pitch '(1 .125)))
+ (gen2 (make-polywave (* 8 pitch) '(1 .1)))
+ (gen3 (make-polywave pitch '(1 .2)))
+ (ampf (make-env '(0.0 0.0 0.05 0.4 0.1 0.65 0.2 0.5 0.27 1.0 0.4 0.43 0.43 0.53
+ 0.5 0.5 0.53 0.36 0.6 1.0 0.64 0.99 0.69 0.6 0.7 0.3 0.77 0.15
+ 0.8 0.04 1.0 0.0) :duration dur :scaler amp))
+ (frqf (make-env '(0 1 2 0 6 0 7 3 9 3) :scaler (hz->radians 60) :duration dur))
+ (vib (make-polywave 2 (list 1 (hz->radians 10)))))
+
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf) (polywave vib))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 (+ (* 2.0 frq)
+ (polywave gen4 frq)))
+ (polywave gen2 (+ (* 8.0 frq)
+ (polywave gen3 frq)))))))))))
+
+;; (with-sound (:play #t) (indri 0 .5))
;;; ================ Insects ================
@@ -1595,105 +1683,93 @@
;;;
;;; need to make freq env flicks at call time (is there a comb-filter effect as it gets near?)
-(definstrument (mosquito beg dur freq amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (carrier (make-oscil freq))
- (modulator1 (make-oscil (* freq 2))) ; or 1 (but leave lower mult at 2??)
- (modulator3 (make-oscil (* freq 3)))
- (modulator2 (make-oscil (* freq 8))) ; or 9
- (ampf (make-env '(0 0 .2 .5 1 .5 2 .5 3 1 4 .5 5 .5) :scaler amp :duration dur :base 32))
- (frqf (make-env '(0 0 1 0 1.01 0.1 1.03 -0.1 1.05 0.0 3 0 3.02 .05 3.03 -0.1 3.1 0 5 0.0) :duration dur :scaler (hz->radians freq)))
- (vib (make-rand-interp 10.0 (hz->radians 10)))
- (indf (make-rand-interp 1 .5))
- (index2 (hz->radians (* freq 1.0)))
- (index3 (hz->radians (* freq 0.5))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((amp (env ampf))
- (frq (+ (env frqf) (rand-interp vib)))
- (pitch (oscil carrier frq))
- (index1 (hz->radians (* freq (+ 1.0 (rand-interp indf))))))
- (outa i (* amp
- (+ (* 0.6 (oscil modulator1 (+ (* 2 frq) (* index1 pitch))))
- (* 0.3 (oscil modulator3 (+ (* 3 frq) (* index3 pitch))))
- (* 0.1 (oscil modulator2 (+ (* 8 frq) (* index2 pitch))))))))))))
-
+(defanimal (mosquito beg dur freq amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (carrier (make-oscil freq))
+ (modulator1 (make-polywave (* freq 2) '(1 .6))) ; or 1 (but leave lower mult at 2??)
+ (modulator3 (make-polywave (* freq 3) '(1 .3)))
+ (modulator2 (make-polywave (* freq 8) '(1 .1))) ; or 9
+ (ampf (make-env '(0 0 .2 .5 1 .5 2 .5 3 1 4 .5 5 .5 5.1 0) :scaler amp :duration dur :base 32))
+ (frqf (make-env '(0 0 1 0 1.01 0.1 1.03 -0.1 1.05 0.0 3 0 3.02 .05 3.03 -0.1 3.1 0 5 0.0) :duration dur :scaler (hz->radians freq)))
+ (vib (make-rand-interp 10.0 (hz->radians 10)))
+ (indf (make-rand-interp 1 .5))
+ (index2 (hz->radians (* freq 1.0)))
+ (index3 (hz->radians (* freq 0.5)))
+ (hfreq (hz->radians freq)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let* ((frq (+ (env frqf) (rand-interp vib)))
+ (pitch (oscil carrier frq)))
+ (outa i (* (env ampf)
+ (+ (polywave modulator1 (+ (* 2.0 frq) (* hfreq pitch (+ 1.0 (rand-interp indf)))))
+ (polywave modulator3 (+ (* 3.0 frq) (* index3 pitch)))
+ (polywave modulator2 (+ (* 8.0 frq) (* index2 pitch))))))))))
;; (with-sound (:play #t) (mosquito 0 5 560 .2) (mosquito 1 3 880 .05))
-
+;; (with-sound () (mosquito 0 1 560 .1))
;;; --------------------------------------------------------------------------------
;;;
;;; Southern mole cricket
-(definstrument (southern-mole-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 20 1 21 0) :scaler amp :duration dur))
- (gen1 (make-oscil 2700))
- (gen2 (make-oscil (* 2700 2.4)))
- (gen3 (make-oscil 60))
- (gen5 (make-oscil 360))
- (gen4 (make-oscil (* 2700 3.2)))
- (gargle (make-rand-interp 360 (hz->radians (* .25 360)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((pval (oscil gen3))
- (noise (rand-interp gargle))
- (aval (+ .7 (* .3 (oscil gen5)))))
- (outa i (* (env ampf)
- (+ (* (max pval 0.0)
- (+ (* .95 (oscil gen1 noise))
- (* .05 (oscil gen4 noise))))
- (* (max (- 1.0 pval) 0.0)
- (* .05 aval (oscil gen2 (* 2.4 noise))))))))))))
-
-;; (with-sound () (southern-mole-cricket 0 3 .5))
+(defanimal (southern-mole-cricket beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil 2700))
+ (gen2 (make-oscil (* 2700 2.4)))
+ (gen3 (make-oscil 60))
+ (gen5 (make-polywave 360 '(0 .035 1 .015)))
+ (gen4 (make-oscil (* 2700 3.2)))
+ (gargle (make-rand-interp 360 (hz->radians (* .25 360)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((pval (oscil gen3))
+ (noise (rand-interp gargle)))
+ (outa i (* amp (+ (* (polywave gen5)
+ (- 1.0 pval)
+ (oscil gen2 (* 2.4 noise)))
+ (* (max 0.0 pval)
+ (+ (* .95 (oscil gen1 noise))
+ (* .05 (oscil gen4 noise)))))))))))
+
+;; (with-sound (:play #t) (southern-mole-cricket 0 3 .5))
;;; --------------------------------------------------------------------------------
;;;
;;; Broad-winged Tree cricket
-(definstrument (broad-winged-tree-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (freq 1700)
- (base (make-oscil freq))
- (base1 (make-oscil (* 2 freq)))
- (base2 (make-oscil (* 3 freq)))
- (base3 (make-oscil (* 4 freq)))
- (base4 (make-oscil (* 5 freq)))
- (ampmod (make-triangle-wave 155))
- (ampf (make-env '(0 0 8 1 20 1 21 0) :duration dur :scaler amp))
- (frqf (make-env '(0 1 1 -1 2 -1) :duration .06 :base 10.0))
- (pulsef (make-env '(0 0 1 .1 6 .2 7 0 8 .3 10 1 18 .9 21 .1 23 .3 28 .1 30 0) :duration .06 :base .1))
- (pulser (make-pulse-train (/ 1.0 .06)))
- (indf (make-env '(0 0 10 0 18 1 23 1 26 0 30 0) :duration .06))
- (noise (make-rand-interp 1000)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((pulse (pulse-train pulser)))
- (if (> pulse .1)
- (begin
- (mus-reset pulsef)
- (mus-reset frqf)
- (mus-reset indf)))
- (let* ((buzz (+ (* (hz->radians 40) (env frqf))
- (* .005 (rand-interp noise)))))
- (outa i (* (env ampf)
- (env pulsef)
- (+ .93 (* .07 (triangle-wave ampmod)))
- (+ (* .7 (oscil base buzz))
- (* .05 (oscil base1 (* 2 buzz)))
- (* .04 (oscil base2 (* 3 buzz)))
- (* (env indf)
- (+ (* .02 (oscil base3 (* 4 buzz)))
- (* .02 (oscil base4 (* 5 buzz))))))))))))))
+(defanimal (broad-winged-tree-cricket beg dur amp)
+ (let ((freq 1700))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gp (make-polywave freq '(1 .7 2 .05 3 .04)))
+ (gb (make-polywave freq '(4 .02 5 .02)))
+ (ampmod (make-triangle-wave 155 :amplitude .07))
+ (ampf (make-env '(0 0 8 1 20 1 21 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 1 1 -1 2 -1) :duration .06 :base 10.0 :scaler (hz->radians 40.0)))
+ (pulsef #f)
+ (pulse-samps (seconds->samples .06))
+ (indf (make-env '(0 0 10 0 18 1 23 1 26 0 30 0) :duration .06))
+ (noise (make-rand-interp 1000 .005)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-samps)))
+ (pulse-amp (env ampf)))
+ (set! pulsef (make-env '(0 0 1 .1 6 .2 7 0 8 .3 10 1 18 .9 21 .1 23 .3 28 .1 30 0) :scaler pulse-amp :duration .06 :base .1))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((buzz (+ (env frqf) (rand-interp noise))))
+ (outa k (* (env pulsef)
+ (+ .93 (triangle-wave ampmod))
+ (+ (polywave gp buzz)
+ (* (env indf)
+ (polywave gb buzz)))))))
+ (mus-reset pulsef)
+ (mus-reset frqf)
+ (mus-reset indf))))))
;; (with-sound (:play #t) (broad-winged-tree-cricket 0 1.0 0.3))
@@ -1707,95 +1783,111 @@
;;; done down one or two octaves -- I think the recording has cut off high info (above 20Khz) --
;;; need much higher srate to see what this guy is really doing. This is not very good...
-(definstrument (long-spurred-meadow-katydid beg amp)
- (let* ((start (seconds->samples beg))
- (dur 10.1) ; overall duration
- (slow-start 2.2) ; buzz at start
- (soft-end (+ slow-start 4.0)) ; softer section, rest is full vol
- (stop (+ start (seconds->samples dur)))
- ;; looks like the same basic pulse throughout, almost same speed at start but every other one is squelched
- ;; slow startup pulse starts much faster (.06 mid-pulse duration, .0013 base pulse)
- (carrier (make-nrxysin 13200 (/ 800 13200) 4 .7))
- (modulator (make-oscil 1500 (* 0.5 pi)))
- (noise (make-rand-interp 5000))
- (peep (make-pulsed-env '(0 0 1 0 2 .2 3 0 5 .75 8 1 10 0 11 0) .06 (/ 1.0 .06)))
- (ampf (make-env (list 0 0 .5 .5 slow-start .4 soft-end .4 (+ soft-end .5) 1 (- dur 1) 1 dur 0.0) :duration dur :scaler amp))
- (pulsef (make-env (list 0 -1 slow-start -1 (+ slow-start .03) 0 dur 0) :duration dur :scaler (hz->radians 8))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (env pulsef))
- (md (oscil modulator)))
- (outa i (* (env ampf)
- (pulsed-env peep frq)
- md md
- (nrxysin carrier (+ (* frq (/ 13200 16))
- (* .1 (rand-interp noise))
- (* .1 md))))))))))
-
-;; (with-sound () (long-spurred-meadow-katydid 0 .5))
+(defanimal (long-spurred-meadow-katydid beg amp)
+ (let ((dur 10.1) ; overall duration
+ (slow-start 2.2)) ; buzz at start
+ (let ((soft-end (+ slow-start 4.0))) ; softer section, rest is full vol
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ ;; looks like the same basic pulse throughout, almost same speed at start but every other one is squelched
+ ;; slow startup pulse starts much faster (.06 mid-pulse duration, .0013 base pulse)
+ (carrier (make-polywave 400 (list 33 .36 35 (* .36 .7) 37 (* .36 .49) 39 (* .36 .343) 41 (* .36 .242))))
+ (modulator (make-polywave 1500 '(1 .003))) ; cos^2 = 1/2(cos 2x + 1), but polywave has constant term via partial 0
+ (modulator1 (make-polywave 3000 '(0 .5 1 .5)))
+ (noise (make-rand-interp 5000 .003))
+ (peep (make-pulsed-env '(0 0 1 0 2 .2 3 0 5 .75 8 1 10 0 11 0) .06 (/ 1.0 .06)))
+ (ampf (make-env (list 0 0 .5 .5 slow-start .4 soft-end .4 (+ soft-end .5) 1 (- dur 1) 1 dur 0.0) :duration dur :scaler amp))
+ (pulsef (make-env (list 0 -1 slow-start -1 (+ slow-start .03) 0 dur 0) :duration dur :scaler (hz->radians 8)))
+ (pulsef1 (make-env (list 0 -1 slow-start -1 (+ slow-start .03) 0 dur 0) :duration dur :scaler (hz->radians (* 24.75 8)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave modulator1)
+ (pulsed-env peep (env pulsef))
+ (polywave carrier (+ (env pulsef1)
+ (rand-interp noise)
+ (polywave modulator))))))))))
+
+
+;; (with-sound (:statistics #t) (long-spurred-meadow-katydid 0 .5))
+
+#|
+(defanimal (long-spurred-meadow-katydid beg amp)
+ (let ((dur 10.1) ; overall duration
+ (slow-start 2.2)) ; buzz at start
+ (let ((soft-end (+ slow-start 4.0))) ; softer section, rest is full vol
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ ;; looks like the same basic pulse throughout, almost same speed at start but every other one is squelched
+ ;; slow startup pulse starts much faster (.06 mid-pulse duration, .0013 base pulse)
+ (carrier (make-nrxysin 13200 (/ 800 13200) 4 .7))
+ (modulator (make-oscil 1500 (* 0.5 pi)))
+ (noise (make-rand-interp 5000 .1))
+ (nrx 0.0)
+ (peep (make-pulsed-env '(0 0 1 0 2 .2 3 0 5 .75 8 1 10 0 11 0) .06 (/ 1.0 .06)))
+ (ampf (make-env (list 0 0 .5 .5 slow-start .4 soft-end .4 (+ soft-end .5) 1 (- dur 1) 1 dur 0.0) :duration dur :scaler amp))
+ (pulsef (make-env (list 0 -1 slow-start -1 (+ slow-start .03) 0 dur 0) :duration dur :scaler (hz->radians 8))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env pulsef))
+ (md (oscil modulator)))
+ (set! nrx (nrxysin carrier (+ (* 825.0 frq) ; (/ 13200 16))
+ (rand-interp noise)
+ (* .1 md))))
+ (set! md (* md md nrx (pulsed-env peep frq)))
+ (outa i (* md (env ampf)))))))))
+|#
+#|
+;; this is slower!
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env pulsef))
+ (md (oscil modulator)))
+ (outa i (* md md
+ (nrxysin carrier (+ (* 825.0 frq) ; (/ 13200 16))
+ (rand-interp noise)
+ (* .1 md)))
+ (pulsed-env peep frq) (env ampf)))))))))
+|#
+
;;; --------------------------------------------------------------------------------
;;;
;;; Handsome trig
-(definstrument (handsome-trig beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (freqs (list 6439 6585 6860 6940 7090 7266 7362))
- (num (length freqs))
- (amps (let* ((v (make-vct num))
- (lst (list 1.0 1.0 .25 .17 .2 .1 .1))
- (scl (apply + lst)))
- (do ((i 0 (+ i 1)))
- ((= i num))
- (set! (v i) (/ (lst i) scl)))
- v))
- (gens (let ((v (make-vector num #f)))
- (do ((i 0 (+ i 1)))
- ((= i num))
- (set! (v i) (make-oscil (freqs i))))
- v))
- (pulse-dur .02)
- (pulse-count 0)
- (pulse-length (seconds->samples pulse-dur))
- (ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur :scaler amp)) ; continuous call
- (pulsef (make-env '(0.0 0.0 0.05 1.0 0.13 1.0 0.4 0.1 1.0 0.0) :duration pulse-dur))
- (pulses 0))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (set! pulse-count (+ 1 pulse-count))
- (if (>= pulse-count pulse-length)
- (let ((dont-click
- ;; count pulses in current group -- at least 2, at most 4, if 2 or 3, possibly and if 4 definitely insert a space
- (or (= pulses 4)
- (and (or (and (= pulses 2)
- (> (random 1.0) 0.6))
- (and (= pulses 3)
- (> (random 1.0) 0.3)))))))
- (set! pulse-count 0)
- (if dont-click
- (begin
- (set! pulses 0)
- (set! pulse-length (seconds->samples (+ .015 (random .005)))))
- (begin
- (set! pulses (+ 1 pulses))
- (set! pulse-length (seconds->samples pulse-dur))
- (mus-reset pulsef)
- (do ((k 0 (+ 1 k)))
- ((= k num))
- (mus-reset (gens k)))))))
- (let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k num))
- (set! sum (+ sum (* (amps k) (oscil (gens k))))))
- (outa i (* (env ampf)
- (env pulsef)
- sum)))))))
-
-;; (with-sound () (handsome-trig 0 2 .5))
+(defanimal (handsome-trig beg dur amp)
+ (let ((freqs (apply float-vector (map hz->radians '(6439 6585 6860 6940 7090 7266 7362))))
+ (amps (float-vector 0.355 0.355 0.089 0.060 0.071 0.035 0.035))
+ (pulse-dur .02))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (pulsef (make-env '(0.0 0.0 0.05 1.0 0.13 1.0 0.4 0.1 1.0 0.0) :scaler amp :duration pulse-dur))
+ (pulse-samps (seconds->samples pulse-dur))
+ (pulse-sep (seconds->samples pulse-dur))
+ (pulses 0)
+ (obank (make-oscil-bank freqs (make-float-vector 7 0.0) amps #t)))
+ (do ((i start (+ i pulse-sep)))
+ ((>= i stop))
+ (let ((pulse-stop (+ i pulse-samps)))
+ (do ((k i (+ k 1)))
+ ((= k pulse-stop))
+ (outa k (* (env pulsef) (oscil-bank obank)))))
+ (set! pulses (+ pulses 1))
+ ;; count pulses in current group -- at least 2, at most 4, if 2 or 3, possibly and if 4 definitely insert a space
+ (if (or (= pulses 4)
+ (and (= pulses 2)
+ (> (random 1.0) 0.6))
+ (and (= pulses 3)
+ (> (random 1.0) 0.3)))
+ (begin
+ (set! pulse-sep (+ pulse-samps (seconds->samples (+ .015 (random .005)))))
+ (set! pulses 0))
+ (set! pulse-sep pulse-samps))
+ (mus-reset pulsef)
+ (mus-reset obank)))))
+
+;; (with-sound (:play #t :statistics #t) (handsome-trig 0 2 .5))
;;; --------------------------------------------------------------------------------
@@ -1804,133 +1896,122 @@
;;;
;;; (use fm for noise to get the burble right, and pm for spectrum)
-(definstrument (fast-calling-tree-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (pulse-dur .0167)
- (pulsef (make-env '(0.0 0.0 0.05 0.07 0.08 0.4 0.2 0.7 0.37 0.93 0.52 1.0 0.6 0.4 0.67 0.2 0.84 0.16 0.88 0.06 0.96 0.03 1.0 0.0)
- :duration pulse-dur))
- (gen1 (make-oscil 4100))
- (md (make-oscil 4100))
- (md1 (make-oscil 205))
- (rnd (make-rand-interp 180 .01))
- ;; 1.0 .04 .007
- (pulser (make-pulse-train 55.0))
- (ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((pulse (pulse-train pulser)))
- (if (> pulse .1)
- (mus-reset pulsef))
- (outa i (* (env ampf)
- (env pulsef)
- (oscil gen1
- (rand-interp rnd)
- (+ (* .1 (oscil md))
- (* .2 (oscil md1)))))))))))
-
-;; (with-sound () (fast-calling-tree-cricket 0 2 .5))
+(defanimal (fast-calling-tree-cricket beg dur amp)
+ (let ((pulse-dur .0167))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (pulsef (make-env '(0.0 0.0 0.05 0.07 0.08 0.4 0.2 0.7 0.37 0.93 0.52 1.0 0.6 0.4 0.67 0.2 0.84 0.16 0.88 0.06 0.96 0.03 1.0 0.0)
+ :scaler amp :duration pulse-dur))
+ (pulse-samps (seconds->samples (/ 1.0 55)))
+ (pulse-out (seconds->samples pulse-dur))
+ (gen1 (make-oscil 4100))
+ (md (make-oscil 4100))
+ (md1 (make-oscil 205))
+ (rnd (make-rand-interp 180 .01)))
+ ;; 1.0 .04 .007
+
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-out))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (oscil gen1
+ (rand-interp rnd)
+ (+ (* .1 (oscil md))
+ (* .2 (oscil md1)))))))
+ (mus-reset pulsef))))))
+
+;; (with-sound (:play #t) (fast-calling-tree-cricket 0 2 .25))
;;; --------------------------------------------------------------------------------
;;;
;;; Dog-day cicada
-(definstrument (dog-day-cicada beg dur amp) ; dur ca 10 ..15 secs
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.0 0.0 0.1 0.03 0.2 0.2 0.3 0.6 0.34 0.8 0.44 1.0
- 0.5 0.83 0.55 0.92 0.6 0.86 0.66 1.0 0.7 0.7 0.88 0.25
- 0.91 0.24 0.93 0.02 1.0 0.0)
- :duration dur :scaler amp))
- (gen1 (make-oscil 7500))
- (gen2 (make-oscil 200))
- (rnd (make-rand-interp 200))
- (rndf (make-env '(0 .3 .7 .3 .8 1 1 0) :scaler (hz->radians 120)))
- (frqf (make-env '(0 -.5 .2 0 .85 0 1 -1) :scaler (hz->radians 400) :duration dur))
- (rx (make-rxyk!cos 4000 (/ 600 4000) 8.0)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (* .5 (+ (oscil gen1 (+ frq
- (* (env rndf) (rand-interp rnd))
- (* .15 (oscil gen2))))
- (rxyk!cos rx))))))))))
-
-;; (with-sound () (dog-day-cicada 0 2 .5))
+(defanimal (dog-day-cicada beg dur amp) ; dur ca 10 ..15 secs
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.0 0.0 0.1 0.03 0.2 0.2 0.3 0.6 0.34 0.8 0.44 1.0
+ 0.5 0.83 0.55 0.92 0.6 0.86 0.66 1.0 0.7 0.7 0.88 0.25
+ 0.91 0.24 0.93 0.02 1.0 0.0)
+ :duration dur :scaler (* 0.5 amp)))
+ (gen1 (make-oscil 7500))
+ (gen2 (make-polywave 200 '(1 .15)))
+ (rnd (make-rand-interp 200))
+ (rndf (make-env '(0 .3 .7 .3 .8 1 1 0) :duration dur :scaler (hz->radians 120)))
+ (frqf (make-env '(0 -.5 .2 0 .85 0 1 -1) :scaler (hz->radians 400) :duration dur))
+ (rx (make-rxyk!cos 4000 (/ 600 4000) 8.0)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ (oscil gen1 (+ (env frqf)
+ (* (env rndf) (rand-interp rnd))
+ (polywave gen2)))
+ (rxyk!cos rx)))))))
+
+;; (with-sound (:play #t) (dog-day-cicada 0 2 .5))
;;; --------------------------------------------------------------------------------
;;;
;;; Linnaeus' Cicada
-(definstrument (linnaeus-cicada beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 .8 10 1 11 0) :duration dur :scaler amp))
- (frqf (make-env '(0 0 3 .02 6 0 8 .03 9.8 0 10.6 -1 11 -1) :scaler (hz->radians 450) :duration dur :base 32))
- (gen1 (make-oscil 1280))
- (gen2 (make-oscil 1100))
- (gen3 (make-oscil 1460))
- (gen4 (make-oscil (* 2 1280)))
- (gen5 (make-oscil (* 3 1280)))
- (rnd (make-rand-interp 1280))
- (saw (make-sawtooth-wave 180)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (env frqf))
- (md (+ frq
- (* .014 (rand-interp rnd))))
- (sw (sawtooth-wave saw)))
- (outa i (* (env ampf)
- (+ .75 (* .25 sw sw))
- (+ (* .8 (oscil gen1 md))
- (* .15 (oscil gen2 (* md (/ 1100 1280))))
- (* .07 (oscil gen3 (* md (/ 1460 1280))))
- (* .02 (oscil gen4 (* 2 md)))
- (* .02 (oscil gen5 (* 3 md)))))))))))
+(defanimal (linnaeus-cicada beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 .8 10 1 11 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 0 3 .02 6 0 8 .03 9.8 0 10.6 -1 11 -1) :scaler (hz->radians 450) :duration dur :base 32))
+ (gp1 (make-polywave 1280 '(1 .8 2 .02 3 .02)))
+ (gp2 (make-polywave 1100 '(1 .15)))
+ (gp3 (make-polywave 1460 '(1 .07)))
+ (rnd (make-rand-interp 1280 .014))
+ (saw (make-sawtooth-wave 180 .5)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((sw (sawtooth-wave saw))
+ (md (+ (env frqf) (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ .75 (* sw sw))
+ (+ (polywave gp1 md)
+ (polywave gp2 (* 0.8593 md)) ;(/ 1100 1280)
+ (polywave gp3 (* 1.1406 md))))))))) ;(/ 1460 1280)
+
+;; (with-sound (:statistics #t) (linnaeus-cicada 0 2 .5))
;;; --------------------------------------------------------------------------------
;;;
;;; Lyric cicada
-(definstrument (lyric-cicada beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (p0 400)
- (pulsef (make-env '(0.0 0.0 0.038 0.16 0.044 0.6 0.07 0.6 0.08 0.26
- 0.1 0.09 0.12 0.43 0.14 0.19 0.18 0.07 0.22 0.048
- 0.23 0.65 0.25 0.65 0.26 0.23 0.28 0.044
- 0.3 0.55 0.31 0.31 0.35 0.05 0.38 0.01 0.39 1.0
- 0.41 0.36 0.42 0.16 0.44 0.02 0.46 0.7 0.48 0.23
- 0.5 0.1 0.55 0.01 0.56 0.97
- 0.6 0.12 0.612 0.02 0.63 0.61 0.65 0.18 0.69 0.07
- 0.7 0.61 0.72 0.16 0.76 0.05 0.78 0.37 0.790 0.13
- 0.82 0.02 0.83 0.4 0.85 0.12
- 0.9 0.01 0.92 0.29 0.95 0.2 0.96 0.08
- 1.0 0)
- :duration .02
- :scaler 1.0))
- (pulser (make-pulse-train 50))
- (gen1 (make-oscil (* p0 16)))
- (gen2 (make-oscil p0))
- (rnd (make-rand-interp p0 (hz->radians 800)))
- (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((pulse (pulse-train pulser)))
- (if (> pulse .1)
- (mus-reset pulsef))
- (outa i (* (env ampf)
- (env pulsef)
- (oscil gen1 (+ (* .15 (oscil gen2))
- (rand-interp rnd))))))))))
+(defanimal (lyric-cicada beg dur amp)
+ (let ((p0 400))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (pulsef (make-pulsed-env '(0.0 0.0 0.038 0.16 0.044 0.6 0.07 0.6 0.08 0.26
+ 0.1 0.09 0.12 0.43 0.14 0.19 0.18 0.07 0.22 0.048
+ 0.23 0.65 0.25 0.65 0.26 0.23 0.28 0.044
+ 0.3 0.55 0.31 0.31 0.35 0.05 0.38 0.01 0.39 1.0
+ 0.41 0.36 0.42 0.16 0.44 0.02 0.46 0.7 0.48 0.23
+ 0.5 0.1 0.55 0.01 0.56 0.97
+ 0.6 0.12 0.612 0.02 0.63 0.61 0.65 0.18 0.69 0.07
+ 0.7 0.61 0.72 0.16 0.76 0.05 0.78 0.37 0.790 0.13
+ 0.82 0.02 0.83 0.4 0.85 0.12
+ 0.9 0.01 0.92 0.29 0.95 0.2 0.96 0.08
+ 1.0 0)
+ .02 50.0))
+ (gen1 (make-oscil (* p0 16)))
+ (gen2 (make-polywave p0 '(1 .15)))
+ (rnd (make-rand-interp p0 (hz->radians 800)))
+ (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (pulsed-env pulsef)
+ (oscil gen1 (+ (polywave gen2)
+ (rand-interp rnd)))))))))
+
+;; (with-sound (:play #t) (lyric-cicada 0 2 .5))
@@ -1938,63 +2019,60 @@
;;;
;;; Confused ground cricket
-(definstrument (confused-ground-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil 5700))
- (gen2 (make-oscil 5700))
- (rnd (make-rand-interp 600 (hz->radians 166)))
- (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp))
- (songf (make-env '(0.0 0.0 0.02 0.5 0.18 0.5 0.24 0.28 0.28 0.27 0.45 0.8 0.65 1.0 0.93 0.94 1.0 0.0) :duration .4))
- (pulsef (make-env '(0.0 0.0 0.16 0.0 0.23 0.57 0.36 0.57 0.42 0.83 0.56 1.0 0.64 0.81 0.75 0.2 0.86 0.02 1.0 0.0) :duration .01))
- (pulse-ctr (seconds->samples (+ .01 (random .006))))
- (song-ctr (seconds->samples (+ .5 (random .2)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (<= song-ctr 0)
- (begin
- (set! song-ctr (seconds->samples (+ .5 (random .2))))
- (mus-reset songf)
- (set! pulse-ctr 0)))
- (if (<= pulse-ctr 0)
- (begin
- (set! pulse-ctr (seconds->samples (+ .01 (random .006))))
- (mus-reset pulsef)))
- (outa i (* (env ampf)
- (env songf)
- (env pulsef)
- (oscil gen1 (+ (* .01 (oscil gen2))
- (rand-interp rnd)))))
- (set! song-ctr (- song-ctr 1))
- (set! pulse-ctr (- pulse-ctr 1))))))
+(defanimal (confused-ground-cricket beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil 5700))
+ (gen2 (make-polywave 5700 '(1 .01)))
+ (rnd (make-rand-interp 600 (hz->radians 166)))
+ (songf (make-env '(0.0 0.0 0.02 0.5 0.18 0.5 0.24 0.28 0.28 0.27 0.45 0.8 0.65 1.0 0.93 0.94 1.0 0.0) :duration .4))
+ (pulsef #f)
+ (pulse-samps (seconds->samples .01))
+ (song-samps (seconds->samples .4)))
+ (do ((i start (+ i (seconds->samples (+ .5 (random .2))))))
+ ((>= i stop))
+ (let ((song-stop (min stop (+ i song-samps))))
+ (do ((k i (+ k (seconds->samples (+ .01 (random .006))))))
+ ((>= k song-stop))
+ (set! (mus-location songf) (- k i))
+ (let ((pstop (+ k pulse-samps))
+ (pulse-amp (env songf)))
+ (set! pulsef (make-env '(0.0 0.0 0.16 0.0 0.23 0.57 0.36 0.57 0.42 0.83 0.56 1.0 0.64 0.81 0.75 0.2 0.86 0.02 1.0 0.0)
+ :scaler (* pulse-amp amp) :duration .01))
+ (do ((j k (+ j 1)))
+ ((= j pstop))
+ (outa j (* (env pulsef)
+ (oscil gen1 (+ (polywave gen2)
+ (rand-interp rnd))))))))
+ (mus-reset songf)))))
;; (with-sound (:play #t) (confused-ground-cricket 0 3 .3))
+
;;; ------------------------------------------------------------------------------------------
;;;
;;; Tinkling ground cricket
;;;
;;; There's a secondary (slower) peep -- is this part of our cricket's song, or another cricket in the background?
-(definstrument (tinkling-ground-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp))
- (gen1 (make-oscil 7200))
- (gen2 (make-oscil 80))
- (pulser (make-pulse-train (/ 1.0 .15)))
- (pulsef (make-env '(0.0 0.0 0.07 0.5 0.28 0.86 0.42 0.97 0.55 1.0 0.63 0.88 0.71 0.6 0.85 0.14 0.9 0.1 0.94 0.02 1.0 0.0) :duration .03)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((pulse (pulse-train pulser)))
- (if (> pulse .1)
- (mus-reset pulsef))
- (outa i (* (env ampf)
- (env pulsef)
- (oscil gen1 (* .01 (oscil gen2))))))))))
+(defanimal (tinkling-ground-cricket beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil 7200))
+ (gp (make-polywave 80 '(1 .01)))
+ (pulser (make-env '(0.0 0.0 0.07 0.5 0.28 0.86 0.42 0.97 0.55 1.0 0.63 0.88 0.71 0.6 0.85 0.14 0.9 0.1 0.94 0.02 1.0 0.0)
+ :scaler amp :duration .03))
+ (pulse-samps (seconds->samples .15))
+ (pulse-out (seconds->samples .03)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-out))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulser)
+ (oscil gen1 (polywave gp)))))
+ (mus-reset pulser)))))
;; (with-sound (:play #t) (tinkling-ground-cricket 0 3 .3))
@@ -2005,33 +2083,35 @@
;;;
;;; this is just a random number generator with an elaborate amplitude envelope
-(definstrument (marsh-meadow-grasshopper beg amp)
- (let* ((start (seconds->samples beg))
- (dur 4.8)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 .2 .6 .65 1.0 .87 .87 1.0 0) :duration dur :scaler amp))
- (pulsef (make-env '(0.000 0.000 0.070 0.086 0.176 0.083 0.311 0.170 0.432 0.173
- 0.470 0.321 0.487 0.021 0.503 0.021 0.504 0.304 0.540 0.298
- 0.553 0.435 0.600 0.193 0.614 0.458 0.652 0.315 0.665 0.024
- 0.689 0.018 0.699 0.638 0.725 0.582 0.727 0.027 0.790 0.009
- 0.799 0.819 0.824 0.635 0.833 0.036 0.926 0.015 0.941 0.866
- 0.949 0.053 0.968 0.570 1.000 0.000)
- :duration .19))
- (pulser (make-pulse-train (/ 1.0 (+ .19 .02))))
- (last-val 0.0))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((pulse (pulse-train pulser)))
- (if (> pulse .1)
- (mus-reset pulsef))
- (let ((this-val (* (env ampf)
- (env pulsef)
- (- 1.0 (random 2.0)))))
- (outa i (- last-val this-val))
- (set! last-val this-val)))))))
+(defanimal (marsh-meadow-grasshopper beg amp)
+ (let ((dur 4.8))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 .2 .6 .65 1.0 .87 .87 1.0 0) :duration dur :scaler amp))
+ (pulsef (make-env '(0.000 0.000 0.070 0.086 0.176 0.083 0.311 0.170 0.432 0.173
+ 0.470 0.321 0.487 0.021 0.503 0.021 0.504 0.304 0.540 0.298
+ 0.553 0.435 0.600 0.193 0.614 0.458 0.652 0.315 0.665 0.024
+ 0.689 0.018 0.699 0.638 0.725 0.582 0.727 0.027 0.790 0.009
+ 0.799 0.819 0.824 0.635 0.833 0.036 0.926 0.015 0.941 0.866
+ 0.949 0.053 0.968 0.570 1.000 0.000)
+ :duration .19))
+ (pulse-samps (seconds->samples (+ .19 .02)))
+ (pulse-out (seconds->samples .19))
+ (r (make-rand 20000.0 1.0))
+ (oz (make-one-zero -1.0 1.0)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! (mus-scaler r) pulse-amp)
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (one-zero oz (* (env pulsef) (rand r)))))
+ (mus-reset pulsef))))))
+
+;; (with-sound (:play #t :statistics #t) (marsh-meadow-grasshopper 0 .3))
-;; (with-sound (:play #t) (marsh-meadow-grasshopper 0 .3))
;;; --------------------------------------------------------------------------------
@@ -2041,35 +2121,32 @@
;;; tricky! spikes are at 48 Hz, but the sound they make requires 24 Hz pulse -- I presume
;;; I'm seeing the 2 or 4 wings alternating?
-(definstrument (carolina-grasshopper beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env ;'(0.000 0.000 0.032 0.115 0.151 0.044 0.181 0.485 0.254 0.841 0.620 0.431 0.731 0.051 0.757 0.292 0.898 0.620 0.984 0.380 1.000 0.000)
- '(0.000 0.000 0.031 0.122 0.076 0.054 0.148 0.010 0.177 0.512 0.199 0.366 0.246 0.868 0.291 0.336 0.320 0.644 0.386 0.244 0.450 0.553
- 0.535 0.142 0.583 0.424 0.611 0.427 0.727 0.081 0.778 0.315 0.835 0.319 0.899 0.600 0.972 0.356 1.000 0.000)
- :duration dur :scaler (* 3 amp)))
- (spikes1 (make-nsin 24 250))
- (spikes1a (make-nsin 24 250))
- (spikes2 (make-nsin 48 140))
- (spikes3 (make-nsin 48 120))
- (rnd (make-rand-interp 100 .0001)) ; perhaps this is too much -- it clobbers the comb filter
- (frqf (make-env '(0 0 1 -.4 2 0 3 -.2 4 .3 6 -1.0) :scaler (hz->radians .4) :duration dur))
- (last-val 0.0))
+(defanimal (carolina-grasshopper beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env ;'(0.000 0.000 0.032 0.115 0.151 0.044 0.181 0.485 0.254 0.841 0.620 0.431 0.731 0.051 0.757 0.292 0.898 0.620 0.984 0.380 1.000 0.000)
+ '(0.000 0.000 0.031 0.122 0.076 0.054 0.148 0.010 0.177 0.512 0.199 0.366 0.246 0.868 0.291 0.336 0.320 0.644 0.386 0.244 0.450 0.553
+ 0.535 0.142 0.583 0.424 0.611 0.427 0.727 0.081 0.778 0.315 0.835 0.319 0.899 0.600 0.972 0.356 1.000 0.000)
+ :duration dur :scaler (* 3 amp)))
+ (spikes1 (make-nsin 24 250))
+ (spikes1a (make-nsin 24 250))
+ (spikes2 (make-nsin 48 140))
+ (spikes3 (make-nsin 48 120))
+ (rnd (make-rand-interp 100 .0001)) ; perhaps this is too much -- it clobbers the comb filter
+ (frqf (make-env '(0 0 1 -.4 2 0 3 -.2 4 .3 6 -1.0) :scaler (hz->radians .4) :duration dur))
+ (oz (make-one-zero 1.0 -1.0)))
(set! (mus-phase spikes1a) pi)
(set! (mus-phase spikes2) .7)
(set! (mus-phase spikes3) 1.4)
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((noi (rand-interp rnd))
- (frq (+ noi (env frqf)))
- (this-val (* (env ampf)
- (+ (* .6 (nsin spikes1 noi))
- (* .6 (nsin spikes1a noi))
- (* .4 (nsin spikes2 frq))
- (* .3 (nsin spikes3 frq))))))
- (outa i (- this-val last-val))
- (set! last-val this-val))))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let* ((noi (rand-interp rnd))
+ (frq (+ noi (env frqf))))
+ (outa i (one-zero oz (* (env ampf)
+ (+ (* .6 (nsin spikes1 noi))
+ (* .6 (nsin spikes1a noi))
+ (* .4 (nsin spikes2 frq))
+ (* .3 (nsin spikes3 frq))))))))))
;; (with-sound (:play #t) (carolina-grasshopper 0 1.5 1.0))
@@ -2078,44 +2155,46 @@
;;;
;;; Striped ground cricket
-(definstrument (striped-ground-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp))
- (gen1 (make-oscil (* 2 6600)))
- (gen2 (make-oscil (* 2 66) (* 0.5 (+ pi (hz->radians (* 2 66))))))
- (gen3 (make-oscil 6600))
- (gen4 (make-oscil 66 (* 0.5 (+ pi (hz->radians 66)))))
- (pulser (make-pulse-train (/ 1.0 .015)))
- (pulsef (make-env '(0.000 0.000 0.041 0.466 0.144 0.775 0.359 1.0 0.484 0.858 1.000 0.000) :duration .012))
- (pulses 10)
- (pulse-ctr 0)
- (pulse-amp 0.5)
- (long-pulser (make-pulse-train (/ 1.0 .54)))
- (rnd (make-rand-interp (* 3 66) .04)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((pulse (pulse-train pulser))
- (long-pulse (pulse-train long-pulser)))
- (if (> long-pulse .1)
- (begin
- (set! pulse-amp 0.5)
- (set! pulse-ctr 0)
- (set! pulses (+ 8 (random 3)))))
- (if (and (> pulse .1)
- (< pulse-ctr pulses))
- (begin
- (mus-reset pulsef)
- (if (> pulse-ctr 0)
- (set! pulse-amp 1.0))
- (set! pulse-ctr (+ 1 pulse-ctr))))
- (outa i (* (env ampf)
- pulse-amp
- (env pulsef)
- (+ (* .2 (oscil gen1 (* .075 (oscil gen2))))
- (* .8 (oscil gen3 (+ (* .0125 (oscil gen4))
- (rand-interp rnd))))))))))))
+(defanimal (striped-ground-cricket beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil (* 2 6600)))
+ (gen2 (make-oscil (* 2 66) (* 0.5 (+ pi (hz->radians (* 2 66))))))
+ (gen3 (make-oscil 6600))
+ (gen4 (make-oscil 66 (* 0.5 (+ pi (hz->radians 66)))))
+ (pulsef (make-env '(0.000 0.000 0.041 0.466 0.144 0.775 0.359 1.0 0.484 0.858 1.000 0.000) :scaler amp :duration .012))
+ (pulsef1 (make-env '(0.000 0.000 0.041 0.466 0.144 0.775 0.359 1.0 0.484 0.858 1.000 0.000) :scaler (* 0.5 amp) :duration .012))
+ (pulse-samps (seconds->samples 0.012))
+ (pulse-sep (seconds->samples 0.015))
+ (long-pulse-samps (seconds->samples .54))
+ (rnd (make-rand-interp (* 3 66) .04)))
+
+ (do ((i start (+ i long-pulse-samps)))
+ ((>= i stop))
+ ;; do the 1st 0.5 amp pulse
+ (let ((pstop (+ i pulse-samps))
+ (next-start i)
+ (pulses (+ 8 (random 3))))
+ (do ((j i (+ j 1)))
+ ((= j pstop))
+ (outa j (* (env pulsef1)
+ (+ (* .2 (oscil gen1 (* .075 (oscil gen2))))
+ (* .8 (oscil gen3 (+ (* .0125 (oscil gen4))
+ (rand-interp rnd))))))))
+ (mus-reset pulsef1)
+
+ ;; now the remaining pulses
+ (do ((k 1 (+ k 1)))
+ ((= k pulses))
+ (set! next-start (+ next-start pulse-sep))
+ (set! pstop (+ next-start pulse-samps))
+ (do ((j next-start (+ j 1)))
+ ((= j pstop))
+ (outa j (* (env pulsef)
+ (+ (* .2 (oscil gen1 (* .075 (oscil gen2))))
+ (* .8 (oscil gen3 (+ (* .0125 (oscil gen4))
+ (rand-interp rnd))))))))
+ (mus-reset pulsef))))))
;; (with-sound (:play #t) (striped-ground-cricket 0 3 .5))
@@ -2124,25 +2203,29 @@
;;;
;;; Sphagnum ground cricket
-(definstrument (sphagnum-ground-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil 8850))
- (gen2 (make-oscil (* 8850 2)))
- (rnd1 (make-rand-interp 885 .03))
- (rnd2 (make-rand-interp 885 .1))
- (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp))
- (pulsef (make-env '(0.000 0.000 0.041 0.5 0.250 0.7 0.4 1.0 0.5 0.9 0.8 0.3 1.000 0.000) :duration .013))
- (pulser (make-pulse-train (/ 1.0 .019))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (> (pulse-train pulser) .1)
- (mus-reset pulsef))
- (outa i (* (env ampf)
- (env pulsef)
- (+ (* .9 (oscil gen1 (rand-interp rnd1)))
- (* .1 (oscil gen2 (rand-interp rnd2)))))))))) ; I can't hear this unless transposed down
+(defanimal (sphagnum-ground-cricket beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil 8850))
+ (gen2 (make-oscil (* 8850 2)))
+ (rnd1 (make-rand-interp 885 .03))
+ (rnd2 (make-rand-interp 885 .1))
+ (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp))
+ (pulsef (make-env '(0.000 0.000 0.041 0.5 0.250 0.7 0.4 1.0 0.5 0.9 0.8 0.3 1.000 0.000) :duration .013))
+ (pulse-samps (seconds->samples .019))
+ (pulse-out (seconds->samples .013)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* pulse-amp
+ (env pulsef)
+ (+ (* .9 (oscil gen1 (rand-interp rnd1)))
+ (* .1 (oscil gen2 (rand-interp rnd2)))))))
+ (mus-reset pulsef)))))
;; (with-sound (:play #t) (sphagnum-ground-cricket 0 2 .3))
@@ -2151,96 +2234,83 @@
;;;
;;; Southeastern field cricket
-(definstrument (southeastern-field-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil 4730))
- (gen2 (make-oscil (* 2 4730)))
- (gen3 (make-oscil (* 3 4730)))
- (rnd (make-rand-interp (* 2 473) 1))
- (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp))
- (pulsef (make-env '(0.0 0.0 0.05 0.38 0.14 0.77 0.26 0.95 0.47 1.0 0.57 0.9 0.81 0.5 0.85 0.3 1.0 0.0) :duration .014))
- (pulse-dur 0.027) ; occasionally a hicccup = .039, 30..100 pulses per song
- (pulses (+ 30 (random 70)))
- (pulse-amp 1.0)
- (pulse-ctr (seconds->samples pulse-dur))
- (song-ctr 0))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (= i song-ctr)
- (begin
- (set! pulses (+ 30 (random 70)))
- (set! pulse-amp 1.0)
- (set! pulse-ctr (seconds->samples pulse-dur))))
- (if (and (<= pulse-ctr 0)
- (> pulse-amp 0.0))
- (begin
- (if (> (random 1.0) .95)
- (set! pulse-ctr (seconds->samples (+ pulse-dur .005 (random .01))))
- (set! pulse-ctr (seconds->samples pulse-dur)))
- (mus-reset pulsef)
- (set! pulses (- pulses 1))
- (if (<= pulses 0)
- (begin
- (set! pulse-amp 0.0)
- (set! song-ctr (+ i (seconds->samples (+ .2 (random .1))))))
- (set! pulse-amp 1.0))))
- (let ((rn (rand-interp rnd)))
- (outa i (* (env ampf)
- (env pulsef)
- pulse-amp
- (+ (* .8 (oscil gen1 0.0 rn))
- (* .1 (oscil gen2 0.0 (* 2 rn)))
- (* .1 (oscil gen3 0.0 (* 3 rn)))))))
- (set! pulse-ctr (- pulse-ctr 1))))))
-
+(defanimal (southeastern-field-cricket beg dur amp)
+ (let ((pulse-dur 0.027)) ; occasionally a hicccup = .039, 30..100 pulses per song
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-polywave 4730 '(1 .8 2 .1 3 .1)))
+ (rnd (make-rand-interp (* 2 473) 1))
+ (oz (make-one-zero 1.0 -1.0))
+ (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp))
+ (pulsef (make-env '(0.0 0.0 0.05 0.38 0.14 0.77 0.26 0.95 0.47 1.0 0.57 0.9 0.81 0.5 0.85 0.3 1.0 0.0) :duration .014))
+ (pulses (+ 30 (random 70)))
+ (pulse-samps (seconds->samples pulse-dur))
+ (current-pulse-samps (seconds->samples pulse-dur)))
+
+ (do ((i start (+ i current-pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+
+ (let ((reset-stop (min stop (+ i pulse-samps)))
+ (pulse-amp (env ampf)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* pulse-amp
+ (env pulsef)
+ (polywave gen1 (one-zero oz (rand-interp rnd))))))
+
+ (mus-reset pulsef)
+ (set! pulses (- pulses 1))
+ (if (<= pulses 0)
+ (begin
+ (set! current-pulse-samps (+ pulse-samps (seconds->samples (+ .2 (random .1)))))
+ (set! pulses (+ 30 (random 70))))
+ (begin
+ (if (> (random 1.0) .95)
+ (set! pulse-samps (seconds->samples (+ pulse-dur .005 (random .01))))
+ (set! pulse-samps (seconds->samples pulse-dur)))
+ (set! current-pulse-samps pulse-samps))))))))
;; (with-sound (:play #t) (southeastern-field-cricket 0 5 .3))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Snowy tree cricket
-(definstrument (snowy-tree-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (pitch 1690)
- (gen1 (make-oscil pitch))
- (gen2 (make-oscil (* pitch 2)))
- (gen3 (make-oscil (* pitch 3)))
- (rnd (make-rand-interp 1000 .014))
- (ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur :scaler amp))
- (pulsef (make-env '(0.0 0.0 0.04 0.79 0.08 0.09 0.11 0.02 0.14 0.83 0.15 0.95
- 0.21 0.05 0.26 0.02 0.29 0.79 0.31 0.89 0.35 0.07 0.38 0.04
- 0.39 0.79 0.42 0.94 0.45 0.08 0.48 0.05 0.50 0.80 0.52 0.96
- 0.59 0.02 0.64 0.01 0.66 0.78 0.68 0.95 0.72 0.06 0.75 0.04
- 0.76 0.70 0.79 0.96 0.83 0.07 0.85 0.02 0.88 0.80 0.90 1.0
- 0.95 0.12 0.97 0.04 1.00 0.00)
- :duration .352 :base .1))
- (frqf (make-env '(0.0 0.0 0.04 1.0 0.08 0.0 0.11 0.0 0.14 1.0 0.15 0.0
- 0.21 0.0 0.26 0.0 0.29 1.0 0.31 0.0 0.35 0.0 0.38 0.0
- 0.39 1.0 0.42 0.0 0.45 0.0 0.48 0.0 0.50 1.0 0.52 0.0
- 0.59 0.0 0.64 0.0 0.66 1.0 0.68 0.0 0.72 0.0 0.75 0.0
- 0.76 1.0 0.79 0.0 0.83 0.0 0.85 0.0 0.88 1.0 0.90 0.0
- 0.95 0.0 0.97 0.0 1.00 0.0)
- :duration .352 :scaler (hz->radians 60)))
- (pulser (make-pulse-train (/ 1.0 .85))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((rn (+ (rand-interp rnd)
- (env frqf))))
- (if (> (pulse-train pulser) .1)
- (begin
- (mus-reset pulsef)
- (mus-reset frqf)))
- (outa i (* (env ampf)
- (env pulsef)
- (+ (* .9 (oscil gen1 rn))
- (* .05 (oscil gen2 (* 2 rn)))
- (* .05 (oscil gen3 (* 3 rn)))))))))))
+(defanimal (snowy-tree-cricket beg dur amp)
+ (let ((pitch 1690))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gp (make-polywave pitch '(1 .9 2 .05 3 .05)))
+ (rnd (make-rand-interp 1000 .014))
+ (pulsef (make-env '(0.0 0.0 0.04 0.79 0.08 0.09 0.11 0.02 0.14 0.83 0.15 0.95
+ 0.21 0.05 0.26 0.02 0.29 0.79 0.31 0.89 0.35 0.07 0.38 0.04
+ 0.39 0.79 0.42 0.94 0.45 0.08 0.48 0.05 0.50 0.80 0.52 0.96
+ 0.59 0.02 0.64 0.01 0.66 0.78 0.68 0.95 0.72 0.06 0.75 0.04
+ 0.76 0.70 0.79 0.96 0.83 0.07 0.85 0.02 0.88 0.80 0.90 1.0
+ 0.95 0.12 0.97 0.04 1.00 0.00)
+ :scaler amp :duration .352 :base .1))
+ (frqf (make-env '(0.0 0.0 0.04 1.0 0.08 0.0 0.11 0.0 0.14 1.0 0.15 0.0
+ 0.21 0.0 0.26 0.0 0.29 1.0 0.31 0.0 0.35 0.0 0.38 0.0
+ 0.39 1.0 0.42 0.0 0.45 0.0 0.48 0.0 0.50 1.0 0.52 0.0
+ 0.59 0.0 0.64 0.0 0.66 1.0 0.68 0.0 0.72 0.0 0.75 0.0
+ 0.76 1.0 0.79 0.0 0.83 0.0 0.85 0.0 0.88 1.0 0.90 0.0
+ 0.95 0.0 0.97 0.0 1.00 0.0)
+ :duration .352 :scaler (hz->radians 60)))
+ (reset-samps (seconds->samples .85))
+ (on-samps (seconds->samples .36))) ; else ampf is 0.0
+
+ (do ((i start (+ i reset-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i on-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (polywave gp (+ (env frqf) (rand-interp rnd))))))
+ (mus-reset pulsef)
+ (mus-reset frqf))))))
;; (with-sound (:play #t) (snowy-tree-cricket 0 2 .3))
@@ -2251,102 +2321,90 @@
;;;
;;; this could use some work
-(definstrument (slightly-musical-conehead beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil 11000))
- (gen2 (make-oscil 5500))
- (gen3 (make-oscil 1100))
- (rnd1 (make-rand-interp 1100 .05))
- (rnd2 (make-rand-interp 1100 .4))
- (ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler amp))
- (pulsef (make-env '(0.00 0.00 0.02 0.29 0.04 0.55 0.07 0.37 0.08 0.06 0.11 0.48 0.14 0.13
- 0.15 0.69 0.18 0.31 0.20 0.07 0.22 0.77 0.23 0.52 0.25 0.77 0.26 0.21
- 0.28 0.70 0.30 0.12 0.34 0.80 0.38 0.17 0.39 0.79 0.42 0.08 0.44 0.54
- 0.48 0.53 0.50 0.85 0.53 0.11 0.55 0.51 0.58 0.79 0.60 0.22 0.62 0.84
- 0.65 0.09 0.67 0.56 0.70 0.91 0.74 0.81 0.77 0.10 0.79 0.70 0.83 0.51
- 0.85 0.90 0.88 0.03 0.90 0.55 0.93 0.60 0.95 0.11 0.97 0.97 1.0 0.00)
- :duration .146))
- (pulser (make-pulse-train (/ 1.0 .36))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (> (pulse-train pulser) .1)
- (mus-reset pulsef))
- (let ((rn (rand-interp rnd1)))
- (outa i (* (env ampf)
- (env pulsef)
- (+ .6 (rand-interp rnd2))
- (oscil gen1
- (+ (* .05 (oscil gen2 (* 5 rn)))
- (* .1 (oscil gen3 rn)))))))))))
+(defanimal (slightly-musical-conehead beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil 11000))
+ (gp (make-polywave 1100 '(1 .1 5 .05)))
+ (rnd1 (make-rand-interp 1100 .05))
+ (rnd2 (make-rand-interp 1100 .4))
+ (pulse-samps (seconds->samples .36))
+ (pulse-out (seconds->samples .146))
+ (pulsef (make-env '(0.00 0.00 0.02 0.29 0.04 0.55 0.07 0.37 0.08 0.06 0.11 0.48 0.14 0.13
+ 0.15 0.69 0.18 0.31 0.20 0.07 0.22 0.77 0.23 0.52 0.25 0.77 0.26 0.21
+ 0.28 0.70 0.30 0.12 0.34 0.80 0.38 0.17 0.39 0.79 0.42 0.08 0.44 0.54
+ 0.48 0.53 0.50 0.85 0.53 0.11 0.55 0.51 0.58 0.79 0.60 0.22 0.62 0.84
+ 0.65 0.09 0.67 0.56 0.70 0.91 0.74 0.81 0.77 0.10 0.79 0.70 0.83 0.51
+ 0.85 0.90 0.88 0.03 0.90 0.55 0.93 0.60 0.95 0.11 0.97 0.97 1.0 0.00)
+ :scaler amp :duration .146)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-out))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (+ .6 (rand-interp rnd2))
+ (oscil gen1 (polywave gp (rand-interp rnd1))))))
+ (mus-reset pulsef)))))
;; (with-sound (:play #t) (slightly-musical-conehead 0 2 .4))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Pine tree cricket
-(definstrument (pine-tree-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (pulse-dur .014)
- (pulsef (make-env '(0.000 0.000 0.027 0.196 0.104 0.448 0.236 0.773 0.341 0.910 0.416 0.975 0.532 1.0
- 0.671 0.868 0.751 0.711 0.833 0.504 0.926 0.160 1.000 0.000)
- :duration pulse-dur))
- (gen1 (make-oscil 3580))
- (gen2 (make-oscil (* 3 3580)))
- (frqf (make-env '(0 1 1 0) :scaler (hz->radians 100) :duration pulse-dur))
- (pulser (make-pulse-train (/ 1.0 .022)))
- (rnd (make-rand-interp 100 .004))
- (ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((pulse (pulse-train pulser))
- (noise (+ (env frqf)
- (rand-interp rnd))))
- (if (> pulse .1)
- (begin
- (mus-reset frqf)
- (mus-reset pulsef)))
- (outa i (* (env ampf)
- (env pulsef)
- (+ (* .97 (oscil gen1 noise))
- (* .03 (oscil gen2 (* 3 noise)))))))))))
+(defanimal (pine-tree-cricket beg dur amp)
+ (let ((pulse-dur .014))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (pulsef (make-env '(0.000 0.000 0.027 0.196 0.104 0.448 0.236 0.773 0.341 0.910 0.416 0.975 0.532 1.0
+ 0.671 0.868 0.751 0.711 0.833 0.504 0.926 0.160 1.000 0.000)
+ :scaler amp :duration pulse-dur))
+ (gp (make-polywave 3580 '(1 .97 3 .03)))
+ (frqf (make-env '(0 1 1 0) :scaler (hz->radians 100) :duration pulse-dur))
+ (pulse-samps (seconds->samples .022))
+ (pulse-out (seconds->samples pulse-dur))
+ (rnd (make-rand-interp 100 .004)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-out))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (polywave gp (+ (env frqf) (rand-interp rnd))))))
+ (mus-reset frqf)
+ (mus-reset pulsef))))))
;; (with-sound (:play #t) (pine-tree-cricket 0 2 .25))
+
;;;--------------------------------------------------------------------------------
;;;
;;; Davis's tree cricket
-(definstrument (davis-tree-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (pulse-dur .013)
- (pulsef (make-env '(0.000 0.000 0.079 0.395 0.245 0.925 0.410 1.000 0.470 0.874
- 0.554 0.549 0.614 0.312 0.728 0.170 1.000 0.000)
- :duration pulse-dur))
- (pitch 2420)
- (gen1 (make-oscil pitch))
- (gen2 (make-oscil (* 2 pitch)))
- (pulser (make-pulse-train (/ 1.0 .014)))
- (rnd (make-rand-interp 150 .004))
- (ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((pulse (pulse-train pulser))
- (noise (rand-interp rnd)))
- (if (> pulse .1)
- (mus-reset pulsef))
- (outa i (* (env ampf)
- (env pulsef)
- (+ (* .93 (oscil gen1 noise))
- (* .07 (oscil gen2 (* 2 noise)))))))))))
+(defanimal (davis-tree-cricket beg dur amp)
+ (let ((pulse-dur .013)
+ (pitch 2420))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (pulse-samps (seconds->samples 0.014))
+ (pulse-out (seconds->samples pulse-dur))
+ (pulsef (make-env '(0.000 0.000 0.079 0.395 0.245 0.925 0.410 1.000 0.470 0.874
+ 0.554 0.549 0.614 0.312 0.728 0.170 1.000 0.000)
+ :scaler amp :duration pulse-dur))
+ (gp (make-polywave pitch '(1 .93 2 .07)))
+ (rnd (make-rand-interp 150 .004)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-out))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (polywave gp (rand-interp rnd)))))
+ (mus-reset pulsef))))))
;; (with-sound (:play #t) (davis-tree-cricket 0 2 .25))
@@ -2355,54 +2413,58 @@
;;;
;;; Black-horned tree cricket
-(definstrument (black-horned-tree-cricket beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 .05 1 .95 1 1 0) :duration dur :scaler amp))
- (gen1 (make-polywave 3680.0 (list 1 .94 2 .04 3 .01 4 .005 5 .003)))
- (rnd (make-rand-interp 1000 (hz->radians 50)))
-
- (pulse-dur 0.0173)
- (pulse-space 0.0219)
- (pulse-samps (seconds->samples pulse-space))
- (pulse-ampf (make-env '(0.000 0.000 0.076 0.443 0.277 0.866 0.454 0.925 0.603 0.771 0.690 0.573 0.726 0.304 1.000 0.000)
- :duration pulse-dur))
- (next-pulse (+ start pulse-samps)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (mus-reset pulse-ampf)
- (set! next-pulse (+ next-pulse pulse-samps))))
- (outa i (* (env ampf)
- (env pulse-ampf)
- (polywave gen1 (rand-interp rnd))))))))
+(defanimal (black-horned-tree-cricket beg dur amp)
+ (let ((pulse-dur 0.0173)
+ (pulse-space 0.0219)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (pulse-samps (seconds->samples pulse-space))
+ (pulse-out (seconds->samples pulse-dur))
+ (ampf (make-env '(0 0 .05 1 .95 1 1 0) :duration dur :scaler amp))
+ (gen1 #f)
+ (rnd (make-rand-interp 1000 (hz->radians 50)))
+ (pulse-ampf (make-env '(0.000 0.000 0.076 0.443 0.277 0.866 0.454 0.925 0.603 0.771 0.690 0.573 0.726 0.304 1.000 0.000)
+ :duration pulse-dur)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! gen1 (make-polywave 3680.0 (list 1 (* pulse-amp .94)
+ 2 (* pulse-amp .04)
+ 3 (* pulse-amp .01)
+ 4 (* pulse-amp .005)
+ 5 (* pulse-amp .003))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulse-ampf)
+ (polywave gen1 (rand-interp rnd)))))
+ (mus-reset pulse-ampf))))))
;; (with-sound (:play #t) (black-horned-tree-cricket 0 2 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Narrow-winged tree cricket
-(definstrument (narrow-winged-tree-cricket beg dur amp)
+(defanimal (narrow-winged-tree-cricket beg dur amp)
;; insects 18 4
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 .1 1 20 1 20.1 0) :duration dur :scaler amp))
- (pulser (make-wave-train-with-env 43.0
- '(0.000 0.000 0.144 0.332 0.269 0.715 0.361 0.838 0.459 0.866 0.609 0.727
- 0.652 0.530 0.780 0.194 1.000 0.000)
- (seconds->samples .0185)))
- (gen1 (make-polywave 1900 (list 1 .8 2 .07 3 .13)))
- (rnd (make-rand-interp 150 (hz->radians 20))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (wave-train pulser)
- (polywave gen1 (rand-interp rnd))))))))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 .1 1 20 1 20.1 0) :duration dur :scaler amp))
+ (pulser (make-wave-train-with-env 43.0
+ '(0.000 0.000 0.144 0.332 0.269 0.715 0.361 0.838 0.459 0.866 0.609 0.727
+ 0.652 0.530 0.780 0.194 1.000 0.000)
+ (seconds->samples .0185)))
+ (gen1 (make-polywave 1900 '(1 .8 2 .07 3 .13)))
+ (rnd (make-rand-interp 150 (hz->radians 20))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (wave-train pulser)
+ (polywave gen1 (rand-interp rnd)))))))
;; (with-sound (:play #t) (narrow-winged-tree-cricket 0 2 .25))
@@ -2411,33 +2473,32 @@
;;;
;;; Four-spotted tree cricket
-(definstrument (four-spotted-tree-cricket beg dur amp)
+(defanimal (four-spotted-tree-cricket beg dur amp)
;; insects 16 4
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 .3 1 20 1 20.3 0) :duration dur :scaler amp))
- (amp-pulser (make-table-lookup-with-env 40.0
- '(0.000 0.000 0.071 0.518 0.174 0.783 0.315 0.885 0.492 0.727 0.579 0.466
- 0.625 0.186 0.671 0.028 0.755 0.083 0.848 0.024 0.935 0.126 1.000 0.000 1.5 0)
- (seconds->samples .025)))
- (index (hz->radians 400))
- (frq-pulser (make-table-lookup-with-env 40.0 (list 0 index 1 0 2 0) (seconds->samples .025)))
- (gen1 (make-polywave 3220 (list 1 .92 2 .07 3 .01)))
- (gen2 (make-oscil 5000))
- (gen3 (make-oscil 2200))
- (rnd1 (make-rand-interp 8000 (hz->radians 2000)))
- (rnd (make-rand-interp 200 (hz->radians 30))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((noise (rand-interp rnd1)))
- (outa i (* (env ampf)
- (+ (* (table-lookup amp-pulser)
- (polywave gen1 (+ (rand-interp rnd)
- (table-lookup frq-pulser))))
- (* .05
- (+ (oscil gen2 noise)
- (* .2 (oscil gen3 (* .2 noise)))))))))))))
+ (let ((index (hz->radians 400)))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 .3 1 20 1 20.3 0) :duration dur :scaler amp))
+ (amp-pulser (make-table-lookup-with-env 40.0
+ '(0.000 0.000 0.071 0.518 0.174 0.783 0.315 0.885 0.492 0.727 0.579 0.466
+ 0.625 0.186 0.671 0.028 0.755 0.083 0.848 0.024 0.935 0.126 1.000 0.000 1.5 0)
+ (seconds->samples .025)))
+ (frq-pulser (make-table-lookup-with-env 40.0 (list 0 index 1 0 2 0) (seconds->samples .025)))
+ (gen1 (make-polywave 3220 '(1 .92 2 .07 3 .01)))
+ (gen2 (make-oscil 5000))
+ (gen3 (make-oscil 2200))
+ (rnd1 (make-rand-interp 8000 (hz->radians 2000)))
+ (rnd (make-rand-interp 200 (hz->radians 30))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((noise (rand-interp rnd1)))
+ (outa i (* (env ampf)
+ (+ (* (table-lookup amp-pulser)
+ (polywave gen1 (+ (rand-interp rnd)
+ (table-lookup frq-pulser))))
+ (* .05
+ (+ (oscil gen2 noise)
+ (* .2 (oscil gen3 (* .2 noise)))))))))))))
;; (with-sound (:play #t) (four-spotted-tree-cricket 0 1 .5))
@@ -2448,78 +2509,78 @@
;;;
;;; Fox sparrow
-(definstrument (fox-sparrow beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (amp-envs (make-vector 10 #f))
- (frq-envs (make-vector 10 #f))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (peep 0)
- (begs (vector 0.0 0.3 0.6 0.93 1.23 1.49 1.74 1.98 2.12 2.29))
- (ends (vector 0.12 0.46 0.85 1.17 1.44 1.7 1.95 2.08 2.26 2.45))
- (durs (let ((v (make-vector 10 0.0)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (v i) (- (ends i) (begs i))))
- v))
- (scls (vector .09 .19 .22 .19 .27 .23 .21 .04 .17 .17))
- (amps (vector (list 0.000 0.000 0.17 0.13 0.38 0.67 0.64 1.0 0.78 0.79 0.9 0.04 1.0 0.0)
- (list 0.000 0.000 0.15 0.15 0.27 0.67 0.37 0.89 0.69 1.0 0.79 0.6 0.8 0.05 1.0 0.0)
- (list 0.000 0.000 0.11 0.28 0.18 0.66 0.35 0.98 0.90 0.92 1.0 0.0)
- (list 0.000 0.000 0.11 0.28 0.14 0.70 0.32 0.98 0.85 0.84 1.0 0.0)
- (list 0.000 0.000 0.11 0.28 0.14 0.70 0.32 0.98 0.85 0.84 1.0 0.0)
- (list 0.000 0.000 0.15 0.86 0.24 1.00 0.63 0.64 0.89 0.61 1.0 0.0)
- (list 0.000 0.000 0.27 0.80 0.37 1.00 0.63 0.64 0.88 0.51 1.0 0.0)
- (list 0.000 0.000 0.08 0.48 0.37 1.00 0.88 0.76 1.00 0.0)
- (list 0.000 0.000 0.12 0.43 0.24 1.00 0.59 0.72 0.88 0.35 1.0 0.0)
- (list 0.000 0.000 0.12 0.43 0.24 1.00 0.59 0.72 0.88 0.35 1.0 0.0)))
- (low-frqs (vector 4260 4010 3910 4970 3360 3160 2810 2310 2700 2700))
- (high-frqs (vector 5120 4170 5420 5520 4220 3410 5470 2460 3710 3710))
- (frqs (vector (list 0 1 1 0)
- (list 0 0 1 .5 8 .6 9 1.0)
- (list 0 1 1 .5 2 .2 3 0)
- (list 0 1 1 0 5 0)
- (list 0 1 1 .3 2 0)
- (list 0 1 1 1)
- (list 0 1 2 .2 3 0)
- (list 0 0 1 .9 2 1)
- (list 0 1 1 .4 2 0)
- (list 0 1 1 .3 2 0)))
- (song-start start)
- (next-song-start (+ start (seconds->samples (+ 8.75 (random .1)))))
- (next-peep (+ start (seconds->samples (begs 1))))
- (rnd (make-rand-interp 100 .01)))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (amp-envs i) (make-env (amps i)
- :scaler (/ (* amp (scls i)) .27)
- :duration (durs i)))
- (set! (frq-envs i) (make-env (frqs i)
- :scaler (hz->radians (- (high-frqs i) (low-frqs i)))
- :offset (hz->radians (low-frqs i))
- :duration (durs i))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (= i next-song-start)
- (begin
- (set! peep -1)
- (set! song-start next-song-start)
- (set! next-song-start (+ next-song-start (seconds->samples (+ 8.75 (random .1)))))))
- (if (= i next-peep)
- (begin
- (set! peep (+ 1 peep))
- (mus-reset (amp-envs peep))
- (mus-reset (frq-envs peep))
- (if (< peep 9)
- (set! next-peep (+ song-start (seconds->samples (begs (+ 1 peep)))))
- (set! next-peep next-song-start))))
- (let ((frq (+ (env (frq-envs peep))
- (rand-interp rnd))))
- (outa i (* (env (amp-envs peep))
- (oscil gen1 frq
- (* .03 (oscil gen2 (* 2 frq)))))))))))
+(defanimal (fox-sparrow beg dur amp)
+ (let ((begs (vector 0.0 0.3 0.6 0.93 1.23 1.49 1.74 1.98 2.12 2.29 3.0))
+ (ends (vector 0.12 0.46 0.85 1.17 1.44 1.7 1.95 2.08 2.26 2.45))
+ (low-frqs (vector 4260 4010 3910 4970 3360 3160 2810 2310 2700 2700))
+ (high-frqs (vector 5120 4170 5420 5520 4220 3410 5470 2460 3710 3710))
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (amp-envs (make-vector 10 #f))
+ (frq-envs (make-vector 10 #f))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (peep 0)
+ (peep-dur 0)
+ (peep-start 0)
+ (durs (let ((v (make-vector 10 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (- (ends i) (begs i))))
+ v))
+ (scls (vector .09 .19 .22 .19 .27 .23 .21 .04 .17 .17))
+ (amps (vector '(0.000 0.000 0.17 0.13 0.38 0.67 0.64 1.0 0.78 0.79 0.9 0.04 1.0 0.0)
+ '(0.000 0.000 0.15 0.15 0.27 0.67 0.37 0.89 0.69 1.0 0.79 0.6 0.8 0.05 1.0 0.0)
+ '(0.000 0.000 0.11 0.28 0.18 0.66 0.35 0.98 0.90 0.92 1.0 0.0)
+ '(0.000 0.000 0.11 0.28 0.14 0.70 0.32 0.98 0.85 0.84 1.0 0.0)
+ '(0.000 0.000 0.11 0.28 0.14 0.70 0.32 0.98 0.85 0.84 1.0 0.0)
+ '(0.000 0.000 0.15 0.86 0.24 1.00 0.63 0.64 0.89 0.61 1.0 0.0)
+ '(0.000 0.000 0.27 0.80 0.37 1.00 0.63 0.64 0.88 0.51 1.0 0.0)
+ '(0.000 0.000 0.08 0.48 0.37 1.00 0.88 0.76 1.00 0.0)
+ '(0.000 0.000 0.12 0.43 0.24 1.00 0.59 0.72 0.88 0.35 1.0 0.0)
+ '(0.000 0.000 0.12 0.43 0.24 1.00 0.59 0.72 0.88 0.35 1.0 0.0)))
+ (frqs (vector '(0 1 1 0)
+ '(0 0 1 .5 8 .6 9 1.0)
+ '(0 1 1 .5 2 .2 3 0)
+ '(0 1 1 0 5 0)
+ '(0 1 1 .3 2 0)
+ '(0 1 1 1)
+ '(0 1 2 .2 3 0)
+ '(0 0 1 .9 2 1)
+ '(0 1 1 .4 2 0)
+ '(0 1 1 .3 2 0)))
+ (rnd (make-rand-interp 100 .01)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (amp-envs i) (make-env (amps i)
+ :scaler (/ (* amp (scls i)) .27)
+ :duration (durs i)))
+ (set! (frq-envs i) (make-env (frqs i)
+ :scaler (hz->radians (- (high-frqs i) (low-frqs i)))
+ :offset (hz->radians (low-frqs i))
+ :duration (durs i))))
+ (set! peep-dur (seconds->samples (durs 0)))
+ (set! peep-start (+ start (seconds->samples (begs 0))))
+
+ (call-with-exit
+ (lambda (done)
+ (do ((i peep-start peep-start))
+ ((>= i stop))
+ (let ((fe (frq-envs peep))
+ (ae (amp-envs peep))
+ (reset-stop (min stop (+ i peep-dur))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((frq (+ (env fe) (rand-interp rnd))))
+ (outa k (* (env ae)
+ (oscil gen1 frq
+ (* .03 (oscil gen2 (* 2.0 frq)))))))))
+ (set! peep (+ peep 1))
+ (if (>= peep 10) (done))
+ (set! peep-start (+ start (seconds->samples (begs peep))))
+ (set! peep-dur (seconds->samples (durs peep)))))))))
+
;; (with-sound (:play #t) (fox-sparrow 0 3 .25))
@@ -2530,147 +2591,135 @@
;;;
;;; probably music of birds 14, 1st song
-(definstrument (white-throated-sparrow beg amp)
- (let* ((start (seconds->samples beg))
- (dur (+ 3.25 (random .2)))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.00 0.00 0.04 0.44 0.09 0.59 0.12 0.59 0.16 0.75 0.17 0.00
- 0.22 0.00
- 0.25 0.76 0.28 0.89 0.29 0.14 0.31 0.93 0.34 0.87 0.35 0.14 0.36 0.85
- 0.37 0.84 0.38 0.00
- 0.42 0.00 0.44 0.86 0.46 0.83 0.47 0.91 0.51 0.92
- 0.52 0.87 0.53 0.00
- 0.57 0.00 0.58 0.65 0.60 0.88 0.61 0.14 0.62 0.95
- 0.63 0.94 0.64 0.20 0.66 0.99 0.67 0.88 0.68 0.00
- 0.72 0.00 0.73 0.65
- 0.75 0.82 0.76 0.13 0.77 0.78 0.78 0.88 0.79 0.83 0.797 0.12 0.803 0.12 0.81 0.79
- 0.82 0.87 0.83 0.00
- 0.87 0.00 0.89 0.58 0.91 0.75 0.917 0.13 0.923 0.13 0.93 0.73
- 0.94 0.84 0.95 0.77 0.957 0.12 0.963 0.12 0.97 0.81 0.98 0.79 1.00 0.00)
- :duration dur :scaler amp))
- (frqf (make-env '(0 0 .17 0.0 .21 1
- 0.22 1.5 0.23 1 0.41 1
- 0.42 1.25 0.43 1 0.56 1
- 0.57 1.25 0.58 1 0.71 1
- 0.72 1.25 0.73 1 0.86 1
- 0.87 1.25 0.88 1
- 1 1)
- :scaler (hz->radians 720) :duration dur))
- (pitch 3800)
- (gen1 (make-oscil pitch))
- (gen2 (make-oscil (* 2 pitch)))
- (gen3 (make-oscil (* 3 pitch)))
- (rnd (make-rand-interp 30 .005)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (mus-random 0.001)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (* .9 (oscil gen1 frq))
- (* .025 (oscil gen2 (* 2 frq)))
- (* .075 (oscil gen3 (* 3 frq)))))))))))
+(defanimal (white-throated-sparrow beg amp)
+ (let ((dur (+ 3.25 (random .2)))
+ (pitch 3800))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.00 0.00 0.04 0.44 0.09 0.59 0.12 0.59 0.16 0.75 0.17 0.00
+ 0.22 0.00
+ 0.25 0.76 0.28 0.89 0.29 0.14 0.31 0.93 0.34 0.87 0.35 0.14 0.36 0.85
+ 0.37 0.84 0.38 0.00
+ 0.42 0.00 0.44 0.86 0.46 0.83 0.47 0.91 0.51 0.92
+ 0.52 0.87 0.53 0.00
+ 0.57 0.00 0.58 0.65 0.60 0.88 0.61 0.14 0.62 0.95
+ 0.63 0.94 0.64 0.20 0.66 0.99 0.67 0.88 0.68 0.00
+ 0.72 0.00 0.73 0.65
+ 0.75 0.82 0.76 0.13 0.77 0.78 0.78 0.88 0.79 0.83 0.797 0.12 0.803 0.12 0.81 0.79
+ 0.82 0.87 0.83 0.00
+ 0.87 0.00 0.89 0.58 0.91 0.75 0.917 0.13 0.923 0.13 0.93 0.73
+ 0.94 0.84 0.95 0.77 0.957 0.12 0.963 0.12 0.97 0.81 0.98 0.79 1.00 0.00)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 0 .17 0.0 .21 1
+ 0.22 1.5 0.23 1 0.41 1
+ 0.42 1.25 0.43 1 0.56 1
+ 0.57 1.25 0.58 1 0.71 1
+ 0.72 1.25 0.73 1 0.86 1
+ 0.87 1.25 0.88 1
+ 1 1)
+ :scaler (hz->radians 720) :duration dur))
+ (gen1 (make-polywave pitch :partials '(1 .9 2 .025 3 .075)))
+ (rnd (make-rand-interp 30 .005)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (mus-random 0.001)
+ (rand-interp rnd)))))))))
;; (with-sound (:play #t) (white-throated-sparrow 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Henslow's sparrow
-(definstrument (henslows-sparrow beg amp)
+(defanimal (henslows-sparrow beg amp)
;; "the poorest vocal effort of any bird" -- R T Peterson
- (let* ((start (seconds->samples beg))
- (dur 0.24)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.00 0.00 0.05 0.42 0.08 0.03 0.10 0.30 0.12 0.02
- 0.21 0.00 0.22 0.69 0.23 0.34 0.24 0.84 0.26 0.64
- 0.28 0.04 0.29 0.11 0.30 0.47 0.32 0.00 0.46 0.00
- 0.48 0.04 0.52 1.00 0.53 0.97 0.54 0.44 0.55 0.80
- 0.57 0.02 0.58 0.07 0.59 0.72 0.60 0.45 0.61 0.79
- 0.62 0.66 0.63 0.81 0.66 0.05 0.67 0.16 0.73 0.50
- 0.75 0.52 0.78 0.04 0.81 0.03 0.82 0.08 0.85 0.47
- 0.87 0.22 0.88 0.39 0.90 0.09 0.91 0.36 0.96 0.39
- 0.98 0.07 1.00 0.00)
- :duration dur :scaler amp))
- (gen1 (make-oscil))
- (frqf (make-env '(0.00 9310 0.05 9560 0.08 9480 0.10 9900 0.11 8140 0.12 9900
- 0.21 9980 0.22 8630 0.23 8800 0.24 8400 0.26 8800
- 0.28 8600 0.29 8800 0.30 8300 0.32 8100 0.46 8100
- 0.48 5600 0.49 5200 0.52 6200 0.54 4800 0.55 6600
- 0.57 5800 0.58 5800 0.59 6200 0.60 6200
- 0.62 5800 0.66 3600 0.67 4400 0.73 3900 0.78 3100 0.85 4900
- 0.88 3600 0.90 3900 0.91 4400 1.00 3900)
- :duration dur :scaler (hz->radians 1.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (env frqf))))))))
+ (let ((dur 0.24))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.00 0.00 0.05 0.42 0.08 0.03 0.10 0.30 0.12 0.02
+ 0.21 0.00 0.22 0.69 0.23 0.34 0.24 0.84 0.26 0.64
+ 0.28 0.04 0.29 0.11 0.30 0.47 0.32 0.00 0.46 0.00
+ 0.48 0.04 0.52 1.00 0.53 0.97 0.54 0.44 0.55 0.80
+ 0.57 0.02 0.58 0.07 0.59 0.72 0.60 0.45 0.61 0.79
+ 0.62 0.66 0.63 0.81 0.66 0.05 0.67 0.16 0.73 0.50
+ 0.75 0.52 0.78 0.04 0.81 0.03 0.82 0.08 0.85 0.47
+ 0.87 0.22 0.88 0.39 0.90 0.09 0.91 0.36 0.96 0.39
+ 0.98 0.07 1.00 0.00)
+ :duration dur :scaler amp))
+ (gen1 (make-oscil))
+ (frqf (make-env '(0.00 9310 0.05 9560 0.08 9480 0.10 9900 0.11 8140 0.12 9900
+ 0.21 9980 0.22 8630 0.23 8800 0.24 8400 0.26 8800
+ 0.28 8600 0.29 8800 0.30 8300 0.32 8100 0.46 8100
+ 0.48 5600 0.49 5200 0.52 6200 0.54 4800 0.55 6600
+ 0.57 5800 0.58 5800 0.59 6200 0.60 6200
+ 0.62 5800 0.66 3600 0.67 4400 0.73 3900 0.78 3100 0.85 4900
+ 0.88 3600 0.90 3900 0.91 4400 1.00 3900)
+ :duration dur :scaler (hz->radians 1.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (env frqf))))))))
;; (with-sound (:play #t) (henslows-sparrow 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Eastern wood-pewee
-(definstrument (eastern-wood-pewee-1 beg amp)
+(defanimal (eastern-wood-pewee-1 beg amp)
;; probably east 39 3
- (let* ((start (seconds->samples beg))
- (dur 1.07)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.037 0.894 0.045 0.711 0.061 0.845 0.072 0.760 0.076 0.912
- 0.084 0.838 0.099 0.982 0.111 0.729 0.124 0.879 0.142 0.011 0.15 0.01 0.165 0.778
- 0.172 0.601 0.180 0.706 0.212 0.441 0.258 0.227 0.298 0.325 0.312 0.564
- 0.334 0.312 0.365 0.399 0.416 0.260 0.475 0.196 0.555 0.356 0.631 0.363
- 0.712 0.294 0.746 0.464 0.753 0.369 0.776 0.508 0.799 0.425 0.825 0.479
- 0.869 0.485 0.877 0.567 0.907 0.541 0.918 0.459 0.942 0.513 0.977 0.366
- 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (frqf (make-env '(0 3370 .03 4300 .1 4600 .14 3400 0.15 4400 .16 3700 .18 4400 .24 4700 .3 4600 .34 3600 .4 3700 .6 3800 .8 4000 1.0 3900)
- :duration dur :base .1 :scaler (hz->radians 1.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* .905 (oscil gen1 frq))
- (* .025 (oscil gen2 (* 2 frq)))
- (* .025 (oscil gen3 (* 3 frq)))))))))))
+ (let ((dur 1.07))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.037 0.894 0.045 0.711 0.061 0.845 0.072 0.760 0.076 0.912
+ 0.084 0.838 0.099 0.982 0.111 0.729 0.124 0.879 0.142 0.011 0.15 0.01 0.165 0.778
+ 0.172 0.601 0.180 0.706 0.212 0.441 0.258 0.227 0.298 0.325 0.312 0.564
+ 0.334 0.312 0.365 0.399 0.416 0.260 0.475 0.196 0.555 0.356 0.631 0.363
+ 0.712 0.294 0.746 0.464 0.753 0.369 0.776 0.508 0.799 0.425 0.825 0.479
+ 0.869 0.485 0.877 0.567 0.907 0.541 0.918 0.459 0.942 0.513 0.977 0.366
+ 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .905 2 .025 3 .025)))
+ (frqf (make-env '(0 3370 .03 4300 .1 4600 .14 3400 0.15 4400 .16 3700 .18 4400 .24 4700 .3 4600 .34 3600 .4 3700 .6 3800 .8 4000 1.0 3900)
+ :duration dur :base .1 :scaler (hz->radians 1.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (eastern-wood-pewee-1 0 .25))
-(definstrument (eastern-wood-pewee-2 beg amp)
+
+(defanimal (eastern-wood-pewee-2 beg amp)
;; probably east 39 14
- (let* ((start (seconds->samples beg))
- (dur 1.07)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.055 0.665 0.081 0.657 0.101 0.456 0.140 0.572
- 0.165 0.477 0.219 0.564 0.288 0.526 0.306 0.668 0.328 0.613
- 0.387 0.830 0.402 1.000 0.434 0.768 0.455 0.214 0.470 0.173
- 0.484 0.387 0.499 0.631 0.512 0.229 0.559 0.142 0.582 0.165
- 0.698 0.085 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (frqf (make-env '(0 3250 .1 4400 .2 4800 .3 4800 .47 4000 .49 6300 .51 3600 1.0 2800)
- :duration dur :base .03 :scaler (hz->radians 1.0)))
- (indf (make-env '(0 0 .35 0 .55 1 1 1) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf))
- (ind (env indf)))
- (outa i (* (env ampf)
- (+ (* .9 (oscil gen1 frq))
- (* ind .1 (oscil gen2 (* 2 frq)))
- (* (- 1.0 ind) .075 (oscil gen3 (* 3 frq)))))))))))
+ (let ((dur 1.07))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.055 0.665 0.081 0.657 0.101 0.456 0.140 0.572
+ 0.165 0.477 0.219 0.564 0.288 0.526 0.306 0.668 0.328 0.613
+ 0.387 0.830 0.402 1.000 0.434 0.768 0.455 0.214 0.470 0.173
+ 0.484 0.387 0.499 0.631 0.512 0.229 0.559 0.142 0.582 0.165
+ 0.698 0.085 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (frqf (make-env '(0 3250 .1 4400 .2 4800 .3 4800 .47 4000 .49 6300 .51 3600 1.0 2800)
+ :duration dur :base .03 :scaler (hz->radians 1.0)))
+ (indf (make-env '(0 0 .35 0 .55 1 1 1) :duration dur :scaler 0.1))
+ (indf-1 (make-env '(0 0 .35 0 .55 1 1 1) :duration dur :offset 1.0 :scaler -1.0)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* .9 (oscil gen1 frq))
+ (* (env indf) (oscil gen2 (* 2.0 frq)))
+ (* (env indf-1) .075 (oscil gen3 (* 3.0 frq)))))))))))
;; (with-sound (:play #t) (eastern-wood-pewee-2 0 .25))
@@ -2679,85 +2728,78 @@
;;;
;;; Field sparrow
-(definstrument (field-sparrow beg amp)
- (let* ((start (seconds->samples beg))
- (dur 2.92)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.025 0.201 0.095 0.307 0.113 0.235 0.122 0.005 0.146 0.000
- 0.167 0.696 0.201 0.430 0.241 0.325 0.243 0.000 0.265 0.000
- 0.287 0.840 0.300 0.791 0.312 0.567 0.354 0.369 0.365 0.000 0.388 0.000
- 0.405 0.853 0.430 0.621 0.449 0.387 0.470 0.314 0.477 0.000 0.493 0.000
- 0.511 0.887 0.529 0.796 0.552 0.402 0.566 0.327 0.578 0.000 0.594 0.000
- 0.614 0.966 0.629 0.446 0.645 0.273 0.649 0.000 0.65 0.0 0.664 0.026
- 0.673 1.0 0.690 0.459 0.706 0.000 0.714 0.031
- 0.719 0.892 0.74 0.0 0.747 0.000
- 0.755 0.851 0.773 0.0 0.781 0.000
- 0.790 0.869 0.81 0.0 0.814 0.000
- 0.827 0.827 0.845 0.0 0.849 0.000
- 0.861 0.786 0.878 0.0 0.882 0.000
- 0.894 0.716 0.912 0.0 0.918 0.000
- 0.925 0.711 0.943 0.0 0.949 0.000
- 0.959 0.657 0.97 0.0 0.975 0.000
- 0.984 0.536 0.993 0.149
- 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (frqf (make-env '(0.000 4300 0.025 4300 0.1 3300 0.122 3300
- 0.146 4300 0.18 4300 0.23 3300 0.243 3300
- 0.265 4300 0.3 4300 0.35 3300 0.365 3300
- 0.388 4300 0.42 4300 0.46 3300 0.477 3300
- 0.493 4300 0.52 4300 0.56 3300 0.578 3300
- 0.594 4300 0.61 4300 0.63 3300 0.649 3300 0.65 4300
- 0.664 4300 0.68 4300 0.714 3300
- 0.716 4300 0.74 3200 0.747 4300
- 0.75 4300 0.773 3200 0.781 4300
- 0.785 4300 0.81 3200 0.814 4300
- 0.82 4300 0.845 3200 0.849 4300
- 0.85 4300 0.878 3200 0.882 4300
- 0.89 4300 0.912 3200 0.918 4300
- 0.92 4300 0.943 3200 0.949 4300
- 0.95 4300 0.97 3200 0.975 4300
- 0.98 4300 0.993 3200
- 1.000 3300)
- :duration dur :scaler (hz->radians 1.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* .99 (oscil gen1 frq))
- (* .01 (oscil gen2 (* 2 frq)))))))))))
+(defanimal (field-sparrow beg amp)
+ (let ((dur 2.92))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.025 0.201 0.095 0.307 0.113 0.235 0.122 0.005 0.146 0.000
+ 0.167 0.696 0.201 0.430 0.241 0.325 0.243 0.000 0.265 0.000
+ 0.287 0.840 0.300 0.791 0.312 0.567 0.354 0.369 0.365 0.000 0.388 0.000
+ 0.405 0.853 0.430 0.621 0.449 0.387 0.470 0.314 0.477 0.000 0.493 0.000
+ 0.511 0.887 0.529 0.796 0.552 0.402 0.566 0.327 0.578 0.000 0.594 0.000
+ 0.614 0.966 0.629 0.446 0.645 0.273 0.649 0.000 0.65 0.0 0.664 0.026
+ 0.673 1.0 0.690 0.459 0.706 0.000 0.714 0.031
+ 0.719 0.892 0.74 0.0 0.747 0.000
+ 0.755 0.851 0.773 0.0 0.781 0.000
+ 0.790 0.869 0.81 0.0 0.814 0.000
+ 0.827 0.827 0.845 0.0 0.849 0.000
+ 0.861 0.786 0.878 0.0 0.882 0.000
+ 0.894 0.716 0.912 0.0 0.918 0.000
+ 0.925 0.711 0.943 0.0 0.949 0.000
+ 0.959 0.657 0.97 0.0 0.975 0.000
+ 0.984 0.536 0.993 0.149
+ 1.000 0.000)
+ :duration dur :scaler amp))
+ (gp (make-polywave 0.0 '(1 .99 2 .01)))
+ (frqf (make-env '(0.000 4300 0.025 4300 0.1 3300 0.122 3300
+ 0.146 4300 0.18 4300 0.23 3300 0.243 3300
+ 0.265 4300 0.3 4300 0.35 3300 0.365 3300
+ 0.388 4300 0.42 4300 0.46 3300 0.477 3300
+ 0.493 4300 0.52 4300 0.56 3300 0.578 3300
+ 0.594 4300 0.61 4300 0.63 3300 0.649 3300 0.65 4300
+ 0.664 4300 0.68 4300 0.714 3300
+ 0.716 4300 0.74 3200 0.747 4300
+ 0.75 4300 0.773 3200 0.781 4300
+ 0.785 4300 0.81 3200 0.814 4300
+ 0.82 4300 0.845 3200 0.849 4300
+ 0.85 4300 0.878 3200 0.882 4300
+ 0.89 4300 0.912 3200 0.918 4300
+ 0.92 4300 0.943 3200 0.949 4300
+ 0.95 4300 0.97 3200 0.975 4300
+ 0.98 4300 0.993 3200
+ 1.000 3300)
+ :duration dur :scaler (hz->radians 1.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gp (env frqf))))))))
;; (with-sound (:play #t) (field-sparrow 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Tufted titmouse
-(definstrument (tufted-titmouse beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.0)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.00 0.034 0.637 0.060 0.591 0.074 0.458 0.095 0.872 0.119 0.473 0.185 0.033 0.211 0.102
- 0.233 0.00 0.384 0.00 0.425 0.926 0.447 0.898 0.461 0.665 0.471 1.0 0.497 0.578 0.529 0.422 0.565 0.054 0.594 0.107
- 0.616 0.00 0.755 0.00 0.807 0.905 0.829 0.870 0.837 0.675 0.847 0.992 0.867 0.739 0.891 0.486 0.942 0.056 0.970 0.130
- 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.0 3730 .04 3900 .07 3770 .09 2800 .17 2470 .19 2050 .21 2320 .23 2100
- .38 3730 .42 3900 .45 3770 .46 2760 .53 2470 .55 2050 .58 2320 .6 2100
- .75 3730 .79 3900 .83 3770 .84 2720 .91 2470 .94 2050 .96 2320 1.0 2100)
- :duration dur :base .1 :scaler (hz->radians 1.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* .99 (oscil gen1 frq))
- (* .01 (oscil gen2 (* frq 2)))))))))))
+(defanimal (tufted-titmouse beg amp)
+ (let ((dur 1.0))
+ (let ((start (seconds->samples beg))
+
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.00 0.034 0.637 0.060 0.591 0.074 0.458 0.095 0.872 0.119 0.473 0.185 0.033 0.211 0.102
+ 0.233 0.00 0.384 0.00 0.425 0.926 0.447 0.898 0.461 0.665 0.471 1.0 0.497 0.578 0.529 0.422 0.565 0.054 0.594 0.107
+ 0.616 0.00 0.755 0.00 0.807 0.905 0.829 0.870 0.837 0.675 0.847 0.992 0.867 0.739 0.891 0.486 0.942 0.056 0.970 0.130
+ 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.0 3730 .04 3900 .07 3770 .09 2800 .17 2470 .19 2050 .21 2320 .23 2100
+ .38 3730 .42 3900 .45 3770 .46 2760 .53 2470 .55 2050 .58 2320 .6 2100
+ .75 3730 .79 3900 .83 3770 .84 2720 .91 2470 .94 2050 .96 2320 1.0 2100)
+ :duration dur :base .1 :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (tufted-titmouse 0 .3))
@@ -2768,150 +2810,138 @@
;;;
;;; 8 separate calls make up a song
-(definstrument (savannah-sparrow beg amp)
+(defanimal (savannah-sparrow beg amp)
(define (savannah-1 beg amp)
;; peeps
- (let* ((start (seconds->samples beg))
- (dur .05)
- (stop (+ start (seconds->samples dur)))
- (hi-pitch 9000)
- (lo-pitch 7460)
- (ampf (make-env '(0 0 1 1 2 0) :duration dur :scaler amp))
- (frqf (make-env '(0 1 1 0) :duration dur :scaler (hz->radians (- hi-pitch lo-pitch)) :offset (hz->radians lo-pitch)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (gen3 (make-oscil 80)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ .8 (* .2 (abs (oscil gen3))))
- (+ (* .98 (oscil gen1 frq))
- (* .02 (oscil gen2 (* 2 frq)))))))))))
+ (let ((dur .05)
+ (hi-pitch 9000)
+ (lo-pitch 7460))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 2 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 1 1 0) :duration dur :scaler (hz->radians (- hi-pitch lo-pitch)) :offset (hz->radians lo-pitch)))
+ (gp (make-polywave 0.0 '(1 .98 2 .02)))
+ (gen3 (make-oscil 80)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .8 (* .2 (abs (oscil gen3))))
+ (polywave gp (env frqf))))))))
(define (savannah-2 beg amp pitch)
;; buzz
- (let* ((start (seconds->samples beg))
- (dur .008)
- (stop (+ start (seconds->samples dur)))
- (hi-pitch (+ pitch 400))
- (lo-pitch pitch)
- (ampf (make-env '(0.000 0.000 0.094 0.228 0.148 0.832 0.248 1.000 0.364 0.695 0.522 0.586 0.634 0.284 0.801 0.558 0.891 0.102 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 1 1 0) :duration dur :scaler (hz->radians (- hi-pitch lo-pitch)) :offset (hz->radians lo-pitch)))
- (gen1 (make-oscil))
- (rnd (make-rand-interp 300 .03)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (+ (env frqf)
- (rand-interp rnd)))))))))
+ (let ((dur .008)
+ (hi-pitch (+ pitch 400))
+ (lo-pitch pitch))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.094 0.228 0.148 0.832 0.248 1.000 0.364 0.695 0.522 0.586 0.634 0.284 0.801 0.558 0.891 0.102 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 1 1 0) :duration dur :scaler (hz->radians (- hi-pitch lo-pitch)) :offset (hz->radians lo-pitch)))
+ (gen1 (make-oscil))
+ (rnd (make-rand-interp 300 .03)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (+ (env frqf)
+ (rand-interp rnd)))))))))
(define (savannah-3 beg amp)
;; ticks
- (let* ((start (seconds->samples beg))
- (dur .004)
- (stop (+ start (seconds->samples dur)))
- (rnd (make-rand 4000 .4))
- (gen1 (make-oscil 8000))
- (ampf (make-env '(0 0 1 1 2 .3 10 0) :duration dur :base 32 :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (rand rnd))))))))
+ (let ((dur .004))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (rnd (make-rand 4000 .4))
+ (gen1 (make-oscil 8000))
+ (ampf (make-env '(0 0 1 1 2 .3 10 0) :duration dur :base 32 :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (rand rnd))))))))
(define (savannah-4 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .034)
- (stop (+ start (seconds->samples dur)))
- (rnd (make-rand 12000 .1))
- (gen1 (make-oscil 6400))
- (frqf (make-env '(0 .5 1 0 2 1 4 1) :scaler (hz->radians 400) :duration dur))
- (ampf (make-env '(0.000 0.000 0.045 0.018 0.067 0.196 0.096 0.004 0.166 0.032 0.196 0.207 0.209 0.116
- 0.239 0.575 0.249 0.639 0.280 0.063 0.297 0.032 0.312 0.070 0.339 0.021 0.372 0.049
- 0.378 0.544 0.391 0.088 0.437 0.211 0.441 0.611 0.455 0.218 0.480 0.140 0.498 0.253
- 0.506 0.593 0.516 0.228 0.532 0.098 0.551 0.200 0.569 0.544 0.593 0.253 0.630 0.540
- 0.660 0.133 0.684 0.540 0.722 0.158 0.748 0.604 0.760 0.779 0.787 0.260 0.824 1.000
- 0.847 0.249 0.878 0.874 0.917 0.204 0.976 0.056 1.000 0.000)
- :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (+ (env frqf) (rand rnd)))))))))
+ (let ((dur .034))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (rnd (make-rand 12000 .1))
+ (gen1 (make-oscil 6400))
+ (frqf (make-env '(0 .5 1 0 2 1 4 1) :scaler (hz->radians 400) :duration dur))
+ (ampf (make-env '(0.000 0.000 0.045 0.018 0.067 0.196 0.096 0.004 0.166 0.032 0.196 0.207 0.209 0.116
+ 0.239 0.575 0.249 0.639 0.280 0.063 0.297 0.032 0.312 0.070 0.339 0.021 0.372 0.049
+ 0.378 0.544 0.391 0.088 0.437 0.211 0.441 0.611 0.455 0.218 0.480 0.140 0.498 0.253
+ 0.506 0.593 0.516 0.228 0.532 0.098 0.551 0.200 0.569 0.544 0.593 0.253 0.630 0.540
+ 0.660 0.133 0.684 0.540 0.722 0.158 0.748 0.604 0.760 0.779 0.787 0.260 0.824 1.000
+ 0.847 0.249 0.878 0.874 0.917 0.204 0.976 0.056 1.000 0.000)
+ :duration dur :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (+ (env frqf) (rand rnd)))))))))
(define (savannah-5 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .071)
- (stop (+ start (seconds->samples dur)))
- (rnd (make-rand 12000 .1))
- (gen1 (make-oscil 8500))
- (ampf (make-env '(0.000 0.000 0.067 0.060 0.084 0.432 0.098 0.414 0.111 1.000 0.123 0.267 0.148 0.028
- 0.160 0.877 0.181 0.151 0.189 0.007 0.305 0.007 0.316 0.347 0.331 0.225 0.341 1.000
- 0.353 0.382 0.360 0.137 0.374 0.039 0.388 0.053 0.398 0.919 0.404 0.688 0.415 0.196
- 0.438 0.000 0.530 0.000 0.542 0.502 0.561 0.151 0.573 0.958 0.586 0.218 0.599 0.035
- 0.616 0.067 0.623 0.811 0.642 0.144 0.661 0.000 0.767 0.000 0.785 0.225 0.799 0.923
- 0.822 0.000 0.853 0.000 0.861 0.674 0.880 0.053 0.906 0.000 1.000 0.000)
- :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (rand rnd))))))))
+ (let ((dur .071))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (rnd (make-rand 12000 .1))
+ (gen1 (make-oscil 8500))
+ (ampf (make-env '(0.000 0.000 0.067 0.060 0.084 0.432 0.098 0.414 0.111 1.000 0.123 0.267 0.148 0.028
+ 0.160 0.877 0.181 0.151 0.189 0.007 0.305 0.007 0.316 0.347 0.331 0.225 0.341 1.000
+ 0.353 0.382 0.360 0.137 0.374 0.039 0.388 0.053 0.398 0.919 0.404 0.688 0.415 0.196
+ 0.438 0.000 0.530 0.000 0.542 0.502 0.561 0.151 0.573 0.958 0.586 0.218 0.599 0.035
+ 0.616 0.067 0.623 0.811 0.642 0.144 0.661 0.000 0.767 0.000 0.785 0.225 0.799 0.923
+ 0.822 0.000 0.853 0.000 0.861 0.674 0.880 0.053 0.906 0.000 1.000 0.000)
+ :duration dur :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (rand rnd))))))))
(define (savannah-6 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .023)
- (stop (+ start (seconds->samples dur)))
- (rnd (make-rand 3500 .15))
- (gen1 (make-oscil 3600))
- (ampf (make-env '(0.000 0.000 0.297 0.323 0.339 0.547 0.388 0.891 0.439 1.000 0.553 0.975 0.591 0.295
- 0.615 0.168 0.678 0.011 0.731 0.105 0.758 0.709 0.800 0.312 0.884 0.077 1.000 0.000)
- :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (rand rnd))))))))
+ (let ((dur .023))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (rnd (make-rand 3500 .15))
+ (gen1 (make-oscil 3600))
+ (ampf (make-env '(0.000 0.000 0.297 0.323 0.339 0.547 0.388 0.891 0.439 1.000 0.553 0.975 0.591 0.295
+ 0.615 0.168 0.678 0.011 0.731 0.105 0.758 0.709 0.800 0.312 0.884 0.077 1.000 0.000)
+ :duration dur :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (rand rnd))))))))
(define (savannah-7 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .053)
- (stop (+ start (seconds->samples dur)))
- (hi-pitch 8250)
- (lo-pitch 6900)
- (ampf (make-env '(0 0 2 1 3 0) :duration dur :scaler amp))
- (frqf (make-env '(0 0 1 1) :duration dur :scaler (hz->radians (- hi-pitch lo-pitch)) :offset (hz->radians lo-pitch)))
- (gen1 (make-oscil))
- (gen2 (make-oscil 220)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ .25 (* .75 (abs (oscil gen2))))
- (oscil gen1 frq))))))))
+ (let ((dur .053)
+ (hi-pitch 8250)
+ (lo-pitch 6900))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 2 1 3 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 0 1 1) :duration dur :scaler (hz->radians (- hi-pitch lo-pitch)) :offset (hz->radians lo-pitch)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil 220)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .25 (* .75 (abs (oscil gen2))))
+ (oscil gen1 (env frqf))))))))
(define (savannah-8 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .023)
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil 3800))
- (gen2 (make-oscil 150))
- (ampf (make-env '(0.000 0.000 0.138 0.098 0.199 0.218 0.258 0.018 0.367 0.404 0.422 0.361 0.462 0.011
- 0.549 0.782 0.639 0.519 0.665 0.000 0.678 0.379 0.707 1.000 0.801 0.551 0.835 0.165
- 0.850 0.337 1.000 0.000)
- :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 0.0 (* 2.0 (oscil gen2)))))))))
+ (let ((dur .023))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil 3800))
+ (gen2 (make-oscil 150))
+ (ampf (make-env '(0.000 0.000 0.138 0.098 0.199 0.218 0.258 0.018 0.367 0.404 0.422 0.361 0.462 0.011
+ 0.549 0.782 0.639 0.519 0.665 0.000 0.678 0.379 0.707 1.000 0.801 0.551 0.835 0.165
+ 0.850 0.337 1.000 0.000)
+ :duration dur :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 0.0 (* 2.0 (oscil gen2)))))))))
;; --------
(savannah-1 beg (* amp .21))
@@ -2933,8 +2963,7 @@
(savannah-6 (+ beg 1.46) (* amp .15))
(savannah-6 (+ beg 1.5) (* amp .15))
- (let* ((beg2 0.0)
- (repeats 20)
+ (let* ((repeats 20)
(af-incr (/ .6 repeats)))
(do ((i 0 (+ i 1))
(beg2 0.0 (+ beg2 .004))
@@ -2963,116 +2992,111 @@
;; (with-sound (:play #t) (savannah-sparrow 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Chipping sparrow
-(definstrument (chipping-sparrow beg amp)
- (let* ((start (seconds->samples beg))
- (repeats (+ 20 (random 25)))
- (total-dur (* repeats .068))
- (stop (+ start (seconds->samples total-dur)))
- (ampf (make-env '(0 0 1 .7 2 1 10 1 11 0) :duration total-dur :scaler amp))
- (dur .055)
- (pulsef (make-env '(0.000 0.000 0.049 0.091 0.179 0.636 0.253 0.186 0.293 0.518 0.361 0.170 0.413 0.079
- 0.503 0.253 0.609 0.976 0.660 0.937 0.742 0.688 0.783 0.292 0.853 0.043 0.913 0.119 1.000 0.000)
- :duration dur))
- (frqf (make-env '(0 7600 .1 7900
- .18 8700 .2 9000 .23 8300
- .32 5300 .4 4300 .5 4800
- .6 5600 0.8 6400 1.0 5400)
- :duration dur :base 32 :scaler (hz->radians 1.0)))
- (gen1 (make-oscil))
- (pulser (make-pulse-train (/ 1.0 .068)))
- (rnd (make-rand-interp 100 .02)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((pulse (pulse-train pulser))
- (frq (+ (env frqf)
- (rand-interp rnd))))
- (if (> pulse .1)
- (begin
- (mus-reset pulsef)
- (mus-reset frqf)))
- (outa i (* (env ampf)
- (env pulsef)
- (oscil gen1 frq))))))))
+(defanimal (chipping-sparrow beg amp)
+ (let ((dur .055)
+ (repeats (+ 20 (random 25))))
+ (let ((start (seconds->samples beg))
+ (total-dur (* repeats .068)))
+ (let ((stop (+ start (seconds->samples total-dur)))
+ (ampf (make-env '(0 0 1 .7 2 1 10 1 11 0) :duration total-dur :scaler amp))
+ (pulsef (make-env '(0.000 0.000 0.049 0.091 0.179 0.636 0.253 0.186 0.293 0.518 0.361 0.170 0.413 0.079
+ 0.503 0.253 0.609 0.976 0.660 0.937 0.742 0.688 0.783 0.292 0.853 0.043 0.913 0.119 1.000 0.000)
+ :duration dur))
+ (frqf (make-env '(0 7600 .1 7900
+ .18 8700 .2 9000 .23 8300
+ .32 5300 .4 4300 .5 4800
+ .6 5600 0.8 6400 1.0 5400)
+ :duration dur :base 32 :scaler (hz->radians 1.0)))
+ (gen1 #f)
+ (pulse-samps (seconds->samples .068))
+ (pulse-out (seconds->samples dur)) ; pulsef and frqf dur
+ (rnd (make-rand-interp 100 .02)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! gen1 (make-polywave 0.0 (list 1 pulse-amp)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (polywave gen1 (+ (env frqf) (rand-interp rnd))))))
+ (mus-reset pulsef)
+ (mus-reset frqf)))))))
;; (with-sound (:play #t) (chipping-sparrow 0 .3))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Least flycatcher
-(definstrument (least-flycatcher beg amp)
- (let* ((start (seconds->samples beg))
- (call1-dur .032)
- (stop1 (+ start (seconds->samples call1-dur)))
-
- (ampf1 (make-env '(0.000 0.000 0.223 0.158 0.386 0.379 0.617 1.0 0.679 0.929 0.810 0.458 1.000 0.000) :duration call1-dur :scaler amp))
- (gen1 (make-oscil))
- (gen11 (make-oscil))
- (frqf1 (make-env '(0 3000 .4 6250 .5 6400 1.0 6000) :duration call1-dur :scaler (hz->radians 1.0)))
-
- (pause .065)
- (start2 (+ start (seconds->samples pause)))
- (call2-dur .04)
- (stop2 (+ start2 (seconds->samples call2-dur)))
-
- (ampf2 (make-env '(0.000 0.000 0.088 0.124 0.157 0.258 0.198 0.202 0.237 0.264 0.273 0.823 0.286 0.419
- 0.328 0.814 0.343 1.000 0.360 0.329 0.409 0.413 0.435 0.935 0.448 0.295 0.481 0.183
- 0.539 0.901 0.563 0.444 0.619 0.373 0.644 0.944 0.662 0.311 0.724 0.053 0.756 0.186
- 0.782 0.432 0.823 0.512 0.865 0.174 0.886 0.230 1.000 0.000)
- :duration call2-dur :scaler (* .5 amp)))
- (gen2 (make-oscil 4600))
- (gen21 (make-oscil 5600))
- (gen22 (make-rand-interp 2000 (hz->radians 1000))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop1))
- (let ((frq (env frqf1)))
- (outa i (* (env ampf1)
- (+ (* .9 (oscil gen1 frq))
- (* .1 (oscil gen11 (* 2 frq))))))))
- (do ((i start2 (+ i 1)))
- ((= i stop2))
- (let ((noise (rand-interp gen22)))
- (outa i (* (env ampf2)
- (+ (* .7 (oscil gen2 noise))
- (* .3 (oscil gen21 noise))))))))))
+(defanimal (least-flycatcher beg amp)
+ (let ((call1-dur .032)
+ (pause .065)
+ (call2-dur .04)
+ (start (seconds->samples beg)))
+ (let ((stop1 (+ start (seconds->samples call1-dur)))
+ (ampf1 (make-env '(0.000 0.000 0.223 0.158 0.386 0.379 0.617 1.0 0.679 0.929 0.810 0.458 1.000 0.000) :duration call1-dur :scaler amp))
+ (gen1 (make-oscil))
+ (gen11 (make-oscil))
+ (frqf1 (make-env '(0 3000 .4 6250 .5 6400 1.0 6000) :duration call1-dur :scaler (hz->radians 1.0)))
+ (start2 (+ start (seconds->samples pause))))
+ (let ((stop2 (+ start2 (seconds->samples call2-dur)))
+ (ampf2 (make-env '(0.000 0.000 0.088 0.124 0.157 0.258 0.198 0.202 0.237 0.264 0.273 0.823 0.286 0.419
+ 0.328 0.814 0.343 1.000 0.360 0.329 0.409 0.413 0.435 0.935 0.448 0.295 0.481 0.183
+ 0.539 0.901 0.563 0.444 0.619 0.373 0.644 0.944 0.662 0.311 0.724 0.053 0.756 0.186
+ 0.782 0.432 0.823 0.512 0.865 0.174 0.886 0.230 1.000 0.000)
+ :duration call2-dur :scaler (* .5 amp)))
+ (gen2 (make-oscil 4600))
+ (gen21 (make-oscil 5600))
+ (gen22 (make-rand-interp 2000 (hz->radians 1000))))
+ (do ((i start (+ i 1)))
+ ((= i stop1))
+ (let ((frq (env frqf1)))
+ (outa i (* (env ampf1)
+ (+ (* .9 (oscil gen1 frq))
+ (* .1 (oscil gen11 (* 2.0 frq))))))))
+ (do ((i start2 (+ i 1)))
+ ((= i stop2))
+ (let ((noise (rand-interp gen22)))
+ (outa i (* (env ampf2)
+ (+ (* .7 (oscil gen2 noise))
+ (* .3 (oscil gen21 noise)))))))))))
;; (with-sound (:play #t) (least-flycatcher 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Acadian flycatcher
-(definstrument (acadian-flycatcher beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.3)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.102 0.301 0.221 0.705 0.287 0.332 0.357 0.801 0.406 0.385 0.45 0 0.55 0
- 0.567 0.298 0.623 1.0 0.706 0.727 0.729 0.292 0.860 0.239 0.885 0.484 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (frqf (make-env '(0 2800 .075 3600 .11 4200 .22 4900 .28 3200 .35 5400 .45 4200 .47 4000
- .55 4900 .62 5000 .7 5500 .75 5200 .8 5500 .87 5400 1.0 2800)
- :duration dur :scaler (hz->radians 1.0) :base 32)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* .95 (oscil gen1 frq))
- (* .05 (oscil gen2 (* 2 frq)))))))))))
+(defanimal (acadian-flycatcher beg amp)
+ (let ((dur 0.3))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.102 0.301 0.221 0.705 0.287 0.332 0.357 0.801 0.406 0.385 0.45 0 0.55 0
+ 0.567 0.298 0.623 1.0 0.706 0.727 0.729 0.292 0.860 0.239 0.885 0.484 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .05)))
+ (frqf (make-env '(0 2800 .075 3600 .11 4200 .22 4900 .28 3200 .35 5400 .45 4200 .47 4000
+ .55 4900 .62 5000 .7 5500 .75 5200 .8 5500 .87 5400 1.0 2800)
+ :duration dur :scaler (hz->radians 1.0) :base 32)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (acadian-flycatcher 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Swainson's thrush
@@ -3080,53 +3104,52 @@
;;; are there really multiphonics in this birdsong?
;;; also, is this a song that uses both parts of the syrinx? -- I think the doubled stuff is reverb
-(definstrument (swainsons-thrush beg amp)
- (let* ((start (seconds->samples beg))
- (dur 2.0)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.058 0.146 0.075 0.127
- 0.085 0.000 0.113 0.000 0.143 0.481 0.150 0.516 0.227 0.735
- 0.238 0.000 0.260 0.000 0.289 0.474 0.311 0.423
- 0.316 0.000 0.337 0.000 0.350 0.559 0.355 0.805 0.367 0.895 0.413 0.990 0.427 0.598 0.446 0.373
- 0.452 0.066 0.460 0.103 0.470 0.651 0.492 0.828 0.510 0.502 0.531 0.457
- 0.541 0.000 0.568 0.000 0.569 0.424 0.587 0.548 0.603 0.553 0.613 0.061 0.645 0.633 0.686 0.760
- 0.703 0.000 0.726 0.000 0.727 0.236 0.735 0.037 0.793 0.301 0.815 0.125 0.835 0.130
- 0.847 0.000 0.868 0.000 0.931 0.180
- 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 0.96 2 0.01 3 0.02 4 0.001 5 .005)))
- (gen2 (make-oscil)) ; eschew aliasing
- (intrpf (make-env '(0 1 .7 1 .75 0 1 0) :duration dur))
- (frqf (make-env '(0.000 0.000
- 0.01 0.175 0.015 0.264
- 0.02 0.172 0.025 0.263
- 0.03 0.171 0.035 0.260
- 0.04 0.172 0.045 0.263
- 0.05 0.172 0.055 0.265
- 0.06 0.171 0.065 0.263
- 0.07 0.170 0.077 0.267
- 0.08 0.174 0.085 0.266
- 0.09 0.170 0.095 0.265
- 0.1 0.171 0.105 0.266
- 0.107 0.186 0.128 0.172 0.141 0.240 0.155 0.238 0.164 0.280 0.170 0.180
- 0.178 0.330 0.181 0.177 0.190 0.322 0.196 0.185 0.201 0.326 0.207 0.288 0.242 0.283 0.272 0.238 0.276 0.238
- 0.288 0.238 0.318 0.238 0.342 0.240 0.344 0.270 0.355 0.325 0.365 0.376 0.370 0.325 0.378 0.376 0.383 0.325
- 0.390 0.376 0.395 0.309 0.401 0.426 0.410 0.502 0.424 0.305 0.433 0.280 0.436 0.238 0.447 0.241 0.453 0.199
- 0.466 0.378 0.471 0.431 0.482 0.391 0.494 0.384 0.504 0.350 0.516 0.334 0.532 0.334 0.558 0.330 0.564 0.412
- 0.569 0.477 0.578 0.511 0.582 0.568 0.590 0.429 0.596 0.553 0.604 0.416 0.620 0.735 0.629 0.653 0.641 0.617
- 0.647 0.572 0.656 0.542 0.662 0.510 0.681 0.436 0.689 0.379 0.694 0.293 0.719 0.395 0.723 0.510 0.734 0.555
- 0.743 0.807 0.765 0.786 0.783 0.637 0.797 0.875 0.806 0.902 0.812 0.957 0.832 0.981
- 0.85 .9 0.868 0.416 0.895 0.814 0.900 0.788 0.903 0.735 0.917 0.635 0.922 0.686 0.931 0.855 0.949 0.952 0.965 0.939 1.000 .9)
- :duration dur
- :scaler (hz->radians 8200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf))
- (intrp (env intrpf)))
- (outa i (* (env ampf)
- (+ (* intrp (polywave gen1 frq))
- (* (- 1.0 intrp) (oscil gen2 frq))))))))))
+(defanimal (swainsons-thrush beg amp)
+ (let ((dur 2.0))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.058 0.146 0.075 0.127
+ 0.085 0.000 0.113 0.000 0.143 0.481 0.150 0.516 0.227 0.735
+ 0.238 0.000 0.260 0.000 0.289 0.474 0.311 0.423
+ 0.316 0.000 0.337 0.000 0.350 0.559 0.355 0.805 0.367 0.895 0.413 0.990 0.427 0.598 0.446 0.373
+ 0.452 0.066 0.460 0.103 0.470 0.651 0.492 0.828 0.510 0.502 0.531 0.457
+ 0.541 0.000 0.568 0.000 0.569 0.424 0.587 0.548 0.603 0.553 0.613 0.061 0.645 0.633 0.686 0.760
+ 0.703 0.000 0.726 0.000 0.727 0.236 0.735 0.037 0.793 0.301 0.815 0.125 0.835 0.130
+ 0.847 0.000 0.868 0.000 0.931 0.180
+ 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 0.96 2 0.01 3 0.02 4 0.001 5 .005)))
+ (gen2 (make-oscil)) ; eschew aliasing
+ (intrpf (make-env '(0 1 .7 1 .75 0 1 0) :duration dur))
+ (intrpf-1 (make-env '(0 1 .7 1 .75 0 1 0) :duration dur :offset 1.0 :scaler -1.0))
+ (frqf (make-env '(0.000 0.000
+ 0.01 0.175 0.015 0.264
+ 0.02 0.172 0.025 0.263
+ 0.03 0.171 0.035 0.260
+ 0.04 0.172 0.045 0.263
+ 0.05 0.172 0.055 0.265
+ 0.06 0.171 0.065 0.263
+ 0.07 0.170 0.077 0.267
+ 0.08 0.174 0.085 0.266
+ 0.09 0.170 0.095 0.265
+ 0.1 0.171 0.105 0.266
+ 0.107 0.186 0.128 0.172 0.141 0.240 0.155 0.238 0.164 0.280 0.170 0.180
+ 0.178 0.330 0.181 0.177 0.190 0.322 0.196 0.185 0.201 0.326 0.207 0.288 0.242 0.283 0.272 0.238 0.276 0.238
+ 0.288 0.238 0.318 0.238 0.342 0.240 0.344 0.270 0.355 0.325 0.365 0.376 0.370 0.325 0.378 0.376 0.383 0.325
+ 0.390 0.376 0.395 0.309 0.401 0.426 0.410 0.502 0.424 0.305 0.433 0.280 0.436 0.238 0.447 0.241 0.453 0.199
+ 0.466 0.378 0.471 0.431 0.482 0.391 0.494 0.384 0.504 0.350 0.516 0.334 0.532 0.334 0.558 0.330 0.564 0.412
+ 0.569 0.477 0.578 0.511 0.582 0.568 0.590 0.429 0.596 0.553 0.604 0.416 0.620 0.735 0.629 0.653 0.641 0.617
+ 0.647 0.572 0.656 0.542 0.662 0.510 0.681 0.436 0.689 0.379 0.694 0.293 0.719 0.395 0.723 0.510 0.734 0.555
+ 0.743 0.807 0.765 0.786 0.783 0.637 0.797 0.875 0.806 0.902 0.812 0.957 0.832 0.981
+ 0.85 .9 0.868 0.416 0.895 0.814 0.900 0.788 0.903 0.735 0.917 0.635 0.922 0.686 0.931 0.855 0.949 0.952 0.965 0.939 1.000 .9)
+ :duration dur
+ :scaler (hz->radians 8200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env intrpf) (polywave gen1 frq))
+ (* (env intrpf-1) (oscil gen2 frq))))))))))
;; (with-sound (:play #t) (swainsons-thrush 0 .5))
@@ -3135,36 +3158,36 @@
;;;
;;; Carolina wren
-(definstrument (carolina-wren beg amp)
- (let* ((start (seconds->samples beg))
- (pulse-dur 0.25)
- (pulses 7)
- (dur 1.84)
- (stop (+ start (seconds->samples dur)))
- (pulsef (make-env '(0.000 0.000 0.027 0.031 0.049 0.185 0.065 0.749 0.121 0.508 0.137 0.339 0.146 0.270
- 0.195 0.571 0.247 0.806 0.270 0.994 0.311 0.837 0.325 0.129 0.335 0.373 0.354 0.000
- 0.512 0.000 0.525 0.677 0.548 0.831 0.560 0.737 0.594 0.082 0.602 0.000 0.618 0.223
- 0.635 0.313 0.657 0.712 0.698 0.649 0.716 0.517 0.741 0.006 0.775 0.094 0.791 0.467
- 0.808 0.373 0.838 0.480 0.885 0.414 0.917 0.160 0.930 0.031 1.000 0.000)
- :duration pulse-dur))
- (frqf (make-env '(0.000 0.3 0.06 0.209 0.079 0.204 0.084 0.158 0.171 0.160 0.260 0.175 0.310 0.185
- 0.495 0.153 0.582 0.155 0.621 0.145 0.653 0.125 0.738 0.121 0.794 0.125 0.805 0.109
- 0.835 0.104 1.000 0.102)
- :duration pulse-dur :scaler (hz->radians 22050)))
- (ampf (make-env '(0 0 1 .5 16 1 18 .8 20 0) :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .95 2 .015 3 .025 3 .01)))
- (pulser (make-pulse-train (/ 6 1.6))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((pulse (pulse-train pulser)))
- (if (> pulse .1)
- (begin
- (mus-reset pulsef)
- (mus-reset frqf)))
- (outa i (* (env ampf)
- (env pulsef)
- (polywave gen1 (env frqf)))))))))
+(defanimal (carolina-wren beg amp)
+ (let ((dur 1.84)
+ (pulse-dur 0.25))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (pulsef (make-env '(0.000 0.000 0.027 0.031 0.049 0.185 0.065 0.749 0.121 0.508 0.137 0.339 0.146 0.270
+ 0.195 0.571 0.247 0.806 0.270 0.994 0.311 0.837 0.325 0.129 0.335 0.373 0.354 0.000
+ 0.512 0.000 0.525 0.677 0.548 0.831 0.560 0.737 0.594 0.082 0.602 0.000 0.618 0.223
+ 0.635 0.313 0.657 0.712 0.698 0.649 0.716 0.517 0.741 0.006 0.775 0.094 0.791 0.467
+ 0.808 0.373 0.838 0.480 0.885 0.414 0.917 0.160 0.930 0.031 1.000 0.000)
+ :duration pulse-dur))
+ (frqf (make-env '(0.000 0.3 0.06 0.209 0.079 0.204 0.084 0.158 0.171 0.160 0.260 0.175 0.310 0.185
+ 0.495 0.153 0.582 0.155 0.621 0.145 0.653 0.125 0.738 0.121 0.794 0.125 0.805 0.109
+ 0.835 0.104 1.000 0.102)
+ :duration pulse-dur :scaler (hz->radians 22050)))
+ (ampf (make-env '(0 0 1 .5 16 1 18 .8 20 0) :duration dur :scaler amp))
+ (gen1 #f)
+ (pulse-samps (seconds->samples (/ 1.6 6.0)))) ; .26
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-samps)))
+ (pulse-amp (env ampf)))
+ (set! gen1 (make-polywave 0.0 (list 1 (* pulse-amp .95) 2 (* pulse-amp .015) 3 (* pulse-amp .025) 3 (* pulse-amp .01))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (polywave gen1 (env frqf)))))
+ (mus-reset pulsef)
+ (mus-reset frqf))))))
;; (with-sound (:play #t) (carolina-wren 0 .25))
@@ -3173,48 +3196,51 @@
;;;
;;; Bachman's sparrow
-(definstrument (bachmans-sparrow beg amp)
+(defanimal (bachmans-sparrow beg amp)
;; two pieces -- initial steady tone, then 10 repetitions of 2nd call
- (let* ((start (seconds->samples beg))
- (call1-dur .576)
- (stop1 (+ start (seconds->samples call1-dur)))
- (ampf1 (make-env '(0.000 0.000 0.684 0.978 0.863 1.0 0.962 0.773 1.000 0.000) :duration call1-dur :scaler (* .5 amp)))
- (gen1 (make-polywave :partials (list 1 .98 3 .02)))
- (frqf1 (make-env '(0 4970 1 4850) :duration call1-dur :scaler (hz->radians 1.0)))
- (pulser (make-pulse-train (/ 1.0 .184)))
- (pulses 10)
- (call2-dur .172)
- (stop2 (+ start (seconds->samples 2.4)))
- (ampf2 (make-env '(0.000 0.000 0.070 0.025 0.239 0.430 0.331 0.404 0.381 0.000 0.422 0.007
- 0.495 0.560 0.541 0.596 0.552 0.466 0.578 0.469 0.592 1.000 0.616 0.798
- 0.642 0.751
- 0.75 0 0.786 0.000 0.834 0.267 0.859 0.227 0.902 0.043 1.000 0.000)
- :duration call2-dur :scaler amp))
- ;; these two envs may not be aligned correctly -- maybe backup the frq slightly?
- (frqf2 (make-env '(0.000 0.252 0.129 0.266 0.210 0.291 0.282 0.293 0.336 0.293 0.442 0.404
- 0.473 0.416 0.515 0.416 0.556 0.447
- 0.576 0.6
- 0.598 0.443 0.607 0.386
- 0.638 0.342 0.688 0.332 0.784 0.338 0.796 0.340 0.886 0.57
- 0.948 0.697 1 .7)
- :duration call2-dur :scaler (hz->radians 10000)))
- (ampf (make-env '(0 1 1.78 1 1.79 0 1.82 0) :duration 1.82)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop1))
- (outa i (* (env ampf1)
- (polywave gen1 (env frqf1)))
- ))
- (do ((i stop1 (+ i 1)))
- ((= i stop2))
- (let ((pulse (pulse-train pulser)))
- (if (> pulse .1)
- (begin
- (mus-reset ampf2)
- (mus-reset frqf2)))
- (outa i (* (env ampf2)
- (env ampf)
- (polywave gen1 (env frqf2)))))))))
+ (let ((call1-dur .576)
+ (call2-dur .172)
+ (start (seconds->samples beg)))
+ (let ((stop1 (+ start (seconds->samples call1-dur)))
+ (ampf1 (make-env '(0.000 0.000 0.684 0.978 0.863 1.0 0.962 0.773 1.000 0.000) :duration call1-dur :scaler (* .5 amp)))
+ (gen1 (make-polywave 0.0 '(1 .98 3 .02))) ; first section uses ampf1 for amp scaling (.5)
+ (frqf1 (make-env '(0 4970 1 4850) :duration call1-dur :scaler (hz->radians 1.0)))
+ (pulse-samps (seconds->samples .184))
+ (pulse-out (seconds->samples call2-dur))
+
+ (stop2 (+ start (seconds->samples 2.4)))
+ (ampf2 (make-env '(0.000 0.000 0.070 0.025 0.239 0.430 0.331 0.404 0.381 0.000 0.422 0.007
+ 0.495 0.560 0.541 0.596 0.552 0.466 0.578 0.469 0.592 1.000 0.616 0.798
+ 0.642 0.751
+ 0.75 0 0.786 0.000 0.834 0.267 0.859 0.227 0.902 0.043 1.000 0.000)
+ :duration call2-dur :scaler amp))
+ ;; these two envs may not be aligned correctly -- maybe backup the frq slightly?
+ (frqf2 (make-env '(0.000 0.252 0.129 0.266 0.210 0.291 0.282 0.293 0.336 0.293 0.442 0.404
+ 0.473 0.416 0.515 0.416 0.556 0.447
+ 0.576 0.6
+ 0.598 0.443 0.607 0.386
+ 0.638 0.342 0.688 0.332 0.784 0.338 0.796 0.340 0.886 0.57
+ 0.948 0.697 1 .7)
+ :duration call2-dur :scaler (hz->radians 10000)))
+ (ampf (make-env '(0 1 1.78 1 1.79 0 1.82 0) :duration 1.82)))
+
+ (do ((i start (+ i 1)))
+ ((= i stop1))
+ (outa i (* (env ampf1)
+ (polywave gen1 (env frqf1)))))
+
+ (do ((i stop1 (+ i pulse-samps)))
+ ((>= i stop2))
+ (set! (mus-location ampf) (- i stop1))
+ (let ((reset-stop (min stop2 (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! gen1 (make-polywave 0.0 (list 1 (* pulse-amp .98) 3 (* pulse-amp .02))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env ampf2)
+ (polywave gen1 (env frqf2)))))
+ (mus-reset ampf2)
+ (mus-reset frqf2))))))
;; (with-sound (:play #t) (bachmans-sparrow 0 .25))
@@ -3223,54 +3249,51 @@
;;;
;;; Grasshopper sparrow
-(definstrument (grasshopper-sparrow beg amp)
+(defanimal (grasshopper-sparrow beg amp)
;; 2 portions -- simple tones, then a buzz (calif case has much tighter (faster) buzz)
- (let* ((start (seconds->samples beg))
-
- (begs (vct 0.0 .24 .36 .44 .55))
- (durs (vct 0.019 0.020 0.011 0.021 1.09))
- (amps (vct .48 .54 .07 .22 1.0))
- (frqs (vct 8500 7240 9730 4920 8000))
- (starts (make-vector 4 0))
- (stops (make-vector 4 0))
- (ampfs (make-vector 4 #f))
- (gen1 (make-oscil))
-
- (buzz-start (+ start (seconds->samples (begs 4))))
- (buzz-end (+ buzz-start (seconds->samples (durs 4))))
- (buzz-ampf (make-env '(0.000 0.000 0.095 0.953 0.114 0.182 0.158 0.822 0.236 0.996 0.332 1.000 0.848 0.589 0.957 0.372 1.000 0.000)
- :duration (durs 4) :scaler amp))
- (buzzer (make-nrxysin 40 :n 5 :r .5)) ; sawtooth not great here due to broad spectrum
- (buzzer-index (hz->radians 2000))
- (buzzer-amp (make-triangle-wave 40 0.8)))
-
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (set! (ampfs i) (make-env '(0 0 1 .8 1.5 1 2 .8 3 0) :duration (durs i) :scaler (* amp (amps i))))
- (set! (starts i) (+ start (seconds->samples (begs i))))
- (set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
-
- (run
-
- ;; first the 4 tones
- (do ((tone 0 (+ 1 tone)))
- ((= tone 4))
- (set! (mus-frequency gen1) (frqs tone))
- (let ((ampf (ampfs tone))
- (end (stops tone)))
- (do ((i (starts tone) (+ i 1)))
- ((= i end))
- (outa i (* (env ampf)
- (oscil gen1))))))
-
- ;; then the buzz
- (set! (mus-frequency gen1) 8000.0)
- (do ((i buzz-start (+ i 1)))
- ((= i buzz-end))
- (outa i (* (env buzz-ampf)
- (+ 0.2 (abs (triangle-wave buzzer-amp)))
- (oscil gen1 (* buzzer-index
- (nrxysin buzzer)))))))))
+ (let ((start (seconds->samples beg))
+ (begs (vector 0.0 .24 .36 .44 .55))
+ (durs (vector 0.019 0.020 0.011 0.021 1.09))
+ (amps (vector .48 .54 .07 .22 1.0))
+ (frqs (vector 8500 7240 9730 4920 8000))
+ (starts (make-vector 4 0))
+ (stops (make-vector 4 0))
+ (ampfs (make-vector 4 #f))
+ (gen1 (make-oscil)))
+ (let ((buzz-start (+ start (seconds->samples (begs 4)))))
+ (let ((buzz-end (+ buzz-start (seconds->samples (durs 4))))
+ (buzz-ampf (make-env '(0.000 0.000 0.095 0.953 0.114 0.182 0.158 0.822 0.236 0.996 0.332 1.000 0.848 0.589 0.957 0.372 1.000 0.000)
+ :duration (durs 4) :scaler amp))
+ (buzzer (make-nrxysin 40 :n 5 :r .5)) ; sawtooth not great here due to broad spectrum
+ (buzzer-index (hz->radians 2000))
+ (buzzer-amp (make-triangle-wave 40 0.8)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (set! (ampfs i) (make-env '(0 0 1 .8 1.5 1 2 .8 3 0) :duration (durs i) :scaler (* amp (amps i))))
+ (set! (starts i) (+ start (seconds->samples (begs i))))
+ (set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
+
+ ;; first the 4 tones
+ (do ((tone 0 (+ 1 tone)))
+ ((= tone 4))
+ (set! (mus-frequency gen1) (frqs tone))
+ (let ((ampf (ampfs tone))
+ (start (starts tone))
+ (end (stops tone)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env ampf)
+ (oscil gen1))))))
+
+ ;; then the buzz
+ (set! (mus-frequency gen1) 8000.0)
+ (do ((i buzz-start (+ i 1)))
+ ((= i buzz-end))
+ (outa i (* (env buzz-ampf)
+ (+ 0.2 (abs (triangle-wave buzzer-amp)))
+ (oscil gen1 (* buzzer-index
+ (nrxysin buzzer))))))))))
;; (with-sound (:play #t) (grasshopper-sparrow 0 .25))
@@ -3279,59 +3302,59 @@
;;;
;;; American robin
-(definstrument (american-robin beg amp)
- (let* ((start (seconds->samples beg))
+(defanimal (american-robin beg amp)
+ (let ((start (seconds->samples beg))
(ampfs (make-vector 4 #f))
(frqfs (make-vector 4 #f))
(starts (make-vector 4 0))
(stops (make-vector 4 0))
- (begs (vct 0.0 0.6 1.3 1.8))
- (durs (vct 0.34 0.25 0.16 0.39))
- (amps (vct 0.6 1.0 0.7 0.95))
+ (begs (vector 0.0 0.6 1.3 1.8))
+ (durs (vector 0.34 0.25 0.16 0.39))
+ (amps (vector 0.6 1.0 0.7 0.95))
- (gen1 (make-polywave :partials (list 1 .95 2 .03 3 .01 4 .01)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .03 3 .01 4 .01)))
(amp-envs (vector
- (list 0.000 0.000 0.085 0.847 0.117 0.555 0.125 0.731 0.137 0.505 0.158 0.635 0.178 0.595
+ '(0.000 0.000 0.085 0.847 0.117 0.555 0.125 0.731 0.137 0.505 0.158 0.635 0.178 0.595
0.200 0.449 0.224 0.578 0.241 0.395 0.274 0.515 0.372 0.415 0.409 0.243 0.434 0.266
0.445 0.000 0.463 0.166 0.489 0.080 0.527 0.272 0.535 0.150 0.559 0.777 0.594 0.967
0.632 0.811 0.650 0.897 0.692 0.718 0.710 0.525 0.726 0.588 0.743 0.000 0.746 0.661
0.764 0.748 0.782 0.711 0.799 0.528 0.824 0.678 0.834 0.615 0.864 0.721 0.883 0.548
0.904 0.625 0.940 0.458 0.957 0.505 1.000 0.000)
- (list 0.000 0.000 0.117 0.734 0.200 0.934 0.220 0.814 0.233 0.900 0.254 0.864 0.268 0.538
+ '(0.000 0.000 0.117 0.734 0.200 0.934 0.220 0.814 0.233 0.900 0.254 0.864 0.268 0.538
0.280 0.718 0.302 0.063 0.328 0.439 0.340 0.445 0.356 0.070 0.401 0.123 0.437 0.000
0.529 0.000 0.543 0.372 0.566 0.512 0.579 0.369 0.630 0.449 0.654 0.402 0.704 0.555
0.794 0.515 0.814 0.442 0.822 0.213 0.838 0.654 0.947 0.502 1.000 0.000)
- (list 0.000 0.000 0.013 0.282 0.085 0.568 0.140 0.522 0.174 0.678 0.217 0.960 0.232 1.000
+ '(0.000 0.000 0.013 0.282 0.085 0.568 0.140 0.522 0.174 0.678 0.217 0.960 0.232 1.000
0.258 0.718 0.277 0.877 0.310 0.970 0.361 0.927 0.429 0.864 0.487 0.641 0.513 0.382
0.565 0.425 0.586 0.166 0.611 0.040 0.647 0.319 0.692 0.784 0.806 0.947 0.846 0.671
0.875 0.462 0.905 0.605 0.959 0.508 1.000 0.000)
- (list 0.000 0.000 0.059 0.282 0.107 0.711 0.154 0.711 0.176 0.588 0.221 0.525 0.289 0.475
+ '(0.000 0.000 0.059 0.282 0.107 0.711 0.154 0.711 0.176 0.588 0.221 0.525 0.289 0.475
0.386 0.445 0.415 0.199 0.438 0.286 0.451 0.060 0.455 0.269 0.479 0.090 0.493 0.196
0.577 0.924 0.674 0.924 0.699 0.608 0.710 0.831 0.762 0.571 0.778 0.645 0.842 0.425
0.899 0.372 0.933 0.415 1.000 0.000)))
(frq-envs (vector
- (list 0.000 0.491 0.026 0.502 0.083 0.509 0.098 0.456 0.132 0.428 0.165 0.428 0.190 0.442
+ '(0.000 0.491 0.026 0.502 0.083 0.509 0.098 0.456 0.132 0.428 0.165 0.428 0.190 0.442
0.350 0.436 0.367 0.419 0.440 0.415 0.450 0.606 0.485 0.608 0.502 0.634 0.583 0.636
0.607 0.677 0.658 0.684 0.663 0.562 0.687 0.564 0.703 0.546 0.725 0.546 0.773 0.564
0.793 0.560 0.808 0.555 1.000 0.555)
- (list 0.000 0.634 0.074 0.647 0.094 0.666 0.113 0.671 0.130 0.663 0.147 0.625 0.172 0.620
+ '(0.000 0.634 0.074 0.647 0.094 0.666 0.113 0.671 0.130 0.663 0.147 0.625 0.172 0.620
0.189 0.601 0.219 0.601 0.229 0.627 0.251 0.622 0.265 0.601 0.329 0.597 0.481 0.601
0.508 0.602 0.514 0.504 0.556 0.502 0.625 0.473 0.722 0.477 0.729 0.583 0.825 0.572
0.852 0.553 0.892 0.555 1.000 0.578)
- (list 0.000 0.509 0.075 0.518 0.124 0.560 0.150 0.640 0.192 0.663 0.223 0.654 0.271 0.551
+ '(0.000 0.509 0.075 0.518 0.124 0.560 0.150 0.640 0.192 0.663 0.223 0.654 0.271 0.551
0.313 0.539 0.354 0.551 0.389 0.583 0.433 0.601 0.542 0.606 0.595 0.564 0.669 0.558
0.736 0.557 0.749 0.610 0.788 0.655 0.821 0.678 0.857 0.680 0.874 0.611 0.907 0.595 1.000 0.580)
- (list 0.000 0.481 0.032 0.491 0.084 0.530 0.098 0.595 0.113 0.592 0.118 0.458 0.186 0.436
+ '(0.000 0.481 0.032 0.491 0.084 0.530 0.098 0.595 0.113 0.592 0.118 0.458 0.186 0.436
0.229 0.445 0.313 0.442 0.330 0.452 0.346 0.440 0.386 0.442 0.464 0.428 0.504 0.560
0.529 0.641 0.573 0.636 0.605 0.647 0.657 0.661 0.690 0.680 0.705 0.558 0.758 0.549
0.787 0.555 0.821 0.544 0.849 0.532 0.913 0.535 0.939 0.548 1.000 0.537))))
@@ -3343,16 +3366,16 @@
(set! (starts i) (+ start (seconds->samples (begs i))))
(set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
- (run
(do ((tone 0 (+ 1 tone)))
((= tone 4))
(let ((ampf (ampfs tone))
(frqf (frqfs tone))
+ (start (starts tone))
(end (stops tone)))
- (do ((i (starts tone) (+ i 1)))
+ (do ((i start (+ i 1)))
((= i end))
(outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))))
+ (polywave gen1 (env frqf)))))))))
;; (with-sound (:play #t) (american-robin 0 .25))
@@ -3361,61 +3384,60 @@
;;;
;;; Common loon
-(definstrument (common-loon-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 2.5)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.049 0.134 0.122 0.131 0.174 0.070 0.178 0.244
- 0.522 0.954 0.649 0.922 0.736 1.0 0.860 0.962 0.957 0.839 .98 .5 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .85 2 .1 3 .02 4 .05 5 .01 7 .003 9 .001)))
- (frqf (make-env '(0.000 0.330 0.030 0.388 0.087 0.395 0.155 0.509 0.158 0.609 0.204 0.633 0.346 0.685
- 0.35 0.852 0.469 0.882 0.585 0.886 0.780 0.888 0.896 0.878 0.961 0.869 .98 .8 1.000 0.76)
- :duration dur :scaler (hz->radians 1000.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (common-loon-1 beg amp)
+ (let ((dur 2.5))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.049 0.134 0.122 0.131 0.174 0.070 0.178 0.244
+ 0.522 0.954 0.649 0.922 0.736 1.0 0.860 0.962 0.957 0.839 .98 .5 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .85 2 .1 3 .02 4 .05 5 .01 7 .003 9 .001)))
+ (frqf (make-env '(0.000 0.330 0.030 0.388 0.087 0.395 0.155 0.509 0.158 0.609 0.204 0.633 0.346 0.685
+ 0.35 0.852 0.469 0.882 0.585 0.886 0.780 0.888 0.896 0.878 0.961 0.869 .98 .8 1.000 0.76)
+ :duration dur :scaler (hz->radians 1000.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (common-loon-1 0 .25))
-(definstrument (common-loon-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.63)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.021 0.270 0.045 0.253 0.088 0.103 0.141 0.416 0.165 0.251 0.179 0.107
- 0.192 0.403 0.211 0.399 0.222 0.208 0.242 0.206 0.286 0.895 0.303 0.882 0.327 0.672
- 0.350 0.324 0.362 0.150 0.378 0.236 0.389 0.268 0.423 0.991 0.447 0.923 0.459 0.785
- 0.488 0.242 0.506 0.200 0.531 0.245 0.540 0.371 0.556 0.785 0.566 0.792 0.573 0.981
- 0.579 0.873 0.585 0.931 0.600 0.811 0.622 0.354 0.636 0.191 0.652 0.120 0.663 0.148
- 0.674 0.099 0.687 0.163 0.707 0.489 0.720 0.631 0.731 0.624 0.765 0.339 0.778 0.170
- 0.810 0.056 0.842 0.116 0.863 0.227 0.899 0.240 0.907 0.189 0.965 0.122 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .85 2 .02 3 .008 4 .01 5 .006)))
- (frqf (make-env '(0.000 0.267 0.029 0.354 0.131 0.349 0.188 0.414 0.202 0.534 0.232 0.453 0.250 0.427
- 0.267 0.455 0.279 0.505 0.296 0.540 0.312 0.549 0.332 0.532 0.365 0.442 0.380 0.427
- 0.395 0.443 0.417 0.512 0.430 0.544 0.446 0.558 0.465 0.542 0.503 0.436 0.521 0.421
- 0.535 0.440 0.558 0.510 0.570 0.534 0.588 0.544 0.608 0.525 0.625 0.479 0.646 0.425
- 0.669 0.410 0.690 0.432 0.715 0.514 0.733 0.532 0.753 0.514 0.801 0.423 0.817 0.421
- 0.830 0.304 0.866 0.343 0.891 0.354 0.913 0.338 0.950 0.312 1.000 0.304)
- :duration dur :scaler (hz->radians 2000.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (common-loon-2 beg amp)
+ (let ((dur 0.63))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.021 0.270 0.045 0.253 0.088 0.103 0.141 0.416 0.165 0.251 0.179 0.107
+ 0.192 0.403 0.211 0.399 0.222 0.208 0.242 0.206 0.286 0.895 0.303 0.882 0.327 0.672
+ 0.350 0.324 0.362 0.150 0.378 0.236 0.389 0.268 0.423 0.991 0.447 0.923 0.459 0.785
+ 0.488 0.242 0.506 0.200 0.531 0.245 0.540 0.371 0.556 0.785 0.566 0.792 0.573 0.981
+ 0.579 0.873 0.585 0.931 0.600 0.811 0.622 0.354 0.636 0.191 0.652 0.120 0.663 0.148
+ 0.674 0.099 0.687 0.163 0.707 0.489 0.720 0.631 0.731 0.624 0.765 0.339 0.778 0.170
+ 0.810 0.056 0.842 0.116 0.863 0.227 0.899 0.240 0.907 0.189 0.965 0.122 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .85 2 .02 3 .008 4 .01 5 .006)))
+ (frqf (make-env '(0.000 0.267 0.029 0.354 0.131 0.349 0.188 0.414 0.202 0.534 0.232 0.453 0.250 0.427
+ 0.267 0.455 0.279 0.505 0.296 0.540 0.312 0.549 0.332 0.532 0.365 0.442 0.380 0.427
+ 0.395 0.443 0.417 0.512 0.430 0.544 0.446 0.558 0.465 0.542 0.503 0.436 0.521 0.421
+ 0.535 0.440 0.558 0.510 0.570 0.534 0.588 0.544 0.608 0.525 0.625 0.479 0.646 0.425
+ 0.669 0.410 0.690 0.432 0.715 0.514 0.733 0.532 0.753 0.514 0.801 0.423 0.817 0.421
+ 0.830 0.304 0.866 0.343 0.891 0.354 0.913 0.338 0.950 0.312 1.000 0.304)
+ :duration dur :scaler (hz->radians 2000.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (common-loon-2 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Hermit thrush
-(definstrument (hermit-thrush beg amp)
- (let* ((start (seconds->samples beg))
+(defanimal (hermit-thrush beg amp)
+ (let ((start (seconds->samples beg))
(ampfs (make-vector 3 #f))
(frqf1s (make-vector 3 #f))
@@ -3423,18 +3445,18 @@
(starts (make-vector 3 0))
(stops (make-vector 3 0))
- (begs (vct 0.0 0.42 0.84))
- (durs (vct 0.34 0.35 0.56))
- (amps (vct 0.6 0.8 1.0))
+ (begs (vector 0.0 0.42 0.84))
+ (durs (vector 0.34 0.35 0.56))
+ (amps (vector 0.6 0.8 1.0))
- (gen1 (make-polywave :partials (list 1 .95 2 .01 3 .03)))
- (gen2 (make-polywave :partials (list 1 .95 2 .01 3 .03)))
+ (gen1 (make-polywave 0.0 (list 1 (* .55 .95) 2 (* .55 .01) 3 (* .55 .03))))
+ (gen2 (make-polywave 0.0 (list 1 (* .45 .95) 2 (* .45 .01) 3 (* .45 .03))))
(amp-envs (vector
- (list 0.000 0.000 0.117 0.054 0.301 0.269 0.518 0.605 0.608 0.620 0.703 0.783 0.779 0.900
+ '(0.000 0.000 0.117 0.054 0.301 0.269 0.518 0.605 0.608 0.620 0.703 0.783 0.779 0.900
0.804 0.857 0.863 0.987 0.912 0.959 0.943 1.000 0.967 0.900 1.000 0.000)
- (list 0.000 0.000 0.028 0.109 0.037 0.059 0.056 0.223 0.066 0.000 0.094 0.252 0.104 0.488
+ '(0.000 0.000 0.028 0.109 0.037 0.059 0.056 0.223 0.066 0.000 0.094 0.252 0.104 0.488
0.136 0.605 0.151 0.770 0.154 0.000 0.162 0.857 0.175 0.727 0.187 0.000 0.198 0.505
0.217 0.280 0.229 0.427 0.240 0.291 0.249 0.479 0.266 0.369 0.277 0.518 0.289 0.380
0.297 0.503 0.310 0.380 0.321 0.495 0.334 0.000 0.343 0.584 0.376 0.545 0.398 0.649
@@ -3444,7 +3466,7 @@
0.754 0.586 0.764 0.709 0.777 0.575 0.791 0.716 0.802 0.568 0.819 0.681 0.837 0.601
0.872 0.783 0.933 0.967 0.978 0.902 1.000 0.000)
- (list 0.000 0.000 0.006 0.202 0.014 0.082 0.023 0.349 0.057 0.605 0.064 0.581 0.071 0.367
+ '(0.000 0.000 0.006 0.202 0.014 0.082 0.023 0.349 0.057 0.605 0.064 0.581 0.071 0.367
0.105 0.184 0.107 0.000 0.152 0.421 0.171 0.538 0.183 0.443 0.210 0.000 0.230 0.150
0.250 0.707 0.264 0.716 0.276 0.579 0.280 0.499 0.306 0.712 0.328 0.711 0.340 0.852
0.356 0.850 0.367 0.957 0.391 0.904 0.412 0.616 0.420 0.000 0.446 0.516 0.452 0.482
@@ -3454,16 +3476,16 @@
0.948 0.095 1.000 0.000)))
(frq1-envs (vector
- (list 0.000 0.352 1.000 0.345)
+ '(0.000 0.352 1.000 0.345)
- (list 0.000 0.485 0.037 0.482 0.058 0.511 0.068 0.482 0.085 0.523 0.102 0.489 0.112 0.562
+ '(0.000 0.485 0.037 0.482 0.058 0.511 0.068 0.482 0.085 0.523 0.102 0.489 0.112 0.562
0.200 0.549 0.215 0.490 0.233 0.510 0.243 0.487 0.256 0.508 0.265 0.484 0.281 0.508
0.293 0.482 0.302 0.499 0.318 0.489 0.528 0.492 0.544 0.516 0.557 0.487 0.572 0.492
0.576 0.518 0.578 0.549 0.675 0.542 0.680 0.496 0.691 0.485 0.704 0.508 0.712 0.487
0.728 0.506 0.743 0.480 0.755 0.503 0.770 0.482 0.782 0.497 0.794 0.478 0.805 0.492
0.827 0.490 0.851 0.397 1.000 0.392)
- (list 0.000 0.499 0.018 0.497 0.029 0.563 0.061 0.563 0.074 0.553 0.086 0.487 0.098 0.513
+ '(0.000 0.499 0.018 0.497 0.029 0.563 0.061 0.563 0.074 0.553 0.086 0.487 0.098 0.513
0.105 0.492 0.116 0.510 0.127 0.612 0.137 0.641 0.190 0.641 0.202 0.510 0.213 0.487
0.224 0.548 0.235 0.510 0.244 0.567 0.268 0.553 0.277 0.501 0.286 0.489 0.314 0.504
0.323 0.449 0.423 0.442 0.432 0.553 0.446 0.567 0.457 0.503 0.467 0.487 0.481 0.497
@@ -3473,16 +3495,16 @@
0.946 0.555 0.972 0.489 1.000 0.487)))
(frq2-envs (vector
- (list 0.000 0.352 1.000 0.345)
+ '(0.000 0.352 1.000 0.345)
- (list 0.000 0.000 0.001 0.352 0.025 0.440 0.034 0.388 0.051 0.438 0.064 0.380 0.088 0.425
+ '(0.000 0.000 0.001 0.352 0.025 0.440 0.034 0.388 0.051 0.438 0.064 0.380 0.088 0.425
0.098 0.383 0.120 0.350 0.146 0.357 0.193 0.336 0.207 0.409 0.219 0.381 0.231 0.418
0.243 0.388 0.259 0.421 0.268 0.388 0.279 0.426 0.293 0.388 0.307 0.426 0.316 0.397
0.336 0.428 0.345 0.402 0.364 0.430 0.371 0.397 0.372 0.492 0.534 0.494 0.549 0.402
0.565 0.386 0.585 0.347 0.614 0.355 0.663 0.336 0.672 0.354 0.678 0.395 0.697 0.388
0.707 0.406 0.735 0.407 0.758 0.406 0.804 0.397 0.830 0.400 0.846 0.397 1.000 0.395)
- (list 0.000 0.409 0.018 0.392 0.034 0.364 0.069 0.343 0.080 0.400 0.092 0.357 0.100 0.399
+ '(0.000 0.409 0.018 0.392 0.034 0.364 0.069 0.343 0.080 0.400 0.092 0.357 0.100 0.399
0.114 0.354 0.136 0.347 0.157 0.315 0.195 0.399 0.206 0.376 0.218 0.399 0.231 0.348
0.257 0.345 0.270 0.393 0.286 0.400 0.293 0.440 0.312 0.447 0.410 0.445 0.424 0.350
0.434 0.340 0.449 0.393 0.462 0.393 0.476 0.406 0.489 0.366 0.504 0.348 0.516 0.360
@@ -3499,577 +3521,581 @@
(set! (starts i) (+ start (seconds->samples (begs i))))
(set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
- (run
(do ((tone 0 (+ 1 tone)))
((= tone 3))
(let ((ampf (ampfs tone))
(frqf1 (frqf1s tone))
(frqf2 (frqf2s tone))
+ (start (starts tone))
(end (stops tone)))
- (do ((i (starts tone) (+ i 1)))
+ (do ((i start (+ i 1)))
((= i end))
(outa i (* (env ampf)
- (+ (* .55 (polywave gen1 (env frqf1)))
- (* .45 (polywave gen2 (env frqf2))))))))))))
+ (+ (polywave gen1 (env frqf1))
+ (polywave gen2 (env frqf2))))))))))
;; (with-sound (:play #t) (hermit-thrush 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Chuck-will's-widow
-(definstrument (chuck-wills-widow beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.05)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.017 0.656 0.026 0.136 0.048 0.000
- 0.289 0.000 0.328 0.154 0.353 0.405 0.361 0.961 0.369 0.667 0.381 0.918 0.394 0.269
- 0.402 0.204 0.425 0.333 0.440 0.570 0.466 0.444 0.515 0.470 0.592 0.294
- 0.65 0.000 .68 0.0 .7 .1 .74 0 0.762 0.000 0.791 0.305 0.818 0.337
- 0.832 1.000 0.844 0.699 0.857 0.903 0.867 0.405 0.883 0.398 0.895 0.853 0.907 0.853
- 0.921 0.297 0.953 0.294 0.981 0.140 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .97 3 .02 4 .01)))
- (rnd (make-rand-interp 100 .25))
- (frqf (make-env '(0.000 0.702 0.014 0.637 0.023 0.478 0.048 0.343 0.298 0.385 0.335 0.389 0.353 0.459
- 0.362 0.546 0.371 0.687 0.376 0.715 0.383 0.687 0.388 0.635 0.391 0.565 0.398 0.474
- 0.417 0.370 0.455 0.561 0.490 0.389 0.504 0.465 0.523 0.483 0.541 0.461 0.552 0.413
- 0.605 0.409 0.610 0.370 0.781 0.380 0.804 0.417 0.823 0.457 0.837 0.517 0.851 0.693
- 0.858 0.737 0.867 0.702 0.871 0.572 0.878 0.496 0.889 0.430 0.904 0.535 0.914 0.630
- 0.924 0.554 0.933 0.457 0.951 0.380 1.000 0.354)
- :duration dur :scaler (hz->radians 3000.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ .75 (abs (rand-interp rnd)))
- (polywave gen1 (env frqf))))))))
+(defanimal (chuck-wills-widow beg amp)
+ (let ((dur 1.05))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.017 0.656 0.026 0.136 0.048 0.000
+ 0.289 0.000 0.328 0.154 0.353 0.405 0.361 0.961 0.369 0.667 0.381 0.918 0.394 0.269
+ 0.402 0.204 0.425 0.333 0.440 0.570 0.466 0.444 0.515 0.470 0.592 0.294
+ 0.65 0.000 .68 0.0 .7 .1 .74 0 0.762 0.000 0.791 0.305 0.818 0.337
+ 0.832 1.000 0.844 0.699 0.857 0.903 0.867 0.405 0.883 0.398 0.895 0.853 0.907 0.853
+ 0.921 0.297 0.953 0.294 0.981 0.140 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .97 3 .02 4 .01)))
+ (rnd (make-rand-interp 100 .25))
+ (frqf (make-env '(0.000 0.702 0.014 0.637 0.023 0.478 0.048 0.343 0.298 0.385 0.335 0.389 0.353 0.459
+ 0.362 0.546 0.371 0.687 0.376 0.715 0.383 0.687 0.388 0.635 0.391 0.565 0.398 0.474
+ 0.417 0.370 0.455 0.561 0.490 0.389 0.504 0.465 0.523 0.483 0.541 0.461 0.552 0.413
+ 0.605 0.409 0.610 0.370 0.781 0.380 0.804 0.417 0.823 0.457 0.837 0.517 0.851 0.693
+ 0.858 0.737 0.867 0.702 0.871 0.572 0.878 0.496 0.889 0.430 0.904 0.535 0.914 0.630
+ 0.924 0.554 0.933 0.457 0.951 0.380 1.000 0.354)
+ :duration dur :scaler (hz->radians 3000.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .75 (abs (rand-interp rnd)))
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (chuck-wills-widow 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; California towhee
-(definstrument (california-towhee beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.17)
- (stop (+ start (seconds->samples dur)))
- ;; peep pitch changes
- (amps (vct .5 .8 .85 .9 .95 1.0))
- (begs (vct 0.0 0.39 0.67 0.86 0.96 1.09))
- (frqs (vct 4750 4950 4880 4920 5210 5140))
- (starts (make-vector 7 0))
- (peep-dur 0.055)
- (ampf (make-env '(0.000 0.000 0.141 0.119 0.220 0.652 0.329 0.968 0.495 0.830 0.603 0.399 0.715 0.178 1.000 0.000)
- :duration peep-dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .97 2 .02 3 .01)))
- (frqf (make-env '(0 .5 .1 3 .2 1 .4 0 1 .2) :duration peep-dur :scaler (hz->radians 800)))
- (next-start start)
- (peep-amp 1.0)
- (peep-ctr 0))
-
- (do ((i 0 (+ i 1)))
- ((= i 6))
- (set! (starts i) (+ start (seconds->samples (begs i)))))
- (set! (starts 6) (+ 1 stop))
-
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-start)
- (begin
- (set! peep-amp (amps peep-ctr))
- (set! (mus-frequency gen1) (frqs peep-ctr))
- (set! peep-ctr (+ 1 peep-ctr))
- (set! next-start (starts peep-ctr))
- (mus-reset ampf)
- (mus-reset frqf)))
- (outa i (* (env ampf)
- peep-amp
- (polywave gen1 (env frqf))))))))
+(defanimal (california-towhee beg amp)
+ (let ((dur 1.17)
+ ;; peep pitch changes
+ (amps (vector .5 .8 .85 .9 .95 1.0))
+ (begs (vector 0.0 0.39 0.67 0.86 0.96 1.09))
+ (frqs (vector 4750 4950 4880 4920 5210 5140))
+ (starts (make-vector 7 0))
+ (peep-dur 0.055)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.141 0.119 0.220 0.652 0.329 0.968 0.495 0.830 0.603 0.399 0.715 0.178 1.000 0.000)
+ :duration peep-dur :scaler amp))
+ (gen1 #f)
+ (frqf (make-env '(0 .5 .1 3 .2 1 .4 0 1 .2) :duration peep-dur :scaler (hz->radians 800)))
+ (peep-samps (seconds->samples peep-dur))
+ (peep-amp 1.0)
+ (peep-ctr 0))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 6))
+ (set! (starts i) (+ start (seconds->samples (begs i)))))
+ (set! (starts 6) (+ 1 stop))
+
+ (do ((i start start))
+ ((>= i stop))
+
+ (set! peep-amp (amps peep-ctr))
+ (set! gen1 (make-polywave (frqs peep-ctr) :partials (list 1 (* peep-amp .97) 2 (* peep-amp .02) 3 (* peep-amp .01))))
+ (set! peep-ctr (+ peep-ctr 1))
+
+ (let ((reset-stop (min stop (+ i peep-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env ampf)
+ (polywave gen1 (env frqf)))))
+
+ (set! start (starts peep-ctr))
+ (mus-reset ampf)
+ (mus-reset frqf))))))
;; (with-sound (:play #t) (california-towhee 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Black-chinned sparrow
-(definstrument (black-chinned-sparrow beg amp gliss-up)
- (let* ((start (seconds->samples beg))
- ;; initial stable pitch, then the gliss->buzz with frq going either up or down
-
- (initial-dur .36)
- (initial-pitch 6800)
- (initial-amp .05)
- (initial-stop (+ start (seconds->samples initial-dur)))
- (initial-ampf (make-env '(0 0 1 1 10 1 11 0) :duration initial-dur :scaler (* amp initial-amp)))
- (initial-gen (make-oscil initial-pitch))
-
- (buzz-dur 2.62)
- (buzz-stop (+ initial-stop (seconds->samples buzz-dur)))
- (buzz-amp (make-env '(0.000 0.000 0.035 0.190 0.082 0.336 0.168 0.625 0.348 0.743 0.467 0.763
- 0.530 0.723 0.628 0.818 0.668 1.000 0.728 0.913 0.777 0.506 0.818 0.174 1.000 0.000)
- :duration buzz-dur :scaler amp))
- (buzz-frq0 (/ 1.0 (* 2 .34)))
- (buzz-frq1 (/ 1.0 .02))
- (buzz-frqmid (/ 1.0 .15))
- (buzz-frq (make-env (list 0 buzz-frq0 .5 buzz-frqmid 1 buzz-frq1) :duration buzz-dur :scaler (hz->radians 1.0)))
- (buzz-size 128)
- (buzz-low 3000)
- (buzz-high 8500)
- (buzz-mid 4000)
- (buzz-frq-table (let ((v (make-vct buzz-size 0.0))
- (bfrqf (make-env (if gliss-up
- (list 0 buzz-low .5 buzz-mid 1 buzz-high)
- (list 0 buzz-high .5 buzz-mid 1 buzz-low))
- :length buzz-size
- :scaler (hz->radians 1.0))))
- (do ((i 0 (+ i 1)))
- ((= i buzz-size))
- (set! (v i) (env bfrqf)))
- v))
- (buzz-amp-table (let ((v (make-vct buzz-size 0.0))
- (bampf (make-env (if gliss-up
- '(0 0 1 1 2.5 .7 3 0 3.5 0)
- '(0 0 .5 1 2 1 3 0 3.5 0))
- :length buzz-size)))
- (do ((i 0 (+ i 1)))
- ((= i buzz-size))
- (set! (v i) (env bampf)))
- v))
- (buzz-frqf (make-table-lookup buzz-frq0 :wave buzz-frq-table))
- (buzz-ampf (make-table-lookup buzz-frq0 :wave buzz-amp-table))
- (buzz-gen (make-polywave :partials (list 1 .98 2 .005 3 .01))))
-
- (run
-
- (do ((i start (+ i 1)))
- ((= i initial-stop))
- (outa i (* (env initial-ampf) (oscil initial-gen)) ))
-
- (do ((i initial-stop (+ i 1)))
- ((= i buzz-stop))
- (let* ((frq (env buzz-frq)))
- (outa i (* (env buzz-amp)
- (table-lookup buzz-ampf frq)
- (polywave buzz-gen (table-lookup buzz-frqf frq)))))))))
+(defanimal (black-chinned-sparrow beg amp gliss-up)
+ (let ((initial-dur .36)
+ (initial-pitch 6800)
+ (initial-amp .05)
+ (buzz-dur 2.62)
+ (buzz-frq0 (/ 1.0 (* 2 .34)))
+ (buzz-frq1 (/ 1.0 .02))
+ (buzz-frqmid (/ 1.0 .15))
+ (buzz-size 128)
+ (buzz-low 3000)
+ (buzz-high 8500)
+ (buzz-mid 4000)
+ (start (seconds->samples beg)))
+ (let (;; initial stable pitch, then the gliss->buzz with frq going either up or down
+ (initial-stop (+ start (seconds->samples initial-dur)))
+ (initial-ampf (make-env '(0 0 1 1 10 1 11 0) :duration initial-dur :scaler (* amp initial-amp)))
+ (initial-gen (make-oscil initial-pitch))
+
+ (buzz-frq-table (let ((v (make-float-vector buzz-size 0.0))
+ (bfrqf (make-env (if gliss-up
+ (list 0 buzz-low .5 buzz-mid 1 buzz-high)
+ (list 0 buzz-high .5 buzz-mid 1 buzz-low))
+ :length buzz-size
+ :scaler (hz->radians 1.0))))
+ (do ((i 0 (+ i 1)))
+ ((= i buzz-size))
+ (set! (v i) (env bfrqf)))
+ v))
+ (buzz-amp-table (let ((v (make-float-vector buzz-size 0.0))
+ (bampf (make-env (if gliss-up
+ '(0 0 1 1 2.5 .7 3 0 3.5 0)
+ '(0 0 .5 1 2 1 3 0 3.5 0))
+ :length buzz-size)))
+ (do ((i 0 (+ i 1)))
+ ((= i buzz-size))
+ (set! (v i) (env bampf)))
+ v)))
+ (let ((buzz-stop (+ initial-stop (seconds->samples buzz-dur)))
+ (buzz-amp (make-env '(0.000 0.000 0.035 0.190 0.082 0.336 0.168 0.625 0.348 0.743 0.467 0.763
+ 0.530 0.723 0.628 0.818 0.668 1.000 0.728 0.913 0.777 0.506 0.818 0.174 1.000 0.000)
+ :duration buzz-dur :scaler amp))
+ (buzz-frq (make-env (list 0 buzz-frq0 .5 buzz-frqmid 1 buzz-frq1) :duration buzz-dur :scaler (hz->radians 1.0)))
+
+ (buzz-frqf (make-table-lookup buzz-frq0 :wave buzz-frq-table))
+ (buzz-ampf (make-table-lookup buzz-frq0 :wave buzz-amp-table))
+ (buzz-gen (make-polywave 0.0 '(1 .98 2 .005 3 .01))))
+
+ (do ((i start (+ i 1)))
+ ((= i initial-stop))
+ (outa i (* (env initial-ampf) (oscil initial-gen)) ))
+
+ (do ((i initial-stop (+ i 1)))
+ ((= i buzz-stop))
+ (let ((frq (env buzz-frq)))
+ (outa i (* (env buzz-amp)
+ (table-lookup buzz-ampf frq)
+ (polywave buzz-gen (table-lookup buzz-frqf frq))))))))))
;; (with-sound (:play #t) (black-chinned-sparrow 0 .25 #t))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Mourning dove
-(definstrument (mourning-dove beg amp)
- (let* ((start (seconds->samples beg))
- (dur 4.1)
- (stop (+ start (seconds->samples dur)))
- (rnd (make-rand-interp 2000 (hz->radians 200.0)))
- (rndf (make-env '(0 1 2 .3 5 .3) :duration dur :scaler .1))
- (gen2 (make-oscil 620))
- (gen1 (make-polywave :partials (list 1 .95 2 .05 3 .005)))
- (ampf (make-env '(0.000 0.000 0.012 0.256 0.032 0.247 0.048 0.188 0.197 0.156 0.224 0.988 0.238 0.844
- 0.256 0.881 0.309 0.000 0.390 0.000 0.414 0.881 0.441 0.819 0.494 0.394 0.564 0.175
- 0.579 0.000 0.647 0.000 0.678 0.725 0.703 0.659 0.786 0.000 0.856 0.000 0.879 0.631
- 0.892 0.675 0.920 0.494 0.986 0.162 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.395 0.019 0.449 0.065 0.439 0.159 0.439 0.198 0.427 0.217 0.493 0.229 0.621
- 0.236 0.658 0.270 0.642 0.298 0.555 0.309 0.495 0.414 0.487 0.432 0.499 0.477 0.497
- 0.537 0.484 0.577 0.468 0.588 0.427 0.674 0.480 0.698 0.493 0.729 0.487 0.771 0.472
- 0.877 0.468 0.903 0.493 0.960 0.478 1.000 0.462)
- :duration dur :scaler (hz->radians 1000.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ (* .95 (polywave gen1 (env frqf)))
- (* (env rndf)
- (oscil gen2 (rand-interp rnd))))))))))
+(defanimal (mourning-dove beg amp)
+ (let ((dur 4.1))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (rnd (make-rand-interp 2000 (hz->radians 200.0)))
+ (rndf (make-env '(0 1 2 .3 5 .3) :duration dur :scaler .1))
+ (gen2 (make-oscil 620))
+ (gen1 (make-polywave 0.0 (list 1 (* .95 .95) 2 (* .95 .05) 3 (* .95 .005))))
+ (ampf (make-env '(0.000 0.000 0.012 0.256 0.032 0.247 0.048 0.188 0.197 0.156 0.224 0.988 0.238 0.844
+ 0.256 0.881 0.309 0.000 0.390 0.000 0.414 0.881 0.441 0.819 0.494 0.394 0.564 0.175
+ 0.579 0.000 0.647 0.000 0.678 0.725 0.703 0.659 0.786 0.000 0.856 0.000 0.879 0.631
+ 0.892 0.675 0.920 0.494 0.986 0.162 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.395 0.019 0.449 0.065 0.439 0.159 0.439 0.198 0.427 0.217 0.493 0.229 0.621
+ 0.236 0.658 0.270 0.642 0.298 0.555 0.309 0.495 0.414 0.487 0.432 0.499 0.477 0.497
+ 0.537 0.484 0.577 0.468 0.588 0.427 0.674 0.480 0.698 0.493 0.729 0.487 0.771 0.472
+ 0.877 0.468 0.903 0.493 0.960 0.478 1.000 0.462)
+ :duration dur :scaler (hz->radians 1000.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 (env frqf))
+ (* (env rndf)
+ (oscil gen2 (rand-interp rnd))))))))))
;; (with-sound (:play #t) (mourning-dove 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Bobwhite
-(definstrument (bobwhite beg amp)
- (let* ((call1-dur .32)
- (call1-amp .07)
- (call1-pitch 1500) ; 1530 down to 1450? 1 is pure, 2 and 3 have 1 2, no 3, 4
- (call1-gen (make-oscil 1450))
- (call1-ampf (make-env '(0 0 1 1 8 1 9 0) :duration call1-dur :scaler (* amp call1-amp)))
- (call1-frqf (make-env '(0 1 1 0) :duration call1-dur :scaler (hz->radians 80)))
- (call1-start (seconds->samples beg))
- (call1-stop (+ call1-start (seconds->samples call1-dur)))
-
- (call2-beg .80)
- (call2-dur .20)
- (call2-amp .35)
- (call2-gen (make-polywave 1320 (list 1 .95 2 .04 3 .01 4 .02 5 .01)))
- (call2-ampf (make-env '(0 0 1 1 4 1 5 0) :duration call2-dur :scaler (* amp call2-amp)))
- (call2-frqf (make-env '(0 0 1 1 4 1 5 .5) :duration call2-dur :scaler (hz->radians 430)))
- (call2-start (+ call1-start (seconds->samples call2-beg)))
- (call2-stop (+ call2-start (seconds->samples call2-dur)))
-
- (call3-beg 1.43)
- (call3-dur .22)
- (call3-amp 1.0)
- (call3-gen (make-polywave :partials (list 1 .95 2 .04 4 .01)))
- (call4-gen (make-polywave :partials (list 1 .05 2 .6 3 .2 4 .1 5 .01 6 .005)))
- (call3-ampf (make-env '(0 0 .5 1 .75 .2 1 0) :duration call3-dur :scaler (* amp call3-amp)))
- (call3-frqf (make-env '(0.000 0.245 0.135 0.304 0.399 0.335 0.439 0.345 0.491 0.384 0.551 0.434 0.591 0.485
- 0.65 0.65 .67 .5 1 .3)
- :duration call3-dur :scaler (hz->radians 6000.0)))
- (call3-f1 (make-env '(0 1 .6 1 .75 0 1 0) :duration call3-dur))
- (call3-f2 (make-env '(0 0 .6 0 .64 1 1 1) :duration call3-dur))
- (call3-start (+ call1-start (seconds->samples call3-beg)))
- (call3-stop (+ call3-start (seconds->samples call3-dur))))
- (run
-
- (do ((i call1-start (+ i 1)))
- ((= i call1-stop))
- (outa i (* (env call1-ampf)
- (oscil call1-gen (env call1-frqf)))))
-
- (do ((i call2-start (+ i 1)))
- ((= i call2-stop))
- (outa i (* (env call2-ampf)
- (polywave call2-gen (env call2-frqf)))))
-
- (do ((i call3-start (+ i 1)))
- ((= i call3-stop))
- (let ((f1 (env call3-f1))
- (f2 (env call3-f2))
- (frq (env call3-frqf)))
- (outa i (* (env call3-ampf)
- (+ (* f1 (polywave call3-gen frq))
- (* f2 (polywave call4-gen (* 0.5 frq)))))))))))
+(defanimal (bobwhite beg amp)
+ (let ((call1-dur .32)
+ (call1-amp .07)
+ (call2-beg .80)
+ (call2-dur .20)
+ (call2-amp .35)
+ (call3-beg 1.43)
+ (call3-dur .22)
+ (call3-amp 1.0)
+ (call1-start (seconds->samples beg)))
+ (let ((call1-gen (make-oscil 1450))
+ (call1-ampf (make-env '(0 0 1 1 8 1 9 0) :duration call1-dur :scaler (* amp call1-amp)))
+ (call1-frqf (make-env '(0 1 1 0) :duration call1-dur :scaler (hz->radians 80)))
+ (call1-stop (+ call1-start (seconds->samples call1-dur)))
+
+ (call2-gen (make-polywave 1320 '(1 .95 2 .04 3 .01 4 .02 5 .01)))
+ (call2-ampf (make-env '(0 0 1 1 4 1 5 0) :duration call2-dur :scaler (* amp call2-amp)))
+ (call2-frqf (make-env '(0 0 1 1 4 1 5 .5) :duration call2-dur :scaler (hz->radians 430)))
+ (call2-start (+ call1-start (seconds->samples call2-beg))))
+ (let ((call2-stop (+ call2-start (seconds->samples call2-dur)))
+
+ (call3-gen (make-polywave 0.0 '(1 .95 2 .04 4 .01)))
+ (call4-gen (make-polywave 0.0 '(1 .05 2 .6 3 .2 4 .1 5 .01 6 .005)))
+ (call3-ampf (make-env '(0 0 .5 1 .75 .2 1 0) :duration call3-dur :scaler (* amp call3-amp)))
+ (call3-frqf (make-env '(0.000 0.245 0.135 0.304 0.399 0.335 0.439 0.345 0.491 0.384 0.551 0.434 0.591 0.485
+ 0.65 0.65 .67 .5 1 .3)
+ :duration call3-dur :scaler (hz->radians 6000.0)))
+ (call3-f1 (make-env '(0 1 .6 1 .75 0 1 0) :duration call3-dur))
+ (call3-f2 (make-env '(0 0 .6 0 .64 1 1 1) :duration call3-dur))
+ (call3-start (+ call1-start (seconds->samples call3-beg))))
+ (let ((call3-stop (+ call3-start (seconds->samples call3-dur))))
+
+ (do ((i call1-start (+ i 1)))
+ ((= i call1-stop))
+ (outa i (* (env call1-ampf)
+ (oscil call1-gen (env call1-frqf)))))
+
+ (do ((i call2-start (+ i 1)))
+ ((= i call2-stop))
+ (outa i (* (env call2-ampf)
+ (polywave call2-gen (env call2-frqf)))))
+
+ (do ((i call3-start (+ i 1)))
+ ((= i call3-stop))
+ (let ((frq (env call3-frqf)))
+ (outa i (* (env call3-ampf)
+ (+ (* (env call3-f1) (polywave call3-gen frq))
+ (* (env call3-f2) (polywave call4-gen (* 0.5 frq)))))))))))))
;; (with-sound (:play #t) (bobwhite 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Warbling vireo
-(definstrument (warbling-vireo beg amp)
- (let* ((start (seconds->samples beg))
- (dur 2.25)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.018 0.042 0.046 0.000 0.074 0.113 0.091 0.111 0.096 0.000
- 0.113 0.000 0.129 0.124 0.144 0.089 0.148 0.026 0.164 0.000 0.187 0.108
- 0.209 0.000 0.220 0.000 0.222 0.103 0.235 0.218 0.245 0.205 0.258 0.000
- 0.268 0.000 0.279 0.087 0.305 0.089 0.316 0.000 0.338 0.000 0.345 0.216
- 0.379 0.726 0.402 0.000 0.411 0.000 0.414 0.324 0.437 0.155 0.455 0.139
- 0.461 0.000 0.473 0.000 0.482 0.126 0.492 0.126 0.497 0.321 0.509 0.139
- 0.520 0.003 0.536 0.308 0.552 0.187 0.565 0.250 0.572 0.000 0.587 0.000
- 0.596 0.737 0.619 0.966 0.646 0.501 0.661 0.000 0.670 0.000 0.679 0.266
- 0.697 0.097 0.703 0.711 0.719 0.000 0.736 0.000 0.746 0.997 0.756 0.282
- 0.775 0.392 0.787 0.000 0.804 0.000 0.813 0.811 0.826 0.463 0.836 0.411
- 0.847 0.000 0.862 0.000 0.873 0.284 0.893 0.192 0.899 0.066 0.912 0.329
- 0.921 0.000 0.931 0.000 0.934 0.303 0.947 0.466 0.960 0.418 0.980 0.258 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-oscil))
- (frqf (make-env '(0.000 0.184 0.010 0.214 0.026 0.214 0.036 0.197 0.057 0.197 0.066 0.233
- 0.085 0.266 0.099 0.260 0.113 0.255 0.124 0.274 0.125 0.222 0.134 0.249
- 0.146 0.227 0.165 0.227 0.169 0.178 0.179 0.184 0.191 0.192 0.209 0.175
- 0.221 0.186 0.226 0.312 0.227 0.258 0.233 0.285 0.234 0.236 0.242 0.274
- 0.245 0.241 0.252 0.230 0.268 0.227 0.272 0.203 0.284 0.225 0.295 0.216
- 0.306 0.208 0.316 0.219 0.346 0.233 0.357 0.282 0.359 0.252 0.366 0.296
- 0.369 0.252 0.373 0.304 0.376 0.255 0.382 0.301 0.385 0.263 0.390 0.301
- 0.412 0.279 0.418 0.321 0.421 0.247 0.424 0.279 0.427 0.233 0.441 0.211
- 0.450 0.208 0.457 0.178 0.480 0.197 0.484 0.238 0.488 0.205 0.492 0.241
- 0.495 0.200 0.499 0.247 0.506 0.241 0.512 0.186 0.529 0.192 0.530 0.255
- 0.548 0.238 0.557 0.214 0.568 0.241 0.582 0.230 0.591 0.299 0.599 0.307
- 0.609 0.301 0.615 0.274 0.627 0.342 0.645 0.359 0.648 0.329 0.670 0.332
- 0.672 0.247 0.700 0.227 0.705 0.304 0.715 0.249 0.722 0.244 0.738 0.247
- 0.749 0.307 0.753 0.425 0.762 0.422 0.770 0.468 0.774 0.392 0.786 0.342
- 0.808 0.326 0.821 0.255 0.832 0.285 0.843 0.266 0.866 0.263 0.891 0.197
- 0.915 0.247 0.935 0.285 0.942 0.345 0.945 0.290 0.947 0.441 0.950 0.353
- 0.953 0.411 0.957 0.367 0.960 0.405 0.964 0.370 0.967 0.405 0.973 0.373
- 0.979 0.373 0.990 0.296 1.000 0.255)
- :duration dur :scaler (hz->radians 11900))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (env frqf))))))))
+(defanimal (warbling-vireo beg amp)
+ (let ((dur 2.25))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.018 0.042 0.046 0.000 0.074 0.113 0.091 0.111 0.096 0.000
+ 0.113 0.000 0.129 0.124 0.144 0.089 0.148 0.026 0.164 0.000 0.187 0.108
+ 0.209 0.000 0.220 0.000 0.222 0.103 0.235 0.218 0.245 0.205 0.258 0.000
+ 0.268 0.000 0.279 0.087 0.305 0.089 0.316 0.000 0.338 0.000 0.345 0.216
+ 0.379 0.726 0.402 0.000 0.411 0.000 0.414 0.324 0.437 0.155 0.455 0.139
+ 0.461 0.000 0.473 0.000 0.482 0.126 0.492 0.126 0.497 0.321 0.509 0.139
+ 0.520 0.003 0.536 0.308 0.552 0.187 0.565 0.250 0.572 0.000 0.587 0.000
+ 0.596 0.737 0.619 0.966 0.646 0.501 0.661 0.000 0.670 0.000 0.679 0.266
+ 0.697 0.097 0.703 0.711 0.719 0.000 0.736 0.000 0.746 0.997 0.756 0.282
+ 0.775 0.392 0.787 0.000 0.804 0.000 0.813 0.811 0.826 0.463 0.836 0.411
+ 0.847 0.000 0.862 0.000 0.873 0.284 0.893 0.192 0.899 0.066 0.912 0.329
+ 0.921 0.000 0.931 0.000 0.934 0.303 0.947 0.466 0.960 0.418 0.980 0.258 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-oscil))
+ (frqf (make-env '(0.000 0.184 0.010 0.214 0.026 0.214 0.036 0.197 0.057 0.197 0.066 0.233
+ 0.085 0.266 0.099 0.260 0.113 0.255 0.124 0.274 0.125 0.222 0.134 0.249
+ 0.146 0.227 0.165 0.227 0.169 0.178 0.179 0.184 0.191 0.192 0.209 0.175
+ 0.221 0.186 0.226 0.312 0.227 0.258 0.233 0.285 0.234 0.236 0.242 0.274
+ 0.245 0.241 0.252 0.230 0.268 0.227 0.272 0.203 0.284 0.225 0.295 0.216
+ 0.306 0.208 0.316 0.219 0.346 0.233 0.357 0.282 0.359 0.252 0.366 0.296
+ 0.369 0.252 0.373 0.304 0.376 0.255 0.382 0.301 0.385 0.263 0.390 0.301
+ 0.412 0.279 0.418 0.321 0.421 0.247 0.424 0.279 0.427 0.233 0.441 0.211
+ 0.450 0.208 0.457 0.178 0.480 0.197 0.484 0.238 0.488 0.205 0.492 0.241
+ 0.495 0.200 0.499 0.247 0.506 0.241 0.512 0.186 0.529 0.192 0.530 0.255
+ 0.548 0.238 0.557 0.214 0.568 0.241 0.582 0.230 0.591 0.299 0.599 0.307
+ 0.609 0.301 0.615 0.274 0.627 0.342 0.645 0.359 0.648 0.329 0.670 0.332
+ 0.672 0.247 0.700 0.227 0.705 0.304 0.715 0.249 0.722 0.244 0.738 0.247
+ 0.749 0.307 0.753 0.425 0.762 0.422 0.770 0.468 0.774 0.392 0.786 0.342
+ 0.808 0.326 0.821 0.255 0.832 0.285 0.843 0.266 0.866 0.263 0.891 0.197
+ 0.915 0.247 0.935 0.285 0.942 0.345 0.945 0.290 0.947 0.441 0.950 0.353
+ 0.953 0.411 0.957 0.367 0.960 0.405 0.964 0.370 0.967 0.405 0.973 0.373
+ 0.979 0.373 0.990 0.296 1.000 0.255)
+ :duration dur :scaler (hz->radians 11900))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (env frqf))))))))
;; (with-sound (:play #t) (warbling-vireo 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Great-horned owl
-(definstrument (great-horned-owl beg amp)
- (let* ((begs (vct 0.0 0.26 1.42 2.16))
- (durs (vct 0.14 0.40 0.43 0.37))
- (amps (vct .75 .9 .95 1.0)))
-
- (do ((call 0 (+ 1 call)))
+(defanimal (great-horned-owl beg amp)
+ (let ((begs (vector 0.0 0.26 1.42 2.16))
+ (durs (vector 0.14 0.40 0.43 0.37))
+ (amps (vector .75 .9 .95 1.0)))
+ (do ((call 0 (+ call 1)))
((= call 4))
- (let* ((start (seconds->samples (+ beg (begs call))))
- (stop (+ start (seconds->samples (durs call))))
- (gen (make-polywave :partials (list 1 .9 2 .12 3 .007 7 .003)))
- (rnd (make-rand-interp 30 (hz->radians 5)))
- (ampf (make-env '(0 0 1 1 4 .9 5 0) :duration (durs call) :scaler (* amp (amps call))))
- (frqf (make-env '(0 1.25 .5 2 4.4 1.95 5 1) :base .1 :duration (durs call) :scaler (hz->radians (* 0.5 328)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen (+ (env frqf)
- (rand-interp rnd)))))))))))
+ (let ((start (seconds->samples (+ beg (begs call)))))
+ (let ((stop (+ start (seconds->samples (durs call))))
+ (gen (make-polywave 0.0 '(1 .9 2 .12 3 .007 7 .003)))
+ (rnd (make-rand-interp 30 (hz->radians 5)))
+ (ampf (make-env '(0 0 1 1 4 .9 5 0) :duration (durs call) :scaler (* amp (amps call))))
+ (frqf (make-env '(0 1.25 .5 2 4.4 1.95 5 1) :base .1 :duration (durs call) :scaler (hz->radians (* 0.5 328)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen (+ (env frqf)
+ (rand-interp rnd)))))))))))
;; (with-sound (:play #t) (great-horned-owl 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Western tanager
-(definstrument (western-tanager beg amp)
- (let* ((gen (make-polywave :partials '(1 .98 2 .02)))
- (begs (vct 0.0 0.7 1.4 2.0))
- (durs (vct 0.27 0.32 0.25 0.24))
- (amps (vct 0.32 0.85 1.0 0.65))
-
- (ampfs (vector
- (make-env '(0.000 0.000 0.086 0.398 0.247 0.610 0.363 0.000 0.416 0.000 0.513 0.603 0.610 0.603
- 0.708 0.507 0.733 0.232 0.798 0.895 0.848 1.000 0.898 0.927 1.000 0.000)
- :duration (durs 0) :scaler (* amp (amps 0)))
- (make-env '(0.000 0.000 0.060 0.735 0.303 1.000 0.394 0.408 0.503 0.318 0.617 0.879 0.912 0.258
- 0.939 0.055 1.000 0.000)
- :duration (durs 1) :scaler (* amp (amps 1)))
- (make-env '(0.000 0.000 0.098 0.837 0.183 0.704 0.395 1.000 0.469 0.185 0.553 0.086 0.731 0.841
- 0.785 0.834 1.000 0.000)
- :duration (durs 2) :scaler (* amp (amps 2)))
- (make-env '(0.000 0.000 0.047 0.837 0.117 0.172 0.167 0.157 0.234 0.993 0.296 0.826 0.319 0.609
- 0.431 0.781 0.567 0.506 0.642 0.166 0.673 0.757 0.769 0.874 0.873 0.766 0.919 0.605
- 0.956 0.230 1.000 0.000)
- :duration (durs 3) :scaler (* amp (amps 3)))))
-
- (frqfs (vector
- (make-env '(0.000 0.437 0.056 0.561 0.075 0.558 0.094 0.459 0.109 0.536 0.128 0.411 0.142 0.521
- 0.156 0.435 0.172 0.532 0.190 0.450 0.214 0.556 0.226 0.459 0.239 0.556 0.350 0.318
- 0.409 0.313 0.491 0.461 0.614 0.461 0.665 0.428 0.702 0.340 0.718 0.406 0.739 0.331
- 0.756 0.470 0.772 0.336 0.803 0.510 0.818 0.353 0.845 0.536 0.862 0.415 0.886 0.545
- 0.903 0.470 0.924 0.534 0.945 0.442 1.000 0.395)
- :duration (durs 0) :scaler (hz->radians 6000))
- (make-env '(0.000 0.587 0.045 0.543 0.064 0.459 0.088 0.563 0.105 0.481 0.127 0.600 0.141 0.514
- 0.172 0.620 0.185 0.532 0.212 0.640 0.233 0.567 0.251 0.629 0.266 0.589 0.374 0.448
- 0.440 0.404 0.528 0.406 0.557 0.450 0.583 0.466 0.604 0.517 0.618 0.481 0.648 0.552
- 0.667 0.499 0.691 0.556 0.710 0.517 0.739 0.561 0.758 0.519 0.791 0.561 0.814 0.510
- 0.833 0.534 0.975 0.483 1.000 0.488)
- :duration (durs 1) :scaler (hz->radians 6000))
- (make-env '(0.000 0.247 0.059 0.539 0.073 0.556 0.131 0.490 0.150 0.444 0.172 0.501 0.199 0.402
- 0.222 0.512 0.249 0.430 0.279 0.552 0.304 0.464 0.340 0.600 0.360 0.479 0.383 0.567
- 0.496 0.311 0.611 0.320 0.635 0.470 0.655 0.331 0.680 0.492 0.703 0.349 0.742 0.534
- 0.770 0.373 0.797 0.536 0.823 0.419 0.856 0.536 0.881 0.433 0.910 0.506 0.950 0.397
- 0.978 0.508 1.000 0.514)
- :duration (durs 2) :scaler (hz->radians 6000))
- (make-env '(0.000 0.614 0.031 0.607 0.046 0.514 0.072 0.430 0.145 0.307 0.168 0.380 0.191 0.536
- 0.205 0.453 0.223 0.570 0.239 0.457 0.261 0.547 0.282 0.426 0.297 0.503 0.318 0.426
- 0.341 0.453 0.449 0.468 0.580 0.435 0.635 0.419 0.652 0.353 0.674 0.494 0.687 0.545
- 0.706 0.455 0.732 0.556 0.754 0.457 0.783 0.547 0.807 0.455 0.840 0.558 0.858 0.453
- 0.885 0.539 0.914 0.439 0.938 0.541 0.965 0.433 1.000 0.472)
- :duration (durs 3) :scaler (hz->radians 6000)))))
-
- (do ((call 0 (+ 1 call)))
- ((= call 4))
- (let* ((ampf (ampfs call))
- (frqf (frqfs call))
- (start (seconds->samples (+ beg (begs call))))
- (stop (+ start (seconds->samples (durs call)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen (env frqf))))))))))
+(defanimal (western-tanager beg amp)
+ (let ((gen (make-polywave 0.0 '(1 .98 2 .02)))
+ (begs (vector 0.0 0.7 1.4 2.0))
+ (durs (vector 0.27 0.32 0.25 0.24))
+ (amps (vector 0.32 0.85 1.0 0.65)))
+ (let ((ampfs (vector
+ (make-env '(0.000 0.000 0.086 0.398 0.247 0.610 0.363 0.000 0.416 0.000 0.513 0.603 0.610 0.603
+ 0.708 0.507 0.733 0.232 0.798 0.895 0.848 1.000 0.898 0.927 1.000 0.000)
+ :duration (durs 0) :scaler (* amp (amps 0)))
+ (make-env '(0.000 0.000 0.060 0.735 0.303 1.000 0.394 0.408 0.503 0.318 0.617 0.879 0.912 0.258
+ 0.939 0.055 1.000 0.000)
+ :duration (durs 1) :scaler (* amp (amps 1)))
+ (make-env '(0.000 0.000 0.098 0.837 0.183 0.704 0.395 1.000 0.469 0.185 0.553 0.086 0.731 0.841
+ 0.785 0.834 1.000 0.000)
+ :duration (durs 2) :scaler (* amp (amps 2)))
+ (make-env '(0.000 0.000 0.047 0.837 0.117 0.172 0.167 0.157 0.234 0.993 0.296 0.826 0.319 0.609
+ 0.431 0.781 0.567 0.506 0.642 0.166 0.673 0.757 0.769 0.874 0.873 0.766 0.919 0.605
+ 0.956 0.230 1.000 0.000)
+ :duration (durs 3) :scaler (* amp (amps 3)))))
+
+ (frqfs (vector
+ (make-env '(0.000 0.437 0.056 0.561 0.075 0.558 0.094 0.459 0.109 0.536 0.128 0.411 0.142 0.521
+ 0.156 0.435 0.172 0.532 0.190 0.450 0.214 0.556 0.226 0.459 0.239 0.556 0.350 0.318
+ 0.409 0.313 0.491 0.461 0.614 0.461 0.665 0.428 0.702 0.340 0.718 0.406 0.739 0.331
+ 0.756 0.470 0.772 0.336 0.803 0.510 0.818 0.353 0.845 0.536 0.862 0.415 0.886 0.545
+ 0.903 0.470 0.924 0.534 0.945 0.442 1.000 0.395)
+ :duration (durs 0) :scaler (hz->radians 6000))
+ (make-env '(0.000 0.587 0.045 0.543 0.064 0.459 0.088 0.563 0.105 0.481 0.127 0.600 0.141 0.514
+ 0.172 0.620 0.185 0.532 0.212 0.640 0.233 0.567 0.251 0.629 0.266 0.589 0.374 0.448
+ 0.440 0.404 0.528 0.406 0.557 0.450 0.583 0.466 0.604 0.517 0.618 0.481 0.648 0.552
+ 0.667 0.499 0.691 0.556 0.710 0.517 0.739 0.561 0.758 0.519 0.791 0.561 0.814 0.510
+ 0.833 0.534 0.975 0.483 1.000 0.488)
+ :duration (durs 1) :scaler (hz->radians 6000))
+ (make-env '(0.000 0.247 0.059 0.539 0.073 0.556 0.131 0.490 0.150 0.444 0.172 0.501 0.199 0.402
+ 0.222 0.512 0.249 0.430 0.279 0.552 0.304 0.464 0.340 0.600 0.360 0.479 0.383 0.567
+ 0.496 0.311 0.611 0.320 0.635 0.470 0.655 0.331 0.680 0.492 0.703 0.349 0.742 0.534
+ 0.770 0.373 0.797 0.536 0.823 0.419 0.856 0.536 0.881 0.433 0.910 0.506 0.950 0.397
+ 0.978 0.508 1.000 0.514)
+ :duration (durs 2) :scaler (hz->radians 6000))
+ (make-env '(0.000 0.614 0.031 0.607 0.046 0.514 0.072 0.430 0.145 0.307 0.168 0.380 0.191 0.536
+ 0.205 0.453 0.223 0.570 0.239 0.457 0.261 0.547 0.282 0.426 0.297 0.503 0.318 0.426
+ 0.341 0.453 0.449 0.468 0.580 0.435 0.635 0.419 0.652 0.353 0.674 0.494 0.687 0.545
+ 0.706 0.455 0.732 0.556 0.754 0.457 0.783 0.547 0.807 0.455 0.840 0.558 0.858 0.453
+ 0.885 0.539 0.914 0.439 0.938 0.541 0.965 0.433 1.000 0.472)
+ :duration (durs 3) :scaler (hz->radians 6000)))))
+
+ (do ((call 0 (+ call 1)))
+ ((= call 4))
+ (let ((ampf (ampfs call))
+ (frqf (frqfs call))
+ (start (seconds->samples (+ beg (begs call)))))
+ (let ((stop (+ start (seconds->samples (durs call)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen (env frqf)))))))))))
;; (with-sound (:play #t) (western-tanager 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Pileated woodpecker
-(definstrument (pileated-woodpecker beg amp)
- (let* ((gen (make-polywave :partials (normalize-partials (list 1 .06 2 1.0 3 .1 4 .13 5 .07 6 .01 7 .015 8 .01 9 .017 10 .006))))
- (start (seconds->samples beg))
- (dur 2.28)
- (stop (+ start (seconds->samples 2.28)))
- (ampf (make-env '(0 .5 4 1 15 1) :duration dur :scaler amp))
- (pulse-space .137)
- (pulse-dur .06)
- (pulse-ampf (make-env '(0.000 0.000 0.20 0.625 0.511 0.985 0.663 1.000 0.802 0.940 0.906 0.731 0.961 0.157 1.000 0.000)
- :duration pulse-dur))
- (pulse-frqf (make-env '(0 0 .3 .9 .6 1 .8 1 1 .75) :duration pulse-dur :scaler (hz->radians 300)))
- (pulse-off (make-env '(0 1120 .25 1140 .4 1190 .9 1150) :length 18))
- (pulser (make-pulse-train (/ 1.0 pulse-space))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (> (pulse-train pulser) .1)
- (begin
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)
- (set! (mus-frequency gen) (- (env pulse-off) 300.0))))
- (outa i (* (env ampf)
- (env pulse-ampf)
- (polywave gen (env pulse-frqf))))))))
+(defanimal (pileated-woodpecker beg amp)
+ (let ((dur 2.28)
+ (pulse-space .137)
+ (pulse-dur .06)
+ (start (seconds->samples beg)))
+ (let ((gen #f)
+ (partials '(1 .06 2 1.0 3 .1 4 .13 5 .07 6 .01 7 .015 8 .01 9 .017 10 .006)) ; .705 is scaling
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 .5 4 1 15 1) :duration dur :scaler (* .705 amp)))
+ (pulse-ampf (make-env '(0.000 0.000 0.20 0.625 0.511 0.985 0.663 1.000 0.802 0.940 0.906 0.731 0.961 0.157 1.000 0.000)
+ :duration pulse-dur))
+ (pulse-frqf (make-env '(0 0 .3 .9 .6 1 .8 1 1 .75) :duration pulse-dur :scaler (hz->radians 300)))
+ (pulse-off (make-env '(0 1120 .25 1140 .4 1190 .9 1150) :length 18))
+ (pulse-samps (seconds->samples pulse-space))
+ (pulse-out (seconds->samples pulse-dur)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! gen (make-polywave
+ :partials (let ((xcoord #f))
+ (map (lambda (x)
+ (set! xcoord (not xcoord))
+ (if xcoord x (* x pulse-amp)))
+ partials))))
+ (set! (mus-frequency gen) (- (env pulse-off) 300.0))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulse-ampf)
+ (polywave gen (env pulse-frqf)))))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf))))))
;; (with-sound (:play #t) (pileated-woodpecker 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Whip-poor-will
-(definstrument (whip-poor-will beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.75)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.043 0.172 0.063 0.341 0.093 0.256 0.188 0.159 0.209 0.000
- 0.466 0.000 0.527 0.097 0.558 0.081 0.626 0.309 0.650 0.288
- 0.657 0.140 0.674 0.142 0.708 0.322 0.750 0.343 0.765 0.121
- 0.787 0.201 0.805 0.381 0.826 0.470
- 0.861 0.144 0.867 0.451 0.877 0.106
- 0.890 0.964
- 0.914 0.117 0.919 0.377 0.926 0.233 0.931 0.324 0.949 0.244 0.977 0.377 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials '(1 .98 2 .01 3 .01)))
- (frqf (make-env '(0 1170 .093 1680 .2 1640
- .46 1170 .558 1170 .626 1450 .650 1530
- .66 1290 .707 1480 .750 1480 .765 1290
- .78 1320 .8 1600
- .81 1300 .82 1900 .83 1500 .84 2100 .85 1700 .86 2150 .87 1900
- .89 2460 .914 2160 .93 1680 1.0 1600)
- :duration dur :scaler (hz->radians 1.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (whip-poor-will beg amp)
+ (let ((dur 0.75))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.043 0.172 0.063 0.341 0.093 0.256 0.188 0.159 0.209 0.000
+ 0.466 0.000 0.527 0.097 0.558 0.081 0.626 0.309 0.650 0.288
+ 0.657 0.140 0.674 0.142 0.708 0.322 0.750 0.343 0.765 0.121
+ 0.787 0.201 0.805 0.381 0.826 0.470
+ 0.861 0.144 0.867 0.451 0.877 0.106
+ 0.890 0.964
+ 0.914 0.117 0.919 0.377 0.926 0.233 0.931 0.324 0.949 0.244 0.977 0.377 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .01)))
+ (frqf (make-env '(0 1170 .093 1680 .2 1640
+ .46 1170 .558 1170 .626 1450 .650 1530
+ .66 1290 .707 1480 .750 1480 .765 1290
+ .78 1320 .8 1600
+ .81 1300 .82 1900 .83 1500 .84 2100 .85 1700 .86 2150 .87 1900
+ .89 2460 .914 2160 .93 1680 1.0 1600)
+ :duration dur :scaler (hz->radians 1.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (whip-poor-will 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Varied thrush
-(definstrument (varied-thrush beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.02)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.052 0.100 0.130 0.538 0.261 0.845 0.438 0.983 0.580 0.917 0.738 0.720 0.860 0.475 0.941 0.172 1.000 0.000)
- :duration dur :scaler (/ amp 2.25)))
- (gen1 (make-rxyk!cos 3360 (/ -200 3360) 0.7))
- (gen2 (make-rxyk!cos 3760 (/ 200 3760) 0.3))
- (gen3 (make-polywave 3660 '(1 .98 2 .02)))
- (frqf (make-env '(0 1 .1 0 .95 0 1.0 -.1) :duration dur :scaler (hz->radians 10.0)))
- (rnd (make-rand-interp 100 (hz->radians 3))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((fm (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (rxyk!cos gen1 (* (/ 3360 200) fm))
- (rxyk!cos gen2 (* (/ 3760 200) fm))
- (* .25 (polywave gen3 fm))))))))))
+(defanimal (varied-thrush beg amp)
+ (let ((dur 1.02))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.052 0.100 0.130 0.538 0.261 0.845 0.438 0.983 0.580 0.917 0.738 0.720 0.860 0.475 0.941 0.172 1.000 0.000)
+ :duration dur :scaler (/ amp 2.25)))
+ (gen1 (make-rxyk!cos 3360 (/ -200 3360) 0.7))
+ (gen2 (make-rxyk!cos 3760 (/ 200 3760) 0.3))
+ (gen3 (make-polywave 3660 (list 1 (* .25 .98) 2 (* .25 .02))))
+ (frqf (make-env '(0 1 .1 0 .95 0 1.0 -.1) :duration dur :scaler (hz->radians 10.0)))
+ (rnd (make-rand-interp 100 (hz->radians 3))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((fm (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (rxyk!cos gen1 (* 16.8 fm))
+ (rxyk!cos gen2 (* 18.8 fm))
+ (polywave gen3 fm)))))))))
;; (with-sound (:play #t) (varied-thrush 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Nashville warbler
-(definstrument (nashville-warbler beg amp)
+(defanimal (nashville-warbler beg amp)
(define (nashville-warbler-1 beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.111 0.837 0.169 0.995 0.328 1.000 0.430 0.905 0.561 0.333
- 0.595 0.000 0.61 0.0 0.62 0.154 0.715 0.675 0.806 0.959 0.969 0.908 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 7200 .1 5500 .3 4800 .56 4400
- .59 4500 .62 7200 .72 7200
- .8 6800 .83 6700
- .85 6700 .87 6600
- .9 6600 .92 6500
- .96 6500 1 6520)
- :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .005 3 .03))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.111 0.837 0.169 0.995 0.328 1.000 0.430 0.905 0.561 0.333
+ 0.595 0.000 0.61 0.0 0.62 0.154 0.715 0.675 0.806 0.959 0.969 0.908 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 7200 .1 5500 .3 4800 .56 4400
+ .59 4500 .62 7200 .72 7200
+ .8 6800 .83 6700
+ .85 6700 .87 6600
+ .9 6600 .92 6500
+ .96 6500 1 6520)
+ :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .005 3 .03))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
(define (nashville-warbler-2 beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.049 0.165 0.082 0.591 0.123 0.561 0.139 0.434 0.219 0.981 0.325 0.984
- 0.374 0.100 0.438 0.100 0.484 0.415 0.552 0.818 0.618 0.995 0.753 0.748 0.888 0.439 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 3450 .1 5000
- .14 4800 .37 5600
- .44 8600 .55 6600 .61 5300 1 3200)
- :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .005 3 .03))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.049 0.165 0.082 0.591 0.123 0.561 0.139 0.434 0.219 0.981 0.325 0.984
+ 0.374 0.100 0.438 0.100 0.484 0.415 0.552 0.818 0.618 0.995 0.753 0.748 0.888 0.439 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 3450 .1 5000
+ .14 4800 .37 5600
+ .44 8600 .55 6600 .61 5300 1 3200)
+ :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .005 3 .03))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
(define (nashville-warbler-3 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .1)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 3 1 4 0) :duration dur :scaler amp))
- (frqf (make-env '(0 7580 .6 5100 1 5000) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .005 3 .03))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur .1))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 3 1 4 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 7580 .6 5100 1 5000) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .005 3 .03))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
(define (nashville-warbler-4 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.07)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.129 0.201 0.182 0.382 0.197 1.000
- 0.243 0.350 0.342 0.520 0.393 0.759 0.485 0.878 0.647 0.694 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 3300 .195 4800
- .24 5500 .26 5500 .4 4500 .7 3460 1 3000)
- :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .96 2 .03 3 .005 4 .004))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (let* ((amps1 (vct .2 .5 .7 .9 1.0 1.0)))
+ (let ((dur 0.07))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.129 0.201 0.182 0.382 0.197 1.000
+ 0.243 0.350 0.342 0.520 0.393 0.759 0.485 0.878 0.647 0.694 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 3300 .195 4800
+ .24 5500 .26 5500 .4 4500 .7 3460 1 3000)
+ :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .96 2 .03 3 .005 4 .004))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (let ((amps1 (vector .2 .5 .7 .9 1.0 1.0)))
- (do ((call 0 (+ 1 call)))
+ (do ((call 0 (+ call 1)))
((= call 6))
(nashville-warbler-1 (+ beg (* .21 call)) (+ .15 (random .02)) (* amp (amps1 call))))
- (do ((call 0 (+ 1 call)))
+ (do ((call 0 (+ call 1)))
((= call 3))
(nashville-warbler-2 (+ beg 1.26 (* .17 call)) (+ .13 (random .02)) amp))
@@ -4080,242 +4106,269 @@
;; (with-sound (:play #t) (nashville-warbler 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Ruffed grouse
-(definstrument (ruffed-grouse beg amp)
- (let* ((dur 10.33)
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.006 0.097 0.045 0.135 0.091 0.244 0.141 0.223
- 0.219 0.552 0.301 0.682 0.360 0.689 0.503 0.766 0.696 0.619
- 0.751 0.622 0.806 0.705 0.820 0.552 0.829 0.787 0.849 0.687
- 0.867 1.000 0.910 0.494 0.929 0.559 0.944 0.527 0.969 0.339 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env (list 0 (/ 1.0 .45) .18 (/ 1.0 .45)
- .19 (/ 1.0 .8)
- .22 (/ 1.0 .8)
- .25 (/ 1.0 .6)
- .5 (/ 1.0 .4)
- .74 (/ 1.0 .15)
- .9 (/ 1.0 .08)
- 1 (/ 1.0 .4))
- :duration dur :scaler (hz->radians 1.0)))
- (pulser (make-pulse-train 0.0))
-
- (bump-dur 0.27)
- (bump-samps (seconds->samples bump-dur))
- (bump (make-env '(0.000 0.499 0.040 0.499 0.063 0.506 0.089 0.492 0.108 0.499 0.122 0.523
- 0.134 0.506 0.143 0.462 0.153 0.425 0.164 0.457 0.171 0.508 0.173 0.580
- 0.176 0.647 0.181 0.691 0.186 0.650 0.195 0.404 0.197 0.355 0.202 0.311
- 0.208 0.362 0.222 0.657 0.229 0.696 0.235 0.661 0.258 0.350 0.263 0.311
- 0.271 0.297 0.283 0.343 0.311 0.661 0.316 0.703 0.322 0.733 0.333 0.698
- 0.340 0.643 0.375 0.343 0.379 0.304 0.389 0.278 0.404 0.353 0.443 0.624
- 0.458 0.661 0.473 0.631 0.494 0.508 0.517 0.434 0.537 0.394 0.557 0.436
- 0.589 0.520 0.618 0.564 0.644 0.538 0.679 0.490 0.703 0.473 0.736 0.483
- 0.794 0.510 0.831 0.510 0.909 0.494 1.000 0.499)
- :duration bump-dur :offset -0.5)))
- (run
- (do ((i start (+ i 1)))
- ((>= i stop))
- (let ((vol (env ampf)))
- (if (> (pulse-train pulser (env frqf)) .1)
- (let ((bump-amp (/ (* amp vol) .15))
- (bump-stop (+ i bump-samps)))
- (mus-reset bump)
- (do ((k i (+ 1 k)))
- ((= k bump-stop))
- (outa k (* bump-amp (env bump)))))))))))
-
-;; (with-sound (:play #t :statistics #t) (ruffed-grouse 0 0.5))
+(defanimal (ruffed-grouse beg amp)
+ (let ((dur 10.33)
+ (bump-dur 0.27))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.006 0.097 0.045 0.135 0.091 0.244 0.141 0.223
+ 0.219 0.552 0.301 0.682 0.360 0.689 0.503 0.766 0.696 0.619
+ 0.751 0.622 0.806 0.705 0.820 0.552 0.829 0.787 0.849 0.687
+ 0.867 1.1000 0.910 0.494 0.929 0.559 0.944 0.527 0.969 0.339 1.000 0.000)
+ :duration dur :scaler (* 3 amp)))
+ (frqf (make-env (list 0 (/ 1.0 .45)
+ .18 (/ 1.0 .45)
+ .19 (/ 1.0 .8)
+ .22 (/ 1.0 .8)
+ .25 (/ 1.0 .6)
+ .5 (/ 1.0 .4)
+ .74 (/ 1.0 .15)
+ .9 (/ 1.0 .08)
+ 1 (/ 1.0 .4))
+ :duration dur :scaler (hz->radians 1.0)))
+ (bump-samps (seconds->samples bump-dur))
+ (bump (make-env '(0.000 0.499 0.040 0.499 0.063 0.506 0.089 0.492 0.108 0.499 0.122 0.523
+ 0.134 0.506 0.143 0.462 0.153 0.425 0.164 0.457 0.171 0.508 0.173 0.580
+ 0.176 0.647 0.181 0.691 0.186 0.650 0.195 0.404 0.197 0.355 0.202 0.311
+ 0.208 0.362 0.222 0.657 0.229 0.696 0.235 0.661 0.258 0.350 0.263 0.311
+ 0.271 0.297 0.283 0.343 0.311 0.661 0.316 0.703 0.322 0.733 0.333 0.698
+ 0.340 0.643 0.375 0.343 0.379 0.304 0.389 0.278 0.404 0.353 0.443 0.624
+ 0.458 0.661 0.473 0.631 0.494 0.508 0.517 0.434 0.537 0.394 0.557 0.436
+ 0.589 0.520 0.618 0.564 0.644 0.538 0.679 0.490 0.703 0.473 0.736 0.483
+ 0.794 0.510 0.831 0.510 0.909 0.494 1.000 0.499)
+ :duration bump-dur :offset -0.5)))
+
+ (let ((bump-wave (make-float-vector bump-samps 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i bump-samps))
+ (set! (bump-wave i) (env bump)))
+ (let ((wt (make-wave-train 0.0 0.0 bump-wave)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (wave-train wt (env frqf))))))))))
+#|
+;; old form:
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (if (> (pulse-train pulser (env frqf)) .1)
+ (let ((bump-stop (+ i bump-samps)))
+ (set! (mus-location ampf) (- i start))
+ (let ((vol (env ampf)))
+ (mus-reset bump)
+ (do ((k i (+ k 1)))
+ ((= k bump-stop))
+ (outa k (* vol (env bump)))))))))))
+|#
+
+;; (with-sound (:play #t) (ruffed-grouse 0 0.5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Plumbeous vireo
-(definstrument (plumbeous-vireo-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.34)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 .02 .1 0.124 0.146 0.142 0.370 0.251 1.000 0.277 0.373 .29 .1 0.393 0.326 0.419 0.731
- 0.568 0.407 0.713 0.286 0.885 0.351 0.947 0.311 0.967 0.123 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .98 3 .01 5 .004)))
- (ampf1a (make-env '(0 .2 .15 .25 .2 .01 .24 .02 .25 .1 .32 .1 .34 .005 .37 .001 .4 .05 .6 .03 1 0) :duration dur))
- (gen1a (make-oscil))
- (frqf (make-env '(0.000 0.181 0.054 0.175 0.072 0.187 0.087 0.156 0.097 0.177 0.118 0.154 0.151 0.259 0.201
- 0.320 0.243 0.293 0.256 0.261 0.275 0.202 0.295 0.162 0.316 0.204 0.328 0.314 0.339 0.446
- 0.359 0.489 0.382 0.454 0.394 0.352 0.425 0.286 0.449 0.277 0.467 0.246 0.494 0.238 0.507
- 0.211 0.525 0.234 0.551 0.166 0.570 0.215 0.586 0.207 0.595 0.161 0.617 0.211 0.633 0.203
- 0.642 0.159 0.657 0.207 0.692 0.168 0.711 0.231 0.728 0.227 0.742 0.188 0.750 0.257 0.795
- 0.218 0.802 0.283 0.845 0.234 0.856 0.296 0.897 0.229 0.909 0.292 0.958 0.227 0.969 0.261 1.000 0.252)
- :duration dur :scaler (hz->radians 10000.0)))
- (gen2 (make-polywave :partials (list 1 .05 2 .1 3 .2 4 .3 5 .2 6 .1 7 .05)))
- (ampf2 (make-env '(0 1 .15 0 1 0) :duration dur :scaler (* .5 amp)))
- (frqf2 (make-env '(0 850 1 700) :duration dur :scaler (hz->radians 1.0)))
- (rnd (make-rand-interp 1000 (hz->radians 50)))
- (buzz (make-rand-interp 1000 (hz->radians 40))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf1a)
- (oscil gen1a (* 2 frq)))
- (* (env ampf2)
- (polywave gen2 (+ (env frqf2)
- (rand-interp buzz))))))))))))
+(defanimal (plumbeous-vireo-1 beg amp)
+ (let ((dur 0.34))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 .02 .1 0.124 0.146 0.142 0.370 0.251 1.000 0.277 0.373 .29 .1 0.393 0.326 0.419 0.731
+ 0.568 0.407 0.713 0.286 0.885 0.351 0.947 0.311 0.967 0.123 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .98 3 .01 5 .004)))
+ (ampf1a (make-env '(0 .2 .15 .25 .2 .01 .24 .02 .25 .1 .32 .1 .34 .005 .37 .001 .4 .05 .6 .03 1 0) :duration dur))
+ (gen1a (make-oscil))
+ (frqf (make-env '(0.000 0.181 0.054 0.175 0.072 0.187 0.087 0.156 0.097 0.177 0.118 0.154 0.151 0.259 0.201
+ 0.320 0.243 0.293 0.256 0.261 0.275 0.202 0.295 0.162 0.316 0.204 0.328 0.314 0.339 0.446
+ 0.359 0.489 0.382 0.454 0.394 0.352 0.425 0.286 0.449 0.277 0.467 0.246 0.494 0.238 0.507
+ 0.211 0.525 0.234 0.551 0.166 0.570 0.215 0.586 0.207 0.595 0.161 0.617 0.211 0.633 0.203
+ 0.642 0.159 0.657 0.207 0.692 0.168 0.711 0.231 0.728 0.227 0.742 0.188 0.750 0.257 0.795
+ 0.218 0.802 0.283 0.845 0.234 0.856 0.296 0.897 0.229 0.909 0.292 0.958 0.227 0.969 0.261 1.000 0.252)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (gen2 (make-polywave 0.0 '(1 .05 2 .1 3 .2 4 .3 5 .2 6 .1 7 .05)))
+ (ampf2 (make-env '(0 1 .15 0 1 0) :duration dur :scaler (* .5 amp)))
+ (frqf2 (make-env '(0 850 1 700) :duration dur :scaler (hz->radians 1.0)))
+ (rnd (make-rand-interp 1000 (hz->radians 50)))
+ (buzz (make-rand-interp 1000 (hz->radians 40))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf1a)
+ (oscil gen1a (* 2.0 frq)))
+ (* (env ampf2)
+ (polywave gen2 (+ (env frqf2)
+ (rand-interp buzz))))))))))))
;; (with-sound (:play #t) (plumbeous-vireo-1 0 .25))
-(definstrument (plumbeous-vireo-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.455)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.106 0.184 0.148 0.082 0.169 0.156 0.183 0.441 0.199 0.484 0.216 0.379
- 0.234 0.770 0.244 0.748 0.252 0.527 0.261 0.992 0.320 0.961 0.343 0.742 0.360 0.832
- 0.395 0.916 0.411 0.145 0.416 0.559 0.421 0.126 0.424 0.577 0.435 0.791 0.448 0.529
- 0.452 0.089 0.460 0.639 0.472 0.777 0.485 0.181 0.495 0.656 0.499 0.319 0.506 0.854
- 0.515 0.668 0.516 0.186 0.523 0.559 0.535 0.933 0.540 0.599 0.545 0.923 0.554 0.282
- 0.562 0.795 0.569 0.609 0.574 0.988 0.579 0.908 0.588 0.772 0.593 0.161 0.597 0.646
- 0.604 0.879 0.612 0.931 0.625 0.800 0.630 0.267 0.634 0.782 0.644 0.926 0.649 0.812
- 0.652 0.423 0.658 0.955 0.664 0.718 0.670 0.973 0.675 0.235 0.682 0.752 0.691 1.000
- 0.698 0.938 0.706 0.153 0.712 0.889 0.720 0.693 0.735 0.906 0.745 0.661 0.750 0.228
- 0.754 0.594 0.757 0.683 0.763 0.411 0.767 0.621 0.779 0.797 0.793 0.693 0.797 0.532
- 0.802 0.564 0.810 0.386 0.814 0.653 0.839 0.535 0.840 0.092 0.843 0.495 0.851 0.572
- 0.862 0.627 0.870 0.490 0.873 0.592 0.882 0.416 0.888 0.054 0.889 0.359 0.896 0.465
- 0.901 0.379 0.908 0.543 0.919 0.413 0.926 0.443 0.931 0.218 0.949 0.516 0.959 0.423
- 0.979 0.151 1.000 0.000 )
- :duration dur :scaler amp))
- (frqf (make-env '(0.030 0.200 0.053 0.223 0.086 0.262 0.135 0.262 0.179 0.225 0.200 0.215 0.210 0.257
- 0.222 0.374 0.235 0.441 0.266 0.396 0.293 0.376 0.332 0.401 0.345 0.418 0.353 0.450
- 0.365 0.413 0.382 0.465 0.397 0.428 0.413 0.505 0.427 0.433 0.446 0.537 0.461 0.438
- 0.480 0.550 0.494 0.446 0.508 0.525 0.533 0.386 0.546 0.473 0.565 0.371 0.581 0.455
- 0.607 0.344 0.618 0.426 0.646 0.324 0.658 0.391 0.687 0.300 0.704 0.364 0.730 0.302
- 0.747 0.359 0.773 0.297 0.789 0.347 0.815 0.290 0.832 0.342 0.861 0.285 0.883 0.347
- 0.907 0.285 0.923 0.332 1.000 0.252)
- :duration dur :scaler (hz->radians 8100.0)))
- (gen1 (make-polywave :partials (list 1 .99 3 .005)))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (ampf2 (make-env '(0 .2 .1 1 .13 0 1 0) :duration dur :scaler .5))
- (ampf3 (make-env '(0 .3 .1 .3 .16 1 .19 0 1 0) :duration dur :scaler 1))
- (rnd (make-rand-interp 1000 (hz->radians 50))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (oscil gen2 (* 1.5 frq)))
- (* (env ampf3)
- (oscil gen3 (* 2 frq)))))))))))
+(defanimal (plumbeous-vireo-2 beg amp)
+ (let ((dur 0.455))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.106 0.184 0.148 0.082 0.169 0.156 0.183 0.441 0.199 0.484 0.216 0.379
+ 0.234 0.770 0.244 0.748 0.252 0.527 0.261 0.992 0.320 0.961 0.343 0.742 0.360 0.832
+ 0.395 0.916 0.411 0.145 0.416 0.559 0.421 0.126 0.424 0.577 0.435 0.791 0.448 0.529
+ 0.452 0.089 0.460 0.639 0.472 0.777 0.485 0.181 0.495 0.656 0.499 0.319 0.506 0.854
+ 0.515 0.668 0.516 0.186 0.523 0.559 0.535 0.933 0.540 0.599 0.545 0.923 0.554 0.282
+ 0.562 0.795 0.569 0.609 0.574 0.988 0.579 0.908 0.588 0.772 0.593 0.161 0.597 0.646
+ 0.604 0.879 0.612 0.931 0.625 0.800 0.630 0.267 0.634 0.782 0.644 0.926 0.649 0.812
+ 0.652 0.423 0.658 0.955 0.664 0.718 0.670 0.973 0.675 0.235 0.682 0.752 0.691 1.000
+ 0.698 0.938 0.706 0.153 0.712 0.889 0.720 0.693 0.735 0.906 0.745 0.661 0.750 0.228
+ 0.754 0.594 0.757 0.683 0.763 0.411 0.767 0.621 0.779 0.797 0.793 0.693 0.797 0.532
+ 0.802 0.564 0.810 0.386 0.814 0.653 0.839 0.535 0.840 0.092 0.843 0.495 0.851 0.572
+ 0.862 0.627 0.870 0.490 0.873 0.592 0.882 0.416 0.888 0.054 0.889 0.359 0.896 0.465
+ 0.901 0.379 0.908 0.543 0.919 0.413 0.926 0.443 0.931 0.218 0.949 0.516 0.959 0.423
+ 0.979 0.151 1.000 0.000 )
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.030 0.200 0.053 0.223 0.086 0.262 0.135 0.262 0.179 0.225 0.200 0.215 0.210 0.257
+ 0.222 0.374 0.235 0.441 0.266 0.396 0.293 0.376 0.332 0.401 0.345 0.418 0.353 0.450
+ 0.365 0.413 0.382 0.465 0.397 0.428 0.413 0.505 0.427 0.433 0.446 0.537 0.461 0.438
+ 0.480 0.550 0.494 0.446 0.508 0.525 0.533 0.386 0.546 0.473 0.565 0.371 0.581 0.455
+ 0.607 0.344 0.618 0.426 0.646 0.324 0.658 0.391 0.687 0.300 0.704 0.364 0.730 0.302
+ 0.747 0.359 0.773 0.297 0.789 0.347 0.815 0.290 0.832 0.342 0.861 0.285 0.883 0.347
+ 0.907 0.285 0.923 0.332 1.000 0.252)
+ :duration dur :scaler (hz->radians 8100.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 3 .005)))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (ampf2 (make-env '(0 .2 .1 1 .13 0 1 0) :duration dur :scaler .5))
+ (ampf3 (make-env '(0 .3 .1 .3 .16 1 .19 0 1 0) :duration dur :scaler 1))
+ (rnd (make-rand-interp 1000 (hz->radians 50))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (oscil gen2 (* 1.5 frq)))
+ (* (env ampf3)
+ (oscil gen3 (* 2.0 frq)))))))))))
;; (with-sound (:play #t) (plumbeous-vireo-2 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Least bittern
-(definstrument (least-bittern beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.25)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.100 0.123 0.388 0.454 0.884 0.649 0.995 0.754 0.776 1.000 0.100) :duration dur :scaler amp))
- (frqf (make-env '(0 .6 1 .75 2 1 3 .40) :duration dur :scaler (hz->radians 90)))
- (gen1 (make-polywave :partials (list 1 .25 2 .6 3 .2 4 .01 5 .01)))
- (rnd (make-rand-interp 200 (hz->radians 40)))
-
- (pulser (make-pulse-train (/ 1.0 .13)))
- (pulse-dur .09)
- (pulse-samps (seconds->samples pulse-dur))
- (pulse-ampf (make-env '(0.000 0.000 0.119 0.698 0.258 1.000 0.355 0.310 0.564 0.1 0.7 0.070 1.3 0) :duration pulse-dur))
- (pulse-frqf (make-env '(0 150 .3 300 1 250 2 200 3 200 3.5 150 4 230) :duration pulse-dur :scaler (hz->radians 1.0)))
- (pulse-rnd (make-rand-interp 4000 .2)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((vol (env ampf))
- (pit (env frqf)))
- (if (> (pulse-train pulser) .1)
- (begin
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)))
- (outa i (* (env pulse-ampf)
- vol
- (+ (polywave gen1 (+ pit
- (env pulse-frqf)
- (rand-interp rnd)))
- (rand-interp pulse-rnd)))))))))
+(defanimal (least-bittern beg amp)
+ (let ((dur 1.25)
+ (pulse-dur .09))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.100 0.123 0.388 0.454 0.884 0.649 0.995 0.754 0.776 1.000 0.100) :duration dur :scaler amp))
+ (frqf (make-env '(0 .6 1 .75 2 1 3 .40) :duration dur :scaler (hz->radians 90)))
+ (gen1 #f)
+ (rnd (make-rand-interp 200 (hz->radians 40)))
+
+ (pulse-samps (seconds->samples .13))
+ (pulse-out (seconds->samples pulse-dur))
+ (pulse-ampf (make-env '(0.000 0.000 0.119 0.698 0.258 1.000 0.355 0.310 0.564 0.1 0.7 0.070 1.3 0) :duration pulse-dur))
+ (pulse-frqf (make-env '(0 150 .3 300 1 250 2 200 3 200 3.5 150 4 230) :duration pulse-dur :scaler (hz->radians 1.0)))
+ (pulse-rnd #f))
+
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf)))
+ (set! (mus-location frqf) (- i start))
+ (set! gen1 (make-polywave 0.0 (list 1 (* pulse-amp .25) 2 (* pulse-amp .6) 3 (* pulse-amp .2)
+ 4 (* pulse-amp .01) 5 (* pulse-amp .01))))
+ (set! pulse-rnd (make-rand-interp 4000 (* pulse-amp .2)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulse-ampf)
+ (+ (polywave gen1 (+ (env frqf)
+ (env pulse-frqf)
+ (rand-interp rnd)))
+ (rand-interp pulse-rnd)))))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf))))))
;; (with-sound (:play #t) (least-bittern 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; American crow
-(definstrument (american-crow beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.27)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 .02 .1 .04 .01 .06 0.056 0.110 0.700 0.258 1.000 0.344 0.970 0.369 0.677 .7 .3 1.000 0.000)
- :duration dur :scaler (* 2 amp)))
- (frqf (make-env '(0.000 0.360 0.038 0.362 0.052 0.396 0.076 0.403 0.095 0.445 0.129 0.445 0.153 0.493
- 0.201 0.495 0.231 0.501 0.260 0.490 0.297 0.503 0.317 0.499 0.346 0.473 0.407 0.473
- 0.435 0.424 0.495 0.439 0.528 0.392 0.589 0.405 0.621 0.362 0.677 0.373 0.704 0.332
- 0.767 0.325 0.791 0.281 0.832 0.278 0.859 0.251 0.890 0.225 0.912 0.255 0.950 0.263 1.000 0.26)
- :duration dur :scaler (hz->radians 1250.0)))
- (frm1 (make-formant 1400 .995))
- (frm2 (make-formant 5500 .98))
- (frm3 (make-formant 3800 .98))
-
- (fr1 (* 2 20 (sin (hz->radians 1400))))
- (fr2 (* 2 (sin (hz->radians 5500))))
- (fr3 (* 2 2 (sin (hz->radians 3800))))
-
- (gen (make-nrcos 0.0 15 .75))
- (rnd (make-rand-interp 5000 .007)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((inp (* (env ampf)
- (nrcos gen (+ (env frqf)
- (rand-interp rnd))))))
- (outa i (+ (* fr1 (formant frm1 inp))
- (* fr2 (formant frm2 inp))
- (* fr3 (formant frm3 inp)))))))))
+(define (nrcos->polywave n r scl)
+ (if (and (positive? n)
+ (< n 8192))
+ (let ((lst ())
+ (total (polynomial (make-float-vector n 1.0) r)))
+ (set! scl (/ scl total))
+ (do ((i 0 (+ i 1)))
+ ((= i n) (reverse lst))
+ (set! lst (cons (* scl (expt r i)) (cons (+ i 1) lst)))))
+ (error 'out-of-range "nrcos->polywave: too many partials")))
+
+(defanimal (american-crow beg amp)
+ (let ((dur 0.27))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 .02 .1 .04 .01 .06 0.056 0.110 0.700 0.258 1.000 0.344 0.970 0.369 0.677 .7 .3 1.000 0.000)
+ :duration dur :scaler (* 2 amp)))
+ (frqf (make-env '(0.000 0.360 0.038 0.362 0.052 0.396 0.076 0.403 0.095 0.445 0.129 0.445 0.153 0.493
+ 0.201 0.495 0.231 0.501 0.260 0.490 0.297 0.503 0.317 0.499 0.346 0.473 0.407 0.473
+ 0.435 0.424 0.495 0.439 0.528 0.392 0.589 0.405 0.621 0.362 0.677 0.373 0.704 0.332
+ 0.767 0.325 0.791 0.281 0.832 0.278 0.859 0.251 0.890 0.225 0.912 0.255 0.950 0.263 1.000 0.26)
+ :duration dur :scaler (hz->radians 1250.0)))
+ (frm1 (make-formant 1400 .995))
+ (frm2 (make-formant 5500 .98))
+ (frm3 (make-formant 3800 .98))
+
+ (fr1 (* 2 20 (sin (hz->radians 1400))))
+ (fr2 (* 2 (sin (hz->radians 5500))))
+ (fr3 (* 2 2 (sin (hz->radians 3800))))
+
+ (gen (make-polywave 0.0 (nrcos->polywave 15 .75 1.0)))
+ (rnd (make-rand-interp 5000 .007)))
+
+ (let ((fb (vector frm1 frm2 frm3))
+ (fs (float-vector fr1 fr2 fr3)))
+ (set! fb (make-formant-bank fb fs))
+
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (formant-bank fb (* (env ampf)
+ (polywave gen (+ (env frqf)
+ (rand-interp rnd)))))))))))
;; (with-sound (:play #t) (american-crow 0 .5))
-(definstrument (american-crow-no-formants beg amp) ; this is for sndclm.html
- (let* ((start (seconds->samples beg))
- (dur 0.27)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 .02 .1 .04 .01 .06 0.056 0.110 0.700 0.258 1.000 0.344 0.970 0.369 0.677 .7 .3 1.000 0.000)
- :duration dur :scaler (* 2 amp)))
- (frqf (make-env '(0.000 0.360 0.038 0.362 0.052 0.396 0.076 0.403 0.095 0.445 0.129 0.445 0.153 0.493
- 0.201 0.495 0.231 0.501 0.260 0.490 0.297 0.503 0.317 0.499 0.346 0.473 0.407 0.473
- 0.435 0.424 0.495 0.439 0.528 0.392 0.589 0.405 0.621 0.362 0.677 0.373 0.704 0.332
- 0.767 0.325 0.791 0.281 0.832 0.278 0.859 0.251 0.890 0.225 0.912 0.255 0.950 0.263 1.000 0.26)
- :duration dur :scaler (hz->radians 1250.0)))
- (gen (make-nrcos 0.0 15 .75))
- (rnd (make-rand-interp 5000 .007)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((inp (* (env ampf)
- (nrcos gen (+ (env frqf)
- (rand-interp rnd))))))
- (outa i inp))))))
+
+(defanimal (american-crow-no-formants beg amp) ; this is for sndclm.html
+ (let ((dur 0.27))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 .02 .1 .04 .01 .06 0.056 0.110 0.700 0.258 1.000 0.344 0.970 0.369 0.677 .7 .3 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.360 0.038 0.362 0.052 0.396 0.076 0.403 0.095 0.445 0.129 0.445 0.153 0.493
+ 0.201 0.495 0.231 0.501 0.260 0.490 0.297 0.503 0.317 0.499 0.346 0.473 0.407 0.473
+ 0.435 0.424 0.495 0.439 0.528 0.392 0.589 0.405 0.621 0.362 0.677 0.373 0.704 0.332
+ 0.767 0.325 0.791 0.281 0.832 0.278 0.859 0.251 0.890 0.225 0.912 0.255 0.950 0.263 1.000 0.26)
+ :duration dur :scaler (hz->radians 1250.0)))
+ (gen (make-polywave 0.0 (nrcos->polywave 15 .75 1.0) mus-chebyshev-second-kind))
+ (rnd (make-rand-interp 5000 .007)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen (+ (env frqf)
+ (rand-interp rnd)))))))))
@@ -4323,1077 +4376,1081 @@
;;;
;;; Orange-crowned warbler
-(definstrument (orange-crowned-warbler beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.5)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.05 0.347 1.000 0.838 0.831 1.000 0.000) :duration dur :scaler amp))
- (gen1 (make-oscil))
- (frqf (make-env '(0 0 7 1 10 0) :duration dur :scaler (hz->radians 600.0)))
-
- (pulse-dur 0.045)
- (pulse-samps (seconds->samples pulse-dur))
- (pulse-ampf1 (make-env '(0.000 0.000 0.038 0.152 0.062 0.115 0.148 0.468 0.211 0.530 0.228 0.290
- 0.266 0.642 0.313 0.873 0.362 0.623 0.401 0.918 0.443 0.054 0.475 0.983
- 0.490 0.901 0.501 0.290 0.525 0.668 0.576 0.189 0.605 0.155 0.621 0.313
- 0.656 0.082 0.679 0.259 0.703 0.118 0.730 0.177 0.752 0.062 0.775 0.155
- 0.798 0.048 0.812 0.099 0.831 0.059 0.885 0.096 0.922 0.048 0.947 0.087 1.000 0.000)
- :duration pulse-dur))
- (pulse-frqf1 (make-env '(0 3700 .2 4500 .3 4500 .45 4000 .8 4000 1 4300) :duration pulse-dur :scaler (hz->radians 1.0)))
- (pulser (make-pulse-train (/ 1.0 pulse-dur)))
-
- (call1-stop (+ start (seconds->samples 1.35)))
- (call2-start (+ start (seconds->samples 1.36)))
- (call2-dur 0.13)
- (pulse-ampf2 (make-env '(0.000 0.000 0.074 0.994 0.135 0.375 0.184 0.637 0.238 0.721 0.290 0.411 0.381 0.003
- 0.537 0.000 0.591 0.186 0.704 0.121 0.737 0.437 0.843 0.358 0.880 0.045 0.908 0.225 1.000 0.000)
- :duration call2-dur :scaler (* 0.5 amp)))
- (pulse-frqf2 (make-env '(0 4800 .1 3950 .15 3820 .22 3950 .4 4800 .6 4600 .7 3480 .75 3940 .86 5200 1 5150)
- :duration call2-dur :scaler (hz->radians 1.0))))
- (run
- ;; 30 repetitions, then 2 special end tones
- (do ((i start (+ i 1)))
- ((= i call1-stop))
- (let ((vol (env ampf))
- (frq (env frqf)))
- (if (> (pulse-train pulser) .1)
- (begin
- (mus-reset pulse-ampf1)
- (mus-reset pulse-frqf1)))
- (outa i (* vol
- (env pulse-ampf1)
- (oscil gen1 (+ frq (env pulse-frqf1)))))))
-
- (do ((i call2-start (+ i 1)))
- ((= i stop))
- (outa i (* (env pulse-ampf2)
- (oscil gen1 (env pulse-frqf2))))))))
+(defanimal (orange-crowned-warbler beg amp)
+ (let ((dur 1.5)
+ (pulse-dur 0.045)
+ (call2-dur 0.13)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.05 0.347 1.000 0.838 0.831 1.000 0.000) :duration dur :scaler amp))
+ (gen1 (make-oscil))
+ (frqf (make-env '(0 0 7 1 10 0) :duration dur :scaler (hz->radians 600.0)))
+
+ (pulse-ampf1 (make-env '(0.000 0.000 0.038 0.152 0.062 0.115 0.148 0.468 0.211 0.530 0.228 0.290
+ 0.266 0.642 0.313 0.873 0.362 0.623 0.401 0.918 0.443 0.054 0.475 0.983
+ 0.490 0.901 0.501 0.290 0.525 0.668 0.576 0.189 0.605 0.155 0.621 0.313
+ 0.656 0.082 0.679 0.259 0.703 0.118 0.730 0.177 0.752 0.062 0.775 0.155
+ 0.798 0.048 0.812 0.099 0.831 0.059 0.885 0.096 0.922 0.048 0.947 0.087 1.000 0.000)
+ :duration pulse-dur))
+ (pulse-frqf1 (make-env '(0 3700 .2 4500 .3 4500 .45 4000 .8 4000 1 4300) :duration pulse-dur :scaler (hz->radians 1.0)))
+ (pulse-samps (seconds->samples pulse-dur))
+
+ (call1-stop (+ start (seconds->samples 1.35)))
+ (call2-start (+ start (seconds->samples 1.36)))
+
+ (pulse-ampf2 (make-env '(0.000 0.000 0.074 0.994 0.135 0.375 0.184 0.637 0.238 0.721 0.290 0.411 0.381 0.003
+ 0.537 0.000 0.591 0.186 0.704 0.121 0.737 0.437 0.843 0.358 0.880 0.045 0.908 0.225 1.000 0.000)
+ :duration call2-dur :scaler (* 0.5 amp)))
+ (pulse-frqf2 (make-env '(0 4800 .1 3950 .15 3820 .22 3950 .4 4800 .6 4600 .7 3480 .75 3940 .86 5200 1 5150)
+ :duration call2-dur :scaler (hz->radians 1.0))))
+ ;; 30 repetitions, then 2 special end tones
+ (do ((i start (+ i pulse-samps)))
+ ((>= i call1-stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min call1-stop (+ i pulse-samps)))
+ (pulse-amp (env ampf)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* pulse-amp
+ (env pulse-ampf1)
+ (oscil gen1 (+ (env frqf) (env pulse-frqf1))))))
+ (mus-reset pulse-ampf1)
+ (mus-reset pulse-frqf1)))
+
+ (do ((i call2-start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env pulse-ampf2)
+ (oscil gen1 (env pulse-frqf2))))))))
;; (with-sound (:play #t) (orange-crowned-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Loggerhead shrike
-(definstrument (loggerhead-shrike-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.65)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 .01 1 .99 1 1 0) :duration dur :scaler amp))
- (gen1 (make-oscil))
- (frqf (make-env '(0 0 1 1) :duration dur :scaler (hz->radians 100.0)))
-
- (open-dur .036)
- (open-samps (seconds->samples open-dur))
- (open-stop (+ start open-samps))
- (open-ampf (make-env '(0.000 0.000 0.158 0.063 0.280 0.162 0.386 0.775 0.418 0.644
- 0.465 0.000 0.573 0.000 0.592 0.921 .62 .1 0.633 0.866
- 0.726 0.000 0.788 0.000 0.829 0.399 0.889 0.154 1.000 0.000)
- :duration open-dur :scaler .75))
- (open-frqf (make-env '(0 4200 .35 3900 .46 3800
- .57 3600 .6 3900 .61 5100 .72 5100
- .8 3400 .83 4200 1 4200)
- :duration open-dur :scaler (hz->radians 1.0)))
-
- (pulse-dur .008)
- (pulser (make-pulse-train (/ 1.0 pulse-dur)))
- (pulse-ampf (make-env '(0 0 .05 1 .3 1 .8 .1 1 0) :duration pulse-dur))
- (pulse-frqf (make-env '(0 3600 .2 4800 .5 5000 .85 4000 1 3700) :duration pulse-dur :scaler (hz->radians 1.0)))
- (trem (make-oscil 160))
- (rnd (make-rand-interp 500 .04))
- (rnd1 (make-rand-interp 100 .01)))
- (run
- ;; special starting call, then the buzz
- (do ((i start (+ i 1)))
- ((= i open-stop))
- (outa i (* (env open-ampf)
- (env ampf)
- (oscil gen1 (+ (env frqf)
- (env open-frqf))))))
-
- (do ((i open-stop (+ i 1)))
- ((= i stop))
- (if (> (pulse-train pulser) .1)
- (begin
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)))
- (outa i (* (env ampf)
- (env pulse-ampf)
- (+ .5 (* .5 (abs (oscil trem (rand-interp rnd1)))))
- (oscil gen1 (+ (env frqf)
- (env pulse-frqf)
- (rand-interp rnd)))))))))
+(defanimal (loggerhead-shrike-1 beg amp)
+ (let ((dur 0.65)
+ (open-dur .036)
+ (pulse-dur .008)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 .01 1 .99 1 1 0) :duration dur :scaler amp))
+ (gen1 (make-oscil))
+ (frqf (make-env '(0 0 1 1) :duration dur :scaler (hz->radians 100.0)))
+ (open-samps (seconds->samples open-dur)))
+ (let ((open-stop (+ start open-samps))
+ (open-ampf (make-env '(0.000 0.000 0.158 0.063 0.280 0.162 0.386 0.775 0.418 0.644
+ 0.465 0.000 0.573 0.000 0.592 0.921 .62 .1 0.633 0.866
+ 0.726 0.000 0.788 0.000 0.829 0.399 0.889 0.154 1.000 0.000)
+ :duration open-dur :scaler .75))
+ (open-frqf (make-env '(0 4200 .35 3900 .46 3800
+ .57 3600 .6 3900 .61 5100 .72 5100
+ .8 3400 .83 4200 1 4200)
+ :duration open-dur :scaler (hz->radians 1.0)))
+
+ (pulse-samps (seconds->samples pulse-dur))
+ (pulse-ampf (make-env '(0 0 .05 1 .3 1 .8 .1 1 0) :duration pulse-dur))
+ (pulse-frqf (make-env '(0 3600 .2 4800 .5 5000 .85 4000 1 3700) :duration pulse-dur :scaler (hz->radians 1.0)))
+ (trem (make-oscil 160))
+ (rnd (make-rand-interp 500 .04))
+ (rnd1 (make-rand-interp 100 .01)))
+ ;; special starting call, then the buzz
+ (do ((i start (+ i 1)))
+ ((= i open-stop))
+ (outa i (* (env open-ampf)
+ (env ampf)
+ (oscil gen1 (+ (env frqf)
+ (env open-frqf))))))
+
+ (do ((i open-stop (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-samps)))
+ (pulse-amp (env ampf)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* pulse-amp
+ (* (env pulse-ampf)
+ (+ .5 (* .5 (abs (oscil trem (rand-interp rnd1)))))
+ (oscil gen1 (+ (env frqf)
+ (env pulse-frqf)
+ (rand-interp rnd)))))))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf)))))))
;; (with-sound (:play #t) (loggerhead-shrike-1 0 .5))
-(definstrument (loggerhead-shrike-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.4)
- (stop (+ start (seconds->samples dur)))
- (frqs (vct .9 .95 .95 1.0 1.0 1.0))
-
- (pulse-dur .08)
- (pulse-samps (seconds->samples pulse-dur))
- (pulse-ampf (make-env '(0.000 0.000 0.114 0.077 0.153 0.943 0.191 0.960 0.291 0.510 0.320 0.114
- 0.342 0.647 0.373 0.191 0.400 0.490 0.419 0.066 0.456 0.291 0.728 0.288
- 0.769 0.479 0.792 0.407 0.812 0.003 1.000 0.000)
- :duration pulse-dur :scaler amp))
- (frqf1 (make-env '(0.000 0.229 0.310 0.231 0.325 0.271 0.345 0.273 0.377 0.237 0.397 0.240
- 0.615 0.235 0.7 0.235 1.000 0.235)
- :duration pulse-dur :scaler (hz->radians 10500.0)))
- (frqf2 (make-env '(0.000 0.13 .6 .13 0.7 0.15 .9 .15 1.000 0.1)
- :duration pulse-dur :scaler (hz->radians 10500.0)))
- (next-pulse (+ start pulse-samps))
-
- (ampf1 (make-env '(0 1 .8 1 1 0) :duration pulse-dur))
- (ampf2 (make-env '(0 0 .6 0 .7 1 1 1) :duration pulse-dur))
- (gen1 (make-polywave :partials (list 1 .95 2 .04 3 .005)))
- (gen2 (make-polywave :partials (list 1 .5 2 .5 4 .01)))
- (pulse-frq (frqs 0))
- (pulse-ctr 1)
- (rnd (make-rand-interp 500 .02)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (set! next-pulse (+ next-pulse pulse-samps))
- (set! pulse-frq (frqs pulse-ctr))
- (set! pulse-ctr (+ pulse-ctr 1))
- (mus-reset pulse-ampf)
- (mus-reset ampf1)
- (mus-reset ampf2)
- (mus-reset frqf1)
- (mus-reset frqf2)))
-
- (let ((noise (rand-interp rnd)))
- (outa i (* (env pulse-ampf)
- (+ (* (env ampf1)
- (polywave gen1 (* pulse-frq (+ noise (env frqf1)))))
- (* (env ampf2)
- (polywave gen2 (* pulse-frq (+ noise (env frqf2)))))))))))))
+(defanimal (loggerhead-shrike-2 beg amp)
+ (let ((dur 0.4)
+ (pulse-dur .08)
+ (frqs (vector .9 .95 .95 1.0 1.0 1.0))
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (pulse-samps (seconds->samples pulse-dur))
+ (pulse-ampf (make-env '(0.000 0.000 0.114 0.077 0.153 0.943 0.191 0.960 0.291 0.510 0.320 0.114
+ 0.342 0.647 0.373 0.191 0.400 0.490 0.419 0.066 0.456 0.291 0.728 0.288
+ 0.769 0.479 0.792 0.407 0.812 0.003 1.000 0.000)
+ :duration pulse-dur :scaler amp))
+ (frqf1 (make-env '(0.000 0.229 0.310 0.231 0.325 0.271 0.345 0.273 0.377 0.237 0.397 0.240
+ 0.615 0.235 0.7 0.235 1.000 0.235)
+ :duration pulse-dur :scaler (hz->radians 10500.0)))
+ (frqf2 (make-env '(0.000 0.13 .6 .13 0.7 0.15 .9 .15 1.000 0.1)
+ :duration pulse-dur :scaler (hz->radians 10500.0))))
+ (let ((ampf1 (make-env '(0 1 .8 1 1 0) :duration pulse-dur))
+ (ampf2 (make-env '(0 0 .6 0 .7 1 1 1) :duration pulse-dur))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .04 3 .005)))
+ (gen2 (make-polywave 0.0 '(1 .5 2 .5 4 .01)))
+ (pulse-frq (frqs 0))
+ (pulse-ctr 1)
+ (rnd (make-rand-interp 500 .02)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((noise (rand-interp rnd)))
+ (outa k (* (env pulse-ampf)
+ (+ (* (env ampf1)
+ (polywave gen1 (* pulse-frq (+ noise (env frqf1)))))
+ (* (env ampf2)
+ (polywave gen2 (* pulse-frq (+ noise (env frqf2))))))))))
+ (set! pulse-frq (frqs pulse-ctr))
+ (set! pulse-ctr (+ pulse-ctr 1))
+ (mus-reset pulse-ampf)
+ (mus-reset ampf1)
+ (mus-reset ampf2)
+ (mus-reset frqf1)
+ (mus-reset frqf2)))))))
;; (with-sound (:play #t) (loggerhead-shrike-2 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; California Quail
-(definstrument (california-quail beg amp)
- (let* ((durs (vct .075 .23 .16))
- (begs (vct 0.0 .21 .58))
- (ampfs (make-vector 3 #f))
- (frqfs (make-vector 3 #f))
- (gens (make-vector 3 #f))
- (starts (make-vector 3 0))
- (stops (make-vector 3 0))
- (frm1 (make-formant 1000 .995))
- (frm2 (make-formant 1700 .99))
- (frm3 (make-formant 5600 .98))
-
- (fr1 (* 2 5 (sin (hz->radians 1000))))
- (fr2 (* 2 15 (sin (hz->radians 1700))))
- (fr3 (* 2 5 (sin (hz->radians 5600)))))
-
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (set! (starts i) (seconds->samples (+ beg (begs i))))
- (set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
-
- (set! (gens 0) (make-nrxysin 530 1.0 8 .5))
- (set! (gens 1) (make-nrxysin 450 1.0 15 .6))
- (set! (gens 2) (make-nrxysin 400 1.0 8 .5))
-
- (set! (ampfs 0) (make-env '(0 0 1.25 1 1.75 1 3 0) :base 10 :duration (durs 0) :scaler (* amp 0.25)))
- (set! (ampfs 1) (make-env '(0.000 0.000 0.208 0.719 0.292 0.965 0.809 0.869 0.928 0.682 1.000 0.000) :base 10 :duration (durs 1) :scaler (* 0.5 amp)))
- (set! (ampfs 2) (make-env '(0 0 1 1 3 1 6 0) :base 10 :duration (durs 2) :scaler (* amp .375)))
-
- (set! (frqfs 0) (make-env '(0 0 1.3 1 2 0) :duration (durs 0) :scaler (hz->radians 300)))
- (set! (frqfs 1) (make-env '(0 0 1.5 .8 2.5 1 4 .95 5 .25) :base .03 :duration (durs 1) :scaler (hz->radians 520)))
- (set! (frqfs 2) (make-env '(0 0 .2 .7 .3 1 1 .5) :duration (durs 2) :scaler (hz->radians 450.0)))
+(defanimal (california-quail beg amp)
+ (let ((durs (vector .075 .23 .16))
+ (begs (vector 0.0 .21 .58))
+ (ampfs (make-vector 3 #f))
+ (frqfs (make-vector 3 #f))
+ (gens (make-vector 3 #f))
+ (starts (make-vector 3 0))
+ (stops (make-vector 3 0))
+ (frm1 (make-formant 1000 .995))
+ (frm2 (make-formant 1700 .99))
+ (frm3 (make-formant 5600 .98))
+
+ (fr1 (* 2 5 (sin (hz->radians 1000))))
+ (fr2 (* 2 15 (sin (hz->radians 1700))))
+ (fr3 (* 2 5 (sin (hz->radians 5600)))))
+
+ (let ((fb (vector frm1 frm2 frm3))
+ (fs (float-vector fr1 fr2 fr3)))
+ (set! fb (make-formant-bank fb fs))
- (run
- (do ((k 0 (+ 1 k)))
- ((= k 3))
- (let ((start (starts k))
- (stop (stops k))
- (ampf (ampfs k))
- (frqf (frqfs k))
- (gen (gens k)))
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((val (* (env ampf)
- (nrxysin gen (env frqf)))))
- (outa i (+ (* fr1 (formant frm1 val))
- (* fr2 (formant frm2 val))
- (* fr3 (formant frm3 val)))))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (set! (starts i) (seconds->samples (+ beg (begs i))))
+ (set! (stops i) (+ (starts i) (seconds->samples (durs i)))))
+
+ (set! (gens 0) (make-nrxysin 530 1.0 8 .5))
+ (set! (gens 1) (make-nrxysin 450 1.0 15 .6))
+ (set! (gens 2) (make-nrxysin 400 1.0 8 .5))
+
+ (set! (ampfs 0) (make-env '(0 0 1.25 1 1.75 1 3 0) :base 10 :duration (durs 0) :scaler (* amp 0.25)))
+ (set! (ampfs 1) (make-env '(0.000 0.000 0.208 0.719 0.292 0.965 0.809 0.869 0.928 0.682 1.000 0.000) :base 10 :duration (durs 1) :scaler (* 0.5 amp)))
+ (set! (ampfs 2) (make-env '(0 0 1 1 3 1 6 0) :base 10 :duration (durs 2) :scaler (* amp .375)))
+
+ (set! (frqfs 0) (make-env '(0 0 1.3 1 2 0) :duration (durs 0) :scaler (hz->radians 300)))
+ (set! (frqfs 1) (make-env '(0 0 1.5 .8 2.5 1 4 .95 5 .25) :base .03 :duration (durs 1) :scaler (hz->radians 520)))
+ (set! (frqfs 2) (make-env '(0 0 .2 .7 .3 1 1 .5) :duration (durs 2) :scaler (hz->radians 450.0)))
+
+ (do ((k 0 (+ k 1)))
+ ((= k 3))
+ (let ((start (starts k))
+ (stop (stops k))
+ (ampf (ampfs k))
+ (frqf (frqfs k))
+ (gen (gens k)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (formant-bank fb (nrxysin gen (env frqf)))))))))))
;; (with-sound (:play #t) (california-quail 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Vermillion flycatcher
-(definstrument (vermillion-flycatcher beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.72)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.023 0.527
- 0.045 0.000 0.264 0.000 0.282 0.868 0.295 0.231
- 0.312 0.000 0.462 0.000 0.481 0.918 0.503 0.206
- 0.520 0.000 0.598 0.000 0.614 0.848 0.633 0.729 0.648 0.164
- 0.660 0.000 0.685 0.000 0.696 0.654 0.709 0.746 0.719 0.532
- 0.738 0.000 0.747 0.100 0.750 0.570 0.770 0.435
- 0.779 0.000 0.814 0.000 0.823 0.923 0.836 0.525 0.840 0.998 0.855 0.968 0.866 0.321
- 0.883 0.095 0.909 0.517 0.924 0.600 0.961 0.440 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .98 2 .015 3 .006)))
- (frqf (make-env '(0.000 0.378 0.022 0.474 0.032 0.400
- 0.266 0.378 0.278 0.496 0.297 0.402 0.462 0.351 0.469 0.466 0.482
- 0.526 0.504 0.398 0.602 0.378 0.607 0.486 0.617 0.546 0.637 0.490 0.643 0.398
- 0.686 0.402 0.689 0.510 0.709 0.582 0.721 0.560 0.736 0.558 0.744 0.406 0.752 0.562 0.767 0.679
- 0.793 0.394 0.810 0.394 0.827 0.851 0.836 0.633 0.849 0.564 0.856 0.478 0.871 0.448
- 0.887 0.480 0.902 0.506 0.924 0.510 0.950 0.500 0.973 0.466 1.000 0.470)
- :duration dur :scaler (hz->radians 8000.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (vermillion-flycatcher beg amp)
+ (let ((dur 0.72))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.023 0.527
+ 0.045 0.000 0.264 0.000 0.282 0.868 0.295 0.231
+ 0.312 0.000 0.462 0.000 0.481 0.918 0.503 0.206
+ 0.520 0.000 0.598 0.000 0.614 0.848 0.633 0.729 0.648 0.164
+ 0.660 0.000 0.685 0.000 0.696 0.654 0.709 0.746 0.719 0.532
+ 0.738 0.000 0.747 0.100 0.750 0.570 0.770 0.435
+ 0.779 0.000 0.814 0.000 0.823 0.923 0.836 0.525 0.840 0.998 0.855 0.968 0.866 0.321
+ 0.883 0.095 0.909 0.517 0.924 0.600 0.961 0.440 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .015 3 .006)))
+ (frqf (make-env '(0.000 0.378 0.022 0.474 0.032 0.400
+ 0.266 0.378 0.278 0.496 0.297 0.402 0.462 0.351 0.469 0.466 0.482
+ 0.526 0.504 0.398 0.602 0.378 0.607 0.486 0.617 0.546 0.637 0.490 0.643 0.398
+ 0.686 0.402 0.689 0.510 0.709 0.582 0.721 0.560 0.736 0.558 0.744 0.406 0.752 0.562 0.767 0.679
+ 0.793 0.394 0.810 0.394 0.827 0.851 0.836 0.633 0.849 0.564 0.856 0.478 0.871 0.448
+ 0.887 0.480 0.902 0.506 0.924 0.510 0.950 0.500 0.973 0.466 1.000 0.470)
+ :duration dur :scaler (hz->radians 8000.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (vermillion-flycatcher 0 .5))
+
;;;--------------------------------------------------------------------------------
;;;
;;; Cardinal
-(definstrument (cardinal beg amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples 3.26)))
- (call 0)
- (next-call (+ start (seconds->samples 0.35)))
- (gen1 (make-polywave :partials (normalize-partials (list 1 1 2 .08 3 .01 4 .05 5 .005 6 .01))))
-
- (call1-dur 0.185)
- (call1-ampf (make-env '(0.000 0.000 0.174 0.333 0.243 0.273 0.332 0.446 0.391 0.373 0.446 0.488
- 0.496 0.363 0.545 0.064 0.606 0.048 0.632 0.614 0.676 0.783 0.732 0.655
- 0.764 0.667 0.802 0.992 0.841 0.659 0.888 0.633 0.951 0.347 0.974 0.122 1.000 0.000)
- :duration call1-dur :scaler (* 0.5 amp)))
- (call1-frqf (make-env '(0.000 0.299 0.230 0.320 0.387 0.339 0.513 0.349 0.586 0.349 0.610 0.534
- 0.622 0.570 0.654 0.585 0.703 0.594 0.753 0.584 0.778 0.566 0.803 0.560
- 0.911 0.434 1.000 0.435)
- :duration call1-dur :scaler (hz->radians 6000.0)))
-
- (call2-dur 0.19)
- (call2-ampf (make-env '(0.000 0.000 0.041 0.159 0.101 0.263 0.167 0.247 0.246 0.126 0.266 0.150
- 0.443 0.000 0.573 0.000 0.599 0.202 0.635 0.299 0.667 0.273 0.683 0.371 0.724 0.411
- 0.796 0.000 0.83 0.0 0.848 0.155 0.870 1.000 0.925 0.639 0.951 0.126 1.000 0.000)
- :duration call2-dur :scaler amp))
- (call2-frqf (make-env '(0.000 0.138 0.032 0.173 0.063 0.187 0.215 0.176 0.403 0.140 0.542 0.117 0.590 0.214
- 0.659 0.218 0.750 0.250 0.794 0.244 0.832 0.618 0.843 0.518
- 0.876 0.352 0.909 0.335 0.954 0.323 1.000 0.311)
- :duration call2-dur :scaler (hz->radians 10000.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-call)
- (begin
- (set! call (+ 1 call))
- (if (= call 1)
- (begin
- (set! next-call (+ start (seconds->samples 0.63)))
- (mus-reset call1-ampf)
- (mus-reset call1-frqf))
- (begin
- (set! next-call (+ next-call (seconds->samples 0.24)))
- (mus-reset call2-ampf)
- (mus-reset call2-frqf)))))
- (outa i (if (< call 2)
- (* (env call1-ampf)
- (polywave gen1 (env call1-frqf)))
- (* (env call2-ampf)
- (polywave gen1 (env call2-frqf)))))))))
+(defanimal (cardinal beg amp)
+ (let ((call1-dur 0.185)
+ (call2-dur 0.19)
+ (start (seconds->samples beg)))
+ (let ((stop (+ start (seconds->samples 3.26)))
+ (call 0)
+ (next-call 0)
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 1 2 .08 3 .01 4 .05 5 .005 6 .01))))
+
+ (call1-ampf (make-env '(0.000 0.000 0.174 0.333 0.243 0.273 0.332 0.446 0.391 0.373 0.446 0.488
+ 0.496 0.363 0.545 0.064 0.606 0.048 0.632 0.614 0.676 0.783 0.732 0.655
+ 0.764 0.667 0.802 0.992 0.841 0.659 0.888 0.633 0.951 0.347 0.974 0.122 1.000 0.000)
+ :duration call1-dur :scaler (* 0.5 amp)))
+ (call1-frqf (make-env '(0.000 0.299 0.230 0.320 0.387 0.339 0.513 0.349 0.586 0.349 0.610 0.534
+ 0.622 0.570 0.654 0.585 0.703 0.594 0.753 0.584 0.778 0.566 0.803 0.560
+ 0.911 0.434 1.000 0.435)
+ :duration call1-dur :scaler (hz->radians 6000.0)))
+
+ (call2-ampf (make-env '(0.000 0.000 0.041 0.159 0.101 0.263 0.167 0.247 0.246 0.126 0.266 0.150
+ 0.443 0.000 0.573 0.000 0.599 0.202 0.635 0.299 0.667 0.273 0.683 0.371 0.724 0.411
+ 0.796 0.000 0.83 0.0 0.848 0.155 0.870 1.000 0.925 0.639 0.951 0.126 1.000 0.000)
+ :duration call2-dur :scaler amp))
+ (call2-frqf (make-env '(0.000 0.138 0.032 0.173 0.063 0.187 0.215 0.176 0.403 0.140 0.542 0.117 0.590 0.214
+ 0.659 0.218 0.750 0.250 0.794 0.244 0.832 0.618 0.843 0.518
+ 0.876 0.352 0.909 0.335 0.954 0.323 1.000 0.311)
+ :duration call2-dur :scaler (hz->radians 10000.0))))
+ (let ((call-ampf call1-ampf)
+ (call-frqf call1-frqf)
+ (call-samps (seconds->samples call1-dur)))
+
+ (do ((i start next-call))
+ ((>= i stop))
+
+ (let ((call-stop (min stop (+ i call-samps))))
+ (do ((k i (+ k 1)))
+ ((= k call-stop))
+ (outa k (* (env call-ampf)
+ (polywave gen1 (env call-frqf))))))
+
+ (mus-reset call-ampf)
+ (mus-reset call-frqf)
+ (if (= call 0)
+ (set! next-call (+ start (seconds->samples 0.35)))
+ (if (= call 1)
+ (begin
+ (set! next-call (+ next-call (seconds->samples (- 0.63 0.35))))
+ (set! call-samps (seconds->samples call2-dur))
+ (set! call-ampf call2-ampf)
+ (set! call-frqf call2-frqf))
+ (set! next-call (+ next-call (seconds->samples 0.24)))))
+ (set! call (+ call 1)))))))
;; (with-sound (:play #t) (cardinal 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Black phoebe
-(definstrument (black-phoebe beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.36)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.082 0.899 0.098 0.957 0.118 0.892 0.142 0.396
- 0.181 0.000 0.287 0.000 0.367 0.661 0.396 0.000 0.440 0.778
- 0.458 0.739 0.479 0.300 0.507 0.636 0.532 0.558 0.555 0.380
- 0.588 0.535 0.807 0.325 0.926 0.181 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .9 2 .1 3 .006)))
- (frqf (make-env '(0.000 0.167 0.066 0.212 0.077 0.234 0.104 0.231 0.132 0.187
- 0.148 0.181 0.166 0.153 0.231 0.146 0.289 0.101 0.298 0.196
- 0.319 0.229 0.339 0.222 0.349 0.240 0.357 0.219 0.377 0.159
- 0.388 0.146 0.401 0.167 0.417 0.199 0.438 0.209 0.456 0.202
- 0.467 0.177 0.479 0.174 0.485 0.196 0.503 0.206 0.531 0.201
- 0.550 0.176 0.563 0.194 0.602 0.196 0.622 0.186 0.658 0.192
- 0.931 0.163 1.000 0.141)
- :duration dur :scaler (hz->radians 22050.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (black-phoebe beg amp)
+ (let ((dur 0.36))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.082 0.899 0.098 0.957 0.118 0.892 0.142 0.396
+ 0.181 0.000 0.287 0.000 0.367 0.661 0.396 0.000 0.440 0.778
+ 0.458 0.739 0.479 0.300 0.507 0.636 0.532 0.558 0.555 0.380
+ 0.588 0.535 0.807 0.325 0.926 0.181 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .9 2 .1 3 .006)))
+ (frqf (make-env '(0.000 0.167 0.066 0.212 0.077 0.234 0.104 0.231 0.132 0.187
+ 0.148 0.181 0.166 0.153 0.231 0.146 0.289 0.101 0.298 0.196
+ 0.319 0.229 0.339 0.222 0.349 0.240 0.357 0.219 0.377 0.159
+ 0.388 0.146 0.401 0.167 0.417 0.199 0.438 0.209 0.456 0.202
+ 0.467 0.177 0.479 0.174 0.485 0.196 0.503 0.206 0.531 0.201
+ 0.550 0.176 0.563 0.194 0.602 0.196 0.622 0.186 0.658 0.192
+ 0.931 0.163 1.000 0.141)
+ :duration dur :scaler (hz->radians 22050.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (black-phoebe 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Yellow warbler
-(definstrument (yellow-warbler beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.38)
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil))
-
- (ampf (make-env '(0.000 0.000 0.028 0.077 0.056 0.000 0.135 0.000 0.156 0.125 0.182 0.112 0.197 0.000
- 0.268 0.000 0.287 0.235 0.314 0.243 0.326 0.000 0.406 0.000 0.415 0.339 0.440 0.301 0.463 0.000
- 0.486 0.000 0.499 0.403 0.513 0.611 0.531 0.592 0.553 0.000
- 0.582 0.000 0.596 0.517 0.606 0.648 0.627 0.621 0.640 0.000 0.667 0.000 0.673 0.533 0.696 0.896 0.720 0.000
- 0.750 0.000 0.774 1.000 0.800 0.000 0.831 0.000 0.858 0.971 0.884 0.000
- 0.905 0.000 0.926 0.349 0.942 0.424 0.978 0.421 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.827 0.026 0.661 0.042 0.706 0.104 0.695 0.134 0.909 0.167 0.672 0.184 0.708
- 0.229 0.677 0.271 0.909 0.292 0.715 0.303 0.670 0.310 0.713 0.342 0.674 0.396 0.911
- 0.418 0.715 0.425 0.672 0.441 0.727 0.480 0.720 0.487 0.476 0.491 0.533 0.510 0.558
- 0.526 0.704 0.539 0.765 0.563 0.754 0.578 0.472 0.582 0.526 0.594 0.540 0.618 0.720
- 0.630 0.781 0.656 0.765 0.674 0.683 0.693 0.567 0.713 0.408 0.735 0.410 0.751 0.711
- 0.765 0.654 0.795 0.358 0.817 0.355 0.826 0.708 0.839 0.681 0.854 0.565 0.881 0.330
- 0.904 0.308 0.924 0.351 0.957 0.460 0.967 0.408 0.976 0.362 1.000 0.314)
- :duration dur :scaler (hz->radians 10000.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (env frqf))))))))
+(defanimal (yellow-warbler beg amp)
+ (let ((dur 1.38))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-oscil))
+
+ (ampf (make-env '(0.000 0.000 0.028 0.077 0.056 0.000 0.135 0.000 0.156 0.125 0.182 0.112 0.197 0.000
+ 0.268 0.000 0.287 0.235 0.314 0.243 0.326 0.000 0.406 0.000 0.415 0.339 0.440 0.301 0.463 0.000
+ 0.486 0.000 0.499 0.403 0.513 0.611 0.531 0.592 0.553 0.000
+ 0.582 0.000 0.596 0.517 0.606 0.648 0.627 0.621 0.640 0.000 0.667 0.000 0.673 0.533 0.696 0.896 0.720 0.000
+ 0.750 0.000 0.774 1.000 0.800 0.000 0.831 0.000 0.858 0.971 0.884 0.000
+ 0.905 0.000 0.926 0.349 0.942 0.424 0.978 0.421 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.827 0.026 0.661 0.042 0.706 0.104 0.695 0.134 0.909 0.167 0.672 0.184 0.708
+ 0.229 0.677 0.271 0.909 0.292 0.715 0.303 0.670 0.310 0.713 0.342 0.674 0.396 0.911
+ 0.418 0.715 0.425 0.672 0.441 0.727 0.480 0.720 0.487 0.476 0.491 0.533 0.510 0.558
+ 0.526 0.704 0.539 0.765 0.563 0.754 0.578 0.472 0.582 0.526 0.594 0.540 0.618 0.720
+ 0.630 0.781 0.656 0.765 0.674 0.683 0.693 0.567 0.713 0.408 0.735 0.410 0.751 0.711
+ 0.765 0.654 0.795 0.358 0.817 0.355 0.826 0.708 0.839 0.681 0.854 0.565 0.881 0.330
+ 0.904 0.308 0.924 0.351 0.957 0.460 0.967 0.408 0.976 0.362 1.000 0.314)
+ :duration dur :scaler (hz->radians 10000.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (env frqf))))))))
;; (with-sound (:play #t) (yellow-warbler 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Barred owl (the "hoo-aw" call, not the more complex one -- I haven't succeeded with the latter yet)
-(definstrument (barred-owl-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.27)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.030 0.308 0.052 0.345 0.057 0.932 0.104 0.567 0.161 0.605 0.259 0.510
- 0.299 0.399 0.371 0.535 0.396 0.463 0.472 0.678 0.495 1.000 0.517 0.995
- 0.534 0.000 0.538 0.365 0.560 0.435 0.630 0.254 0.828 0.338 0.850 0.190
- 0.897 0.154 0.929 0.079 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.09 0.025 0.09 0.092 0.156 0.435 0.149 0.491 0.132 0.517 0.124
- 0.53 .124 0.536 0.088 0.830 0.061 1.000 0.013)
- :base .03 :duration dur :scaler (hz->radians 4060.0)))
-
- (gen1 (make-nrcos 0.0 9 .5))
- (vib (make-oscil 12))
- (rnd (make-rand-interp 300 (hz->radians 5)))
- (intrpf (make-env '(0 0 .53 0 .54 1 1 1) :duration dur))
- (rnd1 (make-rand-interp 1000 .1))
-
- (frm1 (make-formant 730 .995))
- (frm2 (make-formant 1090 .999))
- (frm3 (make-formant 2240 .993))
-
- (fr1 (* 2 15 (sin (hz->radians 730))))
- (fr2 (* 2 (sin (hz->radians 1090))))
- (fr3 (* 2 (sin (hz->radians 2240)))))
-
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((intrp (env intrpf))
- (frq (+ (env frqf)
- (* intrp (+ (* (hz->radians 7) (oscil vib))
- (rand-interp rnd)))))
- (inp (* (env ampf)
- (+ .9 (rand-interp rnd1))
- (nrcos gen1 frq))))
- (set! (mus-frequency frm1) (+ 550 (* intrp 80)))
- (set! (mus-frequency frm2) (- 1500 (* intrp 400)))
- (set! (mus-frequency frm3) (+ 2300 (* intrp 150)))
- (outa i (+ (* fr1 (formant frm1 inp))
- (* fr2 (formant frm2 inp))
- (* fr3 (formant frm3 inp)))))))))
+(defanimal (barred-owl-1 beg amp)
+ (let ((dur 1.27)
+ (owl-env '(0 0 .53 0 .54 1 1 1)))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.030 0.308 0.052 0.345 0.057 0.932 0.104 0.567 0.161 0.605 0.259 0.510
+ 0.299 0.399 0.371 0.535 0.396 0.463 0.472 0.678 0.495 1.000 0.517 0.995
+ 0.534 0.000 0.538 0.365 0.560 0.435 0.630 0.254 0.828 0.338 0.850 0.190
+ 0.897 0.154 0.929 0.079 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.09 0.025 0.09 0.092 0.156 0.435 0.149 0.491 0.132 0.517 0.124
+ 0.53 .124 0.536 0.088 0.830 0.061 1.000 0.013)
+ :base .03 :duration dur :scaler (hz->radians 4060.0)))
+
+ (gen1 (make-polywave 0.0 (nrcos->polywave 9 .5 1.0)))
+ (rnd (make-rand-interp 300 (hz->radians 5)))
+ (intrpf (make-env owl-env :duration dur))
+ (intrpf1 (make-env owl-env :offset (hz->radians 550.0) :scaler (hz->radians 80.0) :duration dur))
+ (intrpf2 (make-env owl-env :offset (hz->radians 1500.0) :scaler (hz->radians -400.0) :duration dur))
+ (intrpf3 (make-env owl-env :offset (hz->radians 2300.0) :scaler (hz->radians 150.0) :duration dur))
+ (rnd1 (make-rand-interp 1000 .1))
+
+ (frm1 (make-formant 730 .995))
+ (frm2 (make-formant 1090 .999))
+ (frm3 (make-formant 2240 .993))
+
+ (fr1 (* 2 15 (sin (hz->radians 730))))
+ (fr2 (* 2 (sin (hz->radians 1090))))
+ (fr3 (* 2 (sin (hz->radians 2240))))
+ (vib (make-polywave 12.0 (list 1 (hz->radians 7.0)))))
+
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((val (* (+ .9 (rand-interp rnd1))
+ (polywave gen1 (+ (env frqf)
+ (* (env intrpf) (+ (polywave vib)
+ (rand-interp rnd))))))))
+ (outa i (* (env ampf)
+ (+ (* fr1 (formant frm1 val (env intrpf1)))
+ (* fr2 (formant frm2 val (env intrpf2)))
+ (* fr3 (formant frm3 val (env intrpf3)))))))))))
+
+;; (with-sound (:play #t :statistics #t) (barred-owl-1 0 .5))
-;; (with-sound (:play #t) (barred-owl-1 0 .5))
;;; --------------------------------------------------------------------------------
;;;
;;; Say's phoebe
-(definstrument (says-phoebe beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.64)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.017 0.223 0.039 0.372 0.056 0.000 0.101 0.000 0.122 0.132
- 0.145 0.000 0.192 0.000 0.214 0.639 0.232 0.507 0.324 0.981 0.415 0.402
- 0.496 0.413 0.610 0.317 0.771 0.287 0.970 0.179 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .98 2 .07 3 .08 4 .01 5 .003)))
- (frqf (make-env '(0.000 0.221 0.022 0.305 0.032 0.318 0.040 0.297 0.054 0.225 0.106 0.229
- 0.111 0.250 0.130 0.240 0.139 0.215 0.196 0.238 0.205 0.274 0.223 0.322
- 0.249 0.337 0.295 0.333 0.324 0.310 0.356 0.293 0.584 0.265 0.781 0.261
- 0.958 0.250 1.000 0.204)
- :duration dur :scaler (hz->radians 10040.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (says-phoebe beg amp)
+ (let ((dur 0.64))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.017 0.223 0.039 0.372 0.056 0.000 0.101 0.000 0.122 0.132
+ 0.145 0.000 0.192 0.000 0.214 0.639 0.232 0.507 0.324 0.981 0.415 0.402
+ 0.496 0.413 0.610 0.317 0.771 0.287 0.970 0.179 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .07 3 .08 4 .01 5 .003)))
+ (frqf (make-env '(0.000 0.221 0.022 0.305 0.032 0.318 0.040 0.297 0.054 0.225 0.106 0.229
+ 0.111 0.250 0.130 0.240 0.139 0.215 0.196 0.238 0.205 0.274 0.223 0.322
+ 0.249 0.337 0.295 0.333 0.324 0.310 0.356 0.293 0.584 0.265 0.781 0.261
+ 0.958 0.250 1.000 0.204)
+ :duration dur :scaler (hz->radians 10040.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (says-phoebe 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Yellow-rumped warbler
-(definstrument (yellow-rumped-warbler beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.6)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.009 0.038 0.022 0.220 0.028 0.000 0.037 0.152 0.048 0.000 0.079 0.000
- 0.088 0.218 0.094 0.000 0.109 0.132 0.122 0.488 0.127 0.363 0.128 0.000 0.133 0.303
- 0.141 0.381 0.147 0.000 0.178 0.000 0.196 0.296 0.201 0.000 0.216 0.432 0.227 0.515
- 0.231 0.000 0.242 0.601 0.250 0.000 0.269 0.000 0.290 0.187 0.298 0.040 0.305 0.227
- 0.311 0.000 0.316 0.486 0.327 0.579 0.331 0.000 0.336 0.407 0.343 0.459 0.345 0.000
- 0.371 0.000 0.376 0.085 0.386 0.122 0.393 0.399 0.397 0.000 0.405 0.194 0.412 0.045
- 0.419 0.470 0.428 0.505 0.431 0.000 0.444 0.630 0.446 0.100 0.458 0.000 0.474 0.000
- 0.477 0.114 0.488 0.169 0.496 0.412 0.500 0.000 0.505 0.207 0.509 0.100 0.516 0.265
- 0.524 0.748 0.530 0.599 0.537 0.000 0.541 0.613 0.545 0.819 0.551 0.000 0.577 0.000
- 0.584 0.151 0.591 0.200 0.601 0.577 0.607 0.004 0.610 0.319 0.614 0.111 0.618 0.283
- 0.621 0.132 0.626 0.993 0.637 0.924 0.642 0.000 0.644 0.621 0.652 0.855 0.655 0.000
- 0.681 0.000 0.687 0.156 0.696 0.214 0.706 0.613 0.709 0.000 0.711 0.187 0.719 0.120
- 0.726 0.902 0.733 0.494 0.737 0.955 0.749 0.000 0.753 0.673 0.768 0.000 0.784 0.000
- 0.810 0.768 0.821 0.227 0.829 0.000 0.849 0.592 0.855 0.281 0.863 0.000 0.874 0.354
- 0.875 0.000 0.901 0.000 0.913 0.430 0.931 0.517 0.941 0.000 0.948 0.000 0.965 0.454
- 0.971 0.169 0.975 0.120 0.987 0.225 0.993 0.045 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .99 2 .01 3 .005)))
- (frqf (make-env '(0.000 0.371 0.017 0.571 0.030 0.491 0.035 0.397 0.037 0.321 0.043 0.466 0.047 0.438
- 0.052 0.387 0.087 0.344 0.095 0.417 0.102 0.290 0.106 0.458 0.108 0.507 0.117 0.542
- 0.122 0.513 0.131 0.446 0.135 0.384 0.136 0.323 0.145 0.446 0.150 0.407 0.151 0.356
- 0.185 0.403 0.189 0.442 0.190 0.337 0.201 0.440 0.205 0.294 0.212 0.483 0.218 0.536
- 0.224 0.515 0.234 0.434 0.235 0.317 0.243 0.446 0.248 0.436 0.252 0.309 0.279 0.352
- 0.286 0.438 0.290 0.405 0.291 0.356 0.298 0.425 0.302 0.307 0.307 0.468 0.311 0.530
- 0.318 0.530 0.330 0.436 0.335 0.350 0.340 0.429 0.343 0.458 0.345 0.436 0.350 0.382
- 0.377 0.389 0.381 0.434 0.386 0.350 0.397 0.446 0.403 0.331 0.408 0.495 0.411 0.517
- 0.417 0.526 0.428 0.458 0.431 0.417 0.434 0.348 0.441 0.476 0.449 0.401 0.479 0.362
- 0.485 0.431 0.490 0.354 0.499 0.438 0.502 0.342 0.509 0.515 0.513 0.540 0.521 0.515
- 0.529 0.456 0.536 0.366 0.541 0.479 0.551 0.374 0.582 0.370 0.588 0.440 0.591 0.348
- 0.601 0.421 0.605 0.356 0.611 0.515 0.616 0.532 0.623 0.517 0.636 0.425 0.638 0.339
- 0.644 0.464 0.650 0.438 0.654 0.395 0.655 0.344 0.680 0.368 0.688 0.425 0.692 0.356
- 0.702 0.421 0.706 0.344 0.710 0.497 0.718 0.509 0.727 0.476 0.740 0.397 0.743 0.470
- 0.747 0.534 0.754 0.497 0.760 0.446 0.788 0.499 0.793 0.528 0.796 0.448 0.814 0.507
- 0.816 0.374 0.826 0.352 0.835 0.360 0.839 0.389 0.846 0.438 0.851 0.337 0.862 0.333
- 0.868 0.395 0.900 0.485 0.907 0.489 0.909 0.431 0.922 0.452 0.926 0.485 0.934 0.317
- 0.943 0.350 0.954 0.352 0.961 0.423 0.965 0.325 0.974 0.317 0.983 0.376 0.985 0.436 1.000 0.454)
- :duration dur :scaler (hz->radians 10125.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (yellow-rumped-warbler beg amp)
+ (let ((dur 1.6))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.009 0.038 0.022 0.220 0.028 0.000 0.037 0.152 0.048 0.000 0.079 0.000
+ 0.088 0.218 0.094 0.000 0.109 0.132 0.122 0.488 0.127 0.363 0.128 0.000 0.133 0.303
+ 0.141 0.381 0.147 0.000 0.178 0.000 0.196 0.296 0.201 0.000 0.216 0.432 0.227 0.515
+ 0.231 0.000 0.242 0.601 0.250 0.000 0.269 0.000 0.290 0.187 0.298 0.040 0.305 0.227
+ 0.311 0.000 0.316 0.486 0.327 0.579 0.331 0.000 0.336 0.407 0.343 0.459 0.345 0.000
+ 0.371 0.000 0.376 0.085 0.386 0.122 0.393 0.399 0.397 0.000 0.405 0.194 0.412 0.045
+ 0.419 0.470 0.428 0.505 0.431 0.000 0.444 0.630 0.446 0.100 0.458 0.000 0.474 0.000
+ 0.477 0.114 0.488 0.169 0.496 0.412 0.500 0.000 0.505 0.207 0.509 0.100 0.516 0.265
+ 0.524 0.748 0.530 0.599 0.537 0.000 0.541 0.613 0.545 0.819 0.551 0.000 0.577 0.000
+ 0.584 0.151 0.591 0.200 0.601 0.577 0.607 0.004 0.610 0.319 0.614 0.111 0.618 0.283
+ 0.621 0.132 0.626 0.993 0.637 0.924 0.642 0.000 0.644 0.621 0.652 0.855 0.655 0.000
+ 0.681 0.000 0.687 0.156 0.696 0.214 0.706 0.613 0.709 0.000 0.711 0.187 0.719 0.120
+ 0.726 0.902 0.733 0.494 0.737 0.955 0.749 0.000 0.753 0.673 0.768 0.000 0.784 0.000
+ 0.810 0.768 0.821 0.227 0.829 0.000 0.849 0.592 0.855 0.281 0.863 0.000 0.874 0.354
+ 0.875 0.000 0.901 0.000 0.913 0.430 0.931 0.517 0.941 0.000 0.948 0.000 0.965 0.454
+ 0.971 0.169 0.975 0.120 0.987 0.225 0.993 0.045 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01 3 .005)))
+ (frqf (make-env '(0.000 0.371 0.017 0.571 0.030 0.491 0.035 0.397 0.037 0.321 0.043 0.466 0.047 0.438
+ 0.052 0.387 0.087 0.344 0.095 0.417 0.102 0.290 0.106 0.458 0.108 0.507 0.117 0.542
+ 0.122 0.513 0.131 0.446 0.135 0.384 0.136 0.323 0.145 0.446 0.150 0.407 0.151 0.356
+ 0.185 0.403 0.189 0.442 0.190 0.337 0.201 0.440 0.205 0.294 0.212 0.483 0.218 0.536
+ 0.224 0.515 0.234 0.434 0.235 0.317 0.243 0.446 0.248 0.436 0.252 0.309 0.279 0.352
+ 0.286 0.438 0.290 0.405 0.291 0.356 0.298 0.425 0.302 0.307 0.307 0.468 0.311 0.530
+ 0.318 0.530 0.330 0.436 0.335 0.350 0.340 0.429 0.343 0.458 0.345 0.436 0.350 0.382
+ 0.377 0.389 0.381 0.434 0.386 0.350 0.397 0.446 0.403 0.331 0.408 0.495 0.411 0.517
+ 0.417 0.526 0.428 0.458 0.431 0.417 0.434 0.348 0.441 0.476 0.449 0.401 0.479 0.362
+ 0.485 0.431 0.490 0.354 0.499 0.438 0.502 0.342 0.509 0.515 0.513 0.540 0.521 0.515
+ 0.529 0.456 0.536 0.366 0.541 0.479 0.551 0.374 0.582 0.370 0.588 0.440 0.591 0.348
+ 0.601 0.421 0.605 0.356 0.611 0.515 0.616 0.532 0.623 0.517 0.636 0.425 0.638 0.339
+ 0.644 0.464 0.650 0.438 0.654 0.395 0.655 0.344 0.680 0.368 0.688 0.425 0.692 0.356
+ 0.702 0.421 0.706 0.344 0.710 0.497 0.718 0.509 0.727 0.476 0.740 0.397 0.743 0.470
+ 0.747 0.534 0.754 0.497 0.760 0.446 0.788 0.499 0.793 0.528 0.796 0.448 0.814 0.507
+ 0.816 0.374 0.826 0.352 0.835 0.360 0.839 0.389 0.846 0.438 0.851 0.337 0.862 0.333
+ 0.868 0.395 0.900 0.485 0.907 0.489 0.909 0.431 0.922 0.452 0.926 0.485 0.934 0.317
+ 0.943 0.350 0.954 0.352 0.961 0.423 0.965 0.325 0.974 0.317 0.983 0.376 0.985 0.436 1.000 0.454)
+ :duration dur :scaler (hz->radians 10125.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (yellow-rumped-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Purple finch
-(definstrument (purple-finch beg amp)
- (let* ((start (seconds->samples beg))
- (dur 2.5)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.0000 0.0000 0.0150 0.0420 0.0210 0.0018 0.0291 0.0804 0.0355 0.1682 0.0402 0.0658
- 0.0428 0.2468 0.0449 0.0676 0.0505 0.1243 0.0522 0.0000 0.0651 0.0000 0.0702 0.1298
- 0.0741 0.0841 0.0766 0.1590 0.0848 0.0000 0.0890 0.0530 0.0950 0.2724 0.1006 0.2249
- 0.1032 0.1499 0.1057 0.3784 0.1104 0.2578 0.1143 0.0000 0.1259 0.0000 0.1284 0.1901
- 0.1323 0.1079 0.1361 0.2358 0.1417 0.0000 0.1468 0.0000 0.1507 0.2486 0.1558 0.2888
- 0.1614 0.1207 0.1648 0.5503 0.1678 0.2267 0.1691 0.3693 0.1717 0.0000 0.1858 0.0000
- 0.1896 0.1938 0.1931 0.0859 0.1952 0.2267 0.2016 0.0000 0.2063 0.0420 0.2149 0.4771
- 0.2188 0.4004 0.2209 0.1865 0.2256 0.6399 0.2265 0.2596 0.2295 0.4644 0.2354 0.0000
- 0.2436 0.0000 0.2491 0.2431 0.2513 0.1718 0.2568 0.3528 0.2616 0.0000 0.2748 0.0640
- 0.2868 0.4388 0.2967 0.4954 0.3018 0.0000 0.3215 0.0000 0.3318 0.1865 0.3339 0.1097
- 0.3412 0.7697 0.3438 0.3857 0.3450 0.7770 0.3472 0.4260 0.3485 0.7843 0.3502 0.3565
- 0.3528 0.7751 0.3566 0.0000 0.3669 0.0000 0.3716 0.5686 0.3737 0.2303 0.3776 0.9854
- 0.3801 0.3108 0.3840 0.3309 0.3857 0.5960 0.3908 0.1207 0.3934 0.5759 0.4003 0.0000
- 0.4127 0.0000 0.4199 0.2176 0.4234 0.1152 0.4272 0.5850 0.4281 0.2980 0.4324 0.5009
- 0.4345 0.3693 0.4379 0.4241 0.4405 0.2943 0.4452 0.5046 0.4533 0.1408 0.4568 0.5795
- 0.4606 0.0000 0.4735 0.0000 0.4837 0.8501 0.4842 0.6088 0.4880 0.7093 0.4893 0.6581
- 0.4923 0.9049 0.4953 0.1828 0.4974 0.7770 0.5009 0.0859 0.5060 0.8537 0.5132 0.0000
- 0.5256 0.0000 0.5321 0.7477 0.5368 0.3364 0.5420 0.6527 0.5454 0.2834 0.5488 0.2212
- 0.5518 0.0512 0.5552 0.6691 0.5634 0.0000 0.5766 0.0000 0.5775 0.3364 0.5809 0.0000
- 0.5826 0.4826 0.5860 0.0037 0.5920 0.6362 0.5963 0.5448 0.5967 0.6600 0.5993 0.5759
- 0.6002 0.6289 0.6040 0.5503 0.6100 0.9360 0.6160 0.0000 0.6271 0.0000 0.6280 0.3583
- 0.6322 0.0000 0.6327 0.4388 0.6366 0.0000 0.6430 0.7733 0.6468 0.6088 0.6481 0.7532
- 0.6528 0.7166 0.6541 0.4899 0.6563 0.8355 0.6648 0.0000 0.6777 0.0000 0.6781 0.2523
- 0.6817 0.0000 0.6832 0.2943 0.6870 0.0000 0.6952 0.5850 0.7033 0.4095 0.7098 0.6728
- 0.7145 0.0000 0.7286 0.0000 0.7295 0.1609 0.7334 0.0000 0.7359 0.3382 0.7380 0.0000
- 0.7483 0.4845 0.7539 0.5814 0.7624 0.0000 0.7748 0.0000 0.7783 0.2633 0.7811 0.0000
- 0.7825 0.2541 0.7869 0.0000 0.7958 0.4717 0.8031 0.5393 0.8116 0.0000 0.8271 0.0000
- 0.8288 0.2431 0.8315 0.0000 0.8339 0.0000 0.8399 0.2687 0.8433 0.1700 0.8446 0.3967
- 0.8506 0.4826 0.8600 0.0000 0.8754 0.0000 0.8767 0.1207 0.8796 0.0000 0.8818 0.2377
- 0.8844 0.0000 0.8951 0.3528 0.9114 0.0000 0.9255 0.0000 0.9285 0.1024 0.9322 0.0000
- 0.9336 0.1737 0.9388 0.0000 0.9439 0.0859 0.9482 0.2431 0.9521 0.1024 0.9546 0.2761
- 0.9636 0.0000 0.9850 0.0000 0.9927 0.0402 1.0000 0.0000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .005 4 .003)))
- (rnd (make-rand-interp 800 (hz->radians 200)))
- (frqf (make-env '(0.0000 0.2374 0.0125 0.1869 0.0192 0.1616 0.0250 0.1835 0.0370 0.3316 0.0388 0.2407
- 0.0419 0.3013 0.0450 0.2003 0.0473 0.2694 0.0513 0.2155 0.0646 0.2003 0.0727 0.2761
- 0.0728 0.2020 0.0798 0.2559 0.0852 0.1751 0.0936 0.2424 0.0994 0.3535 0.1025 0.2424
- 0.1048 0.3030 0.1074 0.2138 0.1110 0.2576 0.1271 0.2290 0.1315 0.2037 0.1355 0.2374
- 0.1404 0.3451 0.1453 0.1684 0.1587 0.3350 0.1605 0.2542 0.1632 0.3131 0.1658 0.2525
- 0.1690 0.2744 0.1868 0.2239 0.1935 0.3249 0.1979 0.2357 0.2069 0.1835 0.2167 0.3316
- 0.2207 0.2559 0.2225 0.3199 0.2269 0.2273 0.2300 0.2795 0.2341 0.2290 0.2461 0.2222
- 0.2479 0.2559 0.2514 0.2138 0.2555 0.2576 0.2595 0.2020 0.2662 0.1667 0.2853 0.2458
- 0.2951 0.2778 0.3027 0.2256 0.3255 0.2306 0.3290 0.1902 0.3388 0.2811 0.3433 0.3232
- 0.3455 0.2424 0.3486 0.3754 0.3513 0.2155 0.3522 0.3333 0.3549 0.2879 0.3691 0.3519
- 0.3749 0.2710 0.3785 0.3384 0.3807 0.2811 0.3848 0.2576 0.3870 0.3064 0.3923 0.2492
- 0.3941 0.2997 0.3968 0.2744 0.4155 0.1852 0.4222 0.2357 0.4289 0.2845 0.4391 0.2845
- 0.4463 0.2795 0.4525 0.2340 0.4579 0.2980 0.4610 0.2138 0.4753 0.2980 0.4819 0.3249
- 0.4864 0.3636 0.4900 0.4040 0.4931 0.3468 0.4962 0.2795 0.4993 0.3535 0.5029 0.2542
- 0.5051 0.3788 0.5087 0.3114 0.5127 0.2811 0.5145 0.2189 0.5310 0.3519 0.5372 0.2811
- 0.5408 0.3603 0.5439 0.2862 0.5515 0.2441 0.5582 0.2997 0.5631 0.2239 0.5778 0.3131
- 0.5809 0.5017 0.5863 0.3266 0.5934 0.3990 0.5961 0.3064 0.6054 0.3603 0.6135 0.2761
- 0.6291 0.3215 0.6349 0.5051 0.6371 0.2997 0.6433 0.3822 0.6469 0.3232 0.6540 0.3451
- 0.6603 0.2929 0.6643 0.2458 0.6799 0.3114 0.6830 0.4983 0.6906 0.2424 0.6973 0.3098
- 0.7044 0.3485 0.7107 0.3165 0.7156 0.2593 0.7321 0.3249 0.7356 0.5286 0.7445 0.2138
- 0.7477 0.3030 0.7543 0.3064 0.7633 0.2256 0.7793 0.2761 0.7864 0.5034 0.7900 0.2189
- 0.7954 0.2205 0.7967 0.2778 0.8038 0.3182 0.8123 0.1734 0.8292 0.2290 0.8324 0.4293
- 0.8377 0.2155 0.8444 0.2121 0.8471 0.2929 0.8533 0.2963 0.8613 0.2037 0.8823 0.2391
- 0.8850 0.4478 0.8903 0.1886 0.8939 0.2256 0.8979 0.2946 0.9015 0.3131 0.9104 0.2088
- 0.9309 0.2172 0.9358 0.5556 0.9403 0.2172 0.9456 0.2290 0.9563 0.3215 0.9666 0.2104
- 0.9924 0.1785 1.0000 0.1801)
- :duration dur :scaler (hz->radians 10035.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp rnd)))))))))
+(defanimal (purple-finch beg amp)
+ (let ((dur 2.5))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.0000 0.0000 0.0150 0.0420 0.0210 0.0018 0.0291 0.0804 0.0355 0.1682 0.0402 0.0658
+ 0.0428 0.2468 0.0449 0.0676 0.0505 0.1243 0.0522 0.0000 0.0651 0.0000 0.0702 0.1298
+ 0.0741 0.0841 0.0766 0.1590 0.0848 0.0000 0.0890 0.0530 0.0950 0.2724 0.1006 0.2249
+ 0.1032 0.1499 0.1057 0.3784 0.1104 0.2578 0.1143 0.0000 0.1259 0.0000 0.1284 0.1901
+ 0.1323 0.1079 0.1361 0.2358 0.1417 0.0000 0.1468 0.0000 0.1507 0.2486 0.1558 0.2888
+ 0.1614 0.1207 0.1648 0.5503 0.1678 0.2267 0.1691 0.3693 0.1717 0.0000 0.1858 0.0000
+ 0.1896 0.1938 0.1931 0.0859 0.1952 0.2267 0.2016 0.0000 0.2063 0.0420 0.2149 0.4771
+ 0.2188 0.4004 0.2209 0.1865 0.2256 0.6399 0.2265 0.2596 0.2295 0.4644 0.2354 0.0000
+ 0.2436 0.0000 0.2491 0.2431 0.2513 0.1718 0.2568 0.3528 0.2616 0.0000 0.2748 0.0640
+ 0.2868 0.4388 0.2967 0.4954 0.3018 0.0000 0.3215 0.0000 0.3318 0.1865 0.3339 0.1097
+ 0.3412 0.7697 0.3438 0.3857 0.3450 0.7770 0.3472 0.4260 0.3485 0.7843 0.3502 0.3565
+ 0.3528 0.7751 0.3566 0.0000 0.3669 0.0000 0.3716 0.5686 0.3737 0.2303 0.3776 0.9854
+ 0.3801 0.3108 0.3840 0.3309 0.3857 0.5960 0.3908 0.1207 0.3934 0.5759 0.4003 0.0000
+ 0.4127 0.0000 0.4199 0.2176 0.4234 0.1152 0.4272 0.5850 0.4281 0.2980 0.4324 0.5009
+ 0.4345 0.3693 0.4379 0.4241 0.4405 0.2943 0.4452 0.5046 0.4533 0.1408 0.4568 0.5795
+ 0.4606 0.0000 0.4735 0.0000 0.4837 0.8501 0.4842 0.6088 0.4880 0.7093 0.4893 0.6581
+ 0.4923 0.9049 0.4953 0.1828 0.4974 0.7770 0.5009 0.0859 0.5060 0.8537 0.5132 0.0000
+ 0.5256 0.0000 0.5321 0.7477 0.5368 0.3364 0.5420 0.6527 0.5454 0.2834 0.5488 0.2212
+ 0.5518 0.0512 0.5552 0.6691 0.5634 0.0000 0.5766 0.0000 0.5775 0.3364 0.5809 0.0000
+ 0.5826 0.4826 0.5860 0.0037 0.5920 0.6362 0.5963 0.5448 0.5967 0.6600 0.5993 0.5759
+ 0.6002 0.6289 0.6040 0.5503 0.6100 0.9360 0.6160 0.0000 0.6271 0.0000 0.6280 0.3583
+ 0.6322 0.0000 0.6327 0.4388 0.6366 0.0000 0.6430 0.7733 0.6468 0.6088 0.6481 0.7532
+ 0.6528 0.7166 0.6541 0.4899 0.6563 0.8355 0.6648 0.0000 0.6777 0.0000 0.6781 0.2523
+ 0.6817 0.0000 0.6832 0.2943 0.6870 0.0000 0.6952 0.5850 0.7033 0.4095 0.7098 0.6728
+ 0.7145 0.0000 0.7286 0.0000 0.7295 0.1609 0.7334 0.0000 0.7359 0.3382 0.7380 0.0000
+ 0.7483 0.4845 0.7539 0.5814 0.7624 0.0000 0.7748 0.0000 0.7783 0.2633 0.7811 0.0000
+ 0.7825 0.2541 0.7869 0.0000 0.7958 0.4717 0.8031 0.5393 0.8116 0.0000 0.8271 0.0000
+ 0.8288 0.2431 0.8315 0.0000 0.8339 0.0000 0.8399 0.2687 0.8433 0.1700 0.8446 0.3967
+ 0.8506 0.4826 0.8600 0.0000 0.8754 0.0000 0.8767 0.1207 0.8796 0.0000 0.8818 0.2377
+ 0.8844 0.0000 0.8951 0.3528 0.9114 0.0000 0.9255 0.0000 0.9285 0.1024 0.9322 0.0000
+ 0.9336 0.1737 0.9388 0.0000 0.9439 0.0859 0.9482 0.2431 0.9521 0.1024 0.9546 0.2761
+ 0.9636 0.0000 0.9850 0.0000 0.9927 0.0402 1.0000 0.0000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .005 4 .003)))
+ (rnd (make-rand-interp 800 (hz->radians 200)))
+ (frqf (make-env '(0.0000 0.2374 0.0125 0.1869 0.0192 0.1616 0.0250 0.1835 0.0370 0.3316 0.0388 0.2407
+ 0.0419 0.3013 0.0450 0.2003 0.0473 0.2694 0.0513 0.2155 0.0646 0.2003 0.0727 0.2761
+ 0.0728 0.2020 0.0798 0.2559 0.0852 0.1751 0.0936 0.2424 0.0994 0.3535 0.1025 0.2424
+ 0.1048 0.3030 0.1074 0.2138 0.1110 0.2576 0.1271 0.2290 0.1315 0.2037 0.1355 0.2374
+ 0.1404 0.3451 0.1453 0.1684 0.1587 0.3350 0.1605 0.2542 0.1632 0.3131 0.1658 0.2525
+ 0.1690 0.2744 0.1868 0.2239 0.1935 0.3249 0.1979 0.2357 0.2069 0.1835 0.2167 0.3316
+ 0.2207 0.2559 0.2225 0.3199 0.2269 0.2273 0.2300 0.2795 0.2341 0.2290 0.2461 0.2222
+ 0.2479 0.2559 0.2514 0.2138 0.2555 0.2576 0.2595 0.2020 0.2662 0.1667 0.2853 0.2458
+ 0.2951 0.2778 0.3027 0.2256 0.3255 0.2306 0.3290 0.1902 0.3388 0.2811 0.3433 0.3232
+ 0.3455 0.2424 0.3486 0.3754 0.3513 0.2155 0.3522 0.3333 0.3549 0.2879 0.3691 0.3519
+ 0.3749 0.2710 0.3785 0.3384 0.3807 0.2811 0.3848 0.2576 0.3870 0.3064 0.3923 0.2492
+ 0.3941 0.2997 0.3968 0.2744 0.4155 0.1852 0.4222 0.2357 0.4289 0.2845 0.4391 0.2845
+ 0.4463 0.2795 0.4525 0.2340 0.4579 0.2980 0.4610 0.2138 0.4753 0.2980 0.4819 0.3249
+ 0.4864 0.3636 0.4900 0.4040 0.4931 0.3468 0.4962 0.2795 0.4993 0.3535 0.5029 0.2542
+ 0.5051 0.3788 0.5087 0.3114 0.5127 0.2811 0.5145 0.2189 0.5310 0.3519 0.5372 0.2811
+ 0.5408 0.3603 0.5439 0.2862 0.5515 0.2441 0.5582 0.2997 0.5631 0.2239 0.5778 0.3131
+ 0.5809 0.5017 0.5863 0.3266 0.5934 0.3990 0.5961 0.3064 0.6054 0.3603 0.6135 0.2761
+ 0.6291 0.3215 0.6349 0.5051 0.6371 0.2997 0.6433 0.3822 0.6469 0.3232 0.6540 0.3451
+ 0.6603 0.2929 0.6643 0.2458 0.6799 0.3114 0.6830 0.4983 0.6906 0.2424 0.6973 0.3098
+ 0.7044 0.3485 0.7107 0.3165 0.7156 0.2593 0.7321 0.3249 0.7356 0.5286 0.7445 0.2138
+ 0.7477 0.3030 0.7543 0.3064 0.7633 0.2256 0.7793 0.2761 0.7864 0.5034 0.7900 0.2189
+ 0.7954 0.2205 0.7967 0.2778 0.8038 0.3182 0.8123 0.1734 0.8292 0.2290 0.8324 0.4293
+ 0.8377 0.2155 0.8444 0.2121 0.8471 0.2929 0.8533 0.2963 0.8613 0.2037 0.8823 0.2391
+ 0.8850 0.4478 0.8903 0.1886 0.8939 0.2256 0.8979 0.2946 0.9015 0.3131 0.9104 0.2088
+ 0.9309 0.2172 0.9358 0.5556 0.9403 0.2172 0.9456 0.2290 0.9563 0.3215 0.9666 0.2104
+ 0.9924 0.1785 1.0000 0.1801)
+ :duration dur :scaler (hz->radians 10035.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd)))))))))
;; (with-sound (:play #t) (purple-finch 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Northern goshawk
-(definstrument (northern-goshawk beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.31)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.124 0.399 0.174 0.520 0.223 0.881 0.355 0.998 0.499 0.644 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .1 2 .8 3 .3 4 .05 5 .01 6 .005 7 .003)))
- (frqf (make-env '(0.000 0.137 0.126 0.138 0.237 0.144 0.314 0.142 0.400 0.140 1.000 0.130)
- :duration dur :scaler (hz->radians 9040.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (northern-goshawk beg amp)
+ (let ((dur 0.31))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.124 0.399 0.174 0.520 0.223 0.881 0.355 0.998 0.499 0.644 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .1 2 .8 3 .3 4 .05 5 .01 6 .005 7 .003)))
+ (frqf (make-env '(0.000 0.137 0.126 0.138 0.237 0.144 0.314 0.142 0.400 0.140 1.000 0.130)
+ :duration dur :scaler (hz->radians 9040.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (northern-goshawk 0 .25))
+
;;;--------------------------------------------------------------------------------
;;;
;;; Common Gull
-(definstrument (common-gull beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.42)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 1.4 1 1.7 .8 1.8 .2 2 0) :duration dur :scaler amp))
- (gen1 (make-rcos 1200 0.5))
- (gen2 (make-rxycos 1800 (/ 1200 1800.0) 0.75))
- (frqf (make-env '(0.000 0.326 0.057 0.599 0.075 0.602 0.102 0.637 0.140 0.618 0.255 0.626 0.378 0.607
- 0.401 0.589 0.441 0.584 0.491 0.562 0.591 0.544 0.628 0.557 0.675 0.541 0.733 0.538
- 0.756 0.523 0.809 0.501 0.853 0.469 0.887 0.390 1.000 0.325)
- :duration dur :offset (hz->radians -1200) :scaler (hz->radians 2000.0)))
- (intrpf (make-env '(0 1 .2 1 .5 0 1 0) :duration dur :scaler .3 :base 10))
- (rnd (make-rand-interp 800 .2))
- (attf (make-env '(0 1 .15 0 1 0) :duration dur :base 10))
-
- (frm1 (make-formant 2300 .99))
- (frm2 (make-formant 6100 .98))
- (frm3 (make-formant 3800 .98))
- (frm4 (make-formant 1800 .99))
-
- (fr1 (* 2 5 (sin (hz->radians 2300))))
- (fr2 (* 2 3 (sin (hz->radians 6100))))
- (fr3 (* 2 5 (sin (hz->radians 3800))))
- (fr4 (* 2 7 (sin (hz->radians 1800))))
-
- (rnd2 (make-rand-interp 300 (hz->radians 15))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (+ (env frqf)
- (rand-interp rnd2)
- (* (env attf)
- (rand-interp rnd))))
- (val (* (env ampf)
- (+ (rcos gen1 frq)
- (* (env intrpf)
- (rxycos gen2 frq))))))
- (outa i (+ (* fr1 (formant frm1 val))
- (* fr2 (formant frm2 val))
- (* fr3 (formant frm3 val))
- (* fr4 (formant frm4 val)))))))))
+(defanimal (common-gull beg amp)
+ (let ((dur 0.42))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 1.4 1 1.7 .8 1.8 .2 2 0) :duration dur :scaler amp))
+ (gen1 (make-rcos 1200 0.5))
+ (gen2 (make-rxycos 1800 (/ 1200 1800.0) 0.75))
+ (frqf (make-env '(0.000 0.326 0.057 0.599 0.075 0.602 0.102 0.637 0.140 0.618 0.255 0.626 0.378 0.607
+ 0.401 0.589 0.441 0.584 0.491 0.562 0.591 0.544 0.628 0.557 0.675 0.541 0.733 0.538
+ 0.756 0.523 0.809 0.501 0.853 0.469 0.887 0.390 1.000 0.325)
+ :duration dur :offset (hz->radians -1200) :scaler (hz->radians 2000.0)))
+ (intrpf (make-env '(0 1 .2 1 .5 0 1 0) :duration dur :scaler .3 :base 10))
+ (rnd (make-rand-interp 800 .2))
+ (attf (make-env '(0 1 .15 0 1 0) :duration dur :base 10))
+
+ (frm1 (make-formant 2300 .99))
+ (frm2 (make-formant 6100 .98))
+ (frm3 (make-formant 3800 .98))
+ (frm4 (make-formant 1800 .99))
+
+ (fr1 (* 2 5 (sin (hz->radians 2300))))
+ (fr2 (* 2 3 (sin (hz->radians 6100))))
+ (fr3 (* 2 5 (sin (hz->radians 3800))))
+ (fr4 (* 2 7 (sin (hz->radians 1800))))
+
+ (rnd2 (make-rand-interp 300 (hz->radians 15))))
+
+ (let ((fb (vector frm1 frm2 frm3 frm4))
+ (fs (float-vector fr1 fr2 fr3 fr4)))
+ (set! fb (make-formant-bank fb fs))
+
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd2)
+ (* (env attf)
+ (rand-interp rnd)))))
+ (outa i (* (env ampf)
+ (formant-bank fb (+ (rcos gen1 frq)
+ (* (env intrpf)
+ (rxycos gen2 frq))))))))))))
+
+;; (with-sound (:play #t) (common-gull 0 .5))
-;; (with-sound (:play #t :scaled-to .5) (common-gull 0 .5))
;;; --------------------------------------------------------------------------------
;;;
;;; Ash-throated flycatcher
-(definstrument (ash-throated-flycatcher beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.47)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.018 0.176 0.030 0.756 0.041 1.000 0.052 0.916 0.066 0.198 0.097 0.046
- 0.128 0.000 0.165 0.000 0.211 0.141 0.224 0.108 0.244 0.149 0.261 0.105 0.267 0.031
- 0.272 0.218 0.278 0.125 0.302 0.237 0.315 0.510 0.336 0.255 0.346 0.000 0.369 0.000
- 0.386 0.345 0.403 0.246 0.412 0.000 0.481 0.000 0.490 0.084 0.504 0.330 0.514 0.174
- 0.527 0.070 0.531 0.000 0.546 0.000 0.550 0.055 0.556 0.000 0.560 0.000 0.565 0.053
- 0.571 0.000 0.575 0.000 0.580 0.048 0.587 0.000 0.592 0.000 0.597 0.064 0.601 0.000
- 0.605 0.000 0.609 0.084 0.616 0.000 0.620 0.000 0.623 0.086 0.631 0.000 0.636 0.000
- 0.638 0.103 0.644 0.000 0.650 0.000 0.653 0.095 0.657 0.000 0.663 0.000 0.669 0.105
- 0.675 0.000 0.679 0.000 0.683 0.046 0.689 0.000 0.722 0.000 0.727 0.084 0.736 0.312
- 0.741 0.365 0.747 0.314 0.756 0.000 0.819 0.000 0.830 0.086 0.838 0.369 0.845 0.411
- 0.854 0.365 0.861 0.000 0.864 0.092 0.869 0.081 0.873 0.200 0.881 0.336 0.889 0.374
- 0.901 0.033 0.908 0.000 0.913 0.066 0.929 0.310 0.936 0.266 0.940 0.079 0.948 0.000
- 0.967 0.044 0.973 0.101 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .98 2 .02 4 .01)))
- (frqf (make-env '(0.000 0.317 0.013 0.368 0.029 0.464 0.048 0.485 0.062 0.469 0.100 0.310 0.176 0.320
- 0.224 0.389 0.242 0.395 0.270 0.370 0.280 0.492 0.284 0.304 0.292 0.363 0.305 0.411
- 0.322 0.464 0.347 0.306 0.376 0.269 0.386 0.368 0.396 0.398 0.407 0.366 0.415 0.290
- 0.485 0.288 0.520 0.405 0.536 0.315 0.690 0.313 0.728 0.267 0.733 0.350 0.743 0.375
- 0.756 0.345 0.759 0.281 0.827 0.285 0.834 0.349 0.850 0.375 0.868 0.312 0.878 0.358
- 0.886 0.375 0.897 0.352 0.910 0.297 0.923 0.342 0.932 0.361 0.942 0.342 0.960 0.283
- 0.968 0.327 0.978 0.350 0.989 0.335 1.000 0.290)
- :duration dur :scaler (hz->radians 6070.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (ash-throated-flycatcher beg amp)
+ (let ((dur 0.47))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.018 0.176 0.030 0.756 0.041 1.000 0.052 0.916 0.066 0.198 0.097 0.046
+ 0.128 0.000 0.165 0.000 0.211 0.141 0.224 0.108 0.244 0.149 0.261 0.105 0.267 0.031
+ 0.272 0.218 0.278 0.125 0.302 0.237 0.315 0.510 0.336 0.255 0.346 0.000 0.369 0.000
+ 0.386 0.345 0.403 0.246 0.412 0.000 0.481 0.000 0.490 0.084 0.504 0.330 0.514 0.174
+ 0.527 0.070 0.531 0.000 0.546 0.000 0.550 0.055 0.556 0.000 0.560 0.000 0.565 0.053
+ 0.571 0.000 0.575 0.000 0.580 0.048 0.587 0.000 0.592 0.000 0.597 0.064 0.601 0.000
+ 0.605 0.000 0.609 0.084 0.616 0.000 0.620 0.000 0.623 0.086 0.631 0.000 0.636 0.000
+ 0.638 0.103 0.644 0.000 0.650 0.000 0.653 0.095 0.657 0.000 0.663 0.000 0.669 0.105
+ 0.675 0.000 0.679 0.000 0.683 0.046 0.689 0.000 0.722 0.000 0.727 0.084 0.736 0.312
+ 0.741 0.365 0.747 0.314 0.756 0.000 0.819 0.000 0.830 0.086 0.838 0.369 0.845 0.411
+ 0.854 0.365 0.861 0.000 0.864 0.092 0.869 0.081 0.873 0.200 0.881 0.336 0.889 0.374
+ 0.901 0.033 0.908 0.000 0.913 0.066 0.929 0.310 0.936 0.266 0.940 0.079 0.948 0.000
+ 0.967 0.044 0.973 0.101 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .02 4 .01)))
+ (frqf (make-env '(0.000 0.317 0.013 0.368 0.029 0.464 0.048 0.485 0.062 0.469 0.100 0.310 0.176 0.320
+ 0.224 0.389 0.242 0.395 0.270 0.370 0.280 0.492 0.284 0.304 0.292 0.363 0.305 0.411
+ 0.322 0.464 0.347 0.306 0.376 0.269 0.386 0.368 0.396 0.398 0.407 0.366 0.415 0.290
+ 0.485 0.288 0.520 0.405 0.536 0.315 0.690 0.313 0.728 0.267 0.733 0.350 0.743 0.375
+ 0.756 0.345 0.759 0.281 0.827 0.285 0.834 0.349 0.850 0.375 0.868 0.312 0.878 0.358
+ 0.886 0.375 0.897 0.352 0.910 0.297 0.923 0.342 0.932 0.361 0.942 0.342 0.960 0.283
+ 0.968 0.327 0.978 0.350 0.989 0.335 1.000 0.290)
+ :duration dur :scaler (hz->radians 6070.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (ash-throated-flycatcher 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; White-header woodpecker
-(definstrument (white-headed-woodpecker beg amp)
+(defanimal (white-headed-woodpecker beg amp)
;; spectrum travels right off the top -- I wonder how high it actually goes
- (let* ((start (seconds->samples beg))
- (dur 0.16)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.053 0.952 0.066 0.865 0.079 0.386 0.091 0.937 0.145 0.963 0.182 0.923
- 0.197 0.384 0.221 0.892 0.256 0.751 0.298 0.000 0.410 0.000 0.430 0.915 0.450 0.836
- 0.464 0.307 0.479 0.873 0.496 0.952 0.531 0.886 0.554 0.291 0.575 0.892 0.606 0.717
- 0.654 0.000 0.775 0.000 0.801 0.712 0.814 0.233 0.822 0.712 0.893 0.712 0.923 0.225
- 0.938 0.758 0.959 0.640 1.000 0.000 )
- :duration dur :scaler amp))
- (frqf1 (make-env '(0.000 0.106 0.051 0.119 0.063 0.177 0.087 0.230 0.198 0.228 0.211 0.175 0.236 0.153
- 0.282 0.122 0.427 0.103 0.465 0.156 0.483 0.214 0.542 0.220 0.563 0.159 0.588 0.146
- 0.615 0.095 0.767 0.122 0.8 0.2 0.851 0.2 0.871 0.16 0.903 0.148
- 0.939 0.143 .95 .14)
- :duration dur :scaler (hz->radians (/ 22050.0 3.0))))
- (frqf2 (make-env '(0.000 0.230 0.061 0.262 0.088 0.341 0.152 0.323 0.206 0.341 0.219 0.265 0.237 0.235
- 0.450 0.220 0.459 0.317 0.514 0.302 0.558 0.354 0.605 0.246 0.772 0.246 0.838 0.323
- 0.857 0.278 0.864 0.325 0.914 0.222 .95 .22)
- :duration dur :scaler (hz->radians (/ 22050.0 5.0))))
-
- (gen1 (make-polywave :partials (list 1 .01 2 .1 3 .6 4 .02 6 .4 7 .05 9 .1 10 .1 12 .01)))
- (gen2 (make-polywave :partials (list 5 .9 8 .3 11 .1)))
-
- (rnd (make-sawtooth-wave 700 .01))
- (rndf (make-env '(0 0 .01 1 .08 .02 .25 .02 .3 1 .45 1 .47 .03 .64 .01 .65 1 .75 1 .77 .05 .92 .01 1 1)
- :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((noise (* (env rndf)
- (sawtooth-wave rnd))))
- (outa i (* (env ampf)
- (+ (* .8 (polywave gen1 (+ (env frqf1)
- noise)))
- (* .2 (polywave gen2 (+ (env frqf2)
- (* 10 noise))))))))))))
+ (let ((dur 0.16))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.053 0.952 0.066 0.865 0.079 0.386 0.091 0.937 0.145 0.963 0.182 0.923
+ 0.197 0.384 0.221 0.892 0.256 0.751 0.298 0.000 0.410 0.000 0.430 0.915 0.450 0.836
+ 0.464 0.307 0.479 0.873 0.496 0.952 0.531 0.886 0.554 0.291 0.575 0.892 0.606 0.717
+ 0.654 0.000 0.775 0.000 0.801 0.712 0.814 0.233 0.822 0.712 0.893 0.712 0.923 0.225
+ 0.938 0.758 0.959 0.640 1.000 0.000 )
+ :duration dur :scaler amp))
+ (frqf1 (make-env '(0.000 0.106 0.051 0.119 0.063 0.177 0.087 0.230 0.198 0.228 0.211 0.175 0.236 0.153
+ 0.282 0.122 0.427 0.103 0.465 0.156 0.483 0.214 0.542 0.220 0.563 0.159 0.588 0.146
+ 0.615 0.095 0.767 0.122 0.8 0.2 0.851 0.2 0.871 0.16 0.903 0.148
+ 0.939 0.143 .95 .14)
+ :duration dur :scaler (hz->radians (/ 22050.0 3.0))))
+ (frqf2 (make-env '(0.000 0.230 0.061 0.262 0.088 0.341 0.152 0.323 0.206 0.341 0.219 0.265 0.237 0.235
+ 0.450 0.220 0.459 0.317 0.514 0.302 0.558 0.354 0.605 0.246 0.772 0.246 0.838 0.323
+ 0.857 0.278 0.864 0.325 0.914 0.222 .95 .22)
+ :duration dur :scaler (hz->radians (/ 22050.0 5.0))))
+
+ (gen1 (make-polywave 0.0 (list 1 (* .8 .01) 2 (* .8 .1) 3 (* .8 .6) 4 (* .8 .02)
+ 6 (* .8 .4) 7 (* .8 .05) 9 (* .8 .1) 10 (* .8 .1)
+ 12 (* .8 .01))))
+ (gen2 (make-polywave 0.0 (list 5 (* .2 .9) 8 (* .2 .3) 11 (* .2 .1))))
+
+ (rnd (make-sawtooth-wave 700 .01))
+ (rndf (make-env '(0 0 .01 1 .08 .02 .25 .02 .3 1 .45 1 .47 .03 .64 .01 .65 1 .75 1 .77 .05 .92 .01 1 1)
+ :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((noise (* (env rndf)
+ (sawtooth-wave rnd))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 (+ (env frqf1) noise))
+ (polywave gen2 (+ (env frqf2) (* 10.0 noise)))))))))))
;; (with-sound (:play #t) (white-headed-woodpecker 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Phainopepla
-(definstrument (phainopepla beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.26)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.063 0.073 0.119 0.181 0.142 0.290 0.178 0.617 0.192 0.525 0.236 0.288
- 0.255 0.000 0.272 0.557 0.285 0.178 0.296 0.095 0.393 0.088 0.501 0.000 0.522 0.108
- 0.538 0.634 0.647 0.000 0.663 0.000 0.681 0.484 0.704 0.211 0.777 0.643 0.850 0.961
- 0.880 0.998 0.899 0.974 0.958 0.277 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .9 2 .1 3 .01)))
- (frqf (make-env '(0.000 0.203 0.061 0.309 0.259 0.317 0.276 0.533 0.300 0.720 0.329 0.739 0.373 0.697
- 0.450 0.792 0.496 0.836 0.516 0.794 0.525 0.689 0.532 0.417 0.550 0.351 0.573 0.314
- 0.607 0.296 0.624 0.351 0.629 0.435 0.652 0.425 0.660 0.219 0.698 0.398 0.726 0.441
- 0.839 0.433 1.000 0.427)
- :duration dur :scaler (hz->radians 8040.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (phainopepla beg amp)
+ (let ((dur 0.26))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.063 0.073 0.119 0.181 0.142 0.290 0.178 0.617 0.192 0.525 0.236 0.288
+ 0.255 0.000 0.272 0.557 0.285 0.178 0.296 0.095 0.393 0.088 0.501 0.000 0.522 0.108
+ 0.538 0.634 0.647 0.000 0.663 0.000 0.681 0.484 0.704 0.211 0.777 0.643 0.850 0.961
+ 0.880 0.998 0.899 0.974 0.958 0.277 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .9 2 .1 3 .01)))
+ (frqf (make-env '(0.000 0.203 0.061 0.309 0.259 0.317 0.276 0.533 0.300 0.720 0.329 0.739 0.373 0.697
+ 0.450 0.792 0.496 0.836 0.516 0.794 0.525 0.689 0.532 0.417 0.550 0.351 0.573 0.314
+ 0.607 0.296 0.624 0.351 0.629 0.435 0.652 0.425 0.660 0.219 0.698 0.398 0.726 0.441
+ 0.839 0.433 1.000 0.427)
+ :duration dur :scaler (hz->radians 8040.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (phainopepla 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Golden-crowned sparrow
-(definstrument (golden-crowned-sparrow beg amp)
- (let* ((start (seconds->samples beg))
- (dur 2.13)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.079 0.343 0.188 0.391 0.301 0.504 0.343 0.963 0.379 0.887 0.388 0.000
- 0.459 0.000 0.474 0.480 0.494 0.549 0.595 0.984 0.637 1.000 0.688 0.720 0.701 0.000
- 0.770 0.000 0.795 0.311 0.863 0.420 0.916 0.383 0.985 0.272 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .9 2 .01 3 .1)))
- (frqf (make-env '(0.000 0.814 0.028 0.730 0.064 0.690 0.122 0.549 0.156 0.551 0.178 0.573 0.207 0.544
- 0.272 0.556 0.296 0.580 0.320 0.549 0.343 0.501 0.377 0.468 0.452 0.446 0.467 0.475
- 0.488 0.470 0.523 0.477 0.529 0.561 0.535 0.480 0.572 0.473 0.589 0.494 0.612 0.477
- 0.655 0.456 0.672 0.482 0.691 0.463 0.767 0.413 0.819 0.394 0.861 0.396 0.865 0.449
- 0.873 0.408 0.894 0.401 0.930 0.401 0.975 0.396 1.000 0.329 )
- :duration dur :scaler (hz->radians 8040.0)))
- (vib (make-rand-interp 50 (hz->radians 80))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp vib)))))))))
+(defanimal (golden-crowned-sparrow beg amp)
+ (let ((dur 2.13))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.079 0.343 0.188 0.391 0.301 0.504 0.343 0.963 0.379 0.887 0.388 0.000
+ 0.459 0.000 0.474 0.480 0.494 0.549 0.595 0.984 0.637 1.000 0.688 0.720 0.701 0.000
+ 0.770 0.000 0.795 0.311 0.863 0.420 0.916 0.383 0.985 0.272 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .9 2 .01 3 .1)))
+ (frqf (make-env '(0.000 0.814 0.028 0.730 0.064 0.690 0.122 0.549 0.156 0.551 0.178 0.573 0.207 0.544
+ 0.272 0.556 0.296 0.580 0.320 0.549 0.343 0.501 0.377 0.468 0.452 0.446 0.467 0.475
+ 0.488 0.470 0.523 0.477 0.529 0.561 0.535 0.480 0.572 0.473 0.589 0.494 0.612 0.477
+ 0.655 0.456 0.672 0.482 0.691 0.463 0.767 0.413 0.819 0.394 0.861 0.396 0.865 0.449
+ 0.873 0.408 0.894 0.401 0.930 0.401 0.975 0.396 1.000 0.329 )
+ :duration dur :scaler (hz->radians 8040.0)))
+ (vib (make-rand-interp 50 (hz->radians 80))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp vib)))))))))
;; (with-sound (:play #t) (golden-crowned-sparrow 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; House finch
-(definstrument (house-finch beg amp)
- (let* ((start (seconds->samples beg))
- (dur 3.16)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.014 0.128 0.021 0.000 0.052 0.000 0.058 0.146 0.062 0.314 0.068 0.301
- 0.073 0.000 0.097 0.000 0.101 0.296 0.104 0.151 0.106 0.447 0.114 0.459 0.119 0.143
- 0.125 0.000 0.151 0.000 0.162 0.415 0.180 0.375 0.188 0.000 0.209 0.000 0.212 0.353
- 0.214 0.175 0.217 0.442 0.222 0.153 0.225 0.528 0.232 0.002 0.246 0.000 0.247 0.109
- 0.258 0.030 0.259 0.294 0.263 0.180 0.267 0.333 0.271 0.000 0.290 0.000 0.295 0.128
- 0.298 0.388 0.303 0.000 0.313 0.857 0.322 0.000 0.346 0.000 0.358 0.990 0.359 0.528
- 0.361 0.778 0.370 0.000 0.384 0.000 0.390 0.504 0.395 0.227 0.399 0.328 0.409 0.000
- 0.420 0.993 0.425 0.402 0.433 0.000 0.444 0.000 0.449 0.380 0.455 0.978 0.461 0.000
- 0.472 0.000 0.480 0.477 0.487 0.000 0.492 0.558 0.500 0.430 0.506 0.000 0.516 0.000
- 0.525 0.844 0.533 0.104 0.537 0.072 0.541 0.538 0.550 0.067 0.557 0.067 0.559 0.232
- 0.564 0.528 0.567 0.064 0.573 0.901 0.579 0.084 0.582 0.551 0.587 0.430 0.593 0.000
- 0.606 0.000 0.611 0.257 0.618 0.000 0.625 0.079 0.629 0.516 0.636 0.642 0.639 0.489
- 0.643 0.104 0.653 0.000 0.672 0.000 0.680 0.736 0.694 0.696 0.701 0.121 0.707 0.057
- 0.713 0.558 0.722 0.000 0.752 0.000 0.757 0.723 0.774 0.546 0.782 0.116 0.794 0.207
- 0.801 0.499 0.818 0.689 0.833 0.388 0.847 0.000 0.859 0.000 0.863 0.123 0.867 0.726
- 0.872 0.000 0.878 0.116 0.879 0.385 0.885 0.669 0.944 0.835 0.989 0.328 0.995 0.035
- 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.0000 0.3997 0.0085 0.4810 0.0103 0.3943 0.0166 0.4228 0.0573 0.4268 0.0605 0.4932
- 0.0663 0.4160 0.0708 0.4363 0.0985 0.4228 0.1008 0.2846 0.1066 0.4228 0.1146 0.3089
- 0.1187 0.3238 0.1339 0.3225 0.1487 0.4864 0.1617 0.4607 0.1769 0.4512 0.1818 0.3740
- 0.1948 0.3794 0.2100 0.4214 0.2114 0.2859 0.2172 0.4350 0.2248 0.3157 0.2293 0.3320
- 0.2427 0.5054 0.2512 0.4214 0.2557 0.3374 0.2584 0.4648 0.2620 0.5434 0.2665 0.3835
- 0.2888 0.4119 0.2942 0.3794 0.3014 0.5813 0.3032 0.3130 0.3081 0.4892 0.3144 0.3266
- 0.3193 0.3388 0.3395 0.4065 0.3462 0.4824 0.3542 0.4458 0.3605 0.3333 0.3645 0.3144
- 0.3820 0.2927 0.3842 0.2751 0.3887 0.3360 0.3932 0.4173 0.4017 0.5705 0.4035 0.4607
- 0.4107 0.3862 0.4187 0.3360 0.4263 0.2737 0.4438 0.3062 0.4456 0.3686 0.4478 0.4228
- 0.4541 0.3266 0.4635 0.3225 0.4720 0.2317 0.4765 0.3225 0.4814 0.3726 0.4828 0.4702
- 0.4877 0.4363 0.4913 0.3672 0.4922 0.3130 0.4993 0.2846 0.5204 0.3496 0.5280 0.2913
- 0.5311 0.2195 0.5361 0.4241 0.5428 0.3089 0.5567 0.2913 0.5584 0.4295 0.5625 0.3198
- 0.5665 0.5000 0.5723 0.4065 0.5808 0.3225 0.5902 0.2060 0.6064 0.2642 0.6117 0.3374
- 0.6122 0.2195 0.6189 0.1789 0.6296 0.3591 0.6444 0.1599 0.6458 0.4160 0.6771 0.4201
- 0.6950 0.4214 0.7026 0.2778 0.7112 0.2764 0.7228 0.1897 0.7394 0.4092 0.7546 0.4160
- 0.7721 0.4187 0.7895 0.3198 0.8343 0.3184 0.8616 0.2344 0.8634 0.3808 0.8697 0.2276
- 0.8804 0.3279 0.9149 0.3835 0.9472 0.4688 1.0000 0.8306)
- :duration dur :scaler (hz->radians 9130.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .01)))
- (gen2 (make-polywave :partials (list 1 .98 2 .005)))
- (buzz (make-oscil 0))
- (buzzsweep (make-nrxysin :n 5 :r .5))
- (bsweep (hz->radians 500))
- (buzzf (make-env '(0 0 .14 0 .15 1 .19 1 .20 0 .66 0 .67 1 1 1) :duration dur))
- (buzzfrqf (make-env '(0 110 .5 110 .6 70 .85 70 .86 130 1 130) :duration dur :scaler (hz->radians 1.0)))
- (rnd (make-rand-interp 400 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((buzzing (env buzzf))
- (frq (env frqf))
- (bfrq (env buzzfrqf)))
- (outa i (* (env ampf)
- (+ (* (- 1.0 buzzing)
- (polywave gen1 frq))
- (* buzzing
- (+ .1 (* .9 (abs (oscil buzz bfrq))))
- (polywave gen2 (+ frq
- (* bsweep (nrxysin buzzsweep bfrq))
- (rand-interp rnd))))))))))))
+(defanimal (house-finch beg amp)
+ (let ((dur 3.16))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.014 0.128 0.021 0.000 0.052 0.000 0.058 0.146 0.062 0.314 0.068 0.301
+ 0.073 0.000 0.097 0.000 0.101 0.296 0.104 0.151 0.106 0.447 0.114 0.459 0.119 0.143
+ 0.125 0.000 0.151 0.000 0.162 0.415 0.180 0.375 0.188 0.000 0.209 0.000 0.212 0.353
+ 0.214 0.175 0.217 0.442 0.222 0.153 0.225 0.528 0.232 0.002 0.246 0.000 0.247 0.109
+ 0.258 0.030 0.259 0.294 0.263 0.180 0.267 0.333 0.271 0.000 0.290 0.000 0.295 0.128
+ 0.298 0.388 0.303 0.000 0.313 0.857 0.322 0.000 0.346 0.000 0.358 0.990 0.359 0.528
+ 0.361 0.778 0.370 0.000 0.384 0.000 0.390 0.504 0.395 0.227 0.399 0.328 0.409 0.000
+ 0.420 0.993 0.425 0.402 0.433 0.000 0.444 0.000 0.449 0.380 0.455 0.978 0.461 0.000
+ 0.472 0.000 0.480 0.477 0.487 0.000 0.492 0.558 0.500 0.430 0.506 0.000 0.516 0.000
+ 0.525 0.844 0.533 0.104 0.537 0.072 0.541 0.538 0.550 0.067 0.557 0.067 0.559 0.232
+ 0.564 0.528 0.567 0.064 0.573 0.901 0.579 0.084 0.582 0.551 0.587 0.430 0.593 0.000
+ 0.606 0.000 0.611 0.257 0.618 0.000 0.625 0.079 0.629 0.516 0.636 0.642 0.639 0.489
+ 0.643 0.104 0.653 0.000 0.672 0.000 0.680 0.736 0.694 0.696 0.701 0.121 0.707 0.057
+ 0.713 0.558 0.722 0.000 0.752 0.000 0.757 0.723 0.774 0.546 0.782 0.116 0.794 0.207
+ 0.801 0.499 0.818 0.689 0.833 0.388 0.847 0.000 0.859 0.000 0.863 0.123 0.867 0.726
+ 0.872 0.000 0.878 0.116 0.879 0.385 0.885 0.669 0.944 0.835 0.989 0.328 0.995 0.035
+ 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.0000 0.3997 0.0085 0.4810 0.0103 0.3943 0.0166 0.4228 0.0573 0.4268 0.0605 0.4932
+ 0.0663 0.4160 0.0708 0.4363 0.0985 0.4228 0.1008 0.2846 0.1066 0.4228 0.1146 0.3089
+ 0.1187 0.3238 0.1339 0.3225 0.1487 0.4864 0.1617 0.4607 0.1769 0.4512 0.1818 0.3740
+ 0.1948 0.3794 0.2100 0.4214 0.2114 0.2859 0.2172 0.4350 0.2248 0.3157 0.2293 0.3320
+ 0.2427 0.5054 0.2512 0.4214 0.2557 0.3374 0.2584 0.4648 0.2620 0.5434 0.2665 0.3835
+ 0.2888 0.4119 0.2942 0.3794 0.3014 0.5813 0.3032 0.3130 0.3081 0.4892 0.3144 0.3266
+ 0.3193 0.3388 0.3395 0.4065 0.3462 0.4824 0.3542 0.4458 0.3605 0.3333 0.3645 0.3144
+ 0.3820 0.2927 0.3842 0.2751 0.3887 0.3360 0.3932 0.4173 0.4017 0.5705 0.4035 0.4607
+ 0.4107 0.3862 0.4187 0.3360 0.4263 0.2737 0.4438 0.3062 0.4456 0.3686 0.4478 0.4228
+ 0.4541 0.3266 0.4635 0.3225 0.4720 0.2317 0.4765 0.3225 0.4814 0.3726 0.4828 0.4702
+ 0.4877 0.4363 0.4913 0.3672 0.4922 0.3130 0.4993 0.2846 0.5204 0.3496 0.5280 0.2913
+ 0.5311 0.2195 0.5361 0.4241 0.5428 0.3089 0.5567 0.2913 0.5584 0.4295 0.5625 0.3198
+ 0.5665 0.5000 0.5723 0.4065 0.5808 0.3225 0.5902 0.2060 0.6064 0.2642 0.6117 0.3374
+ 0.6122 0.2195 0.6189 0.1789 0.6296 0.3591 0.6444 0.1599 0.6458 0.4160 0.6771 0.4201
+ 0.6950 0.4214 0.7026 0.2778 0.7112 0.2764 0.7228 0.1897 0.7394 0.4092 0.7546 0.4160
+ 0.7721 0.4187 0.7895 0.3198 0.8343 0.3184 0.8616 0.2344 0.8634 0.3808 0.8697 0.2276
+ 0.8804 0.3279 0.9149 0.3835 0.9472 0.4688 1.0000 0.8306)
+ :duration dur :scaler (hz->radians 9130.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .01)))
+ (gen2 (make-polywave 0.0 '(1 .98 2 .005)))
+ (buzz (make-oscil 0))
+ (buzzsweep (make-nrxysin :n 5 :r .5))
+ (bsweep (hz->radians 500))
+ (buzzf (make-env '(0 0 .14 0 .15 1 .19 1 .20 0 .66 0 .67 1 1 1) :duration dur))
+ (buzzf-1 (make-env '(0 0 .14 0 .15 1 .19 1 .20 0 .66 0 .67 1 1 1) :duration dur :offset 1.0 :scaler -1.0))
+ (buzzfrqf (make-env '(0 110 .5 110 .6 70 .85 70 .86 130 1 130) :duration dur :scaler (hz->radians 1.0)))
+ (rnd (make-rand-interp 400 (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf))
+ (bfrq (env buzzfrqf)))
+ (outa i (* (env ampf)
+ (+ (* (env buzzf-1)
+ (polywave gen1 frq))
+ (* (env buzzf)
+ (+ .1 (* .9 (abs (oscil buzz bfrq))))
+ (polywave gen2 (+ frq
+ (* bsweep (nrxysin buzzsweep bfrq))
+ (rand-interp rnd))))))))))))
;; (with-sound (:play #t) (house-finch 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Ruby-crowned kinglet
-(definstrument (ruby-crowned-kinglet beg amp)
- (let* ((start (seconds->samples beg))
- (dur 2.17)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.017 0.053 0.025 0.000 0.034 0.000 0.044 0.088 0.053 0.076 0.057 0.000
- 0.112 0.000 0.133 0.298 0.151 0.060 0.167 0.158 0.179 0.000 0.214 0.000 0.232 0.496
- 0.247 0.100 0.265 0.745 0.275 0.000 0.310 0.000 0.318 0.601 0.326 0.714 0.344 0.169
- 0.361 0.334 0.372 0.000 0.401 0.000 0.417 1.000 0.433 0.115 0.450 0.979 0.459 0.000
- 0.496 0.000 0.506 0.745 0.516 0.778 0.526 0.322 0.537 0.236 0.546 0.258 0.553 0.212
- 0.559 0.000 0.599 0.000 0.613 0.967 0.631 0.189 0.647 0.933 0.656 0.000 0.697 0.000
- 0.706 0.726 0.714 0.589 0.719 0.714 0.729 0.236 0.737 0.160 0.743 0.241 0.754 0.198
- 0.761 0.000 0.808 0.000 0.826 0.752 0.839 0.098 0.856 0.599 0.862 0.558 0.868 0.000
- 0.921 0.000 0.932 0.470 0.941 0.511 0.951 0.179 0.976 0.229 0.980 0.057 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .004)))
- (frqf (make-env '(0.000 0.671 0.017 0.698 0.026 0.786 0.031 0.785 0.032 0.556 0.039 0.556 0.053 0.646
- 0.059 0.591 0.119 0.476 0.146 0.284 0.193 0.269 0.216 0.549 0.225 0.464 0.238 0.564
- 0.244 0.477 0.250 0.411 0.262 0.411 0.268 0.442 0.274 0.414 0.316 0.446 0.337 0.289
- 0.363 0.285 0.368 0.267 0.391 0.287 0.404 0.523 0.410 0.481 0.423 0.553 0.432 0.426
- 0.441 0.401 0.452 0.441 0.458 0.396 0.502 0.444 0.528 0.285 0.550 0.285 0.557 0.259
- 0.572 0.260 0.594 0.513 0.607 0.482 0.618 0.568 0.626 0.529 0.629 0.451 0.642 0.429
- 0.650 0.462 0.653 0.427 0.703 0.442 0.729 0.282 0.750 0.285 0.756 0.259 0.778 0.259
- 0.793 0.616 0.806 0.588 0.813 0.481 0.825 0.571 0.841 0.444 0.851 0.416 0.860 0.442
- 0.923 0.444 0.952 0.279 1.000 0.275)
- :duration dur :scaler (hz->radians 9060.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (ruby-crowned-kinglet beg amp)
+ (let ((dur 2.17))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.017 0.053 0.025 0.000 0.034 0.000 0.044 0.088 0.053 0.076 0.057 0.000
+ 0.112 0.000 0.133 0.298 0.151 0.060 0.167 0.158 0.179 0.000 0.214 0.000 0.232 0.496
+ 0.247 0.100 0.265 0.745 0.275 0.000 0.310 0.000 0.318 0.601 0.326 0.714 0.344 0.169
+ 0.361 0.334 0.372 0.000 0.401 0.000 0.417 1.000 0.433 0.115 0.450 0.979 0.459 0.000
+ 0.496 0.000 0.506 0.745 0.516 0.778 0.526 0.322 0.537 0.236 0.546 0.258 0.553 0.212
+ 0.559 0.000 0.599 0.000 0.613 0.967 0.631 0.189 0.647 0.933 0.656 0.000 0.697 0.000
+ 0.706 0.726 0.714 0.589 0.719 0.714 0.729 0.236 0.737 0.160 0.743 0.241 0.754 0.198
+ 0.761 0.000 0.808 0.000 0.826 0.752 0.839 0.098 0.856 0.599 0.862 0.558 0.868 0.000
+ 0.921 0.000 0.932 0.470 0.941 0.511 0.951 0.179 0.976 0.229 0.980 0.057 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .004)))
+ (frqf (make-env '(0.000 0.671 0.017 0.698 0.026 0.786 0.031 0.785 0.032 0.556 0.039 0.556 0.053 0.646
+ 0.059 0.591 0.119 0.476 0.146 0.284 0.193 0.269 0.216 0.549 0.225 0.464 0.238 0.564
+ 0.244 0.477 0.250 0.411 0.262 0.411 0.268 0.442 0.274 0.414 0.316 0.446 0.337 0.289
+ 0.363 0.285 0.368 0.267 0.391 0.287 0.404 0.523 0.410 0.481 0.423 0.553 0.432 0.426
+ 0.441 0.401 0.452 0.441 0.458 0.396 0.502 0.444 0.528 0.285 0.550 0.285 0.557 0.259
+ 0.572 0.260 0.594 0.513 0.607 0.482 0.618 0.568 0.626 0.529 0.629 0.451 0.642 0.429
+ 0.650 0.462 0.653 0.427 0.703 0.442 0.729 0.282 0.750 0.285 0.756 0.259 0.778 0.259
+ 0.793 0.616 0.806 0.588 0.813 0.481 0.825 0.571 0.841 0.444 0.851 0.416 0.860 0.442
+ 0.923 0.444 0.952 0.279 1.000 0.275)
+ :duration dur :scaler (hz->radians 9060.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (ruby-crowned-kinglet 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Green-tailed towhee
;;;
;;; not very elegant, but a real test of the envelope editor
-(definstrument (green-tailed-towhee beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.86)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.010 0.168 0.013 0.000 0.018 0.000 0.021 0.200 0.027 0.255 0.033 0.119
- 0.039 0.000 0.141 0.000 0.149 0.104 0.159 0.586 0.163 0.438 0.166 0.586 0.168 0.374
- 0.171 0.519 0.173 0.429 0.176 0.487 0.179 0.284 0.180 0.554 0.184 0.261 0.186 0.539
- 0.189 0.270 0.190 0.530 0.194 0.243 0.197 0.449 0.200 0.272 0.202 0.443 0.205 0.243
- 0.207 0.377 0.218 0.200 0.222 0.000 0.277 0.000 0.286 0.122 0.289 0.417 0.292 0.055
- 0.296 0.417 0.299 0.490 0.303 0.058 0.307 0.336 0.309 0.000 0.323 0.093 0.327 0.658
- 0.330 0.087 0.335 0.530 0.341 0.000 0.343 0.438 0.346 0.000 0.356 0.061 0.362 0.232
- 0.365 0.872 0.368 0.145 0.372 0.655 0.378 0.061 0.381 0.542 0.383 0.000 0.392 0.000
- 0.397 0.159 0.403 0.739 0.406 0.081 0.411 0.600 0.416 0.000 0.420 0.452 0.422 0.000
- 0.432 0.078 0.437 0.235 0.441 0.788 0.445 0.078 0.450 0.614 0.454 0.078 0.459 0.357
- 0.460 0.000 0.470 0.081 0.476 0.281 0.479 0.733 0.485 0.070 0.489 0.588 0.493 0.000
- 0.498 0.194 0.500 0.000 0.533 0.000 0.535 0.374 0.538 0.090 0.550 1.000 0.557 0.991
- 0.572 0.078 0.577 0.145 0.583 0.354 0.612 0.000 0.646 0.000 0.663 0.588 0.671 0.583
- 0.686 0.081 0.701 0.591 0.706 0.577 0.721 0.000 0.759 0.000 0.763 0.420 0.765 0.084
- 0.768 0.191 0.772 0.136 0.775 0.000 0.778 0.464 0.780 0.119 0.783 0.212 0.788 0.154
- 0.790 0.003 0.794 0.571 0.796 0.136 0.799 0.241 0.803 0.165 0.807 0.009 0.810 0.710
- 0.812 0.125 0.814 0.275 0.819 0.174 0.822 0.017 0.824 0.536 0.828 0.136 0.831 0.272
- 0.835 0.186 0.837 0.006 0.841 0.684 0.844 0.142 0.846 0.345 0.855 0.006 0.856 0.617
- 0.860 0.130 0.862 0.287 0.870 0.006 0.873 0.606 0.876 0.142 0.879 0.290 0.883 0.154
- 0.885 0.009 0.889 0.623 0.892 0.139 0.893 0.281 0.903 0.023 0.904 0.600 0.908 0.130
- 0.911 0.241 0.918 0.006 0.921 0.580 0.924 0.110 0.926 0.209 0.934 0.009 0.938 0.455
- 0.940 0.090 0.943 0.159 0.951 0.003 0.955 0.391 0.956 0.093 0.959 0.136 0.967 0.012
- 0.970 0.386 0.974 0.116 0.983 0.012 0.987 0.333 0.990 0.049 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-oscil))
- (frqf (make-env '(0.0000 0.3575 0.0067 0.4860 0.0110 0.5475 0.0119 0.3203 0.0181 0.3911 0.0219 0.5438
- 0.0229 0.3389 0.0267 0.4860 0.0300 0.3948 0.0334 0.3259 0.1411 0.3315 0.1478 0.4953
- 0.1554 0.4413 0.1635 0.3296 0.1640 0.4376 0.1697 0.3315 0.1698 0.4302 0.1755 0.3389
- 0.1759 0.4153 0.1797 0.3296 0.1821 0.4358 0.1859 0.3240 0.1864 0.4078 0.1892 0.3575
- 0.1907 0.4358 0.1959 0.3240 0.1964 0.4134 0.2031 0.3128 0.2032 0.4376 0.2078 0.3035
- 0.2126 0.3166 0.2127 0.4246 0.2183 0.3464 0.2194 0.4320 0.2216 0.3669 0.2698 0.3892
- 0.2827 0.7318 0.2898 0.5214 0.2941 0.3054 0.2979 0.5978 0.3046 0.3091 0.3207 0.7745
- 0.3241 0.6685 0.3322 0.2868 0.3346 0.5512 0.3394 0.2626 0.3547 0.8209 0.3608 0.6462
- 0.3689 0.2756 0.3723 0.5196 0.3785 0.2868 0.3918 0.8425 0.3999 0.6331 0.4066 0.3110
- 0.4109 0.5568 0.4175 0.3147 0.4280 0.8541 0.4337 0.7263 0.4409 0.5531 0.4447 0.2961
- 0.4485 0.6555 0.4561 0.2607 0.4682 0.8375 0.4743 0.6853 0.4790 0.5661 0.4833 0.3315
- 0.4871 0.6089 0.4933 0.3315 0.4976 0.6462 0.5353 0.4860 0.5362 0.6872 0.5377 0.2849
- 0.5405 0.4488 0.5458 0.4860 0.5567 0.4600 0.5648 0.3464 0.5758 0.2458 0.5877 0.3240
- 0.6025 0.2495 0.6482 0.3222 0.6568 0.4860 0.6754 0.4618 0.6888 0.4823 0.6892 0.2775
- 0.7021 0.3315 0.7188 0.2682 0.7541 0.2793 0.7610 0.6542 0.7649 0.2737 0.7650 0.6574
- 0.7717 0.4097 0.7769 0.6499 0.7798 0.3222 0.7822 0.5791 0.7879 0.3743 0.7927 0.6480
- 0.7939 0.3003 0.7974 0.6034 0.8022 0.3799 0.8065 0.6518 0.8117 0.2961 0.8136 0.6425
- 0.8184 0.4041 0.8241 0.6499 0.8255 0.2896 0.8282 0.6167 0.8341 0.4004 0.8379 0.6610
- 0.8442 0.2857 0.8451 0.6145 0.8506 0.3969 0.8537 0.6491 0.8585 0.3066 0.8600 0.6269
- 0.8652 0.3816 0.8700 0.6422 0.8755 0.2760 0.8756 0.6238 0.8831 0.3697 0.8870 0.6499
- 0.8919 0.2794 0.8923 0.6145 0.8985 0.3526 0.9021 0.6405 0.9066 0.3408 0.9075 0.3066
- 0.9080 0.6071 0.9145 0.3748 0.9175 0.6388 0.9238 0.3135 0.9249 0.6065 0.9306 0.3714
- 0.9351 0.6303 0.9390 0.2998 0.9404 0.5791 0.9442 0.3855 0.9514 0.6294 0.9542 0.3575
- 0.9571 0.5791 0.9628 0.3724 0.9670 0.6235 0.9720 0.3152 0.9747 0.5680 0.9795 0.3594
- 0.9858 0.5963 0.9900 0.3520 1.0000 0.2777)
- :duration dur :scaler (hz->radians 10030.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (env frqf))))))))
+(defanimal (green-tailed-towhee beg amp)
+ (let ((dur 1.86))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.010 0.168 0.013 0.000 0.018 0.000 0.021 0.200 0.027 0.255 0.033 0.119
+ 0.039 0.000 0.141 0.000 0.149 0.104 0.159 0.586 0.163 0.438 0.166 0.586 0.168 0.374
+ 0.171 0.519 0.173 0.429 0.176 0.487 0.179 0.284 0.180 0.554 0.184 0.261 0.186 0.539
+ 0.189 0.270 0.190 0.530 0.194 0.243 0.197 0.449 0.200 0.272 0.202 0.443 0.205 0.243
+ 0.207 0.377 0.218 0.200 0.222 0.000 0.277 0.000 0.286 0.122 0.289 0.417 0.292 0.055
+ 0.296 0.417 0.299 0.490 0.303 0.058 0.307 0.336 0.309 0.000 0.323 0.093 0.327 0.658
+ 0.330 0.087 0.335 0.530 0.341 0.000 0.343 0.438 0.346 0.000 0.356 0.061 0.362 0.232
+ 0.365 0.872 0.368 0.145 0.372 0.655 0.378 0.061 0.381 0.542 0.383 0.000 0.392 0.000
+ 0.397 0.159 0.403 0.739 0.406 0.081 0.411 0.600 0.416 0.000 0.420 0.452 0.422 0.000
+ 0.432 0.078 0.437 0.235 0.441 0.788 0.445 0.078 0.450 0.614 0.454 0.078 0.459 0.357
+ 0.460 0.000 0.470 0.081 0.476 0.281 0.479 0.733 0.485 0.070 0.489 0.588 0.493 0.000
+ 0.498 0.194 0.500 0.000 0.533 0.000 0.535 0.374 0.538 0.090 0.550 1.000 0.557 0.991
+ 0.572 0.078 0.577 0.145 0.583 0.354 0.612 0.000 0.646 0.000 0.663 0.588 0.671 0.583
+ 0.686 0.081 0.701 0.591 0.706 0.577 0.721 0.000 0.759 0.000 0.763 0.420 0.765 0.084
+ 0.768 0.191 0.772 0.136 0.775 0.000 0.778 0.464 0.780 0.119 0.783 0.212 0.788 0.154
+ 0.790 0.003 0.794 0.571 0.796 0.136 0.799 0.241 0.803 0.165 0.807 0.009 0.810 0.710
+ 0.812 0.125 0.814 0.275 0.819 0.174 0.822 0.017 0.824 0.536 0.828 0.136 0.831 0.272
+ 0.835 0.186 0.837 0.006 0.841 0.684 0.844 0.142 0.846 0.345 0.855 0.006 0.856 0.617
+ 0.860 0.130 0.862 0.287 0.870 0.006 0.873 0.606 0.876 0.142 0.879 0.290 0.883 0.154
+ 0.885 0.009 0.889 0.623 0.892 0.139 0.893 0.281 0.903 0.023 0.904 0.600 0.908 0.130
+ 0.911 0.241 0.918 0.006 0.921 0.580 0.924 0.110 0.926 0.209 0.934 0.009 0.938 0.455
+ 0.940 0.090 0.943 0.159 0.951 0.003 0.955 0.391 0.956 0.093 0.959 0.136 0.967 0.012
+ 0.970 0.386 0.974 0.116 0.983 0.012 0.987 0.333 0.990 0.049 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-oscil))
+ (frqf (make-env '(0.0000 0.3575 0.0067 0.4860 0.0110 0.5475 0.0119 0.3203 0.0181 0.3911 0.0219 0.5438
+ 0.0229 0.3389 0.0267 0.4860 0.0300 0.3948 0.0334 0.3259 0.1411 0.3315 0.1478 0.4953
+ 0.1554 0.4413 0.1635 0.3296 0.1640 0.4376 0.1697 0.3315 0.1698 0.4302 0.1755 0.3389
+ 0.1759 0.4153 0.1797 0.3296 0.1821 0.4358 0.1859 0.3240 0.1864 0.4078 0.1892 0.3575
+ 0.1907 0.4358 0.1959 0.3240 0.1964 0.4134 0.2031 0.3128 0.2032 0.4376 0.2078 0.3035
+ 0.2126 0.3166 0.2127 0.4246 0.2183 0.3464 0.2194 0.4320 0.2216 0.3669 0.2698 0.3892
+ 0.2827 0.7318 0.2898 0.5214 0.2941 0.3054 0.2979 0.5978 0.3046 0.3091 0.3207 0.7745
+ 0.3241 0.6685 0.3322 0.2868 0.3346 0.5512 0.3394 0.2626 0.3547 0.8209 0.3608 0.6462
+ 0.3689 0.2756 0.3723 0.5196 0.3785 0.2868 0.3918 0.8425 0.3999 0.6331 0.4066 0.3110
+ 0.4109 0.5568 0.4175 0.3147 0.4280 0.8541 0.4337 0.7263 0.4409 0.5531 0.4447 0.2961
+ 0.4485 0.6555 0.4561 0.2607 0.4682 0.8375 0.4743 0.6853 0.4790 0.5661 0.4833 0.3315
+ 0.4871 0.6089 0.4933 0.3315 0.4976 0.6462 0.5353 0.4860 0.5362 0.6872 0.5377 0.2849
+ 0.5405 0.4488 0.5458 0.4860 0.5567 0.4600 0.5648 0.3464 0.5758 0.2458 0.5877 0.3240
+ 0.6025 0.2495 0.6482 0.3222 0.6568 0.4860 0.6754 0.4618 0.6888 0.4823 0.6892 0.2775
+ 0.7021 0.3315 0.7188 0.2682 0.7541 0.2793 0.7610 0.6542 0.7649 0.2737 0.7650 0.6574
+ 0.7717 0.4097 0.7769 0.6499 0.7798 0.3222 0.7822 0.5791 0.7879 0.3743 0.7927 0.6480
+ 0.7939 0.3003 0.7974 0.6034 0.8022 0.3799 0.8065 0.6518 0.8117 0.2961 0.8136 0.6425
+ 0.8184 0.4041 0.8241 0.6499 0.8255 0.2896 0.8282 0.6167 0.8341 0.4004 0.8379 0.6610
+ 0.8442 0.2857 0.8451 0.6145 0.8506 0.3969 0.8537 0.6491 0.8585 0.3066 0.8600 0.6269
+ 0.8652 0.3816 0.8700 0.6422 0.8755 0.2760 0.8756 0.6238 0.8831 0.3697 0.8870 0.6499
+ 0.8919 0.2794 0.8923 0.6145 0.8985 0.3526 0.9021 0.6405 0.9066 0.3408 0.9075 0.3066
+ 0.9080 0.6071 0.9145 0.3748 0.9175 0.6388 0.9238 0.3135 0.9249 0.6065 0.9306 0.3714
+ 0.9351 0.6303 0.9390 0.2998 0.9404 0.5791 0.9442 0.3855 0.9514 0.6294 0.9542 0.3575
+ 0.9571 0.5791 0.9628 0.3724 0.9670 0.6235 0.9720 0.3152 0.9747 0.5680 0.9795 0.3594
+ 0.9858 0.5963 0.9900 0.3520 1.0000 0.2777)
+ :duration dur :scaler (hz->radians 10030.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (env frqf))))))))
;; (with-sound (:play #t) (green-tailed-towhee 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Lucy's warbler
-(definstrument (lucys-warbler beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.72)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.019 0.093 0.038 0.000 0.057 0.000 0.066 0.170 0.073 0.132 0.081 0.168
- 0.091 0.000 0.116 0.000 0.125 0.269 0.132 0.211 0.137 0.280 0.149 0.000 0.174 0.000
- 0.185 0.384 0.191 0.261 0.196 0.461 0.209 0.000 0.233 0.000 0.239 0.416 0.245 0.474
- 0.248 0.284 0.254 0.543 0.259 0.405 0.267 0.000 0.287 0.000 0.295 0.659 0.301 0.507
- 0.308 0.655 0.320 0.000 0.343 0.000 0.355 0.881 0.358 0.629 0.365 0.761 0.377 0.000
- 0.396 0.000 0.408 0.965 0.424 0.573 0.431 0.000 0.450 0.000 0.459 0.983 0.471 0.466
- 0.477 0.000 0.494 0.000 0.503 0.853 0.516 0.442 0.520 0.000 0.536 0.000 0.549 0.853
- 0.567 0.000 0.581 0.000 0.596 0.981 0.614 0.000 0.628 0.000 0.634 0.813 0.640 0.425
- 0.642 0.860 0.653 0.422 0.657 0.000 0.678 0.000 0.682 0.757 0.686 0.364 0.688 0.875
- 0.704 0.000 0.720 0.000 0.727 0.761 0.731 0.440 0.733 0.875 0.743 0.461 0.750 0.000
- 0.768 0.000 0.773 0.993 0.781 0.601 0.785 0.918 0.798 0.000 0.816 0.000 0.823 0.877
- 0.827 0.535 0.830 0.877 0.855 0.000 0.879 0.000 0.885 0.638 0.889 0.741 0.919 0.000
- 0.945 0.000 0.950 0.556 0.955 0.379 0.959 0.563 0.986 0.037 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .98 2 .015 3 .005)))
- (frqf (make-env '(0.000 0.651 0.018 0.637 0.040 0.401 0.049 0.361 0.055 0.658 0.072 0.644 0.087 0.526
- 0.098 0.358 0.106 0.340 0.110 0.677 0.130 0.665 0.136 0.595 0.146 0.509 0.155 0.361
- 0.161 0.342 0.175 0.628 0.191 0.602 0.202 0.536 0.212 0.394 0.219 0.361 0.229 0.648
- 0.244 0.623 0.254 0.590 0.263 0.500 0.271 0.382 0.278 0.354 0.285 0.627 0.302 0.611
- 0.315 0.536 0.322 0.391 0.328 0.356 0.333 0.661 0.357 0.644 0.369 0.547 0.379 0.387
- 0.390 0.363 0.396 0.630 0.415 0.613 0.425 0.543 0.432 0.394 0.442 0.351 0.449 0.724
- 0.462 0.708 0.474 0.538 0.475 0.418 0.488 0.365 0.491 0.774 0.502 0.743 0.513 0.613
- 0.519 0.438 0.528 0.389 0.533 0.821 0.544 0.800 0.551 0.688 0.562 0.526 0.565 0.387
- 0.577 0.354 0.579 0.807 0.588 0.795 0.597 0.701 0.606 0.595 0.612 0.384 0.621 0.339
- 0.624 0.797 0.634 0.773 0.648 0.627 0.657 0.385 0.663 0.333 0.664 0.809 0.678 0.799
- 0.686 0.696 0.695 0.575 0.701 0.389 0.709 0.345 0.714 0.825 0.724 0.797 0.736 0.630
- 0.746 0.432 0.748 0.373 0.759 0.325 0.760 0.813 0.770 0.780 0.785 0.623 0.789 0.507
- 0.793 0.405 0.802 0.342 0.803 0.837 0.818 0.795 0.829 0.630 0.836 0.535 0.854 0.372
- 0.864 0.309 0.868 0.826 0.878 0.802 0.884 0.727 0.888 0.618 0.915 0.373 0.930 0.314
- 0.931 0.819 0.944 0.792 0.951 0.670 0.963 0.563 0.977 0.448 0.981 0.387 1.000 0.318)
- :duration dur :scaler (hz->radians 8070.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (lucys-warbler beg amp)
+ (let ((dur 1.72))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.019 0.093 0.038 0.000 0.057 0.000 0.066 0.170 0.073 0.132 0.081 0.168
+ 0.091 0.000 0.116 0.000 0.125 0.269 0.132 0.211 0.137 0.280 0.149 0.000 0.174 0.000
+ 0.185 0.384 0.191 0.261 0.196 0.461 0.209 0.000 0.233 0.000 0.239 0.416 0.245 0.474
+ 0.248 0.284 0.254 0.543 0.259 0.405 0.267 0.000 0.287 0.000 0.295 0.659 0.301 0.507
+ 0.308 0.655 0.320 0.000 0.343 0.000 0.355 0.881 0.358 0.629 0.365 0.761 0.377 0.000
+ 0.396 0.000 0.408 0.965 0.424 0.573 0.431 0.000 0.450 0.000 0.459 0.983 0.471 0.466
+ 0.477 0.000 0.494 0.000 0.503 0.853 0.516 0.442 0.520 0.000 0.536 0.000 0.549 0.853
+ 0.567 0.000 0.581 0.000 0.596 0.981 0.614 0.000 0.628 0.000 0.634 0.813 0.640 0.425
+ 0.642 0.860 0.653 0.422 0.657 0.000 0.678 0.000 0.682 0.757 0.686 0.364 0.688 0.875
+ 0.704 0.000 0.720 0.000 0.727 0.761 0.731 0.440 0.733 0.875 0.743 0.461 0.750 0.000
+ 0.768 0.000 0.773 0.993 0.781 0.601 0.785 0.918 0.798 0.000 0.816 0.000 0.823 0.877
+ 0.827 0.535 0.830 0.877 0.855 0.000 0.879 0.000 0.885 0.638 0.889 0.741 0.919 0.000
+ 0.945 0.000 0.950 0.556 0.955 0.379 0.959 0.563 0.986 0.037 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .015 3 .005)))
+ (frqf (make-env '(0.000 0.651 0.018 0.637 0.040 0.401 0.049 0.361 0.055 0.658 0.072 0.644 0.087 0.526
+ 0.098 0.358 0.106 0.340 0.110 0.677 0.130 0.665 0.136 0.595 0.146 0.509 0.155 0.361
+ 0.161 0.342 0.175 0.628 0.191 0.602 0.202 0.536 0.212 0.394 0.219 0.361 0.229 0.648
+ 0.244 0.623 0.254 0.590 0.263 0.500 0.271 0.382 0.278 0.354 0.285 0.627 0.302 0.611
+ 0.315 0.536 0.322 0.391 0.328 0.356 0.333 0.661 0.357 0.644 0.369 0.547 0.379 0.387
+ 0.390 0.363 0.396 0.630 0.415 0.613 0.425 0.543 0.432 0.394 0.442 0.351 0.449 0.724
+ 0.462 0.708 0.474 0.538 0.475 0.418 0.488 0.365 0.491 0.774 0.502 0.743 0.513 0.613
+ 0.519 0.438 0.528 0.389 0.533 0.821 0.544 0.800 0.551 0.688 0.562 0.526 0.565 0.387
+ 0.577 0.354 0.579 0.807 0.588 0.795 0.597 0.701 0.606 0.595 0.612 0.384 0.621 0.339
+ 0.624 0.797 0.634 0.773 0.648 0.627 0.657 0.385 0.663 0.333 0.664 0.809 0.678 0.799
+ 0.686 0.696 0.695 0.575 0.701 0.389 0.709 0.345 0.714 0.825 0.724 0.797 0.736 0.630
+ 0.746 0.432 0.748 0.373 0.759 0.325 0.760 0.813 0.770 0.780 0.785 0.623 0.789 0.507
+ 0.793 0.405 0.802 0.342 0.803 0.837 0.818 0.795 0.829 0.630 0.836 0.535 0.854 0.372
+ 0.864 0.309 0.868 0.826 0.878 0.802 0.884 0.727 0.888 0.618 0.915 0.373 0.930 0.314
+ 0.931 0.819 0.944 0.792 0.951 0.670 0.963 0.563 0.977 0.448 0.981 0.387 1.000 0.318)
+ :duration dur :scaler (hz->radians 8070.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (lucys-warbler 0 .25))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Cassin's vireo
-(definstrument (cassins-vireo beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.5)
- (stop (+ start (seconds->samples dur)))
-
- (ampf (make-env '(0.000 0.000 0.028 0.110 0.037 0.062 0.050 0.098 0.060 0.075 0.078 0.179 0.085 0.065
- 0.093 0.116 0.100 0.379 0.119 0.163 0.136 0.457 0.147 0.473 0.159 0.180 0.173 0.608
- 0.182 0.655 0.193 0.001 0.200 0.292 0.210 0.180 0.219 0.262 0.224 0.103 0.241 0.204
- 0.253 0.055 0.268 0.225 0.285 0.061 0.299 0.251 0.312 0.171 0.330 0.298 0.366 0.182
- 0.375 0.138 0.384 0.159 0.391 0.000 0.512 0.000 0.527 0.085 0.539 0.267 0.553 0.111
- 0.565 0.200 0.574 0.150 0.583 0.360 0.587 0.117 0.595 0.257 0.602 0.096 0.610 0.297
- 0.623 0.072 0.635 0.241 0.640 0.201 0.653 0.336 0.669 0.996 0.679 0.730 0.689 0.235
- 0.702 0.336 0.714 0.688 0.725 0.752 0.733 0.466 0.744 0.680 0.752 0.070 0.763 0.628
- 0.766 0.567 0.774 0.671 0.786 0.094 0.792 0.514 0.797 0.099 0.800 0.187 0.807 0.224
- 0.810 0.523 0.820 0.444 0.824 0.155 0.829 0.481 0.832 0.598 0.838 0.521 0.843 0.070
- 0.847 0.209 0.857 0.476 0.862 0.294 0.873 0.775 0.880 0.175 0.884 0.495 0.888 0.083
- 0.896 0.644 0.916 0.074 0.919 0.379 0.926 0.072 0.940 0.657 0.944 0.613 0.955 0.070
- 0.960 0.181 0.966 0.087 0.970 0.111 0.975 0.069 0.981 0.173 0.989 0.021 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.069 0.028 0.063 0.060 0.075 0.078 0.110 0.100 0.144 0.121 0.159 0.141 0.162
- 0.160 0.154 0.188 0.130 0.206 0.119 0.216 0.120 0.225 0.100 0.239 0.119 0.254 0.093
- 0.265 0.117 0.281 0.094 0.298 0.120 0.325 0.129 0.356 0.133 0.382 0.128 0.395 0.100
- 0.516 0.090 0.568 0.108 0.600 0.075 0.621 0.150 0.639 0.183 0.662 0.178 0.682 0.159
- 0.703 0.155 0.721 0.139 0.735 0.157 0.753 0.123 0.769 0.148 0.784 0.124 0.795 0.159
- 0.816 0.139 0.831 0.172 0.845 0.148 0.857 0.180 0.872 0.178 0.881 0.159 0.892 0.198
- 0.908 0.178 0.922 0.206 0.942 0.194 0.957 0.212 0.982 0.199 1.000 0.179)
- :duration dur :scaler (hz->radians 22050.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (gen4 (make-oscil))
- (gen5 (make-oscil))
- (f1 (make-env '(0 .01 .06 .01 .1 1 .3 1 .5 .01 .65 .05 .67 1 1 1) :duration dur))
- (f2 (make-env '(0 .25 .06 .5 .1 .01 .3 .01 .5 .75 .6 .5 .64 .01 1 .01) :duration dur))
- (f3 (make-env '(0 1 .06 .5 .1 .01 .3 .01 .5 .01 .6 .3 .65 .01 .67 .01 1 .01) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env f1) (oscil gen1 frq))
- (* (env f2) (oscil gen2 (* 2 frq)))
- (* (env f3) (oscil gen3 (* 3 frq)))
- (* .005 (oscil gen4 (* 4 frq)))
- (* .005 (oscil gen5 (* 5 frq)))))))))))
+(defanimal (cassins-vireo beg amp)
+ (let ((dur 0.5))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+
+ (ampf (make-env '(0.000 0.000 0.028 0.110 0.037 0.062 0.050 0.098 0.060 0.075 0.078 0.179 0.085 0.065
+ 0.093 0.116 0.100 0.379 0.119 0.163 0.136 0.457 0.147 0.473 0.159 0.180 0.173 0.608
+ 0.182 0.655 0.193 0.001 0.200 0.292 0.210 0.180 0.219 0.262 0.224 0.103 0.241 0.204
+ 0.253 0.055 0.268 0.225 0.285 0.061 0.299 0.251 0.312 0.171 0.330 0.298 0.366 0.182
+ 0.375 0.138 0.384 0.159 0.391 0.000 0.512 0.000 0.527 0.085 0.539 0.267 0.553 0.111
+ 0.565 0.200 0.574 0.150 0.583 0.360 0.587 0.117 0.595 0.257 0.602 0.096 0.610 0.297
+ 0.623 0.072 0.635 0.241 0.640 0.201 0.653 0.336 0.669 0.996 0.679 0.730 0.689 0.235
+ 0.702 0.336 0.714 0.688 0.725 0.752 0.733 0.466 0.744 0.680 0.752 0.070 0.763 0.628
+ 0.766 0.567 0.774 0.671 0.786 0.094 0.792 0.514 0.797 0.099 0.800 0.187 0.807 0.224
+ 0.810 0.523 0.820 0.444 0.824 0.155 0.829 0.481 0.832 0.598 0.838 0.521 0.843 0.070
+ 0.847 0.209 0.857 0.476 0.862 0.294 0.873 0.775 0.880 0.175 0.884 0.495 0.888 0.083
+ 0.896 0.644 0.916 0.074 0.919 0.379 0.926 0.072 0.940 0.657 0.944 0.613 0.955 0.070
+ 0.960 0.181 0.966 0.087 0.970 0.111 0.975 0.069 0.981 0.173 0.989 0.021 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.069 0.028 0.063 0.060 0.075 0.078 0.110 0.100 0.144 0.121 0.159 0.141 0.162
+ 0.160 0.154 0.188 0.130 0.206 0.119 0.216 0.120 0.225 0.100 0.239 0.119 0.254 0.093
+ 0.265 0.117 0.281 0.094 0.298 0.120 0.325 0.129 0.356 0.133 0.382 0.128 0.395 0.100
+ 0.516 0.090 0.568 0.108 0.600 0.075 0.621 0.150 0.639 0.183 0.662 0.178 0.682 0.159
+ 0.703 0.155 0.721 0.139 0.735 0.157 0.753 0.123 0.769 0.148 0.784 0.124 0.795 0.159
+ 0.816 0.139 0.831 0.172 0.845 0.148 0.857 0.180 0.872 0.178 0.881 0.159 0.892 0.198
+ 0.908 0.178 0.922 0.206 0.942 0.194 0.957 0.212 0.982 0.199 1.000 0.179)
+ :duration dur :scaler (hz->radians 22050.0)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (gen4 (make-oscil))
+ (gen5 (make-oscil))
+ (f1 (make-env '(0 .01 .06 .01 .1 1 .3 1 .5 .01 .65 .05 .67 1 1 1) :duration dur))
+ (f2 (make-env '(0 .25 .06 .5 .1 .01 .3 .01 .5 .75 .6 .5 .64 .01 1 .01) :duration dur))
+ (f3 (make-env '(0 1 .06 .5 .1 .01 .3 .01 .5 .01 .6 .3 .65 .01 .67 .01 1 .01) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env f1) (oscil gen1 frq))
+ (* (env f2) (oscil gen2 (* 2.0 frq)))
+ (+ (* (env f3) (oscil gen3 (* 3.0 frq)))
+ (* .005 (oscil gen4 (* 4.0 frq)))
+ (* .005 (oscil gen5 (* 5.0 frq))))))))))))
;;; formants sounded bad here, polywave worse
;; (with-sound (:play #t) (cassins-vireo 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Plain chacalaca
@@ -5403,9 +5460,9 @@
(define (plain-chacalaca beg1 amp)
- (definstrument (plain-chacalaca-1 beg dur amp frmfrq frqlst)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
+ (defanimal (plain-chacalaca-1 beg dur amp frmfrq frqlst)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
(ampf (make-env '(0.000 0.000 2 1 4 1 6 0) :duration dur :scaler (* 0.5 amp)))
(frqf (make-env frqlst :duration dur :scaler (hz->radians 1.0)))
(frm1 (make-formant frmfrq .99))
@@ -5414,263 +5471,260 @@
(fr1 (* 2 20 (sin (hz->radians frmfrq))))
(fr2 (* 2 (sin (hz->radians 4200))))
(fr3 (* 2 8 (sin (hz->radians 2800))))
- (gen (make-nrcos 0.0 15 .75))
+ (gen (make-polywave 0.0 (nrcos->polywave 15 .75 1.0)))
(rnd (make-rand-interp 5000 .03))
(rnd1 (make-rand-interp 1000 .15))
(vib (make-blackman 50 4))
(vib-index (hz->radians -100)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((inp (* (env ampf)
- (+ .85 (abs (rand-interp rnd1)))
- (nrcos gen (+ (env frqf)
- (rand-interp rnd)
- (* vib-index (blackman vib)))))))
- (outa i (+ (* fr1 (formant frm1 inp))
- (* fr2 (formant frm2 inp))
- (* fr3 (formant frm3 inp)))))))))
-
- (plain-chacalaca-1 beg1 0.17 (* .7 amp) 1700 (list 0 450 1 680))
- (plain-chacalaca-1 (+ beg1 0.20) 0.12 amp 1400 (list 0 500 1 680 2 660))
- (plain-chacalaca-1 (+ beg1 0.35) 0.20 amp 1400 (list 0 500 1 680 4 660)))
+ (let ((fb (vector frm1 frm2 frm3))
+ (fs (float-vector fr1 fr2 fr3)))
+ (set! fb (make-formant-bank fb fs))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (formant-bank fb (* (+ .85 (abs (rand-interp rnd1)))
+ (polywave gen (+ (env frqf)
+ (rand-interp rnd)
+ (* vib-index (blackman vib))))))))))))
+
+ (plain-chacalaca-1 beg1 0.17 (* .7 amp) 1700 '(0 450 1 680))
+ (plain-chacalaca-1 (+ beg1 0.20) 0.12 amp 1400 '(0 500 1 680 2 660))
+ (plain-chacalaca-1 (+ beg1 0.35) 0.20 amp 1400 '(0 500 1 680 4 660)))
;; (with-sound (:play #t) (plain-chacalaca 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Black-billed cuckoo
-(definstrument (black-billed-cuckoo beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.68)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.013 0.388 0.023 0.303 0.026 0.419 0.042 0.530 0.066 0.104 0.128 0.000
- 0.215 0.000 0.243 0.642 0.257 0.536 0.266 0.725 0.296 0.737 0.311 0.044 0.357 0.070
- 0.367 0.000 0.421 0.000 0.448 0.856 0.460 0.807 0.468 0.913 0.483 0.960 0.515 0.928
- 0.535 0.048 0.575 0.085 0.584 0.000 0.638 0.000 0.658 0.903 0.674 0.989 0.708 0.822
- 0.732 0.079 0.781 0.038 0.798 0.070 0.806 0.028 0.823 0.059 0.845 0.000 0.883 0.000
- 0.892 0.593 0.913 0.739 0.940 0.031 0.976 0.066 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .97 2 .005 3 .008 5 .005)))
- (rnd (make-rand-interp 400 (hz->radians 25)))
- (frqf (make-env '(0.000 0.568 0.057 0.568 0.078 0.399 0.203 0.315 0.218 0.632 0.252 0.557 0.314 0.553
- 0.340 0.350 0.410 0.337 0.426 0.667 0.469 0.557 0.528 0.559 0.548 0.381 0.616 0.352
- 0.624 0.617 0.659 0.544 0.721 0.544 0.748 0.350 0.840 0.297 0.851 0.615 0.889 0.540
- 0.926 0.542 0.948 0.416 1.000 0.419)
- :duration dur :scaler (hz->radians 1190.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp rnd)))))))))
+(defanimal (black-billed-cuckoo beg amp)
+ (let ((dur 0.68))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.013 0.388 0.023 0.303 0.026 0.419 0.042 0.530 0.066 0.104 0.128 0.000
+ 0.215 0.000 0.243 0.642 0.257 0.536 0.266 0.725 0.296 0.737 0.311 0.044 0.357 0.070
+ 0.367 0.000 0.421 0.000 0.448 0.856 0.460 0.807 0.468 0.913 0.483 0.960 0.515 0.928
+ 0.535 0.048 0.575 0.085 0.584 0.000 0.638 0.000 0.658 0.903 0.674 0.989 0.708 0.822
+ 0.732 0.079 0.781 0.038 0.798 0.070 0.806 0.028 0.823 0.059 0.845 0.000 0.883 0.000
+ 0.892 0.593 0.913 0.739 0.940 0.031 0.976 0.066 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .97 2 .005 3 .008 5 .005)))
+ (rnd (make-rand-interp 400 (hz->radians 25)))
+ (frqf (make-env '(0.000 0.568 0.057 0.568 0.078 0.399 0.203 0.315 0.218 0.632 0.252 0.557 0.314 0.553
+ 0.340 0.350 0.410 0.337 0.426 0.667 0.469 0.557 0.528 0.559 0.548 0.381 0.616 0.352
+ 0.624 0.617 0.659 0.544 0.721 0.544 0.748 0.350 0.840 0.297 0.851 0.615 0.889 0.540
+ 0.926 0.542 0.948 0.416 1.000 0.419)
+ :duration dur :scaler (hz->radians 1190.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd)))))))))
;; (with-sound (:play #t) (black-billed-cuckoo 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Eared grebe
-(definstrument (eared-grebe beg amp)
+(defanimal (eared-grebe beg amp)
;; note #1
- (let* ((start (seconds->samples beg))
- (dur 0.3)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 9 1 10 0) :duration dur :scaler amp))
- (frqf (make-env '(0 1050 1 1400) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (gen4 (make-oscil))
- (gen5 (make-oscil))
- (f1 (make-env '(0 .03 9 .144 10 .1) :duration dur))
- (f2 (make-env '(0 .5 9 .844 10 .2) :duration dur))
- (f3 (make-env '(0 .01 9 .03 10 .02) :duration dur))
- (f4 (make-env '(0 0 1 .002 7 .003 10 0) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env f1) (oscil gen1 frq))
- (* (env f2) (oscil gen2 (* 2 frq)))
- (* (env f3) (oscil gen3 (* 3 frq)))
- (* (env f4) (oscil gen4 (* 4 frq)))
- (* .005 (oscil gen5 (* 5 frq))))))))))
+ (let ((dur 0.3))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 9 1 10 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 1050 1 1400) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (gen4 (make-oscil))
+ (gen5 (make-oscil))
+ (f1 (make-env '(0 .03 9 .144 10 .1) :duration dur))
+ (f2 (make-env '(0 .5 9 .844 10 .2) :duration dur))
+ (f3 (make-env '(0 .01 9 .03 10 .02) :duration dur))
+ (f4 (make-env '(0 0 1 .002 7 .003 10 0) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env f1) (oscil gen1 frq))
+ (* (env f2) (oscil gen2 (* 2.0 frq)))
+ (+ (* (env f3) (oscil gen3 (* 3.0 frq)))
+ (* (env f4) (oscil gen4 (* 4.0 frq)))
+ (* .005 (oscil gen5 (* 5.0 frq)))))))))))
;; note #2
- (let* ((start (seconds->samples (+ beg 0.29)))
- (dur 0.085)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 2 .5 2.9 1 3 0) :duration dur :scaler amp))
- (frqf (make-env '(0 2280 .25 2320 .6 2440 .65 3240 .8 3470 1 3260) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (f1 (make-env '(0 .5 .6 1 .62 .05 .65 .5 1 .5) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env f1) (oscil gen1 frq))
- (* .01 (oscil gen2 (* 2 frq))))))))))
+ (let ((dur 0.085)
+ (start (seconds->samples (+ beg 0.29))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0 0 1 1 2 .5 2.9 1 3 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 2280 .25 2320 .6 2440 .65 3240 .8 3470 1 3260) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (f1 (make-env '(0 .5 .6 1 .62 .05 .65 .5 1 .5) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env f1) (oscil gen1 frq))
+ (* .01 (oscil gen2 (* 2.0 frq))))))))))
;; note #3
- (let* ((start (seconds->samples (+ beg 0.446)))
- (dur 0.02)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 2.5 0) :duration dur :scaler (* .5 amp)))
- (frqf1 (make-env '(0 1120 .5 1540 1 1100) :duration dur :scaler (hz->radians 1.0)))
- (frqf2 (make-env '(0 2400 .5 2520 1 2300) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (gen4 (make-oscil))
- (f1 (make-env '(0 .9 .2 1 .6 1 .8 0 1 0) :duration dur))
- (f2 (make-env '(0 .5 .2 1 .6 .01 1 0) :duration dur))
- (f3 (make-env '(0 .1 .2 0 1 0) :duration dur))
- (f4 (make-env '(0 0 .2 0 .7 .25 1 .1) :duration dur))
- (rnd (make-rand-interp 3000 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq1 (+ (env frqf1)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (* (env f1) (oscil gen1 (* 2 frq1)))
- (* (env f2) (oscil gen2 frq1))
- (* (env f3) (oscil gen3 (* 3 frq1)))
- (* (env f4) (oscil gen4 (env frqf2)))))))))))
+ (let ((dur 0.02)
+ (start (seconds->samples (+ beg 0.446))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0 0 1 1 2.5 0) :duration dur :scaler (* .5 amp)))
+ (frqf1 (make-env '(0 1120 .5 1540 1 1100) :duration dur :scaler (hz->radians 1.0)))
+ (frqf2 (make-env '(0 2400 .5 2520 1 2300) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (gen4 (make-oscil))
+ (f1 (make-env '(0 .9 .2 1 .6 1 .8 0 1 0) :duration dur))
+ (f2 (make-env '(0 .5 .2 1 .6 .01 1 0) :duration dur))
+ (f3 (make-env '(0 .1 .2 0 1 0) :duration dur))
+ (f4 (make-env '(0 0 .2 0 .7 .25 1 .1) :duration dur))
+ (rnd (make-rand-interp 3000 (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq1 (+ (env frqf1)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (* (env f1) (oscil gen1 (* 2.0 frq1)))
+ (* (env f2) (oscil gen2 frq1))
+ (* (env f3) (oscil gen3 (* 3.0 frq1)))
+ (* (env f4) (oscil gen4 (env frqf2)))))))))))
;; (with-sound (:play #t :statistics #t) (eared-grebe 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Brown jay
-(definstrument (brown-jay beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.26)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.012 0.106 0.044 0.151 0.072 0.267 0.129 0.766 0.221 0.889 0.372 1.000
- 0.455 0.837 0.534 0.553 0.632 0.660 0.762 0.540 0.912 0.105 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .1 2 .9 3 .3 4 .07 5 .05 6 .2 7 .01 8 .005 9 .004 10 .003)))
- (gen2 (make-polywave :partials (list 2 .5 3 .1 4 .05)))
- (intrpf (make-env '(0 1 .5 1 .8 .6 1 0) :duration dur))
- (frqf (make-env '(0.000 0.201 0.052 0.201 0.091 0.271 0.143 0.285 0.631 0.288 0.659 0.268
- 0.858 0.257 .93 .2 1.000 0.22)
- :duration dur :scaler (hz->radians 4060.0)))
- (rnd (make-rand-interp 500 (hz->radians 15))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((intrp (env intrpf))
- (frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (* intrp (polywave gen1 frq))
- (* (- 1.0 intrp) (polywave gen2 frq))))))))))
+(defanimal (brown-jay beg amp)
+ (let ((dur 0.26))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.012 0.106 0.044 0.151 0.072 0.267 0.129 0.766 0.221 0.889 0.372 1.000
+ 0.455 0.837 0.534 0.553 0.632 0.660 0.762 0.540 0.912 0.105 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .1 2 .9 3 .3 4 .07 5 .05 6 .2 7 .01 8 .005 9 .004 10 .003)))
+ (gen2 (make-polywave 0.0 '( 2 .5 3 .1 4 .05)))
+ (intrpf (make-env '(0 1 .5 1 .8 .6 1 0) :duration dur))
+ (intrpf-1 (make-env '(0 1 .5 1 .8 .6 1 0) :duration dur :offset 1.0 :scaler -1.0))
+ (frqf (make-env '(0.000 0.201 0.052 0.201 0.091 0.271 0.143 0.285 0.631 0.288 0.659 0.268
+ 0.858 0.257 .93 .2 1.000 0.22)
+ :duration dur :scaler (hz->radians 4060.0)))
+ (rnd (make-rand-interp 500 (hz->radians 15))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf) (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (* (env intrpf) (polywave gen1 frq))
+ (* (env intrpf-1) (polywave gen2 frq))))))))))
;; (with-sound (:play #t) (brown-jay 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Blue grosbeak
-(definstrument (blue-grosbeak beg amp)
- (let* ((start (seconds->samples beg))
- (dur 2.26)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.010 0.029 0.019 0.110 0.032 0.024 0.055 0.260 0.058 0.003 0.062 0.034
- 0.071 0.282 0.078 0.000 0.119 0.000 0.124 0.057 0.129 0.335 0.134 0.410 0.138 0.035
- 0.143 0.464 0.146 0.430 0.150 0.034 0.156 0.593 0.162 0.513 0.167 0.355 0.172 0.319
- 0.175 0.000 0.213 0.000 0.222 0.279 0.223 0.099 0.226 0.224 0.228 0.055 0.232 0.087
- 0.238 0.503 0.249 0.663 0.253 0.025 0.255 0.060 0.256 0.435 0.261 0.468 0.274 0.000
- 0.315 0.000 0.326 0.426 0.333 0.046 0.342 0.499 0.349 0.658 0.351 0.090 0.355 0.868
- 0.360 0.677 0.367 0.000 0.390 0.000 0.399 0.673 0.400 0.270 0.403 0.949 0.406 0.934
- 0.418 0.002 0.429 0.072 0.442 0.240 0.449 0.528 0.455 0.585 0.458 0.533 0.464 0.000
- 0.484 0.000 0.487 0.323 0.491 0.187 0.495 0.439 0.505 0.683 0.513 0.000 0.526 0.000
- 0.534 0.784 0.541 0.648 0.545 0.781 0.548 0.160 0.553 0.734 0.569 0.077 0.572 0.097
- 0.580 0.532 0.583 0.505 0.589 0.000 0.620 0.000 0.627 0.520 0.631 0.543 0.637 0.071
- 0.641 0.402 0.653 0.846 0.656 0.075 0.662 1.000 0.674 0.000 0.696 0.000 0.702 0.155
- 0.703 0.361 0.705 0.046 0.710 0.491 0.719 0.133 0.723 0.091 0.730 0.074 0.735 0.110
- 0.744 0.406 0.753 0.467 0.758 0.053 0.760 0.007 0.765 0.029 0.771 0.481 0.774 0.539
- 0.781 0.000 0.820 0.000 0.823 0.168 0.825 0.045 0.827 0.005 0.830 0.050 0.831 0.360
- 0.834 0.047 0.837 0.017 0.843 0.441 0.844 0.086 0.848 0.036 0.854 0.437 0.857 0.085
- 0.860 0.231 0.864 0.626 0.869 0.136 0.873 0.324 0.880 0.081 0.883 0.344 0.888 0.076
- 0.890 0.045 0.893 0.235 0.899 0.000 0.932 0.000 0.942 0.091 0.946 0.007 0.951 0.035
- 0.956 0.104 0.963 0.319 0.970 0.424 0.973 0.065 0.976 0.011 0.977 0.058 0.980 0.244
- 0.992 0.059 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave :partials (list 1 .97 2 .03 3 .01 4 .005)))
- (frqf (make-env '(0.0000 0.5530 0.0090 0.5109 0.0278 0.3367 0.0521 0.5167 0.0589 0.7257 0.0718 0.5675
- 0.0756 0.4949 0.1252 0.4717 0.1282 0.5501 0.1354 0.3120 0.1418 0.4775 0.1495 0.3222
- 0.1568 0.4761 0.1649 0.3962 0.1717 0.4557 0.1743 0.3919 0.2174 0.3266 0.2213 0.3904
- 0.2234 0.5559 0.2268 0.3033 0.2358 0.3861 0.2456 0.4833 0.2499 0.5457 0.2525 0.7083
- 0.2563 0.5225 0.2597 0.4441 0.2704 0.3367 0.2994 0.3367 0.3093 0.5849 0.3165 0.5835
- 0.3217 0.4833 0.3268 0.4180 0.3319 0.2917 0.3353 0.4935 0.3396 0.4441 0.3456 0.4688
- 0.3481 0.5109 0.3520 0.7547 0.3537 0.5602 0.3584 0.5094 0.3635 0.4630 0.3904 0.5167
- 0.3934 0.7010 0.3947 0.5065 0.3964 0.6546 0.3981 0.4659 0.3998 0.7242 0.4020 0.5007
- 0.4032 0.6168 0.4041 0.5399 0.4075 0.4833 0.4122 0.3904 0.4186 0.2467 0.4421 0.3759
- 0.4541 0.4296 0.4724 0.4282 0.4776 0.3077 0.484 0.3091 0.488 0.4146 0.4920 0.3120
- 0.4964 0.4209 0.5015 0.4601 0.5058 0.4238 0.5088 0.3062 0.5203 0.3048 0.5229 0.6067
- 0.5284 0.6081 0.5344 0.5138 0.5412 0.4630 0.5451 0.5181 0.5481 0.6923 0.5515 0.5733
- 0.5540 0.4702 0.5592 0.4078 0.5716 0.3106 0.5805 0.4282 0.6010 0.4282 0.6168 0.3672
- 0.6215 0.3687 0.6232 0.5704 0.6258 0.4398 0.6314 0.4267 0.6369 0.2903 0.6416 0.4369
- 0.6489 0.4644 0.6536 0.5327 0.6561 0.7983 0.6587 0.6038 0.6617 0.5472 0.6702 0.4514
- 0.6822 0.4485 0.6890 0.3425 0.6980 0.3440 0.7031 0.3890 0.7053 0.7286 0.7074 0.5152
- 0.7172 0.3498 0.7258 0.3048 0.7347 0.3396 0.7428 0.4035 0.7531 0.5007 0.7612 0.7257
- 0.7800 0.5007 0.8232 0.5936 0.8249 0.7837 0.8300 0.6734 0.8334 0.5646 0.8351 0.7576
- 0.8394 0.6415 0.8428 0.5094 0.8462 0.7460 0.8484 0.6299 0.8526 0.4586 0.8578 0.6386
- 0.8620 0.4151 0.8672 0.5631 0.8710 0.3701 0.8770 0.4848 0.8804 0.3527 0.8855 0.4761
- 0.8902 0.3295 0.8958 0.4964 0.8975 0.2874 0.9381 0.2903 0.9436 0.5036 0.9470 0.2642
- 0.9680 0.4731 0.9718 0.5559 0.9765 0.7881 0.9795 0.5414 0.9889 0.3657 1.0000 0.3033)
- :base 10 :duration dur :scaler (hz->radians 7190.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (blue-grosbeak beg amp)
+ (let ((dur 2.26))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.010 0.029 0.019 0.110 0.032 0.024 0.055 0.260 0.058 0.003 0.062 0.034
+ 0.071 0.282 0.078 0.000 0.119 0.000 0.124 0.057 0.129 0.335 0.134 0.410 0.138 0.035
+ 0.143 0.464 0.146 0.430 0.150 0.034 0.156 0.593 0.162 0.513 0.167 0.355 0.172 0.319
+ 0.175 0.000 0.213 0.000 0.222 0.279 0.223 0.099 0.226 0.224 0.228 0.055 0.232 0.087
+ 0.238 0.503 0.249 0.663 0.253 0.025 0.255 0.060 0.256 0.435 0.261 0.468 0.274 0.000
+ 0.315 0.000 0.326 0.426 0.333 0.046 0.342 0.499 0.349 0.658 0.351 0.090 0.355 0.868
+ 0.360 0.677 0.367 0.000 0.390 0.000 0.399 0.673 0.400 0.270 0.403 0.949 0.406 0.934
+ 0.418 0.002 0.429 0.072 0.442 0.240 0.449 0.528 0.455 0.585 0.458 0.533 0.464 0.000
+ 0.484 0.000 0.487 0.323 0.491 0.187 0.495 0.439 0.505 0.683 0.513 0.000 0.526 0.000
+ 0.534 0.784 0.541 0.648 0.545 0.781 0.548 0.160 0.553 0.734 0.569 0.077 0.572 0.097
+ 0.580 0.532 0.583 0.505 0.589 0.000 0.620 0.000 0.627 0.520 0.631 0.543 0.637 0.071
+ 0.641 0.402 0.653 0.846 0.656 0.075 0.662 1.000 0.674 0.000 0.696 0.000 0.702 0.155
+ 0.703 0.361 0.705 0.046 0.710 0.491 0.719 0.133 0.723 0.091 0.730 0.074 0.735 0.110
+ 0.744 0.406 0.753 0.467 0.758 0.053 0.760 0.007 0.765 0.029 0.771 0.481 0.774 0.539
+ 0.781 0.000 0.820 0.000 0.823 0.168 0.825 0.045 0.827 0.005 0.830 0.050 0.831 0.360
+ 0.834 0.047 0.837 0.017 0.843 0.441 0.844 0.086 0.848 0.036 0.854 0.437 0.857 0.085
+ 0.860 0.231 0.864 0.626 0.869 0.136 0.873 0.324 0.880 0.081 0.883 0.344 0.888 0.076
+ 0.890 0.045 0.893 0.235 0.899 0.000 0.932 0.000 0.942 0.091 0.946 0.007 0.951 0.035
+ 0.956 0.104 0.963 0.319 0.970 0.424 0.973 0.065 0.976 0.011 0.977 0.058 0.980 0.244
+ 0.992 0.059 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .97 2 .03 3 .01 4 .005)))
+ (frqf (make-env '(0.0000 0.5530 0.0090 0.5109 0.0278 0.3367 0.0521 0.5167 0.0589 0.7257 0.0718 0.5675
+ 0.0756 0.4949 0.1252 0.4717 0.1282 0.5501 0.1354 0.3120 0.1418 0.4775 0.1495 0.3222
+ 0.1568 0.4761 0.1649 0.3962 0.1717 0.4557 0.1743 0.3919 0.2174 0.3266 0.2213 0.3904
+ 0.2234 0.5559 0.2268 0.3033 0.2358 0.3861 0.2456 0.4833 0.2499 0.5457 0.2525 0.7083
+ 0.2563 0.5225 0.2597 0.4441 0.2704 0.3367 0.2994 0.3367 0.3093 0.5849 0.3165 0.5835
+ 0.3217 0.4833 0.3268 0.4180 0.3319 0.2917 0.3353 0.4935 0.3396 0.4441 0.3456 0.4688
+ 0.3481 0.5109 0.3520 0.7547 0.3537 0.5602 0.3584 0.5094 0.3635 0.4630 0.3904 0.5167
+ 0.3934 0.7010 0.3947 0.5065 0.3964 0.6546 0.3981 0.4659 0.3998 0.7242 0.4020 0.5007
+ 0.4032 0.6168 0.4041 0.5399 0.4075 0.4833 0.4122 0.3904 0.4186 0.2467 0.4421 0.3759
+ 0.4541 0.4296 0.4724 0.4282 0.4776 0.3077 0.484 0.3091 0.488 0.4146 0.4920 0.3120
+ 0.4964 0.4209 0.5015 0.4601 0.5058 0.4238 0.5088 0.3062 0.5203 0.3048 0.5229 0.6067
+ 0.5284 0.6081 0.5344 0.5138 0.5412 0.4630 0.5451 0.5181 0.5481 0.6923 0.5515 0.5733
+ 0.5540 0.4702 0.5592 0.4078 0.5716 0.3106 0.5805 0.4282 0.6010 0.4282 0.6168 0.3672
+ 0.6215 0.3687 0.6232 0.5704 0.6258 0.4398 0.6314 0.4267 0.6369 0.2903 0.6416 0.4369
+ 0.6489 0.4644 0.6536 0.5327 0.6561 0.7983 0.6587 0.6038 0.6617 0.5472 0.6702 0.4514
+ 0.6822 0.4485 0.6890 0.3425 0.6980 0.3440 0.7031 0.3890 0.7053 0.7286 0.7074 0.5152
+ 0.7172 0.3498 0.7258 0.3048 0.7347 0.3396 0.7428 0.4035 0.7531 0.5007 0.7612 0.7257
+ 0.7800 0.5007 0.8232 0.5936 0.8249 0.7837 0.8300 0.6734 0.8334 0.5646 0.8351 0.7576
+ 0.8394 0.6415 0.8428 0.5094 0.8462 0.7460 0.8484 0.6299 0.8526 0.4586 0.8578 0.6386
+ 0.8620 0.4151 0.8672 0.5631 0.8710 0.3701 0.8770 0.4848 0.8804 0.3527 0.8855 0.4761
+ 0.8902 0.3295 0.8958 0.4964 0.8975 0.2874 0.9381 0.2903 0.9436 0.5036 0.9470 0.2642
+ 0.9680 0.4731 0.9718 0.5559 0.9765 0.7881 0.9795 0.5414 0.9889 0.3657 1.0000 0.3033)
+ :base 10 :duration dur :scaler (hz->radians 7190.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (blue-grosbeak 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Acorn woodpecker
-(definstrument (acorn-woodpecker beg1 amp1)
-
- (define (acorn-woodpecker-1 beg dur amp ampf frqf ampf2 ampf4 rndf)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-polywave :partials (list 1 .2 2 1 3 .01 4 .005)))
- (gen2 (make-polywave :partials (list 3 .5 5 1 6 .05 7 .1)))
- (gen3 (make-polywave :partials (list 5 .005 6 .01 7 .003 8 .005 9 .002 10 .005 11 .001 13 .003 15 .001)))
- (gen4 (make-oscil))
- (rnd (make-rand-interp 1000 (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* (env rndf)
- (rand-interp rnd))))
- (amp2 (env ampf2)))
- (outa i (* (env ampf)
- (+ (polywave gen1 (* 2 frq))
- (* amp2 (polywave gen2 frq))
- (* (- 1.0 amp2) 2 (polywave gen3 (* 2 frq)))
- (* (env ampf4) (oscil gen4 (* 6 frq)))))))))))
+(defanimal (acorn-woodpecker beg1 amp1)
+
+ (define (acorn-woodpecker-1 beg dur ampf frqf ampf2 ampf4 rndf)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen1 (make-polywave 0.0 '(1 .2 2 1 3 .01 4 .005)))
+ (gen2 (make-polywave 0.0 '(3 .5 5 1 6 .05 7 .1)))
+ (gen3 (make-polywave 0.0 (list 5 (* 2 .005) 6 (* 2 .01) 7 (* 2 .003) 8 (* 2 .005)
+ 9 (* 2 .002) 10 (* 2 .005) 11 (* 2 .001) 13 (* 2 .003) 15 (* 2 .001))))
+ (gen4 (make-oscil))
+ (rnd (make-rand-interp 1000 (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env rndf)
+ (rand-interp rnd))))
+ (amp2 (env ampf2)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 (* 2.0 frq))
+ (* amp2 (polywave gen2 frq))
+ (* (- 1.0 amp2) (polywave gen3 (* 2.0 frq)))
+ (* (env ampf4) (oscil gen4 (* 6.0 frq))))))))))
;; note #1
(let ((dur1 0.36))
- (acorn-woodpecker-1 beg1 dur1 amp1
+ (acorn-woodpecker-1 beg1 dur1
(make-env '(0.000 0.000 0.046 0.257 0.248 0.331 0.371 0.745 0.564 1.000 0.738 0.970 0.909 0.442 1.000 0.000)
:duration dur1 :scaler amp1)
(make-env '(0.000 0.430 0.054 0.526 0.171 0.534 0.244 0.591 0.284 0.603 0.317 0.630 0.378 0.639 0.414 0.658
@@ -5682,7 +5736,7 @@
(make-env '(0 .03 .85 .03 1 1) :duration dur1)))
;; note #2
(let ((dur1 0.35))
- (acorn-woodpecker-1 (+ beg1 0.55) dur1 amp1
+ (acorn-woodpecker-1 (+ beg1 0.55) dur1
(make-env '(0 0 .2 .1 .9 1 1 0) :duration dur1 :scaler amp1)
(make-env '(0.000 0.466 0.088 0.497 0.202 0.513 0.319 0.585 0.386 0.596 0.747 0.632
0.835 0.671 0.882 0.661 1.000 0.350)
@@ -5692,7 +5746,7 @@
(make-env '(0 .3 .05 .03 .8 .03 1 .3) :duration dur1 :base 10)))
;; note #3
(let ((dur1 0.34))
- (acorn-woodpecker-1 (+ beg1 1.17) dur1 amp1
+ (acorn-woodpecker-1 (+ beg1 1.17) dur1
(make-env '(0 0 .2 .1 .8 1 .9 1 1 0) :duration dur1 :scaler amp1)
(make-env '(0.000 0.310 0.076 0.331 0.118 0.388 0.184 0.422 0.239 0.484 0.336 0.544
0.720 0.549 0.831 0.581 0.896 0.570 0.920 0.630 0.938 0.604 1.000 0.448)
@@ -5701,147 +5755,150 @@
(make-env '(0 1 .2 1 .25 0 .4 0 .6 1 .7 0 .8 1 .9 1 1 1) :duration dur1 :scaler .3)
(make-env '(0 .1 .05 .03 .8 .03 1 .5) :duration dur1 :base 10))))
-;; (with-sound (:play #t) (acorn-woodpecker 0 .5))
+;; (with-sound (:play #t) (acorn-woodpecker 0 .3))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Lesser nighhawk
-(definstrument (lesser-nighthawk beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 2 1 10 1 11 0) :duration dur :scaler amp :base 10))
- (gen1 (make-polywave :partials (list 1 .94 3 .04 4 .01)))
- (pulse-dur .021)
- (pulsef (make-env '(0.000 0.000 .6 1 1 0) :base .1 :duration pulse-dur))
- (pulse-sep .047)
- (pulse-samps (seconds->samples pulse-sep))
- (next-pulse (+ start pulse-samps))
- (frqf (make-env (list 0 600 .5 620 (max .55 (- dur .5)) 620 (max .6 dur) 570) :duration dur :scaler (hz->radians 1.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (set! next-pulse (+ i pulse-samps))
- (mus-reset pulsef)))
- (outa i (* (env ampf)
- (env pulsef)
- (polywave gen1 (env frqf))))))))
+(defanimal (lesser-nighthawk beg dur amp)
+ (let ((pulse-dur .021)
+ (pulse-sep .047))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 2 1 10 1 11 0) :duration dur :scaler amp :base 10))
+ (gen1 #f)
+
+ (pulsef (make-env '(0.000 0.000 .6 1 1 0) :base .1 :duration pulse-dur))
+ (pulse-samps (seconds->samples pulse-sep))
+ (pulse-out (seconds->samples pulse-dur))
+ (frqf (make-env (list 0 600 .5 620 (max .55 (- dur .5)) 620 (max .6 dur) 570) :duration dur :scaler (hz->radians 1.0))))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location ampf) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-out)))
+ (pulse-amp (env ampf))
+ (pulse-frq (env frqf)))
+ (set! (mus-location frqf) (- i start))
+ (set! gen1 (make-polywave 0.0 (list 1 (* pulse-amp .94) 3 (* pulse-amp .04) 4 (* pulse-amp .01))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulsef)
+ (polywave gen1 pulse-frq))))
+ (mus-reset pulsef))))))
;; (with-sound (:play #t) (lesser-nighthawk 0 1 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Olive-sided flycatcher
-(definstrument (olive-sided-flycatcher beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.08)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.021 0.129 0.035 0.369 0.053 0.250 0.064 0.000 0.352 0.000 0.381 0.674
- 0.394 0.483 0.407 0.834 0.418 0.852 0.425 0.795 0.440 0.898 0.457 0.931 0.489 0.922
- 0.506 0.878 0.534 0.991 0.548 0.988 0.577 0.717 0.593 0.834 0.615 0.000 0.690 0.000
- 0.704 0.698 0.710 0.436 0.712 0.610 0.726 0.395 0.736 0.483 0.756 0.545 0.773 0.795
- 0.786 0.583 0.808 0.919 0.816 0.843 0.826 0.898 0.837 0.797 0.844 0.659 0.860 0.640
- 0.879 0.334 0.975 0.176 0.989 0.034 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.175 0.020 0.235 0.035 0.269 0.041 0.311 0.070 0.224 0.356 0.209 0.377 0.309
- 0.402 0.352 0.449 0.360 0.549 0.348 0.574 0.339 0.588 0.354 0.596 0.330 0.603 0.354
- 0.612 0.235 0.691 0.213 0.702 0.313 0.725 0.380 0.743 0.397 0.765 0.354 0.794 0.328
- 0.844 0.299 0.876 0.277 0.975 0.254 1.000 0.198)
- :duration dur :scaler (hz->radians 10100.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .03 3 .01 4 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (olive-sided-flycatcher beg amp)
+ (let ((dur 1.08))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.021 0.129 0.035 0.369 0.053 0.250 0.064 0.000 0.352 0.000 0.381 0.674
+ 0.394 0.483 0.407 0.834 0.418 0.852 0.425 0.795 0.440 0.898 0.457 0.931 0.489 0.922
+ 0.506 0.878 0.534 0.991 0.548 0.988 0.577 0.717 0.593 0.834 0.615 0.000 0.690 0.000
+ 0.704 0.698 0.710 0.436 0.712 0.610 0.726 0.395 0.736 0.483 0.756 0.545 0.773 0.795
+ 0.786 0.583 0.808 0.919 0.816 0.843 0.826 0.898 0.837 0.797 0.844 0.659 0.860 0.640
+ 0.879 0.334 0.975 0.176 0.989 0.034 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.175 0.020 0.235 0.035 0.269 0.041 0.311 0.070 0.224 0.356 0.209 0.377 0.309
+ 0.402 0.352 0.449 0.360 0.549 0.348 0.574 0.339 0.588 0.354 0.596 0.330 0.603 0.354
+ 0.612 0.235 0.691 0.213 0.702 0.313 0.725 0.380 0.743 0.397 0.765 0.354 0.794 0.328
+ 0.844 0.299 0.876 0.277 0.975 0.254 1.000 0.198)
+ :duration dur :scaler (hz->radians 10100.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .03 3 .01 4 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (olive-sided-flycatcher 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Red-shouldered hawk
;;;
;;; ending is not right
-(definstrument (red-shouldered-hawk beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.475)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.071 0.704 0.128 0.964 0.168 0.593 0.383 0.356 0.399 0.798 0.446 0.901
- 0.492 0.628 0.595 0.771 0.677 0.700 0.693 0.439 0.715 0.593 0.750 0.715 0.872 0.648
- 0.894 0.360 0.938 0.360 0.984 0.213 1.000 0.000)
- :duration dur :scaler (* 0.2 amp)))
- (frqf (make-env '(0.000 0.083 0.027 0.094 0.035 0.129 0.103 0.143 0.116 0.180 0.370 0.167 0.381 0.13
- 0.66 .114 .72 .116 .8 .112
- 0.871 0.105 0.888 0.080 0.976 0.078 1.000 0.08)
- :base .1 :duration dur :scaler (hz->radians (* 0.5 9130.0))))
- (histuff (make-polywave :partials (list 1 .1 2 .75 3 .1 4 .1 5 .01 6 .01 7 .01 8 .02 9 .01 11 .005 )))
- (lostuff (make-polywave :partials (list 2 .1 3 .3 5 .03 7 .1 9 .01 13 .1 15 .1 17 .05 19 .03)))
- (midstuff (make-polywave :partials (list 1 .3 3 .7)))
- (midf (make-env '(0 1 .3 1 .4 .1 1 0) :duration dur :scaler 1.0))
- (oddf (make-env '(0 1 .1 1 .12 .01 .45 .01 .55 .75 1 0) :duration dur :scaler 0.7 :base 10))
- (frm1 (make-formant 2300 .98))
- (frm2 (make-formant 3200 .99))
- (frm3 (make-formant 5300 .97))
- (frm4 (make-formant 1600 .99))
- (fr1 (* 2 10 (sin (hz->radians 2300))))
- (fr2 (* 2 3 (sin (hz->radians 3200))))
- (fr3 (* 2 5 (sin (hz->radians 5300))))
- (fr4 (* 2 5 (sin (hz->radians 1600))))
- (rnd (make-rand-interp 400 (hz->radians 10))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((frq (+ (env frqf)
- (rand-interp rnd)))
- (val (* (env ampf)
- (+ (* (polywave histuff (* 2 frq)))
- (* (env oddf)
- (polywave lostuff frq))
- (* (env midf)
- (polywave midstuff (* 2 frq)))))))
- (outa i (+ val
- (* fr1 (formant frm1 val) )
- (* fr2 (formant frm2 val) )
- (* fr3 (formant frm3 val))
- (* fr4 (formant frm4 val)))))))))
+(defanimal (red-shouldered-hawk beg amp)
+ (let ((dur 0.475))
+ (let ((start (seconds->samples beg))
+
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.071 0.704 0.128 0.964 0.168 0.593 0.383 0.356 0.399 0.798 0.446 0.901
+ 0.492 0.628 0.595 0.771 0.677 0.700 0.693 0.439 0.715 0.593 0.750 0.715 0.872 0.648
+ 0.894 0.360 0.938 0.360 0.984 0.213 1.000 0.000)
+ :duration dur :scaler (* 0.2 amp)))
+ (frqf (make-env '(0.000 0.083 0.027 0.094 0.035 0.129 0.103 0.143 0.116 0.180 0.370 0.167 0.381 0.13
+ 0.66 .114 .72 .116 .8 .112
+ 0.871 0.105 0.888 0.080 0.976 0.078 1.000 0.08)
+ :base .1 :duration dur :scaler (hz->radians (* 0.5 9130.0))))
+ (histuff (make-polywave 0.0 '(1 .1 2 .75 3 .1 4 .1 5 .01 6 .01 7 .01 8 .02 9 .01 11 .005 )))
+ (lostuff (make-polywave 0.0 '(2 .1 3 .3 5 .03 7 .1 9 .01 13 .1 15 .1 17 .05 19 .03)))
+ (midstuff (make-polywave 0.0 '(1 .3 3 .7)))
+ (midf (make-env '(0 1 .3 1 .4 .1 1 0) :duration dur :scaler 1.0))
+ (oddf (make-env '(0 1 .1 1 .12 .01 .45 .01 .55 .75 1 0) :duration dur :scaler 0.7 :base 10))
+ (frm1 (make-formant 2300 .98))
+ (frm2 (make-formant 3200 .99))
+ (frm3 (make-formant 5300 .97))
+ (frm4 (make-formant 1600 .99))
+ (fr1 (* 2 10 (sin (hz->radians 2300))))
+ (fr2 (* 2 3 (sin (hz->radians 3200))))
+ (fr3 (* 2 5 (sin (hz->radians 5300))))
+ (fr4 (* 2 5 (sin (hz->radians 1600))))
+ (rnd (make-rand-interp 400 (hz->radians 10))))
+ (let ((fb (vector frm1 frm2 frm3 frm4))
+ (fs (float-vector fr1 fr2 fr3 fr4)))
+ (set! fb (make-formant-bank fb fs))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let* ((frq (+ (env frqf)
+ (rand-interp rnd)))
+ (val (* (env ampf)
+ (+ (polywave histuff (* 2.0 frq))
+ (* (env oddf) (polywave lostuff frq))
+ (* (env midf) (polywave midstuff (* 2.0 frq)))))))
+ (outa i (+ val (formant-bank fb val)))))))))
;; (with-sound (:play #t) (red-shouldered-hawk 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Common yellowthroat
(define (common-yellowthroat beg1 amp1)
- (definstrument (common-yellowthroat-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .42)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.067 0.312 0.105 0.773 0.132 0.685 0.160 0.168 0.178 0.075 0.192 0.178
- 0.211 0.636 0.227 0.782 0.236 0.623 0.258 0.807 0.283 0.639 0.299 0.000 0.434 0.000
- 0.482 0.751 0.503 0.804 0.518 0.651 0.540 0.000 0.638 0.000 0.661 0.576 0.715 0.664
- 0.736 0.984 0.763 0.685 0.784 0.620 0.817 0.894 0.830 0.745 0.912 0.134 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.296 0.029 0.290 0.052 0.305 0.072 0.334 0.088 0.367 0.108 0.381 0.132 0.348
- 0.159 0.305 0.183 0.352 0.210 0.410 0.241 0.436 0.267 0.441 0.292 0.434 0.398 0.417
- 0.410 0.682 0.428 0.686 0.457 0.581 0.475 0.534 0.491 0.503 0.521 0.485 0.531 0.468
- 0.645 0.488 0.672 0.506 0.690 0.530 0.704 0.543 0.718 0.521 0.733 0.486 0.763 0.457
- 0.791 0.423 0.838 0.356 0.918 0.261 0.951 0.252 1.000 0.194)
- :duration dur :scaler (hz->radians 10150.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (defanimal (common-yellowthroat-1 beg amp)
+ (let ((dur .42))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.067 0.312 0.105 0.773 0.132 0.685 0.160 0.168 0.178 0.075 0.192 0.178
+ 0.211 0.636 0.227 0.782 0.236 0.623 0.258 0.807 0.283 0.639 0.299 0.000 0.434 0.000
+ 0.482 0.751 0.503 0.804 0.518 0.651 0.540 0.000 0.638 0.000 0.661 0.576 0.715 0.664
+ 0.736 0.984 0.763 0.685 0.784 0.620 0.817 0.894 0.830 0.745 0.912 0.134 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.296 0.029 0.290 0.052 0.305 0.072 0.334 0.088 0.367 0.108 0.381 0.132 0.348
+ 0.159 0.305 0.183 0.352 0.210 0.410 0.241 0.436 0.267 0.441 0.292 0.434 0.398 0.417
+ 0.410 0.682 0.428 0.686 0.457 0.581 0.475 0.534 0.491 0.503 0.521 0.485 0.531 0.468
+ 0.645 0.488 0.672 0.506 0.690 0.530 0.704 0.543 0.718 0.521 0.733 0.486 0.763 0.457
+ 0.791 0.423 0.838 0.356 0.918 0.261 0.951 0.252 1.000 0.194)
+ :duration dur :scaler (hz->radians 10150.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
(common-yellowthroat-1 beg1 (* 0.4 amp1))
(common-yellowthroat-1 (+ beg1 0.44) amp1)
@@ -5852,6 +5909,7 @@
;; (with-sound (:play #t) (common-yellowthroat 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Cassin's sparrow
@@ -5859,384 +5917,370 @@
(define (cassins-sparrow beg amp)
;; buzz1
- (let* ((start (seconds->samples beg))
- (dur 0.2)
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-polywave :partials (list 1 .95 2 .05)))
- (ampf (make-env '(0.000 0.000 0.139 0.174 0.302 0.577 0.492 0.601 0.720 0.415 0.853 0.628 0.962 0.945 1.000 0.000)
- :duration dur :scaler (* .3 amp)))
- (pulse-dur .0064)
- (pulse-samps (seconds->samples pulse-dur))
- (next-pulse (+ start pulse-samps))
- (pulse-frqf (make-env '(0 0 1 200 3 0) :duration pulse-dur :scaler (hz->radians 1.0)))
- (frqf (make-env '(0 5850 .2 6200 .3 6000 1 6100) :duration dur :scaler (hz->radians 1.0)))
- (pulse-ampf (make-env '(0.000 0.2 0.435 0.356 0.701 0.925 0.785 0.984 0.880 0.779 0.973 0.395 1.000 0.2) :duration pulse-dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (set! next-pulse (+ next-pulse pulse-samps))
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)))
- (outa i (* (env ampf)
- (env pulse-ampf)
- (polywave gen1 (+ (env pulse-frqf)
- (env frqf))))))))
+ (let ((dur 0.2)
+ (pulse-dur .0064)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .05)))
+ (ampf (make-env '(0.000 0.000 0.139 0.174 0.302 0.577 0.492 0.601 0.720 0.415 0.853 0.628 0.962 0.945 1.000 0.000)
+ :duration dur :scaler (* .3 amp)))
+ (pulse-samps (seconds->samples pulse-dur))
+ (pulse-frqf (make-env '(0 0 1 200 3 0) :duration pulse-dur :scaler (hz->radians 1.0)))
+ (frqf (make-env '(0 5850 .2 6200 .3 6000 1 6100) :duration dur :scaler (hz->radians 1.0)))
+ (pulse-ampf (make-env '(0.000 0.2 0.435 0.356 0.701 0.925 0.785 0.984 0.880 0.779 0.973 0.395 1.000 0.2) :duration pulse-dur)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env ampf)
+ (env pulse-ampf)
+ (polywave gen1 (+ (env pulse-frqf)
+ (env frqf))))))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf)))))
;; buzz2
- (let* ((start (seconds->samples (+ beg .2)))
- (dur 0.22)
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-polywave :partials (list 1 .95 2 .05)))
- (pulse-dur .022)
- (pulse-samps (seconds->samples pulse-dur))
- (next-pulse (+ start pulse-samps))
- (pulse-frqf (make-env '(0 5400 1 6700) :duration pulse-dur :scaler (hz->radians 1.0)))
- (pulse-ampf (make-env '(0 0 .1 0 .7 1 1 0) :duration pulse-dur :base .1 :scaler (* .6 amp)))
- (rnd (make-rand-interp 600 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (set! next-pulse (+ next-pulse pulse-samps))
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)))
- (outa i (* (env pulse-ampf)
- (polywave gen1 (+ (env pulse-frqf)
- (rand-interp rnd))))))))
-
+ (let ((dur 0.22)
+ (pulse-dur .022)
+ (start (seconds->samples (+ beg .2))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .05)))
+ (pulse-samps (seconds->samples pulse-dur))
+ (pulse-frqf (make-env '(0 5400 1 6700) :duration pulse-dur :scaler (hz->radians 1.0)))
+ (pulse-ampf (make-env '(0 0 .1 0 .7 1 1 0) :duration pulse-dur :base .1 :scaler (* .6 amp)))
+ (rnd (make-rand-interp 600 (hz->radians 100))))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env pulse-ampf)
+ (polywave gen1 (+ (env pulse-frqf)
+ (rand-interp rnd))))))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf)))))
+
;; buzz3
- (let* ((start (seconds->samples (+ beg .425)))
- (dur 0.51)
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .005)))
- (pulse-dur .051)
- (pulse-samps (seconds->samples 0.064))
- (next-pulse (+ start pulse-samps))
- (pulse-frqf (make-env '(0 5300 .1 5200 .2 5300 .3 6000 1 6000) :duration pulse-dur :scaler (hz->radians 1.0)))
- (pulse-ampf (make-env '(0 0 .1 .5 .2 0 .3 1 .4 .9 .8 1 1 0) :duration pulse-dur :scaler amp))
- (frqf (make-env '(0 100 .6 0 1 50) :duration dur :scaler (hz->radians 1.0)))
- (ampf (make-env '(0 .6 1 1) :duration dur))
- (rnd (make-rand-interp 600 (hz->radians 10))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (set! next-pulse (+ next-pulse pulse-samps))
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)))
- (outa i (* (env ampf)
- (env pulse-ampf)
- (polywave gen1 (+ (env pulse-frqf)
- (env frqf)
- (rand-interp rnd))))))))
+ (let ((dur 0.51)
+ (pulse-dur .051)
+ (start (seconds->samples (+ beg .425))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .005)))
+ (pulse-samps (seconds->samples 0.064))
+ (pulse-frqf (make-env '(0 5300 .1 5200 .2 5300 .3 6000 1 6000) :duration pulse-dur :scaler (hz->radians 1.0)))
+ (pulse-ampf (make-env '(0 0 .1 .5 .2 0 .3 1 .4 .9 .8 1 1 0) :duration pulse-dur :scaler amp))
+ (frqf (make-env '(0 100 .6 0 1 50) :duration dur :scaler (hz->radians 1.0)))
+ (ampf (make-env '(0 .6 1 1) :duration dur))
+ (rnd (make-rand-interp 600 (hz->radians 10))))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (* (env ampf)
+ (env pulse-ampf)
+ (polywave gen1 (+ (env pulse-frqf)
+ (env frqf)
+ (rand-interp rnd))))))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf)))))
;; 4 long pitches
- (let* ((start (seconds->samples (+ beg .95)))
- (dur 0.74)
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01)))
- (frqf (make-env '(0.000 0.446 0.014 0.403 0.054 0.385 0.121 0.376 0.248 0.374 0.274 0.367 0.290 0.198
- 0.308 0.166 0.339 0.159 0.418 0.162 0.545 0.162 0.674 0.162 0.714 0.164 0.718 0.458
- 0.735 0.451 0.743 0.415 0.761 0.403 0.847 0.387 1.000 0.387)
- :duration dur :scaler (hz->radians 22050.0)))
- (ampf (make-env '(0.000 0.000 0.025 0.833 0.062 0.951 0.087 0.882 0.120 1.000 0.172 0.961 0.226 0.849
- 0.238 0.666 0.253 0.000 0.299 0.000 0.319 0.689 0.329 0.679 0.346 0.000 0.409 0.000
- 0.450 0.593 0.478 0.689 0.537 0.767 0.649 0.626 0.666 0.469 0.679 0.000 0.737 0.000
- 0.771 0.816 0.784 0.698 0.795 0.911 0.828 0.895 0.853 0.774 0.882 0.734 0.942 0.603
- 0.979 0.475 0.992 0.325 1.000 0.000)
- :duration dur :scaler (* .9 amp))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf)))))))
+ (let ((dur 0.74)
+ (start (seconds->samples (+ beg .95))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01)))
+ (frqf (make-env '(0.000 0.446 0.014 0.403 0.054 0.385 0.121 0.376 0.248 0.374 0.274 0.367 0.290 0.198
+ 0.308 0.166 0.339 0.159 0.418 0.162 0.545 0.162 0.674 0.162 0.714 0.164 0.718 0.458
+ 0.735 0.451 0.743 0.415 0.761 0.403 0.847 0.387 1.000 0.387)
+ :duration dur :scaler (hz->radians 22050.0)))
+ (ampf (make-env '(0.000 0.000 0.025 0.833 0.062 0.951 0.087 0.882 0.120 1.000 0.172 0.961 0.226 0.849
+ 0.238 0.666 0.253 0.000 0.299 0.000 0.319 0.689 0.329 0.679 0.346 0.000 0.409 0.000
+ 0.450 0.593 0.478 0.689 0.537 0.767 0.649 0.626 0.666 0.469 0.679 0.000 0.737 0.000
+ 0.771 0.816 0.784 0.698 0.795 0.911 0.828 0.895 0.853 0.774 0.882 0.734 0.942 0.603
+ 0.979 0.475 0.992 0.325 1.000 0.000)
+ :duration dur :scaler (* .9 amp))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
;; last buzz
- (let* ((start (seconds->samples (+ beg 1.73)))
- (dur 0.32)
- (stop (+ start (seconds->samples dur)))
- (gen1 (make-oscil 3100.0))
- (ampf (make-env '(0 0 1 1 2 1 3 0) :base .3 :duration dur :scaler (* .4 amp)))
- (buzz (make-oscil 120))
- (rnd (make-rand-interp 400 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ .25 (* .75 (abs (oscil buzz))))
- (oscil gen1 (rand-interp rnd))))))))
+ (let ((dur 0.32)
+ (start (seconds->samples (+ beg 1.73))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (gen1 (make-oscil 3100.0))
+ (ampf (make-env '(0 0 1 1 2 1 3 0) :base .3 :duration dur :scaler (* .4 amp)))
+ (buzz (make-oscil 120))
+ (rnd (make-rand-interp 400 (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .25 (* .75 (abs (oscil buzz))))
+ (oscil gen1 (rand-interp rnd))))))))
;; (with-sound (:play #t) (cassins-sparrow 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Steller's jay
(define (stellers-jay beg1 amp1)
- (definstrument (stellers-jay-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .09)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.171 0.175 0.268 0.475 0.314 0.294 0.433 1.000 0.502 0.306 0.671 0.586
- 0.794 0.236 0.847 0.615 1.000 0.000)
- :duration dur :scaler amp))
- (frqf1 (make-env '(0.000 0.393 0.343 0.411 0.423 0.366 0.478 0.405 0.542 0.508 0.582 0.526 0.683 0.414
- 0.849 0.417 0.957 0.218 1.000 0.196)
- :duration dur :scaler (hz->radians 6050.0)))
- (frqf2 (make-env '(0.000 0.405 0.213 0.405 0.277 0.311 0.391 0.290 0.497 0.275 0.558 0.242 0.635 0.242
- 0.729 0.190 0.868 0.205 1.000 0.160)
- :duration dur :scaler (hz->radians 6050.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .1 3 .1)))
- (gen2 (make-polywave :partials (list 1 .95 2 .03 3 .01)))
- (ampf2 (make-env '(0 0 1 1 2 0) :duration dur :scaler .3))
- (rnd (make-rand-interp 8000 ))
-
- (frm1 (make-formant 2460 .99))
- (frm2 (make-formant 5200 .98))
- (frm3 (make-formant 8200 .97))
- (fr1 (* 2 5 (sin (hz->radians 2460))))
- (fr2 (* 2 5 (sin (hz->radians 5200))))
- (fr3 (* 2 2 (sin (hz->radians 8200))))
- (frmf (make-env '(0 5200 .7 4900 .9 2200 1 2000) :duration dur))
- (frmf3 (make-env '(0 8200 .7 8400 .9 4000 1 4000) :duration dur))
- (frmaf (make-env '(0 0 .6 .3 .9 .8 1 .5) :duration dur))
- (frmf1 (make-env '(0 2460 .7 2400 .9 1400 1 1500) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (set! (mus-frequency frm2) (env frmf))
- (set! (mus-frequency frm3) (env frmf3))
- (set! (mus-frequency frm1) (env frmf1))
-
- (let* ((fintrp (env frmaf))
- (val1 (* (env ampf)
- (+ (polywave gen1 (env frqf1))
- (* (env ampf2)
- (polywave gen2 (env frqf2))))))
- (val (* val1
- (rand-interp rnd))))
- (outa i (+ (* .75 val1)
- (* fr1 (- 1.0 fintrp) (formant frm1 val))
- (* fr2 fintrp (formant frm2 val))
- (* fr3 (formant frm3 val)))))))))
+ (defanimal (stellers-jay-1 beg amp)
+ (let ((dur .09))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.171 0.175 0.268 0.475 0.314 0.294 0.433 1.000 0.502 0.306 0.671 0.586
+ 0.794 0.236 0.847 0.615 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf1 (make-env '(0.000 0.393 0.343 0.411 0.423 0.366 0.478 0.405 0.542 0.508 0.582 0.526 0.683 0.414
+ 0.849 0.417 0.957 0.218 1.000 0.196)
+ :duration dur :scaler (hz->radians 6050.0)))
+ (frqf2 (make-env '(0.000 0.405 0.213 0.405 0.277 0.311 0.391 0.290 0.497 0.275 0.558 0.242 0.635 0.242
+ 0.729 0.190 0.868 0.205 1.000 0.160)
+ :duration dur :scaler (hz->radians 6050.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .1 3 .1)))
+ (gen2 (make-polywave 0.0 '(1 .95 2 .03 3 .01)))
+ (ampf2 (make-env '(0 0 1 1 2 0) :duration dur :scaler .3))
+ (rnd (make-rand-interp 8000 ))
+
+ (frm1 (make-formant 2460 .99))
+ (frm2 (make-formant 5200 .98))
+ (frm3 (make-formant 8200 .97))
+ (fr1 (* 2 5 (sin (hz->radians 2460))))
+ (fr2 (* 2 5 (sin (hz->radians 5200))))
+ (fr3 (* 2 2 (sin (hz->radians 8200))))
+ (frmaf (make-env '(0 0 .6 .3 .9 .8 1 .5) :duration dur))
+ (frmaf-1 (make-env '(0 0 .6 .3 .9 .8 1 .5) :duration dur :offset 1.0 :scaler -1.0))
+ (frmf (make-env '(0 5200 .7 4900 .9 2200 1 2000) :scaler (hz->radians 1.0) :duration dur))
+ (frmf3 (make-env '(0 8200 .7 8400 .9 4000 1 4000) :scaler (hz->radians 1.0) :duration dur))
+ (frmf1 (make-env '(0 2460 .7 2400 .9 1400 1 1500) :scaler (hz->radians 1.0) :duration dur)))
+
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let* ((val1 (* (env ampf)
+ (+ (polywave gen1 (env frqf1))
+ (* (env ampf2)
+ (polywave gen2 (env frqf2))))))
+ (frm-in (* val1 (rand-interp rnd))))
+ (outa i (+ (* 0.75 val1)
+ (* fr1 (env frmaf-1) (formant frm1 frm-in (env frmf1)))
+ (* fr2 (env frmaf) (formant frm2 frm-in (env frmf)))
+ (* fr3 (formant frm3 frm-in (env frmf3))))))))))
(do ((beg beg1 (+ beg .15))
(i 0 (+ i 1)))
((= i 6))
(stellers-jay-1 beg amp1)))
-;; (with-sound (:play #t) (stellers-jay 0 .5))
+;; (with-sound (:statistics #t) (stellers-jay 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Black rail
-(definstrument (black-rail beg amp)
+(defanimal (black-rail beg amp)
;; notes 1 and 2
- (let* ((start (seconds->samples beg))
- (dur 0.2)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.015 0.069 0.029 0.738 0.083 0.868 0.133 0.868 0.230 0.725 0.267 0.501
- 0.324 0.000 0.694 0.000 0.716 1.000 0.778 0.975 0.850 0.906 0.898 0.814 0.939 0.585
- 0.981 0.081 1.000 0.000)
- :duration dur :scaler (* 0.9 amp)))
- (frqf (make-env '(0.000 0.484 0.028 0.458 0.210 0.456 0.296 0.444 0.324 0.404 0.700 0.461 0.728 0.453
- 0.916 0.453 1.000 0.390)
- :duration dur :scaler (hz->radians (* 0.5 8150.0))))
- (gen1 (make-polywave :partials (list 1 .09 2 1 3 .07 4 .003 5 .01 6 .03 7 .005 9 .003)))
- (buzz (make-oscil 240))
- (buzz1 (make-oscil 240)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ .8 (* .2 (oscil buzz)))
- (polywave gen1 (+ (env frqf)
- (* (hz->radians 20)
- (oscil buzz1)))))))))
+ (let ((dur 0.2))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.015 0.069 0.029 0.738 0.083 0.868 0.133 0.868 0.230 0.725 0.267 0.501
+ 0.324 0.000 0.694 0.000 0.716 1.000 0.778 0.975 0.850 0.906 0.898 0.814 0.939 0.585
+ 0.981 0.081 1.000 0.000)
+ :duration dur :scaler (* 0.9 amp)))
+ (frqf (make-env '(0.000 0.484 0.028 0.458 0.210 0.456 0.296 0.444 0.324 0.404 0.700 0.461 0.728 0.453
+ 0.916 0.453 1.000 0.390)
+ :duration dur :scaler (hz->radians (* 0.5 8150.0))))
+ (gen1 (make-polywave 0.0 '(1 .09 2 1 3 .07 4 .003 5 .01 6 .03 7 .005 9 .003)))
+ (buzz (make-oscil 240))
+ (buzz1 (make-oscil 240))
+ (scl (hz->radians 20)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .8 (* .2 (oscil buzz)))
+ (polywave gen1 (+ (env frqf)
+ (* scl (oscil buzz1)))))))))
;; note 3
- (let* ((start (seconds->samples (+ beg .254)))
- (dur 0.21)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.031 0.980 0.106 0.725 0.141 0.811 0.182 0.567 0.225 0.779 0.272 0.473
- 0.318 0.648 0.375 0.292 0.410 0.585 0.467 0.212 0.507 0.335 0.550 0.192 0.585 0.301
- 0.643 0.155 0.678 0.261 0.721 0.152 0.756 0.201 0.811 0.172 0.845 0.052 0.879 0.140
- 0.924 0.066 1.000 0.000)
- :duration dur :scaler (* 0.4 amp)))
- (frqf (make-env '(0.000 0.000 0.003 0.366 0.027 0.469 0.047 0.516 0.086 0.478 0.107 0.516 0.130 0.537
- 0.155 0.507 0.178 0.472 0.201 0.510 0.227 0.528 0.249 0.501 0.273 0.463 0.291 0.496
- 0.317 0.516 0.342 0.484 0.364 0.437 0.386 0.484 0.413 0.504 0.439 0.460 0.461 0.422
- 0.482 0.466 0.507 0.493 0.528 0.451 0.547 0.398 0.569 0.434 0.599 0.469 0.619 0.431
- 0.642 0.383 0.661 0.425 0.678 0.454 0.707 0.410 0.731 0.372 0.774 0.422 0.815 0.336
- 0.867 0.372 0.905 0.319 1.000 0.304)
- :duration dur :scaler (hz->radians (* 0.25 8040.0))))
- (gen1 (make-polywave :partials (list 1 .1 2 1 3 .4 4 .1 5 .03 6 .005 7 .005 10 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.21)
+ (start (seconds->samples (+ beg .254))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.031 0.980 0.106 0.725 0.141 0.811 0.182 0.567 0.225 0.779 0.272 0.473
+ 0.318 0.648 0.375 0.292 0.410 0.585 0.467 0.212 0.507 0.335 0.550 0.192 0.585 0.301
+ 0.643 0.155 0.678 0.261 0.721 0.152 0.756 0.201 0.811 0.172 0.845 0.052 0.879 0.140
+ 0.924 0.066 1.000 0.000)
+ :duration dur :scaler (* 0.4 amp)))
+ (frqf (make-env '(0.000 0.000 0.003 0.366 0.027 0.469 0.047 0.516 0.086 0.478 0.107 0.516 0.130 0.537
+ 0.155 0.507 0.178 0.472 0.201 0.510 0.227 0.528 0.249 0.501 0.273 0.463 0.291 0.496
+ 0.317 0.516 0.342 0.484 0.364 0.437 0.386 0.484 0.413 0.504 0.439 0.460 0.461 0.422
+ 0.482 0.466 0.507 0.493 0.528 0.451 0.547 0.398 0.569 0.434 0.599 0.469 0.619 0.431
+ 0.642 0.383 0.661 0.425 0.678 0.454 0.707 0.410 0.731 0.372 0.774 0.422 0.815 0.336
+ 0.867 0.372 0.905 0.319 1.000 0.304)
+ :duration dur :scaler (hz->radians (* 0.25 8040.0))))
+ (gen1 (make-polywave 0.0 '(1 .1 2 1 3 .4 4 .1 5 .03 6 .005 7 .005 10 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (black-rail 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Pinyon jay
-(definstrument (pinyon-jay beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.3)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.008 0.035 0.013 0.118 0.024 0.032 0.087 0.596 0.111 0.617 0.159 0.460
- 0.188 0.546 0.240 0.876 0.293 1.000 0.345 0.991 0.377 0.938 0.436 0.959 0.501 0.764
- 0.537 0.534 0.628 0.442 0.718 0.466 0.812 0.386 0.858 0.316 0.903 0.342 0.949 0.094 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.100 0.075 0.163 0.130 0.185 0.192 0.207 0.327 0.245 0.385 0.256 0.558 0.200
- 0.724 0.207 0.806 0.209 0.875 0.180 0.944 0.138 1.000 0.134)
- :base .1 :duration dur :scaler (hz->radians (* 0.5 8160))))
- (gen1 (make-polywave :partials (list 1 .03 2 .8 3 .05 4 .01 5 .03 6 .075 7 .03 8 .008 9 .005 10 .005 11 .003)))
- (gen2 (make-oscil 0.0 (* 0.5 pi)))
- (ampf2 (make-env '(0 .2 .1 .2 .2 0 .4 .05 .8 .02 .9 .2 1 0) :duration dur :scaler 3))
- (rnd (make-rand-interp 1000 (hz->radians 10))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (oscil gen2 (* 3 frq)))))))))))
+(defanimal (pinyon-jay beg amp)
+ (let ((dur 0.3))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.008 0.035 0.013 0.118 0.024 0.032 0.087 0.596 0.111 0.617 0.159 0.460
+ 0.188 0.546 0.240 0.876 0.293 1.000 0.345 0.991 0.377 0.938 0.436 0.959 0.501 0.764
+ 0.537 0.534 0.628 0.442 0.718 0.466 0.812 0.386 0.858 0.316 0.903 0.342 0.949 0.094 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.100 0.075 0.163 0.130 0.185 0.192 0.207 0.327 0.245 0.385 0.256 0.558 0.200
+ 0.724 0.207 0.806 0.209 0.875 0.180 0.944 0.138 1.000 0.134)
+ :base .1 :duration dur :scaler (hz->radians (* 0.5 8160))))
+ (gen1 (make-polywave 0.0 '(1 .03 2 .8 3 .05 4 .01 5 .03 6 .075 7 .03 8 .008 9 .005 10 .005 11 .003)))
+ (gen2 (make-oscil 0.0 (* 0.5 pi)))
+ (ampf2 (make-env '(0 .2 .1 .2 .2 0 .4 .05 .8 .02 .9 .2 1 0) :duration dur :scaler 3))
+ (rnd (make-rand-interp 1000 (hz->radians 10))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (oscil gen2 (* 3.0 frq)))))))))))
;; (with-sound (:play #t) (pinyon-jay 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Sora
-(definstrument (sora beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.41)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.011 0.109 0.066 0.180 0.360 0.192 0.442 0.229 0.473 0.203 0.575 0.276
- 0.621 0.345 0.702 0.361 0.751 0.661 0.792 0.713 0.839 0.606 0.885 0.873 0.904 0.788
- 0.937 0.980 0.953 0.998 0.962 0.911 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.358 0.103 0.332 0.209 0.327 0.328 0.341 0.572 0.363 0.771 0.429 0.893 0.458
- 0.965 0.462 1.000 0.448)
- :duration dur :scaler (hz->radians (* 0.5 6020))))
- (gen1 (make-polywave :partials (list 1 .05 2 .9 3 .05 4 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (sora beg amp)
+ (let ((dur 0.41))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.011 0.109 0.066 0.180 0.360 0.192 0.442 0.229 0.473 0.203 0.575 0.276
+ 0.621 0.345 0.702 0.361 0.751 0.661 0.792 0.713 0.839 0.606 0.885 0.873 0.904 0.788
+ 0.937 0.980 0.953 0.998 0.962 0.911 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.358 0.103 0.332 0.209 0.327 0.328 0.341 0.572 0.363 0.771 0.429 0.893 0.458
+ 0.965 0.462 1.000 0.448)
+ :duration dur :scaler (hz->radians (* 0.5 6020))))
+ (gen1 (make-polywave 0.0 '(1 .05 2 .9 3 .05 4 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (sora 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Killdeer
-(definstrument (killdeer beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.88)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.015 0.477 0.028 0.499 0.054 0.172 0.078 0.107 0.184 0.199 0.212 0.177
- 0.245 0.249 0.275 0.291 0.364 0.688 0.388 0.714 0.416 0.944 0.436 0.906 0.451 0.998
- 0.478 0.000 0.535 0.000 0.551 0.976 0.564 1.000 0.582 0.981 0.610 0.838 0.634 0.908
- 0.661 0.782 0.682 0.000 0.732 0.000 0.735 0.562 0.746 0.709 0.798 0.554 0.814 0.579
- 0.825 0.472 0.837 0.000 0.910 0.000 0.915 0.392 0.920 0.554 0.947 0.458 0.962 0.341
- 0.978 0.370 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.373 0.013 0.471 0.029 0.487 0.052 0.449 0.074 0.422 0.244 0.442 0.319 0.453
- 0.353 0.456 0.412 0.458 0.454 0.464 0.471 0.442 0.477 0.389 0.537 0.378 0.539 0.436
- 0.551 0.464 0.586 0.460 0.649 0.462 0.673 0.444 0.684 0.404 0.736 0.373 0.742 0.422
- 0.758 0.440 0.820 0.440 0.835 0.416 0.839 0.382 0.911 0.353 0.912 0.393 0.924 0.420
- 0.941 0.409 0.959 0.404 0.982 0.413 1.000 0.396)
- :duration dur :scaler (hz->radians (* 0.25 10170.0))))
- (gen1 (make-polywave :partials (list 1 .04 2 1 3 .07 4 .04 5 .005)))
- (gen2 (make-polywave :partials (list 1 .01 2 .05 3 .03 4 1 5 .12 6 .1 7 .01 8 .05 9 .005)))
- (ampf2 (make-env '(0 0 .53 0 .64 .7 .67 0 .73 .1 .9 0 .91 .07 .94 0 1 0) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (polywave gen1 (* 2 frq))
- (* (env ampf2)
- (polywave gen2 frq))))))))))
+(defanimal (killdeer beg amp)
+ (let ((dur 0.88))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.015 0.477 0.028 0.499 0.054 0.172 0.078 0.107 0.184 0.199 0.212 0.177
+ 0.245 0.249 0.275 0.291 0.364 0.688 0.388 0.714 0.416 0.944 0.436 0.906 0.451 0.998
+ 0.478 0.000 0.535 0.000 0.551 0.976 0.564 1.000 0.582 0.981 0.610 0.838 0.634 0.908
+ 0.661 0.782 0.682 0.000 0.732 0.000 0.735 0.562 0.746 0.709 0.798 0.554 0.814 0.579
+ 0.825 0.472 0.837 0.000 0.910 0.000 0.915 0.392 0.920 0.554 0.947 0.458 0.962 0.341
+ 0.978 0.370 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.373 0.013 0.471 0.029 0.487 0.052 0.449 0.074 0.422 0.244 0.442 0.319 0.453
+ 0.353 0.456 0.412 0.458 0.454 0.464 0.471 0.442 0.477 0.389 0.537 0.378 0.539 0.436
+ 0.551 0.464 0.586 0.460 0.649 0.462 0.673 0.444 0.684 0.404 0.736 0.373 0.742 0.422
+ 0.758 0.440 0.820 0.440 0.835 0.416 0.839 0.382 0.911 0.353 0.912 0.393 0.924 0.420
+ 0.941 0.409 0.959 0.404 0.982 0.413 1.000 0.396)
+ :duration dur :scaler (hz->radians (* 0.25 10170.0))))
+ (gen1 (make-polywave 0.0 '(1 .04 2 1 3 .07 4 .04 5 .005)))
+ (gen2 (make-polywave 0.0 '(1 .01 2 .05 3 .03 4 1 5 .12 6 .1 7 .01 8 .05 9 .005)))
+ (ampf2 (make-env '(0 0 .53 0 .64 .7 .67 0 .73 .1 .9 0 .91 .07 .94 0 1 0) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 (* 2.0 frq))
+ (* (env ampf2)
+ (polywave gen2 frq))))))))))
;; (with-sound (:play #t) (killdeer 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Oak titmouse
(define (oak-titmouse beg1 amp1)
- (definstrument (oak-titmouse-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.117)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.019 0.149 0.034 0.099 0.058 0.121 0.067 0.041 0.099 0.032 0.117 0.061
- 0.147 0.510 0.170 0.537 0.182 0.138 0.195 0.066 0.228 0.058 0.247 0.086 0.258 0.151
- 0.269 0.701 0.290 0.382 0.305 0.537 0.319 0.128 0.341 0.041 0.363 0.077 0.383 0.173
- 0.400 0.989 0.412 0.613 0.433 0.545 0.443 0.475 0.452 0.631 0.461 0.139 0.477 0.061
- 0.501 0.086 0.516 0.149 0.530 0.979 0.548 0.601 0.558 0.504 0.576 0.524 0.589 0.183
- 0.606 0.080 0.633 0.094 0.648 0.180 0.671 0.979 0.686 0.549 0.705 0.815 0.718 0.214
- 0.731 0.131 0.757 0.100 0.773 0.146 0.788 0.315 0.805 0.876 0.822 0.606 0.834 0.503
- 0.849 0.544 0.865 0.120 0.888 0.079 0.910 0.121 0.924 0.182 0.940 0.542 0.959 0.430
- 0.972 0.183 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 7200 1 5200) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .97 2 .03)))
- (gen2 (make-oscil 63.5 (+ pi 1)))
- (vib-amp (hz->radians 1200)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (* vib-amp (oscil gen2))))))))))
-
- (definstrument (oak-titmouse-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.14)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.027 0.067 0.088 0.113 0.129 0.322 0.175 0.718 0.244 0.987 0.283 0.941
- 0.315 0.710 0.344 0.322 0.374 0.450 0.388 0.351 0.450 0.220 0.565 0.118 0.673 0.062
- 0.725 0.070 0.789 0.126 0.836 0.209 0.870 0.177 0.892 0.233 0.908 0.475 .92 .1 1 0)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.125 .04 .125 0.070 0.214 0.1 0.296 0.146 0.333 0.2 0.329 0.263 0.300 0.322 0.264
- 0.407 0.218 0.514 0.196 0.660 0.183 0.746 0.190 0.822 0.212 0.873 0.252 0.902 0.254 0.926 0.212 1.000 0.207)
- :duration dur :scaler (hz->radians 10230.0)))
- (gen1 (make-polywave :partials (list 1 .9 2 .05 3 .01 4 .01 5 .005)))
- (gen2 (make-polywave :partials (list 2 1 3 .5 4 .1)))
- (ampf2 (make-env '(0 1 .1 0 .8 0 1 1) :duration dur :scaler .5)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (polywave gen2 frq))))))))))
-
- (let ((amps (vct .5 1.0 1.0 .9)))
+ (defanimal (oak-titmouse-1 beg amp)
+ (let ((dur 0.117))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.019 0.149 0.034 0.099 0.058 0.121 0.067 0.041 0.099 0.032 0.117 0.061
+ 0.147 0.510 0.170 0.537 0.182 0.138 0.195 0.066 0.228 0.058 0.247 0.086 0.258 0.151
+ 0.269 0.701 0.290 0.382 0.305 0.537 0.319 0.128 0.341 0.041 0.363 0.077 0.383 0.173
+ 0.400 0.989 0.412 0.613 0.433 0.545 0.443 0.475 0.452 0.631 0.461 0.139 0.477 0.061
+ 0.501 0.086 0.516 0.149 0.530 0.979 0.548 0.601 0.558 0.504 0.576 0.524 0.589 0.183
+ 0.606 0.080 0.633 0.094 0.648 0.180 0.671 0.979 0.686 0.549 0.705 0.815 0.718 0.214
+ 0.731 0.131 0.757 0.100 0.773 0.146 0.788 0.315 0.805 0.876 0.822 0.606 0.834 0.503
+ 0.849 0.544 0.865 0.120 0.888 0.079 0.910 0.121 0.924 0.182 0.940 0.542 0.959 0.430
+ 0.972 0.183 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 7200 1 5200) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .97 2 .03)))
+ (gen2 (make-oscil 63.5 (+ pi 1)))
+ (vib-amp (hz->radians 1200)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (* vib-amp (oscil gen2))))))))))
+
+ (defanimal (oak-titmouse-2 beg amp)
+ (let ((dur 0.14))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.027 0.067 0.088 0.113 0.129 0.322 0.175 0.718 0.244 0.987 0.283 0.941
+ 0.315 0.710 0.344 0.322 0.374 0.450 0.388 0.351 0.450 0.220 0.565 0.118 0.673 0.062
+ 0.725 0.070 0.789 0.126 0.836 0.209 0.870 0.177 0.892 0.233 0.908 0.475 .92 .1 1 0)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.125 .04 .125 0.070 0.214 0.1 0.296 0.146 0.333 0.2 0.329 0.263 0.300 0.322 0.264
+ 0.407 0.218 0.514 0.196 0.660 0.183 0.746 0.190 0.822 0.212 0.873 0.252 0.902 0.254 0.926 0.212 1.000 0.207)
+ :duration dur :scaler (hz->radians 10230.0)))
+ (gen1 (make-polywave 0.0 '(1 .9 2 .05 3 .01 4 .01 5 .005)))
+ (gen2 (make-polywave 0.0 '(2 1 3 .5 4 .1)))
+ (ampf2 (make-env '(0 1 .1 0 .8 0 1 1) :duration dur :scaler .5)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (polywave gen2 frq))))))))))
+
+ (let ((amps (vector .5 1.0 1.0 .9)))
(do ((i 0 (+ i 1))
(bg beg1 (+ bg .35)))
((= i 4))
@@ -6246,6 +6290,7 @@
;; (with-sound (:play #t) (oak-titmouse 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Macgillivray's warbler
@@ -6253,87 +6298,85 @@
(define (macgillivrays-warbler beg1 amp1)
;; much more complex than it sounds -- like the Hermit Thrush, this has 2 independent sources
- (definstrument (macgillivrays-warbler-1 beg amp)
+ (defanimal (macgillivrays-warbler-1 beg amp)
;; 5 of these to start
- (let* ((start (seconds->samples beg))
- (dur 0.137)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.066 0.200 0.208 0.310 0.228 0.400 0.259 0.403 0.331 0.175 0.370 0.377
- 0.414 0.166 0.462 0.639 0.475 0.149 0.495 0.648 0.612 0.992 0.647 0.924 0.700 0.473
- 0.710 0.138 0.720 0.654 0.770 0.352 0.815 0.848 0.829 0.724 0.840 0.837 0.864 0.625
- 0.891 0.715 0.937 0.687 0.989 0.456 1.000 0.000)
- :duration dur :scaler (* .75 amp)))
-
- (frqf1 (make-env '(0.000 0.515 0.096 0.506 0.193 0.475 0.287 0.421 0.358 0.362 0.470 0.346 0.495 0.588
- 0.532 0.593 0.567 0.607 0.625 0.635 0.680 0.711 0.711 0.739 0.735 0.800 0.762 0.800
- 0.785 0.645 0.808 0.565 0.851 0.551 1.000 0.544)
- :duration dur :scaler (hz->radians 8830.0)))
- (ampf1 (make-env '(0 1 .35 1 .356 0 .49 0 .494 1 .73 1 .735 .25 .8 .25 .81 1 1 1) :duration dur))
- (gen1 (make-polywave :partials (list 1 .97 2 .02 3 .005)))
-
- (frqf2 (make-env '(0.000 0.515 0.326 0.522 0.370 0.454 0.413 0.416 0.419 0.492 0.427 0.586 0.451 0.534
- 0.472 0.461 0.493 0.593 0.540 0.598 0.587 0.614 0.647 0.656 0.698 0.725 0.728 0.562
- 0.758 0.492 0.788 0.468 0.803 0.501 0.814 0.555 1.000 0.544)
- :duration dur :scaler (hz->radians 8830.0)))
- (ampf2 (make-env '(0 0 .324 0 .327 .5 .73 .5 .735 1 .8 1 .81 0 1 0) :duration dur))
- (gen2 (make-polywave :partials (list 1 .97 2 .02 3 .005)))
-
- (rnd (make-rand-interp 6000 .1)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ .9 (rand-interp rnd))
- (+ (* (env ampf1)
- (polywave gen1 (env frqf1)))
- (* (env ampf2)
- (polywave gen2 (env frqf2))))))))))
-
- (definstrument (macgillivrays-warbler-2 beg amp)
+ (let ((dur 0.137))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.066 0.200 0.208 0.310 0.228 0.400 0.259 0.403 0.331 0.175 0.370 0.377
+ 0.414 0.166 0.462 0.639 0.475 0.149 0.495 0.648 0.612 0.992 0.647 0.924 0.700 0.473
+ 0.710 0.138 0.720 0.654 0.770 0.352 0.815 0.848 0.829 0.724 0.840 0.837 0.864 0.625
+ 0.891 0.715 0.937 0.687 0.989 0.456 1.000 0.000)
+ :duration dur :scaler (* .75 amp)))
+
+ (frqf1 (make-env '(0.000 0.515 0.096 0.506 0.193 0.475 0.287 0.421 0.358 0.362 0.470 0.346 0.495 0.588
+ 0.532 0.593 0.567 0.607 0.625 0.635 0.680 0.711 0.711 0.739 0.735 0.800 0.762 0.800
+ 0.785 0.645 0.808 0.565 0.851 0.551 1.000 0.544)
+ :duration dur :scaler (hz->radians 8830.0)))
+ (ampf1 (make-env '(0 1 .35 1 .356 0 .49 0 .494 1 .73 1 .735 .25 .8 .25 .81 1 1 1) :duration dur))
+ (gen1 (make-polywave 0.0 '(1 .97 2 .02 3 .005)))
+
+ (frqf2 (make-env '(0.000 0.515 0.326 0.522 0.370 0.454 0.413 0.416 0.419 0.492 0.427 0.586 0.451 0.534
+ 0.472 0.461 0.493 0.593 0.540 0.598 0.587 0.614 0.647 0.656 0.698 0.725 0.728 0.562
+ 0.758 0.492 0.788 0.468 0.803 0.501 0.814 0.555 1.000 0.544)
+ :duration dur :scaler (hz->radians 8830.0)))
+ (ampf2 (make-env '(0 0 .324 0 .327 .5 .73 .5 .735 1 .8 1 .81 0 1 0) :duration dur))
+ (gen2 (make-polywave 0.0 '(1 .97 2 .02 3 .005)))
+
+ (rnd (make-rand-interp 6000 .1)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .9 (rand-interp rnd))
+ (+ (* (env ampf1)
+ (polywave gen1 (env frqf1)))
+ (* (env ampf2)
+ (polywave gen2 (env frqf2))))))))))
+
+ (defanimal (macgillivrays-warbler-2 beg amp)
;; 3 of these to end
- (let* ((start (seconds->samples beg))
- (dur 0.135)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.031 0.052 0.184 0.078 0.275 0.254 0.311 0.285 0.327 0.461 0.377 0.635
- 0.455 0.216 0.521 0.426 0.533 0.605 0.601 0.991 0.619 0.951 0.628 0.584 0.674 0.318
- 0.711 0.440 0.732 0.680 0.771 0.581 0.806 0.315 0.857 0.256 0.892 0.132 0.949 0.108 1.000 0.000)
- :duration dur :scaler amp))
-
- (frqf1 (make-env '(0.000 0.202 0.048 0.277 0.077 0.289 0.106 0.268 0.130 0.286 0.152 0.275 0.169 0.232
- 0.202 0.216 0.229 0.232 0.264 0.277 0.292 0.291 0.324 0.310 0.351 0.340 0.382 0.303
- 0.430 0.329 0.470 0.366 0.533 0.408 0.612 0.479 0.638 0.575 0.712 0.343 0.730 0.286
- 0.750 0.258 0.778 0.272 0.804 0.312 0.826 0.345 0.852 0.352 0.891 0.317 0.934 0.286 1.000 0.2)
- :duration dur :scaler (hz->radians 9140.0)))
- (ampf1 (make-env '(0 1 .1 .4 .3 .1 .5 .2 .63 .2 .64 0 .71 0 .72 .1 .8 1 1 1) :duration dur))
- (gen1 (make-polywave :partials (list 1 .6 2 .4 3 .005)))
-
- (frqf2 (make-env '(0.000 0.357 0.196 0.357 0.275 0.373 0.310 0.413 0.350 0.446 0.385 0.484 0.425 0.538
- 0.462 0.540 0.470 0.373 0.535 0.418 0.591 0.462 0.621 0.500 0.637 0.573 0.667 0.392
- 0.712 0.406 0.744 0.455 0.778 0.462 0.833 0.556 1.000 0.32)
- :duration dur :scaler (hz->radians 9140.0)))
- (ampf2 (make-env '(0 0 .19 0 .195 1 .45 .1 .46 0 .47 1 .63 1 .64 0 .67 0 .68 1 .82 1 .83 0 1 0) :duration dur))
- (gen2 (make-polywave :partials (list 1 .99 2 .01)))
-
- (rnd1 (make-rand-interp 600 (hz->radians 40)))
- (rnd (make-rand-interp 6000 .1)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ .9 (rand-interp rnd))
- (+ (* (env ampf1)
- (polywave gen1 (env frqf1)))
- (* (env ampf2)
- (polywave gen2 (+ (env frqf2)
- (rand-interp rnd1)))))))))))
-
- (let ((amps (vct .4 .6 .8 .9 1.0)))
+ (let ((dur 0.135))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.031 0.052 0.184 0.078 0.275 0.254 0.311 0.285 0.327 0.461 0.377 0.635
+ 0.455 0.216 0.521 0.426 0.533 0.605 0.601 0.991 0.619 0.951 0.628 0.584 0.674 0.318
+ 0.711 0.440 0.732 0.680 0.771 0.581 0.806 0.315 0.857 0.256 0.892 0.132 0.949 0.108 1.000 0.000)
+ :duration dur :scaler amp))
+
+ (frqf1 (make-env '(0.000 0.202 0.048 0.277 0.077 0.289 0.106 0.268 0.130 0.286 0.152 0.275 0.169 0.232
+ 0.202 0.216 0.229 0.232 0.264 0.277 0.292 0.291 0.324 0.310 0.351 0.340 0.382 0.303
+ 0.430 0.329 0.470 0.366 0.533 0.408 0.612 0.479 0.638 0.575 0.712 0.343 0.730 0.286
+ 0.750 0.258 0.778 0.272 0.804 0.312 0.826 0.345 0.852 0.352 0.891 0.317 0.934 0.286 1.000 0.2)
+ :duration dur :scaler (hz->radians 9140.0)))
+ (ampf1 (make-env '(0 1 .1 .4 .3 .1 .5 .2 .63 .2 .64 0 .71 0 .72 .1 .8 1 1 1) :duration dur))
+ (gen1 (make-polywave 0.0 '(1 .6 2 .4 3 .005)))
+
+ (frqf2 (make-env '(0.000 0.357 0.196 0.357 0.275 0.373 0.310 0.413 0.350 0.446 0.385 0.484 0.425 0.538
+ 0.462 0.540 0.470 0.373 0.535 0.418 0.591 0.462 0.621 0.500 0.637 0.573 0.667 0.392
+ 0.712 0.406 0.744 0.455 0.778 0.462 0.833 0.556 1.000 0.32)
+ :duration dur :scaler (hz->radians 9140.0)))
+ (ampf2 (make-env '(0 0 .19 0 .195 1 .45 .1 .46 0 .47 1 .63 1 .64 0 .67 0 .68 1 .82 1 .83 0 1 0) :duration dur))
+ (gen2 (make-polywave 0.0 '(1 .99 2 .01)))
+
+ (rnd1 (make-rand-interp 600 (hz->radians 40)))
+ (rnd (make-rand-interp 6000 .1)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .9 (rand-interp rnd))
+ (+ (* (env ampf1)
+ (polywave gen1 (env frqf1)))
+ (* (env ampf2)
+ (polywave gen2 (+ (env frqf2)
+ (rand-interp rnd1)))))))))))
+
+ (let ((amps (vector .4 .6 .8 .9 1.0)))
(do ((note 0 (+ 1 note))
(bg beg1 (+ bg 0.18)))
((= note 5))
(macgillivrays-warbler-1 bg (* amp1 (amps note)))))
- (let ((amps (vct 1.0 .9 .7)))
+ (let ((amps (vector 1.0 .9 .7)))
(do ((note 0 (+ 1 note))
(bg (+ beg1 0.93) (+ bg 0.17)))
((= note 3))
@@ -6342,60 +6385,61 @@
;; (with-sound (:play #t) (macgillivrays-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Hutton's vireo
-(definstrument (huttons-vireo beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.4)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.054 0.080 0.063 0.040 0.078 0.086 0.113 0.107 0.136 0.061 0.148 0.086
- 0.155 0.066 0.161 0.123 0.176 0.087 0.184 0.112 0.204 0.067 0.214 0.070 0.220 0.055
- 0.226 0.077 0.233 0.034 0.239 0.083 0.246 0.032 0.254 0.081 0.260 0.038 0.265 0.067
- 0.274 0.040 0.281 0.074 0.287 0.043 0.293 0.060 0.300 0.014 0.307 0.066 0.315 0.018
- 0.320 0.074 0.330 0.021 0.335 0.070 0.342 0.025 0.351 0.069 0.355 0.017 0.360 0.051
- 0.375 0.040 0.380 0.063 0.388 0.023 0.396 0.077 0.404 0.025 0.410 0.081 0.417 0.032
- 0.425 0.089 0.428 0.058 0.435 0.047 0.441 0.093 0.447 0.041 0.456 0.116 0.463 0.044
- 0.471 0.138 0.479 0.061 0.489 0.150 0.497 0.070 0.506 0.191 0.510 0.124 0.514 0.089
- 0.521 0.211 0.526 0.138 0.530 0.121 0.537 0.234 0.547 0.103 0.556 0.263 0.561 0.204
- 0.567 0.213 0.571 0.319 0.578 0.286 0.580 0.237 0.586 0.292 0.591 0.234 0.594 0.288
- 0.600 0.132 0.602 0.217 0.606 0.262 0.611 0.420 0.614 0.357 0.617 0.162 0.630 0.472
- 0.636 0.132 0.649 0.587 0.657 0.133 0.666 0.587 0.671 0.380 0.677 0.271 0.683 0.640
- 0.692 0.343 0.696 0.248 0.704 0.680 0.711 0.358 0.715 0.288 0.721 0.779 0.731 0.204
- 0.736 0.357 0.739 0.776 0.745 0.882 0.753 0.320 0.760 0.695 0.769 0.994 0.775 0.322
- 0.781 0.662 0.789 0.856 0.794 0.582 0.797 0.240 0.801 0.608 0.809 0.825 0.816 0.877
- 0.823 0.311 0.830 0.900 0.834 0.877 0.838 0.758 0.844 0.809 0.858 0.605 0.867 0.879
- 0.879 0.819 0.883 0.968 0.890 0.969 0.898 0.885 0.912 0.862 0.919 0.776 0.934 0.769
- 0.940 0.740 0.952 0.565 0.969 0.485 0.974 0.403 0.982 0.389 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.0000 0.4927 0.0133 0.5498 0.0177 0.6092 0.0275 0.8519 0.0276 0.5073 0.0413 0.8422
- 0.0428 0.4454 0.0624 0.5510 0.0954 0.5534 0.1264 0.5570 0.1391 0.5194 0.1632 0.5522
- 0.1750 0.4976 0.1912 0.5437 0.1996 0.4672 0.2055 0.5413 0.2134 0.4660 0.2207 0.5413
- 0.2266 0.4454 0.2335 0.5388 0.2380 0.4357 0.2458 0.5352 0.2522 0.4357 0.2596 0.5243
- 0.2635 0.4320 0.2699 0.5182 0.2788 0.4296 0.2842 0.5061 0.2935 0.4248 0.2999 0.5061
- 0.3068 0.4260 0.3147 0.5000 0.3210 0.4248 0.3289 0.4939 0.3358 0.4187 0.3422 0.4782
- 0.3500 0.4223 0.3569 0.4721 0.3658 0.4223 0.3736 0.4794 0.3800 0.4211 0.3884 0.4745
- 0.3948 0.4199 0.4036 0.4745 0.4105 0.4126 0.4174 0.4721 0.4258 0.4090 0.4341 0.4733
- 0.4410 0.4066 0.4489 0.4648 0.4577 0.4053 0.4656 0.4648 0.4730 0.3993 0.4823 0.4697
- 0.4887 0.3993 0.4990 0.4709 0.5059 0.4005 0.5143 0.4769 0.5236 0.3968 0.5339 0.4879
- 0.5393 0.3993 0.5521 0.4988 0.5590 0.4029 0.5674 0.5024 0.5777 0.4053 0.5870 0.5097
- 0.5954 0.4090 0.6057 0.5146 0.6121 0.4150 0.6229 0.5303 0.6332 0.4187 0.6416 0.5437
- 0.6529 0.4284 0.6618 0.5437 0.6711 0.4308 0.6814 0.5413 0.6868 0.4345 0.6986 0.5473
- 0.7065 0.4393 0.7183 0.5510 0.7281 0.4430 0.7404 0.5558 0.7557 0.4490 0.7630 0.5595
- 0.7763 0.4563 0.7861 0.5558 0.7984 0.4612 0.8117 0.5680 0.8265 0.5231 0.9641 0.5095
- 0.9754 0.3944 0.9823 0.4); 1 .4)
- :duration dur :scaler (hz->radians 7500.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .03 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (huttons-vireo beg amp)
+ (let ((dur 0.4))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.054 0.080 0.063 0.040 0.078 0.086 0.113 0.107 0.136 0.061 0.148 0.086
+ 0.155 0.066 0.161 0.123 0.176 0.087 0.184 0.112 0.204 0.067 0.214 0.070 0.220 0.055
+ 0.226 0.077 0.233 0.034 0.239 0.083 0.246 0.032 0.254 0.081 0.260 0.038 0.265 0.067
+ 0.274 0.040 0.281 0.074 0.287 0.043 0.293 0.060 0.300 0.014 0.307 0.066 0.315 0.018
+ 0.320 0.074 0.330 0.021 0.335 0.070 0.342 0.025 0.351 0.069 0.355 0.017 0.360 0.051
+ 0.375 0.040 0.380 0.063 0.388 0.023 0.396 0.077 0.404 0.025 0.410 0.081 0.417 0.032
+ 0.425 0.089 0.428 0.058 0.435 0.047 0.441 0.093 0.447 0.041 0.456 0.116 0.463 0.044
+ 0.471 0.138 0.479 0.061 0.489 0.150 0.497 0.070 0.506 0.191 0.510 0.124 0.514 0.089
+ 0.521 0.211 0.526 0.138 0.530 0.121 0.537 0.234 0.547 0.103 0.556 0.263 0.561 0.204
+ 0.567 0.213 0.571 0.319 0.578 0.286 0.580 0.237 0.586 0.292 0.591 0.234 0.594 0.288
+ 0.600 0.132 0.602 0.217 0.606 0.262 0.611 0.420 0.614 0.357 0.617 0.162 0.630 0.472
+ 0.636 0.132 0.649 0.587 0.657 0.133 0.666 0.587 0.671 0.380 0.677 0.271 0.683 0.640
+ 0.692 0.343 0.696 0.248 0.704 0.680 0.711 0.358 0.715 0.288 0.721 0.779 0.731 0.204
+ 0.736 0.357 0.739 0.776 0.745 0.882 0.753 0.320 0.760 0.695 0.769 0.994 0.775 0.322
+ 0.781 0.662 0.789 0.856 0.794 0.582 0.797 0.240 0.801 0.608 0.809 0.825 0.816 0.877
+ 0.823 0.311 0.830 0.900 0.834 0.877 0.838 0.758 0.844 0.809 0.858 0.605 0.867 0.879
+ 0.879 0.819 0.883 0.968 0.890 0.969 0.898 0.885 0.912 0.862 0.919 0.776 0.934 0.769
+ 0.940 0.740 0.952 0.565 0.969 0.485 0.974 0.403 0.982 0.389 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.0000 0.4927 0.0133 0.5498 0.0177 0.6092 0.0275 0.8519 0.0276 0.5073 0.0413 0.8422
+ 0.0428 0.4454 0.0624 0.5510 0.0954 0.5534 0.1264 0.5570 0.1391 0.5194 0.1632 0.5522
+ 0.1750 0.4976 0.1912 0.5437 0.1996 0.4672 0.2055 0.5413 0.2134 0.4660 0.2207 0.5413
+ 0.2266 0.4454 0.2335 0.5388 0.2380 0.4357 0.2458 0.5352 0.2522 0.4357 0.2596 0.5243
+ 0.2635 0.4320 0.2699 0.5182 0.2788 0.4296 0.2842 0.5061 0.2935 0.4248 0.2999 0.5061
+ 0.3068 0.4260 0.3147 0.5000 0.3210 0.4248 0.3289 0.4939 0.3358 0.4187 0.3422 0.4782
+ 0.3500 0.4223 0.3569 0.4721 0.3658 0.4223 0.3736 0.4794 0.3800 0.4211 0.3884 0.4745
+ 0.3948 0.4199 0.4036 0.4745 0.4105 0.4126 0.4174 0.4721 0.4258 0.4090 0.4341 0.4733
+ 0.4410 0.4066 0.4489 0.4648 0.4577 0.4053 0.4656 0.4648 0.4730 0.3993 0.4823 0.4697
+ 0.4887 0.3993 0.4990 0.4709 0.5059 0.4005 0.5143 0.4769 0.5236 0.3968 0.5339 0.4879
+ 0.5393 0.3993 0.5521 0.4988 0.5590 0.4029 0.5674 0.5024 0.5777 0.4053 0.5870 0.5097
+ 0.5954 0.4090 0.6057 0.5146 0.6121 0.4150 0.6229 0.5303 0.6332 0.4187 0.6416 0.5437
+ 0.6529 0.4284 0.6618 0.5437 0.6711 0.4308 0.6814 0.5413 0.6868 0.4345 0.6986 0.5473
+ 0.7065 0.4393 0.7183 0.5510 0.7281 0.4430 0.7404 0.5558 0.7557 0.4490 0.7630 0.5595
+ 0.7763 0.4563 0.7861 0.5558 0.7984 0.4612 0.8117 0.5680 0.8265 0.5231 0.9641 0.5095
+ 0.9754 0.3944 0.9823 0.4); 1 .4)
+ :duration dur :scaler (hz->radians 7500.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .03 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (huttons-vireo 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Western meadowlark
@@ -6403,62 +6447,60 @@
(define (western-meadowlark beg1 amp1)
;; 1st sequence of notes
- (definstrument (western-meadowlark-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.075)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.007 0.072 0.016 0.253 0.028 0.300 0.048 0.000 0.115 0.000 0.122 0.062
- 0.132 0.437 0.148 0.462 0.162 0.444 0.188 0.000 0.365 0.000 0.392 0.050 0.397 0.017
- 0.406 0.052 0.412 0.000 0.432 0.000 0.438 0.082 0.455 0.541 0.486 0.722 0.503 0.759
- 0.518 0.744 0.529 0.774 0.547 0.700 0.570 0.000 0.635 0.000 0.656 0.715 0.680 0.963
- 0.701 1.000 0.730 0.938 0.742 0.883 0.754 0.715 0.770 0.000 0.850 0.000 0.855 0.211
- 0.857 0.072 0.858 0.360 0.861 0.112 0.862 0.568 0.864 0.181 0.866 0.742 0.867 0.290
- 0.872 0.933 0.874 0.625 0.883 0.963 0.899 0.940 0.906 0.844 0.920 0.856 0.922 0.821
- 0.929 0.891 0.935 0.844 0.949 0.911 0.970 0.861 0.981 0.667 0.993 0.104 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.280 0.069 0.288 0.125 0.280 0.185 0.275 0.258 0.280 0.366 0.184 0.394 0.179
- 0.405 0.218 0.409 0.134 0.426 0.134 0.428 0.352 0.568 0.345 0.618 0.350 0.630 0.258
- 0.765 0.261 0.828 0.258 0.848 0.454 1.000 0.452)
- :duration dur :scaler (hz->radians 7470.0)))
- (gen1 (make-oscil)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (env frqf))))))))
+ (defanimal (western-meadowlark-1 beg amp)
+ (let ((dur 1.075))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.007 0.072 0.016 0.253 0.028 0.300 0.048 0.000 0.115 0.000 0.122 0.062
+ 0.132 0.437 0.148 0.462 0.162 0.444 0.188 0.000 0.365 0.000 0.392 0.050 0.397 0.017
+ 0.406 0.052 0.412 0.000 0.432 0.000 0.438 0.082 0.455 0.541 0.486 0.722 0.503 0.759
+ 0.518 0.744 0.529 0.774 0.547 0.700 0.570 0.000 0.635 0.000 0.656 0.715 0.680 0.963
+ 0.701 1.000 0.730 0.938 0.742 0.883 0.754 0.715 0.770 0.000 0.850 0.000 0.855 0.211
+ 0.857 0.072 0.858 0.360 0.861 0.112 0.862 0.568 0.864 0.181 0.866 0.742 0.867 0.290
+ 0.872 0.933 0.874 0.625 0.883 0.963 0.899 0.940 0.906 0.844 0.920 0.856 0.922 0.821
+ 0.929 0.891 0.935 0.844 0.949 0.911 0.970 0.861 0.981 0.667 0.993 0.104 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.280 0.069 0.288 0.125 0.280 0.185 0.275 0.258 0.280 0.366 0.184 0.394 0.179
+ 0.405 0.218 0.409 0.134 0.426 0.134 0.428 0.352 0.568 0.345 0.618 0.350 0.630 0.258
+ 0.765 0.261 0.828 0.258 0.848 0.454 1.000 0.452)
+ :duration dur :scaler (hz->radians 7470.0)))
+ (gen1 (make-oscil)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (env frqf))))))))
;; 2nd sequence of notes
- (definstrument (western-meadowlark-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.45)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.014 0.080 0.030 0.297 0.036 0.100 0.043 0.109 0.050 0.436 0.055 0.191
- 0.057 0.435 0.064 0.338 0.067 0.000 0.070 0.830 0.079 0.255 0.084 0.883 0.090 0.982
- 0.099 0.000 0.100 0.553 0.102 0.626 0.113 0.035 0.118 0.261 0.129 0.047 0.151 0.000
- 0.218 0.000 0.224 0.041 0.227 0.015 0.233 0.083 0.248 0.000 0.263 0.141 0.282 0.209
- 0.310 0.389 0.331 0.377 0.354 0.148 0.383 0.829 0.393 0.733 0.406 0.294 0.412 0.559
- 0.436 0.512 0.440 0.250 0.443 0.465 0.446 0.117 0.453 0.324 0.460 0.094 0.464 0.070
- 0.470 0.192 0.477 0.058 0.483 0.023 0.490 0.686 0.501 0.788 0.509 0.756 0.532 0.129
- 0.550 0.000 0.613 0.000 0.619 0.062 0.625 0.015 0.631 0.042 0.634 0.117 0.641 0.070
- 0.659 0.102 0.675 0.067 0.687 0.000 0.730 0.000 0.734 0.118 0.745 0.139 0.746 0.252
- 0.762 0.329 0.770 0.898 0.772 0.223 0.777 0.856 0.785 0.900 0.792 0.126 0.797 0.071
- 0.803 0.742 0.809 0.688 0.824 0.179 0.832 0.197 0.836 0.294 0.880 0.017 0.895 0.041
- 0.915 0.029 0.924 0.008 0.935 0.029 0.956 0.041 0.978 0.033 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.506 0.042 0.501 0.068 0.481 0.125 0.300 0.153 0.293 0.204 0.963 0.217 0.918
- 0.223 0.720 0.235 0.588 0.353 0.553 0.358 0.328 0.400 0.323 0.412 0.293 0.418 0.318
- 0.421 0.273 0.429 0.315 0.435 0.263 0.443 0.263 0.449 0.221 0.472 0.218 0.483 0.223
- 0.487 0.320 0.499 0.266 0.530 0.266 0.545 0.253 0.550 0.201 0.622 0.211 0.635 0.241
- 0.640 0.149 0.684 0.161 0.725 0.169 0.727 0.305 0.736 0.268 0.742 0.238 0.752 0.236
- 0.757 0.310 0.759 0.166 0.773 0.400 0.777 0.350 0.791 0.347 0.803 0.303 0.829 0.303
- 0.840 0.206 0.872 0.208 0.894 0.146 0.918 0.161 0.930 0.102 0.964 0.134 1.000 0.146)
- :duration dur :scaler (hz->radians 7470.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (defanimal (western-meadowlark-2 beg amp)
+ (let ((dur 0.45))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.014 0.080 0.030 0.297 0.036 0.100 0.043 0.109 0.050 0.436 0.055 0.191
+ 0.057 0.435 0.064 0.338 0.067 0.000 0.070 0.830 0.079 0.255 0.084 0.883 0.090 0.982
+ 0.099 0.000 0.100 0.553 0.102 0.626 0.113 0.035 0.118 0.261 0.129 0.047 0.151 0.000
+ 0.218 0.000 0.224 0.041 0.227 0.015 0.233 0.083 0.248 0.000 0.263 0.141 0.282 0.209
+ 0.310 0.389 0.331 0.377 0.354 0.148 0.383 0.829 0.393 0.733 0.406 0.294 0.412 0.559
+ 0.436 0.512 0.440 0.250 0.443 0.465 0.446 0.117 0.453 0.324 0.460 0.094 0.464 0.070
+ 0.470 0.192 0.477 0.058 0.483 0.023 0.490 0.686 0.501 0.788 0.509 0.756 0.532 0.129
+ 0.550 0.000 0.613 0.000 0.619 0.062 0.625 0.015 0.631 0.042 0.634 0.117 0.641 0.070
+ 0.659 0.102 0.675 0.067 0.687 0.000 0.730 0.000 0.734 0.118 0.745 0.139 0.746 0.252
+ 0.762 0.329 0.770 0.898 0.772 0.223 0.777 0.856 0.785 0.900 0.792 0.126 0.797 0.071
+ 0.803 0.742 0.809 0.688 0.824 0.179 0.832 0.197 0.836 0.294 0.880 0.017 0.895 0.041
+ 0.915 0.029 0.924 0.008 0.935 0.029 0.956 0.041 0.978 0.033 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.506 0.042 0.501 0.068 0.481 0.125 0.300 0.153 0.293 0.204 0.963 0.217 0.918
+ 0.223 0.720 0.235 0.588 0.353 0.553 0.358 0.328 0.400 0.323 0.412 0.293 0.418 0.318
+ 0.421 0.273 0.429 0.315 0.435 0.263 0.443 0.263 0.449 0.221 0.472 0.218 0.483 0.223
+ 0.487 0.320 0.499 0.266 0.530 0.266 0.545 0.253 0.550 0.201 0.622 0.211 0.635 0.241
+ 0.640 0.149 0.684 0.161 0.725 0.169 0.727 0.305 0.736 0.268 0.742 0.238 0.752 0.236
+ 0.757 0.310 0.759 0.166 0.773 0.400 0.777 0.350 0.791 0.347 0.803 0.303 0.829 0.303
+ 0.840 0.206 0.872 0.208 0.894 0.146 0.918 0.161 0.930 0.102 0.964 0.134 1.000 0.146)
+ :duration dur :scaler (hz->radians 7470.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
(western-meadowlark-1 beg1 (* 0.6 amp1))
@@ -6467,97 +6509,97 @@
;; (with-sound (:play #t) (western-meadowlark 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Northern beardless tyrannulet
;;;
;;; this should have used 4 calls on one note
-(definstrument (northern-beardless-tyrannulet beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.91)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.013 0.124 0.018 0.713 0.038 0.303 0.052 0.469 0.065 0.236 0.079 0.685
- 0.084 0.483 0.089 0.666 0.094 0.545 0.101 0.638 0.107 0.542 0.113 0.671 0.123 0.531
- 0.132 0.590 0.157 0.879 0.167 0.784 0.173 0.410 0.177 0.646 0.182 0.228 0.192 0.587
- 0.203 0.000 0.238 0.000 0.240 0.010 0.248 0.843 0.255 0.404 0.266 0.952 0.281 1.000
- 0.331 0.963 0.350 0.702 0.358 0.784 0.375 0.534 0.391 0.778 0.406 0.000 0.444 0.000
- 0.446 0.010 0.457 0.899 0.464 0.334 0.473 1.000 0.492 0.854 0.499 0.610 0.506 0.730
- 0.525 0.652 0.552 0.801 0.560 0.553 0.570 0.865 0.582 0.534 0.583 0.626 0.590 0.483
- 0.595 0.570 0.611 0.000 0.649 0.000 0.651 0.010 0.662 0.899 0.671 0.654 0.679 0.969
- 0.698 0.787 0.704 0.843 0.711 0.772 0.726 0.910 0.768 0.643 0.780 0.680 0.803 0.000
- 0.845 0.000 0.847 0.010 0.856 0.770 0.863 0.492 0.866 0.860 0.873 0.890 0.883 0.680
- 0.889 0.817 0.901 0.722 0.915 0.823 0.934 0.534 0.953 0.576 0.972 0.435 0.977 0.562
- 0.990 0.101 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.396 0.021 0.439 0.188 0.431 0.197 0.340 0.247 0.375
- 0.256 0.447 0.268 0.437 0.396 0.426 0.400 0.394 0.402 0.358 0.457 0.369
- 0.461 0.426 0.469 0.447 0.484 0.437 0.599 0.418 0.607 0.394 0.611 0.345 0.658 0.361
- 0.663 0.426 0.669 0.456 0.682 0.429 0.786 0.415 0.795 0.407 0.801 0.345 0.856 0.372
- 0.861 0.420 0.865 0.450 0.875 0.431 0.982 0.407 0.990 0.361 1.000 0.278)
- :duration dur :scaler (hz->radians 9230.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .005 3 .02 4 .005 5 .003)))
- (noise (make-rand-interp 8000))
- (noisef (make-env '(0 0 .011 1 .015 0
- .236 0 .24 1 .245 0
- .44 0 .445 1 .452 0
- .647 0 .65 1 .657 0
- .84 0 .845 1 .853 0
- 1 0)
- :duration dur :scaler .25)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((rnd (env noisef)))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (* rnd (rand-interp noise)))))))))))
+(defanimal (northern-beardless-tyrannulet beg amp)
+ (let ((dur 1.91))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.013 0.124 0.018 0.713 0.038 0.303 0.052 0.469 0.065 0.236 0.079 0.685
+ 0.084 0.483 0.089 0.666 0.094 0.545 0.101 0.638 0.107 0.542 0.113 0.671 0.123 0.531
+ 0.132 0.590 0.157 0.879 0.167 0.784 0.173 0.410 0.177 0.646 0.182 0.228 0.192 0.587
+ 0.203 0.000 0.238 0.000 0.240 0.010 0.248 0.843 0.255 0.404 0.266 0.952 0.281 1.000
+ 0.331 0.963 0.350 0.702 0.358 0.784 0.375 0.534 0.391 0.778 0.406 0.000 0.444 0.000
+ 0.446 0.010 0.457 0.899 0.464 0.334 0.473 1.000 0.492 0.854 0.499 0.610 0.506 0.730
+ 0.525 0.652 0.552 0.801 0.560 0.553 0.570 0.865 0.582 0.534 0.583 0.626 0.590 0.483
+ 0.595 0.570 0.611 0.000 0.649 0.000 0.651 0.010 0.662 0.899 0.671 0.654 0.679 0.969
+ 0.698 0.787 0.704 0.843 0.711 0.772 0.726 0.910 0.768 0.643 0.780 0.680 0.803 0.000
+ 0.845 0.000 0.847 0.010 0.856 0.770 0.863 0.492 0.866 0.860 0.873 0.890 0.883 0.680
+ 0.889 0.817 0.901 0.722 0.915 0.823 0.934 0.534 0.953 0.576 0.972 0.435 0.977 0.562
+ 0.990 0.101 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.396 0.021 0.439 0.188 0.431 0.197 0.340 0.247 0.375
+ 0.256 0.447 0.268 0.437 0.396 0.426 0.400 0.394 0.402 0.358 0.457 0.369
+ 0.461 0.426 0.469 0.447 0.484 0.437 0.599 0.418 0.607 0.394 0.611 0.345 0.658 0.361
+ 0.663 0.426 0.669 0.456 0.682 0.429 0.786 0.415 0.795 0.407 0.801 0.345 0.856 0.372
+ 0.861 0.420 0.865 0.450 0.875 0.431 0.982 0.407 0.990 0.361 1.000 0.278)
+ :duration dur :scaler (hz->radians 9230.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .005 3 .02 4 .005 5 .003)))
+ (noise (make-rand-interp 8000))
+ (noisef (make-env '(0 0 .011 1 .015 0
+ .236 0 .24 1 .245 0
+ .44 0 .445 1 .452 0
+ .647 0 .65 1 .657 0
+ .84 0 .845 1 .853 0
+ 1 0)
+ :duration dur :scaler .25)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (* (env noisef) (rand-interp noise))))))))))
;; (with-sound (:play #t) (northern-beardless-tyrannulet 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Scott's oriole
-(definstrument (scotts-oriole beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.83)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.020 0.103 0.030 0.113 0.038 0.099 0.062 0.000 0.142 0.000 0.150 0.050
- 0.160 0.326 0.170 0.333 0.178 0.309 0.200 0.050 0.207 0.076 0.218 0.282 0.238 0.018
- 0.255 0.353 0.265 0.415 0.276 0.392 0.292 0.000 0.318 0.000 0.328 0.442 0.331 0.090
- 0.335 0.408 0.339 0.279 0.342 0.545 0.357 0.000 0.405 0.000 0.413 0.250 0.419 0.281
- 0.424 0.250 0.436 0.058 0.442 0.072 0.462 0.511 0.471 0.500 0.477 0.000 0.484 0.000
- 0.487 0.980 0.505 0.514 0.521 0.304 0.530 0.000 0.601 0.000 0.616 0.559 0.622 0.599
- 0.637 0.581 0.646 0.507 0.661 0.000 0.676 0.000 0.678 0.239 0.680 0.094 0.682 0.424
- 0.687 0.096 0.689 0.374 0.693 0.000 0.702 0.000 0.716 0.698 0.725 0.763 0.735 0.000
- 0.746 0.000 0.753 0.396 0.758 0.423 0.760 0.399 0.771 0.054 0.777 0.095 0.783 0.207
- 0.786 0.227 0.800 0.142 0.823 0.072 0.828 0.000 0.851 0.000 0.853 0.243 0.856 0.087
- 0.857 0.351 0.862 0.147 0.863 0.300 0.870 0.000 0.877 0.000 0.892 0.888 0.911 0.000
- 0.920 0.000 0.926 0.353 0.933 0.406 0.943 0.059 0.948 0.025 0.962 0.167 0.970 0.174 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.560 0.023 0.489 0.052 0.487 0.079 0.487 0.138 0.556 0.150 0.556 0.162 0.487
- 0.181 0.473 0.202 0.473 0.212 0.415 0.234 0.415 0.241 0.491 0.252 0.442 0.267 0.431
- 0.285 0.438 0.319 0.455 0.322 0.533 0.328 0.634 0.332 0.467 0.338 0.775 0.348 0.839
- 0.354 0.810 0.366 0.737 0.392 0.415 0.409 0.411 0.421 0.386 0.440 0.397 0.472 0.438
- 0.477 0.531 0.485 0.607 0.495 0.507 0.508 0.408 0.527 0.406 0.587 0.406 0.607 0.491
- 0.624 0.462 0.637 0.458 0.654 0.467 0.658 0.422 0.679 0.393 0.682 0.585 0.684 0.482
- 0.686 0.643 0.690 0.420 0.700 0.576 0.706 0.621 0.710 0.583 0.730 0.612 0.751 0.413
- 0.766 0.406 0.789 0.362 0.819 0.359 0.852 0.388 0.856 0.645 0.858 0.491 0.861 0.621
- 0.864 0.435 0.867 0.576 0.873 0.565 0.879 0.600 0.887 0.576 0.896 0.596 0.903 0.654
- 0.924 0.420 0.940 0.395 0.973 0.359 1.000 0.353)
- :duration dur :scaler (hz->radians 5080.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .003 4 .007))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (scotts-oriole beg amp)
+ (let ((dur 1.83))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.020 0.103 0.030 0.113 0.038 0.099 0.062 0.000 0.142 0.000 0.150 0.050
+ 0.160 0.326 0.170 0.333 0.178 0.309 0.200 0.050 0.207 0.076 0.218 0.282 0.238 0.018
+ 0.255 0.353 0.265 0.415 0.276 0.392 0.292 0.000 0.318 0.000 0.328 0.442 0.331 0.090
+ 0.335 0.408 0.339 0.279 0.342 0.545 0.357 0.000 0.405 0.000 0.413 0.250 0.419 0.281
+ 0.424 0.250 0.436 0.058 0.442 0.072 0.462 0.511 0.471 0.500 0.477 0.000 0.484 0.000
+ 0.487 0.980 0.505 0.514 0.521 0.304 0.530 0.000 0.601 0.000 0.616 0.559 0.622 0.599
+ 0.637 0.581 0.646 0.507 0.661 0.000 0.676 0.000 0.678 0.239 0.680 0.094 0.682 0.424
+ 0.687 0.096 0.689 0.374 0.693 0.000 0.702 0.000 0.716 0.698 0.725 0.763 0.735 0.000
+ 0.746 0.000 0.753 0.396 0.758 0.423 0.760 0.399 0.771 0.054 0.777 0.095 0.783 0.207
+ 0.786 0.227 0.800 0.142 0.823 0.072 0.828 0.000 0.851 0.000 0.853 0.243 0.856 0.087
+ 0.857 0.351 0.862 0.147 0.863 0.300 0.870 0.000 0.877 0.000 0.892 0.888 0.911 0.000
+ 0.920 0.000 0.926 0.353 0.933 0.406 0.943 0.059 0.948 0.025 0.962 0.167 0.970 0.174 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.560 0.023 0.489 0.052 0.487 0.079 0.487 0.138 0.556 0.150 0.556 0.162 0.487
+ 0.181 0.473 0.202 0.473 0.212 0.415 0.234 0.415 0.241 0.491 0.252 0.442 0.267 0.431
+ 0.285 0.438 0.319 0.455 0.322 0.533 0.328 0.634 0.332 0.467 0.338 0.775 0.348 0.839
+ 0.354 0.810 0.366 0.737 0.392 0.415 0.409 0.411 0.421 0.386 0.440 0.397 0.472 0.438
+ 0.477 0.531 0.485 0.607 0.495 0.507 0.508 0.408 0.527 0.406 0.587 0.406 0.607 0.491
+ 0.624 0.462 0.637 0.458 0.654 0.467 0.658 0.422 0.679 0.393 0.682 0.585 0.684 0.482
+ 0.686 0.643 0.690 0.420 0.700 0.576 0.706 0.621 0.710 0.583 0.730 0.612 0.751 0.413
+ 0.766 0.406 0.789 0.362 0.819 0.359 0.852 0.388 0.856 0.645 0.858 0.491 0.861 0.621
+ 0.864 0.435 0.867 0.576 0.873 0.565 0.879 0.600 0.887 0.576 0.896 0.596 0.903 0.654
+ 0.924 0.420 0.940 0.395 0.973 0.359 1.000 0.353)
+ :duration dur :scaler (hz->radians 5080.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .003 4 .007))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (scotts-oriole 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Wilson's warbler
@@ -6565,92 +6607,87 @@
(define (wilsons-warbler beg1 amp1)
;; 3 different calls, 2(?) with 2 different tones
- (definstrument (wilsons-warbler-1 beg dur amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
-
- (ampf (make-env '(0.000 0.000 0.101 0.169 0.138 0.169 0.179 0.297 0.226 0.377 0.269 0.092 0.318 0.513
- 0.340 0.651 0.359 0.156 0.372 0.654 0.387 0.156 0.428 0.700 0.491 0.808 0.607 0.721
- 0.659 0.923 0.747 0.995 0.909 0.813 0.965 0.528 1.000 0.000)
- :duration dur :scaler amp))
- (frqf1 (make-env '(0.000 0.692 0.038 0.698 0.077 0.647 0.136 0.614 0.258 0.606 0.275 0.575 0.314 0.571
- 0.365 0.550 0.381 0.500 0.681 0.502 0.844 0.496 0.873 0.401 1.000 0.390)
- :duration dur :scaler (hz->radians 10210.0)))
- (gen1 (make-oscil))
- (frqf2 (make-env '(0.000 0.692 0.038 0.698 0.077 0.647 0.136 0.614 0.258 0.606 0.275 0.575 0.314 0.571
- 0.365 0.550 0.376 0.394 0.490 0.353 0.594 0.347 0.681 0.392 0.740 0.418 0.818 0.416
- 0.886 0.399 1.000 0.390)
- :duration dur :scaler (hz->radians 10210.0)))
- (ampf1 (make-env '(0 1 .6 1 .8 0 1 0) :duration dur))
- (gen2 (make-oscil))
- (ampf2 (make-env '(0 .25 .35 .25 .36 0 .6 0 .7 1 1 1) :duration dur))
-
- (rnd (make-rand-interp 4000 (hz->radians 300))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((noise (rand-interp rnd)))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (oscil gen1 (+ (env frqf1)
- noise)))
- (* (env ampf2)
- (oscil gen2 (env frqf2)))))))))))
-
- (definstrument (wilsons-warbler-2 beg dur frq amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
-
- (ampf (make-env '(0.000 0.000 0.049 0.091 0.109 0.276 0.129 0.280 0.149 0.164 0.157 0.388 0.179 0.677
- 0.221 0.642 0.241 0.448 0.319 1.000 0.360 0.953 0.489 0.765 0.513 0.539 0.591 0.282
- 0.619 0.345 0.727 0.244 0.762 0.446 0.828 0.442 0.925 0.313 0.982 0.136 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.909 0.050 0.838 0.080 0.799 0.119 0.786 0.162 0.752 0.225 0.692 0.262 0.634
- 0.317 0.538 0.366 0.478 0.482 0.376 0.554 0.342 0.628 0.366 0.701 0.392 0.762 0.394
- 0.832 0.373 1.000 0.3)
- :duration dur :scaler (hz->radians (* frq 9780.0))))
- (gen1 (make-oscil))
-
- (rnd (make-rand-interp 4000 (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (+ (env frqf)
- (rand-interp rnd)))))))))
-
-
- (definstrument (wilsons-warbler-3 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.07)
- (stop (+ start (seconds->samples dur)))
-
- (ampf (make-env '(0.000 0.000 0.087 0.099 0.126 0.201 0.148 0.086 0.201 0.483 0.223 0.337 0.243 0.561
- 0.257 0.384 0.269 0.658 0.282 0.332 0.292 0.428 0.311 0.211 0.357 0.290 0.390 0.601
- 0.407 0.674 0.433 0.658 0.437 0.222 0.456 0.572 0.485 0.629 0.498 0.885 0.529 0.627
- 0.552 0.807 0.642 0.689 0.658 0.836 0.683 0.877 0.704 0.543 0.733 0.634 0.837 0.428
- 0.873 0.634 0.924 0.185 0.974 0.238 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.770 0.120 0.768 0.190 0.752 0.227 0.715 0.261 0.692 0.292 0.695 0.310 0.648
- 0.334 0.629 0.423 0.616 0.477 0.561 0.510 0.554 0.534 0.501 0.645 0.413 0.690 0.402
- 0.737 0.371 0.893 0.347 1.000 0.295)
- :duration dur :scaler (hz->radians 9780.0)))
- (gen1 (make-oscil))
-
- (rnd (make-rand-interp 4000 (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (+ (env frqf)
- (rand-interp rnd)))))))))
+ (defanimal (wilsons-warbler-1 beg dur amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+
+ (ampf (make-env '(0.000 0.000 0.101 0.169 0.138 0.169 0.179 0.297 0.226 0.377 0.269 0.092 0.318 0.513
+ 0.340 0.651 0.359 0.156 0.372 0.654 0.387 0.156 0.428 0.700 0.491 0.808 0.607 0.721
+ 0.659 0.923 0.747 0.995 0.909 0.813 0.965 0.528 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf1 (make-env '(0.000 0.692 0.038 0.698 0.077 0.647 0.136 0.614 0.258 0.606 0.275 0.575 0.314 0.571
+ 0.365 0.550 0.381 0.500 0.681 0.502 0.844 0.496 0.873 0.401 1.000 0.390)
+ :duration dur :scaler (hz->radians 10210.0)))
+ (gen1 (make-oscil))
+ (frqf2 (make-env '(0.000 0.692 0.038 0.698 0.077 0.647 0.136 0.614 0.258 0.606 0.275 0.575 0.314 0.571
+ 0.365 0.550 0.376 0.394 0.490 0.353 0.594 0.347 0.681 0.392 0.740 0.418 0.818 0.416
+ 0.886 0.399 1.000 0.390)
+ :duration dur :scaler (hz->radians 10210.0)))
+ (ampf1 (make-env '(0 1 .6 1 .8 0 1 0) :duration dur))
+ (gen2 (make-oscil))
+ (ampf2 (make-env '(0 .25 .35 .25 .36 0 .6 0 .7 1 1 1) :duration dur))
+
+ (rnd (make-rand-interp 4000 (hz->radians 300))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (oscil gen1 (+ (env frqf1) (rand-interp rnd))))
+ (* (env ampf2)
+ (oscil gen2 (env frqf2)))))))))
+
+ (defanimal (wilsons-warbler-2 beg dur frq amp)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+
+ (ampf (make-env '(0.000 0.000 0.049 0.091 0.109 0.276 0.129 0.280 0.149 0.164 0.157 0.388 0.179 0.677
+ 0.221 0.642 0.241 0.448 0.319 1.000 0.360 0.953 0.489 0.765 0.513 0.539 0.591 0.282
+ 0.619 0.345 0.727 0.244 0.762 0.446 0.828 0.442 0.925 0.313 0.982 0.136 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.909 0.050 0.838 0.080 0.799 0.119 0.786 0.162 0.752 0.225 0.692 0.262 0.634
+ 0.317 0.538 0.366 0.478 0.482 0.376 0.554 0.342 0.628 0.366 0.701 0.392 0.762 0.394
+ 0.832 0.373 1.000 0.3)
+ :duration dur :scaler (hz->radians (* frq 9780.0))))
+ (gen1 (make-oscil))
+
+ (rnd (make-rand-interp 4000 (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (+ (env frqf)
+ (rand-interp rnd))))))))
+
+
+ (defanimal (wilsons-warbler-3 beg amp)
+ (let ((dur 0.07))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+
+ (ampf (make-env '(0.000 0.000 0.087 0.099 0.126 0.201 0.148 0.086 0.201 0.483 0.223 0.337 0.243 0.561
+ 0.257 0.384 0.269 0.658 0.282 0.332 0.292 0.428 0.311 0.211 0.357 0.290 0.390 0.601
+ 0.407 0.674 0.433 0.658 0.437 0.222 0.456 0.572 0.485 0.629 0.498 0.885 0.529 0.627
+ 0.552 0.807 0.642 0.689 0.658 0.836 0.683 0.877 0.704 0.543 0.733 0.634 0.837 0.428
+ 0.873 0.634 0.924 0.185 0.974 0.238 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.770 0.120 0.768 0.190 0.752 0.227 0.715 0.261 0.692 0.292 0.695 0.310 0.648
+ 0.334 0.629 0.423 0.616 0.477 0.561 0.510 0.554 0.534 0.501 0.645 0.413 0.690 0.402
+ 0.737 0.371 0.893 0.347 1.000 0.295)
+ :duration dur :scaler (hz->radians 9780.0)))
+ (gen1 (make-oscil))
+
+ (rnd (make-rand-interp 4000 (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (+ (env frqf)
+ (rand-interp rnd)))))))))
(wilsons-warbler-1 beg1 .046 (* .05 amp1))
(wilsons-warbler-1 (+ beg1 .147) .05 (* .1 amp1))
- (let ((durs2 (vct 0.067 0.07 0.075 0.08 0.086 0.084 0.08 0.08 0.078))
- (frqs2 (vct 1.0 1.0 0.95 0.93 1.0 1.0 1.0 1.0 0.95))
- (amps2 (vct .2 .4 .7 1 1 .8 1 1 1)))
+ (let ((durs2 (vector 0.067 0.07 0.075 0.08 0.086 0.084 0.08 0.08 0.078))
+ (frqs2 (vector 1.0 1.0 0.95 0.93 1.0 1.0 1.0 1.0 0.95))
+ (amps2 (vector .2 .4 .7 1 1 .8 1 1 1)))
(do ((i 0 (+ i 1)))
((= i 9))
(wilsons-warbler-2 (+ beg1 0.285 (* i .13)) (durs2 i) (frqs2 i) (* amp1 (amps2 i)))))
@@ -6662,443 +6699,442 @@
;; (with-sound (:play #t) (wilsons-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Willow flycatcher
-(definstrument (willow-flycatcher beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.65)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.016 0.054 0.026 0.142 0.033 0.292 0.043 0.228 0.056 0.240 0.088 0.162
- 0.107 0.218 0.125 0.105 0.130 0.019 0.196 0.012 0.208 0.053 0.215 0.031 0.221 0.086
- 0.223 0.711 0.228 0.828 0.231 0.760 0.237 0.978 0.242 0.679 0.245 0.966 0.250 0.272
- 0.253 0.177 0.262 0.131 0.264 0.000 0.405 0.000 0.417 0.069 0.426 0.174 0.431 0.402
- 0.435 0.301 0.445 0.338 0.452 0.240 0.460 0.000 0.501 0.000 0.504 0.159 0.509 0.069
- 0.519 0.096 0.521 0.228 0.524 0.000 0.536 0.000 0.539 0.336 0.541 0.103 0.547 0.449
- 0.550 0.157 0.554 0.000 0.557 0.086 0.560 0.419 0.562 0.169 0.565 0.000 0.567 0.066
- 0.568 0.174 0.569 0.419 0.572 0.123 0.574 0.027 0.576 0.167 0.577 0.537 0.582 0.056
- 0.583 0.237 0.584 0.564 0.588 0.211 0.590 0.051 0.592 0.232 0.594 0.515 0.595 0.179
- 0.597 0.041 0.599 0.177 0.601 0.426 0.603 0.153 0.606 0.029 0.609 0.172 0.612 0.395
- 0.614 0.029 0.617 0.169 0.620 0.412 0.623 0.024 0.625 0.148 0.628 0.375 0.631 0.022
- 0.634 0.148 0.636 0.336 0.640 0.031 0.644 0.150 0.646 0.348 0.650 0.041 0.654 0.165
- 0.655 0.338 0.659 0.039 0.664 0.165 0.665 0.336 0.668 0.058 0.671 0.260 0.674 0.162
- 0.677 0.321 0.680 0.218 0.682 0.343 0.684 0.167 0.696 0.265 0.702 0.348 0.708 0.326
- 0.716 0.385 0.720 0.520 0.727 0.451 0.731 0.561 0.738 0.267 0.745 0.321 0.750 0.108
- 0.772 0.118 0.782 0.167 0.792 0.282 0.802 0.409 0.811 0.257 0.816 0.083 0.833 0.069
- 0.852 0.103 0.863 0.152 0.867 0.250 0.877 0.047 0.929 0.091 0.938 0.054 0.953 0.027 0.986 0.039 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.174 0.042 0.324 0.074 0.339 0.111 0.390 0.130 0.453 0.190 0.831 0.210 0.780
- 0.225 0.605 0.227 0.504 0.240 0.489 0.248 0.453 0.251 0.346 0.262 0.165 0.412 0.155
- 0.422 0.230 0.430 0.288 0.435 0.334 0.448 0.337 0.456 0.395 0.458 0.467 0.503 0.402
- 0.506 0.235 0.513 0.213 0.520 0.240 0.524 0.443 0.537 0.441 0.540 0.298 0.544 0.262
- 0.547 0.298 0.553 0.443 0.558 0.453 0.561 0.324 0.563 0.508 0.570 0.324 0.573 0.511
- 0.577 0.329 0.581 0.482 0.585 0.332 0.590 0.479 0.594 0.332 0.598 0.467 0.602 0.320
- 0.606 0.453 0.611 0.300 0.615 0.443 0.620 0.291 0.623 0.450 0.628 0.262 0.631 0.438
- 0.637 0.259 0.640 0.436 0.646 0.264 0.649 0.436 0.655 0.257 0.659 0.438 0.664 0.247
- 0.668 0.407 0.673 0.264 0.679 0.400 0.683 0.291 0.702 0.298 0.716 0.334 0.721 0.397
- 0.728 0.370 0.733 0.402 0.738 0.438 0.742 0.375 0.748 0.249 0.755 0.232 0.766 0.264
- 0.785 0.295 0.797 0.310 0.801 0.354 0.803 0.426 0.808 0.361 0.815 0.203 0.824 0.184
- 0.834 0.225 0.852 0.254 0.861 0.293 0.867 0.349 0.881 0.157 0.889 0.155 0.895 0.184
- 0.913 0.206 0.926 0.257 0.930 0.310 0.946 0.136 0.956 0.123 0.969 0.169 0.987 0.208 1.000 0.262)
- :duration dur :scaler (hz->radians 10800.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .01 4 .005)))
- (gen2 (make-oscil))
- (ampf2 (make-env '(0 0 .68 0 .9 1 1 1) :duration dur :scaler .2)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (oscil gen2 (* 2 frq)))))))))))
+(defanimal (willow-flycatcher beg amp)
+ (let ((dur 0.65))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.016 0.054 0.026 0.142 0.033 0.292 0.043 0.228 0.056 0.240 0.088 0.162
+ 0.107 0.218 0.125 0.105 0.130 0.019 0.196 0.012 0.208 0.053 0.215 0.031 0.221 0.086
+ 0.223 0.711 0.228 0.828 0.231 0.760 0.237 0.978 0.242 0.679 0.245 0.966 0.250 0.272
+ 0.253 0.177 0.262 0.131 0.264 0.000 0.405 0.000 0.417 0.069 0.426 0.174 0.431 0.402
+ 0.435 0.301 0.445 0.338 0.452 0.240 0.460 0.000 0.501 0.000 0.504 0.159 0.509 0.069
+ 0.519 0.096 0.521 0.228 0.524 0.000 0.536 0.000 0.539 0.336 0.541 0.103 0.547 0.449
+ 0.550 0.157 0.554 0.000 0.557 0.086 0.560 0.419 0.562 0.169 0.565 0.000 0.567 0.066
+ 0.568 0.174 0.569 0.419 0.572 0.123 0.574 0.027 0.576 0.167 0.577 0.537 0.582 0.056
+ 0.583 0.237 0.584 0.564 0.588 0.211 0.590 0.051 0.592 0.232 0.594 0.515 0.595 0.179
+ 0.597 0.041 0.599 0.177 0.601 0.426 0.603 0.153 0.606 0.029 0.609 0.172 0.612 0.395
+ 0.614 0.029 0.617 0.169 0.620 0.412 0.623 0.024 0.625 0.148 0.628 0.375 0.631 0.022
+ 0.634 0.148 0.636 0.336 0.640 0.031 0.644 0.150 0.646 0.348 0.650 0.041 0.654 0.165
+ 0.655 0.338 0.659 0.039 0.664 0.165 0.665 0.336 0.668 0.058 0.671 0.260 0.674 0.162
+ 0.677 0.321 0.680 0.218 0.682 0.343 0.684 0.167 0.696 0.265 0.702 0.348 0.708 0.326
+ 0.716 0.385 0.720 0.520 0.727 0.451 0.731 0.561 0.738 0.267 0.745 0.321 0.750 0.108
+ 0.772 0.118 0.782 0.167 0.792 0.282 0.802 0.409 0.811 0.257 0.816 0.083 0.833 0.069
+ 0.852 0.103 0.863 0.152 0.867 0.250 0.877 0.047 0.929 0.091 0.938 0.054 0.953 0.027 0.986 0.039 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.174 0.042 0.324 0.074 0.339 0.111 0.390 0.130 0.453 0.190 0.831 0.210 0.780
+ 0.225 0.605 0.227 0.504 0.240 0.489 0.248 0.453 0.251 0.346 0.262 0.165 0.412 0.155
+ 0.422 0.230 0.430 0.288 0.435 0.334 0.448 0.337 0.456 0.395 0.458 0.467 0.503 0.402
+ 0.506 0.235 0.513 0.213 0.520 0.240 0.524 0.443 0.537 0.441 0.540 0.298 0.544 0.262
+ 0.547 0.298 0.553 0.443 0.558 0.453 0.561 0.324 0.563 0.508 0.570 0.324 0.573 0.511
+ 0.577 0.329 0.581 0.482 0.585 0.332 0.590 0.479 0.594 0.332 0.598 0.467 0.602 0.320
+ 0.606 0.453 0.611 0.300 0.615 0.443 0.620 0.291 0.623 0.450 0.628 0.262 0.631 0.438
+ 0.637 0.259 0.640 0.436 0.646 0.264 0.649 0.436 0.655 0.257 0.659 0.438 0.664 0.247
+ 0.668 0.407 0.673 0.264 0.679 0.400 0.683 0.291 0.702 0.298 0.716 0.334 0.721 0.397
+ 0.728 0.370 0.733 0.402 0.738 0.438 0.742 0.375 0.748 0.249 0.755 0.232 0.766 0.264
+ 0.785 0.295 0.797 0.310 0.801 0.354 0.803 0.426 0.808 0.361 0.815 0.203 0.824 0.184
+ 0.834 0.225 0.852 0.254 0.861 0.293 0.867 0.349 0.881 0.157 0.889 0.155 0.895 0.184
+ 0.913 0.206 0.926 0.257 0.930 0.310 0.946 0.136 0.956 0.123 0.969 0.169 0.987 0.208 1.000 0.262)
+ :duration dur :scaler (hz->radians 10800.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .01 4 .005)))
+ (gen2 (make-oscil))
+ (ampf2 (make-env '(0 0 .68 0 .9 1 1 1) :duration dur :scaler .2)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (oscil gen2 (* 2.0 frq)))))))))))
;; (with-sound (:play #t) (willow-flycatcher 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Black-necked stilt
-(definstrument (black-necked-stilt beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.085)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.034 0.133 0.121 0.287 0.210 0.586 0.358 0.950 0.419 1.000 0.514 1.000
- 0.611 0.912 0.819 0.251 0.893 0.204 0.962 0.105 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.246 0.073 0.252 0.107 0.294 0.131 0.276 0.160 0.300 0.269 0.334 0.345 0.350
- 0.451 0.361 0.548 0.359 0.692 0.352 0.765 0.328 0.803 0.300 0.832 0.318 0.865 0.285 1.000 0.266)
- :duration dur :scaler (hz->radians (* 1/3 10100.0))))
- (gen1 (make-polywave :partials (normalize-partials (list 1 .05 2 .25 3 1 4 .5 5 .2 6 .01 8 .03 9 .03 10 .01 11 .005 12 .005))))
- (gen2 (make-polywave :partials (list 3 .03 5 .05 7 .1 9 .03 11 .04 13 .015 15 .01 17 .005 19 .005 21 .005 23 .005)))
- (ampf2 (make-env '(0 1 .2 .1 .3 1 .5 0 .7 0 1 .5) :duration dur))
-
- (rnd (make-rand-interp 4000 (hz->radians 500)))
- (rndf (make-env '(0 1 .2 0 .9 0 1 1) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* (env rndf)
- (rand-interp rnd)))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (polywave gen2 (* 0.5 frq)))))))))))
+(defanimal (black-necked-stilt beg amp)
+ (let ((dur 0.085))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.034 0.133 0.121 0.287 0.210 0.586 0.358 0.950 0.419 1.000 0.514 1.000
+ 0.611 0.912 0.819 0.251 0.893 0.204 0.962 0.105 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.246 0.073 0.252 0.107 0.294 0.131 0.276 0.160 0.300 0.269 0.334 0.345 0.350
+ 0.451 0.361 0.548 0.359 0.692 0.352 0.765 0.328 0.803 0.300 0.832 0.318 0.865 0.285 1.000 0.266)
+ :duration dur :scaler (hz->radians (* 1/3 10100.0))))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 .05 2 .25 3 1 4 .5 5 .2 6 .01 8 .03 9 .03 10 .01 11 .005 12 .005))))
+ (gen2 (make-polywave 0.0 '(3 .03 5 .05 7 .1 9 .03 11 .04 13 .015 15 .01 17 .005 19 .005 21 .005 23 .005)))
+ (ampf2 (make-env '(0 1 .2 .1 .3 1 .5 0 .7 0 1 .5) :duration dur))
+
+ (rnd (make-rand-interp 4000 (hz->radians 500)))
+ (rndf (make-env '(0 1 .2 0 .9 0 1 1) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env rndf)
+ (rand-interp rnd)))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (polywave gen2 (* 0.5 frq)))))))))))
;; (with-sound (:play #t) (black-necked-stilt 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Bushtit
-(definstrument (bushtit beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.368)
- (stop (+ start (seconds->samples dur)))
- (frqf (make-env '(0 0 1 -1) :duration dur :scaler (hz->radians 500)))
- (pulse-dur .044)
- (pulse-spacing (seconds->samples .064))
- (next-pulse (+ start pulse-spacing))
- (pulse-ampf (make-env '(0.000 0.000 0.114 0.486 0.182 0.988 0.394 0.763 0.620 1.000 0.769 0.937 0.889 1.000 1.000 0.000)
- :duration pulse-dur :scaler amp))
- (pulse-frqf (make-env '(0.000 0.230 0.109 0.291 0.212 0.322 0.298 0.343 0.410 0.348 0.654 0.357 0.821 0.354 0.889 0.337 0.952 0.304 1.000 0.231)
- :duration pulse-dur :scaler (hz->radians 22050.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01)))
- (gen2 (make-polywave :partials (list 5 .9 7 .07 8 .02 9 .01 11 .02)))
- (pulse-ampf2 (make-env '(0 0 .65 0 .8 1 .9 1 1 0)
- :duration pulse-dur :scaler .4))
- (pulse-frqf2 (make-env '(0 5400 .6 5400 .75 6300 1 5400)
- :duration pulse-dur :scaler (hz->radians 0.2) :base .1))
- (pulse2 #f))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (if (>= i next-pulse)
- (begin
- (mus-reset pulse-ampf)
- (mus-reset pulse-frqf)
- (if pulse2
- (begin
- (mus-reset pulse-ampf2)
- (mus-reset pulse-frqf2))
- (set! pulse2 #t))
- (set! next-pulse (+ next-pulse pulse-spacing))))
- (outa i (+ (* (env pulse-ampf)
+(defanimal (bushtit beg amp)
+ (let ((dur 0.368)
+ (pulse-dur .044)
+ (start (seconds->samples beg)))
+ (let ((stop (seconds->samples (+ beg dur)))
+ (frqf (make-env '(0 0 1 -1) :duration dur :scaler (hz->radians 500)))
+ (pulse-spacing (seconds->samples .064))
+ (pulse-samps (seconds->samples pulse-dur)))
+ (let ((pulse-ampf (make-env '(0.000 0.000 0.114 0.486 0.182 0.988 0.394 0.763 0.620 1.000 0.769 0.937 0.889 1.000 1.000 0.000)
+ :duration pulse-dur :scaler amp))
+ (pulse-frqf (make-env '(0.000 0.230 0.109 0.291 0.212 0.322 0.298 0.343 0.410 0.348 0.654 0.357 0.821 0.354 0.889 0.337 0.952 0.304 1.000 0.231)
+ :duration pulse-dur :scaler (hz->radians 22050.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01)))
+ (gen2 (make-polywave 0.0 '(5 .9 7 .07 8 .02 9 .01 11 .02)))
+ (pulse-ampf2 (make-env '(0 0 .65 0 .8 1 .9 1 1 0)
+ :duration pulse-dur :scaler .4))
+ (pulse-frqf2 (make-env '(0 5400 .6 5400 .75 6300 1 5400)
+ :duration pulse-dur :scaler (hz->radians 0.2) :base .1))
+ (first-stop (+ start pulse-samps)))
+
+ (do ((i start (+ i 1)))
+ ((= i first-stop))
+ (outa i (* (env pulse-ampf)
(polywave gen1 (+ (env pulse-frqf)
- (env frqf))))
- (if pulse2
- (* (env pulse-ampf2)
- (polywave gen2 (env pulse-frqf2)))
- 0.0)))))))
+ (env frqf))))))
+ (set! start (+ start pulse-spacing))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf)
+
+ (do ((i start (+ i pulse-spacing)))
+ ((>= i stop))
+ (let ((reset-stop (min stop (+ i pulse-samps))))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (outa k (+ (* (env pulse-ampf)
+ (polywave gen1 (+ (env pulse-frqf)
+ (env frqf))))
+ (* (env pulse-ampf2)
+ (polywave gen2 (env pulse-frqf2))))))
+ (mus-reset pulse-ampf)
+ (mus-reset pulse-frqf)
+ (mus-reset pulse-ampf2)
+ (mus-reset pulse-frqf2)))))))
;; (with-sound (:play #t) (bushtit 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Red-breasted nuthatch
-(definstrument (red-breasted-nuthatch beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.287)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.084 0.402 0.289 0.914 0.400 0.957 0.501 0.957 0.530 0.895 0.600 0.988
- 0.680 1.000 0.786 0.926 0.860 0.984 0.912 0.969 0.962 0.855 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.257 0.029 0.306 0.061 0.322 0.101 0.318 0.965 0.361 1.000 0.316)
- :duration dur :scaler (hz->radians (* 0.2 7510.0))))
- (gen1 (make-polywave :partials (list 1 .95 2 .03 3 .03)))
- (mod1 (make-oscil))
- (index (hz->radians (* 510 1.25)))
- (rnd (make-rand-interp 100 (hz->radians 6))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (polywave gen1 (+ (* 5 frq)
- (* index (oscil mod1 frq)))))))))))
+(defanimal (red-breasted-nuthatch beg amp)
+ (let ((dur 0.287))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.084 0.402 0.289 0.914 0.400 0.957 0.501 0.957 0.530 0.895 0.600 0.988
+ 0.680 1.000 0.786 0.926 0.860 0.984 0.912 0.969 0.962 0.855 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.257 0.029 0.306 0.061 0.322 0.101 0.318 0.965 0.361 1.000 0.316)
+ :duration dur :scaler (hz->radians (* 0.2 7510.0))))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .03 3 .03)))
+ (mod1 (make-oscil))
+ (index (hz->radians (* 510 1.25)))
+ (rnd (make-rand-interp 100 (hz->radians 6))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (* 5.0 frq)
+ (* index (oscil mod1 frq)))))))))))
;; (with-sound (:play #t) (red-breasted-nuthatch 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; White-breasted nuthatch
-(definstrument (white-breasted-nuthatch beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.31)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.157 0.871 0.386 1.000 0.728 0.759 0.951 0.306 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.318 0.045 0.392 0.160 0.418 0.254 0.418 0.517 0.404 0.816 0.367 1.000 0.310)
- :duration dur :scaler (hz->radians (* 0.25 8900))))
- (gen1 (make-polywave :partials (list 1 .96 2 .02 3 .03)))
- (gen2 (make-polywave :partials (list 4 .005 5 .01)))
- (ampf2 (make-env '(0 1 .65 1 .75 0 1 0) :duration dur))
- (mod1 (make-oscil))
- (index (hz->radians (* 800 0.4)))
- (rnd (make-rand-interp 100 (hz->radians 16)))
- (vib (make-oscil 40.0))
- (vib-index (hz->radians 50)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((vb (oscil vib))
- (frq (+ (env frqf)
- (rand-interp rnd)
- (* vib-index vb)))
- (mfrq (+ (* 3 frq)
- (* index (oscil mod1 frq)))))
- (outa i (* (env ampf)
- (+ .7 (* .3 (abs vb)))
- (+ (polywave gen1 mfrq)
- (* (env ampf2)
- (polywave gen2 mfrq))))))))))
+(defanimal (white-breasted-nuthatch beg amp)
+ (let ((dur 0.31))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.157 0.871 0.386 1.000 0.728 0.759 0.951 0.306 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.318 0.045 0.392 0.160 0.418 0.254 0.418 0.517 0.404 0.816 0.367 1.000 0.310)
+ :duration dur :scaler (hz->radians (* 0.25 8900))))
+ (gen1 (make-polywave 0.0 '(1 .96 2 .02 3 .03)))
+ (gen2 (make-polywave 0.0 '(4 .005 5 .01)))
+ (ampf2 (make-env '(0 1 .65 1 .75 0 1 0) :duration dur))
+ (mod1 (make-oscil))
+ (index (hz->radians (* 800 0.4)))
+ (rnd (make-rand-interp 100 (hz->radians 16)))
+ (vib (make-oscil 40.0))
+ (vib-index (hz->radians 50)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let* ((vb (oscil vib))
+ (frq (+ (env frqf)
+ (rand-interp rnd)
+ (* vib-index vb)))
+ (mfrq (+ (* 3.0 frq)
+ (* index (oscil mod1 frq)))))
+ (outa i (* (env ampf)
+ (+ .7 (* .3 (abs vb)))
+ (+ (polywave gen1 mfrq)
+ (* (env ampf2)
+ (polywave gen2 mfrq))))))))))
;; (with-sound (:play #t) (white-breasted-nuthatch 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Pygmy nuthatch
-(definstrument (pygmy-nuthatch beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.12)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.096 0.247 0.148 0.591 0.206 0.767 0.244 0.995 0.260 0.470 0.385 0.406
- 0.406 0.240 0.425 0.370 0.475 0.244 0.488 0.324 0.511 0.326 0.528 0.258 0.544 0.336
- 0.594 0.331 0.638 0.256 0.689 0.288 0.720 0.279 0.769 0.299 0.795 0.249 0.818 0.272
- 0.841 0.242 0.856 0.292 0.865 0.205 0.876 0.304 0.897 0.304 0.932 0.126 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.096 0.063 0.174 0.090 0.199 0.127 0.205 0.25 0.210 0.26 0.237 0.733 0.222
- 0.865 0.210 0.890 0.195 0.912 0.159 0.930 0.145 1.000 0.138)
- :duration dur :scaler (hz->radians 21500.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (pygmy-nuthatch beg amp)
+ (let ((dur 0.12))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.096 0.247 0.148 0.591 0.206 0.767 0.244 0.995 0.260 0.470 0.385 0.406
+ 0.406 0.240 0.425 0.370 0.475 0.244 0.488 0.324 0.511 0.326 0.528 0.258 0.544 0.336
+ 0.594 0.331 0.638 0.256 0.689 0.288 0.720 0.279 0.769 0.299 0.795 0.249 0.818 0.272
+ 0.841 0.242 0.856 0.292 0.865 0.205 0.876 0.304 0.897 0.304 0.932 0.126 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.096 0.063 0.174 0.090 0.199 0.127 0.205 0.25 0.210 0.26 0.237 0.733 0.222
+ 0.865 0.210 0.890 0.195 0.912 0.159 0.930 0.145 1.000 0.138)
+ :duration dur :scaler (hz->radians 21500.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (pygmy-nuthatch 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Flammulated owl
-(definstrument (flammulated-owl beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.25)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.146 0.603 0.286 0.858 0.455 0.992 0.629 0.983 0.789 0.819 0.907 0.473 0.946 0.445 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 340 .1 400 .15 410 .9 420 1 380) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
+(defanimal (flammulated-owl beg amp)
+ (let ((dur 0.25))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.146 0.603 0.286 0.858 0.455 0.992 0.629 0.983 0.789 0.819 0.907 0.473 0.946 0.445 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 340 .1 400 .15 410 .9 420 1 380) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
;; (with-sound (:play #t) (flammulated-owl 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Song sparrow
(define (song-sparrow beg1 amp1)
- (definstrument (song-sparrow-big-buzz beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.25)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.106 0.826 0.190 0.996 0.418 0.818 0.688 0.458 0.897 0.447 0.962 0.348 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 4400 .4 4200 1 4300) :duration dur :scaler (hz->radians 1.0)))
- (gen-up (make-polywave :partials (vct 1 .95 2 .03 3 .02)))
- (gen-down (make-polywave :partials (vct 1 .95 2 .03 3 .02)))
- (mod-up (make-oscil 142.0))
- (mod-down (make-oscil 142.0))
- (pulser (make-pulse-train 142.0))
- (ampf-up (make-env '(0 .1 .23 .01 .27 .01 .6 .5 .75 1 .8 .4 1 .1) :duration (/ 1.0 142.0)))
- (ampf-down (make-env '(0 .1 .2 .6 .25 1 .6 .1 .75 .001 1 .1) :duration (/ 1.0 142.0)))
- (ampf2 (make-env '(0 1 1 0) :duration dur :scaler 0.7))
- (rnd (make-rand-interp 6000 (hz->radians 300))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((modup (oscil mod-up))
- (moddown (oscil mod-down))
- (frq (+ (env frqf)
- (rand-interp rnd))))
- (if (> (pulse-train pulser) .1)
- (begin
- (mus-reset ampf-up)
- (mus-reset ampf-down)))
- (outa i (* (env ampf)
- (+ (* (env ampf-up)
- (polywave gen-up (+ frq (hz->radians 700)
- (* (hz->radians 800)
- modup))))
- (* (env ampf-down)
- (env ampf2)
- (polywave gen-down (+ frq (hz->radians -600)
- (* (hz->radians 800)
- moddown))))))))))))
-
- (definstrument (song-sparrow-clear-tone beg frq amp)
- (let* ((start (seconds->samples beg))
- (dur 0.062)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.054 0.208 0.138 0.327 0.162 0.292 0.306 0.659 0.352 0.698 0.400 0.835
- 0.468 0.894 0.507 0.808 0.548 0.906 0.593 0.833 0.623 0.939 0.668 0.902 0.710 0.971
- 0.735 0.678 0.759 0.937 0.777 1.000 0.792 0.820 0.800 0.922 0.847 0.806 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.203 0.043 0.253 0.118 0.276 0.446 0.263 0.575 0.251 0.707 0.226 0.883 0.187 1.000 0.153)
- :duration dur :scaler (hz->radians (* frq 22050.0))))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (song-sparrow-sweep-tone beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.036)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.048 0.158 0.098 0.474 0.201 0.574 0.235 0.206 0.357 0.206 0.419 0.366
- 0.468 0.331 0.489 0.173 0.519 0.579 0.567 0.639 0.604 0.972 0.647 0.556 0.697 0.391 0.75 0.0)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.358 0.033 0.355 0.060 0.321 0.078 0.240 0.098 0.214 0.120 0.257 0.153 0.364
- 0.187 0.420 0.242 0.428 0.289 0.418 0.348 0.390 0.465 0.381 0.531 0.360 0.571 0.338
- 0.609 0.306 0.668 0.246 0.75 0.223)
- :duration dur :scaler (hz->radians 22050.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .05))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (song-sparrow-sweep-caw beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.025)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.155 0.364 0.185 0.154 0.242 0.542 0.283 0.526 0.321 0.660 0.386 0.846
- 0.451 0.292 0.481 1.000 0.546 0.881 0.584 0.676 0.636 0.798 0.685 0.269 0.755 0.640
- 0.791 0.316 0.957 0.115 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.210 0.170 0.232 0.187 0.164 0.453 0.212 0.462 0.159 0.668 0.201 0.699 0.147
- 0.905 0.181 1.000 0.164)
- :duration dur :scaler (hz->radians 22050.0)))
- (gen (make-polywave :partials (list 2 .92 3 .02 4 .01 5 .005)))
- (rnd (make-rand-interp 4000 (hz->radians 500))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen (+ (* .5 (env frqf))
- (rand-interp rnd)))))))))
-
- (definstrument (song-sparrow-little-buzz beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.17)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 2 1 4 0) :duration dur :scaler amp))
- (frqf (make-env '(0 0 1 1) :duration dur :scaler (hz->radians 20)))
- (gen (make-polywave 610.0 (normalize-partials (list 3 .4 4 1 5 .01 6 .2 7 .03 8 .02 9 .01 10 .01 11 .01 12 .005))))
- (rnd (make-rand-interp 4000 (hz->radians 50)))
- (tri (make-triangle-wave 60 0.6)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ .4 (abs (triangle-wave tri)))
- (polywave gen (+ (env frqf)
- (rand-interp rnd)))))))))
-
- (definstrument (song-sparrow-sweep-down beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.186)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.125 0.212 0.164 1.000 0.206 0.218 0.231 0.278 0.243 0.470 0.273 0.136
- 0.301 0.419 0.311 0.691 0.329 0.530 0.341 0.501 0.354 0.295 0.373 0.382 0.383 0.193
- 0.397 0.232 0.403 0.127 0.415 0.238 0.426 0.173 0.433 0.238 0.452 0.088 0.528 0.286
- 0.552 0.150 0.564 0.309 0.590 0.133 0.608 0.303 0.635 0.204 0.659 0.215 0.673 0.275
- 0.709 0.380 0.718 0.292 0.727 0.354 0.749 0.235 0.800 0.139 0.831 0.153 0.853 0.232
- 0.886 0.130 0.911 0.337 0.932 0.147 0.949 0.224 0.965 0.082 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 9000 .08 7900 .164 7385 .2 7000 1 6960) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .05))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (song-sparrow-sweep-up beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.076)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 2 1 3 0) :base .1
- :duration dur :scaler amp))
- (frqf (make-env '(0 2260 .3 3000 .9 3100 1 3300)
- :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .01 4 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (song-sparrow-2nd-buzz beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.053)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.101 0.110 0.174 0.229 0.206 0.229 0.220 0.153 0.231 0.285 0.263 0.449
- 0.293 0.424 0.315 0.698 0.374 0.661 0.416 0.884 0.554 0.785 0.587 0.661 0.600 0.037
- 0.608 0.859 0.685 0.554 0.692 0.034 0.705 0.734 0.729 0.602 0.741 0.079 0.753 0.695
- 0.787 0.737 0.803 0.110 0.813 0.520 0.841 0.757 0.868 0.085 0.882 0.398 0.899 0.514
- 0.922 0.172 0.952 0.280 0.962 0.150 0.993 0.198 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0 3100 .4 3430 1 3140)
- :duration dur :offset (hz->radians 40) :scaler (hz->radians 0.5)))
- (gen1 (make-polywave :partials (list 1 .1 2 .5 3 .2 4 .1 6 .05 8 .03)))
- (vib (make-blackman 320 4)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((vb (blackman vib)))
- (outa i (* (env ampf)
- (+ .4 (* .6 vb))
- (polywave gen1 (+ (env frqf)
- (* (hz->radians 200) vb))))))))))
-
-
- (definstrument (song-sparrow-chiff beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.019)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 2 0) :duration dur :scaler amp))
- (frqf (make-env '(0 4800 .4 5500 .6 6060 .9 4200 1 4100)
- :duration dur :scaler (hz->radians 0.32)))
- (gen1 (make-polywave :partials (list 3 .7 4 .3 7 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (defanimal (song-sparrow-big-buzz beg amp)
+ (let ((dur 0.25))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.106 0.826 0.190 0.996 0.418 0.818 0.688 0.458 0.897 0.447 0.962 0.348 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 4400 .4 4200 1 4300) :duration dur :scaler (hz->radians 1.0)))
+ (gen-up (make-polywave 0.0 (vector 1 .95 2 .03 3 .02)))
+ (gen-down (make-polywave 0.0 (vector 1 .95 2 .03 3 .02)))
+ (mod-up (make-oscil 142.0))
+ (mod-down (make-oscil 142.0))
+ (pulse-samps (seconds->samples (/ 1.0 142.0)))
+ (ampf-up (make-env '(0 .1 .23 .01 .27 .01 .6 .5 .75 1 .8 .4 1 .1) :duration (/ 1.0 142.0)))
+ (ampf-down (make-env '(0 .1 .2 .6 .25 1 .6 .1 .75 .001 1 .1) :duration (/ 1.0 142.0)))
+ (ampf2 (make-env '(0 1 1 0) :duration dur :scaler 0.7))
+ (rnd (make-rand-interp 6000 (hz->radians 300)))
+ (h700 (hz->radians 700.0))
+ (h800 (hz->radians 800.0))
+ (h600 (hz->radians -600.0)))
+ (do ((i start (+ i pulse-samps)))
+ ((>= i stop))
+ (set! (mus-location frqf) (- i start))
+ (set! (mus-location ampf) (- i start))
+ (set! (mus-location ampf2) (- i start))
+ (let ((reset-stop (min stop (+ i pulse-samps)))
+ (pulse-amp (env ampf))
+ (pulse-amp2 (env ampf2))
+ (pulse-frq (env frqf)))
+ (do ((k i (+ k 1)))
+ ((= k reset-stop))
+ (let ((frq (+ pulse-frq (rand-interp rnd))))
+ (outa k (* pulse-amp
+ (+ (* (env ampf-up)
+ (polywave gen-up (+ frq h700 (* h800 (oscil mod-up)))))
+ (* pulse-amp2
+ (env ampf-down)
+ (polywave gen-down (+ frq h600 (* h800 (oscil mod-down))))))))))
+ (mus-reset ampf-up)
+ (mus-reset ampf-down))))))
+
+ (defanimal (song-sparrow-clear-tone beg frq amp)
+ (let ((dur 0.062))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.054 0.208 0.138 0.327 0.162 0.292 0.306 0.659 0.352 0.698 0.400 0.835
+ 0.468 0.894 0.507 0.808 0.548 0.906 0.593 0.833 0.623 0.939 0.668 0.902 0.710 0.971
+ 0.735 0.678 0.759 0.937 0.777 1.000 0.792 0.820 0.800 0.922 0.847 0.806 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.203 0.043 0.253 0.118 0.276 0.446 0.263 0.575 0.251 0.707 0.226 0.883 0.187 1.000 0.153)
+ :duration dur :scaler (hz->radians (* frq 22050.0))))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (song-sparrow-sweep-tone beg amp)
+ (let ((dur 0.036))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.048 0.158 0.098 0.474 0.201 0.574 0.235 0.206 0.357 0.206 0.419 0.366
+ 0.468 0.331 0.489 0.173 0.519 0.579 0.567 0.639 0.604 0.972 0.647 0.556 0.697 0.391 0.75 0.0)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.358 0.033 0.355 0.060 0.321 0.078 0.240 0.098 0.214 0.120 0.257 0.153 0.364
+ 0.187 0.420 0.242 0.428 0.289 0.418 0.348 0.390 0.465 0.381 0.531 0.360 0.571 0.338
+ 0.609 0.306 0.668 0.246 0.75 0.223)
+ :duration dur :scaler (hz->radians 22050.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .05))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (song-sparrow-sweep-caw beg amp)
+ (let ((dur 0.025))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.155 0.364 0.185 0.154 0.242 0.542 0.283 0.526 0.321 0.660 0.386 0.846
+ 0.451 0.292 0.481 1.000 0.546 0.881 0.584 0.676 0.636 0.798 0.685 0.269 0.755 0.640
+ 0.791 0.316 0.957 0.115 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.210 0.170 0.232 0.187 0.164 0.453 0.212 0.462 0.159 0.668 0.201 0.699 0.147
+ 0.905 0.181 1.000 0.164)
+ :duration dur :scaler (* .5 (hz->radians 22050.0))))
+ (gen (make-polywave 0.0 '(2 .92 3 .02 4 .01 5 .005)))
+ (rnd (make-rand-interp 4000 (hz->radians 500))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (polywave gen (+ (env frqf) (rand-interp rnd)))))))))
+
+ (defanimal (song-sparrow-little-buzz beg amp)
+ (let ((dur 0.17))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 2 1 4 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 0 1 1) :duration dur :scaler (hz->radians 20)))
+ (gen (make-polywave 610.0 (normalize-partials '(3 .4 4 1 5 .01 6 .2 7 .03 8 .02 9 .01 10 .01 11 .01 12 .005))))
+ (rnd (make-rand-interp 4000 (hz->radians 50)))
+ (tri (make-triangle-wave 60 0.6)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .4 (abs (triangle-wave tri)))
+ (polywave gen (+ (env frqf)
+ (rand-interp rnd)))))))))
+
+ (defanimal (song-sparrow-sweep-down beg amp)
+ (let ((dur 0.186))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.125 0.212 0.164 1.000 0.206 0.218 0.231 0.278 0.243 0.470 0.273 0.136
+ 0.301 0.419 0.311 0.691 0.329 0.530 0.341 0.501 0.354 0.295 0.373 0.382 0.383 0.193
+ 0.397 0.232 0.403 0.127 0.415 0.238 0.426 0.173 0.433 0.238 0.452 0.088 0.528 0.286
+ 0.552 0.150 0.564 0.309 0.590 0.133 0.608 0.303 0.635 0.204 0.659 0.215 0.673 0.275
+ 0.709 0.380 0.718 0.292 0.727 0.354 0.749 0.235 0.800 0.139 0.831 0.153 0.853 0.232
+ 0.886 0.130 0.911 0.337 0.932 0.147 0.949 0.224 0.965 0.082 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 9000 .08 7900 .164 7385 .2 7000 1 6960) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .05))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (song-sparrow-sweep-up beg amp)
+ (let ((dur 0.076))
+ (let ((start (seconds->samples beg))
+
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 2 1 3 0) :base .1
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 2260 .3 3000 .9 3100 1 3300)
+ :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .01 4 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (song-sparrow-2nd-buzz beg amp)
+ (let ((dur 0.053))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.101 0.110 0.174 0.229 0.206 0.229 0.220 0.153 0.231 0.285 0.263 0.449
+ 0.293 0.424 0.315 0.698 0.374 0.661 0.416 0.884 0.554 0.785 0.587 0.661 0.600 0.037
+ 0.608 0.859 0.685 0.554 0.692 0.034 0.705 0.734 0.729 0.602 0.741 0.079 0.753 0.695
+ 0.787 0.737 0.803 0.110 0.813 0.520 0.841 0.757 0.868 0.085 0.882 0.398 0.899 0.514
+ 0.922 0.172 0.952 0.280 0.962 0.150 0.993 0.198 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0 3100 .4 3430 1 3140)
+ :duration dur :offset (hz->radians 40) :scaler (hz->radians 0.5)))
+ (gen1 (make-polywave 0.0 '(1 .1 2 .5 3 .2 4 .1 6 .05 8 .03)))
+ (vib (make-blackman 320 4))
+ (scl (hz->radians 200)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((vb (blackman vib)))
+ (outa i (* (env ampf)
+ (+ .4 (* .6 vb))
+ (polywave gen1 (+ (env frqf)
+ (* scl vb))))))))))
+
+ (defanimal (song-sparrow-chiff beg amp)
+ (let ((dur 0.019))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 2 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 4800 .4 5500 .6 6060 .9 4200 1 4100)
+ :duration dur :scaler (hz->radians 0.32)))
+ (gen1 (make-polywave 0.0 '(3 .7 4 .3 7 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
(song-sparrow-little-buzz beg1 (* .25 amp1))
(song-sparrow-clear-tone (+ beg1 0.2) 1.0 (* 0.9 amp1))
@@ -7106,7 +7142,7 @@
(song-sparrow-little-buzz (+ beg1 .37) (* .4 amp1))
(song-sparrow-clear-tone (+ beg1 0.57) 1.0 amp1)
- (let ((amps (vct .14 .33 .37 .37 .30 .30 .30)))
+ (let ((amps (vector .14 .33 .37 .37 .30 .30 .30)))
(do ((i 0 (+ i 1))
(x 0.68 (+ x .1)))
((= i 7))
@@ -7125,252 +7161,244 @@
;; (with-sound (:play #t) (song-sparrow 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Burrowing owl
-(definstrument (burrowing-owl beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.6)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.038 0.510 0.060 0.743 0.082 0.822 0.114 0.775 0.125 0.692 0.204 0.000
- 0.416 0.000 0.465 0.858 0.500 1.000 0.571 0.921 0.611 0.937 0.927 0.526 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.029 0.035 0.108 0.045 0.133 0.091 0.135 0.129 0.132 0.176 0.107 0.190 0.043
- 0.424 0.046 0.446 0.110 0.468 0.133 0.75 .133 0.8 .129 0.936 0.127 0.973 0.104 1.000 0.035)
- :duration dur :scaler (hz->radians 6800.0)))
- (rnd (make-rand-interp 200 (hz->radians 5)))
- (gen1 (make-polywave :partials (list 1 .92 2 .08)))
- (gen2 (make-polywave :partials (list 3 .01 4 .01 6 .005 7 .007 8 .002 9 .002 10 .002 12 .001)))
- (ampf2 (make-env '(0 0 .05 0 .09 1 .13 1 .2 0 .45 0 .5 1 .9 1 1 0) :duration dur))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 0 .08 0 .12 .4 .2 0 .46 0 .5 .5 .6 0 .65 0 .8 1 .9 1 1 0) :duration dur :scaler .015)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (polywave gen2 frq))
- (* (env ampf3)
- (oscil gen3 (* 5 frq)))))))))))
+(defanimal (burrowing-owl beg amp)
+ (let ((dur 0.6))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.038 0.510 0.060 0.743 0.082 0.822 0.114 0.775 0.125 0.692 0.204 0.000
+ 0.416 0.000 0.465 0.858 0.500 1.000 0.571 0.921 0.611 0.937 0.927 0.526 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.029 0.035 0.108 0.045 0.133 0.091 0.135 0.129 0.132 0.176 0.107 0.190 0.043
+ 0.424 0.046 0.446 0.110 0.468 0.133 0.75 .133 0.8 .129 0.936 0.127 0.973 0.104 1.000 0.035)
+ :duration dur :scaler (hz->radians 6800.0)))
+ (rnd (make-rand-interp 200 (hz->radians 5)))
+ (gen1 (make-polywave 0.0 '(1 .92 2 .08)))
+ (gen2 (make-polywave 0.0 '(3 .01 4 .01 6 .005 7 .007 8 .002 9 .002 10 .002 12 .001)))
+ (ampf2 (make-env '(0 0 .05 0 .09 1 .13 1 .2 0 .45 0 .5 1 .9 1 1 0) :duration dur))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 0 .08 0 .12 .4 .2 0 .46 0 .5 .5 .6 0 .65 0 .8 1 .9 1 1 0) :duration dur :scaler .015)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (polywave gen2 frq))
+ (* (env ampf3)
+ (oscil gen3 (* 5.0 frq)))))))))))
;; (with-sound (:play #t) (burrowing-owl 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Gray vireo
;;;
;;; (I didn't really intend to do 5 of these calls)
-(definstrument (gray-vireo-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.23)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.059 0.052 0.078 0.132 0.085 0.076 0.099 0.100 0.108 0.260 0.125 0.102
- 0.134 0.280 0.143 0.254 0.146 0.306 0.158 0.197 0.184 0.403 0.193 0.403 0.201 0.180
- 0.208 0.239 0.217 0.375 0.222 0.000 0.229 0.232 0.237 0.158 0.254 0.800 0.263 0.846
- 0.307 0.785 0.322 0.850 0.334 1.000 0.350 0.731 0.357 0.822 0.369 0.599 0.378 0.711
- 0.384 0.375 0.389 0.688 0.393 0.315 0.396 0.657 0.410 0.291 0.419 0.414 0.491 0.412
- 0.566 0.258 0.593 0.06 0.659 0.01 0.754 0.06 0.772 0.245 0.854 0.523 0.892 0.330
- 0.932 0.436 0.947 0.182 0.957 0.228 0.981 0.063 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.203 0.033 0.198 0.051 0.218 0.064 0.189 0.085 0.226 0.101 0.187 0.116 0.214
- 0.133 0.183 0.199 0.172 0.216 0.186 0.242 0.288 0.256 0.330 0.297 0.330 0.324 0.316
- 0.441 0.243 0.506 0.215 0.556 0.206 0.690 0.107 0.721 0.104 0.739 0.136 0.769 0.215
- 0.796 0.266 0.833 0.282 1.000 0.29)
- :duration dur :scaler (hz->radians 10250.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (interpf (make-env '(0 .5 .2 .1 .25 .99 .6 .95 .7 .3 .75 .99 1 .99) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf))
- (interp (env interpf)))
- (outa i (* (env ampf)
- (+ (* interp
- (oscil gen1 frq))
- (* (- 1.0 interp)
- (oscil gen2 (* 2 frq)))))))))))
+(defanimal (gray-vireo-1 beg amp)
+ (let ((dur 0.23))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.059 0.052 0.078 0.132 0.085 0.076 0.099 0.100 0.108 0.260 0.125 0.102
+ 0.134 0.280 0.143 0.254 0.146 0.306 0.158 0.197 0.184 0.403 0.193 0.403 0.201 0.180
+ 0.208 0.239 0.217 0.375 0.222 0.000 0.229 0.232 0.237 0.158 0.254 0.800 0.263 0.846
+ 0.307 0.785 0.322 0.850 0.334 1.000 0.350 0.731 0.357 0.822 0.369 0.599 0.378 0.711
+ 0.384 0.375 0.389 0.688 0.393 0.315 0.396 0.657 0.410 0.291 0.419 0.414 0.491 0.412
+ 0.566 0.258 0.593 0.06 0.659 0.01 0.754 0.06 0.772 0.245 0.854 0.523 0.892 0.330
+ 0.932 0.436 0.947 0.182 0.957 0.228 0.981 0.063 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.203 0.033 0.198 0.051 0.218 0.064 0.189 0.085 0.226 0.101 0.187 0.116 0.214
+ 0.133 0.183 0.199 0.172 0.216 0.186 0.242 0.288 0.256 0.330 0.297 0.330 0.324 0.316
+ 0.441 0.243 0.506 0.215 0.556 0.206 0.690 0.107 0.721 0.104 0.739 0.136 0.769 0.215
+ 0.796 0.266 0.833 0.282 1.000 0.29)
+ :duration dur :scaler (hz->radians 10250.0)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (interpf (make-env '(0 .5 .2 .1 .25 .99 .6 .95 .7 .3 .75 .99 1 .99) :duration dur))
+ (interpf-1 (make-env '(0 .5 .2 .1 .25 .99 .6 .95 .7 .3 .75 .99 1 .99) :duration dur :offset 1.0 :scaler -1.0)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env interpf) (oscil gen1 frq))
+ (* (env interpf-1) (oscil gen2 (* 2.0 frq)))))))))))
;; (with-sound (:play #t) (gray-vireo-1 0 .5))
-(definstrument (gray-vireo-2 beg amp)
+(defanimal (gray-vireo-2 beg amp)
;; probably calif2 18 4
- (let* ((start (seconds->samples beg))
- (dur 0.23)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.026 0.099 0.067 0.176 0.097 0.111 0.110 0.199 0.147 0.096 0.186 0.110
- 0.214 0.068 0.228 0.113 0.245 0.069 0.254 0.097 0.264 0.209 0.274 0.143 0.291 0.096
- 0.301 0.250 0.315 0.347 0.332 0.166 0.343 0.144 0.353 0.369 0.364 0.446 0.371 0.429
- 0.390 0.196 0.403 0.383 0.411 0.495 0.434 0.372 0.442 0.192 0.456 0.449 0.471 0.364
- 0.479 0.505 0.486 0.487 0.492 0.413 0.500 0.455 0.509 0.323 0.515 0.361 0.519 0.212
- 0.524 0.259 0.529 0.469 0.548 0.549 0.562 0.235 0.565 0.316 0.576 0.385 0.582 0.488
- 0.594 0.493 0.600 0.402 0.612 0.355 0.616 0.414 0.624 0.306 0.636 0.289 0.641 0.223
- 0.648 0.349 0.655 0.287 0.674 0.325 0.682 0.270 0.691 0.133 0.712 0.275 0.726 0.319
- 0.743 0.578 0.765 0.722 0.776 0.651 0.796 1.000 0.808 0.686 0.816 0.556 0.825 0.826
- 0.833 0.527 0.835 0.725 0.848 0.281 0.855 0.639 0.861 0.405 0.863 0.485 0.869 0.250
- 0.871 0.414 0.876 0.193 0.882 0.468 0.886 0.443 0.894 0.141 0.897 0.312 0.901 0.181
- 0.903 0.435 0.907 0.339 0.910 0.432 0.937 0.399 0.949 0.234 0.974 0.243 0.993 0.159 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.260 0.040 0.245 0.091 0.203 0.122 0.174 0.152 0.221 0.174 0.240 0.190 0.297
- 0.211 0.232 0.227 0.284 0.248 0.250 0.261 0.331 0.289 0.260 0.304 0.333 0.321 0.336
- 0.337 0.286 0.356 0.349 0.371 0.346 0.386 0.299 0.406 0.359 0.422 0.359 0.439 0.307
- 0.460 0.383 0.474 0.380 0.489 0.352 0.513 0.414 0.533 0.378 0.546 0.385 0.564 0.432
- 0.582 0.383 0.598 0.393 0.609 0.435 0.678 0.430 0.719 0.466 0.780 0.518 0.821 0.560
- 0.856 0.620 0.922 0.677 1.000 0.701)
- :duration dur :scaler (hz->radians 6030.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (interpf (make-env '(0 .1 .2 .1 .3 .99 1 .99) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf))
- (interp (env interpf)))
- (outa i (* (env ampf)
- (+ (* interp
- (oscil gen1 frq))
- (* 0.5 (- 1.0 interp)
- (+ (oscil gen2 (* 2 frq))
- (oscil gen3 (* 3 frq))))))))))))
+ (let ((dur 0.23))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.026 0.099 0.067 0.176 0.097 0.111 0.110 0.199 0.147 0.096 0.186 0.110
+ 0.214 0.068 0.228 0.113 0.245 0.069 0.254 0.097 0.264 0.209 0.274 0.143 0.291 0.096
+ 0.301 0.250 0.315 0.347 0.332 0.166 0.343 0.144 0.353 0.369 0.364 0.446 0.371 0.429
+ 0.390 0.196 0.403 0.383 0.411 0.495 0.434 0.372 0.442 0.192 0.456 0.449 0.471 0.364
+ 0.479 0.505 0.486 0.487 0.492 0.413 0.500 0.455 0.509 0.323 0.515 0.361 0.519 0.212
+ 0.524 0.259 0.529 0.469 0.548 0.549 0.562 0.235 0.565 0.316 0.576 0.385 0.582 0.488
+ 0.594 0.493 0.600 0.402 0.612 0.355 0.616 0.414 0.624 0.306 0.636 0.289 0.641 0.223
+ 0.648 0.349 0.655 0.287 0.674 0.325 0.682 0.270 0.691 0.133 0.712 0.275 0.726 0.319
+ 0.743 0.578 0.765 0.722 0.776 0.651 0.796 1.000 0.808 0.686 0.816 0.556 0.825 0.826
+ 0.833 0.527 0.835 0.725 0.848 0.281 0.855 0.639 0.861 0.405 0.863 0.485 0.869 0.250
+ 0.871 0.414 0.876 0.193 0.882 0.468 0.886 0.443 0.894 0.141 0.897 0.312 0.901 0.181
+ 0.903 0.435 0.907 0.339 0.910 0.432 0.937 0.399 0.949 0.234 0.974 0.243 0.993 0.159 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.260 0.040 0.245 0.091 0.203 0.122 0.174 0.152 0.221 0.174 0.240 0.190 0.297
+ 0.211 0.232 0.227 0.284 0.248 0.250 0.261 0.331 0.289 0.260 0.304 0.333 0.321 0.336
+ 0.337 0.286 0.356 0.349 0.371 0.346 0.386 0.299 0.406 0.359 0.422 0.359 0.439 0.307
+ 0.460 0.383 0.474 0.380 0.489 0.352 0.513 0.414 0.533 0.378 0.546 0.385 0.564 0.432
+ 0.582 0.383 0.598 0.393 0.609 0.435 0.678 0.430 0.719 0.466 0.780 0.518 0.821 0.560
+ 0.856 0.620 0.922 0.677 1.000 0.701)
+ :duration dur :scaler (hz->radians 6030.0)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (interpf (make-env '(0 .1 .2 .1 .3 .99 1 .99) :duration dur))
+ (interpf-1 (make-env '(0 .1 .2 .1 .3 .99 1 .99) :duration dur :offset 1.0 :scaler -0.5)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env interpf) (oscil gen1 frq))
+ (* (env interpf-1)
+ (+ (oscil gen2 (* 2.0 frq))
+ (oscil gen3 (* 3.0 frq))))))))))))
;; (with-sound (:play #t) (gray-vireo-2 0 .5))
-(definstrument (gray-vireo-3 beg amp)
+(defanimal (gray-vireo-3 beg amp)
;; south 44 4
;; part 1 -- I could not find a way to get this right short of brute force additive synthesis
- (let* ((start (seconds->samples beg))
- (dur 0.1)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.167 0.561 0.210 0.243 0.245 0.298 0.272 0.793 0.437 0.171 0.572 0.296
- 0.604 0.202 0.734 0.599 0.759 0.597 0.829 0.425 0.881 0.843 1.000 0.000)
- :duration dur :scaler (* 0.2 amp)))
- (frqf (make-env '(0.000 0.260 0.060 0.301 0.100 0.371 0.151 0.442 0.191 0.465 0.251 0.447 0.313 0.365
- 0.381 0.266 0.458 0.228 0.546 0.231 0.632 0.243 0.708 0.275 0.792 0.310 0.855 0.339
- 0.899 0.389 0.934 0.404 0.964 0.398 1.000 0.363)
- :duration dur :scaler (hz->radians (* 1/3 11500.0))))
- (oscs (make-vector 5))
- (ampfs (make-vector 5)))
- (do ((i 0 (+ i 1)))
- ((= i 5))
- (set! (oscs i) (make-oscil)))
-
- (set! (ampfs 0) (make-env '(0.000 0.000 0.061 0.000 0.201 0.997 0.278 0.997 0.441 0.000 0.662 0.000
- 0.783 0.456 0.864 0.459 0.970 0.000 1.000 0.000)
- :duration dur :scaler .1))
- (set! (ampfs 1) (make-env '(0.000 0.000 0.153 0.639 0.307 0.639 0.457 0.109 0.617 0.107 0.739 1.000
- 0.913 1.000 1.000 0.298)
- :duration dur :scaler .4))
- (set! (ampfs 2) (make-env '(0.000 0.000 0.190 0.842 0.266 0.514 0.297 1.000 0.456 0.257 0.599 0.260
- 0.670 0.702 0.707 0.579 0.739 0.710 0.808 0.325 0.865 0.519 1.000 0.402)
- :duration dur :scaler .2))
- (set! (ampfs 3) (make-env '(0.000 0.000 0.064 0.077 0.157 0.653 0.255 0.699 0.311 0.995 0.352 0.615
- 0.389 0.986 0.458 0.178 0.667 0.363 0.750 0.000 1.000 0.000)
- :duration dur :scaler .07))
- (set! (ampfs 4) (make-env '(0.000 0.000 0.159 0.995 0.314 0.997 0.598 0.000 1.000 0.000)
- :duration dur :scaler .01))
-
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf))
- (sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k 5))
- (set! sum (+ sum (* (env (ampfs k)) (oscil (oscs k) (* (+ 1 k) frq))))))
- (outa i (* (env ampf) sum) )))))
+ (let ((dur 0.1))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.167 0.561 0.210 0.243 0.245 0.298 0.272 0.793 0.437 0.171 0.572 0.296
+ 0.604 0.202 0.734 0.599 0.759 0.597 0.829 0.425 0.881 0.843 1.000 0.000)
+ :duration dur :scaler (* 0.2 amp)))
+ (frqf (make-env '(0.000 0.260 0.060 0.301 0.100 0.371 0.151 0.442 0.191 0.465 0.251 0.447 0.313 0.365
+ 0.381 0.266 0.458 0.228 0.546 0.231 0.632 0.243 0.708 0.275 0.792 0.310 0.855 0.339
+ 0.899 0.389 0.934 0.404 0.964 0.398 1.000 0.363)
+ :duration dur :scaler (hz->radians (* 1/3 11500.0))))
+ (ampfs (make-vector 5)))
+
+ (set! (ampfs 0) (make-env '(0.000 0.000 0.061 0.000 0.201 0.997 0.278 0.997 0.441 0.000 0.662 0.000
+ 0.783 0.456 0.864 0.459 0.970 0.000 1.000 0.000)
+ :duration dur :scaler .1))
+ (set! (ampfs 1) (make-env '(0.000 0.000 0.153 0.639 0.307 0.639 0.457 0.109 0.617 0.107 0.739 1.000
+ 0.913 1.000 1.000 0.298)
+ :duration dur :scaler .4))
+ (set! (ampfs 2) (make-env '(0.000 0.000 0.190 0.842 0.266 0.514 0.297 1.000 0.456 0.257 0.599 0.260
+ 0.670 0.702 0.707 0.579 0.739 0.710 0.808 0.325 0.865 0.519 1.000 0.402)
+ :duration dur :scaler .2))
+ (set! (ampfs 3) (make-env '(0.000 0.000 0.064 0.077 0.157 0.653 0.255 0.699 0.311 0.995 0.352 0.615
+ 0.389 0.986 0.458 0.178 0.667 0.363 0.750 0.000 1.000 0.000)
+ :duration dur :scaler .07))
+ (set! (ampfs 4) (make-env '(0.000 0.000 0.159 0.995 0.314 0.997 0.598 0.000 1.000 0.000)
+ :duration dur :scaler .01))
+
+ (let ((frqs (make-float-vector 5 0.0))
+ (amps (make-float-vector 5 0.0)))
+ (let ((obank (make-oscil-bank frqs (make-float-vector 5 0.0) amps)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (do ((k 0 (+ k 1))
+ (f frq (+ f frq)))
+ ((= k 5))
+ (set! (amps k) (env (vector-ref ampfs k)))
+ (set! (frqs k) f))
+ (outa i (* (env ampf) (oscil-bank obank)))))))))
;; part 2
- (let* ((start (seconds->samples (+ beg 0.1)))
- (dur 0.137)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.042 0.123 0.086 0.399 0.155 0.626 0.176 0.169 0.190 0.691 0.205 0.877
- 0.224 0.552 0.246 0.828 0.274 0.978 0.319 0.937 0.356 0.893 0.410 0.866 0.461 0.956
- 0.565 0.784 0.622 0.311 0.648 0.423 0.671 0.279 0.688 0.096 0.705 0.328 0.713 0.284
- 0.725 0.096 0.807 0.254 0.844 0.134 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.493 0.034 0.542 0.048 0.550 0.066 0.515 0.102 0.485 0.151 0.463 0.168 0.431
- 0.181 0.455 0.198 0.450 0.216 0.436 0.232 0.439 0.444 0.439 0.572 0.444 0.703 0.463
- 0.800 0.472 1.000 0.458)
- :duration dur :scaler (hz->radians 7300.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .01 3 .02 4 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.137))
+ (let ((start (seconds->samples (+ beg 0.1)))
+ (stop (seconds->samples (+ beg 0.1 dur)))
+ (ampf (make-env '(0.000 0.000 0.042 0.123 0.086 0.399 0.155 0.626 0.176 0.169 0.190 0.691 0.205 0.877
+ 0.224 0.552 0.246 0.828 0.274 0.978 0.319 0.937 0.356 0.893 0.410 0.866 0.461 0.956
+ 0.565 0.784 0.622 0.311 0.648 0.423 0.671 0.279 0.688 0.096 0.705 0.328 0.713 0.284
+ 0.725 0.096 0.807 0.254 0.844 0.134 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.493 0.034 0.542 0.048 0.550 0.066 0.515 0.102 0.485 0.151 0.463 0.168 0.431
+ 0.181 0.455 0.198 0.450 0.216 0.436 0.232 0.439 0.444 0.439 0.572 0.444 0.703 0.463
+ 0.800 0.472 1.000 0.458)
+ :duration dur :scaler (hz->radians 7300.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .01 3 .02 4 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (gray-vireo-3 0 .5))
-(definstrument (gray-vireo-4 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.23)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.081 0.163 0.123 0.184 0.185 0.447 0.204 0.081 0.230 0.626 0.245 0.607
- 0.271 0.398 0.293 0.130 0.305 0.347 0.326 0.444 0.339 0.279 0.349 0.382 0.366 0.751
- 0.388 0.347 0.405 0.965 0.417 0.783 0.435 0.992 0.452 0.737 0.471 0.916 0.523 0.702
- 0.534 0.526 0.543 0.770 0.563 0.496 0.581 0.558 0.625 0.393 0.646 0.439 0.712 0.388
- 0.761 0.455 0.832 0.141 0.845 0.081 0.875 0.106 0.911 0.068 0.959 0.154 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.534 0.054 0.509 0.089 0.480 0.128 0.447 0.168 0.477 0.195 0.531 0.224 0.661
- 0.240 0.507 0.278 0.350 0.304 0.295 0.319 0.333 0.334 0.409 0.352 0.369 0.370 0.442
- 0.398 0.431 0.414 0.504 0.485 0.493 0.563 0.458 0.621 0.431 0.697 0.423 0.814 0.409
- 1.000 0.420)
- :duration dur :scaler (hz->radians 6230.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .003 3 .007)))
- (ampf1 (make-env '(0 0 .22 0 .23 1 1 1) :duration dur))
- (gen2 (make-polywave :partials (list 1 .05 2 .9 3 .1 4 .07)))
- (ampf2 (make-env '(0 1 .2 1 .22 0 1 0) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (polywave gen1 frq))
- (* (env ampf2)
- (polywave gen2 (* 0.5 frq)))))))))))
+(defanimal (gray-vireo-4 beg amp)
+ (let ((dur 0.23))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.081 0.163 0.123 0.184 0.185 0.447 0.204 0.081 0.230 0.626 0.245 0.607
+ 0.271 0.398 0.293 0.130 0.305 0.347 0.326 0.444 0.339 0.279 0.349 0.382 0.366 0.751
+ 0.388 0.347 0.405 0.965 0.417 0.783 0.435 0.992 0.452 0.737 0.471 0.916 0.523 0.702
+ 0.534 0.526 0.543 0.770 0.563 0.496 0.581 0.558 0.625 0.393 0.646 0.439 0.712 0.388
+ 0.761 0.455 0.832 0.141 0.845 0.081 0.875 0.106 0.911 0.068 0.959 0.154 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.534 0.054 0.509 0.089 0.480 0.128 0.447 0.168 0.477 0.195 0.531 0.224 0.661
+ 0.240 0.507 0.278 0.350 0.304 0.295 0.319 0.333 0.334 0.409 0.352 0.369 0.370 0.442
+ 0.398 0.431 0.414 0.504 0.485 0.493 0.563 0.458 0.621 0.431 0.697 0.423 0.814 0.409
+ 1.000 0.420)
+ :duration dur :scaler (hz->radians 6230.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .003 3 .007)))
+ (ampf1 (make-env '(0 0 .22 0 .23 1 1 1) :duration dur))
+ (gen2 (make-polywave 0.0 '(1 .05 2 .9 3 .1 4 .07)))
+ (ampf2 (make-env '(0 1 .2 1 .22 0 1 0) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (polywave gen1 frq))
+ (* (env ampf2)
+ (polywave gen2 (* 0.5 frq)))))))))))
;; (with-sound (:play #t) (gray-vireo-4 0 .5))
-(definstrument (gray-vireo-5 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.256)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.010 0.160 0.025 0.133 0.044 0.301 0.060 0.314 0.072 0.724 0.085 0.678
- 0.088 0.374 0.106 0.634 0.114 0.930 0.127 0.718 0.141 1.000 0.175 0.233 0.220 0.528
- 0.244 0.496 0.270 0.648 0.320 0.564 0.353 0.393 0.376 0.667 0.443 0.623 0.493 0.447
- 0.524 0.474 0.570 0.287 0.583 0.320 0.682 0.117 0.856 0.079 0.933 0.057 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.371 0.029 0.393 0.047 0.428 0.074 0.425 0.097 0.333 0.116 0.206 0.149 0.168
- 0.192 0.190 0.242 0.214 0.314 0.217 0.437 0.198 0.876 0.165 1.000 0.146)
- :duration dur :scaler (hz->radians 11150.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 4 .005)))
- (ampf1 (make-env '(0 1 .09 1 .14 .1 .2 1 .6 .8 .9 .8 1 1) :duration dur))
- (gen2 (make-oscil))
- (ampf2 (make-env '(0 0 .09 0 .14 1 .18 1 .23 0 .6 0 .7 .4 1 0) :duration dur :scaler .5))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 0 .2 0 .25 1 .5 1 .6 0 1 0) :duration dur :scaler .01)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (polywave gen1 frq))
- (* (env ampf2)
- (oscil gen2 (* frq 2)))
- (* (env ampf3)
- (oscil gen3 (* frq 3)))))))))))
+(defanimal (gray-vireo-5 beg amp)
+ (let ((dur 0.256))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.010 0.160 0.025 0.133 0.044 0.301 0.060 0.314 0.072 0.724 0.085 0.678
+ 0.088 0.374 0.106 0.634 0.114 0.930 0.127 0.718 0.141 1.000 0.175 0.233 0.220 0.528
+ 0.244 0.496 0.270 0.648 0.320 0.564 0.353 0.393 0.376 0.667 0.443 0.623 0.493 0.447
+ 0.524 0.474 0.570 0.287 0.583 0.320 0.682 0.117 0.856 0.079 0.933 0.057 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.371 0.029 0.393 0.047 0.428 0.074 0.425 0.097 0.333 0.116 0.206 0.149 0.168
+ 0.192 0.190 0.242 0.214 0.314 0.217 0.437 0.198 0.876 0.165 1.000 0.146)
+ :duration dur :scaler (hz->radians 11150.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 4 .005)))
+ (ampf1 (make-env '(0 1 .09 1 .14 .1 .2 1 .6 .8 .9 .8 1 1) :duration dur))
+ (gen2 (make-oscil))
+ (ampf2 (make-env '(0 0 .09 0 .14 1 .18 1 .23 0 .6 0 .7 .4 1 0) :duration dur :scaler .5))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 0 .2 0 .25 1 .5 1 .6 0 1 0) :duration dur :scaler .01)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (polywave gen1 frq))
+ (* (env ampf2)
+ (oscil gen2 (* frq 2)))
+ (* (env ampf3)
+ (oscil gen3 (* frq 3)))))))))))
;; (with-sound (:play #t) (gray-vireo-5 0 .5))
@@ -7388,111 +7416,100 @@
(define (bald-eagle beg amp)
- (definstrument (bald-eagle-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.153)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.016 0.145 0.042 0.773 0.084 0.471 0.097 0.265 0.112 0.124 0.123 0.297
- 0.134 0.937 0.151 0.665 0.166 0.810 0.194 0.733 0.228 0.218 0.244 0.059 0.269 0.373
- 0.280 0.621 0.292 0.597 0.314 0.681 0.368 0.241 0.389 0.332 0.411 0.688 0.431 0.674
- 0.447 0.539 0.477 0.452 0.517 0.572 0.534 0.550 0.555 0.455 0.576 0.457 0.597 0.494
- 0.613 0.391 0.630 0.073 0.648 0.164 0.671 0.119 0.680 0.014 0.700 0.077 0.737 0.045
- 0.757 0.075 0.803 0.024 0.817 0.065 0.855 0.028 0.866 0.063 0.906 0.033 0.973 0.042 1.000 0.000)
- :duration dur :scaler amp))
- (frqf1 (make-env '(0.000 0.268 0.042 0.273 0.132 0.280 0.281 0.280 0.409 0.273 0.609 0.282 0.686 0.289 1.000 0.273)
- :duration dur :scaler (hz->radians 10000.0)))
- (frqf2 (make-env '(0.000 0.541 0.050 0.543 0.130 0.555 0.202 0.559 0.271 0.568 0.413 0.534 0.522 0.543
- 0.586 0.559 0.638 0.582 0.706 0.566 0.791 0.539 0.852 0.516 0.922 0.466 0.962 0.400 1.000 0.309)
- :duration dur :scaler (hz->radians 10000.0)))
- (gen1 (make-polywave :partials (list 1 .98 3 .02)))
- (gen2 (make-polywave :partials (list 1 .95 2 .05)))
- (intrpf (make-env '(0 .9 .6 .9 .7 .5 1 .5) :duration dur))
- (rnd (make-rand-interp 2000 ))
- (rndf (make-env '(0 0 .02 0 .04 1 .06 0 .13 0 .135 1 .14 0 .27 0 .276 1 .28 0 .4 0 .405 1 .41 0 .678 0 .682 1 1 1)
- :duration dur :offset (hz->radians 40) :scaler (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((intrp (env intrpf))
- (noise (* (env rndf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (* intrp (polywave gen1 (+ (env frqf1)
- noise)))
- (* (- 1.0 intrp) (polywave gen2 (+ (env frqf2)
- (* 2 noise))))))))))))
-
- (definstrument (bald-eagle-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.074)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.045 0.084 0.073 0.223 0.176 0.395 0.207 1.000 0.245 0.616 0.276 0.093
- 0.301 0.325 0.349 0.316 0.396 0.211 0.445 0.075 0.643 0.145 0.777 0.170 0.804 0.291
- 0.848 0.164 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.752 0.065 0.617 0.116 0.597 0.140 0.513 0.158 0.420 0.177 0.273 0.255 0.285
- 0.351 0.285 0.393 0.285 0.467 0.287 0.518 0.293 0.582 0.301 0.638 0.163 0.690 0.225
- 0.752 0.282 0.800 0.262 0.875 0.268 1.000 0.290)
- :duration dur :scaler (hz->radians 10100.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01)))
- (rnd (make-rand-interp 2000))
- (rndf (make-env '(0 0 .16 0 .25 1 1 .5) :duration dur :offset (hz->radians 100) :scaler (hz->radians 500))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (* (env rndf)
- (rand-interp rnd))))))))))
-
- (definstrument (bald-eagle-3 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.074)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.048 0.225 0.130 0.273 0.170 0.507 0.190 1.000 0.204 0.775 0.259 0.761
- 0.318 0.349 0.361 0.501 0.447 0.045 0.476 0.375 0.539 0.476 0.560 0.679 0.593 0.670
- 0.613 0.583 0.668 0.028 0.684 0.177 0.727 0.068 0.741 0.400 0.766 0.504 0.784 0.372
- 0.826 0.400 0.857 0.318 0.879 0.085 0.937 0.045 0.979 0.073 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.449 0.076 0.410 0.122 0.325 0.150 0.195 0.190 0.195 0.255 0.198 0.371 0.198
- 0.436 0.198 0.465 0.215 0.521 0.203 0.745 0.198 1.000 0.195)
- :duration dur :scaler (hz->radians 14000.0)))
- (gen1 (make-polywave :partials (list 1 .99 3 .01)))
- (gen2 (make-polywave :partials (list 1 .9 2 .1)))
- (ampf2 (make-env '(0 0 .2 0 .25 1 .3 1 .35 0 .5 0 .55 1 .6 1 .65 0 .75 0 .8 .5 .9 0 1 0) :scaler .1 :duration dur))
- (rnd (make-rand-interp 2000 (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (polywave gen2 (* 2 frq)))))))))))
-
- (definstrument (bald-eagle-4 beg frqscl amp)
- (let* ((start (seconds->samples beg))
- (dur 0.056)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.079 0.116 0.125 0.198 0.154 0.867 0.190 0.994 0.214 0.743 0.260 0.867
- 0.282 0.802 0.315 0.825 0.330 0.636 0.371 0.678 0.423 0.825 0.468 0.734 0.504 0.542
- 0.549 0.619 0.595 0.960 0.637 0.686 0.669 0.130 0.772 0.418 0.823 0.147 0.890 0.056
- 0.929 0.090 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.215 0.035 0.243 0.060 0.285 0.086 0.268 0.121 0.198 0.135 0.137 0.154 0.167
- 0.218 0.186 0.880 0.181 1.000 0.192)
- :duration dur :scaler (hz->radians (* frqscl 13920))))
- (gen1 (make-polywave :partials (list 1 .96 2 .04 3 .007 4 .002)))
- (rnd (make-rand-interp 4000 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (polywave gen1 frq))))))))
-
+ (defanimal (bald-eagle-1 beg amp)
+ (let ((dur 0.153))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.016 0.145 0.042 0.773 0.084 0.471 0.097 0.265 0.112 0.124 0.123 0.297
+ 0.134 0.937 0.151 0.665 0.166 0.810 0.194 0.733 0.228 0.218 0.244 0.059 0.269 0.373
+ 0.280 0.621 0.292 0.597 0.314 0.681 0.368 0.241 0.389 0.332 0.411 0.688 0.431 0.674
+ 0.447 0.539 0.477 0.452 0.517 0.572 0.534 0.550 0.555 0.455 0.576 0.457 0.597 0.494
+ 0.613 0.391 0.630 0.073 0.648 0.164 0.671 0.119 0.680 0.014 0.700 0.077 0.737 0.045
+ 0.757 0.075 0.803 0.024 0.817 0.065 0.855 0.028 0.866 0.063 0.906 0.033 0.973 0.042 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf1 (make-env '(0.000 0.268 0.042 0.273 0.132 0.280 0.281 0.280 0.409 0.273 0.609 0.282 0.686 0.289 1.000 0.273)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (frqf2 (make-env '(0.000 0.541 0.050 0.543 0.130 0.555 0.202 0.559 0.271 0.568 0.413 0.534 0.522 0.543
+ 0.586 0.559 0.638 0.582 0.706 0.566 0.791 0.539 0.852 0.516 0.922 0.466 0.962 0.400 1.000 0.309)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 3 .02)))
+ (gen2 (make-polywave 0.0 '(1 .95 2 .05)))
+ (intrpf (make-env '(0 .9 .6 .9 .7 .5 1 .5) :duration dur))
+ (intrpf-1 (make-env '(0 .9 .6 .9 .7 .5 1 .5) :duration dur :offset 1.0 :scaler -1.0))
+ (rnd (make-rand-interp 2000 ))
+ (rndf (make-env '(0 0 .02 0 .04 1 .06 0 .13 0 .135 1 .14 0 .27 0 .276 1 .28 0 .4 0 .405 1 .41 0 .678 0 .682 1 1 1)
+ :duration dur :offset (hz->radians 40) :scaler (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((noise (* (env rndf) (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (* (env intrpf) (polywave gen1 (+ (env frqf1) noise)))
+ (* (env intrpf-1) (polywave gen2 (+ (env frqf2) (* 2.0 noise))))))))))))
+
+ (defanimal (bald-eagle-2 beg amp)
+ (let ((dur 0.074))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.045 0.084 0.073 0.223 0.176 0.395 0.207 1.000 0.245 0.616 0.276 0.093
+ 0.301 0.325 0.349 0.316 0.396 0.211 0.445 0.075 0.643 0.145 0.777 0.170 0.804 0.291
+ 0.848 0.164 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.752 0.065 0.617 0.116 0.597 0.140 0.513 0.158 0.420 0.177 0.273 0.255 0.285
+ 0.351 0.285 0.393 0.285 0.467 0.287 0.518 0.293 0.582 0.301 0.638 0.163 0.690 0.225
+ 0.752 0.282 0.800 0.262 0.875 0.268 1.000 0.290)
+ :duration dur :scaler (hz->radians 10100.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01)))
+ (rnd (make-rand-interp 2000))
+ (rndf (make-env '(0 0 .16 0 .25 1 1 .5) :duration dur :offset (hz->radians 100) :scaler (hz->radians 500))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (* (env rndf)
+ (rand-interp rnd))))))))))
+
+ (defanimal (bald-eagle-3 beg amp)
+ (let ((dur 0.074))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.048 0.225 0.130 0.273 0.170 0.507 0.190 1.000 0.204 0.775 0.259 0.761
+ 0.318 0.349 0.361 0.501 0.447 0.045 0.476 0.375 0.539 0.476 0.560 0.679 0.593 0.670
+ 0.613 0.583 0.668 0.028 0.684 0.177 0.727 0.068 0.741 0.400 0.766 0.504 0.784 0.372
+ 0.826 0.400 0.857 0.318 0.879 0.085 0.937 0.045 0.979 0.073 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.449 0.076 0.410 0.122 0.325 0.150 0.195 0.190 0.195 0.255 0.198 0.371 0.198
+ 0.436 0.198 0.465 0.215 0.521 0.203 0.745 0.198 1.000 0.195)
+ :duration dur :scaler (hz->radians 14000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 3 .01)))
+ (gen2 (make-polywave 0.0 '(1 .9 2 .1)))
+ (ampf2 (make-env '(0 0 .2 0 .25 1 .3 1 .35 0 .5 0 .55 1 .6 1 .65 0 .75 0 .8 .5 .9 0 1 0) :scaler .1 :duration dur))
+ (rnd (make-rand-interp 2000 (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (polywave gen2 (* 2.0 frq)))))))))))
+
+ (defanimal (bald-eagle-4 beg frqscl amp)
+ (let ((dur 0.056))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.079 0.116 0.125 0.198 0.154 0.867 0.190 0.994 0.214 0.743 0.260 0.867
+ 0.282 0.802 0.315 0.825 0.330 0.636 0.371 0.678 0.423 0.825 0.468 0.734 0.504 0.542
+ 0.549 0.619 0.595 0.960 0.637 0.686 0.669 0.130 0.772 0.418 0.823 0.147 0.890 0.056
+ 0.929 0.090 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.215 0.035 0.243 0.060 0.285 0.086 0.268 0.121 0.198 0.135 0.137 0.154 0.167
+ 0.218 0.186 0.880 0.181 1.000 0.192)
+ :duration dur :scaler (hz->radians (* frqscl 13920))))
+ (gen1 (make-polywave 0.0 '(1 .96 2 .04 3 .007 4 .002)))
+ (rnd (make-rand-interp 4000 (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (polywave gen1 (+ (env frqf) (rand-interp rnd)))))))))
(bald-eagle-1 beg (* amp .8))
(bald-eagle-2 (+ beg .195) (* amp .7))
@@ -7504,74 +7521,74 @@
;; (with-sound (:play #t) (bald-eagle 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Eastern meadowlark
-(definstrument (eastern-meadowlark beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.65)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.011 0.304 0.022 0.310 0.032 0.162 0.039 0.000 0.121 0.000 0.136 0.148
- 0.145 0.138 0.152 0.184 0.170 0.430 0.188 0.406 0.213 0.556 0.244 0.700 0.273 0.999
- 0.280 0.992 0.293 0.000 0.335 0.000 0.341 0.169 0.356 0.786 0.369 0.941 0.389 0.689
- 0.399 0.622 0.430 0.515 0.480 0.426 0.494 0.000 0.518 0.000 0.524 0.383 0.528 0.017
- 0.540 0.446 0.549 0.000 0.585 0.000 0.591 0.113 0.610 0.134 0.631 0.175 0.644 0.261
- 0.656 0.212 0.665 0.282 0.680 0.196 0.691 0.233 0.702 0.182 0.715 0.226 0.726 0.281
- 0.733 0.268 0.747 0.370 0.753 0.328 0.760 0.450 0.767 0.402 0.770 0.469 0.777 0.412
- 0.795 0.714 0.812 0.515 0.825 0.444 0.839 0.250 0.843 0.015 0.852 0.295 0.856 0.254
- 0.858 0.045 0.863 0.008 0.867 0.075 0.870 0.279 0.878 0.304 0.891 0.189 0.910 0.115
- 0.932 0.068 0.960 0.034 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.197 0.051 0.192 0.097 0.437 0.129 0.421 0.201 0.371 0.285 0.332 0.325 0.343
- 0.341 0.358 0.386 0.269 0.410 0.245 0.481 0.231 0.524 0.229 0.533 0.214 0.557 0.214
- 0.576 0.231 0.579 0.725 0.588 0.710 0.594 0.635 0.606 0.596 0.644 0.509 0.724 0.439
- 0.756 0.397 0.800 0.297 0.825 0.264 0.851 0.271 0.870 0.275 0.892 0.214 0.925 0.194 1.000 0.197)
- :duration dur :scaler (hz->radians 10280.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .01 4 .005 5 .002)))
- (buzz (make-oscil 350))
- (buzzf (make-env '(0 0 .59 0 .6 1 .61 1 .64 0 1 0) :duration dur :scaler (hz->radians 300))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (* (env buzzf)
- (oscil buzz))))))))))
+(defanimal (eastern-meadowlark beg amp)
+ (let ((dur 1.65))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.011 0.304 0.022 0.310 0.032 0.162 0.039 0.000 0.121 0.000 0.136 0.148
+ 0.145 0.138 0.152 0.184 0.170 0.430 0.188 0.406 0.213 0.556 0.244 0.700 0.273 0.999
+ 0.280 0.992 0.293 0.000 0.335 0.000 0.341 0.169 0.356 0.786 0.369 0.941 0.389 0.689
+ 0.399 0.622 0.430 0.515 0.480 0.426 0.494 0.000 0.518 0.000 0.524 0.383 0.528 0.017
+ 0.540 0.446 0.549 0.000 0.585 0.000 0.591 0.113 0.610 0.134 0.631 0.175 0.644 0.261
+ 0.656 0.212 0.665 0.282 0.680 0.196 0.691 0.233 0.702 0.182 0.715 0.226 0.726 0.281
+ 0.733 0.268 0.747 0.370 0.753 0.328 0.760 0.450 0.767 0.402 0.770 0.469 0.777 0.412
+ 0.795 0.714 0.812 0.515 0.825 0.444 0.839 0.250 0.843 0.015 0.852 0.295 0.856 0.254
+ 0.858 0.045 0.863 0.008 0.867 0.075 0.870 0.279 0.878 0.304 0.891 0.189 0.910 0.115
+ 0.932 0.068 0.960 0.034 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.197 0.051 0.192 0.097 0.437 0.129 0.421 0.201 0.371 0.285 0.332 0.325 0.343
+ 0.341 0.358 0.386 0.269 0.410 0.245 0.481 0.231 0.524 0.229 0.533 0.214 0.557 0.214
+ 0.576 0.231 0.579 0.725 0.588 0.710 0.594 0.635 0.606 0.596 0.644 0.509 0.724 0.439
+ 0.756 0.397 0.800 0.297 0.825 0.264 0.851 0.271 0.870 0.275 0.892 0.214 0.925 0.194 1.000 0.197)
+ :duration dur :scaler (hz->radians 10280.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .01 4 .005 5 .002)))
+ (buzz (make-oscil 350))
+ (buzzf (make-env '(0 0 .59 0 .6 1 .61 1 .64 0 1 0) :duration dur :scaler (hz->radians 300))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (* (env buzzf)
+ (oscil buzz))))))))))
;; (with-sound (:play #t) (eastern-meadowlark 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Yellow-green vireo
-(definstrument (yellow-green-vireo beg amp)
+(defanimal (yellow-green-vireo beg amp)
;; south 48 3.5
- (let* ((start (seconds->samples beg))
- (dur 0.22)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.054 0.070 0.083 0.403 0.109 0.142 0.137 0.558 0.155 0.682 0.173 0.408
- 0.183 0.915 0.213 0.879 0.236 1.000 0.290 0.938 0.309 0.257 0.311 0.800 0.321 0.384
- 0.329 0.607 0.337 0.117 0.345 0.930 0.357 0.155 0.390 0.329 0.395 0.486 0.418 0.359
- 0.436 0.274 0.493 0.384 0.518 0.363 0.529 0.276 0.542 0.471 0.567 0.490 0.573 0.361
- 0.587 0.618 0.595 0.380 0.600 0.722 0.609 0.365 0.622 0.845 0.652 0.193 0.665 0.913
- 0.715 0.713 0.731 0.837 0.745 0.486 0.753 0.826 0.764 0.713 0.780 0.204 0.787 0.437
- 0.799 0.053 0.816 0.255 0.859 0.501 0.885 0.735 0.910 0.378 0.924 0.724 0.958 0.098
- 0.966 0.197 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.310 0.043 0.321 0.074 0.470 0.095 0.523 0.113 0.544 0.138 0.513 0.170 0.451
- 0.224 0.413 0.291 0.418 0.314 0.451 0.330 0.392 0.348 0.340 0.369 0.298 0.392 0.278
- 0.442 0.262 0.515 0.266 0.574 0.295 0.617 0.338 0.647 0.380 0.672 0.418 0.692 0.439
- 0.738 0.454 0.793 0.464 0.843 0.464 0.890 0.477 0.923 0.490 0.955 0.494 0.978 0.475
- 1.000 0.433)
- :duration dur :scaler (hz->radians 10000.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .003 3 .02))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.22))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.054 0.070 0.083 0.403 0.109 0.142 0.137 0.558 0.155 0.682 0.173 0.408
+ 0.183 0.915 0.213 0.879 0.236 1.000 0.290 0.938 0.309 0.257 0.311 0.800 0.321 0.384
+ 0.329 0.607 0.337 0.117 0.345 0.930 0.357 0.155 0.390 0.329 0.395 0.486 0.418 0.359
+ 0.436 0.274 0.493 0.384 0.518 0.363 0.529 0.276 0.542 0.471 0.567 0.490 0.573 0.361
+ 0.587 0.618 0.595 0.380 0.600 0.722 0.609 0.365 0.622 0.845 0.652 0.193 0.665 0.913
+ 0.715 0.713 0.731 0.837 0.745 0.486 0.753 0.826 0.764 0.713 0.780 0.204 0.787 0.437
+ 0.799 0.053 0.816 0.255 0.859 0.501 0.885 0.735 0.910 0.378 0.924 0.724 0.958 0.098
+ 0.966 0.197 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.310 0.043 0.321 0.074 0.470 0.095 0.523 0.113 0.544 0.138 0.513 0.170 0.451
+ 0.224 0.413 0.291 0.418 0.314 0.451 0.330 0.392 0.348 0.340 0.369 0.298 0.392 0.278
+ 0.442 0.262 0.515 0.266 0.574 0.295 0.617 0.338 0.647 0.380 0.672 0.418 0.692 0.439
+ 0.738 0.454 0.793 0.464 0.843 0.464 0.890 0.477 0.923 0.490 0.955 0.494 0.978 0.475
+ 1.000 0.433)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .003 3 .02))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (yellow-green-vireo 0 .5))
@@ -7581,45 +7598,45 @@
;;;
;;; Magnolia warbler
-(definstrument (magnolia-warbler beg amp)
+(defanimal (magnolia-warbler beg amp)
;; east 13 3
- (let* ((start (seconds->samples beg))
- (dur 0.96)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.018 0.030 0.034 0.085 0.060 0.000 0.071 0.040 0.087 0.058 0.105 0.137
- 0.110 0.027 0.118 0.000 0.176 0.000 0.211 0.076 0.226 0.218 0.229 0.366 0.240 0.419
- 0.252 0.088 0.261 0.000 0.300 0.000 0.321 0.391 0.325 0.340 0.330 0.490 0.336 0.516
- 0.338 0.482 0.342 0.620 0.344 0.364 0.346 0.600 0.357 0.562 0.365 0.000 0.370 0.059
- 0.384 0.542 0.387 0.484 0.393 0.626 0.406 0.788 0.422 0.000 0.458 0.000 0.474 0.186
- 0.490 0.246 0.498 0.275 0.511 0.541 0.513 0.475 0.526 0.917 0.536 0.633 0.539 0.698
- 0.554 0.000 0.593 0.000 0.610 0.414 0.613 0.794 0.617 0.689 0.619 0.847 0.625 0.942
- 0.628 0.480 0.631 0.904 0.636 0.814 0.653 0.000 0.657 0.083 0.671 0.768 0.675 0.655
- 0.679 0.801 0.686 0.999 0.695 0.818 0.704 0.000 0.734 0.000 0.750 0.657 0.756 0.797
- 0.762 0.750 0.768 0.581 0.772 0.970 0.778 0.869 0.783 0.710 0.789 0.573 0.796 0.549
- 0.805 0.251 0.807 0.524 0.816 0.199 0.823 0.257 0.831 0.541 0.841 0.565 0.847 0.847
- 0.852 0.653 0.856 0.511 0.861 0.429 0.866 0.472 0.871 0.285 0.876 0.463 0.882 0.216
- 0.887 0.387 0.891 0.311 0.895 0.369 0.902 0.301 0.905 0.359 0.912 0.326 0.915 0.410
- 0.919 0.369 0.924 0.394 0.925 0.357 0.932 0.398 0.952 0.277 0.973 0.064 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.530 0.020 0.591 0.048 0.447 0.055 0.754 0.073 0.660 0.101 0.579 0.108 0.519
- 0.180 0.349 0.196 0.348 0.212 0.359 0.223 0.440 0.233 0.499 0.243 0.414 0.258 0.268
- 0.287 0.268 0.297 0.523 0.306 0.532 0.317 0.558 0.328 0.575 0.341 0.512 0.353 0.458
- 0.365 0.773 0.379 0.660 0.392 0.606 0.411 0.543 0.455 0.353 0.495 0.353 0.524 0.486
- 0.540 0.386 0.553 0.272 0.571 0.274 0.588 0.471 0.605 0.518 0.620 0.551 0.642 0.425
- 0.650 0.739 0.673 0.628 0.687 0.562 0.700 0.536 0.740 0.433 0.768 0.527 0.800 0.702
- 0.804 0.636 0.811 0.516 0.821 0.421 0.833 0.490 0.845 0.532 0.855 0.621 0.870 0.702
- 0.875 0.638 0.888 0.455 1.000 0.301)
- :duration dur :scaler (hz->radians 10000.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.96))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.018 0.030 0.034 0.085 0.060 0.000 0.071 0.040 0.087 0.058 0.105 0.137
+ 0.110 0.027 0.118 0.000 0.176 0.000 0.211 0.076 0.226 0.218 0.229 0.366 0.240 0.419
+ 0.252 0.088 0.261 0.000 0.300 0.000 0.321 0.391 0.325 0.340 0.330 0.490 0.336 0.516
+ 0.338 0.482 0.342 0.620 0.344 0.364 0.346 0.600 0.357 0.562 0.365 0.000 0.370 0.059
+ 0.384 0.542 0.387 0.484 0.393 0.626 0.406 0.788 0.422 0.000 0.458 0.000 0.474 0.186
+ 0.490 0.246 0.498 0.275 0.511 0.541 0.513 0.475 0.526 0.917 0.536 0.633 0.539 0.698
+ 0.554 0.000 0.593 0.000 0.610 0.414 0.613 0.794 0.617 0.689 0.619 0.847 0.625 0.942
+ 0.628 0.480 0.631 0.904 0.636 0.814 0.653 0.000 0.657 0.083 0.671 0.768 0.675 0.655
+ 0.679 0.801 0.686 0.999 0.695 0.818 0.704 0.000 0.734 0.000 0.750 0.657 0.756 0.797
+ 0.762 0.750 0.768 0.581 0.772 0.970 0.778 0.869 0.783 0.710 0.789 0.573 0.796 0.549
+ 0.805 0.251 0.807 0.524 0.816 0.199 0.823 0.257 0.831 0.541 0.841 0.565 0.847 0.847
+ 0.852 0.653 0.856 0.511 0.861 0.429 0.866 0.472 0.871 0.285 0.876 0.463 0.882 0.216
+ 0.887 0.387 0.891 0.311 0.895 0.369 0.902 0.301 0.905 0.359 0.912 0.326 0.915 0.410
+ 0.919 0.369 0.924 0.394 0.925 0.357 0.932 0.398 0.952 0.277 0.973 0.064 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.530 0.020 0.591 0.048 0.447 0.055 0.754 0.073 0.660 0.101 0.579 0.108 0.519
+ 0.180 0.349 0.196 0.348 0.212 0.359 0.223 0.440 0.233 0.499 0.243 0.414 0.258 0.268
+ 0.287 0.268 0.297 0.523 0.306 0.532 0.317 0.558 0.328 0.575 0.341 0.512 0.353 0.458
+ 0.365 0.773 0.379 0.660 0.392 0.606 0.411 0.543 0.455 0.353 0.495 0.353 0.524 0.486
+ 0.540 0.386 0.553 0.272 0.571 0.274 0.588 0.471 0.605 0.518 0.620 0.551 0.642 0.425
+ 0.650 0.739 0.673 0.628 0.687 0.562 0.700 0.536 0.740 0.433 0.768 0.527 0.800 0.702
+ 0.804 0.636 0.811 0.516 0.821 0.421 0.833 0.490 0.845 0.532 0.855 0.621 0.870 0.702
+ 0.875 0.638 0.888 0.455 1.000 0.301)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (magnolia-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Eastern bluebird
@@ -7627,61 +7644,59 @@
(define (eastern-bluebird beg1 amp1)
;; east 75 10
- (definstrument (eastern-bluebird-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.285)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.067 0.103 0.083 0.145 0.134 0.636 0.152 0.615 0.197 0.872 0.238 1.000
- 0.272 1.000 0.298 0.842 0.340 0.889 0.415 0.820 0.455 0.194 0.464 0.400 0.500 0.243
- 0.559 0.267 0.589 0.229 0.635 0.274 0.687 0.835 0.712 0.896 0.805 0.811 0.926 0.759
- 0.972 0.225 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.103 0.049 0.138 0.119 0.200 0.198 0.229 0.251 0.234 0.317 0.247 0.422 0.250
- 0.540 0.250 0.643 0.235 0.722 0.229 0.902 0.217 0.936 0.207 0.970 0.150 1.000 0.136)
- :duration dur :scaler (hz->radians 10200.0)))
- (gen1 (make-polywave :partials (list 1 .8 2 .01 3 .05 4 .01 5 .005)))
- (gen2 (make-polywave :partials (list 1 .92 2 .01 3 .05 4 .01 5 .005)))
- (ampf2 (make-env '(0 1 .2 0 1 0) :duration dur))
- (rnd (make-nrxysin 200 :n 2 :r .5))
- (rndf (make-env '(0 0 .1 1 .25 0 .45 0 .5 1 .6 0 1 0) :duration dur :scaler (hz->radians 200)))
- (rndfrqf (make-env '(0 1 .45 1 .5 .2 .6 .2 1 0) :duration dur :scaler (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* (env rndf)
- (nrxysin rnd (env rndfrqf))))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (polywave gen2 (* 1.5 frq)))))))))))
-
- (definstrument (eastern-bluebird-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.33)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.023 0.324 0.046 0.438 0.089 0.551 0.136 0.994 0.248 0.978 0.470 0.452
- 0.506 0.432 0.556 0.479 0.629 0.197 0.681 0.211 0.746 0.330 0.791 0.161 0.814 0.180
- 0.828 0.127 0.916 0.291 0.959 0.102 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.195 0.019 0.246 0.042 0.294 0.066 0.308 0.093 0.294 0.122 0.254 0.202 0.246
- 0.554 0.237 0.604 0.206 0.643 0.175 0.673 0.184 0.707 0.206 0.743 0.220 0.791 0.201
- 0.832 0.167 0.856 0.198 0.879 0.212 0.918 0.234 0.942 0.209 0.960 0.186 1.000 0.158)
- :duration dur :scaler (hz->radians 10000.0)))
- (gen1 (make-polywave :partials (list 1 .8 2 .01 3 .05 4 .01 5 .005)))
- (gen2 (make-polywave :partials (list 2 .01 4 .7 5 .01 6 .01 7 .01 8 .05 9 .01 10 .01 11 .01 12 .005 13 .01 14 .10 15 .10 16 .01)))
- (frqf2 (make-env '(0.000 0.345 0.052 0.393 0.098 0.345 0.271 0.311 0.443 0.305 0.506 0.319 0.559 0.339
- 0.613 0.322 0.661 0.294 0.705 0.314 0.738 0.353 0.769 0.364 0.797 0.356 0.818 0.316
- 0.845 0.285 0.882 0.339 0.905 0.362 0.928 0.364 0.960 0.319 1.000 0.209)
- :duration dur :scaler (hz->radians 2500.0)))
- (ampf2 (make-env '(0 0 .1 0 .2 1 1 1) :scaler .3 :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ (polywave gen1 (env frqf))
- (* (env ampf2)
- (polywave gen2 (env frqf2))))))))))
+ (defanimal (eastern-bluebird-1 beg amp)
+ (let ((dur 0.285))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.067 0.103 0.083 0.145 0.134 0.636 0.152 0.615 0.197 0.872 0.238 1.000
+ 0.272 1.000 0.298 0.842 0.340 0.889 0.415 0.820 0.455 0.194 0.464 0.400 0.500 0.243
+ 0.559 0.267 0.589 0.229 0.635 0.274 0.687 0.835 0.712 0.896 0.805 0.811 0.926 0.759
+ 0.972 0.225 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.103 0.049 0.138 0.119 0.200 0.198 0.229 0.251 0.234 0.317 0.247 0.422 0.250
+ 0.540 0.250 0.643 0.235 0.722 0.229 0.902 0.217 0.936 0.207 0.970 0.150 1.000 0.136)
+ :duration dur :scaler (hz->radians 10200.0)))
+ (gen1 (make-polywave 0.0 '(1 .8 2 .01 3 .05 4 .01 5 .005)))
+ (gen2 (make-polywave 0.0 '(1 .92 2 .01 3 .05 4 .01 5 .005)))
+ (ampf2 (make-env '(0 1 .2 0 1 0) :duration dur))
+ (rnd (make-nrxysin 200 :n 2 :r .5))
+ (rndf (make-env '(0 0 .1 1 .25 0 .45 0 .5 1 .6 0 1 0) :duration dur :scaler (hz->radians 200)))
+ (rndfrqf (make-env '(0 1 .45 1 .5 .2 .6 .2 1 0) :duration dur :scaler (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env rndf)
+ (nrxysin rnd (env rndfrqf))))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (polywave gen2 (* 1.5 frq)))))))))))
+
+ (defanimal (eastern-bluebird-2 beg amp)
+ (let ((dur 0.33))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.023 0.324 0.046 0.438 0.089 0.551 0.136 0.994 0.248 0.978 0.470 0.452
+ 0.506 0.432 0.556 0.479 0.629 0.197 0.681 0.211 0.746 0.330 0.791 0.161 0.814 0.180
+ 0.828 0.127 0.916 0.291 0.959 0.102 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.195 0.019 0.246 0.042 0.294 0.066 0.308 0.093 0.294 0.122 0.254 0.202 0.246
+ 0.554 0.237 0.604 0.206 0.643 0.175 0.673 0.184 0.707 0.206 0.743 0.220 0.791 0.201
+ 0.832 0.167 0.856 0.198 0.879 0.212 0.918 0.234 0.942 0.209 0.960 0.186 1.000 0.158)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (gen1 (make-polywave 0.0 '(1 .8 2 .01 3 .05 4 .01 5 .005)))
+ (gen2 (make-polywave 0.0 '(2 .01 4 .7 5 .01 6 .01 7 .01 8 .05 9 .01 10 .01 11 .01 12 .005 13 .01 14 .10 15 .10 16 .01)))
+ (frqf2 (make-env '(0.000 0.345 0.052 0.393 0.098 0.345 0.271 0.311 0.443 0.305 0.506 0.319 0.559 0.339
+ 0.613 0.322 0.661 0.294 0.705 0.314 0.738 0.353 0.769 0.364 0.797 0.356 0.818 0.316
+ 0.845 0.285 0.882 0.339 0.905 0.362 0.928 0.364 0.960 0.319 1.000 0.209)
+ :duration dur :scaler (hz->radians 2500.0)))
+ (ampf2 (make-env '(0 0 .1 0 .2 1 1 1) :scaler .3 :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 (env frqf))
+ (* (env ampf2)
+ (polywave gen2 (env frqf2))))))))))
(eastern-bluebird-1 beg1 amp1)
(eastern-bluebird-2 (+ beg1 0.33) amp1))
@@ -7689,239 +7704,238 @@
;; (with-sound (:play #t) (eastern-bluebird 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Greater roadrunner
-(definstrument (greater-roadrunner beg amp)
+(defanimal (greater-roadrunner beg amp)
;; south 13 3
- (let* ((start (seconds->samples beg))
- (dur 4.36)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.043 0.623 0.069 0.901 0.079 0.000 0.155 0.000 0.168 0.292 0.193 0.771
- 0.231 0.947 0.240 0.000 0.310 0.000 0.317 0.327 0.369 0.947 0.385 0.894 0.401 0.000
- 0.458 0.000 0.491 0.620 0.510 0.810 0.538 0.757 0.563 0.000 0.627 0.000 0.646 0.408
- 0.691 0.680 0.709 0.148 0.750 0.000 0.813 0.004 0.825 0.201 0.847 0.317 0.867 0.211
- 0.881 0.067 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.215 0.075 0.178 0.114 0.172 0.137 0.231 0.166 0.215 0.188 0.190 0.230 0.178
- 0.265 0.176 0.284 0.217 0.316 0.201 0.349 0.183 0.388 0.174 0.421 0.174 0.443 0.211
- 0.465 0.197 0.503 0.176 0.542 0.169 0.556 0.137 0.591 0.142 0.600 0.195 0.638 0.185
- 0.674 0.174 0.697 0.167 0.709 0.140 0.733 0.137 0.766 0.130 0.793 0.174 0.820 0.169
- 0.868 0.162 0.879 0.133 1.000 0.089)
- :duration dur :scaler (hz->radians 3000.0)))
- (gen1 (make-polywave :partials (list 1 .95 2 .03 3 .01 4 .005 5 .005 7 .005)))
- (rnd (make-rand-interp 200 .3)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ .7 (abs (rand-interp rnd)))
- (polywave gen1 (env frqf))))))))
+ (let ((dur 4.36))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.043 0.623 0.069 0.901 0.079 0.000 0.155 0.000 0.168 0.292 0.193 0.771
+ 0.231 0.947 0.240 0.000 0.310 0.000 0.317 0.327 0.369 0.947 0.385 0.894 0.401 0.000
+ 0.458 0.000 0.491 0.620 0.510 0.810 0.538 0.757 0.563 0.000 0.627 0.000 0.646 0.408
+ 0.691 0.680 0.709 0.148 0.750 0.000 0.813 0.004 0.825 0.201 0.847 0.317 0.867 0.211
+ 0.881 0.067 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.215 0.075 0.178 0.114 0.172 0.137 0.231 0.166 0.215 0.188 0.190 0.230 0.178
+ 0.265 0.176 0.284 0.217 0.316 0.201 0.349 0.183 0.388 0.174 0.421 0.174 0.443 0.211
+ 0.465 0.197 0.503 0.176 0.542 0.169 0.556 0.137 0.591 0.142 0.600 0.195 0.638 0.185
+ 0.674 0.174 0.697 0.167 0.709 0.140 0.733 0.137 0.766 0.130 0.793 0.174 0.820 0.169
+ 0.868 0.162 0.879 0.133 1.000 0.089)
+ :duration dur :scaler (hz->radians 3000.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .03 3 .01 4 .005 5 .005 7 .005)))
+ (rnd (make-rand-interp 200 .3)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .7 (abs (rand-interp rnd)))
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (greater-roadrunner 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Evening grosbeak
-(definstrument (evening-grosbeak beg amp)
+(defanimal (evening-grosbeak beg amp)
;; east 98 7.5
- (let* ((start (seconds->samples beg))
- (dur 0.17)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.050 0.121 0.068 0.000 0.081 0.000 0.097 0.329 0.109 0.000 0.125 0.451
- 0.135 0.344 0.144 0.462 0.162 0.000 0.171 0.058 0.177 0.688 0.188 0.558 0.208 0.477
- 0.220 0.283 0.246 0.373 0.265 0.373 0.277 0.566 0.303 0.775 0.328 0.824 0.360 0.711
- 0.383 0.838 0.405 0.835 0.413 0.711 0.443 0.939 0.514 0.948 0.576 1.000 0.626 0.942
- 0.658 0.951 0.707 0.864 0.742 0.728 0.777 0.682 0.820 0.610 0.926 0.260 0.949 0.072
- 0.978 0.107 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.196 0.021 0.259 0.038 0.355 0.055 0.322 0.066 0.276 0.096 0.255 0.116 0.287
- 0.124 0.371 0.134 0.390 0.146 0.325 0.158 0.371 0.181 0.386 0.203 0.397 0.227 0.449
- 0.262 0.451 0.283 0.437 0.465 0.388 0.599 0.374 0.701 0.350 0.834 0.327 1.000 0.243)
- :duration dur :scaler (hz->radians 10200.0)))
- (gen1 (make-polywave :partials (list 1 .97 2 .01 3 .015 4 .004)))
- (vib (make-oscil 300))
- (vibf (make-env '(0 0 .25 0 .3 1 1 1) :duration dur :scaler (hz->radians 200)))
- (emph (make-oscil))
- (emphf (make-env '(0 0 .3 1 .4 0 1 0) :duration dur :scaler .2)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* (env vibf)
- (oscil vib)))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env emphf)
- (oscil emph (* 2 frq)))))))))))
+ (let ((dur 0.17))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.050 0.121 0.068 0.000 0.081 0.000 0.097 0.329 0.109 0.000 0.125 0.451
+ 0.135 0.344 0.144 0.462 0.162 0.000 0.171 0.058 0.177 0.688 0.188 0.558 0.208 0.477
+ 0.220 0.283 0.246 0.373 0.265 0.373 0.277 0.566 0.303 0.775 0.328 0.824 0.360 0.711
+ 0.383 0.838 0.405 0.835 0.413 0.711 0.443 0.939 0.514 0.948 0.576 1.000 0.626 0.942
+ 0.658 0.951 0.707 0.864 0.742 0.728 0.777 0.682 0.820 0.610 0.926 0.260 0.949 0.072
+ 0.978 0.107 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.196 0.021 0.259 0.038 0.355 0.055 0.322 0.066 0.276 0.096 0.255 0.116 0.287
+ 0.124 0.371 0.134 0.390 0.146 0.325 0.158 0.371 0.181 0.386 0.203 0.397 0.227 0.449
+ 0.262 0.451 0.283 0.437 0.465 0.388 0.599 0.374 0.701 0.350 0.834 0.327 1.000 0.243)
+ :duration dur :scaler (hz->radians 10200.0)))
+ (gen1 (make-polywave 0.0 '(1 .97 2 .01 3 .015 4 .004)))
+ (vib (make-oscil 300))
+ (vibf (make-env '(0 0 .25 0 .3 1 1 1) :duration dur :scaler (hz->radians 200)))
+ (emph (make-oscil))
+ (emphf (make-env '(0 0 .3 1 .4 0 1 0) :duration dur :scaler .2)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env vibf)
+ (oscil vib)))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env emphf)
+ (oscil emph (* 2.0 frq)))))))))))
;; (with-sound (:play #t) (evening-grosbeak 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Dark-eyed junco
(define (dark-eyed-junco beg1 amp1)
;; calif 49 3
- (definstrument (dark-eyed-junco-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.11)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.042 0.085 0.115 0.572 0.161 0.288 0.192 0.604 0.214 0.661 0.241 1.000
- 0.289 0.085 0.316 0.748 0.345 0.950 0.387 0.307 0.413 0.082 0.431 0.497 0.459 0.481
- 0.486 0.133 0.552 0.078 0.710 0.382 0.777 0.236 0.795 0.291 0.872 0.156 0.899 0.169 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.578 0.069 0.569 0.119 0.535 0.173 0.427 0.175 0.575 0.204 0.566 0.235 0.536
- 0.273 0.473 0.299 0.401 0.304 0.535 0.327 0.547 0.358 0.513 0.404 0.416 0.415 0.555
- 0.445 0.549 0.482 0.493 0.520 0.396 0.549 0.367 0.695 0.369 0.846 0.330 0.934 0.297 1.000 0.243)
- :duration dur :scaler (hz->radians 10050.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (let ((amps (vct .3 .5 .8 .8 .8 .8 .8 1.0 .8 .8 .4)))
- (do ((call 0 (+ 1 call)))
+ (defanimal (dark-eyed-junco-1 beg amp)
+ (let ((dur 0.11))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.042 0.085 0.115 0.572 0.161 0.288 0.192 0.604 0.214 0.661 0.241 1.000
+ 0.289 0.085 0.316 0.748 0.345 0.950 0.387 0.307 0.413 0.082 0.431 0.497 0.459 0.481
+ 0.486 0.133 0.552 0.078 0.710 0.382 0.777 0.236 0.795 0.291 0.872 0.156 0.899 0.169 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.578 0.069 0.569 0.119 0.535 0.173 0.427 0.175 0.575 0.204 0.566 0.235 0.536
+ 0.273 0.473 0.299 0.401 0.304 0.535 0.327 0.547 0.358 0.513 0.404 0.416 0.415 0.555
+ 0.445 0.549 0.482 0.493 0.520 0.396 0.549 0.367 0.695 0.369 0.846 0.330 0.934 0.297 1.000 0.243)
+ :duration dur :scaler (hz->radians 10050.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (let ((amps (vector .3 .5 .8 .8 .8 .8 .8 1.0 .8 .8 .4)))
+ (do ((call 0 (+ call 1)))
((= call 11))
(dark-eyed-junco-1 (+ beg1 (* call .122)) (* amp1 (amps call))))))
;; (with-sound (:play #t) (dark-eyed-junco 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Groove-billed ani
-(definstrument (groove-billed-ani beg amp)
+(defanimal (groove-billed-ani beg amp)
;; south 14 17
;; first note
- (let* ((start (seconds->samples beg))
- (dur 0.067)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.110 0.124 0.121 0.469 0.137 0.323 0.149 0.524 0.195 0.654 0.212 0.906
- 0.226 0.204 0.245 0.744 0.317 0.991 0.481 0.824 0.517 0.558 0.556 0.746 0.573 0.446
- 0.581 0.590 0.597 0.668 0.606 0.231 0.622 0.698 0.653 0.686 0.718 0.185 0.884 0.046 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.112 0.058 0.098 0.114 0.098 0.18 0.143 0.208 0.309 0.339 0.325 0.445 0.327
- 0.597 0.318 0.636 0.297 0.673 0.240 0.744 0.229 0.775 0.160 0.801 0.117 0.838 0.082 0.884 0.082 .95 0.059 )
- :duration dur :scaler (hz->radians 17100.0)))
- (gen1 (make-polywave :partials (list 1 .96 2 .04 3 .005)))
- (gen2 (make-polywave :partials (list 1 .1 2 .7 3 .1 4 .005 5 .005 6 .002)))
- (ampf2 (make-env '(0 0 .025 1 .2 0 .7 0 .9 1 1 0) :duration dur))
- (rnd (make-rand-interp 400 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (polywave gen2 frq)))))))))
+ (let ((dur 0.067))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.110 0.124 0.121 0.469 0.137 0.323 0.149 0.524 0.195 0.654 0.212 0.906
+ 0.226 0.204 0.245 0.744 0.317 0.991 0.481 0.824 0.517 0.558 0.556 0.746 0.573 0.446
+ 0.581 0.590 0.597 0.668 0.606 0.231 0.622 0.698 0.653 0.686 0.718 0.185 0.884 0.046 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.112 0.058 0.098 0.114 0.098 0.18 0.143 0.208 0.309 0.339 0.325 0.445 0.327
+ 0.597 0.318 0.636 0.297 0.673 0.240 0.744 0.229 0.775 0.160 0.801 0.117 0.838 0.082 0.884 0.082 .95 0.059 )
+ :duration dur :scaler (hz->radians 17100.0)))
+ (gen1 (make-polywave 0.0 '(1 .96 2 .04 3 .005)))
+ (gen2 (make-polywave 0.0 '(1 .1 2 .7 3 .1 4 .005 5 .005 6 .002)))
+ (ampf2 (make-env '(0 0 .025 1 .2 0 .7 0 .9 1 1 0) :duration dur))
+ (rnd (make-rand-interp 400 (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (polywave gen2 frq)))))))))
;; second note
- (let* ((start (seconds->samples (+ beg 0.27)))
- (dur 0.265)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.020 0.160 0.091 0.182 0.138 0.132 0.174 0.162 0.239 0.120 0.390 0.297
- 0.427 0.216 0.474 0.530 0.521 1.000 0.565 0.893 0.590 0.498 0.605 0.656 0.634 0.171
- 0.676 0.209 0.696 0.130 0.754 0.222 0.786 0.173 0.818 0.214 0.835 0.177 0.884 0.199
- 0.911 0.107 0.922 0.158 0.961 0.071 0.978 0.378 1.000 0.000)
- :duration dur :scaler (* .4 amp)))
- (frqf (make-env '(0.000 0.125 0.048 0.142 0.139 0.133 0.303 0.131 0.443 0.150 0.495 0.156 0.508 0.206
- 0.568 0.200 0.612 0.219 0.621 0.289 0.627 0.439 0.690 0.458 0.752 0.464 0.823 0.464
- 0.900 0.450 0.947 0.425 0.975 0.194 1.000 0.2 )
- :duration dur :scaler (hz->radians 10300.0)))
- (gen1 (make-oscil))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (ampf1 (make-env '(0 1 .63 1 .65 .1 .94 .1 1 1) :scaler .95 :duration dur))
- (ampf2 (make-env '(0 .5 .6 1 .9 1 1 .5) :scaler .1 :duration dur))
- (ampf3 (make-env '(0 1 .59 1 .6 0 .65 0 .66 1 .8 1 .9 0 1 0) :scaler .05 :duration dur))
- (rnd (make-rand-interp 400 (hz->radians 30))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (oscil gen1 frq))
- (* (env ampf2)
- (oscil gen2 (* 2 frq)))
- (* (env ampf3)
- (oscil gen3 (* 3 frq)))))))))))
+ (let ((dur 0.265)
+ (start (seconds->samples (+ beg 0.27))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.020 0.160 0.091 0.182 0.138 0.132 0.174 0.162 0.239 0.120 0.390 0.297
+ 0.427 0.216 0.474 0.530 0.521 1.000 0.565 0.893 0.590 0.498 0.605 0.656 0.634 0.171
+ 0.676 0.209 0.696 0.130 0.754 0.222 0.786 0.173 0.818 0.214 0.835 0.177 0.884 0.199
+ 0.911 0.107 0.922 0.158 0.961 0.071 0.978 0.378 1.000 0.000)
+ :duration dur :scaler (* .4 amp)))
+ (frqf (make-env '(0.000 0.125 0.048 0.142 0.139 0.133 0.303 0.131 0.443 0.150 0.495 0.156 0.508 0.206
+ 0.568 0.200 0.612 0.219 0.621 0.289 0.627 0.439 0.690 0.458 0.752 0.464 0.823 0.464
+ 0.900 0.450 0.947 0.425 0.975 0.194 1.000 0.2 )
+ :duration dur :scaler (hz->radians 10300.0)))
+ (gen1 (make-oscil))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (ampf1 (make-env '(0 1 .63 1 .65 .1 .94 .1 1 1) :scaler .95 :duration dur))
+ (ampf2 (make-env '(0 .5 .6 1 .9 1 1 .5) :scaler .1 :duration dur))
+ (ampf3 (make-env '(0 1 .59 1 .6 0 .65 0 .66 1 .8 1 .9 0 1 0) :scaler .05 :duration dur))
+ (rnd (make-rand-interp 400 (hz->radians 30))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (oscil gen1 frq))
+ (* (env ampf2)
+ (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3)
+ (oscil gen3 (* 3.0 frq)))))))))))
;; (with-sound (:play #t) (groove-billed-ani 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Common pauraque
-(definstrument (common-pauraque beg amp)
+(defanimal (common-pauraque beg amp)
;; south 20 1.7
- (let* ((start (seconds->samples beg))
- (dur 0.65)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.134 0.124 0.181 0.079 0.203 0.169 0.275 0.160 0.341 0.494 0.390 0.850
- 0.443 0.561 0.462 0.783 0.502 0.768 0.535 1.000 0.587 0.795 0.742 0.802 0.821 0.702
- 0.856 0.458 0.884 0.263 0.926 0.241 1.000 0.000 )
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.168 0.175 0.190 0.328 0.225 0.399 0.237 0.472 0.310 0.504 0.342 0.539 0.345
- 0.572 0.326 0.594 0.294 0.644 0.275 0.731 0.259 0.797 0.244 0.832 0.231 0.868 0.212 1.000 0.155 )
- :duration dur :scaler (hz->radians 7700.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .015)))
- (vib (make-oscil 120))
- (vibf (make-env '(0 0 .25 0 .4 .3 .5 .1 .6 1 1 0) :duration dur :scaler (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (* (env vibf)
- (oscil vib))))))))))
+ (let ((dur 0.65))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.134 0.124 0.181 0.079 0.203 0.169 0.275 0.160 0.341 0.494 0.390 0.850
+ 0.443 0.561 0.462 0.783 0.502 0.768 0.535 1.000 0.587 0.795 0.742 0.802 0.821 0.702
+ 0.856 0.458 0.884 0.263 0.926 0.241 1.000 0.000 )
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.168 0.175 0.190 0.328 0.225 0.399 0.237 0.472 0.310 0.504 0.342 0.539 0.345
+ 0.572 0.326 0.594 0.294 0.644 0.275 0.731 0.259 0.797 0.244 0.832 0.231 0.868 0.212 1.000 0.155 )
+ :duration dur :scaler (hz->radians 7700.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .015)))
+ (vib (make-oscil 120))
+ (vibf (make-env '(0 0 .25 0 .4 .3 .5 .1 .6 1 1 0) :duration dur :scaler (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (* (env vibf)
+ (oscil vib))))))))))
;; (with-sound (:play #t) (common-pauraque 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Hammond's flycatcher
-(definstrument (hammonds-flycatcher beg amp)
+(defanimal (hammonds-flycatcher beg amp)
;; calif2 5 8.2
- (let* ((start (seconds->samples beg))
- (dur 0.23)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.090 0.518 0.153 0.872 0.167 0.795 0.190 0.952 0.251 0.000 0.453 0.000
- 0.502 0.434 0.521 0.295 0.542 0.053 0.580 0.051 0.606 0.000 0.691 0.000 0.701 0.062
- 0.731 0.089 0.735 0.000 0.746 0.000 0.754 0.212 0.764 0.119 0.784 0.110 0.794 0.148
- 0.800 0.007 0.815 0.080 0.823 0.301 0.834 0.126 0.854 0.151 0.862 0.062 0.873 0.009
- 0.880 0.075 0.890 0.297 0.910 0.205 0.921 0.078 0.934 0.032 0.948 0.208 0.959 0.285
- 0.971 0.260 0.984 0.091 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.401 0.037 0.480 0.073 0.538 0.109 0.596 0.142 0.628 0.175 0.697 0.206 0.794
- 0.218 0.812 0.233 0.800 0.240 0.773 0.260 0.693 0.404 0.381 0.416 0.356 0.437 0.347
- 0.460 0.359 0.482 0.439 0.497 0.532 0.529 0.659 0.546 0.836 0.587 0.614 0.690 0.460
- 0.700 0.282 0.713 0.247 0.725 0.285 0.727 0.525 0.739 0.594 0.756 0.314 0.769 0.276
- 0.784 0.280 0.788 0.329 0.796 0.736 0.811 0.543 0.828 0.301 0.843 0.282 0.851 0.325
- 0.861 0.780 0.887 0.377 0.899 0.321 0.909 0.370 0.926 0.681 0.944 0.449 0.959 0.421
- 0.977 0.433 1.000 0.471)
- :duration dur :scaler (hz->radians 9000.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.23))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.090 0.518 0.153 0.872 0.167 0.795 0.190 0.952 0.251 0.000 0.453 0.000
+ 0.502 0.434 0.521 0.295 0.542 0.053 0.580 0.051 0.606 0.000 0.691 0.000 0.701 0.062
+ 0.731 0.089 0.735 0.000 0.746 0.000 0.754 0.212 0.764 0.119 0.784 0.110 0.794 0.148
+ 0.800 0.007 0.815 0.080 0.823 0.301 0.834 0.126 0.854 0.151 0.862 0.062 0.873 0.009
+ 0.880 0.075 0.890 0.297 0.910 0.205 0.921 0.078 0.934 0.032 0.948 0.208 0.959 0.285
+ 0.971 0.260 0.984 0.091 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.401 0.037 0.480 0.073 0.538 0.109 0.596 0.142 0.628 0.175 0.697 0.206 0.794
+ 0.218 0.812 0.233 0.800 0.240 0.773 0.260 0.693 0.404 0.381 0.416 0.356 0.437 0.347
+ 0.460 0.359 0.482 0.439 0.497 0.532 0.529 0.659 0.546 0.836 0.587 0.614 0.690 0.460
+ 0.700 0.282 0.713 0.247 0.725 0.285 0.727 0.525 0.739 0.594 0.756 0.314 0.769 0.276
+ 0.784 0.280 0.788 0.329 0.796 0.736 0.811 0.543 0.828 0.301 0.843 0.282 0.851 0.325
+ 0.861 0.780 0.887 0.377 0.899 0.321 0.909 0.370 0.926 0.681 0.944 0.449 0.959 0.421
+ 0.977 0.433 1.000 0.471)
+ :duration dur :scaler (hz->radians 9000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (hammonds-flycatcher 0 .5))
@@ -7932,77 +7946,74 @@
;;;
;;; not as good as some of the others -- ending slightly wrong, formants need tuning a bit, etc
-(definstrument (barn-owl beg amp)
+(defanimal (barn-owl beg amp)
;; calif 50 2.9
- (let* ((start (seconds->samples beg))
- (dur 0.9)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur :scaler (* 0.5 amp) :base 3))
-
- (ampf1 (make-env '(0 1 19 1 21 0 22 0) :base 10 :duration dur))
- (gen1 (make-polywave 1110.0 (list 2 .6 3 .2 4 .1 5 .1 6 .05 7 .1 9 .01)))
-
- (ampf2 (make-env '(0 0 19 0 20 .5 22 0) :base 10 :duration dur))
- (frqf2 (make-env '(0 1550 18 1550 19 1200 20 1700 22 1500) :scaler (hz->radians 1.0) :duration dur :base 10))
- (gen2 (make-polywave :partials (list 1 .2 2 .01 3 .8 4 .3 5 .1 6 .01)))
-
- (rnd (make-rand-interp 10000 (hz->radians 400)))
- (rndf (make-env '(0 1 19 1 20 .1 22 .01) :duration dur))
- (trem (make-rand-interp 120 .6))
-
- (frm1 (make-formant 2800 .98))
- (frm2 (make-formant 4400 .92))
- (frm4 (make-formant 6000 .97))
- (frm5 (make-formant 7500 .96))
- (frm3 (make-formant 9000 .96))
-
- (fr1 (* 2 7 (sin (hz->radians 2800))))
- (fr2 (* 2 3 (sin (hz->radians 4400))))
- (fr3 (* 2 0.5 (sin (hz->radians 9000))))
- (fr4 (* 2 3 (sin (hz->radians 6000))))
- (fr5 (* 2 (sin (hz->radians 7500)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((val (* (env ampf)
- (+ .4 (abs (rand-interp trem)))
- (+ (* (env ampf1)
- (polywave gen1 (* (env rndf)
- (rand-interp rnd))))
- (* (env ampf2)
- (polywave gen2 (env frqf2)))))))
- (outa i (+ (* fr1 (formant frm1 val))
- (* fr2 (formant frm2 val))
- (* fr3 (formant frm3 val))
- (* fr4 (formant frm4 val))
- (* fr5 (formant frm5 val)))))))))
+ (let ((dur 0.9))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur :scaler (* 0.5 amp) :base 3))
+
+ (ampf1 (make-env '(0 1 19 1 21 0 22 0) :base 10 :duration dur))
+ (gen1 (make-polywave 1110.0 '(2 .6 3 .2 4 .1 5 .1 6 .05 7 .1 9 .01)))
+
+ (ampf2 (make-env '(0 0 19 0 20 .5 22 0) :base 10 :duration dur))
+ (frqf2 (make-env '(0 1550 18 1550 19 1200 20 1700 22 1500) :scaler (hz->radians 1.0) :duration dur :base 10))
+ (gen2 (make-polywave 0.0 '(1 .2 2 .01 3 .8 4 .3 5 .1 6 .01)))
+
+ (rnd (make-rand-interp 10000 (hz->radians 400)))
+ (rndf (make-env '(0 1 19 1 20 .1 22 .01) :duration dur))
+ (trem (make-rand-interp 120 .6))
+
+ (frm1 (make-formant 2800 .98))
+ (frm2 (make-formant 4400 .92))
+ (frm4 (make-formant 6000 .97))
+ (frm5 (make-formant 7500 .96))
+ (frm3 (make-formant 9000 .96))
+
+ (fr1 (* 2 7 (sin (hz->radians 2800))))
+ (fr2 (* 2 3 (sin (hz->radians 4400))))
+ (fr3 (* 2 0.5 (sin (hz->radians 9000))))
+ (fr4 (* 2 3 (sin (hz->radians 6000))))
+ (fr5 (* 2 (sin (hz->radians 7500)))))
+ (let ((fb (vector frm1 frm2 frm3 frm4 frm5))
+ (fs (float-vector fr1 fr2 fr3 fr4 fr5)))
+ (set! fb (make-formant-bank fb fs))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (formant-bank fb (* (+ .4 (abs (rand-interp trem)))
+ (+ (* (env ampf1)
+ (polywave gen1 (* (env rndf) (rand-interp rnd))))
+ (* (env ampf2)
+ (polywave gen2 (env frqf2)))))))))))))
;; (with-sound (:play #t :statistics #t) (barn-owl 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Long-eared owl
-(definstrument (long-eared-owl beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.37)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.119 0.319 0.193 0.682 0.251 0.767 0.309 0.958 0.485 0.930 0.505 1.000
- 0.574 0.895 0.698 0.901 0.902 0.767 0.965 0.401 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.276 0.185 0.328 0.273 0.338 0.462 0.343 0.735 0.340 0.894 0.337 0.938 0.305 1.000 0.231)
- :duration dur :scaler (hz->radians 980.0)))
- (gen1 (make-polywave :partials (list 1 1 2 .23 3 .034 4 .008 5 .005 7 .003))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (long-eared-owl beg amp)
+ (let ((dur 0.37))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.119 0.319 0.193 0.682 0.251 0.767 0.309 0.958 0.485 0.930 0.505 1.000
+ 0.574 0.895 0.698 0.901 0.902 0.767 0.965 0.401 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.276 0.185 0.328 0.273 0.338 0.462 0.343 0.735 0.340 0.894 0.337 0.938 0.305 1.000 0.231)
+ :duration dur :scaler (hz->radians 980.0)))
+ (gen1 (make-polywave 0.0 '(1 1 2 .23 3 .034 4 .008 5 .005 7 .003))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (long-eared-owl 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Summer tanager
@@ -8010,21 +8021,20 @@
(define (summer-tanager beg1 amp1)
;; calif 24 18
- (definstrument (summer-tanager-1 beg dur amp ampl frq frql rndl)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env ampl :duration dur :scaler amp))
- (frqf (make-env frql :duration dur :scaler (hz->radians frq)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .006 4 .008 5 .004)))
- (rndf (make-env rndl :duration dur))
- (rnd (make-rand-interp 600)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((rf (env rndf)))
- (outa i (* (env ampf)
- (+ (- 1.0 rf) (* rf (rand-interp rnd)))
- (polywave gen1 (env frqf)))))))))
+ (defanimal (summer-tanager-1 beg dur amp ampl frq frql rndl)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env ampl :duration dur :scaler amp))
+ (frqf (make-env frql :duration dur :scaler (hz->radians frq)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .006 4 .008 5 .004)))
+ (rndf (make-env rndl :duration dur))
+ (rnd (make-rand-interp 600)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((rf (env rndf)))
+ (outa i (* (env ampf)
+ (+ (- 1.0 rf) (* rf (rand-interp rnd)))
+ (polywave gen1 (env frqf))))))))
(summer-tanager-1 beg1 .29 (* .4 amp1)
'(0.000 0.000 0.123 0.450 0.194 0.404 0.210 0.055 0.232 0.437 0.251 0.193 0.277 0.263
@@ -8118,57 +8128,56 @@
;; (with-sound (:play #t) (summer-tanager 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Whooping crane
-(definstrument (whooping-crane beg amp)
+(defanimal (whooping-crane beg amp)
;; east 63 53 (is this 2 birds?)
- (let* ((start (seconds->samples beg))
- (dur 0.68)
- (stop (+ start (seconds->samples dur)))
-
- (ampf (make-env '(0.000 0.000 0.036 0.069 0.052 0.000 0.115 0.000 0.127 0.343 0.137 0.254 0.143 0.400
- 0.162 0.000 0.184 0.000 0.191 0.524 0.202 0.772 0.224 0.131 0.241 0.392 0.259 0.770
- 0.274 0.699 0.305 0.692 0.362 0.852 0.432 0.768 0.449 0.985 0.484 1.000 0.604 0.969
- 0.640 0.783 0.672 0.489 0.687 0.752 0.725 0.290 0.742 0.376 0.801 0.281 0.906 0.197
- 0.928 0.128 0.943 0.192 0.950 0.365 0.977 0.086 1.000 0.000)
- :duration dur :scaler (* 0.33 amp)))
-
- (frqf1 (make-env '(0.000 0.158 0.120 0.175 0.137 0.227 0.145 0.180 0.190 0.173 0.204 0.249 0.219 0.230
- 0.324 0.237 0.428 0.242 0.585 0.240 0.655 0.232 0.689 0.215 0.958 0.205 0.966 0.128 1.000 0.123)
- :duration dur :scaler (hz->radians 5000.0)))
- (frqf2 (make-env '(0.000 0.104 0.342 0.121 0.376 0.136 0.435 0.128 0.447 0.175 0.498 0.173 1.000 0.170)
- :duration dur :scaler (hz->radians 5000.0)))
-
- (ampf1 (make-env '(0 1 .65 1 .70 0 1 0) :duration dur))
- (ampf2 (make-env '(0 0 .32 0 .48 1 .68 1 .75 0 1 0) :duration dur))
- (ampf3 (make-env '(0 0 .6 0 .65 1 1 1) :duration dur))
-
- (gen1 (make-polywave :partials (normalize-partials (list 1 .3 2 1 3 -.8 4 .25 5 .45 6 .22 7 .13 8 .05 9 .02 10 .005 11 .005))))
- (gen2 (make-polywave :partials (normalize-partials (list 1 .91 2 .17 3 -.77 4 .25 5 .2 6 .2 7 .18 8 .1 10 .01))))
- (gen3 (make-polywave :partials (normalize-partials (list 1 -1 2 .11 3 .45 4 .44 5 .62 6 .27 7 .02 8 .005))))
-
- (rnd (make-rand-interp 2000 (hz->radians 200)))
- (rndf1 (make-env '(0 1 .2 1 .3 0 .65 0 .7 1 .8 0 1 0) :duration dur))
- (rndf2 (make-env '(0 0 .32 0 .48 1 .5 0 .7 0 .75 1 .8 0 1 0) :duration dur))
- (rndf3 (make-env '(0 0 .6 0 .65 1 .7 0 .9 0 1 1) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq1 (env frqf1))
- (frq2 (env frqf2))
- (rn (rand-interp rnd)))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (polywave gen1 (+ frq1
- (* (env rndf1) rn))))
- (* (env ampf2)
- (polywave gen2 (+ frq2
- (* (env rndf2) rn))))
- (* (env ampf3)
- (polywave gen3 (+ frq1
- (* (env rndf3) rn))))))))))))
+ (let ((dur 0.68))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+
+ (ampf (make-env '(0.000 0.000 0.036 0.069 0.052 0.000 0.115 0.000 0.127 0.343 0.137 0.254 0.143 0.400
+ 0.162 0.000 0.184 0.000 0.191 0.524 0.202 0.772 0.224 0.131 0.241 0.392 0.259 0.770
+ 0.274 0.699 0.305 0.692 0.362 0.852 0.432 0.768 0.449 0.985 0.484 1.000 0.604 0.969
+ 0.640 0.783 0.672 0.489 0.687 0.752 0.725 0.290 0.742 0.376 0.801 0.281 0.906 0.197
+ 0.928 0.128 0.943 0.192 0.950 0.365 0.977 0.086 1.000 0.000)
+ :duration dur :scaler (* 0.33 amp)))
+
+ (frqf1 (make-env '(0.000 0.158 0.120 0.175 0.137 0.227 0.145 0.180 0.190 0.173 0.204 0.249 0.219 0.230
+ 0.324 0.237 0.428 0.242 0.585 0.240 0.655 0.232 0.689 0.215 0.958 0.205 0.966 0.128 1.000 0.123)
+ :duration dur :scaler (hz->radians 5000.0)))
+ (frqf2 (make-env '(0.000 0.104 0.342 0.121 0.376 0.136 0.435 0.128 0.447 0.175 0.498 0.173 1.000 0.170)
+ :duration dur :scaler (hz->radians 5000.0)))
+
+ (ampf1 (make-env '(0 1 .65 1 .70 0 1 0) :duration dur))
+ (ampf2 (make-env '(0 0 .32 0 .48 1 .68 1 .75 0 1 0) :duration dur))
+ (ampf3 (make-env '(0 0 .6 0 .65 1 1 1) :duration dur))
+
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 .3 2 1 3 -.8 4 .25 5 .45 6 .22 7 .13 8 .05 9 .02 10 .005 11 .005))))
+ (gen2 (make-polywave 0.0 (normalize-partials '(1 .91 2 .17 3 -.77 4 .25 5 .2 6 .2 7 .18 8 .1 10 .01))))
+ (gen3 (make-polywave 0.0 (normalize-partials '(1 -1 2 .11 3 .45 4 .44 5 .62 6 .27 7 .02 8 .005))))
+
+ (rnd (make-rand-interp 2000 (hz->radians 200)))
+ (rndf1 (make-env '(0 1 .2 1 .3 0 .65 0 .7 1 .8 0 1 0) :duration dur))
+ (rndf2 (make-env '(0 0 .32 0 .48 1 .5 0 .7 0 .75 1 .8 0 1 0) :duration dur))
+ (rndf3 (make-env '(0 0 .6 0 .65 1 .7 0 .9 0 1 1) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq1 (env frqf1))
+ (rn (rand-interp rnd)))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (polywave gen1 (+ frq1
+ (* rn (env rndf1)))))
+ (* (env ampf2)
+ (polywave gen2 (+ (env frqf2)
+ (* rn (env rndf2)))))
+ (* (env ampf3)
+ (polywave gen3 (+ frq1
+ (* rn (env rndf3)))))))))))))
;; (with-sound (:play #t) (whooping-crane 0 .5))
@@ -8177,88 +8186,87 @@
;;;
;;; Sandhill crane
-(definstrument (sandhill-crane beg amp)
+(defanimal (sandhill-crane beg amp)
;; calif 30 13
- (let* ((start (seconds->samples beg))
- (dur 0.64)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.042 0.100 0.130 0.108 0.175 0.155 0.183 0.052 0.200 0.000 0.230 0.000
- 0.240 0.052 0.244 0.681 0.252 0.545 0.260 0.602 0.264 0.000 0.269 0.397 0.277 0.845
- 0.288 0.547 0.292 0.734 0.304 0.624 0.313 0.453 0.320 0.215 0.324 0.373 0.328 0.359
- 0.335 0.143 0.344 0.282 0.371 0.291 0.380 0.256 0.386 0.333 0.390 0.773 0.404 0.428
- 0.409 0.577 0.417 0.612 0.424 0.374 0.427 0.562 0.433 0.405 0.436 0.452 0.442 0.285
- 0.446 0.417 0.460 0.034 0.468 0.319 0.480 0.036 0.485 0.852 0.493 0.606 0.498 0.636
- 0.503 0.526 0.519 0.471 0.525 0.980 0.532 0.134 0.535 0.467 0.546 0.236 0.550 0.044
- 0.561 0.069 0.565 0.276 0.576 0.739 0.584 0.581 0.592 0.797 0.605 0.168 0.606 0.268
- 0.613 0.076 0.620 0.145 0.631 0.035 0.635 0.164 0.639 0.080 0.643 0.939 0.656 0.508
- 0.664 0.623 0.672 0.165 0.678 0.040 0.681 0.157 0.687 0.187 0.695 0.038 0.700 0.293
- 0.704 0.155 0.709 0.719 0.715 0.701 0.720 0.420 0.724 0.559 0.728 0.249 0.737 0.069
- 0.741 0.168 0.748 0.103 0.751 0.051 0.757 0.072 0.758 0.196 0.763 0.129 0.769 0.666
- 0.778 0.515 0.785 0.126 0.791 0.108 0.800 0.029 0.809 0.087 0.821 0.016 0.826 0.327
- 0.832 0.135 0.840 0.084 0.848 0.025 0.858 0.440 0.866 0.168 0.873 0.123 0.878 0.033
- 0.886 0.055 0.900 0.008 0.907 0.593 0.918 0.102 0.923 0.463 0.930 0.361 0.940 0.343
- 0.947 0.182 0.953 0.236 0.964 0.025 0.967 0.061 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.063 0.163 0.065 0.171 0.092 0.182 0.063 0.238 0.090 0.244 0.115 0.251 0.094
- 0.267 0.092 0.285 0.094 0.381 0.096 0.387 0.129 0.398 0.092 0.427 0.094 0.438 0.069
- 0.445 0.094 0.473 0.092 0.483 0.100 0.492 0.092 0.523 0.096 0.559 0.094 0.571 0.104
- 0.581 0.092 0.618 0.096 0.633 0.096 0.645 0.100 0.661 0.085 0.673 0.096 0.708 0.096
- 0.723 0.085 0.768 0.090 0.791 0.090 0.824 0.075 0.850 0.083 0.853 0.117 0.863 0.094
- 0.888 0.094 0.906 0.115 0.920 0.110 0.931 0.085 1.000 0.087 )
- :duration dur :scaler (hz->radians 8300.0)))
- (gen1 (make-polywave :partials (list 1 .6 2 -.1 3 .01 4 .05 5 .03 6 .01 7 .01 8 .005)))
- (rnd (make-rand-interp 3000 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp rnd)))))))))
+ (let ((dur 0.64))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.042 0.100 0.130 0.108 0.175 0.155 0.183 0.052 0.200 0.000 0.230 0.000
+ 0.240 0.052 0.244 0.681 0.252 0.545 0.260 0.602 0.264 0.000 0.269 0.397 0.277 0.845
+ 0.288 0.547 0.292 0.734 0.304 0.624 0.313 0.453 0.320 0.215 0.324 0.373 0.328 0.359
+ 0.335 0.143 0.344 0.282 0.371 0.291 0.380 0.256 0.386 0.333 0.390 0.773 0.404 0.428
+ 0.409 0.577 0.417 0.612 0.424 0.374 0.427 0.562 0.433 0.405 0.436 0.452 0.442 0.285
+ 0.446 0.417 0.460 0.034 0.468 0.319 0.480 0.036 0.485 0.852 0.493 0.606 0.498 0.636
+ 0.503 0.526 0.519 0.471 0.525 0.980 0.532 0.134 0.535 0.467 0.546 0.236 0.550 0.044
+ 0.561 0.069 0.565 0.276 0.576 0.739 0.584 0.581 0.592 0.797 0.605 0.168 0.606 0.268
+ 0.613 0.076 0.620 0.145 0.631 0.035 0.635 0.164 0.639 0.080 0.643 0.939 0.656 0.508
+ 0.664 0.623 0.672 0.165 0.678 0.040 0.681 0.157 0.687 0.187 0.695 0.038 0.700 0.293
+ 0.704 0.155 0.709 0.719 0.715 0.701 0.720 0.420 0.724 0.559 0.728 0.249 0.737 0.069
+ 0.741 0.168 0.748 0.103 0.751 0.051 0.757 0.072 0.758 0.196 0.763 0.129 0.769 0.666
+ 0.778 0.515 0.785 0.126 0.791 0.108 0.800 0.029 0.809 0.087 0.821 0.016 0.826 0.327
+ 0.832 0.135 0.840 0.084 0.848 0.025 0.858 0.440 0.866 0.168 0.873 0.123 0.878 0.033
+ 0.886 0.055 0.900 0.008 0.907 0.593 0.918 0.102 0.923 0.463 0.930 0.361 0.940 0.343
+ 0.947 0.182 0.953 0.236 0.964 0.025 0.967 0.061 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.063 0.163 0.065 0.171 0.092 0.182 0.063 0.238 0.090 0.244 0.115 0.251 0.094
+ 0.267 0.092 0.285 0.094 0.381 0.096 0.387 0.129 0.398 0.092 0.427 0.094 0.438 0.069
+ 0.445 0.094 0.473 0.092 0.483 0.100 0.492 0.092 0.523 0.096 0.559 0.094 0.571 0.104
+ 0.581 0.092 0.618 0.096 0.633 0.096 0.645 0.100 0.661 0.085 0.673 0.096 0.708 0.096
+ 0.723 0.085 0.768 0.090 0.791 0.090 0.824 0.075 0.850 0.083 0.853 0.117 0.863 0.094
+ 0.888 0.094 0.906 0.115 0.920 0.110 0.931 0.085 1.000 0.087 )
+ :duration dur :scaler (hz->radians 8300.0)))
+ (gen1 (make-polywave 0.0 '(1 .6 2 -.1 3 .01 4 .05 5 .03 6 .01 7 .01 8 .005)))
+ (rnd (make-rand-interp 3000 (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd)))))))))
;; (with-sound (:play #t) (sandhill-crane 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Gray-crowned rosy-finch
-(definstrument (gray-crowned-rosy-finch beg amp)
+(defanimal (gray-crowned-rosy-finch beg amp)
;; calif 64 5.1
- (let* ((start (seconds->samples beg))
- (dur 0.15)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.339 0.937 0.454 0.992 0.609 0.860 0.807 0.575 1.000 0.000) :duration dur :scaler amp))
- (ampf2 (make-env '(0 1 .5 1 .55 0 1 0) :duration dur :scaler .2))
- (frqf1 (make-env '(0.000 0.000 0.004 0.271 0.031 0.299 0.085 0.313 0.167 0.318 0.227 0.317 0.243 0.326
- 0.281 0.296 0.299 0.318 0.309 0.299 0.325 0.299 0.338 0.285 0.356 0.321 0.369 0.301
- 0.387 0.294 0.396 0.280 0.415 0.313 0.430 0.282 0.452 0.283 0.462 0.263 0.483 0.304
- 0.497 0.280 0.517 0.288 0.534 0.249 0.550 0.293 0.568 0.254 0.587 0.285 0.611 0.222
- 0.627 0.274 0.647 0.238 0.662 0.263 0.677 0.247 0.696 0.203 0.708 0.219 0.715 0.250
- 0.734 0.230 0.755 0.246 0.781 0.198 0.800 0.250 0.811 0.228 0.834 0.250 0.869 0.191
- 0.893 0.252 0.915 0.220 0.939 0.244 0.967 0.220 1.000 0.222)
- :duration dur :scaler (hz->radians 13400.0)))
- (frqf2 (make-env '(0.000 0.328 0.086 0.397 0.158 0.441 0.219 0.446 0.232 0.420 0.258 0.430 0.281 0.387
- 0.307 0.419 0.330 0.400 0.344 0.369 0.357 0.395 0.382 0.397 0.396 0.365 0.416 0.398
- 0.442 0.402 0.460 0.354 0.480 0.397 0.504 0.384 0.526 0.329 0.550 0.294 1.000 0.288)
- :duration dur :scaler (hz->radians 13400.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .005)))
- (gen2 (make-oscil))
- (rnd (make-rand-interp 400 .5))
- (rnd1 (make-rand-interp 2000 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((rn (rand-interp rnd1)))
- (outa i (* (env ampf)
- (+ .5 (abs (rand-interp rnd)))
- (+ (polywave gen1 (+ rn (env frqf1)))
- (* (env ampf2)
- (oscil gen2 (+ rn (env frqf2)))))
- )))))))
+ (let ((dur 0.15))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.339 0.937 0.454 0.992 0.609 0.860 0.807 0.575 1.000 0.000) :duration dur :scaler amp))
+ (ampf2 (make-env '(0 1 .5 1 .55 0 1 0) :duration dur :scaler .2))
+ (frqf1 (make-env '(0.000 0.000 0.004 0.271 0.031 0.299 0.085 0.313 0.167 0.318 0.227 0.317 0.243 0.326
+ 0.281 0.296 0.299 0.318 0.309 0.299 0.325 0.299 0.338 0.285 0.356 0.321 0.369 0.301
+ 0.387 0.294 0.396 0.280 0.415 0.313 0.430 0.282 0.452 0.283 0.462 0.263 0.483 0.304
+ 0.497 0.280 0.517 0.288 0.534 0.249 0.550 0.293 0.568 0.254 0.587 0.285 0.611 0.222
+ 0.627 0.274 0.647 0.238 0.662 0.263 0.677 0.247 0.696 0.203 0.708 0.219 0.715 0.250
+ 0.734 0.230 0.755 0.246 0.781 0.198 0.800 0.250 0.811 0.228 0.834 0.250 0.869 0.191
+ 0.893 0.252 0.915 0.220 0.939 0.244 0.967 0.220 1.000 0.222)
+ :duration dur :scaler (hz->radians 13400.0)))
+ (frqf2 (make-env '(0.000 0.328 0.086 0.397 0.158 0.441 0.219 0.446 0.232 0.420 0.258 0.430 0.281 0.387
+ 0.307 0.419 0.330 0.400 0.344 0.369 0.357 0.395 0.382 0.397 0.396 0.365 0.416 0.398
+ 0.442 0.402 0.460 0.354 0.480 0.397 0.504 0.384 0.526 0.329 0.550 0.294 1.000 0.288)
+ :duration dur :scaler (hz->radians 13400.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .005)))
+ (gen2 (make-oscil))
+ (rnd (make-rand-interp 400 .5))
+ (rnd1 (make-rand-interp 2000 (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((rn (rand-interp rnd1)))
+ (outa i (* (env ampf)
+ (+ .5 (abs (rand-interp rnd)))
+ (+ (polywave gen1 (+ rn (env frqf1)))
+ (* (env ampf2)
+ (oscil gen2 (+ rn (env frqf2))))))))))))
;; (with-sound (:play #t) (gray-crowned-rosy-finch 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Virginia rail
@@ -8266,73 +8274,69 @@
(define (virginia-rail beg amp)
;; calif 28 20
- (definstrument (virginia-rail-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.048)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.021 0.076 0.040 0.233 0.058 0.307 0.075 0.254 0.099 0.000 0.118 0.213
- 0.131 0.118 0.180 0.935 0.217 0.207 0.224 0.315 0.253 0.142 0.274 1.000 0.290 0.956
- 0.305 0.247 0.321 0.203 0.332 0.070 0.362 0.896 0.376 0.706 0.384 0.237 0.402 0.292
- 0.417 0.556 0.431 0.607 0.438 0.767 0.469 0.858 0.480 0.729 0.492 0.080 0.503 0.355
- 0.510 0.256 0.539 0.706 0.549 0.641 0.574 0.104 0.591 0.285 0.637 0.004 0.670 0.154
- 0.683 0.146 0.699 0.087 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave 2700 (list 1 .98 2 .01 3 .05 5 .005)))
- (gen2 (make-polywave 2400 (list 1 .98 2 .01 3 .03 5 .005)))
- (rnd (make-rand-interp 4000 (hz->radians 300))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (rand-interp rnd)))
- (outa i (* (env ampf)
- (+ (* .55 (polywave gen1 frq))
- (* .45 (polywave gen2))))))))))
-
- (definstrument (virginia-rail-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.048)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.042 0.141 0.071 0.749 0.087 0.659 0.104 0.283 0.118 0.150 0.133 0.229
- 0.146 0.147 0.153 0.385 0.172 0.503 0.195 0.950 0.219 0.075 0.227 0.257 0.245 0.101
- 0.264 0.193 0.282 0.976 0.312 0.815 0.346 0.437 0.387 0.888 0.406 0.622 0.434 0.767
- 0.451 0.277 0.463 0.363 0.486 0.106 0.497 0.690 0.507 0.727 0.523 0.338 0.540 0.910
- 0.555 0.892 0.563 0.582 0.578 0.716 0.588 0.637 0.605 0.171 0.631 0.939 0.646 0.862
- 0.664 0.413 0.687 0.061 0.703 0.171 0.724 0.072 0.743 0.150 0.776 0.103 0.801 0.139
- 0.828 0.066 0.909 0.029 0.957 0.061 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave 2700 (list 1 .98 2 .01 3 .05 5 .005)))
- (gen2 (make-polywave 2400 (list 1 .98 2 .01 3 .05 5 .005)))
- (rnd (make-rand-interp 4000 (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (rand-interp rnd)))
- (outa i (* (env ampf)
- (+ (* .45 (polywave gen1 frq))
- (* .55 (polywave gen2 frq))))))))))
-
- (definstrument (virginia-rail-3 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.048)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.062 0.158 0.095 0.921 0.127 0.411 0.237 0.954 0.260 0.382 0.294 0.993
- 0.315 0.473 0.326 0.583 0.353 0.217 0.406 0.991 0.428 0.437 0.449 0.769 0.498 0.305
- 0.526 0.883 0.548 0.367 0.562 0.892 0.578 0.347 0.597 0.316 0.612 0.890 0.637 0.717
- 0.665 0.235 0.696 0.545 0.711 0.233 0.754 0.754 0.818 0.099 0.854 0.123 0.910 0.033
- 0.940 0.117 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave 2700 (list 1 .98 2 .01 3 .05 5 .005)))
- (gen2 (make-polywave 2500 (list 1 .98 2 .01 3 .05 5 .005)))
- (gen3 (make-polywave 3000 (list 1 .98 2 .01 3 .05 5 .005)))
- (rnd (make-rand-interp 4000 (hz->radians 300))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (rand-interp rnd)))
- (outa i (* (env ampf)
- (+ (* .5 (polywave gen1 frq))
- (* .4 (polywave gen2 frq))
- (* .1 (polywave gen3 frq))))))))))
+ (defanimal (virginia-rail-1 beg amp)
+ (let ((dur 0.048))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.021 0.076 0.040 0.233 0.058 0.307 0.075 0.254 0.099 0.000 0.118 0.213
+ 0.131 0.118 0.180 0.935 0.217 0.207 0.224 0.315 0.253 0.142 0.274 1.000 0.290 0.956
+ 0.305 0.247 0.321 0.203 0.332 0.070 0.362 0.896 0.376 0.706 0.384 0.237 0.402 0.292
+ 0.417 0.556 0.431 0.607 0.438 0.767 0.469 0.858 0.480 0.729 0.492 0.080 0.503 0.355
+ 0.510 0.256 0.539 0.706 0.549 0.641 0.574 0.104 0.591 0.285 0.637 0.004 0.670 0.154
+ 0.683 0.146 0.699 0.087 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 2700 (list 1 (* .55 .98) 2 (* .55 .01) 3 (* .55 .05) 5 (* .55 .005))))
+ (gen2 (make-polywave 2400 (list 1 (* .45 .98) 2 (* .45 .01) 3 (* .45 .03) 5 (* .45 .005))))
+ (rnd (make-rand-interp 4000 (hz->radians 300))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 (rand-interp rnd))
+ (polywave gen2))))))))
+
+ (defanimal (virginia-rail-2 beg amp)
+ (let ((dur 0.048))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.042 0.141 0.071 0.749 0.087 0.659 0.104 0.283 0.118 0.150 0.133 0.229
+ 0.146 0.147 0.153 0.385 0.172 0.503 0.195 0.950 0.219 0.075 0.227 0.257 0.245 0.101
+ 0.264 0.193 0.282 0.976 0.312 0.815 0.346 0.437 0.387 0.888 0.406 0.622 0.434 0.767
+ 0.451 0.277 0.463 0.363 0.486 0.106 0.497 0.690 0.507 0.727 0.523 0.338 0.540 0.910
+ 0.555 0.892 0.563 0.582 0.578 0.716 0.588 0.637 0.605 0.171 0.631 0.939 0.646 0.862
+ 0.664 0.413 0.687 0.061 0.703 0.171 0.724 0.072 0.743 0.150 0.776 0.103 0.801 0.139
+ 0.828 0.066 0.909 0.029 0.957 0.061 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 2700 (list 1 (* .45 .98) 2 (* .45 .01) 3 (* .45 .05) 5 (* .45 .005))))
+ (gen2 (make-polywave 2400 (list 1 (* .55 .98) 2 (* .55 .01) 3 (* .55 .05) 5 (* .55 .005))))
+ (rnd (make-rand-interp 4000 (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (rand-interp rnd)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (polywave gen2 frq)))))))))
+
+ (defanimal (virginia-rail-3 beg amp)
+ (let ((dur 0.048))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.062 0.158 0.095 0.921 0.127 0.411 0.237 0.954 0.260 0.382 0.294 0.993
+ 0.315 0.473 0.326 0.583 0.353 0.217 0.406 0.991 0.428 0.437 0.449 0.769 0.498 0.305
+ 0.526 0.883 0.548 0.367 0.562 0.892 0.578 0.347 0.597 0.316 0.612 0.890 0.637 0.717
+ 0.665 0.235 0.696 0.545 0.711 0.233 0.754 0.754 0.818 0.099 0.854 0.123 0.910 0.033
+ 0.940 0.117 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 2700 (list 1 (* .5 .98) 2 (* .5 .01) 3 (* .5 .05) 5 (* .5 .005))))
+ (gen2 (make-polywave 2500 (list 1 (* .4 .98) 2 (* .4 .01) 3 (* .4 .05) 5 (* .4 .005))))
+ (gen3 (make-polywave 3000 (list 1 (* .1 .98) 2 (* .1 .01) 3 (* .1 .05) 5 (* .1 .005))))
+ (rnd (make-rand-interp 4000 (hz->radians 300))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (rand-interp rnd)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (polywave gen2 frq)
+ (polywave gen3 frq)))))))))
(virginia-rail-1 beg amp)
@@ -8352,445 +8356,436 @@
;; (with-sound (:play #t) (virginia-rail 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Sage Sparrow
;;;
;;; this is one of the best so far
-(definstrument (sage-sparrow beg amp)
+(defanimal (sage-sparrow beg amp)
;; calif 39 4
;; first 4 pure tones
- (let* ((start (seconds->samples beg))
- (dur 0.23)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.038 0.048 0.075 0.162 0.185 0.000 0.262 0.000 0.284 0.118 0.333 0.592
- 0.363 0.526 0.429 0.000 0.502 0.000 0.528 0.184 0.579 0.912 0.613 0.846 0.665 0.140
- 0.688 0.000 0.766 0.000 0.786 0.250 0.831 1.000 0.871 0.961 0.933 0.276 1.000 0.000)
- :duration dur :scaler (* .7 amp)))
- (gen1 (make-polywave 3800.0 (list 1 .995 2 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1))))))
+ (let ((dur 0.23))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.038 0.048 0.075 0.162 0.185 0.000 0.262 0.000 0.284 0.118 0.333 0.592
+ 0.363 0.526 0.429 0.000 0.502 0.000 0.528 0.184 0.579 0.912 0.613 0.846 0.665 0.140
+ 0.688 0.000 0.766 0.000 0.786 0.250 0.831 1.000 0.871 0.961 0.933 0.276 1.000 0.000)
+ :duration dur :scaler (* .7 amp)))
+ (gen1 (make-polywave 3800.0 '(1 .995 2 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1))))))
;; 3 buzzes
- (let* ((start (seconds->samples (+ beg 0.264)))
- (dur 0.23)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.055 0.118 0.071 0.099 0.079 0.329 0.107 0.208 0.114 0.248 0.125 0.568
- 0.153 0.202 0.159 0.224 0.173 0.532 0.200 0.199 0.213 0.226 0.226 0.467 0.255 0.128
- 0.270 0.348 0.299 0.106 0.313 0.138 0.351 0.000 0.454 0.000 0.464 0.052 0.471 0.021
- 0.481 0.046 0.485 0.138 0.496 0.058 0.502 0.104 0.507 0.322 0.515 0.163 0.523 0.124
- 0.534 0.584 0.537 0.350 0.544 0.230 0.549 0.411 0.555 0.825 0.560 0.439 0.569 0.323
- 0.573 0.421 0.579 1.000 0.591 0.348 0.603 0.981 0.612 0.433 0.618 0.235 0.628 0.981
- 0.636 0.425 0.643 0.301 0.649 0.432 0.653 0.799 0.666 0.185 0.671 0.286 0.680 0.660
- 0.691 0.061 0.698 0.139 0.704 0.334 0.719 0.093 0.769 0.038 0.805 0.026 0.838 0.060
- 0.854 0.139 0.865 0.046 0.872 0.201 0.880 0.004 0.891 0.174 0.899 0.042 0.907 0.201
- 0.918 0.029 0.926 0.113 0.936 0.019 0.943 0.068 0.957 0.013 0.960 0.074 0.971 0.021 1.000 0.000 )
- :duration dur :scaler (* .4 amp)))
- (frqf (make-env '(0.000 0.609 0.026 0.606 0.056 0.316 0.060 0.568 0.080 0.455 0.096 0.309 0.101 0.574
- 0.128 0.451 0.144 0.300 0.150 0.563 0.176 0.451 0.194 0.281 0.199 0.549 0.223 0.465
- 0.244 0.295 0.256 0.506 0.274 0.435 0.289 0.291 0.307 0.487 0.335 0.284 0.456 0.373
- 0.467 0.584 0.480 0.435 0.490 0.604 0.507 0.426 0.512 0.606 0.529 0.416 0.532 0.510
- 0.537 0.597 0.551 0.412 0.554 0.508 0.560 0.597 0.576 0.426 0.579 0.519 0.586 0.600
- 0.598 0.442 0.608 0.584 0.623 0.449 0.633 0.588 0.649 0.442 0.655 0.570 0.673 0.453
- 0.681 0.563 0.700 0.396 0.706 0.570 0.819 0.469 0.829 0.307 0.835 0.471 0.847 0.307
- 0.854 0.515 0.865 0.323 0.871 0.522 0.881 0.314 0.886 0.398 0.889 0.531 0.904 0.304
- 0.909 0.494 0.920 0.311 0.925 0.499 0.942 0.284 0.943 0.428 0.957 0.371 0.958 0.513 1.000 0.508 )
- :duration dur :scaler (hz->radians 4300.0) :offset (hz->radians 1000)))
- (gen1 (make-polywave :partials (list 1 .99 2 .005 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf)))))))
+ (let ((dur 0.23)
+ (start (seconds->samples (+ beg 0.264))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.055 0.118 0.071 0.099 0.079 0.329 0.107 0.208 0.114 0.248 0.125 0.568
+ 0.153 0.202 0.159 0.224 0.173 0.532 0.200 0.199 0.213 0.226 0.226 0.467 0.255 0.128
+ 0.270 0.348 0.299 0.106 0.313 0.138 0.351 0.000 0.454 0.000 0.464 0.052 0.471 0.021
+ 0.481 0.046 0.485 0.138 0.496 0.058 0.502 0.104 0.507 0.322 0.515 0.163 0.523 0.124
+ 0.534 0.584 0.537 0.350 0.544 0.230 0.549 0.411 0.555 0.825 0.560 0.439 0.569 0.323
+ 0.573 0.421 0.579 1.000 0.591 0.348 0.603 0.981 0.612 0.433 0.618 0.235 0.628 0.981
+ 0.636 0.425 0.643 0.301 0.649 0.432 0.653 0.799 0.666 0.185 0.671 0.286 0.680 0.660
+ 0.691 0.061 0.698 0.139 0.704 0.334 0.719 0.093 0.769 0.038 0.805 0.026 0.838 0.060
+ 0.854 0.139 0.865 0.046 0.872 0.201 0.880 0.004 0.891 0.174 0.899 0.042 0.907 0.201
+ 0.918 0.029 0.926 0.113 0.936 0.019 0.943 0.068 0.957 0.013 0.960 0.074 0.971 0.021 1.000 0.000 )
+ :duration dur :scaler (* .4 amp)))
+ (frqf (make-env '(0.000 0.609 0.026 0.606 0.056 0.316 0.060 0.568 0.080 0.455 0.096 0.309 0.101 0.574
+ 0.128 0.451 0.144 0.300 0.150 0.563 0.176 0.451 0.194 0.281 0.199 0.549 0.223 0.465
+ 0.244 0.295 0.256 0.506 0.274 0.435 0.289 0.291 0.307 0.487 0.335 0.284 0.456 0.373
+ 0.467 0.584 0.480 0.435 0.490 0.604 0.507 0.426 0.512 0.606 0.529 0.416 0.532 0.510
+ 0.537 0.597 0.551 0.412 0.554 0.508 0.560 0.597 0.576 0.426 0.579 0.519 0.586 0.600
+ 0.598 0.442 0.608 0.584 0.623 0.449 0.633 0.588 0.649 0.442 0.655 0.570 0.673 0.453
+ 0.681 0.563 0.700 0.396 0.706 0.570 0.819 0.469 0.829 0.307 0.835 0.471 0.847 0.307
+ 0.854 0.515 0.865 0.323 0.871 0.522 0.881 0.314 0.886 0.398 0.889 0.531 0.904 0.304
+ 0.909 0.494 0.920 0.311 0.925 0.499 0.942 0.284 0.943 0.428 0.957 0.371 0.958 0.513 1.000 0.508 )
+ :duration dur :scaler (hz->radians 4300.0) :offset (hz->radians 1000)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .005 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
;; next pure tone (overlaps next)
- (let* ((start (seconds->samples (+ beg 0.517)))
- (dur (* 3 0.088))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.079 0.082 0.202 0.616 0.333 0.966 0.423 1.000 0.548 0.851 0.831 0.146 1.000 0.050 3 0)
- :duration dur :scaler amp))
- (gen1 (make-polywave 3900.0 (list 1 .985 2 .005 3 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1))))))
+ (let ((dur (* 3 0.088))
+ (start (seconds->samples (+ beg 0.517))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.079 0.082 0.202 0.616 0.333 0.966 0.423 1.000 0.548 0.851 0.831 0.146 1.000 0.050 3 0)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 3900.0 '(1 .985 2 .005 3 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1))))))
;; another buzz
- (let* ((start (seconds->samples (+ beg 0.627)))
- (dur 0.236)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.020 0.352 0.045 0.261 0.068 0.462 0.086 0.256 0.109 0.295 0.130 0.506
- 0.152 0.151 0.176 0.705 0.192 0.359 0.202 0.169 0.230 0.666 0.247 0.293 0.263 0.190
- 0.282 0.652 0.307 0.124 0.323 0.259 0.343 0.723 0.353 0.364 0.368 0.167 0.384 0.293
- 0.397 0.785 0.405 0.380 0.421 0.128 0.437 0.256 0.452 0.762 0.466 0.300 0.481 0.112
- 0.490 0.245 0.507 0.826 0.522 0.334 0.529 0.165 0.539 0.103 0.563 0.762 0.575 0.309
- 0.593 0.192 0.608 0.318 0.617 0.945 0.645 0.098 0.663 0.256 0.677 0.906 0.691 0.384
- 0.707 0.092 0.721 0.334 0.736 1.000 0.757 0.316 0.760 0.144 0.769 0.080 0.777 0.297
- 0.794 0.771 0.825 0.108 0.837 0.277 0.854 0.867 0.864 0.263 0.881 0.085 0.899 0.204
- 0.913 0.753 0.944 0.098 0.958 0.130 0.974 0.563 1.000 0.000 )
- :duration dur :scaler (* .125 amp)))
- (frqf (make-env '(0.000 0.403 0.030 0.502 0.034 0.369 0.067 0.433 0.084 0.556 0.087 0.375 0.104 0.386
- 0.121 0.457 0.131 0.512 0.135 0.345 0.147 0.372 0.168 0.437 0.184 0.509 0.189 0.362
- 0.214 0.416 0.238 0.505 0.242 0.358 0.265 0.403 0.290 0.509 0.295 0.352 0.317 0.396
- 0.345 0.509 0.350 0.345 0.377 0.416 0.401 0.509 0.404 0.362 0.428 0.403 0.456 0.505
- 0.461 0.362 0.482 0.406 0.508 0.509 0.513 0.355 0.524 0.354 0.539 0.399 0.563 0.505
- 0.568 0.358 0.581 0.364 0.624 0.505 0.627 0.352 0.638 0.354 0.652 0.399 0.682 0.495
- 0.687 0.355 0.699 0.371 0.715 0.416 0.741 0.512 0.745 0.352 0.757 0.361 0.772 0.403
- 0.797 0.495 0.802 0.354 0.814 0.364 0.834 0.416 0.858 0.519 0.862 0.358 0.884 0.406
- 0.914 0.498 0.923 0.369 0.940 0.381 0.955 0.435 0.976 0.493 0.982 0.361 1.000 0.364)
- :duration dur :scaler (hz->radians 6100)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf)))))))
+ (let ((dur 0.236)
+ (start (seconds->samples (+ beg 0.627))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.020 0.352 0.045 0.261 0.068 0.462 0.086 0.256 0.109 0.295 0.130 0.506
+ 0.152 0.151 0.176 0.705 0.192 0.359 0.202 0.169 0.230 0.666 0.247 0.293 0.263 0.190
+ 0.282 0.652 0.307 0.124 0.323 0.259 0.343 0.723 0.353 0.364 0.368 0.167 0.384 0.293
+ 0.397 0.785 0.405 0.380 0.421 0.128 0.437 0.256 0.452 0.762 0.466 0.300 0.481 0.112
+ 0.490 0.245 0.507 0.826 0.522 0.334 0.529 0.165 0.539 0.103 0.563 0.762 0.575 0.309
+ 0.593 0.192 0.608 0.318 0.617 0.945 0.645 0.098 0.663 0.256 0.677 0.906 0.691 0.384
+ 0.707 0.092 0.721 0.334 0.736 1.000 0.757 0.316 0.760 0.144 0.769 0.080 0.777 0.297
+ 0.794 0.771 0.825 0.108 0.837 0.277 0.854 0.867 0.864 0.263 0.881 0.085 0.899 0.204
+ 0.913 0.753 0.944 0.098 0.958 0.130 0.974 0.563 1.000 0.000 )
+ :duration dur :scaler (* .125 amp)))
+ (frqf (make-env '(0.000 0.403 0.030 0.502 0.034 0.369 0.067 0.433 0.084 0.556 0.087 0.375 0.104 0.386
+ 0.121 0.457 0.131 0.512 0.135 0.345 0.147 0.372 0.168 0.437 0.184 0.509 0.189 0.362
+ 0.214 0.416 0.238 0.505 0.242 0.358 0.265 0.403 0.290 0.509 0.295 0.352 0.317 0.396
+ 0.345 0.509 0.350 0.345 0.377 0.416 0.401 0.509 0.404 0.362 0.428 0.403 0.456 0.505
+ 0.461 0.362 0.482 0.406 0.508 0.509 0.513 0.355 0.524 0.354 0.539 0.399 0.563 0.505
+ 0.568 0.358 0.581 0.364 0.624 0.505 0.627 0.352 0.638 0.354 0.652 0.399 0.682 0.495
+ 0.687 0.355 0.699 0.371 0.715 0.416 0.741 0.512 0.745 0.352 0.757 0.361 0.772 0.403
+ 0.797 0.495 0.802 0.354 0.814 0.364 0.834 0.416 0.858 0.519 0.862 0.358 0.884 0.406
+ 0.914 0.498 0.923 0.369 0.940 0.381 0.955 0.435 0.976 0.493 0.982 0.361 1.000 0.364)
+ :duration dur :scaler (hz->radians 6100)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
;; 2 more buzzes
- (let* ((start (seconds->samples (+ beg 0.897)))
- (dur 0.22)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.024 0.034 0.032 0.018 0.042 0.059 0.047 0.029 0.057 0.101 0.062 0.043
- 0.072 0.146 0.079 0.016 0.087 0.183 0.095 0.031 0.103 0.194 0.109 0.050 0.117 0.241
- 0.125 0.031 0.132 0.268 0.140 0.038 0.148 0.335 0.155 0.050 0.164 0.351 0.170 0.068
- 0.182 0.401 0.187 0.151 0.194 0.511 0.203 0.187 0.212 0.531 0.218 0.273 0.227 0.662
- 0.233 0.473 0.242 0.775 0.249 0.604 0.268 0.919 0.279 0.878 0.289 1.000 0.301 0.795
- 0.313 0.775 0.331 0.563 0.341 0.561 0.375 0.236 0.407 0.124 0.426 0.108 0.436 0.000
- 0.591 0.000 0.618 0.052 0.626 0.032 0.649 0.122 0.657 0.076 0.676 0.270 0.687 0.205
- 0.704 0.469 0.713 0.360 0.721 0.442 0.728 0.227 0.735 0.585 0.751 0.518 0.757 0.272
- 0.768 0.694 0.780 0.592 0.790 0.324 0.799 0.712 0.811 0.680 0.821 0.286 0.833 0.718
- 0.840 0.687 0.850 0.216 0.861 0.656 0.874 0.592 0.881 0.194 0.892 0.477 0.901 0.468
- 0.914 0.153 0.924 0.349 0.939 0.085 1.000 0.000)
- :duration dur :scaler (* .8 amp)))
- (frqf (make-env '(0.000 0.600 0.214 0.619 0.258 0.609 0.298 0.534 0.391 0.427 0.629 0.483 0.646 0.613
- 0.660 0.513 0.678 0.623 0.694 0.508 0.708 0.628 0.724 0.529 0.737 0.642 0.753 0.527
- 0.769 0.634 0.783 0.527 0.800 0.642 0.814 0.521 0.831 0.648 0.845 0.523 0.862 0.644
- 0.876 0.536 0.893 0.640 0.908 0.531 0.923 0.642 1.000 0.563)
- :duration dur :scaler (hz->radians 5950)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .006 4 .004))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf)))))))
+ (let ((dur 0.22)
+ (start (seconds->samples (+ beg 0.897))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.024 0.034 0.032 0.018 0.042 0.059 0.047 0.029 0.057 0.101 0.062 0.043
+ 0.072 0.146 0.079 0.016 0.087 0.183 0.095 0.031 0.103 0.194 0.109 0.050 0.117 0.241
+ 0.125 0.031 0.132 0.268 0.140 0.038 0.148 0.335 0.155 0.050 0.164 0.351 0.170 0.068
+ 0.182 0.401 0.187 0.151 0.194 0.511 0.203 0.187 0.212 0.531 0.218 0.273 0.227 0.662
+ 0.233 0.473 0.242 0.775 0.249 0.604 0.268 0.919 0.279 0.878 0.289 1.000 0.301 0.795
+ 0.313 0.775 0.331 0.563 0.341 0.561 0.375 0.236 0.407 0.124 0.426 0.108 0.436 0.000
+ 0.591 0.000 0.618 0.052 0.626 0.032 0.649 0.122 0.657 0.076 0.676 0.270 0.687 0.205
+ 0.704 0.469 0.713 0.360 0.721 0.442 0.728 0.227 0.735 0.585 0.751 0.518 0.757 0.272
+ 0.768 0.694 0.780 0.592 0.790 0.324 0.799 0.712 0.811 0.680 0.821 0.286 0.833 0.718
+ 0.840 0.687 0.850 0.216 0.861 0.656 0.874 0.592 0.881 0.194 0.892 0.477 0.901 0.468
+ 0.914 0.153 0.924 0.349 0.939 0.085 1.000 0.000)
+ :duration dur :scaler (* .8 amp)))
+ (frqf (make-env '(0.000 0.600 0.214 0.619 0.258 0.609 0.298 0.534 0.391 0.427 0.629 0.483 0.646 0.613
+ 0.660 0.513 0.678 0.623 0.694 0.508 0.708 0.628 0.724 0.529 0.737 0.642 0.753 0.527
+ 0.769 0.634 0.783 0.527 0.800 0.642 0.814 0.521 0.831 0.648 0.845 0.523 0.862 0.644
+ 0.876 0.536 0.893 0.640 0.908 0.531 0.923 0.642 1.000 0.563)
+ :duration dur :scaler (hz->radians 5950)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .006 4 .004))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
;; two tones
- (let* ((start (seconds->samples (+ beg 1.123)))
- (dur 0.145)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.060 0.075 0.110 0.186 0.159 0.285 0.209 0.328 0.268 0.305 0.384 0.002
- 0.461 0.000 0.497 0.144 0.572 0.851 0.631 1.000 0.661 0.989 0.712 0.835 0.768 0.540
- 0.822 0.136 0.861 0.061 0.915 0.044 0.942 0.069 1.000 0.000)
- :duration dur :scaler (* .6 amp)))
- (frqf (make-env '(0.000 0.313 0.164 0.305 0.379 0.289 0.421 0.292 0.432 0.411 0.642 0.398 1.000 0.401)
- :duration dur :scaler (hz->radians 7900)))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .01 4 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf)))))))
+ (let ((dur 0.145)
+ (start (seconds->samples (+ beg 1.123))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.060 0.075 0.110 0.186 0.159 0.285 0.209 0.328 0.268 0.305 0.384 0.002
+ 0.461 0.000 0.497 0.144 0.572 0.851 0.631 1.000 0.661 0.989 0.712 0.835 0.768 0.540
+ 0.822 0.136 0.861 0.061 0.915 0.044 0.942 0.069 1.000 0.000)
+ :duration dur :scaler (* .6 amp)))
+ (frqf (make-env '(0.000 0.313 0.164 0.305 0.379 0.289 0.421 0.292 0.432 0.411 0.642 0.398 1.000 0.401)
+ :duration dur :scaler (hz->radians 7900)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .01 4 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
;; last buzz
- (let* ((start (seconds->samples (+ beg 1.25)))
- (dur 0.321)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.011 0.132 0.016 0.059 0.027 0.220 0.034 0.078 0.044 0.323 0.051 0.080
- 0.059 0.561 0.065 0.103 0.072 0.674 0.085 0.028 0.094 0.072 0.102 0.654 0.108 0.088
- 0.118 0.922 0.139 0.031 0.145 0.109 0.149 0.579 0.156 0.134 0.165 0.917 0.173 0.770
- 0.179 0.222 0.185 0.023 0.189 0.096 0.196 0.690 0.201 0.039 0.209 0.961 0.217 0.842
- 0.225 0.031 0.238 0.067 0.244 0.566 0.249 0.129 0.257 0.904 0.262 0.801 0.270 0.147
- 0.278 0.049 0.283 0.140 0.288 0.612 0.294 0.036 0.301 0.979 0.309 0.925 0.318 0.124
- 0.329 0.052 0.334 0.432 0.339 0.041 0.348 0.718 0.354 0.879 0.366 0.065 0.377 0.080
- 0.380 0.494 0.387 0.103 0.401 0.817 0.413 0.054 0.423 0.088 0.429 0.447 0.434 0.057
- 0.446 0.824 0.450 0.708 0.459 0.070 0.470 0.059 0.473 0.279 0.478 0.044 0.489 0.760
- 0.494 0.726 0.507 0.072 0.514 0.044 0.520 0.276 0.527 0.052 0.535 0.506 0.539 0.592
- 0.552 0.054 0.559 0.078 0.564 0.245 0.573 0.052 0.584 0.633 0.589 0.483 0.596 0.088
- 0.605 0.065 0.611 0.258 0.616 0.067 0.625 0.488 0.628 0.545 0.642 0.054 0.653 0.085
- 0.656 0.227 0.665 0.049 0.670 0.401 0.674 0.468 0.679 0.416 0.687 0.062 0.696 0.072
- 0.701 0.147 0.708 0.078 0.715 0.444 0.719 0.514 0.734 0.052 0.741 0.031 0.748 0.142
- 0.753 0.065 0.764 0.442 0.780 0.065 0.787 0.052 0.794 0.147 0.801 0.054 0.811 0.370
- 0.815 0.331 0.825 0.054 0.834 0.041 0.840 0.140 0.846 0.049 0.858 0.362 0.863 0.279
- 0.870 0.044 0.882 0.034 0.885 0.109 0.892 0.052 0.897 0.072 0.902 0.209 0.908 0.269
- 0.916 0.044 0.930 0.021 0.934 0.085 0.942 0.026 0.958 0.129 0.972 0.039 1.000 0.000)
- :duration dur :scaler (* .25 amp)))
- (frqf (make-env '(0.000 0.592 0.013 0.550 0.023 0.615 0.035 0.548 0.043 0.612 0.054 0.530 0.063 0.646
- 0.071 0.556 0.098 0.545 0.103 0.654 0.113 0.558 0.143 0.550 0.150 0.664 0.155 0.550
- 0.178 0.556 0.185 0.641 0.191 0.556 0.227 0.563 0.234 0.643 0.238 0.550 0.270 0.553
- 0.276 0.630 0.280 0.553 0.310 0.550 0.317 0.620 0.322 0.550 0.356 0.548 0.363 0.612
- 0.367 0.548 0.402 0.550 0.407 0.628 0.413 0.553 0.445 0.550 0.449 0.607 0.453 0.537
- 0.485 0.540 0.492 0.615 0.497 0.545 0.529 0.543 0.537 0.612 0.542 0.537 0.572 0.532
- 0.579 0.581 0.583 0.537 0.613 0.537 0.617 0.597 0.623 0.522 0.656 0.525 0.662 0.589
- 0.668 0.535 0.703 0.535 0.706 0.597 0.712 0.530 0.742 0.530 0.747 0.581 0.757 0.540
- 0.786 0.540 0.791 0.602 0.797 0.537 0.832 0.537 0.836 0.605 0.843 0.532 0.859 0.587
- 0.891 0.491 0.901 0.594 1.000 0.545)
- :duration dur :scaler (hz->radians 5400)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.321)
+ (start (seconds->samples (+ beg 1.25))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.011 0.132 0.016 0.059 0.027 0.220 0.034 0.078 0.044 0.323 0.051 0.080
+ 0.059 0.561 0.065 0.103 0.072 0.674 0.085 0.028 0.094 0.072 0.102 0.654 0.108 0.088
+ 0.118 0.922 0.139 0.031 0.145 0.109 0.149 0.579 0.156 0.134 0.165 0.917 0.173 0.770
+ 0.179 0.222 0.185 0.023 0.189 0.096 0.196 0.690 0.201 0.039 0.209 0.961 0.217 0.842
+ 0.225 0.031 0.238 0.067 0.244 0.566 0.249 0.129 0.257 0.904 0.262 0.801 0.270 0.147
+ 0.278 0.049 0.283 0.140 0.288 0.612 0.294 0.036 0.301 0.979 0.309 0.925 0.318 0.124
+ 0.329 0.052 0.334 0.432 0.339 0.041 0.348 0.718 0.354 0.879 0.366 0.065 0.377 0.080
+ 0.380 0.494 0.387 0.103 0.401 0.817 0.413 0.054 0.423 0.088 0.429 0.447 0.434 0.057
+ 0.446 0.824 0.450 0.708 0.459 0.070 0.470 0.059 0.473 0.279 0.478 0.044 0.489 0.760
+ 0.494 0.726 0.507 0.072 0.514 0.044 0.520 0.276 0.527 0.052 0.535 0.506 0.539 0.592
+ 0.552 0.054 0.559 0.078 0.564 0.245 0.573 0.052 0.584 0.633 0.589 0.483 0.596 0.088
+ 0.605 0.065 0.611 0.258 0.616 0.067 0.625 0.488 0.628 0.545 0.642 0.054 0.653 0.085
+ 0.656 0.227 0.665 0.049 0.670 0.401 0.674 0.468 0.679 0.416 0.687 0.062 0.696 0.072
+ 0.701 0.147 0.708 0.078 0.715 0.444 0.719 0.514 0.734 0.052 0.741 0.031 0.748 0.142
+ 0.753 0.065 0.764 0.442 0.780 0.065 0.787 0.052 0.794 0.147 0.801 0.054 0.811 0.370
+ 0.815 0.331 0.825 0.054 0.834 0.041 0.840 0.140 0.846 0.049 0.858 0.362 0.863 0.279
+ 0.870 0.044 0.882 0.034 0.885 0.109 0.892 0.052 0.897 0.072 0.902 0.209 0.908 0.269
+ 0.916 0.044 0.930 0.021 0.934 0.085 0.942 0.026 0.958 0.129 0.972 0.039 1.000 0.000)
+ :duration dur :scaler (* .25 amp)))
+ (frqf (make-env '(0.000 0.592 0.013 0.550 0.023 0.615 0.035 0.548 0.043 0.612 0.054 0.530 0.063 0.646
+ 0.071 0.556 0.098 0.545 0.103 0.654 0.113 0.558 0.143 0.550 0.150 0.664 0.155 0.550
+ 0.178 0.556 0.185 0.641 0.191 0.556 0.227 0.563 0.234 0.643 0.238 0.550 0.270 0.553
+ 0.276 0.630 0.280 0.553 0.310 0.550 0.317 0.620 0.322 0.550 0.356 0.548 0.363 0.612
+ 0.367 0.548 0.402 0.550 0.407 0.628 0.413 0.553 0.445 0.550 0.449 0.607 0.453 0.537
+ 0.485 0.540 0.492 0.615 0.497 0.545 0.529 0.543 0.537 0.612 0.542 0.537 0.572 0.532
+ 0.579 0.581 0.583 0.537 0.613 0.537 0.617 0.597 0.623 0.522 0.656 0.525 0.662 0.589
+ 0.668 0.535 0.703 0.535 0.706 0.597 0.712 0.530 0.742 0.530 0.747 0.581 0.757 0.540
+ 0.786 0.540 0.791 0.602 0.797 0.537 0.832 0.537 0.836 0.605 0.843 0.532 0.859 0.587
+ 0.891 0.491 0.901 0.594 1.000 0.545)
+ :duration dur :scaler (hz->radians 5400)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (sage-sparrow 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Hairy woodpecker
-(definstrument (hairy-woodpecker beg amp)
+(defanimal (hairy-woodpecker beg amp)
;; calif 81 10
- (let* ((start (seconds->samples beg))
- (dur 0.08)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.099 0.188 0.152 0.148 0.211 0.558 0.242 0.267 0.278 0.519 0.434 0.472
- 0.527 0.543 0.612 0.479 0.792 0.941 0.831 0.523 0.854 1.000 0.913 0.422 0.927 0.200
- 0.946 0.430 0.971 0.304 1.000 0.000 )
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.180 0.056 0.213 0.135 0.241 0.167 0.305 0.191 0.396 0.212 0.402 0.242 0.485
- 0.288 0.506 0.390 0.524 0.509 0.530 0.637 0.537 0.732 0.530 0.770 0.503 0.808 0.503
- 0.826 0.427 0.848 0.366 0.889 0.345 0.913 0.232 1.000 0.198)
- :duration dur :scaler (hz->radians 10000.0)))
- (gen1 (make-polywave :partials (list 1 .9 2 .09 3 .01)))
- (gen2 (make-polywave :partials (list 1 .2 2 .1 3 .1 4 .1 5 .1 6 .05 7 .01)))
- (ampf2 (make-env '(0 1 .3 1 .4 0 .75 0 .8 1 1 1) :duration dur :scaler 1.0)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2)
- (polywave gen2 (* 0.5 frq)))))))))))
+ (let ((dur 0.08))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.099 0.188 0.152 0.148 0.211 0.558 0.242 0.267 0.278 0.519 0.434 0.472
+ 0.527 0.543 0.612 0.479 0.792 0.941 0.831 0.523 0.854 1.000 0.913 0.422 0.927 0.200
+ 0.946 0.430 0.971 0.304 1.000 0.000 )
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.180 0.056 0.213 0.135 0.241 0.167 0.305 0.191 0.396 0.212 0.402 0.242 0.485
+ 0.288 0.506 0.390 0.524 0.509 0.530 0.637 0.537 0.732 0.530 0.770 0.503 0.808 0.503
+ 0.826 0.427 0.848 0.366 0.889 0.345 0.913 0.232 1.000 0.198)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (gen1 (make-polywave 0.0 '(1 .9 2 .09 3 .01)))
+ (gen2 (make-polywave 0.0 '(1 .2 2 .1 3 .1 4 .1 5 .1 6 .05 7 .01)))
+ (ampf2 (make-env '(0 1 .3 1 .4 0 .75 0 .8 1 1 1) :duration dur :scaler 1.0)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (polywave gen2 (* 0.5 frq)))))))))))
;; (with-sound (:play #t) (hairy-woodpecker 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Pacific-slope flycatcher
-(definstrument (pacific-slope-flycatcher beg amp)
+(defanimal (pacific-slope-flycatcher beg amp)
;; calif 8 22
- (let* ((start (seconds->samples beg))
- (dur 0.3)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.015 0.088 0.017 0.256 0.032 0.345 0.054 0.354 0.082 0.210 0.101 0.000
- 0.161 0.000 0.232 0.860 0.320 1.000 0.368 0.848 0.401 0.927 0.466 0.000 0.486 0.000
- 0.528 0.463 0.687 0.643 0.708 0.515 0.719 0.686 0.812 0.787 0.863 0.707 0.896 0.497
- 0.939 0.500 0.970 0.396 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.266 0.014 0.487 0.023 0.451 0.033 0.528 0.042 0.480 0.058 0.480 0.076 0.420
- 0.102 0.511 0.172 0.618 0.212 0.663 0.252 0.694 0.295 0.709 0.351 0.775 0.382 0.771
- 0.397 0.726 0.406 0.671 0.433 0.443 0.455 0.318 0.491 0.250 0.532 0.451 0.547 0.486
- 0.565 0.503 0.678 0.520 0.753 0.539 0.818 0.570 0.951 0.661 1.000 0.672)
- :duration dur :scaler (hz->radians 10100.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .005 3 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.3))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.015 0.088 0.017 0.256 0.032 0.345 0.054 0.354 0.082 0.210 0.101 0.000
+ 0.161 0.000 0.232 0.860 0.320 1.000 0.368 0.848 0.401 0.927 0.466 0.000 0.486 0.000
+ 0.528 0.463 0.687 0.643 0.708 0.515 0.719 0.686 0.812 0.787 0.863 0.707 0.896 0.497
+ 0.939 0.500 0.970 0.396 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.266 0.014 0.487 0.023 0.451 0.033 0.528 0.042 0.480 0.058 0.480 0.076 0.420
+ 0.102 0.511 0.172 0.618 0.212 0.663 0.252 0.694 0.295 0.709 0.351 0.775 0.382 0.771
+ 0.397 0.726 0.406 0.671 0.433 0.443 0.455 0.318 0.491 0.250 0.532 0.451 0.547 0.486
+ 0.565 0.503 0.678 0.520 0.753 0.539 0.818 0.570 0.951 0.661 1.000 0.672)
+ :duration dur :scaler (hz->radians 10100.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .005 3 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (pacific-slope-flycatcher 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Dusky flycatcher
-(definstrument (dusky-flycatcher beg amp)
+(defanimal (dusky-flycatcher beg amp)
;; calif 7 20.4
- (let* ((start (seconds->samples beg))
- (dur 0.125)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.018 0.291 0.036 0.414 0.103 0.559 0.131 0.572 0.212 0.748 0.279 1.000
- 0.297 0.994 0.354 0.272 0.400 0.102 0.417 0.000 0.580 0.000 0.588 0.089 0.619 0.164
- 0.647 0.362 0.660 0.364 0.687 0.042 0.700 0.091 0.731 0.692 0.746 0.659 0.766 0.385
- 0.779 0.314 0.794 0.071 0.812 0.042 0.844 0.374 0.868 0.333 0.891 0.177 0.924 0.069 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.535 0.036 0.500 0.087 0.460 0.145 0.451 0.229 0.458 0.288 0.470 0.335 0.507
- 0.386 0.533 0.416 0.521 0.583 0.314 0.656 0.353 0.677 0.398 0.682 0.537 0.696 0.567
- 0.711 0.540 0.723 0.414 0.751 0.419 0.788 0.470 0.796 0.567 0.809 0.600 0.829 0.574
- 0.841 0.460 0.864 0.460 0.892 0.505 0.924 0.528 0.971 0.516 1.000 0.495)
- :duration dur :scaler (hz->radians 10100.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.125))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.018 0.291 0.036 0.414 0.103 0.559 0.131 0.572 0.212 0.748 0.279 1.000
+ 0.297 0.994 0.354 0.272 0.400 0.102 0.417 0.000 0.580 0.000 0.588 0.089 0.619 0.164
+ 0.647 0.362 0.660 0.364 0.687 0.042 0.700 0.091 0.731 0.692 0.746 0.659 0.766 0.385
+ 0.779 0.314 0.794 0.071 0.812 0.042 0.844 0.374 0.868 0.333 0.891 0.177 0.924 0.069 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.535 0.036 0.500 0.087 0.460 0.145 0.451 0.229 0.458 0.288 0.470 0.335 0.507
+ 0.386 0.533 0.416 0.521 0.583 0.314 0.656 0.353 0.677 0.398 0.682 0.537 0.696 0.567
+ 0.711 0.540 0.723 0.414 0.751 0.419 0.788 0.470 0.796 0.567 0.809 0.600 0.829 0.574
+ 0.841 0.460 0.864 0.460 0.892 0.505 0.924 0.528 0.971 0.516 1.000 0.495)
+ :duration dur :scaler (hz->radians 10100.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (dusky-flycatcher 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Inca dove
-(definstrument (inca-dove-1 beg amp)
+(defanimal (inca-dove-1 beg amp)
;; south 11 9.6
- (let* ((start (seconds->samples beg))
- (dur 0.76)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.022 0.506 0.046 0.664 0.079 0.889 0.109 0.684 0.136 0.980 0.166 0.806
- 0.264 0.779 0.427 0.000 0.674 0.000 0.707 0.751 0.750 0.609 0.777 0.747 0.791 0.403
- 0.815 0.680 0.842 0.368 0.875 0.285 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.268 0.048 0.323 0.106 0.338 0.184 0.331 0.247 0.321 0.284 0.294 0.314 0.296
- 0.419 0.287 0.435 0.254 0.683 0.237 0.696 0.285 0.715 0.323 0.748 0.321 0.781 0.306
- 0.830 0.300 0.875 0.277 0.922 0.264 1.000 0.208)
- :duration dur :scaler (hz->radians 2850.0)))
- (gen1 (make-polywave :partials (list 1 .99 3 .01)))
- (rndf (make-env '(0 0 .3 0 .4 1 .5 0 .65 0 .7 .1 .85 .1 1 1) :duration dur))
- (rnd (make-rand-interp 400 (hz->radians 100))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (* (env rndf)
- (rand-interp rnd))))))))))
+ (let ((dur 0.76))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.022 0.506 0.046 0.664 0.079 0.889 0.109 0.684 0.136 0.980 0.166 0.806
+ 0.264 0.779 0.427 0.000 0.674 0.000 0.707 0.751 0.750 0.609 0.777 0.747 0.791 0.403
+ 0.815 0.680 0.842 0.368 0.875 0.285 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.268 0.048 0.323 0.106 0.338 0.184 0.331 0.247 0.321 0.284 0.294 0.314 0.296
+ 0.419 0.287 0.435 0.254 0.683 0.237 0.696 0.285 0.715 0.323 0.748 0.321 0.781 0.306
+ 0.830 0.300 0.875 0.277 0.922 0.264 1.000 0.208)
+ :duration dur :scaler (hz->radians 2850.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 3 .01)))
+ (rndf (make-env '(0 0 .3 0 .4 1 .5 0 .65 0 .7 .1 .85 .1 1 1) :duration dur))
+ (rnd (make-rand-interp 400 (hz->radians 100))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (* (env rndf)
+ (rand-interp rnd))))))))))
;; (with-sound (:play #t) (inca-dove-1 0 .5))
-(definstrument (inca-dove-2 beg amp)
+(defanimal (inca-dove-2 beg amp)
;; south 11 11.3 ("what the hell")
- (let* ((start1 (seconds->samples beg))
- (pitch 5150)
-
- (dur1 .1)
- (stop1 (+ start1 (seconds->samples dur1)))
- (ampf1 (make-env '(0.000 0.000 0.354 0.256 0.417 0.212 0.543 0.031 0.579 0.101 0.608 0.606 0.635 0.822
- 0.666 0.744 0.724 0.046 0.749 0.637 0.783 0.981 0.821 0.966 0.869 0.660 0.905 0.746
- 0.930 0.702 0.972 0.197 1.000 0.000)
- :duration dur1 :scaler amp))
- (frqf1 (make-env '(0.000 0.092 0.082 0.115 0.201 0.137 0.351 0.143 0.477 0.140 0.553 0.162 0.624 0.166
- 0.675 0.159 0.770 0.166 0.838 0.162 0.933 0.156 1.000 0.156)
- :duration dur1 :scaler (hz->radians pitch)))
-
- (dur2 .07)
- (start2 (seconds->samples (+ beg .2)))
- (stop2 (+ start2 (seconds->samples dur2)))
- (ampf2 (make-env '(0.000 0.000 0.254 0.252 0.513 0.997 0.612 0.943 0.675 0.990 0.851 0.809 0.906 0.608 1.000 0.000)
- :duration dur2 :scaler amp))
- (frqf2 (make-env '(0.000 0.129 0.158 0.154 0.369 0.173 0.450 0.173 0.867 0.164 1.000 0.138)
- :duration dur2 :scaler (hz->radians pitch)))
-
- (dur3 .29)
- (start3 (seconds->samples (+ beg .3)))
- (stop3 (+ start3 (seconds->samples dur3)))
- (ampf3 (make-env '(0.000 0.000 0.017 0.084 0.043 1.000 0.049 0.964 0.065 0.202 0.071 0.311 0.084 1.000
- 0.096 0.851 0.109 0.363 0.123 0.920 0.140 0.790 0.150 0.308 0.162 0.931 0.166 0.896
- 0.177 0.414 0.186 0.859 0.190 0.794 0.197 0.264 0.204 0.890 0.209 0.858 0.216 0.218
- 0.228 0.934 0.233 0.885 0.243 0.331 0.248 0.776 0.253 0.877 0.264 0.372 0.274 0.881
- 0.277 0.869 0.287 0.128 0.290 0.481 0.292 0.789 0.296 0.848 0.302 0.660 0.307 0.182
- 0.311 0.478 0.313 0.831 0.318 0.950 0.322 0.881 0.330 0.175 0.334 0.559 0.338 0.896
- 0.341 0.953 0.350 0.438 0.356 0.829 0.362 0.952 0.364 0.887 0.374 0.309 0.387 0.942
- 0.391 0.930 0.396 0.796 0.407 0.912 0.421 0.272 0.428 0.633 0.431 0.847 0.436 0.878
- 0.446 0.222 0.452 0.811 0.459 0.967 0.468 0.825 0.475 0.942 0.480 0.896 0.491 0.153
- 0.506 0.919 0.512 0.867 0.523 0.482 0.532 0.581 0.544 0.402 0.551 0.633 0.559 0.767
- 0.563 0.740 0.575 0.485 0.587 0.638 0.597 0.656 0.606 0.590 0.616 0.477 0.627 0.025
- 0.634 0.213 0.642 0.301 0.665 0.251 0.673 0.156 0.687 0.276 0.717 0.159 0.725 0.207
- 0.735 0.094 0.749 0.157 0.769 0.108 0.799 0.155 0.827 0.115 0.858 0.142 0.876 0.070 1.000 0.000)
- :duration dur3 :scaler amp))
- (frqf3 (make-env '(0.000 0.172 0.135 0.191 0.199 0.192 0.266 0.176 0.325 0.173 0.384 0.182 0.423 0.186
- 0.614 0.173 0.896 0.145 1.000 0.138)
- :duration dur3 :scaler (hz->radians pitch)))
-
- (gen1 (make-polywave :partials (list 1 .99 3 .01)))
- (rnd (make-rand-interp 300 (hz->radians 50))))
- (run
- (do ((i start1 (+ i 1)))
- ((= i stop1))
- (outa i (* (env ampf1) (polywave gen1 (env frqf1)))))
-
- (do ((i start2 (+ i 1)))
- ((= i stop2))
- (outa i (* (env ampf2) (polywave gen1 (env frqf2)))))
-
- (do ((i start3 (+ i 1)))
- ((= i stop3))
- (outa i (* (env ampf3) (polywave gen1 (+ (env frqf3)
- (rand-interp rnd)))))))))
+ (let ((pitch 5150)
+ (dur1 .1)
+ (dur2 .07)
+ (dur3 .29)
+ (start1 (seconds->samples beg)))
+ (let ((stop1 (+ start1 (seconds->samples dur1)))
+ (ampf1 (make-env '(0.000 0.000 0.354 0.256 0.417 0.212 0.543 0.031 0.579 0.101 0.608 0.606 0.635 0.822
+ 0.666 0.744 0.724 0.046 0.749 0.637 0.783 0.981 0.821 0.966 0.869 0.660 0.905 0.746
+ 0.930 0.702 0.972 0.197 1.000 0.000)
+ :duration dur1 :scaler amp))
+ (frqf1 (make-env '(0.000 0.092 0.082 0.115 0.201 0.137 0.351 0.143 0.477 0.140 0.553 0.162 0.624 0.166
+ 0.675 0.159 0.770 0.166 0.838 0.162 0.933 0.156 1.000 0.156)
+ :duration dur1 :scaler (hz->radians pitch)))
+
+ (start2 (seconds->samples (+ beg .2))))
+ (let ((stop2 (+ start2 (seconds->samples dur2)))
+ (ampf2 (make-env '(0.000 0.000 0.254 0.252 0.513 0.997 0.612 0.943 0.675 0.990 0.851 0.809 0.906 0.608 1.000 0.000)
+ :duration dur2 :scaler amp))
+ (frqf2 (make-env '(0.000 0.129 0.158 0.154 0.369 0.173 0.450 0.173 0.867 0.164 1.000 0.138)
+ :duration dur2 :scaler (hz->radians pitch)))
+
+ (start3 (seconds->samples (+ beg .3))))
+ (let ((stop3 (+ start3 (seconds->samples dur3)))
+ (ampf3 (make-env '(0.000 0.000 0.017 0.084 0.043 1.000 0.049 0.964 0.065 0.202 0.071 0.311 0.084 1.000
+ 0.096 0.851 0.109 0.363 0.123 0.920 0.140 0.790 0.150 0.308 0.162 0.931 0.166 0.896
+ 0.177 0.414 0.186 0.859 0.190 0.794 0.197 0.264 0.204 0.890 0.209 0.858 0.216 0.218
+ 0.228 0.934 0.233 0.885 0.243 0.331 0.248 0.776 0.253 0.877 0.264 0.372 0.274 0.881
+ 0.277 0.869 0.287 0.128 0.290 0.481 0.292 0.789 0.296 0.848 0.302 0.660 0.307 0.182
+ 0.311 0.478 0.313 0.831 0.318 0.950 0.322 0.881 0.330 0.175 0.334 0.559 0.338 0.896
+ 0.341 0.953 0.350 0.438 0.356 0.829 0.362 0.952 0.364 0.887 0.374 0.309 0.387 0.942
+ 0.391 0.930 0.396 0.796 0.407 0.912 0.421 0.272 0.428 0.633 0.431 0.847 0.436 0.878
+ 0.446 0.222 0.452 0.811 0.459 0.967 0.468 0.825 0.475 0.942 0.480 0.896 0.491 0.153
+ 0.506 0.919 0.512 0.867 0.523 0.482 0.532 0.581 0.544 0.402 0.551 0.633 0.559 0.767
+ 0.563 0.740 0.575 0.485 0.587 0.638 0.597 0.656 0.606 0.590 0.616 0.477 0.627 0.025
+ 0.634 0.213 0.642 0.301 0.665 0.251 0.673 0.156 0.687 0.276 0.717 0.159 0.725 0.207
+ 0.735 0.094 0.749 0.157 0.769 0.108 0.799 0.155 0.827 0.115 0.858 0.142 0.876 0.070 1.000 0.000)
+ :duration dur3 :scaler amp))
+ (frqf3 (make-env '(0.000 0.172 0.135 0.191 0.199 0.192 0.266 0.176 0.325 0.173 0.384 0.182 0.423 0.186
+ 0.614 0.173 0.896 0.145 1.000 0.138)
+ :duration dur3 :scaler (hz->radians pitch)))
+
+ (gen1 (make-polywave 0.0 '(1 .99 3 .01)))
+ (rnd (make-rand-interp 300 (hz->radians 50))))
+ (do ((i start1 (+ i 1)))
+ ((= i stop1))
+ (outa i (* (env ampf1) (polywave gen1 (env frqf1)))))
+
+ (do ((i start2 (+ i 1)))
+ ((= i stop2))
+ (outa i (* (env ampf2) (polywave gen1 (env frqf2)))))
+
+ (do ((i start3 (+ i 1)))
+ ((= i stop3))
+ (outa i (* (env ampf3) (polywave gen1 (+ (env frqf3)
+ (rand-interp rnd)))))))))))
;; (with-sound (:play #t) (inca-dove-2 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Great kiskadee
-(definstrument (great-kiskadee beg amp)
+(defanimal (great-kiskadee beg amp)
;; south 37 16.5
;; note #1
- (let* ((start (seconds->samples beg))
- (dur 0.123)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.013 0.068 0.026 0.000 0.048 0.030 0.053 0.211 0.068 0.000 0.083 0.000
- 0.093 0.184 0.098 0.479 0.114 0.000 0.125 0.000 0.135 0.216 0.140 0.526 0.159 0.000
- 0.172 0.000 0.174 0.159 0.179 0.252 0.185 0.625 0.190 0.578 0.205 0.000 0.218 0.066
- 0.225 0.301 0.230 0.715 0.240 0.592 0.250 0.000 0.260 0.077 0.280 0.800 0.295 0.000
- 0.305 0.099 0.324 0.822 0.341 0.000 0.351 0.137 0.370 0.855 0.377 0.660 0.389 0.000
- 0.396 0.110 0.405 0.397 0.414 0.868 0.422 0.751 0.442 0.071 0.457 0.562 0.461 0.827
- 0.470 0.759 0.488 0.438 0.496 0.863 0.506 0.822 0.519 0.666 0.538 0.737 0.553 0.737
- 0.567 0.871 0.619 0.973 0.650 0.847 0.694 0.375 0.766 0.238 0.789 0.353 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.357 0.048 0.353 0.056 0.407 0.098 0.353 0.105 0.395 0.142 0.347 0.145 0.390
- 0.183 0.353 0.194 0.403 0.231 0.374 0.240 0.420 0.273 0.372 0.285 0.434 0.317 0.388
- 0.332 0.438 0.364 0.376 0.382 0.438 0.406 0.384 0.427 0.447 0.454 0.370 0.472 0.432
- 0.489 0.436 0.500 0.399 0.527 0.418 0.561 0.420 0.647 0.359 0.711 0.317 0.736 0.313
- .9 .2 .95 .15)
- :duration dur :scaler (hz->radians (* 0.5 8280.0))))
- (gen1 (make-polywave :partials (normalize-partials (list 1 .17 3 .1 4 .1 5 .14 6 .01))))
- (ampf1 (make-env '(0 .1 .3 1 .5 1 .8 0 1 0) :duration dur))
- (gen2 (make-polywave :partials (normalize-partials (list 2 .95 3 .04 4 .03)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (polywave gen1 frq))
- (polywave gen2 frq))))))))
-
+ (let ((dur 0.123))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.013 0.068 0.026 0.000 0.048 0.030 0.053 0.211 0.068 0.000 0.083 0.000
+ 0.093 0.184 0.098 0.479 0.114 0.000 0.125 0.000 0.135 0.216 0.140 0.526 0.159 0.000
+ 0.172 0.000 0.174 0.159 0.179 0.252 0.185 0.625 0.190 0.578 0.205 0.000 0.218 0.066
+ 0.225 0.301 0.230 0.715 0.240 0.592 0.250 0.000 0.260 0.077 0.280 0.800 0.295 0.000
+ 0.305 0.099 0.324 0.822 0.341 0.000 0.351 0.137 0.370 0.855 0.377 0.660 0.389 0.000
+ 0.396 0.110 0.405 0.397 0.414 0.868 0.422 0.751 0.442 0.071 0.457 0.562 0.461 0.827
+ 0.470 0.759 0.488 0.438 0.496 0.863 0.506 0.822 0.519 0.666 0.538 0.737 0.553 0.737
+ 0.567 0.871 0.619 0.973 0.650 0.847 0.694 0.375 0.766 0.238 0.789 0.353 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.357 0.048 0.353 0.056 0.407 0.098 0.353 0.105 0.395 0.142 0.347 0.145 0.390
+ 0.183 0.353 0.194 0.403 0.231 0.374 0.240 0.420 0.273 0.372 0.285 0.434 0.317 0.388
+ 0.332 0.438 0.364 0.376 0.382 0.438 0.406 0.384 0.427 0.447 0.454 0.370 0.472 0.432
+ 0.489 0.436 0.500 0.399 0.527 0.418 0.561 0.420 0.647 0.359 0.711 0.317 0.736 0.313
+ .9 .2 .95 .15)
+ :duration dur :scaler (hz->radians (* 0.5 8280.0))))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 .17 3 .1 4 .1 5 .14 6 .01))))
+ (ampf1 (make-env '(0 .1 .3 1 .5 1 .8 0 1 0) :duration dur))
+ (gen2 (make-polywave 0.0 (normalize-partials '(2 .95 3 .04 4 .03)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (polywave gen1 frq))
+ (polywave gen2 frq))))))))
;; note #2
- (let* ((start (seconds->samples (+ beg .2)))
- (dur 0.38)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.024 0.225 0.147 0.534 0.263 0.731 0.406 0.881 0.597 0.873 0.772 0.754
- 0.897 0.503 0.926 0.582 1.000 0.000)
- :duration dur :scaler (* 0.8 amp)))
- (frqf (make-env '(0.000 0.195 0.066 0.286 0.086 0.305 0.120 0.365 0.187 0.417 0.345 0.461 0.525 0.483
- 0.748 0.450 0.853 0.429 0.919 0.392 0.957 0.328 0.971 0.253 1.000 0.214)
- :duration dur :scaler (hz->radians (* 0.5 5500.0))))
- (gen1 (make-polywave :partials (normalize-partials (list 3 .01 4 .01 5 .01 6 .01))))
- (gen2 (make-polywave :partials (normalize-partials (list 1 .08 2 1.0 3 .06 5 .02 7 .007 8 .003 10 .001))))
- (ampf1 (make-env '(0 1 .07 1 .15 .1 .85 .1 .9 1 1 1) :duration dur))
- (ampf2 (make-env '(0 0 .3 1 .8 1 1 0) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (polywave gen1 frq))
- (* (env ampf2)
- (polywave gen2 frq))))))))))
+ (let ((dur 0.38))
+ (let ((start (seconds->samples (+ beg .2)))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.024 0.225 0.147 0.534 0.263 0.731 0.406 0.881 0.597 0.873 0.772 0.754
+ 0.897 0.503 0.926 0.582 1.000 0.000)
+ :duration dur :scaler (* 0.8 amp)))
+ (frqf (make-env '(0.000 0.195 0.066 0.286 0.086 0.305 0.120 0.365 0.187 0.417 0.345 0.461 0.525 0.483
+ 0.748 0.450 0.853 0.429 0.919 0.392 0.957 0.328 0.971 0.253 1.000 0.214)
+ :duration dur :scaler (hz->radians (* 0.5 5500.0))))
+ (gen1 (make-polywave 0.0 (normalize-partials '(3 .01 4 .01 5 .01 6 .01))))
+ (gen2 (make-polywave 0.0 (normalize-partials '(1 .08 2 1.0 3 .06 5 .02 7 .007 8 .003 10 .001))))
+ (ampf1 (make-env '(0 1 .07 1 .15 .1 .85 .1 .9 1 1 1) :duration dur))
+ (ampf2 (make-env '(0 0 .3 1 .8 1 1 0) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (polywave gen1 frq))
+ (* (env ampf2)
+ (polywave gen2 frq))))))))))
;; (with-sound (:play #t) (great-kiskadee 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Chestnut-sided warbler
@@ -8798,79 +8793,76 @@
(define (chestnut-sided-warbler beg1 amp1)
;; east 12 3.5
- (definstrument (chestnut-sided-warbler-1 beg amp)
+ (defanimal (chestnut-sided-warbler-1 beg amp)
;; 1st 6 notes
- (let* ((start (seconds->samples beg))
- (dur 0.11)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.188 0.446 0.230 0.412 0.276 0.190 0.298 0.330 0.302 0.158 0.309 0.278
- 0.312 0.037 0.324 0.126 0.367 0.077 0.400 0.261 0.459 0.880 0.482 0.710 0.493 0.798
- 0.503 0.628 0.519 0.998 0.534 0.591 0.559 0.843 0.565 0.769 0.579 0.835 0.601 0.562
- 0.622 0.663 0.641 0.581 0.642 0.689 0.660 0.465 0.682 0.601 0.707 0.678 0.724 0.603
- 0.746 0.668 0.758 0.589 0.768 0.682 0.814 0.549 0.833 0.638 0.865 0.582 0.881 0.618
- 0.915 0.527 0.965 0.143 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.262 0.127 0.273 0.263 0.273 0.294 0.320 0.318 0.383 0.346 0.410 0.373 0.386
- 0.396 0.353 0.421 0.339 0.458 0.336 0.490 0.306 0.516 0.303 0.534 0.287 0.598 0.267
- 0.689 0.245 0.806 0.223 1.000 0.212)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (chestnut-sided-warbler-2 beg amp)
+ (let ((dur 0.11))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.188 0.446 0.230 0.412 0.276 0.190 0.298 0.330 0.302 0.158 0.309 0.278
+ 0.312 0.037 0.324 0.126 0.367 0.077 0.400 0.261 0.459 0.880 0.482 0.710 0.493 0.798
+ 0.503 0.628 0.519 0.998 0.534 0.591 0.559 0.843 0.565 0.769 0.579 0.835 0.601 0.562
+ 0.622 0.663 0.641 0.581 0.642 0.689 0.660 0.465 0.682 0.601 0.707 0.678 0.724 0.603
+ 0.746 0.668 0.758 0.589 0.768 0.682 0.814 0.549 0.833 0.638 0.865 0.582 0.881 0.618
+ 0.915 0.527 0.965 0.143 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.262 0.127 0.273 0.263 0.273 0.294 0.320 0.318 0.383 0.346 0.410 0.373 0.386
+ 0.396 0.353 0.421 0.339 0.458 0.336 0.490 0.306 0.516 0.303 0.534 0.287 0.598 0.267
+ 0.689 0.245 0.806 0.223 1.000 0.212)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (chestnut-sided-warbler-2 beg amp)
;; notes 7 and 8
- (let* ((start (seconds->samples beg))
- (dur 0.17)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.213 0.394 0.239 0.394 0.319 0.669 0.337 0.584 0.354 0.683 0.369 0.620
- 0.381 0.705 0.387 0.556 0.398 0.642 0.419 0.683 0.468 0.576 0.490 0.424 0.513 0.576
- 0.589 0.212 0.644 0.380 0.693 0.609 0.708 0.537 0.721 0.402 0.729 0.515 0.754 0.620
- 0.767 0.526 0.785 0.749 0.812 0.942 0.827 0.675 0.835 0.733 0.853 0.573 0.863 0.369
- 0.876 1.000 0.881 0.565 0.887 0.893 0.910 0.857 0.919 0.672 0.939 0.774 0.950 0.551
- 0.968 0.477 0.982 0.050 0.989 0.102 1.000 0.000)
- :duration dur :scaler (* .9 amp)))
- (frqf (make-env '(0.000 0.129 0.067 0.160 0.129 0.174 0.184 0.176 0.273 0.196 0.351 0.212 0.390 0.229
- 0.426 0.251 0.470 0.270 0.503 0.253 0.538 0.204 0.563 0.182 0.594 0.168 0.633 0.176
- 0.688 0.218 0.715 0.223 0.733 0.240 0.750 0.281 0.794 0.303 0.844 0.314 0.894 0.320
- 0.945 0.336 1.000 0.325)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .005 4 .003))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (chestnut-sided-warbler-3 beg amp)
+ (let ((dur 0.17))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.213 0.394 0.239 0.394 0.319 0.669 0.337 0.584 0.354 0.683 0.369 0.620
+ 0.381 0.705 0.387 0.556 0.398 0.642 0.419 0.683 0.468 0.576 0.490 0.424 0.513 0.576
+ 0.589 0.212 0.644 0.380 0.693 0.609 0.708 0.537 0.721 0.402 0.729 0.515 0.754 0.620
+ 0.767 0.526 0.785 0.749 0.812 0.942 0.827 0.675 0.835 0.733 0.853 0.573 0.863 0.369
+ 0.876 1.000 0.881 0.565 0.887 0.893 0.910 0.857 0.919 0.672 0.939 0.774 0.950 0.551
+ 0.968 0.477 0.982 0.050 0.989 0.102 1.000 0.000)
+ :duration dur :scaler (* .9 amp)))
+ (frqf (make-env '(0.000 0.129 0.067 0.160 0.129 0.174 0.184 0.176 0.273 0.196 0.351 0.212 0.390 0.229
+ 0.426 0.251 0.470 0.270 0.503 0.253 0.538 0.204 0.563 0.182 0.594 0.168 0.633 0.176
+ 0.688 0.218 0.715 0.223 0.733 0.240 0.750 0.281 0.794 0.303 0.844 0.314 0.894 0.320
+ 0.945 0.336 1.000 0.325)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .005 4 .003))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (chestnut-sided-warbler-3 beg amp)
;; last note
- (let* ((start (seconds->samples beg))
- (dur 0.19)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.015 0.036 0.074 0.344 0.105 0.331 0.111 0.427 0.137 0.455 0.152 0.567
- 0.166 0.466 0.178 0.840 0.194 0.749 0.207 0.884 0.232 0.992 0.239 0.953 0.245 0.763
- 0.255 0.895 0.260 0.749 0.272 0.862 0.286 0.650 0.295 0.744 0.302 0.636 0.334 0.501
- 0.352 0.711 0.375 0.730 0.384 0.559 0.395 0.620 0.404 0.576 0.419 0.656 0.443 0.540
- 0.462 0.559 0.473 0.490 0.487 0.534 0.566 0.267 0.582 0.320 0.645 0.154 0.714 0.113
- 1.000 0.000)
- :duration dur :scaler (* .7 amp)))
- (frqf (make-env '(0.000 0.416 0.039 0.419 0.063 0.410 0.092 0.386 0.127 0.342 0.167 0.314 0.229 0.278
- 0.334 0.245 0.497 0.198 0.579 0.179 0.628 0.176 0.675 0.171 0.731 0.160 0.841 0.152
- 1.000 0.118)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01)))) ; there are 3 to 5, but they alias at 44KHz
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (let ((amps (vct .1 .3 .6 .8 .9 1.0))
- (begs (vct 0.0 0.156 .311 .454 .594 .731)))
- (do ((call 0 (+ 1 call)))
+ (let ((dur 0.19))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.015 0.036 0.074 0.344 0.105 0.331 0.111 0.427 0.137 0.455 0.152 0.567
+ 0.166 0.466 0.178 0.840 0.194 0.749 0.207 0.884 0.232 0.992 0.239 0.953 0.245 0.763
+ 0.255 0.895 0.260 0.749 0.272 0.862 0.286 0.650 0.295 0.744 0.302 0.636 0.334 0.501
+ 0.352 0.711 0.375 0.730 0.384 0.559 0.395 0.620 0.404 0.576 0.419 0.656 0.443 0.540
+ 0.462 0.559 0.473 0.490 0.487 0.534 0.566 0.267 0.582 0.320 0.645 0.154 0.714 0.113
+ 1.000 0.000)
+ :duration dur :scaler (* .7 amp)))
+ (frqf (make-env '(0.000 0.416 0.039 0.419 0.063 0.410 0.092 0.386 0.127 0.342 0.167 0.314 0.229 0.278
+ 0.334 0.245 0.497 0.198 0.579 0.179 0.628 0.176 0.675 0.171 0.731 0.160 0.841 0.152
+ 1.000 0.118)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01)))) ; there are 3 to 5, but they alias at 44KHz
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (let ((amps (vector .1 .3 .6 .8 .9 1.0))
+ (begs (vector 0.0 0.156 .311 .454 .594 .731)))
+ (do ((call 0 (+ call 1)))
((= call 6))
(chestnut-sided-warbler-1 (+ beg1 (begs call))
(* amp1 (amps call)))))
@@ -8884,55 +8876,56 @@
;; (with-sound (:play #t) (chestnut-sided-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Yellow-bellied flycatcher
-(definstrument (yellow-bellied-flycatcher beg amp)
+(defanimal (yellow-bellied-flycatcher beg amp)
;; east 40 3.1
- (let* ((start (seconds->samples beg))
- (dur 0.167)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.031 0.122 0.054 0.665 0.082 0.777 0.092 0.724 0.105 0.774 0.109 0.639
- 0.116 0.697 0.121 0.577 0.135 0.781 0.149 0.368 0.153 0.419 0.171 0.092 0.176 0.234
- 0.224 0.028 0.264 0.191 0.284 0.619 0.299 0.709 0.304 0.914 0.311 0.861 0.316 0.945
- 0.320 0.809 0.327 0.957 0.332 0.786 0.337 0.972 0.348 0.973 0.362 0.742 0.377 0.358
- 0.390 0.388 0.413 0.035 0.420 0.070 0.428 0.031 0.450 0.068 0.458 0.022 0.471 0.088
- 0.480 0.051 0.490 0.189 0.499 0.041 0.509 0.164 0.518 0.101 0.526 0.230 0.536 0.046
- 0.544 0.188 0.554 0.241 0.557 0.139 0.563 0.214 0.567 0.316 0.578 0.038 0.584 0.192
- 0.595 0.303 0.598 0.186 0.607 0.381 0.615 0.082 0.621 0.132 0.628 0.286 0.634 0.266
- 0.638 0.300 0.646 0.385 0.655 0.109 0.662 0.084 0.664 0.170 0.668 0.247 0.675 0.212
- 0.687 0.382 0.697 0.122 0.704 0.086 0.708 0.236 0.715 0.262 0.718 0.334 0.724 0.251
- 0.727 0.364 0.730 0.319 0.740 0.088 0.744 0.045 0.749 0.120 0.752 0.286 0.759 0.373
- 0.764 0.259 0.770 0.341 0.778 0.234 0.782 0.057 0.789 0.122 0.794 0.245 0.801 0.336
- 0.808 0.231 0.813 0.327 0.821 0.224 0.826 0.045 0.838 0.197 0.846 0.346 0.861 0.266
- 0.867 0.074 0.874 0.189 0.880 0.168 0.887 0.388 0.904 0.489 0.917 0.520 0.922 0.497
- 0.929 0.258 0.936 0.253 0.943 0.124 0.950 0.180 0.959 0.051 0.971 0.099 0.974 0.061
- 0.980 0.089 0.988 0.032 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.341 0.025 0.368 0.045 0.434 0.059 0.482 0.073 0.482 0.086 0.465 0.101 0.434
- 0.127 0.416 0.150 0.392 0.181 0.341 0.205 0.319 0.232 0.339 0.268 0.407 0.289 0.458
- 0.311 0.500 0.324 0.509 0.390 0.518 0.408 0.590 0.444 0.487 0.455 0.247 0.470 0.253
- 0.479 0.289 0.485 0.394 0.495 0.421 0.502 0.370 0.507 0.304 0.515 0.286 0.522 0.304
- 0.523 0.438 0.529 0.454 0.538 0.441 0.546 0.319 0.552 0.295 0.559 0.326 0.562 0.425
- 0.567 0.452 0.574 0.427 0.582 0.357 0.592 0.324 0.600 0.344 0.602 0.416 0.608 0.445
- 0.616 0.447 0.625 0.339 0.634 0.322 0.642 0.337 0.643 0.394 0.645 0.454 0.654 0.452
- 0.664 0.357 0.674 0.335 0.683 0.339 0.685 0.427 0.692 0.458 0.698 0.430 0.704 0.352
- 0.714 0.337 0.721 0.346 0.727 0.436 0.731 0.456 0.737 0.434 0.742 0.374 0.756 0.346
- 0.767 0.355 0.773 0.443 0.780 0.460 0.786 0.438 0.791 0.385 0.799 0.348 0.810 0.366
- 0.815 0.421 0.821 0.434 0.824 0.419 0.831 0.372 0.841 0.359 0.851 0.357 0.854 0.388
- 0.856 0.515 0.864 0.568 0.871 0.555 0.883 0.436 0.914 0.421 0.930 0.385 1.000 0.368)
- :duration dur :scaler (hz->radians 10000.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .02 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.167))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.031 0.122 0.054 0.665 0.082 0.777 0.092 0.724 0.105 0.774 0.109 0.639
+ 0.116 0.697 0.121 0.577 0.135 0.781 0.149 0.368 0.153 0.419 0.171 0.092 0.176 0.234
+ 0.224 0.028 0.264 0.191 0.284 0.619 0.299 0.709 0.304 0.914 0.311 0.861 0.316 0.945
+ 0.320 0.809 0.327 0.957 0.332 0.786 0.337 0.972 0.348 0.973 0.362 0.742 0.377 0.358
+ 0.390 0.388 0.413 0.035 0.420 0.070 0.428 0.031 0.450 0.068 0.458 0.022 0.471 0.088
+ 0.480 0.051 0.490 0.189 0.499 0.041 0.509 0.164 0.518 0.101 0.526 0.230 0.536 0.046
+ 0.544 0.188 0.554 0.241 0.557 0.139 0.563 0.214 0.567 0.316 0.578 0.038 0.584 0.192
+ 0.595 0.303 0.598 0.186 0.607 0.381 0.615 0.082 0.621 0.132 0.628 0.286 0.634 0.266
+ 0.638 0.300 0.646 0.385 0.655 0.109 0.662 0.084 0.664 0.170 0.668 0.247 0.675 0.212
+ 0.687 0.382 0.697 0.122 0.704 0.086 0.708 0.236 0.715 0.262 0.718 0.334 0.724 0.251
+ 0.727 0.364 0.730 0.319 0.740 0.088 0.744 0.045 0.749 0.120 0.752 0.286 0.759 0.373
+ 0.764 0.259 0.770 0.341 0.778 0.234 0.782 0.057 0.789 0.122 0.794 0.245 0.801 0.336
+ 0.808 0.231 0.813 0.327 0.821 0.224 0.826 0.045 0.838 0.197 0.846 0.346 0.861 0.266
+ 0.867 0.074 0.874 0.189 0.880 0.168 0.887 0.388 0.904 0.489 0.917 0.520 0.922 0.497
+ 0.929 0.258 0.936 0.253 0.943 0.124 0.950 0.180 0.959 0.051 0.971 0.099 0.974 0.061
+ 0.980 0.089 0.988 0.032 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.341 0.025 0.368 0.045 0.434 0.059 0.482 0.073 0.482 0.086 0.465 0.101 0.434
+ 0.127 0.416 0.150 0.392 0.181 0.341 0.205 0.319 0.232 0.339 0.268 0.407 0.289 0.458
+ 0.311 0.500 0.324 0.509 0.390 0.518 0.408 0.590 0.444 0.487 0.455 0.247 0.470 0.253
+ 0.479 0.289 0.485 0.394 0.495 0.421 0.502 0.370 0.507 0.304 0.515 0.286 0.522 0.304
+ 0.523 0.438 0.529 0.454 0.538 0.441 0.546 0.319 0.552 0.295 0.559 0.326 0.562 0.425
+ 0.567 0.452 0.574 0.427 0.582 0.357 0.592 0.324 0.600 0.344 0.602 0.416 0.608 0.445
+ 0.616 0.447 0.625 0.339 0.634 0.322 0.642 0.337 0.643 0.394 0.645 0.454 0.654 0.452
+ 0.664 0.357 0.674 0.335 0.683 0.339 0.685 0.427 0.692 0.458 0.698 0.430 0.704 0.352
+ 0.714 0.337 0.721 0.346 0.727 0.436 0.731 0.456 0.737 0.434 0.742 0.374 0.756 0.346
+ 0.767 0.355 0.773 0.443 0.780 0.460 0.786 0.438 0.791 0.385 0.799 0.348 0.810 0.366
+ 0.815 0.421 0.821 0.434 0.824 0.419 0.831 0.372 0.841 0.359 0.851 0.357 0.854 0.388
+ 0.856 0.515 0.864 0.568 0.871 0.555 0.883 0.436 0.914 0.421 0.930 0.385 1.000 0.368)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .02 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (yellow-bellied-flycatcher 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Black-throated blue warbler
@@ -8940,28 +8933,23 @@
(define (black-throated-blue-warbler beg1 amp1)
;; east 15 9.8
- (definstrument (black-throated-blue-warbler-1 beg dur amp ampf frq frqf ind)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env ampf :duration dur :scaler amp))
- (frqf (make-env frqf :duration dur :scaler (hz->radians frq)))
- (gen1 (make-polywave :partials (list 1 .99 2 .008 3 .003)))
- (speed 200)
- (vib (make-oscil speed))
- (vib-index (hz->radians ind))
- (vibf (make-env '(0 1 .8 1 .9 0 1 0) :duration dur))
- (rnd (make-rand-interp 800))
- (trem (make-oscil (* 2 speed))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((vb (oscil vib))
- (vbf (env vibf))
- (noise (rand-interp rnd)))
- (outa i (* (env ampf)
- (+ .25 (* .45 (abs (+ noise (* .7 (oscil trem))))))
- (polywave gen1 (+ (env frqf)
- (* vib-index vbf vb))))))))))
+ (defanimal (black-throated-blue-warbler-1 beg dur amp ampf frq frqf ind)
+ (let ((speed 200))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env ampf :duration dur :scaler amp))
+ (frqf1 (make-env frqf :duration dur :scaler (hz->radians frq)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .008 3 .003)))
+ (vib (make-oscil speed))
+ (vibf (make-env '(0 1 .8 1 .9 0 1 0) :duration dur :scaler (hz->radians ind)))
+ (rnd (make-rand-interp 800))
+ (trem (make-oscil (* 2 speed))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .25 (* .45 (abs (+ (rand-interp rnd) (* .7 (oscil trem))))))
+ (polywave gen1 (+ (env frqf1)
+ (* (env vibf) (oscil vib))))))))))
(let ((main-ampf '(0.000 0.000 0.321 0.215 0.679 0.569 0.826 0.992 0.874 1.000 1.000 0.000))
(main-frqf '(0.000 0.228 0.795 0.210 0.816 0.235 0.827 0.199 0.846 0.217 0.882 0.181 1.000 0.206))
@@ -8992,134 +8980,135 @@
;; (with-sound (:play #t) (black-throated-blue-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Great crested flycatcher
-(definstrument (great-crested-flycatcher beg amp)
+(defanimal (great-crested-flycatcher beg amp)
;; east 46 6
- (let* ((start (seconds->samples beg))
- (dur 0.318)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.122 0.198 0.136 0.168 0.165 0.235 0.184 0.411 0.191 0.373 0.212 0.542
- 0.224 0.499 0.242 0.715 0.288 0.617 0.294 0.559 0.307 0.644 0.338 0.491 0.348 0.586
- 0.357 0.576 0.368 0.491 0.373 0.539 0.392 0.536 0.427 0.656 0.446 0.642 0.528 0.795
- 0.556 0.636 0.566 0.997 0.582 0.100 0.590 0.384 0.597 0.097 0.601 0.213 0.607 0.120
- 0.614 0.586 0.653 0.334 0.658 0.225 0.676 0.639 0.703 0.195 0.711 0.363 0.733 0.358
- 0.746 0.280 0.771 0.551 0.793 0.226 0.840 0.258 0.922 0.183 0.973 0.150 1.000 0.000)
- :duration dur :scaler amp))
-
- (frqf1 (make-env '(0.000 0.226 0.033 0.284 0.076 0.324 0.128 0.376 0.200 0.423 0.254 0.439 0.314 0.441
- 0.391 0.438 0.488 0.432 0.533 0.436 0.559 0.445 0.566 0.486 0.586 0.660 0.606 0.656
- 0.612 0.544 0.627 0.535 0.643 0.546 0.689 0.535 0.708 0.523 0.718 0.546 0.735 0.528
- 0.740 0.501 1.000 0.416)
- :duration dur :scaler (hz->radians 7090.0)))
- (ampf1 (make-env '(0 1 .6 1 .65 .1 .7 .5 .75 0 1 0) :duration dur))
- (gen1 (make-polywave :partials (list 1 .92 2 .05 3 .01 4 .005 6 .005)))
-
- (frqf2 (make-env '(0.000 0.407 0.256 0.439 0.492 0.434 0.566 0.447 0.595 0.430 0.609 0.309 0.626 0.266
- 0.646 0.297 0.661 0.396 0.673 0.430 0.681 0.474 0.695 0.412 0.702 0.325 0.719 0.320
- 0.736 0.335 0.762 0.409 0.774 0.445 0.786 0.414 0.791 0.335 0.806 0.311 0.824 0.329
- 0.839 0.376 0.856 0.349 0.876 0.324 0.916 0.324 0.951 0.293 1.000 0.25)
- :duration dur :scaler (hz->radians 7090.0)))
- (ampf2 (make-env '(0 0 .5 0 .55 .2 .7 1 1 .5) :duration dur))
- (gen2 (make-polywave :partials (list 1 .95 2 .01 3 .01 4 .01 5 .005 6 .01)))
- (rnd (make-rand-interp 100 .7)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (polywave gen1 (env frqf1)))
- (* (env ampf2)
- (+ .3 (abs (rand-interp rnd)))
- (polywave gen2 (env frqf2))))))))))
+ (let ((dur 0.318))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.122 0.198 0.136 0.168 0.165 0.235 0.184 0.411 0.191 0.373 0.212 0.542
+ 0.224 0.499 0.242 0.715 0.288 0.617 0.294 0.559 0.307 0.644 0.338 0.491 0.348 0.586
+ 0.357 0.576 0.368 0.491 0.373 0.539 0.392 0.536 0.427 0.656 0.446 0.642 0.528 0.795
+ 0.556 0.636 0.566 0.997 0.582 0.100 0.590 0.384 0.597 0.097 0.601 0.213 0.607 0.120
+ 0.614 0.586 0.653 0.334 0.658 0.225 0.676 0.639 0.703 0.195 0.711 0.363 0.733 0.358
+ 0.746 0.280 0.771 0.551 0.793 0.226 0.840 0.258 0.922 0.183 0.973 0.150 1.000 0.000)
+ :duration dur :scaler amp))
+
+ (frqf1 (make-env '(0.000 0.226 0.033 0.284 0.076 0.324 0.128 0.376 0.200 0.423 0.254 0.439 0.314 0.441
+ 0.391 0.438 0.488 0.432 0.533 0.436 0.559 0.445 0.566 0.486 0.586 0.660 0.606 0.656
+ 0.612 0.544 0.627 0.535 0.643 0.546 0.689 0.535 0.708 0.523 0.718 0.546 0.735 0.528
+ 0.740 0.501 1.000 0.416)
+ :duration dur :scaler (hz->radians 7090.0)))
+ (ampf1 (make-env '(0 1 .6 1 .65 .1 .7 .5 .75 0 1 0) :duration dur))
+ (gen1 (make-polywave 0.0 '(1 .92 2 .05 3 .01 4 .005 6 .005)))
+
+ (frqf2 (make-env '(0.000 0.407 0.256 0.439 0.492 0.434 0.566 0.447 0.595 0.430 0.609 0.309 0.626 0.266
+ 0.646 0.297 0.661 0.396 0.673 0.430 0.681 0.474 0.695 0.412 0.702 0.325 0.719 0.320
+ 0.736 0.335 0.762 0.409 0.774 0.445 0.786 0.414 0.791 0.335 0.806 0.311 0.824 0.329
+ 0.839 0.376 0.856 0.349 0.876 0.324 0.916 0.324 0.951 0.293 1.000 0.25)
+ :duration dur :scaler (hz->radians 7090.0)))
+ (ampf2 (make-env '(0 0 .5 0 .55 .2 .7 1 1 .5) :duration dur))
+ (gen2 (make-polywave 0.0 '(1 .95 2 .01 3 .01 4 .01 5 .005 6 .01)))
+ (rnd (make-rand-interp 100 .7)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (polywave gen1 (env frqf1)))
+ (* (env ampf2)
+ (+ .3 (abs (rand-interp rnd)))
+ (polywave gen2 (env frqf2))))))))))
;; (with-sound (:play #t) (great-crested-flycatcher 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; House sparrow
-(definstrument (house-sparrow-1 beg amp)
+(defanimal (house-sparrow-1 beg amp)
;; east 99 2.9
- (let* ((start (seconds->samples beg))
- (dur 0.144)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.073 0.108 0.086 0.220 0.182 0.225 0.190 0.281 0.200 0.151 0.240 0.529
- 0.254 0.436 0.259 0.558 0.266 0.536 0.284 0.856 0.299 0.461 0.311 0.888 0.330 0.281
- 0.339 0.612 0.344 0.559 0.355 0.178 0.376 0.575 0.380 0.407 0.389 0.919 0.394 0.686
- 0.399 0.836 0.407 0.547 0.412 0.976 0.422 0.176 0.426 0.476 0.442 0.942 0.461 0.347
- 0.475 0.281 0.485 0.069 0.488 0.222 0.499 0.200 0.505 0.259 0.527 0.422 0.559 0.583
- 0.576 0.324 0.599 0.578 0.611 0.556 0.626 0.268 0.640 0.525 0.652 0.471 0.657 0.237
- 0.685 0.556 0.703 0.449 0.714 0.175 0.756 0.308 0.803 0.229 0.926 0.112 0.963 0.056
- 0.972 0.093 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.217 0.130 0.236 0.169 0.261 0.196 0.321 0.238 0.414 0.260 0.445 0.286 0.462
- 0.302 0.451 0.316 0.472 0.329 0.458 0.346 0.507 0.361 0.530 0.383 0.501 0.408 0.400
- 0.427 0.420 0.451 0.395 0.465 0.333 0.485 0.275 0.503 0.290 0.518 0.321 0.563 0.373
- 0.622 0.441 0.643 0.387 0.664 0.325 0.684 0.360 0.700 0.358 0.713 0.282 0.734 0.267
- 0.746 0.288 0.769 0.325 0.799 0.290 0.833 0.321 0.859 0.292 0.888 0.304 0.913 0.265
- 0.944 0.265 0.964 0.226 0.984 0.209 1.000 0.224)
- :duration dur :scaler (hz->radians 10550.0)))
- (rnd (make-rand-interp 4000 (hz->radians 300)))
- (rnd1 (make-rand-interp 4000))
- (rndf1 (make-env '(0 1 .15 1 .2 0 .75 0 .8 1 1 1) :duration dur :scaler .75))
- (gen1 (make-oscil))
- (ampf1 (make-env '(0 0 .15 0 .2 1 .9 1 1 .2) :duration dur))
- (gen2 (make-oscil))
- (ampf2 (make-env '(0 .5 .15 .5 .2 .05 1 .01) :duration dur))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 .5 .15 .5 .2 .005 1 .005) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((rf (env rndf1))
- (frq (+ (env frqf)
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (+ (- 1.0 rf)
- (* rf (abs (rand-interp rnd1))))
- (+ (* (env ampf1) (oscil gen1 frq))
- (* (env ampf2) (oscil gen2 (* 2 frq)))
- (* (env ampf3) (oscil gen3 (* 3 frq)))))))))))
+ (let ((dur 0.144))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.073 0.108 0.086 0.220 0.182 0.225 0.190 0.281 0.200 0.151 0.240 0.529
+ 0.254 0.436 0.259 0.558 0.266 0.536 0.284 0.856 0.299 0.461 0.311 0.888 0.330 0.281
+ 0.339 0.612 0.344 0.559 0.355 0.178 0.376 0.575 0.380 0.407 0.389 0.919 0.394 0.686
+ 0.399 0.836 0.407 0.547 0.412 0.976 0.422 0.176 0.426 0.476 0.442 0.942 0.461 0.347
+ 0.475 0.281 0.485 0.069 0.488 0.222 0.499 0.200 0.505 0.259 0.527 0.422 0.559 0.583
+ 0.576 0.324 0.599 0.578 0.611 0.556 0.626 0.268 0.640 0.525 0.652 0.471 0.657 0.237
+ 0.685 0.556 0.703 0.449 0.714 0.175 0.756 0.308 0.803 0.229 0.926 0.112 0.963 0.056
+ 0.972 0.093 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.217 0.130 0.236 0.169 0.261 0.196 0.321 0.238 0.414 0.260 0.445 0.286 0.462
+ 0.302 0.451 0.316 0.472 0.329 0.458 0.346 0.507 0.361 0.530 0.383 0.501 0.408 0.400
+ 0.427 0.420 0.451 0.395 0.465 0.333 0.485 0.275 0.503 0.290 0.518 0.321 0.563 0.373
+ 0.622 0.441 0.643 0.387 0.664 0.325 0.684 0.360 0.700 0.358 0.713 0.282 0.734 0.267
+ 0.746 0.288 0.769 0.325 0.799 0.290 0.833 0.321 0.859 0.292 0.888 0.304 0.913 0.265
+ 0.944 0.265 0.964 0.226 0.984 0.209 1.000 0.224)
+ :duration dur :scaler (hz->radians 10550.0)))
+ (rnd (make-rand-interp 4000 (hz->radians 300)))
+ (rnd1 (make-rand-interp 4000))
+ (rndf1 (make-env '(0 1 .15 1 .2 0 .75 0 .8 1 1 1) :duration dur :scaler .75))
+ (gen1 (make-oscil))
+ (ampf1 (make-env '(0 0 .15 0 .2 1 .9 1 1 .2) :duration dur))
+ (gen2 (make-oscil))
+ (ampf2 (make-env '(0 .5 .15 .5 .2 .05 1 .01) :duration dur))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 .5 .15 .5 .2 .005 1 .005) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((rf (env rndf1))
+ (frq (+ (env frqf)
+ (rand-interp rnd))))
+ (outa i (* (env ampf)
+ (+ (- 1.0 rf)
+ (* rf (abs (rand-interp rnd1))))
+ (+ (* (env ampf1) (oscil gen1 frq))
+ (* (env ampf2) (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3) (oscil gen3 (* 3.0 frq)))))))))))
;; (with-sound (:play #t) (house-sparrow-1 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Gambel's quail
-(definstrument (gambels-quail beg amp)
+(defanimal (gambels-quail beg amp)
;; south 8 3
- (let* ((start (seconds->samples beg))
- (dur 0.56)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.105 0.364 0.146 0.379 0.231 0.694 0.471 0.838 0.567 0.785 0.637 0.649
- 0.681 0.626 0.750 0.513 0.771 0.417 0.828 0.351 0.864 0.212 0.952 0.048 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.080 0.029 0.091 0.079 0.131 0.103 0.136 0.165 0.148 0.219 0.164 0.341 0.176
- 0.469 0.173 0.714 0.162 0.819 0.157 0.902 0.150 0.949 0.138 1.000 0.141)
- :duration dur :scaler (hz->radians (* 0.5 10950))))
- (gen1 (make-polywave :partials (normalize-partials (list 1 .21 2 .83 3 .05))))
- (gen2 (make-polywave :partials (normalize-partials (list 4 .03 5 .02 6 .12))))
- (gen3 (make-polywave :partials (normalize-partials (list 7 .01 8 .02 9 .007 10 .003))))
- (ampf2 (make-env '(0 0 .05 0 .1 .2 .15 0 .275 1 .6 1 .9 0 1 0) :duration dur :scaler .15))
- (ampf3 (make-env '(0 0 .18 0 .5 1 .7 1 .85 0 1 0) :duration dur :scaler .08)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (polywave gen1 frq)
- (* (env ampf2) (polywave gen2 frq))
- (* (env ampf3) (polywave gen3 frq))))))))))
+ (let ((dur 0.56))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.105 0.364 0.146 0.379 0.231 0.694 0.471 0.838 0.567 0.785 0.637 0.649
+ 0.681 0.626 0.750 0.513 0.771 0.417 0.828 0.351 0.864 0.212 0.952 0.048 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.080 0.029 0.091 0.079 0.131 0.103 0.136 0.165 0.148 0.219 0.164 0.341 0.176
+ 0.469 0.173 0.714 0.162 0.819 0.157 0.902 0.150 0.949 0.138 1.000 0.141)
+ :duration dur :scaler (hz->radians (* 0.5 10950))))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 .21 2 .83 3 .05))))
+ (gen2 (make-polywave 0.0 (normalize-partials '(4 .03 5 .02 6 .12))))
+ (gen3 (make-polywave 0.0 (normalize-partials '(7 .01 8 .02 9 .007 10 .003))))
+ (ampf2 (make-env '(0 0 .05 0 .1 .2 .15 0 .275 1 .6 1 .9 0 1 0) :duration dur :scaler .15))
+ (ampf3 (make-env '(0 0 .18 0 .5 1 .7 1 .85 0 1 0) :duration dur :scaler .08)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2) (polywave gen2 frq))
+ (* (env ampf3) (polywave gen3 frq))))))))))
;; (with-sound (:play #t) (gambels-quail 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Scaled quail
@@ -9127,56 +9116,55 @@
(define (scaled-quail beg1 amp1)
;; south 7 7
- (definstrument (scaled-quail-1 beg dur amp frqscl frm1frq frm2frq frmamp vibamp vibf amp4 amp5)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.026 0.166 0.052 0.609 0.058 0.250 0.066 0.892 0.070 0.465 0.073 0.909
- 0.079 0.255 0.088 0.766 0.091 0.350 0.096 0.607 0.105 0.504 0.106 0.932 0.119 0.296
- 0.126 0.978 0.129 0.540 0.134 0.609 0.136 0.347 0.140 0.425 0.142 0.274 0.148 0.998
- 0.154 0.393 0.156 0.816 0.161 0.266 0.166 0.614 0.170 0.810 0.174 0.482 0.177 0.773
- 0.184 0.305 0.192 0.937 0.198 0.296 0.199 0.596 0.203 0.350 0.207 0.738 0.212 0.399
- 0.213 0.602 0.222 0.650 0.228 0.464 0.238 0.526 0.246 0.266 0.259 0.403 0.283 0.320
- 0.323 0.365 0.388 0.249 0.405 0.196 0.432 0.191 0.496 0.135 0.582 0.120 0.621 0.071 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.157 0.051 0.204 0.075 0.267 0.142 0.281 0.196 0.267 0.268 0.191 0.353 0.171 1.000 0.175)
- :duration dur :scaler (hz->radians frqscl)))
- (gen1 (make-oscil))
- (gen2 (make-polywave :partials (normalize-partials (list 2 .3 3 .7))))
- (gen6 (make-polywave :partials (normalize-partials (list 4 .1 5 .05 6 .02))))
- (gen3 (make-polywave :partials (normalize-partials (list 9 .12 10 .02 11 .003 12 .006 15 .005 16 .004))))
- (gen4 (make-oscil))
- (gen5 (make-oscil))
- (ampf1 (make-env '(0 1 .6 1 .9 0 1 0) :duration dur :scaler .1))
- (ampf3 (make-env '(0 0 .1 .2 .4 1 .5 1 .8 0 1 0) :duration dur :scaler .3))
- (ampf4 (make-env amp4 :duration dur :scaler .25))
- (ampf5 (make-env amp5 :duration dur :scaler .125))
- (ampf6 (make-env '(0 0 .3 0 .4 1 1 0) :duration dur :scaler .5))
- (vib (make-oscil 1000))
- (vibf (make-env vibf :duration dur :scaler (hz->radians 200)))
- (rnd (make-rand-interp 10000 vibamp))
- (frm1 (make-formant frm1frq .97))
- (frm2 (make-formant frm2frq .95))
- (fr1 (* 2 5 (sin (hz->radians frm1frq))))
- (fr2 (* 2 4 (sin (hz->radians frm2frq))))
- (frmf (make-env frmamp :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* (env vibf)
+ (defanimal (scaled-quail-1 beg dur amp frqscl frm1frq frm2frq frmamp vibamp vibf amp4 amp5)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.026 0.166 0.052 0.609 0.058 0.250 0.066 0.892 0.070 0.465 0.073 0.909
+ 0.079 0.255 0.088 0.766 0.091 0.350 0.096 0.607 0.105 0.504 0.106 0.932 0.119 0.296
+ 0.126 0.978 0.129 0.540 0.134 0.609 0.136 0.347 0.140 0.425 0.142 0.274 0.148 0.998
+ 0.154 0.393 0.156 0.816 0.161 0.266 0.166 0.614 0.170 0.810 0.174 0.482 0.177 0.773
+ 0.184 0.305 0.192 0.937 0.198 0.296 0.199 0.596 0.203 0.350 0.207 0.738 0.212 0.399
+ 0.213 0.602 0.222 0.650 0.228 0.464 0.238 0.526 0.246 0.266 0.259 0.403 0.283 0.320
+ 0.323 0.365 0.388 0.249 0.405 0.196 0.432 0.191 0.496 0.135 0.582 0.120 0.621 0.071 1.000 0.000)
+ :duration dur :scaler (* 0.3 amp)))
+ (frqf (make-env '(0.000 0.157 0.051 0.204 0.075 0.267 0.142 0.281 0.196 0.267 0.268 0.191 0.353 0.171 1.000 0.175)
+ :duration dur :scaler (hz->radians frqscl)))
+ (gen1 (make-polywave 0.0 :partials '(1 2)))
+ (gen2 (make-polywave 0.0 (list 2 (* 2 .3) 3 (* 2 .7))))
+ (gen6 (make-polywave 0.0 (normalize-partials '(4 .1 5 .05 6 .02))))
+ (gen3 (make-polywave 0.0 (normalize-partials '(9 .12 10 .02 11 .003 12 .006 15 .005 16 .004))))
+ (gen4 (make-oscil))
+ (gen5 (make-oscil))
+ (ampf1 (make-env '(0 1 .6 1 .9 0 1 0) :duration dur :scaler .1))
+ (ampf3 (make-env '(0 0 .1 .2 .4 1 .5 1 .8 0 1 0) :duration dur :scaler .3))
+ (ampf4 (make-env amp4 :duration dur :scaler .25))
+ (ampf5 (make-env amp5 :duration dur :scaler .125))
+ (ampf6 (make-env '(0 0 .3 0 .4 1 1 0) :duration dur :scaler .5))
+ (vib (make-oscil 1000))
+ (vibf1 (make-env vibf :duration dur :scaler (hz->radians 200)))
+ (rnd (make-rand-interp 10000 vibamp))
+ (frm1 (make-formant frm1frq .97))
+ (frm2 (make-formant frm2frq .95))
+ (fr1 (* 2 5 (sin (hz->radians frm1frq))))
+ (fr2 (* 2 4 (sin (hz->radians frm2frq))))
+ (frmf (make-env frmamp :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let* ((frq (+ (env frqf)
+ (* (env vibf1)
(+ (oscil vib)
(rand-interp rnd)))))
- (frm (env frmf)))
- (let ((val (* 0.3 (env ampf)
- (+ (* 2 (env ampf1) (oscil gen1 frq))
- (* (env ampf4) (oscil gen4 (* frq 5)))
- (* (env ampf5) (oscil gen5 (* frq 6)))
- (* 2 (polywave gen2 frq))
- (* (env ampf3) (polywave gen3 frq))
- (* (env ampf6) (polywave gen6 frq))))))
- (outa i (+ (* frm (+ (* fr1 (formant frm1 val))
- (* fr2 (formant frm2 val))))
- (* (- 1.0 frm) val)))))))))
+ (frm (env frmf))
+ (val (* (env ampf)
+ (+ (* (env ampf1) (polywave gen1 frq))
+ (* (env ampf4) (oscil gen4 (* frq 5)))
+ (* (env ampf5) (oscil gen5 (* frq 6)))
+ (+ (polywave gen2 frq)
+ (* (env ampf3) (polywave gen3 frq))
+ (* (env ampf6) (polywave gen6 frq)))))))
+ (outa i (+ (* frm (+ (* fr1 (formant frm1 val))
+ (* fr2 (formant frm2 val))))
+ (* (- 1.0 frm) val)))))))
(scaled-quail-1 beg1 .18 amp1 4200
2300 6400 '(0 0 .1 1 .45 1 .5 0 .7 0 .8 1 1 1)
@@ -9193,249 +9181,250 @@
;; (with-sound (:play #t) (scaled-quail 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Montezuma quail
-(definstrument (montezuma-quail beg amp)
+(defanimal (montezuma-quail beg amp)
;; south 9 15
- (let* ((start (seconds->samples beg))
- (dur 1.3)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.022 0.069 0.036 0.196 0.088 0.615 0.138 0.837 0.168 0.873 0.202 0.837
- 0.217 0.743 0.225 0.850 0.242 0.962 0.255 0.839 0.270 0.914 0.309 0.916 0.322 0.796
- 0.365 0.831 0.407 0.941 0.432 0.975 0.442 0.885 0.461 0.919 0.480 0.850 0.494 0.651
- 0.504 0.903 0.527 0.773 0.546 0.870 0.585 0.813 0.604 0.880 0.630 0.836 0.642 0.789
- 0.662 0.898 0.689 0.817 0.779 0.656 0.834 0.668 0.895 0.449 0.927 0.372 0.950 0.350
- 0.965 0.229 0.981 0.253 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.284 0.052 0.254 0.128 0.239 0.256 0.229 0.404 0.219 0.580 0.211 0.707 0.206 1.000 0.216)
- :duration dur :scaler (hz->radians 8700.0)))
- (gen1 (make-polywave :partials (list 1 .91 2 .008 3 .07 4 .003)))
- (vib (make-oscil 50))
- (vibf (make-env '(0 .1 .4 .6 .9 1 1 .4) :duration dur :scaler (hz->radians 100)))
- (vibr (make-rand-interp 200 .5))
- (rnd (make-rand-interp 240 .5)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (+ .5 (abs (rand-interp rnd)))
- (polywave gen1 (+ (env frqf)
- (* (env vibf) (+ (oscil vib)
- (rand-interp vibr)))))))))))
+ (let ((dur 1.3))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.022 0.069 0.036 0.196 0.088 0.615 0.138 0.837 0.168 0.873 0.202 0.837
+ 0.217 0.743 0.225 0.850 0.242 0.962 0.255 0.839 0.270 0.914 0.309 0.916 0.322 0.796
+ 0.365 0.831 0.407 0.941 0.432 0.975 0.442 0.885 0.461 0.919 0.480 0.850 0.494 0.651
+ 0.504 0.903 0.527 0.773 0.546 0.870 0.585 0.813 0.604 0.880 0.630 0.836 0.642 0.789
+ 0.662 0.898 0.689 0.817 0.779 0.656 0.834 0.668 0.895 0.449 0.927 0.372 0.950 0.350
+ 0.965 0.229 0.981 0.253 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.284 0.052 0.254 0.128 0.239 0.256 0.229 0.404 0.219 0.580 0.211 0.707 0.206 1.000 0.216)
+ :duration dur :scaler (hz->radians 8700.0)))
+ (gen1 (make-polywave 0.0 '(1 .91 2 .008 3 .07 4 .003)))
+ (vib (make-oscil 50))
+ (vibf (make-env '(0 .1 .4 .6 .9 1 1 .4) :duration dur :scaler (hz->radians 100)))
+ (vibr (make-rand-interp 200 .5))
+ (rnd (make-rand-interp 240 .5)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (+ .5 (abs (rand-interp rnd)))
+ (polywave gen1 (+ (env frqf)
+ (* (env vibf) (+ (oscil vib)
+ (rand-interp vibr)))))))))))
;; (with-sound (:play #t) (montezuma-quail 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Mountain quail
-(definstrument (mountain-quail beg amp)
- (let* ((start (seconds->samples beg))
- (dur .2)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.152 0.128 0.179 0.040 0.219 0.173 0.271 0.864 0.289 0.754 0.300 0.666
- 0.316 0.804 0.339 0.666 0.362 0.628 0.402 0.477 0.493 0.653 0.513 0.721 0.573 0.736
- 0.599 0.626 0.666 0.804 0.741 0.887 0.786 0.977 0.818 0.814 0.837 0.807 0.872 0.889
- 0.899 0.761 0.920 0.588 0.932 0.656 0.956 0.427 0.970 0.176 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.103 0.036 0.108 0.151 0.103 0.175 0.156 0.219 0.160 0.261 0.162 0.322 0.144
- 0.397 0.149 0.894 0.146 0.945 0.130 1.000 0.121)
- :duration dur :scaler (hz->radians 10000.0)))
- (gen1 (make-oscil))
- (ampf2 (make-env '(0 0 .1 0 .2 1 1 1) :duration dur))
- (gen2 (make-polywave :partials (list 2 .01 3 .005 4 .04 5 .003)))
- (rnd (make-rand-interp 4000 (hz->radians 500)))
- (rndf (make-env '(0 1 .2 .1 .9 .1 1 1) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* (env rndf) (rand-interp rnd)))))
- (outa i (* (env ampf)
- (+ (oscil gen1 frq)
- (* (env ampf2) (polywave gen2 frq))))))))))
+(defanimal (mountain-quail beg amp)
+ (let ((dur .2))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.152 0.128 0.179 0.040 0.219 0.173 0.271 0.864 0.289 0.754 0.300 0.666
+ 0.316 0.804 0.339 0.666 0.362 0.628 0.402 0.477 0.493 0.653 0.513 0.721 0.573 0.736
+ 0.599 0.626 0.666 0.804 0.741 0.887 0.786 0.977 0.818 0.814 0.837 0.807 0.872 0.889
+ 0.899 0.761 0.920 0.588 0.932 0.656 0.956 0.427 0.970 0.176 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.103 0.036 0.108 0.151 0.103 0.175 0.156 0.219 0.160 0.261 0.162 0.322 0.144
+ 0.397 0.149 0.894 0.146 0.945 0.130 1.000 0.121)
+ :duration dur :scaler (hz->radians 10000.0)))
+ (gen1 (make-oscil))
+ (ampf2 (make-env '(0 0 .1 0 .2 1 1 1) :duration dur))
+ (gen2 (make-polywave 0.0 '(2 .01 3 .005 4 .04 5 .003)))
+ (rnd (make-rand-interp 4000 (hz->radians 500)))
+ (rndf (make-env '(0 1 .2 .1 .9 .1 1 1) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env rndf) (rand-interp rnd)))))
+ (outa i (* (env ampf)
+ (+ (oscil gen1 frq)
+ (* (env ampf2) (polywave gen2 frq))))))))))
;; (with-sound (:play #t) (mountain-quail 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Verdin
-(definstrument (verdin beg amp)
+(defanimal (verdin beg amp)
;; south 57 18
- (let* ((begs (vct 0.0 0.28 0.57))
- (durs (vct 0.12 0.15 0.15))
- (amps (vct 0.25 0.75 1.0))
- (frqs (vector (list 0.000 0.162 0.246 0.168 0.505 0.168 0.867 0.183 0.956 0.198 1.000 0.192)
- (list 0.000 0.162 0.246 0.168 0.867 0.183 0.897 0.186 0.926 0.204 1.000 0.192)
- (list 0.000 0.189 0.039 0.168 0.246 0.168 1.000 0.192)))
- (gen1 (make-polywave :partials (list 1 .98 2 .015 3 .005))))
- (do ((call 0 (+ 1 call)))
+ (let ((begs (vector 0.0 0.28 0.57))
+ (durs (vector 0.12 0.15 0.15))
+ (amps (vector 0.25 0.75 1.0))
+ (frqs (vector '(0.000 0.162 0.246 0.168 0.505 0.168 0.867 0.183 0.956 0.198 1.000 0.192)
+ '(0.000 0.162 0.246 0.168 0.867 0.183 0.897 0.186 0.926 0.204 1.000 0.192)
+ '(0.000 0.189 0.039 0.168 0.246 0.168 1.000 0.192)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .015 3 .005))))
+ (do ((call 0 (+ call 1)))
((= call 3))
- (let* ((start (seconds->samples (+ beg (begs call))))
- (dur (durs call))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.016 0.207 0.079 0.402 0.131 0.348 0.224 0.562 0.255 0.592 0.316 0.757
- 0.367 0.637 0.407 0.664 0.428 0.613 0.474 0.751 0.495 0.757 0.522 0.898 0.609 1.000
- 0.701 0.778 0.738 0.967 0.770 0.892 0.797 0.898 0.819 0.790 0.835 0.931 0.852 0.892
- 0.874 0.997 0.903 0.775 0.928 0.718 0.957 0.736 1.000 0.000)
- :duration dur :scaler (* amp (amps call))))
- (frqf (make-env (frqs call) :duration dur :scaler (hz->radians 22000.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))))
+ (let ((start (seconds->samples (+ beg (begs call))))
+ (dur (durs call)))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.016 0.207 0.079 0.402 0.131 0.348 0.224 0.562 0.255 0.592 0.316 0.757
+ 0.367 0.637 0.407 0.664 0.428 0.613 0.474 0.751 0.495 0.757 0.522 0.898 0.609 1.000
+ 0.701 0.778 0.738 0.967 0.770 0.892 0.797 0.898 0.819 0.790 0.835 0.931 0.852 0.892
+ 0.874 0.997 0.903 0.775 0.928 0.718 0.957 0.736 1.000 0.000)
+ :duration dur :scaler (* amp (amps call))))
+ (frqf (make-env (frqs call) :duration dur :scaler (hz->radians 22000.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))))
;; (with-sound (:play #t) (verdin 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; White-tipped dove
-(definstrument (white-tipped-dove beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.7)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.097 0.071 0.140 0.147 0.190 0.000 0.328 0.000 0.405 0.652 0.426 0.596
- 0.447 0.136 0.465 0.109 0.473 0.000 0.511 0.000 0.555 0.354 0.625 0.578 0.672 0.820
- 0.745 1.000 0.782 0.897 0.874 0.755 0.930 0.614 0.975 0.139 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.172 0.137 0.170 0.175 0.165 0.340 0.172 0.451 0.160 0.544 0.165 .6 .160 1.000 0.170)
- :duration dur :scaler (hz->radians 2550.0)))
- (gen1 (make-polywave :partials (list 1 .94 2 .02 3 .05 4 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+(defanimal (white-tipped-dove beg amp)
+ (let ((dur 1.7))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.097 0.071 0.140 0.147 0.190 0.000 0.328 0.000 0.405 0.652 0.426 0.596
+ 0.447 0.136 0.465 0.109 0.473 0.000 0.511 0.000 0.555 0.354 0.625 0.578 0.672 0.820
+ 0.745 1.000 0.782 0.897 0.874 0.755 0.930 0.614 0.975 0.139 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.172 0.137 0.170 0.175 0.165 0.340 0.172 0.451 0.160 0.544 0.165 .6 .160 1.000 0.170)
+ :duration dur :scaler (hz->radians 2550.0)))
+ (gen1 (make-polywave 0.0 '(1 .94 2 .02 3 .05 4 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (white-tipped-dove 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Zone-tailed hawk
-(definstrument (zone-tailed-hawk beg amp)
- (let* ((start (seconds->samples beg))
- (dur 1.82)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.014 0.170 0.019 0.000 0.046 0.074 0.054 0.327 0.090 0.448 0.106 0.781
- 0.130 0.852 0.139 1.000 0.174 1.000 0.359 0.691 0.383 0.435 0.427 0.494 0.545 0.448
- 0.654 0.463 0.704 0.485 0.741 0.330 0.752 0.407 0.785 0.435 0.792 0.238 0.793 0.528
- 0.825 0.528 0.838 0.475 0.846 0.225 0.850 0.509 0.872 0.485 0.892 0.367 0.913 0.497
- 0.949 0.500 0.978 0.537 0.988 0.099 1.000 0.000)
- :duration dur :scaler (* 0.8 amp)))
- (frqf (make-env '(0.000 0.283 0.026 0.321 0.048 0.368 0.051 0.404 0.055 0.330 0.064 0.357 0.076 0.357
- 0.097 0.387 0.108 0.427 0.184 0.438 0.356 0.452 0.371 0.431 0.380 0.408 0.460 0.401
- 0.510 0.390 0.555 0.397 0.589 0.386 0.615 0.388 0.667 0.376 0.718 0.382 0.783 0.365
- 0.807 0.348 0.841 0.333 0.875 0.314 0.905 0.314 0.925 0.340 0.957 0.344 0.972 0.325
- 0.983 0.302 1.000 0.237)
- :duration dur :scaler (hz->radians (* 0.5 8150.0))))
- (gen1 (make-polywave :partials (normalize-partials (list 1 .25 2 .25 3 .05 4 .2 5 .01 7 .003))))
- (gen2 (make-oscil))
- (gen3 (make-polywave :partials (normalize-partials (list 3 .2 5 .1 7 .1 9 .05 11 .05 13 .01))))
-
- (ampf2 (make-env '(0 0 .05 0 .12 1 .18 1 .2 .6 .5 .8 .75 0 .8 .7 1 .7) :duration dur :scaler .5))
- (ampf3 (make-env '(0 0 .05 0 .12 1 .6 1 .75 0 1 0) :duration dur :scaler .3 :base 10))
-
- (rnd (make-rand-interp 3000))
- (rndf (make-env '(0 0 .12 .2 .25 1 .35 1 .4 .2 .75 .3 .9 .1 .93 .4 1 0) :duration dur :scaler (hz->radians 100)))
-
- (vib (make-triangle-wave 40 (hz->radians 20)))
- (vibf (make-env '(0 0 .15 0 .2 1 .4 0 1 0) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((noise (* (env rndf)
+(defanimal (zone-tailed-hawk beg amp)
+ (let ((dur 1.82))
+ (let ((start (seconds->samples beg))
+
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.014 0.170 0.019 0.000 0.046 0.074 0.054 0.327 0.090 0.448 0.106 0.781
+ 0.130 0.852 0.139 1.000 0.174 1.000 0.359 0.691 0.383 0.435 0.427 0.494 0.545 0.448
+ 0.654 0.463 0.704 0.485 0.741 0.330 0.752 0.407 0.785 0.435 0.792 0.238 0.793 0.528
+ 0.825 0.528 0.838 0.475 0.846 0.225 0.850 0.509 0.872 0.485 0.892 0.367 0.913 0.497
+ 0.949 0.500 0.978 0.537 0.988 0.099 1.000 0.000)
+ :duration dur :scaler (* 0.8 amp)))
+ (frqf (make-env '(0.000 0.283 0.026 0.321 0.048 0.368 0.051 0.404 0.055 0.330 0.064 0.357 0.076 0.357
+ 0.097 0.387 0.108 0.427 0.184 0.438 0.356 0.452 0.371 0.431 0.380 0.408 0.460 0.401
+ 0.510 0.390 0.555 0.397 0.589 0.386 0.615 0.388 0.667 0.376 0.718 0.382 0.783 0.365
+ 0.807 0.348 0.841 0.333 0.875 0.314 0.905 0.314 0.925 0.340 0.957 0.344 0.972 0.325
+ 0.983 0.302 1.000 0.237)
+ :duration dur :scaler (hz->radians (* 0.5 8150.0))))
+ (gen1 (make-polywave 0.0 (list 1 (* .5 0.328) 2 (* .5 0.328) 3 (* .5 0.066) 4 (* .5 0.262) 5 (* .5 0.013) 7 (* .5 0.004))))
+ (gen2 (make-oscil))
+ (gen3 (make-polywave 0.0 (normalize-partials '(3 .2 5 .1 7 .1 9 .05 11 .05 13 .01))))
+
+ (ampf2 (make-env '(0 0 .05 0 .12 1 .18 1 .2 .6 .5 .8 .75 0 .8 .7 1 .7) :duration dur :scaler .5))
+ (ampf3 (make-env '(0 0 .05 0 .12 1 .6 1 .75 0 1 0) :duration dur :scaler .3 :base 10))
+
+ (rnd (make-rand-interp 3000))
+ (rndf (make-env '(0 0 .12 .2 .25 1 .35 1 .4 .2 .75 .3 .9 .1 .93 .4 1 0) :duration dur :scaler (hz->radians 100)))
+
+ (vib (make-triangle-wave 40 (hz->radians 20)))
+ (vibf (make-env '(0 0 .15 0 .2 1 .4 0 1 0) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((noise (* (env rndf)
(rand-interp rnd)))
(frq (+ (env frqf)
(* (env vibf)
- (triangle-wave vib))))
- (frq1 (+ frq (* 1.5 noise)))
- (frq2 (+ (* 2 frq) (* 0.5 noise)))
- (frq3 (+ (* 0.5 frq) (* 2 noise))))
- (outa i (* (env ampf)
- (+ (* .5 (polywave gen1 frq1))
- (* (env ampf2) (oscil gen2 frq2))
- (* (env ampf3) (polywave gen3 frq3))))))))))
+ (triangle-wave vib)))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 (+ frq (* 1.5 noise)))
+ (* (env ampf2) (oscil gen2 (+ (* 2.0 frq) (* 0.5 noise))))
+ (* (env ampf3) (polywave gen3 (+ (* 0.5 frq) (* 2.0 noise))))))))))))
+
;; (with-sound (:play #t) (zone-tailed-hawk 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Red-eyed vireo
-(definstrument (red-eyed-vireo beg amp)
+(defanimal (red-eyed-vireo beg amp)
;; south 47 46
- (let* ((start (seconds->samples beg))
- (dur 0.29)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.033 0.082 0.069 0.415 0.081 0.426 0.102 0.204 0.119 0.156 0.137 0.307
- 0.146 0.159 0.156 0.378 0.182 0.685 0.188 0.556 0.205 0.735 0.212 0.479 0.223 0.484
- 0.236 0.939 0.243 0.344 0.246 0.825 0.254 0.415 0.258 0.611 0.273 0.587 0.279 0.251
- 0.290 0.992 0.297 0.865 0.304 0.937 0.314 0.735 0.324 0.770 0.340 0.365 0.352 0.590
- 0.367 0.230 0.387 0.000 0.495 0.000 0.510 0.331 0.535 0.339 0.560 0.249 0.572 0.116
- 0.592 0.146 0.604 0.275 0.628 0.410 0.634 0.339 0.668 0.619 0.684 0.220 0.709 0.656
- 0.731 0.593 0.761 0.598 0.770 0.534 0.783 0.720 0.797 0.632 0.809 0.479 0.819 0.288
- 0.833 0.444 0.849 0.423 0.857 0.325 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.375 0.022 0.420 0.044 0.492 0.067 0.531 0.079 0.506 0.095 0.352 0.105 0.336
- 0.121 0.359 0.147 0.417 0.163 0.462 0.178 0.520 0.188 0.590 0.197 0.662 0.209 0.685
- 0.225 0.669 0.245 0.625 0.266 0.606 0.283 0.576 0.329 0.406 0.342 0.387 0.371 0.338
- 0.484 0.289 0.505 0.340 0.529 0.347 0.541 0.368 0.558 0.268 0.572 0.245 0.589 0.259
- 0.607 0.305 0.642 0.368 0.672 0.396 0.704 0.420 0.752 0.431 0.775 0.452 0.795 0.527
- 0.815 0.534 0.824 0.492 0.835 0.387 0.861 0.336 0.891 0.305 0.946 0.298 1.000 0.240)
- :duration dur :scaler (hz->radians 8100.0)))
- (gen1 (make-polywave :partials (list 1 .985 2 .005 3 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.29))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.033 0.082 0.069 0.415 0.081 0.426 0.102 0.204 0.119 0.156 0.137 0.307
+ 0.146 0.159 0.156 0.378 0.182 0.685 0.188 0.556 0.205 0.735 0.212 0.479 0.223 0.484
+ 0.236 0.939 0.243 0.344 0.246 0.825 0.254 0.415 0.258 0.611 0.273 0.587 0.279 0.251
+ 0.290 0.992 0.297 0.865 0.304 0.937 0.314 0.735 0.324 0.770 0.340 0.365 0.352 0.590
+ 0.367 0.230 0.387 0.000 0.495 0.000 0.510 0.331 0.535 0.339 0.560 0.249 0.572 0.116
+ 0.592 0.146 0.604 0.275 0.628 0.410 0.634 0.339 0.668 0.619 0.684 0.220 0.709 0.656
+ 0.731 0.593 0.761 0.598 0.770 0.534 0.783 0.720 0.797 0.632 0.809 0.479 0.819 0.288
+ 0.833 0.444 0.849 0.423 0.857 0.325 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.375 0.022 0.420 0.044 0.492 0.067 0.531 0.079 0.506 0.095 0.352 0.105 0.336
+ 0.121 0.359 0.147 0.417 0.163 0.462 0.178 0.520 0.188 0.590 0.197 0.662 0.209 0.685
+ 0.225 0.669 0.245 0.625 0.266 0.606 0.283 0.576 0.329 0.406 0.342 0.387 0.371 0.338
+ 0.484 0.289 0.505 0.340 0.529 0.347 0.541 0.368 0.558 0.268 0.572 0.245 0.589 0.259
+ 0.607 0.305 0.642 0.368 0.672 0.396 0.704 0.420 0.752 0.431 0.775 0.452 0.795 0.527
+ 0.815 0.534 0.824 0.492 0.835 0.387 0.861 0.336 0.891 0.305 0.946 0.298 1.000 0.240)
+ :duration dur :scaler (hz->radians 8100.0)))
+ (gen1 (make-polywave 0.0 '(1 .985 2 .005 3 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (red-eyed-vireo 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Crested caracara
;;;
;;; not perfect... original seems to have a harder attack, slightly different timbre, etc
-(definstrument (crested-caracara beg amp)
+(defanimal (crested-caracara beg amp)
;; south 5 6.5
(do ((i 0 (+ i 1)))
((= i 17))
- (let* ((start (seconds->samples (+ beg (* i .04) (random .005))))
- (dur (+ 0.04 (random .005)))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.003 0.273 0.032 0.068 0.055 0.147 0.073 0.033 0.116 0.958 0.143 0.641
- 0.180 0.869 0.193 0.340 0.207 0.618 0.235 0.881 0.258 0.587 0.293 0.387 0.320 0.676
- 0.334 0.263 0.352 0.338 0.369 0.000 0.396 0.573 0.407 0.333 0.417 0.660 0.431 0.779
- 0.445 0.268 0.498 0.1 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave 1600 (normalize-partials (list 1 .4 2 .7 3 .01 4 .01 5 .01))))
- (gen2 (make-polywave 1200 (list 1 .4 2 1)))
- (index (hz->radians 800))
- (rnd (make-rand-interp 4000 .425)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (* index (+ (polywave gen2)
- (rand-interp rnd)))))))))))
+ (let ((start (seconds->samples (+ beg (* i .04) (random .005))))
+ (dur (+ 0.04 (random .005))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.003 0.273 0.032 0.068 0.055 0.147 0.073 0.033 0.116 0.958 0.143 0.641
+ 0.180 0.869 0.193 0.340 0.207 0.618 0.235 0.881 0.258 0.587 0.293 0.387 0.320 0.676
+ 0.334 0.263 0.352 0.338 0.369 0.000 0.396 0.573 0.407 0.333 0.417 0.660 0.431 0.779
+ 0.445 0.268 0.498 0.1 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 1600 (normalize-partials '(1 .4 2 .7 3 .01 4 .01 5 .01))))
+ (gen2 (make-polywave 1200 '(1 .4 2 1)))
+ (index (hz->radians 800))
+ (rnd (make-rand-interp 4000 .425)))
+ (do ((k start (+ k 1)))
+ ((= k stop))
+ (outa k (* (env ampf)
+ (polywave gen1 (* index (+ (polywave gen2)
+ (rand-interp rnd)))))))))))
+
;; (with-sound (:play #t) (crested-caracara 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Trumpeter swan
@@ -9447,141 +9436,131 @@
(define (trumpeter-swan-1 beg amp)
;; east 19 44
- (definstrument (trumpeter-swan-a beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.053)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.086 0.411 0.253 0.887 0.466 0.989 0.627 0.992 0.782 0.842 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave 356.0 (normalize-partials (list 1 .1 2 1.0 3 .08 4 .2 5 .1 6 .03 7 .03 8 .03))))
- (vib (make-oscil 130.0))
- (index (hz->radians 30)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (* index (oscil vib)))))))))
-
- (definstrument (trumpeter-swan-b beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.12)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.038 0.460 0.106 0.554 0.152 1.000 0.187 0.569 0.225 0.694 0.316 0.000
- 0.381 0.000 0.462 0.827 0.512 0.000 0.539 0.613 0.571 0.859 0.609 0.528 0.632 0.815
- 0.715 0.661 0.764 0.782 0.837 0.800 0.884 0.724 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.251 0.088 0.259 0.144 0.290 0.173 0.228 0.276 0.228 0.387 0.245 0.429 0.296
- 0.457 0.310 0.484 0.296 0.514 0.265 0.548 0.307 0.599 0.377 0.641 0.352 0.706 0.346
- 0.741 0.338 0.773 0.346 1.000 0.346)
- :duration dur :scaler (hz->radians (* 0.5 3140))))
- (gen2 (make-polywave :partials (normalize-partials (list 2 1.0 3 .25))))
- (gen2a (make-polywave :partials (normalize-partials (list 4 .35 5 .19 6 .12 7 .03 8 .02))))
- (ampf2a (make-env '(0 1 .6 1 1 0) :duration dur :scaler .4 :base 10))
- (gen3 (make-nrxysin :n 12 :r .85 :ratio 1/9))
- (ampf3 (make-env '(0 0 .1 0 .15 .5 .2 0 .4 0 .45 .7 .5 0 .55 1 .7 1 .8 0 .9 .1 1 0) :duration dur :scaler .02))
- (gen1 (make-oscil))
- (ampf1 (make-env '(0 0 .5 0 .6 1 .9 1 1 0) :duration dur :scaler .2)))
- (set! (mus-phase gen2) (* 0.5 pi))
- (set! (mus-phase gen2a) (* 0.5 pi))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* .6 (polywave gen2 frq))
- (* (env ampf2a)
- (polywave gen2a frq))
- (* (env ampf1)
- (oscil gen1 frq))
- (* (env ampf3)
- (nrxysin gen3 (* frq 9)))))))))))
-
- (definstrument (trumpeter-swan-c beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.11)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.029 0.244 0.084 0.525 0.111 0.515 0.124 0.376 0.153 0.334 0.183 0.166
- 0.205 0.000 0.240 0.769 0.261 0.775 0.280 0.271 0.297 0.000 0.338 0.773 0.423 1.000
- 0.529 0.758 0.621 0.845 0.783 0.630 0.849 0.676 0.896 0.538 0.930 0.252 0.957 0.118 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.085 0.189 0.079 0.222 0.113 0.251 0.123 0.278 0.105 0.312 0.121 0.349 0.125
- 0.377 0.133 0.412 0.127 0.510 0.123 0.691 0.129 0.778 0.125 0.830 0.127 1.000 0.129)
- :duration dur :scaler (hz->radians (* 0.5 8650.0))))
- (gen1 (make-polywave :partials (normalize-partials (list 1 .01 2 .98 3 .05 4 .02 5 .005 6 .005))))
- (gen2 (make-polywave :partials (normalize-partials (list 1 .44 2 1.0 3 .34 4 .31 5 .19 6 .075 7 .04 8 .03))))
- (gen3 (make-nrxysin :n 12 :r .85 :ratio 1/9))
- (intrpf (make-env '(0 1 .19 1 .2 0 1 0) :duration dur)))
- (set! (mus-phase gen2) (* 0.5 pi))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf))
- (intrp (env intrpf))) ; runtime if instead here caused a click at the juncture
- (outa i (* (env ampf)
- (+ (* intrp
- (polywave gen1 frq))
- (* (- 1.0 intrp)
- (+ (polywave gen2 frq)
- (* .03 (nrxysin gen3 (* frq 9)))))))))))))
-
- (definstrument (trumpeter-swan-d beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.082)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.068 0.279 0.121 0.989 0.178 0.755 0.208 0.451 0.234 0.834 0.291 0.921
- 0.355 0.459 0.371 0.158 0.401 0.876 0.494 1.000 0.614 0.851 0.797 0.510 0.862 0.166
- 0.928 0.146 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.328 0.092 0.328 0.147 0.370 0.212 0.314 0.256 0.356 0.345 0.359 0.389 0.373
- 0.438 0.370 0.489 0.420 0.532 0.398 0.601 0.398 0.641 0.375 0.685 0.364 0.739 0.401
- 0.799 0.417 0.856 0.398 1.000 0.401)
- :duration dur :scaler (hz->radians 1350)))
- (gen1 (make-oscil))
- (ampf1 (make-env '(0 0 .4 .1 .5 1 .9 .5 1 0) :duration dur :scaler .3))
-
- (gen2 (make-oscil))
- (ampf2 (make-env '(0 1 .45 1 .5 .5 .6 .8 .7 .8 .75 .1 .8 .5 1 0) :duration dur :scaler .5))
-
- (gen3 (make-nrxysin :n 12 :r .8 :ratio 1/8))
- (ampf3 (make-env '(0 0 .1 1 .6 1 .8 0 1 0) :duration dur :scaler .15))
-
- (gen4 (make-polywave :partials (normalize-partials (list 3 .4 4 .4 5 .2 6 .1 7 .05))))
- (ampf4 (make-env '(0 1 .8 1 1 0) :duration dur :scaler .5)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (oscil gen1 frq))
- (* (env ampf2)
- (oscil gen2 (* 2 frq)))
- (* (env ampf3)
- (nrxysin gen3 (* 8 frq)))
- (* (env ampf4)
- (polywave gen4 frq))))))))))
-
- (definstrument (trumpeter-swan-e beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.04)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.087 0.300 0.206 0.927 0.265 1.000 0.324 0.894 0.382 0.482 0.445 0.515
- 0.692 0.364 0.752 0.218 1.000 0.000)
- :duration dur :scaler amp))
- (frq 434)
- (gen1 (make-polywave frq (list 1 .05 2 .85 3 .1 5 .01)))
- (gen2 (make-nrxysin (* frq 7) 1/7 10 .8))
- (ampf2 (make-env '(0 0 .1 1 .4 0 1 0) :duration dur :scaler .2))
- (vib (make-rand-interp 200))
- (index (hz->radians 40)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((vb (* index (rand-interp vib))))
- (outa i (* (env ampf)
- (+ (polywave gen1 vb)
- (* (env ampf2)
- (nrxysin gen2 vb))))))))))
+ (defanimal (trumpeter-swan-a beg amp)
+ (let ((dur 0.053))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.086 0.411 0.253 0.887 0.466 0.989 0.627 0.992 0.782 0.842 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 356.0 (normalize-partials '(1 .1 2 1.0 3 .08 4 .2 5 .1 6 .03 7 .03 8 .03))))
+ (vib (make-oscil 130.0))
+ (index (hz->radians 30)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (* index (oscil vib)))))))))
+
+ (defanimal (trumpeter-swan-b beg amp)
+ (let ((dur 0.12))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.038 0.460 0.106 0.554 0.152 1.000 0.187 0.569 0.225 0.694 0.316 0.000
+ 0.381 0.000 0.462 0.827 0.512 0.000 0.539 0.613 0.571 0.859 0.609 0.528 0.632 0.815
+ 0.715 0.661 0.764 0.782 0.837 0.800 0.884 0.724 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.251 0.088 0.259 0.144 0.290 0.173 0.228 0.276 0.228 0.387 0.245 0.429 0.296
+ 0.457 0.310 0.484 0.296 0.514 0.265 0.548 0.307 0.599 0.377 0.641 0.352 0.706 0.346
+ 0.741 0.338 0.773 0.346 1.000 0.346)
+ :duration dur :scaler (hz->radians (* 0.5 3140))))
+ (gen2 (make-polywave 0.0 (float-vector 2 (* .6 .8) 3 (* .6 .2))))
+ (gen2a (make-polywave 0.0 (normalize-partials '( 4 .35 5 .19 6 .12 7 .03 8 .02))))
+ (ampf2a (make-env '(0 1 .6 1 1 0) :duration dur :scaler .4 :base 10))
+ (gen3 (make-nrxysin :n 12 :r .85 :ratio 1/9))
+ (ampf3 (make-env '(0 0 .1 0 .15 .5 .2 0 .4 0 .45 .7 .5 0 .55 1 .7 1 .8 0 .9 .1 1 0) :duration dur :scaler .02))
+ (gen1 (make-oscil))
+ (ampf1 (make-env '(0 0 .5 0 .6 1 .9 1 1 0) :duration dur :scaler .2)))
+ (set! (mus-phase gen2) (* 0.5 pi))
+ (set! (mus-phase gen2a) (* 0.5 pi))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (polywave gen2 frq)
+ (* (env ampf2a) (polywave gen2a frq))
+ (* (env ampf1) (oscil gen1 frq))
+ (* (env ampf3) (nrxysin gen3 (* 9.0 frq)))))))))))
+
+ (defanimal (trumpeter-swan-c beg amp)
+ (let ((dur 0.11))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.029 0.244 0.084 0.525 0.111 0.515 0.124 0.376 0.153 0.334 0.183 0.166
+ 0.205 0.000 0.240 0.769 0.261 0.775 0.280 0.271 0.297 0.000 0.338 0.773 0.423 1.000
+ 0.529 0.758 0.621 0.845 0.783 0.630 0.849 0.676 0.896 0.538 0.930 0.252 0.957 0.118 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.085 0.189 0.079 0.222 0.113 0.251 0.123 0.278 0.105 0.312 0.121 0.349 0.125
+ 0.377 0.133 0.412 0.127 0.510 0.123 0.691 0.129 0.778 0.125 0.830 0.127 1.000 0.129)
+ :duration dur :scaler (hz->radians (* 0.5 8650.0))))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 .01 2 .98 3 .05 4 .02 5 .005 6 .005))))
+ (gen2 (make-polywave 0.0 (normalize-partials '(1 .44 2 1.0 3 .34 4 .31 5 .19 6 .075 7 .04 8 .03))))
+ (gen3 (make-nrxysin :n 12 :r .85 :ratio 1/9))
+ (intrpf (make-env '(0 1 .19 1 .2 0 1 0) :duration dur))
+ (intrpf-1 (make-env '(0 1 .19 1 .2 0 1 0) :duration dur :offset 1.0 :scaler -1.0)))
+ (set! (mus-phase gen2) (* 0.5 pi))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env intrpf) (polywave gen1 frq))
+ (* (env intrpf-1) (+ (polywave gen2 frq)
+ (* .03 (nrxysin gen3 (* 9.0 frq)))))))))))))
+
+ (defanimal (trumpeter-swan-d beg amp)
+ (let ((dur 0.082))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.068 0.279 0.121 0.989 0.178 0.755 0.208 0.451 0.234 0.834 0.291 0.921
+ 0.355 0.459 0.371 0.158 0.401 0.876 0.494 1.000 0.614 0.851 0.797 0.510 0.862 0.166
+ 0.928 0.146 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.328 0.092 0.328 0.147 0.370 0.212 0.314 0.256 0.356 0.345 0.359 0.389 0.373
+ 0.438 0.370 0.489 0.420 0.532 0.398 0.601 0.398 0.641 0.375 0.685 0.364 0.739 0.401
+ 0.799 0.417 0.856 0.398 1.000 0.401)
+ :duration dur :scaler (hz->radians 1350)))
+ (gen1 (make-oscil))
+ (ampf1 (make-env '(0 0 .4 .1 .5 1 .9 .5 1 0) :duration dur :scaler .3))
+
+ (gen2 (make-oscil))
+ (ampf2 (make-env '(0 1 .45 1 .5 .5 .6 .8 .7 .8 .75 .1 .8 .5 1 0) :duration dur :scaler .5))
+
+ (gen3 (make-nrxysin :n 12 :r .8 :ratio 1/8))
+ (ampf3 (make-env '(0 0 .1 1 .6 1 .8 0 1 0) :duration dur :scaler .15))
+
+ (gen4 (make-polywave 0.0 (normalize-partials '(3 .4 4 .4 5 .2 6 .1 7 .05))))
+ (ampf4 (make-env '(0 1 .8 1 1 0) :duration dur :scaler .5)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (oscil gen1 frq))
+ (* (env ampf2)
+ (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3)
+ (nrxysin gen3 (* 8.0 frq)))
+ (* (env ampf4)
+ (polywave gen4 frq))))))))))
+
+ (defanimal (trumpeter-swan-e beg amp)
+ (let ((dur 0.04)
+ (frq 434))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.087 0.300 0.206 0.927 0.265 1.000 0.324 0.894 0.382 0.482 0.445 0.515
+ 0.692 0.364 0.752 0.218 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave frq '(1 .05 2 .85 3 .1 5 .01)))
+ (gen2 (make-nrxysin (* frq 7) 1/7 10 .8))
+ (ampf2 (make-env '(0 0 .1 1 .4 0 1 0) :duration dur :scaler .2))
+ (vib (make-rand-interp 200))
+ (index (hz->radians 40)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((vb (* index (rand-interp vib))))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 vb)
+ (* (env ampf2)
+ (nrxysin gen2 vb))))))))))
(trumpeter-swan-a beg (* amp .6))
(trumpeter-swan-b (+ beg .126) (* amp .9))
@@ -9593,6 +9572,7 @@
;; (with-sound (:play #t) (trumpeter-swan-1 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Wrentit
@@ -9600,49 +9580,47 @@
(define (wrentit beg1 amp1)
;; calif 1 3
- (definstrument (wrentit-1 beg dur amp frqscl)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.095 0.221 0.193 0.692 0.293 0.814 0.380 0.727 0.486 1.000 0.543 0.972
- 0.611 0.664 0.720 0.435 0.788 0.115 0.853 0.138 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.262 0.112 0.288 0.197 0.304 0.275 0.319 0.508 0.313 0.634 0.281 0.743 0.281
- 0.811 0.249 0.869 0.256 1.000 0.240)
- :duration dur :scaler (hz->radians (* frqscl 5000.0))))
- (gen1 (make-polywave :partials (list 1 .005 2 .9 3 .005 4 .01 6 .03 7 .005 8 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (wrentit-2 beg dur amp frqscl)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.091 0.616 0.150 0.724 0.195 0.667 0.259 0.686 0.387 1.000 0.447 0.770
- 0.482 0.740 0.507 0.623 0.552 0.693 0.629 0.557 0.684 0.288 0.713 0.321 0.738 0.232
- 0.754 0.162 0.771 0.225 0.786 0.150 0.792 0.197 0.801 0.126 0.808 0.225 0.816 0.122
- 0.829 0.178 0.832 0.105 0.840 0.211 0.849 0.094 0.856 0.173 0.880 0.089 0.898 0.220
- 0.914 0.124 .925 .01 1 0)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.269 0.105 0.297 0.182 0.319 0.311 0.319 0.428 0.304 0.534 0.281 0.688 0.269
- 0.789 0.244 0.825 0.215 1 .21)
- :duration dur :scaler (hz->radians (* frqscl 5040.0))))
- (gen1 (make-polywave :partials (list 1 .005 3 .005 4 .01 6 .03 7 .005 8 .005)))
- (ampf1 (make-env '(0 1 .6 1 .7 0 1 0) :duration dur))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 0 .7 0 1 1) :duration dur :scaler .5)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env ampf1)
- (polywave gen1 frq))
- (* .9 (oscil gen2 (* 2 frq)))
- (* (env ampf3)
- (oscil gen3 (* 3 frq)))))))))))
+ (defanimal (wrentit-1 beg dur amp frqscl)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.095 0.221 0.193 0.692 0.293 0.814 0.380 0.727 0.486 1.000 0.543 0.972
+ 0.611 0.664 0.720 0.435 0.788 0.115 0.853 0.138 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.262 0.112 0.288 0.197 0.304 0.275 0.319 0.508 0.313 0.634 0.281 0.743 0.281
+ 0.811 0.249 0.869 0.256 1.000 0.240)
+ :duration dur :scaler (hz->radians (* frqscl 5000.0))))
+ (gen1 (make-polywave 0.0 '(1 .005 2 .9 3 .005 4 .01 6 .03 7 .005 8 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
+
+ (defanimal (wrentit-2 beg dur amp frqscl)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.091 0.616 0.150 0.724 0.195 0.667 0.259 0.686 0.387 1.000 0.447 0.770
+ 0.482 0.740 0.507 0.623 0.552 0.693 0.629 0.557 0.684 0.288 0.713 0.321 0.738 0.232
+ 0.754 0.162 0.771 0.225 0.786 0.150 0.792 0.197 0.801 0.126 0.808 0.225 0.816 0.122
+ 0.829 0.178 0.832 0.105 0.840 0.211 0.849 0.094 0.856 0.173 0.880 0.089 0.898 0.220
+ 0.914 0.124 .925 .01 1 0)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.269 0.105 0.297 0.182 0.319 0.311 0.319 0.428 0.304 0.534 0.281 0.688 0.269
+ 0.789 0.244 0.825 0.215 1 .21)
+ :duration dur :scaler (hz->radians (* frqscl 5040.0))))
+ (gen1 (make-polywave 0.0 '(1 .005 3 .005 4 .01 6 .03 7 .005 8 .005)))
+ (ampf1 (make-env '(0 1 .6 1 .7 0 1 0) :duration dur))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 0 .7 0 1 1) :duration dur :scaler .5)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1)
+ (polywave gen1 frq))
+ (* .9 (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3)
+ (oscil gen3 (* 3.0 frq))))))))))
(wrentit-1 beg1 .041 (* amp1 0.6) 1.0)
@@ -9656,7 +9634,7 @@
(frqf (make-env (list 0 1 1 (/ 3050.0 3200.0)) :length 10))
(call-init 1.0))
- (do ((call 0 (+ 1 call)))
+ (do ((call 0 (+ call 1)))
((= call 10))
(let ((call-amp (env ampf))
(call-frq (env frqf)))
@@ -9669,102 +9647,102 @@
;; (with-sound (:play #t) (wrentit 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Western wood-pewee
-(definstrument (western-wood-pewee-1 beg amp)
+(defanimal (western-wood-pewee-1 beg amp)
;; calif 2 8
- (let* ((start (seconds->samples beg))
- (dur 0.89)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.009 0.038 0.014 0.140 0.019 0.184 0.030 0.178 0.038 0.055 0.046 0.000
- 0.210 0.000 0.217 0.165 0.229 0.263 0.239 0.253 0.246 0.204 0.254 0.000 0.336 0.000
- 0.338 0.122 0.355 0.373 0.363 0.356 0.367 0.151 0.371 0.260 0.383 0.000 0.408 0.000
- 0.415 0.302 0.421 0.349 0.425 0.496 0.429 0.420 0.439 0.382 0.452 0.460 0.459 0.401
- 0.466 0.438 0.469 0.498 0.484 0.567 0.505 0.603 0.518 0.541 0.531 0.580 0.543 0.582
- 0.554 0.473 0.564 0.535 0.587 0.534 0.594 0.495 0.616 0.567 0.633 0.530 0.651 0.570
- 0.665 0.544 0.683 0.566 0.698 0.521 0.704 0.402 0.709 0.000 0.727 0.001 0.738 0.865
- 0.742 0.951 0.747 0.997 0.750 0.971 0.763 0.000 0.783 0.000 0.786 0.342 0.794 0.832
- 0.800 0.611 0.805 0.764 0.811 0.705 0.815 0.863 0.819 0.822 0.829 0.0 0.834 0.0
- 0.840 0.630 0.850 0.185 0.861 0.000 0.865 0.000 0.872 0.113 0.881 0.211 0.899 0.260
- 0.907 0.441 0.913 0.340 0.917 0.424 0.919 0.317 0.921 0.444 0.930 0.198 0.935 0.174
- 0.949 0.136 0.953 0.109 0.964 0.122 0.973 0.110 0.982 0.140 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.379 0.016 0.432 0.034 0.438 0.214 0.395 0.219 0.428 0.230 0.446 0.247 0.444
- 0.339 0.407 0.346 0.444 0.356 0.452 0.365 0.436 0.369 0.415 0.375 0.434 0.380 0.411
- 0.411 0.420 0.419 0.450 0.429 0.464 0.447 0.460 0.464 0.466 0.496 0.473 0.571 0.483
- 0.691 0.485 0.701 0.468 0.710 0.409 0.728 0.314 0.734 0.464 0.740 0.511 0.746 0.521
- 0.756 0.485 0.764 0.420 0.786 0.428 0.789 0.481 0.798 0.550 0.808 0.552 0.818 0.489
- 0.823 0.46 0.825 0.481 0.829 0.809 0.835 0.792 0.839 0.546 0.842 0.487 0.848 0.442
- 0.855 0.397 0.870 0.409 0.877 0.442 0.898 0.442 0.913 0.468 0.921 0.519 0.927 0.580
- 0.938 0.650 0.948 0.697 0.954 0.684 0.958 0.705 0.967 0.680 0.983 0.666 0.991 0.593 1.000 0.452)
- :duration dur :scaler (hz->radians 7100.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .005 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.89))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.009 0.038 0.014 0.140 0.019 0.184 0.030 0.178 0.038 0.055 0.046 0.000
+ 0.210 0.000 0.217 0.165 0.229 0.263 0.239 0.253 0.246 0.204 0.254 0.000 0.336 0.000
+ 0.338 0.122 0.355 0.373 0.363 0.356 0.367 0.151 0.371 0.260 0.383 0.000 0.408 0.000
+ 0.415 0.302 0.421 0.349 0.425 0.496 0.429 0.420 0.439 0.382 0.452 0.460 0.459 0.401
+ 0.466 0.438 0.469 0.498 0.484 0.567 0.505 0.603 0.518 0.541 0.531 0.580 0.543 0.582
+ 0.554 0.473 0.564 0.535 0.587 0.534 0.594 0.495 0.616 0.567 0.633 0.530 0.651 0.570
+ 0.665 0.544 0.683 0.566 0.698 0.521 0.704 0.402 0.709 0.000 0.727 0.001 0.738 0.865
+ 0.742 0.951 0.747 0.997 0.750 0.971 0.763 0.000 0.783 0.000 0.786 0.342 0.794 0.832
+ 0.800 0.611 0.805 0.764 0.811 0.705 0.815 0.863 0.819 0.822 0.829 0.0 0.834 0.0
+ 0.840 0.630 0.850 0.185 0.861 0.000 0.865 0.000 0.872 0.113 0.881 0.211 0.899 0.260
+ 0.907 0.441 0.913 0.340 0.917 0.424 0.919 0.317 0.921 0.444 0.930 0.198 0.935 0.174
+ 0.949 0.136 0.953 0.109 0.964 0.122 0.973 0.110 0.982 0.140 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.379 0.016 0.432 0.034 0.438 0.214 0.395 0.219 0.428 0.230 0.446 0.247 0.444
+ 0.339 0.407 0.346 0.444 0.356 0.452 0.365 0.436 0.369 0.415 0.375 0.434 0.380 0.411
+ 0.411 0.420 0.419 0.450 0.429 0.464 0.447 0.460 0.464 0.466 0.496 0.473 0.571 0.483
+ 0.691 0.485 0.701 0.468 0.710 0.409 0.728 0.314 0.734 0.464 0.740 0.511 0.746 0.521
+ 0.756 0.485 0.764 0.420 0.786 0.428 0.789 0.481 0.798 0.550 0.808 0.552 0.818 0.489
+ 0.823 0.46 0.825 0.481 0.829 0.809 0.835 0.792 0.839 0.546 0.842 0.487 0.848 0.442
+ 0.855 0.397 0.870 0.409 0.877 0.442 0.898 0.442 0.913 0.468 0.921 0.519 0.927 0.580
+ 0.938 0.650 0.948 0.697 0.954 0.684 0.958 0.705 0.967 0.680 0.983 0.666 0.991 0.593 1.000 0.452)
+ :duration dur :scaler (hz->radians 7100.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .005 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (western-wood-pewee-1 0 .5))
-(definstrument (western-wood-pewee-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.69)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.016 0.098 0.038 0.208 0.060 0.000 0.254 0.000 0.293 0.846 0.306 0.975
- 0.345 1.000 0.391 0.833 0.457 0.809 0.545 0.843 0.596 0.836 0.713 0.669 0.724 0.583
- 0.729 0.326 0.740 0.324 0.751 0.240 0.774 0.179 0.794 0.600 0.812 0.632 0.878 0.539
- 0.912 0.392 0.971 0.316 0.984 0.091 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.409 0.030 0.400 0.039 0.436 0.067 0.444 0.279 0.434 0.291 0.505 0.327 0.561
- 0.420 0.578 0.482 0.569 0.648 0.532 0.728 0.527 0.753 0.593 0.779 0.650 0.802 0.605
- 0.827 0.532 0.854 0.507 0.977 0.485 1.000 0.43)
- :duration dur :scaler (hz->radians 7300.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .005 3 .005)))
- (vib (make-oscil 152))
- (index (hz->radians 500))
- (vibf (make-env '(0 0 .29 0 .38 1 .7 .5 .75 0 1 0) :duration dur))
- (trem (make-triangle-wave 76 .8)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((vbf (env vibf)))
- (outa i (* (env ampf)
- (- 1.0 (* vbf (abs (triangle-wave trem))))
- (polywave gen1 (+ (env frqf)
- (* vbf index (oscil vib)))))))))))
+(defanimal (western-wood-pewee-2 beg amp)
+ (let ((dur 0.69))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.016 0.098 0.038 0.208 0.060 0.000 0.254 0.000 0.293 0.846 0.306 0.975
+ 0.345 1.000 0.391 0.833 0.457 0.809 0.545 0.843 0.596 0.836 0.713 0.669 0.724 0.583
+ 0.729 0.326 0.740 0.324 0.751 0.240 0.774 0.179 0.794 0.600 0.812 0.632 0.878 0.539
+ 0.912 0.392 0.971 0.316 0.984 0.091 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.409 0.030 0.400 0.039 0.436 0.067 0.444 0.279 0.434 0.291 0.505 0.327 0.561
+ 0.420 0.578 0.482 0.569 0.648 0.532 0.728 0.527 0.753 0.593 0.779 0.650 0.802 0.605
+ 0.827 0.532 0.854 0.507 0.977 0.485 1.000 0.43)
+ :duration dur :scaler (hz->radians 7300.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .005 3 .005)))
+ (vib (make-oscil 152))
+ (index (hz->radians 500))
+ (vibf (make-env '(0 0 .29 0 .38 1 .7 .5 .75 0 1 0) :duration dur))
+ (trem (make-triangle-wave 76 .8)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((vbf (env vibf)))
+ (outa i (* (env ampf)
+ (- 1.0 (* vbf (abs (triangle-wave trem))))
+ (polywave gen1 (+ (env frqf)
+ (* vbf index (oscil vib)))))))))))
;; (with-sound (:play #t) (western-wood-pewee-2 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Cedar waxwing
-(definstrument (cedar-waxwing beg amp)
+(defanimal (cedar-waxwing beg amp)
;; probably the simplest bird call
;; calif 10 10 (hard to find one call by itself)
;; a cleaner original is east 3 3 with a slightly sharper frq env
- (let* ((start (seconds->samples beg))
- (dur 0.5)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.133 0.217 0.337 0.854 0.470 0.826 0.533 0.751 0.617 0.980
- 0.704 1.000 0.883 0.881 0.943 0.747 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.267 0.097 0.287 0.242 0.301 0.472 0.304 0.684 0.301 0.788 0.301
- 0.973 0.293 1.000 0.264)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .006 3 .004))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf) (polywave gen1 (env frqf))))))))
+ (let ((dur 0.5))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.133 0.217 0.337 0.854 0.470 0.826 0.533 0.751 0.617 0.980
+ 0.704 1.000 0.883 0.881 0.943 0.747 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.267 0.097 0.287 0.242 0.301 0.472 0.304 0.684 0.301 0.788 0.301
+ 0.973 0.293 1.000 0.264)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .006 3 .004))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (cedar-waxwing 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Townsend's solitaire
@@ -9772,113 +9750,108 @@
(define (townsends-solitaire beg1 amp1)
;; calif 67 33
- (definstrument (townsends-solitaire-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.15)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.056 0.074 0.084 0.182 0.122 0.118 0.163 0.168 0.224 0.104 0.257 0.343
- 0.289 0.337 0.299 0.155 0.308 0.242 0.320 0.185 0.329 0.125 0.389 0.145 0.436 0.242
- 0.466 0.195 0.484 0.313 0.495 0.455 0.571 0.535 0.634 0.566 0.684 0.727 0.717 0.926
- 0.751 0.983 0.786 0.960 0.891 0.717 0.957 0.242 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.321 0.055 0.337 0.081 0.365 0.103 0.370 0.113 0.303 0.153 0.308 0.192 0.329
- 0.233 0.342 0.261 0.376 0.282 0.358 0.306 0.285 0.358 0.272 0.427 0.308 0.490 0.360
- 0.584 0.376 0.813 0.360 1.000 0.342)
- :duration dur :scaler (hz->radians 8100.0)))
- (gen1 (make-polywave :partials (list 1 .995 2 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (townsends-solitaire-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.037)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.077 0.215 0.112 0.907 0.198 0.189 0.212 0.096 0.235 0.0 0.333 0.085
- 0.433 0.515 0.471 0.481 0.517 0.622 0.571 0.526 0.671 1.000 0.699 0.752 0.718 0.904
- 0.781 0.915 0.862 0.374 0.968 0.289 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.395 0.077 0.351 0.121 0.293 0.169 0.225 0.218 0.196 0.286 0.163 0.345 0.185
- 0.407 0.221 1.000 0.36)
- :duration dur :scaler (hz->radians 13800.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .005 4 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (townsends-solitaire-3 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.323)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.106 0.301 0.117 0.254 0.156 0.475 0.198 0.359 0.221 0.043 0.228 0.214
- 0.307 0.848 0.337 0.391 0.355 0.355 0.366 0.467 0.381 0.409 0.397 0.649 0.407 0.576
- 0.424 0.105 0.453 0.449 0.474 0.627 0.485 0.558 0.488 0.703 0.506 0.482 0.514 0.261
- 0.523 0.203 0.572 0.529 0.581 0.449 0.586 0.641 0.606 0.000 0.634 0.359 0.661 0.598
- 0.675 0.522 0.684 0.750 0.701 0.616 0.709 0.380 0.718 0.250 0.733 0.188 0.768 0.478
- 0.778 0.362 0.796 0.000 0.822 0.373 0.849 0.587 0.861 0.478 0.881 0.891 0.888 0.804
- 0.904 0.996 0.935 0.703 0.946 0.768 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.549 0.083 0.595 0.114 0.606 0.144 0.641 0.179 0.656 0.213 0.643 0.229 0.590
- 0.247 0.573 0.283 0.564 0.313 0.538 0.344 0.484 0.347 0.641 0.361 0.610 0.387 0.586
- 0.404 0.547 0.419 0.486 0.435 0.477 0.440 0.645 0.450 0.667 0.456 0.634 0.472 0.610
- 0.507 0.529 0.527 0.492 0.535 0.688 0.559 0.625 0.605 0.519 0.618 0.505 0.629 0.678
- 0.654 0.619 0.672 0.590 0.711 0.519 0.732 0.510 0.734 0.702 0.758 0.632 0.797 0.508
- 0.813 0.671 0.828 0.662 0.840 0.608 0.882 0.560 0.922 0.525 1.000 0.475)
- :duration dur :scaler (hz->radians 6000.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .004 3 .006))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (townsends-solitaire-4 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.217)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.065 0.296 0.096 0.261 0.145 0.368 0.179 0.580 0.196 0.375 0.227 0.560
- 0.272 0.000 0.314 0.000 0.380 0.451 0.416 0.325 0.433 0.183 0.456 0.351 0.483 0.303
- 0.509 0.410 0.528 0.255 0.627 0.089 0.640 0.000 0.660 0.196 0.699 0.307 0.711 0.706
- 0.722 0.719 0.740 0.481 0.755 0.455 0.763 0.362 0.775 0.453 0.793 0.059 0.796 0.214
- 0.807 0.000 0.810 0.124 0.828 0.187 0.856 0.240 0.867 0.205 0.883 0.253 0.902 0.882
- 0.909 1.000 0.955 0.438 0.963 0.603 0.969 0.497 0.982 0.153 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.486 0.036 0.486 0.128 0.538 0.134 0.473 0.166 0.481 0.183 0.512 0.200 0.534
- 0.219 0.484 0.227 0.425 0.244 0.386 0.287 0.366 0.307 0.499 0.328 0.527 0.341 0.508
- 0.424 0.429 0.507 0.410 0.599 0.364 0.617 0.381 0.628 0.414 0.659 0.427 0.685 0.460
- 0.707 0.475 0.729 0.514 0.759 0.551 0.774 0.521 0.779 0.449 0.797 0.386 0.833 0.414
- 0.873 0.451 0.905 0.492 0.941 0.547 0.959 0.545 0.970 0.423 1.000 0.322)
- :duration dur :scaler (hz->radians 6050.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .006 3 .004))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (townsends-solitaire-5 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.007)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0 0 1 1 3 0) :duration dur :scaler amp))
- (frqf (make-env '(0 4600 1 3000) :duration dur :scaler (hz->radians 1.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (defanimal (townsends-solitaire-1 beg amp)
+ (let ((dur 0.15))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.056 0.074 0.084 0.182 0.122 0.118 0.163 0.168 0.224 0.104 0.257 0.343
+ 0.289 0.337 0.299 0.155 0.308 0.242 0.320 0.185 0.329 0.125 0.389 0.145 0.436 0.242
+ 0.466 0.195 0.484 0.313 0.495 0.455 0.571 0.535 0.634 0.566 0.684 0.727 0.717 0.926
+ 0.751 0.983 0.786 0.960 0.891 0.717 0.957 0.242 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.321 0.055 0.337 0.081 0.365 0.103 0.370 0.113 0.303 0.153 0.308 0.192 0.329
+ 0.233 0.342 0.261 0.376 0.282 0.358 0.306 0.285 0.358 0.272 0.427 0.308 0.490 0.360
+ 0.584 0.376 0.813 0.360 1.000 0.342)
+ :duration dur :scaler (hz->radians 8100.0)))
+ (gen1 (make-polywave 0.0 '(1 .995 2 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (townsends-solitaire-2 beg amp)
+ (let ((dur 0.037))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.077 0.215 0.112 0.907 0.198 0.189 0.212 0.096 0.235 0.0 0.333 0.085
+ 0.433 0.515 0.471 0.481 0.517 0.622 0.571 0.526 0.671 1.000 0.699 0.752 0.718 0.904
+ 0.781 0.915 0.862 0.374 0.968 0.289 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.395 0.077 0.351 0.121 0.293 0.169 0.225 0.218 0.196 0.286 0.163 0.345 0.185
+ 0.407 0.221 1.000 0.36)
+ :duration dur :scaler (hz->radians 13800.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .005 4 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (townsends-solitaire-3 beg amp)
+ (let ((dur 0.323))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.106 0.301 0.117 0.254 0.156 0.475 0.198 0.359 0.221 0.043 0.228 0.214
+ 0.307 0.848 0.337 0.391 0.355 0.355 0.366 0.467 0.381 0.409 0.397 0.649 0.407 0.576
+ 0.424 0.105 0.453 0.449 0.474 0.627 0.485 0.558 0.488 0.703 0.506 0.482 0.514 0.261
+ 0.523 0.203 0.572 0.529 0.581 0.449 0.586 0.641 0.606 0.000 0.634 0.359 0.661 0.598
+ 0.675 0.522 0.684 0.750 0.701 0.616 0.709 0.380 0.718 0.250 0.733 0.188 0.768 0.478
+ 0.778 0.362 0.796 0.000 0.822 0.373 0.849 0.587 0.861 0.478 0.881 0.891 0.888 0.804
+ 0.904 0.996 0.935 0.703 0.946 0.768 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.549 0.083 0.595 0.114 0.606 0.144 0.641 0.179 0.656 0.213 0.643 0.229 0.590
+ 0.247 0.573 0.283 0.564 0.313 0.538 0.344 0.484 0.347 0.641 0.361 0.610 0.387 0.586
+ 0.404 0.547 0.419 0.486 0.435 0.477 0.440 0.645 0.450 0.667 0.456 0.634 0.472 0.610
+ 0.507 0.529 0.527 0.492 0.535 0.688 0.559 0.625 0.605 0.519 0.618 0.505 0.629 0.678
+ 0.654 0.619 0.672 0.590 0.711 0.519 0.732 0.510 0.734 0.702 0.758 0.632 0.797 0.508
+ 0.813 0.671 0.828 0.662 0.840 0.608 0.882 0.560 0.922 0.525 1.000 0.475)
+ :duration dur :scaler (hz->radians 6000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .004 3 .006))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (townsends-solitaire-4 beg amp)
+ (let ((dur 0.217))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.065 0.296 0.096 0.261 0.145 0.368 0.179 0.580 0.196 0.375 0.227 0.560
+ 0.272 0.000 0.314 0.000 0.380 0.451 0.416 0.325 0.433 0.183 0.456 0.351 0.483 0.303
+ 0.509 0.410 0.528 0.255 0.627 0.089 0.640 0.000 0.660 0.196 0.699 0.307 0.711 0.706
+ 0.722 0.719 0.740 0.481 0.755 0.455 0.763 0.362 0.775 0.453 0.793 0.059 0.796 0.214
+ 0.807 0.000 0.810 0.124 0.828 0.187 0.856 0.240 0.867 0.205 0.883 0.253 0.902 0.882
+ 0.909 1.000 0.955 0.438 0.963 0.603 0.969 0.497 0.982 0.153 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.486 0.036 0.486 0.128 0.538 0.134 0.473 0.166 0.481 0.183 0.512 0.200 0.534
+ 0.219 0.484 0.227 0.425 0.244 0.386 0.287 0.366 0.307 0.499 0.328 0.527 0.341 0.508
+ 0.424 0.429 0.507 0.410 0.599 0.364 0.617 0.381 0.628 0.414 0.659 0.427 0.685 0.460
+ 0.707 0.475 0.729 0.514 0.759 0.551 0.774 0.521 0.779 0.449 0.797 0.386 0.833 0.414
+ 0.873 0.451 0.905 0.492 0.941 0.547 0.959 0.545 0.970 0.423 1.000 0.322)
+ :duration dur :scaler (hz->radians 6050.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .006 3 .004))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (townsends-solitaire-5 beg amp)
+ (let ((dur 0.007))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0 0 1 1 3 0) :duration dur :scaler amp))
+ (frqf (make-env '(0 4600 1 3000) :duration dur :scaler (hz->radians 1.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
(townsends-solitaire-3 beg1 (* amp1 .7))
(townsends-solitaire-1 (+ beg1 .37) amp1)
(townsends-solitaire-1 (+ beg1 .59) amp1)
- (do ((call 0 (+ 1 call)))
+ (do ((call 0 (+ call 1)))
((= call 5))
(townsends-solitaire-2 (+ beg1 .85 (* call .059)) (* .3 amp1)))
@@ -9888,145 +9861,145 @@
;; (with-sound (:play #t) (townsends-solitaire 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Canada goose
-(definstrument (canada-goose-1 beg amp)
+(defanimal (canada-goose-1 beg amp)
;; east 21 28
- (let* ((start (seconds->samples beg))
- (dur 0.375)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.446 0.182 0.489 0.778 0.521 0.465 0.610 0.356 0.682 0.553 0.741 1.000
- 0.785 0.513 0.811 0.350 0.878 0.270 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.362 0.321 0.378 0.422 0.398 0.445 0.418 0.461 0.388 0.485 0.428 0.606 0.434
- 0.624 0.421 0.643 0.444 0.662 0.405 0.670 0.451 0.685 0.378 0.691 0.428 0.700 0.378
- 0.708 0.434 0.748 0.457 0.819 0.467 0.870 0.464 0.910 0.414 1.000 0.382)
- :duration dur :scaler (hz->radians (* 0.5 3500))))
- (gen1 (make-oscil))
- (ampf1 (make-env '(0 1 .44 1 .455 .5 .46 1 .465 .5 .5 1 .67 1 .68 .1 .69 1 .71 1 .72 .1 .73 1 1 1) :duration dur :scaler .4))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 .2 .4 .2 .5 1 .68 1 .7 .5 .9 .5 1 0) :duration dur :scaler .3))
- (gen4 (make-polywave :partials (list 4 .8 5 .2)))
- (ampf4 (make-env '(0 0 .4 .1 .5 1 .75 1 .9 0 1 0) :duration dur :scaler .05))
- (gen5 (make-nrxysin :n 12 :r .8 :ratio 1/6))
- (ampf5 (make-env '(0 0 .4 0 .5 1 .65 .1 .7 1 .9 0 1 0) :duration dur :scaler .2))
- (trem (make-triangle-wave (* 0.5 170)))
- (tremf (make-env '(0 1 .45 1 .5 .3 .65 .2 .7 1 .75 .2 1 .2) :duration dur))
- (hum (make-oscil))
- (humf (make-env '(0 .1 .1 1 .2 .1 .3 1 .4 1 .45 .1 .8 0 1 0) :duration dur :scaler .4))
- (rnd (make-rand-interp 2000))
- (rndf (make-env '(0 .1 .3 .2 .4 1 .45 1 .5 .1 .6 .01 .65 1 .7 .1 1 .25) :duration dur :scaler (hz->radians 200)))
- (gen6 (make-nrxysin :n 12 :r .8 :ratio 1/6))
- (ampf6 (make-env '(0 0 .4 0 .45 1 .5 0 .65 0 .7 1 .75 0 1 0) :duration dur :scaler .2)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((trmf (env tremf))
- (frq (+ (env frqf)
- (* (env rndf) (rand-interp rnd)))))
- (outa i (* (env ampf)
- (+ (- 1.0 trmf) (* trmf (abs (triangle-wave trem))))
- (+ (* (env ampf1) (oscil gen1 frq))
- (* .5 (oscil gen2 (* 2 frq)))
- (* (env ampf3) (oscil gen3 (* 3 frq)))
- (* (env ampf4) (polywave gen4 frq))
- (* (env ampf5) (nrxysin gen5 (* 6 frq)))
- (* (env ampf6) (nrxysin gen6 (* 3 frq)))
- (* (env humf) (oscil hum (* .25 frq)))))))))))
-
-(definstrument (canada-goose-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur 0.245)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.027 0.057 0.054 0.000 0.072 0.076 0.080 0.000 0.098 0.078 0.106 0.005
- 0.121 0.087 0.133 0.000 0.147 0.101 0.157 0.005 0.174 0.119 0.183 0.005 0.200 0.119
- 0.208 0.002 0.225 0.128 0.236 0.000 0.249 0.112 0.259 0.000 0.270 0.098 0.283 0.000
- 0.299 0.105 0.308 0.000 0.322 0.133 0.329 0.066 0.345 0.151 0.352 0.085 0.361 0.201
- 0.375 0.114 0.383 0.217 0.397 0.124 0.406 0.195 0.414 0.085 0.442 0.373 0.620 1.000
- 0.640 0.686 0.705 0.469 0.757 0.352 0.818 0.300 0.846 0.405 0.942 0.133 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.276 0.164 0.300 0.307 0.308 0.599 0.297 0.651 0.302 0.661 0.354 0.755 0.357
- 0.827 0.342 0.855 0.310 1.000 0.283)
- :duration dur :scaler (hz->radians (* 0.5 4300))))
- (gen1 (make-oscil))
- (ampf1 (make-env '(0 1 .4 1 .55 1 .6 .7 1 1) :duration dur :scaler .5))
- (gen2 (make-oscil))
- (ampf2 (make-env '(0 .5 .55 .2 .6 1 .7 .2 1 1) :duration dur :scaler .5))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 .2 .6 .1 .65 1 .75 1 .9 0 1 0) :duration dur :scaler .3))
- (gen4 (make-polywave :partials (list 4 .8 5 .2)))
- (ampf4 (make-env '(0 0 .4 .1 .65 1 .75 1 .8 0 .85 1 .9 .5 1 .5) :duration dur :scaler .1))
- (gen5 (make-nrxysin :n 12 :r .8 :ratio 1/6))
- (ampf5 (make-env '(0 0 .5 0 .55 1 .6 0 .65 1 .7 1 .8 0 1 0) :duration dur :scaler .2))
- (hum (make-oscil))
- (humf (make-env '(0 1 .4 1 .42 .1 .6 0 1 0) :duration dur :scaler .4))
- (rnd (make-rand-interp 2000))
- (rndf (make-env '(0 .1 .3 .2 .65 1 .7 .1 1 .25) :duration dur :scaler (hz->radians 100)))
- (gen6 (make-nrxysin :n 12 :r .8 :ratio 1/6))
- (ampf6 (make-env '(0 0 .65 0 .7 1 .75 0 1 0) :duration dur :scaler .3)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* (env rndf) (rand-interp rnd)))))
- (outa i (* (env ampf)
- (+ (* (env ampf1) (oscil gen1 frq))
- (* (env ampf2) (oscil gen2 (* 2 frq)))
- (* (env ampf3) (oscil gen3 (* 3 frq)))
- (* (env ampf4) (polywave gen4 frq))
- (* (env ampf5) (nrxysin gen5 (* 6 frq)))
- (* (env ampf6) (nrxysin gen6 (* 3 frq)))
- (* (env humf) (oscil hum (* .25 frq)))))))))))
-
-(definstrument (canada-goose-3 beg amp)
+ (let ((dur 0.375))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.446 0.182 0.489 0.778 0.521 0.465 0.610 0.356 0.682 0.553 0.741 1.000
+ 0.785 0.513 0.811 0.350 0.878 0.270 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.362 0.321 0.378 0.422 0.398 0.445 0.418 0.461 0.388 0.485 0.428 0.606 0.434
+ 0.624 0.421 0.643 0.444 0.662 0.405 0.670 0.451 0.685 0.378 0.691 0.428 0.700 0.378
+ 0.708 0.434 0.748 0.457 0.819 0.467 0.870 0.464 0.910 0.414 1.000 0.382)
+ :duration dur :scaler (hz->radians (* 0.5 3500))))
+ (gen1 (make-oscil))
+ (ampf1 (make-env '(0 1 .44 1 .455 .5 .46 1 .465 .5 .5 1 .67 1 .68 .1 .69 1 .71 1 .72 .1 .73 1 1 1) :duration dur :scaler .4))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 .2 .4 .2 .5 1 .68 1 .7 .5 .9 .5 1 0) :duration dur :scaler .3))
+ (gen4 (make-polywave 0.0 '(4 .8 5 .2)))
+ (ampf4 (make-env '(0 0 .4 .1 .5 1 .75 1 .9 0 1 0) :duration dur :scaler .05))
+ (gen5 (make-nrxysin :n 12 :r .8 :ratio 1/6))
+ (ampf5 (make-env '(0 0 .4 0 .5 1 .65 .1 .7 1 .9 0 1 0) :duration dur :scaler .2))
+ (trem (make-triangle-wave (* 0.5 170)))
+ (tremf (make-env '(0 1 .45 1 .5 .3 .65 .2 .7 1 .75 .2 1 .2) :duration dur))
+ (tremf-1 (make-env '(0 1 .45 1 .5 .3 .65 .2 .7 1 .75 .2 1 .2) :duration dur :offset 1.0 :scaler -1.0))
+ (hum (make-oscil))
+ (humf (make-env '(0 .1 .1 1 .2 .1 .3 1 .4 1 .45 .1 .8 0 1 0) :duration dur :scaler .4))
+ (rnd (make-rand-interp 2000))
+ (rndf (make-env '(0 .1 .3 .2 .4 1 .45 1 .5 .1 .6 .01 .65 1 .7 .1 1 .25) :duration dur :scaler (hz->radians 200)))
+ (gen6 (make-nrxysin :n 12 :r .8 :ratio 1/6))
+ (ampf6 (make-env '(0 0 .4 0 .45 1 .5 0 .65 0 .7 1 .75 0 1 0) :duration dur :scaler .2)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env rndf) (rand-interp rnd)))))
+ (outa i (* (env ampf)
+ (+ (env tremf-1)
+ (* (env tremf) (abs (triangle-wave trem))))
+ (+ (* (env ampf1) (oscil gen1 frq))
+ (* .5 (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3) (oscil gen3 (* 3.0 frq)))
+ (+ (* (env ampf4) (polywave gen4 frq)) ; extra + to make the optimizer happy
+ (* (env ampf5) (nrxysin gen5 (* 6.0 frq)))
+ (* (env ampf6) (nrxysin gen6 (* 3.0 frq)))
+ (* (env humf) (oscil hum (* .25 frq))))))))))))
+
+(defanimal (canada-goose-2 beg amp)
+ (let ((dur 0.245))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.027 0.057 0.054 0.000 0.072 0.076 0.080 0.000 0.098 0.078 0.106 0.005
+ 0.121 0.087 0.133 0.000 0.147 0.101 0.157 0.005 0.174 0.119 0.183 0.005 0.200 0.119
+ 0.208 0.002 0.225 0.128 0.236 0.000 0.249 0.112 0.259 0.000 0.270 0.098 0.283 0.000
+ 0.299 0.105 0.308 0.000 0.322 0.133 0.329 0.066 0.345 0.151 0.352 0.085 0.361 0.201
+ 0.375 0.114 0.383 0.217 0.397 0.124 0.406 0.195 0.414 0.085 0.442 0.373 0.620 1.000
+ 0.640 0.686 0.705 0.469 0.757 0.352 0.818 0.300 0.846 0.405 0.942 0.133 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.276 0.164 0.300 0.307 0.308 0.599 0.297 0.651 0.302 0.661 0.354 0.755 0.357
+ 0.827 0.342 0.855 0.310 1.000 0.283)
+ :duration dur :scaler (hz->radians (* 0.5 4300))))
+ (gen1 (make-oscil))
+ (ampf1 (make-env '(0 1 .4 1 .55 1 .6 .7 1 1) :duration dur :scaler .5))
+ (gen2 (make-oscil))
+ (ampf2 (make-env '(0 .5 .55 .2 .6 1 .7 .2 1 1) :duration dur :scaler .5))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 .2 .6 .1 .65 1 .75 1 .9 0 1 0) :duration dur :scaler .3))
+ (gen4 (make-polywave 0.0 '(4 .8 5 .2)))
+ (ampf4 (make-env '(0 0 .4 .1 .65 1 .75 1 .8 0 .85 1 .9 .5 1 .5) :duration dur :scaler .1))
+ (gen5 (make-nrxysin :n 12 :r .8 :ratio 1/6))
+ (ampf5 (make-env '(0 0 .5 0 .55 1 .6 0 .65 1 .7 1 .8 0 1 0) :duration dur :scaler .2))
+ (hum (make-oscil))
+ (humf (make-env '(0 1 .4 1 .42 .1 .6 0 1 0) :duration dur :scaler .4))
+ (rnd (make-rand-interp 2000))
+ (rndf (make-env '(0 .1 .3 .2 .65 1 .7 .1 1 .25) :duration dur :scaler (hz->radians 100)))
+ (gen6 (make-nrxysin :n 12 :r .8 :ratio 1/6))
+ (ampf6 (make-env '(0 0 .65 0 .7 1 .75 0 1 0) :duration dur :scaler .3)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env rndf) (rand-interp rnd)))))
+ (outa i (* (env ampf)
+ (+ (* (env ampf1) (oscil gen1 frq))
+ (* (env ampf2) (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3) (oscil gen3 (* 3.0 frq)))
+ (+ (* (env ampf4) (polywave gen4 frq))
+ (* (env ampf5) (nrxysin gen5 (* 6.0 frq)))
+ (* (env ampf6) (nrxysin gen6 (* 3.0 frq)))
+ (* (env humf) (oscil hum (* .25 frq))))))))))))
+
+(defanimal (canada-goose-3 beg amp)
;; east 21 29
- (let* ((start (seconds->samples beg))
- (dur 0.33)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.082 0.112 0.207 0.158 0.218 0.089 0.246 0.214 0.278 0.181 .32 .3
- 0.364 0.944 0.374 1.000 0.384 0.974 0.394 0.757 0.431 0.645 0.584 0.201 0.639 0.688
- 0.657 0.717 0.714 0.477 0.800 0.319 0.882 0.253 0.902 0.164 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.291 0.311 0.299 0.338 0.299 0.358 0.414 0.395 0.443 0.454 0.455 0.547 0.418
- 0.596 0.389 0.614 0.414 0.634 0.393 0.682 0.418 0.764 0.426 0.846 0.410 0.874 0.369
- 0.907 0.352 1.000 0.307)
- :duration dur :scaler (hz->radians (* 0.5 3600))))
- (gen1 (make-oscil))
- (ampf1 (make-env '(0 .1 .5 .2 .6 1 .65 .3 1 1) :duration dur :scaler .3))
- (gen2 (make-oscil))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 .1 .3 .2 .4 1 1 1) :duration dur :scaler .1))
- (gen4 (make-polywave :partials (list 4 .8 5 .2)))
- (ampf4 (make-env '(0 0 .3 0 .4 1 .9 1 1 0) :duration dur :scaler .05))
- (gen5 (make-nrxysin :n 12 :r .7 :ratio 1/6))
- (ampf5 (make-env '(0 0 .3 0 .4 1 .5 .1 .55 0 .6 .1 .63 1 .85 0 1 0) :duration dur :scaler .3))
- (trem (make-triangle-wave (* 0.5 170)))
- (tremf (make-env '(0 1 .3 1 .35 .1 .6 .2 .65 1 .7 .2 1 .2) :duration dur))
- (hum (make-oscil))
- (humf (make-env '(0 .5 .45 .4 .5 1 .6 .5 .7 0 1 0) :duration dur :scaler .2))
- (humfrq (make-env '(0 150 .6 190 1 200) :duration dur :scaler (hz->radians 1.0)))
- (tri1 (make-triangle-wave 75 .75))
- (rnd (make-rand-interp 2000))
- (rndf (make-env '(0 .1 .3 1 .35 .1 .4 .01 .55 .01 .6 1 .65 .01 1 .01) :duration dur :scaler (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((trmf (env tremf))
- (frq (+ (env frqf)
- (* (env rndf) (rand-interp rnd)))))
- (outa i (* (env ampf)
- (+ (- 1.0 trmf) (* trmf (abs (triangle-wave trem))))
- (+ (* (env ampf1) (oscil gen1 frq))
- (* .5 (oscil gen2 (* 2 frq)))
- (* (env ampf3) (oscil gen3 (* 3 frq)))
- (* (env ampf4) (polywave gen4 frq))
- (* (env ampf5) (nrxysin gen5 (* 6 frq)))
- (* (env humf)
- (+ .25 (abs (triangle-wave tri1)))
- (oscil hum (env humfrq)))))))))))
+ (let ((dur 0.33))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.082 0.112 0.207 0.158 0.218 0.089 0.246 0.214 0.278 0.181 .32 .3
+ 0.364 0.944 0.374 1.000 0.384 0.974 0.394 0.757 0.431 0.645 0.584 0.201 0.639 0.688
+ 0.657 0.717 0.714 0.477 0.800 0.319 0.882 0.253 0.902 0.164 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.291 0.311 0.299 0.338 0.299 0.358 0.414 0.395 0.443 0.454 0.455 0.547 0.418
+ 0.596 0.389 0.614 0.414 0.634 0.393 0.682 0.418 0.764 0.426 0.846 0.410 0.874 0.369
+ 0.907 0.352 1.000 0.307)
+ :duration dur :scaler (hz->radians (* 0.5 3600))))
+ (gen1 (make-oscil))
+ (ampf1 (make-env '(0 .1 .5 .2 .6 1 .65 .3 1 1) :duration dur :scaler .3))
+ (gen2 (make-oscil))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 .1 .3 .2 .4 1 1 1) :duration dur :scaler .1))
+ (gen4 (make-polywave 0.0 '(4 .8 5 .2)))
+ (ampf4 (make-env '(0 0 .3 0 .4 1 .9 1 1 0) :duration dur :scaler .05))
+ (gen5 (make-nrxysin :n 12 :r .7 :ratio 1/6))
+ (ampf5 (make-env '(0 0 .3 0 .4 1 .5 .1 .55 0 .6 .1 .63 1 .85 0 1 0) :duration dur :scaler .3))
+ (trem (make-triangle-wave (* 0.5 170)))
+ (tremf (make-env '(0 1 .3 1 .35 .1 .6 .2 .65 1 .7 .2 1 .2) :duration dur))
+ (tremf-1 (make-env '(0 1 .3 1 .35 .1 .6 .2 .65 1 .7 .2 1 .2) :duration dur :offset 1.0 :scaler -1.0))
+ (hum (make-oscil))
+ (humf (make-env '(0 .5 .45 .4 .5 1 .6 .5 .7 0 1 0) :duration dur :scaler .2))
+ (humfrq (make-env '(0 150 .6 190 1 200) :duration dur :scaler (hz->radians 1.0)))
+ (tri1 (make-triangle-wave 75 .75))
+ (rnd (make-rand-interp 2000))
+ (rndf (make-env '(0 .1 .3 1 .35 .1 .4 .01 .55 .01 .6 1 .65 .01 1 .01) :duration dur :scaler (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env rndf) (rand-interp rnd)))))
+ (outa i (* (env ampf)
+ (+ (env tremf-1)
+ (* (env tremf) (abs (triangle-wave trem))))
+ (+ (* (env ampf1) (oscil gen1 frq))
+ (* .5 (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3) (oscil gen3 (* 3.0 frq)))
+ (+ (* (env ampf4) (polywave gen4 frq))
+ (* (env ampf5) (nrxysin gen5 (* 6.0 frq)))
+ (* (env humf)
+ (+ .25 (abs (triangle-wave tri1)))
+ (oscil hum (env humfrq))))))))))))
(define (canada-goose beg1 amp1)
(canada-goose-1 beg1 amp1)
@@ -10036,47 +10009,48 @@
;; (with-sound (:play #t) (canada-goose 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Pine warbler
-(definstrument (pine-warbler beg amp)
+(defanimal (pine-warbler beg amp)
;; east 21 3
(let ((call-ampf (make-env '(0 .05 1 .2 3 .8 5 1 10 1 16 .4) :length 16))
(call-frqf (make-env '(0 1.1 4 1.0 13 .98 15 1.0) :length 16)))
- (do ((call 0 (+ 1 call)))
+ (do ((call 0 (+ call 1)))
((= call 16))
- (let* ((start (seconds->samples (+ beg (* call .115) (random .01))))
- (dur (+ .105 (random .01)))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.147 0.356 0.216 0.403 0.257 0.135 0.310 0.000 0.347 0.000 0.447 0.468
- 0.474 0.694 0.489 0.656 0.500 0.729 0.514 0.632 0.529 0.815 0.562 0.644 0.578 0.809
- 0.590 0.626 0.602 0.982 0.621 0.765 0.629 0.950 0.639 0.829 0.648 0.982 0.662 0.818
- 0.669 0.644 0.675 0.824 0.685 0.932 0.699 0.579 0.706 0.353 0.723 0.800 0.737 1.000
- 0.753 0.959 0.765 0.529 0.773 0.638 0.781 0.971 0.790 0.941 0.798 0.547 0.803 0.591
- 0.808 0.806 0.822 0.832 0.833 0.124 0.839 0.415 0.874 0.132 0.887 0.206 0.923 0.062
- 0.933 0.174 0.939 0.091 0.948 0.159 0.960 0.079 0.967 0.176 0.981 0.062 1.000 0.000)
- :duration dur :scaler (* amp (env call-ampf))))
- (frqf (make-env '(0.000 0.118 0.056 0.132 0.133 0.146 0.190 0.148 0.233 0.134 0.261 0.132 0.288 0.137
- 0.311 0.154 0.332 0.176 0.365 0.151 0.415 0.151 0.477 0.164 0.526 0.171 0.636 0.199
- 0.730 0.204 0.855 0.221 0.962 0.218 1.000 0.199)
- :duration dur :scaler (hz->radians (* 22000.0 (env call-frqf)))))
- (gen1 (make-oscil))
- (gen2 (make-polywave :partials (list 2 .005 3 .03 4 .003)))
- (ampf2 (make-env '(0 0 .3 0 .4 1 1 1) :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* .97 (oscil gen1 frq))
- (* (env ampf2)
- (polywave gen2 frq))))))))))))
+ (let ((start (seconds->samples (+ beg (* call .115) (random .01))))
+ (dur (+ .105 (random .01))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.147 0.356 0.216 0.403 0.257 0.135 0.310 0.000 0.347 0.000 0.447 0.468
+ 0.474 0.694 0.489 0.656 0.500 0.729 0.514 0.632 0.529 0.815 0.562 0.644 0.578 0.809
+ 0.590 0.626 0.602 0.982 0.621 0.765 0.629 0.950 0.639 0.829 0.648 0.982 0.662 0.818
+ 0.669 0.644 0.675 0.824 0.685 0.932 0.699 0.579 0.706 0.353 0.723 0.800 0.737 1.000
+ 0.753 0.959 0.765 0.529 0.773 0.638 0.781 0.971 0.790 0.941 0.798 0.547 0.803 0.591
+ 0.808 0.806 0.822 0.832 0.833 0.124 0.839 0.415 0.874 0.132 0.887 0.206 0.923 0.062
+ 0.933 0.174 0.939 0.091 0.948 0.159 0.960 0.079 0.967 0.176 0.981 0.062 1.000 0.000)
+ :duration dur :scaler (* amp (env call-ampf))))
+ (frqf (make-env '(0.000 0.118 0.056 0.132 0.133 0.146 0.190 0.148 0.233 0.134 0.261 0.132 0.288 0.137
+ 0.311 0.154 0.332 0.176 0.365 0.151 0.415 0.151 0.477 0.164 0.526 0.171 0.636 0.199
+ 0.730 0.204 0.855 0.221 0.962 0.218 1.000 0.199)
+ :duration dur :scaler (hz->radians (* 22000.0 (env call-frqf)))))
+ (gen1 (make-polywave 0.0 '(1 .97)))
+ (gen2 (make-polywave 0.0 '(2 .005 3 .03 4 .003)))
+ (ampf2 (make-env '(0 0 .3 0 .4 1 1 1) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (polywave gen1 frq)
+ (* (env ampf2)
+ (polywave gen2 frq))))))))))))
;; (with-sound (:play #t) (pine-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Black-throated sparrow
@@ -10084,136 +10058,132 @@
(define (black-throated-sparrow beg1 amp1)
;; south 85 2
- (definstrument (black-throated-sparrow-1 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .034)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.057 0.806 0.073 0.857 0.111 0.783 0.139 0.988 0.216 0.817 0.235 0.574
- 0.324 0.333 0.473 0.216 0.725 0.679 0.805 0.649 0.887 0.484 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.301 0.059 0.288 0.090 0.281 0.123 0.286 0.149 0.299 0.189 0.303 0.250 0.299
- 0.341 0.292 0.568 0.296 0.746 0.299 1.000 0.296)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .007 3 .003))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (black-throated-sparrow-2 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .11)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.026 0.514 0.080 0.667 0.120 0.618 0.183 0.000 0.223 0.000 0.260 0.913
- 0.281 0.977 0.311 0.895 0.343 0.631 0.399 0.000 0.444 0.000 0.504 0.130 0.514 0.070
- 0.533 0.173 0.567 0.128 0.576 0.217 0.587 0.202 0.596 0.117 0.613 0.171 0.640 0.104
- 0.654 0.166 0.677 0.087 0.729 0.000 0.820 0.000 0.844 0.940 0.865 1.000 0.909 0.927
- 0.968 0.499 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.176 0.167 0.176 0.196 0.158 0.246 0.160 0.272 0.174 0.407 0.169 0.487 0.093
- 0.504 0.117 0.518 0.093 0.543 0.117 0.562 0.093 0.579 0.117 0.599 0.093 0.615 0.113
- 0.635 0.090 0.656 0.115 0.671 0.088 0.689 0.111 0.705 0.088 0.809 0.172 0.835 0.176 1.000 0.176)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .007 3 .003))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (definstrument (black-throated-sparrow-3 beg amp)
- (let* ((start (seconds->samples beg))
- (dur .153)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.099 0.442 0.124 0.456 0.146 0.372 0.164 0.203 0.243 0.061 0.257 0.352
- 0.294 0.433 0.371 0.221 0.380 0.000 0.525 0.000 0.552 0.138 0.559 0.068 0.579 0.314
- 0.595 0.074 0.621 0.643 0.636 0.738 0.649 0.542 0.660 0.147 0.670 0.853 0.681 0.986
- 0.690 0.941 0.717 0.149 0.728 0.862 0.743 0.995 0.751 0.950 0.777 0.149 0.790 0.853
- 0.799 0.901 0.805 0.840 0.825 0.056 0.835 0.609 0.851 0.822 0.858 0.795 0.873 0.061
- 0.885 0.738 0.894 0.813 0.903 0.745 0.919 0.097 0.925 0.438 0.945 0.591 0.957 0.149
- 0.971 0.289 0.985 0.065 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.192 0.090 0.195 0.119 0.197 0.156 0.211 0.163 0.142 0.242 0.128 0.254 0.211
- 0.276 0.178 0.326 0.169 0.355 0.169 0.379 0.181 0.542 0.238 0.563 0.247 0.586 0.240
- 0.618 0.245 0.640 0.238 0.664 0.247 0.690 0.240 0.721 0.240 0.748 0.233 0.782 0.243
- 0.809 0.238 0.832 0.243 0.858 0.233 0.880 0.245 0.903 0.233 0.923 0.245 0.944 0.238 1.000 0.240)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave :partials (list 1 .99 2 .007 3 .003))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
+ (defanimal (black-throated-sparrow-1 beg amp)
+ (let ((dur .034))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.057 0.806 0.073 0.857 0.111 0.783 0.139 0.988 0.216 0.817 0.235 0.574
+ 0.324 0.333 0.473 0.216 0.725 0.679 0.805 0.649 0.887 0.484 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.301 0.059 0.288 0.090 0.281 0.123 0.286 0.149 0.299 0.189 0.303 0.250 0.299
+ 0.341 0.292 0.568 0.296 0.746 0.299 1.000 0.296)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .007 3 .003))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (black-throated-sparrow-2 beg amp)
+ (let ((dur .11))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.026 0.514 0.080 0.667 0.120 0.618 0.183 0.000 0.223 0.000 0.260 0.913
+ 0.281 0.977 0.311 0.895 0.343 0.631 0.399 0.000 0.444 0.000 0.504 0.130 0.514 0.070
+ 0.533 0.173 0.567 0.128 0.576 0.217 0.587 0.202 0.596 0.117 0.613 0.171 0.640 0.104
+ 0.654 0.166 0.677 0.087 0.729 0.000 0.820 0.000 0.844 0.940 0.865 1.000 0.909 0.927
+ 0.968 0.499 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.176 0.167 0.176 0.196 0.158 0.246 0.160 0.272 0.174 0.407 0.169 0.487 0.093
+ 0.504 0.117 0.518 0.093 0.543 0.117 0.562 0.093 0.579 0.117 0.599 0.093 0.615 0.113
+ 0.635 0.090 0.656 0.115 0.671 0.088 0.689 0.111 0.705 0.088 0.809 0.172 0.835 0.176 1.000 0.176)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .007 3 .003))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
+
+ (defanimal (black-throated-sparrow-3 beg amp)
+ (let ((dur .153))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.099 0.442 0.124 0.456 0.146 0.372 0.164 0.203 0.243 0.061 0.257 0.352
+ 0.294 0.433 0.371 0.221 0.380 0.000 0.525 0.000 0.552 0.138 0.559 0.068 0.579 0.314
+ 0.595 0.074 0.621 0.643 0.636 0.738 0.649 0.542 0.660 0.147 0.670 0.853 0.681 0.986
+ 0.690 0.941 0.717 0.149 0.728 0.862 0.743 0.995 0.751 0.950 0.777 0.149 0.790 0.853
+ 0.799 0.901 0.805 0.840 0.825 0.056 0.835 0.609 0.851 0.822 0.858 0.795 0.873 0.061
+ 0.885 0.738 0.894 0.813 0.903 0.745 0.919 0.097 0.925 0.438 0.945 0.591 0.957 0.149
+ 0.971 0.289 0.985 0.065 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.192 0.090 0.195 0.119 0.197 0.156 0.211 0.163 0.142 0.242 0.128 0.254 0.211
+ 0.276 0.178 0.326 0.169 0.355 0.169 0.379 0.181 0.542 0.238 0.563 0.247 0.586 0.240
+ 0.618 0.245 0.640 0.238 0.664 0.247 0.690 0.240 0.721 0.240 0.748 0.233 0.782 0.243
+ 0.809 0.238 0.832 0.243 0.858 0.233 0.880 0.245 0.903 0.233 0.923 0.245 0.944 0.238 1.000 0.240)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .007 3 .003))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
(black-throated-sparrow-3 beg1 (* .4 amp1))
(let ((ampf (make-env '(0 .4 5 1.0 7 .9) :length 7)))
- (do ((call 0 (+ 1 call)))
+ (do ((call 0 (+ call 1)))
((= call 7))
(black-throated-sparrow-1 (+ beg1 .2 (* call .042) (random .003)) (* amp1 (env ampf)))))
- (do ((call 0 (+ 1 call)))
+ (do ((call 0 (+ call 1)))
((= call 3))
(black-throated-sparrow-2 (+ beg1 .53 (* call .134)) (* 0.6 amp1))))
;; (with-sound (:play #t) (black-throated-sparrow 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Cape May warbler
-(definstrument (cape-may-warbler beg amp)
+(defanimal (cape-may-warbler beg amp)
;; east 14 2
;; note #1
- (let* ((start (seconds->samples beg))
- (dur 0.234)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.115 0.517 0.170 0.326 0.214 0.400 0.272 0.397 0.298 0.289 0.486 0.674
- 0.529 0.564 0.537 0.744 0.554 0.605 0.570 0.871 0.617 0.637 0.646 0.986 0.664 0.857
- 0.675 1.000 0.697 0.279 0.713 0.626 0.756 0.522 0.772 0.342 0.792 0.600 0.813 0.319
- 0.825 0.667 0.856 0.330 0.864 0.642 0.890 0.568 0.899 0.242 0.920 0.573 0.983 0.323 1.000 0.000)
- :duration dur :scaler (* .2 amp)))
- (frqf (make-env '(0.000 0.357 0.070 0.364 0.119 0.362 0.246 0.378 0.318 0.380 0.397 0.387 0.538 0.398
- 0.628 0.416 0.733 0.430 0.811 0.437 0.852 0.443 0.912 0.441 1.000 0.441)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-oscil)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (env frqf)))))))
+ (let ((dur 0.234))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.115 0.517 0.170 0.326 0.214 0.400 0.272 0.397 0.298 0.289 0.486 0.674
+ 0.529 0.564 0.537 0.744 0.554 0.605 0.570 0.871 0.617 0.637 0.646 0.986 0.664 0.857
+ 0.675 1.000 0.697 0.279 0.713 0.626 0.756 0.522 0.772 0.342 0.792 0.600 0.813 0.319
+ 0.825 0.667 0.856 0.330 0.864 0.642 0.890 0.568 0.899 0.242 0.920 0.573 0.983 0.323 1.000 0.000)
+ :duration dur :scaler (* .2 amp)))
+ (frqf (make-env '(0.000 0.357 0.070 0.364 0.119 0.362 0.246 0.378 0.318 0.380 0.397 0.387 0.538 0.398
+ 0.628 0.416 0.733 0.430 0.811 0.437 0.852 0.443 0.912 0.441 1.000 0.441)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-oscil)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (env frqf)))))))
;; next 4 notes
- (let* ((begs (vct 0.31 0.61 0.86 1.11))
- (durs (vct 0.23 0.19 0.18 0.18))
- (amps (vct 0.6 0.95 1.0 0.8))
- (ampenv '(0.000 0.000 0.081 0.593 0.118 0.676 0.139 0.952 0.174 1.000 0.198 0.762 0.255 0.701 0.276 0.824
- 0.316 0.572 0.372 0.794 0.411 0.572 0.506 0.663 0.550 0.514 0.582 0.622 0.633 0.337 0.653 0.520
- 0.685 0.536 0.700 0.389 0.780 0.462 0.796 0.267 0.804 0.380 0.814 0.231 0.832 0.330 0.895 0.310
- 0.942 0.238 1.000 0.000))
- (frqenv '(0.000 0.326 0.102 0.344 0.182 0.351 0.269 0.360 0.352 0.373 0.503 0.382 0.614 0.394 0.730 0.410
- 0.833 0.423 1.000 0.434))
- (gen1 (make-oscil)))
- (do ((call 0 (+ 1 call)))
+ (let ((begs (vector 0.31 0.61 0.86 1.11))
+ (durs (vector 0.23 0.19 0.18 0.18))
+ (amps (vector 0.6 0.95 1.0 0.8))
+ (ampenv '(0.000 0.000 0.081 0.593 0.118 0.676 0.139 0.952 0.174 1.000 0.198 0.762 0.255 0.701 0.276 0.824
+ 0.316 0.572 0.372 0.794 0.411 0.572 0.506 0.663 0.550 0.514 0.582 0.622 0.633 0.337 0.653 0.520
+ 0.685 0.536 0.700 0.389 0.780 0.462 0.796 0.267 0.804 0.380 0.814 0.231 0.832 0.330 0.895 0.310
+ 0.942 0.238 1.000 0.000))
+ (frqenv '(0.000 0.326 0.102 0.344 0.182 0.351 0.269 0.360 0.352 0.373 0.503 0.382 0.614 0.394 0.730 0.410
+ 0.833 0.423 1.000 0.434))
+ (gen1 (make-oscil)))
+ (do ((call 0 (+ call 1)))
((= call 4))
- (let* ((start (seconds->samples (+ beg (begs call))))
- (dur (durs call))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env ampenv :duration dur :scaler (* amp (amps call))))
- (frqf (make-env frqenv :duration dur :scaler (hz->radians 22000))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (oscil gen1 (env frqf))))))))))
+ (let ((start (seconds->samples (+ beg (begs call))))
+ (dur (durs call)))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env ampenv :duration dur :scaler (* amp (amps call))))
+ (frqf (make-env frqenv :duration dur :scaler (hz->radians 22000))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (oscil gen1 (env frqf))))))))))
;; (with-sound (:play #t) (cape-may-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Kirtland's warbler
@@ -10221,78 +10191,77 @@
(define (kirtlands-warbler beg1 amp1)
;; east 22 3
- (definstrument (kirtlands-warbler-1 beg dur frqscl frqenv ampscl ampenv)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env ampenv :duration dur :scaler ampscl))
- (frqf (make-env frqenv :duration dur :scaler (hz->radians frqscl)))
- (gen1 (make-polywave :partials (normalize-partials (list 1 1.0 2 .08 3 .1 4 .03 5 .05)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
-
- (let* ((begs (vct 0.0 0.25 0.47 0.65 0.79 0.99 1.17 1.33))
- (durs (vct 0.05 0.05 0.06 0.07 0.14 0.14 0.12 0.11))
- (amps (vct 0.04 0.6 0.8 0.80 1.0 0.94 0.92 0.75))
- (frqs (vct 6020 6020 13370 13360 13360 13360 13360 13360))
-
- (ampenvs (vector '(0.000 0.000 0.063 0.289 0.098 0.838 0.139 0.960 0.217 0.213 0.389 0.115 0.484 0.775
- 0.524 0.530 0.546 0.842 0.587 0.375 0.630 0.909 0.739 0.613 0.764 0.320 0.829 0.443
- 0.910 0.356 0.929 0.162 1.000 0.000)
- '(0.000 0.000 0.049 0.166 0.083 0.204 0.111 0.348 0.149 0.271 0.190 0.665 0.238 0.671
- 0.303 0.477 0.390 0.032 0.570 0.026 0.614 0.277 0.643 0.591 0.664 0.527 0.695 0.785
- 0.732 0.492 0.767 0.856 0.809 0.933 0.853 0.576 0.907 0.346 0.960 0.140 1.000 0.000)
- '(0.000 0.000 0.097 0.340 0.127 0.181 0.157 0.578 0.185 0.426 0.234 0.718 0.267 0.624
- 0.300 0.613 0.416 0.041 0.506 0.034 0.554 0.232 0.575 0.561 0.609 0.318 0.651 0.865
- 0.696 0.884 0.763 0.763 0.821 0.533 0.862 0.340 0.919 0.148 1.000 0.000)
- '(0.000 0.000 0.077 0.052 0.138 0.196 0.159 0.368 0.178 0.067 0.210 0.589 0.224 0.256
- 0.251 0.658 0.286 0.529 0.324 0.751 0.345 0.578 0.374 0.477 0.453 0.043 0.524 0.043
- 0.595 0.413 0.609 0.258 0.635 0.333 0.654 0.667 0.685 0.852 0.703 0.871 0.725 0.789
- 0.748 0.837 0.813 0.602 0.845 0.329 0.904 0.110 1.000 0.000)
- '(0.000 0.000 0.063 0.075 0.109 0.275 0.125 0.262 0.135 0.146 0.166 0.523 0.184 0.503
- 0.194 0.157 0.203 0.477 0.231 0.725 0.263 0.804 0.282 0.613 0.350 0.561 0.387 0.295
- 0.442 0.060 0.489 0.054 0.545 0.303 0.562 0.140 0.632 0.583 0.669 0.594 0.705 0.923
- 0.813 0.540 0.857 0.118 0.921 0.039 1.000 0.000)
- '(0.000 0.000 0.085 0.308 0.096 0.153 0.143 0.477 0.154 0.239 0.161 0.443 0.196 0.755
- 0.264 0.903 0.282 0.804 0.315 0.796 0.357 0.325 0.407 0.047 0.469 0.049 0.519 0.310
- 0.543 0.159 0.552 0.480 0.657 0.908 0.769 0.570 0.828 0.142 0.882 0.071 1.000 0.000)
- '(0.000 0.000 0.315 0.112 0.450 0.310 0.710 0.963 0.805 0.862 0.913 0.460 0.952 0.099
- 1.000 0.000)
- '(0.000 0.000 0.264 0.138 0.326 0.135 0.510 0.688 0.621 0.766 0.656 0.768 0.697 0.923
- 0.717 0.809 0.743 0.892 0.824 0.871 0.877 0.725 1.000 0.000)))
-
- (frqenvs (vector '(0.000 0.314 0.074 0.394 0.101 0.462 0.127 0.486 0.157 0.458 0.178 0.372 0.243 0.310
- 0.348 0.299 0.425 0.323 0.463 0.413 0.496 0.505 0.522 0.533 0.552 0.492 0.567 0.415
- 0.597 0.389 0.633 0.426 0.654 0.486 0.686 0.495 0.732 0.389 0.820 0.344 1.000 0.314)
- '(0.000 0.394 0.044 0.458 0.059 0.578 0.085 0.606 0.113 0.542 0.125 0.475 0.150 0.462
- 0.182 0.518 0.210 0.551 0.238 0.516 0.266 0.465 0.305 0.411 0.356 0.381 0.428 0.323
- 0.508 0.312 0.588 0.348 0.628 0.426 0.646 0.499 0.669 0.525 0.695 0.510 0.713 0.469
- 0.736 0.454 0.761 0.480 0.793 0.512 0.824 0.480 0.863 0.415 0.934 0.387 1.000 0.340)
- '(0.000 0.204 0.027 0.258 0.053 0.267 0.077 0.224 0.096 0.196 0.119 0.222 0.136 0.252
- 0.160 0.265 0.183 0.247 0.211 0.224 0.250 0.200 0.304 0.191 0.387 0.157 0.441 0.146
- 0.494 0.168 0.528 0.178 0.548 0.206 0.564 0.243 0.584 0.265 0.609 0.245 0.646 0.217
- 0.695 0.228 0.744 0.204 0.771 0.194 0.799 0.194 0.879 0.163 1.000 0.144)
- '(0.000 0.202 0.138 0.204 0.162 0.273 0.186 0.314 0.201 0.273 0.211 0.237 0.229 0.224
- 0.252 0.239 0.275 0.260 0.303 0.239 0.332 0.209 0.392 0.185 0.434 0.161 0.490 0.144
- 0.547 0.170 0.588 0.198 0.600 0.239 0.624 0.265 0.650 0.241 0.677 0.228 0.716 0.245
- 0.752 0.219 0.801 0.198 1.000 0.140)
- '(0.000 0.161 0.050 0.163 0.075 0.237 0.095 0.363 0.119 0.398 0.160 0.396 0.190 0.391
- 0.207 0.363 0.240 0.323 0.263 0.303 0.292 0.258 0.320 0.241 0.376 0.228 0.430 0.224
- 0.466 0.247 0.481 0.327 0.498 0.381 0.530 0.398 0.570 0.385 0.599 0.359 0.659 0.329
- 0.701 0.286 0.765 0.219 0.822 0.191 0.857 0.168 0.899 0.151 1.000 0.135)
- '(0.000 0.245 0.021 0.353 0.047 0.402 0.087 0.406 0.122 0.381 0.147 0.353 0.180 0.329
- 0.222 0.267 0.263 0.247 0.360 0.228 0.382 0.243 0.404 0.226 0.422 0.222 0.438 0.241
- 0.463 0.314 0.488 0.376 0.521 0.387 0.553 0.381 0.570 0.361 0.599 0.353 0.622 0.329
- 0.656 0.312 0.689 0.286 0.769 0.213 0.813 0.194 0.857 0.170 1.000 0.142)
- '(0.000 0.110 0.160 0.138 0.284 0.159 0.389 0.172 0.504 0.196 0.555 0.215 0.628 0.239
- 0.693 0.256 0.744 0.277 0.796 0.286 0.828 0.308 0.867 0.299 0.894 0.305 0.922 0.297
- 1.000 0.267)
- '(0.000 0.123 0.079 0.148 0.131 0.153 0.274 0.168 0.340 0.170 0.432 0.194 0.494 0.200
- 0.520 0.215 0.595 0.219 0.628 0.241 0.675 0.245 0.752 0.273 0.864 0.310 0.898 0.297
- 0.930 0.292 0.964 0.269 1.000 0.247))))
- (do ((call 0 (+ 1 call)))
+ (defanimal (kirtlands-warbler-1 beg dur frqscl frqenv ampscl ampenv)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env ampenv :duration dur :scaler ampscl))
+ (frqf (make-env frqenv :duration dur :scaler (hz->radians frqscl)))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 1.0 2 .08 3 .1 4 .03 5 .05)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
+
+ (let ((begs (vector 0.0 0.25 0.47 0.65 0.79 0.99 1.17 1.33))
+ (durs (vector 0.05 0.05 0.06 0.07 0.14 0.14 0.12 0.11))
+ (amps (vector 0.04 0.6 0.8 0.80 1.0 0.94 0.92 0.75))
+ (frqs (vector 6020 6020 13370 13360 13360 13360 13360 13360))
+
+ (ampenvs (vector '(0.000 0.000 0.063 0.289 0.098 0.838 0.139 0.960 0.217 0.213 0.389 0.115 0.484 0.775
+ 0.524 0.530 0.546 0.842 0.587 0.375 0.630 0.909 0.739 0.613 0.764 0.320 0.829 0.443
+ 0.910 0.356 0.929 0.162 1.000 0.000)
+ '(0.000 0.000 0.049 0.166 0.083 0.204 0.111 0.348 0.149 0.271 0.190 0.665 0.238 0.671
+ 0.303 0.477 0.390 0.032 0.570 0.026 0.614 0.277 0.643 0.591 0.664 0.527 0.695 0.785
+ 0.732 0.492 0.767 0.856 0.809 0.933 0.853 0.576 0.907 0.346 0.960 0.140 1.000 0.000)
+ '(0.000 0.000 0.097 0.340 0.127 0.181 0.157 0.578 0.185 0.426 0.234 0.718 0.267 0.624
+ 0.300 0.613 0.416 0.041 0.506 0.034 0.554 0.232 0.575 0.561 0.609 0.318 0.651 0.865
+ 0.696 0.884 0.763 0.763 0.821 0.533 0.862 0.340 0.919 0.148 1.000 0.000)
+ '(0.000 0.000 0.077 0.052 0.138 0.196 0.159 0.368 0.178 0.067 0.210 0.589 0.224 0.256
+ 0.251 0.658 0.286 0.529 0.324 0.751 0.345 0.578 0.374 0.477 0.453 0.043 0.524 0.043
+ 0.595 0.413 0.609 0.258 0.635 0.333 0.654 0.667 0.685 0.852 0.703 0.871 0.725 0.789
+ 0.748 0.837 0.813 0.602 0.845 0.329 0.904 0.110 1.000 0.000)
+ '(0.000 0.000 0.063 0.075 0.109 0.275 0.125 0.262 0.135 0.146 0.166 0.523 0.184 0.503
+ 0.194 0.157 0.203 0.477 0.231 0.725 0.263 0.804 0.282 0.613 0.350 0.561 0.387 0.295
+ 0.442 0.060 0.489 0.054 0.545 0.303 0.562 0.140 0.632 0.583 0.669 0.594 0.705 0.923
+ 0.813 0.540 0.857 0.118 0.921 0.039 1.000 0.000)
+ '(0.000 0.000 0.085 0.308 0.096 0.153 0.143 0.477 0.154 0.239 0.161 0.443 0.196 0.755
+ 0.264 0.903 0.282 0.804 0.315 0.796 0.357 0.325 0.407 0.047 0.469 0.049 0.519 0.310
+ 0.543 0.159 0.552 0.480 0.657 0.908 0.769 0.570 0.828 0.142 0.882 0.071 1.000 0.000)
+ '(0.000 0.000 0.315 0.112 0.450 0.310 0.710 0.963 0.805 0.862 0.913 0.460 0.952 0.099
+ 1.000 0.000)
+ '(0.000 0.000 0.264 0.138 0.326 0.135 0.510 0.688 0.621 0.766 0.656 0.768 0.697 0.923
+ 0.717 0.809 0.743 0.892 0.824 0.871 0.877 0.725 1.000 0.000)))
+
+ (frqenvs (vector '(0.000 0.314 0.074 0.394 0.101 0.462 0.127 0.486 0.157 0.458 0.178 0.372 0.243 0.310
+ 0.348 0.299 0.425 0.323 0.463 0.413 0.496 0.505 0.522 0.533 0.552 0.492 0.567 0.415
+ 0.597 0.389 0.633 0.426 0.654 0.486 0.686 0.495 0.732 0.389 0.820 0.344 1.000 0.314)
+ '(0.000 0.394 0.044 0.458 0.059 0.578 0.085 0.606 0.113 0.542 0.125 0.475 0.150 0.462
+ 0.182 0.518 0.210 0.551 0.238 0.516 0.266 0.465 0.305 0.411 0.356 0.381 0.428 0.323
+ 0.508 0.312 0.588 0.348 0.628 0.426 0.646 0.499 0.669 0.525 0.695 0.510 0.713 0.469
+ 0.736 0.454 0.761 0.480 0.793 0.512 0.824 0.480 0.863 0.415 0.934 0.387 1.000 0.340)
+ '(0.000 0.204 0.027 0.258 0.053 0.267 0.077 0.224 0.096 0.196 0.119 0.222 0.136 0.252
+ 0.160 0.265 0.183 0.247 0.211 0.224 0.250 0.200 0.304 0.191 0.387 0.157 0.441 0.146
+ 0.494 0.168 0.528 0.178 0.548 0.206 0.564 0.243 0.584 0.265 0.609 0.245 0.646 0.217
+ 0.695 0.228 0.744 0.204 0.771 0.194 0.799 0.194 0.879 0.163 1.000 0.144)
+ '(0.000 0.202 0.138 0.204 0.162 0.273 0.186 0.314 0.201 0.273 0.211 0.237 0.229 0.224
+ 0.252 0.239 0.275 0.260 0.303 0.239 0.332 0.209 0.392 0.185 0.434 0.161 0.490 0.144
+ 0.547 0.170 0.588 0.198 0.600 0.239 0.624 0.265 0.650 0.241 0.677 0.228 0.716 0.245
+ 0.752 0.219 0.801 0.198 1.000 0.140)
+ '(0.000 0.161 0.050 0.163 0.075 0.237 0.095 0.363 0.119 0.398 0.160 0.396 0.190 0.391
+ 0.207 0.363 0.240 0.323 0.263 0.303 0.292 0.258 0.320 0.241 0.376 0.228 0.430 0.224
+ 0.466 0.247 0.481 0.327 0.498 0.381 0.530 0.398 0.570 0.385 0.599 0.359 0.659 0.329
+ 0.701 0.286 0.765 0.219 0.822 0.191 0.857 0.168 0.899 0.151 1.000 0.135)
+ '(0.000 0.245 0.021 0.353 0.047 0.402 0.087 0.406 0.122 0.381 0.147 0.353 0.180 0.329
+ 0.222 0.267 0.263 0.247 0.360 0.228 0.382 0.243 0.404 0.226 0.422 0.222 0.438 0.241
+ 0.463 0.314 0.488 0.376 0.521 0.387 0.553 0.381 0.570 0.361 0.599 0.353 0.622 0.329
+ 0.656 0.312 0.689 0.286 0.769 0.213 0.813 0.194 0.857 0.170 1.000 0.142)
+ '(0.000 0.110 0.160 0.138 0.284 0.159 0.389 0.172 0.504 0.196 0.555 0.215 0.628 0.239
+ 0.693 0.256 0.744 0.277 0.796 0.286 0.828 0.308 0.867 0.299 0.894 0.305 0.922 0.297
+ 1.000 0.267)
+ '(0.000 0.123 0.079 0.148 0.131 0.153 0.274 0.168 0.340 0.170 0.432 0.194 0.494 0.200
+ 0.520 0.215 0.595 0.219 0.628 0.241 0.675 0.245 0.752 0.273 0.864 0.310 0.898 0.297
+ 0.930 0.292 0.964 0.269 1.000 0.247))))
+ (do ((call 0 (+ call 1)))
((= call 8))
(kirtlands-warbler-1 (+ beg1 (begs call))
(durs call)
@@ -10304,322 +10273,314 @@
;; (with-sound (:play #t) (kirtlands-warbler 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Wood duck
;;;
;;; reverb in original makes this hard to match
-(definstrument (wood-duck beg amp)
+(defanimal (wood-duck beg amp)
;; east 22 19
- (let* ((start (seconds->samples beg))
- (dur 0.75)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.022 0.070 0.027 0.433 0.041 0.441 0.047 0.256 .06 .1 0.088 0.888 0.1 0
- 0.115 0.692 0.120 0.266 0.132 0.379 0.149 0.277 0.166 0.360 0.174 0.269 0.203 0.386
- 0.219 0.295 0.269 0.413 0.316 0.287 0.338 0.428 0.354 0.292 0.369 0.397 0.424 0.290
- 0.476 0.368 0.52 .01 0.53 0.029 0.58 0.916 0.634 0.875 0.657 0.781 0.682 1.000
- 0.718 0.961 0.734 0.705 0.761 0.864 0.785 0.841 0.830 0.606 0.85 0.454 0.87 0.0
- .88 0.0 0.919 0.292 0.966 0.240 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.110 0.029 0.174 0.048 0.232 0.075 0.256 0.096 0.238 0.120 0.191 0.199 0.168
- 0.272 0.168 0.369 0.186 0.522 0.226 0.528 0.368 0.539 0.345 0.714 0.339 0.847 0.328
- 0.879 0.325 0.885 0.200 0.956 0.157 1.000 0.122)
- :duration dur :scaler (hz->radians 4890.0)))
- (gen1 (make-oscil))
- (ampf1 (make-env '(0 .2 .45 .15 .5 .25 .53 1 .85 1 .88 .4 1 .1) :duration dur :scaler .8))
- (gen2 (make-oscil))
- (ampf2 (make-env '(0 1 .1 1 .15 .75 .4 .75 .5 .1 .6 .75 .8 .75 .85 .1 .88 .5 .95 .5 1 .2) :duration dur :scaler .6))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 1 .2 .3 .4 .1 .5 1 .52 1 .7 1 .75 .3 1 .1) :duration dur :scaler .1))
- (gen4 (make-oscil))
- (gen5 (make-oscil))
- (ampf4 (make-env '(0 .2 .4 .05 .5 .2 .55 0 1 0) :duration dur :scaler .1))
-
- (rnd (make-rand-interp 400 (hz->radians 40)))
- (rndf (make-env '(0 0 .05 4 .1 .5 .9 .1 1 1) :duration dur))
-
- (rnd1 (make-rand-interp 500 .1))
-
- (att (make-polywave :partials (list 3 .3 5 .5 7 .1 9 .1)))
- (attf (make-env '(0 0 .05 1 .1 0 1 0) :duration dur :scaler .125)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* (env rndf) (rand-interp rnd)))))
- (outa i (* (env ampf)
- (+ .9 (abs (rand-interp rnd1)))
- (+ (* (env attf) (polywave att (* 0.5 frq)))
- (* (env ampf1) (oscil gen1 frq))
- (* (env ampf2) (oscil gen2 (* 2 frq)))
- (* (env ampf3) (oscil gen3 (* 3 frq)))
- (* (env ampf4) (+ (oscil gen4 (* 4 frq))
- (oscil gen5 (* 5 frq))))))))))))
+ (let ((dur 0.75))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.022 0.070 0.027 0.433 0.041 0.441 0.047 0.256 .06 .1 0.088 0.888 0.1 0
+ 0.115 0.692 0.120 0.266 0.132 0.379 0.149 0.277 0.166 0.360 0.174 0.269 0.203 0.386
+ 0.219 0.295 0.269 0.413 0.316 0.287 0.338 0.428 0.354 0.292 0.369 0.397 0.424 0.290
+ 0.476 0.368 0.52 .01 0.53 0.029 0.58 0.916 0.634 0.875 0.657 0.781 0.682 1.000
+ 0.718 0.961 0.734 0.705 0.761 0.864 0.785 0.841 0.830 0.606 0.85 0.454 0.87 0.0
+ .88 0.0 0.919 0.292 0.966 0.240 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.110 0.029 0.174 0.048 0.232 0.075 0.256 0.096 0.238 0.120 0.191 0.199 0.168
+ 0.272 0.168 0.369 0.186 0.522 0.226 0.528 0.368 0.539 0.345 0.714 0.339 0.847 0.328
+ 0.879 0.325 0.885 0.200 0.956 0.157 1.000 0.122)
+ :duration dur :scaler (hz->radians 4890.0)))
+ (gen1 (make-oscil))
+ (ampf1 (make-env '(0 .2 .45 .15 .5 .25 .53 1 .85 1 .88 .4 1 .1) :duration dur :scaler .8))
+ (gen2 (make-oscil))
+ (ampf2 (make-env '(0 1 .1 1 .15 .75 .4 .75 .5 .1 .6 .75 .8 .75 .85 .1 .88 .5 .95 .5 1 .2) :duration dur :scaler .6))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 1 .2 .3 .4 .1 .5 1 .52 1 .7 1 .75 .3 1 .1) :duration dur :scaler .1))
+ (gen4 (make-oscil))
+ (gen5 (make-oscil))
+ (ampf4 (make-env '(0 .2 .4 .05 .5 .2 .55 0 1 0) :duration dur :scaler .1))
+
+ (rnd (make-rand-interp 400 (hz->radians 40)))
+ (rndf (make-env '(0 0 .05 4 .1 .5 .9 .1 1 1) :duration dur))
+
+ (rnd1 (make-rand-interp 500 .1))
+
+ (att (make-polywave 0.0 '(3 .3 5 .5 7 .1 9 .1)))
+ (attf (make-env '(0 0 .05 1 .1 0 1 0) :duration dur :scaler .125)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (* (env rndf) (rand-interp rnd)))))
+ (outa i (* (env ampf)
+ (+ .9 (abs (rand-interp rnd1)))
+ (+ (* (env attf) (polywave att (* 0.5 frq)))
+ (* (env ampf1) (oscil gen1 frq))
+ (+ (* (env ampf2) (oscil gen2 (* 2.0 frq)))
+ (* (env ampf3) (oscil gen3 (* 3.0 frq)))
+ (* (env ampf4) (+ (oscil gen4 (* 4.0 frq))
+ (oscil gen5 (* 5.0 frq)))))))))))))
;; (with-sound (:play #t) (wood-duck 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; White-eyed vireo
-(definstrument (white-eyed-vireo beg amp)
+(defanimal (white-eyed-vireo beg amp)
;; south 41 2
;; note #1
- (let* ((start (seconds->samples beg))
- (dur 0.1)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.067 0.143 0.150 0.431 0.174 0.392 0.215 0.866 0.243 1.000 0.265 1.000
- 0.309 0.589 0.322 0.742 0.347 1.000 0.371 0.487 0.415 0.617 0.496 0.457 0.546 0.604
- 0.644 0.686 0.677 0.593 0.703 0.721 0.741 0.745 0.757 0.693 0.772 0.500 0.828 0.615
- 0.838 0.766 0.875 0.965 0.897 0.905 0.912 0.461 0.932 0.868 0.952 0.855 1.000 0.000)
- :duration dur :scaler (* .5 amp)))
- (frqf (make-env '(0.000 0.109 0.076 0.131 0.112 0.144 0.155 0.156 0.235 0.193 0.259 0.198 0.287 0.215
- 0.352 0.232 0.382 0.257 0.462 0.270 0.599 0.273 0.748 0.272 0.776 0.262 0.798
- 0.260 0.897 0.227 0.927 0.211 0.960 0.195 1.000 0.191)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave 0.0 (list 1 .99 2 .01 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf) (polywave gen1 (env frqf)))))))
+ (let ((dur 0.1))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.067 0.143 0.150 0.431 0.174 0.392 0.215 0.866 0.243 1.000 0.265 1.000
+ 0.309 0.589 0.322 0.742 0.347 1.000 0.371 0.487 0.415 0.617 0.496 0.457 0.546 0.604
+ 0.644 0.686 0.677 0.593 0.703 0.721 0.741 0.745 0.757 0.693 0.772 0.500 0.828 0.615
+ 0.838 0.766 0.875 0.965 0.897 0.905 0.912 0.461 0.932 0.868 0.952 0.855 1.000 0.000)
+ :duration dur :scaler (* .5 amp)))
+ (frqf (make-env '(0.000 0.109 0.076 0.131 0.112 0.144 0.155 0.156 0.235 0.193 0.259 0.198 0.287 0.215
+ 0.352 0.232 0.382 0.257 0.462 0.270 0.599 0.273 0.748 0.272 0.776 0.262 0.798
+ 0.260 0.897 0.227 0.927 0.211 0.960 0.195 1.000 0.191)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf) (polywave gen1 (env frqf)))))))
;; note #2
- (let* ((start (seconds->samples (+ beg 0.23)))
- (dur 0.046)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.052 0.258 0.111 0.138 0.273 0.508 0.356 0.992 0.419 0.569 0.493 0.547
- 0.584 0.374 0.668 0.629 0.703 0.659 0.732 0.884 0.813 0.077 0.857 0.190 0.913 0.087 1.000 0.000)
- :duration dur :scaler (* .6 amp)))
- (frqf (make-env '(0.000 0.203 0.071 0.200 0.111 0.203 0.134 0.227 0.200 0.238 0.249 0.255 0.329 0.263
- 0.469 0.265 0.627 0.245 0.728 0.233 0.891 0.146 0.948 0.131 1.000 0.144)
- :duration dur :scaler (hz->radians (* 1/3 22000.0))))
- (gen1 (make-polywave :partials (normalize-partials (list 2 1 3 .05 4 .02 5 .005 6 .01 7 .005))))
- (gen2 (make-oscil))
- (ampf2 (make-env '(0 .5 .4 1 .7 1 .8 0 1 0) :duration dur :scaler .05))
- (gen3 (make-oscil))
- (ampf3 (make-env '(0 1 .1 0 1 0) :duration dur :scaler .1)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (+ (* (env ampf2) (oscil gen2 frq))
- (* (env ampf3) (oscil gen3 (* 3 frq)))
- (polywave gen1 frq))))))))
+ (let ((dur 0.046)
+ (start (seconds->samples (+ beg 0.23))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.052 0.258 0.111 0.138 0.273 0.508 0.356 0.992 0.419 0.569 0.493 0.547
+ 0.584 0.374 0.668 0.629 0.703 0.659 0.732 0.884 0.813 0.077 0.857 0.190 0.913 0.087 1.000 0.000)
+ :duration dur :scaler (* .6 amp)))
+ (frqf (make-env '(0.000 0.203 0.071 0.200 0.111 0.203 0.134 0.227 0.200 0.238 0.249 0.255 0.329 0.263
+ 0.469 0.265 0.627 0.245 0.728 0.233 0.891 0.146 0.948 0.131 1.000 0.144)
+ :duration dur :scaler (hz->radians (* 1/3 22000.0))))
+ (gen1 (make-polywave 0.0 (normalize-partials '( 2 1 3 .05 4 .02 5 .005 6 .01 7 .005))))
+ (gen2 (make-oscil))
+ (ampf2 (make-env '(0 .5 .4 1 .7 1 .8 0 1 0) :duration dur :scaler .05))
+ (gen3 (make-oscil))
+ (ampf3 (make-env '(0 1 .1 0 1 0) :duration dur :scaler .1)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (env frqf)))
+ (outa i (* (env ampf)
+ (+ (* (env ampf2) (oscil gen2 frq))
+ (* (env ampf3) (oscil gen3 (* 3.0 frq)))
+ (polywave gen1 frq))))))))
;; note #3
- (let* ((start (seconds->samples (+ beg 0.33)))
- (dur 0.078)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.054 0.208 0.443 0.794 0.762 0.943 0.848 0.901 0.922 0.586 0.967 0.104 1.000 0.000)
- :duration dur :scaler (* 0.3 amp)))
- (frqf (make-env '(0.000 0.111 0.853 0.135 1.000 0.114)
- :duration dur :scaler (hz->radians 22000.0)))
- (gen1 (make-polywave 0.0 (list 1 .95 2 .01 3 .03 4 .01 5 .005 )))
-
- (vib (make-oscil 370))
- (vib-index (hz->radians 300))
- (rnd (make-rand-interp 4000 (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (* vib-index (oscil vib))
- (rand-interp rnd))))
- (outa i (* (env ampf)
- (polywave gen1 frq)))))))
+ (let ((dur 0.078)
+ (start (seconds->samples (+ beg 0.33))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.054 0.208 0.443 0.794 0.762 0.943 0.848 0.901 0.922 0.586 0.967 0.104 1.000 0.000)
+ :duration dur :scaler (* 0.3 amp)))
+ (frqf (make-env '(0.000 0.111 0.853 0.135 1.000 0.114)
+ :duration dur :scaler (hz->radians 22000.0)))
+ (gen1 (make-polywave 0.0 '(1 .95 2 .01 3 .03 4 .01 5 .005 )))
+
+ (vib (make-oscil 370))
+ (vib-index (hz->radians 300))
+ (rnd (make-rand-interp 4000 (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (* vib-index (oscil vib))
+ (rand-interp rnd))))))))
;; note #4
- (let* ((start (seconds->samples (+ beg 0.426)))
- (dur 0.2)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.023 0.147 0.041 0.537 0.063 0.716 0.077 0.179 0.092 0.812 0.121 0.710
- 0.128 0.625 0.163 0.959 0.251 0.161 0.338 0.504 0.355 0.551 0.366 0.689 0.383 0.507
- 0.393 0.845 0.406 0.806 0.410 0.601 0.421 0.815 0.444 0.856 0.456 0.575 0.500 0.742
- 0.510 0.619 0.515 0.408 0.524 0.754 0.537 0.563 0.546 0.331 0.551 0.683 0.564 0.625
- 0.572 0.493 0.580 0.704 0.593 0.639 0.597 0.396 0.604 0.721 0.621 0.551 0.624 0.413
- 0.630 0.660 0.647 0.557 0.650 0.416 0.660 0.707 0.678 0.472 0.685 0.686 0.703 0.496
- 0.716 0.733 0.732 0.575 0.740 0.739 0.750 0.648 0.765 0.762 0.771 0.727 0.777 0.636
- 0.792 0.809 0.806 0.648 0.830 0.845 0.841 0.745 0.875 0.982 0.906 1.000 0.931 0.944
- 0.970 0.645 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.197 0.042 0.463 0.047 0.513 0.060 0.492 0.067 0.553 0.076 0.624 0.086 0.592
- 0.100 0.513 0.135 0.453 0.186 0.411 0.224 0.395 0.250 0.403 0.281 0.368 0.357 0.366
- 0.370 0.397 0.384 0.376 0.396 0.426 0.412 0.400 0.426 0.445 0.440 0.421 0.449 0.476
- 0.463 0.437 0.478 0.497 0.490 0.453 0.503 0.503 0.515 0.447 0.531 0.503 0.545 0.461
- 0.557 0.511 0.569 0.463 0.580 0.516 0.595 0.455 0.608 0.505 0.625 0.455 0.638 0.505
- 0.649 0.455 0.665 0.495 0.679 0.455 0.693 0.500 0.707 0.447 0.721 0.487 0.735 0.455
- 0.750 0.479 0.766 0.453 0.778 0.479 0.793 0.439 0.808 0.461 0.821 0.437 0.837 0.458
- 0.861 0.437 1.000 0.408)
- :duration dur :scaler (hz->radians 7800.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .01 4 .005 5 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf)))))))
+ (let ((dur 0.2)
+ (start (seconds->samples (+ beg 0.426))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.023 0.147 0.041 0.537 0.063 0.716 0.077 0.179 0.092 0.812 0.121 0.710
+ 0.128 0.625 0.163 0.959 0.251 0.161 0.338 0.504 0.355 0.551 0.366 0.689 0.383 0.507
+ 0.393 0.845 0.406 0.806 0.410 0.601 0.421 0.815 0.444 0.856 0.456 0.575 0.500 0.742
+ 0.510 0.619 0.515 0.408 0.524 0.754 0.537 0.563 0.546 0.331 0.551 0.683 0.564 0.625
+ 0.572 0.493 0.580 0.704 0.593 0.639 0.597 0.396 0.604 0.721 0.621 0.551 0.624 0.413
+ 0.630 0.660 0.647 0.557 0.650 0.416 0.660 0.707 0.678 0.472 0.685 0.686 0.703 0.496
+ 0.716 0.733 0.732 0.575 0.740 0.739 0.750 0.648 0.765 0.762 0.771 0.727 0.777 0.636
+ 0.792 0.809 0.806 0.648 0.830 0.845 0.841 0.745 0.875 0.982 0.906 1.000 0.931 0.944
+ 0.970 0.645 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.197 0.042 0.463 0.047 0.513 0.060 0.492 0.067 0.553 0.076 0.624 0.086 0.592
+ 0.100 0.513 0.135 0.453 0.186 0.411 0.224 0.395 0.250 0.403 0.281 0.368 0.357 0.366
+ 0.370 0.397 0.384 0.376 0.396 0.426 0.412 0.400 0.426 0.445 0.440 0.421 0.449 0.476
+ 0.463 0.437 0.478 0.497 0.490 0.453 0.503 0.503 0.515 0.447 0.531 0.503 0.545 0.461
+ 0.557 0.511 0.569 0.463 0.580 0.516 0.595 0.455 0.608 0.505 0.625 0.455 0.638 0.505
+ 0.649 0.455 0.665 0.495 0.679 0.455 0.693 0.500 0.707 0.447 0.721 0.487 0.735 0.455
+ 0.750 0.479 0.766 0.453 0.778 0.479 0.793 0.439 0.808 0.461 0.821 0.437 0.837 0.458
+ 0.861 0.437 1.000 0.408)
+ :duration dur :scaler (hz->radians 7800.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .01 4 .005 5 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
;; note #5
- (let* ((start (seconds->samples (+ beg 0.65)))
- (dur 0.14)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.033 0.216 0.110 0.247 0.218 0.800 0.263 0.734 0.301 0.889 0.370 0.966
- 0.470 0.905 0.494 0.658 0.531 0.666 0.727 0.508 1.000 0.000)
- :duration dur :scaler (* .3 amp)))
- (frqf (make-env '(0.124 0.214 0.222 0.265 0.311 0.310 0.400 0.317 0.501 0.307 0.651 0.283 0.752 0.262 1.000 0.198)
- :duration dur :scaler (hz->radians 8100.0)))
- (gen1 (make-polywave 0.0 (normalize-partials (list 1 1.5 2 .01 3 .01 4 .07 5 .04 6 .05 8 .005))))
- (rnd (make-rand-interp 3000))
- (rndf (make-env '(0 1 .2 0 .7 0 .8 1 1 1) :duration dur :scaler (hz->radians 200))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (* (env rndf)
- (rand-interp rnd))))))))))
+ (let ((dur 0.14)
+ (start (seconds->samples (+ beg 0.65))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.033 0.216 0.110 0.247 0.218 0.800 0.263 0.734 0.301 0.889 0.370 0.966
+ 0.470 0.905 0.494 0.658 0.531 0.666 0.727 0.508 1.000 0.000)
+ :duration dur :scaler (* .3 amp)))
+ (frqf (make-env '(0.124 0.214 0.222 0.265 0.311 0.310 0.400 0.317 0.501 0.307 0.651 0.283 0.752 0.262 1.000 0.198)
+ :duration dur :scaler (hz->radians 8100.0)))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 1.5 2 .01 3 .01 4 .07 5 .04 6 .05 8 .005))))
+ (rnd (make-rand-interp 3000))
+ (rndf (make-env '(0 1 .2 0 .7 0 .8 1 1 1) :duration dur :scaler (hz->radians 200))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (* (env rndf)
+ (rand-interp rnd))))))))))
;; (with-sound (:play #t) (white-eyed-vireo 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Willet
-(definstrument (willet beg amp)
+(defanimal (willet beg amp)
;; calif2 36 2
;; note #1
- (let* ((start (seconds->samples beg))
- (dur 0.037)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.017 0.603 0.397 0.986 0.531 0.915 0.750 0.255 0.836 0.383 0.913 0.420 1.000 0.000)
- :duration dur :scaler (* .25 amp)))
- (frqf (make-env '(0.000 0.172 0.152 0.172 0.401 0.188 0.667 0.201 0.808 0.205 0.951 0.227 1.000 0.234)
- :duration dur :scaler (hz->radians (* 1/3 13000.0))))
- (gen1 (make-polywave :partials (normalize-partials (list 1 .03 2 .1 3 1 4 .6 5 .5 6 .4 7 .1 8 .04 9 .01 10 .01 11 .005)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf)))))))
+ (let ((dur 0.037))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.017 0.603 0.397 0.986 0.531 0.915 0.750 0.255 0.836 0.383 0.913 0.420 1.000 0.000)
+ :duration dur :scaler (* .25 amp)))
+ (frqf (make-env '(0.000 0.172 0.152 0.172 0.401 0.188 0.667 0.201 0.808 0.205 0.951 0.227 1.000 0.234)
+ :duration dur :scaler (hz->radians (* 1/3 13000.0))))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 .03 2 .1 3 1 4 .6 5 .5 6 .4 7 .1 8 .04 9 .01 10 .01 11 .005)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf)))))))
;; note #2
- (let* ((start (seconds->samples (+ beg 0.054)))
- (dur 0.029)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.063 0.263 0.086 0.656 0.113 0.877 0.429 0.753 0.681 0.578 0.830 0.224 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.178 0.849 0.156 1.000 0.156)
- :duration dur :scaler (hz->radians (* 1/2 14900.0))))
- (gen1 (make-polywave :partials (normalize-partials (list 1 .07 2 1 3 .8 4 .47 5 .14 6 .04 7 .03 8 .01)))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.029)
+ (start (seconds->samples (+ beg 0.054))))
+ (let ((stop (+ start (seconds->samples dur)))
+ (ampf (make-env '(0.000 0.000 0.063 0.263 0.086 0.656 0.113 0.877 0.429 0.753 0.681 0.578 0.830 0.224 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.178 0.849 0.156 1.000 0.156)
+ :duration dur :scaler (hz->radians (* 1/2 14900.0))))
+ (gen1 (make-polywave 0.0 (normalize-partials '(1 .07 2 1 3 .8 4 .47 5 .14 6 .04 7 .03 8 .01)))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (willet 0 .5))
-
;;; --------------------------------------------------------------------------------
;;;
;;; Philadelphia vireo
-(definstrument (philadelphia-vireo beg amp)
+(defanimal (philadelphia-vireo beg amp)
;; east 58 3
- (let* ((start (seconds->samples beg))
- (dur 0.364)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.051 0.03 0.078 0.168 0.100 0.358 0.120 0.179 0.146 0.059 0.166 0.551
- 0.175 0.363 0.188 0.486 0.197 0.441 0.212 0.559 0.226 1.000 0.311 0.105 0.317 0.227
- 0.348 0.152 0.380 0.142 0.408 0.067 0.469 0.000 0.615 0.000 0.637 0.094 0.702 0.138
- 0.731 0.055 0.784 0.028 0.835 0.168 0.899 0.429 0.928 0.323 0.942 0.220 0.953 0.309
- 0.957 0.050 0.968 0.264 0.984 0.032 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.912 0.033 0.904 0.060 0.664 0.092 0.555 0.110 0.499 0.148 0.403 0.167 0.480
- 0.178 0.567 0.198 0.593 0.221 0.563 0.236 0.510 0.254 0.465 0.283 0.430 0.331 0.373
- 0.385 0.338 0.444 0.296 0.509 0.306 0.635 0.396 0.653 0.443 0.667 0.456 0.683 0.437
- 0.719 0.351 0.745 0.296 0.765 0.281 0.802 0.298 0.835 0.358 0.868 0.452 0.904 0.507
- 0.955 0.505 0.966 0.488 0.971 0.520 0.980 0.493 1.000 0.510)
- :duration dur :scaler (hz->radians 7400.0)))
- (gen1 (make-polywave :partials (list 1 .98 2 .015 3 .005))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.364))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.051 0.03 0.078 0.168 0.100 0.358 0.120 0.179 0.146 0.059 0.166 0.551
+ 0.175 0.363 0.188 0.486 0.197 0.441 0.212 0.559 0.226 1.000 0.311 0.105 0.317 0.227
+ 0.348 0.152 0.380 0.142 0.408 0.067 0.469 0.000 0.615 0.000 0.637 0.094 0.702 0.138
+ 0.731 0.055 0.784 0.028 0.835 0.168 0.899 0.429 0.928 0.323 0.942 0.220 0.953 0.309
+ 0.957 0.050 0.968 0.264 0.984 0.032 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.912 0.033 0.904 0.060 0.664 0.092 0.555 0.110 0.499 0.148 0.403 0.167 0.480
+ 0.178 0.567 0.198 0.593 0.221 0.563 0.236 0.510 0.254 0.465 0.283 0.430 0.331 0.373
+ 0.385 0.338 0.444 0.296 0.509 0.306 0.635 0.396 0.653 0.443 0.667 0.456 0.683 0.437
+ 0.719 0.351 0.745 0.296 0.765 0.281 0.802 0.298 0.835 0.358 0.868 0.452 0.904 0.507
+ 0.955 0.505 0.966 0.488 0.971 0.520 0.980 0.493 1.000 0.510)
+ :duration dur :scaler (hz->radians 7400.0)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .015 3 .005))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (philadelphia-vireo 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Black-crowned night heron
-(definstrument (black-crowned-night-heron beg amp)
+(defanimal (black-crowned-night-heron beg amp)
;; east 15 6
- (let* ((start (seconds->samples beg))
- (dur 0.145)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.045 0.233 0.289 0.674 0.508 0.865 0.762 1.000 0.847 0.900 0.929 0.368
- 0.958 0.100 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.119 0.219 0.149 0.385 0.168 0.501 0.182 0.555 0.201 0.708 0.190 1.000 0.168)
- :duration dur :scaler (hz->radians (* 1/2 7150.0))))
- (gen1 (make-oscil))
- (gens (make-nrxycos 0.0 1/6 15 .9))
- (gens0 (make-nrcos 0.0 6 .5))
- (rf (make-env '(0 .5 .4 .9 .7 .8 1 .5) :duration dur))
- (rnd (make-rand-interp 1000 (hz->radians 50)))
- (vib (make-triangle-wave 500 (hz->radians 30)))
- (rnd1 (make-rand-interp 1000 .5)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (+ (env frqf)
- (triangle-wave vib)
- (rand-interp rnd))))
- (set! (mus-scaler gens) (env rf)) ;scaler=r
- (outa i (* (env ampf)
- (+ .5 (abs (rand-interp rnd1)))
- (+ (oscil gen1 (* 2 frq))
- (* .2 (nrcos gens0 frq))
- (nrxycos gens (* 6 frq))))))))))
+ (let ((dur 0.145))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.045 0.233 0.289 0.674 0.508 0.865 0.762 1.000 0.847 0.900 0.929 0.368
+ 0.958 0.100 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.119 0.219 0.149 0.385 0.168 0.501 0.182 0.555 0.201 0.708 0.190 1.000 0.168)
+ :duration dur :scaler (hz->radians (* 1/2 7150.0))))
+ (gen1 (make-oscil))
+ (gens (make-nrxycos 0.0 1/6 15 .9))
+ (gens0 (make-polywave 0.0 (nrcos->polywave 6 .5 .2)))
+ (rf (make-env '(0 .5 .4 .9 .7 .8 1 .5) :duration dur))
+ (rnd (make-rand-interp 1000 (hz->radians 50)))
+ (vib (make-triangle-wave 500 (hz->radians 30)))
+ (rnd1 (make-rand-interp 1000 .5)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (+ (env frqf)
+ (triangle-wave vib)
+ (rand-interp rnd))))
+ (set! (mus-scaler gens) (env rf)) ;scaler=r
+ (outa i (* (env ampf)
+ (+ .5 (abs (rand-interp rnd1)))
+ (+ (oscil gen1 (* 2.0 frq))
+ (polywave gens0 frq)
+ (nrxycos gens (* 6.0 frq))))))))))
;; (with-sound (:play #t) (black-crowned-night-heron 0 .5))
+
;;; --------------------------------------------------------------------------------
;;;
;;; Scrub Euphonia
-(definstrument (scrub-euphonia beg amp)
+(defanimal (scrub-euphonia beg amp)
;; arizona 90 3.0
- (let* ((start (seconds->samples beg))
- (dur 0.49)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.067 0.188 0.111 0.676 0.151 0.838 0.239 0.988 0.275 0.000 0.346 0.000
- 0.386 0.243 0.399 0.615 0.427 0.719 0.445 0.587 0.464 0.664 0.521 0.630 0.533 0.571
- 0.567 0.868 0.580 0.877 0.611 0.176 0.628 0.138 0.637 0.000 0.671 0.000 0.676 0.168
- 0.690 0.204 0.725 0.694 0.742 0.725 0.821 0.464 0.904 0.696 0.939 0.109 1.000 0.000)
- :duration dur :scaler amp))
- (gen1 (make-polywave 0.0 (list 1 .99 2 .01)))
- (frqf (make-env '(0.000 0.819 0.024 0.761 0.063 0.686 0.101 0.642 0.171 0.586 0.229 0.556 0.271 0.558
- 0.342 0.556 0.347 0.883 0.361 0.900 0.367 0.719 0.390 0.656 0.436 0.589 0.480 0.564
- 0.529 0.547 0.555 0.525 0.605 0.519 0.640 0.528 0.660 0.869 0.673 0.869 0.683 0.681
- 0.717 0.625 0.763 0.561 0.791 0.564 0.817 0.544 0.857 0.533 0.894 0.522 0.924 0.531 1.000 0.531)
- :duration dur :scaler (hz->radians 7160))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.49))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.067 0.188 0.111 0.676 0.151 0.838 0.239 0.988 0.275 0.000 0.346 0.000
+ 0.386 0.243 0.399 0.615 0.427 0.719 0.445 0.587 0.464 0.664 0.521 0.630 0.533 0.571
+ 0.567 0.868 0.580 0.877 0.611 0.176 0.628 0.138 0.637 0.000 0.671 0.000 0.676 0.168
+ 0.690 0.204 0.725 0.694 0.742 0.725 0.821 0.464 0.904 0.696 0.939 0.109 1.000 0.000)
+ :duration dur :scaler amp))
+ (gen1 (make-polywave 0.0 '(1 .99 2 .01)))
+ (frqf (make-env '(0.000 0.819 0.024 0.761 0.063 0.686 0.101 0.642 0.171 0.586 0.229 0.556 0.271 0.558
+ 0.342 0.556 0.347 0.883 0.361 0.900 0.367 0.719 0.390 0.656 0.436 0.589 0.480 0.564
+ 0.529 0.547 0.555 0.525 0.605 0.519 0.640 0.528 0.660 0.869 0.673 0.869 0.683 0.681
+ 0.717 0.625 0.763 0.561 0.791 0.564 0.817 0.544 0.857 0.533 0.894 0.522 0.924 0.531 1.000 0.531)
+ :duration dur :scaler (hz->radians 7160))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (scrub-euphonia 0 .25))
@@ -10629,49 +10590,47 @@
;;;
;;; Greater pewee
-(definstrument (greater-pewee beg1 amp)
+(defanimal (greater-pewee beg1 amp)
;; arizona 52 2
(define (greater-pewee-first-and-last beg)
- (let* ((start (seconds->samples beg))
- (dur 0.4)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.011 0.083 0.220 0.268 0.374 0.325 0.463 0.337 0.542 0.289 0.599 0.000
- 0.668 0.000 0.683 0.554 0.701 0.501 0.735 1.000 0.775 0.039 0.829 0.806 0.852 0.862
- 0.877 0.979 0.888 0.912 0.900 0.968 0.912 0.822 0.928 0.866 0.939 0.762 0.950 0.783
- 0.970 0.637 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.102 0.018 0.114 0.138 0.124 0.251 0.124 0.438 0.124 0.511 0.124 0.589 0.119
- 0.649 0.124 0.663 0.169 0.672 0.150 0.704 0.124 0.750 0.135 0.777 0.124 0.795 0.121
- 0.969 0.147 1.000 0.162)
- :duration dur :scaler (hz->radians 22500))) ; not a typo...
- (gen1 (make-polywave :partials (list 1 .96 2 .02 3 .02))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 0.4))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.011 0.083 0.220 0.268 0.374 0.325 0.463 0.337 0.542 0.289 0.599 0.000
+ 0.668 0.000 0.683 0.554 0.701 0.501 0.735 1.000 0.775 0.039 0.829 0.806 0.852 0.862
+ 0.877 0.979 0.888 0.912 0.900 0.968 0.912 0.822 0.928 0.866 0.939 0.762 0.950 0.783
+ 0.970 0.637 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.102 0.018 0.114 0.138 0.124 0.251 0.124 0.438 0.124 0.511 0.124 0.589 0.119
+ 0.649 0.124 0.663 0.169 0.672 0.150 0.704 0.124 0.750 0.135 0.777 0.124 0.795 0.121
+ 0.969 0.147 1.000 0.162)
+ :duration dur :scaler (hz->radians 22500))) ; not a typo...
+ (gen1 (make-polywave 0.0 '(1 .96 2 .02 3 .02))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
(define (greater-pewee-midsection beg)
- (let* ((start (seconds->samples beg))
- (dur 1.65)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.023 0.155 0.085 0.349 0.196 0.507 0.219 0.513 0.227 0.000 0.295 0.000
- 0.306 0.510 0.333 0.741 0.356 0.825 0.370 0.752 0.386 0.775 0.394 0.713 0.409 0.761
- 0.431 0.668 0.439 0.713 0.456 0.701 0.469 0.000 0.570 0.000 0.578 0.093 0.619 0.152
- 0.653 0.223 0.684 0.217 0.721 0.299 0.745 0.507 0.780 0.620 0.795 0.586 0.808 0.679
- 0.836 0.428 0.852 0.563 0.862 0.997 0.875 0.625 0.887 0.476 0.982 0.251 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.274 0.038 0.283 0.219 0.291 0.302 0.293 0.410 0.324 0.451 0.327 0.464 0.315
- 0.518 0.324 0.542 0.213 0.580 0.223 0.715 0.242 0.759 0.293 0.813 0.308 0.828 0.320
- 0.843 0.341 0.857 0.337 0.877 0.276 0.896 0.252 1.000 0.230)
- :duration dur :scaler (hz->radians 10000)))
- (gen1 (make-polywave :partials (list 1 .98 2 .01 3 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (polywave gen1 (env frqf))))))))
+ (let ((dur 1.65))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.023 0.155 0.085 0.349 0.196 0.507 0.219 0.513 0.227 0.000 0.295 0.000
+ 0.306 0.510 0.333 0.741 0.356 0.825 0.370 0.752 0.386 0.775 0.394 0.713 0.409 0.761
+ 0.431 0.668 0.439 0.713 0.456 0.701 0.469 0.000 0.570 0.000 0.578 0.093 0.619 0.152
+ 0.653 0.223 0.684 0.217 0.721 0.299 0.745 0.507 0.780 0.620 0.795 0.586 0.808 0.679
+ 0.836 0.428 0.852 0.563 0.862 0.997 0.875 0.625 0.887 0.476 0.982 0.251 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.274 0.038 0.283 0.219 0.291 0.302 0.293 0.410 0.324 0.451 0.327 0.464 0.315
+ 0.518 0.324 0.542 0.213 0.580 0.223 0.715 0.242 0.759 0.293 0.813 0.308 0.828 0.320
+ 0.843 0.341 0.857 0.337 0.877 0.276 0.896 0.252 1.000 0.230)
+ :duration dur :scaler (hz->radians 10000)))
+ (gen1 (make-polywave 0.0 '(1 .98 2 .01 3 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
(greater-pewee-first-and-last beg1)
(greater-pewee-midsection (+ beg1 1.13))
@@ -10686,72 +10645,68 @@
;;;
;;; Brown-crested flycatcher
-(definstrument (brown-crested-flycatcher-1 beg amp)
+(defanimal (brown-crested-flycatcher-1 beg amp)
;; calif 13 7
- (let* ((start (seconds->samples beg))
- (dur 0.66)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.017 0.616 0.035 0.803 0.044 0.410 0.050 0.674 0.056 0.157 0.065 0.452
- 0.081 0.350 0.105 0.426 0.106 0.279 0.111 0.439 0.122 0.483 0.133 0.743 0.192 0.466
- 0.197 0.608 0.212 0.424 0.221 0.998 0.236 0.335 0.244 0.690 0.260 0.652 0.274 0.703
- 0.283 0.537 0.288 0.847 0.298 0.743 0.305 0.829 0.323 0.324 0.336 0.619 0.349 0.075
- 0.357 0.457 0.362 0.322 0.366 0.426 0.390 0.193 0.396 0.452 0.413 0.000 0.415 0.302
- 0.422 0.220 0.426 0.259 0.433 0.120 0.437 0.191 0.452 0.000 0.530 0.000 0.556 0.144
- 0.564 0.399 0.589 0.000 0.617 0.000 0.623 0.149 0.634 0.392 0.655 0.000 0.678 0.000
- 0.682 .100 0.695 0.153 0.707 0.000 0.715 0.073 0.727 0.111 0.737 0.000 0.778 0.000
- 0.786 0.089 0.798 0.060 0.806 0.175 0.815 0.000 0.829 0.000 0.830 0.217 0.842 0.146
- 0.846 0.222 0.859 0.000 0.872 0.000 0.874 0.191 0.885 0.146 0.894 0.222 0.908 0.000
- 0.918 0.000 0.919 0.166 0.924 0.115 0.929 0.169 0.938 0.091 0.942 0.038 0.949 0.069
- 0.953 0.038 0.960 0.102 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.492 0.013 0.588 0.027 0.615 0.047 0.551 0.072 0.531 0.097 0.551 0.137 0.579
- 0.197 0.588 0.211 0.608 0.219 0.654 0.225 0.592 0.237 0.583 0.270 0.581 0.288 0.695
- 0.299 0.572 0.304 0.599 0.310 0.563 0.326 0.558 0.340 0.692 0.356 0.579 0.364 0.538
- 0.375 0.510 0.390 0.501 0.397 0.610 0.414 0.576 0.417 0.478 0.436 0.462 0.442 0.513
- 0.454 0.339 0.524 0.339 0.566 0.503 0.587 0.310 0.610 0.308 0.628 0.485 0.638 0.460
- 0.655 0.292 0.674 0.294 0.685 0.431 0.699 0.417 0.715 0.351 0.728 0.524 0.745 0.519
- 0.760 0.369 0.780 0.369 0.788 0.442 0.805 0.460 0.809 0.574 0.830 0.576 0.832 0.469
- 0.846 0.474 0.854 0.574 0.873 0.604 0.877 0.476 0.892 0.476 0.901 0.592 0.917 0.563
- 0.923 0.458 0.939 0.462 0.955 0.431 0.976 0.431 1.000 0.351)
- :duration dur :scaler (hz->radians 4500)))
- (gen1 (make-polywave :partials (list 1 .9 2 .03 3 .05 4 .01 5 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (polywave gen1 frq))))))))
+ (let ((dur 0.66))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.017 0.616 0.035 0.803 0.044 0.410 0.050 0.674 0.056 0.157 0.065 0.452
+ 0.081 0.350 0.105 0.426 0.106 0.279 0.111 0.439 0.122 0.483 0.133 0.743 0.192 0.466
+ 0.197 0.608 0.212 0.424 0.221 0.998 0.236 0.335 0.244 0.690 0.260 0.652 0.274 0.703
+ 0.283 0.537 0.288 0.847 0.298 0.743 0.305 0.829 0.323 0.324 0.336 0.619 0.349 0.075
+ 0.357 0.457 0.362 0.322 0.366 0.426 0.390 0.193 0.396 0.452 0.413 0.000 0.415 0.302
+ 0.422 0.220 0.426 0.259 0.433 0.120 0.437 0.191 0.452 0.000 0.530 0.000 0.556 0.144
+ 0.564 0.399 0.589 0.000 0.617 0.000 0.623 0.149 0.634 0.392 0.655 0.000 0.678 0.000
+ 0.682 .100 0.695 0.153 0.707 0.000 0.715 0.073 0.727 0.111 0.737 0.000 0.778 0.000
+ 0.786 0.089 0.798 0.060 0.806 0.175 0.815 0.000 0.829 0.000 0.830 0.217 0.842 0.146
+ 0.846 0.222 0.859 0.000 0.872 0.000 0.874 0.191 0.885 0.146 0.894 0.222 0.908 0.000
+ 0.918 0.000 0.919 0.166 0.924 0.115 0.929 0.169 0.938 0.091 0.942 0.038 0.949 0.069
+ 0.953 0.038 0.960 0.102 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.492 0.013 0.588 0.027 0.615 0.047 0.551 0.072 0.531 0.097 0.551 0.137 0.579
+ 0.197 0.588 0.211 0.608 0.219 0.654 0.225 0.592 0.237 0.583 0.270 0.581 0.288 0.695
+ 0.299 0.572 0.304 0.599 0.310 0.563 0.326 0.558 0.340 0.692 0.356 0.579 0.364 0.538
+ 0.375 0.510 0.390 0.501 0.397 0.610 0.414 0.576 0.417 0.478 0.436 0.462 0.442 0.513
+ 0.454 0.339 0.524 0.339 0.566 0.503 0.587 0.310 0.610 0.308 0.628 0.485 0.638 0.460
+ 0.655 0.292 0.674 0.294 0.685 0.431 0.699 0.417 0.715 0.351 0.728 0.524 0.745 0.519
+ 0.760 0.369 0.780 0.369 0.788 0.442 0.805 0.460 0.809 0.574 0.830 0.576 0.832 0.469
+ 0.846 0.474 0.854 0.574 0.873 0.604 0.877 0.476 0.892 0.476 0.901 0.592 0.917 0.563
+ 0.923 0.458 0.939 0.462 0.955 0.431 0.976 0.431 1.000 0.351)
+ :duration dur :scaler (hz->radians 4500)))
+ (gen1 (make-polywave 0.0 '(1 .9 2 .03 3 .05 4 .01 5 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (brown-crested-flycatcher-1 0 .5))
-(definstrument (brown-crested-flycatcher-2 beg amp)
+(defanimal (brown-crested-flycatcher-2 beg amp)
;; calif 13 63.5
- (let* ((start (seconds->samples beg))
- (dur 0.47)
- (stop (+ start (seconds->samples dur)))
- (ampf (make-env '(0.000 0.000 0.021 0.219 0.040 0.847 0.057 0.948 0.071 0.929 0.084 0.000 0.119 0.000
- 0.132 0.633 0.145 0.711 0.153 0.836 0.175 0.000 0.202 0.000 0.215 0.237 0.233 0.232
- 0.255 0.000 0.403 0.000 0.426 0.091 0.449 0.032 0.469 0.164 0.494 0.064 0.536 0.219
- 0.568 0.125 0.586 0.210 0.622 0.185 0.627 0.128 0.652 0.155 0.675 0.271 0.692 0.205
- 0.699 0.077 0.719 0.144 0.757 0.296 0.779 0.084 0.801 0.175 0.821 0.371 0.851 0.180
- 0.867 0.112 0.898 0.273 0.942 0.080 0.976 0.294 0.991 0.262 1.000 0.000)
- :duration dur :scaler amp))
- (frqf (make-env '(0.000 0.392 0.036 0.595 0.049 0.626 0.064 0.601 0.082 0.405 0.117 0.387 0.126 0.497
- 0.138 0.540 0.150 0.538 0.158 0.499 0.173 0.392 0.201 0.346 0.210 0.444 0.219 0.474
- 0.231 0.465 0.239 0.433 0.254 0.346 0.404 0.349 0.423 0.417 0.439 0.401 0.461 0.410
- 0.469 0.440 0.502 0.415 0.520 0.451 0.536 0.456 0.554 0.435 0.575 0.428 0.597 0.492
- 0.636 0.440 0.678 0.506 0.694 0.465 0.723 0.476 0.751 0.517 0.762 0.478 0.789 0.478
- 0.818 0.522 0.839 0.508 0.854 0.474 0.882 0.492 0.901 0.515 0.925 0.490 0.947 0.481
- 0.958 0.501 0.986 0.494 1.000 0.633)
- :duration dur :scaler (hz->radians 4100)))
- (gen1 (make-polywave :partials (list 1 .9 2 .02 3 .005 4 .02 5 .007 6 .01))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((frq (env frqf)))
- (outa i (* (env ampf)
- (polywave gen1 frq))))))))
+ (let ((dur 0.47))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (ampf (make-env '(0.000 0.000 0.021 0.219 0.040 0.847 0.057 0.948 0.071 0.929 0.084 0.000 0.119 0.000
+ 0.132 0.633 0.145 0.711 0.153 0.836 0.175 0.000 0.202 0.000 0.215 0.237 0.233 0.232
+ 0.255 0.000 0.403 0.000 0.426 0.091 0.449 0.032 0.469 0.164 0.494 0.064 0.536 0.219
+ 0.568 0.125 0.586 0.210 0.622 0.185 0.627 0.128 0.652 0.155 0.675 0.271 0.692 0.205
+ 0.699 0.077 0.719 0.144 0.757 0.296 0.779 0.084 0.801 0.175 0.821 0.371 0.851 0.180
+ 0.867 0.112 0.898 0.273 0.942 0.080 0.976 0.294 0.991 0.262 1.000 0.000)
+ :duration dur :scaler amp))
+ (frqf (make-env '(0.000 0.392 0.036 0.595 0.049 0.626 0.064 0.601 0.082 0.405 0.117 0.387 0.126 0.497
+ 0.138 0.540 0.150 0.538 0.158 0.499 0.173 0.392 0.201 0.346 0.210 0.444 0.219 0.474
+ 0.231 0.465 0.239 0.433 0.254 0.346 0.404 0.349 0.423 0.417 0.439 0.401 0.461 0.410
+ 0.469 0.440 0.502 0.415 0.520 0.451 0.536 0.456 0.554 0.435 0.575 0.428 0.597 0.492
+ 0.636 0.440 0.678 0.506 0.694 0.465 0.723 0.476 0.751 0.517 0.762 0.478 0.789 0.478
+ 0.818 0.522 0.839 0.508 0.854 0.474 0.882 0.492 0.901 0.515 0.925 0.490 0.947 0.481
+ 0.958 0.501 0.986 0.494 1.000 0.633)
+ :duration dur :scaler (hz->radians 4100)))
+ (gen1 (make-polywave 0.0 '(1 .9 2 .02 3 .005 4 .02 5 .007 6 .01))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (polywave gen1 (env frqf))))))))
;; (with-sound (:play #t) (brown-crested-flycatcher-2 0 .5))
@@ -10769,7 +10724,7 @@
(texas-toad (+ beg 10) 2.0 0.125) (set! beg (+ beg spacing))
(bullfrog (+ beg 12.5) 0.125) (set! beg (+ beg spacing))
(ornate-chorus-frog (+ beg 14) 2 0.1) (set! beg (+ beg spacing))
- (squirrel-tree-frog-1 (+ beg 16.5) 1 0.1) (set! beg (+ beg spacing))
+ (squirrel-tree-frog (+ beg 16.5) 1 0.1) (set! beg (+ beg spacing))
(pinewoods-tree-frog (+ beg 18) 1.5 0.15) (set! beg (+ beg spacing))
(great-plains-narrow-mouthed-toad (+ beg 20) 2 .25) (set! beg (+ beg spacing))
(northern-leopard-frog-2 (+ beg 22.5) 0.5) (set! beg (+ beg spacing))
@@ -10823,7 +10778,7 @@
(+ beg 71))
-(define* (calling-all-birds (beg 0.0) (spacing .25))
+(define* (calling-all-birds (beg 0.0) (spacing .25))
(ruffed-grouse (+ beg 0.0) 0.5) (set! beg (+ beg spacing))
(eastern-wood-pewee-1 (+ beg 11.0) 0.25) (set! beg (+ beg spacing))
(eastern-wood-pewee-2 (+ beg 12.5) 0.25) (set! beg (+ beg spacing))
@@ -10981,7 +10936,7 @@
(define (calling-all-animals)
- (with-sound (:scaled-to .5 :srate 44100) ;(srate needed by snd-test)
+ (with-sound (:srate 44100) ;(srate needed by snd-test)
(let ((beg 0.0))
(set! beg (calling-all-frogs beg))
(set! beg (calling-all-mammals beg))
diff --git a/audinfo.c b/audinfo.c
deleted file mode 100644
index 8b6a489..0000000
--- a/audinfo.c
+++ /dev/null
@@ -1,16 +0,0 @@
-/* audinfo decribes the current audio hardware state */
-
-#include <mus-config.h>
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <time.h>
-
-#include "sndlib.h"
-
-int main(int argc, char *argv[])
-{
- mus_sound_initialize();
- mus_audio_describe();
- return(0);
-}
diff --git a/audio.c b/audio.c
index 394f236..4bc2ed7 100644
--- a/audio.c
+++ b/audio.c
@@ -1,26 +1,32 @@
-/* Audio hardware handlers (OSS, ALSA, Sun, Windows, Mac OSX, Jack, ESD, HPUX, NetBSD, pulseaudio, portaudio) */
+/* Audio hardware handlers (OSS, ALSA, Sun, Windows, Mac OSX, Jack, HPUX, NetBSD, OpenBSD, pulseaudio, portaudio)
+ *
+ * In many cases, only callback driven transfers are supported, so ideally we'd have:
+ * int mus_audio_playback(caller_data, start_func, fill_func, end_func)
+ * returns error indication or MUS_NO_ERROR
+ * calls start_func at startup: void start(caller_data, ...)?
+ * each times it needs a bufferfull, calls fill_func: bool fill(caller_data, void *buf, buf_size_in_samples, buf_data_type)
+ * perhaps returns false to signal normal quit?
+ * at end (either via fill or some interrupt), calls end(caller_data, ...)?
+ */
/*
* layout of this file:
* error handlers
* OSS
* ALSA
- * Sun (has switches for OpenBSD, but they're untested)
+ * Sun
* Windows 95/98
* OSX
- * ESD
* JACK
* HPUX
- * NetBSD
+ * NetBSD/OpenBSD
* PulseAudio (in progress?)
* PortAudio
- * audio describers
*/
/*
- * char *mus_audio_describe(void) returns a description of the audio hardware
- * int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
- * int mus_audio_open_input(int dev, int srate, int chans, int format, int size)
+ * int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size)
+ * int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size)
* int mus_audio_write(int line, char *buf, int bytes)
* int mus_audio_close(int line)
* int mus_audio_read(int line, char *buf, int bytes)
@@ -28,14 +34,9 @@
* char *mus_audio_moniker(void) returns some brief description of the overall audio setup (don't free return string).
*/
-/* error handling is tricky here -- higher levels are using many calls as probes, so
- * the "error" is a sign of non-existence, not a true error. So, for nearly all
- * cases, I'll use mus_print, not mus_error.
- */
-
-#include <mus-config.h>
+#include "mus-config.h"
-#if USE_SND && MUS_MAC_OSX && USE_MOTIF
+#if USE_SND && __APPLE__ && USE_MOTIF
#undef USE_MOTIF
#define USE_NO_GUI 1
/* Xt's Boolean (/usr/include/X11/Intrinsic.h = char) collides with MacTypes.h Boolean, (actually,
@@ -45,7 +46,7 @@
*/
#endif
-#if USE_SND && MUS_MAC_OSX && HAVE_RUBY
+#if USE_SND && __APPLE__ && HAVE_RUBY
/* if using Ruby, OpenTransport.h T_* definitions collide with Ruby's -- it isn't needed here, so... */
#define REDEFINE_HAVE_RUBY 1
#undef HAVE_RUBY
@@ -58,7 +59,7 @@
#define LABEL_BUFFER_SIZE 64
#endif
-#if USE_SND && MUS_MAC_OSX
+#if USE_SND && __APPLE__
#define USE_MOTIF 1
#undef USE_NO_GUI
#if REDEFINE_HAVE_RUBY
@@ -68,66 +69,44 @@
#include <math.h>
#include <stdio.h>
-#if HAVE_FCNTL_H
- #include <fcntl.h>
-#endif
+#include <fcntl.h>
#include <errno.h>
#include <stdlib.h>
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
-#else
- #if (!(defined(_MSC_VER)))
- #include <unistd.h>
- #endif
-#endif
-#if HAVE_STRING_H
- #include <string.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
#endif
+#include <string.h>
-#ifdef MUS_MAC_OSX
+#ifdef __APPLE__
#include <CoreServices/CoreServices.h>
#include <CoreAudio/CoreAudio.h>
/* these pull in stdbool.h apparently, so they have to precede sndlib.h */
#endif
+#define HAVE_JACK_IN_LINUX (MUS_JACK && __linux__)
+
#include "_sndlib.h"
#include "sndlib-strings.h"
-enum {MUS_AUDIO_DEFAULT_0, MUS_AUDIO_DUPLEX_DEFAULT, MUS_AUDIO_LINE_OUT,
+#if WITH_AUDIO
+
+enum {MUS_AUDIO_IGNORED, MUS_AUDIO_DUPLEX_DEFAULT, MUS_AUDIO_LINE_OUT,
MUS_AUDIO_LINE_IN, MUS_AUDIO_MICROPHONE, MUS_AUDIO_SPEAKERS, MUS_AUDIO_DIGITAL_OUT,
MUS_AUDIO_DAC_OUT, MUS_AUDIO_MIXER, MUS_AUDIO_AUX_OUTPUT
};
-#if (!HAVE_STRERROR)
-char *strerror(int errnum)
-{
- char *strerrbuf;
- strerrbuf = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
- mus_snprintf(strerrbuf, LABEL_BUFFER_SIZE, "io err %d", errnum);
- return(strerrbuf);
-}
-#endif
-
-#define MUS_STANDARD_ERROR(Error_Type, Error_Message) \
- mus_print("%s\n [%s[%d] %s]", Error_Message, __FILE__, __LINE__, c__FUNCTION__)
+#define mus_standard_error(Error_Type, Error_Message) \
+ mus_print("%s\n [%s[%d] %s]", Error_Message, __FILE__, __LINE__, __func__)
-#define MUS_STANDARD_IO_ERROR(Error_Type, IO_Func, IO_Name) \
- mus_print("%s %s: %s\n [%s[%d] %s]", IO_Func, IO_Name, strerror(errno), __FILE__, __LINE__, c__FUNCTION__)
+#define mus_standard_io_error(Error_Type, IO_Func, IO_Name) \
+ mus_print("%s %s: %s\n [%s[%d] %s]", IO_Func, IO_Name, strerror(errno), __FILE__, __LINE__, __func__)
static char *version_name = NULL;
static bool audio_initialized = false;
-static const char *mus_audio_device_name(int dev)
-{
- return("default device");
-}
-
-
-static char *audio_strbuf = NULL; /* previous name "strbuf" collides with Mac OSX global! */
-static void pprint(const char *str);
/* ------------------------------- OSS ----------------------------------------- */
@@ -139,35 +118,7 @@ static void pprint(const char *str);
#define AUDIO_OK 1
#include <sys/ioctl.h>
-
-/* the system version of the soundcard header file may have no relation to the current OSS actually loaded */
-/* sys/soundcard.h is usually just a pointer to linux/soundcard.h */
-
-#if MUS_HAVE_USR_LIB_OSS
- #include "/usr/lib/oss/include/sys/soundcard.h"
-#else
- #if MUS_HAVE_USR_LOCAL_LIB_OSS
- #include "/usr/local/lib/oss/include/sys/soundcard.h"
- #else
- #if MUS_HAVE_OPT_OSS
- #include "/opt/oss/include/sys/soundcard.h"
- #else
- #if MUS_HAVE_VAR_LIB_OSS
- #include "/var/lib/oss/include/sys/soundcard.h"
- #else
- #if (HAVE_SYS_SOUNDCARD_H || MUS_LINUX)
- #include <sys/soundcard.h>
- #else
- #if HAVE_MACHINE_SOUNDCARD_H
- #include <machine/soundcard.h>
- #else
- #include <soundcard.h>
- #endif
- #endif
- #endif
- #endif
- #endif
-#endif
+#include <sys/soundcard.h>
#if ((SOUND_VERSION > 360) && (defined(OSS_SYSINFO)))
#define NEW_OSS 1
@@ -178,14 +129,6 @@ static void pprint(const char *str);
#define MUS_OSS_SET_FORMAT SNDCTL_DSP_SETFMT
#define MUS_OSS_GET_FORMATS SNDCTL_DSP_GETFMTS
-#if SOUND_VERSION < 0x040000
- /* did they change the way SOUND_VERSION encodes the version? */
- /* MUS_OSS_READ_* deliberately undefined in OSS v4 (see below) */
- #define MUS_OSS_READ_RATE SOUND_PCM_READ_RATE
- #define MUS_OSS_READ_CHANNELS SOUND_PCM_READ_CHANNELS
- /* these can't be defined (easily anyway) in oss v4 */
-#endif
-
#define DAC_NAME "/dev/dsp"
#define MIXER_NAME "/dev/mixer"
/* some programs use /dev/audio */
@@ -200,7 +143,7 @@ static void pprint(const char *str);
* might work on the Mac -- something for a rainy day...
*/
-#define RETURN_ERROR_EXIT(Message_Type, Audio_Line, Ur_Message) \
+#define return_error_exit(Message_Type, Audio_Line, Ur_Message) \
do { \
char *Message; Message = Ur_Message; \
if (Audio_Line != -1) \
@@ -209,12 +152,12 @@ static void pprint(const char *str);
{ \
mus_print("%s\n [%s[%d] %s]", \
Message, \
- __FILE__, __LINE__, c__FUNCTION__); \
+ __FILE__, __LINE__, __func__); \
free(Message); \
} \
else mus_print("%s\n [%s[%d] %s]", \
mus_error_type_to_string(Message_Type), \
- __FILE__, __LINE__, c__FUNCTION__); \
+ __FILE__, __LINE__, __func__); \
return(MUS_ERROR); \
} while (false)
@@ -240,30 +183,24 @@ static int *audio_open_ctr = NULL;
static int *audio_dsp = NULL;
static int *audio_mixer = NULL;
static int *audio_mode = NULL;
-typedef enum {NORMAL_CARD, SONORUS_STUDIO, RME_HAMMERFALL, DELTA_66} audio_card_t;
-/* the Sonorus Studi/o card is a special case in all regards */
-static audio_card_t *audio_type = NULL;
static int sound_cards = 0;
-static int new_oss_running = 0;
+#ifdef NEW_OSS
+ static int new_oss_running = 0;
+#endif
static char *dev_name = NULL;
-static int oss_mus_audio_systems(void)
-{
- return(sound_cards);
-}
-
static char *oss_mus_audio_moniker(void)
{
- char version[LABEL_BUFFER_SIZE];
if (version_name == NULL) version_name = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
if (SOUND_VERSION < 361)
{
- mus_snprintf(version, LABEL_BUFFER_SIZE, "%d", SOUND_VERSION);
- mus_snprintf(version_name, LABEL_BUFFER_SIZE, "OSS %c.%c.%c", version[0], version[1], version[2]);
+ char version[LABEL_BUFFER_SIZE];
+ snprintf(version, LABEL_BUFFER_SIZE, "%d", SOUND_VERSION);
+ snprintf(version_name, LABEL_BUFFER_SIZE, "OSS %c.%c.%c", version[0], version[1], version[2]);
}
else
- mus_snprintf(version_name, LABEL_BUFFER_SIZE, "OSS %x.%x.%x",
+ snprintf(version_name, LABEL_BUFFER_SIZE, "OSS %x.%x.%x",
(SOUND_VERSION >> 16) & 0xff,
(SOUND_VERSION >> 8) & 0xff,
SOUND_VERSION & 0xff);
@@ -274,7 +211,7 @@ static char *dac_name(int sys, int offset)
{
if ((sys < sound_cards) && (audio_mixer[sys] >= -1))
{
- mus_snprintf(dev_name, LABEL_BUFFER_SIZE, "%s%d", DAC_NAME, audio_dsp[sys] + offset);
+ snprintf(dev_name, LABEL_BUFFER_SIZE, "%s%d", DAC_NAME, audio_dsp[sys] + offset);
return(dev_name);
}
return((char *)DAC_NAME);
@@ -289,9 +226,7 @@ static int oss_mus_audio_initialize(void)
/* here we need to set up the map of /dev/dsp and /dev/mixer to a given system */
/* since this info is not passed to us by OSS, we have to work at it... */
/* for the time being, I'll ignore auxiliary dsp and mixer ports (each is a special case) */
- int i, fd = -1, md, err = 0;
- char dname[LABEL_BUFFER_SIZE];
- int amp, old_mixer_amp, old_dsp_amp, new_mixer_amp, responsive_field;
+ int amp, old_mixer_amp, old_dsp_amp, new_mixer_amp;
int devmask;
#ifdef NEW_OSS
int status, ignored;
@@ -299,15 +234,14 @@ static int oss_mus_audio_initialize(void)
static mixer_info mixinfo;
int sysinfo_ok = 0;
#endif
- int num_mixers, num_dsps, nmix, ndsp;
if (!audio_initialized)
{
+ int i, num_mixers, num_dsps, nmix, ndsp, err = 0, fd = -1, responsive_field;
audio_initialized = true;
audio_fd = (int *)calloc(MAX_SOUNDCARDS, sizeof(int));
audio_open_ctr = (int *)calloc(MAX_SOUNDCARDS, sizeof(int));
audio_dsp = (int *)calloc(MAX_SOUNDCARDS, sizeof(int));
audio_mixer = (int *)calloc(MAX_SOUNDCARDS, sizeof(int));
- audio_type = (audio_card_t *)calloc(MAX_SOUNDCARDS, sizeof(audio_card_t));
audio_mode = (int *)calloc(MAX_SOUNDCARDS, sizeof(int));
dev_name = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
init_srate = (int *)calloc(MAX_SOUNDCARDS, sizeof(int));
@@ -321,7 +255,6 @@ static int oss_mus_audio_initialize(void)
audio_open_ctr[i] = 0;
audio_dsp[i] = -1;
audio_mixer[i] = -1;
- audio_type[i] = NORMAL_CARD;
}
num_mixers = MAX_MIXERS;
@@ -356,8 +289,8 @@ static int oss_mus_audio_initialize(void)
* Ensoniq uses 2 dsps and 1 mixer.
*
* the data we are gathering here:
- * int audio_dsp[MAX_SOUNDCARDS] -> main_dsp_port[MUS_AUDIO_PACK_SYSTEM(n)] (-1 => no such system dsp)
- * int audio_mixer[MAX_SOUNDCARDS] -> main_mixer_port[MUS_AUDIO_PACK_SYSTEM(n)]
+ * int audio_dsp[MAX_SOUNDCARDS] -> main_dsp_port[n] (-1 => no such system dsp)
+ * int audio_mixer[MAX_SOUNDCARDS] -> main_mixer_port[n]
* int sound_cards = 0 -> usable systems
* all auxiliary ports are currently ignored (SB equalizer, etc)
*/
@@ -367,6 +300,8 @@ static int oss_mus_audio_initialize(void)
while ((nmix < num_mixers) &&
(ndsp < num_dsps))
{
+ char dname[LABEL_BUFFER_SIZE];
+ int md;
/* for each mixer, find associated main dsp (assumed to be first in /dev/dsp ordering) */
/* if mixer's dsp overlaps or we run out of dsps first, ignore it (aux mixer) */
/* our by-guess-or-by-gosh method here is to try to open the mixer.
@@ -375,7 +310,7 @@ static int oss_mus_audio_initialize(void)
* open next unchecked dsp, try to set volume, read current, if different we found a match -- set and go on.
* if no change, move to next dsp and try again, if no more dsps, quit (checking for null case as before)
*/
- mus_snprintf(dname, LABEL_BUFFER_SIZE, "%s%d", MIXER_NAME, nmix);
+ snprintf(dname, LABEL_BUFFER_SIZE, "%s%d", MIXER_NAME, nmix);
md = open(dname, O_RDWR, 0);
if (md == -1)
{
@@ -383,13 +318,13 @@ static int oss_mus_audio_initialize(void)
{
mus_print("%s is busy: can't access it [%s[%d] %s]",
dname,
- __FILE__, __LINE__, c__FUNCTION__);
+ __FILE__, __LINE__, __func__);
nmix++;
continue;
}
else break;
}
- mus_snprintf(dname, LABEL_BUFFER_SIZE, "%s%d", DAC_NAME, ndsp);
+ snprintf(dname, LABEL_BUFFER_SIZE, "%s%d", DAC_NAME, ndsp);
fd = open(dname, O_RDWR | O_NONBLOCK, 0);
if (fd == -1) fd = open(dname, O_RDONLY | O_NONBLOCK, 0);
if (fd == -1) fd = open(dname, O_WRONLY | O_NONBLOCK, 0); /* some output devices need this */
@@ -410,67 +345,7 @@ static int oss_mus_audio_initialize(void)
}
}
#ifdef NEW_OSS
- /* can't change volume yet of Sonorus, so the method above won't work --
- * try to catch this case via the mixer's name
- */
status = ioctl(md, SOUND_MIXER_INFO, &mixinfo);
- if ((status == 0) &&
- (mixinfo.name) &&
- (*(mixinfo.name)) &&
- (strlen(mixinfo.name) > 6))
- {
- if (strncmp("STUDI/O", mixinfo.name, 7) == 0)
- {
- /* a special case in every regard */
- audio_type[sound_cards] = SONORUS_STUDIO;
- audio_mixer[sound_cards] = nmix;
- nmix++;
- audio_dsp[sound_cards] = ndsp;
- if (num_dsps >= 21)
- {
- ndsp += 21;
- audio_mode[sound_cards] = 1;
- }
- else
- {
- ndsp += 9;
- audio_mode[sound_cards] = 0;
- }
- sound_cards++;
- close(fd);
- close(md);
- continue;
- }
- else
- {
- if (strncmp("RME Digi96", mixinfo.name, 10) == 0)
- {
- audio_type[sound_cards] = RME_HAMMERFALL;
- audio_mixer[sound_cards] = nmix;
- nmix++;
- audio_dsp[sound_cards] = ndsp;
- sound_cards++;
- close(fd);
- close(md);
- continue;
- }
- else
- {
- if (strncmp("M Audio Delta", mixinfo.name, 13) == 0)
- {
- audio_type[sound_cards] = DELTA_66;
- audio_mixer[sound_cards] = nmix;
- nmix++;
- ndsp += 6; /* just a guess */
- audio_dsp[sound_cards] = ndsp;
- sound_cards++;
- close(fd);
- close(md);
- continue;
- }
- }
- }
- }
#endif
err = ioctl(md, SOUND_MIXER_READ_DEVMASK, &devmask);
responsive_field = SOUND_MIXER_VOLUME;
@@ -500,7 +375,6 @@ static int oss_mus_audio_initialize(void)
/* found one! */
audio_dsp[sound_cards] = ndsp; ndsp++;
audio_mixer[sound_cards] = nmix; nmix++;
- audio_type[sound_cards] = NORMAL_CARD;
sound_cards++;
}
else ndsp++;
@@ -525,7 +399,6 @@ static int oss_mus_audio_initialize(void)
{
sound_cards = 1;
audio_dsp[0] = 0;
- audio_type[0] = NORMAL_CARD;
audio_mixer[0] = -2; /* hmmm -- need a way to see /dev/dsp as lonely outpost */
close(fd);
fd = open(MIXER_NAME, O_RDONLY | O_NONBLOCK, 0);
@@ -538,13 +411,6 @@ static int oss_mus_audio_initialize(void)
return(MUS_NO_ERROR);
}
-int mus_audio_reinitialize(void)
-{
- /* an experiment */
- audio_initialized = false;
- return(mus_audio_initialize());
-}
-
static int linux_audio_open(const char *pathname, int flags, mode_t mode, int system)
{
/* sometimes this is simply searching for a device (so failure is not a mus_error) */
@@ -570,7 +436,7 @@ static int linux_audio_open_with_error(const char *pathname, int flags, mode_t m
(!already_warned))
{
already_warned = true;
- MUS_STANDARD_IO_ERROR(MUS_AUDIO_CANT_OPEN,
+ mus_standard_io_error(MUS_AUDIO_CANT_OPEN,
((mode == O_RDONLY) ? "open read" :
(mode == O_WRONLY) ? "open write" : "open read/write"),
pathname);
@@ -605,7 +471,7 @@ static int linux_audio_close(int fd)
}
}
else err = close(fd);
- if (err) RETURN_ERROR_EXIT(MUS_AUDIO_CANT_CLOSE, -1,
+ if (err) return_error_exit(MUS_AUDIO_CANT_CLOSE, -1,
mus_format("close %d failed: %s",
fd, strerror(errno)));
}
@@ -613,7 +479,7 @@ static int linux_audio_close(int fd)
return(MUS_NO_ERROR);
}
-static int to_oss_format(int snd_format)
+static int to_oss_sample_type(mus_sample_t snd_format)
{
switch (snd_format)
{
@@ -629,73 +495,28 @@ static int to_oss_format(int snd_format)
case MUS_LINT: return(AFMT_S32_LE); break;
case MUS_BINT: return(AFMT_S32_BE); break;
#endif
+ default: break;
}
return(MUS_ERROR);
}
-static char sonorus_buf[LABEL_BUFFER_SIZE];
-static char *sonorus_name(int sys, int offset)
-{
- mus_snprintf(sonorus_buf, LABEL_BUFFER_SIZE, "/dev/dsp%d", offset + audio_dsp[sys]);
- return(sonorus_buf);
-}
-
static bool fragment_set_failed = false;
-static int oss_mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size)
+static int oss_mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
- /* ur_dev is in general MUS_AUDIO_PACK_SYSTEM(n) | MUS_AUDIO_DEVICE */
- int oss_format, buffer_info, audio_out = -1, sys, dev;
+ int oss_sample_type, buffer_info, audio_out = -1, sys, dev;
char *dev_name;
#ifndef NEW_OSS
int stereo;
#endif
sys = MUS_AUDIO_SYSTEM(ur_dev);
dev = MUS_AUDIO_DEVICE(ur_dev);
- oss_format = to_oss_format(format);
- if (oss_format == MUS_ERROR)
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, -1,
- mus_format("format %d (%s) not available",
- format,
- mus_data_format_name(format)));
- if (audio_type[sys] == SONORUS_STUDIO)
- {
- /* in this case the output devices are parcelled out to the /dev/dsp locs */
- /* dev/dsp0 is always stereo */
- switch (dev)
- {
- case MUS_AUDIO_DEFAULT:
- if (chans > 2)
- audio_out = open(sonorus_name(sys, 1), O_WRONLY, 0);
- else audio_out = open(sonorus_name(sys, 0), O_WRONLY, 0);
- /* probably should write to both outputs */
- if (audio_out == -1) audio_out = open("/dev/dsp", O_WRONLY, 0);
- break;
- case MUS_AUDIO_SPEAKERS:
- audio_out = open(sonorus_name(sys, 0), O_WRONLY, 0);
- if (audio_out == -1) audio_out = open("/dev/dsp", O_WRONLY, 0);
- break;
- default:
- RETURN_ERROR_EXIT(MUS_AUDIO_DEVICE_NOT_AVAILABLE, audio_out,
- mus_format("Sonorus device %d (%s) not available",
- dev,
- mus_audio_device_name(dev)));
- break;
- }
- if (audio_out == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, audio_out,
- mus_format("can't open Sonorus output device %d (%s): %s",
- dev,
- mus_audio_device_name(dev), strerror(errno)));
-#ifdef NEW_OSS
- if (ioctl(audio_out, MUS_OSS_WRITE_CHANNELS, &chans) == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_out,
- mus_format("can't get %d channels for Sonorus device %d (%s)",
- chans, dev,
- mus_audio_device_name(dev)));
-#endif
- return(audio_out);
- }
+ oss_sample_type = to_oss_sample_type(samp_type);
+ if (oss_sample_type == MUS_ERROR)
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, -1,
+ mus_format("sample type %d (%s) not available",
+ samp_type,
+ mus_sample_type_name(samp_type)));
if (dev == MUS_AUDIO_DEFAULT)
audio_out = linux_audio_open_with_error(dev_name = dac_name(sys, 0),
@@ -733,28 +554,28 @@ static int oss_mus_audio_open_output(int ur_dev, int srate, int chans, int forma
}
}
}
- if ((ioctl(audio_out, MUS_OSS_SET_FORMAT, &oss_format) == -1) ||
- (oss_format != to_oss_format(format)))
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, audio_out,
- mus_format("data format %d (%s) not available on %s",
- format,
- mus_data_format_name(format),
+ if ((ioctl(audio_out, MUS_OSS_SET_FORMAT, &oss_sample_type) == -1) ||
+ (oss_sample_type != to_oss_sample_type(samp_type)))
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, audio_out,
+ mus_format("sample type %d (%s) not available on %s",
+ samp_type,
+ mus_sample_type_name(samp_type),
dev_name));
#ifdef NEW_OSS
if (ioctl(audio_out, MUS_OSS_WRITE_CHANNELS, &chans) == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_out,
+ return_error_exit(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_out,
mus_format("can't get %d channels on %s",
chans, dev_name));
#else
if (chans == 2) stereo = 1; else stereo = 0;
if ((ioctl(audio_out, SNDCTL_DSP_STEREO, &stereo) == -1) ||
((chans == 2) && (stereo == 0)))
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_out,
+ return_error_exit(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_out,
mus_format("can't get %d channels on %s",
chans, dev_name));
#endif
if (ioctl(audio_out, MUS_OSS_WRITE_RATE, &srate) == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_SRATE_NOT_AVAILABLE, audio_out,
+ return_error_exit(MUS_AUDIO_SRATE_NOT_AVAILABLE, audio_out,
mus_format("can't set srate of %s to %d",
dev_name, srate));
/* http://www.4front-tech.com/pguide/audio.html says this order has to be followed */
@@ -770,9 +591,9 @@ static int oss_mus_audio_write(int line, char *buf, int bytes)
if (err != bytes)
{
if (errno != 0)
- RETURN_ERROR_EXIT(MUS_AUDIO_WRITE_ERROR, -1,
+ return_error_exit(MUS_AUDIO_WRITE_ERROR, -1,
mus_format("write error: %s", strerror(errno)));
- else RETURN_ERROR_EXIT(MUS_AUDIO_WRITE_ERROR, -1,
+ else return_error_exit(MUS_AUDIO_WRITE_ERROR, -1,
mus_format("wrote %d bytes of requested %d", err, bytes));
}
return(MUS_NO_ERROR);
@@ -792,9 +613,9 @@ static int oss_mus_audio_read(int line, char *buf, int bytes)
if (err != bytes)
{
if (errno != 0)
- RETURN_ERROR_EXIT(MUS_AUDIO_READ_ERROR, -1,
+ return_error_exit(MUS_AUDIO_READ_ERROR, -1,
mus_format("read error: %s", strerror(errno)));
- else RETURN_ERROR_EXIT(MUS_AUDIO_READ_ERROR, -1,
+ else return_error_exit(MUS_AUDIO_READ_ERROR, -1,
mus_format("read %d bytes of requested %d", err, bytes));
}
return(MUS_NO_ERROR);
@@ -811,56 +632,28 @@ static char *oss_unsrc(int srcbit)
buf = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
if (srcbit & SOUND_MASK_MIC) {need_and = true; strcat(buf, "mic");}
if (srcbit & SOUND_MASK_LINE) {if (need_and) strcat(buf, " and "); need_and = true; strcat(buf, "line in");}
- if (srcbit & SOUND_MASK_CD) {if (need_and) strcat(buf, " and "); need_and = true; strcat(buf, "cd");}
+ if (srcbit & SOUND_MASK_CD) {if (need_and) strcat(buf, " and "); strcat(buf, "cd");}
return(buf);
}
}
-static int oss_mus_audio_open_input(int ur_dev, int srate, int chans, int format, int requested_size)
+static int oss_mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int requested_size)
{
/* dev can be MUS_AUDIO_DEFAULT or MUS_AUDIO_DUPLEX_DEFAULT as well as the obvious others */
- int audio_fd = -1, oss_format, buffer_info, sys, dev, srcbit, cursrc, err;
+ int audio_fd = -1, oss_sample_type, buffer_info, sys, dev, srcbit, cursrc, err;
char *dev_name;
#ifndef NEW_OSS
int stereo;
#endif
sys = MUS_AUDIO_SYSTEM(ur_dev);
dev = MUS_AUDIO_DEVICE(ur_dev);
- oss_format = to_oss_format(format);
- if (oss_format == MUS_ERROR)
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, -1,
- mus_format("format %d (%s) not available",
- format,
- mus_data_format_name(format)));
- if (audio_type[sys] == SONORUS_STUDIO)
- {
- switch (dev)
- {
- case MUS_AUDIO_DEFAULT:
- audio_fd = open(dev_name = sonorus_name(sys, 11), O_RDONLY, 0);
- break;
- default:
- RETURN_ERROR_EXIT(MUS_AUDIO_DEVICE_NOT_AVAILABLE, -1,
- mus_format("no %s device on Sonorus?",
- mus_audio_device_name(dev)));
- break;
- }
- if (audio_fd == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_NO_INPUT_AVAILABLE, -1,
- mus_format("can't open %s (Sonorus device %s): %s",
- dev_name,
- mus_audio_device_name(dev),
- strerror(errno)));
-#ifdef NEW_OSS
- if (ioctl(audio_fd, MUS_OSS_WRITE_CHANNELS, &chans) == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
- mus_format("can't get %d channels on %s (Sonorus device %s)",
- chans, dev_name,
- mus_audio_device_name(dev)));
-#endif
- return(audio_fd);
- }
+ oss_sample_type = to_oss_sample_type(samp_type);
+ if (oss_sample_type == MUS_ERROR)
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, -1,
+ mus_format("sample type %d (%s) not available",
+ samp_type,
+ mus_sample_type_name(samp_type)));
if (((dev == MUS_AUDIO_DEFAULT) || (dev == MUS_AUDIO_DUPLEX_DEFAULT)) && (sys == 0))
audio_fd = linux_audio_open(dev_name = dac_name(sys, 0),
@@ -869,21 +662,19 @@ static int oss_mus_audio_open_input(int ur_dev, int srate, int chans, int format
if (audio_fd == -1)
{
if (dev == MUS_AUDIO_DUPLEX_DEFAULT)
- RETURN_ERROR_EXIT(MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE, -1,
- mus_format("can't open %s (device %s): %s",
- dev_name, mus_audio_device_name(dev), strerror(errno)));
+ return_error_exit(MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE, -1,
+ mus_format("can't open %s: %s",
+ dev_name, strerror(errno)));
if ((audio_fd = linux_audio_open(dev_name = dac_name(sys, 0), O_RDONLY, 0, sys)) == -1)
{
if ((errno == EACCES) || (errno == ENOENT))
- RETURN_ERROR_EXIT(MUS_AUDIO_NO_READ_PERMISSION, -1,
- mus_format("can't open %s (device %s): %s\n to get input in Linux, we need read permission on /dev/dsp",
+ return_error_exit(MUS_AUDIO_NO_READ_PERMISSION, -1,
+ mus_format("can't open %s: %s\n to get input in Linux, we need read permission on /dev/dsp",
dev_name,
- mus_audio_device_name(dev),
strerror(errno)));
- else RETURN_ERROR_EXIT(MUS_AUDIO_NO_INPUT_AVAILABLE, -1,
- mus_format("can't open %s (device %s): %s",
+ else return_error_exit(MUS_AUDIO_NO_INPUT_AVAILABLE, -1,
+ mus_format("can't open %s: %s",
dev_name,
- mus_audio_device_name(dev),
strerror(errno)));
}
}
@@ -891,8 +682,6 @@ static int oss_mus_audio_open_input(int ur_dev, int srate, int chans, int format
else
ioctl(audio_fd, SNDCTL_DSP_SETDUPLEX, &err); /* not always a no-op! */
#endif
- if (audio_type[sys] == RME_HAMMERFALL) return(audio_fd);
- if (audio_type[sys] == DELTA_66) return(audio_fd);
/* need to make sure the desired recording source is active -- does this actually have any effect? */
switch (dev)
{
@@ -921,384 +710,66 @@ static int oss_mus_audio_open_input(int ur_dev, int srate, int chans, int format
buffer_info = (FRAGMENTS << 16) | (FRAGMENT_SIZE);
ioctl(audio_fd, SNDCTL_DSP_SETFRAGMENT, &buffer_info);
}
- if ((ioctl(audio_fd, MUS_OSS_SET_FORMAT, &oss_format) == -1) ||
- (oss_format != to_oss_format(format)))
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, audio_fd,
- mus_format("can't set %s format to %d (%s)",
- dev_name, format,
- mus_data_format_name(format)));
+ if ((ioctl(audio_fd, MUS_OSS_SET_FORMAT, &oss_sample_type) == -1) ||
+ (oss_sample_type != to_oss_sample_type(samp_type)))
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, audio_fd,
+ mus_format("can't set %s sample type to %d (%s)",
+ dev_name, samp_type,
+ mus_sample_type_name(samp_type)));
#ifdef NEW_OSS
if (ioctl(audio_fd, MUS_OSS_WRITE_CHANNELS, &chans) == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
+ return_error_exit(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
mus_format("can't get %d channels on %s",
chans, dev_name));
#else
if (chans == 2) stereo = 1; else stereo = 0;
if ((ioctl(audio_fd, SNDCTL_DSP_STEREO, &stereo) == -1) ||
((chans == 2) && (stereo == 0)))
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
- mus_format("can't get %d channels on %s (%s)",
- chans, dev_name,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
+ mus_format("can't get %d channels on %s",
+ chans, dev_name));
#endif
if (ioctl(audio_fd, MUS_OSS_WRITE_RATE, &srate) == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_SRATE_NOT_AVAILABLE, audio_fd,
- mus_format("can't set srate to %d on %s (%s)",
- srate, dev_name,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_SRATE_NOT_AVAILABLE, audio_fd,
+ mus_format("can't set srate to %d on %s",
+ srate, dev_name));
return(audio_fd);
}
#if (!HAVE_ALSA)
-static int oss_formats(int ur_dev, int *val)
+static int oss_sample_types(int ur_dev, mus_sample_t *val)
{
- int fd, formats = 0, sys, dev, ind;
+ int fd, samp_types = 0, sys, ind;
sys = MUS_AUDIO_SYSTEM(ur_dev);
- dev = MUS_AUDIO_DEVICE(ur_dev);
+ /* dev = MUS_AUDIO_DEVICE(ur_dev); */
fd = open(dac_name(sys, 0), O_WRONLY, 0);
if (fd == -1) fd = open(DAC_NAME, O_WRONLY, 0);
if (fd == -1)
{
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, -1,
+ return_error_exit(MUS_AUDIO_CANT_OPEN, -1,
mus_format("can't open %s: %s",
DAC_NAME, strerror(errno)));
return(MUS_ERROR);
}
- ioctl(fd, MUS_OSS_GET_FORMATS, &formats);
+ ioctl(fd, MUS_OSS_GET_FORMATS, &samp_types);
ind = 1;
- if (formats & (to_oss_format(MUS_BSHORT))) val[ind++] = MUS_BSHORT;
- if (formats & (to_oss_format(MUS_LSHORT))) val[ind++] = MUS_LSHORT;
- if (formats & (to_oss_format(MUS_MULAW))) val[ind++] = MUS_MULAW;
- if (formats & (to_oss_format(MUS_ALAW))) val[ind++] = MUS_ALAW;
- if (formats & (to_oss_format(MUS_BYTE))) val[ind++] = MUS_BYTE;
- if (formats & (to_oss_format(MUS_UBYTE))) val[ind++] = MUS_UBYTE;
- if (formats & (to_oss_format(MUS_UBSHORT))) val[ind++] = MUS_UBSHORT;
- if (formats & (to_oss_format(MUS_ULSHORT))) val[ind++] = MUS_ULSHORT;
- val[0] = ind - 1;
- return(MUS_NO_ERROR);
-}
-#endif
-
-
-static void yes_no(int condition)
-{
- if (condition)
- pprint(" yes ");
- else pprint(" no ");
-}
-
-#if SOUND_VERSION < 0x040000
-static int set_dsp(int fd, int channels, int bits, int *rate)
-{
- int val, fmt;
- val = channels;
- ioctl(fd, MUS_OSS_WRITE_CHANNELS, &val);
- if (val != channels) return(MUS_ERROR);
-
- if (bits == 8)
- val = AFMT_U8;
- else val = AFMT_S16_LE;
- fmt = val;
- ioctl(fd, MUS_OSS_SET_FORMAT, &val);
- if (fmt != val) return(MUS_ERROR);
-
- ioctl(fd, MUS_OSS_WRITE_RATE, rate);
+ if (samp_types & (to_oss_sample_type(MUS_BSHORT))) val[ind++] = MUS_BSHORT;
+ if (samp_types & (to_oss_sample_type(MUS_LSHORT))) val[ind++] = MUS_LSHORT;
+ if (samp_types & (to_oss_sample_type(MUS_MULAW))) val[ind++] = MUS_MULAW;
+ if (samp_types & (to_oss_sample_type(MUS_ALAW))) val[ind++] = MUS_ALAW;
+ if (samp_types & (to_oss_sample_type(MUS_BYTE))) val[ind++] = MUS_BYTE;
+ if (samp_types & (to_oss_sample_type(MUS_UBYTE))) val[ind++] = MUS_UBYTE;
+ if (samp_types & (to_oss_sample_type(MUS_UBSHORT))) val[ind++] = MUS_UBSHORT;
+ if (samp_types & (to_oss_sample_type(MUS_ULSHORT))) val[ind++] = MUS_ULSHORT;
+ val[0] = (mus_sample_t)(ind - 1);
return(MUS_NO_ERROR);
}
#endif
-static void oss_describe_audio_state_1(void)
-{
- /* this code taken largely from "Linux Multimedia Guide" by Jeff Tranter, O'Reilly & Associates, Inc 1996 */
- /* it is explicitly released under the GPL, so I think I can use it here without elaborate disguises */
- int fd;
- int status = 0, level, i, recsrc, devmask, recmask, stereodevs, caps;
-#if SOUND_VERSION < 0x040000
- int rate = 0, channels = 0, blocksize = 0, formats = 0, deffmt = 0, min_rate = 0, max_rate = 0;
-#endif
- const char *sound_device_names[] = SOUND_DEVICE_LABELS;
- char dsp_name[LABEL_BUFFER_SIZE];
- char version[LABEL_BUFFER_SIZE];
- int dsp_num = 0;
-#ifdef NEW_OSS
- mixer_info mixinfo;
- oss_sysinfo sysinfo;
-#endif
-
- if (sound_cards <= 0) mus_audio_initialize();
- memset((void *)dsp_name, 0, LABEL_BUFFER_SIZE);
- memset((void *)version, 0, LABEL_BUFFER_SIZE);
-
-#ifdef NEW_OSS
- fd = open(DAC_NAME, O_WRONLY, 0);
- if (fd == -1) fd = open(MIXER_NAME, O_RDONLY, 0);
- if (fd != -1)
- {
- status = ioctl(fd, OSS_GETVERSION, &level);
- new_oss_running = (status == 0);
- status = ioctl(fd, OSS_SYSINFO, &sysinfo);
- close(fd);
- }
-#endif
-
- if (new_oss_running)
- {
-#ifdef NEW_OSS
- if (status == 0)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "OSS version: %s\n", sysinfo.version);
- pprint(audio_strbuf);
- }
- else
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "OSS version: %x.%x.%x\n", (level >> 16) & 0xff, (level >> 8) & 0xff, level & 0xff);
- pprint(audio_strbuf);
- }
-#else
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "OSS version: %x.%x.%x\n", (level >> 16) & 0xff, (level >> 8) & 0xff, level & 0xff);
- pprint(audio_strbuf);
-#endif
- }
- else
- {
- /* refers to the version upon compilation */
- mus_snprintf(version, LABEL_BUFFER_SIZE, "%d", SOUND_VERSION);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "OSS version: %c.%c.%c\n", version[0], version[1], version[2]);
- pprint(audio_strbuf);
- }
-
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "%d card%s found", sound_cards, (sound_cards != 1) ? "s" : ""); pprint(audio_strbuf);
- if (sound_cards > 1)
- {
- pprint(": ");
- for (i = 0; i < sound_cards; i++)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "/dev/dsp%d with /dev/mixer%d%s",
- audio_dsp[i],
- audio_mixer[i],
- (i < (sound_cards - 1)) ? ", " : "");
- pprint(audio_strbuf);
- }
- }
- pprint("\n\n");
-
- pprint("--------------------------------\n");
-
-MIXER_INFO:
- mus_snprintf(dsp_name, LABEL_BUFFER_SIZE, "%s%d", MIXER_NAME, dsp_num);
- fd = linux_audio_open(dsp_name, O_RDWR, 0, 0);
- if (fd == -1)
- {
- /* maybe output only */
- fd = linux_audio_open(dsp_name, O_WRONLY, 0, 0);
- if (fd == -1)
- {
- if (dsp_num == 0)
- {
- mus_snprintf(dsp_name, LABEL_BUFFER_SIZE, "%s", DAC_NAME);
- fd = linux_audio_open(DAC_NAME, O_RDWR, 0, 0);
- if (fd == -1)
- {
- /* maybe output only */
- fd = linux_audio_open(DAC_NAME, O_WRONLY, 0, 0);
- if (fd == -1)
- {
- pprint("no audio device found\n");
- return;
- }
- }
- }
- else goto AUDIO_INFO; /* no /dev/mixern */
- }
- else pprint("no audio input enabled\n");
- }
- if (fd == -1) goto AUDIO_INFO;
-
-#ifdef NEW_OSS
- if (new_oss_running) status = ioctl(fd, SOUND_MIXER_INFO, &mixinfo);
-#endif
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "%s", dsp_name);
- pprint(audio_strbuf);
-#ifdef NEW_OSS
- if ((new_oss_running) && (status == 0))
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " (%s", mixinfo.name);
- pprint(audio_strbuf);
- for (i = 0; i < sound_cards; i++)
- {
- if ((audio_mixer[i] == dsp_num) && (audio_type[i] == SONORUS_STUDIO))
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " in mode %d", audio_mode[i]);
- pprint(audio_strbuf);
- break;
- }
- }
- pprint(")");
- }
-#endif
- status = ioctl(fd, SOUND_MIXER_READ_RECSRC, &recsrc);
- if (status == -1)
- {
- linux_audio_close(fd);
- fd = -1;
- pprint(" no recsrc\n");
- }
- else
- {
- status = ioctl(fd, SOUND_MIXER_READ_DEVMASK, &devmask);
- if ((status == -1) || (devmask == 0))
- {
- linux_audio_close(fd);
- fd = -1;
- if (status == -1) pprint(" no devmask\n"); else pprint(" (no reported devices)");
- }
- else
- {
- status = ioctl(fd, SOUND_MIXER_READ_RECMASK, &recmask);
- if (status == -1)
- {
- pprint(" no recmask\n");
- recmask = 0;
- }
- status = ioctl(fd, SOUND_MIXER_READ_STEREODEVS, &stereodevs);
- if (status == -1)
- {
- pprint(" no stereodevs\n");
- stereodevs = 0;
- }
- status = ioctl(fd, SOUND_MIXER_READ_CAPS, &caps);
- if (status == -1)
- {
- pprint(" no caps\n");
- caps = 0;
- }
- pprint(":\n\n"
- " mixer recording active stereo current\n"
- " channel source source device level\n"
- " -------- -------- -------- -------- -------- \n");
- for (i = 0; i < SOUND_MIXER_NRDEVICES; i++)
- {
- if ((1<<i) & devmask)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %-10s", sound_device_names[i]);
- pprint(audio_strbuf);
- yes_no((1 << i) & recmask);
- yes_no((1 << i) & recsrc);
- yes_no((1 << i) & stereodevs);
- status = ioctl(fd, MIXER_READ(i), &level);
- if (status != -1)
- {
- if ((1<<i) & stereodevs)
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %.2f %.2f", (float)(level & 0xff) * 0.01, (float)((level & 0xff00) >> 8) * 0.01);
- else mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %.2f", (float)(level & 0xff) * 0.01);
- /* can't use %% here because subsequent fprintf in pprint evaluates the %! #$@$! */
- pprint(audio_strbuf);
- }
- pprint("\n");
- }
- }
- pprint("--------------------------------\n");
- }
- }
-
-AUDIO_INFO:
- if (fd != -1) {linux_audio_close(fd); fd = -1;}
- mus_snprintf(dsp_name, LABEL_BUFFER_SIZE, "%s%d", DAC_NAME, dsp_num);
- fd = linux_audio_open(dsp_name, O_RDWR, 0, 0);
- if ((fd == -1) && (dsp_num == 0)) fd = linux_audio_open(DAC_NAME, O_WRONLY, 0, 0);
- if (fd == -1) return;
-
-#if SOUND_VERSION < 0x040000
- /* Here's Yair K's explanation:
-
- In OSSv4 we can use the same ioctls as the equivalents of the
- respective SOUND_PCM_WRITE_* with arg == 0 to read the current value.
- But in ALSA's OSS emulation this would set everything to mono/slowest
- rate. So there we have to keep using SOUND_PCM_READ_*.
- */
-
- /* since this is just a descriptive function, and not really vital anymore (in the bad old
- * days, getting a sound card to work was a major undertaking), I think I'll just comment
- * out the portions that require rewriting.
- */
-
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "%s:\n\n", dsp_name); pprint(audio_strbuf);
- if ((ioctl(fd, MUS_OSS_READ_RATE, &rate) != -1) &&
- (ioctl(fd, MUS_OSS_READ_CHANNELS, &channels) != -1) &&
- (ioctl(fd, SNDCTL_DSP_GETBLKSIZE, &blocksize) != -1))
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- " defaults:\n sampling rate: %d, chans: %d, block size: %d bytes",
- rate, channels, blocksize);
- pprint(audio_strbuf);
-
-#ifdef SNDCTL_DSP_GETOSPACE
- {
- audio_buf_info abi;
- ioctl(fd, SNDCTL_DSP_GETOSPACE, &abi);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " (%d fragments)\n", abi.fragments);
- pprint(audio_strbuf);
- }
-#else
- pprint("\n");
-#endif
-
- deffmt = AFMT_QUERY;
- if ((ioctl(fd, MUS_OSS_SET_FORMAT, &deffmt) != -1) &&
- (ioctl(fd, MUS_OSS_GET_FORMATS, &formats) != -1))
- {
- pprint(" supported formats:\n");
- if (formats & AFMT_MU_LAW) {pprint(" mulaw"); if (deffmt == AFMT_MU_LAW) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_A_LAW) {pprint(" alaw"); if (deffmt == AFMT_A_LAW) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_IMA_ADPCM) {pprint(" adpcm"); if (deffmt == AFMT_IMA_ADPCM) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_U8) {pprint(" unsigned byte"); if (deffmt == AFMT_U8) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_S16_LE) {pprint(" signed little-endian short"); if (deffmt == AFMT_S16_LE) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_S16_BE) {pprint(" signed big-endian short"); if (deffmt == AFMT_S16_BE) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_S8) {pprint(" signed byte"); if (deffmt == AFMT_S8) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_U16_LE) {pprint(" unsigned little-endian short"); if (deffmt == AFMT_U16_LE) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_U16_BE) {pprint(" unsigned big-endian short"); if (deffmt == AFMT_U16_BE) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_MPEG) {pprint(" mpeg 2"); if (deffmt == AFMT_MPEG) pprint(" (default)"); pprint("\n");}
-#ifdef NEW_OSS
- if (formats & AFMT_S32_LE) {pprint(" signed little-endian int"); if (deffmt == AFMT_S32_LE) pprint(" (default)"); pprint("\n");}
- if (formats & AFMT_S32_BE) {pprint(" signed big-endian int"); if (deffmt == AFMT_S32_BE) pprint(" (default)"); pprint("\n");}
-#endif
- status = ioctl(fd, SNDCTL_DSP_GETCAPS, &caps);
- if (status != -1)
- {
- if (caps & DSP_CAP_DUPLEX) pprint(" full duplex\n");
- pprint(" sample srate\n channels size min max\n");
- for (channels = 1; channels <= 2; channels++)
- {
- int bits;
- for (bits = 8; bits <= 16; bits += 8)
- {
- min_rate = 1;
- if (set_dsp(fd, channels, bits, &min_rate) == MUS_ERROR) continue;
- max_rate = 100000;
- if (set_dsp(fd, channels, bits, &max_rate) == MUS_ERROR) continue;
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %4d %8d %8d %8d\n", channels, bits, min_rate, max_rate);
- pprint(audio_strbuf);
- }
- }
- }
- }
- }
- pprint("--------------------------------\n");
-#endif
-
- linux_audio_close(fd);
- fd = -1;
- dsp_num++;
- if (dsp_num < 16)
- {
- mus_snprintf(dsp_name, LABEL_BUFFER_SIZE, "%s%d", MIXER_NAME, dsp_num);
- goto MIXER_INFO;
- }
-}
@@ -1320,14 +791,12 @@ static int (*vect_mus_audio_initialize)(void);
/* vectors for the rest of the sndlib api */
static void (*vect_mus_oss_set_buffers)(int num, int size);
-static int (*vect_mus_audio_systems)(void);
static char* (*vect_mus_audio_moniker)(void);
-static int (*vect_mus_audio_open_output)(int ur_dev, int srate, int chans, int format, int size);
-static int (*vect_mus_audio_open_input)(int ur_dev, int srate, int chans, int format, int requested_size);
+static int (*vect_mus_audio_open_output)(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size);
+static int (*vect_mus_audio_open_input)(int ur_dev, int srate, int chans, mus_sample_t samp_type, int requested_size);
static int (*vect_mus_audio_write)(int id, char *buf, int bytes);
static int (*vect_mus_audio_read)(int id, char *buf, int bytes);
static int (*vect_mus_audio_close)(int id);
-static void (*vect_describe_audio_state_1)(void);
/* vectors for the rest of the sndlib api */
int mus_audio_initialize(void)
@@ -1340,11 +809,6 @@ void mus_oss_set_buffers(int num, int size)
vect_mus_oss_set_buffers(num, size);
}
-int mus_audio_systems(void)
-{
- return(vect_mus_audio_systems());
-}
-
#if HAVE_ALSA
static char* alsa_mus_audio_moniker(void);
#endif
@@ -1364,14 +828,14 @@ char* mus_audio_moniker(void)
#endif
}
-int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
- return(vect_mus_audio_open_output(ur_dev, srate, chans, format, size));
+ return(vect_mus_audio_open_output(ur_dev, srate, chans, samp_type, size));
}
-int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int requested_size)
+int mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int requested_size)
{
- return(vect_mus_audio_open_input(ur_dev, srate, chans, format, requested_size));
+ return(vect_mus_audio_open_input(ur_dev, srate, chans, samp_type, requested_size));
}
int mus_audio_write(int id, char *buf, int bytes)
@@ -1389,11 +853,6 @@ int mus_audio_close(int id)
return(vect_mus_audio_close(id));
}
-static void describe_audio_state_1(void)
-{
- vect_describe_audio_state_1();
-}
-
#if HAVE_JACK_IN_LINUX
static int jack_mus_audio_initialize(void);
#endif
@@ -1411,14 +870,12 @@ static int probe_api(void)
api = MUS_OSS_API;
vect_mus_audio_initialize = oss_mus_audio_initialize;
vect_mus_oss_set_buffers = oss_mus_oss_set_buffers;
- vect_mus_audio_systems = oss_mus_audio_systems;
vect_mus_audio_moniker = oss_mus_audio_moniker;
vect_mus_audio_open_output = oss_mus_audio_open_output;
vect_mus_audio_open_input = oss_mus_audio_open_input;
vect_mus_audio_write = oss_mus_audio_write;
vect_mus_audio_read = oss_mus_audio_read;
vect_mus_audio_close = oss_mus_audio_close;
- vect_describe_audio_state_1 = oss_describe_audio_state_1;
return(vect_mus_audio_initialize());
#if HAVE_JACK_IN_LINUX
}
@@ -1499,7 +956,7 @@ static int probe_api(void)
#include <sys/ioctl.h>
-#if HAVE_ALSA_ASOUNDLIB_H
+#if HAVE_ALSA
#include <alsa/asoundlib.h>
#else
#include <sys/asoundlib.h>
@@ -1512,13 +969,11 @@ static int probe_api(void)
/* prototypes for the alsa sndlib functions */
static int alsa_mus_audio_initialize(void);
static void alsa_mus_oss_set_buffers(int num, int size);
-static int alsa_mus_audio_systems(void);
-static int alsa_mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size);
-static int alsa_mus_audio_open_input(int ur_dev, int srate, int chans, int format, int requested_size);
+static int alsa_mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size);
+static int alsa_mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int requested_size);
static int alsa_mus_audio_write(int id, char *buf, int bytes);
static int alsa_mus_audio_read(int id, char *buf, int bytes);
static int alsa_mus_audio_close(int id);
-static void alsa_describe_audio_state_1(void);
/* decide which api to activate */
@@ -1537,14 +992,12 @@ static int probe_api(void)
api = MUS_ALSA_API;
vect_mus_audio_initialize = alsa_mus_audio_initialize;
vect_mus_oss_set_buffers = alsa_mus_oss_set_buffers;
- vect_mus_audio_systems = alsa_mus_audio_systems;
vect_mus_audio_moniker = alsa_mus_audio_moniker;
vect_mus_audio_open_output = alsa_mus_audio_open_output;
vect_mus_audio_open_input = alsa_mus_audio_open_input;
vect_mus_audio_write = alsa_mus_audio_write;
vect_mus_audio_read = alsa_mus_audio_read;
vect_mus_audio_close = alsa_mus_audio_close;
- vect_describe_audio_state_1 = alsa_describe_audio_state_1;
}
else
{
@@ -1552,14 +1005,12 @@ static int probe_api(void)
api = MUS_OSS_API;
vect_mus_audio_initialize = oss_mus_audio_initialize;
vect_mus_oss_set_buffers = oss_mus_oss_set_buffers;
- vect_mus_audio_systems = oss_mus_audio_systems;
vect_mus_audio_moniker = oss_mus_audio_moniker;
vect_mus_audio_open_output = oss_mus_audio_open_output;
vect_mus_audio_open_input = oss_mus_audio_open_input;
vect_mus_audio_write = oss_mus_audio_write;
vect_mus_audio_read = oss_mus_audio_read;
vect_mus_audio_close = oss_mus_audio_close;
- vect_describe_audio_state_1 = oss_describe_audio_state_1;
}
/* will the _real_ mus_audio_initialize please stand up? */
return(vect_mus_audio_initialize());
@@ -1569,9 +1020,9 @@ static int probe_api(void)
#endif
}
-/* convert a sndlib sample format to an alsa sample format */
+/* convert a sndlib sample type to an alsa sample type */
-static snd_pcm_format_t to_alsa_format(int snd_format)
+static snd_pcm_format_t to_alsa_format(mus_sample_t snd_format)
{
switch (snd_format)
{
@@ -1593,6 +1044,7 @@ static snd_pcm_format_t to_alsa_format(int snd_format)
case MUS_LFLOAT: return(SND_PCM_FORMAT_FLOAT_LE);
case MUS_BDOUBLE: return(SND_PCM_FORMAT_FLOAT64_BE);
case MUS_LDOUBLE: return(SND_PCM_FORMAT_FLOAT64_LE);
+ default: break;
}
return((snd_pcm_format_t)MUS_ERROR);
}
@@ -1602,7 +1054,7 @@ static snd_pcm_format_t to_alsa_format(int snd_format)
* using...
*/
-static int to_mus_format(int alsa_format)
+static mus_sample_t to_mus_sample_type(int alsa_format)
{
/* alsa format definitions from asoundlib.h (0.9 cvs 6/27/2001) */
switch (alsa_format)
@@ -1635,7 +1087,7 @@ static int to_mus_format(int alsa_format)
case SND_PCM_FORMAT_GSM:
case SND_PCM_FORMAT_SPECIAL:
default:
- return(MUS_ERROR);
+ return(MUS_UNKNOWN_SAMPLE);
}
}
@@ -1753,7 +1205,6 @@ static void alsa_dump_configuration(char *name, snd_pcm_hw_params_t *hw_params,
{
int err;
char *str;
- size_t len;
snd_output_t *buf;
#if (SND_LIB_MAJOR == 0) || ((SND_LIB_MAJOR == 1) && (SND_LIB_MINOR == 0) && (SND_LIB_SUBMINOR < 8))
@@ -1762,11 +1213,10 @@ static void alsa_dump_configuration(char *name, snd_pcm_hw_params_t *hw_params,
err = snd_output_buffer_open(&buf);
if (err < 0)
- {
- mus_print("could not open dump buffer: %s", snd_strerror(err));
- }
+ mus_print("could not open dump buffer: %s", snd_strerror(err));
else
{
+ size_t len;
if (hw_params)
{
snd_output_puts(buf, "hw_params status of ");
@@ -1932,17 +1382,12 @@ static void alsa_mus_oss_set_buffers(int num, int size)
/* return the number of cards that are available */
-static int alsa_mus_audio_systems(void)
-{
- return(sound_cards);
-}
-
/* return the type of driver we're dealing with */
static char *alsa_mus_audio_moniker(void)
{
if (version_name == NULL) version_name = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
- mus_snprintf(version_name, LABEL_BUFFER_SIZE, "ALSA %s", SND_LIB_VERSION_STR);
+ snprintf(version_name, LABEL_BUFFER_SIZE, "ALSA %s", SND_LIB_VERSION_STR);
return(version_name);
}
@@ -2373,15 +1818,14 @@ static int alsa_mus_audio_initialize(void)
/* open an input or output stream */
-static int alsa_audio_open(int ur_dev, int srate, int chans, int format, int size)
+static int alsa_audio_open(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
- int card, device, alsa_device;
+ int device, alsa_device;
snd_pcm_format_t alsa_format;
snd_pcm_stream_t alsa_stream;
char *alsa_name;
int frames, periods;
int err;
- unsigned int r;
snd_pcm_t *handle;
snd_pcm_hw_params_t *hw_params = NULL;
snd_pcm_sw_params_t *sw_params = NULL;
@@ -2393,32 +1837,33 @@ static int alsa_audio_open(int ur_dev, int srate, int chans, int format, int siz
if (alsa_trace)
mus_print("%s: %x rate=%d, chans=%d, format=%d:%s, size=%d",
- c__FUNCTION__, ur_dev, srate, chans, format,
- mus_data_format_to_string(format), size);
+ __func__, ur_dev, srate, chans, samp_type,
+ mus_sample_type_to_string(samp_type), size);
- card = MUS_AUDIO_SYSTEM(ur_dev);
+ /* card = MUS_AUDIO_SYSTEM(ur_dev); */
device = MUS_AUDIO_DEVICE(ur_dev);
if ((err = to_alsa_device(device, &alsa_device, &alsa_stream)) < 0)
{
return(alsa_mus_error(MUS_AUDIO_DEVICE_NOT_AVAILABLE,
- mus_format("%s: cannot translate device %s<%d> to alsa",
- snd_strerror(err), mus_audio_device_name(device), device)));
+ mus_format("%s: cannot translate device %d to alsa",
+ snd_strerror(err), device)));
}
- if ((alsa_format = to_alsa_format(format)) == (snd_pcm_format_t)MUS_ERROR)
+ if ((alsa_format = to_alsa_format(samp_type)) == (snd_pcm_format_t)MUS_ERROR)
{
- return(alsa_mus_error(MUS_AUDIO_FORMAT_NOT_AVAILABLE,
+ return(alsa_mus_error(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE,
mus_format("could not change %s<%d> to alsa format",
- mus_data_format_to_string(format), format)));
+ mus_sample_type_to_string(samp_type), samp_type)));
}
alsa_name = (alsa_stream == SND_PCM_STREAM_PLAYBACK) ? alsa_playback_device_name : alsa_capture_device_name;
if ((err = snd_pcm_open(&handle, alsa_name, alsa_stream, alsa_open_mode)) != 0)
{
- snd_pcm_close(handle);
+ /* snd_pcm_close(handle); */
+ /* this segfaults in some versions of ALSA */
return(alsa_mus_error(MUS_AUDIO_CANT_OPEN,
- mus_format("open pcm %s (%s) stream %s: %s",
- mus_audio_device_name(device), alsa_name, snd_pcm_stream_name(alsa_stream),
+ mus_format("open pcm %s stream %s: %s",
+ alsa_name, snd_pcm_stream_name(alsa_stream),
snd_strerror(err))));
}
handles[alsa_stream] = handle;
@@ -2461,7 +1906,7 @@ static int alsa_audio_open(int ur_dev, int srate, int chans, int format, int siz
snd_strerror(err), alsa_name, periods, (int)minp, (int)maxp)));
}
- frames = size / chans / mus_bytes_per_sample(format);
+ frames = size / chans / mus_bytes_per_sample(samp_type);
err = snd_pcm_hw_params_set_buffer_size(handle, hw_params, frames * periods);
if (err < 0)
@@ -2504,7 +1949,7 @@ total requested buffer size is %d frames, minimum allowed is %d, maximum is %d",
unsigned int new_rate;
new_rate = srate;
/* r is unsigned int so it can't be negative */
- r = snd_pcm_hw_params_set_rate_near(handle, hw_params, &new_rate, 0);
+ err = snd_pcm_hw_params_set_rate_near(handle, hw_params, &new_rate, 0);
if ((new_rate != (unsigned int)srate) && (!alsa_squelch_warning))
{
mus_print("%s: could not set rate to exactly %d, set to %d instead",
@@ -2542,16 +1987,16 @@ total requested buffer size is %d frames, minimum allowed is %d, maximum is %d",
/* sndlib support for opening output devices */
-static int alsa_mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size)
+static int alsa_mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
- return(alsa_audio_open(ur_dev, srate, chans, format, size));
+ return(alsa_audio_open(ur_dev, srate, chans, samp_type, size));
}
/* sndlib support for opening input devices */
-static int alsa_mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
+static int alsa_mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
- return(alsa_audio_open(ur_dev, srate, chans, format, size));
+ return(alsa_audio_open(ur_dev, srate, chans, samp_type, size));
}
/* sndlib support for closing a device */
@@ -2562,12 +2007,12 @@ static bool xrun_warned = false;
static int alsa_mus_audio_close(int id)
{
- int err = 0;
xrun_warned = false;
if (id == MUS_ERROR) return(MUS_ERROR);
- if (alsa_trace) mus_print( "%s: %d", c__FUNCTION__, id);
+ if (alsa_trace) mus_print( "%s: %d", __func__, id);
if (handles[id])
{
+ int err;
err = snd_pcm_drain(handles[id]);
if (err != 0)
mus_print("snd_pcm_drain: %s", snd_strerror(err));
@@ -2593,7 +2038,7 @@ static int recover_from_xrun(int id)
err = snd_pcm_status(handles[id], status);
if (err < 0)
{
- mus_print("%s: snd_pcm_status: %s", c__FUNCTION__, snd_strerror(err));
+ mus_print("%s: snd_pcm_status: %s", __func__, snd_strerror(err));
return(MUS_ERROR);
}
state = snd_pcm_status_get_state(status);
@@ -2609,7 +2054,7 @@ static int recover_from_xrun(int id)
mus_print("snd_pcm_prepare: %s", snd_strerror(err));
else return(MUS_NO_ERROR);
}
- else mus_print("%s: error, current state is %s", c__FUNCTION__, snd_pcm_state_name(state));
+ else mus_print("%s: error, current state is %s", __func__, snd_pcm_state_name(state));
return(MUS_ERROR);
}
@@ -2730,13 +2175,12 @@ static int alsa_chans(int ur_dev, int *info)
}
-static int alsa_formats(int ur_dev, int chan, int *val)
+static int alsa_sample_types(int ur_dev, int chan, mus_sample_t *val)
{
int card;
int device;
int alsa_device = 0;
snd_pcm_stream_t alsa_stream = SND_PCM_STREAM_PLAYBACK;
- int f, err;
if ((!audio_initialized) &&
(mus_audio_initialize() != MUS_NO_ERROR))
@@ -2750,7 +2194,7 @@ static int alsa_formats(int ur_dev, int chan, int *val)
return(alsa_mus_error(MUS_AUDIO_CANT_READ, NULL));
{
- int format;
+ int f, format;
snd_pcm_format_mask_t *mask;
snd_pcm_format_mask_alloca(&mask);
@@ -2758,57 +2202,21 @@ static int alsa_formats(int ur_dev, int chan, int *val)
for (format = 0, f = 1; format < SND_PCM_FORMAT_LAST; format++)
{
+ int err;
err = snd_pcm_format_mask_test(mask, (snd_pcm_format_t)format);
if (err > 0)
{
if ((f < chan) &&
- (to_mus_format(format) != MUS_ERROR))
- val[f++] = to_mus_format(format);
+ (to_mus_sample_type(format) != MUS_UNKNOWN_SAMPLE))
+ val[f++] = to_mus_sample_type(format);
}
}
- val[0] = f - 1;
+ val[0] = (mus_sample_t)(f - 1);
}
return(MUS_NO_ERROR);
}
-static void alsa_describe_audio_state_1(void)
-{
- int err;
- char *str;
- size_t len;
- snd_config_t *conf;
- snd_output_t *buf = NULL;
-#if ((SND_LIB_MAJOR == 1) && (SND_LIB_MINOR == 0) && (SND_LIB_SUBMINOR < 8))
- return; /* avoid Alsa bug */
-#endif
- err = snd_config_update();
- if (err < 0)
- {
- mus_print("snd_config_update: %s", snd_strerror(err));
- return;
- }
- err = snd_output_buffer_open(&buf);
- if (err < 0)
- mus_print("could not open dump buffer: %s", snd_strerror(err));
- else
- {
- err = snd_config_search(snd_config, "pcm", &conf);
- if (err < 0)
- {
- mus_print("snd_config_search: could not find at least one pcm: %s", snd_strerror(err));
- return;
- }
- snd_output_puts(buf, "PCM list:\n");
- snd_config_save(conf, buf);
- snd_output_putc(buf, '\0');
- len = snd_output_buffer_string(buf, &str);
- if (len > 1)
- pprint(str);
- snd_output_close(buf);
- }
-}
-
#endif /* HAVE_ALSA */
@@ -2821,11 +2229,13 @@ static void alsa_describe_audio_state_1(void)
/* apparently input other than 8000 is 16-bit, 8000 is (?) mulaw */
-#if (defined(MUS_SUN) || defined(MUS_OPENBSD)) && (!(defined(AUDIO_OK)))
+#if (defined(__sun) || defined(__SVR4)) && (!(defined(AUDIO_OK)))
#define AUDIO_OK 1
#include <sys/types.h>
-#include <stropts.h>
+#ifdef SUNOS
+ #include <stropts.h>
+#endif
#include <sys/filio.h>
#ifdef SUNOS
@@ -2833,26 +2243,20 @@ static void alsa_describe_audio_state_1(void)
#else
#include <sys/audioio.h>
#endif
-#if HAVE_SYS_MIXER_H
+
#include <sys/mixer.h>
-#endif
int mus_audio_initialize(void) {return(MUS_NO_ERROR);}
-int mus_audio_systems(void) {return(1);}
-#ifdef MUS_OPENBSD
- #define DAC_NAME "/dev/sound"
-#else
- #define DAC_NAME "/dev/audio"
-#endif
+#define DAC_NAME "/dev/audio"
#define AUDIODEV_ENV "AUDIODEV"
-#define RETURN_ERROR_EXIT(Error_Type, Audio_Line, Ur_Error_Message) \
+#define return_error_exit(Error_Type, Audio_Line, Ur_Error_Message) \
do { char *Error_Message; Error_Message = Ur_Error_Message; \
if (Audio_Line != -1) close(Audio_Line); \
if (Error_Message) \
- {MUS_STANDARD_ERROR(Error_Type, Error_Message); free(Error_Message);} \
- else MUS_STANDARD_ERROR(Error_Type, mus_error_type_to_string(Error_Type)); \
+ {mus_standard_error(Error_Type, Error_Message); free(Error_Message);} \
+ else mus_standard_error(Error_Type, mus_error_type_to_string(Error_Type)); \
return(MUS_ERROR); \
} while (false)
@@ -2867,7 +2271,7 @@ char *mus_audio_moniker(void)
char *dev_name;
if (getenv(AUDIODEV_ENV) != NULL)
dev_name = getenv(AUDIODEV_ENV);
- else dev_name = DAC_NAME;
+ else dev_name = (char *)DAC_NAME;
audio_fd = open(dev_name, O_RDONLY | O_NONBLOCK, 0);
if (audio_fd == -1)
{
@@ -2881,89 +2285,73 @@ char *mus_audio_moniker(void)
return("sun?");
}
mus_audio_close(audio_fd);
-#if HAVE_SYS_MIXER_H
+
if (version_name == NULL) version_name = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
-#else
- if (version_name == NULL) version_name = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
-#endif
#ifndef AUDIO_DEV_AMD
- #if HAVE_SYS_MIXER_H
- mus_snprintf(version_name, PRINT_BUFFER_SIZE,
- "audio: %s (%s), %s %s %s",
- ad.name, ad.version,
- MIXER_NAME, MIXER_VERSION, MIXER_CONFIGURATION);
- #else
- mus_snprintf(version_name, LABEL_BUFFER_SIZE, "audio: %s (%s)", ad.name, ad.version);
- #endif
+ snprintf(version_name, LABEL_BUFFER_SIZE, "audio: %s (%s)", ad.name, ad.version);
#else
switch (ad)
{
- case AUDIO_DEV_AMD: mus_snprintf(version_name, LABEL_BUFFER_SIZE, "audio: amd"); break;
+ case AUDIO_DEV_AMD: snprintf(version_name, LABEL_BUFFER_SIZE, "audio: amd"); break;
#ifdef AUDIO_DEV_CS4231
- case AUDIO_DEV_CS4231: mus_snprintf(version_name, LABEL_BUFFER_SIZE, "audio: cs4231"); break;
+ case AUDIO_DEV_CS4231: snprintf(version_name, LABEL_BUFFER_SIZE, "audio: cs4231"); break;
#endif
- case AUDIO_DEV_SPEAKERBOX: mus_snprintf(version_name, LABEL_BUFFER_SIZE, "audio: speakerbox"); break;
- case AUDIO_DEV_CODEC: mus_snprintf(version_name, LABEL_BUFFER_SIZE, "audio: codec"); break;
- default: mus_snprintf(version_name, LABEL_BUFFER_SIZE, "audio: unknown"); break;
+ case AUDIO_DEV_SPEAKERBOX: snprintf(version_name, LABEL_BUFFER_SIZE, "audio: speakerbox"); break;
+ case AUDIO_DEV_CODEC: snprintf(version_name, LABEL_BUFFER_SIZE, "audio: codec"); break;
+ default: snprintf(version_name, LABEL_BUFFER_SIZE, "audio: unknown"); break;
}
#endif
return(version_name);
}
-static int to_sun_format(int format)
+static int to_sun_sample_type(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
#if MUS_LITTLE_ENDIAN
case MUS_LSHORT: /* Solaris on Intel? */
#else
case MUS_BSHORT:
#endif
-#ifdef MUS_OPENBSD
- return(AUDIO_ENCODING_PCM16);
-#else
return(AUDIO_ENCODING_LINEAR);
-#endif
break;
case MUS_BYTE:
#if defined(AUDIO_ENCODING_LINEAR8)
return(AUDIO_ENCODING_LINEAR8); break;
#else
- #ifdef MUS_OPENBSD
- return(AUDIO_ENCODING_PCM8);
- #else
return(AUDIO_ENCODING_LINEAR);
- #endif
break;
#endif
case MUS_MULAW: return(AUDIO_ENCODING_ULAW); break;
case MUS_ALAW: return(AUDIO_ENCODING_ALAW); break;
/* there's also AUDIO_ENCODING_DVI */
+
+ default: break;
}
return(MUS_ERROR);
}
-int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
struct audio_info info;
char *dev_name;
int encode, bits, dev;
int audio_fd, err;
dev = MUS_AUDIO_DEVICE(ur_dev);
- encode = to_sun_format(format);
+ encode = to_sun_sample_type(samp_type);
if (encode == MUS_ERROR)
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, -1,
- mus_format("format %d (%s) not available",
- format,
- mus_data_format_name(format)));
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, -1,
+ mus_format("sample type %d (%s) not available",
+ samp_type,
+ mus_sample_type_name(samp_type)));
if (getenv(AUDIODEV_ENV) != NULL)
dev_name = getenv(AUDIODEV_ENV);
- else dev_name = DAC_NAME;
+ else dev_name = (char *)DAC_NAME;
if (dev != MUS_AUDIO_DUPLEX_DEFAULT)
audio_fd = open(dev_name, O_WRONLY, 0);
else audio_fd = open(dev_name, O_RDWR, 0);
if (audio_fd == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, -1,
+ return_error_exit(MUS_AUDIO_CANT_OPEN, -1,
mus_format("can't open output %s: %s",
dev_name, strerror(errno)));
AUDIO_INITINFO(&info);
@@ -2979,7 +2367,7 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
}
info.play.sample_rate = srate;
info.play.channels = chans;
- bits = 8 * mus_bytes_per_sample(format);
+ bits = 8 * mus_bytes_per_sample(samp_type);
info.play.precision = bits;
info.play.encoding = encode;
err = ioctl(audio_fd, AUDIO_SETINFO, &info);
@@ -2988,33 +2376,35 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
ioctl(audio_fd, AUDIO_GETINFO, &info);
if ((int)info.play.channels != chans)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
- mus_format("can't set output %s (%s) channels to %d",
- mus_audio_device_name(dev), dev_name, chans));
+ return_error_exit(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
+ mus_format("can't set output %s channels to %d",
+ dev_name, chans));
if (((int)info.play.precision != bits) ||
((int)info.play.encoding != encode))
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, audio_fd,
- mus_format("can't set output %s (%s) format to %d bits, %d encode (%s)",
- mus_audio_device_name(dev), dev_name,
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, audio_fd,
+ mus_format("can't set output %s sample type to %d bits, %d encode (%s)",
+ dev_name,
bits, encode,
- mus_data_format_name(format)));
+ mus_sample_type_name(samp_type)));
if ((int)info.play.sample_rate != srate)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
- mus_format("can't set output %s (%s) srate to %d",
- mus_audio_device_name(dev), dev_name, srate));
+ return_error_exit(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
+ mus_format("can't set output %s srate to %d",
+ dev_name, srate));
}
/* man audio sez the play.buffer_size field is not currently supported */
/* but since the default buffer size is 8180! we need ioctl(audio_fd, I_SETSIG, ...) */
+#ifdef SUNOS
ioctl(audio_fd, I_FLUSH, FLUSHR);
+#endif
return(audio_fd);
}
int mus_audio_write(int line, char *buf, int bytes)
{
if (write(line, buf, bytes) != bytes)
- RETURN_ERROR_EXIT(MUS_AUDIO_WRITE_ERROR, -1,
+ return_error_exit(MUS_AUDIO_WRITE_ERROR, -1,
mus_format("write error: %s", strerror(errno)));
return(MUS_NO_ERROR);
}
@@ -3056,27 +2446,27 @@ int mus_audio_read(int line, char *buf, int bytes)
return(MUS_NO_ERROR);
}
-int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
struct audio_info info;
int indev, encode, bits, dev, audio_fd, err;
char *dev_name;
dev = MUS_AUDIO_DEVICE(ur_dev);
- encode = to_sun_format(format);
- bits = 8 * mus_bytes_per_sample(format);
+ encode = to_sun_sample_type(samp_type);
+ bits = 8 * mus_bytes_per_sample(samp_type);
if (encode == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, -1,
- mus_format("format %d bits, %d encode (%s) not available",
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, -1,
+ mus_format("sample type %d bits, %d encode (%s) not available",
bits, encode,
- mus_data_format_name(format)));
+ mus_sample_type_name(samp_type)));
if (getenv(AUDIODEV_ENV) != NULL)
dev_name = getenv(AUDIODEV_ENV);
- else dev_name = DAC_NAME;
+ else dev_name = (char *)DAC_NAME;
if (dev != MUS_AUDIO_DUPLEX_DEFAULT)
audio_fd = open(dev_name, O_RDONLY, 0);
else audio_fd = open(dev_name, O_RDWR, 0);
if (audio_fd == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, -1,
+ return_error_exit(MUS_AUDIO_CANT_OPEN, -1,
mus_format("can't open input %s: %s",
dev_name, strerror(errno)));
AUDIO_INITINFO(&info);
@@ -3085,11 +2475,10 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
info.record.channels = chans;
err = ioctl(audio_fd, AUDIO_SETINFO, &info);
if (err == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, audio_fd,
- mus_format("can't set srate %d and chans %d for input %s (%s)",
+ return_error_exit(MUS_AUDIO_CANT_OPEN, audio_fd,
+ mus_format("can't set srate %d and chans %d for input %s",
srate, chans,
- dev_name,
- mus_audio_device_name(dev)));
+ dev_name));
ioctl(audio_fd, AUDIO_GETINFO, &info);
if (info.record.sample_rate != (unsigned int)srate)
mus_print("%s[%d]: sampling rate: %d != %d\n",
@@ -3104,11 +2493,10 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
info.record.encoding = encode;
err = ioctl(audio_fd, AUDIO_SETINFO, &info);
if (err == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, audio_fd,
- mus_format("can't set bits %d, encode %d (format %s) for input %s (%s)",
- bits, encode, mus_data_format_name(format),
- dev_name,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_CANT_OPEN, audio_fd,
+ mus_format("can't set bits %d, encode %d (sample type %s) for input %s",
+ bits, encode, mus_sample_type_name(samp_type),
+ dev_name));
ioctl(audio_fd, AUDIO_GETINFO, &info);
/* these cannot be OR'd */
@@ -3118,56 +2506,52 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
info.record.port = indev;
err = ioctl(audio_fd, AUDIO_SETINFO, &info);
if (err == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_WRITE, audio_fd,
- mus_format("can't set record.port to %d for %s (%s)",
- indev, dev_name,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_CANT_WRITE, audio_fd,
+ mus_format("can't set record.port to %d for %s",
+ indev, dev_name));
err = ioctl(audio_fd, AUDIO_GETINFO, &info);
if (err == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_READ, audio_fd,
- mus_format("can't getinfo on input %s (%s, line: %d)",
+ return_error_exit(MUS_AUDIO_CANT_READ, audio_fd,
+ mus_format("can't getinfo on input %s (line: %d)",
dev_name,
- mus_audio_device_name(dev), audio_fd));
+ audio_fd));
else
{
if ((int)info.record.port != indev)
- RETURN_ERROR_EXIT(MUS_AUDIO_DEVICE_NOT_AVAILABLE, audio_fd,
- mus_format("confusion in record.port: %d != %d (%s: %s)",
+ return_error_exit(MUS_AUDIO_DEVICE_NOT_AVAILABLE, audio_fd,
+ mus_format("confusion in record.port: %d != %d (%s)",
(int)info.record.port, indev,
- dev_name,
- mus_audio_device_name(dev)));
+ dev_name));
if ((int)info.record.channels != chans)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
- mus_format("confusion in record.channels: %d != %d (%s: %s)",
+ return_error_exit(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_fd,
+ mus_format("confusion in record.channels: %d != %d (%s)",
(int)info.record.channels, chans,
- dev_name,
- mus_audio_device_name(dev)));
+ dev_name));
if (((int)info.record.precision != bits) ||
((int)info.record.encoding != encode))
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, audio_fd,
- mus_format("confusion in record.precision|encoding: %d != %d or %d != %d (%s: %s)",
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, audio_fd,
+ mus_format("confusion in record.precision|encoding: %d != %d or %d != %d (%s)",
(int)info.record.precision, bits,
(int)info.record.encoding, encode,
- dev_name,
- mus_audio_device_name(dev)));
+ dev_name));
}
/* this may be a bad idea */
info.record.buffer_size = size;
err = ioctl(audio_fd, AUDIO_SETINFO, &info);
if (err == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_WRITE, audio_fd,
- mus_format("can't set buffer size to %d on input %s (%s)",
+ return_error_exit(MUS_AUDIO_CANT_WRITE, audio_fd,
+ mus_format("can't set buffer size to %d on input %s",
size,
- dev_name,
- mus_audio_device_name(dev)));
+ dev_name));
return(audio_fd);
}
+#if 0
/* pause can be implemented with play.pause and record.pause */
-static char *sun_format_name(int format)
+static const char *sun_sample_type_name(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
#ifdef AUDIO_ENCODING_ALAW
case AUDIO_ENCODING_ALAW: return("alaw"); break;
@@ -3199,7 +2583,7 @@ static char *sun_format_name(int format)
return("unknown");
}
-static char *sun_in_device_name(int dev)
+static const char *sun_in_device_name(int dev)
{
if (dev == AUDIO_MICROPHONE) return("microphone");
if (dev == AUDIO_LINE_IN) return("line in");
@@ -3211,7 +2595,7 @@ static char *sun_in_device_name(int dev)
return("unknown");
}
-static char *sun_out_device_name(int dev)
+static const char *sun_out_device_name(int dev)
{
if (dev == AUDIO_SPEAKER) return("speakers");
if (dev == AUDIO_LINE_OUT) return("line out");
@@ -3223,122 +2607,30 @@ static char *sun_out_device_name(int dev)
return("unknown");
}
+
static char *sun_vol_name = NULL;
static char *sun_volume_name(float vol, int balance, int chans)
{
if (sun_vol_name == NULL) sun_vol_name = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
if (chans != 2)
- mus_snprintf(sun_vol_name, LABEL_BUFFER_SIZE, "%.3f", vol);
+ snprintf(sun_vol_name, LABEL_BUFFER_SIZE, "%.3f", vol);
else
{
- mus_snprintf(sun_vol_name, LABEL_BUFFER_SIZE, "%.3f %.3f",
+ snprintf(sun_vol_name, LABEL_BUFFER_SIZE, "%.3f %.3f",
vol * (float)(AUDIO_RIGHT_BALANCE - balance) / (float)AUDIO_RIGHT_BALANCE,
vol * (float)balance / (float)AUDIO_RIGHT_BALANCE);
}
return(sun_vol_name);
}
-static void describe_audio_state_1(void)
-{
- struct audio_info info;
-#ifndef AUDIO_DEV_AMD
- struct audio_device ad;
-#else
- int ad;
-#endif
- int audio_fd, err;
- char *dev_name;
- AUDIO_INITINFO(&info);
- if (getenv(AUDIODEV_ENV) != NULL)
- dev_name = getenv(AUDIODEV_ENV);
- else dev_name = DAC_NAME;
- audio_fd = open(dev_name, O_RDONLY | O_NONBLOCK, 0);
- if (audio_fd == -1)
- audio_fd = open("/dev/audioctl", O_RDONLY | O_NONBLOCK, 0);
- if (audio_fd == -1) return;
- err = ioctl(audio_fd, AUDIO_GETINFO, &info);
- if (err == -1) return;
- err = ioctl(audio_fd, AUDIO_GETDEV, &ad);
- if (err == -1) return;
- pprint(mus_audio_moniker());
- pprint("\n");
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "output: %s\n srate: %d, vol: %s, chans: %d, format %d-bit %s\n",
- sun_out_device_name(info.play.port),
- info.play.sample_rate,
- sun_volume_name((float)info.play.gain / (float)AUDIO_MAX_GAIN, info.play.balance, 2),
- info.play.channels,
- info.play.precision,
- sun_format_name(info.play.encoding));
- pprint(audio_strbuf);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "input: %s\n srate: %d, vol: %s, chans: %d, format %d-bit %s\n",
- sun_in_device_name(info.record.port),
- info.record.sample_rate,
- sun_volume_name((float)info.record.gain / (float)AUDIO_MAX_GAIN, info.record.balance, 2),
- info.record.channels,
- info.record.precision,
- sun_format_name(info.record.encoding));
- pprint(audio_strbuf);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "input->output vol: %.3f\n", (float)info.monitor_gain / (float)AUDIO_MAX_GAIN);
- pprint(audio_strbuf);
- if (info.play.pause) {mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "Playback is paused\n"); pprint(audio_strbuf);}
- if (info.record.pause) {mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "Recording is paused\n"); pprint(audio_strbuf);}
- if (info.output_muted) {mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "Output is muted\n"); pprint(audio_strbuf);}
-#ifdef AUDIO_HWFEATURE_DUPLEX
- if (info.hw_features == AUDIO_HWFEATURE_DUPLEX)
- {mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "Simultaneous play and record supported\n"); pprint(audio_strbuf);}
-#endif
-#if HAVE_SYS_MIXER_H
- {
- int i, num = 0, choice;
- #define LARGE_NUMBER 100
- am_sample_rates_t *sr = NULL;
- for (choice = 0; choice < 2; choice++)
- {
- for (num = 4; num < LARGE_NUMBER; num += 2)
- {
- sr = (am_sample_rates_t *)
- malloc(AUDIO_MIXER_SAMP_RATES_STRUCT_SIZE(num));
- sr->num_samp_rates = num;
- sr->type = (choice == 0) ? AUDIO_PLAY : AUDIO_RECORD;
- err = ioctl(audio_fd, AUDIO_MIXER_GET_SAMPLE_RATES, sr);
- if ((int)(sr->num_samp_rates) <= num) break;
- free(sr);
- sr = NULL;
- }
- if (sr)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "%s srates:", (choice == 0) ? "play" : "record");
- pprint(audio_strbuf);
- if (sr->type == MIXER_SR_LIMITS)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %d to %d", sr->samp_rates[0], sr->samp_rates[sr->num_samp_rates - 1]);
- pprint(audio_strbuf);
- }
- else
- {
- for (i = 0; i < (int)(sr->num_samp_rates); i++)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %d", sr->samp_rates[i]);
- pprint(audio_strbuf);
- }
- }
- pprint("\n");
- }
- free(sr);
- sr = NULL;
- }
- }
#endif
- mus_audio_close(audio_fd);
-}
-
#endif
/* ------------------------------- WINDOZE ----------------------------------------- */
-#if defined(MUS_WINDOZE) && (!(defined(__CYGWIN__)))
+#if defined(_MSC_VER) && (!(defined(__CYGWIN__)))
#define AUDIO_OK 1
#include <windows.h>
@@ -3381,7 +2673,7 @@ static void win_mus_print(char *msg)
if (win_in_err)
waveInGetErrorText(win_in_err, getstr, PRINT_BUFFER_SIZE);
else waveOutGetErrorText(win_out_err, getstr, PRINT_BUFFER_SIZE);
- mus_snprintf(errstr, PRINT_BUFFER_SIZE, "%s [%s]", msg, getstr);
+ snprintf(errstr, PRINT_BUFFER_SIZE, "%s [%s]", msg, getstr);
(*old_handler)(errstr);
}
}
@@ -3399,20 +2691,15 @@ static void end_win_print(void)
else mus_print_set_handler(old_handler);
}
-#define RETURN_ERROR_EXIT(Error_Type, Ur_Error_Message) \
+#define return_error_exit(Error_Type, Ur_Error_Message) \
do { char *Error_Message; Error_Message = Ur_Error_Message; \
if (Error_Message) \
- {MUS_STANDARD_ERROR(Error_Type, Error_Message); free(Error_Message);} \
- else MUS_STANDARD_ERROR(Error_Type, mus_error_type_to_string(Error_Type)); \
+ {mus_standard_error(Error_Type, Error_Message); free(Error_Message);} \
+ else mus_standard_error(Error_Type, mus_error_type_to_string(Error_Type)); \
end_win_print(); \
return(MUS_ERROR); \
} while (false)
-int mus_audio_systems(void)
-{
- /* this number is available -- see below (user mixer number as in linux)->mixerGetNumDevs */
- return(1);
-}
DWORD CALLBACK next_buffer(HWAVEOUT w, UINT msg, DWORD user_data, DWORD p1, DWORD p2)
@@ -3424,7 +2711,7 @@ DWORD CALLBACK next_buffer(HWAVEOUT w, UINT msg, DWORD user_data, DWORD p1, DWOR
return(0);
}
-int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
WAVEFORMATEX wf;
int dev;
@@ -3434,7 +2721,7 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
current_chans = chans;
wf.wFormatTag = WAVE_FORMAT_PCM;
wf.cbSize = 0;
- if (format == MUS_UBYTE)
+ if (samp_type == MUS_UBYTE)
{
wf.wBitsPerSample = 8;
current_datum_size = 1;
@@ -3454,10 +2741,8 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
#endif
/* 0 here = user_data above, other case = WAVE_FORMAT_QUERY */
if (win_out_err)
- RETURN_ERROR_EXIT(MUS_AUDIO_DEVICE_NOT_AVAILABLE,
- mus_format("can't open %d (%s)",
- dev,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_DEVICE_NOT_AVAILABLE,
+ mus_format("can't open %d", dev));
waveOutPause(fd);
if (size <= 0)
buffer_size = 1024;
@@ -3469,20 +2754,16 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
if ((wh[0].lpData) == 0)
{
waveOutClose(fd);
- RETURN_ERROR_EXIT(MUS_AUDIO_SIZE_NOT_AVAILABLE,
- mus_format("can't allocate buffer size %d for output %d (%s)",
- buffer_size, dev,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_SIZE_NOT_AVAILABLE,
+ mus_format("can't allocate buffer size %d for output %d", buffer_size, dev));
}
win_out_err = waveOutPrepareHeader(fd, &(wh[0]), sizeof(WAVEHDR));
if (win_out_err)
{
free(wh[0].lpData);
waveOutClose(fd);
- RETURN_ERROR_EXIT(MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
- mus_format("can't setup output 'header' for %d (%s)",
- dev,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
+ mus_format("can't setup output 'header' for %d", dev));
}
db_state[0] = BUFFER_EMPTY;
wh[1].dwBufferLength = buffer_size * current_datum_size;
@@ -3493,10 +2774,8 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
{
free(wh[0].lpData);
waveOutClose(fd);
- RETURN_ERROR_EXIT(MUS_AUDIO_SIZE_NOT_AVAILABLE,
- mus_format("can't allocate buffer size %d for output %d (%s)",
- buffer_size, dev,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_SIZE_NOT_AVAILABLE,
+ mus_format("can't allocate buffer size %d for output %d", buffer_size, dev));
}
win_out_err = waveOutPrepareHeader(fd, &(wh[1]), sizeof(WAVEHDR));
if (win_out_err)
@@ -3505,10 +2784,8 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
free(wh[0].lpData);
free(wh[1].lpData);
waveOutClose(fd);
- RETURN_ERROR_EXIT(MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
- mus_format("can't setup output 'header' for %d (%s)",
- dev,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
+ mus_format("can't setup output 'header' for %d", dev));
}
db_state[1] = BUFFER_EMPTY;
sound_state = SOUND_INITIALIZED;
@@ -3545,10 +2822,10 @@ static void wait_for_empty_buffer(int buf)
int mus_audio_write(int line, char *buf, int bytes)
{
- int lim, leftover, start;
+ int leftover, start;
start_win_print();
if (line != OUTPUT_LINE)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_WRITE,
+ return_error_exit(MUS_AUDIO_CANT_WRITE,
mus_format("write error: line %d != %d?",
line, OUTPUT_LINE));
win_out_err = 0;
@@ -3561,18 +2838,19 @@ int mus_audio_write(int line, char *buf, int bytes)
}
while (leftover > 0)
{
+ int lim;
lim = leftover;
if (lim > buffer_size) lim = buffer_size;
leftover -= lim;
wait_for_empty_buffer(current_buf);
win_out_err = fill_buffer(current_buf, buf, start, lim);
if (win_out_err)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_WRITE,
+ return_error_exit(MUS_AUDIO_CANT_WRITE,
mus_format("write error on %d",
line));
win_out_err = waveOutWrite(fd, &wh[current_buf], sizeof(WAVEHDR));
if (win_out_err)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_WRITE,
+ return_error_exit(MUS_AUDIO_CANT_WRITE,
mus_format("write error on %d",
line));
start += lim;
@@ -3590,12 +2868,6 @@ static float unlog(unsigned short val)
/* return(pow(2.0, amp) - 1.0); */ /* doc seems to be bogus */
}
-#define SRATE_11025_BITS (WAVE_FORMAT_1S16 | WAVE_FORMAT_1S08 | WAVE_FORMAT_1M16 | WAVE_FORMAT_1M08)
-#define SRATE_22050_BITS (WAVE_FORMAT_2S16 | WAVE_FORMAT_2S08 | WAVE_FORMAT_2M16 | WAVE_FORMAT_2M08)
-#define SRATE_44100_BITS (WAVE_FORMAT_4S16 | WAVE_FORMAT_4S08 | WAVE_FORMAT_4M16 | WAVE_FORMAT_4M08)
-#define SHORT_SAMPLE_BITS (WAVE_FORMAT_1S16 | WAVE_FORMAT_1M16 | WAVE_FORMAT_2S16 | WAVE_FORMAT_2M16 | WAVE_FORMAT_4S16 | WAVE_FORMAT_4M16)
-#define BYTE_SAMPLE_BITS (WAVE_FORMAT_1S08 | WAVE_FORMAT_1M08 | WAVE_FORMAT_2S08 | WAVE_FORMAT_2M08 | WAVE_FORMAT_4S08 | WAVE_FORMAT_4M08)
-
static char *mixer_status_name(int status)
{
switch (status)
@@ -3649,389 +2921,8 @@ static char *mixer_component_name(int type)
}
}
-#define MAX_DESCRIBE_CHANS 8
-#define MAX_DESCRIBE_CONTROLS 16
-/* these actually need to be big enough to handle whatever comes along, since we can't read partial states */
-/* or they need to be expanded as necessary */
-
char *mus_audio_moniker(void) {return("MS audio");} /* version number of some sort? */
-static void describe_audio_state_1(void)
-{
- int devs, dev, srate, chans, format, need_comma, maker;
- MMRESULT err;
- unsigned long val, rate, pitch, version;
- WAVEOUTCAPS wocaps;
- WAVEINCAPS wicaps;
- AUXCAPS wacaps;
- HWAVEOUT hd;
- WAVEFORMATEX pwfx;
-#ifdef MIXERR_BASE
- MIXERCAPS wmcaps;
- MIXERLINE mixline;
- MIXERLINECONTROLS linecontrols;
- MIXERCONTROL mc[MAX_DESCRIBE_CONTROLS];
- MIXERCONTROLDETAILS controldetails;
- MIXERCONTROLDETAILS_LISTTEXT clist[MAX_DESCRIBE_CHANS];
- MIXERCONTROLDETAILS_BOOLEAN cbool[MAX_DESCRIBE_CHANS];
- MIXERCONTROLDETAILS_UNSIGNED cline[MAX_DESCRIBE_CHANS];
- MIXERCONTROLDETAILS_SIGNED csign[MAX_DESCRIBE_CHANS];
- HMIXER mfd;
- int control, controls, dest, dests, source, happy, dest_time, chan, mina, maxa, ctype;
-#endif
- need_comma = 1;
- chans = 1;
- devs = waveOutGetNumDevs();
- if (devs > 0)
- {
- pprint("Output:\n");
- for (dev = 0; dev < devs; dev++)
- {
- err = waveOutGetDevCaps(dev, &wocaps, sizeof(wocaps));
- if (!err)
- {
- version = wocaps.vDriverVersion;
- maker = wocaps.wMid;
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s: version %d.%d\n",
- wocaps.szPname, version >> 8, version & 0xff);
- pprint(audio_strbuf);
- if (wocaps.wChannels == 2) {chans = 2; pprint(" stereo");} else {chans = 1; pprint(" mono");}
- if (wocaps.dwFormats & SRATE_11025_BITS) {srate = 11025; if (need_comma) pprint(", "); pprint(" 11025"); need_comma = 1;}
- if (wocaps.dwFormats & SRATE_22050_BITS) {srate = 22050; if (need_comma) pprint(", "); pprint(" 22050"); need_comma = 1;}
- if (wocaps.dwFormats & SRATE_44100_BITS) {srate = 44100; if (need_comma) pprint(", "); pprint(" 44100"); need_comma = 1;}
- if (wocaps.dwFormats & BYTE_SAMPLE_BITS) {format = 8; if (need_comma) pprint(", "); pprint(" unsigned byte"); need_comma = 1;}
- if (wocaps.dwFormats & SHORT_SAMPLE_BITS) {format = 16; if (need_comma) pprint(", "); pprint(" little-endian short"); need_comma = 1;}
- if (need_comma) pprint("\n");
- need_comma = 0;
- pwfx.wFormatTag = WAVE_FORMAT_PCM;
- pwfx.nChannels = chans;
- pwfx.nSamplesPerSec = srate;
- pwfx.nAvgBytesPerSec = srate;
- pwfx.nBlockAlign = 1;
- pwfx.wBitsPerSample = format;
-
- err = waveOutOpen(&hd, dev, &pwfx, 0, 0, WAVE_FORMAT_QUERY);
-
- if (wocaps.dwSupport & WAVECAPS_VOLUME)
- {
- err = waveOutGetVolume(hd, &val);
- if (!err)
- {
- if (wocaps.dwSupport & WAVECAPS_LRVOLUME)
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- " vol: %.3f %.3f",
- unlog((unsigned short)(val >> 16)),
- unlog((unsigned short)(val & 0xffff)));
- else mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- " vol: %.3f",
- unlog((unsigned short)(val & 0xffff)));
- pprint(audio_strbuf);
- need_comma = 1;
- }
- }
- if (!err)
- {
- /* this is just to get the hd data for subsequent info */
- if (wocaps.dwSupport & WAVECAPS_PLAYBACKRATE)
- {
- err = waveOutGetPlaybackRate(hd, &rate);
- if (!err)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- "%s playback rate: %.3f",
- (need_comma ? ", " : ""),
- (float)rate / 65536.0);
- pprint(audio_strbuf);
- need_comma = 1;
- }
- }
- if (wocaps.dwSupport & WAVECAPS_PITCH)
- {
- err = waveOutGetPitch(hd, &pitch);
- if (!err)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- "%s pitch: %.3f",
- (need_comma ? ", " : ""),
- (float)pitch / 65536.0);
- pprint(audio_strbuf);
- need_comma = 1;
- }
- }
- waveOutClose(hd);
- }
- if (need_comma) {need_comma = 0; pprint("\n");}
- }
- }
- }
- devs = waveInGetNumDevs();
- if (devs > 0)
- {
- pprint("Input:\n");
- for (dev = 0; dev < devs; dev++)
- {
- err = waveInGetDevCaps(dev, &wicaps, sizeof(wicaps));
- if (!err)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s", wicaps.szPname);
- pprint(audio_strbuf);
- if ((wicaps.wMid != maker) || (version != wicaps.vDriverVersion))
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, ": version %d.%d\n",
- (wicaps.vDriverVersion >> 8),
- wicaps.vDriverVersion & 0xff);
- pprint(audio_strbuf);
- }
- else pprint("\n");
- if (wicaps.wChannels == 2) pprint(" stereo"); else pprint(" mono");
- if (wicaps.dwFormats & SRATE_11025_BITS) {pprint(", 11025"); need_comma = 1;}
- if (wicaps.dwFormats & SRATE_22050_BITS) {if (need_comma) pprint(", "); pprint(" 22050"); need_comma = 1;}
- if (wicaps.dwFormats & SRATE_44100_BITS) {if (need_comma) pprint(", "); pprint(" 44100"); need_comma = 1;}
- if (wicaps.dwFormats & BYTE_SAMPLE_BITS) {if (need_comma) pprint(", "); pprint(" unsigned byte"); need_comma = 1;}
- if (wicaps.dwFormats & SHORT_SAMPLE_BITS) {if (need_comma) pprint(", "); pprint(" little-endian short");}
- pprint("\n");
- }
- }
- }
- devs = auxGetNumDevs();
- if (devs > 0)
- {
- pprint("Auxiliary:\n");
- for (dev = 0; dev < devs; dev++)
- {
- err = auxGetDevCaps(dev, &wacaps, sizeof(wacaps));
- if (!err)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s", wacaps.szPname);
- pprint(audio_strbuf);
- if ((wacaps.wMid != maker) || (version != wacaps.vDriverVersion))
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, ": version %d.%d%s",
- (wacaps.vDriverVersion >> 8), wacaps.vDriverVersion & 0xff,
- (wacaps.wTechnology & AUXCAPS_CDAUDIO) ? " (CD)" : "");
- else mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "%s\n", (wacaps.wTechnology & AUXCAPS_CDAUDIO) ? " (CD)" : "");
- pprint(audio_strbuf);
- if (wacaps.dwSupport & AUXCAPS_VOLUME)
- {
- err = auxGetVolume(dev, &val);
- if (!err)
- {
- if (wacaps.dwSupport & AUXCAPS_LRVOLUME)
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- " vol: %.3f %.3f\n",
- unlog((unsigned short)(val >> 16)),
- unlog((unsigned short)(val & 0xffff)));
- else mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- " vol: %.3f\n",
- unlog((unsigned short)(val & 0xffff)));
- pprint(audio_strbuf);
- }
- }
- }
- }
- }
-#ifdef MIXERR_BASE
- devs = mixerGetNumDevs();
- if (devs > 0)
- {
- pprint("Mixer:\n");
- for (dev = 0; dev < devs; dev++)
- {
- err = mixerGetDevCaps(dev, &wmcaps, sizeof(wmcaps));
- if (!err)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s", wmcaps.szPname);
- pprint(audio_strbuf);
- if ((wmcaps.wMid != maker) || (version != wmcaps.vDriverVersion))
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- ": version %d.%d\n",
- (wmcaps.vDriverVersion >> 8),
- wmcaps.vDriverVersion & 0xff);
- pprint(audio_strbuf);
- }
- else pprint("\n");
- dests = wmcaps.cDestinations;
-
- err = mixerOpen(&mfd, dev, 0, 0, CALLBACK_NULL);
- if (!err)
- {
- dest = 0;
- source = 0;
- dest_time = 1;
- happy = 1;
- while (happy)
- {
- if (dest_time)
- {
- mixline.dwDestination = dest;
- mixline.cbStruct = sizeof(MIXERLINE);
- err = mixerGetLineInfo((HMIXEROBJ)mfd, &mixline, MIXER_GETLINEINFOF_DESTINATION);
- }
- else
- {
- mixline.dwSource = source;
- mixline.cbStruct = sizeof(MIXERLINE);
- err = mixerGetLineInfo((HMIXEROBJ)mfd, &mixline, MIXER_GETLINEINFOF_SOURCE);
- }
- if (!err)
- {
- if ((source == 0) && (!dest_time)) pprint(" Sources:\n");
- if ((dest == 0) && (dest_time)) pprint(" Destinations:\n");
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s: %s (%s), %d chan%s",
- mixline.szName,
- mixer_component_name(mixline.dwComponentType),
- mixer_target_name(mixline.Target.dwType),
-
- mixline.cChannels, ((mixline.cChannels != 1) ? "s" : ""));
- pprint(audio_strbuf);
- if (mixline.cConnections > 0)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, ", %d connection%s",
- mixline.cConnections, ((mixline.cConnections != 1) ? "s" : ""));
- pprint(audio_strbuf);
- }
- if (dest_time)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "%s\n", mixer_status_name(mixline.fdwLine));
- pprint(audio_strbuf);
- }
- else pprint("\n");
- if (mixline.cControls > 0)
- {
- linecontrols.cbStruct = sizeof(MIXERLINECONTROLS);
- linecontrols.dwLineID = mixline.dwLineID;
- linecontrols.dwControlID = MIXER_GETLINECONTROLSF_ONEBYID;
- if (mixline.cControls > MAX_DESCRIBE_CONTROLS)
- linecontrols.cControls = MAX_DESCRIBE_CONTROLS;
- else linecontrols.cControls = mixline.cControls;
- linecontrols.pamxctrl = mc;
- linecontrols.cbmxctrl = sizeof(MIXERCONTROL);
- err = mixerGetLineControls((HMIXEROBJ)mfd, &linecontrols, MIXER_GETLINECONTROLSF_ALL);
- if (!err)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE,
- " %d control%s:\n",
- linecontrols.cControls,
- (linecontrols.cControls != 1) ? "s" : "");
- pprint(audio_strbuf);
- controls = linecontrols.cControls;
- if (controls > MAX_DESCRIBE_CONTROLS) controls = MAX_DESCRIBE_CONTROLS;
- for (control = 0; control < controls; control++)
- {
-
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s", mc[control].szName);
- pprint(audio_strbuf);
- controldetails.cbStruct = sizeof(MIXERCONTROLDETAILS);
- controldetails.dwControlID = mc[control].dwControlID;
-
- ctype = (mc[control].dwControlType);
- if ((ctype == MIXERCONTROL_CONTROLTYPE_EQUALIZER) ||
- (ctype == MIXERCONTROL_CONTROLTYPE_MUX) ||
- (ctype == MIXERCONTROL_CONTROLTYPE_MIXER) ||
- (ctype == MIXERCONTROL_CONTROLTYPE_SINGLESELECT) ||
- (ctype == MIXERCONTROL_CONTROLTYPE_MULTIPLESELECT))
- {
- controldetails.cChannels = 1;
- controldetails.cMultipleItems = mc[control].cMultipleItems;
- controldetails.cbDetails = sizeof(MIXERCONTROLDETAILS_LISTTEXT);
- controldetails.paDetails = clist;
- err = mixerGetControlDetails((HMIXEROBJ)mfd, &controldetails, MIXER_GETCONTROLDETAILSF_LISTTEXT);
- if (!err)
- {
- for (chan = 0; chan < (int)(mixline.cChannels); chan++)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " [%s]", clist[chan].szName);
- pprint(audio_strbuf);
- }
- }
- }
- if (mixline.cChannels > MAX_DESCRIBE_CHANS)
- controldetails.cChannels = MAX_DESCRIBE_CHANS;
- else controldetails.cChannels = mixline.cChannels;
- controldetails.cMultipleItems = 0;
- err = 0;
- switch (mc[control].dwControlType & MIXERCONTROL_CT_UNITS_MASK)
- {
- case MIXERCONTROL_CT_UNITS_BOOLEAN:
- controldetails.cbDetails = sizeof(MIXERCONTROLDETAILS_BOOLEAN);
- controldetails.paDetails = cbool;
- break;
- case MIXERCONTROL_CT_UNITS_SIGNED: case MIXERCONTROL_CT_UNITS_DECIBELS:
- controldetails.cbDetails = sizeof(MIXERCONTROLDETAILS_SIGNED);
- controldetails.paDetails = csign;
- break;
- case MIXERCONTROL_CT_UNITS_UNSIGNED: case MIXERCONTROL_CT_UNITS_PERCENT:
- controldetails.cbDetails = sizeof(MIXERCONTROLDETAILS_UNSIGNED);
- controldetails.paDetails = cline;
- break;
- default: err = 1; break;
- }
- if (err)
- pprint("\n");
- else
- {
- err = mixerGetControlDetails((HMIXEROBJ)mfd, &controldetails, MIXER_GETCONTROLDETAILSF_VALUE);
- if (!err)
- {
- chans = controldetails.cChannels;
- if (chans > MAX_DESCRIBE_CHANS) chans = MAX_DESCRIBE_CHANS;
- switch (mc[control].dwControlType & MIXERCONTROL_CT_UNITS_MASK)
- {
- case MIXERCONTROL_CT_UNITS_BOOLEAN:
- for (chan = 0; chan < chans; chan++)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s", (cbool[chan].fValue) ? " on" : " off");
- pprint(audio_strbuf);
- }
- break;
- case MIXERCONTROL_CT_UNITS_SIGNED: case MIXERCONTROL_CT_UNITS_DECIBELS:
- mina = mc[control].Bounds.lMinimum;
- maxa = mc[control].Bounds.lMaximum;
- if (maxa > mina)
- {
- for (chan = 0; chan < chans; chan++)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %.3f",
- (float)(csign[chan].lValue - mina) / (float)(maxa - mina));
- pprint(audio_strbuf);
- }
- }
- break;
- case MIXERCONTROL_CT_UNITS_UNSIGNED: case MIXERCONTROL_CT_UNITS_PERCENT:
- mina = mc[control].Bounds.dwMinimum;
- maxa = mc[control].Bounds.dwMaximum;
- if (maxa > mina)
- {
- for (chan = 0; chan < chans; chan++)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %.3f",
- (float)(cline[chan].dwValue - mina) / (float)(maxa - mina));
- pprint(audio_strbuf);
- }
- }
- break;
- default: break;
- }
- pprint("\n");
- }
- else pprint("\n");
- }
- }
- }
- }
- }
- else if (!dest_time) happy = 0;
- if (dest_time) dest++; else source++;
- if (dest == dests) dest_time = 0;
- }
- }
- mixerClose(mfd);
- }
- }
- }
-#endif
-}
-
int mus_audio_initialize(void)
{
return(MUS_NO_ERROR);
@@ -4039,7 +2930,6 @@ int mus_audio_initialize(void)
int mus_audio_close(int line)
{
- int i;
win_out_err = 0;
win_in_err = 0;
if (line == OUTPUT_LINE)
@@ -4047,6 +2937,7 @@ int mus_audio_close(int line)
/* fill with a few zeros, wait for empty flag */
if (sound_state != SOUND_UNREADY)
{
+ int i;
wait_for_empty_buffer(current_buf);
for (i = 0; i < 128; i++) wh[current_buf].lpData[i] = 0;
wait_for_empty_buffer(current_buf);
@@ -4067,7 +2958,7 @@ int mus_audio_close(int line)
free(wh[0].lpData);
free(wh[1].lpData);
if (win_out_err)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_CLOSE,
+ return_error_exit(MUS_AUDIO_CANT_CLOSE,
mus_format("close failed on %d",
line));
}
@@ -4090,7 +2981,7 @@ int mus_audio_close(int line)
}
}
else
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_CLOSE,
+ return_error_exit(MUS_AUDIO_CANT_CLOSE,
mus_format("can't close unrecognized line %d",
line));
}
@@ -4114,7 +3005,7 @@ DWORD CALLBACK next_input_buffer(HWAVEIN w, UINT msg, DWORD user_data, DWORD p1,
return(0);
}
-int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
WAVEFORMATEX wf;
int dev;
@@ -4125,7 +3016,7 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
wf.wFormatTag = WAVE_FORMAT_PCM;
wf.cbSize = 0;
- if (format == MUS_UBYTE)
+ if (samp_type == MUS_UBYTE)
{
wf.wBitsPerSample = 8;
current_record_datum_size = 1;
@@ -4144,29 +3035,27 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
rec_wh.dwLoops = 0;
rec_wh.lpData = (char *)calloc(rec_wh.dwBufferLength, sizeof(char));
if ((rec_wh.lpData) == 0)
- RETURN_ERROR_EXIT(MUS_AUDIO_SIZE_NOT_AVAILABLE,
- mus_format("can't allocated %d bytes for input buffer of %d (%s)",
- size, dev, mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_SIZE_NOT_AVAILABLE,
+ mus_format("can't allocated %d bytes for input buffer of %d", size, dev));
#if _MSC_VER
win_in_err = waveInOpen(&record_fd, WAVE_MAPPER, &wf, (DWORD (*)(HWAVEIN,UINT,DWORD,DWORD,DWORD))next_input_buffer, 0, CALLBACK_FUNCTION);
+ /* why isn't the simple cast (DWORD) correct here as below? -- the docs say the 4th arg's type is DWORD */
#else
win_in_err = waveInOpen(&record_fd, WAVE_MAPPER, &wf, (DWORD)next_input_buffer, 0, CALLBACK_FUNCTION);
#endif
if (win_in_err)
{
free(rec_wh.lpData);
- RETURN_ERROR_EXIT(MUS_AUDIO_DEVICE_NOT_AVAILABLE,
- mus_format("can't open input device %d (%s)",
- dev, mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_DEVICE_NOT_AVAILABLE,
+ mus_format("can't open input device %d", dev));
}
win_in_err = waveInPrepareHeader(record_fd, &(rec_wh), sizeof(WAVEHDR));
if (win_in_err)
{
free(rec_wh.lpData);
waveInClose(record_fd);
- RETURN_ERROR_EXIT(MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
- mus_format("can't prepare input 'header' for %d (%s)",
- dev, mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
+ mus_format("can't prepare input 'header' for %d", dev));
}
return(MUS_NO_ERROR);
}
@@ -4181,21 +3070,18 @@ int mus_audio_read(int line, char *buf, int bytes)
-/* ------------------------------- OSX ----------------------------------------- */
+/* ------------------------------- Mac OSX ----------------------------------------- */
/* this code based primarily on the CoreAudio headers and portaudio pa_mac_core.c,
* and to a much lesser extent, coreaudio.pdf and the HAL/Daisy examples.
*/
-/* the following have been deprecated:
- * AudioDeviceGetPropertyInfo, AudioDeviceGetProperty, AudioHardwareGetPropertyInfo, AudioHardwareGetProperty,
- * AudioDeviceSetProperty
- * once they are removed, Mac users will need portaudio, since I can't face rewriting that code.
- */
-
-#ifdef MUS_MAC_OSX
+#ifdef __APPLE__
#define AUDIO_OK 1
+#include <AvailabilityMacros.h>
+#define HAVE_AUDIODEVICEDESTROYIOPROCID (defined(MAC_OS_X_VERSION_10_5))
+
/*
#include <CoreServices/CoreServices.h>
#include <CoreAudio/CoreAudio.h>
@@ -4215,246 +3101,15 @@ static const char* osx_error(OSStatus err)
case kAudioHardwareBadDeviceError: return("bad device"); break;
case kAudioHardwareBadStreamError: return("bad stream"); break;
case kAudioHardwareIllegalOperationError: return("illegal operation"); break;
- case kAudioDeviceUnsupportedFormatError: return("unsupported format"); break;
+ case kAudioDeviceUnsupportedFormatError: return("unsupported sample type"); break;
case kAudioDevicePermissionsError: return("device permissions error"); break;
}
return("unknown error");
}
-char *device_name(AudioDeviceID deviceID, int input_case)
-{
- OSStatus err = noErr;
- UInt32 size = 0, msize = 0, trans = 0, trans_size = 0;
- char *name = NULL, *mfg = NULL, *full_name = NULL;
- err = AudioDeviceGetPropertyInfo(deviceID, 0, false, kAudioDevicePropertyDeviceName, &size, NULL);
- if (err == noErr) err = AudioDeviceGetPropertyInfo(deviceID, 0, false, kAudioDevicePropertyDeviceManufacturer, &msize, NULL);
- if (err == noErr)
- {
- name = (char *)malloc(size + 2);
- err = AudioDeviceGetProperty(deviceID, 0, input_case, kAudioDevicePropertyDeviceName, &size, name);
- mfg = (char *)malloc(msize + 2);
- err = AudioDeviceGetProperty(deviceID, 0, input_case, kAudioDevicePropertyDeviceManufacturer, &msize, mfg);
- full_name = (char *)malloc(size + msize + 4);
-#if HAVE_KAUDIODEVICEPROPERTYTRANSPORTTYPE
- trans_size = sizeof(UInt32);
- err = AudioDeviceGetProperty(deviceID, 0, input_case, kAudioDevicePropertyTransportType, &trans_size, &trans);
- if (err != noErr)
-#endif
- trans = 0;
- if (trans == 0)
- mus_snprintf(full_name, size + msize + 4, "\n %s: %s", mfg, name);
- else mus_snprintf(full_name, size + msize + 4, "\n %s: %s ('%c%c%c%c')",
- mfg, name,
- (char)((trans >> 24) & 0xff), (char)((trans >> 16) & 0xff), (char)((trans >> 8) & 0xff), (char)(trans & 0xff));
- free(name);
- free(mfg);
- }
- return(full_name);
-}
-
-static int max_chans_via_stream_configuration(AudioDeviceID device, bool input_case)
-{
- /* apparently MOTU 828 has to be different (this code from portaudio) */
- UInt32 size = 0;
- Boolean writable;
- OSStatus err = noErr;
- err = AudioDeviceGetPropertyInfo(device, 0, input_case, kAudioDevicePropertyStreamConfiguration, &size, &writable);
- if (err == noErr)
- {
- AudioBufferList *list;
- list = (AudioBufferList *)malloc(size);
- err = AudioDeviceGetProperty(device, 0, input_case, kAudioDevicePropertyStreamConfiguration, &size, list);
- if (err == noErr)
- {
- int chans = 0, i;
- for (i = 0; i < list->mNumberBuffers; i++)
- chans += list->mBuffers[i].mNumberChannels;
- free(list);
- return(chans);
- }
- }
- return(-1);
-}
-
-static void describe_audio_state_1(void)
-{
- OSStatus err = noErr;
- UInt32 num_devices = 0, msize = 0, size = 0, buffer_size = 0, mute = 0, alive = 0;
- Float32 vol;
- int i, j, k;
- pid_t hogger = 0;
- AudioDeviceID *devices = NULL;
- AudioDeviceID device, default_output, default_input;
- AudioStreamBasicDescription desc;
- AudioStreamBasicDescription *descs = NULL;
- int formats = 0, m;
- bool input_case = false;
- err = AudioHardwareGetPropertyInfo(kAudioHardwarePropertyDevices, &msize, NULL);
- if (err != noErr)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "get property info error: %s\n", osx_error(err));
- pprint(audio_strbuf);
- return;
- }
- num_devices = msize / sizeof(AudioDeviceID);
- if (num_devices <= 0)
- {
- pprint("no audio devices found");
- return;
- }
- devices = (AudioDeviceID *)malloc(msize);
- size = sizeof(AudioDeviceID);
- err = AudioHardwareGetProperty(kAudioHardwarePropertyDefaultInputDevice, &size, &default_input);
- if (err != noErr) default_input = 55555555; /* unsigned int -- I want some value that won't happen! */
- size = sizeof(AudioDeviceID);
- err = AudioHardwareGetProperty(kAudioHardwarePropertyDefaultOutputDevice, &size, &default_output);
- if (err != noErr) default_output = 55555555;
- err = AudioHardwareGetProperty(kAudioHardwarePropertyDevices, &msize, (void *)devices);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "found %d audio device%s",
- (int)num_devices, (num_devices != 1) ? "s" : "");
- pprint(audio_strbuf);
- for (m = 0; m < 2; m++)
- {
- for (i = 0; i < num_devices; i++)
- {
- device = devices[i];
- pprint(device_name(device, input_case));
- if (input_case)
- {
- if (device == default_input)
- pprint(" (default input)");
- else pprint(" (input)");
- }
- else
- {
- if (device == default_output)
- pprint(" (default output)");
- else pprint(" (output)");
- }
- size = sizeof(pid_t);
- err = AudioDeviceGetProperty(device, 0, input_case, kAudioDevicePropertyHogMode, &size, &hogger);
- if ((err == noErr) && (hogger >= 0))
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " currently owned (exclusively) by process %d", (int)hogger);
- pprint(audio_strbuf);
- }
- size = sizeof(UInt32);
- err = AudioDeviceGetProperty(device, 0, input_case, kAudioDevicePropertyDeviceIsAlive, &size, &alive);
- if ((err == noErr) && (alive == 0))
- pprint(" disconnected?");
- size = sizeof(UInt32);
- err = AudioDeviceGetProperty(device, 0, input_case, kAudioDevicePropertyBufferSize, &size, &buffer_size);
- if (err != noErr) buffer_size = 0;
- size = sizeof(AudioStreamBasicDescription);
- err = AudioDeviceGetProperty(device, 0, input_case, kAudioDevicePropertyStreamFormat, &size, &desc);
- if (err == noErr)
- {
- int config_chans;
- unsigned int trans;
- trans = (unsigned int)(desc.mFormatID);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "\n srate: %d, chans: %d",
- (int)(desc.mSampleRate),
- (int)(desc.mChannelsPerFrame));
- pprint(audio_strbuf);
- config_chans = max_chans_via_stream_configuration(device, input_case);
- if ((config_chans > 0) && (config_chans != (int)(desc.mChannelsPerFrame)))
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " (or %d?)", config_chans);
- pprint(audio_strbuf);
- }
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, ", bits/sample: %d, format: %c%c%c%c",
- (int)(desc.mBitsPerChannel),
- (trans >> 24) & 0xff, (trans >> 16) & 0xff, (trans >> 8) & 0xff, trans & 0xff);
- pprint(audio_strbuf);
- if (buffer_size > 0)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, ", buf: %d", (int)buffer_size);
- pprint(audio_strbuf);
- }
- if ((int)(desc.mFormatFlags) != 0) /* assuming "PCM" here */
- {
- int flags;
- flags = ((int)(desc.mFormatFlags));
- pprint("\n flags: ");
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "%s%s%s%s%s%s",
- (flags & kLinearPCMFormatFlagIsFloat) ? "float " : "",
- (flags & kLinearPCMFormatFlagIsBigEndian) ? "big-endian " : "",
- (flags & kLinearPCMFormatFlagIsSignedInteger) ? "signed-int " : "",
- (flags & kLinearPCMFormatFlagIsPacked) ? "packed " : "",
- (flags & kLinearPCMFormatFlagIsAlignedHigh) ? "aligned-high " : "",
-#if HAVE_KLINEARPCMFORMATFLAGISNONINTERLEAVED
- (flags & kLinearPCMFormatFlagIsNonInterleaved) ? "non-interleaved " : ""
-#else
- ""
-#endif
- );
- pprint(audio_strbuf);
- }
-
- if ((int)(desc.mChannelsPerFrame) > 0)
- {
- pprint("\n vols:");
- for (j = 0; j <= (int)(desc.mChannelsPerFrame); j++)
- {
- size = sizeof(Float32);
- err = AudioDeviceGetProperty(device, j, input_case, kAudioDevicePropertyVolumeScalar, &size, &vol);
- if (err == noErr)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s%.3f",
- (j == 0) ? "master: " : "",
- vol);
- pprint(audio_strbuf);
- }
-
- if (j > 0)
- {
- size = sizeof(UInt32);
- err = AudioDeviceGetProperty(device, j, input_case, kAudioDevicePropertyMute, &size, &mute);
- if ((err == noErr) && (mute == 1))
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " (muted)");
- pprint(audio_strbuf);
- }
- }
- }
- }
- }
- size = 0;
- err = AudioDeviceGetPropertyInfo(device, 0, input_case, kAudioDevicePropertyStreamFormats, &size, NULL);
- formats = size / sizeof(AudioStreamBasicDescription);
- if (formats > 1)
- {
- descs = (AudioStreamBasicDescription *)calloc(formats, sizeof(AudioStreamBasicDescription));
- size = formats * sizeof(AudioStreamBasicDescription);
- err = AudioDeviceGetProperty(device, 0, input_case, kAudioDevicePropertyStreamFormats, &size, descs);
- if (err == noErr)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "\n This device supports %d formats: ", formats);
- pprint(audio_strbuf);
- for (k = 0; k < formats; k++)
- {
- unsigned int trans;
- trans = (unsigned int)(descs[k].mFormatID);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "\n srate: %d, chans: %d, bits/sample: %d, format: %c%c%c%c",
- (int)(descs[k].mSampleRate),
- (int)(descs[k].mChannelsPerFrame),
- (int)(descs[k].mBitsPerChannel),
- (trans >> 24) & 0xff, (trans >> 16) & 0xff, (trans >> 8) & 0xff, trans & 0xff);
- pprint(audio_strbuf);
- }
- }
- free(descs);
- }
- pprint("\n");
- }
- input_case = true;
- }
- if (devices) free(devices);
-}
-
#define MAX_BUFS 4
static char **bufs = NULL;
-static int in_buf = 0, out_buf = 0;
+static unsigned int in_buf = 0, out_buf = 0;
static OSStatus writer(AudioDeviceID inDevice,
const AudioTimeStamp *inNow,
@@ -4535,11 +3190,23 @@ int mus_audio_close(int line)
sizeof_running = sizeof(UInt32);
while (in_buf == out_buf)
{
- err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyDeviceIsRunning, &sizeof_running, &running);
+ /* err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyDeviceIsRunning, &sizeof_running, &running); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyDeviceIsRunning,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_running, &running);
+ }
}
while (in_buf != out_buf)
{
- err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyDeviceIsRunning, &sizeof_running, &running);
+ /* err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyDeviceIsRunning, &sizeof_running, &running); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyDeviceIsRunning,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_running, &running);
+ }
}
in_buf = 0;
err = AudioDeviceStop(device, (AudioDeviceIOProc)writer);
@@ -4563,7 +3230,7 @@ static audio_convert_t conversion_choice = CONVERT_NOT;
static float conversion_multiplier = 1.0;
static int dac_out_chans, dac_out_srate;
static int incoming_out_chans = 1, incoming_out_srate = 44100;
-static int fill_point = 0;
+static unsigned int fill_point = 0;
static unsigned int bufsize = 0, current_bufsize = 0;
static bool match_dac_to_sound = true;
@@ -4581,19 +3248,35 @@ bool mus_audio_output_properties_mutable(bool mut)
* for non-integer srate conversion anyway, and the rest is trivial.
*/
-int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
+int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size)
{
OSStatus err = noErr;
UInt32 sizeof_device, sizeof_format, sizeof_bufsize;
AudioStreamBasicDescription device_desc;
+ device = 0;
sizeof_device = sizeof(AudioDeviceID);
sizeof_bufsize = sizeof(unsigned int);
- err = AudioHardwareGetProperty(kAudioHardwarePropertyDefaultOutputDevice, &sizeof_device, (void *)(&device));
+ /* err = AudioHardwareGetProperty(kAudioHardwarePropertyDefaultOutputDevice, &sizeof_device, (void *)(&device)); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioHardwarePropertyDefaultOutputDevice,
+ kAudioObjectPropertyScopeGlobal,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(kAudioObjectSystemObject, &device_address, 0, NULL, &sizeof_device, &device);
+ }
+
bufsize = 4096;
if (err == noErr)
- err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyBufferSize, &sizeof_bufsize, &bufsize);
+ {
+ /* err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyBufferSize, &sizeof_bufsize, &bufsize); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyBufferSize,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_bufsize, &bufsize);
+ }
+ }
if (err != noErr)
{
fprintf(stderr, "open audio output err: %d %s\n", (int)err, osx_error(err));
@@ -4601,7 +3284,14 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
}
sizeof_format = sizeof(AudioStreamBasicDescription);
- err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyStreamFormat, &sizeof_format, &device_desc);
+ /* err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyStreamFormat, &sizeof_format, &device_desc); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyStreamFormat,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_format, &device_desc);
+ }
+
if (err != noErr)
{
fprintf(stderr, "open audio output (get device format) err: %d %s\n", (int)err, osx_error(err));
@@ -4615,7 +3305,7 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
/* current DAC state: device_desc.mChannelsPerFrame, (int)(device_desc.mSampleRate) */
/* apparently get stream format can return noErr but chans == 0?? */
- if ((device_desc.mChannelsPerFrame != chans) ||
+ if (((int)device_desc.mChannelsPerFrame != chans) ||
((int)(device_desc.mSampleRate) != srate))
{
/* try to match DAC settings to current sound */
@@ -4624,7 +3314,13 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
device_desc.mBytesPerPacket = chans * 4; /* assume 1 frame/packet and float32 data */
device_desc.mBytesPerFrame = chans * 4;
sizeof_format = sizeof(AudioStreamBasicDescription);
- err = AudioDeviceSetProperty(device, 0, 0, false, kAudioDevicePropertyStreamFormat, sizeof_format, &device_desc);
+ /* err = AudioDeviceSetProperty(device, 0, 0, false, kAudioDevicePropertyStreamFormat, sizeof_format, &device_desc); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyStreamFormat,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectSetPropertyData(device, &device_address, 0, NULL, sizeof_format, &device_desc);
+ }
/* this error is bogus in some cases -- other audio systems just ignore it,
* but in my case (a standard MacIntel with no special audio hardware), if I leave
@@ -4643,11 +3339,24 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
device_desc.mBytesPerPacket = device_desc.mChannelsPerFrame * 4; /* assume 1 frame/packet and float32 data */
device_desc.mBytesPerFrame = device_desc.mChannelsPerFrame * 4;
sizeof_format = sizeof(AudioStreamBasicDescription);
- err = AudioDeviceSetProperty(device, 0, 0, false, kAudioDevicePropertyStreamFormat, sizeof_format, &device_desc);
+ /* err = AudioDeviceSetProperty(device, 0, 0, false, kAudioDevicePropertyStreamFormat, sizeof_format, &device_desc); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyStreamFormat,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectSetPropertyData(device, &device_address, 0, NULL, sizeof_format, &device_desc);
+ }
if (err != noErr)
{
sizeof_format = sizeof(AudioStreamBasicDescription);
- err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyStreamFormatMatch, &sizeof_format, &device_desc);
+ /* err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyStreamFormatMatch, &sizeof_format, &device_desc); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyStreamFormatMatch,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_format, &device_desc);
+ }
+
if (err == noErr)
{
/* match suggests: device_desc.mChannelsPerFrame, (int)(device_desc.mSampleRate) */
@@ -4655,12 +3364,24 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
/* a bug here in emagic 2|6 -- we can get 6 channel match, but then can't set it?? */
sizeof_format = sizeof(AudioStreamBasicDescription);
- err = AudioDeviceSetProperty(device, 0, 0, false, kAudioDevicePropertyStreamFormat, sizeof_format, &device_desc);
+ /* err = AudioDeviceSetProperty(device, 0, 0, false, kAudioDevicePropertyStreamFormat, sizeof_format, &device_desc); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyStreamFormat,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectSetPropertyData(device, &device_address, 0, NULL, sizeof_format, &device_desc);
+ }
if (err != noErr)
{
/* no luck -- get current DAC settings at least */
sizeof_format = sizeof(AudioStreamBasicDescription);
- AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyStreamFormat, &sizeof_format, &device_desc);
+ /* AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyStreamFormat, &sizeof_format, &device_desc); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyStreamFormat,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_format, &device_desc);
+ }
}
}
}
@@ -4668,7 +3389,13 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
{
/* nothing matches? -- get current DAC settings */
sizeof_format = sizeof(AudioStreamBasicDescription);
- AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyStreamFormat, &sizeof_format, &device_desc);
+ /* AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyStreamFormat, &sizeof_format, &device_desc); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyStreamFormat,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_format, &device_desc);
+ }
}
}
}
@@ -4835,15 +3562,17 @@ static void convert_incoming(char *to_buf, int fill_point, int lim, char *buf)
int mus_audio_write(int line, char *buf, int bytes)
{
OSStatus err = noErr;
- int lim, bp, out_bytes;
+ unsigned int lim, out_bytes;
UInt32 sizeof_running;
UInt32 running;
char *to_buf;
+
to_buf = bufs[in_buf];
- out_bytes = (int)(bytes * conversion_multiplier);
+ out_bytes = (unsigned int)(bytes * conversion_multiplier);
if ((fill_point + out_bytes) > bufsize)
out_bytes = bufsize - fill_point;
- lim = (int)(out_bytes / conversion_multiplier);
+ lim = (unsigned int)(out_bytes / conversion_multiplier);
+
if (!writing)
{
convert_incoming(to_buf, fill_point, lim, buf);
@@ -4874,12 +3603,19 @@ int mus_audio_write(int line, char *buf, int bytes)
}
if ((fill_point == 0) && (in_buf == out_buf))
{
+ unsigned int bp;
bp = out_buf;
sizeof_running = sizeof(UInt32);
while (bp == out_buf)
{
/* i.e. just kill time without hanging */
- err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyDeviceIsRunning, &sizeof_running, &running);
+ /* err = AudioDeviceGetProperty(device, 0, false, kAudioDevicePropertyDeviceIsRunning, &sizeof_running, &running); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyDeviceIsRunning,
+ kAudioDevicePropertyScopeOutput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_running, &running);
+ }
/* usleep(10); */
}
}
@@ -4896,17 +3632,35 @@ int mus_audio_write(int line, char *buf, int bytes)
return(MUS_NO_ERROR);
}
-int mus_audio_open_input(int dev, int srate, int chans, int format, int size)
+int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size)
{
OSStatus err = noErr;
UInt32 sizeof_device;
UInt32 sizeof_bufsize;
+
sizeof_device = sizeof(AudioDeviceID);
sizeof_bufsize = sizeof(unsigned int);
- err = AudioHardwareGetProperty(kAudioHardwarePropertyDefaultInputDevice, &sizeof_device, (void *)(&device));
+
+ device = 0;
+ /* err = AudioHardwareGetProperty(kAudioHardwarePropertyDefaultInputDevice, &sizeof_device, (void *)(&device)); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioHardwarePropertyDefaultInputDevice,
+ kAudioObjectPropertyScopeGlobal,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(kAudioObjectSystemObject, &device_address, 0, NULL, &sizeof_device, &device);
+ }
+
bufsize = 4096;
if (err == noErr)
- err = AudioDeviceGetProperty(device, 0, true, kAudioDevicePropertyBufferSize, &sizeof_bufsize, &bufsize);
+ {
+ /* err = AudioDeviceGetProperty(device, 0, true, kAudioDevicePropertyBufferSize, &sizeof_bufsize, &bufsize); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyBufferSize,
+ kAudioDevicePropertyScopeInput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_bufsize, &bufsize);
+ }
+ }
if (err != noErr)
{
fprintf(stderr, "open audio input err: %d %s\n", (int)err, osx_error(err));
@@ -4952,23 +3706,30 @@ int mus_audio_open_input(int dev, int srate, int chans, int format, int size)
int mus_audio_read(int line, char *buf, int bytes)
{
OSStatus err = noErr;
- int bp;
UInt32 sizeof_running;
UInt32 running;
char *to_buf;
+
if (in_buf == out_buf)
{
+ unsigned int bp;
bp = out_buf;
sizeof_running = sizeof(UInt32);
while (bp == out_buf)
{
- err = AudioDeviceGetProperty(device, 0, true, kAudioDevicePropertyDeviceIsRunning, &sizeof_running, &running);
+ /* err = AudioDeviceGetProperty(device, 0, true, kAudioDevicePropertyDeviceIsRunning, &sizeof_running, &running); */
+ {
+ AudioObjectPropertyAddress device_address = { kAudioDevicePropertyDeviceIsRunning,
+ kAudioDevicePropertyScopeInput,
+ kAudioObjectPropertyElementMaster };
+ err = AudioObjectGetPropertyData(device, &device_address, 0, NULL, &sizeof_running, &running);
+ }
if (err != noErr)
fprintf(stderr, "wait err: %s ", osx_error(err));
}
}
to_buf = bufs[in_buf];
- if (bytes <= bufsize)
+ if (bytes <= (int)bufsize)
memmove((void *)buf, (void *)to_buf, bytes);
else memmove((void *)buf, (void *)to_buf, bufsize);
in_buf++;
@@ -4976,267 +3737,13 @@ int mus_audio_read(int line, char *buf, int bytes)
return(MUS_ERROR);
}
-static int max_chans(AudioDeviceID device, int input)
-{
- int maxc = 0, formats, k, config_chans;
- UInt32 size;
- OSStatus err;
- AudioStreamBasicDescription desc;
- AudioStreamBasicDescription *descs;
- size = sizeof(AudioStreamBasicDescription);
- err = AudioDeviceGetProperty(device, 0, input, kAudioDevicePropertyStreamFormat, &size, &desc);
- if (err == noErr)
- {
- maxc = (int)(desc.mChannelsPerFrame);
- size = 0;
- err = AudioDeviceGetPropertyInfo(device, 0, input, kAudioDevicePropertyStreamFormats, &size, NULL);
- formats = size / sizeof(AudioStreamBasicDescription);
- if (formats > 1)
- {
- descs = (AudioStreamBasicDescription *)calloc(formats, sizeof(AudioStreamBasicDescription));
- size = formats * sizeof(AudioStreamBasicDescription);
- err = AudioDeviceGetProperty(device, 0, input, kAudioDevicePropertyStreamFormats, &size, descs);
- if (err == noErr)
- for (k = 0; k < formats; k++)
- if ((int)(descs[k].mChannelsPerFrame) > maxc) maxc = (int)(descs[k].mChannelsPerFrame);
- free(descs);
- }
- }
- else fprintf(stderr, "read chans hit: %s\n", osx_error(err));
- config_chans = max_chans_via_stream_configuration(device, input);
- if (config_chans > maxc) return(config_chans);
- return(maxc);
-}
-
-
-static int osx_chans(int dev1)
-{
- AudioDeviceID dev = kAudioDeviceUnknown;
- OSStatus err = noErr;
- UInt32 size;
- int curdev;
- bool in_case = false;
-
- curdev = MUS_AUDIO_DEVICE(dev1);
- size = sizeof(AudioDeviceID);
- in_case = ((curdev == MUS_AUDIO_MICROPHONE) || (curdev == MUS_AUDIO_LINE_IN));
- if (in_case)
- err = AudioHardwareGetProperty(kAudioHardwarePropertyDefaultInputDevice, &size, &dev);
- else err = AudioHardwareGetProperty(kAudioHardwarePropertyDefaultOutputDevice, &size, &dev);
- if (err != noErr) fprintf(stderr, "get default: %s\n", osx_error(err));
- return(max_chans(dev, in_case));
-}
-
int mus_audio_initialize(void) {return(MUS_NO_ERROR);}
-int mus_audio_systems(void) {return(1);}
-
-
char *mus_audio_moniker(void) {return((char *)"Mac OSX audio");}
#endif
-/* -------------------------------- ESD -------------------------------- */
-
-/* ESD audio IO for Linux *
- * Nick Bailey <nick at bailey-family.org.uk> *
- * also n.bailey at elec.gla.ac.uk */
-
-/* ESD is pretty well undocumented, and I've not looked at snd before, *
- * but here goes... *
- * *
- * History: *
- * 14th Nov 2000: copied SUN drivers here and started to hack. NJB. *
- * */
-
-#ifdef MUS_ESD
-#define AUDIO_OK 1
-
-#include <esd.h>
-
-static int esd_play_sock = -1;
-static int esd_rec_sock = -1;
-static char esd_name[] = "Enlightened Sound Daemon";
-static int swap_end, resign; /* How to handle samples on write */
-
-int mus_audio_initialize(void) {return(MUS_NO_ERROR);}
-int mus_audio_systems(void) {return(1);}
-static char our_name[LABEL_BUFFER_SIZE];
-char *mus_audio_moniker(void)
-{
-#ifdef MUS_ESD_VERSION
- #ifdef MUS_AUDIOFILE_VERSION
- mus_snprintf(our_name, LABEL_BUFFER_SIZE, "%s: %s (Audiofile %s)", esd_name, MUS_ESD_VERSION, MUS_AUDIOFILE_VERSION);
- #else
- mus_snprintf(our_name, LABEL_BUFFER_SIZE, "%s: %s", esd_name, MUS_ESD_VERSION);
- #endif
- return(our_name);
-#else
- return(esd_name);
-#endif
-}
-
-int mus_audio_api(void) {return(0);}
-
-#define RETURN_ERROR_EXIT(Error_Type, Audio_Line, Ur_Error_Message) \
- do { char *Error_Message; Error_Message = Ur_Error_Message; \
- if (esd_play_sock != -1) close(esd_play_sock); \
- if (esd_rec_sock != -1) close(esd_rec_sock); \
- if (Error_Message) \
- {MUS_STANDARD_ERROR(Error_Type, Error_Message); free(Error_Message);} \
- else MUS_STANDARD_ERROR(Error_Type, mus_error_type_to_string(Error_Type)); \
- return(MUS_ERROR); \
- } while (false)
-
-/* No we're laughing. snd think's its talking to a real piece of hardware
- so it'll only try to open it once. We can just use the socket numbers */
-
-/* REVOLTING HACK! to_esd_format is called from mus_audio_open, and
- /as a side effect/, sets a flag to tell the write routine whether
- or not to change the endienness of the audio sample data (afaik,
- esd can't do this for us). Same goes for signed-ness.
- If it gets called from elsewhere, it could be nasty. */
-
-static int to_esd_format(int snd_format)
-{
- /* Try this on the Macs: it may be esd expects Bigendian on those */
- switch (snd_format) { /* Only some are supported */
- case MUS_UBYTE: swap_end = 0; resign = 0; return ESD_BITS8;
- case MUS_LSHORT: swap_end = 0; resign = 0; return ESD_BITS16;
- case MUS_BSHORT: swap_end = 1; resign = 0; return ESD_BITS16;
- case MUS_ULSHORT: swap_end = 0; resign = 1; return ESD_BITS16;
- case MUS_UBSHORT: swap_end = 1; resign = 1; return ESD_BITS16;
- }
- return MUS_ERROR;
-}
-
-int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size)
-{
- int esd_prop = ESD_STREAM;
- int esd_format;
-
- if ((esd_format = to_esd_format(format)) == MUS_ERROR)
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, audio_out,
- mus_format("Can't handle format %d (%s) through esd",
- format, mus_data_format_name(format)));
- else
- esd_prop |= esd_format;
-
- if (chans < 1 || chans > 2)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_out,
- mus_format("Can't handle format %d channels through esd",
- format));
- else
- esd_prop |= chans == 1 ? ESD_MONO : ESD_STEREO;
-
- esd_play_sock = esd_play_stream(esd_prop, srate,
- NULL, "snd playback stream");
-
- if (esd_play_sock == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_DEVICE_NOT_AVAILABLE, audio_out,
- mus_format("Sonorus device %d (%s) not available",
- ur_dev, mus_audio_device_name(ur_dev)));
- else
- return esd_play_sock;
-}
-
-int mus_audio_write(int line, char *buf, int bytes)
-{
- int written;
- char *to = buf;
-
- /* Esd can't do endianness or signed/unsigned conversion,
- so it's our problem. We won't screw up the callers data */
-
- if (swap_end) {
- char *from = buf;
- char *p;
- int samps = bytes/2;
- p = to = (char *)alloca(bytes);
- while (samps--) {
- *p++ = *(from+1);
- *p++ = *(from);
- from += 2;
- }
- }
-
- /* Need to do something about sign correction here */
-
- do {
- written = write(line, to, bytes);
- if (written > 0) {
- bytes -= written;
- to += written;
- }
- else
- RETURN_ERROR_EXIT(MUS_AUDIO_WRITE_ERROR, -1,
- mus_format("write error: %s", strerror(errno)));
- } while (bytes > 0);
- return MUS_NO_ERROR;
-}
-
-int mus_audio_close(int line)
-{
- esd_close(line);
- if (esd_play_sock == line) esd_play_sock = -1;
- else if (esd_rec_sock == line) esd_rec_sock = -1;
- return MUS_NO_ERROR;
-}
-
-int mus_audio_read(int line, char *buf, int bytes)
-{
- int bytes_read;
-
- do {
- bytes_read = read(line, buf, bytes);
- if (bytes_read > 0) { /* 0 -> EOF; we'll regard that as an error */
- bytes -= bytes_read;
- buf += bytes_read;
- } else
- RETURN_ERROR_EXIT(MUS_AUDIO_WRITE_ERROR, -1,
- mus_format("read error: %s", strerror(errno)));
- } while (bytes > 0);
- return MUS_NO_ERROR;
-}
-
-int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
-{
- int esd_prop = ESD_STREAM;
- int esd_format;
-
- if ((esd_format = to_esd_format(format)) == MUS_ERROR)
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, audio_out,
- mus_format("Can't handle format %d (%s) through esd",
- format, mus_data_format_name(format)));
- else
- esd_prop |= esd_format;
-
- if (chans < 1 || chans > 2)
- RETURN_ERROR_EXIT(MUS_AUDIO_CHANNELS_NOT_AVAILABLE, audio_out,
- mus_format("Can't handle format %d channels through esd",
- chans));
- else
- esd_prop |= chans == 1 ? ESD_MONO : ESD_STEREO;
-
- esd_rec_sock = esd_play_stream(esd_prop, srate,
- NULL, "snd record stream");
-
- if (esd_rec_sock == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_DEVICE_NOT_AVAILABLE, audio_out,
- mus_format("Device %d (%s) not available",
- ur_dev, mus_audio_device_name(ur_dev)));
- else
- return esd_rec_sock;
-}
-
-void describe_audio_state_1(void)
-{
- pprint("Enlightened Sound Daemon via socket connexion to default host");
-}
-
-#endif
-
/* ------------------------------- JACK ----------------------------------------- */
@@ -5245,6 +3752,7 @@ void describe_audio_state_1(void)
#if MUS_JACK
#define AUDIO_OK 1
+#include <pthread.h>
#include <jack/jack.h>
#include <samplerate.h>
#include <sys/mman.h>
@@ -5300,8 +3808,6 @@ static inline void __attribute__ ((__unused__)) atomic_add(volatile int* __mem,
/* Jack Part */
/*************/
-#define SNDJACK_MAXSNDS 20
-
#define SNDJACK_BUFFERSIZE 32768
typedef jack_default_audio_sample_t sample_t;
@@ -5623,7 +4129,7 @@ static int sndjack_init(void){
for (ch=0;ch<numch;ch++){
char temp[500];
- sprintf(temp, "out_%d",ch+1);
+ snprintf(temp, 500, "out_%d",ch+1);
if ((sndjack_channels[ch].port=jack_port_register(
sndjack_client,
mus_strdup(temp),
@@ -5639,7 +4145,7 @@ static int sndjack_init(void){
for (ch=0;ch<sndjack_num_read_channels_allocated;ch++){
char temp[500];
- sprintf(temp, "in_%d",ch+1);
+ snprintf(temp, 500, "in_%d",ch+1);
if ((sndjack_read_channels[ch].port=jack_port_register(
sndjack_client,
mus_strdup(temp),
@@ -5732,24 +4238,22 @@ static int sndjack_read_dev;
/* prototypes for the jack sndlib functions */
static int jack_mus_audio_initialize(void);
static void jack_mus_oss_set_buffers(int num, int size);
-static int jack_mus_audio_systems(void);
static char* jack_mus_audio_moniker(void);
-static int jack_mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size);
-static int jack_mus_audio_open_input(int ur_dev, int srate, int chans, int format, int requested_size);
+static int jack_mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size);
+static int jack_mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int requested_size);
static int jack_mus_audio_write(int id, char *buf, int bytes);
static int jack_mus_audio_read(int id, char *buf, int bytes);
static int jack_mus_audio_close(int id);
-static void jack_describe_audio_state_1(void);
#if (!HAVE_JACK_IN_LINUX) // Ie. Not using Linux.
-int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
- return(jack_mus_audio_open_output(ur_dev, srate, chans, format, size));
+ return(jack_mus_audio_open_output(ur_dev, srate, chans, samp_type, size));
}
-int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int requested_size)
+int mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int requested_size)
{
- return(jack_mus_audio_open_input(ur_dev, srate, chans, format, requested_size));
+ return(jack_mus_audio_open_input(ur_dev, srate, chans, samp_type, requested_size));
}
int mus_audio_write(int id, char *buf, int bytes)
@@ -5767,20 +4271,10 @@ int mus_audio_close(int id)
return(jack_mus_audio_close(id));
}
-static void describe_audio_state_1(void)
-{
- jack_describe_audio_state_1();
-}
-
int mus_audio_initialize(void){
return jack_mus_audio_initialize();
}
-int mus_audio_systems(void)
-{
- return(jack_mus_audio_systems());
-}
-
char* mus_audio_moniker(void)
{
return(jack_mus_audio_moniker());
@@ -5813,14 +4307,12 @@ static int jack_mus_audio_initialize(void) {
api = MUS_JACK_API;
vect_mus_audio_initialize = jack_mus_audio_initialize;
vect_mus_oss_set_buffers = jack_mus_oss_set_buffers;
- vect_mus_audio_systems = jack_mus_audio_systems;
vect_mus_audio_moniker = jack_mus_audio_moniker;
vect_mus_audio_open_output = jack_mus_audio_open_output;
vect_mus_audio_open_input = jack_mus_audio_open_input;
vect_mus_audio_write = jack_mus_audio_write;
vect_mus_audio_read = jack_mus_audio_read;
vect_mus_audio_close = jack_mus_audio_close;
- vect_describe_audio_state_1 = jack_describe_audio_state_1;
audio_initialized = true;
@@ -5939,7 +4431,7 @@ static void jack_mus_audio_set_non_realtime(void){
#endif
}
-int jack_mus_audio_open_output(int dev, int srate, int chans, int format, int size){
+int jack_mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size){
if (sndjack_client==NULL){
if (jack_mus_audio_initialize()==MUS_ERROR)
return MUS_ERROR;
@@ -5950,8 +4442,8 @@ int jack_mus_audio_open_output(int dev, int srate, int chans, int format, int si
return MUS_ERROR;
}
- if (format!=MUS_BYTE && format!=MUS_COMP_SHORT && format!=MUS_COMP_FLOAT){
- printf("Error, unable to handle format %s.\n",mus_data_format_to_string(format));
+ if (samp_type!=MUS_BYTE && samp_type!=MUS_COMP_SHORT && samp_type!=MUS_COMP_FLOAT){
+ printf("Error, unable to handle sample type %s.\n",mus_sample_type_to_string(samp_type));
return MUS_ERROR;
}
@@ -5973,7 +4465,7 @@ int jack_mus_audio_open_output(int dev, int srate, int chans, int format, int si
sndjack_srcratio=1.0;
}
- sndjack_format=format;
+ sndjack_format=samp_type;
sndjack_num_channels_inuse=chans;
sndjack_dev=dev;
@@ -5982,6 +4474,9 @@ int jack_mus_audio_open_output(int dev, int srate, int chans, int format, int si
return(MUS_NO_ERROR);
}
+
+#define MUS_BYTE_TO_SAMPLE(n) (((mus_float_t)(n) / (mus_float_t)(1 << 7)))
+
static int sndjack_from_byte(int ch,int chs,char *buf,float *out,int bytes){
int i;
int len=bytes/chs;
@@ -6055,12 +4550,12 @@ int jack_mus_audio_write(int line, char *buf, int bytes){
return MUS_ERROR;
}
if (src_data.input_frames!=len){
- printf("Unsuccessfull resampling: Should have used %d bytes, used %d.",len,src_data.input_frames);
+ printf("Unsuccessfull resampling: Should have used %d bytes, used %ld.",len,(long int)(src_data.input_frames));
return MUS_ERROR;
}
if (ch>0 && src_data.output_frames_gen!=outlen){
- printf("Error, src_process did not output the same number of frames as previous resampled channel (%d/%d).\n"
- "Please report this problem to k.s.matheussen at notam02.no. Thanks!\n",src_data.output_frames_gen,outlen);
+ printf("Error, src_process did not output the same number of frames as previous resampled channel (%ld/%d).\n"
+ "Please report this problem to k.s.matheussen at notam02.no. Thanks!\n",(long int)(src_data.output_frames_gen),outlen);
return MUS_ERROR;
}
outlen=src_data.output_frames_gen;
@@ -6085,7 +4580,7 @@ int jack_mus_audio_close(int line)
return MUS_NO_ERROR;
}
-int jack_mus_audio_open_input(int dev, int srate, int chans, int format, int size){
+int jack_mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size){
if (sndjack_client==NULL){
if (jack_mus_audio_initialize()==MUS_ERROR)
return MUS_ERROR;
@@ -6097,8 +4592,8 @@ int jack_mus_audio_open_input(int dev, int srate, int chans, int format, int siz
}
printf("dev: %d\n" ,dev);
- if (format!=MUS_BYTE && format!=MUS_COMP_SHORT && format!=MUS_COMP_FLOAT){
- printf("Error, unable to handle format %s.\n",mus_data_format_to_string(format));
+ if (samp_type!=MUS_BYTE && samp_type!=MUS_COMP_SHORT && samp_type!=MUS_COMP_FLOAT){
+ printf("Error, unable to handle format %s.\n",mus_sample_type_to_string(samp_type));
return MUS_ERROR;
}
@@ -6106,7 +4601,7 @@ int jack_mus_audio_open_input(int dev, int srate, int chans, int format, int siz
printf("Warning, jacks samplerate is %d (and not %d), and the recording will use this samplerate too.\n",jack_get_sample_rate(sndjack_client),srate);
}
- sndjack_read_format=format;
+ sndjack_read_format=samp_type;
sndjack_num_read_channels_inuse=chans;
sndjack_read_dev=dev;
@@ -6121,32 +4616,9 @@ int jack_mus_audio_read(int line, char *buf, int bytes){
}
-static void jack_describe_audio_state_1(void) {
- char temp[500];
-
- pprint("jack audio:\n");
- sprintf(temp, "\tNumber of output channels: %d\n",sndjack_num_channels_allocated);pprint(temp);
- sprintf(temp, "\tNumber of input channels: %d\n",sndjack_num_read_channels_allocated);pprint(temp);
- sprintf(temp, "\tSamplerate: %d\n",jack_get_sample_rate(sndjack_client));pprint(temp);
- sprintf(temp, "\tJack buffersize: %d\n",sj_jackbuffersize);pprint(temp);
- sprintf(temp, "\tSndjack buffersize: %d\n",SNDJACK_BUFFERSIZE);pprint(temp);
- sprintf(temp, "\tMax number of instances: %d\n",SNDJACK_MAXSNDS);pprint(temp);
- sprintf(temp, "\tTotal number of frames delayed: %d\n",sj_totalxrun);pprint(temp);
- sprintf(temp, "\tCurrent cpu-load: %f\n",jack_cpu_load(sndjack_client));pprint(temp);
- sprintf(temp, "\tIs running realtime: %s\n",jack_is_realtime(sndjack_client)==1?"yes":"no");pprint(temp);
- sprintf(temp, "\tResample quality (only used when needed): %s (%s)\n",src_get_name(SRC_QUALITY),src_get_description(SRC_QUALITY));pprint(temp);
- sprintf(temp, "\tIs able to handle the following audio formats: %s %s %s\n",mus_data_format_to_string(MUS_BYTE),mus_data_format_to_string(MUS_COMP_SHORT),mus_data_format_to_string(MUS_COMP_FLOAT));pprint(temp);
- sprintf(temp, "\tPrefered audio format: %s\n",mus_data_format_to_string(MUS_COMP_FLOAT));pprint(temp);
-}
-
-
-int jack_mus_audio_systems(void) {
- return(1); /* was 2 which causes lots of problems -- Fernando and Bill 27-Jan-10 */
-}
-
char *jack_mus_audio_moniker(void)
{
- return(MUS_JACK_VERSION);
+ return((char *)"Jack");
}
#endif
@@ -6159,17 +4631,17 @@ char *jack_mus_audio_moniker(void)
* Sun version changed 28-Jan-99
*/
-#if defined(MUS_HPUX) && (!(defined(AUDIO_OK)))
+#if defined(__hpux) && (!(defined(AUDIO_OK)))
#define AUDIO_OK 1
#include <sys/audio.h>
-#define RETURN_ERROR_EXIT(Error_Type, Audio_Line, Ur_Error_Message) \
+#define return_error_exit(Error_Type, Audio_Line, Ur_Error_Message) \
do { char *Error_Message; Error_Message = Ur_Error_Message; \
if (Audio_Line != -1) close(Audio_Line); \
if (Error_Message) \
- {MUS_STANDARD_ERROR(Error_Type, Error_Message); free(Error_Message);} \
- else MUS_STANDARD_ERROR(Error_Type, mus_error_type_to_string(Error_Type)); \
+ {mus_standard_error(Error_Type, Error_Message); free(Error_Message);} \
+ else mus_standard_error(Error_Type, mus_error_type_to_string(Error_Type)); \
return(MUS_ERROR); \
} while (false)
@@ -6180,7 +4652,7 @@ char *mus_audio_moniker(void)
}
-int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_output(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
int fd, i, dev;
struct audio_describe desc;
@@ -6188,7 +4660,7 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
dev = MUS_AUDIO_DEVICE(ur_dev);
fd = open("/dev/audio", O_RDWR);
if (fd == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, -1,
+ return_error_exit(MUS_AUDIO_CANT_OPEN, -1,
mus_format("can't open /dev/audio for output: %s",
strerror(errno)));
@@ -6200,22 +4672,21 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
ioctl(fd, AUDIO_SET_OUTPUT, AUDIO_OUT_LINE);
else ioctl(fd, AUDIO_SET_OUTPUT, AUDIO_OUT_HEADPHONE);
- if (format == MUS_BSHORT)
- ioctl(fd, AUDIO_SET_DATA_FORMAT, AUDIO_FORMAT_LINEAR16BIT);
+ if (samp_type == MUS_BSHORT)
+ ioctl(fd, AUDIO_SET_SAMPLE_TYPE, AUDIO_FORMAT_LINEAR16BIT);
else
{
- if (format == MUS_MULAW)
- ioctl(fd, AUDIO_SET_DATA_FORMAT, AUDIO_FORMAT_ULAW);
+ if (samp_type == MUS_MULAW)
+ ioctl(fd, AUDIO_SET_SAMPLE_TYPE, AUDIO_FORMAT_ULAW);
else
{
- if (format == MUS_ALAW)
- ioctl(fd, AUDIO_SET_DATA_FORMAT, AUDIO_FORMAT_ALAW);
+ if (samp_type == MUS_ALAW)
+ ioctl(fd, AUDIO_SET_SAMPLE_TYPE, AUDIO_FORMAT_ALAW);
else
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, fd,
- mus_format("can't set output format to %d (%s) for %d (%s)",
- format, mus_data_format_to_string(format),
- dev,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, fd,
+ mus_format("can't set output sample type to %d (%s) for %d",
+ samp_type, mus_sample_type_to_string(samp_type),
+ dev));
}
}
@@ -6225,10 +4696,9 @@ int mus_audio_open_output(int ur_dev, int srate, int chans, int format, int size
break;
if (i == desc.nrates)
- RETURN_ERROR_EXIT(SRATE_NOT_AVAILABLE, fd,
- mus_format("can't set srate to %d on %d (%s)",
- srate, dev,
- mus_audio_device_name(dev)));
+ return_error_exit(SRATE_NOT_AVAILABLE, fd,
+ mus_format("can't set srate to %d on %d",
+ srate, dev));
ioctl(fd, AUDIO_SET_SAMPLE_RATE, srate);
return(fd);
@@ -6249,92 +4719,18 @@ int mus_audio_close(int line)
}
-static void describe_audio_state_1(void)
-{
- struct audio_describe desc;
- struct audio_gain gain;
- int mina, maxa, fd, tmp;
- int g[2];
-
- fd = open("/dev/audio", O_RDWR);
- if (fd == -1) return;
-
- ioctl(fd, AUDIO_GET_OUTPUT, &tmp);
- switch (tmp)
- {
- case AUDIO_OUT_SPEAKER: pprint("output: speakers\n"); break;
- case AUDIO_OUT_HEADPHONE: pprint("output: headphone\n"); break;
- case AUDIO_OUT_LINE: pprint("output: line out\n"); break;
- }
-
- ioctl(fd, AUDIO_GET_INPUT, &tmp);
- switch (tmp)
- {
- case AUDIO_IN_MIKE: pprint("input: mic\n"); break;
- case AUDIO_IN_LINE: pprint("input: line in\n"); break;
- }
-
- ioctl(fd, AUDIO_GET_DATA_FORMAT, &tmp);
- switch (tmp)
- {
- case AUDIO_FORMAT_LINEAR16BIT: pprint("format: 16-bit linear\n"); break;
- case AUDIO_FORMAT_ULAW: pprint("format: mulaw\n"); break;
- case AUDIO_FORMAT_ALAW: pprint("format: alaw\n"); break;
- }
-
- ioctl(fd, AUDIO_DESCRIBE, &desc);
- gain.channel_mask = (AUDIO_CHANNEL_LEFT | AUDIO_CHANNEL_RIGHT);
-
- ioctl(fd, AUDIO_GET_GAINS, &gain);
- close(fd);
-
- g[0] = gain.cgain[0].transmit_gain;
- g[1] = gain.cgain[1].transmit_gain;
- mina = desc.min_transmit_gain;
- maxa = desc.max_transmit_gain;
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "out vols: %.3f %.3f\n",
- (float)(g[0] - mina) / (float)(maxa - mina),
- (float)(g[1] - mina) / (float)(maxa - mina));
- pprint(audio_strbuf);
-
- g[0] = gain.cgain[0].receive_gain;
- g[1] = gain.cgain[1].receive_gain;
- mina = desc.min_receive_gain;
- maxa = desc.max_receive_gain;
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "in vols: %.3f %.3f\n",
- (float)(g[0] - mina) / (float)(maxa - mina),
- (float)(g[1] - mina) / (float)(maxa - mina));
- pprint(audio_strbuf);
-
- g[0] = gain.cgain[0].monitor_gain;
- g[1] = gain.cgain[1].monitor_gain;
- mina = desc.min_monitor_gain;
- maxa = desc.max_monitor_gain;
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "monitor vols: %.3f %.3f\n",
- (float)(g[0] - mina) / (float)(maxa - mina),
- (float)(g[1] - mina) / (float)(maxa - mina));
- pprint(audio_strbuf);
-}
-
-
int mus_audio_initialize(void)
{
return(MUS_NO_ERROR);
}
-int mus_audio_systems(void)
-{
- return(1);
-}
-
-
/* struct audio_status status_b;
* ioctl(devAudio, AUDIO_GET_STATUS, &status_b)
* not_busy = (status_b.transmit_status == AUDIO_DONE);
*/
-int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
int fd, i, dev;
struct audio_describe desc;
@@ -6342,7 +4738,7 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
dev = MUS_AUDIO_DEVICE(ur_dev);
fd = open("/dev/audio", O_RDWR);
if (fd == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, NULL,
+ return_error_exit(MUS_AUDIO_CANT_OPEN, NULL,
mus_format("can't open /dev/audio for input: %s",
strerror(errno)));
@@ -6351,22 +4747,21 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
ioctl(fd, AUDIO_SET_INPUT, AUDIO_IN_MIKE);
else ioctl(fd, AUDIO_SET_INPUT, AUDIO_IN_LINE);
- if (format == MUS_BSHORT)
- ioctl(fd, AUDIO_SET_DATA_FORMAT, AUDIO_FORMAT_LINEAR16BIT);
+ if (samp_type == MUS_BSHORT)
+ ioctl(fd, AUDIO_SET_SAMPLE_TYPE, AUDIO_FORMAT_LINEAR16BIT);
else
{
- if (format == MUS_MULAW)
- ioctl(fd, AUDIO_SET_DATA_FORMAT, AUDIO_FORMAT_ULAW);
+ if (samp_type == MUS_MULAW)
+ ioctl(fd, AUDIO_SET_SAMPLE_TYPE, AUDIO_FORMAT_ULAW);
else
{
- if (format == MUS_ALAW)
- ioctl(fd, AUDIO_SET_DATA_FORMAT, AUDIO_FORMAT_ALAW);
+ if (samp_type == MUS_ALAW)
+ ioctl(fd, AUDIO_SET_SAMPLE_TYPE, AUDIO_FORMAT_ALAW);
else
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, fd,
- mus_format("can't set input format to %d (%s) on %d (%s)",
- format, mus_data_format_to_string(format),
- dev,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, fd,
+ mus_format("can't set input sample type to %d (%s) on %d",
+ samp_type, mus_sample_type_to_string(samp_type),
+ dev));
}
}
@@ -6376,10 +4771,9 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
break;
if (i == desc.nrates)
- RETURN_ERROR_EXIT(MUS_AUDIO_SRATE_NOT_AVAILABLE, fd,
- mus_format("can't set srate to %d on %d (%s)",
- srate, dev,
- mus_audio_device_name(dev)));
+ return_error_exit(MUS_AUDIO_SRATE_NOT_AVAILABLE, fd,
+ mus_format("can't set srate to %d on %d",
+ srate, dev));
ioctl(fd, AUDIO_SET_SAMPLE_RATE, srate);
return(fd);
@@ -6396,9 +4790,9 @@ int mus_audio_read(int line, char *buf, int bytes)
-/* ------------------------------- NETBSD ----------------------------------------- */
+/* ------------------------------- NETBSD/OpenBSD ----------------------------------------- */
-#if defined(MUS_NETBSD) && (!(defined(AUDIO_OK)))
+#if (__NetBSD__ || __OpenBSD__) && (!(defined(AUDIO_OK)))
#define AUDIO_OK 1
/* started from Xanim a long time ago..., bugfixes from Thomas Klausner 30-Jul-05, worked into better shape Aug-05 */
@@ -6407,17 +4801,17 @@ int mus_audio_read(int line, char *buf, int bytes)
#include <sys/ioctl.h>
-#define RETURN_ERROR_EXIT(Error_Type, Audio_Line, Ur_Error_Message) \
+#define return_error_exit(Error_Type, Audio_Line, Ur_Error_Message) \
do { char *Error_Message; Error_Message = Ur_Error_Message; \
if (Audio_Line != -1) close(Audio_Line); \
if (Error_Message) \
- {MUS_STANDARD_ERROR(Error_Type, Error_Message); free(Error_Message);} \
- else MUS_STANDARD_ERROR(Error_Type, mus_error_type_to_string(Error_Type)); \
+ {mus_standard_error(Error_Type, Error_Message); free(Error_Message);} \
+ else mus_standard_error(Error_Type, mus_error_type_to_string(Error_Type)); \
return(MUS_ERROR); \
} while (false)
-static int bsd_format_to_sndlib(int encoding)
+static mus_sample_t bsd_format_to_sndlib(int encoding)
{
switch (encoding)
{
@@ -6433,13 +4827,13 @@ static int bsd_format_to_sndlib(int encoding)
case AUDIO_ENCODING_ULINEAR: return(MUS_UBYTE); break;
case AUDIO_ENCODING_NONE:
case AUDIO_ENCODING_ADPCM:
- default: return(MUS_UNKNOWN); break;
+ default: return(MUS_UNKNOWN_SAMPLE); break;
}
- return(MUS_UNKNOWN);
+ return(MUS_UNKNOWN_SAMPLE);
}
-static int sndlib_format_to_bsd(int encoding)
+static int sndlib_format_to_bsd(mus_sample_t encoding)
{
switch (encoding)
{
@@ -6451,6 +4845,7 @@ static int sndlib_format_to_bsd(int encoding)
case MUS_ULSHORT: return(AUDIO_ENCODING_ULINEAR_LE); break;
case MUS_UBSHORT: return(AUDIO_ENCODING_ULINEAR_BE); break;
case MUS_UBYTE: return(AUDIO_ENCODING_ULINEAR); break;
+ default: break;
}
return(AUDIO_ENCODING_NONE);
}
@@ -6462,15 +4857,13 @@ int mus_audio_initialize(void)
}
-int mus_audio_systems(void)
-{
- return(1);
-}
-
-
char *mus_audio_moniker(void)
{
- return("NetBSD audio");
+#if __NetBSD__
+ return((char *)"NetBSD audio");
+#else
+ return((char *)"OpenBSD audio");
+#endif
}
@@ -6508,12 +4901,14 @@ int mus_audio_close(int line)
}
-int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
+static int netbsd_default_outputs = (AUDIO_HEADPHONE | AUDIO_LINE_OUT | AUDIO_SPEAKER);
+
+int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size)
{
int line, encode;
audio_info_t a_info;
- line = open("/dev/sound", O_WRONLY | O_NDELAY); /* /dev/audio assumes mono 8-bit mulaw */
+ line = open("/dev/sound", O_WRONLY); /* /dev/audio assumes mono 8-bit mulaw */
if (line == -1)
{
if (errno == EBUSY)
@@ -6523,16 +4918,16 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
AUDIO_INITINFO(&a_info);
/* a_info.blocksize = size; */
- encode = sndlib_format_to_bsd(format);
+ encode = sndlib_format_to_bsd(samp_type);
if (encode == AUDIO_ENCODING_NONE)
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, -1,
- mus_format("format %d (%s) not available",
- format,
- mus_data_format_name(format)));
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, -1,
+ mus_format("sample type %d (%s) not available",
+ samp_type,
+ mus_sample_type_name(samp_type)));
a_info.play.encoding = encode;
a_info.mode = AUMODE_PLAY | AUMODE_PLAY_ALL;
- a_info.play.precision = mus_bytes_per_sample(format) * 8;
+ a_info.play.precision = mus_bytes_per_sample(samp_type) * 8;
a_info.play.sample_rate = srate;
if (dev == MUS_AUDIO_LINE_OUT)
@@ -6552,8 +4947,8 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
if ((int)(a_info.play.sample_rate) != srate)
mus_print("srate: %d -> %d\n", srate, a_info.play.sample_rate);
- if ((int)(a_info.play.encoding) != sndlib_format_to_bsd(format))
- mus_print("encoding: %d -> %d\n", sndlib_format_to_bsd(format), a_info.play.encoding);
+ if ((int)(a_info.play.encoding) != sndlib_format_to_bsd(samp_type))
+ mus_print("encoding: %d -> %d\n", sndlib_format_to_bsd(samp_type), a_info.play.encoding);
if ((int)(a_info.play.channels) != chans)
mus_print("chans: %d -> %d\n", chans, a_info.play.channels);
@@ -6571,106 +4966,24 @@ int mus_audio_read(int line, char *buf, int bytes)
}
-static void describe_audio_state_1(void)
-{
- audio_device_t dev;
- int i = 0, val, err = 0;
- int line;
- float amp;
- audio_info_t a_info;
- audio_encoding_t e_info;
-
- pprint("NetBSD ");
- line = open("/dev/sound", O_WRONLY | O_NDELAY);
- if (line == -1)
- return;
-
- pprint("/dev/sound:\n");
- err = ioctl(line, AUDIO_GETDEV, &dev);
- if (err == 0)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "%s: version: %s (%s)", dev.name, dev.version, dev.config);
- pprint(audio_strbuf);
- }
-
- err = ioctl(line, AUDIO_GETPROPS, &val);
- if (err == 0)
- {
- if (val & AUDIO_PROP_FULLDUPLEX)
- pprint(" full-duplex");
- else pprint(" half-duplex");
- }
- pprint("\n");
-
- err = ioctl(line, AUDIO_GETINFO, &a_info);
- if (err == 0)
- {
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " play: srate: %d, chans: %d, format: %s (%d bits), ",
- a_info.play.sample_rate,
- a_info.play.channels,
- mus_data_format_short_name(bsd_format_to_sndlib(a_info.play.encoding)),
- a_info.play.precision);
- pprint(audio_strbuf);
-
- amp = (float)(a_info.play.gain - AUDIO_MIN_GAIN) / (float)(AUDIO_MAX_GAIN - AUDIO_MIN_GAIN);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "volume: %.3f %.3f (gain: %d, balance: %d)\n",
- amp * (1.0 - ((float)(a_info.play.balance) / (float)(2 * AUDIO_MID_BALANCE))),
- amp * ((float)(a_info.play.balance) / (float)(2 * AUDIO_MID_BALANCE)),
- a_info.play.gain, a_info.play.balance);
- pprint(audio_strbuf);
-
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " record: srate: %d, chans: %d, format: %s (%d bits), ",
- a_info.record.sample_rate,
- a_info.record.channels,
- mus_data_format_short_name(bsd_format_to_sndlib(a_info.record.encoding)),
- a_info.record.precision);
- pprint(audio_strbuf);
-
- amp = (float)(a_info.record.gain - AUDIO_MIN_GAIN) / (float)(AUDIO_MAX_GAIN - AUDIO_MIN_GAIN);
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "volume: %.3f %.3f (gain: %d, balance: %d)\n",
- amp * (1.0 - ((float)(a_info.record.balance) / (float)(2 * AUDIO_MID_BALANCE))),
- amp * ((float)(a_info.record.balance) / (float)(2 * AUDIO_MID_BALANCE)),
- a_info.record.gain, a_info.record.balance);
- pprint(audio_strbuf);
- }
-
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " available encodings:\n");
- pprint(audio_strbuf);
-
- for (i = 0; ; i++)
- {
- e_info.index = i;
- err = ioctl(line, AUDIO_GETENC, &e_info);
- if (err != 0) break;
- mus_snprintf(audio_strbuf, PRINT_BUFFER_SIZE, " %s (%s, bits: %d)\n",
- mus_data_format_short_name(bsd_format_to_sndlib(e_info.encoding)),
- e_info.name,
- e_info.precision);
- pprint(audio_strbuf);
- }
-
- close(line);
-}
-
-
-static int netbsd_formats(int ur_dev, int *val)
+static int netbsd_sample_types(int ur_dev, mus_sample_t *val)
{
int i, audio_fd, err, dev;
audio_info_t info;
- bool ok = true;
audio_encoding_t e_info;
dev = MUS_AUDIO_DEVICE(ur_dev);
AUDIO_INITINFO(&info);
+
audio_fd = open("/dev/sound", O_RDONLY | O_NONBLOCK, 0);
if (audio_fd == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_READ, -1,
- mus_format("can't open /dev/sound: %s",
- strerror(errno)));
+ return_error_exit(MUS_AUDIO_CANT_READ, -1, mus_format("can't open /dev/sound: %s", strerror(errno)));
err = ioctl(audio_fd, AUDIO_GETINFO, &info);
if (err == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_READ, audio_fd,
- mus_format("can't get dac info"));
+ {
+ close(audio_fd);
+ return_error_exit(MUS_AUDIO_CANT_READ, audio_fd, mus_format("can't get dac info"));
+ }
for (i = 0; ; i++)
{
@@ -6679,30 +4992,31 @@ static int netbsd_formats(int ur_dev, int *val)
if (err != 0) break;
val[i + 1] = bsd_format_to_sndlib(e_info.encoding);
}
- val[0] = i;
+ val[0] = (mus_sample_t)i;
+ close(audio_fd);
return(MUS_NO_ERROR);
}
-int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
+int mus_audio_open_input(int ur_dev, int srate, int chans, mus_sample_t samp_type, int size)
{
audio_info_t info;
int encode, bits, dev, audio_fd, err;
dev = MUS_AUDIO_DEVICE(ur_dev);
- encode = sndlib_format_to_bsd(format);
- bits = 8 * mus_bytes_per_sample(format);
+ encode = sndlib_format_to_bsd(samp_type);
+ bits = 8 * mus_bytes_per_sample(samp_type);
if (encode == AUDIO_ENCODING_NONE)
- RETURN_ERROR_EXIT(MUS_AUDIO_FORMAT_NOT_AVAILABLE, -1,
- mus_format("format %s not available for recording",
- mus_data_format_name(format)));
+ return_error_exit(MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE, -1,
+ mus_format("sample type %s not available for recording",
+ mus_sample_type_name(samp_type)));
if (dev != MUS_AUDIO_DUPLEX_DEFAULT)
audio_fd = open("/dev/sound", O_RDONLY, 0);
else audio_fd = open("/dev/sound", O_RDWR, 0);
if (audio_fd == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_OPEN, -1,
+ return_error_exit(MUS_AUDIO_CANT_OPEN, -1,
mus_format("can't open /dev/sound: %s",
strerror(errno)));
@@ -6714,7 +5028,7 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
info.record.port = AUDIO_MICROPHONE;
err = ioctl(audio_fd, AUDIO_SETINFO, &info);
if (err == -1)
- RETURN_ERROR_EXIT(MUS_AUDIO_CANT_WRITE, audio_fd,
+ return_error_exit(MUS_AUDIO_CANT_WRITE, audio_fd,
mus_format("can't set up for recording"));
return(audio_fd);
}
@@ -6740,9 +5054,9 @@ int mus_audio_open_input(int ur_dev, int srate, int chans, int format, int size)
#include <pulse/gccmacro.h>
-static int sndlib_to_pa_format(int format)
+static int sndlib_to_pa_format(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_BYTE: return(PA_SAMPLE_U8);
case MUS_LSHORT: return(PA_SAMPLE_S16LE);
@@ -6755,7 +5069,7 @@ static int sndlib_to_pa_format(int format)
case MUS_MULAW: return(PA_SAMPLE_ULAW);
default:
- fprintf(stderr, "unsupported data format: %d\n", format);
+ fprintf(stderr, "unsupported sample type: %d\n", samp_type);
return(0);
break;
}
@@ -6764,19 +5078,13 @@ static int sndlib_to_pa_format(int format)
static pa_simple *pa_out = NULL, *pa_in = NULL;
-static void describe_audio_state_1(void)
-{
- pprint("pulse audio");
-}
-
-
-int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
+int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size)
{
pa_sample_spec *spec;
int error;
spec = (pa_sample_spec *)malloc(sizeof(pa_sample_spec));
- spec->format = sndlib_to_pa_format(format);
+ spec->format = sndlib_to_pa_format(samp_type);
spec->rate = srate;
spec->channels = chans;
@@ -6791,7 +5099,7 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
}
-int mus_audio_open_input(int dev, int srate, int chans, int format, int size)
+int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size)
{
return(MUS_ERROR);
}
@@ -6825,12 +5133,6 @@ int mus_audio_initialize(void)
}
-int mus_audio_systems(void)
-{
- return(1);
-}
-
-
char *mus_audio_moniker(void)
{
return(mus_format("pulseaudio %s", pa_get_library_version()));
@@ -6851,9 +5153,9 @@ char *mus_audio_moniker(void)
#define PA_OUT_STREAM 0
#define PA_IN_STREAM 1
-static unsigned long sndlib_to_portaudio_format(int format)
+static unsigned long sndlib_to_portaudio_format(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_BYTE: return(paInt8);
case MUS_LSHORT: return(paInt16);
@@ -6862,20 +5164,21 @@ static unsigned long sndlib_to_portaudio_format(int format)
case MUS_BINT: return(paInt32);
case MUS_LFLOAT: return(paFloat32);
case MUS_BFLOAT: return(paFloat32);
+ default: break;
}
return(paInt16);
}
static PaStream *out_stream = NULL;
-int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
+int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size)
{
PaStreamParameters output_pars;
PaError err;
output_pars.device = Pa_GetDefaultOutputDevice();
output_pars.channelCount = chans;
- output_pars.sampleFormat = sndlib_to_portaudio_format(format);
+ output_pars.sampleFormat = sndlib_to_portaudio_format(samp_type);
output_pars.suggestedLatency = Pa_GetDeviceInfo(output_pars.device)->defaultHighOutputLatency;
output_pars.hostApiSpecificStreamInfo = NULL;
@@ -6894,14 +5197,14 @@ int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
static PaStream *in_stream = NULL;
-int mus_audio_open_input(int dev, int srate, int chans, int format, int size)
+int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size)
{
PaStreamParameters input_pars;
PaError err;
input_pars.device = Pa_GetDefaultInputDevice();
input_pars.channelCount = chans;
- input_pars.sampleFormat = sndlib_to_portaudio_format(format);
+ input_pars.sampleFormat = sndlib_to_portaudio_format(samp_type);
input_pars.suggestedLatency = Pa_GetDeviceInfo(input_pars.device)->defaultHighInputLatency;
input_pars.hostApiSpecificStreamInfo = NULL;
@@ -6981,162 +5284,34 @@ int mus_audio_initialize(void)
}
-int mus_audio_systems(void)
-{
- return(1);
-}
-
-
char *mus_audio_moniker(void)
{
return((char *)Pa_GetVersionText());
}
-
-
-static void describe_audio_state_1(void)
-{
- int i, ndevices, default_input_device, default_output_device;
-
- mus_audio_initialize();
-
- ndevices = Pa_GetDeviceCount();
- default_input_device = Pa_GetDefaultInputDevice();
- default_output_device = Pa_GetDefaultOutputDevice();
-
- for (i = 0; i < ndevices; i++)
- {
- const PaDeviceInfo *info;
- const PaHostApiInfo *host_info;
-
- info = Pa_GetDeviceInfo(i);
- host_info = Pa_GetHostApiInfo(info->hostApi);
-
- pprint(info->name);
- pprint(" (");
- pprint(host_info->name);
- pprint(") ");
- if ((i == default_input_device) ||
- (i == host_info->defaultInputDevice))
- pprint("default input");
- else
- {
- if ((i == default_output_device) ||
- (i == host_info->defaultOutputDevice))
- pprint("default output");
- }
- snprintf(audio_strbuf, PRINT_BUFFER_SIZE, "\n input chans: %d, output chans: %d\n", info->maxInputChannels, info->maxOutputChannels);
- pprint(audio_strbuf);
- }
-}
-
-
#endif
+
/* ------------------------------- STUBS ----------------------------------------- */
#ifndef AUDIO_OK
-static void describe_audio_state_1(void) {pprint("audio stubbed out");}
-int mus_audio_open_output(int dev, int srate, int chans, int format, int size) {return(MUS_ERROR);}
-int mus_audio_open_input(int dev, int srate, int chans, int format, int size) {return(MUS_ERROR);}
+int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size) {return(MUS_ERROR);}
+int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size) {return(MUS_ERROR);}
int mus_audio_write(int line, char *buf, int bytes) {return(MUS_ERROR);}
int mus_audio_close(int line) {return(MUS_ERROR);}
int mus_audio_read(int line, char *buf, int bytes) {return(MUS_ERROR);}
int mus_audio_initialize(void) {return(MUS_ERROR);}
-int mus_audio_systems(void) {return(0);}
char *mus_audio_moniker(void) {return((char *)"no audio support");}
#endif
-/* -------------------------------- pprint etc -------------------------------- */
-
-static char *save_it = NULL;
-static int save_it_len = 0;
-static int save_it_loc = 0;
-
-static void pprint(const char *str)
-{
- if ((str) && (*str))
- {
- int i, len;
- len = strlen(str);
- if ((len + save_it_loc + 2) >= save_it_len)
- {
- save_it_len = (len + save_it_loc + 1024);
- save_it = (char *)realloc(save_it, save_it_len * sizeof(char));
- }
- for (i = 0; i < len; i++)
- save_it[save_it_loc++] = str[i];
- save_it[save_it_loc] = 0;
- }
-}
-
-
-char *mus_audio_describe(void)
-{
- mus_audio_initialize();
- if (!(save_it))
- {
- save_it_len = 1024;
- save_it = (char *)calloc(save_it_len, sizeof(char));
- }
- save_it_loc = 0;
- if (!audio_strbuf) audio_strbuf = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- describe_audio_state_1();
- return(save_it);
-}
-
-
/* for CLM */
void mus_reset_audio_c(void)
{
audio_initialized = false;
- save_it = NULL;
version_name = NULL;
-#ifdef MUS_SUN
- sun_vol_name = NULL;
-#endif
- save_it_len = 0;
- audio_strbuf = NULL;
-}
-
-
-/* next two added 17-Dec-02 for non-interleaved audio IO */
-static char *output_buffer = NULL;
-static int output_buffer_size = 0;
-
-int mus_audio_write_buffers(int port, int frames, int chans, mus_sample_t **bufs, int output_format, bool clipped)
-{
- int bytes;
- bytes = chans * frames * mus_bytes_per_sample(output_format);
- if (output_buffer_size < bytes)
- {
- if (output_buffer) free(output_buffer);
- output_buffer = (char *)malloc(bytes);
- output_buffer_size = bytes;
- }
- mus_file_write_buffer(output_format, 0, frames - 1, chans, bufs, output_buffer, clipped);
- return(mus_audio_write(port, output_buffer, bytes));
-}
-
-
-static char *input_buffer = NULL;
-static int input_buffer_size = 0;
-
-int mus_audio_read_buffers(int port, int frames, int chans, mus_sample_t **bufs, int input_format)
-{
- int bytes;
- bytes = chans * frames * mus_bytes_per_sample(input_format);
- if (input_buffer_size < bytes)
- {
- if (input_buffer) free(input_buffer);
- input_buffer = (char *)malloc(bytes);
- input_buffer_size = bytes;
- }
- mus_audio_read(port, input_buffer, bytes);
- return(mus_file_read_buffer(input_format, 0, chans, frames, bufs, input_buffer));
}
@@ -7252,36 +5427,32 @@ int mus_audio_device_channels(int dev)
}
#endif
-
-#if MUS_MAC_OSX
- return(osx_chans(dev));
-#endif
-
- return(2); /* netbsd hpux esd sun and oss with quibbles */
+ return(2); /* netbsd hpux sun mac and oss with quibbles */
}
-int mus_audio_compatible_format(int dev) /* snd-dac and sndplay */
+mus_sample_t mus_audio_compatible_sample_type(int dev) /* snd-dac and sndplay */
{
#if HAVE_ALSA
- int err, i;
- int ival[32];
if (api == MUS_ALSA_API)
{
- err = alsa_formats(dev, 32, ival);
+ int err;
+ mus_sample_t ival[32];
+ err = alsa_sample_types(dev, 32, ival);
if (err != MUS_ERROR)
{
- for (i = 1; i <= ival[0]; i++)
- if (ival[i] == MUS_AUDIO_COMPATIBLE_FORMAT)
- return(MUS_AUDIO_COMPATIBLE_FORMAT);
+ int i;
+ for (i = 1; i <= (int)(ival[0]); i++)
+ if (ival[i] == MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE)
+ return(MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE);
- for (i = 1; i <= ival[0]; i++)
+ for (i = 1; i <= (int)(ival[0]); i++)
if ((ival[i] == MUS_BINT) || (ival[i] == MUS_LINT) ||
(ival[i] == MUS_BFLOAT) || (ival[i] == MUS_LFLOAT) ||
(ival[i] == MUS_BSHORT) || (ival[i] == MUS_LSHORT))
return(ival[i]);
- for (i = 1; i <= ival[0]; i++)
+ for (i = 1; i <= (int)(ival[0]); i++)
if ((ival[i] == MUS_MULAW) || (ival[i] == MUS_ALAW) ||
(ival[i] == MUS_UBYTE) || (ival[i] == MUS_BYTE))
return(ival[i]);
@@ -7293,60 +5464,61 @@ int mus_audio_compatible_format(int dev) /* snd-dac and sndplay */
#if MUS_JACK
if (api == MUS_JACK_API)
- {
- return(MUS_COMP_FLOAT);
- }
+ return(MUS_COMP_FLOAT);
#endif
-
- return(MUS_AUDIO_COMPATIBLE_FORMAT);
+ return(MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE);
}
-static int look_for_format (int *mixer_vals, int format)
+static mus_sample_t look_for_sample_type (mus_sample_t *mixer_vals, mus_sample_t samp_type)
{
int i, lim;
lim = mixer_vals[0];
for (i = 1; i <= lim; i++)
- if (mixer_vals[i] == format)
- return(format);
- return(-1);
+ if (mixer_vals[i] == samp_type)
+ return(samp_type);
+ return(MUS_UNKNOWN_SAMPLE);
}
-int mus_audio_device_format(int dev) /* snd-dac snd-xrec snd-grec */
+mus_sample_t mus_audio_device_sample_type(int dev) /* snd-dac */
{
- int mixer_vals[16];
- int format;
+ mus_sample_t mixer_vals[16];
+ mus_sample_t samp_type;
+
+ /* we return the new sample type, so mixer_vals is just a local collector of possible sample types */
+ mixer_vals[0] = MUS_UNKNOWN_SAMPLE;
- /* we return the new format, so mixer_vals is just a local collector of possible formats */
- mixer_vals[0] = 0;
+#if (!WITH_AUDIO)
+ return(MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE);
+#endif
#if HAVE_OSS
if (api == MUS_OSS_API)
- oss_formats(dev, mixer_vals);
+ oss_sample_types(dev, mixer_vals);
#endif
#if HAVE_ALSA
if (api == MUS_ALSA_API)
- alsa_formats(dev, 16, mixer_vals);
+ alsa_sample_types(dev, 16, mixer_vals);
#endif
#if MUS_JACK
if (api == MUS_JACK_API)
{
- mixer_vals[0] = 1;
+ mixer_vals[0] = (mus_sample_t)1;
mixer_vals[1] = MUS_COMP_FLOAT;
}
#endif
#if HAVE_SUN
- mixer_vals[0] = 2;
+ mixer_vals[0] = (mus_sample_t)2;
mixer_vals[1] = MUS_LSHORT;
mixer_vals[2] = MUS_MULAW;
#endif
-#if MUS_MAC_OSX
- mixer_vals[0] = 1;
+#if __APPLE__
+ mixer_vals[0] = (mus_sample_t)1;
#if MUS_LITTLE_ENDIAN
mixer_vals[1] = MUS_LFLOAT;
#else
@@ -7354,39 +5526,53 @@ int mus_audio_device_format(int dev) /* snd-dac snd-xrec snd-grec */
#endif
#endif
-#if MUS_ESD
- mixer_vals[0] = 3;
- mixer_vals[1] = MUS_UBYTE;
- mixer_vals[2] = MUS_LSHORT;
- mixer_vals[3] = MUS_BSHORT;
+#if __NetBSD__ || __OpenBSD__
+ netbsd_sample_types(dev, mixer_vals);
#endif
-#if MUS_NETBSD
- netbsd_formats(dev, mixer_vals);
-#endif
-
- format = look_for_format(mixer_vals, MUS_AUDIO_COMPATIBLE_FORMAT);
- if (format != -1)
- return(format);
+ samp_type = look_for_sample_type(mixer_vals, MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE);
+ if (samp_type != MUS_UNKNOWN_SAMPLE)
+ return(samp_type);
#if MUS_LITTLE_ENDIAN
- format = look_for_format(mixer_vals, MUS_LFLOAT);
- if (format == -1)
+ samp_type = look_for_sample_type(mixer_vals, MUS_LFLOAT);
+ if (samp_type == MUS_UNKNOWN_SAMPLE)
{
- format = look_for_format(mixer_vals, MUS_LSHORT);
- if (format == -1)
- format = mixer_vals[1];
+ samp_type = look_for_sample_type(mixer_vals, MUS_LSHORT);
+ if (samp_type == MUS_UNKNOWN_SAMPLE)
+ samp_type = mixer_vals[1];
}
#else
- format = look_for_format(mixer_vals, MUS_BFLOAT);
- if (format == -1)
+ samp_type = look_for_sample_type(mixer_vals, MUS_BFLOAT);
+ if (samp_type == MUS_UNKNOWN_SAMPLE)
{
- format = look_for_format(mixer_vals, MUS_BSHORT);
- if (format == -1)
- format = mixer_vals[1];
+ samp_type = look_for_sample_type(mixer_vals, MUS_BSHORT);
+ if (samp_type == MUS_UNKNOWN_SAMPLE)
+ samp_type = mixer_vals[1];
}
#endif
- return(format);
+ return(samp_type);
}
+#else
+/* not WITH_AUDIO */
+
+int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size) {return(-1);}
+int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size) {return(-1);}
+int mus_audio_write(int line, char *buf, int bytes) {return(-1);}
+int mus_audio_close(int line) {return(-1);}
+int mus_audio_read(int line, char *buf, int bytes) {return(-1);}
+int mus_audio_initialize(void) {return(-1);}
+char *mus_audio_moniker(void) {return((char *)"no audio support");}
+
+void mus_reset_audio_c(void) {}
+
+int mus_audio_device_channels(int dev) {return(0);}
+mus_sample_t mus_audio_compatible_sample_type(int dev) {return(MUS_UNKNOWN_SAMPLE);}
+mus_sample_t mus_audio_device_sample_type(int dev) {return(MUS_UNKNOWN_SAMPLE);}
+
+#if __APPLE__
+bool mus_audio_output_properties_mutable(bool mut) {return(false);}
+#endif
+#endif
diff --git a/autosave.scm b/autosave.scm
index 0a5ce12..f8c5aeb 100644
--- a/autosave.scm
+++ b/autosave.scm
@@ -5,75 +5,75 @@
(define auto-save-interval 60.0) ;seconds between auto-save checks
(define auto-saving #f)
-(define (cancel-auto-save)
- "(cancel-auto-save) turns off the auto-save mechanism"
- (set! auto-saving #f))
-
-(define (auto-save)
- "(auto-save) starts watching files, automatically saving backup copies as edits accumulate"
-
- (define (auto-save-temp-name snd)
- (string-append (if (and (string? (temp-dir))
- (> (string-length (temp-dir)) 0))
- (string-append (temp-dir) "/")
- "")
- "#" (short-file-name snd) "#"))
-
- (define (unsaved-edits snd)
- (or (sound-property 'auto-save snd)
- 0))
+(define cancel-auto-save
+ (let ((documentation "(cancel-auto-save) turns off the auto-save mechanism"))
+ (lambda ()
+ (set! auto-saving #f))))
- (define (clear-unsaved-edits snd)
- (set! (sound-property 'auto-save snd) 0))
-
- (define (increment-unsaved-edits snd)
- (set! (sound-property 'auto-save snd) (+ 1 (sound-property 'auto-save snd))))
-
- (define (upon-edit snd)
+(define auto-save
+ (let ((documentation "(auto-save) starts watching files, automatically saving backup copies as edits accumulate"))
(lambda ()
- (increment-unsaved-edits snd)))
-
- (define (auto-save-open-func snd)
- (let ((temp-file (auto-save-temp-name snd)))
- (if (and (file-exists? temp-file)
- (< (file-write-date (file-name snd)) (file-write-date temp-file)))
- (snd-warning (format #f "auto-saved version of ~S (~S) is newer"
- (short-file-name snd)
- temp-file)))
- (do ((i 0 (+ 1 i)))
- ((= i (channels snd)))
- (if (null? (hook-functions (edit-hook snd i)))
- (hook-push (edit-hook snd i) (upon-edit snd))))
- (clear-unsaved-edits snd)))
-
- (define (auto-save-done snd)
- (let ((temp-file (auto-save-temp-name snd)))
- (if (file-exists? temp-file)
- (delete-file temp-file))
- (clear-unsaved-edits snd)))
-
- (define (auto-save-func)
- (if auto-saving
- (begin
- (for-each (lambda (snd)
- (if (> (unsaved-edits snd) 0)
- (let ((save-name (auto-save-temp-name snd)))
- (report-in-minibuffer (string-append "auto-saving as " save-name "...") snd)
- (in (* 1000 3) (lambda () (report-in-minibuffer "" snd)))
- (save-sound-as save-name snd)
- (clear-unsaved-edits snd))))
- (sounds))
- (in (* 1000 auto-save-interval) auto-save-func))))
-
- (if (not (member auto-save-done (hook-functions close-hook)))
- (begin
- (if (not (null? (sounds)))
- (for-each auto-save-open-func (sounds)))
- (hook-push after-open-hook auto-save-open-func)
- (hook-push close-hook auto-save-done)
- (hook-push save-hook (lambda (snd name) (auto-save-done snd)))
- (hook-push exit-hook (lambda () (for-each auto-save-done (sounds))))))
- (set! auto-saving #t)
- (in (* 1000 auto-save-interval) auto-save-func))
+ (define (auto-save-temp-name snd)
+ (string-append (if (and (string? *temp-dir*)
+ (> (length *temp-dir*) 0))
+ (string-append *temp-dir* "/")
+ "")
+ "#" (short-file-name snd) "#"))
+
+ (define (unsaved-edits snd)
+ (or (sound-property 'auto-save snd)
+ 0))
+
+ (define (clear-unsaved-edits snd)
+ (set! (sound-property 'auto-save snd) 0))
+
+ (define (increment-unsaved-edits snd)
+ (set! (sound-property 'auto-save snd) (+ 1 (sound-property 'auto-save snd))))
+
+ (define (upon-edit snd)
+ (lambda ()
+ (increment-unsaved-edits snd)))
+
+ (define (auto-save-open-func snd)
+ (let ((temp-file (auto-save-temp-name snd)))
+ (if (and (file-exists? temp-file)
+ (< (file-write-date (file-name snd)) (file-write-date temp-file)))
+ (snd-warning (format #f "auto-saved version of ~S (~S) is newer"
+ (short-file-name snd)
+ temp-file)))
+ (do ((i 0 (+ 1 i)))
+ ((= i (channels snd)))
+ (if (null? (hook-functions (edit-hook snd i)))
+ (hook-push (edit-hook snd i) (lambda (hook) (upon-edit (hook 'snd))))))
+ (clear-unsaved-edits snd)))
+
+ (define (auto-save-done snd)
+ (let ((temp-file (auto-save-temp-name snd)))
+ (if (file-exists? temp-file)
+ (delete-file temp-file))
+ (clear-unsaved-edits snd)))
+
+ (define (auto-save-func)
+ (if auto-saving
+ (begin
+ (for-each (lambda (snd)
+ (if (> (unsaved-edits snd) 0)
+ (let ((save-name (auto-save-temp-name snd)))
+ (status-report (string-append "auto-saving as " save-name "...") snd)
+ (in (* 1000 3) (lambda () (status-report "" snd)))
+ (save-sound-as save-name snd)
+ (clear-unsaved-edits snd))))
+ (sounds))
+ (in (* 1000 auto-save-interval) auto-save-func))))
+
+ (if (not (member auto-save-done (hook-functions close-hook)))
+ (begin
+ (for-each auto-save-open-func (sounds))
+ (hook-push after-open-hook (lambda (hook) (auto-save-open-func (hook 'snd))))
+ (hook-push close-hook (lambda (hook) (auto-save-done (hook 'snd))))
+ (hook-push save-hook (lambda (hook) (auto-save-done (hook 'snd))))
+ (hook-push exit-hook (lambda (hook) (for-each auto-save-done (sounds))))))
+ (set! auto-saving #t)
+ (in (floor (* 1000 auto-save-interval)) auto-save-func))))
(auto-save)
diff --git a/bandedwg.cms b/bandedwg.cms
new file mode 100644
index 0000000..cc2b468
--- /dev/null
+++ b/bandedwg.cms
@@ -0,0 +1,222 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;; Banded Waveguide Instrument based on
+;;; ====== =========
+;;;
+;;; Essl, G. and Cook, P. "Banded
+;;; Waveguides: Towards Physical Modelling of Bar
+;;; Percussion Instruments", Proceedings of the
+;;; 1999 International Computer Music Conference.
+;;;
+;;; Also, Essl, Serafin, Cook, and Smith J.O.,
+;;; "Theory of Banded Waveguides", CMJ, 28:1,
+;;; pp37-50, Spring 2004.
+;;;
+;;; NOTES:
+;;; As with all physical models, initial conditions matter.
+;;; Frequency range is not too broad. 220Hz. is a good
+;;; starting point.
+;;;
+;;;
+;;; Tuned bar, Glass Harmonica and Uniform Bar for now.
+;;;
+;;; 08/22/2013 update bandpass filters with CLM's filter generator (juanig)
+;;; 08/24/2013 replaced delay line macros with DelayL using clm's delay ug
+;;; 08/29/2014 fixed waveguide with feed and reflections
+;;; 08/30/2014 Try different delay line lengths. Fixing bandpass radius param.
+;;; 09/04/2014 This SND's S7 version
+;;;
+
+
+(define* (make-bowtable (offset 0.0) (slope 1.0))
+ (float-vector offset slope))
+
+(define (bowtable b samp)
+ (max 0.0 (- 1.0 (abs (* (b 1) (+ samp (b 0)))))))
+
+
+(define (make-bandpassbq freq radius)
+ (let ((arra (make-float-vector 3))
+ (arrb (make-float-vector 3)))
+ (set! (arra 1) (* -1.998 radius (cos (hz->radians freq))))
+ (set! (arra 2) (* radius radius))
+ ;;;
+ ;;; gain gets normalized
+ ;;;
+ (set! (arrb 0) (- 0.5 (* 0.5 (arra 2))))
+ (set! (arrb 2) (- (arrb 0) ))
+ (make-filter 3 arra arrb) ))
+
+
+
+;;; To handle bandpass filter
+
+(define (bandpassbq f sample0)
+ (filter f sample0))
+
+;;; Delay line structures and functions using SND's delay generator (as per prc95.scm)
+
+(defgenerator dlya (outp 0) (input #f))
+
+(define (make-delayl len lag)
+ (make-dlya :input (make-delay len :max-size (ceiling (+ len lag 1)))
+ :outp (- lag len)))
+
+(define (delayl d samp)
+ (delay-tick (d 'input) samp)
+ (tap (d 'input) (d 'outp)))
+
+
+;;;;;;;;;;;;;;;;;;;;
+
+(definstrument (bandedwg beg dur freq amplitude
+ ;; vibration modes
+ ;; 1=tuned Bar; 2=Glass Harmonica;
+ ;; 3= Uniform bar
+ (mode 3)
+ (maxa 0.9998) ;; max bow velocity
+ (bv 1.0) ;; bow velocity scaler
+ ;; velocity envelope
+ (vel-env '(0 1.0 .95 1.1 1 1.0))
+ (amp-env '(0 1 1 1)) ;;'(0 0.0 .95 1.0 .99 0.00))
+ (rev-amount .08) )
+ (let ((nrmodes 4))
+ (cond ((= mode 1)
+ (set! nrmodes 4))
+ ((= mode 2)
+ (set! nrmodes 6))
+ (else
+ (set! nrmodes 4))
+ )
+ (let* ((start (seconds->samples beg))
+ (baselen (/ *clm-srate* freq)) ;; original Stk delayl length
+ (baselag (- (/ *clm-srate* freq) 0.5))
+ (dtapoffs 0.0) ;; tap offset is 0.0 in StK's version
+ (bandpass (make-vector nrmodes))
+ (delayslft (make-vector nrmodes))
+ (delaysrfl (make-vector nrmodes))
+ (modes (make-float-vector nrmodes))
+ (gains (make-float-vector nrmodes))
+ (basegains (make-float-vector nrmodes))
+ (excitations (make-float-vector nrmodes))
+ (delastout (make-float-vector nrmodes))
+ ;;
+ (fradius 0.0) ;; radius for bandpass filter
+ (dlength 0.0) ;; delay-line length
+ (dlag 0.0) ;; delay lag (for tap)
+ ;;
+ (bowtab (make-bowtable :slope 3.0 :offset 0.001))
+ (ampenv (make-env amp-env :scaler amplitude :duration dur))
+ ;; (vel-env (make-env vel-env :scaler bv :duration dur))
+ ;;
+ (maxvelocity maxa)
+ (end (+ start (seconds->samples dur)))
+ )
+ ;;
+ ;;
+ (cond ((= mode 1) ;; Tuned Bar
+ (begin
+ (set! (modes 0) 1.000)
+ (set! (modes 1) 4.0198391420)
+ (set! (modes 2) 10.7184986595)
+ (set! (modes 3) 18.0697050938)
+ (do ((i 0 (+ i 1)))
+ ((= i nrmodes))
+ (set! (basegains i) (expt 0.998 (+ i 1)))
+ (set! (excitations i) 1.0) )
+ ))
+ ((= mode 2) ;; Glass Harmonica
+ (begin
+ (set! (modes 0) 1.000)
+ (set! (modes 1) 2.32)
+ (set! (modes 2) 4.25)
+ (set! (modes 3) 6.63)
+ (set! (modes 4) 9.38)
+ (set! (modes 5) 12.22)
+ (do ((i 0 (+ i 1)))
+ ((= i nrmodes))
+ (set! (basegains i ) (expt 0.988 (+ i 1)))
+ (set! (excitations i) 1.0))
+ ))
+ (else ;; Uniform Bar
+ (begin
+ (set! (modes 0) 1.000)
+ (set! (modes 1) 2.756)
+ (set! (modes 2) 5.404)
+ (set! (modes 3) 8.933)
+ (do ((i 0 (+ i 1)))
+ ((= i nrmodes))
+ (set! (basegains i ) (expt 0.9 (+ i 1)))
+ (set! (excitations i) 1.0))
+ ))
+ )
+
+ ;;
+ ;; set-frequency method in STK's BandedWG
+ ;;
+
+ ;; (set! fradius (- 1.0 (* pi (/ 32 *clm-srate*))))
+ (set! fradius (- 0.3998 (* pi (/ 32 *clm-srate*))))
+
+ (do ((i 0 (+ i 1)))
+ ((= i nrmodes))
+ (set! dlength (floor (/ baselen (modes i))))
+ (set! dlag (floor (/ baselag (modes i)))) ;; (- lag len) --> tap offset
+ (set! (delayslft i) (make-delayl dlength dlag))
+ (set! (delaysrfl i) (make-delayl dlength dlag))
+
+ (set! (gains i) (basegains i))
+ (set! (bandpass i)
+ (make-bandpassbq (* freq (modes i)) fradius)) )
+
+ ;;
+;;;;;;;;;;;;
+ ;;
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+ ;;
+ (let ((input 0.0)
+ (velinput 0.0)
+ (bowvelocity 0.0)
+ (bplastout 0.0)
+ (dlastsampl 0.0)
+ (outsampl 0.0)
+ )
+
+ (do ((k 0 (+ k 1)))
+ ((= k nrmodes))
+ (set! velinput (+ velinput (* (basegains k) (delastout k))) )
+ )
+ ;;
+ ;; (set! bowvelocity (* 0.3 (env vel-env) maxvelocity))
+ (set! bowvelocity (* 0.3 maxvelocity))
+ (set! input (- bowvelocity velinput))
+ (set! input (* input (bowtable bowtab input)))
+ (set! input (/ input nrmodes ))
+ ;;
+ ;; Here the waveguide
+ ;;
+ (do ((j 0 (+ j 1)))
+ ((= j nrmodes))
+ (set! bplastout (+ bplastout (bandpassbq (bandpass j)
+ (delayl (delayslft j)
+ (+ input (* (gains j) dlastsampl)) ))))
+ (set! dlastsampl (+ dlastsampl (delayl (delaysrfl j) bplastout)))
+ (set! (delastout j) dlastsampl)
+ )
+ ;;
+ ;;
+ (set! outsampl (* 4.0 (env ampenv) bplastout))
+ (outa i outsampl)
+ ;;
+ (if *reverb*
+ (begin
+ (outa i (* outsampl rev-amount) *reverb*)))
+ )))
+ ))
+
+;;; (with-sound () (bandedwg 0 1 220 0.4))
+;;; (with-sound () (bandedwg 0 1 220 0.4 :mode 1))
+;;; (with-sound () (bandedwg 0 1 220 0.4 :mode 2))
+;;; (with-sound () (bandedwg 0 1.0 220 0.7 :mode 1 :maxa 0.497))
diff --git a/bess.scm b/bess.scm
index e68789f..eb3e9b2 100644
--- a/bess.scm
+++ b/bess.scm
@@ -1,261 +1,252 @@
-;;; set up our user-interface
-(let* ((shell-app #f)
- (app (car (main-widgets)))
-
- (shell (let* ((xdismiss (XmStringCreate "Go away" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "FM Forever!" XmFONTLIST_DEFAULT_TAG))
- (dialog (XmCreateTemplateDialog (cadr (main-widgets)) "FM Forever!"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNtransient #f))))
- (XtAddCallback dialog
- XmNhelpCallback (lambda (w context info)
- (snd-print "This dialog lets you experiment with simple FM")))
- (XmStringFree xhelp)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- dialog))
-
- (dpy (XtDisplay shell))
- (screen (DefaultScreenOfDisplay dpy))
- (cmap (DefaultColormap dpy (DefaultScreen dpy)))
- (black (BlackPixelOfScreen screen))
- (white (WhitePixelOfScreen screen)))
-
- (define (get-color color)
- (let ((col (XColor)))
- (if (= (XAllocNamedColor dpy cmap color col col) 0)
- (error (format #f "can't allocate ~A" color))
- (.pixel col))))
-
- (define (set-flabel label value)
- (let ((s1 (XmStringCreate (format #f "~,3F" value) XmFONTLIST_DEFAULT_TAG)))
- (XtVaSetValues label (list XmNlabelString s1))
- (XmStringFree s1)))
-
- (define (set-ilabel label value)
- (let ((s1 (XmStringCreate (format #f "~D" value) XmFONTLIST_DEFAULT_TAG)))
- (XtVaSetValues label (list XmNlabelString s1))
- (XmStringFree s1)))
-
- (let* ((light-blue (position-color))
- (form (XtCreateManagedWidget "form" xmFormWidgetClass shell
- (list XmNbackground white
- XmNforeground black
- XmNresizePolicy XmRESIZE_GROW)))
- ;; toggle named "play"
- (play-button (XtCreateManagedWidget "play" xmToggleButtonWidgetClass form
- (list XmNleftAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_NONE
- XmNbackground white)))
- ;; carrier freq
- (carrier (XtCreateManagedWidget "carrier freq:" xmLabelWidgetClass form
- (list XmNleftAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget play-button
- XmNrightAttachment XmATTACH_NONE
- XmNrecomputeSize #f
- XmNbackground white)))
- (freq-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget carrier
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget carrier
- XmNrightAttachment XmATTACH_NONE
- XmNbackground white)))
- (freq-scale (XtCreateManagedWidget "carrier freq" xmScaleWidgetClass form
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget freq-label
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget freq-label
- XmNrightAttachment XmATTACH_FORM
- XmNshowValue #f
- XmNorientation XmHORIZONTAL
- XmNbackground light-blue)))
- ;; amp
- (amp (XtCreateManagedWidget "amp:" xmLabelWidgetClass form
- (list XmNleftAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget carrier
- XmNrightAttachment XmATTACH_NONE
- XmNrecomputeSize #f
- XmNbackground white)))
- (amp-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget amp
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget amp
- XmNrightAttachment XmATTACH_NONE
- XmNbackground white)))
- (amp-scale (XtCreateManagedWidget "amp" xmScaleWidgetClass form
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget amp-label
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget amp-label
- XmNrightAttachment XmATTACH_FORM
- XmNshowValue #f
- XmNorientation XmHORIZONTAL
- XmNbackground light-blue)))
- ;; fm index
- (fm-index (XtCreateManagedWidget "fm index:" xmLabelWidgetClass form
- (list XmNleftAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget amp-scale
- XmNrightAttachment XmATTACH_NONE
- XmNrecomputeSize #f
- XmNbackground white)))
- (fm-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget fm-index
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget fm-index
- XmNrightAttachment XmATTACH_NONE
- XmNbackground white)))
- (fm-scale (XtCreateManagedWidget "fm index" xmScaleWidgetClass form
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget fm-label
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget fm-label
- XmNrightAttachment XmATTACH_FORM
- XmNshowValue #f
- XmNorientation XmHORIZONTAL
- XmNbackground light-blue)))
- ;; c/m ratio
- (cm-ratio (XtCreateManagedWidget "c/m ratio:" xmLabelWidgetClass form
- (list XmNleftAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget fm-scale
- XmNrightAttachment XmATTACH_NONE
- XmNrecomputeSize #f
- XmNbackground white)))
- (cm-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget cm-ratio
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget cm-ratio
- XmNrightAttachment XmATTACH_NONE
- XmNbackground white)))
- (cm-scale (XtCreateManagedWidget "cm ratio" xmScaleWidgetClass form
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget cm-label
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget cm-label
- XmNrightAttachment XmATTACH_FORM
- XmNshowValue #f
- XmNorientation XmHORIZONTAL
- XmNbackground light-blue)))
- (frequency 220.0)
- (low-frequency 40.0)
- (high-frequency 2000.0)
- (amplitude 0.5)
- (index 1.0)
- (high-index 3.0)
- (ratio 1)
- (high-ratio 10)
- (playing 0.0)
- (carosc (make-oscil 0.0))
- (modosc (make-oscil 0.0)))
-
- (define (freq-callback w c i)
- (set! frequency (+ low-frequency (* (.value i) (/ (- high-frequency low-frequency) 100.0))))
- (set-flabel freq-label frequency))
-
- (define (amp-callback w c i)
- (set! amplitude (/ (.value i) 100.0))
- (set-flabel amp-label amplitude))
-
- (define (fm-callback w c i)
- (set! index (* (.value i) (/ high-index 100.0)))
- (set-flabel fm-label index))
-
- (define (ratio-callback w c i)
- (set! ratio (floor (* (.value i) (/ high-ratio 100.0))))
- (set-ilabel cm-label ratio))
-
- ;; add scale-change (drag and value-changed) callbacks
- (XtAddCallback freq-scale XmNdragCallback freq-callback)
- (XtAddCallback freq-scale XmNvalueChangedCallback freq-callback)
-
- (XtAddCallback amp-scale XmNdragCallback amp-callback)
- (XtAddCallback amp-scale XmNvalueChangedCallback amp-callback)
-
- (XtAddCallback fm-scale XmNdragCallback fm-callback)
- (XtAddCallback fm-scale XmNvalueChangedCallback fm-callback)
-
- (XtAddCallback cm-scale XmNdragCallback ratio-callback)
- (XtAddCallback cm-scale XmNvalueChangedCallback ratio-callback)
-
- (XtAddCallback play-button XmNvalueChangedCallback (lambda (w c i) (set! playing (if (.set i) 1.0 0.0))))
-
- ;; set initial values
- (set-flabel freq-label frequency)
- (set-flabel amp-label amplitude)
- (set-flabel fm-label index)
- (set-ilabel cm-label ratio)
-
- (XmScaleSetValue freq-scale (floor (* 100 (/ (- frequency low-frequency) (- high-frequency low-frequency)))))
- (XmScaleSetValue amp-scale (floor (* 100 amplitude)))
- (XmScaleSetValue fm-scale (floor (* 100 (/ index high-index))))
- (XmScaleSetValue cm-scale (floor (* ratio (/ 100 high-ratio))))
-
- (XtManageChild shell)
- (XtRealizeWidget shell)
-
- ;; send fm data to dac
- (mus-oss-set-buffers 4 12) ; a no-op except in OSS/Linux
- (let* ((bufsize 256)
- (srate 22050)
- (chans 1)
- (data (make-sound-data chans bufsize))
- (proc #f)
- (port (mus-audio-open-output mus-audio-default srate chans mus-lshort (* bufsize 2))))
- (if (< port 0)
- (display (format #f "can't open DAC!")))
-
- (XmAddWMProtocolCallback shell
- (XmInternAtom dpy "WM_DELETE_WINDOW" #f)
- (lambda (w c i)
- (XtRemoveWorkProc proc) ; odd that there's no XtAppRemoveWorkProc
- (mus-audio-close port))
- #f)
- (XtAddCallback shell
- XmNcancelCallback (lambda (w context info)
- (XtRemoveWorkProc proc)
- (mus-audio-close port)
- (XtUnmanageChild shell)))
- (set! proc (XtAppAddWorkProc
- app
- (lambda (ignored-arg)
- (do ((i 0 (+ 1 i)))
- ((= i bufsize))
- (sound-data-set!
- data 0 i
- (* amplitude playing
- (oscil carosc
- (+ (hz->radians frequency)
- (* index
- (oscil modosc
- (hz->radians (* ratio frequency)))))))))
- (mus-audio-write port data bufsize)
- #f))))
- ))
-
+;;; this is obsolete -- it needs some replacement for the mus-audio* functions
+
+(if (provided? 'snd-motif)
+ (with-let (sublet *motif*)
+ ;; set up our user-interface
+ (let* ((app (car (main-widgets)))
+
+ (shell (let* ((xdismiss (XmStringCreate "Go away" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "FM Forever!" XmFONTLIST_DEFAULT_TAG))
+ (dialog (XmCreateTemplateDialog (cadr (main-widgets)) "FM Forever!"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNtransient #f))))
+ (XtAddCallback dialog
+ XmNhelpCallback (lambda (w context info)
+ (snd-print "This dialog lets you experiment with simple FM")))
+ (XmStringFree xhelp)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+ dialog))
+
+ (dpy (XtDisplay shell))
+ (screen (DefaultScreenOfDisplay dpy))
+ ;; (cmap (DefaultColormap dpy (DefaultScreen dpy)))
+ (black (BlackPixelOfScreen screen))
+ (white (WhitePixelOfScreen screen)))
+
+ (define (set-flabel label value)
+ (let ((s1 (XmStringCreate (format #f "~,3F" value) XmFONTLIST_DEFAULT_TAG)))
+ (XtVaSetValues label (list XmNlabelString s1))
+ (XmStringFree s1)))
+
+ (define (set-ilabel label value)
+ (let ((s1 (XmStringCreate (format #f "~D" value) XmFONTLIST_DEFAULT_TAG)))
+ (XtVaSetValues label (list XmNlabelString s1))
+ (XmStringFree s1)))
+
+ (let* ((light-blue *position-color*)
+ (form (XtCreateManagedWidget "form" xmFormWidgetClass shell
+ (list XmNbackground white
+ XmNforeground black
+ XmNresizePolicy XmRESIZE_GROW)))
+ ;; toggle named "play"
+ (play-button (XtCreateManagedWidget "play" xmToggleButtonWidgetClass form
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_NONE
+ XmNbackground white)))
+ ;; carrier freq
+ (carrier (XtCreateManagedWidget "carrier freq:" xmLabelWidgetClass form
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget play-button
+ XmNrightAttachment XmATTACH_NONE
+ XmNrecomputeSize #f
+ XmNbackground white)))
+ (freq-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget carrier
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget carrier
+ XmNrightAttachment XmATTACH_NONE
+ XmNbackground white)))
+ (freq-scale (XtCreateManagedWidget "carrier freq" xmScaleWidgetClass form
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget freq-label
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget freq-label
+ XmNrightAttachment XmATTACH_FORM
+ XmNshowValue #f
+ XmNorientation XmHORIZONTAL
+ XmNbackground light-blue)))
+ ;; amp
+ (amp (XtCreateManagedWidget "amp:" xmLabelWidgetClass form
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget carrier
+ XmNrightAttachment XmATTACH_NONE
+ XmNrecomputeSize #f
+ XmNbackground white)))
+ (amp-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget amp
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget amp
+ XmNrightAttachment XmATTACH_NONE
+ XmNbackground white)))
+ (amp-scale (XtCreateManagedWidget "amp" xmScaleWidgetClass form
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget amp-label
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget amp-label
+ XmNrightAttachment XmATTACH_FORM
+ XmNshowValue #f
+ XmNorientation XmHORIZONTAL
+ XmNbackground light-blue)))
+ ;; fm index
+ (fm-index (XtCreateManagedWidget "fm index:" xmLabelWidgetClass form
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget amp-scale
+ XmNrightAttachment XmATTACH_NONE
+ XmNrecomputeSize #f
+ XmNbackground white)))
+ (fm-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget fm-index
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget fm-index
+ XmNrightAttachment XmATTACH_NONE
+ XmNbackground white)))
+ (fm-scale (XtCreateManagedWidget "fm index" xmScaleWidgetClass form
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget fm-label
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget fm-label
+ XmNrightAttachment XmATTACH_FORM
+ XmNshowValue #f
+ XmNorientation XmHORIZONTAL
+ XmNbackground light-blue)))
+ ;; c/m ratio
+ (cm-ratio (XtCreateManagedWidget "c/m ratio:" xmLabelWidgetClass form
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget fm-scale
+ XmNrightAttachment XmATTACH_NONE
+ XmNrecomputeSize #f
+ XmNbackground white)))
+ (cm-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget cm-ratio
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget cm-ratio
+ XmNrightAttachment XmATTACH_NONE
+ XmNbackground white)))
+ (cm-scale (XtCreateManagedWidget "cm ratio" xmScaleWidgetClass form
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget cm-label
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget cm-label
+ XmNrightAttachment XmATTACH_FORM
+ XmNshowValue #f
+ XmNorientation XmHORIZONTAL
+ XmNbackground light-blue)))
+ (frequency 220.0)
+ (low-frequency 40.0)
+ (high-frequency 2000.0)
+ (amplitude 0.5)
+ (index 1.0)
+ (high-index 3.0)
+ (ratio 1)
+ (high-ratio 10)
+ (playing 0.0)
+ (carosc (make-oscil 0.0))
+ (modosc (make-oscil 0.0)))
+
+ (define (freq-callback w c i)
+ (set! frequency (+ low-frequency (* (.value i) (/ (- high-frequency low-frequency) 100.0))))
+ (set-flabel freq-label frequency))
+
+ (define (amp-callback w c i)
+ (set! amplitude (/ (.value i) 100.0))
+ (set-flabel amp-label amplitude))
+
+ (define (fm-callback w c i)
+ (set! index (* (.value i) (/ high-index 100.0)))
+ (set-flabel fm-label index))
+
+ (define (ratio-callback w c i)
+ (set! ratio (floor (* (.value i) (/ high-ratio 100.0))))
+ (set-ilabel cm-label ratio))
+
+ ;; add scale-change (drag and value-changed) callbacks
+ (XtAddCallback freq-scale XmNdragCallback freq-callback)
+ (XtAddCallback freq-scale XmNvalueChangedCallback freq-callback)
+
+ (XtAddCallback amp-scale XmNdragCallback amp-callback)
+ (XtAddCallback amp-scale XmNvalueChangedCallback amp-callback)
+
+ (XtAddCallback fm-scale XmNdragCallback fm-callback)
+ (XtAddCallback fm-scale XmNvalueChangedCallback fm-callback)
+
+ (XtAddCallback cm-scale XmNdragCallback ratio-callback)
+ (XtAddCallback cm-scale XmNvalueChangedCallback ratio-callback)
+
+ (XtAddCallback play-button XmNvalueChangedCallback (lambda (w c i) (set! playing (if (.set i) 1.0 0.0))))
+
+ ;; set initial values
+ (set-flabel freq-label frequency)
+ (set-flabel amp-label amplitude)
+ (set-flabel fm-label index)
+ (set-ilabel cm-label ratio)
+
+ (XmScaleSetValue freq-scale (floor (* 100 (/ (- frequency low-frequency) (- high-frequency low-frequency)))))
+ (XmScaleSetValue amp-scale (floor (* 100 amplitude)))
+ (XmScaleSetValue fm-scale (floor (* 100 (/ index high-index))))
+ (XmScaleSetValue cm-scale (floor (* ratio (/ 100 high-ratio))))
+
+ (XtManageChild shell)
+ (XtRealizeWidget shell)
+
+ ;; send fm data to dac
+ (let* ((bufsize 256)
+ (srate 22050)
+ (work-proc #f)
+ ;(data (make-float-vector bufsize 0.0))
+ (port (mus-audio-open-output mus-audio-default srate 1 mus-lshort (* bufsize 2))))
+ (if (< port 0)
+ (format #t "can't open DAC!"))
+
+ (XmAddWMProtocolCallback (cadr (main-widgets)) ; shell
+ (XmInternAtom dpy "WM_DELETE_WINDOW" #f)
+ (lambda (w c i)
+ (XtRemoveWorkProc work-proc) ; odd that there's no XtAppRemoveWorkProc
+ (mus-audio-close port))
+ #f)
+ (XtAddCallback shell
+ XmNcancelCallback (lambda (w context info)
+ (XtRemoveWorkProc work-proc)
+ (mus-audio-close port)
+ (XtUnmanageChild shell)))
+ (set! work-proc (XtAppAddWorkProc app
+ (lambda (ignored-arg)
+ (let ((data (make-float-vector bufsize 0.0)))
+ (do ((i 0 (+ 1 i)))
+ ((= i bufsize))
+ (float-vector-set! data i (* amplitude playing
+ (oscil carosc
+ (+ (hz->radians frequency)
+ (* index
+ (oscil modosc
+ (hz->radians (* ratio frequency)))))))))
+ (mus-audio-write port data bufsize)
+ #f)))))))))
\ No newline at end of file
diff --git a/bess1.rb b/bess1.rb
index e01acca..5e0f819 100644
--- a/bess1.rb
+++ b/bess1.rb
@@ -33,7 +33,7 @@
#
# Bess.new.start(:srate, $clm_srate # 22050
# :bufsize, $clm_rt_bufsize # 128
-# :data_format, $clm_data_format # Mus_lshort
+# :sample_type, $clm_sample_type # Mus_lshort
# :which, :agn # :agn or :vct_test
# :play, false)
@@ -61,7 +61,7 @@ end
rbm_require "sndlib"
$output = nil # holds fd from mus_audio_open_output()
$clm_srate = 22050
-$clm_data_format = Mus_lshort
+$clm_sample_type = Mus_lshort
$clm_rt_bufsize = 128
module Bess_utils
@@ -185,10 +185,10 @@ class Agn
def make_vct_test(*args)
srate = get_args(args, :srate, $clm_srate)
bufsize = get_args(args, :bufsize, $clm_rt_bufsize)
- data_format = get_args(args, :data_format, $clm_data_format)
+ sample_type = get_args(args, :sample_type, $clm_sample_type)
$clm_srate = set_mus_srate(srate).to_i
$clm_rt_bufsize = bufsize
- $output = mus_audio_open_output(Mus_audio_default, srate, 1, data_format, bufsize * 2)
+ $output = mus_audio_open_output(Mus_audio_default, srate, 1, sample_type, bufsize * 2)
mode = [0, 12, 2, 4, 14, 4, 5, 5, 0, 7, 7, 11, 11]
pits = Array.new(@lim + 1) do rbm_random(12.0).floor end
begs = Array.new(@lim + 1) do 1 + rbm_random(3.0).floor end
@@ -228,10 +228,10 @@ class Agn
def make_agn(*args)
srate = get_args(args, :srate, $clm_srate)
bufsize = get_args(args, :bufsize, $clm_rt_bufsize)
- data_format = get_args(args, :data_format, $clm_data_format)
+ sample_type = get_args(args, :sample_type, $clm_sample_type)
$clm_srate = set_mus_srate(srate).to_i
$clm_rt_bufsize = bufsize
- $output = mus_audio_open_output(Mus_audio_default, srate, 1, data_format, bufsize * 2)
+ $output = mus_audio_open_output(Mus_audio_default, srate, 1, sample_type, bufsize * 2)
die("can't open DAC (%s)", $output.inspect) if $output < 0
wins = [[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
[0, 0, 60, 0.1, 80, 0.2, 90, 0.4, 95, 1, 100, 0],
@@ -518,7 +518,7 @@ end
begin
# Bess.new.start(:srate, $clm_srate,
# :bufsize, $clm_rt_bufsize,
- # :data_format, $clm_data_format,
+ # :sample_type, $clm_sample_type,
# :which, :agn,
# :play, false)
Bess.new.start
diff --git a/bess1.scm b/bess1.scm
index c4cf91c..4dacc2c 100644
--- a/bess1.scm
+++ b/bess1.scm
@@ -5,16 +5,10 @@
;; Last: Sun Jun 15 03:50:21 CEST 2003
;; changed slightly 14-Jun-06 Bill to match bess.scm, fix pitch problem in make-oscil.
;; then again 18-Dec-09 to use s7 rather than Guile
+;; changed float-vector-map! to use a loop instead (Bill 4-July-12)
(if (not (provided? 'snd-motif)) (error "bess1.scm needs motif"))
-(if (not (provided? 'xm))
- (let ((hxm (dlopen "xm.so")))
- (if (string? hxm)
- (error "bess1.scm needs the xm module (either 'make xm' or build Snd with --with-static-xm): ~A" hxm)
- (dlinit hxm "Init_libxm"))))
-
-
;;; Commentary:
;; This file provides simple mono real time output to DAC. Tempo,
@@ -27,12 +21,15 @@
;;
;; (rt-motif :srate *clm-srate* ;; 22050
;; :bufsize *clm-rt-bufsize* ;; 128
-;; :data-format *clm-data-format*) ;; mus-lshort
+;; :sample-type *clm-sample-type*) ;; mus-lshort
;;; Code:
-(define *clm-srate* 22050)
-(define *clm-data-format* mus-lfloat)
+(with-let *motif*
+
+(set! *clm-srate* 22050)
+
+(define *clm-sample-type* mus-lfloat)
(define *clm-rt-bufsize* 1024)
(define *output* #f) ;holds fd from (mus-audio-open-output)
@@ -45,53 +42,54 @@
(define sliderback "lightsteelblue")
(define background "lightsteelblue1")
-;(define (seconds->samples secs) (round (* secs (mus-srate))))
+;(define (seconds->samples secs) (round (* secs *clm-srate*)))
;; called by XtAppAddWorkProc
(define (rt-send->dac func)
(if cplay
- (begin
- (mus-audio-write *output* (vct->sound-data (vct-map! (make-vct *clm-rt-bufsize*) (func))
- (make-sound-data 1 *clm-rt-bufsize*) 0)
- *clm-rt-bufsize*)
+ (let ((data (make-float-vector *clm-rt-bufsize*)))
+ (do ((i 0 (+ i 1)))
+ ((= i *clm-rt-bufsize*))
+ (set! (data i) (func)))
+ (mus-audio-write *output* (copy data (make-float-vector (list 1 *clm-rt-bufsize*) 0.0)) *clm-rt-bufsize*)
#f)
(begin
(mus-audio-close *output*)
#t)))
-(define* (make-rt-violin dur freq amp :key
- (fm-index 1.0)
- (amp-env '(0 0 25 1 75 1 100 0)))
- "(make-rt-violin dur freq amp (fm-index 1.0) (amp-env '(0 0 25 1 75 1
-100 0))) real time simple violin (see snd-12/fm.html)"
- (let* ((frq-scl (hz->radians freq))
- (maxdev (* frq-scl fm-index))
- (index1 (* maxdev (/ 5.0 (log freq))))
- (index2 (* maxdev 3.0 (/ (- 8.5 (log freq)) (+ 3.0 (/ freq 1000)))))
- (index3 (* maxdev (/ 4.0 (sqrt freq))))
- (carrier (make-oscil :frequency freq))
- (fmosc1 (make-oscil :frequency freq))
- (fmosc2 (make-oscil :frequency (* 3 freq)))
- (fmosc3 (make-oscil :frequency (* 4 freq)))
- (ampf (make-env :envelope amp-env :scaler amp :duration dur))
- (indf1 (make-env :envelope '(0 1 25 0.4 75 0.6 100 0) :scaler index1 :duration dur))
- (indf2 (make-env :envelope '(0 1 25 0.4 75 0.6 100 0) :scaler index2 :duration dur))
- (indf3 (make-env :envelope '(0 1 25 0.4 75 0.6 100 0) :scaler index3 :duration dur))
- (pervib (make-triangle-wave :frequency 5 :amplitude (* 0.0025 frq-scl)))
- (ranvib (make-rand-interp :frequency 16 :amplitude (* 0.005 frq-scl))))
- (lambda ()
- (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
- (* (env ampf)
- (oscil carrier
- (+ vib
- (* (env indf1) (oscil fmosc1 vib))
- (* (env indf2) (oscil fmosc2 (* 3.0 vib)))
- (* (env indf3) (oscil fmosc3 (* 4.0 vib))))))))))
+(define make-rt-violin
+ (let ((documentation "(make-rt-violin dur freq amp (fm-index 1.0) (amp-env '(0 0 25 1 75 1 100 0))) real time simple violin (see fm.html)"))
+ (lambda* (dur freq amp (fm-index 1.0) (amp-env '(0 0 25 1 75 1 100 0)))
+ (let* ((frq-scl (hz->radians freq))
+ (maxdev (* frq-scl fm-index))
+ (index1 (* maxdev (/ 5.0 (log freq))))
+ (index2 (* maxdev 3.0 (/ (- 8.5 (log freq)) (+ 3.0 (/ freq 1000)))))
+ (index3 (* maxdev (/ 4.0 (sqrt freq))))
+ (carrier (make-oscil :frequency freq))
+ (fmosc1 (make-oscil :frequency freq))
+ (fmosc2 (make-oscil :frequency (* 3 freq)))
+ (fmosc3 (make-oscil :frequency (* 4 freq)))
+ (ampf (make-env :envelope amp-env :scaler amp :duration dur))
+ (indf1 (make-env :envelope '(0 1 25 0.4 75 0.6 100 0) :scaler index1 :duration dur))
+ (indf2 (make-env :envelope '(0 1 25 0.4 75 0.6 100 0) :scaler index2 :duration dur))
+ (indf3 (make-env :envelope '(0 1 25 0.4 75 0.6 100 0) :scaler index3 :duration dur))
+ (pervib (make-triangle-wave :frequency 5 :amplitude (* 0.0025 frq-scl)))
+ (ranvib (make-rand-interp :frequency 16 :amplitude (* 0.005 frq-scl))))
+ (lambda ()
+ (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
+ (* (env ampf)
+ (oscil carrier
+ (+ vib
+ (* (env indf1) (oscil fmosc1 vib))
+ (* (env indf2) (oscil fmosc2 (* 3.0 vib)))
+ (* (env indf3) (oscil fmosc3 (* 4.0 vib))))))))))))
+
+(define lim 256)
;; from clm-2/rt.lisp
-(define* (make-vct-test (srate *clm-srate*)
+(define* (make-float-vector-test (srate *clm-srate*)
(bufsize *clm-rt-bufsize*)
- (data-format *clm-data-format*))
+ (sample-type *clm-sample-type*))
(let ((vmode (vector 0 12 2 4 14 4 5 5 0 7 7 11 11))
(vpits (make-vector (+ 1 lim) 0))
(vbegs (make-vector (+ 1 lim) 0))
@@ -107,14 +105,13 @@
(set! (vbegs i) (+ 1 (floor (random 3.0)))))
(set! *clm-srate* srate)
(set! *clm-rt-bufsize* bufsize)
- (set! (mus-srate) srate)
- (set! *output* (mus-audio-open-output mus-audio-default srate 1 data-format (* bufsize 2)))
+ (set! *output* (mus-audio-open-output mus-audio-default srate 1 sample-type (* bufsize 2)))
(lambda ()
(if (> len 1)
(set! len (- len 1))
(begin
- (set! dur (* ctempo (vbegs (+ 1 cellctr))))
- (set! cellctr (+ 1 cellctr))
+ (set! dur (* ctempo (vbegs (+ cellctr 1))))
+ (set! cellctr (+ cellctr 1))
(if (> cellctr (+ cellsiz cellbeg))
(begin
(if (> (random 1.0) 0.5) (set! cellbeg (+ 1 cellbeg)))
@@ -143,7 +140,6 @@
func)))
;; from clm-2/bess5.cl and clm-2/clm-example.lisp
-(define lim 256)
(define time 60)
(define mode (vector 0 0 2 4 11 11 5 6 7 9 2 0 0))
(define rats (vector 1.0 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2.0))
@@ -167,7 +163,7 @@
(define* (make-agn (srate *clm-srate*)
(bufsize *clm-rt-bufsize*)
- (data-format *clm-data-format*))
+ (sample-type *clm-sample-type*))
(let ((wins (vector '(0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0)
'(0 0 60 0.1 80 0.2 90 0.4 95 1 100 0)
'(0 0 10 1 16 0 32 0.1 50 1 56 0 60 0 90 0.3 100 0)
@@ -190,7 +186,7 @@
(whichway 1)
(func #f)
(len 0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i lim))
(set! (octs i) (floor (+ 4 (* 2 (rbell (random 1.0))))))
(set! (pits i) (mode (floor (random 12.0))))
@@ -198,11 +194,10 @@
(set! (begs i) (if (< (random 1.0) 0.9)
(floor (+ 4 (random 2.0)))
(floor (random 24.0))))
- (set! (amps i) (floor (+ 1 (* 8 (rbell (random 1.0)))))) i)
+ (set! (amps i) (floor (+ 1 (* 8 (rbell (random 1.0)))))))
(set! *clm-srate* srate)
(set! *clm-rt-bufsize* bufsize)
- (set! (mus-srate) srate)
- (set! *output* (mus-audio-open-output mus-audio-default srate 1 data-format (* bufsize 2)))
+ (set! *output* (mus-audio-open-output mus-audio-default srate 1 sample-type (* bufsize 2)))
(lambda ()
(if (> len 1)
(set! len (- len 1))
@@ -213,7 +208,7 @@
(set! freq (* cfreq 16.351 (tune (pits cellctr)) (expt 2 (octs cellctr))))
(set! ampl (* camp 10 (max 0.003 (* (amps cellctr) 0.01))))
(set! ind (* cindex (random 3.0)))
- (set! cellctr (+ 1 cellctr))
+ (set! cellctr (+ cellctr 1))
(if (> cellctr (+ cellsiz cellbeg))
(begin
(set! cellbeg (+ 1 cellbeg))
@@ -232,6 +227,7 @@
(set! len (ceiling (/ (seconds->samples dur) bufsize)))))
func)))
+#|
;; from env.scm
(define* (envelope-interp :rest args)
(let ((x (car args))
@@ -257,18 +253,18 @@
(- (caddr env) (car env))))
1.0))))))
(else (envelope-interp x (cddr env))))))
+|#
(define* (rt-motif :rest args)
(let* ((shell-app (XtVaOpenApplication
- "FM" 0 '() applicationShellWidgetClass
+ "FM" 0 () applicationShellWidgetClass
(list XmNallowShellResize #t)))
(app (cadr shell-app))
(shell (car shell-app))
(dpy (XtDisplay shell))
(screen (DefaultScreenOfDisplay dpy))
(cmap (DefaultColormap dpy (DefaultScreen dpy)))
- (black (BlackPixelOfScreen screen))
- (white (WhitePixelOfScreen screen)))
+ (black (BlackPixelOfScreen screen)))
(define (get-color color)
(let ((col (XColor)))
@@ -528,8 +524,8 @@
(begin
(set-defaults)
(if (= which-play 0)
- (set! func (apply make-agn (or args '())))
- (set! func (apply make-vct-test (or args '()))))
+ (set! func (apply make-agn (or args ())))
+ (set! func (apply make-float-vector-test (or args ()))))
(set! proc (XtAppAddWorkProc app (lambda (c) (rt-send->dac func)))))
(if proc (XtRemoveWorkProc proc)))))
(XmToggleButtonSetState play-button cplay #f)
@@ -538,5 +534,5 @@
(XtAppMainLoop app)))
(rt-motif)
-
+)
;; bess1.scm ends here
diff --git a/big-gens.scm b/big-gens.scm
index 3f76ced..222bb04 100644
--- a/big-gens.scm
+++ b/big-gens.scm
@@ -1,15 +1,15 @@
(provide 'snd-big-gens.scm)
-(if (not (provided? 'snd-generators.scm)) (load "generators.scm"))
+(require snd-generators.scm)
;;; -------- conversions --------
(define (big-hz->radians hz)
- (/ (* hz 2 pi) (mus-srate)))
+ (/ (* hz 2 pi) *clm-srate*))
(define (big-radians->hz rad)
- (/ (* rad (mus-srate)) (* 2 pi)))
+ (/ (* rad *clm-srate*) (* 2 pi)))
(define (big-db->linear x)
(expt 10.0 (/ x 20.0)))
@@ -24,17 +24,17 @@
(/ (* rad 180) pi))
(define (big-seconds->samples secs)
- (round (* secs (mus-srate))))
+ (round (* secs *clm-srate*)))
(define (big-samples->seconds samps)
- (/ samps (mus-srate)))
+ (/ samps *clm-srate*))
(define (big-rectangular->polar rl im)
(let ((len (length rl)))
(do ((i 0 (+ i 1)))
((= i len))
- (let* ((rl1 (rl i))
- (im1 (im i)))
+ (let ((rl1 (rl i))
+ (im1 (im i)))
(set! (rl i) (sqrt (+ (* rl1 rl1) (* im1 im1))))
(set! (im i) (- (atan im1 rl1)))))))
@@ -42,8 +42,8 @@
(let ((len (length mag)))
(do ((i 0 (+ i 1)))
((= i len))
- (let* ((mag1 (mag i))
- (ang1 (- (ang i))))
+ (let ((mag1 (mag i))
+ (ang1 (- (ang i))))
(set! (mag i) (* mag1 (cos ang1)))
(set! (ang i) (* mag1 (sin ang1)))))))
@@ -51,11 +51,11 @@
;;; -------- arrays (vectors in this context) --------
(define (big-array-clear v)
- (vector-fill! v 0.0))
+ (fill! v 0.0))
(define (big-array-normalize v)
- (let* ((len (length v))
- (pk 0.0))
+ (let ((len (length v))
+ (pk 0.0))
(do ((i 0 (+ i 1)))
((= i len))
(set! pk (max pk (abs (v i)))))
@@ -76,12 +76,6 @@
(* fpart (- (wave (modulo (+ ipart 1) n))
(wave ipart)))))))
-(define (big-multiply-arrays v1 v2)
- (let ((len (min (length v1) (length v2))))
- (do ((i 0 (+ i 1)))
- ((= i len) v1)
- (set! (v1 i) (* (vi 1) (v2 i))))))
-
;;; -------- polynomial --------
@@ -107,8 +101,7 @@
;;; -------- ring-modulate --------
-(define (big-ring-modulate in1 in2)
- (* in1 in2))
+(define big-ring-modulate *)
;;; -------- amplitude-modulate --------
@@ -128,46 +121,66 @@
(defgenerator (big-oscil
:make-wrapper
- (lambda (g) (set! (big-oscil-frequency g) (big-hz->radians (big-oscil-frequency g))) g))
- (frequency *clm-default-frequency*) (angle 0.0))
+ (lambda (g) (set! (g 'frequency) (big-hz->radians (g 'frequency))) g))
+ (frequency *clm-default-frequency*)
+ (angle 0.0))
(define* (big-oscil gen (fm 0.0) (pm 0.0))
- (declare (gen big-oscil) (fm float) (pm float))
- (let ((x (big-oscil-angle gen)))
- (set! (big-oscil-angle gen) (+ fm x (big-oscil-frequency gen)))
+ (let ((x (gen 'angle)))
+ (set! (gen 'angle) (+ fm x (gen 'frequency)))
(sin (+ x pm))))
+#|
+(with-sound (:statistics #t :clipped #f)
+ (let ((g (make-big-oscil 440.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 22050))
+ (outa i (* .5 (big-oscil g))))))
+|#
+
+
;;; -------- ncos --------
(defgenerator (big-ncos
:make-wrapper
(lambda (g)
- (if (<= (big-ncos-n g) 0)
- (set! (big-ncos-n g) 1))
- (set! (big-ncos-r g) (/ (big-ncos-n g)))
- (set! (big-ncos-frequency g) (big-hz->radians (big-ncos-frequency g)))
+ (if (<= (g 'n) 0)
+ (set! (g 'n) 1))
+ (set! (g 'r) (/ (g 'n)))
+ (set! (g 'frequency) (big-hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0) (r 1.0))
+ (frequency *clm-default-frequency*)
+ (n 1)
+ (angle 0.0)
+ (r 1.0))
(define* (big-ncos gen (fm 0.0))
- (declare (gen big-ncos) (fm float))
- (let* ((n (big-ncos-n gen))
- (x (big-ncos-angle gen))
- (scl (big-ncos-r gen))
+ (let* ((n (gen 'n))
+ (x (gen 'angle))
+ (scl (gen 'r))
(den (* 2 (sin (/ x 2)))))
- (set! (big-ncos-angle gen) (+ fm x (big-ncos-frequency gen)))
+ (set! (gen 'angle) (+ fm x (gen 'frequency)))
(if (= den 0.0)
1.0
(min 1.0 (* scl (- (/ (sin (* (+ n 1/2) x)) den) 1/2))))))
+#|
+(with-sound (:statistics #t :clipped #f)
+ (let ((g (make-big-ncos 100.0 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 22050))
+ (outa i (* .5 (big-ncos g))))))
+|#
+
+
;;; -------- nsin --------
(defgenerator (big-nsin
:make-wrapper
(lambda (g)
- (letrec ((nsin-ns (lambda (x n)
+ (letrec ((ns (lambda (x n)
(let* ((a2 (/ x 2))
(den (sin a2)))
(if (= den 0.0)
@@ -175,30 +188,32 @@
(/ (* (sin (* n a2))
(sin (* (+ n 1) a2)))
den)))))
- (find-nsin-scaler (lambda (n lo hi)
- (let* ((mid (/ (+ lo hi) 2))
- (ylo (nsin-ns lo n))
- (yhi (nsin-ns hi n)))
+ (find-scaler (lambda (n lo hi)
+ (let ((mid (/ (+ lo hi) 2))
+ (ylo (ns lo n))
+ (yhi (ns hi n)))
(if (< (abs (- yhi ylo)) 1e-12)
- (nsin-ns mid n)
+ (ns mid n)
(if (> ylo yhi)
- (find-nsin-scaler n lo mid)
- (find-nsin-scaler n mid hi)))))))
- (if (<= (big-nsin-n g) 0)
- (set! (big-nsin-n g) 1))
- (set! (big-nsin-r g) (/ 1.0 (find-nsin-scaler (big-nsin-n g) 0.0 (/ pi (+ (big-nsin-n g) 1/2)))))
- (set! (big-nsin-frequency g) (big-hz->radians (big-nsin-frequency g)))
+ (find-scaler n lo mid)
+ (find-scaler n mid hi)))))))
+ (if (<= (g 'n) 0)
+ (set! (g 'n) 1))
+ (set! (g 'r) (/ 1.0 (find-scaler (g 'n) 0.0 (/ pi (+ (g 'n) 1/2)))))
+ (set! (g 'frequency) (big-hz->radians (g 'frequency)))
g)))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0) (r 1.0))
+ (frequency *clm-default-frequency*)
+ (n 1)
+ (angle 0.0)
+ (r 1.0))
(define* (big-nsin gen (fm 0.0))
- (declare (gen big-nsin) (fm float))
- (let* ((n (big-nsin-n gen))
- (x (big-nsin-angle gen))
+ (let* ((n (gen 'n))
+ (x (gen 'angle))
(a2 (/ x 2))
- (scl (big-nsin-r gen))
+ (scl (gen 'r))
(den (sin a2)))
- (set! (big-nsin-angle gen) (+ fm x (big-nsin-frequency gen)))
+ (set! (gen 'angle) (+ fm x (gen 'frequency)))
(if (= den 0.0)
0.0
(/ (* scl (sin (* n a2)) (sin (* (+ n 1) a2))) den))))
@@ -217,20 +232,22 @@
(defgenerator (big-table-lookup
:make-wrapper
(lambda (g)
- (if (not (big-table-lookup-wave g))
- (set! (big-table-lookup-wave g) (make-vector (big-table-lookup-size g) 0.0))
- (set! (big-table-lookup-size g) (length (big-table-lookup-wave g))))
- (set! (big-table-lookup-frequency g) (/ (* (big-table-lookup-frequency g) (big-table-lookup-size g)) (mus-srate)))
- (set! (big-table-lookup-angle g) (/ (* (big-table-lookup-angle g) (big-table-lookup-size g)) (* 2 pi)))
+ (if (not (g 'wave))
+ (set! (g 'wave) (make-vector (g 'size) 0.0))
+ (set! (g 'size) (length (g 'wave))))
+ (set! (g 'frequency) (/ (* (g 'frequency) (g 'size)) *clm-srate*))
+ (set! (g 'angle) (/ (* (g 'angle) (g 'size)) (* 2 pi)))
g))
- (frequency *clm-default-frequency*) (angle 0.0) (wave #f :type vector) (size *clm-table-size*))
+ (frequency *clm-default-frequency*)
+ (angle 0.0)
+ (wave #f)
+ (size *clm-table-size*))
(define* (big-table-lookup gen (fm 0.0))
- (declare (gen big-table-lookup) (fm float))
- (let ((x (big-table-lookup-angle gen))
- (w (big-table-lookup-wave gen))
- (n (big-table-lookup-size gen)))
- (set! (big-table-lookup-angle gen) (+ x (big-table-lookup-frequency gen) (/ (* fm n) (* 2 pi))))
+ (let ((x (gen 'angle))
+ (w (gen 'wave))
+ (n (gen 'size)))
+ (set! (gen 'angle) (+ x (gen 'frequency) (/ (* fm n) (* 2 pi))))
(big-array-interp w x n)))
#|
@@ -251,10 +268,9 @@
(defgenerator big-one-zero (a0 1.0) (a1 0.0) (x1 0.0))
(define* (big-one-zero gen x)
- (declare (gen big-one-zero) (x float))
- (let ((val (+ (* x (big-one-zero-a0 gen))
- (* (big-one-zero-x1 gen) (big-one-zero-a1 gen)))))
- (set! (big-one-zero-x1 gen) x)
+ (let ((val (+ (* x (gen 'a0))
+ (* (gen 'x1) (gen 'a1)))))
+ (set! (gen 'x1) x)
val))
@@ -263,18 +279,8 @@
(defgenerator big-one-pole (a0 1.0) (b1 0.0) (y1 0.0))
(define* (big-one-pole gen x)
- (declare (gen big-one-pole) (x float))
- (let ((val (- (* x (big-one-pole-a0 gen))
- (* (big-one-pole-y1 gen) (big-one-pole-b1 gen)))))
- (set! (big-one-pole-y1 gen) val)
- val))
-
-
-
-
-
-
-
-;;; TODO: rest of big-gens and big gen tests/doc etc
+ (let ((val (- (* x (gen 'a0))
+ (* (gen 'y1) (gen 'b1)))))
+ (set! (gen 'y1) val)))
diff --git a/binary-io.scm b/binary-io.scm
index 5ed5a14..07697b1 100644
--- a/binary-io.scm
+++ b/binary-io.scm
@@ -9,15 +9,15 @@
;;; -------- strings (0-terminated)
-(define (read-string)
- (let ((chars '()))
+(define (io-read-string)
+ (let ((chars ()))
(do ((c (read-byte) (read-byte)))
- ((or (= c 0)
- (eof-object? c))
+ ((or (eof-object? c)
+ (= c 0))
(apply string (reverse chars)))
(set! chars (cons (integer->char c) chars)))))
-(define (write-string str)
+(define (io-write-string str)
(for-each write-char str) ; or maybe (lambda (c) (write-byte (char->integer c)))
(write-byte 0))
@@ -28,7 +28,7 @@
(let ((str (make-string len)))
(do ((i 0 (+ i 1)))
((= i len) str)
- (string-set! str i (read-char)))))
+ (set! (str i) (read-char)))))
(define (write-chars str)
(for-each write-char str))
@@ -37,7 +37,7 @@
;;; -------- 16-bit ints
(define (read-bint16)
- (let ((int (+ (ash (read-byte) 8) (read-byte))))
+ (let ((int (+ (ash (read-byte) 8) (read-byte)))) ; this depends on arg evaluation left->right
(if (> int 32767)
(- int 65536)
int)))
@@ -130,8 +130,7 @@
(signif (car data))
(expon (cadr data))
(sign (caddr data)))
- (if (and (= expon 0)
- (= signif 0))
+ (if (= expon signif 0)
0
;; we're assuming floats are (64-bit) doubles in s7, so this is coercing to a 32-bit float in a sense
;; this causes some round-off error
@@ -168,8 +167,7 @@
(signif (car data))
(expon (cadr data))
(sign (caddr data)))
- (if (and (= expon 0)
- (= signif 0))
+ (if (= expon signif 0)
0
(logior (if (negative? sign) #x8000000000000000 0)
(ash (+ expon 52 1023) 52)
@@ -186,11 +184,11 @@
;;; -------- 80-bit floats (IEEE 754, sign + 63(+1) bits significand + 15 bits exponent, needed for aifc headers)
(define (read-bfloat80->int)
- (let* ((exp 0)
- (mant1 0)
- (mant0 0)
- (sign 0)
- (buf (make-vector 10)))
+ (let ((exp 0)
+ (mant1 0)
+ (mant0 0)
+ (sign 0)
+ (buf (make-vector 10)))
(do ((i 0 (+ i 1)))
((= i 10))
(set! (buf i) (read-byte)))
@@ -214,7 +212,7 @@
(if (negative? val)
(begin
(set! sign 1)
- (set! val (abs val))))
+ (set! val (- val))))
(if (not (zero? val))
(begin
(set! exp (round (+ (log val 2.0) 16383.0)))
@@ -243,16 +241,16 @@
(let ((magic (read-chars 4)))
(if (not (string=? magic ".snd"))
(error 'bad-header "~A is not an au file: ~A" file)
- (let* ((data-location (read-bint32))
- (data-size (read-bint32))
- (data-format (read-bint32))
- (srate (read-bint32))
- (chans (read-bint32))
- (comment (read-string)))
- (list magic data-location data-size data-format srate chans comment)))))))
-
-(define (write-au-header file chans srate data-size data-format comment) ; data-size in bytes
- ;; common data-formats: 1 mulaw, 2 linear_8, 3 linear_16, 4 linear_24, 5 linear_32, 6 float, 5 double, 27 alaw
+ (let ((data-location (read-bint32))
+ (data-size (read-bint32))
+ (sample-type (read-bint32))
+ (srate (read-bint32))
+ (chns (read-bint32))
+ (comment (io-read-string)))
+ (list magic data-location data-size sample-type srate chns comment)))))))
+
+(define (write-au-header file chns srate data-size sample-type comment) ; data-size in bytes
+ ;; common sample-types: 1 mulaw, 2 linear_8, 3 linear_16, 4 linear_24, 5 linear_32, 6 float, 5 double, 27 alaw
(with-output-to-file file
(lambda ()
(let* ((comlen (length comment))
@@ -261,13 +259,13 @@
(write-chars ".snd")
(write-bint32 data-location)
(write-bint32 data-size)
- (write-bint32 data-format)
+ (write-bint32 sample-type)
(write-bint32 srate)
- (write-bint32 chans)
+ (write-bint32 chns)
(if (> comlen 0)
(begin
- (write-string comment)
- (set! curloc (+ curloc comlen 1)))) ; write-string adds a trailing 0
+ (io-write-string comment)
+ (set! curloc (+ curloc comlen 1)))) ; io-write-string adds a trailing 0
(do ((i curloc (+ i 1)))
((>= i data-location))
(write-byte 0))))))
@@ -276,17 +274,17 @@
(define (read-aif-header file)
(let ((data-location 0)
(data-size 0)
- (data-format 0)
+ (sample-type 0)
(srate 0)
- (chans 0)
+ (chns 0)
(current-location 0))
(with-input-from-file file
(lambda ()
(let ((magic (read-chars 4)))
(if (not (string=? magic "FORM"))
(error 'bad-header "~A is not an aif file: ~A" file magic)
- (let* ((size (read-bint32))
- (magic (read-chars 4)))
+ (let (;(size (read-bint32))
+ (magic (read-chars 4)))
(set! current-location 12)
(if (and (not (string=? magic "AIFF"))
(not (string=? magic "AIFC")))
@@ -295,23 +293,23 @@
(call-with-exit
(lambda (return)
(let loop ()
- (let* ((chunk (read-chars 4))
- (chunk-size (read-bint32)))
+ (let ((chunk (read-chars 4))
+ (chunk-size (read-bint32)))
(if (odd? chunk-size) (set! chunk-size (+ chunk-size 1)))
(if (string=? chunk "SSND")
(begin
(set! data-location (+ 16 current-location (read-bint32)))
(if (> srate 0)
- (return (list magic data-location data-size data-format srate chans))))
+ (return (list magic data-location data-size sample-type srate chns))))
(if (string=? chunk "COMM")
- (let ((frames 0))
- (set! chans (read-bint16))
- (set! frames (read-bint32))
- (set! data-format (read-bint16))
+ (let ((len 0))
+ (set! chns (read-bint16))
+ (set! len (read-bint32))
+ (set! sample-type (read-bint16))
(set! srate (read-bfloat80->int))
- (set! data-size (* frames chans data-format 1/8))
+ (set! data-size (* len chns sample-type 1/8))
(if (> data-location 0)
- (return (list magic data-location data-size data-format srate chans))))
+ (return (list magic data-location data-size sample-type srate chns))))
(do ((i 0 (+ i 1))) ; here we really need built-in file IO stuff!
((= i chunk-size))
(if (eof-object? (read-byte))
diff --git a/bird.fsm b/bird.fsm
index 192fc1b..da8d6c1 100644
--- a/bird.fsm
+++ b/bird.fsm
@@ -2,7 +2,7 @@
\ Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
\ Created: Tue Dec 12 03:26:27 CET 2006
-\ Changed: Sat Feb 19 17:28:25 CET 2011
+\ Changed: Wed Nov 21 22:48:47 CET 2012
\ Usage: <'> bird-test with-sound
\ or ws-bird-test
@@ -10,30 +10,51 @@
require clm
instrument: bird <{ start dur freq freq-skew amp freqenv ampenv
- :optional lpfilt 1.0 degree 0.0 reverb-amount 0.0 -- }>
- :envelope ampenv :scaler amp :duration dur make-env { amp-env }
- :envelope freqenv :scaler freq-skew hz->radians :duration dur make-env { gls-env }
- :frequency freq make-oscil { os }
- :a0 lpfilt :b1 1.0 lpfilt f- make-one-pole { fil }
- *channels* 2 = degree f0= && if 45.0 to degree then
- *reverb* reverb-amount f0= && if 0.001 to reverb-amount then
- start dur #{ :degree degree :distance 1.0 :reverb-amount reverb-amount } run-instrument
- fil os gls-env env 0.0 oscil amp-env env f* one-pole
- end-run
+ :optional lpfilt 1.0 degree 0.0 reverb-amount 0.0 -- }>
+ :envelope ampenv :scaler amp :duration dur make-env { amp-env }
+ :envelope freqenv :scaler freq-skew hz->radians :duration dur
+ make-env { gls-env }
+ :frequency freq make-oscil { os }
+ :a0 lpfilt :b1 1.0 lpfilt f- make-one-pole { fil }
+ *channels* 2 =
+ degree f0= && if
+ 45.0 to degree
+ then
+ *reverb*
+ reverb-amount f0= && if
+ 0.001 to reverb-amount
+ then
+ start dur
+ #{ :degree degree
+ :distance 1.0
+ :reverb-amount reverb-amount } run-instrument
+ fil os gls-env env 0.0 oscil amp-env env f* one-pole
+ end-run
;instrument
instrument: bigbird <{ start dur freq freq-skew amp freqenv ampenv parts
- :optional lpcoeff 1.0 degree 0.0 reverb-amount 0.0 -- }>
- parts normalize-partials to parts
- :envelope ampenv :scaler amp :duration dur make-env { amp-env }
- :envelope freqenv :scaler freq-skew hz->radians :duration dur make-env { gls-env }
- :frequency freq :coeffs parts mus-chebyshev-first-kind partials->polynomial make-polyshape { os }
- :a0 lpcoeff :b1 1.0 lpcoeff f- make-one-pole { fil }
- *channels* 2 = degree f0= && if 45.0 to degree then
- *reverb* reverb-amount f0= && if 0.001 to reverb-amount then
- start dur #{ :degree degree :distance 1.0 :reverb-amount reverb-amount } run-instrument
- fil os 1.0 gls-env env polyshape amp-env env f* one-pole
- end-run
+ :optional lpcoeff 1.0 degree 0.0 reverb-amount 0.0 -- }>
+ :envelope ampenv :scaler amp :duration dur make-env { amp-env }
+ :envelope freqenv :scaler freq-skew hz->radians :duration dur
+ make-env { gls-env }
+ :frequency freq
+ :coeffs parts normalize-partials undef partials->polynomial
+ make-polyshape { os }
+ :a0 lpcoeff :b1 1.0 lpcoeff f- make-one-pole { fil }
+ *channels* 2 =
+ degree f0= && if
+ 45.0 to degree
+ then
+ *reverb*
+ reverb-amount f0= && if
+ 0.001 to reverb-amount
+ then
+ start dur
+ #{ :degree degree
+ :distance 1.0
+ :reverb-amount reverb-amount } run-instrument
+ fil os 1.0 gls-env env polyshape amp-env env f* one-pole
+ end-run
;instrument
#( 0 0 0.25 1 0.6 0.7 0.75 1 1 0 ) constant main-amp
@@ -43,1076 +64,1122 @@ instrument: bigbird <{ start dur freq freq-skew amp freqenv ampenv parts
#( 0 1 1 0 ) constant bird-down
event: orchard-oriole ( beg -- )
- 0.38 f- { beg }
- #( 0 0 0.6 1 1 0.6 ) { oriupdwna }
- #( 0 0.5 0.3 1 1 0 ) { oriupdwnb }
- #( 0 0.9 0.15 1 0.4 0.3 0.6 0.6 0.85 0 1 0 ) { oribiga }
- #( 0 1 0.05 0.5 0.1 1 0.25 0 0.85 0.5 1 0 ) { orimid }
- #( 0 0.3 0.25 0 1 1 ) { oridwnup }
- #( 0 0 0.1 1 1 0 ) { oriamp }
-
- 0.38 beg f+ 0.03 3700 100 0.05 bird-down main-amp bird
- 0.41 beg f+ 0.05 2500 1000 0.10 bird-up main-amp bird
- 0.50 beg f+ 0.10 2000 800 0.20 oriupdwna main-amp #( 1 1 2 0.02 3 0.05 ) bigbird
- 0.65 beg f+ 0.03 3900 1200 0.10 bird-down main-amp bird
- 0.70 beg f+ 0.21 2000 1200 0.15 oribiga main-amp #( 1 1 2 0.05 ) bigbird
- 1.00 beg f+ 0.05 4200 1000 0.10 bird-down main-amp bird
- 1.10 beg f+ 0.10 2000 1000 0.25 orimid main-amp #( 1 1 2 0.05 ) bigbird
- 1.30 beg f+ 0.10 2000 1000 0.25 orimid main-amp #( 1 1 2 0.05 ) bigbird
- 1.48 beg f+ 0.10 2300 3200 0.10 oriupdwnb oriamp bird
- 1.65 beg f+ 0.03 1800 300 0.05 bird-up main-amp bird
- 1.70 beg f+ 0.03 2200 100 0.04 bird-down main-amp bird
- 1.80 beg f+ 0.07 2500 2000 0.15 oriupdwnb oriamp bird
- 1.92 beg f+ 0.20 2400 1200 0.25 oridwnup main-amp #( 1 1 2 0.04 ) bigbird
- 2.20 beg f+ 0.02 2200 3000 0.04 bird-up main-amp bird
- 2.28 beg f+ 0.02 2200 3000 0.04 bird-up main-amp bird
- 2.40 beg f+ 0.17 2000 1000 0.20 oriupdwna oriamp #( 1 1 2 0.04 ) bigbird
- 2.4 0.17 f+ step
+ 0.38 f- { beg }
+ #( 0 0 0.6 1 1 0.6 ) { oriupdwna }
+ #( 0 0.5 0.3 1 1 0 ) { oriupdwnb }
+ #( 0 0.9 0.15 1 0.4 0.3 0.6 0.6 0.85 0 1 0 ) { oribiga }
+ #( 0 1 0.05 0.5 0.1 1 0.25 0 0.85 0.5 1 0 ) { orimid }
+ #( 0 0.3 0.25 0 1 1 ) { oridwnup }
+ #( 0 0 0.1 1 1 0 ) { oriamp }
+
+ 0.38 beg f+ 0.03 3700 100 0.05 bird-down main-amp bird
+ 0.41 beg f+ 0.05 2500 1000 0.10 bird-up main-amp bird
+ 0.50 beg f+ 0.10 2000 800 0.20 oriupdwna main-amp
+ #( 1 1 2 0.02 3 0.05 ) bigbird
+ 0.65 beg f+ 0.03 3900 1200 0.10 bird-down main-amp bird
+ 0.70 beg f+ 0.21 2000 1200 0.15 oribiga main-amp
+ #( 1 1 2 0.05 ) bigbird
+ 1.00 beg f+ 0.05 4200 1000 0.10 bird-down main-amp bird
+ 1.10 beg f+ 0.10 2000 1000 0.25 orimid main-amp
+ #( 1 1 2 0.05 ) bigbird
+ 1.30 beg f+ 0.10 2000 1000 0.25 orimid main-amp
+ #( 1 1 2 0.05 ) bigbird
+ 1.48 beg f+ 0.10 2300 3200 0.10 oriupdwnb oriamp bird
+ 1.65 beg f+ 0.03 1800 300 0.05 bird-up main-amp bird
+ 1.70 beg f+ 0.03 2200 100 0.04 bird-down main-amp bird
+ 1.80 beg f+ 0.07 2500 2000 0.15 oriupdwnb oriamp bird
+ 1.92 beg f+ 0.20 2400 1200 0.25 oridwnup main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 2.20 beg f+ 0.02 2200 3000 0.04 bird-up main-amp bird
+ 2.28 beg f+ 0.02 2200 3000 0.04 bird-up main-amp bird
+ 2.40 beg f+ 0.17 2000 1000 0.20 oriupdwna oriamp
+ #( 1 1 2 0.04 ) bigbird
+ 2.4 0.17 f+ step
;event
event: cassins-kingbird ( beg -- )
- 0.03 f- { beg }
- #( 0 0.3 0.45 1 0.9 0.1 1 0 ) { kingfirst }
- #( 0.00 0.00 0.02 0.50 0.04 0.00 0.06 0.55 0.08 0.05 0.10 0.60
- 0.12 0.05 0.14 0.65 0.16 0.10 0.18 0.70 0.20 0.10 0.22 0.75
- 0.24 0.15 0.26 0.80 0.28 0.20 0.30 0.85 0.32 0.25 0.34 0.90
- 0.36 0.30 0.38 0.95 0.40 0.40 0.42 1.00 0.44 0.50 0.46 1.00
- 0.48 0.45 0.50 1.00 0.52 0.50 0.54 1.00 0.56 0.40 0.58 0.95
- 0.60 0.40 0.62 0.90 0.64 0.40 0.66 0.85 0.68 0.35 0.70 0.80
- 0.72 0.30 0.74 0.75 0.76 0.25 0.78 0.70 0.80 0.20 0.82 0.65
- 0.84 0.10 0.86 0.60 0.88 0.00 0.90 0.55 0.92 0.00 0.94 0.50
- 0.96 0.00 1.00 0.40 ) { kingsecond }
-
- 0.03 beg f+ 0.04 1700 1200 0.15 kingfirst main-amp #( 1 1 2 0.5 3 0 4 0.2 ) bigbird
- 0.12 beg f+ 0.18 1700 900 0.25 kingsecond main-amp #( 1 1 2 0.01 3 0 4 0.1 ) bigbird
- 0.12 0.18 f+ step
+ 0.03 f- { beg }
+ #( 0 0.3 0.45 1 0.9 0.1 1 0 ) { kingfirst }
+ #( 0.00 0.00 0.02 0.50 0.04 0.00 0.06 0.55 0.08 0.05 0.10 0.60
+ 0.12 0.05 0.14 0.65 0.16 0.10 0.18 0.70 0.20 0.10 0.22 0.75
+ 0.24 0.15 0.26 0.80 0.28 0.20 0.30 0.85 0.32 0.25 0.34 0.90
+ 0.36 0.30 0.38 0.95 0.40 0.40 0.42 1.00 0.44 0.50 0.46 1.00
+ 0.48 0.45 0.50 1.00 0.52 0.50 0.54 1.00 0.56 0.40 0.58 0.95
+ 0.60 0.40 0.62 0.90 0.64 0.40 0.66 0.85 0.68 0.35 0.70 0.80
+ 0.72 0.30 0.74 0.75 0.76 0.25 0.78 0.70 0.80 0.20 0.82 0.65
+ 0.84 0.10 0.86 0.60 0.88 0.00 0.90 0.55 0.92 0.00 0.94 0.50
+ 0.96 0.00 1.00 0.40 ) { kingsecond }
+
+ 0.03 beg f+ 0.04 1700 1200 0.15 kingfirst main-amp
+ #( 1 1 2 0.5 3 0 4 0.2 ) bigbird
+ 0.12 beg f+ 0.18 1700 900 0.25 kingsecond main-amp
+ #( 1 1 2 0.01 3 0 4 0.1 ) bigbird
+ 0.12 0.18 f+ step
;event
event: chipping-sparrow ( beg -- )
- { beg }
- #( 0 0.8 0.15 1 0.75 0.3 1 0 ) { chip-up }
-
- 0.00 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.06 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.12 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.18 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.24 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.30 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.36 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.42 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.48 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.54 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.60 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.66 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.72 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.78 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.84 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.90 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.96 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
- 0.96 0.05 f+ step
+ { beg }
+ #( 0 0.8 0.15 1 0.75 0.3 1 0 ) { chip-up }
+
+ 0.00 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.06 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.12 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.18 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.24 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.30 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.36 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.42 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.48 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.54 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.60 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.66 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.72 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.78 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.84 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.90 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.96 beg f+ 0.05 4000 2400 0.2 chip-up main-amp bird
+ 0.96 0.05 f+ step
;event
event: bobwhite ( beg -- )
- 0.4 f- { beg }
- #( 0 0 0.4 1 1 1 ) { bobup1 }
- #( 0 0 0.65 0.5 1 1 ) { bobup2 }
+ 0.4 f- { beg }
+ #( 0 0 0.4 1 1 1 ) { bobup1 }
+ #( 0 0 0.65 0.5 1 1 ) { bobup2 }
- 0.4 beg f+ 0.2 1800 200 0.1 bobup1 main-amp #( 1 1 2 0.02 ) bigbird
- 1.0 beg f+ 0.2 1800 1200 0.2 bobup2 main-amp #( 1 1 2 0.02 ) bigbird
- 1 0.2 f+ step
+ 0.4 beg f+ 0.2 1800 200 0.1 bobup1 main-amp #( 1 1 2 0.02 ) bigbird
+ 1.0 beg f+ 0.2 1800 1200 0.2 bobup2 main-amp #( 1 1 2 0.02 ) bigbird
+ 1 0.2 f+ step
;event
event: western-meadowlark ( beg -- )
- 0.8 f- { beg }
- #( 0 0 1 0 ) { no-skw }
- #( 0 1 0.4 0.4 1 0 ) { down-skw }
-
- 0.80 beg f+ 0.10 2010 0 0.10 no-skw main-amp #( 1 1 2 0.04 ) bigbird
- 1.10 beg f+ 0.15 3000 100 0.11 down-skw main-amp #( 1 1 2 0.04 ) bigbird
- 1.30 beg f+ 0.25 2000 150 0.20 down-skw main-amp #( 1 1 2 0.04 ) bigbird
- 1.65 beg f+ 0.15 3010 250 0.11 down-skw main-amp #( 1 1 2 0.04 ) bigbird
- 1.85 beg f+ 0.10 2200 150 0.11 down-skw main-amp #( 1 1 2 0.04 ) bigbird
- 2.00 beg f+ 0.10 3200 1400 0.11 bird-down main-amp #( 1 1 2 0.04 ) bigbird
- 2.20 beg f+ 0.05 2000 200 0.11 bird-down main-amp #( 1 1 2 0.04 ) bigbird
- 2.30 beg f+ 0.10 1600 0 0.11 bird-down main-amp #( 1 1 2 0.04 ) bigbird
- 2.3 0.1 f+ step
+ 0.8 f- { beg }
+ #( 0 0 1 0 ) { no-skw }
+ #( 0 1 0.4 0.4 1 0 ) { down-skw }
+
+ 0.80 beg f+ 0.10 2010 0 0.10 no-skw main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 1.10 beg f+ 0.15 3000 100 0.11 down-skw main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 1.30 beg f+ 0.25 2000 150 0.20 down-skw main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 1.65 beg f+ 0.15 3010 250 0.11 down-skw main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 1.85 beg f+ 0.10 2200 150 0.11 down-skw main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 2.00 beg f+ 0.10 3200 1400 0.11 bird-down main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 2.20 beg f+ 0.05 2000 200 0.11 bird-down main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 2.30 beg f+ 0.10 1600 0 0.11 bird-down main-amp
+ #( 1 1 2 0.04 ) bigbird
+ 2.3 0.1 f+ step
;event
event: scissor-tailed-flycatcher ( beg -- )
- { beg }
- #( 0 0 0.4 1 0.6 1 1 0 ) { scissor }
+ { beg }
+ #( 0 0 0.4 1 0.6 1 1 0 ) { scissor }
- beg 0.05 1800 1800 0.2 scissor main-amp #( 1 0.5 2 1 3 0.5 4 0.1 5 0.01 ) bigbird
- 0.05 step
+ beg 0.05 1800 1800 0.2 scissor main-amp
+ #( 1 0.5 2 1 3 0.5 4 0.1 5 0.01 ) bigbird
+ 0.05 step
;event
event: great-horned-owl ( beg -- )
- 0.3 f- { beg }
- #( 0 0 0.3 1 1 1 ) { owlup }
- #( 1 1 3 0.02 7 0.01 ) { owl-parts }
-
- 0.30 beg f+ 0.10 300 0 0.1 main-amp main-amp owl-parts bigbird
- 0.60 beg f+ 0.40 293 6 0.1 bird-down main-amp owl-parts bigbird
- 1.75 beg f+ 0.35 293 7 0.1 owlup main-amp owl-parts bigbird
- 2.50 beg f+ 0.20 300 0 0.1 owlup main-amp owl-parts bigbird
- 2.5 0.2 f+ step
+ 0.3 f- { beg }
+ #( 0 0 0.3 1 1 1 ) { owlup }
+ #( 1 1 3 0.02 7 0.01 ) { owl-parts }
+
+ 0.30 beg f+ 0.10 300 0 0.1 main-amp main-amp owl-parts bigbird
+ 0.60 beg f+ 0.40 293 6 0.1 bird-down main-amp owl-parts bigbird
+ 1.75 beg f+ 0.35 293 7 0.1 owlup main-amp owl-parts bigbird
+ 2.50 beg f+ 0.20 300 0 0.1 owlup main-amp owl-parts bigbird
+ 2.5 0.2 f+ step
;event
event: black-throated-gray-warbler ( beg -- )
- { beg }
- #( 0.00 0.50 0.02 0.60 0.04 0.45 0.06 0.62 0.08 0.40 0.10 0.65
- 0.12 0.35 0.14 0.70 0.18 0.30 0.20 0.70 0.22 0.30 0.24 0.70
- 0.25 0.20 0.30 0.80 0.35 0.10 0.40 0.90 0.45 0.00 0.50 1.00
- 0.55 0.00 0.60 1.00 0.65 0.00 0.70 1.00 0.75 0.00 0.80 1.00
- 0.85 0.00 0.90 1.00 0.95 0.00 1.00 0.50 ) { gray-one }
- #( 0.00 0.00 0.01 0.40 0.02 0.00 0.03 0.40 0.04 0.00 0.05 0.40
- 0.06 0.00 0.07 0.40 0.08 0.00 0.09 0.40 0.10 0.00 0.25 0.80
- 0.40 0.30 0.55 1.00 0.70 0.00 0.85 0.80 1.00 0.40 ) { gray-two }
- #( 0.00 1.00 0.01 0.60 0.02 1.00 0.03 0.60 0.04 1.00 0.05 0.60
- 0.06 1.00 0.07 0.60 0.08 1.00 0.09 0.60 0.10 1.00 0.11 0.60
- 0.12 1.00 0.13 0.60 0.14 1.00 0.15 0.60 0.16 1.00 0.17 0.60
- 0.18 1.00 0.19 0.60 0.20 1.00 0.21 0.55 0.22 1.00 0.23 0.50
- 0.24 1.00 0.25 0.50 0.26 1.00 0.27 0.50 0.28 1.00 0.29 0.50
- 0.30 1.00 0.31 0.50 0.32 1.00 0.33 0.50 0.34 1.00 0.35 0.50
- 0.36 1.00 0.37 0.50 0.38 1.00 0.39 0.50 0.40 1.00 0.41 0.50
- 0.42 1.00 0.43 0.50 0.44 1.00 0.45 0.50 0.46 1.00 0.47 0.50
- 0.48 1.00 0.49 0.50 0.50 1.00 0.51 0.50 0.52 1.00 0.53 0.50
- 0.54 1.00 0.55 0.50 0.56 1.00 0.57 0.50 0.58 1.00 0.59 0.50
- 0.60 1.00 1.00 0.00 ) { gray-three }
-
- 0.00 beg f+ 0.12 3700 600 0.05 gray-one main-amp bird
- 0.18 beg f+ 0.08 3000 800 0.07 gray-two main-amp bird
- 0.28 beg f+ 0.12 3700 600 0.12 gray-one main-amp bird
- 0.44 beg f+ 0.08 3000 800 0.15 gray-two main-amp bird
- 0.54 beg f+ 0.12 3700 600 0.20 gray-one main-amp bird
- 0.72 beg f+ 0.08 3000 800 0.25 gray-two main-amp bird
- 0.82 beg f+ 0.12 3700 600 0.25 gray-one main-amp bird
- 0.96 beg f+ 0.20 3000 2000 0.20 gray-three main-amp bird
- 1.20 beg f+ 0.02 4500 500 0.05 bird-up main-amp bird
- 1.25 beg f+ 0.02 4200 800 0.05 bird-up main-amp bird
- 1.30 beg f+ 0.02 4000 900 0.05 bird-up main-amp bird
- 1.3 0.02 f+ step
+ { beg }
+ #( 0.00 0.50 0.02 0.60 0.04 0.45 0.06 0.62 0.08 0.40 0.10 0.65
+ 0.12 0.35 0.14 0.70 0.18 0.30 0.20 0.70 0.22 0.30 0.24 0.70
+ 0.25 0.20 0.30 0.80 0.35 0.10 0.40 0.90 0.45 0.00 0.50 1.00
+ 0.55 0.00 0.60 1.00 0.65 0.00 0.70 1.00 0.75 0.00 0.80 1.00
+ 0.85 0.00 0.90 1.00 0.95 0.00 1.00 0.50 ) { gray-one }
+ #( 0.00 0.00 0.01 0.40 0.02 0.00 0.03 0.40 0.04 0.00 0.05 0.40
+ 0.06 0.00 0.07 0.40 0.08 0.00 0.09 0.40 0.10 0.00 0.25 0.80
+ 0.40 0.30 0.55 1.00 0.70 0.00 0.85 0.80 1.00 0.40 ) { gray-two }
+ #( 0.00 1.00 0.01 0.60 0.02 1.00 0.03 0.60 0.04 1.00 0.05 0.60
+ 0.06 1.00 0.07 0.60 0.08 1.00 0.09 0.60 0.10 1.00 0.11 0.60
+ 0.12 1.00 0.13 0.60 0.14 1.00 0.15 0.60 0.16 1.00 0.17 0.60
+ 0.18 1.00 0.19 0.60 0.20 1.00 0.21 0.55 0.22 1.00 0.23 0.50
+ 0.24 1.00 0.25 0.50 0.26 1.00 0.27 0.50 0.28 1.00 0.29 0.50
+ 0.30 1.00 0.31 0.50 0.32 1.00 0.33 0.50 0.34 1.00 0.35 0.50
+ 0.36 1.00 0.37 0.50 0.38 1.00 0.39 0.50 0.40 1.00 0.41 0.50
+ 0.42 1.00 0.43 0.50 0.44 1.00 0.45 0.50 0.46 1.00 0.47 0.50
+ 0.48 1.00 0.49 0.50 0.50 1.00 0.51 0.50 0.52 1.00 0.53 0.50
+ 0.54 1.00 0.55 0.50 0.56 1.00 0.57 0.50 0.58 1.00 0.59 0.50
+ 0.60 1.00 1.00 0.00 ) { gray-three }
+
+ 0.00 beg f+ 0.12 3700 600 0.05 gray-one main-amp bird
+ 0.18 beg f+ 0.08 3000 800 0.07 gray-two main-amp bird
+ 0.28 beg f+ 0.12 3700 600 0.12 gray-one main-amp bird
+ 0.44 beg f+ 0.08 3000 800 0.15 gray-two main-amp bird
+ 0.54 beg f+ 0.12 3700 600 0.20 gray-one main-amp bird
+ 0.72 beg f+ 0.08 3000 800 0.25 gray-two main-amp bird
+ 0.82 beg f+ 0.12 3700 600 0.25 gray-one main-amp bird
+ 0.96 beg f+ 0.20 3000 2000 0.20 gray-three main-amp bird
+ 1.20 beg f+ 0.02 4500 500 0.05 bird-up main-amp bird
+ 1.25 beg f+ 0.02 4200 800 0.05 bird-up main-amp bird
+ 1.30 beg f+ 0.02 4000 900 0.05 bird-up main-amp bird
+ 1.3 0.02 f+ step
;event
event: yellow-warbler ( beg -- )
- { beg }
- #( 0 0 0.6 1 1 0.5 ) { yellow-up }
- #( 0 1 0.05 1 0.6 0 0.8 0.3 1 0.1 ) { yellow-swirl }
- #( 0 0 0.3 0.2 0.8 0.7 1 1 ) { yellow-last }
- #( 0 0 0.9 1 1 0 ) { swirl-amp }
-
- 0.00 beg f+ 0.050 5600 400 0.05 yellow-up main-amp bird
- 0.23 beg f+ 0.120 5000 1500 0.15 yellow-swirl main-amp bird
- 0.45 beg f+ 0.130 5000 1700 0.17 yellow-swirl main-amp bird
- 0.62 beg f+ 0.160 5000 2000 0.20 yellow-swirl main-amp bird
- 0.85 beg f+ 0.150 5000 2000 0.20 yellow-swirl main-amp bird
- 1.05 beg f+ 0.075 3700 1000 0.20 bird-down main-amp bird
- 1.15 beg f+ 0.075 3700 800 0.15 bird-down main-amp bird
- 1.25 beg f+ 0.075 3700 800 0.15 bird-down main-amp bird
- 1.40 beg f+ 0.200 3700 2000 0.20 yellow-last main-amp bird
- 1.4 0.2 f+ step
+ { beg }
+ #( 0 0 0.6 1 1 0.5 ) { yellow-up }
+ #( 0 1 0.05 1 0.6 0 0.8 0.3 1 0.1 ) { yellow-swirl }
+ #( 0 0 0.3 0.2 0.8 0.7 1 1 ) { yellow-last }
+ #( 0 0 0.9 1 1 0 ) { swirl-amp }
+
+ 0.00 beg f+ 0.050 5600 400 0.05 yellow-up main-amp bird
+ 0.23 beg f+ 0.120 5000 1500 0.15 yellow-swirl main-amp bird
+ 0.45 beg f+ 0.130 5000 1700 0.17 yellow-swirl main-amp bird
+ 0.62 beg f+ 0.160 5000 2000 0.20 yellow-swirl main-amp bird
+ 0.85 beg f+ 0.150 5000 2000 0.20 yellow-swirl main-amp bird
+ 1.05 beg f+ 0.075 3700 1000 0.20 bird-down main-amp bird
+ 1.15 beg f+ 0.075 3700 800 0.15 bird-down main-amp bird
+ 1.25 beg f+ 0.075 3700 800 0.15 bird-down main-amp bird
+ 1.40 beg f+ 0.200 3700 2000 0.20 yellow-last main-amp bird
+ 1.4 0.2 f+ step
;event
event: black-necked-stilt ( beg -- )
- { beg }
- #( 0 0 0.9 1 1 0 ) { upamp }
- #( 0 0 0.5 1 1 0.2 ) { rampup }
- #( 1 0.5 2 1 3 0.75 4 0.5 5 0.1 ) { bns-parts }
-
- 0.0 beg f+ 0.1 900 100 0.2 rampup upamp bns-parts bigbird
- 0.3 beg f+ 0.1 900 200 0.2 rampup upamp bns-parts bigbird
- 0.6 beg f+ 0.1 900 250 0.2 rampup upamp bns-parts bigbird
- 0.6 0.1 f+ step
+ { beg }
+ #( 0 0 0.9 1 1 0 ) { upamp }
+ #( 0 0 0.5 1 1 0.2 ) { rampup }
+ #( 1 0.5 2 1 3 0.75 4 0.5 5 0.1 ) { bns-parts }
+
+ 0.0 beg f+ 0.1 900 100 0.2 rampup upamp bns-parts bigbird
+ 0.3 beg f+ 0.1 900 200 0.2 rampup upamp bns-parts bigbird
+ 0.6 beg f+ 0.1 900 250 0.2 rampup upamp bns-parts bigbird
+ 0.6 0.1 f+ step
;event
event: chestnut-sided-warbler ( beg -- )
- 0.1 f- { beg }
- #( 0 1 0.3 0.5 0.6 1 0.8 0.2 1 0 ) { ycurve }
- #( 0 0.2 0.5 1 1 0 ) { vcurve }
- #( 0 0.5 0.15 0 0.45 0.1 0.6 1 0.7 0.9 1 0.9 ) { wcurve }
- #( 0 0 0.95 1 1 1 ) { upcurve }
- #( 0 1 0.25 0.3 0.6 0.15 1 0 ) { downcurve }
- #( 0 0 0.9 1 1 0 ) { louder }
- #( 0 0 0.1 1 0.4 0.1 0.5 0.9 0.6 0.1 0.7 1 1 0 ) { wamp }
-
- 0.10 beg f+ 0.10 4050 1200 0.050 ycurve main-amp #( 1 1 2 0.1 ) bigbird
- 0.25 beg f+ 0.03 3900 300 0.075 vcurve main-amp #( 1 1 2 0.1 ) bigbird
- 0.30 beg f+ 0.10 4050 1200 0.150 ycurve louder #( 1 1 2 0.1 ) bigbird
- 0.42 beg f+ 0.03 3800 500 0.100 vcurve main-amp #( 1 1 2 0.1 ) bigbird
- 0.50 beg f+ 0.10 4000 1200 0.200 ycurve tap-amp #( 1 1 2 0.1 ) bigbird
- 0.65 beg f+ 0.03 3800 500 0.150 vcurve main-amp #( 1 1 2 0.1 ) bigbird
- 0.72 beg f+ 0.10 4000 1200 0.200 ycurve tap-amp #( 1 1 2 0.1 ) bigbird
- 0.85 beg f+ 0.03 3800 500 0.150 vcurve main-amp #( 1 1 2 0.1 ) bigbird
- 0.91 beg f+ 0.10 4000 1200 0.200 ycurve tap-amp #( 1 1 2 0.1 ) bigbird
- 1.05 beg f+ 0.12 3800 2200 0.150 wcurve wamp #( 1 1 2 0.1 ) bigbird
- 1.20 beg f+ 0.12 3800 2200 0.150 wcurve wamp #( 1 1 2 0.1 ) bigbird
- 1.35 beg f+ 0.12 2500 2200 0.250 upcurve louder #( 1 1 2 0.1 ) bigbird
- 1.50 beg f+ 0.12 2500 4000 0.150 downcurve main-amp #( 1 1 2 0.1 ) bigbird
- 1.5 0.12 f+ step
+ 0.1 f- { beg }
+ #( 0 1 0.3 0.5 0.6 1 0.8 0.2 1 0 ) { ycurve }
+ #( 0 0.2 0.5 1 1 0 ) { vcurve }
+ #( 0 0.5 0.15 0 0.45 0.1 0.6 1 0.7 0.9 1 0.9 ) { wcurve }
+ #( 0 0 0.95 1 1 1 ) { upcurve }
+ #( 0 1 0.25 0.3 0.6 0.15 1 0 ) { downcurve }
+ #( 0 0 0.9 1 1 0 ) { louder }
+ #( 0 0 0.1 1 0.4 0.1 0.5 0.9 0.6 0.1 0.7 1 1 0 ) { wamp }
+
+ 0.10 beg f+ 0.10 4050 1200 0.050 ycurve main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 0.25 beg f+ 0.03 3900 300 0.075 vcurve main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 0.30 beg f+ 0.10 4050 1200 0.150 ycurve louder
+ #( 1 1 2 0.1 ) bigbird
+ 0.42 beg f+ 0.03 3800 500 0.100 vcurve main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 0.50 beg f+ 0.10 4000 1200 0.200 ycurve tap-amp
+ #( 1 1 2 0.1 ) bigbird
+ 0.65 beg f+ 0.03 3800 500 0.150 vcurve main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 0.72 beg f+ 0.10 4000 1200 0.200 ycurve tap-amp
+ #( 1 1 2 0.1 ) bigbird
+ 0.85 beg f+ 0.03 3800 500 0.150 vcurve main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 0.91 beg f+ 0.10 4000 1200 0.200 ycurve tap-amp
+ #( 1 1 2 0.1 ) bigbird
+ 1.05 beg f+ 0.12 3800 2200 0.150 wcurve wamp
+ #( 1 1 2 0.1 ) bigbird
+ 1.20 beg f+ 0.12 3800 2200 0.150 wcurve wamp
+ #( 1 1 2 0.1 ) bigbird
+ 1.35 beg f+ 0.12 2500 2200 0.250 upcurve louder
+ #( 1 1 2 0.1 ) bigbird
+ 1.50 beg f+ 0.12 2500 4000 0.150 downcurve main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 1.5 0.12 f+ step
;event
event: grasshopper-sparrow ( beg -- )
- 0.49 f- { beg }
- #( 0.00 0.50 0.02 0.80 0.04 0.30 0.06 0.80 0.07 0.10 0.08 0.90
- 0.10 0.00 0.11 0.90 0.12 0.00 0.13 0.90 0.14 0.10 0.15 1.00
- 0.16 0.10 0.17 1.00 0.18 0.10 0.19 1.00 0.20 0.10 0.21 1.00
- 0.22 0.10 0.23 1.00 0.24 0.10 0.25 1.00 0.26 0.10 0.27 1.00
- 0.28 0.10 0.29 1.00 0.30 0.10 0.31 1.00 0.32 0.10 0.33 1.00
- 0.34 0.10 0.35 1.00 0.36 0.10 0.37 1.00 0.38 0.10 0.39 1.00
- 0.40 0.10 0.41 1.00 0.42 0.10 0.43 1.00 0.44 0.10 0.45 1.00
- 0.46 0.10 0.47 1.00 0.48 0.10 0.49 1.00 0.50 0.10 0.51 1.00
- 0.52 0.10 0.53 1.00 0.54 0.10 0.55 1.00 0.56 0.10 0.57 1.00
- 0.58 0.10 0.59 1.00 0.60 0.10 0.61 1.00 0.62 0.10 0.63 1.00
- 0.64 0.10 0.65 1.00 0.66 0.10 0.67 1.00 0.68 0.10 0.69 1.00
- 0.70 0.10 0.71 1.00 0.72 0.10 0.73 1.00 0.74 0.10 0.75 1.00
- 0.76 0.10 0.77 1.00 0.78 0.10 0.79 1.00 0.80 0.10 0.81 1.00
- 0.82 0.10 0.83 1.00 0.84 0.10 0.85 1.00 0.86 0.10 0.87 1.00
- 0.88 0.10 0.89 1.00 0.90 0.10 0.91 1.00 0.92 0.10 0.93 1.00
- 0.94 0.10 0.95 1.00 0.96 0.10 0.97 1.00 0.98 0.10 1.00 1.00 ) { grass-one }
- #( 0.00 0.00 0.10 1.00 0.20 0.00 0.30 1.00 0.40 0.00 0.50 1.00
- 0.60 0.00 0.70 1.00 0.80 0.00 0.90 1.00 1.00 0.00 ) { grass-two }
-
- 0.49 beg f+ 0.01 8000 100 0.1 grass-two main-amp bird
- 0.60 beg f+ 0.01 5700 300 0.1 grass-two main-amp bird
- 0.92 beg f+ 0.01 3900 100 0.1 grass-two main-amp bird
- 1.00 beg f+ 1.40 6000 2500 0.2 grass-one main-amp bird
- 1 1.4 f+ step
+ 0.49 f- { beg }
+ #( 0.00 0.50 0.02 0.80 0.04 0.30 0.06 0.80 0.07 0.10 0.08 0.90
+ 0.10 0.00 0.11 0.90 0.12 0.00 0.13 0.90 0.14 0.10 0.15 1.00
+ 0.16 0.10 0.17 1.00 0.18 0.10 0.19 1.00 0.20 0.10 0.21 1.00
+ 0.22 0.10 0.23 1.00 0.24 0.10 0.25 1.00 0.26 0.10 0.27 1.00
+ 0.28 0.10 0.29 1.00 0.30 0.10 0.31 1.00 0.32 0.10 0.33 1.00
+ 0.34 0.10 0.35 1.00 0.36 0.10 0.37 1.00 0.38 0.10 0.39 1.00
+ 0.40 0.10 0.41 1.00 0.42 0.10 0.43 1.00 0.44 0.10 0.45 1.00
+ 0.46 0.10 0.47 1.00 0.48 0.10 0.49 1.00 0.50 0.10 0.51 1.00
+ 0.52 0.10 0.53 1.00 0.54 0.10 0.55 1.00 0.56 0.10 0.57 1.00
+ 0.58 0.10 0.59 1.00 0.60 0.10 0.61 1.00 0.62 0.10 0.63 1.00
+ 0.64 0.10 0.65 1.00 0.66 0.10 0.67 1.00 0.68 0.10 0.69 1.00
+ 0.70 0.10 0.71 1.00 0.72 0.10 0.73 1.00 0.74 0.10 0.75 1.00
+ 0.76 0.10 0.77 1.00 0.78 0.10 0.79 1.00 0.80 0.10 0.81 1.00
+ 0.82 0.10 0.83 1.00 0.84 0.10 0.85 1.00 0.86 0.10 0.87 1.00
+ 0.88 0.10 0.89 1.00 0.90 0.10 0.91 1.00 0.92 0.10 0.93 1.00
+ 0.94 0.10 0.95 1.00 0.96 0.10
+ 0.97 1.00 0.98 0.10 1.00 1.00 ) { grass-one }
+ #( 0.00 0.00 0.10 1.00 0.20 0.00 0.30 1.00 0.40 0.00 0.50 1.00
+ 0.60 0.00 0.70 1.00 0.80 0.00 0.90 1.00 1.00 0.00 ) { grass-two }
+
+ 0.49 beg f+ 0.01 8000 100 0.1 grass-two main-amp bird
+ 0.60 beg f+ 0.01 5700 300 0.1 grass-two main-amp bird
+ 0.92 beg f+ 0.01 3900 100 0.1 grass-two main-amp bird
+ 1.00 beg f+ 1.40 6000 2500 0.2 grass-one main-amp bird
+ 1 1.4 f+ step
;event
event: swamp-sparrow ( beg -- )
- { beg }
- #( 0 0 0.6 0.7 1 1 ) { swamp-up }
- #( 0 1 0.5 0.5 0.6 0.6 1 0 ) { swamp-down }
-
- 0.000 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.035 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.080 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.100 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.135 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.180 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.200 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.235 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.280 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.300 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.335 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.380 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.400 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.435 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.480 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.500 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.535 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.580 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.600 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.635 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.680 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.700 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.735 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.780 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.800 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.835 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.880 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.900 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
- 0.935 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
- 0.980 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
- 0.98 0.025 f+ step
+ { beg }
+ #( 0 0 0.6 0.7 1 1 ) { swamp-up }
+ #( 0 1 0.5 0.5 0.6 0.6 1 0 ) { swamp-down }
+
+ 0.000 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.035 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.080 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.100 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.135 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.180 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.200 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.235 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.280 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.300 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.335 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.380 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.400 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.435 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.480 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.500 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.535 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.580 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.600 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.635 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.680 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.700 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.735 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.780 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.800 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.835 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.880 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.900 beg f+ 0.020 3900 200 0.3 swamp-up main-amp bird
+ 0.935 beg f+ 0.035 3200 3000 0.1 swamp-down main-amp bird
+ 0.980 beg f+ 0.025 3700 0 0.1 main-amp main-amp bird
+ 0.98 0.025 f+ step
;event
event: golden-crowned-sparrow ( beg -- )
- 0.6 f- { beg }
- #( 0 1 0.25 0.2 1 0 ) { gold-one }
- #( 0 0.9 0.05 1 0.1 0.4 1 0 ) { gold-two }
- #( 0 0.5 0.1 0 0.2 1 0.3 0 0.4 1 0.5 0 0.6 1 0.7 0 0.8 1 0.9 0 1 0.5 )
- { gold-trill }
-
- 0.60 beg f+ 0.50 4300 1000 0.15 gold-one main-amp bird
- 1.30 beg f+ 0.45 3300 200 0.15 gold-one main-amp bird
- 1.75 beg f+ 0.40 3800 100 0.15 gold-two main-amp bird
- 2.20 beg f+ 0.30 3800 100 0.10 gold-trill main-amp bird
- 2.2 0.3 f+ step
+ 0.6 f- { beg }
+ #( 0 1 0.25 0.2 1 0 ) { gold-one }
+ #( 0 0.9 0.05 1 0.1 0.4 1 0 ) { gold-two }
+ #( 0 0.5 0.1 0 0.2 1 0.3 0 0.4 1
+ 0.5 0 0.6 1 0.7 0 0.8 1 0.9 0 1 0.5 ) { gold-trill }
+
+ 0.60 beg f+ 0.50 4300 1000 0.15 gold-one main-amp bird
+ 1.30 beg f+ 0.45 3300 200 0.15 gold-one main-amp bird
+ 1.75 beg f+ 0.40 3800 100 0.15 gold-two main-amp bird
+ 2.20 beg f+ 0.30 3800 100 0.10 gold-trill main-amp bird
+ 2.2 0.3 f+ step
;event
event: indigo-bunting ( beg -- )
- 0.4 f- { beg }
- #( 0 0 0.5 1 1 0 ) { bunt-v }
- #( 0 1 0.5 0 1 0.9 ) { bunt-y }
- #( 0 0.8 0.3 1 0.7 0.2 1 0 ) { bunt-n }
- #( 0 1 0.1 0.5 0.25 0.9 1 0 ) { bunt-x }
-
- 0.40 beg f+ 0.08 3000 700 0.25 bird-down main-amp bird
- 0.52 beg f+ 0.02 6200 1000 0.05 bird-down main-amp bird
- 0.55 beg f+ 0.15 3500 2300 0.10 bunt-v main-amp bird
- 0.74 beg f+ 0.02 6200 1800 0.05 bunt-x main-amp bird
- 0.80 beg f+ 0.15 3400 2300 0.10 bunt-v main-amp bird
- 1.00 beg f+ 0.10 3400 800 0.20 bunt-v main-amp bird
- 1.13 beg f+ 0.03 4100 2000 0.05 bird-down main-amp bird
- 1.25 beg f+ 0.08 3400 800 0.20 bunt-v main-amp bird
- 1.40 beg f+ 0.03 4100 2000 0.05 bird-down main-amp bird
- 1.50 beg f+ 0.07 3700 300 0.10 bird-down main-amp bird
- 1.60 beg f+ 0.10 4100 2200 0.15 bunt-y main-amp bird
- 1.72 beg f+ 0.05 3700 300 0.10 bird-down main-amp bird
- 1.81 beg f+ 0.10 4100 2200 0.15 bunt-y main-amp bird
- 1.94 beg f+ 0.07 5200 1800 0.20 bunt-n main-amp bird
- 2.05 beg f+ 0.08 3000 1500 0.15 bird-up main-amp bird
- 2.20 beg f+ 0.07 5200 1800 0.20 bunt-n main-amp bird
- 2.33 beg f+ 0.08 3000 1500 0.15 bird-up main-amp bird
- 2.43 beg f+ 0.07 5200 1800 0.10 bunt-n main-amp bird
- 2.51 beg f+ 0.08 3000 1500 0.10 bird-up main-amp bird
- 2.51 0.08 f+ step
+ 0.4 f- { beg }
+ #( 0 0 0.5 1 1 0 ) { bunt-v }
+ #( 0 1 0.5 0 1 0.9 ) { bunt-y }
+ #( 0 0.8 0.3 1 0.7 0.2 1 0 ) { bunt-n }
+ #( 0 1 0.1 0.5 0.25 0.9 1 0 ) { bunt-x }
+
+ 0.40 beg f+ 0.08 3000 700 0.25 bird-down main-amp bird
+ 0.52 beg f+ 0.02 6200 1000 0.05 bird-down main-amp bird
+ 0.55 beg f+ 0.15 3500 2300 0.10 bunt-v main-amp bird
+ 0.74 beg f+ 0.02 6200 1800 0.05 bunt-x main-amp bird
+ 0.80 beg f+ 0.15 3400 2300 0.10 bunt-v main-amp bird
+ 1.00 beg f+ 0.10 3400 800 0.20 bunt-v main-amp bird
+ 1.13 beg f+ 0.03 4100 2000 0.05 bird-down main-amp bird
+ 1.25 beg f+ 0.08 3400 800 0.20 bunt-v main-amp bird
+ 1.40 beg f+ 0.03 4100 2000 0.05 bird-down main-amp bird
+ 1.50 beg f+ 0.07 3700 300 0.10 bird-down main-amp bird
+ 1.60 beg f+ 0.10 4100 2200 0.15 bunt-y main-amp bird
+ 1.72 beg f+ 0.05 3700 300 0.10 bird-down main-amp bird
+ 1.81 beg f+ 0.10 4100 2200 0.15 bunt-y main-amp bird
+ 1.94 beg f+ 0.07 5200 1800 0.20 bunt-n main-amp bird
+ 2.05 beg f+ 0.08 3000 1500 0.15 bird-up main-amp bird
+ 2.20 beg f+ 0.07 5200 1800 0.20 bunt-n main-amp bird
+ 2.33 beg f+ 0.08 3000 1500 0.15 bird-up main-amp bird
+ 2.43 beg f+ 0.07 5200 1800 0.10 bunt-n main-amp bird
+ 2.51 beg f+ 0.08 3000 1500 0.10 bird-up main-amp bird
+ 2.51 0.08 f+ step
;event
event: hooded-warbler ( beg -- )
- 0.6 f- { beg }
- 0.60 beg f+ 0.03 3900 1600 0.05 bird-down main-amp bird
- 0.64 beg f+ 0.03 3900 1700 0.05 bird-down main-amp bird
- 0.80 beg f+ 0.03 3900 2000 0.10 bird-down main-amp bird
- 0.84 beg f+ 0.03 3900 2000 0.10 bird-down main-amp bird
- 0.93 beg f+ 0.03 3900 2100 0.15 bird-down main-amp bird
- 0.97 beg f+ 0.03 3900 2100 0.15 bird-down main-amp bird
- 1.05 beg f+ 0.03 3900 2100 0.05 bird-down main-amp bird
- 1.09 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.17 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.21 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.39 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.43 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.51 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.55 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.63 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.67 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.75 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.80 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
- 1.90 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
- 1.98 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
- 2.05 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
- 2.13 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
- 2.21 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
- 2.29 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
- 2.37 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
- 2.45 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
- 2.45 0.04 f+ step
+ 0.6 f- { beg }
+ 0.60 beg f+ 0.03 3900 1600 0.05 bird-down main-amp bird
+ 0.64 beg f+ 0.03 3900 1700 0.05 bird-down main-amp bird
+ 0.80 beg f+ 0.03 3900 2000 0.10 bird-down main-amp bird
+ 0.84 beg f+ 0.03 3900 2000 0.10 bird-down main-amp bird
+ 0.93 beg f+ 0.03 3900 2100 0.15 bird-down main-amp bird
+ 0.97 beg f+ 0.03 3900 2100 0.15 bird-down main-amp bird
+ 1.05 beg f+ 0.03 3900 2100 0.05 bird-down main-amp bird
+ 1.09 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.17 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.21 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.39 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.43 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.51 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.55 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.63 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.67 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.75 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.80 beg f+ 0.03 3900 2100 0.20 bird-down main-amp bird
+ 1.90 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
+ 1.98 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
+ 2.05 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
+ 2.13 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
+ 2.21 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
+ 2.29 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
+ 2.37 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
+ 2.45 beg f+ 0.04 3000 1000 0.15 bird-up main-amp bird
+ 2.45 0.04 f+ step
;event
event: american-widgeon ( beg -- )
- 0.3 f- { beg }
- #( 0 0 0.5 1 1 0 ) { widgeon }
-
- 0.30 beg f+ 0.07 1900 300 0.15 widgeon widgeon #( 1 1 2 0.02 ) bigbird
- 0.40 beg f+ 0.11 1700 1400 0.25 widgeon widgeon #( 1 0.7 2 1 3 0.02 ) bigbird
- 0.55 beg f+ 0.07 1900 300 0.15 widgeon widgeon #( 1 1 2 0.02 ) bigbird
- 0.55 0.07 f+ step
+ 0.3 f- { beg }
+ #( 0 0 0.5 1 1 0 ) { widgeon }
+
+ 0.30 beg f+ 0.07 1900 300 0.15 widgeon widgeon
+ #( 1 1 2 0.02 ) bigbird
+ 0.40 beg f+ 0.11 1700 1400 0.25 widgeon widgeon
+ #( 1 0.7 2 1 3 0.02 ) bigbird
+ 0.55 beg f+ 0.07 1900 300 0.15 widgeon widgeon
+ #( 1 1 2 0.02 ) bigbird
+ 0.55 0.07 f+ step
;event
event: louisiana-waterthrush ( beg -- )
- { beg }
- #( 0 0.8 0.35 0.4 0.45 0.9 0.5 1 0.75 1 1 1 ) { water-one }
- #( 0 1 0.4 0 0.6 0.1 1 0.8 ) { water-two }
- #( 0 1 0.95 0 1 0 ) { water-three }
- #( 0 0 1 1 ) { water-four }
- #( 0 1 1 0 ) { water-five }
- #( 0 0 0.35 1 0.5 0.2 0.9 1 1 0 ) { water-amp }
- #( 0 0 0.9 1 1 0 ) { water-damp }
-
- 0.00 beg f+ 0.170 4100 2000 0.20 water-one water-amp bird
- 0.32 beg f+ 0.180 4050 2050 0.30 water-one water-amp bird
- 0.64 beg f+ 0.200 4000 1900 0.25 water-one water-amp bird
- 0.90 beg f+ 0.200 3900 2000 0.30 water-two tap-amp bird
- 1.25 beg f+ 0.120 3000 3000 0.25 water-three water-damp bird
- 1.40 beg f+ 0.100 2700 1500 0.20 water-four water-damp bird
- 1.58 beg f+ 0.020 5200 1000 0.10 water-five main-amp bird
- 1.65 beg f+ 0.020 5200 1000 0.10 water-five main-amp bird
- 1.70 beg f+ 0.035 3200 1000 0.10 water-three water-damp bird
- 1.7 0.03 f+ step
+ { beg }
+ #( 0 0.8 0.35 0.4 0.45 0.9 0.5 1 0.75 1 1 1 ) { water-one }
+ #( 0 1 0.4 0 0.6 0.1 1 0.8 ) { water-two }
+ #( 0 1 0.95 0 1 0 ) { water-three }
+ #( 0 0 1 1 ) { water-four }
+ #( 0 1 1 0 ) { water-five }
+ #( 0 0 0.35 1 0.5 0.2 0.9 1 1 0 ) { water-amp }
+ #( 0 0 0.9 1 1 0 ) { water-damp }
+
+ 0.00 beg f+ 0.170 4100 2000 0.20 water-one water-amp bird
+ 0.32 beg f+ 0.180 4050 2050 0.30 water-one water-amp bird
+ 0.64 beg f+ 0.200 4000 1900 0.25 water-one water-amp bird
+ 0.90 beg f+ 0.200 3900 2000 0.30 water-two tap-amp bird
+ 1.25 beg f+ 0.120 3000 3000 0.25 water-three water-damp bird
+ 1.40 beg f+ 0.100 2700 1500 0.20 water-four water-damp bird
+ 1.58 beg f+ 0.020 5200 1000 0.10 water-five main-amp bird
+ 1.65 beg f+ 0.020 5200 1000 0.10 water-five main-amp bird
+ 1.70 beg f+ 0.035 3200 1000 0.10 water-three water-damp bird
+ 1.7 0.03 f+ step
;event
event: robin ( beg -- )
- 0.45 f- { beg }
- #( 0.00 0.10 0.08 0.70 0.30 0.00 0.35 1.00 0.40 0.30 1.00 0.30 ) { r-one }
- #( 0.00 0.00 0.10 1.00 0.20 0.70 0.35 0.70 0.65 0.30 0.70 0.50
- 0.80 0.00 0.90 0.20 1.00 0.00 ) { r-two }
- #( 0.00 0.20 0.25 1.00 0.60 0.70 0.90 0.00 1.00 0.10 ) { r-three }
- #( 0.00 0.50 0.10 0.00 0.20 1.00 0.30 0.00 0.40 1.00 0.50 0.00
- 0.60 1.00 0.70 0.50 1.00 0.20 ) { r-five }
- #( 0.00 0.00 0.12 0.70 0.30 0.00 0.70 1.00 1.00 0.50 ) { r-six }
-
- 0.45 beg f+ 0.06 2000 800 0.15 r-six main-amp #( 1 1 2 0.1 ) bigbird
- 0.56 beg f+ 0.10 2000 900 0.15 r-one main-amp #( 1 1 2 0.1 ) bigbird
- 1.04 beg f+ 0.24 2000 2000 0.25 r-two main-amp #( 1 1 2 0.1 ) bigbird
- 1.63 beg f+ 0.13 1900 1600 0.20 r-three main-amp #( 1 1 2 0.1 ) bigbird
- 1.80 beg f+ 0.11 2200 1200 0.25 bird-down main-amp #( 1 1 2 0.1 ) bigbird
- 2.31 beg f+ 0.21 1950 2000 0.15 r-five main-amp #( 1 1 2 0.1 ) bigbird
- 2.31 0.21 f+ step
+ 0.45 f- { beg }
+ #( 0.00 0.10 0.08 0.70 0.30 0.00
+ 0.35 1.00 0.40 0.30 1.00 0.30 ) { r-one }
+ #( 0.00 0.00 0.10 1.00 0.20 0.70 0.35 0.70 0.65 0.30 0.70 0.50
+ 0.80 0.00 0.90 0.20 1.00 0.00 ) { r-two }
+ #( 0.00 0.20 0.25 1.00 0.60 0.70 0.90 0.00 1.00 0.10 ) { r-three }
+ #( 0.00 0.50 0.10 0.00 0.20 1.00 0.30 0.00 0.40 1.00 0.50 0.00
+ 0.60 1.00 0.70 0.50 1.00 0.20 ) { r-five }
+ #( 0.00 0.00 0.12 0.70 0.30 0.00 0.70 1.00 1.00 0.50 ) { r-six }
+
+ 0.45 beg f+ 0.06 2000 800 0.15 r-six main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 0.56 beg f+ 0.10 2000 900 0.15 r-one main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 1.04 beg f+ 0.24 2000 2000 0.25 r-two main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 1.63 beg f+ 0.13 1900 1600 0.20 r-three main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 1.80 beg f+ 0.11 2200 1200 0.25 bird-down main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 2.31 beg f+ 0.21 1950 2000 0.15 r-five main-amp
+ #( 1 1 2 0.1 ) bigbird
+ 2.31 0.21 f+ step
;event
event: solitary-vireo ( beg -- )
- { beg }
- #( 0.00 0.20 0.03 0.30 0.06 0.10 0.10 0.50 0.13 0.40 0.16 0.80
- 0.19 0.50 0.22 0.90 0.25 0.60 0.28 1.00 0.31 0.60 0.34 1.00
- 0.37 0.50 0.41 0.90 0.45 0.40 0.49 0.80 0.51 0.40 0.54 0.75
- 0.57 0.35 0.60 0.70 0.63 0.30 0.66 0.60 0.69 0.25 0.72 0.50
- 0.75 0.20 0.78 0.30 0.82 0.10 0.85 0.30 0.88 0.05 0.91 0.30
- 0.94 0.00 0.95 0.30 0.99 0.00 1.00 0.10 ) { bigskew }
-
- beg 0.4 1800 1200 0.2 bigskew main-amp bird
- 0.4 step
+ { beg }
+ #( 0.00 0.20 0.03 0.30 0.06 0.10 0.10 0.50 0.13 0.40 0.16 0.80
+ 0.19 0.50 0.22 0.90 0.25 0.60 0.28 1.00 0.31 0.60 0.34 1.00
+ 0.37 0.50 0.41 0.90 0.45 0.40 0.49 0.80 0.51 0.40 0.54 0.75
+ 0.57 0.35 0.60 0.70 0.63 0.30 0.66 0.60 0.69 0.25 0.72 0.50
+ 0.75 0.20 0.78 0.30 0.82 0.10 0.85 0.30 0.88 0.05 0.91 0.30
+ 0.94 0.00 0.95 0.30 0.99 0.00 1.00 0.10 ) { bigskew }
+
+ beg 0.4 1800 1200 0.2 bigskew main-amp bird
+ 0.4 step
;event
event: pigeon-hawk ( beg -- )
- { beg }
- #( 0 0 0.3 1 0.7 1 1 0 ) { hupdown }
-
- 0.00 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 0.12 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 0.13 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 0.25 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 0.26 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 0.38 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 0.39 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 0.51 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 0.52 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 0.64 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 0.65 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 0.77 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 0.78 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 0.90 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 0.91 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 1.03 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 1.04 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 1.16 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 1.17 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 1.29 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 1.30 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 1.42 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 1.43 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 1.55 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 1.56 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 1.68 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 1.69 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 1.81 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
- 1.82 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
- 1.82 0.1 f+ step
+ { beg }
+ #( 0 0 0.3 1 0.7 1 1 0 ) { hupdown }
+
+ 0.00 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 0.12 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 0.13 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 0.25 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 0.26 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 0.38 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 0.39 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 0.51 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 0.52 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 0.64 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 0.65 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 0.77 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 0.78 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 0.90 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 0.91 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 1.03 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 1.04 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 1.16 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 1.17 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 1.29 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 1.30 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 1.42 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 1.43 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 1.55 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 1.56 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 1.68 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 1.69 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 1.81 beg f+ 0.01 2050 0 0.1 main-amp main-amp #( 1 0.5 2 1 ) bigbird
+ 1.82 beg f+ 0.10 1900 200 0.2 hupdown main-amp #( 1 0.7 2 1 ) bigbird
+ 1.82 0.1 f+ step
;event
event: cerulean-warbler ( beg -- )
- 0.27 f- { beg }
- #( 0 0.8 0.1 1 0.25 0.5 0.4 1 0.55 0.5 0.7 1 1 0 ) { trill }
-
- 0.27 beg f+ 0.05 3000 1000 0.050 bird-down main-amp bird
- 0.33 beg f+ 0.05 3000 800 0.075 bird-up main-amp bird
- 0.41 beg f+ 0.01 3200 700 0.070 bird-down main-amp bird
- 0.42 beg f+ 0.01 3200 700 0.080 bird-down main-amp bird
- 0.43 beg f+ 0.06 3200 700 0.090 bird-down main-amp bird
- 0.51 beg f+ 0.06 3200 500 0.100 bird-up main-amp bird
- 0.60 beg f+ 0.10 3000 1200 0.200 trill main-amp bird
- 0.72 beg f+ 0.05 3000 800 0.200 bird-up main-amp bird
- 0.80 beg f+ 0.10 3000 1200 0.200 trill main-amp bird
- 0.92 beg f+ 0.05 3000 800 0.200 bird-up main-amp bird
- 1.00 beg f+ 0.01 3900 600 0.100 bird-up main-amp bird
- 1.01 beg f+ 0.01 3910 800 0.100 bird-up main-amp bird
- 1.02 beg f+ 0.01 3940 500 0.100 bird-up main-amp bird
- 1.03 beg f+ 0.01 4000 500 0.100 bird-up main-amp bird
- 1.04 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.05 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.06 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.07 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.08 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.09 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.10 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.11 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.12 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.13 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.14 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.15 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.16 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.17 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.18 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.19 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.20 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.21 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.22 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
- 1.23 beg f+ 0.01 3900 1200 0.100 bird-up main-amp bird
- 1.24 beg f+ 0.01 3900 1200 0.100 bird-up main-amp bird
- 1.25 beg f+ 0.01 3900 1200 0.100 bird-up main-amp bird
- 1.26 beg f+ 0.01 3900 1200 0.100 bird-up main-amp bird
- 1.27 beg f+ 0.01 3900 1400 0.100 bird-up main-amp bird
- 1.28 beg f+ 0.01 3900 1400 0.100 bird-up main-amp bird
- 1.29 beg f+ 0.01 3900 1400 0.100 bird-up main-amp bird
- 1.30 beg f+ 0.01 3900 1400 0.100 bird-up main-amp bird
- 1.3 0.01 f+ step
+ 0.27 f- { beg }
+ #( 0 0.8 0.1 1 0.25 0.5 0.4 1 0.55 0.5 0.7 1 1 0 ) { trill }
+
+ 0.27 beg f+ 0.05 3000 1000 0.050 bird-down main-amp bird
+ 0.33 beg f+ 0.05 3000 800 0.075 bird-up main-amp bird
+ 0.41 beg f+ 0.01 3200 700 0.070 bird-down main-amp bird
+ 0.42 beg f+ 0.01 3200 700 0.080 bird-down main-amp bird
+ 0.43 beg f+ 0.06 3200 700 0.090 bird-down main-amp bird
+ 0.51 beg f+ 0.06 3200 500 0.100 bird-up main-amp bird
+ 0.60 beg f+ 0.10 3000 1200 0.200 trill main-amp bird
+ 0.72 beg f+ 0.05 3000 800 0.200 bird-up main-amp bird
+ 0.80 beg f+ 0.10 3000 1200 0.200 trill main-amp bird
+ 0.92 beg f+ 0.05 3000 800 0.200 bird-up main-amp bird
+ 1.00 beg f+ 0.01 3900 600 0.100 bird-up main-amp bird
+ 1.01 beg f+ 0.01 3910 800 0.100 bird-up main-amp bird
+ 1.02 beg f+ 0.01 3940 500 0.100 bird-up main-amp bird
+ 1.03 beg f+ 0.01 4000 500 0.100 bird-up main-amp bird
+ 1.04 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.05 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.06 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.07 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.08 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.09 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.10 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.11 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.12 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.13 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.14 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.15 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.16 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.17 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.18 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.19 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.20 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.21 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.22 beg f+ 0.01 3900 1000 0.100 bird-up main-amp bird
+ 1.23 beg f+ 0.01 3900 1200 0.100 bird-up main-amp bird
+ 1.24 beg f+ 0.01 3900 1200 0.100 bird-up main-amp bird
+ 1.25 beg f+ 0.01 3900 1200 0.100 bird-up main-amp bird
+ 1.26 beg f+ 0.01 3900 1200 0.100 bird-up main-amp bird
+ 1.27 beg f+ 0.01 3900 1400 0.100 bird-up main-amp bird
+ 1.28 beg f+ 0.01 3900 1400 0.100 bird-up main-amp bird
+ 1.29 beg f+ 0.01 3900 1400 0.100 bird-up main-amp bird
+ 1.30 beg f+ 0.01 3900 1400 0.100 bird-up main-amp bird
+ 1.3 0.01 f+ step
;event
event: nashville-warbler ( beg -- )
- 0.15 f- { beg }
- #( 0 0.6 0.35 1 1 0 ) { nash-blip }
- #( 0 0.9 0.05 1 0.1 0.9 0.65 0.5 1 0 ) { nash-down }
- #( 0 0 0.15 0.2 0.25 0.05 0.9 0.95 1 1 ) { nash-up }
- #( 0 0 0.8 1 1 0 ) { nash-amp }
-
- 0.15 beg f+ 0.025 3900 300 0.300 nash-blip main-amp bird
- 0.24 beg f+ 0.160 4200 3800 0.150 nash-down nash-amp bird
- 0.42 beg f+ 0.025 3900 300 0.300 nash-blip main-amp bird
- 0.55 beg f+ 0.140 4300 3700 0.150 nash-down nash-amp bird
- 0.75 beg f+ 0.030 3950 350 0.300 nash-blip main-amp bird
- 0.81 beg f+ 0.170 4200 3900 0.175 nash-down main-amp bird
- 1.00 beg f+ 0.020 3800 400 0.250 nash-blip main-amp bird
- 1.11 beg f+ 0.140 4200 3800 0.165 nash-down nash-amp bird
- 1.30 beg f+ 0.030 3750 300 0.200 nash-blip main-amp bird
- 1.40 beg f+ 0.110 4200 3700 0.100 nash-down main-amp bird
- 1.57 beg f+ 0.100 3800 2200 0.100 nash-up main-amp bird
- 1.70 beg f+ 0.100 3800 2150 0.125 nash-up main-amp bird
- 1.85 beg f+ 0.075 3900 1800 0.100 nash-up nash-amp bird
- 1.85 0.075 f+ step
+ 0.15 f- { beg }
+ #( 0 0.6 0.35 1 1 0 ) { nash-blip }
+ #( 0 0.9 0.05 1 0.1 0.9 0.65 0.5 1 0 ) { nash-down }
+ #( 0 0 0.15 0.2 0.25 0.05 0.9 0.95 1 1 ) { nash-up }
+ #( 0 0 0.8 1 1 0 ) { nash-amp }
+
+ 0.15 beg f+ 0.025 3900 300 0.300 nash-blip main-amp bird
+ 0.24 beg f+ 0.160 4200 3800 0.150 nash-down nash-amp bird
+ 0.42 beg f+ 0.025 3900 300 0.300 nash-blip main-amp bird
+ 0.55 beg f+ 0.140 4300 3700 0.150 nash-down nash-amp bird
+ 0.75 beg f+ 0.030 3950 350 0.300 nash-blip main-amp bird
+ 0.81 beg f+ 0.170 4200 3900 0.175 nash-down main-amp bird
+ 1.00 beg f+ 0.020 3800 400 0.250 nash-blip main-amp bird
+ 1.11 beg f+ 0.140 4200 3800 0.165 nash-down nash-amp bird
+ 1.30 beg f+ 0.030 3750 300 0.200 nash-blip main-amp bird
+ 1.40 beg f+ 0.110 4200 3700 0.100 nash-down main-amp bird
+ 1.57 beg f+ 0.100 3800 2200 0.100 nash-up main-amp bird
+ 1.70 beg f+ 0.100 3800 2150 0.125 nash-up main-amp bird
+ 1.85 beg f+ 0.075 3900 1800 0.100 nash-up nash-amp bird
+ 1.85 0.075 f+ step
;event
event: eastern-phoebe ( beg -- )
- { beg }
- #( 0 0 0.3 0.3 0.35 0.5 0.55 0.4 0.7 0.8 0.75 0.7 0.8 1 0.95 0.9 1 0 ) { phoebe-one }
- #( 0 0 0.5 1 1 0 ) { phoebe-two }
- #( 0 0 0.1 0.4 0.8 1 1 0.1 ) { phoebe-three }
- #( 0 1 0.5 0.7 1 0 ) { phoebe-four }
- #( 0 0 0.1 1 1 0 ) { phoebe-amp }
-
- 0.00 beg f+ 0.225 3000 1300 0.3 phoebe-one main-amp bird
- 0.35 beg f+ 0.120 3000 500 0.1 phoebe-two phoebe-amp bird
- 0.40 beg f+ 0.100 3000 1500 0.2 phoebe-three phoebe-amp bird
- 0.55 beg f+ 0.050 3000 1400 0.2 phoebe-four phoebe-amp bird
- 0.55 0.05 f+ step
+ { beg }
+ #( 0 0 0.3 0.3 0.35 0.5 0.55 0.4 0.7 0.8
+ 0.75 0.7 0.8 1 0.95 0.9 1 0 ) { phoebe-one }
+ #( 0 0 0.5 1 1 0 ) { phoebe-two }
+ #( 0 0 0.1 0.4 0.8 1 1 0.1 ) { phoebe-three }
+ #( 0 1 0.5 0.7 1 0 ) { phoebe-four }
+ #( 0 0 0.1 1 1 0 ) { phoebe-amp }
+
+ 0.00 beg f+ 0.225 3000 1300 0.3 phoebe-one main-amp bird
+ 0.35 beg f+ 0.120 3000 500 0.1 phoebe-two phoebe-amp bird
+ 0.40 beg f+ 0.100 3000 1500 0.2 phoebe-three phoebe-amp bird
+ 0.55 beg f+ 0.050 3000 1400 0.2 phoebe-four phoebe-amp bird
+ 0.55 0.05 f+ step
;event
event: painted-bunting ( beg -- )
- 0.05 f- { beg }
- #( 0 0 0.9 1 1 0 ) { b-two }
- #( 0 0 0.5 1 1 0 ) { b-four }
- #( 0 0.7 0.15 0 0.4 1 0.8 1 1 0.5 ) { b-five }
- #( 0 0 0.1 0.5 0.15 0 0.4 1 0.9 1 1 0 ) { b-six }
- #( 0 1 0.25 0.4 0.75 0.5 1 0 ) { b-seven }
- #( 0 0.3 0.4 0.4 0.5 1 0.6 0.2 1 0 ) { b-eight }
- #( 0 0 0.05 1 0.3 1 0.5 0.3 0.9 1 1 0 ) { b-nine }
- #( 0 0.4 0.25 0 0.35 1 0.5 0 0.65 1 0.75 0 0.85 1 1 0 ) { b-ten }
- #( 0 0 0.5 1 1 0.5 ) { b-twelve }
- #( 0 0 0.05 1 0.3 0.2 0.6 0.2 0.9 1 1 0 ) { b-thirteen }
- #( 0 0.3 0.3 1 0.6 0.3 1 0 ) { b-fourteen }
- #( 0 0 0.1 0.5 0.5 0.5 0.9 1 1 0 ) { b-fifteen }
-
- 0.05 beg f+ 0.10 3100 900 0.05 bird-up b-two bird
- 0.21 beg f+ 0.07 4100 700 0.15 bird-down main-amp bird
- 0.36 beg f+ 0.12 3700 1000 0.20 b-four main-amp bird
- 0.52 beg f+ 0.08 2300 1600 0.15 b-five b-six bird
- 0.68 beg f+ 0.10 4000 1000 0.25 bird-up tap-amp bird
- 0.80 beg f+ 0.12 2300 1700 0.20 b-seven main-amp bird
- 0.96 beg f+ 0.15 3800 2200 0.30 b-eight b-nine bird
- 1.18 beg f+ 0.10 2300 1600 0.15 b-ten main-amp bird
- 1.30 beg f+ 0.02 3200 1000 0.10 bird-down main-amp bird
- 1.33 beg f+ 0.02 3200 1000 0.10 bird-down main-amp bird
- 1.36 beg f+ 0.02 3200 1000 0.10 bird-down main-amp bird
- 1.40 beg f+ 0.03 4000 2000 0.12 b-twelve b-thirteen bird
- 1.47 beg f+ 0.10 2300 1700 0.20 b-fourteen b-fifteen bird
- 1.47 0.1 f+ step
+ 0.05 f- { beg }
+ #( 0 0 0.9 1 1 0 ) { b-two }
+ #( 0 0 0.5 1 1 0 ) { b-four }
+ #( 0 0.7 0.15 0 0.4 1 0.8 1 1 0.5 ) { b-five }
+ #( 0 0 0.1 0.5 0.15 0 0.4 1 0.9 1 1 0 ) { b-six }
+ #( 0 1 0.25 0.4 0.75 0.5 1 0 ) { b-seven }
+ #( 0 0.3 0.4 0.4 0.5 1 0.6 0.2 1 0 ) { b-eight }
+ #( 0 0 0.05 1 0.3 1 0.5 0.3 0.9 1 1 0 ) { b-nine }
+ #( 0 0.4 0.25 0 0.35 1 0.5 0 0.65 1 0.75 0 0.85 1 1 0 ) { b-ten }
+ #( 0 0 0.5 1 1 0.5 ) { b-twelve }
+ #( 0 0 0.05 1 0.3 0.2 0.6 0.2 0.9 1 1 0 ) { b-thirteen }
+ #( 0 0.3 0.3 1 0.6 0.3 1 0 ) { b-fourteen }
+ #( 0 0 0.1 0.5 0.5 0.5 0.9 1 1 0 ) { b-fifteen }
+
+ 0.05 beg f+ 0.10 3100 900 0.05 bird-up b-two bird
+ 0.21 beg f+ 0.07 4100 700 0.15 bird-down main-amp bird
+ 0.36 beg f+ 0.12 3700 1000 0.20 b-four main-amp bird
+ 0.52 beg f+ 0.08 2300 1600 0.15 b-five b-six bird
+ 0.68 beg f+ 0.10 4000 1000 0.25 bird-up tap-amp bird
+ 0.80 beg f+ 0.12 2300 1700 0.20 b-seven main-amp bird
+ 0.96 beg f+ 0.15 3800 2200 0.30 b-eight b-nine bird
+ 1.18 beg f+ 0.10 2300 1600 0.15 b-ten main-amp bird
+ 1.30 beg f+ 0.02 3200 1000 0.10 bird-down main-amp bird
+ 1.33 beg f+ 0.02 3200 1000 0.10 bird-down main-amp bird
+ 1.36 beg f+ 0.02 3200 1000 0.10 bird-down main-amp bird
+ 1.40 beg f+ 0.03 4000 2000 0.12 b-twelve b-thirteen bird
+ 1.47 beg f+ 0.10 2300 1700 0.20 b-fourteen b-fifteen bird
+ 1.47 0.1 f+ step
;event
event: western-flycatcher ( beg -- )
- { beg }
- #( 0 0 0.1 1 0.2 0.4 0.95 0.1 1 0 ) { f-one }
- #( 0 0 0.1 0.2 0.2 0.1 0.3 1 0.9 1 1 0 ) { a-one }
- #( 0 0.5 0.25 1 0.5 0 0.6 0 0.95 0.3 1 0.6 ) { f-two }
- #( 0 0 0.1 1 0.2 1 0.5 0.1 0.6 0.1 0.9 1 1 0 ) { a-two }
- #( 1 1 2 0.02 3 0.1 4 0.01 ) { fc-parts }
-
- 0.0 beg f+ 0.2 2000 2200 0.2 f-one a-one fc-parts bigbird
- 0.3 beg f+ 0.2 2000 1100 0.2 f-two a-two fc-parts bigbird
- 0.3 0.2 f+ step
+ { beg }
+ #( 0 0 0.1 1 0.2 0.4 0.95 0.1 1 0 ) { f-one }
+ #( 0 0 0.1 0.2 0.2 0.1 0.3 1 0.9 1 1 0 ) { a-one }
+ #( 0 0.5 0.25 1 0.5 0 0.6 0 0.95 0.3 1 0.6 ) { f-two }
+ #( 0 0 0.1 1 0.2 1 0.5 0.1 0.6 0.1 0.9 1 1 0 ) { a-two }
+ #( 1 1 2 0.02 3 0.1 4 0.01 ) { fc-parts }
+
+ 0.0 beg f+ 0.2 2000 2200 0.2 f-one a-one fc-parts bigbird
+ 0.3 beg f+ 0.2 2000 1100 0.2 f-two a-two fc-parts bigbird
+ 0.3 0.2 f+ step
;event
event: bachmans-sparrow ( beg -- )
- { beg }
- #( 0 1 0.1 0.5 0.9 0.5 1 0 ) { sopening }
- #( 0 0.1 0.35 0 1 1 ) { sup }
- #( 0 1 0.4 0.5 1 0 ) { sdwn }
- #( 0 1 0.25 0 0.75 0.4 1 0.5 ) { slast }
-
- 0.00 beg f+ 0.510 4900 200 0.3 sopening main-amp bird
- 0.52 beg f+ 0.015 3800 200 0.1 sup main-amp bird
- 0.52 beg f+ 0.015 3750 250 0.1 sup main-amp bird
- 0.54 beg f+ 0.015 3600 300 0.1 sup main-amp bird
- 0.56 beg f+ 0.015 3500 250 0.1 sup main-amp bird
- 0.58 beg f+ 0.015 3400 200 0.1 sup main-amp bird
- 0.60 beg f+ 0.015 3200 200 0.1 sup main-amp bird
- 0.62 beg f+ 0.015 3800 100 0.1 sup main-amp bird
- 0.65 beg f+ 0.070 3000 750 0.2 sup main-amp bird
- 0.73 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
- 0.80 beg f+ 0.070 3000 750 0.2 sup main-amp bird
- 0.88 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
- 0.95 beg f+ 0.070 3000 750 0.2 sup main-amp bird
- 1.03 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
- 1.10 beg f+ 0.070 3000 750 0.2 sup main-amp bird
- 1.18 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
- 1.25 beg f+ 0.070 3000 750 0.2 sup main-amp bird
- 1.33 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
- 1.40 beg f+ 0.070 3000 750 0.2 sup main-amp bird
- 1.48 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
- 1.55 beg f+ 0.070 3000 750 0.2 sup main-amp bird
- 1.63 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
- 2.80 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
- 2.87 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
- 2.90 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
- 2.97 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
- 3.00 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
- 3.07 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
- 3.10 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
- 3.17 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
- 3.20 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
- 3.27 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
- 3.40 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
- 3.60 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
- 3.80 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
- 4.00 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
- 4.20 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
- 4.40 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
- 4.4 0.15 f+ step
+ { beg }
+ #( 0 1 0.1 0.5 0.9 0.5 1 0 ) { sopening }
+ #( 0 0.1 0.35 0 1 1 ) { sup }
+ #( 0 1 0.4 0.5 1 0 ) { sdwn }
+ #( 0 1 0.25 0 0.75 0.4 1 0.5 ) { slast }
+
+ 0.00 beg f+ 0.510 4900 200 0.3 sopening main-amp bird
+ 0.52 beg f+ 0.015 3800 200 0.1 sup main-amp bird
+ 0.52 beg f+ 0.015 3750 250 0.1 sup main-amp bird
+ 0.54 beg f+ 0.015 3600 300 0.1 sup main-amp bird
+ 0.56 beg f+ 0.015 3500 250 0.1 sup main-amp bird
+ 0.58 beg f+ 0.015 3400 200 0.1 sup main-amp bird
+ 0.60 beg f+ 0.015 3200 200 0.1 sup main-amp bird
+ 0.62 beg f+ 0.015 3800 100 0.1 sup main-amp bird
+ 0.65 beg f+ 0.070 3000 750 0.2 sup main-amp bird
+ 0.73 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
+ 0.80 beg f+ 0.070 3000 750 0.2 sup main-amp bird
+ 0.88 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
+ 0.95 beg f+ 0.070 3000 750 0.2 sup main-amp bird
+ 1.03 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
+ 1.10 beg f+ 0.070 3000 750 0.2 sup main-amp bird
+ 1.18 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
+ 1.25 beg f+ 0.070 3000 750 0.2 sup main-amp bird
+ 1.33 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
+ 1.40 beg f+ 0.070 3000 750 0.2 sup main-amp bird
+ 1.48 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
+ 1.55 beg f+ 0.070 3000 750 0.2 sup main-amp bird
+ 1.63 beg f+ 0.030 5000 1000 0.1 sdwn main-amp bird
+ 2.80 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
+ 2.87 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
+ 2.90 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
+ 2.97 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
+ 3.00 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
+ 3.07 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
+ 3.10 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
+ 3.17 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
+ 3.20 beg f+ 0.060 4000 1700 0.1 bird-up main-amp bird
+ 3.27 beg f+ 0.010 5200 0 0.2 bird-up main-amp bird
+ 3.40 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
+ 3.60 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
+ 3.80 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
+ 4.00 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
+ 4.20 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
+ 4.40 beg f+ 0.150 3000 1000 0.2 slast main-amp bird
+ 4.4 0.15 f+ step
;event
event: cedar-waxwing ( beg -- )
- { beg }
- #( 0 0 0.25 0.7 0.7 1 0.9 1 1 0.2 ) { cedar }
- #( 0 0 0.2 1 0.4 1 1 0 ) { cedamp }
+ { beg }
+ #( 0 0 0.25 0.7 0.7 1 0.9 1 1 0.2 ) { cedar }
+ #( 0 0 0.2 1 0.4 1 1 0 ) { cedamp }
- beg 0.5 6000 800 0.2 cedar cedamp bird
- 0.5 step
+ beg 0.5 6000 800 0.2 cedar cedamp bird
+ 0.5 step
;event
event: bairds-sparrow ( beg -- )
- { beg }
- #( 0 0 0.25 1 0.5 0 0.75 1 1 0 ) { bairdend }
- #( 0.00 0.50 0.05 1.00 0.10 0.00 0.15 1.00 0.20 0.00 0.25 1.00
- 0.30 0.00 0.35 1.00 0.40 0.00 0.45 1.00 0.50 0.00 0.55 1.00
- 0.60 0.00 0.65 1.00 0.70 0.00 0.75 1.00 0.80 0.00 0.85 1.00
- 0.90 0.00 0.95 1.00 1.00 0.00 ) { bairdstart }
-
- 0.00 beg f+ 0.09 6500 1500 0.20 bairdstart main-amp bird
- 0.22 beg f+ 0.01 5900 100 0.20 bairdend main-amp bird
- 0.25 beg f+ 0.09 6000 1000 0.20 bairdstart main-amp bird
- 0.45 beg f+ 0.01 4200 100 0.20 bairdend main-amp bird
- 0.50 beg f+ 0.08 4200 600 0.20 bairdstart main-amp bird
- 0.59 beg f+ 0.01 4400 100 0.20 bairdend main-amp bird
- 0.60 beg f+ 0.01 4400 100 0.20 bairdend main-amp bird
- 0.68 beg f+ 0.07 5400 700 0.20 bairdstart main-amp bird
- 0.75 beg f+ 0.01 4200 100 0.20 bairdend main-amp bird
- 0.79 beg f+ 0.01 4400 100 0.20 bairdend main-amp bird
- 0.83 beg f+ 0.01 4200 100 0.19 bairdend main-amp bird
- 0.87 beg f+ 0.01 4400 100 0.19 bairdend main-amp bird
- 0.91 beg f+ 0.01 4200 100 0.18 bairdend main-amp bird
- 0.95 beg f+ 0.01 4400 100 0.18 bairdend main-amp bird
- 0.99 beg f+ 0.01 4200 100 0.17 bairdend main-amp bird
- 1.03 beg f+ 0.01 4400 100 0.17 bairdend main-amp bird
- 1.07 beg f+ 0.01 4200 100 0.16 bairdend main-amp bird
- 1.11 beg f+ 0.01 4400 100 0.16 bairdend main-amp bird
- 1.15 beg f+ 0.01 4200 100 0.15 bairdend main-amp bird
- 1.19 beg f+ 0.01 4400 100 0.15 bairdend main-amp bird
- 1.23 beg f+ 0.01 4200 100 0.14 bairdend main-amp bird
- 1.27 beg f+ 0.01 4400 100 0.14 bairdend main-amp bird
- 1.31 beg f+ 0.01 4200 100 0.13 bairdend main-amp bird
- 1.35 beg f+ 0.01 4400 100 0.13 bairdend main-amp bird
- 1.39 beg f+ 0.01 4200 100 0.12 bairdend main-amp bird
- 1.43 beg f+ 0.01 4400 100 0.12 bairdend main-amp bird
- 1.47 beg f+ 0.01 4200 100 0.11 bairdend main-amp bird
- 1.51 beg f+ 0.01 4400 100 0.11 bairdend main-amp bird
- 1.55 beg f+ 0.01 4200 100 0.10 bairdend main-amp bird
- 1.59 beg f+ 0.01 4400 100 0.10 bairdend main-amp bird
- 1.63 beg f+ 0.01 4200 100 0.09 bairdend main-amp bird
- 1.67 beg f+ 0.01 4400 100 0.09 bairdend main-amp bird
- 1.71 beg f+ 0.01 4200 100 0.08 bairdend main-amp bird
- 1.75 beg f+ 0.01 4400 100 0.08 bairdend main-amp bird
- 1.79 beg f+ 0.01 4200 100 0.07 bairdend main-amp bird
- 1.83 beg f+ 0.01 4400 100 0.07 bairdend main-amp bird
- 1.87 beg f+ 0.01 4200 100 0.06 bairdend main-amp bird
- 1.92 beg f+ 0.01 4400 100 0.06 bairdend main-amp bird
- 1.97 beg f+ 0.01 4200 100 0.05 bairdend main-amp bird
- 1.97 0.01 f+ step
+ { beg }
+ #( 0 0 0.25 1 0.5 0 0.75 1 1 0 ) { bairdend }
+ #( 0.00 0.50 0.05 1.00 0.10 0.00 0.15 1.00 0.20 0.00 0.25 1.00
+ 0.30 0.00 0.35 1.00 0.40 0.00 0.45 1.00 0.50 0.00 0.55 1.00
+ 0.60 0.00 0.65 1.00 0.70 0.00 0.75 1.00 0.80 0.00 0.85 1.00
+ 0.90 0.00 0.95 1.00 1.00 0.00 ) { bairdstart }
+
+ 0.00 beg f+ 0.09 6500 1500 0.20 bairdstart main-amp bird
+ 0.22 beg f+ 0.01 5900 100 0.20 bairdend main-amp bird
+ 0.25 beg f+ 0.09 6000 1000 0.20 bairdstart main-amp bird
+ 0.45 beg f+ 0.01 4200 100 0.20 bairdend main-amp bird
+ 0.50 beg f+ 0.08 4200 600 0.20 bairdstart main-amp bird
+ 0.59 beg f+ 0.01 4400 100 0.20 bairdend main-amp bird
+ 0.60 beg f+ 0.01 4400 100 0.20 bairdend main-amp bird
+ 0.68 beg f+ 0.07 5400 700 0.20 bairdstart main-amp bird
+ 0.75 beg f+ 0.01 4200 100 0.20 bairdend main-amp bird
+ 0.79 beg f+ 0.01 4400 100 0.20 bairdend main-amp bird
+ 0.83 beg f+ 0.01 4200 100 0.19 bairdend main-amp bird
+ 0.87 beg f+ 0.01 4400 100 0.19 bairdend main-amp bird
+ 0.91 beg f+ 0.01 4200 100 0.18 bairdend main-amp bird
+ 0.95 beg f+ 0.01 4400 100 0.18 bairdend main-amp bird
+ 0.99 beg f+ 0.01 4200 100 0.17 bairdend main-amp bird
+ 1.03 beg f+ 0.01 4400 100 0.17 bairdend main-amp bird
+ 1.07 beg f+ 0.01 4200 100 0.16 bairdend main-amp bird
+ 1.11 beg f+ 0.01 4400 100 0.16 bairdend main-amp bird
+ 1.15 beg f+ 0.01 4200 100 0.15 bairdend main-amp bird
+ 1.19 beg f+ 0.01 4400 100 0.15 bairdend main-amp bird
+ 1.23 beg f+ 0.01 4200 100 0.14 bairdend main-amp bird
+ 1.27 beg f+ 0.01 4400 100 0.14 bairdend main-amp bird
+ 1.31 beg f+ 0.01 4200 100 0.13 bairdend main-amp bird
+ 1.35 beg f+ 0.01 4400 100 0.13 bairdend main-amp bird
+ 1.39 beg f+ 0.01 4200 100 0.12 bairdend main-amp bird
+ 1.43 beg f+ 0.01 4400 100 0.12 bairdend main-amp bird
+ 1.47 beg f+ 0.01 4200 100 0.11 bairdend main-amp bird
+ 1.51 beg f+ 0.01 4400 100 0.11 bairdend main-amp bird
+ 1.55 beg f+ 0.01 4200 100 0.10 bairdend main-amp bird
+ 1.59 beg f+ 0.01 4400 100 0.10 bairdend main-amp bird
+ 1.63 beg f+ 0.01 4200 100 0.09 bairdend main-amp bird
+ 1.67 beg f+ 0.01 4400 100 0.09 bairdend main-amp bird
+ 1.71 beg f+ 0.01 4200 100 0.08 bairdend main-amp bird
+ 1.75 beg f+ 0.01 4400 100 0.08 bairdend main-amp bird
+ 1.79 beg f+ 0.01 4200 100 0.07 bairdend main-amp bird
+ 1.83 beg f+ 0.01 4400 100 0.07 bairdend main-amp bird
+ 1.87 beg f+ 0.01 4200 100 0.06 bairdend main-amp bird
+ 1.92 beg f+ 0.01 4400 100 0.06 bairdend main-amp bird
+ 1.97 beg f+ 0.01 4200 100 0.05 bairdend main-amp bird
+ 1.97 0.01 f+ step
;event
event: kentucky-warbler ( beg -- )
- 0.6 f- { beg }
- #( 0 0.3 0.5 1 1 0 ) { kenstart }
- #( 0 0.9 0.1 1 1 0 ) { kendwn }
- #( 0 1 0.25 0 0.5 0 0.75 1 1 0 ) { kentrill }
- #( 1 1 2 0.1 ) { ken-parts-1 }
- #( 1 1 2 0.01 ) { ken-parts-01 }
- #( 1 1 2 0.03 ) { ken-parts-03 }
-
- 0.60 beg f+ 0.02 3800 200 0.05 kenstart main-amp ken-parts-03 bigbird
- 0.65 beg f+ 0.03 4300 200 0.15 bird-up main-amp ken-parts-1 bigbird
- 0.73 beg f+ 0.02 3200 100 0.10 kendwn main-amp ken-parts-1 bigbird
- 0.75 beg f+ 0.05 3000 800 0.15 kenstart main-amp ken-parts-01 bigbird
- 0.82 beg f+ 0.06 3100 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 0.90 beg f+ 0.06 3200 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 0.98 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
- 1.10 beg f+ 0.05 2900 800 0.15 kenstart main-amp ken-parts-01 bigbird
- 1.17 beg f+ 0.06 3000 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 1.25 beg f+ 0.06 3100 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 1.33 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
- 1.43 beg f+ 0.05 2800 800 0.15 kenstart main-amp ken-parts-01 bigbird
- 1.50 beg f+ 0.05 2700 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 1.57 beg f+ 0.06 2800 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 1.64 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
- 1.75 beg f+ 0.05 2700 800 0.15 kenstart main-amp ken-parts-01 bigbird
- 1.81 beg f+ 0.05 2600 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 1.88 beg f+ 0.06 2600 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 1.97 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
- 2.05 beg f+ 0.05 2700 800 0.15 kenstart main-amp ken-parts-01 bigbird
- 2.12 beg f+ 0.06 2600 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 2.20 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
- 2.30 beg f+ 0.05 2800 800 0.15 kenstart main-amp ken-parts-01 bigbird
- 2.37 beg f+ 0.06 2700 1200 0.10 kendwn main-amp ken-parts-01 bigbird
- 2.45 beg f+ 0.05 4700 100 0.25 kentrill main-amp ken-parts-1 bigbird
- 2.45 0.05 f+ step
+ 0.6 f- { beg }
+ #( 0 0.3 0.5 1 1 0 ) { kenstart }
+ #( 0 0.9 0.1 1 1 0 ) { kendwn }
+ #( 0 1 0.25 0 0.5 0 0.75 1 1 0 ) { kentrill }
+ #( 1 1 2 0.1 ) { ken-parts-1 }
+ #( 1 1 2 0.01 ) { ken-parts-01 }
+ #( 1 1 2 0.03 ) { ken-parts-03 }
+
+ 0.60 beg f+ 0.02 3800 200 0.05 kenstart main-amp ken-parts-03 bigbird
+ 0.65 beg f+ 0.03 4300 200 0.15 bird-up main-amp ken-parts-1 bigbird
+ 0.73 beg f+ 0.02 3200 100 0.10 kendwn main-amp ken-parts-1 bigbird
+ 0.75 beg f+ 0.05 3000 800 0.15 kenstart main-amp ken-parts-01 bigbird
+ 0.82 beg f+ 0.06 3100 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 0.90 beg f+ 0.06 3200 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 0.98 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
+ 1.10 beg f+ 0.05 2900 800 0.15 kenstart main-amp ken-parts-01 bigbird
+ 1.17 beg f+ 0.06 3000 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 1.25 beg f+ 0.06 3100 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 1.33 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
+ 1.43 beg f+ 0.05 2800 800 0.15 kenstart main-amp ken-parts-01 bigbird
+ 1.50 beg f+ 0.05 2700 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 1.57 beg f+ 0.06 2800 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 1.64 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
+ 1.75 beg f+ 0.05 2700 800 0.15 kenstart main-amp ken-parts-01 bigbird
+ 1.81 beg f+ 0.05 2600 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 1.88 beg f+ 0.06 2600 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 1.97 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
+ 2.05 beg f+ 0.05 2700 800 0.15 kenstart main-amp ken-parts-01 bigbird
+ 2.12 beg f+ 0.06 2600 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 2.20 beg f+ 0.05 4600 100 0.20 kentrill main-amp ken-parts-1 bigbird
+ 2.30 beg f+ 0.05 2800 800 0.15 kenstart main-amp ken-parts-01 bigbird
+ 2.37 beg f+ 0.06 2700 1200 0.10 kendwn main-amp ken-parts-01 bigbird
+ 2.45 beg f+ 0.05 4700 100 0.25 kentrill main-amp ken-parts-1 bigbird
+ 2.45 0.05 f+ step
;event
event: rufous-sided-towhee ( beg -- )
- 0.25 f- { beg }
- #( 0.00 0.10 0.02 0.05 0.04 0.15 0.06 0.05 0.08 0.20 0.10 0.04
- 0.12 0.25 0.14 0.03 0.16 0.30 0.18 0.02 0.20 0.35 0.22 0.01
- 0.24 0.40 0.26 0.00 0.28 0.45 0.30 0.00 0.32 0.50 0.34 0.00
- 0.36 0.50 0.80 1.00 1.00 0.00 ) { towhee-one }
- #( 1 0.03 2 1 3 0.03 ) { towhee-parts }
-
- 0.250 beg f+ 0.13 1400 1100 0.20 towhee-one main-amp towhee-parts bigbird
- 0.450 beg f+ 0.13 1400 1100 0.20 towhee-one main-amp towhee-parts bigbird
- 0.600 beg f+ 0.13 1400 1100 0.20 towhee-one main-amp towhee-parts bigbird
- 0.750 beg f+ 0.10 1400 1100 0.20 towhee-one main-amp towhee-parts bigbird
- 0.880 beg f+ 0.01 5100 2000 0.10 bird-up main-amp bird
- 0.895 beg f+ 0.01 5100 1600 0.10 bird-up main-amp bird
- 0.910 beg f+ 0.01 5100 1000 0.10 bird-up main-amp bird
- 0.930 beg f+ 0.01 3000 1200 0.10 bird-down main-amp bird
- 0.945 beg f+ 0.01 5100 2000 0.09 bird-up main-amp bird
- 0.960 beg f+ 0.01 5100 1600 0.09 bird-up main-amp bird
- 0.975 beg f+ 0.01 5100 1000 0.09 bird-up main-amp bird
- 0.995 beg f+ 0.01 3000 1200 0.09 bird-down main-amp bird
- 1.010 beg f+ 0.01 5100 2000 0.10 bird-up main-amp bird
- 1.025 beg f+ 0.01 5100 1600 0.10 bird-up main-amp bird
- 1.040 beg f+ 0.01 5100 1000 0.10 bird-up main-amp bird
- 1.060 beg f+ 0.01 3000 1200 0.10 bird-down main-amp bird
- 1.075 beg f+ 0.01 5100 2000 0.09 bird-up main-amp bird
- 1.090 beg f+ 0.01 5100 1600 0.09 bird-up main-amp bird
- 1.105 beg f+ 0.01 5100 1000 0.09 bird-up main-amp bird
- 1.125 beg f+ 0.01 3000 1200 0.09 bird-down main-amp bird
- 1.140 beg f+ 0.01 5100 2000 0.08 bird-up main-amp bird
- 1.155 beg f+ 0.01 5100 1600 0.08 bird-up main-amp bird
- 1.170 beg f+ 0.01 5100 1000 0.08 bird-up main-amp bird
- 1.190 beg f+ 0.01 3000 1200 0.08 bird-down main-amp bird
- 1.205 beg f+ 0.01 5100 2000 0.08 bird-up main-amp bird
- 1.220 beg f+ 0.01 5100 1600 0.08 bird-up main-amp bird
- 1.235 beg f+ 0.01 5100 1000 0.08 bird-up main-amp bird
- 1.255 beg f+ 0.01 3000 1200 0.08 bird-down main-amp bird
- 1.270 beg f+ 0.01 5100 2000 0.07 bird-up main-amp bird
- 1.285 beg f+ 0.01 5100 1600 0.07 bird-up main-amp bird
- 1.300 beg f+ 0.01 5100 1000 0.07 bird-up main-amp bird
- 1.320 beg f+ 0.01 3000 1200 0.07 bird-down main-amp bird
- 1.335 beg f+ 0.01 5100 2000 0.06 bird-up main-amp bird
- 1.350 beg f+ 0.01 5100 1600 0.06 bird-up main-amp bird
- 1.365 beg f+ 0.01 5100 1000 0.06 bird-up main-amp bird
- 1.385 beg f+ 0.01 3000 1200 0.06 bird-down main-amp bird
- 1.400 beg f+ 0.01 5100 2000 0.05 bird-up main-amp bird
- 1.415 beg f+ 0.01 5100 1600 0.05 bird-up main-amp bird
- 1.430 beg f+ 0.01 5100 1000 0.05 bird-up main-amp bird
- 1.450 beg f+ 0.01 3000 1200 0.05 bird-down main-amp bird
- 1.465 beg f+ 0.01 5100 2000 0.03 bird-up main-amp bird
- 1.480 beg f+ 0.01 5100 1600 0.03 bird-up main-amp bird
- 1.495 beg f+ 0.01 5100 1000 0.03 bird-up main-amp bird
- 1.515 beg f+ 0.01 3000 1200 0.03 bird-down main-amp bird
- 1.515 0.01 f+ step
+ 0.25 f- { beg }
+ #( 0.00 0.10 0.02 0.05 0.04 0.15 0.06 0.05 0.08 0.20 0.10 0.04
+ 0.12 0.25 0.14 0.03 0.16 0.30 0.18 0.02 0.20 0.35 0.22 0.01
+ 0.24 0.40 0.26 0.00 0.28 0.45 0.30 0.00 0.32 0.50 0.34 0.00
+ 0.36 0.50 0.80 1.00 1.00 0.00 ) { towhee-one }
+ #( 1 0.03 2 1 3 0.03 ) { towhee-parts }
+
+ 0.250 beg f+ 0.13 1400 1100 0.20 towhee-one main-amp
+ towhee-parts bigbird
+ 0.450 beg f+ 0.13 1400 1100 0.20 towhee-one main-amp
+ towhee-parts bigbird
+ 0.600 beg f+ 0.13 1400 1100 0.20 towhee-one main-amp
+ towhee-parts bigbird
+ 0.750 beg f+ 0.10 1400 1100 0.20 towhee-one main-amp
+ towhee-parts bigbird
+ 0.880 beg f+ 0.01 5100 2000 0.10 bird-up main-amp bird
+ 0.895 beg f+ 0.01 5100 1600 0.10 bird-up main-amp bird
+ 0.910 beg f+ 0.01 5100 1000 0.10 bird-up main-amp bird
+ 0.930 beg f+ 0.01 3000 1200 0.10 bird-down main-amp bird
+ 0.945 beg f+ 0.01 5100 2000 0.09 bird-up main-amp bird
+ 0.960 beg f+ 0.01 5100 1600 0.09 bird-up main-amp bird
+ 0.975 beg f+ 0.01 5100 1000 0.09 bird-up main-amp bird
+ 0.995 beg f+ 0.01 3000 1200 0.09 bird-down main-amp bird
+ 1.010 beg f+ 0.01 5100 2000 0.10 bird-up main-amp bird
+ 1.025 beg f+ 0.01 5100 1600 0.10 bird-up main-amp bird
+ 1.040 beg f+ 0.01 5100 1000 0.10 bird-up main-amp bird
+ 1.060 beg f+ 0.01 3000 1200 0.10 bird-down main-amp bird
+ 1.075 beg f+ 0.01 5100 2000 0.09 bird-up main-amp bird
+ 1.090 beg f+ 0.01 5100 1600 0.09 bird-up main-amp bird
+ 1.105 beg f+ 0.01 5100 1000 0.09 bird-up main-amp bird
+ 1.125 beg f+ 0.01 3000 1200 0.09 bird-down main-amp bird
+ 1.140 beg f+ 0.01 5100 2000 0.08 bird-up main-amp bird
+ 1.155 beg f+ 0.01 5100 1600 0.08 bird-up main-amp bird
+ 1.170 beg f+ 0.01 5100 1000 0.08 bird-up main-amp bird
+ 1.190 beg f+ 0.01 3000 1200 0.08 bird-down main-amp bird
+ 1.205 beg f+ 0.01 5100 2000 0.08 bird-up main-amp bird
+ 1.220 beg f+ 0.01 5100 1600 0.08 bird-up main-amp bird
+ 1.235 beg f+ 0.01 5100 1000 0.08 bird-up main-amp bird
+ 1.255 beg f+ 0.01 3000 1200 0.08 bird-down main-amp bird
+ 1.270 beg f+ 0.01 5100 2000 0.07 bird-up main-amp bird
+ 1.285 beg f+ 0.01 5100 1600 0.07 bird-up main-amp bird
+ 1.300 beg f+ 0.01 5100 1000 0.07 bird-up main-amp bird
+ 1.320 beg f+ 0.01 3000 1200 0.07 bird-down main-amp bird
+ 1.335 beg f+ 0.01 5100 2000 0.06 bird-up main-amp bird
+ 1.350 beg f+ 0.01 5100 1600 0.06 bird-up main-amp bird
+ 1.365 beg f+ 0.01 5100 1000 0.06 bird-up main-amp bird
+ 1.385 beg f+ 0.01 3000 1200 0.06 bird-down main-amp bird
+ 1.400 beg f+ 0.01 5100 2000 0.05 bird-up main-amp bird
+ 1.415 beg f+ 0.01 5100 1600 0.05 bird-up main-amp bird
+ 1.430 beg f+ 0.01 5100 1000 0.05 bird-up main-amp bird
+ 1.450 beg f+ 0.01 3000 1200 0.05 bird-down main-amp bird
+ 1.465 beg f+ 0.01 5100 2000 0.03 bird-up main-amp bird
+ 1.480 beg f+ 0.01 5100 1600 0.03 bird-up main-amp bird
+ 1.495 beg f+ 0.01 5100 1000 0.03 bird-up main-amp bird
+ 1.515 beg f+ 0.01 3000 1200 0.03 bird-down main-amp bird
+ 1.515 0.01 f+ step
;event
event: prothonotary-warbler ( beg -- )
- 0.76 f- { beg }
- #( 0 0.1 0.2 0 1 1 ) { pro-one }
- #( 0 0 0.2 1 0.4 0.5 1 0 ) { pro-amp }
+ 0.76 f- { beg }
+ #( 0 0.1 0.2 0 1 1 ) { pro-one }
+ #( 0 0 0.2 1 0.4 0.5 1 0 ) { pro-amp }
- 0.76 beg f+ 0.08 3000 3000 0.05 pro-one pro-amp bird
- 0.85 beg f+ 0.05 4000 2500 0.06 bird-up bird-amp bird
- 1.02 beg f+ 0.08 3000 3000 0.10 pro-one pro-amp bird
- 1.12 beg f+ 0.05 4000 2500 0.10 bird-up bird-amp bird
+ 0.76 beg f+ 0.08 3000 3000 0.05 pro-one pro-amp bird
+ 0.85 beg f+ 0.05 4000 2500 0.06 bird-up bird-amp bird
+ 1.02 beg f+ 0.08 3000 3000 0.10 pro-one pro-amp bird
+ 1.12 beg f+ 0.05 4000 2500 0.10 bird-up bird-amp bird
- 1.26 beg f+ 0.08 3000 3000 0.15 pro-one pro-amp bird
- 1.35 beg f+ 0.05 4000 2500 0.16 bird-up bird-amp bird
+ 1.26 beg f+ 0.08 3000 3000 0.15 pro-one pro-amp bird
+ 1.35 beg f+ 0.05 4000 2500 0.16 bird-up bird-amp bird
- 1.54 beg f+ 0.08 3000 3000 0.20 pro-one pro-amp bird
- 1.63 beg f+ 0.05 4000 2500 0.19 bird-up bird-amp bird
+ 1.54 beg f+ 0.08 3000 3000 0.20 pro-one pro-amp bird
+ 1.63 beg f+ 0.05 4000 2500 0.19 bird-up bird-amp bird
- 1.80 beg f+ 0.08 3000 3000 0.20 pro-one pro-amp bird
- 1.89 beg f+ 0.05 4000 2500 0.16 bird-up bird-amp bird
+ 1.80 beg f+ 0.08 3000 3000 0.20 pro-one pro-amp bird
+ 1.89 beg f+ 0.05 4000 2500 0.16 bird-up bird-amp bird
- 2.03 beg f+ 0.08 3000 3000 0.15 pro-one pro-amp bird
- 2.12 beg f+ 0.05 4000 2500 0.10 bird-up bird-amp bird
+ 2.03 beg f+ 0.08 3000 3000 0.15 pro-one pro-amp bird
+ 2.12 beg f+ 0.05 4000 2500 0.10 bird-up bird-amp bird
- 2.30 beg f+ 0.08 3000 3000 0.10 pro-one pro-amp bird
- 2.39 beg f+ 0.05 4000 2500 0.06 bird-up bird-amp bird
- 2.39 0.05 f+ step
+ 2.30 beg f+ 0.08 3000 3000 0.10 pro-one pro-amp bird
+ 2.39 beg f+ 0.05 4000 2500 0.06 bird-up bird-amp bird
+ 2.39 0.05 f+ step
;event
event: audubons-warbler ( beg -- )
- 0.75 f- { beg }
- #( 0 0 0.15 1 0.45 0.9 0.5 0 0.55 1 0.9 0.9 1 1 ) { w-end }
- #( 0 0.1 0.5 1 1 0 ) { w-updown }
-
- 0.75 beg f+ 0.04 2400 200 0.05 bird-down bird-amp bird
- 0.83 beg f+ 0.03 3200 200 0.10 bird-up bird-amp bird
- 0.90 beg f+ 0.04 2500 300 0.15 bird-up bird-amp bird
- 0.97 beg f+ 0.04 2300 600 0.15 bird-down bird-amp bird
-
- 1.02 beg f+ 0.03 3500 400 0.20 bird-up bird-amp bird
- 1.06 beg f+ 0.04 2300 1200 0.10 bird-up bird-amp bird
- 1.13 beg f+ 0.05 2300 1200 0.15 bird-down bird-amp bird
- 1.22 beg f+ 0.02 3200 800 0.25 bird-up bird-amp bird
- 1.25 beg f+ 0.08 2400 600 0.20 w-updown bird-amp bird
- 1.35 beg f+ 0.02 2200 400 0.10 bird-up bird-amp bird
- 1.38 beg f+ 0.07 2400 1400 0.15 bird-down bird-amp bird
- 1.47 beg f+ 0.03 3000 800 0.20 bird-up bird-amp bird
- 1.50 beg f+ 0.03 2500 400 0.10 w-updown bird-amp bird
- 1.55 beg f+ 0.01 2300 100 0.05 bird-up bird-amp bird
- 1.56 beg f+ 0.06 2200 1400 0.15 bird-down bird-amp bird
- 1.65 beg f+ 0.03 3100 800 0.10 bird-up bird-amp bird
- 1.70 beg f+ 0.07 2800 800 0.15 w-updown bird-amp bird
- 1.79 beg f+ 0.06 2400 1000 0.10 bird-down bird-amp bird
- 1.86 beg f+ 0.14 3100 900 0.25 w-end bird-amp bird
- 2.02 beg f+ 0.12 3200 800 0.20 w-end bird-amp bird
- 2.02 0.12 f+ step
+ 0.75 f- { beg }
+ #( 0 0 0.15 1 0.45 0.9 0.5 0 0.55 1 0.9 0.9 1 1 ) { w-end }
+ #( 0 0.1 0.5 1 1 0 ) { w-updown }
+
+ 0.75 beg f+ 0.04 2400 200 0.05 bird-down bird-amp bird
+ 0.83 beg f+ 0.03 3200 200 0.10 bird-up bird-amp bird
+ 0.90 beg f+ 0.04 2500 300 0.15 bird-up bird-amp bird
+ 0.97 beg f+ 0.04 2300 600 0.15 bird-down bird-amp bird
+
+ 1.02 beg f+ 0.03 3500 400 0.20 bird-up bird-amp bird
+ 1.06 beg f+ 0.04 2300 1200 0.10 bird-up bird-amp bird
+ 1.13 beg f+ 0.05 2300 1200 0.15 bird-down bird-amp bird
+ 1.22 beg f+ 0.02 3200 800 0.25 bird-up bird-amp bird
+ 1.25 beg f+ 0.08 2400 600 0.20 w-updown bird-amp bird
+ 1.35 beg f+ 0.02 2200 400 0.10 bird-up bird-amp bird
+ 1.38 beg f+ 0.07 2400 1400 0.15 bird-down bird-amp bird
+ 1.47 beg f+ 0.03 3000 800 0.20 bird-up bird-amp bird
+ 1.50 beg f+ 0.03 2500 400 0.10 w-updown bird-amp bird
+ 1.55 beg f+ 0.01 2300 100 0.05 bird-up bird-amp bird
+ 1.56 beg f+ 0.06 2200 1400 0.15 bird-down bird-amp bird
+ 1.65 beg f+ 0.03 3100 800 0.10 bird-up bird-amp bird
+ 1.70 beg f+ 0.07 2800 800 0.15 w-updown bird-amp bird
+ 1.79 beg f+ 0.06 2400 1000 0.10 bird-down bird-amp bird
+ 1.86 beg f+ 0.14 3100 900 0.25 w-end bird-amp bird
+ 2.02 beg f+ 0.12 3200 800 0.20 w-end bird-amp bird
+ 2.02 0.12 f+ step
;event
event: lark-bunting ( beg -- )
- 0.1 f- { beg }
- #( 0.00 0.00 0.06 0.80 0.12 0.00 0.18 0.85 0.24 0.05 0.36 0.90
- 0.42 0.10 0.48 0.95 0.54 0.20 0.60 1.00 0.66 0.20 0.72 1.00
- 0.78 0.20 0.84 1.00 0.90 0.20 1.00 1.00 ) { b-trill-one }
- #( 0.00 0.00 0.05 0.80 0.10 0.00 0.15 0.85 0.20 0.00 0.25 0.90
- 0.30 0.00 0.35 0.95 0.40 0.00 0.45 1.00 0.50 0.00 0.55 1.00
- 0.60 0.00 0.65 1.00 0.70 0.00 0.75 1.00 0.80 0.00 0.85 1.00
- 0.90 0.00 0.95 1.00 1.00 0.00 ) { b-trill-two }
-
- 0.10 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
- 0.20 beg f+ 0.12 3700 400 0.20 bird-up bird-amp bird
- 0.40 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
- 0.45 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
- 0.51 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
- 0.04 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
- 0.65 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
- 0.71 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
- 0.80 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
- 0.85 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
- 0.91 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
- 1.00 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
- 1.05 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
- 1.01 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
- 1.20 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
- 1.25 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
- 1.31 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
- 1.40 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
- 1.45 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
- 1.51 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
- 1.60 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
- 1.65 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
- 1.71 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
- 1.770 beg f+ 0.23 6000 600 0.15 b-trill-one bird-amp bird
- 2.005 beg f+ 0.28 6000 600 0.15 b-trill-two bird-amp bird
- 2.005 0.28 f+ step
+ 0.1 f- { beg }
+ #( 0.00 0.00 0.06 0.80 0.12 0.00 0.18 0.85 0.24 0.05 0.36 0.90
+ 0.42 0.10 0.48 0.95 0.54 0.20 0.60 1.00 0.66 0.20 0.72 1.00
+ 0.78 0.20 0.84 1.00 0.90 0.20 1.00 1.00 ) { b-trill-one }
+ #( 0.00 0.00 0.05 0.80 0.10 0.00 0.15 0.85 0.20 0.00 0.25 0.90
+ 0.30 0.00 0.35 0.95 0.40 0.00 0.45 1.00 0.50 0.00 0.55 1.00
+ 0.60 0.00 0.65 1.00 0.70 0.00 0.75 1.00 0.80 0.00 0.85 1.00
+ 0.90 0.00 0.95 1.00 1.00 0.00 ) { b-trill-two }
+
+ 0.10 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
+ 0.20 beg f+ 0.12 3700 400 0.20 bird-up bird-amp bird
+ 0.40 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
+ 0.45 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
+ 0.51 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
+ 0.04 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
+ 0.65 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
+ 0.71 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
+ 0.80 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
+ 0.85 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
+ 0.91 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
+ 1.00 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
+ 1.05 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
+ 1.01 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
+ 1.20 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
+ 1.25 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
+ 1.31 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
+ 1.40 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
+ 1.45 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
+ 1.51 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
+ 1.60 beg f+ 0.03 4100 500 0.15 bird-down bird-amp bird
+ 1.65 beg f+ 0.05 2000 400 0.20 bird-down bird-amp bird
+ 1.71 beg f+ 0.03 1800 100 0.10 bird-up bird-amp bird
+ 1.770 beg f+ 0.23 6000 600 0.15 b-trill-one bird-amp bird
+ 2.005 beg f+ 0.28 6000 600 0.15 b-trill-two bird-amp bird
+ 2.005 0.28 f+ step
;event
event: eastern-bluebird ( beg -- )
- 0.75 f- { beg }
- #( 0.00 0.60 0.10 1.00 0.20 0.00 0.25 1.00 0.30 0.00 0.35 1.00
- 0.40 0.00 0.45 1.00 0.50 0.00 0.75 1.00 1.00 0.00 ) { blue-three }
- #( 0 0 0.5 1 1 0 ) { blue-four }
- #( 0.00 0.50 0.10 1.00 0.20 0.00 0.35 1.00 0.50 0.00 0.65 1.00
- 0.80 0.00 0.95 1.00 1.00 0.50 ) { blue-five }
-
- 0.75 beg f+ 0.02 2000 1600 0.10 bird-up bird-amp bird
- 0.80 beg f+ 0.02 2000 1600 0.10 bird-up bird-amp bird
- 0.86 beg f+ 0.02 2000 1600 0.10 bird-up bird-amp bird
- 1.00 beg f+ 0.13 2000 1400 0.20 bird-down bird-amp bird
- 1.20 beg f+ 0.24 2000 800 0.20 blue-three bird-amp bird
- 1.68 beg f+ 0.03 2200 400 0.10 bird-up bird-amp bird
- 1.72 beg f+ 0.10 1950 100 0.15 blue-four bird-amp bird
- 1.96 beg f+ 0.15 2000 600 0.20 blue-five bird-amp bird
- 1.96 0.15 f+ step
+ 0.75 f- { beg }
+ #( 0.00 0.60 0.10 1.00 0.20 0.00 0.25 1.00 0.30 0.00 0.35 1.00
+ 0.40 0.00 0.45 1.00 0.50 0.00 0.75 1.00 1.00 0.00 ) { blue-three }
+ #( 0 0 0.5 1 1 0 ) { blue-four }
+ #( 0.00 0.50 0.10 1.00 0.20 0.00 0.35 1.00 0.50 0.00 0.65 1.00
+ 0.80 0.00 0.95 1.00 1.00 0.50 ) { blue-five }
+
+ 0.75 beg f+ 0.02 2000 1600 0.10 bird-up bird-amp bird
+ 0.80 beg f+ 0.02 2000 1600 0.10 bird-up bird-amp bird
+ 0.86 beg f+ 0.02 2000 1600 0.10 bird-up bird-amp bird
+ 1.00 beg f+ 0.13 2000 1400 0.20 bird-down bird-amp bird
+ 1.20 beg f+ 0.24 2000 800 0.20 blue-three bird-amp bird
+ 1.68 beg f+ 0.03 2200 400 0.10 bird-up bird-amp bird
+ 1.72 beg f+ 0.10 1950 100 0.15 blue-four bird-amp bird
+ 1.96 beg f+ 0.15 2000 600 0.20 blue-five bird-amp bird
+ 1.96 0.15 f+ step
;event
event: chuck-wills-widow ( beg -- )
- 0.05 f- { beg }
- #( 0 0 0.1 0.1 0.25 1 0.5 0.3 0.8 0.7 1 0 ) { wid-one }
- #( 0 0.2 0.3 1 0.5 0.3 0.6 0.7 0.9 0.1 1 0 ) { wid-two }
-
- 0.05 beg f+ 0.03 1000 800 0.1 bird-down bird-amp bird
- 0.32 beg f+ 0.20 1000 1000 0.2 wid-one bird-amp bird
- 0.56 beg f+ 0.29 900 1100 0.2 wid-two bird-amp bird
- 0.56 0.29 f+ step
+ 0.05 f- { beg }
+ #( 0 0 0.1 0.1 0.25 1 0.5 0.3 0.8 0.7 1 0 ) { wid-one }
+ #( 0 0.2 0.3 1 0.5 0.3 0.6 0.7 0.9 0.1 1 0 ) { wid-two }
+
+ 0.05 beg f+ 0.03 1000 800 0.1 bird-down bird-amp bird
+ 0.32 beg f+ 0.20 1000 1000 0.2 wid-one bird-amp bird
+ 0.56 beg f+ 0.29 900 1100 0.2 wid-two bird-amp bird
+ 0.56 0.29 f+ step
;event
event: blue-gray-gnatcatcher ( beg -- )
- 0.5 f- { beg }
- #( 0 0 0.15 1 0.75 0.8 0.9 1 1 0.7 ) { gskw1 }
- #( 0 0 0.25 1 0.75 0.7 1 0 ) { gskw2 }
- #( 1 0.4 2 1 3 0.1 ) { gparts-1 }
- #( 1 0.4 2 1 3 0.2 ) { gparts-2 }
- #( 1 0.4 2 1 3 0.3 ) { gparts-3 }
-
- 0.5 beg f+ 0.20 4000 1000 0.2 gskw1 bird-amp gparts-1 bigbird
- 0.8 beg f+ 0.13 4000 800 0.2 gskw2 bird-amp gparts-2 bigbird
- 1.4 beg f+ 0.25 4000 800 0.2 gskw2 bird-amp gparts-3 bigbird
- 1.8 beg f+ 0.17 4000 900 0.2 gskw1 bird-amp gparts-3 bigbird
- 2.0 beg f+ 0.17 4000 700 0.2 gskw1 bird-amp gparts-3 bigbird
- 2.2 beg f+ 0.17 4000 800 0.2 gskw2 bird-amp gparts-3 bigbird
- 2.2 0.17 f+ step
+ 0.5 f- { beg }
+ #( 0 0 0.15 1 0.75 0.8 0.9 1 1 0.7 ) { gskw1 }
+ #( 0 0 0.25 1 0.75 0.7 1 0 ) { gskw2 }
+ #( 1 0.4 2 1 3 0.1 ) { gparts-1 }
+ #( 1 0.4 2 1 3 0.2 ) { gparts-2 }
+ #( 1 0.4 2 1 3 0.3 ) { gparts-3 }
+
+ 0.5 beg f+ 0.20 4000 1000 0.2 gskw1 bird-amp gparts-1 bigbird
+ 0.8 beg f+ 0.13 4000 800 0.2 gskw2 bird-amp gparts-2 bigbird
+ 1.4 beg f+ 0.25 4000 800 0.2 gskw2 bird-amp gparts-3 bigbird
+ 1.8 beg f+ 0.17 4000 900 0.2 gskw1 bird-amp gparts-3 bigbird
+ 2.0 beg f+ 0.17 4000 700 0.2 gskw1 bird-amp gparts-3 bigbird
+ 2.2 beg f+ 0.17 4000 800 0.2 gskw2 bird-amp gparts-3 bigbird
+ 2.2 0.17 f+ step
;event
event: black-throated-sparrow ( beg -- )
- 0.8 f- { beg }
- #( 0 0 0.75 1 1 0 ) { black-down-amp }
- #( 0 0 0.5 1 1 0.2 ) { black-up-down }
- #( 0 0 0.5 1 1 0 ) { black-amp }
- #( 0.00 0.00 0.03 0.70 0.06 0.00 0.09 0.75 0.12 0.00 0.15 0.80
- 0.18 0.05 0.21 0.85 0.24 0.10 0.27 0.90 0.30 0.10 0.33 1.00
- 0.36 0.10 0.39 1.00 0.42 0.10 0.45 1.00 0.48 0.10 0.51 1.00
- 0.54 0.10 0.57 1.00 0.60 0.10 0.63 1.00 0.66 0.10 0.69 1.00
- 0.72 0.10 0.75 1.00 0.78 0.10 0.81 1.00 0.84 0.10 0.87 1.00
- 0.90 0.00 0.93 0.95 0.96 0.00 1.00 0.90 ) { black-trill }
-
- 0.80 beg f+ 0.02 2200 1000 0.10 bird-down bird-amp bird
- 0.83 beg f+ 0.01 3000 200 0.05 bird-up bird-amp bird
- 0.96 beg f+ 0.02 5800 500 0.05 bird-up bird-amp bird
- 1.00 beg f+ 0.02 4000 200 0.05 bird-up bird-amp bird
- 1.04 beg f+ 0.10 2100 1700 0.15 bird-down black-down-amp bird
- 1.15 beg f+ 0.05 5700 400 0.25 bird-up bird-amp bird
- 1.25 beg f+ 0.25 2000 900 0.20 black-trill bird-amp bird
- 1.52 beg f+ 0.05 5600 400 0.15 black-up-down bird-amp bird
-
- 1.60 beg f+ 0.04 3900 1100 0.15 bird-up bird-amp bird
- 1.66 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
-
- 1.69 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
- 1.71 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
- 1.74 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
- 1.76 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
-
- 1.78 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
- 1.80 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
- 1.83 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
- 1.85 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
-
- 1.87 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
- 1.89 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
- 1.92 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
- 1.94 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
-
- 1.96 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
- 1.98 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
- 2.01 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
- 2.03 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
-
- 2.05 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
- 2.07 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
- 2.10 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
- 2.13 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
-
- 2.16 beg f+ 0.03 3800 300 0.10 bird-up bird-amp bird
- 2.16 0.03 f+ step
+ 0.8 f- { beg }
+ #( 0 0 0.75 1 1 0 ) { black-down-amp }
+ #( 0 0 0.5 1 1 0.2 ) { black-up-down }
+ #( 0 0 0.5 1 1 0 ) { black-amp }
+ #( 0.00 0.00 0.03 0.70 0.06 0.00 0.09 0.75 0.12 0.00 0.15 0.80
+ 0.18 0.05 0.21 0.85 0.24 0.10 0.27 0.90 0.30 0.10 0.33 1.00
+ 0.36 0.10 0.39 1.00 0.42 0.10 0.45 1.00 0.48 0.10 0.51 1.00
+ 0.54 0.10 0.57 1.00 0.60 0.10 0.63 1.00 0.66 0.10 0.69 1.00
+ 0.72 0.10 0.75 1.00 0.78 0.10 0.81 1.00 0.84 0.10 0.87 1.00
+ 0.90 0.00 0.93 0.95 0.96 0.00 1.00 0.90 ) { black-trill }
+
+ 0.80 beg f+ 0.02 2200 1000 0.10 bird-down bird-amp bird
+ 0.83 beg f+ 0.01 3000 200 0.05 bird-up bird-amp bird
+ 0.96 beg f+ 0.02 5800 500 0.05 bird-up bird-amp bird
+ 1.00 beg f+ 0.02 4000 200 0.05 bird-up bird-amp bird
+ 1.04 beg f+ 0.10 2100 1700 0.15 bird-down black-down-amp bird
+ 1.15 beg f+ 0.05 5700 400 0.25 bird-up bird-amp bird
+ 1.25 beg f+ 0.25 2000 900 0.20 black-trill bird-amp bird
+ 1.52 beg f+ 0.05 5600 400 0.15 black-up-down bird-amp bird
+
+ 1.60 beg f+ 0.04 3900 1100 0.15 bird-up bird-amp bird
+ 1.66 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
+
+ 1.69 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
+ 1.71 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
+ 1.74 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
+ 1.76 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
+
+ 1.78 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
+ 1.80 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
+ 1.83 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
+ 1.85 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
+
+ 1.87 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
+ 1.89 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
+ 1.92 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
+ 1.94 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
+
+ 1.96 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
+ 1.98 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
+ 2.01 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
+ 2.03 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
+
+ 2.05 beg f+ 0.01 3600 300 0.10 bird-up black-amp bird
+ 2.07 beg f+ 0.03 3900 1000 0.15 bird-up black-amp bird
+ 2.10 beg f+ 0.02 5000 100 0.20 bird-up black-amp bird
+ 2.13 beg f+ 0.01 1900 100 0.10 bird-up black-amp bird
+
+ 2.16 beg f+ 0.03 3800 300 0.10 bird-up bird-amp bird
+ 2.16 0.03 f+ step
;event
event: black-chinned-sparrow ( beg -- )
- 0.6 f- { beg }
- #( 0 0 0.3 0.2 1 1 ) { chin-up }
-
- 0.60 beg f+ 0.20 4200 100 0.10 bird-up bird-amp bird
- 1.00 beg f+ 0.09 3800 2000 0.10 chin-up bird-amp bird
- 1.25 beg f+ 0.08 3900 1700 0.12 chin-up bird-amp bird
- 1.40 beg f+ 0.08 3600 2300 0.13 bird-up bird-amp bird
- 1.50 beg f+ 0.11 3100 2800 0.14 bird-up bird-amp bird
- 1.65 beg f+ 0.07 2900 2700 0.15 bird-up bird-amp bird
- 1.74 beg f+ 0.07 2900 2700 0.15 bird-up bird-amp bird
- 1.82 beg f+ 0.07 3000 2300 0.13 bird-up bird-amp bird
- 1.89 beg f+ 0.07 3200 2000 0.10 bird-up bird-amp bird
- 1.97 beg f+ 0.05 3200 1500 0.10 bird-up bird-amp bird
-
- 2.04 beg f+ 0.04 3400 1000 0.07 bird-up bird-amp bird
- 2.10 beg f+ 0.03 3600 700 0.05 bird-up bird-amp bird
- 2.15 beg f+ 0.03 3800 300 0.05 bird-up bird-amp bird
- 2.19 beg f+ 0.02 3900 100 0.03 bird-up bird-amp bird
- 2.22 beg f+ 0.01 3900 100 0.01 bird-up bird-amp bird
- 2.24 beg f+ 0.01 3900 100 0.01 bird-up bird-amp bird
- 2.24 0.01 f+ step
+ 0.6 f- { beg }
+ #( 0 0 0.3 0.2 1 1 ) { chin-up }
+
+ 0.60 beg f+ 0.20 4200 100 0.10 bird-up bird-amp bird
+ 1.00 beg f+ 0.09 3800 2000 0.10 chin-up bird-amp bird
+ 1.25 beg f+ 0.08 3900 1700 0.12 chin-up bird-amp bird
+ 1.40 beg f+ 0.08 3600 2300 0.13 bird-up bird-amp bird
+ 1.50 beg f+ 0.11 3100 2800 0.14 bird-up bird-amp bird
+ 1.65 beg f+ 0.07 2900 2700 0.15 bird-up bird-amp bird
+ 1.74 beg f+ 0.07 2900 2700 0.15 bird-up bird-amp bird
+ 1.82 beg f+ 0.07 3000 2300 0.13 bird-up bird-amp bird
+ 1.89 beg f+ 0.07 3200 2000 0.10 bird-up bird-amp bird
+ 1.97 beg f+ 0.05 3200 1500 0.10 bird-up bird-amp bird
+
+ 2.04 beg f+ 0.04 3400 1000 0.07 bird-up bird-amp bird
+ 2.10 beg f+ 0.03 3600 700 0.05 bird-up bird-amp bird
+ 2.15 beg f+ 0.03 3800 300 0.05 bird-up bird-amp bird
+ 2.19 beg f+ 0.02 3900 100 0.03 bird-up bird-amp bird
+ 2.22 beg f+ 0.01 3900 100 0.01 bird-up bird-amp bird
+ 2.24 beg f+ 0.01 3900 100 0.01 bird-up bird-amp bird
+ 2.24 0.01 f+ step
;event
event: various-gull-cries-from-end-of-colony-5 ( beg -- )
- 0.25 f- { beg }
- #( 0 0 10 1 20 0.5 40 0.6 60 0.5 100 0 ) { gull-start }
- #( 0 0 10 1 30 0.5 80 0.5 100 0 ) { gull-middle }
- #( 0 0 5 1 10 0.5 90 0.4 100 0 ) { gull-end }
- #( 1 0.1 2 1 3 0.1 4 0.01 5 0.09 6 0.01 7 0.01 ) { gull-parts }
-
- 0.25 beg f+ 0.80 1180 1180 0.08 gull-end bird-amp gull-parts bigbird
- 1.50 beg f+ 0.90 1180 1180 0.07 gull-end bird-amp gull-parts bigbird
- 2.75 beg f+ 1.00 1050 1050 0.08 gull-end bird-amp gull-parts bigbird
- 4.80 beg f+ 0.05 1180 1180 0.06 gull-start bird-amp gull-parts bigbird
- 4.95 beg f+ 0.10 1180 1180 0.08 gull-start bird-amp gull-parts bigbird
- 5.15 beg f+ 0.10 1180 1180 0.09 gull-start bird-amp gull-parts bigbird
- 5.35 beg f+ 0.10 1180 1180 0.10 gull-middle bird-amp gull-parts bigbird
- 5.45 beg f+ 0.40 1050 1050 0.10 gull-end bird-amp gull-parts bigbird
- 6.25 beg f+ 0.80 1050 1050 0.10 gull-end bird-amp gull-parts bigbird
- 7.45 beg f+ 1.80 1050 1050 0.10 gull-end bird-amp gull-parts bigbird
- 7.45 1.80 f+ step
+ 0.25 f- { beg }
+ #( 0 0 10 1 20 0.5 40 0.6 60 0.5 100 0 ) { gull-start }
+ #( 0 0 10 1 30 0.5 80 0.5 100 0 ) { gull-middle }
+ #( 0 0 5 1 10 0.5 90 0.4 100 0 ) { gull-end }
+ #( 1 0.1 2 1 3 0.1 4 0.01 5 0.09 6 0.01 7 0.01 ) { gull-parts }
+
+ 0.25 beg f+ 0.80 1180 1180 0.08 gull-end bird-amp gull-parts bigbird
+ 1.50 beg f+ 0.90 1180 1180 0.07 gull-end bird-amp gull-parts bigbird
+ 2.75 beg f+ 1.00 1050 1050 0.08 gull-end bird-amp gull-parts bigbird
+ 4.80 beg f+ 0.05 1180 1180 0.06 gull-start bird-amp gull-parts bigbird
+ 4.95 beg f+ 0.10 1180 1180 0.08 gull-start bird-amp gull-parts bigbird
+ 5.15 beg f+ 0.10 1180 1180 0.09 gull-start bird-amp gull-parts bigbird
+ 5.35 beg f+ 0.10 1180 1180 0.10 gull-middle bird-amp gull-parts bigbird
+ 5.45 beg f+ 0.40 1050 1050 0.10 gull-end bird-amp gull-parts bigbird
+ 6.25 beg f+ 0.80 1050 1050 0.10 gull-end bird-amp gull-parts bigbird
+ 7.45 beg f+ 1.80 1050 1050 0.10 gull-end bird-amp gull-parts bigbird
+ 7.45 1.80 f+ step
;event
\ <'> bird-test with-sound
: bird-test ( -- )
- 0.0 now!
- 1.0 { dur }
- now@ orchard-oriole dur step
- now@ cassins-kingbird dur step
- now@ chipping-sparrow dur step
- now@ bobwhite dur step
- now@ western-meadowlark dur step
- now@ scissor-tailed-flycatcher dur step
- now@ great-horned-owl dur step
- now@ black-throated-gray-warbler dur step
- now@ yellow-warbler dur step
- now@ black-necked-stilt dur step
- now@ chestnut-sided-warbler dur step
- now@ grasshopper-sparrow dur step
- now@ swamp-sparrow dur step
- now@ golden-crowned-sparrow dur step
- now@ indigo-bunting dur step
- now@ hooded-warbler dur step
- now@ american-widgeon dur step
- now@ louisiana-waterthrush dur step
- now@ robin dur step
- now@ solitary-vireo dur step
- now@ pigeon-hawk dur step
- now@ cerulean-warbler dur step
- now@ nashville-warbler dur step
- now@ eastern-phoebe dur step
- now@ painted-bunting dur step
- now@ western-flycatcher dur step
- now@ bachmans-sparrow dur step
- now@ cedar-waxwing dur step
- now@ bairds-sparrow dur step
- now@ kentucky-warbler dur step
- now@ rufous-sided-towhee dur step
- now@ prothonotary-warbler dur step
- now@ audubons-warbler dur step
- now@ lark-bunting dur step
- now@ eastern-bluebird dur step
- now@ chuck-wills-widow dur step
- now@ blue-gray-gnatcatcher dur step
- now@ black-throated-sparrow dur step
- now@ black-chinned-sparrow dur step
- now@ various-gull-cries-from-end-of-colony-5 dur step
+ 0.0 now!
+ 1.0 { dur }
+ now@ orchard-oriole dur step
+ now@ cassins-kingbird dur step
+ now@ chipping-sparrow dur step
+ now@ bobwhite dur step
+ now@ western-meadowlark dur step
+ now@ scissor-tailed-flycatcher dur step
+ now@ great-horned-owl dur step
+ now@ black-throated-gray-warbler dur step
+ now@ yellow-warbler dur step
+ now@ black-necked-stilt dur step
+ now@ chestnut-sided-warbler dur step
+ now@ grasshopper-sparrow dur step
+ now@ swamp-sparrow dur step
+ now@ golden-crowned-sparrow dur step
+ now@ indigo-bunting dur step
+ now@ hooded-warbler dur step
+ now@ american-widgeon dur step
+ now@ louisiana-waterthrush dur step
+ now@ robin dur step
+ now@ solitary-vireo dur step
+ now@ pigeon-hawk dur step
+ now@ cerulean-warbler dur step
+ now@ nashville-warbler dur step
+ now@ eastern-phoebe dur step
+ now@ painted-bunting dur step
+ now@ western-flycatcher dur step
+ now@ bachmans-sparrow dur step
+ now@ cedar-waxwing dur step
+ now@ bairds-sparrow dur step
+ now@ kentucky-warbler dur step
+ now@ rufous-sided-towhee dur step
+ now@ prothonotary-warbler dur step
+ now@ audubons-warbler dur step
+ now@ lark-bunting dur step
+ now@ eastern-bluebird dur step
+ now@ chuck-wills-widow dur step
+ now@ blue-gray-gnatcatcher dur step
+ now@ black-throated-sparrow dur step
+ now@ black-chinned-sparrow dur step
+ now@ various-gull-cries-from-end-of-colony-5 dur step
;
: ws-bird-test ( -- )
- <'> bird-test
- :play #t
- :statistics #t
- :verbose #t
- :channels 2
- :srate 44100
- :scaled-to 0.8
- :notehook #f with-sound drop
+ <'> bird-test
+ :play #t
+ :statistics #t
+ :verbose #t
+ :channels 2
+ :srate 44100
+ :scaled-to 0.8
+ :notehook #f with-sound drop
;
\ bird.fsm ends here
diff --git a/bird.rb b/bird.rb
index 5e1fc33..c937a7a 100644
--- a/bird.rb
+++ b/bird.rb
@@ -26,12 +26,11 @@ def bigbird(start, dur, frequency, freqskew, amplitude, freq_envelope, amp_envel
beg = (srate() * start).round
len = (srate() * dur).round
local_data = make_vct len
- vct_map!(local_data,
- Proc.new { ||
- env(amp_env) *
- polynomial(coeffs,
- oscil(os, env(gls_env)))
- })
+ local_data.map! do
+ env(amp_env) *
+ polynomial(coeffs,
+ oscil(os, env(gls_env)))
+ end
vct_add!($out_data, local_data, beg)
end
@@ -42,14 +41,13 @@ def bird(start, dur, frequency, freqskew, amplitude, freq_envelope, amp_envelope
beg = (srate() * start).round
len = (srate() * dur).round
local_data = make_vct len
- vct_map!(local_data,
- Proc.new { ||
- env(amp_env) * oscil(os, env(gls_env))
- })
+ local_data.map! do
+ env(amp_env) * oscil(os, env(gls_env))
+ end
vct_add!($out_data, local_data, beg)
end
-def one_bird(beg, maxdur, func, birdname)
+def one_bird(beg, maxdur, birdname, &func)
$out_data = make_vct((srate() * maxdur).round)
func.call()
mix_vct($out_data, (beg*srate()).round, $out_file, 0, $with_editable_mixes)
@@ -70,8 +68,7 @@ def orchard_oriole(beg)
oridwnup = [0.00, 0.30, 0.25, 0.00, 1.00, 1.0]
oriamp = [0.00, 0.00, 0.10, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "orchard_oriole") do
bird(0.38, 0.03, 3700, 100, 0.05, oridwn, $main_amp)
bird(0.41, 0.05, 2500, 1000, 0.1, oriup, $main_amp)
bigbird(0.5, 0.1, 2000, 800, 0.2, oriupdwna, $main_amp, [1, 1, 2, 0.02, 3, 0.05])
@@ -88,8 +85,7 @@ def orchard_oriole(beg)
bird(2.2, 0.02, 2200, 3000, 0.04, oriup, $main_amp)
bird(2.28, 0.02, 2200, 3000, 0.04, oriup, $main_amp)
bigbird(2.4, 0.17, 2000, 1000, 0.2, oriupdwna, oriamp, [1, 1, 2, 0.04])
- },
- report_in_minibuffer("orchard_oriole"))
+ end
end
@@ -97,20 +93,17 @@ def cassins_kingbird(beg)
kingfirst = [0.00, 0.30, 0.45, 1.00, 0.90, 0.10, 1.00, 0.0]
kingsecond = [0.00, 0.00, 0.02, 0.50, 0.04, 0.00, 0.06, 0.55, 0.08, 0.05, 0.10, 0.60, 0.12, 0.05, 0.14, 0.65, 0.16, 0.10, 0.18, 0.70, 0.20, 0.10, 0.22, 0.75, 0.24, 0.15, 0.26, 0.80, 0.28, 0.20, 0.30, 0.85, 0.32, 0.25, 0.34, 0.90, 0.36, 0.30, 0.38, 0.95, 0.40, 0.40, 0.42, 1.00, 0.44, 0.50, 0.46, 1.00, 0.48, 0.45, 0.50, 1.00, 0.52, 0.50, 0.54, 1.00, 0.56, 0.40, 0.58, 0.95, 0.60, 0.40, 0.62, 0.90, 0.64, 0.40, 0.66, 0.85, 0.68, 0.35, 0.70, 0.80, 0.72, 0.30, 0.74, 0.75, 0.76, 0.25, 0.78, 0.70, 0.80, 0.20, 0.82, 0.65, 0.84, 0.10, 0.86, 0.60, 0.88, 0.00, 0.90, 0.55, 0.92, 0.00, 0.94, 0.50, 0.96, 0.00, 1.00, 0.40]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "cassins_kingbird") do
bigbird(0.03, 0.04, 1700, 1200, 0.15, kingfirst, $main_amp, [1, 1, 2, 0.5, 3, 0, 4, 0.2])
bigbird(0.12, 0.18, 1700, 900, 0.25, kingsecond, $main_amp, [1, 1, 2, 0.01, 3, 0, 4, 0.1])
- },
- report_in_minibuffer("cassins_kingbird"))
+ end
end
def chipping_sparrow(beg)
chip_up = [0.00, 0.80, 0.15, 1.00, 0.75, 0.30, 1.00, 0.0]
- one_bird(beg, 1.1,
- Proc.new {||
+ one_bird(beg, 1.1, "chipping_sparrow") do
bird(0, 0.05, 4000, 2400, 0.2, chip_up, $main_amp)
bird(0.06, 0.05, 4000, 2400, 0.2, chip_up, $main_amp)
bird(0.12, 0.05, 4000, 2400, 0.2, chip_up, $main_amp)
@@ -128,8 +121,7 @@ def chipping_sparrow(beg)
bird(0.84, 0.05, 4000, 2400, 0.2, chip_up, $main_amp)
bird(0.90, 0.05, 4000, 2400, 0.2, chip_up, $main_amp)
bird(0.96, 0.05, 4000, 2400, 0.2, chip_up, $main_amp)
- },
- report_in_minibuffer("chipping_sparrow"))
+ end
end
@@ -137,12 +129,10 @@ def bobwhite(beg)
bobup1 = [0.00, 0.00, 0.40, 1.00, 1.00, 1.0]
bobup2 = [0.00, 0.00, 0.65, 0.50, 1.00, 1.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "bobwhite") do
bigbird(0.4, 0.2, 1800, 200, 0.1, bobup1, $main_amp, [1, 1, 2, 0.02])
bigbird(1, 0.20, 1800, 1200, 0.2, bobup2, $main_amp, [1, 1, 2, 0.02])
- },
- report_in_minibuffer("bobwhite"))
+ end
end
@@ -151,8 +141,7 @@ def western_meadowlark(beg)
down_skw = [0.00, 1.00, 0.40, 0.40, 1.00, 0.0]
fas_down = [0.00, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "western_meadowlark") do
bigbird(0.800, 0.1, 2010.000, 0.000, 0.100, no_skw, $main_amp, [1, 1, 2, 0.04])
bigbird(1.100, 0.15, 3000.000, 100.000, 0.110, down_skw, $main_amp, [1, 1, 2, 0.04])
bigbird(1.300, 0.25, 2000.000, 150.000, 0.200, down_skw, $main_amp, [1, 1, 2, 0.04])
@@ -161,18 +150,15 @@ def western_meadowlark(beg)
bigbird(2.000, 0.10, 3200.000, 1400.000, 0.110, fas_down, $main_amp, [1, 1, 2, 0.04])
bigbird(2.200, 0.05, 2000.000, 200.000, 0.110, fas_down, $main_amp, [1, 1, 2, 0.04])
bigbird(2.300, 0.10, 1600.000, 0.000, 0.110, fas_down, $main_amp, [1, 1, 2, 0.04])
- },
- report_in_minibuffer("western_meadowlark"))
+ end
end
def scissor_tailed_flycatcher(beg)
scissor = [0.00, 0.00, 0.40, 1.00, 0.60, 1.00, 1.00, 0.0]
- one_bird(beg, 1.0,
- Proc.new {||
+ one_bird(beg, 1.0, "scissor_tailed_flycatcher") do
bigbird(0, 0.05, 1800, 1800, 0.2, scissor, $main_amp, [1, 0.5, 2, 1, 3, 0.5, 4, 0.1, 5, 0.01])
- },
- report_in_minibuffer("scissor_tailed_flycatcher"))
+ end
end
@@ -180,14 +166,12 @@ def great_horned_owl(beg)
owlup = [0.00, 0.00, 0.30, 1.00, 1.00, 1.0]
owldown = [0.00, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "great_horned_owl") do
bigbird(0.3, 0.1, 300, 0, 0.1, $main_amp, $main_amp, [1, 1, 3, 0.02, 7, 0.01])
bigbird(0.6, 0.4, 293, 6, 0.1, owldown, $main_amp, [1, 1, 3, 0.02, 7, 0.01])
bigbird(1.75, 0.35, 293, 7, 0.1, owlup, $main_amp, [1, 1, 3, 0.02, 7, 0.01])
bigbird(2.5, 0.2, 300, 0, 0.1, owlup, $main_amp, [1, 1, 3, 0.02, 7, 0.01])
- },
- report_in_minibuffer("great_horned_owl"))
+ end
end
@@ -197,8 +181,7 @@ def black_throated_gray_warbler(beg)
graythree = [0.00, 1.00, 0.01, 0.60, 0.02, 1.00, 0.03, 0.60, 0.04, 1.00, 0.05, 0.60, 0.06, 1.00, 0.07, 0.60, 0.08, 1.00, 0.09, 0.60, 0.10, 1.00, 0.11, 0.60, 0.12, 1.00, 0.13, 0.60, 0.14, 1.00, 0.15, 0.60, 0.16, 1.00, 0.17, 0.60, 0.18, 1.00, 0.19, 0.60, 0.20, 1.00, 0.21, 0.55, 0.22, 1.00, 0.23, 0.50, 0.24, 1.00, 0.25, 0.50, 0.26, 1.00, 0.27, 0.50, 0.28, 1.00, 0.29, 0.50, 0.30, 1.00, 0.31, 0.50, 0.32, 1.00, 0.33, 0.50, 0.34, 1.00, 0.35, 0.50, 0.36, 1.00, 0.37, 0.50, 0.38, 1.00, 0.39, 0.50, 0.40, 1.00, 0.41, 0.50, 0.42, 1.00, 0.43, 0.50, 0.44, 1.00, 0.45, 0.50, 0.46, 1.00, 0.47, 0.50, 0.48, 1.00, 0.49, 0.50, 0.50, 1.00, 0.51, 0.50, 0.52, 1.00, 0.53, 0.50, 0.54, 1.00, 0.55, 0.50, 0.56, 1.00, 0.57, 0.50, 0.58, 1.00, 0.59, 0.50, 0.60, 1.00, 1.00, 0.0]
grayfour = [0.00, 0.00, 1.00, 1.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "black_throated_gray_warbler") do
bird(0, 0.12, 3700, 600, 0.05, grayone, $main_amp)
bird(0.18, 0.08, 3000, 800, 0.07, graytwo, $main_amp)
bird(0.28, 0.12, 3700, 600, 0.12, grayone, $main_amp)
@@ -210,8 +193,7 @@ def black_throated_gray_warbler(beg)
bird(1.2, 0.02, 4500, 500, 0.05, grayfour, $main_amp)
bird(1.25, 0.02, 4200, 800, 0.05, grayfour, $main_amp)
bird(1.3, 0.02, 4000, 900, 0.05, grayfour, $main_amp)
- },
- report_in_minibuffer("black_throated_gray_warbler"))
+ end
end
@@ -222,8 +204,7 @@ def yellow_warbler(beg)
yellow_last = [0.00, 0.00, 0.30, 0.20, 0.80, 0.70, 1.00, 1.0]
swirl_amp = [0.00, 0.00, 0.90, 1.00, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "yellow_warbler") do
bird(0, 0.05, 5600, 400, 0.05, yellow_up, $main_amp)
bird(0.23, 0.12, 5000, 1500, 0.15, yellow_swirl, swirl_amp)
bird(0.45, 0.13, 5000, 1700, 0.17, yellow_swirl, swirl_amp)
@@ -233,8 +214,7 @@ def yellow_warbler(beg)
bird(1.15, 0.075, 3700, 800, 0.15, yellow_down, $main_amp)
bird(1.25, 0.075, 3700, 800, 0.15, yellow_down, $main_amp)
bird(1.4, 0.2, 3700, 2000, 0.2, yellow_last, swirl_amp)
- },
- report_in_minibuffer("yellow_warbler"))
+ end
end
@@ -242,13 +222,11 @@ def black_necked_stilt(beg)
upamp = [0.00, 0.00, 0.90, 1.00, 1.00, 0.0]
rampup = [0.00, 0.00, 0.50, 1.00, 1.00, 0.20]
- one_bird(beg, 1.0,
- Proc.new {||
+ one_bird(beg, 1.0, "black_necked_stilt") do
bigbird(0, 0.1, 900, 100, 0.2, rampup, upamp, [1, 0.5, 2, 1, 3, 0.75, 4, 0.5, 5, 0.1])
bigbird(0.30, 0.1, 900, 200, 0.2, rampup, upamp, [1, 0.5, 2, 1, 3, 0.75, 4, 0.5, 5, 0.1])
bigbird(0.60, 0.1, 900, 250, 0.2, rampup, upamp, [1, 0.5, 2, 1, 3, 0.75, 4, 0.5, 5, 0.1])
- },
- report_in_minibuffer("black_necked_stilt"))
+ end
end
@@ -262,8 +240,7 @@ def chestnut_sided_warbler(beg)
louder = [0.00, 0.00, 0.90, 1.00, 1.00, 0.0]
wamp = [0.00, 0.00, 0.10, 1.00, 0.40, 0.10, 0.50, 0.90, 0.60, 0.10, 0.70, 1.00, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "chestnut_sided_warbler") do
bigbird(0.1, 0.1, 4050, 1200, 0.05, ycurve, $main_amp, [1, 1, 2, 0.1])
bigbird(0.25, 0.03, 3900, 300, 0.075, vcurve, $main_amp, [1, 1, 2, 0.1])
bigbird(0.3, 0.1, 4050, 1200, 0.15, ycurve, louder, [1, 1, 2, 0.1])
@@ -277,8 +254,7 @@ def chestnut_sided_warbler(beg)
bigbird(1.20, 0.12, 3800, 2200, 0.15, wcurve, wamp, [1, 1, 2, 0.1])
bigbird(1.35, 0.12, 2500, 2200, 0.25, upcurve, louder, [1, 1, 2, 0.1])
bigbird(1.50, 0.12, 2500, 4000, 0.15, downcurve, $main_amp, [1, 1, 2, 0.1])
- },
- report_in_minibuffer("chestnut_sided_warbler"))
+ end
end
@@ -286,14 +262,12 @@ def grasshopper_sparrow(beg)
grassone = [0.00, 0.50, 0.02, 0.80, 0.04, 0.30, 0.06, 0.80, 0.07, 0.10, 0.08, 0.90, 0.10, 0.00, 0.11, 0.90, 0.12, 0.00, 0.13, 0.90, 0.14, 0.10, 0.15, 1.00, 0.16, 0.10, 0.17, 1.00, 0.18, 0.10, 0.19, 1.00, 0.20, 0.10, 0.21, 1.00, 0.22, 0.10, 0.23, 1.00, 0.24, 0.10, 0.25, 1.00, 0.26, 0.10, 0.27, 1.00, 0.28, 0.10, 0.29, 1.00, 0.30, 0.10, 0.31, 1.00, 0.32, 0.10, 0.33, 1.00, 0.34, 0.10, 0.35, 1.00, 0.36, 0.10, 0.37, 1.00, 0.38, 0.10, 0.39, 1.00, 0.40, 0.10, 0.41, 1.00, 0.42, 0.10, 0.43, 1.00, 0.44, 0.10, 0.45, 1.00, 0.46, 0.10, 0.47, 1.00, 0.48, 0.10, 0.49, 1.00, 0.50, 0.10, 0.51, 1.00, 0.52, 0.10, 0.53, 1.00, 0.54, 0.10, 0.55, 1.00, 0.56, 0.10, 0.57, 1.00, 0.58, 0.10, 0.59, 1.00, 0.60, 0.10, 0.61, 1.00, 0.62, 0.10, 0.63, 1.00, 0.64, 0.10, 0.65, 1.00, 0.66, 0.10, 0.67, 1.00, 0.68, 0.10, 0.69, 1.00, 0.70, 0.10, 0.71, 1.00, 0.72, 0.10, 0.73, 1.00, 0.74, 0.10, 0.75, 1.00, 0.76, 0.10, 0.77, 1.00, 0.78, 0.10, 0.79, 1.00, 0.80, 0.10, 0.81, 1.00, 0.82, 0.10, 0.83, 1.00, 0.84, 0.10, 0.85, 1.00, 0.86, 0.10, 0.87, 1.00, 0.88, 0.10, 0.89, 1.00, 0.90, 0.10, 0.91, 1.00, 0.92, 0.10, 0.93, 1.00, 0.94, 0.10, 0.95, 1.00, 0.96, 0.10, 0.97, 1.00, 0.98, 0.10, 1.00, 1.0]
grasstwo = [0.00, 0.00, 0.10, 1.00, 0.20, 0.00, 0.30, 1.00, 0.40, 0.00, 0.50, 1.00, 0.60, 0.00, 0.70, 1.00, 0.80, 0.00, 0.90, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "grasshopper_sparrow") do
bird(0.49, 0.01, 8000, 100, 0.1, grasstwo, $main_amp)
bird(0.60, 0.01, 5700, 300, 0.1, grasstwo, $main_amp)
bird(0.92, 0.01, 3900, 100, 0.1, grasstwo, $main_amp)
bird(1.00, 1.4, 6000, 2500, 0.2, grassone, $main_amp)
- },
- report_in_minibuffer("grasshopper_sparrow"))
+ end
end
@@ -301,8 +275,7 @@ def swamp_sparrow(beg)
swamp_up = [0.00, 0.00, 0.60, 0.70, 1.00, 1.0]
swamp_down = [0.00, 1.00, 0.50, 0.50, 0.60, 0.60, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "swamp_sparrow") do
bird(0, 0.02, 3900, 200, 0.3, swamp_up, $main_amp)
bird(0.035, 0.035, 3200, 3000, 0.1, swamp_down, $main_amp)
bird(0.08, 0.025, 3700, 0, 0.1, $main_amp, $main_amp)
@@ -342,8 +315,7 @@ def swamp_sparrow(beg)
bird(0.9, 0.02, 3900, 200, 0.3, swamp_up, $main_amp)
bird(0.935, 0.035, 3200, 3000, 0.1, swamp_down, $main_amp)
bird(0.98, 0.025, 3700, 0, 0.1, $main_amp, $main_amp)
- },
- report_in_minibuffer("swamp_sparrow"))
+ end
end
@@ -352,14 +324,12 @@ def golden_crowned_sparrow(beg)
goldtwo = [0.00, 0.90, 0.05, 1.00, 0.10, 0.40, 1.00, 0.0]
goldtrill = [0.00, 0.50, 0.10, 0.00, 0.20, 1.00, 0.30, 0.00, 0.40, 1.00, 0.50, 0.00, 0.60, 1.00, 0.70, 0.00, 0.80, 1.00, 0.90, 0.00, 1.00, 0.50]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "golden_crowned_sparrow") do
bird(0.6, 0.5, 4300, 1000, 0.15, goldone, $main_amp)
bird(1.3, 0.45, 3300, 200, 0.15, goldone, $main_amp)
bird(1.75, 0.4, 3800, 100, 0.15, goldtwo, $main_amp)
bird(2.2, 0.3, 3800, 100, 0.1, goldtrill, $main_amp)
- },
- report_in_minibuffer("golden_crowned_sparrow"))
+ end
end
@@ -371,8 +341,7 @@ def indigo_bunting(beg)
buntx = [0.00, 1.00, 0.10, 0.50, 0.25, 0.90, 1.00, 0.0]
buntup = [0.00, 0.00, 1.00, 1.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "indigo_bunting") do
bird(0.4, 0.08, 3000, 700, 0.25, buntdwn, $main_amp)
bird(0.52, 0.02, 6200, 1000, 0.05, buntdwn, $main_amp)
bird(0.55, 0.15, 3500, 2300, 0.1, buntv, $main_amp)
@@ -392,8 +361,7 @@ def indigo_bunting(beg)
bird(2.33, 0.08, 3000, 1500, 0.15, buntup, $main_amp)
bird(2.43, 0.07, 5200, 1800, 0.1, buntn, $main_amp)
bird(2.51, 0.08, 3000, 1500, 0.10, buntup, $main_amp)
- },
- report_in_minibuffer("indigo_bunting"))
+ end
end
@@ -401,8 +369,7 @@ def hooded_warbler(beg)
hoodup = [0.00, 0.00, 1.00, 1.0]
hooddown = [0.00, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "hooded_warbler") do
bird(0.6, 0.03, 3900, 1600, 0.05, hooddown, $main_amp)
bird(0.64, 0.03, 3900, 1700, 0.05, hooddown, $main_amp)
bird(0.8, 0.03, 3900, 2000, 0.10, hooddown, $main_amp)
@@ -430,8 +397,7 @@ def hooded_warbler(beg)
bird(2.29, 0.04, 3000, 1000, 0.15, hoodup, $main_amp)
bird(2.37, 0.04, 3000, 1000, 0.15, hoodup, $main_amp)
bird(2.45, 0.04, 3000, 1000, 0.15, hoodup, $main_amp)
- },
- report_in_minibuffer("hooded_warbler"))
+ end
end
@@ -439,13 +405,11 @@ end
def american_widgeon(beg)
widgeon = [0.00, 0.00, 0.50, 1.00, 1.00, 0.0]
- one_bird(beg, 1.0,
- Proc.new {||
+ one_bird(beg, 1.0, "american_widgeon") do
bigbird(0.3, 0.07, 1900, 300, 0.15, widgeon, widgeon, [1, 1, 2, 0.02])
bigbird(0.4, 0.11, 1700, 1400, 0.25, widgeon, widgeon, [1, 0.7, 2, 1, 3, 0.02])
bigbird(0.55, 0.07, 1900, 300, 0.15, widgeon, widgeon, [1, 1, 2, 0.02])
- },
- report_in_minibuffer("american_widgeon"))
+ end
end
@@ -458,8 +422,7 @@ def louisiana_waterthrush(beg)
water_amp = [0.00, 0.00, 0.35, 1.00, 0.50, 0.20, 0.90, 1.00, 1.00, 0.0]
water_damp = [0.00, 0.00, 0.90, 1.00, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "louisiana_waterthrush") do
bird(0, 0.17, 4100, 2000, 0.2, water_one, water_amp)
bird(0.32, 0.18, 4050, 2050, 0.3, water_one, water_amp)
bird(0.64, 0.20, 4000, 1900, 0.25, water_one, water_amp)
@@ -469,8 +432,7 @@ def louisiana_waterthrush(beg)
bird(1.58, 0.02, 5200, 1000, 0.1, water_five, $main_amp)
bird(1.65, 0.02, 5200, 1000, 0.1, water_five, $main_amp)
bird(1.7, 0.035, 3200, 1000, 0.1, water_four, water_damp)
- },
- report_in_minibuffer("louisiana_waterthrush"))
+ end
end
@@ -482,34 +444,29 @@ def robin(beg)
r_five = [0.00, 0.50, 0.10, 0.00, 0.20, 1.00, 0.30, 0.00, 0.40, 1.00, 0.50, 0.00, 0.60, 1.00, 0.70, 0.50, 1.00, 0.20]
r_six = [0.00, 0.00, 0.12, 0.70, 0.30, 0.00, 0.70, 1.00, 1.00, 0.50]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "robin") do
bigbird(0.45, 0.06, 2000, 800, 0.15, r_six, $main_amp, [1, 1, 2, 0.1])
bigbird(0.56, 0.10, 2000, 900, 0.15, r_one, $main_amp, [1, 1, 2, 0.1])
bigbird(1.04, 0.24, 2000, 2000, 0.25, r_two, $main_amp, [1, 1, 2, 0.1])
bigbird(1.63, 0.13, 1900, 1600, 0.20, r_three, $main_amp, [1, 1, 2, 0.1])
bigbird(1.80, 0.11, 2200, 1200, 0.25, r_four, $main_amp, [1, 1, 2, 0.1])
bigbird(2.31, 0.21, 1950, 2000, 0.15, r_five, $main_amp, [1, 1, 2, 0.1])
- },
- report_in_minibuffer("robin"))
+ end
end
def solitary_vireo(beg)
bigskew = [0.00, 0.20, 0.03, 0.30, 0.06, 0.10, 0.10, 0.50, 0.13, 0.40, 0.16, 0.80, 0.19, 0.50, 0.22, 0.90, 0.25, 0.60, 0.28, 1.00, 0.31, 0.60, 0.34, 1.00, 0.37, 0.50, 0.41, 0.90, 0.45, 0.40, 0.49, 0.80, 0.51, 0.40, 0.54, 0.75, 0.57, 0.35, 0.60, 0.70, 0.63, 0.30, 0.66, 0.60, 0.69, 0.25, 0.72, 0.50, 0.75, 0.20, 0.78, 0.30, 0.82, 0.10, 0.85, 0.30, 0.88, 0.05, 0.91, 0.30, 0.94, 0.00, 0.95, 0.30, 0.99, 0.00, 1.00, 0.10]
- one_bird(beg, 1.0,
- Proc.new {||
+ one_bird(beg, 1.0, "solitary_vireo") do
bird(0, 0.4, 1800, 1200, 0.2, bigskew, $main_amp)
- },
- report_in_minibuffer("solitary_vireo"))
+ end
end
def pigeon_hawk(beg)
hupdown = [0.00, 0.00, 0.30, 1.00, 0.70, 1.00, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "pigeon_hawk") do
bigbird(0, 0.1, 1900, 200, 0.2, hupdown, $main_amp, [1, 0.7, 2, 1])
bigbird(0.12, 0.01, 2050, 0, 0.1, $main_amp, $main_amp, [1, 0.5, 2, 1])
bigbird(0.13, 0.1, 1900, 200, 0.2, hupdown, $main_amp, [1, 0.7, 2, 1])
@@ -539,8 +496,7 @@ def pigeon_hawk(beg)
bigbird(1.69, 0.1, 1900, 200, 0.2, hupdown, $main_amp, [1, 0.7, 2, 1])
bigbird(1.81, 0.01, 2050, 0, 0.1, $main_amp, $main_amp, [1, 0.5, 2, 1])
bigbird(1.82, 0.1, 1900, 200, 0.2, hupdown, $main_amp, [1, 0.7, 2, 1])
- },
- report_in_minibuffer("pigeon_hawk"))
+ end
end
@@ -549,8 +505,7 @@ def cerulean_warbler(beg)
trill = [0.00, 0.80, 0.10, 1.00, 0.25, 0.50, 0.40, 1.00, 0.55, 0.50, 0.70, 1.00, 1.00, 0.0]
w_up = [0.00, 0.00, 1.00, 1.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "cerulean_warbler") do
bird(0.27, 0.05, 3000, 1000, 0.05, w_down, $main_amp)
bird(0.33, 0.05, 3000, 800, 0.075, w_up, $main_amp)
bird(0.41, 0.01, 3200, 700, 0.07, w_down, $main_amp)
@@ -592,8 +547,7 @@ def cerulean_warbler(beg)
bird(1.28, 0.01, 3900, 1400, 0.1, w_up, $main_amp)
bird(1.29, 0.01, 3900, 1400, 0.1, w_up, $main_amp)
bird(1.30, 0.01, 3900, 1400, 0.1, w_up, $main_amp)
- },
- report_in_minibuffer("cerulean_warbler"))
+ end
end
@@ -603,8 +557,7 @@ def nashville_warbler(beg)
nash_up = [0.00, 0.00, 0.15, 0.20, 0.25, 0.05, 0.90, 0.95, 1.00, 1.0]
nash_amp = [0.00, 0.00, 0.80, 1.00, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "nashville_warbler") do
bird(0.15, 0.025, 3900, 300, 0.3, nash_blip, $main_amp)
bird(0.24, 0.16, 4200, 3800, 0.15, nash_down, nash_amp)
bird(0.42, 0.025, 3900, 300, 0.3, nash_blip, $main_amp)
@@ -618,8 +571,7 @@ def nashville_warbler(beg)
bird(1.57, 0.1, 3800, 2200, 0.1, nash_up, $main_amp)
bird(1.7, 0.1, 3800, 2150, 0.125, nash_up, $main_amp)
bird(1.85, 0.075, 3900, 1800, 0.1, nash_up, nash_amp)
- },
- report_in_minibuffer("nashville_warbler"))
+ end
end
@@ -630,14 +582,12 @@ def eastern_phoebe(beg)
phoebe_four = [0.00, 1.00, 0.50, 0.70, 1.00, 0.0]
phoebe_amp = [0.00, 0.00, 0.10, 1.00, 1.00, 0.0]
- one_bird(beg, 1.0,
- Proc.new {||
+ one_bird(beg, 1.0, "eastern_phoebe") do
bird(0, 0.225, 3000, 1300, 0.3, phoebe_one, $main_amp)
bird(0.35, 0.12, 3000, 500, 0.1, phoebe_two, phoebe_amp)
bird(0.4, 0.10, 3000, 1500, 0.2, phoebe_three, phoebe_amp)
bird(0.55, 0.05, 3000, 1400, 0.2, phoebe_four, phoebe_amp)
- },
- report_in_minibuffer("eastern_phoebe"))
+ end
end
@@ -658,8 +608,7 @@ def painted_bunting(beg)
b_fourteen = [0.00, 0.30, 0.30, 1.00, 0.60, 0.30, 1.00, 0.0]
b_fifteen = [0.00, 0.00, 0.10, 0.50, 0.50, 0.50, 0.90, 1.00, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "painted_bunting") do
bird(0.05, 0.10, 3100, 900, 0.05, b_one, b_two)
bird(0.21, 0.07, 4100, 700, 0.15, b_three, $main_amp)
bird(0.36, 0.12, 3700, 1000, 0.20, b_four, $main_amp)
@@ -673,8 +622,7 @@ def painted_bunting(beg)
bird(1.36, 0.02, 3200, 1000, 0.1, b_eleven, $main_amp)
bird(1.40, 0.03, 4000, 2000, 0.12, b_twelve, b_thirteen)
bird(1.47, 0.1, 2300, 1700, 0.2, b_fourteen, b_fifteen)
- },
- report_in_minibuffer("painted_bunting"))
+ end
end
@@ -684,12 +632,10 @@ def western_flycatcher(beg)
f_two = [0.00, 0.50, 0.25, 1.00, 0.50, 0.00, 0.60, 0.00, 0.95, 0.30, 1.00, 0.60]
a_two = [0.00, 0.00, 0.10, 1.00, 0.20, 1.00, 0.50, 0.10, 0.60, 0.10, 0.90, 1.00, 1.00, 0.0]
- one_bird(beg, 1.0,
- Proc.new {||
+ one_bird(beg, 1.0, "western_flycatcher") do
bigbird(0, 0.2, 2000, 2200, 0.2, f_one, a_one, [1, 1, 2, 0.02, 3, 0.1, 4, 0.01])
bigbird(0.3, 0.2, 2000, 1100, 0.2, f_two, a_two, [1, 1, 2, 0.02, 3, 0.1, 4, 0.01])
- },
- report_in_minibuffer("western_flycatcher"))
+ end
end
@@ -700,8 +646,7 @@ def bachmans_sparrow(beg)
supn = [0.00, 0.00, 1.00, 1.0]
slast = [0.00, 1.00, 0.25, 0.00, 0.75, 0.40, 1.00, 0.50]
- one_bird(beg, 5.0,
- Proc.new {||
+ one_bird(beg, 5.0, "bachmans_sparrow") do
bird(0, 0.51, 4900, 200, 0.3, sopening, $main_amp)
bird(0.52, 0.015, 3800, 200, 0.1, sup, $main_amp)
bird(0.52, 0.015, 3750, 250, 0.1, sup, $main_amp)
@@ -743,8 +688,7 @@ def bachmans_sparrow(beg)
bird(4.0, 0.15, 3000, 1000, 0.2, slast, $main_amp)
bird(4.2, 0.15, 3000, 1000, 0.2, slast, $main_amp)
bird(4.4, 0.15, 3000, 1000, 0.2, slast, $main_amp)
- },
- report_in_minibuffer("bachmans_sparrow"))
+ end
end
@@ -752,11 +696,9 @@ def cedar_waxwing(beg)
cedar = [0.00, 0.00, 0.25, 0.70, 0.70, 1.00, 0.90, 1.00, 1.00, 0.20]
cedamp = [0.00, 0.00, 0.20, 1.00, 0.40, 1.00, 1.00, 0.0]
- one_bird(beg, 1.0,
- Proc.new {||
+ one_bird(beg, 1.0, "cedar_waxwing") do
bird(0, 0.50, 6000, 800, 0.2, cedar, cedamp)
- },
- report_in_minibuffer("cedar_waxwing"))
+ end
end
@@ -764,8 +706,7 @@ def bairds_sparrow(beg)
bairdend = [0.00, 0.00, 0.25, 1.00, 0.50, 0.00, 0.75, 1.00, 1.00, 0.0]
bairdstart = [0.00, 0.50, 0.05, 1.00, 0.10, 0.00, 0.15, 1.00, 0.20, 0.00, 0.25, 1.00, 0.30, 0.00, 0.35, 1.00, 0.40, 0.00, 0.45, 1.00, 0.50, 0.00, 0.55, 1.00, 0.60, 0.00, 0.65, 1.00, 0.70, 0.00, 0.75, 1.00, 0.80, 0.00, 0.85, 1.00, 0.90, 0.00, 0.95, 1.00, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "bairds_sparrow") do
bird(0, 0.09, 6500, 1500, 0.2, bairdstart, $main_amp)
bird(0.22, 0.01, 5900, 100, 0.2, bairdend, $main_amp)
bird(0.25, 0.09, 6000, 1000, 0.2, bairdstart, $main_amp)
@@ -806,8 +747,7 @@ def bairds_sparrow(beg)
bird(1.87, 0.01, 4200, 100, 0.06, bairdend, $main_amp)
bird(1.92, 0.01, 4400, 100, 0.06, bairdend, $main_amp)
bird(1.97, 0.01, 4200, 100, 0.05, bairdend, $main_amp)
- },
- report_in_minibuffer("bairds_sparrow"))
+ end
end
@@ -817,8 +757,7 @@ def kentucky_warbler(beg)
kenup = [0.00, 0.00, 1.00, 1.0]
kentrill = [0.00, 1.00, 0.25, 0.00, 0.50, 0.00, 0.75, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "kentucky_warbler") do
bigbird(0.6, 0.02, 3800, 200, 0.05, kenstart, $main_amp, [1, 1, 2, 0.03])
bigbird(0.65, 0.03, 4300, 200, 0.15, kenup, $main_amp, [1, 1, 2, 0.1])
bigbird(0.73, 0.02, 3200, 100, 0.1, kendwn, $main_amp, [1, 1, 2, 0.1])
@@ -850,8 +789,7 @@ def kentucky_warbler(beg)
bigbird(2.30, 0.05, 2800, 800, 0.15, kenstart, $main_amp, [1, 1, 2, 0.01])
bigbird(2.37, 0.06, 2700, 1200, 0.1, kendwn, $main_amp, [1, 1, 2, 0.01])
bigbird(2.45, 0.05, 4700, 100, 0.25, kentrill, $main_amp, [1, 1, 2, 0.1])
- },
- report_in_minibuffer("kentucky_warbler"))
+ end
end
@@ -860,8 +798,7 @@ def rufous_sided_towhee(beg)
towhee_two = [0.00, 0.00, 1.00, 1.0]
towhee_three = [0.00, 1.00, 1.00, 0.0]
- one_bird(beg, 2.0,
- Proc.new {||
+ one_bird(beg, 2.0, "rufous_sided_towhee") do
bigbird(0.25, 0.13, 1400, 1100, 0.2, towhee_one, $main_amp, [1, 0.03, 2, 1, 3, 0.03])
bigbird(0.45, 0.13, 1400, 1100, 0.2, towhee_one, $main_amp, [1, 0.03, 2, 1, 3, 0.03])
bigbird(0.60, 0.13, 1400, 1100, 0.2, towhee_one, $main_amp, [1, 0.03, 2, 1, 3, 0.03])
@@ -916,8 +853,7 @@ def rufous_sided_towhee(beg)
bird(1.480, 0.01, 5100, 1600, 0.03, towhee_two, $main_amp)
bird(1.495, 0.01, 5100, 1000, 0.03, towhee_two, $main_amp)
bird(1.515, 0.01, 3000, 1200, 0.03, towhee_three, $main_amp)
- },
- report_in_minibuffer("rufous_sided_towhee"))
+ end
end
@@ -926,8 +862,7 @@ def prothonotary_warbler(beg)
pro_two = [0.00, 0.00, 1.00, 1.0]
pro_amp = [0.00, 0.00, 0.20, 1.00, 0.40, 0.50, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "prothonotary_warbler") do
bird(0.76, 0.08, 3000, 3000, 0.05, pro_one, pro_amp)
bird(0.85, 0.05, 4000, 2500, 0.06, pro_two, $bird_amp)
@@ -948,8 +883,7 @@ def prothonotary_warbler(beg)
bird(2.30, 0.08, 3000, 3000, 0.10, pro_one, pro_amp)
bird(2.39, 0.05, 4000, 2500, 0.06, pro_two, $bird_amp)
- },
- report_in_minibuffer("prothonotary_warbler"))
+ end
end
@@ -959,8 +893,7 @@ def audubons_warbler(beg)
w_end = [0.00, 0.00, 0.15, 1.00, 0.45, 0.90, 0.50, 0.00, 0.55, 1.00, 0.90, 0.90, 1.00, 0.10]
w_updown = [0.00, 0.10, 0.50, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "audubons_warbler") do
bird(0.75, 0.04, 2400, 200, 0.05, w_down, $bird_amp)
bird(0.83, 0.03, 3200, 200, 0.1, w_up, $bird_amp)
bird(0.90, 0.04, 2500, 300, 0.15, w_up, $bird_amp)
@@ -981,8 +914,7 @@ def audubons_warbler(beg)
bird(1.79, 0.06, 2400, 1000, 0.10, w_down, $bird_amp)
bird(1.86, 0.14, 3100, 900, 0.25, w_end, $bird_amp)
bird(2.02, 0.12, 3200, 800, 0.20, w_end, $bird_amp)
- },
- report_in_minibuffer("audubons_warbler"))
+ end
end
@@ -992,8 +924,7 @@ def lark_bunting(beg)
b_trill_one = [0.00, 0.00, 0.06, 0.80, 0.12, 0.00, 0.18, 0.85, 0.24, 0.05, 0.36, 0.90, 0.42, 0.10, 0.48, 0.95, 0.54, 0.20, 0.60, 1.00, 0.66, 0.20, 0.72, 1.00, 0.78, 0.20, 0.84, 1.00, 0.90, 0.20, 1.00, 1.0]
b_trill_two = [0.00, 0.00, 0.05, 0.80, 0.10, 0.00, 0.15, 0.85, 0.20, 0.00, 0.25, 0.90, 0.30, 0.00, 0.35, 0.95, 0.40, 0.00, 0.45, 1.00, 0.50, 0.00, 0.55, 1.00, 0.60, 0.00, 0.65, 1.00, 0.70, 0.00, 0.75, 1.00, 0.80, 0.00, 0.85, 1.00, 0.90, 0.00, 0.95, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "lark_bunting") do
bird(0.1, 0.03, 1800, 100, 0.1, b_up, $bird_amp)
bird(0.2, 0.12, 3700, 400, 0.2, b_up, $bird_amp)
@@ -1027,8 +958,7 @@ def lark_bunting(beg)
bird(1.77, 0.23, 6000, 600, 0.15, b_trill_one, $bird_amp)
bird(2.005, 0.28, 6000, 600, 0.15, b_trill_two, $bird_amp)
- },
- report_in_minibuffer("lark_bunting"))
+ end
end
@@ -1039,8 +969,7 @@ def eastern_bluebird(beg)
blue_four = [0.00, 0.00, 0.50, 1.00, 1.00, 0.0]
blue_five = [0.00, 0.50, 0.10, 1.00, 0.20, 0.00, 0.35, 1.00, 0.50, 0.00, 0.65, 1.00, 0.80, 0.00, 0.95, 1.00, 1.00, 0.50]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "eastern_bluebird") do
bird(0.75, 0.02, 2000, 1600, 0.1, blue_one, $bird_amp)
bird(0.80, 0.02, 2000, 1600, 0.1, blue_one, $bird_amp)
bird(0.86, 0.02, 2000, 1600, 0.1, blue_one, $bird_amp)
@@ -1049,8 +978,7 @@ def eastern_bluebird(beg)
bird(1.68, 0.03, 2200, 400, 0.1, blue_one, $bird_amp)
bird(1.72, 0.10, 1950, 100, 0.15, blue_four, $bird_amp)
bird(1.96, 0.15, 2000, 600, 0.20, blue_five, $bird_amp)
- },
- report_in_minibuffer("eastern_bluebird"))
+ end
end
@@ -1059,13 +987,11 @@ def chuck_wills_widow(beg)
wid_one = [0.00, 0.00, 0.10, 0.10, 0.25, 1.00, 0.50, 0.30, 0.80, 0.70, 1.00, 0.0]
wid_two = [0.00, 0.20, 0.30, 1.00, 0.50, 0.30, 0.60, 0.70, 0.90, 0.10, 1.00, 0.0]
- one_bird(beg, 1.0,
- Proc.new {||
+ one_bird(beg, 1.0, "chuck_wills_widow") do
bird(0.05, 0.03, 1000, 800, 0.1, wid_down, $bird_amp)
bird(0.32, 0.20, 1000, 1000, 0.2, wid_one, $bird_amp)
bird(0.56, 0.29, 900, 1100, 0.2, wid_two, $bird_amp)
- },
- report_in_minibuffer("chuck_wills_widow"))
+ end
end
@@ -1073,8 +999,7 @@ def blue_gray_gnatcatcher(beg)
gskw1 = [0.00, 0.00, 0.15, 1.00, 0.75, 0.80, 0.90, 1.00, 1.00, 0.70]
gskw2 = [0.00, 0.00, 0.25, 1.00, 0.75, 0.70, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "blue_gray_gnatcatcher") do
bigbird(0.5, 0.20, 4000, 1000, 0.2, gskw1, $bird_amp, [1, 0.4, 2, 1, 3, 0.1])
bigbird(0.8, 0.13, 4000, 800, 0.2, gskw2, $bird_amp, [1, 0.4, 2, 1, 3, 0.2])
@@ -1082,8 +1007,7 @@ def blue_gray_gnatcatcher(beg)
bigbird(1.80, 0.17, 4000, 900, 0.2, gskw1, $bird_amp, [1, 0.4, 2, 1, 3, 0.3])
bigbird(2.00, 0.17, 4000, 700, 0.2, gskw1, $bird_amp, [1, 0.4, 2, 1, 3, 0.3])
bigbird(2.20, 0.17, 4000, 800, 0.2, gskw2, $bird_amp, [1, 0.4, 2, 1, 3, 0.3])
- },
- report_in_minibuffer("blue_gray_gnatcatcher" ))
+ end
end
@@ -1095,8 +1019,7 @@ def black_throated_sparrow(beg)
black_up_down = [0.00, 0.00, 0.50, 1.00, 1.00, 0.20]
black_amp = [0.00, 0.00, 0.50, 1.00, 1.00, 0.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "black_throated_sparrow") do
bird(0.8, 0.02, 2200, 1000, 0.1, black_down, $bird_amp)
bird(0.83, 0.01, 3000, 200, 0.05, black_up, $bird_amp)
bird(0.96, 0.02, 5800, 500, 0.05, black_up, $bird_amp)
@@ -1135,8 +1058,7 @@ def black_throated_sparrow(beg)
bird(2.13, 0.01, 1900, 100, 0.10, black_up, black_amp)
bird(2.16, 0.03, 3800, 300, 0.1, black_up, $bird_amp)
- },
- report_in_minibuffer("black_throated_sparrow"))
+ end
end
@@ -1145,8 +1067,7 @@ def black_chinned_sparrow(beg)
chin_up = [0.00, 0.00, 1.00, 1.0]
chin_up2 = [0.00, 0.00, 0.30, 0.20, 1.00, 1.0]
- one_bird(beg, 3.0,
- Proc.new {||
+ one_bird(beg, 3.0, "black_chinned_sparrow") do
bird(0.6, 0.2, 4200, 100, 0.1, chin_up, $bird_amp)
bird(1.0, 0.09, 3800, 2000, 0.1, chin_up2, $bird_amp)
bird(1.25, 0.08, 3900, 1700, 0.12, chin_up2, $bird_amp)
@@ -1163,8 +1084,7 @@ def black_chinned_sparrow(beg)
bird(2.19, 0.02, 3900, 100, 0.03, chin_up, $bird_amp)
bird(2.22, 0.01, 3900, 100, 0.01, chin_up, $bird_amp)
bird(2.24, 0.01, 3900, 100, 0.01, chin_up, $bird_amp)
- },
- report_in_minibuffer("black_chinned_sparrow"))
+ end
end
@@ -1174,8 +1094,7 @@ def various_gull_cries_from_end_of_colony_5(beg)
gullend = [0, 0, 5, 1, 10, 0.5000, 90, 0.4000, 100, 0]
unknown = [1, 0.1, 2, 1, 3, 0.1, 4, 0.01, 5, 0.09, 6, 0.01, 7, 0.01]
- one_bird(beg, 10.0,
- Proc.new {||
+ one_bird(beg, 10.0, "gulls") do
bigbird(0.250, 0.80, 1180, 1180, 0.08, gullend, $bird_amp, unknown)
bigbird(1.500, 0.90, 1180, 1180, 0.07, gullend, $bird_amp, unknown)
bigbird(2.750, 1.00, 1050, 1050, 0.08, gullend, $bird_amp, unknown)
@@ -1186,8 +1105,7 @@ def various_gull_cries_from_end_of_colony_5(beg)
bigbird(5.450, 0.40, 1050, 1050, 0.1, gullend, $bird_amp, unknown)
bigbird(6.250, 0.80, 1050, 1050, 0.1, gullend, $bird_amp, unknown)
bigbird(7.450, 1.80, 1050, 1050, 0.1, gullend, $bird_amp, unknown)
- },
- report_in_minibuffer("gulls"))
+ end
end
@@ -1241,5 +1159,3 @@ def make_birds
# $stderr.write sprintf("time: %f\n", btime - atime)
end
-
-
diff --git a/bird.scm b/bird.scm
index 0059f07..351a87d 100644
--- a/bird.scm
+++ b/bird.scm
@@ -1,1078 +1,1111 @@
;;; bird songs -- (load "bird.scm") then (make-birds)
-;;; writes "test.snd" unless you give it a file name as in (make-birds "hiho.snd")
;;;
-;;; some of the bird names date this work to 1980 using a bird guide published in 1966
-
+;;; some of the bird names come from a 1966 bird guide
+;;;
;;; see animals.scm for later versions of some of these songs
;;;
-;;; 3-Nov-08: I changed some of the instrument names to avoid collisions with animals.scm (prepended "b-")
-
+;;; 3-Nov-08: changed some of the function names to avoid collisions with animals.scm (prepended "b-")
+;;; 13-Dec-12: minor optimizations
(provide 'snd-bird.scm)
;;; translated (semi-automatically) from a Sambox note list to bird.clm, then bird.scm
-(if (and (not (provided? 'snd-ws.scm))
- (not (provided? 'sndlib-ws.scm)))
- (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(definstrument (bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials)
- "(bigbird start dur frequency freqskew amplitude freq-envelope amp-envelope partials)"
-
- (let* ((gls-env (make-env freq-envelope (hz->radians freqskew) dur))
- (os (make-polyshape frequency :coeffs (partials->polynomial (normalize-partials partials))))
- (amp-env (make-env amp-envelope amplitude dur))
- (beg (seconds->samples start))
- (len (seconds->samples dur))
- (end (+ beg len)))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (outa i (* (env amp-env)
- (polyshape os 1.0 (env gls-env))))))))
+ (let ((gls-env (make-env freq-envelope (hz->radians freqskew) dur))
+ (os (make-polywave frequency :partials (normalize-partials partials)))
+ (amp-env (make-env amp-envelope amplitude dur))
+ (beg (seconds->samples start))
+ (end (seconds->samples (+ start dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* (env amp-env)
+ (polywave os (env gls-env)))))))
(definstrument (bird start dur frequency freqskew amplitude freq-envelope amp-envelope)
- "(bird start dur frequency freqskew amplitude freq-envelope amp-envelope)"
- (let* ((gls-env (make-env freq-envelope (hz->radians freqskew) dur))
- (os (make-oscil frequency))
- (amp-env (make-env amp-envelope amplitude dur))
- (len (seconds->samples dur))
- (beg (seconds->samples start))
- (end (+ beg len)))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (outa i (* (env amp-env)
- (oscil os (env gls-env))))))))
-
+ (let ((gls-env (make-env freq-envelope (hz->radians freqskew) dur))
+ (os (make-oscil frequency))
+ (amp-env (make-env amp-envelope amplitude dur))
+ (end (seconds->samples (+ start dur)))
+ (beg (seconds->samples start)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* (env amp-env)
+ (oscil os (env gls-env)))))))
+
(define main-amp '(.00 .00 .25 1.00 .60 .70 .75 1.00 1.00 .0))
(define bird-tap '(.00 .00 .01 1.00 .99 1.00 1.00 .0))
(define bird-amp '(.00 .00 .25 1.00 .75 1.00 1.00 .0))
-(define (b-orchard-oriole beg)
- "(orchard-oriole beg) produces an orchard oriole call at time 'beg'"
- (let ((oriup '(.00 .00 1.00 1.0))
- (oridwn '(.00 1.00 1.00 .0))
- (oriupdwna '(.00 .00 .60 1.00 1.00 .60 ))
- (oriupdwnb '(.00 .50 .30 1.00 1.00 .0))
- (oribiga '(.00 .90 .15 1.00 .40 .30 .60 .60 .85 .00 1.00 .0))
- (orimid '(.00 1.00 .05 .50 .10 1.00 .25 .00 .85 .50 1.00 .0))
- (oridwnup '(.00 .30 .25 .00 1.00 1.0))
- (oriamp '(.00 .00 .10 1.00 1.00 .0)))
- (set! beg (- beg .38))
- (bird (+ beg .38) .03 3700 100 .05 oridwn main-amp)
- (bird (+ beg .41) .05 2500 1000 .1 oriup main-amp)
- (bigbird (+ beg .5) .1 2000 800 .2 oriupdwna main-amp '(1 1 2 .02 3 .05))
- (bird (+ beg .65) .03 3900 1200 .1 oridwn main-amp)
- (bigbird (+ beg .7) .21 2000 1200 .15 oribiga main-amp '(1 1 2 .05))
- (bird (+ beg 1.0) .05 4200 1000 .1 oridwn main-amp)
- (bigbird (+ beg 1.1) .1 2000 1000 .25 orimid main-amp '(1 1 2 .05))
- (bigbird (+ beg 1.3) .1 2000 1000 .25 orimid main-amp '(1 1 2 .05))
- (bird (+ beg 1.48) .1 2300 3200 .1 oriupdwnb oriamp)
- (bird (+ beg 1.65) .03 1800 300 .05 oriup main-amp)
- (bird (+ beg 1.7) .03 2200 100 .04 oridwn main-amp)
- (bird (+ beg 1.8) .07 2500 2000 .15 oriupdwnb oriamp)
- (bigbird (+ beg 1.92) .2 2400 1200 .25 oridwnup main-amp '(1 1 2 .04))
- (bird (+ beg 2.2) .02 2200 3000 .04 oriup main-amp)
- (bird (+ beg 2.28) .02 2200 3000 .04 oriup main-amp)
- (bigbird (+ beg 2.4) .17 2000 1000 .2 oriupdwna oriamp '(1 1 2 .04))))
-
-
-(define (b-cassins-kingbird beg)
- "(cassins-kingbird beg) produces a cassins kingbird call at time 'beg'"
- (let ((kingfirst '(.00 .30 .45 1.00 .90 .10 1.00 .0))
- (kingsecond '(.00 .00 .02 .50 .04 .00 .06 .55 .08 .05 .10 .60 .12 .05 .14 .65 .16 .10 .18 .70 .20 .10 .22 .75 .24 .15 .26 .80 .28 .20 .30 .85 .32 .25 .34 .90 .36 .30 .38 .95 .40 .40 .42 1.00 .44 .50 .46 1.00 .48 .45 .50 1.00 .52 .50 .54 1.00 .56 .40 .58 .95 .60 .40 .62 .90 .64 .40 .66 .85 .68 .35 .70 .80 .72 .30 .74 .75 .76 .25 .78 .70 .80 .20 .82 .65 .84 .10 .86 .60 .88 .00 .90 .55 .92 .00 .94 .50 .96 .00 1.00 .40 )))
- (set! beg (- beg .03))
- (bigbird (+ beg .03) .04 1700 1200 .15 kingfirst main-amp '(1 1 2 .5 3 0 4 .2))
- (bigbird (+ beg .12) .18 1700 900 .25 kingsecond main-amp '(1 1 2 .01 3 0 4 .1))))
-
-
-(define (b-chipping-sparrow beg)
- "(chipping-sparrow beg) produces a chipping sparrow call at time 'beg'"
- (let ((chip-up '(.00 .80 .15 1.00 .75 .30 1.00 .0)))
- (bird (+ beg 0) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .06) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .12) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .18) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .24) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .30) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .36) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .42) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .48) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .54) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .60) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .66) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .72) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .78) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .84) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .90) .05 4000 2400 .2 chip-up main-amp)
- (bird (+ beg .96) .05 4000 2400 .2 chip-up main-amp)))
-
-
-(define (b-bobwhite beg)
- "(bobwhite beg) produces a bobwhite call at time 'beg'"
- (let ((bobup1 '(.00 .00 .40 1.00 1.00 1.0))
- (bobup2 '(.00 .00 .65 .50 1.00 1.0)))
- (set! beg (- beg .4))
- (bigbird (+ beg .4) .2 1800 200 .1 bobup1 main-amp '(1 1 2 .02))
- (bigbird (+ beg 1) .20 1800 1200 .2 bobup2 main-amp '(1 1 2 .02))))
-
-
-(define (b-western-meadowlark beg)
- "(western-meadowlark beg) produces a western meadowlark call at time 'beg'"
- (let ((no-skw '(.00 .00 1.00 .0))
- (down-skw '(.00 1.00 .40 .40 1.00 .0))
- (fas-down '(.00 1.00 1.00 .0)))
- (set! beg (- beg .8))
- (bigbird (+ beg .800) .1 2010.000 0.000 .100 no-skw main-amp '(1 1 2 .04))
- (bigbird (+ beg 1.100) .15 3000.000 100.000 .110 down-skw main-amp '(1 1 2 .04))
- (bigbird (+ beg 1.300) .25 2000.000 150.000 .200 down-skw main-amp '(1 1 2 .04))
- (bigbird (+ beg 1.650) .15 3010.000 250.000 .110 down-skw main-amp '(1 1 2 .04))
- (bigbird (+ beg 1.850) .10 2200.000 150.000 .110 down-skw main-amp '(1 1 2 .04))
- (bigbird (+ beg 2.000) .10 3200.000 1400.000 .110 fas-down main-amp '(1 1 2 .04))
- (bigbird (+ beg 2.200) .05 2000.000 200.000 .110 fas-down main-amp '(1 1 2 .04))
- (bigbird (+ beg 2.300) .10 1600.000 0.000 .110 fas-down main-amp '(1 1 2 .04))))
-
-
-(define (b-scissor-tailed-flycatcher beg)
- "(scissor-tailed-flycatcher beg) produces a scissor-tailed flycatcher call at time 'beg'"
- (let ((scissor '(.00 .00 .40 1.00 .60 1.00 1.00 .0)))
- (bigbird (+ beg 0) .05 1800 1800 .2 scissor main-amp '(1 .5 2 1 3 .5 4 .1 5 .01))))
-
-
-(define (b-great-horned-owl beg)
- "(great-horned-owl beg) produces a great horned owl call at time 'beg'"
- (let ((owlup '(.00 .00 .30 1.00 1.00 1.0))
- (owldown '(.00 1.00 1.00 .0)))
- (set! beg (- beg .3))
- (bigbird (+ beg .3) .1 300 0 .1 main-amp main-amp '(1 1 3 .02 7 .01))
- (bigbird (+ beg .6) .4 293 6 .1 owldown main-amp '(1 1 3 .02 7 .01))
- (bigbird (+ beg 1.75) .35 293 7 .1 owlup main-amp '(1 1 3 .02 7 .01))
- (bigbird (+ beg 2.5) .2 300 0 .1 owlup main-amp '(1 1 3 .02 7 .01))))
-
-
-(define (b-black-throated-gray-warbler beg)
- "(black-throated-gray-warbler beg) produces a black throated gray warbler call at time 'beg'"
- (let ((grayone '(.00 .50 .02 .60 .04 .45 .06 .62 .08 .40 .10 .65 .12 .35 .14 .70 .18 .30 .20 .70 .22 .30 .24 .70 .25 .20 .30 .80 .35 .10 .40 .90 .45 .00 .50 1.00 .55 .00 .60 1.00 .65 .00 .70 1.00 .75 .00 .80 1.00 .85 .00 .90 1.00 .95 .00 1.00 .50 ))
- (graytwo '(.00 .00 .01 .40 .02 .00 .03 .40 .04 .00 .05 .40 .06 .00 .07 .40 .08 .00 .09 .40 .10 .00 .25 .80 .40 .30 .55 1.00 .70 .00 .85 .80 1.00 .40 ))
- (graythree '(.00 1.00 .01 .60 .02 1.00 .03 .60 .04 1.00 .05 .60 .06 1.00 .07 .60 .08 1.00 .09 .60 .10 1.00 .11 .60 .12 1.00 .13 .60 .14 1.00 .15 .60 .16 1.00 .17 .60 .18 1.00 .19 .60 .20 1.00 .21 .55 .22 1.00 .23 .50 .24 1.00 .25 .50 .26 1.00 .27 .50 .28 1.00 .29 .50 .30 1.00 .31 .50 .32 1.00 .33 .50 .34 1.00 .35 .50 .36 1.00 .37 .50 .38 1.00 .39 .50 .40 1.00 .41 .50 .42 1.00 .43 .50 .44 1.00 .45 .50 .46 1.00 .47 .50 .48 1.00 .49 .50 .50 1.00 .51 .50 .52 1.00 .53 .50 .54 1.00 .55 .50 .56 1.00 .57 .50 .58 1.00 .59 .50 .60 1.00 1.00 .0))
- (grayfour '(.00 .00 1.00 1.0)))
- (bird (+ beg 0) .12 3700 600 .05 grayone main-amp)
- (bird (+ beg .18) .08 3000 800 .07 graytwo main-amp)
- (bird (+ beg .28) .12 3700 600 .12 grayone main-amp)
- (bird (+ beg .44) .08 3000 800 .15 graytwo main-amp)
- (bird (+ beg .54) .12 3700 600 .20 grayone main-amp)
- (bird (+ beg .72) .08 3000 800 .25 graytwo main-amp)
- (bird (+ beg .82) .12 3700 600 .25 grayone main-amp)
- (bird (+ beg .96) .2 3000 2000 .2 graythree main-amp)
- (bird (+ beg 1.2) .02 4500 500 .05 grayfour main-amp)
- (bird (+ beg 1.25) .02 4200 800 .05 grayfour main-amp)
- (bird (+ beg 1.3) .02 4000 900 .05 grayfour main-amp)))
-
-
-(define (b-yellow-warbler beg)
- "(yellow-warbler beg) produces a yellow warbler call at time 'beg'"
- (let ((yellow-up '(.00 .00 .60 1.00 1.00 .50 ))
- (yellow-swirl '(.00 1.00 .05 1.00 .60 .00 .80 .30 1.00 .10 ))
- (yellow-down '(.00 1.00 1.00 .0))
- (yellow-last '(.00 .00 .30 .20 .80 .70 1.00 1.0))
- (swirl-amp '(.00 .00 .90 1.00 1.00 .0)))
- (bird (+ beg 0) .05 5600 400 .05 yellow-up main-amp)
- (bird (+ beg .23) .12 5000 1500 .15 yellow-swirl swirl-amp)
- (bird (+ beg .45) .13 5000 1700 .17 yellow-swirl swirl-amp)
- (bird (+ beg .62) .16 5000 2000 .20 yellow-swirl swirl-amp)
- (bird (+ beg .85) .15 5000 2000 .20 yellow-swirl swirl-amp)
- (bird (+ beg 1.05) .075 3700 1000 .20 yellow-down main-amp)
- (bird (+ beg 1.15) .075 3700 800 .15 yellow-down main-amp)
- (bird (+ beg 1.25) .075 3700 800 .15 yellow-down main-amp)
- (bird (+ beg 1.4) .2 3700 2000 .2 yellow-last swirl-amp)))
-
-
-(define (b-black-necked-stilt beg)
- "(black-necked-stilt beg) produces a black necked stilt call at time 'beg'"
- (let (
- ;; have to guess about upper partials (cut off by spectrograph)
- ;; "birds" book has piping sound coming back down whereas "songs
- ;; of western birds" just shows it going up.
- ;;
- (upamp '(.00 .00 .90 1.00 1.00 .0))
- (rampup '(.00 .00 .50 1.00 1.00 .20 )))
- (bigbird (+ beg 0) .1 900 100 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))
- (bigbird (+ beg .30) .1 900 200 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))
- (bigbird (+ beg .60) .1 900 250 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))))
-
-
-(define (b-chestnut-sided-warbler beg)
- "(chestnut-sided-warbler beg) produces a chestnut sided warbler call at time 'beg'"
- (let ((ycurve '(.00 1.00 .30 .50 .60 1.00 .80 .20 1.00 .0))
- (vcurve '(.00 .20 .50 1.00 1.00 .0))
- (wcurve '(.00 .50 .15 .00 .45 .10 .60 1.00 .70 .90 1.00 .90 ))
- (upcurve '(.00 .00 .95 1.00 1.00 1.0))
- (downcurve '(.00 1.00 .25 .30 .60 .15 1.00 .0))
- (louder '(.00 .00 .90 1.00 1.00 .0))
- (wamp '(.00 .00 .10 1.00 .40 .10 .50 .90 .60 .10 .70 1.00 1.00 .0)))
- (set! beg (- beg .1))
- (bigbird (+ beg .1) .1 4050 1200 .05 ycurve main-amp '(1 1 2 .1))
- (bigbird (+ beg .25) .03 3900 300 .075 vcurve main-amp '(1 1 2 .1))
- (bigbird (+ beg .3) .1 4050 1200 .15 ycurve louder '(1 1 2 .1))
- (bigbird (+ beg .42) .03 3800 500 .1 vcurve main-amp '(1 1 2 .1))
- (bigbird (+ beg .5) .1 4000 1200 .2 ycurve bird-tap '(1 1 2 .1))
- (bigbird (+ beg .65) .03 3800 500 .15 vcurve main-amp '(1 1 2 .1))
- (bigbird (+ beg .72) .1 4000 1200 .2 ycurve bird-tap '(1 1 2 .1))
- (bigbird (+ beg .85) .03 3800 500 .15 vcurve main-amp '(1 1 2 .1))
- (bigbird (+ beg .91) .1 4000 1200 .2 ycurve bird-tap '(1 1 2 .1))
- (bigbird (+ beg 1.05) .12 3800 2200 .15 wcurve wamp '(1 1 2 .1))
- (bigbird (+ beg 1.20) .12 3800 2200 .15 wcurve wamp '(1 1 2 .1))
- (bigbird (+ beg 1.35) .12 2500 2200 .25 upcurve louder '(1 1 2 .1))
- (bigbird (+ beg 1.50) .12 2500 4000 .15 downcurve main-amp '(1 1 2 .1))))
-
-
-(define (b-grasshopper-sparrow beg)
- "(grasshopper-sparrow beg) produces a grasshopper sparrow call at time 'beg'"
- (let ((grassone '(.00 .50 .02 .80 .04 .30 .06 .80 .07 .10 .08 .90 .10 .00 .11 .90 .12 .00 .13 .90 .14 .10 .15 1.00 .16 .10 .17 1.00 .18 .10 .19 1.00 .20 .10 .21 1.00 .22 .10 .23 1.00 .24 .10 .25 1.00 .26 .10 .27 1.00 .28 .10 .29 1.00 .30 .10 .31 1.00 .32 .10 .33 1.00 .34 .10 .35 1.00 .36 .10 .37 1.00 .38 .10 .39 1.00 .40 .10 .41 1.00 .42 .10 .43 1.00 .44 .10 .45 1.00 .46 .10 .47 1.00 .48 .10 .49 1.00 .50 .10 .51 1.00 .52 .10 .53 1.00 .54 .10 .55 1.00 .56 .10 .57 1.00 .58 .10 .59 1.00 .60 .10 .61 1.00 .62 .10 .63 1.00 .64 .10 .65 1.00 .66 .10 .67 1.00 .68 .10 .69 1.00 .70 .10 .71 1.00 .72 .10 .73 1.00 .74 .10 .75 1.00 .76 .10 .77 1.00 .78 .10 .79 1.00 .80 .10 .81 1.00 .82 .10 .83 1.00 .84 .10 .85 1.00 .86 .10 .87 1.00 .88 .10 .89 1.00 .90 .10 .91 1.00 .92 .10 .93 1.00 .94 .10 .95 1.00 .96 .10 .97 1.00 .98 .10 1.00 1.0))
- (grasstwo '(.00 .00 .10 1.00 .20 .00 .30 1.00 .40 .00 .50 1.00 .60 .00 .70 1.00 .80 .00 .90 1.00 1.00 .0)))
- (set! beg (- beg .49))
- (bird (+ beg .49) .01 8000 100 .1 grasstwo main-amp)
- (bird (+ beg .60) .01 5700 300 .1 grasstwo main-amp)
- (bird (+ beg .92) .01 3900 100 .1 grasstwo main-amp)
- (bird (+ beg 1.00) 1.4 6000 2500 .2 grassone main-amp)))
-
-
-(define (b-swamp-sparrow beg)
- "(swamp-sparrow beg) produces a swamp sparrow call at time 'beg'"
- (let ((swamp-up '(.00 .00 .60 .70 1.00 1.0))
- (swamp-down '(.00 1.00 .50 .50 .60 .60 1.00 .0)))
- (bird (+ beg 0) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .035) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .08) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .1) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .135) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .18) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .2) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .235) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .28) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .3) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .335) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .38) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .4) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .435) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .48) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .5) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .535) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .58) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .6) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .635) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .68) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .7) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .735) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .78) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .8) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .835) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .88) .025 3700 0 .1 main-amp main-amp)
-
- (bird (+ beg .9) .02 3900 200 .3 swamp-up main-amp)
- (bird (+ beg .935) .035 3200 3000 .1 swamp-down main-amp)
- (bird (+ beg .98) .025 3700 0 .1 main-amp main-amp)))
-
-
-(define (b-golden-crowned-sparrow beg)
- "(golden-crowned-sparrow beg) produces a golden crowned sparrow call at time 'beg'"
- (let (
- ;; these have as different song around here.
- (goldone '(.00 1.00 .25 .20 1.00 .0))
- (goldtwo '(.00 .90 .05 1.00 .10 .40 1.00 .0))
- (goldtrill '(.00 .50 .10 .00 .20 1.00 .30 .00 .40 1.00 .50 .00 .60 1.00 .70 .00 .80 1.00 .90 .00 1.00 .50 )))
- (set! beg (- beg .6))
- (bird (+ beg .6) .5 4300 1000 .15 goldone main-amp)
- (bird (+ beg 1.3) .45 3300 200 .15 goldone main-amp)
- (bird (+ beg 1.75) .4 3800 100 .15 goldtwo main-amp)
- (bird (+ beg 2.2) .3 3800 100 .1 goldtrill main-amp)))
-
-
-(define (b-indigo-bunting beg)
- "(indigo-bunting beg) produces a indigo bunting call at time 'beg'"
- (let ((buntdwn '(.00 1.00 1.00 .0))
- (buntv '(.00 .00 .50 1.00 1.00 .0))
- (bunty '(.00 1.00 .50 .00 1.00 .90 ))
- (buntn '(.00 .80 .30 1.00 .70 .20 1.00 .0))
- (buntx '(.00 1.00 .10 .50 .25 .90 1.00 .0))
- (buntup '(.00 .00 1.00 1.0)))
- (set! beg (- beg .4))
- (bird (+ beg .4) .08 3000 700 .25 buntdwn main-amp)
- (bird (+ beg .52) .02 6200 1000 .05 buntdwn main-amp)
- (bird (+ beg .55) .15 3500 2300 .1 buntv main-amp)
- (bird (+ beg .74) .02 6200 1800 .05 buntx main-amp)
- (bird (+ beg .80) .15 3400 2300 .1 buntv main-amp)
- (bird (+ beg 1.00) .1 3400 800 .2 buntv main-amp)
- (bird (+ beg 1.13) .03 4100 2000 .05 buntdwn main-amp)
- (bird (+ beg 1.25) .08 3400 800 .2 buntv main-amp)
- (bird (+ beg 1.40) .03 4100 2000 .05 buntdwn main-amp)
- (bird (+ beg 1.5) .07 3700 300 .1 buntdwn main-amp)
- (bird (+ beg 1.6) .1 4100 2200 .15 bunty main-amp)
- (bird (+ beg 1.72) .05 3700 300 .1 buntdwn main-amp)
- (bird (+ beg 1.81) .1 4100 2200 .15 bunty main-amp)
- (bird (+ beg 1.94) .07 5200 1800 .2 buntn main-amp)
- (bird (+ beg 2.05) .08 3000 1500 .15 buntup main-amp)
- (bird (+ beg 2.20) .07 5200 1800 .2 buntn main-amp)
- (bird (+ beg 2.33) .08 3000 1500 .15 buntup main-amp)
- (bird (+ beg 2.43) .07 5200 1800 .1 buntn main-amp)
- (bird (+ beg 2.51) .08 3000 1500 .10 buntup main-amp)))
-
-
-(define (b-hooded-warbler beg)
- "(hooded-warbler beg) produces a hooded warbler call at time 'beg'"
- (let ((hoodup '(.00 .00 1.00 1.0))
- (hooddown '(.00 1.00 1.00 .0)))
- (set! beg (- beg .6))
- (bird (+ beg .6) .03 3900 1600 .05 hooddown main-amp)
- (bird (+ beg .64) .03 3900 1700 .05 hooddown main-amp)
- (bird (+ beg .8) .03 3900 2000 .10 hooddown main-amp)
- (bird (+ beg .84) .03 3900 2000 .10 hooddown main-amp)
- (bird (+ beg .93) .03 3900 2100 .15 hooddown main-amp)
- (bird (+ beg .97) .03 3900 2100 .15 hooddown main-amp)
- (bird (+ beg 1.05) .03 3900 2100 .05 hooddown main-amp)
- (bird (+ beg 1.09) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.17) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.21) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.39) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.43) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.51) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.55) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.63) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.67) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.75) .03 3900 2100 .2 hooddown main-amp)
- (bird (+ beg 1.80) .03 3900 2100 .2 hooddown main-amp)
-
- (bird (+ beg 1.90) .04 3000 1000 .15 hoodup main-amp)
- (bird (+ beg 1.98) .04 3000 1000 .15 hoodup main-amp)
- (bird (+ beg 2.05) .04 3000 1000 .15 hoodup main-amp)
- (bird (+ beg 2.13) .04 3000 1000 .15 hoodup main-amp)
- (bird (+ beg 2.21) .04 3000 1000 .15 hoodup main-amp)
- (bird (+ beg 2.29) .04 3000 1000 .15 hoodup main-amp)
- (bird (+ beg 2.37) .04 3000 1000 .15 hoodup main-amp)
- (bird (+ beg 2.45) .04 3000 1000 .15 hoodup main-amp)))
-
-
-(define (b-american-widgeon beg)
- "(american-widgeon beg) produces an american widgeon call at time 'beg'"
- (let ((widgeon '(.00 .00 .50 1.00 1.00 .0)))
- (set! beg (- beg .3))
- (bigbird (+ beg .3) .07 1900 300 .15 widgeon widgeon '(1 1 2 .02))
- (bigbird (+ beg .4) .11 1700 1400 .25 widgeon widgeon '(1 .7 2 1 3 .02))
- (bigbird (+ beg .55) .07 1900 300 .15 widgeon widgeon '(1 1 2 .02))))
-
-
-(define (b-louisiana-waterthrush beg)
- "(louisiana-waterthrush beg) produces a louisiana waterthrush call at time 'beg'"
- (let ((water-one '(.00 .80 .35 .40 .45 .90 .50 1.00 .75 1.00 1.00 .10 ))
- (water-two '(.00 1.00 .40 .00 .60 .10 1.00 .80 ))
- (water-three '(.00 1.00 .95 .00 1.00 .0))
- (water-four '(.00 .00 1.00 1.0))
- (water-five '(.00 1.00 1.00 .0))
- (water-amp '(.00 .00 .35 1.00 .50 .20 .90 1.00 1.00 .0))
- (water-damp '(.00 .00 .90 1.00 1.00 .0)))
- (bird (+ beg 0) .17 4100 2000 .2 water-one water-amp)
- (bird (+ beg .32) .18 4050 2050 .3 water-one water-amp)
- (bird (+ beg .64) .20 4000 1900 .25 water-one water-amp)
- (bird (+ beg .9) .2 3900 2000 .3 water-two bird-tap)
- (bird (+ beg 1.25) .12 3000 3000 .25 water-three water-damp)
- (bird (+ beg 1.4) .1 2700 1500 .2 water-four water-damp)
- (bird (+ beg 1.58) .02 5200 1000 .1 water-five main-amp)
- (bird (+ beg 1.65) .02 5200 1000 .1 water-five main-amp)
- (bird (+ beg 1.7) .035 3200 1000 .1 water-four water-damp)))
-
-
-(define (b-robin beg)
- "(robin beg) produces a robin call at time 'beg'"
- (let ((r-one '(.00 .10 .08 .70 .30 .00 .35 1.00 .40 .30 1.00 .30 ))
- (r-two '(.00 .00 .10 1.00 .20 .70 .35 .70 .65 .30 .70 .50 .80 .00 .90 .20 1.00 .0))
- (r-three '(.00 .20 .25 1.00 .60 .70 .90 .00 1.00 .10 ))
- (r-four '(.00 1.00 1.00 .0))
- (r-five '(.00 .50 .10 .00 .20 1.00 .30 .00 .40 1.00 .50 .00 .60 1.00 .70 .50 1.00 .20 ))
- (r-six '(.00 .00 .12 .70 .30 .00 .70 1.00 1.00 .50 )))
- (set! beg (- beg .45))
- (bigbird (+ beg .45) .06 2000 800 .15 r-six main-amp '(1 1 2 .1))
- (bigbird (+ beg .56) .10 2000 900 .15 r-one main-amp '(1 1 2 .1))
- (bigbird (+ beg 1.04) .24 2000 2000 .25 r-two main-amp '(1 1 2 .1))
- (bigbird (+ beg 1.63) .13 1900 1600 .20 r-three main-amp '(1 1 2 .1))
- (bigbird (+ beg 1.80) .11 2200 1200 .25 r-four main-amp '(1 1 2 .1))
- (bigbird (+ beg 2.31) .21 1950 2000 .15 r-five main-amp '(1 1 2 .1))))
-
-
-(define (b-solitary-vireo beg)
- "(solitary-vireo beg) produces a solitary vireo call at time 'beg'"
- (let ((bigskew '(.00 .20 .03 .30 .06 .10 .10 .50 .13 .40 .16 .80 .19 .50 .22 .90 .25 .60 .28 1.00 .31 .60 .34 1.00 .37 .50 .41 .90 .45 .40 .49 .80 .51 .40 .54 .75 .57 .35 .60 .70 .63 .30 .66 .60 .69 .25 .72 .50 .75 .20 .78 .30 .82 .10 .85 .30 .88 .05 .91 .30 .94 .00 .95 .30 .99 .00 1.00 .10 )))
- (bird (+ beg 0) .4 1800 1200 .2 bigskew main-amp)))
-
-
-(define (b-pigeon-hawk beg)
- "(pigeon-hawk beg) produces a pigeon hawk (merlin) call at time 'beg'"
- (let ((hupdown '(.00 .00 .30 1.00 .70 1.00 1.00 .0)))
- (bigbird (+ beg 0) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .12) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .13) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .25) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .26) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .38) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .39) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .51) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .52) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .64) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .65) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .77) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .78) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg .90) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg .91) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.03) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.04) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.16) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.17) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.29) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.30) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.42) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.43) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.55) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.56) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.68) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.69) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
- (bigbird (+ beg 1.81) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
- (bigbird (+ beg 1.82) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))))
-
-
-(define (b-cerulean-warbler beg)
- "(cerulean-warbler beg) produces a cerulean warbler call at time 'beg'"
- (let ((w-down '(.00 1.00 1.00 .0))
- (trill '(.00 .80 .10 1.00 .25 .50 .40 1.00 .55 .50 .70 1.00 1.00 .0))
- (w-up '(.00 .00 1.00 1.0)))
- (set! beg (- beg .27))
- (bird (+ beg .27) .05 3000 1000 .05 w-down main-amp)
- (bird (+ beg .33) .05 3000 800 .075 w-up main-amp)
- (bird (+ beg .41) .01 3200 700 .07 w-down main-amp)
- (bird (+ beg .42) .01 3200 700 .08 w-down main-amp)
- (bird (+ beg .43) .06 3200 700 .09 w-down main-amp)
- (bird (+ beg .51) .06 3200 500 .1 w-up main-amp)
- (bird (+ beg .6) .10 3000 1200 .2 trill main-amp)
- (bird (+ beg .72) .05 3000 800 .2 w-up main-amp)
- (bird (+ beg .8) .10 3000 1200 .2 trill main-amp)
- (bird (+ beg .92) .05 3000 800 .2 w-up main-amp)
- (bird (+ beg 1.00) .01 3900 600 .1 w-up main-amp)
- (bird (+ beg 1.01) .01 3910 800 .1 w-up main-amp)
- (bird (+ beg 1.02) .01 3940 500 .1 w-up main-amp)
- (bird (+ beg 1.03) .01 4000 500 .1 w-up main-amp)
- (bird (+ beg 1.04) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.05) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.06) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.07) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.08) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.09) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.10) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.11) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.12) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.13) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.14) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.15) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.16) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.17) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.18) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.19) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.20) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.21) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.22) .01 3900 1000 .1 w-up main-amp)
- (bird (+ beg 1.23) .01 3900 1200 .1 w-up main-amp)
- (bird (+ beg 1.24) .01 3900 1200 .1 w-up main-amp)
- (bird (+ beg 1.25) .01 3900 1200 .1 w-up main-amp)
- (bird (+ beg 1.26) .01 3900 1200 .1 w-up main-amp)
- (bird (+ beg 1.27) .01 3900 1400 .1 w-up main-amp)
- (bird (+ beg 1.28) .01 3900 1400 .1 w-up main-amp)
- (bird (+ beg 1.29) .01 3900 1400 .1 w-up main-amp)
- (bird (+ beg 1.30) .01 3900 1400 .1 w-up main-amp)))
-
-
-(define (b-nashville-warbler beg)
- "(nashville-warbler beg) produces a nashville warbler call at time 'beg'"
- (let ((nash-blip '(.00 .60 .35 1.00 1.00 .0))
- (nash-down '(.00 .90 .05 1.00 .10 .90 .65 .50 1.00 .0))
- (nash-up '(.00 .00 .15 .20 .25 .05 .90 .95 1.00 1.0))
- (nash-amp '(.00 .00 .80 1.00 1.00 .0)))
- (set! beg (- beg .15))
- (bird (+ beg .15) .025 3900 300 .3 nash-blip main-amp)
- (bird (+ beg .24) .16 4200 3800 .15 nash-down nash-amp)
- (bird (+ beg .42) .025 3900 300 .3 nash-blip main-amp)
- (bird (+ beg .55) .14 4300 3700 .15 nash-down nash-amp)
- (bird (+ beg .75) .03 3950 350 .3 nash-blip main-amp)
- (bird (+ beg .81) .17 4200 3900 .175 nash-down main-amp)
- (bird (+ beg 1.0) .02 3800 400 .25 nash-blip main-amp)
- (bird (+ beg 1.11) .14 4200 3800 .165 nash-down nash-amp)
- (bird (+ beg 1.3) .03 3750 300 .2 nash-blip main-amp)
- (bird (+ beg 1.4) .11 4200 3700 .1 nash-down main-amp)
- (bird (+ beg 1.57) .1 3800 2200 .1 nash-up main-amp)
- (bird (+ beg 1.7) .1 3800 2150 .125 nash-up main-amp)
- (bird (+ beg 1.85) .075 3900 1800 .1 nash-up nash-amp)))
-
-
-(define (b-eastern-phoebe beg)
- "(eastern-phoebe beg) produces an eastern-phoebe call at time 'beg'"
- (let ((phoebe-one '(.00 .00 .30 .30 .35 .50 .55 .40 .70 .80 .75 .70 .80 1.00 .95 .90 1.00 .0))
- (phoebe-two '(.00 .00 .50 1.00 1.00 .0))
- (phoebe-three '(.00 .00 .10 .40 .80 1.00 1.00 .10 ))
- (phoebe-four '(.00 1.00 .50 .70 1.00 .0))
- (phoebe-amp '(.00 .00 .10 1.00 1.00 .0)))
- (bird (+ beg 0) .225 3000 1300 .3 phoebe-one main-amp)
- (bird (+ beg .35) .12 3000 500 .1 phoebe-two phoebe-amp)
- (bird (+ beg .4) .10 3000 1500 .2 phoebe-three phoebe-amp)
- (bird (+ beg .55) .05 3000 1400 .2 phoebe-four phoebe-amp)))
-
-
-(define (b-painted-bunting beg)
- "(painted-bunting beg) produces a painted bunting call at time 'beg'"
- (let ((b-one '(.00 .00 1.00 1.0))
- (b-two '(.00 .00 .90 1.00 1.00 .0))
- (b-three '(.00 1.00 1.00 .0))
- (b-four '(.00 .00 .50 1.00 1.00 .0))
- (b-five '(.00 .70 .15 .00 .40 1.00 .80 1.00 1.00 .50 ))
- (b-six '(.00 .00 .10 .50 .15 .00 .40 1.00 .90 1.00 1.00 .0))
- (b-seven '(.00 1.00 .25 .40 .75 .50 1.00 .0))
- (b-eight '(.00 .30 .40 .40 .50 1.00 .60 .20 1.00 .0))
- (b-nine '(.00 .00 .05 1.00 .30 1.00 .50 .30 .90 1.00 1.00 .0))
- (b-ten '(.00 .40 .25 .00 .35 1.00 .50 .00 .65 1.00 .75 .00 .85 1.00 1.00 .0))
- (b-eleven '(.00 1.00 1.00 .0))
- (b-twelve '(.00 .00 .50 1.00 1.00 .50 ))
- (b-thirteen '(.00 .00 .05 1.00 .30 .20 .60 .20 .90 1.00 1.00 .0))
- (b-fourteen '(.00 .30 .30 1.00 .60 .30 1.00 .0))
- (b-fifteen '(.00 .00 .10 .50 .50 .50 .90 1.00 1.00 .0)))
- (set! beg (- beg .05))
- (bird (+ beg .05) .10 3100 900 .05 b-one b-two)
- (bird (+ beg .21) .07 4100 700 .15 b-three main-amp)
- (bird (+ beg .36) .12 3700 1000 .20 b-four main-amp)
- (bird (+ beg .52) .08 2300 1600 .15 b-five b-six)
- (bird (+ beg .68) .1 4000 1000 .25 b-one bird-tap)
- (bird (+ beg .8) .12 2300 1700 .2 b-seven main-amp)
- (bird (+ beg .96) .15 3800 2200 .3 b-eight b-nine)
- (bird (+ beg 1.18) .1 2300 1600 .15 b-ten main-amp)
- (bird (+ beg 1.3) .02 3200 1000 .1 b-eleven main-amp)
- (bird (+ beg 1.33) .02 3200 1000 .1 b-eleven main-amp)
- (bird (+ beg 1.36) .02 3200 1000 .1 b-eleven main-amp)
- (bird (+ beg 1.40) .03 4000 2000 .12 b-twelve b-thirteen)
- (bird (+ beg 1.47) .1 2300 1700 .2 b-fourteen b-fifteen)))
-
-
-(define (b-western-flycatcher beg)
- "(western-flycatcher beg) produces a western flycatcher call at time 'beg'"
- (let ((f-one '(.00 .00 .10 1.00 .20 .40 .95 .10 1.00 .0))
- (a-one '(.00 .00 .10 .20 .20 .10 .30 1.00 .90 1.00 1.00 .0))
- (f-two '(.00 .50 .25 1.00 .50 .00 .60 .00 .95 .30 1.00 .60 ))
- (a-two '(.00 .00 .10 1.00 .20 1.00 .50 .10 .60 .10 .90 1.00 1.00 .0)))
- (bigbird (+ beg 0) .2 2000 2200 .2 f-one a-one '(1 1 2 .02 3 .1 4 .01))
- (bigbird (+ beg .3) .2 2000 1100 .2 f-two a-two '(1 1 2 .02 3 .1 4 .01))))
-
-
-(define (b-bachmans-sparrow beg)
- "(bachmans-sparrow beg) produces a bachmans sparrow call at time 'beg'"
- (let ((sopening '(.00 1.00 .10 .50 .90 .50 1.00 .0))
- (sup '(.00 .10 .35 .00 1.00 1.0))
- (sdwn '(.00 1.00 .40 .50 1.00 .0))
- (supn '(.00 .00 1.00 1.0))
- (slast '(.00 1.00 .25 .00 .75 .40 1.00 .50 )))
- (bird (+ beg 0) .51 4900 200 .3 sopening main-amp)
- (bird (+ beg .52) .015 3800 200 .1 sup main-amp)
- (bird (+ beg .52) .015 3750 250 .1 sup main-amp)
- (bird (+ beg .54) .015 3600 300 .1 sup main-amp)
- (bird (+ beg .56) .015 3500 250 .1 sup main-amp)
- (bird (+ beg .58) .015 3400 200 .1 sup main-amp)
- (bird (+ beg .60) .015 3200 200 .1 sup main-amp)
- (bird (+ beg .62) .015 3800 100 .1 sup main-amp)
-
- (bird (+ beg .65) .07 3000 750 .2 sup main-amp)
- (bird (+ beg .73) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg .80) .07 3000 750 .2 sup main-amp)
- (bird (+ beg .88) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg .95) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.03) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg 1.10) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.18) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg 1.25) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.33) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg 1.40) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.48) .03 5000 1000 .1 sdwn main-amp)
- (bird (+ beg 1.55) .07 3000 750 .2 sup main-amp)
- (bird (+ beg 1.63) .03 5000 1000 .1 sdwn main-amp)
-
- (bird (+ beg 2.8) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 2.87) .01 5200 0 .2 supn main-amp)
- (bird (+ beg 2.9) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 2.97) .01 5200 0 .2 supn main-amp)
- (bird (+ beg 3.0) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 3.07) .01 5200 0 .2 supn main-amp)
- (bird (+ beg 3.1) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 3.17) .01 5200 0 .2 supn main-amp)
- (bird (+ beg 3.2) .06 4000 1700 .1 supn main-amp)
- (bird (+ beg 3.27) .01 5200 0 .2 supn main-amp)
-
- (bird (+ beg 3.4) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 3.6) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 3.8) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 4.0) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 4.2) .15 3000 1000 .2 slast main-amp)
- (bird (+ beg 4.4) .15 3000 1000 .2 slast main-amp)))
-
-
-(define (b-cedar-waxwing beg)
- "(cedar-waxwing beg) produces a cedar waxwing call at time 'beg'"
- (let ((cedar '(.00 .00 .25 .70 .70 1.00 .90 1.00 1.00 .20 ))
- (cedamp '(.00 .00 .20 1.00 .40 1.00 1.00 .0)))
- (bird (+ beg 0) .50 6000 800 .2 cedar cedamp)))
-
-
-(define (b-bairds-sparrow beg)
- "(bairds-sparrow beg) produces a bairds sparrow call at time 'beg'"
- (let ((bairdend '(.00 .00 .25 1.00 .50 .00 .75 1.00 1.00 .0))
- (bairdstart '(.00 .50 .05 1.00 .10 .00 .15 1.00 .20 .00 .25 1.00 .30 .00 .35 1.00 .40 .00 .45 1.00 .50 .00 .55 1.00 .60 .00 .65 1.00 .70 .00 .75 1.00 .80 .00 .85 1.00 .90 .00 .95 1.00 1.00 .0)))
- (bird (+ beg 0) .09 6500 1500 .2 bairdstart main-amp)
- (bird (+ beg .22) .01 5900 100 .2 bairdend main-amp)
- (bird (+ beg .25) .09 6000 1000 .2 bairdstart main-amp)
- (bird (+ beg .45) .01 4200 100 .2 bairdend main-amp)
- (bird (+ beg .50) .08 4200 600 .2 bairdstart main-amp)
- (bird (+ beg .59) .01 4400 100 .2 bairdend main-amp)
- (bird (+ beg .60) .01 4400 100 .2 bairdend main-amp)
- (bird (+ beg .68) .07 5400 700 .2 bairdstart main-amp)
- (bird (+ beg .75) .01 4200 100 .2 bairdend main-amp)
- (bird (+ beg .79) .01 4400 100 .2 bairdend main-amp)
- (bird (+ beg .83) .01 4200 100 .19 bairdend main-amp)
- (bird (+ beg .87) .01 4400 100 .19 bairdend main-amp)
- (bird (+ beg .91) .01 4200 100 .18 bairdend main-amp)
- (bird (+ beg .95) .01 4400 100 .18 bairdend main-amp)
- (bird (+ beg .99) .01 4200 100 .17 bairdend main-amp)
- (bird (+ beg 1.03) .01 4400 100 .17 bairdend main-amp)
- (bird (+ beg 1.07) .01 4200 100 .16 bairdend main-amp)
- (bird (+ beg 1.11) .01 4400 100 .16 bairdend main-amp)
- (bird (+ beg 1.15) .01 4200 100 .15 bairdend main-amp)
- (bird (+ beg 1.19) .01 4400 100 .15 bairdend main-amp)
- (bird (+ beg 1.23) .01 4200 100 .14 bairdend main-amp)
- (bird (+ beg 1.27) .01 4400 100 .14 bairdend main-amp)
- (bird (+ beg 1.31) .01 4200 100 .13 bairdend main-amp)
- (bird (+ beg 1.35) .01 4400 100 .13 bairdend main-amp)
- (bird (+ beg 1.39) .01 4200 100 .12 bairdend main-amp)
- (bird (+ beg 1.43) .01 4400 100 .12 bairdend main-amp)
- (bird (+ beg 1.47) .01 4200 100 .11 bairdend main-amp)
- (bird (+ beg 1.51) .01 4400 100 .11 bairdend main-amp)
- (bird (+ beg 1.55) .01 4200 100 .10 bairdend main-amp)
- (bird (+ beg 1.59) .01 4400 100 .10 bairdend main-amp)
- (bird (+ beg 1.63) .01 4200 100 .09 bairdend main-amp)
- (bird (+ beg 1.67) .01 4400 100 .09 bairdend main-amp)
- (bird (+ beg 1.71) .01 4200 100 .08 bairdend main-amp)
- (bird (+ beg 1.75) .01 4400 100 .08 bairdend main-amp)
- (bird (+ beg 1.79) .01 4200 100 .07 bairdend main-amp)
- (bird (+ beg 1.83) .01 4400 100 .07 bairdend main-amp)
- (bird (+ beg 1.87) .01 4200 100 .06 bairdend main-amp)
- (bird (+ beg 1.92) .01 4400 100 .06 bairdend main-amp)
- (bird (+ beg 1.97) .01 4200 100 .05 bairdend main-amp)))
-
-
-(define (b-kentucky-warbler beg)
- "(kentucky-warbler beg) produces a kentucky warbler call at time 'beg'"
- (let ((kenstart '(.00 .30 .50 1.00 1.00 .0))
- (kendwn '(.00 .90 .10 1.00 1.00 .0))
- (kenup '(.00 .00 1.00 1.0))
- (kentrill '(.00 1.00 .25 .00 .50 .00 .75 1.00 1.00 .0)))
- (set! beg (- beg .6))
- (bigbird (+ beg .6) .02 3800 200 .05 kenstart main-amp '(1 1 2 .03))
- (bigbird (+ beg .65) .03 4300 200 .15 kenup main-amp '(1 1 2 .1))
- (bigbird (+ beg .73) .02 3200 100 .1 kendwn main-amp '(1 1 2 .1))
-
- (bigbird (+ beg .75) .05 3000 800 .15 kenstart main-amp '(1 1 2 .01))
- (bigbird (+ beg .82) .06 3100 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg .90) .06 3200 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg .98) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
-
- (bigbird (+ beg 1.10) .05 2900 800 .15 kenstart main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.17) .06 3000 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.25) .06 3100 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.33) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
-
- (bigbird (+ beg 1.43) .05 2800 800 .15 kenstart main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.50) .05 2700 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.57) .06 2800 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.64) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
-
- (bigbird (+ beg 1.75) .05 2700 800 .15 kenstart main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.81) .05 2600 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.88) .06 2600 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg 1.97) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
-
- (bigbird (+ beg 2.05) .05 2700 800 .15 kenstart main-amp '(1 1 2 .01))
- (bigbird (+ beg 2.12) .06 2600 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg 2.20) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
-
- (bigbird (+ beg 2.30) .05 2800 800 .15 kenstart main-amp '(1 1 2 .01))
- (bigbird (+ beg 2.37) .06 2700 1200 .1 kendwn main-amp '(1 1 2 .01))
- (bigbird (+ beg 2.45) .05 4700 100 .25 kentrill main-amp '(1 1 2 .1))))
-
-
-(define (b-rufous-sided-towhee beg)
- "(rufous-sided-towhee beg) produces a rufous sided towhee call at time 'beg'"
- (let ((towhee-one '(.00 .10 .02 .05 .04 .15 .06 .05 .08 .20 .10 .04 .12 .25 .14 .03 .16 .30 .18 .02 .20 .35 .22 .01 .24 .40 .26 .00 .28 .45 .30 .00 .32 .50 .34 .00 .36 .50 .80 1.00 1.00 .0))
- (towhee-two '(.00 .00 1.00 1.0))
- (towhee-three '(.00 1.00 1.00 .0)))
- (set! beg (- beg .25))
- (bigbird (+ beg .25) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
- (bigbird (+ beg .45) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
- (bigbird (+ beg .60) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
- (bigbird (+ beg .75) .10 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
-
- (bird (+ beg .88) .01 5100 2000 .1 towhee-two main-amp)
- (bird (+ beg .895) .01 5100 1600 .1 towhee-two main-amp)
- (bird (+ beg .91) .01 5100 1000 .1 towhee-two main-amp)
- (bird (+ beg .93) .01 3000 1200 .1 towhee-three main-amp)
-
- (bird (+ beg .945) .01 5100 2000 .09 towhee-two main-amp)
- (bird (+ beg .96) .01 5100 1600 .09 towhee-two main-amp)
- (bird (+ beg .975) .01 5100 1000 .09 towhee-two main-amp)
- (bird (+ beg .995) .01 3000 1200 .09 towhee-three main-amp)
-
- (bird (+ beg 1.01) .01 5100 2000 .1 towhee-two main-amp)
- (bird (+ beg 1.025) .01 5100 1600 .1 towhee-two main-amp)
- (bird (+ beg 1.04) .01 5100 1000 .1 towhee-two main-amp)
- (bird (+ beg 1.06) .01 3000 1200 .1 towhee-three main-amp)
-
- (bird (+ beg 1.075) .01 5100 2000 .09 towhee-two main-amp)
- (bird (+ beg 1.09) .01 5100 1600 .09 towhee-two main-amp)
- (bird (+ beg 1.105) .01 5100 1000 .09 towhee-two main-amp)
- (bird (+ beg 1.125) .01 3000 1200 .09 towhee-three main-amp)
-
- (bird (+ beg 1.14) .01 5100 2000 .08 towhee-two main-amp)
- (bird (+ beg 1.155) .01 5100 1600 .08 towhee-two main-amp)
- (bird (+ beg 1.17) .01 5100 1000 .08 towhee-two main-amp)
- (bird (+ beg 1.19) .01 3000 1200 .08 towhee-three main-amp)
-
- (bird (+ beg 1.205) .01 5100 2000 .08 towhee-two main-amp)
- (bird (+ beg 1.220) .01 5100 1600 .08 towhee-two main-amp)
- (bird (+ beg 1.235) .01 5100 1000 .08 towhee-two main-amp)
- (bird (+ beg 1.255) .01 3000 1200 .08 towhee-three main-amp)
-
- (bird (+ beg 1.27) .01 5100 2000 .07 towhee-two main-amp)
- (bird (+ beg 1.285) .01 5100 1600 .07 towhee-two main-amp)
- (bird (+ beg 1.30) .01 5100 1000 .07 towhee-two main-amp)
- (bird (+ beg 1.32) .01 3000 1200 .07 towhee-three main-amp)
-
- (bird (+ beg 1.335) .01 5100 2000 .06 towhee-two main-amp)
- (bird (+ beg 1.350) .01 5100 1600 .06 towhee-two main-amp)
- (bird (+ beg 1.365) .01 5100 1000 .06 towhee-two main-amp)
- (bird (+ beg 1.385) .01 3000 1200 .06 towhee-three main-amp)
-
- (bird (+ beg 1.400) .01 5100 2000 .05 towhee-two main-amp)
- (bird (+ beg 1.415) .01 5100 1600 .05 towhee-two main-amp)
- (bird (+ beg 1.430) .01 5100 1000 .05 towhee-two main-amp)
- (bird (+ beg 1.45) .01 3000 1200 .05 towhee-three main-amp)
-
- (bird (+ beg 1.465) .01 5100 2000 .03 towhee-two main-amp)
- (bird (+ beg 1.480) .01 5100 1600 .03 towhee-two main-amp)
- (bird (+ beg 1.495) .01 5100 1000 .03 towhee-two main-amp)
- (bird (+ beg 1.515) .01 3000 1200 .03 towhee-three main-amp)))
-
-
-(define (b-prothonotary-warbler beg)
- "(prothonotary-warbler beg) produces a prothonotary warbler call at time 'beg'"
- (let ((pro-one '(.00 .10 .20 .00 1.00 1.0))
- (pro-two '(.00 .00 1.00 1.0))
- (pro-amp '(.00 .00 .20 1.00 .40 .50 1.00 .0)))
- (set! beg (- beg .76))
- (bird (+ beg .76) .08 3000 3000 .05 pro-one pro-amp)
- (bird (+ beg .85) .05 4000 2500 .06 pro-two bird-amp)
-
- (bird (+ beg 1.02) .09 3000 3000 .10 pro-one pro-amp)
- (bird (+ beg 1.12) .05 4000 2500 .10 pro-two bird-amp)
-
- (bird (+ beg 1.26) .08 3000 3000 .15 pro-one pro-amp)
- (bird (+ beg 1.35) .05 4000 2500 .16 pro-two bird-amp)
-
- (bird (+ beg 1.54) .08 3000 3000 .20 pro-one pro-amp)
- (bird (+ beg 1.63) .05 4000 2500 .19 pro-two bird-amp)
-
- (bird (+ beg 1.80) .08 3000 3000 .20 pro-one pro-amp)
- (bird (+ beg 1.89) .05 4000 2500 .16 pro-two bird-amp)
-
- (bird (+ beg 2.03) .08 3000 3000 .15 pro-one pro-amp)
- (bird (+ beg 2.12) .05 4000 2500 .10 pro-two bird-amp)
-
- (bird (+ beg 2.30) .08 3000 3000 .10 pro-one pro-amp)
- (bird (+ beg 2.39) .05 4000 2500 .06 pro-two bird-amp)))
-
-
-(define (b-audubons-warbler beg)
- "(audubons-warbler beg) produces an audubons warbler (yellow-rumped warbler) call at time 'beg'"
- (let (
- ;; (yellow-rumped say the revisionists))
- (w-up '(.00 .00 1.00 1.0))
- (w-down '(.00 1.00 1.00 .0))
- (w-end '(.00 .00 .15 1.00 .45 .90 .50 .00 .55 1.00 .90 .90 1.00 .10 ))
- (w-updown '(.00 .10 .50 1.00 1.00 .0)))
- (set! beg (- beg .75))
- (bird (+ beg .75) .04 2400 200 .05 w-down bird-amp)
- (bird (+ beg .83) .03 3200 200 .1 w-up bird-amp)
- (bird (+ beg .90) .04 2500 300 .15 w-up bird-amp)
- (bird (+ beg .97) .04 2300 600 .15 w-down bird-amp)
- (bird (+ beg 1.02) .03 3500 400 .20 w-up bird-amp)
- (bird (+ beg 1.06) .04 2300 1200 .10 w-up bird-amp)
- (bird (+ beg 1.13) .05 2300 1200 .15 w-down bird-amp)
- (bird (+ beg 1.22) .02 3200 800 .25 w-up bird-amp)
- (bird (+ beg 1.25) .08 2400 600 .20 w-updown bird-amp)
- (bird (+ beg 1.35) .02 2200 400 .10 w-up bird-amp)
- (bird (+ beg 1.38) .07 2400 1400 .15 w-down bird-amp)
- (bird (+ beg 1.47) .03 3000 800 .20 w-up bird-amp)
- (bird (+ beg 1.50) .03 2500 400 .10 w-updown bird-amp)
- (bird (+ beg 1.55) .01 2300 100 .05 w-up bird-amp)
- (bird (+ beg 1.56) .06 2200 1400 .15 w-down bird-amp)
- (bird (+ beg 1.65) .03 3100 800 .10 w-up bird-amp)
- (bird (+ beg 1.70) .07 2800 800 .15 w-updown bird-amp)
- (bird (+ beg 1.79) .06 2400 1000 .10 w-down bird-amp)
- (bird (+ beg 1.86) .14 3100 900 .25 w-end bird-amp)
- (bird (+ beg 2.02) .12 3200 800 .20 w-end bird-amp)))
-
-
-(define (b-lark-bunting beg)
- "(lark-bunting beg) produces a lark bunting call at time 'beg'"
- (let ((b-down '(.00 1.00 1.00 .0))
- (b-up '(.00 .00 1.00 1.0))
- (b-trill-one '(.00 .00 .06 .80 .12 .00 .18 .85 .24 .05 .36 .90 .42 .10 .48 .95 .54 .20 .60 1.00 .66 .20 .72 1.00 .78 .20 .84 1.00 .90 .20 1.00 1.0))
- (b-trill-two '(.00 .00 .05 .80 .10 .00 .15 .85 .20 .00 .25 .90 .30 .00 .35 .95 .40 .00 .45 1.00 .50 .00 .55 1.00 .60 .00 .65 1.00 .70 .00 .75 1.00 .80 .00 .85 1.00 .90 .00 .95 1.00 1.00 .0)))
- (set! beg (- beg .1))
- (bird (+ beg .1) .03 1800 100 .1 b-up bird-amp)
- (bird (+ beg .2) .12 3700 400 .2 b-up bird-amp)
-
- (bird (+ beg .4) .03 4100 500 .15 b-down bird-amp)
- (bird (+ beg .45) .05 2000 400 .20 b-down bird-amp)
- (bird (+ beg .51) .03 1800 100 .1 b-up bird-amp)
-
- (bird (+ beg .6) .03 4100 500 .15 b-down bird-amp)
- (bird (+ beg .65) .05 2000 400 .20 b-down bird-amp)
- (bird (+ beg .71) .03 1800 100 .1 b-up bird-amp)
-
- (bird (+ beg .8) .03 4100 500 .15 b-down bird-amp)
- (bird (+ beg .85) .05 2000 400 .20 b-down bird-amp)
- (bird (+ beg .91) .03 1800 100 .1 b-up bird-amp)
-
- (bird (+ beg 1.0) .03 4100 500 .15 b-down bird-amp)
- (bird (+ beg 1.05) .05 2000 400 .20 b-down bird-amp)
- (bird (+ beg 1.11) .03 1800 100 .1 b-up bird-amp)
-
- (bird (+ beg 1.2) .03 4100 500 .15 b-down bird-amp)
- (bird (+ beg 1.25) .05 2000 400 .20 b-down bird-amp)
- (bird (+ beg 1.31) .03 1800 100 .1 b-up bird-amp)
-
- (bird (+ beg 1.4) .03 4100 500 .15 b-down bird-amp)
- (bird (+ beg 1.45) .05 2000 400 .20 b-down bird-amp)
- (bird (+ beg 1.51) .03 1800 100 .1 b-up bird-amp)
-
- (bird (+ beg 1.6) .03 4100 500 .15 b-down bird-amp)
- (bird (+ beg 1.65) .05 2000 400 .20 b-down bird-amp)
- (bird (+ beg 1.71) .03 1800 100 .1 b-up bird-amp)
-
- (bird (+ beg 1.77) .23 6000 600 .15 b-trill-one bird-amp)
- (bird (+ beg 2.005) .28 6000 600 .15 b-trill-two bird-amp)))
-
-
-(define (b-eastern-bluebird beg)
- "(eastern-bluebird beg) produces an eastern bluebird call at time 'beg'"
- (let ((blue-one '(.00 .00 1.00 1.0))
- (blue-two '(.00 1.00 1.00 .0))
- (blue-three '(.00 .60 .10 1.00 .20 .00 .25 1.00 .30 .00 .35 1.00 .40 .00 .45 1.00 .50 .00 .75 1.00 1.00 .0))
- (blue-four '(.00 .00 .50 1.00 1.00 .0))
- (blue-five '(.00 .50 .10 1.00 .20 .00 .35 1.00 .50 .00 .65 1.00 .80 .00 .95 1.00 1.00 .50 )))
- (set! beg (- beg .75))
- (bird (+ beg .75) .02 2000 1600 .1 blue-one bird-amp)
- (bird (+ beg .80) .02 2000 1600 .1 blue-one bird-amp)
- (bird (+ beg .86) .02 2000 1600 .1 blue-one bird-amp)
- (bird (+ beg 1.00) .13 2000 1400 .2 blue-two bird-amp)
- (bird (+ beg 1.20) .24 2000 800 .2 blue-three bird-amp)
- (bird (+ beg 1.68) .03 2200 400 .1 blue-one bird-amp)
- (bird (+ beg 1.72) .10 1950 100 .15 blue-four bird-amp)
- (bird (+ beg 1.96) .15 2000 600 .20 blue-five bird-amp)))
-
-
-(define (b-chuck-wills-widow beg)
- "(chuck-wills-widow beg) produces a chuck wills widow call at time 'beg'"
- (let ((wid-down '(.00 1.00 1.00 .0))
- (wid-one '(.00 .00 .10 .10 .25 1.00 .50 .30 .80 .70 1.00 .0))
- (wid-two '(.00 .20 .30 1.00 .50 .30 .60 .70 .90 .10 1.00 .0)))
- (set! beg (- beg .05))
- (bird (+ beg .05) .03 1000 800 .1 wid-down bird-amp)
- (bird (+ beg .32) .20 1000 1000 .2 wid-one bird-amp)
- (bird (+ beg .56) .29 900 1100 .2 wid-two bird-amp)))
-
-
-(define (b-blue-gray-gnatcatcher beg)
- "(blue-gray-gnatcatcher beg) produces a blue gray gnatcatcher call at time 'beg'"
- (let ((gskw1 '(.00 .00 .15 1.00 .75 .80 .90 1.00 1.00 .70 ))
- (gskw2 '(.00 .00 .25 1.00 .75 .70 1.00 .0)))
- (set! beg (- beg .5))
- (bigbird (+ beg .5) .20 4000 1000 .2 gskw1 bird-amp '(1 .4 2 1 3 .1))
- (bigbird (+ beg .8) .13 4000 800 .2 gskw2 bird-amp '(1 .4 2 1 3 .2))
-
- (bigbird (+ beg 1.4) .25 4000 800 .2 gskw2 bird-amp '(1 .4 2 1 3 .3))
- (bigbird (+ beg 1.80) .17 4000 900 .2 gskw1 bird-amp '(1 .4 2 1 3 .3))
- (bigbird (+ beg 2.00) .17 4000 700 .2 gskw1 bird-amp '(1 .4 2 1 3 .3))
- (bigbird (+ beg 2.20) .17 4000 800 .2 gskw2 bird-amp '(1 .4 2 1 3 .3))))
-
-
-(define (b-black-throated-sparrow beg)
- "(black-throated-sparrow beg) produces a black throated sparrow call at time 'beg'"
- (let ((black-up '(.00 .00 1.00 1.0))
- (black-down '(.00 1.00 1.00 .0))
- (black-down-amp '(.00 .00 .75 1.00 1.00 .0))
- (black-trill '(.00 .00 .03 .70 .06 .00 .09 .75 .12 .00 .15 .80 .18 .05 .21 .85 .24 .10 .27 .90 .30 .10 .33 1.00 .36 .10 .39 1.00 .42 .10 .45 1.00 .48 .10 .51 1.00 .54 .10 .57 1.00 .60 .10 .63 1.00 .66 .10 .69 1.00 .72 .10 .75 1.00 .78 .10 .81 1.00 .84 .10 .87 1.00 .90 .00 .93 .95 .96 .00 1.00 .90 ))
- (black-up-down '(.00 .00 .50 1.00 1.00 .20 ))
- (black-amp '(.00 .00 .50 1.00 1.00 .0)))
- (set! beg (- beg .8))
- (bird (+ beg .8) .02 2200 1000 .1 black-down bird-amp)
- (bird (+ beg .83) .01 3000 200 .05 black-up bird-amp)
- (bird (+ beg .96) .02 5800 500 .05 black-up bird-amp)
- (bird (+ beg 1.00) .02 4000 200 .05 black-up bird-amp)
- (bird (+ beg 1.04) .10 2100 1700 .15 black-down black-down-amp)
- (bird (+ beg 1.15) .05 5700 400 .25 black-up bird-amp)
- (bird (+ beg 1.25) .25 2000 900 .2 black-trill bird-amp)
- (bird (+ beg 1.52) .05 5600 400 .15 black-up-down bird-amp)
-
- (bird (+ beg 1.6) .04 3900 1100 .15 black-up bird-amp)
- (bird (+ beg 1.66) .01 1900 100 .10 black-up black-amp)
-
- (bird (+ beg 1.69) .01 3600 300 .10 black-up black-amp)
- (bird (+ beg 1.71) .03 3900 1000 .15 black-up black-amp)
- (bird (+ beg 1.74) .02 5000 100 .20 black-up black-amp)
- (bird (+ beg 1.76) .01 1900 100 .10 black-up black-amp)
-
- (bird (+ beg 1.78) .01 3600 300 .10 black-up black-amp)
- (bird (+ beg 1.80) .03 3900 1000 .15 black-up black-amp)
- (bird (+ beg 1.83) .02 5000 100 .20 black-up black-amp)
- (bird (+ beg 1.85) .01 1900 100 .10 black-up black-amp)
-
- (bird (+ beg 1.87) .01 3600 300 .10 black-up black-amp)
- (bird (+ beg 1.89) .03 3900 1000 .15 black-up black-amp)
- (bird (+ beg 1.92) .02 5000 100 .20 black-up black-amp)
- (bird (+ beg 1.94) .01 1900 100 .10 black-up black-amp)
-
- (bird (+ beg 1.96) .01 3600 300 .10 black-up black-amp)
- (bird (+ beg 1.98) .03 3900 1000 .15 black-up black-amp)
- (bird (+ beg 2.01) .02 5000 100 .20 black-up black-amp)
- (bird (+ beg 2.03) .01 1900 100 .10 black-up black-amp)
-
- (bird (+ beg 2.05) .01 3600 300 .10 black-up black-amp)
- (bird (+ beg 2.07) .03 3900 1000 .15 black-up black-amp)
- (bird (+ beg 2.10) .02 5000 100 .20 black-up black-amp)
- (bird (+ beg 2.13) .01 1900 100 .10 black-up black-amp)
-
- (bird (+ beg 2.16) .03 3800 300 .1 black-up bird-amp)))
-
-
-(define (b-black-chinned-sparrow beg)
- "(black-chinned-sparrow beg) produces a black chinned sparrow call at time 'beg'"
- (let ((chin-up '(.00 .00 1.00 1.0))
- (chin-up2 '(.00 .00 .30 .20 1.00 1.0)))
- (set! beg (- beg .6))
- (bird (+ beg .6) .2 4200 100 .1 chin-up bird-amp)
- (bird (+ beg 1.0) .09 3800 2000 .1 chin-up2 bird-amp)
- (bird (+ beg 1.25) .08 3900 1700 .12 chin-up2 bird-amp)
- (bird (+ beg 1.40) .08 3600 2300 .13 chin-up bird-amp)
- (bird (+ beg 1.50) .11 3100 2800 .14 chin-up bird-amp)
- (bird (+ beg 1.65) .07 2900 2700 .15 chin-up bird-amp)
- (bird (+ beg 1.74) .07 2900 2700 .15 chin-up bird-amp)
- (bird (+ beg 1.82) .07 3000 2300 .13 chin-up bird-amp)
- (bird (+ beg 1.89) .07 3200 2000 .10 chin-up bird-amp)
- (bird (+ beg 1.97) .05 3200 1500 .10 chin-up bird-amp)
- (bird (+ beg 2.04) .04 3400 1000 .07 chin-up bird-amp)
- (bird (+ beg 2.10) .03 3600 700 .05 chin-up bird-amp)
- (bird (+ beg 2.15) .03 3800 300 .05 chin-up bird-amp)
- (bird (+ beg 2.19) .02 3900 100 .03 chin-up bird-amp)
- (bird (+ beg 2.22) .01 3900 100 .01 chin-up bird-amp)
- (bird (+ beg 2.24) .01 3900 100 .01 chin-up bird-amp)))
-
-
-(define (various-gull-cries-from-end-of-colony-5 beg)
- "(various-gull-cries-from-end-of-colony-5 beg) produces a various gull cries at time 'beg'"
- (let ((gullstart '(0 0 10 1 20 .5000 40 .6000 60 .5000 100 0 ))
- (gullmiddle '(0 0 10 1 30 .5000 80 .5000 100 0 ))
- (gullend '(0 0 5 1 10 .5000 90 .4000 100 0 )))
- (set! beg (- beg .25))
- (bigbird (+ beg .250) .80 1180 1180 .08 gullend bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 1.500) .90 1180 1180 .07 gullend bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 2.750) 1.00 1050 1050 .08 gullend bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 4.800) .05 1180 1180 .06 gullstart bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 4.950) .10 1180 1180 .08 gullstart bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 5.150) .10 1180 1180 .09 gullstart bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 5.350) .10 1180 1180 .1 gullmiddle bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 5.450) .40 1050 1050 .1 gullend bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 6.250) .80 1050 1050 .1 gullend bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))
- (bigbird (+ beg 7.450) 1.80 1050 1050 .1 gullend bird-amp
- '(1 .1 2 1 3 .1 4 .01 5
- .09 6 .01 7 .01))))
-
-
-(define (make-birds)
- "(make-birds) calls all the birds in bird.scm"
- (with-sound ()
- (b-orchard-oriole 0)
- (b-cassins-kingbird 3)
- (b-chipping-sparrow 6)
- (b-bobwhite 9)
- (b-western-meadowlark 12)
- (b-scissor-tailed-flycatcher 15)
- (b-great-horned-owl 18)
- (b-black-throated-gray-warbler 21)
- (b-yellow-warbler 24)
- (b-black-necked-stilt 27)
- (b-chestnut-sided-warbler 30)
- (b-grasshopper-sparrow 33)
- (b-swamp-sparrow 36)
- (b-golden-crowned-sparrow 39)
- (b-indigo-bunting 42)
- (b-hooded-warbler 45)
- (b-american-widgeon 48)
- (b-louisiana-waterthrush 51)
- (b-robin 54)
- (b-solitary-vireo 57)
- (b-pigeon-hawk 61)
- (b-cerulean-warbler 64)
- (b-nashville-warbler 67)
- (b-eastern-phoebe 70)
- (b-painted-bunting 73)
- (b-western-flycatcher 76)
- (b-bachmans-sparrow 79)
- (b-cedar-waxwing 82)
- (b-bairds-sparrow 85)
- (b-kentucky-warbler 88)
- (b-rufous-sided-towhee 91)
- (b-prothonotary-warbler 94)
- (b-audubons-warbler 97)
- (b-lark-bunting 100)
- (b-eastern-bluebird 103)
- (b-chuck-wills-widow 106)
- (b-blue-gray-gnatcatcher 109)
- (b-black-throated-sparrow 112)
- (b-black-chinned-sparrow 115)
- (various-gull-cries-from-end-of-colony-5 118)))
+(define b-orchard-oriole
+ (let ((documentation "(orchard-oriole beg) produces an orchard oriole call at time 'beg'"))
+ (lambda (beg)
+ (let ((oriup '(.00 .00 1.00 1.0))
+ (oridwn '(.00 1.00 1.00 .0))
+ (oriupdwna '(.00 .00 .60 1.00 1.00 .60 ))
+ (oriupdwnb '(.00 .50 .30 1.00 1.00 .0))
+ (oribiga '(.00 .90 .15 1.00 .40 .30 .60 .60 .85 .00 1.00 .0))
+ (orimid '(.00 1.00 .05 .50 .10 1.00 .25 .00 .85 .50 1.00 .0))
+ (oridwnup '(.00 .30 .25 .00 1.00 1.0))
+ (oriamp '(.00 .00 .10 1.00 1.00 .0)))
+ (set! beg (- beg .38))
+ (bird (+ beg .38) .03 3700 100 .05 oridwn main-amp)
+ (bird (+ beg .41) .05 2500 1000 .1 oriup main-amp)
+ (bigbird (+ beg .5) .1 2000 800 .2 oriupdwna main-amp '(1 1 2 .02 3 .05))
+ (bird (+ beg .65) .03 3900 1200 .1 oridwn main-amp)
+ (bigbird (+ beg .7) .21 2000 1200 .15 oribiga main-amp '(1 1 2 .05))
+ (bird (+ beg 1.0) .05 4200 1000 .1 oridwn main-amp)
+ (bigbird (+ beg 1.1) .1 2000 1000 .25 orimid main-amp '(1 1 2 .05))
+ (bigbird (+ beg 1.3) .1 2000 1000 .25 orimid main-amp '(1 1 2 .05))
+ (bird (+ beg 1.48) .1 2300 3200 .1 oriupdwnb oriamp)
+ (bird (+ beg 1.65) .03 1800 300 .05 oriup main-amp)
+ (bird (+ beg 1.7) .03 2200 100 .04 oridwn main-amp)
+ (bird (+ beg 1.8) .07 2500 2000 .15 oriupdwnb oriamp)
+ (bigbird (+ beg 1.92) .2 2400 1200 .25 oridwnup main-amp '(1 1 2 .04))
+ (bird (+ beg 2.2) .02 2200 3000 .04 oriup main-amp)
+ (bird (+ beg 2.28) .02 2200 3000 .04 oriup main-amp)
+ (bigbird (+ beg 2.4) .17 2000 1000 .2 oriupdwna oriamp '(1 1 2 .04))))))
+
+
+(define b-cassins-kingbird
+ (let ((documentation "(cassins-kingbird beg) produces a cassins kingbird call at time 'beg'"))
+ (lambda (beg)
+ (let ((kingfirst '(.00 .30 .45 1.00 .90 .10 1.00 .0))
+ (kingsecond '(.00 .00 .02 .50 .04 .00 .06 .55 .08 .05 .10 .60 .12 .05 .14 .65 .16 .10 .18 .70 .20 .10 .22 .75 .24 .15 .26 .80 .28 .20 .30 .85 .32 .25 .34 .90 .36 .30 .38 .95 .40 .40 .42 1.00 .44 .50 .46 1.00 .48 .45 .50 1.00 .52 .50 .54 1.00 .56 .40 .58 .95 .60 .40 .62 .90 .64 .40 .66 .85 .68 .35 .70 .80 .72 .30 .74 .75 .76 .25 .78 .70 .80 .20 .82 .65 .84 .10 .86 .60 .88 .00 .90 .55 .92 .00 .94 .50 .96 .00 1.00 .40 )))
+ (set! beg (- beg .03))
+ (bigbird (+ beg .03) .04 1700 1200 .15 kingfirst main-amp '(1 1 2 .5 3 0 4 .2))
+ (bigbird (+ beg .12) .18 1700 900 .25 kingsecond main-amp '(1 1 2 .01 3 0 4 .1))))))
+
+
+(define b-chipping-sparrow
+ (let ((documentation "(chipping-sparrow beg) produces a chipping sparrow call at time 'beg'"))
+ (lambda (beg)
+ (let ((chip-up '(.00 .80 .15 1.00 .75 .30 1.00 .0)))
+ (bird beg .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .06) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .12) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .18) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .24) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .30) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .36) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .42) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .48) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .54) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .60) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .66) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .72) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .78) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .84) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .90) .05 4000 2400 .2 chip-up main-amp)
+ (bird (+ beg .96) .05 4000 2400 .2 chip-up main-amp)))))
+
+
+(define b-bobwhite
+ (let ((documentation "(bobwhite beg) produces a bobwhite call at time 'beg'"))
+ (lambda (beg)
+ (let ((bobup1 '(.00 .00 .40 1.00 1.00 1.0))
+ (bobup2 '(.00 .00 .65 .50 1.00 1.0)))
+ (set! beg (- beg .4))
+ (bigbird (+ beg .4) .2 1800 200 .1 bobup1 main-amp '(1 1 2 .02))
+ (bigbird (+ beg 1) .20 1800 1200 .2 bobup2 main-amp '(1 1 2 .02))))))
+
+
+(define b-western-meadowlark
+ (let ((documentation "(western-meadowlark beg) produces a western meadowlark call at time 'beg'"))
+ (lambda (beg)
+ (let ((no-skw '(.00 .00 1.00 .0))
+ (down-skw '(.00 1.00 .40 .40 1.00 .0))
+ (fas-down '(.00 1.00 1.00 .0)))
+ (set! beg (- beg .8))
+ (bigbird (+ beg .800) .1 2010.000 0.000 .100 no-skw main-amp '(1 1 2 .04))
+ (bigbird (+ beg 1.100) .15 3000.000 100.000 .110 down-skw main-amp '(1 1 2 .04))
+ (bigbird (+ beg 1.300) .25 2000.000 150.000 .200 down-skw main-amp '(1 1 2 .04))
+ (bigbird (+ beg 1.650) .15 3010.000 250.000 .110 down-skw main-amp '(1 1 2 .04))
+ (bigbird (+ beg 1.850) .10 2200.000 150.000 .110 down-skw main-amp '(1 1 2 .04))
+ (bigbird (+ beg 2.000) .10 3200.000 1400.000 .110 fas-down main-amp '(1 1 2 .04))
+ (bigbird (+ beg 2.200) .05 2000.000 200.000 .110 fas-down main-amp '(1 1 2 .04))
+ (bigbird (+ beg 2.300) .10 1600.000 0.000 .110 fas-down main-amp '(1 1 2 .04))))))
+
+
+(define b-scissor-tailed-flycatcher
+ (let ((documentation "(scissor-tailed-flycatcher beg) produces a scissor-tailed flycatcher call at time 'beg'"))
+ (lambda (beg)
+ (let ((scissor '(.00 .00 .40 1.00 .60 1.00 1.00 .0)))
+ (bigbird beg .05 1800 1800 .2 scissor main-amp '(1 .5 2 1 3 .5 4 .1 5 .01))))))
+
+
+(define b-great-horned-owl
+ (let ((documentation "(great-horned-owl beg) produces a great horned owl call at time 'beg'"))
+ (lambda (beg)
+ (let ((owlup '(.00 .00 .30 1.00 1.00 1.0))
+ (owldown '(.00 1.00 1.00 .0)))
+ (set! beg (- beg .3))
+ (bigbird (+ beg .3) .1 300 0 .1 main-amp main-amp '(1 1 3 .02 7 .01))
+ (bigbird (+ beg .6) .4 293 6 .1 owldown main-amp '(1 1 3 .02 7 .01))
+ (bigbird (+ beg 1.75) .35 293 7 .1 owlup main-amp '(1 1 3 .02 7 .01))
+ (bigbird (+ beg 2.5) .2 300 0 .1 owlup main-amp '(1 1 3 .02 7 .01))))))
+
+
+(define b-black-throated-gray-warbler
+ (let ((documentation "(black-throated-gray-warbler beg) produces a black throated gray warbler call at time 'beg'"))
+ (lambda (beg)
+ (let ((grayone '(.00 .50 .02 .60 .04 .45 .06 .62 .08 .40 .10 .65 .12 .35 .14 .70 .18 .30 .20 .70 .22 .30 .24 .70 .25 .20 .30 .80 .35 .10 .40 .90 .45 .00 .50 1.00 .55 .00 .60 1.00 .65 .00 .70 1.00 .75 .00 .80 1.00 .85 .00 .90 1.00 .95 .00 1.00 .50 ))
+ (graytwo '(.00 .00 .01 .40 .02 .00 .03 .40 .04 .00 .05 .40 .06 .00 .07 .40 .08 .00 .09 .40 .10 .00 .25 .80 .40 .30 .55 1.00 .70 .00 .85 .80 1.00 .40 ))
+ (graythree '(.00 1.00 .01 .60 .02 1.00 .03 .60 .04 1.00 .05 .60 .06 1.00 .07 .60 .08 1.00 .09 .60 .10 1.00 .11 .60 .12 1.00 .13 .60 .14 1.00 .15 .60 .16 1.00 .17 .60 .18 1.00 .19 .60 .20 1.00 .21 .55 .22 1.00 .23 .50 .24 1.00 .25 .50 .26 1.00 .27 .50 .28 1.00 .29 .50 .30 1.00 .31 .50 .32 1.00 .33 .50 .34 1.00 .35 .50 .36 1.00 .37 .50 .38 1.00 .39 .50 .40 1.00 .41 .50 .42 1.00 .43 .50 .44 1.00 .45 .50 .46 1.00 .47 .50 .48 1.00 .49 .50 .50 1.00 .51 .50 .52 1.00 .53 .50 .54 1.00 .55 .50 .56 1.00 .57 .50 .58 1.00 .59 .50 .60 1.00 1.00 .0))
+ (grayfour '(.00 .00 1.00 1.0)))
+ (bird beg .12 3700 600 .05 grayone main-amp)
+ (bird (+ beg .18) .08 3000 800 .07 graytwo main-amp)
+ (bird (+ beg .28) .12 3700 600 .12 grayone main-amp)
+ (bird (+ beg .44) .08 3000 800 .15 graytwo main-amp)
+ (bird (+ beg .54) .12 3700 600 .20 grayone main-amp)
+ (bird (+ beg .72) .08 3000 800 .25 graytwo main-amp)
+ (bird (+ beg .82) .12 3700 600 .25 grayone main-amp)
+ (bird (+ beg .96) .2 3000 2000 .2 graythree main-amp)
+ (bird (+ beg 1.2) .02 4500 500 .05 grayfour main-amp)
+ (bird (+ beg 1.25) .02 4200 800 .05 grayfour main-amp)
+ (bird (+ beg 1.3) .02 4000 900 .05 grayfour main-amp)))))
+
+
+(define b-yellow-warbler
+ (let ((documentation "(yellow-warbler beg) produces a yellow warbler call at time 'beg'"))
+ (lambda (beg)
+ (let ((yellow-up '(.00 .00 .60 1.00 1.00 .50 ))
+ (yellow-swirl '(.00 1.00 .05 1.00 .60 .00 .80 .30 1.00 .10 ))
+ (yellow-down '(.00 1.00 1.00 .0))
+ (yellow-last '(.00 .00 .30 .20 .80 .70 1.00 1.0))
+ (swirl-amp '(.00 .00 .90 1.00 1.00 .0)))
+ (bird beg .05 5600 400 .05 yellow-up main-amp)
+ (bird (+ beg .23) .12 5000 1500 .15 yellow-swirl swirl-amp)
+ (bird (+ beg .45) .13 5000 1700 .17 yellow-swirl swirl-amp)
+ (bird (+ beg .62) .16 5000 2000 .20 yellow-swirl swirl-amp)
+ (bird (+ beg .85) .15 5000 2000 .20 yellow-swirl swirl-amp)
+ (bird (+ beg 1.05) .075 3700 1000 .20 yellow-down main-amp)
+ (bird (+ beg 1.15) .075 3700 800 .15 yellow-down main-amp)
+ (bird (+ beg 1.25) .075 3700 800 .15 yellow-down main-amp)
+ (bird (+ beg 1.4) .2 3700 2000 .2 yellow-last swirl-amp)))))
+
+
+(define b-black-necked-stilt
+ (let ((documentation "(black-necked-stilt beg) produces a black necked stilt call at time 'beg'"))
+ (lambda (beg)
+ (let (
+ ;; have to guess about upper partials (cut off by spectrograph)
+ ;; "birds" book has piping sound coming back down whereas "songs
+ ;; of western birds" just shows it going up.
+ ;;
+ (upamp '(.00 .00 .90 1.00 1.00 .0))
+ (rampup '(.00 .00 .50 1.00 1.00 .20 )))
+ (bigbird beg .1 900 100 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))
+ (bigbird (+ beg .30) .1 900 200 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))
+ (bigbird (+ beg .60) .1 900 250 .2 rampup upamp '( 1 .5 2 1 3 .75 4 .5 5 .1))))))
+
+
+(define b-chestnut-sided-warbler
+ (let ((documentation "(chestnut-sided-warbler beg) produces a chestnut sided warbler call at time 'beg'"))
+ (lambda (beg)
+ (let ((ycurve '(.00 1.00 .30 .50 .60 1.00 .80 .20 1.00 .0))
+ (vcurve '(.00 .20 .50 1.00 1.00 .0))
+ (wcurve '(.00 .50 .15 .00 .45 .10 .60 1.00 .70 .90 1.00 .90 ))
+ (upcurve '(.00 .00 .95 1.00 1.00 1.0))
+ (downcurve '(.00 1.00 .25 .30 .60 .15 1.00 .0))
+ (louder '(.00 .00 .90 1.00 1.00 .0))
+ (wamp '(.00 .00 .10 1.00 .40 .10 .50 .90 .60 .10 .70 1.00 1.00 .0)))
+ (set! beg (- beg .1))
+ (bigbird (+ beg .1) .1 4050 1200 .05 ycurve main-amp '(1 1 2 .1))
+ (bigbird (+ beg .25) .03 3900 300 .075 vcurve main-amp '(1 1 2 .1))
+ (bigbird (+ beg .3) .1 4050 1200 .15 ycurve louder '(1 1 2 .1))
+ (bigbird (+ beg .42) .03 3800 500 .1 vcurve main-amp '(1 1 2 .1))
+ (bigbird (+ beg .5) .1 4000 1200 .2 ycurve bird-tap '(1 1 2 .1))
+ (bigbird (+ beg .65) .03 3800 500 .15 vcurve main-amp '(1 1 2 .1))
+ (bigbird (+ beg .72) .1 4000 1200 .2 ycurve bird-tap '(1 1 2 .1))
+ (bigbird (+ beg .85) .03 3800 500 .15 vcurve main-amp '(1 1 2 .1))
+ (bigbird (+ beg .91) .1 4000 1200 .2 ycurve bird-tap '(1 1 2 .1))
+ (bigbird (+ beg 1.05) .12 3800 2200 .15 wcurve wamp '(1 1 2 .1))
+ (bigbird (+ beg 1.20) .12 3800 2200 .15 wcurve wamp '(1 1 2 .1))
+ (bigbird (+ beg 1.35) .12 2500 2200 .25 upcurve louder '(1 1 2 .1))
+ (bigbird (+ beg 1.50) .12 2500 4000 .15 downcurve main-amp '(1 1 2 .1))))))
+
+
+(define b-grasshopper-sparrow
+ (let ((documentation "(grasshopper-sparrow beg) produces a grasshopper sparrow call at time 'beg'"))
+ (lambda (beg)
+ (let ((grassone '(.00 .50 .02 .80 .04 .30 .06 .80 .07 .10 .08 .90 .10 .00 .11 .90 .12 .00 .13 .90 .14 .10 .15 1.00 .16 .10 .17 1.00 .18 .10 .19 1.00 .20 .10 .21 1.00 .22 .10 .23 1.00 .24 .10 .25 1.00 .26 .10 .27 1.00 .28 .10 .29 1.00 .30 .10 .31 1.00 .32 .10 .33 1.00 .34 .10 .35 1.00 .36 .10 .37 1.00 .38 .10 .39 1.00 .40 .10 .41 1.00 .42 .10 .43 1.00 .44 .10 .45 1.00 .46 .10 .47 1.00 .48 .10 .49 1.00 .50 .10 .51 1.00 .52 .10 .53 1.00 .54 .10 .55 1.00 .56 .10 .57 1.00 .58 .10 .59 1.00 .60 .10 .61 1.00 .62 .10 .63 1.00 .64 .10 .65 1.00 .66 .10 .67 1.00 .68 .10 .69 1.00 .70 .10 .71 1.00 .72 .10 .73 1.00 .74 .10 .75 1.00 .76 .10 .77 1.00 .78 .10 .79 1.00 .80 .10 .81 1.00 .82 .10 .83 1.00 .84 .10 .85 1.00 .86 .10 .87 1.00 .88 .10 .89 1.00 .90 .10 .91 1.00 .92 .10 .93 1.00 .94 .10 .95 1.00 .96 .10 .97 1.00 .98 .10 1.00 1.0))
+ (grasstwo '(.00 .00 .10 1.00 .20 .00 .30 1.00 .40 .00 .50 1.00 .60 .00 .70 1.00 .80 .00 .90 1.00 1.00 .0)))
+ (set! beg (- beg .49))
+ (bird (+ beg .49) .01 8000 100 .1 grasstwo main-amp)
+ (bird (+ beg .60) .01 5700 300 .1 grasstwo main-amp)
+ (bird (+ beg .92) .01 3900 100 .1 grasstwo main-amp)
+ (bird (+ beg 1.00) 1.4 6000 2500 .2 grassone main-amp)))))
+
+
+(define b-swamp-sparrow
+ (let ((documentation "(swamp-sparrow beg) produces a swamp sparrow call at time 'beg'"))
+ (lambda (beg)
+ (let ((swamp-up '(.00 .00 .60 .70 1.00 1.0))
+ (swamp-down '(.00 1.00 .50 .50 .60 .60 1.00 .0)))
+ (bird beg .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .035) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .08) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .1) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .135) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .18) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .2) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .235) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .28) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .3) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .335) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .38) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .4) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .435) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .48) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .5) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .535) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .58) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .6) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .635) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .68) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .7) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .735) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .78) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .8) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .835) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .88) .025 3700 0 .1 main-amp main-amp)
+
+ (bird (+ beg .9) .02 3900 200 .3 swamp-up main-amp)
+ (bird (+ beg .935) .035 3200 3000 .1 swamp-down main-amp)
+ (bird (+ beg .98) .025 3700 0 .1 main-amp main-amp)))))
+
+
+(define b-golden-crowned-sparrow
+ (let ((documentation "(golden-crowned-sparrow beg) produces a golden crowned sparrow call at time 'beg'"))
+ (lambda (beg)
+ (let (
+ ;; these have as different song around here.
+ (goldone '(.00 1.00 .25 .20 1.00 .0))
+ (goldtwo '(.00 .90 .05 1.00 .10 .40 1.00 .0))
+ (goldtrill '(.00 .50 .10 .00 .20 1.00 .30 .00 .40 1.00 .50 .00 .60 1.00 .70 .00 .80 1.00 .90 .00 1.00 .50 )))
+ (set! beg (- beg .6))
+ (bird (+ beg .6) .5 4300 1000 .15 goldone main-amp)
+ (bird (+ beg 1.3) .45 3300 200 .15 goldone main-amp)
+ (bird (+ beg 1.75) .4 3800 100 .15 goldtwo main-amp)
+ (bird (+ beg 2.2) .3 3800 100 .1 goldtrill main-amp)))))
+
+
+(define b-indigo-bunting
+ (let ((documentation "(indigo-bunting beg) produces a indigo bunting call at time 'beg'"))
+ (lambda (beg)
+ (let ((buntdwn '(.00 1.00 1.00 .0))
+ (buntv '(.00 .00 .50 1.00 1.00 .0))
+ (bunty '(.00 1.00 .50 .00 1.00 .90 ))
+ (buntn '(.00 .80 .30 1.00 .70 .20 1.00 .0))
+ (buntx '(.00 1.00 .10 .50 .25 .90 1.00 .0))
+ (buntup '(.00 .00 1.00 1.0)))
+ (set! beg (- beg .4))
+ (bird (+ beg .4) .08 3000 700 .25 buntdwn main-amp)
+ (bird (+ beg .52) .02 6200 1000 .05 buntdwn main-amp)
+ (bird (+ beg .55) .15 3500 2300 .1 buntv main-amp)
+ (bird (+ beg .74) .02 6200 1800 .05 buntx main-amp)
+ (bird (+ beg .80) .15 3400 2300 .1 buntv main-amp)
+ (bird (+ beg 1.00) .1 3400 800 .2 buntv main-amp)
+ (bird (+ beg 1.13) .03 4100 2000 .05 buntdwn main-amp)
+ (bird (+ beg 1.25) .08 3400 800 .2 buntv main-amp)
+ (bird (+ beg 1.40) .03 4100 2000 .05 buntdwn main-amp)
+ (bird (+ beg 1.5) .07 3700 300 .1 buntdwn main-amp)
+ (bird (+ beg 1.6) .1 4100 2200 .15 bunty main-amp)
+ (bird (+ beg 1.72) .05 3700 300 .1 buntdwn main-amp)
+ (bird (+ beg 1.81) .1 4100 2200 .15 bunty main-amp)
+ (bird (+ beg 1.94) .07 5200 1800 .2 buntn main-amp)
+ (bird (+ beg 2.05) .08 3000 1500 .15 buntup main-amp)
+ (bird (+ beg 2.20) .07 5200 1800 .2 buntn main-amp)
+ (bird (+ beg 2.33) .08 3000 1500 .15 buntup main-amp)
+ (bird (+ beg 2.43) .07 5200 1800 .1 buntn main-amp)
+ (bird (+ beg 2.51) .08 3000 1500 .10 buntup main-amp)))))
+
+
+(define b-hooded-warbler
+ (let ((documentation "(hooded-warbler beg) produces a hooded warbler call at time 'beg'"))
+ (lambda (beg)
+ (let ((hoodup '(.00 .00 1.00 1.0))
+ (hooddown '(.00 1.00 1.00 .0)))
+ (set! beg (- beg .6))
+ (bird (+ beg .6) .03 3900 1600 .05 hooddown main-amp)
+ (bird (+ beg .64) .03 3900 1700 .05 hooddown main-amp)
+ (bird (+ beg .8) .03 3900 2000 .10 hooddown main-amp)
+ (bird (+ beg .84) .03 3900 2000 .10 hooddown main-amp)
+ (bird (+ beg .93) .03 3900 2100 .15 hooddown main-amp)
+ (bird (+ beg .97) .03 3900 2100 .15 hooddown main-amp)
+ (bird (+ beg 1.05) .03 3900 2100 .05 hooddown main-amp)
+ (bird (+ beg 1.09) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.17) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.21) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.39) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.43) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.51) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.55) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.63) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.67) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.75) .03 3900 2100 .2 hooddown main-amp)
+ (bird (+ beg 1.80) .03 3900 2100 .2 hooddown main-amp)
+
+ (bird (+ beg 1.90) .04 3000 1000 .15 hoodup main-amp)
+ (bird (+ beg 1.98) .04 3000 1000 .15 hoodup main-amp)
+ (bird (+ beg 2.05) .04 3000 1000 .15 hoodup main-amp)
+ (bird (+ beg 2.13) .04 3000 1000 .15 hoodup main-amp)
+ (bird (+ beg 2.21) .04 3000 1000 .15 hoodup main-amp)
+ (bird (+ beg 2.29) .04 3000 1000 .15 hoodup main-amp)
+ (bird (+ beg 2.37) .04 3000 1000 .15 hoodup main-amp)
+ (bird (+ beg 2.45) .04 3000 1000 .15 hoodup main-amp)))))
+
+
+(define b-american-widgeon
+ (let ((documentation "(american-widgeon beg) produces an american widgeon call at time 'beg'"))
+ (lambda (beg)
+ (let ((widgeon '(.00 .00 .50 1.00 1.00 .0)))
+ (set! beg (- beg .3))
+ (bigbird (+ beg .3) .07 1900 300 .15 widgeon widgeon '(1 1 2 .02))
+ (bigbird (+ beg .4) .11 1700 1400 .25 widgeon widgeon '(1 .7 2 1 3 .02))
+ (bigbird (+ beg .55) .07 1900 300 .15 widgeon widgeon '(1 1 2 .02))))))
+
+
+(define b-louisiana-waterthrush
+ (let ((documentation "(louisiana-waterthrush beg) produces a louisiana waterthrush call at time 'beg'"))
+ (lambda (beg)
+ (let ((water-one '(.00 .80 .35 .40 .45 .90 .50 1.00 .75 1.00 1.00 .10 ))
+ (water-two '(.00 1.00 .40 .00 .60 .10 1.00 .80 ))
+ (water-three '(.00 1.00 .95 .00 1.00 .0))
+ (water-four '(.00 .00 1.00 1.0))
+ (water-five '(.00 1.00 1.00 .0))
+ (water-amp '(.00 .00 .35 1.00 .50 .20 .90 1.00 1.00 .0))
+ (water-damp '(.00 .00 .90 1.00 1.00 .0)))
+ (bird beg .17 4100 2000 .2 water-one water-amp)
+ (bird (+ beg .32) .18 4050 2050 .3 water-one water-amp)
+ (bird (+ beg .64) .20 4000 1900 .25 water-one water-amp)
+ (bird (+ beg .9) .2 3900 2000 .3 water-two bird-tap)
+ (bird (+ beg 1.25) .12 3000 3000 .25 water-three water-damp)
+ (bird (+ beg 1.4) .1 2700 1500 .2 water-four water-damp)
+ (bird (+ beg 1.58) .02 5200 1000 .1 water-five main-amp)
+ (bird (+ beg 1.65) .02 5200 1000 .1 water-five main-amp)
+ (bird (+ beg 1.7) .035 3200 1000 .1 water-four water-damp)))))
+
+
+(define b-robin
+ (let ((documentation "(robin beg) produces a robin call at time 'beg'"))
+ (lambda (beg)
+ (let ((r-one '(.00 .10 .08 .70 .30 .00 .35 1.00 .40 .30 1.00 .30 ))
+ (r-two '(.00 .00 .10 1.00 .20 .70 .35 .70 .65 .30 .70 .50 .80 .00 .90 .20 1.00 .0))
+ (r-three '(.00 .20 .25 1.00 .60 .70 .90 .00 1.00 .10 ))
+ (r-four '(.00 1.00 1.00 .0))
+ (r-five '(.00 .50 .10 .00 .20 1.00 .30 .00 .40 1.00 .50 .00 .60 1.00 .70 .50 1.00 .20 ))
+ (r-six '(.00 .00 .12 .70 .30 .00 .70 1.00 1.00 .50 )))
+ (set! beg (- beg .45))
+ (bigbird (+ beg .45) .06 2000 800 .15 r-six main-amp '(1 1 2 .1))
+ (bigbird (+ beg .56) .10 2000 900 .15 r-one main-amp '(1 1 2 .1))
+ (bigbird (+ beg 1.04) .24 2000 2000 .25 r-two main-amp '(1 1 2 .1))
+ (bigbird (+ beg 1.63) .13 1900 1600 .20 r-three main-amp '(1 1 2 .1))
+ (bigbird (+ beg 1.80) .11 2200 1200 .25 r-four main-amp '(1 1 2 .1))
+ (bigbird (+ beg 2.31) .21 1950 2000 .15 r-five main-amp '(1 1 2 .1))))))
+
+
+(define b-solitary-vireo
+ (let ((documentation "(solitary-vireo beg) produces a solitary vireo call at time 'beg'"))
+ (lambda (beg)
+ (let ((bigskew '(.00 .20 .03 .30 .06 .10 .10 .50 .13 .40 .16 .80 .19 .50 .22 .90 .25 .60 .28 1.00 .31 .60 .34 1.00 .37 .50 .41 .90 .45 .40 .49 .80 .51 .40 .54 .75 .57 .35 .60 .70 .63 .30 .66 .60 .69 .25 .72 .50 .75 .20 .78 .30 .82 .10 .85 .30 .88 .05 .91 .30 .94 .00 .95 .30 .99 .00 1.00 .10 )))
+ (bird beg .4 1800 1200 .2 bigskew main-amp)))))
+
+
+(define b-pigeon-hawk
+ (let ((documentation "(pigeon-hawk beg) produces a pigeon hawk (merlin) call at time 'beg'"))
+ (lambda (beg)
+ (let ((hupdown '(.00 .00 .30 1.00 .70 1.00 1.00 .0)))
+ (bigbird beg .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .12) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .13) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .25) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .26) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .38) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .39) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .51) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .52) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .64) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .65) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .77) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .78) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg .90) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg .91) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.03) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.04) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.16) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.17) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.29) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.30) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.42) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.43) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.55) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.56) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.68) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.69) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))
+ (bigbird (+ beg 1.81) .01 2050 0 .1 main-amp main-amp '(1 .5 2 1))
+ (bigbird (+ beg 1.82) .1 1900 200 .2 hupdown main-amp '(1 .7 2 1))))))
+
+
+(define b-cerulean-warbler
+ (let ((documentation "(cerulean-warbler beg) produces a cerulean warbler call at time 'beg'"))
+ (lambda (beg)
+ (let ((w-down '(.00 1.00 1.00 .0))
+ (trill '(.00 .80 .10 1.00 .25 .50 .40 1.00 .55 .50 .70 1.00 1.00 .0))
+ (w-up '(.00 .00 1.00 1.0)))
+ (set! beg (- beg .27))
+ (bird (+ beg .27) .05 3000 1000 .05 w-down main-amp)
+ (bird (+ beg .33) .05 3000 800 .075 w-up main-amp)
+ (bird (+ beg .41) .01 3200 700 .07 w-down main-amp)
+ (bird (+ beg .42) .01 3200 700 .08 w-down main-amp)
+ (bird (+ beg .43) .06 3200 700 .09 w-down main-amp)
+ (bird (+ beg .51) .06 3200 500 .1 w-up main-amp)
+ (bird (+ beg .6) .10 3000 1200 .2 trill main-amp)
+ (bird (+ beg .72) .05 3000 800 .2 w-up main-amp)
+ (bird (+ beg .8) .10 3000 1200 .2 trill main-amp)
+ (bird (+ beg .92) .05 3000 800 .2 w-up main-amp)
+ (bird (+ beg 1.00) .01 3900 600 .1 w-up main-amp)
+ (bird (+ beg 1.01) .01 3910 800 .1 w-up main-amp)
+ (bird (+ beg 1.02) .01 3940 500 .1 w-up main-amp)
+ (bird (+ beg 1.03) .01 4000 500 .1 w-up main-amp)
+ (bird (+ beg 1.04) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.05) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.06) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.07) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.08) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.09) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.10) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.11) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.12) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.13) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.14) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.15) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.16) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.17) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.18) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.19) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.20) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.21) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.22) .01 3900 1000 .1 w-up main-amp)
+ (bird (+ beg 1.23) .01 3900 1200 .1 w-up main-amp)
+ (bird (+ beg 1.24) .01 3900 1200 .1 w-up main-amp)
+ (bird (+ beg 1.25) .01 3900 1200 .1 w-up main-amp)
+ (bird (+ beg 1.26) .01 3900 1200 .1 w-up main-amp)
+ (bird (+ beg 1.27) .01 3900 1400 .1 w-up main-amp)
+ (bird (+ beg 1.28) .01 3900 1400 .1 w-up main-amp)
+ (bird (+ beg 1.29) .01 3900 1400 .1 w-up main-amp)
+ (bird (+ beg 1.30) .01 3900 1400 .1 w-up main-amp)))))
+
+
+(define b-nashville-warbler
+ (let ((documentation "(nashville-warbler beg) produces a nashville warbler call at time 'beg'"))
+ (lambda (beg)
+ (let ((nash-blip '(.00 .60 .35 1.00 1.00 .0))
+ (nash-down '(.00 .90 .05 1.00 .10 .90 .65 .50 1.00 .0))
+ (nash-up '(.00 .00 .15 .20 .25 .05 .90 .95 1.00 1.0))
+ (nash-amp '(.00 .00 .80 1.00 1.00 .0)))
+ (set! beg (- beg .15))
+ (bird (+ beg .15) .025 3900 300 .3 nash-blip main-amp)
+ (bird (+ beg .24) .16 4200 3800 .15 nash-down nash-amp)
+ (bird (+ beg .42) .025 3900 300 .3 nash-blip main-amp)
+ (bird (+ beg .55) .14 4300 3700 .15 nash-down nash-amp)
+ (bird (+ beg .75) .03 3950 350 .3 nash-blip main-amp)
+ (bird (+ beg .81) .17 4200 3900 .175 nash-down main-amp)
+ (bird (+ beg 1.0) .02 3800 400 .25 nash-blip main-amp)
+ (bird (+ beg 1.11) .14 4200 3800 .165 nash-down nash-amp)
+ (bird (+ beg 1.3) .03 3750 300 .2 nash-blip main-amp)
+ (bird (+ beg 1.4) .11 4200 3700 .1 nash-down main-amp)
+ (bird (+ beg 1.57) .1 3800 2200 .1 nash-up main-amp)
+ (bird (+ beg 1.7) .1 3800 2150 .125 nash-up main-amp)
+ (bird (+ beg 1.85) .075 3900 1800 .1 nash-up nash-amp)))))
+
+
+(define b-eastern-phoebe
+ (let ((documentation "(eastern-phoebe beg) produces an eastern-phoebe call at time 'beg'"))
+ (lambda (beg)
+ (let ((phoebe-one '(.00 .00 .30 .30 .35 .50 .55 .40 .70 .80 .75 .70 .80 1.00 .95 .90 1.00 .0))
+ (phoebe-two '(.00 .00 .50 1.00 1.00 .0))
+ (phoebe-three '(.00 .00 .10 .40 .80 1.00 1.00 .10 ))
+ (phoebe-four '(.00 1.00 .50 .70 1.00 .0))
+ (phoebe-amp '(.00 .00 .10 1.00 1.00 .0)))
+ (bird beg .225 3000 1300 .3 phoebe-one main-amp)
+ (bird (+ beg .35) .12 3000 500 .1 phoebe-two phoebe-amp)
+ (bird (+ beg .4) .10 3000 1500 .2 phoebe-three phoebe-amp)
+ (bird (+ beg .55) .05 3000 1400 .2 phoebe-four phoebe-amp)))))
+
+
+(define b-painted-bunting
+ (let ((documentation "(painted-bunting beg) produces a painted bunting call at time 'beg'"))
+ (lambda (beg)
+ (let ((b-one '(.00 .00 1.00 1.0))
+ (b-two '(.00 .00 .90 1.00 1.00 .0))
+ (b-three '(.00 1.00 1.00 .0))
+ (b-four '(.00 .00 .50 1.00 1.00 .0))
+ (b-five '(.00 .70 .15 .00 .40 1.00 .80 1.00 1.00 .50 ))
+ (b-six '(.00 .00 .10 .50 .15 .00 .40 1.00 .90 1.00 1.00 .0))
+ (b-seven '(.00 1.00 .25 .40 .75 .50 1.00 .0))
+ (b-eight '(.00 .30 .40 .40 .50 1.00 .60 .20 1.00 .0))
+ (b-nine '(.00 .00 .05 1.00 .30 1.00 .50 .30 .90 1.00 1.00 .0))
+ (b-ten '(.00 .40 .25 .00 .35 1.00 .50 .00 .65 1.00 .75 .00 .85 1.00 1.00 .0))
+ (b-eleven '(.00 1.00 1.00 .0))
+ (b-twelve '(.00 .00 .50 1.00 1.00 .50 ))
+ (b-thirteen '(.00 .00 .05 1.00 .30 .20 .60 .20 .90 1.00 1.00 .0))
+ (b-fourteen '(.00 .30 .30 1.00 .60 .30 1.00 .0))
+ (b-fifteen '(.00 .00 .10 .50 .50 .50 .90 1.00 1.00 .0)))
+ (set! beg (- beg .05))
+ (bird (+ beg .05) .10 3100 900 .05 b-one b-two)
+ (bird (+ beg .21) .07 4100 700 .15 b-three main-amp)
+ (bird (+ beg .36) .12 3700 1000 .20 b-four main-amp)
+ (bird (+ beg .52) .08 2300 1600 .15 b-five b-six)
+ (bird (+ beg .68) .1 4000 1000 .25 b-one bird-tap)
+ (bird (+ beg .8) .12 2300 1700 .2 b-seven main-amp)
+ (bird (+ beg .96) .15 3800 2200 .3 b-eight b-nine)
+ (bird (+ beg 1.18) .1 2300 1600 .15 b-ten main-amp)
+ (bird (+ beg 1.3) .02 3200 1000 .1 b-eleven main-amp)
+ (bird (+ beg 1.33) .02 3200 1000 .1 b-eleven main-amp)
+ (bird (+ beg 1.36) .02 3200 1000 .1 b-eleven main-amp)
+ (bird (+ beg 1.40) .03 4000 2000 .12 b-twelve b-thirteen)
+ (bird (+ beg 1.47) .1 2300 1700 .2 b-fourteen b-fifteen)))))
+
+
+(define b-western-flycatcher
+ (let ((documentation "(western-flycatcher beg) produces a western flycatcher call at time 'beg'"))
+ (lambda (beg)
+ (let ((f-one '(.00 .00 .10 1.00 .20 .40 .95 .10 1.00 .0))
+ (a-one '(.00 .00 .10 .20 .20 .10 .30 1.00 .90 1.00 1.00 .0))
+ (f-two '(.00 .50 .25 1.00 .50 .00 .60 .00 .95 .30 1.00 .60 ))
+ (a-two '(.00 .00 .10 1.00 .20 1.00 .50 .10 .60 .10 .90 1.00 1.00 .0)))
+ (bigbird beg .2 2000 2200 .2 f-one a-one '(1 1 2 .02 3 .1 4 .01))
+ (bigbird (+ beg .3) .2 2000 1100 .2 f-two a-two '(1 1 2 .02 3 .1 4 .01))))))
+
+
+(define b-bachmans-sparrow
+ (let ((documentation "(bachmans-sparrow beg) produces a bachmans sparrow call at time 'beg'"))
+ (lambda (beg)
+ (let ((sopening '(.00 1.00 .10 .50 .90 .50 1.00 .0))
+ (sup '(.00 .10 .35 .00 1.00 1.0))
+ (sdwn '(.00 1.00 .40 .50 1.00 .0))
+ (supn '(.00 .00 1.00 1.0))
+ (slast '(.00 1.00 .25 .00 .75 .40 1.00 .50 )))
+ (bird beg .51 4900 200 .3 sopening main-amp)
+ (bird (+ beg .52) .015 3800 200 .1 sup main-amp)
+ (bird (+ beg .52) .015 3750 250 .1 sup main-amp)
+ (bird (+ beg .54) .015 3600 300 .1 sup main-amp)
+ (bird (+ beg .56) .015 3500 250 .1 sup main-amp)
+ (bird (+ beg .58) .015 3400 200 .1 sup main-amp)
+ (bird (+ beg .60) .015 3200 200 .1 sup main-amp)
+ (bird (+ beg .62) .015 3800 100 .1 sup main-amp)
+
+ (bird (+ beg .65) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg .73) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg .80) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg .88) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg .95) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.03) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg 1.10) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.18) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg 1.25) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.33) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg 1.40) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.48) .03 5000 1000 .1 sdwn main-amp)
+ (bird (+ beg 1.55) .07 3000 750 .2 sup main-amp)
+ (bird (+ beg 1.63) .03 5000 1000 .1 sdwn main-amp)
+
+ (bird (+ beg 2.8) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 2.87) .01 5200 0 .2 supn main-amp)
+ (bird (+ beg 2.9) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 2.97) .01 5200 0 .2 supn main-amp)
+ (bird (+ beg 3.0) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 3.07) .01 5200 0 .2 supn main-amp)
+ (bird (+ beg 3.1) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 3.17) .01 5200 0 .2 supn main-amp)
+ (bird (+ beg 3.2) .06 4000 1700 .1 supn main-amp)
+ (bird (+ beg 3.27) .01 5200 0 .2 supn main-amp)
+
+ (bird (+ beg 3.4) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 3.6) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 3.8) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 4.0) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 4.2) .15 3000 1000 .2 slast main-amp)
+ (bird (+ beg 4.4) .15 3000 1000 .2 slast main-amp)))))
+
+
+(define b-cedar-waxwing
+ (let ((documentation "(cedar-waxwing beg) produces a cedar waxwing call at time 'beg'"))
+ (lambda (beg)
+ (let ((cedar '(.00 .00 .25 .70 .70 1.00 .90 1.00 1.00 .20 ))
+ (cedamp '(.00 .00 .20 1.00 .40 1.00 1.00 .0)))
+ (bird beg .50 6000 800 .2 cedar cedamp)))))
+
+
+(define b-bairds-sparrow
+ (let ((documentation "(bairds-sparrow beg) produces a bairds sparrow call at time 'beg'"))
+ (lambda (beg)
+ (let ((bairdend '(.00 .00 .25 1.00 .50 .00 .75 1.00 1.00 .0))
+ (bairdstart '(.00 .50 .05 1.00 .10 .00 .15 1.00 .20 .00 .25 1.00 .30 .00 .35 1.00 .40 .00 .45 1.00 .50 .00 .55 1.00 .60 .00 .65 1.00 .70 .00 .75 1.00 .80 .00 .85 1.00 .90 .00 .95 1.00 1.00 .0)))
+ (bird beg .09 6500 1500 .2 bairdstart main-amp)
+ (bird (+ beg .22) .01 5900 100 .2 bairdend main-amp)
+ (bird (+ beg .25) .09 6000 1000 .2 bairdstart main-amp)
+ (bird (+ beg .45) .01 4200 100 .2 bairdend main-amp)
+ (bird (+ beg .50) .08 4200 600 .2 bairdstart main-amp)
+ (bird (+ beg .59) .01 4400 100 .2 bairdend main-amp)
+ (bird (+ beg .60) .01 4400 100 .2 bairdend main-amp)
+ (bird (+ beg .68) .07 5400 700 .2 bairdstart main-amp)
+ (bird (+ beg .75) .01 4200 100 .2 bairdend main-amp)
+ (bird (+ beg .79) .01 4400 100 .2 bairdend main-amp)
+ (bird (+ beg .83) .01 4200 100 .19 bairdend main-amp)
+ (bird (+ beg .87) .01 4400 100 .19 bairdend main-amp)
+ (bird (+ beg .91) .01 4200 100 .18 bairdend main-amp)
+ (bird (+ beg .95) .01 4400 100 .18 bairdend main-amp)
+ (bird (+ beg .99) .01 4200 100 .17 bairdend main-amp)
+ (bird (+ beg 1.03) .01 4400 100 .17 bairdend main-amp)
+ (bird (+ beg 1.07) .01 4200 100 .16 bairdend main-amp)
+ (bird (+ beg 1.11) .01 4400 100 .16 bairdend main-amp)
+ (bird (+ beg 1.15) .01 4200 100 .15 bairdend main-amp)
+ (bird (+ beg 1.19) .01 4400 100 .15 bairdend main-amp)
+ (bird (+ beg 1.23) .01 4200 100 .14 bairdend main-amp)
+ (bird (+ beg 1.27) .01 4400 100 .14 bairdend main-amp)
+ (bird (+ beg 1.31) .01 4200 100 .13 bairdend main-amp)
+ (bird (+ beg 1.35) .01 4400 100 .13 bairdend main-amp)
+ (bird (+ beg 1.39) .01 4200 100 .12 bairdend main-amp)
+ (bird (+ beg 1.43) .01 4400 100 .12 bairdend main-amp)
+ (bird (+ beg 1.47) .01 4200 100 .11 bairdend main-amp)
+ (bird (+ beg 1.51) .01 4400 100 .11 bairdend main-amp)
+ (bird (+ beg 1.55) .01 4200 100 .10 bairdend main-amp)
+ (bird (+ beg 1.59) .01 4400 100 .10 bairdend main-amp)
+ (bird (+ beg 1.63) .01 4200 100 .09 bairdend main-amp)
+ (bird (+ beg 1.67) .01 4400 100 .09 bairdend main-amp)
+ (bird (+ beg 1.71) .01 4200 100 .08 bairdend main-amp)
+ (bird (+ beg 1.75) .01 4400 100 .08 bairdend main-amp)
+ (bird (+ beg 1.79) .01 4200 100 .07 bairdend main-amp)
+ (bird (+ beg 1.83) .01 4400 100 .07 bairdend main-amp)
+ (bird (+ beg 1.87) .01 4200 100 .06 bairdend main-amp)
+ (bird (+ beg 1.92) .01 4400 100 .06 bairdend main-amp)
+ (bird (+ beg 1.97) .01 4200 100 .05 bairdend main-amp)))))
+
+
+(define b-kentucky-warbler
+ (let ((documentation "(kentucky-warbler beg) produces a kentucky warbler call at time 'beg'"))
+ (lambda (beg)
+ (let ((kenstart '(.00 .30 .50 1.00 1.00 .0))
+ (kendwn '(.00 .90 .10 1.00 1.00 .0))
+ (kenup '(.00 .00 1.00 1.0))
+ (kentrill '(.00 1.00 .25 .00 .50 .00 .75 1.00 1.00 .0)))
+ (set! beg (- beg .6))
+ (bigbird (+ beg .6) .02 3800 200 .05 kenstart main-amp '(1 1 2 .03))
+ (bigbird (+ beg .65) .03 4300 200 .15 kenup main-amp '(1 1 2 .1))
+ (bigbird (+ beg .73) .02 3200 100 .1 kendwn main-amp '(1 1 2 .1))
+
+ (bigbird (+ beg .75) .05 3000 800 .15 kenstart main-amp '(1 1 2 .01))
+ (bigbird (+ beg .82) .06 3100 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg .90) .06 3200 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg .98) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
+
+ (bigbird (+ beg 1.10) .05 2900 800 .15 kenstart main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.17) .06 3000 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.25) .06 3100 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.33) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
+
+ (bigbird (+ beg 1.43) .05 2800 800 .15 kenstart main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.50) .05 2700 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.57) .06 2800 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.64) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
+
+ (bigbird (+ beg 1.75) .05 2700 800 .15 kenstart main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.81) .05 2600 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.88) .06 2600 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg 1.97) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
+
+ (bigbird (+ beg 2.05) .05 2700 800 .15 kenstart main-amp '(1 1 2 .01))
+ (bigbird (+ beg 2.12) .06 2600 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg 2.20) .05 4600 100 .2 kentrill main-amp '(1 1 2 .1))
+
+ (bigbird (+ beg 2.30) .05 2800 800 .15 kenstart main-amp '(1 1 2 .01))
+ (bigbird (+ beg 2.37) .06 2700 1200 .1 kendwn main-amp '(1 1 2 .01))
+ (bigbird (+ beg 2.45) .05 4700 100 .25 kentrill main-amp '(1 1 2 .1))))))
+
+
+(define b-rufous-sided-towhee
+ (let ((documentation "(rufous-sided-towhee beg) produces a rufous sided towhee call at time 'beg'"))
+ (lambda (beg)
+ (let ((towhee-one '(.00 .10 .02 .05 .04 .15 .06 .05 .08 .20 .10 .04 .12 .25 .14 .03 .16 .30 .18 .02 .20 .35 .22 .01 .24 .40 .26 .00 .28 .45 .30 .00 .32 .50 .34 .00 .36 .50 .80 1.00 1.00 .0))
+ (towhee-two '(.00 .00 1.00 1.0))
+ (towhee-three '(.00 1.00 1.00 .0)))
+ (set! beg (- beg .25))
+ (bigbird (+ beg .25) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
+ (bigbird (+ beg .45) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
+ (bigbird (+ beg .60) .13 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
+ (bigbird (+ beg .75) .10 1400 1100 .2 towhee-one main-amp '(1 .03 2 1 3 .03))
+
+ (bird (+ beg .88) .01 5100 2000 .1 towhee-two main-amp)
+ (bird (+ beg .895) .01 5100 1600 .1 towhee-two main-amp)
+ (bird (+ beg .91) .01 5100 1000 .1 towhee-two main-amp)
+ (bird (+ beg .93) .01 3000 1200 .1 towhee-three main-amp)
+
+ (bird (+ beg .945) .01 5100 2000 .09 towhee-two main-amp)
+ (bird (+ beg .96) .01 5100 1600 .09 towhee-two main-amp)
+ (bird (+ beg .975) .01 5100 1000 .09 towhee-two main-amp)
+ (bird (+ beg .995) .01 3000 1200 .09 towhee-three main-amp)
+
+ (bird (+ beg 1.01) .01 5100 2000 .1 towhee-two main-amp)
+ (bird (+ beg 1.025) .01 5100 1600 .1 towhee-two main-amp)
+ (bird (+ beg 1.04) .01 5100 1000 .1 towhee-two main-amp)
+ (bird (+ beg 1.06) .01 3000 1200 .1 towhee-three main-amp)
+
+ (bird (+ beg 1.075) .01 5100 2000 .09 towhee-two main-amp)
+ (bird (+ beg 1.09) .01 5100 1600 .09 towhee-two main-amp)
+ (bird (+ beg 1.105) .01 5100 1000 .09 towhee-two main-amp)
+ (bird (+ beg 1.125) .01 3000 1200 .09 towhee-three main-amp)
+
+ (bird (+ beg 1.14) .01 5100 2000 .08 towhee-two main-amp)
+ (bird (+ beg 1.155) .01 5100 1600 .08 towhee-two main-amp)
+ (bird (+ beg 1.17) .01 5100 1000 .08 towhee-two main-amp)
+ (bird (+ beg 1.19) .01 3000 1200 .08 towhee-three main-amp)
+
+ (bird (+ beg 1.205) .01 5100 2000 .08 towhee-two main-amp)
+ (bird (+ beg 1.220) .01 5100 1600 .08 towhee-two main-amp)
+ (bird (+ beg 1.235) .01 5100 1000 .08 towhee-two main-amp)
+ (bird (+ beg 1.255) .01 3000 1200 .08 towhee-three main-amp)
+
+ (bird (+ beg 1.27) .01 5100 2000 .07 towhee-two main-amp)
+ (bird (+ beg 1.285) .01 5100 1600 .07 towhee-two main-amp)
+ (bird (+ beg 1.30) .01 5100 1000 .07 towhee-two main-amp)
+ (bird (+ beg 1.32) .01 3000 1200 .07 towhee-three main-amp)
+
+ (bird (+ beg 1.335) .01 5100 2000 .06 towhee-two main-amp)
+ (bird (+ beg 1.350) .01 5100 1600 .06 towhee-two main-amp)
+ (bird (+ beg 1.365) .01 5100 1000 .06 towhee-two main-amp)
+ (bird (+ beg 1.385) .01 3000 1200 .06 towhee-three main-amp)
+
+ (bird (+ beg 1.400) .01 5100 2000 .05 towhee-two main-amp)
+ (bird (+ beg 1.415) .01 5100 1600 .05 towhee-two main-amp)
+ (bird (+ beg 1.430) .01 5100 1000 .05 towhee-two main-amp)
+ (bird (+ beg 1.45) .01 3000 1200 .05 towhee-three main-amp)
+
+ (bird (+ beg 1.465) .01 5100 2000 .03 towhee-two main-amp)
+ (bird (+ beg 1.480) .01 5100 1600 .03 towhee-two main-amp)
+ (bird (+ beg 1.495) .01 5100 1000 .03 towhee-two main-amp)
+ (bird (+ beg 1.515) .01 3000 1200 .03 towhee-three main-amp)))))
+
+
+(define b-prothonotary-warbler
+ (let ((documentation "(prothonotary-warbler beg) produces a prothonotary warbler call at time 'beg'"))
+ (lambda (beg)
+ (let ((pro-one '(.00 .10 .20 .00 1.00 1.0))
+ (pro-two '(.00 .00 1.00 1.0))
+ (pro-amp '(.00 .00 .20 1.00 .40 .50 1.00 .0)))
+ (set! beg (- beg .76))
+ (bird (+ beg .76) .08 3000 3000 .05 pro-one pro-amp)
+ (bird (+ beg .85) .05 4000 2500 .06 pro-two bird-amp)
+
+ (bird (+ beg 1.02) .09 3000 3000 .10 pro-one pro-amp)
+ (bird (+ beg 1.12) .05 4000 2500 .10 pro-two bird-amp)
+
+ (bird (+ beg 1.26) .08 3000 3000 .15 pro-one pro-amp)
+ (bird (+ beg 1.35) .05 4000 2500 .16 pro-two bird-amp)
+
+ (bird (+ beg 1.54) .08 3000 3000 .20 pro-one pro-amp)
+ (bird (+ beg 1.63) .05 4000 2500 .19 pro-two bird-amp)
+
+ (bird (+ beg 1.80) .08 3000 3000 .20 pro-one pro-amp)
+ (bird (+ beg 1.89) .05 4000 2500 .16 pro-two bird-amp)
+
+ (bird (+ beg 2.03) .08 3000 3000 .15 pro-one pro-amp)
+ (bird (+ beg 2.12) .05 4000 2500 .10 pro-two bird-amp)
+
+ (bird (+ beg 2.30) .08 3000 3000 .10 pro-one pro-amp)
+ (bird (+ beg 2.39) .05 4000 2500 .06 pro-two bird-amp)))))
+
+
+(define b-audubons-warbler
+ (let ((documentation "(audubons-warbler beg) produces an audubons warbler (yellow-rumped warbler) call at time 'beg'"))
+ (lambda (beg)
+ (let (
+ ;; (yellow-rumped say the revisionists))
+ (w-up '(.00 .00 1.00 1.0))
+ (w-down '(.00 1.00 1.00 .0))
+ (w-end '(.00 .00 .15 1.00 .45 .90 .50 .00 .55 1.00 .90 .90 1.00 .10 ))
+ (w-updown '(.00 .10 .50 1.00 1.00 .0)))
+ (set! beg (- beg .75))
+ (bird (+ beg .75) .04 2400 200 .05 w-down bird-amp)
+ (bird (+ beg .83) .03 3200 200 .1 w-up bird-amp)
+ (bird (+ beg .90) .04 2500 300 .15 w-up bird-amp)
+ (bird (+ beg .97) .04 2300 600 .15 w-down bird-amp)
+ (bird (+ beg 1.02) .03 3500 400 .20 w-up bird-amp)
+ (bird (+ beg 1.06) .04 2300 1200 .10 w-up bird-amp)
+ (bird (+ beg 1.13) .05 2300 1200 .15 w-down bird-amp)
+ (bird (+ beg 1.22) .02 3200 800 .25 w-up bird-amp)
+ (bird (+ beg 1.25) .08 2400 600 .20 w-updown bird-amp)
+ (bird (+ beg 1.35) .02 2200 400 .10 w-up bird-amp)
+ (bird (+ beg 1.38) .07 2400 1400 .15 w-down bird-amp)
+ (bird (+ beg 1.47) .03 3000 800 .20 w-up bird-amp)
+ (bird (+ beg 1.50) .03 2500 400 .10 w-updown bird-amp)
+ (bird (+ beg 1.55) .01 2300 100 .05 w-up bird-amp)
+ (bird (+ beg 1.56) .06 2200 1400 .15 w-down bird-amp)
+ (bird (+ beg 1.65) .03 3100 800 .10 w-up bird-amp)
+ (bird (+ beg 1.70) .07 2800 800 .15 w-updown bird-amp)
+ (bird (+ beg 1.79) .06 2400 1000 .10 w-down bird-amp)
+ (bird (+ beg 1.86) .14 3100 900 .25 w-end bird-amp)
+ (bird (+ beg 2.02) .12 3200 800 .20 w-end bird-amp)))))
+
+
+(define b-lark-bunting
+ (let ((documentation "(lark-bunting beg) produces a lark bunting call at time 'beg'"))
+ (lambda (beg)
+ (let ((b-down '(.00 1.00 1.00 .0))
+ (b-up '(.00 .00 1.00 1.0))
+ (b-trill-one '(.00 .00 .06 .80 .12 .00 .18 .85 .24 .05 .36 .90 .42 .10 .48 .95 .54 .20 .60 1.00 .66 .20 .72 1.00 .78 .20 .84 1.00 .90 .20 1.00 1.0))
+ (b-trill-two '(.00 .00 .05 .80 .10 .00 .15 .85 .20 .00 .25 .90 .30 .00 .35 .95 .40 .00 .45 1.00 .50 .00 .55 1.00 .60 .00 .65 1.00 .70 .00 .75 1.00 .80 .00 .85 1.00 .90 .00 .95 1.00 1.00 .0)))
+ (set! beg (- beg .1))
+ (bird (+ beg .1) .03 1800 100 .1 b-up bird-amp)
+ (bird (+ beg .2) .12 3700 400 .2 b-up bird-amp)
+
+ (bird (+ beg .4) .03 4100 500 .15 b-down bird-amp)
+ (bird (+ beg .45) .05 2000 400 .20 b-down bird-amp)
+ (bird (+ beg .51) .03 1800 100 .1 b-up bird-amp)
+
+ (bird (+ beg .6) .03 4100 500 .15 b-down bird-amp)
+ (bird (+ beg .65) .05 2000 400 .20 b-down bird-amp)
+ (bird (+ beg .71) .03 1800 100 .1 b-up bird-amp)
+
+ (bird (+ beg .8) .03 4100 500 .15 b-down bird-amp)
+ (bird (+ beg .85) .05 2000 400 .20 b-down bird-amp)
+ (bird (+ beg .91) .03 1800 100 .1 b-up bird-amp)
+
+ (bird (+ beg 1.0) .03 4100 500 .15 b-down bird-amp)
+ (bird (+ beg 1.05) .05 2000 400 .20 b-down bird-amp)
+ (bird (+ beg 1.11) .03 1800 100 .1 b-up bird-amp)
+
+ (bird (+ beg 1.2) .03 4100 500 .15 b-down bird-amp)
+ (bird (+ beg 1.25) .05 2000 400 .20 b-down bird-amp)
+ (bird (+ beg 1.31) .03 1800 100 .1 b-up bird-amp)
+
+ (bird (+ beg 1.4) .03 4100 500 .15 b-down bird-amp)
+ (bird (+ beg 1.45) .05 2000 400 .20 b-down bird-amp)
+ (bird (+ beg 1.51) .03 1800 100 .1 b-up bird-amp)
+
+ (bird (+ beg 1.6) .03 4100 500 .15 b-down bird-amp)
+ (bird (+ beg 1.65) .05 2000 400 .20 b-down bird-amp)
+ (bird (+ beg 1.71) .03 1800 100 .1 b-up bird-amp)
+
+ (bird (+ beg 1.77) .23 6000 600 .15 b-trill-one bird-amp)
+ (bird (+ beg 2.005) .28 6000 600 .15 b-trill-two bird-amp)))))
+
+
+(define b-eastern-bluebird
+ (let ((documentation "(eastern-bluebird beg) produces an eastern bluebird call at time 'beg'"))
+ (lambda (beg)
+ (let ((blue-one '(.00 .00 1.00 1.0))
+ (blue-two '(.00 1.00 1.00 .0))
+ (blue-three '(.00 .60 .10 1.00 .20 .00 .25 1.00 .30 .00 .35 1.00 .40 .00 .45 1.00 .50 .00 .75 1.00 1.00 .0))
+ (blue-four '(.00 .00 .50 1.00 1.00 .0))
+ (blue-five '(.00 .50 .10 1.00 .20 .00 .35 1.00 .50 .00 .65 1.00 .80 .00 .95 1.00 1.00 .50 )))
+ (set! beg (- beg .75))
+ (bird (+ beg .75) .02 2000 1600 .1 blue-one bird-amp)
+ (bird (+ beg .80) .02 2000 1600 .1 blue-one bird-amp)
+ (bird (+ beg .86) .02 2000 1600 .1 blue-one bird-amp)
+ (bird (+ beg 1.00) .13 2000 1400 .2 blue-two bird-amp)
+ (bird (+ beg 1.20) .24 2000 800 .2 blue-three bird-amp)
+ (bird (+ beg 1.68) .03 2200 400 .1 blue-one bird-amp)
+ (bird (+ beg 1.72) .10 1950 100 .15 blue-four bird-amp)
+ (bird (+ beg 1.96) .15 2000 600 .20 blue-five bird-amp)))))
+
+
+(define b-chuck-wills-widow
+ (let ((documentation "(chuck-wills-widow beg) produces a chuck wills widow call at time 'beg'"))
+ (lambda (beg)
+ (let ((wid-down '(.00 1.00 1.00 .0))
+ (wid-one '(.00 .00 .10 .10 .25 1.00 .50 .30 .80 .70 1.00 .0))
+ (wid-two '(.00 .20 .30 1.00 .50 .30 .60 .70 .90 .10 1.00 .0)))
+ (set! beg (- beg .05))
+ (bird (+ beg .05) .03 1000 800 .1 wid-down bird-amp)
+ (bird (+ beg .32) .20 1000 1000 .2 wid-one bird-amp)
+ (bird (+ beg .56) .29 900 1100 .2 wid-two bird-amp)))))
+
+
+(define b-blue-gray-gnatcatcher
+ (let ((documentation "(blue-gray-gnatcatcher beg) produces a blue gray gnatcatcher call at time 'beg'"))
+ (lambda (beg)
+ (let ((gskw1 '(.00 .00 .15 1.00 .75 .80 .90 1.00 1.00 .70 ))
+ (gskw2 '(.00 .00 .25 1.00 .75 .70 1.00 .0)))
+ (set! beg (- beg .5))
+ (bigbird (+ beg .5) .20 4000 1000 .2 gskw1 bird-amp '(1 .4 2 1 3 .1))
+ (bigbird (+ beg .8) .13 4000 800 .2 gskw2 bird-amp '(1 .4 2 1 3 .2))
+
+ (bigbird (+ beg 1.4) .25 4000 800 .2 gskw2 bird-amp '(1 .4 2 1 3 .3))
+ (bigbird (+ beg 1.80) .17 4000 900 .2 gskw1 bird-amp '(1 .4 2 1 3 .3))
+ (bigbird (+ beg 2.00) .17 4000 700 .2 gskw1 bird-amp '(1 .4 2 1 3 .3))
+ (bigbird (+ beg 2.20) .17 4000 800 .2 gskw2 bird-amp '(1 .4 2 1 3 .3))))))
+
+
+(define b-black-throated-sparrow
+ (let ((documentation "(black-throated-sparrow beg) produces a black throated sparrow call at time 'beg'"))
+ (lambda (beg)
+ (let ((black-up '(.00 .00 1.00 1.0))
+ (black-down '(.00 1.00 1.00 .0))
+ (black-down-amp '(.00 .00 .75 1.00 1.00 .0))
+ (black-trill '(.00 .00 .03 .70 .06 .00 .09 .75 .12 .00 .15 .80 .18 .05 .21 .85 .24 .10 .27 .90 .30 .10 .33 1.00 .36 .10 .39 1.00 .42 .10 .45 1.00 .48 .10 .51 1.00 .54 .10 .57 1.00 .60 .10 .63 1.00 .66 .10 .69 1.00 .72 .10 .75 1.00 .78 .10 .81 1.00 .84 .10 .87 1.00 .90 .00 .93 .95 .96 .00 1.00 .90 ))
+ (black-up-down '(.00 .00 .50 1.00 1.00 .20 ))
+ (black-amp '(.00 .00 .50 1.00 1.00 .0)))
+ (set! beg (- beg .8))
+ (bird (+ beg .8) .02 2200 1000 .1 black-down bird-amp)
+ (bird (+ beg .83) .01 3000 200 .05 black-up bird-amp)
+ (bird (+ beg .96) .02 5800 500 .05 black-up bird-amp)
+ (bird (+ beg 1.00) .02 4000 200 .05 black-up bird-amp)
+ (bird (+ beg 1.04) .10 2100 1700 .15 black-down black-down-amp)
+ (bird (+ beg 1.15) .05 5700 400 .25 black-up bird-amp)
+ (bird (+ beg 1.25) .25 2000 900 .2 black-trill bird-amp)
+ (bird (+ beg 1.52) .05 5600 400 .15 black-up-down bird-amp)
+
+ (bird (+ beg 1.6) .04 3900 1100 .15 black-up bird-amp)
+ (bird (+ beg 1.66) .01 1900 100 .10 black-up black-amp)
+
+ (bird (+ beg 1.69) .01 3600 300 .10 black-up black-amp)
+ (bird (+ beg 1.71) .03 3900 1000 .15 black-up black-amp)
+ (bird (+ beg 1.74) .02 5000 100 .20 black-up black-amp)
+ (bird (+ beg 1.76) .01 1900 100 .10 black-up black-amp)
+
+ (bird (+ beg 1.78) .01 3600 300 .10 black-up black-amp)
+ (bird (+ beg 1.80) .03 3900 1000 .15 black-up black-amp)
+ (bird (+ beg 1.83) .02 5000 100 .20 black-up black-amp)
+ (bird (+ beg 1.85) .01 1900 100 .10 black-up black-amp)
+
+ (bird (+ beg 1.87) .01 3600 300 .10 black-up black-amp)
+ (bird (+ beg 1.89) .03 3900 1000 .15 black-up black-amp)
+ (bird (+ beg 1.92) .02 5000 100 .20 black-up black-amp)
+ (bird (+ beg 1.94) .01 1900 100 .10 black-up black-amp)
+
+ (bird (+ beg 1.96) .01 3600 300 .10 black-up black-amp)
+ (bird (+ beg 1.98) .03 3900 1000 .15 black-up black-amp)
+ (bird (+ beg 2.01) .02 5000 100 .20 black-up black-amp)
+ (bird (+ beg 2.03) .01 1900 100 .10 black-up black-amp)
+
+ (bird (+ beg 2.05) .01 3600 300 .10 black-up black-amp)
+ (bird (+ beg 2.07) .03 3900 1000 .15 black-up black-amp)
+ (bird (+ beg 2.10) .02 5000 100 .20 black-up black-amp)
+ (bird (+ beg 2.13) .01 1900 100 .10 black-up black-amp)
+
+ (bird (+ beg 2.16) .03 3800 300 .1 black-up bird-amp)))))
+
+
+(define b-black-chinned-sparrow
+ (let ((documentation "(black-chinned-sparrow beg) produces a black chinned sparrow call at time 'beg'"))
+ (lambda (beg)
+ (let ((chin-up '(.00 .00 1.00 1.0))
+ (chin-up2 '(.00 .00 .30 .20 1.00 1.0)))
+ (set! beg (- beg .6))
+ (bird (+ beg .6) .2 4200 100 .1 chin-up bird-amp)
+ (bird (+ beg 1.0) .09 3800 2000 .1 chin-up2 bird-amp)
+ (bird (+ beg 1.25) .08 3900 1700 .12 chin-up2 bird-amp)
+ (bird (+ beg 1.40) .08 3600 2300 .13 chin-up bird-amp)
+ (bird (+ beg 1.50) .11 3100 2800 .14 chin-up bird-amp)
+ (bird (+ beg 1.65) .07 2900 2700 .15 chin-up bird-amp)
+ (bird (+ beg 1.74) .07 2900 2700 .15 chin-up bird-amp)
+ (bird (+ beg 1.82) .07 3000 2300 .13 chin-up bird-amp)
+ (bird (+ beg 1.89) .07 3200 2000 .10 chin-up bird-amp)
+ (bird (+ beg 1.97) .05 3200 1500 .10 chin-up bird-amp)
+ (bird (+ beg 2.04) .04 3400 1000 .07 chin-up bird-amp)
+ (bird (+ beg 2.10) .03 3600 700 .05 chin-up bird-amp)
+ (bird (+ beg 2.15) .03 3800 300 .05 chin-up bird-amp)
+ (bird (+ beg 2.19) .02 3900 100 .03 chin-up bird-amp)
+ (bird (+ beg 2.22) .01 3900 100 .01 chin-up bird-amp)
+ (bird (+ beg 2.24) .01 3900 100 .01 chin-up bird-amp)))))
+
+
+(define various-gull-cries-from-end-of-colony-5
+ (let ((documentation "(various-gull-cries-from-end-of-colony-5 beg) produces a various gull cries at time 'beg'"))
+ (lambda (beg)
+ (let ((gullstart '(0 0 10 1 20 .5000 40 .6000 60 .5000 100 0 ))
+ (gullmiddle '(0 0 10 1 30 .5000 80 .5000 100 0 ))
+ (gullend '(0 0 5 1 10 .5000 90 .4000 100 0 )))
+ (set! beg (- beg .25))
+ (bigbird (+ beg .250) .80 1180 1180 .08 gullend bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 1.500) .90 1180 1180 .07 gullend bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 2.750) 1.00 1050 1050 .08 gullend bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 4.800) .05 1180 1180 .06 gullstart bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 4.950) .10 1180 1180 .08 gullstart bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 5.150) .10 1180 1180 .09 gullstart bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 5.350) .10 1180 1180 .1 gullmiddle bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 5.450) .40 1050 1050 .1 gullend bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 6.250) .80 1050 1050 .1 gullend bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))
+ (bigbird (+ beg 7.450) 1.80 1050 1050 .1 gullend bird-amp
+ '(1 .1 2 1 3 .1 4 .01 5
+ .09 6 .01 7 .01))))))
+
+
+(define make-birds
+ (let ((documentation "(make-birds) calls all the birds in bird.scm"))
+ (lambda ()
+ (with-sound (:clipped #f)
+ (b-orchard-oriole 0)
+ (b-cassins-kingbird 3)
+ (b-chipping-sparrow 6)
+ (b-bobwhite 9)
+ (b-western-meadowlark 12)
+ (b-scissor-tailed-flycatcher 15)
+ (b-great-horned-owl 18)
+ (b-black-throated-gray-warbler 21)
+ (b-yellow-warbler 24)
+ (b-black-necked-stilt 27)
+ (b-chestnut-sided-warbler 30)
+ (b-grasshopper-sparrow 33)
+ (b-swamp-sparrow 36)
+ (b-golden-crowned-sparrow 39)
+ (b-indigo-bunting 42)
+ (b-hooded-warbler 45)
+ (b-american-widgeon 48)
+ (b-louisiana-waterthrush 51)
+ (b-robin 54)
+ (b-solitary-vireo 57)
+ (b-pigeon-hawk 61)
+ (b-cerulean-warbler 64)
+ (b-nashville-warbler 67)
+ (b-eastern-phoebe 70)
+ (b-painted-bunting 73)
+ (b-western-flycatcher 76)
+ (b-bachmans-sparrow 79)
+ (b-cedar-waxwing 82)
+ (b-bairds-sparrow 85)
+ (b-kentucky-warbler 88)
+ (b-rufous-sided-towhee 91)
+ (b-prothonotary-warbler 94)
+ (b-audubons-warbler 97)
+ (b-lark-bunting 100)
+ (b-eastern-bluebird 103)
+ (b-chuck-wills-widow 106)
+ (b-blue-gray-gnatcatcher 109)
+ (b-black-throated-sparrow 112)
+ (b-black-chinned-sparrow 115)
+ (various-gull-cries-from-end-of-colony-5 118)))))
diff --git a/bowl.cms b/bowl.cms
new file mode 100644
index 0000000..668cdd4
--- /dev/null
+++ b/bowl.cms
@@ -0,0 +1,211 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;
+;;; Banded Waveguide Tibetan Bowl Instrument based on
+;;; ====== ========= ======= ==== ==========
+;;;
+;;; Essl, G. and Cook, P. "Banded
+;;; Waveguides: Towards Physical Modelling of Bar
+;;; Percussion Instruments", Proceedings of the
+;;; 1999 International Computer Music Conference.
+;;;
+;;; Also, Essl, Serafin, Cook, and Smith J.O.,
+;;; "Theory of Banded Waveguides", CMJ, 28:1,
+;;; pp37-50, Spring 2004.
+;;;
+;;;
+;;; CLM version by Juan Reyes 2004-2005,
+;;; NOTES:
+;;; As with all physical models, initial conditions matter.
+;;; Frequency range is not too broad. 220Hz. is a good
+;;; starting point.
+;;;
+;;;
+;;; 08/24/2013 replaced delay line macros with DelayL using clm's delay ug
+;;; 08/29/2014 fixed waveguide with feed and reflections
+;;; 08/30/2014 Try different delay line lengths. Fixing bandpass radius param.
+;;; 09/08/2014 Tibetan bowl, using formant filter ug.
+;;; 09/14/2014 This SND's S7 version
+;;;
+
+
+(define* (make-bowtable (offset 0.0) (slope 1.0))
+ (float-vector offset slope))
+
+(define (bowtable b samp)
+ (max 0.0 (- 1.0 (abs (* (b 1) (+ samp (b 0)))))))
+
+
+;;; Let's try a formant for bandpass filtering
+
+(define (make-formantbp freq radius)
+ (make-formant freq radius))
+
+(define (formantbp f sample0)
+ (formant f sample0))
+
+
+;;; Delay line structures and functions using SND's delay generator (as per prc95.scm)
+
+(defgenerator dlya (outp 0) (input #f))
+
+(define (make-delayl len lag)
+ (make-dlya :input (make-delay len :max-size (ceiling (+ len lag 1)))
+ :outp (- lag len)))
+
+(define (delayl d samp)
+ (delay-tick (d 'input) samp)
+ (tap (d 'input) (d 'outp)))
+
+
+;;;;;;;;;;;;;;;;;;;;
+
+(definstrument (singbowl beg dur freq amplitude
+ (maxa 0.9998) ;; max bow velocity
+ (bv 1.0) ;; bow velocity scaler
+ ;; velocity envelope
+ (vel-env '(0 1.0 .95 1.1 1 1.0))
+ (amp-env '(0 0 0.5 1 1 0)) ;;'(0 0.0 .95 1.0 .99 0.00))
+ (rev-amount .08) )
+ (let ((nrmodes 12)
+ (ratius 0.45))
+
+
+ (let* ((start (seconds->samples beg))
+ (baselen (/ *clm-srate* (* freq ratius))) ;; original stk delayl length
+ (baselag (/ *clm-srate* (* 0.9 freq ratius)))
+ (dtapoffs 7.0) ;; tap offset is 0.0 in StK's version
+ (bandpass (make-vector nrmodes))
+ (delayslft (make-vector nrmodes))
+ (delaysrfl (make-vector nrmodes))
+ (modes (make-float-vector nrmodes))
+ (gains (make-float-vector nrmodes))
+ (basegains (make-float-vector nrmodes))
+ (excitations (make-float-vector nrmodes))
+ (delastout (make-float-vector nrmodes))
+ ;;
+ (fradius 0.0) ;; radius for bandpass filter
+ (dlength 0.0) ;; delay-line length
+ (dlag 0.0) ;; delay lag (for tap)
+ ;;
+ (bowtab (make-bowtable :slope 3.0 :offset 0.001))
+ (ampenv (make-env amp-env :scaler amplitude :duration dur))
+ ;; (vel-env (make-env vel-env :scaler bv :duration dur))
+ ;;
+ (maxvelocity maxa)
+ (end (+ start (seconds->samples dur)))
+ )
+ ;;
+ ;;
+ ;; Tibetan Prayer Bowl (ICMC'02)
+ ;;
+
+ (set! (modes 0) 0.996108344)
+ (set! (basegains 0) 0.999925960128219)
+ (set! (modes 1) 1.0038916562)
+ (set! (basegains 1) 0.999925960128219)
+ (set! (modes 2) 2.979178)
+ (set! (basegains 2) 0.999982774366897)
+ (set! (modes 3) 2.99329767)
+ (set! (basegains 3) 0.999982774366897)
+ (set! (modes 4) 5.704452)
+ (set! (basegains 4) 1.0) ;; 0.999999999999999999987356406352
+ (set! (modes 5) 5.704452)
+ (set! (basegains 5) 1.0) ;; 0.999999999999999999987356406352
+ (set! (modes 6) 8.9982)
+ (set! (basegains 6) 1.0) ;;0.999999999999999999996995497558225
+ (set! (modes 7) 9.01549726)
+ (set! (basegains 7) 1.0) ;;0.999999999999999999996995497558225
+ (set! (modes 8) 12.83303)
+ (set! (basegains 8) 0.99965497558225)
+ (set! (modes 9) 12.807382)
+ (set! (basegains 9) 0.999965497558225)
+ (set! (modes 10) 17.2808219)
+ (set! (basegains 10) 0.9999999999999999999965497558225)
+ (set! (modes 11) 21.97602739726)
+ (set! (basegains 11) 0.999999999999999965497558225)
+ ;;
+ ;;
+ (set! (excitations 0) (/ 11.900357 10))
+ (set! (excitations 1) (/ 11.900357 10))
+ (set! (excitations 2) (/ 10.914886 10))
+ (set! (excitations 3) (/ 10.914886 10))
+ (set! (excitations 4) (/ 42.995041 10))
+ (set! (excitations 5) (/ 42.995041 10))
+ (set! (excitations 6) (/ 40.063034 10))
+ (set! (excitations 7) (/ 40.063034 10))
+ (set! (excitations 8) (/ 7.063034 10))
+ (set! (excitations 9) (/ 7.063034 10))
+ (set! (excitations 10) (/ 57.063034 10))
+ (set! (excitations 11) (/ 57.063034 10))
+
+ ;;
+ ;; setFrequency method in STK's BandedWG
+ ;;
+
+
+ (set! fradius (- 0.79998 (* pi (/ 32 *clm-srate*))))
+ (do ((i 0 (+ i 1)))
+ ((= i nrmodes))
+ (set! dlength (floor (/ baselen (modes i))))
+ (set! dlag (floor (/ baselag (modes i)))) ;; (- lag len) --> tap offset
+ (set! (delayslft i) (make-delayl dlength dlag))
+ (set! (delaysrfl i) (make-delayl dlength dlag))
+ (set! (gains i) ( basegains i))
+ (set! (bandpass i)
+ (make-formantbp (* freq (modes i)) fradius)) )
+ ;;
+;;;;;;;;;;;;
+ ;;
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+ ;;
+ (let ((input 0.00)
+ (velinput 0.00)
+ (bowvelocity 0.00)
+ (bplastout 0.0)
+ (dlastsampl 0.00)
+ (sample0 0.00)
+ )
+
+ (do ((k 0 (+ k 1)))
+ ((= k nrmodes))
+ (set! velinput (+ velinput (* (basegains k) (delastout k)))))
+ ;;
+ ;;
+ ;; (set! bowvelocity (* 0.3 (env vel-env) maxvelocity))
+ (set! bowvelocity (* 0.3 maxvelocity))
+ (set! input (- bowvelocity velinput))
+ (set! input (* input (bowtable bowtab input)))
+ (set! input (/ input nrmodes ))
+ ;;
+ ;; Here the waveguide
+ ;;
+ (do ((j 0 (1+ j)))
+ ((= j nrmodes))
+ (set! bplastout
+ (+ bplastout (formantbp (bandpass j)
+ (delayl (delayslft j)
+ (+ input (* (gains j) dlastsampl)) ))))
+ ;;
+ (set! dlastsampl (+ dlastsampl (delayl ( delaysrfl j) bplastout)))
+ (set! (delastout j) dlastsampl)
+ )
+ ;;
+ ;;
+ (set! sample0 (* 2.0 (env ampenv) bplastout))
+ ;;
+ (outa i sample0)
+ ;;
+ (if *reverb*
+ (begin
+ (outa i (* sample0 rev-amount) *reverb*)))
+ )))
+ ))
+
+
+;;; (with-sound () (singbowl 0 1 200 0.4 ))
+;;; (with-sound () (singbowl 0 1 220 0.4 ))
+;;; (with-sound () (singbowl 0 1 180 0.2 ))
+
+
diff --git a/clean.scm b/clean.scm
index 8a8fd0e..11c60e4 100644
--- a/clean.scm
+++ b/clean.scm
@@ -1,30 +1,29 @@
;; clean-channel -- noise reduction
(provide 'snd-clean.scm)
-(if (not (provided? 'snd-dsp.scm)) (load "dsp.scm"))
-
-(define* (goertzel-channel freq beg dur snd chn)
- "(goertzel-channel freq beg dur snd chn) returns the amplitude of the 'freq' spectral component"
- (let* ((sr (srate snd))
- (y2 0.0)
- (y1 0.0)
- (y0 0.0)
- (rfreq (/ (* 2.0 pi freq) sr))
- (cs (* 2.0 (cos rfreq))))
- (scan-channel (lambda (y)
- (set! y2 y1)
- (set! y1 y0)
- (set! y0 (+ (- (* y1 cs) y2) y))
- #f)
- (or beg 0)
- (or dur (frames snd chn))
- snd chn)
- (magnitude (- y0 (* y1 (exp (make-rectangular 0.0 (- rfreq))))))))
+(require snd-dsp.scm snd-generators.scm)
+
+(define goertzel-channel
+ (let ((documentation "(goertzel-channel freq beg dur snd (chn 0)) returns the amplitude of the 'freq' spectral component"))
+ (lambda* (freq (beg 0) dur snd chn)
+ (let* ((sr (srate snd))
+ (rfreq (/ (* 2.0 pi freq) sr))
+ (cs (* 2.0 (cos rfreq))))
+ (let ((reader (make-sampler beg snd chn))
+ (len (- (if (number? dur) dur (- (framples snd chn) beg)) 2))
+ (flt (make-two-pole 1.0 (- cs) 1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (two-pole flt (next-sample reader)))
+ (let ((y1 (two-pole flt (next-sample reader)))
+ (y0 (two-pole flt (next-sample reader))))
+ (magnitude (- y0 (* y1 (exp (complex 0.0 (- rfreq))))))))))))
+
(define* (check-freq freq snd chn)
(let ((hum 0.0))
- (do ((i 0 (+ 1 i))
- (loc 0.0 (+ loc (round (/ (frames snd chn) 5)))))
+ (do ((i 0 (+ i 1))
+ (loc 0.0 (+ loc (round (/ (framples snd chn) 5)))))
((= i 4))
(set! hum (+ hum (goertzel-channel freq loc 2048 snd chn))))
(/ hum 4.0)))
@@ -39,14 +38,13 @@
(samp1 0.0)
(samp2 0.0)
(fixed 0)
- (len (frames snd chn))
+ (len (framples snd chn))
(block-size (min len (* 1024 1024))) ; do edits by blocks rather than sample-at-a-time (saves time, memory etc)
(block-ctr 0)
(block-beg 0)
- (block (make-vct block-size))
+ (block (make-float-vector block-size))
(block-changed #f))
- (run
- (do ((ctr 0 (+ 1 ctr)))
+ (do ((ctr 0 (+ ctr 1)))
((= ctr len))
(set! samp0 samp1)
(set! samp1 samp2)
@@ -73,41 +71,41 @@
(begin
(if block-changed
(begin
- (vct->channel block block-beg block-size snd chn)
+ (float-vector->channel block block-beg block-size snd chn)
(set! block-changed #f)))
(set! block-beg (+ block-beg (- block-size 1)))
(set! block-ctr 1)
(set! (block 0) samp2))))
(if block-changed
- (vct->channel block block-beg block-ctr snd chn)))
+ (float-vector->channel block block-beg block-ctr snd chn))
fixed))
(define (test-remove-single-clicks)
(let ((test (new-sound "test.snd")))
- (let ((data (make-vct 1001)))
+ (let ((data (make-float-vector 1001)))
(do ((i 2 (+ i 30))
(val .9 (- val .05)))
((>= i 1000))
- (set! (data i) val))
+ (float-vector-set! data i val))
(set! (data 1000) .001)
- (vct->channel data)
+ (float-vector->channel data)
(remove-single-sample-clicks)
(let ((mx (maxamp))
(loc (maxamp-position)))
(if (> mx 0.06)
(format #t "~%;remove-single-sample-clicks 0: ~A (at ~D)" mx loc)))
(revert-sound)
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(ang 0.0 (+ ang .01)))
((= i 1000))
- (set! (data i) (+ (data i) (* .2 (sin ang)))))
- (vct->channel data)
+ (float-vector-set! data i (+ (float-vector-ref data i) (* .2 (sin ang)))))
+ (float-vector->channel data)
(remove-single-sample-clicks)
(if (fneq (maxamp) .2)
(format #t "~%;remove-single-sample-clicks sin max: ~A" (maxamp)))
- (let ((cur-data (channel->vct 0))
+ (let ((cur-data (channel->float-vector 0))
(diff 0.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(ang 0.0 (+ ang .01)))
((= i 1000))
(set! diff (max diff (abs (- ( cur-data i) (* .2 (sin ang)))))))
@@ -117,14 +115,14 @@
;;; -------- pops
-(define* (smooth-vct data beg dur)
+(define* (smooth-float-vector data beg dur)
(let* ((y0 (data beg))
(y1 (data (+ beg dur)))
(angle (if (> y1 y0) pi 0.0))
(off (* .5 (+ y0 y1)))
(scale (* 0.5 (abs (- y1 y0))))
(incr (/ pi dur)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i dur))
(set! (data (+ beg i)) (+ off (* scale (cos (+ angle (* i incr)))))))))
@@ -135,10 +133,6 @@
(mx-ahead (make-moving-average (* 4 size))) ; local average of abs difference ahead of current window
(mx-behind (make-moving-average (* 4 size))) ; local average of abs difference behind current window
(mx (make-moving-average size)) ; local average of abs difference
- (samp0 0.0)
- (samp1 0.0)
- (samp2 0.0)
- (samp3 0.0)
(last-ahead-samp 0.0)
(last-dly0-samp 0.0)
@@ -146,23 +140,22 @@
(last-case 0)
(fixed 0)
- (len (frames snd chn))
+ (len (framples snd chn))
(pad (* 8 size))
(block-size (min (+ len pad) (* 1024 1024)))
(block-ctr 0)
(block-beg 0)
- (block (make-vct block-size))
+ (block (make-float-vector block-size))
(block-changed #f))
- (run
(let ((check-val 0.0)
(check-start 0)
(checker 0)
(checked 0)
(checking #f)
(moving-start #t))
- (do ((ctr 0 (+ 1 ctr)))
+ (do ((ctr 0 (+ ctr 1)))
((= ctr len))
(let* ((ahead-samp (next-sample reader))
(diff-ahead (abs (- ahead-samp last-ahead-samp)))
@@ -179,21 +172,21 @@
(set! (block block-ctr) ahead-samp)
(if checking
(begin
- (set! checked (+ 1 checked))
+ (set! checked (+ checked 1))
(if (or (>= checked (* 2 size))
(< cur-avg check-val))
(begin
- (set! fixed (+ 1 fixed))
+ (set! fixed (+ fixed 1))
(set! checking #f)
- (smooth-vct block (- check-start block-beg) (+ size checker))
+ (smooth-float-vector block (- check-start block-beg) (+ size checker))
(set! block-changed #t)))
(if moving-start
(begin
(set! moving-start (< cur-diff avg-behind))
(if moving-start
- (set! check-start (+ 1 check-start)))))
+ (set! check-start (+ check-start 1)))))
(if (not moving-start)
- (set! checker (+ 1 checker))))
+ (set! checker (+ checker 1))))
(if (and (> (- ctr last-case) (* 2 size))
(> cur-avg (* 4 avg-ahead))
(> cur-avg (* 4 avg-behind)))
@@ -202,53 +195,53 @@
(set! check-start (max 0 (- ctr (* 5 size))))
(set! moving-start (< cur-diff avg-behind))
(if moving-start
- (set! check-start (+ 1 check-start)))
+ (set! check-start (+ check-start 1)))
(set! checking #t)
(set! check-val cur-avg)
(set! checker 0)
(set! checked 0)
(set! last-case ctr))))
- (set! block-ctr (+ 1 block-ctr))
+ (set! block-ctr (+ block-ctr 1))
(if (>= (+ block-ctr pad) block-size)
(begin
(if block-changed
(begin
- (vct->channel block block-beg (- block-ctr pad) snd chn)
+ (float-vector->channel block block-beg (- block-ctr pad) snd chn)
(set! block-changed #f)))
(set! block-beg (+ block-beg (- block-ctr pad)))
- (do ((i 0 (+ 1 i))
- (j (- block-ctr pad) (+ 1 j)))
+ (do ((i 0 (+ i 1))
+ (j (- block-ctr pad) (+ j 1)))
((= i pad))
(set! (block i) (block j)))
(set! block-ctr pad)))))
(if block-changed
- (vct->channel block block-beg block-ctr snd chn))))
+ (float-vector->channel block block-beg block-ctr snd chn)))
fixed))
(define (test-remove-pops)
- (let ((test (new-sound "test.snd"))
- (data (make-vct 4001)))
+ (new-sound "test.snd")
+ (let ((data (make-float-vector 4001)))
(do ((i 100 (+ i 200)))
((>= i 3800))
(let ((size (random 8)))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k size))
- (set! (data (+ i k)) (- 1.0 (random 2.0))))))
- (vct->channel data)
+ (set! (data (+ i k)) (mus-random 1.0)))))
+ (float-vector->channel data)
(remove-pops)
(let ((mx (maxamp)))
(if (> mx .01)
(format #t "~%;test remove-pops 0 case: ~A" mx)))
(revert-sound)
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(ang 0.0 (+ ang .01)))
((= i 4000))
(set! (data i) (+ (data i)
(* .2 (sin ang)))))
- (vct->channel data)
+ (float-vector->channel data)
(remove-pops)
(let ((mx (maxamp)))
(if (fneq mx .2)
@@ -259,28 +252,24 @@
;;; -------- hum
(define (test-notch-hum)
- (let ((test (with-sound (:output "test.snd" :srate 22050)
+ (let ((test (with-sound ("test.snd" :srate 22050)
(let ((osc (make-oscil 60.0))
(e (make-env '(0 0 1 .5 9 .5 10 0) :length 44100)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (* (env e) (oscil osc)))))))))
+ (outa i (* (env e) (oscil osc))))))))
(notch-channel (list 60.0) #f #f #f #f #f #f #t 8)
(let ((mx (maxamp)))
(if (> mx .02)
(format #t "~%;notch hum 0: ~A" mx)))
(close-sound (find-sound test)))
- (let ((test (with-sound (:output "test.snd" :srate 22050)
- (let ((osc (make-oscil 60.0))
- (osc1 (make-oscil 40.0))
- (osc2 (make-oscil 80.0))
- (e (make-env '(0 0 1 .3 9 .3 10 0) :length 44100)))
- (run
- (do ((i 0 (+ 1 i)))
+ (let ((test (with-sound ("test.snd" :srate 22050)
+ (let ((p (make-polywave 20.0 (list 2 1 3 1 4 1)))
+ (e (make-env '(0 0 1 .3 9 .3 10 0) :scaler 1/3 :length 44100)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (* (env e) (+ (oscil osc) (oscil osc1) (oscil osc2))))))))))
+ (outa i (* (env e) (polywave p))))))))
(let ((v60 (goertzel 60.0))
(v40 (goertzel 40.0))
@@ -295,15 +284,12 @@
(format #t "~%;notch 60: ~A ~A ~A -> ~A ~A ~A" v40 v60 v80 e40 e60 e80))))
(close-sound (find-sound test)))
- (let ((test (with-sound (:output "test.snd" :srate 22050)
- (let ((osc (make-oscil 60.0))
- (osc1 (make-oscil 55.0))
- (osc2 (make-oscil 65.0))
- (e (make-env '(0 0 1 .3 9 .3 10 0) :length 44100)))
- (run
- (do ((i 0 (+ 1 i)))
+ (let ((test (with-sound ("test.snd" :srate 22050)
+ (let ((p (make-polywave 5.0 (list 11 1 12 1 13 1)))
+ (e (make-env '(0 0 1 .3 9 .3 10 0) :scaler 1/3 :length 44100)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (* (env e) (+ (oscil osc) (oscil osc1) (oscil osc2))))))))))
+ (outa i (* (env e) (polywave p))))))))
(let ((v60 (goertzel 60.0))
(v40 (goertzel 55.0))
@@ -323,15 +309,15 @@
(define (test-remove-DC)
(let ((test (new-sound "test.snd"))
- (data (make-vct 4001)))
- (do ((i 0 (+ 1 i))
+ (data (make-float-vector 4001)))
+ (do ((i 0 (+ i 1))
(ang 0.0 (+ ang .01)))
((= i 4000))
- (set! (data i) (+ .1 (- 0.1 (random 0.2)) (* .2 (sin ang)))))
- (vct->channel data)
+ (float-vector-set! data i (+ .1 (mus-random 0.1) (* .2 (sin ang)))))
+ (float-vector->channel data)
(let ((dc (goertzel 0.0))
(sig (goertzel 35.0)))
- (let ((dcflt (make-filter 2 (vct 1 -1) (vct 0 -0.99))))
+ (let ((dcflt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))))
(map-channel (lambda (y) (filter dcflt y)))
(let ((ndc (goertzel 0.0))
(nsig (goertzel 35.0)))
@@ -342,8 +328,8 @@
(define* (tvf-channel snd chn)
- (let* ((size (frames snd chn))
- (avg-data (make-vct size))
+ (let* ((size (framples snd chn))
+ (avg-data (make-float-vector size))
(ctr 0)
(mx (maxamp snd chn))
(avg-size 8192)
@@ -359,20 +345,20 @@
(minK 1000.0)
)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i avg-size))
(moving-sum del (formant frm (rd0))))
(map-channel
(lambda (datum)
- (let* ((xhatminus xhat)
- (avg (moving-sum del (formant frm (rd0)))))
+ (let ((xhatminus xhat)
+ (avg (moving-sum del (formant frm (rd0)))))
(set! K (min 1.0 (+ .1 (/ avg 100.0))))
; (set! K .5)
(set! (avg-data ctr) K)
- (set! ctr (+ 1 ctr))
+ (set! ctr (+ ctr 1))
(set! maxg (max maxg avg))
(set! ming (min ming avg))
@@ -431,14 +417,14 @@
(hum (max hum60 hum55)))
(if (> hum 30.0)
(let ((humf (if (> hum60 hum55) 60.0 55.0)))
- (notch-channel (list humf) 4096 0 (frames snd chn) snd chn #f #t 4)
+ (notch-channel (list humf) 4096 0 (framples snd chn) snd chn #f #t 4)
(format #t "~%; notch out ~D cycle hum: ~A -> ~A" (floor humf) hum (check-freq humf snd chn)))))
;; look for DC
(let ((dc (check-freq 0.0 snd chn)))
(if (> dc 30.0)
- (let ((dcflt (make-filter 2 (vct 1 -1) (vct 0 -0.99))))
- (map-channel (lambda (y) (filter dcflt y)) 0 (frames snd chn) snd chn)
+ (let ((dcflt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))))
+ (map-channel (lambda (y) (filter dcflt y)) 0 (framples snd chn) snd chn)
(format #t "~%; block DC: ~A -> ~A" dc (check-freq 0.0 snd chn)))))
;; time-varying low-pass filter
@@ -449,8 +435,8 @@
(define* (clean-sound snd)
(let ((index (or snd (selected-sound) (car (sounds)))))
(if (not (sound? index))
- (throw 'no-such-sound (list "clean-sound" snd))
+ (error 'no-such-sound (list "clean-sound" snd))
(let ((chns (channels index)))
- (do ((chn 0 (+ 1 chn)))
+ (do ((chn 0 (+ chn 1)))
((= chn chns))
(clean-channel index chn))))))
diff --git a/clm-ins.fs b/clm-ins.fs
index 3fb5f12..a54a46b 100644
--- a/clm-ins.fs
+++ b/clm-ins.fs
@@ -1,319 +1,442 @@
\ clm-ins.fs -- clm-ins.scm|rb -> clm-ins.fs
\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Fri Feb 03 10:36:51 CET 2006
-\ Changed: Sat Feb 19 17:27:43 CET 2011
-
-\ Commentary:
+\ Created: 06/02/03 10:36:51
+\ Changed: 14/04/28 03:52:17
\
-\ jc-reverb ( keyword-args -- )
-\ violin ( start dur freq amp keyword-args -- )
-\ fm-violin ( start dur freq amp keyword-args -- )
+\ @(#)clm-ins.fs 1.49 4/28/14
+
+\ jc-reverb ( keyword-args -- )
+\ violin ( start dur freq amp keyword-args -- )
+\ fm-violin ( start dur freq amp keyword-args -- )
\
\ clm-ins.scm|rb instruments
\
-\ pluck ( start dur freq amp :optional weighting lossfact -- )
-\ vox ( start dur freq amp ampfun freqfun freqscl voxfun index :optional vibscl -- )
-\ fofins ( start dur freq amp vib f0 a0 f1 a1 f2 a2 :optional ae ve -- )
-\ fm-trumpet ( start dur keyword-args -- )
-\ pqw-vox ( start dur freq spacing-freq amp ampfun freqfun freqscl ... -- )
-\ stereo-flute ( start dur freq flow keyword-args -- )
-\ fm-bell ( start dur freq amp :optional amp-env index-env index -- )
-\ fm-insect ( start dur freq amp amp-env ... -- )
-\ fm-drum ( start dur freq amp index :optional high degr dist rev-amt -- )
-\ gong ( start dur freq amp -- )
-\ attract ( start dur amp c -- )
-\ pqw ( start dur sfreq cfreq amp ampfun indexfun parts -- )
-\ tubebell ( start dur freq amp :optional base --)
-\ wurley ( start dur freq amp -- )
-\ rhodey ( start dur freq amp :optional base -- )
-\ hammondoid ( start dur freq amp -- )
-\ metal ( start dur freq amp -- )
-\ drone ( start dur freq amp ampfun synth ampat ampdc rvibamt rvibfreq -- )
-\ canter ( start dur pitch amp ampfun ranfun skewfun ... -- )
-\ nrev ( keyword-args -- )
-\ reson ( start dur pitch amp indxfun skewfun ... -- )
-\ cellon ( start dur pitch0 amp ampfun betafun ... -- )
-\ jl-reverb ( keyword-args -- )
-\ gran-synth ( start dur freq grain-dur interval amp -- )
-\ touch-tone ( numbers keyword-args -- )
-\ spectra ( start dur freq amp :optional parts ampenv vibamp vibfrq degr dist rev-amt -- )
-\ two-tab ( start dur freq amp :optional par1 par2 aenv ienv vamp vfrq degr dist rev -- )
-\ lbj-piano ( start dur freq amp -- )
-\ resflt ( start dur driver ... -- )
-\ scratch-ins ( start file src-ratio turntable -- )
-\ pins ( file start dur keyword-args -- )
-\ zc ( start dur freq amp len1 len2 feedback -- )
-\ zn ( start dur freq amp len1 len2 feedforward -- )
-\ za ( start dur freq amp len1 len2 fb ffw -- )
-\ clm-expsrc ( start dur in-file exp-ratio src-ratio amp :optional rev start-in-file -- )
-\ exp-snd ( file start dur amp :optional exp-amt ramp seglen sr hop ampenv -- )
-\ expfil ( start dur hopsecs rampsecs steadysecs file1 file2 -- )
-\ graph-eq ( file start dur keyword-args -- )
-\ anoi ( fname start dur :optional fftsize amp-scaler R -- )
-\ fullmix ( in-file :optional start dur inbeg matrix srate reverb-amount -- )
-\ bes-fm ( start dur freq amp ratio index -- )
-
-require clm
+\ pluck ( start dur freq amp :optional weighting lossfact -- )
+\ vox ( start dur freq amp ampfun freqfun freqscl ... -- )
+\ fofins ( start dur freq amp vib f0 a0 f1 a1 f2 a2 :optional ae ve -- )
+\ fm-trumpet ( start dur keyword-args -- )
+\ pqw-vox ( start dur freq spacing-freq amp ampfun freqfun ... -- )
+\ stereo-flute ( start dur freq flow keyword-args -- )
+\ fm-bell ( start dur freq amp :optional amp-env index-env index -- )
+\ fm-insect ( start dur freq amp amp-env ... -- )
+\ fm-drum ( start dur freq amp index :optional high degr dist rev-amt -- )
+\ gong ( start dur freq amp -- )
+\ attract ( start dur amp c -- )
+\ pqw ( start dur sfreq cfreq amp ampfun indexfun parts -- )
+\ tubebell ( start dur freq amp :optional base --)
+\ wurley ( start dur freq amp -- )
+\ rhodey ( start dur freq amp :optional base -- )
+\ hammondoid ( start dur freq amp -- )
+\ metal ( start dur freq amp -- )
+\ drone ( start dur freq amp ampfun synth ampat ampdc ... -- )
+\ canter ( start dur pitch amp ampfun ranfun skewfun ... -- )
+\ nrev ( keyword-args -- )
+\ reson ( start dur pitch amp indxfun skewfun ... -- )
+\ cellon ( start dur pitch0 amp ampfun betafun ... -- )
+\ jl-reverb ( keyword-args -- )
+\ gran-synth ( start dur freq grain-dur interval amp -- )
+\ touch-tone ( numbers keyword-args -- )
+\ spectra ( start dur freq amp :optional ... -- )
+\ two-tab ( start dur freq amp :optional ... -- )
+\ lbj-piano ( start dur freq amp -- )
+\ resflt ( start dur driver ... -- )
+\ scratch-ins ( start file src-ratio turntable -- )
+\ pins ( file start dur keyword-args -- )
+\ zc ( start dur freq amp len1 len2 feedback -- )
+\ zn ( start dur freq amp len1 len2 feedforward -- )
+\ za ( start dur freq amp len1 len2 fb ffw -- )
+\ clm-expsrc ( start dur in-file exp-ratio src-ratio amp :optional ... -- )
+\ exp-snd ( file start dur amp :optional ... -- )
+\ expfil ( start dur hopsecs rampsecs steadysecs file1 file2 -- )
+\ graph-eq ( file start dur keyword-args -- )
+\ anoi ( fname start dur :optional fftsize amp-scaler R -- )
+\ fullmix ( in-file :optional ... -- )
+\ bes-fm ( start dur freq amp ratio index -- )
+
+require clm
require env
\ Prevent name clash with possibly loaded sndins.so.
\ sndins.so instruments can be called with fm-violin-ins etc.
-[defined] fm-violin [if] <'> fm-violin alias fm-violin-ins [then]
-[defined] jc-reverb [if] <'> jc-reverb alias jc-reverb-ins [then]
-[defined] nrev [if] <'> nrev alias nrev-ins [then]
+[ifdef] fm-violin
+ <'> fm-violin alias fm-violin-ins
+ <'> fm-violin-ins <'> fm-violin help-ref help-set!
+[then]
+[ifdef] jc-reverb
+ <'> jc-reverb alias jc-reverb-ins
+ <'> jc-reverb-ins <'> jc-reverb help-ref help-set!
+[then]
+[ifdef] nrev
+ <'> nrev alias nrev-ins
+ <'> nrev-ins <'> nrev help-ref help-set!
+[then]
\ General input function for src, granulate etc.
-: readin-cb ( gen -- proc; dir self -- r )
- 1 proc-create swap ,
- does> ( dir self -- r )
- nip @ ( gen ) readin
+: readin-cb { gen -- prc; dir self -- val }
+ 1 proc-create ( prc )
+ gen ,
+ does> { dir self -- val }
+ self @ ( gen ) readin
;
-: reverb-dur ( rev -- dur ) mus-length samples->seconds *clm-decay-time* f+ ;
+: reverb-dur ( rev -- dur )
+ mus-length samples->seconds *clm-decay-time* f+
+;
\ clm/jcrev.ins
instrument: jc-reverb-fs <{ :key
- volume 1.0
- delay1 0.013
- delay2 0.011
- delay3 0.015
- delay4 0.017
- low-pass #f
- doubled #f
- amp-env #f -- }>
- doc" The Chowning reverb.\n\
+ volume 1.0
+ delay1 0.013
+ delay2 0.011
+ delay3 0.015
+ delay4 0.017
+ low-pass #f
+ doubled #f
+ amp-env #f -- }>
+ doc" The Chowning reverb.\n\
0 1 440 0.2 <'> fm-violin :reverb <'> jc-reverb with-sound\n\
0 1 440 0.2 <'> fm-violin\n\
- :reverb-data #( :low-pass #t ) :reverb <'> jc-reverb :channels 2 with-sound"
- *output* mus-channels { chans }
- *reverb* mus-channels { rev-chans }
- *reverb* reverb-dur { dur }
- *verbose* if get-func-name rev-chans chans reverb-info then
- :feedback -0.7 :feedforward 0.7 :size 1051 make-all-pass { allpass1 }
- :feedback -0.7 :feedforward 0.7 :size 337 make-all-pass { allpass2 }
- :feedback -0.7 :feedforward 0.7 :size 113 make-all-pass { allpass3 }
- :scaler 0.742 :size 4799 make-comb { comb1 }
- :scaler 0.733 :size 4999 make-comb { comb2 }
- :scaler 0.715 :size 5399 make-comb { comb3 }
- :scaler 0.697 :size 5801 make-comb { comb4 }
- chans 1 > { chan2 }
- chans 4 = { chan4 }
- :size delay1 seconds->samples make-delay { outdel1 }
- chan2 if :size delay2 seconds->samples make-delay else #f then { outdel2 }
- doubled chan4 || if :size delay3 seconds->samples make-delay else #f then { outdel3 }
- chan4 doubled chan2 && || if :size delay4 seconds->samples make-delay else #f then { outdel4 }
- amp-env if :envelope amp-env :scaler volume :duration dur make-env else #f then { env-a }
- doubled chan4 && if $" jc-reverb is not set up for doubled reverb in quad" error then
- 0.0 0.0 { comb-sum comb-sum-1 }
- 0.0 dur run
- 0.0 rev-chans 0 ?do j i *reverb* in-any f+ loop { in-val }
- allpass3 allpass2 allpass1 in-val 0.0 all-pass 0.0 all-pass 0.0 all-pass { allpass-sum }
- comb-sum-1 { comb-sum-2 }
- comb-sum to comb-sum-1
- comb1 allpass-sum 0.0 comb
- comb2 allpass-sum 0.0 comb f+
- comb3 allpass-sum 0.0 comb f+
- comb4 allpass-sum 0.0 comb f+ to comb-sum
- low-pass if
- comb-sum comb-sum-2 f+ 0.25 f* comb-sum-1 f2/ f+
- else
- comb-sum
- then { all-sums }
- outdel1 all-sums 0.0 delay { del-a }
- doubled if outdel3 all-sums 0.0 delay del-a f+ to del-a then
- env-a ?dup-if env to volume then
- i del-a volume f* *output* outa drop
- chan2 if
- outdel2 all-sums 0.0 delay { del-b }
- doubled if outdel4 all-sums 0.0 delay del-b f+ to del-b then
- i del-b volume f* *output* outb drop
- then
- chan4 if
- i outdel3 all-sums 0.0 delay volume f* *output* outc drop
- i outdel4 all-sums 0.0 delay volume f* *output* outd drop
- then
- loop
+:reverb-data #( :low-pass #t ) :reverb <'> jc-reverb :channels 2 with-sound."
+ *output* channels { chans }
+ *reverb* channels { rev-chans }
+ *reverb* reverb-dur { dur }
+ *verbose* if
+ get-func-name rev-chans chans reverb-info
+ then
+ :feedback -0.7 :feedforward 0.7 :size 1051 make-all-pass { allpass1 }
+ :feedback -0.7 :feedforward 0.7 :size 337 make-all-pass { allpass2 }
+ :feedback -0.7 :feedforward 0.7 :size 113 make-all-pass { allpass3 }
+ :scaler 0.742 :size 4799 make-comb { comb1 }
+ :scaler 0.733 :size 4999 make-comb { comb2 }
+ :scaler 0.715 :size 5399 make-comb { comb3 }
+ :scaler 0.697 :size 5801 make-comb { comb4 }
+ chans 1 > { chan2 }
+ chans 4 = { chan4 }
+ :size delay1 seconds->samples make-delay { outdel1 }
+ chan2 if
+ :size delay2 seconds->samples make-delay
+ else
+ #f
+ then { outdel2 }
+ doubled
+ chan4 || if
+ :size delay3 seconds->samples make-delay
+ else
+ #f
+ then { outdel3 }
+ chan4
+ doubled chan2 && || if
+ :size delay4 seconds->samples make-delay
+ else
+ #f
+ then { outdel4 }
+ amp-env if
+ :envelope amp-env :scaler volume :duration dur make-env
+ else
+ #f
+ then { env-a }
+ doubled chan4 && if
+ "jc-reverb is not set up for doubled reverb in quad" error
+ then
+ 0.0 0.0 { comb-sum comb-sum-1 }
+ 0.0 dur run
+ 0.0 rev-chans 0 ?do
+ j i *reverb* in-any f+
+ loop { in-val }
+ allpass3 allpass2 allpass1 in-val
+ 0.0 all-pass 0.0 all-pass 0.0 all-pass { allpass-sum }
+ comb-sum-1 { comb-sum-2 }
+ comb-sum to comb-sum-1
+ comb1 allpass-sum 0.0 comb
+ comb2 allpass-sum 0.0 comb f+
+ comb3 allpass-sum 0.0 comb f+
+ comb4 allpass-sum 0.0 comb f+ to comb-sum
+ low-pass if
+ comb-sum comb-sum-2 f+ 0.25 f* comb-sum-1 f2/ f+
+ else
+ comb-sum
+ then { all-sums }
+ outdel1 all-sums 0.0 delay { del-a }
+ doubled if
+ outdel3 all-sums 0.0 delay del-a f+ to del-a
+ then
+ env-a ?dup-if
+ env to volume
+ then
+ i del-a volume f* *output* outa drop
+ chan2 if
+ outdel2 all-sums 0.0 delay { del-b }
+ doubled if
+ outdel4 all-sums 0.0 delay del-b f+ to del-b
+ then
+ i del-b volume f* *output* outb drop
+ then
+ chan4 if
+ i outdel3 all-sums 0.0 delay
+ volume f* *output* outc drop
+ i outdel4 all-sums 0.0 delay
+ volume f* *output* outd drop
+ then
+ loop
;instrument
<'> jc-reverb-fs alias jc-reverb
+<'> jc-reverb <'> jc-reverb-fs help-ref help-set!
\ snd/fm.html
-instrument: violin <{ start dur freq amp
- :key
- fm-index 1.0
- amp-env #( 0 0 25 1 75 1 100 0 )
- index-env #( 0 1 25 0.4 75 0.6 100 0 )
- degree 0.0
- distance 1.0
- reverb-amount 0.01 -- }>
- doc" Violin example from snd/fm.html.\n\
+instrument: violin <{ start dur freq amp :key
+ fm-index 1.0
+ amp-env #( 0 0 25 1 75 1 100 0 )
+ index-env #( 0 1 25 0.4 75 0.6 100 0 )
+ degree 0.0
+ distance 1.0
+ reverb-amount 0.01 -- }>
+ doc" Violin example from snd/fm.html.\n\
0 3 440 0.5 :fm-index 0.5 <'> violin with-sound"
- freq hz->radians { frq-scl }
- frq-scl fm-index f* { maxdev }
- 5.0 freq flog f/ maxdev f* { index1 }
- 8.5 freq flog f- 3.0 freq 1000.0 f/ f+ f/ maxdev 3.0 f* f* { index2 }
- 4.0 freq fsqrt f/ maxdev f* { index3 }
- :frequency freq make-oscil { carrier }
- :frequency freq make-oscil { fmosc1 }
- :frequency freq 3.0 f* make-oscil { fmosc2 }
- :frequency freq 4.0 f* make-oscil { fmosc3 }
- :envelope amp-env :scaler amp :duration dur make-env { ampf }
- :envelope index-env :scaler index1 :duration dur make-env { indf1 }
- :envelope index-env :scaler index2 :duration dur make-env { indf2 }
- :envelope index-env :scaler index3 :duration dur make-env { indf3 }
- :frequency 5.0 :amplitude 0.0025 frq-scl f* make-triangle-wave { pervib }
- :frequency 16.0 :amplitude 0.005 frq-scl f* make-rand-interp { ranvib }
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ { vib }
- carrier
- vib
- fmosc1 vib 0.0 oscil indf1 env f* f+
- fmosc2 3.0 vib f* 0.0 oscil indf2 env f* f+
- fmosc3 4.0 vib f* 0.0 oscil indf3 env f* f+
- 0.0 oscil ampf env f*
- end-run
+ freq hz->radians { frq-scl }
+ frq-scl fm-index f* { maxdev }
+ 5.0 freq flog f/ maxdev f* { index1 }
+ 8.5 freq flog f- 3.0 freq 1000.0 f/ f+ f/ maxdev 3.0 f* f* { index2 }
+ 4.0 freq fsqrt f/ maxdev f* { index3 }
+ :frequency freq make-oscil { carrier }
+ :frequency freq make-oscil { fmosc1 }
+ :frequency freq 3.0 f* make-oscil { fmosc2 }
+ :frequency freq 4.0 f* make-oscil { fmosc3 }
+ :envelope amp-env :scaler amp :duration dur make-env { ampf }
+ :envelope index-env :scaler index1 :duration dur make-env { indf1 }
+ :envelope index-env :scaler index2 :duration dur make-env { indf2 }
+ :envelope index-env :scaler index3 :duration dur make-env { indf3 }
+ :frequency 5.0
+ :amplitude 0.0025 frq-scl f* make-triangle-wave { pervib }
+ :frequency 16.0
+ :amplitude 0.005 frq-scl f* make-rand-interp { ranvib }
+ start dur
+ #{ :degree degree :distance distance :reverb reverb-amount }
+ run-instrument
+ pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ { vib }
+ carrier vib
+ fmosc1 vib 0.0 oscil indf1 env f* f+
+ fmosc2 3.0 vib f* 0.0 oscil indf2 env f* f+
+ fmosc3 4.0 vib f* 0.0 oscil indf3 env f* f+
+ 0.0 oscil ampf env f*
+ end-run
;instrument
: violin-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.5 violin
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.5 violin
+ dur 0.2 f+ step
;
\ === FM-Violin (clm/v.ins, snd/v.scm|rb) ===
-instrument: fm-violin-fs <{ start dur freq amp
- :key
- fm-index 1.0
- amp-env #( 0 0 25 1 75 1 100 0 )
- periodic-vibrato-rate 5.0
- periodic-vibrato-amplitude 0.0025
- random-vibrato-rate 16.0
- random-vibrato-amplitude 0.005
- noise-freq 1000.0
- noise-amount 0.0
- ind-noise-freq 10.0
- ind-noise-amount 0.0
- amp-noise-freq 20.0
- amp-noise-amount 0.0
- gliss-env #( 0 0 100 0 )
- glissando-amount 0.0
- fm1-env #( 0 1 25 0.4 75 0.6 100 0 )
- fm2-env #( 0 1 25 0.4 75 0.6 100 0 )
- fm3-env #( 0 1 25 0.4 75 0.6 100 0 )
- fm1-rat 1.0
- fm2-rat 3.0
- fm3-rat 4.0
- fm1-index #f
- fm2-index #f
- fm3-index #f
- base 1.0
- degree 0.0
- distance 1.0
- reverb-amount 0.01
- index-type 'violin -- }>
- doc" FM-Violin from clm/v.ins|snd/v.scm|rb.\n\
-0 3 440 0.5 :fm-index 0.5 <'> fm-violin with-sound"
- freq fabs 1.0 f<= if
- $" freq = %s? reset to 440.0" #( freq ) string-format warning
- 440.0 to freq
- then
- freq hz->radians { frq-scl }
- fm-index f0<> { modulate }
- frq-scl fm-index f* { maxdev }
- index-type 'violin equal? { vln }
- freq flog { logfreq }
- freq fsqrt { sqrtfreq }
- fm1-index unless maxdev vln if 5.0 else 7.5 then logfreq f/ f* pi fmin to fm1-index then
- fm2-index unless
- maxdev 3.0 f* vln if 8.5 logfreq f- 3.0 freq 0.001 f* f+ f/ else 15.0 sqrtfreq f/ then
- f* pi fmin to fm2-index
- then
- fm3-index unless maxdev vln if 4.0 else 8.0 then sqrtfreq f/ f* pi fmin to fm3-index then
- noise-amount f0=
- fm1-env fm2-env equal? &&
- fm1-env fm3-env equal? &&
- fm1-rat fm1-rat floor f- f0= &&
- fm2-rat fm1-rat floor f- f0= &&
- fm2-rat fm2-rat floor f- f0= &&
- fm3-rat fm1-rat floor f- f0= &&
- fm3-rat fm3-rat floor f- f0= && { easy-case }
- easy-case modulate && 1.0 && fm1-index || { norm }
- :frequency freq make-oscil { carrier }
- :envelope amp-env :scaler amp :duration dur :base base make-env { ampf }
- #f #f #f { fmosc1 fmosc2 fmosc3 }
- #f #f #f { indf1 indf2 indf3 }
- modulate if
- easy-case if
- :frequency freq fm1-rat f*
- :coeffs
- #( fm1-rat f>s fm1-index
- fm2-rat fm1-rat f/ fround->s fm2-index
- fm3-rat fm1-rat f/ fround->s fm3-index ) 1 partials->polynomial make-polyshape
- else
- :frequency freq fm1-rat f* make-oscil
- then to fmosc1
- easy-case unless
- :frequency freq fm2-rat f* make-oscil to fmosc2
- :frequency freq fm3-rat f* make-oscil to fmosc3
- :envelope fm1-env :scaler norm :duration dur make-env to indf1
- :envelope fm2-env :scaler fm2-index :duration dur make-env to indf2
- :envelope fm3-env :scaler fm3-index :duration dur make-env to indf3
- then
- then
- :envelope gliss-env :scaler glissando-amount frq-scl f* :duration dur make-env { frqf }
- :frequency periodic-vibrato-rate
- :amplitude periodic-vibrato-amplitude frq-scl f* make-triangle-wave { pervib }
- :frequency random-vibrato-rate
- :amplitude random-vibrato-amplitude frq-scl f* make-rand-interp { ranvib }
- #f #f #f { fm-noi ind-noi amp-noi }
- noise-amount f0<> if
- :frequency noise-freq :amplitude noise-amount pi f* make-rand to fm-noi
- then
- ind-noise-freq f0<> ind-noise-amount f0<> && if
- :frequency ind-noise-freq :amplitude ind-noise-amount make-rand-interp to ind-noi
- then
- amp-noise-freq f0<> amp-noise-amount f0<> && if
- :frequency amp-noise-freq :amplitude amp-noise-amount make-rand-interp to amp-noi
- then
- 0.0 0.0 1.0 1.0 { vib fuzz ind-fuzz amp-fuzz }
- modulate if
- easy-case if
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- fm-noi if fm-noi 0.0 rand to fuzz then
- frqf env pervib 0.0 triangle-wave f+ ranvib 0.0 rand-interp f+ to vib
- ind-noi if ind-noi 0.0 rand-interp 1.0 f+ to ind-fuzz then
- amp-noi if amp-noi 0.0 rand-interp 1.0 f+ to amp-fuzz then
- carrier fmosc1 1.0 vib polyshape ind-fuzz f* vib f+ 0.0 oscil ampf env f* amp-fuzz f*
- end-run
- else
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- fm-noi if fm-noi 0.0 rand to fuzz then
- frqf env pervib 0.0 triangle-wave f+ ranvib 0.0 rand-interp f+ to vib
- ind-noi if ind-noi 0.0 rand-interp 1.0 f+ to ind-fuzz then
- amp-noi if amp-noi 0.0 rand-interp 1.0 f+ to amp-fuzz then
- carrier ( gen )
- fmosc1 fm1-rat vib f* fuzz f+ 0.0 oscil indf1 env f*
- fmosc2 fm2-rat vib f* fuzz f+ 0.0 oscil indf2 env f* f+
- fmosc3 fm3-rat vib f* fuzz f+ 0.0 oscil indf3 env f* f+ ind-fuzz f* vib f+ ( fm )
- 0.0 ( pm ) oscil ampf env f* amp-fuzz f*
- end-run
- then
- else
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- fm-noi if fm-noi 0.0 rand to fuzz then
- frqf env pervib 0.0 triangle-wave f+ ranvib 0.0 rand-interp f+ to vib
- ind-noi if ind-noi 0.0 rand-interp 1.0 f+ to ind-fuzz then
- amp-noi if amp-noi 0.0 rand-interp 1.0 f+ to amp-fuzz then
- carrier vib 0.0 oscil ampf env f* amp-fuzz f*
- end-run
- then
+instrument: fm-violin-fs <{ start dur freq amp :key
+ fm-index 1.0
+ amp-env #( 0 0 25 1 75 1 100 0 )
+ periodic-vibrato-rate 5.0
+ periodic-vibrato-amplitude 0.0025
+ random-vibrato-rate 16.0
+ random-vibrato-amplitude 0.005
+ noise-freq 1000.0
+ noise-amount 0.0
+ ind-noise-freq 10.0
+ ind-noise-amount 0.0
+ amp-noise-freq 20.0
+ amp-noise-amount 0.0
+ gliss-env #( 0 0 100 0 )
+ glissando-amount 0.0
+ fm1-env #( 0 1 25 0.4 75 0.6 100 0 )
+ fm2-env #( 0 1 25 0.4 75 0.6 100 0 )
+ fm3-env #( 0 1 25 0.4 75 0.6 100 0 )
+ fm1-rat 1.0
+ fm2-rat 3.0
+ fm3-rat 4.0
+ fm1-index #f
+ fm2-index #f
+ fm3-index #f
+ base 1.0
+ degree 0.0
+ distance 1.0
+ reverb-amount 0.01
+ index-type 'violin -- }>
+ doc" FM-Violin from clm/v.ins|snd/v.scm|rb.\n\
+0 3 440 0.5 :fm-index 0.5 <'> fm-violin with-sound."
+ freq fabs 1.0 f<= if
+ "freq = %s? reset to 440.0" #( freq ) fth-warning
+ 440.0 to freq
+ then
+ freq hz->radians { frq-scl }
+ fm-index f0<> { modulate }
+ frq-scl fm-index f* { maxdev }
+ index-type 'violin = { vln }
+ freq flog { logfreq }
+ freq fsqrt { sqrtfreq }
+ fm1-index unless
+ maxdev vln if
+ 5.0
+ else
+ 7.5
+ then logfreq f/ f* pi fmin to fm1-index
+ then
+ fm2-index unless
+ maxdev 3.0 f* vln if
+ 8.5 logfreq f- 3.0 freq 0.001 f* f+ f/
+ else
+ 15.0 sqrtfreq f/
+ then f* pi fmin to fm2-index
+ then
+ fm3-index unless
+ maxdev vln if
+ 4.0
+ else
+ 8.0
+ then sqrtfreq f/ f* pi fmin to fm3-index
+ then
+ noise-amount f0=
+ fm1-env fm2-env equal? &&
+ fm1-env fm3-env equal? &&
+ fm1-rat fm1-rat floor f- f0= &&
+ fm2-rat fm1-rat floor f- f0= &&
+ fm2-rat fm2-rat floor f- f0= &&
+ fm3-rat fm1-rat floor f- f0= &&
+ fm3-rat fm3-rat floor f- f0= && { easy-case }
+ easy-case modulate && 1.0 && fm1-index || { norm }
+ :frequency freq make-oscil { carrier }
+ :envelope amp-env :scaler amp :duration dur :base base make-env { ampf }
+ #f #f #f { fmosc1 fmosc2 fmosc3 }
+ #f #f #f { indf1 indf2 indf3 }
+ modulate if
+ easy-case if
+ :frequency freq fm1-rat f*
+ :coeffs #( fm1-rat f>s fm1-index
+ fm2-rat fm1-rat f/ fround->s fm2-index
+ fm3-rat fm1-rat f/ fround->s fm3-index )
+ 1 partials->polynomial make-polyshape
+ else
+ :frequency freq fm1-rat f* make-oscil
+ then to fmosc1
+ easy-case unless
+ :frequency freq fm2-rat f* make-oscil to fmosc2
+ :frequency freq fm3-rat f* make-oscil to fmosc3
+ :envelope fm1-env
+ :scaler norm
+ :duration dur make-env to indf1
+ :envelope fm2-env
+ :scaler fm2-index
+ :duration dur make-env to indf2
+ :envelope fm3-env
+ :scaler fm3-index
+ :duration dur make-env to indf3
+ then
+ then
+ :envelope gliss-env
+ :scaler glissando-amount frq-scl f*
+ :duration dur make-env { frqf }
+ :frequency periodic-vibrato-rate
+ :amplitude periodic-vibrato-amplitude frq-scl f*
+ make-triangle-wave { pervib }
+ :frequency random-vibrato-rate
+ :amplitude random-vibrato-amplitude frq-scl f*
+ make-rand-interp { ranvib }
+ #f #f #f { fm-noi ind-noi amp-noi }
+ noise-amount f0<> if
+ :frequency noise-freq
+ :amplitude noise-amount pi f*
+ make-rand to fm-noi
+ then
+ ind-noise-freq f0<>
+ ind-noise-amount f0<> && if
+ :frequency ind-noise-freq
+ :amplitude ind-noise-amount
+ make-rand-interp to ind-noi
+ then
+ amp-noise-freq f0<>
+ amp-noise-amount f0<> && if
+ :frequency amp-noise-freq
+ :amplitude amp-noise-amount
+ make-rand-interp to amp-noi
+ then
+ 0.0 0.0 1.0 1.0 { vib fuzz ind-fuzz amp-fuzz }
+ modulate if
+ easy-case if
+ start dur
+ #{ :degree degree
+ :distance distance
+ :reverb reverb-amount } run-instrument
+ fm-noi if
+ fm-noi 0.0 rand to fuzz
+ then
+ frqf env pervib 0.0 triangle-wave f+
+ ranvib 0.0 rand-interp f+ to vib
+ ind-noi if
+ ind-noi 0.0 rand-interp
+ 1.0 f+ to ind-fuzz
+ then
+ amp-noi if
+ amp-noi 0.0 rand-interp
+ 1.0 f+ to amp-fuzz
+ then
+ carrier ( gen )
+ fmosc1 1.0 vib polyshape
+ ind-fuzz f* vib f+ ( fm )
+ 0.0 ( pm ) oscil
+ ampf env f* amp-fuzz f*
+ end-run
+ else
+ start dur
+ #{ :degree degree
+ :distance distance
+ :reverb reverb-amount } run-instrument
+ fm-noi if
+ fm-noi 0.0 rand to fuzz
+ then
+ frqf env pervib 0.0 triangle-wave f+
+ ranvib 0.0 rand-interp f+ to vib
+ ind-noi if
+ ind-noi 0.0 rand-interp
+ 1.0 f+ to ind-fuzz
+ then
+ amp-noi if
+ amp-noi 0.0 rand-interp
+ 1.0 f+ to amp-fuzz
+ then
+ carrier ( gen )
+ fmosc1 fm1-rat vib f* fuzz f+ 0.0 oscil
+ indf1 env f*
+ fmosc2 fm2-rat vib f* fuzz f+ 0.0 oscil
+ indf2 env f* f+
+ fmosc3 fm3-rat vib f* fuzz f+ 0.0 oscil
+ indf3 env f* f+
+ ind-fuzz f* vib f+ ( fm )
+ 0.0 ( pm ) oscil
+ ampf env f* amp-fuzz f*
+ end-run
+ then
+ else
+ start dur
+ #{ :degree degree :distance distance :reverb reverb-amount }
+ run-instrument
+ fm-noi if
+ fm-noi 0.0 rand to fuzz
+ then
+ frqf env pervib 0.0 triangle-wave f+
+ ranvib 0.0 rand-interp f+ to vib
+ ind-noi if
+ ind-noi 0.0 rand-interp 1.0 f+ to ind-fuzz
+ then
+ amp-noi if
+ amp-noi 0.0 rand-interp 1.0 f+ to amp-fuzz
+ then
+ carrier vib 0.0 oscil ampf env f* amp-fuzz f*
+ end-run
+ then
;
<'> fm-violin-fs alias fm-violin
+<'> fm-violin <'> fm-violin-fs help-ref help-set!
: fm-violin-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.5 fm-violin
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.5 fm-violin
+ dur 0.2 f+ step
;
\ === CLM-INS.(RB|SCM) ===
@@ -321,59 +444,87 @@ instrument: fm-violin-fs <{ start dur freq amp
hide
: get-optimum-c { s o p -- t c }
- o 1/f s o fsin f* 1.0 s f- s o fcos f* f+ fatan2 f* { pa }
- p pa f- f>s { tmp_int } tmp_int unless 1 to tmp_int then
- p pa f- tmp_int f- { pc }
- begin pc 0.1 f< while tmp_int 1 - to tmp_int pc 1.0 f+ to pc repeat
- tmp_int
- o fsin o pc f* fsin f- o o pc f* f+ fsin f/
+ o 1/f s o fsin f* 1.0 s f- s o fcos f* f+ fatan2 f* { pa }
+ p pa f- f>s { tmp_int }
+ tmp_int unless
+ 1 to tmp_int
+ then
+ p pa f- tmp_int f- { pc }
+ begin
+ pc 0.1 f<
+ while
+ tmp_int 1 - to tmp_int
+ pc 1.0 f+ to pc
+ repeat
+ tmp_int ( t )
+ o fsin o pc f* fsin f- o o pc f* f+ fsin f/ ( c )
;
+
: tune-it { f s1 -- s c t }
- mus-srate f f/ { p }
- s1 f0= if 0.5 else s1 then { s }
- f hz->radians { o }
- s o p get-optimum-c { t1 c1 }
- 1.0 s f- o p get-optimum-c { t2 c2 }
- s 0.5 f<> c1 fabs c2 fabs f< && if 1.0 s f- c1 t1 else s c2 t2 then
+ mus-srate f f/ { p }
+ s1 f0= if
+ 0.5
+ else
+ s1
+ then { s }
+ f hz->radians { o }
+ s o p get-optimum-c { t1 c1 }
+ 1.0 s f- o p get-optimum-c { t2 c2 }
+ s 0.5 f<>
+ c1 fabs c2 fabs f< && if
+ 1.0 s f- c1 t1
+ else
+ s c2 t2
+ then
;
set-current
\ PLUCK
-\
+\
\ The Karplus-Strong algorithm as extended by David Jaffe and Julius
\ Smith -- see Jaffe and Smith, "Extensions of the Karplus-Strong
\ Plucked-String Algorithm" CMJ vol 7 no 2 Summer 1983, reprinted in
\ "The Music Machine". translated from CLM's pluck.ins
-instrument: pluck <{ start dur freq amp
- :optional
- weighting 0.5
- lossfact 0.9 -- }>
- doc" Implements the Jaffe-Smith plucked string physical model. \
+instrument: pluck <{ start dur freq amp :optional
+ weighting 0.5
+ lossfact 0.9 -- }>
+ doc" Implement the Jaffe-Smith plucked string physical model. \
WEIGHTING is the ratio of the once-delayed to the twice-delayed samples. \
It defaults to 0.5 = shortest decay. \
Anything other than 0.5 = longer decay. \
Must be between 0 and less than 1.0. \
LOSSFACT can be used to shorten decays. \
Most useful values are between 0.8 and 1.0.\n\
- 0 1 330 0.3 0.95 0.95 <'> pluck with-sound"
- freq weighting tune-it { wt0 c dlen }
- lossfact f0= if 1.0 else 1.0 lossfact fmin then { lf }
- wt0 f0= if 0.5 else 1.0 wt0 fmin then { wt }
- lf 1.0 wt f- f* lf wt f* make-one-zero { allp }
- c 1.0 make-one-zero { feedb }
- dlen 0.0 make-vct map 1.0 2.0 mus-random f- end-map { tab }
- start dur #{ :degree 90.0 random } run-instrument
- tab cycle-ref { val }
- tab i dlen mod 1.0 c f- feedb allp val one-zero one-zero f* vct-set! drop
- amp val f*
- end-run
+0 1 330 0.3 0.95 0.95 <'> pluck with-sound"
+ freq weighting tune-it { wt0 c dlen }
+ lossfact f0= if
+ 1.0
+ else
+ 1.0 lossfact fmin
+ then { lf }
+ wt0 f0= if
+ 0.5
+ else
+ 1.0 wt0 fmin
+ then { wt }
+ lf 1.0 wt f- f* lf wt f* make-one-zero { allp }
+ c 1.0 make-one-zero { feedb }
+ dlen 0.0 make-vct map
+ 1.0 2.0 mus-random f-
+ end-map { tab }
+ start dur #{ :degree 90.0 random } run-instrument
+ tab cycle-ref { val }
+ tab i dlen mod 1.0 c f-
+ feedb allp val one-zero one-zero f* vct-set! drop
+ amp val f*
+ end-run
;instrument
previous
: pluck-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 330 0.3 0.95 0.95 pluck
- dur 0.2 f+ step
+ start now!
+ now@ dur 330 0.3 0.95 0.95 pluck
+ dur 0.2 f+ step
;
\ formant center frequencies for a male speaker (vox and pqw-vox)
@@ -420,1221 +571,1577 @@ previous
\ (using FM here) this version translated (and simplified slightly)
\ from CLM's mlbvoi.ins
instrument: vox <{ start dur freq amp ampfun freqfun freqscl voxfun index
- :optional
- vibscl 0.1 -- }>
- voxfun length { size }
- size make-array { f1 }
- size make-array { f2 }
- size make-array { f3 }
- size 1- 0 ?do
- clm-ins-formants voxfun i 1+ object-ref hash-ref { phon }
- voxfun i object-ref { n }
- f1 i n array-set!
- phon 0 array-ref f1 i 1+ rot array-set!
- f2 i n array-set!
- phon 1 array-ref f2 i 1+ rot array-set!
- f3 i n array-set!
- phon 2 array-ref f3 i 1+ rot array-set!
- 2 +loop
- :frequency 0.0 make-oscil { car-os }
- 6 make-array map :frequency 0.0 make-oscil end-map { ofs }
- :envelope ampfun :scaler amp :duration dur make-env { ampf }
- :envelope f1 :duration dur make-env { frmf1 }
- :envelope f2 :duration dur make-env { frmf2 }
- :envelope f3 :duration dur make-env { frmf3 }
- :envelope freqfun :duration dur :scaler freqscl freq f* :offset freq make-env { freqf }
- :frequency 6.0 :amplitude freq vibscl f* make-triangle-wave { per-vib }
- :frequency 20.0 :amplitude freq 0.01 f* make-rand-interp { ran-vib }
- 6 0.0 make-vct { freqs }
- 6 0.0 make-vct { amps }
- start dur #{ :degree 90.0 random } run-instrument
- freqf env per-vib 0.0 triangle-wave f+ ran-vib 0.0 rand-interp f+ { frq }
- frmf1 env { frm }
- frm frq f/ { frm0 }
- frm0 floor dup f>s { frm-fint frm-int }
- frm-int 2 mod unless
- freqs 0 frm-fint frq f* hz->radians vct-set! drop
- freqs 1 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
- amps 1 frm0 frm-fint f- vct-set! drop
- amps 0 1.0 amps 1 vct-ref f- vct-set! drop
- else
- freqs 1 frm-fint frq f* hz->radians vct-set! drop
- freqs 0 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
- amps 0 frm0 frm-fint f- vct-set! drop
- amps 1 1.0 amps 0 vct-ref f- vct-set! drop
- then
- frmf2 env to frm
- frm frq f/ to frm0
- frm0 floor to frm-fint
- frm-fint f>s to frm-int
- frm-int 2 mod unless
- freqs 2 frm-fint frq f* hz->radians vct-set! drop
- freqs 3 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
- amps 3 frm0 frm-fint f- vct-set! drop
- amps 2 1.0 amps 3 vct-ref f- vct-set! drop
- else
- freqs 3 frm-fint frq f* hz->radians vct-set! drop
- freqs 2 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
- amps 2 frm0 frm-fint f- vct-set! drop
- amps 3 1.0 amps 2 vct-ref f- vct-set! drop
- then
- frmf3 env to frm
- frm frq f/ to frm0
- frm0 floor to frm-fint
- frm-fint f>s to frm-int
- frm-int 2 mod unless
- freqs 4 frm-fint frq f* hz->radians vct-set! drop
- freqs 5 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
- amps 5 frm0 frm-fint f- vct-set! drop
- amps 4 1.0 amps 5 vct-ref f- vct-set! drop
- else
- freqs 5 frm-fint frq f* hz->radians vct-set! drop
- freqs 4 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
- amps 4 frm0 frm-fint f- vct-set! drop
- amps 5 1.0 amps 4 vct-ref f- vct-set! drop
- then
- car-os frq hz->radians 0.0 oscil index f* { caros }
- ofs 0 array-ref caros 0.2 f* freqs 0 vct-ref f+ 0.0 oscil amps 0 vct-ref f*
- ofs 1 array-ref caros 0.2 f* freqs 1 vct-ref f+ 0.0 oscil amps 1 vct-ref f* f+ 0.80 f*
- ofs 2 array-ref caros 0.5 f* freqs 2 vct-ref f+ 0.0 oscil amps 2 vct-ref f*
- ofs 3 array-ref caros 0.5 f* freqs 3 vct-ref f+ 0.0 oscil amps 3 vct-ref f* f+ 0.15 f* f+
- ofs 4 array-ref caros freqs 4 vct-ref f+ 0.0 oscil amps 4 vct-ref f*
- ofs 5 array-ref caros freqs 5 vct-ref f+ 0.0 oscil amps 5 vct-ref f* f+ 0.05 f* f+
- ampf env f*
- end-run
+ :optional vibscl 0.1 -- }>
+ voxfun length { size }
+ size make-array { f1 }
+ size make-array { f2 }
+ size make-array { f3 }
+ size 1- 0 ?do
+ clm-ins-formants voxfun i 1+ object-ref hash-ref { phon }
+ voxfun i object-ref { n }
+ f1 i n array-set!
+ phon 0 array-ref f1 i 1+ rot array-set!
+ f2 i n array-set!
+ phon 1 array-ref f2 i 1+ rot array-set!
+ f3 i n array-set!
+ phon 2 array-ref f3 i 1+ rot array-set!
+ 2 +loop
+ :frequency 0.0 make-oscil { car-os }
+ 6 make-array map
+ :frequency 0.0 make-oscil
+ end-map { ofs }
+ :envelope ampfun :scaler amp :duration dur make-env { ampf }
+ :envelope f1 :duration dur make-env { frmf1 }
+ :envelope f2 :duration dur make-env { frmf2 }
+ :envelope f3 :duration dur make-env { frmf3 }
+ :envelope freqfun
+ :duration dur
+ :scaler freqscl freq f*
+ :offset freq make-env { freqf }
+ :frequency 6.0 :amplitude freq vibscl f* make-triangle-wave { per-vib }
+ :frequency 20.0 :amplitude freq 0.01 f* make-rand-interp { ran-vib }
+ 6 0.0 make-vct { freqs }
+ 6 0.0 make-vct { amps }
+ start dur #{ :degree 90.0 random } run-instrument
+ freqf env per-vib 0.0 triangle-wave f+
+ ran-vib 0.0 rand-interp f+ { frq }
+ frmf1 env { frm }
+ frm frq f/ { frm0 }
+ frm0 floor dup f>s { frm-fint frm-int }
+ frm-int 2 mod unless
+ freqs 0 frm-fint frq f* hz->radians vct-set! drop
+ freqs 1 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
+ amps 1 frm0 frm-fint f- vct-set! drop
+ amps 0 1.0 amps 1 vct-ref f- vct-set! drop
+ else
+ freqs 1 frm-fint frq f* hz->radians vct-set! drop
+ freqs 0 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
+ amps 0 frm0 frm-fint f- vct-set! drop
+ amps 1 1.0 amps 0 vct-ref f- vct-set! drop
+ then
+ frmf2 env to frm
+ frm frq f/ to frm0
+ frm0 floor to frm-fint
+ frm-fint f>s to frm-int
+ frm-int 2 mod unless
+ freqs 2 frm-fint frq f* hz->radians vct-set! drop
+ freqs 3 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
+ amps 3 frm0 frm-fint f- vct-set! drop
+ amps 2 1.0 amps 3 vct-ref f- vct-set! drop
+ else
+ freqs 3 frm-fint frq f* hz->radians vct-set! drop
+ freqs 2 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
+ amps 2 frm0 frm-fint f- vct-set! drop
+ amps 3 1.0 amps 2 vct-ref f- vct-set! drop
+ then
+ frmf3 env to frm
+ frm frq f/ to frm0
+ frm0 floor to frm-fint
+ frm-fint f>s to frm-int
+ frm-int 2 mod unless
+ freqs 4 frm-fint frq f* hz->radians vct-set! drop
+ freqs 5 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
+ amps 5 frm0 frm-fint f- vct-set! drop
+ amps 4 1.0 amps 5 vct-ref f- vct-set! drop
+ else
+ freqs 5 frm-fint frq f* hz->radians vct-set! drop
+ freqs 4 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop
+ amps 4 frm0 frm-fint f- vct-set! drop
+ amps 5 1.0 amps 4 vct-ref f- vct-set! drop
+ then
+ car-os frq hz->radians 0.0 oscil index f* { caros }
+ ofs 0 array-ref caros 0.2 f*
+ freqs 0 vct-ref f+ 0.0 oscil amps 0 vct-ref f*
+ ofs 1 array-ref caros 0.2 f*
+ freqs 1 vct-ref f+ 0.0 oscil amps 1 vct-ref f*
+ f+ 0.80 f*
+ ofs 2 array-ref caros 0.5 f*
+ freqs 2 vct-ref f+ 0.0 oscil amps 2 vct-ref f*
+ ofs 3 array-ref caros 0.5 f*
+ freqs 3 vct-ref f+ 0.0 oscil amps 3 vct-ref f*
+ f+ 0.15 f* f+
+ ofs 4 array-ref caros
+ freqs 4 vct-ref f+ 0.0 oscil amps 4 vct-ref f*
+ ofs 5 array-ref caros
+ freqs 5 vct-ref f+ 0.0 oscil amps 5 vct-ref f*
+ f+ 0.05 f* f+
+ ampf env f*
+ end-run
;instrument
: vox-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- #( 0 0 25 1 75 1 100 0 ) { amp-env }
- #( 0 0 5 0.5 10 0 100 1 ) { frq-env }
- #( 0 :E: 25 :AE: 35 :ER: 65 :ER: 75 :I: 100 :UH: ) { examp1 }
- #( 0 :I: 5 :OW: 10 :I: 50 :AE: 100 :OO: ) { examp2 }
-
- now@ dur 170 0.4 amp-env frq-env 0.1 examp1 0.05 0.1 vox
- dur 0.2 f+ step
- now@ dur 300 0.4 amp-env frq-env 0.1 examp2 0.02 0.1 vox
- dur 0.2 f+ step
- now@ 5.0 600 0.4 amp-env frq-env 0.1 examp2 0.01 0.1 vox
- 5.0 0.2 f+ step
+ start now!
+ #( 0 0 25 1 75 1 100 0 ) { amp-env }
+ #( 0 0 5 0.5 10 0 100 1 ) { frq-env }
+ #( 0 :E: 25 :AE: 35 :ER: 65 :ER: 75 :I: 100 :UH: ) { examp1 }
+ #( 0 :I: 5 :OW: 10 :I: 50 :AE: 100 :OO: ) { examp2 }
+
+ now@ dur 170 0.4 amp-env frq-env 0.1 examp1 0.05 0.1 vox
+ dur 0.2 f+ step
+ now@ dur 300 0.4 amp-env frq-env 0.1 examp2 0.02 0.1 vox
+ dur 0.2 f+ step
+ now@ 5.0 600 0.4 amp-env frq-env 0.1 examp2 0.01 0.1 vox
+ 5.0 0.2 f+ step
;
\ FOF example
-\
+\
\ snd/sndclm.html, section wave-train
-instrument: fofins <{ start dur freq amp vib f0 a0 f1 a1 f2 a2
- :optional
- ae #( 0 0 25 1 75 1 100 0 )
- ve #( 0 1 100 1 ) -- }>
- doc" produces FOF synthesis.\n\
-0 1 270 0.2 0.001 730 0.6 1090 0.3 2440 0.1 <'> fofins with-sound"
- :envelope ae :scaler amp :duration dur make-env { ampf }
- :frequency 6.0 make-oscil { vibr }
- :envelope ve :scaler vib :duration dur make-env { vibenv }
- f0 hz->radians { frq0 }
- f1 hz->radians { frq1 }
- f2 hz->radians { frq2 }
- mus-srate 22050.0 f= if 100 else 200 then { foflen }
- two-pi foflen f/ { win-freq }
- foflen 0.0 make-vct map
- a0 i frq0 f* fsin f*
- a1 i frq1 f* fsin f* f+
- a2 i frq2 f* fsin f* f+ f2/
- 1.0 i win-freq f* fcos f- f*
- end-map { foftab }
- :frequency freq :wave foftab make-wave-train { wt0 }
- start dur #{ :degree 90.0 random } run-instrument
- ampf env wt0 vibenv env vibr 0.0 0.0 oscil f* wave-train f*
- end-run
+instrument: fofins <{ start dur freq amp vib f0 a0 f1 a1 f2 a2 :optional
+ ae #( 0 0 25 1 75 1 100 0 )
+ ve #( 0 1 100 1 ) -- }>
+ doc" Produce FOF synthesis.\n\
+0 1 270 0.2 0.001 730 0.6 1090 0.3 2440 0.1 <'> fofins with-sound."
+ :envelope ae :scaler amp :duration dur make-env { ampf }
+ :frequency 6.0 make-oscil { vibr }
+ :envelope ve :scaler vib :duration dur make-env { vibenv }
+ f0 hz->radians { frq0 }
+ f1 hz->radians { frq1 }
+ f2 hz->radians { frq2 }
+ mus-srate 22050.0 f= if
+ 100
+ else
+ 200
+ then { foflen }
+ two-pi foflen f/ { win-freq }
+ foflen 0.0 make-vct map
+ a0 i frq0 f* fsin f*
+ a1 i frq1 f* fsin f* f+
+ a2 i frq2 f* fsin f* f+ f2/
+ 1.0 i win-freq f* fcos f- f*
+ end-map { foftab }
+ :frequency freq :wave foftab make-wave-train { wt0 }
+ start dur #{ :degree 90.0 random } run-instrument
+ ampf env wt0 vibenv env vibr 0.0 0.0 oscil f* wave-train f*
+ end-run
;instrument
: fofins-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 270 0.2 0.001 730 0.6 1090 0.3 2440 0.1 fofins
- dur 0.2 f+ step
+ start now!
+ now@ dur 270 0.2 0.001 730 0.6 1090 0.3 2440 0.1 fofins
+ dur 0.2 f+ step
;
\ FM TRUMPET
-\
+\
\ Dexter Morrill's FM-trumpet: from CMJ feb 77 p51
-instrument: fm-trumpet <{ start dur
- :key
- frq1 250
- frq2 1500
- amp1 0.5
- amp2 0.1
- ampatt1 0.03
- ampdec1 0.35
- ampatt2 0.03
- ampdec2 0.3
- modfrq1 250
- modind11 0
- modind12 2.66
- modfrq2 250
- modind21 0
- modind22 1.8
- rvibamp 0.007
- rvibfrq 125
- vibamp 0.007
- vibfrq 7
- vibatt 0.6
- vibdec 0.2
- frqskw 0.03
- frqatt 0.06
- ampenv1 #( 0 0 25 1 75 0.9 100 0 )
- ampenv2 #( 0 0 25 1 75 0.9 100 0 )
- indenv1 #( 0 0 25 1 75 0.9 100 0 )
- indenv2 #( 0 0 25 1 75 0.9 100 0 ) -- }>
- doc" 0 2 <'> fm-trumpet with-sound"
- :envelope
- #( 0 1 25 0.1 75 0 100 0 )
- 25
- 100 vibatt dur f/ f* 45.0 fmin
- 75
- 100 1 vibdec dur f/ f- f* 55.0 fmax stretch-envelope
- :scaler vibamp :duration dur make-env { per-vib-f }
- :frequency rvibfrq :amplitude rvibamp make-rand-interp { ran-vib }
- :frequency vibfrq make-oscil { per-vib }
- 75 100 1 0.01 dur f/ f- f* fmax { dec-01 }
- :envelope
- #( 0 0 25 1 75 1 100 0 )
- 25 25 100 frqatt dur f/ f* fmin
- 75 dec-01 stretch-envelope
- :scaler frqskw :duration dur make-env { frq-f }
- 25 100 ampatt1 dur f/ f* fmin { ampattpt1 }
- 75 100 1 ampdec1 dur f/ f- f* fmax { ampdecpt1 }
- 25 100 ampatt2 dur f/ f* fmin { ampattpt2 }
- 75 100 1 ampdec2 dur f/ f- f* fmax { ampdecpt2 }
- :envelope indenv1 25 ampattpt1 75 dec-01 stretch-envelope
- :scaler modfrq1 modind12 modind11 f- f* :duration dur make-env { mod1-f }
- :frequency 0.0 make-oscil { mod1 }
- :frequency 0.0 make-oscil { car1 }
- :envelope ampenv1 25 ampattpt1 75 ampdecpt1 stretch-envelope
- :scaler amp1 :duration dur make-env { car1-f }
- :envelope indenv2 25 ampattpt2 75 dec-01 stretch-envelope
- :scaler modfrq2 modind22 modind21 f- f* :duration dur make-env { mod2-f }
- :frequency 0.0 make-oscil { mod2 }
- :frequency 0.0 make-oscil { car2 }
- :envelope ampenv2 25 ampattpt2 75 ampdecpt2 stretch-envelope
- :scaler amp2 :duration dur make-env { car2-f }
- start dur #{ :degree 90.0 random } run-instrument
- ran-vib 0.0 rand-interp 1.0 f+
- 1.0 per-vib-f env per-vib 0.0 0.0 oscil f* f+ f*
- 1.0 frq-f env f+ f* hz->radians { frq-change }
- car1-f env
- car1 mod1 modfrq1 frq-change f* 0.0 oscil mod1-f env f* frq1 f+ frq-change f* 0.0 oscil f*
- car2-f env
- car2 mod2 modfrq2 frq-change f* 0.0 oscil mod2-f env f* frq2 f+ frq-change f* 0.0 oscil f* f+
- end-run
+instrument: fm-trumpet <{ start dur :key
+ frq1 250
+ frq2 1500
+ amp1 0.5
+ amp2 0.1
+ ampatt1 0.03
+ ampdec1 0.35
+ ampatt2 0.03
+ ampdec2 0.3
+ modfrq1 250
+ modind11 0
+ modind12 2.66
+ modfrq2 250
+ modind21 0
+ modind22 1.8
+ rvibamp 0.007
+ rvibfrq 125
+ vibamp 0.007
+ vibfrq 7
+ vibatt 0.6
+ vibdec 0.2
+ frqskw 0.03
+ frqatt 0.06
+ ampenv1 #( 0 0 25 1 75 0.9 100 0 )
+ ampenv2 #( 0 0 25 1 75 0.9 100 0 )
+ indenv1 #( 0 0 25 1 75 0.9 100 0 )
+ indenv2 #( 0 0 25 1 75 0.9 100 0 ) -- }>
+ doc" 0 2 <'> fm-trumpet with-sound."
+ :envelope #( 0 1 25 0.1 75 0 100 0 )
+ 25.0
+ vibatt dur f/ 100.0 f* 45.0 fmin
+ 75.0
+ 1.0 vibdec dur f/ f- 100.0 f* 55.0 fmax stretch-envelope
+ :scaler vibamp
+ :duration dur make-env { per-vib-f }
+ :frequency rvibfrq :amplitude rvibamp make-rand-interp { ran-vib }
+ :frequency vibfrq make-oscil { per-vib }
+ 1.0 0.01 dur f/ f- 100.0 f* 75.0 fmax { dec-01 }
+ :envelope #( 0 0 25 1 75 1 100 0 )
+ 25.0
+ frqatt dur f/ 100.0 f* 25.0 fmin
+ 75.0
+ dec-01 stretch-envelope
+ :scaler frqskw
+ :duration dur make-env { frq-f }
+ ampatt1 dur f/ 100.0 f* 25.0 fmin { ampattpt1 }
+ 1.0 ampdec1 dur f/ f- 100.0 f* 75.0 fmax { ampdecpt1 }
+ ampatt2 dur f/ 100.0 f* 25.0 fmin { ampattpt2 }
+ 1.0 ampdec2 dur f/ f- 100.0 f* 75.0 fmax { ampdecpt2 }
+ :envelope indenv1 25.0 ampattpt1 75.0 dec-01 stretch-envelope
+ :scaler modfrq1 modind12 modind11 f- f*
+ :duration dur make-env { mod1-f }
+ :frequency 0.0 make-oscil { mod1 }
+ :frequency 0.0 make-oscil { car1 }
+ :envelope ampenv1 25 ampattpt1 75 ampdecpt1 stretch-envelope
+ :scaler amp1
+ :duration dur make-env { car1-f }
+ :envelope indenv2 25 ampattpt2 75 dec-01 stretch-envelope
+ :scaler modfrq2 modind22 modind21 f- f*
+ :duration dur make-env { mod2-f }
+ :frequency 0.0 make-oscil { mod2 }
+ :frequency 0.0 make-oscil { car2 }
+ :envelope ampenv2 25.0 ampattpt2 75.0 ampdecpt2 stretch-envelope
+ :scaler amp2
+ :duration dur make-env { car2-f }
+ start dur #{ :degree 90.0 random } run-instrument
+ ran-vib 0.0 rand-interp 1.0 f+
+ 1.0 per-vib-f env per-vib 0.0 0.0 oscil f* f+ f*
+ 1.0 frq-f env f+ f* hz->radians { frq-change }
+ car1
+ mod1 modfrq1 frq-change f* 0.0 oscil mod1-f env f*
+ frq1 f+ frq-change f* 0.0 oscil car1-f env f*
+ car2
+ mod2 modfrq2 frq-change f* 0.0 oscil mod2-f env f*
+ frq2 f+ frq-change f* 0.0 oscil car2-f env f*
+ f+
+ end-run
;instrument
: fm-trumpet-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur fm-trumpet
- dur 0.2 f+ step
+ start now!
+ now@ dur fm-trumpet
+ dur 0.2 f+ step
;
-struct
- cell% field sin-evens
- cell% field cos-evens
- cell% field sin-odds
- cell% field cos-odds
- cell% field frmfs
- cell% field sin-coeffs
- cell% field cos-coeffs
- cell% field amps
-end-struct pqw-vox%
+#( "pqw-sin-evens"
+ "pqw-sin-odds"
+ "pqw-cos-evens"
+ "pqw-cos-odds"
+ "pqw-cos-coeffs"
+ "pqw-sin-coeffs"
+ "pqw-frmfs"
+ "pqw-amps" ) create-struct make-pqw-vox-struct
\ PQWVOX
-\
+\
\ translation of CLM pqwvox.ins (itself translated from MUS10 of MLB's
\ waveshaping voice instrument (using phase quadrature waveshaping))
instrument: pqw-vox <{ start dur
- freq spacing-freq
- amp ampfun
- freqfun freqscl
- phonemes
- formant-amps formant-shapes -- }>
- :frequency 0.0 make-oscil { car-sin }
- :frequency 0.0 :initial-phase half-pi make-oscil { car-cos }
- :envelope ampfun :scaler amp :duration dur make-env { ampf }
- :envelope freqfun :scaler freqscl freq f* :duration dur :offset freq make-env { freqf }
- :frequency 6.0 :amplitude freq 0.1 f* make-triangle-wave { per-vib }
- :frequency 20.0 :amplitude freq 0.05 f* make-rand-interp { ran-vib }
- phonemes length { plen }
- plen make-array { phone1 }
- plen make-array { phone2 }
- plen make-array { phone3 }
- plen 1- 0 ?do
- phonemes i object-ref { ph }
- phone1 i ph array-set!
- phone2 i ph array-set!
- phone3 i ph array-set!
- clm-ins-formants phonemes i 1+ object-ref hash-ref { ary }
- phone1 i 1+ ary 0 object-ref array-set!
- phone2 i 1+ ary 1 object-ref array-set!
- phone3 i 1+ ary 2 object-ref array-set!
- 2 +loop
- phone1 phone2 phone3 3 >array { phones }
- nil { pv }
- formant-amps map
- pqw-vox% %alloc to pv
- :frequency 0.0 make-oscil pv sin-evens !
- :frequency 0.0 make-oscil pv sin-odds !
- :frequency 0.0 :initial-phase half-pi make-oscil pv cos-evens !
- :frequency 0.0 :initial-phase half-pi make-oscil pv cos-odds !
- formant-shapes i object-ref normalize-partials { shape }
- shape mus-chebyshev-first-kind partials->polynomial pv cos-coeffs !
- shape mus-chebyshev-second-kind partials->polynomial pv sin-coeffs !
- :envelope phones i array-ref :duration dur make-env pv frmfs !
- formant-amps i object-ref pv amps !
- pv
- end-map { values }
- 4 0.0 make-vct { vals }
- spacing-freq freq f/ { frq-ratio }
- start dur #{ :degree 90.0 random } run-instrument
- freqf env per-vib 0.0 triangle-wave f+ ran-vib 0.0 rand-interp f+ { frq }
- frq frq-ratio f* hz->radians { frqscl }
- car-sin frqscl 0.0 oscil { carsin }
- car-cos frqscl 0.0 oscil { carcos }
- 0.0 ( sum )
- values each to pv
- pv frmfs @ env frq f/ { frm0 }
- frm0 floor { frm-fint }
- frm-fint f>s 2 mod unless
- vals 0 frm-fint frq f* hz->radians vct-set! drop ( even-freq )
- vals 1 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop ( odd-freq )
- vals 3 frm0 frm-fint f- vct-set! drop ( odd-amp )
- vals 2 1.0 vals 3 vct-ref f- vct-set! drop ( even-amp )
- else
- vals 1 frm-fint frq f* hz->radians vct-set! drop ( odd-freq )
- vals 0 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop ( even-freq )
- vals 2 frm0 frm-fint f- vct-set! drop ( even-amp )
- vals 3 1.0 vals 2 vct-ref f- vct-set! drop ( odd-amp )
- then
- pv cos-coeffs @ carcos polynomial { fax }
- pv sin-coeffs @ carcos polynomial carsin f* { yfax }
- pv sin-evens @ vals 0 vct-ref 0.0 oscil yfax f*
- pv cos-evens @ vals 0 vct-ref 0.0 oscil fax f* f- vals 2 vct-ref f*
- pv sin-odds @ vals 1 vct-ref 0.0 oscil yfax f*
- pv cos-odds @ vals 1 vct-ref 0.0 oscil fax f* f- vals 3 vct-ref f* f+ pv amps @ f* f+
- end-each
- ampf env f*
- end-run
- values each ( pv ) free throw end-each
+ freq spacing-freq
+ amp ampfun
+ freqfun freqscl
+ phonemes
+ formant-amps formant-shapes -- }>
+ :frequency 0.0 make-oscil { car-sin }
+ :frequency 0.0 :initial-phase half-pi make-oscil { car-cos }
+ :envelope ampfun :scaler amp :duration dur make-env { ampf }
+ :envelope freqfun
+ :scaler freqscl freq f*
+ :duration dur :offset freq
+ make-env { freqf }
+ :frequency 6.0 :amplitude freq 0.1 f* make-triangle-wave { per-vib }
+ :frequency 20.0 :amplitude freq 0.05 f* make-rand-interp { ran-vib }
+ phonemes length { plen }
+ plen make-array { phone1 }
+ plen make-array { phone2 }
+ plen make-array { phone3 }
+ plen 1- 0 ?do
+ phonemes i object-ref { ph }
+ phone1 i ph array-set!
+ phone2 i ph array-set!
+ phone3 i ph array-set!
+ clm-ins-formants phonemes i 1+ object-ref hash-ref { ary }
+ phone1 i 1+ ary 0 object-ref array-set!
+ phone2 i 1+ ary 1 object-ref array-set!
+ phone3 i 1+ ary 2 object-ref array-set!
+ 2 +loop
+ #( phone1 phone2 phone3 ) { phones }
+ nil 0 { pv shape }
+ formant-amps map
+ make-pqw-vox-struct to pv
+ pv :frequency 0.0 :initial-phase 0.0 make-oscil pqw-sin-evens!
+ pv :frequency 0.0 :initial-phase 0.0 make-oscil pqw-sin-odds!
+ pv
+ :frequency 0.0 :initial-phase half-pi make-oscil
+ pqw-cos-evens!
+ pv
+ :frequency 0.0 :initial-phase half-pi make-oscil
+ pqw-cos-odds!
+ formant-shapes i object-ref normalize-partials to shape
+ pv
+ shape mus-chebyshev-first-kind partials->polynomial
+ pqw-cos-coeffs!
+ pv
+ shape mus-chebyshev-second-kind partials->polynomial
+ pqw-sin-coeffs!
+ :envelope phones i array-ref :duration dur make-env
+ pv swap pqw-frmfs!
+ pv formant-amps i object-ref pqw-amps!
+ pv
+ end-map { values }
+ 4 0.0 make-vct { vals }
+ spacing-freq freq f/ { frq-ratio }
+ start dur #{ :degree 90.0 random } run-instrument
+ freqf env per-vib 0.0 triangle-wave f+
+ ran-vib 0.0 rand-interp f+ { frq }
+ frq frq-ratio f* hz->radians { frqscl }
+ car-sin frqscl 0.0 oscil { carsin }
+ car-cos frqscl 0.0 oscil { carcos }
+ 0.0 ( sum )
+ values each to pv
+ pv pqw-frmfs@ env frq f/ { frm0 }
+ frm0 floor { frm-fint }
+ frm-fint f>s 2 mod unless
+ vals 0
+ frm-fint frq f* hz->radians
+ vct-set! drop ( even-freq )
+ vals 1
+ frm-fint 1.0 f+ frq f* hz->radians
+ vct-set! drop ( odd-freq )
+ vals 3
+ frm0 frm-fint f-
+ vct-set! drop ( odd-amp )
+ vals 2
+ 1.0 vals 3 vct-ref f-
+ vct-set! drop ( even-amp )
+ else
+ vals 1
+ frm-fint frq f* hz->radians
+ vct-set! drop ( odd-freq )
+ vals 0
+ frm-fint 1.0 f+ frq f* hz->radians
+ vct-set! drop ( even-freq )
+ vals 2
+ frm0 frm-fint f-
+ vct-set! drop ( even-amp )
+ vals 3
+ 1.0 vals 2 vct-ref f-
+ vct-set! drop ( odd-amp )
+ then
+ pv pqw-cos-coeffs@ carcos polynomial { fax }
+ pv pqw-sin-coeffs@ carcos polynomial carsin f* { yfax }
+ pv pqw-sin-evens@ vals 0 vct-ref 0.0 oscil yfax f*
+ pv pqw-cos-evens@
+ vals 0 vct-ref 0.0 oscil fax f* f-
+ vals 2 vct-ref f*
+ pv pqw-sin-odds@ vals 1 vct-ref 0.0 oscil yfax f*
+ pv pqw-cos-odds@
+ vals 1 vct-ref 0.0 oscil fax f* f-
+ vals 3 vct-ref f*
+ f+ pv pqw-amps@ f* f+
+ end-each ( sum )
+ ampf env f*
+ end-run
;instrument
: pqw-vox-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- #( 0 0 50 1 100 0 ) { ampfun }
- #( 0 0 100 0 ) { freqfun }
- #( 0 0 100 1 ) { freqramp }
- #( #( 1 1 2 0.5 ) #( 1 0.5 2 0.5 3 1 ) #( 1 1 4 0.5 ) ) { shapes1 }
- #( #( 1 1 2 0.5 ) #( 1 1 2 0.5 3 0.2 4 0.1 ) #( 1 1 3 0.1 4 0.5 ) ) { shapes2 }
- #( #( 1 1 2 0.5 ) #( 1 1 4 0.1 ) #( 1 1 2 0.1 4 0.05 ) ) { shapes3 }
- #( #( 1 1 2 0.5 3 0.1 4 0.01 ) #( 1 1 4 0.1 ) #( 1 1 2 0.1 4 0.05 ) ) { shapes4 }
- #( 0.8 0.15 0.05 ) { amps }
-
- now@ dur 300 300 0.5 ampfun freqfun 0.00 #( 0 :L: 100 :L: ) #( 0.33 0.33 0.33 ) shapes1 pqw-vox
- dur 0.2 f+ step
- now@ dur 200 200 0.5 ampfun freqramp 0.10 #( 0 :UH: 100 :ER: ) amps shapes2 pqw-vox
- dur 0.2 f+ step
- now@ dur 100 314 0.5 ampfun freqramp 0.10 #( 0 :UH: 100 :ER: ) amps shapes2 pqw-vox
- dur 0.2 f+ step
- now@ dur 200 314 0.5 ampfun freqramp 0.01 #( 0 :UH: 100 :ER: ) amps shapes3 pqw-vox
- dur 0.2 f+ step
- now@ dur 100 414 0.5 ampfun freqramp 0.01 #( 0 :OW: 50 :E: 100 :ER: ) amps shapes4 pqw-vox
- dur 0.2 f+ step
+ start now!
+ #( 0 0 50 1 100 0 ) { ampfun }
+ #( 0 0 100 0 ) { freqfun }
+ #( 0 0 100 1 ) { freqramp }
+ #( #( 1 1 2 0.5 )
+ #( 1 0.5 2 0.5 3 1 )
+ #( 1 1 4 0.5 ) ) { sh1 }
+ #( #( 1 1 2 0.5 )
+ #( 1 1 2 0.5 3 0.2 4 0.1 )
+ #( 1 1 3 0.1 4 0.5 ) ) { sh2 }
+ #( #( 1 1 2 0.5 )
+ #( 1 1 4 0.1 )
+ #( 1 1 2 0.1 4 0.05 ) ) { sh3 }
+ #( #( 1 1 2 0.5 3 0.1 4 0.01 )
+ #( 1 1 4 0.1 )
+ #( 1 1 2 0.1 4 0.05 ) ) { sh4 }
+ #( 0.8 0.15 0.05 ) { amps }
+
+ now@ dur 300 300 0.5 ampfun freqfun 0.00
+ #( 0 :L: 100 :L: ) #( 0.33 0.33 0.33 ) sh1 pqw-vox
+ dur 0.2 f+ step
+ now@ dur 200 200 0.5 ampfun freqramp 0.10
+ #( 0 :UH: 100 :ER: ) amps sh2 pqw-vox
+ dur 0.2 f+ step
+ now@ dur 100 314 0.5 ampfun freqramp 0.10
+ #( 0 :UH: 100 :ER: ) amps sh2 pqw-vox
+ dur 0.2 f+ step
+ now@ dur 200 314 0.5 ampfun freqramp 0.01
+ #( 0 :UH: 100 :ER: ) amps sh3 pqw-vox
+ dur 0.2 f+ step
+ now@ dur 100 414 0.5 ampfun freqramp 0.01
+ #( 0 :OW: 50 :E: 100 :ER: ) amps sh4 pqw-vox
+ dur 0.2 f+ step
;
\ STEREO-FLUTE
-instrument: stereo-flute <{ start dur freq flow
- :key
- flow-envelope #( 0 1 100 1 )
- decay 0.01
- noise 0.0356
- embouchure-size 0.5
- fbk-scl1 0.5
- fbk-scl2 0.55
- out-scl 1.0
- a0 0.7
- b1 -0.3
- vib-rate 5.0
- vib-amount 0.03
- ran-rate 5.0
- ran-amount 0.03 -- }>
- doc" A physical model of a flute.\n\
-0 1 440 0.55 :flow-envelope #( 0 0 1 1 2 1 3 0 ) <'> stereo-flute with-sound"
- :envelope flow-envelope :scaler flow :duration dur decay f- make-env { flowf }
- :frequency vib-rate make-oscil { p-vib }
- :frequency ran-rate make-rand-interp { ran-vib }
- :frequency mus-srate f2/ :amplitude 1.0 make-rand { breath }
- mus-srate freq f/ fround->s { periodic-samples }
- embouchure-size periodic-samples f* fround->s make-delay { emb }
- periodic-samples make-delay { bore }
- a0 b1 make-one-pole { rlf }
- 0.0 0.0 0.0 0.0 { emb-sig delay-sig out-sig prev-out-sig }
- 0.0 0.0 0.0 0.0 0.0 { cur-exit cur-diff cur-flow dc-blocked prev-dc-blocked }
- start dur #{ :degree 90.0 random } run-instrument
- bore out-sig 0.0 delay to delay-sig
- emb cur-diff 0.0 delay to emb-sig
- p-vib 0.0 0.0 oscil vib-amount f*
- ran-vib 0.0 rand-interp ran-amount f* f+
- flowf env f+ to cur-flow
- breath 0.0 rand cur-flow f* noise f* cur-flow f+ fbk-scl1 delay-sig f* f+ to cur-diff
- emb-sig emb-sig emb-sig f* emb-sig f* f- to cur-exit
- rlf fbk-scl2 delay-sig f* cur-exit f+ one-pole to out-sig
- \ ;; NB the DC blocker is not in the cicuit. It is applied to the out-sig
- \ ;; but the result is not fed back into the system.
- out-sig prev-out-sig f- 0.995 prev-dc-blocked f* f+ to dc-blocked
- out-sig to prev-out-sig
- dc-blocked to prev-dc-blocked
- out-scl dc-blocked f*
- end-run
+instrument: stereo-flute <{ start dur freq flow :key
+ flow-envelope #( 0 1 100 1 )
+ decay 0.01
+ noise 0.0356
+ embouchure-size 0.5
+ fbk-scl1 0.5
+ fbk-scl2 0.55
+ out-scl 1.0
+ a0 0.7
+ b1 -0.3
+ vib-rate 5.0
+ vib-amount 0.03
+ ran-rate 5.0
+ ran-amount 0.03 -- }>
+ doc" A physical model of a flute.\n\
+0 1 440 0.55 :flow-envelope #( 0 0 1 1 2 1 3 0 ) <'> stereo-flute with-sound."
+ :envelope flow-envelope
+ :scaler flow
+ :duration dur decay f- make-env { flowf }
+ :frequency vib-rate make-oscil { p-vib }
+ :frequency ran-rate make-rand-interp { ran-vib }
+ :frequency mus-srate f2/ :amplitude 1.0 make-rand { breath }
+ mus-srate freq f/ fround->s { periodic-samples }
+ embouchure-size periodic-samples f* fround->s make-delay { emb }
+ periodic-samples make-delay { bore }
+ a0 b1 make-one-pole { rlf }
+ 0.0 0.0 0.0 0.0 { emb-sig delay-sig out-sig prev-out-sig }
+ 0.0 0.0 0.0 { cur-exit cur-diff cur-flow }
+ 0.0 0.0 { dc-blocked prev-dc-blocked }
+ start dur #{ :degree 90.0 random } run-instrument
+ bore out-sig 0.0 delay to delay-sig
+ emb cur-diff 0.0 delay to emb-sig
+ p-vib 0.0 0.0 oscil vib-amount f* ran-vib 0.0 rand-interp
+ ran-amount f* f+ flowf env f+ to cur-flow
+ breath 0.0 rand cur-flow f* noise f*
+ cur-flow f+ fbk-scl1 delay-sig f* f+ to cur-diff
+ emb-sig emb-sig emb-sig f* emb-sig f* f- to cur-exit
+ rlf fbk-scl2 delay-sig f* cur-exit f+ one-pole to out-sig
+ \ ;; NB the DC blocker is not in the cicuit.
+ \ ;; It is applied to the out-sig but the result is
+ \ ;; not fed back into the system.
+ out-sig prev-out-sig f- 0.995
+ prev-dc-blocked f* f+ to dc-blocked
+ out-sig to prev-out-sig
+ dc-blocked to prev-dc-blocked
+ out-scl dc-blocked f*
+ end-run
;instrument
: flute-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.55 :flow-envelope #( 0 0 1 1 2 1 3 0 ) stereo-flute
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.55 :flow-envelope #( 0 0 1 1 2 1 3 0 ) stereo-flute
+ dur 0.2 f+ step
;
\ FM-BELL
-instrument: fm-bell <{ start dur freq amp
- :optional
- amp-env #( 0 0 0.1 1 10 0.6 25 0.3 50 0.15 90 0.1 100 0 )
- index-env #( 0 1 2 1.1 25 0.75 75 0.5 100 0.2 )
- index 1.0 -- }>
- freq 32.0 f* hz->radians { fm-ind1 }
- 8.0 freq 50.0 f/ f- 4.0 f* hz->radians { fm-ind2 }
- 1.4 freq 250.0 f/ f- 0.705 f* fm-ind2 f* { fm-ind3 }
- 20.0 freq 20.0 f/ f- 32.0 f* hz->radians { fm-ind4 }
- :frequency freq f2* make-oscil { mod1 }
- :frequency freq 1.41 f* make-oscil { mod2 }
- :frequency freq 2.82 f* make-oscil { mod3 }
- :frequency freq 2.4 f* make-oscil { mod4 }
- :frequency freq make-oscil { car1 }
- :frequency freq make-oscil { car2 }
- :frequency freq 2.4 f* make-oscil { car3 }
- :envelope amp-env :scaler amp :duration dur make-env { ampf }
- :envelope index-env :scaler index :duration dur make-env { indf }
- 0.0 { fmenv }
- start dur #{ :degree 90.0 random } run-instrument
- indf env to fmenv
- car1 fmenv fm-ind1 f* mod1 0.0 0.0 oscil f* 0.0 oscil
- car2 fmenv fm-ind2 mod2 0.0 0.0 oscil f*
- fm-ind3 mod3 0.0 0.0 oscil f* f+ f* 0.0 oscil 0.15 f* f+
- car3 fmenv fm-ind4 f* mod4 0.0 0.0 oscil f* 0.0 oscil 0.15 f* f+
- ampf env f*
- end-run
+instrument: fm-bell <{ start dur freq amp :optional
+ amp-env #( 0 0 0.1 1 10 0.6 25 0.3 50 0.15 90 0.1 100 0 )
+ index-env #( 0 1 2 1.1 25 0.75 75 0.5 100 0.2 )
+ index 1.0 -- }>
+ freq 32.0 f* hz->radians { fm-ind1 }
+ 8.0 freq 50.0 f/ f- 4.0 f* hz->radians { fm-ind2 }
+ 1.4 freq 250.0 f/ f- 0.705 f* fm-ind2 f* { fm-ind3 }
+ 20.0 freq 20.0 f/ f- 32.0 f* hz->radians { fm-ind4 }
+ :frequency freq f2* make-oscil { mod1 }
+ :frequency freq 1.41 f* make-oscil { mod2 }
+ :frequency freq 2.82 f* make-oscil { mod3 }
+ :frequency freq 2.4 f* make-oscil { mod4 }
+ :frequency freq make-oscil { car1 }
+ :frequency freq make-oscil { car2 }
+ :frequency freq 2.4 f* make-oscil { car3 }
+ :envelope amp-env :scaler amp :duration dur make-env { ampf }
+ :envelope index-env :scaler index :duration dur make-env { indf }
+ 0.0 { fmenv }
+ start dur #{ :degree 90.0 random } run-instrument
+ indf env to fmenv
+ car1
+ fmenv fm-ind1 f* mod1 0.0 0.0 oscil f* ( fm )
+ 0.0 ( pm ) oscil
+ car2
+ mod2 0.0 0.0 oscil fm-ind2 f*
+ mod3 0.0 0.0 oscil fm-ind3 f* f+
+ fmenv f* ( fm )
+ 0.0 ( pm ) oscil 0.15 f* f+ ( car1 + car2 )
+ car3
+ mod4 0.0 0.0 oscil fmenv fm-ind4 f* f* ( fm )
+ 0.0 ( pm ) oscil 0.15 f* f+ ( car12 + car3 )
+ ampf env f* ( car123 * ampf )
+ end-run
;instrument
: fm-bell-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440.0 0.5 fm-bell
- dur 0.2 f+ step
+ start now!
+ now@ dur 440.0 0.5 fm-bell
+ dur 0.2 f+ step
;
\ FM-INSECT
\ clm/insect.ins
-instrument: fm-insect <{ start dur
- freq amp amp-env
- mod-freq mod-skew mod-freq-env
- mod-index mod-index-env
- fm-index fm-ratio -- }>
- :frequency freq make-oscil { carrier }
- :frequency mod-freq make-oscil { fm1-osc }
- :frequency fm-ratio freq f* make-oscil { fm2-osc }
- :envelope amp-env :scaler amp :duration dur make-env { ampf }
- :envelope mod-index-env :scaler mod-index hz->radians :duration dur make-env { indf }
- :envelope mod-freq-env :scaler mod-skew hz->radians :duration dur make-env { modfrqf }
- fm-index fm-ratio f* freq f* hz->radians { fm2-amp }
- start dur #{ :degree 90.0 random } run-instrument
- fm1-osc modfrqf env 0.0 oscil indf env f* { garble-in }
- fm2-osc garble-in 0.0 oscil fm2-amp f* { garble-out }
- carrier garble-out garble-in f+ 0.0 oscil ampf env f*
- end-run
+instrument: fm-insect <{ start dur freq
+ amp amp-env
+ mod-freq mod-skew mod-freq-env
+ mod-index mod-index-env
+ fm-index fm-ratio -- }>
+ :frequency freq make-oscil { carrier }
+ :frequency mod-freq make-oscil { fm1-osc }
+ :frequency fm-ratio freq f* make-oscil { fm2-osc }
+ :envelope amp-env :scaler amp :duration dur make-env { ampf }
+ :envelope mod-index-env
+ :scaler mod-index hz->radians
+ :duration dur make-env { indf }
+ :envelope mod-freq-env
+ :scaler mod-skew hz->radians
+ :duration dur make-env { modfrqf }
+ fm-index fm-ratio f* freq f* hz->radians { fm2-amp }
+ 0.0 0.0 { garble-in garble-out }
+ start dur #{ :degree 90.0 random } run-instrument
+ fm1-osc modfrqf env 0.0 oscil indf env f* to garble-in
+ fm2-osc garble-in 0.0 oscil fm2-amp f* to garble-out
+ carrier garble-out garble-in f+ 0.0 oscil ampf env f*
+ end-run
;instrument
: fm-insect-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- #( 0 0 40 1 95 1 100 0.5 ) { locust }
- #( 0 1 25 0.7 75 0.78 100 1 ) { bug-hi }
- #( 0 0 25 1 75 0.7 100 0 ) { amp }
-
- now@ 0.000 f+ 1.699 4142.627 0.015 amp 60 -16.707 locust 500.866 bug-hi 0.346 0.5 fm-insect
- now@ 0.195 f+ 0.233 4126.284 0.030 amp 60 -12.142 locust 649.490 bug-hi 0.407 0.5 fm-insect
- now@ 0.217 f+ 2.057 3930.258 0.045 amp 60 -3.011 locust 562.087 bug-hi 0.591 0.5 fm-insect
- now@ 2.100 f+ 1.500 900.627 0.060 amp 40 -16.707 locust 300.866 bug-hi 0.346 0.5 fm-insect
- now@ 3.000 f+ 1.500 900.627 0.060 amp 40 -16.707 locust 300.866 bug-hi 0.046 0.5 fm-insect
- now@ 3.450 f+ 1.500 900.627 0.090 amp 40 -16.707 locust 300.866 bug-hi 0.006 0.5 fm-insect
- now@ 3.950 f+ 1.500 900.627 0.120 amp 40 -10.707 locust 300.866 bug-hi 0.346 0.5 fm-insect
- now@ 4.300 f+ 1.500 900.627 0.090 amp 40 -20.707 locust 300.866 bug-hi 0.246 0.5 fm-insect
- 6.0 step
+ start now!
+ #( 0 0 40 1 95 1 100 0.5 ) { locust }
+ #( 0 1 25 0.7 75 0.78 100 1 ) { bug-hi }
+ #( 0 0 25 1 75 0.7 100 0 ) { amp }
+
+ now@ 0.000 f+ 1.699 4142.627 0.015 amp 60 -16.707
+ locust 500.866 bug-hi 0.346 0.5 fm-insect
+ now@ 0.195 f+ 0.233 4126.284 0.030 amp 60 -12.142
+ locust 649.490 bug-hi 0.407 0.5 fm-insect
+ now@ 0.217 f+ 2.057 3930.258 0.045 amp 60 -3.011
+ locust 562.087 bug-hi 0.591 0.5 fm-insect
+ now@ 2.100 f+ 1.500 900.627 0.060 amp 40 -16.707
+ locust 300.866 bug-hi 0.346 0.5 fm-insect
+ now@ 3.000 f+ 1.500 900.627 0.060 amp 40 -16.707
+ locust 300.866 bug-hi 0.046 0.5 fm-insect
+ now@ 3.450 f+ 1.500 900.627 0.090 amp 40 -16.707
+ locust 300.866 bug-hi 0.006 0.5 fm-insect
+ now@ 3.950 f+ 1.500 900.627 0.120 amp 40 -10.707
+ locust 300.866 bug-hi 0.346 0.5 fm-insect
+ now@ 4.300 f+ 1.500 900.627 0.090 amp 40 -20.707
+ locust 300.866 bug-hi 0.246 0.5 fm-insect
+ 6.0 step
;
\ FM-DRUM
-\
+\
\ Jan Mattox's fm drum:
-instrument: fm-drum <{ start dur freq amp index
- :optional
- high #f
- degr 0.0
- dist 1.0
- rev-amt 0.01 -- }>
- high if 3.414 8.525 else 1.414 3.515 then { casrat fmrat }
- :envelope #( 0 0 25 0 75 1 100 1 )
- :scaler high if 66.0 hz->radians else 0 then :duration dur make-env { glsf }
- #( 0 0 3 0.05 5 0.2 7 0.8 8 0.95 10 1.0 12 0.95 20 0.3 30 0.1 100 0 ) { ampfun }
- 100 high if 0.01 else 0.015 then f* dur f/ { atdrpt }
- :envelope ampfun 10 atdrpt 15 atdrpt 1 f+ 100 100 dur 0.2 f- dur f/ f* f- fmax stretch-envelope
- :scaler amp :duration dur make-env { ampf }
- #( 0 0 5 0.014 10 0.033 15 0.061 20 0.099
- 25 0.153 30 0.228 35 0.332 40 0.477 45 0.681
- 50 0.964 55 0.681 60 0.478 65 0.332 70 0.228
- 75 0.153 80 0.099 85 0.061 90 0.033 95 0.0141 100 0 ) { indxfun }
- 100 100 dur 0.1 f- dur f/ f* f- { indxpt }
- indxfun 50 atdrpt 65 indxpt stretch-envelope { divindxf }
- :envelope divindxf :duration dur
- :scaler index fmrat freq f* f* hz->radians pi fmin make-env { indxf }
- :envelope divindxf :duration dur
- :scaler index casrat freq f* f* hz->radians pi fmin make-env { mindxf }
- :envelope ampfun 10 atdrpt 90 atdrpt 1 f+ 100 100 dur 0.05 f- dur f/ f* f- fmax stretch-envelope
- :duration dur
- :scaler 7000 hz->radians pi fmin make-env { devf }
- :frequency 7000 :amplitude 1 make-rand { rn }
- :frequency freq make-oscil { car }
- :frequency freq fmrat f* make-oscil { fmosc }
- :frequency freq casrat f* make-oscil { cc }
- 0.0 { gls }
- start dur #{ :degree degr :distance dist :reverb rev-amt } run-instrument
- glsf env to gls
- cc devf env rn 0.0 rand f* gls casrat f* f+ 0.0 oscil
- mindxf env f* gls fmrat f* f+ fmosc swap 0.0 oscil
- indxf env f* gls f+ car swap 0.0 oscil ampf env f*
- end-run
+instrument: fm-drum <{ start dur freq amp index :optional
+ high #f
+ degr 0.0
+ dist 1.0
+ rev-amt 0.01 -- }>
+ high if
+ 3.414 8.525
+ else
+ 1.414 3.515
+ then { casrat fmrat }
+ :envelope #( 0 0 25 0 75 1 100 1 )
+ :scaler high if
+ 66.0 hz->radians
+ else
+ 0
+ then
+ :duration dur make-env { glsf }
+ #( 0 0 3 0.05 5 0.2 7 0.8 8 0.95
+ 10 1.0 12 0.95 20 0.3 30 0.1 100 0 ) { ampfun }
+ high if
+ 0.01
+ else
+ 0.015
+ then 100.0 f* dur f/ { atdrpt }
+ :envelope ampfun
+ 10.0
+ atdrpt
+ 15.0
+ 100.0 dur 0.2 f- dur f/ 100.0 f* f-
+ atdrpt 1.0 f+ fmax stretch-envelope
+ :scaler amp
+ :duration dur make-env { ampf }
+ #( 0 0 5 0.014 10 0.033 15 0.061 20 0.099
+ 25 0.153 30 0.228 35 0.332 40 0.477 45 0.681
+ 50 0.964 55 0.681 60 0.478 65 0.332 70 0.228
+ 75 0.153 80 0.099 85 0.061 90 0.033 95 0.0141 100 0 ) { indxfun }
+ 100.0 dur 0.1 f- dur f/ 100.0 f* f- { indxpt }
+ indxfun 50.0 atdrpt 65.0 indxpt stretch-envelope { divindxf }
+ :envelope divindxf
+ :duration dur
+ :scaler fmrat freq f* index f* hz->radians
+ pi fmin make-env { indxf }
+ :envelope divindxf
+ :duration dur
+ :scaler casrat freq f* index f* hz->radians
+ pi fmin make-env { mindxf }
+ :envelope ampfun
+ 10.0
+ atdrpt
+ 90.0
+ 100.0 dur 0.05 f- dur f/ 100.0 f* f-
+ atdrpt 1.0 f+ fmax stretch-envelope
+ :duration dur
+ :scaler 7000.0 hz->radians pi fmin make-env { devf }
+ :frequency 7000.0 :amplitude 1 make-rand { rn }
+ :frequency freq make-oscil { car }
+ :frequency freq fmrat f* make-oscil { fmosc }
+ :frequency freq casrat f* make-oscil { cc }
+ 0.0 { gls }
+ start dur
+ #{ :degree degr :distance dist :reverb rev-amt } run-instrument
+ glsf env to gls
+ cc ( gen )
+ devf env
+ rn 0.0 rand f*
+ gls casrat f* f+ ( fm ) 0.0 ( pm ) oscil
+ mindxf env f* gls fmrat f* f+ ( fm )
+ fmosc ( gen ) swap 0.0 ( pm ) oscil
+ indxf env f* gls f+ ( fm )
+ car ( gen ) swap 0.0 ( pm ) oscil
+ ampf env f*
+ end-run
;instrument
: fm-drum-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 55 0.3 5 fm-drum
- dur 0.2 f+ step
- now@ dur 66 0.3 4 #t fm-drum
- dur 0.2 f+ step
+ start now!
+ now@ dur 55 0.3 5 fm-drum
+ dur 0.2 f+ step
+ now@ dur 66 0.3 4 #t fm-drum
+ dur 0.2 f+ step
;
\ FM-GONG
-\
+\
\ Paul Weineke's gong.
-instrument: gong <{ start dur freq amp
- :key
- degree 0.0
- distance 1.0
- reverb-amount 0.005 -- }>
- 0.01 1.160 freq f* f* hz->radians { indx01 }
- 0.30 1.160 freq f* f* hz->radians { indx11 }
- 0.01 3.140 freq f* f* hz->radians { indx02 }
- 0.38 3.140 freq f* f* hz->radians { indx12 }
- 0.01 1.005 freq f* f* hz->radians { indx03 }
- 0.50 1.005 freq f* f* hz->radians { indx13 }
- 5 { atpt }
- 100 0.002 dur f/ f* { atdur }
- #( 0 0 3 1 15 0.5 27 0.25 50 0.1 100 0 ) { expf }
- #( 0 0 15 0.3 30 1.0 75 0.5 100 0 ) { rise }
- #( 0 0 75 1.0 98 1.0 100 0 ) { fmup }
- #( 0 0 2 1.0 100 0 ) { fmdwn }
- :envelope expf atpt atdur 0 0 stretch-envelope :scaler amp :duration dur make-env { ampfun }
- :envelope fmup :scaler indx11 indx01 f- :duration dur :offset indx01 make-env { indxfun1 }
- :envelope fmdwn :scaler indx12 indx02 f- :duration dur :offset indx02 make-env { indxfun2 }
- :envelope rise :scaler indx13 indx03 f- :duration dur :offset indx03 make-env { indxfun3 }
- :frequency freq make-oscil { car }
- :frequency freq 1.160 f* make-oscil { mod1 }
- :frequency freq 3.140 f* make-oscil { mod2 }
- :frequency freq 1.005 f* make-oscil { mod3 }
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- car
- mod3 0.0 0.0 oscil indxfun3 env f*
- mod2 0.0 0.0 oscil indxfun2 env f* f+
- mod1 0.0 0.0 oscil indxfun1 env f* f+
- 0.0 oscil ampfun env f*
- end-run
+instrument: gong <{ start dur freq amp :key
+ degree 0.0
+ distance 1.0
+ reverb-amount 0.005 -- }>
+ 0.01 1.160 freq f* f* hz->radians { indx01 }
+ 0.30 1.160 freq f* f* hz->radians { indx11 }
+ 0.01 3.140 freq f* f* hz->radians { indx02 }
+ 0.38 3.140 freq f* f* hz->radians { indx12 }
+ 0.01 1.005 freq f* f* hz->radians { indx03 }
+ 0.50 1.005 freq f* f* hz->radians { indx13 }
+ 5 { atpt }
+ 100 0.002 dur f/ f* { atdur }
+ #( 0 0 3 1 15 0.5 27 0.25 50 0.1 100 0 ) { expf }
+ #( 0 0 15 0.3 30 1.0 75 0.5 100 0 ) { rise }
+ #( 0 0 75 1.0 98 1.0 100 0 ) { fmup }
+ #( 0 0 2 1.0 100 0 ) { fmdwn }
+ :envelope expf atpt atdur 0 0 stretch-envelope
+ :scaler amp
+ :duration dur make-env { ampfun }
+ :envelope fmup
+ :scaler indx11 indx01 f-
+ :duration dur :offset indx01 make-env { indxfun1 }
+ :envelope fmdwn
+ :scaler indx12 indx02 f-
+ :duration dur
+ :offset indx02 make-env { indxfun2 }
+ :envelope rise
+ :scaler indx13 indx03 f-
+ :duration dur
+ :offset indx03 make-env { indxfun3 }
+ :frequency freq make-oscil { car }
+ :frequency freq 1.160 f* make-oscil { mod1 }
+ :frequency freq 3.140 f* make-oscil { mod2 }
+ :frequency freq 1.005 f* make-oscil { mod3 }
+ start dur
+ #{ :degree degree :distance distance :reverb reverb-amount }
+ run-instrument
+ car
+ mod3 0.0 0.0 oscil indxfun3 env f*
+ mod2 0.0 0.0 oscil indxfun2 env f* f+
+ mod1 0.0 0.0 oscil indxfun1 env f* f+
+ 0.0 oscil ampfun env f*
+ end-run
;instrument
: gong-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 261.61 0.6 gong
- dur 0.2 f+ step
+ start now!
+ now@ dur 261.61 0.6 gong
+ dur 0.2 f+ step
;
\ ATTRACT
-\
+\
\ by James McCartney, from CMJ vol 21 no 3 p 6
instrument: attract <{ start dur amp c -- }>
- 0.2 0.2 { a b }
- 0.04 { dt }
- amp f2/ c f/ { scale }
- -1.0 { x }
- 0.0 0.0 0.0 { x1 y z }
- start dur #{ :degree 90.0 random } run-instrument
- x y z f+ dt f* f- to x1
- a y f* x f+ dt f* y f+ to y
- x z f* b f+ c z f* f- dt f* z f+ to z
- x1 to x
- scale x f*
- end-run
+ 0.2 0.2 { a b }
+ 0.04 { dt }
+ amp f2/ c f/ { scale }
+ -1.0 { x }
+ 0.0 0.0 0.0 { x1 y z }
+ start dur #{ :degree 90.0 random } run-instrument
+ x y z f+ dt f* f- to x1
+ a y f* x f+ dt f* y f+ to y
+ x z f* b f+ c z f* f- dt f* z f+ to z
+ x1 to x
+ scale x f*
+ end-run
;instrument
: attract-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 0.5 2.0 attract
- dur 0.2 f+ step
+ start now!
+ now@ dur 0.5 2.0 attract
+ dur 0.2 f+ step
;
\ PQW
-\
+\
\ phase-quadrature waveshaping used to create asymmetric (i.e. single
\ side-band) spectra. The basic idea here is a variant of sin x sin y
\ - cos x cos y = cos (x + y)
\
\ clm/pqw.ins
-instrument: pqw <{ start dur sfreq cfreq amp ampfun indexfun parts
- :key
- degree 0.0
- distance 1.0
- reverb-amount 0.005 -- }>
- parts normalize-partials { nparts }
- :frequency sfreq :initial-phase half-pi make-oscil { sp-cos }
- :frequency sfreq make-oscil { sp-sin }
- :frequency cfreq :initial-phase half-pi make-oscil { c-cos }
- :frequency cfreq make-oscil { c-sin }
- nparts mus-chebyshev-second-kind partials->polynomial { sin-coeffs }
- nparts mus-chebyshev-first-kind partials->polynomial { cos-coeffs }
- :envelope ampfun :scaler amp :duration dur make-env { amp-env }
- :envelope indexfun :duration dur make-env { ind-env }
- 0.0 0.0 0.0 0.0 { vib ax fax yfax }
- cfreq sfreq f/ { r }
- :frequency 5.0 :amplitude 0.005 sfreq f* hz->radians make-triangle-wave { tr }
- :frequency 12.0 :amplitude 0.005 sfreq f* hz->radians make-rand-interp { rn }
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- tr 0.0 triangle-wave rn 0.0 rand-interp f+ to vib
- 1.0 ind-env env fmin sp-cos vib 0.0 oscil f* to ax
- cos-coeffs ax polynomial to fax
- sp-sin vib 0.0 oscil sin-coeffs ax polynomial f* to yfax
- c-sin vib r f* 0.0 oscil yfax f*
- c-cos vib r f* 0.0 oscil fax f* f- amp-env env f*
- end-run
+instrument: pqw <{ start dur sfreq cfreq amp ampfun indexfun parts :key
+ degree 0.0
+ distance 1.0
+ reverb-amount 0.005 -- }>
+ parts normalize-partials { nparts }
+ :frequency sfreq :initial-phase half-pi make-oscil { sp-cos }
+ :frequency sfreq make-oscil { sp-sin }
+ :frequency cfreq :initial-phase half-pi make-oscil { c-cos }
+ :frequency cfreq make-oscil { c-sin }
+ nparts mus-chebyshev-second-kind partials->polynomial { sin-coeffs }
+ nparts mus-chebyshev-first-kind partials->polynomial { cos-coeffs }
+ :envelope ampfun :scaler amp :duration dur make-env { amp-env }
+ :envelope indexfun :duration dur make-env { ind-env }
+ 0.0 0.0 0.0 0.0 { vib ax fax yfax }
+ cfreq sfreq f/ { r }
+ :frequency 5.0
+ :amplitude 0.005 sfreq f* hz->radians make-triangle-wave { tr }
+ :frequency 12.0
+ :amplitude 0.005 sfreq f* hz->radians make-rand-interp { rn }
+ start dur
+ #{ :degree degree :distance distance :reverb reverb-amount }
+ run-instrument
+ tr 0.0 triangle-wave rn 0.0 rand-interp f+ to vib
+ 1.0 ind-env env fmin sp-cos vib 0.0 oscil f* to ax
+ cos-coeffs ax polynomial to fax
+ sp-sin vib 0.0 oscil sin-coeffs ax polynomial f* to yfax
+ c-sin vib r f* 0.0 oscil yfax f*
+ c-cos vib r f* 0.0 oscil fax f* f- amp-env env f*
+ end-run
;instrument
: pqw-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 200 1000 0.2 #( 0 0 25 1 100 0 ) #( 0 1 100 0 ) #( 2 0.1 3 0.3 6 0.5 ) pqw
- dur 0.2 f+ step
+ start now!
+ now@ dur 200 1000 0.2
+ #( 0 0 25 1 100 0 ) #( 0 1 100 0 ) #( 2 0.1 3 0.3 6 0.5 ) pqw
+ dur 0.2 f+ step
;
\ taken from Perry Cook's stkv1.tar.Z (Synthesis Toolkit), but I was
\ in a bit of a hurry and may not have made slavishly accurate
\ translations. Please let me (bil at ccrma.stanford.edu) know of any
\ serious (non-envelope) errors.
-\
+\
\ from Perry Cook's TubeBell.cpp
instrument: tubebell <{ start dur freq amp :optional base 32.0 -- }>
- :frequency freq 0.995 f* make-oscil { osc0 }
- :frequency freq 0.995 1.414 f* f* make-oscil { osc1 }
- :frequency freq 1.005 f* make-oscil { osc2 }
- :frequency freq 1.414 f* make-oscil { osc3 }
- :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 ) :base base :duration dur make-env { ampenv1 }
- :envelope #( 0 0 0.001 1 dur 0.002 fmax 0 ) :base base f2* :duration dur make-env { ampenv2 }
- :frequency 2.0 make-oscil { ampmod }
- amp f2/ { g0 }
- g0 0.707 f* { g1 }
- start dur #{ :degree 90.0 random } run-instrument
- ampmod 0.0 0.0 oscil 0.007 f* 0.993 f+
- osc0 osc1 0.0 0.0 oscil 0.203 f* 0.0 oscil ampenv1 env g1 f* f*
- osc2 osc3 0.0 0.0 oscil 0.144 f* 0.0 oscil ampenv2 env g0 f* f* f+ f*
- end-run
+ :frequency freq 0.995 f* make-oscil { osc0 }
+ :frequency freq 0.995 1.414 f* f* make-oscil { osc1 }
+ :frequency freq 1.005 f* make-oscil { osc2 }
+ :frequency freq 1.414 f* make-oscil { osc3 }
+ :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 )
+ :base base
+ :duration dur make-env { ampenv1 }
+ :envelope #( 0 0 0.001 1 dur 0.002 fmax 0 )
+ :base base f2*
+ :duration dur make-env { ampenv2 }
+ :frequency 2.0 make-oscil { ampmod }
+ amp f2/ { g0 }
+ g0 0.707 f* { g1 }
+ start dur #{ :degree 90.0 random } run-instrument
+ ampmod 0.0 0.0 oscil 0.007 f* 0.993 f+ ( amp )
+ osc0
+ osc1 0.0 0.0 oscil 0.203 f*
+ 0.0 oscil ampenv1 env f* g1 f*
+ osc2
+ osc3 0.0 0.0 oscil 0.144 f*
+ 0.0 oscil ampenv2 env f* g0 f*
+ f+ ( osc0 + osc2 )
+ f* ( amp * osc0+2 )
+ end-run
;instrument
: tubebell-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.2 32 tubebell
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.2 32 tubebell
+ dur 0.2 f+ step
;
\ from Perry Cook's Wurley.cpp
instrument: wurley <{ start dur freq amp -- }>
- :frequency freq make-oscil { osc0 }
- :frequency freq 4 f* make-oscil { osc1 }
- :frequency 510 make-oscil { osc2 }
- :frequency 510 make-oscil { osc3 }
- :frequency 8 make-oscil { ampmod }
- :envelope #( 0 0 1 1 9 1 10 0 ) :duration dur make-env { ampenv }
- :envelope #( 0 0 0.001 1 0.15 0 dur 0.16 fmax 0 ) :duration dur make-env { indenv }
- :envelope #( 0 0 0.001 1 0.25 0 dur 0.26 fmax 0 ) :duration dur make-env { resenv }
- amp f2/ { g0 }
- g0 0.307 f* { g1 }
- start dur #{ :degree 90.0 random } run-instrument
- ampenv env
- ampmod 0.0 0.0 oscil 0.007 f* 1.0 f+ f*
- osc0 osc1 0.0 0.0 oscil 0.307 f* 0.0 oscil g0 f*
- osc2 osc3 0.0 0.0 oscil indenv env f* 0.117 f* 0.0 oscil g1 f* resenv env f* f+ f*
- end-run
+ :frequency freq make-oscil { osc0 }
+ :frequency freq 4 f* make-oscil { osc1 }
+ :frequency 510 make-oscil { osc2 }
+ :frequency 510 make-oscil { osc3 }
+ :frequency 8 make-oscil { ampmod }
+ :envelope #( 0 0 1 1 9 1 10 0 ) :duration dur make-env { ampenv }
+ :envelope #( 0 0 0.001 1 0.15 0 dur 0.16 fmax 0 )
+ :duration dur make-env { indenv }
+ :envelope #( 0 0 0.001 1 0.25 0 dur 0.26 fmax 0 )
+ :duration dur make-env { resenv }
+ amp f2/ { g0 }
+ g0 0.307 f* { g1 }
+ start dur #{ :degree 90.0 random } run-instrument
+ ampenv env ( amp )
+ ampmod 0.0 0.0 oscil 0.007 f* 1.0 f+ f* ( ampmod * amp )
+ osc0
+ osc1 0.0 0.0 oscil 0.307 f*
+ 0.0 oscil g0 f*
+ osc2
+ osc3 0.0 0.0 oscil indenv env f* 0.117 f*
+ 0.0 oscil g1 f*
+ resenv env f*
+ f+ ( osc0 + osc2 )
+ f* ( amp * osc0+2 )
+ end-run
;instrument
: wurley-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.2 wurley
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.2 wurley
+ dur 0.2 f+ step
;
\ from Perry Cook's Rhodey.cpp
instrument: rhodey <{ start dur freq amp :optional base 0.5 -- }>
- :frequency freq make-oscil { osc0 }
- :frequency freq make-oscil { osc1 }
- :frequency freq make-oscil { osc2 }
- :frequency freq make-oscil { osc3 }
- :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 ) :base base :duration dur make-env { ampenv1 }
- :envelope #( 0 0 0.001 1 dur 0.002 fmax 0 ) :base base 1.5 f* :duration dur make-env { ampenv2 }
- :envelope #( 0 0 0.001 1 0.25 0 ) :base base 4 f* :duration dur make-env { ampenv3 }
- amp f2/ { g0 }
- start dur #{ :degree 90.0 random } run-instrument
- osc0 osc1 0.0 0.0 oscil 0.535 f* 0.0 oscil ampenv1 env f* g0 f*
- osc2 osc3 0.0 0.0 oscil 0.109 f* ampenv3 env f* 0.0 oscil ampenv2 env f* g0 f* f+
- end-run
+ :frequency freq make-oscil { osc0 }
+ :frequency freq make-oscil { osc1 }
+ :frequency freq make-oscil { osc2 }
+ :frequency freq make-oscil { osc3 }
+ :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 )
+ :base base :duration dur make-env { ampenv1 }
+ :envelope #( 0 0 0.001 1 dur 0.002 fmax 0 )
+ :base base 1.5 f* :duration dur make-env { ampenv2 }
+ :envelope #( 0 0 0.001 1 0.25 0 )
+ :base base 4 f*
+ :duration dur make-env { ampenv3 }
+ amp f2/ { g0 }
+ start dur #{ :degree 90.0 random } run-instrument
+ osc0
+ osc1 0.0 0.0 oscil 0.535 f*
+ 0.0 oscil ampenv1 env f* g0 f*
+ osc2
+ osc3 0.0 0.0 oscil 0.109 f* ampenv3 env f*
+ 0.0 oscil ampenv2 env f* g0 f*
+ f+ ( osc0 + osc2 )
+ end-run
;instrument
: rhodey-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.2 0.5 rhodey
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.2 0.5 rhodey
+ dur 0.2 f+ step
;
\ from Perry Cook's BeeThree.cpp
instrument: hammondoid <{ start dur freq amp -- }>
- :frequency freq 0.999 f* make-oscil { osc0 }
- :frequency freq 1.997 f* make-oscil { osc1 }
- :frequency freq 3.006 f* make-oscil { osc2 }
- :frequency freq 6.009 f* make-oscil { osc3 }
- :envelope #( 0 0 0.005 1 dur 0.006 fmax 0.008 f- 1 dur 0 ) :duration dur make-env { ampenv1 }
- :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 ) :duration dur make-env { ampenv2 }
- amp f2/ { g0 }
- start dur #{ :degree 90.0 random } run-instrument
- osc0 0.0 0.0 oscil 0.1875 amp f* f*
- osc1 0.0 0.0 oscil 0.1875 amp f* f* f+
- osc2 0.0 0.0 oscil g0 f* f+ ampenv1 env f*
- osc3 0.0 0.0 oscil 0.375 amp f* f* ampenv2 env f* f+
- end-run
+ :frequency freq 0.999 f* make-oscil { osc0 }
+ :frequency freq 1.997 f* make-oscil { osc1 }
+ :frequency freq 3.006 f* make-oscil { osc2 }
+ :frequency freq 6.009 f* make-oscil { osc3 }
+ :envelope #( 0 0 0.005 1 dur 0.006 fmax 0.008 f- 1 dur 0 )
+ :duration dur make-env { ampenv1 }
+ :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 )
+ :duration dur make-env { ampenv2 }
+ amp f2/ { g0 }
+ 0.1875 amp f* { amp0.1875 }
+ 0.375 amp f* { amp0.375 }
+ start dur #{ :degree 90.0 random } run-instrument
+ osc0 0.0 0.0 oscil amp0.1875 f*
+ osc1 0.0 0.0 oscil amp0.1875 f*
+ f+ ( osc0 + osc1 )
+ osc2 0.0 0.0 oscil g0 f*
+ f+ ( osc0+1 + osc2 )
+ ampenv1 env f* ( osc0+1+2 * amp1 )
+ osc3 0.0 0.0 oscil amp0.375 f*
+ ampenv2 env f* ( osc3 * amp2 )
+ f+ ( osc0+1+2*amp1 + osc3*amp2 )
+ end-run
;instrument
: hammondoid-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.2 hammondoid
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.2 hammondoid
+ dur 0.2 f+ step
;
\ from Perry Cook's HeavyMtl.cpp
instrument: metal <{ start dur freq amp -- }>
- :frequency freq make-oscil { osc0 }
- :frequency freq 4 f* 0.999 f* make-oscil { osc1 }
- :frequency freq 3 f* 1.001 f* make-oscil { osc2 }
- :frequency freq 0.5 f* 1.002 f* make-oscil { osc3 }
- :envelope #( 0 0 0.001 1 dur 0.002 fmax 0.002 f- 1 dur 0 ) :duration dur make-env { ampenv0 }
- :envelope #( 0 0 0.001 1 dur 0.002 fmax 0.011 f- 1 dur 0 ) :duration dur make-env { ampenv1 }
- :envelope #( 0 0 0.010 1 dur 0.020 fmax 0.015 f- 1 dur 0 ) :duration dur make-env { ampenv2 }
- :envelope #( 0 0 0.030 1 dur 0.040 fmax 0.040 f- 1 dur 0 ) :duration dur make-env { ampenv3 }
- start dur #{ :degree 90.0 random } run-instrument
- osc0
- osc1 osc2 0.0 0.0 oscil ampenv2 env f* 0.574 f* 0.0 oscil ampenv1 env f* 0.202 f*
- osc3 0.0 0.0 oscil ampenv3 env f* 0.116 f* f+ ( osc0 ) 0.0 oscil ampenv0 env f* 0.615 amp f* f*
- end-run
+ :frequency freq make-oscil { osc0 }
+ :frequency freq 4 f* 0.999 f* make-oscil { osc1 }
+ :frequency freq 3 f* 1.001 f* make-oscil { osc2 }
+ :frequency freq 0.5 f* 1.002 f* make-oscil { osc3 }
+ :envelope #( 0 0 0.001 1 dur 0.002 fmax 0.002 f- 1 dur 0 )
+ :duration dur make-env { ampenv0 }
+ :envelope #( 0 0 0.001 1 dur 0.002 fmax 0.011 f- 1 dur 0 )
+ :duration dur make-env { ampenv1 }
+ :envelope #( 0 0 0.010 1 dur 0.020 fmax 0.015 f- 1 dur 0 )
+ :duration dur make-env { ampenv2 }
+ :envelope #( 0 0 0.030 1 dur 0.040 fmax 0.040 f- 1 dur 0 )
+ :duration dur make-env { ampenv3 }
+ 0.615 amp f* { amp0.615 }
+ start dur #{ :degree 90.0 random } run-instrument
+ osc0
+ osc1
+ osc2 0.0 0.0 oscil ampenv2 env f* 0.574 f* ( fm1 )
+ 0.0 ( pm1 ) oscil ampenv1 env f* 0.202 f* ( osc1 )
+ osc3 0.0 0.0 oscil ampenv3 env f* 0.116 f* ( osc3 )
+ f+ ( fm0 = osc1 + osc3 )
+ 0.0 ( pm0 ) oscil ampenv0 env f* amp0.615 f* ( osc0 )
+ end-run
;instrument
: metal-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.2 metal
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.2 metal
+ dur 0.2 f+ step
;
\ DRONE
-instrument: drone <{ start dur freq amp ampfun synth ampat ampdc rvibamt rvibfreq -- }>
- :frequency freq :wave synth #f #f partials->wave make-table-lookup { s }
- :envelope ampfun 25.0 100.0 ampat dur f/ f* 75.0 100.0 100.0 ampdc dur f/ f* f- stretch-envelope
- :scaler amp 0.25 f*
- :duration dur make-env { ampenv }
- :frequency rvibfreq :amplitude rvibamt freq f* hz->radians make-rand { ranvib }
- start dur #{ :degree 90.0 random } run-instrument
- s ranvib 0.0 rand fabs table-lookup ampenv env f*
- end-run
+instrument: drone
+ <{ start dur freq amp ampfun synth ampat ampdc rvibamt rvibfreq -- }>
+ :frequency freq :wave synth #f #f partials->wave make-table-lookup { s }
+ :envelope ampfun
+ 25.0
+ ampat dur f/ 100.0 f*
+ 75.0
+ 100.0 ampdc dur f/ 100.0 f* f- stretch-envelope
+ :scaler amp 0.25 f* :duration dur make-env { ampenv }
+ :frequency rvibfreq
+ :amplitude rvibamt freq f* hz->radians make-rand { ranvib }
+ start dur #{ :degree 90.0 random } run-instrument
+ s ranvib 0.0 rand fabs table-lookup ampenv env f*
+ end-run
;instrument
\ CANTER
instrument: canter <{ start dur pitch amp
- ampfun ranfun skewfun skewpc ranpc ranfreq indexfun atdr dcdr
- ampfun1 indfun1 fmtfun1
- ampfun2 indfun2 fmtfun2
- ampfun3 indfun3 fmtfun3
- ampfun4 indfun4 fmtfun4 -- }>
- pitch 400.0 f/ flog 910.0 400.0 f/ flog f/ 100.0 f* floor { k }
- 100.0 atdr dur f/ f* { atpt }
- 100.0 100.0 dcdr dur f/ f* f- { dcpt }
- k fmtfun1 1.0 envelope-interp { lfmt1 }
- 0.5 lfmt1 pitch f/ f+ floor { harm1 }
- k indfun1 1.0 envelope-interp pitch f* hz->radians { dev11 }
- dev11 f2/ { dev01 }
- k ampfun1 1.0 envelope-interp amp f* 1.0 harm1 lfmt1 pitch f/ f- fabs f- f* { lamp1 }
- k fmtfun2 1.0 envelope-interp { lfmt2 }
- 0.5 lfmt2 pitch f/ f+ floor { harm2 }
- k indfun2 1.0 envelope-interp pitch f* hz->radians { dev12 }
- dev12 f2/ { dev02 }
- k ampfun2 1.0 envelope-interp amp f* 1.0 harm2 lfmt2 pitch f/ f- fabs f- f* { lamp2 }
- k fmtfun3 1.0 envelope-interp { lfmt3 }
- 0.5 lfmt3 pitch f/ f+ floor { harm3 }
- k indfun3 1.0 envelope-interp pitch f* hz->radians { dev13 }
- dev13 f2/ { dev03 }
- k ampfun3 1.0 envelope-interp amp f* 1.0 harm3 lfmt3 pitch f/ f- fabs f- f* { lamp3 }
- k fmtfun4 1.0 envelope-interp { lfmt4 }
- 0.5 lfmt4 pitch f/ f+ floor { harm4 }
- k indfun4 1.0 envelope-interp pitch f* hz->radians { dev14 }
- dev14 f2/ { dev04 }
- k ampfun4 1.0 envelope-interp amp f* 1.0 harm4 lfmt4 pitch f/ f- fabs f- f* { lamp4 }
- :envelope ampfun 25.0 atpt 75.0 dcpt stretch-envelope
- :duration dur make-env { tampfun }
- :envelope skewfun 25.0 atpt 75.0 dcpt stretch-envelope
- :duration dur
- :scaler pitch skewpc f* hz->radians make-env { tskwfun }
- :envelope ranfun 25.0 atpt 75.0 dcpt stretch-envelope
- :duration dur make-env { tranfun }
- :envelope indexfun 25.0 atpt 75.0 dcpt stretch-envelope
- :duration dur make-env { tidxfun }
- :frequency pitch make-oscil { modgen }
- :frequency pitch harm1 f* make-oscil { gen1 }
- :frequency pitch harm2 f* make-oscil { gen2 }
- :frequency pitch harm3 f* make-oscil { gen3 }
- :frequency pitch harm4 f* make-oscil { gen4 }
- :frequency ranfreq :amplitude ranpc pitch f* hz->radians make-rand { ranvib }
- 0.0 0.0 0.0 0.0 { frqval modval ampval indval }
- start dur #{ :degree 90.0 random } run-instrument
- tskwfun env tranfun env ranvib 0.0 rand f* f+ to frqval
- modgen frqval 0.0 oscil to modval
- tampfun env to ampval
- tidxfun env to indval
- gen1 indval dev11 f* dev01 f+ modval f* frqval f+ harm1 f* 0.0 oscil lamp1 ampval f* f*
- gen2 indval dev12 f* dev02 f+ modval f* frqval f+ harm2 f* 0.0 oscil lamp2 ampval f* f* f+
- gen3 indval dev13 f* dev03 f+ modval f* frqval f+ harm3 f* 0.0 oscil lamp3 ampval f* f* f+
- gen4 indval dev14 f* dev04 f+ modval f* frqval f+ harm4 f* 0.0 oscil lamp4 ampval f* f* f+
- end-run
+ ampfun ranfun skewfun skewpc ranpc ranfreq indexfun atdr dcdr
+ ampfun1 indfun1 fmtfun1
+ ampfun2 indfun2 fmtfun2
+ ampfun3 indfun3 fmtfun3
+ ampfun4 indfun4 fmtfun4 -- }>
+ pitch 400.0 f/ flog 910.0 400.0 f/ flog f/ 100.0 f* floor { k }
+ 100.0 atdr dur f/ f* { atpt }
+ 100.0 100.0 dcdr dur f/ f* f- { dcpt }
+ k fmtfun1 1.0 envelope-interp { lfmt1 }
+ 0.5 lfmt1 pitch f/ f+ floor { harm1 }
+ k indfun1 1.0 envelope-interp pitch f* hz->radians { dev11 }
+ dev11 f2/ { dev01 }
+ k ampfun1 1.0 envelope-interp amp f* 1.0 harm1 lfmt1
+ pitch f/ f- fabs f- f* { lamp1 }
+ k fmtfun2 1.0 envelope-interp { lfmt2 }
+ 0.5 lfmt2 pitch f/ f+ floor { harm2 }
+ k indfun2 1.0 envelope-interp pitch f* hz->radians { dev12 }
+ dev12 f2/ { dev02 }
+ k ampfun2 1.0 envelope-interp amp f* 1.0 harm2 lfmt2
+ pitch f/ f- fabs f- f* { lamp2 }
+ k fmtfun3 1.0 envelope-interp { lfmt3 }
+ 0.5 lfmt3 pitch f/ f+ floor { harm3 }
+ k indfun3 1.0 envelope-interp pitch f* hz->radians { dev13 }
+ dev13 f2/ { dev03 }
+ k ampfun3 1.0 envelope-interp amp f* 1.0 harm3 lfmt3
+ pitch f/ f- fabs f- f* { lamp3 }
+ k fmtfun4 1.0 envelope-interp { lfmt4 }
+ 0.5 lfmt4 pitch f/ f+ floor { harm4 }
+ k indfun4 1.0 envelope-interp pitch f* hz->radians { dev14 }
+ dev14 f2/ { dev04 }
+ k ampfun4 1.0 envelope-interp amp f* 1.0 harm4 lfmt4
+ pitch f/ f- fabs f- f* { lamp4 }
+ :envelope ampfun 25.0 atpt 75.0 dcpt stretch-envelope
+ :duration dur make-env { tampfun }
+ :envelope skewfun 25.0 atpt 75.0 dcpt stretch-envelope
+ :duration dur
+ :scaler pitch skewpc f* hz->radians make-env { tskwfun }
+ :envelope ranfun 25.0 atpt 75.0 dcpt stretch-envelope
+ :duration dur make-env { tranfun }
+ :envelope indexfun 25.0 atpt 75.0 dcpt stretch-envelope
+ :duration dur make-env { tidxfun }
+ :frequency pitch make-oscil { modgen }
+ :frequency pitch harm1 f* make-oscil { gen1 }
+ :frequency pitch harm2 f* make-oscil { gen2 }
+ :frequency pitch harm3 f* make-oscil { gen3 }
+ :frequency pitch harm4 f* make-oscil { gen4 }
+ :frequency ranfreq
+ :amplitude ranpc pitch f* hz->radians make-rand { ranvib }
+ 0.0 0.0 0.0 0.0 { frqval modval ampval indval }
+ start dur #{ :degree 90.0 random } run-instrument
+ tskwfun env tranfun env ranvib 0.0 rand f* f+ to frqval
+ modgen frqval 0.0 oscil to modval
+ tampfun env to ampval
+ tidxfun env to indval
+ gen1
+ indval dev11 f* dev01 f+ modval f* frqval f+ harm1 f*
+ 0.0 oscil lamp1 ampval f* f*
+ gen2
+ indval dev12 f* dev02 f+ modval f* frqval f+ harm2 f*
+ 0.0 oscil lamp2 ampval f* f*
+ f+ ( gen1 + gen2 )
+ gen3
+ indval dev13 f* dev03 f+ modval f* frqval f+ harm3 f*
+ 0.0 oscil lamp3 ampval f* f*
+ f+ ( gen1+2 + gen3 )
+ gen4
+ indval dev14 f* dev04 f+ modval f* frqval f+ harm4 f*
+ 0.0 oscil lamp4 ampval f* f*
+ f+ ( gen1+2+3 + gen4 )
+ end-run
;instrument
: drone/canter-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- #( 0 1200 100 1000 ) { fmt1 }
- #( 0 2250 100 1800 ) { fmt2 }
- #( 0 4500 100 4500 ) { fmt3 }
- #( 0 6750 100 8100 ) { fmt4 }
- #( 0 0.67 100 0.70 ) { amp1 }
- #( 0 0.95 100 0.95 ) { amp2 }
- #( 0 0.28 100 0.33 ) { amp3 }
- #( 0 0.14 100 0.15 ) { amp4 }
- #( 0 0.75 100 0.65 ) { ind1 }
- #( 0 0.75 100 0.75 ) { ind2 }
- #( 0 1 100 1 ) { ind3 }
- #( 0 1 100 1 ) { ind4 }
- #( 0 0 100 0 ) { skwf }
- #( 0 0 25 1 75 1 100 0 ) { ampf }
- #( 0 0.5 100 0.5 ) { ranf }
- #( 0 1 100 1 ) { index }
- #( 0 0 5 1 95 1 100 0 ) { solid }
- #( 0.5 0.06 1 0.62 1.5 0.07 2 0.6 2.5 0.08 3 0.56 4 0.24 5 0.98 6 0.53
- 7 0.16 8 0.33 9 0.62 10 0.12 12 0.14 14 0.86 16 0.12 23 0.14 24 0.17 ) { bassdr2 }
- #( 0.3 0.04 1 0.81 2 0.27 3 0.2 4 0.21 5 0.18 6 0.35 7 0.03
- 8 0.07 9 0.02 10 0.025 11 0.035 ) { tenordr }
-
- now@ 4 115.0 0.125 solid bassdr2 0.1 0.5 0.01 10 drone
- now@ 4 229.0 0.125 solid tenordr 0.1 0.5 0.01 11 drone
- now@ 4 229.5 0.125 solid tenordr 0.1 0.5 0.01 09 drone
- now@ 2.100 918.000 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 2.100 f+ 0.300 688.500 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 2.400 f+ 0.040 826.200 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 2.440 f+ 0.560 459.000 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.000 f+ 0.040 408.000 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.040 f+ 0.040 619.650 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.080 f+ 0.040 408.000 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.120 f+ 0.040 688.500 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.160 f+ 0.290 459.000 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.450 f+ 0.150 516.375 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.600 f+ 0.040 826.200 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.640 f+ 0.040 573.750 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.680 f+ 0.040 619.650 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.720 f+ 0.180 573.750 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.900 f+ 0.040 688.500 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- now@ 3.940 f+ 0.260 459.000 0.175 ampf ranf skwf 0.050 0.01 10 index 0.005 0.005
- amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
- 4.4 step
+ start now!
+ #( 0 1200 100 1000 ) { fmt1 }
+ #( 0 2250 100 1800 ) { fmt2 }
+ #( 0 4500 100 4500 ) { fmt3 }
+ #( 0 6750 100 8100 ) { fmt4 }
+ #( 0 0.67 100 0.70 ) { amp1 }
+ #( 0 0.95 100 0.95 ) { amp2 }
+ #( 0 0.28 100 0.33 ) { amp3 }
+ #( 0 0.14 100 0.15 ) { amp4 }
+ #( 0 0.75 100 0.65 ) { ind1 }
+ #( 0 0.75 100 0.75 ) { ind2 }
+ #( 0 1 100 1 ) { ind3 }
+ #( 0 1 100 1 ) { ind4 }
+ #( 0 0 100 0 ) { skwf }
+ #( 0 0 25 1 75 1 100 0 ) { ampf }
+ #( 0 0.5 100 0.5 ) { ranf }
+ #( 0 1 100 1 ) { index }
+ #( 0 0 5 1 95 1 100 0 ) { solid }
+ #( 0.5 0.06 1 0.62 1.5 0.07 2 0.6 2.5 0.08 3 0.56 4 0.24 5 0.98 6 0.53
+ 7 0.16 8 0.33 9 0.62 10 0.12 12
+ 0.14 14 0.86 16 0.12 23 0.14 24 0.17 ) { bassdr2 }
+ #( 0.3 0.04 1 0.81 2 0.27 3 0.2 4 0.21 5 0.18 6 0.35 7 0.03
+ 8 0.07 9 0.02 10 0.025 11 0.035 ) { tenordr }
+
+ now@ 4 115.0 0.125 solid bassdr2 0.1 0.5 0.01 10 drone
+ now@ 4 229.0 0.125 solid tenordr 0.1 0.5 0.01 11 drone
+ now@ 4 229.5 0.125 solid tenordr 0.1 0.5 0.01 09 drone
+ now@ 2.100 918.000 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 2.100 f+ 0.300 688.500 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 2.400 f+ 0.040 826.200 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 2.440 f+ 0.560 459.000 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.000 f+ 0.040 408.000 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.040 f+ 0.040 619.650 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.080 f+ 0.040 408.000 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.120 f+ 0.040 688.500 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.160 f+ 0.290 459.000 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.450 f+ 0.150 516.375 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.600 f+ 0.040 826.200 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.640 f+ 0.040 573.750 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.680 f+ 0.040 619.650 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.720 f+ 0.180 573.750 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.900 f+ 0.040 688.500 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ now@ 3.940 f+ 0.260 459.000 0.175 ampf ranf skwf 0.050
+ 0.01 10 index 0.005 0.005
+ amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter
+ 4.4 step
;
\ NREV (the most popular Samson box reverb)
-\
+\
\ REVERB-FACTOR controls the length of the decay -- it should not
\ exceed (/ 1.0 .823), LP-COEFF controls the strength of the low pass
\ filter inserted in the feedback loop, VOLUME can be used to boost the
\ reverb output.
-\
+\
\ clm/nrev.ins
instrument: nrev-fs <{ :key
- reverb-factor 1.09
- lp-coeff 0.7
- lp-out-coeff 0.85
- output-scale 1.0
- volume 1.0
- amp-env #( 0 1 1 1 ) -- }>
- doc" NREV (the most popular Samson box reverb).\n\
-<'> fm-violin-test :reverb <'> nrev with-sound"
- *output* mus-channels { chans }
- *reverb* mus-channels { rev-chans }
- *reverb* reverb-dur { dur }
- *verbose* if get-func-name rev-chans chans reverb-info then
- mus-srate 25641.0 f/ { sr }
- #( 1433 1601 1867 2053 2251 2399 347 113 37 59 43 37 29 19 ) map
- sr *key* f* f>s dup 2 mod unless 1+ then ( val )
- begin ( val ) dup prime? false? while 2 + repeat ( val )
- end-map { dly-len }
- :scaler 0.822 reverb-factor f* :size dly-len 0 array-ref make-comb { comb0 }
- :scaler 0.802 reverb-factor f* :size dly-len 1 array-ref make-comb { comb1 }
- :scaler 0.773 reverb-factor f* :size dly-len 2 array-ref make-comb { comb2 }
- :scaler 0.753 reverb-factor f* :size dly-len 3 array-ref make-comb { comb3 }
- :scaler 0.753 reverb-factor f* :size dly-len 4 array-ref make-comb { comb4 }
- :scaler 0.733 reverb-factor f* :size dly-len 5 array-ref make-comb { comb5 }
- :feedback -0.7 :feedforward 0.7 :size dly-len 6 array-ref make-all-pass { allp0 }
- :feedback -0.7 :feedforward 0.7 :size dly-len 7 array-ref make-all-pass { allp1 }
- :feedback -0.7 :feedforward 0.7 :size dly-len 8 array-ref make-all-pass { allp2 }
- :feedback -0.7 :feedforward 0.7 :size dly-len 9 array-ref make-all-pass { allp3 }
- :feedback -0.7 :feedforward 0.7 :size dly-len 10 array-ref make-all-pass { allp4 }
- :feedback -0.7 :feedforward 0.7 :size dly-len 11 array-ref make-all-pass { allp5 }
- :feedback -0.7 :feedforward 0.7 :size dly-len 12 array-ref make-all-pass { allp6 }
- :feedback -0.7 :feedforward 0.7 :size dly-len 13 array-ref make-all-pass { allp7 }
- lp-coeff lp-coeff 1.0 f- make-one-pole { low }
- lp-out-coeff lp-coeff 1.0 f- make-one-pole { low-a }
- lp-out-coeff lp-coeff 1.0 f- make-one-pole { low-b }
- lp-out-coeff lp-coeff 1.0 f- make-one-pole { low-c }
- lp-out-coeff lp-coeff 1.0 f- make-one-pole { low-d }
- :envelope amp-env :scaler output-scale :duration dur make-env { ampf }
- 0.0 dur run
- 0.0 ( rev ) rev-chans 0 ?do j i *reverb* in-any f+ loop volume f* ampf env f* { rev }
- 0.0 ( outrev )
- comb0 rev 0.0 comb f+
- comb1 rev 0.0 comb f+
- comb2 rev 0.0 comb f+
- comb3 rev 0.0 comb f+
- comb4 rev 0.0 comb f+
- comb5 rev 0.0 comb f+ { outrev }
- allp2 allp1 allp0 outrev 0.0 all-pass 0.0 all-pass 0.0 all-pass to outrev
- allp3 low outrev one-pole 0.0 all-pass to outrev
- low-a allp4 outrev 0.0 all-pass one-pole output-scale f* { sample-a }
- low-b allp5 outrev 0.0 all-pass one-pole output-scale f* { sample-b }
- low-c allp6 outrev 0.0 all-pass one-pole output-scale f* { sample-c }
- low-d allp7 outrev 0.0 all-pass one-pole output-scale f* { sample-d }
- chans 2 = if
- i sample-a sample-d f+ f2/ *output* outa drop
- else
- i sample-a *output* outa drop
- then
- chans 2 = chans 4 = || if
- chans 2 = if
- i sample-b sample-c f+ f2/ *output* outb drop
- else
- i sample-b *output* outb drop
- then
- then
- chans 4 = if
- i sample-c *output* outc drop
- i sample-d *output* outd drop
- then
- loop
+ reverb-factor 1.09
+ lp-coeff 0.7
+ lp-out-coeff 0.85
+ output-scale 1.0
+ volume 1.0
+ amp-env #( 0 1 1 1 ) -- }>
+ doc" NREV (the most popular Samson box reverb).\n\
+<'> fm-violin-test :reverb <'> nrev with-sound."
+ *output* channels { chans }
+ *reverb* channels { rev-chans }
+ *reverb* reverb-dur { dur }
+ *verbose* if
+ get-func-name rev-chans chans reverb-info
+ then
+ mus-srate 25641.0 f/ { sr }
+ #( 1433 1601 1867 2053 2251 2399 347 113 37 59 43 37 29 19 ) map
+ sr *key* f* f>s dup 2 mod unless
+ 1+
+ then ( val )
+ begin
+ ( val ) dup prime? false?
+ while
+ 2 +
+ repeat ( val )
+ end-map { dly-len }
+ :scaler 0.822 reverb-factor f*
+ :size dly-len 0 array-ref make-comb { comb0 }
+ :scaler 0.802 reverb-factor f*
+ :size dly-len 1 array-ref make-comb { comb1 }
+ :scaler 0.773 reverb-factor f*
+ :size dly-len 2 array-ref make-comb { comb2 }
+ :scaler 0.753 reverb-factor f*
+ :size dly-len 3 array-ref make-comb { comb3 }
+ :scaler 0.753 reverb-factor f*
+ :size dly-len 4 array-ref make-comb { comb4 }
+ :scaler 0.733 reverb-factor f*
+ :size dly-len 5 array-ref make-comb { comb5 }
+ :feedback -0.7 :feedforward 0.7
+ :size dly-len 6 array-ref make-all-pass { allp0 }
+ :feedback -0.7 :feedforward 0.7
+ :size dly-len 7 array-ref make-all-pass { allp1 }
+ :feedback -0.7 :feedforward 0.7
+ :size dly-len 8 array-ref make-all-pass { allp2 }
+ :feedback -0.7 :feedforward 0.7
+ :size dly-len 9 array-ref make-all-pass { allp3 }
+ :feedback -0.7 :feedforward 0.7
+ :size dly-len 10 array-ref make-all-pass { allp4 }
+ :feedback -0.7 :feedforward 0.7
+ :size dly-len 11 array-ref make-all-pass { allp5 }
+ :feedback -0.7 :feedforward 0.7
+ :size dly-len 12 array-ref make-all-pass { allp6 }
+ :feedback -0.7 :feedforward 0.7
+ :size dly-len 13 array-ref make-all-pass { allp7 }
+ lp-coeff lp-coeff 1.0 f- make-one-pole { low }
+ lp-out-coeff lp-coeff 1.0 f- make-one-pole { low-a }
+ lp-out-coeff lp-coeff 1.0 f- make-one-pole { low-b }
+ lp-out-coeff lp-coeff 1.0 f- make-one-pole { low-c }
+ lp-out-coeff lp-coeff 1.0 f- make-one-pole { low-d }
+ :envelope amp-env :scaler output-scale :duration dur make-env { ampf }
+ 0.0 dur run
+ 0.0 ( rev ) rev-chans 0 ?do
+ j i *reverb* in-any f+
+ loop volume f* ampf env f* { rev }
+ 0.0 ( outrev )
+ comb0 rev 0.0 comb f+
+ comb1 rev 0.0 comb f+
+ comb2 rev 0.0 comb f+
+ comb3 rev 0.0 comb f+
+ comb4 rev 0.0 comb f+
+ comb5 rev 0.0 comb f+ { outrev }
+ allp2 allp1 allp0 outrev 0.0 all-pass 0.0 all-pass
+ 0.0 all-pass to outrev
+ allp3 low outrev one-pole 0.0 all-pass to outrev
+ low-a allp4 outrev 0.0 all-pass
+ one-pole output-scale f* { sample-a }
+ low-b allp5 outrev 0.0 all-pass
+ one-pole output-scale f* { sample-b }
+ low-c allp6 outrev 0.0 all-pass
+ one-pole output-scale f* { sample-c }
+ low-d allp7 outrev 0.0 all-pass
+ one-pole output-scale f* { sample-d }
+ chans 2 = if
+ i sample-a sample-d f+ f2/ *output* outa drop
+ else
+ i sample-a *output* outa drop
+ then
+ chans 2 =
+ chans 4 = || if
+ chans 2 = if
+ i sample-b sample-c f+ f2/ *output* outb drop
+ else
+ i sample-b *output* outb drop
+ then
+ then
+ chans 4 = if
+ i sample-c *output* outc drop
+ i sample-d *output* outd drop
+ then
+ loop
;instrument
<'> nrev-fs alias nrev
+<'> nrev <'> nrev-fs help-ref help-set!
-struct
- cell% field carriers
- cell% field ampfs
- cell% field indfs
- cell% field c-rats
-end-struct reson%
+#( "reson-carriers"
+ "reson-ampfs"
+ "reson-indfs"
+ "reson-c-rats" ) create-struct make-reson-struct
\ RESON
instrument: reson <{ start dur pitch amp
- indxfun skewfun pcskew
- skewat skewdc
- vibfreq vibpc
- ranvibfreq ranvibpc data -- }>
- :frequency pitch make-oscil { mod }
- :envelope skewfun 25 100 skewat dur f/ f* 75 100 100 skewdc dur f/ f* f- stretch-envelope
- :scaler pcskew pitch f* hz->radians
- :duration dur make-env { frqf }
- :frequency vibfreq :amplitude vibpc pitch f* hz->radians make-triangle-wave { pervib }
- :frequency ranvibfreq :amplitude ranvibpc pitch f* hz->radians make-rand-interp { ranvib }
- 0.0 data each ( lst-val ) 2 object-ref f+ end-each { totalamp }
- nil { rs }
- data object->array map! *key* { frmdat }
- reson% %alloc to rs
- frmdat 0 object-ref { ampf }
- frmdat 1 object-ref { freq }
- frmdat 2 object-ref { rfamp }
- frmdat 3 object-ref dur f/ 100.0 f* { ampat }
- 100.0 frmdat 4 object-ref dur f/ 100.0 f* f- { ampdc }
- frmdat 5 object-ref freq f* hz->radians { dev0 }
- frmdat 6 object-ref freq f* hz->radians { dev1 }
- frmdat 7 object-ref dur f/ 100.0 f* { indxat }
- 100.0 frmdat 8 object-ref dur f/ 100.0 f* f- { indxdc }
- freq pitch f/ fround->s { harm }
- 1.0 harm freq pitch f/ f- fabs f- { rsamp }
- pitch harm f* { cfq }
- ampat f0= if 25.0 to ampat then
- ampdc f0= if 75.0 to ampdc then
- indxat f0= if 25.0 to indxat then
- indxdc f0= if 75.0 to indxdc then
- :envelope indxfun 25 indxat 75 indxdc stretch-envelope
- :scaler dev1 dev0 f-
- :offset dev0
- :duration dur make-env rs indfs !
- :envelope ampf 25 ampat 75 ampdc stretch-envelope
- :scaler rsamp amp rfamp totalamp f/ f* f*
- :duration dur make-env rs ampfs !
- harm rs c-rats !
- :frequency cfq make-oscil rs carriers !
- rs
- end-map { values }
- start dur #{ :degree 90.0 random } run-instrument
- pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ frqf env f+ { vib }
- mod vib 0.0 oscil { modsig }
- 0.0
- values each { rs }
- rs ampfs @ env rs carriers @ vib rs c-rats @ f* rs indfs @ env modsig f* f+ 0.0 oscil f* f+
- end-each
- end-run
- values each ( rs ) free throw end-each
+ indxfun skewfun pcskew
+ skewat skewdc
+ vibfreq vibpc
+ ranvibfreq ranvibpc data -- }>
+ :frequency pitch make-oscil { mod }
+ :envelope skewfun
+ 25.0
+ skewat dur f/ 100.0 f*
+ 75.0
+ 100.0 skewdc dur f/ 100.0 f* f- stretch-envelope
+ :scaler pcskew pitch f* hz->radians
+ :duration dur make-env { frqf }
+ :frequency vibfreq
+ :amplitude vibpc pitch f* hz->radians make-triangle-wave { pervib }
+ :frequency ranvibfreq
+ :amplitude ranvibpc pitch f* hz->radians make-rand-interp { ranvib }
+ 0.0 ( sum )
+ data each ( lst-val )
+ 2 object-ref f+ ( sum += ... )
+ end-each { totalamp }
+ nil { rs }
+ data object->array map! *key* { frmdat }
+ frmdat 0 object-ref { ampf }
+ frmdat 1 object-ref { freq }
+ frmdat 2 object-ref { rfamp }
+ frmdat 3 object-ref dur f/ 100.0 f* { ampat }
+ 100.0 frmdat 4 object-ref dur f/ 100.0 f* f- { ampdc }
+ frmdat 5 object-ref freq f* hz->radians { dev0 }
+ frmdat 6 object-ref freq f* hz->radians { dev1 }
+ frmdat 7 object-ref dur f/ 100.0 f* { indxat }
+ 100.0 frmdat 8 object-ref dur f/ 100.0 f* f- { indxdc }
+ freq pitch f/ fround->s { harm }
+ 1.0 harm freq pitch f/ f- fabs f- { rsamp }
+ pitch harm f* { cfq }
+ ampat f0= if
+ 25.0 to ampat
+ then
+ ampdc f0= if
+ 75.0 to ampdc
+ then
+ indxat f0= if
+ 25.0 to indxat
+ then
+ indxdc f0= if
+ 75.0 to indxdc
+ then
+ make-reson-struct to rs
+ :envelope indxfun 25.0 indxat 75.0 indxdc stretch-envelope
+ :scaler dev1 dev0 f-
+ :offset dev0
+ :duration dur make-env rs swap reson-indfs!
+ :envelope ampf 25.0 ampat 75.0 ampdc stretch-envelope
+ :scaler rsamp amp rfamp totalamp f/ f* f*
+ :duration dur make-env rs swap reson-ampfs!
+ rs harm reson-c-rats!
+ rs :frequency cfq :initial-phase 0.0 make-oscil reson-carriers!
+ rs
+ end-map { values }
+ start dur #{ :degree 90.0 random } run-instrument
+ pervib 0.0 triangle-wave ranvib
+ 0.0 rand-interp f+ frqf env f+ { vib }
+ mod vib 0.0 oscil { modsig }
+ 0.0 ( val )
+ values each { rs }
+ rs reson-ampfs@ env ( amp )
+ rs reson-carriers@ ( car-os )
+ rs reson-c-rats@ vib f*
+ rs reson-indfs@ env modsig f* f+ ( car-fm )
+ 0.0 ( car-pm ) oscil
+ f* ( car-os * amp )
+ f+ ( val += ... )
+ end-each ( val )
+ end-run
;instrument
: reson-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- #( #( #( 0 0 100 1 ) 1200 0.5 0.1 0.1 0 1.0 0.1 0.1 )
- #( #( 0 1 100 0 ) 2400 0.5 0.1 0.1 0 1.0 0.1 0.1 ) ) { data }
+ start now!
+ #( #( #( 0 0 100 1 ) 1200 0.5 0.1 0.1 0 1.0 0.1 0.1 )
+ #( #( 0 1 100 0 ) 2400 0.5 0.1 0.1 0 1.0 0.1 0.1 ) ) { data }
- now@ dur 440 0.5 #( 0 0 100 1 ) #( 0 0 100 1 ) 0.1 0.1 0.1 5 0.01 5 0.01 data reson
- dur 0.2 f+ step
+ now@ dur 440 0.5 #( 0 0 100 1 ) #( 0 0 100 1 )
+ 0.1 0.1 0.1 5 0.01 5 0.01 data reson
+ dur 0.2 f+ step
;
\ STK's feedback-fm instrument named CelloN in Sambox-land
instrument: cellon <{ start dur pitch0 amp ampfun
- betafun beta0 beta1 betaat betadc ampat ampdc
- pitch1 glissfun glissat glissdc
- pvibfreq pvibpc pvibfun pvibat pvibdc
- rvibfreq rvibpc rvibfun -- }>
- pitch1 f0= if pitch0 else pitch1 then { pit1 }
- :frequency pitch0 make-oscil { carr }
- 0.5 -0.5 make-one-zero { low }
- :frequency pitch0 make-oscil { fmosc }
- :frequency pvibfreq :amplitude 1.0 make-triangle-wave { pvib }
- :frequency rvibfreq :amplitude 1.0 make-rand-interp { rvib }
- ampat f0> if 100 ampat dur f/ f* else 25 then { ampap }
- ampdc f0> if 100 1 ampdc dur f/ f- f* else 75 then { ampdp }
- glissat f0> if 100 glissat dur f/ f* else 25 then { glsap }
- glissdc f0> if 100 1 glissdc dur f/ f- f* else 75 then { glsdp }
- betaat f0> if 100 betaat dur f/ f* else 25 then { betap }
- betadc f0> if 100 1 betadc dur f/ f- f* else 75 then { betdp }
- pvibat f0> if 100 pvibat dur f/ f* else 25 then { pvbap }
- pvibdc f0> if 100 1 pvibdc dur f/ f- f* else 75 then { pvbdp }
- :envelope pvibfun 25 pvbap 75 pvbdp stretch-envelope
- :scaler pvibpc pitch0 f* hz->radians
- :duration dur make-env { pvibenv }
- :envelope rvibfun
- :scaler rvibpc pitch0 f* hz->radians
- :duration dur make-env { rvibenv }
- :envelope glissfun 25 glsap 75 glsdp stretch-envelope
- :scaler pit1 pitch0 f- hz->radians
- :duration dur make-env { glisenv }
- :envelope ampfun 25 ampap 75 ampdp stretch-envelope
- :scaler amp
- :duration dur make-env { amplenv }
- :envelope betafun 25 betap 75 betdp stretch-envelope
- :scaler beta1 beta0 f-
- :offset beta0
- :duration dur make-env { betaenv }
- 0.0 { fm }
- start dur #{ :degree 90.0 random } run-instrument
- pvibenv env pvib 0.0 triangle-wave f*
- rvibenv env rvib 0.0 rand-interp f* f+
- glisenv env f+ { vib }
- low betaenv env fmosc vib fm f+ 0.0 oscil f* one-zero to fm
- amplenv env carr vib fm f+ 0.0 oscil f*
- end-run
+ betafun beta0 beta1 betaat betadc ampat ampdc
+ pitch1 glissfun glissat glissdc
+ pvibfreq pvibpc pvibfun pvibat pvibdc
+ rvibfreq rvibpc rvibfun -- }>
+ pitch1 f0= if
+ pitch0
+ else
+ pitch1
+ then { pit1 }
+ :frequency pitch0 make-oscil { carr }
+ 0.5 -0.5 make-one-zero { low }
+ :frequency pitch0 make-oscil { fmosc }
+ :frequency pvibfreq :amplitude 1.0 make-triangle-wave { pvib }
+ :frequency rvibfreq :amplitude 1.0 make-rand-interp { rvib }
+ ampat f0> if
+ ampat dur f/ 100.0 f*
+ else
+ 25.0
+ then { ampap }
+ ampdc f0> if
+ 1.0 ampdc dur f/ f- 100.0 f*
+ else
+ 75.0
+ then { ampdp }
+ glissat f0> if
+ glissat dur f/ 100.0 f*
+ else
+ 25.0
+ then { glsap }
+ glissdc f0> if
+ 1.0 glissdc dur f/ f- 100.0 f*
+ else
+ 75.0
+ then { glsdp }
+ betaat f0> if
+ betaat dur f/ 100.0 f*
+ else
+ 25.0
+ then { betap }
+ betadc f0> if
+ 1.0 betadc dur f/ f- 100.0 f*
+ else
+ 75.0
+ then { betdp }
+ pvibat f0> if
+ pvibat dur f/ 100.0 f*
+ else
+ 25.0
+ then { pvbap }
+ pvibdc f0> if
+ 1.0 pvibdc dur f/ f- 100.0 f*
+ else
+ 75.0
+ then { pvbdp }
+ :envelope pvibfun 25.0 pvbap 75.0 pvbdp stretch-envelope
+ :scaler pvibpc pitch0 f* hz->radians
+ :duration dur make-env { pvibenv }
+ :envelope rvibfun
+ :scaler rvibpc pitch0 f* hz->radians
+ :duration dur make-env { rvibenv }
+ :envelope glissfun 25.0 glsap 75.0 glsdp stretch-envelope
+ :scaler pit1 pitch0 f- hz->radians
+ :duration dur make-env { glisenv }
+ :envelope ampfun 25.0 ampap 75.0 ampdp stretch-envelope
+ :scaler amp
+ :duration dur make-env { amplenv }
+ :envelope betafun 25.0 betap 75.0 betdp stretch-envelope
+ :scaler beta1 beta0 f-
+ :offset beta0
+ :duration dur make-env { betaenv }
+ 0.0 { fm }
+ start dur #{ :degree 90.0 random } run-instrument
+ pvibenv env pvib 0.0 triangle-wave f*
+ rvibenv env rvib 0.0 rand-interp f* f+
+ glisenv env f+ { vib }
+ low betaenv env fmosc vib fm f+ 0.0 oscil f* one-zero to fm
+ amplenv env carr vib fm f+ 0.0 oscil f*
+ end-run
;instrument
: cellon-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
-
- now@ dur 220 0.5
- #( 0 0 25 1 75 1 100 0 ) \ ampfun
- #( 0 0 25 1 75 1 100 0 ) \ betafun
- 0.75 1 0 0 0 0 220
- #( 0 0 25 1 75 1 100 0 ) \ glissfun
- 0 0 0 0
- #( 0 0 100 0 ) \ pvibfun
- 0 0 0 0
- #( 0 0 100 0 ) \ rvibfun
- cellon
- dur 0.2 f+ step
+ start now!
+
+ now@ dur 220 0.5
+ #( 0 0 25 1 75 1 100 0 ) \ ampfun
+ #( 0 0 25 1 75 1 100 0 ) \ betafun
+ 0.75 1 0 0 0 0 220
+ #( 0 0 25 1 75 1 100 0 ) \ glissfun
+ 0 0 0 0
+ #( 0 0 100 0 ) \ pvibfun
+ 0 0 0 0
+ #( 0 0 100 0 ) \ rvibfun
+ cellon
+ dur 0.2 f+ step
;
\ JL-REVERB
-instrument: jl-reverb <{ :key -- }>
- *output* mus-channels { chans }
- *reverb* mus-channels { rev-chans }
- *reverb* reverb-dur { dur }
- *verbose* if get-func-name rev-chans chans reverb-info then
- :feedback -0.7 :feedforward 0.7 :size 2111 make-all-pass { allpass1 }
- :feedback -0.7 :feedforward 0.7 :size 673 make-all-pass { allpass2 }
- :feedback -0.7 :feedforward 0.7 :size 223 make-all-pass { allpass3 }
- :scaler 0.742 :size 9601 make-comb { comb1 }
- :scaler 0.733 :size 10007 make-comb { comb2 }
- :scaler 0.715 :size 10799 make-comb { comb3 }
- :scaler 0.697 :size 11597 make-comb { comb4 }
- :size 0.013 seconds->samples make-delay { outdel1 }
- chans 1 > if :size 0.011 seconds->samples make-delay else #f then { outdel2 }
- chans 2 > if :size 0.015 seconds->samples make-delay else #f then { outdel3 }
- chans 3 > if :size 0.017 seconds->samples make-delay else #f then { outdel4 }
- 0.0 { allpass-sum }
- 0.0 { all-sums }
- 0.0 dur run
- 0.0 rev-chans 0 ?do j i *reverb* in-any f+ loop { in-val }
- allpass3 allpass2 allpass1 in-val 0.0 all-pass 0.0 all-pass 0.0 all-pass to allpass-sum
- comb1 allpass-sum 0.0 comb
- comb2 allpass-sum 0.0 comb f+
- comb3 allpass-sum 0.0 comb f+
- comb4 allpass-sum 0.0 comb f+ to all-sums
- i outdel1 all-sums 0.0 delay *output* outa drop
- outdel2 if i outdel2 all-sums 0.0 delay *output* outb drop then
- outdel3 if i outdel3 all-sums 0.0 delay *output* outc drop then
- outdel4 if i outdel4 all-sums 0.0 delay *output* outd drop then
- loop
+instrument: jl-reverb <{ -- }>
+ *output* channels { chans }
+ *reverb* channels { rev-chans }
+ *reverb* reverb-dur { dur }
+ *verbose* if
+ get-func-name rev-chans chans reverb-info
+ then
+ :feedback -0.7 :feedforward 0.7 :size 2111 make-all-pass { allpass1 }
+ :feedback -0.7 :feedforward 0.7 :size 673 make-all-pass { allpass2 }
+ :feedback -0.7 :feedforward 0.7 :size 223 make-all-pass { allpass3 }
+ :scaler 0.742 :size 9601 make-comb { comb1 }
+ :scaler 0.733 :size 10007 make-comb { comb2 }
+ :scaler 0.715 :size 10799 make-comb { comb3 }
+ :scaler 0.697 :size 11597 make-comb { comb4 }
+ :size 0.013 seconds->samples make-delay { outdel1 }
+ chans 1 > if
+ :size 0.011 seconds->samples make-delay
+ else
+ #f
+ then { outdel2 }
+ chans 2 > if
+ :size 0.015 seconds->samples make-delay
+ else
+ #f
+ then { outdel3 }
+ chans 3 > if
+ :size 0.017 seconds->samples make-delay
+ else
+ #f
+ then { outdel4 }
+ 0.0 { allpass-sum }
+ 0.0 { all-sums }
+ 0.0 dur run
+ 0.0 ( sum )
+ rev-chans 0 ?do
+ j i *reverb* in-any f+ ( sum += ... )
+ loop { in-val }
+ allpass3 allpass2 allpass1 in-val 0.0 all-pass
+ 0.0 all-pass 0.0 all-pass to allpass-sum
+ comb1 allpass-sum 0.0 comb
+ comb2 allpass-sum 0.0 comb f+
+ comb3 allpass-sum 0.0 comb f+
+ comb4 allpass-sum 0.0 comb f+ to all-sums
+ i outdel1 all-sums 0.0 delay *output* outa drop
+ outdel2 if
+ i outdel2 all-sums 0.0 delay *output* outb drop
+ then
+ outdel3 if
+ i outdel3 all-sums 0.0 delay *output* outc drop
+ then
+ outdel4 if
+ i outdel4 all-sums 0.0 delay *output* outd drop
+ then
+ loop
;instrument
\ GRAN-SYNTH
instrument: gran-synth <{ start dur freq grain-dur interval amp -- }>
- :envelope #( 0 0 25 1 75 1 100 0 ) :duration grain-dur make-env { grain-env }
- :frequency freq make-oscil { carrier }
- grain-dur interval fmax mus-srate f* fceil f>s { grain-size }
- :frequency interval 1/f :size grain-size make-wave-train { grains }
- grains mus-data map! grain-env env carrier 0.0 0.0 oscil f* end-map drop
- start dur #{ :degree 90.0 random } run-instrument
- grains 0.0 wave-train amp f*
- end-run
+ :envelope #( 0 0 25 1 75 1 100 0 )
+ :duration grain-dur make-env { grain-env }
+ :frequency freq make-oscil { carrier }
+ grain-dur interval fmax mus-srate f* fceil f>s { grain-size }
+ :frequency interval 1/f :size grain-size make-wave-train { grains }
+ grains mus-data map!
+ grain-env env carrier 0.0 0.0 oscil f*
+ end-map drop
+ start dur #{ :degree 90.0 random } run-instrument
+ grains 0.0 wave-train amp f*
+ end-run
;instrument
: gran-synth-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 100 0.0189 0.02 0.4 gran-synth
- dur 0.2 f+ step
+ start now!
+ now@ dur 100 0.0189 0.02 0.4 gran-synth
+ dur 0.2 f+ step
;
\ TOUCH-TONE
\
\ clm/ugex.ins
instrument: touch-tone <{ numbers :key start 0.0 -- }>
- doc" (see clm/ugex.ins) NUMBERS is an array with phone numbers.\n\
-#( 8 5 7 7 5 8 ) <'> touch-tone with-sound"
- #( 0 697 697 697 770 770 770 852 852 852 941 941 941 ) { tt1 }
- #( 0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477 ) { tt2 }
- numbers each ( numb ) dup 0= if drop 11 then { idx }
- :frequency tt1 idx array-ref make-oscil { frq1 }
- :frequency tt2 idx array-ref make-oscil { frq2 }
- i 0.3 f* start f+ 0.2 #{ :degree 90.0 random } run-instrument
- frq1 0.0 0.0 oscil frq2 0.0 0.0 oscil f+ 0.25 f*
- end-run
- end-each
+ doc" (See clm/ugex.ins) NUMBERS is an array with phone numbers.\n\
+#( 4 8 3 4 6 2 1 ) <'> touch-tone with-sound."
+ #( 0 697 697 697 770 770 770
+ 852 852 852 941 941 941 ) { tt1 }
+ #( 0 1209 1336 1477 1209 1336 1477
+ 1209 1336 1477 1209 1336 1477 ) { tt2 }
+ numbers each ( numb )
+ dup 0= if
+ drop
+ 11
+ then { idx }
+ :frequency tt1 idx array-ref make-oscil { frq1 }
+ :frequency tt2 idx array-ref make-oscil { frq2 }
+ i 0.3 f* start f+ 0.2 #{ :degree 90.0 random } run-instrument
+ frq1 0.0 0.0 oscil frq2 0.0 0.0 oscil f+ 0.25 f*
+ end-run
+ end-each
;instrument
: touch-tone-test <{ :optional start 0.0 dur 1.0 -- }>
start now!
- #( 8 5 7 7 5 8 ) :start now@ touch-tone
- dur 6 ( numbers ) f* 0.2 f+ step
+ #( 4 8 3 4 6 2 1 ) :start now@ touch-tone
+ dur 7 ( digits ) f* 0.2 f+ step
;
\ SPECTRA
-instrument: spectra <{ start dur freq amp
- :optional
- parts #( 1 1 2 0.5 )
- ampenv #( 0 0 50 1 100 0 )
- vibamp 0.005
- vibfrq 5.0
- degr 0.0
- dist 1.0
- rev-amt 0.005 -- }>
- :frequency freq :wave parts #f #f partials->wave make-table-lookup { s }
- :envelope ampenv :scaler amp :duration dur make-env { ampf }
- freq hz->radians vibamp f* { vamp }
- :frequency vibfrq :amplitude vamp make-triangle-wave { pervib }
- :frequency vibfrq 1.0 f+ :amplitude vamp make-rand-interp { ranvib }
- start dur #{ :degree degr :distance dist :reverb rev-amt } run-instrument
- s pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ table-lookup ampf env f*
- end-run
+instrument: spectra <{ start dur freq amp :optional
+ parts #( 1 1 2 0.5 )
+ ampenv #( 0 0 50 1 100 0 )
+ vibamp 0.005
+ vibfrq 5.0
+ degr 0.0
+ dist 1.0
+ rev-amt 0.005 -- }>
+ :frequency freq :wave parts #f #f partials->wave make-table-lookup { s }
+ :envelope ampenv :scaler amp :duration dur make-env { ampf }
+ freq hz->radians vibamp f* { vamp }
+ :frequency vibfrq :amplitude vamp make-triangle-wave { pervib }
+ :frequency vibfrq 1.0 f+ :amplitude vamp make-rand-interp { ranvib }
+ start dur
+ #{ :degree degr :distance dist :reverb rev-amt } run-instrument
+ s
+ pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+
+ table-lookup ampf env f*
+ end-run
;instrument
: spectra-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- #( 1.00 0.1132 2.00 0.0252 3.00 0.0292 4.01 0.0136 5.03 0.0045
- 6.06 0.0022 7.11 0.0101 8.17 0.0004 9.23 0.0010 10.33 0.0012
- 11.44 0.0013 12.58 0.0011 13.75 0.0002 14.93 0.0005 16.14 0.0002 ) { p-a4 }
- now@ dur 440 2.0 p-a4 #( 0 0 1 1 5 0.9 12 0.5 25 0.25 100 0 ) spectra
- dur 0.2 f+ step
+ start now!
+ #( 1.00 0.1132 2.00 0.0252 3.00 0.0292 4.01 0.0136 5.03 0.0045
+ 6.06 0.0022 7.11 0.0101 8.17 0.0004 9.23 0.0010 10.33 0.0012
+ 11.44 0.0013 12.58 0.0011 13.75 0.0002 14.93 0.0005
+ 16.14 0.0002 ) { p-a4 }
+
+ now@ dur 440 2.0 p-a4 #( 0 0 1 1 5 0.9 12 0.5 25 0.25 100 0 ) spectra
+ dur 0.2 f+ step
;
\ TWO-TAB
-\
+\
\ interpolate between two waveforms (this could be extended to
\ implement all the various wavetable-based synthesis techniques).
-instrument: two-tab <{ start dur freq amp
- :optional
- part1 #( 1.0 1.0 2.0 0.5 )
- part2 #( 1.0 0.0 3.0 1.0 )
- ampenv #( 0 0 50 1 100 0 )
- interpenv #( 0 1 100 0 )
- vibamp 0.005
- vibfrq 5.0
- degr 0.0
- dist 1.0
- rev-amt 0.005 -- }>
- :frequency freq :wave part1 #f #f partials->wave make-table-lookup { s1 }
- :frequency freq :wave part2 #f #f partials->wave make-table-lookup { s2 }
- :envelope ampenv :scaler amp :duration dur make-env { ampf }
- :envelope interpenv :duration dur make-env { interpf }
- freq hz->radians vibamp f* { vamp }
- :frequency vibfrq :amplitude vamp make-triangle-wave { pervib }
- :frequency vibfrq 1.0 f+ :amplitude vamp make-rand-interp { ranvib }
- start dur #{ :degree degr :distance dist :reverb rev-amt } run-instrument
- pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ { vib }
- interpf env { intrp }
- s1 vib table-lookup intrp f* s2 vib table-lookup 1.0 intrp f- f* f+ ampf env f*
- end-run
+instrument: two-tab <{ start dur freq amp :optional
+ part1 #( 1.0 1.0 2.0 0.5 )
+ part2 #( 1.0 0.0 3.0 1.0 )
+ ampenv #( 0 0 50 1 100 0 )
+ interpenv #( 0 1 100 0 )
+ vibamp 0.005
+ vibfrq 5.0
+ degr 0.0
+ dist 1.0
+ rev-amt 0.005 -- }>
+ :frequency freq
+ :wave part1 #f #f partials->wave make-table-lookup { s1 }
+ :frequency freq
+ :wave part2 #f #f partials->wave make-table-lookup { s2 }
+ :envelope ampenv :scaler amp :duration dur make-env { ampf }
+ :envelope interpenv :duration dur make-env { interpf }
+ freq hz->radians vibamp f* { vamp }
+ :frequency vibfrq :amplitude vamp make-triangle-wave { pervib }
+ :frequency vibfrq 1.0 f+ :amplitude vamp make-rand-interp { ranvib }
+ start dur
+ #{ :degree degr :distance dist :reverb rev-amt } run-instrument
+ pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ { vib }
+ interpf env { intrp }
+ s1 vib table-lookup intrp f*
+ s2 vib table-lookup 1.0 intrp f- f*
+ f+ ( s1 + s2 ) ampf env f*
+ end-run
;instrument
: two-tab-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.5 two-tab
- dur 0.2 f+ step
+ start now!
+ now@ dur 440 0.5 two-tab
+ dur 0.2 f+ step
;
\ LBJ-PIANO
@@ -2124,7 +2631,7 @@ instrument: two-tab <{ start dur freq amp
\ rotten--they just don't sparkle; I have a feeling that this is due
\ to the low amplitude of the original data, and the lack of
\ mechanical noise.
-\
+\
\ The only thing you can do to alter the sound of a piano note is to
\ set the pfreq parameter. Pfreq is used to look up the partials. By
\ default, it's set to the requested frequency. Setting it to a
@@ -2132,711 +2639,943 @@ instrument: two-tab <{ start dur freq amp
\ there's no nyquist detection; a high freq with a low pfreq, will
\ give you fold over (hmmm...maybe I can get those high notes to
\ sparkle after all).
-instrument: lbj-piano <{ start dur freq amp
- :key
- degree 45.0
- distance 1.0
- reverb-amount 0.0 -- }>
- piano-spectra 12.0 freq 32.703 f/ flog 2.0 flog f/ f* f>s array-ref normalize-partials { parts }
- dur *clm-piano-attack-duration* *clm-piano-realease-duration* f+ f+ to dur
- dur *clm-piano-realease-duration* f- { env1dur }
- env1dur mus-srate f* fround->s { env1samples }
- #( 0.0
- 0.0
- *clm-piano-attack-duration* 100.0 f* env1dur f/ 4.0 f/
- 1.0
- *clm-piano-attack-duration* 100.0 f* env1dur f/
- 1.0
- 100.0
- *clm-db-drop-per-second* env1dur f* db->linear ) { ampfun1 }
- :envelope ampfun1 :scaler amp :duration env1dur :base 10000.0 make-env { ampenv1 }
- :envelope #( 0 1 100 0 )
- :scaler amp ampfun1 -1 array-ref f*
- :duration env1dur
- :base 1.0 make-env { ampenv2 }
- parts length 2/ 0.0 make-vct { alist }
- parts length 2/ make-array map!
- alist i parts i 2* 1+ array-ref vct-set! drop
- :frequency parts i 2* array-ref freq f* make-oscil
- end-map { oscils }
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- 0.0 ( sum ) oscils each ( os ) 0.0 0.0 oscil alist i vct-ref f* f+ end-each ( sum )
- i env1samples > if ampenv2 else ampenv1 then env ( sum ) f*
- end-run
+instrument: lbj-piano <{ start dur freq amp :key
+ degree 45.0
+ distance 1.0
+ reverb-amount 0.0 -- }>
+ 12.0 freq 32.703 f/ flog 2.0 flog f/ f* f>s { idx }
+ piano-spectra idx array-ref normalize-partials { parts }
+ dur *clm-piano-attack-duration* *clm-piano-realease-duration*
+ f+ f+ to dur
+ dur *clm-piano-realease-duration* f- { env1dur }
+ env1dur mus-srate f* fround->s { env1samples }
+ #( 0.0
+ 0.0
+ *clm-piano-attack-duration* 100.0 f* env1dur f/ 4.0 f/
+ 1.0
+ *clm-piano-attack-duration* 100.0 f* env1dur f/
+ 1.0
+ 100.0
+ *clm-db-drop-per-second* env1dur f* db->linear ) { ampfun1 }
+ :envelope ampfun1
+ :scaler amp
+ :duration env1dur
+ :base 10000.0 make-env { ampenv1 }
+ :envelope #( 0 1 100 0 )
+ :scaler amp ampfun1 -1 array-ref f*
+ :duration env1dur
+ :base 1.0 make-env { ampenv2 }
+ parts length 2/ 0.0 make-vct { alist }
+ parts length 2/ make-array map!
+ alist i parts i 2* 1+ vct-ref vct-set! drop
+ :frequency parts i 2* vct-ref freq f* make-oscil
+ end-map { oscils }
+ start dur
+ #{ :degree degree :distance distance :reverb reverb-amount }
+ run-instrument
+ 0.0 ( sum )
+ oscils each ( os )
+ 0.0 0.0 oscil alist i vct-ref f* f+ ( sum += ... )
+ end-each ( sum )
+ i env1samples > if
+ ampenv2
+ else
+ ampenv1
+ then env f*
+ end-run
;instrument
: lbj-piano-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440 0.5 lbj-piano
- dur 0.24 f+ 0.2 f+ step
+ start now!
+ now@ dur 440 0.5 lbj-piano
+ dur 0.24 f+ 0.2 f+ step
;
\ RESFLT
\ clm/resflt.ins
instrument: resflt <{ start dur driver
- ranfreq noiamp noifun cosamp cosfreq1 cosfreq0 cosnum
- ampcosfun freqcosfun
- freq1 r1 g1 freq2 r2 g2 freq3 r3 g3
- :key
- degree 0.0
- distance 1.0
- reverb-amount 0.005 -- }>
- doc" from clm/resflt.ins\n\
-0 1 #f 0 0 #f 0.1 200 230 10 '( 0 0 50 1 100 0 ) '( 0 0 100 1 ) 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1 :degree 90.0 random <'> resflt with-sound\n\
-0 1 #t 10000 0.01 '( 0 0 50 1 100 0 ) 0 0 0 0 #f #f 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1 :degree 90.0 random <'> resflt with-sound"
- :radius r1 :frequency freq1 make-two-pole { f1 }
- :radius r2 :frequency freq2 make-two-pole { f2 }
- :radius r3 :frequency freq3 make-two-pole { f3 }
- driver if
- :envelope noifun :scaler noiamp :duration dur make-env { ampf }
- :frequency ranfreq make-rand { gen }
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- gen 0.0 rand ampf env f* { input }
- f1 input g1 f* two-pole
- f2 input g2 f* two-pole f+
- f3 input g3 f* two-pole f+
- end-run
- else
- :envelope freqcosfun :scaler cosfreq1 cosfreq0 f- hz->radians :duration dur make-env { frqf }
- :envelope ampcosfun :scaler cosamp :duration dur make-env { ampf }
- :frequency cosfreq0 :n cosnum make-ncos { gen }
- start dur #{ :degree degree :distance distance :reverb reverb-amount } run-instrument
- gen frqf env ncos ampf env f* { input }
- f1 input g1 f* two-pole
- f2 input g2 f* two-pole f+
- f3 input g3 f* two-pole f+
- end-run
- then
+ ranfreq noiamp noifun cosamp cosfreq1 cosfreq0 cosnum
+ ampcosfun freqcosfun
+ freq1 r1 g1 freq2 r2 g2 freq3 r3 g3 :key
+ degree 0.0
+ distance 1.0
+ reverb-amount 0.005 -- }>
+ doc" From clm/resflt.ins\n\
+0 1 #f 0 0 #f 0.1 200 230 10 '( 0 0 50 1 100 0 ) '( 0 0 100 1 )\n\
+ 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1 :degree\n\
+ 90.0 random <'> resflt with-sound\n\
+0 1 #t 10000 0.01 '( 0 0 50 1 100 0 ) 0 0 0 0 #f #f\n\
+ 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1 :degree\n\
+ 90.0 random <'> resflt with-sound."
+ :radius r1 :frequency freq1 make-two-pole { f1 }
+ :radius r2 :frequency freq2 make-two-pole { f2 }
+ :radius r3 :frequency freq3 make-two-pole { f3 }
+ driver if
+ :envelope noifun
+ :scaler noiamp
+ :duration dur make-env { ampf }
+ :frequency ranfreq make-rand { gen }
+ start dur
+ #{ :degree degree :distance distance :reverb reverb-amount }
+ run-instrument
+ gen 0.0 rand ampf env f* { input }
+ f1 input g1 f* two-pole
+ f2 input g2 f* two-pole f+
+ f3 input g3 f* two-pole f+
+ end-run
+ else
+ :envelope freqcosfun
+ :scaler cosfreq1 cosfreq0 f- hz->radians
+ :duration dur make-env { frqf }
+ :envelope ampcosfun
+ :scaler cosamp
+ :duration dur make-env { ampf }
+ :frequency cosfreq0 :n cosnum make-ncos { gen }
+ start dur
+ #{ :degree degree :distance distance :reverb reverb-amount }
+ run-instrument
+ gen frqf env ncos ampf env f* { input }
+ f1 input g1 f* two-pole
+ f2 input g2 f* two-pole f+
+ f3 input g3 f* two-pole f+
+ end-run
+ then
;instrument
: resflt-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur #f \ start dur driver
- 0 0 #f 0.1 200 230 10 \ ranfreq noiamp noifun cosamp cosfreq1 cosfreq0 cosnum
- '( 0 0 50 1 100 0 ) '( 0 0 100 1 ) \ ampcosfun freqcosfun
- 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1
- :degree 90.0 random resflt
- dur 0.2 f+ step
- now@ dur #t \ start dur driver
- 10000 0.01 '( 0 0 50 1 100 0 ) 0 0 0 0 \ ranfreq noiamp noifun cosamp cosfreq1 cosfreq0 cosnum
- #f #f \ ampcosfun freqcosfun
- 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1
- :degree 90.0 random resflt
- dur 0.2 f+ step
+ start now!
+ now@ dur #f \ start dur driver
+ 0 0 #f 0.1 \ ranfreq noiamp noifun cosamp
+ 200 230 10 \ cosfreq1 cosfreq0 cosnum
+ '( 0 0 50 1 100 0 ) \ ampcosfun
+ '( 0 0 100 1 ) \ freqcosfun
+ 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1
+ :degree 90.0 random resflt
+ dur 0.2 f+ step
+ now@ dur #t \ start dur driver
+ 10000 0.01 \ ranfreq noiamp
+ '( 0 0 50 1 100 0 ) \ noifun
+ 0 0 0 0 \ cosamp cosfreq1 cosfreq0 cosnum
+ #f #f \ ampcosfun freqcosfun
+ 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1
+ :degree 90.0 random resflt
+ dur 0.2 f+ step
;
hide
-: scratch-input-cb { rd samp -- proc ; dir self -- r }
- 1 proc-create samp , rd ,
- does> { dir self -- r }
- self @ { samp }
- self cell+ @ { rd }
- rd samp 0 file->sample \ (file->sample rd samp 0)
- dir self +! \ samp += dir
+: scratch-input-cb { rd samp -- prc ; dir self -- r }
+ 1 proc-create ( prc )
+ samp , rd ,
+ does> { dir self -- r }
+ self @ { samp }
+ self cell+ @ { rd }
+ rd samp 0 file->sample \ (file->sample rd samp 0)
+ dir self +! \ samp += dir
;
set-current
\ SCRATCH-INS
instrument: scratch-ins <{ start file src-ratio turntable -- }>
- file find-file to file
- file unless 'file-not-found $" %s: cannot find %S" #( get-func-name file ) fth-raise then
- file mus-sound-duration { dur }
- file make-readin { f }
- turntable 0 object-ref seconds->samples { cur-samp }
- turntable 1 object-ref seconds->samples { turn-samp }
- :input f cur-samp scratch-input-cb :srate src-ratio make-src { rd }
- src-ratio f0> { forwards }
- forwards turn-samp cur-samp < && if rd src-ratio fnegate set-mus-increment drop then
- 1 { turn-i }
- 0 { turning }
- 0.0 0.0 { last-val1 last-val2 }
- start dur #{ :degree 90.0 random } run-instrument
- turn-i turntable length >= if leave then
- rd 0.0 src { val }
- turning unless
- forwards cur-samp turn-samp >= && if
- 1
- else
- forwards 0= cur-samp turn-samp <= &&
- if
- -1
- else
- turning
+ file find-file to file
+ file unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name file ) fth-throw
then
- then to turning
- else
- last-val2 last-val1 f<= last-val1 val f>= &&
- last-val2 last-val1 f>= last-val1 val f<= && || if
- turn-i 1+ to turn-i
- turn-i turntable length < if
- turntable turn-i object-ref seconds->samples to turn-samp
- forwards negate to forwards
- rd rd mus-increment fnegate set-mus-increment drop
+ file mus-sound-duration { dur }
+ file make-readin { f }
+ turntable 0 object-ref seconds->samples { cur-samp }
+ turntable 1 object-ref seconds->samples { turn-samp }
+ :input f cur-samp scratch-input-cb :srate src-ratio make-src { rd }
+ src-ratio f0> { forwards }
+ forwards
+ turn-samp cur-samp < && if
+ rd src-ratio fnegate set-mus-increment drop
then
- 0 to turning
- then
- then
- last-val1 to last-val2
- val to last-val1
- val
- end-run
- f mus-close drop
+ 1 { turn-i }
+ 0 { turning }
+ 0.0 0.0 { last-val1 last-val2 }
+ start dur #{ :degree 90.0 random } run-instrument
+ turn-i turntable length >= ?leave
+ rd 0.0 undef src { val }
+ turning unless
+ forwards
+ cur-samp turn-samp >= && if
+ 1
+ else
+ forwards false?
+ cur-samp turn-samp <= && if
+ -1
+ else
+ turning
+ then
+ then to turning
+ else
+ last-val2 last-val1 f<= last-val1 val f>= &&
+ last-val2 last-val1 f>= last-val1 val f<= && || if
+ turn-i 1+ to turn-i
+ turn-i turntable length < if
+ turntable turn-i object-ref
+ seconds->samples to turn-samp
+ forwards not to forwards
+ rd rd mus-increment fnegate
+ set-mus-increment drop
+ then
+ 0 to turning
+ then
+ then
+ last-val1 to last-val2
+ val to last-val1
+ val
+ end-run
+ f mus-close drop
;instrument
previous
: scratch-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- start "fyow.snd" dur 1.5 fmin #( 0 0.5 0.25 1 ) scratch-ins
- "fyow.snd" find-file mus-sound-duration 0.2 f+ step
+ start now!
+ start "fyow.snd" dur 1.5 fmin #( 0 0.5 0.25 1 ) scratch-ins
+ "fyow.snd" find-file mus-sound-duration 0.2 f+ step
;
\ PINS
-\
+\
\ spectral modeling (SMS)
-instrument: pins <{ start dur file amp
- :key
- transposition 1.0
- time-scaler 1.0
- fftsize 256
- highest-bin 128
- max-peaks 16
- attack #f -- }>
- doc" start dur \"fyow.snd\" 1.0 :time-scaler 2.0 pins"
- file find-file to file
- file unless 'file-not-found $" %s: cannot find %S" #( get-func-name file ) fth-raise then
- file mus-sound-duration { fdur }
- dur time-scaler f/ { sdur }
- sdur fdur f> if
- 'forth-error
- $" %s is %.3f seconds long, but we'll need %.3f seconds of data for this note"
- #( file fdur sdur ) fth-raise
- then
- file make-readin { fil }
- fftsize make-vct { fdr }
- fftsize make-vct { fdi }
- blackman2-window fftsize 0.0 0.0 make-fft-window { win }
- fftsize make-vct { fftamps }
- max-peaks 2* { max-oscils }
- max-oscils make-vct { current-peak-freqs }
- max-oscils make-vct { last-peak-freqs }
- max-oscils make-vct { current-peak-amps }
- max-oscils make-vct { last-peak-amps }
- max-peaks make-vct { peak-amps }
- max-peaks make-vct { peak-freqs }
- max-oscils make-array map! :frequency 0.0 make-oscil end-map { resynth-oscils }
- max-oscils make-vct { ampls }
- max-oscils make-vct { rates }
- max-oscils make-vct { freqs }
- max-oscils make-vct { sweeps }
- fftsize 4.0 f/ fround->s { hop }
- time-scaler hop f* fround->s { outhop }
- outhop 1/f { ifreq }
- ifreq hz->radians { ihifreq }
- mus-srate fftsize f/ { fft-mag }
- max-oscils { cur-oscils }
- attack if attack else 0 then { ramped }
- attack { splice-attack }
- attack if attack else 1 then { attack-size }
- 0.0 { ramp-ind }
- attack-size make-vct { ramped-attack }
- outhop { trigger }
- win fftsize 0.42323 f* 1/f vct-scale! drop
- 0 { filptr }
- start dur #{ :degree 90.0 random } run-instrument
- splice-attack if
- attack-size 1/f { ramp }
- fil filptr 0 file->sample amp f* ( outval )
- filptr 1+ to filptr
- filptr attack-size > if
- 1 { mult }
- ramped-attack map!
- fil filptr i + 0 file->sample mult f*
- mult ramp f- to mult
- end-map drop
- #f to splice-attack
- then
- ( outval )
- else
- trigger outhop >= if
- 0 { peaks }
- 0 to trigger
- fdr map! fil filptr i + 0 file->sample win i vct-ref f* end-map drop
- filptr fdr vct-length + to filptr
- fdi 0.0 vct-fill! drop
- filptr fftsize hop - - to filptr
- fdr fdi fftsize 1 mus-fft drop
- highest-bin 0 ?do
- fftamps i fdr i vct-ref dup f* fdi i vct-ref dup f* f+ fsqrt f2* vct-set! drop
- loop
- current-peak-freqs each { fv }
- current-peak-amps i vct-ref { av }
- last-peak-freqs i fv vct-set! drop
- last-peak-amps i av vct-set! drop
- current-peak-amps i 0.0 vct-set! drop
- end-each
- peak-amps 0.0 vct-fill! drop
- fftamps 0 vct-ref { ra }
- 0.0 0.0 { la ca }
- highest-bin 0 ?do
- ca to la
- ra to ca
- fftamps i vct-ref to ra
- ca 0.001 f>
- ca ra f> &&
- ca la f> && if
- la flog10 ra flog10 f- f2/ la flog10 -2.0 ca flog10 f* f+ ra flog10 f+ f/ { offset }
- 10.0 ca flog10 0.25 la flog10 ra flog10 f- f* offset f* f- f** { amp-1 }
- fft-mag i offset -1.0 f+ f+ f* { freq }
- peaks max-peaks = if
- 0 { minp }
- peak-amps 0 vct-ref { minpeak }
- max-peaks 1 ?do
- peak-amps i vct-ref minpeak f< if
- i to minp
- peak-amps i vct-ref to minpeak
- then
- loop
- amp-1 minpeak f> if
- peak-freqs minp freq vct-set! drop
- peak-amps minp amp-1 vct-set! drop
- then
- else
- peak-freqs peaks freq vct-set! drop
- peak-amps peaks amp-1 vct-set! drop
- peaks 1+ to peaks
- then
- then
- loop
- peaks 0 ?do
- 0 { maxp }
- peak-amps 0 vct-ref ( maxpk )
- max-peaks 1 ?do
- peak-amps i vct-ref over f> if
- i to maxp
- drop ( maxpk )
- peak-amps i vct-ref ( maxpk )
- then
- loop
- ( maxpk ) f0> if
- -1 { closestp }
- 10 { closestamp }
- peak-freqs maxp vct-ref { cur-freq }
- cur-freq 1/f { icf }
- max-peaks 0 ?do
- last-peak-amps i vct-ref f0> if
- icf last-peak-freqs i vct-ref cur-freq f- fabs f* { closeness }
- closeness closestamp f< if
- closeness to closestamp
- i to closestp
- then
- then
- loop
- closestamp 0.1 f< if
- current-peak-amps closestp peak-amps maxp vct-ref vct-set! drop
- peak-amps maxp 0.0 vct-set! drop
- current-peak-freqs closestp cur-freq vct-set! drop
- then
- then
- loop
- max-peaks 0 ?do
- peak-amps i vct-ref f0> if
- -1 { new-place }
- max-oscils 0 ?do
- last-peak-amps i vct-ref f0= current-peak-amps i vct-ref f0= && if
- i to new-place
- leave
- then
- loop
- current-peak-amps new-place peak-amps i vct-ref vct-set! drop
- peak-amps i 0.0 vct-set! drop
- current-peak-freqs new-place peak-freqs i vct-ref vct-set! drop
- last-peak-freqs new-place peak-freqs i vct-ref vct-set! drop
- resynth-oscils new-place array-ref ( gen )
- transposition peak-freqs i vct-ref f* ( val )
- set-mus-frequency drop
- then
- loop
- 0 to cur-oscils
- max-oscils 0 ?do
- rates i current-peak-amps i vct-ref last-peak-amps i vct-ref f- ifreq f* vct-set! drop
- current-peak-amps i vct-ref f0<> last-peak-amps i vct-ref f0<> || if
- i to cur-oscils
- then
- sweeps i
- current-peak-freqs i vct-ref last-peak-freqs i vct-ref f- transposition f* ihifreq f*
- vct-set! drop
- loop
- cur-oscils 1+ to cur-oscils
- then
- trigger 1+ to trigger
- ramped 0= if
- 0.0 ( sum )
- else
- ramped-attack ramp-ind vct-ref ( sum )
- ramp-ind 1+ to ramp-ind
- ramp-ind ramped = if 0 to ramp-ind then
- then ( sum )
- cur-oscils 0 ?do
- ampls i vct-ref f0<> rates i vct-ref f0<> || if
- resynth-oscils i array-ref freqs i vct-ref 0.0 oscil
- ampls i vct-ref f* f+ ( sum += ... )
- ampls i rates i vct-ref object-set+!
- freqs i sweeps i vct-ref object-set+!
+instrument: pins <{ start dur file amp :key
+ transposition 1.0
+ time-scaler 1.0
+ fftsize 256
+ highest-bin 128
+ max-peaks 16
+ attack #f -- }>
+ doc" start dur \"fyow.snd\" 1.0 :time-scaler 2.0 pins."
+ file find-file to file
+ file unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name file ) fth-throw
+ then
+ file mus-sound-duration { fdur }
+ dur time-scaler f/ { sdur }
+ sdur fdur f> if
+ 'forth-error
+ #( "%s is %.3f secs long, \
+but we'll need %.3f secs of data for this note" file fdur sdur ) fth-throw
then
- loop
- amp ( sum ) f*
- then
- end-run
+ file make-readin { fil }
+ fftsize make-vct { fdr }
+ fftsize make-vct { fdi }
+ blackman2-window fftsize 0.0 0.0 make-fft-window { win }
+ fftsize make-vct { fftamps }
+ max-peaks 2* { max-oscils }
+ max-oscils make-vct { current-peak-freqs }
+ max-oscils make-vct { last-peak-freqs }
+ max-oscils make-vct { current-peak-amps }
+ max-oscils make-vct { last-peak-amps }
+ max-peaks make-vct { peak-amps }
+ max-peaks make-vct { peak-freqs }
+ max-oscils make-array map!
+ :frequency 0.0 make-oscil
+ end-map { resynth-oscils }
+ max-oscils make-vct { ampls }
+ max-oscils make-vct { rates }
+ max-oscils make-vct { freqs }
+ max-oscils make-vct { sweeps }
+ fftsize 4.0 f/ fround->s { hop }
+ time-scaler hop f* fround->s { outhop }
+ outhop 1/f { ifreq }
+ ifreq hz->radians { ihifreq }
+ mus-srate fftsize f/ { fft-mag }
+ max-oscils { cur-oscils }
+ attack if
+ attack
+ else
+ 0
+ then { ramped }
+ attack { splice-attack }
+ attack if
+ attack
+ else
+ 1
+ then { attack-size }
+ 0.0 { ramp-ind }
+ attack-size make-vct { ramped-attack }
+ outhop { trigger }
+ win fftsize 0.42323 f* 1/f vct-scale! drop
+ 0 { filptr }
+ start dur #{ :degree 90.0 random } run-instrument
+ splice-attack if
+ attack-size 1/f { ramp }
+ fil filptr 0 file->sample amp f* ( outval )
+ filptr 1+ to filptr
+ filptr attack-size > if
+ 1 { mult }
+ ramped-attack map!
+ fil filptr i + 0 file->sample mult f*
+ mult ramp f- to mult
+ end-map drop
+ #f to splice-attack
+ then
+ ( outval )
+ else
+ trigger outhop >= if
+ 0 { peaks }
+ 0 to trigger
+ fdr map!
+ fil filptr i + 0 file->sample
+ win i vct-ref f*
+ end-map drop
+ filptr fdr vct-length + to filptr
+ fdi 0.0 vct-fill! drop
+ filptr fftsize hop - - to filptr
+ fdr fdi fftsize 1 mus-fft drop
+ highest-bin 0 ?do
+ fftamps i
+ fdr i vct-ref dup f*
+ fdi i vct-ref dup f* f+
+ fsqrt f2*
+ vct-set! drop
+ loop
+ current-peak-freqs each { fv }
+ current-peak-amps i vct-ref { av }
+ last-peak-freqs i fv vct-set! drop
+ last-peak-amps i av vct-set! drop
+ current-peak-amps i 0.0 vct-set! drop
+ end-each
+ peak-amps 0.0 vct-fill! drop
+ fftamps 0 vct-ref { ra }
+ 0.0 0.0 { la ca }
+ highest-bin 0 ?do
+ ca to la
+ ra to ca
+ fftamps i vct-ref to ra
+ ca 0.001 f>
+ ca ra f> &&
+ ca la f> && if
+ la flog10 ra flog10 f- f2/
+ la flog10 -2.0 ca flog10
+ f* f+ ra flog10
+ f+ f/ { offset }
+ 10.0 ca flog10
+ 0.25 la flog10
+ ra flog10 f- f* offset
+ f* f- f** { amp-1 }
+ fft-mag i offset -1.0
+ f+ f+ f* { freq }
+ peaks max-peaks = if
+ 0 { minp }
+ peak-amps 0
+ vct-ref { minpeak }
+ max-peaks 1 ?do
+ peak-amps i
+ vct-ref
+ minpeak f< if
+ i to minp
+ peak-amps i
+ vct-ref to
+ minpeak
+ then
+ loop
+ amp-1 minpeak f> if
+ peak-freqs minp
+ freq
+ vct-set! drop
+ peak-amps minp
+ amp-1
+ vct-set! drop
+ then
+ else
+ peak-freqs peaks
+ freq vct-set! drop
+ peak-amps peaks
+ amp-1 vct-set! drop
+ peaks 1+ to peaks
+ then
+ then
+ loop
+ peaks 0 ?do
+ 0 { maxp }
+ peak-amps 0 vct-ref ( maxpk )
+ max-peaks 1 ?do
+ peak-amps i vct-ref over f> if
+ i to maxp
+ drop ( maxpk )
+ peak-amps
+ i vct-ref ( maxpk )
+ then
+ loop
+ ( maxpk ) f0> if
+ -1 { closestp }
+ 10 { closestamp }
+ peak-freqs maxp
+ vct-ref { cur-freq }
+ cur-freq 1/f { icf }
+ max-peaks 0 ?do
+ last-peak-amps
+ i vct-ref f0> if
+ icf
+ last-peak-freqs
+ i
+ vct-ref
+ cur-freq f-
+ fabs f*
+ { closeness }
+ closeness
+ closestamp f< if
+ closeness to
+ closestamp
+ i to
+ closestp
+ then
+ then
+ loop
+ closestamp 0.1 f< if
+ current-peak-amps
+ closestp
+ peak-amps maxp vct-ref
+ vct-set! drop
+ peak-amps maxp 0.0
+ vct-set! drop
+ current-peak-freqs
+ closestp cur-freq
+ vct-set! drop
+ then
+ then
+ loop
+ max-peaks 0 ?do
+ peak-amps i vct-ref f0> if
+ -1 { new-place }
+ max-oscils 0 ?do
+ last-peak-amps
+ i vct-ref f0=
+ current-peak-amps
+ i vct-ref f0= && if
+ i to new-place
+ leave
+ then
+ loop
+ current-peak-amps new-place
+ peak-amps i vct-ref
+ vct-set! drop
+ peak-amps i 0.0 vct-set! drop
+ current-peak-freqs new-place
+ peak-freqs i vct-ref
+ vct-set! drop
+ last-peak-freqs new-place
+ peak-freqs i vct-ref
+ vct-set! drop
+ resynth-oscils new-place
+ array-ref ( gen )
+ transposition peak-freqs
+ i vct-ref f* ( val )
+ set-mus-frequency drop
+ then
+ loop
+ 0 to cur-oscils
+ max-oscils 0 ?do
+ rates i
+ current-peak-amps i vct-ref
+ last-peak-amps i vct-ref f-
+ ifreq f*
+ vct-set! drop
+ current-peak-amps i vct-ref f0<>
+ last-peak-amps i vct-ref f0<> || if
+ i to cur-oscils
+ then
+ sweeps i
+ current-peak-freqs i vct-ref
+ last-peak-freqs i vct-ref f-
+ transposition f* ihifreq f*
+ vct-set! drop
+ loop
+ cur-oscils 1+ to cur-oscils
+ then
+ trigger 1+ to trigger
+ ramped 0= if
+ 0.0 ( sum )
+ else
+ ramped-attack ramp-ind vct-ref ( sum )
+ ramp-ind 1+ to ramp-ind
+ ramp-ind ramped = if
+ 0 to ramp-ind
+ then
+ then ( sum )
+ cur-oscils 0 ?do
+ ampls i vct-ref f0<>
+ rates i vct-ref f0<> || if
+ resynth-oscils i array-ref
+ freqs i vct-ref
+ 0.0 oscil
+ ampls i vct-ref f* f+ ( sum += ... )
+ ampls i rates i vct-ref object-set+!
+ freqs i sweeps i vct-ref object-set+!
+ then
+ loop
+ amp ( sum ) f*
+ then
+ end-run
;instrument
: pins-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur "fyow.snd" 1.0 :time-scaler 2.0 pins
- dur 0.2 f+ step
+ start now!
+ now@ dur "fyow.snd" 1.0 :time-scaler 2.0 pins
+ dur 0.2 f+ step
;
\ ZC
instrument: zc <{ start dur freq amp len1 len2 feedback -- }>
- :frequency freq make-pulse-train { s }
- :size len1 :scaler feedback :max-size len1 len2 max 1+ make-comb { d0 }
- :envelope #( 0 0 1 1 ) :scaler len2 len1 f- :duration dur make-env { zenv }
- start dur #{ :degree 90.0 random } run-instrument
- d0 s 0.0 pulse-train amp f* zenv env comb
- end-run
+ :frequency freq make-pulse-train { s }
+ :size len1
+ :scaler feedback
+ :max-size len1 len2 max 1+ make-comb { d0 }
+ :envelope #( 0 0 1 1 )
+ :scaler len2 len1 f-
+ :duration dur make-env { zenv }
+ start dur #{ :degree 90.0 random } run-instrument
+ d0 s 0.0 pulse-train amp f* zenv env comb
+ end-run
;instrument
: zc-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 100 0.4 20 100 0.95 zc
- dur 0.2 f+ step
- now@ dur 100 0.4 100 20 0.95 zc
- dur 0.2 f+ step
+ start now!
+ now@ dur 100 0.4 20 100 0.95 zc
+ dur 0.2 f+ step
+ now@ dur 100 0.4 100 20 0.95 zc
+ dur 0.2 f+ step
;
\ ZN
-\
+\
\ notches are spaced at srate/len, feedforward sets depth thereof so
\ sweep of len from 20 to 100 sweeps the notches down from 1000 Hz to
\ ca 200 Hz so we hear our downward glissando beneath the pulses.
instrument: zn <{ start dur freq amp len1 len2 feedforward -- }>
- :frequency freq make-pulse-train { s }
- :size len1 :scaler feedforward :max-size len1 len2 max 1+ make-notch { d0 }
- :envelope #( 0 0 1 1 ) :scaler len2 len1 f- :duration dur make-env { zenv }
- start dur #{ :degree 90.0 random } run-instrument
- d0 s 0.0 pulse-train amp f* zenv env notch
- end-run
+ :frequency freq make-pulse-train { s }
+ :size len1
+ :scaler feedforward
+ :max-size len1 len2 max 1+ make-notch { d0 }
+ :envelope #( 0 0 1 1 )
+ :scaler len2 len1 f-
+ :duration dur make-env { zenv }
+ start dur #{ :degree 90.0 random } run-instrument
+ d0 s 0.0 pulse-train amp f* zenv env notch
+ end-run
;instrument
: zn-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 100 0.5 20 100 0.95 zn
- dur 0.2 f+ step
- now@ dur 100 0.5 100 20 0.95 zn
- dur 0.2 f+ step
+ start now!
+ now@ dur 100 0.5 20 100 0.95 zn
+ dur 0.2 f+ step
+ now@ dur 100 0.5 100 20 0.95 zn
+ dur 0.2 f+ step
;
\ ZA
instrument: za <{ start dur freq amp len1 len2 fb ffw -- }>
- :frequency freq make-pulse-train { s }
- :size len1 :feedback fb :feedforward ffw :max-size len1 len2 max 1+ make-all-pass { d0 }
- :envelope #( 0 0 1 1 ) :scaler len2 len1 f- :duration dur make-env { zenv }
- start dur #{ :degree 90.0 random } run-instrument
- d0 s 0.0 pulse-train amp f* zenv env all-pass
- end-run
+ :frequency freq make-pulse-train { s }
+ :size len1
+ :feedback fb
+ :feedforward ffw
+ :max-size len1 len2 max 1+ make-all-pass { d0 }
+ :envelope #( 0 0 1 1 )
+ :scaler len2 len1 f-
+ :duration dur make-env { zenv }
+ start dur #{ :degree 90.0 random } run-instrument
+ d0 s 0.0 pulse-train amp f* zenv env all-pass
+ end-run
;instrument
: za-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 100 0.3 20 100 0.95 0.95 za
- dur 0.2 f+ step
- now@ dur 100 0.3 100 20 0.95 0.95 za
- dur 0.2 f+ step
+ start now!
+ now@ dur 100 0.3 20 100 0.95 0.95 za
+ dur 0.2 f+ step
+ now@ dur 100 0.3 100 20 0.95 0.95 za
+ dur 0.2 f+ step
;
hide
-: clm-src-cb { gen -- proc; dir self -- r }
- 1 proc-create gen ,
- does> ( dir self -- r )
- nip @ ( gen ) #f #f granulate
+: clm-src-cb { gen -- prc; dir self -- r }
+ 1 proc-create ( prc )
+ gen ,
+ does> { dir self -- r }
+ self @ ( gen ) #f #f granulate
;
set-current
\ CLM-EXPSRC
-instrument: clm-expsrc <{ start dur in-file exp-ratio src-ratio amp
- :optional
- rev #f
- start-in-file 0 -- }>
- in-file find-file to in-file
- in-file unless 'file-not-found $" %s: cannot find %S" #( get-func-name in-file ) fth-raise then
- start-in-file in-file mus-sound-srate f* fround->s { stf }
- :file in-file :channel 0 :start stf make-readin { fdA }
- :input fdA readin-cb :expansion exp-ratio make-granulate { exA }
- in-file mus-sound-chans 2 = *output* mus-channels 2 = && { two-chans }
- two-chans if :file in-file :channel 1 :start stf make-readin else #f then { fdB }
- :input fdB readin-cb :expansion exp-ratio make-granulate { exB }
- :input exA clm-src-cb :srate src-ratio make-src { srcA }
- two-chans if :input exB clm-src-cb :srate src-ratio make-src else #f then { srcB }
- *reverb* rev && { revit }
- revit if two-chans if rev f2/ else rev then else 0.0 then { rev-amp }
- start dur run
- srcA 0.0 src amp f* { valA }
- two-chans if srcB 0.0 src amp f* else 0.0 then { valB }
- i valA 0 *output* out-any drop
- two-chans if i valB 1 *output* out-any drop then
- revit if i valA valB f+ rev-amp f* 0 *reverb* out-any drop then
- loop
+instrument: clm-expsrc <{ start dur in-file exp-ratio src-ratio amp :optional
+ rev #f
+ start-in-file 0 -- }>
+ in-file find-file to in-file
+ in-file unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name in-file ) fth-throw
+ then
+ start-in-file in-file mus-sound-srate f* fround->s { stf }
+ :file in-file :channel 0 :start stf make-readin { fdA }
+ :input fdA readin-cb :expansion exp-ratio make-granulate { exA }
+ :input exA clm-src-cb :srate src-ratio make-src { srcA }
+ in-file channels 2 = *output* channels 2 = && { two-chans }
+ *reverb* rev && { revit }
+ two-chans if
+ :file in-file :channel 1 :start stf make-readin { fdB }
+ :input fdB readin-cb :expansion exp-ratio make-granulate { exB }
+ :input exB clm-src-cb :srate src-ratio make-src { srcB }
+ revit if
+ rev f2/ to rev
+ start dur run
+ srcA 0.0 undef src amp f* { valA }
+ srcB 0.0 undef src amp f* { valB }
+ i valA *output* outa drop
+ i valB *output* outb drop
+ i valA valB f+ rev f* *reverb* outa drop
+ loop
+ else
+ start dur run
+ i srcA 0.0 undef src amp f* *output* outa drop
+ i srcB 0.0 undef src amp f* *output* outb drop
+ loop
+ then
+ else
+ revit if
+ start dur run
+ srcA 0.0 undef src amp f* { valA }
+ i valA *output* outa drop
+ i valA rev f* *reverb* outa drop
+ loop
+ else
+ start dur run
+ i srcA 0.0 undef src amp f* *output* outa drop
+ loop
+ then
+ then
;instrument
previous
: clm-expsrc-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur "oboe.snd" 2.0 1.0 1.0 clm-expsrc
- dur 0.2 f+ step
+ start now!
+ now@ dur "oboe.snd" 2.0 1.0 1.0 clm-expsrc
+ dur 0.2 f+ step
;
\ EXP-SND
-instrument: exp-snd <{ file start dur amp
- :optional
- exp-amt 1.0
- ramp 0.4
- seglen 0.15
- sr 1.0
- hop 0.05
- ampenv #f -- }>
- doc" \n\
-\\ ;; granulate with envelopes on the expansion amount, segment envelope shape,\n\
-\\ ;; segment length, hop length, and input file resampling rate\n\
-\"fyow.snd\" 0 3 1 #( 0 1 1 3 ) 0.4 0.15 #( 0 2 1 0.5 ) 0.05 <'> exp-snd with-sound\n\
-\"oboe.snd\" 0 3 1 #( 0 1 1 3 ) 0.4 0.15 #( 0 2 1 0.5 ) 0.2 <'> exp-snd with-sound"
- file find-file to file
- file unless 'file-not-found $" %s: cannot find %S" #( get-func-name file ) fth-raise then
- file 0 make-readin { f0 }
- :envelope exp-amt array? if exp-amt else #( 0 exp-amt 1 exp-amt ) then
- :duration dur make-env { expenv }
- :envelope seglen array? if seglen else #( 0 seglen 1 seglen ) then
- :duration dur make-env { lenenv }
- seglen if
- seglen array? if seglen max-envelope else seglen then
- else
- 0.15
- then { max-seg-len }
- seglen if
- seglen array? if seglen 1 array-ref else seglen then
- else
- 0.15
- then { initial-seg-len }
- max-seg-len 0.15 f> if 0.6 0.15 f* max-seg-len f/ else 0.6 then { scaler-amp }
- :envelope sr array? if sr else #( 0 sr 1 sr ) then
- :duration dur make-env { srenv }
- ramp array? if ramp else #( 0 ramp 1 ramp ) then { rampdata }
- :envelope rampdata :duration dur make-env { rampenv }
- ramp if
- ramp array? if ramp 1 array-ref else ramp then
- else
- 0.4
- then { initial-ramp-time }
- :envelope hop array? if hop else #( 0 hop 1 hop ) then
- :duration dur make-env { hopenv }
- hop if
- hop array? if hop max-envelope else hop then
- else
- 0.05
- then { max-out-hop }
- hop if
- hop array? if hop 1 array-ref else hop then
- else
- 0.05
- then { initial-out-hop }
- exp-amt if
- exp-amt array? if exp-amt min-envelope else exp-amt then
- else
- 1.0
- then { min-exp-amt }
- exp-amt if
- exp-amt array? if exp-amt 1 array-ref else exp-amt then
- else
- 1.0
- then { initial-exp-amt }
- max-out-hop min-exp-amt f/ { max-in-hop }
- :envelope ampenv #( 0 0 0.5 1 1 0 ) || :scaler amp :duration dur make-env { ampe }
- :input f0 readin-cb
- :expansion initial-exp-amt
- :max-size max-out-hop max-in-hop fmax max-seg-len f+ mus-srate f* fceil f>s
- :ramp initial-ramp-time
- :hop initial-out-hop
- :length initial-seg-len
- :scaler scaler-amp make-granulate { ex-a }
- ampe env { vol }
- ex-a granulate vol f* { val-a0 }
- ex-a granulate vol f* { val-a1 }
- rampdata min-envelope f0<= rampdata max-envelope 0.5 f>= || if
- 'forth-error
- $" ramp argument to expand must always be between 0.0 and 0.5, %.3f -- %.3f"
- #( rampdata min-envelope rampdata max-envelope ) fth-raise
- then
- 0.0 0.0 { ex-samp next-samp }
- 0.0 0.0 0.0 0.0 0.0 { expa segl resa rmpl hp }
- 0 0 { sl rl }
- start dur #{ :degree 90.0 random } run-instrument
- expenv env to expa
- lenenv env to segl
- srenv env to resa
- rampenv env to rmpl
- hopenv env to hp
- segl mus-srate f* floor dup f>s to sl
- ( fsl ) rmpl f* floor f>s to rl
- ampe env to vol
- ex-a sl set-mus-length drop
- ex-a rl set-mus-ramp drop
- ex-a hp set-mus-frequency drop
- ex-a expa set-mus-increment drop
- resa next-samp f+ to next-samp
- next-samp ex-samp 1.0 f+ f> if
- next-samp ex-samp f- fround->s 0 ?do
- val-a1 to val-a0
- ex-a granulate vol f* to val-a1
- 1.0 ex-samp f+ to ex-samp
- loop
- then
- next-samp ex-samp f= if
- val-a0
- else
- next-samp ex-samp f- val-a1 val-a0 f- f* val-a0 f+
- then
- end-run
+instrument: exp-snd <{ file start dur amp :optional
+ exp-amt 1.0
+ ramp 0.4
+ seglen 0.15
+ sr 1.0
+ hop 0.05
+ ampenv #f -- }>
+ doc" \n\
+\\ ;; granulate with envelopes on the expansion amount,\n\
+\\ ;; segment envelope shape, segment length, hop length,\n\
+\\ ;; and input file resampling rate\n\
+\"fyow.snd\" 0 3 1 #( 0 1 1 3 ) 0.4 0.15\n\
+ #( 0 2 1 0.5 ) 0.05 <'> exp-snd with-sound\n\
+\"oboe.snd\" 0 3 1 #( 0 1 1 3 ) 0.4 0.15\n\
+ #( 0 2 1 0.5 ) 0.2 <'> exp-snd with-sound."
+ file find-file to file
+ file unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name file ) fth-throw
+ then
+ file 0 make-readin { f0 }
+ :envelope exp-amt array? if
+ exp-amt
+ else
+ #( 0 exp-amt 1 exp-amt )
+ then :duration dur make-env { expenv }
+ :envelope seglen array? if
+ seglen
+ else
+ #( 0 seglen 1 seglen )
+ then :duration dur make-env { lenenv }
+ seglen if
+ seglen array? if
+ seglen max-envelope
+ else
+ seglen
+ then
+ else
+ 0.15
+ then { max-seg-len }
+ seglen if
+ seglen array? if
+ seglen 1 array-ref
+ else
+ seglen
+ then
+ else
+ 0.15
+ then { initial-seg-len }
+ max-seg-len 0.15 f> if
+ 0.6 0.15 f* max-seg-len f/
+ else
+ 0.6
+ then { scaler-amp }
+ :envelope sr array? if
+ sr
+ else
+ #( 0 sr 1 sr )
+ then :duration dur make-env { srenv }
+ ramp array? if
+ ramp
+ else
+ #( 0 ramp 1 ramp )
+ then { rampdata }
+ :envelope rampdata :duration dur make-env { rampenv }
+ ramp if
+ ramp array? if
+ ramp 1 array-ref
+ else
+ ramp
+ then
+ else
+ 0.4
+ then { initial-ramp-time }
+ :envelope hop array? if
+ hop
+ else
+ #( 0 hop 1 hop )
+ then :duration dur make-env { hopenv }
+ hop if
+ hop array? if
+ hop max-envelope
+ else
+ hop
+ then
+ else
+ 0.05
+ then { max-out-hop }
+ hop if
+ hop array? if
+ hop 1 array-ref
+ else
+ hop
+ then
+ else
+ 0.05
+ then { initial-out-hop }
+ exp-amt if
+ exp-amt array? if
+ exp-amt min-envelope
+ else
+ exp-amt
+ then
+ else
+ 1.0
+ then { min-exp-amt }
+ exp-amt if
+ exp-amt array? if
+ exp-amt 1 array-ref
+ else
+ exp-amt
+ then
+ else
+ 1.0
+ then { initial-exp-amt }
+ max-out-hop min-exp-amt f/ { max-in-hop }
+ :envelope ampenv #( 0 0 0.5 1 1 0 ) ||
+ :scaler amp
+ :duration dur make-env { ampe }
+ :input f0 readin-cb
+ :expansion initial-exp-amt
+ :max-size max-out-hop max-in-hop fmax max-seg-len f+
+ mus-srate f* fceil f>s
+ :ramp initial-ramp-time
+ :hop initial-out-hop
+ :length initial-seg-len
+ :scaler scaler-amp make-granulate { ex-a }
+ ampe env { vol }
+ ex-a granulate vol f* { val-a0 }
+ ex-a granulate vol f* { val-a1 }
+ rampdata min-envelope f0<=
+ rampdata max-envelope 0.5 f>= || if
+ 'forth-error
+ #( "ramp arg to expand must always \
+be between 0.0 and 0.5, %.3f -- %.3f"
+ rampdata min-envelope
+ rampdata max-envelope ) fth-throw
+ then
+ 0.0 0.0 { ex-samp next-samp }
+ 0.0 0.0 0.0 0.0 0.0 { expa segl resa rmpl hp }
+ 0 0 { sl rl }
+ start dur #{ :degree 90.0 random } run-instrument
+ expenv env to expa
+ lenenv env to segl
+ srenv env to resa
+ rampenv env to rmpl
+ hopenv env to hp
+ segl mus-srate f* floor dup f>s to sl
+ ( fsl ) rmpl f* floor f>s to rl
+ ampe env to vol
+ ex-a sl set-mus-length drop
+ ex-a rl set-mus-ramp drop
+ ex-a hp set-mus-frequency drop
+ ex-a expa set-mus-increment drop
+ resa next-samp f+ to next-samp
+ next-samp ex-samp 1.0 f+ f> if
+ next-samp ex-samp f- fround->s 0 ?do
+ val-a1 to val-a0
+ ex-a granulate vol f* to val-a1
+ 1.0 ex-samp f+ to ex-samp
+ loop
+ then
+ next-samp ex-samp f= if
+ val-a0
+ else
+ next-samp ex-samp f- val-a1 val-a0 f- f* val-a0 f+
+ then
+ end-run
;instrument
: exp-snd-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- "fyow.snd" now@ dur 1.0 #( 0 1 1 3 ) 0.4 0.15 #( 0 2 1 0.5 ) 0.05 exp-snd
- dur 0.2 f+ step
- "oboe.snd" now@ dur 1.0 #( 0 1 1 3 ) 0.4 0.15 #( 0 2 1 0.5 ) 0.2 exp-snd
- dur 0.2 f+ step
+ start now!
+ "fyow.snd" now@ dur 1.0 #( 0 1 1 3 ) 0.4 0.15
+ #( 0 2 1 0.5 ) 0.05 exp-snd
+ dur 0.2 f+ step
+ "oboe.snd" now@ dur 1.0 #( 0 1 1 3 ) 0.4 0.15
+ #( 0 2 1 0.5 ) 0.2 exp-snd
+ dur 0.2 f+ step
;
-struct
- cell% field exp-rampval
- cell% field exp-rampinc
- cell% field exp-loc
- cell% field exp-segctr
- cell% field exp-whichseg
- cell% field exp-ramplen
- cell% field exp-steadylen
- cell% field exp-trigger
-end-struct grn%
+#( "exp-rampval"
+ "exp-rampinc"
+ "exp-loc"
+ "exp-segctr"
+ "exp-whichseg"
+ "exp-ramplen"
+ "exp-steadylen"
+ "exp-trigger" ) create-struct make-expfil-struct
\ EXPFIL
instrument: expfil <{ start dur hopsecs rampsecs steadysecs file1 file2 -- }>
- rampsecs seconds->samples { ramplen }
- grn% %alloc { grn1 }
- grn% %alloc { grn2 }
- 0.0 0.0 grn1 exp-rampval ! grn2 exp-rampval !
- ramplen 1/f dup grn1 exp-rampinc ! grn2 exp-rampinc !
- 0 0 grn1 exp-loc ! grn2 exp-loc !
- 0 0 grn1 exp-segctr ! grn2 exp-segctr !
- 0 0 grn1 exp-whichseg ! grn2 exp-whichseg !
- ramplen dup grn1 exp-ramplen ! grn2 exp-ramplen !
- steadysecs seconds->samples dup grn1 exp-steadylen ! grn2 exp-steadylen !
- 0 0 grn1 exp-trigger ! grn2 exp-trigger !
- hopsecs seconds->samples { hop }
- start seconds->samples { out1 }
- hop out1 + { out2 }
- file1 find-file to file1
- file1 unless 'file-not-found $" %s: cannot find %S" #( get-func-name file1 ) fth-raise then
- file1 0 make-readin { fil1 }
- file2 find-file to file2
- file2 unless 'file-not-found $" %s: cannot find %S" #( get-func-name file2 ) fth-raise then
- file2 0 make-readin { fil2 }
- 0.0 { inval }
- start dur #{ :degree 90.0 random } run-instrument
- 0.0 ( val )
- i out1 = if
- fil1 grn1 exp-loc @ 0 file->sample to inval
- 1 grn1 exp-loc +!
- grn1 exp-whichseg @ case
- 0 of
- grn1 exp-rampval @ inval f* to inval
- grn1 exp-rampinc @ grn1 exp-rampval +!
- 1 grn1 exp-segctr +!
- grn1 exp-segctr @ grn1 exp-ramplen @ = if
- 0 grn1 exp-segctr !
- 1 grn1 exp-whichseg +!
- then
- endof
- 1 of
- 1 grn1 exp-segctr +!
- grn1 exp-segctr @ grn1 exp-steadylen @ = if
- 0 grn1 exp-segctr !
- 1 grn1 exp-whichseg +!
- then
- endof
- grn1 exp-rampval @ inval f* to inval
- 1 grn1 exp-segctr +!
- grn1 exp-rampinc @ fnegate grn1 exp-rampval +!
- grn1 exp-segctr @ grn1 exp-ramplen @ = if
- 0 grn1 exp-segctr !
- 1 grn1 exp-trigger !
- 0 grn1 exp-whichseg !
- 0.0 grn1 exp-rampval !
+ file1 find-file to file1
+ file1 unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name file1 ) fth-throw
then
- endcase
- inval f+ ( val )
- out1 1+ to out1
- grn1 exp-trigger @ 1 = if
- 0 grn1 exp-trigger !
- hop out1 + to out1
- then
- then
- i out2 = if
- fil2 grn2 exp-loc @ 0 file->sample { inval }
- 1 grn2 exp-loc +!
- grn2 exp-whichseg @ case
- 0 of
- grn2 exp-rampval @ inval f* to inval
- grn2 exp-rampinc @ grn2 exp-rampval +!
- 1 grn2 exp-segctr +!
- grn2 exp-segctr @ grn2 exp-ramplen @ = if
- 0 grn2 exp-segctr !
- 1 grn2 exp-whichseg +!
- then
- endof
- 1 of
- 1 grn2 exp-segctr +!
- grn2 exp-segctr @ grn2 exp-steadylen @ = if
- 0 grn2 exp-segctr !
- 1 grn2 exp-whichseg +!
- then
- endof
- grn2 exp-rampval @ inval f* to inval
- 1 grn2 exp-segctr +!
- grn2 exp-rampinc @ fnegate grn2 exp-rampval +!
- grn2 exp-segctr @ grn2 exp-ramplen @ = if
- 0 grn2 exp-segctr !
- 1 grn2 exp-trigger !
- 0 grn2 exp-whichseg !
- 0.0 grn2 exp-rampval !
+ file2 find-file to file2
+ file2 unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name file2 ) fth-throw
then
- endcase
- inval f+ ( val )
- out2 1+ to out2
- grn2 exp-trigger @ 1 = if
- 0 grn2 exp-trigger !
- hop out2 + to out2
- then
- then
- end-run
- grn1 free throw
- grn2 free throw
+ rampsecs seconds->samples { ramplen }
+ make-expfil-struct { grn1 }
+ make-expfil-struct { grn2 }
+ grn1 0.0 exp-rampval!
+ grn2 0.0 exp-rampval!
+ grn1 ramplen 1/f exp-rampinc!
+ grn2 ramplen 1/f exp-rampinc!
+ grn1 0 exp-loc!
+ grn2 0 exp-loc!
+ grn1 0 exp-segctr!
+ grn2 0 exp-segctr!
+ grn1 0 exp-whichseg!
+ grn2 0 exp-whichseg!
+ grn1 ramplen exp-ramplen!
+ grn2 ramplen exp-ramplen!
+ grn1 steadysecs seconds->samples exp-steadylen!
+ grn2 steadysecs seconds->samples exp-steadylen!
+ grn1 0 exp-trigger!
+ grn2 0 exp-trigger!
+ hopsecs seconds->samples { hop }
+ start seconds->samples { out1 }
+ hop out1 + { out2 }
+ file1 0 make-readin { fil1 }
+ file2 0 make-readin { fil2 }
+ 0.0 { inval }
+ start dur #{ :degree 90.0 random } run-instrument
+ 0.0 ( val )
+ i out1 = if
+ fil1 grn1 exp-loc@ 0 file->sample to inval
+ grn1 grn1 exp-loc@ 1+ exp-loc!
+ grn1 exp-whichseg@ case
+ 0 of
+ grn1 exp-rampval@ inval f* to inval
+ grn1 grn1 exp-rampinc@
+ grn1 exp-rampval@ f+ exp-rampval!
+ grn1 grn1 exp-segctr@ 1+ exp-segctr!
+ grn1 exp-segctr@ grn1 exp-ramplen@ = if
+ grn1 0 exp-segctr!
+ grn1 grn1 exp-whichseg@ 1+ exp-whichseg!
+ then
+ endof
+ 1 of
+ grn1 grn1 exp-segctr@ 1+ exp-segctr!
+ grn1 exp-segctr@ grn1 exp-steadylen@ = if
+ grn1 0 exp-segctr!
+ grn1 grn1 exp-whichseg@ 1+ exp-whichseg!
+ then
+ endof
+ \ default
+ grn1 exp-rampval@ inval f* to inval
+ grn1 grn1 exp-segctr@ 1+ exp-segctr!
+ grn1 grn1 exp-rampinc@ fnegate
+ grn1 exp-rampval@ f+ exp-rampval!
+ grn1 exp-segctr@ grn1 exp-ramplen@ = if
+ grn1 0 exp-segctr!
+ grn1 1 exp-trigger!
+ grn1 0 exp-whichseg!
+ grn1 0.0 exp-rampval!
+ then
+ endcase
+ inval f+ ( val )
+ out1 1+ to out1
+ grn1 exp-trigger@ 1 = if
+ grn1 0 exp-trigger!
+ hop out1 + to out1
+ then
+ then
+ i out2 = if
+ fil2 grn2 exp-loc@ 0 file->sample { inval }
+ grn2 grn2 exp-loc@ 1+ exp-loc!
+ grn2 exp-whichseg@ case
+ 0 of
+ grn2 exp-rampval@ inval f* to inval
+ grn2 grn2 exp-rampinc@
+ grn1 exp-rampval@ f+ exp-rampval!
+ grn2 grn2 exp-segctr@ 1+ exp-segctr!
+ grn2 exp-segctr@ grn2 exp-ramplen@ = if
+ grn2 0 exp-segctr!
+ grn2 grn2 exp-whichseg@ 1+ exp-whichseg!
+ then
+ endof
+ 1 of
+ grn2 grn2 exp-segctr@ 1+ exp-segctr!
+ grn2 exp-segctr@ grn2 exp-steadylen@ = if
+ grn2 0 exp-segctr!
+ grn2 grn2 exp-whichseg@ 1+ exp-whichseg!
+ then
+ endof
+ \ default
+ grn2 exp-rampval@ inval f* to inval
+ grn2 grn2 exp-segctr@ 1+ exp-segctr!
+ grn2 grn2 exp-rampinc@ fnegate
+ grn2 exp-rampval@ f+ exp-rampval!
+ grn2 exp-segctr@ grn2 exp-ramplen@ = if
+ grn2 0 exp-segctr!
+ grn2 1 exp-trigger!
+ grn2 0 exp-whichseg!
+ grn2 0.0 exp-rampval!
+ then
+ endcase
+ inval f+ ( val )
+ out2 1+ to out2
+ grn2 exp-trigger@ 1 = if
+ grn2 0 exp-trigger!
+ hop out2 + to out2
+ then
+ then
+ end-run
;instrument
: expfil-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 0.2 0.01 0.1 "oboe.snd" "fyow.snd" expfil
- dur 0.2 f+ step
+ start now!
+ now@ dur 0.2 0.01 0.1 "oboe.snd" "fyow.snd" expfil
+ dur 0.2 f+ step
;
\ GRAPH-EQ
-\
+\
\ From: Marco Trevisani <marco at ccrma.Stanford.EDU>
\
\ This should work like a Graphic Equalizer....
@@ -2845,8 +3584,8 @@ instrument: expfil <{ start dur hopsecs rampsecs steadysecs file1 file2 -- }>
\ "amp" & "amp-env" apply an enveloppe to the final result of the
\ filtering.
\
-\ "dur" as ""standard"" in my instruments, when dur = 0 it will take the length of the
-\ sndfile input, otherwise the duration in seconds.
+\ "dur" as ""standard"" in my instruments, when dur = 0 it will take the
+\ length of the sndfile input, otherwise the duration in seconds.
\
\ "gain-freq-list" is a list of gains and frequencies to
\ filter --in this order gain and frequencies--. There is no limit to
@@ -2858,89 +3597,100 @@ instrument: expfil <{ start dur hopsecs rampsecs steadysecs file1 file2 -- }>
\ #( .1 440.0 (0 1 1 .01) 1500 ..etc) <<< again, this is not allowed ..
\
\ "offset-gain" This apply to all the gains if case 1. It adds or
-\ subtracts an offset to all the gains in the list. This number can be positive or
-\ negative. In case the result is a negative number --let's say offset =
-\ -.4 and, like in case 1, the first gain is .1, the result would be
-\ -.3 -- the instrument will pass a gain equal to 0.
+\ subtracts an offset to all the gains in the list. This number can be
+\ positive or negative. In case the result is a negative number --let's
+\ say offset = -.4 and, like in case 1, the first gain is .1, the result
+\ would be -.3 -- the instrument will pass a gain equal to 0.
\
\ "filt-gain-scale" & "filt-gain-base" will apply to the elements of the
\ envelopes if we are in case 2, gains are envelopes.
-instrument: graph-eq <{ file start dur
- :key
- file-start 0.0
- amplitude 1.0
- amp-env #( 0 1 0.8 1 1 0 )
- amp-base 1.0
- offset-gain 0.0
- gain-freq-list #( #( 0 1 1 0 ) 440 #( 0 0 1 1 ) 660 )
- filt-gain-scale 1.0
- filt-gain-base 1.0
- a1 0.99 -- }>
- doc" \"oboe.snd\" 0 2 graph-eq"
- file find-file to file
- file unless 'file-not-found $" %s: cannot find %S" #( get-func-name file ) fth-raise then
- :file file :start file mus-sound-srate file-start f* fround->s make-readin { rd }
- :envelope amp-env :scaler amplitude :duration dur :base amp-base make-env { ampf }
- gain-freq-list length 2/ { len }
- len make-array { gainl }
- len make-array { freql }
- 0 { idx }
- gain-freq-list length 1- 0 ?do
- gainl idx gain-freq-list i array-ref array-set!
- freql idx gain-freq-list i 1+ array-ref array-set!
- idx 1+ to idx
- 2 +loop
- gainl 0 array-ref array? dup { if-list-in-gain } if
- len make-array map!
- :envelope gainl i array-ref
- :scaler filt-gain-scale
- :duration dur
- :base filt-gain-base make-env
- end-map
- else
- #f
- then { env-size }
- freql map :frequency *key* :radius a1 make-formant end-map { frm-size }
- len 1.0 make-vct { gains }
- gainl each { gval }
- freql i array-ref { fval }
- if-list-in-gain if
- :envelope gval
- :scaler filt-gain-scale
- :duration dur
- :base filt-gain-base make-env
- env-size i rot ( en ) array-set!
- frm-size i :frequency fval :radius a1 make-formant array-set!
- else
- frm-size i :frequency fval :radius a1 make-formant array-set!
- gains i
- offset-gain gval f+ f0< if
- 0.0
- else
- offset-gain gval f+
- then vct-set! drop
- then
- end-each
- 1.0 a1 f- { 1-a1 }
- start dur #{ :degree 90.0 random } run-instrument
- rd readin { inval }
- 0.0 ( outval )
- env-size each { en }
- if-list-in-gain if
- gains i en env 1-a1 f* vct-set! drop
- then
- gains i vct-ref
- frm-size i array-ref ( fmt ) inval undef formant f* f+ ( outval )
- end-each
- ampf env f* ( outval )
- end-run
- rd mus-close drop
+instrument: graph-eq <{ file start dur :key
+ file-start 0.0
+ amplitude 1.0
+ amp-env #( 0 1 0.8 1 1 0 )
+ amp-base 1.0
+ offset-gain 0.0
+ gain-freq-list #( #( 0 1 1 0 ) 440 #( 0 0 1 1 ) 660 )
+ filt-gain-scale 1.0
+ filt-gain-base 1.0
+ a1 0.99 -- }>
+ doc" \"oboe.snd\" 0 2 graph-eq."
+ file find-file to file
+ file unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name file ) fth-throw
+ then
+ :file file
+ :start file mus-sound-srate file-start f* fround->s
+ make-readin { rd }
+ :envelope amp-env
+ :scaler amplitude
+ :duration dur
+ :base amp-base make-env { ampf }
+ gain-freq-list length 2/ { len }
+ len make-array { gainl }
+ len make-array { freql }
+ 0 { idx }
+ gain-freq-list length 1- 0 ?do
+ gainl idx gain-freq-list i array-ref array-set!
+ freql idx gain-freq-list i 1+ array-ref array-set!
+ idx 1+ to idx
+ 2 +loop
+ gainl 0 array-ref array? dup { if-list-in-gain } if
+ len make-array map!
+ :envelope gainl i array-ref
+ :scaler filt-gain-scale
+ :duration dur
+ :base filt-gain-base make-env
+ end-map
+ else
+ #f
+ then { env-size }
+ freql map
+ :frequency *key* :radius a1 make-formant
+ end-map { frm-size }
+ len 1.0 make-vct { gains }
+ gainl each { gval }
+ freql i array-ref { fval }
+ if-list-in-gain if
+ :envelope gval
+ :scaler filt-gain-scale
+ :duration dur
+ :base filt-gain-base make-env
+ env-size i rot ( en ) array-set!
+ frm-size i :frequency fval
+ :radius a1 make-formant array-set!
+ else
+ frm-size i :frequency fval
+ :radius a1 make-formant array-set!
+ gains i offset-gain gval f+ f0< if
+ 0.0
+ else
+ offset-gain gval f+
+ then vct-set! drop
+ then
+ end-each
+ 1.0 a1 f- { 1-a1 }
+ start dur #{ :degree 90.0 random } run-instrument
+ rd readin { inval }
+ 0.0 ( outval )
+ env-size each { en }
+ if-list-in-gain if
+ gains i en env 1-a1 f* vct-set! drop
+ then
+ frm-size i array-ref ( fmt ) inval undef formant
+ gains i vct-ref f* ( fmt * gain )
+ f+ ( outval += ... )
+ end-each
+ ampf env f* ( outval )
+ end-run
+ rd mus-close drop
;instrument
: graph-eq-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- "oboe.snd" now@ dur :amplitude 50.0 graph-eq
- dur 0.2 f+ step
+ start now!
+ "oboe.snd" now@ dur :amplitude 50.0 graph-eq
+ dur 0.2 f+ step
;
\ ANOI
@@ -2951,54 +3701,71 @@ instrument: graph-eq <{ file start dur
\ this is based on Perry Cook's Scrubber.m
\
\ clm/anoi.ins
-instrument: anoi <{ fname start dur :optional fftsize 128 amp-scaler 1.0 R two-pi -- }>
- fftsize 2/ { freq-inc }
- fftsize 0.0 make-vct { fdr }
- fftsize 0.0 make-vct { fdi }
- freq-inc 1.0 make-vct { spectr }
- freq-inc 1.0 make-vct { scales }
- freq-inc 0.0 make-vct { diffs }
- blackman2-window fftsize undef undef make-fft-window { win }
- amp-scaler 4.0 f* mus-srate f/ { incr }
- 0.0 { amp }
- fname find-file to fname
- fname unless 'file-not-found $" %s: cannot find %S" #( get-func-name fname ) fth-raise then
- fname make-file->sample { fil }
- fftsize s>f to fftsize
- fftsize fnegate { -fftsize }
- 1.0 R fftsize f/ f- { radius }
- mus-srate fftsize f/ { bin }
- freq-inc make-array map! :frequency i bin f* :radius radius make-formant end-map { fs }
- 0 { samp }
- start dur #{ :degree 90.0 random } run-instrument
- fil samp 0 file->sample { inval }
- samp 1+ to samp
- fdr inval cycle-set!
- amp amp-scaler f< if incr amp f+ to amp then
- fdr cycle-start@ 0= if
- fdr fdi win 1 spectrum drop
- diffs map!
- fdr i vct-ref { fd }
- spectr i spectr i vct-ref 0.9 f* fd 0.1 f* f+ vct-set! ( sp ) fd f>= if
- scales i vct-ref -fftsize f/
- else
- fd spectr i vct-ref f- fd f/ scales i vct-ref f- fftsize f/
- then ( diff )
- end-map drop
- then
- 0.0 ( outval )
- fs each { fmt }
- scales i vct-ref { curscl }
- fmt inval undef formant curscl f* f+ ( outval += ... )
- scales i diffs i vct-ref curscl f+ vct-set! drop
- end-each ( outval ) amp f*
- end-run
+instrument: anoi <{ fname start dur :optional
+ fftsize 128
+ amp-scaler 1.0
+ R two-pi -- }>
+ fftsize 2/ { freq-inc }
+ fftsize 0.0 make-vct { fdr }
+ fftsize 0.0 make-vct { fdi }
+ freq-inc 1.0 make-vct { spectr }
+ freq-inc 1.0 make-vct { scales }
+ freq-inc 0.0 make-vct { diffs }
+ blackman2-window fftsize undef undef make-fft-window { win }
+ amp-scaler 4.0 f* mus-srate f/ { incr }
+ fname find-file to fname
+ fname unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name fname ) fth-throw
+ then
+ fname make-file->sample { fil }
+ fftsize s>f to fftsize
+ fftsize fnegate { -fftsize }
+ 1.0 R fftsize f/ f- { radius }
+ mus-srate fftsize f/ { bin }
+ freq-inc make-array map!
+ :frequency i bin f* :radius radius make-formant
+ end-map { fs }
+ 0 { samp }
+ 0.0 { inval }
+ nil { fmt }
+ 0.0 { curscl }
+ 0.0 { fd }
+ 0.0 { amp }
+ start dur #{ :degree 90.0 random } run-instrument
+ fil samp 0 file->sample to inval
+ samp 1+ to samp
+ fdr inval cycle-set!
+ amp amp-scaler f< if
+ incr amp f+ to amp
+ then
+ fdr cycle-start@ 0= if
+ fdr fdi win 1 spectrum drop
+ diffs map!
+ fdr i vct-ref to fd
+ spectr i
+ spectr i vct-ref 0.9 f* fd 0.1 f* f+
+ vct-set! ( sp ) fd f>= if
+ scales i vct-ref -fftsize f/
+ else
+ fd spectr i vct-ref f- fd f/
+ scales i vct-ref f- fftsize f/
+ then ( diff )
+ end-map drop
+ then
+ 0.0 ( outval )
+ fs each to fmt
+ scales i vct-ref to curscl
+ fmt inval undef formant curscl f* f+ ( outval += ... )
+ scales i diffs i vct-ref curscl f+ vct-set! drop
+ end-each ( outval ) amp f*
+ end-run
;instrument
: anoi-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- "fyow.snd" now@ dur 128 2.0 anoi
- dur 0.2 f+ step
+ start now!
+ "fyow.snd" now@ dur 128 2.0 anoi
+ dur 0.2 f+ step
;
\ Date: Fri, 25 Sep 1998 09:56:41 +0300
@@ -3022,318 +3789,414 @@ instrument: anoi <{ fname start dur :optional fftsize 128 amp-scaler 1.0 R two-p
\ -matti
\ mjkoskin at sci.fi
+\
+\ FIXME fullmix
+\ needs some more work
+\
+instrument: fullmix <{ in-file :optional
+ start 0.0
+ dur #f
+ inbeg 0.0
+ matrix #f
+ sr #f
+ rev-amount #f -- }>
+;
+
+: fullmix-test <{ :optional start 0.0 dur 1.0 -- }>
+;
+
+0 [if]
+hide
+: set-fullmix-matrix { outn mx inp outp in-chans out-chans dur -- envs }
+ #f { envs }
+ outn number? if
+ mx inp outp outn mixer-set! drop
+ else
+ outn env?
+ outn array? || if
+ in-chans make-array map!
+ out-chans make-array
+ end-map to envs
+ envs inp array-ref
+ outp
+ outn env? if
+ outn
+ else
+ :envelope outn :duration dur make-env
+ then array-set!
+ else
+ 'forth-error
+ #( "fullmix: unknown element in matrix: %S"
+ outn ) fth-throw
+ then
+ then
+ envs
+;
+set-current
+
\ FULLMIX
-instrument: fullmix <{ in-file
- :optional
- start 0.0
- dur #f
- inbeg 0.0
- matrix #f
- sr #f
- rev-amount #f -- }>
- doc" \"pistol.snd\" 0 1 fullmix\n\
-:envelope #( 0 0 1 1 ) :duration dur :scaler 0.5 make-env value en
-\"oboe.snd\" 0 2 0 #( #( 0.8 en ) ) 2.0 <'> fullmix with-sound"
- in-file find-file to in-file
- in-file unless 'file-not-found $" %s: cannot find %S" #( get-func-name in-file ) fth-raise then
- dur unless in-file mus-sound-duration inbeg f- sr if sr fabs else 1.0 then f/ to dur then
- in-file mus-sound-chans { in-chans }
- inbeg in-file mus-sound-srate f* fround->s { inloc }
- *output* mus-channels { out-chans }
- matrix if
- in-chans out-chans max make-mixer
- else
- in-chans out-chans max 1.0 make-scalar-mixer
- then { mx }
- *reverb* rev-amount f0> && if
- in-chans make-mixer { rmx }
- in-chans 0 ?do rmx i 0 rev-amount mixer-set! drop loop
- rmx
- else
- #f
- then { rev-mx }
- #f { envs }
- matrix if
- matrix object-length 0> if
- in-chans 0 ?do
- matrix i object-ref { inlist }
- out-chans 0 ?do
- inlist i object-ref { outn }
- outn if
- outn number? if
- mx j ( inp ) i ( outp ) outn mixer-set! drop
- else
- outn env? outn array? || if
- envs unless
- in-chans make-array map! out-chans make-array end-map to envs
+instrument: fullmix <{ in-file :optional
+ start 0.0
+ dur #f
+ inbeg 0.0
+ matrix #f
+ sr #f
+ rev-amount #f -- }>
+ doc" \"pistol.snd\" 0 1 fullmix\n\
+:envelope #( 0 0 1 1 ) :duration 2 :scaler 0.5 make-env value en
+\"oboe.snd\" 0 2 0 #( #( 0.8 en ) ) 2.0 <'> fullmix with-sound."
+ in-file find-file to in-file
+ in-file unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name in-file ) fth-throw
+ then
+ dur number? unless
+ in-file mus-sound-duration inbeg f-
+ sr if
+ sr fabs
+ else
+ 1.0
+ then f/ to dur
+ then
+ in-file channels { in-chans }
+ *output* channels { out-chans }
+ inbeg in-file mus-sound-srate f* fround->s { inloc }
+ matrix if
+ in-chans out-chans max make-mixer
+ else
+ in-chans out-chans max 1.0 make-scalar-mixer
+ then { mx }
+ #f { rev-mx }
+ *reverb*
+ rev-amount f0> && if
+ in-chans make-mixer to rev-mx
+ in-chans 0 ?do
+ rev-mx i 0 rev-amount mixer-set! drop
+ loop
+ then
+ #f { envs }
+ #f { inlist }
+ matrix if
+ matrix object-length 0> if
+ in-chans 0 ?do
+ matrix i object-ref to inlist
+ out-chans 0 ?do
+ inlist i object-ref ( outn ) mx j i
+ in-chans out-chans dur
+ set-fullmix-matrix to envs
+ loop
+ loop
+ else
+ in-chans 0 ?do
+ i out-chans < if
+ mx i i matrix mixer-set! drop
+ then
+ loop
then
- envs j ( inp ) array-ref i ( outp )
- outn env? if outn else :envelope outn :duration dur make-env then
- array-set!
- else
- $" %s: unknown element in matrix: %S" #( get-func-name outn ) string-format warning
- then
- then
- then
- loop
- loop
- else
- in-chans 0 ?do i out-chans < if mx i i matrix mixer-set! drop then loop
- then
- then
- sr unless
- \ ws-info ( start dur local-vars -- start dur )
- \
- \ This is normally done in RUN or RUN-INSTRUMENT, but here
- \ we haven't one of them.
- \
- start dur local-variables ws-info ( start dur )
- ( start ) seconds->samples { st }
- ( dur ) seconds->samples { samps }
- *output* in-file undef make-file->frame st samps inloc mx envs mus-mix drop
- rev-mx if *reverb* 1 make-frame st samps inloc rev-mx #f mus-mix drop then
- else
- in-chans make-frame { inframe }
- out-chans make-frame { outframe }
- in-chans make-array map!
- :file in-file :channel i :start inloc make-readin { rd }
- :input rd readin-cb :srate sr make-src
- end-map { srcs }
- envs if
- start dur run
- envs each
- each { en } env? if mx j ( inp ) i ( outp ) en env mixer-set! drop then end-each
- end-each
- in-chans 0 ?do inframe i srcs i array-ref 0.0 src frame-set! drop loop
- *output* i inframe mx outframe frame->frame frame->file drop
- rev-mx if *reverb* i inframe rev-mx outframe frame->frame frame->file drop then
- loop
- else
- start dur run
- in-chans 0 ?do inframe i srcs i array-ref 0.0 src frame-set! drop loop
- *output* i inframe mx outframe frame->frame frame->file drop
- rev-mx if *reverb* i inframe rev-mx outframe frame->frame frame->file drop then
- loop
- then
- then
+ then
+ sr unless
+ \ ws-info ( start dur local-vars -- start dur )
+ \
+ \ This is normally done in RUN or RUN-INSTRUMENT, but here
+ \ we haven't one of them.
+ \
+ start dur local-variables ws-info ( start dur )
+ ( start ) seconds->samples { st }
+ ( dur ) seconds->samples { samps }
+ *output* in-file undef make-file->frame
+ st samps inloc mx envs mus-file-mix drop
+ rev-mx if
+ *reverb* 1 make-frame
+ st samps inloc rev-mx #f mus-file-mix drop
+ then
+ else
+ in-chans make-frame { inframe }
+ out-chans make-frame { outframe }
+ in-chans make-array map!
+ :file in-file :channel i :start inloc make-readin { rd }
+ :input rd readin-cb :srate sr make-src
+ end-map { srcs }
+ envs if
+ start dur run
+ envs each ( mat )
+ each { en }
+ env? if
+ mx j ( inp )
+ i ( outp )
+ en env
+ mixer-set! drop
+ then
+ end-each
+ end-each
+ in-chans 0 ?do
+ inframe i
+ srcs i array-ref 0.0 undef src
+ frame-set! drop
+ loop
+ *output* i inframe mx outframe
+ frame->frame frame->file drop
+ rev-mx if
+ *reverb* i inframe rev-mx outframe
+ frame->frame frame->file drop
+ then
+ loop
+ else
+ start dur run
+ in-chans 0 ?do
+ inframe i
+ srcs i array-ref 0.0 undef src
+ frame-set! drop
+ loop
+ *output* i inframe mx outframe
+ frame->frame frame->file drop
+ rev-mx if
+ *reverb* i inframe rev-mx outframe
+ frame->frame frame->file drop
+ then
+ loop
+ then
+ then
;instrument
+previous
: fullmix-test <{ :optional start 0.0 dur 1.0 -- }>
- .stack
- start now!
- :envelope #( 0 0 1 1 ) :duration dur :scaler 0.5 make-env { en }
- "pistol.snd" now@ dur fullmix
- dur 0.2 f+ step
- "oboe.snd" now@ dur 0 #( #( 0.1 en ) ) fullmix
- dur 0.2 f+ step
+ start now!
+ :envelope #( 0 0 1 1 ) :duration dur :scaler 0.5 make-env { en }
+
+ "pistol.snd" now@ dur fullmix
+ dur 0.2 f+ step
+ "oboe.snd" now@ dur 0 #( #( 0.1 en ) ) fullmix
+ dur 0.2 f+ step
;
+[then]
'snd provided? [if]
- \ ;;; bes-fm -- can also use bes-j0 here as in earlier versions
- instrument: bes-fm <{ start dur freq amp ratio index -- }>
- 0.0 0.0 { car-ph mod-ph }
- freq hz->radians { car-incr }
- ratio car-incr f* { mod-incr }
- :envelope #( 0 0 25 1 75 1 100 0 ) :scaler amp :duration dur make-env { ampenv }
- start dur #{ :degree 90.0 random } run-instrument
- ampenv env car-ph bes-j1 f* ( result )
- mod-ph bes-j1 index f* car-incr f+ car-ph f+ to car-ph
- mod-incr mod-ph f+ to mod-ph
- end-run
- ;instrument
-
- : bes-fm-test <{ :optional start 0.0 dur 1.0 -- }>
- start now!
- now@ dur 440.0 10.0 1.0 4.0 bes-fm
- dur 0.2 f+ step
- ;
-
- include dsp
+ \ ;;; bes-fm -- can also use bes-j0 here as in earlier versions
+ instrument: bes-fm <{ start dur freq amp ratio index -- }>
+ 0.0 0.0 { car-ph mod-ph }
+ freq hz->radians { car-incr }
+ ratio car-incr f* { mod-incr }
+ :envelope #( 0 0 25 1 75 1 100 0 )
+ :scaler amp
+ :duration dur make-env { ampenv }
+ start dur #{ :degree 90.0 random } run-instrument
+ ampenv env car-ph bes-j1 f* ( result )
+ mod-ph bes-j1 index f* car-incr f+ car-ph f+ to car-ph
+ mod-incr mod-ph f+ to mod-ph
+ end-run
+ ;instrument
+
+ : bes-fm-test <{ :optional start 0.0 dur 1.0 -- }>
+ start now!
+ now@ dur 440.0 10.0 1.0 4.0 bes-fm
+ dur 0.2 f+ step
+ ;
+
+ include dsp
[else]
- : bes-fm-test <{ :optional start 0.0 dur 1.0 -- }>
- ;
-
- \ --- Hilbert transform (from dsp.fs)
-
- : make-hilbert-transform <{ :optional len 30 -- gen }>
- doc" Makes a Hilbert transform filter."
- len 2* 1+ { arrlen }
- arrlen 0.0 make-vct { arr }
- len even? if len else len 1+ then { lim }
- lim len negate ?do
- i len + { kk }
- i pi f* { denom }
- 1.0 denom fcos f- { num }
- num f0<> i 0<> || if
- arr kk num denom f/ denom len f/ fcos 0.46 f* 0.54 f+ f* vct-set! drop
- then
- loop
- :order arrlen :xcoeffs arr make-fir-filter
- ;
-
- <'> fir-filter alias hilbert-transform
- <'> fir-filter? alias hilbert-transform?
- <'> hilbert-transform <'> fir-filter help-ref help-set!
- <'> hilbert-transform? <'> fir-filter? help-ref help-set!
+ : bes-fm-test <{ :optional start 0.0 dur 1.0 -- }>
+ ;
+
+ \ --- Hilbert transform (from dsp.fs)
+
+ : make-hilbert-transform <{ :optional len 30 -- gen }>
+ doc" Make Hilbert transform filter."
+ len 2* 1+ { arrlen }
+ arrlen 0.0 make-vct { arr }
+ len even? if
+ len
+ else
+ len 1+
+ then { lim }
+ lim len negate ?do
+ i len + { kk }
+ i pi f* { denom }
+ 1.0 denom fcos f- { num }
+ num f0<>
+ i 0<> || if
+ arr kk
+ num denom f/
+ denom len f/ fcos 0.46 f* 0.54 f+ f*
+ vct-set! drop
+ then
+ loop
+ :order arrlen :xcoeffs arr make-fir-filter
+ ;
+
+ <'> fir-filter alias hilbert-transform
+ <'> fir-filter? alias hilbert-transform?
+ <'> hilbert-transform <'> fir-filter help-ref help-set!
+ <'> hilbert-transform? <'> fir-filter? help-ref help-set!
[then]
\ SSB-FM
-\ ;;; this might be better named "quasi-ssb-fm" -- cancellations are not perfect
-struct
- cell% field sbfm-am0
- cell% field sbfm-am1
- cell% field sbfm-car0
- cell% field sbfm-car1
- cell% field sbfm-mod0
- cell% field sbfm-mod1
-end-struct sbfm%
-
-: make-ssb-fm ( freq -- ssb )
- { freq }
- sbfm% %alloc { sbfm }
- freq 0.0 make-oscil sbfm sbfm-am0 !
- freq half-pi make-oscil sbfm sbfm-am1 !
- 0.0 0.0 make-oscil sbfm sbfm-car0 !
- 0.0 half-pi make-oscil sbfm sbfm-car1 !
- 40 make-hilbert-transform sbfm sbfm-mod0 !
- 40 make-delay sbfm sbfm-mod1 !
- sbfm
+\ ;;; this might be better named "quasi-ssb-fm" -- cancellations are not
+\ ;;; perfect
+
+#( "sbfm-am0"
+ "sbfm-am1"
+ "sbfm-car0"
+ "sbfm-car1"
+ "sbfm-mod0"
+ "sbfm-mod1" ) create-struct make-ssb-fm-struct
+
+: make-ssb-fm ( freq -- sbfm )
+ { freq }
+ make-ssb-fm-struct { sbfm }
+ freq 0.0 make-oscil sbfm swap sbfm-am0!
+ freq half-pi make-oscil sbfm swap sbfm-am1!
+ 0.0 0.0 make-oscil sbfm swap sbfm-car0!
+ 0.0 half-pi make-oscil sbfm swap sbfm-car1!
+ 40 make-hilbert-transform sbfm swap sbfm-mod0!
+ 40 make-delay sbfm swap sbfm-mod1!
+ sbfm
;
: ssb-fm ( gen modsig -- val )
- { gen modsig }
- gen sbfm-am0 @ 0.0 0.0 oscil
- gen sbfm-car0 @ gen sbfm-mod0 @ modsig hilbert-transform 0.0 oscil f*
- gen sbfm-am1 @ 0.0 0.0 oscil
- gen sbfm-car1 @ gen sbfm-mod1 @ modsig 0.0 delay 0.0 oscil f* f+
+ { gen modsig }
+ gen sbfm-am0@ 0.0 0.0 oscil
+ gen sbfm-car0@ gen sbfm-mod0@ modsig hilbert-transform 0.0 oscil f*
+ gen sbfm-am1@ 0.0 0.0 oscil
+ gen sbfm-car1@ gen sbfm-mod1@ modsig 0.0 delay 0.0 oscil f*
+ f+
;
-: ssb-fm-free ( gen -- ) free throw ;
-
\ ;;; if all we want are asymmetric fm-generated spectra, we can just
\ ;;; add 2 fm oscil pairs:
-struct
- cell% field fm2-os1
- cell% field fm2-os2
- cell% field fm2-os3
- cell% field fm2-os4
-end-struct fm2%
-
-: make-fm2 ( f1 f2 f3 f4 p1 p2 p3 p4 -- )
- { f1 f2 f3 f4 p1 p2 p3 p4 }
- fm2% %alloc { fm2 }
- f1 p1 make-oscil fm2 fm2-os1 !
- f2 p2 make-oscil fm2 fm2-os2 !
- f3 p3 make-oscil fm2 fm2-os3 !
- f4 p4 make-oscil fm2 fm2-os4 !
- fm2
+#( "fm2-os1"
+ "fm2-os2"
+ "fm2-os3"
+ "fm2-os4" ) create-struct make-fm2-struct
+
+: make-fm2 ( f1 f2 f3 f4 p1 p2 p3 p4 -- fm2 )
+ { f1 f2 f3 f4 p1 p2 p3 p4 }
+ make-fm2-struct { fm2 }
+ f1 p1 make-oscil fm2 swap fm2-os1!
+ f2 p2 make-oscil fm2 swap fm2-os2!
+ f3 p3 make-oscil fm2 swap fm2-os3!
+ f4 p4 make-oscil fm2 swap fm2-os4!
+ fm2
;
: fm2 ( gen index -- val )
- { gen index }
- gen fm2-os1 @ gen fm2-os2 @ 0.0 0.0 oscil index f* 0.0 oscil
- gen fm2-os3 @ gen fm2-os4 @ 0.0 0.0 oscil index f* 0.0 oscil f+ 0.25 f*
+ { gen index }
+ gen fm2-os1@ gen fm2-os2@ 0.0 0.0 oscil index f* 0.0 oscil
+ gen fm2-os3@ gen fm2-os4@ 0.0 0.0 oscil index f* 0.0 oscil f+ 0.25 f*
;
-: fm2-free ( gen -- ) free throw ;
-
\ ;;; rms gain balance
\ ;;; This is a translation of the rmsgain code provided by Fabio Furlanete.
+hide
+#( "rmsg-c1"
+ "rmsg-c2"
+ "rmsg-q"
+ "rmsg-r"
+ "rmsg-avg"
+ "rmsg-avgc" ) create-struct make-rmsgain-struct
+set-current
+
: make-rmsgain <{ :optional hp 10.0 -- gen }>
- doc" makes an RMS gain generator."
- 2.0 two-pi mus-srate f/ hp f* fcos f- { b }
- b b b f* 1.0 f- fsqrt f- { c2 }
- 1.0 c2 f- { c1 }
- #() :rmsg-c1 c1 array-assoc-set!
- ( rmsg ) :rmsg-c2 c2 array-assoc-set!
- ( rmsg ) :rmsg-q 0.0 array-assoc-set!
- ( rmsg ) :rmsg-r 0.0 array-assoc-set!
- ( rmsg ) :rmsg-avg 0.0 array-assoc-set!
- ( rmsg ) :rmsg-avgc 0 array-assoc-set!
- ( rmsg )
+ doc" Make RMS gain generator."
+ 2.0 two-pi mus-srate f/ hp f* fcos f- { b }
+ b b b f* 1.0 f- fsqrt f- { c2 }
+ 1.0 c2 f- { c1 }
+ make-rmsgain-struct { rmsg }
+ rmsg c1 rmsg-c1!
+ rmsg c2 rmsg-c2!
+ rmsg 0.0 rmsg-q!
+ rmsg 0.0 rmsg-r!
+ rmsg 0.0 rmsg-avg!
+ rmsg 0 rmsg-avgc!
+ rmsg
;
: rmsgain-rms ( gen sig -- val )
- doc" runs an RMS gain generator."
- { gen sig }
- gen :rmsg-c1 array-assoc-ref sig f* sig f*
- gen :rmsg-c2 array-assoc-ref gen :rmsg-q array-assoc-ref f* f+
- dup gen :rmsg-q rot array-assoc-set! drop ( val ) fsqrt
+ doc" Run RMS gain generator."
+ { gen sig }
+ gen rmsg-c1@ sig f* sig f*
+ gen rmsg-c2@ gen rmsg-q@ f* f+
+ gen over rmsg-q!
+ ( val ) fsqrt
;
: rmsgain-gain ( gen sig rmsval -- val )
- doc" returns the current RMS gain."
- { gen sig rmsval }
- gen :rmsg-c1 array-assoc-ref sig f* sig f*
- gen :rmsg-c2 array-assoc-ref gen :rmsg-r array-assoc-ref f* f+
- dup ( val val ) gen :rmsg-r rot array-assoc-set! drop
- ( val ) f0= if rmsval else rmsval gen :rmsg-r array-assoc-ref fsqrt f/ then { this-gain }
- gen :rmsg-avg array-assoc-ref this-gain f+ gen :rmsg-avg rot array-assoc-set!
- ( gen ) :rmsg-avgc array-assoc-ref 1+ gen :rmsg-avgc rot array-assoc-set! drop
- sig this-gain f*
+ doc" Return current RMS gain."
+ { gen sig rmsval }
+ gen rmsg-c1@ sig f* sig f*
+ gen rmsg-c2@ gen rmsg-r@ f* f+
+ gen over rmsg-r!
+ ( val ) f0= if
+ rmsval
+ else
+ rmsval gen rmsg-r@ fsqrt f/
+ then { this-gain }
+ gen gen rmsg-avg@ this-gain f+ rmsg-avg!
+ gen gen rmsg-avgc@ 1+ rmsg-avgc!
+ sig this-gain f*
;
: rmsgain-balance ( gen sig comp -- val )
- doc" scales a signal based on a RMS gain."
- { gen sig comp }
- gen sig gen comp rmsgain-rms rmsgain-gain
+ doc" Scale signal based on a RMS gain."
+ { gen sig comp }
+ gen sig
+ gen comp rmsgain-rms
+ rmsgain-gain
;
: rmsgain-gain-avg ( gen -- val )
- doc" is part of the RMS gain stuff."
- { gen }
- gen :rmsg-avg array-assoc-ref gen :rmsg-avgc array-assoc-ref f/
+ doc" Is part of the RMS gain stuff."
+ { gen }
+ gen rmsg-avg@ gen rmsg-avgc@ f/
;
-: rmsgain-balance-avg ( gen -- val )
- doc" is part of the RM gain stuff."
- :rmsg-avg array-assoc-ref
-;
+<'> rmsg-avg@ alias rmsgain-avg ( gen -- val )
+<'> rmsg-avgc@ alias rmsgain-avgc ( gen -- val )
+previous
: clm-ins-test <{ :optional start 0.0 dur 1.0 }>
- start now!
- now@ dur violin-test
- now@ dur fm-violin-test
- now@ dur pluck-test
- now@ dur vox-test
- now@ dur fofins-test
- now@ dur fm-trumpet-test
- now@ dur pqw-vox-test
- now@ dur flute-test
- now@ dur fm-bell-test
- now@ dur fm-insect-test
- now@ dur fm-drum-test
- now@ dur gong-test
- now@ dur attract-test
- now@ dur pqw-test
- now@ dur tubebell-test
- now@ dur wurley-test
- now@ dur rhodey-test
- now@ dur hammondoid-test
- now@ dur metal-test
- now@ dur drone/canter-test
- now@ dur reson-test
- now@ dur cellon-test
- now@ dur gran-synth-test
- now@ dur touch-tone-test
- now@ dur spectra-test
- now@ dur two-tab-test
- now@ dur lbj-piano-test
- now@ dur resflt-test
- now@ dur scratch-test
- now@ dur pins-test
- now@ dur zc-test
- now@ dur zn-test
- now@ dur za-test
- now@ dur clm-expsrc-test
- now@ dur exp-snd-test
- now@ dur expfil-test
- now@ dur graph-eq-test
- now@ dur anoi-test
- now@ dur fullmix-test
- now@ dur bes-fm-test
+ start now!
+ now@ dur violin-test
+ now@ dur fm-violin-test
+ now@ dur pluck-test
+ now@ dur vox-test
+ now@ dur fofins-test
+ now@ dur fm-trumpet-test
+ now@ dur pqw-vox-test
+ now@ dur flute-test
+ now@ dur fm-bell-test
+ now@ dur fm-insect-test
+ now@ dur fm-drum-test
+ now@ dur gong-test
+ now@ dur attract-test
+ now@ dur pqw-test
+ now@ dur tubebell-test
+ now@ dur wurley-test
+ now@ dur rhodey-test
+ now@ dur hammondoid-test
+ now@ dur metal-test
+ now@ dur drone/canter-test
+ now@ dur reson-test
+ now@ dur cellon-test
+ now@ dur gran-synth-test
+ now@ dur touch-tone-test
+ now@ dur spectra-test
+ now@ dur two-tab-test
+ now@ dur lbj-piano-test
+ now@ dur resflt-test
+ now@ dur scratch-test
+ now@ dur pins-test
+ now@ dur zc-test
+ now@ dur zn-test
+ now@ dur za-test
+ now@ dur clm-expsrc-test
+ now@ dur exp-snd-test
+ now@ dur expfil-test
+ now@ dur graph-eq-test
+ now@ dur anoi-test
+ now@ dur fullmix-test
+ now@ dur bes-fm-test
;
\ clm-ins.fs ends here
diff --git a/clm-ins.rb b/clm-ins.rb
index ac7bb2c..205a403 100644
--- a/clm-ins.rb
+++ b/clm-ins.rb
@@ -1,14 +1,14 @@
# clm-ins.rb -- CLM instruments translated to Snd/Ruby
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Tue Sep 16 01:27:09 CEST 2003
-# Changed: Sat Feb 19 18:26:25 CET 2011
+# Created: 03/09/16 01:27:09
+# Changed: 14/11/28 02:16:54
# Instruments work with
# with_sound (CLM (sample2file gens) and Snd)
# with_dac (dac output, except at least for fullmix)
#
-# Tested with Snd 9.3, and Ruby 1.6.6, 1.6.8, and 1.8.6.
+# Tested with Snd 15.x and Ruby 2.x.x
# pluck reson
# vox cellon
@@ -24,7 +24,7 @@
# pqw zc
# tubebell zn
# wurley za
-# rhodey exp_snd
+# rhodey clm_expsrc exp_snd
# hammondoid expfil
# metal graph_eq
# drone anoi
@@ -55,9 +55,10 @@
# fm2?(obj)
# fm2(gen, index)
-
# comments from clm-ins.scm
+$now = 0.0
+
require "ws"
require "spectr"
require "env"
@@ -70,11 +71,29 @@ def normalize_partials(partials)
sum = 0.0
parts = partials.dup
len = parts.length
- 1.step(len - 1, 2) do |i| sum += parts[i].abs end
- 1.step(len - 1, 2) do |i| parts[i] /= sum end
+ 1.step(len - 1, 2) do |i|
+ sum += parts[i].abs
+ end
+ 1.step(len - 1, 2) do |i|
+ parts[i] /= sum
+ end
parts
end unless defined? normalize_partials
+# violin is defined as an example in ws.rb
+def violin_test(start = 0.0, dur = 1.0)
+ violin(start, dur, 440, 0.5)
+ $now = start + dur + 0.2
+end
+
+require "v"
+
+# fm_violin is defined in v.rb
+def fm_violin_test(start = 0.0, dur = 1.0)
+ fm_violin(start, dur, 440, 0.5)
+ $now = start + dur + 0.2
+end
+
# PLUCK
#
# The Karplus-Strong algorithm as extended by David Jaffe and Julius
@@ -82,12 +101,13 @@ end unless defined? normalize_partials
# Plucked-String Algorithm" CMJ vol 7 no 2 Summer 1983, reprinted in
# "The Music Machine". translated from CLM's pluck.ins
add_help(:pluck,
- "pluck(start, dur, freq, amp, weighting, lossfact) \
-implements the Jaffe-Smith plucked string physical model.
-'weighting' is the ratio of the once-delayed to the twice-delayed samples. \
-It defaults to 0.5=shortest decay.
-Anything other than 0.5 = longer decay. Must be between 0 and less than 1.0.
-'lossfact' can be used to shorten decays. \
+ "pluck(start, dur, freq, amp, weighting, lossfact) \
+Implements the Jaffe-Smith plucked string physical model.
+WEIGHTING is the ratio of the once-delayed to the twice-delayed samples. \
+It defaults to 0.5=shortest decay.
+Anything other than 0.5 = longer decay. \
+Must be between 0 and less than 1.0.
+LOSSFACT can be used to shorten decays. \
Most useful values are between 0.8 and 1.0. pluck(0, 1, 330, 0.3, 0.95, 0.95)")
def pluck(start, dur, freq, amp, weighting = 0.5, lossfact = 0.9)
get_optimum_c = lambda do |s, o, p|
@@ -122,28 +142,35 @@ def pluck(start, dur, freq, amp, weighting = 0.5, lossfact = 0.9)
# with white noise (between -1 and 1).
allp = make_one_zero(lf * (1.0 - wt), lf * wt)
feedb = make_one_zero(c, 1.0) # or feedb = make_one_zero(1.0, c)
- dlen.times do |i| tab[i] = 1.0 - random(2.0) end
+ dlen.times do |i|
+ tab[i] = 1.0 - random(2.0)
+ end
run_instrument(start, dur) do
val = tab.clm_cycle
tab[tab.clm_cycle_index] = (1.0 - c) * one_zero(feedb, one_zero(allp, val))
amp * val
end
end
-# with_sound() do pluck(0.05, 0.1, 330, 0.1, 0.95, 0.95) end
+
+def pluck_test(start = 0.0, dur = 1.0)
+ pluck(start, dur, 330, 0.3, 0.95, 0.95)
+ $now = start + dur + 0.2
+end
# formant center frequencies for a male speaker (vox and pqw_vox)
-Formants = {:I => [390, 1990, 2550], :E => [530, 1840, 2480], :AE => [660, 1720, 2410],
- :UH => [520, 1190, 2390], :A => [730, 1090, 2440], :OW => [570, 840, 2410],
- :U => [440, 1020, 2240], :OO => [300, 870, 2240], :ER => [490, 1350, 1690],
- :W => [300, 610, 2200], :LL => [380, 880, 2575], :R => [420, 1300, 1600],
- :Y => [300, 2200, 3065], :EE => [260, 3500, 3800], :LH => [280, 1450, 1600],
- :L => [300, 1300, 3000], :I2 => [350, 2300, 3340], :B => [200, 800, 1750],
- :D => [300, 1700, 2600], :G => [250, 1350, 2000], :M => [280, 900, 2200],
- :N => [280, 1700, 2600], :NG => [280, 2300, 2750], :P => [300, 800, 1750],
- :T => [200, 1700, 2600], :K => [350, 1350, 2000], :F => [175, 900, 4400],
- :TH => [200, 1400, 2200], :S => [200, 1300, 2500], :SH => [200, 1800, 2000],
- :V => [175, 1100, 2400], :THE => [200, 1600, 2200], :Z => [200, 1300, 2500],
- :ZH => [175, 1800, 2000], :ZZ => [900, 2400, 3800], :VV => [565, 1045, 2400]}
+Formants = {
+ :I => [390, 1990, 2550], :E => [530, 1840, 2480], :AE => [660, 1720, 2410],
+ :UH => [520, 1190, 2390], :A => [730, 1090, 2440], :OW => [570, 840, 2410],
+ :U => [440, 1020, 2240], :OO => [300, 870, 2240], :ER => [490, 1350, 1690],
+ :W => [300, 610, 2200], :LL => [380, 880, 2575], :R => [420, 1300, 1600],
+ :Y => [300, 2200, 3065], :EE => [260, 3500, 3800], :LH => [280, 1450, 1600],
+ :L => [300, 1300, 3000], :I2 => [350, 2300, 3340], :B => [200, 800, 1750],
+ :D => [300, 1700, 2600], :G => [250, 1350, 2000], :M => [280, 900, 2200],
+ :N => [280, 1700, 2600], :NG => [280, 2300, 2750], :P => [300, 800, 1750],
+ :T => [200, 1700, 2600], :K => [350, 1350, 2000], :F => [175, 900, 4400],
+ :TH => [200, 1400, 2200], :S => [200, 1300, 2500], :SH => [200, 1800, 2000],
+ :V => [175, 1100, 2400], :THE => [200, 1600, 2200], :Z => [200, 1300, 2500],
+ :ZH => [175, 1800, 2000], :ZZ => [900, 2400, 3800], :VV => [565, 1045, 2400]}
# MLBVOI
#
@@ -224,34 +251,37 @@ def vox(start, dur, freq, amp, ampfun, freqfun, freqscl, voxfun, index, vibscl)
amp5 = 1.0 - amp4
end
env(ampf) * (0.8 * (amp0 * oscil(of0, frq0 + 0.2 * car) +
- amp1 * oscil(of1, frq1 + 0.2 * car)) +
- 0.15 * (amp2 * oscil(of2, frq2 + 0.5 * car) +
- amp3 * oscil(of3, frq3 + 0.5 * car)) +
- 0.05 * (amp4 * oscil(of4, frq4 + car) +
- amp5 * oscil(of5, frq5 + car)))
+ amp1 * oscil(of1, frq1 + 0.2 * car)) +
+ 0.15 * (amp2 * oscil(of2, frq2 + 0.5 * car) +
+ amp3 * oscil(of3, frq3 + 0.5 * car)) +
+ 0.05 * (amp4 * oscil(of4, frq4 + car) +
+ amp5 * oscil(of5, frq5 + car)))
end
end
-=begin
-with_sound() do
+
+def vox_test(start = 0.0, dur = 1.0)
amp_env = [0, 0, 25, 1, 75, 1, 100, 0]
frq_env = [0, 0, 5, 0.5, 10, 0, 100, 1]
- beg = 0
- vox(beg, 2, 170, 0.4, amp_env, frq_env, 0.1,
- [0, :E, 25, :AE, 35, :ER, 65, :ER, 75, :I, 100, :UH], 0.05, 0.1)
- beg += 2.2
- vox(beg, 2, 300, 0.4, amp_env, frq_env, 0.1,
- [0, :I, 5, :OW, 10, :I, 50, :AE, 100, :OO], 0.02, 0.1)
- beg += 2.2
- vox(beg, 5, 600, 0.4, amp_env, frq_env, 0.1,
- [0, :I, 5, :OW, 10, :I, 50, :AE, 100, :OO], 0.01, 0.1)
+ examp1 = [0, :E, 25, :AE, 35, :ER, 65, :ER, 75, :I, 100, :UH]
+ examp2 = [0, :I, 5, :OW, 10, :I, 50, :AE, 100, :OO]
+
+ $now = start
+ vox($now, dur, 170, 0.4, amp_env, frq_env, 0.1, examp1, 0.05, 0.1)
+ $now += dur + 0.2
+ vox($now, dur, 300, 0.4, amp_env, frq_env, 0.1, examp2, 0.02, 0.1)
+ $now += dur + 0.2
+ vox($now, 5, 600, 0.4, amp_env, frq_env, 0.1, examp2, 0.01, 0.1)
+ $now += 5.0 + 0.2
end
-=end
# FOF example
add_help(:fofins,
- "fofins(beg, dur, frq, amp, vib, f0, a0, f1, a1, f2, a2, ae=[0, 0, 25, 1, 75, 1, 100, 0]) \
-produces FOF synthesis: fofins(0, 1, 270, 0.2, 0.001, 730, 0.6, 1090, 0.3, 2440, 0.1)")
-def fofins(start, dur, frq, amp, vib, f0, a0, f1, a1, f2, a2, ae = [0, 0, 25, 1, 75, 1, 100,0])
+ "fofins(beg, dur, frq, amp, vib, f0, a0, f1, a1, \
+f2, a2, ae=[0, 0, 25, 1, 75, 1, 100, 0]) \
+Produces FOF synthesis: \
+fofins(0, 1, 270, 0.2, 0.001, 730, 0.6, 1090, 0.3, 2440, 0.1)")
+def fofins(start, dur, frq, amp, vib, f0, a0, f1, a1, f2, a2,
+ ae = [0, 0, 25, 1, 75, 1, 100,0])
ampf = make_env(:envelope, ae, :scaler, amp, :duration, dur)
frq0 = hz2radians(f0)
frq1 = hz2radians(f1)
@@ -269,15 +299,21 @@ def fofins(start, dur, frq, amp, vib, f0, a0, f1, a1, f2, a2, ae = [0, 0, 25, 1,
env(ampf) * wave_train(wt0, vib * oscil(vibr))
end
end
-# with_sound() do fofins(0, 4, 270, 0.4, 0.001, 730, 0.6, 1090, 0.3, 2440, 0.1) end
+
+def fofins_test(start = 0.0, dur = 1.0)
+ fofins(start, dur, 270, 0.2, 0.001, 730, 0.6, 1090, 0.3, 2440, 0.1)
+ $now = start + dur + 0.2
+end
# FM TRUMPET
#
# Dexter Morrill's FM-trumpet: from CMJ feb 77 p51
def fm_trumpet(start, dur, *args)
- frq1, frq2, amp1, amp2, ampatt1, ampdec1, ampatt2, ampdec2, modfrq1, modind11, modind12 = nil
- modfrq2, modind21, modind22, rvibamp, rvibfrq, vibamp, vibfrq, vibatt, vibdec = nil
- frqskw, frqatt, ampenv1, ampenv2, indenv1, indenv2, degree, distance, reverb_amount = nil
+ frq1, frq2, amp1, amp2, ampatt1, ampdec1, ampatt2, ampdec2 = nil
+ modfrq1, modind11, modind12, modfrq2, modind21, modind22 = nil
+ rvibamp, rvibfrq, vibamp, vibfrq, vibatt, vibdec = nil
+ frqskw, frqatt, ampenv1, ampenv2 = nil
+ indenv1, indenv2, degree, distance, reverb_amount = nil
optkey(args, binding,
[:frq1, 250.0],
[:frq2, 1500.0],
@@ -309,56 +345,76 @@ def fm_trumpet(start, dur, *args)
[:distance, 1.0],
[:reverb_amount, 0.005])
dur = dur.to_f
- per_vib_f = make_env(:envelope, stretch_envelope([0, 1, 25, 0.1, 75, 0, 100, 0],
- 25,
- [100 * (vibatt / dur), 45].min,
- 75,
- [100 * (1.0 - vibdec / dur), 55].max),
+ per_vib_f = make_env(:envelope,
+ stretch_envelope([0, 1, 25, 0.1, 75, 0, 100, 0],
+ 25,
+ [100 * (vibatt / dur), 45].min,
+ 75,
+ [100 * (1.0 - vibdec / dur), 55].max),
:scaler, vibamp, :duration, dur)
+
ran_vib = make_rand_interp(:frequency, rvibfrq, :amplitude, rvibamp)
per_vib = make_oscil(:frequency, vibfrq)
dec_01 = [75, 100 * (1.0 - 0.01 / dur)].max
- frq_f = make_env(:envelope, stretch_envelope([0, 0, 25, 1, 75, 1, 100, 0],
- 25,
- [25, 100 * (frqatt / dur)].min,
- 75,
- dec_01),
+ frq_f = make_env(:envelope,
+ stretch_envelope([0, 0, 25, 1, 75, 1, 100, 0],
+ 25,
+ [25, 100 * (frqatt / dur)].min,
+ 75,
+ dec_01),
:scaler, frqskw, :duration, dur)
ampattpt1 = [25, 100 * (ampatt1 / dur)].min
ampdecpt1 = [75, 100 * (1.0 - ampdec1 / dur)].max
ampattpt2 = [25, 100 * (ampatt2 / dur)].min
ampdecpt2 = [75, 100 * (1.0 - ampdec2 / dur)].max
- mod1_f = make_env(:envelope, stretch_envelope(indenv1, 25, ampattpt1, 75, dec_01),
+ mod1_f = make_env(:envelope,
+ stretch_envelope(indenv1, 25, ampattpt1, 75, dec_01),
:scaler, modfrq1 * (modind12 - modind11), :duration, dur)
mod1 = make_oscil(:frequency, 0.0)
car1 = make_oscil(:frequency, 0.0)
# set frequency to zero here because it is handled multiplicatively below
- car1_f = make_env(:envelope, stretch_envelope(ampenv1, 25, ampattpt1, 75, ampdecpt1),
+ car1_f = make_env(:envelope,
+ stretch_envelope(ampenv1, 25, ampattpt1, 75, ampdecpt1),
:scaler, amp1, :duration, dur)
- mod2_f = make_env(:envelope, stretch_envelope(indenv2, 25, ampattpt2, 75, dec_01),
+ mod2_f = make_env(:envelope,
+ stretch_envelope(indenv2, 25, ampattpt2, 75, dec_01),
:scaler, modfrq2 * (modind22 - modind21), :duration, dur)
mod2 = make_oscil(:frequency, 0.0)
car2 = make_oscil(:frequency, 0.0)
- car2_f = make_env(:envelope, stretch_envelope(ampenv2, 25, ampattpt2, 75, ampdecpt2),
+ car2_f = make_env(:envelope,
+ stretch_envelope(ampenv2, 25, ampattpt2, 75, ampdecpt2),
:scaler, amp2, :duration, dur)
- run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, reverb_amount) do
- frq_change = hz2radians((1.0 + rand_interp(ran_vib)) * \
- (1.0 + env(per_vib_f) * oscil(per_vib)) * (1.0 + env(frq_f)))
- env(car1_f) * \
- oscil(car1, frq_change * (frq1 + env(mod1_f) * oscil(mod1, modfrq1 * frq_change))) + \
- env(car2_f) * \
- oscil(car2, frq_change * (frq2 + env(mod2_f) * oscil(mod2, modfrq2 * frq_change)))
+ run_instrument(start, dur,
+ :degree, degree,
+ :distance, distance,
+ :reverb_amount, reverb_amount) do
+ frq_change = hz2radians((1.0 +
+ rand_interp(ran_vib)) *
+ (1.0 + env(per_vib_f) *
+ oscil(per_vib)) *
+ (1.0 + env(frq_f)))
+ env(car1_f) *
+ oscil(car1, frq_change *
+ (frq1 + env(mod1_f) * oscil(mod1, modfrq1 * frq_change))) +
+ env(car2_f) *
+ oscil(car2, frq_change *
+ (frq2 + env(mod2_f) * oscil(mod2, modfrq2 * frq_change)))
end
end
-# with_sound() do fm_trumpet(0, 1) end
+
+def fm_trumpet_test(start = 0.0, dur = 1.0)
+ fm_trumpet(start, dur)
+ $now = start + dur + 0.2
+end
# PQWVOX
#
# translation of CLM pqwvox.ins (itself translated from MUS10 of MLB's
# waveshaping voice instrument (using phase quadrature waveshaping))
add_help(:pqw_vox,
- "pqw_vox(start, dur, freq, spacing_freq, amp, ampfun, freqfun, freqscl, phonemes, formant_amps, formant_shapes) \
-produces vocal sounds using phase quadrature waveshaping")
+ "pqw_vox(start, dur, freq, spacing_freq, \
+amp, ampfun, freqfun, freqscl, phonemes, formant_amps, formant_shapes) \
+Produces vocal sounds using phase quadrature waveshaping.")
def pqw_vox(start, dur, freq, spacing_freq, amp, ampfun, freqfun, freqscl,
phonemes, formant_amps, formant_shapes)
vox_fun = lambda do |phons, which, newenv|
@@ -366,7 +422,8 @@ def pqw_vox(start, dur, freq, spacing_freq, amp, ampfun, freqfun, freqscl,
if phons.empty?
newenv
else
- vox_fun.call(phons[2..-1], which, newenv + [phons[0], Formants[phons[1]][which]])
+ vox_fun.call(phons[2..-1],
+ which, newenv + [phons[0], Formants[phons[1]][which]])
end
end
car_sin = make_oscil(:frequency, 0.0)
@@ -382,7 +439,8 @@ def pqw_vox(start, dur, freq, spacing_freq, amp, ampfun, freqfun, freqscl,
sin_coeffs = Array.new(fs)
cos_coeffs = Array.new(fs)
ampf = make_env(:envelope, ampfun, :scaler, amp, :duration, dur)
- freqf = make_env(:envelope, freqfun, :scaler, freqscl * freq, :duration, dur, :offset, freq)
+ freqf = make_env(:envelope, freqfun, :scaler, freqscl * freq,
+ :duration, dur, :offset, freq)
per_vib = make_triangle_wave(:frequency, 6.0, :amplitude, freq * 0.1)
ran_vib = make_rand_interp(:frequency, 20.0, :amplitude, freq * 0.05)
fs.times do |i|
@@ -394,7 +452,8 @@ def pqw_vox(start, dur, freq, spacing_freq, amp, ampfun, freqfun, freqscl,
shape = normalize_partials(formant_shapes[i])
cos_coeffs[i] = partials2polynomial(shape, 1)
sin_coeffs[i] = partials2polynomial(shape, 0)
- frmfs[i] = make_env(:envelope, vox_fun.call(phonemes, i, []), :duration, dur)
+ frmfs[i] = make_env(:envelope, vox_fun.call(phonemes, i, []),
+ :duration, dur)
end
run_instrument(start, dur) do
frq = env(freqf) + triangle_wave(per_vib) + rand_interp(ran_vib)
@@ -419,33 +478,50 @@ def pqw_vox(start, dur, freq, spacing_freq, amp, ampfun, freqfun, freqscl,
end
fax = polynomial(cos_coeffs[j], carcos)
yfax = carsin * polynomial(sin_coeffs[j], carcos)
- sum = sum + amps[j] * \
- (even_amp * (yfax * oscil(sin_evens[j], even_freq) - \
- fax * oscil(cos_evens[j], even_freq)) + \
- odd_amp * (yfax * oscil(sin_odds[j], odd_freq) - \
- fax * oscil(cos_odds[j], odd_freq)))
+ sum = sum + amps[j] *
+ (even_amp * (yfax * oscil(sin_evens[j], even_freq) -
+ fax * oscil(cos_evens[j], even_freq)) +
+ odd_amp * (yfax * oscil(sin_odds[j], odd_freq) -
+ fax * oscil(cos_odds[j], odd_freq)))
end
env(ampf) * sum
end
end
-=begin
-with_sound() do
+
+def pqw_vox_test(start = 0.0, dur = 1.0)
ampfun = [0, 0, 50, 1, 100, 0]
freqfun = [0, 0, 100, 0]
freqramp = [0, 0, 100, 1]
- pqw_vox(0, 1, 300, 300, 0.1, ampfun, freqfun, 0, [0, :L, 100, :L], [0.33, 0.33, 0.33],
- [[1, 1, 2, 0.5], [1, 0.5, 2, 0.5, 3, 1], [1, 1, 4, 0.5]])
- pqw_vox(1.2, 2, 200, 200, 0.1, ampfun, freqramp, 0.1, [0, :UH, 100, :ER], [0.8, 0.15, 0.05],
- [[1, 1, 2, 0.5], [1, 1, 2, 0.5, 3, 0.2, 4, 0.1], [1, 1, 3, 0.1, 4, 0.5]])
- pqw_vox(3.4, 2, 100, 314, 0.1, ampfun, freqramp, 0.1, [0, :UH, 100, :ER], [0.8, 0.15, 0.05],
- [[1, 1, 2, 0.5], [1, 1, 2, 0.5, 3, 0.2, 4, 0.1], [1, 1, 3, 0.1, 4, 0.5]])
- pqw_vox(5.6, 2, 200, 314, 0.1, ampfun, freqramp, 0.01, [0, :UH, 100, :ER], [0.8, 0.15, 0.05],
- [[1, 1, 2, 0.5], [1, 1, 4, 0.1], [1, 1, 2, 0.1, 4, 0.05]])
- pqw_vox(7.8, 2, 100, 414, 0.2, ampfun, freqramp, 0.01, [0, :OW, 50, :E, 100, :ER],
- [0.8, 0.15, 0.05],
- [[1, 1, 2, 0.5, 3, 0.1, 4, 0.01], [1, 1, 4, 0.1], [1, 1, 2, 0.1, 4, 0.05]])
+ sh1 = [[1, 1, 2, 0.5],
+ [1, 0.5, 2, 0.5, 3, 1],
+ [1, 1, 4, 0.5]]
+ sh2 = [[1, 1, 2, 0.5],
+ [1, 1, 2, 0.5, 3, 0.2, 4, 0.1],
+ [1, 1, 3, 0.1, 4, 0.5]]
+ sh3 = [[1, 1, 2, 0.5],
+ [1, 1, 4, 0.1],
+ [1, 1, 2, 0.1, 4, 0.05]]
+ sh4 = [[1, 1, 2, 0.5, 3, 0.1, 4, 0.01],
+ [1, 1, 4, 0.1],
+ [1, 1, 2, 0.1, 4, 0.05]]
+
+ $now = start
+ pqw_vox($now, dur, 300, 300, 0.5, ampfun, freqfun, 0.0,
+ [0, :L, 100, :L], [0.33, 0.33, 0.33], sh1)
+ $now += dur + 0.2
+ pqw_vox($now, dur, 200, 200, 0.1, ampfun, freqramp, 0.1,
+ [0, :UH, 100, :ER], [0.8, 0.15, 0.05], sh2)
+ $now += dur + 0.2
+ pqw_vox($now, dur, 100, 314, 0.1, ampfun, freqramp, 0.1,
+ [0, :UH, 100, :ER], [0.8, 0.15, 0.05], sh2)
+ $now += dur + 0.2
+ pqw_vox($now, dur, 200, 314, 0.1, ampfun, freqramp, 0.01,
+ [0, :UH, 100, :ER], [0.8, 0.15, 0.05], sh3)
+ $now += dur + 0.2
+ pqw_vox($now, dur, 100, 414, 0.2, ampfun, freqramp, 0.01,
+ [0, :OW, 50, :E, 100, :ER], [0.8, 0.15, 0.05], sh4)
+ $now += dur + 0.2
end
-=end
# STEREO-FLUTE
# slightly simplified [MS]
@@ -467,7 +543,8 @@ add_help(:stereo_flute,
is a physical model of a flute: \
stereo_flute(0, 1, 440, 0.55, :flow_envelope, [0, 0, 1, 1, 2, 1, 3, 0])")
def stereo_flute(start, dur, freq, flow, *args)
- flow_envelope, decay, noise, embouchure_size, fbk_scl1, fbk_scl2, out_scl = nil
+ flow_envelope, decay, noise, embouchure_size = nil
+ fbk_scl1, fbk_scl2, out_scl = nil
a0, b1, vib_rate, vib_amount, ran_rate, ran_amount = nil
optkey(args, binding,
[:flow_envelope, [0, 1, 100, 1]],
@@ -483,24 +560,27 @@ def stereo_flute(start, dur, freq, flow, *args)
[:vib_amount, 0.03],
[:ran_rate, 5],
[:ran_amount, 0.03])
- flowf = make_env(:envelope, flow_envelope, :scaler, flow,
- :length, seconds2samples(dur - decay))
+ flowf = make_env(:envelope, flow_envelope, :scaler, flow,
+ :length, seconds2samples(dur - decay))
periodic_vib = make_oscil(:frequency, vib_rate)
- ran_vib = make_rand_interp(:frequency, ran_rate)
- breath = make_rand(:frequency, @srate / 2.0, :amplitude, 1)
+ ran_vib = make_rand_interp(:frequency, ran_rate)
+ breath = make_rand(:frequency, @srate / 2.0, :amplitude, 1)
period_samples = (@srate / freq).floor
embouchure_samples = (embouchure_size * period_samples).floor
embouchure = make_delay(embouchure_samples, :initial_element, 0.0)
- bore = make_delay(period_samples)
+ bore = make_delay(period_samples)
reflection_lp_filter = make_one_pole(a0, b1)
out_sig = current_diff = previous_out_sig = previous_dc_blocked_a = 0.0
run_instrument(start, dur) do
delay_sig = delay(bore, out_sig)
emb_sig = delay(embouchure, current_diff)
- current_flow = vib_amount * oscil(periodic_vib) + ran_amount * rand_interp(ran_vib) + env(flowf)
- current_diff = (current_flow + noise * current_flow * rand(breath)) + fbk_scl1 * delay_sig
+ current_flow = vib_amount * oscil(periodic_vib) +
+ ran_amount * rand_interp(ran_vib) + env(flowf)
+ current_diff = (current_flow + noise * current_flow * rand(breath)) +
+ fbk_scl1 * delay_sig
current_exitation = emb_sig - emb_sig * emb_sig * emb_sig
- out_sig = one_pole(reflection_lp_filter, current_exitation + fbk_scl2 * delay_sig)
+ out_sig = one_pole(reflection_lp_filter,
+ current_exitation + fbk_scl2 * delay_sig)
# NB the DC blocker is not in the cicuit. It is applied to the
# out_sig but the result is not fed back into the system.
dc_blocked_a = (out_sig - previous_out_sig) + 0.995 * previous_dc_blocked_a
@@ -509,14 +589,20 @@ def stereo_flute(start, dur, freq, flow, *args)
out_scl * dc_blocked_a
end
end
-# with_sound() do stereo_flute(0, 2, 440, 0.55, :flow_envelope, [0, 0, 1, 1, 2, 1, 3, 0]) end
+
+def flute_test(start = 0.0, dur = 1.0)
+ stereo_flute(start, dur, 440, 0.55, :flow_envelope, [0, 0, 1, 1, 2, 1, 3, 0])
+ $now = start + dur + 0.2
+end
# FM-BELL
add_help(:fm_bell,
- "fm_bell(startime, dur, frequency, amplitude, [amp-env=[], [index_env=[], [index=1.0]]]) \
-mixes in one fm bell note" )
+ "fm_bell(startime, dur, frequency, amplitude, \
+amp-env=[...], index_env=[...], index=1.0) \
+Mixes in one fm bell note." )
def fm_bell(start, dur, freq, amp,
- amp_env = [0, 0, 0.1, 1, 10, 0.6, 25, 0.3, 50, 0.15, 90, 0.1, 100, 0],
+ amp_env = [0, 0, 0.1, 1, 10, 0.6, 25, 0.3,
+ 50, 0.15, 90, 0.1, 100, 0],
index_env = [0, 1, 2, 1.1, 25, 0.75, 75, 0.5, 100, 0.2],
index = 1.0)
fm_ind1 = hz2radians(32.0 * freq)
@@ -534,17 +620,19 @@ def fm_bell(start, dur, freq, amp,
ampf = make_env(:envelope, amp_env, :scaler, amp, :duration, dur)
run_instrument(start, dur) do
fmenv = env(indf)
- env(ampf) * \
- (oscil(car1, fmenv * fm_ind1 * oscil(mod1)) + \
- 0.15 * oscil(car2, fmenv * (fm_ind2 * oscil(mod2) + fm_ind3 * oscil(mod3))) + \
- 0.15 * oscil(car3, fmenv * fm_ind4 * oscil(mod4)))
+ env(ampf) *
+ (oscil(car1, fmenv * fm_ind1 * oscil(mod1)) +
+ 0.15 *
+ oscil(car2, fmenv * (fm_ind2 * oscil(mod2) + fm_ind3 * oscil(mod3))) +
+ 0.15 *
+ oscil(car3, fmenv * fm_ind4 * oscil(mod4)))
end
end
-# with_sound() do
-# fbell = [0, 1, 2, 1.1, 25, 0.75, 75, 0.5, 100, 0.2]
-# abell = [0, 0, 0.1, 1, 10, 0.6, 25, 0.3, 50, 0.15, 90, 0.1, 100, 0]
-# fm_bell(0, 1, 220, 0.5, abell, fbell, 1)
-# end
+
+def fm_bell_test(start = 0.0, dur = 1.0)
+ fm_bell(start, dur, 440, 0.5)
+ $now = start + dur + 0.2
+end
# FM-INSECT
def fm_insect(start, dur, freq, amp, amp_env,
@@ -559,30 +647,47 @@ def fm_insect(start, dur, freq, amp, amp_env,
fm1_osc = make_oscil(:frequency, mod_freq)
fm2_osc = make_oscil(:frequency, fm_ratio * freq)
ampf = make_env(:envelope, amp_env, :scaler, amp, :duration, dur)
- indf = make_env(:envelope, mod_index_env, :scaler, hz2radians(mod_index), :duration, dur)
- modfrqf = make_env(:envelope, mod_freq_env, :scaler, hz2radians(mod_skew), :duration, dur)
+ indf = make_env(:envelope, mod_index_env,
+ :scaler, hz2radians(mod_index),
+ :duration, dur)
+ modfrqf = make_env(:envelope, mod_freq_env,
+ :scaler, hz2radians(mod_skew),
+ :duration, dur)
fm2_amp = hz2radians(fm_index * fm_ratio * freq)
- run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, reverb_amount) do
+ run_instrument(start, dur,
+ :degree, degree,
+ :distance, distance,
+ :reverb_amount, reverb_amount) do
garble_in = env(indf) * oscil(fm1_osc, env(modfrqf))
garble_out = fm2_amp * oscil(fm2_osc, garble_in)
env(ampf) * oscil(carrier, garble_out + garble_in)
end
end
-=begin
-with_sound() do
+
+def fm_insect_test(start = 0.0, dur = 1.0)
locust = [0, 0, 40, 1, 95, 1, 100, 0.5]
bug_hi = [0, 1, 25, 0.7, 75, 0.78, 100, 1]
amp = [0, 0, 25, 1, 75, 0.7, 100, 0]
- fm_insect(0.000, 1.699, 4142.627, 0.015, amp, 60, -16.707, locust, 500.866, bug_hi, 0.346, 0.5)
- fm_insect(0.195, 0.233, 4126.284, 0.030, amp, 60, -12.142, locust, 649.490, bug_hi, 0.407, 0.5)
- fm_insect(0.217, 2.057, 3930.258, 0.045, amp, 60, -3.011, locust, 562.087, bug_hi, 0.591, 0.5)
- fm_insect(2.100, 1.500, 900.627, 0.060, amp, 40, -16.707, locust, 300.866, bug_hi, 0.346, 0.5)
- fm_insect(3.000, 1.500, 900.627, 0.060, amp, 40, -16.707, locust, 300.866, bug_hi, 0.046, 0.5)
- fm_insect(3.450, 1.500, 900.627, 0.090, amp, 40, -16.707, locust, 300.866, bug_hi, 0.006, 0.5)
- fm_insect(3.950, 1.500, 900.627, 0.120, amp, 40, -10.707, locust, 300.866, bug_hi, 0.346, 0.5)
- fm_insect(4.300, 1.500, 900.627, 0.090, amp, 40, -20.707, locust, 300.866, bug_hi, 0.246, 0.5)
+
+ $now = start
+ fm_insect($now + 0.000, 1.699, 4142.627, 0.015, amp, 60, -16.707,
+ locust, 500.866, bug_hi, 0.346, 0.5)
+ fm_insect($now + 0.195, 0.233, 4126.284, 0.030, amp, 60, -12.142,
+ locust, 649.490, bug_hi, 0.407, 0.5)
+ fm_insect($now + 0.217, 2.057, 3930.258, 0.045, amp, 60, -3.011,
+ locust, 562.087, bug_hi, 0.591, 0.5)
+ fm_insect($now + 2.100, 1.500, 900.627, 0.060, amp, 40, -16.707,
+ locust, 300.866, bug_hi, 0.346, 0.5)
+ fm_insect($now + 3.000, 1.500, 900.627, 0.060, amp, 40, -16.707,
+ locust, 300.866, bug_hi, 0.046, 0.5)
+ fm_insect($now + 3.450, 1.500, 900.627, 0.090, amp, 40, -16.707,
+ locust, 300.866, bug_hi, 0.006, 0.5)
+ fm_insect($now + 3.950, 1.500, 900.627, 0.120, amp, 40, -10.707,
+ locust, 300.866, bug_hi, 0.346, 0.5)
+ fm_insect($now + 4.300, 1.500, 900.627, 0.090, amp, 40, -20.707,
+ locust, 300.866, bug_hi, 0.246, 0.5)
+ $now += 6.0
end
-=end
# FM-DRUM
#
@@ -593,46 +698,58 @@ def fm_drum(start, dur, freq, amp, index, high = false,
fmrat = high ? 3.414 : 1.414
glsf = make_env(:envelope, [0, 0, 25, 0, 75, 1, 100, 1],
:scaler, high ? hz2radians(66) : 0.0, :duration, dur)
- ampfun = [0, 0, 3, 0.05, 5, 0.2, 7, 0.8, 8, 0.95, 10, 1.0, 12, 0.95, 20, 0.3, 30, 0.1, 100, 0]
+ ampfun = [0, 0, 3, 0.05, 5, 0.2, 7, 0.8, 8, 0.95,
+ 10, 1.0, 12, 0.95, 20, 0.3, 30, 0.1, 100, 0]
atdrpt = 100 * (high ? 0.01 : 0.015) / dur
- ampf = make_env(:envelope, stretch_envelope(ampfun, 10, atdrpt, 15,
- [atdrpt + 1, 100 - 100 * ((dur - 0.2) / dur)].max),
+ ampf = make_env(:envelope,
+ stretch_envelope(ampfun, 10, atdrpt, 15,
+ [atdrpt + 1,
+ 100 - 100 * ((dur - 0.2) / dur)].max),
:scaler, amp, :duration, dur)
indxfun = [0, 0, 5, 0.014, 10, 0.033, 15, 0.061, 20, 0.099,
- 25, 0.153, 30, 0.228, 35, 0.332, 40, 0.477,
- 45, 0.681, 50, 0.964, 55, 0.681, 60, 0.478, 65, 0.332,
- 70, 0.228, 75, 0.153, 80, 0.099, 85, 0.061,
- 90, 0.033, 95, 0.0141, 100, 0]
+ 25, 0.153, 30, 0.228, 35, 0.332, 40, 0.477,
+ 45, 0.681, 50, 0.964, 55, 0.681, 60, 0.478, 65, 0.332,
+ 70, 0.228, 75, 0.153, 80, 0.099, 85, 0.061,
+ 90, 0.033, 95, 0.0141, 100, 0]
indxpt = 100 - 100 * ((dur - 0.1) / dur)
divindxf = stretch_envelope(indxfun, 50, atdrpt, 65, indxpt)
indxf = make_env(:envelope, divindxf, :duration, dur,
:scaler, [hz2radians(index * fmrat * freq), PI].min)
mindxf = make_env(:envelope, divindxf, :duration, dur,
:scaler, [hz2radians(index * casrat * freq), PI].min)
- devf = make_env(:envelope, stretch_envelope(ampfun, 10, atdrpt, 90,
- [atdrpt + 1, 100 - 100 * ((dur - 0.05) / dur)].max),
+ devf = make_env(:envelope,
+ stretch_envelope(ampfun, 10, atdrpt, 90,
+ [atdrpt + 1,
+ 100 - 100 * ((dur - 0.05) / dur)].max),
:scaler, [hz2radians(7000), PI].min, :duration, dur)
rn = make_rand(:frequency, 7000, :amplitude, 1)
carrier = make_oscil(:frequency, freq)
fmosc = make_oscil(:frequency, freq * fmrat)
cascade = make_oscil(:frequency, freq * casrat)
- run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, rev_amount) do
+ run_instrument(start, dur,
+ :degree, degree,
+ :distance, distance,
+ :reverb_amount, rev_amount) do
gls = env(glsf)
- env(ampf) * oscil(carrier,
- gls + env(indxf) * oscil(fmosc,
- gls * fmrat +
- env(mindxf) * oscil(cascade,
- gls * casrat +
- env(devf) *
- rand(rn))))
+ env(ampf) *
+ oscil(carrier,
+ gls +
+ env(indxf) *
+ oscil(fmosc,
+ gls * fmrat +
+ env(mindxf) * oscil(cascade,
+ gls * casrat +
+ env(devf) * rand(rn))))
end
end
-=begin
-with_sound() do
- fm_drum(0, 1.5, 55, 0.3, 5, false)
- fm_drum(2, 1.5, 66, 0.3, 4, true)
+
+def fm_drum_test(start = 0.0, dur = 1.0)
+ $now = start
+ fm_drum($now, dur, 55, 0.3, 5, false)
+ $now += dur + 0.2
+ fm_drum($now, dur, 66, 0.3, 4, true)
+ $now += dur + 0.2
end
-=end
# FM-GONG
#
@@ -658,22 +775,34 @@ def gong(start, dur, freq, amp, *args)
rise = [0, 0, 15, 0.3, 30, 1.0, 75, 0.5, 100, 0]
fmup = [0, 0, 75, 1.0, 98, 1.0, 100, 0]
fmdwn = [0, 0, 2, 1.0, 100, 0]
- ampfun = make_env(:envelope, stretch_envelope(expf, atpt, atdur), :scaler, amp, :duration, dur)
- indxfun1 = make_env(:envelope, fmup, :scaler, indx11 - indx01, :duration, dur, :offset, indx01)
- indxfun2 = make_env(:envelope, fmdwn, :scaler, indx12 - indx02, :duration, dur, :offset, indx02)
- indxfun3 = make_env(:envelope, rise, :scaler, indx13 - indx03, :duration, dur, :offset, indx03)
+ ampfun = make_env(:envelope, stretch_envelope(expf, atpt, atdur),
+ :scaler, amp, :duration, dur)
+ indxfun1 = make_env(:envelope, fmup, :scaler, indx11 - indx01,
+ :duration, dur, :offset, indx01)
+ indxfun2 = make_env(:envelope, fmdwn, :scaler, indx12 - indx02,
+ :duration, dur, :offset, indx02)
+ indxfun3 = make_env(:envelope, rise, :scaler, indx13 - indx03,
+ :duration, dur, :offset, indx03)
carrier = make_oscil(:frequency, freq)
mod1 = make_oscil(:frequency, mfq1)
mod2 = make_oscil(:frequency, mfq2)
mod3 = make_oscil(:frequency, mfq3)
- run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, reverb_amount) do
- env(ampfun) * oscil(carrier,
- env(indxfun1) * oscil(mod1) + \
- env(indxfun2) * oscil(mod2) + \
- env(indxfun3) * oscil(mod3))
+ run_instrument(start, dur,
+ :degree, degree,
+ :distance, distance,
+ :reverb_amount, reverb_amount) do
+ env(ampfun) *
+ oscil(carrier,
+ env(indxfun1) * oscil(mod1) +
+ env(indxfun2) * oscil(mod2) +
+ env(indxfun3) * oscil(mod3))
end
end
-# with_sound() do gong(0, 3, 261.61, 0.6) end
+
+def gong_test(start = 0.0, dur = 1.0)
+ gong(start, dur, 261.61, 0.6)
+ $now = start + dur + 0.2
+end
# ATTRACT
#
@@ -692,14 +821,19 @@ def attract(start, dur, amp, c)
scale * x
end
end
-# with_sound() do attract(0, 0.25, 0.5, 2.0) end
+
+def attract_test(start = 0.0, dur = 1.0)
+ attract(start, dur, 0.5, 2.0)
+ $now = start + dur + 0.2
+end
# PQW
#
# phase-quadrature waveshaping used to create asymmetric (i.e. single
# side-band) spectra. The basic idea here is a variant of sin x sin y
# - cos x cos y = cos (x + y)
-def pqw(start, dur, spacing_freq, carrier_freq, amp, ampfun, indexfun, partials, *args)
+def pqw(start, dur, spacing_freq, carrier_freq,
+ amp, ampfun, indexfun, partials, *args)
degree, distance, reverb_amount = nil
optkey(args, binding,
[:degree, 0.0],
@@ -715,22 +849,31 @@ def pqw(start, dur, spacing_freq, carrier_freq, amp, ampfun, indexfun, partials,
amp_env = make_env(:envelope, ampfun, :scaler, amp, :duration, dur)
ind_env = make_env(:envelope, indexfun, :duration, dur)
r = carrier_freq / spacing_freq.to_f
- tr = make_triangle_wave(:frequency, 5, :amplitude, hz2radians(0.005 * spacing_freq))
- rn = make_rand_interp(:frequency, 12, :amplitude, hz2radians(0.005 * spacing_freq))
- run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, reverb_amount) do
+ tr = make_triangle_wave(:frequency, 5,
+ :amplitude, hz2radians(0.005 * spacing_freq))
+ rn = make_rand_interp(:frequency, 12,
+ :amplitude, hz2radians(0.005 * spacing_freq))
+ run_instrument(start, dur,
+ :degree, degree,
+ :distance, distance,
+ :reverb_amount, reverb_amount) do
vib = triangle_wave(tr) + rand_interp(rn)
ax = [1.0, env(ind_env)].min * oscil(spacing_cos, vib)
fax = polynomial(cos_coeffs, ax)
yfax = oscil(spacing_sin, vib) * polynomial(sin_coeffs, ax)
- env(amp_env) * (oscil(carrier_sin, vib * r) * yfax - \
- oscil(carrier_cos, vib * r) * fax)
+ env(amp_env) *
+ (oscil(carrier_sin, vib * r) * yfax -
+ oscil(carrier_cos, vib * r) * fax)
end
end
-# with_sound() do
-# pqw(0, 0.5, 200, 1000, 0.2, [0, 0, 25, 1, 100, 0], [0, 1, 100, 0], [2, 0.1, 3, 0.3, 6, 0.5])
-# end
-# to see the asymmetric spectrum most clearly, set the index function
-# above to [0, 1, 100, 1]
+
+def pqw_test(start = 0.0, dur = 1.0)
+ pqw(start, dur, 200, 1000, 0.2,
+ [0, 0, 25, 1, 100, 0], [0, 1, 100, 0], [2, 0.1, 3, 0.3, 6, 0.5])
+ $now = start + dur + 0.2
+ # to see the asymmetric spectrum most clearly, set the index function
+ # above to [0, 1, 100, 1]
+end
# taken from Perry Cook's stkv1.tar.Z (Synthesis Toolkit), but I was
# in a bit of a hurry and may not have made slavishly accurate
@@ -743,20 +886,27 @@ def tubebell(start, dur, freq, amp, base = 32.0)
osc1 = make_oscil(freq * 0.995 * 1.414)
osc2 = make_oscil(freq * 1.005)
osc3 = make_oscil(freq * 1.414)
- ampenv1 = make_env(:envelope, [0, 0, 0.005, 1, dur, 0], :base, base, :duration, dur)
- ampenv2 = make_env(:envelope, [0, 0, 0.001, 1, dur, 0], :base, 2 * base, :duration, dur)
+ ampenv1 = make_env(:envelope, [0, 0, 0.005, 1, dur, 0],
+ :base, base, :duration, dur)
+ ampenv2 = make_env(:envelope, [0, 0, 0.001, 1, dur, 0],
+ :base, 2 * base, :duration, dur)
ampmod = make_oscil(:frequency, 2.0)
g0 = 0.5 * amp * 0.707
g1 = 0.203
g2 = 0.5 * amp
g3 = 0.144
run_instrument(start, dur) do
- (0.007 * oscil(ampmod) + 0.993) * \
- (g0 * env(ampenv1) * oscil(osc0, g1 * oscil(osc1)) + \
- g2 * env(ampenv2) * oscil(osc2, g3 * oscil(osc3)))
+ (0.007 *
+ oscil(ampmod) + 0.993) *
+ (g0 * env(ampenv1) * oscil(osc0, g1 * oscil(osc1)) +
+ g2 * env(ampenv2) * oscil(osc2, g3 * oscil(osc3)))
end
end
-# with_sound() do tubebell(0, 2, 440, 0.2) end
+
+def tubebell_test(start = 0.0, dur = 1.0)
+ tubebell(start, dur, 440, 0.2, 32)
+ $now = start + dur + 0.2
+end
# from Perry Cook's Wurley.cpp
def wurley(start, dur, freq, amp)
@@ -771,16 +921,22 @@ def wurley(start, dur, freq, amp)
g3 = 0.117
dur = [dur, 0.3].max
ampenv = make_env(:envelope, [0, 0, 1, 1, 9, 1, 10, 0], :duration, dur)
- indenv = make_env(:envelope, [0, 0, 0.001, 1, 0.15, 0, dur, 0], :duration, dur)
- resenv = make_env(:envelope, [0, 0, 0.001, 1, 0.25, 0, dur, 0], :duration, dur)
+ indenv = make_env(:envelope, [0, 0, 0.001, 1, 0.15, 0, dur, 0],
+ :duration, dur)
+ resenv = make_env(:envelope, [0, 0, 0.001, 1, 0.25, 0, dur, 0],
+ :duration, dur)
run_instrument(start, dur) do
- env(ampenv) * \
- (1.0 + 0.007 * oscil(ampmod)) * \
- (g0 * oscil(osc0, g1 * oscil(osc1)) + \
- env(resenv) * g2 * oscil(osc2, g3 * env(indenv) * oscil(osc3)))
+ env(ampenv) *
+ (1.0 + 0.007 * oscil(ampmod)) *
+ (g0 * oscil(osc0, g1 * oscil(osc1)) +
+ env(resenv) * g2 * oscil(osc2, g3 * env(indenv) * oscil(osc3)))
end
end
-# with_sound() do wurley(0, 0.25, 440, 0.2) end
+
+def wurley_test(start = 0.0, dur = 1.0)
+ wurley(start, dur, 440, 0.2)
+ $now = start + dur + 0.2
+end
# from Perry Cook's Rhodey.cpp
def rhodey(start, dur, freq, amp, base = 0.5)
@@ -789,19 +945,26 @@ def rhodey(start, dur, freq, amp, base = 0.5)
osc2 = make_oscil(freq)
osc3 = make_oscil(freq * 15.0)
dur = [dur, 0.3].max
- ampenv1 = make_env(:envelope, [0, 0, 0.005, 1, dur, 0], :base, base, :duration, dur)
- ampenv2 = make_env(:envelope, [0, 0, 0.001, 1, dur, 0], :base, base * 1.5, :duration, dur)
- ampenv3 = make_env(:envelope, [0, 0, 0.001, 1, 0.25, 0, dur, 0], :base, base * 4, :duration, dur)
+ ampenv1 = make_env(:envelope, [0, 0, 0.005, 1, dur, 0],
+ :base, base, :duration, dur)
+ ampenv2 = make_env(:envelope, [0, 0, 0.001, 1, dur, 0],
+ :base, base * 1.5, :duration, dur)
+ ampenv3 = make_env(:envelope, [0, 0, 0.001, 1, 0.25, 0, dur, 0],
+ :base, base * 4, :duration, dur)
g0 = 0.5 * amp
g1 = 0.535
g2 = 0.5 * amp
g3 = 0.109
run_instrument(start, dur) do
- g0 * env(ampenv1) * oscil(osc0, g1 * oscil(osc1)) + \
+ g0 * env(ampenv1) * oscil(osc0, g1 * oscil(osc1)) +
g2 * env(ampenv2) * oscil(osc2, env(ampenv3) * g3 * oscil(osc3))
end
end
-# with_sound() do rhodey(0, 0.25, 440, 0.2) end
+
+def rhodey_test(start = 0.0, dur = 1.0)
+ rhodey(start, dur, 440, 0.2, 0.5)
+ $now = start + dur + 0.2
+end
# from Perry Cook's BeeThree.cpp
def hammondoid(start, dur, freq, amp)
@@ -810,18 +973,26 @@ def hammondoid(start, dur, freq, amp)
osc2 = make_oscil(freq * 3.006)
osc3 = make_oscil(freq * 6.009)
dur = [dur, 0.1].max
- ampenv1 = make_env(:envelope, [0, 0, 0.005, 1, dur - 0.008, 1, dur, 0], :duration, dur)
+ ampenv1 = make_env(:envelope, [0, 0, 0.005, 1, dur - 0.008, 1, dur, 0],
+ :duration, dur)
ampenv2 = make_env(:envelope, [0, 0, 0.005, 1, dur, 0], :duration, dur)
g0 = 0.25 * 0.75 * amp
g1 = 0.25 * 0.75 * amp
g2 = 0.5 * amp
g3 = 0.5 * 0.75 * amp
run_instrument(start, dur) do
- env(ampenv1) * (g0 * oscil(osc0) + g1 * oscil(osc1) + g2 * oscil(osc2)) + \
- env(ampenv2) * g3 * oscil(osc3)
+ env(ampenv1) *
+ (g0 * oscil(osc0) +
+ g1 * oscil(osc1) +
+ g2 * oscil(osc2)) +
+ env(ampenv2) * g3 * oscil(osc3)
end
end
-# with_sound() do hammondoid(0, 0.25, 440, 0.2) end
+
+def hammondoid_test(start = 0.0, dur = 1.0)
+ hammondoid(start, dur, 440, 0.2)
+ $now = start + dur + 0.2
+end
# from Perry Cook's HeavyMtl.cpp
def metal(start, dur, freq, amp)
@@ -830,38 +1001,55 @@ def metal(start, dur, freq, amp)
osc2 = make_oscil(freq * 3.0 * 1.001)
osc3 = make_oscil(freq * 0.5 * 1.002)
dur = [dur, 0.1].max
- ampenv0 = make_env(:envelope, [0, 0, 0.001, 1, dur - 0.002, 1, dur, 0], :duration, dur)
- ampenv1 = make_env(:envelope, [0, 0, 0.001, 1, dur - 0.011, 1, dur, 0], :duration, dur)
- ampenv2 = make_env(:envelope, [0, 0, 0.01, 1, dur - 0.015, 1, dur, 0], :duration, dur)
- ampenv3 = make_env(:envelope, [0, 0, 0.03, 1, dur - 0.04, 1, dur, 0], :duration, dur)
+ ampenv0 = make_env(:envelope, [0, 0, 0.001, 1, dur - 0.002, 1, dur, 0],
+ :duration, dur)
+ ampenv1 = make_env(:envelope, [0, 0, 0.001, 1, dur - 0.011, 1, dur, 0],
+ :duration, dur)
+ ampenv2 = make_env(:envelope, [0, 0, 0.01, 1, dur - 0.015, 1, dur, 0],
+ :duration, dur)
+ ampenv3 = make_env(:envelope, [0, 0, 0.03, 1, dur - 0.04, 1, dur, 0],
+ :duration, dur)
g0 = 0.615 * amp
g1 = 0.202
g2 = 0.574
g3 = 0.116
run_instrument(start, dur) do
- g0 * env(ampenv0) * oscil(osc0,
- g1 * env(ampenv1) * oscil(osc1, g2 * env(ampenv2) * oscil(osc2)) + \
- g3 * env(ampenv3) * oscil(osc3))
+ g0 *
+ env(ampenv0) *
+ oscil(osc0,
+ g1 * env(ampenv1) * oscil(osc1, g2 * env(ampenv2) * oscil(osc2)) +
+ g3 * env(ampenv3) * oscil(osc3))
end
end
-# with_sound() do metal(0, 0.25, 440, 0.2) end
+
+def metal_test(start = 0.0, dur = 1.0)
+ metal(start, dur, 440, 0.2)
+ $now = start + dur + 0.2
+end
# DRONE
-def drone(start, dur, freq, amp, ampfun, synth, ampat, ampdc, amtrev, deg, dis, rvibamt, rvibfreq)
+def drone(start, dur, freq, amp, ampfun, synth,
+ ampat, ampdc, amtrev, deg, dis, rvibamt, rvibfreq)
waveform = partials2wave(synth)
amp *= 0.25
s = make_table_lookup(:frequency, freq, :wave, waveform)
- amp_env = make_env(:envelope, stretch_envelope(ampfun, 25, 100 * (ampat / dur.to_f), 75,
- 100 - 100 * (ampdc / dur.to_f)),
+ amp_env = make_env(:envelope,
+ stretch_envelope(ampfun, 25, 100 * (ampat / dur.to_f), 75,
+ 100 - 100 * (ampdc / dur.to_f)),
:scaler, amp, :duration, dur)
- ran_vib = make_rand(:frequency, rvibfreq, :amplitude, hz2radians(rvibamt * freq))
- run_instrument(start, dur, :distance, dis, :degree, deg, :reverb_amount, amtrev) do
+ ran_vib = make_rand(:frequency, rvibfreq,
+ :amplitude, hz2radians(rvibamt * freq))
+ run_instrument(start, dur,
+ :distance, dis,
+ :degree, deg,
+ :reverb_amount, amtrev) do
env(amp_env) * table_lookup(s, rand(ran_vib).abs)
end
end
# CANTER
-def canter(start, dur, pitch, amp, deg, dis, pcrev, ampfun, ranfun, skewfun, skewpc,
+def canter(start, dur, pitch, amp, deg, dis, pcrev,
+ ampfun, ranfun, skewfun, skewpc,
ranpc, ranfreq, indexfun, atdr, dcdr,
ampfun1, indfun1, fmtfun1,
ampfun2, indfun2, fmtfun2,
@@ -896,35 +1084,51 @@ def canter(start, dur, pitch, amp, deg, dis, pcrev, ampfun, ranfun, skewfun, ske
dev14 = hz2radians(envelope_interp(k, indfun4) * mfq)
dev04 = dev14 * 0.5
lamp4 = envelope_interp(k, ampfun4) * amp * (1 - (harm4 - lfmt4 / pitch).abs)
- tampfun = make_env(:envelope, stretch_envelope(ampfun, 25, atpt, 75, dcpt), :duration, dur)
+ tampfun = make_env(:envelope, stretch_envelope(ampfun, 25, atpt, 75, dcpt),
+ :duration, dur)
tskwfun = make_env(:envelope, stretch_envelope(skewfun, 25, atpt, 75, dcpt),
:scaler, hz2radians(pitch * skewpc.to_f), :duration, dur)
- tranfun = make_env(:envelope, stretch_envelope(ranfun, 25, atpt, 75, dcpt), :duration, dur)
- tidxfun = make_env(:envelope, stretch_envelope(indexfun, 25, atpt, 75, dcpt), :duration, dur)
+ tranfun = make_env(:envelope, stretch_envelope(ranfun, 25, atpt, 75, dcpt),
+ :duration, dur)
+ tidxfun = make_env(:envelope, stretch_envelope(indexfun, 25, atpt, 75, dcpt),
+ :duration, dur)
modgen = make_oscil(:frequency, pitch)
gen1 = make_oscil(:frequency, pitch * harm1)
gen2 = make_oscil(:frequency, pitch * harm2)
gen3 = make_oscil(:frequency, pitch * harm3)
gen4 = make_oscil(:frequency, pitch * harm4)
ranvib = make_rand(:frequency, ranfreq, :amplitude, hz2radians(ranpc * pitch))
- run_instrument(start, dur, :degree, deg, :distance, dis, :reverb_amount, pcrev) do
+ run_instrument(start, dur,
+ :degree, deg,
+ :distance, dis,
+ :reverb_amount, pcrev) do
frqval = env(tskwfun) + env(tranfun) * rand(ranvib)
modval = oscil(modgen, frqval)
ampval = env(tampfun)
indval = env(tidxfun)
- lamp1 * ampval * oscil(gen1, ((dev01 + indval * dev11) * modval + frqval) * harm1) + \
- lamp2 * ampval * oscil(gen2, ((dev02 + indval * dev12) * modval + frqval) * harm2) + \
- lamp3 * ampval * oscil(gen3, ((dev03 + indval * dev13) * modval + frqval) * harm3) + \
- lamp4 * ampval * oscil(gen4, ((dev04 + indval * dev14) * modval + frqval) * harm4)
+ lamp1 *
+ ampval *
+ oscil(gen1, ((dev01 + indval * dev11) * modval + frqval) * harm1) +
+ lamp2 *
+ ampval *
+ oscil(gen2, ((dev02 + indval * dev12) * modval + frqval) * harm2) +
+ lamp3 *
+ ampval *
+ oscil(gen3, ((dev03 + indval * dev13) * modval + frqval) * harm3) +
+ lamp4 *
+ ampval *
+ oscil(gen4, ((dev04 + indval * dev14) * modval + frqval) * harm4)
end
end
# NREV (the most popular Samson box reverb)
#
-# reverb_factor controls the length of the decay -- it should not exceed (/ 1.0 .823)
-# lp_coeff controls the strength of the low pass filter inserted in the feedback loop
+# reverb_factor controls the length of the decay -- it should not
+# exceed (/ 1.0 .823)
+# lp_coeff controls the strength of the low pass filter inserted
+# in the feedback loop
# volume can be used to boost the reverb output
-def nrev_rb(*args)
+def nrev(*args)
reverb_factor, lp_coeff, volume = nil
optkey(args, binding,
[:reverb_factor, 1.09],
@@ -938,7 +1142,8 @@ def nrev_rb(*args)
end
end
srscale = @srate / 25641
- dly_len = [1433, 1601, 1867, 2053, 2251, 2399, 347, 113, 37, 59, 53, 43, 37, 29, 19]
+ dly_len = [1433, 1601, 1867, 2053, 2251, 2399,
+ 347, 113, 37, 59, 53, 43, 37, 29, 19]
dly_len.map! do |x|
val = (x * srscale).round
val += 1 if val.even?
@@ -961,7 +1166,7 @@ def nrev_rb(*args)
allpass6 = (chan2 ? make_all_pass(-0.7, 0.7, dly_len[12]) : nil)
allpass7 = (chan4 ? make_all_pass(-0.7, 0.7, dly_len[13]) : nil)
allpass8 = (chan4 ? make_all_pass(-0.7, 0.7, dly_len[14]) : nil)
- reverb_frame = make_frame(@channels)
+ out_frample = Vct.new(@channels, 0.0)
run_reverb() do |val, i|
rev = volume * val
outrev = all_pass(allpass4,
@@ -969,26 +1174,25 @@ def nrev_rb(*args)
all_pass(allpass3,
all_pass(allpass2,
all_pass(allpass1,
- comb(comb1, rev) + \
- comb(comb2, rev) + \
- comb(comb3, rev) + \
- comb(comb4, rev) + \
- comb(comb5, rev) + \
+ comb(comb1, rev) +
+ comb(comb2, rev) +
+ comb(comb3, rev) +
+ comb(comb4, rev) +
+ comb(comb5, rev) +
comb(comb6, rev))))))
- frame_set!(reverb_frame, 0, all_pass(allpass5, outrev))
- frame_set!(reverb_frame, 1, all_pass(allpass6, outrev)) if chan2
- frame_set!(reverb_frame, 2, all_pass(allpass7, outrev)) if chan4
- frame_set!(reverb_frame, 3, all_pass(allpass8, outrev)) if chan4
- reverb_frame
+ out_frample[0] = all_pass(allpass5, outrev)
+ if chan2
+ out_frample[1] = all_pass(allpass6, outrev)
+ end
+ if chan4
+ out_frample[2] = all_pass(allpass7, outrev)
+ out_frample[3] = all_pass(allpass8, outrev)
+ end
+ out_frample
end
end
-class Snd_Instrument
- alias nrev nrev_rb
-end
-
-=begin
-with_sound(:reverb, :nrev) do
+def drone_canter_test(start = 0.0, dur = 1.0)
fmt1 = [0, 1200, 100, 1000]
fmt2 = [0, 2250, 100, 1800]
fmt3 = [0, 4500, 100, 4500]
@@ -1006,52 +1210,72 @@ with_sound(:reverb, :nrev) do
ranf = [0, 0.5, 100, 0.5]
index = [0, 1, 100, 1]
solid = [0, 0, 5, 1, 95, 1, 100, 0]
- bassdr2 = [0.5, 0.06, 1, 0.62, 1.5, 0.07, 2, 0.6, 2.5, 0.08, 3, 0.56, 4, 0.24, 5, 0.98, 6, 0.53,
- 7, 0.16, 8, 0.33, 9, 0.62, 10, 0.12, 12, 0.14, 14, 0.86, 16, 0.12, 23, 0.14, 24, 0.17]
- tenordr = [0.3, 0.04, 1, 0.81, 2, 0.27, 3, 0.2, 4, 0.21, 5, 0.18, 6, 0.35, 7, 0.03,
- 8, 0.07, 9, 0.02, 10, 0.025, 11, 0.035]
-
- drone(0, 4, 115, 0.125, solid, bassdr2, 0.1, 0.5, 0.03, 45, 1, 0.01, 10)
- drone(0, 4, 229, 0.125, solid, tenordr, 0.1, 0.5, 0.03, 45, 1, 0.01, 11)
- drone(0, 4, 229.5, 0.125, solid, tenordr, 0.1, 0.5, 0.03, 45, 1, 0.01, 9)
- canter(0.000, 2.100, 918.000, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.05, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(2.100, 0.300, 688.500, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(2.400, 0.040, 826.200, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(2.440, 0.560, 459.000, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.000, 0.040, 408.000, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.040, 0.040, 619.650, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.080, 0.040, 408.000, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.120, 0.040, 688.500, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.160, 0.290, 459.000, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.450, 0.150, 516.375, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.600, 0.040, 826.200, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.640, 0.040, 573.750, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.680, 0.040, 619.650, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.720, 0.180, 573.750, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.900, 0.040, 688.500, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
- canter(3.940, 0.260, 459.000, 0.175, 45.0, 1, 0.05, ampf, ranf, skwf, 0.050, 0.01, 10, index,
- 0.005, 0.005, amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ bassdr2 = [0.5, 0.06, 1, 0.62, 1.5, 0.07, 2, 0.6, 2.5, 0.08, 3, 0.56,
+ 4, 0.24, 5, 0.98, 6, 0.53, 7, 0.16, 8, 0.33, 9, 0.62, 10, 0.12,
+ 12, 0.14, 14, 0.86, 16, 0.12, 23, 0.14, 24, 0.17]
+ tenordr = [0.3, 0.04, 1, 0.81, 2, 0.27, 3, 0.2, 4, 0.21, 5, 0.18,
+ 6, 0.35, 7, 0.03, 8, 0.07, 9, 0.02, 10, 0.025, 11, 0.035]
+
+ $now = start
+ drone($now, 4, 115, 0.125, solid, bassdr2, 0.1, 0.5, 0.03, 45, 1, 0.01, 10)
+ drone($now, 4, 229, 0.125, solid, tenordr, 0.1, 0.5, 0.03, 45, 1, 0.01, 11)
+ drone($now, 4, 229.5, 0.125, solid, tenordr, 0.1, 0.5, 0.03, 45, 1, 0.01, 9)
+ canter($now, 2.100, 918.000, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 2.100, 0.300, 688.500, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 2.400, 0.040, 826.200, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 2.440, 0.560, 459.000, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.000, 0.040, 408.000, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.040, 0.040, 619.650, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.080, 0.040, 408.000, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.120, 0.040, 688.500, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.160, 0.290, 459.000, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.450, 0.150, 516.375, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.600, 0.040, 826.200, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.640, 0.040, 573.750, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.680, 0.040, 619.650, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.720, 0.180, 573.750, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.900, 0.040, 688.500, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ canter($now + 3.940, 0.260, 459.000, 0.175, 45.0, 1, 0.05,
+ ampf, ranf, skwf, 0.050, 0.01, 10, index, 0.005, 0.005,
+ amp1, ind1, fmt1, amp2, ind2, fmt2, amp3, ind3, fmt3, amp4, ind4, fmt4)
+ $now += 4.4
end
-=end
# RESON
-def reson(start, dur, pitch, amp, numformants, indxfun, skewfun, pcskew, skewat, skewdc,
- vibfreq, vibpc, ranvibfreq, ranvibpc, degree, distance, rev_amount, data)
+def reson(start, dur, pitch, amp, numformants,
+ indxfun, skewfun, pcskew, skewat, skewdc,
+ vibfreq, vibpc, ranvibfreq, ranvibpc,
+ degree, distance, rev_amount, data)
# data is a list of lists of form
# [ampf, resonfrq, resonamp, ampat, ampdc, dev0, dev1, indxat, indxdc]
dur = dur.to_f
@@ -1061,13 +1285,18 @@ def reson(start, dur, pitch, amp, numformants, indxfun, skewfun, pcskew, skewat,
ampfs = Array.new(numformants)
indfs = Array.new(numformants)
c_rats = Array.new(numformants)
- frqf = make_env(:envelope, stretch_envelope(skewfun, 25, 100 * (skewat / dur), 75,
- 100 - (100 * (skewdc / dur))),
+ frqf = make_env(:envelope,
+ stretch_envelope(skewfun, 25, 100 * (skewat / dur), 75,
+ 100 - (100 * (skewdc / dur))),
:scaler, hz2radians(pcskew * pitch), :duration, dur)
- pervib = make_triangle_wave(:frequency, vibfreq, :amplitude, hz2radians(vibpc * pitch))
- ranvib = make_rand_interp(:frequency, ranvibfreq, :amplitude, hz2radians(ranvibpc * pitch))
+ pervib = make_triangle_wave(:frequency, vibfreq,
+ :amplitude, hz2radians(vibpc * pitch))
+ ranvib = make_rand_interp(:frequency, ranvibfreq,
+ :amplitude, hz2radians(ranvibpc * pitch))
totalamp = 0.0
- numformants.times do |i| totalamp += data[i][2] end
+ numformants.times do |i|
+ totalamp += data[i][2]
+ end
numformants.times do |i|
frmdat = data[i]
ampf = frmdat[0]
@@ -1086,36 +1315,50 @@ def reson(start, dur, pitch, amp, numformants, indxfun, skewfun, pcskew, skewat,
ampdc = 75 if ampdc.zero?
indxat = 25 if indxat.zero?
indxdc = 75 if indxdc.zero?
- indfs[i] = make_env(:envelope, stretch_envelope(indxfun, 25, indxat, 75, indxdc),
- :scaler, dev1 - dev0, :offset, dev0, :duration, dur)
- ampfs[i] = make_env(:envelope, stretch_envelope(ampf, 25, ampat, 75, ampdc),
- :scaler, rsamp * amp * (rfamp / totalamp), :duration, dur)
+ indfs[i] = make_env(:envelope,
+ stretch_envelope(indxfun, 25, indxat, 75, indxdc),
+ :scaler, dev1 - dev0,
+ :offset, dev0,
+ :duration, dur)
+ ampfs[i] = make_env(:envelope,
+ stretch_envelope(ampf, 25, ampat, 75, ampdc),
+ :scaler, rsamp * amp * (rfamp / totalamp),
+ :duration, dur)
c_rats[i] = harm
carriers[i] = make_oscil(:frequency, cfq)
end
- run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, rev_amount) do
+ run_instrument(start, dur,
+ :degree, degree,
+ :distance, distance,
+ :reverb_amount, rev_amount) do
vib = triangle_wave(pervib) + rand_interp(ranvib) + env(frqf)
modsig = oscil(modulator, vib)
outsum = 0.0
numformants.times do |j|
- outsum = outsum + env(ampfs[j]) * oscil(carriers[j], vib * c_rats[j] + env(indfs[j]) * modsig)
+ outsum += env(ampfs[j]) *
+ oscil(carriers[j],
+ vib * c_rats[j] +
+ env(indfs[j]) * modsig)
end
outsum
end
end
-=begin
-with_sound() do
- reson(0, 1.0, 440, 0.1, 2, [0, 0, 100, 1], [0, 0, 100, 1], 0.1, 0.1, 0.1, 5, 0.01, 5,
- 0.01, 0, 1.0, 0.01, [[[0, 0, 100, 1], 1200, 0.5, 0.1, 0.1, 0, 1.0, 0.1, 0.1],
- [[0, 1, 100, 0], 2400, 0.5, 0.1, 0.1, 0, 1.0, 0.1, 0.1]])
+
+def reson_test(start = 0.0, dur = 1.0)
+ data = [[[0, 0, 100, 1], 1200, 0.5, 0.1, 0.1, 0, 1.0, 0.1, 0.1],
+ [[0, 1, 100, 0], 2400, 0.5, 0.1, 0.1, 0, 1.0, 0.1, 0.1]]
+
+ reson(start, dur, 440, 0.5, 2, [0, 0, 100, 1], [0, 0, 100, 1],
+ 0.1, 0.1, 0.1, 5, 0.01, 5, 0.01, 0, 1.0, 0.01, data)
+ $now = start + dur + 0.2
end
-=end
# STK's feedback-fm instrument named CelloN in Sambox-land
def cellon(start, dur, pitch0, amp, ampfun, betafun,
beta0, beta1, betaat, betadc, ampat, ampdc, dis, pcrev, deg, pitch1,
glissfun = [0, 0, 100, 0], glissat = 0.0, glissdc = 0.0,
- pvibfreq = 0.0, pvibpc = 0.0, pvibfun = [0, 1, 100, 1], pvibat = 0.0, pvibdc = 0.0,
+ pvibfreq = 0.0, pvibpc = 0.0,
+ pvibfun = [0, 1, 100, 1], pvibat = 0.0, pvibdc = 0.0,
rvibfreq = 0.0, rvibpc = 0.0, rvibfun = [0, 1, 100, 1])
pit1 = pitch1.zero? ? pitch0 : pitch1
@@ -1135,31 +1378,48 @@ def cellon(start, dur, pitch0, amp, ampfun, betafun,
betdp = (betadc > 0.0 ? (100 * (1.0 - betadc / dur)) : 75)
pvbap = (pvibat > 0.0 ? (100 * (pvibat / dur)) : 25)
pvbdp = (pvibdc > 0.0 ? (100 * (1.0 - pvibdc / dur)) : 75)
- pvibenv = make_env(:envelope, stretch_envelope(pvibfun, 25, pvbap, 75, pvbdp),
- :scaler, hz2radians(pvibpc * pitch0), :duration, dur)
- rvibenv = make_env(:envelope, stretch_envelope(rvibfun), :duration, dur,
+ pvibenv = make_env(:envelope,
+ stretch_envelope(pvibfun, 25, pvbap, 75, pvbdp),
+ :scaler, hz2radians(pvibpc * pitch0),
+ :duration, dur)
+ rvibenv = make_env(:envelope, stretch_envelope(rvibfun),
+ :duration, dur,
:scaler, hz2radians(rvibpc * pitch0))
- glisenv = make_env(:envelope, stretch_envelope(glissfun, 25, glsap, 75, glsdp),
- :scaler, hz2radians(pit1 - pitch0), :duration, dur)
+ glisenv = make_env(:envelope,
+ stretch_envelope(glissfun, 25, glsap, 75, glsdp),
+ :scaler, hz2radians(pit1 - pitch0),
+ :duration, dur)
amplenv = make_env(:envelope, stretch_envelope(ampfun, 25, ampap, 75, ampdp),
- :scaler, amp, :duration, dur)
+ :scaler, amp,
+ :duration, dur)
betaenv = make_env(:envelope, stretch_envelope(betafun, 25, betap, 75, betdp),
- :scaler, beta1 - beta0, :offset, beta0, :duration, dur)
- run_instrument(start, dur, :degree, deg, :distance, dis, :reverb_amount, pcrev) do
- vib = env(pvibenv) * triangle_wave(pvib) + env(rvibenv) * rand_interp(rvib) + env(glisenv)
+ :scaler, beta1 - beta0,
+ :offset, beta0,
+ :duration, dur)
+ run_instrument(start, dur,
+ :degree, deg,
+ :distance, dis,
+ :reverb_amount, pcrev) do
+ vib = env(pvibenv) * triangle_wave(pvib) +
+ env(rvibenv) * rand_interp(rvib) +
+ env(glisenv)
fm = one_zero(low, env(betaenv) * oscil(fmosc, fm + vib))
env(amplenv) * oscil(car, fm + vib)
end
end
-=begin
-with_sound() do
- cellon(0, 1, 220, 0.1,
- [0, 0, 25, 1, 75, 1, 100, 0],
- [0, 0, 25, 1, 75, 1, 100, 0], 0.75, 1.0, 0, 0, 0, 0, 1, 0, 0, 220,
- [0, 0, 25, 1, 75, 1, 100, 0], 0, 0, 0, 0,
- [0, 0, 100, 0], 0, 0, 0, 0, [0, 0, 100, 0])
+
+def cellon_test(start = 0.0, dur = 1.0)
+ cellon(start, dur, 220, 0.5,
+ [0, 0, 25, 1, 75, 1, 100, 0], # ampfun
+ [0, 0, 25, 1, 75, 1, 100, 0], # betafun
+ 0.75, 1.0, 0, 0, 0, 0, 1, 0, 0, 220,
+ [0, 0, 25, 1, 75, 1, 100, 0], # glissfun
+ 0, 0, 0, 0,
+ [0, 0, 100, 0], # pvibfun
+ 0, 0, 0, 0,
+ [0, 0, 100, 0]) # rvibfun
+ $now = start + dur + 0.2
end
-=end
# JL-REVERB
def jl_reverb(*args)
@@ -1172,35 +1432,45 @@ def jl_reverb(*args)
comb4 = make_comb(0.697, 11597)
outdel1 = make_delay((0.013 * @srate).round)
outdel2 = (@channels > 1 ? make_delay((0.011 * @srate).round) : false)
- reverb_frame = make_frame(@channels)
+ out_frample = Vct.new(@channels, 0.0)
run_reverb() do |ho, i|
allpass_sum = all_pass(allpass3, all_pass(allpass2, all_pass(allpass1, ho)))
- comb_sum = (comb(comb1, allpass_sum) + comb(comb2, allpass_sum) + \
+ comb_sum = (comb(comb1, allpass_sum) + comb(comb2, allpass_sum) +
comb(comb3, allpass_sum) + comb(comb4, allpass_sum))
- frame_set!(reverb_frame, 0, delay(outdel1, comb_sum))
- frame_set!(reverb_frame, 1, delay(outdel2, comb_sum)) if outdel2
- reverb_frame
+ out_frample[0] = delay(outdel1, comb_sum)
+ if outdel2
+ out_frample[1] = delay(outdel2, comb_sum)
+ end
+ out_frample
end
end
# GRAN-SYNTH
def gran_synth(start, dur, freq, grain_dur, interval, amp)
- grain_env = make_env(:envelope, [0, 0, 25, 1, 75, 1, 100, 0], :duration, grain_dur)
+ grain_env = make_env(:envelope, [0, 0, 25, 1, 75, 1, 100, 0],
+ :duration, grain_dur)
carrier = make_oscil(:frequency, freq)
grain_size = ([grain_dur, interval].max * @srate).ceil
grains = make_wave_train(:size, grain_size, :frequency, 1.0 / interval)
grain = mus_data(grains)
- grain_size.times do |i| grain[i] = env(grain_env) * oscil(carrier) end
+ grain_size.times do |i|
+ grain[i] = env(grain_env) * oscil(carrier)
+ end
run_instrument(start, dur) do
amp * wave_train(grains)
end
end
-# with_sound() do gran_synth(0, 2, 100, 0.0189, 0.02, 0.4) end
+
+def gran_synth_test(start = 0.0, dur = 1.0)
+ gran_synth(start, dur, 100, 0.0189, 0.02, 0.4)
+ $now = start + dur + 0.2
+end
# TOUCH-TONE
def touch_tone(start, number)
touch_tab_1 = [0, 697, 697, 697, 770, 770, 770, 852, 852, 852, 941, 941, 941]
- touch_tab_2 = [0, 1209, 1336, 1477, 1209, 1336, 1477, 1209, 1336, 1477, 1209, 1336, 1477]
+ touch_tab_2 = [0, 1209, 1336, 1477, 1209, 1336,
+ 1477, 1209, 1336, 1477, 1209, 1336, 1477]
number.length.times do |i|
k = number[i]
ii = if k.kind_of?(Numeric)
@@ -1210,12 +1480,16 @@ def touch_tone(start, number)
end
frq1 = make_oscil(:frequency, touch_tab_1[ii])
frq2 = make_oscil(:frequency, touch_tab_2[ii])
- run_instrument(start + i * 0.4, 0.3) do
- 0.1 * (oscil(frq1) + oscil(frq2))
+ run_instrument(start + i * 0.3, 0.2) do
+ 0.25 * (oscil(frq1) + oscil(frq2))
end
end
end
-# with_sound() do touch_tone(0, [7, 2, 3, 4, 9, 7, 1]) end
+
+def touch_tone_test(start = 0.0, dur = 1.0)
+ touch_tone(start, [4, 8, 3, 4, 6, 2, 1])
+ $now = start + dur * 7 + 0.2 # 7 digits
+end
# SPECTRA
def spectra(start, dur, freq, amp,
@@ -1230,17 +1504,24 @@ def spectra(start, dur, freq, amp,
frq = hz2radians(freq)
s = make_table_lookup(:frequency, freq, :wave, waveform)
amp_env = make_env(:envelope, amp_envelope, :scaler, amp, :duration, dur)
- per_vib = make_triangle_wave(:frequency, vibrato_speed, :amplitude, vibrato_amplitude * frq)
- ran_vib = make_rand_interp(:frequency, vibrato_speed + 1.0, :amplitude, vibrato_amplitude * frq)
- run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, rev_amount) do
- env(amp_env) * table_lookup(s, triangle_wave(per_vib) + rand_interp(ran_vib))
+ per_vib = make_triangle_wave(:frequency, vibrato_speed,
+ :amplitude, vibrato_amplitude * frq)
+ ran_vib = make_rand_interp(:frequency, vibrato_speed + 1.0,
+ :amplitude, vibrato_amplitude * frq)
+ run_instrument(start, dur,
+ :degree, degree,
+ :distance, distance,
+ :reverb_amount, rev_amount) do
+ env(amp_env) *
+ table_lookup(s, triangle_wave(per_vib) + rand_interp(ran_vib))
end
end
-=begin
-with_sound() do
- spectra(0, 1, 440.0, 0.8, P_a4, [0, 0, 1, 1, 5, 0.9, 12, 0.5, 25, 0.25, 100, 0])
+
+def spectra_test(start = 0.0, dur = 1.0)
+ spectra(start, dur, 440.0, 0.8, P_a4,
+ [0, 0, 1, 1, 5, 0.9, 12, 0.5, 25, 0.25, 100, 0])
+ $now = start + dur + 0.2
end
-=end
# TWO-TAB
#
@@ -1263,419 +1544,539 @@ def two_tab(start, dur, freq, amp,
s_2 = make_table_lookup(:frequency, freq, :wave, waveform_2)
amp_env = make_env(:envelope, amp_envelope, :scaler, amp, :duration, dur)
interp_env = make_env(:envelope, interp_func, :duration, dur)
- per_vib = make_triangle_wave(:frequency, vibrato_speed, :amplitude, vibrato_amplitude * frq)
- ran_vib = make_rand_interp(:frequency, vibrato_speed + 1.0, :amplitude, vibrato_amplitude * frq)
- run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, rev_amount) do
+ per_vib = make_triangle_wave(:frequency, vibrato_speed,
+ :amplitude, vibrato_amplitude * frq)
+ ran_vib = make_rand_interp(:frequency, vibrato_speed + 1.0,
+ :amplitude, vibrato_amplitude * frq)
+ run_instrument(start, dur,
+ :degree, degree,
+ :distance, distance,
+ :reverb_amount, rev_amount) do
vib = triangle_wave(per_vib) + rand_interp(ran_vib)
intrp = env(interp_env)
- env(amp_env) * (intrp * table_lookup(s_1, vib) + (1.0 - intrp) * table_lookup(s_2, vib))
+ env(amp_env) *
+ (intrp * table_lookup(s_1, vib) +
+ (1.0 - intrp) * table_lookup(s_2, vib))
end
end
-# with_sound() do two_tab(0, 1, 440, 0.5) end
+
+def two_tab_test(start = 0.0, dur = 1.0)
+ two_tab(start, dur, 440, 0.5)
+ $now = start + dur + 0.2
+end
# LBJ-PIANO
$clm_piano_attack_duration = 0.04
$clm_piano_release_duration = 0.2
$clm_db_drop_per_second = -10.0
-Piano_Spectra = [[1.97, 0.0326, 2.99, 0.0086, 3.95, 0.0163, 4.97, 0.0178, 5.98, 0.0177, 6.95, 0.0315, 8.02, 0.0001,
- 8.94, 0.0076, 9.96, 0.0134, 10.99, 0.0284, 11.98, 0.0229, 13.02, 0.0229, 13.89, 0.0010, 15.06, 0.0090, 16.00, 0.0003,
- 17.08, 0.0078, 18.16, 0.0064, 19.18, 0.0129, 20.21, 0.0085, 21.27, 0.0225, 22.32, 0.0061, 23.41, 0.0102, 24.48, 0.0005,
- 25.56, 0.0016, 26.64, 0.0018, 27.70, 0.0113, 28.80, 0.0111, 29.91, 0.0158, 31.06, 0.0093, 32.17, 0.0017, 33.32, 0.0002,
- 34.42, 0.0018, 35.59, 0.0027, 36.74, 0.0055, 37.90, 0.0037, 39.06, 0.0064, 40.25, 0.0033, 41.47, 0.0014, 42.53, 0.0004,
- 43.89, 0.0010, 45.12, 0.0039, 46.33, 0.0039, 47.64, 0.0009, 48.88, 0.0016, 50.13, 0.0006, 51.37, 0.0010, 52.70, 0.0002,
- 54.00, 0.0004, 55.30, 0.0008, 56.60, 0.0025, 57.96, 0.0010, 59.30, 0.0012, 60.67, 0.0011, 61.99, 0.0003, 62.86, 0.0001,
- 64.36, 0.0005, 64.86, 0.0001, 66.26, 0.0004, 67.70, 0.0006, 68.94, 0.0002, 70.10, 0.0001, 70.58, 0.0002, 72.01, 0.0007,
- 73.53, 0.0006, 75.00, 0.0002, 77.03, 0.0005, 78.00, 0.0002, 79.57, 0.0006, 81.16, 0.0005, 82.70, 0.0005, 84.22, 0.0003,
- 85.41, 0.0002, 87.46, 0.0001, 90.30, 0.0001, 94.02, 0.0001, 95.26, 0.0002, 109.39, 0.0003],
-
- [1.98, 0.0194, 2.99, 0.0210, 3.97, 0.0276, 4.96, 0.0297, 5.96, 0.0158, 6.99, 0.0207, 8.01, 0.0009,
- 9.00, 0.0101, 10.00, 0.0297, 11.01, 0.0289, 12.02, 0.0211, 13.04, 0.0127, 14.07, 0.0061, 15.08, 0.0174, 16.13, 0.0009,
- 17.12, 0.0093, 18.16, 0.0117, 19.21, 0.0122, 20.29, 0.0108, 21.30, 0.0077, 22.38, 0.0132, 23.46, 0.0073, 24.14, 0.0002,
- 25.58, 0.0026, 26.69, 0.0035, 27.77, 0.0053, 28.88, 0.0024, 30.08, 0.0027, 31.13, 0.0075, 32.24, 0.0027, 33.36, 0.0004,
- 34.42, 0.0004, 35.64, 0.0019, 36.78, 0.0037, 38.10, 0.0009, 39.11, 0.0027, 40.32, 0.0010, 41.51, 0.0013, 42.66, 0.0019,
- 43.87, 0.0007, 45.13, 0.0017, 46.35, 0.0019, 47.65, 0.0021, 48.89, 0.0014, 50.18, 0.0023, 51.42, 0.0015, 52.73, 0.0002,
- 54.00, 0.0005, 55.34, 0.0006, 56.60, 0.0010, 57.96, 0.0016, 58.86, 0.0005, 59.30, 0.0004, 60.75, 0.0005, 62.22, 0.0003,
- 63.55, 0.0005, 64.82, 0.0003, 66.24, 0.0003, 67.63, 0.0011, 69.09, 0.0007, 70.52, 0.0004, 72.00, 0.0005, 73.50, 0.0008,
- 74.95, 0.0003, 77.13, 0.0013, 78.02, 0.0002, 79.48, 0.0004, 82.59, 0.0004, 84.10, 0.0003],
-
- [2.00, 0.0313, 2.99, 0.0109, 4.00, 0.0215, 5.00, 0.0242, 5.98, 0.0355, 7.01, 0.0132, 8.01, 0.0009,
- 9.01, 0.0071, 10.00, 0.0258, 11.03, 0.0221, 12.02, 0.0056, 13.06, 0.0196, 14.05, 0.0160, 15.11, 0.0107, 16.11, 0.0003,
- 17.14, 0.0111, 18.21, 0.0085, 19.23, 0.0010, 20.28, 0.0048, 21.31, 0.0128, 22.36, 0.0051, 23.41, 0.0041, 24.05, 0.0006,
- 25.54, 0.0019, 26.62, 0.0028, 27.72, 0.0034, 28.82, 0.0062, 29.89, 0.0039, 30.98, 0.0058, 32.08, 0.0011, 33.21, 0.0002,
- 34.37, 0.0008, 35.46, 0.0018, 36.62, 0.0036, 37.77, 0.0018, 38.92, 0.0042, 40.07, 0.0037, 41.23, 0.0011, 42.67, 0.0003,
- 43.65, 0.0018, 44.68, 0.0025, 45.99, 0.0044, 47.21, 0.0051, 48.40, 0.0044, 49.67, 0.0005, 50.88, 0.0019, 52.15, 0.0003,
- 53.42, 0.0008, 54.69, 0.0010, 55.98, 0.0005, 57.26, 0.0013, 58.53, 0.0027, 59.83, 0.0011, 61.21, 0.0027, 62.54, 0.0003,
- 63.78, 0.0003, 65.20, 0.0001, 66.60, 0.0006, 67.98, 0.0008, 69.37, 0.0019, 70.73, 0.0007, 72.14, 0.0004, 73.62, 0.0002,
- 74.40, 0.0003, 76.52, 0.0006, 77.97, 0.0002, 79.49, 0.0004, 80.77, 0.0003, 81.00, 0.0001, 82.47, 0.0005, 83.97, 0.0001,
- 87.27, 0.0002],
-
- [2.00, 0.0257, 2.99, 0.0142, 3.97, 0.0202, 4.95, 0.0148, 5.95, 0.0420, 6.95, 0.0037, 7.94, 0.0004,
- 8.94, 0.0172, 9.95, 0.0191, 10.96, 0.0115, 11.97, 0.0059, 12.98, 0.0140, 14.00, 0.0178, 15.03, 0.0121, 16.09, 0.0002,
- 17.07, 0.0066, 18.08, 0.0033, 19.15, 0.0022, 20.18, 0.0057, 21.22, 0.0077, 22.29, 0.0037, 23.33, 0.0066, 24.97, 0.0002,
- 25.49, 0.0019, 26.55, 0.0042, 27.61, 0.0043, 28.73, 0.0038, 29.81, 0.0084, 30.91, 0.0040, 32.03, 0.0025, 33.14, 0.0005,
- 34.26, 0.0003, 35.38, 0.0019, 36.56, 0.0037, 37.68, 0.0049, 38.86, 0.0036, 40.11, 0.0011, 41.28, 0.0008, 42.50, 0.0004,
- 43.60, 0.0002, 44.74, 0.0022, 45.99, 0.0050, 47.20, 0.0009, 48.40, 0.0036, 49.68, 0.0004, 50.92, 0.0009, 52.17, 0.0005,
- 53.46, 0.0007, 54.76, 0.0006, 56.06, 0.0005, 57.34, 0.0011, 58.67, 0.0005, 59.95, 0.0015, 61.37, 0.0008, 62.72, 0.0004,
- 65.42, 0.0009, 66.96, 0.0003, 68.18, 0.0003, 69.78, 0.0003, 71.21, 0.0004, 72.45, 0.0002, 74.22, 0.0003, 75.44, 0.0001,
- 76.53, 0.0003, 78.31, 0.0004, 79.83, 0.0003, 80.16, 0.0001, 81.33, 0.0003, 82.44, 0.0001, 83.17, 0.0002, 84.81, 0.0003,
- 85.97, 0.0003, 89.08, 0.0001, 90.70, 0.0002, 92.30, 0.0002, 95.59, 0.0002, 97.22, 0.0003, 98.86, 0.0001, 108.37, 0.0001,
- 125.54, 0.0001],
-
- [1.99, 0.0650, 3.03, 0.0040, 4.03, 0.0059, 5.02, 0.0090, 5.97, 0.0227, 6.98, 0.0050, 8.04, 0.0020,
- 9.00, 0.0082, 9.96, 0.0078, 11.01, 0.0056, 12.01, 0.0095, 13.02, 0.0050, 14.04, 0.0093, 15.08, 0.0064, 16.14, 0.0017,
- 17.06, 0.0020, 18.10, 0.0025, 19.14, 0.0023, 20.18, 0.0015, 21.24, 0.0032, 22.29, 0.0029, 23.32, 0.0014, 24.37, 0.0005,
- 25.43, 0.0030, 26.50, 0.0022, 27.60, 0.0027, 28.64, 0.0024, 29.76, 0.0035, 30.81, 0.0136, 31.96, 0.0025, 33.02, 0.0003,
- 34.13, 0.0005, 35.25, 0.0007, 36.40, 0.0014, 37.51, 0.0020, 38.64, 0.0012, 39.80, 0.0019, 40.97, 0.0004, 42.09, 0.0003,
- 43.24, 0.0003, 44.48, 0.0002, 45.65, 0.0024, 46.86, 0.0005, 48.07, 0.0013, 49.27, 0.0008, 50.49, 0.0006, 52.95, 0.0001,
- 54.23, 0.0005, 55.45, 0.0004, 56.73, 0.0001, 58.03, 0.0003, 59.29, 0.0002, 60.59, 0.0003, 62.04, 0.0002, 65.89, 0.0002,
- 67.23, 0.0002, 68.61, 0.0002, 69.97, 0.0004, 71.36, 0.0005, 85.42, 0.0001],
-
- [1.98, 0.0256, 2.96, 0.0158, 3.95, 0.0310, 4.94, 0.0411, 5.95, 0.0238, 6.94, 0.0152, 7.93, 0.0011,
- 8.95, 0.0185, 9.92, 0.0166, 10.93, 0.0306, 11.94, 0.0258, 12.96, 0.0202, 13.97, 0.0403, 14.95, 0.0228, 15.93, 0.0005,
- 17.01, 0.0072, 18.02, 0.0034, 19.06, 0.0028, 20.08, 0.0124, 21.13, 0.0137, 22.16, 0.0102, 23.19, 0.0058, 23.90, 0.0013,
- 25.30, 0.0039, 26.36, 0.0039, 27.41, 0.0025, 28.47, 0.0071, 29.64, 0.0031, 30.60, 0.0027, 31.71, 0.0021, 32.84, 0.0003,
- 33.82, 0.0002, 35.07, 0.0019, 36.09, 0.0054, 37.20, 0.0038, 38.33, 0.0024, 39.47, 0.0055, 40.55, 0.0016, 41.77, 0.0006,
- 42.95, 0.0002, 43.27, 0.0018, 44.03, 0.0006, 45.25, 0.0019, 46.36, 0.0033, 47.50, 0.0024, 48.87, 0.0012, 50.03, 0.0016,
- 51.09, 0.0004, 53.52, 0.0017, 54.74, 0.0012, 56.17, 0.0003, 57.40, 0.0011, 58.42, 0.0020, 59.70, 0.0007, 61.29, 0.0008,
- 62.56, 0.0003, 63.48, 0.0002, 64.83, 0.0002, 66.12, 0.0012, 67.46, 0.0017, 68.81, 0.0003, 69.13, 0.0003, 70.53, 0.0002,
- 71.84, 0.0001, 73.28, 0.0002, 75.52, 0.0010, 76.96, 0.0005, 77.93, 0.0003, 78.32, 0.0003, 79.73, 0.0003, 81.69, 0.0002,
- 82.52, 0.0001, 84.01, 0.0001, 84.61, 0.0002, 86.88, 0.0001, 88.36, 0.0002, 89.85, 0.0002, 91.35, 0.0003, 92.86, 0.0002,
- 93.40, 0.0001, 105.28, 0.0002, 106.22, 0.0002, 107.45, 0.0001, 108.70, 0.0003, 122.08, 0.0002],
-
- [1.97, 0.0264, 2.97, 0.0211, 3.98, 0.0234, 4.98, 0.0307, 5.96, 0.0085, 6.94, 0.0140, 7.93, 0.0005,
- 8.96, 0.0112, 9.96, 0.0209, 10.98, 0.0194, 11.98, 0.0154, 12.99, 0.0274, 13.99, 0.0127, 15.01, 0.0101, 15.99, 0.0002,
- 17.04, 0.0011, 18.08, 0.0032, 19.14, 0.0028, 20.12, 0.0054, 21.20, 0.0053, 22.13, 0.0028, 23.22, 0.0030, 24.32, 0.0006,
- 25.24, 0.0004, 26.43, 0.0028, 27.53, 0.0048, 28.52, 0.0039, 29.54, 0.0047, 30.73, 0.0044, 31.82, 0.0007, 32.94, 0.0008,
- 34.04, 0.0012, 35.13, 0.0018, 36.29, 0.0007, 37.35, 0.0075, 38.51, 0.0045, 39.66, 0.0014, 40.90, 0.0004, 41.90, 0.0002,
- 43.08, 0.0002, 44.24, 0.0017, 45.36, 0.0013, 46.68, 0.0020, 47.79, 0.0015, 48.98, 0.0010, 50.21, 0.0012, 51.34, 0.0001,
- 53.82, 0.0003, 55.09, 0.0004, 56.23, 0.0005, 57.53, 0.0004, 58.79, 0.0005, 59.30, 0.0002, 60.03, 0.0002, 61.40, 0.0003,
- 62.84, 0.0001, 66.64, 0.0001, 67.97, 0.0001, 69.33, 0.0001, 70.68, 0.0001, 73.57, 0.0002, 75.76, 0.0002, 76.45, 0.0001,
- 79.27, 0.0001, 80.44, 0.0002, 81.87, 0.0002],
-
- [2.00, 0.0311, 2.99, 0.0086, 3.99, 0.0266, 4.97, 0.0123, 5.98, 0.0235, 6.97, 0.0161, 7.97, 0.0008,
- 8.96, 0.0088, 9.96, 0.0621, 10.99, 0.0080, 11.99, 0.0034, 12.99, 0.0300, 14.03, 0.0228, 15.04, 0.0105, 16.03, 0.0004,
- 17.06, 0.0036, 18.09, 0.0094, 18.95, 0.0009, 20.17, 0.0071, 21.21, 0.0161, 22.25, 0.0106, 23.28, 0.0104, 24.33, 0.0008,
- 25.38, 0.0030, 26.46, 0.0035, 27.50, 0.0026, 28.59, 0.0028, 29.66, 0.0128, 30.75, 0.0139, 31.81, 0.0038, 32.93, 0.0006,
- 34.04, 0.0004, 35.16, 0.0005, 36.25, 0.0023, 37.35, 0.0012, 38.46, 0.0021, 39.59, 0.0035, 40.71, 0.0006, 41.86, 0.0007,
- 42.42, 0.0001, 43.46, 0.0003, 44.17, 0.0032, 45.29, 0.0013, 46.57, 0.0004, 47.72, 0.0011, 48.79, 0.0005, 50.11, 0.0005,
- 51.29, 0.0003, 52.47, 0.0002, 53.68, 0.0004, 55.02, 0.0005, 56.18, 0.0003, 57.41, 0.0003, 58.75, 0.0007, 59.33, 0.0009,
- 60.00, 0.0004, 61.34, 0.0001, 64.97, 0.0003, 65.20, 0.0002, 66.48, 0.0002, 67.83, 0.0002, 68.90, 0.0003, 70.25, 0.0003,
- 71.59, 0.0002, 73.68, 0.0001, 75.92, 0.0001, 77.08, 0.0002, 78.45, 0.0002, 81.56, 0.0002, 82.99, 0.0001, 88.39, 0.0001],
-
- [0.97, 0.0059, 1.98, 0.0212, 2.99, 0.0153, 3.99, 0.0227, 4.96, 0.0215, 5.97, 0.0153, 6.98, 0.0085,
- 7.98, 0.0007, 8.97, 0.0179, 9.98, 0.0512, 10.98, 0.0322, 12.00, 0.0098, 13.02, 0.0186, 14.00, 0.0099, 15.05, 0.0109,
- 15.88, 0.0011, 17.07, 0.0076, 18.11, 0.0071, 19.12, 0.0045, 20.16, 0.0038, 21.23, 0.0213, 22.27, 0.0332, 23.34, 0.0082,
- 24.34, 0.0014, 25.42, 0.0024, 26.47, 0.0012, 27.54, 0.0014, 28.60, 0.0024, 29.72, 0.0026, 30.10, 0.0008, 31.91, 0.0021,
- 32.13, 0.0011, 33.02, 0.0007, 34.09, 0.0014, 35.17, 0.0007, 36.27, 0.0024, 37.39, 0.0029, 38.58, 0.0014, 39.65, 0.0017,
- 40.95, 0.0012, 41.97, 0.0004, 42.43, 0.0002, 43.49, 0.0001, 44.31, 0.0012, 45.42, 0.0031, 46.62, 0.0017, 47.82, 0.0013,
- 49.14, 0.0013, 50.18, 0.0010, 51.54, 0.0003, 53.90, 0.0006, 55.06, 0.0010, 56.31, 0.0003, 57.63, 0.0001, 59.02, 0.0003,
- 60.09, 0.0004, 60.35, 0.0004, 61.62, 0.0009, 63.97, 0.0001, 65.19, 0.0001, 65.54, 0.0002, 66.92, 0.0002, 67.94, 0.0002,
- 69.17, 0.0003, 69.60, 0.0004, 70.88, 0.0002, 72.24, 0.0002, 76.12, 0.0001, 78.94, 0.0001, 81.75, 0.0001, 82.06, 0.0001,
- 83.53, 0.0001, 90.29, 0.0002, 91.75, 0.0001, 92.09, 0.0002, 93.28, 0.0001, 97.07, 0.0001],
-
- [1.98, 0.0159, 2.98, 0.1008, 3.98, 0.0365, 4.98, 0.0133, 5.97, 0.0101, 6.97, 0.0115, 7.97, 0.0007,
- 8.99, 0.0349, 10.01, 0.0342, 11.01, 0.0236, 12.00, 0.0041, 13.02, 0.0114, 14.05, 0.0137, 15.06, 0.0100, 16.05, 0.0007,
- 17.04, 0.0009, 18.12, 0.0077, 19.15, 0.0023, 20.12, 0.0017, 21.24, 0.0113, 22.26, 0.0126, 23.30, 0.0093, 24.36, 0.0007,
- 25.43, 0.0007, 26.47, 0.0009, 27.55, 0.0013, 28.59, 0.0025, 29.61, 0.0010, 30.77, 0.0021, 31.86, 0.0023, 32.96, 0.0003,
- 34.03, 0.0007, 35.06, 0.0005, 36.20, 0.0006, 37.34, 0.0006, 38.36, 0.0009, 39.60, 0.0016, 40.69, 0.0005, 41.77, 0.0002,
- 42.92, 0.0002, 44.02, 0.0003, 45.24, 0.0006, 46.33, 0.0004, 47.50, 0.0007, 48.71, 0.0007, 49.87, 0.0002, 51.27, 0.0002,
- 53.42, 0.0003, 55.88, 0.0003, 57.10, 0.0004, 58.34, 0.0002, 59.86, 0.0003, 61.13, 0.0003, 67.18, 0.0001, 68.50, 0.0001,
- 71.17, 0.0001, 83.91, 0.0001, 90.55, 0.0001],
-
- [0.98, 0.0099, 2.00, 0.0181, 2.99, 0.0353, 3.98, 0.0285, 4.97, 0.0514, 5.96, 0.0402, 6.96, 0.0015,
- 7.98, 0.0012, 8.98, 0.0175, 9.98, 0.0264, 10.98, 0.0392, 11.98, 0.0236, 13.00, 0.0153, 14.04, 0.0049, 15.00, 0.0089,
- 16.01, 0.0001, 17.03, 0.0106, 18.03, 0.0028, 19.05, 0.0024, 20.08, 0.0040, 21.11, 0.0103, 22.12, 0.0104, 23.20, 0.0017,
- 24.19, 0.0008, 25.20, 0.0007, 26.24, 0.0011, 27.36, 0.0009, 27.97, 0.0030, 29.40, 0.0044, 30.37, 0.0019, 31.59, 0.0017,
- 32.65, 0.0008, 33.59, 0.0005, 34.79, 0.0009, 35.75, 0.0027, 36.88, 0.0035, 37.93, 0.0039, 39.00, 0.0031, 40.08, 0.0025,
- 41.16, 0.0010, 43.25, 0.0004, 44.52, 0.0012, 45.62, 0.0023, 45.85, 0.0012, 47.00, 0.0006, 47.87, 0.0008, 48.99, 0.0003,
- 50.48, 0.0003, 51.62, 0.0001, 52.43, 0.0001, 53.56, 0.0002, 54.76, 0.0002, 56.04, 0.0002, 56.68, 0.0006, 57.10, 0.0003,
- 58.28, 0.0005, 59.47, 0.0003, 59.96, 0.0002, 60.67, 0.0001, 63.08, 0.0002, 64.29, 0.0002, 66.72, 0.0001, 67.97, 0.0001,
- 68.65, 0.0001, 70.43, 0.0001, 79.38, 0.0001, 80.39, 0.0001, 82.39, 0.0001],
-
- [1.00, 0.0765, 1.99, 0.0151, 2.99, 0.0500, 3.99, 0.0197, 5.00, 0.0260, 6.00, 0.0145, 6.98, 0.0128,
- 7.97, 0.0004, 8.98, 0.0158, 9.99, 0.0265, 11.02, 0.0290, 12.02, 0.0053, 13.03, 0.0242, 14.03, 0.0103, 15.06, 0.0054,
- 16.04, 0.0006, 17.08, 0.0008, 18.10, 0.0058, 19.16, 0.0011, 20.16, 0.0055, 21.18, 0.0040, 22.20, 0.0019, 23.22, 0.0014,
- 24.05, 0.0005, 25.31, 0.0019, 26.38, 0.0018, 27.44, 0.0022, 28.45, 0.0024, 29.57, 0.0073, 30.58, 0.0032, 31.66, 0.0071,
- 32.73, 0.0015, 33.85, 0.0005, 34.96, 0.0003, 36.00, 0.0020, 37.11, 0.0018, 38.18, 0.0055, 39.23, 0.0006, 40.33, 0.0004,
- 41.52, 0.0003, 43.41, 0.0028, 45.05, 0.0003, 45.99, 0.0002, 47.07, 0.0003, 48.52, 0.0002, 49.48, 0.0003, 50.63, 0.0003,
- 51.81, 0.0002, 54.05, 0.0002, 55.24, 0.0001, 56.62, 0.0001, 57.81, 0.0004, 59.16, 0.0013, 60.23, 0.0003, 66.44, 0.0001,
- 68.99, 0.0004, 75.49, 0.0001, 87.56, 0.0004],
-
- [0.98, 0.0629, 1.99, 0.0232, 2.98, 0.0217, 4.00, 0.0396, 4.98, 0.0171, 5.97, 0.0098, 6.99, 0.0167,
- 7.99, 0.0003, 8.98, 0.0192, 9.98, 0.0266, 10.99, 0.0256, 12.01, 0.0061, 13.02, 0.0135, 14.02, 0.0062, 15.05, 0.0158,
- 16.06, 0.0018, 17.08, 0.0101, 18.09, 0.0053, 19.11, 0.0074, 20.13, 0.0020, 21.17, 0.0052, 22.22, 0.0077, 23.24, 0.0035,
- 24.00, 0.0009, 25.32, 0.0016, 26.40, 0.0022, 27.43, 0.0005, 28.55, 0.0026, 29.60, 0.0026, 30.65, 0.0010, 31.67, 0.0019,
- 32.77, 0.0008, 33.81, 0.0003, 34.91, 0.0003, 36.01, 0.0005, 37.11, 0.0010, 38.20, 0.0014, 39.29, 0.0039, 40.43, 0.0012,
- 41.50, 0.0006, 43.38, 0.0017, 43.75, 0.0002, 44.94, 0.0005, 46.13, 0.0002, 47.11, 0.0003, 48.28, 0.0005, 48.42, 0.0005,
- 49.44, 0.0003, 50.76, 0.0004, 51.93, 0.0002, 54.15, 0.0003, 55.31, 0.0005, 55.50, 0.0003, 56.98, 0.0003, 57.90, 0.0004,
- 60.33, 0.0002, 61.39, 0.0001, 61.59, 0.0001, 65.09, 0.0002, 66.34, 0.0001, 68.85, 0.0001, 70.42, 0.0002, 71.72, 0.0001,
- 73.05, 0.0003, 79.65, 0.0001, 85.28, 0.0002, 93.52, 0.0001],
-
- [1.02, 0.0185, 1.99, 0.0525, 2.98, 0.0613, 3.99, 0.0415, 4.98, 0.0109, 5.97, 0.0248, 6.99, 0.0102,
- 7.98, 0.0005, 8.98, 0.0124, 9.99, 0.0103, 10.99, 0.0124, 12.00, 0.0016, 13.01, 0.0029, 14.03, 0.0211, 15.04, 0.0128,
- 16.07, 0.0021, 17.09, 0.0009, 18.09, 0.0043, 19.14, 0.0022, 20.13, 0.0016, 21.20, 0.0045, 22.21, 0.0088, 23.26, 0.0046,
- 24.29, 0.0013, 25.35, 0.0009, 26.39, 0.0028, 27.49, 0.0009, 28.51, 0.0006, 29.58, 0.0012, 30.70, 0.0010, 31.74, 0.0019,
- 32.75, 0.0002, 33.85, 0.0001, 34.95, 0.0005, 36.02, 0.0003, 37.16, 0.0009, 38.25, 0.0018, 39.35, 0.0008, 40.54, 0.0004,
- 41.61, 0.0002, 43.40, 0.0004, 43.74, 0.0003, 45.05, 0.0001, 46.11, 0.0003, 47.40, 0.0002, 48.36, 0.0004, 49.55, 0.0004,
- 50.72, 0.0002, 52.00, 0.0001, 55.58, 0.0002, 57.02, 0.0001, 57.98, 0.0002, 59.13, 0.0003, 61.56, 0.0001, 66.56, 0.0001,
- 87.65, 0.0002],
-
- [1.00, 0.0473, 1.99, 0.0506, 2.99, 0.0982, 3.99, 0.0654, 5.00, 0.0196, 5.99, 0.0094, 6.99, 0.0118,
- 7.93, 0.0001, 8.99, 0.0057, 10.01, 0.0285, 11.01, 0.0142, 12.03, 0.0032, 13.03, 0.0056, 14.06, 0.0064, 15.06, 0.0059,
- 16.11, 0.0005, 17.09, 0.0033, 18.14, 0.0027, 19.15, 0.0014, 20.17, 0.0010, 21.21, 0.0059, 22.26, 0.0043, 23.31, 0.0031,
- 24.31, 0.0018, 25.33, 0.0009, 26.41, 0.0005, 27.47, 0.0015, 28.53, 0.0015, 29.58, 0.0041, 30.65, 0.0025, 31.73, 0.0011,
- 32.83, 0.0010, 34.98, 0.0003, 36.07, 0.0009, 37.23, 0.0001, 38.26, 0.0020, 39.41, 0.0014, 40.53, 0.0005, 41.40, 0.0003,
- 42.80, 0.0002, 43.48, 0.0028, 43.93, 0.0001, 45.03, 0.0003, 46.18, 0.0007, 47.41, 0.0001, 48.57, 0.0002, 49.67, 0.0001,
- 50.83, 0.0002, 54.39, 0.0001, 55.58, 0.0002, 57.97, 0.0005, 58.11, 0.0002, 59.21, 0.0001, 60.42, 0.0002, 61.66, 0.0001],
-
- [1.00, 0.0503, 2.00, 0.0963, 2.99, 0.1304, 3.99, 0.0218, 4.98, 0.0041, 5.98, 0.0292, 6.98, 0.0482,
- 7.99, 0.0005, 8.99, 0.0280, 10.00, 0.0237, 11.00, 0.0152, 12.02, 0.0036, 12.95, 0.0022, 14.06, 0.0111, 15.07, 0.0196,
- 16.08, 0.0016, 17.11, 0.0044, 18.13, 0.0073, 19.17, 0.0055, 20.19, 0.0028, 21.20, 0.0012, 22.27, 0.0068, 23.30, 0.0036,
- 24.35, 0.0012, 25.35, 0.0002, 26.46, 0.0005, 27.47, 0.0005, 28.59, 0.0009, 29.65, 0.0021, 30.70, 0.0020, 31.78, 0.0012,
- 32.89, 0.0010, 35.06, 0.0005, 36.16, 0.0008, 37.27, 0.0010, 38.36, 0.0010, 39.47, 0.0014, 40.58, 0.0004, 41.43, 0.0007,
- 41.82, 0.0003, 43.48, 0.0008, 44.53, 0.0001, 45.25, 0.0003, 46.43, 0.0002, 47.46, 0.0002, 48.76, 0.0005, 49.95, 0.0004,
- 50.96, 0.0002, 51.12, 0.0002, 52.33, 0.0001, 54.75, 0.0001, 55.75, 0.0002, 56.90, 0.0002, 58.17, 0.0002, 59.40, 0.0004,
- 60.62, 0.0002, 65.65, 0.0001, 66.91, 0.0002, 69.91, 0.0001, 71.25, 0.0002],
-
- [1.00, 0.1243, 1.98, 0.1611, 3.00, 0.0698, 3.98, 0.0390, 5.00, 0.0138, 5.99, 0.0154, 7.01, 0.0287,
- 8.01, 0.0014, 9.01, 0.0049, 10.00, 0.0144, 11.01, 0.0055, 12.05, 0.0052, 13.01, 0.0011, 14.05, 0.0118, 15.07, 0.0154,
- 16.12, 0.0028, 17.14, 0.0061, 18.25, 0.0007, 19.22, 0.0020, 20.24, 0.0011, 21.27, 0.0029, 22.30, 0.0046, 23.34, 0.0049,
- 24.35, 0.0004, 25.45, 0.0003, 26.47, 0.0007, 27.59, 0.0008, 28.16, 0.0009, 29.12, 0.0002, 29.81, 0.0006, 30.81, 0.0009,
- 31.95, 0.0004, 33.00, 0.0011, 34.12, 0.0005, 35.18, 0.0003, 36.30, 0.0008, 37.38, 0.0003, 38.55, 0.0003, 39.64, 0.0006,
- 40.77, 0.0007, 41.52, 0.0006, 41.89, 0.0006, 43.04, 0.0011, 43.60, 0.0009, 44.31, 0.0002, 45.68, 0.0002, 46.56, 0.0003,
- 47.60, 0.0001, 48.83, 0.0006, 50.01, 0.0003, 51.27, 0.0003, 56.04, 0.0005, 57.21, 0.0003, 58.56, 0.0004, 59.83, 0.0003,
- 61.05, 0.0001, 62.20, 0.0001, 67.37, 0.0002, 76.53, 0.0001],
-
- [0.99, 0.0222, 1.99, 0.0678, 2.99, 0.0683, 4.00, 0.0191, 5.00, 0.0119, 6.01, 0.0232, 6.98, 0.0336,
- 7.99, 0.0082, 9.01, 0.0201, 10.01, 0.0189, 11.01, 0.0041, 12.01, 0.0053, 13.05, 0.0154, 14.04, 0.0159, 15.06, 0.0092,
- 16.11, 0.0038, 17.12, 0.0014, 18.15, 0.0091, 19.16, 0.0006, 20.30, 0.0012, 21.25, 0.0061, 22.28, 0.0099, 23.34, 0.0028,
- 24.38, 0.0012, 25.43, 0.0016, 26.49, 0.0048, 27.55, 0.0025, 28.62, 0.0015, 29.71, 0.0032, 30.78, 0.0077, 31.88, 0.0011,
- 32.97, 0.0007, 34.08, 0.0006, 35.16, 0.0008, 36.28, 0.0004, 37.41, 0.0006, 38.54, 0.0005, 39.62, 0.0002, 40.80, 0.0003,
- 41.93, 0.0001, 43.06, 0.0002, 44.21, 0.0003, 45.38, 0.0002, 46.54, 0.0007, 47.78, 0.0003, 48.95, 0.0004, 50.10, 0.0003,
- 51.37, 0.0002, 53.79, 0.0003, 56.20, 0.0001, 58.71, 0.0002, 66.47, 0.0003],
-
- [1.01, 0.0241, 1.99, 0.1011, 2.98, 0.0938, 3.98, 0.0081, 4.99, 0.0062, 5.99, 0.0291, 6.99, 0.0676,
- 7.59, 0.0004, 8.98, 0.0127, 9.99, 0.0112, 10.99, 0.0142, 12.00, 0.0029, 13.02, 0.0071, 14.02, 0.0184, 15.03, 0.0064,
- 16.07, 0.0010, 17.09, 0.0011, 18.11, 0.0010, 19.15, 0.0060, 20.19, 0.0019, 21.24, 0.0025, 22.29, 0.0013, 23.31, 0.0050,
- 25.41, 0.0030, 26.50, 0.0018, 27.53, 0.0006, 28.63, 0.0012, 29.66, 0.0013, 30.77, 0.0020, 31.84, 0.0006, 34.04, 0.0001,
- 35.14, 0.0001, 36.32, 0.0004, 37.41, 0.0007, 38.53, 0.0007, 39.67, 0.0009, 40.85, 0.0003, 45.49, 0.0002, 46.65, 0.0001,
- 47.81, 0.0004, 49.01, 0.0002, 53.91, 0.0002, 55.14, 0.0002, 57.69, 0.0002],
-
- [1.00, 0.0326, 2.00, 0.1066, 2.99, 0.1015, 4.00, 0.0210, 4.97, 0.0170, 5.99, 0.0813, 6.98, 0.0820,
- 7.96, 0.0011, 8.99, 0.0248, 10.03, 0.0107, 11.01, 0.0126, 12.01, 0.0027, 13.01, 0.0233, 14.04, 0.0151, 15.05, 0.0071,
- 16.04, 0.0002, 17.10, 0.0061, 18.12, 0.0059, 19.15, 0.0087, 20.23, 0.0005, 21.25, 0.0040, 22.30, 0.0032, 23.35, 0.0004,
- 24.40, 0.0001, 25.45, 0.0030, 26.54, 0.0022, 27.60, 0.0003, 28.70, 0.0009, 29.80, 0.0029, 30.85, 0.0006, 31.97, 0.0006,
- 34.19, 0.0004, 35.30, 0.0003, 36.43, 0.0007, 37.56, 0.0005, 38.68, 0.0019, 39.88, 0.0013, 41.00, 0.0003, 43.35, 0.0003,
- 44.51, 0.0002, 45.68, 0.0006, 46.93, 0.0010, 48.11, 0.0006, 49.29, 0.0003, 55.58, 0.0002],
-
- [0.98, 0.0113, 1.99, 0.0967, 3.00, 0.0719, 3.98, 0.0345, 4.98, 0.0121, 6.00, 0.0621, 7.00, 0.0137,
- 7.98, 0.0006, 9.01, 0.0314, 10.01, 0.0171, 11.02, 0.0060, 12.03, 0.0024, 13.05, 0.0077, 14.07, 0.0040, 15.12, 0.0032,
- 16.13, 0.0004, 17.15, 0.0011, 18.20, 0.0028, 19.18, 0.0003, 20.26, 0.0003, 21.31, 0.0025, 22.35, 0.0021, 23.39, 0.0005,
- 25.55, 0.0002, 26.62, 0.0014, 27.70, 0.0003, 28.78, 0.0005, 29.90, 0.0030, 31.01, 0.0011, 32.12, 0.0005, 34.31, 0.0001,
- 35.50, 0.0002, 36.62, 0.0002, 37.76, 0.0005, 38.85, 0.0002, 40.09, 0.0004, 43.60, 0.0001, 44.73, 0.0002, 46.02, 0.0002,
- 47.25, 0.0004, 48.44, 0.0004],
-
- [0.99, 0.0156, 1.98, 0.0846, 2.98, 0.0178, 3.98, 0.0367, 4.98, 0.0448, 5.98, 0.0113, 6.99, 0.0189,
- 8.00, 0.0011, 9.01, 0.0247, 10.02, 0.0089, 11.01, 0.0184, 12.03, 0.0105, 13.00, 0.0039, 14.07, 0.0116, 15.09, 0.0078,
- 16.13, 0.0008, 17.14, 0.0064, 18.19, 0.0029, 19.22, 0.0028, 20.25, 0.0017, 21.32, 0.0043, 22.37, 0.0055, 23.42, 0.0034,
- 24.48, 0.0004, 25.54, 0.0002, 26.61, 0.0017, 27.70, 0.0011, 28.80, 0.0002, 29.89, 0.0019, 30.97, 0.0028, 32.09, 0.0007,
- 34.30, 0.0002, 35.44, 0.0003, 36.55, 0.0001, 37.69, 0.0004, 38.93, 0.0002, 40.05, 0.0005, 41.20, 0.0005, 42.37, 0.0002,
- 43.54, 0.0003, 44.73, 0.0001, 45.95, 0.0002, 47.16, 0.0001, 48.43, 0.0005, 49.65, 0.0004, 55.90, 0.0002, 59.81, 0.0004],
-
- [1.01, 0.0280, 2.00, 0.0708, 2.99, 0.0182, 3.99, 0.0248, 4.98, 0.0245, 5.98, 0.0279, 6.98, 0.0437,
- 7.99, 0.0065, 8.99, 0.0299, 10.00, 0.0073, 10.99, 0.0011, 12.03, 0.0122, 13.03, 0.0028, 14.08, 0.0044, 15.11, 0.0097,
- 16.15, 0.0010, 17.17, 0.0025, 18.19, 0.0017, 19.24, 0.0008, 20.28, 0.0040, 21.32, 0.0024, 22.38, 0.0008, 23.46, 0.0032,
- 24.52, 0.0010, 25.59, 0.0008, 26.68, 0.0009, 27.76, 0.0012, 28.88, 0.0003, 29.95, 0.0005, 31.05, 0.0017, 32.14, 0.0002,
- 33.29, 0.0003, 37.88, 0.0002, 39.03, 0.0002, 40.19, 0.0004, 41.37, 0.0003, 43.74, 0.0002, 46.20, 0.0001, 48.68, 0.0001,
- 49.93, 0.0001, 51.19, 0.0002],
-
- [1.00, 0.0225, 1.99, 0.0921, 2.98, 0.0933, 3.99, 0.0365, 4.99, 0.0100, 5.98, 0.0213, 6.98, 0.0049,
- 7.98, 0.0041, 8.98, 0.0090, 9.99, 0.0068, 11.01, 0.0040, 12.03, 0.0086, 13.02, 0.0015, 14.04, 0.0071, 15.09, 0.0082,
- 16.14, 0.0011, 17.15, 0.0014, 18.18, 0.0010, 19.26, 0.0013, 20.26, 0.0005, 21.33, 0.0006, 22.36, 0.0011, 23.46, 0.0016,
- 24.52, 0.0004, 25.59, 0.0002, 26.70, 0.0006, 27.78, 0.0007, 28.87, 0.0002, 30.03, 0.0008, 31.14, 0.0010, 32.24, 0.0006,
- 33.37, 0.0002, 35.67, 0.0003, 37.99, 0.0004, 39.17, 0.0004, 40.35, 0.0005, 41.53, 0.0001, 46.42, 0.0001],
-
- [1.00, 0.0465, 1.99, 0.0976, 2.98, 0.0678, 4.00, 0.0727, 4.99, 0.0305, 5.98, 0.0210, 6.98, 0.0227,
- 8.00, 0.0085, 9.01, 0.0183, 10.02, 0.0258, 11.05, 0.0003, 12.06, 0.0061, 13.05, 0.0021, 14.10, 0.0089, 15.12, 0.0077,
- 16.16, 0.0016, 17.21, 0.0061, 18.23, 0.0011, 19.29, 0.0031, 20.36, 0.0031, 21.41, 0.0007, 22.48, 0.0013, 23.55, 0.0020,
- 24.64, 0.0004, 25.74, 0.0005, 26.81, 0.0006, 27.95, 0.0006, 29.03, 0.0001, 30.22, 0.0010, 31.30, 0.0004, 32.48, 0.0001,
- 33.60, 0.0002, 38.30, 0.0003],
-
- [1.00, 0.0674, 1.99, 0.0841, 2.98, 0.0920, 3.99, 0.0328, 4.99, 0.0368, 5.98, 0.0206, 6.99, 0.0246,
- 8.01, 0.0048, 9.01, 0.0218, 10.03, 0.0155, 11.05, 0.0048, 12.06, 0.0077, 13.00, 0.0020, 14.10, 0.0083, 15.15, 0.0084,
- 16.18, 0.0015, 17.22, 0.0039, 18.27, 0.0032, 19.34, 0.0026, 20.40, 0.0012, 21.47, 0.0009, 22.54, 0.0008, 23.62, 0.0016,
- 24.71, 0.0005, 25.82, 0.0004, 26.91, 0.0002, 28.03, 0.0008, 29.17, 0.0002, 30.32, 0.0028, 31.45, 0.0004, 32.61, 0.0005,
- 33.77, 0.0001, 36.14, 0.0003, 37.32, 0.0002, 38.54, 0.0005, 39.75, 0.0002, 42.23, 0.0002, 48.65, 0.0001],
-
- [1.01, 0.0423, 1.99, 0.0240, 2.98, 0.0517, 4.00, 0.0493, 5.00, 0.0324, 6.00, 0.0094, 6.99, 0.0449,
- 7.99, 0.0050, 9.00, 0.0197, 10.03, 0.0132, 11.03, 0.0009, 12.07, 0.0017, 13.08, 0.0023, 14.12, 0.0094, 15.16, 0.0071,
- 16.21, 0.0020, 17.25, 0.0005, 18.30, 0.0027, 19.04, 0.0004, 20.43, 0.0022, 21.51, 0.0002, 22.59, 0.0006, 23.72, 0.0018,
- 24.80, 0.0002, 25.88, 0.0002, 27.03, 0.0002, 28.09, 0.0006, 29.31, 0.0002, 30.46, 0.0004, 31.61, 0.0007, 32.78, 0.0005,
- 33.95, 0.0001, 36.34, 0.0002, 37.56, 0.0001, 38.80, 0.0001, 40.02, 0.0001, 44.14, 0.0001],
-
- [1.00, 0.0669, 1.99, 0.0909, 2.99, 0.0410, 3.98, 0.0292, 4.98, 0.0259, 5.98, 0.0148, 6.98, 0.0319,
- 7.99, 0.0076, 9.01, 0.0056, 10.02, 0.0206, 11.04, 0.0032, 12.05, 0.0085, 13.08, 0.0040, 14.12, 0.0037, 15.16, 0.0030,
- 16.20, 0.0013, 17.24, 0.0021, 18.30, 0.0010, 19.36, 0.0015, 20.44, 0.0013, 21.50, 0.0009, 22.60, 0.0015, 23.69, 0.0014,
- 24.80, 0.0006, 25.87, 0.0002, 27.02, 0.0006, 28.12, 0.0002, 29.28, 0.0003, 30.43, 0.0002, 31.59, 0.0007, 32.79, 0.0001,
- 35.14, 0.0001, 37.57, 0.0001, 40.03, 0.0002, 41.28, 0.0004, 44.10, 0.0001],
-
- [0.99, 0.0421, 1.99, 0.1541, 2.98, 0.0596, 3.98, 0.0309, 4.98, 0.0301, 5.99, 0.0103, 7.00, 0.0240,
- 8.01, 0.0073, 9.01, 0.0222, 10.04, 0.0140, 11.05, 0.0033, 12.08, 0.0045, 13.13, 0.0009, 14.13, 0.0015, 15.21, 0.0026,
- 16.24, 0.0003, 17.30, 0.0004, 18.35, 0.0010, 19.39, 0.0003, 20.50, 0.0015, 21.57, 0.0003, 22.68, 0.0011, 23.80, 0.0005,
- 24.90, 0.0008, 26.02, 0.0002, 27.16, 0.0001, 28.30, 0.0006, 29.48, 0.0002, 31.81, 0.0005, 33.00, 0.0003, 34.21, 0.0001,
- 37.89, 0.0001],
-
- [0.99, 0.0389, 2.00, 0.2095, 3.00, 0.0835, 3.99, 0.0289, 5.00, 0.0578, 5.99, 0.0363, 7.01, 0.0387,
- 8.01, 0.0056, 9.04, 0.0173, 10.05, 0.0175, 11.08, 0.0053, 12.10, 0.0056, 13.15, 0.0064, 14.19, 0.0036, 15.22, 0.0019,
- 16.29, 0.0010, 17.36, 0.0017, 18.43, 0.0018, 19.51, 0.0004, 20.60, 0.0011, 21.70, 0.0003, 22.82, 0.0003, 23.95, 0.0001,
- 25.05, 0.0004, 26.17, 0.0001, 28.50, 0.0003, 29.68, 0.0001, 32.07, 0.0003, 33.28, 0.0004, 34.52, 0.0001],
-
- [1.00, 0.1238, 1.99, 0.2270, 3.00, 0.0102, 3.99, 0.0181, 4.98, 0.0415, 6.00, 0.0165, 7.01, 0.0314,
- 8.02, 0.0148, 9.04, 0.0203, 10.05, 0.0088, 11.07, 0.0062, 12.11, 0.0070, 13.14, 0.0054, 14.19, 0.0028, 15.24, 0.0044,
- 16.30, 0.0029, 17.38, 0.0009, 18.45, 0.0026, 19.56, 0.0003, 20.65, 0.0025, 21.74, 0.0014, 22.87, 0.0013, 23.99, 0.0007,
- 25.15, 0.0002, 27.46, 0.0004, 28.39, 0.0006, 28.65, 0.0004, 29.85, 0.0001, 31.05, 0.0002, 32.27, 0.0003, 33.52, 0.0002,
- 34.76, 0.0003],
-
- [1.00, 0.1054, 2.00, 0.2598, 2.99, 0.0369, 3.98, 0.0523, 4.99, 0.0020, 5.99, 0.0051, 7.00, 0.0268,
- 8.01, 0.0027, 9.04, 0.0029, 10.05, 0.0081, 11.08, 0.0047, 12.12, 0.0051, 13.16, 0.0091, 14.19, 0.0015, 15.27, 0.0030,
- 16.34, 0.0017, 17.42, 0.0006, 18.51, 0.0003, 19.61, 0.0007, 20.72, 0.0003, 21.84, 0.0001, 22.99, 0.0010, 24.13, 0.0001,
- 28.44, 0.0001, 30.09, 0.0001],
-
- [0.99, 0.0919, 2.00, 0.0418, 2.99, 0.0498, 3.99, 0.0135, 4.99, 0.0026, 6.00, 0.0155, 7.01, 0.0340,
- 8.02, 0.0033, 9.04, 0.0218, 10.08, 0.0084, 11.11, 0.0057, 12.15, 0.0051, 13.21, 0.0043, 14.25, 0.0015, 15.31, 0.0023,
- 16.40, 0.0008, 17.48, 0.0004, 18.59, 0.0016, 19.71, 0.0010, 20.84, 0.0018, 21.98, 0.0002, 23.11, 0.0013, 24.26, 0.0003,
- 26.67, 0.0002, 29.12, 0.0002, 30.37, 0.0002, 31.62, 0.0003, 32.92, 0.0001],
-
- [0.99, 0.1174, 1.99, 0.1126, 2.99, 0.0370, 3.99, 0.0159, 5.01, 0.0472, 6.01, 0.0091, 7.03, 0.0211,
- 8.05, 0.0015, 9.07, 0.0098, 10.11, 0.0038, 11.15, 0.0042, 12.20, 0.0018, 13.24, 0.0041, 14.32, 0.0033, 15.41, 0.0052,
- 16.49, 0.0001, 17.61, 0.0004, 18.71, 0.0004, 19.84, 0.0004, 20.99, 0.0002, 22.14, 0.0006, 23.31, 0.0006, 24.50, 0.0004,
- 25.70, 0.0002, 28.09, 0.0002, 28.66, 0.0002, 32.00, 0.0001],
-
- [1.00, 0.1085, 2.00, 0.1400, 2.99, 0.0173, 3.99, 0.0229, 5.00, 0.0272, 6.02, 0.0077, 7.03, 0.0069,
- 8.04, 0.0017, 9.08, 0.0045, 10.10, 0.0030, 11.15, 0.0040, 12.20, 0.0007, 13.25, 0.0019, 14.32, 0.0008, 15.42, 0.0024,
- 16.50, 0.0002, 17.59, 0.0005, 18.71, 0.0003, 19.83, 0.0002, 20.98, 0.0005, 23.29, 0.0008],
-
- [1.00, 0.0985, 2.00, 0.1440, 2.99, 0.0364, 3.99, 0.0425, 5.00, 0.0190, 6.01, 0.0089, 7.03, 0.0278,
- 8.04, 0.0006, 9.07, 0.0083, 10.10, 0.0021, 11.14, 0.0050, 12.18, 0.0005, 13.26, 0.0036, 14.33, 0.0005, 15.41, 0.0026,
- 17.62, 0.0004, 18.75, 0.0004, 19.89, 0.0003, 21.04, 0.0012, 22.21, 0.0002, 23.38, 0.0004, 27.04, 0.0001],
-
- [0.99, 0.1273, 2.00, 0.1311, 2.99, 0.0120, 4.00, 0.0099, 5.00, 0.0235, 6.02, 0.0068, 7.03, 0.0162,
- 8.06, 0.0009, 9.08, 0.0083, 10.12, 0.0014, 11.17, 0.0050, 12.24, 0.0010, 13.29, 0.0013, 14.39, 0.0022, 15.48, 0.0011,
- 16.59, 0.0002, 17.70, 0.0003, 18.84, 0.0010, 20.00, 0.0003, 21.17, 0.0003, 23.56, 0.0004, 28.79, 0.0003],
-
- [1.00, 0.1018, 2.00, 0.1486, 3.00, 0.0165, 4.00, 0.0186, 5.01, 0.0194, 6.02, 0.0045, 7.04, 0.0083,
- 8.06, 0.0012, 9.10, 0.0066, 10.15, 0.0009, 11.19, 0.0008, 12.26, 0.0011, 13.34, 0.0028, 14.45, 0.0006, 15.53, 0.0009,
- 16.66, 0.0002, 17.79, 0.0006, 18.94, 0.0005, 20.11, 0.0003, 21.29, 0.0005, 22.49, 0.0003, 23.73, 0.0005, 26.22, 0.0001,
- 27.52, 0.0001, 28.88, 0.0002],
-
- [1.00, 0.1889, 1.99, 0.1822, 3.00, 0.0363, 4.00, 0.0047, 5.01, 0.0202, 6.03, 0.0053, 7.05, 0.0114,
- 8.01, 0.0002, 9.13, 0.0048, 10.17, 0.0010, 11.23, 0.0033, 12.30, 0.0010, 13.38, 0.0006, 14.50, 0.0002, 15.62, 0.0010,
- 20.27, 0.0001, 21.47, 0.0001],
-
- [1.00, 0.0522, 1.99, 0.0763, 2.99, 0.0404, 4.00, 0.0139, 5.01, 0.0185, 6.01, 0.0021, 7.06, 0.0045,
- 8.09, 0.0002, 9.11, 0.0003, 10.17, 0.0006, 11.25, 0.0004, 12.32, 0.0005, 13.40, 0.0003, 14.53, 0.0003, 15.65, 0.0007,
- 16.80, 0.0001, 17.95, 0.0002, 19.14, 0.0006, 20.34, 0.0002, 21.56, 0.0003],
-
- [0.99, 0.1821, 1.99, 0.0773, 3.00, 0.0125, 4.01, 0.0065, 5.01, 0.0202, 6.03, 0.0071, 7.05, 0.0090,
- 8.08, 0.0006, 9.13, 0.0008, 10.18, 0.0013, 11.25, 0.0010, 12.33, 0.0012, 13.42, 0.0006, 14.54, 0.0005, 15.65, 0.0004,
- 17.97, 0.0002, 19.15, 0.0001],
-
- [1.00, 0.1868, 2.00, 0.0951, 3.00, 0.0147, 4.01, 0.0134, 5.02, 0.0184, 6.04, 0.0132, 7.06, 0.0011,
- 8.11, 0.0008, 9.15, 0.0010, 10.22, 0.0012, 11.30, 0.0011, 12.40, 0.0003, 13.11, 0.0004, 13.49, 0.0002, 14.62, 0.0003,
- 15.77, 0.0001],
-
- [1.00, 0.1933, 2.00, 0.0714, 3.00, 0.0373, 4.00, 0.0108, 5.02, 0.0094, 6.02, 0.0010, 7.07, 0.0022,
- 8.11, 0.0002, 9.16, 0.0065, 10.23, 0.0015, 11.31, 0.0023, 12.40, 0.0003, 13.53, 0.0014, 14.66, 0.0002, 15.81, 0.0011,
- 18.20, 0.0002, 19.41, 0.0001],
-
- [0.99, 0.2113, 1.99, 0.0877, 3.00, 0.0492, 4.01, 0.0094, 5.02, 0.0144, 6.04, 0.0103, 7.07, 0.0117,
- 8.12, 0.0006, 9.19, 0.0019, 10.25, 0.0007, 11.35, 0.0017, 12.45, 0.0010, 13.58, 0.0003, 14.74, 0.0003, 15.91, 0.0003,
- 19.57, 0.0002],
-
- [0.99, 0.2455, 1.99, 0.0161, 3.00, 0.0215, 4.01, 0.0036, 5.03, 0.0049, 6.04, 0.0012, 7.09, 0.0036,
- 8.14, 0.0011, 9.21, 0.0009, 10.30, 0.0001, 11.40, 0.0012, 12.50, 0.0001, 13.66, 0.0005, 14.84, 0.0001],
-
- [1.00, 0.1132, 2.00, 0.0252, 3.00, 0.0292, 4.01, 0.0136, 5.03, 0.0045, 6.06, 0.0022, 7.11, 0.0101,
- 8.17, 0.0004, 9.23, 0.0010, 10.33, 0.0012, 11.44, 0.0013, 12.58, 0.0011, 13.75, 0.0002, 14.93, 0.0005, 16.14, 0.0002],
-
- [1.00, 0.1655, 2.00, 0.0445, 3.00, 0.0120, 4.00, 0.0038, 5.02, 0.0015, 6.07, 0.0038, 7.11, 0.0003,
- 8.19, 0.0002, 9.25, 0.0010, 10.36, 0.0011, 11.48, 0.0005, 12.63, 0.0002, 13.79, 0.0003, 16.24, 0.0002],
-
- [0.99, 0.3637, 1.99, 0.0259, 3.01, 0.0038, 4.01, 0.0057, 5.03, 0.0040, 6.07, 0.0067, 7.12, 0.0014,
- 8.19, 0.0004, 9.27, 0.0003, 10.38, 0.0002, 12.67, 0.0001],
-
- [1.00, 0.1193, 2.00, 0.0230, 3.00, 0.0104, 4.01, 0.0084, 5.04, 0.0047, 6.08, 0.0035, 7.13, 0.0041,
- 8.20, 0.0002, 9.29, 0.0005, 10.40, 0.0005, 11.53, 0.0003, 12.70, 0.0002, 13.91, 0.0002],
-
- [1.00, 0.0752, 2.00, 0.0497, 3.00, 0.0074, 4.02, 0.0076, 5.05, 0.0053, 6.09, 0.0043, 7.15, 0.0024,
- 8.22, 0.0001, 9.32, 0.0006, 10.45, 0.0002, 11.58, 0.0001, 12.78, 0.0001, 15.22, 0.0001],
-
- [1.00, 0.2388, 2.00, 0.0629, 3.01, 0.0159, 4.04, 0.0063, 5.07, 0.0051, 6.12, 0.0045, 7.19, 0.0026, 8.29, 0.0015,
- 9.43, 0.0001, 11.75, 0.0002],
-
- [1.00, 0.1919, 2.01, 0.0116, 3.01, 0.0031, 4.03, 0.0090, 5.07, 0.0061, 6.13, 0.0036, 7.19, 0.0013, 8.30, 0.0016,
- 9.13, 0.0001, 10.59, 0.0002, 11.78, 0.0002],
-
- [1.00, 0.1296, 2.00, 0.0135, 3.01, 0.0041, 4.04, 0.0045, 5.09, 0.0028, 6.14, 0.0046, 7.23, 0.0007, 8.32, 0.0007,
- 9.50, 0.0001],
-
- [1.00, 0.0692, 2.00, 0.0209, 3.02, 0.0025, 4.05, 0.0030, 5.09, 0.0047, 6.17, 0.0022, 7.25, 0.0015, 8.36, 0.0015,
- 9.53, 0.0010, 10.69, 0.0001, 13.40, 0.0001],
-
- [1.00, 0.1715, 2.00, 0.0142, 3.01, 0.0024, 4.03, 0.0015, 5.07, 0.0017, 6.13, 0.0018, 7.22, 0.0009, 8.33, 0.0014,
- 9.51, 0.0007, 10.69, 0.0002],
-
- [1.00, 0.1555, 2.01, 0.0148, 3.02, 0.0007, 4.06, 0.0006, 5.10, 0.0005, 6.16, 0.0008, 7.26, 0.0009, 8.39, 0.0008,
- 9.58, 0.0002],
-
- [1.00, 0.1357, 2.00, 0.0116, 3.02, 0.0026, 4.04, 0.0009, 5.09, 0.0004, 6.17, 0.0005, 7.27, 0.0002, 8.40, 0.0001],
-
- [1.00, 0.2185, 2.01, 0.0087, 3.03, 0.0018, 4.06, 0.0025, 5.11, 0.0020, 6.20, 0.0012, 7.32, 0.0005, 8.46, 0.0001,
- 9.66, 0.0003],
-
- [1.00, 0.2735, 2.00, 0.0038, 3.02, 0.0008, 4.06, 0.0012, 5.12, 0.0008, 6.22, 0.0011, 7.35, 0.0003, 8.50, 0.0002],
-
- [1.00, 0.1441, 1.99, 0.0062, 3.01, 0.0023, 4.05, 0.0011, 5.11, 0.0012, 6.20, 0.0003, 7.33, 0.0004, 8.50, 0.0001],
-
- [1.00, 0.0726, 2.01, 0.0293, 3.03, 0.0022, 5.14, 0.0005, 6.26, 0.0011, 7.41, 0.0002, 8.63, 0.0002],
-
+Piano_Spectra = [[1.97, 0.0326, 2.99, 0.0086, 3.95, 0.0163, 4.97,
+ 0.0178, 5.98, 0.0177, 6.95, 0.0315, 8.02, 0.0001, 8.94, 0.0076,
+ 9.96, 0.0134, 10.99, 0.0284, 11.98, 0.0229, 13.02, 0.0229, 13.89,
+ 0.0010, 15.06, 0.0090, 16.00, 0.0003, 17.08, 0.0078, 18.16, 0.0064,
+ 19.18, 0.0129, 20.21, 0.0085, 21.27, 0.0225, 22.32, 0.0061, 23.41,
+ 0.0102, 24.48, 0.0005, 25.56, 0.0016, 26.64, 0.0018, 27.70, 0.0113,
+ 28.80, 0.0111, 29.91, 0.0158, 31.06, 0.0093, 32.17, 0.0017, 33.32,
+ 0.0002, 34.42, 0.0018, 35.59, 0.0027, 36.74, 0.0055, 37.90, 0.0037,
+ 39.06, 0.0064, 40.25, 0.0033, 41.47, 0.0014, 42.53, 0.0004, 43.89,
+ 0.0010, 45.12, 0.0039, 46.33, 0.0039, 47.64, 0.0009, 48.88, 0.0016,
+ 50.13, 0.0006, 51.37, 0.0010, 52.70, 0.0002, 54.00, 0.0004, 55.30,
+ 0.0008, 56.60, 0.0025, 57.96, 0.0010, 59.30, 0.0012, 60.67, 0.0011,
+ 61.99, 0.0003, 62.86, 0.0001, 64.36, 0.0005, 64.86, 0.0001, 66.26,
+ 0.0004, 67.70, 0.0006, 68.94, 0.0002, 70.10, 0.0001, 70.58, 0.0002,
+ 72.01, 0.0007, 73.53, 0.0006, 75.00, 0.0002, 77.03, 0.0005, 78.00,
+ 0.0002, 79.57, 0.0006, 81.16, 0.0005, 82.70, 0.0005, 84.22, 0.0003,
+ 85.41, 0.0002, 87.46, 0.0001, 90.30, 0.0001, 94.02, 0.0001, 95.26,
+ 0.0002, 109.39, 0.0003],
+ [1.98, 0.0194, 2.99, 0.0210, 3.97, 0.0276, 4.96, 0.0297, 5.96, 0.0158,
+ 6.99, 0.0207, 8.01, 0.0009, 9.00, 0.0101, 10.00, 0.0297, 11.01,
+ 0.0289, 12.02, 0.0211, 13.04, 0.0127, 14.07, 0.0061, 15.08, 0.0174,
+ 16.13, 0.0009, 17.12, 0.0093, 18.16, 0.0117, 19.21, 0.0122, 20.29,
+ 0.0108, 21.30, 0.0077, 22.38, 0.0132, 23.46, 0.0073, 24.14, 0.0002,
+ 25.58, 0.0026, 26.69, 0.0035, 27.77, 0.0053, 28.88, 0.0024, 30.08,
+ 0.0027, 31.13, 0.0075, 32.24, 0.0027, 33.36, 0.0004, 34.42, 0.0004,
+ 35.64, 0.0019, 36.78, 0.0037, 38.10, 0.0009, 39.11, 0.0027, 40.32,
+ 0.0010, 41.51, 0.0013, 42.66, 0.0019, 43.87, 0.0007, 45.13, 0.0017,
+ 46.35, 0.0019, 47.65, 0.0021, 48.89, 0.0014, 50.18, 0.0023, 51.42,
+ 0.0015, 52.73, 0.0002, 54.00, 0.0005, 55.34, 0.0006, 56.60, 0.0010,
+ 57.96, 0.0016, 58.86, 0.0005, 59.30, 0.0004, 60.75, 0.0005, 62.22,
+ 0.0003, 63.55, 0.0005, 64.82, 0.0003, 66.24, 0.0003, 67.63, 0.0011,
+ 69.09, 0.0007, 70.52, 0.0004, 72.00, 0.0005, 73.50, 0.0008, 74.95,
+ 0.0003, 77.13, 0.0013, 78.02, 0.0002, 79.48, 0.0004, 82.59, 0.0004,
+ 84.10, 0.0003],
+ [2.00, 0.0313, 2.99, 0.0109, 4.00, 0.0215, 5.00, 0.0242, 5.98, 0.0355,
+ 7.01, 0.0132, 8.01, 0.0009, 9.01, 0.0071, 10.00, 0.0258, 11.03,
+ 0.0221, 12.02, 0.0056, 13.06, 0.0196, 14.05, 0.0160, 15.11, 0.0107,
+ 16.11, 0.0003, 17.14, 0.0111, 18.21, 0.0085, 19.23, 0.0010, 20.28,
+ 0.0048, 21.31, 0.0128, 22.36, 0.0051, 23.41, 0.0041, 24.05, 0.0006,
+ 25.54, 0.0019, 26.62, 0.0028, 27.72, 0.0034, 28.82, 0.0062, 29.89,
+ 0.0039, 30.98, 0.0058, 32.08, 0.0011, 33.21, 0.0002, 34.37, 0.0008,
+ 35.46, 0.0018, 36.62, 0.0036, 37.77, 0.0018, 38.92, 0.0042, 40.07,
+ 0.0037, 41.23, 0.0011, 42.67, 0.0003, 43.65, 0.0018, 44.68, 0.0025,
+ 45.99, 0.0044, 47.21, 0.0051, 48.40, 0.0044, 49.67, 0.0005, 50.88,
+ 0.0019, 52.15, 0.0003, 53.42, 0.0008, 54.69, 0.0010, 55.98, 0.0005,
+ 57.26, 0.0013, 58.53, 0.0027, 59.83, 0.0011, 61.21, 0.0027, 62.54,
+ 0.0003, 63.78, 0.0003, 65.20, 0.0001, 66.60, 0.0006, 67.98, 0.0008,
+ 69.37, 0.0019, 70.73, 0.0007, 72.14, 0.0004, 73.62, 0.0002, 74.40,
+ 0.0003, 76.52, 0.0006, 77.97, 0.0002, 79.49, 0.0004, 80.77, 0.0003,
+ 81.00, 0.0001, 82.47, 0.0005, 83.97, 0.0001, 87.27, 0.0002],
+ [2.00, 0.0257, 2.99, 0.0142, 3.97, 0.0202, 4.95, 0.0148, 5.95, 0.0420,
+ 6.95, 0.0037, 7.94, 0.0004, 8.94, 0.0172, 9.95, 0.0191, 10.96, 0.0115,
+ 11.97, 0.0059, 12.98, 0.0140, 14.00, 0.0178, 15.03, 0.0121, 16.09,
+ 0.0002, 17.07, 0.0066, 18.08, 0.0033, 19.15, 0.0022, 20.18, 0.0057,
+ 21.22, 0.0077, 22.29, 0.0037, 23.33, 0.0066, 24.97, 0.0002, 25.49,
+ 0.0019, 26.55, 0.0042, 27.61, 0.0043, 28.73, 0.0038, 29.81, 0.0084,
+ 30.91, 0.0040, 32.03, 0.0025, 33.14, 0.0005, 34.26, 0.0003, 35.38,
+ 0.0019, 36.56, 0.0037, 37.68, 0.0049, 38.86, 0.0036, 40.11, 0.0011,
+ 41.28, 0.0008, 42.50, 0.0004, 43.60, 0.0002, 44.74, 0.0022, 45.99,
+ 0.0050, 47.20, 0.0009, 48.40, 0.0036, 49.68, 0.0004, 50.92, 0.0009,
+ 52.17, 0.0005, 53.46, 0.0007, 54.76, 0.0006, 56.06, 0.0005, 57.34,
+ 0.0011, 58.67, 0.0005, 59.95, 0.0015, 61.37, 0.0008, 62.72, 0.0004,
+ 65.42, 0.0009, 66.96, 0.0003, 68.18, 0.0003, 69.78, 0.0003, 71.21,
+ 0.0004, 72.45, 0.0002, 74.22, 0.0003, 75.44, 0.0001, 76.53, 0.0003,
+ 78.31, 0.0004, 79.83, 0.0003, 80.16, 0.0001, 81.33, 0.0003, 82.44,
+ 0.0001, 83.17, 0.0002, 84.81, 0.0003, 85.97, 0.0003, 89.08, 0.0001,
+ 90.70, 0.0002, 92.30, 0.0002, 95.59, 0.0002, 97.22, 0.0003, 98.86,
+ 0.0001, 108.37, 0.0001, 125.54, 0.0001],
+ [1.99, 0.0650, 3.03, 0.0040, 4.03, 0.0059, 5.02, 0.0090, 5.97, 0.0227,
+ 6.98, 0.0050, 8.04, 0.0020, 9.00, 0.0082, 9.96, 0.0078, 11.01, 0.0056,
+ 12.01, 0.0095, 13.02, 0.0050, 14.04, 0.0093, 15.08, 0.0064, 16.14,
+ 0.0017, 17.06, 0.0020, 18.10, 0.0025, 19.14, 0.0023, 20.18, 0.0015,
+ 21.24, 0.0032, 22.29, 0.0029, 23.32, 0.0014, 24.37, 0.0005, 25.43,
+ 0.0030, 26.50, 0.0022, 27.60, 0.0027, 28.64, 0.0024, 29.76, 0.0035,
+ 30.81, 0.0136, 31.96, 0.0025, 33.02, 0.0003, 34.13, 0.0005, 35.25,
+ 0.0007, 36.40, 0.0014, 37.51, 0.0020, 38.64, 0.0012, 39.80, 0.0019,
+ 40.97, 0.0004, 42.09, 0.0003, 43.24, 0.0003, 44.48, 0.0002, 45.65,
+ 0.0024, 46.86, 0.0005, 48.07, 0.0013, 49.27, 0.0008, 50.49, 0.0006,
+ 52.95, 0.0001, 54.23, 0.0005, 55.45, 0.0004, 56.73, 0.0001, 58.03,
+ 0.0003, 59.29, 0.0002, 60.59, 0.0003, 62.04, 0.0002, 65.89, 0.0002,
+ 67.23, 0.0002, 68.61, 0.0002, 69.97, 0.0004, 71.36, 0.0005, 85.42,
+ 0.0001],
+ [1.98, 0.0256, 2.96, 0.0158, 3.95, 0.0310, 4.94, 0.0411, 5.95, 0.0238,
+ 6.94, 0.0152, 7.93, 0.0011, 8.95, 0.0185, 9.92, 0.0166, 10.93, 0.0306,
+ 11.94, 0.0258, 12.96, 0.0202, 13.97, 0.0403, 14.95, 0.0228, 15.93,
+ 0.0005, 17.01, 0.0072, 18.02, 0.0034, 19.06, 0.0028, 20.08, 0.0124,
+ 21.13, 0.0137, 22.16, 0.0102, 23.19, 0.0058, 23.90, 0.0013, 25.30,
+ 0.0039, 26.36, 0.0039, 27.41, 0.0025, 28.47, 0.0071, 29.64, 0.0031,
+ 30.60, 0.0027, 31.71, 0.0021, 32.84, 0.0003, 33.82, 0.0002, 35.07,
+ 0.0019, 36.09, 0.0054, 37.20, 0.0038, 38.33, 0.0024, 39.47, 0.0055,
+ 40.55, 0.0016, 41.77, 0.0006, 42.95, 0.0002, 43.27, 0.0018, 44.03,
+ 0.0006, 45.25, 0.0019, 46.36, 0.0033, 47.50, 0.0024, 48.87, 0.0012,
+ 50.03, 0.0016, 51.09, 0.0004, 53.52, 0.0017, 54.74, 0.0012, 56.17,
+ 0.0003, 57.40, 0.0011, 58.42, 0.0020, 59.70, 0.0007, 61.29, 0.0008,
+ 62.56, 0.0003, 63.48, 0.0002, 64.83, 0.0002, 66.12, 0.0012, 67.46,
+ 0.0017, 68.81, 0.0003, 69.13, 0.0003, 70.53, 0.0002, 71.84, 0.0001,
+ 73.28, 0.0002, 75.52, 0.0010, 76.96, 0.0005, 77.93, 0.0003, 78.32,
+ 0.0003, 79.73, 0.0003, 81.69, 0.0002, 82.52, 0.0001, 84.01, 0.0001,
+ 84.61, 0.0002, 86.88, 0.0001, 88.36, 0.0002, 89.85, 0.0002, 91.35,
+ 0.0003, 92.86, 0.0002, 93.40, 0.0001, 105.28, 0.0002, 106.22, 0.0002,
+ 107.45, 0.0001, 108.70, 0.0003, 122.08, 0.0002],
+ [1.97, 0.0264, 2.97, 0.0211, 3.98, 0.0234, 4.98, 0.0307, 5.96, 0.0085,
+ 6.94, 0.0140, 7.93, 0.0005, 8.96, 0.0112, 9.96, 0.0209, 10.98, 0.0194,
+ 11.98, 0.0154, 12.99, 0.0274, 13.99, 0.0127, 15.01, 0.0101, 15.99,
+ 0.0002, 17.04, 0.0011, 18.08, 0.0032, 19.14, 0.0028, 20.12, 0.0054,
+ 21.20, 0.0053, 22.13, 0.0028, 23.22, 0.0030, 24.32, 0.0006, 25.24,
+ 0.0004, 26.43, 0.0028, 27.53, 0.0048, 28.52, 0.0039, 29.54, 0.0047,
+ 30.73, 0.0044, 31.82, 0.0007, 32.94, 0.0008, 34.04, 0.0012, 35.13,
+ 0.0018, 36.29, 0.0007, 37.35, 0.0075, 38.51, 0.0045, 39.66, 0.0014,
+ 40.90, 0.0004, 41.90, 0.0002, 43.08, 0.0002, 44.24, 0.0017, 45.36,
+ 0.0013, 46.68, 0.0020, 47.79, 0.0015, 48.98, 0.0010, 50.21, 0.0012,
+ 51.34, 0.0001, 53.82, 0.0003, 55.09, 0.0004, 56.23, 0.0005, 57.53,
+ 0.0004, 58.79, 0.0005, 59.30, 0.0002, 60.03, 0.0002, 61.40, 0.0003,
+ 62.84, 0.0001, 66.64, 0.0001, 67.97, 0.0001, 69.33, 0.0001, 70.68,
+ 0.0001, 73.57, 0.0002, 75.76, 0.0002, 76.45, 0.0001, 79.27, 0.0001,
+ 80.44, 0.0002, 81.87, 0.0002],
+ [2.00, 0.0311, 2.99, 0.0086, 3.99, 0.0266, 4.97, 0.0123, 5.98, 0.0235,
+ 6.97, 0.0161, 7.97, 0.0008, 8.96, 0.0088, 9.96, 0.0621, 10.99, 0.0080,
+ 11.99, 0.0034, 12.99, 0.0300, 14.03, 0.0228, 15.04, 0.0105, 16.03,
+ 0.0004, 17.06, 0.0036, 18.09, 0.0094, 18.95, 0.0009, 20.17, 0.0071,
+ 21.21, 0.0161, 22.25, 0.0106, 23.28, 0.0104, 24.33, 0.0008, 25.38,
+ 0.0030, 26.46, 0.0035, 27.50, 0.0026, 28.59, 0.0028, 29.66, 0.0128,
+ 30.75, 0.0139, 31.81, 0.0038, 32.93, 0.0006, 34.04, 0.0004, 35.16,
+ 0.0005, 36.25, 0.0023, 37.35, 0.0012, 38.46, 0.0021, 39.59, 0.0035,
+ 40.71, 0.0006, 41.86, 0.0007, 42.42, 0.0001, 43.46, 0.0003, 44.17,
+ 0.0032, 45.29, 0.0013, 46.57, 0.0004, 47.72, 0.0011, 48.79, 0.0005,
+ 50.11, 0.0005, 51.29, 0.0003, 52.47, 0.0002, 53.68, 0.0004, 55.02,
+ 0.0005, 56.18, 0.0003, 57.41, 0.0003, 58.75, 0.0007, 59.33, 0.0009,
+ 60.00, 0.0004, 61.34, 0.0001, 64.97, 0.0003, 65.20, 0.0002, 66.48,
+ 0.0002, 67.83, 0.0002, 68.90, 0.0003, 70.25, 0.0003, 71.59, 0.0002,
+ 73.68, 0.0001, 75.92, 0.0001, 77.08, 0.0002, 78.45, 0.0002, 81.56,
+ 0.0002, 82.99, 0.0001, 88.39, 0.0001],
+ [0.97, 0.0059, 1.98, 0.0212, 2.99, 0.0153, 3.99, 0.0227, 4.96, 0.0215,
+ 5.97, 0.0153, 6.98, 0.0085, 7.98, 0.0007, 8.97, 0.0179, 9.98, 0.0512,
+ 10.98, 0.0322, 12.00, 0.0098, 13.02, 0.0186, 14.00, 0.0099, 15.05,
+ 0.0109, 15.88, 0.0011, 17.07, 0.0076, 18.11, 0.0071, 19.12, 0.0045,
+ 20.16, 0.0038, 21.23, 0.0213, 22.27, 0.0332, 23.34, 0.0082, 24.34,
+ 0.0014, 25.42, 0.0024, 26.47, 0.0012, 27.54, 0.0014, 28.60, 0.0024,
+ 29.72, 0.0026, 30.10, 0.0008, 31.91, 0.0021, 32.13, 0.0011, 33.02,
+ 0.0007, 34.09, 0.0014, 35.17, 0.0007, 36.27, 0.0024, 37.39, 0.0029,
+ 38.58, 0.0014, 39.65, 0.0017, 40.95, 0.0012, 41.97, 0.0004, 42.43,
+ 0.0002, 43.49, 0.0001, 44.31, 0.0012, 45.42, 0.0031, 46.62, 0.0017,
+ 47.82, 0.0013, 49.14, 0.0013, 50.18, 0.0010, 51.54, 0.0003, 53.90,
+ 0.0006, 55.06, 0.0010, 56.31, 0.0003, 57.63, 0.0001, 59.02, 0.0003,
+ 60.09, 0.0004, 60.35, 0.0004, 61.62, 0.0009, 63.97, 0.0001, 65.19,
+ 0.0001, 65.54, 0.0002, 66.92, 0.0002, 67.94, 0.0002, 69.17, 0.0003,
+ 69.60, 0.0004, 70.88, 0.0002, 72.24, 0.0002, 76.12, 0.0001, 78.94,
+ 0.0001, 81.75, 0.0001, 82.06, 0.0001, 83.53, 0.0001, 90.29, 0.0002,
+ 91.75, 0.0001, 92.09, 0.0002, 93.28, 0.0001, 97.07, 0.0001],
+ [1.98, 0.0159, 2.98, 0.1008, 3.98, 0.0365, 4.98, 0.0133, 5.97, 0.0101,
+ 6.97, 0.0115, 7.97, 0.0007, 8.99, 0.0349, 10.01, 0.0342, 11.01,
+ 0.0236, 12.00, 0.0041, 13.02, 0.0114, 14.05, 0.0137, 15.06, 0.0100,
+ 16.05, 0.0007, 17.04, 0.0009, 18.12, 0.0077, 19.15, 0.0023, 20.12,
+ 0.0017, 21.24, 0.0113, 22.26, 0.0126, 23.30, 0.0093, 24.36, 0.0007,
+ 25.43, 0.0007, 26.47, 0.0009, 27.55, 0.0013, 28.59, 0.0025, 29.61,
+ 0.0010, 30.77, 0.0021, 31.86, 0.0023, 32.96, 0.0003, 34.03, 0.0007,
+ 35.06, 0.0005, 36.20, 0.0006, 37.34, 0.0006, 38.36, 0.0009, 39.60,
+ 0.0016, 40.69, 0.0005, 41.77, 0.0002, 42.92, 0.0002, 44.02, 0.0003,
+ 45.24, 0.0006, 46.33, 0.0004, 47.50, 0.0007, 48.71, 0.0007, 49.87,
+ 0.0002, 51.27, 0.0002, 53.42, 0.0003, 55.88, 0.0003, 57.10, 0.0004,
+ 58.34, 0.0002, 59.86, 0.0003, 61.13, 0.0003, 67.18, 0.0001, 68.50,
+ 0.0001, 71.17, 0.0001, 83.91, 0.0001, 90.55, 0.0001],
+ [0.98, 0.0099, 2.00, 0.0181, 2.99, 0.0353, 3.98, 0.0285, 4.97, 0.0514,
+ 5.96, 0.0402, 6.96, 0.0015, 7.98, 0.0012, 8.98, 0.0175, 9.98, 0.0264,
+ 10.98, 0.0392, 11.98, 0.0236, 13.00, 0.0153, 14.04, 0.0049, 15.00,
+ 0.0089, 16.01, 0.0001, 17.03, 0.0106, 18.03, 0.0028, 19.05, 0.0024,
+ 20.08, 0.0040, 21.11, 0.0103, 22.12, 0.0104, 23.20, 0.0017, 24.19,
+ 0.0008, 25.20, 0.0007, 26.24, 0.0011, 27.36, 0.0009, 27.97, 0.0030,
+ 29.40, 0.0044, 30.37, 0.0019, 31.59, 0.0017, 32.65, 0.0008, 33.59,
+ 0.0005, 34.79, 0.0009, 35.75, 0.0027, 36.88, 0.0035, 37.93, 0.0039,
+ 39.00, 0.0031, 40.08, 0.0025, 41.16, 0.0010, 43.25, 0.0004, 44.52,
+ 0.0012, 45.62, 0.0023, 45.85, 0.0012, 47.00, 0.0006, 47.87, 0.0008,
+ 48.99, 0.0003, 50.48, 0.0003, 51.62, 0.0001, 52.43, 0.0001, 53.56,
+ 0.0002, 54.76, 0.0002, 56.04, 0.0002, 56.68, 0.0006, 57.10, 0.0003,
+ 58.28, 0.0005, 59.47, 0.0003, 59.96, 0.0002, 60.67, 0.0001, 63.08,
+ 0.0002, 64.29, 0.0002, 66.72, 0.0001, 67.97, 0.0001, 68.65, 0.0001,
+ 70.43, 0.0001, 79.38, 0.0001, 80.39, 0.0001, 82.39, 0.0001],
+ [1.00, 0.0765, 1.99, 0.0151, 2.99, 0.0500, 3.99, 0.0197, 5.00, 0.0260,
+ 6.00, 0.0145, 6.98, 0.0128, 7.97, 0.0004, 8.98, 0.0158, 9.99, 0.0265,
+ 11.02, 0.0290, 12.02, 0.0053, 13.03, 0.0242, 14.03, 0.0103, 15.06,
+ 0.0054, 16.04, 0.0006, 17.08, 0.0008, 18.10, 0.0058, 19.16, 0.0011,
+ 20.16, 0.0055, 21.18, 0.0040, 22.20, 0.0019, 23.22, 0.0014, 24.05,
+ 0.0005, 25.31, 0.0019, 26.38, 0.0018, 27.44, 0.0022, 28.45, 0.0024,
+ 29.57, 0.0073, 30.58, 0.0032, 31.66, 0.0071, 32.73, 0.0015, 33.85,
+ 0.0005, 34.96, 0.0003, 36.00, 0.0020, 37.11, 0.0018, 38.18, 0.0055,
+ 39.23, 0.0006, 40.33, 0.0004, 41.52, 0.0003, 43.41, 0.0028, 45.05,
+ 0.0003, 45.99, 0.0002, 47.07, 0.0003, 48.52, 0.0002, 49.48, 0.0003,
+ 50.63, 0.0003, 51.81, 0.0002, 54.05, 0.0002, 55.24, 0.0001, 56.62,
+ 0.0001, 57.81, 0.0004, 59.16, 0.0013, 60.23, 0.0003, 66.44, 0.0001,
+ 68.99, 0.0004, 75.49, 0.0001, 87.56, 0.0004],
+ [0.98, 0.0629, 1.99, 0.0232, 2.98, 0.0217, 4.00, 0.0396, 4.98, 0.0171,
+ 5.97, 0.0098, 6.99, 0.0167, 7.99, 0.0003, 8.98, 0.0192, 9.98, 0.0266,
+ 10.99, 0.0256, 12.01, 0.0061, 13.02, 0.0135, 14.02, 0.0062, 15.05,
+ 0.0158, 16.06, 0.0018, 17.08, 0.0101, 18.09, 0.0053, 19.11, 0.0074,
+ 20.13, 0.0020, 21.17, 0.0052, 22.22, 0.0077, 23.24, 0.0035, 24.00,
+ 0.0009, 25.32, 0.0016, 26.40, 0.0022, 27.43, 0.0005, 28.55, 0.0026,
+ 29.60, 0.0026, 30.65, 0.0010, 31.67, 0.0019, 32.77, 0.0008, 33.81,
+ 0.0003, 34.91, 0.0003, 36.01, 0.0005, 37.11, 0.0010, 38.20, 0.0014,
+ 39.29, 0.0039, 40.43, 0.0012, 41.50, 0.0006, 43.38, 0.0017, 43.75,
+ 0.0002, 44.94, 0.0005, 46.13, 0.0002, 47.11, 0.0003, 48.28, 0.0005,
+ 48.42, 0.0005, 49.44, 0.0003, 50.76, 0.0004, 51.93, 0.0002, 54.15,
+ 0.0003, 55.31, 0.0005, 55.50, 0.0003, 56.98, 0.0003, 57.90, 0.0004,
+ 60.33, 0.0002, 61.39, 0.0001, 61.59, 0.0001, 65.09, 0.0002, 66.34,
+ 0.0001, 68.85, 0.0001, 70.42, 0.0002, 71.72, 0.0001, 73.05, 0.0003,
+ 79.65, 0.0001, 85.28, 0.0002, 93.52, 0.0001],
+ [1.02, 0.0185, 1.99, 0.0525, 2.98, 0.0613, 3.99, 0.0415, 4.98, 0.0109,
+ 5.97, 0.0248, 6.99, 0.0102, 7.98, 0.0005, 8.98, 0.0124, 9.99, 0.0103,
+ 10.99, 0.0124, 12.00, 0.0016, 13.01, 0.0029, 14.03, 0.0211, 15.04,
+ 0.0128, 16.07, 0.0021, 17.09, 0.0009, 18.09, 0.0043, 19.14, 0.0022,
+ 20.13, 0.0016, 21.20, 0.0045, 22.21, 0.0088, 23.26, 0.0046, 24.29,
+ 0.0013, 25.35, 0.0009, 26.39, 0.0028, 27.49, 0.0009, 28.51, 0.0006,
+ 29.58, 0.0012, 30.70, 0.0010, 31.74, 0.0019, 32.75, 0.0002, 33.85,
+ 0.0001, 34.95, 0.0005, 36.02, 0.0003, 37.16, 0.0009, 38.25, 0.0018,
+ 39.35, 0.0008, 40.54, 0.0004, 41.61, 0.0002, 43.40, 0.0004, 43.74,
+ 0.0003, 45.05, 0.0001, 46.11, 0.0003, 47.40, 0.0002, 48.36, 0.0004,
+ 49.55, 0.0004, 50.72, 0.0002, 52.00, 0.0001, 55.58, 0.0002, 57.02,
+ 0.0001, 57.98, 0.0002, 59.13, 0.0003, 61.56, 0.0001, 66.56, 0.0001,
+ 87.65, 0.0002],
+ [1.00, 0.0473, 1.99, 0.0506, 2.99, 0.0982, 3.99, 0.0654, 5.00, 0.0196,
+ 5.99, 0.0094, 6.99, 0.0118, 7.93, 0.0001, 8.99, 0.0057, 10.01, 0.0285,
+ 11.01, 0.0142, 12.03, 0.0032, 13.03, 0.0056, 14.06, 0.0064, 15.06,
+ 0.0059, 16.11, 0.0005, 17.09, 0.0033, 18.14, 0.0027, 19.15, 0.0014,
+ 20.17, 0.0010, 21.21, 0.0059, 22.26, 0.0043, 23.31, 0.0031, 24.31,
+ 0.0018, 25.33, 0.0009, 26.41, 0.0005, 27.47, 0.0015, 28.53, 0.0015,
+ 29.58, 0.0041, 30.65, 0.0025, 31.73, 0.0011, 32.83, 0.0010, 34.98,
+ 0.0003, 36.07, 0.0009, 37.23, 0.0001, 38.26, 0.0020, 39.41, 0.0014,
+ 40.53, 0.0005, 41.40, 0.0003, 42.80, 0.0002, 43.48, 0.0028, 43.93,
+ 0.0001, 45.03, 0.0003, 46.18, 0.0007, 47.41, 0.0001, 48.57, 0.0002,
+ 49.67, 0.0001, 50.83, 0.0002, 54.39, 0.0001, 55.58, 0.0002, 57.97,
+ 0.0005, 58.11, 0.0002, 59.21, 0.0001, 60.42, 0.0002, 61.66, 0.0001],
+ [1.00, 0.0503, 2.00, 0.0963, 2.99, 0.1304, 3.99, 0.0218, 4.98, 0.0041,
+ 5.98, 0.0292, 6.98, 0.0482, 7.99, 0.0005, 8.99, 0.0280, 10.00, 0.0237,
+ 11.00, 0.0152, 12.02, 0.0036, 12.95, 0.0022, 14.06, 0.0111, 15.07,
+ 0.0196, 16.08, 0.0016, 17.11, 0.0044, 18.13, 0.0073, 19.17, 0.0055,
+ 20.19, 0.0028, 21.20, 0.0012, 22.27, 0.0068, 23.30, 0.0036, 24.35,
+ 0.0012, 25.35, 0.0002, 26.46, 0.0005, 27.47, 0.0005, 28.59, 0.0009,
+ 29.65, 0.0021, 30.70, 0.0020, 31.78, 0.0012, 32.89, 0.0010, 35.06,
+ 0.0005, 36.16, 0.0008, 37.27, 0.0010, 38.36, 0.0010, 39.47, 0.0014,
+ 40.58, 0.0004, 41.43, 0.0007, 41.82, 0.0003, 43.48, 0.0008, 44.53,
+ 0.0001, 45.25, 0.0003, 46.43, 0.0002, 47.46, 0.0002, 48.76, 0.0005,
+ 49.95, 0.0004, 50.96, 0.0002, 51.12, 0.0002, 52.33, 0.0001, 54.75,
+ 0.0001, 55.75, 0.0002, 56.90, 0.0002, 58.17, 0.0002, 59.40, 0.0004,
+ 60.62, 0.0002, 65.65, 0.0001, 66.91, 0.0002, 69.91, 0.0001, 71.25,
+ 0.0002],
+ [1.00, 0.1243, 1.98, 0.1611, 3.00, 0.0698, 3.98, 0.0390, 5.00, 0.0138,
+ 5.99, 0.0154, 7.01, 0.0287, 8.01, 0.0014, 9.01, 0.0049, 10.00, 0.0144,
+ 11.01, 0.0055, 12.05, 0.0052, 13.01, 0.0011, 14.05, 0.0118, 15.07,
+ 0.0154, 16.12, 0.0028, 17.14, 0.0061, 18.25, 0.0007, 19.22, 0.0020,
+ 20.24, 0.0011, 21.27, 0.0029, 22.30, 0.0046, 23.34, 0.0049, 24.35,
+ 0.0004, 25.45, 0.0003, 26.47, 0.0007, 27.59, 0.0008, 28.16, 0.0009,
+ 29.12, 0.0002, 29.81, 0.0006, 30.81, 0.0009, 31.95, 0.0004, 33.00,
+ 0.0011, 34.12, 0.0005, 35.18, 0.0003, 36.30, 0.0008, 37.38, 0.0003,
+ 38.55, 0.0003, 39.64, 0.0006, 40.77, 0.0007, 41.52, 0.0006, 41.89,
+ 0.0006, 43.04, 0.0011, 43.60, 0.0009, 44.31, 0.0002, 45.68, 0.0002,
+ 46.56, 0.0003, 47.60, 0.0001, 48.83, 0.0006, 50.01, 0.0003, 51.27,
+ 0.0003, 56.04, 0.0005, 57.21, 0.0003, 58.56, 0.0004, 59.83, 0.0003,
+ 61.05, 0.0001, 62.20, 0.0001, 67.37, 0.0002, 76.53, 0.0001],
+ [0.99, 0.0222, 1.99, 0.0678, 2.99, 0.0683, 4.00, 0.0191, 5.00, 0.0119,
+ 6.01, 0.0232, 6.98, 0.0336, 7.99, 0.0082, 9.01, 0.0201, 10.01, 0.0189,
+ 11.01, 0.0041, 12.01, 0.0053, 13.05, 0.0154, 14.04, 0.0159, 15.06,
+ 0.0092, 16.11, 0.0038, 17.12, 0.0014, 18.15, 0.0091, 19.16, 0.0006,
+ 20.30, 0.0012, 21.25, 0.0061, 22.28, 0.0099, 23.34, 0.0028, 24.38,
+ 0.0012, 25.43, 0.0016, 26.49, 0.0048, 27.55, 0.0025, 28.62, 0.0015,
+ 29.71, 0.0032, 30.78, 0.0077, 31.88, 0.0011, 32.97, 0.0007, 34.08,
+ 0.0006, 35.16, 0.0008, 36.28, 0.0004, 37.41, 0.0006, 38.54, 0.0005,
+ 39.62, 0.0002, 40.80, 0.0003, 41.93, 0.0001, 43.06, 0.0002, 44.21,
+ 0.0003, 45.38, 0.0002, 46.54, 0.0007, 47.78, 0.0003, 48.95, 0.0004,
+ 50.10, 0.0003, 51.37, 0.0002, 53.79, 0.0003, 56.20, 0.0001, 58.71,
+ 0.0002, 66.47, 0.0003],
+ [1.01, 0.0241, 1.99, 0.1011, 2.98, 0.0938, 3.98, 0.0081, 4.99, 0.0062,
+ 5.99, 0.0291, 6.99, 0.0676, 7.59, 0.0004, 8.98, 0.0127, 9.99, 0.0112,
+ 10.99, 0.0142, 12.00, 0.0029, 13.02, 0.0071, 14.02, 0.0184, 15.03,
+ 0.0064, 16.07, 0.0010, 17.09, 0.0011, 18.11, 0.0010, 19.15, 0.0060,
+ 20.19, 0.0019, 21.24, 0.0025, 22.29, 0.0013, 23.31, 0.0050, 25.41,
+ 0.0030, 26.50, 0.0018, 27.53, 0.0006, 28.63, 0.0012, 29.66, 0.0013,
+ 30.77, 0.0020, 31.84, 0.0006, 34.04, 0.0001, 35.14, 0.0001, 36.32,
+ 0.0004, 37.41, 0.0007, 38.53, 0.0007, 39.67, 0.0009, 40.85, 0.0003,
+ 45.49, 0.0002, 46.65, 0.0001, 47.81, 0.0004, 49.01, 0.0002, 53.91,
+ 0.0002, 55.14, 0.0002, 57.69, 0.0002],
+ [1.00, 0.0326, 2.00, 0.1066, 2.99, 0.1015, 4.00, 0.0210, 4.97, 0.0170,
+ 5.99, 0.0813, 6.98, 0.0820, 7.96, 0.0011, 8.99, 0.0248, 10.03, 0.0107,
+ 11.01, 0.0126, 12.01, 0.0027, 13.01, 0.0233, 14.04, 0.0151, 15.05,
+ 0.0071, 16.04, 0.0002, 17.10, 0.0061, 18.12, 0.0059, 19.15, 0.0087,
+ 20.23, 0.0005, 21.25, 0.0040, 22.30, 0.0032, 23.35, 0.0004, 24.40,
+ 0.0001, 25.45, 0.0030, 26.54, 0.0022, 27.60, 0.0003, 28.70, 0.0009,
+ 29.80, 0.0029, 30.85, 0.0006, 31.97, 0.0006, 34.19, 0.0004, 35.30,
+ 0.0003, 36.43, 0.0007, 37.56, 0.0005, 38.68, 0.0019, 39.88, 0.0013,
+ 41.00, 0.0003, 43.35, 0.0003, 44.51, 0.0002, 45.68, 0.0006, 46.93,
+ 0.0010, 48.11, 0.0006, 49.29, 0.0003, 55.58, 0.0002],
+ [0.98, 0.0113, 1.99, 0.0967, 3.00, 0.0719, 3.98, 0.0345, 4.98, 0.0121,
+ 6.00, 0.0621, 7.00, 0.0137, 7.98, 0.0006, 9.01, 0.0314, 10.01, 0.0171,
+ 11.02, 0.0060, 12.03, 0.0024, 13.05, 0.0077, 14.07, 0.0040, 15.12,
+ 0.0032, 16.13, 0.0004, 17.15, 0.0011, 18.20, 0.0028, 19.18, 0.0003,
+ 20.26, 0.0003, 21.31, 0.0025, 22.35, 0.0021, 23.39, 0.0005, 25.55,
+ 0.0002, 26.62, 0.0014, 27.70, 0.0003, 28.78, 0.0005, 29.90, 0.0030,
+ 31.01, 0.0011, 32.12, 0.0005, 34.31, 0.0001, 35.50, 0.0002, 36.62,
+ 0.0002, 37.76, 0.0005, 38.85, 0.0002, 40.09, 0.0004, 43.60, 0.0001,
+ 44.73, 0.0002, 46.02, 0.0002, 47.25, 0.0004, 48.44, 0.0004],
+ [0.99, 0.0156, 1.98, 0.0846, 2.98, 0.0178, 3.98, 0.0367, 4.98, 0.0448,
+ 5.98, 0.0113, 6.99, 0.0189, 8.00, 0.0011, 9.01, 0.0247, 10.02, 0.0089,
+ 11.01, 0.0184, 12.03, 0.0105, 13.00, 0.0039, 14.07, 0.0116, 15.09,
+ 0.0078, 16.13, 0.0008, 17.14, 0.0064, 18.19, 0.0029, 19.22, 0.0028,
+ 20.25, 0.0017, 21.32, 0.0043, 22.37, 0.0055, 23.42, 0.0034, 24.48,
+ 0.0004, 25.54, 0.0002, 26.61, 0.0017, 27.70, 0.0011, 28.80, 0.0002,
+ 29.89, 0.0019, 30.97, 0.0028, 32.09, 0.0007, 34.30, 0.0002, 35.44,
+ 0.0003, 36.55, 0.0001, 37.69, 0.0004, 38.93, 0.0002, 40.05, 0.0005,
+ 41.20, 0.0005, 42.37, 0.0002, 43.54, 0.0003, 44.73, 0.0001, 45.95,
+ 0.0002, 47.16, 0.0001, 48.43, 0.0005, 49.65, 0.0004, 55.90, 0.0002,
+ 59.81, 0.0004],
+ [1.01, 0.0280, 2.00, 0.0708, 2.99, 0.0182, 3.99, 0.0248, 4.98, 0.0245,
+ 5.98, 0.0279, 6.98, 0.0437, 7.99, 0.0065, 8.99, 0.0299, 10.00, 0.0073,
+ 10.99, 0.0011, 12.03, 0.0122, 13.03, 0.0028, 14.08, 0.0044, 15.11,
+ 0.0097, 16.15, 0.0010, 17.17, 0.0025, 18.19, 0.0017, 19.24, 0.0008,
+ 20.28, 0.0040, 21.32, 0.0024, 22.38, 0.0008, 23.46, 0.0032, 24.52,
+ 0.0010, 25.59, 0.0008, 26.68, 0.0009, 27.76, 0.0012, 28.88, 0.0003,
+ 29.95, 0.0005, 31.05, 0.0017, 32.14, 0.0002, 33.29, 0.0003, 37.88,
+ 0.0002, 39.03, 0.0002, 40.19, 0.0004, 41.37, 0.0003, 43.74, 0.0002,
+ 46.20, 0.0001, 48.68, 0.0001, 49.93, 0.0001, 51.19, 0.0002],
+ [1.00, 0.0225, 1.99, 0.0921, 2.98, 0.0933, 3.99, 0.0365, 4.99, 0.0100,
+ 5.98, 0.0213, 6.98, 0.0049, 7.98, 0.0041, 8.98, 0.0090, 9.99, 0.0068,
+ 11.01, 0.0040, 12.03, 0.0086, 13.02, 0.0015, 14.04, 0.0071, 15.09,
+ 0.0082, 16.14, 0.0011, 17.15, 0.0014, 18.18, 0.0010, 19.26, 0.0013,
+ 20.26, 0.0005, 21.33, 0.0006, 22.36, 0.0011, 23.46, 0.0016, 24.52,
+ 0.0004, 25.59, 0.0002, 26.70, 0.0006, 27.78, 0.0007, 28.87, 0.0002,
+ 30.03, 0.0008, 31.14, 0.0010, 32.24, 0.0006, 33.37, 0.0002, 35.67,
+ 0.0003, 37.99, 0.0004, 39.17, 0.0004, 40.35, 0.0005, 41.53, 0.0001,
+ 46.42, 0.0001],
+ [1.00, 0.0465, 1.99, 0.0976, 2.98, 0.0678, 4.00, 0.0727, 4.99, 0.0305,
+ 5.98, 0.0210, 6.98, 0.0227, 8.00, 0.0085, 9.01, 0.0183, 10.02, 0.0258,
+ 11.05, 0.0003, 12.06, 0.0061, 13.05, 0.0021, 14.10, 0.0089, 15.12,
+ 0.0077, 16.16, 0.0016, 17.21, 0.0061, 18.23, 0.0011, 19.29, 0.0031,
+ 20.36, 0.0031, 21.41, 0.0007, 22.48, 0.0013, 23.55, 0.0020, 24.64,
+ 0.0004, 25.74, 0.0005, 26.81, 0.0006, 27.95, 0.0006, 29.03, 0.0001,
+ 30.22, 0.0010, 31.30, 0.0004, 32.48, 0.0001, 33.60, 0.0002, 38.30,
+ 0.0003],
+ [1.00, 0.0674, 1.99, 0.0841, 2.98, 0.0920, 3.99, 0.0328, 4.99, 0.0368,
+ 5.98, 0.0206, 6.99, 0.0246, 8.01, 0.0048, 9.01, 0.0218, 10.03, 0.0155,
+ 11.05, 0.0048, 12.06, 0.0077, 13.00, 0.0020, 14.10, 0.0083, 15.15,
+ 0.0084, 16.18, 0.0015, 17.22, 0.0039, 18.27, 0.0032, 19.34, 0.0026,
+ 20.40, 0.0012, 21.47, 0.0009, 22.54, 0.0008, 23.62, 0.0016, 24.71,
+ 0.0005, 25.82, 0.0004, 26.91, 0.0002, 28.03, 0.0008, 29.17, 0.0002,
+ 30.32, 0.0028, 31.45, 0.0004, 32.61, 0.0005, 33.77, 0.0001, 36.14,
+ 0.0003, 37.32, 0.0002, 38.54, 0.0005, 39.75, 0.0002, 42.23, 0.0002,
+ 48.65, 0.0001],
+ [1.01, 0.0423, 1.99, 0.0240, 2.98, 0.0517, 4.00, 0.0493, 5.00, 0.0324,
+ 6.00, 0.0094, 6.99, 0.0449, 7.99, 0.0050, 9.00, 0.0197, 10.03, 0.0132,
+ 11.03, 0.0009, 12.07, 0.0017, 13.08, 0.0023, 14.12, 0.0094, 15.16,
+ 0.0071, 16.21, 0.0020, 17.25, 0.0005, 18.30, 0.0027, 19.04, 0.0004,
+ 20.43, 0.0022, 21.51, 0.0002, 22.59, 0.0006, 23.72, 0.0018, 24.80,
+ 0.0002, 25.88, 0.0002, 27.03, 0.0002, 28.09, 0.0006, 29.31, 0.0002,
+ 30.46, 0.0004, 31.61, 0.0007, 32.78, 0.0005, 33.95, 0.0001, 36.34,
+ 0.0002, 37.56, 0.0001, 38.80, 0.0001, 40.02, 0.0001, 44.14, 0.0001],
+ [1.00, 0.0669, 1.99, 0.0909, 2.99, 0.0410, 3.98, 0.0292, 4.98, 0.0259,
+ 5.98, 0.0148, 6.98, 0.0319, 7.99, 0.0076, 9.01, 0.0056, 10.02, 0.0206,
+ 11.04, 0.0032, 12.05, 0.0085, 13.08, 0.0040, 14.12, 0.0037, 15.16,
+ 0.0030, 16.20, 0.0013, 17.24, 0.0021, 18.30, 0.0010, 19.36, 0.0015,
+ 20.44, 0.0013, 21.50, 0.0009, 22.60, 0.0015, 23.69, 0.0014, 24.80,
+ 0.0006, 25.87, 0.0002, 27.02, 0.0006, 28.12, 0.0002, 29.28, 0.0003,
+ 30.43, 0.0002, 31.59, 0.0007, 32.79, 0.0001, 35.14, 0.0001, 37.57,
+ 0.0001, 40.03, 0.0002, 41.28, 0.0004, 44.10, 0.0001],
+ [0.99, 0.0421, 1.99, 0.1541, 2.98, 0.0596, 3.98, 0.0309, 4.98, 0.0301,
+ 5.99, 0.0103, 7.00, 0.0240, 8.01, 0.0073, 9.01, 0.0222, 10.04, 0.0140,
+ 11.05, 0.0033, 12.08, 0.0045, 13.13, 0.0009, 14.13, 0.0015, 15.21,
+ 0.0026, 16.24, 0.0003, 17.30, 0.0004, 18.35, 0.0010, 19.39, 0.0003,
+ 20.50, 0.0015, 21.57, 0.0003, 22.68, 0.0011, 23.80, 0.0005, 24.90,
+ 0.0008, 26.02, 0.0002, 27.16, 0.0001, 28.30, 0.0006, 29.48, 0.0002,
+ 31.81, 0.0005, 33.00, 0.0003, 34.21, 0.0001, 37.89, 0.0001],
+ [0.99, 0.0389, 2.00, 0.2095, 3.00, 0.0835, 3.99, 0.0289, 5.00, 0.0578,
+ 5.99, 0.0363, 7.01, 0.0387, 8.01, 0.0056, 9.04, 0.0173, 10.05, 0.0175,
+ 11.08, 0.0053, 12.10, 0.0056, 13.15, 0.0064, 14.19, 0.0036, 15.22,
+ 0.0019, 16.29, 0.0010, 17.36, 0.0017, 18.43, 0.0018, 19.51, 0.0004,
+ 20.60, 0.0011, 21.70, 0.0003, 22.82, 0.0003, 23.95, 0.0001, 25.05,
+ 0.0004, 26.17, 0.0001, 28.50, 0.0003, 29.68, 0.0001, 32.07, 0.0003,
+ 33.28, 0.0004, 34.52, 0.0001],
+ [1.00, 0.1238, 1.99, 0.2270, 3.00, 0.0102, 3.99, 0.0181, 4.98, 0.0415,
+ 6.00, 0.0165, 7.01, 0.0314, 8.02, 0.0148, 9.04, 0.0203, 10.05, 0.0088,
+ 11.07, 0.0062, 12.11, 0.0070, 13.14, 0.0054, 14.19, 0.0028, 15.24,
+ 0.0044, 16.30, 0.0029, 17.38, 0.0009, 18.45, 0.0026, 19.56, 0.0003,
+ 20.65, 0.0025, 21.74, 0.0014, 22.87, 0.0013, 23.99, 0.0007, 25.15,
+ 0.0002, 27.46, 0.0004, 28.39, 0.0006, 28.65, 0.0004, 29.85, 0.0001,
+ 31.05, 0.0002, 32.27, 0.0003, 33.52, 0.0002, 34.76, 0.0003],
+ [1.00, 0.1054, 2.00, 0.2598, 2.99, 0.0369, 3.98, 0.0523, 4.99, 0.0020,
+ 5.99, 0.0051, 7.00, 0.0268, 8.01, 0.0027, 9.04, 0.0029, 10.05, 0.0081,
+ 11.08, 0.0047, 12.12, 0.0051, 13.16, 0.0091, 14.19, 0.0015, 15.27,
+ 0.0030, 16.34, 0.0017, 17.42, 0.0006, 18.51, 0.0003, 19.61, 0.0007,
+ 20.72, 0.0003, 21.84, 0.0001, 22.99, 0.0010, 24.13, 0.0001, 28.44,
+ 0.0001, 30.09, 0.0001],
+ [0.99, 0.0919, 2.00, 0.0418, 2.99, 0.0498, 3.99, 0.0135, 4.99, 0.0026,
+ 6.00, 0.0155, 7.01, 0.0340, 8.02, 0.0033, 9.04, 0.0218, 10.08, 0.0084,
+ 11.11, 0.0057, 12.15, 0.0051, 13.21, 0.0043, 14.25, 0.0015, 15.31,
+ 0.0023, 16.40, 0.0008, 17.48, 0.0004, 18.59, 0.0016, 19.71, 0.0010,
+ 20.84, 0.0018, 21.98, 0.0002, 23.11, 0.0013, 24.26, 0.0003, 26.67,
+ 0.0002, 29.12, 0.0002, 30.37, 0.0002, 31.62, 0.0003, 32.92, 0.0001],
+ [0.99, 0.1174, 1.99, 0.1126, 2.99, 0.0370, 3.99, 0.0159, 5.01, 0.0472,
+ 6.01, 0.0091, 7.03, 0.0211, 8.05, 0.0015, 9.07, 0.0098, 10.11, 0.0038,
+ 11.15, 0.0042, 12.20, 0.0018, 13.24, 0.0041, 14.32, 0.0033, 15.41,
+ 0.0052, 16.49, 0.0001, 17.61, 0.0004, 18.71, 0.0004, 19.84, 0.0004,
+ 20.99, 0.0002, 22.14, 0.0006, 23.31, 0.0006, 24.50, 0.0004, 25.70,
+ 0.0002, 28.09, 0.0002, 28.66, 0.0002, 32.00, 0.0001],
+ [1.00, 0.1085, 2.00, 0.1400, 2.99, 0.0173, 3.99, 0.0229, 5.00, 0.0272,
+ 6.02, 0.0077, 7.03, 0.0069, 8.04, 0.0017, 9.08, 0.0045, 10.10, 0.0030,
+ 11.15, 0.0040, 12.20, 0.0007, 13.25, 0.0019, 14.32, 0.0008, 15.42,
+ 0.0024, 16.50, 0.0002, 17.59, 0.0005, 18.71, 0.0003, 19.83, 0.0002,
+ 20.98, 0.0005, 23.29, 0.0008],
+ [1.00, 0.0985, 2.00, 0.1440, 2.99, 0.0364, 3.99, 0.0425, 5.00, 0.0190,
+ 6.01, 0.0089, 7.03, 0.0278, 8.04, 0.0006, 9.07, 0.0083, 10.10, 0.0021,
+ 11.14, 0.0050, 12.18, 0.0005, 13.26, 0.0036, 14.33, 0.0005, 15.41,
+ 0.0026, 17.62, 0.0004, 18.75, 0.0004, 19.89, 0.0003, 21.04, 0.0012,
+ 22.21, 0.0002, 23.38, 0.0004, 27.04, 0.0001],
+ [0.99, 0.1273, 2.00, 0.1311, 2.99, 0.0120, 4.00, 0.0099, 5.00, 0.0235,
+ 6.02, 0.0068, 7.03, 0.0162, 8.06, 0.0009, 9.08, 0.0083, 10.12, 0.0014,
+ 11.17, 0.0050, 12.24, 0.0010, 13.29, 0.0013, 14.39, 0.0022, 15.48,
+ 0.0011, 16.59, 0.0002, 17.70, 0.0003, 18.84, 0.0010, 20.00, 0.0003,
+ 21.17, 0.0003, 23.56, 0.0004, 28.79, 0.0003],
+ [1.00, 0.1018, 2.00, 0.1486, 3.00, 0.0165, 4.00, 0.0186, 5.01, 0.0194,
+ 6.02, 0.0045, 7.04, 0.0083, 8.06, 0.0012, 9.10, 0.0066, 10.15, 0.0009,
+ 11.19, 0.0008, 12.26, 0.0011, 13.34, 0.0028, 14.45, 0.0006, 15.53,
+ 0.0009, 16.66, 0.0002, 17.79, 0.0006, 18.94, 0.0005, 20.11, 0.0003,
+ 21.29, 0.0005, 22.49, 0.0003, 23.73, 0.0005, 26.22, 0.0001, 27.52,
+ 0.0001, 28.88, 0.0002],
+ [1.00, 0.1889, 1.99, 0.1822, 3.00, 0.0363, 4.00, 0.0047, 5.01, 0.0202,
+ 6.03, 0.0053, 7.05, 0.0114, 8.01, 0.0002, 9.13, 0.0048, 10.17, 0.0010,
+ 11.23, 0.0033, 12.30, 0.0010, 13.38, 0.0006, 14.50, 0.0002, 15.62,
+ 0.0010, 20.27, 0.0001, 21.47, 0.0001],
+ [1.00, 0.0522, 1.99, 0.0763, 2.99, 0.0404, 4.00, 0.0139, 5.01, 0.0185,
+ 6.01, 0.0021, 7.06, 0.0045, 8.09, 0.0002, 9.11, 0.0003, 10.17, 0.0006,
+ 11.25, 0.0004, 12.32, 0.0005, 13.40, 0.0003, 14.53, 0.0003, 15.65,
+ 0.0007, 16.80, 0.0001, 17.95, 0.0002, 19.14, 0.0006, 20.34, 0.0002,
+ 21.56, 0.0003],
+ [0.99, 0.1821, 1.99, 0.0773, 3.00, 0.0125, 4.01, 0.0065, 5.01, 0.0202,
+ 6.03, 0.0071, 7.05, 0.0090, 8.08, 0.0006, 9.13, 0.0008, 10.18, 0.0013,
+ 11.25, 0.0010, 12.33, 0.0012, 13.42, 0.0006, 14.54, 0.0005, 15.65,
+ 0.0004, 17.97, 0.0002, 19.15, 0.0001],
+ [1.00, 0.1868, 2.00, 0.0951, 3.00, 0.0147, 4.01, 0.0134, 5.02, 0.0184,
+ 6.04, 0.0132, 7.06, 0.0011, 8.11, 0.0008, 9.15, 0.0010, 10.22, 0.0012,
+ 11.30, 0.0011, 12.40, 0.0003, 13.11, 0.0004, 13.49, 0.0002, 14.62,
+ 0.0003, 15.77, 0.0001],
+ [1.00, 0.1933, 2.00, 0.0714, 3.00, 0.0373, 4.00, 0.0108, 5.02, 0.0094,
+ 6.02, 0.0010, 7.07, 0.0022, 8.11, 0.0002, 9.16, 0.0065, 10.23, 0.0015,
+ 11.31, 0.0023, 12.40, 0.0003, 13.53, 0.0014, 14.66, 0.0002, 15.81,
+ 0.0011, 18.20, 0.0002, 19.41, 0.0001],
+ [0.99, 0.2113, 1.99, 0.0877, 3.00, 0.0492, 4.01, 0.0094, 5.02, 0.0144,
+ 6.04, 0.0103, 7.07, 0.0117, 8.12, 0.0006, 9.19, 0.0019, 10.25, 0.0007,
+ 11.35, 0.0017, 12.45, 0.0010, 13.58, 0.0003, 14.74, 0.0003, 15.91,
+ 0.0003, 19.57, 0.0002],
+ [0.99, 0.2455, 1.99, 0.0161, 3.00, 0.0215, 4.01, 0.0036, 5.03, 0.0049,
+ 6.04, 0.0012, 7.09, 0.0036, 8.14, 0.0011, 9.21, 0.0009, 10.30, 0.0001,
+ 11.40, 0.0012, 12.50, 0.0001, 13.66, 0.0005, 14.84, 0.0001],
+ [1.00, 0.1132, 2.00, 0.0252, 3.00, 0.0292, 4.01, 0.0136, 5.03, 0.0045,
+ 6.06, 0.0022, 7.11, 0.0101, 8.17, 0.0004, 9.23, 0.0010, 10.33, 0.0012,
+ 11.44, 0.0013, 12.58, 0.0011, 13.75, 0.0002, 14.93, 0.0005, 16.14, 0.0002],
+ [1.00, 0.1655, 2.00, 0.0445, 3.00, 0.0120, 4.00, 0.0038, 5.02, 0.0015,
+ 6.07, 0.0038, 7.11, 0.0003, 8.19, 0.0002, 9.25, 0.0010, 10.36, 0.0011,
+ 11.48, 0.0005, 12.63, 0.0002, 13.79, 0.0003, 16.24, 0.0002],
+ [0.99, 0.3637, 1.99, 0.0259, 3.01, 0.0038, 4.01, 0.0057, 5.03, 0.0040,
+ 6.07, 0.0067, 7.12, 0.0014, 8.19, 0.0004, 9.27, 0.0003, 10.38, 0.0002,
+ 12.67, 0.0001],
+ [1.00, 0.1193, 2.00, 0.0230, 3.00, 0.0104, 4.01, 0.0084, 5.04, 0.0047,
+ 6.08, 0.0035, 7.13, 0.0041, 8.20, 0.0002, 9.29, 0.0005, 10.40, 0.0005,
+ 11.53, 0.0003, 12.70, 0.0002, 13.91, 0.0002],
+ [1.00, 0.0752, 2.00, 0.0497, 3.00, 0.0074, 4.02, 0.0076, 5.05, 0.0053,
+ 6.09, 0.0043, 7.15, 0.0024, 8.22, 0.0001, 9.32, 0.0006, 10.45, 0.0002,
+ 11.58, 0.0001, 12.78, 0.0001, 15.22, 0.0001],
+ [1.00, 0.2388, 2.00, 0.0629, 3.01, 0.0159, 4.04, 0.0063, 5.07, 0.0051,
+ 6.12, 0.0045, 7.19, 0.0026, 8.29, 0.0015, 9.43, 0.0001, 11.75, 0.0002],
+ [1.00, 0.1919, 2.01, 0.0116, 3.01, 0.0031, 4.03, 0.0090, 5.07, 0.0061,
+ 6.13, 0.0036, 7.19, 0.0013, 8.30, 0.0016, 9.13, 0.0001, 10.59, 0.0002,
+ 11.78, 0.0002],
+ [1.00, 0.1296, 2.00, 0.0135, 3.01, 0.0041, 4.04, 0.0045, 5.09, 0.0028,
+ 6.14, 0.0046, 7.23, 0.0007, 8.32, 0.0007, 9.50, 0.0001],
+ [1.00, 0.0692, 2.00, 0.0209, 3.02, 0.0025, 4.05, 0.0030, 5.09, 0.0047,
+ 6.17, 0.0022, 7.25, 0.0015, 8.36, 0.0015, 9.53, 0.0010, 10.69, 0.0001,
+ 13.40, 0.0001],
+ [1.00, 0.1715, 2.00, 0.0142, 3.01, 0.0024, 4.03, 0.0015, 5.07, 0.0017,
+ 6.13, 0.0018, 7.22, 0.0009, 8.33, 0.0014, 9.51, 0.0007, 10.69, 0.0002],
+ [1.00, 0.1555, 2.01, 0.0148, 3.02, 0.0007, 4.06, 0.0006, 5.10, 0.0005,
+ 6.16, 0.0008, 7.26, 0.0009, 8.39, 0.0008, 9.58, 0.0002],
+ [1.00, 0.1357, 2.00, 0.0116, 3.02, 0.0026, 4.04, 0.0009, 5.09, 0.0004,
+ 6.17, 0.0005, 7.27, 0.0002, 8.40, 0.0001],
+ [1.00, 0.2185, 2.01, 0.0087, 3.03, 0.0018, 4.06, 0.0025, 5.11, 0.0020,
+ 6.20, 0.0012, 7.32, 0.0005, 8.46, 0.0001, 9.66, 0.0003],
+ [1.00, 0.2735, 2.00, 0.0038, 3.02, 0.0008, 4.06, 0.0012, 5.12, 0.0008,
+ 6.22, 0.0011, 7.35, 0.0003, 8.50, 0.0002],
+ [1.00, 0.1441, 1.99, 0.0062, 3.01, 0.0023, 4.05, 0.0011, 5.11, 0.0012,
+ 6.20, 0.0003, 7.33, 0.0004, 8.50, 0.0001],
+ [1.00, 0.0726, 2.01, 0.0293, 3.03, 0.0022, 5.14, 0.0005, 6.26, 0.0011,
+ 7.41, 0.0002, 8.63, 0.0002],
[1.00, 0.0516, 2.00, 0.0104, 3.02, 0.0029, 5.15, 0.0002, 6.27, 0.0001],
-
- [1.00, 0.0329, 2.00, 0.0033, 3.03, 0.0013, 4.10, 0.0005, 5.19, 0.0004, 6.32, 0.0002],
-
- [1.00, 0.0179, 1.99, 0.0012, 3.04, 0.0005, 4.10, 0.0017, 5.20, 0.0005, 6.35, 0.0001],
-
+ [1.00, 0.0329, 2.00, 0.0033, 3.03, 0.0013, 4.10, 0.0005, 5.19,
+ 0.0004, 6.32, 0.0002],
+ [1.00, 0.0179, 1.99, 0.0012, 3.04, 0.0005, 4.10, 0.0017, 5.20, 0.0005,
+ 6.35, 0.0001],
[1.00, 0.0334, 2.01, 0.0033, 3.04, 0.0011, 4.13, 0.0003, 5.22, 0.0003],
-
[0.99, 0.0161, 2.01, 0.0100, 3.04, 0.0020, 4.13, 0.0003],
-
[1.00, 0.0475, 1.99, 0.0045, 3.03, 0.0035, 4.12, 0.0011],
-
[1.00, 0.0593, 2.00, 0.0014, 4.17, 0.0002],
-
[1.00, 0.0249, 2.01, 0.0016],
-
[1.00, 0.0242, 2.00, 0.0038, 4.19, 0.0002],
-
[1.00, 0.0170, 2.02, 0.0030],
-
[1.00, 0.0381, 2.00, 0.0017, 3.09, 0.0002],
-
[1.00, 0.0141, 2.03, 0.0005, 3.11, 0.0003, 4.26, 0.0001],
-
[1.00, 0.0122, 2.03, 0.0024],
-
[1.00, 0.0107, 2.07, 0.0007, 3.12, 0.0004],
-
[1.00, 0.0250, 2.02, 0.0026, 3.15, 0.0002],
-
[1.01, 0.0092],
-
[1.01, 0.0102, 2.09, 0.0005],
-
[1.00, 0.0080, 2.00, 0.0005, 3.19, 0.0001],
-
[1.01, 0.0298, 2.01, 0.0005]]
def lbj_piano(start, dur, freq, amp, *args)
@@ -1685,7 +2086,9 @@ def lbj_piano(start, dur, freq, amp, *args)
[:degree, 45.0],
[:distance, 1.0],
[:reverb_amount, 0.0])
- get_piano_partials = lambda do |frq| Piano_Spectra[(12 * (log(frq / 32.703) / log(2))).round] end
+ get_piano_partials = lambda do |frq|
+ Piano_Spectra[(12 * (log(frq / 32.703) / log(2))).round]
+ end
make_piano_ampfun = lambda do |dr|
release_amp = db2linear($clm_db_drop_per_second * dr)
attack_time = $clm_piano_attack_duration * 100.0 / dr
@@ -1714,7 +2117,8 @@ def lbj_piano(start, dur, freq, amp, *args)
oscils = Array.new(siz)
alist = make_vct(siz)
ampfun1 = make_piano_ampfun.call(env1dur)
- ampenv1 = make_env(:envelope, ampfun1, :scaler, amp, :duration, env1dur, :base, 10000.0)
+ ampenv1 = make_env(:envelope, ampfun1, :scaler, amp,
+ :duration, env1dur, :base, 10000.0)
releaseamp = ampfun1.last
ampenv2 = make_env(:envelope, [0, 1, 100, 0], :scaler, amp * releaseamp,
:duration, env1dur, :base, 1.0)
@@ -1737,7 +2141,11 @@ def lbj_piano(start, dur, freq, amp, *args)
end
end
end
-# with_sound() do lbj_piano(0, 1, 440.0, 0.2) end
+
+def lbj_piano_test(start = 0.0, dur = 1.0)
+ lbj_piano(start, dur, 440.0, 0.5)
+ $now = start + dur + 0.24 + 0.2
+end
# RESFLT
def resflt(start, dur, driver,
@@ -1756,7 +2164,8 @@ def resflt(start, dur, driver,
# noifun=amplitude envelope on white noise
# if sum-of-cosines (i.e. a band-limited pulse train),
# cosamp=amplitude of pulse train,
- # cosfreq1=top frequency (given freqcosfun) (i.e. pulse frequency)
+ # cosfreq1=top frequency (given freqcosfun)
+ # (i.e. pulse frequency)
# cosfreq0=bottom frequency,
# cosnum=number of cosines in the pulse,
# ampcosfun=amplitude envelope on pulse train
@@ -1789,23 +2198,44 @@ def resflt(start, dur, driver,
else
make_sum_of_cosines(:frequency, cosfreq0, :cosines, cosnum)
end
- run_instrument(start, dur, :distance, distance, :degree, degree, :reverb_amount, reverb_amount) do
- input1 = env(ampf) * (with_noise ? rand(rn) : sum_of_cosines(cn, env(frqf)))
- two_pole(f1, input1 * g1) + two_pole(f2, input1 * g2) + two_pole(f3, input1 * g3)
+ if with_noise
+ run_instrument(start, dur,
+ :distance, distance,
+ :degree, degree,
+ :reverb_amount, reverb_amount) do
+ input1 = env(ampf) * rand(rn)
+ two_pole(f1, input1 * g1) +
+ two_pole(f2, input1 * g2) +
+ two_pole(f3, input1 * g3)
+ end
+ else
+ run_instrument(start, dur,
+ :distance, distance,
+ :degree, degree,
+ :reverb_amount, reverb_amount) do
+ input1 = env(ampf) * sum_of_cosines(cn, env(frqf))
+ two_pole(f1, input1 * g1) +
+ two_pole(f2, input1 * g2) +
+ two_pole(f3, input1 * g3)
+ end
end
end
-=begin
-with_sound() do
- resflt(0, 1, 0, 0, 0, nil, 0.1, 200, 230, 10, [0, 0, 50, 1, 100, 0], [0, 0, 100, 1],
+
+def resflt_test(start = 0.0, dur = 1.0)
+ $now = start
+ resflt($now, dur, 0, 0, 0, nil,
+ 0.1, 200, 230, 10, [0, 0, 50, 1, 100, 0], [0, 0, 100, 1],
500, 0.995, 0.1, 1000, 0.995, 0.1, 2000, 0.995, 0.1)
- resflt(0.5, 1, 1, 10000, 0.01, [0, 0, 50, 1, 100, 0], 0, 0, 0, 0, nil, nil,
+ $now += dur + 0.2
+ resflt($now, dur, 1, 10000, 0.01, [0, 0, 50, 1, 100, 0],
+ 0, 0, 0, 0, nil, nil,
500, 0.995, 0.1, 1000, 0.995, 0.1, 2000, 0.995, 0.1)
+ $now += dur + 0.2
end
-=end
# SCRATCH
def scratch(start, file, src_ratio, turntable)
- assert_type(File.exists?(file), file, 1, "an existing file")
+ assert_type(File.exist?(file), file, 1, "an existing file")
f = make_file2sample(file)
turn_i = 1
turns = turntable.length
@@ -1849,13 +2279,17 @@ def scratch(start, file, src_ratio, turntable)
end
mus_close(f)
end
-# with_sound() do scratch(0, "now.snd", 1.5, [0.0, 0.5, 0.25, 1.0]) end
+
+def scratch_test(start = 0.0, dur = 1.0)
+ scratch(start, "fyow.snd", [dur, 1.5].min, [0.0, 0.5, 0.25, 1.0])
+ $now = start + mus_sound_duration("fyow.snd") + 0.2
+end
# PINS
#
# spectral modeling (SMS)
def pins(start, dur, file, amp, *args)
- assert_type(File.exists?(file), file, 2, "an existing file")
+ assert_type(File.exist?(file), file, 2, "an existing file")
transposition, time_scaler, fftsize, highest_bin, max_peaks, attack = nil
optkey(args, binding,
[:transposition, 1.0], # this can be used to transpose the sound
@@ -1868,10 +2302,10 @@ def pins(start, dur, file, amp, *args)
# probably best to double these sizes
# -- it takes some searching
# sometimes.
- [:highest_bin, 128], # how high in fft data should we search for peaks
- [:max_peaks, 16], # how many spectral peaks to track at the maximum
- :attack) # whether to use original attack via time domain splice
- # do the sliding fft shuffle,
+ [:highest_bin, 128], # how high in fft data should we search for pks
+ [:max_peaks, 16], # how many spectral peaks to track at the max
+ :attack) # whether to use original attack via time domain
+ # splice do the sliding fft shuffle,
# translate to polar coordinates, find
# spectral peaks, match with current,
# do some interesting transformation,
@@ -1893,7 +2327,9 @@ def pins(start, dur, file, amp, *args)
last_peak_amps = make_vct(max_oscils)
peak_amps = make_vct(max_peaks)
peak_freqs = make_vct(max_peaks)
- resynth_oscils = make_array(max_oscils) do make_oscil(:frequency, 0) end
+ resynth_oscils = make_array(max_oscils) do
+ make_oscil(:frequency, 0)
+ end
# run-time generated amplitude and frequency envelopes
amps = make_vct(max_oscils)
rates = make_vct(max_oscils)
@@ -1904,7 +2340,8 @@ def pins(start, dur, file, amp, *args)
outhop = (time_scaler * hop).floor
ifreq = 1.0 / outhop
ihifreq = hz2radians(ifreq)
- fftscale = 1.0 / (fftsize * 0.42323) # integrate Blackman-Harris window = .42323*window
+ # integrate Blackman-Harris window = .42323*window
+ fftscale = 1.0 / (fftsize * 0.42323)
# width and shift by fftsize
fft_mag = @srate / fftsize
furthest_away_accepted = 0.1
@@ -1916,7 +2353,8 @@ def pins(start, dur, file, amp, *args)
ramp_ind = 0
ramped_attack = make_vct(attack_size)
if (dur / time_scaler) > file_duration
- error("%s is %1.3f seconds long, but we'll need %1.3f seconds of data for this note",
+ error("%s is %1.3f seconds long, \
+but we'll need %1.3f seconds of data for this note",
file, file_duration, dur / time_scaler)
end
trigger = outhop
@@ -1956,7 +2394,8 @@ def pins(start, dur, file, amp, *args)
mus_fft(fdr, fdi, fftsize, 1)
# change to polar coordinates (ignoring phases)
highest_bin.times do |j|
- # no need to paw through the upper half (so (<= highest-bin (floor fft-size 2)))
+ # no need to paw through the upper half
+ # (so (<= highest-bin (floor fft-size 2)))
x = fdr[j]
y = fdi[j]
fftamps[j] = 2.0 * sqrt(x * x + y * y)
@@ -1975,7 +2414,8 @@ def pins(start, dur, file, amp, *args)
highest_bin.times do |j|
la, ca, ra = ca, ra, fftamps[j]
if ca > lowest_magnitude and ca > ra and ca > la
- # found a local maximum above the current threshold (its bin number is j-1)
+ # found a local maximum above the current threshold
+ # (its bin number is j-1)
logla = log10(la)
logca = log10(ca)
logra = log10(ra)
@@ -1983,7 +2423,8 @@ def pins(start, dur, file, amp, *args)
amp_1 = 10.0 ** (logca - (0.25 * (logla - logra) * offset))
freq = fft_mag * (j + offset - 1)
if peaks == max_peaks
- # gotta either flush this peak, or find current lowest and flush him
+ # gotta either flush this peak,
+ # or find current lowest and flush him
minp = 0
minpeak = peak_amps[0]
1.upto(max_peaks - 1) do |k|
@@ -2055,7 +2496,8 @@ def pins(start, dur, file, amp, *args)
peak_amps[j] = 0.0
current_peak_freqs[new_place] = peak_freqs[j]
last_peak_freqs[new_place] = peak_freqs[j]
- set_mus_frequency(resynth_oscils[new_place], transposition * peak_freqs[j])
+ set_mus_frequency(resynth_oscils[new_place],
+ transposition * peak_freqs[j])
end
end
cur_oscils = 0
@@ -2064,7 +2506,8 @@ def pins(start, dur, file, amp, *args)
if current_peak_amps[j].nonzero? or last_peak_amps[j].nonzero?
cur_oscils = j
end
- sweeps[j] = ihifreq * transposition * (current_peak_freqs[j] - last_peak_freqs[j])
+ sweeps[j] = ihifreq * transposition *
+ (current_peak_freqs[j] - last_peak_freqs[j])
end
cur_oscils += 1
end
@@ -2090,21 +2533,33 @@ def pins(start, dur, file, amp, *args)
end
mus_close(fil)
end
-# with_sound() do pins(0, 1, "now.snd", 1, :time_scaler, 2) end
+
+def pins_test(start = 0.0, dur = 1.0)
+ pins(start, dur, "fyow.snd", 1, :time_scaler, 2)
+ $now = start + dur + 0.2
+end
# ZC
def zc(start, dur, freq, amp, length1, length2, feedback)
s = make_pulse_train(:frequency, freq)
- d0 = make_comb(:size, length1, :max_size, [length1, length2].max + 1, :scaler, feedback)
- zenv = make_env(:envelope, [0, 0, 1, 1], :scaler, length2 - length1, :duration, dur)
+ d0 = make_comb(:size, length1,
+ :max_size, [length1, length2].max + 1,
+ :scaler, feedback)
+ zenv = make_env(:envelope, [0, 0, 1, 1],
+ :scaler, length2 - length1,
+ :duration, dur)
run_instrument(start, dur) do
comb(d0, amp * pulse_train(s), env(zenv))
end
end
-# with_sound() do
-# zc(0, 3, 100, 0.1, 20, 100, 0.95)
-# zc(3.5, 3, 100, 0.1, 100, 20, 0.95)
-# end
+
+def zc_test(start = 0.0, dur = 1.0)
+ $now = start
+ zc($now, dur, 100, 0.4, 20, 100, 0.95)
+ $now += dur + 0.2
+ zc($now, dur, 100, 0.4, 100, 20, 0.95)
+ $now += dur + 0.2
+end
# ZN
#
@@ -2113,44 +2568,126 @@ end
# ca 200 Hz so we hear our downward glissando beneath the pulses.
def zn(start, dur, freq, amp, length1, length2, feedforward)
s = make_pulse_train(:frequency, freq)
- d0 = make_notch(:size, length1, :max_size, [length1, length2].max + 1,
+ d0 = make_notch(:size, length1,
+ :max_size, [length1, length2].max + 1,
:scaler, feedforward)
- zenv = make_env(:envelope, [0, 0, 1, 1], :scaler, length2 - length1, :duration, dur)
+ zenv = make_env(:envelope, [0, 0, 1, 1],
+ :scaler, length2 - length1,
+ :duration, dur)
run_instrument(start, dur) do
notch(d0, amp * pulse_train(s), env(zenv))
end
end
-# with_sound() do
-# zn(0, 1, 100, 0.1, 20, 100, 0.995)
-# zn(1.5, 1, 100, 0.1, 100, 20, 0.995)
-# end
+
+def zn_test(start = 0.0, dur = 1.0)
+ $now = start
+ zn($now, dur, 100, 0.5, 20, 100, 0.95)
+ $now += dur + 0.2
+ zn($now, dur, 100, 0.5, 100, 20, 0.95)
+ $now += dur + 0.2
+end
# ZA
def za(start, dur, freq, amp, length1, length2, feedback, feedforward)
s = make_pulse_train(:frequency, freq)
- d0 = make_all_pass(:feedback, feedback, :feedforward, feedforward,
- :size, length1, :max_size, [length1, length2].max + 1)
- zenv = make_env(:envelope, [0, 0, 1, 1], :scaler, length2 - length1, :duration, dur)
+ d0 = make_all_pass(:feedback, feedback,
+ :feedforward, feedforward,
+ :size, length1,
+ :max_size, [length1, length2].max + 1)
+ zenv = make_env(:envelope, [0, 0, 1, 1],
+ :scaler, length2 - length1,
+ :duration, dur)
run_instrument(start, dur) do
all_pass(d0, amp * pulse_train(s), env(zenv))
end
end
-# with_sound() do
-# za(0, 1, 100, 0.1, 20, 100, 0.95, 0.95)
-# za(1.5, 1, 100, 0.1, 100, 20, 0.95, 0.95)
-# end
+
+def za_test(start = 0.0, dur = 1.0)
+ $now = start
+ za($now, dur, 100, 0.3, 20, 100, 0.95, 0.95)
+ $now += dur + 0.2
+ za($now, dur, 100, 0.3, 100, 20, 0.95, 0.95)
+ $now += dur + 0.2
+end
+
+# CLM-EXPSRC
+def clm_expsrc(start, dur, in_file, exp_ratio, src_ratio, amp,
+ rev = false, start_in_file = 0)
+ assert_type(File.exist?(in_file), in_file, 0, "an existing file")
+ stf = (start_in_file * srate(in_file)).floor
+ fda = make_readin(in_file, :channel, 0, :start, stf)
+ exa = make_granulate(lambda do |dir|
+ readin(fda)
+ end, :expansion, exp_ratio)
+ srca = make_src(lambda do |dir|
+ granulate(exa)
+ end, :srate, src_ratio)
+ two_chans = (channels(in_file) == 2) and (channels(@ws_output) == 2)
+ revit = @reverb and rev
+ beg = seconds2samples(start)
+ fin = seconds2samples(dur) + beg
+ # to satisfy with_sound-option :info and :notehook
+ with_sound_info(get_func_name, start, dur)
+ if two_chans
+ fdb = make_readin(in_file, :channel, 1, :srate, stf)
+ exb = make_granulate(lambda do |dir|
+ readin(fdb)
+ end, :expansion, exp_ratio)
+ srcb = make_src(lambda do |dir|
+ granulate(exb)
+ end, :srate, src_ratio)
+ if revit
+ rev_amp = rev * 0.5
+ (beg..fin).each do |i|
+ vala = src(srca) * amp
+ valb = src(srcb) * amp
+ outa(i, vala, @ws_output)
+ outb(i, valb, @ws_output)
+ outa(i, (vala + valb) * rev_amp, @reverb)
+ end
+ else # !revit
+ (beg..fin).each do |i|
+ outa(i, src(srca) * amp, @ws_output)
+ outb(i, src(srcb) * amp, @ws_output)
+ end
+ end # revit
+ else # !two_chans
+ if revit
+ rev_amp = rev
+ (beg..fin).each do |i|
+ vala = src(srca) * amp
+ outa(i, vala, @ws_output)
+ outa(i, vala * rev_amp, @ws_reverb)
+ end
+ else # !revit
+ (beg..fin).each do |i|
+ outa(i, src(srca) * amp, @ws_output)
+ end
+ end # revit
+ end # two_chans
+end
+
+def clm_expsrc_test(start = 0.0, dur = 1.0)
+ clm_expsrc(start, dur, "oboe.snd", 2.0, 1.0, 1.0, 0.05)
+ $now = start + dur + 0.2
+end
# EXP-SND
#
# granulate with envelopes on the expansion amount, segment envelope
# shape, segment length, hop length, and input file resampling rate
def exp_snd(file, start, dur, amp,
- exp_amt = 1.0, ramp = 0.4, seglen = 0.15, sr = 1.0, hop = 0.05, ampenv = nil)
- assert_type(File.exists?(file), file, 0, "an existing file")
+ exp_amt = 1.0, ramp = 0.4, seglen = 0.15,
+ sr = 1.0, hop = 0.05, ampenv = nil)
+ assert_type(File.exist?(file), file, 0, "an existing file")
f0 = make_ws_reader(file, :start, 0)
- expenv = make_env(:envelope, (exp_amt.kind_of?(Array) ? exp_amt : [0, exp_amt, 1, exp_amt]),
+ expenv = make_env(:envelope,
+ (exp_amt.kind_of?(Array) ?
+ exp_amt : [0, exp_amt, 1, exp_amt]),
:duration, dur)
- lenenv = make_env(:envelope, (seglen.kind_of?(Array) ? seglen : [0, seglen, 1, seglen]),
+ lenenv = make_env(:envelope,
+ (seglen.kind_of?(Array) ?
+ seglen : [0, seglen, 1, seglen]),
:duration, dur)
max_seg_len, initial_seg_len = if seglen
if seglen.kind_of?(Array)
@@ -2162,7 +2699,8 @@ def exp_snd(file, start, dur, amp,
[0.15, 0.15]
end
scaler_amp = ((max_seg_len > 0.15) ? ((0.6 * 0.15) / max_seg_len) : 0.6)
- srenv = make_env(:envelope, (sr.kind_of?(Array) ? sr : [0, sr, 1, sr]), :duration, dur)
+ srenv = make_env(:envelope, (sr.kind_of?(Array) ? sr : [0, sr, 1, sr]),
+ :duration, dur)
rampdata = (ramp.kind_of?(Array) ? ramp : [0, ramp, 1, ramp])
rampenv = make_env(:envelope, rampdata, :duration, dur)
initial_ramp_time = if ramp
@@ -2174,7 +2712,8 @@ def exp_snd(file, start, dur, amp,
else
0.4
end
- hopenv = make_env(:envelope, (hop.kind_of?(Array) ? hop : [0, hop, 1, hop]), :duration, dur)
+ hopenv = make_env(:envelope, (hop.kind_of?(Array) ? hop : [0, hop, 1, hop]),
+ :duration, dur)
max_out_hop, initial_out_hop = if hop
if hop.kind_of?(Array)
[max_envelope(hop), hop[1]]
@@ -2195,7 +2734,9 @@ def exp_snd(file, start, dur, amp,
end
max_in_hop = max_out_hop / min_exp_amt.to_f
max_len = (@srate * ([max_out_hop, max_in_hop].max + max_seg_len)).ceil
- ampe = make_env(:envelope, (ampenv or [0, 0, 0.5, 1, 1, 0]), :scaler, amp, :duration, dur)
+ ampe = make_env(:envelope, (ampenv or [0, 0, 0.5, 1, 1, 0]),
+ :scaler, amp,
+ :duration, dur)
ex_a = make_granulate(:input, lambda do |dir| ws_readin(f0) end,
:expansion, initial_exp_amt,
:max_size, max_len,
@@ -2208,7 +2749,8 @@ def exp_snd(file, start, dur, amp,
val_a0 = vol * granulate(ex_a)
val_a1 = vol * granulate(ex_a)
if min_envelope(rampdata) <= 0.0 or max_envelope(rampdata) >= 0.5
- error("ramp argument to expand must always be between 0.0 and 0.5: %1.3f", ramp)
+ error("ramp argument to expand must always be between 0.0 and 0.5: %1.3f",
+ ramp)
else
run_instrument(start, dur) do
expa = env(expenv) # current expansion amount
@@ -2241,12 +2783,16 @@ def exp_snd(file, start, dur, amp,
close_ws_reader(f0)
end
end
-=begin
-with_sound() do
- exp_snd("fyow.snd", 0, 1, 1, [0, 1, 1, 3], 0.4, 0.15, [0, 2, 1, 0.5], 0.05)
- exp_snd("oboe.snd", 1.2, 1, 1, [0, 1, 1, 3], 0.4, 0.15, [0, 2, 1, 0.5], 0.2)
+
+def exp_snd_test(start = 0.0, dur = 1.0)
+ $now = start
+ exp_snd("fyow.snd", $now, dur, 1, [0, 1, 1, 3], 0.4, 0.15,
+ [0, 2, 1, 0.5], 0.05)
+ $now += dur + 0.2
+ exp_snd("oboe.snd", $now, dur, 1, [0, 1, 1, 3], 0.4, 0.15,
+ [0, 2, 1, 0.5], 0.2)
+ $now += dur + 0.2
end
-=end
# EXPFIL
Grn = Struct.new("Grn",
@@ -2254,8 +2800,8 @@ Grn = Struct.new("Grn",
:loc, :segctr, :whichseg, :ramplen, :steadylen, :trigger)
def expfil(start, dur, hopsecs, rampsecs, steadysecs, file1, file2)
- assert_type(File.exists?(file1), file1, 5, "an existing file")
- assert_type(File.exists?(file2), file2, 6, "an existing file")
+ assert_type(File.exist?(file1), file1, 5, "an existing file")
+ assert_type(File.exist?(file2), file2, 6, "an existing file")
fil1 = make_file2sample(file1)
fil2 = make_file2sample(file2)
hop = seconds2samples(hopsecs)
@@ -2345,7 +2891,11 @@ def expfil(start, dur, hopsecs, rampsecs, steadysecs, file1, file2)
val
end
end
-# with_sound() do expfil(0, 2, 0.2, 0.01, 0.1, "oboe.snd", "fyow.snd") end
+
+def expfil_test(start = 0.0, dur = 1.0)
+ expfil(start, dur, 0.2, 0.01, 0.1, "oboe.snd", "fyow.snd")
+ $now = start + dur + 0.2
+end
# GRAPH-EQ
#
@@ -2358,8 +2908,8 @@ Very easy to use. Just some note:
"amp" & "amp-env" apply an enveloppe to the final result of the
filtering.
-"dur" as ""standard"" in my instruments, when dur = 0 it will take the length of the
-sndfile input, otherwise the duration in seconds.
+"dur" as ""standard"" in my instruments, when dur = 0 it will take the length
+of the sndfile input, otherwise the duration in seconds.
"gain-freq-list" is a list of gains and frequencies to
filter --in this order gain and frequencies--. There is no limit to
@@ -2371,8 +2921,8 @@ case 2 -> '((0 .1 1 .5) 440.0 (0 1 1 .01) 1500 (0 .3 1 .5) 330.0 ...etc)
'( .1 440.0 (0 1 1 .01) 1500 ..etc) <<< again, this is not allowed ..
"offset-gain" This apply to all the gains if case 1. It adds or
-subtracts an offset to all the gains in the list. This number can be positive or
-negative. In case the result is a negative number --let's say offset =
+subtracts an offset to all the gains in the list. This number can be positive
+or negative. In case the result is a negative number --let's say offset =
-.4 and, like in case 1, the first gain is .1, the result would be
-.3 -- the instrument will pass a gain equal to 0.
@@ -2383,15 +2933,13 @@ envelopes if we are in case 2, gains are envelopes.
nil doesnt print anything, which will speed up a bit the process.
=end
#
-def graph_eq(file, *args)
- assert_type(File.exists?(file), file, 0, "an existing file")
- start, dur, or_beg, amp, amp_env, amp_base, offset_gain = nil
+def graph_eq(file, start, dur, *args)
+ assert_type(File.exist?(file), file, 0, "an existing file")
+ or_beg, amplitude, amp_env, amp_base, offset_gain = nil
gain_freq_list, filt_gain_scale, filt_gain_base, a1 = nil
optkey(args, binding,
- [:start, 0],
- [:dur, 0],
[:or_beg, 0],
- [:amp, 1],
+ [:amplitude, 1],
[:amp_env, [0, 1, 0.8, 1, 1, 0]],
[:amp_base, 1],
[:offset_gain, 0],
@@ -2404,11 +2952,18 @@ def graph_eq(file, *args)
or_start = (or_beg * ws_srate(file)).round
rd_a = make_ws_reader(file, :start, or_start)
half_list = gain_freq_list.length / 2
- ampenv = make_env(:envelope, amp_env, :scaler, amp, :duration, durata, :base, amp_base)
+ ampenv = make_env(:envelope, amp_env,
+ :scaler, amplitude,
+ :duration, durata,
+ :base, amp_base)
gain_list = []
- 0.step(gain_freq_list.length - 1, 2) do |i| gain_list << gain_freq_list[i] end
+ 0.step(gain_freq_list.length - 1, 2) do |i|
+ gain_list << gain_freq_list[i]
+ end
freq_list = []
- 1.step(gain_freq_list.length - 1, 2) do |i| freq_list << gain_freq_list[i] end
+ 1.step(gain_freq_list.length - 1, 2) do |i|
+ freq_list << gain_freq_list[i]
+ end
if_list_in_gain = gain_list[0].kind_of?(Array)
env_size = (if_list_in_gain ? Array.new(freq_list.length) : nil)
frm_size = Array.new(freq_list.length)
@@ -2417,8 +2972,10 @@ def graph_eq(file, *args)
gval = gain_list[i]
fval = freq_list[i]
if gval.kind_of?(Array)
- env_size[i] = make_env(:envelope, gval, :scaler, filt_gain_scale,
- :duration, durata, :base, filt_gain_base)
+ env_size[i] = make_env(:envelope, gval,
+ :scaler, filt_gain_scale,
+ :duration, durata,
+ :base, filt_gain_base)
frm_size[i] = make_formant(fval, a1)
else
gains[i] = (offset_gain + gval < 0) ? 0 : (offset_gain + gain)
@@ -2438,7 +2995,11 @@ def graph_eq(file, *args)
end
close_ws_reader(rd_a)
end
-# with_sound() do graph_eq("oboe.snd") end
+
+def graph_eq_test(start = 0.0, dur = 1.0)
+ graph_eq("oboe.snd", start, dur, :amplitude, 50.0)
+ $now = start + dur + 0.2
+end
# ANOI
#
@@ -2447,7 +3008,7 @@ end
# noise
# this is based on Perry Cook's Scrubber.m
def anoi(infile, start, dur, fftsize = 128, amp_scaler = 1.0, r = TWO_PI)
- assert_type(File.exists?(infile), infile, 0, "an existing file")
+ assert_type(File.exist?(infile), infile, 0, "an existing file")
freq_inc = (fftsize / 2).floor
fdi = make_vct(fftsize)
fdr = make_vct(fftsize)
@@ -2461,7 +3022,9 @@ def anoi(infile, start, dur, fftsize = 128, amp_scaler = 1.0, r = TWO_PI)
file = make_file2sample(infile)
radius = 1.0 - r / fftsize.to_f
bin = @srate / fftsize
- fs = make_array(freq_inc) do |i| make_formant(i * bin, radius) end
+ fs = make_array(freq_inc) do |i|
+ make_formant(i * bin, radius)
+ end
samp = 0
run_instrument(start, dur) do
inval = file2sample(file, samp)
@@ -2490,7 +3053,11 @@ def anoi(infile, start, dur, fftsize = 128, amp_scaler = 1.0, r = TWO_PI)
amp * outval
end
end
-# with_sound() do anoi("oboe.snd", 0, 1) end
+
+def anoi_test(start = 0.0, dur = 1.0)
+ anoi("fyow.snd", start, dur, 128, 2.0)
+ $now = start + dur + 0.2
+end
=begin
Date: Fri, 25 Sep 1998 09:56:41 +0300
@@ -2498,18 +3065,18 @@ From: Matti Koskinen <mjkoskin at sci.fi>
To: linux-audio-dev at ginette.musique.umontreal.ca
Subject: [linux-audio-dev] Announce: alpha version of denoising
[...]
- I wrote a simple denoiser called anoi after it's parent
- clm-instrument anoi.ins.
+ I wrote a simple denoiser called anoi after it's parent
+ clm-instrument anoi.ins.
- anoi tries to remove white noise like tape hiss from wav-
- files. Removing of noise succeeds ok, but depending of the
- original sound, some distortion can be audible.
+ anoi tries to remove white noise like tape hiss from wav-
+ files. Removing of noise succeeds ok, but depending of the
+ original sound, some distortion can be audible.
- If someone is interested, http://www.sci.fi/~mjkoskin
- contains tarred and gzipped file.
+ If someone is interested, http://www.sci.fi/~mjkoskin
+ contains tarred and gzipped file.
- Now only monophonic wav-files can be denoised, but adding
- others isn't too difficult.
+ Now only monophonic wav-files can be denoised, but adding
+ others isn't too difficult.
-matti
mjkoskin at sci.fi
@@ -2517,172 +3084,136 @@ mjkoskin at sci.fi
# FULLMIX
#
-# "matrix" can be a simple amplitude or a list of lists each inner
-# list represents one input channel's amps into one output channel
-# each element of the list can be a number, a list (turned into an
-# env) or an env
+# ;; "matrix" can be a simple amplitude or a list of lists each inner
+# ;; list represents one input channel's amps into one output channel
+# ;; each element of the list can be a number, a list (turned into an
+# ;; env) or an env
+# ;;
+# ;; "srate" can be a negative number (read in reverse), or an envelope.
def fullmix(in_file,
start = 0.0,
- outdur = nil,
+ outdur = false,
inbeg = 0.0,
- matrix = nil,
- srate = nil,
- reverb_amount = 0.05)
- assert_type(File.exists?(in_file), in_file, 0, "an existing file")
- dur = Float((outdur or (ws_duration(in_file) / Float((srate or 1.0)).abs)))
- in_chans = ws_channels(in_file)
- inloc = (Float(inbeg) * ws_srate(in_file)).round
- mx = file = envs = rev_mx = revframe = false
- if srate
- file = make_array(in_chans) do |chn|
- make_ws_reader(in_file, :start, inloc, :channel, chn)
- end
+ matrix = false,
+ srate = false,
+ reverb_amount = false)
+ unless File.exist?(in_file)
+ Snd.raise(:no_such_file, in_file, "no such file")
+ end
+ unless start
+ start = 0.0
+ end
+ unless inbeg
+ inbeg = 0.0
+ end
+ if number?(outdur)
+ dur = outdur
+ else
+ sr = number?(srate) ? srate.abs : 1.0
+ dur = (mus_sound_duration(in_file) - inbeg) / sr
+ end
+ in_chans = channels(in_file)
+ reversed = ((number?(srate) and srate.negative?) or
+ (array?(srate) and srate.cadr.negative?))
+ inloc = (Float(inbeg) * mus_sound_srate(in_file)).round
+ ochans = [in_chans, @channels].max
+ if @ws_reverb and number?(reverb_amount) and reverb_amount.positive?
+ rev_mx = Vct.new(in_chans * in_chans, reverb_amount)
else
- file = in_file
+ rev_mx = false
end
- mx = if matrix
- make_mixer([in_chans, @channels].max)
- else
- make_scalar_mixer([in_chans, @channels].max, 1.0)
- end
- if @ws_reverb and reverb_amount.positive?
- rev_mx = make_mixer(in_chans)
- in_chans.times do |chn|
- mixer_set!(rev_mx, chn, 0, reverb_amount)
+ dir = (reversed ? -1 : 1)
+ if (not srate) or (number?(srate) and srate == 1.0)
+ file = make_file2frample(in_file)
+ else
+ file = make_array(in_chans) do |i|
+ make_readin(in_file, i, inloc, :direction, dir)
end
- revframe = make_frame(1)
+ end
+ envs = false
+ if array?(srate)
+ srcenv = make_env(srate, :duration, dur, :scaler, Float(dir))
+ else
+ srcenv = false
end
case matrix
when Array
- in_chans.times do |ichn|
- inlist = matrix[ichn]
- @channels.times do |ochn|
- outn = inlist[ochn]
+ mx = Vct.new(ochans * ochans, 0.0)
+ matrix.each_with_index do |inlist, inp|
+ break if inp >= in_chans
+ inlist.each_with_index do |outn, outp|
+ break if outp >= @channels
case outn
when Numeric
- mixer_set!(mx, ichn, ochn, outn)
+ # mx[inp][outp] = outn
+ mx[inp * ochans + outp] = outn
when Array, Mus
unless envs
- envs = make_array(in_chans) do make_array(@channels, false) end
+ envs = Array.new(in_chans * @channels, false)
end
if env?(outn)
- envs[ichn][ochn] = outn
+ envs[inp * @channels + outp] = outn
else
- envs[ichn][ochn] = make_env(:envelope, outn, :duration, dur)
+ envs[inp * @channels + outp] = make_env(outn, :duration, dur)
end
else
- Snd.warning("unknown element in matrix: %s", outn.inspect)
+ Snd.warning("unknown element in matrix: %p", outn)
end
end
end
when Numeric
- # matrix is a number in this case (a global scaler)
- in_chans.times do |i|
- if i < @channels then mixer_set!(mx, i, i, matrix) end
- end
+ # ; matrix is a number in this case (a global scaler)
+ mx = Vct.new(ochans * ochans, matrix)
+ else
+ mx = Vct.new(ochans * ochans, 1.0)
end
- start = Float(start)
# to satisfy with_sound-option :info and :notehook
with_sound_info(get_func_name, start, dur)
- run_fullmix(start, dur, in_chans, srate, inloc, file, mx, rev_mx, revframe, envs)
- array?(file) and file.each do |rd| close_ws_reader(rd) end
-end
-
-class Snd_Instrument
- def run_fullmix(start, dur, in_chans, sr, inloc, file, mx, rev_mx, revframe, envs)
- # normally run_instrument stores debugging informations
- @clm_instruments.store(binding, [get_func_name, start, dur])
- beg = seconds2samples(start)
- samps = seconds2samples(dur)
- unless sr
- @out_snd = with_closed_sound(@out_snd) do |snd_name|
- mus_mix(snd_name, file, beg, samps, inloc, mx, envs)
- end
- if rev_mx
- @rev_snd = with_closed_sound(@rev_snd) do |snd_name|
- mus_mix(snd_name, file, beg, samps, inloc, rev_mx, false)
- end
- end
- else
- out_data = make_sound_data(@channels, samps)
- if rev_mx
- rev_data = make_sound_data(@reverb_channels, samps)
- end
- inframe = make_frame(in_chans)
- outframe = make_frame(@channels)
- srcs = make_array(in_chans) do make_src(:srate, sr) end
- samps.times do |i|
- if envs
- in_chans.times do |chn|
- @channels.times do |ochn|
- if envs[chn] and env?(envs[chn][ochn])
- mixer_set!(mx, chn, ochn, env(envs[chn][ochn]))
- end
- end
- end
- end
- in_chans.times do |chn|
- frame_set!(inframe, chn, src(srcs[chn], 0.0, lambda do |dir| ws_readin(file[chn]) end))
- end
- frame2sound_data!(out_data, i, frame2frame(inframe, mx, outframe))
- if rev_mx
- frame2sound_data!(rev_data, i, frame2frame(inframe, rev_mx, revframe))
- end
- end
- @channels.times do |chn|
- mix_vct(out_data.to_vct(chn), beg, @out_snd, chn, false)
- end
- if rev_mx
- @reverb_channels.times do |chn|
- mix_vct(rev_data.to_vct(chn), beg, @rev_snd, chn, false)
+ beg = seconds2samples(start)
+ samps = seconds2samples(dur)
+ if (not array?(file))
+ mxe = envs
+ if envs
+ mxe = Array.new(in_chans) do |i|
+ Array.new(@channels) do |j|
+ envs[i * @channels + j]
end
end
end
- end
-end
-
-class CLM_Instrument
- def run_fullmix(start, dur, in_chans, sr, inloc, file, mx, rev_mx, revframe, envs)
- # normally run_instrument stores debugging informations
- @clm_instruments.store(binding, [get_func_name, start, dur])
- beg = seconds2samples(start)
- samps = seconds2samples(dur)
- unless sr
- mus_mix(@ws_output, file, beg, samps, inloc, mx, envs)
- if rev_mx
- mus_mix(@ws_reverb, file, beg, samps, inloc, rev_mx, false)
+ if sound?(@ws_output)
+ output = file_name(@ws_output)
+ if sound?(@ws_reverb)
+ revout = file_name(@ws_reverb)
end
else
- inframe = make_frame(in_chans)
- outframe = make_frame(@channels)
- srcs = make_array(in_chans) do make_src(:srate, sr) end
- each_sample(start, dur) do |i|
- if envs
- in_chans.times do |chn|
- @channels.times do |ochn|
- if envs[chn] and env?(envs[chn][ochn])
- mixer_set!(mx, chn, ochn, env(envs[chn][ochn]))
- end
- end
- end
- end
- in_chans.times do |chn|
- frame_set!(inframe, chn, src(srcs[chn], 0.0, lambda do |dir| readin(file[chn]) end))
- end
- frame2file(@ws_output, i, frame2frame(inframe, mx, outframe))
- if rev_mx
- frame2file(@ws_reverb, i, frame2frame(inframe, rev_mx, revframe))
- end
- end
+ output = @ws_output
+ revout = @ws_reverb
end
+ mus_file_mix(output, file, beg, samps, inloc, mx, mxe)
+ if rev_mx
+ mus_file_mix(revout, file, beg, samps, inloc, rev_mx)
+ end
+ else
+ if sound?(@ws_output)
+ Snd.raise(:wrong_type_arg, "don't use :to_snd true")
+ end
+ sr = (number?(srate) ? srate.abs : 0.0)
+ srcs = Array.new(in_chans) do |i|
+ make_src(:input, file[i], :srate, sr)
+ end
+ mus_file_mix_with_envs(file, beg, samps, mx, rev_mx, envs, srcs, srcenv,
+ @ws_output, @ws_reverb)
end
end
-=begin
-with_sound(:channels, 2, :statistics, true) do
- fullmix("pistol.snd")
- fullmix("oboe.snd", 1, 2, 0, [[0.1, make_env([0, 0, 1, 1], :duration, 2, :scaler, 0.5)]])
+
+def fullmix_test(start = 0.0, dur = 1.0)
+ $now = start
+ fullmix("pistol.snd", $now, dur)
+ $now += dur + 0.2
+ fullmix("oboe.snd", $now, dur, 0,
+ [[0.1, make_env([0, 0, 1, 1], :duration, dur, :scaler, 0.5)]])
+ $now += dur + 0.2
end
-=end
# Original header:
@@ -2716,7 +3247,8 @@ end
# ;;; create a constant envelope if argument is a number
def envelope_or_number(val)
- assert_type((number?(val) or array?(val) or vct?(val)), val, 0, "a number, an array or a vct")
+ assert_type((number?(val) or array?(val) or vct?(val)),
+ val, 0, "a number, an array or a vct")
case val
when Numeric
[0, Float(val), 1, Float(val)]
@@ -2730,7 +3262,9 @@ end
# ;;; create a vct from an envelope
def make_gr_env(env, length = 512)
length_1 = (length - 1).to_f
- make_vct!(length) do |i| envelope_interp(i / length_1, env) end
+ make_vct!(length) do |i|
+ envelope_interp(i / length_1, env)
+ end
end
# ;;; Grain envelopes
@@ -2813,13 +3347,15 @@ Grani_to_grain_random = 4
Grani_to_grain_allchans = 5
def grani(start, dur, amp, file, *args)
- assert_type(File.exists?(file), file, 3, "an existing file")
- input_channel, grain_degree_spread = nil
- grains, amp_envelope, grain_envelope, grain_envelope_end, grain_envelope_transition = nil
- grain_envelope_array_size, grain_duration, grain_duration_spread, grain_duration_limit = nil
- srate, srate_spread, srate_linear, srate_base, srate_error, grain_start, grain_start_spread = nil
- grain_start_in_seconds, grain_density, grain_density_spread, reverb_amount, reverse = nil
- where_to, where_bins, grain_distance, grain_distance_spread, grain_degree = nil
+ assert_type(File.exist?(file), file, 3, "an existing file")
+ input_channel = nil
+ grains, amp_envelope, grain_envelope, grain_envelope_end = nil
+ grain_envelope_transition, grain_envelope_array_size, grain_duration = nil
+ grain_duration_spread, grain_duration_limit, srate, srate_spread = nil
+ srate_linear, srate_base, srate_error, grain_start, grain_start_spread = nil
+ grain_start_in_seconds, grain_density, grain_density_spread = nil
+ reverb_amount, reverse, where_to, where_bins, grain_distance = nil
+ grain_distance_spread, grain_degree, grain_degree_spread = nil
optkey(args, binding,
[:input_channel, 0],
[:grains, 0],
@@ -2829,8 +3365,8 @@ def grani(start, dur, amp, file, *args)
[:grain_envelope_transition, [0, 0, 1, 1]],
[:grain_envelope_array_size, 512],
[:grain_duration, 0.1],
- [:grain_spread, 0.0],
- [:grain_limit, 0.002],
+ [:grain_duration_spread, 0.0],
+ [:grain_duration_limit, 0.002],
[:srate, 0.0],
[:srate_spread, 0.0],
[:srate_linear, false],
@@ -2853,8 +3389,11 @@ def grani(start, dur, amp, file, *args)
in_file_channels = ws_channels(file)
in_file_sr = ws_srate(file)
in_file_dur = ws_duration(file)
- rd = make_ws_reader(file, :channel, [input_channel, in_file_channels - 1].min, :vct?, true)
- in_file_reader = make_src(:input, lambda do |dir| ws_readin(rd) end, :srate, 1.0)
+ rd = make_ws_reader(file,
+ :channel, [input_channel, in_file_channels - 1].min,
+ :vct?, true)
+ in_file_reader = make_src(:input, lambda do |dir| ws_readin(rd) end,
+ :srate, 1.0)
set_mus_increment(in_file_reader, -1) if reverse
last_in_sample = (in_file_dur * in_file_sr).round
srate_ratio = in_file_sr / mus_srate()
@@ -2867,37 +3406,52 @@ def grani(start, dur, amp, file, *args)
end,
:scaler, srate_ratio,
:duration, dur)
- sr_spread_env = make_env(:envelope, envelope_or_number(srate_spread), :duration, dur)
+ sr_spread_env = make_env(:envelope, envelope_or_number(srate_spread),
+ :duration, dur)
amp_env = make_env(:envelope, amp_envelope, :scaler, amp, :duration, dur)
- gr_dur = make_env(:envelope, envelope_or_number(grain_duration), :duration, dur)
- gr_dur_spread = make_env(:envelope, envelope_or_number(grain_duration_spread), :duration, dur)
+ gr_dur = make_env(:envelope, envelope_or_number(grain_duration),
+ :duration, dur)
+ gr_dur_spread = make_env(:envelope, envelope_or_number(grain_duration_spread),
+ :duration, dur)
gr_start_scaler = (grain_start_in_seconds ? 1.0 : in_file_dur)
- gr_start = make_env(:envelope, envelope_or_number(grain_start), :duration, dur)
- gr_start_spread = make_env(:envelope, envelope_or_number(grain_start_spread), :duration, dur)
- gr_dens_env = make_env(:envelope, envelope_or_number(grain_density), :duration, dur)
- gr_dens_spread_env = make_env(:envelope, envelope_or_number(grain_density_spread), :duration, dur)
- gr_env = make_table_lookup(:frequency, 1.0, :initial_phase, 0.0,
- :wave, if vct?(grain_envelope)
- grain_envelope
- else
- make_gr_env(grain_envelope, grain_envelope_array_size)
- end)
- gr_env_end = make_table_lookup(:frequency, 1.0, :initial_phase, 0.0,
- :wave, if grain_envelope_end
- if vct?(grain_envelope_end)
- grain_envelope_end
- else
- make_gr_env(grain_envelope_end,
- grain_envelope_array_size)
- end
- else
- make_vct(512)
- end)
- gr_int_env = make_env(:envelope, envelope_or_number(grain_envelope_transition), :duration, dur)
- gr_dist = make_env(:envelope, envelope_or_number(grain_distance), :duration, dur)
- gr_dist_spread = make_env(:envelope, envelope_or_number(grain_distance_spread), :duration, dur)
- gr_degree = make_env(:envelope, envelope_or_number(grain_degree), :duration, dur)
- gr_degree_spread = make_env(:envelope, envelope_or_number(grain_degree_spread), :duration, dur)
+ gr_start = make_env(:envelope, envelope_or_number(grain_start),
+ :duration, dur)
+ gr_start_spread = make_env(:envelope, envelope_or_number(grain_start_spread),
+ :duration, dur)
+ gr_dens_env = make_env(:envelope, envelope_or_number(grain_density),
+ :duration, dur)
+ gr_dens_spread_env = make_env(:envelope,
+ envelope_or_number(grain_density_spread),
+ :duration, dur)
+ if vct?(grain_envelope)
+ ge = grain_envelope
+ else
+ ge = make_gr_env(grain_envelope, grain_envelope_array_size)
+ end
+ gr_env = make_table_lookup(:frequency, 1.0, :initial_phase, 0, :wave, ge)
+ if grain_envelope_end
+ if vct?(grain_envelope_end)
+ ge = grain_envelope_end
+ else
+ ge = make_gr_env(grain_envelope_end, grain_envelope_array_size)
+ end
+ else
+ ge = make_vct(512)
+ end
+ gr_env_end = make_table_lookup(:frequency, 1.0, :initial_phase, 0, :wave, ge)
+ gr_int_env = make_env(:envelope,
+ envelope_or_number(grain_envelope_transition),
+ :duration, dur)
+ gr_dist = make_env(:envelope, envelope_or_number(grain_distance),
+ :duration, dur)
+ gr_dist_spread = make_env(:envelope,
+ envelope_or_number(grain_distance_spread),
+ :duration, dur)
+ gr_degree = make_env(:envelope, envelope_or_number(grain_degree),
+ :duration, dur)
+ gr_degree_spread = make_env(:envelope,
+ envelope_or_number(grain_degree_spread),
+ :duration, dur)
gr_start_sample = beg
gr_samples = 0
gr_offset = 1
@@ -2906,12 +3460,19 @@ def grani(start, dur, amp, file, *args)
grain_counter = 0
samples = 0
first_grain = true
- run_instrument(start, dur + grain_duration, :degree, 45.0) do
+ case grain_duration
+ when Numeric
+ dur += grain_duration
+ when Array
+ dur += grain_duration.last
+ end
+ run_instrument(start, dur, :degree, 45.0) do
if gr_offset < gr_samples
gr_offset += 1
(if grain_envelope_end
gr_where = env(gr_int_env)
- (1 - gr_where) * table_lookup(gr_env) + gr_where * table_lookup(gr_env_end)
+ (1 - gr_where) * table_lookup(gr_env) +
+ gr_where * table_lookup(gr_env_end)
else
table_lookup(gr_env)
end) * env(amp_env) * src(in_file_reader)
@@ -2921,7 +3482,8 @@ def grani(start, dur, amp, file, *args)
gr_start_sample = beg
else
gr_start_sample += seconds2samples(1.0 / (gr_dens + gr_dens_spread))
- if (gr_start_sample > fin) or (grains.nonzero? and (grain_counter >= grains))
+ if (gr_start_sample > fin) or
+ (grains.nonzero? and (grain_counter >= grains))
break
end
end
@@ -2939,7 +3501,8 @@ def grani(start, dur, amp, file, *args)
in_start_value = env(gr_start) * gr_start_scaler +
random_spread(env(gr_start_spread) * gr_start_scaler)
in_start = (in_start_value * in_file_sr).round
- gr_duration = [grain_duration_limit, env(gr_dur) + random_spread(env(gr_dur_spread))].max
+ gr_duration = [grain_duration_limit,
+ env(gr_dur) + random_spread(env(gr_dur_spread))].max
gr_samples = seconds2samples(gr_duration)
gr_srate = if srate_linear
env(sr_env) + random_spread(env(sr_spread_env))
@@ -2947,7 +3510,7 @@ def grani(start, dur, amp, file, *args)
env(sr_env) * srate_base ** random_spread(env(sr_spread_env))
end
set_mus_increment(in_file_reader, gr_srate)
- in_samples = gr_samples / (1.0 / srate_ratio)
+ in_samples = (gr_samples / (1.0 / srate_ratio)).round
set_mus_phase(gr_env, 0.0)
set_mus_phase(gr_env_end, 0.0)
set_mus_frequency(gr_env, 1.0 / gr_duration)
@@ -2971,11 +3534,15 @@ def grani(start, dur, amp, file, *args)
if where.nonzero? and where_bins.length > 0
(where_bins.length - 1).times do |chn|
locsig_set!(@locsig, chn,
- (where.between?(where_bins[chn], where_bins[chn + 1]) ? 1.0 : 0.0))
+ (where.between?(where_bins[chn], where_bins[chn + 1]) ?
+ 1.0 :
+ 0.0))
end
else
if where_to == Grani_to_grain_allchans
- @channels.times do |chn| locsig_set!(@locsig, chn, 1.0) end
+ @channels.times do |chn|
+ locsig_set!(@locsig, chn, 1.0)
+ end
else
set_mus_location(gr_dist, gr_from_beg)
set_mus_location(gr_dist_spread, gr_from_beg)
@@ -2985,7 +3552,8 @@ def grani(start, dur, amp, file, *args)
dist = env(gr_dist) + random_spread(env(gr_dist_spread))
dist_scl = 1.0 / [dist, 1.0].max
if sample2file?(@ws_reverb)
- locsig_reverb_set!(@locsig, 0, reverb_amount * (1.0 / sqrt([dist, 1.0].max)))
+ locsig_reverb_set!(@locsig, 0,
+ reverb_amount * (1.0 / sqrt([dist, 1.0].max)))
end
if @channels == 1
locsig_set!(@locsig, 0, dist_scl)
@@ -3051,19 +3619,19 @@ def grani(start, dur, amp, file, *args)
close_ws_reader(rd)
end
-=begin
-with_sound(:channels, 2, :reverb, :jl_reverb, :reverb_channels, 1) do
- file = "oboe.snd"
- grani(0.0, 2.0, 5.0, file, :grain_envelope, raised_cosine())
+def grani_test(start = 0.0, dur = 1.0)
+ grani(start, dur, 5.0, "oboe.snd", :grain_envelope, raised_cosine())
+ $now = start + dur + 0.2
end
-=end
# BES-FM
def bes_fm(start, dur, freq, amp, ratio, index)
car_ph = mod_ph = 0.0
car_incr = hz2radians(freq)
mod_incr = ratio.to_f * car_incr
- ampenv = make_env(:envelope, [0, 0, 25, 1, 75, 1, 100, 0], :scaler, amp, :duration, dur)
+ ampenv = make_env(:envelope, [0, 0, 25, 1, 75, 1, 100, 0],
+ :scaler, amp,
+ :duration, dur)
run_instrument(start, dur) do
out_val = env(ampenv) * bes_j1(car_ph)
car_ph = car_ph + car_incr + index.to_f * bes_j1(mod_ph)
@@ -3071,7 +3639,11 @@ def bes_fm(start, dur, freq, amp, ratio, index)
out_val
end
end
-# with_sound() do bes_fm(0, 0.5, 440, 5, 1, 8) end
+
+def bes_fm_test(start = 0.0, dur = 1.0)
+ bes_fm(start, dur, 440, 10, 1, 4)
+ $now = start + dur + 0.2
+end
# SSB_FM
class Ssb_fm < Musgen
@@ -3144,7 +3716,8 @@ class Fm2 < Musgen
end
def fm2(index)
- (oscil(@osc1, index * oscil(@osc2)) + oscil(@osc3, index * oscil(@osc4))) * 0.25
+ (oscil(@osc1, index * oscil(@osc2)) +
+ oscil(@osc3, index * oscil(@osc4))) * 0.25
end
end
@@ -3162,4 +3735,49 @@ def fm2(gen, index = 0.0)
gen.fm2(index)
end
+def clm_ins_test(start = 0.0, dur = 1.0)
+ $now = start
+ violin_test($now, dur)
+ fm_violin_test($now, dur)
+ pluck_test($now, dur)
+ vox_test($now, dur)
+ fofins_test($now, dur)
+ fm_trumpet_test($now, dur)
+ pqw_vox_test($now, dur)
+ flute_test($now, dur)
+ fm_bell_test($now, dur)
+ fm_insect_test($now, dur)
+ fm_drum_test($now, dur)
+ gong_test($now, dur)
+ attract_test($now, dur)
+ pqw_test($now, dur)
+ tubebell_test($now, dur)
+ wurley_test($now, dur)
+ rhodey_test($now, dur)
+ hammondoid_test($now, dur)
+ metal_test($now, dur)
+ drone_canter_test($now, dur)
+ reson_test($now, dur)
+ cellon_test($now, dur)
+ gran_synth_test($now, dur)
+ touch_tone_test($now, dur)
+ spectra_test($now, dur)
+ two_tab_test($now, dur)
+ lbj_piano_test($now, dur)
+ resflt_test($now, dur)
+ scratch_test($now, dur)
+ pins_test($now, dur)
+ zc_test($now, dur)
+ zn_test($now, dur)
+ za_test($now, dur)
+ clm_expsrc_test($now, dur)
+ exp_snd_test($now, dur)
+ expfil_test($now, dur)
+ graph_eq_test($now, dur)
+ anoi_test($now, dur)
+ fullmix_test($now, dur)
+ grani_test($now, dur)
+ bes_fm_test($now, dur)
+end
+
# clm-ins.rb ends here
diff --git a/clm-ins.scm b/clm-ins.scm
index afb79fe..84d013d 100644
--- a/clm-ins.scm
+++ b/clm-ins.scm
@@ -1,11 +1,12 @@
;;; CLM instruments translated to Snd/Scheme
-;;;
-;;; all assume they're called within with-sound, most set up C-g to (throw 'with-sound-interrupt)
(provide 'snd-clm-ins.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(require snd-env.scm snd-dsp.scm snd-fullmix.scm snd-expandn.scm)
+
;;; -------- pluck
@@ -19,7 +20,7 @@
"(pluck start dur freq amp weighting lossfact) implements the Jaffe-Smith plucked string physical model.
'weighting' is the ratio of the once-delayed to the twice-delayed samples. It defaults to .5=shortest decay.
Anything other than .5 = longer decay. Must be between 0 and less than 1.0.
-'lossfact' can be used to shorten decays. Most useful values are between .8 and 1.0. (pluck 0 1 330 .3 .95 .95)"
+'lossfact' can be used to shorten decays. Most useful values are between .8 and 1.0. (with-sound () (pluck 0 1 330 .3 .7 .995))"
(define (getOptimumC S o p)
(let* ((pa (* (/ 1.0 o) (atan (* S (sin o)) (+ (- 1.0 S) (* S (cos o))))))
@@ -31,51 +32,49 @@ Anything other than .5 = longer decay. Must be between 0 and less than 1.0.
(set! tmpInt (- tmpInt 1))
(set! pc (+ pc 1.0))))
(list tmpInt (/ (- (sin o) (sin (* o pc))) (sin (+ o (* o pc)))))))
-
+
(define (tuneIt f s1)
- (let* ((p (/ (mus-srate) f)) ;period as float
- (s (if (= s1 0.0) 0.5 s1))
- (o (hz->radians f))
- (vals (getOptimumC s o p))
- (T1 (car vals))
- (C1 (cadr vals))
- (vals1 (getOptimumC (- 1.0 s) o p))
- (T2 (car vals1))
- (C2 (cadr vals1)))
- (if (and (not (= s .5))
- (< (abs C1) (abs C2)))
- (list (- 1.0 s) C1 T1)
- (list s C2 T2))))
-
- (let* ((vals (tuneIt freq weighting))
- (wt0 (car vals))
- (c (cadr vals))
- (dlen (caddr vals))
- (beg (seconds->samples start))
- (end (+ beg (seconds->samples dur)))
- (lf (if (= lossfact 0.0) 1.0 (min 1.0 lossfact)))
- (wt (if (= wt0 0.0) 0.5 (min 1.0 wt0)))
- (tab (make-vct dlen))
- ;; get initial waveform in "tab" -- here we can introduce 0's to simulate different pick
- ;; positions, and so on -- see the CMJ article for numerous extensions. The normal case
- ;; is to load it with white noise (between -1 and 1).
- (allp (make-one-zero (* lf (- 1.0 wt)) (* lf wt)))
- (feedb (make-one-zero c 1.0)) ;or (feedb (make-one-zero 1.0 c))
- (ctr 0))
-
- (do ((i 0 (+ i 1)))
- ((= i dlen))
- (set! (tab i) (- 1.0 (random 2.0))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((val (tab ctr))) ;current output value
- (set! (tab ctr) (* (- 1.0 c)
- (one-zero feedb
- (one-zero allp val))))
- (set! ctr (+ ctr 1))
- (if (>= ctr dlen) (set! ctr 0))
- (outa i (* amp val)))))))
+ (let ((p (/ *clm-srate* f)) ;period as float
+ (s (if (= s1 0.0) 0.5 s1))
+ (o (hz->radians f)))
+ (let ((vals (getOptimumC s o p))
+ (vals1 (getOptimumC (- 1.0 s) o p)))
+ (if (and (not (= s .5))
+ (< (abs (cadr vals)) (abs (cadr vals1))))
+ (list (- 1.0 s) (cadr vals) (car vals))
+ (list s (cadr vals1) (car vals1))))))
+
+ (let ((vals (tuneIt freq weighting)))
+ (let ((wt0 (car vals))
+ (c (cadr vals))
+ (dlen (caddr vals))
+ (beg (seconds->samples start))
+ (end (seconds->samples (+ start dur)))
+ (lf (if (= lossfact 0.0) 1.0 (min 1.0 lossfact))))
+
+ (let ((wt (if (= wt0 0.0) 0.5 (min 1.0 wt0)))
+ (tab (make-float-vector dlen)))
+
+ ;; get initial waveform in "tab" -- here we can introduce 0's to simulate different pick
+ ;; positions, and so on -- see the CMJ article for numerous extensions. The normal case
+ ;; is to load it with white noise (between -1 and 1).
+ (let ((allp (make-one-zero (* lf (- 1.0 wt)) (* lf wt)))
+ (feedb (make-one-zero c 1.0)) ;or (feedb (make-one-zero 1.0 c))
+ (c1 (- 1.0 c)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i dlen))
+ (float-vector-set! tab i (mus-random 1.0)))
+
+ (do ((i beg (+ i 1))
+ (ctr 0 (modulo (+ ctr 1) dlen)))
+ ((= i end))
+ (outa i (* amp (float-vector-set! tab ctr (* c1 (one-zero feedb (one-zero allp (float-vector-ref tab ctr)))))))))))))
+#|
+ (let ((val (float-vector-ref tab ctr))) ;current output value
+ (float-vector-set! tab ctr (* c1 (one-zero feedb (one-zero allp val))))
+ (outa i (* amp val)))))))))
+|#
;;; -------- mlbvoi
@@ -97,119 +96,334 @@ Anything other than .5 = longer decay. Must be between 0 and less than 1.0.
(TH 200 1400 2200) (S 200 1300 2500) (SH 200 1800 2000)
(V 175 1100 2400) (THE 200 1600 2200)(Z 200 1300 2500)
(ZH 175 1800 2000) (ZZ 900 2400 3800) (VV 565 1045 2400))))
- ;;formant center frequencies for a male speaker
-
+ ;;formant center frequencies for a male speaker
+
(define (find-phoneme phoneme forms)
- (if (eq? phoneme (car (car forms)))
- (cdr (car forms))
- (find-phoneme phoneme (cdr forms))))
-
+ (if (eq? phoneme (caar forms))
+ (cdar forms)
+ (find-phoneme phoneme (cdr forms))))
+
(define (vox-fun phons which)
- (let ((f1 '())
+ (let ((f1 ())
(len (length phons)))
(do ((i 0 (+ i 2)))
((>= i len))
- (set! f1 (cons (list-ref phons i) f1))
- (set! f1 (cons (list-ref (find-phoneme (list-ref phons (+ i 1)) formants) which) f1)))
+ (set! f1 (cons (phons i) f1))
+ (set! f1 (cons ((find-phoneme (phons (+ i 1)) formants) which) f1)))
(reverse f1)))
+
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (car-os (make-oscil 0))
+ (fs (length formant-amps))
+ (per-vib (make-triangle-wave :frequency 6 :amplitude (hz->radians (* freq vibscl))))
+ (ran-vib (make-rand-interp :frequency 20 :amplitude (hz->radians (* freq .5 vibscl))))
+ (freqf (make-env freqfun :duration dur :scaler (hz->radians (* freqscl freq)) :offset (hz->radians freq))))
+
+ (if (and (= fs 3)
+ (= (channels *output*) 1))
+ ;; optimize the common case
+ (let ((a0 (make-env ampfun :scaler (* amp (formant-amps 0)) :duration dur))
+ (a1 (make-env ampfun :scaler (* amp (formant-amps 1)) :duration dur))
+ (a2 (make-env ampfun :scaler (* amp (formant-amps 2)) :duration dur))
+ (o0 (make-oscil 0.0))
+ (o1 (make-oscil 0.0))
+ (o2 (make-oscil 0.0))
+ (e0 (make-oscil 0.0))
+ (e1 (make-oscil 0.0))
+ (e2 (make-oscil 0.0))
+ (ind0 (formant-indices 0))
+ (ind1 (formant-indices 1))
+ (ind2 (formant-indices 2))
+ (f0 (make-env (vox-fun phonemes 0) :scaler (hz->radians 1.0) :duration dur))
+ (f1 (make-env (vox-fun phonemes 1) :scaler (hz->radians 1.0) :duration dur))
+ (f2 (make-env (vox-fun phonemes 2) :scaler (hz->radians 1.0) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let* ((frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
+ (carg (oscil car-os frq))
+ (frm0 (/ (env f0) frq))
+ (frm1 (/ (env f1) frq))
+ (frm2 (/ (env f2) frq)))
+ (outa i (+
+ (* (env a0)
+ (+ (* (even-weight frm0) (oscil e0 (+ (* ind0 carg) (even-multiple frm0 frq))))
+ (* (odd-weight frm0) (oscil o0 (+ (* ind0 carg) (odd-multiple frm0 frq))))))
+ (* (env a1)
+ (+ (* (even-weight frm1) (oscil e1 (+ (* ind1 carg) (even-multiple frm1 frq))))
+ (* (odd-weight frm1) (oscil o1 (+ (* ind1 carg) (odd-multiple frm1 frq))))))
+ (* (env a2)
+ (+ (* (even-weight frm2) (oscil e2 (+ (* ind2 carg) (even-multiple frm2 frq))))
+ (* (odd-weight frm2) (oscil o2 (+ (* ind2 carg) (odd-multiple frm2 frq)))))))))))
+
+ (let ((evens (make-vector fs))
+ (odds (make-vector fs))
+ (ampfs (make-vector fs))
+ (indices (make-float-vector fs 0.0))
+ (frmfs (make-vector fs))
+ (carrier 0.0)
+ (frm-int 0)
+ (rfrq 0.0)
+ (frm0 0.0)
+ (frac 0.0)
+ (fracf 0.0)
+ (loc (make-locsig deg 1.0 pcrev)))
+ (do ((i 0 (+ i 1)))
+ ((= i fs))
+ (set! (evens i) (make-oscil 0))
+ (set! (odds i) (make-oscil 0))
+ (set! (ampfs i) (make-env ampfun :scaler (* amp (formant-amps i)) :duration dur))
+ (set! (indices i) (formant-indices i))
+ (set! (frmfs i) (make-env (vox-fun phonemes i) :scaler (hz->radians 1.0) :duration dur)))
+
+ (if (= fs 3)
+ (let ((frmfs0 (frmfs 0)) (frmfs1 (frmfs 1)) (frmfs2 (frmfs 2))
+ (index0 (indices 0)) (index1 (indices 1)) (index2 (indices 2))
+ (ampfs0 (ampfs 0)) (ampfs1 (ampfs 1)) (ampfs2 (ampfs 2))
+ (evens0 (evens 0)) (evens1 (evens 1)) (evens2 (evens 2))
+ (odds0 (odds 0)) (odds1 (odds 1)) (odds2 (odds 2)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (set! rfrq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
+ (set! carrier (oscil car-os rfrq))
+
+ (set! frm0 (/ (env frmfs0) rfrq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (+ (* index0 carrier) (* frm-int rfrq)))
+ (if (even? frm-int)
+ (locsig loc i (* (env ampfs0) (+ (* (- 1.0 frac) (oscil evens0 fracf)) (* frac (oscil odds0 (+ fracf rfrq))))))
+ (locsig loc i (* (env ampfs0) (+ (* frac (oscil evens0 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds0 fracf))))))
+
+ (set! frm0 (/ (env frmfs1) rfrq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (+ (* index1 carrier) (* frm-int rfrq)))
+ (if (even? frm-int)
+ (locsig loc i (* (env ampfs1) (+ (* (- 1.0 frac) (oscil evens1 fracf)) (* frac (oscil odds1 (+ fracf rfrq))))))
+ (locsig loc i (* (env ampfs1) (+ (* frac (oscil evens1 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds1 fracf))))))
+
+ (set! frm0 (/ (env frmfs2) rfrq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (+ (* index2 carrier) (* frm-int rfrq)))
+ (if (even? frm-int)
+ (locsig loc i (* (env ampfs2) (+ (* (- 1.0 frac) (oscil evens2 fracf)) (* frac (oscil odds2 (+ fracf rfrq))))))
+ (locsig loc i (* (env ampfs2) (+ (* frac (oscil evens2 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds2 fracf))))))))
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (set! rfrq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
+ (set! carrier (oscil car-os rfrq)) ; better name: modulator or perhaps perceived-carrier?
+
+ (do ((k 0 (+ k 1)))
+ ((= k fs))
+ (set! frm0 (/ (env (vector-ref frmfs k)) rfrq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (+ (* (float-vector-ref indices k) carrier) (* frm-int rfrq)))
+ (if (even? frm-int)
+ (locsig loc i (* (env (vector-ref ampfs k))
+ (+ (* (- 1.0 frac) (oscil (vector-ref evens k) fracf))
+ (* frac (oscil (vector-ref odds k) (+ fracf rfrq))))))
+ (locsig loc i (* (env (vector-ref ampfs k))
+ (+ (* frac (oscil (vector-ref evens k) (+ fracf rfrq)))
+ (* (- 1.0 frac) (oscil (vector-ref odds k) fracf))))))))))))))
+
+;;; (with-sound (:statistics #t) (vox 0 2 170 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 E 25 AE 35 ER 65 ER 75 I 100 UH) '(.8 .15 .05) '(.005 .0125 .025) .05 .1))
+;;; (with-sound () (vox 0 2 300 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .15 .05) '(.05 .0125 .025) .02 .1))
+;;; (with-sound () (vox 0 5 600 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .16 .04) '(.01 .01 .1) .01 .1))
+
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (car-os (make-oscil 0))
+;;; -------- PQWVOX
+;;; translation of CLM pqwvox.ins (itself translated from MUS10 of MLB's waveshaping voice instrument (using phase quadrature waveshaping))
+
+(definstrument (pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes)
+ "(pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes) produces
+vocal sounds using phase quadrature waveshaping"
+
+ (define formants
+ '((I 390 1990 2550) (E 530 1840 2480) (AE 660 1720 2410)
+ (UH 520 1190 2390) (A 730 1090 2440) (OW 570 840 2410)
+ (U 440 1020 2240) (OO 300 870 2240) (ER 490 1350 1690)
+ (W 300 610 2200) (LL 380 880 2575) (R 420 1300 1600)
+ (Y 300 2200 3065) (EE 260 3500 3800) (LH 280 1450 1600)
+ (L 300 1300 3000) (I2 350 2300 3340) (B 200 800 1750)
+ (D 300 1700 2600) (G 250 1350 2000) (M 280 900 2200)
+ (N 280 1700 2600) (NG 280 2300 2750) (P 300 800 1750)
+ (T 200 1700 2600) (K 350 1350 2000) (F 175 900 4400)
+ (TH 200 1400 2200) (S 200 1300 2500) (SH 200 1800 2000)
+ (V 175 1100 2400) (THE 200 1600 2200)(Z 200 1300 2500)
+ (ZH 175 1800 2000) (ZZ 900 2400 3800) (VV 565 1045 2400)))
+ ;;formant center frequencies for a male speaker
+
+ (define (find-phoneme phoneme form)
+ (if (eq? (caar form) phoneme)
+ (cdar form)
+ (find-phoneme phoneme (cdr form))))
+
+ (define (vox-fun phons which newenv)
+ ;; make an envelope from which-th entry of phoneme data referred to by phons
+ (if (null? phons)
+ newenv
+ (vox-fun (cddr phons) which
+ (append newenv
+ (list (car phons)
+ ((find-phoneme (cadr phons) formants) which))))))
+
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (car-sin (make-oscil 0))
+ (car-cos (make-oscil 0 :initial-phase (/ pi 2.0)))
+ (frq-ratio (/ spacing-freq freq))
(fs (length formant-amps))
- (evens (make-vector fs))
- (odds (make-vector fs))
- (amps (make-vct fs))
- (indices (make-vct fs))
- (frmfs (make-vector fs))
- (ampf (make-env ampfun :scaler amp :duration dur))
(freqf (make-env freqfun :duration dur :scaler (* freqscl freq) :offset freq))
- (frq 0.0)
- (carrier 0.0)
- (frm 0.0)
- (frm-int 0)
- (frm0 0.0)
- (even-amp 0.0)
- (odd-amp 0.0)
- (even-freq 0.0)
- (odd-freq 0.0)
- (sum 0.0)
- (loc (make-locsig deg 1.0 pcrev))
- (per-vib (make-triangle-wave :frequency 6 :amplitude (* freq vibscl)))
- (ran-vib (make-rand-interp :frequency 20 :amplitude (* freq .5 vibscl))))
- (do ((i 0 (+ i 1)))
- ((= i fs))
- (let ((amp (list-ref formant-amps i))
- (index (list-ref formant-indices i)))
- (set! (evens i) (make-oscil 0))
- (set! (odds i) (make-oscil 0))
- (set! (amps i) amp)
- (set! (indices i) index)
- (set! (frmfs i) (make-env (vox-fun phonemes i) :duration dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (set! frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
- (set! carrier (oscil car-os (hz->radians frq)))
- (set! sum 0.0)
- (do ((k 0 (+ 1 k))) ((= k fs))
- (set! frm (env (frmfs k)))
- (set! frm0 (/ frm frq))
- (set! frm-int (floor frm0))
- (if (even? frm-int)
- (begin
- (set! even-freq (hz->radians (* frm-int frq)))
- (set! odd-freq (hz->radians (* (+ frm-int 1) frq)))
- (set! odd-amp (- frm0 frm-int))
- (set! even-amp (- 1.0 odd-amp)))
- (begin
- (set! odd-freq (hz->radians (* frm-int frq)))
- (set! even-freq (hz->radians (* (+ frm-int 1) frq)))
- (set! even-amp (- frm0 frm-int))
- (set! odd-amp (- 1.0 even-amp))))
- (set! sum (+ sum
- (* (amps k)
- (+ (* even-amp (oscil (evens k)
- (+ even-freq (* (indices k) carrier))))
- (* odd-amp (oscil (odds k)
- (+ odd-freq (* (indices k) carrier)))))))))
- (locsig loc i (* (env ampf) sum)))))))
-
-;;; (vox 0 2 170 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 E 25 AE 35 ER 65 ER 75 I 100 UH) '(.8 .15 .05) '(.005 .0125 .025) .05 .1)
-;;; (vox 0 2 300 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .15 .05) '(.05 .0125 .025) .02 .1)
-;;; (vox 0 5 600 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .16 .04) '(.01 .01 .1) .01 .1)
-
+ (per-vib (make-triangle-wave :frequency 6.0 :amplitude (* freq .1)))
+ (ran-vib (make-rand-interp :frequency 20.0 :amplitude (* freq .05))))
+ (let ((sin-evens (make-vector fs))
+ (cos-evens (make-vector fs))
+ (sin-odds (make-vector fs))
+ (cos-odds (make-vector fs))
+ (ampfs (make-vector fs))
+ (frmfs (make-vector fs))
+ (sin-coeffs (make-vector fs))
+ (cos-coeffs (make-vector fs))
+ (frq 0.0) (rfrq 0.0) (carcos 0.0) (carsin 0.0)
+ (frac 0.0) (fracf 0.0) (frm0 0.0) (frm-int 0) (fax 0.0) (yfax 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i fs))
+ (let ((shape (normalize-partials (formant-shapes i))))
+ (set! (sin-evens i) (make-oscil 0))
+ (set! (sin-odds i) (make-oscil 0))
+ (set! (cos-evens i) (make-oscil 0 :initial-phase (/ pi 2.0)))
+ (set! (cos-odds i) (make-oscil 0 :initial-phase (/ pi 2.0)))
+ (set! (ampfs i) (make-env ampfun :scaler (* amp (formant-amps i)) :duration dur))
+ (set! (cos-coeffs i) (partials->polynomial shape mus-chebyshev-first-kind))
+ (set! (sin-coeffs i) (partials->polynomial shape mus-chebyshev-second-kind))
+ (set! (frmfs i) (make-env (vox-fun phonemes i ()) :duration dur))))
+
+ (if (= fs 3) ; unroll the inner loop in the most common case
+ (let ((frmfs0 (frmfs 0)) (frmfs1 (frmfs 1)) (frmfs2 (frmfs 2))
+ (ampfs0 (ampfs 0)) (ampfs1 (ampfs 1)) (ampfs2 (ampfs 2))
+ (sin-evens0 (sin-evens 0)) (sin-evens1 (sin-evens 1)) (sin-evens2 (sin-evens 2))
+ (sin-odds0 (sin-odds 0)) (sin-odds1 (sin-odds 1)) (sin-odds2 (sin-odds 2))
+ (cos-evens0 (cos-evens 0)) (cos-evens1 (cos-evens 1)) (cos-evens2 (cos-evens 2))
+ (cos-odds0 (cos-odds 0)) (cos-odds1 (cos-odds 1)) (cos-odds2 (cos-odds 2))
+ (cos-coeffs0 (cos-coeffs 0)) (cos-coeffs1 (cos-coeffs 1)) (cos-coeffs2 (cos-coeffs 2))
+ (sin-coeffs0 (sin-coeffs 0)) (sin-coeffs1 (sin-coeffs 1)) (sin-coeffs2 (sin-coeffs 2)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (set! frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
+ (set! rfrq (hz->radians frq))
+ (set! carsin (oscil car-sin (* rfrq frq-ratio)))
+ (set! carcos (oscil car-cos (* rfrq frq-ratio)))
+
+ (set! frm0 (/ (env frmfs0) frq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (* frm-int rfrq))
+ (set! fax (polynomial cos-coeffs0 carcos))
+ (set! yfax (* carsin (polynomial sin-coeffs0 carcos)))
+ (if (even? frm-int)
+ (outa i (* (env ampfs0)
+ (+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens0 fracf)) (* fax (oscil cos-evens0 fracf))))
+ (* frac (- (* yfax (oscil sin-odds0 (+ fracf rfrq))) (* fax (oscil cos-odds0 (+ fracf rfrq))))))))
+ (outa i (* (env ampfs0)
+ (+ (* frac (- (* yfax (oscil sin-evens0 (+ fracf rfrq))) (* fax (oscil cos-evens0 (+ fracf rfrq)))))
+ (* (- 1.0 frac) (- (* yfax (oscil sin-odds0 fracf)) (* fax (oscil cos-odds0 fracf))))))))
+
+ (set! frm0 (/ (env frmfs1) frq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (* frm-int rfrq))
+ (set! fax (polynomial cos-coeffs1 carcos))
+ (set! yfax (* carsin (polynomial sin-coeffs1 carcos)))
+ (if (even? frm-int)
+ (outa i (* (env ampfs1)
+ (+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens1 fracf)) (* fax (oscil cos-evens1 fracf))))
+ (* frac (- (* yfax (oscil sin-odds1 (+ fracf rfrq))) (* fax (oscil cos-odds1 (+ fracf rfrq))))))))
+ (outa i (* (env ampfs1)
+ (+ (* frac (- (* yfax (oscil sin-evens1 (+ fracf rfrq))) (* fax (oscil cos-evens1 (+ fracf rfrq)))))
+ (* (- 1.0 frac) (- (* yfax (oscil sin-odds1 fracf)) (* fax (oscil cos-odds1 fracf))))))))
+
+ (set! frm0 (/ (env frmfs2) frq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (* frm-int rfrq))
+ (set! fax (polynomial cos-coeffs2 carcos))
+ (set! yfax (* carsin (polynomial sin-coeffs2 carcos)))
+ (if (even? frm-int)
+ (outa i (* (env ampfs2)
+ (+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens2 fracf)) (* fax (oscil cos-evens2 fracf))))
+ (* frac (- (* yfax (oscil sin-odds2 (+ fracf rfrq))) (* fax (oscil cos-odds2 (+ fracf rfrq))))))))
+ (outa i (* (env ampfs2)
+ (+ (* frac (- (* yfax (oscil sin-evens2 (+ fracf rfrq))) (* fax (oscil cos-evens2 (+ fracf rfrq)))))
+ (* (- 1.0 frac) (- (* yfax (oscil sin-odds2 fracf)) (* fax (oscil cos-odds2 fracf))))))))))
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (set! frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
+ (set! rfrq (hz->radians frq))
+ (set! carsin (oscil car-sin (* rfrq frq-ratio)))
+ (set! carcos (oscil car-cos (* rfrq frq-ratio)))
+ (do ((k 0 (+ k 1)))
+ ((= k fs))
+ (set! frm0 (/ (env (vector-ref frmfs k)) frq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (* frm-int rfrq))
+ (set! fax (polynomial (vector-ref cos-coeffs k) carcos))
+ (set! yfax (* carsin (polynomial (vector-ref sin-coeffs k) carcos)))
+ (if (even? frm-int)
+ (outa i (* (env (vector-ref ampfs k))
+ (+ (* (- 1.0 frac) (- (* yfax (oscil (vector-ref sin-evens k) fracf))
+ (* fax (oscil (vector-ref cos-evens k) fracf))))
+ (* frac (- (* yfax (oscil (vector-ref sin-odds k) (+ fracf rfrq)))
+ (* fax (oscil (vector-ref cos-odds k) (+ fracf rfrq))))))))
+ (outa i (* (env (vector-ref ampfs k))
+ (+ (* frac (- (* yfax (oscil (vector-ref sin-evens k) (+ fracf rfrq)))
+ (* fax (oscil (vector-ref cos-evens k) (+ fracf rfrq)))))
+ (* (- 1.0 frac) (- (* yfax (oscil (vector-ref sin-odds k) fracf))
+ (* fax (oscil (vector-ref cos-odds k) fracf))))))))))))))
+
+;;; (with-sound (:statistics #t) (pqw-vox 0 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 0) 0 '(0 L 100 L) '(.33 .33 .33) '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5))))
+;;; (a test to see if the cancellation is working -- sounds like a mosquito)
+
+;;; (with-sound () (pqw-vox 0 2 200 200 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5))))
+;;; (with-sound () (pqw-vox 0 2 100 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5))))
+;;; (with-sound () (pqw-vox 0 2 200 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 4 .1) (1 1 2 .1 4 .05))))
+;;; (with-sound () (pqw-vox 0 2 100 414 .2 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 OW 50 E 100 ER) '(.8 .15 .05) '((1 1 2 .5 3 .1 4 .01) (1 1 4 .1) (1 1 2 .1 4 .05))))
-;;; -------- FOF example
+
+
+;;; -------- FOF
(definstrument (fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 (ae '(0 0 25 1 75 1 100 0)) ve)
"(fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 (ampenv '(0 0 25 1 75 1 100 0)) vibenv) produces FOF
synthesis: (fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)"
- (let* ((two-pi (* 2 pi))
- (start (seconds->samples beg))
- (len (seconds->samples dur))
- (end (+ start len))
- (ampf (make-env ae :scaler amp :duration dur))
- (vibf (make-env (or ve (list 0 1 100 1)) :scaler vib :duration dur))
- (frq0 (hz->radians f0))
- (frq1 (hz->radians f1))
- (frq2 (hz->radians f2))
- (foflen (if (= (mus-srate) 22050) 100 200))
- (vibr (make-oscil 6))
- (win-freq (/ two-pi foflen))
- (wt0 (make-wave-train :size foflen :frequency frq))
- (foftab (mus-data wt0)))
- (do ((i 0 (+ i 1)))
- ((= i foflen))
- (set! (foftab i) (* (+ (* a0 (sin (* i frq0)))
- (* a1 (sin (* i frq1)))
- (* a2 (sin (* i frq2))))
- .5 (- 1.0 (cos (* i win-freq))))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* (env ampf)
- (wave-train wt0 (* (env vibf)
- (oscil vibr)))))))))
+ (let ((foflen (if (= *clm-srate* 22050) 100 200)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (ampf (make-env ae :scaler amp :duration dur))
+ (vibf (make-env (or ve (list 0 1 100 1)) :scaler vib :duration dur))
+ (frq0 (hz->radians f0))
+ (frq1 (hz->radians f1))
+ (frq2 (hz->radians f2))
+ (vibr (make-oscil 6))
+ (win-freq (/ (* 2.0 pi) foflen))
+ (wt0 (make-wave-train :size foflen :frequency frq)))
+ (let ((foftab (mus-data wt0)))
+ (do ((i 0 (+ i 1)))
+ ((= i foflen))
+ (float-vector-set! foftab i (* (+ (* a0 (sin (* i frq0)))
+ (* a1 (sin (* i frq1)))
+ (* a2 (sin (* i frq2))))
+ .5 (- 1.0 (cos (* i win-freq)))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env ampf)
+ (wave-train wt0 (* (env vibf)
+ (oscil vibr)))))))))
@@ -247,174 +461,56 @@ synthesis: (fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)"
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
- (let* ((beg (seconds->samples startime))
- (end (+ beg (seconds->samples dur)))
- (loc (make-locsig degree distance reverb-amount))
- (per-vib-f (make-env (stretch-envelope '(0 1 25 .1 75 0 100 0)
- 25 (min (* 100 (/ vibatt dur)) 45)
- 75 (max (* 100 (- 1.0 (/ vibdec dur))) 55))
- :scaler vibamp :duration dur))
- (ran-vib (make-rand-interp :frequency rvibfrq :amplitude rvibamp))
- (per-vib (make-oscil vibfrq))
- (dec-01 (max 75 (* 100 (- 1.0 (/ .01 dur)))))
- (frq-f (make-env (stretch-envelope '(0 0 25 1 75 1 100 0)
- 25 (min 25 (* 100 (/ frqatt dur)))
- 75 dec-01)
- :scaler frqskw :duration dur))
- (ampattpt1 (min 25 (* 100 (/ ampatt1 dur))))
- (ampdecpt1 (max 75 (* 100 (- 1.0 (/ ampdec1 dur)))))
- (ampattpt2 (min 25 (* 100 (/ ampatt2 dur))))
- (ampdecpt2 (max 75 (* 100 (- 1.0 (/ ampdec2 dur)))))
-
- (mod1-f (make-env (stretch-envelope indenv1 25 ampattpt1 75 dec-01)
- :scaler (* modfrq1 (- modind12 modind11)) :duration dur))
- (mod1 (make-oscil 0.0))
- (car1 (make-oscil 0.0))
- ;; set frequency to zero here because it is handled multiplicatively below
- (car1-f (make-env (stretch-envelope ampenv1 25 ampattpt1 75 ampdecpt1)
- :scaler amp1 :duration dur))
-
- (mod2-f (make-env (stretch-envelope indenv2 25 ampattpt2 75 dec-01)
- :scaler (* modfrq2 (- modind22 modind21)) :duration dur))
- (mod2 (make-oscil 0.0))
- (car2 (make-oscil 0.0))
- (car2-f (make-env (stretch-envelope ampenv2 25 ampattpt2 75 ampdecpt2)
- :scaler amp2 :duration dur)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((frq-change (hz->radians (* (+ 1.0 (rand-interp ran-vib))
- (+ 1.0 (* (env per-vib-f) (oscil per-vib)))
- (+ 1.0 (env frq-f))))))
- (locsig loc i (+ (* (env car1-f)
- (oscil car1 (* frq-change
- (+ frq1 (* (env mod1-f)
- (oscil mod1 (* modfrq1 frq-change)))))))
- (* (env car2-f)
- (oscil car2 (* frq-change
- (+ frq2 (* (env mod2-f)
- (oscil mod2 (* modfrq2 frq-change))))))))))))))
-
-
-
-
-;;; -------- PQWVOX
-;;; translation of CLM pqwvox.ins (itself translated from MUS10 of MLB's waveshaping voice instrument (using phase quadrature waveshaping))
-
-(definstrument (pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes)
- "(pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes) produces
-vocal sounds using phase quadrature waveshaping"
-
- (define formants
- '((I 390 1990 2550) (E 530 1840 2480) (AE 660 1720 2410)
- (UH 520 1190 2390) (A 730 1090 2440) (OW 570 840 2410)
- (U 440 1020 2240) (OO 300 870 2240) (ER 490 1350 1690)
- (W 300 610 2200) (LL 380 880 2575) (R 420 1300 1600)
- (Y 300 2200 3065) (EE 260 3500 3800) (LH 280 1450 1600)
- (L 300 1300 3000) (I2 350 2300 3340) (B 200 800 1750)
- (D 300 1700 2600) (G 250 1350 2000) (M 280 900 2200)
- (N 280 1700 2600) (NG 280 2300 2750) (P 300 800 1750)
- (T 200 1700 2600) (K 350 1350 2000) (F 175 900 4400)
- (TH 200 1400 2200) (S 200 1300 2500) (SH 200 1800 2000)
- (V 175 1100 2400) (THE 200 1600 2200)(Z 200 1300 2500)
- (ZH 175 1800 2000) (ZZ 900 2400 3800) (VV 565 1045 2400)))
- ;;formant center frequencies for a male speaker
-
- (define (find-phoneme phoneme form)
- (if (eq? (car (car form)) phoneme)
- (cdr (car form))
- (find-phoneme phoneme (cdr form))))
-
- (define (vox-fun phons which newenv)
- ;; make an envelope from which-th entry of phoneme data referred to by phons
- (if (null? phons)
- newenv
- (vox-fun (cddr phons) which
- (append newenv
- (list (car phons)
- (list-ref (find-phoneme (cadr phons) formants) which))))))
-
- (let* ((start (seconds->samples beg))
- (samps (seconds->samples dur))
- (end (+ start samps))
- (car-sin (make-oscil 0))
- (car-cos (make-oscil 0 :initial-phase (/ pi 2.0)))
- (frq-ratio (/ spacing-freq freq))
- (fs (length formant-amps))
- (sin-evens (make-vector fs))
- (cos-evens (make-vector fs))
- (sin-odds (make-vector fs))
- (cos-odds (make-vector fs))
- (amps (make-vector fs))
- (frmfs (make-vector fs))
- (sin-coeffs (make-vector fs))
- (cos-coeffs (make-vector fs))
- (ampf (make-env ampfun :scaler amp :duration dur))
- (freqf (make-env freqfun :duration dur :scaler (* freqscl freq) :offset freq))
- (per-vib (make-triangle-wave :frequency 6.0 :amplitude (* freq .1)))
- (ran-vib (make-rand-interp :frequency 20.0 :amplitude (* freq .05))))
- (do ((i 0 (+ i 1)))
- ((= i fs))
- (let* ((amp (list-ref formant-amps i))
- (fshape (list-ref formant-shapes i))
- (shape (normalize-partials fshape)))
- (set! (sin-evens i) (make-oscil 0))
- (set! (sin-odds i) (make-oscil 0))
- (set! (cos-evens i) (make-oscil 0 :initial-phase (/ pi 2.0)))
- (set! (cos-odds i) (make-oscil 0 :initial-phase (/ pi 2.0)))
- (set! (amps i) amp)
- (set! (cos-coeffs i) (partials->polynomial shape mus-chebyshev-first-kind))
- (set! (sin-coeffs i) (partials->polynomial shape mus-chebyshev-second-kind))
- (set! (frmfs i) (make-env (vox-fun phonemes i '()) :duration dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let* ((frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
- (frqscl (hz->radians (* frq frq-ratio)))
- (carsin (oscil car-sin frqscl))
- (carcos (oscil car-cos frqscl))
- (even-amp 0.0)
- (odd-amp 0.0)
- (even-freq 0.0)
- (odd-freq 0.0)
- (sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k fs))
- (let* ((frm (env (frmfs k)))
- (frm0 (/ frm frq))
- (frm-int (floor frm0)))
- (if (even? frm-int)
- (begin
- (set! even-freq (hz->radians (* frm-int frq)))
- (set! odd-freq (hz->radians (* (+ frm-int 1) frq)))
- (set! odd-amp (- frm0 frm-int))
- (set! even-amp (- 1.0 odd-amp)))
- (begin
- (set! odd-freq (hz->radians (* frm-int frq)))
- (set! even-freq (hz->radians (* (+ frm-int 1) frq)))
- (set! even-amp (- frm0 frm-int))
- (set! odd-amp (- 1.0 even-amp))))
- (let* ((fax (polynomial (cos-coeffs k) carcos))
- (yfax (* carsin (polynomial (sin-coeffs k) carcos))))
- (set! sum (+ sum (* (amps k)
- (+ (* even-amp (- (* yfax (oscil (sin-evens k) even-freq))
- (* fax (oscil (cos-evens k) even-freq))))
- (* odd-amp (- (* yfax (oscil (sin-odds k) odd-freq))
- (* fax (oscil (cos-odds k) odd-freq)))))))))))
- (outa i (* (env ampf) sum)))))))
-
-;;; (pqw-vox 0 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 0) 0 '(0 L 100 L) '(.33 .33 .33) '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5)))
-;;; (a test to see if the cancellation is working -- sounds like a mosquito)
-
-;;; (pqw-vox 0 2 200 200 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5)))
-;;; (pqw-vox 0 2 100 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5)))
-;;; (pqw-vox 0 2 200 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 4 .1) (1 1 2 .1 4 .05)))
-;;; (pqw-vox 0 2 100 414 .2 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 OW 50 E 100 ER) '(.8 .15 .05) '((1 1 2 .5 3 .1 4 .01) (1 1 4 .1) (1 1 2 .1 4 .05)))
+ (let ((dec-01 (max 75 (* 100 (- 1.0 (/ .01 dur))))))
+ (let ((beg (seconds->samples startime))
+ (end (seconds->samples (+ startime dur)))
+ (loc (make-locsig degree distance reverb-amount))
+ (per-vib-f (make-env (stretch-envelope '(0 1 25 .1 75 0 100 0)
+ 25 (min (* 100 (/ vibatt dur)) 45)
+ 75 (max (* 100 (- 1.0 (/ vibdec dur))) 55))
+ :scaler vibamp :duration dur))
+ (ran-vib (make-rand-interp :frequency rvibfrq :amplitude rvibamp))
+ (per-vib (make-oscil vibfrq))
+ (frq-f (make-env (stretch-envelope '(0 0 25 1 75 1 100 0)
+ 25 (min 25 (* 100 (/ frqatt dur)))
+ 75 dec-01)
+ :scaler frqskw :offset 1.0 :duration dur))
+ (ampattpt1 (min 25 (* 100 (/ ampatt1 dur))))
+ (ampdecpt1 (max 75 (* 100 (- 1.0 (/ ampdec1 dur)))))
+ (ampattpt2 (min 25 (* 100 (/ ampatt2 dur))))
+ (ampdecpt2 (max 75 (* 100 (- 1.0 (/ ampdec2 dur))))))
+ (let ((mod1-f (make-env (stretch-envelope indenv1 25 ampattpt1 75 dec-01)
+ :scaler (* modfrq1 (- modind12 modind11)) :duration dur))
+ (mod1 (make-oscil 0.0))
+ (car1 (make-oscil 0.0))
+ ;; set frequency to zero here because it is handled multiplicatively below
+ (car1-f (make-env (stretch-envelope ampenv1 25 ampattpt1 75 ampdecpt1)
+ :scaler amp1 :duration dur))
+
+ (mod2-f (make-env (stretch-envelope indenv2 25 ampattpt2 75 dec-01)
+ :scaler (* modfrq2 (- modind22 modind21)) :duration dur))
+ (mod2 (make-oscil 0.0))
+ (car2 (make-oscil 0.0))
+ (car2-f (make-env (stretch-envelope ampenv2 25 ampattpt2 75 ampdecpt2)
+ :scaler amp2 :duration dur)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((frq-change (hz->radians (* (+ 1.0 (rand-interp ran-vib))
+ (+ 1.0 (* (env per-vib-f) (oscil per-vib)))
+ (env frq-f)))))
+ (locsig loc i (+ (* (env car1-f)
+ (oscil car1 (* frq-change
+ (+ frq1 (* (env mod1-f)
+ (oscil mod1 (* modfrq1 frq-change)))))))
+ (* (env car2-f)
+ (oscil car2 (* frq-change
+ (+ frq2 (* (env mod2-f)
+ (oscil mod2 (* modfrq2 frq-change)))))))))))))))
;;; -------- STEREO-FLUTE
+
(definstrument (stereo-flute start dur freq flow
-
(flow-envelope '(0 1 100 1))
(decay 0.01) ; additional time for instrument to decay
(noise 0.0356)
@@ -435,97 +531,98 @@ vocal sounds using phase quadrature waveshaping"
is a physical model of a flute:
(stereo-flute 0 1 440 .55 :flow-envelope '(0 0 1 1 2 1 3 0))"
- (let* ((current-excitation 0.0)
- (current-difference 0.0)
- (current-flow 0.0)
- (out-sig 0.0)
- (tap-sig 0.0)
- (previous-out-sig 0.0)
- (previous-tap-sig 0.0)
- (dc-blocked-a 0.0)
- (dc-blocked-b 0.0)
- (previous-dc-blocked-a 0.0)
- (previous-dc-blocked-b 0.0)
- (delay-sig 0.0)
- (emb-sig 0.0)
- (beg (seconds->samples start))
- (len (seconds->samples dur))
- (end (+ beg len))
- (flowf (make-env flow-envelope
- :scaler flow
- :duration (- dur decay)))
- (periodic-vibrato (make-oscil vib-rate))
- (random-vibrato (make-rand-interp :frequency ran-rate))
- (breath (make-rand :frequency (/ (mus-srate) 2) :amplitude 1))
- (period-samples (floor (/ (mus-srate) freq)))
- (embouchure-samples (floor (* embouchure-size period-samples)))
- (embouchure (make-delay embouchure-samples :initial-element 0.0))
- (bore (make-delay period-samples))
- (offset (floor (* period-samples offset-pos)))
- (reflection-lowpass-filter (make-one-pole a0 b1)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (set! delay-sig (delay bore out-sig))
- (set! emb-sig (delay embouchure current-difference))
- (set! current-flow (+ (* vib-amount (oscil periodic-vibrato))
- (* ran-amount (rand-interp random-vibrato))
- (env flowf)))
- (set! current-difference
- (+ (+ current-flow (* noise (* current-flow (rand breath))))
- (* fbk-scl1 delay-sig)))
- (set! current-excitation (- emb-sig (* emb-sig emb-sig emb-sig)))
- (set! out-sig (one-pole reflection-lowpass-filter
- (+ current-excitation (* fbk-scl2 delay-sig))))
- (set! tap-sig (tap bore offset))
- ;; NB the DC blocker is not in the cicuit. It is applied to the out-sig
- ;; but the result is not fed back into the system.
- (set! dc-blocked-a (+ (- out-sig previous-out-sig) (* 0.995 previous-dc-blocked-a)))
- (set! dc-blocked-b (+ (- tap-sig previous-tap-sig) (* 0.995 previous-dc-blocked-b)))
- (outa i (* out-scl dc-blocked-a))
- (outb i (* out-scl dc-blocked-b))
- (set! previous-out-sig out-sig)
- (set! previous-dc-blocked-a dc-blocked-a)
- (set! previous-tap-sig tap-sig)
- (set! previous-dc-blocked-b dc-blocked-b)))))
+ (let ((period-samples (floor (/ *clm-srate* freq))))
+ (let ((embouchure-samples (floor (* embouchure-size period-samples))))
+ (let ((current-excitation 0.0)
+ (current-difference 0.0)
+ (current-flow 0.0)
+ (out-sig 0.0)
+ (tap-sig 0.0)
+ (previous-out-sig 0.0)
+ (previous-tap-sig 0.0)
+ (dc-blocked-a 0.0)
+ (dc-blocked-b 0.0)
+ (previous-dc-blocked-a 0.0)
+ (previous-dc-blocked-b 0.0)
+ (delay-sig 0.0)
+ (emb-sig 0.0)
+ (beg (seconds->samples start))
+ (end (seconds->samples (+ start dur)))
+ (flowf (make-env flow-envelope
+ :scaler flow
+ :duration (- dur decay)))
+ (periodic-vibrato (make-oscil vib-rate))
+ (random-vibrato (make-rand-interp :frequency ran-rate :amplitude ran-amount))
+ (breath (make-rand :frequency (/ *clm-srate* 2) :amplitude noise))
+
+
+ (embouchure (make-delay embouchure-samples :initial-element 0.0))
+ (bore (make-delay period-samples))
+ (offset (floor (* period-samples offset-pos)))
+ (reflection-lowpass-filter (make-one-pole a0 b1)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (set! delay-sig (delay bore out-sig))
+ (set! emb-sig (delay embouchure current-difference))
+ (set! current-flow (+ (* vib-amount (oscil periodic-vibrato))
+ (rand-interp random-vibrato)
+ (env flowf)))
+ (set! current-difference
+ (+ current-flow
+ (* current-flow (rand breath))
+ (* fbk-scl1 delay-sig)))
+ (set! current-excitation (- emb-sig (* emb-sig emb-sig emb-sig)))
+ (set! out-sig (one-pole reflection-lowpass-filter
+ (+ current-excitation (* fbk-scl2 delay-sig))))
+ (set! tap-sig (tap bore offset))
+ ;; NB the DC blocker is not in the cicuit. It is applied to the out-sig
+ ;; but the result is not fed back into the system.
+ (set! dc-blocked-a (+ (- out-sig previous-out-sig) (* 0.995 previous-dc-blocked-a)))
+ (set! dc-blocked-b (+ (- tap-sig previous-tap-sig) (* 0.995 previous-dc-blocked-b)))
+ (outa i (* out-scl dc-blocked-a))
+ (outb i (* out-scl dc-blocked-b))
+ (set! previous-out-sig out-sig)
+ (set! previous-dc-blocked-a dc-blocked-a)
+ (set! previous-tap-sig tap-sig)
+ (set! previous-dc-blocked-b dc-blocked-b))))))
;;; -------- FM-BELL
(definstrument (fm-bell startime dur frequency amplitude amp-env index-env index)
"(fm-bell startime dur frequency amplitude amp-env index-env index) mixes in one fm bell note"
- (let* ((beg (seconds->samples startime))
- (len (seconds->samples dur))
- (end (+ beg len))
- (fmInd1 (hz->radians (* 32.0 frequency)))
- (fmInd2 (hz->radians (* 4.0 (- 8.0 (/ frequency 50.0)))))
- (fmInd3 (* fmInd2 0.705 (- 1.4 (/ frequency 250.0))))
- (fmInd4 (hz->radians (* 32.0 (- 20 (/ frequency 20)))))
- (mod1 (make-oscil (* frequency 2)))
- (mod2 (make-oscil (* frequency 1.41)))
- (mod3 (make-oscil (* frequency 2.82)))
- (mod4 (make-oscil (* frequency 2.4)))
- (car1 (make-oscil frequency))
- (car2 (make-oscil frequency))
- (car3 (make-oscil (* frequency 2.4)))
- (indf (make-env (or index-env
- (list 0 1 2 1.1 25 .75 75 .5 100 .2))
- (or index 1.0) dur))
- (ampf (make-env (or amp-env
- (list 0 0 .1 1 10 .6 25 .3 50 .15 90 .1 100 0))
- amplitude dur)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((fmenv (env indf)))
- (outa i (* (env ampf)
- (+ (oscil car1 (* fmenv fmInd1 (oscil mod1)))
- (* .15 (oscil car2 (* fmenv
- (+ (* fmInd2 (oscil mod2))
- (* fmInd3
- (oscil mod3))))))
- (* .15 (oscil car3 (* fmenv
- fmInd4
- (oscil mod4))))))))))))
+ (let ((fmInd2 (hz->radians (* 4.0 (- 8.0 (/ frequency 50.0))))))
+ (let ((beg (seconds->samples startime))
+ ;(len (seconds->samples dur))
+ (end (seconds->samples (+ startime dur)))
+ (fmInd1 (hz->radians (* 32.0 frequency)))
+
+ (fmInd3 (* fmInd2 0.705 (- 1.4 (/ frequency 250.0))))
+ (fmInd4 (hz->radians (* 32.0 (- 20 (/ frequency 20)))))
+ (mod1 (make-oscil (* frequency 2)))
+ (mod2 (make-oscil (* frequency 1.41)))
+ (mod3 (make-oscil (* frequency 2.82)))
+ (mod4 (make-oscil (* frequency 2.4)))
+ (car1 (make-oscil frequency))
+ (car2 (make-oscil frequency))
+ (car3 (make-oscil (* frequency 2.4)))
+ (indf (make-env (or index-env
+ (list 0 1 2 1.1 25 .75 75 .5 100 .2))
+ (or index 1.0) dur))
+ (ampf (make-env (or amp-env
+ (list 0 0 .1 1 10 .6 25 .3 50 .15 90 .1 100 0))
+ amplitude dur)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((fmenv (env indf)))
+ (outa i (* (env ampf)
+ (+ (oscil car1 (* fmenv fmInd1 (oscil mod1)))
+ (* .15 (oscil car2 (* fmenv
+ (+ (* fmInd2 (oscil mod2))
+ (* fmInd3
+ (oscil mod3))))))
+ (* .15 (oscil car3 (* fmenv
+ fmInd4
+ (oscil mod4))))))))))))
;(define fbell '(0 1 2 1.1000 25 .7500 75 .5000 100 .2000 ))
@@ -540,8 +637,8 @@ is a physical model of a flute:
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
- (let* ((beg (seconds->samples startime))
- (end (+ beg (seconds->samples dur)))
+ (let ((beg (seconds->samples startime))
+ (end (seconds->samples (+ startime dur)))
(loc (make-locsig degree distance reverb-amount))
(carrier (make-oscil frequency))
(fm1-osc (make-oscil mod-freq))
@@ -550,14 +647,13 @@ is a physical model of a flute:
(indf (make-env mod-index-env :scaler (hz->radians mod-index) :duration dur))
(modfrqf (make-env mod-freq-env :scaler (hz->radians mod-skew) :duration dur))
(fm2-amp (hz->radians (* fm-index fm-ratio frequency))))
- (run
(do ((i beg (+ i 1)))
((= i end))
- (let* ((garble-in (* (env indf)
- (oscil fm1-osc (env modfrqf))))
- (garble-out (* fm2-amp (oscil fm2-osc garble-in))))
+ (let ((garble-in (* (env indf)
+ (oscil fm1-osc (env modfrqf)))))
(locsig loc i (* (env ampf)
- (oscil carrier (+ garble-out garble-in)))))))))
+ (oscil carrier (+ (* fm2-amp (oscil fm2-osc garble-in))
+ garble-in))))))))
#|
(with-sound (:srate 22050)
@@ -579,54 +675,53 @@ is a physical model of a flute:
;;; Jan Mattox's fm drum:
(definstrument (fm-drum start-time duration frequency amplitude index
- :optional (high #f) (degree 0.0) (distance 1.0) (reverb-amount 0.01))
- (let* ((beg (seconds->samples start-time))
- (end (+ beg (seconds->samples duration)))
- ;; many of the following variables were originally passed as arguments
- (casrat (if high 8.525 3.515))
- (fmrat (if high 3.414 1.414))
- (glsfun '(0 0 25 0 75 1 100 1))
- (glsf (make-env glsfun :scaler (if high (hz->radians 66) 0.0) :duration duration))
- (ampfun '(0 0 3 .05 5 .2 7 .8 8 .95 10 1.0 12 .95 20 .3 30 .1 100 0))
- (atdrpt (* 100 (/ (if high .01 .015) duration)))
- (ampf (make-env (stretch-envelope ampfun
- 10 atdrpt
- 15 (max (+ atdrpt 1)
- (- 100 (* 100 (/ (- duration .2) duration)))))
- :scaler amplitude :duration duration))
- (indxfun '(0 0 5 .014 10 .033 15 .061 20 .099
- 25 .153 30 .228 35 .332 40 .477
- 45 .681 50 .964 55 .681 60 .478 65 .332
- 70 .228 75 .153 80 .099 85 .061
- 90 .033 95 .0141 100 0))
- (indxpt (- 100 (* 100 (/ (- duration .1) duration))))
- (divindxf (stretch-envelope indxfun 50 atdrpt 65 indxpt))
- (indxf (make-env divindxf :scaler (min (hz->radians (* index fmrat frequency)) pi) :duration duration))
- (mindxf (make-env divindxf :scaler (min (hz->radians (* index casrat frequency)) pi) :duration duration))
- (devf (make-env (stretch-envelope ampfun
- 10 atdrpt
- 90 (max (+ atdrpt 1)
- (- 100 (* 100 (/ (- duration .05) duration)))))
- :scaler (min pi (hz->radians 7000)) :duration duration))
- (loc (make-locsig degree distance reverb-amount))
- (rn (make-rand :frequency 7000 :amplitude 1.0))
- (carrier (make-oscil frequency))
- (fmosc (make-oscil (* frequency fmrat)))
- (cascade (make-oscil (* frequency casrat))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((gls (env glsf)))
- (locsig loc i (* (env ampf)
- (oscil carrier
- (+ gls
- (* (env indxf)
- (oscil fmosc
- (+ (* gls fmrat)
- (* (env mindxf)
- (oscil cascade
- (+ (* gls casrat)
- (* (env devf) (rand rn)))))))))))))))))
+ high (degree 0.0) (distance 1.0) (reverb-amount 0.01))
+ (let (;; many of the following variables were originally passed as arguments
+ (casrat (if high 8.525 3.515))
+ (fmrat (if high 3.414 1.414))
+ (glsfun '(0 0 25 0 75 1 100 1))
+ (indxfun '(0 0 5 .014 10 .033 15 .061 20 .099
+ 25 .153 30 .228 35 .332 40 .477
+ 45 .681 50 .964 55 .681 60 .478 65 .332
+ 70 .228 75 .153 80 .099 85 .061
+ 90 .033 95 .0141 100 0))
+ (indxpt (- 100 (* 100 (/ (- duration .1) duration))))
+ (ampfun '(0 0 3 .05 5 .2 7 .8 8 .95 10 1.0 12 .95 20 .3 30 .1 100 0))
+ (atdrpt (* 100 (/ (if high .01 .015) duration))))
+ (let ((divindxf (stretch-envelope indxfun 50 atdrpt 65 indxpt)))
+ (let ((beg (seconds->samples start-time))
+ (end (seconds->samples (+ start-time duration)))
+ (glsf (make-env glsfun :scaler (if high (hz->radians 66) 0.0) :duration duration))
+ (ampf (make-env (stretch-envelope ampfun
+ 10 atdrpt
+ 15 (max (+ atdrpt 1)
+ (- 100 (* 100 (/ (- duration .2) duration)))))
+ :scaler amplitude :duration duration))
+ (indxf (make-env divindxf :scaler (min (hz->radians (* index fmrat frequency)) pi) :duration duration))
+ (mindxf (make-env divindxf :scaler (min (hz->radians (* index casrat frequency)) pi) :duration duration))
+ (devf (make-env (stretch-envelope ampfun
+ 10 atdrpt
+ 90 (max (+ atdrpt 1)
+ (- 100 (* 100 (/ (- duration .05) duration)))))
+ :scaler (min pi (hz->radians 7000)) :duration duration))
+ (loc (make-locsig degree distance reverb-amount))
+ (rn (make-rand :frequency 7000 :amplitude 1.0))
+ (carrier (make-oscil frequency))
+ (fmosc (make-oscil (* frequency fmrat)))
+ (cascade (make-oscil (* frequency casrat))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((gls (env glsf)))
+ (locsig loc i (* (env ampf)
+ (oscil carrier
+ (+ gls
+ (* (env indxf)
+ (oscil fmosc
+ (+ (* gls fmrat)
+ (* (env mindxf)
+ (oscil cascade
+ (+ (* gls casrat)
+ (* (env devf) (rand rn))))))))))))))))))
#|
(with-sound ()
(fm-drum 0 1.5 55 .3 5 #f)
@@ -639,62 +734,60 @@ is a physical model of a flute:
(definstrument (gong start-time duration frequency amplitude
(degree 0.0) (distance 1.0) (reverb-amount 0.005))
- (let* ((mfq1 (* frequency 1.16))
- (mfq2 (* frequency 3.14))
- (mfq3 (* frequency 1.005))
- (indx01 (hz->radians (* .01 mfq1)))
- (indx11 (hz->radians (* .30 mfq1)))
- (indx02 (hz->radians (* .01 mfq2)))
- (indx12 (hz->radians (* .38 mfq2)))
- (indx03 (hz->radians (* .01 mfq3)))
- (indx13 (hz->radians (* .50 mfq3)))
- (atpt 5)
- (atdur (* 100 (/ .002 duration)))
- (expf '(0 0 3 1 15 .5 27 .25 50 .1 100 0))
- (rise '(0 0 15 .3 30 1.0 75 .5 100 0))
- (fmup '(0 0 75 1.0 98 1.0 100 0))
- (fmdwn '(0 0 2 1.0 100 0))
- (ampfun (make-env (stretch-envelope expf atpt atdur)
- :scaler amplitude :duration duration))
- (indxfun1 (make-env fmup :duration duration
- :scaler (- indx11 indx01) :offset indx01))
- (indxfun2 (make-env fmdwn :duration duration
- :scaler (- indx12 indx02) :offset indx02))
- (indxfun3 (make-env rise :duration duration
- :scaler (- indx13 indx03) :offset indx03))
- (loc (make-locsig degree distance reverb-amount))
- (carrier (make-oscil frequency))
- (mod1 (make-oscil mfq1))
- (mod2 (make-oscil mfq2))
- (mod3 (make-oscil mfq3))
- (beg (seconds->samples start-time))
- (end (+ beg (seconds->samples duration))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (locsig loc i (* (env ampfun)
- (oscil carrier (+ (* (env indxfun1) (oscil mod1))
- (* (env indxfun2) (oscil mod2))
- (* (env indxfun3) (oscil mod3))))))))))
+ (let ((mfq1 (* frequency 1.16))
+ (mfq2 (* frequency 3.14))
+ (mfq3 (* frequency 1.005)))
+ (let ((indx01 (hz->radians (* .01 mfq1)))
+ (indx11 (hz->radians (* .30 mfq1)))
+ (indx02 (hz->radians (* .01 mfq2)))
+ (indx12 (hz->radians (* .38 mfq2)))
+ (indx03 (hz->radians (* .01 mfq3)))
+ (indx13 (hz->radians (* .50 mfq3)))
+ (atpt 5)
+ (atdur (* 100 (/ .002 duration)))
+ (expf '(0 0 3 1 15 .5 27 .25 50 .1 100 0))
+ (rise '(0 0 15 .3 30 1.0 75 .5 100 0))
+ (fmup '(0 0 75 1.0 98 1.0 100 0))
+ (fmdwn '(0 0 2 1.0 100 0)))
+ (let ((ampfun (make-env (stretch-envelope expf atpt atdur)
+ :scaler amplitude :duration duration))
+ (indxfun1 (make-env fmup :duration duration
+ :scaler (- indx11 indx01) :offset indx01))
+ (indxfun2 (make-env fmdwn :duration duration
+ :scaler (- indx12 indx02) :offset indx02))
+ (indxfun3 (make-env rise :duration duration
+ :scaler (- indx13 indx03) :offset indx03))
+ (loc (make-locsig degree distance reverb-amount))
+ (carrier (make-oscil frequency))
+ (mod1 (make-oscil mfq1))
+ (mod2 (make-oscil mfq2))
+ (mod3 (make-oscil mfq3))
+ (beg (seconds->samples start-time))
+ (end (seconds->samples (+ start-time duration))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (locsig loc i (* (env ampfun)
+ (oscil carrier (+ (* (env indxfun1) (oscil mod1))
+ (* (env indxfun2) (oscil mod2))
+ (* (env indxfun3) (oscil mod3)))))))))))
;;; (with-sound () (gong 0 3 261.61 .6))
(definstrument (attract beg dur amp c-1) ;c from 1 to 10 or so
;; by James McCartney, from CMJ vol 21 no 3 p 6
- (let* ((st (seconds->samples beg))
- (nd (+ st (seconds->samples dur)))
+ (let ((st (seconds->samples beg))
+ (nd (seconds->samples (+ beg dur)))
(c c-1) (a .2) (b .2) (dt .04)
- (scale (/ (* .5 amp) c))
+ (scale (/ (* .5 amp) c-1))
(x -1.0) (y 0.0) (z 0.0))
- (run
(do ((i st (+ i 1)))
((= i nd))
(let ((x1 (- x (* dt (+ y z)))))
(set! y (+ y (* dt (+ x (* a y)))))
(set! z (+ z (* dt (- (+ b (* x z)) (* c z)))))
(set! x x1)
- (outa i (* scale x)))))))
+ (outa i (* scale x))))))
;;; -------- PQW
@@ -705,34 +798,40 @@ is a physical model of a flute:
;; phase-quadrature waveshaping used to create asymmetric (i.e. single side-band) spectra.
;; The basic idea here is a variant of sin x sin y - cos x cos y = cos (x + y)
- (let* ((normalized-partials (normalize-partials partials))
+ (define (clip-env e)
+ (do ((x e (cddr x)))
+ ((null? x) e)
+ (if (> (cadr x) 1.0)
+ (list-set! x 1 1.0))))
+
+ (let ((normalized-partials (normalize-partials partials))
(spacing-cos (make-oscil spacing-freq :initial-phase (/ pi 2.0)))
(spacing-sin (make-oscil spacing-freq))
(carrier-cos (make-oscil carrier-freq :initial-phase (/ pi 2.0)))
- (carrier-sin (make-oscil carrier-freq))
- (sin-coeffs (partials->polynomial normalized-partials mus-chebyshev-second-kind))
- (cos-coeffs (partials->polynomial normalized-partials mus-chebyshev-first-kind))
- (amp-env (make-env ampfun :scaler amplitude :duration dur))
- (ind-env (make-env indexfun :duration dur))
- (loc (make-locsig degree distance reverb-amount))
- (r (/ carrier-freq spacing-freq))
- (tr (make-triangle-wave :frequency 5 :amplitude (hz->radians (* .005 spacing-freq))))
- (rn (make-rand-interp :frequency 12 :amplitude (hz->radians (* .005 spacing-freq))))
- (beg (seconds->samples start))
- (end (+ beg (seconds->samples dur))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let* ((vib (+ (triangle-wave tr) (rand-interp rn)))
- (ax (* (min 1.0 (env ind-env)) (oscil spacing-cos vib)))
- (fax (polynomial cos-coeffs ax))
- (yfax (* (oscil spacing-sin vib) (polynomial sin-coeffs ax))))
- (locsig loc i (* (env amp-env)
- (- (* (oscil carrier-sin (* vib r)) yfax)
- (* (oscil carrier-cos (* vib r)) fax)))))))))
-
-; (pqw 0 .5 200 1000 .2 '(0 0 25 1 100 0) '(0 1 100 0) '(2 .1 3 .3 6 .5))
-; to see the asymmetric spectrum most clearly, set the index function above to '(0 1 100 1)
+ (carrier-sin (make-oscil carrier-freq)))
+ (let ((sin-coeffs (partials->polynomial normalized-partials mus-chebyshev-second-kind))
+ (cos-coeffs (partials->polynomial normalized-partials mus-chebyshev-first-kind))
+ (amp-env (make-env ampfun :scaler amplitude :duration dur))
+ (ind-env (make-env (clip-env indexfun) :duration dur))
+ (loc (make-locsig degree distance reverb-amount))
+ (r (/ carrier-freq spacing-freq))
+ (tr (make-triangle-wave :frequency 5 :amplitude (hz->radians (* .005 spacing-freq))))
+ (rn (make-rand-interp :frequency 12 :amplitude (hz->radians (* .005 spacing-freq))))
+ (beg (seconds->samples start))
+ (end (seconds->samples (+ start dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let* ((vib (+ (triangle-wave tr) (rand-interp rn)))
+ (ax (* (env ind-env) (oscil spacing-cos vib))))
+ (locsig loc i (* (env amp-env)
+ (- (* (oscil carrier-sin (* vib r))
+ (oscil spacing-sin vib)
+ (polynomial sin-coeffs ax))
+ (* (oscil carrier-cos (* vib r))
+ (polynomial cos-coeffs ax))))))))))
+
+;; (with-sound () (pqw 0 .5 200 1000 .2 '(0 0 25 1 100 0) '(0 1 100 0) '(2 .1 3 .3 6 .5)))
+;; to see the asymmetric spectrum most clearly, set the index function above to '(0 1 100 1)
;;; taken from Perry Cook's stkv1.tar.Z (Synthesis Toolkit), but I was
@@ -741,143 +840,117 @@ is a physical model of a flute:
(definstrument (tubebell beg dur freq amp (base 32.0))
;; from Perry Cook's TubeBell.cpp
- (let* ((osc0 (make-oscil (* freq 0.995)))
+ (let ((osc0 (make-oscil (* freq 0.995)))
(osc1 (make-oscil (* freq 1.414 0.995)))
(osc2 (make-oscil (* freq 1.005)))
(osc3 (make-oscil (* freq 1.414)))
- (ampenv1 (make-env (list 0 0 .005 1 dur 0) :base base :duration dur))
- (ampenv2 (make-env (list 0 0 .001 1 dur 0) :base (* 2 base) :duration dur))
+ (ampenv1 (make-env (list 0 0 .005 1 dur 0) :base base :duration dur :scaler (* amp .5 .707)))
+ (ampenv2 (make-env (list 0 0 .001 1 dur 0) :base (* 2 base) :duration dur :scaler (* .5 amp)))
(ampmod (make-oscil 2.0))
- (g0 (* .5 amp .707))
- (g1 .203)
- (g2 (* .5 amp 1.0))
- (g3 .144)
(st (seconds->samples beg))
- (nd (+ st (seconds->samples dur))))
- (run
+ (nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (* (+ (* .007 (oscil ampmod)) .993)
- (+ (* g0 (env ampenv1) (oscil osc0 (* g1 (oscil osc1))))
- (* g2 (env ampenv2) (oscil osc2 (* g3 (oscil osc3)))))))))))
+ (+ (* (env ampenv1) (oscil osc0 (* .203 (oscil osc1))))
+ (* (env ampenv2) (oscil osc2 (* .144 (oscil osc3))))))))))
(definstrument (wurley beg dur freq amp)
;; from Perry Cook's Wurley.cpp
- (let* ((osc0 (make-oscil freq))
+ (let ((osc0 (make-oscil freq))
(osc1 (make-oscil (* freq 4.0)))
(osc2 (make-oscil 510.0))
(osc3 (make-oscil 510.0))
(ampmod (make-oscil 8.0))
(g0 (* .5 amp))
- (g1 .307)
- (g2 (* .5 amp .307))
- (g3 .117)
(ampenv (make-env '(0 0 1 1 9 1 10 0) :duration dur))
- (indenv (make-env (list 0 0 .001 1 .15 0 (max dur .16) 0) :duration dur))
- (resenv (make-env (list 0 0 .001 1 .25 0 (max dur .26) 0) :duration dur))
+ (indenv (make-env (list 0 0 .001 1 .15 0 (max dur .16) 0) :duration dur :scaler .117))
+ (resenv (make-env (list 0 0 .001 1 .25 0 (max dur .26) 0) :duration dur :scaler (* .5 .307 amp)))
(st (seconds->samples beg))
- (nd (+ st (seconds->samples dur))))
- (run
+ (nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (* (env ampenv)
(+ 1.0 (* .007 (oscil ampmod)))
- (+ (* g0 (oscil osc0 (* g1 (oscil osc1))))
- (* (env resenv) g2 (oscil osc2 (* g3 (env indenv) (oscil osc3)))))))))))
+ (+ (* g0 (oscil osc0 (* .307 (oscil osc1))))
+ (* (env resenv) (oscil osc2 (* (env indenv) (oscil osc3))))))))))
(definstrument (rhodey beg dur freq amp (base .5))
;; from Perry Cook's Rhodey.cpp
- (let* ((osc0 (make-oscil freq))
+ (let ((osc0 (make-oscil freq))
(osc1 (make-oscil (* freq 0.5)))
(osc2 (make-oscil freq))
(osc3 (make-oscil (* freq 15.0)))
- (ampenv1 (make-env (list 0 0 .005 1 dur 0) :base base :duration dur))
- (ampenv2 (make-env (list 0 0 .001 1 dur 0) :base (* base 1.5) :duration dur))
- (ampenv3 (make-env (list 0 0 .001 1 .25 0 (max dur .26) 0) :base (* base 4) :duration dur))
- (g0 (* .5 amp))
- (g1 .535)
- (g2 (* .5 amp))
- (g3 .109)
+ (ampenv1 (make-env (list 0 0 .005 1 dur 0) :base base :duration dur :scaler (* amp .5)))
+ (ampenv2 (make-env (list 0 0 .001 1 dur 0) :base (* base 1.5) :duration dur :scaler (* amp .5)))
+ (ampenv3 (make-env (list 0 0 .001 1 .25 0 (max dur .26) 0) :base (* base 4) :duration dur :scaler .109))
(st (seconds->samples beg))
- (nd (+ st (seconds->samples dur))))
- (run
+ (nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
- (outa i (+ (* g0 (env ampenv1) (oscil osc0 (* g1 (oscil osc1))))
- (* g2 (env ampenv2) (oscil osc2 (* (env ampenv3) g3 (oscil osc3))))))))))
+ (outa i (+ (* (env ampenv1) (oscil osc0 (* .535 (oscil osc1))))
+ (* (env ampenv2) (oscil osc2 (* (env ampenv3) (oscil osc3)))))))))
(definstrument (hammondoid beg dur freq amp)
;; from Perry Cook's BeeThree.cpp
- (let* ((osc0 (make-oscil (* freq 0.999)))
+ (let ((osc0 (make-oscil (* freq 0.999)))
(osc1 (make-oscil (* freq 1.997)))
(osc2 (make-oscil (* freq 3.006)))
(osc3 (make-oscil (* freq 6.009)))
(ampenv1 (make-env (list 0 0 .005 1 (- dur .008) 1 dur 0) :duration dur))
- (ampenv2 (make-env (list 0 0 .005 1 dur 0) :duration dur))
+ (ampenv2 (make-env (list 0 0 .005 1 dur 0) :duration dur :scaler (* .5 .75 amp)))
(g0 (* .25 .75 amp))
(g1 (* .25 .75 amp))
(g2 (* .5 amp))
- (g3 (* .5 .75 amp))
(st (seconds->samples beg))
- (nd (+ st (seconds->samples dur))))
- (run
+ (nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (+ (* (env ampenv1)
(+ (* g0 (oscil osc0))
(* g1 (oscil osc1))
(* g2 (oscil osc2))))
- (* (env ampenv2) g3 (oscil osc3))))))))
+ (* (env ampenv2) (oscil osc3)))))))
(definstrument (metal beg dur freq amp)
;; from Perry Cook's HeavyMtl.cpp
- (let* ((osc0 (make-oscil freq))
+ (let ((osc0 (make-oscil freq))
(osc1 (make-oscil (* freq 4.0 0.999)))
(osc2 (make-oscil (* freq 3.0 1.001)))
(osc3 (make-oscil (* freq 0.50 1.002)))
- (ampenv0 (make-env (list 0 0 .001 1 (- dur .002) 1 dur 0) :duration dur))
- (ampenv1 (make-env (list 0 0 .001 1 (- dur .011) 1 dur 0) :duration dur))
- (ampenv2 (make-env (list 0 0 .01 1 (- dur .015) 1 dur 0) :duration dur))
- (ampenv3 (make-env (list 0 0 .03 1 (- dur .040) 1 dur 0) :duration dur))
- (g0 (* .615 amp))
- (g1 .202)
- (g2 .574)
- (g3 .116)
+ (ampenv0 (make-env (list 0 0 .001 1 (- dur .002) 1 dur 0) :duration dur :scaler (* amp .615)))
+ (ampenv1 (make-env (list 0 0 .001 1 (- dur .011) 1 dur 0) :duration dur :scaler .202))
+ (ampenv2 (make-env (list 0 0 .01 1 (- dur .015) 1 dur 0) :duration dur :scaler .574))
+ (ampenv3 (make-env (list 0 0 .03 1 (- dur .040) 1 dur 0) :duration dur :scaler .116))
(st (seconds->samples beg))
- (nd (+ st (seconds->samples dur))))
- (run
+ (nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
- (outa i (* g0 (env ampenv0)
+ (outa i (* (env ampenv0)
(oscil osc0
- (+ (* g1 (env ampenv1)
- (oscil osc1
- (* g2 (env ampenv2)
- (oscil osc2))))
- (* g3 (env ampenv3)
- (oscil osc3))))))))))
+ (+ (* (env ampenv1) (oscil osc1 (* (env ampenv2) (oscil osc2))))
+ (* (env ampenv3) (oscil osc3)))))))))
(definstrument (drone startime dur frequency amp ampfun synth ampat ampdc amtrev deg dis rvibamt rvibfreq)
- (let* ((beg (seconds->samples startime))
- (end (+ beg (seconds->samples dur)))
+ (let ((beg (seconds->samples startime))
+ (end (seconds->samples (+ startime dur)))
(waveform (partials->wave synth))
(amplitude (* amp .25))
- (freq (hz->radians frequency))
- (s (make-table-lookup :frequency frequency :wave waveform))
- (amp-env (make-env (stretch-envelope ampfun 25 (* 100 (/ ampat dur)) 75 (- 100 (* 100 (/ ampdc dur))))
- :scaler amplitude :duration dur))
- (ran-vib (make-rand :frequency rvibfreq
- :amplitude (* rvibamt freq)))
- (loc (make-locsig deg dis amtrev)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (locsig loc i (* (env amp-env) (table-lookup s (+ (rand ran-vib)))))))))
+ (freq (hz->radians frequency)))
+ (let ((s (make-table-lookup :frequency frequency :wave waveform))
+ (amp-env (make-env (stretch-envelope ampfun 25 (* 100 (/ ampat dur)) 75 (- 100 (* 100 (/ ampdc dur))))
+ :scaler amplitude :duration dur))
+ (ran-vib (make-rand :frequency rvibfreq
+ :amplitude (* rvibamt freq)))
+ (loc (make-locsig deg dis amtrev)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (locsig loc i (* (env amp-env) (table-lookup s (rand ran-vib))))))))
(definstrument (canter beg dur pitch amp-1 deg dis pcrev ampfun ranfun skewfun
@@ -886,57 +959,59 @@ is a physical model of a flute:
ampfun2 indfun2 fmtfun2
ampfun3 indfun3 fmtfun3
ampfun4 indfun4 fmtfun4)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (amp (* amp-1 .25)) ;pvc's amplitudes in bag.clm are very high (overflows)
- (rangetop 910.0)
- (rangebot 400.0)
- (k (floor (* 100 (/ (log (/ pitch rangebot)) (log (/ rangetop rangebot))))))
- (atpt (* 100 (/ atdr dur)))
- (dcpt (- 100 (* 100 (/ dcdr dur))))
- (lfmt1 (envelope-interp k fmtfun1))
- (harm1 (floor (+ .5 (/ lfmt1 pitch))))
- (dev11 (hz->radians (* (envelope-interp k indfun1) pitch)))
- (dev01 (* dev11 .5))
- (lamp1 (* (envelope-interp k ampfun1) amp (- 1 (abs (- harm1 (/ lfmt1 pitch))))))
- (lfmt2 (envelope-interp k fmtfun2))
- (harm2 (floor (+ .5 (/ lfmt2 pitch))))
- (dev12 (hz->radians (* (envelope-interp k indfun2) pitch)))
- (dev02 (* dev12 .5))
- (lamp2 (* (envelope-interp k ampfun2) amp (- 1 (abs (- harm2 (/ lfmt2 pitch))))))
- (lfmt3 (envelope-interp k fmtfun3))
- (harm3 (floor (+ .5 (/ lfmt3 pitch))))
- (dev13 (hz->radians (* (envelope-interp k indfun3) pitch)))
- (dev03 (* dev13 .5))
- (lamp3 (* (envelope-interp k ampfun3) amp (- 1 (abs (- harm3 (/ lfmt3 pitch))))))
- (lfmt4 (envelope-interp k fmtfun4))
- (harm4 (floor (+ .5 (/ lfmt4 pitch))))
- (dev14 (hz->radians (* (envelope-interp k indfun4) pitch)))
- (dev04 (* dev14 .5))
- (lamp4 (* (envelope-interp k ampfun4) amp (- 1 (abs (- harm4 (/ lfmt4 pitch))))))
- (tampfun (make-env (stretch-envelope ampfun 25 atpt 75 dcpt) :duration dur))
- (tskwfun (make-env (stretch-envelope skewfun 25 atpt 75 dcpt) :scaler (hz->radians (* pitch skewpc)) :duration dur))
- (tranfun (make-env (stretch-envelope ranfun 25 atpt 75 dcpt) :duration dur))
- (tidxfun (make-env (stretch-envelope indexfun 25 atpt 75 dcpt) :duration dur))
- (modgen (make-oscil pitch))
- (gen1 (make-oscil (* pitch harm1)))
- (gen2 (make-oscil (* pitch harm2)))
- (gen3 (make-oscil (* pitch harm3)))
- (gen4 (make-oscil (* pitch harm4)))
- (ranvib (make-rand :frequency ranfreq :amplitude (hz->radians (* ranpc pitch))))
- (loc (make-locsig deg dis pcrev)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let* ((frqval (+ (env tskwfun) (* (env tranfun) (rand ranvib))))
- (modval (oscil modgen frqval))
- (ampval (env tampfun))
- (indval (env tidxfun)))
- (locsig loc i
- (+ (* lamp1 ampval (oscil gen1 (* (+ (* (+ dev01 (* indval dev11)) modval) frqval) harm1)))
- (* lamp2 ampval (oscil gen2 (* (+ (* (+ dev02 (* indval dev12)) modval) frqval) harm2)))
- (* lamp3 ampval (oscil gen3 (* (+ (* (+ dev03 (* indval dev13)) modval) frqval) harm3)))
- (* lamp4 ampval (oscil gen4 (* (+ (* (+ dev04 (* indval dev14)) modval) frqval) harm4))))))))))
+ (let ((amp (* amp-1 .25)) ;pvc's amplitudes in bag.clm are very high (overflows)
+ (rangetop 910.0)
+ (rangebot 400.0))
+ (let ((k (floor (* 100 (log (/ pitch rangebot) (/ rangetop rangebot)))))
+ (atpt (* 100 (/ atdr dur)))
+ (dcpt (- 100 (* 100 (/ dcdr dur)))))
+ (let ((lfmt1 (envelope-interp k fmtfun1))
+ (lfmt2 (envelope-interp k fmtfun2))
+ (lfmt3 (envelope-interp k fmtfun3))
+ (lfmt4 (envelope-interp k fmtfun4))
+ (dev11 (hz->radians (* (envelope-interp k indfun1) pitch)))
+ (dev12 (hz->radians (* (envelope-interp k indfun2) pitch)))
+ (dev13 (hz->radians (* (envelope-interp k indfun3) pitch)))
+ (dev14 (hz->radians (* (envelope-interp k indfun4) pitch))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (dev01 (* dev11 .5))
+ (dev02 (* dev12 .5))
+ (dev03 (* dev13 .5))
+ (dev04 (* dev14 .5))
+ (harm1 (floor (+ .5 (/ lfmt1 pitch))))
+ (harm2 (floor (+ .5 (/ lfmt2 pitch))))
+ (harm3 (floor (+ .5 (/ lfmt3 pitch))))
+ (harm4 (floor (+ .5 (/ lfmt4 pitch)))))
+ (let ((lamp1 (* (envelope-interp k ampfun1) amp (- 1 (abs (- harm1 (/ lfmt1 pitch))))))
+ (lamp2 (* (envelope-interp k ampfun2) amp (- 1 (abs (- harm2 (/ lfmt2 pitch))))))
+ (lamp3 (* (envelope-interp k ampfun3) amp (- 1 (abs (- harm3 (/ lfmt3 pitch))))))
+ (lamp4 (* (envelope-interp k ampfun4) amp (- 1 (abs (- harm4 (/ lfmt4 pitch))))))
+ (tidx-stretched (stretch-envelope indexfun 25 atpt 75 dcpt)))
+ (let ((tampfun (make-env (stretch-envelope ampfun 25 atpt 75 dcpt) :duration dur))
+ (tskwfun (make-env (stretch-envelope skewfun 25 atpt 75 dcpt) :scaler (hz->radians (* pitch skewpc)) :duration dur))
+ (tranfun (make-env (stretch-envelope ranfun 25 atpt 75 dcpt) :duration dur))
+ (d1env (make-env tidx-stretched :offset dev01 :scaler dev11 :duration dur))
+ (d2env (make-env tidx-stretched :offset dev02 :scaler dev12 :duration dur))
+ (d3env (make-env tidx-stretched :offset dev03 :scaler dev13 :duration dur))
+ (d4env (make-env tidx-stretched :offset dev04 :scaler dev14 :duration dur))
+ (modgen (make-oscil pitch))
+ (ranvib (make-rand :frequency ranfreq :amplitude (hz->radians (* ranpc pitch))))
+ (loc (make-locsig deg dis pcrev))
+ (gen1 (make-oscil (* pitch harm1)))
+ (gen2 (make-oscil (* pitch harm2)))
+ (gen3 (make-oscil (* pitch harm3)))
+ (gen4 (make-oscil (* pitch harm4))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let* ((frqval (+ (env tskwfun) (* (env tranfun) (rand ranvib))))
+ (modval (oscil modgen frqval)))
+ (locsig loc i (* (env tampfun)
+ (+ (* lamp1 (oscil gen1 (* (+ (* (env d1env) modval) frqval) harm1)))
+ (* lamp2 (oscil gen2 (* (+ (* (env d2env) modval) frqval) harm2)))
+ (* lamp3 (oscil gen3 (* (+ (* (env d3env) modval) frqval) harm3)))
+ (* lamp4 (oscil gen4 (* (+ (* (env d4env) modval) frqval) harm4)))))))))))))))
+
;;; NREV (the most popular Samson box reverb)
@@ -957,59 +1032,54 @@ is a physical model of a flute:
val
(next-prime (+ val 2))))
- (let* ((srscale (/ (mus-srate) 25641))
- (val 0)
- (dly-len (list 1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19)))
+ (let ((srscale (/ *clm-srate* 25641))
+ (dly-len (list 1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19))
+ (chan2 (> (channels *output*) 1))
+ (chan4 (= (channels *output*) 4)))
+
(do ((i 0 (+ i 1)))
((= i 15))
- (let ((val (floor (* srscale (list-ref dly-len i)))))
- (if (even? val) (set! val (+ 1 val)))
- (list-set! dly-len i (next-prime val))))
-
- (let* ((len (+ (mus-srate) (length *reverb*)))
- (comb1 (make-comb (* .822 reverb-factor) (list-ref dly-len 0)))
- (comb2 (make-comb (* .802 reverb-factor) (list-ref dly-len 1)))
- (comb3 (make-comb (* .773 reverb-factor) (list-ref dly-len 2)))
- (comb4 (make-comb (* .753 reverb-factor) (list-ref dly-len 3)))
- (comb5 (make-comb (* .753 reverb-factor) (list-ref dly-len 4)))
- (comb6 (make-comb (* .733 reverb-factor) (list-ref dly-len 5)))
+ (let ((val (floor (* srscale (dly-len i)))))
+ (if (even? val) (set! val (+ val 1)))
+ (set! (dly-len i) (next-prime val))))
+
+ (let ((len (+ (floor *clm-srate*) (framples *reverb*)))
+ (comb1 (make-comb (* .822 reverb-factor) (dly-len 0)))
+ (comb2 (make-comb (* .802 reverb-factor) (dly-len 1)))
+ (comb3 (make-comb (* .773 reverb-factor) (dly-len 2)))
+ (comb4 (make-comb (* .753 reverb-factor) (dly-len 3)))
+ (comb5 (make-comb (* .753 reverb-factor) (dly-len 4)))
+ (comb6 (make-comb (* .733 reverb-factor) (dly-len 5)))
(low (make-one-pole lp-coeff (- lp-coeff 1.0)))
- (chan2 (> (channels *output*) 1))
- (chan4 (= (channels *output*) 4))
- (allpass1 (make-all-pass -0.700 0.700 (list-ref dly-len 6)))
- (allpass2 (make-all-pass -0.700 0.700 (list-ref dly-len 7)))
- (allpass3 (make-all-pass -0.700 0.700 (list-ref dly-len 8)))
- (allpass4 (make-all-pass -0.700 0.700 (list-ref dly-len 9))) ; 10 for quad
- (allpass5 (make-all-pass -0.700 0.700 (list-ref dly-len 11)))
- (allpass6 (if chan2 (make-all-pass -0.700 0.700 (list-ref dly-len 12)) #f))
- (allpass7 (if chan4 (make-all-pass -0.700 0.700 (list-ref dly-len 13)) #f))
- (allpass8 (if chan4 (make-all-pass -0.700 0.700 (list-ref dly-len 14)) #f)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let* ((rev (* volume (ina i *reverb*)))
- (outrev (all-pass allpass4
- (one-pole low
- (all-pass allpass3
- (all-pass allpass2
- (all-pass allpass1
- (+ (comb comb1 rev)
- (comb comb2 rev)
- (comb comb3 rev)
- (comb comb4 rev)
- (comb comb5 rev)
- (comb comb6 rev)))))))))
- (outa i (all-pass allpass5 outrev))
- (if chan2 (outb i (all-pass allpass6 outrev)))
- (if chan4 (outc i (all-pass allpass7 outrev)))
- (if chan4 (outd i (all-pass allpass8 outrev)))))))))
-
+ (allpass1 (make-all-pass -0.700 0.700 (dly-len 6)))
+ (allpass2 (make-all-pass -0.700 0.700 (dly-len 7)))
+ (allpass3 (make-all-pass -0.700 0.700 (dly-len 8)))
+ (allpass4 (make-all-pass -0.700 0.700 (dly-len 9))) ; 10 for quad
+ (allpass5 (make-all-pass -0.700 0.700 (dly-len 11)))
+ (allpass6 (and chan2 (make-all-pass -0.700 0.700 (dly-len 12))))
+ (allpass7 (and chan4 (make-all-pass -0.700 0.700 (dly-len 13))))
+ (allpass8 (and chan4 (make-all-pass -0.700 0.700 (dly-len 14)))))
+
+ (let ((filts (if (not chan2)
+ (vector allpass5)
+ (if (not chan4)
+ (vector allpass5 allpass6)
+ (vector allpass5 allpass6 allpass7 allpass8))))
+ (combs (make-comb-bank (vector comb1 comb2 comb3 comb4 comb5 comb6)))
+ (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (out-bank filts i
+ (all-pass allpass4
+ (one-pole low
+ (all-pass-bank allpasses
+ (comb-bank combs (* volume (ina i *reverb*))))))))))))
(definstrument (reson startime dur pitch amp numformants indxfun skewfun pcskew skewat skewdc
vibfreq vibpc ranvibfreq ranvibpc degree distance reverb-amount data)
;; data is a list of lists of form '(ampf resonfrq resonamp ampat ampdc dev0 dev1 indxat indxdc)
- (let* ((beg (seconds->samples startime))
- (end (+ beg (seconds->samples dur)))
+ (let ((beg (seconds->samples startime))
+ (end (seconds->samples (+ startime dur)))
(carriers (make-vector numformants))
(modulator (make-oscil pitch))
(ampfs (make-vector numformants))
@@ -1026,19 +1096,19 @@ is a physical model of a flute:
;; initialize the "formant" generators
(do ((i 0 (+ i 1)))
((= i numformants))
- (set! totalamp (+ totalamp (list-ref (list-ref data i) 2))))
+ (set! totalamp (+ totalamp ((data i) 2))))
(do ((i 0 (+ i 1)))
((= i numformants))
- (let* ((frmdat (list-ref data i))
+ (let* ((frmdat (data i))
(freq (cadr frmdat))
(ampf (car frmdat))
- (rfamp (list-ref frmdat 2))
- (ampat (* 100 (/ (list-ref frmdat 3) dur)))
- (ampdc (- 100 (* 100 (/ (list-ref frmdat 4) dur))))
- (dev0 (hz->radians (* (list-ref frmdat 5) freq)))
- (dev1 (hz->radians (* (list-ref frmdat 6) freq)))
- (indxat (* 100 (/ (list-ref frmdat 7) dur)))
- (indxdc (- 100 (* 100 (/ (list-ref frmdat 8) dur))))
+ (rfamp (frmdat 2))
+ (ampat (* 100 (/ (frmdat 3) dur)))
+ (ampdc (- 100 (* 100 (/ (frmdat 4) dur))))
+ (dev0 (hz->radians (* (frmdat 5) freq)))
+ (dev1 (hz->radians (* (frmdat 6) freq)))
+ (indxat (* 100 (/ (frmdat 7) dur)))
+ (indxdc (- 100 (* 100 (/ (frmdat 8) dur))))
(harm (round (/ freq pitch)))
(rsamp (- 1.0 (abs (- harm (/ freq pitch)))))
(cfq (* pitch harm)))
@@ -1052,20 +1122,40 @@ is a physical model of a flute:
:scaler (* rsamp amp (/ rfamp totalamp))))
(set! (c-rats i) harm)
(set! (carriers i) (make-oscil cfq))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let* ((outsum 0.0)
- (vib (+ (triangle-wave pervib) (rand-interp ranvib) (env frqf)))
- (modsig (oscil modulator vib)))
- (do ((k 0 (+ 1 k)))
- ((= k numformants))
- (set! outsum (+ outsum
- (* (env (ampfs k))
- (oscil (carriers k)
- (+ (* vib (c-rats k))
- (* (env (indfs k)) modsig)))))))
- (locsig loc i outsum))))))
+ (if (= numformants 2)
+ (let ((e1 (ampfs 0))
+ (e2 (ampfs 1))
+ (c1 (carriers 0))
+ (c2 (carriers 1))
+ (i1 (indfs 0))
+ (i2 (indfs 1))
+ (r1 (c-rats 0))
+ (r2 (c-rats 1)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let* ((vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
+ (modsig (oscil modulator vib)))
+ (locsig loc i (+ (* (env e1)
+ (oscil c1 (+ (* vib r1)
+ (* (env i1) modsig))))
+ (* (env e2)
+ (oscil c2 (+ (* vib r2)
+ (* (env i2) modsig)))))))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let* ((outsum 0.0)
+ (vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
+ (modsig (oscil modulator vib)))
+ (do ((k 0 (+ k 1)))
+ ((= k numformants))
+ (set! outsum (+ outsum
+ (* (env (ampfs k))
+ (oscil (carriers k)
+ (+ (* vib (c-rats k))
+ (* (env (indfs k)) modsig)))))))
+ (locsig loc i outsum))))))
+
+;; (with-sound (:statistics #t) (reson 0 1.0 440 .1 2 '(0 0 100 1) '(0 0 100 1) .1 .1 .1 5 .01 5 .01 0 1.0 0.01 '(((0 0 100 1) 1200 .5 .1 .1 0 1.0 .1 .1) ((0 1 100 0) 2400 .5 .1 .1 0 1.0 .1 .1))))
;;; STK's feedback-fm instrument named CelloN in Sambox-land
@@ -1075,91 +1165,86 @@ is a physical model of a flute:
pitch1 glissfun glissat glissdc
pvibfreq pvibpc pvibfun pvibat pvibdc
rvibfreq rvibpc rvibfun)
- (let* ((st (seconds->samples beg))
- (nd (+ st (seconds->samples dur)))
- (pit1 (if (zero? pitch1) pitch0 pitch1))
- (loc (make-locsig deg dis pcrev))
- (car (make-oscil pitch0))
- (low (make-one-zero .5 -.5))
- (fm 0.0)
- (fmosc (make-oscil pitch0))
- (pvib (make-triangle-wave :frequency pvibfreq :amplitude 1.0))
- (rvib (make-rand-interp :frequency rvibfreq :amplitude 1.0))
- (ampap (if (> ampat 0.0) (* 100 (/ ampat dur)) 25))
- (ampdp (if (> ampdc 0.0) (* 100 (- 1.0 (/ ampdc dur))) 75))
- (glsap (if (> glissat 0.0) (* 100 (/ glissat dur)) 25))
- (glsdp (if (> glissdc 0.0) (* 100 (- 1.0 (/ glissdc dur))) 75))
- (betap (if (> betaat 0.0) (* 100 (/ betaat dur)) 25))
- (betdp (if (> betadc 0.0) (* 100 (- 1.0 (/ betadc dur))) 75))
- (pvbap (if (> pvibat 0.0) (* 100 (/ pvibat dur)) 25))
- (pvbdp (if (> pvibdc 0.0) (* 100 (- 1.0 (/ pvibdc dur))) 75))
- (pvibenv (make-env (stretch-envelope (or pvibfun '(0 1 100 1)) 25 pvbap 75 pvbdp) :duration dur
+ (let ((st (seconds->samples beg))
+ (nd (seconds->samples (+ beg dur)))
+ (pit1 (if (zero? pitch1) pitch0 pitch1))
+ (loc (make-locsig deg dis pcrev))
+ (carrier (make-oscil pitch0))
+ (low (make-one-zero .5 -.5))
+ (fm 0.0)
+ (fmosc (make-oscil pitch0))
+ (pvib (make-triangle-wave :frequency pvibfreq :amplitude 1.0))
+ (rvib (make-rand-interp :frequency rvibfreq :amplitude 1.0))
+ (ampap (if (> ampat 0.0) (* 100 (/ ampat dur)) 25))
+ (ampdp (if (> ampdc 0.0) (* 100 (- 1.0 (/ ampdc dur))) 75))
+ (glsap (if (> glissat 0.0) (* 100 (/ glissat dur)) 25))
+ (glsdp (if (> glissdc 0.0) (* 100 (- 1.0 (/ glissdc dur))) 75))
+ (betap (if (> betaat 0.0) (* 100 (/ betaat dur)) 25))
+ (betdp (if (> betadc 0.0) (* 100 (- 1.0 (/ betadc dur))) 75))
+ (pvbap (if (> pvibat 0.0) (* 100 (/ pvibat dur)) 25))
+ (pvbdp (if (> pvibdc 0.0) (* 100 (- 1.0 (/ pvibdc dur))) 75)))
+ (let ((pvibenv (make-env (stretch-envelope (or pvibfun '(0 1 100 1)) 25 pvbap 75 pvbdp) :duration dur
:scaler (hz->radians (* pvibpc pitch0))))
- (rvibenv (make-env (or rvibfun '(0 1 100 1)) :duration dur
+ (rvibenv (make-env (or rvibfun '(0 1 100 1)) :duration dur
:scaler (hz->radians (* rvibpc pitch0))))
- (glisenv (make-env (stretch-envelope (or glissfun '(0 0 100 0)) 25 glsap 75 glsdp) :duration dur
+ (glisenv (make-env (stretch-envelope (or glissfun '(0 0 100 0)) 25 glsap 75 glsdp) :duration dur
:scaler (hz->radians (- pit1 pitch0))))
- (amplenv (make-env (stretch-envelope ampfun 25 ampap 75 ampdp) :scaler amp :duration dur))
- (betaenv (make-env (stretch-envelope betafun 25 betap 75 betdp) :duration dur
+ (amplenv (make-env (stretch-envelope ampfun 25 ampap 75 ampdp) :scaler amp :duration dur))
+ (betaenv (make-env (stretch-envelope betafun 25 betap 75 betdp) :duration dur
:scaler (- beta1 beta0) :offset beta0)))
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (let* ((vib (+ (* (env pvibenv) (triangle-wave pvib))
- (* (env rvibenv) (rand-interp rvib))
- (env glisenv))))
- (set! fm (one-zero low (* (env betaenv) (oscil fmosc (+ fm vib)))))
- (locsig loc i (* (env amplenv)
- (oscil car (+ fm vib)))))))))
-
-
-(definstrument (jl-reverb (decay 3.0))
- (let* ((allpass1 (make-all-pass -0.700 0.700 2111))
- (allpass2 (make-all-pass -0.700 0.700 673))
- (allpass3 (make-all-pass -0.700 0.700 223))
- (comb1 (make-comb 0.742 9601))
- (comb2 (make-comb 0.733 10007))
- (comb3 (make-comb 0.715 10799))
- (comb4 (make-comb 0.697 11597))
- (outdel1 (make-delay (seconds->samples .013)))
- (outdel2 (make-delay (seconds->samples .011)))
- (comb-sum 0.0)
- (comb-sum-1 0.0)
- (comb-sum-2 0.0)
- (all-sums 0.0)
- (delA 0.0)
- (delB 0.0)
- (decay-dur (* decay (mus-srate)))
- (len (floor (+ decay-dur (length *reverb*)))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((allpass-sum (all-pass allpass3 (all-pass allpass2 (all-pass allpass1 (ina i *reverb*))))))
- (set! comb-sum
- (+ (comb comb1 allpass-sum)
- (comb comb2 allpass-sum)
- (comb comb3 allpass-sum)
- (comb comb4 allpass-sum)))
- (outa i (delay outdel1 comb-sum))
- (outb i (delay outdel2 comb-sum)))))))
+ (if (and (= pitch0 pitch1)
+ (or (zero? pvibfreq)
+ (zero? pvibpc))
+ (or (zero? rvibfreq)
+ (zero? rvibpc)))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (set! fm (one-zero low (* (env betaenv) (oscil fmosc fm))))
+ (locsig loc i (* (env amplenv) (oscil carrier fm))))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (let ((vib (+ (* (env pvibenv) (triangle-wave pvib))
+ (* (env rvibenv) (rand-interp rvib))
+ (env glisenv))))
+ (set! fm (one-zero low (* (env betaenv) (oscil fmosc (+ fm vib)))))
+ (locsig loc i (* (env amplenv)
+ (oscil carrier (+ fm vib))))))))))
+
+
+(definstrument (jl-reverb (decay 3.0) (volume 1.0))
+ (let ((allpass1 (make-all-pass -0.700 0.700 2111))
+ (allpass2 (make-all-pass -0.700 0.700 673))
+ (allpass3 (make-all-pass -0.700 0.700 223))
+ (comb1 (make-comb 0.742 9601))
+ (comb2 (make-comb 0.733 10007))
+ (comb3 (make-comb 0.715 10799))
+ (comb4 (make-comb 0.697 11597))
+ (outdel1 (make-delay (seconds->samples .013)))
+ (outdel2 (make-delay (seconds->samples .011)))
+ (len (floor (+ (* decay *clm-srate*) (length *reverb*)))))
+ (let ((filts (vector outdel1 outdel2))
+ (combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
+ (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (out-bank filts i (* volume (comb-bank combs (all-pass-bank allpasses (ina i *reverb*)))))))))
(definstrument (gran-synth start-time duration audio-freq grain-dur grain-interval amp)
- (let* ((beg (seconds->samples start-time))
- (end (+ beg (seconds->samples duration)))
- (grain-env (make-env '(0 0 25 1 75 1 100 0) :duration grain-dur))
- (carrier (make-oscil audio-freq))
- (grain-size (ceiling (* (max grain-dur grain-interval) (mus-srate))))
- (grains (make-wave-train :size grain-size :frequency (/ 1.0 grain-interval)))
- (grain (mus-data grains)))
- (do ((i 0 (+ i 1)))
- ((= i grain-size))
- (set! (grain i) (* (env grain-env) (oscil carrier))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (wave-train grains)))))))
-
+ (let ((grain-size (ceiling (* (max grain-dur grain-interval) *clm-srate*))))
+ (let ((beg (seconds->samples start-time))
+ (end (seconds->samples (+ start-time duration)))
+ (grain-env (make-env '(0 0 25 1 75 1 100 0) :duration grain-dur))
+ (carrier (make-oscil audio-freq))
+ (grains (make-wave-train :size grain-size :frequency (/ 1.0 grain-interval))))
+ (let ((grain (mus-data grains)))
+ (do ((i 0 (+ i 1)))
+ ((= i grain-size))
+ (set! (grain i) (* (env grain-env) (oscil carrier)))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (wave-train grains)))))))
+
;;; (with-sound () (gran-synth 0 2 100 .0189 .02 .4))
@@ -1168,57 +1253,53 @@ is a physical model of a flute:
(touch-tab-2 '(0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477)))
(do ((i 0 (+ i 1)))
((= i (length telephone-number)))
- (let* ((k (list-ref telephone-number i))
- (beg (seconds->samples (+ start (* i .4))))
- (end (+ beg (seconds->samples .3)))
- (i (if (number? k)
- (if (not (= 0 k))
- k
- 11)
- (if (eq? k '*)
- 10
- 12)))
- (frq1 (make-oscil (list-ref touch-tab-1 i)))
- (frq2 (make-oscil (list-ref touch-tab-2 i))))
- (run
- (do ((j beg (+ 1 j)))
- ((= j end))
- (outa j (* 0.1 (+ (oscil frq1) (oscil frq2))))))))))
-
-;;; (with-sound () (touch-tone 0.0 '(7 2 3 4 9 7 1))
+ (let ((k (telephone-number i))
+ (beg (seconds->samples (+ start (* i .4)))))
+ (let ((end (+ beg (seconds->samples .3)))
+ (i (if (number? k)
+ (if (not (= 0 k)) k 11)
+ (if (eq? k '*) 10 12))))
+ (let ((frq1 (make-oscil (touch-tab-1 i)))
+ (frq2 (make-oscil (touch-tab-2 i))))
+ (do ((j beg (+ j 1)))
+ ((= j end))
+ (outa j (* 0.1 (+ (oscil frq1)
+ (oscil frq2)))))))))))
+
+;;; (with-sound () (touch-tone 0.0 '(7 2 3 4 9 7 1)))
;;; I think the dial tone is 350 + 440
;;; http://www.hackfaq.org/telephony/telephone-tone-frequencies.shtml
(definstrument (spectra start-time duration frequency amplitude
- (partials '(1 1 2 0.5))
- (amp-envelope '(0 0 50 1 100 0))
- (vibrato-amplitude 0.005)
- (vibrato-speed 5.0)
- (degree 0.0)
- (distance 1.0)
- (reverb-amount 0.005))
- (let* ((beg (seconds->samples start-time))
- (end (+ beg (seconds->samples duration)))
- (waveform (partials->wave partials))
- (freq (hz->radians frequency))
- (s (make-table-lookup :frequency frequency :wave waveform))
- (amp-env (make-env amp-envelope :scaler amplitude :duration duration))
- (per-vib (make-triangle-wave :frequency vibrato-speed
- :amplitude (* vibrato-amplitude freq)))
- (loc (make-locsig degree distance reverb-amount))
- (ran-vib (make-rand-interp :frequency (+ vibrato-speed 1.0)
- :amplitude (* vibrato-amplitude freq))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (locsig loc i (* (env amp-env)
- (table-lookup s (+ (triangle-wave per-vib)
- (rand-interp ran-vib)))))))))
-
-; (with-sound ()
-; (spectra 0 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1)
-; '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0)))
+ (partials '(1 1 2 0.5))
+ (amp-envelope '(0 0 50 1 100 0))
+ (vibrato-amplitude 0.005)
+ (vibrato-speed 5.0)
+ (degree 0.0)
+ (distance 1.0)
+ (reverb-amount 0.005))
+ (let ((beg (seconds->samples start-time))
+ (end (seconds->samples (+ start-time duration)))
+ (waveform (partials->wave partials))
+ (freq (hz->radians frequency)))
+ (let ((s (make-table-lookup :frequency frequency :wave waveform))
+ (amp-env (make-env amp-envelope :scaler amplitude :duration duration))
+ (per-vib (make-triangle-wave :frequency vibrato-speed
+ :amplitude (* vibrato-amplitude freq)))
+ (loc (make-locsig degree distance reverb-amount))
+ (ran-vib (make-rand-interp :frequency (+ vibrato-speed 1.0)
+ :amplitude (* vibrato-amplitude freq))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (locsig loc i (* (env amp-env)
+ (table-lookup s (+ (triangle-wave per-vib)
+ (rand-interp ran-vib)))))))))
+#|
+ (with-sound (:play #t)
+ (spectra 0 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1)
+ '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0)))
+|#
;;; interpolate between two waveforms (this could be extended to implement all the various
@@ -1226,38 +1307,36 @@ is a physical model of a flute:
(definstrument (two-tab start-time duration frequency amplitude
(partial-1 '(1.0 1.0 2.0 0.5))
- (partial-2 '(1.0 0.0 3.0 1.0))
- (amp-envelope '(0 0 50 1 100 0))
- (interp-func '(0 1 100 0))
- (vibrato-amplitude 0.005)
- (vibrato-speed 5.0)
- (degree 0.0)
- (distance 1.0)
- (reverb-amount 0.005))
- (let* ((beg (seconds->samples start-time))
- (end (+ beg (seconds->samples duration)))
- (waveform-1 (partials->wave partial-1))
- (waveform-2 (partials->wave partial-2))
- (freq (hz->radians frequency))
- (s-1 (make-table-lookup :frequency frequency :wave waveform-1))
- (s-2 (make-table-lookup :frequency frequency :wave waveform-2))
- (amp-env (make-env amp-envelope :scaler amplitude :duration duration))
- (interp-env (make-env interp-func :duration duration))
- (loc (make-locsig degree distance reverb-amount))
- (per-vib (make-triangle-wave :frequency vibrato-speed
- :amplitude (* vibrato-amplitude freq)))
- (ran-vib (make-rand-interp :frequency (+ vibrato-speed 1.0)
- :amplitude (* vibrato-amplitude freq))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((vib (+ (triangle-wave per-vib)
- (rand-interp ran-vib)))
- (intrp (env interp-env)))
- (locsig loc i (* (env amp-env)
- (+ (* intrp (table-lookup s-1 vib))
- (* (- 1.0 intrp)
- (table-lookup s-2 vib))))))))))
+ (partial-2 '(1.0 0.0 3.0 1.0))
+ (amp-envelope '(0 0 50 1 100 0))
+ (interp-func '(0 1 100 0))
+ (vibrato-amplitude 0.005)
+ (vibrato-speed 5.0)
+ (degree 0.0)
+ (distance 1.0)
+ (reverb-amount 0.005))
+ (let ((beg (seconds->samples start-time))
+ (end (seconds->samples (+ start-time duration)))
+ (waveform-1 (partials->wave partial-1))
+ (waveform-2 (partials->wave partial-2))
+ (freq (hz->radians frequency)))
+ (let ((s-1 (make-table-lookup :frequency frequency :wave waveform-1))
+ (s-2 (make-table-lookup :frequency frequency :wave waveform-2))
+ (amp-env (make-env amp-envelope :scaler amplitude :duration duration))
+ (interp-env (make-env interp-func :duration duration))
+ (interp-env-1 (make-env interp-func :duration duration :offset 1.0 :scaler -1.0))
+ (loc (make-locsig degree distance reverb-amount))
+ (per-vib (make-triangle-wave :frequency vibrato-speed
+ :amplitude (* vibrato-amplitude freq)))
+ (ran-vib (make-rand-interp :frequency (+ vibrato-speed 1.0)
+ :amplitude (* vibrato-amplitude freq))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((vib (+ (triangle-wave per-vib) (rand-interp ran-vib))))
+ (locsig loc i (* (env amp-env)
+ (+ (* (env interp-env) (table-lookup s-1 vib))
+ (* (env interp-env-1) (table-lookup s-2 vib))))))))))
+
(definstrument (lbj-piano begin-time duration frequency amplitude pfreq
@@ -1673,11 +1752,11 @@ is a physical model of a flute:
(define (get-piano-partials freq)
(let ((pitch (round (* 12 (log (/ freq 32.703) 2)))))
- (list-ref piano-spectra pitch)))
+ (piano-spectra pitch)))
(define (make-piano-ampfun dur)
- (let* ((releaseAmp (db->linear (* *db-drop-per-second* dur)))
- (attackTime (/ (* *piano-attack-duration* 100) dur)))
+ (let ((releaseAmp (db->linear (* *db-drop-per-second* dur)))
+ (attackTime (/ (* *piano-attack-duration* 100) dur)))
(list 0 0 (/ attackTime 4) 1.0 attackTime 1.0 100 releaseAmp)))
;; This thing sounds pretty good down low, below middle c or so.
@@ -1694,46 +1773,42 @@ is a physical model of a flute:
(if (not (number? pfreq))
(set! pfreq frequency))
- (let* ((partials (normalize-partials (get-piano-partials pfreq)))
- (beg (seconds->samples begin-time))
- (newdur (+ duration *piano-attack-duration* *piano-release-duration*))
- (end (+ beg (seconds->samples newdur)))
- (env1dur (- newdur *piano-release-duration*))
- (env1samples (seconds->samples env1dur))
- (siz (floor (/ (length partials) 2)))
- (oscils (make-vector siz))
- (alist (make-vct siz))
- (locs (make-locsig degree distance reverb-amount))
- (ampfun1 (make-piano-ampfun env1dur))
- (ampenv1 (make-env ampfun1
- :scaler amplitude
- :duration env1dur
- :base 10000.0))
- (releaseamp (list-ref ampfun1 (- (length ampfun1) 1)))
- (ampenv2 (make-env '(0 1 100 0)
- :scaler (* amplitude releaseamp)
- :duration env1dur
- :base 1.0))
- (sktr 0))
-
- (do ((i 0 (+ i 2))
- (j 0 (+ 1 j)))
- ((= i (length partials)))
- (set! (alist j) (partials (+ i 1)))
- (set! (oscils j) (make-oscil (* (partials i) frequency))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (set! sktr (+ 1 sktr))
- (let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k siz))
- (set! sum (+ sum (* (alist k)
- (oscil (oscils k))))))
- (locsig locs i (* sum
- (if (> sktr env1samples)
- (env ampenv2)
- (env ampenv1))))))))))
+ (let ((partials (normalize-partials (get-piano-partials pfreq)))
+ (beg (seconds->samples begin-time))
+ (newdur (+ duration *piano-attack-duration* *piano-release-duration*)))
+ (let ((end (+ beg (seconds->samples newdur)))
+ (env1dur (- newdur *piano-release-duration*))
+ (siz (floor (/ (length partials) 2))))
+ (let ((env1samples (+ beg (seconds->samples env1dur)))
+ (freqs (make-float-vector siz))
+ (phases (make-float-vector siz 0.0))
+ (alist (make-float-vector siz))
+ (locs (make-locsig degree distance reverb-amount))
+ (ampfun1 (make-piano-ampfun env1dur)))
+ (let ((ampenv1 (make-env ampfun1
+ :scaler amplitude
+ :duration env1dur
+ :base 10000.0))
+ (ampenv2 (make-env '(0 1 100 0)
+ :scaler (* amplitude (ampfun1 (- (length ampfun1) 1)))
+ :duration env1dur
+ :base 1.0)))
+
+ (do ((i 0 (+ i 2))
+ (j 0 (+ j 1)))
+ ((= i (length partials)))
+ (set! (alist j) (partials (+ i 1)))
+ (set! (freqs j) (hz->radians (* (partials i) frequency))))
+
+ (let ((obank (make-oscil-bank freqs phases alist #t)))
+ (do ((i beg (+ i 1)))
+ ((= i env1samples))
+ (locsig locs i (* (env ampenv1) (oscil-bank obank))))
+ (do ((i env1samples (+ i 1)))
+ ((= i end))
+ (locsig locs i (* (env ampenv2) (oscil-bank obank)))))))))))
+
+;;; (with-sound () (lbj-piano 0 3 440.0 .2))
(definstrument (resflt start dur driver
@@ -1759,84 +1834,87 @@ is a physical model of a flute:
;; with pole-radius r1, r2, and r3 respectively, and
;; with gains of g1, g2, and g3.
- (let* ((beg (seconds->samples start))
- (end (+ beg (seconds->samples dur)))
- (f1 (make-two-pole :radius r1 :frequency frq1))
- (f2 (make-two-pole :radius r2 :frequency frq2))
- (f3 (make-two-pole :radius r3 :frequency frq3))
- (with-noise (= driver 1))
- (loc (make-locsig degree distance reverb-amount))
- (frqf (if (not with-noise)
- (make-env freqcosfun :duration dur
- :scaler (hz->radians (- cosfreq1 cosfreq0)))
- #f))
- (ampf (if with-noise
- (make-env noifun :scaler noiamp :duration dur)
- (make-env ampcosfun :scaler cosamp :duration dur)))
- (rn (if with-noise
- (make-rand :frequency ranfreq)
- #f))
- (cn (if (not with-noise)
- (make-ncos cosfreq0 cosnum)
- #f)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((input1 (if with-noise
- (* (env ampf) (rand rn))
- (* (env ampf) (ncos cn (env frqf))))))
- (locsig loc i (+ (two-pole f1 (* input1 g1))
- (two-pole f2 (* input1 g2))
- (two-pole f3 (* input1 g3)))))))))
-
-
-; (resflt 0 1.0 0 0 0 #f .1 200 230 10 '(0 0 50 1 100 0) '(0 0 100 1) 500 .995 .1 1000 .995 .1 2000 .995 .1)
-; (resflt 0 1.0 1 10000 .01 '(0 0 50 1 100 0) 0 0 0 0 #f #f 500 .995 .1 1000 .995 .1 2000 .995 .1)
+ (let ((with-noise (= driver 1)))
+ (let ((beg (seconds->samples start))
+ (end (seconds->samples (+ start dur)))
+ (f1 (make-two-pole :radius r1 :frequency frq1))
+ (f2 (make-two-pole :radius r2 :frequency frq2))
+ (f3 (make-two-pole :radius r3 :frequency frq3))
+ (loc (make-locsig degree distance reverb-amount))
+ (frqf (and (not with-noise)
+ (make-env freqcosfun :duration dur
+ :scaler (hz->radians (- cosfreq1 cosfreq0)))))
+ (ampf (if with-noise
+ (make-env noifun :scaler noiamp :duration dur)
+ (make-env ampcosfun :scaler cosamp :duration dur)))
+ (rn (and with-noise
+ (make-rand :frequency ranfreq)))
+ (cn (and (not with-noise)
+ (make-ncos cosfreq0 cosnum))))
+ (set! (mus-xcoeff f1 0) g1)
+ (set! (mus-xcoeff f2 0) g2)
+ (set! (mus-xcoeff f3 0) g3)
+ (if with-noise
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((input1 (* (env ampf) (rand rn))))
+ (locsig loc i (+ (two-pole f1 input1)
+ (two-pole f2 input1)
+ (two-pole f3 input1)))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((input1 (* (env ampf) (ncos cn (env frqf)))))
+ (locsig loc i (+ (two-pole f1 input1)
+ (two-pole f2 input1)
+ (two-pole f3 input1)))))))))
+
+
+; (with-sound () (resflt 0 1.0 0 0 0 #f .1 200 230 10 '(0 0 50 1 100 0) '(0 0 100 1) 500 .995 .1 1000 .995 .1 2000 .995 .1))
+; (with-sound () (resflt 0 1.0 1 10000 .01 '(0 0 50 1 100 0) 0 0 0 0 #f #f 500 .995 .1 1000 .995 .1 2000 .995 .1))
(definstrument (scratch start file src-ratio turnaroundlist)
- (let* ((f (make-file->sample file))
- (beg (seconds->samples start))
- (turntable (list->vct turnaroundlist))
- (turn-i 1)
- (turns (length turnaroundlist))
- (cur-sample (seconds->samples (turntable 0)))
- (turn-sample (seconds->samples (turntable turn-i)))
- (turning 0)
- (last-val 0.0)
- (last-val2 0.0)
- (rd (make-src :srate src-ratio))
- (forwards (> src-ratio 0.0)))
- (if (and forwards (< turn-sample cur-sample))
- (set! (mus-increment rd) (- src-ratio)))
- (run
- (do ((i beg (+ i 1)))
- ((>= turn-i turns))
- (let ((val (src rd 0.0
- (lambda (dir)
- (let ((inval (file->sample f cur-sample)))
- (set! cur-sample (+ cur-sample dir))
- inval)))))
- (if (= turning 0)
- (if (and forwards (>= cur-sample turn-sample)) ;; we past turn point going forwards
- (set! turning 1)
- (if (and (not forwards) (<= cur-sample turn-sample)) ;; we past turn point going backwards
- (set! turning -1)))
- ;; wait for an inflection...
- (if (or (and (<= last-val2 last-val) (>= last-val val))
- (and (>= last-val2 last-val) (<= last-val val)))
- (begin
- (set! turn-i (+ 1 turn-i))
- (if (< turn-i turns)
- (begin
- (set! turn-sample (seconds->samples (turntable turn-i)))
- (set! forwards (not forwards))
- (set! (mus-increment rd) (- (mus-increment rd)))))
- (set! turning 0))))
- (set! last-val2 last-val)
- (set! last-val val)
- (outa i val))))))
-
+ (let ((f (make-file->sample file))
+ (beg (seconds->samples start))
+ (turntable (apply vector turnaroundlist))
+ (turn-i 1)
+ (turns (length turnaroundlist)))
+ (let ((cur-sample (seconds->samples (turntable 0)))
+ (turn-sample (seconds->samples (turntable 1))))
+ (let ((func (lambda (dir)
+ (let ((inval (file->sample f cur-sample)))
+ (set! cur-sample (+ cur-sample dir))
+ inval)))
+ (turning 0)
+ (last-val 0.0)
+ (last-val2 0.0)
+ (rd (make-src :srate src-ratio))
+ (forwards (> src-ratio 0.0)))
+ (if (and forwards (< turn-sample cur-sample))
+ (set! (mus-increment rd) (- src-ratio)))
+ (do ((i beg (+ i 1)))
+ ((>= turn-i turns))
+ (let ((val (src rd 0.0 func)))
+ (if (= turning 0)
+ (if (and forwards (>= cur-sample turn-sample)) ;; we passed turn point going forwards
+ (set! turning 1)
+ (if (and (not forwards) (<= cur-sample turn-sample)) ;; we passed turn point going backwards
+ (set! turning -1)))
+ ;; wait for an inflection...
+ (if (or (and (<= last-val2 last-val) (>= last-val val))
+ (and (>= last-val2 last-val) (<= last-val val)))
+ (begin
+ (set! turn-i (+ turn-i 1))
+ (if (< turn-i turns)
+ (begin
+ (set! turn-sample (seconds->samples (turntable turn-i)))
+ (set! forwards (not forwards))
+ (set! (mus-increment rd) (- (mus-increment rd)))))
+ (set! turning 0))))
+ (set! last-val2 last-val)
+ (set! last-val val)
+ (outa i val)))))))
+
;;; (with-sound () (scratch 0.0 "now.snd" 1.5 '(0.0 .5 .25 1.0)))
@@ -1855,464 +1933,469 @@ is a physical model of a flute:
;; match with current, do some interesting transformation, resynthesize using oscils
;; All the envelopes are created on the fly. max-peaks is how many of these peaks
;; we are willing to track at any given time.
- (let* ((max-peaks-1 max-peaks)
- (fftsize-1 fftsize)
- (highest-bin-1 highest-bin)
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fil (make-file->sample file))
- (file-duration (mus-sound-duration file))
- (fdr (make-vct fftsize-1))
- (fdi (make-vct fftsize-1))
- (window (make-fft-window blackman2-window fftsize-1))
- (fftamps (make-vct fftsize-1))
- (max-oscils (* 2 max-peaks-1))
- (current-peak-freqs (make-vct max-oscils))
- (last-peak-freqs (make-vct max-oscils))
- (current-peak-amps (make-vct max-oscils))
- (last-peak-amps (make-vct max-oscils))
- (peak-amps (make-vct max-peaks-1))
- (peak-freqs (make-vct max-peaks-1))
- (resynth-oscils (make-vector max-oscils))
- (amps (make-vct max-oscils)) ;run-time generated amplitude and frequency envelopes
- (rates (make-vct max-oscils))
- (freqs (make-vct max-oscils))
- (sweeps (make-vct max-oscils))
- (lowest-magnitude .001)
- (hop (floor (/ fftsize-1 4)))
- (outhop (floor (* time-scaler hop)))
- (ifreq (/ 1.0 outhop))
- (ihifreq (hz->radians ifreq))
- (fftscale (/ 1.0 (* fftsize-1 .42323))) ;integrate Blackman-Harris window = .42323*window width and shift by fftsize-1
- (fft-mag (/ (mus-srate) fftsize-1))
- (furthest-away-accepted .1)
- (filptr 0)
- (trigger 0)
- (sum 0.0)
- (log10 (log 10.0))
- (cur-oscils max-oscils)
- (ramped (or attack 0))
- (splice-attack (number? attack))
- (attack-size (or attack 1))
- (ramp-ind 0)
- (ramped-attack (make-vct attack-size)))
-
- (do ((i 0 (+ i 1)))
- ((= i max-oscils))
- (set! (resynth-oscils i) (make-oscil 0)))
- (set! trigger outhop)
- (vct-scale! window fftscale)
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (if splice-attack
- (let ((ramp (/ 1.0 attack-size)))
- ;; my experience in translating SMS, and rumor via Greg Sandell leads me to believe that
- ;; there is in fact no way to model some attacks successfully in this manner, so this block
- ;; simply splices the original attack on to the rest of the note. "attack" is the number
- ;; of samples to include bodily.
- (outa i (* amp (file->sample fil filptr)))
- (set! filptr (+ 1 filptr))
- (if (> filptr attack-size)
- (let ((mult 1.0))
- (do ((k 0 (+ 1 k)))
- ((= k attack-size))
- (set! (ramped-attack k) (* mult (file->sample fil (+ filptr k))))
- (set! mult (- mult ramp)))
- (set! splice-attack #f))))
- (begin
- (if (>= trigger outhop)
- (let ((peaks 0))
- ;; get next block of data and apply window to it
- (set! trigger 0)
- (do ((k 0 (+ 1 k)))
- ((= k fftsize-1))
- (set! (fdr k) (* (window k) (file->sample fil filptr)))
- (set! filptr (+ 1 filptr)))
- (vct-fill! fdi 0.0)
- (set! filptr (- filptr (- fftsize-1 hop)))
- ;; get the fft
- (mus-fft fdr fdi fftsize-1 1)
- ;; change to polar coordinates (ignoring phases)
- (do ((k 0 (+ 1 k)))
- ((= k highest-bin-1)) ;no need to paw through the upper half (so (<= highest-bin-1 (floor fft-size 2)))
- (let ((x (fdr k))
- (y (fdi k)))
- (set! (fftamps k) (* 2 (sqrt (+ (* x x) (* y y)))))))
- (do ((k 0 (+ 1 k)))
- ((= k max-oscils))
- (set! (last-peak-freqs k) (current-peak-freqs k))
- (set! (last-peak-amps k) (current-peak-amps k))
- (set! (current-peak-amps k) 0.0))
- (vct-fill! peak-amps 0.0)
- (let ((ra (fftamps 0))
- (la 0.0)
- (ca 0.0))
- ;; search for current peaks following Xavier Serra's recommendations in
- ;; "A System for Sound Analysis/Transformation/Synthesis
- ;; Based on a Deterministic Plus Stochastic Decomposition"
- (do ((k 0 (+ 1 k)))
- ((= k highest-bin-1))
- (set! la ca)
- (set! ca ra)
- (set! ra (fftamps k))
- (if (and (> ca lowest-magnitude)
- (> ca ra)
- (> ca la))
- ;; found a local maximum above the current threshold (its bin number is k-1)
- (let* ((logla (/ (log la) log10))
- (logca (/ (log ca) log10))
- (logra (/ (log ra) log10))
- (offset (/ (* .5 (- logla logra)) (+ logla (* -2 logca) logra))) ; isn't logca always 0?
- (amp (expt 10.0 (- logca (* .25 (- logla logra) offset))))
- (freq (* fft-mag (+ k offset -1))))
- (if (= peaks max-peaks-1)
- ;; gotta either flush this peak, or find current lowest and flush him
- (let ((minp 0)
- (minpeak (peak-amps 0)))
- (do ((j 1 (+ 1 j)))
- ((= j max-peaks-1))
- (if (< (peak-amps j) minpeak)
- (begin
- (set! minp j)
- (set! minpeak (peak-amps j)))))
- (if (> amp minpeak)
- (begin
- (set! (peak-freqs minp) freq)
- (set! (peak-amps minp) amp))))
- (begin
- (set! (peak-freqs peaks) freq)
- (set! (peak-amps peaks) amp)
- (set! peaks (+ 1 peaks))))))))
- ;; now we have the current peaks -- match them to the previous set and do something interesting with the result
- ;; the end results are reflected in the updated values in the rates and sweeps arrays.
- ;; search for fits between last and current, set rates/sweeps for those found
- ;; try to go by largest amp first
- (do ((k 0 (+ 1 k)))
- ((= k peaks))
- (let ((maxp 0)
- (maxpk (peak-amps 0)))
- (do ((j 1 (+ 1 j)))
- ((= j max-peaks-1))
- (if (> (peak-amps j) maxpk)
- (begin
- (set! maxp j)
- (set! maxpk (peak-amps j)))))
- ;; now maxp points to next largest unmatched peak
- (if (> maxpk 0.0)
- (let* ((closestp -1)
- (closestamp 10.0)
- (current-freq (peak-freqs maxp))
- (icf (/ 1.0 current-freq)))
- (do ((j 0 (+ 1 j)))
- ((= j max-peaks-1))
- (if (> (last-peak-amps j) 0.0)
- (let ((closeness (* icf (abs (- (last-peak-freqs j) current-freq)))))
- (if (< closeness closestamp)
- (begin
- (set! closestamp closeness)
- (set! closestp j))))))
- (if (< closestamp furthest-away-accepted)
- (begin
- ;; peak-amp is transferred to appropriate current-amp and zeroed,
- (set! (current-peak-amps closestp) (peak-amps maxp))
- (set! (peak-amps maxp) 0.0)
- (set! (current-peak-freqs closestp) current-freq)))))))
- (do ((k 0 (+ 1 k)))
- ((= k max-peaks-1))
- (if (> (peak-amps k) 0.0)
- ;; find a place for a new oscil and start it up
- (let ((new-place -1))
- (do ((j 0 (+ 1 j)))
- ((or (not (= new-place -1))
- (= j max-oscils)))
- (if (and (= (last-peak-amps j) 0.0)
- (= (current-peak-amps j) 0.0))
- (set! new-place j)))
- (set! (current-peak-amps new-place) (peak-amps k))
- (set! (peak-amps k) 0.0)
- (set! (current-peak-freqs new-place) (peak-freqs k))
- (set! (last-peak-freqs new-place) (peak-freqs k))
- (set! (mus-frequency (resynth-oscils new-place)) (* transposition (peak-freqs k))))))
- (set! cur-oscils 0)
- (do ((k 0 (+ 1 k)))
- ((= k max-oscils))
- (set! (rates k) (* ifreq (- (current-peak-amps k) (last-peak-amps k))))
- (if (or (not (= (current-peak-amps k) 0.0))
- (not (= (last-peak-amps k) 0.0)))
- (set! cur-oscils k))
- (set! (sweeps k) (* ihifreq transposition (- (current-peak-freqs k) (last-peak-freqs k)))))
- (set! cur-oscils (+ 1 cur-oscils))
- ))
- ;; run oscils, update envelopes
- (set! trigger (+ 1 trigger))
- (if (= ramped 0)
- (set! sum 0.0)
- (begin
- (set! sum (ramped-attack ramp-ind))
- (set! ramp-ind (+ 1 ramp-ind))
- (if (= ramp-ind ramped) (set! ramped 0))))
- (do ((k 0 (+ 1 k)))
- ((= k cur-oscils))
- (set! sum (+ sum (* (amps k) (oscil (resynth-oscils k) (freqs k)))))
- (set! (amps k) (+ (amps k) (rates k)))
- (set! (freqs k) (+ (freqs k) (sweeps k))))
- (outa i (* amp sum))))))))
+ (let ((max-peaks-1 max-peaks)
+ (fftsize-1 fftsize)
+ (highest-bin-1 highest-bin)
+ (start (seconds->samples beg))
+ (attack-size (or attack 1)))
+
+ (let* ((hop (floor (/ fftsize-1 4)))
+ (outhop (floor (* time-scaler hop)))
+ (ifreq (/ 1.0 outhop))
+ (max-oscils (* 2 max-peaks-1)))
+
+ (let ((end (+ start (seconds->samples dur)))
+ (fil (make-readin file))
+ (fdr (make-float-vector fftsize-1))
+ (fdi (make-float-vector fftsize-1))
+ (window (make-fft-window blackman2-window fftsize-1))
+ (current-peak-freqs (make-float-vector max-oscils 0.0))
+ (last-peak-freqs (make-float-vector max-oscils 0.0))
+ (current-peak-amps (make-float-vector max-oscils 0.0))
+ (last-peak-amps (make-float-vector max-oscils 0.0))
+ (peak-amps (make-float-vector max-peaks-1 0.0))
+ (peak-freqs (make-float-vector max-peaks-1 0.0))
+ (amps (make-float-vector max-oscils 0.0)) ;run-time generated amplitude and frequency envelopes
+ (rates (make-float-vector max-oscils 0.0))
+ (freqs (make-float-vector max-oscils 0.0))
+ (sweeps (make-float-vector max-oscils 0.0))
+ ;; (lowest-magnitude .001)
+
+ (ihifreq (hz->radians ifreq))
+ (fftscale (/ 1.0 (* fftsize-1 .42323))) ;integrate Blackman-Harris window = .42323*window width and shift by fftsize-1
+ (fft-mag (/ *clm-srate* fftsize-1))
+ (furthest-away-accepted .1)
+ (filptr 0)
+ (filend 0)
+ (cur-oscils max-oscils)
+ (splice-attack (number? attack))
+ (ramped-attack (make-float-vector attack-size 0.0)))
+ (let ((obank (make-oscil-bank freqs (make-float-vector max-oscils 0.0) amps)))
+
+ (set! filend (mus-length fil))
+ (float-vector-scale! window fftscale)
+
+ (if splice-attack
+ (let ((cur-end (+ start attack-size)))
+ ;; my experience in translating SMS, and rumor via Greg Sandell leads me to believe that
+ ;; there is in fact no way to model some attacks successfully in this manner, so this block
+ ;; simply splices the original attack on to the rest of the note. "attack" is the number
+ ;; of samples to include bodily.
+ (do ((i start (+ i 1)))
+ ((= i cur-end))
+ (outa i (* amp (readin fil))))
+ (set! filptr attack_size)
+ (let ((mult (make-env '(0 1.0 1.0 0.0) :length attack-size)))
+ (do ((k 0 (+ k 1)))
+ ((= k attack-size))
+ (float-vector-set! ramped-attack k (* (env mult) (readin fil)))))
+ (set! start cur-end)))
+
+ (if (< start end)
+ (do ((i start (+ i outhop)))
+ ((>= i end))
+ (if (<= filptr filend)
+ (let ((peaks 0))
+ ;; get next block of data and apply window to it
+ (set! (mus-location fil) filptr)
+ (do ((k 0 (+ k 1)))
+ ((= k fftsize-1))
+ (float-vector-set! fdr k (readin fil)))
+ (float-vector-multiply! fdr window)
+ (set! filptr (+ filptr hop))
+ (fill! fdi 0.0)
+ ;; get the fft
+ (mus-fft fdr fdi fftsize-1 1)
+ ;; change to polar coordinates (ignoring phases)
+ (rectangular->magnitudes fdr fdi)
+ (float-vector-scale! fdr 2.0)
+
+ (float-vector-subseq current-peak-freqs 0 max-oscils last-peak-freqs)
+ (float-vector-subseq current-peak-amps 0 max-oscils last-peak-amps)
+ (fill! current-peak-amps 0.0)
+ (fill! peak-amps 0.0)
+
+ (let ((ra (fdr 0))
+ (la 0.0)
+ (ca 0.0))
+ ;; search for current peaks following Xavier Serra's recommendations in
+ ;; "A System for Sound Analysis/Transformation/Synthesis
+ ;; Based on a Deterministic Plus Stochastic Decomposition"
+ (do ((k 0 (+ k 1)))
+ ((= k highest-bin-1))
+ (set! la ca)
+ (set! ca ra)
+ (set! ra (fdr k))
+ (if (and (> ca .001) ; lowest-magnitude
+ (> ca ra)
+ (> ca la)
+ (not (zero? ra))
+ (not (zero? la)))
+ ;; found a local maximum above the current threshold (its bin number is k-1)
+ (let ((logla (log la 10.0))
+ (logca (log ca 10.0))
+ (logra (log ra 10.0)))
+ (let* ((offset (/ (* .5 (- logla logra)) (+ logla (* -2 logca) logra))) ; isn't logca always 0?
+ (amp (expt 10.0 (- logca (* .25 (- logla logra) offset))))
+ (freq (* fft-mag (+ k offset -1))))
+ ;; (if (not (real? amp)) (format *stderr* "~A ~A ~A -> ~A ~A~%" la ca ra offset amp))
+ (if (= peaks max-peaks-1)
+ ;; gotta either flush this peak, or find current lowest and flush him
+ (let ((minp 0)
+ (minpeak (peak-amps 0)))
+ (do ((j 1 (+ j 1)))
+ ((= j max-peaks-1))
+ (if (< (peak-amps j) minpeak)
+ (begin
+ (set! minp j)
+ (set! minpeak (peak-amps j)))))
+ (if (> amp minpeak)
+ (begin
+ (set! (peak-freqs minp) freq)
+ (set! (peak-amps minp) amp))))
+ (begin
+ (set! (peak-freqs peaks) freq)
+ (set! (peak-amps peaks) amp)
+ (set! peaks (+ peaks 1)))))))))
+ ;; now we have the current peaks -- match them to the previous set and do something interesting with the result
+ ;; the end results are reflected in the updated values in the rates and sweeps arrays.
+ ;; search for fits between last and current, set rates/sweeps for those found
+ ;; try to go by largest amp first
+ (do ((k 0 (+ k 1)))
+ ((= k peaks))
+ (let ((pl (float-vector-peak-and-location peak-amps)))
+ (let ((maxpk (car pl))
+ (maxp (cadr pl)))
+ ;; now maxp points to next largest unmatched peak
+ (if (> maxpk 0.0)
+ (let ((closestp -1)
+ (closestamp 10.0)
+ (current-freq (peak-freqs maxp)))
+ (let ((icf (/ 1.0 current-freq)))
+ (do ((j 0 (+ j 1)))
+ ((= j max-peaks-1))
+ (if (> (last-peak-amps j) 0.0)
+ (let ((closeness (* icf (abs (- (last-peak-freqs j) current-freq)))))
+ (if (< closeness closestamp)
+ (begin
+ (set! closestamp closeness)
+ (set! closestp j))))))
+ (if (< closestamp furthest-away-accepted)
+ (begin
+ ;; peak-amp is transferred to appropriate current-amp and zeroed,
+ (set! (current-peak-amps closestp) (peak-amps maxp))
+ (set! (peak-amps maxp) 0.0)
+ (set! (current-peak-freqs closestp) current-freq)))))))))
+ (do ((k 0 (+ k 1)))
+ ((= k max-peaks-1))
+ (if (> (peak-amps k) 0.0)
+ ;; find a place for a new oscil and start it up
+ (let ((new-place -1))
+ (do ((j 0 (+ j 1)))
+ ((or (not (= new-place -1))
+ (= j max-oscils)))
+ (if (= (last-peak-amps j) 0.0 (current-peak-amps j))
+ (set! new-place j)))
+ (set! (current-peak-amps new-place) (peak-amps k))
+ (set! (peak-amps k) 0.0)
+ (set! (current-peak-freqs new-place) (peak-freqs k))
+ (set! (last-peak-freqs new-place) (peak-freqs k))
+ (set! (freqs new-place) (hz->radians (* transposition (peak-freqs k)))))))
+ (set! cur-oscils 0)
+ (do ((k 0 (+ k 1)))
+ ((= k max-oscils))
+ (set! (rates k) (* amp ifreq (- (current-peak-amps k) (last-peak-amps k))))
+ (if (or (not (= (current-peak-amps k) 0.0))
+ (not (= (last-peak-amps k) 0.0)))
+ (set! cur-oscils k))
+ (set! (sweeps k) (* ihifreq transposition (- (current-peak-freqs k) (last-peak-freqs k)))))
+ (set! cur-oscils (+ cur-oscils 1))
+ (set! (mus-length obank) cur-oscils)
+
+ (let ((stop (min end (+ i outhop))))
+ (do ((k i (+ k 1)))
+ ((= k stop))
+ ;; run oscils, update envelopes
+ (outa k (oscil-bank obank))
+ (float-vector-add! amps rates)
+ (float-vector-add! freqs sweeps))))))))))))
+
+;; (with-sound (:statistics #t) (pins 0 2 "oboe.snd" 1.0 :max-peaks 8))
(definstrument (zc time dur freq amp length1 length2 feedback)
- (let* ((beg (seconds->samples time))
- (end (+ beg (seconds->samples dur)))
- (s (make-pulse-train :frequency freq))
+ (let ((beg (seconds->samples time))
+ (end (seconds->samples (+ time dur)))
+ (s (make-pulse-train freq amp))
(d0 (make-comb :size length1 :max-size (+ 1 (max length1 length2)) :scaler feedback))
(zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :duration dur)))
- (run
(do ((i beg (+ i 1)))
((= i end))
- (outa i (comb d0 (* amp (pulse-train s)) (env zenv)))))))
+ (outa i (comb d0 (pulse-train s) (env zenv))))))
-;;(with-sound () (zc 0 3 100 .1 20 100 .95) (zc 3.5 3 100 .1 100 20 .95))
+;; (with-sound () (zc 0 3 100 .1 20 100 .95) (zc 3.5 3 100 .1 100 20 .95))
(definstrument (zn time dur freq amp length1 length2 feedforward)
;; notches are spaced at srate/len, feedforward sets depth thereof
;; so sweep of len from 20 to 100 sweeps the notches down from 1000 Hz to ca 200 Hz
;; so we hear our downward glissando beneath the pulses.
- (let* ((beg (seconds->samples time))
- (end (+ beg (seconds->samples dur)))
- (s (make-pulse-train :frequency freq))
+ (let ((beg (seconds->samples time))
+ (end (seconds->samples (+ time dur)))
+ (s (make-pulse-train freq amp))
(d0 (make-notch :size length1 :max-size (+ 1 (max length1 length2)) :scaler feedforward))
(zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :duration dur)))
- (run
(do ((i beg (+ i 1)))
((= i end))
- (outa i (notch d0 (* amp (pulse-train s)) (env zenv)))))))
+ (outa i (notch d0 (pulse-train s) (env zenv))))))
;;(with-sound () (zn 0 1 100 .1 20 100 .995) (zn 1.5 1 100 .1 100 20 .995))
(definstrument (za time dur freq amp length1 length2 feedback feedforward)
- (let* ((beg (seconds->samples time))
- (end (+ beg (seconds->samples dur)))
- (s (make-pulse-train :frequency freq))
+ (let ((beg (seconds->samples time))
+ (end (seconds->samples (+ time dur)))
+ (s (make-pulse-train freq amp))
(d0 (make-all-pass feedback feedforward :size length1 :max-size (+ 1 (max length1 length2))))
(zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :duration dur)))
- (run
(do ((i beg (+ i 1)))
((= i end))
- (outa i (all-pass d0 (* amp (pulse-train s)) (env zenv)))))))
+ (outa i (all-pass d0 (pulse-train s) (env zenv))))))
;;(with-sound () (za 0 1 100 .1 20 100 .95 .95) (za 1.5 1 100 .1 100 20 .95 .95))
(define* (clm-expsrc beg dur input-file exp-ratio src-ratio amp rev start-in-file)
- (let* ((st (seconds->samples beg))
- (stf (floor (* (or start-in-file 0) (srate input-file))))
- (fdA (make-readin input-file :channel 0 :start stf))
- (exA (make-granulate :expansion exp-ratio))
- (two-chans (and (= (channels input-file) 2) (= (channels *output*) 2)))
- (fdB (and two-chans (make-readin input-file :channel 1 :start stf)))
- (exB (and two-chans (make-granulate :expansion exp-ratio)))
- (srcA (make-src :srate src-ratio))
- (srcB (and two-chans (make-src :srate src-ratio)))
- (revit (and *reverb* rev))
- (rev-amp (if revit (if two-chans (* rev .5) rev) 0.0))
- (nd (+ st (seconds->samples dur))))
- (run
- (do ((i st (+ i 1))) ((= i nd))
- (let ((valA (* amp (src srcA 0.0 (lambda (dir) (granulate exA (lambda (dir) (readin fdA)))))))
- (valB (if two-chans (* amp (src srcB 0.0 (lambda (dir) (granulate exB (lambda (dir) (readin fdB)))))) 0.0)))
- (out-any i valA 0)
- (if two-chans (out-any i valB 1))
- (if revit (out-any i (* rev-amp (+ valA valB)) 0 *reverb*)))))))
+ (let ((stf (floor (* (or start-in-file 0) (srate input-file))))
+ (two-chans (= (channels input-file) 2 (channels *output*)))
+ (revit (and *reverb* rev)))
+ (let ((st (seconds->samples beg))
+ (exA (make-granulate (make-readin input-file :channel 0 :start stf) :expansion exp-ratio))
+ (exB (and two-chans (make-granulate (make-readin input-file :channel 1 :start stf) :expansion exp-ratio))))
+ (let ((srcA (make-src :srate src-ratio
+ :input (lambda (dir) (granulate exA))))
+ (srcB (and two-chans (make-src :srate src-ratio
+ :input (lambda (dir) (granulate exB)))))
+ (rev-amp (if revit (if two-chans (* rev .5) rev) 0.0))
+ (nd (seconds->samples (+ beg dur))))
+ (if revit
+ (let ((valA 0.0)
+ (valB 0.0))
+ (if two-chans
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (set! valA (* amp (src srcA)))
+ (set! valB (* amp (src srcB)))
+ (outa i valA)
+ (outb i valB)
+ (outa i (* rev-amp (+ valA valB)) *reverb*))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (set! valA (* amp (src srcA)))
+ (outa i valA)
+ (outa i (* rev-amp valA) *reverb*))))
+ (if two-chans
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (* amp (src srcA)))
+ (outb i (* amp (src srcB))))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (* amp (src srcA))))))))))
+
+;;; (with-sound () (clm-expsrc 0 2.5 "oboe.snd" 2.0 1.0 1.0))
(definstrument (exp-snd file beg dur amp (exp-amt 1.0) (ramp .4) (seglen .15) (sr 1.0) (hop .05) ampenv)
;; granulate with envelopes on the expansion amount, segment envelope shape,
;; segment length, hop length, and input file resampling rate
- (let* ((st (seconds->samples beg))
- (nd (+ st (seconds->samples dur)))
- (f0 (make-readin file 0))
- (expenv (make-env (if (list? exp-amt)
- (or exp-amt (list 0 1 1 1))
- (list 0 exp-amt 1 exp-amt))
- :duration dur))
- (lenenv (make-env (if (list? seglen)
- (or seglen (list 0 .15 1 .15))
- (list 0 seglen 1 seglen))
- :duration dur))
- (max-seg-len (if seglen (if (list? seglen) (max-envelope seglen) seglen) .15))
- (initial-seg-len (if seglen (if (list? seglen) (cadr seglen) seglen) .15))
- (scaler-amp (if (> max-seg-len .15) (/ (* 0.6 .15) max-seg-len) 0.6))
- (srenv (make-env (if (list? sr)
- (or sr (list 0 1 1 1))
- (list 0 sr 1 sr))
- :duration dur))
- (rampdata (if (list? ramp)
- (or ramp (list 0 .4 1 .4))
- (list 0 ramp 1 ramp)))
- (rampenv (make-env rampdata :duration dur))
- (initial-ramp-time (if ramp (if (list? ramp) (cadr ramp) ramp) .4))
- (hopenv (make-env (if (list? hop)
- (or hop (list 0 .05 1 .05))
- (list 0 hop 1 hop))
- :duration dur))
- (max-out-hop (if hop (if (list? hop) (max-envelope hop) hop) .05))
- (initial-out-hop (if hop (if (list? hop) (cadr hop) hop) .05))
- (min-exp-amt (if exp-amt (if (list? exp-amt) (min-envelope exp-amt) exp-amt) 1.0))
- (initial-exp-amt (if exp-amt (if (list? exp-amt) (cadr exp-amt) exp-amt) 1.0))
- (max-in-hop (/ max-out-hop min-exp-amt))
- (max-len (seconds->samples (+ (max max-out-hop max-in-hop) max-seg-len)))
- (ampe (make-env (or ampenv (list 0 0 .5 1 1 0)) :scaler amp :duration dur))
- (exA (make-granulate :expansion initial-exp-amt
- :input f0
- :max-size max-len
- :ramp initial-ramp-time
- :hop initial-out-hop
- :length initial-seg-len
- :scaler scaler-amp))
- (ex-samp 0.0)
- (next-samp 0.0)
- (vol (env ampe))
- (valA0 (* vol (granulate exA)))
- (valA1 (* vol (granulate exA))))
+ (let ((max-seg-len (if seglen (if (pair? seglen) (max-envelope seglen) seglen) .15))
+ (initial-seg-len (if seglen (if (pair? seglen) (cadr seglen) seglen) .15))
+ (rampdata (if (pair? ramp) ramp (list 0 ramp 1 ramp)))
+ (max-out-hop (if hop (if (pair? hop) (max-envelope hop) hop) .05))
+ (initial-out-hop (if hop (if (pair? hop) (cadr hop) hop) .05))
+ (min-exp-amt (if exp-amt (if (pair? exp-amt) (min-envelope exp-amt) exp-amt) 1.0))
+ (initial-exp-amt (if exp-amt (if (pair? exp-amt) (cadr exp-amt) exp-amt) 1.0)))
(if (or (<= (min-envelope rampdata) 0.0)
(>= (max-envelope rampdata) 0.5))
- (format #t "ramp argument to expsnd must always be between 0.0 and 0.5: ~A" ramp)
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (let* ((expa (env expenv)) ;current expansion amount
- (segl (env lenenv)) ;current segment length
- (resa (env srenv)) ;current resampling increment
- (rmpl (env rampenv)) ;current ramp length (0 to .5)
- (hp (env hopenv)) ;current hop size
+ (format #t "ramp argument to exp-snd must always be between 0.0 and 0.5: ~A" ramp)
+ (let ((st (seconds->samples beg))
+ (nd (seconds->samples (+ beg dur)))
+ (f0 (make-readin file 0))
+ (expenv (make-env (if (pair? exp-amt)
+ exp-amt
+ (list 0 exp-amt 1 exp-amt))
+ :duration dur))
+ (lenenv (make-env (if (pair? seglen)
+ seglen
+ (list 0 seglen 1 seglen))
+ :scaler *clm-srate* :duration dur))
+ (scaler-amp (if (> max-seg-len .15) (/ (* 0.6 .15) max-seg-len) 0.6))
+ (srenv (make-env (if (pair? sr)
+ sr
+ (list 0 sr 1 sr))
+ :duration dur))
+ (rampenv (make-env rampdata :duration dur))
+ (initial-ramp-time (if ramp (if (pair? ramp) (cadr ramp) ramp) .4))
+ (max-in-hop (/ max-out-hop min-exp-amt)))
+ (let ((max-len (seconds->samples (+ (max max-out-hop max-in-hop) max-seg-len)))
+ (hopenv (make-env (if (pair? hop)
+ hop
+ (list 0 hop 1 hop))
+ :duration dur))
+ (ampe (make-env (or ampenv (list 0 0 .5 1 1 0)) :scaler amp :duration dur)))
+ (let ((exA (make-granulate :expansion initial-exp-amt
+ :input f0
+ :max-size max-len
+ :ramp initial-ramp-time
+ :hop initial-out-hop
+ :length initial-seg-len
+ :scaler scaler-amp))
+ (ex-samp 0.0)
+ (next-samp 0.0)
+ (vol 0.0)
+ (valA0 0.0)
+ (valA1 0.0))
+
+ (set! vol (env ampe))
+ (set! valA0 (* vol (granulate exA)))
+ (set! valA1 (* vol (granulate exA)))
+
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (let ((sl (env lenenv))) ;current segment length
;; now we set the granulate generator internal state to reflect all these envelopes
- (sl (seconds->samples segl))
- (rl (floor (* rmpl sl))))
- (set! vol (env ampe))
- (set! (mus-length exA) sl)
- (set! (mus-ramp exA) rl)
- (set! (mus-frequency exA) hp)
- (set! (mus-increment exA) expa)
- (set! next-samp (+ next-samp resa))
- (if (> next-samp (+ 1 ex-samp))
- (let ((samps (floor (- next-samp ex-samp))))
- (do ((k 0 (+ 1 k)))
- ((= k samps))
- (set! valA0 valA1)
- (set! valA1 (* vol (granulate exA)))
- (set! ex-samp (+ 1 ex-samp)))))
- (if (= next-samp ex-samp)
- (outa i valA0)
- (outa i (+ valA0 (* (- next-samp ex-samp) (- valA1 valA0)))))))))))
-
-;;; (with-sound () (exp-snd "fyow.snd" 0 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05))
+ (set! vol (env ampe))
+ (set! (mus-length exA) (round sl))
+ (set! (mus-ramp exA) (floor (* sl (env rampenv)))) ;current ramp length (0 to .5)
+ (set! (mus-frequency exA) (env hopenv)) ;current hop size
+ (set! (mus-increment exA) (env expenv)) ;current expansion amount
+ (set! next-samp (+ next-samp (env srenv))) ;current resampling increment
+ (if (> next-samp (+ 1 ex-samp))
+ (let ((samps (floor (- next-samp ex-samp))))
+ (if (> samps 2)
+ (do ((k 0 (+ k 1)))
+ ((= k (- samps 2)))
+ (granulate exA)))
+ (if (>= samps 2)
+ (set! valA0 (* vol (granulate exA)))
+ (set! valA0 valA1))
+ (set! valA1 (* vol (granulate exA)))
+ (set! ex-samp (+ ex-samp samps))))
+ (if (= next-samp ex-samp)
+ (outa i valA0)
+ (outa i (+ valA0 (* (- next-samp ex-samp) (- valA1 valA0)))))))))))))
+
+;;; (with-sound (:statistics #t) (exp-snd "fyow.snd" 0 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05))
;;; (with-sound () (exp-snd "oboe.snd" 0 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.2))
(defgenerator grn
- (rampval 0.0 :type float)
- (rampinc 0.0 :type float)
- (loc 0 :type int)
- (segctr 0 :type int)
- (whichseg 0 :type int)
- (ramplen 0 :type int)
- (steadylen 0 :type int)
- (trigger 0 :type int))
+ (rampval 0.0)
+ (rampinc 0.0)
+ (loc 0)
+ (segctr 0)
+ (whichseg 0)
+ (ramplen 0)
+ (steadylen 0)
+ (trigger 0)
+ file)
(definstrument (expfil start duration hopsecs rampsecs steadysecs file1 file2)
- (let* ((fil1 (make-file->sample file1))
+ (let ((fil1 (make-file->sample file1))
(fil2 (make-file->sample file2))
(hop (seconds->samples hopsecs))
- (ramplen (seconds->samples rampsecs))
- (steadylen (seconds->samples steadysecs))
- (grn1 (make-grn :rampval 0.0 :rampinc (/ 1.0 ramplen) :loc 0 :segctr 0 :whichseg 0 :ramplen ramplen :steadylen steadylen :trigger 0))
- (grn2 (make-grn :rampval 0.0 :rampinc (/ 1.0 ramplen) :loc 0 :segctr 0 :whichseg 0 :ramplen ramplen :steadylen steadylen :trigger 0))
+ (rampdur (seconds->samples rampsecs))
+ (steadydur (seconds->samples steadysecs))
(beg (seconds->samples start))
- (end (+ beg (seconds->samples duration)))
- (out1 beg)
- (out2 (+ hop beg)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((val 0.0))
- (if (= i out1)
- (let ((inval (ina (grn-loc grn1) fil1)))
- (set! (grn-loc grn1) (+ 1 (grn-loc grn1)))
- (if (= (grn-whichseg grn1) 0) ;ramp-up
- (begin
- (set! inval (* inval (grn-rampval grn1)))
- (set! (grn-rampval grn1) (+ (grn-rampval grn1) (grn-rampinc grn1)))
- (set! (grn-segctr grn1) (+ 1 (grn-segctr grn1)))
- (if (= (grn-segctr grn1) (grn-ramplen grn1))
- (begin
- (set! (grn-segctr grn1) 0)
- (set! (grn-whichseg grn1) (+ 1 (grn-whichseg grn1))))))
- (if (= (grn-whichseg grn1) 1) ;steady-state
- (begin
- (set! (grn-segctr grn1) (+ 1 (grn-segctr grn1)))
- (if (= (grn-segctr grn1) (grn-steadylen grn1))
- (begin
- (set! (grn-segctr grn1) 0)
- (set! (grn-whichseg grn1) (+ 1 (grn-whichseg grn1))))))
- (begin ;ramp-down
- (set! inval (* inval (grn-rampval grn1)))
- (set! (grn-segctr grn1) (+ 1 (grn-segctr grn1)))
- (set! (grn-rampval grn1) (- (grn-rampval grn1) (grn-rampinc grn1)))
- (if (= (grn-segctr grn1) (grn-ramplen grn1))
- (begin
- (set! (grn-segctr grn1) 0)
- (set! (grn-trigger grn1) 1)
- (set! (grn-whichseg grn1) 0)
- (set! (grn-rampval grn1) 0.0))))))
- (set! val inval)
- (set! out1 (+ 1 out1))
- (if (= (grn-trigger grn1) 1)
- (begin
- (set! (grn-trigger grn1) 0)
- (set! out1 (+ out1 hop))))))
- (if (= i out2)
- (let ((inval (ina (grn-loc grn2) fil2)))
- (set! (grn-loc grn2) (+ 1 (grn-loc grn2)))
- (if (= (grn-whichseg grn2) 0) ;ramp-up
- (begin
- (set! inval (* inval (grn-rampval grn2)))
- (set! (grn-rampval grn2) (+ (grn-rampval grn2) (grn-rampinc grn2)))
- (set! (grn-segctr grn2) (+ 1 (grn-segctr grn2)))
- (if (= (grn-segctr grn2) (grn-ramplen grn2))
- (begin
- (set! (grn-segctr grn2) 0)
- (set! (grn-whichseg grn2) (+ 1 (grn-whichseg grn2))))))
- (if (= (grn-whichseg grn2) 1) ;steady-state
- (begin
- (set! (grn-segctr grn2) (+ 1 (grn-segctr grn2)))
- (if (= (grn-segctr grn2) (grn-steadylen grn2))
- (begin
- (set! (grn-segctr grn2) 0)
- (set! (grn-whichseg grn2) (+ 1 (grn-whichseg grn2))))))
- (begin ;ramp-down
- (set! inval (* inval (grn-rampval grn2)))
- (set! (grn-segctr grn2) (+ 1 (grn-segctr grn2)))
- (set! (grn-rampval grn2) (- (grn-rampval grn2) (grn-rampinc grn2)))
- (if (= (grn-segctr grn2) (grn-ramplen grn2))
- (begin
- (set! (grn-segctr grn2) 0)
- (set! (grn-trigger grn2) 1)
- (set! (grn-whichseg grn2) 0)
- (set! (grn-rampval grn2) 0.0))))))
- (set! val (+ val inval))
- (set! out2 (+ 1 out2))
- (if (= (grn-trigger grn2) 1)
- (begin
- (set! (grn-trigger grn2) 0)
- (set! out2 (+ out2 hop))))))
- (outa i val))))))
-
+ (end (seconds->samples (+ start duration))))
+ (let ((grn1 (make-grn :rampval 0.0 :rampinc (/ 1.0 rampdur) :loc 0 :segctr 0 :whichseg 0 :ramplen rampdur :steadylen steadydur :trigger 0 :file fil1))
+ (grn2 (make-grn :rampval 0.0 :rampinc (/ 1.0 rampdur) :loc 0 :segctr 0 :whichseg 0 :ramplen rampdur :steadylen steadydur :trigger 0 :file fil2))
+ (out1 beg)
+ (out2 (+ hop beg)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((val 0.0))
+ (if (= i out1)
+ (begin
+ (set! val (with-let grn1
+ (let ((inval (ina loc file)))
+ (set! loc (+ loc 1))
+ (if (= whichseg 0) ;ramp-up
+ (begin
+ (set! inval (* inval rampval))
+ (set! rampval (+ rampval rampinc))
+ (set! segctr (+ segctr 1))
+ (if (= segctr ramplen)
+ (begin
+ (set! segctr 0)
+ (set! whichseg (+ whichseg 1)))))
+ (if (= whichseg 1) ;steady-state
+ (begin
+ (set! segctr (+ segctr 1))
+ (if (= segctr steadylen)
+ (begin
+ (set! segctr 0)
+ (set! whichseg (+ whichseg 1)))))
+ (begin ;ramp-down
+ (set! inval (* inval rampval))
+ (set! segctr (+ segctr 1))
+ (set! rampval (- rampval rampinc))
+ (if (= segctr ramplen)
+ (begin
+ (set! segctr 0)
+ (set! trigger 1)
+ (set! whichseg 0)
+ (set! rampval 0.0))))))
+ inval)))
+ (set! out1 (+ out1 1))
+ (if (= (grn1 'trigger) 1)
+ (begin
+ (set! (grn1 'trigger) 0)
+ (set! out1 (+ out1 hop))))))
+ (if (= i out2)
+ (begin
+ (set! val (+ val (with-let grn2
+ (let ((inval (ina loc file)))
+ (set! loc (+ loc 1))
+ (if (= whichseg 0) ;ramp-up
+ (begin
+ (set! inval (* inval rampval))
+ (set! rampval (+ rampval rampinc))
+ (set! segctr (+ segctr 1))
+ (if (= segctr ramplen)
+ (begin
+ (set! segctr 0)
+ (set! whichseg (+ whichseg 1)))))
+ (if (= whichseg 1) ;steady-state
+ (begin
+ (set! segctr (+ segctr 1))
+ (if (= segctr steadylen)
+ (begin
+ (set! segctr 0)
+ (set! whichseg (+ whichseg 1)))))
+ (begin ;ramp-down
+ (set! inval (* inval rampval))
+ (set! segctr (+ segctr 1))
+ (set! rampval (- rampval rampinc))
+ (if (= segctr ramplen)
+ (begin
+ (set! segctr 0)
+ (set! trigger 1)
+ (set! whichseg 0)
+ (set! rampval 0.0))))))
+ inval))))
+ (set! out2 (+ out2 1))
+ (if (= (grn2 'trigger) 1)
+ (begin
+ (set! (grn2 'trigger) 0)
+ (set! out2 (+ out2 hop))))))
+ (outa i val))))))
+
;;; (with-sound () (expfil 0 2 .2 .01 .1 "oboe.snd" "fyow.snd"))
-
-
+
+
#|
From: Marco Trevisani <marco at ccrma.Stanford.EDU>
@@ -2328,7 +2411,7 @@ sndfile input, otherwise the duration in seconds.
"gain-freq-list" is a list of gains and frequencies to
filter --in this order gain and frequencies--. There is no limit to
the size of the list. Gain can be a number or an
-envelope. Unfortunatelly in this version they cant alternate, one
+envelope. Unfortunatelly in this version they can't alternate, one
should chose, all envelopes or all numbers i.e.:
case 1 -> '( .1 440.0 .3 1500.0 .2 330.0 ...etc) or
case 2 -> '((0 .1 1 .5) 440.0 (0 1 1 .01) 1500 (0 .3 1 .5) 330.0 ...etc)
@@ -2349,128 +2432,117 @@ nil doesnt print anything, which will speed up a bit the process.
(definstrument (graphEq file (beg 0) (dur 0) (or-beg 0) (amp 1) (amp-env '(0 1 .8 1 1 0)) (amp-base 1)
(offset-gain 0)
- (gain-freq-list '((0 1 1 0) 440 (0 0 1 1) 660))
+ (gain-freq-list '(.8 440 .2 660))
(filt-gain-scale 1)
(filt-gain-base 1)
- (a1 .99)
- (stats #t))
- (let* ((st (seconds->samples beg))
- (durata (if (= 0 dur) (mus-sound-duration file) dur))
- (nd (+ st (seconds->samples durata)))
- (or-start (round (* or-beg (srate file))))
- (RdA (make-readin :file file :start or-start))
- (half-list (/ (length gain-freq-list) 2))
- (ampenv (make-env amp-env :scaler amp :duration durata :base amp-base))
- (gain-list (let ((lst '())
- (len (length gain-freq-list)))
- (do ((i (- len 2) (- i 2)))
- ((< i 0))
- (set! lst (cons (list-ref gain-freq-list i) lst)))
- lst))
- (freq-list (let ((lst '())
- (len (length gain-freq-list)))
- (do ((i (- len 1) (- i 2)))
- ((<= i 0))
- (set! lst (cons (list-ref gain-freq-list i) lst)))
- lst))
- (env-size (if (list? (car gain-list))
- (make-vector (length freq-list))
- #f))
- (if-list-in-gain (list? (car gain-list)))
- (frm-size (make-vector (length freq-list)))
- (gains (make-vct (length freq-list) 1.0))
- (samp -1))
-
- (do ((k 0 (+ 1 k)))
- ((= k half-list))
- (let ((gval (list-ref gain-list k))
- (fval (list-ref freq-list k)))
- (if (list? gval)
- (begin
- (set! (env-size k) (make-env gval
- :scaler filt-gain-scale
- :duration durata :base filt-gain-base))
- (set! (frm-size k) (make-formant fval a1)))
- (begin
- (set! (frm-size k) (make-formant fval a1))
- (set! (gains k) (if (< (+ offset-gain gval) 0)
- 0
- (+ offset-gain gval)))))))
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (if stats
- (begin
- (set! samp (+ 1 samp))
- (if (= samp (mus-srate))
- (begin
- (set! samp 0)))))
- (let ((outval 0.0)
- (inval (readin RdA)))
- (do ((k 0 (+ 1 k)))
- ((= k half-list))
- (if if-list-in-gain
- (set! (gains k) (* (env (env-size k)) (- 1.0 a1))))
- (set! outval (+ outval (* (gains k)
- (formant (frm-size k) inval)))))
- (outa i (* (env ampenv) outval)))))))
+ (a1 .99))
+ (let ((st (seconds->samples beg))
+ (durata (if (= 0 dur) (mus-sound-duration file) dur))
+ (or-start (round (* or-beg (srate file))))
+ (gain-list (let ((lst ())
+ (len (length gain-freq-list)))
+ (do ((i (- len 2) (- i 2)))
+ ((< i 0))
+ (set! lst (cons (gain-freq-list i) lst)))
+ lst))
+ (freq-list (let ((lst ())
+ (len (length gain-freq-list)))
+ (do ((i (- len 1) (- i 2)))
+ ((<= i 0))
+ (set! lst (cons (gain-freq-list i) lst)))
+ lst)))
+ (let ((nd (+ st (seconds->samples durata)))
+ (RdA (make-readin :file file :start or-start))
+ (half-list (/ (length gain-freq-list) 2))
+ (ampenv (make-env amp-env :scaler amp :duration durata :base amp-base))
+ (env-size (and (pair? (car gain-list))
+ (make-vector (length freq-list))))
+ (if-list-in-gain (pair? (car gain-list)))
+ (frm-size (make-vector (length freq-list)))
+ (gains (make-float-vector (length freq-list) 1.0)))
+
+ (do ((k 0 (+ k 1)))
+ ((= k half-list))
+ (let ((gval (gain-list k))
+ (fval (freq-list k)))
+ (if (pair? gval)
+ (begin
+ (set! (env-size k) (make-env gval
+ :scaler (* filt-gain-scale (- 1.0 a1))
+ :duration durata :base filt-gain-base))
+ (set! (frm-size k) (make-formant fval a1)))
+ (begin
+ (set! (frm-size k) (make-formant fval a1))
+ (set! (gains k) (if (< (+ offset-gain gval) 0)
+ 0
+ (+ offset-gain gval)))))))
+ (set! frm-size (make-formant-bank frm-size gains))
+
+ (if if-list-in-gain
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (do ((k 0 (+ k 1)))
+ ((= k half-list))
+ (float-vector-set! gains k (env (vector-ref env-size k))))
+ (outa i (* (env ampenv) (formant-bank frm-size (readin RdA)))))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (* (env ampenv) (formant-bank frm-size (readin RdA)))))))))
(definstrument (anoi infile start dur (fftsize 128) (amp-scaler 1.0) rr)
;; a kind of noise reduction -- on-going average spectrum is squelched to some extent
;; obviously aimed at intermittent signal in background noise
;; this is based on Perry Cook's Scrubber.m
- (let* ((r (or rr (* 2.0 pi)))
- (freq-inc (floor (/ fftsize 2)))
- (fdi (make-vct fftsize))
- (fdr (make-vct fftsize))
- (spectr (make-vct freq-inc 1.0))
- (scales (make-vct freq-inc 1.0))
- (diffs (make-vct freq-inc))
- (win (make-fft-window blackman2-window fftsize))
- (k 0)
- (amp 0.0)
- (incr (/ (* amp-scaler 4) (mus-srate)))
- (beg (seconds->samples start))
- (end (+ beg (seconds->samples dur)))
- (file (make-file->sample infile))
- (radius (- 1.0 (/ r fftsize)))
- (bin (/ (mus-srate) fftsize))
- (fs (make-vector freq-inc))
- (samp 0))
- (do ((ctr 0 (+ 1 ctr)))
- ((= ctr freq-inc))
- (set! (fs ctr) (make-formant (* ctr bin) radius)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((inval (file->sample file samp)))
- (set! samp (+ 1 samp))
- (set! (fdr k) inval)
- (set! k (+ 1 k))
- (if (< amp amp-scaler) (set! amp (+ amp incr)))
- (if (>= k fftsize)
- (begin
- (set! k 0)
- (spectrum fdr fdi win 1)
- (do ((ctr 0 (+ 1 ctr)))
- ((= ctr freq-inc))
- (set! (spectr ctr) (+ (* .9 (spectr ctr)) (* .1 (fdr ctr))))
- (if (>= (spectr ctr) (fdr ctr))
- (set! (diffs ctr) (/ (scales ctr) (- fftsize)))
- (set! (diffs ctr)
- (/ (- (/ (- (fdr ctr) (spectr ctr))
- (fdr ctr))
- (scales ctr))
- fftsize))))))
- (let ((outval 0.0))
- (do ((ctr 1 (+ 1 ctr)))
- ((= ctr freq-inc))
- (let ((cur-scale (scales ctr)))
- (set! outval (+ outval (* cur-scale (formant (fs ctr) inval))))
- (set! (scales ctr) (+ (scales ctr) (diffs ctr)))))
- (outa i (* amp outval))))))))
-
+ (let ((r (or rr (* 2.0 pi)))
+ (freq-inc (floor (/ fftsize 2)))
+ (fdi (make-float-vector fftsize))
+ (fdr (make-float-vector fftsize)))
+ (let ((spectr (make-vector freq-inc 1.0))
+ (scales (make-float-vector freq-inc 1.0))
+ (diffs (make-float-vector freq-inc 0.0))
+ (win (make-fft-window blackman2-window fftsize))
+ (k 0)
+ (amp 0.0)
+ (incr (/ (* amp-scaler 4) *clm-srate*))
+ (beg (seconds->samples start))
+ (end (seconds->samples (+ start dur)))
+ (file (make-file->sample infile))
+ (radius (- 1.0 (/ r fftsize)))
+ (bin (/ *clm-srate* fftsize))
+ (fs (make-vector freq-inc))
+ (samp 0)
+ (fdrc 0.0))
+
+ (do ((ctr 0 (+ ctr 1)))
+ ((= ctr freq-inc))
+ (set! (fs ctr) (make-formant (* ctr bin) radius)))
+ (set! fs (make-formant-bank fs scales))
+
+ (set! (scales 0) 0.0)
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((inval (file->sample file samp)))
+ (set! samp (+ samp 1))
+ (set! (fdr k) inval)
+ (set! k (+ k 1))
+ (if (< amp amp-scaler) (set! amp (+ amp incr)))
+ (if (>= k fftsize)
+ (begin
+ (set! k 0)
+ (spectrum fdr fdi win 1)
+ (do ((ctr 0 (+ ctr 1)))
+ ((= ctr freq-inc))
+ (set! fdrc (fdr ctr))
+ (set! (spectr ctr) (+ (* .9 (spectr ctr)) (* .1 fdrc)))
+ (if (>= (spectr ctr) fdrc)
+ (set! (diffs ctr) (/ (scales ctr) (- fftsize)))
+ (set! (diffs ctr)
+ (/ (- (/ (- fdrc (spectr ctr)) fdrc)
+ (scales ctr))
+ fftsize))))))
+ (outa i (* amp (formant-bank fs inval)))
+ (float-vector-add! scales diffs))))))
#|
Date: Fri, 25 Sep 1998 09:56:41 +0300
@@ -2498,21 +2570,21 @@ mjkoskin at sci.fi
;;; bes-fm -- can also use bes-j0 here as in earlier versions
-(define (bes-fm beg dur freq amp ratio index)
- "(bes-fm beg dur freq amp ratio index) produces J1(J1) imitating FM"
- (let* ((st (seconds->samples beg))
- (nd (+ st (seconds->samples dur)))
- (car-ph 0.0)
- (mod-ph 0.0)
- (car-incr (hz->radians freq))
- (mod-incr (* ratio car-incr))
- (ampenv (make-env '(0 0 25 1 75 1 100 0) :scaler amp :duration dur)))
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (outa i (* (env ampenv) (bes-j1 car-ph)))
- (set! car-ph (+ car-ph car-incr (* index (bes-j1 mod-ph))))
- (set! mod-ph (+ mod-ph mod-incr))))))
+(define bes-fm
+ (let ((documentation "(bes-fm beg dur freq amp ratio index) produces J1(J1) imitating FM"))
+ (lambda (beg dur freq amp ratio index)
+ (let ((car-incr (hz->radians freq)))
+ (let ((st (seconds->samples beg))
+ (nd (seconds->samples (+ beg dur)))
+ (car-ph 0.0)
+ (mod-ph 0.0)
+ (mod-incr (* ratio car-incr))
+ (ampenv (make-env '(0 0 25 1 75 1 100 0) :scaler amp :duration dur)))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (* (env ampenv) (bes-j1 car-ph)))
+ (set! car-ph (+ car-ph car-incr (* index (bes-j1 mod-ph))))
+ (set! mod-ph (+ mod-ph mod-incr))))))))
;;; (with-sound (:statistics #t) (bes-fm 0 1 440 10.0 1.0 4.0))
@@ -2521,428 +2593,139 @@ mjkoskin at sci.fi
;;; this might be better named "quasi-ssb-fm" -- cancellations are not perfect
(defgenerator sbfm
- (am0 #f :type clm) (am1 #f :type clm)
- (car0 #f :type clm) (car1 #f :type clm)
- (mod0 #f :type clm) (mod1 #f :type clm))
-
-(define (make-ssb-fm freq)
- "(make-ssb-fm freq) makes an ssb-fm generator"
- (make-sbfm :am0 (make-oscil freq 0)
- :am1 (make-oscil freq (* 0.5 pi))
- :car0 (make-oscil 0 0)
- :car1 (make-oscil 0 (* 0.5 pi))
- :mod0 (make-hilbert-transform 40)
- :mod1 (make-delay 40)))
-
-(define (ssb-fm gen modsig)
- "(ssb-fm gen modsig) runs an ssb-fm generator"
- (+ (* (oscil (sbfm-am0 gen))
- (oscil (sbfm-car0 gen) (hilbert-transform (sbfm-mod0 gen) modsig)))
- (* (oscil (sbfm-am1 gen))
- (oscil (sbfm-car1 gen) (delay (sbfm-mod1 gen) modsig)))))
+ (am0 #f) (am1 #f)
+ (car0 #f) (car1 #f)
+ (mod0 #f) (mod1 #f)
+ modsig)
+
+(define make-ssb-fm
+ (let ((documentation "(make-ssb-fm freq) makes an ssb-fm generator"))
+ (lambda (freq)
+ (make-sbfm :am0 (make-oscil freq 0)
+ :am1 (make-oscil freq (* 0.5 pi))
+ :car0 (make-oscil 0 0)
+ :car1 (make-oscil 0 (* 0.5 pi))
+ :mod0 (make-hilbert-transform 40)
+ :mod1 (make-delay 40)))))
+
+(define ssb-fm
+ (let ((documentation "(ssb-fm gen modsig) runs an ssb-fm generator"))
+ (lambda (gen modsig)
+ (let-set! gen 'modsig modsig)
+ (with-let gen
+ (+ (* (oscil am0)
+ (oscil car0 (hilbert-transform mod0 modsig)))
+ (* (oscil am1)
+ (oscil car1 (delay mod1 modsig))))))))
;;; if all we want are asymmetric fm-generated spectra, we can just add 2 fm oscil pairs:
-(define (make-fm2 f1 f2 f3 f4 p1 p2 p3 p4)
- "(make-fm2 f1 f2 f3 f4 p1 p2 p3 p4) makes two FM paired oscils"
- ;; (make-fm2 1000 100 1000 100 0 0 (* 0.5 pi) (* 0.5 pi))
- ;; (make-fm2 1000 100 1000 100 0 0 0 (* 0.5 pi))
- (list (make-oscil f1 p1)
- (make-oscil f2 p2)
- (make-oscil f3 p3)
- (make-oscil f4 p4)))
+(define make-fm2
+ (let ((documentation "(make-fm2 f1 f2 f3 f4 p1 p2 p3 p4) makes two FM paired oscils"))
+ (lambda (f1 f2 f3 f4 p1 p2 p3 p4)
+ ;; (make-fm2 1000 100 1000 100 0 0 (* 0.5 pi) (* 0.5 pi))
+ ;; (make-fm2 1000 100 1000 100 0 0 0 (* 0.5 pi))
+ (list (make-oscil f1 p1)
+ (make-oscil f2 p2)
+ (make-oscil f3 p3)
+ (make-oscil f4 p4)))))
-(define (fm2 gen index)
- "(fm2 gen index) runs an fm2 generator"
- (* .25 (+ (oscil (list-ref gen 0) (* index (oscil (list-ref gen 1))))
- (oscil (list-ref gen 2) (* index (oscil (list-ref gen 3)))))))
+(define fm2
+ (let ((documentation "(fm2 gen index) runs an fm2 generator"))
+ (lambda (gen index)
+ (* .25 (+ (oscil (gen 0) (* index (oscil (gen 1))))
+ (oscil (gen 2) (* index (oscil (gen 3)))))))))
;;; rms gain balance
;;; This is a translation of the rmsgain code provided by Fabio Furlanete.
(defgenerator rmsg
- (c1 0.0 :type float)
- (c2 0.0 :type float)
- (q 0.0 :type float)
- (r 0.0 :type float)
- (avg 0.0 :type float)
- (avgc 0 :type int))
-
-(define* (make-rmsgain (hp 10.0))
- "(make-rmsgain (hp 10.0)) makes an RMS gain generator"
- (let* ((b (- 2.0 (cos (* hp (/ (* 2.0 pi) (mus-srate))))))
- (c2 (- b (sqrt (- (* b b) 1.0))))
- (c1 (- 1.0 c2)))
- (make-rmsg :c1 c1 :c2 c2)))
-
-(define (rms gen sig)
- "(rms gen sig) runs an RMS gain generator"
- (set! (rmsg-q gen) (+ (* (rmsg-c1 gen) sig sig)
- (* (rmsg-c2 gen) (rmsg-q gen))))
- (sqrt (rmsg-q gen)))
-
-
-(define (gain gen sig rmsval)
- "(gain gen sig rmsval) returns the current RMS gain"
- (set! (rmsg-r gen) (+ (* (rmsg-c1 gen) sig sig)
- (* (rmsg-c2 gen) (rmsg-r gen))))
- (let ((this-gain (if (zero? (rmsg-r gen))
- rmsval
- (/ rmsval (sqrt (rmsg-r gen))))))
- (set! (rmsg-avg gen) (+ (rmsg-avg gen) this-gain))
- (set! (rmsg-avgc gen) (+ (rmsg-avgc gen) 1))
- (* sig this-gain)))
-
-(define (balance gen signal compare)
- "(balance gen signal compare) scales a signal based on a RMS gain"
- (gain gen signal (rms gen compare)))
-
-(define (gain-avg gen)
- "(gain-avg gen) is part of the RMS gain stuff"
- (/ (rmsg-avg gen) (rmsg-avgc gen)))
-
-(define (balance-avg gen)
- "(balance-avg gen) is part of the RM gain stuff"
- (rmsg-avg gen))
-
-
-
-
-;;; multi-channel sound file expansion with srate and reverb.
-;;; michael klingbeil (michael at klingbeil.com)
-;;;
-;;; $Name: $
-;;; $Revision: 1.1 $
-;;; $Date: 2005/10/16 22:15:44 $
-;;;
-;;; clm-4 and scheme May-08 bil
-;;; split out cases to optimize May-09 bil
-
-(definstrument (expandn time duration filename amplitude
- (expand 1.0)
- (matrix #f)
- (ramp 0.4)
- (seglen 0.15)
- (srate 1.0)
- (hop .05)
- (amp-env '(0 0 50 1 100 0))
- (input-start 0.0)
- (grain-amp 0.8)
- (reverb #f))
-
- (let ((fnam (file-name filename)))
- (if (not (file-exists? fnam))
- (throw 'no-such-file (list 'expandn filename))
-
- (let* ((beg (seconds->samples time))
- (end (+ beg (seconds->samples duration)))
- (in-chans (channels fnam))
- (out-chans (channels *output*))
- (inframe (make-frame in-chans))
- (outframe (make-frame out-chans))
- (mx (if matrix
- (make-mixer (max in-chans out-chans))
- (make-scalar-mixer (max in-chans out-chans) 1.0)))
- (rev-chans (if *reverb* (channels *reverb*) 0))
- (rev-mx (if (and *reverb* reverb (> reverb 0.0))
- (let ((rmx (make-mixer (max out-chans rev-chans))))
- (do ((i 0 (+ i 1)))
- ((= i (max out-chans rev-chans)))
- (mixer-set! rmx (modulo i out-chans) (modulo i rev-chans) reverb))
- rmx)
- #f))
- (revframe (if rev-mx (make-frame (max out-chans rev-chans)) #f))
- (update-envs (or (list? expand)
- (list? seglen)
- (list? ramp)
- (list? hop)))
- (update-rate 100)
- (update-ctr 0)
- (expenv (make-env (if (list? expand) expand (list 0 expand 1 expand))
- :duration (/ duration update-rate)))
- (lenenv (make-env (if (list? seglen) seglen (list 0 seglen 1 seglen))
- :duration (/ duration update-rate)))
- (max-seg-len (if (list? seglen) (max-envelope seglen) seglen))
- (segment-scaler (if (> max-seg-len .15)
- (/ (* grain-amp .15) max-seg-len)
- grain-amp))
- (srenv (if (list? srate)
- (make-env srate :duration duration)
- (make-env (list 0 srate) :duration duration)))
- (rampdata (if (list? ramp) ramp (list 0 ramp 1 ramp)))
- (rampenv (make-env rampdata :duration (/ duration update-rate)))
- (minramp-bug (<= (min-envelope rampdata) 0.0))
- (maxramp-bug (>= (max-envelope rampdata) 0.5))
- (hopenv (make-env (if (list? hop) hop (list 0 hop 1 hop))
- :duration (/ duration update-rate)))
- (ampenv (make-env amp-env :duration duration :scaler amplitude))
- (ex-array (make-vector in-chans #f))
- (start (floor (* input-start (mus-sound-srate fnam))))
- (max-out-hop (if (list? hop) (max-envelope hop) hop))
- (min-exp-amt (if (list? expand) (min-envelope expand) expand))
- (max-in-hop (/ max-out-hop min-exp-amt))
- (max-len (ceiling (* (mus-srate)
- (+ (max max-out-hop max-in-hop)
- max-seg-len))))
- (ex-samp -1.0)
- ;; these vars used for resampling
- (next-samp 0.0))
-
- (if (or minramp-bug maxramp-bug)
- (throw 'out-of-range (list expand
- "ramp argument to expsnd must always be "
- (if (and minramp-bug maxramp-bug) "between 0.0 and 0.5"
- (if minramp-bug "greater than 0.0"
- "less than 0.5")))))
-
- ;; setup granulate generators
- (do ((i 0 (+ i 1)))
- ((= i in-chans))
- (set! (ex-array i) (make-granulate :input (make-readin fnam :start start :channel i)
- :expansion (if (list? expand) (cadr expand) expand)
- :max-size max-len
- :ramp (if (list? ramp) (cadr ramp) ramp)
- :hop (if (list? hop) (cadr hop) hop)
- :length (if (list? seglen) (cadr seglen) seglen)
- :scaler segment-scaler)))
- (if matrix
- (begin
- (do ((inp 0 (+ 1 inp)))
- ((= inp in-chans))
- (let ((inlist (list-ref matrix inp)))
- (do ((outp 0 (+ 1 outp)))
- ((= outp out-chans))
- (let ((outn (list-ref inlist outp)))
- (mixer-set! mx inp outp outn)))))))
-
- ;; split out 1 and 2 chan input
- (if (= in-chans 1)
- (let ((ingen (ex-array 0))
- (sample-0 0.0)
- (sample-1 0.0))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
-
- (let ((vol (env ampenv))
- (resa (env srenv)))
-
- (if update-envs
- (begin
- (set! update-ctr (+ update-ctr 1))
- (if (>= update-ctr update-rate)
- (let* ((expa (env expenv)) ;current expansion amount
- (segl (env lenenv)) ;current segment length
- (rmpl (env rampenv)) ;current ramp length (0 to .5)
- (hp (env hopenv)) ;current hop size
- (sl (floor (* segl (mus-srate))))
- (rl (floor (* rmpl sl))))
- (set! update-ctr 0)
- (set! (mus-length ingen) sl)
- (set! (mus-ramp ingen) rl)
- (set! (mus-frequency ingen) hp)
- (set! (mus-increment ingen) expa)))))
-
- (if (negative? ex-samp)
- (begin
- (set! sample-0 (* vol (granulate ingen)))
- (set! sample-1 (* vol (granulate ingen)))
- (set! ex-samp (+ 1 ex-samp))
- (set! next-samp ex-samp))
- (begin
- (set! next-samp (+ next-samp resa))
- (if (> next-samp (+ 1 ex-samp))
- (let ((samps (floor (- next-samp ex-samp))))
- (do ((k 0 (+ 1 k)))
- ((= k samps))
- (set! sample-0 sample-1)
- (set! sample-1 (* vol (granulate ingen)))
- (set! ex-samp (+ 1 ex-samp)))))))
-
- (if (= next-samp ex-samp)
- ;; output actual samples
- (frame-set! inframe 0 sample-0)
- ;; output interpolated samples
- (frame-set! inframe 0 (+ sample-0 (* (- next-samp ex-samp) (- sample-1 sample-0)))))
-
- ;; output mixed result
- (frame->file *output* i (frame->frame inframe mx outframe))
- ;; if reverb is turned on, output to the reverb streams
- (if rev-mx
- (frame->file *reverb* i (frame->frame outframe rev-mx revframe)))))))
-
- (if (= in-chans 2)
- (let ((sample-0-0 0.0)
- (sample-1-0 0.0)
- (sample-0-1 0.0)
- (sample-1-1 0.0)
- (ingen0 (ex-array 0))
- (ingen1 (ex-array 1)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
-
- (let ((vol (env ampenv))
- (resa (env srenv)))
-
- (if update-envs
- (begin
- (set! update-ctr (+ update-ctr 1))
- (if (>= update-ctr update-rate)
- (let* ((expa (env expenv)) ;current expansion amount
- (segl (env lenenv)) ;current segment length
- (rmpl (env rampenv)) ;current ramp length (0 to .5)
- (hp (env hopenv)) ;current hop size
- (sl (floor (* segl (mus-srate))))
- (rl (floor (* rmpl sl))))
- (set! update-ctr 0)
- (set! (mus-length ingen0) sl)
- (set! (mus-ramp ingen0) rl)
- (set! (mus-frequency ingen0) hp)
- (set! (mus-increment ingen0) expa)
- (set! (mus-length ingen1) sl)
- (set! (mus-ramp ingen1) rl)
- (set! (mus-frequency ingen1) hp)
- (set! (mus-increment ingen1) expa)))))
-
- (if (negative? ex-samp)
- (begin
- (set! sample-0-0 (* vol (granulate ingen0)))
- (set! sample-1-0 (* vol (granulate ingen0)))
- (set! sample-0-1 (* vol (granulate ingen1)))
- (set! sample-1-1 (* vol (granulate ingen1)))
- (set! ex-samp (+ 1 ex-samp))
- (set! next-samp ex-samp))
- (begin
- (set! next-samp (+ next-samp resa))
- (if (> next-samp (+ 1 ex-samp))
- (let ((samps (floor (- next-samp ex-samp))))
- (do ((k 0 (+ 1 k)))
- ((= k samps))
- (set! sample-0-0 sample-1-0)
- (set! sample-1-0 (* vol (granulate ingen0)))
- (set! sample-0-1 sample-1-1)
- (set! sample-1-1 (* vol (granulate ingen1)))
- (set! ex-samp (+ 1 ex-samp)))))))
-
- (if (= next-samp ex-samp)
- ;; output actual samples
- (begin
- (frame-set! inframe 0 sample-0-0)
- (frame-set! inframe 1 sample-0-1))
- (begin
- ;; output interpolated samples
- (frame-set! inframe 0 (+ sample-0-0 (* (- next-samp ex-samp) (- sample-1-0 sample-0-0))))
- (frame-set! inframe 1 (+ sample-0-1 (* (- next-samp ex-samp) (- sample-1-1 sample-0-1))))))
-
- ;; output mixed result
- (frame->file *output* i (frame->frame inframe mx outframe))
- ;; if reverb is turned on, output to the reverb streams
- (if rev-mx
- (frame->file *reverb* i (frame->frame outframe rev-mx revframe)))))))
-
- (let ((samples-0 (make-vct in-chans))
- (samples-1 (make-vct in-chans)))
- ;; more than 2 chans in input file
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (declare (ex-array clm-vector))
-
- (let ((vol (env ampenv))
- (resa (env srenv)))
-
- (if update-envs
- (begin
- (set! update-ctr (+ update-ctr 1))
- (if (>= update-ctr update-rate)
- (let* ((expa (env expenv)) ;current expansion amount
- (segl (env lenenv)) ;current segment length
- (rmpl (env rampenv)) ;current ramp length (0 to .5)
- (hp (env hopenv)) ;current hop size
- (sl (floor (* segl (mus-srate))))
- (rl (floor (* rmpl sl))))
- (set! update-ctr 0)
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (let ((gen (ex-array ix)))
- (set! (mus-length gen) sl)
- (set! (mus-ramp gen) rl)
- (set! (mus-frequency gen) hp)
- (set! (mus-increment gen) expa)))))))
-
- (if (negative? ex-samp)
- (begin
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (let ((gen (ex-array ix)))
- (set! (samples-0 ix) (* vol (granulate gen)))
- (set! (samples-1 ix) (* vol (granulate gen)))))
- (set! ex-samp (+ 1 ex-samp))
- (set! next-samp ex-samp))
- (begin
- (set! next-samp (+ next-samp resa))
- (if (> next-samp (+ 1 ex-samp))
- (let ((samps (floor (- next-samp ex-samp))))
- (do ((k 0 (+ 1 k)))
- ((= k samps))
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (let ((gen (ex-array ix)))
- (set! (samples-0 ix) (samples-1 ix))
- (set! (samples-1 ix) (* vol (granulate gen)))))
- (set! ex-samp (+ 1 ex-samp)))))))
-
- (if (= next-samp ex-samp)
- ;; output actual samples
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (frame-set! inframe ix (samples-0 ix)))
- ;; output interpolated samples
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (let* ((v0 (samples-0 ix))
- (v1 (samples-1 ix)))
- (frame-set! inframe ix (+ v0 (* (- next-samp ex-samp)
- (- v1 v0)))))))
- ;; output mixed result
- (frame->file *output* i (frame->frame inframe mx outframe))
- ;; if reverb is turned on, output to the reverb streams
- (if rev-mx
- (frame->file *reverb* i (frame->frame outframe rev-mx revframe)))))))))))))
-
-;;; (with-sound () (expandn 0 1 "oboe.snd" 1 :expand 4))
+ (c1 0.0)
+ (c2 0.0)
+ (q 0.0)
+ (r 0.0)
+ (avg 0.0)
+ (avgc 0)
+ sig rmsval)
+
+(define make-rmsgain
+ (let ((documentation "(make-rmsgain (hp 10.0)) makes an RMS gain generator"))
+ (lambda* ((hp 10.0))
+ (let* ((b (- 2.0 (cos (* hp (/ (* 2.0 pi) *clm-srate*)))))
+ (c2 (- b (sqrt (- (* b b) 1.0))))
+ (c1 (- 1.0 c2)))
+ (make-rmsg :c1 c1 :c2 c2)))))
+
+(define rms
+ (let ((documentation "(rms gen sig) runs an RMS gain generator"))
+ (lambda (gen sig)
+ (let-set! gen 'sig sig)
+ (with-let gen
+ (set! q (+ (* c1 sig sig) (* c2 q)))
+ (sqrt q)))))
+
+
+(define gain
+ (let ((documentation "(gain gen sig rmsval) returns the current RMS gain"))
+ (lambda (gen sig rmsval)
+ (let-set! gen 'sig sig)
+ (let-set! gen 'rmsval rmsval)
+ (with-let gen
+ (set! r (+ (* c1 sig sig) (* c2 r)))
+ (let ((this-gain (if (zero? r)
+ rmsval
+ (/ rmsval (sqrt r)))))
+ (set! avg (+ avg this-gain))
+ (set! avgc (+ avgc 1))
+ (* sig this-gain))))))
+
+(define balance
+ (let ((documentation "(balance gen signal compare) scales a signal based on a RMS gain"))
+ (lambda (gen signal compare)
+ (gain gen signal (rms gen compare)))))
+
+(define gain-avg
+ (let ((documentation "(gain-avg gen) is part of the RMS gain stuff"))
+ (lambda (gen)
+ (/ (gen 'avg) (gen 'avgc)))))
+
+(define balance-avg
+ (let ((documentation "(balance-avg gen) is part of the RM gain stuff"))
+ (lambda (gen)
+ (gen 'avg))))
+
(definstrument (cnvrev file impulse (rev-amt .1))
- (let* ((file-len (mus-sound-frames file))
- (filter-len (mus-sound-frames impulse))
- (filter-chan0 (make-vct filter-len))
+ (let* ((file-len (mus-sound-framples file))
+ (filter-len (mus-sound-framples impulse))
+ (filter-chan0 (make-float-vector filter-len))
(filter-chan1 (and (= (mus-channels *output*) 2)
(> (mus-sound-chans impulse) 1)
- (make-vct filter-len))))
+ (make-float-vector filter-len))))
(file->array impulse 0 0 filter-len filter-chan0)
(if filter-chan1
(file->array impulse 1 0 filter-len filter-chan1)
- (set! filter-chan1 filter-chan0))
- (let* ((fd (make-readin file))
- (fd1 (and (= (mus-channels *output*) 2)
- (> (mus-sound-chans file) 1)
- (make-readin file :channel 1)))
- (ff0 (make-convolve :input fd :filter filter-chan0))
- (ff1 (and (= (mus-channels *output*) 2)
- (> (mus-sound-chans file) 1)
- (make-convolve :input fd1 :filter filter-chan1)))
- (end (+ file-len filter-len)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i end))
- (outa i (* rev-amt (convolve ff0)))
- (if (and (= (mus-channels *output*) 2)
- ff1)
- (outb i (* rev-amt (convolve ff1)))))))))
+ (set! filter-chan1 filter-chan0))
+ (let ((fd (make-readin file))
+ (fd1 (and (= (mus-channels *output*) 2)
+ (> (mus-sound-chans file) 1)
+ (make-readin file :channel 1))))
+ (let ((ff0 (make-convolve :input fd :filter filter-chan0))
+ (ff1 (and (= (mus-channels *output*) 2)
+ (> (mus-sound-chans file) 1)
+ (make-convolve :input fd1 :filter filter-chan1)))
+ (end (+ file-len filter-len)))
+ (if ff1
+ (do ((i 0 (+ i 1)))
+ ((= i end))
+ (outa i (* rev-amt (convolve ff0)))
+ (outb i (* rev-amt (convolve ff1))))
+ (do ((i 0 (+ i 1)))
+ ((= i end))
+ (outa i (* rev-amt (convolve ff0)))))))))
#|
@@ -2952,220 +2735,3 @@ mjkoskin at sci.fi
-(definstrument (fullmix in-file beg outdur inbeg matrix srate reverb-amount)
- ;; "matrix" can be a simple amplitude or a list of lists
- ;; each inner list represents one input channel's amps into one output channel
- ;; each element of the list can be a number, a list (turned into an env) or an env
- ;;
- ;; "srate" can be a negative number (read in reverse), or an envelope.
- (let* ((st (seconds->samples (or beg 0.0)))
- (dur (or outdur
- (/ (- (mus-sound-duration in-file) (or inbeg 0.0))
- (or (and srate (number? srate) (abs srate)) 1.0))))
- (samps (seconds->samples dur))
- (nd (+ st samps))
- (in-chans (channels in-file))
- (inloc (floor (* (or inbeg 0.0) (mus-sound-srate in-file))))
- (out-chans (channels *output*))
- (mx (if matrix
- (make-mixer (max in-chans out-chans))
- (make-scalar-mixer (max in-chans out-chans) 1.0)))
- (rev-mx (if (and *reverb* reverb-amount (> reverb-amount 0.0))
- (let ((rmx (make-mixer in-chans)))
- (do ((i 0 (+ i 1)))
- ((= i in-chans))
- (mixer-set! rmx i 0 reverb-amount)) ; 0->assume 1 chan reverb stream, I think
- rmx)
- #f))
- (revframe (if rev-mx (make-frame 1) #f))
- (reversed (or (and (number? srate) (negative? srate))
- (and (list? srate) (negative? (cadr srate)))))
- (file (if (or (not srate)
- (and (number? srate)
- (= srate 1.0)))
- (make-file->frame in-file)
- (let ((vect (make-vector in-chans #f)))
- (do ((i 0 (+ i 1)))
- ((= i in-chans))
- (set! (vect i) (make-readin in-file i inloc :direction (if reversed -1 1))))
- vect)))
- (envs #f)
- (srcenv (if (list? srate)
- (make-env srate :duration dur :scaler (if reversed -1.0 1.0))
- #f)))
-
- (if matrix
- (begin
- (if (list? matrix) ; matrix is list of scalers, envelopes (lists), or env gens
- (do ((inp 0 (+ 1 inp))
- (off 0 (+ off out-chans)))
- ((= inp in-chans))
- (let ((inlist (list-ref matrix inp)))
- (do ((outp 0 (+ 1 outp)))
- ((= outp out-chans))
- (let ((outn (list-ref inlist outp)))
- (if outn
- (if (number? outn)
- (mixer-set! mx inp outp outn)
- (if (or (env? outn)
- (list? outn))
- (begin
- (if (not envs)
- (set! envs (make-vector (* in-chans out-chans) #f)))
- (if (env? outn)
- (set! (envs (+ off outp)) outn)
- (set! (envs (+ off outp)) (make-env outn :duration dur))))
- (format #t "unknown element in matrix: ~A" outn))))))))
- (do ((inp 0 (+ 1 inp))) ; matrix is a number in this case (a global scaler)
- ((= inp in-chans))
- (if (< inp out-chans)
- (mixer-set! mx inp inp matrix))))))
-
- (if (or (not srate)
- (and (number? srate)
- (= srate 1.0)))
- (begin
- ;; -------- no src
- (mus-mix *output* file st samps inloc mx (if envs
- (let ((v (make-vector in-chans)))
- (do ((i 0 (+ i 1))
- (off 0 (+ off out-chans)))
- ((= i in-chans))
- (let ((vo (make-vector out-chans #f)))
- (set! (v i) vo)
- (do ((j 0 (+ j 1)))
- ((= j out-chans))
- (set! (vo j) (envs (+ off j))))))
- v)
- envs))
- (if rev-mx
- (mus-mix *reverb* file st samps inloc rev-mx #f)))
-
- ;; -------- with src
- ;; unroll the loops if 1 chan input
- (if (= in-chans 1)
- (let ((sr (make-src :input (file 0) :srate (if (number? srate) (abs srate) 0.0)))
- (outframe (make-frame out-chans)))
- (if envs
- (run
- (declare (envs clm-vector))
- (do ((i st (+ i 1)))
- ((= i nd))
- (do ((outp 0 (+ 1 outp)))
- ((= outp out-chans))
- (if (env? (envs outp))
- (mixer-set! mx 0 outp (env (envs outp)))))
- (let ((inframe (src sr (if srcenv (env srcenv) 0.0))))
- (frame->file *output* i (sample->frame mx inframe outframe))
- (if rev-mx (frame->file *reverb* i (sample->frame rev-mx inframe revframe))))))
-
- ;; no envs
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (let ((inframe (src sr (if srcenv (env srcenv) 0.0))))
- (frame->file *output* i (sample->frame mx inframe outframe))
- (if rev-mx (frame->file *reverb* i (sample->frame rev-mx inframe revframe))))))))
-
- ;; more than 1 chan input
- (let* ((inframe (make-frame in-chans))
- (outframe (make-frame out-chans))
- (srcs (make-vector in-chans #f)))
- (do ((inp 0 (+ 1 inp)))
- ((= inp in-chans))
- (set! (srcs inp) (make-src :input (file inp) :srate (if (number? srate) (abs srate) 0.0))))
-
- (if envs
- (run
- (declare (envs clm-vector))
- (do ((i st (+ i 1)))
- ((= i nd))
- (do ((inp 0 (+ 1 inp))
- (off 0 (+ off out-chans)))
- ((= inp in-chans))
- (do ((outp 0 (+ 1 outp)))
- ((= outp out-chans))
- (if (env? (envs (+ off outp)))
- (mixer-set! mx inp outp (env (envs (+ off outp)))))))
- (let ((sr-val (if srcenv (env srcenv) 0.0)))
- (do ((inp 0 (+ 1 inp)))
- ((= inp in-chans))
- (frame-set! inframe inp (src (srcs inp) sr-val)))
- (frame->file *output* i (frame->frame inframe mx outframe))
- (if rev-mx (frame->file *reverb* i (frame->frame inframe rev-mx revframe))))))
-
- ;; no envs
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (let ((sr-val (if srcenv (env srcenv) 0.0)))
- (do ((inp 0 (+ 1 inp)))
- ((= inp in-chans))
- (frame-set! inframe inp (src (srcs inp) sr-val)))
- (frame->file *output* i (frame->frame inframe mx outframe))
- (if rev-mx (frame->file *reverb* i (frame->frame inframe rev-mx revframe))))))))))))
-
-#|
-(with-sound (:channels 2 :statistics #t)
- (fullmix "pistol.snd")
- (fullmix "2.snd" .5 1)
- (fullmix "2.snd" 1.5 1 0 #f 2.0)
- (fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5))))
- (fullmix "pistol.snd" 2 1 0 #f .5)
- (fullmix "2.snd" 0 2 0 (list (list .1 .2) (list .3 .4)) 2.0)
- (fullmix "oboe.snd" 3 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5))) .25)
- (let ((e0->0 (make-env '(0 0 1 1) :duration 2))
- (e0->1 (make-env '(0 1 1 0) :duration 2))
- (e1->0 (make-env '(0 1 1 0) :duration 2))
- (e1->1 (make-env '(0 0 1 1) :duration 2)))
- (fullmix "2.snd" 4 2 0 (list (list e0->0 e0->1) (list e1->0 e1->1))))
- (let ((e0->0 (make-env '(0 0 1 1) :duration 2))
- (e0->1 (make-env '(0 1 1 0) :duration 2))
- (e1->0 (make-env '(0 1 1 0) :duration 2))
- (e1->1 (make-env '(0 0 1 1) :duration 2)))
- (fullmix "2.snd" 6 2 0 (list (list e0->0 e0->1) (list e1->0 e1->1)) 2.0)))
-
-(with-sound (:channels 2 :statistics #t)
- (fullmix "2.snd" 0 2 0 (list (list .1 .2) (list .3 .4)) 2.0))
-
-(with-sound () (fullmix "pistol.snd" 0 2 2 #f -1.0))
-
-(with-sound (:channels 2)
- (let ((e0->0 (make-env '(0 0 1 1) :duration 2))
- (e0->1 (make-env '(0 1 1 0) :duration 2))
- (e1->0 (make-env '(0 1 1 0) :duration 2))
- (e1->1 (make-env '(0 0 1 1) :duration 2)))
- (fullmix "2.snd" 0 2 0 (list (list e0->0 e0->1) (list e1->0 e1->1))) 2.0))
-
-
-(with-sound () (fullmix "pistol.snd"))
-(with-sound () (fullmix "pistol.snd" 1))
-(with-sound () (fullmix "pistol.snd" 1 1))
-(with-sound () (fullmix "pistol.snd" 0 1 1))
-(with-sound (:statistics #t) (fullmix "pistol.snd" 0 1 0 2.0))
-(with-sound (:statistics #t :channels 2) (fullmix "pistol.snd" 0 1 0 2.0))
-(with-sound (:statistics #t :channels 2) (fullmix "pistol.snd" 0 1 0 (list (list 0.1 0.7))))
-(with-sound (:statistics #t :channels 2) (fullmix "pistol.snd" 0 1 0 (list (list 0.1 (list 0 0 1 1)))))
-
-(with-sound (:channels 2 :output "one-2.snd") (do ((i 0 (+ i 1))) ((= i 10000)) (outa i 0.5) (outb i -0.5)))
-(with-sound (:channels 4 :output "one-4.snd") (do ((i 0 (+ i 1))) ((= i 10000)) (outa i 0.5) (outb i -0.5) (outc i 0.1) (outd i -0.1)))
-
-(with-sound (:statistics #t :channels 2) (fullmix "one-2.snd" 0 .2 0 '((1.0 0.5) (0.5 1.0))))
-(with-sound (:statistics #t :channels 2) (fullmix "one-2.snd" 0 .2 0 (list (list 0.1 (list 0 0 1 1)) (list (list 0 1 1 0) .5))))
-(with-sound (:statistics #t :channels 2)
- (let ((e0->0 (make-env '(0 0 1 1) :end 10000))
- (e0->1 (make-env '(0 1 1 0) :end 10000))
- (e1->0 (make-env '(0 1 1 0) :end 10000))
- (e1->1 (make-env '(0 0 1 1) :end 10000)))
- (fullmix "one-2.snd" 0 .2 0 (list (list e0->0 e0->1) (list e1->0 e1->1)))))
-
-
-(with-sound (:statistics #t :channels 2 :reverb jc-reverb)
- (let ((e0->0 (make-env '(0 0 1 1) :end 10000))
- (e0->1 (make-env '(0 1 1 0) :end 10000))
- (e1->0 (make-env '(0 1 1 0) :end 10000))
- (e1->1 (make-env '(0 0 1 1) :end 10000)))
- (fullmix "one-2.snd" 0 .2 0 (list (list e0->0 e0->1) (list e1->0 e1->1)) #f .1)))
-
-(with-sound () (fullmix "oboe.snd" 0 2 0 #f '(0 0.5 1 1 2 .1)))
-|#
diff --git a/clm-strings.h b/clm-strings.h
index bd2b3bf..f4c152f 100644
--- a/clm-strings.h
+++ b/clm-strings.h
@@ -4,11 +4,13 @@
/* there's some inconsistency about the mus- prefix: mus-interp-* but *-window etc */
#define S_all_pass "all-pass"
-#define S_all_pass_p "all-pass?"
+#define S_is_all_pass "all-pass?"
+#define S_all_pass_bank "all-pass-bank"
+#define S_is_all_pass_bank "all-pass-bank?"
#define S_amplitude_modulate "amplitude-modulate"
#define S_array_interp "array-interp"
#define S_asymmetric_fm "asymmetric-fm"
-#define S_asymmetric_fm_p "asymmetric-fm?"
+#define S_is_asymmetric_fm "asymmetric-fm?"
#define S_autocorrelate "autocorrelate"
#define S_bartlett_window "bartlett-window"
#define S_bartlett_hann_window "bartlett-hann-window"
@@ -23,128 +25,121 @@
#define S_blackman10_window "blackman10-window"
#define S_bohman_window "bohman-window"
#define S_cauchy_window "cauchy-window"
-#define S_clear_array "clear-array"
#define S_clear_sincs "clear-sincs"
#define S_clm_default_frequency "clm-default-frequency"
#define S_clm_table_size "clm-table-size"
#define S_comb "comb"
-#define S_comb_p "comb?"
+#define S_is_comb "comb?"
+#define S_comb_bank "comb-bank"
+#define S_is_comb_bank "comb-bank?"
#define S_connes_window "connes-window"
#define S_continue_sample_to_file "continue-sample->file"
-#define S_continue_frame_to_file "continue-frame->file"
#define S_contrast_enhancement "contrast-enhancement"
#define S_convolution "convolution"
#define S_convolve "convolve"
#define S_convolve_files "convolve-files"
-#define S_convolve_p "convolve?"
+#define S_is_convolve "convolve?"
#define S_correlate "correlate"
#define S_db_to_linear "db->linear"
#define S_degrees_to_radians "degrees->radians"
#define S_delay "delay"
#define S_delay_tick "delay-tick"
-#define S_delay_p "delay?"
+#define S_is_delay "delay?"
#define S_dolph_chebyshev_window "dolph-chebyshev-window"
#define S_dot_product "dot-product"
#define S_dpss_window "dpss-window"
#define S_env "env"
#define S_env_any "env-any"
#define S_env_interp "env-interp"
-#define S_env_p "env?"
+#define S_is_env "env?"
+#define S_even_multiple "even-multiple"
+#define S_even_weight "even-weight"
#define S_exponential_window "exponential-window"
-#define S_file_to_frame "file->frame"
-#define S_file_to_frame_p "file->frame?"
#define S_file_to_sample "file->sample"
-#define S_file_to_sample_p "file->sample?"
+#define S_is_file_to_sample "file->sample?"
#define S_filter "filter"
-#define S_filter_p "filter?"
+#define S_is_filter "filter?"
#define S_filtered_comb "filtered-comb"
-#define S_filtered_comb_p "filtered-comb?"
+#define S_is_filtered_comb "filtered-comb?"
+#define S_filtered_comb_bank "filtered-comb-bank"
+#define S_is_filtered_comb_bank "filtered-comb-bank?"
#define S_fir_filter "fir-filter"
-#define S_fir_filter_p "fir-filter?"
+#define S_is_fir_filter "fir-filter?"
#define S_flat_top_window "flat-top-window"
#define S_firmant "firmant"
-#define S_firmant_p "firmant?"
+#define S_is_firmant "firmant?"
#define S_formant "formant"
#define S_formant_bank "formant-bank"
-#define S_formant_p "formant?"
-#define S_frame "frame"
-#define S_frame_to_file "frame->file"
-#define S_frame_to_file_p "frame->file?"
-#define S_frame_to_frame "frame->frame"
-#define S_frame_to_list "frame->list"
-#define S_frame_to_sample "frame->sample"
-#if HAVE_RUBY
- #define S_frame_add "frame_add"
- #define S_frame_multiply "frame_multiply"
-#else
- #define S_frame_add "frame+"
- #define S_frame_multiply "frame*"
-#endif
-#define S_frame_p "frame?"
-#define S_frame_ref "frame-ref"
-#define S_frame_set "frame-set!"
+#define S_is_formant_bank "formant-bank?"
+#define S_is_formant "formant?"
#define S_gaussian_window "gaussian-window"
#define S_granulate "granulate"
-#define S_granulate_p "granulate?"
+#define S_is_granulate "granulate?"
#define S_hamming_window "hamming-window"
#define S_hann_window "hann-window"
#define S_hann_poisson_window "hann-poisson-window"
#define S_hz_to_radians "hz->radians"
#define S_iir_filter "iir-filter"
-#define S_iir_filter_p "iir-filter?"
+#define S_is_iir_filter "iir-filter?"
#define S_in_any "in-any"
#define S_ina "ina"
#define S_inb "inb"
#define S_kaiser_window "kaiser-window"
#define S_linear_to_db "linear->db"
#define S_locsig "locsig"
-#define S_locsig_p "locsig?"
+#define S_is_locsig "locsig?"
#define S_locsig_ref "locsig-ref"
#define S_locsig_reverb_ref "locsig-reverb-ref"
#define S_locsig_reverb_set "locsig-reverb-set!"
#define S_locsig_set "locsig-set!"
#define S_locsig_type "locsig-type"
#define S_make_all_pass "make-all-pass"
+#define S_make_all_pass_bank "make-all-pass-bank"
#define S_make_asymmetric_fm "make-asymmetric-fm"
#define S_make_comb "make-comb"
+#define S_make_comb_bank "make-comb-bank"
#define S_make_convolve "make-convolve"
#define S_make_delay "make-delay"
#define S_make_env "make-env"
#define S_make_fft_window "make-fft-window"
-#define S_make_file_to_frame "make-file->frame"
#define S_make_file_to_sample "make-file->sample"
#define S_make_filter "make-filter"
#define S_make_filtered_comb "make-filtered-comb"
+#define S_make_filtered_comb_bank "make-filtered-comb-bank"
#define S_make_fir_coeffs "make-fir-coeffs"
#define S_make_fir_filter "make-fir-filter"
#define S_make_firmant "make-firmant"
#define S_make_formant "make-formant"
-#define S_make_frame "make-frame"
-#define S_make_frame_to_file "make-frame->file"
+#define S_make_formant_bank "make-formant-bank"
#define S_make_granulate "make-granulate"
#define S_make_iir_filter "make-iir-filter"
#define S_make_locsig "make-locsig"
-#define S_make_mixer "make-mixer"
#define S_make_move_sound "make-move-sound"
#define S_make_moving_average "make-moving-average"
+#define S_make_moving_max "make-moving-max"
+#define S_make_moving_norm "make-moving-norm"
#define S_make_ncos "make-ncos"
#define S_make_notch "make-notch"
#define S_make_nrxycos "make-nrxycos"
#define S_make_nrxysin "make-nrxysin"
#define S_make_nsin "make-nsin"
#define S_make_one_pole "make-one-pole"
+#define S_make_one_pole_all_pass "make-one-pole-all-pass"
#define S_make_one_zero "make-one-zero"
#define S_make_oscil "make-oscil"
+#define S_make_oscil_bank "make-oscil-bank"
#define S_make_phase_vocoder "make-phase-vocoder"
#define S_make_polyshape "make-polyshape"
#define S_make_polywave "make-polywave"
#define S_make_pulse_train "make-pulse-train"
+#define S_make_pulsed_env "make-pulsed-env"
#define S_make_rand "make-rand"
#define S_make_rand_interp "make-rand-interp"
#define S_make_readin "make-readin"
+#define S_make_rxykcos "make-rxyk!cos"
+#define S_make_rxyksin "make-rxyk!sin"
#define S_make_sample_to_file "make-sample->file"
#define S_make_sawtooth_wave "make-sawtooth-wave"
-#define S_make_scalar_mixer "make-scalar-mixer"
#define S_make_square_wave "make-square-wave"
#define S_make_src "make-src"
#define S_make_ssb_am "make-ssb-am"
@@ -153,34 +148,28 @@
#define S_make_two_pole "make-two-pole"
#define S_make_two_zero "make-two-zero"
#define S_make_wave_train "make-wave-train"
-#define S_mixer "mixer"
-#if HAVE_RUBY
- #define S_mixer_multiply "mixer_multiply"
- #define S_mixer_add "mixer_add"
-#else
- #define S_mixer_multiply "mixer*"
- #define S_mixer_add "mixer+"
-#endif
-#define S_mixer_p "mixer?"
-#define S_mixer_ref "mixer-ref"
-#define S_mixer_set "mixer-set!"
#define S_mlt_sine_window "mlt-sine-window"
#define S_move_locsig "move-locsig"
#define S_move_sound "move-sound"
-#define S_move_sound_p "move-sound?"
+#define S_is_move_sound "move-sound?"
#define S_moving_average "moving-average"
-#define S_moving_average_p "moving-average?"
-#define S_multiply_arrays "multiply-arrays"
+#define S_is_moving_average "moving-average?"
+#define S_moving_max "moving-max"
+#define S_is_moving_max "moving-max?"
+#define S_moving_norm "moving-norm"
+#define S_is_moving_norm "moving-norm?"
#define S_mus_apply "mus-apply"
#define S_mus_array_print_length "mus-array-print-length"
#define S_mus_channel "mus-channel"
#define S_mus_channels "mus-channels"
#define S_mus_chebyshev_first_kind "mus-chebyshev-first-kind"
#define S_mus_chebyshev_second_kind "mus-chebyshev-second-kind"
+#define S_mus_chebyshev_both_kinds "mus-chebyshev-both-kinds"
#define S_mus_chebyshev_t_sum "mus-chebyshev-t-sum"
#define S_mus_chebyshev_tu_sum "mus-chebyshev-tu-sum"
#define S_mus_chebyshev_u_sum "mus-chebyshev-u-sum"
#define S_mus_close "mus-close"
+#define S_mus_copy "mus-copy"
#define S_mus_data "mus-data"
#define S_mus_describe "mus-describe"
#define S_mus_feedback "mus-feedback"
@@ -190,10 +179,10 @@
#define S_mus_file_name "mus-file-name"
#define S_mus_float_equal_fudge_factor "mus-float-equal-fudge-factor"
#define S_mus_frequency "mus-frequency"
-#define S_mus_generator_p "mus-generator?"
+#define S_is_mus_generator "mus-generator?"
#define S_mus_hop "mus-hop"
#define S_mus_increment "mus-increment"
-#define S_mus_input_p "mus-input?"
+#define S_is_mus_input "mus-input?"
#define S_mus_interpolate "mus-interpolate"
#define S_mus_interp_all_pass "mus-interp-all-pass"
#define S_mus_interp_bezier "mus-interp-bezier"
@@ -205,43 +194,49 @@
#define S_mus_interp_type "mus-interp-type"
#define S_mus_length "mus-length"
#define S_mus_location "mus-location"
-#define S_mus_mix "mus-mix"
#define S_mus_name "mus-name"
#define S_mus_offset "mus-offset"
#define S_mus_order "mus-order"
-#define S_mus_output_p "mus-output?"
+#define S_is_mus_output "mus-output?"
#define S_mus_phase "mus-phase"
#define S_mus_ramp "mus-ramp"
#define S_mus_rand_seed "mus-rand-seed"
#define S_mus_random "mus-random"
#define S_mus_reset "mus-reset"
#define S_mus_run "mus-run"
-#define S_mus_safety "mus-safety"
#define S_mus_scaler "mus-scaler"
+#define S_mus_set_formant_frequency "mus-set-formant-frequency"
#define S_mus_set_formant_radius_and_frequency "mus-set-formant-radius-and-frequency"
#define S_mus_srate "mus-srate"
+#define S_mus_type "mus-type"
#define S_mus_width "mus-width"
#define S_mus_xcoeff "mus-xcoeff"
#define S_mus_xcoeffs "mus-xcoeffs"
#define S_mus_ycoeff "mus-ycoeff"
#define S_mus_ycoeffs "mus-ycoeffs"
#define S_ncos "ncos"
-#define S_ncos_p "ncos?"
+#define S_is_ncos "ncos?"
#define S_normalize_partials "normalize-partials"
#define S_notch "notch"
-#define S_notch_p "notch?"
+#define S_is_notch "notch?"
#define S_nrxycos "nrxycos"
-#define S_nrxycos_p "nrxycos?"
+#define S_is_nrxycos "nrxycos?"
#define S_nrxysin "nrxysin"
-#define S_nrxysin_p "nrxysin?"
+#define S_is_nrxysin "nrxysin?"
#define S_nsin "nsin"
-#define S_nsin_p "nsin?"
+#define S_is_nsin "nsin?"
+#define S_odd_multiple "odd-multiple"
+#define S_odd_weight "odd-weight"
#define S_one_pole "one-pole"
-#define S_one_pole_p "one-pole?"
+#define S_is_one_pole "one-pole?"
+#define S_one_pole_all_pass "one-pole-all-pass"
+#define S_is_one_pole_all_pass "one-pole-all-pass?"
#define S_one_zero "one-zero"
-#define S_one_zero_p "one-zero?"
+#define S_is_one_zero "one-zero?"
#define S_oscil "oscil"
-#define S_oscil_p "oscil?"
+#define S_is_oscil "oscil?"
+#define S_oscil_bank "oscil-bank"
+#define S_is_oscil_bank "oscil-bank?"
#define S_out_any "out-any"
#define S_outa "outa"
#define S_outb "outb"
@@ -252,30 +247,32 @@
#define S_partials_to_wave "partials->wave"
#define S_parzen_window "parzen-window"
#define S_phase_vocoder "phase-vocoder"
-#define S_phase_vocoder_p "phase-vocoder?"
+#define S_is_phase_vocoder "phase-vocoder?"
#define S_phase_partials_to_wave "phase-partials->wave"
#define S_poisson_window "poisson-window"
#define S_polar_to_rectangular "polar->rectangular"
#define S_polynomial "polynomial"
#define S_polyshape "polyshape"
-#define S_polyshape_p "polyshape?"
+#define S_is_polyshape "polyshape?"
#define S_polywave "polywave"
-#define S_polywave_p "polywave?"
+#define S_is_polywave "polywave?"
#define S_pulse_train "pulse-train"
-#define S_pulse_train_p "pulse-train?"
-#define S_phase_vocoder_amp_increments "phase-vocoder-amp-increments"
+#define S_is_pulse_train "pulse-train?"
+#define S_phase_vocoder_amp_increments "phase-vocoder-amp-increments"
#define S_phase_vocoder_amps "phase-vocoder-amps"
#define S_phase_vocoder_freqs "phase-vocoder-freqs"
#define S_phase_vocoder_phase_increments "phase-vocoder-phase-increments"
#define S_phase_vocoder_phases "phase-vocoder-phases"
+#define S_pulsed_env "pulsed-env"
+#define S_is_pulsed_env "pulsed-env?"
#define S_radians_to_degrees "radians->degrees"
#define S_radians_to_hz "radians->hz"
#define S_rand "rand"
#define S_rand_interp "rand-interp"
-#define S_rand_interp_p "rand-interp?"
-#define S_rand_p "rand?"
+#define S_is_rand_interp "rand-interp?"
+#define S_is_rand "rand?"
#define S_readin "readin"
-#define S_readin_p "readin?"
+#define S_is_readin "readin?"
#define S_rectangular_to_magnitudes "rectangular->magnitudes"
#define S_rectangular_to_polar "rectangular->polar"
#define S_rectangular_window "rectangular-window"
@@ -284,35 +281,53 @@
#define S_rv2_window "rv2-window"
#define S_rv3_window "rv3-window"
#define S_rv4_window "rv4-window"
+#define S_rxykcos "rxyk!cos"
+#define S_is_rxykcos "rxyk!cos?"
+#define S_rxyksin "rxyk!sin"
+#define S_is_rxyksin "rxyk!sin?"
#define S_samaraki_window "samaraki-window"
#define S_sample_to_file "sample->file"
#define S_sample_to_file_add "sample->file+"
-#define S_sample_to_file_p "sample->file?"
-#define S_sample_to_frame "sample->frame"
+#define S_is_sample_to_file "sample->file?"
#define S_samples_to_seconds "samples->seconds"
#define S_sawtooth_wave "sawtooth-wave"
-#define S_sawtooth_wave_p "sawtooth-wave?"
+#define S_is_sawtooth_wave "sawtooth-wave?"
#define S_seconds_to_samples "seconds->samples"
#define S_sinc_window "sinc-window"
#define S_spectrum "spectrum"
#define S_square_wave "square-wave"
-#define S_square_wave_p "square-wave?"
+#define S_is_square_wave "square-wave?"
#define S_src "src"
-#define S_src_p "src?"
+#define S_is_src "src?"
#define S_ssb_am "ssb-am"
-#define S_ssb_am_p "ssb-am?"
+#define S_is_ssb_am "ssb-am?"
#define S_table_lookup "table-lookup"
-#define S_table_lookup_p "table-lookup?"
+#define S_is_table_lookup "table-lookup?"
#define S_tap "tap"
+#define S_is_tap "tap?"
#define S_triangle_wave "triangle-wave"
-#define S_triangle_wave_p "triangle-wave?"
+#define S_is_triangle_wave "triangle-wave?"
#define S_tukey_window "tukey-window"
#define S_two_pole "two-pole"
-#define S_two_pole_p "two-pole?"
+#define S_is_two_pole "two-pole?"
#define S_two_zero "two-zero"
-#define S_two_zero_p "two-zero?"
+#define S_is_two_zero "two-zero?"
#define S_ultraspherical_window "ultraspherical-window"
#define S_wave_train "wave-train"
-#define S_wave_train_p "wave-train?"
+#define S_is_wave_train "wave-train?"
#define S_welch_window "welch-window"
+
+
+#define S_continue_frample_to_file "continue-frample->file"
+#define S_file_to_frample "file->frample"
+#define S_is_file_to_frample "file->frample?"
+#define S_frample_to_file "frample->file"
+#define S_is_frample_to_file "frample->file?"
+#define S_frample_to_frample "frample->frample"
+#define S_make_file_to_frample "make-file->frample"
+#define S_make_frample_to_file "make-frample->file"
+
+#define S_mus_file_mix "mus-file-mix"
+#define S_mus_file_mix_with_envs "mus-file-mix-with-envs"
+
#endif
diff --git a/clm.c b/clm.c
index eb3bea5..3baf6cc 100644
--- a/clm.c
+++ b/clm.c
@@ -1,6 +1,6 @@
/* CLM (Music V) implementation */
-#include <mus-config.h>
+#include "mus-config.h"
#if USE_SND
#include "snd.h"
@@ -14,30 +14,17 @@
#include <string.h>
#include <stdarg.h>
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
#else
- #ifndef _MSC_VER
- #include <unistd.h>
- #endif
-#endif
-
-#if HAVE_PTHREAD_H
- #include <pthread.h>
+ #include <io.h>
+ #pragma warning(disable: 4244)
#endif
-
#include "_sndlib.h"
#include "clm.h"
#include "clm-strings.h"
-#define clm_malloc(Num, What) malloc(Num)
-#define clm_malloc_atomic(Num, What) malloc(Num)
-#define clm_calloc(Num, Size, What) calloc(Num, Size)
-#define clm_calloc_atomic(Num, Size, What) calloc(Num, Size)
-#define clm_realloc(Old, NewSize) realloc(Old, NewSize)
-#define clm_free(Ptr) free(Ptr)
-
#if HAVE_GSL
#include <gsl/gsl_complex.h>
#include <gsl/gsl_complex_math.h>
@@ -51,67 +38,122 @@
#include <complex.h>
#endif
-#ifndef TWO_PI
- #define TWO_PI (2.0 * M_PI)
-#endif
-
-#if defined(__GNUC__) && (__GNUC__ >= 3)
- #define MUS_EXPECT __builtin_expect
+#if (!DISABLE_SINCOS) && defined(__GNUC__) && defined(__linux__)
+ #define HAVE_SINCOS 1
+ void sincos(double x, double *sin, double *cos);
#else
- #define MUS_EXPECT(_expr, _value) (_expr)
+ #define HAVE_SINCOS 0
#endif
-#define MUS_LIKELY(_expr) MUS_EXPECT((_expr), 1)
-#define MUS_UNLIKELY(_expr) MUS_EXPECT((_expr), 0)
-
-
-#if (!HAVE_MEMMOVE)
-static void *memmove (char *dest, const char *source, unsigned int length)
-{ /* from libit */
- char *d0 = dest;
- if (source < dest)
- /* Moving from low mem to hi mem; start at end. */
- for (source += length, dest += length; length; --length)
- *--dest = *--source;
- else
- if (source != dest)
- {
- /* Moving from hi mem to low mem; start at beginning. */
- for (; length; --length)
- *dest++ = *source++;
- }
- return((void *)d0);
-}
+#ifndef TWO_PI
+ #define TWO_PI (2.0 * M_PI)
#endif
+struct mus_any_class {
+ int type;
+ char *name;
+ void (*release)(mus_any *ptr);
+ char *(*describe)(mus_any *ptr); /* caller should free the string */
+ bool (*equalp)(mus_any *gen1, mus_any *gen2);
+ mus_float_t *(*data)(mus_any *ptr);
+ mus_float_t *(*set_data)(mus_any *ptr, mus_float_t *new_data);
+ mus_long_t (*length)(mus_any *ptr);
+ mus_long_t (*set_length)(mus_any *ptr, mus_long_t new_length);
+ mus_float_t (*frequency)(mus_any *ptr);
+ mus_float_t (*set_frequency)(mus_any *ptr, mus_float_t new_freq);
+ mus_float_t (*phase)(mus_any *ptr);
+ mus_float_t (*set_phase)(mus_any *ptr, mus_float_t new_phase);
+ mus_float_t (*scaler)(mus_any *ptr);
+ mus_float_t (*set_scaler)(mus_any *ptr, mus_float_t val);
+ mus_float_t (*increment)(mus_any *ptr);
+ mus_float_t (*set_increment)(mus_any *ptr, mus_float_t val);
+ mus_float_t (*run)(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
+ mus_clm_extended_t extended_type;
+ void *(*closure)(mus_any *gen);
+ int (*channels)(mus_any *ptr);
+ mus_float_t (*offset)(mus_any *ptr);
+ mus_float_t (*set_offset)(mus_any *ptr, mus_float_t val);
+ mus_float_t (*width)(mus_any *ptr);
+ mus_float_t (*set_width)(mus_any *ptr, mus_float_t val);
+ mus_float_t (*xcoeff)(mus_any *ptr, int index);
+ mus_float_t (*set_xcoeff)(mus_any *ptr, int index, mus_float_t val);
+ mus_long_t (*hop)(mus_any *ptr);
+ mus_long_t (*set_hop)(mus_any *ptr, mus_long_t new_length);
+ mus_long_t (*ramp)(mus_any *ptr);
+ mus_long_t (*set_ramp)(mus_any *ptr, mus_long_t new_length);
+ mus_float_t (*read_sample)(mus_any *ptr, mus_long_t samp, int chan);
+ mus_float_t (*write_sample)(mus_any *ptr, mus_long_t samp, int chan, mus_float_t data);
+ char *(*file_name)(mus_any *ptr);
+ int (*end)(mus_any *ptr);
+ mus_long_t (*location)(mus_any *ptr);
+ mus_long_t (*set_location)(mus_any *ptr, mus_long_t loc);
+ int (*channel)(mus_any *ptr);
+ mus_float_t (*ycoeff)(mus_any *ptr, int index);
+ mus_float_t (*set_ycoeff)(mus_any *ptr, int index, mus_float_t val);
+ mus_float_t *(*xcoeffs)(mus_any *ptr);
+ mus_float_t *(*ycoeffs)(mus_any *ptr);
+ void (*reset)(mus_any *ptr);
+ void *(*set_closure)(mus_any *gen, void *e);
+ mus_any *(*copy)(mus_any *ptr);
+};
+
enum {MUS_OSCIL, MUS_NCOS, MUS_DELAY, MUS_COMB, MUS_NOTCH, MUS_ALL_PASS,
MUS_TABLE_LOOKUP, MUS_SQUARE_WAVE, MUS_SAWTOOTH_WAVE, MUS_TRIANGLE_WAVE, MUS_PULSE_TRAIN,
- MUS_RAND, MUS_RAND_INTERP, MUS_ASYMMETRIC_FM, MUS_ONE_ZERO, MUS_ONE_POLE, MUS_TWO_ZERO, MUS_TWO_POLE, MUS_FORMANT,
+ MUS_RAND, MUS_RAND_INTERP, MUS_ASYMMETRIC_FM, MUS_ONE_ZERO, MUS_ONE_POLE, MUS_TWO_ZERO, MUS_TWO_POLE, MUS_FORMANT,
MUS_SRC, MUS_GRANULATE, MUS_WAVE_TRAIN,
MUS_FILTER, MUS_FIR_FILTER, MUS_IIR_FILTER, MUS_CONVOLVE, MUS_ENV, MUS_LOCSIG,
- MUS_FRAME, MUS_READIN, MUS_FILE_TO_SAMPLE, MUS_FILE_TO_FRAME,
- MUS_SAMPLE_TO_FILE, MUS_FRAME_TO_FILE, MUS_MIXER, MUS_PHASE_VOCODER,
- MUS_MOVING_AVERAGE, MUS_NSIN, MUS_SSB_AM, MUS_POLYSHAPE, MUS_FILTERED_COMB,
- MUS_MOVE_SOUND, MUS_NRXYSIN, MUS_NRXYCOS, MUS_POLYWAVE, MUS_FIRMANT,
+ MUS_READIN, MUS_FILE_TO_SAMPLE, MUS_FILE_TO_FRAMPLE,
+ MUS_SAMPLE_TO_FILE, MUS_FRAMPLE_TO_FILE, MUS_PHASE_VOCODER,
+ MUS_MOVING_AVERAGE, MUS_MOVING_MAX, MUS_MOVING_NORM, MUS_NSIN, MUS_SSB_AM, MUS_POLYSHAPE, MUS_FILTERED_COMB,
+ MUS_MOVE_SOUND, MUS_NRXYSIN, MUS_NRXYCOS, MUS_POLYWAVE, MUS_FIRMANT, MUS_FORMANT_BANK,
+ MUS_ONE_POLE_ALL_PASS, MUS_COMB_BANK, MUS_ALL_PASS_BANK, MUS_FILTERED_COMB_BANK, MUS_OSCIL_BANK,
+ MUS_PULSED_ENV, MUS_RXYKSIN, MUS_RXYKCOS,
MUS_INITIAL_GEN_TAG};
+mus_any_class *mus_generator_class(mus_any *ptr) {return(ptr->core);}
+
+void mus_generator_set_extended_type(mus_any_class *p, mus_clm_extended_t extended_type) {p->extended_type = extended_type;}
+void mus_generator_set_length(mus_any_class *p, mus_long_t (*length)(mus_any *ptr)) {p->length = length;}
+void mus_generator_set_scaler(mus_any_class *p, mus_float_t (*scaler)(mus_any *ptr)) {p->scaler = scaler;}
+void mus_generator_set_channels(mus_any_class *p, int (*channels)(mus_any *ptr)) {p->channels = channels;}
+void mus_generator_set_location(mus_any_class *p, mus_long_t (*location)(mus_any *ptr)) {p->location = location;}
+void mus_generator_set_set_location(mus_any_class *p, mus_long_t (*set_location)(mus_any *ptr, mus_long_t loc)) {p->set_location = set_location;}
+void mus_generator_set_read_sample(mus_any_class *p, mus_float_t (*read_sample)(mus_any *ptr, mus_long_t samp, int chan)) {p->read_sample = read_sample;}
+void mus_generator_set_channel(mus_any_class *p, int (*channel)(mus_any *ptr)) {p->channel = channel;}
+void mus_generator_set_file_name(mus_any_class *p, char *(*file_name)(mus_any *ptr)) {p->file_name = file_name;}
+
+mus_any_class *mus_make_generator(int type, char *name,
+ void (*release)(mus_any *ptr),
+ char *(*describe)(mus_any *ptr),
+ bool (*equalp)(mus_any *gen1, mus_any *gen2))
+{
+ mus_any_class *p;
+ p = (mus_any_class *)calloc(1, sizeof(mus_any_class));
+ p->type = type;
+ p->name = name;
+ p->release = release;
+ p->describe = describe;
+ p->equalp = equalp;
+ return(p);
+}
+
+
+static int mus_generator_type = MUS_INITIAL_GEN_TAG;
+
+int mus_make_generator_type(void) {return(mus_generator_type++);}
+
static const char *interp_name[] = {"step", "linear", "sinusoidal", "all-pass", "lagrange", "bezier", "hermite"};
static const char *interp_type_to_string(int type)
{
- if (mus_interp_type_p(type))
+ if (mus_is_interp_type(type))
return(interp_name[type]);
return("unknown");
}
-static int mus_class_tag = MUS_INITIAL_GEN_TAG;
-
-int mus_make_class_tag(void) {return(mus_class_tag++);}
-
-
static mus_float_t sampling_rate = MUS_DEFAULT_SAMPLING_RATE;
static mus_float_t w_rate = (TWO_PI / MUS_DEFAULT_SAMPLING_RATE);
@@ -169,6 +211,11 @@ mus_float_t mus_db_to_linear(mus_float_t x) {return(pow(10.0, x / 20.0));}
mus_float_t mus_linear_to_db(mus_float_t x) {if (x > 0.0) return(20.0 * log10(x)); return(-100.0);}
+mus_float_t mus_odd_multiple(mus_float_t x, mus_float_t y) {mus_long_t f; f = (mus_long_t)floor(x); return(y * ((f & 1) ? f : (f + 1)));}
+mus_float_t mus_even_multiple(mus_float_t x, mus_float_t y) {mus_long_t f; f = (mus_long_t)floor(x); return(y * ((f & 1) ? (f + 1) : f));}
+mus_float_t mus_odd_weight(mus_float_t x) {mus_long_t f; f = (mus_long_t)floor(x); return(1.0 - fabs(x - ((f & 1) ? f : (f + 1))));}
+mus_float_t mus_even_weight(mus_float_t x) {mus_long_t f; f = (mus_long_t)floor(x); return(1.0 - fabs(x - ((f & 1) ? (f + 1) : f)));}
+
mus_float_t mus_srate(void) {return(sampling_rate);}
mus_float_t mus_set_srate(mus_float_t val)
@@ -185,7 +232,7 @@ mus_float_t mus_set_srate(mus_float_t val)
mus_long_t mus_seconds_to_samples(mus_float_t secs) {return((mus_long_t)(secs * sampling_rate));}
-mus_float_t mus_samples_to_seconds(mus_long_t samps) {return((mus_float_t)((double)samps / (double)sampling_rate));}
+mus_float_t mus_samples_to_seconds(mus_long_t samps) {return((mus_float_t)((mus_float_t)samps / (mus_float_t)sampling_rate));}
#define DESCRIBE_BUFFER_SIZE 2048
@@ -194,46 +241,48 @@ mus_float_t mus_samples_to_seconds(mus_long_t samps) {return((mus_float_t)((doub
static char *float_array_to_string(mus_float_t *arr, int len, int loc)
{
- #define MAX_NUM_SIZE 32
+ /* %g is needed here rather than %f -- otherwise the number strings can be any size */
+ #define MAX_NUM_SIZE 64
char *base, *str;
- int i, lim, k, size = 256;
+ int i, lim, size = 512;
if (arr == NULL)
{
- str = (char *)clm_calloc_atomic(4, sizeof(char), "float_array_to_string");
- sprintf(str, "nil");
+ str = (char *)malloc(4 * sizeof(char));
+ snprintf(str, 4, "nil");
return(str);
}
lim = (array_print_length + 4) * MAX_NUM_SIZE; /* 4 for possible bounds below */
if (lim > size) size = lim;
if (loc < 0) loc = 0;
- base = (char *)clm_calloc_atomic(size, sizeof(char), "float_array_to_string");
- str = (char *)clm_calloc_atomic(STR_SIZE, sizeof(char), "float_array_to_string");
+ base = (char *)calloc(size, sizeof(char));
+ str = (char *)malloc(STR_SIZE * sizeof(char));
if (len > 0)
{
- sprintf(base, "[");
+ int k;
+ snprintf(base, size, "[");
lim = len;
if (lim > array_print_length) lim = array_print_length;
k = loc;
if (k >= len) k = 0;
for (i = 0; i < lim - 1; i++)
{
- mus_snprintf(str, STR_SIZE, "%.3f ", arr[k]);
+ snprintf(str, STR_SIZE, "%.3g ", arr[k]);
strcat(base, str);
if ((int)(strlen(base) + MAX_NUM_SIZE) > size)
{
- base = (char *)clm_realloc(base, size * 2 * sizeof(char));
+ base = (char *)realloc(base, size * 2 * sizeof(char));
base[size] = 0;
size *= 2;
}
k++;
if (k >= len) k = 0;
}
- mus_snprintf(str, STR_SIZE, "%.3f%s", arr[k], (len > lim) ? "..." : "]");
+ snprintf(str, STR_SIZE, "%.3g%s", arr[k], (len > lim) ? "..." : "]");
strcat(base, str);
}
- else sprintf(base, "[]");
+ else snprintf(base, size, "[]");
if (len > lim)
{
/* print ranges */
@@ -246,10 +295,10 @@ static char *float_array_to_string(mus_float_t *arr, int len, int loc)
if (arr[i] < min_val) {min_val = arr[i]; min_loc = i;}
if (arr[i] > max_val) {max_val = arr[i]; max_loc = i;}
}
- mus_snprintf(str, STR_SIZE, "(%d: %.3f, %d: %.3f)]", min_loc, min_val, max_loc, max_val);
+ snprintf(str, STR_SIZE, "(%d: %.3g, %d: %.3g)]", min_loc, min_val, max_loc, max_val);
strcat(base, str);
}
- clm_free(str);
+ free(str);
return(base);
}
@@ -261,32 +310,32 @@ static char *clm_array_to_string(mus_any **gens, int num_gens, const char *name,
{
int i, len = 0;
char **descrs;
- descrs = (char **)clm_calloc(num_gens, sizeof(char *), "clm_array_to_string");
+ descrs = (char **)calloc(num_gens, sizeof(char *));
for (i = 0; i < num_gens; i++)
{
if (gens[i])
{
char *str = NULL;
descrs[i] = mus_format("\n%s[%d]: %s", indent, i, str = mus_describe(gens[i]));
- if (str) clm_free(str);
+ if (str) free(str);
}
else descrs[i] = mus_format("\n%s[%d]: nil", indent, i);
len += strlen(descrs[i]);
}
len += (64 + strlen(name));
- descr = (char *)clm_calloc(len, sizeof(char), "clm_array_to_string");
- mus_snprintf(descr, len, "%s[%d]:", name, num_gens);
+ descr = (char *)malloc(len * sizeof(char));
+ snprintf(descr, len, "%s[%d]:", name, num_gens);
for (i = 0; i < num_gens; i++)
{
strcat(descr, descrs[i]);
- clm_free(descrs[i]);
+ free(descrs[i]);
}
- clm_free(descrs);
+ free(descrs);
}
else
{
- descr = (char *)clm_calloc(128, sizeof(char), "clm_array_to_string");
- mus_snprintf(descr, 128, "%s: nil", name);
+ descr = (char *)malloc(128 * sizeof(char));
+ snprintf(descr, 128, "%s: nil", name);
}
return(descr);
}
@@ -301,22 +350,22 @@ static char *int_array_to_string(int *arr, int num_ints, const char *name)
int i, len;
char *intstr;
len = num_ints * MAX_INT_SIZE + 64;
- descr = (char *)clm_calloc(len, sizeof(char), "clm_int_array_to_string");
- intstr = (char *)clm_calloc(MAX_INT_SIZE, sizeof(char), "clm_int_array_to_string");
- mus_snprintf(descr, len, "%s[%d]: (", name, num_ints);
+ descr = (char *)calloc(len, sizeof(char));
+ intstr = (char *)malloc(MAX_INT_SIZE * sizeof(char));
+ snprintf(descr, len, "%s[%d]: (", name, num_ints);
for (i = 0; i < num_ints - 1; i++)
{
- mus_snprintf(intstr, MAX_INT_SIZE, "%d ", arr[i]);
+ snprintf(intstr, MAX_INT_SIZE, "%d ", arr[i]);
strcat(descr, intstr);
}
- mus_snprintf(intstr, MAX_INT_SIZE, "%d)", arr[num_ints - 1]);
+ snprintf(intstr, MAX_INT_SIZE, "%d)", arr[num_ints - 1]);
strcat(descr, intstr);
- clm_free(intstr);
+ free(intstr);
}
else
{
- descr = (char *)clm_calloc(128, sizeof(char), "clm_int_array_to_string");
- mus_snprintf(descr, 128, "%s: nil", name);
+ descr = (char *)malloc(128 * sizeof(char));
+ snprintf(descr, 128, "%s: nil", name);
}
return(descr);
}
@@ -324,78 +373,24 @@ static char *int_array_to_string(int *arr, int num_ints, const char *name)
/* ---------------- generic functions ---------------- */
-static bool check_gen(mus_any *ptr, const char *name)
-{
- if (ptr == NULL)
- {
- mus_error(MUS_NO_GEN, "null generator passed to %s", name);
- return(false);
- }
- return(true);
-}
+#define check_gen(Ptr, Name) ((Ptr) ? true : (!mus_error(MUS_NO_GEN, "null generator passed to %s", Name)))
-
-const char *mus_name(mus_any *ptr)
+int mus_type(mus_any *ptr)
{
- if (ptr == NULL)
- return("null");
- return(ptr->core->name);
+ return(((check_gen(ptr, S_mus_type)) && (ptr->core)) ? ptr->core->type : -1);
}
-const char *mus_set_name(mus_any *ptr, const char *new_name)
+const char *mus_name(mus_any *ptr)
{
- /* an experiment -- to change the name, we need to make a local copy of the mus_any_class struct */
- /* eventually we could use this to specialize built-in methods and so on */
- if (check_gen(ptr, S_mus_name))
- {
- if (ptr->core->original_class)
- {
- if (ptr->core->name) free(ptr->core->name);
- ptr->core->name = mus_strdup(new_name);
- }
- else
- {
- mus_any_class *tmp;
- tmp = ptr->core;
- ptr->core = (mus_any_class *)clm_calloc(1, sizeof(mus_any_class), "mus_set_name");
- memcpy((void *)(ptr->core), (void *)tmp, sizeof(mus_any_class));
- ptr->core->name = mus_strdup(new_name);
- ptr->core->original_class = (void *)tmp;
- }
- }
- return(new_name);
+ return((ptr == NULL) ? "null" : ptr->core->name);
}
-/* add_method: in clm2xen always include mus_xen wrapper as environ (as currently for vct-func cases)
- * this is currently handled through closure and set_closure (locally) -- needs gen struct field for the pointer
- * add-method of degenerator could just prepend -- wouldn't assoc ignore the later case?
- * add_method(ptr, name, func) then copies if original as above, resets ptr to xen_func
- * also adds func to gen property list
- * func itself takes ptr, gets mus_xen via environ, finds func in property list and calls
- * to refer to (hidden) gen fields, we'd need a way to tell it to use the original_class ptr's funcs
- * call-next-method? this would need the current ptr, the current class ptr etc
- */
-
-int mus_free(mus_any *gen)
+void mus_free(mus_any *gen)
{
- if ((check_gen(gen, "mus-free")) &&
- (gen->core->release))
- {
- int release_result = 0;
- mus_any_class *local_class = NULL;
-
- if (gen->core->original_class)
- local_class = (mus_any_class *)(gen->core);
-
- release_result = ((*(gen->core->release))(gen));
-
- if (local_class)
- clm_free(local_class);
- return(release_result);
- }
- return(mus_error(MUS_NO_FREE, "can't free %s", mus_name(gen)));
+ if (gen)
+ (*(gen->core->release))(gen);
}
@@ -431,6 +426,16 @@ void mus_reset(mus_any *gen)
}
+mus_any *mus_copy(mus_any *gen)
+{
+ if ((check_gen(gen, S_mus_copy)) &&
+ (gen->core->copy))
+ return((*(gen->core->copy))(gen));
+ else mus_error(MUS_NO_COPY, "can't copy %s", mus_name(gen));
+ return(NULL);
+}
+
+
mus_float_t mus_frequency(mus_any *gen)
{
if ((check_gen(gen, S_mus_frequency)) &&
@@ -442,7 +447,7 @@ mus_float_t mus_frequency(mus_any *gen)
mus_float_t mus_set_frequency(mus_any *gen, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_frequency)) &&
+ if ((check_gen(gen, S_set S_mus_frequency)) &&
(gen->core->set_frequency))
return((*(gen->core->set_frequency))(gen, val));
return((mus_float_t)mus_error(MUS_NO_FREQUENCY, "can't set %s's frequency", mus_name(gen)));
@@ -460,30 +465,13 @@ mus_float_t mus_phase(mus_any *gen)
mus_float_t mus_set_phase(mus_any *gen, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_phase)) &&
+ if ((check_gen(gen, S_set S_mus_phase)) &&
(gen->core->set_phase))
return((*(gen->core->set_phase))(gen, val));
return((mus_float_t)mus_error(MUS_NO_PHASE, "can't set %s's phase", mus_name(gen)));
}
-int mus_safety(mus_any *gen)
-{
- if ((check_gen(gen, S_mus_safety)) &&
- (gen->core->safety))
- return((*(gen->core->safety))(gen));
- return(mus_error(MUS_NO_SAFETY, "can't get %s's safety", mus_name(gen)));
-}
-
-
-int mus_set_safety(mus_any *gen, int val)
-{
- if ((check_gen(gen, S_setB S_mus_safety)) &&
- (gen->core->set_safety))
- return((*(gen->core->set_safety))(gen, val));
- return(mus_error(MUS_NO_SAFETY, "can't set %s's safety", mus_name(gen)));
-}
-
mus_float_t mus_scaler(mus_any *gen)
{
@@ -496,7 +484,7 @@ mus_float_t mus_scaler(mus_any *gen)
mus_float_t mus_set_scaler(mus_any *gen, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_scaler)) &&
+ if ((check_gen(gen, S_set S_mus_scaler)) &&
(gen->core->set_scaler))
return((*(gen->core->set_scaler))(gen, val));
return((mus_float_t)mus_error(MUS_NO_SCALER, "can't set %s's scaler", mus_name(gen)));
@@ -508,16 +496,16 @@ mus_float_t mus_feedforward(mus_any *gen) /* shares "scaler" */
if ((check_gen(gen, S_mus_feedforward)) &&
(gen->core->scaler))
return((*(gen->core->scaler))(gen));
- return((mus_float_t)mus_error(MUS_NO_SCALER, "can't get %s's feedforward", mus_name(gen)));
+ return((mus_float_t)mus_error(MUS_NO_FEEDFORWARD, "can't get %s's feedforward", mus_name(gen)));
}
mus_float_t mus_set_feedforward(mus_any *gen, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_feedforward)) &&
+ if ((check_gen(gen, S_set S_mus_feedforward)) &&
(gen->core->set_scaler))
return((*(gen->core->set_scaler))(gen, val));
- return((mus_float_t)mus_error(MUS_NO_SCALER, "can't set %s's feedforward", mus_name(gen)));
+ return((mus_float_t)mus_error(MUS_NO_FEEDFORWARD, "can't set %s's feedforward", mus_name(gen)));
}
@@ -532,7 +520,7 @@ mus_float_t mus_offset(mus_any *gen)
mus_float_t mus_set_offset(mus_any *gen, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_offset)) &&
+ if ((check_gen(gen, S_set S_mus_offset)) &&
(gen->core->set_offset))
return((*(gen->core->set_offset))(gen, val));
return((mus_float_t)mus_error(MUS_NO_OFFSET, "can't set %s's offset", mus_name(gen)));
@@ -550,7 +538,7 @@ mus_float_t mus_width(mus_any *gen)
mus_float_t mus_set_width(mus_any *gen, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_width)) &&
+ if ((check_gen(gen, S_set S_mus_width)) &&
(gen->core->set_width))
return((*(gen->core->set_width))(gen, val));
return((mus_float_t)mus_error(MUS_NO_WIDTH, "can't set %s's width", mus_name(gen)));
@@ -568,7 +556,7 @@ mus_float_t mus_increment(mus_any *gen)
mus_float_t mus_set_increment(mus_any *gen, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_increment)) &&
+ if ((check_gen(gen, S_set S_mus_increment)) &&
(gen->core->set_increment))
return((*(gen->core->set_increment))(gen, val));
return((mus_float_t)mus_error(MUS_NO_INCREMENT, "can't set %s's increment", mus_name(gen)));
@@ -580,16 +568,16 @@ mus_float_t mus_feedback(mus_any *gen) /* shares "increment" */
if ((check_gen(gen, S_mus_feedback)) &&
(gen->core->increment))
return((*(gen->core->increment))(gen));
- return((mus_float_t)mus_error(MUS_NO_INCREMENT, "can't get %s's feedback", mus_name(gen)));
+ return((mus_float_t)mus_error(MUS_NO_FEEDBACK, "can't get %s's feedback", mus_name(gen)));
}
mus_float_t mus_set_feedback(mus_any *gen, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_feedback)) &&
+ if ((check_gen(gen, S_set S_mus_feedback)) &&
(gen->core->set_increment))
return((*(gen->core->set_increment))(gen, val));
- return((mus_float_t)mus_error(MUS_NO_INCREMENT, "can't set %s's feedback", mus_name(gen)));
+ return((mus_float_t)mus_error(MUS_NO_FEEDBACK, "can't set %s's feedback", mus_name(gen)));
}
@@ -603,7 +591,7 @@ void *mus_environ(mus_any *gen)
void *mus_set_environ(mus_any *gen, void *e)
{
- if (check_gen(gen, S_setB "mus-environ"))
+ if (check_gen(gen, S_set "mus-environ"))
return((*(gen->core->set_closure))(gen, e));
return(NULL);
}
@@ -629,7 +617,7 @@ mus_long_t mus_length(mus_any *gen)
mus_long_t mus_set_length(mus_any *gen, mus_long_t len)
{
- if ((check_gen(gen, S_setB S_mus_length)) &&
+ if ((check_gen(gen, S_set S_mus_length)) &&
(gen->core->set_length))
return((*(gen->core->set_length))(gen, len));
return(mus_error(MUS_NO_LENGTH, "can't set %s's length", mus_name(gen)));
@@ -641,7 +629,7 @@ mus_long_t mus_order(mus_any *gen) /* shares "length", no set */
if ((check_gen(gen, S_mus_order)) &&
(gen->core->length))
return((*(gen->core->length))(gen));
- return(mus_error(MUS_NO_LENGTH, "can't get %s's order", mus_name(gen)));
+ return(mus_error(MUS_NO_ORDER, "can't get %s's order", mus_name(gen)));
}
@@ -659,7 +647,7 @@ int mus_interp_type(mus_any *gen) /* shares "channels", no set */
if ((check_gen(gen, S_mus_interp_type)) &&
(gen->core->channels))
return((*(gen->core->channels))(gen));
- return(mus_error(MUS_NO_CHANNELS, "can't get %s's interp type", mus_name(gen)));
+ return(mus_error(MUS_NO_INTERP_TYPE, "can't get %s's interp type", mus_name(gen)));
}
@@ -668,7 +656,7 @@ int mus_position(mus_any *gen) /* shares "channels", no set, only used in C (snd
if ((check_gen(gen, "mus-position")) &&
(gen->core->channels))
return((*(gen->core->channels))(gen));
- return(mus_error(MUS_NO_CHANNELS, "can't get %s's position", mus_name(gen)));
+ return(mus_error(MUS_NO_POSITION, "can't get %s's position", mus_name(gen)));
}
@@ -692,7 +680,7 @@ mus_long_t mus_hop(mus_any *gen)
mus_long_t mus_set_hop(mus_any *gen, mus_long_t len)
{
- if ((check_gen(gen, S_setB S_mus_hop)) &&
+ if ((check_gen(gen, S_set S_mus_hop)) &&
(gen->core->set_hop))
return((*(gen->core->set_hop))(gen, len));
return(mus_error(MUS_NO_HOP, "can't set %s's hop value", mus_name(gen)));
@@ -710,7 +698,7 @@ mus_long_t mus_ramp(mus_any *gen)
mus_long_t mus_set_ramp(mus_any *gen, mus_long_t len)
{
- if ((check_gen(gen, S_setB S_mus_ramp)) &&
+ if ((check_gen(gen, S_set S_mus_ramp)) &&
(gen->core->set_ramp))
return((*(gen->core->set_ramp))(gen, len));
return(mus_error(MUS_NO_RAMP, "can't set %s's ramp value", mus_name(gen)));
@@ -733,7 +721,7 @@ mus_float_t *mus_data(mus_any *gen)
mus_float_t *mus_set_data(mus_any *gen, mus_float_t *new_data)
{
- if (check_gen(gen, S_setB S_mus_data))
+ if (check_gen(gen, S_set S_mus_data))
{
if (gen->core->set_data)
{
@@ -777,7 +765,7 @@ mus_float_t mus_xcoeff(mus_any *gen, int index)
mus_float_t mus_set_xcoeff(mus_any *gen, int index, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_xcoeff)) &&
+ if ((check_gen(gen, S_set S_mus_xcoeff)) &&
(gen->core->set_xcoeff))
return((*(gen->core->set_xcoeff))(gen, index, val));
return(mus_error(MUS_NO_XCOEFF, "can't set %s's xcoeff[%d] value", mus_name(gen), index));
@@ -795,7 +783,7 @@ mus_float_t mus_ycoeff(mus_any *gen, int index)
mus_float_t mus_set_ycoeff(mus_any *gen, int index, mus_float_t val)
{
- if ((check_gen(gen, S_setB S_mus_ycoeff)) &&
+ if ((check_gen(gen, S_set S_mus_ycoeff)) &&
(gen->core->set_ycoeff))
return((*(gen->core->set_ycoeff))(gen, index, val));
return(mus_error(MUS_NO_YCOEFF, "can't set %s's ycoeff[%d] value", mus_name(gen), index));
@@ -831,12 +819,6 @@ mus_float_t mus_contrast_enhancement(mus_float_t sig, mus_float_t index)
}
-void mus_clear_array(mus_float_t *arr, mus_long_t size)
-{
- memset((void *)arr, 0, size * sizeof(mus_float_t));
-}
-
-
bool mus_arrays_are_equal(mus_float_t *arr1, mus_float_t *arr2, mus_float_t fudge, mus_long_t len)
{
mus_long_t i;
@@ -848,7 +830,25 @@ bool mus_arrays_are_equal(mus_float_t *arr1, mus_float_t *arr2, mus_float_t fudg
}
else
{
- for (i = 0; i < len; i++)
+ mus_long_t len4;
+ len4 = len - 4;
+ i = 0;
+ while (i <= len4)
+ {
+ if (fabs(arr1[i] - arr2[i]) > fudge)
+ return(false);
+ i++;
+ if (fabs(arr1[i] - arr2[i]) > fudge)
+ return(false);
+ i++;
+ if (fabs(arr1[i] - arr2[i]) > fudge)
+ return(false);
+ i++;
+ if (fabs(arr1[i] - arr2[i]) > fudge)
+ return(false);
+ i++;
+ }
+ for (; i < len; i++)
if (fabs(arr1[i] - arr2[i]) > fudge)
return(false);
}
@@ -864,9 +864,22 @@ static bool clm_arrays_are_equal(mus_float_t *arr1, mus_float_t *arr2, mus_long_
mus_float_t mus_dot_product(mus_float_t *data1, mus_float_t *data2, mus_long_t size)
{
- mus_long_t i;
+ mus_long_t i, size4;
mus_float_t sum = 0.0;
- for (i = 0; i < size; i++)
+ size4 = size - 4;
+ i = 0;
+ while (i <= size4)
+ {
+ sum += (data1[i] * data2[i]);
+ i++;
+ sum += (data1[i] * data2[i]);
+ i++;
+ sum += (data1[i] * data2[i]);
+ i++;
+ sum += (data1[i] * data2[i]);
+ i++;
+ }
+ for (; i < size; i++)
sum += (data1[i] * data2[i]);
return(sum);
}
@@ -879,7 +892,7 @@ mus_float_t mus_dot_product(mus_float_t *data1, mus_float_t *data2, mus_long_t s
complex double mus_edot_product(complex double freq, complex double *data, mus_long_t size)
{
- mus_long_t i;
+ int i;
complex double sum = 0.0;
for (i = 0; i < size; i++)
sum += (cexp(i * freq) * data[i]);
@@ -890,25 +903,17 @@ complex double mus_edot_product(complex double freq, complex double *data, mus_l
mus_float_t mus_polynomial(mus_float_t *coeffs, mus_float_t x, int ncoeffs)
{
- double sum;
+ mus_float_t sum;
int i;
if (ncoeffs <= 0) return(0.0);
if (ncoeffs == 1) return(coeffs[0]); /* just a constant term */
sum = coeffs[ncoeffs - 1];
+ /* unrolled is slower */
for (i = ncoeffs - 2; i >= 0; i--)
sum = (sum * x) + coeffs[i];
return((mus_float_t)sum);
}
-
-void mus_multiply_arrays(mus_float_t *data, mus_float_t *window, mus_long_t len)
-{
- mus_long_t i;
- for (i = 0; i < len; i++)
- data[i] *= window[i];
-}
-
-
void mus_rectangular_to_polar(mus_float_t *rl, mus_float_t *im, mus_long_t size)
{
mus_long_t i;
@@ -916,10 +921,16 @@ void mus_rectangular_to_polar(mus_float_t *rl, mus_float_t *im, mus_long_t size)
{
mus_float_t temp; /* apparently floating underflows (denormals?) in sqrt are bringing us to a halt */
temp = rl[i] * rl[i] + im[i] * im[i];
- im[i] = -atan2(im[i], rl[i]); /* "-" here so that clockwise is positive? is this backwards? */
if (temp < .00000001)
- rl[i] = 0.0;
- else rl[i] = sqrt(temp);
+ {
+ rl[i] = 0.0;
+ im[i] = 0.0;
+ }
+ else
+ {
+ im[i] = -atan2(im[i], rl[i]); /* "-" here so that clockwise is positive? is this backwards? */
+ rl[i] = sqrt(temp);
+ }
}
}
@@ -943,10 +954,17 @@ void mus_polar_to_rectangular(mus_float_t *rl, mus_float_t *im, mus_long_t size)
mus_long_t i;
for (i = 0; i < size; i++)
{
+#if HAVE_SINCOS
+ double sx, cx;
+ sincos(-im[i], &sx, &cx);
+ im[i] = sx * rl[i];
+ rl[i] *= cx;
+#else
mus_float_t temp;
temp = rl[i] * sin(-im[i]); /* minus to match sense of rectangular->polar above */
rl[i] *= cos(-im[i]);
im[i] = temp;
+#endif
}
}
@@ -979,12 +997,14 @@ mus_float_t mus_array_interp(mus_float_t *wave, mus_float_t phase, mus_long_t si
if ((phase < 0.0) || (phase > size))
{
/* 28-Mar-01 changed to fmod; I was hoping to avoid this... */
- phase = fmod((double)phase, (double)size);
+ phase = fmod((mus_float_t)phase, (mus_float_t)size);
if (phase < 0.0) phase += size;
}
- int_part = (mus_long_t)floor(phase);
+
+ int_part = (mus_long_t)phase; /* (mus_long_t)floor(phase); */
frac_part = phase - int_part;
if (int_part == size) int_part = 0;
+
if (frac_part == 0.0)
return(wave[int_part]);
else
@@ -1004,7 +1024,7 @@ static mus_float_t mus_array_all_pass_interp(mus_float_t *wave, mus_float_t phas
mus_float_t frac_part;
if ((phase < 0.0) || (phase > size))
{
- phase = fmod((double)phase, (double)size);
+ phase = fmod((mus_float_t)phase, (mus_float_t)size);
if (phase < 0.0) phase += size;
}
int_part = (mus_long_t)floor(phase);
@@ -1034,7 +1054,7 @@ static mus_float_t mus_array_lagrange_interp(mus_float_t *wave, mus_float_t x, m
mus_float_t p, pp;
if ((x < 0.0) || (x > size))
{
- x = fmod((double)x, (double)size);
+ x = fmod((mus_float_t)x, (mus_float_t)size);
if (x < 0.0) x += size;
}
x0 = (mus_long_t)floor(x);
@@ -1059,7 +1079,7 @@ static mus_float_t mus_array_hermite_interp(mus_float_t *wave, mus_float_t x, mu
mus_float_t p, c0, c1, c2, c3, y0, y1, y2, y3;
if ((x < 0.0) || (x > size))
{
- x = fmod((double)x, (double)size);
+ x = fmod((mus_float_t)x, (mus_float_t)size);
if (x < 0.0) x += size;
}
x1 = (mus_long_t)floor(x);
@@ -1090,7 +1110,7 @@ static mus_float_t mus_array_bezier_interp(mus_float_t *wave, mus_float_t x, mus
mus_float_t p, y0, y1, y2, y3, ay, by, cy;
if ((x < 0.0) || (x > size))
{
- x = fmod((double)x, (double)size);
+ x = fmod((mus_float_t)x, (mus_float_t)size);
if (x < 0.0) x += size;
}
x1 = (mus_long_t)floor(x);
@@ -1113,7 +1133,7 @@ static mus_float_t mus_array_bezier_interp(mus_float_t *wave, mus_float_t x, mus
}
-bool mus_interp_type_p(int val)
+bool mus_is_interp_type(int val)
{
/* this is C++'s fault. */
switch (val)
@@ -1178,37 +1198,37 @@ mus_float_t mus_interpolate(mus_interp_t type, mus_float_t x, mus_float_t *table
typedef struct {
mus_any_class *core;
- double phase, freq;
+ mus_float_t phase, freq;
} osc;
mus_float_t mus_oscil(mus_any *ptr, mus_float_t fm, mus_float_t pm)
{
- mus_float_t result;
osc *gen = (osc *)ptr;
- result = sin(gen->phase + pm);
+ mus_float_t result;
+ result = gen->phase + pm;
gen->phase += (gen->freq + fm);
- return(result);
+ return(sin(result));
}
mus_float_t mus_oscil_unmodulated(mus_any *ptr)
{
- mus_float_t result;
osc *gen = (osc *)ptr;
- result = sin(gen->phase);
+ mus_float_t result;
+ result = gen->phase;
gen->phase += gen->freq;
- return(result);
+ return(sin(result));
}
mus_float_t mus_oscil_fm(mus_any *ptr, mus_float_t fm)
{
- mus_float_t result;
osc *gen = (osc *)ptr;
- result = sin(gen->phase);
+ mus_float_t result;
+ result = gen->phase;
gen->phase += (gen->freq + fm);
- return(result);
+ return(sin(result));
}
@@ -1216,20 +1236,22 @@ mus_float_t mus_oscil_pm(mus_any *ptr, mus_float_t pm)
{
mus_float_t result;
osc *gen = (osc *)ptr;
- result = sin(gen->phase + pm);
+ result = gen->phase + pm;
gen->phase += gen->freq;
- return(result);
+ return(sin(result));
}
-bool mus_oscil_p(mus_any *ptr)
+bool mus_is_oscil(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_OSCIL));
}
+/* this could be: bool mus_is_oscil(mus_any *ptr) {return((ptr) && (ptr->core == &OSCIL_CLASS));}
+ */
-static int free_oscil(mus_any *ptr) {if (ptr) clm_free(ptr); return(0);}
+static void free_oscil(mus_any *ptr) {free(ptr);}
static mus_float_t oscil_freq(mus_any *ptr) {return(mus_radians_to_hz(((osc *)ptr)->freq));}
static mus_float_t oscil_set_freq(mus_any *ptr, mus_float_t val) {((osc *)ptr)->freq = mus_hz_to_radians(val); return(val);}
@@ -1243,14 +1265,22 @@ static mus_float_t oscil_set_phase(mus_any *ptr, mus_float_t val) {((osc *)ptr)-
static mus_long_t oscil_cosines(mus_any *ptr) {return(1);}
static void oscil_reset(mus_any *ptr) {((osc *)ptr)->phase = 0.0;}
+static mus_any *oscil_copy(mus_any *ptr)
+{
+ osc *g;
+ g = (osc *)malloc(sizeof(osc));
+ memcpy((void *)g, (void *)ptr, sizeof(osc));
+ return((mus_any *)g);
+}
+
static mus_float_t fallback_scaler(mus_any *ptr) {return(1.0);}
static bool oscil_equalp(mus_any *p1, mus_any *p2)
{
return((p1 == p2) ||
- ((mus_oscil_p((mus_any *)p1)) &&
- (mus_oscil_p((mus_any *)p2)) &&
+ ((mus_is_oscil((mus_any *)p1)) &&
+ (mus_is_oscil((mus_any *)p2)) &&
((((osc *)p1)->freq) == (((osc *)p2)->freq)) &&
((((osc *)p1)->phase) == (((osc *)p2)->phase))));
}
@@ -1259,8 +1289,8 @@ static bool oscil_equalp(mus_any *p1, mus_any *p2)
static char *describe_oscil(mus_any *ptr)
{
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr));
@@ -1289,16 +1319,18 @@ static mus_any_class OSCIL_CLASS = {
0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&oscil_reset,
- 0, 0, 0
+ 0,
+ &oscil_copy
};
+
mus_any *mus_make_oscil(mus_float_t freq, mus_float_t phase)
{
osc *gen;
- gen = (osc *)clm_calloc_atomic(1, sizeof(osc), S_make_oscil);
+ gen = (osc *)malloc(sizeof(osc));
gen->core = &OSCIL_CLASS;
gen->freq = mus_hz_to_radians(freq);
gen->phase = phase;
@@ -1311,22 +1343,313 @@ mus_any *mus_make_oscil(mus_float_t freq, mus_float_t phase)
*/
+/* ---------------- oscil-bank ---------------- */
+
+typedef struct {
+ mus_any_class *core;
+ int size, orig_size;
+ mus_float_t *amps, *phases, *freqs; /* these can change, so sincos is not always safe */
+ bool free_phases;
+ mus_float_t (*ob_func)(mus_any *ptr);
+#if HAVE_SINCOS
+ double *sn1, *cs1, *sn2, *cs2, *phs;
+ bool use_sc;
+#endif
+} ob;
+
+
+static void free_oscil_bank(mus_any *ptr)
+{
+ ob *g = (ob *)ptr;
+#if HAVE_SINCOS
+ if (g->sn1) {free(g->sn1); g->sn1 = NULL;}
+ if (g->sn2) {free(g->sn2); g->sn2 = NULL;}
+ if (g->cs1) {free(g->cs1); g->cs1 = NULL;}
+ if (g->cs2) {free(g->cs2); g->cs2 = NULL;}
+ if (g->phs) {free(g->phs); g->phs = NULL;}
+#endif
+ if ((g->phases) && (g->free_phases)) {free(g->phases); g->phases = NULL;}
+ free(ptr);
+}
+
+static mus_any *ob_copy(mus_any *ptr)
+{
+ ob *g, *p;
+ int bytes;
+
+ p = (ob *)ptr;
+ g = (ob *)malloc(sizeof(ob));
+ memcpy((void *)g, (void *)ptr, sizeof(ob));
+
+ g->ob_func = p->ob_func;
+
+#if HAVE_SINCOS
+ if (g->sn1)
+ {
+ bytes = g->size * sizeof(double);
+ g->sn1 = (double *)malloc(bytes);
+ memcpy((void *)(g->sn1), (void *)(p->sn1), bytes);
+ g->sn2 = (double *)malloc(bytes);
+ memcpy((void *)(g->sn2), (void *)(p->sn2), bytes);
+ g->cs1 = (double *)malloc(bytes);
+ memcpy((void *)(g->cs1), (void *)(p->cs1), bytes);
+ g->cs2 = (double *)malloc(bytes);
+ memcpy((void *)(g->cs2), (void *)(p->cs2), bytes);
+ g->phs = (double *)malloc(bytes);
+ memcpy((void *)(g->phs), (void *)(p->phs), bytes);
+ g->use_sc = p->use_sc;
+ }
+#endif
+
+ bytes = g->size * sizeof(mus_float_t);
+ /* we have to make a new phases array -- otherwise the original and copy step on each other */
+ g->free_phases = true;
+ g->phases = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->phases), (void *)(p->phases), bytes);
+ return((mus_any *)g);
+}
+
+static mus_float_t *ob_data(mus_any *ptr) {return(((ob *)ptr)->phases);}
+
+static mus_float_t run_oscil_bank(mus_any *ptr, mus_float_t input, mus_float_t unused)
+{
+ return(mus_oscil_bank(ptr));
+}
+
+
+static mus_long_t oscil_bank_length(mus_any *ptr)
+{
+ return(((ob *)ptr)->size);
+}
+
+
+static mus_long_t oscil_bank_set_length(mus_any *ptr, mus_long_t len)
+{
+ ob *g = (ob *)ptr;
+ if (len < 0)
+ g->size = 0;
+ else
+ {
+ if (len > g->orig_size)
+ g->size = g->orig_size;
+ else g->size = len;
+ }
+ return(len);
+}
+
+
+static void oscil_bank_reset(mus_any *ptr)
+{
+ ob *p = (ob *)ptr;
+ p->size = p->orig_size;
+ memset((void *)(p->phases), 0, p->orig_size * sizeof(mus_float_t));
+}
+
+
+static bool oscil_bank_equalp(mus_any *p1, mus_any *p2)
+{
+ ob *o1 = (ob *)p1;
+ ob *o2 = (ob *)p2;
+ if (p1 == p2) return(true);
+ return((o1->size == o2->size) &&
+ (o1->orig_size == o2->orig_size) &&
+ (o1->amps == o2->amps) &&
+ (o1->freqs == o2->freqs) &&
+ ((o1->phases == o2->phases) ||
+ (clm_arrays_are_equal(o1->phases, o2->phases, o2->size))));
+}
+
+
+static char *describe_oscil_bank(mus_any *ptr)
+{
+ ob *gen = (ob *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %d",
+ mus_name(ptr),
+ gen->size);
+ return(describe_buffer);
+}
+
+static mus_any_class OSCIL_BANK_CLASS = {
+ MUS_OSCIL_BANK,
+ (char *)S_oscil_bank,
+ &free_oscil_bank,
+ &describe_oscil_bank,
+ &oscil_bank_equalp,
+ &ob_data, 0,
+ &oscil_bank_length, &oscil_bank_set_length,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_oscil_bank,
+ MUS_NOT_SPECIAL,
+ NULL, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &oscil_bank_reset,
+ 0, &ob_copy
+};
+
+
+bool mus_is_oscil_bank(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_OSCIL_BANK));
+}
+
+
+static mus_float_t oscil_bank(mus_any *ptr)
+{
+ ob *p = (ob *)ptr;
+ int i;
+ mus_float_t sum = 0.0;
+ if (!p->amps)
+ {
+ for (i = 0; i < p->size; i++)
+ {
+ sum += sin(p->phases[i]);
+ p->phases[i] += p->freqs[i];
+ }
+ }
+ else
+ {
+ for (i = 0; i < p->size; i++)
+ {
+ sum += (p->amps[i] * sin(p->phases[i]));
+ p->phases[i] += p->freqs[i];
+ }
+ }
+ return(sum);
+}
+
+
+#if HAVE_SINCOS
+static mus_float_t stable_oscil_bank(mus_any *ptr)
+{
+ ob *p = (ob *)ptr;
+ int i;
+ mus_float_t sum = 0.0;
+ if (p->use_sc)
+ {
+ for (i = 0; i < p->size; i++)
+ sum += (p->sn1[i] * p->cs2[i] + p->cs1[i] * p->sn2[i]);
+ p->use_sc = false;
+ }
+ else
+ {
+ double s, c;
+ if (!p->amps)
+ {
+ for (i = 0; i < p->size; i++)
+ {
+ sincos(p->phases[i], &s, &c);
+ p->sn2[i] = s;
+ p->cs2[i] = c;
+ sum += s;
+ p->phases[i] += p->phs[i];
+ }
+ }
+ else
+ {
+ for (i = 0; i < p->size; i++)
+ {
+ sincos(p->phases[i], &s, &c);
+ p->sn2[i] = s;
+ p->cs2[i] = c;
+ sum += p->amps[i] * s;
+ p->phases[i] += p->phs[i];
+ }
+ }
+ p->use_sc = true;
+ }
+ return(sum);
+}
+#endif
+
+
+mus_float_t mus_oscil_bank(mus_any *ptr)
+{
+ ob *p = (ob *)ptr;
+ return(p->ob_func(ptr));
+}
+
+
+mus_any *mus_make_oscil_bank(int size, mus_float_t *freqs, mus_float_t *phases, mus_float_t *amps, bool stable)
+{
+ ob *gen;
+
+ gen = (ob *)malloc(sizeof(ob));
+ gen->core = &OSCIL_BANK_CLASS;
+ gen->orig_size = size;
+ gen->size = size;
+ gen->amps = amps;
+ gen->freqs = freqs;
+ gen->phases = phases;
+ gen->free_phases = false;
+ gen->ob_func = oscil_bank;
+
+#if HAVE_SINCOS
+ if (stable)
+ {
+ int i;
+ double s, c;
+
+ gen->ob_func = stable_oscil_bank;
+ gen->use_sc = false;
+ gen->sn1 = (double *)malloc(size * sizeof(double));
+ gen->sn2 = (double *)malloc(size * sizeof(double));
+ gen->cs1 = (double *)malloc(size * sizeof(double));
+ gen->cs2 = (double *)malloc(size * sizeof(double));
+ gen->phs = (double *)malloc(size * sizeof(double));
+
+ for (i = 0; i < size; i++)
+ {
+ sincos(freqs[i], &s, &c);
+ if (amps)
+ {
+ s *= amps[i];
+ c *= amps[i];
+ }
+ gen->sn1[i] = s;
+ gen->cs1[i] = c;
+ gen->phs[i] = freqs[i] * 2.0;
+ }
+ }
+ else
+ {
+ gen->sn1 = NULL;
+ gen->sn2 = NULL;
+ gen->cs1 = NULL;
+ gen->cs2 = NULL;
+ gen->phs = NULL;
+ }
+#endif
+
+ return((mus_any *)gen);
+}
+
+
/* ---------------- ncos ---------------- */
typedef struct {
mus_any_class *core;
int n;
- double scaler, cos5, phase, freq;
+ mus_float_t scaler, cos5, phase, freq;
} cosp;
-#define DIVISOR_NEAR_ZERO(Den) MUS_UNLIKELY(fabs(Den) < 1.0e-14)
+#define DIVISOR_NEAR_ZERO(Den) (fabs(Den) < 1.0e-14)
mus_float_t mus_ncos(mus_any *ptr, mus_float_t fm)
{
/* changed 25-Apr-04: use less stupid formula */
/* (/ (- (/ (sin (* (+ n 0.5) angle)) (* 2 (sin (* 0.5 angle)))) 0.5) n) */
- double val, den;
+ mus_float_t val, den;
cosp *gen = (cosp *)ptr;
den = sin(gen->phase * 0.5);
if (DIVISOR_NEAR_ZERO(den)) /* see note -- this was den == 0.0 1-Aug-07 */
@@ -1384,14 +1707,14 @@ mus_float_t mus_ncos(mus_any *ptr, mus_float_t fm)
-3.0
:(/ (cos (* 1.5 pi 1.0000000000000008)) (cos (* 0.5 pi 1.0000000000000008)))
-3.34939116712516
- ;; 16 bits in is probably too much for doubles
+ ;; 16 bits in is probably too much for mus_float_ts
;; these numbers can be hit in normal cases:
(define (ncos-with-inversions n x)
;; Andrews Askey Roy 261
(let* ((num (cos (* x (+ 0.5 n))))
(den (cos (* x 0.5)))
- (val (/ num den))) ; Chebyshev polynomial of the 3rd kind! (4th uses sin = our current formula)
+ (val (/ num den))) ; Chebyshev polynomial of the third kind! (4th uses sin = our current formula)
(/ (- (if (even? n) val (- val))
0.5)
(+ 1 (* n 2)))))
@@ -1405,14 +1728,14 @@ mus_float_t mus_ncos(mus_any *ptr, mus_float_t fm)
#endif
-bool mus_ncos_p(mus_any *ptr)
+bool mus_is_ncos(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_NCOS));
}
-static int free_ncos(mus_any *ptr) {if (ptr) clm_free(ptr); return(0);}
+static void free_ncos(mus_any *ptr) {free(ptr);}
static void ncos_reset(mus_any *ptr) {((cosp *)ptr)->phase = 0.0;}
static mus_float_t ncos_freq(mus_any *ptr) {return(mus_radians_to_hz(((cosp *)ptr)->freq));}
@@ -1429,6 +1752,14 @@ static mus_float_t ncos_set_scaler(mus_any *ptr, mus_float_t val) {((cosp *)ptr)
static mus_long_t ncos_n(mus_any *ptr) {return(((cosp *)ptr)->n);}
+static mus_any *cosp_copy(mus_any *ptr)
+{
+ cosp *g;
+ g = (cosp *)malloc(sizeof(cosp));
+ memcpy((void *)g, (void *)ptr, sizeof(cosp));
+ return((mus_any *)g);
+}
+
static mus_long_t ncos_set_n(mus_any *ptr, mus_long_t val)
{
cosp *gen = (cosp *)ptr;
@@ -1447,7 +1778,7 @@ static mus_float_t run_ncos(mus_any *ptr, mus_float_t fm, mus_float_t unused) {r
static bool ncos_equalp(mus_any *p1, mus_any *p2)
{
return((p1 == p2) ||
- ((mus_ncos_p((mus_any *)p1)) && (mus_ncos_p((mus_any *)p2)) &&
+ ((mus_is_ncos((mus_any *)p1)) && (mus_is_ncos((mus_any *)p2)) &&
((((cosp *)p1)->freq) == (((cosp *)p2)->freq)) &&
((((cosp *)p1)->phase) == (((cosp *)p2)->phase)) &&
((((cosp *)p1)->n) == (((cosp *)p2)->n)) &&
@@ -1458,8 +1789,8 @@ static bool ncos_equalp(mus_any *p1, mus_any *p2)
static char *describe_ncos(mus_any *ptr)
{
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, n: %d",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, n: %d",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
@@ -1492,16 +1823,17 @@ static mus_any_class NCOS_CLASS = {
0, 0, 0, 0, 0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&ncos_reset,
- 0, 0, 0
+ 0,
+ &cosp_copy
};
mus_any *mus_make_ncos(mus_float_t freq, int n)
{
cosp *gen;
- gen = (cosp *)clm_calloc_atomic(1, sizeof(cosp), S_make_ncos);
+ gen = (cosp *)malloc(sizeof(cosp));
gen->core = &NCOS_CLASS;
if (n == 0) n = 1;
gen->scaler = 1.0 / (mus_float_t)n;
@@ -1518,7 +1850,7 @@ mus_any *mus_make_ncos(mus_float_t freq, int n)
static bool nsin_equalp(mus_any *p1, mus_any *p2)
{
return((p1 == p2) ||
- ((mus_nsin_p((mus_any *)p1)) && (mus_nsin_p((mus_any *)p2)) &&
+ ((mus_is_nsin((mus_any *)p1)) && (mus_is_nsin((mus_any *)p2)) &&
((((cosp *)p1)->freq) == (((cosp *)p2)->freq)) &&
((((cosp *)p1)->phase) == (((cosp *)p2)->phase)) &&
((((cosp *)p1)->n) == (((cosp *)p2)->n)) &&
@@ -1529,8 +1861,8 @@ static bool nsin_equalp(mus_any *p1, mus_any *p2)
static char *describe_nsin(mus_any *ptr)
{
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, n: %d",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, n: %d",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
@@ -1539,7 +1871,7 @@ static char *describe_nsin(mus_any *ptr)
}
-bool mus_nsin_p(mus_any *ptr)
+bool mus_is_nsin(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_NSIN));
@@ -1557,7 +1889,7 @@ bool mus_nsin_p(mus_any *ptr)
(do ((i 0 (1+ i)))
((= i n))
(vct-set! dcos i (* (+ i 1) (vct-ref coeffs i))))
- (let ((partials '()))
+ (let ((partials ()))
(do ((i 0 (1+ i)))
((= i n))
(set! partials (append (list (vct-ref dcos i) (+ i 1)) partials)))
@@ -1624,7 +1956,7 @@ bool mus_nsin_p(mus_any *ptr)
*
* -(cos(x/2)sin(nx/2)sin((n+1)x/2))/(2sin^2(x/2)) + ncos(nx/2)sin((n+1)x/2)/(2sin(x/2)) + (n+1)sin(nx/2)cos((n+1)x/2)/(2sin(x/2))
*
- * and find the 1st 0 when n is very large -- it is very close to 3pi/(4*n)
+ * and find the first 0 when n is very large -- it is very close to 3pi/(4*n)
*/
#endif
@@ -1678,13 +2010,27 @@ mus_float_t mus_nsin(mus_any *ptr, mus_float_t fm)
0.0
(/ (* (sin (* n a2)) (sin (* (1+ n) a2))) den)))
*/
- double val, den, a2;
+#if HAVE_SINCOS
+ double val, a2, ns, nc, s, c;
+ cosp *gen = (cosp *)ptr;
+ a2 = gen->phase * 0.5;
+ sincos(a2, &s, &c);
+ if (DIVISOR_NEAR_ZERO(s)) /* see note under ncos */
+ val = 0.0;
+ else
+ {
+ sincos(gen->n * a2, &ns, &nc);
+ val = gen->scaler * ns * (ns * c + nc * s) / s;
+ }
+#else
+ mus_float_t val, den, a2;
cosp *gen = (cosp *)ptr;
a2 = gen->phase * 0.5;
den = sin(a2);
if (DIVISOR_NEAR_ZERO(den)) /* see note under ncos */
val = 0.0;
else val = gen->scaler * sin(gen->n * a2) * sin(a2 * gen->cos5) / den;
+#endif
gen->phase += (gen->freq + fm);
return((mus_float_t)val);
}
@@ -1716,9 +2062,10 @@ static mus_any_class NSIN_CLASS = {
0, 0, 0, 0, 0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&ncos_reset,
- 0, 0, 0
+ 0,
+ &cosp_copy
};
@@ -1740,16 +2087,24 @@ mus_any *mus_make_nsin(mus_float_t freq, int n)
typedef struct {
mus_any_class *core;
mus_float_t r;
- double freq, phase;
+ mus_float_t freq, phase;
mus_float_t ratio;
- double cosr, sinr;
+ mus_float_t cosr, sinr;
mus_float_t one;
} asyfm;
-static int free_asymmetric_fm(mus_any *ptr) {if (ptr) clm_free(ptr); return(0);}
+static void free_asymmetric_fm(mus_any *ptr) {free(ptr);}
static void asyfm_reset(mus_any *ptr) {((asyfm *)ptr)->phase = 0.0;}
+static mus_any *asyfm_copy(mus_any *ptr)
+{
+ asyfm *g;
+ g = (asyfm *)malloc(sizeof(asyfm));
+ memcpy((void *)g, (void *)ptr, sizeof(asyfm));
+ return((mus_any *)g);
+}
+
static mus_float_t asyfm_freq(mus_any *ptr) {return(mus_radians_to_hz(((asyfm *)ptr)->freq));}
static mus_float_t asyfm_set_freq(mus_any *ptr, mus_float_t val) {((asyfm *)ptr)->freq = mus_hz_to_radians(val); return(val);}
@@ -1794,8 +2149,8 @@ static bool asyfm_equalp(mus_any *p1, mus_any *p2)
static char *describe_asyfm(mus_any *ptr)
{
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, ratio: %.3f, r: %.3f",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, ratio: %.3f, r: %.3f",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
@@ -1805,7 +2160,7 @@ static char *describe_asyfm(mus_any *ptr)
}
-bool mus_asymmetric_fm_p(mus_any *ptr)
+bool mus_is_asymmetric_fm(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_ASYMMETRIC_FM));
@@ -1816,19 +2171,8 @@ mus_float_t mus_asymmetric_fm(mus_any *ptr, mus_float_t index, mus_float_t fm)
{
asyfm *gen = (asyfm *)ptr;
mus_float_t result;
- double mth;
+ mus_float_t mth;
mth = gen->ratio * gen->phase;
-
-#if 0
- {
- /* sincos is too hard to access, but it would be interesting to check timings (this also occurs in the fft's and polar->rectangular) */
- /* my quick tests indicate that sincos is about 25% faster than sin+cos */
- double cf, sf;
- sincos(mth, &sf, &cf);
- result = exp(index * gen->cosr * cf) * sin(gen->phase + index * gen->sinr * sf);
- }
-#endif
-
result = exp(index * gen->cosr * (gen->one + cos(mth))) * cos(gen->phase + index * gen->sinr * sin(mth));
/* second index factor added 4-Mar-02 and (+/-)1.0 + cos to normalize amps 6-Sep-07 */
gen->phase += (gen->freq + fm);
@@ -1847,17 +2191,6 @@ mus_float_t mus_asymmetric_fm_unmodulated(mus_any *ptr, mus_float_t index)
return(result);
}
-
-mus_float_t mus_asymmetric_fm_no_input(mus_any *ptr)
-{
- asyfm *gen = (asyfm *)ptr;
- mus_float_t result;
- result = sin(gen->phase);
- gen->phase += gen->freq;
- return(result);
-}
-
-
static mus_any_class ASYMMETRIC_FM_CLASS = {
MUS_ASYMMETRIC_FM,
(char *)S_asymmetric_fm,
@@ -1879,9 +2212,10 @@ static mus_any_class ASYMMETRIC_FM_CLASS = {
&asyfm_ratio,
0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&asyfm_reset,
- 0, 0, 0
+ 0,
+ &asyfm_copy
};
@@ -1889,10 +2223,10 @@ mus_any *mus_make_asymmetric_fm(mus_float_t freq, mus_float_t phase, mus_float_t
{
asyfm *gen = NULL;
if (r == 0.0)
- mus_error(MUS_ARG_OUT_OF_RANGE, "r can't be 0.0");
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_asymmetric_fm ": r can't be 0.0");
else
{
- gen = (asyfm *)clm_calloc_atomic(1, sizeof(asyfm), S_make_asymmetric_fm);
+ gen = (asyfm *)malloc(sizeof(asyfm));
gen->core = &ASYMMETRIC_FM_CLASS;
gen->freq = mus_hz_to_radians(freq);
gen->phase = phase;
@@ -1924,15 +2258,23 @@ mus_any *mus_make_asymmetric_fm(mus_float_t freq, mus_float_t phase, mus_float_t
typedef struct {
mus_any_class *core;
- double freq, phase;
+ mus_float_t freq, phase;
int n;
- double norm, r, r_to_n_plus_1, r_squared_plus_1, y_over_x;
+ mus_float_t norm, r, r_to_n_plus_1, r_squared_plus_1, y_over_x;
} nrxy;
-static int free_nrxy(mus_any *ptr) {if (ptr) clm_free(ptr); return(0);}
+static void free_nrxy(mus_any *ptr) {free(ptr);}
static void nrxy_reset(mus_any *ptr) {((nrxy *)ptr)->phase = 0.0;}
+static mus_any *nrxy_copy(mus_any *ptr)
+{
+ nrxy *g;
+ g = (nrxy *)malloc(sizeof(nrxy));
+ memcpy((void *)g, (void *)ptr, sizeof(nrxy));
+ return((mus_any *)g);
+}
+
static mus_float_t nrxy_freq(mus_any *ptr) {return(mus_radians_to_hz(((nrxy *)ptr)->freq));}
static mus_float_t nrxy_set_freq(mus_any *ptr, mus_float_t val) {((nrxy *)ptr)->freq = mus_hz_to_radians(val); return(val);}
@@ -1982,7 +2324,7 @@ static bool nrxy_equalp(mus_any *p1, mus_any *p2)
}
-bool mus_nrxysin_p(mus_any *ptr)
+bool mus_is_nrxysin(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_NRXYSIN));
@@ -1993,8 +2335,8 @@ static char *describe_nrxysin(mus_any *ptr)
{
nrxy *gen = (nrxy *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s frequency: %.3f, ratio: %.3f, phase: %.3f, n: %d, r: %.3f",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s frequency: %.3f, ratio: %.3f, phase: %.3f, n: %d, r: %.3f",
mus_name(ptr),
mus_frequency(ptr),
gen->y_over_x,
@@ -2011,25 +2353,66 @@ mus_float_t mus_nrxysin(mus_any *ptr, mus_float_t fm)
/* see also Durell and Robson "Advanced Trigonometry" p 175 */
nrxy *gen = (nrxy *)ptr;
- double x, y, r, divisor;
+ mus_float_t x, y, r, divisor;
int n;
x = gen->phase;
- y = x * gen->y_over_x;
n = gen->n;
r = gen->r;
-
gen->phase += (gen->freq + fm);
+
+ if (gen->y_over_x == 1.0)
+ {
+#if (!HAVE_SINCOS)
+ divisor = gen->norm * (gen->r_squared_plus_1 - (2 * r * cos(x)));
+ if (DIVISOR_NEAR_ZERO(divisor))
+ return(0.0);
+ return((sin(x) - gen->r_to_n_plus_1 * (sin(x * (n + 2)) - r * sin(x * (n + 1)))) / divisor);
+#else
+ double sx, cx, snx, cnx;
+ sincos(x, &sx, &cx);
+ divisor = gen->norm * (gen->r_squared_plus_1 - (2 * r * cx));
+ if (DIVISOR_NEAR_ZERO(divisor))
+ return(0.0);
+ sincos((n + 1) * x, &snx, &cnx);
+ return((sx - gen->r_to_n_plus_1 * (sx * cnx + (cx - r) * snx)) / divisor);
+#endif
+ }
+
+#if HAVE_SINCOS
+ {
+ double xs, xc, ys, yc, nys, nyc, sin_x_y, sin_x_ny, sin_x_n1y, cos_x_ny;
+
+ y = x * gen->y_over_x;
+ sincos(y, &ys, &yc);
+ divisor = gen->norm * (gen->r_squared_plus_1 - (2 * r * yc));
+ if (DIVISOR_NEAR_ZERO(divisor))
+ return(0.0);
+
+ sincos(x, &xs, &xc);
+ sincos(n * y, &nys, &nyc);
+ sin_x_y = (xs * yc - ys * xc);
+ sin_x_ny = (xs * nyc + nys * xc);
+ cos_x_ny = (xc * nyc - xs * nys);
+ sin_x_n1y = (sin_x_ny * yc + cos_x_ny * ys);
+
+ return((xs -
+ r * sin_x_y -
+ gen->r_to_n_plus_1 * (sin_x_n1y - r * sin_x_ny)) / divisor);
+ }
+#else
+ y = x * gen->y_over_x;
divisor = gen->norm * (gen->r_squared_plus_1 - (2 * r * cos(y)));
if (DIVISOR_NEAR_ZERO(divisor))
return(0.0);
return((sin(x) -
r * sin(x - y) -
- gen->r_to_n_plus_1 * (sin (x + (n + 1) * y) -
+ gen->r_to_n_plus_1 * (sin(x + (n + 1) * y) -
r * sin(x + n * y))) /
divisor);
+#endif
}
@@ -2060,16 +2443,17 @@ static mus_any_class NRXYSIN_CLASS = {
0, 0, 0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&nrxy_reset,
- 0, 0, 0
+ 0,
+ &nrxy_copy
};
mus_any *mus_make_nrxysin(mus_float_t frequency, mus_float_t y_over_x, int n, mus_float_t r)
{
nrxy *gen;
- gen = (nrxy *)clm_calloc_atomic(1, sizeof(nrxy), S_make_nrxysin);
+ gen = (nrxy *)malloc(sizeof(nrxy));
gen->core = &NRXYSIN_CLASS;
gen->freq = mus_hz_to_radians(frequency);
gen->y_over_x = y_over_x;
@@ -2080,7 +2464,7 @@ mus_any *mus_make_nrxysin(mus_float_t frequency, mus_float_t y_over_x, int n, mu
}
-bool mus_nrxycos_p(mus_any *ptr)
+bool mus_is_nrxycos(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_NRXYCOS));
@@ -2091,8 +2475,8 @@ static char *describe_nrxycos(mus_any *ptr)
{
nrxy *gen = (nrxy *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s frequency: %.3f, ratio: %.3f, phase: %.3f, n: %d, r: %.3f",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s frequency: %.3f, ratio: %.3f, phase: %.3f, n: %d, r: %.3f",
mus_name(ptr),
mus_frequency(ptr),
gen->y_over_x,
@@ -2106,7 +2490,7 @@ static char *describe_nrxycos(mus_any *ptr)
mus_float_t mus_nrxycos(mus_any *ptr, mus_float_t fm)
{
nrxy *gen = (nrxy *)ptr;
- double x, y, r, divisor;
+ mus_float_t x, y, r, divisor;
int n;
x = gen->phase;
@@ -2115,13 +2499,31 @@ mus_float_t mus_nrxycos(mus_any *ptr, mus_float_t fm)
r = gen->r;
gen->phase += (gen->freq + fm);
-
+
+#if HAVE_SINCOS
+ {
+ double xs, xc, ys, yc, nys, nyc, cos_x_y, cos_x_ny, cos_x_n1y, sin_x_ny;
+
+ sincos(y, &ys, &yc);
+ divisor = gen->norm * (gen->r_squared_plus_1 - (2 * r * yc));
+ if (DIVISOR_NEAR_ZERO(divisor))
+ return(1.0);
+
+ sincos(x, &xs, &xc);
+ sincos(n * y, &nys, &nyc);
+ cos_x_y = (xc * yc + ys * xs);
+ sin_x_ny = (xs * nyc + nys * xc);
+ cos_x_ny = (xc * nyc - xs * nys);
+ cos_x_n1y = (cos_x_ny * yc - sin_x_ny * ys);
+ return((xc -
+ r * cos_x_y -
+ gen->r_to_n_plus_1 * (cos_x_n1y - r * cos_x_ny)) / divisor);
+ }
+#else
divisor = gen->norm * (gen->r_squared_plus_1 - (2 * r * cos(y)));
if (DIVISOR_NEAR_ZERO(divisor))
return(1.0);
- /* this can happen if --with-doubles and r>0.9999999 or thereabouts;
- * it also happens in x86-64 linux with r=.999999 (with floats), divisor ca 1.0e-12
- * in this case, using --with-doubles fixes it
+ /* this can happen if r>0.9999999 or thereabouts;
*/
return((cos(x) -
@@ -2129,6 +2531,7 @@ mus_float_t mus_nrxycos(mus_any *ptr, mus_float_t fm)
gen->r_to_n_plus_1 * (cos(x + (n + 1) * y) -
r * cos(x + n * y))) /
divisor);
+#endif
}
@@ -2159,9 +2562,10 @@ static mus_any_class NRXYCOS_CLASS = {
0, 0, 0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&nrxy_reset,
- 0, 0, 0
+ 0,
+ &nrxy_copy
};
@@ -2175,33 +2579,232 @@ mus_any *mus_make_nrxycos(mus_float_t frequency, mus_float_t y_over_x, int n, mu
+/* ---------------- rxykcos/sin ---------------- */
+
+typedef struct {
+ mus_any_class *core;
+ mus_float_t r, ar;
+ mus_float_t freq, phase;
+ mus_float_t ratio;
+} rxyk;
+
+
+static void free_rxykcos(mus_any *ptr) {free(ptr);}
+static void rxyk_reset(mus_any *ptr) {((rxyk *)ptr)->phase = 0.0;}
+
+static mus_any *rxyk_copy(mus_any *ptr)
+{
+ rxyk *g;
+ g = (rxyk *)malloc(sizeof(rxyk));
+ memcpy((void *)g, (void *)ptr, sizeof(rxyk));
+ return((mus_any *)g);
+}
+
+static mus_float_t rxyk_freq(mus_any *ptr) {return(mus_radians_to_hz(((rxyk *)ptr)->freq));}
+static mus_float_t rxyk_set_freq(mus_any *ptr, mus_float_t val) {((rxyk *)ptr)->freq = mus_hz_to_radians(val); return(val);}
+
+static mus_float_t rxyk_increment(mus_any *ptr) {return(((rxyk *)ptr)->freq);}
+static mus_float_t rxyk_set_increment(mus_any *ptr, mus_float_t val) {((rxyk *)ptr)->freq = val; return(val);}
+
+static mus_float_t rxyk_phase(mus_any *ptr) {return(fmod(((rxyk *)ptr)->phase, TWO_PI));}
+static mus_float_t rxyk_set_phase(mus_any *ptr, mus_float_t val) {((rxyk *)ptr)->phase = val; return(val);}
+
+static mus_float_t rxyk_ratio(mus_any *ptr) {return(((rxyk *)ptr)->ratio);}
+
+static mus_float_t rxyk_r(mus_any *ptr) {return(((rxyk *)ptr)->r);}
+
+static mus_float_t rxyk_set_r(mus_any *ptr, mus_float_t val)
+{
+ rxyk *gen = (rxyk *)ptr;
+ gen->r = val;
+ gen->ar = 1.0 / exp(fabs(val));
+ return(val);
+}
+
+static mus_float_t run_rxykcos(mus_any *ptr, mus_float_t fm, mus_float_t unused) {return(mus_rxykcos(ptr, fm));}
+static mus_float_t run_rxyksin(mus_any *ptr, mus_float_t fm, mus_float_t unused) {return(mus_rxyksin(ptr, fm));}
+
+static bool rxyk_equalp(mus_any *p1, mus_any *p2)
+{
+ return((p1 == p2) ||
+ (((p1->core)->type == (p2->core)->type) &&
+ ((((rxyk *)p1)->freq) == (((rxyk *)p2)->freq)) &&
+ ((((rxyk *)p1)->phase) == (((rxyk *)p2)->phase)) &&
+ ((((rxyk *)p1)->ratio) == (((rxyk *)p2)->ratio)) &&
+ ((((rxyk *)p1)->r) == (((rxyk *)p2)->r))));
+}
+
+
+static char *describe_rxyk(mus_any *ptr)
+{
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, ratio: %.3f, r: %.3f",
+ mus_name(ptr),
+ mus_frequency(ptr),
+ mus_phase(ptr),
+ ((rxyk *)ptr)->ratio,
+ rxyk_r(ptr));
+ return(describe_buffer);
+}
+
+
+bool mus_is_rxykcos(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_RXYKCOS));
+}
+
+
+mus_float_t mus_rxykcos(mus_any *ptr, mus_float_t fm)
+{
+ rxyk *gen = (rxyk *)ptr;
+ mus_float_t result, rx;
+
+ rx = gen->ratio * gen->phase;
+ result = gen->ar * exp(gen->r * cos(rx)) * cos(gen->phase + (gen->r * sin(rx)));
+ gen->phase += (fm + gen->freq);
+
+ return(result);
+}
+
+
+static mus_any_class RXYKCOS_CLASS = {
+ MUS_RXYKCOS,
+ (char *)S_rxykcos,
+ &free_rxykcos,
+ &describe_rxyk,
+ &rxyk_equalp,
+ 0, 0, 0, 0,
+ &rxyk_freq,
+ &rxyk_set_freq,
+ &rxyk_phase,
+ &rxyk_set_phase,
+ &rxyk_r,
+ &rxyk_set_r,
+ &rxyk_increment,
+ &rxyk_set_increment,
+ &run_rxykcos,
+ MUS_NOT_SPECIAL,
+ NULL, 0,
+ &rxyk_ratio,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &rxyk_reset,
+ 0,
+ &rxyk_copy
+};
+
+
+mus_any *mus_make_rxykcos(mus_float_t freq, mus_float_t phase, mus_float_t r, mus_float_t ratio) /* r default 0.5, ratio 1.0 */
+{
+ rxyk *gen = NULL;
+ gen = (rxyk *)malloc(sizeof(rxyk));
+ gen->core = &RXYKCOS_CLASS;
+ gen->freq = mus_hz_to_radians(freq);
+ gen->phase = phase;
+ gen->r = r;
+ gen->ar = 1.0 / exp(fabs(r));
+ gen->ratio = ratio;
+ return((mus_any *)gen);
+}
+
+
+
+bool mus_is_rxyksin(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_RXYKSIN));
+}
+
+
+mus_float_t mus_rxyksin(mus_any *ptr, mus_float_t fm)
+{
+ rxyk *gen = (rxyk *)ptr;
+ mus_float_t result, rx;
+
+ rx = gen->ratio * gen->phase;
+ result = gen->ar * exp(gen->r * cos(rx)) * sin(gen->phase + (gen->r * sin(rx)));
+ gen->phase += (fm + gen->freq);
+
+ return(result);
+}
+
+
+static mus_any_class RXYKSIN_CLASS = {
+ MUS_RXYKSIN,
+ (char *)S_rxyksin,
+ &free_rxykcos,
+ &describe_rxyk,
+ &rxyk_equalp,
+ 0, 0, 0, 0,
+ &rxyk_freq,
+ &rxyk_set_freq,
+ &rxyk_phase,
+ &rxyk_set_phase,
+ &rxyk_r,
+ &rxyk_set_r,
+ &rxyk_increment,
+ &rxyk_set_increment,
+ &run_rxyksin,
+ MUS_NOT_SPECIAL,
+ NULL, 0,
+ &rxyk_ratio,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &rxyk_reset,
+ 0,
+ &rxyk_copy
+};
+
+
+mus_any *mus_make_rxyksin(mus_float_t freq, mus_float_t phase, mus_float_t r, mus_float_t ratio) /* r default 0.5, ratio 1.0 */
+{
+ rxyk *gen = NULL;
+ gen = (rxyk *)malloc(sizeof(rxyk));
+ gen->core = &RXYKSIN_CLASS;
+ gen->freq = mus_hz_to_radians(freq);
+ gen->phase = phase;
+ gen->r = r;
+ gen->ar = 1.0 / exp(fabs(r));
+ gen->ratio = ratio;
+ return((mus_any *)gen);
+}
+
+
+
/* ---------------- table lookup ---------------- */
typedef struct {
mus_any_class *core;
- double freq, internal_mag, phase;
+ mus_float_t freq, internal_mag, phase;
mus_float_t *table;
mus_long_t table_size;
mus_interp_t type;
bool table_allocated;
mus_float_t yn1;
+ mus_float_t (*tbl_look)(mus_any *ptr, mus_float_t fm);
+ mus_float_t (*tbl_look_unmod)(mus_any *ptr);
} tbl;
mus_float_t *mus_partials_to_wave(mus_float_t *partial_data, int partials, mus_float_t *table, mus_long_t table_size, bool normalize)
{
int partial, k;
- mus_clear_array(table, table_size);
+ if (!table) return(NULL);
+ memset((void *)table, 0, table_size * sizeof(mus_float_t));
for (partial = 0, k = 1; partial < partials; partial++, k += 2)
{
- double amp;
+ mus_float_t amp;
amp = partial_data[k];
if (amp != 0.0)
{
mus_long_t i;
- double freq, angle;
- freq = (partial_data[partial * 2] * TWO_PI) / (double)table_size;
+ mus_float_t freq, angle;
+ freq = (partial_data[partial * 2] * TWO_PI) / (mus_float_t)table_size;
for (i = 0, angle = 0.0; i < table_size; i++, angle += freq)
table[i] += amp * sin(angle);
}
@@ -2215,16 +2818,17 @@ mus_float_t *mus_partials_to_wave(mus_float_t *partial_data, int partials, mus_f
mus_float_t *mus_phase_partials_to_wave(mus_float_t *partial_data, int partials, mus_float_t *table, mus_long_t table_size, bool normalize)
{
int partial, k, n;
- mus_clear_array(table, table_size);
+ if (!table) return(NULL);
+ memset((void *)table, 0, table_size * sizeof(mus_float_t));
for (partial = 0, k = 1, n = 2; partial < partials; partial++, k += 3, n += 3)
{
- double amp;
+ mus_float_t amp;
amp = partial_data[k];
if (amp != 0.0)
{
mus_long_t i;
- double freq, angle;
- freq = (partial_data[partial * 3] * TWO_PI) / (double)table_size;
+ mus_float_t freq, angle;
+ freq = (partial_data[partial * 3] * TWO_PI) / (mus_float_t)table_size;
for (i = 0, angle = partial_data[n]; i < table_size; i++, angle += freq)
table[i] += amp * sin(angle);
}
@@ -2237,13 +2841,48 @@ mus_float_t *mus_phase_partials_to_wave(mus_float_t *partial_data, int partials,
mus_float_t mus_table_lookup(mus_any *ptr, mus_float_t fm)
{
+ return(((tbl *)ptr)->tbl_look(ptr, fm));
+}
+
+static mus_float_t table_look_linear(mus_any *ptr, mus_float_t fm)
+{
+ tbl *gen = (tbl *)ptr;
+
+ /* we're checking already for out-of-range indices, so mus_array_interp is more than we need */
+ mus_long_t int_part;
+ mus_float_t frac_part, f1;
+
+ int_part = (mus_long_t)(gen->phase); /* floor(gen->phase) -- slow! modf is even worse */
+ frac_part = gen->phase - int_part;
+ f1 = gen->table[int_part];
+ int_part++;
+
+ if (int_part == gen->table_size)
+ gen->yn1 = f1 + frac_part * (gen->table[0] - f1);
+ else gen->yn1 = f1 + frac_part * (gen->table[int_part] - f1);
+
+ gen->phase += (gen->freq + (fm * gen->internal_mag));
+ if ((gen->phase >= gen->table_size) ||
+ (gen->phase < 0.0))
+ {
+ gen->phase = fmod(gen->phase, gen->table_size);
+ if (gen->phase < 0.0)
+ gen->phase += gen->table_size;
+ }
+ return(gen->yn1);
+}
+
+
+static mus_float_t table_look_any(mus_any *ptr, mus_float_t fm)
+{
tbl *gen = (tbl *)ptr;
+
gen->yn1 = mus_interpolate(gen->type, gen->phase, gen->table, gen->table_size, gen->yn1);
gen->phase += (gen->freq + (fm * gen->internal_mag));
if ((gen->phase >= gen->table_size) ||
(gen->phase < 0.0))
{
- gen->phase = fmod(gen->phase, (double)(gen->table_size));
+ gen->phase = fmod(gen->phase, gen->table_size);
if (gen->phase < 0.0)
gen->phase += gen->table_size;
}
@@ -2253,13 +2892,46 @@ mus_float_t mus_table_lookup(mus_any *ptr, mus_float_t fm)
mus_float_t mus_table_lookup_unmodulated(mus_any *ptr)
{
+ return(((tbl *)ptr)->tbl_look_unmod(ptr));
+}
+
+static mus_float_t table_look_unmodulated_linear(mus_any *ptr)
+{
+ tbl *gen = (tbl *)ptr;
+ mus_long_t int_part;
+ mus_float_t frac_part, f1;
+
+ int_part = (mus_long_t)(gen->phase);
+ frac_part = gen->phase - int_part;
+ f1 = gen->table[int_part];
+ int_part++;
+
+ if (int_part == gen->table_size)
+ f1 += frac_part * (gen->table[0] - f1);
+ else f1 += frac_part * (gen->table[int_part] - f1);
+
+ gen->phase += gen->freq;
+ if ((gen->phase >= gen->table_size) ||
+ (gen->phase < 0.0))
+ {
+ gen->phase = fmod(gen->phase, gen->table_size);
+ if (gen->phase < 0.0)
+ gen->phase += gen->table_size;
+ }
+ return(f1);
+}
+
+
+static mus_float_t table_look_unmodulated_any(mus_any *ptr)
+{
tbl *gen = (tbl *)ptr;
+
gen->yn1 = mus_interpolate(gen->type, gen->phase, gen->table, gen->table_size, gen->yn1);
gen->phase += gen->freq;
if ((gen->phase >= gen->table_size) ||
(gen->phase < 0.0))
{
- gen->phase = fmod(gen->phase, (double)(gen->table_size));
+ gen->phase = fmod(gen->phase, gen->table_size);
if (gen->phase < 0.0)
gen->phase += gen->table_size;
}
@@ -2267,9 +2939,9 @@ mus_float_t mus_table_lookup_unmodulated(mus_any *ptr)
}
-static mus_float_t run_table_lookup(mus_any *ptr, mus_float_t fm, mus_float_t unused) {return(mus_table_lookup(ptr, fm));}
+static mus_float_t run_table_lookup(mus_any *ptr, mus_float_t fm, mus_float_t unused) {return(((tbl *)ptr)->tbl_look(ptr, fm)); }
-bool mus_table_lookup_p(mus_any *ptr)
+bool mus_is_table_lookup(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_TABLE_LOOKUP));
@@ -2278,7 +2950,7 @@ bool mus_table_lookup_p(mus_any *ptr)
static mus_long_t table_lookup_length(mus_any *ptr) {return(((tbl *)ptr)->table_size);}
static mus_float_t *table_lookup_data(mus_any *ptr) {return(((tbl *)ptr)->table);}
-static mus_float_t table_lookup_freq(mus_any *ptr) {return((((tbl *)ptr)->freq * sampling_rate) / (mus_float_t)(((tbl *)ptr)->table_size));}
+static mus_float_t table_lookup_freq(mus_any *ptr) {return((((tbl *)ptr)->freq * sampling_rate) / (((tbl *)ptr)->table_size));}
static mus_float_t table_lookup_set_freq(mus_any *ptr, mus_float_t val) {((tbl *)ptr)->freq = (val * ((tbl *)ptr)->table_size) / sampling_rate; return(val);}
static mus_float_t table_lookup_increment(mus_any *ptr) {return(((tbl *)ptr)->freq);}
@@ -2295,8 +2967,8 @@ static void table_lookup_reset(mus_any *ptr) {((tbl *)ptr)->phase = 0.0;}
static char *describe_table_lookup(mus_any *ptr)
{
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, length: %d, interp: %s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, length: %d, interp: %s",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
@@ -2322,22 +2994,34 @@ static bool table_lookup_equalp(mus_any *p1, mus_any *p2)
}
-static int free_table_lookup(mus_any *ptr)
+static void free_table_lookup(mus_any *ptr)
{
tbl *gen = (tbl *)ptr;
- if (gen)
- {
- if ((gen->table) && (gen->table_allocated)) clm_free(gen->table);
- clm_free(gen);
- }
- return(0);
+ if ((gen->table) && (gen->table_allocated)) free(gen->table);
+ free(gen);
}
+static mus_any *tbl_copy(mus_any *ptr)
+{
+ mus_long_t bytes;
+ tbl *g, *p;
+
+ p = (tbl *)ptr;
+ g = (tbl *)malloc(sizeof(tbl));
+ memcpy((void *)g, (void *)ptr, sizeof(tbl));
+
+ bytes = g->table_size * sizeof(mus_float_t);
+ g->table = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->table), (void *)(p->table), bytes);
+ g->table_allocated = true;
+
+ return((mus_any *)g);
+}
static mus_float_t *table_set_data(mus_any *ptr, mus_float_t *val)
{
tbl *gen = (tbl *)ptr;
- if (gen->table_allocated) {clm_free(gen->table); gen->table_allocated = false;}
+ if (gen->table_allocated) {free(gen->table); gen->table_allocated = false;}
gen->table = val;
return(val);
}
@@ -2366,22 +3050,32 @@ static mus_any_class TABLE_LOOKUP_CLASS = {
&table_lookup_interp_type,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&table_lookup_reset,
- 0, 0, 0
+ 0, &tbl_copy
};
mus_any *mus_make_table_lookup(mus_float_t freq, mus_float_t phase, mus_float_t *table, mus_long_t table_size, mus_interp_t type)
{
tbl *gen;
- gen = (tbl *)clm_calloc(1, sizeof(tbl), S_make_table_lookup);
+ gen = (tbl *)malloc(sizeof(tbl));
gen->core = &TABLE_LOOKUP_CLASS;
gen->table_size = table_size;
- gen->internal_mag = (mus_float_t)table_size / TWO_PI;
+ gen->internal_mag = table_size / TWO_PI;
gen->freq = (freq * table_size) / sampling_rate;
gen->phase = (fmod(phase, TWO_PI) * table_size) / TWO_PI;
gen->type = type;
+ if (type == MUS_INTERP_LINEAR)
+ {
+ gen->tbl_look = table_look_linear;
+ gen->tbl_look_unmod = table_look_unmodulated_linear;
+ }
+ else
+ {
+ gen->tbl_look = table_look_any;
+ gen->tbl_look_unmod = table_look_unmodulated_any;
+ }
gen->yn1 = 0.0;
if (table)
{
@@ -2390,7 +3084,7 @@ mus_any *mus_make_table_lookup(mus_float_t freq, mus_float_t phase, mus_float_t
}
else
{
- gen->table = (mus_float_t *)clm_calloc_atomic(table_size, sizeof(mus_float_t), "table lookup table");
+ gen->table = (mus_float_t *)calloc(table_size, sizeof(mus_float_t));
gen->table_allocated = true;
}
return((mus_any *)gen);
@@ -2405,12 +3099,12 @@ mus_float_t *mus_partials_to_polynomial(int npartials, mus_float_t *partials, mu
/* coeffs returned in partials */
int i;
mus_long_t *T0, *T1, *Tn;
- double *Cc1;
+ mus_float_t *Cc1;
- T0 = (mus_long_t *)clm_calloc_atomic(npartials + 1, sizeof(mus_long_t), "partials_to_polynomial t0");
- T1 = (mus_long_t *)clm_calloc_atomic(npartials + 1, sizeof(mus_long_t), "partials_to_polynomial t1");
- Tn = (mus_long_t *)clm_calloc_atomic(npartials + 1, sizeof(mus_long_t), "partials_to_polynomial tn");
- Cc1 = (double *)clm_calloc_atomic(npartials + 1, sizeof(double), "partials_to_polynomial cc1");
+ T0 = (mus_long_t *)calloc(npartials + 1, sizeof(mus_long_t));
+ T1 = (mus_long_t *)calloc(npartials + 1, sizeof(mus_long_t));
+ Tn = (mus_long_t *)calloc(npartials + 1, sizeof(mus_long_t));
+ Cc1 = (mus_float_t *)calloc(npartials + 1, sizeof(mus_float_t));
if (kind == MUS_CHEBYSHEV_FIRST_KIND)
T0[0] = 1;
@@ -2422,7 +3116,7 @@ mus_float_t *mus_partials_to_polynomial(int npartials, mus_float_t *partials, mu
for (i = 1; i < npartials; i++)
{
int k;
- double amp;
+ mus_float_t amp;
amp = partials[i];
if (amp != 0.0)
{
@@ -2446,10 +3140,10 @@ mus_float_t *mus_partials_to_polynomial(int npartials, mus_float_t *partials, mu
for (i = 0; i < npartials; i++)
partials[i] = Cc1[i];
- clm_free(T0);
- clm_free(T1);
- clm_free(Tn);
- clm_free(Cc1);
+ free(T0);
+ free(T1);
+ free(Tn);
+ free(Cc1);
return(partials);
}
@@ -2457,7 +3151,7 @@ mus_float_t *mus_partials_to_polynomial(int npartials, mus_float_t *partials, mu
mus_float_t *mus_normalize_partials(int num_partials, mus_float_t *partials)
{
int i;
- double sum = 0.0;
+ mus_float_t sum = 0.0;
for (i = 0; i < num_partials; i++)
sum += fabs(partials[2 * i + 1]);
if ((sum != 0.0) &&
@@ -2471,24 +3165,32 @@ mus_float_t *mus_normalize_partials(int num_partials, mus_float_t *partials)
}
-
typedef struct {
mus_any_class *core;
- double phase, freq;
- mus_float_t *coeffs;
+ mus_float_t phase, freq;
+ mus_float_t *coeffs, *ucoeffs;
int n, cheby_choice;
mus_float_t index;
+ mus_float_t (*polyw)(mus_any *ptr, mus_float_t fm);
} pw;
-static int free_pw(mus_any *pt)
+mus_float_t (*mus_polywave_function(mus_any *g))(mus_any *gen, mus_float_t fm)
{
- pw *ptr = (pw *)pt;
- if (ptr)
- clm_free(ptr);
- return(0);
+ if (mus_is_polywave(g))
+ return(((pw *)g)->polyw);
+ return(NULL);
}
+static void free_pw(mus_any *pt) {free(pt);}
+
+static mus_any *pw_copy(mus_any *ptr)
+{
+ pw *g;
+ g = (pw *)malloc(sizeof(pw));
+ memcpy((void *)g, (void *)ptr, sizeof(pw));
+ return((mus_any *)g);
+}
static void pw_reset(mus_any *ptr)
{
@@ -2526,8 +3228,15 @@ static mus_long_t pw_n(mus_any *ptr) {return(((pw *)ptr)->n);}
static mus_long_t pw_set_n(mus_any *ptr, mus_long_t val) {((pw *)ptr)->n = (int)val; return(val);}
static mus_float_t *pw_data(mus_any *ptr) {return(((pw *)ptr)->coeffs);}
+static mus_float_t *pw_udata(mus_any *ptr) {return(((pw *)ptr)->ucoeffs);}
static mus_float_t *pw_set_data(mus_any *ptr, mus_float_t *val) {((pw *)ptr)->coeffs = val; return(val);}
+static mus_float_t pw_xcoeff(mus_any *ptr, int index) {return(((pw *)ptr)->coeffs[index]);}
+static mus_float_t pw_set_xcoeff(mus_any *ptr, int index, mus_float_t val) {((pw *)ptr)->coeffs[index] = val; return(val);}
+
+static mus_float_t pw_ycoeff(mus_any *ptr, int index) {if (((pw *)ptr)->ucoeffs) return(((pw *)ptr)->ucoeffs[index]); return(0.0);}
+static mus_float_t pw_set_ycoeff(mus_any *ptr, int index, mus_float_t val) {if (((pw *)ptr)->ucoeffs) ((pw *)ptr)->ucoeffs[index] = val; return(val);}
+
static mus_float_t pw_index(mus_any *ptr) {return(((pw *)ptr)->index);}
static mus_float_t pw_set_index(mus_any *ptr, mus_float_t val) {((pw *)ptr)->index = val; return(val);}
@@ -2536,8 +3245,8 @@ static int pw_choice(mus_any *ptr) {return(((pw *)ptr)->cheby_choice);}
mus_float_t mus_chebyshev_tu_sum(mus_float_t x, int n, mus_float_t *tn, mus_float_t *un)
{
- /* the Clenshaw algorithm */
- double x2, tb, tb1 = 0.0, tb2, cx, ub, ub1 = 0.0, ub2;
+ /* the Clenshaw algorithm -- beware of -cos(nx) where you'd expect cos(nx) */
+ mus_float_t x2, tb, tb1 = 0.0, tb2, cx, ub, ub1 = 0.0;
mus_float_t *tp, *up;
cx = cos(x);
@@ -2550,6 +3259,7 @@ mus_float_t mus_chebyshev_tu_sum(mus_float_t x, int n, mus_float_t *tn, mus_floa
while (up != un)
{
+ mus_float_t ub2;
tb2 = tb1;
tb1 = tb;
tb = x2 * tb1 - tb2 + (*tp--);
@@ -2570,7 +3280,7 @@ mus_float_t mus_chebyshev_tu_sum(mus_float_t x, int n, mus_float_t *tn, mus_floa
mus_float_t mus_chebyshev_t_sum(mus_float_t x, int n, mus_float_t *tn)
{
int i;
- double x2, b, b1 = 0.0, b2 = 0.0, cx;
+ mus_float_t x2, b, b1 = 0.0, cx;
cx = cos(x);
x2 = 2.0 * cx;
@@ -2579,6 +3289,7 @@ mus_float_t mus_chebyshev_t_sum(mus_float_t x, int n, mus_float_t *tn)
b = tn[n - 1];
for (i = n - 2; i >= 0; i--)
{
+ mus_float_t b2;
b2 = b1;
b1 = b;
b = x2 * b1 - b2 + tn[i];
@@ -2616,7 +3327,7 @@ mus_float_t mus_chebyshev_t_sum(mus_float_t x, int n, mus_float_t *tn)
mus_float_t mus_chebyshev_u_sum(mus_float_t x, int n, mus_float_t *un)
{
int i;
- double x2, b, b1 = 0.0, b2 = 0.0, cx;
+ mus_float_t x2, b, b1 = 0.0, cx;
cx = cos(x);
x2 = 2.0 * cx;
@@ -2625,6 +3336,7 @@ mus_float_t mus_chebyshev_u_sum(mus_float_t x, int n, mus_float_t *un)
b = un[n - 1];
for (i = n - 2; i > 0; i--)
{
+ mus_float_t b2;
b2 = b1;
b1 = b;
b = x2 * b1 - b2 + un[i];
@@ -2637,14 +3349,32 @@ mus_float_t mus_chebyshev_u_sum(mus_float_t x, int n, mus_float_t *un)
static mus_float_t mus_chebyshev_t_sum_with_index(mus_float_t x, mus_float_t index, int n, mus_float_t *tn)
{
int i;
- double x2, b, b1 = 0.0, b2 = 0.0, cx;
-
+ mus_float_t x2, b, b1 = 0.0, b2, cx;
cx = index * cos(x);
x2 = 2.0 * cx;
/* Tn calc */
b = tn[n - 1];
- for (i = n - 2; i >= 0; i--)
+ i = n - 2;
+ while (i >= 4)
+ {
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+ }
+ for (; i >= 0; i--)
{
b2 = b1;
b1 = b;
@@ -2654,58 +3384,393 @@ static mus_float_t mus_chebyshev_t_sum_with_index(mus_float_t x, mus_float_t ind
}
-static mus_float_t mus_chebyshev_u_sum_with_index(mus_float_t x, mus_float_t index, int n, mus_float_t *un)
+static mus_float_t mus_chebyshev_t_sum_with_index_2(mus_float_t x, mus_float_t index, int n, mus_float_t *tn)
{
int i;
- double x2, b, b1 = 0.0, b2 = 0.0, cx;
+ mus_float_t x2, b, b1 = 0.0, cx;
cx = index * cos(x);
x2 = 2.0 * cx;
- /* Un calc */
- b = un[n - 1];
- for (i = n - 2; i > 0; i--)
+ /* Tn calc */
+ b = tn[n - 1];
+ for (i = n - 2; i > 0;)
{
+ mus_float_t b2;
b2 = b1;
b1 = b;
- b = x2 * b1 - b2 + un[i];
- }
+ b = x2 * b1 - b2 + tn[i--];
- return((mus_float_t)(sin(x) * b));
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+ }
+ return((mus_float_t)(b - b1 * cx));
}
-static mus_float_t poly_TU(mus_any *ptr, mus_float_t fm)
+static mus_float_t mus_chebyshev_t_sum_with_index_3(mus_float_t x, mus_float_t index, int n, mus_float_t *tn)
{
- /* changed to use recursion, rather than polynomial in x, 25-May-08
- * this algorithm taken from Mason and Handscomb, "Chebyshev Polynomials" p27
- */
-
- pw *gen = (pw *)ptr;
- mus_float_t result;
+ int i;
+ mus_float_t x2, b, b1 = 0.0, cx;
- if (gen->cheby_choice != MUS_CHEBYSHEV_SECOND_KIND)
- result = mus_chebyshev_t_sum_with_index(gen->phase, gen->index, gen->n, gen->coeffs);
- else result = mus_chebyshev_u_sum_with_index(gen->phase, gen->index, gen->n, gen->coeffs);
+ cx = index * cos(x);
+ x2 = 2.0 * cx;
+
+ /* Tn calc */
+ b = tn[n - 1];
+ for (i = n - 2; i > 0;)
+ {
+ mus_float_t b2;
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+ }
+ return((mus_float_t)(b - b1 * cx));
+}
+
+
+static mus_float_t mus_chebyshev_t_sum_with_index_5(mus_float_t x, mus_float_t index, int n, mus_float_t *tn)
+{
+ int i;
+ mus_float_t x2, b, b1 = 0.0, cx;
+
+ cx = index * cos(x);
+ x2 = 2.0 * cx;
+
+ /* Tn calc */
+ b = tn[n - 1];
+ for (i = n - 2; i > 0;) /* this was >= ?? (also cases above) -- presumably a copy-and-paste typo? */
+ {
+ mus_float_t b2;
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + tn[i--];
+ }
+ return((mus_float_t)(b - b1 * cx));
+}
+
+
+static mus_float_t mus_chebyshev_u_sum_with_index(mus_float_t x, mus_float_t index, int n, mus_float_t *un)
+{
+ int i;
+ mus_float_t x2, b, b1 = 0.0, cx;
+
+ cx = index * cos(x);
+ x2 = 2.0 * cx;
+
+ /* Un calc */
+ b = un[n - 1];
+ for (i = n - 2; i > 0; i--)
+ {
+ mus_float_t b2;
+ b2 = b1;
+ b1 = b;
+ b = x2 * b1 - b2 + un[i];
+ }
+
+ return((mus_float_t)(sin(x) * b + un[0])); /* don't drop the constant, 16-Jan-14 */
+}
+/* (with-sound () (let ((p (make-polywave 100 (list 0 0.5 1 -.2) mus-chebyshev-second-kind))) (do ((i 0 (+ i 1))) ((= i 1000)) (outa i (polywave p)))))
+ */
+
+static mus_float_t polyw_second_2(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t x;
+
+ x = gen->phase; /* this order (as opposed to saving the full expr below) is much faster?! */
gen->phase += (gen->freq + fm);
- return(result);
+ return(gen->coeffs[1] * sin(x) + gen->coeffs[0]);
+}
+
+
+static mus_float_t polyw_first_1(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t x;
+
+ x = gen->phase;
+ gen->phase += (gen->freq + fm);
+ return(gen->index * cos(x));
+}
+
+
+static mus_float_t polyw_first_3(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t x, cx;
+ mus_float_t *tn;
+
+ x = gen->phase;
+ tn = gen->coeffs;
+ gen->phase += (gen->freq + fm);
+
+ cx = cos(x);
+ return((2.0 * cx * tn[2] + tn[1]) * cx - tn[2]);
+
+ /* b = x2 * b1 - b2;, then return(b - b1 * cx)
+ * but x2 = 2 * cx, so b1*(x2 - cx) -> b1 * cx
+ * and the final recursion unrolls. The old code
+ * (which thought tn[0] might not be 0.0) was:
+ * cx = cos(x);
+ * x2 = 2.0 * cx;
+ * b = tn[2];
+ * b2 = b1; -- but b1 is 0
+ * b1 = b; -- b not used so this is tn[2]
+ * b = x2 * b1 - b2 + tn[1]; -- b2 is 0.0
+ * b2 = b1;
+ * b1 = b;
+ * b = x2 * b1 - b2 + tn[0];
+ * return(b - b1 * cx);
+ */
+}
+
+/* (with-sound () (let ((p (make-polywave 100 (list 1 .5 2 .25)))) (do ((i 0 (+ i 1))) ((= i 30000)) (outa i (polywave p))))) */
+
+
+static mus_float_t polyw_first_4(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t x, x2, b, cx;
+ mus_float_t *tn;
+
+ x = gen->phase;
+ tn = gen->coeffs;
+ gen->phase += (gen->freq + fm);
+
+ cx = cos(x);
+ x2 = 2.0 * cx;
+ b = x2 * tn[3] + tn[2]; /* was -tn[2]! 19-Feb-14 */
+ return((x2 * b - tn[3] + tn[1]) * cx - b);
+}
+
+
+static mus_float_t polyw_first_5(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t x;
+ mus_float_t *tn;
+ mus_float_t x2, b, b1, b2, cx;
+
+ x = gen->phase;
+ tn = gen->coeffs;
+ gen->phase += (gen->freq + fm);
+
+ cx = cos(x);
+ x2 = 2.0 * cx;
+ b1 = tn[4];
+ b = x2 * b1 + tn[3];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[2];
+
+ return((x2 * b - b1 + tn[1]) * cx - b);
+}
+
+
+static mus_float_t polyw_first_6(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t x;
+ mus_float_t *tn;
+ mus_float_t x2, b, b1, b2, cx;
+
+ x = gen->phase;
+ tn = gen->coeffs;
+ gen->phase += (gen->freq + fm);
+
+ cx = cos(x);
+ x2 = 2.0 * cx;
+ b1 = tn[5];
+ b = x2 * b1 + tn[4];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[3];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[2];
+
+ return((x2 * b - b1 + tn[1]) * cx - b);
+}
+
+
+static mus_float_t polyw_first_8(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t x;
+ mus_float_t *tn;
+ mus_float_t x2, b, b1, b2, cx;
+
+ x = gen->phase;
+ tn = gen->coeffs;
+ gen->phase += (gen->freq + fm);
+
+ cx = cos(x);
+ x2 = 2.0 * cx;
+ b1 = tn[7];
+ b = x2 * b1 + tn[6];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[5];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[4];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[3];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[2];
+
+ return((x2 * b - b1 + tn[1]) * cx - b);
+}
+
+
+static mus_float_t polyw_first_11(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t x;
+ mus_float_t *tn;
+ mus_float_t x2, b, b1, b2, cx;
+
+ x = gen->phase;
+ tn = gen->coeffs;
+ gen->phase += (gen->freq + fm);
+
+ cx = cos(x);
+ x2 = 2.0 * cx;
+ b1 = tn[10];
+ b = x2 * b1 + tn[9];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[8];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[7];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[6];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[5];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[4];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[3];
+ b2 = b1; b1 = b; b = x2 * b1 - b2 + tn[2];
+
+ return((x2 * b - b1 + tn[1]) * cx - b);
+}
+
+
+static mus_float_t polyw_first(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t ph;
+ ph = gen->phase;
+ gen->phase += (gen->freq + fm);
+ return(mus_chebyshev_t_sum_with_index(ph, gen->index, gen->n, gen->coeffs));
+}
+
+
+static mus_float_t polyw_f1(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t cx;
+ cx = gen->index * cos(gen->phase);
+ gen->phase += (gen->freq + fm);
+ return(cx * gen->coeffs[1] + gen->coeffs[0]);
+}
+
+
+static mus_float_t polyw_f2(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t ph;
+ ph = gen->phase;
+ gen->phase += (gen->freq + fm);
+ return(mus_chebyshev_t_sum_with_index_2(ph, gen->index, gen->n, gen->coeffs));
+}
+
+
+static mus_float_t polyw_f3(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t ph;
+ ph = gen->phase;
+ gen->phase += (gen->freq + fm);
+ return(mus_chebyshev_t_sum_with_index_3(ph, gen->index, gen->n, gen->coeffs));
+}
+
+
+static mus_float_t polyw_f5(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t ph;
+ ph = gen->phase;
+ gen->phase += (gen->freq + fm);
+ return(mus_chebyshev_t_sum_with_index_5(ph, gen->index, gen->n, gen->coeffs));
+}
+
+
+static mus_float_t polyw_second(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t ph;
+ ph = gen->phase;
+ gen->phase += (gen->freq + fm);
+ return(mus_chebyshev_u_sum_with_index(ph, gen->index, gen->n, gen->coeffs));
+}
+
+
+static mus_float_t polyw_second_5(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t *un;
+ mus_float_t x, b, b1, cx;
+
+ x = gen->phase;
+ gen->phase += (gen->freq + fm);
+ /* gen->n is 5 */
+ un = gen->coeffs;
+
+ /* this is a candidate for sincos, but gcc is already using it here! */
+ cx = 2.0 * cos(x);
+ b1 = cx * un[4] + un[3];
+ b = cx * b1 + gen->index;
+
+ return(sin(x) * (cx * b - b1 + un[1]));
+}
+
+
+static mus_float_t polyw_third(mus_any *ptr, mus_float_t fm)
+{
+ pw *gen = (pw *)ptr;
+ mus_float_t ph;
+ ph = gen->phase;
+ gen->phase += (gen->freq + fm);
+ return(mus_chebyshev_tu_sum(ph, gen->n, gen->coeffs, gen->ucoeffs));
}
mus_float_t mus_polywave(mus_any *ptr, mus_float_t fm)
{
- return(poly_TU(ptr, fm));
+ /* changed to use recursion, rather than polynomial in x, 25-May-08
+ * this algorithm taken from Mason and Handscomb, "Chebyshev Polynomials" p27
+ */
+ return((((pw *)ptr)->polyw)(ptr, fm));
}
-
+
mus_float_t mus_polywave_unmodulated(mus_any *ptr)
{
- return(poly_TU(ptr, 0.0));
+ return(mus_polywave(ptr, 0.0));
}
-static mus_float_t run_polywave(mus_any *ptr, mus_float_t fm, mus_float_t ignored) {return(poly_TU(ptr, fm));}
+static mus_float_t run_polywave(mus_any *ptr, mus_float_t fm, mus_float_t ignored) {return(mus_polywave(ptr, fm));}
static char *describe_polywave(mus_any *ptr)
@@ -2714,18 +3779,29 @@ static char *describe_polywave(mus_any *ptr)
char *str;
char *describe_buffer;
str = float_array_to_string(gen->coeffs, gen->n, 0);
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, coeffs[%d]: %s",
- mus_name(ptr),
- mus_frequency(ptr),
- mus_phase(ptr),
- gen->n,
- str);
- if (str) clm_free(str);
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, coeffs[%d]: %s",
+ mus_name(ptr),
+ mus_frequency(ptr),
+ mus_phase(ptr),
+ gen->n,
+ str);
+ free(str);
return(describe_buffer);
}
+static mus_float_t pw_set_index_and_func(mus_any *ptr, mus_float_t val)
+{
+ pw *gen = (pw *)ptr;
+ gen->index = val;
+ if (gen->cheby_choice == MUS_CHEBYSHEV_FIRST_KIND)
+ gen->polyw = polyw_first;
+ else gen->polyw = polyw_second;
+ return(val);
+}
+
+
static mus_any_class POLYWAVE_CLASS = {
MUS_POLYWAVE,
(char *)S_polywave,
@@ -2741,37 +3817,153 @@ static mus_any_class POLYWAVE_CLASS = {
&pw_phase,
&pw_set_phase,
&pw_index,
- &pw_set_index,
+ &pw_set_index_and_func,
&pw_increment,
&pw_set_increment,
&run_polywave,
MUS_NOT_SPECIAL,
NULL, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &pw_xcoeff, &pw_set_xcoeff,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0,
&pw_choice,
- 0, 0, 0, 0, 0,
+ &pw_ycoeff, &pw_set_ycoeff,
+ &pw_data, &pw_udata,
&pw_reset,
- 0, 0, 0
+ 0, &pw_copy
};
mus_any *mus_make_polywave(mus_float_t frequency, mus_float_t *coeffs, int n, int cheby_choice)
{
pw *gen;
- gen = (pw *)clm_calloc(1, sizeof(pw), S_make_polywave);
+ gen = (pw *)malloc(sizeof(pw));
gen->core = &POLYWAVE_CLASS;
gen->phase = 0.0; /* cos used in cheby funcs above */
gen->freq = mus_hz_to_radians(frequency);
gen->coeffs = coeffs;
+ gen->ucoeffs = NULL;
gen->n = n;
gen->index = 1.0;
gen->cheby_choice = cheby_choice;
+ if (cheby_choice != MUS_CHEBYSHEV_SECOND_KIND)
+ {
+ if (coeffs[0] == 0.0)
+ {
+ /* these also ignore gen->index (assumed to be 1.0) (leaving aside the first_1 case)
+ * pw_set_index_and_func protects against that case
+ */
+ if (n == 2)
+ {
+ gen->polyw = polyw_first_1;
+ gen->index = coeffs[1];
+ }
+ else
+ {
+ if (n == 3)
+ gen->polyw = polyw_first_3;
+ else
+ {
+ if (n == 4)
+ gen->polyw = polyw_first_4;
+ else
+ {
+ if (n == 5)
+ gen->polyw = polyw_first_5;
+ else
+ {
+ if (n == 6)
+ gen->polyw = polyw_first_6;
+ else
+ {
+ if (n == 8)
+ gen->polyw = polyw_first_8;
+ else
+ {
+ if (n == 11) /* a common case oddly enough */
+ gen->polyw = polyw_first_11;
+ else
+ {
+ if (((n - 1) % 5) == 0)
+ gen->polyw = polyw_f5;
+ else
+ {
+ if (((n - 1) % 3) == 0)
+ gen->polyw = polyw_f3;
+ else
+ {
+ if (((n - 1) % 2) == 0)
+ gen->polyw = polyw_f2;
+ else
+ {
+ /* lots of n=8 here */
+ gen->polyw = polyw_first;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ if (n == 2)
+ gen->polyw = polyw_f1;
+ else
+ {
+ if (((n - 1) % 3) == 0)
+ gen->polyw = polyw_f3;
+ else
+ {
+ if (((n - 1) % 2) == 0)
+ gen->polyw = polyw_f2;
+ else gen->polyw = polyw_first;
+ }
+ }
+ }
+ }
+ else
+ {
+ if ((n == 5) &&
+ (coeffs[0] == 0.0))
+ {
+ gen->polyw = polyw_second_5;
+ gen->index = coeffs[2] - coeffs[4];
+ }
+ else
+ {
+ if (n == 2)
+ gen->polyw = polyw_second_2;
+ else gen->polyw = polyw_second;
+ }
+ }
return((mus_any *)gen);
}
-bool mus_polywave_p(mus_any *ptr)
+mus_any *mus_make_polywave_tu(mus_float_t frequency, mus_float_t *tcoeffs, mus_float_t *ucoeffs, int n)
+{
+ pw *gen;
+ gen = (pw *)malloc(sizeof(pw));
+ gen->core = &POLYWAVE_CLASS;
+ gen->phase = 0.0; /* cos used in cheby funcs above */
+ gen->freq = mus_hz_to_radians(frequency);
+ gen->coeffs = tcoeffs;
+ gen->ucoeffs = ucoeffs;
+ gen->n = n;
+ gen->index = 1.0;
+ gen->cheby_choice = MUS_CHEBYSHEV_BOTH_KINDS;
+ gen->polyw = polyw_third;
+ return((mus_any *)gen);
+}
+
+
+bool mus_is_polywave(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_POLYWAVE));
@@ -2786,15 +3978,15 @@ static char *describe_polyshape(mus_any *ptr)
pw *gen = (pw *)ptr;
char *str;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
str = float_array_to_string(gen->coeffs, gen->n, 0);
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, coeffs[%d]: %s",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, coeffs[%d]: %s",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
gen->n,
str);
- clm_free(str);
+ free(str);
return(describe_buffer);
}
@@ -2855,9 +4047,9 @@ static mus_any_class POLYSHAPE_CLASS = {
NULL, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&pw_reset,
- 0, 0, 0
+ 0, &pw_copy
};
@@ -2871,7 +4063,7 @@ mus_any *mus_make_polyshape(mus_float_t frequency, mus_float_t phase, mus_float_
}
-bool mus_polyshape_p(mus_any *ptr)
+bool mus_is_polyshape(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_POLYSHAPE));
@@ -2885,7 +4077,7 @@ bool mus_polyshape_p(mus_any *ptr)
typedef struct {
mus_any_class *core;
- double freq, phase;
+ mus_float_t freq, phase;
mus_float_t *wave; /* passed in from caller */
mus_long_t wave_size;
mus_float_t *out_data;
@@ -2912,6 +4104,19 @@ static int wt_interp_type(mus_any *ptr) {return((int)(((wt *)ptr)->interp_type))
static mus_float_t *wt_data(mus_any *ptr) {return(((wt *)ptr)->wave);}
static mus_float_t *wt_set_data(mus_any *ptr, mus_float_t *data) {((wt *)ptr)->wave = data; return(data);}
+static mus_any *wt_copy(mus_any *ptr)
+{
+ wt *g, *p;
+ int bytes;
+ p = (wt *)ptr;
+ g = (wt *)malloc(sizeof(wt));
+ memcpy((void *)g, (void *)ptr, sizeof(wt));
+ bytes = g->out_data_size * sizeof(mus_float_t);
+ g->out_data = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->out_data), (void *)(p->out_data), bytes);
+ /* g->wave is caller's data */
+ return((mus_any *)g);
+}
static bool wt_equalp(mus_any *p1, mus_any *p2)
{
@@ -2930,12 +4135,11 @@ static bool wt_equalp(mus_any *p1, mus_any *p2)
(clm_arrays_are_equal(w1->out_data, w2->out_data, w1->out_data_size)));
}
-
static char *describe_wt(mus_any *ptr)
{
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, size: " MUS_LD ", interp: %s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, size: %lld, interp: %s",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
@@ -2949,32 +4153,81 @@ static mus_float_t mus_wave_train_any(mus_any *ptr, mus_float_t fm)
{
wt *gen = (wt *)ptr;
mus_float_t result = 0.0;
+
if (gen->out_pos < gen->out_data_size)
result = gen->out_data[gen->out_pos];
gen->out_pos++;
if (gen->out_pos >= gen->next_wave_time)
{
mus_long_t i;
+ mus_float_t *wave, *out_data;
+ mus_long_t wave_size;
+
+ wave = gen->wave;
+ wave_size = gen->wave_size;
+ out_data = gen->out_data;
+
if (gen->out_pos < gen->out_data_size)
{
mus_long_t good_samps;
good_samps = gen->out_data_size - gen->out_pos;
- memmove((void *)(gen->out_data), (void *)(gen->out_data + gen->out_pos), good_samps * sizeof(mus_float_t));
- memset((void *)(gen->out_data + good_samps), 0, gen->out_pos * sizeof(mus_float_t));
+ memmove((void *)out_data, (void *)(out_data + gen->out_pos), good_samps * sizeof(mus_float_t));
+ memset((void *)(out_data + good_samps), 0, gen->out_pos * sizeof(mus_float_t));
+ }
+ else memset((void *)out_data, 0, gen->out_data_size * sizeof(mus_float_t));
+ if (gen->interp_type == MUS_INTERP_LINEAR)
+ {
+ /* gen->phase doesn't change, and i is an int, so we can precalculate the fractional part, etc
+ */
+ mus_float_t phase, frac_part;
+ mus_long_t int_part;
+
+ phase = gen->phase;
+ if ((phase < 0.0) || (phase > wave_size))
+ {
+ phase = fmod((mus_float_t)phase, (mus_float_t)wave_size);
+ if (phase < 0.0) phase += wave_size;
+ }
+
+ int_part = (mus_long_t)floor(phase);
+ frac_part = phase - int_part;
+ if (int_part == wave_size) int_part = 0;
+
+ if (frac_part == 0.0)
+ {
+ mus_long_t p;
+ for (i = 0, p = int_part; i < wave_size; i++, p++)
+ {
+ if (p == wave_size) p = 0;
+ out_data[i] += wave[p];
+ }
+ }
+ else
+ {
+ mus_long_t p, p1;
+ for (i = 0, p = int_part, p1 = int_part + 1; i < wave_size; i++, p1++)
+ {
+ if (p1 == wave_size) p1 = 0;
+ out_data[i] += (wave[p] + frac_part * (wave[p1] - wave[p]));
+ p = p1;
+ }
+ }
}
- else mus_clear_array(gen->out_data, gen->out_data_size);
- for (i = 0; i < gen->wave_size; i++)
+ else
{
- gen->yn1 = mus_interpolate(gen->interp_type, gen->phase + i, gen->wave, gen->wave_size, gen->yn1);
- gen->out_data[i] += gen->yn1;
+ for (i = 0; i < wave_size; i++)
+ {
+ gen->yn1 = mus_interpolate(gen->interp_type, gen->phase + i, wave, wave_size, gen->yn1);
+ out_data[i] += gen->yn1;
+ }
}
if (gen->first_time)
{
gen->first_time = false;
gen->out_pos = (mus_long_t)(gen->phase); /* initial phase, but as an integer in terms of wave table size (gad...) */
- if (gen->out_pos >= gen->wave_size)
- gen->out_pos = gen->out_pos % gen->wave_size;
- result = gen->out_data[gen->out_pos++];
+ if (gen->out_pos >= wave_size)
+ gen->out_pos = gen->out_pos % wave_size;
+ result = out_data[gen->out_pos++];
gen->next_wave_time = ((mus_float_t)sampling_rate / (gen->freq + fm));
}
else
@@ -2991,23 +4244,17 @@ mus_float_t mus_wave_train(mus_any *ptr, mus_float_t fm) {return(mus_wave_train_
mus_float_t mus_wave_train_unmodulated(mus_any *ptr) {return(mus_wave_train(ptr, 0.0));}
-
static mus_float_t run_wave_train(mus_any *ptr, mus_float_t fm, mus_float_t unused) {return(mus_wave_train_any(ptr, fm / w_rate));}
-
-static int free_wt(mus_any *p)
+static void free_wt(mus_any *p)
{
wt *ptr = (wt *)p;
- if (ptr)
+ if (ptr->out_data)
{
- if (ptr->out_data)
- {
- clm_free(ptr->out_data);
- ptr->out_data = NULL;
- }
- clm_free(ptr);
+ free(ptr->out_data);
+ ptr->out_data = NULL;
}
- return(0);
+ free(ptr);
}
@@ -3015,7 +4262,7 @@ static void wt_reset(mus_any *ptr)
{
wt *gen = (wt *)ptr;
gen->phase = 0.0;
- mus_clear_array(gen->out_data, gen->out_data_size);
+ memset((void *)(gen->out_data), 0, gen->out_data_size * sizeof(mus_float_t));
gen->out_pos = gen->out_data_size;
gen->next_wave_time = 0.0;
gen->first_time = true;
@@ -3045,16 +4292,16 @@ static mus_any_class WAVE_TRAIN_CLASS = {
0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&wt_reset,
- 0, 0, 0
+ 0, &wt_copy
};
mus_any *mus_make_wave_train(mus_float_t freq, mus_float_t phase, mus_float_t *wave, mus_long_t wave_size, mus_interp_t type)
{
wt *gen;
- gen = (wt *)clm_calloc(1, sizeof(wt), S_make_wave_train);
+ gen = (wt *)malloc(sizeof(wt));
gen->core = &WAVE_TRAIN_CLASS;
gen->freq = freq;
gen->phase = (wave_size * fmod(phase, TWO_PI)) / TWO_PI;
@@ -3062,7 +4309,7 @@ mus_any *mus_make_wave_train(mus_float_t freq, mus_float_t phase, mus_float_t *w
gen->wave_size = wave_size;
gen->interp_type = type;
gen->out_data_size = wave_size + 2;
- gen->out_data = (mus_float_t *)clm_calloc_atomic(gen->out_data_size, sizeof(mus_float_t), "wave train out data");
+ gen->out_data = (mus_float_t *)calloc(gen->out_data_size, sizeof(mus_float_t));
gen->out_pos = gen->out_data_size;
gen->next_wave_time = 0.0;
gen->first_time = true;
@@ -3071,7 +4318,7 @@ mus_any *mus_make_wave_train(mus_float_t freq, mus_float_t phase, mus_float_t *w
}
-bool mus_wave_train_p(mus_any *ptr)
+bool mus_is_wave_train(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_WAVE_TRAIN));
@@ -3080,46 +4327,92 @@ bool mus_wave_train_p(mus_any *ptr)
-/* ---------------- delay, comb, notch, all-pass, moving-average ---------------- */
+/* ---------------- delay, comb, notch, all-pass, moving-average, filtered-comb ---------------- */
-typedef struct {
+typedef struct dly {
mus_any_class *core;
- int loc, size;
- bool zdly, line_allocated;
+ unsigned int loc, size;
+ bool zdly, line_allocated, filt_allocated;
mus_float_t *line;
- int zloc, zsize;
- mus_float_t xscl, yscl, yn1;
+ unsigned int zloc, zsize;
+ mus_float_t xscl, yscl, yn1, y1, norm;
mus_interp_t type;
mus_any *filt;
+ struct dly *next;
+ mus_float_t (*runf)(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
+ mus_float_t (*del)(mus_any *ptr, mus_float_t input); /* zdelay or normal tap */
+ mus_float_t (*delt)(mus_any *ptr, mus_float_t input); /* just tick */
+ mus_float_t (*delu)(mus_any *ptr, mus_float_t input); /* unmodulated */
} dly;
+
mus_float_t mus_delay_tick(mus_any *ptr, mus_float_t input)
{
+ return(((dly *)ptr)->delt(ptr, input));
+}
+
+
+mus_float_t mus_tap(mus_any *ptr, mus_float_t loc)
+{
+ return(((dly *)ptr)->del(ptr, loc));
+}
+
+
+mus_float_t mus_delay_unmodulated(mus_any *ptr, mus_float_t input)
+{
+ return(((dly *)ptr)->delu(ptr, input));
+}
+
+
+static mus_float_t ztap(mus_any *ptr, mus_float_t loc)
+{
+ dly *gen = (dly *)ptr;
+ /* this is almost always linear */
+ if (gen->type == MUS_INTERP_LINEAR)
+ return(mus_array_interp(gen->line, gen->zloc - loc, gen->zsize));
+ gen->yn1 = mus_interpolate(gen->type, gen->zloc - loc, gen->line, gen->zsize, gen->yn1);
+ return(gen->yn1);
+}
+
+
+static mus_float_t dtap(mus_any *ptr, mus_float_t loc)
+{
+ dly *gen = (dly *)ptr;
+ int taploc;
+ if (gen->size == 0) return(gen->line[0]);
+ if ((int)loc == 0) return(gen->line[gen->loc]);
+ taploc = (int)(gen->loc - (int)loc) % gen->size;
+ if (taploc < 0) taploc += gen->size;
+ return(gen->line[taploc]);
+}
+
+
+mus_float_t mus_tap_unmodulated(mus_any *ptr)
+{
+ dly *gen = (dly *)ptr;
+ return(gen->line[gen->loc]);
+}
+
+
+static mus_float_t zdelt(mus_any *ptr, mus_float_t input)
+{
dly *gen = (dly *)ptr;
gen->line[gen->loc] = input;
gen->loc++;
- if (gen->zdly)
- {
- if (gen->loc >= gen->zsize) gen->loc = 0;
- gen->zloc++;
- if (gen->zloc >= gen->zsize) gen->zloc = 0;
- }
- else
- {
- if (gen->loc >= gen->size) gen->loc = 0;
- }
+ if (gen->loc >= gen->zsize) gen->loc = 0;
+ gen->zloc++;
+ if (gen->zloc >= gen->zsize) gen->zloc = 0;
return(input);
}
-mus_float_t mus_delay_tick_noz(mus_any *ptr, mus_float_t input)
+static mus_float_t delt(mus_any *ptr, mus_float_t input)
{
dly *gen = (dly *)ptr;
gen->line[gen->loc] = input;
gen->loc++;
- if (gen->loc >= gen->size)
- gen->loc = 0;
+ if (gen->loc >= gen->size) gen->loc = 0;
return(input);
}
@@ -3129,28 +4422,29 @@ mus_float_t mus_delay(mus_any *ptr, mus_float_t input, mus_float_t pm)
mus_float_t result;
dly *gen = (dly *)ptr;
if ((gen->size == 0) && (pm < 1.0))
- return(pm * gen->line[0] + (1.0 - pm) * input);
- result = mus_tap(ptr, pm);
+ result = pm * gen->line[0] + (1.0 - pm) * input;
+ else result = mus_tap(ptr, pm);
mus_delay_tick(ptr, input);
return(result);
}
-mus_float_t mus_delay_unmodulated(mus_any *ptr, mus_float_t input)
+static mus_float_t zdelay_unmodulated(mus_any *ptr, mus_float_t input)
{
dly *gen = (dly *)ptr;
mus_float_t result;
- if (gen->zdly)
- {
- if (gen->size == 0) return(input); /* no point in tick in this case */
- result = gen->line[gen->zloc];
- }
- else result = gen->line[gen->loc];
+ result = gen->line[gen->zloc];
mus_delay_tick(ptr, input);
return(result);
}
+static mus_float_t delay_unmodulated_zero(mus_any *ptr, mus_float_t input)
+{
+ return(input);
+}
+
+
mus_float_t mus_delay_unmodulated_noz(mus_any *ptr, mus_float_t input)
{
dly *gen = (dly *)ptr;
@@ -3163,43 +4457,43 @@ mus_float_t mus_delay_unmodulated_noz(mus_any *ptr, mus_float_t input)
return(result);
}
+static dly *dly_free_list = NULL;
-mus_float_t mus_tap(mus_any *ptr, mus_float_t loc)
+static void free_delay(mus_any *gen)
{
- dly *gen = (dly *)ptr;
- int taploc;
- if (gen->zdly)
- {
- gen->yn1 = mus_interpolate(gen->type, gen->zloc - loc, gen->line, gen->zsize, gen->yn1);
- return(gen->yn1);
- }
- else
- {
- if (gen->size == 0) return(gen->line[0]);
- if ((int)loc == 0) return(gen->line[gen->loc]);
- taploc = (int)(gen->loc - (int)loc) % gen->size;
- if (taploc < 0) taploc += gen->size;
- return(gen->line[taploc]);
- }
+ dly *ptr = (dly *)gen;
+ if ((ptr->line) && (ptr->line_allocated)) free(ptr->line);
+ if ((ptr->filt) && (ptr->filt_allocated)) mus_free(ptr->filt);
+ /* free(ptr); */
+ ptr->next = dly_free_list;
+ dly_free_list = ptr;
}
-mus_float_t mus_tap_unmodulated(mus_any *ptr)
+static mus_any *dly_copy(mus_any *ptr)
{
- dly *gen = (dly *)ptr;
- return(gen->line[gen->loc]);
-}
+ dly *g, *p;
+ mus_long_t bytes;
+ p = (dly *)ptr;
+ if (dly_free_list)
+ {
+ g = dly_free_list;
+ dly_free_list = g->next;
+ }
+ else g = (dly *)malloc(sizeof(dly));
+ memcpy((void *)g, (void *)ptr, sizeof(dly));
+ bytes = g->size * sizeof(mus_float_t);
+ g->line = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->line), (void *)(p->line), bytes);
+ g->line_allocated = true;
-static int free_delay(mus_any *gen)
-{
- dly *ptr = (dly *)gen;
- if (ptr)
+ if (p->filt)
{
- if ((ptr->line) && (ptr->line_allocated)) clm_free(ptr->line);
- clm_free(ptr);
+ g->filt = mus_copy(p->filt);
+ g->filt_allocated = true;
}
- return(0);
+ return((mus_any *)g);
}
@@ -3208,20 +4502,20 @@ static char *describe_delay(mus_any *ptr)
char *str = NULL;
dly *gen = (dly *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
if (gen->zdly)
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s line[%d,%d, %s]: %s",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s line[%u,%u, %s]: %s",
mus_name(ptr),
gen->size,
gen->zsize,
interp_type_to_string(gen->type),
str = float_array_to_string(gen->line, gen->size, gen->zloc));
- else mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s line[%d, %s]: %s",
+ else snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s line[%u, %s]: %s",
mus_name(ptr),
gen->size,
interp_type_to_string(gen->type),
str = float_array_to_string(gen->line, gen->size, gen->loc));
- if (str) clm_free(str);
+ if (str) free(str);
return(describe_buffer);
}
@@ -3262,16 +4556,12 @@ static mus_float_t delay_fb(mus_any *ptr) {return(((dly *)ptr)->yscl);}
static mus_float_t delay_set_fb(mus_any *ptr, mus_float_t val) {((dly *)ptr)->yscl = val; return(val);}
static int delay_interp_type(mus_any *ptr) {return((int)(((dly *)ptr)->type));}
-static int delay_zdly(mus_any *ptr) {return((int)(((dly *)ptr)->zdly));}
-
static mus_long_t delay_loc(mus_any *ptr){return((mus_long_t)(((dly *)ptr)->loc));}
-
static mus_float_t *delay_data(mus_any *ptr) {return(((dly *)ptr)->line);}
-
static mus_float_t *delay_set_data(mus_any *ptr, mus_float_t *val)
{
dly *gen = (dly *)ptr;
- if (gen->line_allocated) {clm_free(gen->line); gen->line_allocated = false;}
+ if (gen->line_allocated) {free(gen->line); gen->line_allocated = false;}
gen->line = val;
return(val);
}
@@ -3282,9 +4572,9 @@ static mus_long_t delay_set_length(mus_any *ptr, mus_long_t val)
dly *gen = (dly *)ptr;
if (val > 0)
{
- int old_size;
+ unsigned int old_size;
old_size = gen->size;
- gen->size = (int)val;
+ gen->size = (unsigned int)val;
if (gen->size < old_size)
{
if (gen->loc > gen->size) gen->loc = 0;
@@ -3295,7 +4585,7 @@ static mus_long_t delay_set_length(mus_any *ptr, mus_long_t val)
}
-bool mus_delay_line_p(mus_any *gen)
+bool mus_is_tap(mus_any *gen)
{
return((gen) &&
(gen->core->extended_type == MUS_DELAY_LINE));
@@ -3308,7 +4598,7 @@ static void delay_reset(mus_any *ptr)
gen->loc = 0;
gen->zloc = 0;
gen->yn1 = 0.0;
- mus_clear_array(gen->line, gen->zsize);
+ memset((void *)(gen->line), 0, gen->zsize * sizeof(mus_float_t));
}
@@ -3335,23 +4625,46 @@ static mus_any_class DELAY_CLASS = {
0, 0, 0, 0,
&delay_loc,
0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&delay_reset,
- 0, &delay_zdly, 0
+ 0, &dly_copy
};
mus_any *mus_make_delay(int size, mus_float_t *preloaded_line, int line_size, mus_interp_t type)
{
- /* if preloaded_line null, allocated locally */
- /* if size == line_size, normal (non-interpolating) delay */
+ /* if preloaded_line null, allocated locally.
+ * if size == line_size, normal (non-interpolating) delay
+ * in clm2xen.c, if size=0 and max-size unset, max-size=1 (line_size here)
+ */
dly *gen;
- gen = (dly *)clm_calloc(1, sizeof(dly), S_make_delay);
+ if (dly_free_list)
+ {
+ gen = dly_free_list;
+ dly_free_list = gen->next;
+ }
+ else gen = (dly *)malloc(sizeof(dly));
gen->core = &DELAY_CLASS;
gen->loc = 0;
gen->size = size;
gen->zsize = line_size;
gen->zdly = ((line_size != size) || (type != MUS_INTERP_NONE));
+ if (gen->zdly)
+ {
+ gen->del = ztap;
+ gen->delt = zdelt;
+ if (gen->size == 0)
+ gen->delu = delay_unmodulated_zero;
+ else gen->delu = zdelay_unmodulated;
+ }
+ else
+ {
+ gen->del = dtap;
+ gen->delt = delt;
+ if (gen->size == 0)
+ gen->delu = delay_unmodulated_zero;
+ else gen->delu = mus_delay_unmodulated_noz;
+ }
gen->type = type;
if (preloaded_line)
{
@@ -3360,21 +4673,29 @@ mus_any *mus_make_delay(int size, mus_float_t *preloaded_line, int line_size, mu
}
else
{
- gen->line = (mus_float_t *)clm_calloc_atomic(line_size, sizeof(mus_float_t), "delay line");
+ gen->line = (mus_float_t *)calloc((line_size <= 0) ? 1 : line_size, sizeof(mus_float_t));
gen->line_allocated = true;
}
gen->zloc = line_size - size;
+ gen->filt = NULL;
+ gen->filt_allocated = false;
+ gen->xscl = 0.0;
+ gen->yscl = 0.0;
+ gen->yn1 = 0.0;
+ gen->runf = NULL;
return((mus_any *)gen);
}
-bool mus_delay_p(mus_any *ptr)
+bool mus_is_delay(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_DELAY));
}
+/* ---------------- comb ---------------- */
+
mus_float_t mus_comb(mus_any *ptr, mus_float_t input, mus_float_t pm)
{
dly *gen = (dly *)ptr;
@@ -3382,18 +4703,20 @@ mus_float_t mus_comb(mus_any *ptr, mus_float_t input, mus_float_t pm)
return(mus_delay(ptr, input + (gen->yscl * mus_tap(ptr, pm)), pm));
/* mus.lisp has 0 in place of the final pm -- the question is whether the delay
should interpolate as well as the tap. There is a subtle difference in
- output (the pm case is low-passed by the interpolation ("average"),
+ output (the pm case is low-passed by the interpolation ("average")),
but I don't know if there's a standard here, or what people expect.
We're doing the outer-level interpolation in notch and all-pass.
Should mus.lisp be changed?
*/
- else return(mus_delay(ptr, input + (gen->line[gen->loc] * gen->yscl), 0.0));
+ else return(mus_delay_unmodulated(ptr, input + (gen->line[gen->loc] * gen->yscl)));
}
mus_float_t mus_comb_unmodulated(mus_any *ptr, mus_float_t input)
{
dly *gen = (dly *)ptr;
+ if (gen->zdly)
+ return(mus_delay_unmodulated(ptr, input + (gen->line[gen->zloc] * gen->yscl)));
return(mus_delay_unmodulated(ptr, input + (gen->line[gen->loc] * gen->yscl)));
}
@@ -3402,11 +4725,13 @@ mus_float_t mus_comb_unmodulated_noz(mus_any *ptr, mus_float_t input)
{
dly *gen = (dly *)ptr;
mus_float_t result;
+
result = gen->line[gen->loc];
- gen->line[gen->loc] = input + (gen->line[gen->loc] * gen->yscl);
+ gen->line[gen->loc] = input + (result * gen->yscl);
gen->loc++;
if (gen->loc >= gen->size)
gen->loc = 0;
+
return(result);
}
@@ -3416,22 +4741,22 @@ static char *describe_comb(mus_any *ptr)
char *str = NULL;
dly *gen = (dly *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
if (gen->zdly)
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s scaler: %.3f, line[%d,%d, %s]: %s",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s scaler: %.3f, line[%u,%u, %s]: %s",
mus_name(ptr),
gen->yscl,
gen->size,
gen->zsize,
interp_type_to_string(gen->type),
str = float_array_to_string(gen->line, gen->size, gen->zloc));
- else mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s scaler: %.3f, line[%d, %s]: %s",
+ else snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s scaler: %.3f, line[%u, %s]: %s",
mus_name(ptr),
gen->yscl,
gen->size,
interp_type_to_string(gen->type),
str = float_array_to_string(gen->line, gen->size, gen->loc));
- if (str) clm_free(str);
+ if (str) free(str);
return(describe_buffer);
}
@@ -3459,9 +4784,9 @@ static mus_any_class COMB_CLASS = {
0, 0, 0, 0,
&delay_loc,
0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&delay_reset,
- 0, &delay_zdly, 0
+ 0, &dly_copy
};
@@ -3479,34 +4804,222 @@ mus_any *mus_make_comb(mus_float_t scaler, int size, mus_float_t *line, int line
}
-bool mus_comb_p(mus_any *ptr)
+bool mus_is_comb(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_COMB));
}
+
+/* ---------------- comb-bank ---------------- */
+
+typedef struct {
+ mus_any_class *core;
+ int size;
+ mus_any **gens;
+ mus_float_t (*cmbf)(mus_any *ptr, mus_float_t input);
+} cmb_bank;
+
+
+static void free_comb_bank(mus_any *ptr)
+{
+ cmb_bank *f = (cmb_bank *)ptr;
+ if (f->gens) {free(f->gens); f->gens = NULL;}
+ free(ptr);
+}
+
+
+static mus_any *cmb_bank_copy(mus_any *ptr)
+{
+ cmb_bank *g, *p;
+ int i;
+
+ p = (cmb_bank *)ptr;
+ g = (cmb_bank *)malloc(sizeof(cmb_bank));
+ memcpy((void *)g, (void *)ptr, sizeof(cmb_bank));
+ g->gens = (mus_any **)malloc(p->size * sizeof(mus_any *));
+ for (i = 0; i < p->size; i++)
+ g->gens[i] = mus_copy(p->gens[i]);
+
+ return((mus_any *)g);
+}
+
+
+static mus_float_t run_comb_bank(mus_any *ptr, mus_float_t input, mus_float_t unused)
+{
+ return(mus_comb_bank(ptr, input));
+}
+
+
+static mus_long_t comb_bank_length(mus_any *ptr)
+{
+ return(((cmb_bank *)ptr)->size);
+}
+
+
+static void comb_bank_reset(mus_any *ptr)
+{
+ cmb_bank *f = (cmb_bank *)ptr;
+ int i;
+ for (i = 0; i < f->size; i++)
+ mus_reset(f->gens[i]);
+}
+
+
+static bool comb_bank_equalp(mus_any *p1, mus_any *p2)
+{
+ cmb_bank *f1 = (cmb_bank *)p1;
+ cmb_bank *f2 = (cmb_bank *)p2;
+ int i, size;
+
+ if (f1 == f2) return(true);
+ if (f1->size != f2->size) return(false);
+ size = f1->size;
+
+ for (i = 0; i < size; i++)
+ if (!delay_equalp(f1->gens[i], f2->gens[i]))
+ return(false);
+
+ /* now check the locals... */
+ return(true);
+}
+
+
+static char *describe_comb_bank(mus_any *ptr)
+{
+ cmb_bank *gen = (cmb_bank *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %d",
+ mus_name(ptr),
+ gen->size);
+ return(describe_buffer);
+}
+
+static mus_any_class COMB_BANK_CLASS = {
+ MUS_COMB_BANK,
+ (char *)S_comb_bank,
+ &free_comb_bank,
+ &describe_comb_bank,
+ &comb_bank_equalp,
+ 0, 0,
+ &comb_bank_length, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_comb_bank,
+ MUS_NOT_SPECIAL,
+ NULL, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &comb_bank_reset,
+ 0, &cmb_bank_copy
+};
+
+
+static mus_float_t comb_bank_any(mus_any *combs, mus_float_t inval)
+{
+ int i;
+ mus_float_t sum = 0.0;
+ cmb_bank *c = (cmb_bank *)combs;
+ for (i = 0; i < c->size; i++)
+ sum += mus_comb_unmodulated_noz(c->gens[i], inval);
+ return(sum);
+}
+
+static mus_float_t comb_bank_4(mus_any *combs, mus_float_t inval)
+{
+ cmb_bank *c = (cmb_bank *)combs;
+ mus_any **gs;
+ gs = c->gens;
+ return(mus_comb_unmodulated_noz(gs[0], inval) +
+ mus_comb_unmodulated_noz(gs[1], inval) +
+ mus_comb_unmodulated_noz(gs[2], inval) +
+ mus_comb_unmodulated_noz(gs[3], inval));
+}
+
+static mus_float_t comb_bank_6(mus_any *combs, mus_float_t inval)
+{
+ cmb_bank *c = (cmb_bank *)combs;
+ mus_any **gs;
+ gs = c->gens;
+ return(mus_comb_unmodulated_noz(gs[0], inval) +
+ mus_comb_unmodulated_noz(gs[1], inval) +
+ mus_comb_unmodulated_noz(gs[2], inval) +
+ mus_comb_unmodulated_noz(gs[3], inval) +
+ mus_comb_unmodulated_noz(gs[4], inval) +
+ mus_comb_unmodulated_noz(gs[5], inval));
+}
+
+
+mus_any *mus_make_comb_bank(int size, mus_any **combs)
+{
+ cmb_bank *gen;
+ int i;
+
+ gen = (cmb_bank *)malloc(sizeof(cmb_bank));
+ gen->core = &COMB_BANK_CLASS;
+ gen->size = size;
+
+ gen->gens = (mus_any **)malloc(size * sizeof(mus_any *));
+ for (i = 0; i < size; i++)
+ gen->gens[i] = combs[i];
+
+ if (size == 4)
+ gen->cmbf = comb_bank_4;
+ else
+ {
+ if (size == 6)
+ gen->cmbf = comb_bank_6;
+ else gen->cmbf = comb_bank_any;
+ }
+
+ return((mus_any *)gen);
+}
+
+bool mus_is_comb_bank(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_COMB_BANK));
+}
+
+mus_float_t mus_comb_bank(mus_any *combs, mus_float_t inval)
+{
+ cmb_bank *gen = (cmb_bank *)combs;
+ return((gen->cmbf)(combs, inval));
+}
+
+
+
+
+/* ---------------- notch ---------------- */
+
static char *describe_notch(mus_any *ptr)
{
char *str = NULL;
dly *gen = (dly *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
if (gen->zdly)
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s scaler: %.3f, line[%d,%d, %s]: %s",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s scaler: %.3f, line[%u,%u, %s]: %s",
mus_name(ptr),
gen->xscl,
gen->size,
gen->zsize,
interp_type_to_string(gen->type),
str = float_array_to_string(gen->line, gen->size, gen->zloc));
- else mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s scaler: %.3f, line[%d, %s]: %s",
+ else snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s scaler: %.3f, line[%u, %s]: %s",
mus_name(ptr),
gen->xscl,
gen->size,
interp_type_to_string(gen->type),
str = float_array_to_string(gen->line, gen->size, gen->loc));
- if (str) clm_free(str);
+ if (str) free(str);
return(describe_buffer);
}
@@ -3533,9 +5046,9 @@ static mus_any_class NOTCH_CLASS = {
0, 0, 0, 0,
&delay_loc,
0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&delay_reset,
- 0, &delay_zdly, 0
+ 0, &dly_copy
};
@@ -3551,8 +5064,8 @@ mus_float_t mus_notch_unmodulated(mus_any *ptr, mus_float_t input)
return((input * ((dly *)ptr)->xscl) + mus_delay_unmodulated(ptr, input));
}
-
-mus_float_t mus_notch_unmodulated_noz(mus_any *ptr, mus_float_t input)
+#if 0
+static mus_float_t mus_notch_unmodulated_noz(mus_any *ptr, mus_float_t input)
{
dly *gen = (dly *)ptr;
mus_float_t result;
@@ -3563,9 +5076,9 @@ mus_float_t mus_notch_unmodulated_noz(mus_any *ptr, mus_float_t input)
gen->loc = 0;
return(result);
}
+#endif
-
-bool mus_notch_p(mus_any *ptr)
+bool mus_is_notch(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_NOTCH));
@@ -3601,7 +5114,9 @@ mus_float_t mus_all_pass_unmodulated(mus_any *ptr, mus_float_t input)
{
mus_float_t din;
dly *gen = (dly *)ptr;
- din = input + (gen->yscl * gen->line[gen->loc]);
+ if (gen->zdly)
+ din = input + (gen->yscl * gen->line[gen->zloc]);
+ else din = input + (gen->yscl * gen->line[gen->loc]);
return(mus_delay_unmodulated(ptr, din) + (gen->xscl * din));
}
@@ -3610,17 +5125,18 @@ mus_float_t mus_all_pass_unmodulated_noz(mus_any *ptr, mus_float_t input)
{
mus_float_t result, din;
dly *gen = (dly *)ptr;
- din = input + (gen->yscl * gen->line[gen->loc]);
- result = gen->line[gen->loc] + (gen->xscl * din);
- gen->line[gen->loc] = din;
- gen->loc++;
- if (gen->loc >= gen->size)
+ unsigned int loc;
+ loc = gen->loc++;
+ din = input + (gen->yscl * gen->line[loc]);
+ result = gen->line[loc] + (gen->xscl * din);
+ gen->line[loc] = din;
+ if (gen->loc >= gen->size)
gen->loc = 0;
return(result);
}
-bool mus_all_pass_p(mus_any *ptr)
+bool mus_is_all_pass(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_ALL_PASS));
@@ -3632,9 +5148,9 @@ static char *describe_all_pass(mus_any *ptr)
char *str = NULL;
dly *gen = (dly *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
if (gen->zdly)
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s feedback: %.3f, feedforward: %.3f, line[%d,%d, %s]:%s",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s feedback: %.3f, feedforward: %.3f, line[%u,%u, %s]:%s",
mus_name(ptr),
gen->yscl,
gen->xscl,
@@ -3642,14 +5158,14 @@ static char *describe_all_pass(mus_any *ptr)
gen->zsize,
interp_type_to_string(gen->type),
str = float_array_to_string(gen->line, gen->size, gen->zloc));
- else mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s feedback: %.3f, feedforward: %.3f, line[%d, %s]:%s",
+ else snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s feedback: %.3f, feedforward: %.3f, line[%u, %s]:%s",
mus_name(ptr),
gen->yscl,
gen->xscl,
gen->size,
interp_type_to_string(gen->type),
str = float_array_to_string(gen->line, gen->size, gen->loc));
- if (str) clm_free(str);
+ if (str) free(str);
return(describe_buffer);
}
@@ -3677,9 +5193,9 @@ static mus_any_class ALL_PASS_CLASS = {
0, 0, 0, 0,
&delay_loc,
0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&delay_reset,
- 0, &delay_zdly, 0
+ 0, &dly_copy
};
@@ -3698,11 +5214,191 @@ mus_any *mus_make_all_pass(mus_float_t backward, mus_float_t forward, int size,
}
-bool mus_moving_average_p(mus_any *ptr)
-{
- return((ptr) &&
- (ptr->core->type == MUS_MOVING_AVERAGE));
-}
+/* ---------------- all_pass-bank ---------------- */
+
+typedef struct {
+ mus_any_class *core;
+ int size;
+ mus_any **gens;
+ mus_float_t (*apf)(mus_any *ptr, mus_float_t input);
+} allp_bank;
+
+
+static void free_all_pass_bank(mus_any *ptr)
+{
+ allp_bank *f = (allp_bank *)ptr;
+ if (f->gens) {free(f->gens); f->gens = NULL;}
+ free(ptr);
+}
+
+
+static mus_any *allp_bank_copy(mus_any *ptr)
+{
+ allp_bank *g, *p;
+ int i;
+
+ p = (allp_bank *)ptr;
+ g = (allp_bank *)malloc(sizeof(allp_bank));
+ memcpy((void *)g, (void *)ptr, sizeof(allp_bank));
+ g->gens = (mus_any **)malloc(p->size * sizeof(mus_any *));
+ for (i = 0; i < p->size; i++)
+ g->gens[i] = mus_copy(p->gens[i]);
+
+ return((mus_any *)g);
+}
+
+
+static mus_float_t run_all_pass_bank(mus_any *ptr, mus_float_t input, mus_float_t unused)
+{
+ return(mus_all_pass_bank(ptr, input));
+}
+
+
+static mus_long_t all_pass_bank_length(mus_any *ptr)
+{
+ return(((allp_bank *)ptr)->size);
+}
+
+
+static void all_pass_bank_reset(mus_any *ptr)
+{
+ allp_bank *f = (allp_bank *)ptr;
+ int i;
+ for (i = 0; i < f->size; i++)
+ mus_reset(f->gens[i]);
+}
+
+
+static bool all_pass_bank_equalp(mus_any *p1, mus_any *p2)
+{
+ allp_bank *f1 = (allp_bank *)p1;
+ allp_bank *f2 = (allp_bank *)p2;
+ int i, size;
+
+ if (f1 == f2) return(true);
+ if (f1->size != f2->size) return(false);
+ size = f1->size;
+
+ for (i = 0; i < size; i++)
+ if (!delay_equalp(f1->gens[i], f2->gens[i]))
+ return(false);
+
+ return(true);
+}
+
+
+static char *describe_all_pass_bank(mus_any *ptr)
+{
+ allp_bank *gen = (allp_bank *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %d",
+ mus_name(ptr),
+ gen->size);
+ return(describe_buffer);
+}
+
+static mus_any_class ALL_PASS_BANK_CLASS = {
+ MUS_ALL_PASS_BANK,
+ (char *)S_all_pass_bank,
+ &free_all_pass_bank,
+ &describe_all_pass_bank,
+ &all_pass_bank_equalp,
+ 0, 0,
+ &all_pass_bank_length, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_all_pass_bank,
+ MUS_NOT_SPECIAL,
+ NULL, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &all_pass_bank_reset,
+ 0, &allp_bank_copy
+};
+
+
+static mus_float_t all_pass_bank_3(mus_any *all_passes, mus_float_t inval)
+{
+ allp_bank *c = (allp_bank *)all_passes;
+ mus_any **gs;
+ gs = c->gens;
+ return(mus_all_pass_unmodulated_noz(gs[2], mus_all_pass_unmodulated_noz(gs[1], mus_all_pass_unmodulated_noz(gs[0], inval))));
+}
+
+static mus_float_t all_pass_bank_4(mus_any *all_passes, mus_float_t inval)
+{
+ allp_bank *c = (allp_bank *)all_passes;
+ mus_any **gs;
+ gs = c->gens;
+ return(mus_all_pass_unmodulated_noz(gs[3], mus_all_pass_unmodulated_noz(gs[2], mus_all_pass_unmodulated_noz(gs[1], mus_all_pass_unmodulated_noz(gs[0], inval)))));
+}
+
+static mus_float_t all_pass_bank_any(mus_any *all_passs, mus_float_t inval)
+{
+ int i;
+ mus_float_t sum = inval;
+ allp_bank *c = (allp_bank *)all_passs;
+ for (i = 0; i < c->size; i++)
+ sum = mus_all_pass_unmodulated_noz(c->gens[i], sum);
+ return(sum);
+}
+
+
+mus_any *mus_make_all_pass_bank(int size, mus_any **all_passs)
+{
+ allp_bank *gen;
+ int i;
+
+ gen = (allp_bank *)malloc(sizeof(allp_bank));
+ gen->core = &ALL_PASS_BANK_CLASS;
+ gen->size = size;
+
+ gen->gens = (mus_any **)malloc(size * sizeof(mus_any *));
+ for (i = 0; i < size; i++)
+ gen->gens[i] = all_passs[i];
+
+ if (size == 3)
+ gen->apf = all_pass_bank_3;
+ else
+ {
+ if (size == 4)
+ gen->apf = all_pass_bank_4;
+ else gen->apf = all_pass_bank_any;
+ }
+
+ return((mus_any *)gen);
+}
+
+
+bool mus_is_all_pass_bank(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_ALL_PASS_BANK));
+}
+
+
+mus_float_t mus_all_pass_bank(mus_any *all_passes, mus_float_t inval)
+{
+ allp_bank *gen = (allp_bank *)all_passes;
+ return((gen->apf)(all_passes, inval));
+}
+
+
+
+
+/* ---------------- moving-average ---------------- */
+
+bool mus_is_moving_average(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_MOVING_AVERAGE));
+}
mus_float_t mus_moving_average(mus_any *ptr, mus_float_t input)
@@ -3731,13 +5427,13 @@ static char *describe_moving_average(mus_any *ptr)
char *str = NULL;
dly *gen = (dly *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %.3f, line[%d]:%s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %.3f, line[%u]:%s",
mus_name(ptr),
gen->xscl * gen->yscl,
gen->size,
str = float_array_to_string(gen->line, gen->size, gen->loc));
- if (str) clm_free(str);
+ if (str) free(str);
return(describe_buffer);
}
@@ -3764,9 +5460,9 @@ static mus_any_class MOVING_AVERAGE_CLASS = {
0, 0, 0, 0,
&delay_loc,
0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&moving_average_reset,
- 0, &delay_zdly, 0
+ 0, &dly_copy
};
@@ -3787,6 +5483,225 @@ mus_any *mus_make_moving_average(int size, mus_float_t *line)
return(NULL);
}
+mus_any *mus_make_moving_average_with_initial_sum(int size, mus_float_t *line, mus_float_t sum)
+{
+ dly *gen;
+ gen = (dly *)mus_make_delay(size, line, size, MUS_INTERP_NONE);
+ if (gen)
+ {
+ gen->core = &MOVING_AVERAGE_CLASS;
+ gen->xscl = sum;
+ gen->yscl = 1.0 / (mus_float_t)size;
+ return((mus_any *)gen);
+ }
+ return(NULL);
+}
+
+
+/* -------- moving-max -------- */
+
+bool mus_is_moving_max(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_MOVING_MAX));
+}
+
+
+mus_float_t mus_moving_max(mus_any *ptr, mus_float_t input)
+{
+ dly *gen = (dly *)ptr;
+ mus_float_t output, abs_input;
+
+ abs_input = fabs(input);
+ output = mus_delay_unmodulated_noz(ptr, abs_input);
+ if (abs_input >= gen->xscl)
+ gen->xscl = abs_input;
+ else
+ {
+ if (output >= gen->xscl)
+ {
+ unsigned int i;
+ for (i = 0; i < gen->size; i++)
+ if (gen->line[i] > abs_input)
+ abs_input = gen->line[i];
+ gen->xscl = abs_input;
+ }
+ }
+ return(gen->xscl);
+}
+
+static mus_float_t run_mus_moving_max(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_moving_max(ptr, input));}
+
+
+static void moving_max_reset(mus_any *ptr)
+{
+ dly *gen = (dly *)ptr;
+ delay_reset(ptr);
+ gen->xscl = 0.0;
+}
+
+
+static char *describe_moving_max(mus_any *ptr)
+{
+ char *str = NULL;
+ dly *gen = (dly *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %.3f, line[%u]:%s",
+ mus_name(ptr),
+ gen->xscl,
+ gen->size,
+ str = float_array_to_string(gen->line, gen->size, gen->loc));
+ if (str) free(str);
+ return(describe_buffer);
+}
+
+
+static mus_any_class MOVING_MAX_CLASS = {
+ MUS_MOVING_MAX,
+ (char *)S_moving_max,
+ &free_delay,
+ &describe_moving_max,
+ &delay_equalp,
+ &delay_data,
+ &delay_set_data,
+ &delay_length,
+ &delay_set_length,
+ 0, 0, 0, 0, /* freq phase */
+ &delay_scaler,
+ &delay_set_scaler,
+ &delay_fb,
+ &delay_set_fb,
+ &run_mus_moving_max,
+ MUS_DELAY_LINE,
+ NULL, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &delay_loc,
+ 0, 0,
+ 0, 0, 0, 0,
+ &moving_max_reset,
+ 0, &dly_copy
+};
+
+
+mus_any *mus_make_moving_max(int size, mus_float_t *line)
+{
+ dly *gen;
+ gen = (dly *)mus_make_delay(size, line, size, MUS_INTERP_NONE);
+ if (gen)
+ {
+ int i;
+ gen->core = &MOVING_MAX_CLASS;
+ gen->xscl = 0.0;
+ for (i = 0; i < size; i++)
+ if (fabs(gen->line[i]) > gen->xscl)
+ gen->xscl = fabs(gen->line[i]);
+ return((mus_any *)gen);
+ }
+ return(NULL);
+}
+
+
+/* -------- moving-norm -------- */
+
+bool mus_is_moving_norm(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_MOVING_NORM));
+}
+
+
+mus_float_t mus_moving_norm(mus_any *ptr, mus_float_t input)
+{
+ dly *gen = (dly *)ptr;
+ mus_float_t output, abs_input;
+
+ abs_input = fabs(input);
+ if (abs_input < 0.01) abs_input = 0.01; /* 0.01 sets the max norm output (~100) -- maybe a parameter to make-norm? */
+ output = mus_moving_max(ptr, abs_input);
+ gen->y1 = output + (gen->yscl * gen->y1);
+
+ return(gen->norm / gen->y1);
+}
+
+
+static mus_float_t run_mus_moving_norm(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_moving_norm(ptr, input));}
+
+
+static void moving_norm_reset(mus_any *ptr)
+{
+ dly *gen = (dly *)ptr;
+ delay_reset(ptr);
+ gen->xscl = 0.0;
+ gen->y1 = 0.0;
+}
+
+
+static char *describe_moving_norm(mus_any *ptr)
+{
+ char *str = NULL;
+ dly *gen = (dly *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s, max %.3f, y1 %.3f, weight %.3f, line[%u]:%s",
+ mus_name(ptr),
+ gen->xscl, gen->y1, gen->yscl,
+ gen->size,
+ str = float_array_to_string(gen->line, gen->size, gen->loc));
+ if (str) free(str);
+ return(describe_buffer);
+}
+
+
+static mus_any_class MOVING_NORM_CLASS = {
+ MUS_MOVING_NORM,
+ (char *)S_moving_norm,
+ &free_delay,
+ &describe_moving_norm,
+ &delay_equalp,
+ &delay_data,
+ &delay_set_data,
+ &delay_length,
+ &delay_set_length,
+ 0, 0, 0, 0, /* freq phase */
+ &delay_scaler,
+ &delay_set_scaler,
+ &delay_fb,
+ &delay_set_fb,
+ &run_mus_moving_norm,
+ MUS_DELAY_LINE,
+ NULL, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &delay_loc,
+ 0, 0,
+ 0, 0, 0, 0,
+ &moving_norm_reset,
+ 0, &dly_copy
+};
+
+
+mus_any *mus_make_moving_norm(int size, mus_float_t *line, mus_float_t norm)
+{
+ dly *gen;
+ gen = (dly *)mus_make_moving_max(size, line);
+ if (gen)
+ {
+ gen->core = &MOVING_NORM_CLASS;
+
+ gen->yscl = (mus_float_t)size / (size + 1.0); /* one-pole -b1 = -feedback so this is a lowpass filter */
+ gen->norm = norm * (size + 1.0);
+ gen->yn1 = 1.0 / size;
+ gen->y1 = size + 1.0;
+
+ return((mus_any *)gen);
+ }
+ return(NULL);
+}
+
+
+
/* ---------------------------------------- filtered-comb ---------------------------------------- */
@@ -3814,15 +5729,15 @@ static char *describe_filtered_comb(mus_any *ptr)
comb_str = describe_comb(ptr);
filter_str = mus_describe(((dly *)ptr)->filt);
len = strlen(comb_str) + strlen(filter_str) + 64;
- res = (char *)clm_calloc(len, sizeof(char), "describe_filtered_comb");
- mus_snprintf(res, len, "%s, filter: [%s]", comb_str, filter_str);
- if (comb_str) clm_free(comb_str);
- if (filter_str) clm_free(filter_str);
+ res = (char *)malloc(len * sizeof(char));
+ snprintf(res, len, "%s, filter: [%s]", comb_str, filter_str);
+ if (comb_str) free(comb_str);
+ if (filter_str) free(filter_str);
return(res);
}
-bool mus_filtered_comb_p(mus_any *ptr)
+bool mus_is_filtered_comb(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_FILTERED_COMB));
@@ -3835,16 +5750,13 @@ mus_float_t mus_filtered_comb(mus_any *ptr, mus_float_t input, mus_float_t pm)
if (fc->zdly)
return(mus_delay(ptr,
input + (fc->yscl *
- mus_run(fc->filt,
- mus_tap(ptr, pm),
- 0.0)),
+ fc->runf(fc->filt,
+ mus_tap(ptr, pm),
+ 0.0)),
pm));
- else return(mus_delay(ptr,
- input + (fc->yscl *
- mus_run(fc->filt,
- fc->line[fc->loc],
- 0.0)),
- 0.0));
+ return(mus_delay_unmodulated(ptr,
+ input + (fc->yscl *
+ fc->runf(fc->filt, fc->line[fc->loc], 0.0))));
}
@@ -3853,9 +5765,7 @@ mus_float_t mus_filtered_comb_unmodulated(mus_any *ptr, mus_float_t input)
dly *fc = (dly *)ptr;
return(mus_delay_unmodulated(ptr,
input + (fc->yscl *
- mus_run(fc->filt,
- fc->line[fc->loc],
- 0.0))));
+ fc->runf(fc->filt, fc->line[fc->loc], 0.0))));
}
@@ -3882,27 +5792,241 @@ static mus_any_class FILTERED_COMB_CLASS = {
0, 0, 0, 0,
&delay_loc,
0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&filtered_comb_reset,
- 0, 0, 0
+ 0, &dly_copy
};
mus_any *mus_make_filtered_comb(mus_float_t scaler, int size, mus_float_t *line, int line_size, mus_interp_t type, mus_any *filt)
{
- if (filt)
+ dly *fc;
+ fc = (dly *)mus_make_comb(scaler, size, line, line_size, type);
+ if (fc)
{
- dly *fc;
- fc = (dly *)mus_make_comb(scaler, size, line, line_size, type);
- if (fc)
+ fc->core = &FILTERED_COMB_CLASS;
+ if (filt)
+ fc->filt = filt;
+ else
+ {
+ fc->filt = mus_make_one_zero(1.0, 0.0);
+ fc->filt_allocated = true;
+ }
+ fc->runf = mus_run_function(fc->filt);
+ return((mus_any *)fc);
+ }
+ else return(NULL);
+}
+
+
+/* ---------------- filtered-comb-bank ---------------- */
+
+typedef struct {
+ mus_any_class *core;
+ int size;
+ mus_any **gens;
+ mus_float_t (*cmbf)(mus_any *ptr, mus_float_t input);
+} fltcmb_bank;
+
+
+static void free_filtered_comb_bank(mus_any *ptr)
+{
+ fltcmb_bank *f = (fltcmb_bank *)ptr;
+ if (f->gens) {free(f->gens); f->gens = NULL;}
+ free(ptr);
+}
+
+
+static mus_any *fltcmb_bank_copy(mus_any *ptr)
+{
+ fltcmb_bank *g, *p;
+ int i;
+
+ p = (fltcmb_bank *)ptr;
+ g = (fltcmb_bank *)malloc(sizeof(fltcmb_bank));
+ memcpy((void *)g, (void *)ptr, sizeof(fltcmb_bank));
+ g->gens = (mus_any **)malloc(p->size * sizeof(mus_any *));
+ for (i = 0; i < p->size; i++)
+ g->gens[i] = mus_copy(p->gens[i]);
+
+ return((mus_any *)g);
+}
+
+
+static mus_float_t run_filtered_comb_bank(mus_any *ptr, mus_float_t input, mus_float_t unused)
+{
+ return(mus_filtered_comb_bank(ptr, input));
+}
+
+
+static mus_long_t filtered_comb_bank_length(mus_any *ptr)
+{
+ return(((fltcmb_bank *)ptr)->size);
+}
+
+
+static void filtered_comb_bank_reset(mus_any *ptr)
+{
+ fltcmb_bank *f = (fltcmb_bank *)ptr;
+ int i;
+ for (i = 0; i < f->size; i++)
+ mus_reset(f->gens[i]);
+}
+
+
+static bool filtered_comb_bank_equalp(mus_any *p1, mus_any *p2)
+{
+ fltcmb_bank *f1 = (fltcmb_bank *)p1;
+ fltcmb_bank *f2 = (fltcmb_bank *)p2;
+ int i, size;
+
+ if (f1 == f2) return(true);
+ if (f1->size != f2->size) return(false);
+ size = f1->size;
+
+ for (i = 0; i < size; i++)
+ if (!filtered_comb_equalp(f1->gens[i], f2->gens[i]))
+ return(false);
+
+ return(true);
+}
+
+
+static char *describe_filtered_comb_bank(mus_any *ptr)
+{
+ fltcmb_bank *gen = (fltcmb_bank *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %d",
+ mus_name(ptr),
+ gen->size);
+ return(describe_buffer);
+}
+
+static mus_any_class FILTERED_COMB_BANK_CLASS = {
+ MUS_FILTERED_COMB_BANK,
+ (char *)S_filtered_comb_bank,
+ &free_filtered_comb_bank,
+ &describe_filtered_comb_bank,
+ &filtered_comb_bank_equalp,
+ 0, 0,
+ &filtered_comb_bank_length, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_filtered_comb_bank,
+ MUS_NOT_SPECIAL,
+ NULL, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &filtered_comb_bank_reset,
+ 0, &fltcmb_bank_copy
+};
+
+
+static mus_float_t filtered_comb_one_zero(mus_any *ptr, mus_float_t input)
+{
+ dly *gen = (dly *)ptr;
+ mus_float_t result;
+ result = gen->line[gen->loc];
+ gen->line[gen->loc] = input + mus_one_zero(gen->filt, result); /* gen->yscl folded into one_zero coeffs via smp_scl */
+ gen->loc++;
+ if (gen->loc >= gen->size)
+ gen->loc = 0;
+ return(result);
+}
+
+
+static mus_float_t filtered_comb_bank_8(mus_any *combs, mus_float_t inval)
+{
+ fltcmb_bank *c = (fltcmb_bank *)combs;
+ mus_any **gs;
+ gs = c->gens;
+ return(filtered_comb_one_zero(gs[0], inval) +
+ filtered_comb_one_zero(gs[1], inval) +
+ filtered_comb_one_zero(gs[2], inval) +
+ filtered_comb_one_zero(gs[3], inval) +
+ filtered_comb_one_zero(gs[4], inval) +
+ filtered_comb_one_zero(gs[5], inval) +
+ filtered_comb_one_zero(gs[6], inval) +
+ filtered_comb_one_zero(gs[7], inval));
+}
+
+static mus_float_t filtered_comb_bank_any(mus_any *filtered_combs, mus_float_t inval)
+{
+ int i;
+ mus_float_t sum = 0.0;
+ fltcmb_bank *c = (fltcmb_bank *)filtered_combs;
+ for (i = 0; i < c->size; i++)
+ sum += mus_filtered_comb_unmodulated(c->gens[i], inval);
+ return(sum);
+}
+
+static void smp_scl(mus_any *ptr, mus_float_t scl);
+
+mus_any *mus_make_filtered_comb_bank(int size, mus_any **filtered_combs)
+{
+ fltcmb_bank *gen;
+ int i;
+ bool zdly = false, oz = true;
+
+ gen = (fltcmb_bank *)malloc(sizeof(fltcmb_bank));
+ gen->core = &FILTERED_COMB_BANK_CLASS;
+ gen->size = size;
+
+ gen->gens = (mus_any **)malloc(size * sizeof(mus_any *));
+ for (i = 0; i < size; i++)
+ {
+ gen->gens[i] = filtered_combs[i];
+ zdly = (zdly) || (((dly *)(filtered_combs[i]))->zdly);
+ oz = (oz) && (mus_is_one_zero(((dly *)(filtered_combs[i]))->filt));
+ }
+
+ if ((size == 8) &&
+ (oz) &&
+ (!zdly))
+ {
+ gen->cmbf = filtered_comb_bank_8;
+ for (i = 0; i < 8; i++)
{
- fc->core = &FILTERED_COMB_CLASS;
- fc->filt = filt;
- return((mus_any *)fc);
+ dly *d;
+ d = (dly *)gen->gens[i];
+ smp_scl(d->filt, d->yscl);
}
- else return(NULL);
}
- return(mus_make_comb(scaler, size, line, line_size, type));
+ else gen->cmbf = filtered_comb_bank_any;
+
+ return((mus_any *)gen);
+}
+
+
+bool mus_is_filtered_comb_bank(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_FILTERED_COMB_BANK));
+}
+
+
+mus_float_t mus_filtered_comb_bank(mus_any *filtered_combs, mus_float_t inval)
+{
+ fltcmb_bank *gen = (fltcmb_bank *)filtered_combs;
+ return((gen->cmbf)(filtered_combs, inval));
+}
+
+
+mus_any *mus_bank_generator(mus_any *g, int i)
+{
+ if (mus_is_comb_bank(g))
+ return(((cmb_bank *)g)->gens[i]);
+ if (mus_is_all_pass_bank(g))
+ return(((allp_bank *)g)->gens[i]);
+ if (mus_is_filtered_comb_bank(g))
+ return(((fltcmb_bank *)g)->gens[i]);
+ return(NULL);
}
@@ -3913,14 +6037,18 @@ mus_any *mus_make_filtered_comb(mus_float_t scaler, int size, mus_float_t *line,
typedef struct {
mus_any_class *core;
mus_float_t current_value;
- double freq, phase, base, width;
+ mus_float_t freq, phase, base, width;
} sw;
-static int free_sw(mus_any *ptr)
+static void free_sw(mus_any *ptr) {free(ptr);}
+
+static mus_any *sw_copy(mus_any *ptr)
{
- if (ptr) clm_free(ptr);
- return(0);
+ sw *g;
+ g = (sw *)malloc(sizeof(sw));
+ memcpy((void *)g, (void *)ptr, sizeof(sw));
+ return((mus_any *)g);
}
@@ -3942,7 +6070,7 @@ mus_float_t mus_sawtooth_wave(mus_any *ptr, mus_float_t fm)
static mus_float_t run_sawtooth_wave(mus_any *ptr, mus_float_t fm, mus_float_t unused) {return(mus_sawtooth_wave(ptr, fm));}
-bool mus_sawtooth_wave_p(mus_any *ptr)
+bool mus_is_sawtooth_wave(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_SAWTOOTH_WAVE));
@@ -3983,8 +6111,8 @@ static bool sw_equalp(mus_any *p1, mus_any *p2)
static char *describe_sw(mus_any *ptr)
{
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, amp: %.3f",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, amp: %.3f",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
@@ -4021,16 +6149,16 @@ static mus_any_class SAWTOOTH_WAVE_CLASS = {
NULL, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&sawtooth_reset,
- 0, 0, 0
+ 0, &sw_copy
};
mus_any *mus_make_sawtooth_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase) /* M_PI as initial phase, normally */
{
sw *gen;
- gen = (sw *)clm_calloc_atomic(1, sizeof(sw), S_make_sawtooth_wave);
+ gen = (sw *)malloc(sizeof(sw));
gen->core = &SAWTOOTH_WAVE_CLASS;
gen->freq = mus_hz_to_radians(freq);
gen->base = (amp / M_PI);
@@ -4058,7 +6186,7 @@ mus_float_t mus_square_wave(mus_any *ptr, mus_float_t fm)
}
-bool mus_square_wave_p(mus_any *ptr)
+bool mus_is_square_wave(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_SQUARE_WAVE));
@@ -4102,16 +6230,16 @@ static mus_any_class SQUARE_WAVE_CLASS = {
0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&square_wave_reset,
- 0, 0, 0
+ 0, &sw_copy
};
mus_any *mus_make_square_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase)
{
sw *gen;
- gen = (sw *)clm_calloc_atomic(1, sizeof(sw), S_make_square_wave);
+ gen = (sw *)malloc(sizeof(sw));
gen->core = &SQUARE_WAVE_CLASS;
gen->freq = mus_hz_to_radians(freq);
gen->base = amp;
@@ -4128,6 +6256,7 @@ mus_float_t mus_triangle_wave(mus_any *ptr, mus_float_t fm)
{
sw *gen = (sw *)ptr;
mus_float_t result;
+
result = gen->current_value;
gen->phase += (gen->freq + fm);
if ((gen->phase >= TWO_PI) || (gen->phase < 0.0))
@@ -4145,7 +6274,36 @@ mus_float_t mus_triangle_wave(mus_any *ptr, mus_float_t fm)
}
-bool mus_triangle_wave_p(mus_any *ptr)
+mus_float_t mus_triangle_wave_unmodulated(mus_any *ptr)
+{
+ sw *gen = (sw *)ptr;
+ mus_float_t result;
+
+ result = gen->current_value;
+ gen->phase += gen->freq;
+ TRY_AGAIN:
+ if (gen->phase < (M_PI / 2.0))
+ gen->current_value = gen->base * gen->phase;
+ else
+ {
+ if (gen->phase < (M_PI * 1.5))
+ gen->current_value = gen->base * (M_PI - gen->phase);
+ else
+ {
+ if (gen->phase < TWO_PI)
+ gen->current_value = gen->base * (gen->phase - TWO_PI);
+ else
+ {
+ gen->phase -= TWO_PI;
+ goto TRY_AGAIN;
+ }
+ }
+ }
+ return(result);
+}
+
+
+bool mus_is_triangle_wave(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_TRIANGLE_WAVE));
@@ -4186,17 +6344,23 @@ static mus_any_class TRIANGLE_WAVE_CLASS = {
NULL, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&triangle_wave_reset,
- 0, 0, 0
+ 0, &sw_copy
};
mus_any *mus_make_triangle_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase)
{
sw *gen;
- gen = (sw *)clm_calloc_atomic(1, sizeof(sw), S_make_triangle_wave);
+ gen = (sw *)malloc(sizeof(sw));
gen->core = &TRIANGLE_WAVE_CLASS;
+ if (freq < 0.0)
+ {
+ freq = -freq;
+ phase += M_PI;
+ if (phase > TWO_PI) phase -= TWO_PI;
+ }
gen->freq = mus_hz_to_radians(freq);
gen->base = (2.0 * amp / M_PI);
gen->phase = phase;
@@ -4225,7 +6389,24 @@ mus_float_t mus_pulse_train(mus_any *ptr, mus_float_t fm)
}
-bool mus_pulse_train_p(mus_any *ptr)
+mus_float_t mus_pulse_train_unmodulated(mus_any *ptr)
+{
+ sw *gen = (sw *)ptr;
+ /* here unfortunately, we might get any phase: (pulse-train p (+ (pulse-train p) -1.0))
+ */
+ if ((gen->phase >= TWO_PI) || (gen->phase < 0.0))
+ {
+ gen->phase = fmod(gen->phase, TWO_PI);
+ if (gen->phase < 0.0) gen->phase += TWO_PI;
+ gen->current_value = gen->base;
+ }
+ else gen->current_value = 0.0;
+ gen->phase += gen->freq;
+ return(gen->current_value);
+}
+
+
+bool mus_is_pulse_train(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_PULSE_TRAIN));
@@ -4266,17 +6447,18 @@ static mus_any_class PULSE_TRAIN_CLASS = {
NULL, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&pulse_train_reset,
- 0, 0, 0
+ 0, &sw_copy
};
mus_any *mus_make_pulse_train(mus_float_t freq, mus_float_t amp, mus_float_t phase) /* TWO_PI initial phase, normally */
{
sw *gen;
- gen = (sw *)clm_calloc_atomic(1, sizeof(sw), S_make_pulse_train);
+ gen = (sw *)malloc(sizeof(sw));
gen->core = &PULSE_TRAIN_CLASS;
+ if (freq < 0.0) freq = -freq;
gen->freq = mus_hz_to_radians(freq);
gen->base = amp;
gen->phase = phase;
@@ -4290,10 +6472,11 @@ mus_any *mus_make_pulse_train(mus_float_t freq, mus_float_t amp, mus_float_t pha
typedef struct {
mus_any_class *core;
- double freq, phase, base, incr;
+ mus_float_t freq, phase, base, incr, norm;
mus_float_t output;
mus_float_t *distribution;
int distribution_size;
+ mus_float_t (*ran_unmod)(mus_any *ptr);
} noi;
@@ -4322,24 +6505,12 @@ mus_float_t mus_random(mus_float_t amp) /* -amp to amp as mus_float_t */
}
-mus_float_t mus_random_no_input(void) /* -1.0 to 1.0 as mus_float_t */
-{
- return(next_random() * INVERSE_MAX_RAND - 1.0);
-}
-
-
mus_float_t mus_frandom(mus_float_t amp) /* 0.0 to amp as mus_float_t */
{
return(amp * next_random() * INVERSE_MAX_RAND2);
}
-mus_float_t mus_frandom_no_input(void) /* 0.0 to 1.0 as mus_float_t */
-{
- return(next_random() * INVERSE_MAX_RAND2);
-}
-
-
int mus_irandom(int amp)
{
return((int)(amp * next_random() * INVERSE_MAX_RAND2));
@@ -4370,6 +6541,21 @@ mus_float_t mus_rand(mus_any *ptr, mus_float_t fm)
}
+static mus_float_t zero_unmodulated(mus_any *ptr) {return(0.0);}
+
+mus_float_t mus_rand_unmodulated(mus_any *ptr)
+{
+ noi *gen = (noi *)ptr;
+ if (gen->phase >= TWO_PI)
+ {
+ gen->phase -= TWO_PI;
+ gen->output = random_any(gen);
+ }
+ gen->phase += gen->freq;
+ return(gen->output);
+}
+
+
mus_float_t mus_rand_interp(mus_any *ptr, mus_float_t fm)
{
/* fm can change the increment step during a ramp */
@@ -4393,41 +6579,131 @@ mus_float_t mus_rand_interp(mus_any *ptr, mus_float_t fm)
}
+mus_float_t mus_rand_interp_unmodulated(mus_any *ptr)
+{
+ return(((noi *)ptr)->ran_unmod(ptr));
+}
+
+
+mus_float_t (*mus_rand_interp_unmodulated_function(mus_any *g))(mus_any *gen);
+mus_float_t (*mus_rand_interp_unmodulated_function(mus_any *g))(mus_any *gen)
+{
+ if (mus_is_rand_interp(g))
+ return(((noi *)g)->ran_unmod);
+ return(NULL);
+}
+
+static mus_float_t rand_interp_unmodulated_with_distribution(mus_any *ptr)
+{
+ noi *gen = (noi *)ptr;
+ gen->output += gen->incr;
+ if (gen->phase >= TWO_PI)
+ {
+ gen->phase -= TWO_PI;
+ gen->incr = (random_any(gen) - gen->output) / (ceil(TWO_PI / gen->freq));
+ }
+ gen->phase += gen->freq;
+ return(gen->output);
+}
+
+
+static mus_float_t rand_interp_unmodulated(mus_any *ptr)
+{
+ noi *gen = (noi *)ptr;
+ gen->output += gen->incr;
+ gen->phase += gen->freq;
+ if (gen->phase >= TWO_PI)
+ {
+ gen->phase -= TWO_PI;
+ randx = randx * 1103515245 + 12345;
+ gen->incr = ((gen->base * ((mus_float_t)((unsigned int)(randx >> 16) & 32767) * INVERSE_MAX_RAND - 1.0)) - gen->output) * gen->norm;
+ }
+ return(gen->output);
+}
+
+
static mus_float_t run_rand(mus_any *ptr, mus_float_t fm, mus_float_t unused) {return(mus_rand(ptr, fm));}
static mus_float_t run_rand_interp(mus_any *ptr, mus_float_t fm, mus_float_t unused) {return(mus_rand_interp(ptr, fm));}
-bool mus_rand_p(mus_any *ptr)
+bool mus_is_rand(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_RAND));
}
-bool mus_rand_interp_p(mus_any *ptr)
+bool mus_is_rand_interp(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_RAND_INTERP));
}
-static int free_noi(mus_any *ptr) {if (ptr) clm_free(ptr); return(0);}
+static void free_noi(mus_any *ptr) {free(ptr);}
+
+static mus_any *noi_copy(mus_any *ptr)
+{
+ noi *g;
+ g = (noi *)malloc(sizeof(noi));
+ memcpy((void *)g, (void *)ptr, sizeof(noi));
+ /* if ptr->distribution, it comes from elsewhere -- we don't touch it here,
+ * and in clm2xen, we merely wrap it.
+ */
+ return((mus_any *)g);
+}
static mus_float_t noi_freq(mus_any *ptr) {return(mus_radians_to_hz(((noi *)ptr)->freq));}
-static mus_float_t noi_set_freq(mus_any *ptr, mus_float_t val) {((noi *)ptr)->freq = mus_hz_to_radians(val); return(val);}
+static mus_float_t noi_set_freq(mus_any *ptr, mus_float_t val)
+{
+ if (val < 0.0) val = -val;
+ ((noi *)ptr)->freq = mus_hz_to_radians(val);
+ return(val);
+}
+
+static mus_float_t interp_noi_set_freq(mus_any *ptr, mus_float_t val)
+{
+ noi *gen = (noi *)ptr;
+ if (val < 0.0) val = -val;
+ gen->freq = mus_hz_to_radians(val);
+ if (gen->freq != 0.0)
+ gen->norm = 1.0 / (ceil(TWO_PI / gen->freq));
+ return(val);
+}
static mus_float_t noi_increment(mus_any *ptr) {return(((noi *)ptr)->freq);}
static mus_float_t noi_set_increment(mus_any *ptr, mus_float_t val) {((noi *)ptr)->freq = val; return(val);}
+static mus_float_t noi_incr(mus_any *ptr) {return(((noi *)ptr)->incr);}
+static mus_float_t noi_set_incr(mus_any *ptr, mus_float_t val) {((noi *)ptr)->incr = val; return(val);}
+
static mus_float_t noi_phase(mus_any *ptr) {return(fmod(((noi *)ptr)->phase, TWO_PI));}
static mus_float_t noi_set_phase(mus_any *ptr, mus_float_t val) {((noi *)ptr)->phase = val; return(val);}
static mus_float_t noi_scaler(mus_any *ptr) {return(((noi *)ptr)->base);}
-static mus_float_t noi_set_scaler(mus_any *ptr, mus_float_t val) {((noi *)ptr)->base = val; return(val);}
+static mus_float_t noi_set_scaler(mus_any *ptr, mus_float_t val) {((noi *)ptr)->base = val; return(val);} /* rand, not rand-interp */
static mus_float_t *noi_data(mus_any *ptr) {return(((noi *)ptr)->distribution);}
static mus_long_t noi_length(mus_any *ptr) {return(((noi *)ptr)->distribution_size);}
+static mus_float_t randi_set_scaler(mus_any *ptr, mus_float_t val)
+{
+ noi *gen = (noi *)ptr;
+ if (val == 0.0)
+ gen->ran_unmod = zero_unmodulated;
+ else
+ {
+ if (gen->base == 0.0)
+ {
+ if (gen->distribution)
+ gen->ran_unmod = rand_interp_unmodulated_with_distribution;
+ else gen->ran_unmod = rand_interp_unmodulated;
+ }
+ }
+ gen->base = val;
+ return(val);
+}
+
static void noi_reset(mus_any *ptr)
{
noi *gen = (noi *)ptr;
@@ -4457,16 +6733,16 @@ static char *describe_noi(mus_any *ptr)
{
noi *gen = (noi *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- if (mus_rand_p(ptr))
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, amp: %.3f%s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ if (mus_is_rand(ptr))
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, amp: %.3f%s",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
mus_scaler(ptr),
(gen->distribution) ? ", with distribution envelope" : "");
else
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, amp: %.3f, incr: %.3f, curval: %.3f%s",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, amp: %.3f, incr: %.3f, curval: %.3f%s",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
@@ -4478,9 +6754,9 @@ static char *describe_noi(mus_any *ptr)
}
-static mus_any_class RAND_INTERP_CLASS = {
- MUS_RAND_INTERP,
- (char *)S_rand_interp,
+static mus_any_class RAND_CLASS = {
+ MUS_RAND,
+ (char *)S_rand,
&free_noi,
&describe_noi,
&noi_equalp,
@@ -4492,51 +6768,54 @@ static mus_any_class RAND_INTERP_CLASS = {
&noi_set_phase,
&noi_scaler,
&noi_set_scaler,
- &noi_increment, /* (phase increment) */
+ &noi_increment, /* this is the phase increment, not the incr field */
&noi_set_increment,
- &run_rand_interp,
+ &run_rand,
MUS_NOT_SPECIAL,
NULL, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ &noi_incr, &noi_set_incr,
+ 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&noi_reset,
- 0, 0, 0
+ 0, &noi_copy
};
-static mus_any_class RAND_CLASS = {
- MUS_RAND,
- (char *)S_rand,
+static mus_any_class RAND_INTERP_CLASS = {
+ MUS_RAND_INTERP,
+ (char *)S_rand_interp,
&free_noi,
&describe_noi,
&noi_equalp,
&noi_data, 0,
&noi_length, 0,
&noi_freq,
- &noi_set_freq,
+ &interp_noi_set_freq,
&noi_phase,
&noi_set_phase,
&noi_scaler,
- &noi_set_scaler,
- &noi_increment, /* (phase increment) */
+ &randi_set_scaler,
+ &noi_increment, /* phase increment, not incr field */
&noi_set_increment,
- &run_rand,
+ &run_rand_interp,
MUS_NOT_SPECIAL,
NULL, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ &noi_incr, &noi_set_incr, /* incr field == mus_offset method */
+ 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&noi_reset,
- 0, 0, 0
+ 0, &noi_copy
};
mus_any *mus_make_rand(mus_float_t freq, mus_float_t base)
{
noi *gen;
- gen = (noi *)clm_calloc(1, sizeof(noi), S_make_rand);
+ gen = (noi *)calloc(1, sizeof(noi));
gen->core = &RAND_CLASS;
+ if (freq < 0.0) freq = -freq;
gen->freq = mus_hz_to_radians(freq);
gen->base = base;
gen->incr = 0.0;
@@ -4545,26 +6824,32 @@ mus_any *mus_make_rand(mus_float_t freq, mus_float_t base)
}
-mus_any *mus_make_rand_interp(mus_float_t freq, mus_float_t base)
+mus_any *mus_make_rand_with_distribution(mus_float_t freq, mus_float_t base, mus_float_t *distribution, int distribution_size)
{
noi *gen;
- gen = (noi *)clm_calloc(1, sizeof(noi), S_make_rand_interp);
- gen->core = &RAND_INTERP_CLASS;
- gen->freq = mus_hz_to_radians(freq);
- gen->base = base;
- gen->incr = mus_random(base) * freq / sampling_rate;
- gen->output = 0.0;
+ gen = (noi *)mus_make_rand(freq, base);
+ gen->distribution = distribution;
+ gen->distribution_size = distribution_size;
+ gen->output = random_any(gen);
return((mus_any *)gen);
}
-mus_any *mus_make_rand_with_distribution(mus_float_t freq, mus_float_t base, mus_float_t *distribution, int distribution_size)
+mus_any *mus_make_rand_interp(mus_float_t freq, mus_float_t base)
{
noi *gen;
- gen = (noi *)mus_make_rand(freq, base);
- gen->distribution = distribution;
- gen->distribution_size = distribution_size;
- gen->output = random_any(gen);
+ gen = (noi *)calloc(1, sizeof(noi));
+ gen->core = &RAND_INTERP_CLASS;
+ /* gen->distribution = NULL; */
+ if (freq < 0.0) freq = -freq;
+ gen->freq = mus_hz_to_radians(freq);
+ gen->base = base;
+ gen->incr = mus_random(base) * freq / sampling_rate;
+ gen->output = 0.0;
+ if (gen->freq != 0.0)
+ gen->norm = 1.0 / (ceil(TWO_PI / gen->freq));
+ else gen->norm = 1.0;
+ gen->ran_unmod = ((base == 0.0) ? zero_unmodulated : rand_interp_unmodulated);
return((mus_any *)gen);
}
@@ -4575,6 +6860,7 @@ mus_any *mus_make_rand_interp_with_distribution(mus_float_t freq, mus_float_t ba
gen = (noi *)mus_make_rand_interp(freq, base);
gen->distribution = distribution;
gen->distribution_size = distribution_size;
+ gen->ran_unmod = ((base == 0.0) ? zero_unmodulated : rand_interp_unmodulated_with_distribution);
return((mus_any *)gen);
}
@@ -4590,10 +6876,14 @@ typedef struct {
} smpflt;
-static int free_smpflt(mus_any *ptr)
+static void free_smpflt(mus_any *ptr) {free(ptr);}
+
+static mus_any *smpflt_copy(mus_any *ptr)
{
- if (ptr) clm_free(ptr);
- return(0);
+ smpflt *g;
+ g = (smpflt *)malloc(sizeof(smpflt));
+ memcpy((void *)g, (void *)ptr, sizeof(smpflt));
+ return((mus_any *)g);
}
@@ -4619,29 +6909,29 @@ static char *describe_smpflt(mus_any *ptr)
{
smpflt *gen = (smpflt *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
switch (gen->core->type)
{
case MUS_ONE_ZERO:
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s a0: %.3f, a1: %.3f, x1: %.3f",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s a0: %.3f, a1: %.3f, x1: %.3f",
mus_name(ptr),
gen->xs[0], gen->xs[1], gen->x1);
break;
case MUS_ONE_POLE:
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s a0: %.3f, b1: %.3f, y1: %.3f",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s a0: %.3f, b1: %.3f, y1: %.3f",
mus_name(ptr),
gen->xs[0], gen->ys[1], gen->y1);
break;
case MUS_TWO_ZERO:
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s a0: %.3f, a1: %.3f, a2: %.3f, x1: %.3f, x2: %.3f",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s a0: %.3f, a1: %.3f, a2: %.3f, x1: %.3f, x2: %.3f",
mus_name(ptr),
gen->xs[0], gen->xs[1], gen->xs[2], gen->x1, gen->x2);
break;
case MUS_TWO_POLE:
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s a0: %.3f, b1: %.3f, b2: %.3f, y1: %.3f, y2: %.3f",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s a0: %.3f, b1: %.3f, b2: %.3f, y1: %.3f, y2: %.3f",
mus_name(ptr),
gen->xs[0], gen->ys[1], gen->ys[2], gen->y1, gen->y2);
break;
@@ -4674,6 +6964,7 @@ static mus_float_t smp_set_ycoeff(mus_any *ptr, int index, mus_float_t val) {((s
static mus_float_t *smp_xcoeffs(mus_any *ptr) {return(((smpflt *)ptr)->xs);}
static mus_float_t *smp_ycoeffs(mus_any *ptr) {return(((smpflt *)ptr)->ys);}
+static void smp_scl(mus_any *ptr, mus_float_t scl) {smpflt *g = (smpflt *)ptr; g->xs[0] *= scl; g->xs[1] *= scl;}
static void smpflt_reset(mus_any *ptr)
{
@@ -4705,16 +6996,16 @@ static mus_any_class ONE_ZERO_CLASS = {
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
0, 0,
- &smp_xcoeffs, &smp_ycoeffs, 0,
+ &smp_xcoeffs, &smp_ycoeffs,
&smpflt_reset,
- 0, 0, 0
+ 0, &smpflt_copy
};
mus_any *mus_make_one_zero(mus_float_t a0, mus_float_t a1)
{
smpflt *gen;
- gen = (smpflt *)clm_calloc_atomic(1, sizeof(smpflt), S_make_one_zero);
+ gen = (smpflt *)calloc(1, sizeof(smpflt));
gen->core = &ONE_ZERO_CLASS;
gen->xs[0] = a0;
gen->xs[1] = a1;
@@ -4722,7 +7013,7 @@ mus_any *mus_make_one_zero(mus_float_t a0, mus_float_t a1)
}
-bool mus_one_zero_p(mus_any *ptr)
+bool mus_is_one_zero(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_ONE_ZERO));
@@ -4736,6 +7027,7 @@ mus_float_t mus_one_pole(mus_any *ptr, mus_float_t input)
return(gen->y1);
}
+/* incrementer: (make-one-pole 1.0 -1.0) */
static mus_float_t run_one_pole(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_one_pole(ptr, input));}
@@ -4758,16 +7050,16 @@ static mus_any_class ONE_POLE_CLASS = {
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
&smp_ycoeff, &smp_set_ycoeff,
- &smp_xcoeffs, &smp_ycoeffs, 0,
+ &smp_xcoeffs, &smp_ycoeffs,
&smpflt_reset,
- 0, 0, 0
+ 0, &smpflt_copy
};
mus_any *mus_make_one_pole(mus_float_t a0, mus_float_t b1)
{
smpflt *gen;
- gen = (smpflt *)clm_calloc_atomic(1, sizeof(smpflt), S_make_one_pole);
+ gen = (smpflt *)calloc(1, sizeof(smpflt));
gen->core = &ONE_POLE_CLASS;
gen->xs[0] = a0;
gen->ys[1] = b1;
@@ -4775,7 +7067,7 @@ mus_any *mus_make_one_pole(mus_float_t a0, mus_float_t b1)
}
-bool mus_one_pole_p(mus_any *ptr)
+bool mus_is_one_pole(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_ONE_POLE));
@@ -4847,16 +7139,16 @@ static mus_any_class TWO_ZERO_CLASS = {
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
0, 0,
- &smp_xcoeffs, &smp_ycoeffs, 0,
+ &smp_xcoeffs, &smp_ycoeffs,
&smpflt_reset,
- 0, 0, 0
+ 0, &smpflt_copy
};
mus_any *mus_make_two_zero(mus_float_t a0, mus_float_t a1, mus_float_t a2)
{
smpflt *gen;
- gen = (smpflt *)clm_calloc_atomic(1, sizeof(smpflt), S_make_two_zero);
+ gen = (smpflt *)calloc(1, sizeof(smpflt));
gen->core = &TWO_ZERO_CLASS;
gen->xs[0] = a0;
gen->xs[1] = a1;
@@ -4865,7 +7157,7 @@ mus_any *mus_make_two_zero(mus_float_t a0, mus_float_t a1, mus_float_t a2)
}
-bool mus_two_zero_p(mus_any *ptr)
+bool mus_is_two_zero(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_TWO_ZERO));
@@ -4943,43 +7235,25 @@ static mus_any_class TWO_POLE_CLASS = {
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
&smp_ycoeff, &smp_set_ycoeff,
- &smp_xcoeffs, &smp_ycoeffs, 0,
+ &smp_xcoeffs, &smp_ycoeffs,
&smpflt_reset,
- 0, 0, 0
+ 0, &smpflt_copy
};
mus_any *mus_make_two_pole(mus_float_t a0, mus_float_t b1, mus_float_t b2)
{
- if (fabs(b1) >= 2.0)
- mus_error(MUS_UNSTABLE_TWO_POLE_ERROR, S_make_two_pole ": b1 = %.3f", b1);
- else
- {
- if (fabs(b2) >= 1.0)
- mus_error(MUS_UNSTABLE_TWO_POLE_ERROR, S_make_two_pole ": b2 = %.3f", b2);
- else
- {
- if ( ((b1 * b1) - (b2 * 4.0) >= 0.0) &&
- ( ((b1 + b2) >= 1.0) ||
- ((b2 - b1) >= 1.0)))
- mus_error(MUS_UNSTABLE_TWO_POLE_ERROR, S_make_two_pole ": b1 = %.3f, b2 = %.3f", b1, b2);
- else
- {
- smpflt *gen;
- gen = (smpflt *)clm_calloc_atomic(1, sizeof(smpflt), S_make_two_pole);
- gen->core = &TWO_POLE_CLASS;
- gen->xs[0] = a0;
- gen->ys[1] = b1;
- gen->ys[2] = b2;
- return((mus_any *)gen);
- }
- }
- }
- return(NULL);
+ smpflt *gen;
+ gen = (smpflt *)calloc(1, sizeof(smpflt));
+ gen->core = &TWO_POLE_CLASS;
+ gen->xs[0] = a0;
+ gen->ys[1] = b1;
+ gen->ys[2] = b2;
+ return((mus_any *)gen);
}
-bool mus_two_pole_p(mus_any *ptr)
+bool mus_is_two_pole(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_TWO_POLE));
@@ -5003,14 +7277,19 @@ typedef struct {
} frm;
-static int free_frm(mus_any *ptr)
+static void free_frm(mus_any *ptr) {free(ptr);}
+
+
+static mus_any *frm_copy(mus_any *ptr)
{
- if (ptr) clm_free(ptr);
- return(0);
+ frm *g;
+ g = (frm *)malloc(sizeof(frm));
+ memcpy((void *)g, (void *)ptr, sizeof(frm));
+ return((mus_any *)g);
}
-bool mus_formant_p(mus_any *ptr)
+bool mus_is_formant(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_FORMANT));
@@ -5046,8 +7325,8 @@ static char *describe_formant(mus_any *ptr)
{
frm *gen = (frm *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s frequency: %.3f, radius: %.3f",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s frequency: %.3f, radius: %.3f",
mus_name(ptr),
mus_radians_to_hz(gen->frequency),
gen->radius);
@@ -5072,16 +7351,6 @@ mus_float_t mus_formant(mus_any *ptr, mus_float_t input)
static mus_float_t run_formant(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_formant(ptr, input));}
-mus_float_t mus_formant_bank(mus_float_t *amps, mus_any **formants, mus_float_t inval, int size)
-{
- int i;
- mus_float_t sum = 0.0;
- for (i = 0; i < size; i++)
- sum += (amps[i] * mus_formant(formants[i], inval));
- return(sum);
-}
-
-
static void mus_set_formant_radius_and_frequency_in_radians(mus_any *ptr, mus_float_t radius, mus_float_t freq_in_radians)
{
frm *gen = (frm *)ptr;
@@ -5101,7 +7370,7 @@ void mus_set_formant_radius_and_frequency(mus_any *ptr, mus_float_t radius, mus_
static mus_float_t formant_frequency(mus_any *ptr) {return(mus_radians_to_hz(((frm *)ptr)->frequency));}
-static mus_float_t formant_set_frequency(mus_any *ptr, mus_float_t freq_in_hz)
+mus_float_t mus_set_formant_frequency(mus_any *ptr, mus_float_t freq_in_hz)
{
frm *gen = (frm *)ptr;
mus_float_t fw;
@@ -5115,8 +7384,11 @@ static mus_float_t formant_set_frequency(mus_any *ptr, mus_float_t freq_in_hz)
mus_float_t mus_formant_with_frequency(mus_any *ptr, mus_float_t input, mus_float_t freq_in_radians)
{
frm *gen = (frm *)ptr;
- gen->frequency = freq_in_radians;
- gen->fdbk = 2.0 * gen->radius * cos(freq_in_radians);
+ if (gen->frequency != freq_in_radians)
+ {
+ gen->frequency = freq_in_radians;
+ gen->fdbk = 2.0 * gen->radius * cos(freq_in_radians);
+ }
return(mus_formant(ptr, input));
}
@@ -5138,7 +7410,7 @@ static mus_any_class FORMANT_CLASS = {
&frm_equalp,
0, 0,
&two_length, 0,
- &formant_frequency, &formant_set_frequency,
+ &formant_frequency, &mus_set_formant_frequency,
0, 0,
&formant_radius, &formant_set_radius,
0, 0,
@@ -5149,2050 +7421,2859 @@ static mus_any_class FORMANT_CLASS = {
0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&frm_reset,
- 0, 0, 0
+ 0, &frm_copy
};
mus_any *mus_make_formant(mus_float_t frequency, mus_float_t radius)
{
frm *gen;
- gen = (frm *)clm_calloc_atomic(1, sizeof(frm), S_make_formant);
+ gen = (frm *)calloc(1, sizeof(frm));
gen->core = &FORMANT_CLASS;
mus_set_formant_radius_and_frequency((mus_any *)gen, radius, frequency);
return((mus_any *)gen);
}
+/* ---------------- formant-bank ---------------- */
-/* ---------------- firmant ---------------- */
+typedef struct {
+ mus_any_class *core;
+ int size, mctr;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *amps, *rr, *fdbk, *gain;
+ mus_float_t c1, c2;
+ mus_float_t (*one_input)(mus_any *fbank, mus_float_t inval);
+ mus_float_t (*many_inputs)(mus_any *fbank, mus_float_t *inval);
+} frm_bank;
-static char *describe_firmant(mus_any *ptr)
+
+static void free_formant_bank(mus_any *ptr)
{
- frm *gen = (frm *)ptr;
- char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s frequency: %.3f, radius: %.3f",
- mus_name(ptr),
- mus_radians_to_hz(gen->frequency),
- gen->radius);
- return(describe_buffer);
+ frm_bank *f = (frm_bank *)ptr;
+ if (f->x0) {free(f->x0); f->x0 = NULL;}
+ if (f->x1) {free(f->x1); f->x1 = NULL;}
+ if (f->x2) {free(f->x2); f->x2 = NULL;}
+ if (f->y0) {free(f->y0); f->y0 = NULL;}
+ if (f->y1) {free(f->y1); f->y1 = NULL;}
+ if (f->y2) {free(f->y2); f->y2 = NULL;}
+ if (f->rr) {free(f->rr); f->rr = NULL;}
+ if (f->fdbk) {free(f->fdbk); f->fdbk = NULL;}
+ if (f->gain) {free(f->gain); f->gain = NULL;}
+ free(ptr);
}
-static mus_float_t firmant_frequency(mus_any *ptr) {return(mus_radians_to_hz(((frm *)ptr)->frequency));}
+static mus_any *frm_bank_copy(mus_any *ptr)
+{
+ frm_bank *g, *p;
+ int bytes;
-static mus_float_t firmant_set_frequency(mus_any *ptr, mus_float_t freq_in_hz)
+ p = (frm_bank *)ptr;
+ g = (frm_bank *)malloc(sizeof(frm_bank));
+ memcpy((void *)g, (void *)ptr, sizeof(frm_bank));
+ bytes = g->size * sizeof(mus_float_t);
+
+ g->x0 = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->x0), (void *)(p->x0), bytes);
+ g->x1 = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->x1), (void *)(p->x1), bytes);
+ g->x2 = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->x2), (void *)(p->x2), bytes);
+ g->y0 = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->y0), (void *)(p->y0), bytes);
+ g->y1 = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->y1), (void *)(p->y1), bytes);
+ g->y2 = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->y2), (void *)(p->y2), bytes);
+
+ g->rr = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->rr), (void *)(p->rr), bytes);
+ g->fdbk = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->fdbk), (void *)(p->fdbk), bytes);
+ g->gain = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->gain), (void *)(p->gain), bytes);
+
+ return((mus_any *)g);
+}
+
+static mus_float_t run_formant_bank(mus_any *ptr, mus_float_t input, mus_float_t unused)
{
- frm *gen = (frm *)ptr;
- mus_float_t fw;
- fw = mus_hz_to_radians(freq_in_hz);
- gen->frequency = fw;
- gen->fdbk = 2.0 * sin(gen->frequency * 0.5);
- return(freq_in_hz);
+ return(mus_formant_bank(ptr, input));
}
-static mus_float_t firmant_radius(mus_any *ptr) {return(((frm *)ptr)->radius);}
-static mus_float_t firmant_set_radius(mus_any *ptr, mus_float_t radius)
+static mus_long_t formant_bank_length(mus_any *ptr)
{
- frm *gen = (frm *)ptr;
- gen->radius = radius;
- gen->gain = 1.0 - radius * radius;
- return(radius);
+ return(((frm_bank *)ptr)->size);
}
-bool mus_firmant_p(mus_any *ptr)
+static void formant_bank_reset(mus_any *ptr)
{
- return((ptr) &&
- (ptr->core->type == MUS_FIRMANT));
+ frm_bank *f = (frm_bank *)ptr;
+ int size;
+ size = f->size * sizeof(mus_float_t);
+ memset((void *)(f->x0), 0, size);
+ memset((void *)(f->x1), 0, size);
+ memset((void *)(f->x2), 0, size);
+ memset((void *)(f->y0), 0, size);
+ memset((void *)(f->y1), 0, size);
+ memset((void *)(f->y2), 0, size);
}
-mus_float_t mus_firmant(mus_any *ptr, mus_float_t input)
+static bool formant_bank_equalp(mus_any *p1, mus_any *p2)
{
- frm *gen = (frm *)ptr;
- mus_float_t xn1, yn1;
- xn1 = gen->gain * input + gen->radius * (gen->x1 - gen->fdbk * gen->y1);
- yn1 = gen->radius * (gen->fdbk * xn1 + gen->y1);
- gen->x1 = xn1;
- gen->y1 = yn1;
- return(yn1);
+ frm_bank *f1 = (frm_bank *)p1;
+ frm_bank *f2 = (frm_bank *)p2;
+#if 0
+ int i, size;
+#endif
+ if (f1 == f2) return(true);
+ if (f1->size != f2->size) return(false);
+#if 0
+ size = f1->size;
+ for (i = 0; i < size; i++)
+ if (!frm_equalp(f1->gens[i], f2->gens[i]))
+ return(false);
+#endif
+ /* now check the locals... */
+ return(true);
}
-mus_float_t mus_firmant_with_frequency(mus_any *ptr, mus_float_t input, mus_float_t freq_in_radians)
+static char *describe_formant_bank(mus_any *ptr)
{
- frm *gen = (frm *)ptr;
- gen->frequency = freq_in_radians;
- gen->fdbk = 2.0 * sin(gen->frequency * 0.5);
- return(mus_firmant(ptr, input));
+ frm_bank *gen = (frm_bank *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %d", mus_name(ptr), gen->size);
+ return(describe_buffer);
}
-static mus_float_t run_firmant(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_firmant(ptr, input));}
-
+mus_float_t mus_formant_bank(mus_any *fbank, mus_float_t inval)
+{
+ frm_bank *bank = (frm_bank *)fbank;
+ return(bank->one_input(fbank, inval));
+}
-static mus_any_class FIRMANT_CLASS = {
- MUS_FIRMANT,
- (char *)S_firmant,
- &free_frm,
- &describe_firmant,
- &frm_equalp,
- 0, 0,
- &two_length, 0,
- &firmant_frequency, &firmant_set_frequency,
- 0, 0,
- &firmant_radius, &firmant_set_radius,
- 0, 0,
- &run_firmant,
- MUS_SIMPLE_FILTER,
- NULL, 0,
- 0, 0, 0, 0,
- 0, 0,
- 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
- &frm_reset,
- 0, 0, 0
-};
+mus_float_t mus_formant_bank_with_inputs(mus_any *fbank, mus_float_t *inval)
+{
+ frm_bank *bank = (frm_bank *)fbank;
+ return(bank->many_inputs(fbank, inval));
+}
-mus_any *mus_make_firmant(mus_float_t frequency, mus_float_t radius)
+static mus_float_t fb_one_with_amps(mus_any *fbank, mus_float_t inval)
{
- frm *gen;
- gen = (frm *)clm_calloc_atomic(1, sizeof(frm), S_make_firmant);
- gen->core = &FIRMANT_CLASS;
- gen->frequency = mus_hz_to_radians(frequency);
- gen->radius = radius;
- gen->fdbk = 2.0 * sin(gen->frequency * 0.5);
- gen->gain = 1.0 - radius * radius;
- return((mus_any *)gen);
-}
+ frm_bank *bank = (frm_bank *)fbank;
+ int i, size4;
+ mus_float_t sum = 0.0;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *amps, *rr, *fdbk, *gain;
+
+ x0 = bank->x0;
+ x1 = bank->x1;
+ x2 = bank->x2;
+ y0 = bank->y0;
+ y1 = bank->y1;
+ y2 = bank->y2;
+ rr = bank->rr;
+ fdbk = bank->fdbk;
+ gain = bank->gain;
+ amps = bank->amps;
+ size4 = bank->size - 4;
+
+ i = 0;
+ while (i <= size4)
+ {
+ x0[i] = gain[i] * inval;
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr[i] * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ x0[i] = gain[i] * inval;
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr[i] * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ x0[i] = gain[i] * inval;
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr[i] * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ x0[i] = gain[i] * inval;
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr[i] * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+ }
+ for (; i < bank->size; i++)
+ {
+ x0[i] = gain[i] * inval;
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr[i] * y2[i]);
+ sum += amps[i] * y0[i];
+ }
+ bank->x2 = x1;
+ bank->x1 = x0;
+ bank->x0 = x2;
+ bank->y2 = y1;
+ bank->y1 = y0;
+ bank->y0 = y2;
+ return(sum);
+}
-/* ---------------- filter ---------------- */
+static mus_float_t fb_one_without_amps(mus_any *fbank, mus_float_t inval)
+{
+ frm_bank *bank = (frm_bank *)fbank;
+ int i;
+ mus_float_t sum = 0.0;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *rr, *fdbk, *gain;
+
+ x0 = bank->x0;
+ x1 = bank->x1;
+ x2 = bank->x2;
+ y0 = bank->y0;
+ y1 = bank->y1;
+ y2 = bank->y2;
+ rr = bank->rr;
+ fdbk = bank->fdbk;
+ gain = bank->gain;
+
+ for (i = 0; i < bank->size; i++)
+ {
+ x0[i] = gain[i] * inval;
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr[i] * y2[i]);
+ sum += y0[i];
+ }
-typedef struct {
- mus_any_class *core;
- int order, allocated_size;
- bool state_allocated;
- mus_float_t *x, *y, *state;
-} flt;
+ bank->x2 = x1;
+ bank->x1 = x0;
+ bank->x0 = x2;
-/* handling symmetric coeffs to reduce multiplies was actually slower than the normal form */
+ bank->y2 = y1;
+ bank->y1 = y0;
+ bank->y0 = y2;
+ return(sum);
+}
-mus_float_t mus_filter(mus_any *ptr, mus_float_t input)
+static mus_float_t fb_many_with_amps(mus_any *fbank, mus_float_t *inval)
{
- flt *gen = (flt *)ptr;
- mus_float_t xout = 0.0;
- mus_float_t *xp, *yp, *dp, *d, *dprev;
+ frm_bank *bank = (frm_bank *)fbank;
+ int i;
+ mus_float_t sum = 0.0;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *amps, *rr, *fdbk, *gain;
+
+ x0 = bank->x0;
+ x1 = bank->x1;
+ x2 = bank->x2;
+ y0 = bank->y0;
+ y1 = bank->y1;
+ y2 = bank->y2;
+ rr = bank->rr;
+ fdbk = bank->fdbk;
+ gain = bank->gain;
+ amps = bank->amps;
+
+ for (i = 0; i < bank->size; i++)
+ {
+ x0[i] = gain[i] * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr[i] * y2[i]);
+ sum += amps[i] * y0[i];
+ }
+
+ bank->x2 = x1;
+ bank->x1 = x0;
+ bank->x0 = x2;
- if (!(gen->y)) return(mus_fir_filter(ptr, input));
- if (!(gen->x)) return(mus_iir_filter(ptr, input));
+ bank->y2 = y1;
+ bank->y1 = y0;
+ bank->y0 = y2;
- xp = (mus_float_t *)(gen->x + gen->order - 1);
- yp = (mus_float_t *)(gen->y + gen->order - 1);
- dp = (mus_float_t *)(gen->state + gen->order - 1);
- d = gen->state;
+ return(sum);
+}
- d[0] = input;
- while (dp > d)
+static mus_float_t fb_many_without_amps(mus_any *fbank, mus_float_t *inval)
+{
+ frm_bank *bank = (frm_bank *)fbank;
+ int i;
+ mus_float_t sum = 0.0;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *rr, *fdbk, *gain;
+
+ x0 = bank->x0;
+ x1 = bank->x1;
+ x2 = bank->x2;
+ y0 = bank->y0;
+ y1 = bank->y1;
+ y2 = bank->y2;
+ rr = bank->rr;
+ fdbk = bank->fdbk;
+ gain = bank->gain;
+
+ for (i = 0; i < bank->size; i++)
{
- xout += (*dp) * (*xp--);
- d[0] -= (*dp) * (*yp--);
- dprev = dp--;
- (*dprev) = (*dp);
+ x0[i] = gain[i] * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr[i] * y2[i]);
+ sum += y0[i];
}
- return(xout + (d[0] * (*xp)));
-}
+ bank->x2 = x1;
+ bank->x1 = x0;
+ bank->x0 = x2;
-mus_float_t mus_fir_filter(mus_any *ptr, mus_float_t input)
+ bank->y2 = y1;
+ bank->y1 = y0;
+ bank->y0 = y2;
+
+ return(sum);
+}
+
+static mus_float_t fb_one_with_amps_c1_c2(mus_any *fbank, mus_float_t inval)
{
- mus_float_t xout = 0.0;
- flt *gen = (flt *)ptr;
- mus_float_t *ap, *dp, *d, *dprev;
+ frm_bank *bank = (frm_bank *)fbank;
+ int i, size4;
+ mus_float_t sum = 0.0, rr, gain;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *amps, *fdbk;
+
+ x0 = bank->x0;
+ x1 = bank->x1;
+ x2 = bank->x2;
+ y0 = bank->y0;
+ y1 = bank->y1;
+ y2 = bank->y2;
+ fdbk = bank->fdbk;
+ amps = bank->amps;
+ size4 = bank->size - 4;
- ap = (mus_float_t *)(gen->x + gen->order - 1);
- dp = (mus_float_t *)(gen->state + gen->order - 1);
- d = gen->state;
+ bank->mctr++;
- (*d) = input;
- while (dp > d)
+ rr = bank->c1;
+ gain = (bank->c2 * inval);
+ x0[0] = gain;
+
+ if (bank->mctr < 3)
+ {
+ i = 0;
+ while (i <= size4)
+ {
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+ /* in isolation this looks like the x0[i]-x2[i] business could be handled outside the loop
+ * by a single float, but formant-bank can be called in the same do-loop both with and
+ * without multiple inputs, so fb_one has to be completely compatible sample-by-sample
+ * with fb_many. Since we can't predict here when we'll need bank->x2, we can't collapse
+ * this calculation.
+ *
+ * If we know we've had 2 fb_one calls just before this one, then x2[i] are all the same,
+ * x0[i] will all be the same in this loop, so x0[i] - x2[i] can be collapsed, but
+ * we still need to set x0[0]=gain: enter mctr.
+ *
+ * So in the current case, we can save x0[0]=gain -> x1 -> x2, then in fm_many
+ * mctr=1 -- x2 is ok, x1[0] needs to be propogated
+ * mctr>1 -- x2 and x1 need propogation
+ * On the other side, if mctr>=3, then x2[i] was not set, so don't access it.
+ */
+
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+ }
+ for (; i < bank->size; i++)
+ {
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ }
+ }
+ else
{
- xout += (*dp) * (*ap--);
- dprev = dp--;
- (*dprev) = (*dp);
+ mus_float_t g2;
+ g2 = gain - x2[0];
+ i = 0;
+ while (i <= size4)
+ {
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+ }
+ for (; i < bank->size; i++)
+ {
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ }
}
- return(xout + (input * (*ap)));
-}
+ bank->x2 = x1;
+ bank->x1 = x0;
+ bank->x0 = x2;
-mus_float_t mus_iir_filter(mus_any *ptr, mus_float_t input)
+ bank->y2 = y1;
+ bank->y1 = y0;
+ bank->y0 = y2;
+
+ return(sum);
+}
+
+static mus_float_t fb_many_with_amps_c1_c2(mus_any *fbank, mus_float_t *inval)
{
- flt *gen = (flt *)ptr;
- mus_float_t *ap, *dp, *d, *dprev;
+ frm_bank *bank = (frm_bank *)fbank;
+ int i, size4;
+ mus_float_t sum = 0.0, rr, gain;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *amps, *fdbk;
- ap = (mus_float_t *)(gen->y + gen->order - 1);
- dp = (mus_float_t *)(gen->state + gen->order - 1);
- d = gen->state;
+ x0 = bank->x0;
+ x1 = bank->x1;
+ x2 = bank->x2;
+ y0 = bank->y0;
+ y1 = bank->y1;
+ y2 = bank->y2;
+ fdbk = bank->fdbk;
+ amps = bank->amps;
+ size4 = bank->size - 4;
+
+ if (bank->mctr > 0)
+ {
+ if (bank->mctr == 1)
+ {
+ for (i = 1; i < bank->size; i++) x1[i] = x1[0];
+ }
+ else
+ {
+ for (i = 1; i < bank->size; i++) {x1[i] = x1[0]; x2[i] = x2[0];}
+ }
+ bank->mctr = 0;
+ }
+ rr = bank->c1;
+ gain = bank->c2;
- (*d) = input;
- while (dp > d)
+ i = 0;
+ while (i <= size4)
{
- (*d) -= (*dp) * (*ap--);
- dprev = dp--;
- (*dprev) = (*dp);
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
+ i++;
+ }
+ for (; i < bank->size; i++)
+ {
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += amps[i] * y0[i];
}
- return(*d);
-}
-static mus_float_t run_filter(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_filter(ptr, input));}
-static mus_float_t run_fir_filter(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_fir_filter(ptr, input));}
-static mus_float_t run_iir_filter(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_iir_filter(ptr, input));}
+ bank->x2 = x1;
+ bank->x1 = x0;
+ bank->x0 = x2;
+ bank->y2 = y1;
+ bank->y1 = y0;
+ bank->y0 = y2;
-bool mus_filter_p(mus_any *ptr)
-{
- return((ptr) &&
- ((ptr->core->type == MUS_FILTER) ||
- (ptr->core->type == MUS_FIR_FILTER) ||
- (ptr->core->type == MUS_IIR_FILTER)));
+ return(sum);
}
-bool mus_fir_filter_p(mus_any *ptr)
+static mus_float_t fb_one_without_amps_c1_c2(mus_any *fbank, mus_float_t inval)
{
- return((ptr) &&
- (ptr->core->type == MUS_FIR_FILTER));
-}
-
-bool mus_iir_filter_p(mus_any *ptr)
-{
- return((ptr) &&
- (ptr->core->type == MUS_IIR_FILTER));
-}
+ frm_bank *bank = (frm_bank *)fbank;
+ int i, size4;
+ mus_float_t sum = 0.0, rr, gain;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *fdbk;
+ x0 = bank->x0;
+ x1 = bank->x1;
+ x2 = bank->x2;
+ y0 = bank->y0;
+ y1 = bank->y1;
+ y2 = bank->y2;
+ fdbk = bank->fdbk;
+ size4 = bank->size - 4;
-static mus_float_t *filter_data(mus_any *ptr) {return(((flt *)ptr)->state);}
-static mus_long_t filter_length(mus_any *ptr) {return(((flt *)ptr)->order);}
-
-static mus_float_t *filter_xcoeffs(mus_any *ptr) {return(((flt *)ptr)->x);}
-static mus_float_t *filter_ycoeffs(mus_any *ptr) {return(((flt *)ptr)->y);}
+ bank->mctr++;
+ rr = bank->c1;
+ gain = (bank->c2 * inval);
+ x0[0] = gain;
-mus_float_t *mus_filter_set_xcoeffs(mus_any *ptr, mus_float_t *new_data)
-{
- /* needed by Snd if filter order increased during play */
- flt *gen = (flt *)ptr;
- mus_float_t *old_data;
- old_data = gen->x;
- gen->x = new_data;
- return(old_data);
-}
+ if (bank->mctr < 3)
+ {
+ i = 0;
+ while (i <= size4)
+ {
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+ }
+ for (; i < bank->size; i++)
+ {
+ y0[i] = gain - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ }
+ }
+ else
+ {
+ mus_float_t g2;
+ g2 = gain - x2[0];
+ i = 0;
+ while (i <= size4)
+ {
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+ }
+ for (; i < bank->size; i++)
+ {
+ y0[i] = g2 + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ }
+ }
+ bank->x2 = x1;
+ bank->x1 = x0;
+ bank->x0 = x2;
-mus_float_t *mus_filter_set_ycoeffs(mus_any *ptr, mus_float_t *new_data)
-{
- flt *gen = (flt *)ptr;
- mus_float_t *old_data;
- old_data = gen->y;
- gen->y = new_data;
- return(old_data);
+ bank->y2 = y1;
+ bank->y1 = y0;
+ bank->y0 = y2;
+
+ return(sum);
}
-static mus_long_t filter_set_length(mus_any *ptr, mus_long_t val)
+static mus_float_t fb_many_without_amps_c1_c2(mus_any *fbank, mus_float_t *inval)
{
- /* just resets order if order < allocated size */
- flt *gen = (flt *)ptr;
- if ((val > 0) && (val <= gen->allocated_size))
- gen->order = (int)val;
- return((mus_long_t)(gen->order));
-}
+ frm_bank *bank = (frm_bank *)fbank;
+ int i, size4;
+ mus_float_t sum = 0.0, rr, gain;
+ mus_float_t *x0, *x1, *x2, *y0, *y1, *y2, *fdbk;
+ x0 = bank->x0;
+ x1 = bank->x1;
+ x2 = bank->x2;
+ y0 = bank->y0;
+ y1 = bank->y1;
+ y2 = bank->y2;
+ fdbk = bank->fdbk;
+ size4 = bank->size - 4;
-int mus_filter_set_order(mus_any *ptr, int order)
-{
- /* resets order and fixes state array if needed (coeffs arrays should be handled separately by set_x|ycoeffs above) */
- /* returns either old order or -1 if state array can't be reallocated */
- flt *gen = (flt *)ptr;
- int old_order;
- if ((order > gen->allocated_size) &&
- (!(gen->state_allocated)))
- return(-1);
- old_order = gen->order;
- gen->order = order;
- if (order > gen->allocated_size)
+ if (bank->mctr > 0)
{
- int i;
- gen->allocated_size = order;
- gen->state = (mus_float_t *)clm_realloc(gen->state, order * sizeof(mus_float_t));
- for (i = old_order; i < order; i++)
- gen->state[i] = 0.0; /* try to minimize click */
+ if (bank->mctr == 1)
+ {
+ for (i = 1; i < bank->size; i++) x1[i] = x1[0];
+ }
+ else
+ {
+ for (i = 1; i < bank->size; i++) {x1[i] = x1[0]; x2[i] = x2[0];}
+ }
+ bank->mctr = 0;
}
- return(old_order);
-}
-
-
-static mus_float_t filter_xcoeff(mus_any *ptr, int index)
-{
- flt *gen = (flt *)ptr;
- if (!(gen->x)) return((mus_float_t)mus_error(MUS_NO_XCOEFFS, "no xcoeffs"));
- if ((index >= 0) && (index < gen->order))
- return(gen->x[index]);
- return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE, S_mus_xcoeff ": invalid index %d, order = %d?", index, gen->order));
-}
+ rr = bank->c1;
+ gain = bank->c2;
-static mus_float_t filter_set_xcoeff(mus_any *ptr, int index, mus_float_t val)
-{
- flt *gen = (flt *)ptr;
- if (!(gen->x)) return((mus_float_t)mus_error(MUS_NO_XCOEFFS, "no xcoeffs"));
- if ((index >= 0) && (index < gen->order))
+ i = 0;
+ while (i <= size4)
{
- gen->x[index] = val;
- return(val);
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
+ i++;
+ }
+ for (; i < bank->size; i++)
+ {
+ x0[i] = gain * inval[i];
+ y0[i] = x0[i] - x2[i] + (fdbk[i] * y1[i]) - (rr * y2[i]);
+ sum += y0[i];
}
- return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE, S_setB S_mus_xcoeff ": invalid index %d, order = %d?", index, gen->order));
-}
+ bank->x2 = x1;
+ bank->x1 = x0;
+ bank->x0 = x2;
-static mus_float_t filter_ycoeff(mus_any *ptr, int index)
-{
- flt *gen = (flt *)ptr;
- if (!(gen->y)) return((mus_float_t)mus_error(MUS_NO_YCOEFFS, "no ycoeffs"));
- if ((index >= 0) && (index < gen->order))
- return(gen->y[index]);
- return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE, S_mus_ycoeff ": invalid index %d, order = %d?", index, gen->order));
+ bank->y2 = y1;
+ bank->y1 = y0;
+ bank->y0 = y2;
+
+ return(sum);
}
-static mus_float_t filter_set_ycoeff(mus_any *ptr, int index, mus_float_t val)
+static mus_any_class FORMANT_BANK_CLASS = {
+ MUS_FORMANT_BANK,
+ (char *)S_formant_bank,
+ &free_formant_bank,
+ &describe_formant_bank,
+ &formant_bank_equalp,
+ 0, 0,
+ &formant_bank_length, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_formant_bank,
+ MUS_NOT_SPECIAL,
+ NULL, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &formant_bank_reset,
+ 0, &frm_bank_copy
+};
+
+
+mus_any *mus_make_formant_bank(int size, mus_any **formants, mus_float_t *amps)
{
- flt *gen = (flt *)ptr;
- if (!(gen->y)) return((mus_float_t)mus_error(MUS_NO_YCOEFFS, "no ycoeffs"));
- if ((index >= 0) && (index < gen->order))
+ frm_bank *gen;
+ int i;
+
+ gen = (frm_bank *)malloc(sizeof(frm_bank));
+ gen->core = &FORMANT_BANK_CLASS;
+ gen->size = size;
+ gen->mctr = 0;
+
+ gen->x0 = (mus_float_t *)calloc(size, sizeof(mus_float_t));
+ gen->x1 = (mus_float_t *)calloc(size, sizeof(mus_float_t));
+ gen->x2 = (mus_float_t *)calloc(size, sizeof(mus_float_t));
+ gen->y0 = (mus_float_t *)calloc(size, sizeof(mus_float_t));
+ gen->y1 = (mus_float_t *)calloc(size, sizeof(mus_float_t));
+ gen->y2 = (mus_float_t *)calloc(size, sizeof(mus_float_t));
+ gen->amps = amps;
+
+ gen->rr = (mus_float_t *)malloc(size * sizeof(mus_float_t));
+ gen->fdbk = (mus_float_t *)malloc(size * sizeof(mus_float_t));
+ gen->gain = (mus_float_t *)malloc(size * sizeof(mus_float_t));
+
+ if (amps)
{
- gen->y[index] = val;
- return(val);
+ gen->one_input = fb_one_with_amps;
+ gen->many_inputs = fb_many_with_amps;
}
- return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE, S_setB S_mus_ycoeff ": invalid index %d, order = %d?", index, gen->order));
-}
-
+ else
+ {
+ gen->one_input = fb_one_without_amps;
+ gen->many_inputs = fb_many_without_amps;
+ }
+
+ for (i = 0; i < size; i++)
+ {
+ frm *g;
+ g = (frm *)formants[i];
+ gen->rr[i] = g->rr;
+ gen->fdbk[i] = g->fdbk;
+ gen->gain[i] = g->gain;
+ /* one case: 1.0 val 0.0 throughout
+ * also c1 x c2
+ */
+ }
+ gen->c1 = gen->rr[0];
+ gen->c2 = gen->gain[0];
+ for (i = 1; i < size; i++)
+ if ((gen->rr[i] != gen->c1) ||
+ (gen->gain[i] != gen->c2))
+ return((mus_any *)gen);
-static int free_filter(mus_any *ptr)
-{
- flt *gen = (flt *)ptr;
- if (gen)
+ if (amps)
{
- if ((gen->state) && (gen->state_allocated)) clm_free(gen->state);
- clm_free(gen);
+ gen->one_input = fb_one_with_amps_c1_c2;
+ gen->many_inputs = fb_many_with_amps_c1_c2;
+ }
+ else
+ {
+ gen->one_input = fb_one_without_amps_c1_c2;
+ gen->many_inputs = fb_many_without_amps_c1_c2;
}
- return(0);
-}
+ return((mus_any *)gen);
+}
-static bool filter_equalp(mus_any *p1, mus_any *p2)
+bool mus_is_formant_bank(mus_any *ptr)
{
- flt *f1, *f2;
- f1 = (flt *)p1;
- f2 = (flt *)p2;
- if (p1 == p2) return(true);
- return(((p1->core)->type == (p2->core)->type) &&
- ((mus_filter_p(p1)) || (mus_fir_filter_p(p1)) || (mus_iir_filter_p(p1))) &&
- (f1->order == f2->order) &&
- ((!(f1->x)) || (!(f2->x)) || (clm_arrays_are_equal(f1->x, f2->x, f1->order))) &&
- ((!(f1->y)) || (!(f2->y)) || (clm_arrays_are_equal(f1->y, f2->y, f1->order))) &&
- (clm_arrays_are_equal(f1->state, f2->state, f1->order)));
+ return((ptr) &&
+ (ptr->core->type == MUS_FORMANT_BANK));
}
-static char *describe_filter(mus_any *ptr)
+
+/* ---------------- firmant ---------------- */
+
+static char *describe_firmant(mus_any *ptr)
{
- flt *gen = (flt *)ptr;
- char *xstr = NULL, *ystr = NULL;
+ frm *gen = (frm *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- xstr = float_array_to_string(gen->x, gen->order, 0);
- ystr = float_array_to_string(gen->y, gen->order, 0);
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s order: %d, xs: %s, ys: %s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s frequency: %.3f, radius: %.3f",
mus_name(ptr),
- gen->order,
- xstr, ystr);
- if (xstr) clm_free(xstr);
- if (ystr) clm_free(ystr);
+ mus_radians_to_hz(gen->frequency),
+ gen->radius);
return(describe_buffer);
}
+static mus_float_t firmant_frequency(mus_any *ptr) {return(mus_radians_to_hz(((frm *)ptr)->frequency));}
-static char *describe_fir_filter(mus_any *ptr)
+static mus_float_t firmant_set_frequency(mus_any *ptr, mus_float_t freq_in_hz)
{
- flt *gen = (flt *)ptr;
- char *xstr = NULL;
- char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- xstr = float_array_to_string(gen->x, gen->order, 0);
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s order: %d, xs: %s",
- mus_name(ptr),
- gen->order,
- xstr);
- if (xstr) clm_free(xstr);
- return(describe_buffer);
+ frm *gen = (frm *)ptr;
+ mus_float_t fw;
+ fw = mus_hz_to_radians(freq_in_hz);
+ gen->frequency = fw;
+ gen->fdbk = 2.0 * sin(gen->frequency * 0.5);
+ return(freq_in_hz);
}
+static mus_float_t firmant_radius(mus_any *ptr) {return(((frm *)ptr)->radius);}
-static char *describe_iir_filter(mus_any *ptr)
+static mus_float_t firmant_set_radius(mus_any *ptr, mus_float_t radius)
{
- flt *gen = (flt *)ptr;
- char *ystr = NULL;
- char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- ystr = float_array_to_string(gen->y, gen->order, 0);
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s order: %d, ys: %s",
- mus_name(ptr),
- gen->order,
- ystr);
- if (ystr) clm_free(ystr);
- return(describe_buffer);
+ frm *gen = (frm *)ptr;
+ gen->radius = radius;
+ gen->gain = 1.0 - radius * radius;
+ return(radius);
}
-static void filter_reset(mus_any *ptr)
+bool mus_is_firmant(mus_any *ptr)
{
- flt *gen = (flt *)ptr;
- mus_clear_array(gen->state, gen->allocated_size);
+ return((ptr) &&
+ (ptr->core->type == MUS_FIRMANT));
}
-static mus_any_class FILTER_CLASS = {
- MUS_FILTER,
- (char *)S_filter,
- &free_filter,
- &describe_filter,
- &filter_equalp,
- &filter_data, 0,
- &filter_length,
- &filter_set_length,
- 0, 0, 0, 0,
+mus_float_t mus_firmant(mus_any *ptr, mus_float_t input)
+{
+ frm *gen = (frm *)ptr;
+ mus_float_t xn1, yn1;
+ xn1 = gen->gain * input + gen->radius * (gen->x1 - gen->fdbk * gen->y1);
+ yn1 = gen->radius * (gen->fdbk * xn1 + gen->y1);
+ gen->x1 = xn1;
+ gen->y1 = yn1;
+ return(yn1);
+}
+
+
+mus_float_t mus_firmant_with_frequency(mus_any *ptr, mus_float_t input, mus_float_t freq_in_radians)
+{
+ frm *gen = (frm *)ptr;
+ gen->frequency = freq_in_radians;
+ gen->fdbk = 2.0 * sin(gen->frequency * 0.5);
+ return(mus_firmant(ptr, input));
+}
+
+
+static mus_float_t run_firmant(mus_any *ptr, mus_float_t input, mus_float_t unused) {return(mus_firmant(ptr, input));}
+
+
+static mus_any_class FIRMANT_CLASS = {
+ MUS_FIRMANT,
+ (char *)S_firmant,
+ &free_frm,
+ &describe_firmant,
+ &frm_equalp,
+ 0, 0,
+ &two_length, 0,
+ &firmant_frequency, &firmant_set_frequency,
0, 0,
+ &firmant_radius, &firmant_set_radius,
0, 0,
- &run_filter,
- MUS_FULL_FILTER,
+ &run_firmant,
+ MUS_SIMPLE_FILTER,
NULL, 0,
- 0, 0, 0, 0,
- &filter_xcoeff, &filter_set_xcoeff,
+ 0, 0, 0, 0,
+ 0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- &filter_ycoeff, &filter_set_ycoeff,
- &filter_xcoeffs, &filter_ycoeffs,
- 0,
- &filter_reset,
- 0, 0, 0
-};
-
-
-static mus_any_class FIR_FILTER_CLASS = {
- MUS_FIR_FILTER,
- (char *)S_fir_filter,
- &free_filter,
- &describe_fir_filter,
- &filter_equalp,
- &filter_data, 0,
- &filter_length,
- &filter_set_length,
- 0, 0, 0, 0,
- 0, 0,
- 0, 0,
- &run_fir_filter,
- MUS_FULL_FILTER,
- NULL, 0,
- 0, 0, 0, 0,
- &filter_xcoeff, &filter_set_xcoeff,
- 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0,
- 0, 0,
- &filter_xcoeffs, 0, 0,
- &filter_reset,
- 0, 0, 0
-};
-
-
-static mus_any_class IIR_FILTER_CLASS = {
- MUS_IIR_FILTER,
- (char *)S_iir_filter,
- &free_filter,
- &describe_iir_filter,
- &filter_equalp,
- &filter_data, 0,
- &filter_length,
- &filter_set_length,
- 0, 0, 0, 0,
- 0, 0,
- 0, 0,
- &run_iir_filter,
- MUS_FULL_FILTER,
- NULL, 0,
- 0, 0, 0, 0,
- 0, 0,
0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0,
- &filter_ycoeff, &filter_set_ycoeff,
- 0, &filter_ycoeffs, 0,
- &filter_reset,
- 0, 0, 0
+ &frm_reset,
+ 0, &frm_copy
};
-static mus_any *make_filter(mus_any_class *cls, const char *name, int order, mus_float_t *xcoeffs, mus_float_t *ycoeffs, mus_float_t *state) /* if state null, allocated locally */
+mus_any *mus_make_firmant(mus_float_t frequency, mus_float_t radius)
{
- if (order <= 0)
- mus_error(MUS_ARG_OUT_OF_RANGE, "%s order = %d?", name, order);
- else
- {
- flt *gen;
- gen = (flt *)clm_calloc(1, sizeof(flt), name);
- if (state)
- gen->state = state;
- else
- {
- gen->state = (mus_float_t *)clm_calloc_atomic(order, sizeof(mus_float_t), "filter state space");
- gen->state_allocated = true;
- }
- gen->core = cls;
- gen->order = order;
- gen->allocated_size = order;
- gen->x = xcoeffs;
- gen->y = ycoeffs;
- return((mus_any *)gen);
- }
- return(NULL);
+ frm *gen;
+ gen = (frm *)calloc(1, sizeof(frm));
+ gen->core = &FIRMANT_CLASS;
+ gen->frequency = mus_hz_to_radians(frequency);
+ gen->radius = radius;
+ gen->fdbk = 2.0 * sin(gen->frequency * 0.5);
+ gen->gain = 1.0 - radius * radius;
+ return((mus_any *)gen);
}
-mus_any *mus_make_filter(int order, mus_float_t *xcoeffs, mus_float_t *ycoeffs, mus_float_t *state)
-{
- return(make_filter(&FILTER_CLASS, S_make_filter, order, xcoeffs, ycoeffs, state));
-}
-mus_any *mus_make_fir_filter(int order, mus_float_t *xcoeffs, mus_float_t *state)
-{
- return(make_filter(&FIR_FILTER_CLASS, S_make_fir_filter, order, xcoeffs, NULL, state));
-}
+/* ---------------- filter ---------------- */
+typedef struct {
+ mus_any_class *core;
+ int order, allocated_size, loc;
+ bool state_allocated;
+ mus_float_t *x, *y, *state;
+ mus_float_t (*filtw)(mus_any *ptr, mus_float_t fm);
+} flt;
-mus_any *mus_make_iir_filter(int order, mus_float_t *ycoeffs, mus_float_t *state)
+
+mus_float_t mus_filter(mus_any *ptr, mus_float_t input)
{
- return(make_filter(&IIR_FILTER_CLASS, S_make_iir_filter, order, NULL, ycoeffs, state));
+ return((((flt *)ptr)->filtw)(ptr, input));
}
-mus_float_t *mus_make_fir_coeffs(int order, mus_float_t *envl, mus_float_t *aa)
+static mus_float_t filter_eight(mus_any *ptr, mus_float_t input)
{
- /* envl = evenly sampled freq response, has order samples */
- int n, i, j, jj;
- mus_float_t scl;
- mus_float_t *a;
- n = order;
- if (n <= 0) return(aa);
- if (aa)
- a = aa;
- else a = (mus_float_t *)clm_calloc_atomic(order, sizeof(mus_float_t), "coeff space");
- if (!a) return(NULL);
- if (!(POWER_OF_2_P(order)))
- {
- int m;
- mus_float_t am, q, xt = 0.0, xt0, qj, x;
- m = (n + 1) / 2;
- am = 0.5 * (n + 1);
- scl = 2.0 / (mus_float_t)n;
- q = TWO_PI / (mus_float_t)n;
- xt0 = envl[0] * 0.5;
- for (j = 0, jj = n - 1; j < m; j++, jj--)
- {
- xt = xt0;
- qj = q * (am - j - 1);
- for (i = 1, x = qj; i < m; i++, x += qj)
- xt += (envl[i] * cos(x));
- a[j] = xt * scl;
- a[jj] = a[j];
- }
- }
- else /* use fft if it's easy to match -- there must be a way to handle odd orders here */
- {
- mus_float_t *rl, *im;
- mus_long_t fsize;
- int lim;
- mus_float_t offset;
-
- fsize = 2 * order; /* checked power of 2 above */
- rl = (mus_float_t *)clm_calloc(fsize, sizeof(mus_float_t), "mus_make_fir_coeffs");
- im = (mus_float_t *)clm_calloc(fsize, sizeof(mus_float_t), "mus_make_fir_coeffs");
- lim = order / 2;
- memcpy((void *)rl, (void *)envl, lim * sizeof(mus_float_t));
+ /* oddly enough, this separated form is faster than the interleaved version below, or is valgrind confused?
+ */
+ flt *gen = (flt *)ptr;
+ mus_float_t xout;
+ mus_float_t *state, *ts, *ts1, *y, *x;
- mus_fft(rl, im, fsize, 1);
+ x = (mus_float_t *)(gen->x);
+ y = (mus_float_t *)(gen->y + 1); /* assume y[0] = 1.0 I think */
+ state = (mus_float_t *)(gen->state + gen->loc);
+ ts = (mus_float_t *)(state + gen->order - 1);
+ ts1 = (mus_float_t *)(state + gen->order);
- scl = 4.0 / fsize;
- offset = -2.0 * envl[0] / fsize;
- for (i = 0; i < fsize; i++)
- rl[i] = rl[i] * scl + offset;
- for (i = 1, j = lim - 1, jj = lim; i < order; i += 2, j--, jj++)
- {
- a[j] = rl[i];
- a[jj] = rl[i];
- }
- clm_free(rl);
- clm_free(im);
- }
+ gen->loc++;
+ if (gen->loc == gen->order)
+ gen->loc = 0;
- return(a);
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts) * (*y));
+
+ state[0] = input;
+ state[gen->order] = input;
+
+ xout = (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ return(xout + ((*ts1) * (*x)));
+
+ /*
+ * flt *gen = (flt *)ptr;
+ * mus_float_t xout;
+ * mus_float_t *state, *ts, *y, *x;
+ *
+ * x = (mus_float_t *)(gen->x + 1);
+ * y = (mus_float_t *)(gen->y + 1);
+ * state = (mus_float_t *)(gen->state + gen->loc);
+ * ts = (mus_float_t *)(state + gen->order - 1);
+ *
+ * gen->loc++;
+ * if (gen->loc == gen->order)
+ * gen->loc = 0;
+ *
+ * xout = (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x);
+ * input -= ((*ts--) * (*y));
+ *
+ * state[0] = input;
+ * state[gen->order] = input;
+ * return(xout + ((*ts) * gen->x[0]));
+ */
}
+static mus_float_t filter_four(mus_any *ptr, mus_float_t input)
+{
+ flt *gen = (flt *)ptr;
+ mus_float_t xout;
+ mus_float_t *state, *ts, *ts1, *y, *x;
-/* ---------------- env ---------------- */
+ x = (mus_float_t *)(gen->x);
+ y = (mus_float_t *)(gen->y + 1);
+ state = (mus_float_t *)(gen->state + gen->loc);
+ ts = (mus_float_t *)(state + gen->order - 1);
+ ts1 = (mus_float_t *)(state + gen->order);
-typedef struct {
- mus_any_class *core;
- double rate, current_value, base, offset, scaler, power, init_y, init_power, original_scaler, original_offset;
- mus_long_t loc, end;
- mus_env_t style;
- int index, size;
- bool data_allocated;
- mus_float_t *original_data;
- double *rates;
- mus_long_t *locs;
-} seg;
+ gen->loc++;
+ if (gen->loc == gen->order)
+ gen->loc = 0;
-/* I used to use exp directly, but:
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts) * (*y));
+
+ state[0] = input;
+ state[gen->order] = input;
+
+ xout = (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ xout += (*ts1--) * (*x++);
+ return(xout + ((*ts1) * (*x)));
+
+ /*
+ * flt *gen = (flt *)ptr;
+ * mus_float_t xout;
+ * mus_float_t *state, *ts, *y, *x;
+ *
+ * x = (mus_float_t *)(gen->x + 1);
+ * y = (mus_float_t *)(gen->y + 1);
+ * state = (mus_float_t *)(gen->state + gen->loc);
+ * ts = (mus_float_t *)(state + gen->order - 1);
+ *
+ * gen->loc++;
+ * if (gen->loc == gen->order)
+ * gen->loc = 0;
+ *
+ * xout = (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ * xout += (*ts) * (*x++);
+ * input -= ((*ts--) * (*y++));
+ *
+ * state[0] = input;
+ * state[gen->order] = input;
+ * return(xout + ((*ts) * gen->x[0]));
+ */
+}
- (define (texp1 start end num)
- (let* ((ls (log start))
- (le (log end))
- (cf (exp (/ (- le ls) (1- num))))
- (max-diff 0.0)
- (xstart start))
- (do ((i 0 (1+ i)))
- ((= i num)
- max-diff)
- (let ((val1 (* start (exp (* (/ i (1- num)) (- le ls)))))
- (val2 xstart))
- (set! xstart (* xstart cf))
- (set! max-diff (max max-diff (abs (- val1 val2))))))))
-
- returns:
- :(texp1 1.0 3.0 1000000)
- 2.65991229042584e-10
- :(texp1 1.0 10.0 100000000)
- 2.24604939091932e-8
- :(texp1 10.0 1000.0 100000000)
- 4.11786902532185e-6
- :(texp1 1.0 1.1 100000000)
- 1.28246036013024e-9
- :(texp1 10.0 1000.0 1000000000)
- 4.39423240550241e-5
+static mus_float_t filter_two(mus_any *ptr, mus_float_t input)
+{
+ /* here the mus_float_t-delay form is not faster, but use it for consistency */
+ flt *gen = (flt *)ptr;
+ mus_float_t *state, *ts, *y, *x;
- so the repeated multiply version is more than accurate enough
-*/
+ x = gen->x;
+ y = gen->y;
+ state = (mus_float_t *)(gen->state + gen->loc);
+ ts = (mus_float_t *)(state + gen->order - 2);
+ gen->loc++;
+ if (gen->loc == gen->order)
+ gen->loc = 0;
-bool mus_env_p(mus_any *ptr)
-{
- return((ptr) &&
- (ptr->core->type == MUS_ENV));
+ state[0] = input - ((ts[1] * y[1]) + (ts[0] * y[2]));
+ state[gen->order] = state[0];
+
+ return((ts[0] * x[2]) + (ts[1] * x[1]) + (ts[2] * x[0]));
}
-mus_env_t mus_env_type(mus_any *ptr)
+static mus_float_t filter_lt_10(mus_any *ptr, mus_float_t input)
{
- return(((seg *)ptr)->style);
-}
+ flt *gen = (flt *)ptr;
+ mus_float_t xout = 0.0;
+ mus_float_t *state, *state1, *ts, *y, *x;
+ x = (mus_float_t *)(gen->x);
+ y = (mus_float_t *)(gen->y + 1); /* assume y[0] = 1.0 I think */
+ state = (mus_float_t *)(gen->state + gen->loc);
+ state1 = (mus_float_t *)(state + 1);
+ ts = (mus_float_t *)(state + gen->order - 1);
-mus_float_t mus_env(mus_any *ptr)
-{
- seg *gen = (seg *)ptr;
- mus_float_t val;
+ while (ts > state1)
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts) * (*y));
- val = gen->current_value;
+ state[0] = input;
+ state[gen->order] = input;
- if (gen->loc >= gen->locs[gen->index])
- {
- gen->index++;
- gen->rate = gen->rates[gen->index];
- }
+ ts = (mus_float_t *)(state + gen->order);
- if (gen->style == MUS_ENV_LINEAR)
- gen->current_value += gen->rate;
- else
- {
- if (gen->style == MUS_ENV_EXPONENTIAL)
- {
- gen->power *= gen->rate;
- gen->current_value = gen->offset + (gen->scaler * gen->power);
- }
- else gen->current_value = gen->rate;
- }
+ while (ts > state1)
+ xout += (*ts--) * (*x++);
gen->loc++;
- return(val);
+ if (gen->loc == gen->order)
+ gen->loc = 0;
+
+ return(xout + ((*ts) * (*x)));
}
-mus_float_t mus_env_linear(mus_any *ptr)
+static mus_float_t filter_ge_10(mus_any *ptr, mus_float_t input)
{
- seg *gen = (seg *)ptr;
- mus_float_t val;
- val = gen->current_value;
- if (gen->loc >= gen->locs[gen->index])
+ flt *gen = (flt *)ptr;
+ mus_float_t xout = 0.0;
+ mus_float_t *state, *state1, *state11, *ts, *y, *x;
+
+ x = (mus_float_t *)(gen->x);
+ y = (mus_float_t *)(gen->y + 1); /* assume y[0] = 1.0 I think */
+ state = (mus_float_t *)(gen->state + gen->loc);
+ state1 = (mus_float_t *)(state + 1);
+ state11 = (mus_float_t *)(state + 11);
+ ts = (mus_float_t *)(state + gen->order - 1);
+
+ while (ts >= state11)
{
- gen->index++;
- gen->rate = gen->rates[gen->index];
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts--) * (*y++));
}
- gen->current_value += gen->rate;
- gen->loc++;
- return(val);
-}
+ while (ts > state1)
+ input -= ((*ts--) * (*y++));
+ input -= ((*ts) * (*y));
+ state[0] = input;
+ state[gen->order] = input;
-mus_float_t mus_env_exponential(mus_any *ptr)
-{
- seg *gen = (seg *)ptr;
- mus_float_t val;
- val = gen->current_value;
- if (gen->loc >= gen->locs[gen->index])
+ ts = (mus_float_t *)(state + gen->order);
+ while (ts >= state11)
{
- gen->index++;
- gen->rate = gen->rates[gen->index];
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
}
- gen->power *= gen->rate;
- gen->current_value = gen->offset + (gen->scaler * gen->power);
+ while (ts > state1)
+ xout += (*ts--) * (*x++);
+
gen->loc++;
- return(val);
+ if (gen->loc == gen->order)
+ gen->loc = 0;
+
+ return(xout + ((*ts) * (*x)));
}
-static mus_float_t run_env(mus_any *ptr, mus_float_t unused1, mus_float_t unused2)
+mus_float_t mus_fir_filter(mus_any *ptr, mus_float_t input)
{
- return(mus_env(ptr));
+ return((((flt *)ptr)->filtw)(ptr, input));
}
-static void dmagify_env(seg *e, mus_float_t *data, int pts, mus_long_t dur, double scaler)
-{
- int i, j;
- double xscl = 1.0, cur_loc = 0.0, y1 = 0.0;
-
- e->size = pts;
+static mus_float_t fir_n(mus_any *ptr, mus_float_t input)
+{
+ mus_float_t xout = 0.0;
+ flt *gen = (flt *)ptr;
+ mus_float_t *state, *ts, *x, *end;
- if ((pts > 1) &&
- (data[pts * 2 - 2] != data[0]))
- xscl = (double)(dur - 1) / (double)(data[pts * 2 - 2] - data[0]); /* was dur, 7-Apr-02 */
+ x = (mus_float_t *)(gen->x);
+ state = (mus_float_t *)(gen->state + gen->loc);
+ ts = (mus_float_t *)(state + gen->order);
- e->rates = (double *)clm_calloc_atomic(pts, sizeof(double), "env rates");
- e->locs = (mus_long_t *)clm_calloc_atomic(pts + 1, sizeof(mus_long_t), "env locs");
+ (*state) = input;
+ (*ts) = input;
+ state++;
+ end = (mus_float_t *)(state + 4);
- for (j = 0, i = 2; i < pts * 2; i += 2, j++)
+ while (ts > end)
{
- mus_long_t samps;
- double cur_dx, x0, y0, x1;
-
- x0 = data[i - 2];
- x1 = data[i];
- y0 = data[i - 1];
- y1 = data[i + 1];
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ }
+ while (ts > state)
+ xout += (*ts--) * (*x++);
- cur_dx = xscl * (x1 - x0);
- if (cur_dx < 1.0) cur_dx = 1.0;
- cur_loc += cur_dx;
+ gen->loc++;
+ if (gen->loc == gen->order)
+ gen->loc = 0;
- if (e->style == MUS_ENV_STEP)
- e->locs[j] = (mus_long_t)cur_loc; /* this is the change boundary (confusing...) */
- else e->locs[j] = (mus_long_t)(cur_loc + 0.5);
+ return(xout + ((*ts) * (*x)));
+}
+
- if (j == 0)
- samps = e->locs[0];
- else samps = e->locs[j] - e->locs[j - 1];
+static mus_float_t fir_ge_20(mus_any *ptr, mus_float_t input)
+{
+ mus_float_t xout = 0.0;
+ flt *gen = (flt *)ptr;
+ mus_float_t *state, *ts, *x, *end;
- switch (e->style)
- {
- case MUS_ENV_LINEAR:
- if ((y0 == y1) || (samps == 0))
- e->rates[j] = 0.0;
- else e->rates[j] = scaler * (y1 - y0) / (double)samps;
- break;
+ x = (mus_float_t *)(gen->x);
+ state = (mus_float_t *)(gen->state + gen->loc);
+ ts = (mus_float_t *)(state + gen->order);
+ end = (mus_float_t *)(state + 20);
- case MUS_ENV_EXPONENTIAL:
- if ((y0 == y1) || (samps == 0))
- e->rates[j] = 1.0;
- else e->rates[j] = exp((y1 - y0) / (double)samps);
- break;
+ (*state) = input;
+ (*ts) = input;
+ state++;
- case MUS_ENV_STEP:
- e->rates[j] = e->offset + (scaler * y0);
- break;
- }
+ while (ts >= end)
+ {
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
+ xout += (*ts--) * (*x++);
}
+ while (ts > state)
+ xout += (*ts--) * (*x++);
+
+ gen->loc++;
+ if (gen->loc == gen->order)
+ gen->loc = 0;
- if ((pts > 1) &&
- (e->locs[pts - 2] != e->end))
- e->locs[pts - 2] = e->end;
+ return((ts == state) ? (xout + ((*ts) * (*x))) : xout);
+}
- if (pts > 1)
- {
- switch (e->style)
- {
- case MUS_ENV_STEP:
- e->rates[pts - 1] = e->offset + (scaler * y1); /* stick at last value, which in this case is the value (not an increment) */
- break;
- case MUS_ENV_LINEAR:
- e->rates[pts - 1] = 0.0;
- break;
+mus_float_t mus_iir_filter(mus_any *ptr, mus_float_t input)
+{
+ return((((flt *)ptr)->filtw)(ptr, input));
+}
- case MUS_ENV_EXPONENTIAL:
- e->rates[pts - 1] = 1.0;
- break;
- }
- }
- e->locs[pts - 1] = 1000000000;
- e->locs[pts] = 1000000000; /* guard cell at end to make bounds check simpler */
+static mus_float_t iir_n(mus_any *ptr, mus_float_t input)
+{
+ flt *gen = (flt *)ptr;
+ mus_float_t *state, *ts, *y;
+
+ y = (mus_float_t *)(gen->y + 1); /* assume y[0] = 1.0 I think */
+ state = (mus_float_t *)(gen->state + gen->loc);
+ ts = (mus_float_t *)(state + gen->order - 1);
+
+ while (ts > state)
+ input -= ((*ts--) * (*y++));
+
+ gen->loc++;
+ if (gen->loc == gen->order)
+ gen->loc = 0;
+
+ state[0] = input;
+ state[gen->order] = input;
+
+ return(input);
}
-static mus_float_t *fixup_exp_env(seg *e, mus_float_t *data, int pts, double offset, double scaler, double base)
+static mus_float_t run_filter(mus_any *ptr, mus_float_t input, mus_float_t unused) {return((((flt *)ptr)->filtw)(ptr, input));}
+
+bool mus_is_filter(mus_any *ptr)
{
- double min_y, max_y, val = 0.0, tmp = 0.0, b1;
- int len, i;
- bool flat;
- mus_float_t *result = NULL;
+ return((ptr) &&
+ ((ptr->core->type == MUS_FILTER) ||
+ (ptr->core->type == MUS_FIR_FILTER) ||
+ (ptr->core->type == MUS_IIR_FILTER)));
+}
- if ((base <= 0.0) ||
- (base == 1.0))
- return(NULL);
- min_y = offset + scaler * data[1];
- max_y = min_y;
- len = pts * 2;
+bool mus_is_fir_filter(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_FIR_FILTER));
+}
- /* fill "result" with x and (offset+scaler*y) */
+bool mus_is_iir_filter(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_IIR_FILTER));
+}
- result = (mus_float_t *)clm_calloc_atomic(len, sizeof(mus_float_t), "env data");
- result[0] = data[0];
- result[1] = min_y;
- for (i = 2; i < len; i += 2)
+static mus_float_t *filter_data(mus_any *ptr) {return(((flt *)ptr)->state);}
+static mus_long_t filter_length(mus_any *ptr) {return(((flt *)ptr)->order);}
+
+static mus_float_t *filter_xcoeffs(mus_any *ptr) {return(((flt *)ptr)->x);}
+static mus_float_t *filter_ycoeffs(mus_any *ptr) {return(((flt *)ptr)->y);}
+
+
+mus_float_t *mus_filter_set_xcoeffs(mus_any *ptr, mus_float_t *new_data)
+{
+ /* needed by Snd if filter order increased during play */
+ flt *gen = (flt *)ptr;
+ mus_float_t *old_data;
+ old_data = gen->x;
+ gen->x = new_data;
+ return(old_data);
+}
+
+
+mus_float_t *mus_filter_set_ycoeffs(mus_any *ptr, mus_float_t *new_data)
+{
+ flt *gen = (flt *)ptr;
+ mus_float_t *old_data;
+ old_data = gen->y;
+ gen->y = new_data;
+ return(old_data);
+}
+
+
+static mus_long_t filter_set_length(mus_any *ptr, mus_long_t val)
+{
+ /* just resets order if order < allocated size */
+ flt *gen = (flt *)ptr;
+ if ((val > 0) && (val <= gen->allocated_size))
+ gen->order = (int)val;
+ return((mus_long_t)(gen->order));
+}
+
+
+static void set_filter_function(flt *gen);
+
+int mus_filter_set_order(mus_any *ptr, int order)
+{
+ /* resets order and fixes state array if needed (coeffs arrays should be handled separately by set_x|ycoeffs above) */
+ /* returns either old order or -1 if state array can't be reallocated */
+ flt *gen = (flt *)ptr;
+ int old_order;
+ if ((order > gen->allocated_size) &&
+ (!(gen->state_allocated)))
+ return(-1);
+ old_order = gen->order;
+ gen->order = order;
+ if (order > gen->allocated_size)
{
- tmp = offset + scaler * data[i + 1];
- result[i] = data[i];
- result[i + 1] = tmp;
- if (tmp < min_y) min_y = tmp;
- if (tmp > max_y) max_y = tmp;
+ int i;
+ gen->allocated_size = order;
+ gen->state = (mus_float_t *)realloc(gen->state, order * 2 * sizeof(mus_float_t));
+ for (i = old_order; i < order; i++)
+ {
+ gen->state[i] = 0.0; /* try to minimize click */
+ gen->state[i + order] = 0.0; /* just a guess */
+ }
}
+ set_filter_function(gen);
+ return(old_order);
+}
- b1 = base - 1.0;
- flat = (min_y == max_y);
- if (!flat)
- val = 1.0 / (max_y - min_y);
- /* now logify result */
- for (i = 1; i < len; i += 2)
+static mus_float_t filter_xcoeff(mus_any *ptr, int index)
+{
+ flt *gen = (flt *)ptr;
+ if (!(gen->x)) return((mus_float_t)mus_error(MUS_NO_XCOEFFS, S_mus_xcoeff ": no xcoeffs"));
+ if ((index >= 0) && (index < gen->order))
+ return(gen->x[index]);
+ return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE, S_mus_xcoeff ": invalid index %d, order = %d?", index, gen->order));
+}
+
+
+static mus_float_t filter_set_xcoeff(mus_any *ptr, int index, mus_float_t val)
+{
+ flt *gen = (flt *)ptr;
+ if (!(gen->x)) return((mus_float_t)mus_error(MUS_NO_XCOEFFS, S_set S_mus_xcoeff ": no xcoeffs"));
+ if ((index >= 0) && (index < gen->order))
{
- if (flat)
- tmp = 1.0;
- else tmp = val * (result[i] - min_y);
- result[i] = log(1.0 + (tmp * b1));
+ gen->x[index] = val;
+ return(val);
}
+ return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE, S_set S_mus_xcoeff ": invalid index %d, order = %d?", index, gen->order));
+}
- e->scaler = (max_y - min_y) / b1;
- e->offset = min_y;
- return(result);
+
+static mus_float_t filter_ycoeff(mus_any *ptr, int index)
+{
+ flt *gen = (flt *)ptr;
+ if (!(gen->y)) return((mus_float_t)mus_error(MUS_NO_YCOEFFS, S_mus_ycoeff ": no ycoeffs"));
+ if ((index >= 0) && (index < gen->order))
+ return(gen->y[index]);
+ return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE, S_mus_ycoeff ": invalid index %d, order = %d?", index, gen->order));
}
-static bool env_equalp(mus_any *p1, mus_any *p2)
+static mus_float_t filter_set_ycoeff(mus_any *ptr, int index, mus_float_t val)
{
- seg *e1 = (seg *)p1;
- seg *e2 = (seg *)p2;
+ flt *gen = (flt *)ptr;
+ if (!(gen->y)) return((mus_float_t)mus_error(MUS_NO_YCOEFFS, S_set S_mus_ycoeff ": no ycoeffs"));
+ if ((index >= 0) && (index < gen->order))
+ {
+ gen->y[index] = val;
+ return(val);
+ }
+ return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE, S_set S_mus_ycoeff ": invalid index %d, order = %d?", index, gen->order));
+}
+
+
+static void free_filter(mus_any *ptr)
+{
+ flt *gen = (flt *)ptr;
+ if ((gen->state) && (gen->state_allocated)) free(gen->state);
+ free(gen);
+}
+
+static mus_any *flt_copy(mus_any *ptr)
+{
+ flt *g, *p;
+ int bytes;
+
+ p = (flt *)ptr;
+ g = (flt *)malloc(sizeof(flt));
+ memcpy((void *)g, (void *)ptr, sizeof(flt));
+
+ /* we have to make a new state array -- otherwise the original and copy step on each other */
+ bytes = p->order * 2 * sizeof(mus_float_t);
+ g->state_allocated = true;
+ g->state = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->state), (void *)(p->state), bytes);
+ return((mus_any *)g);
+}
+
+
+static bool filter_equalp(mus_any *p1, mus_any *p2)
+{
+ flt *f1, *f2;
+ f1 = (flt *)p1;
+ f2 = (flt *)p2;
if (p1 == p2) return(true);
- return((e1) && (e2) &&
- (e1->core->type == e2->core->type) &&
- (e1->loc == e2->loc) &&
- (e1->end == e2->end) &&
- (e1->style == e2->style) &&
- (e1->index == e2->index) &&
- (e1->size == e2->size) &&
+ return(((p1->core)->type == (p2->core)->type) &&
+ ((mus_is_filter(p1)) || (mus_is_fir_filter(p1)) || (mus_is_iir_filter(p1))) &&
+ (f1->order == f2->order) &&
+ ((!(f1->x)) || (!(f2->x)) || (clm_arrays_are_equal(f1->x, f2->x, f1->order))) &&
+ ((!(f1->y)) || (!(f2->y)) || (clm_arrays_are_equal(f1->y, f2->y, f1->order))) &&
+ (clm_arrays_are_equal(f1->state, f2->state, f1->order)));
+}
+
+
+static char *describe_filter(mus_any *ptr)
+{
+ flt *gen = (flt *)ptr;
+ char *xstr = NULL, *ystr = NULL;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ xstr = float_array_to_string(gen->x, gen->order, 0);
+ ystr = float_array_to_string(gen->y, gen->order, 0);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s order: %d, xs: %s, ys: %s",
+ mus_name(ptr),
+ gen->order,
+ xstr, ystr);
+ if (xstr) free(xstr);
+ if (ystr) free(ystr);
+ return(describe_buffer);
+}
+
+
+static char *describe_fir_filter(mus_any *ptr)
+{
+ flt *gen = (flt *)ptr;
+ char *xstr = NULL;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ xstr = float_array_to_string(gen->x, gen->order, 0);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s order: %d, xs: %s",
+ mus_name(ptr),
+ gen->order,
+ xstr);
+ if (xstr) free(xstr);
+ return(describe_buffer);
+}
+
+
+static char *describe_iir_filter(mus_any *ptr)
+{
+ flt *gen = (flt *)ptr;
+ char *ystr = NULL;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ ystr = float_array_to_string(gen->y, gen->order, 0);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s order: %d, ys: %s",
+ mus_name(ptr),
+ gen->order,
+ ystr);
+ if (ystr) free(ystr);
+ return(describe_buffer);
+}
+
+
+static void filter_reset(mus_any *ptr)
+{
+ flt *gen = (flt *)ptr;
+ memset((void *)(gen->state), 0, gen->allocated_size * 2 * sizeof(mus_float_t));
+}
+
+
+static mus_any_class FILTER_CLASS = {
+ MUS_FILTER,
+ (char *)S_filter,
+ &free_filter,
+ &describe_filter,
+ &filter_equalp,
+ &filter_data, 0,
+ &filter_length,
+ &filter_set_length,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_filter,
+ MUS_FULL_FILTER,
+ NULL, 0,
+ 0, 0, 0, 0,
+ &filter_xcoeff, &filter_set_xcoeff,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ &filter_ycoeff, &filter_set_ycoeff,
+ &filter_xcoeffs, &filter_ycoeffs,
+ &filter_reset,
+ 0, &flt_copy
+};
+
+
+static mus_any_class FIR_FILTER_CLASS = {
+ MUS_FIR_FILTER,
+ (char *)S_fir_filter,
+ &free_filter,
+ &describe_fir_filter,
+ &filter_equalp,
+ &filter_data, 0,
+ &filter_length,
+ &filter_set_length,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_filter,
+ MUS_FULL_FILTER,
+ NULL, 0,
+ 0, 0, 0, 0,
+ &filter_xcoeff, &filter_set_xcoeff,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0,
+ &filter_xcoeffs, 0,
+ &filter_reset,
+ 0, &flt_copy
+};
+
+
+static mus_any_class IIR_FILTER_CLASS = {
+ MUS_IIR_FILTER,
+ (char *)S_iir_filter,
+ &free_filter,
+ &describe_iir_filter,
+ &filter_equalp,
+ &filter_data, 0,
+ &filter_length,
+ &filter_set_length,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_filter,
+ MUS_FULL_FILTER,
+ NULL, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ &filter_ycoeff, &filter_set_ycoeff,
+ 0, &filter_ycoeffs,
+ &filter_reset,
+ 0, &flt_copy
+};
+
+
+static void set_filter_function(flt *gen)
+{
+ /* choose the run-time function based on the current filter order and type */
+ int order;
+ order = gen->order - 1;
+ if (gen->core == &FILTER_CLASS)
+ {
+ if (order == 2)
+ gen->filtw = filter_two;
+ else
+ {
+ if (order == 8)
+ gen->filtw = filter_eight;
+ else
+ {
+ if (order == 4)
+ gen->filtw = filter_four;
+ else
+ {
+ if (order >= 10)
+ gen->filtw = filter_ge_10;
+ else gen->filtw = filter_lt_10;
+ }
+ }
+ }
+ }
+ else
+ {
+ if (gen->core == &FIR_FILTER_CLASS)
+ {
+ if (order >= 20)
+ gen->filtw = fir_ge_20;
+ else gen->filtw = fir_n;
+ }
+ else gen->filtw = iir_n;
+ }
+}
+
+
+static mus_any *make_filter(mus_any_class *cls, const char *name, int order, mus_float_t *xcoeffs, mus_float_t *ycoeffs, mus_float_t *state)
+{
+ /* if state is null, it is allocated locally, otherwise it's size should be at least 2 * order.
+ */
+ if (order <= 0)
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_filter ": %s order = %d?", name, order);
+ else
+ {
+ flt *gen;
+ gen = (flt *)malloc(sizeof(flt));
+ if (state)
+ {
+ gen->state = state;
+ gen->state_allocated = false;
+ }
+ else
+ {
+ gen->state = (mus_float_t *)calloc(order * 2, sizeof(mus_float_t));
+ gen->state_allocated = true;
+ }
+ gen->loc = 0;
+
+ if (cls == &FILTER_CLASS)
+ {
+ if (!ycoeffs)
+ cls = &FIR_FILTER_CLASS;
+ else
+ {
+ if (!xcoeffs)
+ cls = &IIR_FILTER_CLASS;
+ }
+ }
+ gen->core = cls;
+ gen->order = order;
+ gen->allocated_size = order;
+ gen->x = xcoeffs;
+ gen->y = ycoeffs;
+ gen->filtw = NULL;
+ set_filter_function(gen);
+ return((mus_any *)gen);
+ }
+ return(NULL);
+}
- (e1->rate == e2->rate) &&
- (e1->base == e2->base) &&
- (e1->power == e2->power) &&
- (e1->current_value == e2->current_value) &&
- (e1->scaler == e2->scaler) &&
- (e1->offset == e2->offset) &&
- (e1->init_y == e2->init_y) &&
- (e1->init_power == e2->init_power) &&
- (clm_arrays_are_equal(e1->original_data, e2->original_data, e1->size * 2)));
+
+mus_any *mus_make_filter(int order, mus_float_t *xcoeffs, mus_float_t *ycoeffs, mus_float_t *state)
+{
+ return(make_filter(&FILTER_CLASS, S_make_filter, order, xcoeffs, ycoeffs, state));
}
-static char *describe_env(mus_any *ptr)
+mus_any *mus_make_fir_filter(int order, mus_float_t *xcoeffs, mus_float_t *state)
{
- char *str = NULL;
- seg *e = (seg *)ptr;
- char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s, pass: " MUS_LD " (dur: " MUS_LD "), index: %d, scaler: %.4f, offset: %.4f, data: %s",
- mus_name(ptr),
- ((e->style == MUS_ENV_LINEAR) ? "linear" : ((e->style == MUS_ENV_EXPONENTIAL) ? "exponential" : "step")),
- e->loc,
- e->end + 1,
- e->index,
- e->original_scaler,
- e->original_offset,
- str = float_array_to_string(e->original_data, e->size * 2, 0));
- if (str) clm_free(str);
- return(describe_buffer);
+ return(make_filter(&FIR_FILTER_CLASS, S_make_fir_filter, order, xcoeffs, NULL, state));
}
-static int free_env_gen(mus_any *pt)
+mus_any *mus_make_iir_filter(int order, mus_float_t *ycoeffs, mus_float_t *state)
{
- seg *ptr = (seg *)pt;
- if (ptr)
- {
- if (ptr->locs) {clm_free(ptr->locs); ptr->locs = NULL;}
- if (ptr->rates) {clm_free(ptr->rates); ptr->rates = NULL;}
- if ((ptr->original_data) && (ptr->data_allocated)) {clm_free(ptr->original_data); ptr->original_data = NULL;}
- clm_free(ptr);
- }
- return(0);
+ return(make_filter(&IIR_FILTER_CLASS, S_make_iir_filter, order, NULL, ycoeffs, state));
}
-static mus_float_t *env_data(mus_any *ptr) {return(((seg *)ptr)->original_data);} /* mus-data */
+mus_float_t *mus_make_fir_coeffs(int order, mus_float_t *envl, mus_float_t *aa)
+{
+ /* envl = evenly sampled freq response, has order samples */
+ int n, i, j, jj;
+ mus_float_t scl;
+ mus_float_t *a;
-static mus_float_t env_scaler(mus_any *ptr) {return(((seg *)ptr)->original_scaler);} /* "mus_float_t" for mus-scaler */
+ n = order;
+ if (n <= 0) return(aa);
+ if (aa)
+ a = aa;
+ else a = (mus_float_t *)calloc(order + 1, sizeof(mus_float_t));
+ if (!a) return(NULL);
+ if (!(is_power_of_2(order)))
+ {
+ int m;
+ mus_float_t am, q, xt0, x;
+ m = (n + 1) / 2;
+ am = 0.5 * (n + 1) - 1.0;
+ scl = 2.0 / (mus_float_t)n;
+ q = TWO_PI / (mus_float_t)n;
+ xt0 = envl[0] * 0.5;
+ for (j = 0, jj = n - 1; j < m; j++, jj--)
+ {
+ mus_float_t xt, qj;
+#if HAVE_SINCOS
+ double s1, c1, s2, c2, qj1;
+ xt = xt0;
+ qj = q * (am - j);
+ sincos(qj, &s1, &c1);
+ qj1 = qj * 2.0;
+ for (i = 1, x = qj; i < m; i += 2, x += qj1)
+ {
+ sincos(x, &s2, &c2);
+ xt += (envl[i] * c2);
+ if (i < (m - 1))
+ xt += (envl[i + 1] * (c1 * c2 - s1 * s2));
+ }
+#else
+ xt = xt0;
+ qj = q * (am - j);
+ for (i = 1, x = qj; i < m; i++, x += qj)
+ xt += (envl[i] * cos(x));
+#endif
+ a[j] = xt * scl;
+ a[jj] = a[j];
+ }
+ }
+ else /* use fft if it's easy to match -- there must be a way to handle non-power-of-2 orders here
+ * stretch envl to a power of 2, fft, subsample?
+ */
+ {
+ mus_float_t *rl, *im;
+ mus_long_t fsize;
+ int lim;
+ mus_float_t offset;
-static mus_float_t env_offset(mus_any *ptr) {return(((seg *)ptr)->original_offset);}
+ fsize = 2 * order; /* checked power of 2 above */
+ rl = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
+ im = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
+ lim = order / 2;
+ memcpy((void *)rl, (void *)envl, lim * sizeof(mus_float_t));
-int mus_env_breakpoints(mus_any *ptr) {return(((seg *)ptr)->size);}
+ mus_fft(rl, im, fsize, 1);
-static mus_long_t env_length(mus_any *ptr) {return((((seg *)ptr)->end + 1));} /* this needs to match the :length arg to make-env (changed to +1, 20-Feb-08) */
+ scl = 4.0 / fsize;
+ offset = -2.0 * envl[0] / fsize;
+ for (i = 0; i < fsize; i++)
+ rl[i] = rl[i] * scl + offset;
+ for (i = 1, j = lim - 1, jj = lim; i < order; i += 2, j--, jj++)
+ {
+ a[j] = rl[i];
+ a[jj] = rl[i];
+ }
+ free(rl);
+ free(im);
+ }
-static mus_float_t env_current_value(mus_any *ptr) {return(((seg *)ptr)->current_value);}
+ return(a);
+}
-mus_long_t *mus_env_passes(mus_any *gen) {return(((seg *)gen)->locs);}
-double *mus_env_rates(mus_any *gen) {return(((seg *)gen)->rates);}
-static int env_position(mus_any *ptr) {return(((seg *)ptr)->index);}
+/* ---------------- one-pole-all-pass ---------------- */
-double mus_env_offset(mus_any *gen) {return(((seg *)gen)->offset);}
+typedef struct {
+ mus_any_class *core;
+ int size;
+ mus_float_t coeff;
+ mus_float_t *x, *y;
+ mus_float_t (*f)(mus_any *ptr, mus_float_t input);
+} onepall;
-double mus_env_scaler(mus_any *gen) {return(((seg *)gen)->scaler);}
-double mus_env_initial_power(mus_any *gen) {return(((seg *)gen)->init_power);}
+static void free_onepall(mus_any *ptr)
+{
+ onepall *f = (onepall *)ptr;
+ if (f->x) {free(f->x); f->x = NULL;}
+ if (f->y) {free(f->y); f->y = NULL;}
+ free(ptr);
+}
-static mus_long_t seg_pass(mus_any *ptr) {return(((seg *)ptr)->loc);}
+static mus_any *onepall_copy(mus_any *ptr)
+{
+ onepall *g, *p;
+ int bytes;
-static void env_set_location(mus_any *ptr, mus_long_t val);
+ p = (onepall *)ptr;
+ g = (onepall *)malloc(sizeof(onepall));
+ memcpy((void *)g, (void *)ptr, sizeof(onepall));
-static mus_long_t seg_set_pass(mus_any *ptr, mus_long_t val) {env_set_location(ptr, val); return(val);}
+ bytes = g->size * sizeof(mus_float_t);
+ g->x = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->x), (void *)(p->x), bytes);
+ g->y = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->y), (void *)(p->y), bytes);
+ return((mus_any *)g);
+}
-static mus_float_t env_increment(mus_any *rd)
+
+static mus_float_t run_onepall(mus_any *ptr, mus_float_t input, mus_float_t unused)
{
- if (((seg *)rd)->style == MUS_ENV_STEP)
- return(0.0);
- return(((seg *)rd)->base);
+ return((((onepall *)ptr)->f)(ptr, input));
}
-static void env_reset(mus_any *ptr)
+static mus_long_t onepall_length(mus_any *ptr)
{
- seg *gen = (seg *)ptr;
- gen->current_value = gen->init_y;
- gen->loc = 0;
- gen->index = 0;
- gen->rate = gen->rates[0];
- gen->power = gen->init_power;
+ return(((onepall *)ptr)->size);
}
-static void rebuild_env(seg *e, mus_float_t scl, mus_float_t off, mus_long_t end)
+static void onepall_reset(mus_any *ptr)
{
- seg *new_e;
+ onepall *f = (onepall *)ptr;
+ int size;
+ size = f->size;
+ memset((void *)(f->x), 0, size * sizeof(mus_float_t));
+ memset((void *)(f->y), 0, size * sizeof(mus_float_t));
+}
- new_e = (seg *)mus_make_env(e->original_data, e->size, scl, off, e->base, 0.0, end, e->original_data);
- if (e->locs) clm_free(e->locs);
- if (e->rates) clm_free(e->rates);
- e->locs = new_e->locs;
- e->rates = new_e->rates;
- e->init_y = new_e->init_y;
- e->init_power = new_e->init_power;
- env_reset((mus_any *)e);
+static bool onepall_equalp(mus_any *p1, mus_any *p2)
+{
+ onepall *f1 = (onepall *)p1;
+ onepall *f2 = (onepall *)p2;
- clm_free(new_e);
+ if (f1 == f2) return(true);
+ if (f1->size != f2->size) return(false);
+ if (f1->coeff != f2->coeff) return(false);
+
+ return((mus_arrays_are_equal(f1->x, f2->x, float_equal_fudge_factor, f1->size)) &&
+ (mus_arrays_are_equal(f1->y, f2->y, float_equal_fudge_factor, f1->size)));
}
-static mus_float_t env_set_scaler(mus_any *ptr, mus_float_t val)
+static char *describe_onepall(mus_any *ptr)
{
- seg *e;
- e = (seg *)ptr;
- rebuild_env(e, val, e->original_offset, e->end);
- e->original_scaler = val;
- return(val);
+ onepall *gen = (onepall *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %d, coeff: %f",
+ mus_name(ptr),
+ gen->size,
+ gen->coeff);
+ return(describe_buffer);
}
-static mus_float_t env_set_offset(mus_any *ptr, mus_float_t val)
+mus_float_t mus_one_pole_all_pass(mus_any *ptr, mus_float_t input)
{
- seg *e;
- e = (seg *)ptr;
- rebuild_env(e, e->original_scaler, val, e->end);
- e->original_offset = val;
- return(val);
+ return((((onepall *)ptr)->f)(ptr, input));
}
+static mus_float_t one_pole_all_pass_n(mus_any *f, mus_float_t input)
+{
+ onepall *p = (onepall *)f;
+ int i;
+ mus_float_t coeff, y0;
+ mus_float_t *x, *y;
-static mus_long_t env_set_length(mus_any *ptr, mus_long_t val)
+ x = p->x;
+ y = p->y;
+ coeff = p->coeff;
+
+ y0 = input;
+ for (i = 0; i < p->size; i++)
+ {
+ y[i] = x[i] + (coeff * (y0 - y[i]));
+ x[i] = y0;
+ y0 = y[i];
+ }
+ return(y0);
+}
+
+static mus_float_t one_pole_all_pass_8(mus_any *f, mus_float_t input)
{
- seg *e;
- e = (seg *)ptr;
- rebuild_env(e, e->original_scaler, e->original_offset, val - 1);
- e->end = val - 1;
- return(val);
+ onepall *p = (onepall *)f;
+ mus_float_t coeff;
+ mus_float_t *x, *y;
+
+ x = p->x;
+ y = p->y;
+ coeff = p->coeff;
+
+ y[0] = x[0] + (coeff * (input - y[0])); x[0] = input;
+ y[1] = x[1] + (coeff * (y[0] - y[1])); x[1] = y[0];
+ y[2] = x[2] + (coeff * (y[1] - y[2])); x[2] = y[1];
+ y[3] = x[3] + (coeff * (y[2] - y[3])); x[3] = y[2];
+ y[4] = x[4] + (coeff * (y[3] - y[4])); x[4] = y[3];
+ y[5] = x[5] + (coeff * (y[4] - y[5])); x[5] = y[4];
+ y[6] = x[6] + (coeff * (y[5] - y[6])); x[6] = y[5];
+ y[7] = x[7] + (coeff * (y[6] - y[7])); x[7] = y[6];
+
+ return(y[7]);
}
+static mus_float_t one_pole_all_pass_1(mus_any *f, mus_float_t input)
+{
+ onepall *p = (onepall *)f;
-static mus_any_class ENV_CLASS = {
- MUS_ENV,
- (char *)S_env,
- &free_env_gen,
- &describe_env,
- &env_equalp,
- &env_data, /* mus-data -> original breakpoints */
- 0,
- &env_length, &env_set_length,
+ p->y[0] = p->x[0] + (p->coeff * (input - p->y[0]));
+ p->x[0] = input;
+ return(p->y[0]);
+}
+
+
+static mus_any_class ONE_POLE_ALL_PASS_CLASS = {
+ MUS_ONE_POLE_ALL_PASS,
+ (char *)S_one_pole_all_pass,
+ &free_onepall,
+ &describe_onepall,
+ &onepall_equalp,
+ 0, 0,
+ &onepall_length, 0,
0, 0,
- &env_current_value, 0, /* mus-phase?? -- used in snd-sig.c, but this needs a better access point */
- &env_scaler, &env_set_scaler,
- &env_increment,
- 0,
- &run_env,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_onepall,
MUS_NOT_SPECIAL,
- NULL,
- &env_position,
- &env_offset, &env_set_offset,
- 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0,
- &seg_pass, &seg_set_pass,
- 0,
- 0, 0, 0, 0, 0,
- &env_reset,
- 0, 0, 0
+ NULL, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &onepall_reset,
+ 0, &onepall_copy
};
-mus_any *mus_make_env(mus_float_t *brkpts, int npts, double scaler, double offset, double base, double duration, mus_long_t end, mus_float_t *odata)
+mus_any *mus_make_one_pole_all_pass(int size, mus_float_t coeff)
{
- int i;
- mus_long_t dur_in_samples;
- mus_float_t *edata;
- seg *e = NULL;
-
- for (i = 2; i < npts * 2; i += 2)
- if (brkpts[i - 2] >= brkpts[i])
- {
- char *temp = NULL;
- mus_error(MUS_BAD_ENVELOPE, S_make_env ": env at breakpoint %d: x axis value: %f <= previous x value: %f (env: %s)",
- i / 2, brkpts[i], brkpts[i - 2],
- temp = float_array_to_string(brkpts, npts * 2, 0)); /* minor memleak here */
- if (temp) clm_free(temp);
- return(NULL);
- }
+ onepall *gen;
- e = (seg *)clm_calloc(1, sizeof(seg), S_make_env);
- e->core = &ENV_CLASS;
-
- if (duration != 0.0)
- dur_in_samples = (mus_long_t)(duration * sampling_rate);
- else dur_in_samples = (end + 1);
+ gen = (onepall *)malloc(sizeof(onepall));
+ gen->core = &ONE_POLE_ALL_PASS_CLASS;
+ gen->size = size;
- e->init_y = offset + scaler * brkpts[1];
- e->current_value = e->init_y;
- e->rate = 0.0;
- e->offset = offset;
- e->scaler = scaler;
- e->original_offset = offset;
- e->original_scaler = scaler;
- e->base = base;
- e->end = (dur_in_samples - 1);
- e->loc = 0;
- e->index = 0;
+ gen->x = (mus_float_t *)calloc(size, sizeof(mus_float_t));
+ gen->y = (mus_float_t *)calloc(size, sizeof(mus_float_t));
+ gen->coeff = coeff;
- if (odata)
- e->original_data = odata;
+ if (size == 1)
+ gen->f = one_pole_all_pass_1;
else
- {
- e->original_data = (mus_float_t *)clm_calloc_atomic(npts * 2, sizeof(mus_float_t), "env original data");
- e->data_allocated = true;
+ {
+ if (size == 8)
+ gen->f = one_pole_all_pass_8;
+ else gen->f = one_pole_all_pass_n;
}
- if (e->original_data != brkpts)
- memcpy((void *)(e->original_data), (void *)brkpts, npts * 2 * sizeof(mus_float_t));
+ return((mus_any *)gen);
+}
- if (base == 0.0)
- {
- e->style = MUS_ENV_STEP;
- dmagify_env(e, brkpts, npts, dur_in_samples, scaler);
- }
- else
- {
- if (base == 1.0)
- {
- e->style = MUS_ENV_LINEAR;
- dmagify_env(e, brkpts, npts, dur_in_samples, scaler);
- }
- else
- {
- e->style = MUS_ENV_EXPONENTIAL;
- edata = fixup_exp_env(e, brkpts, npts, offset, scaler, base);
- if (edata == NULL)
- {
- if ((e->original_data) && (e->data_allocated)) clm_free(e->original_data);
- clm_free(e);
- return(NULL);
- }
+bool mus_is_one_pole_all_pass(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_ONE_POLE_ALL_PASS));
+}
+
+
+
+/* ---------------- env ---------------- */
+
+typedef enum {MUS_ENV_LINEAR, MUS_ENV_EXPONENTIAL, MUS_ENV_STEP} mus_env_t;
+
+typedef struct {
+ mus_any_class *core;
+ mus_float_t rate, current_value, base, offset, scaler, power, init_y, init_power, original_scaler, original_offset;
+ mus_long_t loc, end;
+ mus_env_t style;
+ int index, size;
+ mus_float_t *original_data;
+ mus_float_t *rates;
+ mus_long_t *locs;
+ mus_float_t (*env_func)(mus_any *g);
+ void *next;
+ void (*free_env)(mus_any *ptr);
+} seg;
+
+/* I used to use exp directly, but:
+
+ (define (texp1 start end num)
+ (let* ((ls (log start))
+ (le (log end))
+ (cf (exp (/ (- le ls) (1- num))))
+ (max-diff 0.0)
+ (xstart start))
+ (do ((i 0 (1+ i)))
+ ((= i num)
+ max-diff)
+ (let ((val1 (* start (exp (* (/ i (1- num)) (- le ls)))))
+ (val2 xstart))
+ (set! xstart (* xstart cf))
+ (set! max-diff (max max-diff (abs (- val1 val2))))))))
+
+ returns:
- dmagify_env(e, edata, npts, dur_in_samples, 1.0);
+ :(texp1 1.0 3.0 1000000)
+ 2.65991229042584e-10
+ :(texp1 1.0 10.0 100000000)
+ 2.24604939091932e-8
+ :(texp1 10.0 1000.0 100000000)
+ 4.11786902532185e-6
+ :(texp1 1.0 1.1 100000000)
+ 1.28246036013024e-9
+ :(texp1 10.0 1000.0 1000000000)
+ 4.39423240550241e-5
- e->power = exp(edata[1]);
- e->init_power = e->power;
- e->offset -= e->scaler;
- clm_free(edata);
- }
- }
+ so the repeated multiply version is more than accurate enough
+*/
- e->rate = e->rates[0];
- return((mus_any *)e);
+bool mus_is_env(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_ENV));
}
-static void env_set_location(mus_any *ptr, mus_long_t val)
+mus_float_t mus_env(mus_any *ptr)
{
seg *gen = (seg *)ptr;
- mus_long_t ctr = 0;
-
- if (gen->loc == val) return;
-
- if (gen->loc > val)
- mus_reset(ptr);
- else ctr = gen->loc;
- gen->loc = val;
-
- while ((gen->index < (gen->size - 1)) && /* this was gen->size */
- (ctr < val))
- {
- mus_long_t samps;
- if (val > gen->locs[gen->index])
- samps = gen->locs[gen->index] - ctr;
- else samps = val - ctr;
+ return((*(gen->env_func))(ptr));
+}
- switch (gen->style)
- {
- case MUS_ENV_LINEAR:
- gen->current_value += (samps * gen->rate);
- break;
- case MUS_ENV_STEP:
- gen->current_value = gen->rate;
- break;
+mus_float_t (*mus_env_function(mus_any *g))(mus_any *gen)
+{
+ if (mus_is_env(g))
+ return(((seg *)g)->env_func);
+ return(NULL);
+}
- case MUS_ENV_EXPONENTIAL:
- gen->power *= exp(samps * log(gen->rate));
- gen->current_value = gen->offset + (gen->scaler * gen->power);
- break;
- }
- ctr += samps;
- if (ctr < val)
- {
- gen->index++;
- if (gen->index < gen->size)
- gen->rate = gen->rates[gen->index];
- }
+static mus_float_t mus_env_step(mus_any *ptr)
+{
+ seg *gen = (seg *)ptr;
+ mus_float_t val;
+ val = gen->current_value;
+ if (gen->loc == 0)
+ {
+ gen->index++;
+ gen->loc = gen->locs[gen->index] - gen->locs[gen->index - 1];
+ gen->rate = gen->rates[gen->index];
+ gen->current_value = gen->rate;
}
+ gen->loc--;
+ return(val);
}
-double mus_env_interp(double x, mus_any *ptr)
+static mus_float_t mus_env_line(mus_any *ptr)
{
- /* the accuracy depends on the duration here -- more samples = more accurate */
seg *gen = (seg *)ptr;
- env_set_location(ptr, (mus_long_t)((x * (gen->end + 1)) / (gen->original_data[gen->size * 2 - 2])));
return(gen->current_value);
}
-mus_float_t mus_env_any(mus_any *e, mus_float_t (*connect_points)(mus_float_t val))
+static mus_float_t mus_env_linear(mus_any *ptr)
{
- /* "env_any" is supposed to mimic "out-any" */
- seg *gen = (seg *)e;
- mus_float_t *pts;
- int pt, size;
- mus_float_t y0, y1, new_val, val;
- double scaler, offset;
-
- scaler = gen->original_scaler;
- offset = gen->original_offset;
- size = gen->size;
+ seg *gen = (seg *)ptr;
+ mus_float_t val;
- if (size <= 1)
- return(offset + scaler * connect_points(0.0));
-
- pts = gen->original_data;
- pt = gen->index;
- if (pt >= (size - 1)) pt = size - 2;
- if (pts[pt * 2 + 1] <= pts[pt * 2 + 3])
+ val = gen->current_value;
+ if (gen->loc == 0)
{
- y0 = pts[pt * 2 + 1];
- y1 = pts[pt * 2 + 3];
+ /* we can save about 10% total env time by checking here that we're on the last segment,
+ * and setting gen->env_func to a version of mus_env_linear that does not watch gen->loc.
+ * In any case, this code is strange -- change anything and it is 20% slower, sez callgrind.
+ */
+ gen->index++;
+ gen->loc = gen->locs[gen->index] - gen->locs[gen->index - 1];
+ gen->rate = gen->rates[gen->index];
}
- else
+ gen->current_value += gen->rate;
+ gen->loc--;
+ return(val);
+}
+
+
+static mus_float_t mus_env_exponential(mus_any *ptr)
+{
+ seg *gen = (seg *)ptr;
+ mus_float_t val;
+ val = gen->current_value;
+ if (gen->loc == 0)
{
- y1 = pts[pt * 2 + 1];
- y0 = pts[pt * 2 + 3];
+ gen->index++;
+ gen->loc = gen->locs[gen->index] - gen->locs[gen->index - 1];
+ gen->rate = gen->rates[gen->index];
}
-
- val = (mus_env(e) - offset) / scaler;
- new_val = connect_points( (val - y0) / (y1 - y0));
- return(offset + scaler * (y0 + new_val * (y1 - y0)));
+ gen->power *= gen->rate;
+ gen->current_value = gen->offset + (gen->scaler * gen->power);
+ gen->loc--;
+ return(val);
}
+static mus_float_t run_env(mus_any *ptr, mus_float_t unused1, mus_float_t unused2)
+{
+ return(mus_env(ptr));
+}
-/* ---------------- frame ---------------- */
-/* frame = vector, mixer = (square) matrix, but "vector" is in use already, and "matrix" sounds too techy */
+static void canonicalize_env(seg *e, const mus_float_t *data, int pts, mus_long_t dur, mus_float_t scaler)
+{
+ int i, j, pts2;
+ mus_float_t xscl, cur_loc, x1, y1, xdur;
+ mus_long_t samps, pre_loc;
-/* someday frames and vcts should be combined, and mixers/sound-data
- */
+ /* pts > 1 if we get here, so the loop below is always exercised */
-typedef struct {
- mus_any_class *core;
- int chans;
- mus_float_t *vals;
- bool data_allocated;
-} mus_frame;
+ pts2 = pts * 2;
+ xdur = data[pts2 - 2] - data[0];
+ if (xdur > 0.0)
+ xscl = (mus_float_t)(dur - 1) / xdur;
+ else xscl = 1.0;
+ e->locs[pts - 2] = e->end;
+ x1 = data[0];
+ y1 = data[1];
+ pre_loc = 0;
-static int free_frame(mus_any *pt)
-{
- mus_frame *ptr = (mus_frame *)pt;
- if (ptr)
+ for (j = 0, i = 2, cur_loc = 0.0; i < pts2; i += 2, j++)
{
- if ((ptr->vals) && (ptr->data_allocated)) clm_free(ptr->vals);
- clm_free(ptr);
- }
- return(0);
-}
+ mus_float_t cur_dx, x0, y0;
+ x0 = x1;
+ x1 = data[i];
+ y0 = y1;
+ y1 = data[i + 1];
+ cur_dx = xscl * (x1 - x0);
+ if (cur_dx < 1.0)
+ cur_loc += 1.0;
+ else cur_loc += cur_dx;
-static char *describe_frame(mus_any *ptr)
-{
- mus_frame *gen = (mus_frame *)ptr;
- char *str = NULL;
- char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s[%d]: %s",
- mus_name(ptr),
- gen->chans,
- str = float_array_to_string(gen->vals, gen->chans, 0));
- if (str) clm_free(str);
- return(describe_buffer);
-}
+ switch (e->style)
+ {
+ case MUS_ENV_LINEAR:
+ e->locs[j] = (mus_long_t)(cur_loc + 0.5);
+ samps = e->locs[j] - pre_loc;
+ pre_loc = e->locs[j];
+ if (samps == 0)
+ e->rates[j] = 0.0;
+ else e->rates[j] = scaler * (y1 - y0) / (mus_float_t)samps;
+ break;
-bool mus_frame_p(mus_any *ptr)
-{
- return((ptr) &&
- (ptr->core->type == MUS_FRAME));
+ case MUS_ENV_EXPONENTIAL:
+ e->locs[j] = (mus_long_t)(cur_loc + 0.5);
+ samps = e->locs[j] - pre_loc;
+ pre_loc = e->locs[j];
+
+ if (samps == 0)
+ e->rates[j] = 1.0;
+ else e->rates[j] = exp((y1 - y0) / (mus_float_t)samps);
+ break;
+
+ case MUS_ENV_STEP:
+ e->locs[j] = (mus_long_t)cur_loc; /* this is the change boundary (confusing...) */
+ e->rates[j] = e->offset + (scaler * y0);
+ break;
+ }
+ }
+
+ e->locs[pts - 1] = 1000000000;
+ e->locs[pts] = 1000000000; /* guard cell at end to make bounds check simpler */
}
-static bool equalp_frame(mus_any *p1, mus_any *p2)
+static mus_float_t *fixup_exp_env(seg *e, const mus_float_t *data, int pts, mus_float_t offset, mus_float_t scaler, mus_float_t base)
{
- mus_frame *g1, *g2;
- if (p1 == p2) return(true);
- g1 = (mus_frame *)p1;
- g2 = (mus_frame *)p2;
- return(((g1->core)->type == (g2->core)->type) &&
- (g1->chans == g2->chans) &&
- (clm_arrays_are_equal(g1->vals, g2->vals, g1->chans)));
-}
+ mus_float_t min_y, max_y, val = 0.0, tmp = 0.0, b1;
+ int len, i;
+ bool flat;
+ mus_float_t *result = NULL;
+ if ((base <= 0.0) ||
+ (base == 1.0))
+ return(NULL);
-static mus_float_t run_frame(mus_any *ptr, mus_float_t arg1, mus_float_t arg2) {return(mus_frame_ref(ptr, (int)arg1));}
-static mus_float_t *frame_data(mus_any *ptr) {return(((mus_frame *)ptr)->vals);}
-static mus_long_t frame_length(mus_any *ptr) {return(((mus_frame *)ptr)->chans);}
-static int frame_channels(mus_any *ptr) {return(((mus_frame *)ptr)->chans);}
+ min_y = offset + scaler * data[1];
+ max_y = min_y;
+ len = pts * 2;
-static void frame_reset(mus_any *ptr)
-{
- mus_frame *gen = (mus_frame *)ptr;
- mus_clear_array(gen->vals, gen->chans);
-}
+ /* fill "result" with x and (offset+scaler*y) */
-static mus_any_class FRAME_CLASS = {
- MUS_FRAME,
- (char *)S_frame,
- &free_frame,
- &describe_frame,
- &equalp_frame,
- &frame_data, 0,
- &frame_length, 0,
- 0, 0, 0, 0,
- 0, 0,
- 0, 0,
- &run_frame,
- MUS_NOT_SPECIAL,
- NULL,
- &frame_channels,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
- &frame_reset,
- 0, 0, 0
-};
+ result = (mus_float_t *)malloc(len * sizeof(mus_float_t));
+ result[0] = data[0];
+ result[1] = min_y;
+ for (i = 2; i < len; i += 2)
+ {
+ tmp = offset + scaler * data[i + 1];
+ result[i] = data[i];
+ result[i + 1] = tmp;
+ if (tmp < min_y) min_y = tmp;
+ if (tmp > max_y) max_y = tmp;
+ }
-mus_any *mus_make_empty_frame(int chans)
-{
- mus_frame *nf;
- if (chans <= 0) return(NULL);
- nf = (mus_frame *)clm_calloc(1, sizeof(mus_frame), S_make_frame);
- nf->core = &FRAME_CLASS;
- nf->chans = chans;
- nf->vals = (mus_float_t *)clm_calloc_atomic(chans, sizeof(mus_float_t), "frame data");
- nf->data_allocated = true;
- return((mus_any *)nf);
+ b1 = base - 1.0;
+ flat = (min_y == max_y);
+ if (!flat)
+ val = 1.0 / (max_y - min_y);
+
+ /* now logify result */
+ for (i = 1; i < len; i += 2)
+ {
+ if (flat)
+ tmp = 1.0;
+ else tmp = val * (result[i] - min_y);
+ result[i] = log(1.0 + (tmp * b1));
+ }
+
+ e->scaler = (max_y - min_y) / b1;
+ e->offset = min_y;
+ return(result);
}
-mus_any *mus_make_frame_with_data(int chans, mus_float_t *data)
+static bool env_equalp(mus_any *p1, mus_any *p2)
{
- /* for CLM */
- mus_frame *nf;
- if (chans <= 0) return(NULL);
- nf = (mus_frame *)clm_calloc(1, sizeof(mus_frame), S_make_frame);
- nf->core = &FRAME_CLASS;
- nf->chans = chans;
- nf->vals = data;
- nf->data_allocated = false;
- return((mus_any *)nf);
+ seg *e1 = (seg *)p1;
+ seg *e2 = (seg *)p2;
+ if (p1 == p2) return(true);
+ return((e1) && (e2) &&
+ (e1->core->type == e2->core->type) &&
+ (e1->loc == e2->loc) &&
+ (e1->end == e2->end) &&
+ (e1->style == e2->style) &&
+ (e1->index == e2->index) &&
+ (e1->size == e2->size) &&
+
+ (e1->rate == e2->rate) &&
+ (e1->base == e2->base) &&
+ (e1->power == e2->power) &&
+ (e1->current_value == e2->current_value) &&
+ (e1->scaler == e2->scaler) &&
+ (e1->offset == e2->offset) &&
+ (e1->init_y == e2->init_y) &&
+ (e1->init_power == e2->init_power) &&
+ (clm_arrays_are_equal(e1->original_data, e2->original_data, e1->size * 2)));
}
-mus_any *mus_make_frame(int chans, ...)
+static char *describe_env(mus_any *ptr)
{
- if (chans <= 0)
- mus_error(MUS_ARG_OUT_OF_RANGE, S_make_frame ": chans: %d", chans);
- else
- {
- mus_frame *nf = NULL;
- nf = (mus_frame *)mus_make_empty_frame(chans);
- if (nf)
- {
- int i;
- va_list ap;
- va_start(ap, chans);
- for (i = 0; i < chans; i++)
- nf->vals[i] = (mus_float_t)(va_arg(ap, double)); /* float not safe here apparently */
- va_end(ap);
- return((mus_any *)nf);
- }
- }
- return(NULL);
+ char *str = NULL;
+ seg *e = (seg *)ptr;
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s, pass: %lld (dur: %lld), index: %d, scaler: %.4f, offset: %.4f, data: %s",
+ mus_name(ptr),
+ ((e->style == MUS_ENV_LINEAR) ? "linear" : ((e->style == MUS_ENV_EXPONENTIAL) ? "exponential" : "step")),
+ (e->locs) ? (e->locs[e->index] - e->loc) : -1,
+ e->end + 1,
+ e->index,
+ e->original_scaler,
+ e->original_offset,
+ str = float_array_to_string(e->original_data, e->size * 2, 0));
+ if (str) free(str);
+ return(describe_buffer);
}
-mus_any *mus_frame_add(mus_any *uf1, mus_any *uf2, mus_any *ures)
+static seg *e2_free_list = NULL, *e3_free_list = NULL, *e4_free_list = NULL;
+
+static void free_env_gen(mus_any *pt)
{
- int chans, i;
- mus_frame *f1 = (mus_frame *)uf1;
- mus_frame *f2 = (mus_frame *)uf2;
- mus_frame *res = (mus_frame *)ures;
-
- chans = f1->chans;
- if (f2->chans < chans) chans = f2->chans;
- if (res)
- {
- if (res->chans < chans) chans = res->chans;
- }
- else res = (mus_frame *)mus_make_empty_frame(chans);
- for (i = 0; i < chans; i++)
- res->vals[i] = f1->vals[i] + f2->vals[i];
- return((mus_any *)res);
+ seg *ptr = (seg *)pt;
+ (*(ptr->free_env))(pt);
}
+static void fe2(mus_any *pt)
+{
+ seg *ptr = (seg *)pt;
+ ptr->next = e2_free_list;
+ e2_free_list = ptr;
+}
-mus_any *mus_frame_multiply(mus_any *uf1, mus_any *uf2, mus_any *ures)
+static void fe3(mus_any *pt)
{
- int chans, i;
- mus_frame *f1 = (mus_frame *)uf1;
- mus_frame *f2 = (mus_frame *)uf2;
- mus_frame *res = (mus_frame *)ures;
+ seg *ptr = (seg *)pt;
+ ptr->next = e3_free_list;
+ e3_free_list = ptr;
+}
- chans = f1->chans;
- if (f2->chans < chans) chans = f2->chans;
- if (res)
- {
- if (res->chans < chans)
- chans = res->chans;
- }
- else res = (mus_frame *)mus_make_empty_frame(chans);
- for (i = 0; i < chans; i++)
- res->vals[i] = f1->vals[i] * f2->vals[i];
- return((mus_any *)res);
+static void fe4(mus_any *pt)
+{
+ seg *ptr = (seg *)pt;
+ ptr->next = e4_free_list;
+ e4_free_list = ptr;
}
+static void ferest(mus_any *pt)
+{
+ seg *ptr = (seg *)pt;
+ if (ptr->locs) {free(ptr->locs); ptr->locs = NULL;}
+ if (ptr->rates) {free(ptr->rates); ptr->rates = NULL;}
+ free(ptr);
+}
-mus_any *mus_frame_scale(mus_any *uf1, mus_float_t scl, mus_any *ures)
+static mus_any *seg_copy(mus_any *ptr)
{
- int chans, i;
- mus_frame *f1 = (mus_frame *)uf1;
- mus_frame *res = (mus_frame *)ures;
+ seg *e = NULL, *p;
+ p = (seg *)ptr;
- chans = f1->chans;
- if (res)
+ switch (p->size) /* "npts" */
{
- if (res->chans < chans)
- chans = res->chans;
+ case 1:
+ e = (seg *)malloc(sizeof(seg));
+ memcpy((void *)e, (void *)ptr, sizeof(seg));
+ return((mus_any *)e);
+
+ case 2: if (e2_free_list) {e = e2_free_list; e2_free_list = (seg *)(e->next);} break;
+ case 3: if (e3_free_list) {e = e3_free_list; e3_free_list = (seg *)(e->next);} break;
+ case 4: if (e4_free_list) {e = e4_free_list; e4_free_list = (seg *)(e->next);} break;
+ default: break;
}
- else res = (mus_frame *)mus_make_empty_frame(chans);
- for (i = 0; i < chans; i++)
- res->vals[i] = f1->vals[i] * scl;
- return((mus_any *)res);
-}
+ if (!e)
+ {
+ e = (seg *)malloc(sizeof(seg));
+ memcpy((void *)e, (void *)ptr, sizeof(seg));
+ if (p->rates)
+ {
+ int bytes;
+ bytes = p->size * sizeof(mus_float_t);
+ e->rates = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(e->rates), (void *)(p->rates), bytes);
+
+ bytes = (p->size + 1) * sizeof(mus_long_t);
+ e->locs = (mus_long_t *)malloc(bytes);
+ memcpy((void *)(e->locs), (void *)(p->locs), bytes);
+ }
+ }
+ else
+ {
+ mus_float_t *r;
+ mus_long_t *l;
+ int bytes;
-mus_any *mus_frame_offset(mus_any *uf1, mus_float_t offset, mus_any *ures)
-{
- int chans, i;
- mus_frame *f1 = (mus_frame *)uf1;
- mus_frame *res = (mus_frame *)ures;
+ bytes = p->size * sizeof(mus_float_t);
+ r = e->rates;
+ memcpy((void *)r, (void *)(p->rates), bytes);
- chans = f1->chans;
- if (res)
- {
- if (res->chans < chans) chans = res->chans;
+ bytes = (p->size + 1) * sizeof(mus_long_t);
+ l = e->locs;
+ memcpy((void *)l, (void *)(p->locs), bytes);
+
+ memcpy((void *)e, (void *)ptr, sizeof(seg));
+ e->rates = r;
+ e->locs = l;
}
- else res = (mus_frame *)mus_make_empty_frame(chans);
- for (i = 0; i < chans; i++)
- res->vals[i] = f1->vals[i] + offset;
- return((mus_any *)res);
+ return((mus_any *)e);
}
+static mus_float_t *env_data(mus_any *ptr) {return(((seg *)ptr)->original_data);} /* mus-data */
-mus_float_t mus_frame_ref(mus_any *uf, int chan)
-{
- mus_frame *f = (mus_frame *)uf;
- if ((chan >= 0) && (chan < f->chans))
- return(f->vals[chan]);
- return((mus_float_t)mus_error(MUS_ARG_OUT_OF_RANGE,
- S_frame_ref ": invalid chan: %d (frame has %d chan%s)",
- chan, f->chans, (f->chans == 1) ? "" : "s"));
-}
+static mus_float_t env_scaler(mus_any *ptr) {return(((seg *)ptr)->original_scaler);} /* "mus_float_t" for mus-scaler */
+static mus_float_t env_offset(mus_any *ptr) {return(((seg *)ptr)->original_offset);}
-mus_float_t mus_frame_set(mus_any *uf, int chan, mus_float_t val)
-{
- mus_frame *f = (mus_frame *)uf;
- if ((chan >= 0) && (chan < f->chans))
- f->vals[chan] = val;
- else mus_error(MUS_ARG_OUT_OF_RANGE,
- S_frame_set ": invalid chan: %d (frame has %d chan%s)",
- chan, f->chans, (f->chans == 1) ? "" : "s");
- return(val);
-}
+int mus_env_breakpoints(mus_any *ptr) {return(((seg *)ptr)->size);}
+static mus_long_t env_length(mus_any *ptr) {return((((seg *)ptr)->end + 1));} /* this needs to match the :length arg to make-env (changed to +1, 20-Feb-08) */
-mus_any *mus_frame_copy(mus_any *uf)
-{
- mus_frame *f = (mus_frame *)uf;
- mus_frame *nf;
- nf = (mus_frame *)mus_make_empty_frame(f->chans);
- memcpy((void *)(nf->vals), (void *)(f->vals), f->chans * sizeof(mus_float_t));
- return((mus_any *)nf);
-}
+static mus_float_t env_current_value(mus_any *ptr) {return(((seg *)ptr)->current_value);}
+mus_long_t *mus_env_passes(mus_any *gen) {return(((seg *)gen)->locs);}
-mus_float_t mus_frame_fill(mus_any *uf, mus_float_t val)
-{
- int i;
- mus_frame *f = (mus_frame *)uf;
- for (i = 0; i < f->chans; i++)
- f->vals[i] = val;
- return(val);
-}
+mus_float_t *mus_env_rates(mus_any *gen) {return(((seg *)gen)->rates);}
+
+static int env_position(mus_any *ptr) {return(((seg *)ptr)->index);}
+mus_float_t mus_env_offset(mus_any *gen) {return(((seg *)gen)->offset);}
+mus_float_t mus_env_scaler(mus_any *gen) {return(((seg *)gen)->scaler);}
-/* ---------------- mixer ---------------- */
+mus_float_t mus_env_initial_power(mus_any *gen) {return(((seg *)gen)->init_power);}
-typedef struct {
- mus_any_class *core;
- int chans;
- mus_float_t **vals;
- bool data_allocated;
-} mus_mixer;
+static void env_set_location(mus_any *ptr, mus_long_t val);
+static mus_long_t seg_set_pass(mus_any *ptr, mus_long_t val) {env_set_location(ptr, val); return(val);}
-static int free_mixer(mus_any *pt)
+static mus_long_t seg_pass(mus_any *ptr)
{
- mus_mixer *ptr = (mus_mixer *)pt;
- if (ptr)
- {
- if (ptr->vals)
- {
- int i;
- if (ptr->data_allocated)
- for (i = 0; i < ptr->chans; i++)
- clm_free(ptr->vals[i]);
- clm_free(ptr->vals);
- }
- clm_free(ptr);
- }
- return(0);
+ seg *gen = (seg *)ptr;
+ return(gen->locs[gen->index] - gen->loc);
}
-static void mixer_reset(mus_any *ptr)
+static mus_float_t env_increment(mus_any *rd)
{
- int i;
- mus_mixer *gen = (mus_mixer *)ptr;
- for (i = 0; i < gen->chans; i++)
- mus_clear_array(gen->vals[i], gen->chans);
+ if (((seg *)rd)->style == MUS_ENV_STEP)
+ return(0.0);
+ return(((seg *)rd)->base);
}
-static char *describe_mixer(mus_any *ptr)
+static void env_reset(mus_any *ptr)
{
- mus_mixer *gen = (mus_mixer *)ptr;
- char *str;
- int i, j, lim, bufsize;
- char *describe_buffer;
-
- lim = mus_array_print_length();
- if (gen->chans < lim) lim = gen->chans;
-
- bufsize = lim * lim * 16;
- if (bufsize < DESCRIBE_BUFFER_SIZE) bufsize = DESCRIBE_BUFFER_SIZE;
- if (bufsize > 65536) bufsize = 65536;
+ seg *gen = (seg *)ptr;
+ gen->current_value = gen->init_y;
+ gen->index = 0;
+ gen->loc = gen->locs[0];
+ gen->rate = gen->rates[0];
+ gen->power = gen->init_power;
+}
- describe_buffer = (char *)clm_malloc(bufsize, "describe buffer");
- if (gen->chans == 1)
- mus_snprintf(describe_buffer, bufsize, "%s chans: 1, [%.3f]", mus_name(ptr), gen->vals[0][0]);
- else
- {
- mus_snprintf(describe_buffer, bufsize, "%s chans: %d, [\n ", mus_name(ptr), gen->chans);
- str = (char *)clm_calloc(64, sizeof(char), "describe_mixer");
+static void rebuild_env(seg *e, mus_float_t scl, mus_float_t off, mus_long_t end)
+{
+ seg *new_e;
- for (i = 0; i < lim; i++)
- for (j = 0; j < lim; j++)
- {
- mus_snprintf(str, 64, "%.3f%s%s%s",
- gen->vals[i][j],
- ((j == (lim - 1)) && (lim < gen->chans)) ? "..." : "",
- (j == (lim - 1)) ? "\n" : "",
- ((i == (lim - 1)) && (j == (lim - 1))) ? "]" : " ");
- if ((int)(strlen(describe_buffer) + strlen(str)) < (bufsize - 1))
- strcat(describe_buffer, str);
- else break;
- }
+ new_e = (seg *)mus_make_env(e->original_data, e->size, scl, off, e->base, 0.0, end, NULL);
+ if (e->locs) free(e->locs);
+ if (e->rates) free(e->rates);
+ e->locs = new_e->locs;
+ e->rates = new_e->rates;
- clm_free(str);
- }
+ e->init_y = new_e->init_y;
+ e->init_power = new_e->init_power;
+ env_reset((mus_any *)e);
- return(describe_buffer);
+ free(new_e);
}
-bool mus_mixer_p(mus_any *ptr) {return((ptr) && (ptr->core->type == MUS_MIXER));}
-
-
-static bool equalp_mixer(mus_any *p1, mus_any *p2)
+static mus_float_t env_set_scaler(mus_any *ptr, mus_float_t val)
{
- int i;
- mus_mixer *g1, *g2;
- if (p1 == p2) return(true);
- if ((p1 == NULL) || (p2 == NULL)) return(false); /* is this needed? */
- g1 = (mus_mixer *)p1;
- g2 = (mus_mixer *)p2;
- if (((g1->core)->type != (g2->core)->type) ||
- (g1->chans != g2->chans))
- return(false);
- for (i = 0; i < g1->chans; i++)
- if (!(clm_arrays_are_equal(g1->vals[i], g2->vals[i], g1->chans)))
- return(false);
- return(true);
+ seg *e;
+ e = (seg *)ptr;
+ rebuild_env(e, val, e->original_offset, e->end);
+ e->original_scaler = val;
+ return(val);
}
-static mus_float_t run_mixer(mus_any *ptr, mus_float_t arg1, mus_float_t arg2) {return(mus_mixer_ref(ptr, (int)arg1, (int)arg2));}
+static mus_float_t env_set_offset(mus_any *ptr, mus_float_t val)
+{
+ seg *e;
+ e = (seg *)ptr;
+ rebuild_env(e, e->original_scaler, val, e->end);
+ e->original_offset = val;
+ return(val);
+}
-static mus_long_t mixer_length(mus_any *ptr) {return(((mus_mixer *)ptr)->chans);}
-static mus_float_t *mixer_data(mus_any *ptr) {return((mus_float_t *)(((mus_mixer *)ptr)->vals));}
+static mus_long_t env_set_length(mus_any *ptr, mus_long_t val)
+{
+ seg *e;
+ e = (seg *)ptr;
+ rebuild_env(e, e->original_scaler, e->original_offset, val - 1);
+ e->end = val - 1;
+ return(val);
+}
-static int mixer_channels(mus_any *ptr) {return(((mus_mixer *)ptr)->chans);}
-static mus_any_class MIXER_CLASS = {
- MUS_MIXER,
- (char *)S_mixer,
- &free_mixer,
- &describe_mixer,
- &equalp_mixer,
- &mixer_data, 0,
- &mixer_length,
+static mus_any_class ENV_CLASS = {
+ MUS_ENV,
+ (char *)S_env,
+ &free_env_gen,
+ &describe_env,
+ &env_equalp,
+ &env_data, /* mus-data -> original breakpoints */
0,
- 0, 0, 0, 0,
- 0, 0,
- 0, 0,
- &run_mixer,
+ &env_length, &env_set_length,
+ 0, 0,
+ &env_current_value, 0, /* mus-phase?? -- used in snd-sig.c, but this needs a better access point */
+ &env_scaler, &env_set_scaler,
+ &env_increment,
+ 0,
+ &run_env,
MUS_NOT_SPECIAL,
NULL,
- &mixer_channels,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
- &mixer_reset,
- 0, 0, 0
+ &env_position,
+ &env_offset, &env_set_offset,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &seg_pass, &seg_set_pass,
+ 0,
+ 0, 0, 0, 0,
+ &env_reset,
+ 0, &seg_copy
};
-mus_any *mus_make_mixer_with_data(int chans, mus_float_t *data)
+mus_any *mus_make_env(mus_float_t *brkpts, int npts, mus_float_t scaler, mus_float_t offset, mus_float_t base, mus_float_t duration, mus_long_t end, mus_float_t *ignored)
{
- /* for CLM */
- mus_mixer *nf;
+ /* brkpts are not freed by the new env gen when it is freed, but should be protected during its existence */
int i;
- if (chans <= 0) return(NULL);
- nf = (mus_mixer *)clm_calloc(1, sizeof(mus_mixer), S_make_mixer);
- nf->core = &MIXER_CLASS;
- nf->chans = chans;
- nf->vals = (mus_float_t **)clm_calloc_atomic(chans, sizeof(mus_float_t *), "mixer data");
- for (i = 0; i < chans; i++)
- nf->vals[i] = (mus_float_t *)(data + (i * chans));
- nf->data_allocated = false;
- return((mus_any *)nf);
-}
-
+ mus_long_t dur_in_samples;
+ mus_float_t *edata;
+ seg *e = NULL;
+ void (*fe_release)(mus_any *ptr);
-mus_any *mus_make_empty_mixer(int chans)
-{
- mus_mixer *nf = NULL;
- int i;
- nf = (mus_mixer *)clm_calloc(1, sizeof(mus_mixer), S_make_mixer);
- nf->core = &MIXER_CLASS;
- nf->chans = chans;
- nf->vals = (mus_float_t **)clm_calloc(chans, sizeof(mus_float_t *), "mixer data");
- for (i = 0; i < chans; i++)
- nf->vals[i] = (mus_float_t *)clm_calloc_atomic(chans, sizeof(mus_float_t), "mixer data");
- nf->data_allocated = true;
- return((mus_any *)nf);
-}
+ for (i = 2; i < npts * 2; i += 2)
+ if (brkpts[i - 2] >= brkpts[i])
+ {
+ char *temp = NULL;
+ mus_error(MUS_BAD_ENVELOPE, S_make_env ": env at breakpoint %d: x axis value: %f <= previous x value: %f (env: %s)",
+ i / 2, brkpts[i], brkpts[i - 2],
+ temp = float_array_to_string(brkpts, npts * 2, 0)); /* minor memleak here */
+ if (temp) free(temp);
+ return(NULL);
+ }
+ switch (npts)
+ {
+ case 1:
+ e = (seg *)calloc(1, sizeof(seg));
+ e->core = &ENV_CLASS;
+ e->current_value = offset + scaler * brkpts[1];
+ e->env_func = mus_env_line;
+ e->original_data = brkpts;
+ e->free_env = ferest;
+ return((mus_any *)e);
+
+ case 2:
+ if (e2_free_list)
+ {
+ e = e2_free_list;
+ e2_free_list = (seg *)(e->next);
+ }
+ fe_release = fe2;
+ break;
-mus_any *mus_make_scalar_mixer(int chans, mus_float_t scalar)
-{
- mus_mixer *mx = NULL;
- if (chans <= 0)
- mus_error(MUS_ARG_OUT_OF_RANGE, S_make_scalar_mixer ": chans: %d", chans);
- else
+ case 3:
+ if (e3_free_list)
+ {
+ e = e3_free_list;
+ e3_free_list = (seg *)(e->next);
+ }
+ fe_release = fe3;
+ break;
+
+ case 4:
+ if (e4_free_list)
+ {
+ e = e4_free_list;
+ e4_free_list = (seg *)(e->next);
+ }
+ fe_release = fe4;
+ break;
+
+ default:
+ fe_release = ferest;
+ break;
+ }
+
+ if (!e)
{
- int i;
- mx = (mus_mixer *)mus_make_empty_mixer(chans);
- if (mx) for (i = 0; i < chans; i++) mx->vals[i][i] = scalar;
+ e = (seg *)malloc(sizeof(seg));
+ e->core = &ENV_CLASS;
+ e->size = npts;
+ e->rates = (mus_float_t *)malloc(npts * sizeof(mus_float_t));
+ e->locs = (mus_long_t *)malloc((npts + 1) * sizeof(mus_long_t));
}
- return((mus_any *)mx);
-}
+ e->free_env = fe_release;
+ e->original_data = brkpts;
-mus_any *mus_make_identity_mixer(int chans)
-{
- return(mus_make_scalar_mixer(chans, 1.0));
-}
+ if (duration != 0.0)
+ dur_in_samples = (mus_long_t)(duration * sampling_rate);
+ else dur_in_samples = (end + 1);
+ e->init_y = offset + scaler * brkpts[1];
+ e->current_value = e->init_y;
+ e->rate = 0.0;
+ e->offset = offset;
+ e->scaler = scaler;
+ e->original_offset = offset;
+ e->original_scaler = scaler;
+ e->base = base;
+ e->end = (dur_in_samples - 1);
+ e->loc = 0;
+ e->index = 0;
-mus_any *mus_make_mixer(int chans, ...)
-{
- mus_mixer *mx = NULL;
- if (chans <= 0)
- mus_error(MUS_ARG_OUT_OF_RANGE, S_make_mixer ": chans: %d", chans);
+ if (base == 1.0)
+ {
+ e->style = MUS_ENV_LINEAR;
+ if ((npts == 2) &&
+ (brkpts[1] == brkpts[3]))
+ e->env_func = mus_env_line;
+ else e->env_func = mus_env_linear;
+ e->power = 0.0;
+ e->init_power = 0.0;
+ canonicalize_env(e, brkpts, npts, dur_in_samples, scaler);
+ e->rates[npts - 1] = 0.0;
+ }
else
{
- mx = (mus_mixer *)mus_make_empty_mixer(chans);
- if (mx)
+ if (base == 0.0)
+ {
+ e->style = MUS_ENV_STEP;
+ e->env_func = mus_env_step;
+ e->power = 0.0;
+ e->init_power = 0.0;
+ canonicalize_env(e, brkpts, npts, dur_in_samples, scaler);
+ e->rates[npts - 1] = e->offset + (scaler * brkpts[npts * 2 - 1]); /* stick at last value, which in this case is the value (not an increment) */
+ }
+ else
{
- int i, j;
- va_list ap;
- va_start(ap, chans);
- for (i = 0; i < chans; i++)
- for (j = 0; j < chans; j++)
- mx->vals[i][j] = (mus_float_t)(va_arg(ap, double));
- va_end(ap);
+ e->style = MUS_ENV_EXPONENTIAL;
+ e->env_func = mus_env_exponential;
+ edata = fixup_exp_env(e, brkpts, npts, offset, scaler, base);
+ if (edata == NULL)
+ {
+ free(e);
+ return(NULL);
+ }
+ canonicalize_env(e, edata, npts, dur_in_samples, 1.0);
+ e->rates[npts - 1] = 1.0;
+ e->power = exp(edata[1]);
+ e->init_power = e->power;
+ e->offset -= e->scaler;
+ free(edata);
}
}
- return((mus_any *)mx);
+
+ e->rate = e->rates[0];
+ e->loc = e->locs[0];
+ return((mus_any *)e);
}
+/* one way to make an impulse: (make-env '(0 1 1 0) :length 1 :base 0.0)
+ * a counter: (make-env '(0 0 1 1) :length 21 :scaler 20) -- length = 1+scaler
+ */
+
-mus_any *mus_mixer_copy(mus_any *uf)
+static void env_set_location(mus_any *ptr, mus_long_t val)
{
- int i, j;
- mus_mixer *f = (mus_mixer *)uf;
- mus_mixer *nf;
- nf = (mus_mixer *)mus_make_empty_mixer(f->chans);
- for (i = 0; i < f->chans; i++)
- for (j = 0; j < f->chans; j++)
- nf->vals[i][j] = f->vals[i][j];
- return((mus_any *)nf);
-}
+ seg *gen = (seg *)ptr;
+ mus_long_t ctr = 0, loc;
+ loc = gen->locs[gen->index] - gen->loc;
+ if (loc == val) return;
-mus_float_t mus_mixer_fill(mus_any *uf, mus_float_t val)
-{
- int i, j;
- mus_mixer *f = (mus_mixer *)uf;
- for (i = 0; i < f->chans; i++)
- for (j = 0; j < f->chans; j++)
- f->vals[i][j] = val;
- return(val);
+ if (loc > val)
+ mus_reset(ptr);
+ else ctr = loc;
+
+ while ((gen->index < (gen->size - 1)) && /* this was gen->size */
+ (ctr < val))
+ {
+ mus_long_t samps;
+ if (val > gen->locs[gen->index])
+ samps = gen->locs[gen->index] - ctr;
+ else samps = val - ctr;
+
+ switch (gen->style)
+ {
+ case MUS_ENV_LINEAR:
+ gen->current_value += (samps * gen->rate);
+ break;
+
+ case MUS_ENV_STEP:
+ gen->current_value = gen->rate;
+ break;
+
+ case MUS_ENV_EXPONENTIAL:
+ gen->power *= exp(samps * log(gen->rate));
+ gen->current_value = gen->offset + (gen->scaler * gen->power);
+ break;
+ }
+
+ ctr += samps;
+ if (ctr < val)
+ {
+ gen->index++;
+ if (gen->index < gen->size)
+ gen->rate = gen->rates[gen->index];
+ }
+ }
+ gen->loc = gen->locs[gen->index] - ctr;
}
-mus_float_t mus_mixer_ref(mus_any *uf, int in, int out)
+mus_float_t mus_env_interp(mus_float_t x, mus_any *ptr)
{
- mus_mixer *f = (mus_mixer *)uf;
- if ((in >= 0) && (in < f->chans) &&
- (out >= 0) && (out < f->chans))
- return(f->vals[in][out]);
- mus_error(MUS_ARG_OUT_OF_RANGE,
- S_mixer_ref ": invalid chan: %d (mixer has %d chan%s)",
- ((in < 0) || (in >= f->chans)) ? in : out,
- f->chans,
- (f->chans == 1) ? "" : "s");
- return(0.0);
+ /* the accuracy depends on the duration here -- more samples = more accurate */
+ seg *gen = (seg *)ptr;
+ env_set_location(ptr, (mus_long_t)((x * (gen->end + 1)) / (gen->original_data[gen->size * 2 - 2])));
+ return(gen->current_value);
}
-mus_float_t mus_mixer_set(mus_any *uf, int in, int out, mus_float_t val)
+mus_float_t mus_env_any(mus_any *e, mus_float_t (*connect_points)(mus_float_t val))
{
- mus_mixer *f = (mus_mixer *)uf;
- if ((in >= 0) && (in < f->chans) &&
- (out >= 0) && (out < f->chans))
- f->vals[in][out] = val;
- else mus_error(MUS_ARG_OUT_OF_RANGE,
- S_mixer_set ": invalid chan: %d (mixer has %d chan%s)",
- ((in < 0) || (in >= f->chans)) ? in : out,
- f->chans,
- (f->chans == 1) ? "" : "s");
- return(val);
-}
-
+ /* "env_any" is supposed to mimic "out-any" */
+ seg *gen = (seg *)e;
+ mus_float_t *pts;
+ int pt, size;
+ mus_float_t y0, y1, new_val, val;
+ mus_float_t scaler, offset;
-static mus_any *frame_to_frame_right(mus_any *arg1, mus_any *arg2, mus_any *arg_out)
-{
- /* (frame->frame frame mixer frame) = frame * mixer -> frame -- this is the original form */
- mus_mixer *mix = (mus_mixer *)arg2;
- mus_frame *frame = (mus_frame *)arg1;
- mus_frame *out = (mus_frame *)arg_out;
- int i, in_chans, out_chans;
+ scaler = gen->original_scaler;
+ offset = gen->original_offset;
+ size = gen->size;
- in_chans = frame->chans;
- if (in_chans > mix->chans)
- in_chans = mix->chans;
- out_chans = mix->chans;
- if (out)
+ if (size <= 1)
+ return(offset + scaler * connect_points(0.0));
+
+ pts = gen->original_data;
+ pt = gen->index;
+ if (pt >= (size - 1)) pt = size - 2;
+ if (pts[pt * 2 + 1] <= pts[pt * 2 + 3])
{
- if (out->chans < out_chans)
- out_chans = out->chans;
+ y0 = pts[pt * 2 + 1];
+ y1 = pts[pt * 2 + 3];
}
- else out = (mus_frame *)mus_make_empty_frame(out_chans);
- for (i = 0; i < out_chans; i++)
+ else
{
- int j;
- out->vals[i] = 0.0;
- for (j = 0; j < in_chans; j++)
- out->vals[i] += (frame->vals[j] * mix->vals[j][i]);
+ y1 = pts[pt * 2 + 1];
+ y0 = pts[pt * 2 + 3];
}
- return((mus_any *)out); /* not arg_out since out may be allocated above, and clm2xen.c expects this to be legit */
-}
-
-mus_any *mus_frame_to_frame_mono(mus_any *frame, mus_any *mix, mus_any *out)
-{
- /* assume every possible problem has already been checked somewhere */
- ((mus_frame *)out)->vals[0] = ((mus_frame *)frame)->vals[0] * ((mus_mixer *)mix)->vals[0][0];
- return(out);
+ val = (mus_env(e) - offset) / scaler;
+ new_val = connect_points( (val - y0) / (y1 - y0));
+ return(offset + scaler * (y0 + new_val * (y1 - y0)));
}
-mus_any *mus_frame_to_frame_stereo(mus_any *frame, mus_any *mix, mus_any *out)
-{
- ((mus_frame *)out)->vals[0] = ((mus_frame *)frame)->vals[0] * ((mus_mixer *)mix)->vals[0][0] +
- ((mus_frame *)frame)->vals[1] * ((mus_mixer *)mix)->vals[1][0];
- ((mus_frame *)out)->vals[1] = ((mus_frame *)frame)->vals[0] * ((mus_mixer *)mix)->vals[0][1] +
- ((mus_frame *)frame)->vals[1] * ((mus_mixer *)mix)->vals[1][1];
- return(out);
-}
-
+/* ---------------- pulsed-env ---------------- */
-mus_any *mus_frame_to_frame_mono_to_stereo(mus_any *frame, mus_any *mix, mus_any *out)
-{
- ((mus_frame *)out)->vals[0] = ((mus_frame *)frame)->vals[0] * ((mus_mixer *)mix)->vals[0][0];
- ((mus_frame *)out)->vals[1] = ((mus_frame *)frame)->vals[0] * ((mus_mixer *)mix)->vals[0][1];
- return(out);
-}
+typedef struct {
+ mus_any_class *core;
+ mus_any *e, *p;
+ bool gens_allocated;
+} plenv;
-static mus_any *frame_to_frame_left(mus_any *arg1, mus_any *arg2, mus_any *arg_out)
+static void free_pulsed_env(mus_any *ptr)
{
- /* (frame->frame mixer frame frame) = mixer * frame -> frame */
- mus_mixer *mix = (mus_mixer *)arg1;
- mus_frame *frame = (mus_frame *)arg2;
- mus_frame *out = (mus_frame *)arg_out;
- int i, in_chans, out_chans;
-
- in_chans = frame->chans;
- if (in_chans > mix->chans)
- in_chans = mix->chans;
- out_chans = mix->chans;
- if (out)
- {
- if (out->chans < out_chans)
- out_chans = out->chans;
- }
- else out = (mus_frame *)mus_make_empty_frame(out_chans);
- for (i = 0; i < out_chans; i++)
+ plenv *g;
+ g = (plenv *)ptr;
+ if (g->gens_allocated)
{
- int j;
- out->vals[i] = 0.0;
- for (j = 0; j < in_chans; j++)
- out->vals[i] += (mix->vals[i][j] * frame->vals[j]);
+ mus_free(g->e);
+ mus_free(g->p);
}
- return((mus_any *)out);
+ free(ptr);
}
-
-mus_any *mus_frame_to_frame(mus_any *arg1, mus_any *arg2, mus_any *arg_out)
+static mus_any *plenv_copy(mus_any *ptr)
{
- if (mus_mixer_p(arg2))
- return(frame_to_frame_right(arg1, arg2, arg_out));
- return(frame_to_frame_left(arg1, arg2, arg_out));
+ plenv *g, *p;
+ p = (plenv *)ptr;
+ g = (plenv *)malloc(sizeof(plenv));
+ memcpy((void *)g, (void *)ptr, sizeof(plenv));
+ g->gens_allocated = true;
+ g->e = mus_copy(p->e);
+ g->p = mus_copy(p->p);
+ return((mus_any *)g);
}
-mus_any *mus_sample_to_frame(mus_any *f, mus_float_t in, mus_any *uout)
+static mus_float_t run_pulsed_env(mus_any *ptr, mus_float_t input, mus_float_t unused)
{
- int i, chans;
- mus_frame *out = (mus_frame *)uout;
- if (mus_frame_p(f))
- {
- mus_frame *fr;
- fr = (mus_frame *)f;
- chans = fr->chans;
- if (out)
- {
- if (out->chans < chans)
- chans = out->chans;
- }
- else out = (mus_frame *)mus_make_empty_frame(chans);
- for (i = 0; i < chans; i++)
- out->vals[i] = (in * fr->vals[i]);
- /* was += here and below? */
- }
- else
- {
- if (mus_mixer_p(f))
- {
- mus_mixer *mx;
- mx = (mus_mixer *)f;
- chans = mx->chans;
- if (out)
- {
- if (out->chans < chans)
- chans = out->chans;
- }
- else out = (mus_frame *)mus_make_empty_frame(chans);
- for (i = 0; i < chans; i++)
- out->vals[i] = (in * mx->vals[0][i]);
- }
- else mus_error(MUS_ARG_OUT_OF_RANGE, S_sample_to_frame ": gen not frame or mixer");
- }
- return((mus_any *)out);
+ return(mus_pulsed_env(ptr, input));
}
-mus_float_t mus_frame_to_sample(mus_any *f, mus_any *uin)
+static void pulsed_env_reset(mus_any *ptr)
{
- int i, chans;
- mus_frame *in = (mus_frame *)uin;
- mus_float_t val = 0.0;
- if (mus_frame_p(f))
- {
- mus_frame *fr;
- fr = (mus_frame *)f;
- chans = in->chans;
- if (fr->chans < chans)
- chans = fr->chans;
- for (i = 0; i < chans; i++)
- val += (in->vals[i] * fr->vals[i]);
- }
- else
- {
- if (mus_mixer_p(f))
- {
- mus_mixer *mx;
- mx = (mus_mixer *)f;
- chans = in->chans;
- if (mx->chans < chans)
- chans = mx->chans;
- for (i = 0; i < chans; i++)
- val += (in->vals[i] * mx->vals[i][0]);
- }
- else mus_error(MUS_ARG_OUT_OF_RANGE, S_frame_to_sample ": gen not frame or mixer");
- }
- return(val);
+ plenv *pl = (plenv *)ptr;
+ mus_reset(pl->e);
+ mus_reset(pl->p);
}
-mus_any *mus_mixer_add(mus_any *uf1, mus_any *uf2, mus_any *ures)
+static bool pulsed_env_equalp(mus_any *p1, mus_any *p2)
{
- int i, j, chans;
- mus_mixer *f1 = (mus_mixer *)uf1;
- mus_mixer *f2 = (mus_mixer *)uf2;
- mus_mixer *res = (mus_mixer *)ures;
+ plenv *f1 = (plenv *)p1;
+ plenv *f2 = (plenv *)p2;
- chans = f1->chans;
- if (f2->chans < chans)
- chans = f2->chans;
- if (res)
- {
- if (res->chans < chans)
- chans = res->chans;
- }
- else res = (mus_mixer *)mus_make_empty_mixer(chans);
- for (i = 0; i < chans; i++)
- for (j = 0; j < chans; j++)
- res->vals[i][j] = f1->vals[i][j] + f2->vals[i][j];
- return((mus_any *)res);
+ if (f1 == f2) return(true);
+ return((env_equalp(f1->e, f2->e)) &&
+ (sw_equalp(f1->p, f2->p)));
}
-mus_any *mus_mixer_multiply(mus_any *uf1, mus_any *uf2, mus_any *ures)
+static char *describe_pulsed_env(mus_any *ptr)
{
- int i, j, k, chans;
- mus_mixer *f1 = (mus_mixer *)uf1;
- mus_mixer *f2 = (mus_mixer *)uf2;
- mus_mixer *res = (mus_mixer *)ures;
-
- chans = f1->chans;
- if (f2->chans < chans)
- chans = f2->chans;
- if (res)
- {
- if (res->chans < chans)
- chans = res->chans;
- }
- else res = (mus_mixer *)mus_make_empty_mixer(chans);
- for (i = 0; i < chans; i++)
- for (j = 0; j < chans; j++)
- {
- res->vals[i][j] = 0.0;
- for (k = 0; k < chans; k++)
- res->vals[i][j] += (f1->vals[i][k] * f2->vals[k][j]);
- }
- return((mus_any *)res);
+ char *describe_buffer;
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s",
+ mus_name(ptr));
+ return(describe_buffer);
}
+static mus_any_class PULSED_ENV_CLASS = {
+ MUS_PULSED_ENV,
+ (char *)S_pulsed_env,
+ &free_pulsed_env,
+ &describe_pulsed_env,
+ &pulsed_env_equalp,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ 0, 0,
+ &run_pulsed_env,
+ MUS_NOT_SPECIAL,
+ NULL, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
+ &pulsed_env_reset,
+ 0, &plenv_copy
+};
+
-mus_any *mus_mixer_scale(mus_any *uf1, mus_float_t scaler, mus_any *ures)
+mus_any *mus_make_pulsed_env(mus_any *e, mus_any *p)
{
- int i, j, chans;
- mus_mixer *f1 = (mus_mixer *)uf1;
- mus_mixer *res = (mus_mixer *)ures;
+ plenv *gen;
- chans = f1->chans;
- if (res)
- {
- if (res->chans < chans)
- chans = res->chans;
- }
- else res = (mus_mixer *)mus_make_empty_mixer(chans);
- for (i = 0; i < chans; i++)
- for (j = 0; j < chans; j++)
- res->vals[i][j] = f1->vals[i][j] * scaler;
- return((mus_any *)res);
+ gen = (plenv *)malloc(sizeof(plenv));
+ gen->core = &PULSED_ENV_CLASS;
+ gen->e = e;
+ gen->p = p;
+ gen->gens_allocated = false;
+ return((mus_any *)gen);
}
+bool mus_is_pulsed_env(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_PULSED_ENV));
+}
-mus_any *mus_mixer_offset(mus_any *uf1, mus_float_t offset, mus_any *ures)
+mus_float_t mus_pulsed_env(mus_any *g, mus_float_t inval)
{
- int i, j, chans;
- mus_mixer *f1 = (mus_mixer *)uf1;
- mus_mixer *res = (mus_mixer *)ures;
+ plenv *pl = (plenv *)g;
+ mus_float_t pt_val;
+ pt_val = mus_pulse_train(pl->p, inval);
+ if (pt_val > 0.1)
+ mus_reset(pl->e);
+ return(mus_env(pl->e));
+}
- chans = f1->chans;
- if (res)
- {
- if (res->chans < chans)
- chans = res->chans;
- }
- else res = (mus_mixer *)mus_make_empty_mixer(chans);
- for (i = 0; i < chans; i++)
- for (j = 0; j < chans; j++)
- res->vals[i][j] = f1->vals[i][j] + offset;
- return((mus_any *)res);
+
+mus_float_t mus_pulsed_env_unmodulated(mus_any *g)
+{
+ plenv *pl = (plenv *)g;
+ mus_float_t pt_val;
+ pt_val = mus_pulse_train_unmodulated(pl->p);
+ if (pt_val > 0.1)
+ mus_reset(pl->e);
+ return(mus_env(pl->e));
}
+
/* ---------------- input/output ---------------- */
-static mus_float_t mus_read_sample(mus_any *fd, mus_long_t frame, int chan)
+static mus_float_t mus_read_sample(mus_any *fd, mus_long_t frample, int chan)
{
if ((check_gen(fd, "mus-read-sample")) &&
((fd->core)->read_sample))
- return(((*(fd->core)->read_sample))(fd, frame, chan));
+ return(((*(fd->core)->read_sample))(fd, frample, chan));
return((mus_float_t)mus_error(MUS_NO_SAMPLE_INPUT,
- "can't find %s's sample input function",
- mus_name(fd)));
-}
-
-
-static mus_float_t mus_write_sample(mus_any *fd, mus_long_t frame, int chan, mus_float_t samp)
-{
- if ((check_gen(fd, "mus-write-sample")) &&
- ((fd->core)->write_sample))
- return(((*(fd->core)->write_sample))(fd, frame, chan, samp));
- return((mus_float_t)mus_error(MUS_NO_SAMPLE_OUTPUT,
- "can't find %s's sample output function",
+ ":can't find %s's sample input function",
mus_name(fd)));
}
@@ -7207,14 +10288,14 @@ char *mus_file_name(mus_any *gen)
}
-bool mus_input_p(mus_any *gen)
+bool mus_is_input(mus_any *gen)
{
return((gen) &&
(gen->core->extended_type == MUS_INPUT));
}
-bool mus_output_p(mus_any *gen)
+bool mus_is_output(mus_any *gen)
{
return((gen) &&
(gen->core->extended_type == MUS_OUTPUT));
@@ -7231,10 +10312,11 @@ typedef struct {
mus_long_t loc;
char *file_name;
int chans;
- mus_sample_t **ibufs;
+ mus_float_t **ibufs, **saved_data;
+ mus_float_t *sbuf;
mus_long_t data_start, data_end, file_end;
mus_long_t file_buffer_size;
- int safety;
+ mus_float_t (*reader)(mus_any *ptr);
} rdin;
@@ -7242,8 +10324,8 @@ static char *describe_file_to_sample(mus_any *ptr)
{
rdin *gen = (rdin *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s",
mus_name(ptr),
gen->file_name);
return(describe_buffer);
@@ -7266,26 +10348,51 @@ static bool rdin_equalp(mus_any *p1, mus_any *p2)
}
-static int free_file_to_sample(mus_any *p)
+static void free_file_to_sample(mus_any *p)
{
rdin *ptr = (rdin *)p;
- if (ptr)
+ if (ptr->core->end) ((*ptr->core->end))(p);
+ free(ptr->file_name);
+ free(ptr);
+}
+
+static mus_long_t make_ibufs(rdin *gen)
+{
+ int i;
+ mus_long_t len;
+ len = gen->file_end + 1;
+ if (len > gen->file_buffer_size)
+ len = gen->file_buffer_size;
+
+ gen->ibufs = (mus_float_t **)malloc(gen->chans * sizeof(mus_float_t *));
+ for (i = 0; i < gen->chans; i++)
+ gen->ibufs[i] = (mus_float_t *)malloc(len * sizeof(mus_float_t));
+
+ return(len);
+}
+
+static mus_any *rdin_copy(mus_any *ptr)
+{
+ rdin *g, *p;
+ p = (rdin *)ptr;
+ g = (rdin *)malloc(sizeof(rdin));
+ memcpy((void *)g, (void *)ptr, sizeof(rdin));
+ g->file_name = mus_strdup(p->file_name);
+ if (p->ibufs)
{
- if (ptr->core->end) ((*ptr->core->end))(p);
- clm_free(ptr->file_name);
- clm_free(ptr);
+ int i;
+ mus_long_t len;
+ len = make_ibufs(g);
+ for (i = 0; i < g->chans; i++)
+ memcpy((void *)(g->ibufs[i]), (void *)(p->ibufs[i]), len * sizeof(mus_float_t));
}
- return(0);
+ return((mus_any *)g);
}
-
static mus_long_t file_to_sample_length(mus_any *ptr) {return((((rdin *)ptr)->file_end));}
static int file_to_sample_channels(mus_any *ptr) {return((int)(((rdin *)ptr)->chans));}
-static int file_to_sample_safety(mus_any *ptr) {return(((rdin *)ptr)->safety);}
-static int file_to_sample_set_safety(mus_any *ptr, int val) {((rdin *)ptr)->safety = val; return(val);}
-
static mus_float_t file_to_sample_increment(mus_any *rd) {return((mus_float_t)(((rdin *)rd)->dir));}
static mus_float_t file_to_sample_set_increment(mus_any *rd, mus_float_t val) {((rdin *)rd)->dir = (int)val; return(val);}
@@ -7293,121 +10400,81 @@ static char *file_to_sample_file_name(mus_any *ptr) {return(((rdin *)ptr)->file_
static void no_reset(mus_any *ptr) {}
-static int file_to_sample_end(mus_any *ptr);
-
-static mus_float_t run_file_to_sample(mus_any *ptr, mus_float_t arg1, mus_float_t arg2) {return(mus_in_any_from_file(ptr, (int)arg1, (int)arg2));} /* mus_read_sample here? */
-
-
-static mus_any_class FILE_TO_SAMPLE_CLASS = {
- MUS_FILE_TO_SAMPLE,
- (char *)S_file_to_sample,
- &free_file_to_sample,
- &describe_file_to_sample,
- &rdin_equalp,
- 0, 0,
- &file_to_sample_length, 0,
- 0, 0, 0, 0,
- 0, 0,
- &file_to_sample_increment,
- &file_to_sample_set_increment,
- &run_file_to_sample,
- MUS_INPUT,
- NULL,
- &file_to_sample_channels,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- &mus_in_any_from_file,
- 0,
- &file_to_sample_file_name,
- &file_to_sample_end,
- 0, /* location */
- 0, /* set_location */
- 0, /* channel */
- 0, 0, 0, 0, 0,
- &no_reset,
- 0,
- &file_to_sample_safety,
- &file_to_sample_set_safety
-};
-
-
-mus_float_t mus_in_any_from_file(mus_any *ptr, mus_long_t samp, int chan)
+static mus_float_t mus_in_any_from_file(mus_any *ptr, mus_long_t samp, int chan)
{
/* check in-core buffer bounds,
* if needed read new buffer (taking into account dir)
- * return mus_float_t at samp (frame)
+ * return mus_float_t at samp (frample)
*/
rdin *gen = (rdin *)ptr;
- mus_float_t result = 0.0;
- if ((chan >= gen->chans) ||
- (samp < 0))
+ if (chan >= gen->chans)
return(0.0);
if ((samp <= gen->data_end) &&
(samp >= gen->data_start))
+ return((mus_float_t)(gen->ibufs[chan][samp - gen->data_start]));
+
+ if ((samp >= 0) &&
+ (samp < gen->file_end))
{
- result = (mus_float_t)MUS_SAMPLE_TO_FLOAT(gen->ibufs[chan][samp - gen->data_start]);
- }
- else
- {
- if ((samp >= 0) &&
- (samp < gen->file_end))
- {
- /* got to read it from the file */
- int fd;
- mus_long_t newloc;
- /* read in first buffer start either at samp (dir > 0) or samp-bufsize (dir < 0) */
+ /* got to read it from the file */
+ int fd;
+ mus_long_t newloc;
+ /* read in first buffer start either at samp (dir > 0) or samp-bufsize (dir < 0) */
+
+ if (samp >= gen->data_start) /* gen dir is irrelevant here (see grev in clm23.scm) */
+ newloc = samp;
+ else newloc = (mus_long_t)(samp - (gen->file_buffer_size * .75));
+ /* The .75 in the backwards read is trying to avoid reading the full buffer on
+ * nearly every sample when we're oscillating around the
+ * nominal buffer start/end (in src driven by an oscil for example)
+ */
+ if (newloc < 0) newloc = 0;
+ gen->data_start = newloc;
+ gen->data_end = newloc + gen->file_buffer_size - 1;
+ fd = mus_sound_open_input(gen->file_name);
+ if (fd == -1)
+ return((mus_float_t)mus_error(MUS_CANT_OPEN_FILE,
+ "open(%s) -> %s",
+ gen->file_name, STRERROR(errno)));
+ else
+ {
+ if (gen->ibufs == NULL)
+ make_ibufs(gen);
+ mus_file_seek_frample(fd, gen->data_start);
+
+ if ((gen->data_start + gen->file_buffer_size) >= gen->file_end)
+ mus_file_read_chans(fd, gen->data_start, gen->file_end - gen->data_start, gen->chans, gen->ibufs, gen->ibufs);
+ else mus_file_read_chans(fd, gen->data_start, gen->file_buffer_size, gen->chans, gen->ibufs, gen->ibufs);
- if (gen->dir >= 0)
- newloc = samp;
- else newloc = (mus_long_t)(samp - (gen->file_buffer_size * .75));
- /* The .75 in the backwards read is trying to avoid reading the full buffer on
- * nearly every sample when we're oscillating around the
- * nominal buffer start/end (in src driven by an oscil for example)
+ /* we have to check file_end here because chunked files can have trailing chunks containing
+ * comments or whatever. io.c (mus_file_read_*) merely calls read, and translates bytes --
+ * if it gets fewer than requested, it zeros from the point where the incoming file data stopped,
+ * but that can be far beyond the actual end of the sample data! It is at this level that
+ * we know how much data is actually supposed to be in the file.
+ *
+ * Also, file_end is the number of framples, so we should not read samp # file_end (see above).
*/
- if (newloc < 0) newloc = 0;
- gen->data_start = newloc;
- gen->data_end = newloc + gen->file_buffer_size - 1;
- fd = mus_sound_open_input(gen->file_name);
- if (fd == -1)
- return((mus_float_t)mus_error(MUS_CANT_OPEN_FILE,
- "open(%s) -> %s",
- gen->file_name, STRERROR(errno)));
- else
- {
- int i;
- if (gen->ibufs == NULL)
- {
- gen->ibufs = (mus_sample_t **)clm_malloc(gen->chans * sizeof(mus_sample_t *), "input buffers");
- for (i = 0; i < gen->chans; i++)
- gen->ibufs[i] = (mus_sample_t *)clm_calloc_atomic(gen->file_buffer_size, sizeof(mus_sample_t), "input buffer");
- }
- mus_file_seek_frame(fd, gen->data_start);
-
- if ((gen->data_start + gen->file_buffer_size) >= gen->file_end)
- mus_file_read_chans(fd, 0, gen->file_end - gen->data_start - 1, gen->chans, gen->ibufs, gen->ibufs);
- else mus_file_read_chans(fd, 0, gen->file_buffer_size - 1, gen->chans, gen->ibufs, gen->ibufs);
-
- /* we have to check file_end here because chunked files can have trailing chunks containing
- * comments or whatever. io.c (mus_file_read_*) merely calls read, and translates bytes --
- * if it gets fewer than requested, it zeros from the point where the incoming file data stopped,
- * but that can be far beyond the actual end of the sample data! It is at this level that
- * we know how much data is actually supposed to be in the file.
- *
- * Also, file_end is the number of frames, so we should not read samp # file_end (see above).
- */
-
- mus_sound_close_input(fd);
- if (gen->data_end > gen->file_end) gen->data_end = gen->file_end;
- }
- result = (mus_float_t)MUS_SAMPLE_TO_FLOAT(gen->ibufs[chan][samp - gen->data_start]);
+ mus_sound_close_input(fd);
+ if (gen->data_end > gen->file_end) gen->data_end = gen->file_end;
}
+
+ return((mus_float_t)(gen->ibufs[chan][samp - gen->data_start]));
}
- return(result);
+
+ return(0.0);
}
+static mus_float_t run_file_to_sample(mus_any *ptr, mus_float_t arg1, mus_float_t arg2)
+{
+ /* mus_read_sample here? */
+ return(mus_in_any_from_file(ptr, (int)arg1, (int)arg2));
+}
+
+
static int file_to_sample_end(mus_any *ptr)
{
rdin *gen = (rdin *)ptr;
@@ -7418,16 +10485,47 @@ static int file_to_sample_end(mus_any *ptr)
int i;
for (i = 0; i < gen->chans; i++)
if (gen->ibufs[i])
- clm_free(gen->ibufs[i]);
- clm_free(gen->ibufs);
+ free(gen->ibufs[i]);
+ free(gen->ibufs);
gen->ibufs = NULL;
+ gen->sbuf = NULL;
}
}
return(0);
}
-bool mus_file_to_sample_p(mus_any *ptr)
+static mus_any_class FILE_TO_SAMPLE_CLASS = {
+ MUS_FILE_TO_SAMPLE,
+ (char *)S_file_to_sample,
+ &free_file_to_sample,
+ &describe_file_to_sample,
+ &rdin_equalp,
+ 0, 0,
+ &file_to_sample_length, 0,
+ 0, 0, 0, 0,
+ 0, 0,
+ &file_to_sample_increment,
+ &file_to_sample_set_increment,
+ &run_file_to_sample,
+ MUS_INPUT,
+ NULL,
+ &file_to_sample_channels,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ &mus_in_any_from_file,
+ 0,
+ &file_to_sample_file_name,
+ &file_to_sample_end,
+ 0, /* location */
+ 0, /* set_location */
+ 0, /* channel */
+ 0, 0, 0, 0,
+ &no_reset,
+ 0, &rdin_copy
+};
+
+
+bool mus_is_file_to_sample(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_FILE_TO_SAMPLE));
@@ -7442,21 +10540,24 @@ mus_any *mus_make_file_to_sample_with_buffer_size(const char *filename, mus_long
mus_error(MUS_NO_FILE_NAME_PROVIDED, S_make_file_to_sample " requires a file name");
else
{
- gen = (rdin *)clm_calloc(1, sizeof(rdin), S_make_file_to_sample);
+ gen = (rdin *)calloc(1, sizeof(rdin));
gen->core = &FILE_TO_SAMPLE_CLASS;
- gen->file_buffer_size = buffer_size;
- gen->file_name = (char *)clm_calloc_atomic(strlen(filename) + 1, sizeof(char), S_file_to_sample " filename");
+ gen->file_name = (char *)malloc((strlen(filename) + 1) * sizeof(char));
strcpy(gen->file_name, filename);
gen->data_end = -1; /* force initial read */
gen->chans = mus_sound_chans(gen->file_name);
if (gen->chans <= 0)
- mus_error(MUS_NO_CHANNELS, "%s chans: %d", filename, gen->chans);
+ mus_error(MUS_NO_CHANNELS, S_make_file_to_sample ": %s chans: %d", filename, gen->chans);
- gen->file_end = mus_sound_frames(gen->file_name);
+ gen->file_end = mus_sound_framples(gen->file_name);
if (gen->file_end < 0)
- mus_error(MUS_NO_LENGTH, "%s frames: " MUS_LD, filename, gen->file_end);
+ mus_error(MUS_NO_LENGTH, S_make_file_to_sample ": %s framples: %lld", filename, gen->file_end);
+
+ if (buffer_size < gen->file_end)
+ gen->file_buffer_size = buffer_size;
+ else gen->file_buffer_size = gen->file_end;
return((mus_any *)gen);
}
@@ -7472,6 +10573,16 @@ mus_any *mus_make_file_to_sample(const char *filename)
mus_float_t mus_file_to_sample(mus_any *ptr, mus_long_t samp, int chan)
{
+ rdin *gen = (rdin *)ptr;
+
+ if (chan >= gen->chans)
+ return(0.0);
+
+ /* redundant in a sense, but saves the call overhead of mus_in_any_from_file */
+ if ((samp <= gen->data_end) &&
+ (samp >= gen->data_start))
+ return((mus_float_t)(gen->ibufs[chan][samp - gen->data_start]));
+
return(mus_in_any_from_file(ptr, samp, chan));
}
@@ -7487,27 +10598,24 @@ static char *describe_readin(mus_any *ptr)
{
rdin *gen = (rdin *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s[chan %d], loc: " MUS_LD ", dir: %d",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s[chan %d], loc: %lld, dir: %d",
mus_name(ptr),
gen->file_name, gen->chan, gen->loc, gen->dir);
return(describe_buffer);
}
-static int free_readin(mus_any *p)
+static void free_readin(mus_any *p)
{
rdin *ptr = (rdin *)p;
- if (ptr)
- {
- if (ptr->core->end) ((*ptr->core->end))(p);
- clm_free(ptr->file_name);
- clm_free(ptr);
- }
- return(0);
+ if (ptr->core->end) ((*ptr->core->end))(p);
+ free(ptr->file_name);
+ free(ptr);
}
-static mus_float_t run_readin(mus_any *ptr, mus_float_t unused1, mus_float_t unused2) {return(mus_readin(ptr));}
+static mus_float_t run_readin(mus_any *ptr, mus_float_t unused1, mus_float_t unused2) {return(((rdin *)ptr)->reader(ptr));}
+static mus_float_t readin_to_sample(mus_any *ptr, mus_long_t samp, int chan) {return(((rdin *)ptr)->reader(ptr));}
static mus_float_t rd_increment(mus_any *ptr) {return((mus_float_t)(((rdin *)ptr)->dir));}
static mus_float_t rd_set_increment(mus_any *ptr, mus_float_t val) {((rdin *)ptr)->dir = (int)val; return(val);}
@@ -7534,58 +10642,131 @@ static mus_any_class READIN_CLASS = {
NULL,
&file_to_sample_channels,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- &mus_in_any_from_file,
+ &readin_to_sample,
0,
&file_to_sample_file_name,
&file_to_sample_end,
&rd_location,
&rd_set_location,
&rd_channel,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&no_reset,
- 0, 0, 0
+ 0, &rdin_copy
};
-bool mus_readin_p(mus_any *ptr)
+bool mus_is_readin(mus_any *ptr)
+{
+ return((ptr) &&
+ (ptr->core->type == MUS_READIN));
+}
+
+
+mus_float_t mus_readin(mus_any *ptr)
+{
+ return(((rdin *)ptr)->reader(ptr));
+}
+
+
+static mus_float_t safe_readin(mus_any *ptr)
+{
+ mus_float_t res;
+ rdin *rd = (rdin *)ptr;
+
+ if ((rd->loc < rd->file_end) &&
+ (rd->loc >= 0))
+ res = rd->sbuf[rd->loc];
+ else res = 0.0;
+ rd->loc += rd->dir;
+ return(res);
+}
+
+
+static mus_float_t readin(mus_any *ptr)
{
- return((ptr) &&
- (ptr->core->type == MUS_READIN));
+ mus_float_t res;
+ rdin *rd = (rdin *)ptr;
+
+ if ((rd->loc <= rd->data_end) &&
+ (rd->loc >= rd->data_start))
+ res = rd->sbuf[rd->loc - rd->data_start];
+ else
+ {
+ if ((rd->loc < 0) || (rd->loc >= rd->file_end))
+ res = 0.0;
+ else res = mus_in_any_from_file(ptr, rd->loc, rd->chan);
+ }
+
+ rd->loc += rd->dir;
+ return(res);
}
mus_any *mus_make_readin_with_buffer_size(const char *filename, int chan, mus_long_t start, int direction, mus_long_t buffer_size)
{
rdin *gen;
+ if (chan >= mus_sound_chans(filename))
+ mus_error(MUS_NO_SUCH_CHANNEL, S_make_readin ": %s, chan: %d, but chans: %d", filename, chan, mus_sound_chans(filename));
+
gen = (rdin *)mus_make_file_to_sample(filename);
if (gen)
{
+ mus_float_t **saved_data = NULL;
gen->core = &READIN_CLASS;
gen->loc = start;
gen->dir = direction;
gen->chan = chan;
- gen->file_buffer_size = buffer_size;
- gen->ibufs = (mus_sample_t **)clm_calloc(gen->chans, sizeof(mus_sample_t *), "readin buffers");
- gen->ibufs[chan] = (mus_sample_t *)clm_calloc_atomic(gen->file_buffer_size, sizeof(mus_sample_t), "readin buffer");
+ /* the saved data option does not save us anything in file_to_sample above */
+ gen->saved_data = mus_sound_saved_data(filename);
+ if (!saved_data)
+ {
+ char *str;
+ str = mus_expand_filename(filename);
+ if (str)
+ {
+ gen->saved_data = mus_sound_saved_data(str);
+ free(str);
+ }
+ }
+ if (gen->saved_data)
+ {
+ gen->file_buffer_size = gen->file_end;
+ gen->sbuf = gen->saved_data[chan];
+ gen->reader = safe_readin;
+ gen->data_start = 0;
+ gen->data_end = gen->file_end;
+ }
+ else
+ {
+ gen->ibufs = (mus_float_t **)calloc(gen->chans, sizeof(mus_float_t *));
+ if (buffer_size > gen->file_end)
+ {
+ gen->file_buffer_size = gen->file_end;
+ gen->reader = safe_readin;
+ gen->ibufs[chan] = (mus_float_t *)malloc(gen->file_buffer_size * sizeof(mus_float_t));
+ mus_in_any_from_file((mus_any *)gen, 0, chan);
+ }
+ else
+ {
+ gen->file_buffer_size = buffer_size;
+ gen->reader = readin;
+ gen->ibufs[chan] = (mus_float_t *)malloc(gen->file_buffer_size * sizeof(mus_float_t));
+ }
+ gen->sbuf = gen->ibufs[chan];
+ }
return((mus_any *)gen);
}
return(NULL);
}
-
-mus_float_t mus_readin(mus_any *ptr)
-{
- mus_float_t res;
- rdin *rd = (rdin *)ptr;
- res = mus_in_any_from_file(ptr, rd->loc, rd->chan);
- rd->loc += rd->dir;
- return(res);
-}
+/* it would be easy to extend readin to read from a float-vector by using the saved_data and safe_readin
+ * business above -- just need mus_make_readin_from_float_vector or something.
+ */
mus_long_t mus_set_location(mus_any *gen, mus_long_t loc)
{
- if ((check_gen(gen, S_setB S_mus_location)) &&
+ if ((check_gen(gen, S_set S_mus_location)) &&
(gen->core->set_location))
return((*(gen->core->set_location))(gen, loc));
return((mus_long_t)mus_error(MUS_NO_LOCATION, "can't set %s's location", mus_name(gen)));
@@ -7602,34 +10783,44 @@ mus_float_t mus_in_any(mus_long_t samp, int chan, mus_any *IO)
}
-/* ---------------- file->frame ---------------- */
+bool mus_in_any_is_safe(mus_any *ptr)
+{
+ rdin *gen = (rdin *)ptr;
+ return((gen) &&
+ ((gen->core->read_sample == mus_in_any_from_file) ||
+ (gen->core->read_sample == readin_to_sample)));
+}
+
+
+
+/* ---------------- file->frample ---------------- */
/* also built on file->sample */
-static char *describe_file_to_frame(mus_any *ptr)
+static char *describe_file_to_frample(mus_any *ptr)
{
rdin *gen = (rdin *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s",
mus_name(ptr),
gen->file_name);
return(describe_buffer);
}
-static mus_float_t run_file_to_frame(mus_any *ptr, mus_float_t arg1, mus_float_t arg2)
+static mus_float_t run_file_to_frample(mus_any *ptr, mus_float_t arg1, mus_float_t arg2)
{
- mus_error(MUS_NO_RUN, "no run method for file->frame");
+ mus_error(MUS_NO_RUN, "no run method for file->frample");
return(0.0);
}
-static mus_any_class FILE_TO_FRAME_CLASS = {
- MUS_FILE_TO_FRAME,
- (char *)S_file_to_frame,
+static mus_any_class FILE_TO_FRAMPLE_CLASS = {
+ MUS_FILE_TO_FRAMPLE,
+ (char *)S_file_to_frample,
&free_file_to_sample,
- &describe_file_to_frame,
+ &describe_file_to_frample,
&rdin_equalp,
0, 0,
&file_to_sample_length, 0,
@@ -7637,7 +10828,7 @@ static mus_any_class FILE_TO_FRAME_CLASS = {
&fallback_scaler, 0,
&file_to_sample_increment, /* allow backward reads */
&file_to_sample_set_increment,
- &run_file_to_frame,
+ &run_file_to_frample,
MUS_INPUT,
NULL,
&file_to_sample_channels,
@@ -7649,49 +10840,68 @@ static mus_any_class FILE_TO_FRAME_CLASS = {
0, /* location */
0, /* set_location */
0, /* channel */
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&no_reset,
- 0, 0, 0
+ 0, &rdin_copy
};
-mus_any *mus_make_file_to_frame_with_buffer_size(const char *filename, mus_long_t buffer_size)
+mus_any *mus_make_file_to_frample_with_buffer_size(const char *filename, mus_long_t buffer_size)
{
rdin *gen;
gen = (rdin *)mus_make_file_to_sample_with_buffer_size(filename, buffer_size);
if (gen)
{
- gen->core = &FILE_TO_FRAME_CLASS;
+ gen->core = &FILE_TO_FRAMPLE_CLASS;
return((mus_any *)gen);
}
return(NULL);
}
-mus_any *mus_make_file_to_frame(const char *filename)
+mus_any *mus_make_file_to_frample(const char *filename)
{
- return(mus_make_file_to_frame_with_buffer_size(filename, clm_file_buffer_size));
+ return(mus_make_file_to_frample_with_buffer_size(filename, clm_file_buffer_size));
}
-bool mus_file_to_frame_p(mus_any *ptr)
+bool mus_is_file_to_frample(mus_any *ptr)
{
return((ptr) &&
- (ptr->core->type == MUS_FILE_TO_FRAME));
+ (ptr->core->type == MUS_FILE_TO_FRAMPLE));
}
-mus_any *mus_file_to_frame(mus_any *ptr, mus_long_t samp, mus_any *uf)
+mus_float_t *mus_file_to_frample(mus_any *ptr, mus_long_t samp, mus_float_t *f)
{
- mus_frame *f;
rdin *gen = (rdin *)ptr;
int i;
- if (uf == NULL)
- f = (mus_frame *)mus_make_empty_frame(gen->chans);
- else f = (mus_frame *)uf;
- for (i = 0; i < gen->chans; i++)
- f->vals[i] = mus_in_any_from_file(ptr, samp, i);
- return((mus_any *)f);
+
+ if ((samp <= gen->data_end) &&
+ (samp >= gen->data_start))
+ {
+ mus_long_t pos;
+ pos = samp - gen->data_start;
+ f[0] = gen->ibufs[0][pos];
+ for (i = 1; i < gen->chans; i++)
+ f[i] = gen->ibufs[i][pos];
+ }
+ else
+ {
+ if ((samp < 0) ||
+ (samp >= gen->file_end))
+ {
+ for (i = 0; i < gen->chans; i++)
+ f[i] = 0.0;
+ }
+ else
+ {
+ f[0] = mus_in_any_from_file(ptr, samp, 0);
+ for (i = 1; i < gen->chans; i++)
+ f[i] = mus_in_any_from_file(ptr, samp, i);
+ }
+ }
+ return(f);
}
@@ -7701,27 +10911,14 @@ mus_any *mus_file_to_frame(mus_any *ptr, mus_long_t samp, mus_any *uf)
/* in all output functions, the assumption is that we're adding to whatever already exists */
/* also, the "end" methods need to flush the output buffer */
-typedef struct {
- mus_any_class *core;
- int chan;
- mus_long_t loc;
- char *file_name;
- int chans;
- mus_sample_t **obufs;
- mus_long_t data_start, data_end;
- mus_long_t out_end;
- int output_data_format;
- int output_header_type;
- int safety;
-} rdout;
-
+/* rdout struct is in clm.h */
static char *describe_sample_to_file(mus_any *ptr)
{
rdout *gen = (rdout *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s",
mus_name(ptr),
gen->file_name);
return(describe_buffer);
@@ -7731,19 +10928,40 @@ static char *describe_sample_to_file(mus_any *ptr)
static bool sample_to_file_equalp(mus_any *p1, mus_any *p2) {return(p1 == p2);}
-static int free_sample_to_file(mus_any *p)
+static void free_sample_to_file(mus_any *p)
{
rdout *ptr = (rdout *)p;
- if (ptr)
+ if (ptr->core->end) ((*ptr->core->end))(p);
+ free(ptr->file_name);
+ free(ptr);
+}
+
+static mus_any *rdout_copy(mus_any *ptr)
+{
+ rdout *g, *p;
+ p = (rdout *)ptr;
+ g = (rdout *)malloc(sizeof(rdout));
+ memcpy((void *)g, (void *)ptr, sizeof(rdout));
+ g->file_name = mus_strdup(p->file_name);
+ if (p->obufs)
{
- if (ptr->core->end) ((*ptr->core->end))(p);
- clm_free(ptr->file_name);
- clm_free(ptr);
+ int i;
+ mus_long_t bytes;
+ bytes = clm_file_buffer_size * sizeof(mus_float_t);
+ g->obufs = (mus_float_t **)malloc(g->chans * sizeof(mus_float_t *));
+ for (i = 0; i < g->chans; i++)
+ {
+ g->obufs[i] = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->obufs[i]), (void *)(p->obufs[i]), bytes);
+ }
+ g->obuf0 = g->obufs[0];
+ if (g->chans > 1)
+ g->obuf1 = g->obufs[1];
+ else g->obuf1 = NULL;
}
- return(0);
+ return((mus_any *)g);
}
-
static int sample_to_file_channels(mus_any *ptr) {return((int)(((rdout *)ptr)->chans));}
static mus_long_t bufferlen(mus_any *ptr) {return(clm_file_buffer_size);}
@@ -7752,9 +10970,6 @@ static mus_long_t set_bufferlen(mus_any *ptr, mus_long_t len) {clm_file_buffer_s
static char *sample_to_file_file_name(mus_any *ptr) {return(((rdout *)ptr)->file_name);}
-static int sample_to_file_safety(mus_any *ptr) {return(((rdout *)ptr)->safety);}
-static int sample_to_file_set_safety(mus_any *ptr, int val) {((rdout *)ptr)->safety = val; return(val);}
-
static int sample_to_file_end(mus_any *ptr);
static mus_float_t run_sample_to_file(mus_any *ptr, mus_float_t arg1, mus_float_t arg2) {mus_error(MUS_NO_RUN, "no run method for sample->file"); return(0.0);}
@@ -7780,19 +10995,17 @@ static mus_any_class SAMPLE_TO_FILE_CLASS = {
&sample_to_file_file_name,
&sample_to_file_end,
0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&no_reset,
- 0,
- &sample_to_file_safety,
- &sample_to_file_set_safety
+ 0, &rdout_copy
};
-static int *data_format_zero = NULL;
+static int *sample_type_zero = NULL;
-int mus_data_format_zero(int format)
+int mus_sample_type_zero(mus_sample_t samp_type)
{
- return(data_format_zero[format]);
+ return(sample_type_zero[samp_type]);
}
@@ -7812,7 +11025,7 @@ static void flush_buffers(rdout *gen)
fd = mus_sound_open_output(gen->file_name,
(int)sampling_rate,
gen->chans,
- gen->output_data_format,
+ gen->output_sample_type,
gen->output_header_type,
NULL);
if (fd == -1)
@@ -7822,101 +11035,104 @@ static void flush_buffers(rdout *gen)
else
{
mus_file_write(fd, 0, gen->out_end, gen->chans, gen->obufs);
- mus_sound_close_output(fd, (gen->out_end + 1) * gen->chans * mus_bytes_per_sample(mus_sound_data_format(gen->file_name)));
+ mus_sound_close_output(fd, (gen->out_end + 1) * gen->chans * mus_bytes_per_sample(mus_sound_sample_type(gen->file_name)));
}
}
else
{
/* get existing samples, add new output, write back to output */
- mus_sample_t **addbufs;
- int i, j, data_format;
- mus_long_t current_file_frames, frames_to_add;
-
- data_format = mus_sound_data_format(gen->file_name);
- current_file_frames = mus_sound_frames(gen->file_name);
-
- addbufs = (mus_sample_t **)clm_calloc_atomic(gen->chans, sizeof(mus_sample_t *), "output buffers");
-
- {
- bool allocation_failed = false;
-
- for (i = 0; i < gen->chans; i++)
- {
- /* clm_file_buffer_size may be too large, but it's very hard to tell that
- * in advance. In Linux, malloc returns a non-null pointer even when
- * there's no memory available, so you have to touch the memory to force
- * the OS to deal with it, then the next allocation returns null.
- * So, here we go...
- */
- addbufs[i] = (mus_sample_t *)calloc(clm_file_buffer_size, sizeof(mus_sample_t));
- if (addbufs[i])
- addbufs[i][0] = MUS_SAMPLE_0;
- else
- {
- allocation_failed = true;
- break;
- }
- }
-
- if (allocation_failed)
- {
- mus_long_t old_file_buffer_size = 0;
-
- /* first clean up the mess we made */
- for (i = 0; i < gen->chans; i++)
+ mus_float_t **addbufs = NULL;
+ int i;
+ mus_sample_t sample_type;
+ mus_long_t current_file_framples, framples_to_add;
+
+ sample_type = mus_sound_sample_type(gen->file_name);
+ current_file_framples = mus_sound_framples(gen->file_name);
+ /* this is often 0 (brand-new file) */
+
+ if (current_file_framples > gen->data_start)
+ {
+ bool allocation_failed = false;
+ addbufs = (mus_float_t **)calloc(gen->chans, sizeof(mus_float_t *));
+
+ for (i = 0; i < gen->chans; i++)
+ {
+ /* clm_file_buffer_size may be too large, but it's very hard to tell that
+ * in advance. In Linux, malloc returns a non-null pointer even when
+ * there's no memory available, so you have to touch the memory to force
+ * the OS to deal with it, then the next allocation returns null.
+ */
+ addbufs[i] = (mus_float_t *)malloc(clm_file_buffer_size * sizeof(mus_float_t));
if (addbufs[i])
+ addbufs[i][0] = 0.0;
+ else
{
- free(addbufs[i]);
- addbufs[i] = NULL;
+ allocation_failed = true;
+ break;
}
- clm_free(addbufs);
-
- /* it would take a lot of screwing around to find the biggest clm_file_buffer_size we could handle,
- * and it might fail on the next call (if more chans), so we'll throw an error. We could get
- * say 1024 samps per chan, then run through a loop outputting the current buffer, but geez...
- */
- /* but... if we hit this in with-sound, mus_error calls (eventually) s7_error which sees the
- * dynamic-wind and tries to call mus-close, which tries to flush the buffers and we have
- * an infinite loop. So, we need to clean up right now.
- */
- mus_sound_close_input(fd);
- old_file_buffer_size = clm_file_buffer_size;
- clm_file_buffer_size = MUS_DEFAULT_FILE_BUFFER_SIZE;
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, S_mus_file_buffer_size " (" MUS_LD ") is too large: we can't allocate the output buffers!", old_file_buffer_size);
- return;
- }
- }
-
- mus_file_seek_frame(fd, gen->data_start);
- frames_to_add = gen->out_end - gen->data_start;
-
- /* if the caller reset clm_file_buffer_size during a run, frames_to_add might be greater than the assumed buffer size,
+ }
+
+ if (allocation_failed)
+ {
+ mus_long_t old_file_buffer_size = 0;
+
+ /* first clean up the mess we made */
+ for (i = 0; i < gen->chans; i++)
+ if (addbufs[i])
+ {
+ free(addbufs[i]);
+ addbufs[i] = NULL;
+ }
+ free(addbufs);
+
+ /* it would take a lot of screwing around to find the biggest clm_file_buffer_size we could handle,
+ * and it might fail on the next call (if more chans), so we'll throw an error. We could get
+ * say 1024 samps per chan, then run through a loop outputting the current buffer, but geez...
+ */
+ /* but... if we hit this in with-sound, mus_error calls (eventually) s7_error which sees the
+ * dynamic-wind and tries to call mus-close, which tries to flush the buffers and we have
+ * an infinite loop. So, we need to clean up right now.
+ */
+ mus_sound_close_input(fd);
+ old_file_buffer_size = clm_file_buffer_size;
+ clm_file_buffer_size = MUS_DEFAULT_FILE_BUFFER_SIZE;
+ mus_error(MUS_MEMORY_ALLOCATION_FAILED, S_mus_file_buffer_size " (%lld) is too large: we can't allocate the output buffers!", old_file_buffer_size);
+ return;
+ }
+ }
+
+ framples_to_add = gen->out_end - gen->data_start;
+
+ /* if the caller reset clm_file_buffer_size during a run, framples_to_add might be greater than the assumed buffer size,
* so we need to complain and fix up the limits. In CLM, the size is set in sound.lisp, begin-with-sound.
* In Snd via mus_set_file_buffer_size in clm2xen.c. The initial default is set in mus_initialize
* called in CLM by clm-initialize-links via in cmus.c, and in Snd in clm2xen.c when the module is setup.
*/
- if (frames_to_add >= clm_file_buffer_size)
+ if (framples_to_add >= clm_file_buffer_size)
{
- mus_print("clm-file-buffer-size changed? " MUS_LD " <= " MUS_LD " (start: " MUS_LD ", end: " MUS_LD ", " MUS_LD ")",
- clm_file_buffer_size, frames_to_add, gen->data_start, gen->data_end, gen->out_end);
-
- frames_to_add = clm_file_buffer_size - 1;
+ mus_print("clm-file-buffer-size changed? %lld <= %lld (start: %lld, end: %lld, %lld)",
+ clm_file_buffer_size, framples_to_add, gen->data_start, gen->data_end, gen->out_end);
+
+ framples_to_add = clm_file_buffer_size - 1;
/* this means we drop samples -- the other choice (short of throwing an error) would
* be to read/allocate the bigger size.
*/
}
+ if (addbufs)
+ {
+ mus_file_seek_frample(fd, gen->data_start);
+ mus_file_read(fd, gen->data_start, framples_to_add + 1, gen->chans, addbufs);
+ }
+ mus_sound_close_input(fd); /* close previous mus_sound_open_input */
- mus_file_read(fd, 0, frames_to_add, gen->chans, addbufs);
- mus_sound_close_input(fd);
-
- fd = mus_sound_reopen_output(gen->file_name, gen->chans, data_format,
+ fd = mus_sound_reopen_output(gen->file_name, gen->chans, sample_type,
mus_sound_header_type(gen->file_name),
mus_sound_data_location(gen->file_name));
-
- if ((current_file_frames < gen->data_start) &&
- (data_format_zero[data_format] != 0))
+
+ if ((current_file_framples < gen->data_start) &&
+ (sample_type_zero[sample_type] != 0))
{
- /* we're about to create a gap in the output file. mus_file_seek_frame calls lseek which (man lseek):
+ /* we're about to create a gap in the output file. mus_file_seek_frample calls lseek which (man lseek):
*
* "The lseek function allows the file offset to be set beyond the end of
* the existing end-of-file of the file (but this does not change the size
@@ -7924,71 +11140,129 @@ static void flush_buffers(rdout *gen)
* of the data in the gap return bytes of zeros (until data is actually
* written into the gap)."
*
- * but 0 bytes in a file are not interpreted as sound samples of 0 in several data formats.
+ * but 0 bytes in a file are not interpreted as sound samples of 0 in several sample types.
* for example, mus-mulaw 0 => -.98, whereas sound sample 0 is a byte of 255.
- * see the table at the end of this file (data_format_zero) for the other cases.
+ * see the table at the end of this file (sample_type_zero) for the other cases.
*
- * So, we need to write explicit data-format 0 values in those cases where machine 0's
- * won't be data format 0. data_format_zero[format] != 0 signals we have such a
+ * So, we need to write explicit sample-type 0 values in those cases where machine 0's
+ * won't be sample type 0. sample_type_zero[type] != 0 signals we have such a
* case, and returns the nominal zero value. For unsigned shorts, we also need to
* take endianess into account.
- *
- * Since addbufs is empty here, and is of type mus_sample_t, I'll take the slightly
- * slower but simpler path of calling mus_file_write to handle all the translations.
*/
-
- mus_long_t filler, current_samps;
- filler = gen->data_start - current_file_frames;
- mus_file_seek_frame(fd, current_file_frames);
+
+ mus_long_t filler, current_samps, bytes, bps;
+ unsigned char *zeros;
+ #define MAX_ZERO_SAMPLES 65536
+
+ bps = mus_bytes_per_sample(sample_type);
+ filler = gen->data_start - current_file_framples;
+ mus_file_seek_frample(fd, current_file_framples);
+
+ if (filler > MAX_ZERO_SAMPLES)
+ bytes = MAX_ZERO_SAMPLES * bps * gen->chans;
+ else bytes = filler * bps * gen->chans;
+
+ zeros = (unsigned char *)malloc(bytes);
+ if (bps == 1)
+ memset((void *)zeros, sample_type_zero[sample_type], bytes);
+ else /* it has to be a short */
+ {
+ int df, i, b1, b2;
+ df = sample_type_zero[sample_type];
+ b1 = df >> 8;
+ b2 = df & 0xff;
+ for (i = 0; i < bytes; i += 2)
+ {
+ zeros[i] = b2;
+ zeros[i + 1] = b1;
+ }
+ }
+ /* (with-sound (:sample-type mus-ulshort) (fm-violin 10 1 440 .1)) */
while (filler > 0)
{
- if (filler > clm_file_buffer_size)
- current_samps = clm_file_buffer_size;
- else current_samps = filler;
- mus_file_write(fd, 0, current_samps - 1, gen->chans, addbufs);
+ ssize_t wbytes;
+ if (filler > MAX_ZERO_SAMPLES)
+ current_samps = MAX_ZERO_SAMPLES;
+ else
+ {
+ current_samps = filler;
+ bytes = current_samps * bps * gen->chans;
+ }
+ wbytes = write(fd, zeros, bytes);
+ if (wbytes != bytes) fprintf(stderr, "%s[%d]: write trouble\n", __func__, __LINE__);
filler -= current_samps;
}
+ free(zeros);
}
-
- /* fill/write output buffers with current data added to saved data (if any) */
- for (j = 0; j < gen->chans; j++)
- for (i = 0; i <= frames_to_add; i++)
- addbufs[j][i] += gen->obufs[j][i];
-
- mus_file_seek_frame(fd, gen->data_start);
- mus_file_write(fd, 0, frames_to_add, gen->chans, addbufs);
- if (current_file_frames <= gen->out_end) current_file_frames = gen->out_end + 1;
-
- mus_sound_close_output(fd, current_file_frames * gen->chans * mus_bytes_per_sample(data_format));
-
- for (i = 0; i < gen->chans; i++)
- free(addbufs[i]); /* used calloc above to make sure we can check for unsuccessful allocation */
- clm_free(addbufs);
+
+ if (addbufs)
+ {
+ int j;
+ /* fill/write output buffers with current data added to saved data */
+ for (j = 0; j < gen->chans; j++)
+ {
+ mus_float_t *adder, *vals;
+ mus_long_t add4;
+ adder = addbufs[j];
+ vals = gen->obufs[j];
+ add4 = framples_to_add - 4;
+ i = 0;
+ while (i <= add4)
+ {
+ adder[i] += vals[i];
+ i++;
+ adder[i] += vals[i];
+ i++;
+ adder[i] += vals[i];
+ i++;
+ adder[i] += vals[i];
+ i++;
+ }
+ for (; i <= framples_to_add; i++)
+ adder[i] += vals[i];
+ }
+
+ mus_file_seek_frample(fd, gen->data_start);
+ mus_file_write(fd, 0, framples_to_add, gen->chans, addbufs);
+ for (i = 0; i < gen->chans; i++)
+ free(addbufs[i]);
+ free(addbufs);
+ }
+ else
+ {
+ /* output currently empty, so just flush out the gen->obufs */
+ mus_file_seek_frample(fd, gen->data_start);
+ mus_file_write(fd, 0, framples_to_add, gen->chans, gen->obufs);
+ }
+
+ if (current_file_framples <= gen->out_end)
+ current_file_framples = gen->out_end + 1;
+ mus_sound_close_output(fd, current_file_framples * gen->chans * mus_bytes_per_sample(sample_type));
}
}
mus_any *mus_sample_to_file_add(mus_any *out1, mus_any *out2)
{
- mus_long_t min_frames;
+ mus_long_t min_framples;
rdout *dest = (rdout *)out1;
rdout *in_coming = (rdout *)out2;
int chn, min_chans;
min_chans = dest->chans;
if (in_coming->chans < min_chans) min_chans = in_coming->chans;
- min_frames = in_coming->out_end;
+ min_framples = in_coming->out_end;
for (chn = 0; chn < min_chans; chn++)
{
mus_long_t i;
- for (i = 0; i < min_frames; i++)
+ for (i = 0; i < min_framples; i++)
dest->obufs[chn][i] += in_coming->obufs[chn][i];
- memset((void *)(in_coming->obufs[chn]), 0, min_frames * sizeof(mus_sample_t));
+ memset((void *)(in_coming->obufs[chn]), 0, min_framples * sizeof(mus_float_t));
}
- if (min_frames > dest->out_end)
- dest->out_end = min_frames;
+ if (min_framples > dest->out_end)
+ dest->out_end = min_framples;
in_coming->out_end = 0;
in_coming->data_start = 0;
@@ -8002,31 +11276,115 @@ mus_float_t mus_out_any_to_file(mus_any *ptr, mus_long_t samp, int chan, mus_flo
rdout *gen = (rdout *)ptr;
if (!ptr) return(val);
- if ((chan >= gen->chans) ||
- (!(gen->obufs)) ||
- (samp < 0))
+ if ((chan >= gen->chans) || /* checking for (val == 0.0) here appears to make no difference overall */
+ (!(gen->obufs)))
return(val);
- if (gen->safety == 1)
+ if ((samp <= gen->data_end) &&
+ (samp >= gen->data_start))
+ gen->obufs[chan][samp - gen->data_start] += val;
+ else
{
- gen->obufs[chan][samp] += MUS_FLOAT_TO_SAMPLE(val);
- if (samp > gen->out_end)
- gen->out_end = samp;
- return(val);
+ int j;
+ if (samp < 0) return(val);
+ flush_buffers(gen);
+ for (j = 0; j < gen->chans; j++)
+ memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ gen->data_start = samp;
+ gen->data_end = samp + clm_file_buffer_size - 1;
+ gen->obufs[chan][0] += val;
+ gen->out_end = samp; /* this resets the current notion of where in the buffer the new data ends */
+ }
+
+ if (samp > gen->out_end)
+ gen->out_end = samp;
+ return(val);
+}
+
+
+static void mus_out_chans_to_file(rdout *gen, mus_long_t samp, int chans, mus_float_t *vals)
+{
+ int i;
+ if ((samp <= gen->data_end) &&
+ (samp >= gen->data_start))
+ {
+ mus_long_t pos;
+ pos = samp - gen->data_start;
+ for (i = 0; i < chans; i++)
+ gen->obufs[i][pos] += vals[i];
+ }
+ else
+ {
+ int j;
+ if (samp < 0) return;
+ flush_buffers(gen);
+ for (j = 0; j < gen->chans; j++)
+ memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ gen->data_start = samp;
+ gen->data_end = samp + clm_file_buffer_size - 1;
+ for (i = 0; i < chans; i++)
+ gen->obufs[i][0] += vals[i];
+ gen->out_end = samp; /* this resets the current notion of where in the buffer the new data ends */
+ }
+
+ if (samp > gen->out_end)
+ gen->out_end = samp;
+}
+
+
+static mus_float_t mus_outa_to_file(mus_any *ptr, mus_long_t samp, mus_float_t val)
+{
+ rdout *gen = (rdout *)ptr;
+ if (!ptr) return(val);
+
+ if ((!(gen->obuf0)) ||
+ (!(gen->obufs)))
+ return(val);
+
+ if ((samp <= gen->data_end) &&
+ (samp >= gen->data_start))
+ gen->obuf0[samp - gen->data_start] += val;
+ else
+ {
+ int j;
+ if (samp < 0) return(val);
+ flush_buffers(gen);
+ for (j = 0; j < gen->chans; j++)
+ memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ gen->data_start = samp;
+ gen->data_end = samp + clm_file_buffer_size - 1;
+ gen->obuf0[0] += val;
+ gen->out_end = samp; /* this resets the current notion of where in the buffer the new data ends */
}
+ if (samp > gen->out_end)
+ gen->out_end = samp;
+ return(val);
+}
+
+
+static mus_float_t mus_outb_to_file(mus_any *ptr, mus_long_t samp, mus_float_t val)
+{
+ rdout *gen = (rdout *)ptr;
+ if (!ptr) return(val);
+
+ if ((!(gen->obuf1)) ||
+ (!(gen->obufs)))
+ return(val);
+
if ((samp <= gen->data_end) &&
(samp >= gen->data_start))
- gen->obufs[chan][samp - gen->data_start] += MUS_FLOAT_TO_SAMPLE(val);
+ gen->obuf1[samp - gen->data_start] += val;
else
{
int j;
+ if (samp < 0) return(val);
flush_buffers(gen);
for (j = 0; j < gen->chans; j++)
- memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_sample_t));
+ memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
gen->data_start = samp;
gen->data_end = samp + clm_file_buffer_size - 1;
- gen->obufs[chan][samp - gen->data_start] += MUS_FLOAT_TO_SAMPLE(val);
+ gen->obuf1[0] += val;
gen->out_end = samp; /* this resets the current notion of where in the buffer the new data ends */
}
@@ -8041,64 +11399,76 @@ static int sample_to_file_end(mus_any *ptr)
rdout *gen = (rdout *)ptr;
if ((gen) && (gen->obufs))
{
- int i;
if (gen->chans > 0)
{
+ int i;
flush_buffers(gen); /* this forces the error handling stuff, unlike in free reader case */
for (i = 0; i < gen->chans; i++)
if (gen->obufs[i])
- clm_free(gen->obufs[i]);
+ free(gen->obufs[i]);
}
- clm_free(gen->obufs);
+ free(gen->obufs);
gen->obufs = NULL;
+ gen->obuf0 = NULL;
+ gen->obuf1 = NULL;
}
return(0);
}
-bool mus_sample_to_file_p(mus_any *ptr)
+bool mus_is_sample_to_file(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_SAMPLE_TO_FILE));
}
-static mus_any *mus_make_sample_to_file_with_comment_1(const char *filename, int out_chans, int out_format, int out_type, const char *comment, bool reopen)
+static mus_any *mus_make_sample_to_file_with_comment_1(const char *filename, int out_chans,
+ mus_sample_t samp_type, mus_header_t head_type, const char *comment, bool reopen)
{
- int fd;
if (filename == NULL)
mus_error(MUS_NO_FILE_NAME_PROVIDED, S_make_sample_to_file " requires a file name");
else
{
+ int fd;
+ if (out_chans <= 0)
+ return(NULL);
if (reopen)
- fd = mus_sound_reopen_output(filename, out_chans, out_format, out_type, mus_sound_data_location(filename));
- else fd = mus_sound_open_output(filename, (int)sampling_rate, out_chans, out_format, out_type, comment);
+ fd = mus_sound_reopen_output(filename, out_chans, samp_type, head_type, mus_sound_data_location(filename));
+ else fd = mus_sound_open_output(filename, (int)sampling_rate, out_chans, samp_type, head_type, comment);
if (fd == -1)
mus_error(MUS_CANT_OPEN_FILE,
- "open(%s) -> %s",
+ S_make_sample_to_file ": open(%s) -> %s",
filename, STRERROR(errno));
else
{
rdout *gen;
int i;
- gen = (rdout *)clm_calloc(1, sizeof(rdout), "output");
+
+ gen = (rdout *)calloc(1, sizeof(rdout));
gen->core = &SAMPLE_TO_FILE_CLASS;
- gen->file_name = (char *)clm_calloc_atomic(strlen(filename) + 1, sizeof(char), "output filename");
+ gen->file_name = (char *)calloc(strlen(filename) + 1, sizeof(char));
strcpy(gen->file_name, filename);
gen->data_start = 0;
gen->data_end = clm_file_buffer_size - 1;
gen->out_end = 0;
gen->chans = out_chans;
- gen->output_data_format = out_format;
- gen->output_header_type = out_type;
- gen->obufs = (mus_sample_t **)clm_calloc(gen->chans, sizeof(mus_sample_t *), "output buffers");
+ gen->output_sample_type = samp_type;
+ gen->output_header_type = head_type;
+ gen->obufs = (mus_float_t **)malloc(gen->chans * sizeof(mus_float_t *));
for (i = 0; i < gen->chans; i++)
- gen->obufs[i] = (mus_sample_t *)clm_calloc_atomic(clm_file_buffer_size, sizeof(mus_sample_t), "output buffer");
+ gen->obufs[i] = (mus_float_t *)calloc(clm_file_buffer_size, sizeof(mus_float_t));
+ gen->obuf0 = gen->obufs[0];
+ if (out_chans > 1)
+ gen->obuf1 = gen->obufs[1];
+ else gen->obuf1 = NULL;
+
/* clear previous, if any */
if (mus_file_close(fd) != 0)
mus_error(MUS_CANT_CLOSE_FILE,
- "close(%d, %s) -> %s",
+ S_make_sample_to_file ": close(%d, %s) -> %s",
fd, gen->file_name, STRERROR(errno));
+
return((mus_any *)gen);
}
}
@@ -8110,77 +11480,131 @@ mus_any *mus_continue_sample_to_file(const char *filename)
{
return(mus_make_sample_to_file_with_comment_1(filename,
mus_sound_chans(filename),
- mus_sound_data_format(filename),
+ mus_sound_sample_type(filename),
mus_sound_header_type(filename),
NULL,
true));
}
-mus_any *mus_make_sample_to_file_with_comment(const char *filename, int out_chans, int out_format, int out_type, const char *comment)
+mus_any *mus_make_sample_to_file_with_comment(const char *filename, int out_chans, mus_sample_t samp_type, mus_header_t head_type, const char *comment)
{
- return(mus_make_sample_to_file_with_comment_1(filename, out_chans, out_format, out_type, comment, false));
+ return(mus_make_sample_to_file_with_comment_1(filename, out_chans, samp_type, head_type, comment, false));
}
-mus_float_t mus_sample_to_file(mus_any *ptr, mus_long_t samp, int chan, mus_float_t val)
+mus_float_t mus_sample_to_file(mus_any *fd, mus_long_t samp, int chan, mus_float_t val)
{
- return(mus_write_sample(ptr, samp, chan, val)); /* write_sample -> write_sample in class struct -> mus_out_any_to_file for example */
+ /* return(mus_write_sample(ptr, samp, chan, val)); */
+ if ((fd) &&
+ ((fd->core)->write_sample))
+ return(((*(fd->core)->write_sample))(fd, samp, chan, val));
+ mus_error(MUS_NO_SAMPLE_OUTPUT,
+ S_sample_to_file ": can't find %s's sample output function",
+ mus_name(fd));
+ return(val);
}
int mus_close_file(mus_any *ptr)
{
rdout *gen = (rdout *)ptr;
- if ((mus_output_p(ptr)) && (gen->obufs)) sample_to_file_end(ptr);
+ if ((mus_is_output(ptr)) && (gen->obufs)) sample_to_file_end(ptr);
return(0);
}
-/* ---------------- out-any ---------------- */
-
-mus_float_t mus_out_any(mus_long_t samp, mus_float_t val, int chan, mus_any *IO)
+/* ---------------- out-any ---------------- */
+
+mus_float_t mus_out_any(mus_long_t samp, mus_float_t val, int chan, mus_any *IO)
+{
+ if ((IO) &&
+ (samp >= 0))
+ {
+ if ((IO->core)->write_sample)
+ return(((*(IO->core)->write_sample))(IO, samp, chan, val));
+ mus_error(MUS_NO_SAMPLE_OUTPUT,
+ "can't find %s's sample output function",
+ mus_name(IO));
+ }
+ return(val);
+}
+
+
+mus_float_t mus_safe_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO)
+{
+ rdout *gen = (rdout *)IO;
+ if (chan >= gen->chans) /* checking for (val == 0.0) here appears to make no difference overall */
+ return(val);
+ /* does this need to check obufs? */
+
+ if ((samp <= gen->data_end) &&
+ (samp >= gen->data_start))
+ {
+ gen->obufs[chan][samp - gen->data_start] += val;
+ if (samp > gen->out_end)
+ gen->out_end = samp;
+ }
+ else
+ {
+ int j;
+ if (samp < 0) return(val);
+ flush_buffers(gen);
+ for (j = 0; j < gen->chans; j++)
+ memset((void *)(gen->obufs[j]), 0, clm_file_buffer_size * sizeof(mus_float_t));
+ gen->data_start = samp;
+ gen->data_end = samp + clm_file_buffer_size - 1;
+ gen->obufs[chan][0] += val;
+ gen->out_end = samp; /* this resets the current notion of where in the buffer the new data ends */
+ }
+ return(val);
+
+}
+
+
+bool mus_out_any_is_safe(mus_any *IO)
{
- if ((IO) && (samp >= 0))
- return(mus_write_sample(IO, samp, chan, val));
- return(val);
+ rdout *gen = (rdout *)IO;
+ return((gen) &&
+ (gen->obufs) &&
+ (gen->core->write_sample == mus_out_any_to_file));
}
-/* ---------------- frame->file ---------------- */
+/* ---------------- frample->file ---------------- */
-static char *describe_frame_to_file(mus_any *ptr)
+static char *describe_frample_to_file(mus_any *ptr)
{
rdout *gen = (rdout *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s",
mus_name(ptr),
gen->file_name);
return(describe_buffer);
}
-static mus_float_t run_frame_to_file(mus_any *ptr, mus_float_t arg1, mus_float_t arg2)
+static mus_float_t run_frample_to_file(mus_any *ptr, mus_float_t arg1, mus_float_t arg2)
{
- mus_error(MUS_NO_RUN, "no run method for frame->file");
+ mus_error(MUS_NO_RUN, "no run method for frample->file");
return(0.0);
}
-static mus_any_class FRAME_TO_FILE_CLASS = {
- MUS_FRAME_TO_FILE,
- (char *)S_frame_to_file,
+static mus_any_class FRAMPLE_TO_FILE_CLASS = {
+ MUS_FRAMPLE_TO_FILE,
+ (char *)S_frample_to_file,
&free_sample_to_file,
- &describe_frame_to_file,
+ &describe_frample_to_file,
&sample_to_file_equalp,
0, 0,
&bufferlen, &set_bufferlen,
0, 0, 0, 0,
&fallback_scaler, 0,
0, 0,
- &run_frame_to_file,
+ &run_frample_to_file,
MUS_OUTPUT,
NULL,
&sample_to_file_channels,
@@ -8190,71 +11614,72 @@ static mus_any_class FRAME_TO_FILE_CLASS = {
&sample_to_file_file_name,
&sample_to_file_end,
0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&no_reset,
- 0,
- &sample_to_file_safety,
- &sample_to_file_set_safety
+ 0, &rdout_copy
};
-mus_any *mus_make_frame_to_file_with_comment(const char *filename, int chans, int out_format, int out_type, const char *comment)
+mus_any *mus_make_frample_to_file_with_comment(const char *filename, int chans, mus_sample_t samp_type, mus_header_t head_type, const char *comment)
{
rdout *gen = NULL;
- gen = (rdout *)mus_make_sample_to_file_with_comment(filename, chans, out_format, out_type, comment);
- if (gen) gen->core = &FRAME_TO_FILE_CLASS;
+ gen = (rdout *)mus_make_sample_to_file_with_comment(filename, chans, samp_type, head_type, comment);
+ if (gen) gen->core = &FRAMPLE_TO_FILE_CLASS;
return((mus_any *)gen);
}
-bool mus_frame_to_file_p(mus_any *ptr)
+bool mus_is_frample_to_file(mus_any *ptr)
{
return((ptr) &&
- (ptr->core->type == MUS_FRAME_TO_FILE));
+ (ptr->core->type == MUS_FRAMPLE_TO_FILE));
}
-mus_any *mus_frame_to_file(mus_any *ptr, mus_long_t samp, mus_any *udata)
+mus_float_t *mus_frample_to_file(mus_any *ptr, mus_long_t samp, mus_float_t *data)
{
rdout *gen = (rdout *)ptr;
- mus_frame *data = (mus_frame *)udata;
+ if (!gen) return(data);
- if (data)
+ if (gen->chans == 1)
+ mus_outa_to_file(ptr, samp, data[0]);
+ else
{
- if (data->chans == 1)
- mus_out_any_to_file(ptr, samp, 0, data->vals[0]);
- else
+ if (gen->chans == 2)
{
- if ((data->chans == 2) &&
- (gen->chans == 2))
- {
- mus_out_any_to_file(ptr, samp, 0, data->vals[0]);
- mus_out_any_to_file(ptr, samp, 1, data->vals[1]);
- }
- else
- {
- int i, chans;
- chans = data->chans;
- if (gen->chans < chans)
- chans = gen->chans;
- for (i = 0; i < chans; i++)
- mus_out_any_to_file(ptr, samp, i, data->vals[i]);
- }
+ mus_outa_to_file(ptr, samp, data[0]);
+ mus_outb_to_file(ptr, samp, data[1]);
}
+ else mus_out_chans_to_file(gen, samp, gen->chans, data);
}
- return(udata);
+ return(data);
}
-mus_any *mus_continue_frame_to_file(const char *filename)
+mus_any *mus_continue_frample_to_file(const char *filename)
{
rdout *gen = NULL;
gen = (rdout *)mus_continue_sample_to_file(filename);
- if (gen) gen->core = &FRAME_TO_FILE_CLASS;
+ if (gen) gen->core = &FRAMPLE_TO_FILE_CLASS;
return((mus_any *)gen);
}
+mus_float_t *mus_frample_to_frample(mus_float_t *matrix, int mx_chans, mus_float_t *in_samps, int in_chans, mus_float_t *out_samps, int out_chans)
+{
+ /* in->out conceptually, so left index is in_chan, it (j below) steps by out_chans */
+ int i, j, offset;
+ if (mx_chans < out_chans) out_chans = mx_chans;
+ if (mx_chans < in_chans) in_chans = mx_chans;
+ for (i = 0; i < out_chans; i++)
+ {
+ out_samps[i] = in_samps[0] * matrix[i];
+ for (j = 1, offset = mx_chans; j < in_chans; j++, offset += mx_chans)
+ out_samps[i] += in_samps[j] * matrix[offset + i];
+ }
+ return(out_samps);
+}
+
/* ---------------- locsig ---------------- */
@@ -8263,14 +11688,16 @@ typedef struct {
mus_any_class *core;
mus_any *outn_writer;
mus_any *revn_writer;
- mus_frame *outf, *revf;
+ mus_float_t *outf, *revf;
mus_float_t *outn;
mus_float_t *revn;
int chans, rev_chans;
mus_interp_t type;
mus_float_t reverb;
+ bool safe_output;
void *closure;
- int safety;
+ void (*locsig_func)(mus_any *ptr, mus_long_t loc, mus_float_t val);
+ void (*detour)(mus_any *ptr, mus_long_t loc);
} locs;
@@ -8295,24 +11722,24 @@ static char *describe_locsig(mus_any *ptr)
locs *gen = (locs *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s chans %d, outn: [",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s chans %d, outn: [",
mus_name(ptr),
gen->chans);
- str = (char *)clm_calloc(STR_SIZE, sizeof(char), "describe_locsig");
+ str = (char *)malloc(STR_SIZE * sizeof(char));
if (gen->outn)
{
if (gen->chans - 1 < lim) lim = gen->chans - 1;
for (i = 0; i < lim; i++)
{
- mus_snprintf(str, STR_SIZE, "%.3f ", gen->outn[i]);
+ snprintf(str, STR_SIZE, "%.3f ", gen->outn[i]);
if ((strlen(describe_buffer) + strlen(str)) < (DESCRIBE_BUFFER_SIZE - 16))
strcat(describe_buffer, str);
else break;
}
if (gen->chans - 1 > lim) strcat(describe_buffer, "...");
- mus_snprintf(str, STR_SIZE, "%.3f]", gen->outn[gen->chans - 1]);
+ snprintf(str, STR_SIZE, "%.3f]", gen->outn[gen->chans - 1]);
strcat(describe_buffer, str);
}
else
@@ -8327,58 +11754,79 @@ static char *describe_locsig(mus_any *ptr)
if (gen->rev_chans - 1 < lim) lim = gen->rev_chans - 1;
for (i = 0; i < lim; i++)
{
- mus_snprintf(str, STR_SIZE, "%.3f ", gen->revn[i]);
+ snprintf(str, STR_SIZE, "%.3f ", gen->revn[i]);
if ((strlen(describe_buffer) + strlen(str)) < (DESCRIBE_BUFFER_SIZE - 16))
strcat(describe_buffer, str);
else break;
}
if (gen->rev_chans - 1 > lim) strcat(describe_buffer, "...");
- mus_snprintf(str, STR_SIZE, "%.3f]", gen->revn[gen->rev_chans - 1]);
+ snprintf(str, STR_SIZE, "%.3f]", gen->revn[gen->rev_chans - 1]);
strcat(describe_buffer, str);
}
- mus_snprintf(str, STR_SIZE, ", interp: %s", interp_type_to_string(gen->type));
+ snprintf(str, STR_SIZE, ", interp: %s", interp_type_to_string(gen->type));
strcat(describe_buffer, str);
- clm_free(str);
+ free(str);
return(describe_buffer);
}
-static int free_locsig(mus_any *p)
+static void free_locsig(mus_any *p)
{
locs *ptr = (locs *)p;
- if (ptr)
+ if (ptr->outn)
{
- if (ptr->outn)
- {
- clm_free(ptr->outn);
- ptr->outn = NULL;
- }
- if (ptr->revn)
- {
- clm_free(ptr->revn);
- ptr->revn = NULL;
- }
- mus_free((mus_any *)(ptr->outf));
- ptr->outf = NULL;
- if (ptr->revf)
- {
- mus_free((mus_any *)(ptr->revf));
- ptr->revf = NULL;
- }
- ptr->outn_writer = NULL;
- ptr->revn_writer = NULL;
- ptr->chans = 0;
- ptr->rev_chans = 0;
- clm_free(ptr);
+ free(ptr->outn);
+ ptr->outn = NULL;
}
- return(0);
+ if (ptr->revn)
+ {
+ free(ptr->revn);
+ ptr->revn = NULL;
+ }
+ if (ptr->outf) free(ptr->outf);
+ ptr->outf = NULL;
+ if (ptr->revf) free(ptr->revf);
+ ptr->revf = NULL;
+ ptr->outn_writer = NULL;
+ ptr->revn_writer = NULL;
+ ptr->chans = 0;
+ ptr->rev_chans = 0;
+ free(ptr);
+}
+
+static mus_any *locs_copy(mus_any *ptr)
+{
+ locs *g, *p;
+ int bytes;
+ p = (locs *)ptr;
+ g = (locs *)malloc(sizeof(locs));
+ memcpy((void *)g, (void *)ptr, sizeof(locs));
+ bytes = g->chans * sizeof(mus_float_t);
+ if (p->outn)
+ {
+ g->outn = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->outn), (void *)(p->outn), bytes);
+ }
+ if (p->outf)
+ {
+ g->outf = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->outf), (void *)(p->outf), bytes);
+ }
+ bytes = g->rev_chans * sizeof(mus_float_t);
+ if (p->revn)
+ {
+ g->revn = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->revn), (void *)(p->revn), bytes);
+ }
+ if (p->revf)
+ {
+ g->revf = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->revf), (void *)(p->revf), bytes);
+ }
+ return((mus_any *)g);
}
-
-static int locsig_safety(mus_any *ptr) {return(((locs *)ptr)->safety);}
-static int locsig_set_safety(mus_any *ptr, int val) {((locs *)ptr)->safety = val; return(val);}
-
static mus_long_t locsig_length(mus_any *ptr) {return(((locs *)ptr)->chans);}
static int locsig_channels(mus_any *ptr) {return(((locs *)ptr)->chans);}
@@ -8387,18 +11835,24 @@ static mus_float_t *locsig_data(mus_any *ptr) {return(((locs *)ptr)->outn);}
static mus_float_t *locsig_xcoeffs(mus_any *ptr) {return(((locs *)ptr)->revn);}
-mus_any *mus_locsig_outf(mus_any *ptr) {return((mus_any *)(((locs *)ptr)->outf));} /* clm2xen.c */
-mus_any *mus_locsig_revf(mus_any *ptr) {return((mus_any *)(((locs *)ptr)->revf));}
+mus_float_t *mus_locsig_outf(mus_any *ptr) {return(((locs *)ptr)->outf);} /* clm2xen.c */
+mus_float_t *mus_locsig_revf(mus_any *ptr) {return(((locs *)ptr)->revf);}
-void *mus_locsig_closure(mus_any *ptr) {return(((locs *)ptr)->closure);} /* run.c */
+void *mus_locsig_closure(mus_any *ptr) {return(((locs *)ptr)->closure);}
static void *locsig_set_closure(mus_any *ptr, void *e) {((locs *)ptr)->closure = e; return(e);}
+void mus_locsig_set_detour(mus_any *ptr, void (*detour)(mus_any *ptr, mus_long_t val))
+{
+ locs *gen = (locs *)ptr;
+ gen->detour = detour;
+}
+
static void locsig_reset(mus_any *ptr)
{
locs *gen = (locs *)ptr;
- if (gen->outn) mus_clear_array(gen->outn, gen->chans);
- if (gen->revn) mus_clear_array(gen->revn, gen->rev_chans);
+ if (gen->outn) memset((void *)(gen->outn), 0, gen->chans * sizeof(mus_float_t));
+ if (gen->revn) memset((void *)(gen->revn), 0, gen->rev_chans * sizeof(mus_float_t));
}
@@ -8428,7 +11882,7 @@ static mus_any *locsig_warned = NULL;
mus_float_t mus_locsig_ref(mus_any *ptr, int chan)
{
locs *gen = (locs *)ptr;
- if ((ptr) && (mus_locsig_p(ptr)))
+ if ((ptr) && (mus_is_locsig(ptr)))
{
if ((chan >= 0) &&
(chan < gen->chans))
@@ -8438,7 +11892,7 @@ mus_float_t mus_locsig_ref(mus_any *ptr, int chan)
if (locsig_warned != gen->outn_writer)
{
mus_error(MUS_NO_SUCH_CHANNEL,
- S_locsig_ref " chan %d >= %d",
+ S_locsig_ref ": chan %d >= %d",
chan, gen->chans);
locsig_warned = gen->outn_writer;
}
@@ -8451,7 +11905,7 @@ mus_float_t mus_locsig_ref(mus_any *ptr, int chan)
mus_float_t mus_locsig_set(mus_any *ptr, int chan, mus_float_t val)
{
locs *gen = (locs *)ptr;
- if ((ptr) && (mus_locsig_p(ptr)))
+ if ((ptr) && (mus_is_locsig(ptr)))
{
if ((chan >= 0) &&
(chan < gen->chans))
@@ -8461,7 +11915,7 @@ mus_float_t mus_locsig_set(mus_any *ptr, int chan, mus_float_t val)
if (locsig_warned != gen->outn_writer)
{
mus_error(MUS_NO_SUCH_CHANNEL,
- S_locsig_set " chan %d >= %d",
+ S_locsig_set ": chan %d >= %d",
chan, gen->chans);
locsig_warned = gen->outn_writer;
}
@@ -8474,7 +11928,7 @@ mus_float_t mus_locsig_set(mus_any *ptr, int chan, mus_float_t val)
mus_float_t mus_locsig_reverb_ref(mus_any *ptr, int chan)
{
locs *gen = (locs *)ptr;
- if ((ptr) && (mus_locsig_p(ptr)))
+ if ((ptr) && (mus_is_locsig(ptr)))
{
if ((chan >= 0) &&
(chan < gen->rev_chans))
@@ -8484,7 +11938,7 @@ mus_float_t mus_locsig_reverb_ref(mus_any *ptr, int chan)
if (locsig_warned != gen->outn_writer)
{
mus_error(MUS_NO_SUCH_CHANNEL,
- S_locsig_reverb_ref " chan %d, but this locsig has %d reverb chans",
+ S_locsig_reverb_ref ": chan %d, but this locsig has %d reverb chans",
chan, gen->rev_chans);
locsig_warned = gen->outn_writer;
}
@@ -8497,7 +11951,7 @@ mus_float_t mus_locsig_reverb_ref(mus_any *ptr, int chan)
mus_float_t mus_locsig_reverb_set(mus_any *ptr, int chan, mus_float_t val)
{
locs *gen = (locs *)ptr;
- if ((ptr) && (mus_locsig_p(ptr)))
+ if ((ptr) && (mus_is_locsig(ptr)))
{
if ((chan >= 0) &&
(chan < gen->rev_chans))
@@ -8507,7 +11961,7 @@ mus_float_t mus_locsig_reverb_set(mus_any *ptr, int chan, mus_float_t val)
if (locsig_warned != gen->outn_writer)
{
mus_error(MUS_NO_SUCH_CHANNEL,
- S_locsig_reverb_set " chan %d >= %d",
+ S_locsig_reverb_set ": chan %d >= %d",
chan, gen->rev_chans);
locsig_warned = gen->outn_writer;
}
@@ -8545,14 +11999,14 @@ static mus_any_class LOCSIG_CLASS = {
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
0, 0,
- &locsig_xcoeffs, 0, 0,
+ &locsig_xcoeffs, 0,
&locsig_reset,
&locsig_set_closure, /* the method name is set_environ (clm2xen.c) */
- &locsig_safety, &locsig_set_safety
+ &locs_copy
};
-bool mus_locsig_p(mus_any *ptr)
+bool mus_is_locsig(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_LOCSIG));
@@ -8565,12 +12019,10 @@ static void mus_locsig_fill(mus_float_t *arr, int chans, mus_float_t degree, mus
arr[0] = scaler;
else
{
- mus_float_t deg, pos, frac, degs_per_chan, ldeg, c, s;
+ mus_float_t deg, pos, frac, degs_per_chan;
int left, right;
/* this used to check for degree < 0.0 first, but as Michael Klingbeil noticed, that
- * means that in the stereo case, the location can jump to 90 => click. It was also
- * possible for a negative degree to leak through, causing a segfault in the Scheme
- * version if "run" was in use.
+ * means that in the stereo case, the location can jump to 90 => click.
*/
if (chans == 2)
{
@@ -8598,7 +12050,7 @@ static void mus_locsig_fill(mus_float_t *arr, int chans, mus_float_t degree, mus
degs_per_chan = 360.0 / chans;
}
pos = deg / degs_per_chan;
- left = (int)floor(pos);
+ left = (int)pos; /* floor(pos) */
right = left + 1;
if (right >= chans) right = 0;
frac = pos - left;
@@ -8609,6 +12061,7 @@ static void mus_locsig_fill(mus_float_t *arr, int chans, mus_float_t degree, mus
}
else
{
+ mus_float_t ldeg, c, s;
ldeg = M_PI_2 * (0.5 - frac);
scaler *= sqrt(2.0) / 2.0;
c = cos(ldeg);
@@ -8620,195 +12073,377 @@ static void mus_locsig_fill(mus_float_t *arr, int chans, mus_float_t degree, mus
}
-mus_any *mus_make_locsig(mus_float_t degree, mus_float_t distance, mus_float_t reverb,
- int chans, mus_any *output, /* direct signal output */
- int rev_chans, mus_any *revput, /* reverb output */
- mus_interp_t type)
+static void mus_locsig_mono_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
- locs *gen;
- mus_float_t dist;
- if (chans <= 0)
- {
- mus_error(MUS_ARG_OUT_OF_RANGE, "chans: %d", chans);
- return(NULL);
- }
+ locs *gen = (locs *)ptr;
+ mus_outa_to_file(gen->outn_writer, loc, val * gen->outn[0]);
+}
- gen = (locs *)clm_calloc(1, sizeof(locs), S_make_locsig);
- gen->core = &LOCSIG_CLASS;
- gen->outf = (mus_frame *)mus_make_empty_frame(chans);
- gen->type = type;
- gen->reverb = reverb;
- if (distance > 1.0)
- dist = 1.0 / distance;
- else dist = 1.0;
+static void mus_locsig_mono(mus_any *ptr, mus_long_t loc, mus_float_t val)
+{
+ locs *gen = (locs *)ptr;
+ mus_outa_to_file(gen->outn_writer, loc, val * gen->outn[0]);
+ mus_outa_to_file(gen->revn_writer, loc, val * gen->revn[0]);
+}
- if (mus_output_p(output))
- gen->outn_writer = output;
- gen->chans = chans;
- gen->outn = (mus_float_t *)clm_calloc_atomic(gen->chans, sizeof(mus_float_t), "locsig frame");
- mus_locsig_fill(gen->outn, gen->chans, degree, dist, type);
- if (mus_output_p(revput))
- gen->revn_writer = revput;
- gen->rev_chans = rev_chans;
- if (gen->rev_chans > 0)
- {
- gen->revn = (mus_float_t *)clm_calloc_atomic(gen->rev_chans, sizeof(mus_float_t), "locsig reverb frame");
- gen->revf = (mus_frame *)mus_make_empty_frame(gen->rev_chans);
- mus_locsig_fill(gen->revn, gen->rev_chans, degree, (reverb * sqrt(dist)), type);
- }
+static void mus_locsig_stereo_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
+{
+ locs *gen = (locs *)ptr;
+ mus_outa_to_file(gen->outn_writer, loc, val * gen->outn[0]);
+ mus_outb_to_file(gen->outn_writer, loc, val * gen->outn[1]);
+}
- if ((gen->outn_writer) &&
- (((rdout *)output)->safety == 1))
- gen->safety = 1;
- return((mus_any *)gen);
+static void mus_locsig_stereo(mus_any *ptr, mus_long_t loc, mus_float_t val) /* but mono rev */
+{
+ locs *gen = (locs *)ptr;
+ mus_outa_to_file(gen->outn_writer, loc, val * gen->outn[0]);
+ mus_outb_to_file(gen->outn_writer, loc, val * gen->outn[1]);
+ mus_outa_to_file(gen->revn_writer, loc, val * gen->revn[0]);
}
-mus_float_t mus_locsig(mus_any *ptr, mus_long_t loc, mus_float_t val)
+static void mus_locsig_any(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
- locs *gen = (locs *)ptr;
int i;
-
- if (gen->safety == 1)
+ locs *gen = (locs *)ptr;
+ rdout *writer = (rdout *)(gen->outn_writer);
+ for (i = 0; i < gen->chans; i++)
{
- /* assume (since it's locsig) that we're eventually headed for sample->file, and
- * (since safety == 1) that everything is ready to go, and the output frames are
- * of no interest.
- */
-
- if (gen->outn_writer)
- {
- rdout *writer = (rdout *)(gen->outn_writer);
- for (i = 0; i < gen->chans; i++)
- writer->obufs[i][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->outn[i]);
- if (loc > writer->out_end)
- writer->out_end = loc;
- }
-
- if (gen->revn_writer)
- {
- rdout *writer = (rdout *)(gen->revn_writer);
- for (i = 0; i < gen->rev_chans; i++)
- writer->obufs[i][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->revn[i]);
- if (loc > writer->out_end)
- writer->out_end = loc;
- }
+ gen->outf[i] = val * gen->outn[i];
+ if (writer)
+ mus_out_any_to_file((mus_any *)writer, loc, i, gen->outf[i]);
}
- else
+ writer = (rdout *)(gen->revn_writer);
+ for (i = 0; i < gen->rev_chans; i++)
{
- rdout *writer = (rdout *)(gen->outn_writer);
- for (i = 0; i < gen->chans; i++)
- {
- (gen->outf)->vals[i] = val * gen->outn[i];
- if (writer)
- mus_out_any_to_file((mus_any *)writer, loc, i, gen->outf->vals[i]);
- }
- writer = (rdout *)(gen->revn_writer);
- for (i = 0; i < gen->rev_chans; i++)
- {
- (gen->revf)->vals[i] = val * gen->revn[i];
- if (writer)
- mus_out_any_to_file((mus_any *)writer, loc, i, gen->revf->vals[i]);
- }
+ gen->revf[i] = val * gen->revn[i];
+ if (writer)
+ mus_out_any_to_file((mus_any *)writer, loc, i, gen->revf[i]);
}
- return(val);
}
-
-int mus_locsig_channels(mus_any *ptr)
+static void mus_locsig_safe_mono_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
- return(((locs *)ptr)->chans);
-}
+ /* here we know in each safe case that obufs fits loc chans and the output gen is ok */
+ locs *gen = (locs *)ptr;
+ rdout *writer = (rdout *)(gen->outn_writer);
-int mus_locsig_reverb_channels(mus_any *ptr)
-{
- return(((locs *)ptr)->rev_chans);
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ writer->obufs[0][loc - writer->data_start] += (val * gen->outn[0]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else mus_outa_to_file((mus_any *)writer, loc, val * gen->outn[0]);
}
-int mus_locsig_safety(mus_any *ptr)
+static void mus_locsig_safe_mono(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
- return(((locs *)ptr)->safety);
+ locs *gen = (locs *)ptr;
+ rdout *writer = (rdout *)(gen->outn_writer);
+
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ writer->obufs[0][loc - writer->data_start] += (val * gen->outn[0]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else mus_outa_to_file((mus_any *)writer, loc, val * gen->outn[0]);
+
+ writer = (rdout *)(gen->revn_writer);
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ writer->obufs[0][loc - writer->data_start] += (val * gen->revn[0]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else mus_outa_to_file((mus_any *)writer, loc, val * gen->revn[0]);
}
-void mus_locsig_mono_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
+static void mus_locsig_safe_stereo_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
locs *gen = (locs *)ptr;
- mus_out_any_to_file(gen->outn_writer, loc, 0, val * gen->outn[0]);
-}
+ rdout *writer = (rdout *)(gen->outn_writer);
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ mus_long_t pos;
+ pos = loc - writer->data_start;
+ writer->obufs[0][pos] += (val * gen->outn[0]);
+ writer->obufs[1][pos] += (val * gen->outn[1]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else
+ {
+ mus_outa_to_file((mus_any *)writer, loc, val * gen->outn[0]);
+ mus_outb_to_file((mus_any *)writer, loc, val * gen->outn[1]);
+ }
+}
-void mus_locsig_mono(mus_any *ptr, mus_long_t loc, mus_float_t val)
+static void mus_locsig_safe_stereo(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
locs *gen = (locs *)ptr;
- mus_out_any_to_file(gen->outn_writer, loc, 0, val * gen->outn[0]);
- mus_out_any_to_file(gen->revn_writer, loc, 0, val * gen->revn[0]);
+ rdout *writer = (rdout *)(gen->outn_writer);
+
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ mus_long_t pos;
+ pos = loc - writer->data_start;
+ writer->obufs[0][pos] += (val * gen->outn[0]);
+ writer->obufs[1][pos] += (val * gen->outn[1]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else
+ {
+ mus_outa_to_file((mus_any *)writer, loc, val * gen->outn[0]);
+ mus_outb_to_file((mus_any *)writer, loc, val * gen->outn[1]);
+ }
+
+ writer = (rdout *)(gen->revn_writer);
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ writer->obufs[0][loc - writer->data_start] += (val * gen->revn[0]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else mus_outa_to_file((mus_any *)writer, loc, val * gen->revn[0]);
}
-void mus_locsig_stereo_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
+static void mus_locsig_detour(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
+ /* here we let the closure data decide what to do with the output */
locs *gen = (locs *)ptr;
- mus_out_any_to_file(gen->outn_writer, loc, 0, val * gen->outn[0]);
- mus_out_any_to_file(gen->outn_writer, loc, 1, val * gen->outn[1]);
+ if (gen->detour)
+ {
+ int i;
+ for (i = 0; i < gen->chans; i++)
+ gen->outf[i] = val * gen->outn[i];
+
+ for (i = 0; i < gen->rev_chans; i++)
+ gen->revf[i] = val * gen->revn[i];
+
+ (*(gen->detour))(ptr, loc);
+ }
}
-
-void mus_locsig_stereo(mus_any *ptr, mus_long_t loc, mus_float_t val) /* but mono rev */
+static void mus_locsig_any_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
+ int i;
locs *gen = (locs *)ptr;
- mus_out_any_to_file(gen->outn_writer, loc, 0, val * gen->outn[0]);
- mus_out_any_to_file(gen->outn_writer, loc, 1, val * gen->outn[1]);
- mus_out_any_to_file(gen->revn_writer, loc, 0, val * gen->revn[0]);
+ rdout *writer = (rdout *)(gen->outn_writer);
+ for (i = 0; i < gen->chans; i++)
+ {
+ gen->outf[i] = val * gen->outn[i];
+ if (writer)
+ mus_out_any_to_file((mus_any *)writer, loc, i, gen->outf[i]);
+ }
}
-
-void mus_locsig_safe_mono_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
+static void mus_locsig_safe_any_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
+ int i;
locs *gen = (locs *)ptr;
rdout *writer = (rdout *)(gen->outn_writer);
- writer->obufs[0][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->outn[0]);
- if (loc > writer->out_end)
- writer->out_end = loc;
+
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ mus_long_t pos;
+ pos = loc - writer->data_start;
+ for (i = 0; i < gen->chans; i++)
+ writer->obufs[i][pos] += (val * gen->outn[i]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else
+ {
+ for (i = 0; i < gen->chans; i++)
+ mus_safe_out_any_to_file(loc, val * gen->outn[i], i, (mus_any *)writer);
+ }
}
-void mus_locsig_safe_mono(mus_any *ptr, mus_long_t loc, mus_float_t val)
+static void mus_locsig_safe_any(mus_any *ptr, mus_long_t loc, mus_float_t val)
{
+ int i;
locs *gen = (locs *)ptr;
rdout *writer = (rdout *)(gen->outn_writer);
- writer->obufs[0][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->outn[0]);
+
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ mus_long_t pos;
+ pos = loc - writer->data_start;
+ for (i = 0; i < gen->chans; i++)
+ writer->obufs[i][pos] += (val * gen->outn[i]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else
+ {
+ for (i = 0; i < gen->chans; i++)
+ mus_safe_out_any_to_file(loc, val * gen->outn[i], i, (mus_any *)writer);
+ }
+
writer = (rdout *)(gen->revn_writer);
- writer->obufs[0][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->revn[0]);
- if (loc > writer->out_end)
- writer->out_end = loc;
+ if ((loc <= writer->data_end) &&
+ (loc >= writer->data_start))
+ {
+ mus_long_t pos;
+ pos = loc - writer->data_start;
+ for (i = 0; i < gen->rev_chans; i++)
+ writer->obufs[i][pos] += (val * gen->revn[i]);
+ if (loc > writer->out_end)
+ writer->out_end = loc;
+ }
+ else
+ {
+ for (i = 0; i < gen->rev_chans; i++)
+ mus_safe_out_any_to_file(loc, val * gen->revn[i], i, (mus_any *)writer);
+ }
+}
+
+
+mus_any *mus_make_locsig(mus_float_t degree, mus_float_t distance, mus_float_t reverb,
+ int chans, mus_any *output, /* direct signal output */
+ int rev_chans, mus_any *revput, /* reverb output */
+ mus_interp_t type)
+{
+ locs *gen;
+ mus_float_t dist;
+ if (chans <= 0)
+ {
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_locsig ": chans: %d", chans);
+ return(NULL);
+ }
+ if (isnan(degree))
+ {
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_locsig ": degree: %f", degree);
+ return(NULL);
+ }
+
+ gen = (locs *)calloc(1, sizeof(locs));
+ gen->core = &LOCSIG_CLASS;
+ gen->outf = (mus_float_t *)calloc(chans, sizeof(mus_float_t));
+
+ gen->type = type;
+ gen->reverb = reverb;
+ gen->safe_output = false;
+ if (distance > 1.0)
+ dist = 1.0 / distance;
+ else dist = 1.0;
+
+ if (mus_is_output(output))
+ gen->outn_writer = output;
+ gen->chans = chans;
+ gen->outn = (mus_float_t *)calloc(gen->chans, sizeof(mus_float_t));
+ mus_locsig_fill(gen->outn, gen->chans, degree, dist, type);
+
+ if (mus_is_output(revput))
+ gen->revn_writer = revput;
+ gen->rev_chans = rev_chans;
+ if (gen->rev_chans > 0)
+ {
+ gen->revn = (mus_float_t *)calloc(gen->rev_chans, sizeof(mus_float_t));
+ gen->revf = (mus_float_t *)calloc(gen->rev_chans, sizeof(mus_float_t));
+ mus_locsig_fill(gen->revn, gen->rev_chans, degree, (reverb * sqrt(dist)), type);
+ }
+
+ /* now choose the output function based on chans, and reverb
+ */
+ if ((output == NULL) && (revput == NULL))
+ gen->locsig_func = mus_locsig_detour;
+ else
+ {
+ gen->locsig_func = mus_locsig_any;
+
+ if ((mus_is_output(output)) &&
+ (mus_out_any_is_safe(output)) &&
+ (mus_channels(output) == chans))
+ {
+ if (rev_chans > 0)
+ {
+ if ((rev_chans == 1) &&
+ (mus_is_output(revput)) &&
+ (mus_out_any_is_safe(revput)) &&
+ (mus_channels(revput) == 1))
+ {
+ gen->safe_output = true;
+ switch (chans)
+ {
+ case 1: gen->locsig_func = mus_locsig_safe_mono; break;
+ case 2: gen->locsig_func = mus_locsig_safe_stereo; break;
+ default: gen->locsig_func = mus_locsig_safe_any; break;
+ }
+ }
+ }
+ else
+ {
+ gen->safe_output = true;
+ switch (chans)
+ {
+ case 1: gen->locsig_func = mus_locsig_safe_mono_no_reverb; break;
+ case 2: gen->locsig_func = mus_locsig_safe_stereo_no_reverb; break;
+ default: gen->locsig_func = mus_locsig_safe_any_no_reverb; break;
+ }
+ }
+ }
+ else
+ {
+ if (rev_chans > 0)
+ {
+ if (rev_chans == 1)
+ {
+ switch (chans)
+ {
+ case 1: gen->locsig_func = mus_locsig_mono; break;
+ case 2: gen->locsig_func = mus_locsig_stereo; break;
+ default: gen->locsig_func = mus_locsig_any; break;
+ }
+ }
+ }
+ else
+ {
+ switch (chans)
+ {
+ case 1: gen->locsig_func = mus_locsig_mono_no_reverb; break;
+ case 2: gen->locsig_func = mus_locsig_stereo_no_reverb; break;
+ default: gen->locsig_func = mus_locsig_any_no_reverb; break;
+ }
+ }
+ }
+ }
+ return((mus_any *)gen);
}
+void mus_locsig(mus_any *ptr, mus_long_t loc, mus_float_t val)
+{
+ locs *gen = (locs *)ptr;
+ (*(gen->locsig_func))(ptr, loc, val);
+}
-void mus_locsig_safe_stereo_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val)
+int mus_locsig_channels(mus_any *ptr)
{
- locs *gen = (locs *)ptr;
- rdout *writer = (rdout *)(gen->outn_writer);
- writer->obufs[0][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->outn[0]);
- writer->obufs[1][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->outn[1]);
- if (loc > writer->out_end)
- writer->out_end = loc;
+ return(((locs *)ptr)->chans);
}
-void mus_locsig_safe_stereo(mus_any *ptr, mus_long_t loc, mus_float_t val)
+int mus_locsig_reverb_channels(mus_any *ptr)
{
- locs *gen = (locs *)ptr;
- rdout *writer = (rdout *)(gen->outn_writer);
- writer->obufs[0][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->outn[0]);
- writer->obufs[1][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->outn[1]);
- writer = (rdout *)(gen->revn_writer);
- writer->obufs[0][loc] += MUS_FLOAT_TO_SAMPLE(val * gen->revn[0]);
- if (loc > writer->out_end)
- writer->out_end = loc;
+ return(((locs *)ptr)->rev_chans);
}
@@ -8816,12 +12451,19 @@ void mus_move_locsig(mus_any *ptr, mus_float_t degree, mus_float_t distance)
{
locs *gen = (locs *)ptr;
mus_float_t dist;
- mus_reset(ptr); /* clear old state, if any */
+
if (distance > 1.0)
dist = 1.0 / distance;
else dist = 1.0;
+
if (gen->rev_chans > 0)
- mus_locsig_fill(gen->revn, gen->rev_chans, degree, (gen->reverb * sqrt(dist)), gen->type);
+ {
+ if (gen->rev_chans > 2)
+ memset((void *)(gen->revn), 0, gen->rev_chans * sizeof(mus_float_t));
+ mus_locsig_fill(gen->revn, gen->rev_chans, degree, (gen->reverb * sqrt(dist)), gen->type);
+ }
+ if (gen->chans > 2)
+ memset((void *)(gen->outn), 0, gen->chans * sizeof(mus_float_t));
mus_locsig_fill(gen->outn, gen->chans, degree, dist, gen->type);
}
@@ -8829,14 +12471,11 @@ void mus_move_locsig(mus_any *ptr, mus_float_t degree, mus_float_t distance)
/* ---------------- move-sound ---------------- */
-/* TODO: move-sound rb: update dlocsig.rb (787, l788)
- */
-
typedef struct {
mus_any_class *core;
mus_any *outn_writer;
mus_any *revn_writer;
- mus_frame *outf, *revf;
+ mus_float_t *outf, *revf;
int out_channels, rev_channels;
mus_long_t start, end;
mus_any *doppler_delay, *doppler_env, *rev_env;
@@ -8844,20 +12483,28 @@ typedef struct {
int *out_map;
bool free_arrays, free_gens;
void *closure;
+ void (*detour)(mus_any *ptr, mus_long_t loc);
} dloc;
static bool move_sound_equalp(mus_any *p1, mus_any *p2) {return(p1 == p2);}
-static int move_sound_channels(mus_any *ptr) {return(((dloc *)ptr)->out_channels);}
+int mus_move_sound_channels(mus_any *ptr) {return(((dloc *)ptr)->out_channels);}
+int mus_move_sound_reverb_channels(mus_any *ptr) {return(((dloc *)ptr)->rev_channels);}
static mus_long_t move_sound_length(mus_any *ptr) {return(((dloc *)ptr)->out_channels);} /* need both because return types differ */
static void move_sound_reset(mus_any *ptr) {}
-mus_any *mus_move_sound_outf(mus_any *ptr) {return((mus_any *)(((dloc *)ptr)->outf));}
-mus_any *mus_move_sound_revf(mus_any *ptr) {return((mus_any *)(((dloc *)ptr)->revf));}
+mus_float_t *mus_move_sound_outf(mus_any *ptr) {return(((dloc *)ptr)->outf);}
+mus_float_t *mus_move_sound_revf(mus_any *ptr) {return(((dloc *)ptr)->revf);}
void *mus_move_sound_closure(mus_any *ptr) {return(((dloc *)ptr)->closure);}
static void *move_sound_set_closure(mus_any *ptr, void *e) {((dloc *)ptr)->closure = e; return(e);}
+void mus_move_sound_set_detour(mus_any *ptr, void (*detour)(mus_any *ptr, mus_long_t val))
+{
+ dloc *gen = (dloc *)ptr;
+ gen->detour = detour;
+}
+
static char *describe_move_sound(mus_any *ptr)
{
@@ -8870,7 +12517,7 @@ static char *describe_move_sound(mus_any *ptr)
char *allstr = NULL;
int len;
- starts = mus_format("%s start: " MUS_LD ", end: " MUS_LD ", out chans %d, rev chans: %d",
+ starts = mus_format("%s start: %lld, end: %lld, out chans %d, rev chans: %d",
mus_name(ptr),
gen->start,
gen->end,
@@ -8886,68 +12533,114 @@ static char *describe_move_sound(mus_any *ptr)
len = 64 + strlen(starts) + strlen(dopdly) + strlen(dopenv) + strlen(revenv) +
strlen(outdlys) + strlen(outenvs) + strlen(revenvs) + strlen(outmap);
- allstr = (char *)clm_calloc(len, sizeof(char), "describe_move_sound");
- mus_snprintf(allstr, len, "%s\n %s\n %s\n %s\n %s\n %s\n %s\n %s\n free: arrays: %s, gens: %s\n",
+ allstr = (char *)malloc(len * sizeof(char));
+ snprintf(allstr, len, "%s\n %s\n %s\n %s\n %s\n %s\n %s\n %s\n free: arrays: %s, gens: %s\n",
starts, dopdly, dopenv, revenv, outdlys, outenvs, revenvs, outmap,
(gen->free_arrays) ? "true" : "false",
(gen->free_gens) ? "true" : "false");
- if (str1) clm_free(str1);
- if (str2) clm_free(str2);
- if (str3) clm_free(str3);
- clm_free(starts);
- clm_free(dopdly);
- clm_free(dopenv);
- clm_free(revenv);
- clm_free(outdlys);
- clm_free(outenvs);
- clm_free(revenvs);
- clm_free(outmap);
+ if (str1) free(str1);
+ if (str2) free(str2);
+ if (str3) free(str3);
+ free(starts);
+ free(dopdly);
+ free(dopenv);
+ free(revenv);
+ free(outdlys);
+ free(outenvs);
+ free(revenvs);
+ free(outmap);
return(allstr);
}
-static int free_move_sound(mus_any *p)
+static void free_move_sound(mus_any *p)
{
dloc *ptr = (dloc *)p;
- if (ptr)
+ if (ptr->free_gens)
{
- if (ptr->free_gens)
- {
- int i;
- /* free everything except outer arrays and IO stuff */
- if (ptr->doppler_delay) mus_free(ptr->doppler_delay);
- if (ptr->doppler_env) mus_free(ptr->doppler_env);
- if (ptr->rev_env) mus_free(ptr->rev_env);
- if (ptr->out_delays)
- for (i = 0; i < ptr->out_channels; i++)
- if (ptr->out_delays[i]) mus_free(ptr->out_delays[i]);
- if (ptr->out_envs)
- for (i = 0; i < ptr->out_channels; i++)
- if (ptr->out_envs[i]) mus_free(ptr->out_envs[i]);
- if (ptr->rev_envs)
- for (i = 0; i < ptr->rev_channels; i++)
- if (ptr->rev_envs[i]) mus_free(ptr->rev_envs[i]);
- }
-
- if (ptr->free_arrays)
- {
- /* free outer arrays */
- if (ptr->out_envs) {clm_free(ptr->out_envs); ptr->out_envs = NULL;}
- if (ptr->rev_envs) {clm_free(ptr->rev_envs); ptr->rev_envs = NULL;}
- if (ptr->out_delays) {clm_free(ptr->out_delays); ptr->out_delays = NULL;}
- if (ptr->out_map) clm_free(ptr->out_map);
- }
-
- /* we created these in make_move_sound, so it should always be safe to free them */
- if (ptr->outf) mus_free((mus_any *)(ptr->outf));
- if (ptr->revf) mus_free((mus_any *)(ptr->revf));
- clm_free(ptr);
+ int i;
+ /* free everything except outer arrays and IO stuff */
+ if (ptr->doppler_delay) mus_free(ptr->doppler_delay);
+ if (ptr->doppler_env) mus_free(ptr->doppler_env);
+ if (ptr->rev_env) mus_free(ptr->rev_env);
+ if (ptr->out_delays)
+ for (i = 0; i < ptr->out_channels; i++)
+ if (ptr->out_delays[i]) mus_free(ptr->out_delays[i]);
+ if (ptr->out_envs)
+ for (i = 0; i < ptr->out_channels; i++)
+ if (ptr->out_envs[i]) mus_free(ptr->out_envs[i]);
+ if (ptr->rev_envs)
+ for (i = 0; i < ptr->rev_channels; i++)
+ if (ptr->rev_envs[i]) mus_free(ptr->rev_envs[i]);
}
- return(0);
+
+ if (ptr->free_arrays)
+ {
+ /* free outer arrays */
+ if (ptr->out_envs) {free(ptr->out_envs); ptr->out_envs = NULL;}
+ if (ptr->rev_envs) {free(ptr->rev_envs); ptr->rev_envs = NULL;}
+ if (ptr->out_delays) {free(ptr->out_delays); ptr->out_delays = NULL;}
+ if (ptr->out_map) free(ptr->out_map);
+ }
+
+ /* we created these in make_move_sound, so it should always be safe to free them */
+ if (ptr->outf) free(ptr->outf);
+ if (ptr->revf) free(ptr->revf);
+ free(ptr);
}
+static mus_any *dloc_copy(mus_any *ptr)
+{
+ dloc *g, *p;
+ int i, bytes;
+ p = (dloc *)ptr;
+ g = (dloc *)malloc(sizeof(dloc));
+ memcpy((void *)g, (void *)ptr, sizeof(dloc));
+
+ if (p->outf)
+ {
+ bytes = p->out_channels * sizeof(mus_float_t);
+ g->outf = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->outf), (void *)(p->outf), bytes);
+ }
+ if (p->revf)
+ {
+ bytes = p->rev_channels * sizeof(mus_float_t);
+ g->revf = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->revf), (void *)(p->revf), bytes);
+ }
+
+ g->free_arrays = true;
+ g->free_gens = true;
+ if (p->doppler_delay) g->doppler_delay = mus_copy(p->doppler_delay);
+ if (p->doppler_env) g->doppler_env = mus_copy(p->doppler_env);
+ if (p->rev_env) g->rev_env = mus_copy(p->rev_env);
+ if (p->out_envs)
+ {
+ g->out_envs = (mus_any **)malloc(p->out_channels * sizeof(mus_any *));
+ for (i = 0; i < p->out_channels; i++) g->out_envs[i] = mus_copy(p->out_envs[i]);
+ }
+ if (p->rev_envs)
+ {
+ g->rev_envs = (mus_any **)malloc(p->rev_channels * sizeof(mus_any *));
+ for (i = 0; i < p->rev_channels; i++) g->rev_envs[i] = mus_copy(p->rev_envs[i]);
+ }
+ if (p->out_delays)
+ {
+ g->out_delays = (mus_any **)malloc(p->out_channels * sizeof(mus_any *));
+ for (i = 0; i < p->out_channels; i++) g->out_delays[i] = mus_copy(p->out_delays[i]);
+ }
+ if (p->out_map)
+ {
+ bytes = p->out_channels * sizeof(int);
+ g->out_map = (int *)malloc(bytes);
+ memcpy((void *)(g->out_map), (void *)(p->out_map), bytes);
+ }
+
+ return((mus_any *)g);
+}
-bool mus_move_sound_p(mus_any *ptr)
+bool mus_is_move_sound(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_MOVE_SOUND));
@@ -8981,31 +12674,36 @@ mus_float_t mus_move_sound(mus_any *ptr, mus_long_t loc, mus_float_t uval)
sample = val * mus_env(gen->out_envs[chan]);
if (gen->out_delays[chan])
sample = mus_delay_unmodulated(gen->out_delays[chan], sample);
- gen->outf->vals[gen->out_map[chan]] = sample;
+ gen->outf[gen->out_map[chan]] = sample;
}
/* reverb */
- if (gen->revn_writer)
+ if ((gen->rev_env) &&
+ (gen->revf))
{
val *= mus_env(gen->rev_env);
if (gen->rev_envs)
{
if (gen->rev_channels == 1)
- gen->revf->vals[0] = val * mus_env(gen->rev_envs[0]);
+ gen->revf[0] = val * mus_env(gen->rev_envs[0]);
else
{
for (chan = 0; chan < gen->rev_channels; chan++)
- gen->revf->vals[gen->out_map[chan]] = val * mus_env(gen->rev_envs[chan]);
+ gen->revf[gen->out_map[chan]] = val * mus_env(gen->rev_envs[chan]);
}
}
- else gen->revf->vals[0] = val;
- mus_frame_to_file(gen->revn_writer, loc, (mus_any *)(gen->revf));
+ else gen->revf[0] = val;
+
+ if (gen->revn_writer)
+ mus_frample_to_file(gen->revn_writer, loc, gen->revf);
}
/* file output */
if (gen->outn_writer)
- mus_frame_to_file(gen->outn_writer, loc, (mus_any *)(gen->outf));
+ mus_frample_to_file(gen->outn_writer, loc, gen->outf);
+ if (gen->detour)
+ (*(gen->detour))(ptr, loc);
return(uval);
}
@@ -9032,16 +12730,16 @@ static mus_any_class MOVE_SOUND_CLASS = {
&run_move_sound,
MUS_OUTPUT,
&mus_move_sound_closure,
- &move_sound_channels,
+ &mus_move_sound_channels,
0, 0, 0, 0,
0, 0,
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
0, 0,
- 0, 0, 0,
+ 0, 0,
&move_sound_reset,
&move_sound_set_closure,
- 0, 0
+ &dloc_copy
};
@@ -9057,10 +12755,10 @@ mus_any *mus_make_move_sound(mus_long_t start, mus_long_t end, int out_channels,
dloc *gen;
if (out_channels <= 0)
{
- mus_error(MUS_ARG_OUT_OF_RANGE, "move-sound: out chans: %d", out_channels);
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_move_sound ": out chans: %d", out_channels);
return(NULL);
}
- gen = (dloc *)clm_calloc(1, sizeof(dloc), S_make_move_sound);
+ gen = (dloc *)calloc(1, sizeof(dloc));
gen->core = &MOVE_SOUND_CLASS;
gen->start = start;
@@ -9079,15 +12777,15 @@ mus_any *mus_make_move_sound(mus_long_t start, mus_long_t end, int out_channels,
gen->free_gens = free_gens;
gen->free_arrays = free_arrays;
- gen->outf = (mus_frame *)mus_make_empty_frame(out_channels);
- if (mus_output_p(output))
+ gen->outf = (mus_float_t *)calloc(out_channels, sizeof(mus_float_t));
+ if (mus_is_output(output))
gen->outn_writer = output;
if (rev_channels > 0)
{
- if (mus_output_p(revput))
+ if (mus_is_output(revput))
gen->revn_writer = revput;
- gen->revf = (mus_frame *)mus_make_empty_frame(rev_channels);
+ gen->revf = (mus_float_t *)calloc(rev_channels, sizeof(mus_float_t));
}
return((mus_any *)gen);
@@ -9120,29 +12818,25 @@ mus_any *mus_make_move_sound(mus_long_t start, mus_long_t end, int out_channels,
typedef struct {
mus_any_class *core;
mus_float_t (*feeder)(void *arg, int direction);
+ mus_float_t (*block_feeder)(void *arg, int direction, mus_float_t *block, mus_long_t start, mus_long_t end);
mus_float_t x;
mus_float_t incr, width_1;
- int width, lim;
+ int width, lim, start, sinc4;
int len;
- mus_float_t *data, *sinc_table;
+ mus_float_t *data, *sinc_table, *coeffs;
void *closure;
} sr;
-/* I wonder if it would be more accurate and not too much slower to use
- * the Chebyshev expansion of sinc here, or even the power series:
- * 1 - x^2/3! + x^4/5! etc (i.e. x divides sin(x))
- */
-
-#define SRC_SINC_DENSITY 1000
+#define SRC_SINC_DENSITY 2000
#define SRC_SINC_WIDTH 10
+#define SRC_SINC_WINDOW_SIZE 8000
static mus_float_t **sinc_tables = NULL;
static int *sinc_widths = NULL;
static int sincs = 0;
-#if HAVE_PTHREADS
- static mus_lock_t sinc_lock = MUS_LOCK_INITIALIZER;
-#endif
+static mus_float_t *sinc = NULL, *sinc_window = NULL;
+static int sinc_size = 0;
void mus_clear_sinc_tables(void)
{
@@ -9151,31 +12845,82 @@ void mus_clear_sinc_tables(void)
int i;
for (i = 0; i < sincs; i++)
if (sinc_tables[i])
- clm_free(sinc_tables[i]);
- clm_free(sinc_tables);
+ free(sinc_tables[i]);
+ free(sinc_tables);
sinc_tables = NULL;
- clm_free(sinc_widths);
+
+ free(sinc_window);
+ sinc_window = NULL;
+ free(sinc_widths);
sinc_widths = NULL;
sincs = 0;
}
}
-static mus_float_t *init_sinc_table(int width)
+static int init_sinc_table(int width)
{
int i, size, padded_size, loc;
- mus_float_t sinc_freq, win_freq, sinc_phase, win_phase;
+ mus_float_t win_freq, win_phase;
+#if HAVE_SINCOS
+ double sn, snp, cs, csp;
+#endif
+
+ if (width > sinc_size)
+ {
+ int old_end;
+ mus_float_t sinc_phase, sinc_freq;
+ if (sinc_size == 0)
+ old_end = 1;
+ else old_end = sinc_size * SRC_SINC_DENSITY + 4;
+ padded_size = width * SRC_SINC_DENSITY + 4;
+ if (sinc_size == 0)
+ {
+ sinc = (mus_float_t *)malloc(padded_size * sizeof(mus_float_t));
+ sinc[0] = 1.0;
+ }
+ else sinc = (mus_float_t *)realloc(sinc, padded_size * sizeof(mus_float_t));
+ sinc_size = width;
+ sinc_freq = M_PI / (mus_float_t)SRC_SINC_DENSITY;
+ sinc_phase = old_end * sinc_freq;
+#if HAVE_SINCOS
+ sincos(sinc_freq, &sn, &cs);
+ if (old_end == 1)
+ {
+ sinc[1] = sin(sinc_phase) / (2.0 * sinc_phase);
+ old_end++;
+ sinc_phase += sinc_freq;
+ }
+ for (i = old_end; i < padded_size;)
+ {
+ sincos(sinc_phase, &snp, &csp);
+ sinc[i] = snp / (2.0 * sinc_phase);
+ i++;
+ sinc_phase += sinc_freq;
+ sinc[i] = (snp * cs + csp * sn) / (2.0 * sinc_phase);
+ i++;
+ sinc_phase += sinc_freq;
+ }
+#else
+ for (i = old_end; i < padded_size; i++, sinc_phase += sinc_freq)
+ sinc[i] = sin(sinc_phase) / (2.0 * sinc_phase);
+#endif
+ }
for (i = 0; i < sincs; i++)
if (sinc_widths[i] == width)
- return(sinc_tables[i]);
-
- MUS_LOCK(&sinc_lock);
+ return(i);
if (sincs == 0)
{
- sinc_tables = (mus_float_t **)clm_calloc(8, sizeof(mus_float_t *), "sinc tables");
- sinc_widths = (int *)clm_calloc_atomic(8, sizeof(int), "sinc tables");
+ mus_float_t ph, incr;
+ incr = M_PI / SRC_SINC_WINDOW_SIZE;
+ sinc_window = (mus_float_t *)calloc(SRC_SINC_WINDOW_SIZE + 16, sizeof(mus_float_t));
+ for (i = 0, ph = 0.0; i < SRC_SINC_WINDOW_SIZE; i++, ph += incr)
+ sinc_window[i] = 1.0 + cos(ph);
+
+ sinc_tables = (mus_float_t **)calloc(8, sizeof(mus_float_t *));
+ sinc_widths = (int *)calloc(8, sizeof(int));
sincs = 8;
loc = 0;
}
@@ -9190,8 +12935,8 @@ static mus_float_t *init_sinc_table(int width)
}
if (loc == -1)
{
- sinc_tables = (mus_float_t **)clm_realloc(sinc_tables, (sincs + 8) * sizeof(mus_float_t *));
- sinc_widths = (int *)clm_realloc(sinc_widths, (sincs + 8) * sizeof(int));
+ sinc_tables = (mus_float_t **)realloc(sinc_tables, (sincs + 8) * sizeof(mus_float_t *));
+ sinc_widths = (int *)realloc(sinc_widths, (sincs + 8) * sizeof(int));
for (i = sincs; i < (sincs + 8); i++)
{
sinc_widths[i] = 0;
@@ -9205,38 +12950,60 @@ static mus_float_t *init_sinc_table(int width)
sinc_widths[loc] = width;
size = width * SRC_SINC_DENSITY;
padded_size = size + 4;
- sinc_freq = M_PI / (mus_float_t)SRC_SINC_DENSITY;
- win_freq = M_PI / (mus_float_t)size;
- sinc_tables[loc] = (mus_float_t *)clm_calloc_atomic(padded_size, sizeof(mus_float_t), "sinc table");
- sinc_tables[loc][0] = 1.0;
- for (i = 1, sinc_phase = sinc_freq, win_phase = win_freq; i < padded_size; i++, sinc_phase += sinc_freq, win_phase += win_freq)
- sinc_tables[loc][i] = sin(sinc_phase) * (0.5 + 0.5 * cos(win_phase)) / sinc_phase;
+ win_freq = (mus_float_t)SRC_SINC_WINDOW_SIZE / (mus_float_t)size;
- MUS_UNLOCK(&sinc_lock);
+ sinc_tables[loc] = (mus_float_t *)malloc(padded_size * 2 * sizeof(mus_float_t));
+ sinc_tables[loc][padded_size] = 1.0;
+
+ for (i = 1, win_phase = win_freq; i < padded_size; i++, win_phase += win_freq)
+ {
+ mus_float_t val;
+ val = sinc[i] * sinc_window[(int)win_phase];
+ sinc_tables[loc][padded_size + i] = val;
+ sinc_tables[loc][padded_size - i] = val;
+ }
- return(sinc_tables[loc]);
+ return(loc);
}
-bool mus_src_p(mus_any *ptr)
+bool mus_is_src(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_SRC));
}
-static int free_src_gen(mus_any *srptr)
+static void free_src_gen(mus_any *srptr)
{
sr *srp = (sr *)srptr;
- if (srp)
+ if (srp->data) free(srp->data);
+ if (srp->coeffs) free(srp->coeffs);
+ free(srp);
+}
+
+static mus_any *sr_copy(mus_any *ptr)
+{
+ sr *g, *p;
+ int bytes;
+
+ p = (sr *)ptr;
+ g = (sr *)malloc(sizeof(sr));
+ memcpy((void *)g, (void *)ptr, sizeof(sr));
+
+ bytes = (2 * g->lim + 1) * sizeof(mus_float_t);
+ g->data = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->data), (void *)(p->data), bytes);
+
+ if (p->coeffs)
{
- if (srp->data) clm_free(srp->data);
- clm_free(srp);
+ bytes = p->lim * sizeof(mus_float_t);
+ g->coeffs = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->coeffs), (void *)(p->coeffs), bytes);
}
- return(0);
+ return((mus_any *)g);
}
-
static bool src_equalp(mus_any *p1, mus_any *p2) {return(p1 == p2);}
@@ -9244,8 +13011,8 @@ static char *describe_src(mus_any *ptr)
{
sr *gen = (sr *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s width: %d, x: %.3f, incr: %.3f, sinc table len: %d",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s width: %d, x: %.3f, incr: %.3f, sinc table len: %d",
mus_name(ptr),
gen->width, gen->x, gen->incr, gen->len);
return(describe_buffer);
@@ -9266,7 +13033,7 @@ static mus_float_t *src_sinc_table(mus_any *rd) {return(((sr *)rd)->sinc_table);
static void src_reset(mus_any *ptr)
{
sr *gen = (sr *)ptr;
- mus_clear_array(gen->data, gen->lim + 1);
+ memset((void *)(gen->data), 0, (gen->lim + 1) * sizeof(mus_float_t));
gen->x = 0.0;
/* center the data if possible */
if (gen->feeder)
@@ -9274,7 +13041,23 @@ static void src_reset(mus_any *ptr)
int i, dir = 1;
if (gen->incr < 0.0) dir = -1;
for (i = gen->width - 1; i < gen->lim; i++)
- gen->data[i] = (*(gen->feeder))(gen->closure, dir);
+ gen->data[i] = gen->feeder(gen->closure, dir);
+ }
+ gen->start = 0;
+}
+
+void mus_src_init(mus_any *ptr)
+{
+ sr *srp = (sr *)ptr;
+ if (srp->feeder)
+ {
+ int i, dir = 1;
+ if (srp->incr < 0.0) dir = -1;
+ for (i = srp->width - 1; i < srp->lim; i++)
+ {
+ srp->data[i] = srp->feeder(srp->closure, dir);
+ srp->data[i + srp->lim] = srp->data[i];
+ }
}
}
@@ -9297,65 +13080,93 @@ static mus_any_class SRC_CLASS = {
0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&src_reset,
&src_set_closure,
- 0, 0
+ &sr_copy
};
-mus_any *mus_make_src(mus_float_t (*input)(void *arg, int direction), mus_float_t srate, int width, void *closure)
+mus_any *mus_make_src_with_init(mus_float_t (*input)(void *arg, int direction), mus_float_t srate, int width, void *closure, void (*init)(void *p, mus_any *g))
{
+ /* besides 1, 2, .5, other common cases: 1.5, 3
+ */
+
if (fabs(srate) > MUS_MAX_CLM_SRC)
- mus_error(MUS_ARG_OUT_OF_RANGE, S_make_src " srate arg invalid: %f", srate);
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_src ": srate arg invalid: %f", srate);
else
{
if ((width < 0) || (width > MUS_MAX_CLM_SINC_WIDTH))
- mus_error(MUS_ARG_OUT_OF_RANGE, S_make_src " width arg invalid: %d", width);
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_src ": width arg invalid: %d", width);
else
{
sr *srp;
- int wid;
- srp = (sr *)clm_calloc(1, sizeof(sr), S_make_src);
+ int wid, loc;
+
if (width <= 0) width = SRC_SINC_WIDTH;
if (width < (int)(fabs(srate) * 2))
wid = (int)(ceil(fabs(srate)) * 2);
else wid = width;
+ if ((srate == 2.0) &&
+ ((wid & 1) != 0))
+ wid++;
+
+ srp = (sr *)calloc(1, sizeof(sr));
srp->core = &SRC_CLASS;
srp->x = 0.0;
srp->feeder = input;
+ srp->block_feeder = NULL;
srp->closure = closure;
srp->incr = srate;
srp->width = wid;
srp->lim = 2 * wid;
+ srp->start = 0;
srp->len = wid * SRC_SINC_DENSITY;
- srp->data = (mus_float_t *)clm_calloc_atomic(srp->lim + 1, sizeof(mus_float_t), "src table");
- srp->sinc_table = init_sinc_table(wid);
- if (input)
+ srp->width_1 = 1.0 - wid;
+ srp->sinc4 = srp->width * SRC_SINC_DENSITY + 4;
+ srp->data = (mus_float_t *)calloc(2 * srp->lim + 1, sizeof(mus_float_t));
+ loc = init_sinc_table(wid);
+ srp->sinc_table = sinc_tables[loc];
+ srp->coeffs = NULL;
+
+ if (init)
+ init(closure, (mus_any *)srp);
+
+ if (srp->feeder)
{
int i, dir = 1;
if (srate < 0.0) dir = -1;
for (i = wid - 1; i < srp->lim; i++)
- srp->data[i] = (*input)(closure, dir);
+ {
+ srp->data[i] = srp->feeder(closure, dir);
+ srp->data[i + srp->lim] = srp->data[i];
+ }
/* was i = 0 here but we want the incoming data centered */
}
- srp->width_1 = 1.0 - wid;
return((mus_any *)srp);
}
}
return(NULL);
}
+mus_any *mus_make_src(mus_float_t (*input)(void *arg, int direction), mus_float_t srate, int width, void *closure)
+{
+ return(mus_make_src_with_init(input, srate, width, closure, NULL));
+}
mus_float_t mus_src(mus_any *srptr, mus_float_t sr_change, mus_float_t (*input)(void *arg, int direction))
{
sr *srp = (sr *)srptr;
- mus_float_t sum = 0.0, x, zf, srx, factor;
- int fsx, lim, i, k, loc;
- int xi, xs;
- bool int_ok = false;
+ mus_float_t sum, zf, srx, factor;
+ int lim, loc, xi;
+ bool int_ok;
+ mus_float_t *data, *sinc_table;
lim = srp->lim;
+ loc = srp->start;
+ data = srp->data;
+ sinc_table = srp->sinc_table;
+
if (sr_change > MUS_MAX_CLM_SRC)
sr_change = MUS_MAX_CLM_SRC;
else
@@ -9367,40 +13178,47 @@ mus_float_t mus_src(mus_any *srptr, mus_float_t sr_change, mus_float_t (*input)(
if (srp->x >= 1.0)
{
- mus_float_t (*sr_input)(void *arg, int direction) = input;
- if (sr_input == NULL) sr_input = srp->feeder;
+ int i, fsx, dir = 1;
+
+ if (srx < 0.0) dir = -1;
fsx = (int)(srp->x);
srp->x -= fsx;
- /* realign data, reset srp->x */
- if (fsx > lim)
+
+ if (input) {srp->feeder = input; srp->block_feeder = NULL;}
+
+ data[loc] = srp->feeder(srp->closure, dir);
+ data[loc + lim] = data[loc];
+ loc++;
+ if (loc == lim) loc = 0;
+
+ for (i = 1; i < fsx; i++)
{
- int dir = 1;
- if (srx < 0.0) dir = -1;
- /* if sr_change is so extreme that the new index falls outside the data table, we need to
- * read forward until we reach the new data bounds
+ /* there are two copies of the circular data buffer back-to-back so that we can
+ * run the convolution below without worrying about the buffer end.
*/
- for (i = lim; i < fsx; i++)
- (*sr_input)(srp->closure, dir);
- fsx = lim;
+ data[loc] = srp->feeder(srp->closure, dir);
+ data[loc + lim] = data[loc];
+ loc++;
+ if (loc == lim) loc = 0;
}
- loc = lim - fsx;
- if (loc > 0)
- memmove((void *)(srp->data), (void *)(srp->data + fsx), sizeof(mus_float_t) * loc);
- for (i = loc; i < lim; i++)
- srp->data[i] = (*sr_input)(srp->closure, (srx >= 0.0) ? 1 : -1);
+ srp->start = loc; /* next time around we start here */
}
+ /* now loc = beginning of data */
+
/* if (srx == 0.0) srx = 0.01; */ /* can't decide about this ... */
if (srx < 0.0) srx = -srx;
- /* tedious timing tests indicate that precalculating this block in the sr_change=0 case saves no time at all */
-
if (srx > 1.0)
{
factor = 1.0 / srx;
/* this is not exact since we're sampling the sinc and so on, but it's close over a wide range */
zf = factor * (mus_float_t)SRC_SINC_DENSITY;
- xi = (int)zf;
- int_ok = ((zf - xi) < .001);
+ xi = (int)(zf + 0.5);
+
+ /* (let ((e (make-env '(0 1 1 1.1) :length 11))) (src-channel e))
+ */
+ /* we're comparing adding xi lim times to zf and if there's no difference, using the int case */
+ if (fabs((xi - zf) * lim) > 2.0) int_ok = false; else int_ok = true;
}
else
{
@@ -9410,92 +13228,318 @@ mus_float_t mus_src(mus_any *srptr, mus_float_t sr_change, mus_float_t (*input)(
int_ok = true;
}
+ sum = 0.0;
if (int_ok)
{
+ int sinc_loc, sinc_incr, last, last10, xs;
+
xs = (int)(zf * (srp->width_1 - srp->x));
- i = 0;
- if (xs < 0)
- for (; (i < lim) && (xs < 0); i++, xs += xi)
- sum += (srp->data[i] * srp->sinc_table[-xs]); /* fma? */
- for (; i < lim; i++, xs += xi)
- sum += (srp->data[i] * srp->sinc_table[xs]);
+ sinc_loc = xs + srp->sinc4;
+ sinc_incr = xi;
+ last = loc + lim;
+ last10 = last - 10;
+
+ while (loc <= last10)
+ {
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ }
+ for (; loc < last; loc++, sinc_loc += sinc_incr)
+ sum += data[loc] * sinc_table[sinc_loc];
}
else
{
- /* this form twice as slow because of float->int conversions */
- for (i = 0, x = zf * (srp->width_1 - srp->x); i < lim; i++, x += zf)
+ mus_float_t sinc_loc, sinc_incr, x;
+ int last, last10;
+
+ x = zf * (srp->width_1 - srp->x);
+ sinc_loc = x + srp->sinc4;
+ sinc_incr = zf;
+ last = loc + lim;
+
+ last10 = last - 10;
+
+ while (loc <= last10)
{
- /* we're moving backwards in the data array, so the sr->x field has to mimic that (hence the '1.0 - srp->x') */
- if (x < 0) k = (int)(-x); else k = (int)x;
- sum += (srp->data[i] * srp->sinc_table[k]);
- /* rather than do a bounds check here, we just padded the sinc_table above with 2 extra 0's */
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
}
+ for (; loc < last; loc++, sinc_loc += sinc_incr)
+ sum += data[loc] * sinc_table[(int)sinc_loc];
}
+
srp->x += srx;
return(sum * factor);
}
-/* it was a cold, rainy day... */
-mus_float_t mus_src_20(mus_any *srptr, mus_float_t (*input)(void *arg, int direction))
+void mus_src_to_buffer(mus_any *srptr, mus_float_t (*input)(void *arg, int direction), mus_float_t *out_data, mus_long_t dur)
{
+ /* sr_change = 0.0
+ */
sr *srp = (sr *)srptr;
- mus_float_t sum;
- int lim, i, loc;
- int xi, xs;
+ mus_float_t sum, x, zf, srx, factor, sincx, srpx;
+ int lim, i, xi, xs, dir = 1;
+ bool int_ok;
+ mus_long_t k;
+ mus_float_t *data, *sinc_table;
+
lim = srp->lim;
- if (srp->x > 0.0)
+ sincx = (mus_float_t)SRC_SINC_DENSITY;
+ data = srp->data;
+ sinc_table = srp->sinc_table;
+ srx = srp->incr;
+ srpx = srp->x;
+ if (srx < 0.0)
+ {
+ dir = -1;
+ srx = -srx;
+ }
+ if (srx > 1.0)
{
- /* realign data, reset srp->x */
- mus_float_t (*sr_input)(void *arg, int direction) = input;
- if (sr_input == NULL) sr_input = srp->feeder;
- loc = lim - 2;
- memmove((void *)(srp->data), (void *)(srp->data + 2), sizeof(mus_float_t) * loc);
- for (i = loc; i < lim; i++)
- srp->data[i] = (*sr_input)(srp->closure, 1);
+ factor = 1.0 / srx;
+ /* this is not exact since we're sampling the sinc and so on, but it's close over a wide range */
+ zf = factor * sincx;
+ xi = (int)zf;
+ if (fabs((xi - zf) * lim) > 2.0) int_ok = false; else int_ok = true;
+ }
+ else
+ {
+ factor = 1.0;
+ zf = sincx;
+ xi = SRC_SINC_DENSITY;
+ int_ok = true;
+ }
+
+ for (k = 0; k < dur; k++)
+ {
+ int loc;
+ loc = srp->start;
+ if (srpx >= 1.0)
+ {
+ int fsx;
+ /* modf here is very slow??! */
+ fsx = (int)srpx;
+ srpx -= fsx;
+
+ data[loc] = input(srp->closure, dir);
+ data[loc + lim] = data[loc];
+ loc++;
+ if (loc == lim) loc = 0;
+
+ for (i = 1; i < fsx; i++)
+ {
+ /* there are two copies of the circular data buffer back-to-back so that we can
+ * run the convolution below without worrying about the buffer end.
+ */
+ data[loc] = input(srp->closure, dir);
+ data[loc + lim] = data[loc];
+ loc++;
+ if (loc == lim) loc = 0;
+ }
+ srp->start = loc; /* next time around we start here */
+ }
+
+ sum = 0.0;
+ if (int_ok)
+ {
+ int sinc_loc, sinc_incr, last, last10;
+
+ xs = (int)(zf * (srp->width_1 - srpx));
+ sinc_loc = xs + srp->sinc4;
+ sinc_incr = xi;
+ last = loc + lim;
+ last10 = last - 10;
+
+ while (loc <= last10)
+ {
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[sinc_loc]; sinc_loc += sinc_incr;
+ }
+ for (; loc < last; loc++, sinc_loc += sinc_incr)
+ sum += data[loc] * sinc_table[sinc_loc];
+ }
+ else
+ {
+ mus_float_t sinc_loc, sinc_incr;
+ int last, last10;
+
+ x = zf * (srp->width_1 - srpx);
+ sinc_loc = x + srp->sinc4;
+ sinc_incr = zf;
+ last = loc + lim;
+
+ last10 = last - 10;
+
+ while (loc <= last10)
+ {
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ sum += data[loc++] * sinc_table[(int)sinc_loc]; sinc_loc += sinc_incr;
+ }
+ for (; loc < last; loc++, sinc_loc += sinc_incr)
+ sum += data[loc] * sinc_table[(int)sinc_loc];
+ }
+ srpx += srx;
+ out_data[k] = sum * factor;
+ }
+ srp->x = srpx;
+}
+
+
+/* it was a cold, rainy day...
+ * and on an even colder day, I changed this to use a circular data buffer, rather than memmove
+ * then changed yet again to use straight buffers
+ */
+
+mus_float_t *mus_src_20(mus_any *srptr, mus_float_t *in_data, mus_long_t dur)
+{
+ sr *srp = (sr *)srptr;
+ mus_float_t sum;
+ int lim, i, width, wid1, wid10, xs, xi;
+ mus_long_t k, dur2;
+ mus_float_t *out_data, *ldata, *coeffs;
+
+ dur2 = dur / 2 + 1;
+ if ((dur & 1) != 0) dur2++;
+ out_data = (mus_float_t *)malloc(dur2 * sizeof(mus_float_t));
+
+ lim = srp->lim; /* 2 * width so it's even */
+ width = srp->width;
+
+ coeffs = (mus_float_t *)malloc(lim * sizeof(mus_float_t));
+ if ((width & 1) != 0)
+ xs = (int)((2 + width) * (SRC_SINC_DENSITY / 2)) + 4; /* Humph -- looks like crap -- maybe if odd width use the real one above, or insist on even width */
+ else xs = (int)((1 + width) * (SRC_SINC_DENSITY / 2)) + 4;
+ xi = SRC_SINC_DENSITY; /* skip a location (coeff=0.0) */
+
+ for (i = 0; i < width; i++, xs += xi)
+ coeffs[i] = srp->sinc_table[xs];
+
+ for (i = 0; i < lim; i++)
+ in_data[i] = srp->data[i];
+
+ ldata = (mus_float_t *)in_data;
+ wid10 = width - 10;
+ wid1 = width - 1;
+
+ for (k = 0; k < dur2; k++, ldata += 2)
+ {
+ int j;
+ sum = ldata[wid1];
+ i = 0;
+ j = 0;
+ while (i <= wid10)
+ {
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ sum += (ldata[j] * coeffs[i++]); j += 2;
+ }
+ for (; i < width; i++, j += 2)
+ sum += (ldata[j] * coeffs[i]);
+ out_data[k] = sum * 0.5;
}
- else srp->x = 2.0;
- xi = (int)(SRC_SINC_DENSITY / 2);
- xs = xi * (1 - srp->width);
- xi *= 2;
- sum = srp->data[srp->width - 1];
- for (i = 0; (i < lim) && (xs < 0); i += 2, xs += xi)
- sum += (srp->data[i] * srp->sinc_table[-xs]);
- for (; i < lim; i += 2, xs += xi)
- sum += (srp->data[i] * srp->sinc_table[xs]);
- return(sum * 0.5);
+
+ free(coeffs);
+ return(out_data);
}
-mus_float_t mus_src_05(mus_any *srptr, mus_float_t (*input)(void *arg, int direction))
+mus_float_t *mus_src_05(mus_any *srptr, mus_float_t *in_data, mus_long_t dur)
{
sr *srp = (sr *)srptr;
mus_float_t sum;
- int lim, i, loc;
- int xs;
+ int lim, i, width, wid1, wid10, xs, xi;
+ mus_long_t k, dur2;
+ mus_float_t *out_data, *ldata, *coeffs;
+
+ dur2 = dur * 2;
+ out_data = (mus_float_t *)malloc((dur2 + 1) * sizeof(mus_float_t));
+ out_data[dur2] = 0.0;
+
lim = srp->lim;
- if (srp->x >= 1.0)
+ width = srp->width;
+
+ coeffs = (mus_float_t *)malloc(lim * sizeof(mus_float_t));
+ xs = (SRC_SINC_DENSITY / 2) + 4;
+ xi = SRC_SINC_DENSITY;
+
+ for (i = 0; i < lim; i++, xs += xi)
+ coeffs[i] = srp->sinc_table[xs];
+
+ for (i = 0; i < lim; i++)
+ in_data[i] = srp->data[i];
+
+ ldata = (mus_float_t *)in_data;
+ wid10 = lim - 10;
+ wid1 = width - 1;
+
+ for (k = 0; k < dur2; k += 2)
{
- mus_float_t (*sr_input)(void *arg, int direction) = input;
- if (sr_input == NULL) sr_input = srp->feeder;
- loc = lim - 1;
- memmove((void *)(srp->data), (void *)(srp->data + 1), sizeof(mus_float_t) * loc);
- for (i = loc; i < lim; i++)
- srp->data[i] = (*sr_input)(srp->closure, 1);
- srp->x = 0.0;
- }
- if (srp->x == 0.0)
- {
- srp->x = 0.5;
- return(srp->data[srp->width - 1]);
- }
- xs = (int)(SRC_SINC_DENSITY * (srp->width_1 - 0.5));
- for (i = 0, sum = 0.0; (i < lim) && (xs < 0); i++, xs += SRC_SINC_DENSITY)
- sum += (srp->data[i] * srp->sinc_table[-xs]);
- for (; i < lim; i++, xs += SRC_SINC_DENSITY)
- sum += (srp->data[i] * srp->sinc_table[xs]);
- srp->x += 0.5;
- return(sum);
+ out_data[k] = ldata[wid1];
+
+ sum = 0.0;
+ i = 0;
+ while (i <= wid10)
+ {
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ sum += (ldata[i] * coeffs[i]); i++;
+ }
+ for (; i < lim; i++)
+ sum += (ldata[i] * coeffs[i]);
+ out_data[k + 1] = sum;
+
+ ldata++;
+ }
+
+ free(coeffs);
+ return(out_data);
}
@@ -9506,6 +13550,7 @@ mus_float_t mus_src_05(mus_any *srptr, mus_float_t (*input)(void *arg, int direc
typedef struct {
mus_any_class *core;
mus_float_t (*rd)(void *arg, int direction);
+ mus_float_t (*block_rd)(void *arg, int direction, mus_float_t *block, mus_long_t start, mus_long_t end);
int s20;
int s50;
int rmp;
@@ -9527,7 +13572,7 @@ typedef struct {
} grn_info;
-bool mus_granulate_p(mus_any *ptr)
+bool mus_is_granulate(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_GRANULATE));
@@ -9541,8 +13586,8 @@ static char *describe_granulate(mus_any *ptr)
{
grn_info *gen = (grn_info *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s expansion: %.3f (%d/%d), scaler: %.3f, length: %.3f secs (%d samps), ramp: %.3f",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s expansion: %.3f (%d/%d), scaler: %.3f, length: %.3f secs (%d samps), ramp: %.3f",
mus_name(ptr),
(mus_float_t)(gen->output_hop) / (mus_float_t)(gen->input_hop),
gen->input_hop, gen->output_hop,
@@ -9553,19 +13598,36 @@ static char *describe_granulate(mus_any *ptr)
}
-static int free_granulate(mus_any *ptr)
+static void free_granulate(mus_any *ptr)
{
grn_info *gen = (grn_info *)ptr;
- if (gen)
- {
- if (gen->out_data) clm_free(gen->out_data);
- if (gen->in_data) clm_free(gen->in_data);
- if (gen->grain) clm_free(gen->grain);
- clm_free(gen);
- }
- return(0);
+ if (gen->out_data) free(gen->out_data);
+ if (gen->in_data) free(gen->in_data);
+ if (gen->grain) free(gen->grain);
+ free(gen);
}
+static mus_any *grn_info_copy(mus_any *ptr)
+{
+ grn_info *g, *p;
+ int bytes;
+
+ p = (grn_info *)ptr;
+ g = (grn_info *)malloc(sizeof(grn_info));
+ memcpy((void *)g, (void *)ptr, sizeof(grn_info));
+
+ bytes = g->out_data_len * sizeof(mus_float_t);
+ g->out_data = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->out_data), (void *)(p->out_data), bytes);
+
+ bytes = g->in_data_len * sizeof(mus_float_t);
+ g->in_data = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->in_data), (void *)(p->in_data), bytes);
+ g->grain = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->grain), (void *)(p->grain), bytes);
+
+ return((mus_any *)g);
+}
static mus_long_t grn_length(mus_any *ptr) {return(((grn_info *)ptr)->grain_len);}
@@ -9627,9 +13689,9 @@ static void grn_reset(mus_any *ptr)
grn_info *gen = (grn_info *)ptr;
gen->cur_out = 0;
gen->ctr = 0;
- mus_clear_array(gen->out_data, gen->out_data_len);
- mus_clear_array(gen->in_data, gen->in_data_len);
- mus_clear_array(gen->grain, gen->in_data_len);
+ memset((void *)(gen->out_data), 0, gen->out_data_len * sizeof(mus_float_t));
+ memset((void *)(gen->in_data), 0, gen->in_data_len * sizeof(mus_float_t));
+ memset((void *)(gen->grain), 0, gen->in_data_len * sizeof(mus_float_t));
gen->first_samp = true;
}
@@ -9667,10 +13729,10 @@ static mus_any_class GRANULATE_CLASS = {
&grn_ramp, &grn_set_ramp,
0, 0, 0, 0,
&grn_location, &grn_set_location, /* local randx */
- 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0,
&grn_reset,
- &grn_set_closure,
- 0, 0
+ &grn_set_closure,
+ &grn_info_copy
};
@@ -9686,20 +13748,20 @@ mus_any *mus_make_granulate(mus_float_t (*input)(void *arg, int direction),
if (max_size > outlen) outlen = max_size;
if (expansion <= 0.0)
{
- mus_error(MUS_ARG_OUT_OF_RANGE, S_make_granulate " expansion must be > 0.0: %f", expansion);
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_granulate ": expansion must be > 0.0: %f", expansion);
return(NULL);
}
if (outlen <= 0)
{
- mus_error(MUS_NO_LENGTH, S_make_granulate " size is %d (hop: %f, segment-length: %f)?", outlen, hop, length);
+ mus_error(MUS_NO_LENGTH, S_make_granulate ": size is %d (hop: %f, segment-length: %f)?", outlen, hop, length);
return(NULL);
}
if ((hop * sampling_rate) < expansion)
{
- mus_error(MUS_ARG_OUT_OF_RANGE, S_make_granulate " expansion (%f) must be < hop * srate (%f)", expansion, hop * sampling_rate);
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_granulate ": expansion (%f) must be < hop * srate (%f)", expansion, hop * sampling_rate);
return(NULL);
}
- spd = (grn_info *)clm_calloc(1, sizeof(grn_info), S_make_granulate);
+ spd = (grn_info *)malloc(sizeof(grn_info));
spd->core = &GRANULATE_CLASS;
spd->cur_out = 0;
spd->ctr = 0;
@@ -9712,13 +13774,14 @@ mus_any *mus_make_granulate(mus_float_t (*input)(void *arg, int direction),
/* added "2 *" 21-Mar-05 and replaced irandom with (grn)mus_irandom below */
spd->s50 = (int)(jitter * sampling_rate * hop * 0.4);
spd->out_data_len = outlen;
- spd->out_data = (mus_float_t *)clm_calloc_atomic(spd->out_data_len, sizeof(mus_float_t), "granulate out data");
+ spd->out_data = (mus_float_t *)calloc(spd->out_data_len, sizeof(mus_float_t));
spd->in_data_len = outlen + spd->s20 + 1;
- spd->in_data = (mus_float_t *)clm_calloc_atomic(spd->in_data_len, sizeof(mus_float_t), "granulate in data");
- spd->rd = input;
+ spd->in_data = (mus_float_t *)malloc(spd->in_data_len * sizeof(mus_float_t));
+ spd->rd = input;
+ spd->block_rd = NULL;
spd->closure = closure;
spd->edit = edit;
- spd->grain = (mus_float_t *)clm_calloc_atomic(spd->in_data_len, sizeof(mus_float_t), "granulate grain");
+ spd->grain = (mus_float_t *)malloc(spd->in_data_len * sizeof(mus_float_t));
spd->first_samp = true;
spd->randx = mus_rand_seed(); /* caller can override this via the mus_location method */
next_random();
@@ -9730,7 +13793,7 @@ void mus_granulate_set_edit_function(mus_any *ptr, int (*edit)(void *closure))
{
grn_info *gen = (grn_info *)ptr;
if (!(gen->grain))
- gen->grain = (mus_float_t *)clm_calloc_atomic(gen->in_data_len, sizeof(mus_float_t), "granulate grain");
+ gen->grain = (mus_float_t *)calloc(gen->in_data_len, sizeof(mus_float_t));
gen->edit = edit;
}
@@ -9752,21 +13815,23 @@ mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *a
if (spd->ctr >= spd->cur_out) /* time for next grain */
{
- int i;
-
/* set up edit/input functions and possible outside-accessible grain array */
- mus_float_t (*spd_input)(void *arg, int direction) = input;
+ int i;
int (*spd_edit)(void *closure) = edit;
- if (spd_input == NULL) spd_input = spd->rd;
+ if (input) {spd->rd = input; spd->block_rd = NULL;}
if (spd_edit == NULL) spd_edit = spd->edit;
if (spd->first_samp)
{
/* fill up in_data, out_data is already cleared */
- for (i = 0; i < spd->in_data_len; i++)
- spd->in_data[i] = (*spd_input)(spd->closure, 1);
+ if (spd->block_rd)
+ spd->block_rd(spd->closure, 1, spd->in_data, 0, spd->in_data_len);
+ else
+ {
+ for (i = 0; i < spd->in_data_len; i++)
+ spd->in_data[i] = spd->rd(spd->closure, 1);
+ }
}
-
else
{
@@ -9774,7 +13839,7 @@ mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *a
if (spd->cur_out >= spd->out_data_len)
{
/* entire buffer has been output, and in fact we've been sending 0's for awhile to fill out hop */
- mus_clear_array(spd->out_data, spd->out_data_len); /* so zero the entire thing (it's all old) */
+ memset((void *)(spd->out_data), 0, spd->out_data_len * sizeof(mus_float_t)); /* so zero the entire thing (it's all old) */
}
else
{
@@ -9789,10 +13854,15 @@ mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *a
if (spd->input_hop > spd->in_data_len)
{
/* need to flush enough samples to accommodate the fact that the hop is bigger than our data buffer */
- for (i = spd->in_data_len; i < spd->input_hop; i++) (*spd_input)(spd->closure, 1);
+ for (i = spd->in_data_len; i < spd->input_hop; i++) spd->rd(spd->closure, 1);
/* then get a full input buffer */
- for (i = 0; i < spd->in_data_len; i++)
- spd->in_data[i] = (*spd_input)(spd->closure, 1);
+ if (spd->block_rd)
+ spd->block_rd(spd->closure, 1, spd->in_data, 0, spd->in_data_len);
+ else
+ {
+ for (i = 0; i < spd->in_data_len; i++)
+ spd->in_data[i] = spd->rd(spd->closure, 1);
+ }
}
else
{
@@ -9800,34 +13870,51 @@ mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *a
int good_samps;
good_samps = (spd->in_data_len - spd->input_hop);
memmove((void *)(spd->in_data), (void *)(spd->in_data + spd->input_hop), good_samps * sizeof(mus_float_t));
- for (i = good_samps; i < spd->in_data_len; i++)
- spd->in_data[i] = (*spd_input)(spd->closure, 1);
+ if (spd->block_rd)
+ spd->block_rd(spd->closure, 1, spd->in_data, good_samps, spd->in_data_len);
+ else
+ {
+ for (i = good_samps; i < spd->in_data_len; i++)
+ spd->in_data[i] = spd->rd(spd->closure, 1);
+ }
}
}
/* create current grain */
{
- int lim, steady_end, curstart, j;
+ int lim, curstart, j;
+
lim = spd->grain_len;
curstart = grn_irandom(spd, spd->s20); /* start location in input buffer */
if ((curstart + spd->grain_len) > spd->in_data_len)
lim = (spd->in_data_len - curstart);
if (lim > spd->grain_len)
lim = spd->grain_len;
- mus_clear_array(spd->grain, spd->grain_len);
+ else
+ {
+ if (lim < spd->grain_len)
+ memset((void *)(spd->grain), 0, (spd->grain_len - lim) * sizeof(mus_float_t));
+ }
if (spd->rmp > 0)
{
+ int steady_end, up_end;
mus_float_t amp = 0.0, incr;
steady_end = (spd->grain_len - spd->rmp);
incr = (mus_float_t)(spd->amp) / (mus_float_t)(spd->rmp);
- for (i = 0, j = curstart; i < lim; i++, j++)
+ up_end = spd->rmp;
+ if (up_end > lim) up_end = lim;
+ for (i = 0, j = curstart; i < up_end; i++, j++)
+ {
+ spd->grain[i] = (amp * spd->in_data[j]);
+ amp += incr;
+ }
+ if (steady_end > lim) steady_end = lim;
+ for (; i < steady_end; i++, j++)
+ spd->grain[i] = (amp * spd->in_data[j]);
+ for (; i < lim; i++, j++)
{
spd->grain[i] = (amp * spd->in_data[j]);
- if (i < spd->rmp)
- amp += incr;
- else
- if (i >= steady_end) /* was >, but that truncates the envelope */
- amp -= incr;
+ amp -= incr;
}
}
else
@@ -9897,21 +13984,15 @@ mus_float_t mus_granulate(mus_any *ptr, mus_float_t (*input)(void *arg, int dire
static void mus_big_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is);
-#if HAVE_FFTW3 && HAVE_COMPLEX_TRIG && (!__cplusplus)
+#if HAVE_FFTW3 && HAVE_COMPLEX_TRIG
static fftw_complex *c_in_data = NULL, *c_out_data = NULL;
static fftw_plan c_r_plan, c_i_plan;
static int last_c_fft_size = 0;
-#if HAVE_PTHREADS
- static mus_lock_t c_fft_lock = MUS_LOCK_INITIALIZER;
-#endif
-
static void mus_fftw_with_imag(mus_float_t *rl, mus_float_t *im, int n, int dir)
{
- int i;
-
- MUS_LOCK(&c_fft_lock);
+ int i, n4;
if (n != last_c_fft_size)
{
@@ -9922,32 +14003,66 @@ static void mus_fftw_with_imag(mus_float_t *rl, mus_float_t *im, int n, int dir)
fftw_destroy_plan(c_r_plan);
fftw_destroy_plan(c_i_plan);
}
- c_in_data = (fftw_complex *)fftw_malloc(n * sizeof(fftw_complex));
+ c_in_data = (fftw_complex *)fftw_malloc(n * sizeof(fftw_complex)); /* rl/im data is mus_float_t */
c_out_data = (fftw_complex *)fftw_malloc(n * sizeof(fftw_complex));
c_r_plan = fftw_plan_dft_1d(n, c_in_data, c_out_data, FFTW_FORWARD, FFTW_ESTIMATE);
c_i_plan = fftw_plan_dft_1d(n, c_in_data, c_out_data, FFTW_BACKWARD, FFTW_ESTIMATE);
last_c_fft_size = n;
}
- for (i = 0; i < n; i++)
+
+ n4 = n - 4;
+ i = 0;
+ while (i <= n4)
+ {
+ /* adding code to avoid this loop saves essentially nothing, mainly because the great majority of the calls
+ * are actually handling two real arrays at once -- the imag=0 case is 1/10 of the total. In the zero case,
+ * the savings here is about 10%, but that is swamped by the fft itself (say 5-10 in c*).
+ * using the new split array code (see below) saves essentially nothing -- perhaps 1 to 2% overall.
+ */
+ c_in_data[i] = rl[i] + _Complex_I * im[i];
+ i++;
+ c_in_data[i] = rl[i] + _Complex_I * im[i];
+ i++;
+ c_in_data[i] = rl[i] + _Complex_I * im[i];
+ i++;
+ c_in_data[i] = rl[i] + _Complex_I * im[i];
+ i++;
+ }
+ for (; i < n; i++)
c_in_data[i] = rl[i] + _Complex_I * im[i];
if (dir == -1)
fftw_execute(c_r_plan);
else fftw_execute(c_i_plan);
- for (i = 0; i < n; i++)
+ i = 0;
+ while (i <= n4)
+ {
+ rl[i] = creal(c_out_data[i]);
+ im[i] = cimag(c_out_data[i]);
+ i++;
+ rl[i] = creal(c_out_data[i]);
+ im[i] = cimag(c_out_data[i]);
+ i++;
+ rl[i] = creal(c_out_data[i]);
+ im[i] = cimag(c_out_data[i]);
+ i++;
+ rl[i] = creal(c_out_data[i]);
+ im[i] = cimag(c_out_data[i]);
+ i++;
+ }
+ for (; i < n; i++)
{
rl[i] = creal(c_out_data[i]);
im[i] = cimag(c_out_data[i]);
}
-
- MUS_UNLOCK(&c_fft_lock);
}
void mus_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is)
{
- /* simple timing tests indicate fftw is slightly less than 4 times faster than mus_fft in this context */
+ /* simple timing tests indicate fftw is slightly faster than mus_fft in this context
+ */
if (n < (1 << 30))
mus_fftw_with_imag(rl, im, n, is);
else mus_big_fft(rl, im, n, is);
@@ -9959,11 +14074,12 @@ static void mus_scramble(mus_float_t *rl, mus_float_t *im, int n)
{
/* bit reversal */
- int i, m, j;
+ int i, j;
mus_float_t vr, vi;
j = 0;
for (i = 0; i < n; i++)
{
+ int m;
if (j > i)
{
vr = rl[j];
@@ -9991,7 +14107,7 @@ void mus_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is)
* see fxt/simplfft/fft.c (Joerg Arndt)
*/
int m, j, mh, ldm, lg, i, i2, j2, imh;
- double ur, ui, u, vr, vi, angle, c, s;
+ mus_float_t u, vr, vi, angle;
if (n >= (1 << 30))
{
@@ -10007,6 +14123,7 @@ void mus_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is)
angle = (M_PI * is);
for (lg = 0; lg < imh; lg++)
{
+ mus_float_t c, s, ur, ui;
c = cos(angle);
s = sin(angle);
ur = 1.0;
@@ -10043,7 +14160,7 @@ static void mus_big_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is)
{
mus_long_t m, j, mh, ldm, i, i2, j2;
int imh, lg;
- double ur, ui, u, vr, vi, angle, c, s;
+ mus_float_t u, vr, vi, angle;
imh = (int)(log(n + 1) / log(2.0));
@@ -10074,6 +14191,7 @@ static void mus_big_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is)
angle = (M_PI * is);
for (lg = 0; lg < imh; lg++)
{
+ mus_float_t c, s, ur, ui;
c = cos(angle);
s = sin(angle);
ur = 1.0;
@@ -10108,16 +14226,16 @@ static void mus_big_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is)
#if HAVE_GSL
#include <gsl/gsl_sf_bessel.h>
-double mus_bessi0(mus_float_t x)
+mus_float_t mus_bessi0(mus_float_t x)
{
gsl_sf_result res;
gsl_sf_bessel_I0_e(x, &res);
- return(res.val);
+ return((mus_float_t)(res.val));
}
#else
-double mus_bessi0(mus_float_t x)
+mus_float_t mus_bessi0(mus_float_t x)
{
if (x == 0.0) return(1.0);
if (fabs(x) <= 15.0)
@@ -10164,7 +14282,7 @@ static mus_float_t ultraspherical(int n, mus_float_t x, mus_float_t lambda)
#endif
-bool mus_fft_window_p(int val)
+bool mus_is_fft_window(int val)
{
switch (val)
{
@@ -10184,9 +14302,14 @@ bool mus_fft_window_p(int val)
return(false);
}
-#if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
- #include <gsl/gsl_math.h>
- #include <gsl/gsl_eigen.h>
+
+#if HAVE_GSL
+ #include <gsl/gsl_version.h>
+ #if ((GSL_MAJOR_VERSION >= 1) && (GSL_MINOR_VERSION >= 9))
+ #include <gsl/gsl_math.h>
+ #include <gsl/gsl_eigen.h>
+ #define HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE 1
+ #endif
#endif
@@ -10206,13 +14329,13 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
*/
mus_long_t i, j, midn, midp1;
- double freq, rate, angle = 0.0, cx;
+ mus_float_t freq, rate, angle = 0.0, cx;
if (window == NULL) return(NULL);
midn = size >> 1;
midp1 = (size + 1) / 2;
- freq = TWO_PI / (double)size;
- rate = 1.0 / (double)midn;
+ freq = TWO_PI / (mus_float_t)size;
+ rate = 1.0 / (mus_float_t)midn;
switch (type)
{
@@ -10255,7 +14378,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
case MUS_BARTLETT_HANN_WINDOW:
{
- double ramp;
+ mus_float_t ramp;
rate *= 0.5;
/* this definition taken from mathworks docs: they use size - 1 throughout -- this makes very little
* difference unless you're using a small window. I decided to be consistent with all the other
@@ -10271,7 +14394,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
case MUS_BOHMAN_WINDOW:
{
- double ramp;
+ mus_float_t ramp;
/* definition from diracdelta docs and "DSP Handbook" -- used in bispectrum ("minimum bispectrum bias supremum") */
for (i = 0, j = size - 1, angle = M_PI, ramp = 0.0; i <= midn; i++, j--, angle -= freq, ramp += rate)
{
@@ -10498,8 +14621,8 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
case MUS_EXPONENTIAL_WINDOW:
{
- double expn, expsum = 1.0;
- expn = log(2) / (double)midn + 1.0;
+ mus_float_t expn, expsum = 1.0;
+ expn = log(2) / (mus_float_t)midn + 1.0;
for (i = 0, j = size - 1; i <= midn; i++, j--)
{
window[i] = expsum - 1.0;
@@ -10511,7 +14634,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
case MUS_KAISER_WINDOW:
{
- double I0beta;
+ mus_float_t I0beta;
I0beta = mus_bessi0(beta); /* Harris multiplies beta by pi */
for (i = 0, j = size - 1, angle = 1.0; i <= midn; i++, j--, angle -= rate)
{
@@ -10540,7 +14663,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
case MUS_HANN_POISSON_WINDOW:
/* Hann * Poisson -- from JOS */
{
- double angle1;
+ mus_float_t angle1;
for (i = 0, j = size - 1, angle = 1.0, angle1 = 0.0; i <= midn; i++, j--, angle -= rate, angle1 += freq)
{
window[i] = exp((-beta) * angle) * (0.5 - 0.5 * cos(angle1));
@@ -10551,8 +14674,8 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
case MUS_RIEMANN_WINDOW:
{
- double sr1;
- sr1 = TWO_PI / (double)size;
+ mus_float_t sr1;
+ sr1 = TWO_PI / (mus_float_t)size;
for (i = 0, j = size - 1; i <= midn; i++, j--)
{
if (i == midn)
@@ -10588,8 +14711,8 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
case MUS_MLT_SINE_WINDOW:
{
- double scl;
- scl = M_PI / (double)size;
+ mus_float_t scl;
+ scl = M_PI / (mus_float_t)size;
for (i = 0, j = size - 1; i <= midn; i++, j--)
{
window[i] = sin((i + 0.5) * scl);
@@ -10604,8 +14727,8 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
n2 = size / 2;
for (i = -n2; i < n2; i++)
{
- double ratio, pratio;
- ratio = (double)i / (double)n2;
+ mus_float_t ratio, pratio;
+ ratio = (mus_float_t)i / (mus_float_t)n2;
pratio = M_PI * ratio;
window[i + n2] = (fabs(sin(pratio)) / M_PI) + (cos(pratio) * (1.0 - fabs(ratio)));
}
@@ -10614,7 +14737,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
case MUS_SINC_WINDOW:
{
- double scl;
+ mus_float_t scl;
scl = 2 * M_PI / (size - 1);
for (i = -midn, j = 0; i < midn; i++, j++)
{
@@ -10631,14 +14754,14 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
/* from Verma, Bilbao, Meng, "The Digital Prolate Spheroidal Window"
* output checked using Julius Smith's dpssw.m, although my "beta" is different
*/
- double *data;
+ double *data; /* "double" for gsl func */
double cw, n1, pk = 0.0;
cw = cos(2 * M_PI * beta);
n1 = (size - 1) * 0.5;
if ((mus_long_t)(size * size * sizeof(double)) > mus_max_malloc())
{
- mus_error(MUS_ARG_OUT_OF_RANGE, "dpss window requires size^2 * 8 bytes, but that exceeds the current mus-max-malloc amount");
+ mus_error(MUS_ARG_OUT_OF_RANGE, S_make_fft_window ": dpss window requires size^2 * 8 bytes, but that exceeds the current mus-max-malloc amount");
return(window);
}
@@ -10683,7 +14806,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
free(data);
}
#else
- mus_error(MUS_NO_SUCH_FFT_WINDOW, "DPSS window needs GSL");
+ mus_error(MUS_NO_SUCH_FFT_WINDOW, S_make_fft_window ": DPSS window needs GSL");
#endif
break;
@@ -10706,21 +14829,21 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
{
mus_float_t *rl, *im;
mus_float_t pk = 0.0;
- double alpha;
+ mus_float_t alpha;
freq = M_PI / (mus_float_t)size;
if (beta < 0.2) beta = 0.2;
alpha = creal(ccosh(cacosh(pow(10.0, beta)) / (mus_float_t)size));
- rl = (mus_float_t *)clm_calloc_atomic(size, sizeof(mus_float_t), "ifft window buffer");
- im = (mus_float_t *)clm_calloc_atomic(size, sizeof(mus_float_t), "ifft window buffer");
+ rl = (mus_float_t *)malloc(size * sizeof(mus_float_t));
+ im = (mus_float_t *)calloc(size, sizeof(mus_float_t));
for (i = 0, angle = 0.0; i < size; i++, angle += freq)
{
switch (type)
{
case MUS_DOLPH_CHEBYSHEV_WINDOW:
- rl[i] = creal(ccos(cacos(alpha * cos(angle)) * size)); /* here is Tn (Chebyshev polynomial 1st kind) */
+ rl[i] = creal(ccos(cacos(alpha * cos(angle)) * size)); /* here is Tn (Chebyshev polynomial first kind) */
break;
case MUS_SAMARAKI_WINDOW:
@@ -10757,25 +14880,25 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
memcpy((void *)window, (void *)rl, size * sizeof(mus_float_t));
}
- clm_free(rl);
- clm_free(im);
+ free(rl);
+ free(im);
}
#else
#if HAVE_GSL
{
mus_float_t *rl, *im;
mus_float_t pk;
- double alpha;
+ mus_float_t alpha;
freq = M_PI / (mus_float_t)size;
if (beta < 0.2) beta = 0.2;
alpha = GSL_REAL(gsl_complex_cosh(
gsl_complex_mul_real(
gsl_complex_arccosh_real(pow(10.0, beta)),
- (double)(1.0 / (mus_float_t)size))));
+ (mus_float_t)(1.0 / (mus_float_t)size))));
- rl = (mus_float_t *)clm_calloc_atomic(size, sizeof(mus_float_t), "ifft window buffer");
- im = (mus_float_t *)clm_calloc_atomic(size, sizeof(mus_float_t), "ifft window buffer");
+ rl = (mus_float_t *)malloc(size * sizeof(mus_float_t));
+ im = (mus_float_t *)calloc(size, sizeof(mus_float_t));
for (i = 0, angle = 0.0; i < size; i++, angle += freq)
{
@@ -10785,7 +14908,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
rl[i] = GSL_REAL(gsl_complex_cos(
gsl_complex_mul_real(
gsl_complex_arccos_real(alpha * cos(angle)),
- (double)size)));
+ (mus_float_t)size)));
break;
case MUS_SAMARAKI_WINDOW:
@@ -10793,7 +14916,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
gsl_complex_sin(
gsl_complex_mul_real(
gsl_complex_arccos_real(alpha * cos(angle)),
- (double)(size + 1.0))),
+ (mus_float_t)(size + 1.0))),
gsl_complex_sin(
gsl_complex_arccos_real(alpha * cos(angle)))));
break;
@@ -10826,17 +14949,17 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
{
memcpy((void *)window, (void *)rl, size * sizeof(mus_float_t));
}
- clm_free(rl);
- clm_free(im);
+ free(rl);
+ free(im);
}
#else
- mus_error(MUS_NO_SUCH_FFT_WINDOW, "Dolph-Chebyshev, Samaraki, and Ultraspherical windows need complex trig support");
+ mus_error(MUS_NO_SUCH_FFT_WINDOW, S_make_fft_window ": Dolph-Chebyshev, Samaraki, and Ultraspherical windows need complex trig support");
#endif
#endif
break;
default:
- mus_error(MUS_NO_SUCH_FFT_WINDOW, "unknown fft data window: %d", (int)type);
+ mus_error(MUS_NO_SUCH_FFT_WINDOW, S_make_fft_window ": unknown fft data window: %d", (int)type);
break;
}
return(window);
@@ -10845,7 +14968,7 @@ mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t s
mus_float_t *mus_make_fft_window(mus_fft_window_t type, mus_long_t size, mus_float_t beta)
{
- return(mus_make_fft_window_with_window(type, size, beta, 0.0, (mus_float_t *)clm_calloc_atomic(size, sizeof(mus_float_t), S_make_fft_window)));
+ return(mus_make_fft_window_with_window(type, size, beta, 0.0, (mus_float_t *)calloc(size, sizeof(mus_float_t))));
}
@@ -10860,7 +14983,7 @@ static const char *fft_window_names[MUS_NUM_FFT_WINDOWS] =
const char *mus_fft_window_name(mus_fft_window_t win)
{
- if (mus_fft_window_p((int)win))
+ if (mus_is_fft_window((int)win))
return(fft_window_names[(int)win]);
return("unknown");
}
@@ -10876,21 +14999,21 @@ mus_float_t *mus_spectrum(mus_float_t *rdat, mus_float_t *idat, mus_float_t *win
{
mus_long_t i;
mus_float_t maxa, lowest;
- double val, todb;
- if (window) mus_multiply_arrays(rdat, window, n);
- mus_clear_array(idat, n);
+ if (window)
+ {
+ for (i = 0; i < n; i++)
+ rdat[i] *= window[i];
+ }
+ memset((void *)idat, 0, n * sizeof(mus_float_t));
mus_fft(rdat, idat, n, 1);
lowest = 0.000001;
maxa = 0.0;
- n = n * 0.5;
+ n = n / 2;
for (i = 0; i < n; i++)
{
-#if (__linux__ && __PPC__)
- if (rdat[i] < lowest) rdat[i] = 0.0;
- if (idat[i] < lowest) idat[i] = 0.0;
-#endif
+ mus_float_t val;
val = rdat[i] * rdat[i] + idat[i] * idat[i];
if (val < lowest)
rdat[i] = 0.001;
@@ -10905,6 +15028,7 @@ mus_float_t *mus_spectrum(mus_float_t *rdat, mus_float_t *idat, mus_float_t *win
maxa = 1.0 / maxa;
if (type == MUS_SPECTRUM_IN_DB)
{
+ mus_float_t todb;
todb = 20.0 / log(10.0);
for (i = 0; i < n; i++)
rdat[i] = todb * log(rdat[i] * maxa);
@@ -10928,7 +15052,7 @@ mus_float_t *mus_autocorrelate(mus_float_t *data, mus_long_t n)
n2 = n / 2;
fscl = 1.0 / (mus_float_t)n;
- im = (mus_float_t *)clm_calloc_atomic(n, sizeof(mus_float_t), "mus_autocorrelate imaginary data");
+ im = (mus_float_t *)calloc(n, sizeof(mus_float_t));
mus_fft(data, im, n, 1);
for (i = 0; i < n; i++)
@@ -10941,7 +15065,7 @@ mus_float_t *mus_autocorrelate(mus_float_t *data, mus_long_t n)
for (i = n2 + 1; i < n; i++)
data[i] = 0.0;
- clm_free(im);
+ free(im);
return(data);
}
@@ -10952,8 +15076,8 @@ mus_float_t *mus_correlate(mus_float_t *data1, mus_float_t *data2, mus_long_t n)
mus_long_t i;
mus_float_t fscl;
- im1 = (mus_float_t *)clm_calloc_atomic(n, sizeof(mus_float_t), "mus_correlate imaginary data");
- im2 = (mus_float_t *)clm_calloc_atomic(n, sizeof(mus_float_t), "mus_correlate imaginary data");
+ im1 = (mus_float_t *)calloc(n, sizeof(mus_float_t));
+ im2 = (mus_float_t *)calloc(n, sizeof(mus_float_t));
mus_fft(data1, im1, n, 1);
mus_fft(data2, im2, n, 1);
@@ -10974,8 +15098,8 @@ mus_float_t *mus_correlate(mus_float_t *data1, mus_float_t *data2, mus_long_t n)
for (i = 0; i < n; i++)
data1[i] *= fscl;
- clm_free(im1);
- clm_free(im2);
+ free(im1);
+ free(im2);
return(data1);
}
@@ -10984,14 +15108,14 @@ mus_float_t *mus_correlate(mus_float_t *data1, mus_float_t *data2, mus_long_t n)
mus_float_t *mus_cepstrum(mus_float_t *data, mus_long_t n)
{
mus_float_t *rl, *im;
- mus_float_t fscl = 0.0, lowest;
+ mus_float_t fscl, lowest;
mus_long_t i;
lowest = 0.00000001;
fscl = 2.0 / (mus_float_t)n;
- rl = (mus_float_t *)clm_malloc_atomic(n * sizeof(mus_float_t), "mus_cepstrum real data");
- im = (mus_float_t *)clm_calloc_atomic(n, sizeof(mus_float_t), "mus_cepstrum imaginary data");
+ rl = (mus_float_t *)malloc(n * sizeof(mus_float_t));
+ im = (mus_float_t *)calloc(n, sizeof(mus_float_t));
memcpy((void *)rl, (void *)data, n * sizeof(mus_float_t));
mus_fft(rl, im, n, 1);
@@ -11026,13 +15150,14 @@ mus_float_t *mus_cepstrum(mus_float_t *data, mus_long_t n)
mus_float_t *mus_convolution(mus_float_t *rl1, mus_float_t *rl2, mus_long_t n)
{
- /* convolves two real arrays. */
- /* rl1 and rl2 are assumed to be set up correctly for the convolution */
- /* (that is, rl1 (the "signal") is zero-padded by length of */
- /* (non-zero part of) rl2 and rl2 is stored in wrap-around order) */
- /* We treat rl2 as the imaginary part of the first fft, then do */
- /* the split, scaling, and (complex) spectral multiply in one step. */
- /* result in rl1 */
+ /* convolves two real arrays.
+ * rl1 and rl2 are assumed to be set up correctly for the convolution
+ * (that is, rl1 (the "signal") is zero-padded by length of
+ * (non-zero part of) rl2 and rl2 is stored in wrap-around order)
+ * We treat rl2 as the imaginary part of the first fft, then do
+ * the split, scaling, and (complex) spectral multiply in one step.
+ * result in rl1
+ */
mus_long_t j, n2;
mus_float_t invn;
@@ -11048,6 +15173,7 @@ mus_float_t *mus_convolution(mus_float_t *rl1, mus_float_t *rl2, mus_long_t n)
{
mus_long_t nn2;
mus_float_t rem, rep, aim, aip;
+
nn2 = n - j;
rep = (rl1[j] + rl1[nn2]);
rem = (rl1[j] - rl1[nn2]);
@@ -11055,8 +15181,8 @@ mus_float_t *mus_convolution(mus_float_t *rl1, mus_float_t *rl2, mus_long_t n)
aim = (rl2[j] - rl2[nn2]);
rl1[j] = invn * (rep * aip + aim * rem);
- rl1[nn2] = rl1[j];
rl2[j] = invn * (aim * aip - rep * rem);
+ rl1[nn2] = rl1[j];
rl2[nn2] = -rl2[j];
}
@@ -11068,6 +15194,7 @@ mus_float_t *mus_convolution(mus_float_t *rl1, mus_float_t *rl2, mus_long_t n)
typedef struct {
mus_any_class *core;
mus_float_t (*feeder)(void *arg, int direction);
+ mus_float_t (*block_feeder)(void *arg, int direction, mus_float_t *block, mus_long_t start, mus_long_t end);
mus_long_t fftsize, fftsize2, ctr, filtersize;
mus_float_t *rl1, *rl2, *buf, *filter;
void *closure;
@@ -11081,25 +15208,39 @@ static char *describe_convolve(mus_any *ptr)
{
conv *gen = (conv *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: " MUS_LD,
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %lld",
mus_name(ptr),
gen->fftsize);
return(describe_buffer);
}
-static int free_convolve(mus_any *ptr)
+static void free_convolve(mus_any *ptr)
{
conv *gen = (conv *)ptr;
- if (gen)
- {
- if (gen->rl1) clm_free(gen->rl1);
- if (gen->rl2) clm_free(gen->rl2);
- if (gen->buf) clm_free(gen->buf);
- clm_free(gen);
- }
- return(0);
+ if (gen->rl1) free(gen->rl1);
+ if (gen->rl2) free(gen->rl2);
+ if (gen->buf) free(gen->buf);
+ free(gen);
+}
+
+static mus_any *conv_copy(mus_any *ptr)
+{
+ conv *g, *p;
+ int bytes;
+
+ p = (conv *)ptr;
+ g = (conv *)malloc(sizeof(conv));
+ memcpy((void *)g, (void *)ptr, sizeof(conv));
+ bytes = g->fftsize * sizeof(mus_float_t);
+ g->rl1 = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->rl1), (void *)(p->rl1), bytes);
+ g->rl2 = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->rl2), (void *)(p->rl2), bytes);
+ g->buf = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->buf), (void *)(p->buf), bytes);
+ return((mus_any *)g);
}
@@ -11113,9 +15254,9 @@ static void convolve_reset(mus_any *ptr)
{
conv *gen = (conv *)ptr;
gen->ctr = gen->fftsize2;
- mus_clear_array(gen->rl1, gen->fftsize);
- mus_clear_array(gen->rl2, gen->fftsize);
- mus_clear_array(gen->buf, gen->fftsize);
+ memset((void *)(gen->rl1), 0, gen->fftsize * sizeof(mus_float_t));
+ memset((void *)(gen->rl2), 0, gen->fftsize * sizeof(mus_float_t));
+ memset((void *)(gen->buf), 0, gen->fftsize * sizeof(mus_float_t));
}
@@ -11137,10 +15278,10 @@ static mus_any_class CONVOLVE_CLASS = {
0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0,
+ 0, 0, 0, 0,
&convolve_reset,
- &conv_set_closure,
- 0, 0
+ &conv_set_closure,
+ &conv_copy
};
@@ -11150,27 +15291,39 @@ mus_float_t mus_convolve(mus_any *ptr, mus_float_t (*input)(void *arg, int direc
mus_float_t result;
if (gen->ctr >= gen->fftsize2)
{
- mus_long_t i, j;
- mus_float_t (*conv_input)(void *arg, int direction) = input;
- if (conv_input == NULL) conv_input = gen->feeder;
- for (i = 0, j = gen->fftsize2; i < gen->fftsize2; i++, j++)
+ mus_long_t i, N;
+ size_t bytes;
+
+ N = gen->fftsize2;
+ bytes = N * sizeof(mus_float_t);
+
+ if (input) {gen->feeder = input; gen->block_feeder = NULL;}
+ memset((void *)(gen->rl2), 0, bytes * 2);
+ memcpy((void *)(gen->rl2), (void *)(gen->filter), gen->filtersize * sizeof(mus_float_t));
+
+ memcpy((void *)(gen->buf), (void *)(gen->buf + N), bytes);
+ memset((void *)(gen->buf + N), 0, bytes);
+ memset((void *)(gen->rl1 + N), 0, bytes);
+
+ if (gen->block_feeder)
+ gen->block_feeder(gen->closure, 1, gen->rl1, 0, N);
+ else
{
- gen->buf[i] = gen->buf[j];
- gen->buf[j] = 0.0;
- gen->rl1[i] = (*conv_input)(gen->closure, 1);
- gen->rl1[j] = 0.0;
- gen->rl2[i] = 0.0;
- gen->rl2[j] = 0.0;
+ for (i = 0; i < N;)
+ {
+ gen->rl1[i] = gen->feeder(gen->closure, 1); i++;
+ gen->rl1[i] = gen->feeder(gen->closure, 1); i++;
+ }
}
- memcpy((void *)(gen->rl2), (void *)(gen->filter), gen->filtersize * sizeof(mus_float_t));
mus_convolution(gen->rl1, gen->rl2, gen->fftsize);
- for (i = 0, j = gen->fftsize2; i < gen->fftsize2; i++, j++)
+ for (i = 0; i < N;)
{
- gen->buf[i] += gen->rl1[i];
- gen->buf[j] = gen->rl1[j];
+ gen->buf[i] += gen->rl1[i]; i++;
+ gen->buf[i] += gen->rl1[i]; i++;
}
+ memcpy((void *)(gen->buf + N), (void *)(gen->rl1 + N), bytes);
gen->ctr = 0;
}
result = gen->buf[gen->ctr];
@@ -11179,7 +15332,7 @@ mus_float_t mus_convolve(mus_any *ptr, mus_float_t (*input)(void *arg, int direc
}
-bool mus_convolve_p(mus_any *ptr)
+bool mus_is_convolve(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_CONVOLVE));
@@ -11189,9 +15342,10 @@ bool mus_convolve_p(mus_any *ptr)
mus_any *mus_make_convolve(mus_float_t (*input)(void *arg, int direction), mus_float_t *filter, mus_long_t fftsize, mus_long_t filtersize, void *closure)
{
conv *gen = NULL;
- gen = (conv *)clm_calloc(1, sizeof(conv), S_make_convolve);
+ gen = (conv *)malloc(sizeof(conv));
gen->core = &CONVOLVE_CLASS;
gen->feeder = input;
+ gen->block_feeder = NULL;
gen->closure = closure;
gen->filter = filter;
if (filter)
@@ -11211,9 +15365,9 @@ mus_any *mus_make_convolve(mus_float_t (*input)(void *arg, int direction), mus_f
gen->fftsize = fftsize;
gen->fftsize2 = gen->fftsize / 2;
gen->ctr = gen->fftsize2;
- gen->rl1 = (mus_float_t *)clm_calloc_atomic(fftsize, sizeof(mus_float_t), "convolve fft data");
- gen->rl2 = (mus_float_t *)clm_calloc_atomic(fftsize, sizeof(mus_float_t), "convolve fft data");
- gen->buf = (mus_float_t *)clm_calloc_atomic(fftsize, sizeof(mus_float_t), "convolve fft data");
+ gen->rl1 = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
+ gen->rl2 = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
+ gen->buf = (mus_float_t *)calloc(fftsize, sizeof(mus_float_t));
return((mus_any *)gen);
}
@@ -11227,14 +15381,14 @@ void mus_convolve_files(const char *file1, const char *file2, mus_float_t maxamp
mus_float_t maxval = 0.0;
mus_long_t i, fftlen;
- file1_len = mus_sound_frames(file1);
- file2_len = mus_sound_frames(file2);
+ file1_len = mus_sound_framples(file1);
+ file2_len = mus_sound_framples(file2);
if ((file1_len <= 0) || (file2_len <= 0)) return;
file1_chans = mus_sound_chans(file1);
- if (file1_chans <= 0) mus_error(MUS_NO_CHANNELS, "%s chans: %d", file1, file1_chans);
+ if (file1_chans <= 0) mus_error(MUS_NO_CHANNELS, S_convolve_files ": %s chans: %d", file1, file1_chans);
file2_chans = mus_sound_chans(file2);
- if (file2_chans <= 0) mus_error(MUS_NO_CHANNELS, "%s chans: %d", file2, file2_chans);
+ if (file2_chans <= 0) mus_error(MUS_NO_CHANNELS, S_convolve_files ": %s chans: %d", file2, file2_chans);
output_chans = file1_chans;
if (file2_chans > output_chans) output_chans = file2_chans;
@@ -11242,18 +15396,18 @@ void mus_convolve_files(const char *file1, const char *file2, mus_float_t maxamp
outlen = file1_len + file2_len + 1;
totallen = outlen * output_chans;
- data1 = (mus_float_t *)clm_calloc_atomic(fftlen, sizeof(mus_float_t), "convolve_files data");
- data2 = (mus_float_t *)clm_calloc_atomic(fftlen, sizeof(mus_float_t), "convolve_files data");
+ data1 = (mus_float_t *)calloc(fftlen, sizeof(mus_float_t));
+ data2 = (mus_float_t *)calloc(fftlen, sizeof(mus_float_t));
if (output_chans == 1)
{
- mus_sample_t *samps;
- samps = (mus_sample_t *)clm_calloc_atomic(fftlen, sizeof(mus_sample_t), "convolve_files data");
+ mus_float_t *samps;
+ samps = (mus_float_t *)calloc(fftlen, sizeof(mus_float_t));
mus_file_to_array(file1, 0, 0, file1_len, samps);
- for (i = 0; i < file1_len; i++) data1[i] = MUS_SAMPLE_TO_DOUBLE(samps[i]);
+ for (i = 0; i < file1_len; i++) data1[i] = samps[i];
mus_file_to_array(file2, 0, 0, file2_len, samps);
- for (i = 0; i < file2_len; i++) data2[i] = MUS_SAMPLE_TO_DOUBLE(samps[i]);
+ for (i = 0; i < file2_len; i++) data2[i] = samps[i];
mus_convolution(data1, data2, fftlen);
@@ -11267,28 +15421,28 @@ void mus_convolve_files(const char *file1, const char *file2, mus_float_t maxamp
for (i = 0; i < outlen; i++) data1[i] *= maxval;
}
- for (i = 0; i < outlen; i++) samps[i] = MUS_DOUBLE_TO_SAMPLE(data1[i]);
+ for (i = 0; i < outlen; i++) samps[i] = data1[i];
errmsg = mus_array_to_file_with_error(output_file, samps, outlen, mus_sound_srate(file1), 1);
- clm_free(samps);
+ free(samps);
}
else
{
- mus_sample_t *samps;
+ mus_float_t *samps;
mus_float_t *outdat = NULL;
int c1 = 0, c2 = 0, chan;
- samps = (mus_sample_t *)clm_calloc_atomic(totallen, sizeof(mus_sample_t), "convolve_files data");
- outdat = (mus_float_t *)clm_calloc_atomic(totallen, sizeof(mus_float_t), "convolve_files data");
+ samps = (mus_float_t *)calloc(totallen, sizeof(mus_float_t));
+ outdat = (mus_float_t *)malloc(totallen * sizeof(mus_float_t));
for (chan = 0; chan < output_chans; chan++)
{
mus_long_t j, k;
mus_file_to_array(file1, c1, 0, file1_len, samps);
- for (k = 0; k < file1_len; k++) data1[k] = MUS_SAMPLE_TO_DOUBLE(samps[k]);
+ for (k = 0; k < file1_len; k++) data1[k] = samps[k];
mus_file_to_array(file2, c2, 0, file2_len, samps);
- for (k = 0; k < file2_len; k++) data2[k] = MUS_SAMPLE_TO_DOUBLE(samps[k]);
+ for (k = 0; k < file2_len; k++) data2[k] = samps[k];
mus_convolution(data1, data2, fftlen);
@@ -11298,8 +15452,8 @@ void mus_convolve_files(const char *file1, const char *file2, mus_float_t maxamp
c2++;
if (c2 >= file2_chans) c2 = 0;
- mus_clear_array(data1, fftlen);
- mus_clear_array(data2, fftlen);
+ memset((void *)data1, 0, fftlen * sizeof(mus_float_t));
+ memset((void *)data2, 0, fftlen * sizeof(mus_float_t));
}
for (i = 0; i < totallen; i++)
@@ -11313,18 +15467,18 @@ void mus_convolve_files(const char *file1, const char *file2, mus_float_t maxamp
}
for (i = 0; i < totallen; i++)
- samps[i] = MUS_DOUBLE_TO_SAMPLE(outdat[i]);
+ samps[i] = outdat[i];
errmsg = mus_array_to_file_with_error(output_file, samps, totallen, mus_sound_srate(file1), output_chans);
- clm_free(samps);
- clm_free(outdat);
+ free(samps);
+ free(outdat);
}
- clm_free(data1);
- clm_free(data2);
+ free(data1);
+ free(data2);
if (errmsg)
- mus_error(MUS_CANT_OPEN_FILE, "%s", errmsg);
+ mus_error(MUS_CANT_OPEN_FILE, S_convolve_files ": %s", errmsg);
}
@@ -11335,16 +15489,25 @@ typedef struct {
mus_any_class *core;
mus_float_t pitch;
mus_float_t (*input)(void *arg, int direction);
+ mus_float_t (*block_input)(void *arg, int direction, mus_float_t *block, mus_long_t start, mus_long_t end);
void *closure;
bool (*analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction));
int (*edit)(void *arg);
mus_float_t (*synthesize)(void *arg);
- int outctr, interp, filptr, N, D;
+ int outctr, interp, filptr, N, D, topN;
mus_float_t *win, *ampinc, *amps, *freqs, *phases, *phaseinc, *lastphase, *in_data;
+
+ mus_float_t sum1;
+ bool calc;
+#if HAVE_SINCOS
+ double *cs, *sn;
+ bool *sc_safe;
+ int *indices;
+#endif
} pv_info;
-bool mus_phase_vocoder_p(mus_any *ptr)
+bool mus_is_phase_vocoder(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_PHASE_VOCODER));
@@ -11359,32 +15522,86 @@ static char *describe_phase_vocoder(mus_any *ptr)
char *arr = NULL;
pv_info *gen = (pv_info *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s outctr: %d, interp: %d, filptr: %d, N: %d, D: %d, in_data: %s",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s outctr: %d, interp: %d, filptr: %d, N: %d, D: %d, in_data: %s",
mus_name(ptr),
gen->outctr, gen->interp, gen->filptr, gen->N, gen->D,
arr = float_array_to_string(gen->in_data, gen->N, 0));
- if (arr) clm_free(arr);
+ if (arr) free(arr);
return(describe_buffer);
}
-static int free_phase_vocoder(mus_any *ptr)
+static void free_phase_vocoder(mus_any *ptr)
{
pv_info *gen = (pv_info *)ptr;
- if (gen)
+ if (gen->in_data) free(gen->in_data);
+ if (gen->amps) free(gen->amps);
+ if (gen->freqs) free(gen->freqs);
+ if (gen->phases) free(gen->phases);
+ if (gen->win) free(gen->win);
+ if (gen->phaseinc) free(gen->phaseinc);
+ if (gen->lastphase) free(gen->lastphase);
+ if (gen->ampinc) free(gen->ampinc);
+#if HAVE_SINCOS
+ if (gen->indices) free(gen->indices);
+ if (gen->sn) free(gen->sn);
+ if (gen->cs) free(gen->cs);
+ if (gen->sc_safe) free(gen->sc_safe);
+#endif
+ free(gen);
+}
+
+
+static mus_any *pv_info_copy(mus_any *ptr)
+{
+ pv_info *g, *p;
+ int bytes;
+
+ p = (pv_info *)ptr;
+ g = (pv_info *)malloc(sizeof(pv_info));
+ memcpy((void *)g, (void *)ptr, sizeof(pv_info));
+
+ bytes = p->N * sizeof(mus_float_t);
+ g->freqs = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->freqs), (void *)(p->freqs), bytes);
+ g->ampinc = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->ampinc), (void *)(p->ampinc), bytes);
+ g->win = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->win), (void *)(p->win), bytes);
+ if (p->in_data)
{
- if (gen->in_data) clm_free(gen->in_data);
- if (gen->amps) clm_free(gen->amps);
- if (gen->freqs) clm_free(gen->freqs);
- if (gen->phases) clm_free(gen->phases);
- if (gen->win) clm_free(gen->win);
- if (gen->phaseinc) clm_free(gen->phaseinc);
- if (gen->lastphase) clm_free(gen->lastphase);
- if (gen->ampinc) clm_free(gen->ampinc);
- clm_free(gen);
+ g->in_data = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->in_data), (void *)(p->in_data), bytes);
}
- return(0);
+
+ bytes = (p->N / 2) * sizeof(mus_float_t);
+ g->amps = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->amps), (void *)(p->amps), bytes);
+ g->phases = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->phases), (void *)(p->phases), bytes);
+ g->lastphase = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->lastphase), (void *)(p->lastphase), bytes);
+ g->phaseinc = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->phaseinc), (void *)(p->phaseinc), bytes);
+
+#if HAVE_SINCOS
+ bytes = (p->N / 2) * sizeof(int);
+ g->indices = (int *)malloc(bytes);
+ memcpy((void *)(g->indices), (void *)(p->indices), bytes);
+
+ bytes = p->N * sizeof(double);
+ g->sn = (double *)malloc(bytes);
+ memcpy((void *)(g->sn), (void *)(p->sn), bytes);
+ g->cs = (double *)malloc(bytes);
+ memcpy((void *)(g->cs), (void *)(p->cs), bytes);
+
+ bytes = p->N * sizeof(bool);
+ g->sc_safe = (bool *)malloc(bytes);
+ memcpy((void *)(g->sc_safe), (void *)(p->sc_safe), bytes);
+#endif
+
+ return((mus_any *)g);
}
@@ -11418,16 +15635,16 @@ static mus_float_t pv_set_increment(mus_any *rd, mus_float_t val) {((pv_info *)r
static void pv_reset(mus_any *ptr)
{
pv_info *gen = (pv_info *)ptr;
- if (gen->in_data) clm_free(gen->in_data);
+ if (gen->in_data) free(gen->in_data);
gen->in_data = NULL;
gen->outctr = gen->interp;
gen->filptr = 0;
- mus_clear_array(gen->ampinc, gen->N);
- mus_clear_array(gen->freqs, gen->N);
- mus_clear_array(gen->amps, gen->N / 2);
- mus_clear_array(gen->phases, gen->N / 2);
- mus_clear_array(gen->lastphase, gen->N / 2);
- mus_clear_array(gen->phaseinc, gen->N / 2);
+ memset((void *)(gen->ampinc), 0, gen->N * sizeof(mus_float_t));
+ memset((void *)(gen->freqs), 0, gen->N * sizeof(mus_float_t));
+ memset((void *)(gen->amps), 0, (gen->N / 2) * sizeof(mus_float_t));
+ memset((void *)(gen->phases), 0, (gen->N / 2) * sizeof(mus_float_t));
+ memset((void *)(gen->lastphase), 0, (gen->N / 2) * sizeof(mus_float_t));
+ memset((void *)(gen->phaseinc), 0, (gen->N / 2) * sizeof(mus_float_t));
}
@@ -11454,13 +15671,16 @@ static mus_any_class PHASE_VOCODER_CLASS = {
0, 0,
0, 0, 0, 0,
&pv_outctr, &pv_set_outctr,
- 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0,
&pv_reset,
- &pv_set_closure,
- 0, 0
+ &pv_set_closure,
+ &pv_info_copy
};
+static int pv_last_fftsize = -1;
+static mus_float_t *pv_last_window = NULL;
+
mus_any *mus_make_phase_vocoder(mus_float_t (*input)(void *arg, int direction),
int fftsize, int overlap, int interp,
mus_float_t pitch,
@@ -11473,57 +15693,80 @@ mus_any *mus_make_phase_vocoder(mus_float_t (*input)(void *arg, int direction),
* the inclusion of pitch and interp provides built-in time/pitch scaling which is 99% of phase-vocoder use
*/
pv_info *pv;
- int N2, D, i;
- mus_float_t scl;
+ int N2, D;
N2 = (int)(fftsize / 2);
if (N2 == 0) return(NULL);
D = fftsize / overlap;
if (D == 0) return(NULL);
- pv = (pv_info *)clm_calloc(1, sizeof(pv_info), S_make_phase_vocoder);
+ pv = (pv_info *)malloc(sizeof(pv_info));
pv->core = &PHASE_VOCODER_CLASS;
pv->N = fftsize;
pv->D = D;
+ pv->topN = 0;
pv->interp = interp;
pv->outctr = interp;
pv->filptr = 0;
pv->pitch = pitch;
- pv->ampinc = (mus_float_t *)clm_calloc_atomic(fftsize, sizeof(mus_float_t), "pvoc ampinc");
- pv->freqs = (mus_float_t *)clm_calloc_atomic(fftsize, sizeof(mus_float_t), "pvoc freqs");
- pv->amps = (mus_float_t *)clm_calloc_atomic(N2, sizeof(mus_float_t), "pvoc amps");
- pv->phases = (mus_float_t *)clm_calloc_atomic(N2, sizeof(mus_float_t), "pvoc phases");
- pv->lastphase = (mus_float_t *)clm_calloc_atomic(N2, sizeof(mus_float_t), "pvoc lastphase");
- pv->phaseinc = (mus_float_t *)clm_calloc_atomic(N2, sizeof(mus_float_t), "pvoc phaseinc");
+ pv->ampinc = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
+ pv->freqs = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
+ pv->amps = (mus_float_t *)calloc(N2, sizeof(mus_float_t));
+ pv->phases = (mus_float_t *)calloc(N2, sizeof(mus_float_t));
+ pv->lastphase = (mus_float_t *)calloc(N2, sizeof(mus_float_t));
+ pv->phaseinc = (mus_float_t *)calloc(N2, sizeof(mus_float_t));
pv->in_data = NULL;
pv->input = input;
+ pv->block_input = NULL;
pv->closure = closure;
pv->analyze = analyze;
pv->edit = edit;
pv->synthesize = synthesize;
+ pv->calc = true;
- pv->win = mus_make_fft_window(MUS_HAMMING_WINDOW, fftsize, 0.0);
- scl = 2.0 / (0.54 * (mus_float_t)fftsize);
- if (pv->win) /* clm2xen traps errors for later reporting (to clean up local allocation),
- * so calloc might return NULL in all the cases here
- */
- for (i = 0; i < fftsize; i++)
- pv->win[i] *= scl;
+ if ((fftsize == pv_last_fftsize) && (pv_last_window))
+ {
+ pv->win = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
+ memcpy((void *)(pv->win), (const void *)pv_last_window, fftsize * sizeof(mus_float_t));
+ }
+ else
+ {
+ int i;
+ mus_float_t scl;
+ if (pv_last_window) free(pv_last_window);
+ pv_last_fftsize = fftsize;
+ pv_last_window = (mus_float_t *)malloc(fftsize * sizeof(mus_float_t));
+ pv->win = mus_make_fft_window(MUS_HAMMING_WINDOW, fftsize, 0.0);
+ scl = 2.0 / (0.54 * (mus_float_t)fftsize);
+ for (i = 0; i < fftsize; i++)
+ pv->win[i] *= scl;
+ memcpy((void *)pv_last_window, (const void *)(pv->win), fftsize * sizeof(mus_float_t));
+ }
+#if HAVE_SINCOS
+ /* in some cases, sincos is slower than sin+cos? Callgrind is seriously confused by it!
+ * in Linux at least, sincos is faster than sin+sin -- in my timing tests, although
+ * callgrind is crazy, the actual runtimes are about 25% faster (sincos vs sin+sin).
+ */
+ pv->cs = (double *)malloc(fftsize * sizeof(double));
+ pv->sn = (double *)malloc(fftsize * sizeof(double));
+ pv->sc_safe = (bool *)calloc(fftsize, sizeof(bool));
+ pv->indices = (int *)malloc(N2 * sizeof(int));
+#endif
return((mus_any *)pv);
}
mus_float_t mus_phase_vocoder_with_editors(mus_any *ptr,
- mus_float_t (*input)(void *arg, int direction),
- bool (*analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction)),
- int (*edit)(void *arg),
- mus_float_t (*synthesize)(void *arg))
-{
+ mus_float_t (*input)(void *arg, int direction),
+ bool (*analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction)),
+ int (*edit)(void *arg),
+ mus_float_t (*synthesize)(void *arg))
+ {
pv_info *pv = (pv_info *)ptr;
int N2, i;
+ mus_float_t sum, sum1;
mus_float_t (*pv_synthesize)(void *arg) = synthesize;
- mus_float_t sum = 0.0;
if (pv_synthesize == NULL) pv_synthesize = pv->synthesize;
N2 = pv->N / 2;
@@ -11531,35 +15774,45 @@ mus_float_t mus_phase_vocoder_with_editors(mus_any *ptr,
if (pv->outctr >= pv->interp)
{
mus_float_t scl;
- mus_float_t (*pv_input)(void *arg, int direction) = input;
bool (*pv_analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction)) = analyze;
int (*pv_edit)(void *arg) = edit;
- if (pv_input == NULL)
- {
- pv_input = pv->input;
- if (pv_input == NULL)
- mus_error(MUS_NO_SAMPLE_INPUT, "%s has no input function!", mus_describe(ptr));
- }
if (pv_analyze == NULL) pv_analyze = pv->analyze;
if (pv_edit == NULL) pv_edit = pv->edit;
+ if (input) {pv->input = input; pv->block_input = NULL;}
pv->outctr = 0;
if ((pv_analyze == NULL) ||
- ((*pv_analyze)(pv->closure, pv_input)))
+ ((*pv_analyze)(pv->closure, pv->input)))
{
- int j, buf;
- mus_clear_array(pv->freqs, pv->N);
+ int buf;
+ memset((void *)(pv->freqs), 0, pv->N * sizeof(mus_float_t));
if (pv->in_data == NULL)
{
- pv->in_data = (mus_float_t *)clm_calloc_atomic(pv->N, sizeof(mus_float_t), "pvoc indata");
- for (i = 0; i < pv->N; i++) pv->in_data[i] = (*pv_input)(pv->closure, 1);
+ pv->in_data = (mus_float_t *)malloc(pv->N * sizeof(mus_float_t));
+ if (pv->block_input)
+ pv->block_input(pv->closure, 1, pv->in_data, 0, pv->N);
+ else
+ {
+ for (i = 0; i < pv->N; i++)
+ pv->in_data[i] = pv->input(pv->closure, 1);
+ }
}
else
{
- for (i = 0, j = pv->D; j < pv->N; i++, j++) pv->in_data[i] = pv->in_data[j];
- for (i = pv->N - pv->D; i < pv->N; i++) pv->in_data[i] = (*pv_input)(pv->closure, 1);
+ int j;
+ /* if back-to-back here we could omit a lot of data movement or just use a circle here! */
+ for (i = 0, j = pv->D; j < pv->N; i++, j++)
+ pv->in_data[i] = pv->in_data[j];
+
+ if (pv->block_input)
+ pv->block_input(pv->closure, 1, pv->in_data, pv->N - pv->D, pv->N);
+ else
+ {
+ for (i = pv->N - pv->D; i < pv->N; i++)
+ pv->in_data[i] = pv->input(pv->closure, 1);
+ }
}
buf = pv->filptr % pv->N;
for (i = 0; i < pv->N; i++)
@@ -11588,29 +15841,138 @@ mus_float_t mus_phase_vocoder_with_editors(mus_any *ptr,
pv->freqs[i] = pv->pitch * (diff * pscl + ks);
}
}
-
+ /* it's possible to build the endpoint waveforms here and interpolate, but there is no savings.
+ * other pvocs use ifft rather than sin-bank, but then they have to make excuses.
+ * Something I didn't expect -- the algorithm above focusses on the active frequency!
+ * For example, the 4 or so bins around a given peak all tighten
+ * to 4 bins running at almost exactly the same frequency (the center).
+ */
+
scl = 1.0 / (mus_float_t)(pv->interp);
+#if HAVE_SINCOS
+ pv->topN = 0;
+#else
+ pv->topN = N2;
+#endif
+
for (i = 0; i < N2; i++)
{
+#if HAVE_SINCOS
+ double s, c;
+ bool amp_zero;
+
+ amp_zero = ((pv->amps[i] < 1e-7) && (pv->ampinc[i] == 0.0));
+ if (!amp_zero)
+ {
+ pv->indices[pv->topN++] = i;
+
+ pv->sc_safe[i] = (fabs(pv->freqs[i] - pv->phaseinc[i]) < 0.02); /* .5 is too big, .01 and .03 ok by tests */
+ if (pv->sc_safe[i])
+ {
+ sincos((pv->freqs[i] + pv->phaseinc[i]) * 0.5, &s, &c);
+ pv->sn[i] = s;
+ pv->cs[i] = c;
+ }
+ }
+
+ if ((!(pv->synthesize)) && (amp_zero))
+ {
+ pv->phases[i] += (pv->interp * (pv->freqs[i] + pv->phaseinc[i]) * 0.5);
+ pv->phaseinc[i] = pv->freqs[i];
+ }
+ else
+ {
+ pv->ampinc[i] = scl * (pv->ampinc[i] - pv->amps[i]);
+ pv->freqs[i] = scl * (pv->freqs[i] - pv->phaseinc[i]);
+ }
+#else
pv->ampinc[i] = scl * (pv->ampinc[i] - pv->amps[i]);
pv->freqs[i] = scl * (pv->freqs[i] - pv->phaseinc[i]);
+#endif
}
-
}
pv->outctr++;
-
if (pv_synthesize)
return((*pv_synthesize)(pv->closure));
- for (i = 0; i < N2; i++)
+ if (pv->calc)
{
- pv->amps[i] += pv->ampinc[i];
- pv->phaseinc[i] += pv->freqs[i];
- pv->phases[i] += pv->phaseinc[i];
- sum += (pv->amps[i] * sin(pv->phases[i])); /* this is really expensive in 64-bit systems -- perhaps make a local sin? */
+ mus_float_t *pinc, *frq, *ph, *amp, *panc;
+ int topN;
+#if HAVE_SINCOS
+ int j;
+ double *cs, *sn;
+#endif
+
+ topN = pv->topN;
+ pinc = pv->phaseinc;
+ frq = pv->freqs;
+ ph = pv->phases;
+ amp = pv->amps;
+ panc = pv->ampinc;
+#if HAVE_SINCOS
+ cs = pv->cs;
+ sn = pv->sn;
+#endif
+
+ sum = 0.0;
+ sum1 = 0.0;
+
+ /* amps can be negative here due to rounding troubles
+ * sincos is faster (using shell time command) except in virtualbox running linux on a mac?
+ * (callgrind does not handle sincos correctly).
+ *
+ * this version (22-Jan-14) is slower if no sincos;
+ * if sincos, we use sin(a + b) = sin(a)cos(b) + cos(a)sin(b)
+ * since sin(b) and cos(b) are constant through the pv->interp (implicit) loop, they are calculated once above.
+ * Then here we calculate 2 samples on each run through this loop. I wonder if we could center the true case,
+ * and get 3 samples? If 2, the difference is very small (we're taking the midpoint of the phase increment change,
+ * so the two are not quite the same). In tests, 10000 samples, channel-distance is ca .15.
+ *
+ * If the amp zero phase is off (incorrectly incremented above), the effect is a sort of low-pass filter??
+ * Are we getting cancellation from the overlap?
+ */
+
+#if HAVE_SINCOS
+ for (j = 0; j < topN; j++)
+ {
+ double sx, cx;
+
+ i = pv->indices[j];
+ pinc[i] += frq[i];
+ ph[i] += pinc[i];
+ amp[i] += panc[i];
+ sincos(ph[i], &sx, &cx);
+ sum += (amp[i] * sx);
+
+ pinc[i] += frq[i];
+ ph[i] += pinc[i];
+ amp[i] += panc[i];
+ if (pv->sc_safe[i])
+ sum1 += amp[i] * (sx * cs[i] + cx * sn[i]);
+ else sum1 += amp[i] * sin(ph[i]);
+ }
+#else
+ for (i = 0; i < topN; i++)
+ {
+ pinc[i] += frq[i];
+ ph[i] += pinc[i];
+ amp[i] += panc[i];
+ if (amp[i] > 0.0) sum += amp[i] * sin(ph[i]);
+
+ pinc[i] += frq[i];
+ ph[i] += pinc[i];
+ amp[i] += panc[i];
+ if (amp[i] > 0.0) sum1 += amp[i] * sin(ph[i]);
+ }
+#endif
+ pv->sum1 = sum1;
+ pv->calc = false;
+ return(sum);
}
- return(sum);
+ pv->calc = true;
+ return(pv->sum1);
}
@@ -11620,6 +15982,75 @@ mus_float_t mus_phase_vocoder(mus_any *ptr, mus_float_t (*input)(void *arg, int
}
+void mus_generator_set_feeders(mus_any *g,
+ mus_float_t (*feed)(void *arg, int direction),
+ mus_float_t (*block_feed)(void *arg, int direction, mus_float_t *block, mus_long_t start, mus_long_t end))
+{
+ if (mus_is_src(g))
+ {
+ ((sr *)g)->feeder = feed;
+ ((sr *)g)->block_feeder = block_feed;
+ }
+ else
+ {
+ if (mus_is_granulate(g))
+ {
+ ((grn_info *)g)->rd = feed;
+ ((grn_info *)g)->block_rd = block_feed;
+ }
+ else
+ {
+ if (mus_is_phase_vocoder(g))
+ {
+ ((pv_info *)g)->input = feed;
+ ((pv_info *)g)->block_input = block_feed;
+ }
+ else
+ {
+ if (mus_is_convolve(g))
+ {
+ ((conv *)g)->feeder = feed;
+ ((conv *)g)->block_feeder = block_feed;
+ }
+ }
+ }
+ }
+}
+
+void mus_generator_copy_feeders(mus_any *dest, mus_any *source)
+{
+ if (mus_is_src(dest))
+ {
+ ((sr *)dest)->feeder = ((sr *)source)->feeder;
+ ((sr *)dest)->block_feeder = ((sr *)source)->block_feeder;
+ }
+ else
+ {
+ if (mus_is_granulate(dest))
+ {
+ ((grn_info *)dest)->rd = ((grn_info *)source)->rd;
+ ((grn_info *)dest)->block_rd = ((grn_info *)source)->block_rd;
+ }
+ else
+ {
+ if (mus_is_phase_vocoder(dest))
+ {
+ ((pv_info *)dest)->input = ((pv_info *)source)->input;
+ ((pv_info *)dest)->block_input = ((pv_info *)source)->block_input;
+ }
+ else
+ {
+ if (mus_is_convolve(dest))
+ {
+ ((conv *)dest)->feeder = ((conv *)source)->feeder;
+ ((conv *)dest)->block_feeder = ((conv *)source)->block_feeder;
+ }
+ }
+ }
+ }
+}
+
+
/* ---------------- single sideband "suppressed carrier" amplitude modulation (ssb-am) ---------------- */
@@ -11627,41 +16058,59 @@ typedef struct {
mus_any_class *core;
bool shift_up;
mus_float_t *coeffs;
- mus_any *sin_osc, *cos_osc, *hilbert, *dly;
+ mus_any *hilbert, *dly;
+#if (!HAVE_SINCOS)
+ mus_any *sin_osc, *cos_osc;
+#else
+ double phase, freq, sign;
+#endif
+ int size;
} ssbam;
-bool mus_ssb_am_p(mus_any *ptr)
+bool mus_is_ssb_am(mus_any *ptr)
{
return((ptr) &&
(ptr->core->type == MUS_SSB_AM));
}
-
-static mus_float_t run_hilbert(flt *gen, mus_float_t insig)
+static mus_float_t run_hilbert(flt *gen, mus_float_t input)
{
- mus_float_t xout = 0.0, d1 = 0.0, d2 = 0.0;
- mus_float_t *ap, *dp, *dend;
+ mus_float_t xout = 0.0;
+ mus_float_t *state, *ts, *x, *end;
- ap = gen->x;
- dp = gen->state;
- dend = (mus_float_t *)(gen->state + gen->order);
+ x = (mus_float_t *)(gen->x);
+ state = (mus_float_t *)(gen->state + gen->loc);
+ ts = (mus_float_t *)(state + gen->order);
- dp[0] = insig;
- while (dp < dend)
+ (*state) = input;
+ (*ts) = input;
+ state += 2;
+ end = (mus_float_t *)(state + 20);
+
+ while (ts > end)
+ {
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ xout += (*ts) * (*x); ts -= 2; x += 2;
+ }
+ while (ts > state)
{
- xout += (*dp) * (*ap++);
- d2 = d1;
- d1 = (*dp);
- (*dp++) = d2;
- if (dp == dend) break;
- d2 = d1;
- d1 = (*dp);
- (*dp++) = d2;
- ap++; /* every odd-numbered entry in the coeffs array is 0 in this filter */
+ xout += (*ts) * (*x); ts -= 2; x += 2;
}
- return(xout);
+ gen->loc++;
+ if (gen->loc == gen->order)
+ gen->loc = 0;
+
+ return(xout + ((*ts) * (*x)));
#if 0
int i, len;
mus_float_t val = 0.0;
@@ -11677,38 +16126,80 @@ static mus_float_t run_hilbert(flt *gen, mus_float_t insig)
mus_float_t mus_ssb_am_unmodulated(mus_any *ptr, mus_float_t insig)
{
ssbam *gen = (ssbam *)ptr;
- return((mus_oscil_unmodulated(gen->cos_osc) * mus_delay_unmodulated(gen->dly, insig)) +
+#if (!HAVE_SINCOS)
+ return((mus_oscil_unmodulated(gen->cos_osc) * mus_delay_unmodulated_noz(gen->dly, insig)) +
(mus_oscil_unmodulated(gen->sin_osc) * run_hilbert((flt *)(gen->hilbert), insig)));
+#else
+ double cx, sx;
+ sincos(gen->phase, &sx, &cx);
+ gen->phase += gen->freq;
+ return((cx * mus_delay_unmodulated_noz(gen->dly, insig)) +
+ (sx * gen->sign * run_hilbert((flt *)(gen->hilbert), insig)));
+#endif
}
mus_float_t mus_ssb_am(mus_any *ptr, mus_float_t insig, mus_float_t fm)
{
ssbam *gen = (ssbam *)ptr;
- return((mus_oscil_fm(gen->cos_osc, fm) * mus_delay_unmodulated(gen->dly, insig)) +
+#if (!HAVE_SINCOS)
+ return((mus_oscil_fm(gen->cos_osc, fm) * mus_delay_unmodulated_noz(gen->dly, insig)) +
(mus_oscil_fm(gen->sin_osc, fm) * run_hilbert((flt *)(gen->hilbert), insig)));
+#else
+ double cx, sx;
+ sincos(gen->phase, &sx, &cx);
+ gen->phase += (fm + gen->freq);
+ return((cx * mus_delay_unmodulated_noz(gen->dly, insig)) +
+ (sx * gen->sign * run_hilbert((flt *)(gen->hilbert), insig)));
+#endif
}
-static int free_ssb_am(mus_any *ptr)
+static void free_ssb_am(mus_any *ptr)
{
- if (ptr)
- {
- ssbam *gen = (ssbam *)ptr;
- mus_free(gen->dly);
- mus_free(gen->hilbert);
- mus_free(gen->cos_osc);
- mus_free(gen->sin_osc);
- if (gen->coeffs) {clm_free(gen->coeffs); gen->coeffs = NULL;}
- clm_free(ptr);
- }
- return(0);
+ ssbam *gen = (ssbam *)ptr;
+ mus_free(gen->dly);
+ mus_free(gen->hilbert);
+#if (!HAVE_SINCOS)
+ mus_free(gen->cos_osc);
+ mus_free(gen->sin_osc);
+#endif
+ if (gen->coeffs) {free(gen->coeffs); gen->coeffs = NULL;}
+ free(ptr);
+}
+
+
+static mus_any *ssbam_copy(mus_any *ptr)
+{
+ ssbam *g, *p;
+ int bytes;
+
+ p = (ssbam *)ptr;
+ g = (ssbam *)malloc(sizeof(ssbam));
+ memcpy((void *)g, (void *)ptr, sizeof(ssbam));
+
+ g->dly = mus_copy(p->dly);
+ g->hilbert = mus_copy(p->hilbert);
+#if (!HAVE_SINCOS)
+ g->cos_osc = mus_copy(p->cos_osc);
+ g->sin_osc = mus_copy(p->sin_osc);
+#endif
+
+ bytes = p->size * sizeof(mus_float_t);
+ g->coeffs = (mus_float_t *)malloc(bytes);
+ memcpy((void *)(g->coeffs), (void *)(p->coeffs), bytes);
+
+ return((mus_any *)g);
}
static mus_float_t ssb_am_freq(mus_any *ptr)
{
+#if (!HAVE_SINCOS)
return(mus_radians_to_hz(((osc *)((ssbam *)ptr)->sin_osc)->freq));
+#else
+ return(mus_radians_to_hz(((ssbam *)ptr)->freq));
+#endif
}
@@ -11717,40 +16208,60 @@ static mus_float_t ssb_am_set_freq(mus_any *ptr, mus_float_t val)
ssbam *gen = (ssbam *)ptr;
mus_float_t rads;
rads = mus_hz_to_radians(val);
+#if (!HAVE_SINCOS)
((osc *)(gen->sin_osc))->freq = rads;
((osc *)(gen->cos_osc))->freq = rads;
+#else
+ gen->freq = rads;
+#endif
return(val);
}
static mus_float_t ssb_am_increment(mus_any *ptr)
{
+#if (!HAVE_SINCOS)
return(((osc *)((ssbam *)ptr)->sin_osc)->freq);
+#else
+ return(((ssbam *)ptr)->freq);
+#endif
}
static mus_float_t ssb_am_set_increment(mus_any *ptr, mus_float_t val)
{
ssbam *gen = (ssbam *)ptr;
+#if (!HAVE_SINCOS)
((osc *)(gen->sin_osc))->freq = val;
((osc *)(gen->cos_osc))->freq = val;
+#else
+ gen->freq = val;
+#endif
return(val);
}
static mus_float_t ssb_am_phase(mus_any *ptr)
{
+#if (!HAVE_SINCOS)
return(fmod(((osc *)((ssbam *)ptr)->cos_osc)->phase - 0.5 * M_PI, TWO_PI));
+#else
+ return(fmod(((ssbam *)ptr)->phase, TWO_PI));
+#endif
}
static mus_float_t ssb_am_set_phase(mus_any *ptr, mus_float_t val)
{
ssbam *gen = (ssbam *)ptr;
+#if (!HAVE_SINCOS)
if (gen->shift_up)
((osc *)(gen->sin_osc))->phase = val + M_PI;
else ((osc *)(gen->sin_osc))->phase = val;
((osc *)(gen->cos_osc))->phase = val + 0.5 * M_PI;
+#else
+ gen->phase = val;
+#endif
return(val);
}
@@ -11770,11 +16281,16 @@ static mus_float_t ssb_am_set_xcoeff(mus_any *ptr, int index, mus_float_t val) {
static bool ssb_am_equalp(mus_any *p1, mus_any *p2)
{
return((p1 == p2) ||
- ((mus_ssb_am_p((mus_any *)p1)) &&
- (mus_ssb_am_p((mus_any *)p2)) &&
+ ((mus_is_ssb_am((mus_any *)p1)) &&
+ (mus_is_ssb_am((mus_any *)p2)) &&
(((ssbam *)p1)->shift_up == ((ssbam *)p2)->shift_up) &&
+#if (!HAVE_SINCOS)
(mus_equalp(((ssbam *)p1)->sin_osc, ((ssbam *)p2)->sin_osc)) &&
(mus_equalp(((ssbam *)p1)->cos_osc, ((ssbam *)p2)->cos_osc)) &&
+#else
+ (((ssbam *)p1)->freq == ((ssbam *)p2)->freq) &&
+ (((ssbam *)p1)->phase == ((ssbam *)p2)->phase) &&
+#endif
(mus_equalp(((ssbam *)p1)->dly, ((ssbam *)p2)->dly)) &&
(mus_equalp(((ssbam *)p1)->hilbert, ((ssbam *)p2)->hilbert))));
}
@@ -11784,8 +16300,8 @@ static char *describe_ssb_am(mus_any *ptr)
{
ssbam *gen = (ssbam *)ptr;
char *describe_buffer;
- describe_buffer = (char *)clm_malloc(DESCRIBE_BUFFER_SIZE, "describe buffer");
- mus_snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s shift: %s, sin/cos: %f Hz (%f radians), order: %d",
+ describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s shift: %s, sin/cos: %f Hz (%f radians), order: %d",
mus_name(ptr),
(gen->shift_up) ? "up" : "down",
mus_frequency(ptr),
@@ -11828,44 +16344,95 @@ static mus_any_class SSB_AM_CLASS = {
0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0,
0, 0,
- &ssb_am_xcoeffs, 0, 0,
+ &ssb_am_xcoeffs, 0,
&ssb_reset,
- 0, 0, 0
+ 0, &ssbam_copy
};
+static int ssb_am_last_flen = -1;
+static mus_float_t *ssb_am_last_coeffs = NULL;
+
mus_any *mus_make_ssb_am(mus_float_t freq, int order)
{
ssbam *gen;
- int i, k, len;
+ int len, flen;
if ((order & 1) == 0) order++; /* if order is even, the first Hilbert coeff is 0.0 */
- gen = (ssbam *)clm_calloc(1, sizeof(ssbam), S_make_ssb_am);
+ gen = (ssbam *)malloc(sizeof(ssbam));
gen->core = &SSB_AM_CLASS;
if (freq > 0)
gen->shift_up = true;
else gen->shift_up = false;
+#if (!HAVE_SINCOS)
gen->sin_osc = mus_make_oscil(fabs(freq), (gen->shift_up) ? M_PI : 0.0);
gen->cos_osc = mus_make_oscil(fabs(freq), M_PI * 0.5);
+#else
+ if (gen->shift_up) gen->sign = -1.0; else gen->sign = 1.0;
+ gen->freq = mus_hz_to_radians(fabs(freq));
+ gen->phase = 0.0;
+#endif
gen->dly = mus_make_delay(order, NULL, order, MUS_INTERP_NONE);
len = order * 2 + 1;
- gen->coeffs = (mus_float_t *)clm_calloc(len, sizeof(mus_float_t), "make-ssb-am");
- for (i = -order, k = 0; i <= order; i++, k++)
+ flen = len + 1; /* even -- need 4 */
+ if ((flen & 2) != 0) flen += 2;
+ gen->size = flen;
+
+ if ((flen == ssb_am_last_flen) && (ssb_am_last_coeffs))
+ {
+ gen->coeffs = (mus_float_t *)malloc(flen * sizeof(mus_float_t));
+ memcpy((void *)(gen->coeffs), (const void *)ssb_am_last_coeffs, flen * sizeof(mus_float_t));
+ }
+ else
{
- mus_float_t denom, num;
- denom = i * M_PI;
- num = 1.0 - cos(denom);
- if (i == 0)
- gen->coeffs[k] = 0.0;
- else gen->coeffs[k] = (num / denom) * (0.54 + (0.46 * cos(denom / order)));
+ int i, k;
+ gen->coeffs = (mus_float_t *)calloc(flen, sizeof(mus_float_t));
+ for (i = -order, k = 0; i <= order; i++, k++)
+ {
+ mus_float_t denom, num;
+ denom = i * M_PI;
+ num = 1.0 - cos(denom);
+ if (i == 0)
+ gen->coeffs[k] = 0.0;
+ else gen->coeffs[k] = (num / denom) * (0.54 + (0.46 * cos(denom / order)));
+ }
+ /* so odd numbered coeffs are zero */
+
+ /* can't be too fancy here because there might be several of these gens running in parallel at different sizes */
+ if (ssb_am_last_coeffs) free(ssb_am_last_coeffs);
+ ssb_am_last_flen = flen;
+ ssb_am_last_coeffs = (mus_float_t *)malloc(flen * sizeof(mus_float_t));
+ memcpy((void *)(ssb_am_last_coeffs), (const void *)(gen->coeffs), flen * sizeof(mus_float_t));
}
- gen->hilbert = mus_make_fir_filter(len, gen->coeffs, NULL);
+ gen->hilbert = mus_make_fir_filter(flen, gen->coeffs, NULL);
return((mus_any *)gen);
}
+/* (define (hi) (let ((g (make-ssb-am 100.0))) (ssb-am g 1.0) (ssb-am g 0.0))) */
+
+
+
+
+
+/* ---------------- mus-apply ---------------- */
+
+mus_float_t (*mus_run_function(mus_any *g))(mus_any *gen, mus_float_t arg1, mus_float_t arg2)
+{
+ if (g)
+ return(g->core->run);
+ return(NULL);
+}
+
+mus_float_t mus_apply(mus_any *gen, mus_float_t f1, mus_float_t f2)
+{
+ /* what about non-gen funcs such as polynomial, ring_modulate etc? */
+ if ((gen) && (gen->core->run))
+ return((*(gen->core->run))(gen, f1, f2));
+ return(0.0);
+}
/* ---------------- mix files ---------------- */
@@ -11881,13 +16448,16 @@ mus_any *mus_make_ssb_am(mus_float_t freq, int order)
#define ENVELOPED_MIX 5
#define ALL_MIX 6
-static int mix_type(int out_chans, int in_chans, mus_any *umx, mus_any ***envs)
+static int mix_file_type(int out_chans, int in_chans, mus_float_t *mx, mus_any ***envs)
{
- mus_mixer *mx = (mus_mixer *)umx;
if (envs)
{
if ((in_chans == 1) && (out_chans == 1))
- return(ENVELOPED_MONO_MIX);
+ {
+ if (envs[0][0])
+ return(ENVELOPED_MONO_MIX);
+ return(SCALED_MONO_MIX);
+ }
else
{
if (mx)
@@ -11900,14 +16470,14 @@ static int mix_type(int out_chans, int in_chans, mus_any *umx, mus_any ***envs)
int i, j;
if ((in_chans == 1) && (out_chans == 1))
{
- if (mx->vals[0][0] == 1.0)
+ if (mx[0] == 1.0)
return(IDENTITY_MONO_MIX);
return(SCALED_MONO_MIX);
}
- for (i = 0; i < mx->chans; i++)
- for (j = 0; j < mx->chans; j++)
- if (((i == j) && (mx->vals[i][i] != 1.0)) ||
- ((i != j) && (mx->vals[i][j] != 0.0)))
+ for (i = 0; i < out_chans; i++)
+ for (j = 0; j < in_chans; j++)
+ if (((i == j) && (mx[i * in_chans + j] != 1.0)) ||
+ ((i != j) && (mx[i * in_chans + j] != 0.0)))
return(SCALED_MIX);
}
if ((in_chans == 1) && (out_chans == 1))
@@ -11916,159 +16486,195 @@ static int mix_type(int out_chans, int in_chans, mus_any *umx, mus_any ***envs)
}
-void mus_mix_with_reader_and_writer(mus_any *outf, mus_any *inf, mus_long_t out_start, mus_long_t out_frames, mus_long_t in_start, mus_any *umx, mus_any ***envs)
+void mus_file_mix_with_reader_and_writer(mus_any *outf, mus_any *inf,
+ mus_long_t out_start, mus_long_t out_framples, mus_long_t in_start,
+ mus_float_t *mx, int mx_chans,
+ mus_any ***envs)
{
- int in_chans, out_chans, mix_chans, mixtype;
- mus_mixer *mx = (mus_mixer *)umx;
- mus_long_t inc, outc, offi;
- mus_frame *frin, *frthru = NULL;
+ int mixtype, in_chans, out_chans;
+ mus_long_t inc, outc, out_end;
+ mus_float_t *out_data, *in_data, *local_mx;
out_chans = mus_channels(outf);
if (out_chans <= 0)
- mus_error(MUS_NO_CHANNELS, "%s chans: %d", mus_describe(outf), out_chans);
+ mus_error(MUS_NO_CHANNELS, S_mus_file_mix ": %s chans: %d", mus_describe(outf), out_chans);
in_chans = mus_channels(inf);
if (in_chans <= 0)
- mus_error(MUS_NO_CHANNELS, "%s chans: %d", mus_describe(inf), in_chans);
- if (out_chans > in_chans)
- mix_chans = out_chans;
- else mix_chans = in_chans;
+ mus_error(MUS_NO_CHANNELS, S_mus_file_mix ": %s chans: %d", mus_describe(inf), in_chans);
- mixtype = mix_type(out_chans, in_chans, umx, envs);
- frin = (mus_frame *)mus_make_empty_frame(mix_chans);
- frthru = (mus_frame *)mus_make_empty_frame(mix_chans);
+ out_end = out_start + out_framples;
+ mixtype = mix_file_type(out_chans, in_chans, mx, envs);
+
+ in_data = (mus_float_t *)calloc((in_chans < out_chans) ? out_chans : in_chans, sizeof(mus_float_t));
+ out_data = (mus_float_t *)calloc((in_chans < out_chans) ? out_chans : in_chans, sizeof(mus_float_t));
+
+ local_mx = mx;
switch (mixtype)
{
case ENVELOPED_MONO_MIX:
+ {
+ mus_any *e;
+ e = envs[0][0];
+ for (inc = in_start, outc = out_start; outc < out_end; inc++, outc++)
+ {
+ mus_file_to_frample(inf, inc, in_data);
+ mus_outa_to_file(outf, outc, in_data[0] * mus_env(e));
+ }
+ }
+ break;
+
case ENVELOPED_MIX:
- if (umx == NULL)
- mx = (mus_mixer *)mus_make_identity_mixer(mix_chans); /* fall through */
+ if (mx == NULL)
+ {
+ int i;
+ mx_chans = (in_chans < out_chans) ? out_chans : in_chans;
+ local_mx = (mus_float_t *)calloc(mx_chans * mx_chans, sizeof(mus_float_t));
+ for (i = 0; i < mx_chans; i++)
+ local_mx[i * mx_chans + i] = 1.0;
+ }
+ /* fall through */
case ALL_MIX:
/* the general case -- possible envs/scalers on every mixer cell */
- for (offi = 0, inc = in_start, outc = out_start; offi < out_frames; offi++, inc++, outc++)
+ for (inc = in_start, outc = out_start; outc < out_end; inc++, outc++)
{
int j, k;
for (j = 0; j < in_chans; j++)
for (k = 0; k < out_chans; k++)
if (envs[j][k])
- mx->vals[j][k] = mus_env(envs[j][k]);
- mus_frame_to_file(outf,
- outc,
- mus_frame_to_frame(mus_file_to_frame(inf, inc, (mus_any *)frin),
- (mus_any *)mx,
- (mus_any *)frthru));
- }
- if (umx == NULL) mus_free((mus_any *)mx);
+ local_mx[j * mx_chans + k] = mus_env(envs[j][k]);
+ mus_frample_to_file(outf, outc, mus_frample_to_frample(local_mx, mx_chans, mus_file_to_frample(inf, inc, in_data), in_chans, out_data, out_chans));
+ }
+ if (mx == NULL) free(local_mx);
break;
- case IDENTITY_MIX:
case IDENTITY_MONO_MIX:
- for (offi = 0, inc = in_start, outc = out_start; offi < out_frames; offi++, inc++, outc++)
- mus_frame_to_file(outf, outc, mus_file_to_frame(inf, inc, (mus_any *)frin));
+ for (inc = in_start, outc = out_start; outc < out_end; inc++, outc++)
+ {
+ mus_file_to_frample(inf, inc, in_data);
+ mus_outa_to_file(outf, outc, in_data[0]);
+ }
+ break;
+
+ case IDENTITY_MIX:
+ for (inc = in_start, outc = out_start; outc < out_end; inc++, outc++)
+ mus_frample_to_file(outf, outc, mus_file_to_frample(inf, inc, in_data));
break;
case SCALED_MONO_MIX:
+ {
+ mus_float_t scl;
+ scl = mx[0];
+ for (inc = in_start, outc = out_start; outc < out_end; inc++, outc++)
+ {
+ mus_file_to_frample(inf, inc, in_data);
+ mus_outa_to_file(outf, outc, scl * in_data[0]);
+ }
+ }
+ break;
+
case SCALED_MIX:
- for (offi = 0, inc = in_start, outc = out_start; offi < out_frames; offi++, inc++, outc++)
- mus_frame_to_file(outf,
- outc,
- mus_frame_to_frame(mus_file_to_frame(inf, inc, (mus_any *)frin),
- (mus_any *)mx,
- (mus_any *)frthru));
+ for (inc = in_start, outc = out_start; outc < out_end; inc++, outc++)
+ mus_frample_to_file(outf, outc, mus_frample_to_frample(mx, mx_chans, mus_file_to_frample(inf, inc, in_data), in_chans, out_data, out_chans));
break;
}
- mus_free((mus_any *)frin);
- mus_free((mus_any *)frthru);
+ free(in_data);
+ free(out_data);
}
-void mus_mix(const char *outfile, const char *infile, mus_long_t out_start, mus_long_t out_frames, mus_long_t in_start, mus_any *umx, mus_any ***envs)
+void mus_file_mix(const char *outfile, const char *infile,
+ mus_long_t out_start, mus_long_t out_framples, mus_long_t in_start,
+ mus_float_t *mx, int mx_chans,
+ mus_any ***envs)
{
int in_chans, out_chans, min_chans, mixtype;
- out_chans = mus_sound_chans(outfile);
+ out_chans = mus_sound_chans(outfile);
if (out_chans <= 0)
- mus_error(MUS_NO_CHANNELS, "%s chans: %d", outfile, out_chans);
+ mus_error(MUS_NO_CHANNELS, S_mus_file_mix ": %s chans: %d", outfile, out_chans);
in_chans = mus_sound_chans(infile);
if (in_chans <= 0)
- mus_error(MUS_NO_CHANNELS, "%s chans: %d", infile, in_chans);
+ mus_error(MUS_NO_CHANNELS, S_mus_file_mix ": %s chans: %d", infile, in_chans);
if (out_chans > in_chans)
- min_chans = in_chans; else min_chans = out_chans;
+ min_chans = in_chans;
+ else min_chans = out_chans;
- mixtype = mix_type(out_chans, in_chans, umx, envs);
+ mixtype = mix_file_type(out_chans, in_chans, mx, envs);
if (mixtype == ALL_MIX)
{
mus_any *inf, *outf;
/* the general case -- possible envs/scalers on every mixer cell */
outf = mus_continue_sample_to_file(outfile);
- inf = mus_make_file_to_frame(infile);
- mus_mix_with_reader_and_writer(outf, inf, out_start, out_frames, in_start, umx, envs);
- mus_free((mus_any *)inf);
- mus_free((mus_any *)outf);
+ inf = mus_make_file_to_frample(infile);
+ mus_file_mix_with_reader_and_writer(outf, inf, out_start, out_framples, in_start, mx, mx_chans, envs);
+ mus_free(inf);
+ mus_free(outf);
}
else
{
- mus_mixer *mx = (mus_mixer *)umx;
mus_long_t j = 0;
int i, m, ofd, ifd;
mus_float_t scaler;
mus_any *e;
- mus_sample_t **obufs, **ibufs;
- mus_long_t offk, curoutframes;
+ mus_float_t **obufs, **ibufs;
+ mus_long_t offk, curoutframples;
/* highly optimizable cases */
- obufs = (mus_sample_t **)clm_malloc(out_chans * sizeof(mus_sample_t *), "mix output");
+ obufs = (mus_float_t **)malloc(out_chans * sizeof(mus_float_t *));
for (i = 0; i < out_chans; i++)
- obufs[i] = (mus_sample_t *)clm_calloc_atomic(clm_file_buffer_size, sizeof(mus_sample_t), "mix output buffers");
- ibufs = (mus_sample_t **)clm_malloc(in_chans * sizeof(mus_sample_t *), "mix input");
+ obufs[i] = (mus_float_t *)malloc(clm_file_buffer_size * sizeof(mus_float_t));
+
+ ibufs = (mus_float_t **)malloc(in_chans * sizeof(mus_float_t *));
for (i = 0; i < in_chans; i++)
- ibufs[i] = (mus_sample_t *)clm_calloc_atomic(clm_file_buffer_size, sizeof(mus_sample_t), "mix input buffers");
+ ibufs[i] = (mus_float_t *)malloc(clm_file_buffer_size * sizeof(mus_float_t));
+
ifd = mus_sound_open_input(infile);
- mus_file_seek_frame(ifd, in_start);
- mus_file_read(ifd, 0, clm_file_buffer_size - 1, in_chans, ibufs);
+ mus_file_seek_frample(ifd, in_start);
+ mus_file_read(ifd, in_start, clm_file_buffer_size, in_chans, ibufs);
ofd = mus_sound_reopen_output(outfile,
out_chans,
- mus_sound_data_format(outfile),
+ mus_sound_sample_type(outfile),
mus_sound_header_type(outfile),
mus_sound_data_location(outfile));
- curoutframes = mus_sound_frames(outfile);
- mus_file_seek_frame(ofd, out_start);
- mus_file_read(ofd, 0, clm_file_buffer_size - 1, out_chans, obufs);
- mus_file_seek_frame(ofd, out_start);
+ curoutframples = mus_sound_framples(outfile);
+ mus_file_seek_frample(ofd, out_start);
+ mus_file_read(ofd, out_start, clm_file_buffer_size, out_chans, obufs);
+ mus_file_seek_frample(ofd, out_start);
switch (mixtype)
{
case IDENTITY_MONO_MIX:
- for (offk = 0, j = 0; offk < out_frames; offk++, j++)
+ for (offk = 0, j = 0; offk < out_framples; offk++, j++)
{
if (j == clm_file_buffer_size)
{
mus_file_write(ofd, 0, j - 1, out_chans, obufs);
j = 0;
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ofd, 0, clm_file_buffer_size - 1, out_chans, obufs);
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ifd, 0, clm_file_buffer_size - 1, in_chans, ibufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ofd, out_start + offk, clm_file_buffer_size, out_chans, obufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ifd, in_start + offk, clm_file_buffer_size, in_chans, ibufs);
}
obufs[0][j] += ibufs[0][j];
}
break;
case IDENTITY_MIX:
- for (offk = 0, j = 0; offk < out_frames; offk++, j++)
+ for (offk = 0, j = 0; offk < out_framples; offk++, j++)
{
if (j == clm_file_buffer_size)
{
mus_file_write(ofd, 0, j - 1, out_chans, obufs);
j = 0;
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ofd, 0, clm_file_buffer_size - 1, out_chans, obufs);
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ifd, 0, clm_file_buffer_size - 1, in_chans, ibufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ofd, out_start + offk, clm_file_buffer_size, out_chans, obufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ifd, in_start + offk, clm_file_buffer_size, in_chans, ibufs);
}
for (i = 0; i < min_chans; i++)
obufs[i][j] += ibufs[i][j];
@@ -12076,105 +16682,92 @@ void mus_mix(const char *outfile, const char *infile, mus_long_t out_start, mus_
break;
case SCALED_MONO_MIX:
- scaler = mx->vals[0][0];
- for (offk = 0, j = 0; offk < out_frames; offk++, j++)
+ scaler = mx[0];
+ for (offk = 0, j = 0; offk < out_framples; offk++, j++)
{
if (j == clm_file_buffer_size)
{
mus_file_write(ofd, 0, j - 1, out_chans, obufs);
j = 0;
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ofd, 0, clm_file_buffer_size - 1, out_chans, obufs);
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ifd, 0, clm_file_buffer_size - 1, in_chans, ibufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ofd, out_start + offk, clm_file_buffer_size, out_chans, obufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ifd, in_start + offk, clm_file_buffer_size, in_chans, ibufs);
}
- obufs[0][j] += (mus_sample_t)(scaler * ibufs[0][j]);
+ obufs[0][j] += (mus_float_t)(scaler * ibufs[0][j]);
}
break;
case SCALED_MIX:
- for (offk = 0, j = 0; offk < out_frames; offk++, j++)
+ for (offk = 0, j = 0; offk < out_framples; offk++, j++)
{
if (j == clm_file_buffer_size)
{
mus_file_write(ofd, 0, j - 1, out_chans, obufs);
j = 0;
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ofd, 0, clm_file_buffer_size- 1 , out_chans, obufs);
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ifd, 0, clm_file_buffer_size - 1, in_chans, ibufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ofd, out_start + offk, clm_file_buffer_size , out_chans, obufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ifd, in_start + offk, clm_file_buffer_size, in_chans, ibufs);
}
for (i = 0; i < min_chans; i++)
for (m = 0; m < in_chans; m++)
- obufs[i][j] += (mus_sample_t)(ibufs[m][j] * mx->vals[m][i]);
+ obufs[i][j] += (mus_float_t)(ibufs[m][j] * mx[m * mx_chans + i]);
}
break;
case ENVELOPED_MONO_MIX:
e = envs[0][0];
- for (offk = 0, j = 0; offk < out_frames; offk++, j++)
+ for (offk = 0, j = 0; offk < out_framples; offk++, j++)
{
if (j == clm_file_buffer_size)
{
mus_file_write(ofd, 0, j - 1, out_chans, obufs);
j = 0;
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ofd, 0, clm_file_buffer_size - 1, out_chans, obufs);
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ifd, 0, clm_file_buffer_size - 1, in_chans, ibufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ofd, out_start + offk, clm_file_buffer_size, out_chans, obufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ifd, in_start + offk, clm_file_buffer_size, in_chans, ibufs);
}
- obufs[0][j] += (mus_sample_t)(mus_env(e) * ibufs[0][j]);
+ obufs[0][j] += (mus_float_t)(mus_env(e) * ibufs[0][j]);
}
break;
case ENVELOPED_MIX:
e = envs[0][0];
- for (offk = 0, j = 0; offk < out_frames; offk++, j++)
+ for (offk = 0, j = 0; offk < out_framples; offk++, j++)
{
if (j == clm_file_buffer_size)
{
mus_file_write(ofd, 0, j - 1, out_chans, obufs);
j = 0;
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ofd, 0, clm_file_buffer_size - 1, out_chans, obufs);
- mus_file_seek_frame(ofd, out_start + offk);
- mus_file_read(ifd, 0, clm_file_buffer_size - 1, in_chans, ibufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ofd, out_start + offk, clm_file_buffer_size, out_chans, obufs);
+ mus_file_seek_frample(ofd, out_start + offk);
+ mus_file_read(ifd, in_start + offk, clm_file_buffer_size, in_chans, ibufs);
}
scaler = mus_env(e);
for (i = 0; i < min_chans; i++)
- obufs[i][j] += (mus_sample_t)(scaler * ibufs[i][j]);
+ obufs[i][j] += (mus_float_t)(scaler * ibufs[i][j]);
}
break;
-
}
if (j > 0)
mus_file_write(ofd, 0, j - 1, out_chans, obufs);
- if (curoutframes < (out_frames + out_start))
- curoutframes = out_frames + out_start;
- mus_sound_close_output(ofd,
- curoutframes * out_chans * mus_bytes_per_sample(mus_sound_data_format(outfile)));
+ if (curoutframples < (out_framples + out_start))
+ curoutframples = out_framples + out_start;
+ mus_sound_close_output(ofd, curoutframples * out_chans * mus_bytes_per_sample(mus_sound_sample_type(outfile)));
mus_sound_close_input(ifd);
- for (i = 0; i < in_chans; i++) clm_free(ibufs[i]);
- clm_free(ibufs);
- for (i = 0; i < out_chans; i++) clm_free(obufs[i]);
- clm_free(obufs);
+ for (i = 0; i < in_chans; i++) free(ibufs[i]);
+ free(ibufs);
+ for (i = 0; i < out_chans; i++) free(obufs[i]);
+ free(obufs);
}
}
-/* ---------------- mus-apply ---------------- */
-
-mus_float_t mus_apply(mus_any *gen, mus_float_t f1, mus_float_t f2)
-{
- /* what about non-gen funcs such as polynomial, ring_modulate etc? */
- if ((gen) && (MUS_RUN_P(gen)))
- return(MUS_RUN(gen, f1, f2));
- return(0.0);
-}
-
-
/* ---------------- init clm ---------------- */
void mus_initialize(void)
@@ -12183,13 +16776,13 @@ void mus_initialize(void)
#define ALAW_ZERO 213
#define UBYTE_ZERO 128
- mus_class_tag = MUS_INITIAL_GEN_TAG;
+ mus_generator_type = MUS_INITIAL_GEN_TAG;
sampling_rate = MUS_DEFAULT_SAMPLING_RATE;
w_rate = (TWO_PI / MUS_DEFAULT_SAMPLING_RATE);
array_print_length = MUS_DEFAULT_ARRAY_PRINT_LENGTH;
clm_file_buffer_size = MUS_DEFAULT_FILE_BUFFER_SIZE;
-#if HAVE_FFTW3 && HAVE_COMPLEX_TRIG && (!__cplusplus)
+#if HAVE_FFTW3 && HAVE_COMPLEX_TRIG
last_c_fft_size = 0;
/* is there a problem if the caller built fftw with --enable-threads?
* How to tell via configure that we need to initialize the thread stuff in libfftw?
@@ -12199,15 +16792,15 @@ void mus_initialize(void)
sincs = 0;
locsig_warned = NULL;
- data_format_zero = (int *)clm_calloc(MUS_NUM_DATA_FORMATS, sizeof(int), "init mus module");
- data_format_zero[MUS_MULAW] = MULAW_ZERO;
- data_format_zero[MUS_ALAW] = ALAW_ZERO;
- data_format_zero[MUS_UBYTE] = UBYTE_ZERO;
+ sample_type_zero = (int *)calloc(MUS_NUM_SAMPLES, sizeof(int));
+ sample_type_zero[MUS_MULAW] = MULAW_ZERO;
+ sample_type_zero[MUS_ALAW] = ALAW_ZERO;
+ sample_type_zero[MUS_UBYTE] = UBYTE_ZERO;
#if MUS_LITTLE_ENDIAN
- data_format_zero[MUS_UBSHORT] = 0x80;
- data_format_zero[MUS_ULSHORT] = 0x8000;
+ sample_type_zero[MUS_UBSHORT] = 0x80;
+ sample_type_zero[MUS_ULSHORT] = 0x8000;
#else
- data_format_zero[MUS_UBSHORT] = 0x8000;
- data_format_zero[MUS_ULSHORT] = 0x80;
-#endif
+ sample_type_zero[MUS_UBSHORT] = 0x8000;
+ sample_type_zero[MUS_ULSHORT] = 0x80;
+#endif
}
diff --git a/clm.fs b/clm.fs
index 1543cec..9f49a62 100644
--- a/clm.fs
+++ b/clm.fs
@@ -1,91 +1,147 @@
\ clm.fs -- clm related base words, with-sound and friends
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Mon Mar 15 19:25:58 CET 2004
-\ Changed: Sat Feb 19 17:26:08 CET 2011
-
-\ Commentary:
+\ Created: 04/03/15 19:25:58
+\ Changed: 15/02/25 16:05:57
\
-\ clm-print ( fmt :optional args -- )
-\ clm-message ( fmt :optional args -- )
+\ @(#)clm.fs 1.121 2/25/15
+
+\ clm-print ( fmt :optional args -- )
+\ clm-message ( fmt :optional args -- )
\
-\ now@ ( -- secs )
-\ now! ( secs -- )
-\ step ( secs -- )
-\ tempo@ ( -- secs )
-\ tempo! ( secs -- )
-\ interval->hertz ( n -- r )
-\ keynum->hertz ( n -- r )
-\ hertz->keynum ( r -- n )
-\ bpm->seconds ( bpm -- secs )
-\ rhythm->seconds ( rhy -- secs )
+\ now@ ( -- secs )
+\ now! ( secs -- )
+\ step ( secs -- )
+\ tempo@ ( -- secs )
+\ tempo! ( secs -- )
+\ interval->hertz ( n -- r )
+\ keynum->hertz ( n -- r )
+\ hertz->keynum ( r -- n )
+\ bpm->seconds ( bpm -- secs )
+\ rhythm->seconds ( rhy -- secs )
\
-\ tempnam ( -- name )
-\ fth-tempnam ( -- name )
-\ make-default-comment ( -- str )
-\ times->samples ( start dur -- len beg )
-\ normalize-partials ( parts1 -- parts2 )
+\ tempnam ( -- name )
+\ fth-tempnam ( -- name )
+\ make-default-comment ( -- str )
+\ times->samples ( start dur -- len beg )
\
-\ ws-local-variables ( -- )
-\ ws-info ( start dur vars -- start dur )
-\ run ( start dur -- )
-\ run-instrument ( start dur locsig-args -- )
-\ end-run ( sample -- )
-\ reverb-info ( caller in-chans out-chans -- )
-\ instrument: ( -- )
-\ ;instrument ( -- )
-\ event: ( -- )
-\ ;event ( -- )
+\ ws-local-variables ( -- )
+\ ws-info ( start dur vars -- start dur )
+\ run ( start dur -- )
+\ run-instrument ( start dur locsig-args -- )
+\ end-run ( sample -- )
+\ reverb-info ( caller in-chans out-chans -- )
+\ instrument: ( "name" -- )
+\ ;instrument ( -- )
+\ event: ( "name" -- )
+\ ;event ( -- )
+\
+\ find-file ( file -- fname|#f )
+\ snd-info ( output :key reverb-file-name scaled? timer -- )
\
-\ find-file ( file -- fname|#f )
-\ snd-info ( output :key reverb-file-name scaled? timer -- )
-\ play-sound ( input :key verbose dac-size audio-format -- )
-\ record-sound ( output keyword-args -- )
+\ clm-mix ( ifile keyword-args -- )
+\ ws-output ( ws -- fname )
+\ with-sound ( body-xt keyword-args -- ws )
+\ clm-load ( fname keyword-args -- ws )
+\ with-current-sound ( body-xt :key offset scaled-to scaled-by -- )
+\ scaled-to ( body-xt scl -- )
+\ scaled-by ( body-xt scl -- )
+\ with-offset ( body-xt secs -- )
+\ with-mix ( body-str|nil args fname start -- )
+\ sound-let ( ws-xt-lst body-xt -- )
\
-\ clm-mix ( infile :key output output-frame frames input-frame scaler -- )
-\ ws-output ( ws -- fname )
-\ with-sound ( body-xt keyword-args -- ws )
-\ clm-load ( fname keyword-args -- ws )
-\ with-current-sound ( body-xt :key offset scaled-to scaled-by -- )
-\ scaled-to ( body-xt scl -- )
-\ scaled-by ( body-xt scl -- )
-\ with-offset ( body-xt secs -- )
-\ with-mix ( body-str|nil args fname start -- )
-\ sound-let ( ws-xt-lst body-xt -- )
+\ play-sound ( :key verbose player :optional input -- )
+\
+\ example instruments:
+\ simp ( star dur freq amp -- )
+\ src-simp ( start dur amp sr sr-env fname -- )
+\ conv-simp ( start dur filt fname amp -- )
+\ arpeggio ( start dur freq amp :key ampenv offset -- )
+\
+\ from generators.scm:
+\ make-waveshape ( :optional freq parts wave size -- )
+\ waveshape ( gen :optional index fm -- val )
+\ waveshape? ( obj -- f )
+\ partials->waveshape ( part :optional size -- wave )
+\ make-sum-of-sines ( :key sines frequency initial-phase -- gen )
+\ sum-of-sines ( gen :optional fm -- val )
+\ sum-of-sines? ( obj -- f )
+\ make-sum-of-cosines ( :key cosines frequency initial-phase -- gen )
+\ sum-of-cosines ( gen :optional fm -- val )
+\ sum-of-cosines? ( obj -- f )
+\ make-sine-summation ( :key frequency initial-phase n a ratio -- gen )
+\ sine-summation ( gen :optional fm -- val )
+\ sine-summation? ( obj -- f )
[ifundef] flog10
- <'> flog alias flog10
- <'> fln alias flog
- <'> flnp1 alias flogp1
+ <'> flog alias flog10
+ <'> fln alias flog
+ <'> flnp1 alias flogp1
[then]
\ if configured --with-shared-sndlib
-'sndlib provided? not [if] dl-load sndlib Init_sndlib [then]
-
-'snd provided? not [if]
- <'> noop alias sound?
- <'> noop alias open-sound
- <'> noop alias find-sound
- <'> noop alias save-sound
- <'> noop alias close-sound
- <'> noop alias play
- <'> noop alias maxamp
- <'> noop alias frames
- <'> noop alias scale-channel
+'sndlib provided? [unless] dl-load sndlib Init_sndlib [then]
+
+'snd provided? [unless]
+ <'> noop alias close-sound
+ <'> noop alias find-sound
+ <'> noop alias open-sound
+ <'> noop alias save-sound
+ <'> noop alias scale-channel
+ <'> noop alias sound?
+ <'> noop alias framples
+
+ \ Some generic words for non-Snd use.
+ : channels <{ :optional obj #f -- n }>
+ obj string? if
+ obj mus-sound-chans
+ else
+ obj mus-generator? if
+ obj mus-channels
+ else
+ obj object-length
+ then
+ then
+ ;
+
+ : srate <{ :optional obj #f -- n }>
+ obj string? if
+ obj mus-sound-srate
+ else
+ mus-srate f>s
+ then
+ ;
+
+ : maxamp <{ :optional snd #f chn #f edpos #f -- r }>
+ snd string? if
+ snd mus-sound-maxamp
+ else
+ snd vct? if
+ snd vct-peak
+ else
+ 0.0
+ then
+ then
+ ;
[then]
[ifundef] clm-print
- \ "hello" clm-print
- \ "file %s, line %d\n" '( "oboe.snd" 123 ) clm-print
- 'snd provided? [if]
- : clm-print ( fmt :optional args -- ) fth-format snd-print drop ;
- [else]
- <'> fth-print alias clm-print ( fmt :optional args -- )
- [then]
+ \ "hello" clm-print
+ \ "file %s, line %d\n" '( "oboe.snd" 123 ) clm-print
+ [ifdef] snd-print
+ : clm-print ( fmt :optional args -- )
+ string-format snd-print drop
+ ;
+ [else]
+ <'> fth-print alias clm-print ( fmt :optional args -- )
+ [then]
[then]
-\ puts a comment sign before output string and adds a carriage return
-: clm-message <{ fmt :optional args nil -- }> $" \\ %s\n" '( fmt args fth-format ) clm-print ;
+\ Put comment sign before output string and finish with carriage return.
+: clm-message ( fmt :optional args -- )
+ string-format { msg }
+ "\\ %s\n" '( msg ) clm-print
+;
\ === Notelist ===
hide
@@ -94,27 +150,35 @@ hide
0.25 value *clm-beat*
set-current
-: now@ ( -- secs ) *clm-current-time* ;
-: now! ( secs -- ) to *clm-current-time* ;
-: step ( secs -- ) now@ f+ now! ;
-: tempo@ ( -- secs ) *clm-tempo* ;
-: tempo! ( secs -- ) to *clm-tempo* ;
+: now@ ( -- secs ) *clm-current-time* ;
+: now! ( secs -- ) to *clm-current-time* ;
+: step ( secs -- ) now@ f+ now! ;
+: tempo@ ( -- secs ) *clm-tempo* ;
+: tempo! ( secs -- ) to *clm-tempo* ;
previous
\ --- Pitches ---
6.875 constant lowest-freq
-: interval->hertz ( n -- r ) { n } 2.0 12.0 n 3.0 f+ f+ 12.0 f/ f** lowest-freq f* ;
-: keynum->hertz ( n -- r ) { n } 2.0 n 3.0 f+ 12.0 f/ f** lowest-freq f* ;
-: hertz->keynum ( r -- n ) lowest-freq f/ 2.0 flogn 12.0 f* 3.0 f- f>s ;
+: interval->hertz { n -- 5 }
+ 2.0 12.0 n 3.0 f+ f+ 12.0 f/ f** lowest-freq f*
+;
+
+: keynum->hertz { n -- r }
+ 2.0 n 3.0 f+ 12.0 f/ f** lowest-freq f*
+;
+
+: hertz->keynum ( r -- n )
+ lowest-freq f/ 2.0 flogn 12.0 f* 3.0 f- f>s
+;
hide
: pitch ( interval octave "name" --; self -- freq )
- { interval octave }
- 2.0 octave 1.0 f+ 12.0 f* interval 3.0 f+ f+ 12.0 f/ f** lowest-freq f*
- create ,
- does> ( self -- freq )
- @
+ { interval octave }
+ 2.0 octave 1.0 f+ 12.0 f* interval 3.0 f+ f+ 12.0 f/ f** lowest-freq f*
+ create ,
+ does> ( self -- freq )
+ @
;
set-current
@@ -192,14 +256,14 @@ set-current
previous
\ --- Note length ---
-: bpm->seconds ( bpm -- secs ) 60.0 swap f/ ;
-: rhythm->seconds ( rhy -- secs ) 4.0 tempo@ bpm->seconds f* f* ;
+: bpm->seconds ( bpm -- secs ) 60.0 swap f/ ;
+: rhythm->seconds ( rhy -- secs ) 4.0 tempo@ bpm->seconds f* f* ;
hide
: notelength ( scale "name" --; self -- r )
- create ,
- does> ( self -- r )
- @ rhythm->seconds
+ create ,
+ does> ( self -- r )
+ @ ( scale ) rhythm->seconds ( secs )
;
set-current
@@ -217,51 +281,65 @@ set-current
previous
\ === Global User Variables (settable in ~/.snd_forth or ~/.fthrc) ===
-$" fth 19-Feb-2011" value *clm-version*
-#f value *locsig*
-mus-lshort value *clm-audio-format*
-#f value *clm-comment*
-1.0 value *clm-decay-time*
-#f value *clm-delete-reverb*
-"test.snd" value *clm-file-name*
-#f value *clm-notehook*
-#f value *clm-play*
-#f value *clm-player*
-#f value *clm-reverb*
-1 value *clm-reverb-channels*
-#() value *clm-reverb-data*
-"test.reverb" value *clm-reverb-file-name*
-#f value *clm-statistics*
-#f value *clm-verbose*
-#f value *clm-debug*
-\ array of directories containing sound files
+"fth 2015/02/25" value *clm-version*
+#f value *locsig*
+mus-lshort value *clm-audio-format*
+#f value *clm-comment*
+1.0 value *clm-decay-time*
+#f value *clm-delete-reverb*
+"test.snd" value *clm-file-name*
+#f value *clm-notehook*
+#f value *clm-play*
+#f value *clm-player*
+#f value *clm-reverb*
+1 value *clm-reverb-channels*
+#() value *clm-reverb-data*
+"test.reverb" value *clm-reverb-file-name*
+#f value *clm-statistics*
+#f value *clm-verbose*
+#f value *clm-debug*
"CLM_SEARCH_PATH" getenv "." || ":" string-split value *clm-search-list*
-#() value *clm-instruments* \ array of arrays #( ins-name start dur local-vars )
+
+<'> *clm-search-list*
+"List of directories with sound files." help-set!
+#() value *clm-instruments*
+<'> *clm-instruments*
+"List of #( ins-name start dur local-vars ) elements. \
+Instruments using RUN or RUN-INSTRUMENT add entries to the list." help-set!
'snd provided? [unless]
- 1 constant default-output-chans
- 44100 constant default-output-srate
- mus-next constant default-output-header-type
- mus-lfloat constant default-output-data-format
- 0 constant audio-output-device
- 512 constant dac-size
+ 1 constant default-output-chans
+ 44100 constant default-output-srate
+ mus-next constant default-output-header-type
+ mus-lfloat constant default-output-sample-type
+ 1024 constant dac-size
[then]
default-output-chans value *clm-channels*
default-output-srate value *clm-srate*
locsig-type value *clm-locsig-type*
default-output-header-type value *clm-header-type*
-default-output-data-format value *clm-data-format*
-audio-output-device value *clm-output-device*
+default-output-sample-type value *clm-sample-type*
dac-size value *clm-rt-bufsize*
mus-file-buffer-size value *clm-file-buffer-size*
mus-clipping value *clm-clipped*
mus-array-print-length value *clm-array-print-length*
clm-table-size value *clm-table-size*
clm-default-frequency value *clm-default-frequency*
-
-<'> *clm-default-frequency* lambda: <{ val -- res }> val set-clm-default-frequency ; trace-var
-<'> *clm-table-size* lambda: <{ val -- res }> val set-clm-table-size ; trace-var
+
+\ for backward compatibility
+*clm-sample-type* value *clm-data-format*
+<'> *clm-data-format* lambda: <{ val -- res }>
+ val to *clm-sample-type*
+ val
+; trace-var
+
+<'> *clm-default-frequency* lambda: <{ val -- res }>
+ val set-clm-default-frequency
+; trace-var
+<'> *clm-table-size* lambda: <{ val -- res }>
+ val set-clm-table-size
+; trace-var
\ internal global variables
*clm-channels* value *channels*
@@ -269,130 +347,129 @@ clm-default-frequency value *clm-default-frequency*
*clm-notehook* value *notehook*
'snd provided? [if]
- <'> snd-tempnam alias fth-tempnam
+ <'> snd-tempnam alias fth-tempnam
[else]
- hide
- user *fth-file-number*
- set-current
+ hide
+ user *fth-file-number*
+ set-current
- : fth-tempnam ( -- name )
- doc" Looks for environment variables TMP, TEMP, and TMPDIR. \
-If none of them is set, uses /tmp as temporary path. \
+ : fth-tempnam ( -- name )
+ doc" Look for environment variables TMP, TEMP, and TMPDIR. \
+If none of them is set, use /tmp as temporary path. \
Produces something like:\n\
/tmp/fth-12345-1.snd\n\
/tmp/fth-12345-2.snd\n\
/tmp/fth-12345-3.snd\n\
..."
- 1 *fth-file-number* +!
- environ { env }
- "%s/fth-%d-%d.snd"
- env "TMP" array-assoc-ref ?dup-if
- ( tmp )
- else
- env "TEMP" array-assoc-ref ?dup-if
- ( temp )
- else
- env "TMPDIR" array-assoc-ref ?dup-if
- ( tmpdir )
- else
- "/tmp"
- then
- then
- then ( tmp ) getpid *fth-file-number* @ 3 >array string-format
- ;
- previous
+ 1 *fth-file-number* +!
+ environ { env }
+ "%s/fth-%d-%d.snd"
+ env "TMP" array-assoc-ref ?dup-if
+ ( tmp )
+ else
+ env "TEMP" array-assoc-ref ?dup-if
+ ( temp )
+ else
+ env "TMPDIR" array-assoc-ref ?dup-if
+ ( tmpdir )
+ else
+ "/tmp"
+ then
+ then
+ then ( tmp ) getpid *fth-file-number* @ 3 >array string-format
+ ;
+ previous
[then]
: make-default-comment ( -- str )
- $" \\ Written %s by %s at %s using clm (%s)"
- #( $" %a %d-%b-%y %H:%M %Z" current-time strftime
- getlogin
- gethostname
- *clm-version* ) string-format
-;
-
-: times->samples ( start dur -- len beg )
- { start dur }
- start seconds->samples { beg }
- dur seconds->samples { len }
- beg len d+ beg
+ "\\ Written %s by %s at %s using clm (%s)"
+ #( "%a %d-%b-%y %H:%M %Z" current-time strftime
+ getlogin
+ gethostname
+ *clm-version* ) string-format
;
-: normalize-partials ( parts1 -- parts2 )
- { parts1 }
- 0.0 ( sum ) parts1 object-length 1 ?do parts1 i object-ref fabs f+ 2 +loop
- dup f0= if
- $" all parts have 0.0 amplitude: %s" #( parts1 ) string-format warning
- ( sum ) drop parts1
- else
- ( sum ) 1/f { scl }
- parts1 map i 2 mod if *key* scl f* else *key* then end-map ( parts2 )
- then
+: times->samples { start dur -- len beg }
+ start seconds->samples { beg }
+ dur seconds->samples { len }
+ beg len d+ beg
;
\ === With-Sound Run-Instrument ===
-$" with-sound error" create-exception with-sound-error
-$" with-sound interrupt" create-exception with-sound-interrupt
+"with-sound error" create-exception with-sound-error
+"with-sound interrupt" create-exception with-sound-interrupt
#() value *ws-args* \ array for recursive with-sound calls
#f value *clm-current-instrument* \ current instrument set in INSTRUMENT:
: ws-local-variables ( -- )
- nil { vals }
- *clm-instruments* empty? if
- $" *clm-instruments* is empty" #() clm-message
- else
- "" #() clm-message
- *clm-instruments* each to vals
- $" === %s [%.3f-%.3f] ===" #(
- vals 0 array-ref
- vals 1 array-ref
- vals 2 array-ref ) clm-message
- vals 3 array-ref each ( var-val-cell ) $" %s = %s" swap clm-message end-each
- "" #() clm-message
- end-each
- then
+ nil { vals }
+ *clm-instruments* empty? if
+ "*clm-instruments* is empty" #() clm-message
+ else
+ "" #() clm-message
+ *clm-instruments* each to vals
+ "=== %s [%.3f-%.3f] ==="
+ #( vals 0 array-ref
+ vals 1 array-ref
+ vals 2 array-ref ) clm-message
+ vals 3 array-ref each { var }
+ \ var: '( name . value ) )
+ "%s = %s" var clm-message
+ end-each
+ "" #() clm-message
+ end-each
+ then
;
-: ws-info ( start dur vars -- start dur )
- { start dur vars }
- *clm-instruments* #( *clm-current-instrument* start dur vars ) array-push to *clm-instruments*
- *notehook* word? if
- *notehook* #( *clm-current-instrument* start dur ) run-proc drop
- then
- start dur
+: ws-info { start dur vars -- start dur }
+ *clm-instruments*
+ #( *clm-current-instrument* start dur vars ) array-push drop
+ *notehook* word? if
+ *notehook* #( *clm-current-instrument* start dur ) run-proc drop
+ then
+ start dur
;
hide
-: (run) ( start dur vars -- limit begin ) ws-info times->samples ;
-
-: (run-instrument) ( start dur args vars -- limit begin )
- { start dur args vars }
- args hash? unless #{} to args then
- :degree args :degree hash-ref 0.0 ||
- :distance args :distance hash-ref 1.0 ||
- :reverb args :reverb hash-ref 0.05 ||
- :channels args :channels hash-ref *channels* ||
- :output args :output hash-ref *output* ||
- :revout args :revout hash-ref *reverb* ||
- :type args :type hash-ref locsig-type || make-locsig to *locsig*
- \ we set channel 3/4 if any to 0.5 * channel 1/2
- *output* mus-output? if
- *output* mus-channels 2 > if
- *locsig* 2 *locsig* 0 locsig-ref f2/ locsig-set! drop
- *output* mus-channels 3 > if
- *locsig* 3 *locsig* 1 locsig-ref f2/ locsig-set! drop
- then
- then
- then
- *reverb* mus-output? if
- *reverb* mus-channels 2 > if
- *locsig* 2 *locsig* 0 locsig-reverb-ref f2/ locsig-reverb-set! drop
- *reverb* mus-channels 3 > if
- *locsig* 3 *locsig* 1 locsig-reverb-ref f2/ locsig-reverb-set! drop
- then
- then
- then
- start dur vars (run)
+: (run) ( start dur vars -- limit begin ) ws-info times->samples ;
+
+: (run-instrument) { start dur args vars -- limit begin }
+ args hash? unless
+ #{} to args
+ then
+ :degree args :degree hash-ref 0.0 ||
+ :distance args :distance hash-ref 1.0 ||
+ :reverb args :reverb hash-ref 0.05 ||
+ :channels args :channels hash-ref *channels* ||
+ :output args :output hash-ref *output* ||
+ :revout args :revout hash-ref *reverb* ||
+ :type args :type hash-ref locsig-type || make-locsig to *locsig*
+ \ we set channel 3/4 if any to 0.5 * channel 1/2
+ *output* mus-output? if
+ *output* mus-channels 2 > if
+ *locsig* 2
+ *locsig* 0 locsig-ref f2/
+ locsig-set! drop
+ *output* mus-channels 3 > if
+ *locsig* 3
+ *locsig* 1 locsig-ref f2/
+ locsig-set! drop
+ then
+ then
+ then
+ *reverb* mus-output? if
+ *reverb* mus-channels 2 > if
+ *locsig* 2
+ *locsig* 0 locsig-reverb-ref f2/
+ locsig-reverb-set! drop
+ *reverb* mus-channels 3 > if
+ *locsig* 3
+ *locsig* 1 locsig-reverb-ref f2/
+ locsig-reverb-set! drop
+ then
+ then
+ then
+ start dur vars (run)
;
: (end-run) { val idx -- } *locsig* idx val locsig drop ;
@@ -416,40 +493,50 @@ set-current
\
\ 0.0 1.0 RUN ... LOOP
\ 0.0 1.0 #{ :degree 45.0 } RUN-INSTRUMENT ... END-RUN
-: run ( start dur -- )
- postpone local-variables postpone (run) postpone ?do
+: run ( start dur -- )
+ postpone local-variables
+ postpone (run)
+ postpone ?do
; immediate compile-only
: run-instrument ( start dur locsig-args -- )
- postpone local-variables postpone (run-instrument) postpone ?do
+ postpone local-variables
+ postpone (run-instrument)
+ postpone ?do
; immediate compile-only
-: end-run ( sample -- )
- postpone r@ postpone (end-run) postpone loop
+: end-run ( sample -- )
+ postpone r@
+ postpone (end-run)
+ postpone loop
; immediate compile-only
previous
-: reverb-info ( caller in-chans out-chans -- )
- { caller in-chans out-chans }
- $" %s on %d in and %d out channels" #( caller in-chans out-chans ) clm-message
+: reverb-info { caller in-chans out-chans -- }
+ "%s on %d in and %d out channels"
+ #( caller in-chans out-chans ) clm-message
;
\ === Helper functions for instruments ===
hide
-: ins-info ( ins-name -- ) to *clm-current-instrument* ;
-: event-info ( ev-name -- ) *clm-verbose* if #() clm-message else drop then ;
+: ins-info ( ins-name -- ) to *clm-current-instrument* ;
+: event-info { ename -- }
+ *clm-verbose* if
+ ename #() clm-message
+ then
+;
set-current
-: instrument: ( -- )
- >in @ parse-word $>string { ins-name } >in !
- :
- ins-name postpone literal <'> ins-info compile,
+: instrument: ( "name" -- )
+ >in @ parse-word $>string { ins-name } >in !
+ :
+ ins-name postpone literal <'> ins-info compile,
;
-: event: ( -- )
- >in @ parse-word $>string { ev-name } >in !
- :
- ev-name postpone literal <'> event-info compile,
+: event: ( "name" -- )
+ >in @ parse-word $>string { ev-name } >in !
+ :
+ ev-name postpone literal <'> event-info compile,
;
: ;instrument ( -- ) postpone ; ; immediate
@@ -458,504 +545,499 @@ previous
\ === Playing and Recording Sound Files ===
: find-file ( file -- fname|#f )
- doc" Returns the possibly full path name of FILE if FILE exists or \
-if FILE was found in *CLM-SEARCH-LIST*, otherwise returns #f."
- { file }
- file file-exists? if
- file
- else
- #f { fname }
- file string? *clm-search-list* array? && if
- *clm-search-list* each ( dir )
- "/" $+ file $+ dup file-exists? if to fname leave else drop then
- end-each
- then
- fname
- then
+ doc" Return the possible full path name of FILE if FILE exists or \
+if FILE was found in *CLM-SEARCH-LIST*, otherwise return #f."
+ { file }
+ file file-exists? if
+ file
+ else
+ #f { fname }
+ file string?
+ *clm-search-list* array? && if
+ *clm-search-list* each ( dir )
+ "/" $+ file $+ dup file-exists? if
+ to fname leave
+ else
+ drop
+ then
+ end-each
+ then
+ fname
+ then
;
hide
: .maxamps { fname name sr scl? -- }
- fname file-exists? if
- fname mus-sound-maxamp { vals }
- vals length 0 ?do
- $" %6s %c: %.3f (near %.3f secs)%s" #(
- name
- [char] A i 2/ +
- vals i 1+ array-ref
- vals i array-ref sr f/
- scl? if $" (before scaling)" else "" then ) clm-message
- 2 +loop
- then
+ fname file-exists? if
+ fname mus-sound-maxamp { vals }
+ scl? if
+ " (before scaling)"
+ else
+ ""
+ then { scaled }
+ vals length 0 ?do
+ "%6s %c: %.3f (near %.3f secs)%s"
+ #( name
+ [char] A i 2/ +
+ vals i 1+ array-ref
+ vals i array-ref sr f/
+ scaled ) clm-message
+ 2 +loop
+ then
;
: .timer { obj -- }
- $" real: %.3f (utime %.3f, stime %.3f)" #(
- obj real-time@
- obj user-time@
- obj system-time@ ) clm-message
+ " real: %.3f (utime %.3f, stime %.3f)"
+ #( obj real-time@
+ obj user-time@
+ obj system-time@ ) clm-message
;
: .timer-ratio { sr frms obj -- }
- frms 0> if
- sr frms f/ { m }
- $" ratio: %.2f (uratio %.2f)" #( obj real-time@ m f* obj user-time@ m f* )
- else
- $" ratio: no ratio" #()
- then clm-message
+ frms 0> if
+ sr frms f/ { m }
+ " ratio: %.2f (uratio %.2f)"
+ #( obj real-time@ m f*
+ obj user-time@ m f* )
+ else
+ " ratio: no ratio" #()
+ then clm-message
;
set-current
: snd-info <{ output :key reverb-file-name #f scaled? #f timer #f -- }>
- output mus-sound-duration { dur }
- output mus-sound-frames { frames }
- output mus-sound-chans { channels }
- output mus-sound-srate { srate }
- $" filename: %S" #( output ) clm-message
- $" chans: %d, srate: %d" #( channels srate f>s ) clm-message
- $" format: %s [%s]" #(
- output mus-sound-data-format mus-data-format-name
- output mus-sound-header-type mus-header-type-name ) clm-message
- $" length: %.3f (%d frames)" #( dur frames ) clm-message
- timer timer? if
- timer .timer
- srate frames timer .timer-ratio
- then
- output "maxamp" srate scaled? .maxamps
- reverb-file-name ?dup-if "revamp" srate #f .maxamps then
- output mus-sound-comment { comm }
- comm empty? unless $" comment: %S" #( comm ) clm-message then
+ output mus-sound-duration { dur }
+ output mus-sound-framples { frms }
+ output mus-sound-chans { channels }
+ output mus-sound-srate { srate }
+ "filename: %S" #( output ) clm-message
+ " chans: %d, srate: %d" #( channels srate f>s ) clm-message
+ " format: %s [%s]"
+ #( output mus-sound-sample-type mus-sample-type-name
+ output mus-sound-header-type mus-header-type-name ) clm-message
+ " length: %.3f (%d frames)" #( dur frms ) clm-message
+ timer timer? if
+ timer .timer
+ srate frms timer .timer-ratio
+ then
+ output "maxamp" srate scaled? .maxamps
+ reverb-file-name ?dup-if
+ "revamp" srate #f .maxamps
+ then
+ output mus-sound-comment { comm }
+ comm empty? unless
+ " comment: %S" #( comm ) clm-message
+ then
;
previous
-\ === Playing and Recording one or two Channel Sounds ===
-: play-sound <{ input
- :key
- verbose *clm-verbose*
- dac-size *clm-rt-bufsize*
- audio-format *clm-audio-format* -- }>
- doc" Plays sound file INPUT.\n\
-\"bell.snd\" :verbose #t play-sound"
- input find-file to input
- input false? if 'no-such-file #( get-func-name input ) fth-throw then
- input mus-sound-frames { frames }
- input mus-sound-srate { srate }
- input mus-sound-chans { chans }
- chans 2 > if
- $" %s: we can only handle 2 chans, not %d" #( get-func-name chans ) string-format warning
- 2 to chans
- then
- verbose if input snd-info then
- dac-size frames min { bufsize }
- bufsize 0> if
- chans bufsize make-sound-data { data }
- input mus-sound-open-input { snd-fd }
- snd-fd 0< if 'forth-error #( get-func-name $" cannot open %s" input ) fth-throw then
- 0 srate chans 2 min audio-format bufsize mus-audio-open-output { dac-fd }
- dac-fd 0< if 'forth-error #( get-func-name $" cannot open dac" ) fth-throw then
- frames 0 ?do
- i bufsize + frames > if frames i - to bufsize then
- snd-fd 0 bufsize 1- chans data mus-sound-read drop
- dac-fd data bufsize mus-audio-write drop
- bufsize +loop
- snd-fd mus-sound-close-input drop
- dac-fd mus-audio-close drop
- else
- $" nothing to play for %S (%d frames)" #( input bufsize ) string-format warning
- then
-;
-
-: record-sound ( output keyword-args -- )
- <{ output :key
- duration 10.0
- verbose *clm-verbose*
- output-device *clm-output-device*
- dac-size *clm-rt-bufsize*
- srate *clm-srate*
- channels *clm-channels*
- audio-format *clm-audio-format*
- data-format *clm-data-format*
- header-type *clm-header-type*
- comment *clm-comment* -- }>
- doc" Records from dac output device to the specified OUTPUT file."
- \ INFO: mus-srate must be set before seconds->samples! [ms]
- mus-srate { old-srate }
- srate set-mus-srate drop
- duration seconds->samples { frames }
- dac-size frames min { bufsize }
- channels 2 min { chans }
- comment empty? if $" written %s by %s" #( date get-func-name ) string-format to comment then
- chans bufsize make-sound-data { data }
- output srate chans data-format header-type comment mus-sound-open-output { snd-fd }
- snd-fd 0< if 'forth-error #( get-func-name $" cannot open %S" output ) fth-throw then
- output-device srate chans audio-format bufsize mus-audio-open-input { dac-fd }
- dac-fd 0< if 'forth-error #( get-func-name $" cannot open dac" ) fth-throw then
- verbose if
- $" filename: %s" #( output ) clm-message
- $" device: %d" #( output-device ) clm-message
- $" chans: %d, srate: %d" #( chans srate ) clm-message
- $" r format: %s [Dac]" #( audio-format mus-data-format-name ) clm-message
- $" w format: %s [%s]" #(
- data-format mus-data-format-name header-type mus-header-type-name ) clm-message
- $" length: %.3f (%d frames)" #( duration frames ) clm-message
- $" comment: %S" #( comment ) clm-message
- then
- frames 0 ?do
- i bufsize + frames > if frames i - to bufsize then
- dac-fd data bufsize mus-audio-read drop
- snd-fd 0 bufsize 1- chans data mus-sound-write drop
- bufsize +loop
- dac-fd mus-audio-close drop
- snd-fd frames chans * data-format mus-bytes-per-sample * mus-sound-close-output drop
- old-srate set-mus-srate drop
-;
-
-: clm-mix <{ infile :key output #f output-frame 0 frames #f input-frame 0 scaler 1.0 -- }>
- doc" Mixes files in with-sound's *output* generator.\n\
+: clm-mix <{ infile :key
+ output #f
+ output-frame 0
+ frames #f
+ input-frame 0
+ scaler #f -- }>
+ doc" Mix files in with-sound's *output* generator.\n\
\"oboe.snd\" clm-mix\n\
-Mixes oboe.snd in *output* at *output*'s location 0 from oboe.snd's location 0 on. \
+Mixes oboe.snd in *output* at *output*'s \
+location 0 from oboe.snd's location 0 on. \
The whole oboe.snd file will be mixed in because :frames is not specified."
- 0 { chans }
- #f { mx }
- *output* mus-output? { outgen }
- output unless
- outgen if
- *output* mus-channels to chans
- *output* mus-file-name to output
- else
- 'with-sound-error $" %s: *output* gen or :output required" #( get-func-name ) fth-raise
- then
- then
- infile find-file to infile
- infile false? if 'file-not-found $" %s: cannot find %S" #( get-func-name infile ) fth-raise then
- frames infile mus-sound-frames || dup unless drop undef then to frames
- outgen if *output* mus-close drop then
- chans 0>
- scaler f0<> &&
- scaler 1.0 f<> && if
- save-stack { s }
- chans chans dup * 0 ?do scaler loop make-mixer to mx
- s restore-stack
- then
- output ( outfile )
- infile ( infile )
- output-frame ( outloc )
- frames ( frames )
- input-frame ( inloc )
- mx ( mixer )
- #f ( envs ) mus-mix drop
- outgen if output continue-sample->file to *output* then
+ 0 { chans }
+ *output* mus-output? { outgen }
+ output unless
+ outgen if
+ *output* mus-channels to chans
+ *output* mus-file-name to output
+ else
+ 'with-sound-error
+ #( "%s: *output* gen or :output required"
+ get-func-name ) fth-throw
+ then
+ then
+ infile find-file to infile
+ infile unless
+ 'file-not-found
+ #( "%s: can't find %S" get-func-name infile ) fth-throw
+ then
+ frames
+ infile mus-sound-framples || dup unless
+ drop undef
+ then to frames
+ outgen if
+ *output* mus-close drop
+ then
+ chans 0>
+ scaler &&
+ scaler f0<> && if
+ chans chans * scaler make-vct
+ else
+ #f
+ then { mx }
+ output ( outfile )
+ infile ( infile )
+ output-frame ( outloc )
+ frames ( frames )
+ input-frame ( inloc )
+ mx ( matrix )
+ #f ( envs ) mus-file-mix drop
+ outgen if
+ output continue-sample->file to *output*
+ then
;
[ifundef] ws-is-array?
- false value ws-is-array?
+ #f value ws-is-array?
[then]
ws-is-array? [if]
- <'> #() alias #w{} ( -- ws )
- <'> array? alias ws? ( obj -- f )
- <'> array-assoc-ref alias ws-ref ( ws key -- val )
- <'> array-assoc-set! alias ws-set! ( ws key val -- 'ws )
+ <'> #() alias #w{} ( -- ws )
+ <'> array? alias ws? ( obj -- f )
+ <'> array-assoc-ref alias ws-ref ( ws key -- val )
+ <'> array-assoc-set! alias ws-set! ( ws key val -- 'ws )
[else]
- <'> #{} alias #w{} ( -- ws )
- <'> hash? alias ws? ( obj -- f )
- <'> hash-ref alias ws-ref ( ws key -- val )
- : ws-set! ( ws key val -- 'ws ) 3 pick >r hash-set! r> ;
+ <'> #{} alias #w{} ( -- ws )
+ <'> hash? alias ws? ( obj -- f )
+ <'> hash-ref alias ws-ref ( ws key -- val )
+ : ws-set! ( ws key val -- 'ws ) 3 pick >r hash-set! r> ;
[then]
hide
: ws-get-snd ( ws -- snd )
- ( ws ) :output ws-ref find-file { fname }
- fname 0 find-sound dup sound? if dup save-sound drop close-sound then drop
- fname open-sound
+ ( ws ) :output ws-ref find-file { fname }
+ fname 0 find-sound dup sound? if
+ dup save-sound drop close-sound
+ then drop
+ fname open-sound
;
-: ws-scaled-to ( ws -- )
- { ws }
- ws :scaled-to ws-ref { scale }
- 'snd provided? if
- ws ws-get-snd { snd }
- 0.0 snd #t #f maxamp each fmax end-each { mx }
- mx f0<> if
- scale mx f/ to scale
- snd #f #f frames { len }
- ws :channels ws-ref 0 ?do scale 0 len snd i ( chn ) #f scale-channel drop loop
- then
- snd save-sound drop
- else
- ws :output ws-ref mus-sound-maxamp { smax }
- 0.0 smax length 1 ?do smax i array-ref fabs fmax 2 +loop { mx }
- mx f0<> if
- ws :output ws-ref :scaler scale mx f/ clm-mix
- then
- then
+: ws-scaled-to { ws -- }
+ ws :scaled-to ws-ref { scale }
+ 'snd provided? if
+ ws ws-get-snd { snd }
+ 0.0 snd #t #f maxamp each
+ fmax
+ end-each { mx }
+ mx f0<> if
+ scale mx f/ to scale
+ snd #f #f framples { len }
+ ws :channels ws-ref 0 ?do
+ scale 0 len snd i ( chn ) #f scale-channel drop
+ loop
+ then
+ snd save-sound drop
+ else
+ ws :output ws-ref mus-sound-maxamp { smax }
+ 0.0 smax length 1 ?do
+ smax i array-ref fabs fmax
+ 2 +loop { mx }
+ mx f0<> if
+ ws :output ws-ref :scaler scale mx f/ clm-mix
+ then
+ then
;
-: ws-scaled-by ( ws -- )
- { ws }
- ws :scaled-by ws-ref { scale }
- 'snd provided? if
- ws ws-get-snd { snd }
- snd #f #f frames { len }
- ws :channels ws-ref 0 ?do scale 0 len snd i ( chn ) #f scale-channel drop loop
- snd save-sound drop
- else
- ws :output ws-ref :scaler scale clm-mix
- then
+: ws-scaled-by { ws -- }
+ ws :scaled-by ws-ref { scale }
+ 'snd provided? if
+ ws ws-get-snd { snd }
+ snd #f #f framples { len }
+ ws :channels ws-ref 0 ?do
+ scale 0 len snd i ( chn ) #f scale-channel drop
+ loop
+ snd save-sound drop
+ else
+ ws :output ws-ref :scaler scale clm-mix
+ then
+;
+
+: ws-before-output { ws -- }
+ ws :old-table-size clm-table-size ws-set!
+ ( ws ) :old-file-buffer-size mus-file-buffer-size ws-set!
+ ( ws ) :old-array-print-length mus-array-print-length ws-set!
+ ( ws ) :old-clipped mus-clipping ws-set!
+ ( ws ) :old-srate mus-srate ws-set!
+ ( ws ) :old-locsig-type locsig-type ws-set!
+ ( ws ) :old-*output* *output* ws-set!
+ ( ws ) :old-*reverb* *reverb* ws-set!
+ ( ws ) :old-verbose *verbose* ws-set!
+ ( ws ) :old-debug *clm-debug* ws-set!
+ ( ws ) :old-channels *channels* ws-set!
+ ( ws ) :old-notehook *notehook* ws-set!
+ ( ws ) :old-decay-time *clm-decay-time* ws-set! to ws
+ ws :verbose ws-ref to *verbose*
+ ws :debug ws-ref to *clm-debug*
+ ws :channels ws-ref to *channels*
+ ws :notehook ws-ref to *notehook*
+ ws :decay-time ws-ref to *clm-decay-time*
+ *clm-file-buffer-size* set-mus-file-buffer-size drop
+ *clm-array-print-length* set-mus-array-print-length drop
+ ws :scaled-to ws-ref
+ ws :scaled-by ws-ref || if
+ #( mus-bfloat
+ mus-lfloat
+ mus-bdouble
+ mus-ldouble ) ws :sample-type ws-ref array-member? if
+ #f set-mus-clipping
+ else
+ *clm-clipped* set-mus-clipping
+ then
+ else
+ *clm-clipped* set-mus-clipping
+ then drop
+ ws :srate ws-ref set-mus-srate drop
+ ws :locsig-type ws-ref set-locsig-type drop
;
-: ws-before-output ( ws -- )
- { ws }
- ws :old-table-size clm-table-size ws-set!
- ( ws ) :old-file-buffer-size mus-file-buffer-size ws-set!
- ( ws ) :old-array-print-length mus-array-print-length ws-set!
- ( ws ) :old-clipping mus-clipping ws-set!
- ( ws ) :old-srate mus-srate ws-set!
- ( ws ) :old-locsig-type locsig-type ws-set!
- ( ws ) :old-*output* *output* ws-set!
- ( ws ) :old-*reverb* *reverb* ws-set!
- ( ws ) :old-verbose *verbose* ws-set!
- ( ws ) :old-debug *clm-debug* ws-set!
- ( ws ) :old-channels *channels* ws-set!
- ( ws ) :old-notehook *notehook* ws-set!
- ( ws ) :old-decay-time *clm-decay-time* ws-set! to ws
- ws :verbose ws-ref to *verbose*
- ws :debug ws-ref to *clm-debug*
- ws :channels ws-ref to *channels*
- ws :notehook ws-ref to *notehook*
- ws :decay-time ws-ref to *clm-decay-time*
- *clm-file-buffer-size* set-mus-file-buffer-size drop
- *clm-array-print-length* set-mus-array-print-length drop
- *clm-clipped* boolean? if *clm-clipped* else #f then set-mus-clipping drop
- ws :srate ws-ref set-mus-srate drop
- ws :locsig-type ws-ref set-locsig-type drop
+: ws-after-output { ws -- ws }
+ ws :old-table-size ws-ref set-clm-table-size drop
+ ws :old-file-buffer-size ws-ref set-mus-file-buffer-size drop
+ ws :old-array-print-length ws-ref set-mus-array-print-length drop
+ ws :old-clipped ws-ref set-mus-clipping drop
+ ws :old-srate ws-ref set-mus-srate drop
+ ws :old-locsig-type ws-ref set-locsig-type drop
+ ws :old-*output* ws-ref to *output*
+ ws :old-*reverb* ws-ref to *reverb*
+ ws :old-verbose ws-ref to *verbose*
+ ws :old-debug ws-ref to *clm-debug*
+ ws :old-channels ws-ref to *channels*
+ ws :old-notehook ws-ref to *notehook*
+ ws :old-decay-time ws-ref to *clm-decay-time*
+ *ws-args* array-pop
;
-: ws-after-output ( ws -- ws )
- { ws }
- ws :old-table-size ws-ref set-clm-table-size drop
- ws :old-file-buffer-size ws-ref set-mus-file-buffer-size drop
- ws :old-array-print-length ws-ref set-mus-array-print-length drop
- ws :old-clipping ws-ref set-mus-clipping drop
- ws :old-srate ws-ref set-mus-srate drop
- ws :old-locsig-type ws-ref set-locsig-type drop
- ws :old-*output* ws-ref to *output*
- ws :old-*reverb* ws-ref to *reverb*
- ws :old-verbose ws-ref to *verbose*
- ws :old-debug ws-ref to *clm-debug*
- ws :old-channels ws-ref to *channels*
- ws :old-notehook ws-ref to *notehook*
- ws :old-decay-time ws-ref to *clm-decay-time*
- *ws-args* array-pop
+: ws-statistics { ws -- }
+ ws :output ws-ref
+ :reverb-file-name ws :reverb-file-name ws-ref
+ :scaled? ws :scaled-to ws-ref ws :scaled-by ws-ref ||
+ :timer ws :timer ws-ref snd-info
;
-: ws-statistics ( ws -- )
- { ws }
- ws :output ws-ref
- :reverb-file-name ws :reverb-file-name ws-ref
- :scaled? ws :scaled-to ws-ref ws :scaled-by ws-ref ||
- :timer ws :timer ws-ref
- snd-info
+: set-args { key def ws -- }
+ key def get-optkey ws key rot ws-set! to ws
;
+set-current
-\ player can be one of xt, proc, string, or #f.
+\ player: xt, proc, string, or #f.
\
\ xt: output player execute
\ proc: player #( output ) run-proc
\ string: "player output" system
\ else snd: output :wait #t play
-\ clm: output play-sound
+\ or clm: output play-sound
\
\ A player may look like this:
\
-\ : play-3-times ( output -- )
-\ { output }
-\ 3 0 ?do output :wait #t play drop loop
+\ : play-3-times { output -- }
+\ 3 0 ?do
+\ output :wait #t play drop
+\ loop
\ ;
\ <'> play-3-times to *clm-player*
-: ws-play-it ( ws -- )
- { ws }
- ws :output ws-ref { output }
- ws :player ws-ref { player }
- player word? if
- player #( output ) run-proc drop
- else
- player string? if
- $" %s %s" #( player output ) string-format file-system drop
- else
- 'snd provided? if
- output find-file :wait #t play drop
- else
- output :verbose #f play-sound
- then
- then
- then
-;
-: set-args ( key def ws -- )
- { key def ws }
- key def get-optkey ws key rot ws-set! to ws
+defer ws-play
+: ws-play-it { ws -- }
+ ws :output ws-ref { output }
+ ws :player ws-ref { player }
+ player word? if
+ player #( output ) run-proc
+ else
+ player string? if
+ player $space $+ output $+ file-system
+ else
+ 'snd provided? if
+ output find-file :wait #t ws-play
+ else
+ "sndplay " output $+ file-system
+ then
+ then
+ then drop
;
-set-current
-: ws-output ( ws -- fname ) :output ws-ref ;
+: ws-output ( ws -- fname )
+ :output ws-ref
+;
: with-sound-default-args ( keyword-args -- ws )
- #() to *clm-instruments*
- #w{} { ws }
- *ws-args* ws array-push to *ws-args*
- :play *clm-play* ws set-args
- :statistics *clm-statistics* ws set-args
- :verbose *clm-verbose* ws set-args
- :debug *clm-debug* ws set-args
- :continue-old-file #f ws set-args
- :output *clm-file-name* ws set-args
- :channels *clm-channels* ws set-args
- :srate *clm-srate* ws set-args
- :locsig-type *clm-locsig-type* ws set-args
- :header-type *clm-header-type* ws set-args
- :data-format *clm-data-format* ws set-args
- :comment *clm-comment* ws set-args
- :notehook *clm-notehook* ws set-args
- :scaled-to #f ws set-args
- :scaled-by #f ws set-args
- :delete-reverb *clm-delete-reverb* ws set-args
- :reverb *clm-reverb* ws set-args
- :reverb-data *clm-reverb-data* ws set-args
- :reverb-channels *clm-reverb-channels* ws set-args
- :reverb-file-name *clm-reverb-file-name* ws set-args
- :player *clm-player* ws set-args
- :decay-time *clm-decay-time* ws set-args
- ws
+ #() to *clm-instruments*
+ #w{} { ws }
+ *ws-args* ws array-push to *ws-args*
+ :channels *clm-channels* ws set-args
+ :clipped *clm-clipped* ws set-args
+ :comment *clm-comment* ws set-args
+ :continue-old-file #f ws set-args
+ :sample-type *clm-sample-type* ws set-args
+ :debug *clm-debug* ws set-args
+ :decay-time *clm-decay-time* ws set-args
+ :delete-reverb *clm-delete-reverb* ws set-args
+ :header-type *clm-header-type* ws set-args
+ :locsig-type *clm-locsig-type* ws set-args
+ :notehook *clm-notehook* ws set-args
+ :output *clm-file-name* ws set-args
+ :play *clm-play* ws set-args
+ :player *clm-player* ws set-args
+ :reverb *clm-reverb* ws set-args
+ :reverb-channels *clm-reverb-channels* ws set-args
+ :reverb-data *clm-reverb-data* ws set-args
+ :reverb-file-name *clm-reverb-file-name* ws set-args
+ :scaled-by #f ws set-args
+ :scaled-to #f ws set-args
+ :srate *clm-srate* ws set-args
+ :statistics *clm-statistics* ws set-args
+ :verbose *clm-verbose* ws set-args
+ \ for backward compatibility
+ :data-format *clm-sample-type* get-optkey
+ ws :sample-type rot ws-set! to ws
+ ws
;
: with-sound-args ( keyword-args -- ws )
- #w{} { ws }
- *ws-args* -1 array-ref { ws1 }
- *ws-args* ws array-push to *ws-args*
- :play #f ws set-args
- :player #f ws set-args
- :statistics #f ws set-args
- :continue-old-file #f ws set-args
- :verbose ws1 :verbose ws-ref ws set-args
- :debug ws1 :debug ws-ref ws set-args
- :output ws1 :output ws-ref ws set-args
- :channels ws1 :channels ws-ref ws set-args
- :srate ws1 :srate ws-ref ws set-args
- :locsig-type ws1 :locsig-type ws-ref ws set-args
- :header-type ws1 :header-type ws-ref ws set-args
- :data-format ws1 :data-format ws-ref ws set-args
- :comment $" with-sound level %d" #( *ws-args* length ) string-format ws set-args
- :notehook ws1 :notehook ws-ref ws set-args
- :scaled-to ws1 :scaled-to ws-ref ws set-args
- :scaled-by ws1 :scaled-by ws-ref ws set-args
- :delete-reverb ws1 :delete-reverb ws-ref ws set-args
- :reverb ws1 :reverb ws-ref ws set-args
- :reverb-data ws1 :reverb-data ws-ref ws set-args
- :reverb-channels ws1 :reverb-channels ws-ref ws set-args
- :reverb-file-name ws1 :reverb-file-name ws-ref ws set-args
- :decay-time ws1 :decay-time ws-ref ws set-args
- ws
+ #w{} { ws }
+ *ws-args* -1 array-ref { ws1 }
+ *ws-args* ws array-push to *ws-args*
+ :play #f ws set-args
+ :player #f ws set-args
+ :statistics #f ws set-args
+ :continue-old-file #f ws set-args
+ :verbose ws1 :verbose ws-ref ws set-args
+ :debug ws1 :debug ws-ref ws set-args
+ :output ws1 :output ws-ref ws set-args
+ :channels ws1 :channels ws-ref ws set-args
+ :srate ws1 :srate ws-ref ws set-args
+ :locsig-type ws1 :locsig-type ws-ref ws set-args
+ :header-type ws1 :header-type ws-ref ws set-args
+ :sample-type ws1 :sample-type ws-ref ws set-args
+ :comment "with-sound level %d"
+ #( *ws-args* length ) string-format ws set-args
+ :notehook ws1 :notehook ws-ref ws set-args
+ :scaled-to ws1 :scaled-to ws-ref ws set-args
+ :scaled-by ws1 :scaled-by ws-ref ws set-args
+ :delete-reverb ws1 :delete-reverb ws-ref ws set-args
+ :reverb ws1 :reverb ws-ref ws set-args
+ :reverb-data ws1 :reverb-data ws-ref ws set-args
+ :reverb-channels ws1 :reverb-channels ws-ref ws set-args
+ :reverb-file-name ws1 :reverb-file-name ws-ref ws set-args
+ :decay-time ws1 :decay-time ws-ref ws set-args
+ \ for backward compatibility
+ :data-format ws1 :sample-type ws-ref get-optkey
+ ws :sample-type rot ws-set! to ws
+ ws
;
-: with-sound-main ( body-xt ws -- ws )
- { body-xt ws }
- body-xt word? body-xt 1 $" a proc or xt" assert-type
- ws ws? ws 2 $" a ws object" assert-type
- ws ws-before-output
- ws :reverb ws-ref { reverb-xt }
- reverb-xt if
- reverb-xt word? reverb-xt 3 $" a proc or xt" assert-type
- #t
- else
- #f
- then { rev? }
- ws :output ws-ref { output }
- ws :reverb-file-name ws-ref { revput }
- ws :continue-old-file ws-ref { cont? }
- cont? if
- output continue-sample->file
- else
- output file-delete
- output
- ws :channels ws-ref
- ws :data-format ws-ref
- ws :header-type ws-ref
- ws :comment ws-ref dup empty? if drop make-default-comment then make-sample->file
- then to *output*
- *output* sample->file? unless
- 'with-sound-error #( get-func-name $" cannot open sample->file" ) fth-throw
- then
- cont? if
- output mus-sound-srate set-mus-srate drop
- 'snd provided? if
- output 0 find-sound dup sound? if close-sound then drop
- then
- then
- rev? if
- cont? if
- revput continue-sample->file
- else
- revput file-delete
- revput
- ws :reverb-channels ws-ref
- ws :data-format ws-ref
- ws :header-type ws-ref
- $" with-sound temporary reverb file" make-sample->file
- then to *reverb*
- *reverb* sample->file? unless
- 'with-sound-error #( get-func-name $" cannot open reverb sample->file" ) fth-throw
- then
- then
- ws :timer make-timer ws-set! to ws
- \ compute ws body
- *clm-debug* if
- \ EXECUTE provides probably a more precise backtrace than FTH-CATCH.
- body-xt proc->xt execute
- else
- body-xt 'with-sound-interrupt #t fth-catch if
- stack-reset
- *output* mus-close drop
- *reverb* if *reverb* mus-close drop then
- $" body-xt interrupted by C-g" #() clm-message
- ws ws-after-output ( ws )
- exit
- then
- then
- reverb-xt if
- *reverb* mus-close drop
- ws :reverb-file-name ws-ref undef make-file->sample to *reverb*
- *reverb* file->sample? unless
- 'with-sound-error #( get-func-name $" cannot open file->sample" ) fth-throw
- then
- \ compute ws reverb
- \ push reverb arguments on stack
- ws :reverb-data ws-ref each end-each
- *clm-debug* if
- reverb-xt proc->xt execute
- else
- reverb-xt 'with-sound-interrupt #t fth-catch if
- stack-reset
+: with-sound-main { body-xt ws -- ws }
+ body-xt word? body-xt 1 "a proc or xt" assert-type
+ ws ws? ws 2 "a ws object" assert-type
+ ws ws-before-output
+ ws :reverb ws-ref { reverb-xt }
+ reverb-xt if
+ reverb-xt word? reverb-xt 3 "a proc or xt" assert-type
+ #t
+ else
+ #f
+ then { rev? }
+ ws :output ws-ref { output }
+ ws :reverb-file-name ws-ref { revput }
+ ws :continue-old-file ws-ref { cont? }
+ cont? if
+ output continue-sample->file
+ else
+ output file-delete
+ output
+ ws :channels ws-ref
+ ws :sample-type ws-ref
+ ws :header-type ws-ref
+ ws :comment ws-ref dup empty? if
+ drop make-default-comment
+ then make-sample->file
+ then to *output*
+ *output* sample->file? unless
+ 'with-sound-error
+ #( "%s: can't open sample->file" get-func-name ) fth-throw
+ then
+ cont? if
+ output mus-sound-srate set-mus-srate drop
+ 'snd provided? if
+ output 0 find-sound dup sound? if
+ close-sound
+ then drop
+ then
+ then
+ rev? if
+ cont? if
+ revput continue-sample->file
+ else
+ revput file-delete
+ revput
+ ws :reverb-channels ws-ref
+ ws :sample-type ws-ref
+ ws :header-type ws-ref
+ "with-sound temporary reverb file" make-sample->file
+ then to *reverb*
+ *reverb* sample->file? unless
+ 'with-sound-error
+ #( "%s: can't open reverb sample->file"
+ get-func-name ) fth-throw
+ then
+ then
+ ws :timer make-timer ws-set! to ws
+ \ compute ws body
+ body-xt #t nil fth-catch if
+ stack-reset
+ *output* mus-close drop
+ *reverb* if
+ *reverb* mus-close drop
+ then
+ ws ws-after-output ( ws )
+ "%s: body-xt interrupted; output closed"
+ #( get-func-name ) clm-message
+ \ reraise last exception
+ #f #f #f fth-raise
+ then
+ reverb-xt if
+ *reverb* mus-close drop
+ ws :reverb-file-name ws-ref undef make-file->sample to *reverb*
+ *reverb* file->sample? unless
+ 'with-sound-error
+ #( "%s: can't open file->sample" get-func-name )
+ fth-throw
+ then
+ \ compute ws reverb
+ \ push reverb arguments on stack
+ ws :reverb-data ws-ref each end-each
+ reverb-xt #t nil fth-catch if
+ stack-reset
+ *output* mus-close drop
+ *reverb* mus-close drop
+ ws ws-after-output ( ws )
+ "%s: reverb-xt interrupted; output closed"
+ #( get-func-name ) clm-message
+ \ reraise last exception
+ #f #f #f fth-raise
+ then
+ *reverb* mus-close drop
+ then
*output* mus-close drop
- *reverb* mus-close drop
- $" reverb-xt interrupted by C-g" #() clm-message
+ ws :timer ws-ref stop-timer
+ 'snd provided? if
+ ws ws-get-snd drop
+ then
+ ws :statistics ws-ref if
+ ws ws-statistics
+ then
+ reverb-xt if
+ ws :delete-reverb ws-ref if
+ ws :reverb-file-name ws-ref file-delete
+ then
+ then
+ ws :scaled-to ws-ref if
+ ws ws-scaled-to
+ then
+ ws :scaled-by ws-ref if
+ ws ws-scaled-by
+ then
+ ws :play ws-ref if
+ ws ws-play-it
+ then
ws ws-after-output ( ws )
- exit
- then
- then
- *reverb* mus-close drop
- then
- *output* mus-close drop
- ws :timer ws-ref stop-timer
- 'snd provided? if
- ws ws-get-snd drop
- then
- ws :statistics ws-ref if ws ws-statistics then
- reverb-xt if ws :delete-reverb ws-ref if ws :reverb-file-name ws-ref file-delete then then
- ws :scaled-to ws-ref if ws ws-scaled-to then
- ws :scaled-by ws-ref if ws ws-scaled-by then
- ws :play ws-ref if ws ws-play-it then
- ws ws-after-output ( ws )
;
previous
@@ -963,7 +1045,7 @@ previous
\ <'> resflt-test :play #f :channels 2 with-sound .g
\ lambda: resflt-test ; :output "resflt.snd" with-sound drop
: with-sound ( body-xt keyword-args -- ws )
- doc" \\ keywords and default values:\n\
+ doc" \\ keywords and default values:\n\
:play *clm-play* (#f)\n\
:statistics *clm-statistics* (#f)\n\
:verbose *clm-verbose* (#f)\n\
@@ -974,7 +1056,8 @@ previous
:srate *clm-srate* (44100)\n\
:locsig-type *clm-locsig-type* (mus-interp-linear)\n\
:header-type *clm-header-type* (mus-next)\n\
-:data-format *clm-data-format* (mus-lfloat)\n\
+:sample-type *clm-sample-type* (mus-lfloat)\n\
+:clipped *clm-clipped* (#t)\n\
:comment *clm-comment* (#f)\n\
:notehook *clm-notehook* (#f)\n\
:scaled-to (#f)\n\
@@ -986,83 +1069,90 @@ previous
:reverb-file-name *clm-reverb-file-name* (\"test.reverb\")\n\
:player *clm-player* (#f)\n\
:decay-time *clm-decay-time* (1.0)\n\
-Executes BODY-XT, a proc object or an xt, and returns an assoc array with with-sound arguments.\n\
-<'> resflt-test with-sound .g cr\n\
-<'> resflt-test :play #t :channels 2 :srate 44100 with-sound drop"
- *ws-args* empty? if
- with-sound-default-args
- else
- with-sound-args
- then ( ws )
- with-sound-main ( ws )
+Execute BODY-XT, a proc object or an xt, \
+and returns a ws-args object with with-sound arguments.\n\
+<'> resflt-test with-sound .$ cr\n\
+<'> resflt-test :play #t :channels 2 :srate 48000 with-sound drop"
+ *ws-args* empty? if
+ with-sound-default-args
+ else
+ with-sound-args
+ then with-sound-main ( ws )
;
: clm-load ( fname keyword-args -- ws )
- doc" Loads and evals the CLM instrument call file FNAME. \
+ doc" Load and eval the CLM instrument file FNAME. \
See with-sound for a full keyword list.\n\
\"test.fsm\" :play #t :player \"sndplay\" clm-load drop"
- *ws-args* empty? if
- with-sound-default-args
- else
- with-sound-args
- then
- { fname ws }
- fname file-exists? if
- ws :verbose ws-ref if $" loading %S" #( fname ) clm-message then
- fname <'> file-eval ws with-sound-main ( ws )
- else
- 'no-such-file $" %s: %S not found" #( get-func-name fname ) fth-raise
- then
+ *ws-args* empty? if
+ with-sound-default-args
+ else
+ with-sound-args
+ then
+ { fname ws }
+ fname file-exists? if
+ ws :verbose ws-ref if
+ "loading %S" #( fname ) clm-message
+ then
+ fname <'> file-eval ws with-sound-main ( ws )
+ else
+ 'no-such-file
+ #( "%s: %S not found" get-func-name fname ) fth-throw
+ then
;
: with-current-sound <{ body-xt :key offset 0.0 scaled-to #f scaled-by #f -- }>
- doc" Must be called within with-sound body. \
-Takes all arguments from current with-sound except :output, :scaled-to, :scaled-by and :comment."
- *output* mus-output? false? if
- 'with-sound-error $" %s can only be called within with-sound" #( get-func-name ) fth-raise
- then
- with-sound-args { ws }
- fth-tempnam { output }
- ws :output output ws-set!
- ( ws ) :scaled-to scaled-to ws-set!
- ( ws ) :scaled-by scaled-by ws-set! to ws
- body-xt ws with-sound-main drop
- output :output-frame offset seconds->samples clm-mix
- output file-delete
+ doc" Must be called within with-sound body. \
+Take all arguments from current with-sound except \
+:output, :scaled-to, :scaled-by and :comment."
+ *output* mus-output? false? if
+ 'with-sound-error
+ #( "%s can only be called within with-sound"
+ get-func-name ) fth-throw
+ then
+ with-sound-args { ws }
+ fth-tempnam { output }
+ ws :output output ws-set!
+ ( ws ) :scaled-to scaled-to ws-set!
+ ( ws ) :scaled-by scaled-by ws-set! to ws
+ body-xt ws with-sound-main drop
+ output :output-frame offset seconds->samples clm-mix
+ output file-delete
;
: scaled-to <{ body-xt scl -- }>
- doc" Must be called within with-sound body. \
-Scales BODY-XT's resulting sound file to SCL.\n\
+ doc" Must be called within with-sound body. \
+Scale BODY-XT's resulting sound file to SCL.\n\
lambda: ( -- )\n\
0.0 0.1 660.0 0.5 fm-violin\n\
0.5 0.1 550.0 0.1 <'> fm-violin 0.8 scaled-to ( scaled to 0.8 )\n\
; with-sound"
- body-xt :scaled-to scl with-current-sound
+ body-xt :scaled-to scl with-current-sound
;
: scaled-by <{ body-xt scl -- }>
- doc" Must be called within with-sound body. \
-Scales BODY-XT's resulting sound file by SCL.\n\
+ doc" Must be called within with-sound body. \
+Scale BODY-XT's resulting sound file by SCL.\n\
lambda: ( -- )\n\
0.0 0.1 660.0 0.5 fm-violin\n\
0.5 0.1 550.0 0.1 <'> fm-violin 2.0 scaled-by ( scaled to 0.2 )\n\
; with-sound"
- body-xt :scaled-by scl with-current-sound
+ body-xt :scaled-by scl with-current-sound
;
: with-offset <{ body-xt sec -- }>
- doc" Must be called within with-sound body. \
-Mixes BODY-XT's resulting sound file into main sound file at SEC seconds.\n\
+ doc" Must be called within with-sound body. \
+Mix BODY-XT's resulting sound file into main sound file at SEC seconds.\n\
lambda: ( -- )\n\
0.0 0.1 660.0 0.5 fm-violin\n\
- 0.5 0.1 550.0 0.1 <'> fm-violin 1.0 with-offset ( its actual begin time is 1.5 )\n\
+ 0.5 0.1 550.0 0.1 <'> fm-violin 1.0 \
+with-offset ( its actual begin time is 1.5 )\n\
; with-sound"
- body-xt :offset sec with-current-sound
+ body-xt :offset sec with-current-sound
;
: with-mix <{ body-str args fname start -- }>
- doc" BODY-STR is a string with with-sound commands or NIL, \
+ doc" BODY-STR is a string with with-sound commands or NIL, \
ARGS is an array of with-sound arguments, \
FNAME is the temporary mix file name without extension, \
and START is the begin time for mix in. \
@@ -1079,153 +1169,196 @@ lambda: ( -- )\n\
\" #( :reverb <'> jc-reverb ) \"sec2\" 1.0 with-mix\n\
2.0 0.1 220 0.1 fm-violin\n\
; with-sound drop"
- body-str string? body-str nil? || body-str 1 $" a string or nil" assert-type
- args array? args list? || args 2 $" an array or a list" assert-type
- fname string? fname 3 $" a string" assert-type
- start number? start 4 $" a number" assert-type
- *output* mus-output? false? if
- 'with-sound-error $" %s can only be called within with-sound" #( get-func-name ) fth-raise
- then
- fname ".snd" $+ { snd-file }
- fname ".fsm" $+ { mix-file }
- fname ".reverb" $+ { rev-file }
- snd-file file-exists? if
- snd-file file-mtime
- else
- #f
- then { snd-time }
- body-str string? if
- mix-file file-exists? if
- mix-file readlines "" array-join
- else
- ""
- then ( old-body ) body-str string= if
- mix-file file-mtime
- else
- mix-file #( body-str ) writelines
- #f
- then
- else
- mix-file file-exists? if
- mix-file file-mtime
- else
- 'no-such-file $" %s: %S not found" #( get-func-name mix-file ) fth-raise
- then
- then { mix-time }
- snd-time false?
- mix-time false? ||
- snd-time mix-time d< || if
- mix-file args each end-each :output snd-file :reverb-file-name rev-file clm-load drop
- then
- snd-file :output-frame start seconds->samples clm-mix
+ body-str string? body-str nil? || body-str
+ 1 "a string or nil" assert-type
+ args array? args list? || args
+ 2 "an array or a list" assert-type
+ fname string? fname 3 "a string" assert-type
+ start number? start 4 "a number" assert-type
+ *output* mus-output? false? if
+ 'with-sound-error
+ #( "%s can only be called within with-sound"
+ get-func-name ) fth-throw
+ then
+ fname ".snd" $+ { snd-file }
+ fname ".fsm" $+ { mix-file }
+ fname ".reverb" $+ { rev-file }
+ snd-file file-exists? if
+ snd-file file-mtime
+ else
+ #f
+ then { snd-time }
+ body-str string? if
+ mix-file file-exists? if
+ mix-file readlines "" array-join
+ else
+ ""
+ then ( old-body ) body-str string= if
+ mix-file file-mtime
+ else
+ mix-file #( body-str ) writelines
+ #f
+ then
+ else \ body-str is nil
+ mix-file file-exists? if
+ mix-file file-mtime
+ else
+ 'no-such-file
+ #( "%s: %S not found"
+ get-func-name
+ mix-file ) fth-throw
+ then
+ then { mix-time }
+ snd-time false?
+ mix-time false? ||
+ snd-time mix-time d< || if
+ mix-file args each
+ ( put all args on stack )
+ end-each :output snd-file :reverb-file-name rev-file
+ clm-load drop
+ then
+ snd-file :output-frame start seconds->samples clm-mix
;
: sound-let ( ws-xt-lst body-xt -- )
- doc" Requires an array of arrays WS-XT-LST with with-sound args and xts, and a BODY-XT. \
+ doc" Require array of arrays WS-XT-LST with with-sound args \
+and xts, and a BODY-XT. \
The BODY-XT must take WS-XT-LST length arguments which are tempfile names. \
with-sound will be feed with ws-args und ws-xts from WS-XT-LST. \
:output is set to tempnam which will be on stack before executing BODY-XT. \
These temporary files will be deleted after execution of BODY-XT.\n\
#( #( #( :reverb <'> jc-reverb ) 0.0 1 220 0.2 <'> fm-violin )\n\
- #( #() 0.5 1 440 0.3 <'> fm-violin ) ) ( the ws-xt-lst )\n\
+ #( #() 0.5 1 440 0.3 <'> fm-violin ) ) ( the ws-xt-lst )\n\
lambda: { tmp1 tmp2 }\n\
tmp1 :output tmp2 clm-mix\n\
tmp1 clm-mix\n\
; ( the body-xt ) <'> sound-let with-sound drop"
- { ws-xt-lst body-xt }
- ws-xt-lst array? ws-xt-lst 1 $" an array" assert-type
- body-xt word? body-xt 2 $" a proc or xt" assert-type
- *output* mus-output? false? if
- 'with-sound-error $" %s can only be called within with-sound" #( get-func-name ) fth-raise
- then
- ws-xt-lst map
- *key* 0 array-ref ( args ) each end-each with-sound-args
- ( ws ) :output fth-tempnam ws-set! { ws }
- *key* 1 array-ref ( xt ) each end-each ws with-sound-main :output ws-ref ( outfile )
- end-map { outfiles }
- body-xt xt? if
- outfiles each end-each body-xt execute
- else
- body-xt outfiles run-proc drop
- then
- outfiles each file-delete end-each
+ { ws-xt-lst body-xt }
+ ws-xt-lst array? ws-xt-lst 1 "an array" assert-type
+ body-xt word? body-xt 2 "a proc or xt" assert-type
+ *output* mus-output? unless
+ 'with-sound-error
+ #( "%s can only be called within with-sound"
+ get-func-name ) fth-throw
+ then
+ ws-xt-lst map
+ *key* 0 array-ref ( args ) each
+ ( put all args on stack )
+ end-each with-sound-args
+ ( ws ) :output fth-tempnam ws-set! { ws }
+ *key* 1 array-ref ( xt ) each
+ ( put all xts on stack )
+ end-each ws with-sound-main :output ws-ref ( outfile )
+ end-map { outfiles }
+ body-xt xt? if
+ outfiles each end-each body-xt execute
+ else
+ body-xt outfiles run-proc drop
+ then
+ outfiles each ( file )
+ file-delete
+ end-each
;
+\ === Playing Sounds ===
+: play-sound <{ :key verbose *clm-verbose* player *clm-player*
+ :optional input *clm-file-name* -- }>
+ doc" Play sound file INPUT.\n\
+\"bell.snd\" :verbose #t play-sound"
+ input find-file to input
+ input unless
+ 'no-such-file #( "%s: %s" get-func-name input ) fth-throw
+ then
+ verbose if
+ input snd-info
+ then
+ #w{} :output input ws-set! :player player ws-set! ws-play-it
+;
+
+'snd provided? [unless]
+ <'> play-sound alias play
+[then]
+<'> play is ws-play
+
\ === Example instruments, more in clm-ins.fs ===
-instrument: simp ( start dur freq amp -- )
- { start dur freq amp }
- :frequency freq make-oscil { os }
- :envelope #( 0 0 25 1 75 1 100 0 ) :duration dur :scaler amp make-env { en }
- start dur run
- i os 0.0 0.0 oscil en env f* *output* outa drop
- loop
+instrument: simp { start dur freq amp -- }
+ :frequency freq make-oscil { os }
+ :envelope #( 0 0 25 1 75 1 100 0 )
+ :duration dur :scaler amp make-env { en }
+ start dur run
+ i os 0.0 0.0 oscil en env f* *output* outa drop
+ loop
;instrument
: run-test ( -- ) 0.0 1.0 330.0 0.5 simp ;
-: input-fn ( gen -- proc; dir self -- r )
- 1 proc-create swap ,
- does> ( dir self -- r )
- nip @ readin
+: input-fn { gen -- prc; dir self -- r }
+ 1 proc-create ( prc )
+ gen ,
+ does> { dir self -- r }
+ self @ ( gen ) readin
;
-instrument: src-simp ( start dur amp sr sr-env fname -- )
- { start dur amp sr sr-env fname }
- :file fname find-file make-readin { f }
- :input f input-fn :srate sr make-src { sc }
- :envelope sr-env :duration dur make-env { en }
- start dur run
- i sc en env #f src amp f* *output* outa drop
- loop
- f mus-close drop
+instrument: src-simp { start dur amp sr sr-env fname -- }
+ :file fname find-file make-readin { f }
+ :input f input-fn :srate sr make-src { sc }
+ :envelope sr-env :duration dur make-env { en }
+ start dur run
+ i sc en env #f src amp f* *output* outa drop
+ loop
+ f mus-close drop
;instrument
-instrument: conv-simp ( start dur filt fname amp -- )
- { start dur filt fname amp }
- :file fname find-file make-readin { f }
- filt string? if
- 8192 0.0 make-vct { v }
- filt find-file 0 0 v length v file->array
- else
- filt
- then { data }
- :input f input-fn :filter data make-convolve { cv }
- start dur run
- i cv #f convolve amp f* *output* outa drop
- loop
- f mus-close drop
+instrument: conv-simp { start dur filt fname amp -- }
+ :file fname find-file make-readin { f }
+ filt string? if
+ 8192 0.0 make-vct { v }
+ filt find-file 0 0 v length v file->array
+ else
+ filt
+ then { data }
+ :input f input-fn :filter data make-convolve { cv }
+ start dur run
+ i cv #f convolve amp f* *output* outa drop
+ loop
+ f mus-close drop
;instrument
\ <'> src-test with-sound drop
event: src-test ( -- )
- 0.0 1.0 1.0 0.2 #( 0 0 50 1 100 0 ) "oboe.snd" src-simp
+ 0.0 1.0 1.0 0.2 #( 0 0 50 1 100 0 ) "oboe.snd" src-simp
;event
\ <'> conv1-test with-sound drop
event: conv1-test ( -- )
- 0.0 1.0 vct( 0.5 0.2 0.1 0.05 0 0 0 0 ) "fyow.snd" 1.0 conv-simp
+ 0.0 1.0 vct( 0.5 0.2 0.1 0.05 0 0 0 0 ) "fyow.snd" 1.0 conv-simp
;event
\ <'> conc2-test with-sound drop
event: conv2-test ( -- )
- 0.0 1.0 "pistol.snd" "fyow.snd" 0.2 conv-simp
+ 0.0 1.0 "pistol.snd" "fyow.snd" 0.2 conv-simp
;event
\ <'> inst-test with-sound drop
event: inst-test ( -- )
- 0.0 1.0 1.0 0.2 #( 0 0 50 1 100 0 ) "oboe.snd" src-simp
- 1.2 1.0 vct( 0.5 0.2 0.1 0.05 0 0 0 0 ) "fyow.snd" 1.0 conv-simp
- 2.4 1.0 "pistol.snd" "fyow.snd" 0.2 conv-simp
+ 0.0 1.0 1.0 0.2 #( 0 0 50 1 100 0 ) "oboe.snd" src-simp
+ 1.2 1.0 vct( 0.5 0.2 0.1 0.05 0 0 0 0 ) "fyow.snd" 1.0 conv-simp
+ 2.4 1.0 "pistol.snd" "fyow.snd" 0.2 conv-simp
;event
\ generators.scm
: make-waveshape <{ :optional
- frequency *clm-default-frequency*
- partials '( 1 1 )
- wave #f
- size *clm-table-size* -- gen }>
- doc" see make-polyshape"
- :frequency frequency wave if :coeffs wave else :partials partials then make-polyshape
+ freq *clm-default-frequency*
+ parts #( 1 1 )
+ wave #f
+ size *clm-table-size* -- gen }>
+ doc" See make-polyshape."
+ :frequency freq
+ wave if
+ :coeffs wave
+ else
+ :partials parts
+ then make-polyshape
;
<'> polyshape alias waveshape ( gen :optional index 1.0 fm 0.0 -- val )
@@ -1234,16 +1367,19 @@ event: inst-test ( -- )
<'> waveshape? <'> polyshape? help-ref help-set!
: partials->waveshape <{ partials :optional size *clm-table-size* -- wave }>
- doc" see partials->polynomial"
- partials partials->polynomial ( wave )
+ doc" See partials->polynomial."
+ partials partials->polynomial ( wave )
;
\ snd10.scm
-: make-sum-of-sines <{ :key sines 1 frequency 0.0 initial-phase 0.0 -- gen }>
- doc" see make-nsin"
- :frequency frequency :n sines make-nsin { gen }
- gen initial-phase set-mus-phase drop
- gen
+: make-sum-of-sines <{ :key
+ sines 1
+ frequency 0.0
+ initial-phase 0.0 -- gen }>
+ doc" See make-nsin."
+ :frequency frequency :n sines make-nsin { gen }
+ gen initial-phase set-mus-phase drop
+ gen
;
<'> nsin alias sum-of-sines ( gen :optional fm 0.0 -- val )
@@ -1251,11 +1387,14 @@ event: inst-test ( -- )
<'> sum-of-sines <'> nsin help-ref help-set!
<'> sum-of-sines? <'> nsin? help-ref help-set!
-: make-sum-of-cosines <{ :key cosines 1 frequency 0.0 initial-phase 0.0 -- gen }>
- doc" see make-ncos"
- :frequency frequency :n cosines make-ncos { gen }
- gen initial-phase set-mus-phase drop
- gen
+: make-sum-of-cosines <{ :key
+ cosines 1
+ frequency 0.0
+ initial-phase 0.0 -- gn }>
+ doc" See make-ncos."
+ :frequency frequency :n cosines make-ncos { gen }
+ gen initial-phase set-mus-phase drop
+ gen
;
<'> ncos alias sum-of-cosines ( gen :optional fm 0.0 -- val )
@@ -1263,11 +1402,16 @@ event: inst-test ( -- )
<'> sum-of-cosines <'> ncos help-ref help-set!
<'> sum-of-cosines? <'> ncos? help-ref help-set!
-: make-sine-summation <{ :key frequency 0.0 initial-phase 0.0 n 1 a 0.5 ratio 1.0 -- gen }>
- doc" see make-nrxysin"
- :frequency frequency :ratio ratio :n n :r a make-nrxysin { gen }
- gen initial-phase set-mus-phase drop
- gen
+: make-sine-summation <{ :key
+ frequency 0.0
+ initial-phase 0.0
+ n 1
+ a 0.5
+ ratio 1.0 -- gen }>
+ doc" See make-nrxysin."
+ :frequency frequency :ratio ratio :n n :r a make-nrxysin { gen }
+ gen initial-phase set-mus-phase drop
+ gen
;
<'> nrxysin alias sine-summation ( gen :optional fm 0.0 -- val )
@@ -1276,29 +1420,77 @@ event: inst-test ( -- )
<'> sine-summation? <'> nrxysin? help-ref help-set!
'snd provided? [if]
- instrument: arpeggio <{ start dur freq amp :key ampenv #( 0 0 0.5 1 1 0 ) offset 1.0 -- }>
- start dur times->samples { end beg }
- 12 make-array map!
- :frequency freq offset i 6 - 0.03 f* f* f+
- :partials #( 1 1 5 0.7 6 0.7 7 0.7 8 0.7 9 0.7 10 0.7 ) make-polyshape
- end-map { waveshbank }
- :envelope ampenv :scaler amp 0.1 f* :length end make-env { amp-env }
- end 0.0 make-vct map!
- 0.0 ( sum ) waveshbank each ( wv ) 1.0 0.0 polyshape f+ end-each ( sum ) amp-env env f*
- end-map ( vct-output )
- #f channels 0 ?do ( vct-output ) beg end #f i #f undef vct->channel loop ( vct-output ) drop
- ;instrument
-
- event: arpeggio-test ( -- )
- :file "arpeggio.snd"
- :header-type mus-next
- :data-format mus-lfloat
- :channels 2
- :srate mus-srate f>s
- :comment make-default-comment new-sound { snd }
- 0 10 65 0.5 arpeggio
- snd save-sound drop
- ;event
+ instrument: snd-arpeggio
+ <{ start dur freq amp :key ampenv #( 0 0 0.5 1 1 0 ) offset 1.0 -- }>
+ start dur times->samples { end beg }
+ 12 make-array map!
+ :frequency i 6 - 0.03 f* offset f* freq f+
+ :partials #( 1 1.0
+ 5 0.7
+ 6 0.7
+ 7 0.7
+ 8 0.7
+ 9 0.7
+ 10 0.7 ) make-polyshape
+ end-map { waveshbank }
+ :envelope ampenv
+ :scaler amp 0.1 f*
+ :length end make-env { amp-env }
+ end 0.0 make-vct map!
+ 0.0 ( sum )
+ waveshbank each ( wv )
+ 1.0 0.0 polyshape f+ ( sum += ... )
+ end-each ( sum ) amp-env env f*
+ end-map ( vct-output )
+ #f channels 0 ?do
+ ( vct-output ) beg end #f i #f undef vct->channel
+ loop ( vct-output ) drop
+ ;instrument
+
+ event: snd-arpeggio-test ( -- snd )
+ mus-srate { old-sr }
+ 48000 set-mus-srate drop
+ :file "arpeggio.snd"
+ :header-type mus-next
+ :sample-type mus-bdouble
+ :channels 2
+ :srate mus-srate f>s
+ :comment make-default-comment new-sound { snd }
+ 0 10 65 0.5 snd-arpeggio
+ snd save-sound drop
+ old-sr set-mus-srate drop
+ snd
+ ;event
[then]
+instrument: arpeggio <{ start dur freq amp :key
+ ampenv #( 0 0 0.5 1 1 0 )
+ offset 1.0 -- }>
+ start dur times->samples { end beg }
+ 12 make-array map!
+ :frequency i 6 - 0.03 f* offset f* freq f+
+ :partials #( 1 1.0
+ 5 0.7
+ 6 0.7
+ 7 0.7
+ 8 0.7
+ 9 0.7
+ 10 0.7 ) make-polyshape
+ end-map { waveshbank }
+ :envelope ampenv
+ :scaler amp 0.1 f*
+ :length end make-env { amp-env }
+ start dur #{ :degree 90.0 random } run-instrument
+ 0.0 ( sum )
+ waveshbank each ( wv )
+ 1.0 0.0 polyshape f+ ( sum += ... )
+ end-each ( sum ) amp-env env f*
+ end-run
+;instrument
+
+\ <'> arpeggio-test :output "arpeggio.snd" with-sound
+event: arpeggio-test ( -- )
+ 0 10 65 0.5 arpeggio
+;event
+
\ clm.fs ends here
diff --git a/clm.h b/clm.h
index 4287049..c174fca 100644
--- a/clm.h
+++ b/clm.h
@@ -1,16 +1,19 @@
#ifndef CLM_H
#define CLM_H
-#define MUS_VERSION 4
-#define MUS_REVISION 31
-#define MUS_DATE "7-Mar-10"
+#define MUS_VERSION 6
+#define MUS_REVISION 13
+#define MUS_DATE "5-Aug-15"
/* isn't mus_env_interp backwards? */
#include "sndlib.h"
+#ifndef _MSC_VER
+ #include <sys/param.h>
+#endif
#if HAVE_COMPLEX_TRIG
-#include <complex.h>
+ #include <complex.h>
#endif
#if(!defined(M_PI))
@@ -24,64 +27,14 @@
typedef enum {MUS_NOT_SPECIAL, MUS_SIMPLE_FILTER, MUS_FULL_FILTER, MUS_OUTPUT, MUS_INPUT, MUS_DELAY_LINE} mus_clm_extended_t;
+typedef struct mus_any_class mus_any_class;
typedef struct {
struct mus_any_class *core;
} mus_any;
-typedef struct mus_any_class {
- int type;
- char *name;
- int (*release)(mus_any *ptr);
- char *(*describe)(mus_any *ptr); /* caller should free the string */
- bool (*equalp)(mus_any *gen1, mus_any *gen2);
- mus_float_t *(*data)(mus_any *ptr);
- mus_float_t *(*set_data)(mus_any *ptr, mus_float_t *new_data);
- mus_long_t (*length)(mus_any *ptr);
- mus_long_t (*set_length)(mus_any *ptr, mus_long_t new_length);
- mus_float_t (*frequency)(mus_any *ptr);
- mus_float_t (*set_frequency)(mus_any *ptr, mus_float_t new_freq);
- mus_float_t (*phase)(mus_any *ptr);
- mus_float_t (*set_phase)(mus_any *ptr, mus_float_t new_phase);
- mus_float_t (*scaler)(mus_any *ptr);
- mus_float_t (*set_scaler)(mus_any *ptr, mus_float_t val);
- mus_float_t (*increment)(mus_any *ptr);
- mus_float_t (*set_increment)(mus_any *ptr, mus_float_t val);
- mus_float_t (*run)(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
- mus_clm_extended_t extended_type;
- void *(*closure)(mus_any *gen);
- int (*channels)(mus_any *ptr);
- mus_float_t (*offset)(mus_any *ptr);
- mus_float_t (*set_offset)(mus_any *ptr, mus_float_t val);
- mus_float_t (*width)(mus_any *ptr);
- mus_float_t (*set_width)(mus_any *ptr, mus_float_t val);
- mus_float_t (*xcoeff)(mus_any *ptr, int index);
- mus_float_t (*set_xcoeff)(mus_any *ptr, int index, mus_float_t val);
- mus_long_t (*hop)(mus_any *ptr);
- mus_long_t (*set_hop)(mus_any *ptr, mus_long_t new_length);
- mus_long_t (*ramp)(mus_any *ptr);
- mus_long_t (*set_ramp)(mus_any *ptr, mus_long_t new_length);
- mus_float_t (*read_sample)(mus_any *ptr, mus_long_t samp, int chan);
- mus_float_t (*write_sample)(mus_any *ptr, mus_long_t samp, int chan, mus_float_t data);
- char *(*file_name)(mus_any *ptr);
- int (*end)(mus_any *ptr);
- mus_long_t (*location)(mus_any *ptr);
- mus_long_t (*set_location)(mus_any *ptr, mus_long_t loc);
- int (*channel)(mus_any *ptr);
- mus_float_t (*ycoeff)(mus_any *ptr, int index);
- mus_float_t (*set_ycoeff)(mus_any *ptr, int index, mus_float_t val);
- mus_float_t *(*xcoeffs)(mus_any *ptr);
- mus_float_t *(*ycoeffs)(mus_any *ptr);
- void *original_class; /* class chain perhaps */
- void (*reset)(mus_any *ptr);
- void *(*set_closure)(mus_any *gen, void *e);
- int (*safety)(mus_any *ptr);
- int (*set_safety)(mus_any *ptr, int val);
-} mus_any_class;
-
typedef enum {MUS_INTERP_NONE, MUS_INTERP_LINEAR, MUS_INTERP_SINUSOIDAL, MUS_INTERP_ALL_PASS,
- MUS_INTERP_LAGRANGE, MUS_INTERP_BEZIER, MUS_INTERP_HERMITE, MUS_NUM_INTERPS} mus_interp_t;
-typedef enum {MUS_ENV_LINEAR, MUS_ENV_EXPONENTIAL, MUS_ENV_STEP} mus_env_t;
+ MUS_INTERP_LAGRANGE, MUS_INTERP_BEZIER, MUS_INTERP_HERMITE} mus_interp_t;
typedef enum {MUS_RECTANGULAR_WINDOW, MUS_HANN_WINDOW, MUS_WELCH_WINDOW, MUS_PARZEN_WINDOW, MUS_BARTLETT_WINDOW,
MUS_HAMMING_WINDOW, MUS_BLACKMAN2_WINDOW, MUS_BLACKMAN3_WINDOW, MUS_BLACKMAN4_WINDOW,
@@ -94,31 +47,67 @@ typedef enum {MUS_RECTANGULAR_WINDOW, MUS_HANN_WINDOW, MUS_WELCH_WINDOW, MUS_PAR
MUS_NUM_FFT_WINDOWS} mus_fft_window_t;
typedef enum {MUS_SPECTRUM_IN_DB, MUS_SPECTRUM_NORMALIZED, MUS_SPECTRUM_RAW} mus_spectrum_t;
-typedef enum {MUS_CHEBYSHEV_EITHER_KIND, MUS_CHEBYSHEV_FIRST_KIND, MUS_CHEBYSHEV_SECOND_KIND} mus_polynomial_t;
+typedef enum {MUS_CHEBYSHEV_EITHER_KIND, MUS_CHEBYSHEV_FIRST_KIND, MUS_CHEBYSHEV_SECOND_KIND, MUS_CHEBYSHEV_BOTH_KINDS} mus_polynomial_t;
-#if defined(__GNUC__) && (!(defined(__cplusplus)))
- #define MUS_RUN(GEN, ARG_1, ARG_2) ({ mus_any *_clm_h_1 = (mus_any *)(GEN); \
- ((*((_clm_h_1->core)->run))(_clm_h_1, ARG_1, ARG_2)); })
-#else
- #define MUS_RUN(GEN, ARG_1, ARG_2) ((*(((GEN)->core)->run))(GEN, ARG_1, ARG_2))
-#endif
-#define MUS_RUN_P(GEN) (((GEN)->core)->run)
#define MUS_MAX_CLM_SINC_WIDTH 65536
#define MUS_MAX_CLM_SRC 65536.0
+
+/* this is internal -- for clm->clm2xen */
+typedef struct {
+ mus_any_class *core;
+ int chan;
+ mus_long_t loc;
+ char *file_name;
+ int chans;
+ mus_float_t **obufs;
+ mus_float_t *obuf0, *obuf1;
+ mus_long_t data_start, data_end;
+ mus_long_t out_end;
+ mus_sample_t output_sample_type;
+ mus_header_t output_header_type;
+} rdout;
+/* end internal stuff */
+
+
#ifdef __cplusplus
extern "C" {
#endif
MUS_EXPORT void mus_initialize(void);
-MUS_EXPORT int mus_make_class_tag(void);
+MUS_EXPORT int mus_make_generator_type(void);
+
+MUS_EXPORT mus_any_class *mus_generator_class(mus_any *ptr);
+MUS_EXPORT mus_any_class *mus_make_generator(int type, char *name,
+ void (*release)(mus_any *ptr),
+ char *(*describe)(mus_any *ptr),
+ bool (*equalp)(mus_any *gen1, mus_any *gen2));
+
+MUS_EXPORT void mus_generator_set_length(mus_any_class *p, mus_long_t (*length)(mus_any *ptr));
+MUS_EXPORT void mus_generator_set_scaler(mus_any_class *p, mus_float_t (*scaler)(mus_any *ptr));
+MUS_EXPORT void mus_generator_set_channels(mus_any_class *p, int (*channels)(mus_any *ptr));
+MUS_EXPORT void mus_generator_set_location(mus_any_class *p, mus_long_t (*location)(mus_any *ptr));
+MUS_EXPORT void mus_generator_set_set_location(mus_any_class *p, mus_long_t (*set_location)(mus_any *ptr, mus_long_t loc));
+MUS_EXPORT void mus_generator_set_channel(mus_any_class *p, int (*channel)(mus_any *ptr));
+MUS_EXPORT void mus_generator_set_file_name(mus_any_class *p, char *(*file_name)(mus_any *ptr));
+MUS_EXPORT void mus_generator_set_extended_type(mus_any_class *p, mus_clm_extended_t extended_type);
+MUS_EXPORT void mus_generator_set_read_sample(mus_any_class *p, mus_float_t (*read_sample)(mus_any *ptr, mus_long_t samp, int chan));
+MUS_EXPORT void mus_generator_set_feeders(mus_any *g,
+ mus_float_t (*feed)(void *arg, int direction),
+ mus_float_t (*block_feed)(void *arg, int direction, mus_float_t *block, mus_long_t start, mus_long_t end));
+MUS_EXPORT void mus_generator_copy_feeders(mus_any *dest, mus_any *source);
+
MUS_EXPORT mus_float_t mus_radians_to_hz(mus_float_t radians);
MUS_EXPORT mus_float_t mus_hz_to_radians(mus_float_t hz);
MUS_EXPORT mus_float_t mus_degrees_to_radians(mus_float_t degrees);
MUS_EXPORT mus_float_t mus_radians_to_degrees(mus_float_t radians);
MUS_EXPORT mus_float_t mus_db_to_linear(mus_float_t x);
MUS_EXPORT mus_float_t mus_linear_to_db(mus_float_t x);
+MUS_EXPORT mus_float_t mus_odd_multiple(mus_float_t x, mus_float_t y);
+MUS_EXPORT mus_float_t mus_even_multiple(mus_float_t x, mus_float_t y);
+MUS_EXPORT mus_float_t mus_odd_weight(mus_float_t x);
+MUS_EXPORT mus_float_t mus_even_weight(mus_float_t x);
MUS_EXPORT mus_float_t mus_srate(void);
MUS_EXPORT mus_float_t mus_set_srate(mus_float_t val);
@@ -134,28 +123,28 @@ MUS_EXPORT mus_float_t mus_amplitude_modulate(mus_float_t s1, mus_float_t s2, mu
MUS_EXPORT mus_float_t mus_contrast_enhancement(mus_float_t sig, mus_float_t index);
MUS_EXPORT mus_float_t mus_dot_product(mus_float_t *data1, mus_float_t *data2, mus_long_t size);
#if HAVE_COMPLEX_TRIG
-MUS_EXPORT complex double mus_edot_product(complex double freq, complex double *data, mus_long_t size);
+ MUS_EXPORT complex double mus_edot_product(complex double freq, complex double *data, mus_long_t size);
#endif
-MUS_EXPORT void mus_clear_array(mus_float_t *arr, mus_long_t size);
MUS_EXPORT bool mus_arrays_are_equal(mus_float_t *arr1, mus_float_t *arr2, mus_float_t fudge, mus_long_t len);
MUS_EXPORT mus_float_t mus_polynomial(mus_float_t *coeffs, mus_float_t x, int ncoeffs);
-MUS_EXPORT void mus_multiply_arrays(mus_float_t *data, mus_float_t *window, mus_long_t len);
MUS_EXPORT void mus_rectangular_to_polar(mus_float_t *rl, mus_float_t *im, mus_long_t size);
MUS_EXPORT void mus_rectangular_to_magnitudes(mus_float_t *rl, mus_float_t *im, mus_long_t size);
MUS_EXPORT void mus_polar_to_rectangular(mus_float_t *rl, mus_float_t *im, mus_long_t size);
MUS_EXPORT mus_float_t mus_array_interp(mus_float_t *wave, mus_float_t phase, mus_long_t size);
-MUS_EXPORT double mus_bessi0(mus_float_t x);
+MUS_EXPORT mus_float_t mus_bessi0(mus_float_t x);
MUS_EXPORT mus_float_t mus_interpolate(mus_interp_t type, mus_float_t x, mus_float_t *table, mus_long_t table_size, mus_float_t y);
-MUS_EXPORT bool mus_interp_type_p(int val);
-MUS_EXPORT bool mus_fft_window_p(int val);
+MUS_EXPORT bool mus_is_interp_type(int val);
+MUS_EXPORT bool mus_is_fft_window(int val);
-MUS_EXPORT int mus_data_format_zero(int format);
+MUS_EXPORT int mus_sample_type_zero(mus_sample_t samp_type);
+MUS_EXPORT mus_float_t (*mus_run_function(mus_any *g))(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
/* -------- generic functions -------- */
-MUS_EXPORT int mus_free(mus_any *ptr);
+MUS_EXPORT int mus_type(mus_any *ptr);
+MUS_EXPORT void mus_free(mus_any *ptr);
MUS_EXPORT char *mus_describe(mus_any *gen);
MUS_EXPORT bool mus_equalp(mus_any *g1, mus_any *g2);
MUS_EXPORT mus_float_t mus_phase(mus_any *gen);
@@ -169,7 +158,6 @@ MUS_EXPORT mus_long_t mus_order(mus_any *gen);
MUS_EXPORT mus_float_t *mus_data(mus_any *gen);
MUS_EXPORT mus_float_t *mus_set_data(mus_any *gen, mus_float_t *data);
MUS_EXPORT const char *mus_name(mus_any *ptr);
-MUS_EXPORT const char *mus_set_name(mus_any *ptr, const char *new_name);
MUS_EXPORT mus_float_t mus_scaler(mus_any *gen);
MUS_EXPORT mus_float_t mus_set_scaler(mus_any *gen, mus_float_t val);
MUS_EXPORT mus_float_t mus_offset(mus_any *gen);
@@ -178,6 +166,7 @@ MUS_EXPORT mus_float_t mus_width(mus_any *gen);
MUS_EXPORT mus_float_t mus_set_width(mus_any *gen, mus_float_t val);
MUS_EXPORT char *mus_file_name(mus_any *ptr);
MUS_EXPORT void mus_reset(mus_any *ptr);
+MUS_EXPORT mus_any *mus_copy(mus_any *gen);
MUS_EXPORT mus_float_t *mus_xcoeffs(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_ycoeffs(mus_any *ptr);
MUS_EXPORT mus_float_t mus_xcoeff(mus_any *ptr, int index);
@@ -200,8 +189,6 @@ MUS_EXPORT mus_float_t mus_feedforward(mus_any *gen);
MUS_EXPORT mus_float_t mus_set_feedforward(mus_any *gen, mus_float_t val);
MUS_EXPORT mus_float_t mus_feedback(mus_any *rd);
MUS_EXPORT mus_float_t mus_set_feedback(mus_any *rd, mus_float_t dir);
-MUS_EXPORT int mus_safety(mus_any *gen);
-MUS_EXPORT int mus_set_safety(mus_any *gen, int val);
/* -------- generators -------- */
@@ -210,146 +197,183 @@ MUS_EXPORT mus_float_t mus_oscil(mus_any *o, mus_float_t fm, mus_float_t pm);
MUS_EXPORT mus_float_t mus_oscil_unmodulated(mus_any *ptr);
MUS_EXPORT mus_float_t mus_oscil_fm(mus_any *ptr, mus_float_t fm);
MUS_EXPORT mus_float_t mus_oscil_pm(mus_any *ptr, mus_float_t pm);
-MUS_EXPORT bool mus_oscil_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_oscil(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_oscil(mus_float_t freq, mus_float_t phase);
+MUS_EXPORT bool mus_is_oscil_bank(mus_any *ptr);
+MUS_EXPORT mus_float_t mus_oscil_bank(mus_any *ptr);
+MUS_EXPORT mus_any *mus_make_oscil_bank(int size, mus_float_t *freqs, mus_float_t *phases, mus_float_t *amps, bool stable);
+
MUS_EXPORT mus_any *mus_make_ncos(mus_float_t freq, int n);
MUS_EXPORT mus_float_t mus_ncos(mus_any *ptr, mus_float_t fm);
-MUS_EXPORT bool mus_ncos_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_ncos(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_nsin(mus_float_t freq, int n);
MUS_EXPORT mus_float_t mus_nsin(mus_any *ptr, mus_float_t fm);
-MUS_EXPORT bool mus_nsin_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_nsin(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_nrxysin(mus_float_t frequency, mus_float_t y_over_x, int n, mus_float_t r);
MUS_EXPORT mus_float_t mus_nrxysin(mus_any *ptr, mus_float_t fm);
-MUS_EXPORT bool mus_nrxysin_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_nrxysin(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_nrxycos(mus_float_t frequency, mus_float_t y_over_x, int n, mus_float_t r);
MUS_EXPORT mus_float_t mus_nrxycos(mus_any *ptr, mus_float_t fm);
-MUS_EXPORT bool mus_nrxycos_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_nrxycos(mus_any *ptr);
+
+MUS_EXPORT mus_any *mus_make_rxykcos(mus_float_t freq, mus_float_t phase, mus_float_t r, mus_float_t ratio);
+MUS_EXPORT mus_float_t mus_rxykcos(mus_any *ptr, mus_float_t fm);
+MUS_EXPORT bool mus_is_rxykcos(mus_any *ptr);
+
+MUS_EXPORT mus_any *mus_make_rxyksin(mus_float_t freq, mus_float_t phase, mus_float_t r, mus_float_t ratio);
+MUS_EXPORT mus_float_t mus_rxyksin(mus_any *ptr, mus_float_t fm);
+MUS_EXPORT bool mus_is_rxyksin(mus_any *ptr);
MUS_EXPORT mus_float_t mus_delay(mus_any *gen, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_delay_unmodulated(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_float_t mus_tap(mus_any *gen, mus_float_t loc);
MUS_EXPORT mus_float_t mus_tap_unmodulated(mus_any *gen);
MUS_EXPORT mus_any *mus_make_delay(int size, mus_float_t *line, int line_size, mus_interp_t type);
-MUS_EXPORT bool mus_delay_p(mus_any *ptr);
-MUS_EXPORT bool mus_delay_line_p(mus_any *gen); /* added 2-Mar-03 for tap error checks */
+MUS_EXPORT bool mus_is_delay(mus_any *ptr);
+MUS_EXPORT bool mus_is_tap(mus_any *ptr);
MUS_EXPORT mus_float_t mus_delay_tick(mus_any *ptr, mus_float_t input);
-MUS_EXPORT mus_float_t mus_delay_tick_noz(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_float_t mus_delay_unmodulated_noz(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_float_t mus_comb(mus_any *gen, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_comb_unmodulated(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_comb(mus_float_t scaler, int size, mus_float_t *line, int line_size, mus_interp_t type);
-MUS_EXPORT bool mus_comb_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_comb(mus_any *ptr);
MUS_EXPORT mus_float_t mus_comb_unmodulated_noz(mus_any *ptr, mus_float_t input);
+MUS_EXPORT mus_float_t mus_comb_bank(mus_any *bank, mus_float_t inval);
+MUS_EXPORT mus_any *mus_make_comb_bank(int size, mus_any **combs);
+MUS_EXPORT bool mus_is_comb_bank(mus_any *g);
+
MUS_EXPORT mus_float_t mus_notch(mus_any *gen, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_notch_unmodulated(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_notch(mus_float_t scaler, int size, mus_float_t *line, int line_size, mus_interp_t type);
-MUS_EXPORT bool mus_notch_p(mus_any *ptr);
-MUS_EXPORT mus_float_t mus_notch_unmodulated_noz(mus_any *ptr, mus_float_t input);
+MUS_EXPORT bool mus_is_notch(mus_any *ptr);
MUS_EXPORT mus_float_t mus_all_pass(mus_any *gen, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_all_pass_unmodulated(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_all_pass(mus_float_t backward, mus_float_t forward, int size, mus_float_t *line, int line_size, mus_interp_t type);
-MUS_EXPORT bool mus_all_pass_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_all_pass(mus_any *ptr);
MUS_EXPORT mus_float_t mus_all_pass_unmodulated_noz(mus_any *ptr, mus_float_t input);
+MUS_EXPORT mus_float_t mus_all_pass_bank(mus_any *bank, mus_float_t inval);
+MUS_EXPORT mus_any *mus_make_all_pass_bank(int size, mus_any **combs);
+MUS_EXPORT bool mus_is_all_pass_bank(mus_any *g);
+
MUS_EXPORT mus_any *mus_make_moving_average(int size, mus_float_t *line);
-MUS_EXPORT bool mus_moving_average_p(mus_any *ptr);
+MUS_EXPORT mus_any *mus_make_moving_average_with_initial_sum(int size, mus_float_t *line, mus_float_t sum);
+MUS_EXPORT bool mus_is_moving_average(mus_any *ptr);
MUS_EXPORT mus_float_t mus_moving_average(mus_any *ptr, mus_float_t input);
+MUS_EXPORT mus_any *mus_make_moving_max(int size, mus_float_t *line);
+MUS_EXPORT bool mus_is_moving_max(mus_any *ptr);
+MUS_EXPORT mus_float_t mus_moving_max(mus_any *ptr, mus_float_t input);
+
+MUS_EXPORT mus_any *mus_make_moving_norm(int size, mus_float_t *line, mus_float_t norm);
+MUS_EXPORT bool mus_is_moving_norm(mus_any *ptr);
+MUS_EXPORT mus_float_t mus_moving_norm(mus_any *ptr, mus_float_t input);
+
MUS_EXPORT mus_float_t mus_table_lookup(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_float_t mus_table_lookup_unmodulated(mus_any *gen);
MUS_EXPORT mus_any *mus_make_table_lookup(mus_float_t freq, mus_float_t phase, mus_float_t *wave, mus_long_t wave_size, mus_interp_t type);
-MUS_EXPORT bool mus_table_lookup_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_table_lookup(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_partials_to_wave(mus_float_t *partial_data, int partials, mus_float_t *table, mus_long_t table_size, bool normalize);
MUS_EXPORT mus_float_t *mus_phase_partials_to_wave(mus_float_t *partial_data, int partials, mus_float_t *table, mus_long_t table_size, bool normalize);
MUS_EXPORT mus_float_t mus_sawtooth_wave(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_sawtooth_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase);
-MUS_EXPORT bool mus_sawtooth_wave_p(mus_any *gen);
+MUS_EXPORT bool mus_is_sawtooth_wave(mus_any *gen);
MUS_EXPORT mus_float_t mus_square_wave(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_square_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase);
-MUS_EXPORT bool mus_square_wave_p(mus_any *gen);
+MUS_EXPORT bool mus_is_square_wave(mus_any *gen);
MUS_EXPORT mus_float_t mus_triangle_wave(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_triangle_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase);
-MUS_EXPORT bool mus_triangle_wave_p(mus_any *gen);
-
+MUS_EXPORT bool mus_is_triangle_wave(mus_any *gen);
+MUS_EXPORT mus_float_t mus_triangle_wave_unmodulated(mus_any *ptr);
+
MUS_EXPORT mus_float_t mus_pulse_train(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_pulse_train(mus_float_t freq, mus_float_t amp, mus_float_t phase);
-MUS_EXPORT bool mus_pulse_train_p(mus_any *gen);
+MUS_EXPORT bool mus_is_pulse_train(mus_any *gen);
+MUS_EXPORT mus_float_t mus_pulse_train_unmodulated(mus_any *ptr);
MUS_EXPORT void mus_set_rand_seed(unsigned long seed);
MUS_EXPORT unsigned long mus_rand_seed(void);
MUS_EXPORT mus_float_t mus_random(mus_float_t amp);
MUS_EXPORT mus_float_t mus_frandom(mus_float_t amp);
-MUS_EXPORT mus_float_t mus_random_no_input(void);
-MUS_EXPORT mus_float_t mus_frandom_no_input(void);
MUS_EXPORT int mus_irandom(int amp);
MUS_EXPORT mus_float_t mus_rand(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_rand(mus_float_t freq, mus_float_t base);
-MUS_EXPORT bool mus_rand_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_rand(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_rand_with_distribution(mus_float_t freq, mus_float_t base, mus_float_t *distribution, int distribution_size);
MUS_EXPORT mus_float_t mus_rand_interp(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_rand_interp(mus_float_t freq, mus_float_t base);
-MUS_EXPORT bool mus_rand_interp_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_rand_interp(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_rand_interp_with_distribution(mus_float_t freq, mus_float_t base, mus_float_t *distribution, int distribution_size);
+MUS_EXPORT mus_float_t mus_rand_interp_unmodulated(mus_any *ptr);
+MUS_EXPORT mus_float_t mus_rand_unmodulated(mus_any *ptr);
MUS_EXPORT mus_float_t mus_asymmetric_fm(mus_any *gen, mus_float_t index, mus_float_t fm);
MUS_EXPORT mus_float_t mus_asymmetric_fm_unmodulated(mus_any *gen, mus_float_t index);
-MUS_EXPORT mus_float_t mus_asymmetric_fm_no_input(mus_any *gen);
MUS_EXPORT mus_any *mus_make_asymmetric_fm(mus_float_t freq, mus_float_t phase, mus_float_t r, mus_float_t ratio);
-MUS_EXPORT bool mus_asymmetric_fm_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_asymmetric_fm(mus_any *ptr);
MUS_EXPORT mus_float_t mus_one_zero(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_one_zero(mus_float_t a0, mus_float_t a1);
-MUS_EXPORT bool mus_one_zero_p(mus_any *gen);
+MUS_EXPORT bool mus_is_one_zero(mus_any *gen);
MUS_EXPORT mus_float_t mus_one_pole(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_one_pole(mus_float_t a0, mus_float_t b1);
-MUS_EXPORT bool mus_one_pole_p(mus_any *gen);
+MUS_EXPORT bool mus_is_one_pole(mus_any *gen);
MUS_EXPORT mus_float_t mus_two_zero(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_two_zero(mus_float_t a0, mus_float_t a1, mus_float_t a2);
-MUS_EXPORT bool mus_two_zero_p(mus_any *gen);
+MUS_EXPORT bool mus_is_two_zero(mus_any *gen);
MUS_EXPORT mus_any *mus_make_two_zero_from_frequency_and_radius(mus_float_t frequency, mus_float_t radius);
MUS_EXPORT mus_float_t mus_two_pole(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_two_pole(mus_float_t a0, mus_float_t b1, mus_float_t b2);
-MUS_EXPORT bool mus_two_pole_p(mus_any *gen);
+MUS_EXPORT bool mus_is_two_pole(mus_any *gen);
MUS_EXPORT mus_any *mus_make_two_pole_from_frequency_and_radius(mus_float_t frequency, mus_float_t radius);
+MUS_EXPORT mus_float_t mus_one_pole_all_pass(mus_any *f, mus_float_t input);
+MUS_EXPORT mus_any *mus_make_one_pole_all_pass(int size, mus_float_t coeff);
+MUS_EXPORT bool mus_is_one_pole_all_pass(mus_any *ptr);
+
MUS_EXPORT mus_float_t mus_formant(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_formant(mus_float_t frequency, mus_float_t radius);
-MUS_EXPORT bool mus_formant_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_formant(mus_any *ptr);
+MUS_EXPORT mus_float_t mus_set_formant_frequency(mus_any *ptr, mus_float_t freq_in_hz);
MUS_EXPORT void mus_set_formant_radius_and_frequency(mus_any *ptr, mus_float_t radius, mus_float_t frequency);
MUS_EXPORT mus_float_t mus_formant_with_frequency(mus_any *ptr, mus_float_t input, mus_float_t freq_in_radians);
-MUS_EXPORT mus_float_t mus_formant_bank(mus_float_t *amps, mus_any **formants, mus_float_t inval, int size);
+
+MUS_EXPORT mus_float_t mus_formant_bank(mus_any *bank, mus_float_t inval);
+MUS_EXPORT mus_float_t mus_formant_bank_with_inputs(mus_any *bank, mus_float_t *inval);
+MUS_EXPORT mus_any *mus_make_formant_bank(int size, mus_any **formants, mus_float_t *amps);
+MUS_EXPORT bool mus_is_formant_bank(mus_any *g);
MUS_EXPORT mus_float_t mus_firmant(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_firmant(mus_float_t frequency, mus_float_t radius);
-MUS_EXPORT bool mus_firmant_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_firmant(mus_any *ptr);
MUS_EXPORT mus_float_t mus_firmant_with_frequency(mus_any *ptr, mus_float_t input, mus_float_t freq_in_radians);
MUS_EXPORT mus_float_t mus_filter(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_filter(int order, mus_float_t *xcoeffs, mus_float_t *ycoeffs, mus_float_t *state);
-MUS_EXPORT bool mus_filter_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_filter(mus_any *ptr);
MUS_EXPORT mus_float_t mus_fir_filter(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_fir_filter(int order, mus_float_t *xcoeffs, mus_float_t *state);
-MUS_EXPORT bool mus_fir_filter_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_fir_filter(mus_any *ptr);
MUS_EXPORT mus_float_t mus_iir_filter(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_iir_filter(int order, mus_float_t *ycoeffs, mus_float_t *state);
-MUS_EXPORT bool mus_iir_filter_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_iir_filter(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_make_fir_coeffs(int order, mus_float_t *env, mus_float_t *aa);
MUS_EXPORT mus_float_t *mus_filter_set_xcoeffs(mus_any *ptr, mus_float_t *new_data);
@@ -358,161 +382,143 @@ MUS_EXPORT int mus_filter_set_order(mus_any *ptr, int order);
MUS_EXPORT mus_float_t mus_filtered_comb(mus_any *ptr, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_filtered_comb_unmodulated(mus_any *ptr, mus_float_t input);
-MUS_EXPORT bool mus_filtered_comb_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_filtered_comb(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_filtered_comb(mus_float_t scaler, int size, mus_float_t *line, int line_size, mus_interp_t type, mus_any *filt);
+MUS_EXPORT mus_float_t mus_filtered_comb_bank(mus_any *bank, mus_float_t inval);
+MUS_EXPORT mus_any *mus_make_filtered_comb_bank(int size, mus_any **combs);
+MUS_EXPORT bool mus_is_filtered_comb_bank(mus_any *g);
+
MUS_EXPORT mus_float_t mus_wave_train(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_float_t mus_wave_train_unmodulated(mus_any *gen);
MUS_EXPORT mus_any *mus_make_wave_train(mus_float_t freq, mus_float_t phase, mus_float_t *wave, mus_long_t wsize, mus_interp_t type);
-MUS_EXPORT bool mus_wave_train_p(mus_any *gen);
+MUS_EXPORT bool mus_is_wave_train(mus_any *gen);
MUS_EXPORT mus_float_t *mus_partials_to_polynomial(int npartials, mus_float_t *partials, mus_polynomial_t kind);
MUS_EXPORT mus_float_t *mus_normalize_partials(int num_partials, mus_float_t *partials);
MUS_EXPORT mus_any *mus_make_polyshape(mus_float_t frequency, mus_float_t phase, mus_float_t *coeffs, int size, int cheby_choice);
MUS_EXPORT mus_float_t mus_polyshape(mus_any *ptr, mus_float_t index, mus_float_t fm);
-#define mus_polyshape_fm(Obj, Fm) mus_polyshape(Obj, 1.0, Fm)
MUS_EXPORT mus_float_t mus_polyshape_unmodulated(mus_any *ptr, mus_float_t index);
#define mus_polyshape_no_input(Obj) mus_polyshape(Obj, 1.0, 0.0)
-MUS_EXPORT bool mus_polyshape_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_polyshape(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_polywave(mus_float_t frequency, mus_float_t *coeffs, int n, int cheby_choice);
-MUS_EXPORT bool mus_polywave_p(mus_any *ptr);
+MUS_EXPORT mus_any *mus_make_polywave_tu(mus_float_t frequency, mus_float_t *tcoeffs, mus_float_t *ucoeffs, int n);
+MUS_EXPORT bool mus_is_polywave(mus_any *ptr);
MUS_EXPORT mus_float_t mus_polywave_unmodulated(mus_any *ptr);
MUS_EXPORT mus_float_t mus_polywave(mus_any *ptr, mus_float_t fm);
MUS_EXPORT mus_float_t mus_chebyshev_t_sum(mus_float_t x, int n, mus_float_t *tn);
MUS_EXPORT mus_float_t mus_chebyshev_u_sum(mus_float_t x, int n, mus_float_t *un);
MUS_EXPORT mus_float_t mus_chebyshev_tu_sum(mus_float_t x, int n, mus_float_t *tn, mus_float_t *un);
-#define mus_polywave_type(Obj) mus_channel(Obj)
+MUS_EXPORT mus_float_t (*mus_polywave_function(mus_any *g))(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_float_t mus_env(mus_any *ptr);
-MUS_EXPORT mus_any *mus_make_env(mus_float_t *brkpts, int npts, double scaler, double offset, double base, double duration, mus_long_t end, mus_float_t *odata);
-MUS_EXPORT bool mus_env_p(mus_any *ptr);
-MUS_EXPORT double mus_env_interp(double x, mus_any *env);
+MUS_EXPORT mus_any *mus_make_env(mus_float_t *brkpts, int npts, mus_float_t scaler, mus_float_t offset, mus_float_t base,
+ mus_float_t duration, mus_long_t end, mus_float_t *odata);
+MUS_EXPORT bool mus_is_env(mus_any *ptr);
+MUS_EXPORT mus_float_t mus_env_interp(mus_float_t x, mus_any *env);
MUS_EXPORT mus_long_t *mus_env_passes(mus_any *gen); /* for Snd */
-MUS_EXPORT double *mus_env_rates(mus_any *gen); /* for Snd */
-MUS_EXPORT double mus_env_offset(mus_any *gen); /* for Snd */
-MUS_EXPORT double mus_env_scaler(mus_any *gen); /* for Snd */
-MUS_EXPORT double mus_env_initial_power(mus_any *gen); /* for Snd */
+MUS_EXPORT mus_float_t *mus_env_rates(mus_any *gen); /* for Snd */
+MUS_EXPORT mus_float_t mus_env_offset(mus_any *gen); /* for Snd */
+MUS_EXPORT mus_float_t mus_env_scaler(mus_any *gen); /* for Snd */
+MUS_EXPORT mus_float_t mus_env_initial_power(mus_any *gen); /* for Snd */
MUS_EXPORT int mus_env_breakpoints(mus_any *gen); /* for Snd */
MUS_EXPORT mus_float_t mus_env_any(mus_any *e, mus_float_t (*connect_points)(mus_float_t val));
-#define mus_make_env_with_length(Brkpts, Pts, Scaler, Offset, Base, Length) mus_make_env(Brkpts, Pts, Scaler, Offset, Base, 0.0, (Length) - 1, NULL)
-MUS_EXPORT mus_float_t mus_env_linear(mus_any *ptr);
-MUS_EXPORT mus_float_t mus_env_exponential(mus_any *ptr);
-MUS_EXPORT mus_env_t mus_env_type(mus_any *ptr);
-
-MUS_EXPORT bool mus_frame_p(mus_any *ptr);
-MUS_EXPORT mus_any *mus_make_empty_frame(int chans);
-MUS_EXPORT mus_any *mus_make_frame(int chans, ...);
-MUS_EXPORT mus_any *mus_frame_add(mus_any *f1, mus_any *f2, mus_any *res);
-MUS_EXPORT mus_any *mus_frame_multiply(mus_any *f1, mus_any *f2, mus_any *res);
-MUS_EXPORT mus_any *mus_frame_scale(mus_any *uf1, mus_float_t scl, mus_any *ures);
-MUS_EXPORT mus_any *mus_frame_offset(mus_any *uf1, mus_float_t offset, mus_any *ures);
-MUS_EXPORT mus_float_t mus_frame_ref(mus_any *f, int chan);
-MUS_EXPORT mus_float_t mus_frame_set(mus_any *f, int chan, mus_float_t val);
-MUS_EXPORT mus_any *mus_frame_copy(mus_any *uf);
-MUS_EXPORT mus_float_t mus_frame_fill(mus_any *uf, mus_float_t val);
-
-MUS_EXPORT bool mus_mixer_p(mus_any *ptr);
-MUS_EXPORT mus_any *mus_make_empty_mixer(int chans);
-MUS_EXPORT mus_any *mus_make_identity_mixer(int chans);
-MUS_EXPORT mus_any *mus_make_mixer(int chans, ...);
-MUS_EXPORT mus_float_t mus_mixer_ref(mus_any *f, int in, int out);
-MUS_EXPORT mus_float_t mus_mixer_set(mus_any *f, int in, int out, mus_float_t val);
-MUS_EXPORT mus_any *mus_frame_to_frame(mus_any *f, mus_any *in, mus_any *out);
-MUS_EXPORT mus_any *mus_sample_to_frame(mus_any *f, mus_float_t in, mus_any *out);
-MUS_EXPORT mus_float_t mus_frame_to_sample(mus_any *f, mus_any *in);
-MUS_EXPORT mus_any *mus_mixer_multiply(mus_any *f1, mus_any *f2, mus_any *res);
-MUS_EXPORT mus_any *mus_mixer_add(mus_any *f1, mus_any *f2, mus_any *res);
-MUS_EXPORT mus_any *mus_mixer_scale(mus_any *uf1, mus_float_t scaler, mus_any *ures);
-MUS_EXPORT mus_any *mus_mixer_offset(mus_any *uf1, mus_float_t offset, mus_any *ures);
-MUS_EXPORT mus_any *mus_make_scalar_mixer(int chans, mus_float_t scalar);
-MUS_EXPORT mus_any *mus_mixer_copy(mus_any *uf);
-MUS_EXPORT mus_float_t mus_mixer_fill(mus_any *uf, mus_float_t val);
-
-MUS_EXPORT mus_any *mus_frame_to_frame_mono(mus_any *frame, mus_any *mix, mus_any *out);
-MUS_EXPORT mus_any *mus_frame_to_frame_stereo(mus_any *frame, mus_any *mix, mus_any *out);
-MUS_EXPORT mus_any *mus_frame_to_frame_mono_to_stereo(mus_any *frame, mus_any *mix, mus_any *out);
-
-MUS_EXPORT bool mus_file_to_sample_p(mus_any *ptr);
+MUS_EXPORT mus_float_t (*mus_env_function(mus_any *g))(mus_any *gen);
+
+MUS_EXPORT mus_any *mus_make_pulsed_env(mus_any *e, mus_any *p);
+MUS_EXPORT bool mus_is_pulsed_env(mus_any *ptr);
+MUS_EXPORT mus_float_t mus_pulsed_env(mus_any *pl, mus_float_t inval);
+MUS_EXPORT mus_float_t mus_pulsed_env_unmodulated(mus_any *pl);
+
+MUS_EXPORT bool mus_is_file_to_sample(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_file_to_sample(const char *filename);
MUS_EXPORT mus_any *mus_make_file_to_sample_with_buffer_size(const char *filename, mus_long_t buffer_size);
MUS_EXPORT mus_float_t mus_file_to_sample(mus_any *ptr, mus_long_t samp, int chan);
-MUS_EXPORT mus_float_t mus_in_any_from_file(mus_any *ptr, mus_long_t samp, int chan);
MUS_EXPORT mus_float_t mus_readin(mus_any *rd);
MUS_EXPORT mus_any *mus_make_readin_with_buffer_size(const char *filename, int chan, mus_long_t start, int direction, mus_long_t buffer_size);
#define mus_make_readin(Filename, Chan, Start, Direction) mus_make_readin_with_buffer_size(Filename, Chan, Start, Direction, mus_file_buffer_size())
-MUS_EXPORT bool mus_readin_p(mus_any *ptr);
-
-MUS_EXPORT bool mus_output_p(mus_any *ptr);
-MUS_EXPORT bool mus_input_p(mus_any *ptr);
-MUS_EXPORT mus_float_t mus_in_any(mus_long_t frame, int chan, mus_any *IO);
-
-MUS_EXPORT mus_any *mus_make_file_to_frame(const char *filename);
-MUS_EXPORT bool mus_file_to_frame_p(mus_any *ptr);
-MUS_EXPORT mus_any *mus_file_to_frame(mus_any *ptr, mus_long_t samp, mus_any *f);
-MUS_EXPORT mus_any *mus_make_file_to_frame_with_buffer_size(const char *filename, mus_long_t buffer_size);
-
-MUS_EXPORT bool mus_sample_to_file_p(mus_any *ptr);
-MUS_EXPORT mus_any *mus_make_sample_to_file_with_comment(const char *filename, int out_chans, int out_format, int out_type, const char *comment);
-#define mus_make_sample_to_file(Filename, Chans, OutFormat, OutType) mus_make_sample_to_file_with_comment(Filename, Chans, OutFormat, OutType, NULL)
+MUS_EXPORT bool mus_is_readin(mus_any *ptr);
+
+MUS_EXPORT bool mus_is_output(mus_any *ptr);
+MUS_EXPORT bool mus_is_input(mus_any *ptr);
+MUS_EXPORT mus_float_t mus_in_any(mus_long_t frample, int chan, mus_any *IO);
+MUS_EXPORT bool mus_in_any_is_safe(mus_any *IO);
+
+ /* new 6.0 */
+MUS_EXPORT mus_float_t *mus_file_to_frample(mus_any *ptr, mus_long_t samp, mus_float_t *f);
+MUS_EXPORT mus_any *mus_make_file_to_frample(const char *filename);
+MUS_EXPORT bool mus_is_file_to_frample(mus_any *ptr);
+MUS_EXPORT mus_any *mus_make_file_to_frample_with_buffer_size(const char *filename, mus_long_t buffer_size);
+MUS_EXPORT mus_float_t *mus_frample_to_frample(mus_float_t *matrix, int mx_chans, mus_float_t *in_samps, int in_chans, mus_float_t *out_samps, int out_chans);
+
+MUS_EXPORT bool mus_is_frample_to_file(mus_any *ptr);
+MUS_EXPORT mus_float_t *mus_frample_to_file(mus_any *ptr, mus_long_t samp, mus_float_t *data);
+MUS_EXPORT mus_any *mus_make_frample_to_file_with_comment(const char *filename, int chans, mus_sample_t samp_type, mus_header_t head_type, const char *comment);
+#define mus_make_frample_to_file(Filename, Chans, SampType, HeadType) mus_make_frample_to_file_with_comment(Filename, Chans, SampType, HeadType, NULL)
+MUS_EXPORT mus_any *mus_continue_frample_to_file(const char *filename);
+
+MUS_EXPORT void mus_file_mix_with_reader_and_writer(mus_any *outf, mus_any *inf,
+ mus_long_t out_start, mus_long_t out_framples, mus_long_t in_start,
+ mus_float_t *mx, int mx_chans, mus_any ***envs);
+MUS_EXPORT void mus_file_mix(const char *outfile, const char *infile,
+ mus_long_t out_start, mus_long_t out_framples, mus_long_t in_start,
+ mus_float_t *mx, int mx_chans, mus_any ***envs);
+
+MUS_EXPORT bool mus_is_sample_to_file(mus_any *ptr);
+MUS_EXPORT mus_any *mus_make_sample_to_file_with_comment(const char *filename, int out_chans, mus_sample_t samp_type, mus_header_t head_type, const char *comment);
+#define mus_make_sample_to_file(Filename, Chans, SampType, HeadType) mus_make_sample_to_file_with_comment(Filename, Chans, SampType, HeadType, NULL)
MUS_EXPORT mus_float_t mus_sample_to_file(mus_any *ptr, mus_long_t samp, int chan, mus_float_t val);
MUS_EXPORT mus_any *mus_continue_sample_to_file(const char *filename);
MUS_EXPORT int mus_close_file(mus_any *ptr);
MUS_EXPORT mus_any *mus_sample_to_file_add(mus_any *out1, mus_any *out2);
-MUS_EXPORT mus_float_t mus_out_any(mus_long_t frame, mus_float_t val, int chan, mus_any *IO);
+MUS_EXPORT mus_float_t mus_out_any(mus_long_t frample, mus_float_t val, int chan, mus_any *IO);
+MUS_EXPORT mus_float_t mus_safe_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO);
+MUS_EXPORT bool mus_out_any_is_safe(mus_any *IO);
MUS_EXPORT mus_float_t mus_out_any_to_file(mus_any *ptr, mus_long_t samp, int chan, mus_float_t val);
-MUS_EXPORT bool mus_frame_to_file_p(mus_any *ptr);
-MUS_EXPORT mus_any *mus_frame_to_file(mus_any *ptr, mus_long_t samp, mus_any *data);
-MUS_EXPORT mus_any *mus_make_frame_to_file_with_comment(const char *filename, int chans, int out_format, int out_type, const char *comment);
-#define mus_make_frame_to_file(Filename, Chans, OutFormat, OutType) mus_make_frame_to_file_with_comment(Filename, Chans, OutFormat, OutType, NULL)
-MUS_EXPORT mus_any *mus_continue_frame_to_file(const char *filename);
-
-MUS_EXPORT mus_float_t mus_locsig(mus_any *ptr, mus_long_t loc, mus_float_t val);
-MUS_EXPORT mus_any *mus_make_locsig(mus_float_t degree, mus_float_t distance, mus_float_t reverb, int chans, mus_any *output, int rev_chans, mus_any *revput, mus_interp_t type);
-MUS_EXPORT bool mus_locsig_p(mus_any *ptr);
+
+MUS_EXPORT void mus_locsig(mus_any *ptr, mus_long_t loc, mus_float_t val);
+MUS_EXPORT mus_any *mus_make_locsig(mus_float_t degree, mus_float_t distance, mus_float_t reverb, int chans,
+ mus_any *output, int rev_chans, mus_any *revput, mus_interp_t type);
+MUS_EXPORT bool mus_is_locsig(mus_any *ptr);
MUS_EXPORT mus_float_t mus_locsig_ref(mus_any *ptr, int chan);
MUS_EXPORT mus_float_t mus_locsig_set(mus_any *ptr, int chan, mus_float_t val);
MUS_EXPORT mus_float_t mus_locsig_reverb_ref(mus_any *ptr, int chan);
MUS_EXPORT mus_float_t mus_locsig_reverb_set(mus_any *ptr, int chan, mus_float_t val);
MUS_EXPORT void mus_move_locsig(mus_any *ptr, mus_float_t degree, mus_float_t distance);
-MUS_EXPORT mus_any *mus_locsig_outf(mus_any *ptr);
-MUS_EXPORT mus_any *mus_locsig_revf(mus_any *ptr);
+MUS_EXPORT mus_float_t *mus_locsig_outf(mus_any *ptr);
+MUS_EXPORT mus_float_t *mus_locsig_revf(mus_any *ptr);
MUS_EXPORT void *mus_locsig_closure(mus_any *ptr);
-
- /* these are for the optimizer (run.c) */
-MUS_EXPORT void mus_locsig_mono_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val);
-MUS_EXPORT void mus_locsig_mono(mus_any *ptr, mus_long_t loc, mus_float_t val);
-MUS_EXPORT void mus_locsig_stereo_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val);
-MUS_EXPORT void mus_locsig_stereo(mus_any *ptr, mus_long_t loc, mus_float_t val);
-MUS_EXPORT void mus_locsig_safe_mono_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val);
-MUS_EXPORT void mus_locsig_safe_mono(mus_any *ptr, mus_long_t loc, mus_float_t val);
-MUS_EXPORT void mus_locsig_safe_stereo_no_reverb(mus_any *ptr, mus_long_t loc, mus_float_t val);
-MUS_EXPORT void mus_locsig_safe_stereo(mus_any *ptr, mus_long_t loc, mus_float_t val);
+MUS_EXPORT void mus_locsig_set_detour(mus_any *ptr, void (*detour)(mus_any *ptr, mus_long_t val));
MUS_EXPORT int mus_locsig_channels(mus_any *ptr);
MUS_EXPORT int mus_locsig_reverb_channels(mus_any *ptr);
-MUS_EXPORT int mus_locsig_safety(mus_any *ptr);
-
-MUS_EXPORT bool mus_move_sound_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_move_sound(mus_any *ptr);
MUS_EXPORT mus_float_t mus_move_sound(mus_any *ptr, mus_long_t loc, mus_float_t val);
MUS_EXPORT mus_any *mus_make_move_sound(mus_long_t start, mus_long_t end, int out_channels, int rev_channels,
mus_any *doppler_delay, mus_any *doppler_env, mus_any *rev_env,
mus_any **out_delays, mus_any **out_envs, mus_any **rev_envs,
int *out_map, mus_any *output, mus_any *revput, bool free_arrays, bool free_gens);
-MUS_EXPORT mus_any *mus_move_sound_outf(mus_any *ptr);
-MUS_EXPORT mus_any *mus_move_sound_revf(mus_any *ptr);
+MUS_EXPORT mus_float_t *mus_move_sound_outf(mus_any *ptr);
+MUS_EXPORT mus_float_t *mus_move_sound_revf(mus_any *ptr);
MUS_EXPORT void *mus_move_sound_closure(mus_any *ptr);
+MUS_EXPORT void mus_move_sound_set_detour(mus_any *ptr, void (*detour)(mus_any *ptr, mus_long_t val));
+MUS_EXPORT int mus_move_sound_channels(mus_any *ptr);
+MUS_EXPORT int mus_move_sound_reverb_channels(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_src(mus_float_t (*input)(void *arg, int direction), mus_float_t srate, int width, void *closure);
+MUS_EXPORT mus_any *mus_make_src_with_init(mus_float_t (*input)(void *arg, int direction), mus_float_t srate, int width, void *closure, void (*init)(void *p, mus_any *g));
MUS_EXPORT mus_float_t mus_src(mus_any *srptr, mus_float_t sr_change, mus_float_t (*input)(void *arg, int direction));
-MUS_EXPORT bool mus_src_p(mus_any *ptr);
-MUS_EXPORT mus_float_t mus_src_20(mus_any *srptr, mus_float_t (*input)(void *arg, int direction));
-MUS_EXPORT mus_float_t mus_src_05(mus_any *srptr, mus_float_t (*input)(void *arg, int direction));
+MUS_EXPORT bool mus_is_src(mus_any *ptr);
+MUS_EXPORT mus_float_t *mus_src_20(mus_any *srptr, mus_float_t *in_data, mus_long_t dur);
+MUS_EXPORT mus_float_t *mus_src_05(mus_any *srptr, mus_float_t *in_data, mus_long_t dur);
+MUS_EXPORT void mus_src_to_buffer(mus_any *srptr, mus_float_t (*input)(void *arg, int direction), mus_float_t *out_data, mus_long_t dur);
+MUS_EXPORT void mus_src_init(mus_any *ptr);
-MUS_EXPORT bool mus_convolve_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_convolve(mus_any *ptr);
MUS_EXPORT mus_float_t mus_convolve(mus_any *ptr, mus_float_t (*input)(void *arg, int direction));
MUS_EXPORT mus_any *mus_make_convolve(mus_float_t (*input)(void *arg, int direction), mus_float_t *filter, mus_long_t fftsize, mus_long_t filtersize, void *closure);
@@ -529,7 +535,7 @@ MUS_EXPORT mus_float_t *mus_convolution(mus_float_t *rl1, mus_float_t *rl2, mus_
MUS_EXPORT void mus_convolve_files(const char *file1, const char *file2, mus_float_t maxamp, const char *output_file);
MUS_EXPORT mus_float_t *mus_cepstrum(mus_float_t *data, mus_long_t n);
-MUS_EXPORT bool mus_granulate_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_granulate(mus_any *ptr);
MUS_EXPORT mus_float_t mus_granulate(mus_any *ptr, mus_float_t (*input)(void *arg, int direction));
MUS_EXPORT mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *arg, int direction), int (*edit)(void *closure));
MUS_EXPORT mus_any *mus_make_granulate(mus_float_t (*input)(void *arg, int direction),
@@ -543,11 +549,9 @@ MUS_EXPORT void mus_granulate_set_edit_function(mus_any *ptr, int (*edit)(void *
MUS_EXPORT mus_long_t mus_set_file_buffer_size(mus_long_t size);
MUS_EXPORT mus_long_t mus_file_buffer_size(void);
-MUS_EXPORT void mus_mix(const char *outfile, const char *infile, mus_long_t out_start, mus_long_t out_samps, mus_long_t in_start, mus_any *mx, mus_any ***envs);
-MUS_EXPORT void mus_mix_with_reader_and_writer(mus_any *outf, mus_any *inf, mus_long_t out_start, mus_long_t out_frames, mus_long_t in_start, mus_any *umx, mus_any ***envs);
MUS_EXPORT mus_float_t mus_apply(mus_any *gen, mus_float_t f1, mus_float_t f2);
-MUS_EXPORT bool mus_phase_vocoder_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_phase_vocoder(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_phase_vocoder(mus_float_t (*input)(void *arg, int direction),
int fftsize, int overlap, int interp,
mus_float_t pitch,
@@ -570,19 +574,14 @@ MUS_EXPORT mus_float_t *mus_phase_vocoder_phase_increments(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_ssb_am(mus_float_t freq, int order);
-MUS_EXPORT bool mus_ssb_am_p(mus_any *ptr);
+MUS_EXPORT bool mus_is_ssb_am(mus_any *ptr);
MUS_EXPORT mus_float_t mus_ssb_am_unmodulated(mus_any *ptr, mus_float_t insig);
MUS_EXPORT mus_float_t mus_ssb_am(mus_any *ptr, mus_float_t insig, mus_float_t fm);
MUS_EXPORT void mus_clear_sinc_tables(void);
MUS_EXPORT void *mus_environ(mus_any *gen);
MUS_EXPORT void *mus_set_environ(mus_any *gen, void *e);
-
-
-/* used only in run.lisp */
-MUS_EXPORT mus_any *mus_make_frame_with_data(int chans, mus_float_t *data);
-MUS_EXPORT mus_any *mus_make_mixer_with_data(int chans, mus_float_t *data);
-
+MUS_EXPORT mus_any *mus_bank_generator(mus_any *g, int i);
#ifdef __cplusplus
}
#endif
@@ -592,6 +591,46 @@ MUS_EXPORT mus_any *mus_make_mixer_with_data(int chans, mus_float_t *data);
/* Change log.
*
+ * 5-Aug: removed some now-obsolete mus_locsig functions.
+ * 5-Jul: added stable arg to mus_make_oscil_bank.
+ * 15-Feb: removed mus_set_name, changed mus_free to void.
+ * 31-Jan-15: removed mus_multiply_arrays.
+ * --------
+ * 8-Nov: mus_copy, mus_bank_generator.
+ * 24-Oct: mus_generator_set_feeders.
+ * 10-Aug: data-format -> sample-type.
+ * 17-Apr: moving_norm generator.
+ * 14-Apr: mus_frame and mus_mixer removed, "frame" replaced by "frample" in IO functions.
+ * 11-Apr: mus_even|odd_weight|multiple.
+ * 9-Apr: deprecate mus_is_delay_line.
+ * 2-Apr: mus_make_moving_average_with_sum.
+ * 19-Mar: deprecate mus_make_env_with_length.
+ * 17-Feb-14: mus_*_p -> mus_is_*.
+ * --------
+ * 7-Dec: mus_set_formant_frequency, mus_src_20 and mus_src_05 changed. Removed mus_in_any_from_file.
+ * 29-Nov: mus_make_polywave_tu.
+ * 11-Oct: mus_vector_to_file, mus_vector_mix.
+ * 19-Apr: rxyk!cos and rxyk!sin from generators.scm.
+ * 11-Apr: mus_tap_p as a better name for mus_delay_line_p.
+ * 27-Mar: comb-bank, all-pass-bank, filtered-comb-bank, pulsed-env, oscil-bank.
+ * 21-Mar: one-pole-all-pass generator.
+ * 14-Mar: formant-bank generator.
+ * removed mus_delay_tick_noz.
+ * 4-Mar: moving_max generator.
+ * removed the unstable filter check in make_two_pole.
+ * 21-Jan-13: changed mus_formant_bank parameters.
+ * --------
+ * 22-Dec: removed all the safety settings.
+ * 15-Nov: removed mus_env_t, mus_env_type, and other recently deprecated stuff.
+ * 15-Jul: more changes for clm2xen.
+ * 4-July-12: moved various struct definitions to clm.c
+ * added accessors for mus_any_class etc.
+ * --------
+ * 1-Sep: mus_type.
+ * 20-Aug: changed type of mus_locsig to void, added mus_locsig_function_reset.
+ * removed function-as-output-location from locsig et al.
+ * 14-Jul-11: removed pthread stuff.
+ * --------
* 7-Mar-10: protect in-any and out-any from sample numbers less than 0.
* --------
* 14-Oct: sine-summation, sum-of-sines, sum-of-cosines removed.
@@ -608,7 +647,7 @@ MUS_EXPORT mus_any *mus_make_mixer_with_data(int chans, mus_float_t *data);
* 11-Dec: deprecated the sine-summation, sum-of-cosines, and sum-of-sines generators.
* 30-Oct: mus_sample_to_file_add.
* mus_describe once again allocates a fresh output string.
- * finally removed sine-bank (snd9.scm has replacement).
+ * finally removed sine-bank.
* 9-Oct: various thread-related internal changes.
* 14-Jul: mus_data_format_zero.
* 12-Jul: mus_interp_type_p and mus_fft_window_p for C++'s benefit.
@@ -664,7 +703,7 @@ MUS_EXPORT mus_any *mus_make_mixer_with_data(int chans, mus_float_t *data);
* 30-July: renamed average to moving_average.
* 28-July: renamed make_ppolar and make_zpolar to make_two_pole|zero_from_radius_and_frequency.
* added mus_scaler and mus_frequency methods for two_pole and two_zero.
- * 21-July: removed mus_wrapper field -- old way can't work since we need the original XEN object.
+ * 21-July: removed mus_wrapper field -- old way can't work since we need the original Xen object.
* 3-July: mus_move_sound (dlocsig) generator.
* changed return type of mus_locsig to float.
* 28-June: mus_filtered_comb generator.
diff --git a/clm.rb b/clm.rb
index cc6b86f..3d78d94 100644
--- a/clm.rb
+++ b/clm.rb
@@ -1,11 +1,9 @@
# clm.rb -- Ruby extension
# Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Wed Oct 14 23:02:57 CEST 2009
-# Changed: Sat Feb 19 17:17:01 CET 2011
+# Created: 09/10/14 23:02:57
+# Changed: 14/11/30 18:00:42
-# Commentary:
-#
# Ruby extensions:
#
# array?(obj) alias list?(obj)
@@ -66,6 +64,7 @@
# make_array(len, init, &body)
# Array#insert
# Float#step
+# Numeric#to_c
# Range#step
# Enumerable#each_index
# Enumerable#zip
@@ -129,7 +128,6 @@
# class Vct
# Vct[]
# name
-# to_sound_data(sd, chn)
# to_vct
# to_vector
# apply(func, *rest, &body)
@@ -147,21 +145,6 @@
# +(other) handles other.offset on Vct, Array, and Vec
# *(other) handles other.scale on Vct, Array, and Vec
#
-# SoundData(ary) can be used to reread evaled output from sound_data2string
-# sound_data2string(sd) produces a string which can be evaled and reread with SoundData
-#
-# class SoundData
-# name
-# to_vct(chn)
-# to_a
-# length
-# scale!(scl)
-# fill!(val)
-# each(chn)
-# each_with_index(chn)
-# map(chn)
-# map!(chn)
-#
# mus_a0(gen)
# set_mus_a0(gen, val)
# mus_a1(gen)
@@ -392,8 +375,8 @@ end
def assert_type(condition, obj, pos, msg)
condition or Kernel.raise(TypeError,
- format("%s: wrong type arg %d, %s, wanted %s",
- get_func_name(2), pos, obj.inspect, msg))
+ format("%s: wrong type arg %d, %p, wanted %s",
+ get_func_name(2), pos, obj, msg))
end
def identity(arg)
@@ -409,7 +392,9 @@ unless defined? $LOADED_FEATURES
end
def provided?(feature)
- $LOADED_FEATURES.map do |f| File.basename(f) end.member?(feature.to_s.tr("_", "-"))
+ $LOADED_FEATURES.map do |f|
+ File.basename(f)
+ end.member?(feature.to_s.tr("_", "-"))
end
def provide(feature)
@@ -452,35 +437,26 @@ def with_silence(exception = StandardError)
ret
end
-include Math
-
-TWO_PI = PI * 2.0 unless defined? TWO_PI
-HALF_PI = PI * 0.5 unless defined? HALF_PI
-
# ruby19 moved complex.rb and rational.rb to C
# (See ruby/Changelog Sun Mar 16 08:51:41 2008.)
-# FIXME
-# Thu Nov 18 01:26:45 CET 2010
-# with ruby19 and C Complex
-# val < 1.0 ==> Math::DomainError: Numerical argument is out of domain - "acosh"
-#unless defined? Complex
-with_silence do
- # lib/complex.rb is deprecated
- require "complex"
+if defined? Complex
+ require "cmath"
+ include CMath
+else
+ with_silence do
+ # lib/complex.rb is deprecated
+ require "complex"
+ end
+ include Math
end
+
unless defined? Rational
with_silence do
- # warning: method redefined; discarding old numerator|denominator|gcd|lcm
+ # lib/rational.rb is deprecated
require "rational"
end
end
-# ruby19 moved Continuation to 'continuation'!
-# (See ruby/ChangeLog Tue Jan 20 16:17:12 2009.)
-unless defined? Kernel.callcc
- require "continuation"
-end
-
unless provided?(:sndlib)
with_silence do
# warning: method redefined; discarding old rand
@@ -488,6 +464,9 @@ unless provided?(:sndlib)
end
end
+TWO_PI = PI * 2.0 unless defined? TWO_PI
+HALF_PI = PI * 0.5 unless defined? HALF_PI
+
#
# Backward compatibility aliases and constants (from sndXX.scm)
#
@@ -496,15 +475,7 @@ if provided? :snd
alias save_options save_state
alias delete_samples_with_origin delete_samples
alias default_output_type default_output_header_type
- alias default_output_format default_output_data_format
- alias previous_files_sort view_files_sort
- alias preload_directory add_directory_to_view_files_list
- alias preload_file add_file_to_view_files_list
- alias $previous_files_select_hook $view_files_select_hook
- Sort_files_by_name = 0
- Sort_files_by_date = 2
- Sort_files_by_size = 4
- Sort_files_by_entry = -1
+ alias default_output_format default_output_sample_type
alias mus_audio_set_oss_buffers mus_oss_set_buffers
unless defined? mus_file_data_clipped
alias mus_file_data_clipped mus_clipping
@@ -519,33 +490,6 @@ if provided? :snd
alias make_average make_moving_average
alias average moving_average
alias average? moving_average?
- # *windowed_maxamp -> dsp.rb
- def samples2sound_data(beg = 0,
- num = false,
- snd = false,
- chn = false,
- obj = false,
- pos = false,
- sd_chan = 0)
- len = (num or frames(snd, chn))
- gen = (obj or make_sound_data(1, len))
- vct2sound_data(channel2vct(beg, len, snd, chn, pos), gen, sd_chan)
- end
-
- def open_sound_file(*args)
- mus_sound_open_output(get_args(args, :file, (little_endian ? "test.wav" : "test.snd")),
- get_args(args, :srate, 44100),
- get_args(args, :channels, 1),
- (little_endian ? Mus_lfloat : Mus_bfloat),
- get_args(args, :header_type, (little_endian ? Mus_riff : Mus_next)),
- get_args(args, :comment, ""))
- end
-
- alias close_sound_file mus_sound_close_output
-
- def vct2sound_file(fd, v, samps)
- mus_sound_write(fd, 0, samps - 1, 1, vct2sound_data(v))
- end
# snd10.scm
def make_sum_of_sines(*args)
@@ -588,6 +532,11 @@ if provided? :snd
end
alias sine_summation nrxysin
alias sine_summation? nrxysin?
+
+ # snd13.scm
+ def clm_print(fmt, *args)
+ snd_print(format(fmt, *args))
+ end unless defined? clm_print
end
# enum("foo", :bar, "FOO_BAR")
@@ -595,17 +544,28 @@ end
# Foo == 0
# Bar == 1
# FOO_BAR == 2
-def enum(*names)
- cap_alpha = ?A.kind_of?(String) ? ?A.sum : ?A
- lit_alpha = ?a.kind_of?(String) ? ?a.sum : ?a
- letter_diff = cap_alpha - lit_alpha
- names.flatten.map_with_index do |name, i|
- const_name = name.to_s
- if const_name[0].between?(?a, ?z)
- const_name[0] += letter_diff
+if ?a.kind_of?(String)
+ def enum(*names)
+ names.map_with_index do |name, i|
+ const_name = name.to_s
+ const_name[0] = const_name[0].capitalize
+ Object.const_set(const_name, i)
+ const_name
+ end
+ end
+else
+ def enum(*names)
+ cap_alpha = ?A.kind_of?(String) ? ?A.sum : ?A
+ lit_alpha = ?a.kind_of?(String) ? ?a.sum : ?a
+ letter_diff = cap_alpha - lit_alpha
+ names.map_with_index do |name, i|
+ const_name = name.to_s
+ if const_name[0].between?(?a, ?z)
+ const_name[0] += letter_diff
+ end
+ Object.const_set(const_name, i)
+ const_name
end
- Object.const_set(const_name, i)
- const_name
end
end
@@ -731,11 +691,14 @@ if $DEBUG and RUBY_VERSION < "1.8.0"
class Object
def method_missing(id, *args)
if id == :to_str
- self.class.class_eval do define_method(id, lambda do | | self.to_s end) end
+ self.class.class_eval do
+ define_method(id, lambda do | | self.to_s end)
+ end
id.id2name
else
Kernel.raise(NameError,
- format("[version %s] undefined method `%s'", RUBY_VERSION, id.id2name))
+ format("[version %s] undefined method `%s'",
+ RUBY_VERSION, id.id2name))
end
end
end
@@ -768,7 +731,8 @@ module Info
alias info= description=
def description
- if defined?(@description) and string?(@description) and (not @description.empty?)
+ if defined?(@description) and
+ string?(@description) and (not @description.empty?)
@description
else
"no description available"
@@ -827,9 +791,9 @@ module Enumerable
# Enumerable#zip, new in ruby core since 19-Nov-2002.
# a = [4, 5, 6]
# b = [7, 8, 9]
- # [1, 2, 3].zip(a, b) --> [[1, 4, 7], [2, 5, 8], [3, 6, 9]]
- # [1, 2].zip(a, b) --> [[1, 4, 7], [2, 5, 8]]
- # a.zip([1, 2],[8]) --> [[4, 1, 8], [5, 2, nil], [6, nil, nil]]
+ # [1, 2, 3].zip(a, b) ==> [[1, 4, 7], [2, 5, 8], [3, 6, 9]]
+ # [1, 2].zip(a, b) ==> [[1, 4, 7], [2, 5, 8]]
+ # a.zip([1, 2],[8]) ==> [[4, 1, 8], [5, 2, nil], [6, nil, nil]]
def clm_zip(*objs)
args = objs.map do |obj| obj.to_a end
res = self.to_a
@@ -860,7 +824,7 @@ def make_array(len = 0, init = nil)
Array.new(len, init)
end
else
- Kernel.raise(TypeError, format("array length < 0 (%s)?", len.inspect))
+ Kernel.raise(TypeError, format("array length < 0 (%p)?", len))
end
end
@@ -877,17 +841,19 @@ class Array
self
end unless defined? [].insert
- # [0.0, 0.0, 0.5, 0.2, 1.0, 1.0].to_pairs --> [[0.0, 0.0], [0.5, 0.2], [1.0, 1.0]]
+ # [0.0, 0.0, 0.5, 0.2, 1.0, 1.0].to_pairs
+ # ==> [[0.0, 0.0], [0.5, 0.2], [1.0, 1.0]]
def to_pairs
ary = []
self.step(2) do |a, b| ary.push([a, b]) end
ary
end
- # [0.0, 0.0, 0.5, 0.2, 1.0, 1.0].each_pair do |x, y| print x, " ", y, "\n" end
- # --> 0.0 0.0
- # 0.5 0.2
- # 1.0 1.0
+ # [0.0, 0.0, 0.5, 0.2, 1.0, 1.0].each_pair do |x, y|
+ # print x, " ", y, "\n"
+ # end ==> 0.0 0.0
+ # 0.5 0.2
+ # 1.0 1.0
def each_pair
ary = []
self.step(2) do |a, b| ary.push(yield(a, b)) end
@@ -1062,11 +1028,11 @@ class Array
end
add_help(:apply,
- "Array#apply([:func,] *rest, &body)
-applies function or procedure with possible rest args \
+ "Array#apply([:func,] *rest, &body) \
+Applies function or procedure with possible rest args \
to each element of Array or subclasses of Array.
- [0, 1, 2].apply(\"a: %d\\n\") do |fmt, a| printf(fmt, a) end
- [0, 1, 2].apply(:printf, \"a: %d\\n\")
+ [0, 1, 2].apply(\"a: %d\\n\") do |fmt, a| printf(fmt, a) end
+ [0, 1, 2].apply(:printf, \"a: %d\\n\")
both produce
a: 0
a: 1
@@ -1093,12 +1059,15 @@ a: 2
else
receiver = self.compact.first
meths = receiver.methods
- if receiver and (meths.member?(func.to_s) or meths.member?(func.to_sym))
+ if receiver and
+ (meths.member?(func.to_s) or meths.member?(func.to_sym))
# methods
case func.to_sym
when :+, :-, :*
res = receiver
- self[1..-1].compact.map do |item| res = res.send(func, *rest + [item]) end
+ self[1..-1].compact.map do |item|
+ res = res.send(func, *rest + [item])
+ end
res
else
len = rest.length + ((array?(receiver) and receiver.length) or 1)
@@ -1119,7 +1088,8 @@ a: 2
end
end
- # original operands +, -, and * can now handle nil and numberic (offset, multiply)
+ # original operands +, -, and * can now handle nil and numberic
+ # (offset, multiply)
#
# [].+(ary) concatenate arrays
# [].+(number) [].add(number)
@@ -1188,10 +1158,11 @@ class Vec < Array
super(len, init)
end
else
- Kernel.raise(TypeError, format("array length < 0 (%s)?", len.inspect))
+ Kernel.raise(TypeError, format("array length < 0 (%p)?", len))
end
if test = self.detect do |x| (not number?(x)) end
- Kernel.raise(TypeError, format("only numeric elements (%s)?", test.inspect))
+ Kernel.raise(TypeError,
+ format("only numeric elements (%p)?", test))
end
end
@@ -1250,7 +1221,8 @@ end
def Vec(obj)
if obj.nil? then obj = [] end
assert_type(obj.respond_to?(:to_vector), obj, 0,
- "an object containing method 'to_vector' (Vct, String, Array and subclasses)")
+ "an object containing method \
+'to_vector' (Vct, String, Array and subclasses)")
obj.to_vector
end
@@ -1287,7 +1259,8 @@ end
def Vct(obj)
if obj.nil? then obj = [] end
assert_type(obj.respond_to?(:to_vct), obj, 0,
- "an object containing method 'to_vct' (Vct, String, Array and subclasses)")
+ "an object containing method \
+'to_vct' (Vct, String, Array and subclasses)")
obj.to_vct
end
@@ -1307,16 +1280,8 @@ class Vct
def name
self.class.to_s.downcase
end
-
- def to_sound_data(sd = nil, chn = 0)
- if sound_data?(sd)
- vct2sound_data(self, sd, chn)
- else
- vct2sound_data(self)
- end
- end
- def to_vct(chn = 0) # CHN for compatibility with sound-data
+ def to_vct
self
end
@@ -1481,91 +1446,6 @@ class Float
end
end
-def SoundData(ary)
- assert_type((array?(ary) and vct?(ary.first)), ary, 0, "an array of vcts")
- sd = SoundData.new(ary.length, ary.first.length)
- ary.each_with_index do |v, chn| vct2sound_data(v, sd, chn) end
- sd
-end
-
-def sound_data2string(sd)
- sd.to_a.to_s
-end
-
-def sound_data2vector(sd)
- make_array(sd.chans) do |chn|
- sound_data2vct(sd, chn).to_a
- end
-end
-
-class SoundData
- def name
- "sound-data"
- end
-
- def to_vct(chn = 0)
- sound_data2vct(self, chn)
- end
-
- # returns an array of sd.chans vcts
- def to_a
- sound_data2vector(self)
- end
-
- alias sd_length length
- def length
- self.size / self.chans
- end
-
- def fill!(val)
- sound_data_fill!(self, val)
- end
-
- alias sd_each each
- def each(chn = nil)
- if chn
- self.length.times do |i| yield(self[chn, i]) end
- else
- self.sd_each do |val| yield(val) end
- end
- end
-
- def each_with_index(chn = nil)
- if chn
- self.length.times do |i| yield(self[chn, i], i) end
- else
- self.length.times do |i|
- self.chans.times do |j| yield(self[j, i], i) end
- end
- end
- end
-
- def map(chn = nil)
- sd = nil
- if chn
- sd = self.dup
- self.each_with_index(chn) do |val, i| sd[chn, i] = yield(val) end
- else
- sd = SoundData.new(self.chans, self.length)
- self.chans.times do |j|
- self.each_with_index(j) do |val, i| sd[j, i] = yield(val) end
- end
- end
- sd
- end
-
- def map!(chn = nil)
- if chn
- self.each_with_index(chn) do |val, i| self[chn, i] = yield(val) end
- else
- self.chans.times do |j|
- self.each_with_index(j) do |val, i| self[j, i] = yield(val) end
- end
- end
- self
- end
-end
-
def mus_a0(gen)
mus_xcoeff(gen, 0)
end
@@ -1740,6 +1620,13 @@ class Numeric
def negative?
self < 0
end
+
+ # According to Ruby's ChangeLog-2.0.0:
+ # Wed Nov 21 21:53:29 2012 Tadayoshi Funaba <tadf at dotrb.org>
+ # * complex.c (nucomp_to_c): added.
+ def to_c
+ Complex(self)
+ end unless defined? 1.to_c
end
class Integer
@@ -1753,12 +1640,13 @@ class Integer
def prime?
(self == 2) or
- (self.odd? and 3.step(sqrt(self), 2) do |i| return false if self.modulo(i) == 0 end)
+ (self.odd? and
+ 3.step(sqrt(self), 2) do |i| return false if self.modulo(i) == 0 end)
end
end
class Float
- # step accepts floats as arguments (still implemented in newer versions)
+ # step accepts floats as arguments (implemented in newer versions)
def step(upto, step)
counter = self
while counter < upto
@@ -1783,15 +1671,18 @@ def as_one_edit_rb(*origin, &body)
end
def map_channel_rb(beg = 0, dur = false,
- snd = false, chn = false, edpos = false, edname = false, &func)
+ snd = false, chn = false,
+ edpos = false, edname = false, &func)
map_channel(func, beg, dur, snd, chn, edpos, edname)
end
add_help(:map_chan_rb,
- "map_chan(func,[start=0,[end=false,[edname=false,[snd=false,[chn=false,[edpos=false]]]]]])\
- map_chan applies func to samples in the specified channel.\
- It is the old (\"irregular\") version of map_channel.")
-def map_chan_rb(beg = 0, dur = false, ednam = false, snd = false, chn = false, edpos = false, &func)
+ "map_chan(func, start=0, end=false, edname=false, \
+snd=false, chn=false, edpos=false) \
+Applies FUNC to samples in the specified channel. \
+It is the old (\"irregular\") version of map_channel.")
+def map_chan_rb(beg = 0, dur = false, ednam = false,
+ snd = false, chn = false, edpos = false, &func)
map_chan(func, beg, dur, ednam, snd, chn, edpos)
end
@@ -1800,9 +1691,9 @@ class Proc
alias run call
add_help(:to_method,
- "Proc#to_method(name, [klass=Object]) \
-converts a Proc to a Method 'name' in the given class, default Object. \
-'name' can be a string or a symbol.
+ "Proc#to_method(name, klass=Object) \
+Converts a Proc to a Method 'name' in the given class, default Object. \
+NAME can be a string or a symbol.
m = lambda do |*args| p args end
m.to_method(:func)
@@ -1834,7 +1725,8 @@ lambda do |x| p x end.to_method(\"bar\"); bar(\"text2\") ==> \"text2\"")
# eval'ed by the Snd listener (or in Emacs). You must load the file
# instead.
#
- # with_sound(:notehook, lambda do |name| snd_print(name) if name =~ /viol/ end) do
+ # with_sound(:notehook,
+ # lambda do |name| snd_print(name) if name =~ /viol/ end) do
# fm_violin(0, 1, 440, 0.3)
# end
#
@@ -1856,15 +1748,17 @@ lambda do |x| p x end.to_method(\"bar\"); bar(\"text2\") ==> \"text2\"")
file, line = self.to_s.sub(/>/, "").split(/@/).last.split(/:/)
if file[0] == ?( and file[-1] == ?)
if $VERBOSE
- warning("%s#%s: no file found for procedure %s", self.class, get_func_name, self.inspect)
+ warning("%s#%s: no file found for procedure %p",
+ self.class, get_func_name, self)
end
body = ""
- elsif (not File.exists?(file))
+ elsif (not File.exist?(file))
if $VERBOSE
- warning("%s#%s: Sorry, you need a higher ruby version to use Proc#to_str.
+ warning("%s#%s: \
+Sorry, you need a higher ruby version to use Proc#to_str.
It works only with newer ruby versions (I assume >= 1.8.x).
-Proc#inspect must return #<Proc:0x01234567 at xxx:x> not only %s!",
- self.class, get_func_name, self.inspect)
+Proc#inspect must return #<Proc:0x01234567 at xxx:x> not only %p!",
+ self.class, get_func_name, self)
end
body = ""
else
@@ -1877,7 +1771,8 @@ Proc#inspect must return #<Proc:0x01234567 at xxx:x> not only %s!",
next if i < lineno
body << ln
if first_line
- if (ln.scan(/\s*do\b|\{/).length - ln.scan(/\s*end\b|\}/).length).zero? and
+ if (ln.scan(/\s*do\b|\{/).length -
+ ln.scan(/\s*end\b|\}/).length).zero? and
(ln.scan(/\(/).length - ln.scan(/\)/).length).zero?
break
else
@@ -1939,7 +1834,9 @@ end
# the current (or other) environment in the proc body:
#
# os = make_oscil(:frequency, 330)
-# prc = make_proc_with_source(%(lambda do | | 10.times do |i| p os.run end end), binding)
+# prc = make_proc_with_source(%(lambda do | |
+# 10.times do |i| p os.run end
+# end), binding)
# puts prc.source ==> lambda do | | 10.times do |i| p os.run end end
# prc.call ==> ..., 0.748837699712728
# puts
@@ -1973,10 +1870,12 @@ make_proc_with_setter(:proc_source,
# start_emacs_eval # installs emacs-eval-hook
make_hook("$emacs_eval_hook", 1, "\
-emacs_eval_hook(line): called each time inf-snd.el sends a line to the Snd process. \
+emacs_eval_hook(line): \
+called each time inf-snd.el sends a line to the Snd process. \
The hook functions may do their best to deal with multi-line input; \
they can collect multi-line input and eval it by itself. \
-One example is install_eval_hooks(file, retval, input, hook, &reset_cursor) in clm.rb.")
+One example is install_eval_hooks(file, retval, input, hook, &reset_cursor) \
+in clm.rb.")
# inf-snd.el calls this function each time a line was sent to the
# emacs buffer.
@@ -2020,8 +1919,8 @@ end
class Snd_prompt
# level number inserted into original prompt
- # ">" --> "(0)>"
- # "snd> " --> "snd(0)> "
+ # ">" ==> "(0)>"
+ # "snd> " ==> "snd(0)> "
def initialize(level)
@listener_prompt = listener_prompt
@base_prompt = listener_prompt.split(/(\(\d+\))?(>)?\s*$/).car.to_s
@@ -2102,16 +2001,22 @@ end
# Debugging resp. inspecting local variables
make_proc_with_setter(:debug_properties,
- lambda do |name| property(name, :debug_property) end,
- lambda do |name, val| set_property(name, :debug_property, val) end)
+ lambda do |name|
+ property(name, :debug_property)
+ end,
+ lambda do |name, val|
+ set_property(name, :debug_property, val)
+ end)
make_proc_with_setter(:debug_property,
lambda do |key, name|
hash?(h = debug_properties(name)) and h[key]
end,
lambda do |key, val, name|
- unless hash?(h = debug_properties(name)) and h.store(key, [val] + h[key])
- unless array?(a = property(:debug, :names)) and a.push(name)
+ h = debug_properties(name)
+ unless hash?(h) and h.store(key, [val] + h[key])
+ a = property(:debug, :names)
+ unless array?(a) and a.push(name)
set_property(:debug, :names, [name])
end
set_debug_properties(name, {key => [val]})
@@ -2123,7 +2028,8 @@ make_proc_with_setter(:debug_binding,
debug_property(:binding, name)
end,
lambda do |bind, *name|
- set_debug_property(:binding, bind, (name[0] or get_func_name(3)))
+ set_debug_property(:binding, bind,
+ (name[0] or get_func_name(3)))
end)
# Shows all local variables of last call of functions prepared with
@@ -2229,7 +2135,7 @@ else
end
add_help(:times2samples,
- "times2samples(start, dur) \
+ "times2samples(start, dur) \
START and DUR are in seconds; returns array [beg, end] in samples.")
def times2samples(start, dur)
beg = seconds2samples(start)
@@ -2250,8 +2156,12 @@ def random(val)
end
def logn(r, b = 10)
- if r <= 0 then Snd.raise(:ruby_error, r, "r must be > 0") end
- if b <= 0 or b == 1 then Snd.raise(:ruby_error, b, "b must be > 0 and != 1") end
+ if r <= 0
+ Snd.raise(:ruby_error, r, "r must be > 0")
+ end
+ if b <= 0 or b == 1
+ Snd.raise(:ruby_error, b, "b must be > 0 and != 1")
+ end
log(r) / log(b)
end
@@ -2286,10 +2196,15 @@ def verbose_message_string(stack_p, remark, *args)
format("%s%s", remark, str)
end
if $!
- str += format("[%s] %s (%s)", rb_error_to_mus_tag.inspect, snd_error_to_message, $!.class)
- if stack_p then str += format("\n%s%s", remark, $!.backtrace.join(fmt_remark)) end
+ str += format("[%p] %s (%s)",
+ rb_error_to_mus_tag, snd_error_to_message, $!.class)
+ if stack_p
+ str += format("\n%s%s", remark, $!.backtrace.join(fmt_remark))
+ end
else
- if stack_p and caller(2) then str += format("\n%s%s", remark, caller(2).join(fmt_remark)) end
+ if stack_p and caller(2)
+ str += format("\n%s%s", remark, caller(2).join(fmt_remark))
+ end
end
str
end
@@ -2298,10 +2213,10 @@ def warning(*args)
str = "Warning: " << verbose_message_string($VERBOSE, nil, *args)
if provided? :snd
snd_warning(str)
- nil
else
clm_message(str)
end
+ nil
end
def die(*args)
@@ -2314,8 +2229,10 @@ def error(*args)
end
make_proc_with_setter(:snd_input,
- lambda { property(:snd_input, :snd_listener) },
- lambda { |val| set_property(:snd_input, :snd_listener, val) })
+ lambda do property(:snd_input, :snd_listener) end,
+ lambda do |val|
+ set_property(:snd_input, :snd_listener, val)
+ end)
# like clm_print(fmt, *args)
@@ -2337,6 +2254,7 @@ def clm_message(*args)
else
$stdout.print(msg, "\n")
end
+ nil
end
# like clm_print(*args), in emacs it prepends msg with a comment sign
@@ -2345,12 +2263,12 @@ def message(*args)
clm_message(verbose_message_string(false, "# ", *args))
end
-# debug(var1, var2) --> #<DEBUG: ClassName: value1, ClassName: value2>
+# debug(var1, var2) ==> #<DEBUG: ClassName: value1, ClassName: value2>
def debug(*args)
fmt = ""
args.each do |arg|
- fmt += format("%s: %s", arg.class, arg.inspect)
+ fmt += format("%s: %p", arg.class, arg)
fmt += ", "
end
message("#<DEBUG: %s>", fmt.chomp(", "))
@@ -2367,20 +2285,11 @@ class Snd
class << Snd
Snd_path = Array.new
- if provided? :snd
+ if provided? :snd_motif
def add_sound_path(path)
Snd_path.push(path)
add_directory_to_view_files_list(path)
end
-
- def open_from_path(fname)
- snd_file = Snd.fullname(fname)
- find_sound(snd_file) or open_sound(snd_file)
- end
-
- def find_from_path(fname)
- find_sound(Snd.fullname(fname))
- end
else
def add_sound_path(path)
Snd_path.push(path)
@@ -2388,18 +2297,27 @@ class Snd
end
def fullname(fname)
- if File.exists?(fname)
+ if File.exist?(fname)
fname
else
f = File.basename(fname)
Snd_path.each do |path|
- if File.exists?(path + "/" + f)
+ if File.exist?(path + "/" + f)
return path + "/" + f
end
end
Snd.raise(:no_such_file, fname)
end
end
+
+ def open_from_path(fname)
+ snd_file = Snd.fullname(fname)
+ find_sound(snd_file) or open_sound(snd_file)
+ end
+
+ def find_from_path(fname)
+ find_sound(Snd.fullname(fname))
+ end
def load_path
Snd_path
@@ -2423,20 +2341,20 @@ class Snd
else
clm_print("\n%s", msg)
end
- nil
else
$stdout.print(msg, "\n")
end
+ nil
end
def warning(*args)
if provided? :snd
snd_warning(verbose_message_string($VERBOSE, nil, *args))
- nil
else
args[0] = "Warning: " + String(args[0])
Snd.display(verbose_message_string($VERBOSE, "# ", *args))
end
+ nil
end
def die(*args)
@@ -2488,7 +2406,8 @@ class Snd
$DEBUG = false
val = Kernel.catch(tag) do yield end
# catch/throw part
- if array?(val) and val.car == :snd_throw # [:snd_throw, tag, get_func_name(2), *rest]
+ # [:snd_throw, tag, get_func_name(2), *rest]
+ if array?(val) and val.car == :snd_throw
if retval != :undefined
if proc?(retval)
retval.call(val.cdr)
@@ -2503,8 +2422,8 @@ class Snd
end
# ruby1.9/ChangeLog
# Thu Feb 2 16:01:24 2006 Yukihiro Matsumoto <matz at ruby-lang.org>
- # * error.c (Init_Exception): change NameError to direct subclass of
- # Exception so that default rescue do not handle it silently.
+ # * error.c (Init_Exception): change NameError to direct subclass of
+ # Exception so that default rescue do not handle it silently.
rescue Interrupt, ScriptError, NameError, StandardError
mus_tag = rb_error_to_mus_tag
# raise part
@@ -2530,7 +2449,7 @@ class Snd
end
def raise(tag, *rest)
- msg = format("%s: %s:", get_func_name(2), tag)
+ msg = format("%s in %s:", tag, get_func_name(2))
rest.each do |s| msg += format(" %s,", s) end
msg.chomp!(",")
exception = case tag
@@ -2626,21 +2545,11 @@ Snd_error_tags = [# clm2xen.c
:no_such_resource]
def rb_error_to_mus_tag
- # to_s and string error-names intended here
+ # to_s and string error-names intentional here
# otherwise e.g. NameError goes to case StandardError!
case $!.class.to_s
- # case 1
- # No_such_file: file->array /baddy/hiho No such file or directory
- # case 2
- # insert_region: No_such_region: 1004
- # case 3 (mus_error)
- # mus_ycoeff__invalid_index_123__order___3?: Mus_error
- # can't translate /usr/gnu/sound/sf1/oboe.g721 to /usr/gnu/sound/sf1/oboe.g721.snd:
- # : Mus_error>
when "StandardError"
- err = $!.message.split(/\n/).first.downcase.split(/:/).map do |e| e.strip.chomp(">") end
- # err = $!.message.delete("\n").downcase.split(/:/).compact.map do |e| e.strip.chomp(">") end
- Snd_error_tags.detect do |tag| err.member?(tag.to_s) end or :standard_error
+ $!.message.split(/[: ]/).first.downcase.intern
when "RangeError"
:out_of_range
when "TypeError"
@@ -2648,48 +2557,29 @@ def rb_error_to_mus_tag
when "ArgumentError"
:wrong_number_of_args
else
- # converts ruby exceptions to symbols: NoMethodError --> :no_method_error
- $!.class.to_s.gsub(/([A-Z])/) do |c| "_" + c.tr("A-Z", "a-z") end[1..-1].intern
+ # converts ruby exceptions to symbols: NoMethodError ==> :no_method_error
+ $!.class.to_s.gsub(/([A-Z])/) do |c|
+ "_" + c.tr("A-Z", "a-z")
+ end[1..-1].intern
end
end
def snd_error_to_message
- err = $!.message.split(/:/).map do |e| e.strip.chomp("\n") end
- str = err.join(": ")
- if err.length > 1 and (len = str.scan(/~A/).length).positive?
- str.gsub!(/~A/, "%s")
- str = if $!.class == RangeError
- format(str.strip, if string?(s = err.cadr.split(/,/)[1..-2].join(","))
- eval(s)
- else
- 0
- end)
- else
- format(str.strip, if string?(s = str.slice!(str.index("[")..str.index("]")))
- eval(s)
- else
- [0] * len
- end)
- end
- end
- str.gsub(/#{rb_error_to_mus_tag.to_s.capitalize + ": "}/, "")
-rescue Interrupt, ScriptError, NameError, StandardError
- if $DEBUG
- $stderr.printf("# Warning (%s)\n", get_func_name)
- each_variables do |var, val| $stderr.printf("# %s = %s\n", var, val.inspect) end
- end
- str
+ $!.message.split(/\n/).first.sub(/^.*: /, "")
end
add_help(:snd_catch,
- "snd_catch([tag=:all, [retval=:undefined]]) \
-catchs snd_throw and exceptions and \
+ "snd_catch(tag=:all, retval=:undefined]) \
+Catchs snd_throw and exceptions and \
returns body's last value wrapped in an array if all goes well. \
If a snd_throw tag meets snd_catch's, returns an array with the tag name, \
-the function name from where was thrown and optional arguments given to snd_throw. \
+the function name from where was thrown \
+and optional arguments given to snd_throw. \
If an exception was risen and the exception name meets tag name, \
-returns an array with tag name and the exception message, otherwise reraises exception. \
-If retval is given and tag matches exception or snd_throw tag, returns retval. \
+returns an array with tag name and the exception message, \
+otherwise reraises exception. \
+If retval is given and tag matches exception or snd_throw tag, \
+returns retval. \
If retval is a procedure, calls retval with tag name and message.
res = snd_catch do 10 + 2 end
@@ -2698,8 +2588,8 @@ puts res ==> [12]
res = Snd.catch(:no_such_file) do
open_sound(\"unknown-file.snd\")
end
-puts res ==> [:no_such_file,
- \"open_sound: no_such_file: Unknown_file.snd No such file or directory\"]
+puts res ==> [:no_such_file, \
+\"open_sound: no_such_file: Unknown_file.snd No such file or directory\"]
res = Snd.catch(:finish) do
10.times do |i|
@@ -2711,7 +2601,8 @@ puts res ==> [:finish, \"top_level\", 8]
res = Snd.catch(:all, lambda do |tag, msg| Snd.display([tag, msg]) end) do
set_listener_prompt(17)
end
-==> [:wrong_type_arg, \"set_listener-prompt: wrong type arg 0, 17, wanted a string\"]
+==> [:wrong_type_arg, \
+\"set_listener-prompt: wrong type arg 0, 17, wanted a string\"]
puts res ==> nil
The lambda function handles the error in the last case.")
@@ -2721,8 +2612,8 @@ end
add_help(:snd_throw,
"snd_throw(tag, *rest) \
-jumps to the corresponding snd_catch('tag') and returns an array \
-with tag, function name and possible *rest strings or values.")
+Jumps to the corresponding snd_catch(TAG) and returns an array \
+with TAG, function name and possible *REST strings or values.")
def snd_throw(tag, *rest)
Snd.throw(tag, *rest)
end
@@ -2759,9 +2650,9 @@ Ruby_exceptions = {
add_help(:snd_raise,
"snd_raise(tag, *rest) \
-raises an exception 'tag' with an error message \
-containing function name, tag and possible *rest strings or values. \
-'tag' is a symbol, \
+Raises an exception TAG with an error message \
+containing function name, TAG and possible *REST strings or values. \
+TAG is a symbol, \
a Ruby exception looks like :local_jump_error instead of LocalJumpError, \
a Snd error tag looks like :no_such_sound.")
def snd_raise(tag, *rest)
@@ -2782,9 +2673,9 @@ add_help(:gloop,
args[0]: Range (each)
Hash(s) (each)
- Array(s) (each_with_index) [args.last == Fixnum --> step]
+ Array(s) (each_with_index) [args.last == Fixnum ==> step]
Fixnum (times)
- Fixnum [args[1] == :step --> step]
+ Fixnum [args[1] == :step ==> step]
A general purpose loop, handling Range, Hash, Array, Vec, Vct, Fixnum,
with optional step. Returns the result of body as array like map.
@@ -2912,7 +2803,8 @@ def optkey(args, *rest)
get_class_or_key(args_1, *keys)
else
assert_type(keys.length.between?(1, 3), keys, 1,
- "an array of one to three elements [class, :key, default]")
+ "an array of one to three \
+elements [class, :key, default]")
end
else
name = keys.to_s
@@ -2931,13 +2823,13 @@ def optkey(args, *rest)
end
add_help(:load_init_file,
- "load_init_file(file) \
-Returns false if file doesn't exist, otherwise loads it. \
-File may reside in current working dir or in $HOME dir.")
+ "load_init_file(file) \
+Returns false if FILE doesn't exist, otherwise loads it. \
+FILE may reside in current working dir or in $HOME dir.")
def load_init_file(file)
- if File.exists?(file)
+ if File.exist?(file)
Snd.catch do load(file) end
- elsif File.exists?(f = ENV["HOME"] + "/" + file)
+ elsif File.exist?(f = ENV["HOME"] + "/" + file)
Snd.catch do load(f) end
else
false
@@ -2947,7 +2839,9 @@ end
let(-1) do |count|
# see rotate_phase(func, snd, chn) in dsp.rb
# it's necessary to produce a uniq method name
- make_proc_with_setter(:edit_list_proc_counter, lambda { count }, lambda { count += 1 })
+ make_proc_with_setter(:edit_list_proc_counter,
+ lambda do count end,
+ lambda do count += 1 end)
end
# clm.rb ends here
diff --git a/clm23.scm b/clm23.scm
index 69ba723..47ab88b 100644
--- a/clm23.scm
+++ b/clm23.scm
@@ -1,34 +1,34 @@
;;; these are CLM test instruments
(provide 'snd-clm23.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-(if (not (provided? 'snd-dsp.scm)) (load "dsp.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(require snd-dsp.scm snd-jcrev.scm)
-;;; definstrument -> define (+ change open paren placement)
-;;; *srate* -> (mus-srate)
-;;; run loop ... -> run (lambda () (do... + extra end close paren
-;;; aref ->
+;;; definstrument -> define* (+ change open paren placement)
+;;; *srate* -> *clm-srate*
+;;; run loop ... -> (do...)
+;;; aref -> [float-vector-ref or vector-ref use implicit indexing]
;;; setf -> set!
-;;; remove declare (or change order of args and remove ":")
-;;; however in granulate run-time edit-func, the "(declare (g clm))" is necessary
+;;; remove declare
;;; double not needed
;;; array of gen -> vector (and setf aref to vector-set! in this case)
;;; nil -> #f, t -> #t
-;;; incf, decf
-;;; length sometimes length, vct-length etc
+;;; incf, decf to explicit sets
+;;; length sometimes length, vector-length etc
;;; make-filter in scm requires coeffs arrays
-;;; &optional ->, &key too (using define*)
+;;; &optional, &key -> define*
;;; two-pi -> (* 2 pi)
-;;; make-empty-frame is make-frame essentially
;;; open-input and close-input -> make-readin or use name directly (in make-readin)
;;; make-locsig channel arg is in a different place
-;;; progn -> begin, when -> if+begin (prog1 prog2), dotimes
+;;; progn -> begin, dotimes -> do
;;; string= -> string=? (also string-equal)
-;;; integerp -> integer? and others like it (null -> null?)
+;;; integerp -> integer? and others like it (null -> null? is the tricky one)
;;; sound-duration -> mus-sound-duration and similarly for others
;;; various array info procs like array-dimension
-;;; #'(lambda ...) to just (lambda...)
+;;; #'(lambda ...) to just (lambda...), and if possible move the lambda out of the args
;;; nth -> list-ref
;;; loop -> do
@@ -36,1833 +36,1287 @@
(let ((sum 0.0))
(do ((i 0 (+ 1 i)))
((= i len))
- (set! sum (+ sum (* (vct-ref amps i)
- (sin (vct-ref phases i))))))
+ (set! sum (+ sum (* (amps i)
+ (sin (phases i))))))
sum))
-(define* (make-double-array len initial-contents initial-element)
- "(make-double-array len initial-contents initial-element) is for CL/Scheme compatibility; it makes a vct"
- (let ((v (make-vct len (or initial-element 0.0))))
- (if initial-contents
- (let ((clen (min len (length initial-contents))))
- (do ((i 0 (+ i 1)))
- ((= i clen))
- (set! (v i) (list-ref initial-contents i)))))
- v))
-
-(define make-double-float-array make-double-array)
-(define make-integer-array make-double-array) ; could use a vector here I suppose
-
-(define (double a)
- "(double a) is for compatibility with CL instruments; it returns its argument"
- a)
-
(define open-input make-file->sample)
(define two-pi (* 2 pi))
(define (simple-out beg dur freq amp)
- "(simple-out beg dur freq amp) test instrument for outa"
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (oscil os)) 0)))))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (oscil os))))))
(definstrument (simple-fm beg dur freq amp mc-ratio index amp-env index-env)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (cr (make-oscil freq)) ; our carrier
- (md (make-oscil (* freq mc-ratio))) ; our modulator
- (fm-index (hz->radians (* index mc-ratio freq)))
- (ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
- (indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))
+ (let ((fm-index (hz->radians (* index mc-ratio freq))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (cr (make-oscil freq)) ; our carrier
+ (md (make-oscil (* freq mc-ratio))) ; our modulator
+ (ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
+ (indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))
(define (simple-outn beg dur freq ampa ampb ampc ampd reva revb)
- "(simple-outn beg dur freq ampa ampb ampc ampd reva revb) test instrument for outn"
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (let ((val (oscil os)))
- (if (> ampa 0.0) (outa i (* ampa val)))
- (if (> ampb 0.0) (outb i (* ampb val)))
- (if (> ampc 0.0) (outc i (* ampc val)))
- (if (> ampd 0.0) (outd i (* ampd val)))
- (if (> reva 0.0) (outa i (* reva val) *reverb*))
- (if (> revb 0.0) (outb i (* revb val) *reverb*)))))))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (let ((val (oscil os)))
+ (if (> ampa 0.0) (outa i (* ampa val)))
+ (if (> ampb 0.0) (outb i (* ampb val)))
+ (if (> ampc 0.0) (outc i (* ampc val)))
+ (if (> ampd 0.0) (outd i (* ampd val)))
+ (if (> reva 0.0) (outa i (* reva val) *reverb*))
+ (if (> revb 0.0) (outb i (* revb val) *reverb*))))))
(define (simple-ssb beg dur freq amp)
- "(simple-ssb beg dur freq amp) test instrument for ssb-am"
- (let* ((os (make-ssb-am freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (arr (make-vector 3)))
+ (let ((os (make-ssb-am freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (arr (make-vector 3)))
(set! (arr 0) os)
(set! (arr 1) #f)
(set! (arr 2) (make-ssb-am 660 40))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (let* ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i (length arr)))
- (if (ssb-am? (arr i))
- (set! sum (+ sum (ssb-am (arr i) 1.0)))))
- (out-any i (* amp sum) 0))))))
+ (do ((k 0 (+ k 1)))
+ ((= k (length arr)))
+ (let ((g (arr k)))
+ (if (ssb-am? g)
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (ssb-am g amp))))))))
(define (simple-multiarr beg dur freq amp)
- "(simple-multiarr beg dur freq amp) test instrument for array of gen"
;; this won't work in CL because that version of CLM assumes all aref gens are the same type
- (let* ((start (seconds->samples beg))
- (len (seconds->samples dur))
- (end (+ start len))
- (arr (make-vector 3)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (arr (make-vector 3)))
(set! (arr 0) (make-oscil freq))
(set! (arr 1) (make-env '(0 0 1 1) :scaler amp :duration dur))
(set! (arr 2) (make-oscil (* freq 2)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (out-any i (* (env (arr 1))
- (oscil (arr 0)
- (* .1 (oscil (arr 2)))))
- 0)))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env (vector-ref arr 1))
+ (oscil (arr 0)
+ (* .1 (oscil (arr 2)))))))))
(define (simple-nsin beg dur amp)
- "(simple-nsin beg dur amp) test instrument for nsin"
- (let* ((os (make-nsin 440 10))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (nsin os)) 0)))))
+ (let ((os (make-nsin 440 10))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (nsin os))))))
(define (simple-ncos beg dur freq amp)
- "(simple-ncos beg dur freq amp) test instrument for ncos"
- (let* ((os (make-ncos freq 10))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (ncos os)) 0)))))
+ (let ((os (make-ncos freq 10))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (ncos os))))))
(define (simple-nrxysin beg dur amp)
- "(simple-nrxysin beg dur amp) test instrument for nrxysin"
- (let* ((os (make-nrxysin 440 1.0 10))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (nrxysin os)) 0)))))
+ (let ((os (make-nrxysin 440 1.0 10))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (nrxysin os))))))
(define (simple-nrxycos beg dur freq amp)
- "(simple-nrxycos beg dur freq amp) test instrument for nrxycos"
- (let* ((os (make-nrxycos freq 1.0 10))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (nrxycos os)) 0)))))
+ (let ((os (make-nrxycos freq 1.0 10))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (nrxycos os))))))
(define (simple-osc beg dur freq amp)
- "(simple-osc beg dur freq amp) test instrument for oscil"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (arr (make-vector 20)))
- (do ((i 0 (+ i 1)))
- ((= i 20))
- (set! (arr i) (make-oscil (* (+ i 1) 100))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i (length arr)))
- (if (oscil? (arr i))
- (set! sum (+ sum (oscil (arr i))))))
- (out-any i (* amp .05 sum) 0))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (freqs (make-float-vector 20)))
+ (let ((obank (make-oscil-bank freqs
+ (let ((fv (make-float-vector 20 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 20) fv)
+ (set! (freqs i) (hz->radians (* (+ i 1) 100)))))
+ (make-float-vector 20 1.0)
+ #t)))
+ (set! amp (* 0.05 amp))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil-bank obank)))))))
(define (simple-asy beg dur amp)
- "(simple-asy beg dur amp) test instrument for asymmetric-fm"
- (let* ((os (make-asymmetric-fm 440.0))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (asymmetric-fm os 1.0)) 0)))))
+ (let ((os (make-asymmetric-fm 440.0))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (asymmetric-fm os 1.0))))))
(define (simple-saw beg dur amp)
- "(simple-saw beg dur amp) test instrument for sawtooth-wave"
- (let* ((os (make-sawtooth-wave 440.0))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (sawtooth-wave os)) 0)))))
+ (let ((os (make-sawtooth-wave 440.0 amp))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (sawtooth-wave os)))))
(define (simple-sqr beg dur amp)
- "(simple-sqr beg dur amp) test instrument for square-wave"
- (let* ((os (make-square-wave 440.0))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (square-wave os)) 0)))))
+ (let ((os (make-square-wave 440.0 amp))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (square-wave os)))))
(define (simple-tri beg dur amp)
- "(simple-tri beg dur amp) test instrument for triangle-wave"
- (let* ((os (make-triangle-wave 440.0))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (triangle-wave os)) 0)))))
+ (let ((os (make-triangle-wave 440.0 amp))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (triangle-wave os)))))
(define (simple-pul beg dur amp)
- "(simple-pul beg dur amp) test instrument for pusle-train"
- (let* ((os (make-pulse-train 440.0))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (pulse-train os)) 0)))))
-
-(define (simple-sib beg dur freq amp)
- "(simple-sib beg dur freq amp) test instrument for sine-bank"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (amps (make-double-array 3 :initial-element 0.0))
- (phases (make-double-array 3 :initial-element 0.0))
- (freqs (make-double-array 3 :initial-element 0.0)))
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (set! (freqs i) (double (* freq (+ i 1))))
- (set! (amps i) (double (/ amp (+ i 2)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (do ((i 0 (+ i 1)))
- ((= i (vct-length phases)))
- (set! (phases i) (+ (phases i) (hz->radians (freqs i)))))
- (out-any i (clm23-sine-bank amps phases 3) 0)))))
+ (let ((os (make-pulse-train 440.0 amp))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (pulse-train os)))))
(define (simple-oz beg dur freq amp)
- "(simple-oz beg dur freq amp) test instrument for one-zero"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (oz (make-one-zero 0.4 0.6)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (one-zero oz (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (oz (make-one-zero (* amp 0.4) (* amp 0.6))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (one-zero oz (oscil os))))))
(define (simple-op beg dur freq amp)
- "(simple-op beg dur freq amp) test instrument for one-pole"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (oz (make-one-pole 0.4 -0.6)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (one-pole oz (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (oz (make-one-pole (* amp 0.4) -0.6)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (one-pole oz (oscil os))))))
(define (simple-tz beg dur freq amp)
- "(simple-tz beg dur freq amp) test instrument for two-zero"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (oz (make-two-zero 0.4 0.3 0.3)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (two-zero oz (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (oz (make-two-zero (* amp 0.4) (* amp 0.3) (* amp 0.3))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (two-zero oz (oscil os))))))
(define (simple-tp beg dur freq amp)
- "(simple-tp beg dur freq amp) test instrument for two-pole"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (oz (make-two-pole 0.3 -0.6 0.1)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (two-pole oz (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (oz (make-two-pole (* amp 0.3) -0.6 0.1)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (two-pole oz (oscil os))))))
(define (simple-frm beg dur freq amp)
- "(simple-frm beg dur freq amp) test instrument for formant"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (oz (make-formant 1200.0 0.95)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (formant oz (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (oz (make-formant 1200.0 0.95)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (formant oz (oscil os)))))))
(define (simple-firm beg dur freq amp)
- "(simple-frm beg dur freq amp) test instrument for firmant"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (oz (make-firmant 1200.0 0.95)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (firmant oz (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (oz (make-firmant 1200.0 0.95)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (firmant oz (oscil os)))))))
(define (simple-firm2 beg dur freq amp)
- "(simple-frm beg dur freq amp) test instrument for firmant"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (frqf (make-env '(0 1200 1 2400) :scaler (hz->radians 1.0) :duration dur))
- (oz (make-firmant 1200.0 0.95)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (firmant oz (oscil os) (env frqf))) 0)))))
-
-;(define w1 (make-polyshape :frequency 100.0
-; :partials (let ((frqs '()))
-; (do ((i 1 (+ i 1)))
-; ((= i 10) (begin (format #t frqs) (reverse frqs)))
-; (set! frqs (cons (/ 1.0 (* i i)) (cons i frqs)))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (frqf (make-env '(0 1200 1 2400) :scaler (hz->radians 1.0) :duration dur))
+ (oz (make-firmant 1200.0 0.95)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (firmant oz (oscil os) (env frqf)))))))
+
+ ;(define w1 (make-polyshape :frequency 100.0
+ ; :partials (let ((frqs ()))
+ ; (do ((i 1 (+ i 1)))
+ ; ((= i 10) (begin (format #t frqs) (reverse frqs)))
+ ; (set! frqs (cons (/ 1.0 (* i i)) (cons i frqs)))))))
(define (simple-poly beg dur freq amp)
- "(simple-poly beg dur freq amp) test instrument for polyshape"
- (let* ((w1 (make-polyshape :frequency freq :partials '(1 1 2 1 3 1)))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (polyshape w1 1.0)) 0)))))
+ (let ((w1 (make-polyshape freq :partials '(1 1 2 1 3 1)))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (polyshape w1 1.0))))))
(define (simple-polyw beg dur freq amp)
- "(simple-poly beg dur freq amp) test instrument for polywave"
- (let* ((w1 (make-polywave :frequency freq :partials '(1 1 2 1 3 1)))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (polywave w1)) 0)))))
+ (let ((w1 (make-polywave freq :partials (list 1 amp 2 amp 3 amp)))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (polywave w1)))))
(define (simple-dly beg dur freq amp)
- "(simple-dly beg dur freq amp) test instrument for delay"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (buf (make-delay 100)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (delay buf (* amp (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (buf (make-delay 100)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (delay buf (oscil os)))))))
(define (simple-cmb beg dur freq amp)
- "(simple-cmb beg dur freq amp) test instrument for comb"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (buf (make-comb .1 100)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (comb buf (* amp (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (buf (make-comb .1 100)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (comb buf (oscil os)))))))
(define (simple-filtered-cmb beg dur freq amp)
- "(simple-filtered-cmb beg dur freq amp) test instrument for filtered-comb"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (buf (make-filtered-comb .1 100 :filter (make-one-zero .5 .5))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (filtered-comb buf (* amp (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (buf (make-filtered-comb .1 100 :filter (make-one-zero .5 .5))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (filtered-comb buf (oscil os)))))))
(define (simple-not beg dur freq amp)
- "(simple-not beg dur freq amp) test instrument for notch"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (buf (make-notch .1 100)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (notch buf (* amp (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (buf (make-notch .1 100)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (notch buf (oscil os)))))))
(define (simple-alp beg dur freq amp)
- "(simple-alp beg dur freq amp) test instrument for all-pass"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (buf (make-all-pass .2 .8 100)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (all-pass buf (* amp (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (buf (make-all-pass .2 .8 100)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (all-pass buf (oscil os)))))))
(define (simple-ave beg dur freq amp)
- "(simple-ave beg dur freq amp) test instrument for moving-average"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (buf (make-moving-average 10)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (moving-average buf (* amp (oscil os))) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (buf (make-moving-average 10)))
+ (set! (mus-increment buf) (* amp (mus-increment buf)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (moving-average buf (oscil os))))))
(define (simple-tab beg dur freq amp)
- "(simple-tab beg dur freq amp) test instrument for table-lookup"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (table-size 256)
- (buf (make-table-lookup freq 0.0 :size table-size))
- (table (mus-data buf)))
- (do ((i 0 (+ i 1)))
- ((= i table-size))
- (set! (table i) (double (/ i table-size))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (table-lookup buf)) 0)))))
+ (let ((table-size 256))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (buf (make-table-lookup freq 0.0 :size table-size)))
+ (let ((table (mus-data buf)))
+ (do ((i 0 (+ i 1)))
+ ((= i table-size))
+ (set! (table i) (/ i table-size))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (table-lookup buf)))))))
(define (simple-flt beg dur freq amp)
- "(simple-flt beg dur freq amp) test instrument for filter"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (flt (make-filter 8 :xcoeffs (make-vct 8) :ycoeffs (make-vct 8)))
- (os (make-oscil freq)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (flt (make-filter 8 :xcoeffs (make-float-vector 8) :ycoeffs (make-float-vector 8)))
+ (os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! ((mus-xcoeffs flt) i) (double (/ i 16)))
- (set! ((mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (filter flt (oscil os))) 0)))))
+ (set! ((mus-xcoeffs flt) i) (/ i 16.0))
+ (set! ((mus-ycoeffs flt) i) (- 0.5 (/ i 16.0))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (filter flt (oscil os)))))))
(define (simple-fir beg dur freq amp)
- "(simple-fir beg dur freq amp) test instrument for fir-filter"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (flt (make-fir-filter 8 :xcoeffs (make-vct 8)))
- (os (make-oscil freq)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (flt (make-fir-filter 8 :xcoeffs (make-float-vector 8)))
+ (os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! ((mus-xcoeffs flt) i) (double (/ i 16))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (fir-filter flt (oscil os))) 0)))))
+ (set! ((mus-xcoeffs flt) i) (/ i 16.0)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (fir-filter flt (oscil os)))))))
(define (simple-iir beg dur freq amp)
- "(simple-iir beg dur freq amp) test instrument for iir-filter"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (flt (make-iir-filter 8 :ycoeffs (make-vct 8)))
- (os (make-oscil freq)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (flt (make-iir-filter 8 :ycoeffs (make-float-vector 8)))
+ (os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! ((mus-ycoeffs flt) i) (double (/ i 16))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (iir-filter flt (oscil os))) 0)))))
-
-(define (simple-f beg dur freq amp)
- "(simple-f beg dur freq amp) test instrument for frame->sample"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (frm (make-frame 2 .7 .3))
- (smp (make-frame 2))
- (os (make-oscil freq)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (let ((val (oscil os)))
- (frame-set! smp 0 val)
- (set! (frame-ref smp 1) val)
- (out-any i (* amp (frame->sample frm smp)) 0))))))
+ (set! ((mus-ycoeffs flt) i) (/ i 16.0)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (iir-filter flt (oscil os)))))))
(define (simple-ran beg dur freq amp)
- "(simple-ran beg dur freq amp) test instrument for rand"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-rand freq)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (rand os)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-rand freq amp)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (rand os)))))
(define (simple-ri beg dur freq amp)
- "(simple-ri beg dur freq amp) test instrument for rand-interp"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-rand-interp freq)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (rand-interp os)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-rand-interp freq amp)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (rand-interp os)))))
(define (simple-rndist beg dur freq amp)
- "(simple-rndist beg dur freq amp) test instrument for rand dist"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-rand freq :distribution (inverse-integrate '(0 0 1 1)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (rand os)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-rand freq amp :distribution (inverse-integrate '(0 0 1 1)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (rand os)))))
(define (simple-ridist beg dur freq amp)
- "(simple-ridist beg dur freq amp) test instrument for rand-interp dist"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-rand-interp freq :distribution (inverse-integrate '(0 1 1 0)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (rand-interp os)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-rand-interp freq amp :distribution (inverse-integrate '(0 1 1 0)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (rand-interp os)))))
(define (simple-env beg dur freq amp)
- "(simple-env beg dur freq amp) test instrument for env"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (e (make-env '(0 0 1 1 2 1 3 0) :scaler amp :offset .1 :duration dur)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* (env e) (oscil os)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq))
+ (e (make-env '(0 0 1 1 2 1 3 0) :scaler amp :offset .1 :duration dur)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* (env e) (oscil os))))))
(define* (simple-fof beg dur frq amp vib f0 a0 f1 a1 f2 a2 ve ae)
- " (simple-fof beg dur frq amp vib f0 a0 f1 a1 f2 a2 ve ae) test instrument for FOF"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (ampf (make-env :envelope (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
- (frq0 (hz->radians f0))
- (frq1 (hz->radians f1))
- (frq2 (hz->radians f2))
- (foflen (if (= (mus-srate) 22050) 100 200))
- (vibr (make-oscil :frequency 6))
- (vibenv (make-env :envelope (or ve (list 0 1 100 1)) :scaler vib :duration dur))
- (win-freq (/ two-pi foflen))
- (wt0 (make-wave-train :size foflen :frequency frq))
- (foftab (mus-data wt0)))
- (do ((i 0 (+ i 1))) ((= i foflen))
- (set! (foftab i) (double
- ;; this is not the pulse shape used by B&R
- (* (+ (* a0 (sin (* i frq0)))
- (* a1 (sin (* i frq1)))
- (* a2 (sin (* i frq2))))
- .5 (- 1.0 (cos (* i win-freq)))))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr)))) 0)))))
+ (let ((foflen (if (= *clm-srate* 22050) 100 200)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (ampf (make-env :envelope (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
+ (frq0 (hz->radians f0))
+ (frq1 (hz->radians f1))
+ (frq2 (hz->radians f2))
+ (vibr (make-oscil 6))
+ (vibenv (make-env :envelope (or ve (list 0 1 100 1)) :scaler vib :duration dur))
+ (win-freq (/ two-pi foflen))
+ (wt0 (make-wave-train :size foflen :frequency frq)))
+ (let ((foftab (mus-data wt0)))
+ (do ((i 0 (+ i 1))) ((= i foflen))
+ (set! (foftab i) ;; this is not the pulse shape used by B&R
+ (* (+ (* a0 (sin (* i frq0)))
+ (* a1 (sin (* i frq1)))
+ (* a2 (sin (* i frq2))))
+ .5 (- 1.0 (cos (* i win-freq)))))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr)))))))))
(define (simple-amb beg dur freq amp)
- "(simple-amb beg dur freq amp) test instrument for osc?+rand"
- (let* ((os (if (> freq 1) (make-oscil freq) (make-rand freq)))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (if (oscil? os) (oscil os) (rand os))) 0)))))
+ (let ((os (if (> freq 1) (make-oscil freq) (make-rand freq)))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (os))))))
(define (simple-rd beg dur amp file)
- "(simple-rd beg dur amp file) test instrument for readin"
- (let* ((rd (make-readin file))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (readin rd)) 0)))))
+ (let ((rd (make-readin file))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (readin rd))))))
(define (simple-rd-start beg dur amp file channel start)
- "(simple-rd-start beg dur amp file channel start) test instrument for readin"
- (let* ((rd (make-readin file :channel channel :start start))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (readin rd)) 0)))))
+ (let ((rd (make-readin file :channel channel :start start))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (readin rd))))))
(define (simple-cnv beg dur amp file)
- "(simple-cnv beg dur amp file) test instrument for convolve"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
- (set! (filt 4) (double 1.0))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (filt (make-float-vector 8)))
+ (set! (filt 4) 1.0)
(let ((ff (make-convolve :input (make-readin file) :filter filt)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (convolve ff)) 0))))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (convolve ff)))))))
(define (simple-cnf beg dur amp file)
- "(simple-cnf beg dur amp file) test instrument for convolve"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
- (set! (filt 4) (double 1.0))
- (let ((ff (make-convolve :filter filt)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (convolve ff (lambda (dir) (readin rd))))
- 0))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (filt (make-float-vector 8)))
+ (set! (filt 4) 1.0)
+ (let ((ff (make-convolve (make-readin file) :filter filt)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (convolve ff)))))))
(define (simple-lrg beg dur amp file)
- "(simple-lrg beg dur amp file) test instrument for convolve"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
- (set! (filt 4) (double 1.0))
- (let ((ff (make-convolve :filter filt)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (convolve ff (lambda (dir)
- (if (= dir 1)
- (readin rd)
- 0.0))))
- 0))))))
+ (let ((rd (make-readin file)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (read-func (lambda (dir) (readin rd)))
+ (filt (make-float-vector 8)))
+ (set! (filt 4) 1.0)
+ (let ((ff (make-convolve :filter filt :input read-func)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (convolve ff))))))))
+
(define (simple-cn2 beg dur amp file)
- "(simple-cn2 beg dur amp file) test instrument for convolve"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
- (set! (filt 4) (double 1.0))
- (let ((ff (make-convolve :filter filt))
- (ff1 (make-convolve :filter filt :input (make-readin file))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (+ (convolve ff (lambda (dir)
- (if (= dir 1)
- (readin rd)
- 0.0)))
- (convolve ff1)))
- 0))))))
+ (let ((rd (make-readin file)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (read-func (lambda (dir) (readin rd)))
+ (filt (make-float-vector 8)))
+ (set! (filt 4) 1.0)
+ (let ((ff (make-convolve :filter filt :input read-func))
+ (ff1 (make-convolve :filter filt :input (make-readin file))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (+ (convolve ff)
+ (convolve ff1)))))))))
(define (simple-src beg dur amp speed file)
- "(simple-src beg dur amp speed file) test instrument for src"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (sr (make-src :input (make-readin file) :srate speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (src sr)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-src :input (make-readin file) :srate speed)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (src sr))))))
(define (simple-src-f beg dur amp speed file)
- "(simple-src-f beg dur amp speed file) test instrument for src"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (sr (make-src :input (make-readin file) :srate speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (src sr 0.0 #f)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-src :input (make-readin file) :srate speed)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (src sr 0.0))))))
(define (simple-sr2 beg dur amp speed file)
- "(simple-sr2 beg dur amp speed file) test instrument for src"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-src :srate speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (src sr 0.0 (lambda (dir) (if (= dir 1) (readin rd))))) 0)))))
+ (let ((rd (make-readin file)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-src :srate speed
+ :input (lambda (dir) (readin rd)))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (src sr)))))))
(define (simple-sr2a beg dur amp speed file)
- "(simple-sr2a beg dur amp speed file) test instrument for src"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-src :input rd :srate speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (src sr)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-src :input (make-readin file) :srate speed)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (src sr))))))
(define (simple-sro beg dur amp speed freq)
- "(simple-sro beg dur amp speed freq) test instrument for src"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (sr (make-src :srate speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (src sr 0.0 (lambda (dir)
- (oscil os))))
- 0)))))
+ (let ((os (make-oscil freq)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-src :srate speed :input (lambda (dir) (oscil os)))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (src sr)))))))
(define (simple-grn beg dur amp speed freq)
- "(simple-grn beg dur amp speed freq) test instrument for granulate"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (sr (make-granulate :expansion speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (granulate sr (lambda (dir) (oscil os)))) 0)))))
+ (let ((os (make-oscil freq)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-granulate :expansion speed :input (lambda (dir) (oscil os)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (granulate sr)))))))
(define (simple-pvoc beg dur amp size file)
- "(simple-pvoc beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (sr (make-phase-vocoder :input (make-readin file) :fft-size size)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (phase-vocoder sr)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-phase-vocoder :input (make-readin file) :fft-size size)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (phase-vocoder sr))))))
+
+;;; (with-sound (:statistics #t) (simple-pvoc 0 2.0 .4 256 "oboe.snd"))
(define (simple-ina beg dur amp file)
- "(simple-ina beg dur amp file) test instrument for ina"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fil (open-input file))
- (ctr 0))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (in-any ctr 0 fil)) 0)
- (set! ctr (+ ctr 1))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (fil (open-input file)))
+ (do ((i start (+ i 1))
+ (ctr 0 (+ ctr 1)))
+ ((= i end))
+ (outa i (* amp (in-any ctr 0 fil))))))
(define (simple-in-rev beg dur ampa ampb)
- "(simple-in-rev beg dur ampa ampb) test instrument for in reverb"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (if (> ampa 0.0) (outa i (* ampa (ina i *reverb*))))
- (if (> ampb 0.0) (outb i (* ampb (inb i *reverb*))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (chns (mus-channels *reverb*)))
+ (if (or (> ampa 0.0) (> ampb 0.0))
+ (if (or (zero? ampb) (= chns 1))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* ampa (ina i *reverb*))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* ampa (ina i *reverb*)))
+ (outb i (* ampb (inb i *reverb*))))))))
(define (simple-f2s beg dur amp file)
- "(simple-f2s beg dur amp file) test instrument for file->sample"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fil (make-file->sample file))
- (ctr 0))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (file->sample fil ctr 0)) 0)
- (set! ctr (+ 1 ctr))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (fil (make-file->sample file)))
+ (do ((i start (+ i 1))
+ (ctr 0 (+ ctr 1)))
+ ((= i end))
+ (outa i (* amp (file->sample fil ctr))))))
(define (simple-rdf beg dur amp file)
- "(simple-rdf beg dur amp file) test instrument for readin"
- (let* ((rd (make-readin file))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (readin rd)) 0)))))
+ (let ((rd (make-readin file))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (readin rd))))))
(define (simple-loc beg dur freq amp)
- "(simple-loc beg dur freq amp) test instrument for locsig"
- (let* ((os (make-oscil freq))
- (loc (make-locsig :degree 0.0))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (locsig loc i (* amp (oscil os)))))))
+ (let ((os (make-oscil freq))
+ (loc (make-locsig :degree 0.0))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (locsig loc i (* amp (oscil os))))))
(define (simple-dloc beg dur freq amp)
- "(simple-dloc beg dur freq amp) test instrument for move-sound"
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (loc (make-move-sound (list start end 1 0
- (make-delay 32) (make-env '(0 0 1 1) :length 1000) (make-env '(0 0 1 1) :length 1000)
- (vector (make-delay 32)) (vector (make-env '(0 0 1 1) :length 1000))
- (vector (make-delay 32)) (vector 0 1)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (move-sound loc i (* amp (oscil os)))))))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (let ((loc (make-move-sound (list start end 1 0
+ (make-delay 32) (make-env '(0 0 1 1) :length 1000) (make-env '(0 0 1 1) :length 1000)
+ (vector (make-delay 32)) (vector (make-env '(0 0 1 1) :length 1000))
+ (vector (make-delay 32)) (vector 0 1)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (move-sound loc i (* amp (oscil os)))))))
(define (simple-dloc-4 beg dur freq amp)
- "(simple-dloc-4 beg dur freq amp) test instrument for dlocsig"
- (let* ((os (make-oscil freq))
- (start (floor (* beg (mus-srate))))
- (end (+ start (floor (* dur (mus-srate)))))
- (loc (make-move-sound (list start end 4 0
- (make-delay 12)
- (make-env '(0 0 10 1) :duration dur)
- #f
- (make-vector 4 #f)
- (vector (make-env '(0 0 1 1 2 0 3 0 4 0) :duration dur)
- (make-env '(0 0 1 0 2 1 3 0 4 0) :duration dur)
- (make-env '(0 0 1 0 2 0 3 1 4 0) :duration dur)
- (make-env '(0 0 1 0 2 0 3 0 4 1) :duration dur))
- #f
- (vector 0 1 2 3)))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (move-sound loc i (* amp (oscil os)))))))
-
-;(with-sound (:channels 4 :output "temp.snd") (simple-dloc-4 0 2 440 .5))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (let ((loc (make-move-sound (list start end 4 0
+ (make-delay 12)
+ (make-env '(0 0 10 1) :duration dur)
+ #f
+ (make-vector 4 #f)
+ (vector (make-env '(0 0 1 1 2 0 3 0 4 0) :duration dur)
+ (make-env '(0 0 1 0 2 1 3 0 4 0) :duration dur)
+ (make-env '(0 0 1 0 2 0 3 1 4 0) :duration dur)
+ (make-env '(0 0 1 0 2 0 3 0 4 1) :duration dur))
+ #f
+ (vector 0 1 2 3)))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (move-sound loc i (* amp (oscil os)))))))
+
+ ;(with-sound (:channels 4 :output "temp.snd") (simple-dloc-4 0 2 440 .5))
(define (simple-dup beg dur freq amp)
- "(simple-dup beg dur freq amp) test instrument for arith"
- (let* ((os (make-oscil freq))
- (j 2)
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (let ((amp .3)
- (j 4))
- (if (not (= j 4)) (clm-print "local j is ~D\n" j))
- (if (> (abs (- amp .3)) .001) (clm-print "local amp is ~F\n" amp)))
- (if (= j 2)
- (out-any i (* amp (oscil os)) 0))))))
+ (let ((os (make-oscil freq))
+ (j 2)
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (let ((amp .3)
+ (j 4))
+ (if (not (= j 4)) (format #t "local j is ~D\n" j))
+ (if (> (abs (- amp .3)) .001) (format #t "local amp is ~F\n" amp)))
+ (if (= j 2)
+ (outa i (* amp (oscil os)))))))
(define (simple-du1 beg dur freq amp)
- "(simple-du1 beg dur freq amp) test instrument for arith"
- (let* ((os (make-oscil freq))
- (j (+ (expt 2 41) 1234)) ; 2199023256786
- (mj -3)
- (jj (- (+ (expt 2 40) 4321))) ; -1099511632097
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (if (not (= j 2199023256786)) (clm-print "local j is ~A" j))
- (if (not (= jj -1099511632097)) (clm-print "local jj is ~A" jj))
- (if (= mj -3)
- (out-any i (* amp (oscil os)) 0)
- (clm-print "minus 3: ~D" mj))))))
+ (let ((os (make-oscil freq))
+ (j (+ (expt 2 41) 1234)) ; 2199023256786
+ (mj -3)
+ (jj (- (+ (expt 2 40) 4321))) ; -1099511632097
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (if (not (= j 2199023256786)) (format #t "local j is ~A" j))
+ (if (not (= jj -1099511632097)) (format #t "local jj is ~A" jj))
+ (if (= mj -3)
+ (outa i (* amp (oscil os)))
+ (format #t "minus 3: ~D" mj)))))
(define (sample-desc beg dur freq amp)
- "(sample-desc beg dur freq amp) test instrument for generics"
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (printed #f)
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (if (not printed)
- (begin
- (if (not (string=? (mus-describe os) "oscil freq: 440.000Hz, phase: 0.000"))
- (clm-print "describe oscil: ~A~%" (mus-describe os)))
- (if (> (abs (- (mus-frequency os) freq)) .001)
- (clm-print "osc freq: ~A (~A)~%" (mus-frequency os) freq))
- (set! printed #t)))
- (out-any i (* amp (oscil os)) 0)))))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (printed #f)
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (if (not printed)
+ (begin
+ (if (not (string=? (mus-describe os) "oscil freq: 440.000Hz, phase: 0.000"))
+ (format #t "describe oscil: ~A~%" (mus-describe os)))
+ (if (> (abs (- (mus-frequency os) freq)) .001)
+ (format #t "osc freq: ~A (~A)~%" (mus-frequency os) freq))
+ (set! printed #t)))
+ (outa i (* amp (oscil os))))))
(define (sample-mdat beg dur freq amp)
- "(sample-mdat beg dur freq amp) test instrument for coeffs"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (table-size 256)
- (j 0)
- (buf (make-table-lookup freq 0.0 :size table-size))
- (table (mus-data buf)))
- (do ((i 0 (+ i 1)))
- ((= i table-size))
- (set! (table i) (double (/ i table-size))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp ((mus-data buf) j) (table-lookup buf)) 0)
- (set! j (+ 1 j))
- (if (>= j table-size) (set! j 0))))))
+ (let ((table-size 256))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (buf (make-table-lookup freq 0.0 :size table-size)))
+ (let ((table (mus-data buf)))
+ (do ((i 0 (+ i 1)))
+ ((= i table-size))
+ (set! (table i) (/ i table-size))))
+ (do ((i start (+ i 1))
+ (j 0 (modulo (+ j 1) table-size)))
+ ((= i end))
+ (outa i (* amp ((mus-data buf) j) (table-lookup buf)))))))
(define (sample-xtab beg dur freq amp)
- "(sample-xtab beg dur freq amp) test instrument for generics"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (flt (make-filter 8 :xcoeffs (make-vct 8) :ycoeffs (make-vct 8)))
- (os (make-oscil freq)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (flt (make-filter 8 :xcoeffs (make-float-vector 8) :ycoeffs (make-float-vector 8)))
+ (os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! ((mus-xcoeffs flt) i) (double (/ i 16)))
- (set! ((mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp
- (+ ((mus-xcoeffs flt) 4)
- ((mus-ycoeffs flt) 4))
- (filter flt (oscil os)))
- 0)))))
+ (set! ((mus-xcoeffs flt) i) (/ i 16.0))
+ (set! ((mus-ycoeffs flt) i) (- 0.5 (/ i 16.0))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp
+ (+ ((mus-xcoeffs flt) 4)
+ ((mus-ycoeffs flt) 4))
+ (filter flt (oscil os)))))))
(define (sample-xts beg dur freq amp)
- "(sample-xts beg dur freq amp) test instrument for generics"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (flt (make-filter 8 :xcoeffs (make-vct 8) :ycoeffs (make-vct 8)))
- (os (make-oscil freq)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (set! ((mus-xcoeffs flt) i) (double (/ i 16)))
- (set! ((mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (vct-set! (mus-xcoeffs flt) 0 .5)
- (vct-set! (mus-ycoeffs flt) 0 .5)
- (out-any i (* amp
- (+ ((mus-xcoeffs flt) 0)
- (mus-ycoeff flt 0))
- (filter flt (oscil os)))
- 0)))))
+ (let ((vx (make-float-vector 8))
+ (vy (make-float-vector 8)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (flt (make-filter 8 :xcoeffs vx :ycoeffs vy))
+ (os (make-oscil freq)))
+ (do ((i 0 (+ i 1)))
+ ((= i 8))
+ (set! ((mus-xcoeffs flt) i) (/ i 16.0))
+ (set! ((mus-ycoeffs flt) i) (- 0.5 (/ i 16.0))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (float-vector-set! vx 0 .5)
+ (float-vector-set! vy 0 .5)
+ (outa i (* amp
+ (+ (vx 0)
+ (mus-ycoeff flt 0))
+ (filter flt (oscil os))))))))
(define (sample-srl2 beg dur amp speed freq)
- "(sample-srl2 beg dur amp speed freq) test instrument for src"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os1 (make-oscil freq))
- (os2 (make-oscil (* freq 2)))
- (sr1 (make-src :srate speed))
- (sr2 (make-src :srate speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (+ (src sr1 0.0 (lambda (dir) (oscil os1)))
- (src sr2 0.0 (lambda (dir) (oscil os2)))))
- 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os1 (make-oscil freq))
+ (os2 (make-oscil (* freq 2))))
+ (let ((sr1 (make-src :srate speed :input (lambda (dir) (oscil os1))))
+ (sr2 (make-src :srate speed :input (lambda (dir) (oscil os2)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (+ (src sr1) (src sr2))))))))
(define (sample-srll beg dur amp speed freq)
- "(sample-srll beg dur amp speed freq) test instrument for src"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (sr1 (make-src :srate speed))
- (sr2 (make-src :srate speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (src sr1 0.0 (lambda (dir)
- (src sr2 0.0
- (lambda (dir)
- (oscil os))))))
- 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq)))
+ (let ((sr2 (make-src :srate speed :input (lambda (dir) (oscil os)))))
+ (let ((sr1 (make-src :srate speed :input (lambda (dir) (src sr2)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (src sr1))))))))
(define (sample-srl3 beg dur amp speed freq)
- "(sample-srl3 beg dur amp speed freq) test instrument for src"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os1 (make-oscil freq))
- (os2 (make-oscil freq))
- (sr1 (make-src :srate speed))
- (sr2 (make-src :srate speed))
- (sr3 (make-src :srate speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (+ (src sr1 0.0 (lambda (dir)
- (src sr2 0.0
- (lambda (dir)
- (oscil os1)))))
- (src sr3 0.0 (lambda (dir)
- (oscil os2)))))
- 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os1 (make-oscil freq))
+ (os2 (make-oscil freq)))
+ (let ((sr3 (make-src :srate speed :input (lambda (dir) (oscil os2))))
+ (sr2 (make-src :srate speed :input (lambda (dir) (oscil os1)))))
+ (let ((sr1 (make-src :srate speed :input (lambda (dir) (src sr2)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (+ (src sr1) (src sr3)))))))))
(define (sample-grn2 beg dur amp speed freq)
- "(sample-grn2 beg dur amp speed freq) test instrument for granulate"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (sr (make-granulate :expansion speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (granulate sr
- (lambda (dir)
- (oscil os))
- (lambda (g)
- 0)))
- 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq)))
+ (let ((sr (make-granulate :expansion speed
+ :input (lambda (dir) (oscil os))
+ :edit (lambda (g) 0))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (granulate sr)))))))
(define (sample-grn3 beg dur amp speed file)
- "(sample-grn3 beg dur amp speed file) test instrument for granulate"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-src :srate speed))
- (gr (make-granulate :expansion speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (granulate gr (lambda (dir)
- (src sr 0.0 (lambda (dir)
- (readin rd))))))
- 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-src (make-readin file) :srate speed)))
+ (let ((gr (make-granulate :expansion speed :input (lambda (dir) (src sr)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (granulate gr)))))))
(define (sample-cnv beg dur amp speed file)
- "(sample-cnv beg dur amp speed file) test instrument for convolve"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-src :srate speed))
- (filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
- (set! (filt 4) (double 1.0))
- (let ((ff (make-convolve :filter filt)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (convolve ff (lambda (dir)
- (src sr 0.0 (lambda (dir)
- (readin rd))))))
- 0))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-src (make-readin file) :srate speed))
+ (filt (make-float-vector 8)))
+ (set! (filt 4) 1.0)
+ (let ((ff (make-convolve :filter filt :input (lambda (dir) (src sr)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (convolve ff)))))))
(define (sample-cnv1 beg dur amp speed file)
- "(sample-cnv1 beg dur amp speed file) test instrument for convolve"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-src :srate speed :input rd))
- (filt (make-double-array 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (set! (filt i) (double 0.0)))
- (set! (filt 4) (double 1.0))
- (let ((ff (make-convolve :filter filt)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (convolve ff (lambda (dir)
- (src sr))))
- 0))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-src :srate speed :input (make-readin file)))
+ (filt (make-float-vector 8)))
+ (set! (filt 4) 1.0)
+ (let ((ff (make-convolve :filter filt :input (lambda (dir) (src sr)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (convolve ff)))))))
(define (sample-pvoc1 beg dur amp size file)
- "(sample-pvoc1 beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fil (make-readin file))
- (sr (make-phase-vocoder :fft-size size)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (phase-vocoder sr
- (lambda (dir)
- (readin fil))))
- 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-phase-vocoder (make-readin file) :fft-size size)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (phase-vocoder sr))))))
(define (sample-pvoc2 beg dur amp size file)
- "(sample-pvoc2 beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fil (make-readin file))
- (sr (make-phase-vocoder :fft-size size)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (phase-vocoder sr
- (lambda (dir)
- (readin fil))
- #f
- (lambda (closure)
- (if (not (= (mus-location sr) 0))
- (clm-print "outctr: ~A" (mus-location sr)))
- #t)
- #f))
- 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-phase-vocoder (make-readin file)
+ :fft-size size
+ :edit (lambda (pv)
+ (if (not (= (mus-location pv) 0))
+ (format #t "outctr: ~A" (mus-location pv)))
+ #t))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (phase-vocoder sr))))))
(define (sample-pvoc3 beg dur amp size file)
- "(sample-pvoc3 beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (k 0)
- (N2 (/ size 2))
- (fil (make-readin file))
- (sr (make-phase-vocoder :fft-size size)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i
- (* amp (phase-vocoder sr
- (lambda (dir)
- (readin fil))
- #f
- #f
- (lambda (closure)
- (set! k 0)
- (do ()
- ((= k N2))
- (vct-set! (phase-vocoder-amps sr) k
- (+ ((phase-vocoder-amps sr) k)
- ((phase-vocoder-amp-increments sr) k)))
- (vct-set! (phase-vocoder-phase-increments sr) k
- (+ ((phase-vocoder-phase-increments sr) k)
- ((phase-vocoder-freqs sr) k)))
- (vct-set! (phase-vocoder-phases sr) k
- (+ ((phase-vocoder-phases sr) k)
- ((phase-vocoder-phase-increments sr) k)))
- (set! k (+ 1 k)))
- (clm23-sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))))
- 0)))))
-
-(define (sample-mxf beg dur freq amp)
- "(sample-mxf beg dur freq amp) test instrument for frames"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (frm (make-frame 2 .7 .3))
- (smp (make-frame 2))
- (os (make-oscil freq))
- (int 0)
- (gen (make-mixer 2 .5 .25 .125 1.0))
- (fr0 (make-frame 2 1.0 1.0))
- (fr1 (make-frame 2 0.0 0.0))
- (fr3 (make-frame 2))
- (fr4 (make-frame 4))
- (fr5 (make-frame 4))
- (mx1 (make-scalar-mixer 2 2.0))
- (mx2 (make-mixer 2 .1 .2 .3 .4))
- (nmx (make-mixer 2)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (let ((val (* (oscil os) amp)))
- (frame-set! smp 0 val)
- (set! (frame-ref smp (+ int 1)) val)
- (out-any i (frame->sample frm smp) 0)
- (if (not (frame? fr0)) (clm-print ";~S not a frame?" (mus-describe fr0)))
- (if (not (mixer? gen)) (clm-print ";~S not a mixer?" (mus-describe gen)))
- (if (not (= (channels fr0) 2)) (clm-print ";frame channels: ~D?" (channels fr0)))
- (if (not (= (length fr1) 2)) (clm-print ";frame length: ~D?" (length fr0)))
- (if (not (= (channels gen) 2)) (clm-print ";mixer channels: ~D?" (channels gen)))
- (frame->frame fr0 gen fr1)
- (if (or (> (abs (- (frame-ref fr0 0) 1.0)) .001)
- (> (abs (- (frame-ref fr1 1) 1.25)) .001)
- (> (abs (- (mixer-ref gen 0 0) .5)) .001))
- (clm-print ";fr1: ~A" (mus-describe fr1)))
- (frame-set! fr1 0 1.0)
- (set! (frame-ref fr1 1) 1.0)
- (frame+ fr0 fr1 fr3)
- (frame* fr0 fr1 fr4)
- (sample->frame fr1 .5 fr5)
- (if (or (> (abs (- (frame-ref fr3 0) 2.0)) .001)
- (> (abs (-(frame-ref fr4 0) 1.0)) .001))
- (clm-print ";fr+*: ~A ~A" (mus-describe fr3) (mus-describe fr4)))
- (if (> (abs (- (frame-ref fr5 0) .5)) .001)
- (clm-print ";sample->frame: ~A?" (frame-ref fr5 0)))
- (mixer+ mx1 mx2 nmx)
- (if (or (> (abs (- (mixer-ref mx1 0 0) 2.0)) .001)
- (> (abs (- (mixer-ref mx1 0 1) 0.0)) .001)
- (> (abs (- (mixer-ref mx1 1 0) 0.0)) .001)
- (> (abs (- (mixer-ref mx1 1 1) 2.0)) .001))
- (clm-print ";make-scalar-mixer 2: ~A" (mus-describe mx1)))
- (if (or (> (abs (- (mixer-ref mx2 0 0) .1)) .001)
- (> (abs (- (mixer-ref mx2 0 1) .2)) .001)
- (> (abs (- (mixer-ref mx2 1 0) .3)) .001)
- (> (abs (- (mixer-ref mx2 1 1) .4)) .001))
- (clm-print ";make-mixer .1 .2 .3 .4: ~A" (mus-describe mx2)))
- (if (or (> (abs (- (mixer-ref nmx 0 0) 2.1)) .001)
- (> (abs (- (mixer-ref nmx 0 1) 0.2)) .001)
- (> (abs (- (mixer-ref nmx 1 0) 0.3)) .001)
- (> (abs (- (mixer-ref nmx 1 1) 2.4)) .001))
- (clm-print ";mixer add ~A ~A: ~A" (mus-describe mx1) (mus-describe mx2) (mus-describe nmx)))
- (mixer* mx1 .5 mx1)
- (if (or (> (abs (- (mixer-ref mx1 0 0) 1.0)) .001)
- (> (abs (- (mixer-ref mx1 0 1) 0.0)) .001)
- (> (abs (- (mixer-ref mx1 1 0) 0.0)) .001)
- (> (abs (- (mixer-ref mx1 1 1) 1.0)) .001))
- (clm-print ";make-scale (identity): ~A" (mus-describe mx1)))
- (do ((j 0 (+ 1 j)))
- ((= j 2))
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (mixer-set! nmx j k 0.0)
- (set! (mixer-ref mx1 j k) (* 1.0 (+ j k)))
- (set! (mixer-ref mx2 j k) (* 1.0 (* j k)))))
- (mixer* mx1 mx2 nmx)
- (if (or (> (abs (- (mixer-ref nmx 0 0) 0.0)) .001)
- (> (abs (- (mixer-ref nmx 0 1) 1.0)) .001)
- (> (abs (- (mixer-ref nmx 1 0) 0.0)) .001)
- (> (abs (- (mixer-ref nmx 1 1) 2.0)) .001))
- (clm-print ";mixer*: ~A" (mus-describe nmx)))
- (do ((j 0 (+ 1 j)))
- ((= j 2))
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (set! (mixer-ref mx1 j k) 0.0)
- (set! (mixer-ref nmx j k) 0.0)))
- (do ((j 0 (+ 1 j)))
- ((= j 2))
- (mixer-set! mx1 j j 2.0))
- (mixer-set! mx2 0 0 .1)
- (mixer-set! mx2 0 1 .2)
- (mixer-set! mx2 1 0 .3)
- (mixer-set! mx2 1 1 .4))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (N2 (/ size 2))
+ (amps #f) (paincrs #f) (ppincrs #f) (phases #f) (freqs #f))
+ (let ((sr (make-phase-vocoder (make-readin file)
+ :fft-size size
+ :synthesize (lambda (pv)
+ (float-vector-add! amps paincrs)
+ (float-vector-add! ppincrs freqs)
+ (float-vector-add! phases ppincrs)
+ (clm23-sine-bank amps phases N2)))))
+ (set! amps (phase-vocoder-amps sr))
+ (set! paincrs (phase-vocoder-amp-increments sr))
+ (set! ppincrs (phase-vocoder-phase-increments sr))
+ (set! phases (phase-vocoder-phases sr))
+ (set! freqs (phase-vocoder-freqs sr))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (phase-vocoder sr)))))))
(define (sample-osc beg dur freq amp)
- "(sample-osc beg dur freq amp) test instrument for oscil"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (arr (make-vector 20))
- (arrfrq (make-double-array 20 :initial-element (double 0.0))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (arr (make-vector 20))
+ (arrfrq (make-float-vector 20)))
+ (set! amp (* amp 0.05))
(do ((i 0 (+ i 1)))
((= i 20))
- (set! (arrfrq i) (double (* (+ i 1) 100.0)))
+ (set! (arrfrq i) (* (+ i 1) 100.0))
(set! (arr i) (make-oscil (* (+ i 1) 100))))
- (run
- (do ((k start (+ 1 k))) ((= k end))
- (let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i (length arr)))
- (if (oscil? (arr i))
- (begin
- (set! (mus-frequency (arr i)) (arrfrq i))
- (if (> (abs (- (mus-frequency (arr i)) (arrfrq i))) .001)
- (clm-print "oops ~A ~A" (mus-frequency (arr i)) (arrfrq i)))
- (set! sum (+ sum (oscil (arr i)))))))
- (out-any k (* amp .05 sum) 0))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20))
+ (let ((g (arr i))
+ (frq (arrfrq i)))
+ (if (oscil? g)
+ (begin
+ (set! (mus-frequency g) frq)
+ (if (> (abs (- (mus-frequency g) frq)) .001)
+ (format #t "oops ~A ~A" (mus-frequency g) frq))
+ (do ((k start (+ k 1)))
+ ((= k end))
+ (outa k (* amp (oscil g))))))))))
(define (sample-ardcl beg dur freq amp)
- "(sample-ardcl beg dur freq amp) test instrument for arith"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (amps (make-double-array 3 :initial-element 0.0))
- (phases (make-double-array 3 :initial-element 0.0))
- (freqs (make-double-array 3 :initial-element 0.0))
- (ints (make-vector 3 32)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (amps (make-float-vector 3))
+ (phases (make-float-vector 3))
+ (freqs (make-float-vector 3))
+ (ints (make-vector 3 32)))
(do ((i 0 (+ i 1)))
((= i 3))
- (set! (freqs i) (double (* freq (+ i 1))))
- (set! (amps i) (double (/ amp (+ i 2)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (do ((i 0 (+ i 1)))
- ((= i (vct-length phases)))
- (set! (phases i) (+ (phases i) (hz->radians (freqs i)))))
- (if (not (= (ints 0) 32)) (clm-print "int array trouble"))
- (set! (ints 1) 3)
- (if (not (= (ints 1) 3)) (clm-print "set int array trouble"))
- (if (not (= (length amps) 3)) (clm-print "amps len: ~A" (length amps)))
- (out-any i (clm23-sine-bank amps phases 3) 0)))))
-
-(define (sample-strs beg dur freq amp)
- "(sample-strs beg dur freq amp) test instrument for strings"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (filename "oboe.snd"))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (if (not (string=? "oscil" (mus-name os))) (clm-print "oscil name: ~A" (mus-name os)))
- (if (> (abs (- (mus-sound-duration filename) 2.305)) .001) (clm-print "sound-duration: ~A" (mus-sound-duration filename)))
- (if (and (not (string=? (mus-header-type-name (mus-sound-header-type "oboe.snd")) "Sun/Next"))
- (not (string=? (mus-header-type-name (mus-sound-header-type "oboe.snd")) "Sun"))
- (not (string=? (mus-header-type-name (mus-sound-header-type "oboe.snd")) "Next")))
- (clm-print "header type: ~A" (mus-header-type-name (mus-sound-header-type "oboe.snd"))))
- (if (not (string=? (mus-data-format-name (mus-sound-data-format "oboe.snd")) "big endian short (16 bits)"))
- (clm-print "data format: ~A" (mus-data-format-name (mus-sound-data-format "oboe.snd"))))
- (if (not (= (mus-sound-datum-size "oboe.snd") 2)) (clm-print ";datum size: ~A" (mus-sound-datum-size filename)))
- (if (not (= (mus-sound-chans "oboe.snd") 1)) (clm-print ";chans: ~A" (mus-sound-chans filename)))
- (if (not (= (mus-sound-data-location filename) 28)) (clm-print ";data-location: ~A" (mus-sound-data-location filename)))
- (if (not (= (mus-sound-length filename) 101684)) (clm-print ";length: ~A" (mus-sound-length filename)))
- (if (not (= (mus-sound-samples filename) 50828)) (clm-print ";samples: ~A" (mus-sound-samples filename)))
- (if (not (= (frames filename) 50828)) (clm-print ";frames: ~A" (mus-sound-samples filename)))
- (if (not (= (mus-sound-srate filename) 22050)) (clm-print ";srate: ~A" (mus-sound-srate filename)))
- (out-any i (oscil os) 0)))))
+ (set! (freqs i) (hz->radians (* freq (+ i 1))))
+ (set! (amps i) (/ amp (+ i 2))))
+ (do ((i start (+ i 1))) ((= i end))
+ (do ((i 0 (+ i 1)))
+ ((= i (length phases)))
+ (set! (phases i) (+ (phases i) (freqs i))))
+ (if (not (= (ints 0) 32)) (format #t "int array trouble"))
+ (set! (ints 1) 3)
+ (if (not (= (ints 1) 3)) (format #t "set int array trouble"))
+ (if (not (= (length amps) 3)) (format #t "amps len: ~A" (length amps)))
+ (outa i (clm23-sine-bank amps phases 3)))))
(define (sample-flt beg dur freq amp)
- "(sample-flt beg dur freq amp) test instrument for arith"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fltdat (make-double-array 3 :initial-element (double 3.14)))
- (intdat (make-integer-array 3 :initial-element 3))
- (flt (make-filter 8 :xcoeffs (make-vct 8) :ycoeffs (make-vct 8)))
- (os (make-oscil freq)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (fltdat (make-float-vector 3 3.14))
+ (intdat (make-vector 3 3))
+ (flt (make-filter 8 :xcoeffs (make-float-vector 8) :ycoeffs (make-float-vector 8)))
+ (os (make-oscil freq)))
(do ((i 0 (+ i 1)))
((= i 8))
- (set! ((mus-xcoeffs flt) i) (double (/ i 16)))
- (set! ((mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (let ((xs (mus-xcoeffs flt)))
- (if (or (> (abs (- (xs 1) (mus-xcoeff flt 1))) .001)
- (> (abs (- (xs 1) 0.0625)) .001))
- (clm-print "~A ~A~%" (xs 1) (mus-xcoeff flt 1))))
- (let ((data (mus-data flt)))
- (if (> (data 0) 1.0) (clm-print "data overflow? ~A~%" (data 0))))
- (let ((is intdat)
- (fs fltdat))
- (if (not (= (is 1) 3)) (clm-print "intdat let: ~A~%" (is 1)))
- (if (> (abs (- (fs 1) 3.14)) .001) (clm-print "fltdat let: ~A~%" (fs 1))))
- (out-any i (* amp (filter flt (oscil os))) 0)))))
+ (set! ((mus-xcoeffs flt) i) (/ i 16.0))
+ (set! ((mus-ycoeffs flt) i) (- 0.5 (/ i 16.0))))
+ (do ((i start (+ i 1))) ((= i end))
+ (let ((xs (mus-xcoeffs flt)))
+ (if (or (> (abs (- (xs 1) (mus-xcoeff flt 1))) .001)
+ (> (abs (- (xs 1) 0.0625)) .001))
+ (format #t "~A ~A~%" (xs 1) (mus-xcoeff flt 1))))
+ (let ((data (mus-data flt)))
+ (if (> (data 0) 1.0) (format #t "data overflow? ~A~%" (data 0))))
+ (let ((is intdat)
+ (fs fltdat))
+ (if (not (= (is 1) 3)) (format #t "intdat let: ~A~%" (is 1)))
+ (if (> (abs (- (fs 1) 3.14)) .001) (format #t "fltdat let: ~A~%" (fs 1))))
+ (outa i (* amp (filter flt (oscil os)))))))
(define (sample-arrintp beg dur freq amp)
- "(sample-arrintp beg dur freq amp) test instrument for array-interp"
- (let* ((os (make-oscil freq))
- (arr (make-double-array 101))
- (start (seconds->samples beg))
- (len (seconds->samples dur))
- (end (+ start len))
- (loc 0.0)
- (loc-incr (/ 100.0 len)))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x .01)))
- ((= i 100))
- (set! (arr i) (double x)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (array-interp arr loc) (oscil os)) 0)
- (set! loc (+ loc loc-incr))))))
+ (let ((len (seconds->samples dur)))
+ (let ((os (make-oscil freq))
+ (arr (make-float-vector 101))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (loc-incr (/ 100.0 len)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x .01)))
+ ((= i 100))
+ (set! (arr i) x))
+ (do ((i start (+ i 1))
+ (loc 0.0 (+ loc loc-incr)))
+ ((= i end))
+ (outa i (* amp (array-interp arr loc) (oscil os)))))))
(define (sample-if beg dur freq amp)
- "(sample-if beg dur freq amp) test instrument for ifs"
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (k -123)
- (j 0)
- (bool #t))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (if (and (= i start) (not (= k -123))) (clm-print "init k: ~A~%" k))
- (if (not bool) (clm-print "bool: ~A~%" bool))
- (set! j (if bool 1 2))
- (if (not (= j 1)) (clm-print "if expr: ~A~%" j))
- (if bool (set! j 3) (set! j 4))
- (if (not (= j 3)) (clm-print "if statement: ~A~%" j))
- (if (integer? k) (set! j 5))
- (if (not (= j 5)) (clm-print "int k? ~A ~A~%" (integer? k) j))
- (if (= j k) (set! j 6))
- (if (= j 6) (clm-print "j if false: ~A~%" j))
- (set! j (if (= j k) (+ k 7) (+ k 8)))
- (if (not (= j (+ k 8))) (clm-print "if false expr: ~A ~A~%" j k))
- (set! j (if (> j -1234) (if (> k -1234) 9 10) 11))
- (if (not (= j 9)) (clm-print "if 2 expr: ~A~%" j))
- (set! j (if (> j -1234) (begin (set! k 0) 12) 13))
- (if (not (= j 12)) (clm-print "if begin expr: ~A~%" j))
- (if (> j -1234) (begin (set! j 1234) (set! j 14)) (set! j 15))
- (if (not (= j 14)) (clm-print "if begin: ~A~%" j))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (k -123)
+ (j 0)
+ (bool #t))
+ (do ((i start (+ i 1))) ((= i end))
+ (if (and (= i start) (not (= k -123))) (format #t "init k: ~A~%" k))
+ (if (not bool) (format #t "bool: ~A~%" bool))
+ (set! j (if bool 1 2))
+ (if (not (= j 1)) (format #t "if expr: ~A~%" j))
+ (if bool (set! j 3) (set! j 4))
+ (if (not (= j 3)) (format #t "if statement: ~A~%" j))
+ (if (integer? k) (set! j 5))
+ (if (not (= j 5)) (format #t "int k? ~A ~A~%" (integer? k) j))
+ (if (= j k) (set! j 6))
+ (if (= j 6) (format #t "j if false: ~A~%" j))
+ (set! j (if (= j k) (+ k 7) (+ k 8)))
+ (if (not (= j (+ k 8))) (format #t "if false expr: ~A ~A~%" j k))
+ (set! j (if (> j -1234) (if (> k -1234) 9 10) 11))
+ (if (not (= j 9)) (format #t "if 2 expr: ~A~%" j))
+ (set! j (if (> j -1234) (begin (set! k 0) 12) 13))
+ (if (not (= j 12)) (format #t "if begin expr: ~A~%" j))
+ (if (> j -1234) (begin (set! j 1234) (set! j 14)) (set! j 15))
+ (if (not (= j 14)) (format #t "if begin: ~A~%" j))
; (if (> j -1234) (set! j (prog1 16 (set! k 0))))
- ; (if (not (= j 16)) (clm-print "if prog1: ~A~%" j))
+ ; (if (not (= j 16)) (format #t "if prog1: ~A~%" j))
; (if (> j -1234) (set! j (prog2 (set! k 0) 17 (set! k 0))))
- ; (if (not (= j 17)) (clm-print "if prog2: ~A~%" j))
+ ; (if (not (= j 17)) (format #t "if prog2: ~A~%" j))
; (set! k (loop for j from 1 to 4 sum j))
- ; (if (not (= k 10)) (clm-print "loop sum: ~A~%" k))
+ ; (if (not (= k 10)) (format #t "loop sum: ~A~%" k))
; (if (> j -1234) (set! j (prog2 (set! k 0) (if (> j -1234) (begin (set! k 123) 18) 19) (set! k 0))))
- ; (if (not (= j 18)) (clm-print "if nested prog2: ~A~%" j))
- (set! j 123)
- (cond ((= j 0) (set! k -1))
- ((= j 12) (set! k -2))
- ((= j 123) (set! k -3))
- (#t (set! k -4)))
- (if (not (= k -3)) (clm-print "cond: ~A ~A~%" j k))
- (set! k (cond ((= j 0) -4)
- ((= j 12) -5)
- (#t -6)))
- (if (not (= k -6)) (clm-print "cond expr: ~A ~A~%" j k))
- (set! k (let ((a 123))
- (if (> a 0)
- 20
- 32)))
- (if (not (= k 20)) (clm-print "let expr: ~A ~A~%" j k))
- (let ((a 123))
- (set! k a))
- (if (not (= k 123)) (clm-print "let: ~A ~A~%" j k))
- (set! k 123)
- (set! bool (= k 123))
- (if (not bool) (clm-print "bool expr: ~A~%" bool))
- (set! bool (if (= k 123) (> k 0) (< k 0)))
- (if (not bool) (clm-print "if bool expr: ~A~%" bool))
- (set! j 0)
- (set! k (do ((m 0 (+ 1 m)))
- ((= m 3) j)
- (set! j (+ j 1))))
- (if (not (= k 3)) (clm-print "do expr: ~A~%" k))
+ ; (if (not (= j 18)) (format #t "if nested prog2: ~A~%" j))
+ (set! j 123)
+ (cond ((= j 0) (set! k -1))
+ ((= j 12) (set! k -2))
+ ((= j 123) (set! k -3))
+ (#t (set! k -4)))
+ (if (not (= k -3)) (format #t "cond: ~A ~A~%" j k))
+ (set! k (cond ((= j 0) -4)
+ ((= j 12) -5)
+ (#t -6)))
+ (if (not (= k -6)) (format #t "cond expr: ~A ~A~%" j k))
+ (set! k (let ((a 123))
+ (if (> a 0)
+ 20
+ 32)))
+ (if (not (= k 20)) (format #t "let expr: ~A ~A~%" j k))
+ (let ((a 123))
+ (set! k a))
+ (if (not (= k 123)) (format #t "let: ~A ~A~%" j k))
+ (set! k 123)
+ (set! bool (= k 123))
+ (if (not bool) (format #t "bool expr: ~A~%" bool))
+ (set! bool (if (= k 123) (> k 0) (< k 0)))
+ (if (not bool) (format #t "if bool expr: ~A~%" bool))
+ (set! j 0)
+ (set! k (do ((m 0 (+ 1 m)))
+ ((= m 3) j)
+ (set! j (+ j 1))))
+ (if (not (= k 3)) (format #t "do expr: ~A~%" k))
; (dotimes (m 2)
; (set! k (- k 1)))
- ; (if (not (= k 1)) (clm-print "dotimes: ~A~%" k))
- (out-any i (* amp (oscil os)) 0)))))
+ ; (if (not (= k 1)) (format #t "dotimes: ~A~%" k))
+ (outa i (* amp (oscil os))))))
(define (sample-arrfile beg dur freq amp)
- "(sample-arrfile beg dur freq amp) test instrument for arrays"
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (arr (make-double-array 100 :initial-element (double 0.0)))
- (ctr 0)
- (dir 1))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (arr (make-float-vector 100))
+ (ctr 0)
+ (dir 1))
(do ((i 0 (+ i 1)))
((= i 100))
- (set! (arr i) (double (* amp (+ -.5 (* i .01))))))
+ (set! (arr i) (* amp (+ -.5 (* i .01)))))
(array->file "testx.data" arr 100 22050 1)
- (do ((i 0 (+ i 1)))
- ((= i 100))
- (set! (arr i) (double 0.0)))
+ (fill! arr 0.0)
(file->array "testx.data" 0 0 100 arr)
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* (arr ctr) (oscil os)) 0)
- (set! ctr (+ ctr dir))
- (if (>= ctr 99) (set! dir -1)
- (if (<= ctr 0) (set! dir 1)))))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* (arr ctr) (oscil os)))
+ (set! ctr (+ ctr dir))
+ (if (>= ctr 99) (set! dir -1)
+ (if (<= ctr 0) (set! dir 1))))))
(define (simple-grn-f1 beg dur amp speed freq)
- "(simple-grn-f1 beg dur amp speed freq) test instrument for granulate"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (os (make-oscil freq))
- (sr (make-granulate :expansion speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (granulate sr (lambda (dir) (oscil os)) #f)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq)))
+ (let ((sr (make-granulate :expansion speed :input (lambda (dir) (oscil os)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (granulate sr)))))))
-;(with-sound () (simple-grn-f1 0 1 .1 2 440))
+ ;(with-sound () (simple-grn-f1 0 1 .1 2 440))
(define (simple-grn-f2 beg dur amp speed file)
- "(simple-grn-f2 beg dur amp speed file) test instrument for granulate"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-granulate :input rd :expansion speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (granulate sr)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-granulate :input (make-readin file) :expansion speed)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (granulate sr))))))
-;(with-sound () (simple-grn-f2 0 1 1 2 "oboe.snd"))
+ ;(with-sound () (simple-grn-f2 0 1 1 2 "oboe.snd"))
(define (simple-grn-f3 beg dur amp speed file)
- "(simple-grn-f3 beg dur amp speed file) test instrument for granulate"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-granulate :input rd :expansion speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (granulate sr #f #f)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-granulate :input (make-readin file) :expansion speed)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (granulate sr))))))
-;(with-sound () (simple-grn-f3 0 1 1 2 "oboe.snd"))
+ ;(with-sound () (simple-grn-f3 0 1 1 2 "oboe.snd"))
(define (simple-grn-f4 beg dur amp speed file)
- "(simple-grn-f4 beg dur amp speed file) test instrument for granulate"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-granulate :input rd :expansion speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (granulate sr #f)) 0)))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-granulate :input (make-readin file) :expansion speed)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (granulate sr))))))
-;(with-sound () (simple-grn-f4 0 1 1 2 "oboe.snd"))
+ ;(with-sound () (simple-grn-f4 0 1 1 2 "oboe.snd"))
(define (simple-grn-f5 beg dur amp speed file)
- "(simple-grn-f5 beg dur amp speed file) test instrument for granulate"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-granulate :input rd :expansion speed)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (granulate sr #f
- (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (length g))) ; current grain length
- (do ((i 0 (+ i 1)))
- ((= i len) len) ; grain length unchanged in this case
- (set! (grain i) (* 2 (grain i)))))
- 0)))
- 0)))))
-
-;(with-sound () (simple-grn-f5 0 1 1 2 "oboe.snd"))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-granulate :input (make-readin file)
+ :expansion speed
+ :edit (lambda (g) (float-vector-scale! (mus-data g) 2.0) 0))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (granulate sr))))))
+ ;(with-sound (:statistics #t) (simple-grn-f5 0 1 1 2 "oboe.snd"))
(define (sample-pvoc5 beg dur amp size file freq)
- "(sample-pvoc5 beg dur amp size file freq) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fil (make-readin file))
- (sr (make-phase-vocoder :fft-size size))
- (os (make-oscil freq)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (phase-vocoder sr
- (lambda (dir)
- (readin fil))
- #f
- #f
- (lambda (closure)
- (oscil os))))
- 0)))))
-
-;(with-sound () (sample-pvoc5 0 1 .1 256 "oboe.snd" 440.0))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (os (make-oscil freq)))
+ (let ((sr (make-phase-vocoder (make-readin file)
+ :fft-size size
+ :synthesize (lambda (pv) (oscil os)))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (phase-vocoder sr)))))))
+;; (with-sound () (sample-pvoc5 0 1 .1 256 "oboe.snd" 440.0))
#|
(with-sound (:statistics #t)
- (simple-ssb 0 .2 440 .1)
- (simple-nsin .6 .2 .1)
- (simple-ncos 0.7 .2 440 .1)
- (simple-nrxysin .6 .2 .1)
- (simple-nrxycos 0.7 .2 440 .1)
- (simple-osc 0.75 .2 440 .1)
- (simple-asy 1.25 .2 .1)
- (simple-saw 1.5 .2 .1)
- (simple-tri 1.75 .2 .1)
- (simple-pul 2.0 .2 .1)
- (simple-sqr 2.25 .2 .1)
- (simple-sib 2.5 .2 440.0 .1)
- (simple-oz 2.75 .2 440.0 .1)
- (simple-op 3.0 .2 440.0 .1)
- (simple-tz 3.25 .2 440.0 .1)
- (simple-tp 3.5 .2 440.0 .1)
- (simple-frm 3.75 .2 440.0 .1)
- (simple-buf 4.5 .2 440.0 .1)
- (simple-dly 4.75 .2 440.0 .1)
- (simple-cmb 5.0 .2 440.0 .1)
- (simple-not 5.25 .2 440.0 .1)
- (simple-alp 5.5 .2 440.0 .1)
- (simple-ave 5.75 .2 440.0 .1)
- (simple-tab 6.0 .2 440.0 .1)
- (simple-flt 6.25 .2 440.0 .1)
- (simple-fir 6.5 .2 440.0 .1)
- (simple-iir 6.5 .2 440.0 .3)
- (simple-f 6.75 .2 440.0 .1)
- (simple-ran 7.0 .2 440.0 .1)
- (simple-ri 7.25 .2 440.0 .1)
- (simple-env 7.5 .2 440.0 .1)
- (simple-amb 7.75 .2 440.0 .1)
- (simple-fof 8 1 270 .1 .001 730 .6 1090 .3 2440 .1) ;"Ahh"
- (simple-fof 9 4 270 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
- (simple-fof 9 4 (* 6/5 540) .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
- (simple-fof 9 4 135 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0))
- (simple-rd 13.5 .45 .75 "oboe.snd")
- (simple-cnv 14.0 .45 .75 "oboe.snd")
- (simple-cnf 14.5 .45 .75 "oboe.snd")
- (simple-lrg 15.0 .45 .75 "oboe.snd")
- (simple-cn2 15.5 .45 .4 "oboe.snd")
- (simple-src 16 .45 1.0 2.0 "oboe.snd")
- (simple-sr2 16.5 .45 1.0 2.0 "oboe.snd")
- (simple-sr2a 16.75 .45 1.0 2.0 "oboe.snd")
- (simple-rndist 17.0 .2 440.0 .1)
- (simple-ridist 17.25 .2 440.0 .1)
- (simple-sro 17.5 .45 .1 .5 440)
- (simple-grn 18 .2 .1 1.0 440)
- (simple-pvoc 18.25 .2 .4 256 "oboe.snd")
- (simple-ina 18.5 .45 1 "oboe.snd")
- (simple-rdf 19 .45 1 "oboe.snd")
- (simple-f2s 19.5 .45 1 "oboe.snd")
- (simple-loc 20 .2 440 .1)
- (simple-out 20.25 .2 440 .1)
- (simple-dup 20.5 .2 440 .1)
- (simple-du1 20.75 .2 440 .1)))
+ (simple-ssb 0 .2 440 .1)
+ (simple-nsin .6 .2 .1)
+ (simple-ncos 0.7 .2 440 .1)
+ (simple-nrxysin .6 .2 .1)
+ (simple-nrxycos 0.7 .2 440 .1)
+ (simple-osc 0.75 .2 440 .1)
+ (simple-asy 1.25 .2 .1)
+ (simple-saw 1.5 .2 .1)
+ (simple-tri 1.75 .2 .1)
+ (simple-pul 2.0 .2 .1)
+ (simple-sqr 2.25 .2 .1)
+ (simple-oz 2.75 .2 440.0 .1)
+ (simple-op 3.0 .2 440.0 .1)
+ (simple-tz 3.25 .2 440.0 .1)
+ (simple-tp 3.5 .2 440.0 .1)
+ (simple-frm 3.75 .2 440.0 .1)
+ (simple-buf 4.5 .2 440.0 .1)
+ (simple-dly 4.75 .2 440.0 .1)
+ (simple-cmb 5.0 .2 440.0 .1)
+ (simple-not 5.25 .2 440.0 .1)
+ (simple-alp 5.5 .2 440.0 .1)
+ (simple-ave 5.75 .2 440.0 .1)
+ (simple-tab 6.0 .2 440.0 .1)
+ (simple-flt 6.25 .2 440.0 .1)
+ (simple-fir 6.5 .2 440.0 .1)
+ (simple-iir 6.5 .2 440.0 .3)
+ (simple-ran 7.0 .2 440.0 .1)
+ (simple-ri 7.25 .2 440.0 .1)
+ (simple-env 7.5 .2 440.0 .1)
+ (simple-amb 7.75 .2 440.0 .1)
+ (simple-fof 8 1 270 .1 .001 730 .6 1090 .3 2440 .1) ;"Ahh"
+ (simple-fof 9 4 270 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
+ (simple-fof 9 4 (* 6/5 540) .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
+ (simple-fof 9 4 135 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0))
+ (simple-rd 13.5 .45 .75 "oboe.snd")
+ (simple-cnv 14.0 .45 .75 "oboe.snd")
+ (simple-cnf 14.5 .45 .75 "oboe.snd")
+ (simple-lrg 15.0 .45 .75 "oboe.snd")
+ (simple-cn2 15.5 .45 .4 "oboe.snd")
+ (simple-src 16 .45 1.0 2.0 "oboe.snd")
+ (simple-sr2 16.5 .45 1.0 2.0 "oboe.snd")
+ (simple-sr2a 16.75 .45 1.0 2.0 "oboe.snd")
+ (simple-rndist 17.0 .2 440.0 .1)
+ (simple-ridist 17.25 .2 440.0 .1)
+ (simple-sro 17.5 .45 .1 .5 440)
+ (simple-grn 18 .2 .1 1.0 440)
+ (simple-pvoc 18.25 .2 .4 256 "oboe.snd")
+ (simple-ina 18.5 .45 1 "oboe.snd")
+ (simple-rdf 19 .45 1 "oboe.snd")
+ (simple-f2s 19.5 .45 1 "oboe.snd")
+ (simple-loc 20 .2 440 .1)
+ (simple-out 20.25 .2 440 .1)
+ (simple-dup 20.5 .2 440 .1)
+ (simple-du1 20.75 .2 440 .1)))
(with-sound (:statistics #t)
- (sample-desc 0 .2 440 .1)
- (sample-mdat .25 .2 440 .1)
- (sample-xtab .5 .2 440 .1)
- (sample-xts .75 .2 440 .1)
- (sample-srl2 1 .2 .2 .5 (* 440 2))
- (sample-srll 1.25 .2 .1 .5 (* 440 4))
- (sample-srl3 1.5 .2 .1 .5 880)
- (sample-grn2 1.75 .2 .1 .5 880)
- (sample-grn3 2 .45 1 1 "oboe.snd")
- (sample-cnv 2.5 .45 1 1 "oboe.snd")
- (sample-cnv1 3.0 .45 1 1 "oboe.snd")
- (sample-pvoc1 3.5 .45 1 512 "oboe.snd")
- (sample-pvoc2 4.0 .45 1 512 "oboe.snd")
- (sample-pvoc3 4.5 .001 1 512 "oboe.snd")
- (sample-mxf 5 .2 440 .1)
- (sample-osc 5.25 .2 440 .1)
- (sample-ardcl 5.5 .2 440 .1)
- (sample-strs 5.75 .2 440 .1)
- (sample-flt 6 .2 440 .1)
- (sample-arrintp 6.25 .2 440 .1)
- (sample-if 6.5 .2 440 .1)
- (sample-arrfile 6.75 .2 440 .15)
- (sample-pvoc5 7 .2 .1 256 "oboe.snd" 440.0)
- )
+ (sample-desc 0 .2 440 .1)
+ (sample-mdat .25 .2 440 .1)
+ (sample-xtab .5 .2 440 .1)
+ (sample-xts .75 .2 440 .1)
+ (sample-srl2 1 .2 .2 .5 (* 440 2))
+ (sample-srll 1.25 .2 .1 .5 (* 440 4))
+ (sample-srl3 1.5 .2 .1 .5 880)
+ (sample-grn2 1.75 .2 .1 .5 880)
+ (sample-grn3 2 .45 1 1 "oboe.snd")
+ (sample-cnv 2.5 .45 1 1 "oboe.snd")
+ (sample-cnv1 3.0 .45 1 1 "oboe.snd")
+ (sample-pvoc1 3.5 .45 1 512 "oboe.snd")
+ (sample-pvoc2 4.0 .45 1 512 "oboe.snd")
+ (sample-pvoc3 4.5 .001 1 512 "oboe.snd")
+ (sample-osc 5.25 .2 440 .1)
+ (sample-ardcl 5.5 .2 440 .1)
+ (sample-flt 6 .2 440 .1)
+ (sample-arrintp 6.25 .2 440 .1)
+ (sample-if 6.5 .2 440 .1)
+ (sample-arrfile 6.75 .2 440 .15)
+ (sample-pvoc5 7 .2 .1 256 "oboe.snd" 440.0)
+ )
|#
(define (pvoc-a beg dur amp size file)
- "(pvoc-a beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (sr (make-phase-vocoder :input (make-readin file) :fft-size size :interp (/ size 4) :overlap 4)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (phase-vocoder sr)) 0)))))
-
-(define (pvoc-b beg dur amp size file)
- "(pvoc-b beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-phase-vocoder :fft-size size :interp (/ size 4) :overlap 4)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (phase-vocoder sr (lambda (dir) (readin rd)))) 0)))))
-
-#|
-(let* ((outfile (with-sound () (pvoc-a 0 2.3 1 256 "oboe.snd") (pvoc-b 0 2.3 -1 256 "oboe.snd")))
- (mx (mus-sound-maxamp outfile)))
- (if (fneq (cadr mx) 0.0)
- (format #t ";pvoc a-b: ~A" mx)))
-|#
-
-(define (pvoc-c beg dur amp size file)
- "(pvoc-c beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-phase-vocoder :fft-size size :interp (/ size 4) :overlap 4)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i
- (* amp
- (phase-vocoder sr
- (lambda (dir) (readin rd))
- #f
- #f
- (lambda (closure)
- (let ((N2 (floor (/ size 2))))
- (do ((k 0 (+ 1 k)))
- ((= k N2))
- (vct-set! (phase-vocoder-amps sr) k (+ ((phase-vocoder-amps sr) k)
- ((phase-vocoder-amp-increments sr) k)))
- (vct-set! (phase-vocoder-phase-increments sr) k (+ ((phase-vocoder-phase-increments sr) k)
- ((phase-vocoder-freqs sr) k)))
- (vct-set! (phase-vocoder-phases sr) k (+ ((phase-vocoder-phases sr) k)
- ((phase-vocoder-phase-increments sr) k))))
- (clm23-sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2)))
- ))
- 0)))))
-
-#|
-(let* ((outfile (with-sound () (pvoc-a 0 2.3 1 256 "oboe.snd") (pvoc-c 0 2.3 -1 256 "oboe.snd")))
- (mx (mus-sound-maxamp outfile)))
- (if (fneq (cadr mx) 0.0)
- (format #t ";pvoc a-c: ~A" mx)))
-|#
-
-
-(define (pvoc-d beg dur amp size file)
- "(pvoc-d beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-phase-vocoder :fft-size size :interp (/ size 4) :overlap 4))
- (N2 (floor (/ size 2)))
- (lastphases (make-vct N2 0.0))
- (two-pi (* 2 pi)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i
- (* amp
- (phase-vocoder sr
- (lambda (dir) (readin rd))
- #f
- (lambda (closure)
- (let* ((D (floor (/ size 4))) ; overlap = 4
- (pscl (/ 1.0 D))
- (kscl (/ two-pi size)))
- (do ((k 0 (+ 1 k))
- (ks 0.0 (+ ks kscl)))
- ((= k N2))
- (let* ((freq ((phase-vocoder-freqs sr) k))
- (diff (- freq (lastphases k))))
- (set! (lastphases k) freq)
- (if (> diff pi) (set! diff (- diff two-pi)))
- (if (< diff (- pi)) (set! diff (+ diff two-pi)))
- (set! ((phase-vocoder-freqs sr) k) (+ (* diff pscl) ks))))
- #f))
- (lambda (closure)
- (do ((k 0 (+ 1 k)))
- ((= k N2))
- (vct-set! (phase-vocoder-amps sr) k (+ ((phase-vocoder-amps sr) k)
- ((phase-vocoder-amp-increments sr) k)))
- (vct-set! (phase-vocoder-phase-increments sr) k (+ ((phase-vocoder-phase-increments sr) k)
- ((phase-vocoder-freqs sr) k)))
- (vct-set! (phase-vocoder-phases sr) k (+ ((phase-vocoder-phases sr) k)
- ((phase-vocoder-phase-increments sr) k))))
- (clm23-sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))
- ))
- 0)))))
-
-#|
-(let* ((outfile (with-sound () (pvoc-a 0 2.3 1 256 "oboe.snd") (pvoc-d 0 2.3 -1 256 "oboe.snd")))
- (mx (mus-sound-maxamp outfile)))
- (if (fneq (cadr mx) 0.0)
- (format #t ";pvoc a-d: ~A" mx)))
-|#
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-phase-vocoder :input (make-readin file) :fft-size size :interp (/ size 4) :overlap 4)))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (phase-vocoder sr))))))
(define (pvoc-e beg dur amp size file)
- "(pvoc-e beg dur amp size file) test instrument for phase-vocoder"
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (rd (make-readin file))
- (sr (make-phase-vocoder :fft-size size :interp (/ size 4) :overlap 4))
- (N2 (floor (/ size 2)))
- (lastphases (make-vct N2 0.0))
- (in-data (make-vct size 0.0))
- (two-pi (* 2 pi))
- (filptr 0)
- (window (make-fft-window hamming-window size 0.0))
- (D (floor (/ size 4)))) ; overlap = 4
- (vct-scale! window (/ 2.0 (* 0.54 size)))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i
- (* amp
- (phase-vocoder sr
- (lambda (dir) (readin rd))
-
- (lambda (closure input)
- (let ((buf (modulo filptr size)))
- (clear-array (phase-vocoder-freqs sr))
- (if (= filptr 0)
- (do ((k 0 (+ 1 k)))
- ((= k size))
- (set! (in-data k) (readin rd)))
- (begin
- (do ((k 0 (+ 1 k))
- (j D (+ 1 j)))
- ((= j size))
- (set! (in-data k) (in-data j)))
- (do ((k (- size D) (+ 1 k)))
- ((= k size))
- (set! (in-data k) (readin rd)))))
- (do ((k 0 (+ 1 k)))
- ((= k size))
- (vct-set! (phase-vocoder-amp-increments sr) buf (* (in-data k) (window k)))
- (set! buf (+ 1 buf))
- (if (>= buf size) (set! buf 0)))
- (set! filptr (+ filptr D))
- (mus-fft (phase-vocoder-amp-increments sr) (phase-vocoder-freqs sr) size 1)
- (rectangular->polar (phase-vocoder-amp-increments sr) (phase-vocoder-freqs sr))
- #f))
-
- (lambda (closure)
- (let* ((pscl (/ 1.0 D))
- (kscl (/ two-pi size)))
- (do ((k 0 (+ 1 k))
- (ks 0.0 (+ ks kscl)))
- ((= k N2))
- (let* ((freq ((phase-vocoder-freqs sr) k))
- (diff (- freq (lastphases k))))
- (set! (lastphases k) freq)
- (if (> diff pi) (set! diff (- diff two-pi)))
- (if (< diff (- pi)) (set! diff (+ diff two-pi)))
- (vct-set! (phase-vocoder-freqs sr) k (+ (* diff pscl) ks))))
- #f))
-
- (lambda (closure)
- (do ((k 0 (+ 1 k)))
- ((= k N2))
- (vct-set! (phase-vocoder-amps sr) k (+ ((phase-vocoder-amps sr) k)
- ((phase-vocoder-amp-increments sr) k)))
- (vct-set! (phase-vocoder-phase-increments sr) k (+ ((phase-vocoder-phase-increments sr) k)
- ((phase-vocoder-freqs sr) k)))
- (vct-set! (phase-vocoder-phases sr) k (+ ((phase-vocoder-phases sr) k)
- ((phase-vocoder-phase-increments sr) k))))
- (clm23-sine-bank (phase-vocoder-amps sr) (phase-vocoder-phases sr) N2))
- ))
- 0)))))
-
-#|
-(let* ((outfile (with-sound () (pvoc-a 0 2.3 1 256 "oboe.snd") (pvoc-e 0 2.3 -1 256 "oboe.snd")))
- (mx (mus-sound-maxamp outfile)))
- (if (fneq (cadr mx) 0.0)
- (format #t ";pvoc a-e: ~A" mx)))
-|#
+ (let ((N2 (floor (/ size 2)))
+ (rd (make-readin file)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (lastphases (make-float-vector N2))
+ (in-data (make-float-vector size))
+ (filptr 0)
+ (window (make-fft-window hamming-window size 0.0))
+ (D (floor (/ size 4))) ; overlap = 4
+ (amps #f) (paincrs #f) (ppincrs #f) (phases #f) (freqs #f))
+ (let ((sr (make-phase-vocoder rd
+ :fft-size size
+ :interp (/ size 4)
+ :overlap 4
+ :analyze (lambda (pv input)
+ (let ((buf (modulo filptr size)))
+ (fill! freqs 0.0)
+ (if (= filptr 0)
+ (do ((k 0 (+ k 1)))
+ ((= k size))
+ (set! (in-data k) (readin rd)))
+ (begin
+ (do ((k 0 (+ k 1))
+ (j D (+ j 1)))
+ ((= j size))
+ (set! (in-data k) (in-data j)))
+ (do ((k (- size D) (+ k 1)))
+ ((= k size))
+ (set! (in-data k) (readin rd)))))
+ (do ((k 0 (+ k 1)))
+ ((= k size))
+ (float-vector-set! paincrs buf (* (in-data k) (window k)))
+ (set! buf (+ buf 1))
+ (if (>= buf size) (set! buf 0)))
+ (set! filptr (+ filptr D))
+ (mus-fft paincrs freqs size 1)
+ (rectangular->polar paincrs freqs)
+ #f))
+ :edit (lambda (pv)
+ (let ((pscl (/ 1.0 D))
+ (kscl (/ two-pi size)))
+ (do ((k 0 (+ k 1))
+ (ks 0.0 (+ ks kscl)))
+ ((= k N2))
+ (let* ((freq (freqs k))
+ (diff (- freq (lastphases k))))
+ (set! (lastphases k) freq)
+ (if (> diff pi) (set! diff (- diff two-pi)))
+ (if (< diff (- pi)) (set! diff (+ diff two-pi)))
+ (float-vector-set! freqs k (+ (* diff pscl) ks))))
+ #f))
+ :synthesize (lambda (pv)
+ (float-vector-add! amps paincrs)
+ (float-vector-add! ppincrs freqs)
+ (float-vector-add! phases ppincrs)
+ (clm23-sine-bank amps phases N2)))))
+ (set! amps (phase-vocoder-amps sr))
+ (set! paincrs (phase-vocoder-amp-increments sr))
+ (set! ppincrs (phase-vocoder-phase-increments sr))
+ (set! phases (phase-vocoder-phases sr))
+ (set! freqs (phase-vocoder-freqs sr))
+ (float-vector-scale! window (/ 2.0 (* 0.54 size)))
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (phase-vocoder sr))))))))
(define (or1)
- "(or1) test function for or"
(let ((e1 (make-env '(0 0 1 1) :length 10))
(e2 (make-env '(0 1 1 0) :length 10))
(e3 #f)
(ok1 0.0))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 1))
- (set! ok1 0.0)
- (if (or e1 e2)
- (set! ok1 (+ ok1 (env e1)))
- (clm-print ";or1 a~%"))
- (if (not (or e1 e2))
- (clm-print ";or1 1~%"))
- (if (and e1 e2)
- (set! ok1 (+ ok1 (env e2)))
- (clm-print ";or1 b~%"))
- (if (not (and e1 e2))
- (clm-print ";or1 2~%"))
- (if (or e3 e1 e2)
- (mus-reset e2) ; resets e2 -> 1.0
- (clm-print ";or1 c~%"))
- (if (and e1 e3 e2)
- (clm-print ";or1 3~%"))
- (if (not e1)
- (clm-print ";or1 4~%"))
- (if (< (abs ok1) .001)
- (clm-print ";or1 ok1: ~A~%" ok1))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (set! ok1 0.0)
+ (if (or e1 e2)
+ (set! ok1 (+ ok1 (env e1)))
+ (format #t ";or1 a~%"))
+ (if (not (or e1 e2))
+ (format #t ";or1 1~%"))
+ (if (and e1 e2)
+ (set! ok1 (+ ok1 (env e2)))
+ (format #t ";or1 b~%"))
+ (if (not (and e1 e2))
+ (format #t ";or1 2~%"))
+ (if (or e3 e1 e2)
+ (mus-reset e2) ; resets e2 -> 1.0
+ (format #t ";or1 c~%"))
+ (if (and e1 e3 e2)
+ (format #t ";or1 3~%"))
+ (if (not e1)
+ (format #t ";or1 4~%"))
+ (if (< (abs ok1) .001)
+ (format #t ";or1 ok1: ~A~%" ok1)))))
(define (or2)
- "(or2) test function for or"
(let ((e1 (make-env '(0 0 1 1) :length 10))
(e2 (make-env '(0 1 1 0) :length 10))
(e3 #f)
(ok1 0.0)
(oki 0)
(okb #f))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 1))
- (declare (e1 clm) (e2 clm) (e3 clm)
- (ok1 float)
- (oki int)
- (okb boolean))
- (set! ok1 0.0)
- (set! oki (+ 1 oki))
- (set! okb #t)
- (if (or e1 e2)
- (set! ok1 (+ ok1 (env e1)))
- (clm-print ";or2 a~%"))
- (if (not (or e1 e2))
- (clm-print ";or2 1~%"))
- (if (and e1 e2)
- (set! ok1 (+ ok1 (env e2)))
- (clm-print ";or2 b~%"))
- (if (not (and e1 e2))
- (clm-print ";or2 2~%"))
- (if (or e3 e1 e2)
- (mus-reset e2) ; resets e2 -> 1.0
- (clm-print ";or2 c~%"))
- (if (and e1 e3 e2)
- (clm-print ";or2 3~%"))
- (if (not e1)
- (clm-print ";or2 4~%"))
- (if (< (abs ok1) .001)
- (clm-print ";or1 ok1: ~A~%" ok1))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (set! ok1 0.0)
+ (set! oki (+ oki 1))
+ (set! okb #t)
+ (if (or e1 e2)
+ (set! ok1 (+ ok1 (env e1)))
+ (format #t ";or2 a~%"))
+ (if (not (or e1 e2 okb))
+ (format #t ";or2 1~%"))
+ (if (and e1 e2)
+ (set! ok1 (+ ok1 (env e2)))
+ (format #t ";or2 b~%"))
+ (if (not (and e1 e2))
+ (format #t ";or2 2~%"))
+ (if (or e3 e1 e2)
+ (mus-reset e2) ; resets e2 -> 1.0
+ (format #t ";or2 c~%"))
+ (if (and e1 e3 e2)
+ (format #t ";or2 3~%"))
+ (if (not e1)
+ (format #t ";or2 4~%"))
+ (if (< (abs ok1) .001)
+ (format #t ";or1 ok1: ~A~%" ok1)))))
(define (or3)
- "(or3) test function for or"
(let ((e1 (make-env '(0 0 1 1) :length 10))
(i1 (make-vector 3 32))
- (f1 (make-vct 3 3.14))
+ (f1 (make-float-vector 3 3.14))
(i2 (make-vector 3 3))
(f2 (make-vector 3 1.5))
(ok1 0.0)
(oki 0))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 1))
- (cond (e1 (set! ok1 (+ ok1 (env e1))))
- (#t (clm-print ";or3 1~%")))
- (if (or f1 f2)
- (set! ok1 (+ ok1 (f2 0)))
- (clm-print ";or3 a~%"))
- (if (not (or f2 f1))
- (clm-print ";or3 2~%"))
- (if (and f2 f1)
- (set! ok1 (+ ok1 (f1 1)))
- (clm-print ";or3 b~%"))
- (if (or i1 i2)
- (set! oki (+ oki (i2 0)))
- (clm-print ";or3 d~%"))
- (if (not (or i2 i1))
- (clm-print ";or3 3~%"))
- (if (and i2 i1)
- (set! oki (+ oki (i1 1)))
- (clm-print ";or3 e~%"))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (cond (e1 (set! ok1 (+ ok1 (env e1))))
+ (#t (format #t ";or3 1~%")))
+ (if (or f1 f2)
+ (set! ok1 (+ ok1 (f2 0)))
+ (format #t ";or3 a~%"))
+ (if (not (or f2 f1))
+ (format #t ";or3 2~%"))
+ (if (and f2 f1)
+ (set! ok1 (+ ok1 (f1 1)))
+ (format #t ";or3 b~%"))
+ (if (or i1 i2)
+ (set! oki (+ oki (i2 0)))
+ (format #t ";or3 d~%"))
+ (if (not (or i2 i1))
+ (format #t ";or3 3~%"))
+ (if (and i2 i1)
+ (set! oki (+ oki (i1 1)))
+ (format #t ";or3 e~%")))))
(define (or4)
- "(or4) test function for or"
(let ((e1 (make-env '(0 0 1 1) :length 10))
(e2 (make-env '(0 1 1 0) :length 10))
(i1 (make-vector 3 32))
- (f1 (make-vct 3 3.14))
+ (f1 (make-float-vector 3 3.14))
(i2 (make-vector 3 3))
(f2 (make-vector 3 1.5))
(oki 0))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 1))
- (if (or (and e1 e2)
- (and f1 f2)
- (and i1 i2))
- (set! oki (+ 1 oki))
- (clm-print ";or4 a~%"))
- (if (and (or f1 f2)
- (not (or i1 i2))
- (or e1 e2))
- (clm-print ";or4 1~%"))
- (if f1
- (if e1
- (if (not e2)
- (clm-print ";or4 2~%")
- (set! oki (+ 1 oki)))
- (clm-print ";or4 3~%"))
- (clm-print ";or4 4~%"))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (if (or (and e1 e2)
+ (and f1 f2)
+ (and i1 i2))
+ (set! oki (+ oki 1))
+ (format #t ";or4 a~%"))
+ (if (and (or f1 f2)
+ (not (or i1 i2))
+ (or e1 e2))
+ (format #t ";or4 1~%"))
+ (if f1
+ (if e1
+ (if (not e2)
+ (format #t ";or4 2~%")
+ (set! oki (+ oki 1)))
+ (format #t ";or4 3~%"))
+ (format #t ";or4 4~%")))))
;;; --------------------------------------------------------------------------------
@@ -1870,9 +1324,6 @@
;;; instruments and note lists from the documentation
-(if (not (provided? 'snd-dsp.scm)) (load "dsp.scm"))
-(if (not (provided? 'snd-jcrev.scm)) (load "jcrev.scm"))
-
;;; ins in docs + note lists
;;; fm.html
@@ -1882,219 +1333,252 @@
(carrier-phase-incr (hz->radians freq))
(modulator-phase 0.0)
(modulator-phase-incr (hz->radians (* mc-ratio freq))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let* ((modulation (* index (sin modulator-phase)))
- (pm-val (* amp (sin (+ carrier-phase modulation)))))
- ;; no integration in phase modulation (it's a phase change)
- (set! carrier-phase (+ carrier-phase carrier-phase-incr))
- (set! modulator-phase (+ modulator-phase modulator-phase-incr))
- (outa i pm-val))))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let* ((modulation (* index (sin modulator-phase)))
+ (pm-val (* amp (sin (+ carrier-phase modulation)))))
+ ;; no integration in phase modulation (it's a phase change)
+ (set! carrier-phase (+ carrier-phase carrier-phase-incr))
+ (set! modulator-phase (+ modulator-phase modulator-phase-incr))
+ (outa i pm-val)))))
(define (fmdoc-fm beg end freq amp mc-ratio index)
- (let* ((carrier-phase 0.0)
- (carrier-phase-incr (hz->radians freq))
- (modulator-phase-incr (hz->radians (* mc-ratio freq)))
- (modulator-phase (* 0.5 (+ pi modulator-phase-incr)))
- ;; (pi+incr)/2 to get (centered) sin after integration, to match pm case above
- ;; I believe this is what causes most of the confusion
- (fm-index (hz->radians (* mc-ratio freq index))))
- ;; fix up fm index (it's a frequency change)
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((modulation (* fm-index (sin modulator-phase)))
- (fm-val (* amp (sin carrier-phase))))
- (set! carrier-phase (+ carrier-phase modulation carrier-phase-incr))
- (set! modulator-phase (+ modulator-phase modulator-phase-incr))
- (outb i fm-val))))))
+ (let ((carrier-phase 0.0)
+ (carrier-phase-incr (hz->radians freq))
+ (modulator-phase-incr (hz->radians (* mc-ratio freq))))
+ (let ((modulator-phase (* 0.5 (+ pi modulator-phase-incr)))
+ ;; (pi+incr)/2 to get (centered) sin after integration, to match pm case above
+ ;; I believe this is what causes most of the confusion
+ (fm-index (hz->radians (* mc-ratio freq index))))
+ ;; fix up fm index (it's a frequency change)
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((modulation (* fm-index (sin modulator-phase)))
+ (fm-val (* amp (sin carrier-phase))))
+ (set! carrier-phase (+ carrier-phase modulation carrier-phase-incr))
+ (set! modulator-phase (+ modulator-phase modulator-phase-incr))
+ (outa i fm-val))))))
(define* (fmdoc-fm-1 beg dur freq amp mc-ratio index (index-env '(0 1 100 1)))
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (cr (make-oscil freq))
- (md (make-oscil (* freq mc-ratio)))
- (fm-index (hz->radians (* index mc-ratio freq)))
- (ampf (make-env index-env :scaler amp :duration dur))
- (indf (make-env index-env :scaler fm-index :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* (env ampf) ; amplitude env
- (oscil cr (* (env indf) ; carrier + modulation env
- (oscil md)))) ; modulation
- )))))
+ (let ((fm-index (hz->radians (* index mc-ratio freq))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (cr (make-oscil freq))
+ (md (make-oscil (* freq mc-ratio)))
+ (ampf (make-env index-env :scaler amp :duration dur))
+ (indf (make-env index-env :scaler fm-index :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env ampf) ; amplitude env
+ (oscil cr (* (env indf) ; carrier + modulation env
+ (oscil md)))) ; modulation
+ )))))
(define (fmdoc-fm-2 beg dur freq amp mc-ratio index carrier-phase mod-phase)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (cr (make-oscil freq carrier-phase))
- (md (make-oscil (* freq mc-ratio) mod-phase))
- (fm-index (hz->radians (* index mc-ratio freq))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil cr (* fm-index (oscil md)))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (cr (make-oscil freq carrier-phase))
+ (md (make-oscil (* freq mc-ratio) mod-phase))
+ (fm-index (hz->radians (* index mc-ratio freq))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil cr (* fm-index (oscil md))))))))
(define (fmdoc-fm-3 beg dur freq amp mc-ratio index car-phase mod-phase skew-func skew)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (cr (make-oscil freq car-phase))
- (md (make-oscil (* freq mc-ratio) mod-phase))
- (skewf (make-env skew-func :scaler (hz->radians (* skew mc-ratio freq)) :duration dur))
- (fm-index (hz->radians (* index mc-ratio freq))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil cr (* fm-index (oscil md (env skewf))))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (cr (make-oscil freq car-phase))
+ (md (make-oscil (* freq mc-ratio) mod-phase))
+ (skewf (make-env skew-func :scaler (hz->radians (* skew mc-ratio freq)) :duration dur))
+ (fm-index (hz->radians (* index mc-ratio freq))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil cr (* fm-index (oscil md (env skewf)))))))))
(define (fmdoc-fm-4 beg dur freq amp mc-ratio index cr0p cr1p md0p md1p)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (cr0 (make-oscil 0 cr0p))
- (cr1 (make-oscil 0 cr1p))
- (md0 (make-oscil (* freq mc-ratio) md0p))
- (md1 (make-oscil (* freq mc-ratio) md1p))
- (am0 (make-oscil freq 0))
- (am1 (make-oscil freq (* .5 pi)))
- (fm-index (hz->radians (* index mc-ratio freq))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (+ (* (oscil am0) (oscil cr0 (* fm-index (oscil md0))))
- (* (oscil am1) (oscil cr1 (* fm-index (oscil md1)))))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (cr0 (make-oscil 0 cr0p))
+ (cr1 (make-oscil 0 cr1p))
+ (md0 (make-oscil (* freq mc-ratio) md0p))
+ (md1 (make-oscil (* freq mc-ratio) md1p))
+ (am0 (make-oscil freq 0))
+ (am1 (make-oscil freq (* .5 pi)))
+ (fm-index (hz->radians (* index mc-ratio freq))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (+ (* (oscil am0) (oscil cr0 (* fm-index (oscil md0))))
+ (* (oscil am1) (oscil cr1 (* fm-index (oscil md1))))))))))
(define (fmdoc-fm-5 beg dur freq amp mc-ratios indexes carrier-phase mod-phases)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (cr (make-oscil freq carrier-phase))
- (n (length mc-ratios))
- (modulators (make-vector n))
- (fm-indices (make-vct n)))
- (do ((i 0 (+ i 1)))
- ((= i n))
- (set! (modulators i) (make-oscil (* freq (list-ref mc-ratios i)) (list-ref mod-phases i)))
- (set! (fm-indices i) (hz->radians (* freq (list-ref indexes i) (list-ref mc-ratios i)))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! sum (+ sum (* (fm-indices k) (oscil (modulators k))))))
- (outa i (* amp (oscil cr sum))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (cr (make-oscil freq carrier-phase))
+ (n (length mc-ratios)))
+ (define (interleave a b)
+ (let ((lst ()))
+ (for-each (lambda (x y) (set! lst (cons (hz->radians (* freq x y)) (cons x lst)))) a b)
+ (reverse lst)))
+ (if (and (apply and (map integer? mc-ratios))
+ (apply and (map zero? mod-phases))) ; use polyoid if any not 0.0
+ (let ((fm (make-polywave freq (interleave mc-ratios indexes) mus-chebyshev-second-kind)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil cr (polywave fm))))))
+ (let ((modulators (make-float-vector n))
+ (fm-indices (make-float-vector n)))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (set! (modulators i) (hz->radians (* freq (mc-ratios i) (mod-phases i))))
+ (set! (fm-indices i) (hz->radians (* freq (indexes i) (mc-ratios i)))))
+ (let ((ob (make-oscil-bank modulators (make-float-vector n 0.0) fm-indices #t)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil cr (oscil-bank ob))))))))))
+
(define (fmdoc-violin beg dur frequency amplitude fm-index)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (frq-scl (hz->radians frequency))
- (maxdev (* frq-scl fm-index))
- (index1 (* maxdev (/ 5.0 (log frequency))))
- (index2 (* maxdev 3.0 (/ (- 8.5 (log frequency)) (+ 3.0 (/ frequency 1000)))))
- (index3 (* maxdev (/ 4.0 (sqrt frequency))))
- (carrier (make-oscil frequency))
- (fmosc1 (make-oscil frequency))
- (fmosc2 (make-oscil (* 3 frequency)))
- (fmosc3 (make-oscil (* 4 frequency)))
- (ampf (make-env '(0 0 25 1 75 1 100 0) :scaler amplitude :duration dur))
- (indf1 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index1 :duration dur))
- (indf2 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index2 :duration dur))
- (indf3 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index3 :duration dur))
- (pervib (make-triangle-wave 5 :amplitude (* .0025 frq-scl)))
- (ranvib (make-rand-interp 16 :amplitude (* .005 frq-scl))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
- (outa i (* (env ampf)
- (oscil carrier
- (+ vib
- (* (env indf1) (oscil fmosc1 vib))
- (* (env indf2) (oscil fmosc2 (* 3.0 vib)))
- (* (env indf3) (oscil fmosc3 (* 4.0 vib))))))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (frq-scl (hz->radians frequency)))
+ (let ((maxdev (* frq-scl fm-index)))
+ (let ((index1 (* maxdev (/ 5.0 (log frequency))))
+ (index2 (* maxdev 3.0 (/ (- 8.5 (log frequency)) (+ 3.0 (/ frequency 1000)))))
+ (index3 (* maxdev (/ 4.0 (sqrt frequency))))
+ (carrier (make-oscil frequency))
+ (fmosc1 (make-oscil frequency))
+ (fmosc2 (make-oscil (* 3 frequency)))
+ (fmosc3 (make-oscil (* 4 frequency)))
+ (ampf (make-env '(0 0 25 1 75 1 100 0) :scaler amplitude :duration dur)))
+ (let ((indf1 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index1 :duration dur))
+ (indf2 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index2 :duration dur))
+ (indf3 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index3 :duration dur))
+ (pervib (make-triangle-wave 5 :amplitude (* .0025 frq-scl)))
+ (ranvib (make-rand-interp 16 :amplitude (* .005 frq-scl))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
+ (outa i (* (env ampf)
+ (oscil carrier
+ (+ vib
+ (+ (* (env indf1) (oscil fmosc1 vib))
+ (* (env indf2) (oscil fmosc2 (* 3.0 vib)))
+ (* (env indf3) (oscil fmosc3 (* 4.0 vib)))))))))))))))
(define (fmdoc-cascade beg dur freq amp modrat modind casrat casind caspha)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (cr (make-oscil freq))
- (md (make-oscil (* freq modrat)))
- (ca (make-oscil (* freq casrat) caspha))
- (fm-ind0 (hz->radians (* modind modrat freq)))
- (fm-ind1 (hz->radians (* casind (/ casrat modrat) freq))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp
- (oscil cr (* fm-ind0
- (oscil md (* fm-ind1
- (oscil ca)))))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (cr (make-oscil freq))
+ (md (make-oscil (* freq modrat)))
+ (ca (make-oscil (* freq casrat) caspha))
+ (fm-ind0 (hz->radians (* modind modrat freq)))
+ (fm-ind1 (hz->radians (* casind (/ casrat modrat) freq))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp
+ (oscil cr (* fm-ind0
+ (oscil md (* fm-ind1
+ (oscil ca))))))))))
(define (fmdoc-feedbk beg dur freq amp index)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (y 0.0)
- (x-incr (hz->radians freq)))
- (run
- (do ((i start (+ i 1))
- (x 0.0 (+ x x-incr)))
- ((= i end))
- (set! y (+ x (* index (sin y))))
- (outa i (* amp (sin y)))))))
-
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (y 0.0)
+ (x-incr (hz->radians freq)))
+ (do ((i start (+ i 1))
+ (x 0.0 (+ x x-incr)))
+ ((= i end))
+ (set! y (+ x (* index (sin y))))
+ (outa i (* amp (sin y))))))
+
+
+(define* (fmdoc-vox beg dur freq amp (indices '(.005 .01 .02)) (formant-amps '(.86 .13 .01)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (car (make-oscil 0))
+ (per-vib (make-triangle-wave 6 :amplitude (* freq .03)))
+ (ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02))))
+
+ (let ((a0 (make-env '(0 0 25 1 75 1 100 0) :scaler (* amp (formant-amps 0)) :duration dur))
+ (a1 (make-env '(0 0 25 1 75 1 100 0) :scaler (* amp (formant-amps 1)) :duration dur))
+ (a2 (make-env '(0 0 25 1 75 1 100 0) :scaler (* amp (formant-amps 2)) :duration dur))
+ (o0 (make-oscil 0.0))
+ (o1 (make-oscil 0.0))
+ (o2 (make-oscil 0.0))
+ (e0 (make-oscil 0.0))
+ (e1 (make-oscil 0.0))
+ (e2 (make-oscil 0.0))
+ (ind0 (indices 0))
+ (ind1 (indices 1))
+ (ind2 (indices 2))
+ (f0 (make-env '(0 520 100 490) :duration dur))
+ (f1 (make-env '(0 1190 100 1350) :duration dur))
+ (f2 (make-env '(0 2390 100 1690) :duration dur)))
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let* ((frq (+ freq (triangle-wave per-vib) (rand-interp ran-vib)))
+ (frq1 (hz->radians frq))
+ (carg (oscil car frq1))
+ (frm0 (/ (env f0) frq))
+ (frm1 (/ (env f1) frq))
+ (frm2 (/ (env f2) frq)))
+
+ (outa i (+
+ (* (env a0)
+ (+ (* (even-weight frm0) (oscil e0 (+ (* ind0 carg) (even-multiple frm0 frq1))))
+ (* (odd-weight frm0) (oscil o0 (+ (* ind0 carg) (odd-multiple frm0 frq1))))))
+ (* (env a1)
+ (+ (* (even-weight frm1) (oscil e1 (+ (* ind1 carg) (even-multiple frm1 frq1))))
+ (* (odd-weight frm1) (oscil o1 (+ (* ind1 carg) (odd-multiple frm1 frq1))))))
+ (* (env a2)
+ (+ (* (even-weight frm2) (oscil e2 (+ (* ind2 carg) (even-multiple frm2 frq1))))
+ (* (odd-weight frm2) (oscil o2 (+ (* ind2 carg) (odd-multiple frm2 frq1)))))))))))))
+#|
(define* (fmdoc-vox beg dur freq amp (indexes '(.005 .01 .02)) (formant-amps '(.86 .13 .01)))
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (car-os (make-oscil 0))
- (evens (make-vector 3))
- (odds (make-vector 3))
- (amps (apply vct formant-amps))
- (ampf (make-env '(0 0 25 1 75 1 100 0) :scaler amp :duration dur))
- (frmfs (make-vector 3))
- (indices (apply vct indexes))
- (per-vib (make-triangle-wave 6 :amplitude (* freq .03)))
- (ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (car-os (make-oscil 0))
+ (evens (make-vector 3))
+ (odds (make-vector 3))
+ (ampfs (make-vector 3))
+ (frmfs (make-vector 3))
+ (indices (apply float-vector indexes))
+ (per-vib (make-triangle-wave 6 :amplitude (* freq .03)))
+ (ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02)))
+ (frq1 0.0) (frq 0.0) (carg 0.0) (frm0 0.0) (frm-int 0)
+ (frac 0.0) (fracf 0.0))
(do ((i 0 (+ i 1)))
((= i 3))
(set! (evens i) (make-oscil 0))
- (set! (odds i) (make-oscil 0)))
-
+ (set! (odds i) (make-oscil 0))
+ (set! (ampfs i) (make-env '(0 0 25 1 75 1 100 0) :scaler (* amp (formant-amps i)) :duration dur)))
+
(set! (frmfs 0) (make-env '(0 520 100 490) :duration dur))
(set! (frmfs 1) (make-env '(0 1190 100 1350) :duration dur))
(set! (frmfs 2) (make-env '(0 2390 100 1690) :duration dur))
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (set! frq (+ freq (triangle-wave per-vib) (rand-interp ran-vib)))
+ (set! frq1 (hz->radians frq))
+ (set! carg (oscil car-os frq1))
+ (do ((k 0 (+ k 1)))
+ ((= k 3))
+ (set! frm0 (/ (env (vector-ref frmfs k)) frq))
+ (set! frm-int (floor frm0))
+ (set! frac (- frm0 frm-int))
+ (set! fracf (+ (* (float-vector-ref indices k) carg) (* frm-int frq1)))
+ (if (even? frm-int)
+ (outa i (* (env (vector-ref ampfs k))
+ (+ (* (- 1.0 frac) (oscil (vector-ref evens k) fracf))
+ (* frac (oscil (vector-ref odds k) (+ fracf frq1))))))
+ (outa i (* (env (vector-ref ampfs k))
+ (+ (* frac (oscil (vector-ref evens k) (+ fracf frq1)))
+ (* (- 1.0 frac) (oscil (vector-ref odds k) fracf))))))))))
+|#
+
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let* ((frq (+ freq (triangle-wave per-vib) (rand-interp ran-vib)))
- (car (oscil car-os (hz->radians frq)))
- (sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k 3))
- (let* ((frm (env (frmfs k)))
- (frm0 (/ frm frq))
- (frm-int (floor frm0))
- (even-amp 0.0) (odd-amp 0.0)
- (even-freq 0.0) (odd-freq 0.0))
- (if (even? frm-int)
- (begin
- (set! even-freq (hz->radians (* frm-int frq)))
- (set! odd-freq (hz->radians (* (+ frm-int 1) frq)))
- (set! odd-amp (- frm0 frm-int))
- (set! even-amp (- 1.0 odd-amp)))
- (begin
- (set! odd-freq (hz->radians (* frm-int frq)))
- (set! even-freq (hz->radians (* (+ frm-int 1) frq)))
- (set! even-amp (- frm0 frm-int))
- (set! odd-amp (- 1.0 even-amp))))
- (set! sum (+ sum (+ (* (amps k)
- (+ (* even-amp
- (oscil (evens k)
- (+ even-freq (* (indices k) car))))
- (* odd-amp
- (oscil (odds k)
- (+ odd-freq (* (indices k) car)))))))))))
- (outa i (* (env ampf) sum)))))))
;;; --------------------------------------------------------------------------------
@@ -2103,61 +1587,56 @@
(define (sndclmdoc-simp start end freq amp)
(let ((os (make-oscil freq)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil os)))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil os))))))
(define (sndclmdoc-simp-1 beg dur freq amp)
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil os)))))))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil os))))))
(define (sndclmdoc-simp-2 beg dur freq amp)
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil os)))))))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil os))))))
(definstrument (sndclmdoc-simp-3 beg dur freq amp)
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil os)))))))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil os))))))
(define (sndclmdoc-telephone start telephone-number)
(let ((touch-tab-1 '(0 697 697 697 770 770 770 852 852 852 941 941 941))
(touch-tab-2 '(0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477)))
(do ((i 0 (+ i 1)))
((= i (length telephone-number)))
- (let* ((num (list-ref telephone-number i))
- (frq1 (list-ref touch-tab-1 num))
- (frq2 (list-ref touch-tab-2 num)))
+ (let* ((num (telephone-number i))
+ (frq1 (touch-tab-1 num))
+ (frq2 (touch-tab-2 num)))
(sndclmdoc-simp-3 (+ start (* i .4)) .3 frq1 .1)
(sndclmdoc-simp-3 (+ start (* i .4)) .3 frq2 .1)))))
(definstrument (sndclmdoc-simp-4 beg dur freq amp envelope)
- (let* ((os (make-oscil freq))
- (amp-env (make-env envelope :duration dur :scaler amp))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* (env amp-env) (oscil os)))))))
+ (let ((os (make-oscil freq))
+ (amp-env (make-env envelope :duration dur :scaler amp))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env amp-env) (oscil os))))))
(define (make-my-oscil frequency) ; we want our own oscil!
- (vct 0.0 (hz->radians frequency))) ; current phase and frequency-based phase increment
+ (float-vector 0.0 (hz->radians frequency))) ; current phase and frequency-based phase increment
(define (my-oscil gen fm) ; the corresponding generator
(let ((result (sin (gen 0)))) ; return sin(current-phase)
@@ -2169,179 +1648,168 @@
(define (sndclmdoc-simp-5 start end freq amp frq-env)
(let ((os (make-oscil freq))
(frqe (make-env frq-env :length (- end start) :scaler (hz->radians freq))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil os (env frqe))))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil os (env frqe)))))))
(definstrument (sndclmdoc-simple-fm beg dur freq amp mc-ratio index amp-env index-env)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (cr (make-oscil freq)) ; carrier
- (md (make-oscil (* freq mc-ratio))) ; modulator
- (fm-index (hz->radians (* index mc-ratio freq)))
- (ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
- (indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))
+ (let ((fm-index (hz->radians (* index mc-ratio freq))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (cr (make-oscil freq)) ; carrier
+ (md (make-oscil (* freq mc-ratio))) ; modulator
+ (ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
+ (indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))
(define (sndclmdoc-simple-add beg dur freq amp)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (arr (make-vector 20))) ; we'll create a tone with 20 equal amplitude harmonics
- (do ((i 0 (+ i 1))) ; use the 'f' button to check out the spectrum
- ((= i 20))
- (set! (arr i) (make-oscil (* (+ i 1) freq))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k 20))
- (set! sum (+ sum (oscil (arr k)))))
- (out-any i (* amp .05 sum) 0))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (harms (do ((i 1 (+ i 1)) (lst ()))
+ ((> i 20)
+ (reverse lst))
+ (set! lst (cons (* amp .05) (cons i lst))))))
+ ;; we'll create a tone with 20 equal amplitude harmonics
+ (let ((gen (make-polywave freq harms)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (polywave gen))))))
(definstrument (sndclmdoc-mapenv beg dur frq amp en)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (osc (make-oscil frq))
- (zv (make-env en 1.0 dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let ((zval (env zv)))
- (outa i
- (* amp
- (sin (* 0.5 pi zval zval zval))
- (oscil osc))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (osc (make-oscil frq))
+ (zv (make-env en 1.0 dur))
+ (pi2 (* 0.5 pi)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let ((zval (env zv)))
+ (outa i
+ (* amp
+ (sin (* pi2 zval (* zval zval)))
+ (oscil osc)))))))
(definstrument (sndclmdoc-simple-table dur)
(let ((tab (make-table-lookup :wave (partials->wave '(1 .5 2 .5)))))
- (run
- (do ((i 0 (+ i 1))) ((= i dur))
- (outa i (* .3 (table-lookup tab)))))))
+ (do ((i 0 (+ i 1))) ((= i dur))
+ (outa i (* .3 (table-lookup tab))))))
(define (sndclmdoc-looper start dur sound freq amp)
- (let* ((beg (seconds->samples start))
- (end (+ beg (seconds->samples dur)))
- (loop-data (mus-sound-loop-info sound)))
+ (let ((beg (seconds->samples start))
+ (end (seconds->samples (+ start dur)))
+ (loop-data (mus-sound-loop-info sound)))
(if (or (null? loop-data)
(<= (cadr loop-data) (car loop-data)))
- (throw 'no-loop-positions)
+ (error 'no-loop-positions)
(let* ((loop-start (car loop-data))
(loop-end (cadr loop-data))
(loop-length (+ 1 (- loop-end loop-start)))
- (sound-section (file->array sound 0 loop-start loop-length (make-vct loop-length)))
+ (sound-section (float-vector-scale! (file->array sound 0 loop-start loop-length (make-float-vector loop-length)) amp))
(original-loop-duration (/ loop-length (srate sound)))
(tbl (make-table-lookup :frequency (/ freq original-loop-duration) :wave sound-section)))
- ;; "freq" here is how fast we read (transpose) the sound -- 1.0 returns the original
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (table-lookup tbl)))))))))
+ ;; "freq" here is how fast we read (transpose) the sound -- 1.0 returns the original
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (table-lookup tbl)))))))
(definstrument (sndclmdoc-fm-table file start dur amp read-speed modulator-freq index-in-samples)
- (let* ((beg (seconds->samples start))
- (end (+ beg (seconds->samples dur)))
- (table-length (frames file))
- (tab (make-table-lookup :frequency (/ read-speed (mus-sound-duration file))
- :wave (file->array file 0 0 table-length (make-vct table-length))))
- (osc (make-oscil modulator-freq))
- (index (/ (* (hz->radians modulator-freq) 2 pi index-in-samples) table-length)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (table-lookup tab (* index (oscil osc)))))))))
+ (let ((table-length (framples file)))
+ (let ((beg (seconds->samples start))
+ (end (seconds->samples (+ start dur)))
+ (tab (make-table-lookup :frequency (/ read-speed (mus-sound-duration file))
+ :wave (float-vector-scale!
+ (file->array file 0 0 table-length (make-float-vector table-length))
+ amp)))
+ (osc (make-oscil modulator-freq))
+ (index (/ (* (hz->radians modulator-freq) 2 pi index-in-samples) table-length)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (table-lookup tab (* index (oscil osc))))))))
(definstrument (sndclmdoc-bigbird start duration frequency freqskew amplitude freq-env amp-env partials)
- (let* ((beg (seconds->samples start))
- (end (+ beg (seconds->samples duration)))
- (gls-env (make-env freq-env (hz->radians freqskew) duration))
- (polyos (make-polyshape frequency :coeffs (partials->polynomial partials)))
- (fil (make-one-pole .1 .9))
- (amp-env (make-env amp-env amplitude duration)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i
- (one-pole fil ; for distance effects
- (* (env amp-env)
- (polyshape polyos 1.0 (env gls-env)))))))))
+ (let ((beg (seconds->samples start))
+ (end (seconds->samples (+ start duration)))
+ (gls-env (make-env freq-env (hz->radians freqskew) duration))
+ (polyos (make-polywave frequency :partials partials))
+ (fil (make-one-pole .1 .9))
+ (amp-env (make-env amp-env amplitude duration)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i
+ (one-pole fil ; for distance effects
+ (* (env amp-env)
+ (polywave polyos (env gls-env))))))))
(definstrument (sndclmdoc-pqw start dur spacing carrier partials)
- (let* ((spacing-cos (make-oscil spacing (/ pi 2.0)))
- (spacing-sin (make-oscil spacing))
- (carrier-cos (make-oscil carrier (/ pi 2.0)))
- (carrier-sin (make-oscil carrier))
- (sin-coeffs (partials->polynomial
- partials mus-chebyshev-second-kind))
- (cos-coeffs (partials->polynomial
- partials mus-chebyshev-first-kind))
- (beg (seconds->samples start))
- (end (+ beg (seconds->samples dur))))
- (run
- (do ((i beg (+ i 1))) ((= i end))
- (let ((ax (oscil spacing-cos)))
- (outa i (- (* (oscil carrier-sin)
- (oscil spacing-sin)
- (polynomial sin-coeffs ax))
- (* (oscil carrier-cos)
- (polynomial cos-coeffs ax)))))))))
+ (let ((spacing-cos (make-oscil spacing (/ pi 2.0)))
+ (spacing-sin (make-oscil spacing))
+ (carrier-cos (make-oscil carrier (/ pi 2.0)))
+ (carrier-sin (make-oscil carrier))
+ (sin-coeffs (partials->polynomial
+ partials mus-chebyshev-second-kind))
+ (cos-coeffs (partials->polynomial
+ partials mus-chebyshev-first-kind))
+ (beg (seconds->samples start))
+ (end (seconds->samples (+ start dur))))
+ (do ((i beg (+ i 1))) ((= i end))
+ (let ((ax (oscil spacing-cos)))
+ (outa i (- (* (oscil carrier-sin)
+ (oscil spacing-sin)
+ (polynomial sin-coeffs ax))
+ (* (oscil carrier-cos)
+ (polynomial cos-coeffs ax))))))))
(definstrument (sndclmdoc-bl-saw start dur frequency order)
- (let* ((norm (if (= order 1) 1.0 ; these peak amps were determined empirically
- (if (= order 2) 1.3 ; actual limit is supposed to be pi/2 (G&R 1.441)
- (if (< order 9) 1.7 ; but Gibbs phenomenon pushes it to 1.851
- 1.9)))) ; if order>25, numerical troubles -- use table-lookup
- (freqs '()))
+ (let ((norm (if (= order 1) 1.0 ; these peak amps were determined empirically
+ (if (= order 2) 1.3 ; actual limit is supposed to be pi/2 (G&R 1.441)
+ (if (< order 9) 1.7 ; but Gibbs phenomenon pushes it to 1.851
+ 1.9)))) ; if order>25, numerical troubles -- use table-lookup
+ (freqs ()))
(do ((i 1 (+ i 1)))
((> i order))
(set! freqs (cons (/ 1.0 (* norm i)) (cons i freqs))))
- (let* ((ccos (make-oscil frequency (/ pi 2.0)))
- (csin (make-oscil frequency))
- (coeffs (partials->polynomial (reverse freqs) mus-chebyshev-second-kind))
- (beg (seconds->samples start))
- (end (+ beg (seconds->samples dur))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* (oscil csin)
- (polynomial coeffs (oscil ccos)))))))))
+ (let ((ccos (make-oscil frequency (/ pi 2.0)))
+ (csin (make-oscil frequency))
+ (coeffs (partials->polynomial (reverse freqs) mus-chebyshev-second-kind))
+ (beg (seconds->samples start))
+ (end (seconds->samples (+ start dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* (oscil csin)
+ (polynomial coeffs (oscil ccos))))))))
(define (sndclmdoc-tritri start dur freq amp index mcr)
- (let* ((beg (seconds->samples start))
- (end (+ beg (seconds->samples dur)))
- (carrier (make-triangle-wave freq))
- (modulator (make-triangle-wave (* mcr freq))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (triangle-wave carrier
- (* index (triangle-wave modulator)))))))))
-
-(define* (sndclmdoc-make-sinc-train (frequency 440.0) (width #f))
- (let ((range (or width (* pi (- (* 2 (floor (/ (mus-srate) (* 2.2 frequency)))) 1)))))
+ (let ((beg (seconds->samples start))
+ (end (seconds->samples (+ start dur)))
+ (carrier (make-triangle-wave freq amp))
+ (modulator (make-triangle-wave (* mcr freq) index)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (triangle-wave carrier (triangle-wave modulator))))))
+
+(define* (sndclmdoc-make-sinc-train (frequency 440.0) width)
+ (let ((range (or width (* pi (- (* 2 (floor (/ *clm-srate* (* 2.2 frequency)))) 1)))))
;; 2.2 leaves a bit of space before srate/2, (* 3 pi) is the minimum width, normally
(list (- (* range 0.5))
range
- (/ (* range frequency) (mus-srate)))))
-
+ (/ (* range frequency) *clm-srate*))))
+
(define* (sndclmdoc-sinc-train gen (fm 0.0))
- (let* ((ang (car gen))
- (range (cadr gen))
- (top (* 0.5 range))
- (frq (caddr gen))
- (val (if (= ang 0.0) 1.0 (/ (sin ang) ang)))
- (new-ang (+ ang frq fm)))
- (if (> new-ang top)
- (list-set! gen 0 (- new-ang range))
- (list-set! gen 0 new-ang))
- val))
+ (let ((ang (car gen))
+ (range (cadr gen))
+ (frq (caddr gen)))
+ (let ((top (* 0.5 range))
+ (val (if (= ang 0.0) 1.0 (/ (sin ang) ang)))
+ (new-ang (+ ang frq fm)))
+ (if (> new-ang top)
+ (set! (gen 0) (- new-ang range))
+ (set! (gen 0) new-ang))
+ val)))
(define (sndclmdoc-make-sum-of-odd-sines frequency n)
- (vct 0.0 (hz->radians frequency) (* 1.0 n)))
+ (float-vector 0.0 (hz->radians frequency) (* 1.0 n)))
(define (sndclmdoc-sum-of-odd-sines gen fm)
(let* ((angle (gen 0))
@@ -2357,75 +1825,87 @@
result))
(definstrument (sndclmdoc-shift-pitch beg dur file freq (order 40))
- (let* ((st (seconds->samples beg))
- (nd (+ st (seconds->samples dur)))
- (gen (make-ssb-am freq order))
- (rd (make-readin file)))
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (outa i (ssb-am gen (readin rd)))))))
+ (let ((st (seconds->samples beg))
+ (nd (seconds->samples (+ beg dur)))
+ (gen (make-ssb-am freq order))
+ (rd (make-readin file)))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (ssb-am gen (readin rd))))))
(definstrument (sndclmdoc-repitch beg dur sound old-freq new-freq
- (amp 1.0) (pairs 10) (order 40) (bw 50.0))
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (ssbs (make-vector pairs))
- (bands (make-vector pairs))
- (factor (/ (- new-freq old-freq) old-freq))
- (rd (make-readin sound)))
- (do ((i 1 (+ i 1)))
- ((> i pairs))
- (let* ((aff (* i old-freq))
- (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
- (set! (bands (- i 1)) (make-bandpass (hz->radians (- aff bwf))
- (hz->radians (+ aff bwf))
- order))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let ((sum 0.0)
- (y (readin rd)))
- (do ((band 0 (+ 1 band)))
- ((= band pairs))
- (set! sum (+ sum (ssb-am (ssbs band)
- (bandpass (bands band) y)))))
- (outa i (* amp sum)))))))
+ (amp 1.0) (pairs 10) (order 40) (bw 50.0))
+ (let ((start (seconds->samples beg))
+ (len (seconds->samples dur))
+ (end (seconds->samples (+ beg dur)))
+ (ssbs (make-vector pairs))
+ (bands (make-vector pairs))
+ (factor (/ (- new-freq old-freq) old-freq))
+ (rd (make-readin sound)))
+ (let ((in-data (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! in-data i (readin rd)))
+ (float-vector-scale! in-data amp)
+ (do ((i 1 (+ i 1)))
+ ((> i pairs))
+ (let ((aff (* i old-freq))
+ (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
+ (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
+ (set! (bands (- i 1)) (make-bandpass (hz->radians (- aff bwf))
+ (hz->radians (+ aff bwf))
+ order))))
+ (do ((band 0 (+ 1 band)))
+ ((= band pairs))
+ (let ((ssb (ssbs band))
+ (flt (bands band)))
+ (do ((i start (+ i 1))
+ (j 0 (+ j 1)))
+ ((= i end))
+ (outa i (ssb-am ssb (bandpass flt (float-vector-ref in-data j))))))))))
+
+#|
+(let* ((sound "oboe.snd") ; 1.8
+ (mx (maxamp sound))
+ (dur (mus-sound-duration sound)))
+ (with-sound (:scaled-to mx :srate 22050 :statistics #t)
+ (sndclmdoc-repitch 0 dur sound 554 1000)))
+|#
(definstrument (sndclmdoc-fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 ve ae)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (ampf (make-env :envelope (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
- (frq0 (hz->radians f0))
- (frq1 (hz->radians f1))
- (frq2 (hz->radians f2))
- (foflen (if (= (mus-srate) 22050) 100 200))
- (vibr (make-oscil :frequency 6))
- (vibenv (make-env :envelope (or ve (list 0 1 100 1)) :scaler vib :duration dur))
- (win-freq (/ (* 2 pi) foflen))
- (foftab (make-vct foflen))
- (wt0 (make-wave-train :wave foftab :frequency frq)))
- (do ((i 0 (+ i 1)))
- ((= i foflen))
- (set! (foftab i) ;; this is not the pulse shape used by B&R
- (* (+ (* a0 (sin (* i frq0)))
- (* a1 (sin (* i frq1)))
- (* a2 (sin (* i frq2))))
- .5 (- 1.0 (cos (* i win-freq))))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr)))))))))
+ (let ((foflen (if (= *clm-srate* 22050) 100 200)))
+ (let ((foftab (make-float-vector foflen)))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (ampf (make-env :envelope (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
+ (frq0 (hz->radians f0))
+ (frq1 (hz->radians f1))
+ (frq2 (hz->radians f2))
+ (vibr (make-oscil 6))
+ (vibenv (make-env :envelope (or ve (list 0 1 100 1)) :scaler vib :duration dur))
+ (win-freq (/ (* 2 pi) foflen))
+ (wt0 (make-wave-train :wave foftab :frequency frq)))
+ (do ((i 0 (+ i 1)))
+ ((= i foflen))
+ (set! (foftab i) ;; this is not the pulse shape used by B&R
+ (* (+ (* a0 (sin (* i frq0)))
+ (* a1 (sin (* i frq1)))
+ (* a2 (sin (* i frq2))))
+ .5 (- 1.0 (cos (* i win-freq))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr))))))))))
(definstrument (sndclmdoc-echo beg dur scaler secs file)
(let ((del (make-delay (seconds->samples secs)))
- (rd (make-sampler 0 file)))
- (run
- (do ((i beg (+ i 1)))
- ((= i (+ beg dur)))
- (let ((inval (rd)))
- (outa i (+ inval (delay del (* scaler (+ (tap del) inval))))))))))
+ (rd (make-sampler 0 file))
+ (stop (+ beg dur)))
+ (do ((i beg (+ i 1)))
+ ((= i stop))
+ (let ((inval (read-sample rd)))
+ (outa i (+ inval (delay del (* scaler (+ (tap del) inval)))))))))
+
+; (with-sound () (sndclmdoc-echo 0 60000 .5 1.0 "pistol.snd"))
(define* (sndclmdoc-make-moving-max (size 128))
(let ((gen (make-delay size)))
@@ -2438,308 +1918,291 @@
(if (>= absy (mus-scaler gen))
(set! (mus-scaler gen) absy)
(if (>= mx (mus-scaler gen))
- (set! (mus-scaler gen) (vct-peak (mus-data gen)))))
+ (set! (mus-scaler gen) (float-vector-peak (mus-data gen)))))
(mus-scaler gen)))
(definstrument (sndclmdoc-zc time dur freq amp length1 length2 feedback)
- (let* ((beg (seconds->samples time))
- (end (+ beg (seconds->samples dur)))
- (s (make-pulse-train :frequency freq)) ; some raspy input so we can hear the effect easily
- (d0 (make-comb :size length1 :max-size (max length1 length2) :scaler feedback))
- (aenv (make-env '(0 0 .1 1 .9 1 1 0) :scaler amp :duration dur))
- (zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :base 12.0 :duration dur)))
- (run
- (do ((i beg (+ i 1))) ((= i end))
- (outa i (* (env aenv) (comb d0 (pulse-train s) (env zenv))))))))
+ (let ((beg (seconds->samples time))
+ (end (seconds->samples (+ time dur)))
+ (s (make-pulse-train freq)) ; some raspy input so we can hear the effect easily
+ (d0 (make-comb :size length1 :max-size (max length1 length2) :scaler feedback))
+ (aenv (make-env '(0 0 .1 1 .9 1 1 0) :scaler amp :duration dur))
+ (zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :base 12.0 :duration dur)))
+ (do ((i beg (+ i 1))) ((= i end))
+ (outa i (* (env aenv) (comb d0 (pulse-train s) (env zenv)))))))
(define (sndclmdoc-fir+comb beg dur freq amp size)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (dly (make-comb :scaler .9 :size size))
- (flt (make-fir-filter :order size :xcoeffs (mus-data dly))) ; comb delay line as FIR coeffs
- (r (make-rand freq))) ; feed comb with white noise
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (fir-filter flt (comb dly (rand r)))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (dly (make-comb :scaler .9 :size size)))
+ (let ((flt (make-fir-filter :order size :xcoeffs (mus-data dly))) ; comb delay line as FIR coeffs
+ (r (make-rand freq))) ; feed comb with white noise
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (fir-filter flt (comb dly (rand r)))))))))
(definstrument (sndclmdoc-simple-src start-time duration amp srt srt-env filename)
- (let* ((senv (make-env :envelope srt-env :duration duration))
- (beg (seconds->samples start-time))
- (end (+ beg (seconds->samples duration)))
- (src-gen (make-src :input (make-readin filename) :srate srt)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (src src-gen (env senv))))))))
+ (let ((senv (make-env :envelope srt-env :duration duration))
+ (beg (seconds->samples start-time))
+ (end (seconds->samples (+ start-time duration)))
+ (src-gen (make-src :input (make-readin filename) :srate srt)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (src src-gen (env senv)))))))
(definstrument (sndclmdoc-srcer start-time duration amp srt fmamp fmfreq filename)
- (let* ((os (make-oscil :frequency fmfreq))
- (beg (seconds->samples start-time))
- (end (+ beg (seconds->samples duration)))
- (src-gen (make-src :input (make-readin filename) :srate srt)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (src src-gen (* fmamp (oscil os)))))))))
-
-(definstrument (sndclmdoc-convins beg dur filter file (size 128))
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (ff (make-convolve :input (make-readin file) :fft-size size :filter filter)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (convolve ff))))))
+ (let ((os (make-oscil fmfreq))
+ (beg (seconds->samples start-time))
+ (end (seconds->samples (+ start-time duration)))
+ (src-gen (make-src :input (make-readin filename) :srate srt)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (src src-gen (* fmamp (oscil os))))))))
+
+;;; (with-sound () (sndclmdoc-srcer 0 2 1.0 0.5 1.0 300 "oboe.snd"))
+
+(definstrument (sndclmdoc-convins beg dur filt file (size 128))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (ff (make-convolve :input (make-readin file) :fft-size size :filter filt)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (convolve ff)))))
(definstrument (sndclmdoc-granulate-sound file beg dur (orig-beg 0.0) (exp-amt 1.0))
(let* ((f-srate (srate file))
(f-start (round (* f-srate orig-beg)))
(f (make-readin file :start f-start))
(st (seconds->samples beg))
- (new-dur (or dur (- (mus-sound-duration file) orig-beg)))
- (exA (make-granulate :input f :expansion exp-amt))
- (nd (+ st (seconds->samples new-dur))))
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (outa i (granulate exA))))))
+ (new-dur (or dur (- (mus-sound-duration file) orig-beg))))
+ (let ((exA (make-granulate :input f :expansion exp-amt))
+ (nd (+ st (seconds->samples new-dur))))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (granulate exA))))))
(definstrument (sndclmdoc-grev beg dur exp-amt file file-beg)
- (let* ((exA (make-granulate :expansion exp-amt))
- (fil (make-file->sample file))
- (ctr file-beg))
- (run
- (do ((i beg (+ i 1)))
- ((= i (+ beg dur)))
- (outa i (granulate exA
- (lambda (dir)
- (let ((inval (file->sample fil ctr 0)))
- (if (> ctr 0) (set! ctr (- ctr 1)))
- inval))))))))
+ (let ((exA (make-granulate :expansion exp-amt
+ :input (make-readin file 0 file-beg -1)))
+ (stop (+ beg dur)))
+ (do ((i beg (+ i 1)))
+ ((= i stop))
+ (outa i (granulate exA)))))
(definstrument (sndclmdoc-simple-pvoc beg dur amp size file)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (sr (make-phase-vocoder (make-readin file) :fft-size size)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (phase-vocoder sr)))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (sr (make-phase-vocoder (make-readin file) :fft-size size)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (phase-vocoder sr))))))
(definstrument (sndclmdoc-asy beg dur freq amp index (r 1.0) (ratio 1.0))
- (let* ((st (seconds->samples beg))
- (nd (+ st (seconds->samples dur)))
- (asyf (make-asymmetric-fm :r r :ratio ratio :frequency freq)))
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (outa i (* amp (asymmetric-fm asyf index 0.0)))))))
+ (let ((st (seconds->samples beg))
+ (nd (seconds->samples (+ beg dur)))
+ (asyf (make-asymmetric-fm :r r :ratio ratio :frequency freq)))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (* amp (asymmetric-fm asyf index))))))
(define (sndclmdoc-simple-f2s beg dur amp file)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fil (make-file->sample file))
- (ctr 0))
- (run
- (do ((i start (+ i 1))) ((= i end))
- (out-any i (* amp (file->sample fil ctr 0)) 0)
- (set! ctr (+ 1 ctr))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (fil (make-file->sample file)))
+ (do ((i start (+ i 1))
+ (ctr 0 (+ ctr 1)))
+ ((= i end))
+ (outa i (* amp (file->sample fil ctr))))))
(definstrument (sndclmdoc-simple-ina beg dur amp file)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (fil (make-file->sample file)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i
- (* amp (in-any i 0 fil)) ; same as (ina i fil)
- )))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (fil (make-file->sample file)))
+ (do ((i start (+ i 1))
+ (ctr 0 (+ ctr 1)))
+ ((= i end))
+ (outa i (* amp (ina ctr fil))))))
(definstrument (sndclmdoc-env-sound file beg (amp 1.0) (amp-env '(0 1 100 1)))
- (let* ((st (seconds->samples beg))
- (dur (mus-sound-duration file))
- (rev-amount .01)
- (rdA (make-readin file))
- (ampf (make-env amp-env amp dur))
- (nd (+ st (seconds->samples dur))))
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (let ((outval (* (env ampf) (readin rdA))))
- (outa i outval)
- (if *reverb*
- (outa i (* outval rev-amount) *reverb*)))))))
+ (let ((st (seconds->samples beg))
+ (dur (mus-sound-framples file))
+ (rev-amount .01)
+ (rdA (make-readin file)))
+ (let ((ampf (make-env amp-env amp :length dur))
+ (nd (+ st dur)))
+ (if *reverb*
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (let ((outval (* (env ampf) (readin rdA))))
+ (outa i outval)
+ (outa i (* outval rev-amount) *reverb*)))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (* (env ampf) (readin rdA))))))))
(definstrument (sndclmdoc-space file onset duration (distance-env '(0 1 100 10)) (amplitude-env '(0 1 100 1))
- (degree-env '(0 45 50 0 100 90)) (reverb-amount .05))
- (let* ((beg (seconds->samples onset))
- (end (+ beg (seconds->samples duration)))
- (loc (make-locsig :degree 0 :distance 1 :reverb reverb-amount))
- (rdA (make-readin :file file))
- (dist-env (make-env distance-env :duration duration))
- (amp-env (make-env amplitude-env :duration duration))
- (deg-env (make-env degree-env :scaler (/ 1.0 90.0) :duration duration))
- (dist-scaler 0.0))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((rdval (* (readin rdA) (env amp-env)))
- (degval (env deg-env))
- (distval (env dist-env)))
- (set! dist-scaler (/ 1.0 distval))
- (set! (locsig-ref loc 0) (* (- 1.0 degval) dist-scaler))
- (if (> (channels *output*) 1)
- (set! (locsig-ref loc 1) (* degval dist-scaler)))
- (if *reverb*
- (set! (locsig-reverb-ref loc 0) (* reverb-amount (sqrt dist-scaler))))
- (locsig loc i rdval))))))
+ (degree-env '(0 45 50 0 100 90)) (reverb-amount .05))
+ (let ((beg (seconds->samples onset))
+ (end (seconds->samples (+ onset duration)))
+ (loc (make-locsig :degree 0 :distance 1 :reverb reverb-amount))
+ (rdA (make-readin :file file))
+ (dist-env (make-env distance-env :duration duration))
+ (amp-env (make-env amplitude-env :duration duration))
+ (deg-env (make-env degree-env :scaler (/ 1.0 90.0) :duration duration))
+ (dist-scaler 0.0)
+ (degval 0.0)
+ (stereo (> (channels *output*) 1)))
+ (if (and stereo *reverb*)
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (set! degval (env deg-env))
+ (set! dist-scaler (/ 1.0 (env dist-env)))
+ (locsig-set! loc 0 (* (- 1.0 degval) dist-scaler))
+ (locsig-set! loc 1 (* degval dist-scaler))
+ (locsig-reverb-set! loc 0 (* reverb-amount (sqrt dist-scaler)))
+ (locsig loc i (* (env amp-env) (readin rdA))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (set! degval (env deg-env))
+ (set! dist-scaler (/ 1.0 (env dist-env)))
+ (locsig-set! loc 0 (* (- 1.0 degval) dist-scaler))
+ (if stereo (locsig-set! loc 1 (* degval dist-scaler)))
+ (if *reverb* (locsig-reverb-set! loc 0 (* reverb-amount (sqrt dist-scaler))))
+ (locsig loc i (* (env amp-env) (readin rdA)))))))
(define (sndclmdoc-simple-dloc beg dur freq amp)
- "(simple-dloc-4 beg dur freq amp) test instrument for dlocsig"
- (let* ((os (make-oscil freq))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (loc (make-move-sound (list start end 4 0
- (make-delay 12)
- (make-env '(0 0 10 1) :duration dur)
- #f
- (make-vector 4 #f)
- (vector (make-env '(0 0 1 1 2 0 3 0 4 0) :duration dur)
- (make-env '(0 0 1 0 2 1 3 0 4 0) :duration dur)
- (make-env '(0 0 1 0 2 0 3 1 4 0) :duration dur)
- (make-env '(0 0 1 0 2 0 3 0 4 1) :duration dur))
- #f
- (vector 0 1 2 3)))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (move-sound loc i (* amp (oscil os)))))))
+ (let ((os (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (let ((loc (make-move-sound (list start end 4 0
+ (make-delay 12)
+ (make-env '(0 0 10 1) :duration dur)
+ #f
+ (make-vector 4 #f)
+ (vector (make-env '(0 0 1 1 2 0 3 0 4 0) :duration dur)
+ (make-env '(0 0 1 0 2 1 3 0 4 0) :duration dur)
+ (make-env '(0 0 1 0 2 0 3 1 4 0) :duration dur)
+ (make-env '(0 0 1 0 2 0 3 0 4 1) :duration dur))
+ #f
+ (vector 0 1 2 3)))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (move-sound loc i (* amp (oscil os)))))))
(definstrument (when? start-time duration start-freq end-freq grain-file)
- (let* ((beg (seconds->samples start-time))
- (len (seconds->samples duration))
- (end (+ beg len))
- (grain-dur (mus-sound-duration grain-file))
- (frqf (make-env '(0 0 1 1) :scaler (hz->radians (- end-freq start-freq)) :duration duration))
- (click-track (make-pulse-train start-freq))
- (grain-size (seconds->samples grain-dur))
- (grains (make-wave-train :size grain-size :frequency start-freq))
- (ampf (make-env '(0 1 1 0) :scaler .7 :offset .3 :duration duration :base 3.0))
- (grain (mus-data grains)))
- (file->array grain-file 0 0 grain-size grain)
- (let ((original-grain (vct-copy grain)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let* ((gliss (env frqf)))
- (outa i (* (env ampf) (wave-train grains gliss)))
- (let ((click (pulse-train click-track gliss)))
- (if (> click 0.0)
- (let* ((scaler (max 0.1 (* 1.0 (/ (- i beg) len))))
- (comb-len 32)
- (c1 (make-comb scaler comb-len))
- (c2 (make-comb scaler (floor (* comb-len .75))))
- (c3 (make-comb scaler (floor (* comb-len 1.25)))))
- (do ((k 0 (+ 1 k)))
- ((= k grain-size))
- (let ((x (original-grain k)))
- (set! (grain k) (+ (comb c1 x) (comb c2 x) (comb c3 x))))))))))))))
+ (let ((beg (seconds->samples start-time))
+ (len (seconds->samples duration))
+ (end (seconds->samples (+ start-time duration)))
+ (frqf (make-env '(0 0 1 1) :scaler (hz->radians (- end-freq start-freq)) :duration duration))
+ (click-track (make-pulse-train start-freq))
+ (grain-size (mus-sound-framples grain-file)))
+ (let ((grains (make-wave-train :size grain-size :frequency start-freq))
+ (ampf (make-env '(0 1 1 0) :scaler .7 :offset .3 :duration duration :base 3.0))
+ (grain #f))
+ (set! grain (mus-data grains))
+ (file->array grain-file 0 0 grain-size grain)
+ (let ((original-grain (copy grain)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((gliss (env frqf)))
+ (outa i (* (env ampf) (wave-train grains gliss)))
+ (if (> (pulse-train click-track gliss) 0.0)
+ (let ((scaler (max 0.1 (* 1.0 (/ (- i beg) len))))
+ (comb-len 32)
+ (cs (make-vector 3)))
+ (vector-set! cs 0 (make-comb scaler comb-len))
+ (vector-set! cs 1 (make-comb scaler (floor (* comb-len .75))))
+ (vector-set! cs 2 (make-comb scaler (floor (* comb-len 1.25))))
+ (set! cs (make-comb-bank cs))
+ (do ((k 0 (+ k 1)))
+ ((= k grain-size))
+ (float-vector-set! grain k (comb-bank cs (float-vector-ref original-grain k))))))))))))
(definstrument (move-formants start file amp radius move-env num-formants)
- (let* ((frms (make-vector num-formants))
- (beg (seconds->samples start))
- (dur (frames file))
- (end (+ beg dur))
- (rd (make-readin file))
- (menv (make-env move-env :length dur)))
- (let ((start-frq (env menv)))
- (do ((i 0 (+ i 1)))
- ((= i num-formants))
- (set! (frms i) (make-formant (* (+ i 1) start-frq) radius))))
- (run
- (do ((k beg (+ 1 k)))
- ((= k end))
- (let ((sum 0.0)
- (x (readin rd))
- (frq (env menv)))
- (do ((i 0 (+ i 1)))
- ((= i num-formants))
- (set! sum (+ sum (formant (frms i) x)))
- (let ((curfrq (* (+ i 1) frq)))
- (if (< (* 2 curfrq) (mus-srate))
- (set! (mus-frequency (frms i)) curfrq))))
- (outa k (* amp sum)))))))
+ (let ((frms (make-vector num-formants))
+ (beg (seconds->samples start))
+ (dur (framples file)))
+ (let ((end (+ beg dur))
+ (rd (make-readin file))
+ (menv (make-env move-env :length dur))
+ (amps (make-float-vector num-formants amp)))
+ (let ((start-frq (env menv)))
+ (do ((i 0 (+ i 1)))
+ ((= i num-formants))
+ (set! (frms i) (make-formant (* (+ i 1) start-frq) radius))))
+ (let ((frms1 (make-formant-bank frms amps)))
+ (do ((k beg (+ k 1)))
+ ((= k end))
+ (let ((frq (env menv)))
+ (outa k (formant-bank frms1 (readin rd)))
+ (do ((i 0 (+ i 1))
+ (gfrq frq (+ gfrq frq)))
+ ((= i num-formants))
+ (mus-set-formant-frequency (vector-ref frms i) gfrq))))))))
(define (test-filter flt)
- (let* ((osc (make-oscil 0.0))
- (samps (seconds->samples 0.5))
- (ramp (make-env '(0 0 1 1) :scaler (hz->radians samps) :length samps)))
- (with-sound ()
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (outa i (flt (oscil osc (env ramp))))))))
+ (let ((osc (make-oscil 0.0))
+ (samps (seconds->samples 0.5)))
+ (let ((rmp (make-env '(0 0 1 1) :scaler (hz->radians samps) :length samps)))
+ (with-sound ()
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (flt (oscil osc (env rmp)))))))))
(definstrument (flux start-time file frequency combs0 combs1 (scaler 0.99) (comb-len 32))
- (let* ((beg (seconds->samples start-time))
- (len (frames file))
- (end (+ beg len))
- (num-combs0 (length combs0))
- (num-combs1 (length combs1))
- (cmbs0 (make-vector num-combs0))
- (cmbs1 (make-vector num-combs1))
- (osc (make-oscil frequency))
- (rd (make-readin file)))
- (do ((k 0 (+ 1 k)))
- ((= k num-combs0))
- (set! (cmbs0 k)
- (make-comb scaler
- (floor (* comb-len (list-ref combs0 k))))))
- (do ((k 0 (+ 1 k)))
- ((= k num-combs1))
- (set! (cmbs1 k)
- (make-comb scaler
- (floor (* comb-len (list-ref combs1 k))))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (let* ((interp (oscil osc))
- (sum0 0.0)
- (sum1 0.0)
- (x (readin rd)))
- (do ((k 0 (+ 1 k)))
- ((= k num-combs0))
- (set! sum0 (+ sum0 (comb (cmbs0 k) x))))
- (do ((k 0 (+ 1 k)))
- ((= k num-combs1))
- (set! sum1 (+ sum1 (comb (cmbs1 k) x))))
- (outa i (+ (* interp sum0) (* (- 1.0 interp) sum1))))))))
-
+ (let ((beg (seconds->samples start-time))
+ (len (framples file)))
+ (let ((end (+ beg len))
+ (num-combs0 (length combs0))
+ (num-combs1 (length combs1)))
+ (let ((cmbs0 (make-vector num-combs0))
+ (cmbs1 (make-vector num-combs1))
+ (osc (make-oscil frequency))
+ (rd (make-readin file)))
+
+ (do ((k 0 (+ k 1)))
+ ((= k num-combs0))
+ (set! (cmbs0 k)
+ (make-comb scaler
+ (floor (* comb-len (combs0 k))))))
+ (do ((k 0 (+ k 1)))
+ ((= k num-combs1))
+ (set! (cmbs1 k)
+ (make-comb scaler
+ (floor (* comb-len (combs1 k))))))
+
+ (set! cmbs0 (make-comb-bank cmbs0))
+ (set! cmbs1 (make-comb-bank cmbs1))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((interp (oscil osc))
+ (x (readin rd)))
+ (outa i (+ (* interp (comb-bank cmbs0 x))
+ (* (- 1.0 interp) (comb-bank cmbs1 x))))))))))
;;; ---------------- sndscm-osc ----------------
-(defgenerator sndscm-osc freq phase) ;same as (defgenerator sndscm-osc (freq 0.0 :type float) (phase 0.0 :type float))
+(defgenerator sndscm-osc freq phase fm res)
(define (sndscm-osc gen fm)
- (declare (gen sndscm-osc) (fm float))
- (let ((result (sin (sndscm-osc-phase gen))))
- (set! (sndscm-osc-phase gen) (+ (sndscm-osc-phase gen) (sndscm-osc-freq gen) fm))
- result))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (set! res (sin phase))
+ (set! phase (+ phase freq fm))
+ res))
(definstrument (sndscm-osc-fm beg dur freq amp mc-ratio fm-index)
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (carrier (make-sndscm-osc (hz->radians freq)))
- (modulator (make-sndscm-osc (hz->radians (* mc-ratio freq))))
- (index (hz->radians (* freq mc-ratio fm-index))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (sndscm-osc carrier (* index (sndscm-osc modulator 0.0)))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (carrier (make-sndscm-osc (hz->radians freq)))
+ (modulator (make-sndscm-osc (hz->radians (* mc-ratio freq))))
+ (index (hz->radians (* freq mc-ratio fm-index))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (sndscm-osc carrier (* index (sndscm-osc modulator 0.0))))))))
@@ -2748,26 +2211,26 @@
(defgenerator
(sndscm-osc1 :make-wrapper (lambda (gen)
- (set! (sndscm-osc1-freq gen) (hz->radians (sndscm-osc1-freq gen)))
- gen))
- (freq 0.0) (phase 0.0 :type float))
+ (set! (gen 'freq) (hz->radians (gen 'freq)))
+ gen))
+ freq phase fm res)
(define* (sndscm-osc1 gen fm)
- (declare (gen sndscm-osc1) (fm float))
- (let ((result (sin (sndscm-osc1-phase gen))))
- (set! (sndscm-osc1-phase gen) (+ (sndscm-osc1-phase gen) (sndscm-osc1-freq gen) fm))
- result))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (set! res (sin phase))
+ (set! phase (+ phase freq fm))
+ res))
(definstrument (sndscm-osc1-fm beg dur freq amp mc-ratio (fm-index 1.0))
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (carrier (make-sndscm-osc1 freq))
- (modulator (make-sndscm-osc1 (* mc-ratio freq)))
- (index (hz->radians (* freq mc-ratio fm-index))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (sndscm-osc1 carrier (* index (sndscm-osc1 modulator 0.0)))))))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (carrier (make-sndscm-osc1 freq))
+ (modulator (make-sndscm-osc1 (* mc-ratio freq)))
+ (index (hz->radians (* freq mc-ratio fm-index))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (sndscm-osc1 carrier (* index (sndscm-osc1 modulator 0.0))))))))
@@ -2775,198 +2238,220 @@
;;; ---------------- sndscm-osc2 ----------------
(defgenerator (sndscm-osc2 :make-wrapper (lambda (gen)
- (set! (sndscm-osc2-freq gen) (hz->radians (sndscm-osc2-freq gen)))
- gen)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (radians->hz (sndscm-osc2-freq g)))
- (lambda (g val) (set! (sndscm-osc2-freq g) (hz->radians val))))
-
- (list 'mus-phase
- (lambda (g) (sndscm-osc2-phase g))
- (lambda (g val) (set! (sndscm-osc2-phase g) val)))
-
- (list 'mus-describe
- (lambda (g) (format #f "sndscm-osc2 freq: ~A, phase: ~A"
- (mus-frequency g)
- (mus-phase g))))))
- freq phase)
+ (set! (gen 'freq) (hz->radians (gen 'freq)))
+ gen)
+ :methods (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (radians->hz (g 'freq)))
+ (lambda (g val) (set! (g 'freq) (hz->radians val)))))
+
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (g 'phase))
+ (lambda (g val) (set! (g 'phase) val))))
+
+ (cons 'mus-describe
+ (lambda (g) (format #f "sndscm-osc2 freq: ~A, phase: ~A"
+ (mus-frequency g)
+ (mus-phase g))))))
+ freq phase fm res)
(define* (sndscm-osc2 gen fm)
- (declare (gen sndscm-osc2) (fm float))
- (let ((result (sin (sndscm-osc2-phase gen))))
- (set! (sndscm-osc2-phase gen) (+ (sndscm-osc2-phase gen) (sndscm-osc2-freq gen) fm))
- result))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (set! res (sin phase))
+ (set! phase (+ phase freq fm))
+ res))
(definstrument (sndscm-osc2-fm beg dur freq amp mc-ratio (fm-index 1.0))
- (let* ((start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (carrier (make-sndscm-osc2 freq))
- (modulator (make-sndscm-osc2 (* mc-ratio freq)))
- (index (hz->radians (* freq mc-ratio fm-index))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (carrier (make-sndscm-osc2 freq))
+ (modulator (make-sndscm-osc2 (* mc-ratio freq)))
+ (index (hz->radians (* freq mc-ratio fm-index))))
(if (fneq (mus-frequency carrier) freq)
(format #t ";sndscm-osc2 (sclm23.scm) mus-frequency ~A: ~A ~A" (mus-describe carrier) (mus-frequency carrier) freq))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (* amp (sndscm-osc2 carrier (* index (sndscm-osc2 modulator 0.0)))))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (sndscm-osc2 carrier (* index (sndscm-osc2 modulator 0.0))))))))
+
;;; -------- asymmetric FM (bes-i0 case)
(defgenerator (dsp-asyfm :make-wrapper (lambda (gen)
- (set! (dsp-asyfm-freq gen) (hz->radians (dsp-asyfm-freq gen)))
- gen))
- freq (phase 0.0) (ratio 1.0) (r 1.0) (index 1.0))
-
-(define (dsp-asyfm-J gen input)
- "(dsp-asyfm-J gen input) is the same as the CLM asymmetric-fm generator, set r != 1.0 to get the asymmetric spectra"
- (declare (gen dsp-asyfm) (input float))
- (let* ((phase (dsp-asyfm-phase gen))
- (r (dsp-asyfm-r gen))
- (r1 (/ 1.0 r))
- (index (dsp-asyfm-index gen))
- (modphase (* (dsp-asyfm-ratio gen) phase))
- (result (* (exp (* 0.5 index (- r r1) (cos modphase)))
- (sin (+ phase (* 0.5 index (+ r r1) (sin modphase)))))))
- (set! (dsp-asyfm-phase gen) (+ phase input (dsp-asyfm-freq gen)))
- result))
+ (set! (gen 'freq) (hz->radians (gen 'freq)))
+ (set! (gen 'r1) (* 0.5 (gen 'index) (+ (gen 'r) (/ (gen 'r)))))
+ (set! (gen 'r2) (* 0.5 (gen 'index) (- (gen 'r) (/ (gen 'r)))))
+ (set! (gen 'r3) (* 0.5 (log (bes-i0 (* 2.0 (gen 'r1))))))
+ gen))
+ freq phase (ratio 1.0) (r 1.0) (index 1.0) input r1 r2 r3)
+
+(define dsp-asyfm-J
+ (let ((documentation "(dsp-asyfm-J gen input) is the same as the CLM asymmetric-fm generator, set r != 1.0 to get the asymmetric spectra"))
+ (lambda (gen input)
+ (let-set! gen 'input input)
+ (with-let gen
+ (let* ((modphase (* ratio phase))
+ (result (* (exp (* r2 (cos modphase)))
+ (sin (+ phase (* r1 (sin modphase)))))))
+ (set! phase (+ phase input freq))
+ result)))))
+
+(define dsp-asyfm-I
+ (let ((documentation "(dsp-asyfm-I gen input) is the I0 case of the asymmetric-fm generator (dsp.scm)"))
+ (lambda (gen input)
+ (let-set! gen 'input input)
+ (with-let gen
+ (let* ((modphase (* ratio phase))
+ (result (* (exp (- (* r1 (cos modphase)) r3))
+ (sin (+ phase (* r2 (sin modphase)))))))
+ (set! phase (+ phase input freq))
+ result)))))
-(define (dsp-asyfm-I gen input)
- "(dsp-asyfm-I gen input) is the I0 case of the asymmetric-fm generator (dsp.scm)"
- (declare (gen dsp-asyfm) (input float))
- (let* ((phase (dsp-asyfm-phase gen))
- (r (dsp-asyfm-r gen))
- (r1 (/ 1.0 r))
- (index (dsp-asyfm-index gen))
- (modphase (* (dsp-asyfm-ratio gen) phase))
- (result (* (exp (- (* 0.5 index (+ r r1) (cos modphase))
- (* 0.5 (log (bes-i0 (* index (+ r r1)))))))
- (sin (+ phase (* 0.5 index (- r r1) (sin modphase)))))))
- (set! (dsp-asyfm-phase gen) (+ phase input (dsp-asyfm-freq gen)))
- result))
(defgenerator (sndclm-expcs
- :make-wrapper (lambda (g)
- (if (<= (sndclm-expcs-et g) 0.0) (set! (sndclm-expcs-et g) 0.00001))
- (set! (sndclm-expcs-frequency g) (hz->radians (sndclm-expcs-frequency g)))
- (set! (sndclm-expcs-sinht g) (* 0.5 (sinh (sndclm-expcs-et g))))
- (set! (sndclm-expcs-cosht g) (cosh (sndclm-expcs-et g)))
- g))
- frequency phase et sinht cosht)
+ :make-wrapper (lambda (g)
+ (if (<= (g 'et) 0.0) (set! (g 'et) 0.00001))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'sinht) (* 0.5 (sinh (g 'et))))
+ (set! (g 'cosht) (cosh (g 'et)))
+ g))
+ frequency phase et sinht cosht fm)
(define (sndclm-expcs gen fm)
- (declare (gen sndclm-expcs) (fm float))
- (let ((result (- (/ (sndclm-expcs-sinht gen)
- (- (sndclm-expcs-cosht gen) (cos (sndclm-expcs-phase gen))))
- 0.5)))
- (set! (sndclm-expcs-phase gen) (+ (sndclm-expcs-phase gen) (sndclm-expcs-frequency gen) fm))
- result))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((result (- (/ sinht (- cosht (cos phase))) 0.5)))
+ (set! phase (+ phase frequency fm))
+ result)))
+;;; --------------------------------------------------------------------------------
+
+(define (simp-named-let beg dur freq amp)
+ (let ((o (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (let loop ((i start))
+ (outa i (* amp (oscil o)))
+ (if (< i end)
+ (loop (+ i 1))))))
+
+(define (simp-tail-recursion beg dur freq amp)
+ (let ((o (make-oscil freq))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur))))
+ (define (simper i)
+ (outa i (* amp (oscil o)))
+ (if (< i end)
+ (simper (+ i 1))))
+ (simper start)))
;;; --------------------------------------------------------------------------------
(define (test-documentation-instruments)
-
+
(with-sound (:channels 2)
- (fmdoc-pm 0 10000 1000 .25 0.5 4)
- (fmdoc-fm 0 10000 1000 .25 0.5 4))
- (with-sound () (fmdoc-fm-1 0 1.0 100 .5 1.0 4.0))
- (with-sound () (fmdoc-fm-1 0 1.0 400 .5 0.25 4.0))
- (with-sound () (fmdoc-fm-1 0 1.0 400 .5 1.1414 4.0))
- (with-sound () (fmdoc-fm-1 0 0.5 400 .5 1.0 5.0 '(0 0 20 1 40 .6 90 .5 100 0)))
- (with-sound () (fmdoc-fm-1 0 1.0 900 .5 1/3 2.0 '(0 0 6 .5 10 1 90 1 100 0)))
- (with-sound () (fmdoc-fm-1 0 1.0 500 .5 .2 1.5 '(0 0 6 .5 10 1 90 1 100 0)))
- (with-sound () (fmdoc-fm-1 0 1.0 900 .5 2/3 2 '(0 0 25 1 75 1 100 0)))
- (with-sound () (fmdoc-fm-2 0 1.0 100 .25 1.0 4 0 (* .5 pi)))
- (with-sound () (fmdoc-fm-2 0 1.0 100 .25 1.0 4.0 (* .5 pi) (* .5 pi)))
- (with-sound () (fmdoc-fm-3 0 2.0 100 .25 1.0 4.0 0 0 '(0 0 50 1 100 0) .02))
- (with-sound () (fmdoc-fm-4 0 1.0 1000 .25 .1 1.0 0 (* .5 pi) (* .5 pi) 0))
- (with-sound () (fmdoc-fm-5 0 2.0 440 .3 '(1 3 4) '(1.0 0.5 0.1) 0.0 '(0.0 0.0 0.0)))
- (with-sound () (fmdoc-violin 0 1.0 440 .1 2.5))
- (with-sound ()
- (fmdoc-cascade 0 1.0 400 .25 1.0 1.0 1.0 1.0 0)
- (fmdoc-cascade 1.5 1.0 400 .25 1.0 1.0 1.0 1.0 (* .5 pi)))
- (with-sound () (fmdoc-feedbk 0 1 100.0 1.0 1.0))
+ (fmdoc-pm 0 10000 1000 .25 0.5 4)
+ (fmdoc-fm 0 10000 1000 .25 0.5 4))
(with-sound ()
- (fmdoc-vox 0 1.0 220.0 0.5)
- (fmdoc-vox 1.5 1.0 110 .5 '(0.02 0.01 0.02) '(.9 .09 .01)))
- (with-sound (:play #t) (sndclmdoc-simp 0 22050 330 .1))
- (with-sound (:srate 44100) (sndclmdoc-simp-1 0 1.0 440.0 0.1))
- (with-sound () (sndclmdoc-telephone 0.0 '(7 2 3 4 9 7 1)))
- (with-sound () (sndclmdoc-simp-4 0 2 440 .1 '(0 0 0.1 1.0 1.0 0.0)))
- (with-sound ()
- (let ((sqr (make-square-wave 100))) ; test a square-wave generator
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (square-wave sqr)))))
+ (fmdoc-fm-1 0 1.0 100 .5 1.0 4.0)
+ (fmdoc-fm-1 1 1.0 400 .5 0.25 4.0)
+ (fmdoc-fm-1 2 1.0 400 .5 1.1414 4.0)
+ (fmdoc-fm-1 3 0.5 400 .5 1.0 5.0 '(0 0 20 1 40 .6 90 .5 100 0))
+ (fmdoc-fm-1 4 1.0 900 .5 1/3 2.0 '(0 0 6 .5 10 1 90 1 100 0))
+ (fmdoc-fm-1 5 1.0 500 .5 .2 1.5 '(0 0 6 .5 10 1 90 1 100 0))
+ (fmdoc-fm-1 6 1.0 900 .5 2/3 2 '(0 0 25 1 75 1 100 0))
+ (fmdoc-fm-2 7 1.0 100 .25 1.0 4 0 (* .5 pi))
+ (fmdoc-fm-2 8 1.0 100 .25 1.0 4.0 (* .5 pi) (* .5 pi))
+ (fmdoc-fm-3 9 2.0 100 .25 1.0 4.0 0 0 '(0 0 50 1 100 0) .02)
+ (fmdoc-fm-4 10 1.0 1000 .25 .1 1.0 0 (* .5 pi) (* .5 pi) 0)
+ (fmdoc-fm-5 11 2.0 440 .3 '(1 3 4) '(1.0 0.5 0.1) 0.0 '(0.0 0.0 0.0))
+ (fmdoc-violin 12 1.0 440 .1 2.5))
+ (with-sound ()
+ (fmdoc-cascade 0 1.0 400 .25 1.0 1.0 1.0 1.0 0)
+ (fmdoc-cascade 1.5 1.0 400 .25 1.0 1.0 1.0 1.0 (* .5 pi))
+ (fmdoc-feedbk 2 1 100.0 1.0 1.0))
+ (with-sound () ; 1.2
+ (fmdoc-vox 0 1.0 220.0 0.5)
+ (fmdoc-vox 1.5 1.0 110 .5 '(0.02 0.01 0.02) '(.9 .09 .01)))
+ (with-sound (:srate 44100)
+ (sndclmdoc-simp 0 22050 330 .1)
+ (sndclmdoc-simp-1 0 1.0 440.0 0.1)
+ (sndclmdoc-telephone 1.0 '(7 2 3 4 9 7 1))
+ (sndclmdoc-simp-4 2 2 440 .1 '(0 0 0.1 1.0 1.0 0.0)))
(with-sound ()
- (run
- (lambda ()
- (let ((osc (make-my-oscil 440.0)))
- (do ((i 0 (+ i 1)))
- ((= i 22050))
- (outa i (my-oscil osc 0.0)))))))
- (with-sound () (sndclmdoc-simp-5 0 10000 440 .1 '(0 0 1 1))) ; sweep up an octave
- (with-sound () (sndclmdoc-simple-fm 0 1 440 .1 2 1.0))
- (with-sound () (sndclmdoc-simple-add 0 1 220 .3))
+ (let ((sqr (make-square-wave 100))) ; test a square-wave generator
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (square-wave sqr))))
+ (let ((osc (make-my-oscil 440.0)))
+ (do ((i 10000 (+ i 1)))
+ ((= i 22050))
+ (outa i (my-oscil osc 0.0)))))
(with-sound ()
- (sndclmdoc-mapenv 0 1 440 .4 '(0 0 50 1 75 0 86 .5 100 0)))
+ (sndclmdoc-simp-5 0 10000 440 .1 '(0 0 1 1)) ; sweep up an octave
+ (sndclmdoc-simple-fm 1 1 440 .1 2 1.0)
+ (sndclmdoc-simple-add 2 1 220 .3)
+ (sndclmdoc-mapenv 3 1 440 .4 '(0 0 50 1 75 0 86 .5 100 0)))
(if (file-exists? "/home/bil/sf1/forest.aiff")
(with-sound (:srate 44100) (sndclmdoc-looper 0 10 "/home/bil/sf1/forest.aiff" 1.0 0.5)))
(with-sound ()
- (sndclmdoc-bigbird 0 .05 1800 1800 .2
- '(.00 .00 .40 1.00 .60 1.00 1.00 .0) ; freq env
- '(.00 .00 .25 1.00 .60 .70 .75 1.00 1.00 .0) ; amp env
- '(1 .5 2 1 3 .5 4 .1 5 .01))) ; bird song spectrum
- (with-sound () (sndclmdoc-pqw 0 1 200.0 1000.0 '(2 .2 3 .3 6 .5)))
- (with-sound (:srate 44100) (sndclmdoc-tritri 0 1 1000.0 0.5 0.1 0.01)) ; sci-fi laser gun
- (with-sound (:srate 44100) (sndclmdoc-tritri 0 1 4000.0 0.7 0.1 0.01)) ; a sparrow?
- (with-sound () (sndclmdoc-shift-pitch 0 3 "oboe.snd" 1108.0))
- (let* ((sound "oboe.snd")
+ (sndclmdoc-bigbird 0 .05 1800 1800 .2
+ '(.00 .00 .40 1.00 .60 1.00 1.00 .0) ; freq env
+ '(.00 .00 .25 1.00 .60 .70 .75 1.00 1.00 .0) ; amp env
+ '(1 .5 2 1 3 .5 4 .1 5 .01))) ; bird song spectrum
+ (with-sound (:srate 44100)
+ (sndclmdoc-pqw 0 1 200.0 1000.0 '(2 .2 3 .3 6 .5))
+ (sndclmdoc-tritri 0 1 1000.0 0.5 0.1 0.01) ; sci-fi laser gun
+ (sndclmdoc-tritri 1 1 4000.0 0.7 0.1 0.01)) ; a sparrow?
+ (with-sound (:srate 22050) (sndclmdoc-shift-pitch 0 3 "oboe.snd" 1108.0)) ; 1.7
+ (let* ((sound "oboe.snd") ; 1.8
(mx (maxamp sound))
(dur (mus-sound-duration sound)))
- (with-sound (:scaled-to mx)
- (sndclmdoc-repitch 0 dur sound 554 1000)))
+ (with-sound (:scaled-to mx :srate 22050)
+ (sndclmdoc-repitch 0 dur sound 554 1000)))
(with-sound () (sndclmdoc-fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)) ; "Ahh"
(with-sound () ; one of JC's favorite demos
- (sndclmdoc-fofins 0 4 270 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
- (sndclmdoc-fofins 0 4 (* 6/5 540) .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
- (sndclmdoc-fofins 0 4 135 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
- '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0)))
+ (sndclmdoc-fofins 0 4 270 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
+ (sndclmdoc-fofins 0 4 (* 6/5 540) .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
+ (sndclmdoc-fofins 0 4 135 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
+ '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0)))
(with-sound () (sndclmdoc-echo 0 60000 .5 1.0 "pistol.snd"))
(with-sound ()
- (sndclmdoc-zc 0 3 100 .1 20 100 .5)
- (sndclmdoc-zc 3.5 3 100 .1 90 100 .95))
+ (sndclmdoc-zc 0 3 100 .1 20 100 .5)
+ (sndclmdoc-zc 3.5 3 100 .1 90 100 .95))
+ (with-sound (:srate 22050) ; .93
+ (sndclmdoc-fir+comb 0 2 10000 .001 200)
+ (sndclmdoc-fir+comb 2 2 1000 .0005 400)
+ (sndclmdoc-fir+comb 4 2 3000 .001 300)
+ (sndclmdoc-fir+comb 6 2 3000 .0005 1000))
+ (with-sound (:srate 22050) ; 1.3
+ (sndclmdoc-simple-src 0 4 1.0 0.5 '(0 1 1 2) "oboe.snd")
+ (sndclmdoc-srcer 1 2 1.0 1 .3 20 "fyow.snd")
+ (sndclmdoc-srcer 2 25 10.0 .01 1 10 "fyow.snd")
+ (sndclmdoc-srcer 3 2 1.0 .9 .05 60 "oboe.snd")
+ (sndclmdoc-srcer 4 2 1.0 1.0 .5 124 "oboe.snd")
+ (sndclmdoc-srcer 5 10 10.0 .01 .2 8 "oboe.snd")
+ (sndclmdoc-srcer 6 2 1.0 1 3 20 "oboe.snd"))
(with-sound ()
- (sndclmdoc-fir+comb 0 2 10000 .001 200)
- (sndclmdoc-fir+comb 2 2 1000 .0005 400)
- (sndclmdoc-fir+comb 4 2 3000 .001 300)
- (sndclmdoc-fir+comb 6 2 3000 .0005 1000))
- (with-sound () (sndclmdoc-simple-src 0 4 1.0 0.5 '(0 1 1 2) "oboe.snd"))
- (with-sound () (sndclmdoc-srcer 0 2 1.0 1 .3 20 "fyow.snd"))
- (with-sound () (sndclmdoc-srcer 0 25 10.0 .01 1 10 "fyow.snd"))
- (with-sound () (sndclmdoc-srcer 0 2 1.0 .9 .05 60 "oboe.snd"))
- (with-sound () (sndclmdoc-srcer 0 2 1.0 1.0 .5 124 "oboe.snd"))
- (with-sound () (sndclmdoc-srcer 0 10 10.0 .01 .2 8 "oboe.snd"))
- (with-sound () (sndclmdoc-srcer 0 2 1.0 1 3 20 "oboe.snd"))
- (with-sound ()
- (sndclmdoc-convins 0 2 (vct 1.0 0.5 0.25 0.125) "oboe.snd")) ; same as fir-filter with those coeffs
- (with-sound () (sndclmdoc-granulate-sound "now.snd" 0 3.0 0 2.0))
- (with-sound () (sndclmdoc-grev 0 100000 2.0 "pistol.snd" 40000))
- (with-sound () (sndclmdoc-simple-pvoc 0 2.0 1.0 512 "oboe.snd"))
- (with-sound () (sndclmdoc-simple-ina 0 1 .5 "oboe.snd"))
- (with-sound () (sndclmdoc-env-sound "oboe.snd" 0 1.0 '(0 0 1 1 2 1 3 0)))
+ (sndclmdoc-convins 0 2 (float-vector 1.0 0.5 0.25 0.125) "oboe.snd") ; same as fir-filter with those coeffs
+ (sndclmdoc-granulate-sound "now.snd" 1 3.0 0 2.0)
+ (sndclmdoc-grev 2 100000 2.0 "pistol.snd" 40000)
+ (sndclmdoc-simple-pvoc 3 2.0 1.0 512 "oboe.snd")
+ (sndclmdoc-simple-ina 4 1 .5 "oboe.snd")
+ (sndclmdoc-env-sound "oboe.snd" 5 1.0 '(0 0 1 1 2 1 3 0)))
(with-sound (:reverb jc-reverb :channels 2)
- (sndclmdoc-space "pistol.snd" 0 3 :distance-env '(0 1 1 2) :degree-env '(0 0 1 90)))
-
+ (sndclmdoc-space "pistol.snd" 0 1 :distance-env '(0 1 1 2) :degree-env '(0 0 1 90)))
+
(with-sound ()
(let ((gen (sndclmdoc-make-sum-of-odd-sines 440.0 10)))
(sndclmdoc-sum-of-odd-sines gen 0.0))
@@ -2980,79 +2465,61 @@
(sndclmdoc-simp-2 .2 .1 440 .1)
(sndclmdoc-fm-table "oboe.snd" .3 .1 .1 1.0 10.0 10)
(sndclmdoc-bl-saw .5 .1 440 10))
-
+
(with-sound (:channels 4)
- (let ((loc (make-locsig))
- (osc (make-oscil 440.0))
- (j 0))
- (run ; 360 notes one at each degree in a circle
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i 360))
- (do ((k 0 (+ 1 k)))
- ((= k 1000))
- (let ((sig (* .5 (oscil osc))))
- (locsig loc j sig)
- (set! j (+ 1 j))))
- (move-locsig loc (* 1.0 i) 1.0))))))
+ (let ((loc (make-locsig))
+ (osc (make-oscil 440.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 360))
+ (let ((start (* i 1000))
+ (stop (* (+ i 1) 1000)))
+ (do ((j start (+ j 1)))
+ ((= j stop))
+ (locsig loc j (* .5 (oscil osc)))))
+ (move-locsig loc (* 1.0 i) 1.0))))
(with-sound (:channels 4) (sndclmdoc-simple-dloc 0 2 440 .5))
(with-sound () (when? 0 4 2.0 8.0 "1a.snd"))
- (with-sound ()
- (move-formants 0 "oboe.snd" 2.0 0.99 '(0 1200 1.6 2400 2 1400) 4))
+ (with-sound () (move-formants 0 "oboe.snd" 2.0 0.99 '(0 1200 1.6 2400 2 1400) 4))
(test-filter (make-one-zero 0.5 0.5))
(test-filter (make-one-pole 0.1 -0.9))
(test-filter (make-two-pole 0.1 0.1 0.9))
(test-filter (make-two-zero 0.5 0.2 0.3))
-
- (with-sound (:scaled-to .5)
- (flux 0 "oboe.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6))
- (flux 2 "now.snd" 4.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0))
- (flux 4 "now.snd" 1.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.995 20)
- (flux 6 "now.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.99 10)
- (flux 8 "now.snd" 10.0 '(2.0) '(1.0 1.333 1.6 2.0 3.0) 0.99 120)
- (flux 10 "fyow.snd" .50 '(1.0 2.0 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.99 120))
-
- (with-sound () (sndscm-osc-fm 0 1 440 .1 1 1))
- (with-sound () (sndscm-osc1-fm 0 1 440 .1 1))
- (with-sound () (sndscm-osc2-fm 0 1 440.0 .1 1))
-
+
+ (with-sound (:scaled-to .5) ; .875
+ (flux 0 "oboe.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6))
+ (flux 2 "now.snd" 4.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0))
+ (flux 4 "now.snd" 1.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.995 20)
+ (flux 6 "now.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.99 10)
+ (flux 8 "now.snd" 10.0 '(2.0) '(1.0 1.333 1.6 2.0 3.0) 0.99 120)
+ (flux 10 "fyow.snd" .50 '(1.0 2.0 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.99 120))
+
(with-sound ()
- (let ((gen (make-dsp-asyfm :freq 2000 :ratio .1)))
- (run
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (dsp-asyfm-J gen 0.0)))))))
+ (sndscm-osc-fm 0 1 440 .1 1 1)
+ (sndscm-osc1-fm 0 1 440 .1 1)
+ (sndscm-osc2-fm 0 1 440.0 .1 1)
+ (simp-named-let 0 .01 440 .1)
+ (simp-tail-recursion 0 .01 440 .1))
(with-sound ()
- (let ((gen (make-dsp-asyfm :freq 2000 :ratio .1)))
- (run
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (dsp-asyfm-I gen 0.0)))))))
-
- (with-sound ()
- (let ((gen (make-sndclm-expcs :frequency 100 :et 1.0)))
- (run
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (sndclm-expcs gen 0.0)))))))
-
- (with-sound ()
- (let ((gen (make-sndclm-expcs :frequency 100 :et 0.1))
- (t-env (make-env '(0 .1 1 2) :length 10000)))
- (run (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (let ((et (env t-env)))
- (set! (sndclm-expcs-sinht gen) (* 0.5 (sinh et)))
- (set! (sndclm-expcs-cosht gen) (cosh et))
- (outa i (sndclm-expcs gen 0.0))))))))
-
- (for-each close-sound (sounds))
- )
-
-
-
+ (let ((gen (make-dsp-asyfm :freq 2000 :ratio .1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (outa i (dsp-asyfm-J gen 0.0))))
+ (let ((gen (make-dsp-asyfm :freq 2000 :ratio .1)))
+ (do ((i 1000 (+ i 1)))
+ ((= i 2000))
+ (outa i (* 0.5 (dsp-asyfm-I gen 0.0)))))
+ (let ((gen (make-sndclm-expcs :frequency 100 :et 1.0)))
+ (do ((i 2000 (+ i 1)))
+ ((= i 12000))
+ (outa i (sndclm-expcs gen 0.0))))
+ (let ((gen (make-sndclm-expcs :frequency 100 :et 0.1))
+ (t-env (make-env '(0 .1 1 2) :length 10000)))
+ (do ((i 12000 (+ i 1)))
+ ((= i 22000))
+ (let ((et (env t-env)))
+ (set! (gen 'sinht) (* 0.5 (sinh et)))
+ (set! (gen 'cosht) (cosh et))
+ (outa i (sndclm-expcs gen 0.0))))))
+
+ (for-each close-sound (sounds)))
diff --git a/clm2xen.c b/clm2xen.c
index d419e69..43f35d1 100644
--- a/clm2xen.c
+++ b/clm2xen.c
@@ -1,16 +1,12 @@
/* tie CLM module into Scheme, Ruby, or Forth */
-/*
- * we have mus-sound-srate in sndlib, mus-srate in clm.c, sound-srate and *clm-srate* in clm, mus-sound-srate and srate in snd
- * perhaps a mus module, giving mus:sound-srate in xen, mus:sound-srate in clm, mus_sound_srate in C?
+/* if the optimizer stops working inexplicably, look for any symbols used before this that
+ * might shadow a generator name; one such case was (make-hook 'env...) in snd-env.c
+ *
+ * (env env) is accepted by the optimizer in error
*/
-/* SOMEDAY: if s7, use s7_make_function_star (see g_make_oscil below).
- * The same for cases in snd-dac|region|select|snd
- * and since it's so easy in s7, are there are others? -- make-sampler but this complicates the documentation
- */
-
-#include <mus-config.h>
+#include "mus-config.h"
#if USE_SND
#include "snd.h"
@@ -22,17 +18,14 @@
#include <errno.h>
#include <stdlib.h>
#include <limits.h>
-#if HAVE_STRING_H
- #include <string.h>
-#endif
+#include <string.h>
#include <stdarg.h>
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
#else
- #ifndef _MSC_VER
- #include <unistd.h>
- #endif
+ #include <io.h>
+ #pragma warning(disable: 4244)
#endif
#include "_sndlib.h"
@@ -57,8 +50,111 @@
#endif
#endif
-#define MAX_ARGLIST_LEN 24
-/* try to accommodate &other-keys essentially */
+
+/* -------------------------------------------------------------------------------- */
+#if HAVE_SCHEME
+static bool mus_simple_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO)
+{
+ rdout *gen = (rdout *)IO;
+ if ((chan < gen->chans) &&
+ (samp <= gen->data_end) &&
+ (samp >= gen->data_start))
+ {
+ gen->obufs[chan][samp - gen->data_start] += val;
+ if (samp > gen->out_end)
+ gen->out_end = samp;
+ return(true);
+ }
+ return(false);
+}
+#endif
+
+/* -------------------------------------------------------------------------------- */
+
+struct mus_xen {
+ mus_any *gen;
+ int nvcts;
+#if HAVE_SCHEME
+ bool free_data;
+#endif
+ Xen *vcts; /* one for each accessible mus_float_t array (wrapped up here in a vct) */
+ struct mus_xen *next;
+};
+
+
+enum {MUS_DATA_WRAPPER, MUS_INPUT_FUNCTION, MUS_ANALYZE_FUNCTION, MUS_EDIT_FUNCTION, MUS_SYNTHESIZE_FUNCTION, MUS_SELF_WRAPPER, MUS_INPUT_DATA, MUS_MAX_VCTS};
+
+static mus_xen *mx_free_lists[8] = {NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL};
+
+static mus_xen *mx_alloc(int vcts)
+{
+ mus_xen *p;
+ if (mx_free_lists[vcts])
+ {
+ p = mx_free_lists[vcts];
+ mx_free_lists[vcts] = p->next;
+ return(p);
+ }
+ p = (mus_xen *)malloc(sizeof(mus_xen));
+ p->nvcts = vcts;
+ if (vcts > 0)
+ p->vcts = (Xen *)malloc(vcts * sizeof(Xen));
+ else p->vcts = NULL;
+#if HAVE_SCHEME
+ p->free_data = false;
+#endif
+ return(p);
+}
+
+
+static void mx_free(mus_xen *p)
+{
+#if HAVE_SCHEME
+ if (p->free_data)
+ {
+ s7_xf_attach(s7, (void *)(p->vcts[MUS_INPUT_DATA]));
+ p->free_data = false;
+ }
+#endif
+ p->next = mx_free_lists[p->nvcts];
+ mx_free_lists[p->nvcts] = p;
+}
+
+
+mus_any *mus_xen_gen(mus_xen *x) {return(x->gen);}
+#define mus_xen_to_mus_any(Gn) (((mus_xen *)Gn)->gen)
+
+#if (!HAVE_SCHEME)
+#define XEN_NULL 0
+
+#define Xen_real_to_C_double_if_bound(Xen_Arg, C_Val, Caller, ArgNum) \
+ if (Xen_is_bound(Xen_Arg)) {if (Xen_is_number(Xen_Arg)) C_Val = Xen_real_to_C_double(Xen_Arg); else Xen_check_type(false, Xen_Arg, ArgNum, Caller, "a number");}
+
+#define Xen_to_C_double_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
+ do {C_Val = 0.0; if (Xen_is_number(Xen_Arg)) C_Val = Xen_real_to_C_double(Xen_Arg); else Xen_check_type(false, Xen_Arg, ArgNum, Caller, "a number");} while (0)
+
+#define Xen_real_to_C_double_with_caller(Xen_Arg, Caller) Xen_real_to_C_double(Xen_Arg)
+
+#define Xen_to_C_integer_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
+ do {if (Xen_is_integer(Xen_Arg)) C_Val = Xen_integer_to_C_int(Xen_Arg); else {C_Val = 0.0; Xen_check_type(false, Xen_Arg, ArgNum, Caller, "an integer");}} while (0)
+
+#if (HAVE_FORTH) || (HAVE_RUBY)
+ #define Xen_object_ref_checked(Obj, Type) (Xen_c_object_is_type(Obj, Type) ? Xen_object_ref(Obj) : NULL)
+#else
+ #define Xen_object_ref_checked(Obj, Type) NULL
+#endif
+
+#else
+#define Xen_real_to_C_double_if_bound(Xen_Arg, C_Val, Caller, ArgNum) if (Xen_is_bound(Xen_Arg)) C_Val = (double)s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
+#define Xen_to_C_double_or_error(Xen_Arg, C_Val, Caller, ArgNum) C_Val = (double)s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
+#define Xen_real_to_C_double_with_caller(Xen_Arg, Caller) s7_number_to_real_with_caller(s7, Xen_Arg, Caller)
+
+#define Xen_to_C_integer_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
+ do {if (s7_is_integer(Xen_Arg)) C_Val = s7_integer(Xen_Arg); else {C_Val = 0.0; Xen_check_type(false, Xen_Arg, ArgNum, Caller, "an integer");}} while (0)
+
+#define Xen_object_ref_checked(Obj, Type) s7_object_value_checked(Obj, Type)
+#define XEN_NULL NULL
+#endif
static int local_error_type = MUS_NO_ERROR;
@@ -72,21 +168,22 @@ static void local_mus_error(int type, char *msg)
}
-static XEN clm_mus_error(int type, const char *msg)
+static Xen clm_mus_error(int type, const char *msg, const char *caller)
{
- mus_error(type, "%s", msg);
- return(XEN_FALSE);
+ /* mus_error returns an int, which is a bother in this context */
+ mus_error(type, "%s: %s", caller, msg);
+ return(Xen_false);
}
-#define CLM_ERROR XEN_ERROR_TYPE("mus-error")
+#define CLM_ERROR Xen_make_error_type("mus-error")
-static void clm_error(const char *caller, const char *msg, XEN val)
+static void clm_error(const char *caller, const char *msg, Xen val)
{
- XEN_ERROR(CLM_ERROR,
- XEN_LIST_4(C_TO_XEN_STRING("~A: ~A ~A"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_STRING(msg),
+ Xen_error(CLM_ERROR,
+ Xen_list_4(C_string_to_Xen_string("~A: ~A ~A"),
+ C_string_to_Xen_string(caller),
+ C_string_to_Xen_string(msg),
val));
}
@@ -94,34 +191,37 @@ static void clm_error(const char *caller, const char *msg, XEN val)
/* ---------------- optional-key ---------------- */
-int mus_optkey_unscramble(const char *caller, int nkeys, XEN *keys, XEN *args, int *orig)
+int mus_optkey_unscramble(const char *caller, int nkeys, Xen *keys, Xen *args, int *orig)
{
/* implement the &optional-key notion in CLM */
/* "keys" holds the keywords the calling function accepts,
* upon return, if a key was given in the arglist or its position had a value, the corresponding value is in its keys location
* "nkeys is the size of "keys"
* "args" contains the original arguments passed to the function in order
- * it should be of size nkeys * 2, and any trailing (unspecified) args should be XEN_UNDEFINED
+ * it should be of size nkeys * 2, and any trailing (unspecified) args should be Xen_undefined
* "orig" should be of size nkeys, and will contain upon return the 1-based location of the original keyword value argument
* (it is intended for error reports)
*/
- int arg_ctr = 0, key_start = 0, rtn_ctr = 0, nargs;
+ int arg_ctr = 0, key_start = 0, rtn_ctr = 0, nargs, nargs_end;
bool keying = false, key_found = false;
nargs = nkeys * 2;
+ nargs_end = nargs - 1;
while ((arg_ctr < nargs) &&
- (XEN_BOUND_P(args[arg_ctr])))
+ (Xen_is_bound(args[arg_ctr])))
{
- if (!(XEN_KEYWORD_P(args[arg_ctr])))
+ Xen key;
+ key = args[arg_ctr];
+ if (!(Xen_is_keyword(key)))
{
if (keying)
- clm_error(caller, "unmatched value within keyword section?", args[arg_ctr]);
+ clm_error(caller, "unmatched value within keyword section?", key);
/* type checking on the actual values has to be the caller's problem */
- if (arg_ctr >= nkeys)
- clm_error(caller, "extra trailing args?", args[arg_ctr]);
+ if (arg_ctr >= nkeys) /* we aren't handling a keyword arg, so the underlying args should only take nkeys args */
+ clm_error(caller, "extra trailing args?", key);
- keys[arg_ctr] = args[arg_ctr];
+ keys[arg_ctr] = key;
orig[arg_ctr] = arg_ctr + 1;
arg_ctr++;
key_start = arg_ctr;
@@ -129,29 +229,28 @@ int mus_optkey_unscramble(const char *caller, int nkeys, XEN *keys, XEN *args, i
}
else
{
- XEN key;
int i;
+ Xen val;
+ val = args[arg_ctr + 1];
+ if ((arg_ctr == nargs_end) ||
+ (!(Xen_is_bound(val))))
+ clm_error(caller, "keyword without value?", key);
- if ((arg_ctr == (nargs - 1)) ||
- (!(XEN_BOUND_P(args[arg_ctr + 1]))))
- clm_error(caller, "keyword without value?", args[arg_ctr]);
-
- keying = true;
- key = args[arg_ctr];
-
- if (XEN_KEYWORD_P(args[arg_ctr + 1]))
+ if (Xen_is_keyword(val))
clm_error(caller, "two keywords in a row?", key);
+ keying = true;
key_found = false;
for (i = key_start; i < nkeys; i++)
{
- if (XEN_KEYWORD_EQ_P(keys[i], key))
+ if (Xen_keyword_is_eq(keys[i], key))
{
- keys[i] = args[arg_ctr + 1];
- orig[i] = arg_ctr + 2;
+ keys[i] = val;
arg_ctr += 2;
+ orig[i] = arg_ctr;
rtn_ctr++;
key_found = true;
+ break;
}
}
@@ -168,121 +267,134 @@ int mus_optkey_unscramble(const char *caller, int nkeys, XEN *keys, XEN *args, i
}
-mus_float_t mus_optkey_to_float(XEN key, const char *caller, int n, mus_float_t def)
+static mus_float_t optkey_float_error(Xen key, int n, const char *caller)
{
- if (!(XEN_KEYWORD_P(key)))
- {
- XEN_ASSERT_TYPE(XEN_NUMBER_P(key), key, n, caller, "a number");
- return(XEN_TO_C_DOUBLE(key));
- }
+ Xen_check_type(false, key, n, caller, "a number");
+ return(0.0);
+}
+
+#define Xen_optkey_to_float(Original_key, Key, Caller, N, Def) \
+ ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_number(Key)) ? Xen_real_to_C_double(Key) : optkey_float_error(Key, N, Caller)))
+
+mus_float_t mus_optkey_to_float(Xen key, const char *caller, int n, mus_float_t def)
+{
+ if (Xen_is_number(key))
+ return(Xen_real_to_C_double(key));
+ if (!(Xen_is_keyword(key)))
+ Xen_check_type(false, key, n, caller, "a number");
return(def);
}
-int mus_optkey_to_int(XEN key, const char *caller, int n, int def)
+static int optkey_int_error(Xen key, int n, const char *caller)
{
- if (!(XEN_KEYWORD_P(key)))
- {
- XEN_ASSERT_TYPE(XEN_INTEGER_P(key), key, n, caller, "an integer");
- return(XEN_TO_C_INT(key));
- }
+ Xen_check_type(false, key, n, caller, "an integer");
+ return(0);
+}
+
+#define Xen_optkey_to_int(Original_key, Key, Caller, N, Def) \
+ ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_integer(Key)) ? Xen_integer_to_C_int(Key) : optkey_int_error(Key, N, Caller)))
+
+int mus_optkey_to_int(Xen key, const char *caller, int n, int def)
+{
+ if (Xen_is_integer(key))
+ return(Xen_integer_to_C_int(key));
+ if (!(Xen_is_keyword(key)))
+ Xen_check_type(false, key, n, caller, "an integer");
return(def);
}
-bool mus_optkey_to_bool(XEN key, const char *caller, int n, bool def)
+bool mus_optkey_to_bool(Xen key, const char *caller, int n, bool def)
{
- if (!(XEN_KEYWORD_P(key)))
- {
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(key), key, n, caller, "#f or #t");
- return(XEN_TO_C_BOOLEAN(key));
- }
+ if (Xen_is_boolean(key))
+ return(Xen_boolean_to_C_bool(key));
+ if (!(Xen_is_keyword(key)))
+ Xen_check_type(false, key, n, caller, "#f or #t");
return(def);
}
-mus_long_t mus_optkey_to_mus_long_t(XEN key, const char *caller, int n, mus_long_t def)
+static mus_long_t optkey_llong_error(Xen key, int n, const char *caller)
{
- if (!(XEN_KEYWORD_P(key)))
- {
- XEN_ASSERT_TYPE(XEN_NUMBER_P(key), key, n, caller, "a sample number");
- return(XEN_TO_C_INT64_T_OR_ELSE(key, def));
- }
+ Xen_check_type(false, key, n, caller, "an integer");
+ return(0);
+}
+
+#define Xen_optkey_to_mus_long_t(Original_key, Key, Caller, N, Def) \
+ ((Xen_keyword_is_eq(Original_key, Key)) ? Def : ((Xen_is_integer(Key)) ? Xen_llong_to_C_llong(Key) : optkey_llong_error(Key, N, Caller)))
+
+mus_long_t mus_optkey_to_mus_long_t(Xen key, const char *caller, int n, mus_long_t def)
+{
+ if (Xen_is_integer(key))
+ return(Xen_llong_to_C_llong(key));
+ if (!(Xen_is_keyword(key)))
+ Xen_check_type(false, key, n, caller, "a sample number or size");
return(def);
}
-const char *mus_optkey_to_string(XEN key, const char *caller, int n, char *def)
+const char *mus_optkey_to_string(Xen key, const char *caller, int n, char *def)
{
- if ((!(XEN_KEYWORD_P(key))) && (!(XEN_FALSE_P(key))))
- {
- XEN_ASSERT_TYPE(XEN_STRING_P(key), key, n, caller, "a string");
- return(XEN_TO_C_STRING(key));
- }
+ if (Xen_is_string(key))
+ return(Xen_string_to_C_string(key));
+ if ((!(Xen_is_keyword(key))) && (!(Xen_is_false(key))))
+ Xen_check_type(false, key, n, caller, "a string");
return(def);
}
-static vct *mus_optkey_to_vct(XEN key, const char *caller, int n, vct *def)
+static vct *mus_optkey_to_vct(Xen key, const char *caller, int n, vct *def)
{
- if ((!(XEN_KEYWORD_P(key))) && (!(XEN_FALSE_P(key))))
- {
- XEN_ASSERT_TYPE(MUS_VCT_P(key), key, n, caller, "a vct");
- return(XEN_TO_VCT(key));
- }
+ if (mus_is_vct(key))
+ return(Xen_to_vct(key));
+ if ((!(Xen_is_keyword(key))) && (!(Xen_is_false(key))))
+ Xen_check_type(false, key, n, caller, "a " S_vct);
return(def);
}
-static bool local_arity_ok(XEN proc, int args) /* from snd-xen.c minus (inconvenient) gc protection */
+static bool local_arity_ok(Xen proc, int args) /* from snd-xen.c minus (inconvenient) gc protection */
{
- XEN arity;
+#if HAVE_SCHEME
+ return(s7_is_aritable(s7, proc, args));
+#else
+ Xen arity;
int rargs;
- arity = XEN_ARITY(proc);
+ arity = Xen_arity(proc);
+ rargs = Xen_integer_to_C_int(arity);
#if HAVE_RUBY
- rargs = XEN_TO_C_INT(arity);
return(xen_rb_arity_ok(rargs, args));
#endif
#if HAVE_FORTH
- rargs = XEN_TO_C_INT(arity);
return(rargs == args);
#endif
-
-#if HAVE_SCHEME
- {
- int oargs, restargs;
- rargs = XEN_TO_C_INT(XEN_CAR(arity));
- oargs = XEN_TO_C_INT(XEN_CADR(arity));
- restargs = ((XEN_TRUE_P(XEN_CADDR(arity))) ? 1 : 0);
- if (rargs > args) return(false);
- if ((restargs == 0) && ((rargs + oargs) < args)) return(false);
- }
#endif
-
return(true);
}
-XEN mus_optkey_to_procedure(XEN key, const char *caller, int n, XEN def, int required_args, const char *err)
+Xen mus_optkey_to_procedure(Xen key, const char *caller, int n, Xen def, int required_args, const char *err)
{
- if ((!(XEN_KEYWORD_P(key))) && (!(XEN_FALSE_P(key))))
+ /* in this case, it's faster to look for the keyword first */
+ if ((!(Xen_is_keyword(key))) &&
+ (!(Xen_is_false(key))))
{
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(key), key, n, caller, "a procedure");
+ Xen_check_type(Xen_is_procedure(key), key, n, caller, "a procedure");
if (!(local_arity_ok(key, required_args)))
- XEN_BAD_ARITY_ERROR(caller, n, key, err);
+ Xen_bad_arity_error(caller, n, key, err);
return(key);
}
return(def);
}
-/* mus_optkey_to_mus_any and mus_optkey_to_input_procedure are below where MUS_XEN_P et al are defined */
/* ---------------- clm keywords ---------------- */
-static XEN kw_frequency, kw_initial_phase, kw_wave, kw_amplitude,
+static Xen kw_frequency, kw_initial_phase, kw_wave, kw_amplitude,
kw_r, kw_ratio, kw_size, kw_a0, kw_a1, kw_a2, kw_b1, kw_b2, kw_max_size,
kw_input, kw_srate, kw_file, kw_channel, kw_start,
kw_initial_contents, kw_initial_element, kw_scaler, kw_feedforward, kw_feedback,
@@ -298,66 +410,66 @@ static XEN kw_frequency, kw_initial_phase, kw_wave, kw_amplitude,
static void init_keywords(void)
{
/* in Ruby there's rb_intern of the symbol -- is it safe? */
- kw_frequency = XEN_MAKE_KEYWORD("frequency");
- kw_initial_phase = XEN_MAKE_KEYWORD("initial-phase");
- kw_wave = XEN_MAKE_KEYWORD("wave");
- kw_amplitude = XEN_MAKE_KEYWORD("amplitude");
- kw_r = XEN_MAKE_KEYWORD("r");
- kw_ratio = XEN_MAKE_KEYWORD("ratio");
- kw_size = XEN_MAKE_KEYWORD("size");
- kw_a0 = XEN_MAKE_KEYWORD("a0");
- kw_a1 = XEN_MAKE_KEYWORD("a1");
- kw_a2 = XEN_MAKE_KEYWORD("a2");
- kw_b1 = XEN_MAKE_KEYWORD("b1");
- kw_b2 = XEN_MAKE_KEYWORD("b2");
- kw_max_size = XEN_MAKE_KEYWORD("max-size");
- kw_input = XEN_MAKE_KEYWORD("input");
- kw_srate = XEN_MAKE_KEYWORD("srate");
- kw_file = XEN_MAKE_KEYWORD("file");
- kw_channel = XEN_MAKE_KEYWORD("channel");
- kw_start = XEN_MAKE_KEYWORD("start"); /* make-readin */
- kw_initial_contents = XEN_MAKE_KEYWORD("initial-contents");
- kw_initial_element = XEN_MAKE_KEYWORD("initial-element");
- kw_scaler = XEN_MAKE_KEYWORD("scaler");
- kw_feedforward = XEN_MAKE_KEYWORD("feedforward");
- kw_feedback = XEN_MAKE_KEYWORD("feedback");
- kw_radius = XEN_MAKE_KEYWORD("radius");
- kw_partials = XEN_MAKE_KEYWORD("partials");
- kw_a = XEN_MAKE_KEYWORD("a");
- kw_n = XEN_MAKE_KEYWORD("n");
- kw_order = XEN_MAKE_KEYWORD("order");
- kw_x_coeffs = XEN_MAKE_KEYWORD("xcoeffs");
- kw_y_coeffs = XEN_MAKE_KEYWORD("ycoeffs");
- kw_envelope = XEN_MAKE_KEYWORD("envelope");
- kw_base = XEN_MAKE_KEYWORD("base");
- kw_duration = XEN_MAKE_KEYWORD("duration");
- kw_offset = XEN_MAKE_KEYWORD("offset");
- kw_end = XEN_MAKE_KEYWORD("end");
- kw_direction = XEN_MAKE_KEYWORD("direction");
- kw_degree = XEN_MAKE_KEYWORD("degree");
- kw_distance = XEN_MAKE_KEYWORD("distance");
- kw_reverb = XEN_MAKE_KEYWORD("reverb");
- kw_output = XEN_MAKE_KEYWORD("output");
- kw_fft_size = XEN_MAKE_KEYWORD("fft-size");
- kw_expansion = XEN_MAKE_KEYWORD("expansion");
- kw_length = XEN_MAKE_KEYWORD("length");
- kw_hop = XEN_MAKE_KEYWORD("hop");
- kw_ramp = XEN_MAKE_KEYWORD("ramp");
- kw_jitter = XEN_MAKE_KEYWORD("jitter");
- kw_type = XEN_MAKE_KEYWORD("type");
- kw_channels = XEN_MAKE_KEYWORD("channels");
- kw_filter = XEN_MAKE_KEYWORD("filter");
- kw_revout = XEN_MAKE_KEYWORD("revout");
- kw_width = XEN_MAKE_KEYWORD("width");
- kw_edit = XEN_MAKE_KEYWORD("edit");
- kw_synthesize = XEN_MAKE_KEYWORD("synthesize");
- kw_analyze = XEN_MAKE_KEYWORD("analyze");
- kw_interp = XEN_MAKE_KEYWORD("interp");
- kw_overlap = XEN_MAKE_KEYWORD("overlap");
- kw_pitch = XEN_MAKE_KEYWORD("pitch");
- kw_distribution = XEN_MAKE_KEYWORD("distribution");
- kw_coeffs = XEN_MAKE_KEYWORD("coeffs");
- kw_kind = XEN_MAKE_KEYWORD("kind");
+ kw_frequency = Xen_make_keyword("frequency");
+ kw_initial_phase = Xen_make_keyword("initial-phase");
+ kw_wave = Xen_make_keyword("wave");
+ kw_amplitude = Xen_make_keyword("amplitude");
+ kw_r = Xen_make_keyword("r");
+ kw_ratio = Xen_make_keyword("ratio");
+ kw_size = Xen_make_keyword("size");
+ kw_a0 = Xen_make_keyword("a0");
+ kw_a1 = Xen_make_keyword("a1");
+ kw_a2 = Xen_make_keyword("a2");
+ kw_b1 = Xen_make_keyword("b1");
+ kw_b2 = Xen_make_keyword("b2");
+ kw_max_size = Xen_make_keyword("max-size");
+ kw_input = Xen_make_keyword("input");
+ kw_srate = Xen_make_keyword("srate");
+ kw_file = Xen_make_keyword("file");
+ kw_channel = Xen_make_keyword("channel");
+ kw_start = Xen_make_keyword("start"); /* make-readin */
+ kw_initial_contents = Xen_make_keyword("initial-contents");
+ kw_initial_element = Xen_make_keyword("initial-element");
+ kw_scaler = Xen_make_keyword("scaler");
+ kw_feedforward = Xen_make_keyword("feedforward");
+ kw_feedback = Xen_make_keyword("feedback");
+ kw_radius = Xen_make_keyword("radius");
+ kw_partials = Xen_make_keyword("partials");
+ kw_a = Xen_make_keyword("a");
+ kw_n = Xen_make_keyword("n");
+ kw_order = Xen_make_keyword("order");
+ kw_x_coeffs = Xen_make_keyword("xcoeffs");
+ kw_y_coeffs = Xen_make_keyword("ycoeffs");
+ kw_envelope = Xen_make_keyword("envelope");
+ kw_base = Xen_make_keyword("base");
+ kw_duration = Xen_make_keyword("duration");
+ kw_offset = Xen_make_keyword("offset");
+ kw_end = Xen_make_keyword("end");
+ kw_direction = Xen_make_keyword("direction");
+ kw_degree = Xen_make_keyword("degree");
+ kw_distance = Xen_make_keyword("distance");
+ kw_reverb = Xen_make_keyword("reverb");
+ kw_output = Xen_make_keyword("output");
+ kw_fft_size = Xen_make_keyword("fft-size");
+ kw_expansion = Xen_make_keyword("expansion");
+ kw_length = Xen_make_keyword("length");
+ kw_hop = Xen_make_keyword("hop");
+ kw_ramp = Xen_make_keyword("ramp");
+ kw_jitter = Xen_make_keyword("jitter");
+ kw_type = Xen_make_keyword("type");
+ kw_channels = Xen_make_keyword("channels");
+ kw_filter = Xen_make_keyword("filter");
+ kw_revout = Xen_make_keyword("revout");
+ kw_width = Xen_make_keyword("width");
+ kw_edit = Xen_make_keyword("edit");
+ kw_synthesize = Xen_make_keyword("synthesize");
+ kw_analyze = Xen_make_keyword("analyze");
+ kw_interp = Xen_make_keyword("interp");
+ kw_overlap = Xen_make_keyword("overlap");
+ kw_pitch = Xen_make_keyword("pitch");
+ kw_distribution = Xen_make_keyword("distribution");
+ kw_coeffs = Xen_make_keyword("coeffs");
+ kw_kind = Xen_make_keyword("kind");
}
@@ -365,42 +477,55 @@ static void init_keywords(void)
/* ---------------- *clm-table-size* ---------------- */
static mus_long_t clm_table_size = MUS_CLM_DEFAULT_TABLE_SIZE;
+#if HAVE_SCHEME
+ static s7_pointer clm_table_size_symbol;
+#endif
mus_long_t clm_default_table_size_c(void) {return(clm_table_size);}
-static XEN g_clm_table_size(void) {return(C_TO_XEN_INT64_T(clm_table_size));}
+static Xen g_clm_table_size(void) {return(C_llong_to_Xen_llong(clm_table_size));}
-static XEN g_set_clm_table_size(XEN val)
+static Xen g_set_clm_table_size(Xen val)
{
mus_long_t size;
#define H_clm_table_size "(" S_clm_table_size "): the default table size for most generators (512)"
- XEN_ASSERT_TYPE(XEN_INT64_T_P(val), val, XEN_ONLY_ARG, S_setB S_clm_table_size, "an integer");
- size = XEN_TO_C_INT64_T(val);
+ Xen_check_type(Xen_is_llong(val), val, 1, S_set S_clm_table_size, "an integer");
+ size = Xen_llong_to_C_llong(val);
if ((size <= 0) ||
(size > mus_max_table_size()))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_clm_table_size, XEN_ARG_1, val, "invalid size: ~A (see mus-max-table-size)");
+ Xen_out_of_range_error(S_set S_clm_table_size, 1, val, "invalid size (see mus-max-table-size)");
clm_table_size = size;
- return(C_TO_XEN_INT64_T(clm_table_size));
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, clm_table_size_symbol, s7_make_integer(s7, clm_table_size));
+#endif
+ return(C_llong_to_Xen_llong(clm_table_size));
}
/* ---------------- *clm-default-frequency* ---------------- */
-static double clm_default_frequency = MUS_CLM_DEFAULT_FREQUENCY;
+static mus_float_t clm_default_frequency = MUS_CLM_DEFAULT_FREQUENCY;
+#if HAVE_SCHEME
+ static s7_pointer clm_default_frequency_symbol;
+#endif
-double clm_default_frequency_c(void) {return(clm_default_frequency);}
+mus_float_t clm_default_frequency_c(void) {return(clm_default_frequency);}
-static XEN g_clm_default_frequency(void) {return(C_TO_XEN_DOUBLE(clm_default_frequency));}
+static Xen g_clm_default_frequency(void) {return(C_double_to_Xen_real(clm_default_frequency));}
-static XEN g_set_clm_default_frequency(XEN val)
+static Xen g_set_clm_default_frequency(Xen val)
{
#define H_clm_default_frequency "(" S_clm_default_frequency "): the default frequency for most generators (0.0)"
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(val), val, XEN_ONLY_ARG, S_setB S_clm_default_frequency, "a number");
- clm_default_frequency = XEN_TO_C_DOUBLE(val);
+ Xen_check_type(Xen_is_double(val), val, 1, S_set S_clm_default_frequency, "a number");
+ clm_default_frequency = Xen_real_to_C_double(val);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, clm_default_frequency_symbol, s7_make_real(s7, clm_default_frequency));
+#endif
return(val);
}
+
/* ---------------- AM and simple stuff ---------------- */
static const char *fft_window_xen_names[MUS_NUM_FFT_WINDOWS] =
@@ -418,328 +543,460 @@ static const char *fft_window_xen_names[MUS_NUM_FFT_WINDOWS] =
const char *mus_fft_window_xen_name(mus_fft_window_t i) {return(fft_window_xen_names[(int)i]);}
-static XEN g_radians_to_hz(XEN val)
+static Xen g_mus_file_buffer_size(void)
+{
+ #define H_mus_file_buffer_size "(" S_mus_file_buffer_size "): current CLM IO buffer size (default is 8192)"
+ return(C_llong_to_Xen_llong(mus_file_buffer_size()));
+}
+
+
+#if HAVE_SCHEME
+ static s7_pointer mus_file_buffer_size_symbol;
+#endif
+
+static Xen g_mus_set_file_buffer_size(Xen val)
+{
+ mus_long_t len;
+ Xen_check_type(Xen_is_llong(val), val, 1, S_set S_mus_file_buffer_size, "an integer");
+ len = Xen_llong_to_C_llong(val);
+ if (len <= 0)
+ Xen_out_of_range_error(S_set S_mus_file_buffer_size, 1, val, "must be > 0");
+ mus_set_file_buffer_size(len);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, mus_file_buffer_size_symbol, s7_make_integer(s7, len));
+#endif
+ return(val);
+}
+
+
+static Xen g_radians_to_hz(Xen val)
{
#define H_radians_to_hz "(" S_radians_to_hz " rads): convert radians per sample to frequency in Hz: rads * srate / (2 * pi)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_radians_to_hz, "a number");
- return(C_TO_XEN_DOUBLE(mus_radians_to_hz(XEN_TO_C_DOUBLE(val))));
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_radians_to_hz, 1);
+ return(C_double_to_Xen_real(mus_radians_to_hz(x)));
}
-static XEN g_hz_to_radians(XEN val)
+static Xen g_hz_to_radians(Xen val)
{
#define H_hz_to_radians "(" S_hz_to_radians " hz): convert frequency in Hz to radians per sample: hz * 2 * pi / srate"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_hz_to_radians, "a number");
- return(C_TO_XEN_DOUBLE(mus_hz_to_radians(XEN_TO_C_DOUBLE(val))));
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_hz_to_radians, 1);
+ return(C_double_to_Xen_real(mus_hz_to_radians(x)));
}
-static XEN g_radians_to_degrees(XEN val)
+static Xen g_radians_to_degrees(Xen val)
{
#define H_radians_to_degrees "(" S_radians_to_degrees " rads): convert radians to degrees: rads * 360 / (2 * pi)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_radians_to_degrees, "a number");
- return(C_TO_XEN_DOUBLE(mus_radians_to_degrees(XEN_TO_C_DOUBLE(val))));
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_radians_to_degrees, 1);
+ return(C_double_to_Xen_real(mus_radians_to_degrees(x)));
}
-static XEN g_degrees_to_radians(XEN val)
+static Xen g_degrees_to_radians(Xen val)
{
#define H_degrees_to_radians "(" S_degrees_to_radians " deg): convert degrees to radians: deg * 2 * pi / 360"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_degrees_to_radians, "a number");
- return(C_TO_XEN_DOUBLE(mus_degrees_to_radians(XEN_TO_C_DOUBLE(val))));
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_degrees_to_radians, 1);
+ return(C_double_to_Xen_real(mus_degrees_to_radians(x)));
}
-static XEN g_db_to_linear(XEN val)
+static Xen g_db_to_linear(Xen val)
{
#define H_db_to_linear "(" S_db_to_linear " db): convert decibel value db to linear value: pow(10, db / 20)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_db_to_linear, "a number");
- return(C_TO_XEN_DOUBLE(mus_db_to_linear(XEN_TO_C_DOUBLE(val))));
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_db_to_linear, 1);
+ return(C_double_to_Xen_real(mus_db_to_linear(x)));
}
-static XEN g_linear_to_db(XEN val)
+static Xen g_linear_to_db(Xen val)
{
#define H_linear_to_db "(" S_linear_to_db " lin): convert linear value to decibels: 20 * log10(lin)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_linear_to_db, "a number");
- return(C_TO_XEN_DOUBLE(mus_linear_to_db(XEN_TO_C_DOUBLE(val))));
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_linear_to_db, 1);
+ return(C_double_to_Xen_real(mus_linear_to_db(x)));
+}
+
+
+static Xen g_even_weight(Xen val)
+{
+ #define H_even_weight "(" S_even_weight " x): return the even weight of x"
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_even_weight, 1);
+ return(C_double_to_Xen_real(mus_even_weight(x)));
+}
+
+
+static Xen g_odd_weight(Xen val)
+{
+ #define H_odd_weight "(" S_odd_weight " x): return the odd weight of x"
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_odd_weight, 1);
+ return(C_double_to_Xen_real(mus_odd_weight(x)));
+}
+
+
+static Xen g_even_multiple(Xen val1, Xen val2)
+{
+ #define H_even_multiple "(" S_even_multiple " x y): return the even multiple of x and y"
+ mus_float_t x, y;
+ Xen_to_C_double_or_error(val1, x, S_even_multiple, 1);
+ Xen_to_C_double_or_error(val2, y, S_even_multiple, 2);
+ return(C_double_to_Xen_real(mus_even_multiple(x, y)));
+}
+
+
+static Xen g_odd_multiple(Xen val1, Xen val2)
+{
+ #define H_odd_multiple "(" S_odd_multiple " x y): return the odd multiple of x and y"
+ mus_float_t x, y;
+ Xen_to_C_double_or_error(val1, x, S_odd_multiple, 1);
+ Xen_to_C_double_or_error(val2, y, S_odd_multiple, 2);
+ return(C_double_to_Xen_real(mus_odd_multiple(x, y)));
}
-static XEN g_seconds_to_samples(XEN val)
+static Xen g_seconds_to_samples(Xen val)
{
#define H_seconds_to_samples "(" S_seconds_to_samples " secs): use " S_mus_srate " to convert seconds to samples"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_seconds_to_samples, "a number");
- return(C_TO_XEN_INT64_T(mus_seconds_to_samples(XEN_TO_C_DOUBLE(val))));
+ mus_float_t x;
+ Xen_to_C_double_or_error(val, x, S_seconds_to_samples, 1);
+ return(C_llong_to_Xen_llong(mus_seconds_to_samples(x)));
}
-static XEN g_samples_to_seconds(XEN val)
+static Xen g_samples_to_seconds(Xen val)
{
#define H_samples_to_seconds "(" S_samples_to_seconds " samps): use " S_mus_srate " to convert samples to seconds"
- XEN_ASSERT_TYPE(XEN_INT64_T_P(val), val, XEN_ONLY_ARG, S_samples_to_seconds, "a number");
- return(C_TO_XEN_DOUBLE(mus_samples_to_seconds(XEN_TO_C_INT64_T(val))));
+ Xen_check_type(Xen_is_llong(val), val, 1, S_samples_to_seconds, "a number");
+ return(C_double_to_Xen_real(mus_samples_to_seconds(Xen_llong_to_C_llong(val))));
}
-/* can't use a variable *srate* directly here because the set! side would not communicate the change to C */
+#if HAVE_SCHEME
+ static s7_pointer clm_srate_symbol;
+#endif
-static XEN g_mus_srate(void)
+static Xen g_mus_srate(void)
{
#define H_mus_srate "(" S_mus_srate "): current sampling rate"
- return(C_TO_XEN_DOUBLE(mus_srate()));
+ return(C_double_to_Xen_real(mus_srate()));
}
-static XEN g_mus_set_srate(XEN val)
+static Xen g_mus_set_srate(Xen val)
{
mus_float_t sr;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_mus_srate, "a number");
- sr = XEN_TO_C_DOUBLE(val);
- if (sr <= 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_mus_srate, XEN_ONLY_ARG, val, "must be > 0.0");
- return(C_TO_XEN_DOUBLE(mus_set_srate(sr)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_mus_srate, "a number");
+ sr = Xen_real_to_C_double(val);
+ if (sr != mus_srate())
+ {
+ if (sr <= 0.0)
+ Xen_out_of_range_error(S_set S_mus_srate, 1, val, "must be > 0.0");
+ mus_set_srate(sr);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, clm_srate_symbol, s7_make_real(s7, sr));
+#endif
+ }
+ return(val);
}
-static XEN g_mus_float_equal_fudge_factor(void)
+#if HAVE_SCHEME
+ static s7_pointer mus_float_equal_fudge_factor_symbol;
+#endif
+
+static Xen g_mus_float_equal_fudge_factor(void)
{
#define H_mus_float_equal_fudge_factor "(" S_mus_float_equal_fudge_factor "): floating point equality fudge factor"
- return(C_TO_XEN_DOUBLE(mus_float_equal_fudge_factor()));
+ return(C_double_to_Xen_real(mus_float_equal_fudge_factor()));
}
-static XEN g_mus_set_float_equal_fudge_factor(XEN val)
+static Xen g_mus_set_float_equal_fudge_factor(Xen val)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_mus_float_equal_fudge_factor, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_float_equal_fudge_factor(XEN_TO_C_DOUBLE(val))));
+ mus_float_t factor;
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_mus_float_equal_fudge_factor, "a number");
+ factor = Xen_real_to_C_double(val);
+ if (factor != mus_float_equal_fudge_factor())
+ {
+ mus_set_float_equal_fudge_factor(factor);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, mus_float_equal_fudge_factor_symbol, s7_make_real(s7, factor));
+#endif
+ }
+ return(val);
}
-static XEN g_mus_array_print_length(void)
+#if HAVE_SCHEME
+ static s7_pointer mus_array_print_length_symbol;
+#endif
+
+static Xen g_mus_array_print_length(void)
{
#define H_mus_array_print_length "(" S_mus_array_print_length "): current clm array print length (default is 8). This \
-affects error reporting and generator descriptions. Array (vct) elements beyond this length are represented by '...'"
- return(C_TO_XEN_INT(mus_array_print_length()));
+affects error reporting and generator descriptions. Array (" S_vct ") elements beyond this length are represented by '...'"
+ return(C_int_to_Xen_integer(mus_array_print_length()));
}
-static XEN g_mus_set_array_print_length(XEN val)
+static Xen g_mus_set_array_print_length(Xen val)
{
int len;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_mus_array_print_length, "an integer");
- len = XEN_TO_C_INT(val);
- if (len < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_mus_array_print_length, XEN_ONLY_ARG, val, "must be >= 0");
- return(C_TO_XEN_INT(mus_set_array_print_length(len)));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mus_array_print_length, "an integer");
+ len = Xen_integer_to_C_int(val);
+ if (len != mus_array_print_length())
+ {
+ if (len < 0)
+ Xen_out_of_range_error(S_set S_mus_array_print_length, 1, val, "must be >= 0");
+ mus_set_array_print_length(len);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, mus_array_print_length_symbol, s7_make_integer(s7, len));
+#endif
+ }
+ return(val);
}
-static XEN g_ring_modulate(XEN val1, XEN val2)
+static Xen g_ring_modulate(Xen val1, Xen val2)
{
#define H_ring_modulate "(" S_ring_modulate " s1 s2): s1 * s2 (sample by sample multiply)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val1), val1, XEN_ARG_1, S_ring_modulate, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val2), val2, XEN_ARG_2, S_ring_modulate, "a number");
- return(C_TO_XEN_DOUBLE(mus_ring_modulate(XEN_TO_C_DOUBLE(val1), XEN_TO_C_DOUBLE(val2))));
+ Xen_check_type(Xen_is_number(val1), val1, 1, S_ring_modulate, "a number");
+ Xen_check_type(Xen_is_number(val2), val2, 2, S_ring_modulate, "a number");
+ return(C_double_to_Xen_real(mus_ring_modulate(Xen_real_to_C_double(val1), Xen_real_to_C_double(val2))));
}
-static XEN g_amplitude_modulate(XEN val1, XEN val2, XEN val3)
+static Xen g_amplitude_modulate(Xen val1, Xen val2, Xen val3)
{
#define H_amplitude_modulate "(" S_amplitude_modulate " carrier in1 in2): in1 * (carrier + in2)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val1), val1, XEN_ARG_1, S_amplitude_modulate, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val2), val2, XEN_ARG_2, S_amplitude_modulate, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val3), val3, XEN_ARG_3, S_amplitude_modulate, "a number");
- return(C_TO_XEN_DOUBLE(mus_amplitude_modulate(XEN_TO_C_DOUBLE(val1), XEN_TO_C_DOUBLE(val2), XEN_TO_C_DOUBLE(val3))));
+ Xen_check_type(Xen_is_number(val1), val1, 1, S_amplitude_modulate, "a number");
+ Xen_check_type(Xen_is_number(val2), val2, 2, S_amplitude_modulate, "a number");
+ Xen_check_type(Xen_is_number(val3), val3, 3, S_amplitude_modulate, "a number");
+ return(C_double_to_Xen_real(mus_amplitude_modulate(Xen_real_to_C_double(val1), Xen_real_to_C_double(val2), Xen_real_to_C_double(val3))));
}
-static XEN g_contrast_enhancement(XEN val1, XEN val2)
+static Xen g_contrast_enhancement(Xen val1, Xen val2)
{
mus_float_t index = 1.0; /* this is the default in clm.html and mus.lisp */
#define H_contrast_enhancement "(" S_contrast_enhancement " sig (index 1.0)): sin(sig * pi / 2 + index * sin(sig * 2 * pi))"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val1), val1, XEN_ARG_1, S_contrast_enhancement, "a number");
- if (XEN_BOUND_P(val2))
+ Xen_check_type(Xen_is_number(val1), val1, 1, S_contrast_enhancement, "a number");
+ if (Xen_is_bound(val2))
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val2), val2, XEN_ARG_2, S_contrast_enhancement, "a number");
- index = XEN_TO_C_DOUBLE(val2);
+ Xen_check_type(Xen_is_number(val2), val2, 2, S_contrast_enhancement, "a number");
+ index = Xen_real_to_C_double(val2);
}
- return(C_TO_XEN_DOUBLE(mus_contrast_enhancement(XEN_TO_C_DOUBLE(val1), index)));
+ return(C_double_to_Xen_real(mus_contrast_enhancement(Xen_real_to_C_double(val1), index)));
}
-static XEN g_dot_product(XEN val1, XEN val2, XEN size)
+static Xen g_dot_product(Xen val1, Xen val2, Xen size)
{
- #define H_dot_product "(" S_dot_product " v1 v2 :optional size): sum of (vcts) v1[i] * v2[i] (also named scalar product)"
+ #define H_dot_product "(" S_dot_product " v1 v2 (size)): sum of v1[i] * v2[i] (also named scalar product)"
vct *v1, *v2;
mus_long_t len;
- XEN_ASSERT_TYPE(MUS_VCT_P(val1), val1, XEN_ARG_1, S_dot_product, "a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(val2), val2, XEN_ARG_2, S_dot_product, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(size), size, XEN_ARG_3, S_dot_product, "an integer");
+ Xen_check_type(mus_is_vct(val1), val1, 1, S_dot_product, "a " S_vct);
+ Xen_check_type(mus_is_vct(val2), val2, 2, S_dot_product, "a " S_vct);
+ Xen_check_type(Xen_is_llong_or_unbound(size), size, 3, S_dot_product, "an integer");
- v1 = XEN_TO_VCT(val1);
- v2 = XEN_TO_VCT(val2);
- if (XEN_INT64_T_P(size))
+ v1 = Xen_to_vct(val1);
+ v2 = Xen_to_vct(val2);
+ if (Xen_is_llong(size))
{
- len = XEN_TO_C_INT64_T(size);
- if (len == 0) return(C_TO_XEN_DOUBLE(0.0));
+ len = Xen_llong_to_C_llong(size);
+ if (len == 0) return(C_double_to_Xen_real(0.0));
if (len < 0)
- XEN_OUT_OF_RANGE_ERROR(S_dot_product, 3, size, "size ~A < 0?");
- if (len > v1->length) len = v1->length;
+ Xen_out_of_range_error(S_dot_product, 3, size, "size < 0?");
+ if (len > mus_vct_length(v1)) len = mus_vct_length(v1);
}
- else len = v1->length;
- if (len > v2->length) len = v2->length;
+ else len = mus_vct_length(v1);
+ if (len > mus_vct_length(v2)) len = mus_vct_length(v2);
- return(C_TO_XEN_DOUBLE(mus_dot_product(v1->data, v2->data, len)));
+ return(C_double_to_Xen_real(mus_dot_product(mus_vct_data(v1), mus_vct_data(v2), len)));
}
-#if HAVE_COMPLEX_TRIG && XEN_HAVE_COMPLEX_NUMBERS
+#if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
+
+#if defined(__sun) && defined(__SVR4)
+ #undef _Complex_I
+ #define _Complex_I 1.0fi
+#endif
+
#define S_edot_product "edot-product"
-static XEN g_edot_product(XEN val1, XEN val2)
+static Xen g_edot_product(Xen val1, Xen val2)
{
#define H_edot_product "(" S_edot_product " freq data): sum of (e^freq*i) * data[i]"
mus_long_t i, len;
vct *v = NULL;
complex double freq;
complex double *vals;
- XEN result;
- XEN_ASSERT_TYPE(XEN_COMPLEX_P(val1), val1, XEN_ARG_1, S_edot_product, "complex");
- XEN_ASSERT_TYPE((MUS_VCT_P(val2)) || (XEN_VECTOR_P(val2)), val2, XEN_ARG_2, S_edot_product, "a vct");
+ Xen result;
+
+ Xen_check_type(Xen_is_complex(val1), val1, 1, S_edot_product, "complex");
+ Xen_check_type((mus_is_vct(val2)) || (Xen_is_vector(val2)), val2, 2, S_edot_product, "a " S_vct);
- freq = XEN_TO_C_COMPLEX(val1);
- if (MUS_VCT_P(val2))
+ freq = Xen_complex_to_C_complex(val1);
+ if (mus_is_vct(val2))
{
- v = XEN_TO_VCT(val2);
- len = v->length;
+ v = Xen_to_vct(val2);
+ len = mus_vct_length(v);
}
else
{
- len = XEN_VECTOR_LENGTH(val2);
+ len = Xen_vector_length(val2);
}
vals = (complex double *)calloc(len, sizeof(complex double));
- if (MUS_VCT_P(val2))
+ if (mus_is_vct(val2))
{
+ mus_float_t *vdata;
+ vdata = mus_vct_data(v);
for (i = 0; i < len; i++)
- vals[i] = v->data[i];
+ vals[i] = vdata[i];
}
else
{
for (i = 0; i < len; i++)
- vals[i] = XEN_TO_C_COMPLEX(XEN_VECTOR_REF(val2, i));
+ vals[i] = Xen_complex_to_C_complex(Xen_vector_ref(val2, i));
}
- result = C_TO_XEN_COMPLEX(mus_edot_product(freq, vals, len));
+ result = C_complex_to_Xen_complex(mus_edot_product(freq, vals, len));
free(vals);
return(result);
}
#endif
+typedef enum {G_RECTANGULAR_POLAR, G_POLAR_RECTANGULAR, G_RECTANGULAR_MAGNITUDES} xclm_window_t;
-typedef enum {G_MULTIPLY_ARRAYS, G_RECTANGULAR_POLAR, G_POLAR_RECTANGULAR, G_RECTANGULAR_MAGNITUDES} xclm_window_t;
-
-static XEN g_fft_window_1(xclm_window_t choice, XEN val1, XEN val2, XEN ulen, const char *caller)
+static Xen g_fft_window_1(xclm_window_t choice, Xen val1, Xen val2, Xen ulen, const char *caller)
{
vct *v1, *v2;
mus_long_t len;
- XEN_ASSERT_TYPE(MUS_VCT_P(val1), val1, XEN_ARG_1, caller, "a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(val2), val2, XEN_ARG_2, caller, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(ulen), ulen, XEN_ARG_3, caller, "an integer");
+ Xen_check_type(mus_is_vct(val1), val1, 1, caller, "a " S_vct);
+ Xen_check_type(mus_is_vct(val2), val2, 2, caller, "a " S_vct);
+ Xen_check_type(Xen_is_llong_or_unbound(ulen), ulen, 3, caller, "an integer");
- v1 = XEN_TO_VCT(val1);
- v2 = XEN_TO_VCT(val2);
- if (XEN_INT64_T_P(ulen))
+ v1 = Xen_to_vct(val1);
+ v2 = Xen_to_vct(val2);
+ if (Xen_is_llong(ulen))
{
- len = XEN_TO_C_INT64_T(ulen);
- if (len == 0) return(XEN_FALSE);
+ len = Xen_llong_to_C_llong(ulen);
+ if (len == 0) return(Xen_false);
if (len < 0)
- XEN_OUT_OF_RANGE_ERROR(caller, 3, ulen, "size ~A < 0?");
- if (len > v1->length) len = v1->length;
+ Xen_out_of_range_error(caller, 3, ulen, "size < 0?");
+ if (len > mus_vct_length(v1)) len = mus_vct_length(v1);
}
- else len = v1->length;
- if (len > v2->length) len = v2->length;
+ else len = mus_vct_length(v1);
+ if (len > mus_vct_length(v2)) len = mus_vct_length(v2);
switch (choice)
{
- case G_MULTIPLY_ARRAYS: mus_multiply_arrays(v1->data, v2->data, len); break;
- case G_RECTANGULAR_POLAR: mus_rectangular_to_polar(v1->data, v2->data, len); break;
- case G_RECTANGULAR_MAGNITUDES: mus_rectangular_to_magnitudes(v1->data, v2->data, len); break;
- case G_POLAR_RECTANGULAR: mus_polar_to_rectangular(v1->data, v2->data, len); break;
+ case G_RECTANGULAR_POLAR: mus_rectangular_to_polar(mus_vct_data(v1), mus_vct_data(v2), len); break;
+ case G_RECTANGULAR_MAGNITUDES: mus_rectangular_to_magnitudes(mus_vct_data(v1), mus_vct_data(v2), len); break;
+ case G_POLAR_RECTANGULAR: mus_polar_to_rectangular(mus_vct_data(v1), mus_vct_data(v2), len); break;
}
return(val1);
}
-static XEN g_multiply_arrays(XEN val1, XEN val2, XEN len)
-{
- #define H_multiply_arrays "(" S_multiply_arrays " v1 v2 :optional len): vct element-wise multiply: v1[i] *= v2[i]"
- return(g_fft_window_1(G_MULTIPLY_ARRAYS, val1, val2, len, S_multiply_arrays));
-}
-
-
-static XEN g_rectangular_to_polar(XEN val1, XEN val2)
+static Xen g_rectangular_to_polar(Xen val1, Xen val2)
{
#define H_rectangular_to_polar "(" S_rectangular_to_polar " rl im): convert real/imaginary \
-data in vcts rl and im from rectangular form (fft output) to polar form (a spectrum)"
+data in " S_vct "s rl and im from rectangular form (fft output) to polar form (a spectrum)"
- return(g_fft_window_1(G_RECTANGULAR_POLAR, val1, val2, XEN_UNDEFINED, S_rectangular_to_polar));
+ return(g_fft_window_1(G_RECTANGULAR_POLAR, val1, val2, Xen_undefined, S_rectangular_to_polar));
}
-static XEN g_rectangular_to_magnitudes(XEN val1, XEN val2)
+static Xen g_rectangular_to_magnitudes(Xen val1, Xen val2)
{
#define H_rectangular_to_magnitudes "(" S_rectangular_to_magnitudes " rl im): convert real/imaginary \
-data in vcts rl and im from rectangular form (fft output) to polar form, but ignore the phases"
+data in " S_vct "s rl and im from rectangular form (fft output) to polar form, but ignore the phases"
- return(g_fft_window_1(G_RECTANGULAR_MAGNITUDES, val1, val2, XEN_UNDEFINED, S_rectangular_to_magnitudes));
+ return(g_fft_window_1(G_RECTANGULAR_MAGNITUDES, val1, val2, Xen_undefined, S_rectangular_to_magnitudes));
}
-static XEN g_polar_to_rectangular(XEN val1, XEN val2)
+static Xen g_polar_to_rectangular(Xen val1, Xen val2)
{
#define H_polar_to_rectangular "(" S_polar_to_rectangular " rl im): convert real/imaginary \
-data in vcts rl and im from polar (spectrum) to rectangular (fft)"
+data in " S_vct "s rl and im from polar (spectrum) to rectangular (fft)"
- return(g_fft_window_1(G_POLAR_RECTANGULAR, val1, val2, XEN_UNDEFINED, S_polar_to_rectangular));
+ return(g_fft_window_1(G_POLAR_RECTANGULAR, val1, val2, Xen_undefined, S_polar_to_rectangular));
}
+#if HAVE_SCHEME
+#if (!WITH_GMP)
+#define PF2_TO_PF(CName, Cfnc) \
+ static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pf_t f; \
+ s7_pointer x, y; \
+ f = (s7_pf_t)(**p); (*p)++; \
+ x = f(sc, p); \
+ f = (s7_pf_t)(**p); (*p)++; \
+ y = f(sc, p); \
+ return(Cfnc); \
+ } \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
+ (s7_arg_to_pf(sc, s7_cadr(expr))) && \
+ (s7_arg_to_pf(sc, s7_caddr(expr)))) \
+ return(CName ## _pf_a); \
+ return(NULL); \
+ }
+
+PF2_TO_PF(rectangular_to_polar, g_rectangular_to_polar(x, y))
+PF2_TO_PF(polar_to_rectangular, g_polar_to_rectangular(x, y))
+PF2_TO_PF(rectangular_to_magnitudes, g_rectangular_to_magnitudes(x, y))
+#endif
+#endif
-static XEN g_mus_fft(XEN url, XEN uim, XEN len, XEN usign)
+
+static Xen g_mus_fft(Xen url, Xen uim, Xen len, Xen usign)
{
- #define H_mus_fft "(" S_mus_fft " rl im :optional len (dir 1)): return the fft of vcts rl and im which contain \
+ #define H_mus_fft "(" S_mus_fft " rl im (len) (dir 1)): return the fft of " S_vct "s rl and im which contain \
the real and imaginary parts of the data; len should be a power of 2, dir = 1 for fft, -1 for inverse-fft"
int sign;
mus_long_t n;
vct *v1, *v2;
- XEN_ASSERT_TYPE((MUS_VCT_P(url)), url, XEN_ARG_1, S_mus_fft, "a vct");
- XEN_ASSERT_TYPE((MUS_VCT_P(uim)), uim, XEN_ARG_2, S_mus_fft, "a vct");
+ Xen_check_type((mus_is_vct(url)), url, 1, S_mus_fft, "a " S_vct);
+ Xen_check_type((mus_is_vct(uim)), uim, 2, S_mus_fft, "a " S_vct);
- v1 = XEN_TO_VCT(url);
- v2 = XEN_TO_VCT(uim);
+ v1 = Xen_to_vct(url);
+ v2 = Xen_to_vct(uim);
- if (XEN_INTEGER_P(usign))
- sign = XEN_TO_C_INT(usign);
+ if (Xen_is_integer(usign))
+ sign = Xen_integer_to_C_int(usign);
else sign = 1;
- if (XEN_INT64_T_P(len))
+ if (Xen_is_llong(len))
{
- n = XEN_TO_C_INT64_T(len);
+ n = Xen_llong_to_C_llong(len);
if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_fft, 3, len, "size ~A <= 0?");
+ Xen_out_of_range_error(S_mus_fft, 3, len, "size <= 0?");
if (n > mus_max_malloc())
- XEN_OUT_OF_RANGE_ERROR(S_mus_fft, 3, len, "size ~A too large (see mus-max-malloc)");
- if (n > v1->length)
- n = v1->length;
+ Xen_out_of_range_error(S_mus_fft, 3, len, "size too large (see mus-max-malloc)");
+ if (n > mus_vct_length(v1))
+ n = mus_vct_length(v1);
}
- else n = v1->length;
+ else n = mus_vct_length(v1);
- if (n > v2->length)
- n = v2->length;
+ if (n > mus_vct_length(v2))
+ n = mus_vct_length(v2);
- if (!(POWER_OF_2_P(n)))
+ if (!(is_power_of_2(n)))
{
mus_float_t nf;
int np;
@@ -748,7 +1005,8 @@ the real and imaginary parts of the data; len should be a power of 2, dir = 1 fo
n = (mus_long_t)pow(2.0, np);
}
- mus_fft(v1->data, v2->data, n, sign);
+ if (n > 0)
+ mus_fft(mus_vct_data(v1), mus_vct_data(v2), n, sign);
/*
* in fftw, there's the extra complex array allocation, so for n = 2^29
* (and doubles for vcts as well as fftw), we need 24.6 Gbytes, and the FFT
@@ -760,7 +1018,7 @@ the real and imaginary parts of the data; len should be a power of 2, dir = 1 fo
}
-static XEN g_make_fft_window(XEN type, XEN size, XEN ubeta, XEN ualpha)
+static Xen g_make_fft_window(Xen type, Xen size, Xen ubeta, Xen ualpha)
{
#if HAVE_SCHEME
#define make_window_example "(" S_make_fft_window " " S_hamming_window " 256)"
@@ -772,7 +1030,7 @@ static XEN g_make_fft_window(XEN type, XEN size, XEN ubeta, XEN ualpha)
#define make_window_example "hamming-window 256 make-fft-window"
#endif
- #define H_make_fft_window "(" S_make_fft_window " type size :optional (beta 0.0) (alpha 0.0)): -> fft data window (a vct). \
+ #define H_make_fft_window "(" S_make_fft_window " type size (beta 0.0) (alpha 0.0)): -> fft data window (a " S_vct "). \
type is one of the sndlib fft window identifiers such as " S_kaiser_window ", beta \
is the window family parameter, if any:\n " make_window_example
@@ -781,33 +1039,33 @@ is the window family parameter, if any:\n " make_window_example
int fft_window;
mus_float_t *data;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(type), type, XEN_ARG_1, S_make_fft_window, "an integer (window type)");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(size), size, XEN_ARG_2, S_make_fft_window, "an integer");
+ Xen_check_type(Xen_is_integer(type), type, 1, S_make_fft_window, "an integer (window type)");
+ Xen_check_type(Xen_is_llong(size), size, 2, S_make_fft_window, "an integer");
- if (XEN_NUMBER_P(ubeta)) beta = XEN_TO_C_DOUBLE(ubeta);
- if (XEN_NUMBER_P(ualpha)) alpha = XEN_TO_C_DOUBLE(ualpha);
+ if (Xen_is_number(ubeta)) beta = Xen_real_to_C_double(ubeta);
+ if (Xen_is_number(ualpha)) alpha = Xen_real_to_C_double(ualpha);
- n = XEN_TO_C_INT64_T(size);
+ n = Xen_llong_to_C_llong(size);
if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_fft_window, 2, size, "size ~A <= 0?");
+ Xen_out_of_range_error(S_make_fft_window, 2, size, "size <= 0?");
if (n > mus_max_malloc())
- XEN_OUT_OF_RANGE_ERROR(S_make_fft_window, 2, size, "size arg ~A too large (see mus-max-malloc)");
+ Xen_out_of_range_error(S_make_fft_window, 2, size, "size too large (see mus-max-malloc)");
- fft_window = XEN_TO_C_INT(type);
- if (!(mus_fft_window_p(fft_window)))
- XEN_OUT_OF_RANGE_ERROR(S_make_fft_window, 1, type, "~A: unknown fft window");
+ fft_window = Xen_integer_to_C_int(type);
+ if (!(mus_is_fft_window(fft_window)))
+ Xen_out_of_range_error(S_make_fft_window, 1, type, "unknown fft window");
- data = (mus_float_t *)calloc(n, sizeof(mus_float_t));
+ data = (mus_float_t *)malloc(n * sizeof(mus_float_t));
mus_make_fft_window_with_window((mus_fft_window_t)fft_window, n, beta, alpha, data);
return(xen_make_vct(n, data));
}
-static XEN g_spectrum(XEN url, XEN uim, XEN uwin, XEN utype)
+static Xen g_spectrum(Xen url, Xen uim, Xen uwin, Xen utype)
{
- #define H_mus_spectrum "(" S_spectrum " rl im window :optional (type 1)): \
-real and imaginary data in vcts rl and im, returns (in rl) the spectrum thereof; \
-window is the fft data window (a vct as returned by " S_make_fft_window "), \
+ #define H_mus_spectrum "(" S_spectrum " rl im window (type 1)): \
+real and imaginary data in " S_vct "s rl and im, returns (in rl) the spectrum thereof; \
+window is the fft data window (a " S_vct " as returned by " S_make_fft_window "), \
and type determines how the spectral data is scaled:\n\
0 = data in dB,\n\
1 (default) = linear and normalized\n\
@@ -817,21 +1075,21 @@ and type determines how the spectral data is scaled:\n\
mus_long_t n;
vct *v1, *v2, *v3 = NULL;
- XEN_ASSERT_TYPE((MUS_VCT_P(url)), url, XEN_ARG_1, S_spectrum, "a vct");
- XEN_ASSERT_TYPE((MUS_VCT_P(uim)), uim, XEN_ARG_2, S_spectrum, "a vct");
- if (XEN_NOT_FALSE_P(uwin)) XEN_ASSERT_TYPE((MUS_VCT_P(uwin)), uwin, XEN_ARG_3, S_spectrum, "a vct or " PROC_FALSE);
+ Xen_check_type((mus_is_vct(url)), url, 1, S_spectrum, "a " S_vct);
+ Xen_check_type((mus_is_vct(uim)), uim, 2, S_spectrum, "a " S_vct);
+ if (!Xen_is_false(uwin)) Xen_check_type((mus_is_vct(uwin)), uwin, 3, S_spectrum, "a " S_vct " or " PROC_FALSE);
- v1 = XEN_TO_VCT(url);
- v2 = XEN_TO_VCT(uim);
- if (XEN_NOT_FALSE_P(uwin)) v3 = XEN_TO_VCT(uwin);
+ v1 = Xen_to_vct(url);
+ v2 = Xen_to_vct(uim);
+ if (!Xen_is_false(uwin)) v3 = Xen_to_vct(uwin);
- n = v1->length;
- if (n > v2->length)
- n = v2->length;
- if ((v3) && (n > v3->length))
- n = v3->length;
+ n = mus_vct_length(v1);
+ if (n > mus_vct_length(v2))
+ n = mus_vct_length(v2);
+ if ((v3) && (n > mus_vct_length(v3)))
+ n = mus_vct_length(v3);
- if (!(POWER_OF_2_P(n)))
+ if (!(is_power_of_2(n)))
{
mus_float_t nf;
int np;
@@ -840,77 +1098,80 @@ and type determines how the spectral data is scaled:\n\
n = (int)pow(2.0, np);
}
- if (XEN_INTEGER_P(utype))
- type = XEN_TO_C_INT(utype);
+ if (Xen_is_integer(utype))
+ type = Xen_integer_to_C_int(utype);
else type = 1; /* linear normalized */
if ((type < 0) || (type > 2))
- XEN_OUT_OF_RANGE_ERROR(S_spectrum, 4, utype, "type must be 0..2");
+ Xen_out_of_range_error(S_spectrum, 4, utype, "type must be 0..2");
- mus_spectrum(v1->data, v2->data, (v3) ? (v3->data) : NULL, n, (mus_spectrum_t)type);
+ if (n > 0)
+ mus_spectrum(mus_vct_data(v1), mus_vct_data(v2), (v3) ? (mus_vct_data(v3)) : NULL, n, (mus_spectrum_t)type);
return(url);
}
-static XEN g_autocorrelate(XEN reals)
+static Xen g_autocorrelate(Xen reals)
{
- #define H_autocorrelate "(" S_autocorrelate " data): in place autocorrelation of data (a vct)"
+ #define H_autocorrelate "(" S_autocorrelate " data): in place autocorrelation of data (a " S_vct ")"
/* assumes length is power of 2 */
vct *v1 = NULL;
- XEN_ASSERT_TYPE(MUS_VCT_P(reals), reals, XEN_ONLY_ARG, S_autocorrelate, "a vct");
- v1 = XEN_TO_VCT(reals);
- mus_autocorrelate(v1->data, v1->length);
+ Xen_check_type(mus_is_vct(reals), reals, 1, S_autocorrelate, "a " S_vct);
+ v1 = Xen_to_vct(reals);
+ if (mus_vct_length(v1) > 0)
+ mus_autocorrelate(mus_vct_data(v1), mus_vct_length(v1));
return(reals);
}
-static XEN g_correlate(XEN data1, XEN data2)
+static Xen g_correlate(Xen data1, Xen data2)
{
- #define H_correlate "(" S_correlate " data1 data2): in place cross-correlation of data1 and data2 (both vcts)"
+ #define H_correlate "(" S_correlate " data1 data2): in place cross-correlation of data1 and data2 (both " S_vct "s)"
mus_long_t size;
vct *v1 = NULL, *v2 = NULL;
- XEN_ASSERT_TYPE(MUS_VCT_P(data1), data1, XEN_ARG_1, S_correlate, "a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(data2), data2, XEN_ARG_2, S_correlate, "a vct");
+ Xen_check_type(mus_is_vct(data1), data1, 1, S_correlate, "a " S_vct);
+ Xen_check_type(mus_is_vct(data2), data2, 2, S_correlate, "a " S_vct);
- v1 = XEN_TO_VCT(data1);
- v2 = XEN_TO_VCT(data2);
- if (v1->length < v2->length)
- size = v1->length;
- else size = v2->length;
+ v1 = Xen_to_vct(data1);
+ v2 = Xen_to_vct(data2);
+ if (mus_vct_length(v1) < mus_vct_length(v2))
+ size = mus_vct_length(v1);
+ else size = mus_vct_length(v2);
- mus_correlate(v1->data, v2->data, size);
+ if (size > 0)
+ mus_correlate(mus_vct_data(v1), mus_vct_data(v2), size);
return(data1);
}
-static XEN g_convolution(XEN url1, XEN url2, XEN un)
+static Xen g_convolution(Xen url1, Xen url2, Xen un)
{
- #define H_mus_convolution "(" S_convolution " v1 v2 :optional len): convolution \
-of vcts v1 with v2, using fft of size len (a power of 2), result in v1"
+ #define H_mus_convolution "(" S_convolution " v1 v2 (len)): convolution \
+of " S_vct "s v1 with v2, using fft of size len (a power of 2), result in v1"
mus_long_t n;
vct *v1, *v2;
- XEN_ASSERT_TYPE((MUS_VCT_P(url1)), url1, XEN_ARG_1, S_convolution, "a vct");
- XEN_ASSERT_TYPE((MUS_VCT_P(url2)), url2, XEN_ARG_2, S_convolution, "a vct");
+ Xen_check_type((mus_is_vct(url1)), url1, 1, S_convolution, "a " S_vct);
+ Xen_check_type((mus_is_vct(url2)), url2, 2, S_convolution, "a " S_vct);
- v1 = XEN_TO_VCT(url1);
- v2 = XEN_TO_VCT(url2);
+ v1 = Xen_to_vct(url1);
+ v2 = Xen_to_vct(url2);
- if (XEN_INTEGER_P(un))
+ if (Xen_is_integer(un))
{
- n = XEN_TO_C_INT64_T(un);
+ n = Xen_llong_to_C_llong(un);
if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_convolution, 3, un, "size ~A <= 0?");
+ Xen_out_of_range_error(S_convolution, 3, un, "size <= 0?");
if (n > mus_max_malloc())
- XEN_OUT_OF_RANGE_ERROR(S_convolution, 3, un, "size ~A too large (see mus-max-malloc)");
- if (n > v1->length)
- n = v1->length;
+ Xen_out_of_range_error(S_convolution, 3, un, "size too large (see mus-max-malloc)");
+ if (n > mus_vct_length(v1))
+ n = mus_vct_length(v1);
}
- else n = v1->length;
- if (n > v2->length)
- n = v2->length;
- if (!(POWER_OF_2_P(n)))
+ else n = mus_vct_length(v1);
+ if (n > mus_vct_length(v2))
+ n = mus_vct_length(v2);
+ if (!(is_power_of_2(n)))
{
mus_float_t nf;
int np;
@@ -918,193 +1179,189 @@ of vcts v1 with v2, using fft of size len (a power of 2), result in v1"
np = (int)nf;
n = (int)pow(2.0, np);
}
-
- mus_convolution(v1->data, v2->data, n);
+ if (n > 0)
+ mus_convolution(mus_vct_data(v1), mus_vct_data(v2), n);
return(url1);
}
-static XEN g_clear_array(XEN arr)
-{
- #define H_clear_array "(" S_clear_array " v): clear vct v: v[i] = 0.0"
- vct *v;
- XEN_ASSERT_TYPE(MUS_VCT_P(arr), arr, XEN_ONLY_ARG, S_clear_array, "a vct");
- v = XEN_TO_VCT(arr);
- mus_clear_array(v->data, v->length);
- return(arr);
-}
-
-
-static XEN g_polynomial(XEN arr, XEN x)
+static Xen g_polynomial(Xen arr, Xen x)
{
#define H_polynomial "(" S_polynomial " coeffs x): evaluate a polynomial at x. coeffs are in order \
of degree, so coeff[0] is the constant term."
- vct *v;
- XEN_ASSERT_TYPE(MUS_VCT_P(arr), arr, XEN_ARG_1, S_polynomial, "a vct");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_2, S_polynomial, "a number");
- v = XEN_TO_VCT(arr);
- return(C_TO_XEN_DOUBLE(mus_polynomial(v->data, XEN_TO_C_DOUBLE(x), v->length)));
+
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(x), x, 2, S_polynomial, "a number");
+#endif
+ if (mus_is_vct(arr))
+ {
+ vct *v;
+ v = Xen_to_vct(arr);
+ return(C_double_to_Xen_real(mus_polynomial(mus_vct_data(v), Xen_real_to_C_double_with_caller(x, S_polynomial), mus_vct_length(v))));
+ }
+
+ Xen_check_type(Xen_is_vector(arr), arr, 1, S_polynomial, "a vector or " S_vct);
+ {
+ mus_float_t sum, cx;
+ int i, ncoeffs;
+
+ ncoeffs = Xen_vector_length(arr);
+ if (ncoeffs <= 0) return(C_double_to_Xen_real(0.0));
+ if (ncoeffs == 1) return(Xen_vector_ref(arr, 0)); /* just a constant term */
+
+ cx = Xen_real_to_C_double_with_caller(x, S_polynomial);
+ sum = Xen_real_to_C_double_with_caller(Xen_vector_ref(arr, ncoeffs - 1), S_polynomial);
+ for (i = ncoeffs - 2; i >= 0; i--)
+ sum = (sum * cx) + Xen_real_to_C_double_with_caller(Xen_vector_ref(arr, i), S_polynomial);
+ return(C_double_to_Xen_real(sum));
+ }
}
-static XEN g_array_interp(XEN obj, XEN phase, XEN size) /* opt size */
+static Xen g_array_interp(Xen obj, Xen phase, Xen size) /* opt size */
{
- #define H_array_interp "(" S_array_interp " v phase :optional size): v[phase] \
+ #define H_array_interp "(" S_array_interp " v phase (size)): v[phase] \
taking into account wrap-around (size is size of data), with linear interpolation if phase is not an integer."
mus_long_t len;
vct *v;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ARG_1, S_array_interp, "a vct");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(phase), phase, XEN_ARG_2, S_array_interp, "a number");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(size), size, XEN_ARG_3, S_array_interp, "an integer");
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_array_interp, "a " S_vct);
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(phase), phase, 2, S_array_interp, "a number");
+#endif
+ Xen_check_type(Xen_is_llong_or_unbound(size), size, 3, S_array_interp, "an integer");
- v = XEN_TO_VCT(obj);
- if (XEN_BOUND_P(size))
+ v = Xen_to_vct(obj);
+ if (Xen_is_bound(size))
{
- len = XEN_TO_C_INT64_T(size);
+ len = Xen_llong_to_C_llong(size);
if (len <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_array_interp, 3, size, "size ~A <= 0?");
- if (len > v->length)
- len = v->length;
+ Xen_out_of_range_error(S_array_interp, 3, size, "size <= 0?");
+ if (len > mus_vct_length(v))
+ len = mus_vct_length(v);
}
- else len = v->length;
-
- return(C_TO_XEN_DOUBLE(mus_array_interp(v->data, XEN_TO_C_DOUBLE(phase), len)));
+ else len = mus_vct_length(v);
+ if (len == 0)
+ return(C_double_to_Xen_real(0.0));
+ return(C_double_to_Xen_real(mus_array_interp(mus_vct_data(v), Xen_real_to_C_double_with_caller(phase, S_array_interp), len)));
}
-static XEN g_mus_interpolate(XEN type, XEN x, XEN obj, XEN size, XEN yn1)
+static Xen g_mus_interpolate(Xen type, Xen x, Xen obj, Xen size, Xen yn1)
{
- #define H_mus_interpolate "(" S_mus_interpolate " type x v :optional size yn1): interpolate in \
-data ('v' is a vct) using interpolation 'type', such as " S_mus_interp_linear "."
+ #define H_mus_interpolate "(" S_mus_interpolate " type x v (size) (yn1 0.0)): interpolate in \
+data ('v' is a " S_vct ") using interpolation 'type', such as " S_mus_interp_linear "."
mus_long_t len;
int itype;
vct *v;
mus_float_t y = 0.0;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(type), type, XEN_ARG_1, S_mus_interpolate, "an integer (interp type such as " S_mus_interp_all_pass ")");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_2, S_mus_interpolate, "a number");
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ARG_3, S_mus_interpolate, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(size), size, XEN_ARG_4, S_mus_interpolate, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(yn1), yn1, XEN_ARG_5, S_mus_interpolate, "a number");
+ Xen_check_type(Xen_is_integer(type), type, 1, S_mus_interpolate, "an integer (interp type such as " S_mus_interp_all_pass ")");
+ Xen_check_type(Xen_is_number(x), x, 2, S_mus_interpolate, "a number");
+ Xen_check_type(mus_is_vct(obj), obj, 3, S_mus_interpolate, "a " S_vct);
+ Xen_check_type(Xen_is_llong_or_unbound(size), size, 4, S_mus_interpolate, "an integer");
+ Xen_check_type(Xen_is_number_or_unbound(yn1), yn1, 5, S_mus_interpolate, "a number");
- itype = XEN_TO_C_INT(type);
- if (!(mus_interp_type_p(itype)))
- XEN_OUT_OF_RANGE_ERROR(S_mus_interpolate, 1, type, "unknown interp type ~A");
+ itype = Xen_integer_to_C_int(type);
+ if (!(mus_is_interp_type(itype)))
+ Xen_out_of_range_error(S_mus_interpolate, 1, type, "unknown interp type");
- v = XEN_TO_VCT(obj);
+ v = Xen_to_vct(obj);
- if (XEN_BOUND_P(size))
+ if (Xen_is_bound(size))
{
- len = XEN_TO_C_INT64_T(size);
+ len = Xen_llong_to_C_llong(size);
if (len <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_interpolate, 4, size, "size ~A <= 0?");
- if (len > v->length)
- len = v->length;
+ Xen_out_of_range_error(S_mus_interpolate, 4, size, "size <= 0?");
+ if (len > mus_vct_length(v))
+ len = mus_vct_length(v);
}
- else len = v->length;
+ else len = mus_vct_length(v);
+ if (len == 0)
+ return(C_double_to_Xen_real(0.0));
- if (XEN_NUMBER_P(yn1))
- y = XEN_TO_C_DOUBLE(yn1);
+ if (Xen_is_number(yn1))
+ y = Xen_real_to_C_double(yn1);
- return(C_TO_XEN_DOUBLE(mus_interpolate((mus_interp_t)itype, XEN_TO_C_DOUBLE(x), v->data, len, y)));
+ return(C_double_to_Xen_real(mus_interpolate((mus_interp_t)itype, Xen_real_to_C_double(x), mus_vct_data(v), len, y)));
}
/* ---------------- mus-xen struct ---------------- */
-static XEN_OBJECT_TYPE mus_xen_tag;
-
-#define MUS_XEN_P(obj) (XEN_OBJECT_TYPE_P(obj, mus_xen_tag))
-
-bool mus_xen_p(XEN obj) {return(MUS_XEN_P(obj));}
-
-
-static XEN g_mus_generator_p(XEN obj)
-{
- #define H_mus_generator_p "(" S_mus_generator_p " obj): " PROC_TRUE " if 'obj' is a CLM generator."
-
- if (MUS_XEN_P(obj)) return(XEN_TRUE);
+static Xen_object_type_t mus_xen_tag;
-#if HAVE_SCHEME || HAVE_FORTH
- /* defgenerator defines "mus-name" -- we need an actual type here! */
- if ((XEN_LIST_P(obj)) &&
- (XEN_LIST_LENGTH(obj) > 1) &&
- (XEN_SYMBOL_P(XEN_CAR(obj))))
- {
- XEN assoc_list;
- assoc_list = XEN_LIST_REF(obj, XEN_LIST_LENGTH(obj) - 1);
+bool mus_is_xen(Xen obj) {return(Xen_c_object_is_type(obj, mus_xen_tag));}
- if ((XEN_LIST_P(assoc_list)) && /* avoid type error from assoc */
- (XEN_LIST_P(XEN_CAR(assoc_list))) &&
- (XEN_LIST_P(XEN_ASSOC(C_STRING_TO_XEN_SYMBOL("mus-name"), assoc_list))))
- return(XEN_TRUE);
- }
-#endif
+#define Xen_to_C_generator(Xen_Arg, X_Val, C_Val, Checker, Caller, Descr) \
+ Xen_check_type((X_Val = (mus_xen *)Xen_object_ref_checked(Xen_Arg, mus_xen_tag)) && (Checker(C_Val = (mus_any *)mus_xen_to_mus_any(X_Val))), Xen_Arg, 1, Caller, Descr)
- return(XEN_FALSE);
-}
+#define Xen_to_C_any_generator(Xen_Arg, X_Val, C_Val, Caller, Descr) \
+ Xen_check_type((X_Val = (mus_xen *)Xen_object_ref_checked(Xen_Arg, mus_xen_tag)) && (C_Val = (mus_any *)mus_xen_to_mus_any(X_Val)), Xen_Arg, 1, Caller, Descr)
-/* if we used make-type in defgenerator, this could use the ? func,
- * but to keep Forth and Scheme together, maybe the type could be in C
- * mus-make-generator|generator?
- */
-static XEN *make_vcts(int size)
+static Xen g_is_mus_generator(Xen obj)
{
- int i;
- XEN *vcts;
- vcts = (XEN *)malloc(size * sizeof(XEN));
- for (i = 0; i < size; i++)
- vcts[i] = XEN_UNDEFINED;
- return(vcts);
+ #define H_is_mus_generator "(" S_is_mus_generator " obj): " PROC_TRUE " if 'obj' is a CLM generator."
+ return(C_bool_to_Xen_boolean(mus_is_xen(obj)));
}
-enum {MUS_DATA_WRAPPER, MUS_INPUT_FUNCTION, MUS_ANALYZE_FUNCTION, MUS_EDIT_FUNCTION, MUS_SYNTHESIZE_FUNCTION, MUS_SELF_WRAPPER, MUS_MAX_VCTS};
-
#if HAVE_SCHEME
-static XEN_MARK_OBJECT_TYPE mark_mus_xen(void *obj)
+static Xen_object_mark_t mark_mus_xen(void *obj)
#else
-static XEN_MARK_OBJECT_TYPE mark_mus_xen(XEN obj)
+static Xen_object_mark_t mark_mus_xen(Xen obj)
#endif
{
mus_xen *ms;
#if HAVE_RUBY || HAVE_SCHEME
- /* rb_gc_mark and scheme_mark_object pass us the actual value, not the XEN wrapper */
+ /* rb_gc_mark and scheme_mark_object pass us the actual value, not the Xen wrapper */
ms = (mus_xen *)obj;
#endif
#if HAVE_FORTH
- ms = XEN_TO_MUS_XEN(obj);
+ ms = Xen_to_mus_xen(obj);
#endif
if (ms->vcts)
{
- int i;
- for (i = 0; i < ms->nvcts; i++)
- if ((i != MUS_SELF_WRAPPER) &&
- (XEN_BOUND_P(ms->vcts[i])))
- xen_gc_mark(ms->vcts[i]);
+ int i, lim;
+ lim = MUS_SELF_WRAPPER;
+ if (ms->nvcts < lim) lim = ms->nvcts;
+#if HAVE_SCHEME
+ if (ms->free_data)
+ {
+ for (i = 0; i < lim; i++)
+ if ((i != MUS_INPUT_FUNCTION) &&
+ (i != MUS_INPUT_DATA) &&
+ (Xen_is_bound(ms->vcts[i])))
+ xen_gc_mark(ms->vcts[i]);
+ return;
+ }
+#endif
+ for (i = 0; i < lim; i++)
+ if (Xen_is_bound(ms->vcts[i]))
+ xen_gc_mark(ms->vcts[i]);
}
#if HAVE_RUBY
return(NULL);
#endif
+#if (!HAVE_EXTENSION_LANGUAGE)
+ return(0);
+#endif
}
static void mus_xen_free(mus_xen *ms)
{
- if (!(ms->dont_free_gen)) mus_free(ms->gen);
+ mus_free(ms->gen);
ms->gen = NULL;
- if (ms->vcts) free(ms->vcts);
- ms->vcts = NULL;
- free(ms);
+ mx_free(ms);
}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(mus_xen, free_mus_xen, mus_xen_free)
+Xen_wrap_free(mus_xen, free_mus_xen, mus_xen_free)
#if HAVE_SCHEME
@@ -1120,13 +1377,118 @@ static bool s7_equalp_mus_xen(void *val1, void *val2)
#endif
+enum {G_FILTER_STATE, G_FILTER_XCOEFFS, G_FILTER_YCOEFFS};
+/* G_FILTER_STATE must = MUS_DATA_WRAPPER = 0 */
+enum {G_LOCSIG_DATA, G_LOCSIG_REVDATA, G_LOCSIG_OUT, G_LOCSIG_REVOUT};
+
+static Xen mus_xen_copy(mus_xen *ms)
+{
+ /* return an object -> copied mus_xen -> copied mus_any gen */
+ mus_xen *np;
+
+ np = mx_alloc(ms->nvcts);
+ np->gen = mus_copy(ms->gen);
+ if (ms->nvcts > 0)
+ {
+ if (ms->nvcts == 1)
+ {
+ if ((mus_is_env(np->gen)) || /* do the most common case first */
+ (mus_is_formant_bank(np->gen)))
+ np->vcts[MUS_DATA_WRAPPER] = ms->vcts[MUS_DATA_WRAPPER];
+ else
+ {
+ if ((mus_is_comb_bank(np->gen)) ||
+ (mus_is_all_pass_bank(np->gen)) ||
+ (mus_is_filtered_comb_bank(np->gen)))
+ {
+ /* set up objects for new gens so that they will eventually be GC'd */
+ Xen v;
+ int i, len;
+ len = Xen_vector_length(ms->vcts[MUS_DATA_WRAPPER]);
+ v = Xen_make_vector(len, Xen_false);
+ np->vcts[MUS_DATA_WRAPPER] = v;
+ for (i = 0; i < len; i++)
+ Xen_vector_set(v, i, mus_xen_to_object(mus_any_to_mus_xen(mus_bank_generator(np->gen, i))));
+ }
+ else np->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
+ }
+ }
+ else
+ {
+ if (ms->nvcts == 2)
+ {
+ if (mus_is_pulsed_env(np->gen))
+ {
+ /* mus_free taken care of by copied pulsed_env gen */
+ np->vcts[0] = Xen_false;
+ np->vcts[1] = Xen_false;
+ }
+ else
+ {
+ if (mus_is_filtered_comb(np->gen))
+ {
+ np->vcts[0] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
+ np->vcts[1] = Xen_false; /* filt gen but it's not wrapped */
+ }
+ else
+ {
+ np->vcts[0] = ms->vcts[0];
+ np->vcts[1] = ms->vcts[1];
+ }
+ }
+ }
+ else
+ {
+ if (ms->nvcts == 3)
+ {
+ if (mus_is_oscil_bank(np->gen))
+ {
+ np->vcts[0] = ms->vcts[0];
+ np->vcts[1] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
+ np->vcts[2] = ms->vcts[2];
+ }
+ else
+ {
+ np->vcts[G_FILTER_STATE] = xen_make_vct_wrapper(mus_length(np->gen), mus_data(np->gen));
+ np->vcts[G_FILTER_XCOEFFS] = ms->vcts[G_FILTER_XCOEFFS];
+ np->vcts[G_FILTER_YCOEFFS] = ms->vcts[G_FILTER_YCOEFFS];
+ }
+ }
+ else
+ {
+ int i;
+ for (i = 0; i < ms->nvcts; i++)
+ np->vcts[i] = ms->vcts[i];
+
+ if (mus_is_granulate(np->gen))
+ np->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_granulate_grain_max_length(np->gen), mus_data(np->gen));
+
+ if ((mus_is_convolve(np->gen)) ||
+ (mus_is_src(np->gen)) ||
+ (mus_is_granulate(np->gen)) ||
+ (mus_is_phase_vocoder(np->gen)))
+ {
+ Xen c_obj;
+ c_obj = mus_xen_to_object(np);
+ np->vcts[MUS_SELF_WRAPPER] = c_obj;
+ mus_generator_copy_feeders(np->gen, ms->gen);
+ return(c_obj);
+ }
+ }
+ }
+ }
+ }
+ return(mus_xen_to_object(np));
+}
+
+
#if HAVE_RUBY
-static XEN mus_xen_to_s(XEN obj)
+static Xen mus_xen_to_s(Xen obj)
{
char *str;
- XEN result;
- str = mus_describe(XEN_TO_MUS_ANY(obj));
- result = C_TO_XEN_STRING(str);
+ Xen result;
+ str = mus_describe(Xen_to_mus_any(obj));
+ result = C_string_to_Xen_string(str);
if (str) free(str);
return(result);
}
@@ -1134,11 +1496,11 @@ static XEN mus_xen_to_s(XEN obj)
#if HAVE_FORTH
-static XEN print_mus_xen(XEN obj)
+static Xen print_mus_xen(Xen obj)
{
char *str;
- XEN result;
- str = mus_describe(XEN_TO_MUS_ANY(obj));
+ Xen result;
+ str = mus_describe(Xen_to_mus_any(obj));
result = fth_make_string_format("#<%s>", str);
if (str) free(str);
return(result);
@@ -1147,141 +1509,103 @@ static XEN print_mus_xen(XEN obj)
#if (!HAVE_SCHEME)
-static XEN equalp_mus_xen(XEN obj1, XEN obj2)
+static Xen equalp_mus_xen(Xen obj1, Xen obj2)
{
- if ((!(MUS_XEN_P(obj1))) || (!(MUS_XEN_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(mus_equalp(XEN_TO_MUS_ANY(obj1), XEN_TO_MUS_ANY(obj2))));
+ if ((!(mus_is_xen(obj1))) || (!(mus_is_xen(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(mus_equalp(Xen_to_mus_any(obj1), Xen_to_mus_any(obj2))));
}
#endif
#if HAVE_RUBY || HAVE_FORTH
-static XEN mus_xen_apply(XEN gen, XEN arg1, XEN arg2)
+static Xen mus_xen_apply(Xen gen, Xen arg1, Xen arg2)
{
#if HAVE_FORTH
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_mus_apply, "a generator");
+ Xen_check_type(mus_is_xen(gen), gen, 1, S_mus_apply, "a generator");
#endif
- return(C_TO_XEN_DOUBLE(mus_run(XEN_TO_MUS_ANY(gen),
- (XEN_NUMBER_P(arg1)) ? XEN_TO_C_DOUBLE(arg1) : 0.0,
- (XEN_NUMBER_P(arg2)) ? XEN_TO_C_DOUBLE(arg2) : 0.0)));
+ return(C_double_to_Xen_real(mus_run(Xen_to_mus_any(gen),
+ (Xen_is_number(arg1)) ? Xen_real_to_C_double(arg1) : 0.0,
+ (Xen_is_number(arg2)) ? Xen_real_to_C_double(arg2) : 0.0)));
}
#endif
#if HAVE_SCHEME
-static XEN g_frame_set(XEN uf1, XEN uchan, XEN val);
-static XEN g_mixer_set(XEN uf1, XEN in, XEN out, XEN val);
-static XEN mus_xen_apply(s7_scheme *sc, XEN gen, XEN args)
-{
- mus_float_t arg1 = 0.0, arg2 = 0.0;
- int len;
- len = XEN_LIST_LENGTH(args);
- if ((len > 0) &&
- (XEN_NUMBER_P(XEN_CAR(args))))
- arg1 = XEN_TO_C_DOUBLE(XEN_CAR(args));
- if ((len > 1) &&
- (XEN_NUMBER_P(XEN_CADR(args))))
- arg2 = XEN_TO_C_DOUBLE(XEN_CADR(args));
- return(C_TO_XEN_DOUBLE(mus_run(XEN_TO_MUS_ANY(gen), arg1, arg2)));
-}
+/* these are for mus_xen_tag, so need not handle float-vectors */
-static XEN s7_mus_set(s7_scheme *sc, XEN obj, XEN args)
+static Xen mus_xen_apply(s7_scheme *sc, Xen gen, Xen args)
{
- mus_any *g;
- g = XEN_TO_MUS_ANY(obj);
-
- if (mus_frame_p(g))
- return(g_frame_set(obj, XEN_CAR(args), XEN_CADR(args)));
- if (mus_mixer_p(g))
- return(g_mixer_set(obj, XEN_CAR(args), XEN_CADR(args), XEN_CADDR(args)));
- XEN_ASSERT_TYPE(false, obj, XEN_ARG_1, "generalized set!", "a frame or mixer");
- return(XEN_FALSE);
+ if (s7_is_pair(args))
+ {
+ mus_float_t arg1, arg2;
+ arg1 = s7_number_to_real_with_caller(sc, s7_car(args), "mus-apply");
+ args = s7_cdr(args);
+ if (s7_is_pair(args))
+ arg2 = s7_number_to_real_with_caller(sc, s7_car(args), "mus-apply");
+ else arg2 = 0.0;
+ return(s7_make_real(s7, mus_run(Xen_to_mus_any(gen), arg1, arg2)));
+ }
+ return(s7_make_real(s7, mus_run(Xen_to_mus_any(gen), 0.0, 0.0)));
}
-static XEN s7_mus_length(s7_scheme *sc, XEN obj)
+static Xen s7_mus_length(s7_scheme *sc, Xen obj)
{
return(g_mus_length(obj));
}
-static XEN s7_mus_copy(s7_scheme *sc, XEN obj)
+static Xen g_mus_copy(Xen gen);
+static Xen s7_mus_copy(s7_scheme *sc, Xen args)
{
- /* mus_copy in clm.c first */
-
- mus_any *g;
- g = XEN_TO_MUS_ANY(obj);
-
- if (mus_frame_p(g))
- return(mus_xen_to_object(mus_any_to_mus_xen(mus_frame_copy(g))));
- if (mus_mixer_p(g))
- return(mus_xen_to_object(mus_any_to_mus_xen(mus_mixer_copy(g))));
-
- return(XEN_FALSE);
+ return(g_mus_copy(s7_car(args)));
}
-static XEN s7_mus_fill(s7_scheme *sc, XEN obj, XEN val)
-{
- /* frame mixer, perhaps anything with an array? mus_fill method? */
-
- mus_any *g;
- g = XEN_TO_MUS_ANY(obj);
-
- if (mus_frame_p(g))
- return(C_TO_XEN_DOUBLE(mus_frame_fill(g, XEN_TO_C_DOUBLE(val))));
- if (mus_mixer_p(g))
- return(C_TO_XEN_DOUBLE(mus_mixer_fill(g, XEN_TO_C_DOUBLE(val))));
-
- return(XEN_FALSE);
-}
#endif
-XEN mus_xen_to_object(mus_xen *gn) /* global for user-defined gens */
+Xen mus_xen_to_object(mus_xen *gn) /* global for user-defined gens */
{
- XEN_MAKE_AND_RETURN_OBJECT(mus_xen_tag, gn, mark_mus_xen, free_mus_xen);
+ return(Xen_make_object(mus_xen_tag, gn, mark_mus_xen, free_mus_xen));
}
-XEN mus_xen_to_object_with_vct(mus_xen *gn, XEN v) /* global for user-defined gens (not used anymore in this file) */
+Xen mus_xen_to_object_with_vct(mus_xen *gn, Xen v) /* global for user-defined gens */
{
-#if HAVE_SCHEME
- if (!mus_vct_p(v)) fprintf(stderr, "vct arg clobbered");
-#endif
gn->vcts[MUS_DATA_WRAPPER] = v;
- XEN_MAKE_AND_RETURN_OBJECT(mus_xen_tag, gn, mark_mus_xen, free_mus_xen);
+ return(Xen_make_object(mus_xen_tag, gn, mark_mus_xen, free_mus_xen));
}
-mus_any *mus_optkey_to_mus_any(XEN key, const char *caller, int n, mus_any *def)
+mus_any *mus_optkey_to_mus_any(Xen key, const char *caller, int n, mus_any *def)
{
/* from Michael Scholz's sndins.c */
- if (!(XEN_KEYWORD_P(key)))
+ if (!(Xen_is_keyword(key)))
{
- XEN_ASSERT_TYPE(MUS_XEN_P(key), key, n, caller, "a clm generator or keyword");
- return(XEN_TO_MUS_ANY(key));
+ Xen_check_type(mus_is_xen(key), key, n, caller, "a clm generator or keyword");
+ return(Xen_to_mus_any(key));
}
return(def);
}
-static XEN mus_optkey_to_input_procedure(XEN key, const char *caller, int n, XEN def, int required_args, const char *err)
+static Xen mus_optkey_to_input_procedure(Xen key, const char *caller, int n, Xen def, int required_args, const char *err)
{
- if ((!(XEN_KEYWORD_P(key))) &&
- (!(XEN_FALSE_P(key))))
+ if (Xen_is_procedure(key))
{
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(key) || MUS_XEN_P(key), key, n, caller, "a procedure or input generator");
-
- if ((XEN_PROCEDURE_P(key)) &&
- (!(local_arity_ok(key, required_args))))
- XEN_BAD_ARITY_ERROR(caller, n, key, err);
-
- if (MUS_VCT_P(key))
- XEN_WRONG_TYPE_ARG_ERROR(caller, n, key, "an input procedure");
+ if (!(local_arity_ok(key, required_args)))
+ Xen_bad_arity_error(caller, n, key, err);
+ return(key);
+ }
- if ((MUS_XEN_P(key)) &&
- (!(mus_input_p(XEN_TO_MUS_ANY(key)))))
- XEN_WRONG_TYPE_ARG_ERROR(caller, n, key, "an input generator");
+ if (mus_is_xen(key))
+ {
+ if (!(mus_is_input(Xen_to_mus_any(key))))
+ Xen_wrong_type_arg_error(caller, n, key, "an input generator");
return(key);
}
+
+ if ((!(Xen_is_keyword(key))) &&
+ (!(Xen_is_false(key))))
+ Xen_check_type(false, key, n, caller, "a procedure or input generator");
return(def);
}
@@ -1292,33 +1616,27 @@ static XEN mus_optkey_to_input_procedure(XEN key, const char *caller, int n, XEN
mus_xen *mus_any_to_mus_xen(mus_any *ge)
{
mus_xen *gn;
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
+ gn = mx_alloc(0);
gn->gen = ge;
- gn->nvcts = 0;
- gn->vcts = NULL;
return(gn);
}
-static mus_xen *mus_any_to_mus_xen_with_vct(mus_any *ge, XEN v)
+mus_xen *mus_any_to_mus_xen_with_vct(mus_any *ge, Xen v)
{
mus_xen *gn;
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
+ gn = mx_alloc(1);
gn->gen = ge;
- gn->nvcts = 1;
- gn->vcts = make_vcts(gn->nvcts);
gn->vcts[MUS_DATA_WRAPPER] = v;
return(gn);
}
-static mus_xen *mus_any_to_mus_xen_with_two_vcts(mus_any *ge, XEN v1, XEN v2)
+mus_xen *mus_any_to_mus_xen_with_two_vcts(mus_any *ge, Xen v1, Xen v2)
{
mus_xen *gn;
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
+ gn = mx_alloc(2);
gn->gen = ge;
- gn->nvcts = 2;
- gn->vcts = make_vcts(gn->nvcts);
gn->vcts[MUS_DATA_WRAPPER] = v1;
gn->vcts[MUS_INPUT_FUNCTION] = v2;
return(gn);
@@ -1328,651 +1646,950 @@ static mus_xen *mus_any_to_mus_xen_with_two_vcts(mus_any *ge, XEN v1, XEN v2)
/* ---------------- generic functions ---------------- */
-/* these are for user-defined (list-based defgenerator-style) generators
- * the methods are in an association list (name func) or (name getter setter)
- */
-static XEN call_get_method(XEN gen, const char *method_name)
+static Xen g_mus_reset(Xen gen)
{
-#if HAVE_SCHEME || HAVE_FORTH
- XEN pair;
- pair = XEN_ASSOC(C_STRING_TO_XEN_SYMBOL(method_name),
- XEN_LIST_REF(gen,
- XEN_LIST_LENGTH(gen) - 1));
- if (XEN_LIST_P(pair))
- return(XEN_CALL_1(XEN_CADR(pair), /* this is the getter proc if procedure-with-setter */
- gen,
- method_name));
- XEN_ERROR(XEN_ERROR_TYPE("no-such-method"),
- XEN_LIST_3(C_TO_XEN_STRING("no-such-method: ~A for ~A"),
- C_TO_XEN_STRING(method_name),
- gen));
+ #define H_mus_reset "(" S_mus_reset " gen): clear out gen, setting it to its default starting state"
+ mus_xen *ms;
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ {
+ mus_reset(ms->gen);
+ return(gen);
+ }
+#if HAVE_SCHEME
+ if (s7_is_float_vector(gen))
+ {
+ s7_int len;
+ len = s7_vector_length(gen);
+ if (len > 0)
+ memset((void *)s7_float_vector_elements(gen), 0, len * sizeof(s7_double));
+ return(gen);
+ }
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-reset"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
#endif
- return(XEN_FALSE);
+ Xen_check_type(false, gen, 1, S_mus_reset, "a generator");
+ return(gen);
}
+#if HAVE_SCHEME
+ static s7_pointer mus_copy_symbol, copy_function;
+#endif
-static XEN call_get_method_2(XEN gen, XEN arg, const char *method_name)
+static Xen g_mus_copy(Xen gen)
{
-#if HAVE_SCHEME || HAVE_FORTH
- XEN pair;
- pair = XEN_ASSOC(C_STRING_TO_XEN_SYMBOL(method_name),
- XEN_LIST_REF(gen,
- XEN_LIST_LENGTH(gen) - 1));
- if (XEN_LIST_P(pair))
- return(XEN_CALL_2(XEN_CADR(pair),
- gen, arg,
- method_name));
- XEN_ERROR(XEN_ERROR_TYPE("no-such-method"),
- XEN_LIST_3(C_TO_XEN_STRING("no-such-method: ~A for ~A"),
- C_TO_XEN_STRING(method_name),
- gen));
+ #define H_mus_copy "(" S_mus_copy " gen): return a copy of gen"
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ return(mus_xen_copy(ms));
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, mus_copy_symbol);
+ if (func == copy_function)
+ return(s7_copy(s7, s7_list(s7, 1, gen)));
+ if (func != Xen_undefined)
+ return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
#endif
- return(XEN_FALSE);
+ Xen_check_type(false, gen, 1, S_mus_copy, "a generator");
+ return(gen);
}
-static XEN call_get_method_3(XEN gen, XEN arg1, XEN arg2, const char *method_name)
+static Xen g_mus_run(Xen gen, Xen arg1, Xen arg2)
{
-#if HAVE_SCHEME || HAVE_FORTH
- XEN pair;
- pair = XEN_ASSOC(C_STRING_TO_XEN_SYMBOL(method_name),
- XEN_LIST_REF(gen,
- XEN_LIST_LENGTH(gen) - 1));
- if (XEN_LIST_P(pair))
- return(XEN_CALL_3(XEN_CADR(pair),
- gen, arg1, arg2,
- method_name));
- XEN_ERROR(XEN_ERROR_TYPE("no-such-method"),
- XEN_LIST_3(C_TO_XEN_STRING("no-such-method: ~A for ~A"),
- C_TO_XEN_STRING(method_name),
- gen));
+ #define H_mus_run "(" S_mus_run " gen (arg1 0.0) (arg2 0.0)): apply gen to arg1 and arg2"
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ {
+ mus_float_t a1 = 0.0, a2 = 0.0;
+ Xen_real_to_C_double_if_bound(arg1, a1, S_mus_run, 2);
+ Xen_real_to_C_double_if_bound(arg2, a2, S_mus_run, 3);
+ return(C_double_to_Xen_real(mus_run(ms->gen, a1, a2)));
+ }
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-run"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 3, gen, arg1, arg2)));
+ }
#endif
- return(XEN_FALSE);
+ Xen_check_type(false, gen, 1, S_mus_run, "a generator");
+ return(C_double_to_Xen_real(0.0));
}
-static XEN call_set_method(XEN gen, XEN value, const char *method_name)
+static Xen g_mus_apply(Xen arglist)
{
-#if HAVE_SCHEME || HAVE_FORTH
- XEN pair;
- pair = XEN_ASSOC(C_STRING_TO_XEN_SYMBOL(method_name),
- XEN_LIST_REF(gen,
- XEN_LIST_LENGTH(gen) - 1));
- if (XEN_LIST_P(pair))
+ #define H_mus_apply "(" S_mus_apply " gen args...): apply gen to args"
+ mus_xen *ms;
+ Xen gen;
+ int arglist_len;
+
+ arglist_len = Xen_list_length(arglist);
+ if ((arglist_len > 3) || (arglist_len == 0))
+ return(C_double_to_Xen_real(0.0));
+
+ gen = Xen_car(arglist);
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
{
-#if HAVE_SCHEME
- if (s7_is_procedure_with_setter(XEN_CADR(pair)))
- return(XEN_CALL_2(s7_procedure_with_setter_setter(XEN_CADR(pair)),
- gen, value,
- method_name));
-#endif
- if (XEN_LIST_LENGTH(pair) == 3)
- return(XEN_CALL_2(XEN_CADDR(pair),
- gen, value,
- method_name));
+ mus_any *g;
+ g = ms->gen;
+
+ if (arglist_len == 1)
+ return(C_double_to_Xen_real(mus_apply(g, 0.0, 0.0)));
+
+ if (arglist_len == 2)
+ return(C_double_to_Xen_real(mus_apply(g, Xen_real_to_C_double(Xen_cadr(arglist)), 0.0)));
+
+ return(C_double_to_Xen_real(mus_apply(g,
+ Xen_real_to_C_double_with_caller(Xen_cadr(arglist), "mus-apply"),
+ Xen_real_to_C_double_with_caller(Xen_caddr(arglist), "mus-apply"))));
}
- XEN_ERROR(XEN_ERROR_TYPE("no-such-method"),
- XEN_LIST_3(C_TO_XEN_STRING("no-such-method: ~A for ~A"),
- C_TO_XEN_STRING(method_name),
- gen));
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-apply"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, arglist));
+ }
#endif
- return(XEN_FALSE);
+ Xen_check_type(false, Xen_car(arglist), 1, S_mus_apply, "a generator");
+ return(C_double_to_Xen_real(0.0));
}
-static XEN call_set_method_2(XEN gen, XEN arg, XEN value, const char *method_name)
+static Xen g_mus_describe(Xen gen)
{
-#if HAVE_SCHEME || HAVE_FORTH
- XEN pair;
- pair = XEN_ASSOC(C_STRING_TO_XEN_SYMBOL(method_name),
- XEN_LIST_REF(gen,
- XEN_LIST_LENGTH(gen) - 1));
- if (XEN_LIST_P(pair))
+ #define H_mus_describe "(" S_mus_describe " gen): return a string describing the state of CLM generator generator"
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
{
-#if HAVE_SCHEME
- if (s7_is_procedure_with_setter(XEN_CADR(pair)))
- return(XEN_CALL_3(s7_procedure_with_setter_setter(XEN_CADR(pair)),
- gen, arg, value,
- method_name));
-#endif
- if (XEN_LIST_LENGTH(pair) == 3)
- return(XEN_CALL_3(XEN_CADDR(pair),
- gen, arg, value,
- method_name));
+ Xen result;
+ char *str;
+ str = mus_describe(ms->gen);
+ result = C_string_to_Xen_string(str);
+ if (str) free(str);
+ return(result);
}
- XEN_ERROR(XEN_ERROR_TYPE("no-such-method"),
- XEN_LIST_3(C_TO_XEN_STRING("no-such-method: ~A for ~A"),
- C_TO_XEN_STRING(method_name),
- gen));
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-describe"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
#endif
- return(XEN_FALSE);
+ Xen_check_type(false, gen, 1, S_mus_describe, "a generator");
+ return(gen);
}
-static XEN g_mus_describe(XEN gen)
+#if HAVE_SCHEME
+#define mus_double_generic(Caller, CLM_case, Symbol) \
+ mus_xen *gn; \
+ s7_pointer func; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ if (gn) return(C_double_to_Xen_real(CLM_case(gn->gen))); \
+ func = s7_method(s7, gen, Symbol); \
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
+ Xen_check_type(false, gen, 1, Caller, "a generator"); \
+ return(gen);
+
+#define mus_set_double_generic(Caller, CLM_case) \
+ mus_xen *gn; \
+ s7_pointer func; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ Xen_check_type(Xen_is_double(val), val, 2, S_set Caller, "a float"); \
+ if (gn) {CLM_case(gn->gen, Xen_real_to_C_double(val)); return(val);} \
+ func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
+ if ((func != Xen_undefined) && (s7_procedure_setter(s7, func))) \
+ return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val))); \
+ Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
+ return(val);
+
+#define mus_long_long_generic(Caller, CLM_case) \
+ mus_xen *gn; \
+ s7_pointer func; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ if (gn) return(C_llong_to_Xen_llong(CLM_case(gn->gen))); \
+ func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
+ Xen_check_type(false, gen, 1, Caller, "a generator"); \
+ return(gen);
+
+#define mus_set_long_long_generic(Caller, CLM_case) \
+ mus_xen *gn; \
+ s7_pointer func; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ Xen_check_type(Xen_is_integer(val), val, 2, Caller, "an integer"); \
+ if (gn) {CLM_case(gn->gen, Xen_llong_to_C_llong(val)); return(val);} \
+ func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
+ if ((func != Xen_undefined) && (s7_procedure_setter(s7, func))) \
+ return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val))); \
+ Xen_check_type(false, gen, 1, Caller, "a generator"); \
+ return(val);
+
+#define mus_int_generic(Caller, CLM_case) \
+ mus_xen *gn; \
+ s7_pointer func; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ if (gn) return(C_int_to_Xen_integer(CLM_case(gn->gen))); \
+ func = s7_method(s7, gen, s7_make_symbol(s7, Caller)); \
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen))); \
+ Xen_check_type(false, gen, 1, Caller, "a generator"); \
+ return(gen);
+
+#else
+
+#define mus_double_generic(Caller, CLM_case, Symbol) \
+ mus_xen *gn; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
+ return(C_double_to_Xen_real(CLM_case(gn->gen)));
+
+#define mus_set_double_generic(Caller, CLM_case) \
+ mus_xen *gn; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ if (!gn) Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
+ Xen_check_type(Xen_is_double(val), val, 2, S_set Caller, "a float"); \
+ CLM_case(gn->gen, Xen_real_to_C_double(val)); \
+ return(val);
+
+#define mus_long_long_generic(Caller, CLM_case) \
+ mus_xen *gn; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
+ return(C_llong_to_Xen_llong(CLM_case(gn->gen)));
+
+#define mus_set_long_long_generic(Caller, CLM_case) \
+ mus_xen *gn; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ if (!gn) Xen_check_type(false, gen, 1, S_set Caller, "a generator"); \
+ Xen_check_type(Xen_is_integer(val), val, 2, S_set Caller, "an integer"); \
+ CLM_case(gn->gen, Xen_llong_to_C_llong(val)); \
+ return(val);
+
+#define mus_int_generic(Caller, CLM_case) \
+ mus_xen *gn; \
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag); \
+ if (!gn) Xen_check_type(false, gen, 1, Caller, "a generator"); \
+ return(C_int_to_Xen_integer(CLM_case(gn->gen)));
+
+#endif
+
+#if HAVE_SCHEME
+static Xen sym_frequency, sym_phase, sym_scaler, sym_increment, sym_width, sym_offset, sym_feedforward, sym_feedback;
+#endif
+
+static Xen g_mus_frequency(Xen gen)
{
- #define H_mus_describe "(" S_mus_describe " gen): return a string describing the state of CLM generator generator"
- char *str;
- XEN result;
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_describe));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_describe, "a generator");
- str = mus_describe(XEN_TO_MUS_ANY(gen));
- result = C_TO_XEN_STRING(str);
- if (str) free(str);
- return(result);
+ #define H_mus_frequency "(" S_mus_frequency " gen): gen's frequency (Hz)"
+ mus_double_generic(S_mus_frequency, mus_frequency, sym_frequency);
}
-
-static XEN g_mus_reset(XEN gen)
+static Xen g_mus_set_frequency(Xen gen, Xen val)
{
- #define H_mus_reset "(" S_mus_reset " gen): clear out gen, setting it to its default starting state"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_reset));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_reset, "a generator");
- mus_reset(XEN_TO_MUS_ANY(gen));
- return(gen);
+ mus_set_double_generic(S_mus_frequency, mus_set_frequency);
}
-static XEN g_mus_phase(XEN gen)
+static Xen g_mus_phase(Xen gen)
{
#define H_mus_phase "(" S_mus_phase " gen): gen's current phase (radians)"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_phase));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_phase, "a generator");
- return(C_TO_XEN_DOUBLE(mus_phase(XEN_TO_MUS_ANY(gen))));
+ mus_double_generic(S_mus_phase, mus_phase, sym_phase);
}
-
-static XEN g_mus_set_phase(XEN gen, XEN val)
+static Xen g_mus_set_phase(Xen gen, Xen val)
{
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_phase));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_phase, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_phase, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_phase(XEN_TO_MUS_ANY(gen), XEN_TO_C_DOUBLE(val))));
+ mus_set_double_generic(S_mus_phase, mus_set_phase);
}
-static XEN g_mus_scaler(XEN gen)
+static Xen g_mus_scaler(Xen gen)
{
#define H_mus_scaler "(" S_mus_scaler " gen): gen's scaler, if any. This is often an amplitude adjustment of some sort."
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_scaler));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_scaler, "a generator");
- return(C_TO_XEN_DOUBLE(mus_scaler(XEN_TO_MUS_ANY(gen))));
+ mus_double_generic(S_mus_scaler, mus_scaler, sym_scaler);
}
-
-static XEN g_mus_set_scaler(XEN gen, XEN val)
+static Xen g_mus_set_scaler(Xen gen, Xen val)
{
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_scaler));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_scaler, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_scaler, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_scaler(XEN_TO_MUS_ANY(gen), XEN_TO_C_DOUBLE(val))));
+ mus_set_double_generic(S_mus_scaler, mus_set_scaler);
}
-static XEN g_mus_safety(XEN gen)
+static Xen g_mus_feedforward(Xen gen)
{
- #define H_mus_safety "(" S_mus_safety " gen): gen's safety setting, if any."
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_safety));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_safety, "a generator");
- return(C_TO_XEN_INT(mus_safety(XEN_TO_MUS_ANY(gen))));
+ #define H_mus_feedforward "(" S_mus_feedforward " gen): gen's feedforward field"
+ mus_double_generic(S_mus_feedforward, mus_scaler, sym_feedforward);
}
-
-static XEN g_mus_set_safety(XEN gen, XEN val)
+static Xen g_mus_set_feedforward(Xen gen, Xen val)
{
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_safety));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_safety, "a generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, S_setB S_mus_safety, "an integer");
- return(C_TO_XEN_INT(mus_set_safety(XEN_TO_MUS_ANY(gen), XEN_TO_C_INT(val))));
+ mus_set_double_generic(S_mus_feedforward, mus_set_scaler);
}
-static XEN g_mus_feedforward(XEN gen)
+static Xen g_mus_feedback(Xen gen)
{
- #define H_mus_feedforward "(" S_mus_feedforward " gen): gen's feedforward field"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_feedforward));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_feedforward, "a generator");
- return(C_TO_XEN_DOUBLE(mus_feedforward(XEN_TO_MUS_ANY(gen))));
+ #define H_mus_feedback "(" S_mus_feedback " gen): gen's " S_mus_feedback " field"
+ mus_double_generic(S_mus_feedback, mus_increment, sym_feedback);
}
-
-static XEN g_mus_set_feedforward(XEN gen, XEN val)
+static Xen g_mus_set_feedback(Xen gen, Xen val)
{
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_feedforward));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_feedforward, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_feedforward, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_feedforward(XEN_TO_MUS_ANY(gen), XEN_TO_C_DOUBLE(val))));
+ mus_set_double_generic(S_mus_feedback, mus_set_increment);
}
-static XEN g_mus_width(XEN gen)
+static Xen g_mus_width(Xen gen)
{
#define H_mus_width "(" S_mus_width " gen): gen's width, if any. This is usually a table size."
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_width));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_width, "a generator");
- return(C_TO_XEN_DOUBLE(mus_width(XEN_TO_MUS_ANY(gen))));
+ mus_double_generic(S_mus_width, mus_width, sym_width);
}
-
-static XEN g_mus_set_width(XEN gen, XEN val)
+static Xen g_mus_set_width(Xen gen, Xen val)
{
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_width));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_width, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_width, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_width(XEN_TO_MUS_ANY(gen), XEN_TO_C_DOUBLE(val))));
+ mus_set_double_generic(S_mus_width, mus_set_width);
}
-static XEN g_mus_offset(XEN gen)
+static Xen g_mus_offset(Xen gen)
{
#define H_mus_offset "(" S_mus_offset " gen): gen's offset, if any"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_offset));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_offset, "a generator");
- return(C_TO_XEN_DOUBLE(mus_offset(XEN_TO_MUS_ANY(gen))));
+ mus_double_generic(S_mus_offset, mus_offset, sym_offset);
}
-
-static XEN g_mus_set_offset(XEN gen, XEN val)
+static Xen g_mus_set_offset(Xen gen, Xen val)
{
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_offset));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_offset, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_offset, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_offset(XEN_TO_MUS_ANY(gen), XEN_TO_C_DOUBLE(val))));
+ mus_set_double_generic(S_mus_offset, mus_set_offset);
}
-static XEN g_mus_frequency(XEN gen)
+static Xen g_mus_increment(Xen gen)
{
- #define H_mus_frequency "(" S_mus_frequency " gen): gen's frequency (Hz)"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_frequency));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_frequency, "a generator");
- return(C_TO_XEN_DOUBLE(mus_frequency(XEN_TO_MUS_ANY(gen))));
+ #define H_mus_increment "(" S_mus_increment " gen): gen's " S_mus_increment " field, if any"
+ mus_double_generic(S_mus_increment, mus_increment, sym_increment);
}
-
-static XEN g_mus_set_frequency(XEN gen, XEN val)
+static Xen g_mus_set_increment(Xen gen, Xen val)
{
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_frequency));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_frequency, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_frequency, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_frequency(XEN_TO_MUS_ANY(gen), XEN_TO_C_DOUBLE(val))));
+ mus_set_double_generic(S_mus_increment, mus_set_increment);
}
-static XEN g_mus_run(XEN gen, XEN arg1, XEN arg2)
+static Xen g_mus_hop(Xen gen)
{
- #define H_mus_run "(" S_mus_run " gen :optional (arg1 0.0) (arg2 0.0)): apply gen to arg1 and arg2"
- if (XEN_LIST_P(gen)) return(call_get_method_3(gen, arg1, arg2, S_mus_run));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_mus_run, "a generator");
- return(C_TO_XEN_DOUBLE(mus_run(XEN_TO_MUS_ANY(gen),
- (XEN_NUMBER_P(arg1)) ? XEN_TO_C_DOUBLE(arg1) : 0.0,
- (XEN_NUMBER_P(arg2)) ? XEN_TO_C_DOUBLE(arg2) : 0.0)));
+ #define H_mus_hop "(" S_mus_hop " gen): gen's " S_mus_hop " field"
+ mus_long_long_generic(S_mus_hop, mus_hop);
+}
+
+static Xen g_mus_set_hop(Xen gen, Xen val)
+{
+ mus_set_long_long_generic(S_mus_hop, mus_set_hop);
}
-XEN g_mus_length(XEN gen)
+static Xen g_mus_ramp(Xen gen)
{
- #define H_mus_length "(" S_mus_length " gen): gen's length, if any"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_length));
- if (MUS_XEN_P(gen))
- return(C_TO_XEN_INT64_T(mus_length(XEN_TO_MUS_ANY(gen))));
- if (MUS_VCT_P(gen))
- return(C_TO_XEN_INT((XEN_TO_VCT(gen))->length));
- if (sound_data_p(gen))
- return(C_TO_XEN_INT((XEN_TO_SOUND_DATA(gen))->length));
+ #define H_mus_ramp "(" S_mus_ramp " gen): granulate generator's " S_mus_ramp " field"
+ mus_long_long_generic(S_mus_ramp, mus_ramp);
+}
- XEN_ASSERT_TYPE(false, gen, XEN_ONLY_ARG, S_mus_length, "a generator, vct, or sound-data object");
- return(XEN_FALSE); /* make compiler happy */
+static Xen g_mus_set_ramp(Xen gen, Xen val)
+{
+ mus_set_long_long_generic(S_mus_ramp, mus_set_ramp);
}
-static XEN g_mus_set_length(XEN gen, XEN val)
+static Xen g_mus_location(Xen gen)
{
- mus_long_t len;
- mus_any *ptr;
- mus_xen *ms;
+ #define H_mus_location "(" S_mus_location " gen): gen's " S_mus_location " field, if any"
+ mus_long_long_generic(S_mus_location, mus_location);
+}
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_length));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_length, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_length, "a number");
+static Xen g_mus_set_location(Xen gen, Xen val)
+{
+ mus_set_long_long_generic(S_mus_location, mus_set_location);
+}
- len = XEN_TO_C_INT64_T_OR_ELSE(val, 0);
- if (len <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_mus_length, XEN_ONLY_ARG, val, "must be > 0");
- ptr = XEN_TO_MUS_ANY(gen);
- if ((ptr) && (!mus_env_p(ptr)) && (!mus_src_p(ptr))) /* set length doesn't refer to data vct here */
- {
- if ((ptr->core->set_length) && (ptr->core->set_data)) /* else throw error below (backwards compatibility) */
- {
- ms = XEN_TO_MUS_XEN(gen);
- if ((ms->vcts) && (!(XEN_EQ_P(ms->vcts[MUS_DATA_WRAPPER], XEN_UNDEFINED))))
- {
- vct *v;
- v = XEN_TO_VCT(ms->vcts[MUS_DATA_WRAPPER]);
- if ((v) && (len > v->length))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_mus_length, XEN_ONLY_ARG, val, "must be <= current data size");
- /* set_offset refers only to env, set_width only to square_wave et al, set_location only readin */
- /* filters are protected by keeping allocated_size and not allowing arrays to be set */
- }
- }
- }
- return(C_TO_XEN_INT64_T(mus_set_length(ptr, len)));
+static Xen g_mus_order(Xen gen)
+{
+ #define H_mus_order "(" S_mus_order " gen): gen's order, if any"
+ mus_long_long_generic(S_mus_order, mus_length);
}
-static XEN g_mus_order(XEN gen)
+static Xen g_mus_channel(Xen gen)
{
- #define H_mus_order "(" S_mus_order " gen): gen's order, if any"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_order));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_order, "a generator");
- return(C_TO_XEN_INT64_T(mus_order(XEN_TO_MUS_ANY(gen))));
+ #define H_mus_channel "(" S_mus_channel " gen): gen's " S_mus_channel " field, if any"
+ mus_int_generic(S_mus_channel, mus_channel);
}
-static XEN g_mus_name(XEN gen)
+static Xen g_mus_interp_type(Xen gen)
{
- #define H_mus_name "(" S_mus_name " gen): gen's (type) name, if any"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_name));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_name, "a generator");
- return(C_TO_XEN_STRING(mus_name(XEN_TO_MUS_ANY(gen))));
+ #define H_mus_interp_type "(" S_mus_interp_type " gen): gen's " S_mus_interp_type " field, if any"
+ mus_int_generic(S_mus_interp_type, mus_channels);
}
-static XEN g_mus_set_name(XEN gen, XEN name)
+static Xen g_mus_type(Xen gen)
{
- if (XEN_LIST_P(gen)) return(call_set_method(gen, name, S_mus_name));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_name, "a generator");
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_2, S_setB S_mus_name, "a string");
- return(C_TO_XEN_STRING(mus_set_name(XEN_TO_MUS_ANY(gen), (const char *)(XEN_TO_C_STRING(name)))));
+ #define H_mus_type "(" S_mus_type " gen): gen's type"
+ mus_int_generic(S_mus_type, mus_type);
}
-XEN g_mus_data(XEN gen)
+static Xen g_mus_name(Xen gen)
{
- #define H_mus_data "(" S_mus_data " gen): gen's internal data (a vct), if any"
+ #define H_mus_name "(" S_mus_name " gen): gen's (type) name, if any"
mus_xen *ms;
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_data));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_data, "a generator");
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ return(C_string_to_Xen_string(mus_name(mus_xen_to_mus_any(ms))));
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-name"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_mus_name, "a generator");
+ return(gen);
+}
+
- ms = XEN_TO_MUS_XEN(gen);
- if (ms->vcts)
- return(ms->vcts[MUS_DATA_WRAPPER]);
- else return(XEN_FALSE);
+Xen g_mus_file_name(Xen gen)
+{
+ #define H_mus_file_name "(" S_mus_file_name " gen): file associated with gen, if any"
+ mus_xen *gn;
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (gn)
+ return(C_string_to_Xen_string(mus_file_name(gn->gen)));
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, S_mus_file_name));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_mus_file_name, "a generator");
+ return(gen);
}
-static XEN g_mus_set_data(XEN gen, XEN val)
+Xen g_mus_data(Xen gen)
{
+ #define H_mus_data "(" S_mus_data " gen): gen's internal data (a " S_vct "), if any"
mus_xen *ms;
- if (XEN_LIST_P(gen)) return(call_set_method(gen, val, S_mus_data));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_data, "a generator");
- XEN_ASSERT_TYPE((MUS_VCT_P(val)), val, XEN_ARG_2, S_setB S_mus_data, "a vct");
-
- ms = XEN_TO_MUS_XEN(gen);
- if (ms->vcts)
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
{
- vct *v;
- mus_any *ma;
- v = XEN_TO_VCT(val);
- ma = ms->gen;
- mus_set_data(ma, v->data); /* TO REMEMBER: if allocated, should have freed, and set to not allocated */
- ms->vcts[MUS_DATA_WRAPPER] = val;
- return(val);
+ if (ms->vcts)
+ return(ms->vcts[MUS_DATA_WRAPPER]);
+ else return(Xen_false);
}
- return(XEN_FALSE);
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, S_mus_data));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_mus_data, "a generator");
+ return(gen);
}
-enum {G_FILTER_STATE, G_FILTER_XCOEFFS, G_FILTER_YCOEFFS};
-/* G_FILTER_STATE must = MUS_DATA_WRAPPER = 0 */
-
-
-static XEN g_mus_xcoeffs(XEN gen)
+static Xen g_mus_set_data(Xen gen, Xen val)
{
- #define H_mus_xcoeffs "(" S_mus_xcoeffs " gen): gen's filter xcoeffs (vct of coefficients on inputs)"
mus_xen *ms;
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_xcoeffs));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_xcoeffs, "a generator");
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ {
+ Xen_check_type((mus_is_vct(val)), val, 2, S_set S_mus_data, "a " S_vct);
+ if (ms->vcts)
+ {
+ vct *v;
+ mus_any *ma;
+ v = Xen_to_vct(val);
+ ma = ms->gen;
+ mus_set_data(ma, mus_vct_data(v)); /* TO REMEMBER: if allocated, should have freed, and set to not allocated */
+ ms->vcts[MUS_DATA_WRAPPER] = val;
+ return(val);
+ }
+ }
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-data"));
+ if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
+ return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val)));
+ }
+#endif
- ms = XEN_TO_MUS_XEN(gen);
- if ((ms->vcts) && (ms->nvcts > G_FILTER_XCOEFFS))
- return(ms->vcts[G_FILTER_XCOEFFS]);
- /* no wrapper -- locsig/ssb-am, all smpflts have xcoeffs, latter have ycoeffs, but how to get array size? */
- return(XEN_FALSE);
+ Xen_check_type(false, gen, 1, S_set S_mus_data, "a generator with a data field");
+ return(Xen_false);
}
-static XEN g_mus_ycoeffs(XEN gen)
+static Xen c_xcoeffs(mus_xen *ms)
{
- #define H_mus_ycoeffs "(" S_mus_ycoeffs " gen): gen's filter ycoeffs (vct of coefficients on outputs)"
- mus_xen *ms;
+ mus_any *g;
+ g = ms->gen;
+ if (ms->vcts)
+ {
+ if (mus_is_polywave(g))
+ return(ms->vcts[0]);
+ if (ms->nvcts > G_FILTER_XCOEFFS)
+ return(ms->vcts[G_FILTER_XCOEFFS]);
+ }
+ if ((mus_is_one_zero(g)) ||
+ (mus_is_one_pole(g)) ||
+ (mus_is_two_zero(g)) ||
+ (mus_is_two_pole(g)))
+ return(xen_make_vct_wrapper(3, mus_xcoeffs(g)));
+ return(Xen_false);
+}
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_ycoeffs));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_ycoeffs, "a generator");
+static Xen g_mus_xcoeffs(Xen gen)
+{
+ #define H_mus_xcoeffs "(" S_mus_xcoeffs " gen): gen's filter xcoeffs (" S_vct " of coefficients on inputs)"
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms) return(c_xcoeffs(ms));
- ms = XEN_TO_MUS_XEN(gen);
- if ((ms->vcts) && (ms->nvcts > G_FILTER_YCOEFFS))
- return(ms->vcts[G_FILTER_YCOEFFS]);
- return(XEN_FALSE);
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeffs"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_mus_xcoeffs, "a generator");
+ return(gen);
}
-static XEN g_mus_xcoeff(XEN gen, XEN index)
+static Xen g_mus_ycoeffs(Xen gen)
{
- int ind;
- #define H_mus_xcoeff "(" S_mus_xcoeff " gen index): gen's filter xcoeff value at index (0-based)"
- if (XEN_LIST_P(gen)) return(call_get_method_2(gen, index, S_mus_xcoeff));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_mus_xcoeff, "a generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(index), index, XEN_ARG_2, S_mus_xcoeff, "an int");
- ind = XEN_TO_C_INT(index);
- if (ind < 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_xcoeff, XEN_ARG_2, index, "index must be non-negative");
- return(C_TO_XEN_DOUBLE(mus_xcoeff(XEN_TO_MUS_ANY(gen), ind)));
+ #define H_mus_ycoeffs "(" S_mus_ycoeffs " gen): gen's filter ycoeffs (" S_vct " of coefficients on outputs)"
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ {
+ mus_any *g;
+ g = ms->gen;
+ if (ms->vcts)
+ {
+ if ((mus_is_polywave(Xen_to_mus_any(gen))) && (ms->nvcts == 2))
+ return(ms->vcts[1]);
+ if (ms->nvcts > G_FILTER_YCOEFFS)
+ return(ms->vcts[G_FILTER_YCOEFFS]);
+ }
+ if ((mus_is_one_zero(g)) ||
+ (mus_is_one_pole(g)) ||
+ (mus_is_two_zero(g)) ||
+ (mus_is_two_pole(g)))
+ return(xen_make_vct_wrapper(3, mus_ycoeffs(g)));
+ return(Xen_false);
+ }
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeffs"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_mus_ycoeffs, "a generator");
+ return(gen);
}
-static XEN g_mus_set_xcoeff(XEN gen, XEN index, XEN val)
+static Xen g_mus_xcoeff(Xen gen, Xen index)
{
- int ind;
- if (XEN_LIST_P(gen)) return(call_set_method_2(gen, index, val, S_setB S_mus_xcoeff));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_xcoeff, "a generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(index), index, XEN_ARG_2, S_setB S_mus_xcoeff, "an int");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_3, S_setB S_mus_xcoeff, "a number");
- ind = XEN_TO_C_INT(index);
- if (ind < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_mus_xcoeff, XEN_ARG_2, index, "index must be non-negative");
- return(C_TO_XEN_DOUBLE(mus_set_xcoeff(XEN_TO_MUS_ANY(gen), ind, XEN_TO_C_DOUBLE(val))));
+ #define H_mus_xcoeff "(" S_mus_xcoeff " gen index): gen's filter xcoeff value at index (0-based)"
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ {
+ int ind = 0;
+ Xen_to_C_integer_or_error(index, ind, S_mus_xcoeff, 2);
+ if (ind < 0)
+ Xen_out_of_range_error(S_mus_xcoeff, 2, index, "index must be non-negative");
+ return(C_double_to_Xen_real(mus_xcoeff(mus_xen_to_mus_any(ms), ind)));
+ }
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeff"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 2, gen, index)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_mus_xcoeff, "a generator");
+ return(index);
}
-static XEN g_mus_ycoeff(XEN gen, XEN index)
+static Xen g_mus_set_xcoeff(Xen gen, Xen index, Xen val)
{
- int ind;
- #define H_mus_ycoeff "(" S_mus_ycoeff " gen index): gen's filter ycoeff value at index (0-based)"
- if (XEN_LIST_P(gen)) return(call_get_method_2(gen, index, S_mus_ycoeff));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_mus_ycoeff, "a generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(index), index, XEN_ARG_2, S_mus_ycoeff, "an int");
- ind = XEN_TO_C_INT(index);
- if (ind < 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_ycoeff, XEN_ARG_2, index, "index must be non-negative");
- return(C_TO_XEN_DOUBLE(mus_ycoeff(XEN_TO_MUS_ANY(gen), ind)));
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ {
+ int ind = 0;
+ mus_float_t x;
+ Xen_to_C_integer_or_error(index, ind, S_set S_mus_xcoeff, 2);
+ Xen_to_C_double_or_error(val, x, S_set S_mus_xcoeff, 3);
+ if (ind < 0)
+ Xen_out_of_range_error(S_set S_mus_xcoeff, 2, index, "index must be non-negative");
+ mus_set_xcoeff(mus_xen_to_mus_any(ms), ind, x);
+ return(val);
+ }
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-xcoeff"));
+ if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
+ return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 3, gen, index, val)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_set S_mus_xcoeff, "a generator");
+ return(val);
}
-static XEN g_mus_set_ycoeff(XEN gen, XEN index, XEN val)
+static Xen g_mus_ycoeff(Xen gen, Xen index)
{
- int ind;
- if (XEN_LIST_P(gen)) return(call_set_method_2(gen, index, val, S_setB S_mus_ycoeff));
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ARG_1, S_setB S_mus_ycoeff, "a generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(index), index, XEN_ARG_2, S_setB S_mus_ycoeff, "an int");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_3, S_setB S_mus_ycoeff, "a number");
- ind = XEN_TO_C_INT(index);
- if (ind < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_mus_ycoeff, XEN_ARG_2, index, "index must be non-negative");
- return(C_TO_XEN_DOUBLE(mus_set_ycoeff(XEN_TO_MUS_ANY(gen), ind, XEN_TO_C_DOUBLE(val))));
+ #define H_mus_ycoeff "(" S_mus_ycoeff " gen index): gen's filter ycoeff value at index (0-based)"
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ {
+ int ind = 0;
+ Xen_to_C_integer_or_error(index, ind, S_mus_ycoeff, 2);
+ if (ind < 0)
+ Xen_out_of_range_error(S_mus_ycoeff, 2, index, "index must be non-negative");
+ return(C_double_to_Xen_real(mus_ycoeff(mus_xen_to_mus_any(ms), ind)));
+ }
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeff"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 2, gen, index)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_mus_ycoeff, "a generator");
+ return(index);
}
-XEN g_mus_file_name(XEN gen)
+static Xen g_mus_set_ycoeff(Xen gen, Xen index, Xen val)
{
- #define H_mus_file_name "(" S_mus_file_name " gen): file associated with gen, if any"
- if (XEN_LIST_P(gen)) return(call_get_method(gen, S_mus_file_name));
+ mus_xen *ms;
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(gen))
- gen = s7_thread_variable(s7, gen);
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
+ {
+ int ind = 0;
+ mus_float_t x;
+ Xen_to_C_integer_or_error(index, ind, S_set S_mus_ycoeff, 2);
+ Xen_to_C_double_or_error(val, x, S_set S_mus_ycoeff, 3);
+ if (ind < 0)
+ Xen_out_of_range_error(S_set S_mus_ycoeff, 2, index, "index must be non-negative");
+ mus_set_ycoeff(mus_xen_to_mus_any(ms), ind, x);
+ return(val);
+ }
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-ycoeff"));
+ if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
+ return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 3, gen, index, val)));
+ }
#endif
-
- XEN_ASSERT_TYPE(MUS_XEN_P(gen), gen, XEN_ONLY_ARG, S_mus_file_name, "a generator");
- return(C_TO_XEN_STRING(mus_file_name(XEN_TO_MUS_ANY(gen))));
+ Xen_check_type(false, gen, 1, S_set S_mus_ycoeff, "a generator");
+ return(val);
}
+Xen g_mus_channels(Xen gen)
+{
+ #define H_mus_channels "(" S_mus_channels " gen): gen's " S_mus_channels " field, if any"
+ mus_xen *gn;
-/* ---------------- oscil ---------------- */
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (gn)
+ return(C_int_to_Xen_integer(mus_channels(gn->gen)));
-#if (!HAVE_SCHEME)
-static XEN g_make_oscil(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+#if HAVE_SCHEME
+ if (mus_is_vct(gen))
+ {
+ if (Xen_vector_rank(gen) > 1)
+ return(C_int_to_Xen_integer(s7_vector_dimensions(gen)[0]));
+ else return(C_int_to_Xen_integer(1));
+ }
+#else
+ if (mus_is_vct(gen))
+ return(C_int_to_Xen_integer(1));
+#endif
+
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-channels"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
+#endif
+
+ Xen_check_type(false, gen, 1, S_mus_channels, "an output generator, " S_vct ", or sound-data object");
+ return(Xen_false); /* make compiler happy */
+}
+
+
+Xen g_mus_length(Xen gen)
{
- #define H_make_oscil "(" S_make_oscil " (:frequency *clm-default-frequency*) (:initial-phase 0.0)): return a new " S_oscil " (sinewave) generator"
- mus_any *ge;
- int vals;
- XEN args[4];
- XEN keys[2];
- int orig_arg[2] = {0, 0};
- mus_float_t freq, phase = 0.0;
+ #define H_mus_length "(" S_mus_length " gen): gen's length, if any"
+ mus_xen *gn;
- freq = clm_default_frequency;
- keys[0] = kw_frequency;
- keys[1] = kw_initial_phase;
+ gn = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (gn)
+ return(C_llong_to_Xen_llong(mus_length(gn->gen)));
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
- vals = mus_optkey_unscramble(S_make_oscil, 2, keys, args, orig_arg);
- if (vals > 0)
+ if (mus_is_vct(gen))
+ return(C_int_to_Xen_integer(mus_vct_length(Xen_to_vct(gen))));
+
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-length"));
+ if (func != Xen_undefined) return(s7_apply_function(s7, func, s7_list(s7, 1, gen)));
+ }
+#endif
+
+ Xen_check_type(false, gen, 1, S_mus_length, "a generator, " S_vct ", or sound-data object");
+ return(Xen_false); /* make compiler happy */
+}
+
+
+static Xen g_mus_set_length(Xen gen, Xen val)
+{
+ mus_xen *ms;
+
+ ms = (mus_xen *)Xen_object_ref_checked(gen, mus_xen_tag);
+ if (ms)
{
- freq = mus_optkey_to_float(keys[0], S_make_oscil, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_oscil, orig_arg[0], keys[0], "freq ~A > srate/2?");
- phase = mus_optkey_to_float(keys[1], S_make_oscil, orig_arg[1], phase);
- }
+ mus_long_t len = 0;
+ mus_any *ptr = NULL;
- ge = mus_make_oscil(freq, phase);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ Xen_to_C_integer_or_error(val, len, S_set S_mus_length, 2);
+ if (len <= 0)
+ Xen_out_of_range_error(S_set S_mus_length, 1, val, "must be > 0");
+
+ ptr = ms->gen;
+ if ((!mus_is_env(ptr)) && (!mus_is_src(ptr))) /* set length doesn't refer to data vct here */
+ {
+ if ((ms->vcts) && (!(Xen_is_eq(ms->vcts[MUS_DATA_WRAPPER], Xen_undefined))))
+ {
+ vct *v;
+ v = Xen_to_vct(ms->vcts[MUS_DATA_WRAPPER]);
+ if ((v) && (len > mus_vct_length(v)))
+ Xen_out_of_range_error(S_set S_mus_length, 1, val, "must be <= current data size");
+ /* set_offset refers only to env, set_width only to square_wave et al, set_location only readin */
+ /* filters are protected by keeping allocated_size and not allowing arrays to be set */
+ }
+ }
+ mus_set_length(ptr, len);
+ return(val);
+ }
+#if HAVE_SCHEME
+ {
+ s7_pointer func;
+ func = s7_method(s7, gen, s7_make_symbol(s7, "mus-length"));
+ if ((func != Xen_undefined) && (s7_procedure_setter(s7, func)))
+ return(s7_apply_function(s7, s7_procedure_setter(s7, func), s7_list(s7, 2, gen, val)));
+ }
+#endif
+ Xen_check_type(false, gen, 1, S_set S_mus_length, "a generator");
+ return(val);
}
-#else
-static XEN g_make_oscil(XEN frequency, XEN initial_phase)
+
+
+
+/* ---------------- oscil ---------------- */
+
+static Xen g_make_oscil(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
- #define H_make_oscil "(" S_make_oscil " (:frequency *clm-default-frequency*) (:initial-phase 0.0)): return a new " S_oscil " (sinewave) generator"
+ #define H_make_oscil "(" S_make_oscil " (frequency *clm-default-frequency*) (initial-phase 0.0)): return a new " S_oscil " (sinewave) generator"
mus_any *ge;
mus_float_t freq, phase = 0.0;
- if (XEN_FALSE_P(frequency))
- freq = clm_default_frequency;
- else
+ freq = clm_default_frequency;
+ if (Xen_is_bound(arg1))
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(frequency), frequency, XEN_ARG_1, S_make_oscil, "a number");
- freq = XEN_TO_C_DOUBLE(frequency);
- if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_oscil, XEN_ARG_1, frequency, "freq ~A > srate/2?");
+ if (!Xen_is_bound(arg2))
+ {
+ Xen_check_type(Xen_is_number(arg1), arg1, 1, S_make_oscil, "a number");
+ freq = Xen_real_to_C_double(arg1);
+ if (freq > (0.5 * mus_srate()))
+ Xen_out_of_range_error(S_make_oscil, 1, arg1, "freq > srate/2?");
+ }
+ else
+ {
+ int vals;
+ Xen args[4];
+ Xen keys[2];
+ int orig_arg[2] = {0, 0};
+ keys[0] = kw_frequency;
+ keys[1] = kw_initial_phase;
+
+ args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
+ vals = mus_optkey_unscramble(S_make_oscil, 2, keys, args, orig_arg);
+ if (vals > 0)
+ {
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_oscil, orig_arg[0], freq);
+ if (freq > (0.5 * mus_srate()))
+ Xen_out_of_range_error(S_make_oscil, orig_arg[0], keys[0], "freq > srate/2?");
+ phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_oscil, orig_arg[1], phase);
+ }
+ }
}
-
- XEN_ASSERT_TYPE(XEN_NUMBER_P(initial_phase), initial_phase, XEN_ARG_2, S_make_oscil, "a number");
- phase = XEN_TO_C_DOUBLE(initial_phase);
-
+
ge = mus_make_oscil(freq, phase);
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-#endif
-static XEN g_oscil(XEN os, XEN fm, XEN pm)
+static Xen g_oscil(Xen osc, Xen fm, Xen pm)
{
- #define H_oscil "(" S_oscil " gen :optional (fm 0.0) (pm 0.0)): next sample from " S_oscil " gen: val = sin(phase + pm); phase += (freq + fm)"
- mus_float_t fm1 = 0.0, pm1 = 0.0;
+ #define H_oscil "(" S_oscil " gen (fm 0.0) (pm 0.0)): next sample from " S_oscil " gen: val = sin(phase + pm); phase += (freq + fm)"
+ #define Q_oscil s7_make_circular_signature(s7, 2, 3, s7_make_symbol(s7, "float?"), s7_make_symbol(s7, "oscil?"), s7_make_symbol(s7, "real?"))
- XEN_ASSERT_TYPE((MUS_XEN_P(os)) && (mus_oscil_p(XEN_TO_MUS_ANY(os))), os, XEN_ARG_1, S_oscil, "an oscil");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_oscil, "a number");
- if (XEN_NUMBER_P(pm)) pm1 = XEN_TO_C_DOUBLE(pm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(pm), pm, XEN_ARG_3, S_oscil, "a number");
+ mus_float_t fm1;
+ mus_any *g = NULL;
+ mus_xen *gn;
- return(C_TO_XEN_DOUBLE(mus_oscil(XEN_TO_MUS_ANY(os), fm1, pm1)));
+ Xen_to_C_generator(osc, gn, g, mus_is_oscil, S_oscil, "an oscil");
+ if (!Xen_is_bound(fm))
+ return(C_double_to_Xen_real(mus_oscil_unmodulated(g)));
+ if (!Xen_is_bound(pm))
+ return(C_double_to_Xen_real(mus_oscil_fm(g, Xen_real_to_C_double(fm))));
+ fm1 = Xen_real_to_C_double(fm);
+ if (fm1 == 0.0)
+ return(C_double_to_Xen_real(mus_oscil_pm(g, Xen_real_to_C_double(pm))));
+ return(C_double_to_Xen_real(mus_oscil(g, fm1, Xen_real_to_C_double(pm))));
}
-static XEN g_oscil_p(XEN os)
+static Xen g_is_oscil(Xen os)
{
- #define H_oscil_p "(" S_oscil_p " gen): " PROC_TRUE " if gen is an " S_oscil
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(os)) && (mus_oscil_p(XEN_TO_MUS_ANY(os)))));
+ #define H_is_oscil "(" S_is_oscil " gen): " PROC_TRUE " if gen is an " S_oscil
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_oscil(Xen_to_mus_any(os)))));
}
-static XEN g_mus_apply(XEN arglist)
+static Xen g_make_oscil_bank(Xen freqs, Xen phases, Xen amps, XEN stable)
{
- #define H_mus_apply "(" S_mus_apply " gen args...): apply gen to args"
- int arglist_len;
- mus_any *gen;
+ #define H_make_oscil_bank "(" S_make_oscil_bank " freqs phases amps stable): return a new oscil-bank generator. (freqs in radians)"
- arglist_len = XEN_LIST_LENGTH(arglist);
- if ((arglist_len > 3) || (arglist_len == 0))
- return(C_TO_XEN_DOUBLE(0.0));
+ mus_any *ge = NULL;
+ vct *f, *p, *a = NULL;
+ mus_xen *gn;
-#if HAVE_FORTH
- XEN_ASSERT_TYPE(MUS_XEN_P(XEN_CAR(arglist)), XEN_CAR(arglist), XEN_ARG_1, S_mus_apply, "a generator");
-#endif
- gen = XEN_TO_MUS_ANY(XEN_CAR(arglist));
- if (arglist_len == 1)
- return(C_TO_XEN_DOUBLE(mus_apply(gen, 0.0, 0.0)));
- if (arglist_len == 2)
- return(C_TO_XEN_DOUBLE(mus_apply(gen,
- XEN_TO_C_DOUBLE(XEN_CADR(arglist)),
- 0.0)));
- return(C_TO_XEN_DOUBLE(mus_apply(gen,
- XEN_TO_C_DOUBLE(XEN_CADR(arglist)),
- XEN_TO_C_DOUBLE(XEN_CADDR(arglist)))));
+ Xen_check_type(mus_is_vct(freqs), freqs, 1, S_make_oscil_bank, "a " S_vct);
+ Xen_check_type(mus_is_vct(phases), phases, 2, S_make_oscil_bank, "a " S_vct);
+ Xen_check_type(Xen_is_boolean_or_unbound(stable), stable, 3, S_make_oscil_bank, "a boolean");
+
+ f = Xen_to_vct(freqs);
+ p = Xen_to_vct(phases);
+ if (mus_is_vct(amps)) a = Xen_to_vct(amps);
+
+ ge = mus_make_oscil_bank(mus_vct_length(f), mus_vct_data(f), mus_vct_data(p), (a) ? mus_vct_data(a) : NULL, Xen_is_true(stable));
+ /* Xen_is_true looks specifically for #t */
+
+ gn = mx_alloc(3);
+ gn->gen = ge;
+ gn->vcts[0] = freqs;
+ gn->vcts[1] = phases;
+ gn->vcts[2] = amps;
+
+ return(mus_xen_to_object(gn));
+}
+
+
+static Xen g_is_oscil_bank(Xen os)
+{
+ #define H_is_oscil_bank "(" S_is_oscil_bank " gen): " PROC_TRUE " if gen is an " S_oscil_bank
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_oscil_bank(Xen_to_mus_any(os)))));
+}
+
+
+static Xen g_oscil_bank(Xen g)
+{
+ #define H_oscil_bank "(" S_oscil_bank " bank): sum an array of oscils"
+ mus_any *ob = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(g, gn, ob, mus_is_oscil_bank, S_oscil_bank, "an oscil-bank generator");
+ return(C_double_to_Xen_real(mus_oscil_bank(ob)));
}
+
/* ---------------- delay ---------------- */
-typedef enum {G_DELAY, G_COMB, G_NOTCH, G_ALL_PASS, G_MOVING_AVERAGE, G_FCOMB} xclm_delay_t;
+typedef enum {G_DELAY, G_COMB, G_NOTCH, G_ALL_PASS, G_FCOMB} xclm_delay_t;
-static XEN g_make_delay_1(xclm_delay_t choice, XEN arglist)
+static Xen g_make_delay_1(xclm_delay_t choice, Xen arglist)
{
mus_any *ge = NULL, *filt = NULL;
const char *caller = NULL;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[9];
- XEN xen_filt = XEN_FALSE;
+ Xen args[18];
+ Xen keys[9];
+ Xen xen_filt = Xen_false;
int orig_arg[9] = {0, 0, 0, 0, 0, 0, 0, (int)MUS_INTERP_NONE, 0};
- int vals, i, argn = 0, len = 0, arglist_len;
+ int vals, i, argn = 0;
mus_long_t max_size = -1, size = -1;
int interp_type = (int)MUS_INTERP_NONE;
mus_float_t *line = NULL;
mus_float_t scaler = 0.0, feedback = 0.0, feedforward = 0.0;
vct *initial_contents = NULL;
- XEN orig_v = XEN_FALSE; /* initial-contents can be a vct */
+ Xen orig_v = Xen_false; /* initial-contents can be a vct */
mus_float_t initial_element = 0.0;
int scaler_key = -1, feedback_key = -1, feedforward_key = -1, size_key = -1, initial_contents_key = -1;
int initial_element_key = -1, max_size_key = -1, interp_type_key = -1, filter_key = -1;
- bool size_set = false, max_size_set = false;
switch (choice)
{
- case G_DELAY: caller = S_make_delay; break;
- case G_MOVING_AVERAGE: caller = S_make_moving_average; break;
- case G_COMB: caller = S_make_comb; scaler_key = argn; keys[argn++] = kw_scaler; break;
- case G_FCOMB: caller = S_make_filtered_comb; scaler_key = argn; keys[argn++] = kw_scaler; break;
- case G_NOTCH: caller = S_make_notch; scaler_key = argn; keys[argn++] = kw_scaler; break;
+ case G_DELAY: caller = S_make_delay; break;
+ case G_COMB: caller = S_make_comb; scaler_key = argn; keys[argn++] = kw_scaler; break;
+ case G_FCOMB: caller = S_make_filtered_comb; scaler_key = argn; keys[argn++] = kw_scaler; break;
+ case G_NOTCH: caller = S_make_notch; scaler_key = argn; keys[argn++] = kw_scaler; break;
case G_ALL_PASS:
caller = S_make_all_pass;
feedback_key = argn;
@@ -1989,41 +2606,46 @@ static XEN g_make_delay_1(xclm_delay_t choice, XEN arglist)
interp_type_key = argn; keys[argn++] = kw_type;
filter_key = argn; keys[argn++] = kw_filter;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(caller, "too many args!", arglist);
+ {
+ Xen p;
+ int a2, arglist_len;
+ a2 = argn * 2;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > a2) clm_error(caller, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < a2; i++) args[i] = Xen_undefined;
+ }
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
vals = mus_optkey_unscramble(caller, argn, keys, args, orig_arg);
if (vals > 0)
{
+ bool size_set = false, max_size_set = false;
/* try to catch obvious type/range errors before allocations
* a major complication here is that size can be 0
*/
- if (!(XEN_KEYWORD_P(keys[size_key])))
+ if (!(Xen_is_keyword(keys[size_key])))
{
- size = mus_optkey_to_mus_long_t(keys[size_key], caller, orig_arg[size_key], size); /* size can be 0? -- surely we need a line in any case? */
+ size = Xen_optkey_to_mus_long_t(kw_size, keys[size_key], caller, orig_arg[size_key], size); /* size can be 0? -- surely we need a line in any case? */
if (size < 0)
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[size_key], keys[size_key], "size ~A < 0?");
+ Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size < 0?");
if (size > mus_max_table_size())
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[size_key], keys[size_key], "size ~A too large (see mus-max-table-size)");
+ Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size too large (see mus-max-table-size)");
size_set = true;
}
- if (!(XEN_KEYWORD_P(keys[max_size_key])))
+ if (!(Xen_is_keyword(keys[max_size_key])))
{
- max_size = mus_optkey_to_mus_long_t(keys[max_size_key], caller, orig_arg[max_size_key], max_size); /* -1 = unset */
+ max_size = Xen_optkey_to_mus_long_t(kw_max_size, keys[max_size_key], caller, orig_arg[max_size_key], max_size); /* -1 = unset */
if (max_size <= 0)
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[max_size_key], keys[max_size_key], "max-size ~A <= 0?");
+ Xen_out_of_range_error(caller, orig_arg[max_size_key], keys[max_size_key], "max-size <= 0?");
if (max_size > mus_max_table_size())
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[max_size_key], keys[max_size_key], "max-size ~A too large (see mus-max-table-size)");
+ Xen_out_of_range_error(caller, orig_arg[max_size_key], keys[max_size_key], "max-size too large (see mus-max-table-size)");
max_size_set = true;
}
- if (XEN_KEYWORD_P(keys[interp_type_key]))
+ if (Xen_is_keyword(keys[interp_type_key]))
{
/* if type not given, if max_size, assume linear interp (for possible tap), else no interp */
if ((max_size_set) && (max_size != size))
@@ -2032,83 +2654,84 @@ static XEN g_make_delay_1(xclm_delay_t choice, XEN arglist)
}
else
{
- interp_type = mus_optkey_to_int(keys[interp_type_key], caller, orig_arg[interp_type_key], (int)MUS_INTERP_LINEAR);
- if (!(mus_interp_type_p(interp_type)))
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[interp_type_key], keys[interp_type_key], "no such interp-type: ~A");
+ interp_type = Xen_optkey_to_int(kw_type, keys[interp_type_key], caller, orig_arg[interp_type_key], (int)MUS_INTERP_LINEAR);
+ if (!(mus_is_interp_type(interp_type)))
+ Xen_out_of_range_error(caller, orig_arg[interp_type_key], keys[interp_type_key], "no such interp-type");
}
- initial_element = mus_optkey_to_float(keys[initial_element_key], caller, orig_arg[initial_element_key], initial_element);
+ initial_element = Xen_optkey_to_float(kw_initial_element, keys[initial_element_key], caller, orig_arg[initial_element_key], initial_element);
switch (choice)
{
case G_DELAY:
- case G_MOVING_AVERAGE:
break;
case G_COMB: case G_NOTCH: case G_FCOMB:
- scaler = mus_optkey_to_float(keys[scaler_key], caller, orig_arg[scaler_key], scaler);
+ scaler = Xen_optkey_to_float(kw_scaler, keys[scaler_key], caller, orig_arg[scaler_key], scaler);
break;
case G_ALL_PASS:
- feedback = mus_optkey_to_float(keys[feedback_key], caller, orig_arg[feedback_key], feedback);
- feedforward = mus_optkey_to_float(keys[feedforward_key], caller, orig_arg[feedforward_key], feedforward);
+ feedback = Xen_optkey_to_float(kw_feedback, keys[feedback_key], caller, orig_arg[feedback_key], feedback);
+ feedforward = Xen_optkey_to_float(kw_feedforward, keys[feedforward_key], caller, orig_arg[feedforward_key], feedforward);
break;
}
- if (!(XEN_KEYWORD_P(keys[filter_key])))
+ if (!(Xen_is_keyword(keys[filter_key])))
{
if (choice != G_FCOMB)
clm_error(caller, "filter arg passed??", keys[filter_key]);
- XEN_ASSERT_TYPE(MUS_XEN_P(keys[filter_key]), keys[filter_key], orig_arg[filter_key], caller, "filter arg must be a generator");
+ Xen_check_type(mus_is_xen(keys[filter_key]), keys[filter_key], orig_arg[filter_key], caller, "filter arg must be a generator");
xen_filt = keys[filter_key];
- filt = XEN_TO_MUS_ANY(xen_filt);
+ filt = Xen_to_mus_any(xen_filt);
}
- if (!(XEN_KEYWORD_P(keys[initial_contents_key])))
+ if (!(Xen_is_keyword(keys[initial_contents_key])))
{
- if (!(XEN_KEYWORD_P(keys[initial_element_key])))
- XEN_OUT_OF_RANGE_ERROR(caller,
+ if (!(Xen_is_keyword(keys[initial_element_key])))
+ Xen_out_of_range_error(caller,
orig_arg[initial_contents_key],
keys[initial_contents_key],
"initial-contents and initial-element in same call?");
- if (MUS_VCT_P(keys[initial_contents_key]))
+ if (mus_is_vct(keys[initial_contents_key]))
{
- initial_contents = XEN_TO_VCT(keys[initial_contents_key]);
+ initial_contents = Xen_to_vct(keys[initial_contents_key]);
orig_v = keys[initial_contents_key];
}
else
{
- if (XEN_LIST_P_WITH_LENGTH(keys[initial_contents_key], len))
+ if (Xen_is_list(keys[initial_contents_key]))
{
- if (len == 0)
- XEN_ERROR(NO_DATA,
- XEN_LIST_2(C_TO_XEN_STRING("~A: initial-contents list empty?"),
- C_TO_XEN_STRING(caller)));
+ int len;
+ len = Xen_list_length(keys[initial_contents_key]);
+ if (len <= 0)
+ Xen_error(NO_DATA,
+ Xen_list_2(C_string_to_Xen_string("~A: initial-contents not a proper list?"),
+ C_string_to_Xen_string(caller)));
orig_v = xen_list_to_vct(keys[initial_contents_key]);
- initial_contents = XEN_TO_VCT(orig_v);
+ initial_contents = Xen_to_vct(orig_v);
/* do I need to protect this until we read its contents? -- no extlang stuff except error returns */
}
- else XEN_ASSERT_TYPE(XEN_FALSE_P(keys[initial_contents_key]),
+ else Xen_check_type(Xen_is_false(keys[initial_contents_key]),
keys[initial_contents_key],
orig_arg[initial_contents_key],
- caller, "a vct or a list");
+ caller, "a " S_vct " or a list");
}
if (initial_contents)
{
if (size_set)
{
- if (size > initial_contents->length)
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "size > initial-contents length");
+ if (size > mus_vct_length(initial_contents))
+ Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "size > initial-contents length");
}
- else size = initial_contents->length;
+ else size = mus_vct_length(initial_contents);
if (max_size_set)
{
- if (max_size > initial_contents->length)
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "max-size > initial-contents length");
+ if (max_size > mus_vct_length(initial_contents))
+ Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "max-size > initial-contents length");
}
- else max_size = initial_contents->length;
+ else max_size = mus_vct_length(initial_contents);
}
}
}
@@ -2120,26 +2743,23 @@ static XEN g_make_delay_1(xclm_delay_t choice, XEN arglist)
max_size = 1;
else max_size = size;
}
- if ((choice == G_MOVING_AVERAGE) && (max_size != size))
- {
- if (size == 0)
- XEN_OUT_OF_RANGE_ERROR(caller, 0, C_TO_XEN_INT64_T(size), "size = 0 for the " S_moving_average " generator is kinda loony?");
- else XEN_OUT_OF_RANGE_ERROR(caller, 0, C_TO_XEN_INT64_T(max_size), "max_size is irrelevant to the " S_moving_average " generator");
- }
if (initial_contents == NULL)
{
- line = (mus_float_t *)calloc(max_size, sizeof(mus_float_t));
+ line = (mus_float_t *)malloc(max_size * sizeof(mus_float_t));
if (line == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate delay line"));
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate delay line", caller));
orig_v = xen_make_vct(max_size, line);
- if (initial_element != 0.0)
- for (i = 0; i < max_size; i++)
- line[i] = initial_element;
+ if (initial_element != 0.0)
+ {
+ for (i = 0; i < max_size; i++)
+ line[i] = initial_element;
+ }
+ else memset((void *)line, 0, max_size * sizeof(mus_float_t));
}
else
{
- line = initial_contents->data;
+ line = mus_vct_data(initial_contents);
}
{
@@ -2147,12 +2767,11 @@ static XEN g_make_delay_1(xclm_delay_t choice, XEN arglist)
old_error_handler = mus_error_set_handler(local_mus_error);
switch (choice)
{
- case G_DELAY: ge = mus_make_delay(size, line, max_size, (mus_interp_t)interp_type); break;
- case G_MOVING_AVERAGE: ge = mus_make_moving_average(size, line); break;
- case G_COMB: ge = mus_make_comb(scaler, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_NOTCH: ge = mus_make_notch(scaler, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_ALL_PASS: ge = mus_make_all_pass(feedback, feedforward, size, line, max_size, (mus_interp_t)interp_type); break;
- case G_FCOMB: ge = mus_make_filtered_comb(scaler, size, line, max_size, (mus_interp_t)interp_type, filt); break;
+ case G_DELAY: ge = mus_make_delay(size, line, max_size, (mus_interp_t)interp_type); break;
+ case G_COMB: ge = mus_make_comb(scaler, size, line, max_size, (mus_interp_t)interp_type); break;
+ case G_NOTCH: ge = mus_make_notch(scaler, size, line, max_size, (mus_interp_t)interp_type); break;
+ case G_ALL_PASS: ge = mus_make_all_pass(feedback, feedforward, size, line, max_size, (mus_interp_t)interp_type); break;
+ case G_FCOMB: ge = mus_make_filtered_comb(scaler, size, line, max_size, (mus_interp_t)interp_type, filt); break;
}
mus_error_set_handler(old_error_handler);
}
@@ -2163,323 +2782,667 @@ static XEN g_make_delay_1(xclm_delay_t choice, XEN arglist)
return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, orig_v, xen_filt)));
}
- return(clm_mus_error(local_error_type, local_error_msg));
+ return(clm_mus_error(local_error_type, local_error_msg, caller));
}
-static XEN g_make_delay(XEN args)
+static Xen g_make_delay(Xen args)
{
- #define H_make_delay "(" S_make_delay " :size :initial-contents (:initial-element 0.0) (:max-size) (:type mus-interp-linear)): \
+ #define H_make_delay "(" S_make_delay " (size) (initial-contents) (initial-element 0.0) (max-size) (type mus-interp-linear)): \
return a new delay line of size elements. \
If the delay length will be changing at run-time, max-size sets its maximum length, so\n\
(" S_make_delay " len :max-size (+ len 10))\n\
provides 10 extra elements of delay for subsequent phasing or flanging. \
-initial-contents can be either a list or a vct."
+initial-contents can be either a list or a " S_vct "."
+
+ if ((Xen_is_pair(args)) && (!Xen_is_pair(Xen_cdr(args))))
+ {
+ Xen val, v;
+ mus_any *ge;
+ mus_long_t size, max_size;
+ mus_float_t *line;
+ mus_error_handler_t *old_error_handler;
+
+ val = Xen_car(args);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_make_delay, "an integer");
+ size = Xen_integer_to_C_int(val);
+ if (size < 0)
+ Xen_out_of_range_error(S_make_delay, 1, val, "size < 0?");
+ if (size > mus_max_table_size())
+ Xen_out_of_range_error(S_make_delay, 1, val, "size too large (see mus-max-table-size)");
+ if (size == 0) max_size = 1; else max_size = size;
+
+ line = (mus_float_t *)calloc(max_size, sizeof(mus_float_t));
+ v = xen_make_vct(max_size, line); /* we need this for mus-data */
+
+ old_error_handler = mus_error_set_handler(local_mus_error);
+ ge = mus_make_delay(size, line, max_size, MUS_INTERP_NONE);
+ mus_error_set_handler(old_error_handler);
+ if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, v)));
+ return(clm_mus_error(local_error_type, local_error_msg, S_make_delay));
+ }
return(g_make_delay_1(G_DELAY, args));
}
-static XEN g_make_comb(XEN args)
+static Xen g_make_comb(Xen args)
{
- #define H_make_comb "(" S_make_comb " :scaler :size :initial-contents (:initial-element 0.0) :max-size (:type " S_mus_interp_linear ")): \
+ #define H_make_comb "(" S_make_comb " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
return a new comb filter (a delay line with a scaler on the feedback) of size elements. \
If the comb length will be changing at run-time, max-size sets its maximum length. \
-initial-contents can be either a list or a vct."
+initial-contents can be either a list or a " S_vct "."
return(g_make_delay_1(G_COMB, args));
}
-static XEN g_make_filtered_comb(XEN args)
+static Xen g_make_filtered_comb(Xen args)
{
- #define H_make_filtered_comb "(" S_make_filtered_comb " :scaler :size :initial-contents (:initial-element 0.0) :max-size (:type " S_mus_interp_linear ") :filter): \
+ #define H_make_filtered_comb "(" S_make_filtered_comb " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ") :filter): \
return a new filtered comb filter (a delay line with a scaler and a filter on the feedback) of size elements. \
If the comb length will be changing at run-time, max-size sets its maximum length. \
-initial-contents can be either a list or a vct."
+initial-contents can be either a list or a " S_vct "."
return(g_make_delay_1(G_FCOMB, args));
}
-static XEN g_make_notch(XEN args)
+static Xen g_make_notch(Xen args)
{
- #define H_make_notch "(" S_make_notch " :scaler :size :initial-contents (:initial-element 0.0) :max-size (:type " S_mus_interp_linear ")): \
+ #define H_make_notch "(" S_make_notch " (scaler) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
return a new notch filter (a delay line with a scaler on the feedforward) of size elements. \
If the notch length will be changing at run-time, max-size sets its maximum length. \
-initial-contents can be either a list or a vct."
+initial-contents can be either a list or a " S_vct "."
return(g_make_delay_1(G_NOTCH, args));
}
-static XEN g_make_all_pass(XEN args)
+static Xen g_make_all_pass(Xen args)
{
- #define H_make_all_pass "(" S_make_all_pass " :feedback :feedforward :size :initial-contents (:initial-element 0.0) :max-size (:type " S_mus_interp_linear ")): \
+ #define H_make_all_pass "(" S_make_all_pass " (feedback) (feedforward) (size) (initial-contents) (initial-element 0.0) (max-size) (type " S_mus_interp_linear ")): \
return a new allpass filter (a delay line with a scalers on both the feedback and the feedforward). \
If the " S_all_pass " length will be changing at run-time, max-size sets its maximum length. \
-initial-contents can be either a list or a vct."
+initial-contents can be either a list or a " S_vct "."
return(g_make_delay_1(G_ALL_PASS, args));
}
-static XEN g_make_moving_average(XEN args)
+typedef enum {G_MOVING_AVERAGE, G_MOVING_MAX, G_MOVING_NORM} xclm_moving_t;
+
+static Xen g_make_moving_any(xclm_moving_t choice, const char *caller, Xen arglist)
{
- #define H_make_moving_average "(" S_make_moving_average " :size :initial-contents (:initial-element 0.0)): \
-return a new moving_average generator. initial-contents can be either a list or a vct."
+ mus_any *ge = NULL;
+ Xen args[8];
+ Xen keys[4];
+ int orig_arg[4] = {0, 0, 0, 0};
+ int vals, i, argn = 0, arglist_len;
+ mus_long_t size = -1;
+ mus_float_t scaler = 1.0, sum = 0.0;
+ vct *initial_contents = NULL;
+ Xen orig_v = Xen_false, p;
+ mus_float_t initial_element = 0.0;
+ mus_float_t *line = NULL;
+ int scaler_key = -1, size_key, initial_contents_key, initial_element_key;
+ mus_error_handler_t *old_error_handler;
- return(g_make_delay_1(G_MOVING_AVERAGE, args));
-}
+ size_key = argn;
+ keys[argn++] = kw_size;
+ if (choice == G_MOVING_NORM)
+ {
+ scaler_key = argn;
+ keys[argn++] = kw_scaler;
+ }
+ initial_contents_key = argn;
+ keys[argn++] = kw_initial_contents;
+ initial_element_key = argn;
+ keys[argn++] = kw_initial_element;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 8) clm_error(caller, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < argn * 2; i++) args[i] = Xen_undefined;
+ vals = mus_optkey_unscramble(caller, argn, keys, args, orig_arg);
-static XEN g_delay(XEN obj, XEN input, XEN pm)
-{
- #define H_delay "(" S_delay " gen :optional (val 0.0) (pm 0.0)): \
-delay val according to the delay line's length and pm ('phase-modulation'). \
-If pm is greater than 0.0, the max-size argument used to create gen should have accommodated its maximum value."
+ if (vals > 0)
+ {
+ bool size_set = false;
+ if (!(Xen_is_keyword(keys[size_key])))
+ {
+ size = Xen_optkey_to_mus_long_t(kw_size, keys[size_key], caller, orig_arg[size_key], size); /* size can be 0? -- surely we need a line in any case? */
+ if (size < 0)
+ Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size < 0?");
+ if (size > mus_max_table_size())
+ Xen_out_of_range_error(caller, orig_arg[size_key], keys[size_key], "size too large (see mus-max-table-size)");
+ size_set = true;
+ }
- mus_float_t in1 = 0.0, pm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_delay_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_delay, "a delay line");
- if (XEN_NUMBER_P(input)) in1 = XEN_TO_C_DOUBLE(input); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_delay, "a number");
- if (XEN_NUMBER_P(pm)) pm1 = XEN_TO_C_DOUBLE(pm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(pm), pm, XEN_ARG_3, S_delay, "a number");
- return(C_TO_XEN_DOUBLE(mus_delay(XEN_TO_MUS_ANY(obj), in1, pm1)));
-}
+ if (choice == G_MOVING_NORM)
+ scaler = Xen_optkey_to_float(kw_scaler, keys[scaler_key], caller, orig_arg[scaler_key], scaler);
+
+ initial_element = Xen_optkey_to_float(kw_initial_element, keys[initial_element_key], caller, orig_arg[initial_element_key], initial_element);
+ if (!(Xen_is_keyword(keys[initial_contents_key])))
+ {
+ if (!(Xen_is_keyword(keys[initial_element_key])))
+ Xen_out_of_range_error(caller,
+ orig_arg[initial_contents_key],
+ keys[initial_contents_key],
+ "initial-contents and initial-element in same call?");
+ if (mus_is_vct(keys[initial_contents_key]))
+ {
+ initial_contents = Xen_to_vct(keys[initial_contents_key]);
+ orig_v = keys[initial_contents_key];
+ }
+ else
+ {
+ if (Xen_is_list(keys[initial_contents_key]))
+ {
+ int len;
+ len = Xen_list_length(keys[initial_contents_key]);
+ if (len <= 0)
+ Xen_error(NO_DATA,
+ Xen_list_2(C_string_to_Xen_string("~A: initial-contents not a proper list?"),
+ C_string_to_Xen_string(caller)));
+
+ orig_v = xen_list_to_vct(keys[initial_contents_key]);
+ initial_contents = Xen_to_vct(orig_v);
+ /* do I need to protect this until we read its contents? -- no extlang stuff except error returns */
+ }
+ else Xen_check_type(Xen_is_false(keys[initial_contents_key]),
+ keys[initial_contents_key],
+ orig_arg[initial_contents_key],
+ caller, "a " S_vct " or a list");
+ }
+ if (initial_contents)
+ {
+ if (size_set)
+ {
+ if (size > mus_vct_length(initial_contents))
+ Xen_out_of_range_error(caller, orig_arg[initial_contents_key], keys[initial_contents_key], "size > initial-contents length");
+ }
+ else size = mus_vct_length(initial_contents);
+ }
+ }
+ }
+ if (size < 0) size = 1;
+ if (size == 0)
+ Xen_out_of_range_error(caller, 0, C_llong_to_Xen_llong(size), "size = 0?");
-static XEN g_delay_tick(XEN obj, XEN input)
-{
- #define H_delay_tick "(" S_delay_tick " gen :optional (val 0.0)): \
-delay val according to the delay line's length. This merely 'ticks' the delay line forward.\
-The argument 'val' is returned."
+ if (initial_contents == NULL)
+ {
+ line = (mus_float_t *)malloc(size * sizeof(mus_float_t));
+ if (line == NULL)
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate delay line", caller));
+ orig_v = xen_make_vct(size, line);
+ if (initial_element != 0.0)
+ {
+ for (i = 0; i < size; i++)
+ line[i] = initial_element;
+ sum = initial_element * size;
+ }
+ else memset((void *)line, 0, size * sizeof(mus_float_t));
+ }
+ else
+ {
+ line = mus_vct_data(initial_contents);
+ if ((line) && (choice == G_MOVING_AVERAGE))
+ {
+ sum = line[0];
+ for (i = 1; i < size; i++)
+ sum += line[i];
+ }
+ }
- mus_float_t in1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_delay_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_delay_tick, "a delay line");
- if (XEN_NUMBER_P(input)) in1 = XEN_TO_C_DOUBLE(input); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_delay_tick, "a number");
- return(C_TO_XEN_DOUBLE(mus_delay_tick(XEN_TO_MUS_ANY(obj), in1)));
+ old_error_handler = mus_error_set_handler(local_mus_error);
+ switch (choice)
+ {
+ case G_MOVING_AVERAGE: ge = mus_make_moving_average_with_initial_sum(size, line, sum); break;
+ case G_MOVING_MAX: ge = mus_make_moving_max(size, line); break;
+ case G_MOVING_NORM: ge = mus_make_moving_norm(size, line, scaler); break;
+ }
+ mus_error_set_handler(old_error_handler);
+
+ if (ge)
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
+ return(clm_mus_error(local_error_type, local_error_msg, caller));
}
-static XEN g_notch(XEN obj, XEN input, XEN pm)
+static Xen g_make_moving_average(Xen args)
{
- #define H_notch "(" S_notch " gen :optional (val 0.0) (pm 0.0)): notch filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_notch_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_notch, "a notch filter");
- if (XEN_NUMBER_P(input)) in1 = XEN_TO_C_DOUBLE(input); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_notch, "a number");
- if (XEN_NUMBER_P(pm)) pm1 = XEN_TO_C_DOUBLE(pm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(pm), pm, XEN_ARG_3, S_notch, "a number");
- return(C_TO_XEN_DOUBLE(mus_notch(XEN_TO_MUS_ANY(obj), in1, pm1)));
+ #define H_make_moving_average "(" S_make_moving_average " (size) (initial-contents) (initial-element 0.0)): \
+return a new moving_average generator. initial-contents can be either a list or a " S_vct "."
+
+ return(g_make_moving_any(G_MOVING_AVERAGE, S_make_moving_average, args));
}
-static XEN g_comb(XEN obj, XEN input, XEN pm)
+static Xen g_make_moving_max(Xen args)
{
- #define H_comb "(" S_comb " gen :optional (val 0.0) (pm 0.0)): comb filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_comb_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_comb, "a comb filter");
- if (XEN_NUMBER_P(input)) in1 = XEN_TO_C_DOUBLE(input); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_comb, "a number");
- if (XEN_NUMBER_P(pm)) pm1 = XEN_TO_C_DOUBLE(pm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(pm), pm, XEN_ARG_3, S_comb, "a number");
- return(C_TO_XEN_DOUBLE(mus_comb(XEN_TO_MUS_ANY(obj), in1, pm1)));
+ #define H_make_moving_max "(" S_make_moving_max " (size) (initial-contents) (initial-element 0.0)): \
+return a new moving-max generator. initial-contents can be either a list or a " S_vct "."
+
+ return(g_make_moving_any(G_MOVING_MAX, S_make_moving_max, args));
}
-static XEN g_filtered_comb(XEN obj, XEN input, XEN pm)
+static Xen g_make_moving_norm(Xen args)
{
- #define H_filtered_comb "(" S_filtered_comb " gen :optional (val 0.0) (pm 0.0)): filtered comb filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_filtered_comb_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_filtered_comb, "a filtered-comb filter");
- if (XEN_NUMBER_P(input)) in1 = XEN_TO_C_DOUBLE(input); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_filtered_comb, "a number");
- if (XEN_NUMBER_P(pm)) pm1 = XEN_TO_C_DOUBLE(pm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(pm), pm, XEN_ARG_3, S_filtered_comb, "a number");
- return(C_TO_XEN_DOUBLE(mus_filtered_comb(XEN_TO_MUS_ANY(obj), in1, pm1)));
+ #define H_make_moving_norm "(" S_make_moving_norm " (size (scaler 1.0))): return a new moving-norm generator."
+
+ return(g_make_moving_any(G_MOVING_NORM, S_make_moving_norm, args));
}
-static XEN g_all_pass(XEN obj, XEN input, XEN pm)
+static Xen g_delay(Xen obj, Xen input, Xen pm)
{
- #define H_all_pass "(" S_all_pass " gen :optional (val 0.0) (pm 0.0)): all-pass filter val, pm changes the delay length."
- mus_float_t in1 = 0.0, pm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_all_pass_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_all_pass, "an all-pass filter");
- if (XEN_NUMBER_P(input)) in1 = XEN_TO_C_DOUBLE(input); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_all_pass, "a number");
- if (XEN_NUMBER_P(pm)) pm1 = XEN_TO_C_DOUBLE(pm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(pm), pm, XEN_ARG_3, S_all_pass, "a number");
- return(C_TO_XEN_DOUBLE(mus_all_pass(XEN_TO_MUS_ANY(obj), in1, pm1)));
+ #define H_delay "(" S_delay " gen (val 0.0) (pm 0.0)): \
+delay val according to the delay line's length and pm ('phase-modulation'). \
+If pm is greater than 0.0, the max-size argument used to create gen should have accommodated its maximum value."
+
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_delay, S_delay, "a delay line");
+ if (!Xen_is_bound(input))
+ return(C_double_to_Xen_real(mus_delay_unmodulated(g, 0.0)));
+ if (!Xen_is_bound(pm))
+ return(C_double_to_Xen_real(mus_delay_unmodulated(g, Xen_real_to_C_double(input))));
+ return(C_double_to_Xen_real(mus_delay(g, Xen_real_to_C_double(input), Xen_real_to_C_double(pm))));
}
-static XEN g_moving_average(XEN obj, XEN input)
+static Xen g_delay_tick(Xen obj, Xen input)
{
- #define H_moving_average "(" S_moving_average " gen :optional (val 0.0)): moving window moving_average."
+ #define H_delay_tick "(" S_delay_tick " gen (val 0.0)): \
+delay val according to the delay line's length. This merely 'ticks' the delay line forward.\
+The argument 'val' is returned."
+
mus_float_t in1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_moving_average_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_moving_average, "a moving-average generator");
- if (XEN_NUMBER_P(input)) in1 = XEN_TO_C_DOUBLE(input); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_moving_average, "a number");
- return(C_TO_XEN_DOUBLE(mus_moving_average(XEN_TO_MUS_ANY(obj), in1)));
-}
+ mus_any *g = NULL;
+ mus_xen *gn;
+ Xen_to_C_generator(obj, gn, g, mus_is_delay, S_delay_tick, "a delay line");
+ Xen_real_to_C_double_if_bound(input, in1, S_delay_tick, 2);
-static XEN g_tap(XEN obj, XEN loc)
-{
- #define H_tap "(" S_tap " gen :optional (pm 0.0)): tap the " S_delay " generator offset by pm"
- mus_float_t dloc = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_delay_line_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_tap, "a delay line tap");
- if (XEN_NUMBER_P(loc)) dloc = XEN_TO_C_DOUBLE(loc); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(loc), loc, XEN_ARG_3, S_tap, "a number");
- return(C_TO_XEN_DOUBLE(mus_tap(XEN_TO_MUS_ANY(obj), dloc)));
+ return(C_double_to_Xen_real(mus_delay_tick(g, in1)));
}
-static XEN g_delay_p(XEN obj)
+static Xen g_notch(Xen obj, Xen input, Xen pm)
{
- #define H_delay_p "(" S_delay_p " gen): " PROC_TRUE " if gen is a delay line"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_delay_p(XEN_TO_MUS_ANY(obj)))));
-}
+ #define H_notch "(" S_notch " gen (val 0.0) (pm 0.0)): notch filter val, pm changes the delay length."
+
+ mus_float_t in1 = 0.0, pm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+ Xen_to_C_generator(obj, gn, g, mus_is_notch, S_notch, "a notch filter");
+ Xen_real_to_C_double_if_bound(input, in1, S_notch, 2);
+ Xen_real_to_C_double_if_bound(pm, pm1, S_notch, 3);
-static XEN g_comb_p(XEN obj)
-{
- #define H_comb_p "(" S_comb_p " gen): " PROC_TRUE " if gen is a comb filter"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_comb_p(XEN_TO_MUS_ANY(obj)))));
+ return(C_double_to_Xen_real(mus_notch(g, in1, pm1)));
}
-static XEN g_filtered_comb_p(XEN obj)
+static Xen g_comb(Xen obj, Xen input, Xen pm)
{
- #define H_filtered_comb_p "(" S_filtered_comb_p " gen): " PROC_TRUE " if gen is a filtered-comb filter"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_filtered_comb_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_comb "(" S_comb " gen (val 0.0) (pm 0.0)): comb filter val, pm changes the delay length."
+ mus_float_t in1 = 0.0, pm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_comb, S_comb, "a comb generator");
+ Xen_real_to_C_double_if_bound(input, in1, S_comb, 2);
+ Xen_real_to_C_double_if_bound(pm, pm1, S_comb, 3);
+
+ return(C_double_to_Xen_real(mus_comb(g, in1, pm1)));
}
-static XEN g_notch_p(XEN obj)
+static Xen g_make_comb_bank(Xen arg)
{
- #define H_notch_p "(" S_notch_p " gen): " PROC_TRUE " if gen is a notch filter"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_notch_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_make_comb_bank "(" S_make_comb_bank " gens): return a new comb-bank generator."
+
+ mus_any *ge = NULL;
+ mus_any **gens;
+ int i, j, size;
+
+ Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_comb_bank, "a vector of comb generators");
+
+ size = Xen_vector_length(arg);
+ if (size == 0) return(Xen_false);
+ gens = (mus_any **)calloc(size, sizeof(mus_any *));
+
+ for (i = 0, j = 0; i < size; i++)
+ {
+ Xen g;
+ g = Xen_vector_ref(arg, i);
+ if (mus_is_xen(g))
+ {
+ mus_any *fg;
+ fg = Xen_to_mus_any(g);
+ if (mus_is_comb(fg))
+ gens[j++] = fg;
+ }
+ }
+ if (j > 0)
+ ge = mus_make_comb_bank(j, gens);
+ free(gens);
+
+ if (ge)
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
+ return(Xen_false);
}
-static XEN g_all_pass_p(XEN obj)
+static Xen g_is_comb_bank(Xen os)
{
- #define H_all_pass_p "(" S_all_pass_p " gen): " PROC_TRUE " if gen is an all-pass filter"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_all_pass_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_comb_bank "(" S_is_comb_bank " gen): " PROC_TRUE " if gen is a " S_comb_bank
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_comb_bank(Xen_to_mus_any(os)))));
}
-static XEN g_moving_average_p(XEN obj)
+static Xen g_comb_bank(Xen gens, Xen inp)
{
- #define H_moving_average_p "(" S_moving_average_p " gen): " PROC_TRUE " if gen is a moving-average generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_moving_average_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_comb_bank "(" S_comb_bank " bank inval): sum an array of " S_comb " filters."
+ mus_any *bank = NULL;
+ mus_xen *gn;
+ mus_float_t x = 0.0;
+
+ Xen_to_C_generator(gens, gn, bank, mus_is_comb_bank, S_comb_bank, "a comb-bank generator");
+ Xen_real_to_C_double_if_bound(inp, x, S_comb_bank, 2);
+
+ return(C_double_to_Xen_real(mus_comb_bank(bank, x)));
}
-/* -------- ncos -------- */
-static XEN g_ncos_p(XEN obj)
+static Xen g_filtered_comb(Xen obj, Xen input, Xen pm)
{
- #define H_ncos_p "(" S_ncos_p " gen): " PROC_TRUE " if gen is an " S_ncos " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) &&
- (mus_ncos_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_filtered_comb "(" S_filtered_comb " gen (val 0.0) (pm 0.0)): filtered comb filter val, pm changes the delay length."
+ mus_float_t in1 = 0.0, pm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_filtered_comb, S_filtered_comb, "a filtered-comb generator");
+ Xen_real_to_C_double_if_bound(input, in1, S_filtered_comb, 2);
+ Xen_real_to_C_double_if_bound(pm, pm1, S_filtered_comb, 3);
+
+ return(C_double_to_Xen_real(mus_filtered_comb(g, in1, pm1)));
}
-#if (!HAVE_SCHEME)
-static XEN g_make_ncos(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen g_make_filtered_comb_bank(Xen arg)
{
- #define H_make_ncos "(" S_make_ncos " (:frequency *clm-default-frequency*) (:n 1)): \
-return a new " S_ncos " generator, producing a sum of 'n' equal amplitude cosines."
+ #define H_make_filtered_comb_bank "(" S_make_filtered_comb_bank " gens): return a new filtered_comb-bank generator."
- mus_any *ge;
- XEN args[4];
- XEN keys[2];
- int orig_arg[2] = {0, 0};
- int vals, n = 1;
- mus_float_t freq;
+ mus_any *ge = NULL;
+ mus_any **gens;
+ int i, j, size;
- freq = clm_default_frequency;
+ Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_filtered_comb_bank, "a vector of filtered_comb generators");
- keys[0] = kw_frequency;
- keys[1] = kw_n;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
+ size = Xen_vector_length(arg);
+ if (size == 0) return(Xen_false);
+ gens = (mus_any **)calloc(size, sizeof(mus_any *));
- vals = mus_optkey_unscramble(S_make_ncos, 2, keys, args, orig_arg);
- if (vals > 0)
+ for (i = 0, j = 0; i < size; i++)
{
- freq = mus_optkey_to_float(keys[0], S_make_ncos, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_ncos, orig_arg[0], keys[0], "freq ~A > srate/2?");
-
- n = mus_optkey_to_int(keys[1], S_make_ncos, orig_arg[1], n);
- if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_ncos, orig_arg[1], keys[1], "n: ~A?");
+ Xen g;
+ g = Xen_vector_ref(arg, i);
+ if (mus_is_xen(g))
+ {
+ mus_any *fg;
+ fg = Xen_to_mus_any(g);
+ if (mus_is_filtered_comb(fg))
+ gens[j++] = fg;
+ }
}
+ if (j > 0)
+ ge = mus_make_filtered_comb_bank(j, gens);
+ free(gens);
- ge = mus_make_ncos(freq, n);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ if (ge)
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
+ return(Xen_false);
}
-#else
-static XEN g_make_ncos(XEN frequency, XEN xn)
+static Xen g_is_filtered_comb_bank(Xen os)
{
- #define H_make_ncos "(" S_make_ncos " (:frequency *clm-default-frequency*) (:n 1)): \
-return a new " S_ncos " generator, producing a sum of 'n' equal amplitude cosines."
+ #define H_is_filtered_comb_bank "(" S_is_filtered_comb_bank " gen): " PROC_TRUE " if gen is a " S_filtered_comb_bank
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_filtered_comb_bank(Xen_to_mus_any(os)))));
+}
- mus_any *ge;
- int n = 1;
- mus_float_t freq;
- if (XEN_FALSE_P(frequency))
- freq = clm_default_frequency;
- else
+static Xen g_filtered_comb_bank(Xen gens, Xen inp)
+{
+ #define H_filtered_comb_bank "(" S_filtered_comb_bank " bank inval): sum an array of " S_filtered_comb " filters."
+ mus_any *bank = NULL;
+ mus_xen *gn;
+ mus_float_t x = 0.0;
+
+ Xen_to_C_generator(gens, gn, bank, mus_is_filtered_comb_bank, S_filtered_comb_bank, "a filtered-comb-bank generator");
+ Xen_real_to_C_double_if_bound(inp, x, S_filtered_comb_bank, 2);
+
+ return(C_double_to_Xen_real(mus_filtered_comb_bank(bank, x)));
+}
+
+
+
+static Xen g_all_pass(Xen obj, Xen input, Xen pm)
+{
+ #define H_all_pass "(" S_all_pass " gen (val 0.0) (pm 0.0)): all-pass filter val, pm changes the delay length."
+ mus_float_t in1 = 0.0, pm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_all_pass, S_all_pass, "an all-pass filter");
+ Xen_real_to_C_double_if_bound(input, in1, S_all_pass, 2);
+ Xen_real_to_C_double_if_bound(pm, pm1, S_all_pass, 3);
+
+ return(C_double_to_Xen_real(mus_all_pass(g, in1, pm1)));
+}
+
+
+static Xen g_make_all_pass_bank(Xen arg)
+{
+ #define H_make_all_pass_bank "(" S_make_all_pass_bank " gens): return a new all_pass-bank generator."
+
+ mus_any *ge = NULL;
+ mus_any **gens;
+ int i, j, size;
+
+ Xen_check_type(Xen_is_vector(arg), arg, 1, S_make_all_pass_bank, "a vector of all_pass generators");
+
+ size = Xen_vector_length(arg);
+ if (size == 0) return(Xen_false);
+ gens = (mus_any **)calloc(size, sizeof(mus_any *));
+
+ for (i = 0, j = 0; i < size; i++)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(frequency), frequency, XEN_ARG_1, S_make_ncos, "a number");
- freq = XEN_TO_C_DOUBLE(frequency);
- if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_ncos, XEN_ARG_1, frequency, "freq ~A > srate/2?");
+ Xen g;
+ g = Xen_vector_ref(arg, i);
+ if (mus_is_xen(g))
+ {
+ mus_any *fg;
+ fg = Xen_to_mus_any(g);
+ if (mus_is_all_pass(fg))
+ gens[j++] = fg;
+ }
}
+ if (j > 0)
+ ge = mus_make_all_pass_bank(j, gens);
+ free(gens);
- XEN_ASSERT_TYPE(XEN_INTEGER_P(xn), xn, XEN_ARG_2, S_make_ncos, "an integer");
- n = XEN_TO_C_INT(xn);
- if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_ncos, XEN_ARG_2, xn, "n: ~A?");
+ if (ge)
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, arg)));
+ return(Xen_false);
+}
- ge = mus_make_ncos(freq, n);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+
+static Xen g_is_all_pass_bank(Xen os)
+{
+ #define H_is_all_pass_bank "(" S_is_all_pass_bank " gen): " PROC_TRUE " if gen is a " S_all_pass_bank
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_all_pass_bank(Xen_to_mus_any(os)))));
+}
+
+
+static Xen g_all_pass_bank(Xen gens, Xen inp)
+{
+ #define H_all_pass_bank "(" S_all_pass_bank " bank inval): sum an array of " S_all_pass " filters."
+ mus_any *bank = NULL;
+ mus_xen *gn;
+ mus_float_t x = 0.0;
+
+ Xen_to_C_generator(gens, gn, bank, mus_is_all_pass_bank, S_all_pass_bank, "an all-pass-bank generator");
+ Xen_real_to_C_double_if_bound(inp, x, S_all_pass_bank, 2);
+
+ return(C_double_to_Xen_real(mus_all_pass_bank(bank, x)));
}
-#endif
-static XEN g_ncos(XEN obj, XEN fm)
+static Xen g_moving_average(Xen obj, Xen input)
{
- #define H_ncos "(" S_ncos " gen :optional (fm 0.0)): get the next sample from 'gen', an " S_ncos " generator"
+ #define H_moving_average "(" S_moving_average " gen (val 0.0)): moving window average."
+ mus_float_t in1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
- mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_ncos_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_ncos, "an " S_ncos " generator");
- if (XEN_NUMBER_P(fm))
- fm1 = XEN_TO_C_DOUBLE(fm);
- else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_ncos, "a number");
- return(C_TO_XEN_DOUBLE(mus_ncos(XEN_TO_MUS_ANY(obj), fm1)));
+ Xen_to_C_generator(obj, gn, g, mus_is_moving_average, S_moving_average, "a moving-average generator");
+ Xen_real_to_C_double_if_bound(input, in1, S_moving_average, 2);
+
+ return(C_double_to_Xen_real(mus_moving_average(g, in1)));
}
+static Xen g_moving_max(Xen obj, Xen input)
+{
+ #define H_moving_max "(" S_moving_max " gen (val 0.0)): moving window max."
+ mus_float_t in1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
-/* -------- nsin -------- */
+ Xen_to_C_generator(obj, gn, g, mus_is_moving_max, S_moving_max, "a moving-max generator");
+ Xen_real_to_C_double_if_bound(input, in1, S_moving_max, 2);
-static XEN g_nsin_p(XEN obj)
+ return(C_double_to_Xen_real(mus_moving_max(g, in1)));
+}
+
+
+static Xen g_moving_norm(Xen obj, Xen input)
{
- #define H_nsin_p "(" S_nsin_p " gen): " PROC_TRUE " if gen is an " S_nsin " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) &&
- (mus_nsin_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_moving_norm "(" S_moving_norm " gen (val 0.0)): moving window norm."
+ mus_float_t in1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_moving_norm, S_moving_norm, "a moving-norm generator");
+ Xen_real_to_C_double_if_bound(input, in1, S_moving_norm, 2);
+
+ return(C_double_to_Xen_real(mus_moving_norm(g, in1)));
}
-#if (!HAVE_SCHEME)
+static Xen g_tap(Xen obj, Xen loc)
+{
+ #define H_tap "(" S_tap " gen (pm 0.0)): tap the " S_delay " generator offset by pm"
+ mus_float_t dloc = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_tap, S_tap, "a delay line tap");
+ Xen_real_to_C_double_if_bound(loc, dloc, S_tap, 3);
-static XEN g_make_nsin(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+ return(C_double_to_Xen_real(mus_tap(g, dloc)));
+}
+
+
+static Xen g_is_tap(Xen obj)
{
- #define H_make_nsin "(" S_make_nsin " (:frequency *clm-default-frequency*) (:n 1)): \
-return a new " S_nsin " generator, producing a sum of 'n' equal amplitude sines"
+ #define H_is_tap "(" S_is_tap " gen): " PROC_TRUE " if gen is a delay line tap"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_tap(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_delay(Xen obj)
+{
+ #define H_is_delay "(" S_is_delay " gen): " PROC_TRUE " if gen is a delay line"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_delay(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_comb(Xen obj)
+{
+ #define H_is_comb "(" S_is_comb " gen): " PROC_TRUE " if gen is a comb filter"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_comb(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_filtered_comb(Xen obj)
+{
+ #define H_is_filtered_comb "(" S_is_filtered_comb " gen): " PROC_TRUE " if gen is a filtered-comb filter"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_filtered_comb(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_notch(Xen obj)
+{
+ #define H_is_notch "(" S_is_notch " gen): " PROC_TRUE " if gen is a notch filter"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_notch(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_all_pass(Xen obj)
+{
+ #define H_is_all_pass "(" S_is_all_pass " gen): " PROC_TRUE " if gen is an all-pass filter"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_all_pass(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_moving_average(Xen obj)
+{
+ #define H_is_moving_average "(" S_is_moving_average " gen): " PROC_TRUE " if gen is a moving-average generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_average(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_moving_max(Xen obj)
+{
+ #define H_is_moving_max "(" S_is_moving_max " gen): " PROC_TRUE " if gen is a moving-max generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_max(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_moving_norm(Xen obj)
+{
+ #define H_is_moving_norm "(" S_is_moving_norm " gen): " PROC_TRUE " if gen is a moving-norm generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_moving_norm(Xen_to_mus_any(obj)))));
+}
+
+
+/* -------- ncos -------- */
+
+static Xen g_is_ncos(Xen obj)
+{
+ #define H_is_ncos "(" S_is_ncos " gen): " PROC_TRUE " if gen is an " S_ncos " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
+ (mus_is_ncos(Xen_to_mus_any(obj)))));
+}
+
+static Xen g_make_ncos(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
+{
+ #define H_make_ncos "(" S_make_ncos " (frequency *clm-default-frequency*) (n 1)): \
+return a new " S_ncos " generator, producing a sum of 'n' equal amplitude cosines."
mus_any *ge;
- XEN args[4];
- XEN keys[2];
+ Xen args[4];
+ Xen keys[2];
int orig_arg[2] = {0, 0};
int vals, n = 1;
mus_float_t freq;
@@ -2490,67 +3453,97 @@ return a new " S_nsin " generator, producing a sum of 'n' equal amplitude sines"
keys[1] = kw_n;
args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
- vals = mus_optkey_unscramble(S_make_nsin, 2, keys, args, orig_arg);
+ vals = mus_optkey_unscramble(S_make_ncos, 2, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], S_make_nsin, orig_arg[0], freq);
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_ncos, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_nsin, orig_arg[0], keys[0], "freq ~A > srate/2?");
+ Xen_out_of_range_error(S_make_ncos, orig_arg[0], keys[0], "freq > srate/2?");
- n = mus_optkey_to_int(keys[1], S_make_nsin, orig_arg[1], n);
+ n = Xen_optkey_to_int(kw_n, keys[1], S_make_ncos, orig_arg[1], n);
if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_nsin, orig_arg[1], keys[1], "n: ~A?");
+ Xen_out_of_range_error(S_make_ncos, orig_arg[1], keys[1], "n <= 0?");
}
- ge = mus_make_nsin(freq, n);
+ ge = mus_make_ncos(freq, n);
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-#else
+static Xen g_ncos(Xen obj, Xen fm)
+{
+ #define H_ncos "(" S_ncos " gen (fm 0.0)): get the next sample from 'gen', an " S_ncos " generator"
+
+ mus_float_t fm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_ncos, S_ncos, "an ncos generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_ncos, 2);
+
+ return(C_double_to_Xen_real(mus_ncos(g, fm1)));
+}
+
+
-static XEN g_make_nsin(XEN frequency, XEN xn)
+/* -------- nsin -------- */
+
+static Xen g_is_nsin(Xen obj)
+{
+ #define H_is_nsin "(" S_is_nsin " gen): " PROC_TRUE " if gen is an " S_nsin " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
+ (mus_is_nsin(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_make_nsin(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
- #define H_make_nsin "(" S_make_nsin " (:frequency *clm-default-frequency*) (:n 1)): \
-return a new " S_nsin " generator, producing a sum of 'n' equal amplitude sines."
+ #define H_make_nsin "(" S_make_nsin " (frequency *clm-default-frequency*) (n 1)): \
+return a new " S_nsin " generator, producing a sum of 'n' equal amplitude sines"
mus_any *ge;
- int n = 1;
+ Xen args[4];
+ Xen keys[2];
+ int orig_arg[2] = {0, 0};
+ int vals, n = 1;
mus_float_t freq;
- if (XEN_FALSE_P(frequency))
- freq = clm_default_frequency;
- else
+ freq = clm_default_frequency;
+
+ keys[0] = kw_frequency;
+ keys[1] = kw_n;
+ args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
+
+ vals = mus_optkey_unscramble(S_make_nsin, 2, keys, args, orig_arg);
+ if (vals > 0)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(frequency), frequency, XEN_ARG_1, S_make_nsin, "a number");
- freq = XEN_TO_C_DOUBLE(frequency);
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_nsin, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_nsin, XEN_ARG_1, frequency, "freq ~A > srate/2?");
- }
+ Xen_out_of_range_error(S_make_nsin, orig_arg[0], keys[0], "freq > srate/2?");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(xn), xn, XEN_ARG_2, S_make_nsin, "an integer");
- n = XEN_TO_C_INT(xn);
- if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_nsin, XEN_ARG_2, xn, "n: ~A?");
+ n = Xen_optkey_to_int(kw_n, keys[1], S_make_nsin, orig_arg[1], n);
+ if (n <= 0)
+ Xen_out_of_range_error(S_make_nsin, orig_arg[1], keys[1], "n <= 0?");
+ }
ge = mus_make_nsin(freq, n);
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-#endif
-
-static XEN g_nsin(XEN obj, XEN fm)
+static Xen g_nsin(Xen obj, Xen fm)
{
- #define H_nsin "(" S_nsin " gen :optional (fm 0.0)): get the next sample from 'gen', an " S_nsin " generator"
+ #define H_nsin "(" S_nsin " gen (fm 0.0)): get the next sample from 'gen', an " S_nsin " generator"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_nsin_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_nsin, "an " S_nsin " generator");
- if (XEN_NUMBER_P(fm))
- fm1 = XEN_TO_C_DOUBLE(fm);
- else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_nsin, "a number");
- return(C_TO_XEN_DOUBLE(mus_nsin(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_nsin, S_nsin, "an nsin generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_nsin, 2);
+
+ return(C_double_to_Xen_real(mus_nsin(g, fm1)));
}
@@ -2560,32 +3553,32 @@ static XEN g_nsin(XEN obj, XEN fm)
#define RANDOM_DISTRIBUTION_TABLE_SIZE 512
#define RANDOM_DISTRIBUTION_ENVELOPE_SIZE 50
-static mus_float_t *inverse_integrate(XEN dist, int data_size)
+static mus_float_t *inverse_integrate(Xen dist, int data_size)
{
/* e = env possibly starting < 0 */
int e_size = RANDOM_DISTRIBUTION_ENVELOPE_SIZE;
mus_float_t *e, *data;
int i, e_len, lim, e_loc = 2;
- XEN ex0, ex1, ey0, ey1;
- mus_float_t x, x0, x1, xincr, y0, y1, sum = 0.0, first_sum = 0.0, last_sum = 0.0;
+ Xen ex0, ex1, ey0, ey1;
+ mus_float_t x, x0, x1, xincr, y0, y1, sum, first_sum, last_sum = 0.0;
lim = (e_size + 1) * 2;
e = (mus_float_t *)calloc(lim, sizeof(mus_float_t));
- e_len = XEN_LIST_LENGTH(dist);
- ex0 = XEN_LIST_REF(dist, 0);
- ex1 = XEN_LIST_REF(dist, e_len - 2);
- x0 = XEN_TO_C_DOUBLE(ex0);
+ e_len = Xen_list_length(dist);
+ ex0 = Xen_list_ref(dist, 0);
+ ex1 = Xen_list_ref(dist, e_len - 2);
+ x0 = Xen_real_to_C_double(ex0);
/* get x range first */
- x1 = XEN_TO_C_DOUBLE(ex1);
+ x1 = Xen_real_to_C_double(ex1);
xincr = (x1 - x0) / (mus_float_t)e_size;
/* now true x1 */
- ex1 = XEN_LIST_REF(dist, 2);
- x1 = XEN_TO_C_DOUBLE(ex1);
- ey0 = XEN_LIST_REF(dist, 1);
- ey1 = XEN_LIST_REF(dist, 3);
- y0 = XEN_TO_C_DOUBLE(ey0);
- y1 = XEN_TO_C_DOUBLE(ey1);
+ ex1 = Xen_list_ref(dist, 2);
+ x1 = Xen_real_to_C_double(ex1);
+ ey0 = Xen_list_ref(dist, 1);
+ ey1 = Xen_list_ref(dist, 3);
+ y0 = Xen_real_to_C_double(ey0);
+ y1 = Xen_real_to_C_double(ey1);
sum = y0;
first_sum = sum;
@@ -2599,10 +3592,10 @@ static mus_float_t *inverse_integrate(XEN dist, int data_size)
x0 = x1;
y0 = y1;
e_loc += 2;
- ex1 = XEN_LIST_REF(dist, e_loc);
- ey1 = XEN_LIST_REF(dist, e_loc + 1);
- x1 = XEN_TO_C_DOUBLE(ex1);
- y1 = XEN_TO_C_DOUBLE(ey1);
+ ex1 = Xen_list_ref(dist, e_loc);
+ ey1 = Xen_list_ref(dist, e_loc + 1);
+ x1 = Xen_real_to_C_double(ex1);
+ y1 = Xen_real_to_C_double(ey1);
}
if ((x == x0) || (x0 == x1))
sum += y0;
@@ -2637,17 +3630,16 @@ static mus_float_t *inverse_integrate(XEN dist, int data_size)
}
-static XEN g_make_noi(bool rand_case, const char *caller, XEN arglist)
+static Xen g_make_noi(bool rand_case, const char *caller, Xen arglist)
{
mus_any *ge = NULL;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[5];
+ Xen args[10];
+ Xen keys[5];
int orig_arg[5] = {0, 0, 0, 0, 0};
- int i, vals, arglist_len;
+ int vals;
mus_float_t freq, base = 1.0;
mus_float_t *distribution = NULL;
- vct *v = NULL;
- XEN orig_v = XEN_FALSE;
+ Xen orig_v = Xen_false;
int distribution_size = RANDOM_DISTRIBUTION_TABLE_SIZE;
freq = clm_default_frequency;
@@ -2658,52 +3650,55 @@ static XEN g_make_noi(bool rand_case, const char *caller, XEN arglist)
keys[3] = kw_distribution;
keys[4] = kw_size;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(caller, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 10) clm_error(caller, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(caller, 5, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], caller, orig_arg[0], freq);
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
if (freq > mus_srate())
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[0], keys[0], "freq ~A > srate/2?");
+ Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
- base = mus_optkey_to_float(keys[1], caller, orig_arg[1], base);
+ base = Xen_optkey_to_float(kw_amplitude, keys[1], caller, orig_arg[1], base);
- distribution_size = mus_optkey_to_int(keys[4], caller, orig_arg[4], distribution_size);
+ distribution_size = Xen_optkey_to_int(kw_size, keys[4], caller, orig_arg[4], distribution_size);
if (distribution_size <= 0)
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[4], keys[4], "distribution size ~A <= 0?");
+ Xen_out_of_range_error(caller, orig_arg[4], keys[4], "distribution size <= 0?");
if (distribution_size > mus_max_table_size())
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[4], keys[4], "distribution size ~A too large (see mus-max-table-size)");
+ Xen_out_of_range_error(caller, orig_arg[4], keys[4], "distribution size too large (see mus-max-table-size)");
- if (!(XEN_KEYWORD_P(keys[2]))) /* i.e. envelope arg was specified */
+ if (!(Xen_is_keyword(keys[2]))) /* i.e. envelope arg was specified */
{
int len;
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[2]), keys[2], orig_arg[2], caller, "an envelope");
- len = XEN_LIST_LENGTH(keys[2]);
+ Xen_check_type(Xen_is_list(keys[2]), keys[2], orig_arg[2], caller, "an envelope");
+ len = Xen_list_length(keys[2]);
if ((len < 4) || (len & 1))
clm_error(caller, "bad distribution envelope", keys[2]);
/* envelope and distribution are incompatible */
- if (!(XEN_KEYWORD_P(keys[3])))
+ if (!(Xen_is_keyword(keys[3])))
clm_error(caller, ":envelope and :distribution in same call?", keys[3]);
distribution = inverse_integrate(keys[2], distribution_size);
orig_v = xen_make_vct(distribution_size, distribution);
}
else
{
- if (!(XEN_KEYWORD_P(keys[3]))) /* i.e. distribution arg was specified */
+ if (!(Xen_is_keyword(keys[3]))) /* i.e. distribution arg was specified */
{
- XEN_ASSERT_TYPE(MUS_VCT_P(keys[3]) || XEN_FALSE_P(keys[3]), keys[3], orig_arg[3], caller, "a vct");
- if (MUS_VCT_P(keys[3]))
+ Xen_check_type(mus_is_vct(keys[3]) || Xen_is_false(keys[3]), keys[3], orig_arg[3], caller, "a " S_vct);
+ if (mus_is_vct(keys[3]))
{
+ vct *v = NULL;
orig_v = keys[3];
v = mus_optkey_to_vct(orig_v, caller, orig_arg[3], NULL);
- distribution_size = v->length;
- distribution = v->data;
+ distribution_size = mus_vct_length(v);
+ distribution = mus_vct_data(v);
}
}
}
@@ -2722,17 +3717,17 @@ static XEN g_make_noi(bool rand_case, const char *caller, XEN arglist)
}
if (ge)
{
- if (MUS_VCT_P(orig_v))
+ if (mus_is_vct(orig_v))
return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_make_rand_interp(XEN arglist)
+static Xen g_make_rand_interp(Xen arglist)
{
- #define H_make_rand_interp "(" S_make_rand_interp " (:frequency *clm-default-frequency*) (:amplitude 1.0) :envelope :distribution :size): \
+ #define H_make_rand_interp "(" S_make_rand_interp " (frequency *clm-default-frequency*) (amplitude 1.0) (envelope) (distribution) (size)): \
return a new " S_rand_interp " generator, producing linearly interpolated random numbers. \
frequency is the rate at which new end-points are chosen."
@@ -2740,9 +3735,9 @@ frequency is the rate at which new end-points are chosen."
}
-static XEN g_make_rand(XEN arglist)
+static Xen g_make_rand(Xen arglist)
{
- #define H_make_rand "(" S_make_rand " (:frequency *clm-default-frequency*) (:amplitude 1.0) :envelope :distribution :size): \
+ #define H_make_rand "(" S_make_rand " (frequency *clm-default-frequency*) (amplitude 1.0) (envelope) (distribution) (size)): \
return a new " S_rand " generator, producing a sequence of random numbers (a step function). \
frequency is the rate at which new numbers are chosen."
@@ -2750,67 +3745,76 @@ frequency is the rate at which new numbers are chosen."
}
-static XEN g_rand(XEN obj, XEN fm)
+static Xen g_rand(Xen obj, Xen fm)
{
- #define H_rand "(" S_rand " gen :optional (fm 0.0)): gen's current random number. \
+ #define H_rand "(" S_rand " gen (fm 0.0)): gen's current random number. \
fm modulates the rate at which the current number is changed."
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_rand_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_rand, " a rand generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_rand, "a number");
- return(C_TO_XEN_DOUBLE(mus_rand(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_rand, S_rand, "a rand generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_rand, 2);
+
+ return(C_double_to_Xen_real(mus_rand(g, fm1)));
}
-static XEN g_rand_p(XEN obj)
+static Xen g_is_rand(Xen obj)
{
- #define H_rand_p "(" S_rand_p " gen): " PROC_TRUE " if gen is a " S_rand
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_rand_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_rand "(" S_is_rand " gen): " PROC_TRUE " if gen is a " S_rand
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_rand(Xen_to_mus_any(obj)))));
}
-static XEN g_rand_interp(XEN obj, XEN fm)
+static Xen g_rand_interp(Xen obj, Xen fm)
{
- #define H_rand_interp "(" S_rand_interp " gen :optional (fm 0.0)): gen's current (interpolating) random number. \
+ #define H_rand_interp "(" S_rand_interp " gen (fm 0.0)): gen's current (interpolating) random number. \
fm modulates the rate at which new segment end-points are chosen."
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_rand_interp_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_rand_interp, "a " S_rand_interp " generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_rand_interp, "a number");
- return(C_TO_XEN_DOUBLE(mus_rand_interp(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_rand_interp, S_rand_interp, "a rand-interp generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_rand_interp, 2);
+
+ return(C_double_to_Xen_real(mus_rand_interp(g, fm1)));
}
-static XEN g_rand_interp_p(XEN obj)
+static Xen g_is_rand_interp(Xen obj)
{
- #define H_rand_interp_p "(" S_rand_interp_p " gen): " PROC_TRUE " if gen is a " S_rand_interp
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_rand_interp_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_rand_interp "(" S_is_rand_interp " gen): " PROC_TRUE " if gen is a " S_rand_interp
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_rand_interp(Xen_to_mus_any(obj)))));
}
-static XEN g_mus_random(XEN a)
+static Xen g_mus_random(Xen a)
{
#define H_mus_random "(" S_mus_random " val): a random number between -val and val. \
the built-in 'random' function returns values between 0 and its argument"
+ mus_float_t x;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(a), a, XEN_ONLY_ARG, S_mus_random, "a number");
- return(C_TO_XEN_DOUBLE(mus_random(XEN_TO_C_DOUBLE(a))));
+ Xen_to_C_double_or_error(a, x, S_mus_random, 1);
+ return(C_double_to_Xen_real(mus_random(x)));
}
-static XEN g_mus_rand_seed(void)
+static Xen g_mus_rand_seed(void)
{
#define H_mus_rand_seed "(" S_mus_rand_seed "): the random number seed; \
this can be used to re-run a particular random number sequence."
- return(C_TO_XEN_INT(mus_rand_seed()));
+ return(C_int_to_Xen_integer(mus_rand_seed()));
}
-static XEN g_mus_set_rand_seed(XEN a)
+static Xen g_mus_set_rand_seed(Xen a)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(a), a, XEN_ONLY_ARG, S_setB S_mus_rand_seed, "an integer");
- mus_set_rand_seed((unsigned long)XEN_TO_C_INT(a));
+ Xen_check_type(Xen_is_integer(a), a, 1, S_set S_mus_rand_seed, "an integer");
+ mus_set_rand_seed((unsigned long)Xen_integer_to_C_int(a));
return(a);
}
@@ -2818,66 +3822,65 @@ static XEN g_mus_set_rand_seed(XEN a)
/* ---------------- table lookup ---------------- */
-static XEN g_table_lookup_p(XEN obj)
+static Xen g_is_table_lookup(Xen obj)
{
- #define H_table_lookup_p "(" S_table_lookup_p " gen): " PROC_TRUE " if gen is a " S_table_lookup
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_table_lookup_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_table_lookup "(" S_is_table_lookup " gen): " PROC_TRUE " if gen is a " S_table_lookup
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_table_lookup(Xen_to_mus_any(obj)))));
}
-static XEN g_partials_to_wave(XEN partials, XEN utable, XEN normalize)
+static Xen g_partials_to_wave(Xen partials, Xen utable, Xen normalize)
{
- #define H_partials_to_wave "(" S_partials_to_wave " partials :optional wave (normalize " PROC_FALSE ")): \
-take a list or vct of partials (harmonic number and associated amplitude) and produce \
-a waveform for use in " S_table_lookup ". If wave (a vct) is not given, \
+ #define H_partials_to_wave "(" S_partials_to_wave " partials wave (normalize " PROC_FALSE ")): \
+take a list or " S_vct " of partials (harmonic number and associated amplitude) and produce \
+a waveform for use in " S_table_lookup ". If wave (a " S_vct ") is not given, \
a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goes between -1.0 and 1.0.\n\
(set! gen (" S_make_table_lookup " 440.0 :wave (" S_partials_to_wave " '(1 1.0 2 .5))))"
vct *f;
- XEN table;
- XEN lst;
+ Xen table;
mus_float_t *partial_data = NULL;
- mus_long_t len = 0, i;
+ mus_long_t len = 0;
bool partials_allocated = true;
#if HAVE_SCHEME
int gc_loc;
#endif
- XEN_ASSERT_TYPE(MUS_VCT_P(partials) || XEN_LIST_P(partials), partials, XEN_ARG_1, S_partials_to_wave, "a list or a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(utable) || XEN_FALSE_P(utable) || (!(XEN_BOUND_P(utable))), utable, XEN_ARG_2, S_partials_to_wave, "a vct or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(normalize), normalize, XEN_ARG_3, S_partials_to_wave, "a boolean");
+ Xen_check_type(mus_is_vct(partials) || Xen_is_list(partials), partials, 1, S_partials_to_wave, "a list or a " S_vct);
+ Xen_check_type(mus_is_vct(utable) || Xen_is_false(utable) || (!(Xen_is_bound(utable))), utable, 2, S_partials_to_wave, "a " S_vct " or " PROC_FALSE);
+ Xen_check_type(Xen_is_boolean_or_unbound(normalize), normalize, 3, S_partials_to_wave, "a boolean");
- if (MUS_VCT_P(partials))
+ if (mus_is_vct(partials))
{
vct *v;
- v = XEN_TO_VCT(partials);
- partial_data = v->data;
- len = v->length;
+ v = Xen_to_vct(partials);
+ partial_data = mus_vct_data(v);
+ len = mus_vct_length(v);
partials_allocated = false;
}
else
{
- len = XEN_LIST_LENGTH(partials);
+ len = Xen_list_length(partials);
if (len == 0)
- XEN_ERROR(NO_DATA,
- XEN_LIST_2(C_TO_XEN_STRING("~A: partials list empty?"),
- C_TO_XEN_STRING(S_partials_to_wave)));
+ Xen_error(NO_DATA,
+ Xen_list_2(C_string_to_Xen_string("~A: partials list empty?"),
+ C_string_to_Xen_string(S_partials_to_wave)));
- if (!(XEN_NUMBER_P(XEN_CAR(partials))))
- XEN_ASSERT_TYPE(false, partials, XEN_ARG_1, S_partials_to_wave, "a list of numbers (partial numbers with amplitudes)");
+ if (!(Xen_is_number(Xen_car(partials))))
+ Xen_check_type(false, partials, 1, S_partials_to_wave, "a list of numbers (partial numbers with amplitudes)");
}
if (len & 1)
- XEN_ERROR(BAD_TYPE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: odd length partials list? ~A"),
- C_TO_XEN_STRING(S_partials_to_wave),
+ Xen_error(BAD_TYPE,
+ Xen_list_3(C_string_to_Xen_string("~A: odd length partials list? ~A"),
+ C_string_to_Xen_string(S_partials_to_wave),
partials));
- if ((XEN_NOT_BOUND_P(utable)) || (!(MUS_VCT_P(utable))))
+ if ((!Xen_is_bound(utable)) || (!(mus_is_vct(utable))))
{
mus_float_t *wave;
wave = (mus_float_t *)calloc(clm_table_size, sizeof(mus_float_t));
if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave table"));
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave table", S_partials_to_wave));
table = xen_make_vct(clm_table_size, wave);
}
else table = utable;
@@ -2886,18 +3889,20 @@ a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goe
gc_loc = s7_gc_protect(s7, table);
#endif
- f = XEN_TO_VCT(table);
+ f = Xen_to_vct(table);
if (!partial_data)
{
- partial_data = (mus_float_t *)calloc(len, sizeof(mus_float_t));
+ Xen lst;
+ int i;
+ partial_data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
if (partial_data == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate partials table"));
- for (i = 0, lst = XEN_COPY_ARG(partials); i < len; i++, lst = XEN_CDR(lst))
- partial_data[i] = XEN_TO_C_DOUBLE_OR_ELSE(XEN_CAR(lst), 0.0);
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate partials table", S_partials_to_wave));
+ for (i = 0, lst = Xen_copy_arg(partials); i < len; i++, lst = Xen_cdr(lst))
+ partial_data[i] = Xen_real_to_C_double(Xen_car(lst));
}
- mus_partials_to_wave(partial_data, len / 2, f->data, f->length, (XEN_TRUE_P(normalize)));
+ mus_partials_to_wave(partial_data, len / 2, mus_vct_data(f), mus_vct_length(f), (Xen_is_true(normalize)));
if (partials_allocated)
free(partial_data);
@@ -2910,12 +3915,12 @@ a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goe
}
-static XEN g_phase_partials_to_wave(XEN partials, XEN utable, XEN normalize)
+static Xen g_phase_partials_to_wave(Xen partials, Xen utable, Xen normalize)
{
vct *f;
- XEN table, lst;
- mus_float_t *partial_data = NULL, *wave;
- mus_long_t len = 0, i;
+ Xen table;
+ mus_float_t *partial_data = NULL;
+ mus_long_t len = 0;
bool partials_allocated = true;
#if HAVE_SCHEME
int gc_loc;
@@ -2931,45 +3936,46 @@ static XEN g_phase_partials_to_wave(XEN partials, XEN utable, XEN normalize)
#define pp2w_example "440.0 0.0 '( 1.0 0.75 0.0 2.0 0.25 3.14159 0.5 f* ) #f #f phase-partials->wave make-table-lookup"
#endif
- #define H_phase_partials_to_wave "(" S_phase_partials_to_wave " partials :optional wave (normalize " PROC_FALSE ")): \
-take a list or vct of partials (harmonic number, amplitude, initial phase) and produce \
-a waveform for use in " S_table_lookup ". If wave (a vct) is not given, \
+ #define H_phase_partials_to_wave "(" S_phase_partials_to_wave " partials wave (normalize " PROC_FALSE ")): \
+take a list or " S_vct " of partials (harmonic number, amplitude, initial phase) and produce \
+a waveform for use in " S_table_lookup ". If wave (a " S_vct ") is not given, \
a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goes between -1.0 and 1.0.\n " pp2w_example
- XEN_ASSERT_TYPE(MUS_VCT_P(partials) || XEN_LIST_P(partials), partials, XEN_ARG_1, S_phase_partials_to_wave, "a list or a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(utable) || XEN_FALSE_P(utable) || (!(XEN_BOUND_P(utable))), utable, XEN_ARG_2, S_phase_partials_to_wave, "a vct or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(normalize), normalize, XEN_ARG_3, S_phase_partials_to_wave, "a boolean");
+ Xen_check_type(mus_is_vct(partials) || Xen_is_list(partials), partials, 1, S_phase_partials_to_wave, "a list or a " S_vct);
+ Xen_check_type(mus_is_vct(utable) || Xen_is_false(utable) || (!(Xen_is_bound(utable))), utable, 2, S_phase_partials_to_wave, "a " S_vct " or " PROC_FALSE);
+ Xen_check_type(Xen_is_boolean_or_unbound(normalize), normalize, 3, S_phase_partials_to_wave, "a boolean");
- if (MUS_VCT_P(partials))
+ if (mus_is_vct(partials))
{
vct *v;
- v = XEN_TO_VCT(partials);
- partial_data = v->data;
- len = v->length;
+ v = Xen_to_vct(partials);
+ partial_data = mus_vct_data(v);
+ len = mus_vct_length(v);
partials_allocated = false;
}
else
{
- len = XEN_LIST_LENGTH(partials);
+ len = Xen_list_length(partials);
if (len == 0)
- XEN_ERROR(NO_DATA,
- XEN_LIST_2(C_TO_XEN_STRING("~A: partials list empty?"),
- C_TO_XEN_STRING(S_phase_partials_to_wave)));
+ Xen_error(NO_DATA,
+ Xen_list_2(C_string_to_Xen_string("~A: partials list empty?"),
+ C_string_to_Xen_string(S_phase_partials_to_wave)));
- if (!(XEN_NUMBER_P(XEN_CAR(partials))))
- XEN_ASSERT_TYPE(false, partials, XEN_ARG_1, S_phase_partials_to_wave, "a list of numbers (partial numbers with amplitudes and phases)");
+ if (!(Xen_is_number(Xen_car(partials))))
+ Xen_check_type(false, partials, 1, S_phase_partials_to_wave, "a list of numbers (partial numbers with amplitudes and phases)");
}
if ((len % 3) != 0)
- XEN_ERROR(XEN_ERROR_TYPE("wrong-type-arg"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: partials list, ~A, should have 3 entries for each harmonic (number amp phase)"),
- C_TO_XEN_STRING(S_phase_partials_to_wave),
+ Xen_error(Xen_make_error_type("wrong-type-arg"),
+ Xen_list_3(C_string_to_Xen_string("~A: partials list, ~A, should have 3 entries for each harmonic (number amp phase)"),
+ C_string_to_Xen_string(S_phase_partials_to_wave),
partials));
- if ((XEN_NOT_BOUND_P(utable)) || (!(MUS_VCT_P(utable))))
+ if ((!Xen_is_bound(utable)) || (!(mus_is_vct(utable))))
{
+ mus_float_t *wave;
wave = (mus_float_t *)calloc(clm_table_size, sizeof(mus_float_t));
if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave table"));
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave table", S_phase_partials_to_wave));
table = xen_make_vct(clm_table_size, wave);
}
else table = utable;
@@ -2978,18 +3984,20 @@ a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goe
gc_loc = s7_gc_protect(s7, table);
#endif
- f = XEN_TO_VCT(table);
+ f = Xen_to_vct(table);
if (!partial_data)
{
- partial_data = (mus_float_t *)calloc(len, sizeof(mus_float_t));
+ int i;
+ Xen lst;
+ partial_data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
if (partial_data == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate partials table"));
- for (i = 0, lst = XEN_COPY_ARG(partials); i < len; i++, lst = XEN_CDR(lst))
- partial_data[i] = XEN_TO_C_DOUBLE_OR_ELSE(XEN_CAR(lst), 0.0);
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate partials table", S_phase_partials_to_wave));
+ for (i = 0, lst = Xen_copy_arg(partials); i < len; i++, lst = Xen_cdr(lst))
+ partial_data[i] = Xen_real_to_C_double(Xen_car(lst));
}
- mus_phase_partials_to_wave(partial_data, len / 3, f->data, f->length, (XEN_TRUE_P(normalize)));
+ mus_phase_partials_to_wave(partial_data, len / 3, mus_vct_data(f), mus_vct_length(f), (Xen_is_true(normalize)));
if (partials_allocated)
free(partial_data);
@@ -3002,24 +4010,23 @@ a new one is created. If normalize is " PROC_TRUE ", the resulting waveform goe
}
-static XEN g_make_table_lookup(XEN arglist)
+static Xen g_make_table_lookup(Xen arglist)
{
- #define H_make_table_lookup "(" S_make_table_lookup " (:frequency *clm-default-frequency*) (:initial-phase 0.0) :wave (:size clm-table-size) :type): \
-return a new " S_table_lookup " generator. This is known as an oscillator in other synthesis systems. \
-The default table size is 512; use :size to set some other size, or pass your own vct as the 'wave'.\n\
- (set! gen (" S_make_table_lookup " 440.0 :wave (" S_partials_to_wave " '(1 1.0)))\n\
+ #define H_make_table_lookup "(" S_make_table_lookup " (frequency *clm-default-frequency*) (initial-phase 0.0) (wave) (size clm-table-size) (type)): \
+return a new " S_table_lookup " generator. \
+The default table size is 512; use :size to set some other size, or pass your own " S_vct " as the 'wave'.\n\
+ (set! gen (" S_make_table_lookup " 440.0 :wave (" S_partials_to_wave " '(1 1.0))))\n\
is the same in effect as " S_make_oscil ". 'type' sets the interpolation choice which defaults to " S_mus_interp_linear "."
mus_any *ge;
- int vals, i, arglist_len;
+ int vals;
mus_long_t table_size = clm_table_size;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[5];
+ Xen args[10];
+ Xen keys[5];
int orig_arg[5] = {0, 0, 0, 0, MUS_INTERP_LINEAR};
mus_float_t freq, phase = 0.0;
mus_float_t *table = NULL;
- vct *v = NULL;
- XEN orig_v = XEN_FALSE;
+ Xen orig_v = Xen_false;
int interp_type = (int)MUS_INTERP_LINEAR;
freq = clm_default_frequency;
@@ -3030,50 +4037,53 @@ is the same in effect as " S_make_oscil ". 'type' sets the interpolation choice
keys[3] = kw_size;
keys[4] = kw_type;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_table_lookup, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 10) clm_error(S_make_table_lookup, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_table_lookup, 5, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], S_make_table_lookup, orig_arg[0], freq);
+ vct *v = NULL;
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_table_lookup, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_table_lookup, orig_arg[0], keys[0], "freq ~A > srate/2?");
+ Xen_out_of_range_error(S_make_table_lookup, orig_arg[0], keys[0], "freq > srate/2?");
- phase = mus_optkey_to_float(keys[1], S_make_table_lookup, orig_arg[1], phase);
+ phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_table_lookup, orig_arg[1], phase);
if (phase < 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_table_lookup, orig_arg[1], keys[1], "phase ~A?");
+ Xen_out_of_range_error(S_make_table_lookup, orig_arg[1], keys[1], "initial phase <= 0.0?"); /* is this actually an error? */
v = mus_optkey_to_vct(keys[2], S_make_table_lookup, orig_arg[2], NULL);
if (v)
{
orig_v = keys[2];
- table = v->data;
- table_size = v->length;
+ table = mus_vct_data(v);
+ table_size = mus_vct_length(v);
}
- table_size = mus_optkey_to_mus_long_t(keys[3], S_make_table_lookup, orig_arg[3], table_size);
+ table_size = Xen_optkey_to_mus_long_t(kw_size, keys[3], S_make_table_lookup, orig_arg[3], table_size);
if (table_size <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_table_lookup, orig_arg[3], keys[3], "size ~A <= 0?");
+ Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "size <= 0?");
if (table_size > mus_max_table_size())
- XEN_OUT_OF_RANGE_ERROR(S_make_table_lookup, orig_arg[3], keys[3], "size ~A too large (see mus-max-table-size)");
- if ((v) && (table_size > v->length))
- XEN_OUT_OF_RANGE_ERROR(S_make_table_lookup, orig_arg[3], keys[3], "size arg ~A bigger than size of provided wave");
+ Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "size too large (see mus-max-table-size)");
+ if ((v) && (table_size > mus_vct_length(v)))
+ Xen_out_of_range_error(S_make_table_lookup, orig_arg[3], keys[3], "table size > wave size");
- interp_type = mus_optkey_to_int(keys[4], S_make_table_lookup, orig_arg[4], interp_type);
- if (!(mus_interp_type_p(interp_type)))
- XEN_OUT_OF_RANGE_ERROR(S_make_table_lookup, orig_arg[4], keys[4], "no such interp-type: ~A");
+ interp_type = Xen_optkey_to_int(kw_type, keys[4], S_make_table_lookup, orig_arg[4], interp_type);
+ if (!(mus_is_interp_type(interp_type)))
+ Xen_out_of_range_error(S_make_table_lookup, orig_arg[4], keys[4], "no such interp-type");
}
- if (!(MUS_VCT_P(orig_v)))
+ if (!(mus_is_vct(orig_v)))
{
table = (mus_float_t *)calloc(table_size, sizeof(mus_float_t));
if (table == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate table-lookup table"));
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate table-lookup table", S_make_table_lookup));
orig_v = xen_make_vct(table_size, table);
}
ge = mus_make_table_lookup(freq, phase, table, table_size, (mus_interp_t)interp_type);
@@ -3081,15 +4091,19 @@ is the same in effect as " S_make_oscil ". 'type' sets the interpolation choice
}
-static XEN g_table_lookup(XEN obj, XEN fm)
+static Xen g_table_lookup(Xen obj, Xen fm)
{
- #define H_table_lookup "(" S_table_lookup " gen :optional (fm 0.0)): interpolated table-lookup \
+ #define H_table_lookup "(" S_table_lookup " gen (fm 0.0)): interpolated table-lookup \
with 'wrap-around' when gen's phase marches off either end of its table."
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_table_lookup_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_table_lookup, "a " S_table_lookup " generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_table_lookup, "a number");
- return(C_TO_XEN_DOUBLE(mus_table_lookup(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_table_lookup, S_table_lookup, "a table-lookup generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_table_lookup, 2);
+
+ return(C_double_to_Xen_real(mus_table_lookup(g, fm1)));
}
@@ -3098,12 +4112,12 @@ with 'wrap-around' when gen's phase marches off either end of its table."
typedef enum {G_SAWTOOTH_WAVE, G_SQUARE_WAVE, G_TRIANGLE_WAVE, G_PULSE_TRAIN} xclm_wave_t;
-static XEN g_make_sw(xclm_wave_t type, mus_float_t def_phase, XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_sw(xclm_wave_t type, mus_float_t def_phase, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
mus_any *ge = NULL;
const char *caller = NULL;
- XEN args[6];
- XEN keys[3];
+ Xen args[6];
+ Xen keys[3];
int orig_arg[3] = {0, 0, 0};
int vals;
mus_float_t freq, base = 1.0, phase;
@@ -3127,13 +4141,12 @@ static XEN g_make_sw(xclm_wave_t type, mus_float_t def_phase, XEN arg1, XEN arg2
vals = mus_optkey_unscramble(caller, 3, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], caller, orig_arg[0], freq);
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
if (freq > mus_srate())
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[0], keys[0], "freq ~A > srate/2?");
-
- base = mus_optkey_to_float(keys[1], caller, orig_arg[1], base);
+ Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
- phase = mus_optkey_to_float(keys[2], caller, orig_arg[2], phase);
+ base = Xen_optkey_to_float(kw_amplitude, keys[1], caller, orig_arg[1], base);
+ phase = Xen_optkey_to_float(kw_initial_phase, keys[2], caller, orig_arg[2], phase);
}
switch (type)
@@ -3144,127 +4157,141 @@ static XEN g_make_sw(xclm_wave_t type, mus_float_t def_phase, XEN arg1, XEN arg2
case G_PULSE_TRAIN: ge = mus_make_pulse_train(freq, base, phase); break;
}
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_make_sawtooth_wave(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_sawtooth_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- #define H_make_sawtooth_wave "(" S_make_sawtooth_wave " (:frequency *clm-default-frequency*) (:amplitude 1.0) (:initial-phase 0.0)): \
+ #define H_make_sawtooth_wave "(" S_make_sawtooth_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
return a new " S_sawtooth_wave " generator."
return(g_make_sw(G_SAWTOOTH_WAVE, M_PI, arg1, arg2, arg3, arg4, arg5, arg6));
}
-static XEN g_make_square_wave(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_square_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- #define H_make_square_wave "(" S_make_square_wave " (:frequency *clm-default-frequency*) (:amplitude 1.0) (:initial-phase 0.0)): \
+ #define H_make_square_wave "(" S_make_square_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
return a new " S_square_wave " generator."
return(g_make_sw(G_SQUARE_WAVE, 0.0, arg1, arg2, arg3, arg4, arg5, arg6));
}
-static XEN g_make_triangle_wave(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_triangle_wave(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- #define H_make_triangle_wave "(" S_make_triangle_wave " (:frequency *clm-default-frequency*) (:amplitude 1.0) (:initial-phase 0.0)): \
+ #define H_make_triangle_wave "(" S_make_triangle_wave " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
return a new " S_triangle_wave " generator."
return(g_make_sw(G_TRIANGLE_WAVE, 0.0, arg1, arg2, arg3, arg4, arg5, arg6));
}
-static XEN g_make_pulse_train(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_pulse_train(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- #define H_make_pulse_train "(" S_make_pulse_train " (:frequency *clm-default-frequency*) (:amplitude 1.0) (:initial-phase 0.0)): \
+ #define H_make_pulse_train "(" S_make_pulse_train " (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0.0)): \
return a new " S_pulse_train " generator. This produces a sequence of impulses."
return(g_make_sw(G_PULSE_TRAIN, TWO_PI, arg1, arg2, arg3, arg4, arg5, arg6));
}
-static XEN g_sawtooth_wave(XEN obj, XEN fm)
+static Xen g_sawtooth_wave(Xen obj, Xen fm)
{
- #define H_sawtooth_wave "(" S_sawtooth_wave " gen :optional (fm 0.0)): next sawtooth sample from generator"
+ #define H_sawtooth_wave "(" S_sawtooth_wave " gen (fm 0.0)): next sawtooth sample from generator"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_sawtooth_wave_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_sawtooth_wave, "a " S_sawtooth_wave " generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_sawtooth_wave, "a number");
- return(C_TO_XEN_DOUBLE(mus_sawtooth_wave(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_sawtooth_wave, S_sawtooth_wave, "a sawtooth-wave generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_sawtooth_wave, 2);
+
+ return(C_double_to_Xen_real(mus_sawtooth_wave(g, fm1)));
}
-static XEN g_square_wave(XEN obj, XEN fm)
+static Xen g_square_wave(Xen obj, Xen fm)
{
- #define H_square_wave "(" S_square_wave " gen :optional (fm 0.0)): next square wave sample from generator"
+ #define H_square_wave "(" S_square_wave " gen (fm 0.0)): next square wave sample from generator"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_square_wave_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_square_wave, "a " S_square_wave " generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_square_wave, "a number");
- return(C_TO_XEN_DOUBLE(mus_square_wave(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_square_wave, S_square_wave, "a square-wave generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_square_wave, 2);
+
+ return(C_double_to_Xen_real(mus_square_wave(g, fm1)));
}
-static XEN g_triangle_wave(XEN obj, XEN fm)
+static Xen g_triangle_wave(Xen obj, Xen fm)
{
- #define H_triangle_wave "(" S_triangle_wave " gen :optional (fm 0.0)): next triangle wave sample from generator"
+ #define H_triangle_wave "(" S_triangle_wave " gen (fm 0.0)): next triangle wave sample from generator"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_triangle_wave_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_triangle_wave, "a " S_triangle_wave " generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_triangle_wave, "a number");
- return(C_TO_XEN_DOUBLE(mus_triangle_wave(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_triangle_wave, S_triangle_wave, "a triangle-wave generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_triangle_wave, 2);
+
+ return(C_double_to_Xen_real(mus_triangle_wave(g, fm1)));
}
-static XEN g_pulse_train(XEN obj, XEN fm)
+static Xen g_pulse_train(Xen obj, Xen fm)
{
- #define H_pulse_train "(" S_pulse_train " gen :optional (fm 0.0)): next pulse train sample from generator"
+ #define H_pulse_train "(" S_pulse_train " gen (fm 0.0)): next pulse train sample from generator"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_pulse_train_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_pulse_train, "a " S_pulse_train " generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_pulse_train, "a number");
- return(C_TO_XEN_DOUBLE(mus_pulse_train(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_pulse_train, S_pulse_train, "a pulse-train generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_pulse_train, 2);
+
+ return(C_double_to_Xen_real(mus_pulse_train(g, fm1)));
}
-static XEN g_sawtooth_wave_p(XEN obj)
+static Xen g_is_sawtooth_wave(Xen obj)
{
- #define H_sawtooth_wave_p "(" S_sawtooth_wave_p " gen): " PROC_TRUE " if gen is a " S_sawtooth_wave
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_sawtooth_wave_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_sawtooth_wave "(" S_is_sawtooth_wave " gen): " PROC_TRUE " if gen is a " S_sawtooth_wave
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_sawtooth_wave(Xen_to_mus_any(obj)))));
}
-static XEN g_square_wave_p(XEN obj)
+static Xen g_is_square_wave(Xen obj)
{
- #define H_square_wave_p "(" S_square_wave_p " gen): " PROC_TRUE " if gen is a " S_square_wave
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_square_wave_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_square_wave "(" S_is_square_wave " gen): " PROC_TRUE " if gen is a " S_square_wave
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_square_wave(Xen_to_mus_any(obj)))));
}
-static XEN g_triangle_wave_p(XEN obj)
+static Xen g_is_triangle_wave(Xen obj)
{
- #define H_triangle_wave_p "(" S_triangle_wave_p " gen): " PROC_TRUE " if gen is a " S_triangle_wave
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_triangle_wave_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_triangle_wave "(" S_is_triangle_wave " gen): " PROC_TRUE " if gen is a " S_triangle_wave
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_triangle_wave(Xen_to_mus_any(obj)))));
}
-static XEN g_pulse_train_p(XEN obj)
+static Xen g_is_pulse_train(Xen obj)
{
- #define H_pulse_train_p "(" S_pulse_train_p " gen): " PROC_TRUE " if gen is a " S_pulse_train
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_pulse_train_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_pulse_train "(" S_is_pulse_train " gen): " PROC_TRUE " if gen is a " S_pulse_train
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_pulse_train(Xen_to_mus_any(obj)))));
}
/* ---------------- asymmetric-fm ---------------- */
-#if (!HAVE_SCHEME)
-
-static XEN g_make_asymmetric_fm(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+static Xen g_make_asymmetric_fm(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
- #define H_make_asymmetric_fm "(" S_make_asymmetric_fm " (:frequency *clm-default-frequency*) (:initial-phase 0.0) (:r 1.0) (:ratio 1.0)): \
+ #define H_make_asymmetric_fm "(" S_make_asymmetric_fm " (frequency *clm-default-frequency*) (initial-phase 0.0) (r 1.0) (ratio 1.0)): \
return a new " S_asymmetric_fm " generator."
mus_any *ge;
- XEN args[8];
- XEN keys[4];
+ Xen args[8];
+ Xen keys[4];
int orig_arg[4] = {0, 0, 0, 0};
int vals;
mus_float_t freq, phase = 0.0, r = 1.0, ratio = 1.0;
@@ -3280,76 +4307,43 @@ return a new " S_asymmetric_fm " generator."
vals = mus_optkey_unscramble(S_make_asymmetric_fm, 4, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], S_make_asymmetric_fm, orig_arg[0], freq);
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_asymmetric_fm, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_asymmetric_fm, orig_arg[0], keys[0], "freq ~A > srate/2?");
-
- phase = mus_optkey_to_float(keys[1], S_make_asymmetric_fm, orig_arg[1], phase);
-
- r = mus_optkey_to_float(keys[2], S_make_asymmetric_fm, orig_arg[2], r);
-
- ratio = mus_optkey_to_float(keys[3], S_make_asymmetric_fm, orig_arg[3], ratio);
- }
-
- ge = mus_make_asymmetric_fm(freq, phase, r, ratio);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
-}
-
-#else
+ Xen_out_of_range_error(S_make_asymmetric_fm, orig_arg[0], keys[0], "freq > srate/2?");
-static XEN g_make_asymmetric_fm(XEN frequency, XEN initial_phase, XEN xr, XEN xratio)
-{
- #define H_make_asymmetric_fm "(" S_make_asymmetric_fm " (:frequency *clm-default-frequency*) (:initial-phase 0.0) (:r 1.0) (:ratio 1.0)): \
-return a new " S_asymmetric_fm " generator."
+ phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_asymmetric_fm, orig_arg[1], phase);
- mus_any *ge;
- mus_float_t freq, phase = 0.0, r = 1.0, ratio = 1.0;
+ r = Xen_optkey_to_float(kw_r, keys[2], S_make_asymmetric_fm, orig_arg[2], r);
- if (XEN_FALSE_P(frequency))
- freq = clm_default_frequency;
- else
- {
- XEN_ASSERT_TYPE(XEN_NUMBER_P(frequency), frequency, XEN_ARG_1, S_make_asymmetric_fm, "a number");
- freq = XEN_TO_C_DOUBLE(frequency);
- if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_asymmetric_fm, XEN_ARG_1, frequency, "freq ~A > srate/2?");
+ ratio = Xen_optkey_to_float(kw_ratio, keys[3], S_make_asymmetric_fm, orig_arg[3], ratio);
}
- XEN_ASSERT_TYPE(XEN_NUMBER_P(initial_phase), initial_phase, XEN_ARG_2, S_make_asymmetric_fm, "a number");
- phase = XEN_TO_C_DOUBLE(initial_phase);
-
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xr), xr, XEN_ARG_3, S_make_asymmetric_fm, "a number");
- r = XEN_TO_C_DOUBLE(xr);
-
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xratio), xr, XEN_ARG_4, S_make_asymmetric_fm, "a number");
- ratio = XEN_TO_C_DOUBLE(xratio);
-
ge = mus_make_asymmetric_fm(freq, phase, r, ratio);
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-#endif
-static XEN g_asymmetric_fm(XEN obj, XEN index, XEN fm)
+static Xen g_asymmetric_fm(Xen obj, Xen index, Xen fm)
{
- #define H_asymmetric_fm "(" S_asymmetric_fm " gen :optional (index 0.0) (fm 0.0)): next sample from asymmetric fm generator"
+ #define H_asymmetric_fm "(" S_asymmetric_fm " gen (index 0.0) (fm 0.0)): next sample from asymmetric fm generator"
mus_float_t fm1 = 0.0, index1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_asymmetric_fm_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_asymmetric_fm, "an " S_asymmetric_fm " generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_asymmetric_fm, "a number");
- if (XEN_NUMBER_P(index)) index1 = XEN_TO_C_DOUBLE(index); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(index), index, XEN_ARG_3, S_asymmetric_fm, "a number");
+ Xen_to_C_generator(obj, gn, g, mus_is_asymmetric_fm, S_asymmetric_fm, "an asymmetric-fm generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_asymmetric_fm, 2);
+ Xen_real_to_C_double_if_bound(index, index1, S_asymmetric_fm, 3);
- return(C_TO_XEN_DOUBLE(mus_asymmetric_fm(XEN_TO_MUS_ANY(obj), index1, fm1)));
+ return(C_double_to_Xen_real(mus_asymmetric_fm(g, index1, fm1)));
}
-static XEN g_asymmetric_fm_p(XEN obj)
+static Xen g_is_asymmetric_fm(Xen obj)
{
- #define H_asymmetric_fm_p "(" S_asymmetric_fm_p " gen): " PROC_TRUE " if gen is a " S_asymmetric_fm
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_asymmetric_fm_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_asymmetric_fm "(" S_is_asymmetric_fm " gen): " PROC_TRUE " if gen is a " S_asymmetric_fm
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_asymmetric_fm(Xen_to_mus_any(obj)))));
}
@@ -3361,11 +4355,11 @@ typedef enum {G_ONE_POLE, G_ONE_ZERO, G_TWO_POLE, G_TWO_ZERO} xclm_filter_t;
static const char *smpflts[6] = {S_make_one_pole, S_make_one_zero, S_make_two_pole, S_make_two_zero};
-static XEN g_make_smpflt_1(xclm_filter_t choice, XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen g_make_smpflt_1(xclm_filter_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
mus_any *gen = NULL;
- XEN args[4];
- XEN keys[2];
+ Xen args[4];
+ Xen keys[2];
int orig_arg[2] = {0, 0};
int vals;
mus_float_t a0 = 0.0;
@@ -3395,29 +4389,29 @@ static XEN g_make_smpflt_1(xclm_filter_t choice, XEN arg1, XEN arg2, XEN arg3, X
default: break;
}
if (gen) return(mus_xen_to_object(mus_any_to_mus_xen(gen)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_make_one_zero(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen g_make_one_zero(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
- #define H_make_one_zero "(" S_make_one_zero " :a0 :a1): return a new " S_one_zero " filter; a0*x(n) + a1*x(n-1)"
+ #define H_make_one_zero "(" S_make_one_zero " a0 a1): return a new " S_one_zero " filter; a0*x(n) + a1*x(n-1)"
return(g_make_smpflt_1(G_ONE_ZERO, arg1, arg2, arg3, arg4));
}
-static XEN g_make_one_pole(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen g_make_one_pole(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
- #define H_make_one_pole "(" S_make_one_pole " :a0 :b1): return a new " S_one_pole " filter; a0*x(n) - b1*y(n-1)"
+ #define H_make_one_pole "(" S_make_one_pole " a0 b1): return a new " S_one_pole " filter; a0*x(n) - b1*y(n-1)"
return(g_make_smpflt_1(G_ONE_POLE, arg1, arg2, arg3, arg4));
}
-static XEN g_make_smpflt_2(xclm_filter_t choice, XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_smpflt_2(xclm_filter_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
mus_any *gen = NULL;
- XEN args[6];
- XEN keys[3];
+ Xen args[6];
+ Xen keys[3];
int orig_arg[3] = {0, 0, 0};
int vals;
mus_float_t a0 = 0.0;
@@ -3439,7 +4433,7 @@ static XEN g_make_smpflt_2(xclm_filter_t choice, XEN arg1, XEN arg2, XEN arg3, X
vals = mus_optkey_unscramble(smpflts[choice], 3, keys, args, orig_arg);
if (vals > 0)
{
- a0 = mus_optkey_to_float(keys[0], smpflts[choice], orig_arg[0], a0);
+ a0 = Xen_optkey_to_float(kw_a0, keys[0], smpflts[choice], orig_arg[0], a0);
a1 = mus_optkey_to_float(keys[1], smpflts[choice], orig_arg[1], a1);
a2 = mus_optkey_to_float(keys[2], smpflts[choice], orig_arg[2], a2);
}
@@ -3447,39 +4441,39 @@ static XEN g_make_smpflt_2(xclm_filter_t choice, XEN arg1, XEN arg2, XEN arg3, X
gen = mus_make_two_zero(a0, a1, a2);
else gen = mus_make_two_pole(a0, a1, a2);
if (gen) return(mus_xen_to_object(mus_any_to_mus_xen(gen)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static bool found_polar_key(XEN arg)
+static bool found_polar_key(Xen arg)
{
- return((XEN_KEYWORD_P(arg)) &&
- ((XEN_KEYWORD_EQ_P(arg, kw_radius)) ||
- (XEN_KEYWORD_EQ_P(arg, kw_frequency))));
+ return((Xen_is_keyword(arg)) &&
+ ((Xen_keyword_is_eq(arg, kw_radius)) ||
+ (Xen_keyword_is_eq(arg, kw_frequency))));
}
-static bool found_coeff_key(XEN arg)
+static bool found_coeff_key(Xen arg)
{
- return((XEN_KEYWORD_P(arg)) &&
- (!(XEN_KEYWORD_EQ_P(arg, kw_radius))) &&
- (!(XEN_KEYWORD_EQ_P(arg, kw_frequency))));
+ return((Xen_is_keyword(arg)) &&
+ (!(Xen_keyword_is_eq(arg, kw_radius))) &&
+ (!(Xen_keyword_is_eq(arg, kw_frequency))));
}
-static XEN g_make_two_zero(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_two_zero(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- #define H_make_two_zero "(" S_make_two_zero " :a0 :a1 :a2 or :frequency :radius): return a new " S_two_zero " filter; \
+ #define H_make_two_zero "(" S_make_two_zero " a0 a1 a2) or (" S_make_two_zero " frequency radius): return a new " S_two_zero " filter; \
a0*x(n) + a1*x(n-1) + a2*x(n-2)"
- if ((XEN_BOUND_P(arg2)) && /* 0 or 1 args -> coeffs */
- (!(XEN_BOUND_P(arg5)))) /* 5 or more args -> coeffs */
+ if ((Xen_is_bound(arg2)) && /* 0 or 1 args -> coeffs */
+ (!(Xen_is_bound(arg5)))) /* 5 or more args -> coeffs */
{
if ((found_polar_key(arg1)) ||
(found_polar_key(arg2)) || /* if arg1 is frequency as number, then arg2 is either key or number */
- ((!(XEN_BOUND_P(arg3))) && /* make a guess that if 2 args, no keys, and a0 > 20, it is intended as a frequency */
+ ((!(Xen_is_bound(arg3))) && /* make a guess that if 2 args, no keys, and a0 > 20, it is intended as a frequency */
(!(found_coeff_key(arg1))) &&
- ((XEN_NUMBER_P(arg1)) && (XEN_TO_C_DOUBLE(arg1) >= 20.0))))
+ ((Xen_is_number(arg1)) && (Xen_real_to_C_double(arg1) >= 20.0))))
return(g_make_smpflt_1(G_TWO_ZERO, arg1, arg2, arg3, arg4));
}
@@ -3487,19 +4481,19 @@ a0*x(n) + a1*x(n-1) + a2*x(n-2)"
}
-static XEN g_make_two_pole(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_two_pole(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- #define H_make_two_pole "(" S_make_two_pole " :a0 :b1 :b2 or :frequency :radius): return a new " S_two_pole " filter; \
+ #define H_make_two_pole "(" S_make_two_pole " a0 b1 b2) or (" S_make_two_pole " frequency radius): return a new " S_two_pole " filter; \
a0*x(n) - b1*y(n-1) - b2*y(n-2)"
- if ((XEN_BOUND_P(arg2)) && /* 0 or 1 args -> coeffs */
- (!(XEN_BOUND_P(arg5)))) /* 5 or more args -> coeffs */
+ if ((Xen_is_bound(arg2)) && /* 0 or 1 args -> coeffs */
+ (!(Xen_is_bound(arg5)))) /* 5 or more args -> coeffs */
{
if ((found_polar_key(arg1)) ||
(found_polar_key(arg2)) || /* if arg1 is frequency as number, then arg2 is either key or number */
- ((!(XEN_BOUND_P(arg3))) &&
+ ((!(Xen_is_bound(arg3))) &&
(!(found_coeff_key(arg1))) &&
- ((XEN_NUMBER_P(arg1)) && (XEN_TO_C_DOUBLE(arg1) >= 2.0))))
+ ((Xen_is_number(arg1)) && (Xen_real_to_C_double(arg1) >= 2.0))))
return(g_make_smpflt_1(G_TWO_POLE, arg1, arg2, arg3, arg4));
}
@@ -3507,71 +4501,87 @@ a0*x(n) - b1*y(n-1) - b2*y(n-2)"
}
-static XEN g_one_zero(XEN obj, XEN fm)
+static Xen g_one_zero(Xen obj, Xen fm)
{
- #define H_one_zero "(" S_one_zero " gen :optional (input 0.0)): one zero filter of input"
+ #define H_one_zero "(" S_one_zero " gen (input 0.0)): one zero filter of input"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_one_zero_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_one_zero, "a " S_one_zero " filter");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_one_zero, "a number");
- return(C_TO_XEN_DOUBLE(mus_one_zero(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_one_zero, S_one_zero, "a one-zero filter");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_one_zero, 2);
+
+ return(C_double_to_Xen_real(mus_one_zero(g, fm1)));
}
-static XEN g_one_pole(XEN obj, XEN fm)
+static Xen g_one_pole(Xen obj, Xen fm)
{
- #define H_one_pole "(" S_one_pole " gen :optional (input 0.0)): one pole filter of input"
+ #define H_one_pole "(" S_one_pole " gen (input 0.0)): one pole filter of input"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_one_pole_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_one_pole, "a " S_one_pole " filter");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_one_pole, "a number");
- return(C_TO_XEN_DOUBLE(mus_one_pole(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_one_pole, S_one_pole, "a one-pole filter");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_one_pole, 2);
+
+ return(C_double_to_Xen_real(mus_one_pole(g, fm1)));
}
-static XEN g_two_zero(XEN obj, XEN fm)
+static Xen g_two_zero(Xen obj, Xen fm)
{
- #define H_two_zero "(" S_two_zero " gen :optional (input 0.0)): two zero filter of input"
+ #define H_two_zero "(" S_two_zero " gen (input 0.0)): two zero filter of input"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_two_zero_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_two_zero, "a " S_two_zero " filter");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_two_zero, "a number");
- return(C_TO_XEN_DOUBLE(mus_two_zero(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_two_zero, S_two_zero, "a two-zero filter");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_two_zero, 2);
+
+ return(C_double_to_Xen_real(mus_two_zero(g, fm1)));
}
-static XEN g_two_pole(XEN obj, XEN fm)
+static Xen g_two_pole(Xen obj, Xen fm)
{
- #define H_two_pole "(" S_two_pole " gen :optional (input 0.0)): two pole filter of input"
+ #define H_two_pole "(" S_two_pole " gen (input 0.0)): two pole filter of input"
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_two_pole_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_two_pole, "a " S_two_pole " filter");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_two_pole, "a number");
- return(C_TO_XEN_DOUBLE(mus_two_pole(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_two_pole, S_two_pole, "a two-pole filter");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_two_pole, 2);
+
+ return(C_double_to_Xen_real(mus_two_pole(g, fm1)));
}
-static XEN g_one_zero_p(XEN obj)
+static Xen g_is_one_zero(Xen obj)
{
- #define H_one_zero_p "(" S_one_zero_p " gen): " PROC_TRUE " if gen is a " S_one_zero
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_one_zero_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_one_zero "(" S_is_one_zero " gen): " PROC_TRUE " if gen is a " S_one_zero
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_one_zero(Xen_to_mus_any(obj)))));
}
-static XEN g_one_pole_p(XEN obj)
+static Xen g_is_one_pole(Xen obj)
{
- #define H_one_pole_p "(" S_one_pole_p " gen): " PROC_TRUE " if gen is a " S_one_pole
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_one_pole_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_one_pole "(" S_is_one_pole " gen): " PROC_TRUE " if gen is a " S_one_pole
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_one_pole(Xen_to_mus_any(obj)))));
}
-static XEN g_two_zero_p(XEN obj)
+static Xen g_is_two_zero(Xen obj)
{
- #define H_two_zero_p "(" S_two_zero_p " gen): " PROC_TRUE " if gen is a " S_two_zero
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_two_zero_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_two_zero "(" S_is_two_zero " gen): " PROC_TRUE " if gen is a " S_two_zero
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_two_zero(Xen_to_mus_any(obj)))));
}
-static XEN g_two_pole_p(XEN obj)
+static Xen g_is_two_pole(Xen obj)
{
- #define H_two_pole_p "(" S_two_pole_p " gen): " PROC_TRUE " if gen is a " S_two_pole
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_two_pole_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_two_pole "(" S_is_two_pole " gen): " PROC_TRUE " if gen is a " S_two_pole
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_two_pole(Xen_to_mus_any(obj)))));
}
@@ -3579,12 +4589,12 @@ static XEN g_two_pole_p(XEN obj)
/* ---------------- formant ---------------- */
-static XEN g_make_frm(bool formant_case, const char *caller, XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen g_make_frm(bool formant_case, const char *caller, Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
mus_any *ge;
int vals;
- XEN args[4];
- XEN keys[2];
+ Xen args[4];
+ Xen keys[2];
int orig_arg[2] = {0, 0};
mus_float_t freq = 0.0, radius = 0.0;
@@ -3595,694 +4605,413 @@ static XEN g_make_frm(bool formant_case, const char *caller, XEN arg1, XEN arg2,
vals = mus_optkey_unscramble(caller, 2, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], caller, orig_arg[0], freq);
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[0], keys[0], "freq ~A > srate/2?");
+ Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
- radius = mus_optkey_to_float(keys[1], caller, orig_arg[1], radius);
+ radius = Xen_optkey_to_float(kw_radius, keys[1], caller, orig_arg[1], radius);
}
if (formant_case)
- ge = mus_make_formant(freq, radius);
- else ge = mus_make_firmant(freq, radius);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ {
+ ge = mus_make_formant(freq, radius);
+ if (ge)
+ {
+ mus_xen *gn;
+ gn = mus_any_to_mus_xen(ge);
+ return(mus_xen_to_object(gn));
+ }
+ }
+ else
+ {
+ ge = mus_make_firmant(freq, radius);
+ if (ge)
+ return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
+ }
+ return(Xen_false);
}
-static XEN g_formant(XEN gen, XEN input, XEN freq)
+static Xen g_formant(Xen gen, Xen input, Xen freq)
{
- #define H_formant "(" S_formant " gen :optional (input 0.0) freq-in-radians): next sample from resonator generator"
+ #define H_formant "(" S_formant " gen (input 0.0) freq-in-radians): next sample from resonator generator"
mus_float_t in1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(gen, gn, g, mus_is_formant, S_formant, "a formant generator");
+
+ Xen_real_to_C_double_if_bound(input, in1, S_formant, 2);
+ if (Xen_is_bound(freq))
+ return(C_double_to_Xen_real(mus_formant_with_frequency(g, in1, Xen_real_to_C_double(freq))));
- XEN_ASSERT_TYPE((MUS_XEN_P(gen) && (mus_formant_p(XEN_TO_MUS_ANY(gen)))), gen, XEN_ARG_1, S_formant, "a formant generator");
+ return(C_double_to_Xen_real(mus_formant(g, in1)));
+}
- if (XEN_NUMBER_P(input))
- in1 = XEN_TO_C_DOUBLE(input);
- else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_formant, "a number");
- if (XEN_NUMBER_P(freq))
- return(C_TO_XEN_DOUBLE(mus_formant_with_frequency(XEN_TO_MUS_ANY(gen), in1, XEN_TO_C_DOUBLE(freq))));
+static Xen g_make_formant(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
+{
+ #define H_make_formant "(" S_make_formant " frequency radius): \
+return a new formant generator (a resonator). radius sets the pole radius (in terms of the 'unit circle'). \
+frequency sets the resonance center frequency (Hz)."
- return(C_TO_XEN_DOUBLE(mus_formant(XEN_TO_MUS_ANY(gen), in1)));
+ return(g_make_frm(true, S_make_formant, arg1, arg2, arg3, arg4));
}
-static XEN g_formant_bank(XEN amps, XEN gens, XEN inp)
+static Xen g_is_formant(Xen os)
{
- #define H_formant_bank "(" S_formant_bank " scls gens inval): sum a bank of " S_formant "s: scls[i]*" S_formant "(gens[i], inval)"
- mus_float_t outval = 0.0, inval;
- int i, size;
- vct *scl;
-#if HAVE_SCHEME
- s7_pointer *elements;
-#endif
+ #define H_is_formant "(" S_is_formant " gen): " PROC_TRUE " if gen is a " S_formant
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_formant(Xen_to_mus_any(os)))));
+}
- XEN_ASSERT_TYPE(XEN_VECTOR_P(gens), gens, XEN_ARG_2, S_formant_bank, "a vector of formant generators");
- XEN_ASSERT_TYPE(MUS_VCT_P(amps), amps, XEN_ARG_1, S_formant_bank, "a vct");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(inp), inp, XEN_ARG_3, S_formant_bank, "a number");
- size = XEN_VECTOR_LENGTH(gens);
- if (size == 0) return(XEN_ZERO);
- scl = XEN_TO_VCT(amps);
- inval = XEN_TO_C_DOUBLE(inp);
-#if HAVE_SCHEME
- elements = s7_vector_elements(gens);
-#endif
-
- for (i = 0; i < size; i++)
- {
- XEN g;
-#if HAVE_SCHEME
- g = elements[i];
-#else
- g = XEN_VECTOR_REF(gens, i);
-#endif
- if (MUS_XEN_P(g))
- {
- mus_any *fg;
- fg = XEN_TO_MUS_ANY(g);
- if (mus_formant_p(fg))
- outval += (scl->data[i] * mus_formant(fg, inval));
- else XEN_WRONG_TYPE_ARG_ERROR(S_formant_bank, i, g, "a formant generator");
- }
- else XEN_WRONG_TYPE_ARG_ERROR(S_formant_bank, i, g, "a formant generator");
- }
- return(C_TO_XEN_DOUBLE(outval));
-}
-
-
-static XEN g_make_formant(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_make_formant "(" S_make_formant " :frequency :radius): \
-return a new formant generator (a resonator). radius sets the pole radius (in terms of the 'unit circle'). \
-frequency sets the resonance center frequency (Hz)."
-
- return(g_make_frm(true, S_make_formant, arg1, arg2, arg3, arg4));
-}
+static Xen g_set_formant_radius_and_frequency(Xen gen, Xen rad, Xen frq)
+{
+ #define H_mus_set_formant_radius_and_frequency "(" S_mus_set_formant_radius_and_frequency " gen radius frequency): set " S_formant " \
+generator gen's radius and frequency"
+ mus_any *g = NULL;
+ mus_float_t radius, frequency;
+ mus_xen *gn;
+ Xen_to_C_generator(gen, gn, g, mus_is_formant, S_mus_set_formant_radius_and_frequency, "a formant generator");
-static XEN g_formant_p(XEN os)
-{
- #define H_formant_p "(" S_formant_p " gen): " PROC_TRUE " if gen is a " S_formant
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(os)) && (mus_formant_p(XEN_TO_MUS_ANY(os)))));
-}
-
-
-static XEN g_set_formant_radius_and_frequency(XEN gen, XEN rad, XEN frq)
-{
- #define H_mus_set_formant_radius_and_frequency "(" S_mus_set_formant_radius_and_frequency " gen radius frequency): set (" S_formant " \
-generator) gen's radius and frequency"
+ Xen_to_C_double_or_error(rad, radius, S_mus_set_formant_radius_and_frequency, 2);
+ Xen_to_C_double_or_error(frq, frequency, S_mus_set_formant_radius_and_frequency, 3);
- XEN_ASSERT_TYPE((MUS_XEN_P(gen) && (mus_formant_p(XEN_TO_MUS_ANY(gen)))), gen, XEN_ARG_1, S_mus_set_formant_radius_and_frequency, "a formant generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(rad), rad, XEN_ARG_2, S_mus_set_formant_radius_and_frequency, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(frq), frq, XEN_ARG_3, S_mus_set_formant_radius_and_frequency, "a number");
- mus_set_formant_radius_and_frequency(XEN_TO_MUS_ANY(gen), XEN_TO_C_DOUBLE(rad), XEN_TO_C_DOUBLE(frq));
+ mus_set_formant_radius_and_frequency(g, radius, frequency);
return(rad);
}
-/* ---------------- firmant ---------------- */
-
-static XEN g_make_firmant(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen g_set_formant_frequency(Xen gen, Xen frq)
{
- #define H_make_firmant "(" S_make_firmant " :frequency :radius): \
-return a new firmant generator (a resonator). radius sets the pole radius (in terms of the 'unit circle'). \
-frequency sets the resonance center frequency (Hz)."
-
- return(g_make_frm(false, S_make_firmant, arg1, arg2, arg3, arg4));
-}
+ #define H_mus_set_formant_frequency "(" S_mus_set_formant_frequency " gen frequency): set " S_formant " generator gen's frequency"
+ mus_any *g = NULL;
+ mus_float_t frequency;
+ mus_xen *gn;
+ Xen_to_C_generator(gen, gn, g, mus_is_formant, S_mus_set_formant_frequency, "a formant generator");
+ Xen_to_C_double_or_error(frq, frequency, S_mus_set_formant_frequency, 2);
-static XEN g_firmant_p(XEN os)
-{
- #define H_firmant_p "(" S_firmant_p " gen): " PROC_TRUE " if gen is a " S_firmant " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(os)) && (mus_firmant_p(XEN_TO_MUS_ANY(os)))));
+ mus_set_formant_frequency(g, frequency);
+ return(frq);
}
-static XEN g_firmant(XEN gen, XEN input, XEN freq)
+static Xen g_make_formant_bank(Xen frms, Xen amps)
{
- #define H_firmant "(" S_firmant " gen :optional (input 0.0) freq-in-radians): next sample from resonator generator"
- mus_float_t in1 = 0.0;
-
- XEN_ASSERT_TYPE((MUS_XEN_P(gen) && (mus_firmant_p(XEN_TO_MUS_ANY(gen)))), gen, XEN_ARG_1, S_firmant, "a firmant generator");
-
- if (XEN_NUMBER_P(input))
- in1 = XEN_TO_C_DOUBLE(input);
- else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(input), input, XEN_ARG_2, S_firmant, "a number");
-
- if (XEN_NUMBER_P(freq))
- return(C_TO_XEN_DOUBLE(mus_firmant_with_frequency(XEN_TO_MUS_ANY(gen), in1, XEN_TO_C_DOUBLE(freq))));
-
- return(C_TO_XEN_DOUBLE(mus_firmant(XEN_TO_MUS_ANY(gen), in1)));
-}
-
+ #define H_make_formant_bank "(" S_make_formant_bank " gens amps): return a new formant-bank generator."
+ mus_any *ge = NULL;
+ mus_any **gens;
+ int i, j, size;
+ vct *v = NULL;
-/* ---------------- frame ---------------- */
+ Xen_check_type(Xen_is_vector(frms), frms, 1, S_make_formant_bank, "a vector of formant generators");
+ /* need size and elements -> mus_any */
-#define MUS_MAX_CHANS 128
+ size = Xen_vector_length(frms);
+ if (size == 0) return(Xen_false);
+ gens = (mus_any **)calloc(size, sizeof(mus_any *));
-/* this needs to be a reasonably small number -- user can override the size check using "!" as in make-mixer!
- */
+ if (Xen_is_bound(amps))
+ {
+ v = Xen_to_vct(amps);
+ if (!v) Xen_check_type(false, amps, 2, S_make_formant_bank, "a " S_vct " if anything");
+ }
-static XEN g_make_frame_2(int len, XEN args)
-{
- mus_any *ge;
- ge = (mus_any *)mus_make_empty_frame((len == 0) ? 1 : len);
- if (ge)
+ for (i = 0, j = 0; i < size; i++)
{
- if (len > 0)
+ Xen g;
+ g = Xen_vector_ref(frms, i);
+ if (mus_is_xen(g))
{
- mus_float_t *vals;
- XEN lst;
- int i;
- vals = mus_data(ge);
- for (i = 0, lst = XEN_COPY_ARG(args); (i < len) && (XEN_NOT_NULL_P(lst)); i++, lst = XEN_CDR(lst))
- if (XEN_NUMBER_P(XEN_CAR(lst)))
- vals[i] = XEN_TO_C_DOUBLE(XEN_CAR(lst));
- else
- {
- mus_free(ge);
- XEN_WRONG_TYPE_ARG_ERROR(S_make_frame, i, XEN_CAR(lst), "a number");
- }
+ mus_any *fg;
+ fg = Xen_to_mus_any(g);
+ if (mus_is_formant(fg))
+ gens[j++] = fg;
}
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, xen_make_vct_wrapper(mus_length(ge), mus_data(ge)))));
}
- return(XEN_FALSE);
-}
-
-
-static XEN g_make_frame_1(XEN arglist, bool check_size)
-{
- #if HAVE_SCHEME
- #define make_frame_example "(" S_make_frame " 2 .1 .2)"
- #endif
- #if HAVE_RUBY
- #define make_frame_example "make_frame(2, 0.1, 0.2)"
- #endif
- #if HAVE_FORTH
- #define make_frame_example "2 0.1 0.2 make-frame"
- #endif
-
- #define H_make_frame "(" S_make_frame " chans val0 val1 ...): return a new frame object \
-with chans samples, each sample set from the trailing arguments (defaulting to 0.0):\n " make_frame_example
-
- /* make_empty_frame from first of arglist, then if more args, load vals */
- int len = 0, size = 0;
-
- XEN_ASSERT_TYPE((XEN_LIST_P_WITH_LENGTH(arglist, len)) && (len >= 0), arglist, XEN_ARG_1, S_make_frame, "a list");
+ if (j > 0)
+ ge = mus_make_formant_bank(j, gens, (v) ? mus_vct_data(v) : NULL);
+ free(gens);
- if (len > 0)
+ if (ge)
{
- XEN cararg;
- cararg = XEN_CAR(arglist);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(cararg), cararg, XEN_ARG_1, S_make_frame, "a number");
- size = XEN_TO_C_INT_OR_ELSE(cararg, 0);
- if (size <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_frame, XEN_ARG_1, cararg, "chans ~A <= 0?");
- if (len > (size + 1))
- clm_error(S_make_frame, "extra trailing args?", arglist);
- if ((check_size) &&
- (size > MUS_MAX_CHANS))
- XEN_OUT_OF_RANGE_ERROR(S_make_frame, XEN_ARG_1, C_TO_XEN_INT(size), "size ~A too big");
+ if (v)
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, frms, amps)));
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, frms)));
}
-
- return(g_make_frame_2(size, (len <= 1) ? XEN_EMPTY_LIST : XEN_CDR(arglist)));
-}
-
-
-static XEN g_make_frame(XEN arglist)
-{
- return(g_make_frame_1(arglist, true));
+ return(Xen_false);
}
-static XEN g_make_frame_unchecked(XEN arglist)
+static Xen g_is_formant_bank(Xen os)
{
- return(g_make_frame_1(arglist, false));
+ #define H_is_formant_bank "(" S_is_formant_bank " gen): " PROC_TRUE " if gen is a " S_formant_bank
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_formant_bank(Xen_to_mus_any(os)))));
}
-static XEN g_frame(XEN args)
+static Xen g_formant_bank(Xen gens, Xen inp)
{
- #define H_frame "(" S_frame " args...): returns a new frame with args as its contents: (frame .1 .2)"
- return(g_make_frame_2(XEN_LIST_LENGTH(args), args));
-}
+ #define H_formant_bank "(" S_formant_bank " gens inval): sum a bank of " S_formant " generators"
+ mus_any *bank = NULL;
+ mus_xen *gn;
+ Xen_to_C_generator(gens, gn, bank, mus_is_formant_bank, S_formant_bank, "a formant-bank generator");
+ if (mus_is_vct(inp))
+ return(C_double_to_Xen_real(mus_formant_bank_with_inputs(bank, mus_vct_data(Xen_to_vct(inp)))));
+ if (Xen_is_number(inp))
+ return(C_double_to_Xen_real(mus_formant_bank(bank, Xen_real_to_C_double(inp))));
+ if (!Xen_is_bound(inp))
+ return(C_double_to_Xen_real(mus_formant_bank(bank, 0.0)));
-static XEN g_frame_p(XEN obj)
-{
- #define H_frame_p "(" S_frame_p " gen): " PROC_TRUE " if gen is a frame"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_frame_p(XEN_TO_MUS_ANY(obj)))));
+ Xen_check_type(false, inp, 2, S_formant_bank, "a number or a " S_vct);
+ return(Xen_false);
}
-static XEN g_frame_add(XEN uf1, XEN uf2, XEN ures) /* optional res */
-{
- #define H_frame_add "(" S_frame_add " f1 f2 :optional outf): add f1 and f2 returning outf; \
-if outf is not given, a new frame is created. outf[i] = f1[i] + f2[i]. Either f1 or f2 can be a float."
-
- mus_any *res = NULL, *nf = NULL;
-
- if ((MUS_XEN_P(ures)) &&
- (mus_frame_p(XEN_TO_MUS_ANY(ures))))
- res = (mus_any *)XEN_TO_MUS_ANY(ures);
-
- if (XEN_NUMBER_P(uf1))
- {
- XEN_ASSERT_TYPE((MUS_XEN_P(uf2)) && (mus_frame_p(XEN_TO_MUS_ANY(uf2))), uf2, XEN_ARG_2, S_frame_add, "a frame");
- nf = mus_frame_offset((mus_any *)XEN_TO_MUS_ANY(uf2), XEN_TO_C_DOUBLE(uf1), res);
- }
- else
- {
- if (XEN_NUMBER_P(uf2))
- {
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_frame_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_frame_add, "a frame");
- nf = mus_frame_offset((mus_any *)XEN_TO_MUS_ANY(uf1), XEN_TO_C_DOUBLE(uf2), res);
- }
- }
- if (!nf)
- {
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_frame_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_frame_add, "a frame");
- XEN_ASSERT_TYPE((MUS_XEN_P(uf2)) && (mus_frame_p(XEN_TO_MUS_ANY(uf2))), uf2, XEN_ARG_2, S_frame_add, "a frame");
- nf = mus_frame_add((mus_any *)XEN_TO_MUS_ANY(uf1), (mus_any *)XEN_TO_MUS_ANY(uf2), res);
- }
- if (res)
- return(ures);
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(nf, xen_make_vct_wrapper(mus_length(nf), mus_data(nf)))));
-}
+/* ---------------- one-pole-all-pass ---------------- */
-static XEN g_frame_multiply(XEN uf1, XEN uf2, XEN ures) /* optional res */
+static Xen g_make_one_pole_all_pass(Xen arg1, Xen arg2)
{
- #define H_frame_multiply "(" S_frame_multiply " f1 f2 :optional outf): multiply f1 and f2 (elementwise) returning outf; \
-if outf is not given, a new frame is created. outf[i] = f1[i] * f2[i]."
+ #define H_make_one_pole_all_pass "(" S_make_one_pole_all_pass " size coeff): return a new one-pole-all-pass generator."
- mus_any *res = NULL, *nf = NULL;
+ mus_any *ge = NULL;
+ int size;
+ mus_float_t coeff;
- if ((MUS_XEN_P(ures)) &&
- (mus_frame_p(XEN_TO_MUS_ANY(ures))))
- res = (mus_any *)XEN_TO_MUS_ANY(ures);
+ Xen_check_type(Xen_is_integer(arg1), arg1, 1, S_make_one_pole_all_pass, "an integer");
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(arg2), arg2, 2, S_make_one_pole_all_pass, "a number");
+#endif
- if (XEN_NUMBER_P(uf1))
- {
- XEN_ASSERT_TYPE((MUS_XEN_P(uf2)) && (mus_frame_p(XEN_TO_MUS_ANY(uf2))), uf2, XEN_ARG_2, S_frame_multiply, "a frame");
- nf = mus_frame_scale((mus_any *)XEN_TO_MUS_ANY(uf2), XEN_TO_C_DOUBLE(uf1), res);
- }
- else
- {
- if (XEN_NUMBER_P(uf2))
- {
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_frame_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_frame_multiply, "a frame");
- nf = mus_frame_scale((mus_any *)XEN_TO_MUS_ANY(uf1), XEN_TO_C_DOUBLE(uf2), res);
- }
- }
+ size = Xen_integer_to_C_int(arg1);
+ if (size < 0)
+ Xen_out_of_range_error(S_make_one_pole_all_pass, 1, arg1, "size < 0?");
+ if (size == 0) return(Xen_false);
+ coeff = Xen_real_to_C_double(arg2);
- if (!nf)
- {
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_frame_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_frame_multiply, "a frame");
- XEN_ASSERT_TYPE((MUS_XEN_P(uf2)) && (mus_frame_p(XEN_TO_MUS_ANY(uf2))), uf2, XEN_ARG_2, S_frame_multiply, "a frame");
- nf = mus_frame_multiply((mus_any *)XEN_TO_MUS_ANY(uf1), (mus_any *)XEN_TO_MUS_ANY(uf2), res);
- }
- if (res)
- return(ures);
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(nf, xen_make_vct_wrapper(mus_length(nf), mus_data(nf)))));
+ ge = mus_make_one_pole_all_pass(size, coeff);
+ if (ge)
+ return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
+ return(Xen_false);
}
-static XEN g_frame_ref(XEN uf1, XEN uchan)
+static Xen g_is_one_pole_all_pass(Xen os)
{
- #define H_frame_ref "(" S_frame_ref " f chan): f[chan] (the chan-th sample in frame f"
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_frame_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_frame_ref, "a frame");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(uchan), uchan, XEN_ARG_2, S_frame_ref, "an integer");
- return(C_TO_XEN_DOUBLE(mus_frame_ref((mus_any *)XEN_TO_MUS_ANY(uf1), XEN_TO_C_INT(uchan))));
+ #define H_is_one_pole_all_pass "(" S_is_one_pole_all_pass " gen): " PROC_TRUE " if gen is a " S_one_pole_all_pass
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_one_pole_all_pass(Xen_to_mus_any(os)))));
}
-static XEN g_frame_set(XEN uf1, XEN uchan, XEN val)
+static Xen g_one_pole_all_pass(Xen gen, Xen fm)
{
- #define H_frame_set "(" S_frame_set " f chan val) sets frame f's chan-th sample to val: f[chan] = val"
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_frame_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_frame_set, "a frame");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(uchan), uchan, XEN_ARG_2, S_frame_set, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_3, S_frame_set, "a number");
- return(C_TO_XEN_DOUBLE(mus_frame_set((mus_any *)XEN_TO_MUS_ANY(uf1), XEN_TO_C_INT(uchan), XEN_TO_C_DOUBLE(val))));
-}
+ #define H_one_pole_all_pass "(" S_one_pole_all_pass " gen (input 0.0)): run a one-pole-all-pass generator"
+ mus_float_t in1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+ Xen_to_C_generator(gen, gn, g, mus_is_one_pole_all_pass, S_one_pole_all_pass, "a one-pole-all-pass generator");
+ Xen_real_to_C_double_if_bound(fm, in1, S_one_pole_all_pass, 2);
+ return(C_double_to_Xen_real(mus_one_pole_all_pass(g, in1)));
+}
-/* ---------------- mixer ---------------- */
-static XEN g_mixer_p(XEN obj)
-{
- #define H_mixer_p "(" S_mixer_p " gen): " PROC_TRUE " if gen is a mixer"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_mixer_p(XEN_TO_MUS_ANY(obj)))));
-}
+/* ---------------- firmant ---------------- */
-static XEN g_mixer_ref(XEN uf1, XEN in, XEN out)
+static Xen g_make_firmant(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
- #define H_mixer_ref "(" S_mixer_ref " m in out): m[in, out], the mixer coefficient at location (in, out)"
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_mixer_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_mixer_ref, "a mixer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(in), in, XEN_ARG_2, S_mixer_ref, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(out), out, XEN_ARG_3, S_mixer_ref, "an integer");
- return(C_TO_XEN_DOUBLE(mus_mixer_ref((mus_any *)XEN_TO_MUS_ANY(uf1),
- XEN_TO_C_INT(in),
- XEN_TO_C_INT(out))));
+ #define H_make_firmant "(" S_make_firmant " frequency radius): \
+return a new firmant generator (a resonator). radius sets the pole radius (in terms of the 'unit circle'). \
+frequency sets the resonance center frequency (Hz)."
+
+ return(g_make_frm(false, S_make_firmant, arg1, arg2, arg3, arg4));
}
-static XEN g_mixer_set(XEN uf1, XEN in, XEN out, XEN val)
+static Xen g_is_firmant(Xen os)
{
- #define H_mixer_set "(" S_mixer_set " m in out val): set m[in, out] = val"
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_mixer_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_mixer_set, "a mixer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(in), in, XEN_ARG_2, S_mixer_set, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(out), out, XEN_ARG_3, S_mixer_set, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_4, S_mixer_set, "a number");
- return(C_TO_XEN_DOUBLE(mus_mixer_set((mus_any *)XEN_TO_MUS_ANY(uf1),
- XEN_TO_C_INT(in),
- XEN_TO_C_INT(out),
- XEN_TO_C_DOUBLE(val))));
+ #define H_is_firmant "(" S_is_firmant " gen): " PROC_TRUE " if gen is a " S_firmant " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_firmant(Xen_to_mus_any(os)))));
}
-static XEN g_mixer_multiply(XEN uf1, XEN uf2, XEN ures) /* optional res */
+static Xen g_firmant(Xen gen, Xen input, Xen freq)
{
- #define H_mixer_multiply "(" S_mixer_multiply " m1 m2 (outm " PROC_FALSE ")): multiply mixers m1 and m2 (a matrix multiply), \
-returning the mixer outm, or creating a new mixer if outm is not given. Either m1 or m2 can be a float, rather than a mixer."
-
- mus_any *res = NULL, *u1 = NULL, *u2 = NULL, *nm = NULL;
- bool u1_mixer = false, u2_mixer = false;
-
- if ((MUS_XEN_P(ures)) &&
- (mus_mixer_p(XEN_TO_MUS_ANY(ures))))
- res = (mus_any *)XEN_TO_MUS_ANY(ures);
-
- if (MUS_XEN_P(uf1))
- {
- u1 = XEN_TO_MUS_ANY(uf1);
- u1_mixer = mus_mixer_p(u1);
- if (!u1_mixer)
- XEN_ASSERT_TYPE(mus_frame_p(u1), uf1, XEN_ARG_1, S_mixer_multiply, "a frame or mixer");
- }
- else XEN_ASSERT_TYPE(XEN_NUMBER_P(uf1), uf1, XEN_ARG_1, S_mixer_multiply, "a number, frame or mixer");
+ #define H_firmant "(" S_firmant " gen (input 0.0) freq-in-radians): next sample from resonator generator"
+ mus_float_t in1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
- if (MUS_XEN_P(uf2))
- {
- u2 = XEN_TO_MUS_ANY(uf2);
- u2_mixer = mus_mixer_p(u2);
- if (!u2_mixer)
- XEN_ASSERT_TYPE(mus_frame_p(u2), uf2, XEN_ARG_2, S_mixer_multiply, "a frame or mixer");
- }
- else XEN_ASSERT_TYPE(XEN_NUMBER_P(uf2), uf2, XEN_ARG_2, S_mixer_multiply, "a number, frame or mixer");
+ Xen_to_C_generator(gen, gn, g, mus_is_firmant, S_firmant, "a firmant generator");
- XEN_ASSERT_TYPE(u1_mixer || u2_mixer, uf1, XEN_ARG_1, S_mixer_multiply, "one arg must be a mixer");
- if (!u1)
- {
- XEN_ASSERT_TYPE(u2_mixer, uf2, XEN_ARG_2, S_mixer_multiply, "a mixer");
- nm = mus_mixer_scale(u2, XEN_TO_C_DOUBLE(uf1), res);
- }
- else
- {
- if (!u2)
- {
- XEN_ASSERT_TYPE(u1_mixer, uf1, XEN_ARG_1, S_mixer_multiply, "a mixer");
- nm = mus_mixer_scale(u1, XEN_TO_C_DOUBLE(uf2), res);
- }
- }
- if (!nm)
- {
- if ((u1_mixer) && (u2_mixer))
- nm = mus_mixer_multiply(u1, u2, res);
- else nm = mus_frame_to_frame(u1, u2, res);
- }
- if (res)
- return(ures);
- return(mus_xen_to_object(mus_any_to_mus_xen(nm)));
+ Xen_real_to_C_double_if_bound(input, in1, S_firmant, 2);
+ if (Xen_is_bound(freq))
+ return(C_double_to_Xen_real(mus_firmant_with_frequency(g, in1, Xen_real_to_C_double(freq))));
+ return(C_double_to_Xen_real(mus_firmant(g, in1)));
}
-static XEN g_mixer_add(XEN uf1, XEN uf2, XEN ures) /* optional res */
+static mus_float_t mus_pink_noise(vct *v)
{
- #define H_mixer_add "(" S_mixer_add " m1 m2 :optional outm): add mixers m1 and m2 \
-returning the mixer outm, or creating a new mixer if outm is not given. \
-Either m1 or m2 can be a float, rather than a mixer."
-
- mus_any *res = NULL, *nm = NULL;
+ int i, size;
+ mus_float_t sum = 0.0, amp, x;
+ mus_float_t *data;
- if ((MUS_XEN_P(ures)) &&
- (mus_mixer_p(XEN_TO_MUS_ANY(ures))))
- res = (mus_any *)XEN_TO_MUS_ANY(ures);
+ size = mus_vct_length(v);
+ data = mus_vct_data(v);
+ amp = data[0];
- if (XEN_NUMBER_P(uf1))
- {
- XEN_ASSERT_TYPE((MUS_XEN_P(uf2)) && (mus_mixer_p(XEN_TO_MUS_ANY(uf2))), uf2, XEN_ARG_2, S_mixer_add, "a mixer");
- nm = mus_mixer_offset((mus_any *)XEN_TO_MUS_ANY(uf2), XEN_TO_C_DOUBLE(uf1), res);
- }
- else
+ for (i = 2, x = 0.5; i < size; i += 2, x *= 0.5)
{
- if (XEN_NUMBER_P(uf2))
+ sum += data[i];
+ data[i + 1] -= x;
+ if (data[i + 1] < 0.0)
{
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_mixer_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_mixer_add, "a mixer");
- nm = mus_mixer_offset((mus_any *)XEN_TO_MUS_ANY(uf1), XEN_TO_C_DOUBLE(uf2), res);
+ data[i] = mus_random(amp);
+ data[i + 1] += 1.0;
}
}
-
- if (!nm)
- {
- XEN_ASSERT_TYPE((MUS_XEN_P(uf1)) && (mus_mixer_p(XEN_TO_MUS_ANY(uf1))), uf1, XEN_ARG_1, S_mixer_add, "a mixer");
- XEN_ASSERT_TYPE((MUS_XEN_P(uf2)) && (mus_mixer_p(XEN_TO_MUS_ANY(uf2))), uf2, XEN_ARG_2, S_mixer_add, "a mixer");
- nm = mus_mixer_add((mus_any *)XEN_TO_MUS_ANY(uf1), (mus_any *)XEN_TO_MUS_ANY(uf2), res);
- }
-
- if (res)
- return(ures);
- return(mus_xen_to_object(mus_any_to_mus_xen(nm)));
-}
-
-
-/* frame->frame chooses the multiplication based on arg order */
-
-static XEN g_frame_to_frame(XEN mx, XEN infr, XEN outfr) /* optional outfr */
-{
- #define H_frame_to_frame "(" S_frame_to_frame " m f :optional outf): pass frame f through mixer m \
-returning frame outf (or creating a new frame if necessary); this is a matrix multiply of m and f"
-
- mus_any *res = NULL, *arg1, *arg2, *nm = NULL;
-
- XEN_ASSERT_TYPE(MUS_XEN_P(mx), mx, XEN_ARG_1, S_frame_to_frame, "a mixer or frame");
- XEN_ASSERT_TYPE(MUS_XEN_P(infr), infr, XEN_ARG_2, S_frame_to_frame, "a mixer or frame");
-
- arg1 = (mus_any *)XEN_TO_MUS_ANY(mx);
- arg2 = (mus_any *)XEN_TO_MUS_ANY(infr);
- XEN_ASSERT_TYPE((mus_frame_p(arg1) && mus_mixer_p(arg2)) ||
- (mus_mixer_p(arg1) && mus_frame_p(arg2)),
- mx, XEN_ARG_1, S_frame_to_frame, "first two args should be mixer and frame");
-
- if ((MUS_XEN_P(outfr)) &&
- (mus_frame_p(XEN_TO_MUS_ANY(outfr))))
- res = (mus_any *)XEN_TO_MUS_ANY(outfr);
-
- nm = mus_frame_to_frame(arg1, arg2, res);
- if (res)
- return(outfr);
- return(mus_xen_to_object(mus_any_to_mus_xen(nm)));
+ return(sum + mus_random(amp));
}
-
-static XEN g_frame_to_list(XEN fr)
+#define S_pink_noise "pink-noise"
+static Xen g_pink_noise(Xen gens)
{
- #define H_frame_to_list "(" S_frame_to_list " f): return contents of frame f as a list"
- mus_any *val;
- int i;
- mus_float_t *vals;
- XEN res = XEN_EMPTY_LIST;
+ #define H_pink_noise "(pink-noise gens) generates an approximation to pink noise."
+ int size;
+ vct *v;
- XEN_ASSERT_TYPE((MUS_XEN_P(fr)) && (mus_frame_p(XEN_TO_MUS_ANY(fr))), fr, XEN_ONLY_ARG, S_frame_to_list, "a frame");
+ Xen_check_type((mus_is_vct(gens)) && (Xen_vector_rank(gens) == 1), gens, 1, S_pink_noise, "a " S_vct);
+ v = Xen_to_vct(gens);
+ size = mus_vct_length(v);
+ if (size == 0)
+ return(XEN_ZERO); /* needs to be upper case for Forth/Ruby */
+ Xen_check_type((size & 1) == 0, gens, 1, S_pink_noise, "an even length " S_vct);
- val = (mus_any *)XEN_TO_MUS_ANY(fr);
- vals = mus_data(val);
- for (i = (int)mus_length(val) - 1; i >= 0; i--)
- res = XEN_CONS(C_TO_XEN_DOUBLE(vals[i]), res);
- return(res);
+ return(C_double_to_Xen_real(mus_pink_noise(v)));
}
-
-static XEN g_frame_to_sample(XEN mx, XEN fr)
+#if HAVE_SCHEME
+static s7_double piano_noise(s7_int *g, s7_double noi)
{
- #define H_frame_to_sample "(" S_frame_to_sample " m f): pass frame f through mixer (or frame) m to produce a sample"
- XEN_ASSERT_TYPE((MUS_XEN_P(mx)), mx, XEN_ARG_1, S_frame_to_sample, "a frame or mixer");
- XEN_ASSERT_TYPE((MUS_XEN_P(fr)) && (mus_frame_p(XEN_TO_MUS_ANY(fr))), fr, XEN_ARG_2, S_frame_to_sample, "a frame");
- return(C_TO_XEN_DOUBLE(mus_frame_to_sample(XEN_TO_MUS_ANY(mx),
- (mus_any *)XEN_TO_MUS_ANY(fr))));
+ g[0] = ((g[0] * 1103515245) + 12345) & 0xffffffff;
+ noi *= (((s7_double)g[0] * 4.6566128730774e-10) - 1.0);
+ return(noi);
}
-
-static XEN g_sample_to_frame(XEN mx, XEN insp, XEN outfr) /* optional outfr */
+#define S_piano_noise "piano-noise"
+static Xen g_piano_noise(Xen gen, XEN amp)
{
- #define H_sample_to_frame "(" S_sample_to_frame " m val :optional outf): pass the sample val through mixer m \
-returning frame outf (creating it if necessary)"
-
- mus_any *res = NULL, *nf = NULL;
-
- XEN_ASSERT_TYPE((MUS_XEN_P(mx)), mx, XEN_ARG_1, S_sample_to_frame, "a frame or mixer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(insp), insp, XEN_ARG_2, S_sample_to_frame, "a number");
+ #define H_piano_noise "(piano-noise gen amp) generates the noise used in the piano instrument."
- if ((MUS_XEN_P(outfr)) &&
- (mus_frame_p(XEN_TO_MUS_ANY(outfr))))
- res = (mus_any *)XEN_TO_MUS_ANY(outfr);
+ if (!s7_is_int_vector(gen)) s7_wrong_type_arg_error(s7, S_piano_noise, 1, gen, "an int-vector");
+ if (!s7_is_real(amp)) s7_wrong_type_arg_error(s7, S_piano_noise, 2, amp, "a real");
- nf = mus_sample_to_frame(XEN_TO_MUS_ANY(mx), XEN_TO_C_DOUBLE(insp), res);
- if (res)
- return(outfr);
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(nf, xen_make_vct_wrapper(mus_length(nf), mus_data(nf)))));
+ return(C_double_to_Xen_real(piano_noise(s7_int_vector_elements(gen), Xen_real_to_C_double(amp))));
}
-static XEN g_make_scalar_mixer(XEN chans, XEN val)
+#define S_singer_filter "singer-filter"
+static Xen g_singer_filter(Xen start, Xen end, Xen tmp, Xen dline1, Xen dline2, Xen coeffs)
{
- #define H_make_scalar_mixer "(" S_make_scalar_mixer " chans value): return a mixer \
-with 'chans' channels, and 'val' along the diagonal"
-
- mus_any *mx = NULL;
- int size;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chans), chans, XEN_ARG_1, S_make_scalar_mixer, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_make_scalar_mixer, "a number");
-
- size = XEN_TO_C_INT(chans);
- if (size <= 0) XEN_OUT_OF_RANGE_ERROR(S_make_scalar_mixer, 1, chans, "chans ~A <= 0?");
- if (size > MUS_MAX_CHANS) XEN_OUT_OF_RANGE_ERROR(S_make_scalar_mixer, 1, chans, "too many chans: ~A");
- mx = mus_make_scalar_mixer(size, XEN_TO_C_DOUBLE(val));
- if (mx)
- return(mus_xen_to_object(mus_any_to_mus_xen(mx)));
- return(XEN_FALSE);
-}
+ #define H_singer_filter "this is an optimization for the singer instrument"
+ int j, k, beg, lim;
+ s7_double *d1, *d2, *cf;
+ s7_double temp, x;
+ if (!s7_is_integer(start)) s7_wrong_type_arg_error(s7, S_singer_filter, 1, start, "an integer");
+ if (!s7_is_integer(end)) s7_wrong_type_arg_error(s7, S_singer_filter, 2, end, "an integer");
+ if (!s7_is_real(tmp)) s7_wrong_type_arg_error(s7, S_singer_filter, 3, tmp, "a real");
+ if (!s7_is_float_vector(dline1)) s7_wrong_type_arg_error(s7, S_singer_filter, 4, dline1, "a float-vector");
+ if (!s7_is_float_vector(dline2)) s7_wrong_type_arg_error(s7, S_singer_filter, 5, dline2, "a float-vector");
+ if (!s7_is_float_vector(coeffs)) s7_wrong_type_arg_error(s7, S_singer_filter, 6, coeffs, "a float-vector");
+
+ x = 0.0;
+ beg = s7_integer(start);
+ lim = s7_integer(end);
+ d1 = s7_float_vector_elements(dline1);
+ d2 = s7_float_vector_elements(dline2);
+ cf = s7_float_vector_elements(coeffs);
+ temp = s7_number_to_real(s7, tmp);
-static XEN g_make_mixer_2(int len, XEN args)
-{
- mus_any *ge;
- ge = (mus_any *)mus_make_empty_mixer((len == 0) ? 1 : len);
- if (ge)
+ for (k = beg, j = beg + 1; j < lim; k++, j++)
{
- if (len > 0)
- {
- XEN lst;
- int i, j, k, size;
- mus_float_t **vals;
- size = len * len;
- vals = (mus_float_t **)mus_data(ge);
- j = 0;
- k = 0;
- for (i = 0, lst = XEN_COPY_ARG(args); (i < size) && (XEN_NOT_NULL_P(lst)); i++, lst = XEN_CDR(lst))
- {
- if (XEN_NUMBER_P(XEN_CAR(lst)))
- vals[j][k] = XEN_TO_C_DOUBLE(XEN_CAR(lst));
- else
- {
- mus_free(ge);
- XEN_WRONG_TYPE_ARG_ERROR(S_make_mixer, i, XEN_CAR(lst), "a number");
- }
- k++;
- if (k == len)
- {
- k = 0;
- j++;
- if (j >= len) break;
- }
- }
- }
- return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
+ s7_double temp1;
+ x = d2[j + 1];
+ d2[j] = x + (cf[j] * (d1[k] - x));
+ temp1 = temp;
+ temp = d1[k] + d2[j] - x;
+ d1[k] = temp1;
}
- return(XEN_FALSE);
-
-}
-
-
-static XEN g_make_mixer_1(XEN arglist, bool check_size)
-{
- #if HAVE_SCHEME
- #define make_mixer_example "(" S_make_mixer " 2 .5 .25 .125 1.0))"
- #endif
- #if HAVE_RUBY
- #define make_mixer_example "make_mixer(2, 0.5, 0.25, 0.125, 1.0)"
- #endif
- #if HAVE_FORTH
- #define make_mixer_example "2 0.5 0.25 0.125 1.0 make-mixer"
- #endif
-
- #define H_make_mixer "(" S_make_mixer " chans val0 val1 ...): make a new mixer object \
-with chans inputs and outputs, initializing the scalars from the rest of the arguments:\n " make_mixer_example "\n\
- | .5 .25 |\n\
- | .125 1.0 |\n"
-
- /* make_empty_mixer from first of arglist, then if more args, load vals */
-
- XEN cararg;
- int size = 0, len = 0;
-
- XEN_ASSERT_TYPE(XEN_LIST_P_WITH_LENGTH(arglist, len), arglist, XEN_ARG_1, S_make_mixer, "a list");
- if (len == 0) clm_error(S_make_mixer, "need at least 1 arg", arglist);
-
- cararg = XEN_CAR(arglist);
- if (!(XEN_NUMBER_P(cararg)))
- XEN_WRONG_TYPE_ARG_ERROR(S_make_mixer, 1, cararg, "an integer = number of chans");
-
- size = XEN_TO_C_INT_OR_ELSE(cararg, 0);
- if (size <= 0) XEN_OUT_OF_RANGE_ERROR(S_make_mixer, 1, cararg, "chans ~A <= 0?");
- if ((check_size) &&
- (size > MUS_MAX_CHANS))
- XEN_OUT_OF_RANGE_ERROR(S_make_mixer, 1, cararg, "chans ~A too big");
- if (len > (size * size + 1))
- clm_error(S_make_mixer, "extra trailing args?", arglist);
-
- return(g_make_mixer_2(size, (len == 1) ? XEN_EMPTY_LIST : XEN_CDR(arglist)));
+ return(s7_make_real(s7, temp));
}
-static XEN g_make_mixer(XEN arglist)
+#define S_singer_nose_filter "singer-nose-filter"
+static Xen g_singer_nose_filter(Xen end, Xen tmp, Xen dline1, Xen dline2, Xen coeffs)
{
- return(g_make_mixer_1(arglist, true));
-}
-
+ #define H_singer_nose_filter "this is an optimization for the singer instrument"
+ int j, k, lim;
+ s7_double *d1, *d2, *cf;
+ s7_double reftemp, temp;
-static XEN g_make_mixer_unchecked(XEN arglist)
-{
- return(g_make_mixer_1(arglist, false));
-}
+ if (!s7_is_integer(end)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 1, end, "an integer");
+ if (!s7_is_real(tmp)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 2, tmp, "a real");
+ if (!s7_is_float_vector(dline1)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 3, dline1, "a float-vector");
+ if (!s7_is_float_vector(dline2)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 4, dline2, "a float-vector");
+ if (!s7_is_float_vector(coeffs)) s7_wrong_type_arg_error(s7, S_singer_nose_filter, 5, coeffs, "a float-vector");
+
+ reftemp = 0.0;
+ lim = s7_integer(end);
+ d1 = s7_float_vector_elements(dline1);
+ d2 = s7_float_vector_elements(dline2);
+ cf = s7_float_vector_elements(coeffs);
+ temp = s7_number_to_real(s7, tmp);
+ for (k = 1, j = 2; j < lim; k++, j++)
+ {
+ s7_double t1;
+ reftemp = cf[j] * (d1[k] - d2[j + 1]);
+ d2[j] = d2[j + 1] + reftemp;
+ t1 = temp;
+ temp = d1[k] + reftemp;
+ d1[k] = t1;
+ }
-static XEN g_mixer(XEN args)
-{
- #define H_mixer "(" S_mixer " args...): returns a new mixer with args as its contents: (mixer .1 .2 .3 .4)"
- return(g_make_mixer_2((int)ceil(sqrt(XEN_LIST_LENGTH(args))), args));
+ return(s7_make_real(s7, temp));
}
+#endif
/* ---------------- wave-train ---------------- */
-static XEN g_make_wave_train(XEN arglist)
+static Xen g_make_wave_train(Xen arglist)
{
- #define H_make_wave_train "(" S_make_wave_train " (:frequency *clm-default-frequency*) (:initial-phase 0.0) :wave (:size clm-table-size) :type): \
+ #define H_make_wave_train "(" S_make_wave_train " (frequency *clm-default-frequency*) (initial-phase 0.0) (wave) (size clm-table-size) (type)): \
return a new wave-train generator (an extension of pulse-train). Frequency is \
the repetition rate of the wave found in wave. Successive waves can overlap."
mus_any *ge;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[5];
+ Xen args[10];
+ Xen keys[5];
int orig_arg[5] = {0, 0, 0, 0, MUS_INTERP_LINEAR};
- int vals, i, arglist_len;
+ int vals;
mus_long_t wsize = clm_table_size;
- vct *v = NULL;
- XEN orig_v = XEN_FALSE;
+ Xen orig_v = Xen_false;
mus_float_t freq, phase = 0.0;
mus_float_t *wave = NULL;
int interp_type = (int)MUS_INTERP_LINEAR;
@@ -4295,52 +5024,55 @@ the repetition rate of the wave found in wave. Successive waves can overlap."
keys[3] = kw_size;
keys[4] = kw_type;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_wave_train, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ Xen p;
+ int i, arglist_len;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 10) clm_error(S_make_wave_train, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_wave_train, 5, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], S_make_wave_train, orig_arg[0], freq);
+ vct *v = NULL;
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_wave_train, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_wave_train, orig_arg[0], keys[0], "freq ~A > srate/2?");
+ Xen_out_of_range_error(S_make_wave_train, orig_arg[0], keys[0], "freq > srate/2?");
if (freq < 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_wave_train, orig_arg[0], keys[0], "freq ~A?");
+ Xen_out_of_range_error(S_make_wave_train, orig_arg[0], keys[0], "freq < 0.0?");
- phase = mus_optkey_to_float(keys[1], S_make_wave_train, orig_arg[1], phase);
+ phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_wave_train, orig_arg[1], phase);
if (phase < 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_wave_train, orig_arg[1], keys[1], "phase ~A?");
+ Xen_out_of_range_error(S_make_wave_train, orig_arg[1], keys[1], "phase < 0.0?");
v = mus_optkey_to_vct(keys[2], S_make_wave_train, orig_arg[2], NULL);
if (v)
{
orig_v = keys[2];
- wave = v->data;
- wsize = v->length;
+ wave = mus_vct_data(v);
+ wsize = mus_vct_length(v);
}
- wsize = mus_optkey_to_mus_long_t(keys[3], S_make_wave_train, orig_arg[3], wsize);
+ wsize = Xen_optkey_to_mus_long_t(kw_size, keys[3], S_make_wave_train, orig_arg[3], wsize);
if (wsize <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_wave_train, orig_arg[3], keys[3], "size ~A <= 0?");
+ Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "size <= 0?");
if (wsize > mus_max_table_size())
- XEN_OUT_OF_RANGE_ERROR(S_make_wave_train, orig_arg[3], keys[3], "size ~A too large (see mus-max-table-size)");
- if ((v) && (wsize > v->length))
- XEN_OUT_OF_RANGE_ERROR(S_make_wave_train, orig_arg[3], keys[3], "size arg ~A bigger than size of provided wave");
+ Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "size too large (see mus-max-table-size)");
+ if ((v) && (wsize > mus_vct_length(v)))
+ Xen_out_of_range_error(S_make_wave_train, orig_arg[3], keys[3], "table size > wave size");
- interp_type = mus_optkey_to_int(keys[4], S_make_wave_train, orig_arg[4], interp_type);
- if (!(mus_interp_type_p(interp_type)))
- XEN_OUT_OF_RANGE_ERROR(S_make_wave_train, orig_arg[4], keys[4], "no such interp-type: ~A");
+ interp_type = Xen_optkey_to_int(kw_type, keys[4], S_make_wave_train, orig_arg[4], interp_type);
+ if (!(mus_is_interp_type(interp_type)))
+ Xen_out_of_range_error(S_make_wave_train, orig_arg[4], keys[4], "no such interp-type");
}
if (wave == NULL)
{
wave = (mus_float_t *)calloc(wsize, sizeof(mus_float_t));
if (wave == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave-train table"));
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate wave-train table", S_make_wave_train));
orig_v = xen_make_vct(wsize, wave);
}
ge = mus_make_wave_train(freq, phase, wave, wsize, (mus_interp_t)interp_type);
@@ -4348,49 +5080,54 @@ the repetition rate of the wave found in wave. Successive waves can overlap."
}
-static XEN g_wave_train(XEN obj, XEN fm)
+static Xen g_wave_train(Xen obj, Xen fm)
{
- #define H_wave_train "(" S_wave_train " gen :optional (fm 0.0)): next sample of " S_wave_train
+ #define H_wave_train "(" S_wave_train " gen (fm 0.0)): next sample of " S_wave_train
mus_float_t fm1 = 0.0;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_wave_train_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_wave_train, "a " S_wave_train " generator");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_wave_train, "a number");
- return(C_TO_XEN_DOUBLE(mus_wave_train(XEN_TO_MUS_ANY(obj), fm1)));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_wave_train, S_wave_train, "a wave-train generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_wave_train, 2);
+
+ return(C_double_to_Xen_real(mus_wave_train(g, fm1)));
}
-static XEN g_wave_train_p(XEN obj)
+static Xen g_is_wave_train(Xen obj)
{
- #define H_wave_train_p "(" S_wave_train_p " gen): " PROC_TRUE " if gen is a " S_wave_train
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_wave_train_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_wave_train "(" S_is_wave_train " gen): " PROC_TRUE " if gen is a " S_wave_train
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_wave_train(Xen_to_mus_any(obj)))));
}
/* ---------------- waveshaping ---------------- */
-enum {NO_PROBLEM_IN_LIST, NULL_LIST, ODD_LENGTH_LIST, NON_NUMBER_IN_LIST, NEGATIVE_NUMBER_IN_LIST};
+enum {NO_PROBLEM_IN_LIST, NULL_LIST, ODD_LENGTH_LIST, NON_NUMBER_IN_LIST, NEGATIVE_NUMBER_IN_LIST, HUGE_NUMBER_IN_LIST};
static const char *list_to_partials_error_to_string(int code)
{
switch (code)
{
- case NO_PROBLEM_IN_LIST: return("~A: nothing wrong with partials list?? ~A"); break;
- case NULL_LIST: return("~A: partials list is null, ~A"); break;
- case ODD_LENGTH_LIST: return("~A: partials list has an odd number of elements: ~A"); break;
- case NON_NUMBER_IN_LIST: return("~A: partials list has a non-numerical element: ~A"); break;
- case NEGATIVE_NUMBER_IN_LIST: return("~A: partials list has a partial number that is negative: ~A"); break;
+ case NO_PROBLEM_IN_LIST: return("~A: nothing wrong with partials list?? ~A"); break;
+ case NULL_LIST: return("~A: partials list is null, ~A"); break;
+ case ODD_LENGTH_LIST: return("~A: partials list has an odd number of elements: ~A"); break;
+ case NON_NUMBER_IN_LIST: return("~A: partials list has a non-numerical element: ~A"); break;
+ case NEGATIVE_NUMBER_IN_LIST: return("~A: partials list has a partial number that is negative: ~A"); break;
+ case HUGE_NUMBER_IN_LIST: return("~A: partials list has a partial number that is too large: ~A"); break;
}
return("~A: unknown error, ~A");
}
-static mus_float_t *list_to_partials(XEN harms, int *npartials, int *error_code)
+static mus_float_t *list_to_partials(Xen harms, int *npartials, int *error_code)
{
int listlen, i, maxpartial = 0, curpartial;
mus_float_t *partials = NULL;
- XEN lst;
+ Xen lst;
- listlen = XEN_LIST_LENGTH(harms);
+ listlen = Xen_list_length(harms);
if (listlen == 0)
{
(*error_code) = NULL_LIST;
@@ -4403,7 +5140,7 @@ static mus_float_t *list_to_partials(XEN harms, int *npartials, int *error_code)
return(NULL);
}
- if (!(XEN_NUMBER_P(XEN_CAR(harms))))
+ if (!(Xen_is_number(Xen_car(harms))))
{
(*error_code) = NON_NUMBER_IN_LIST;
return(NULL);
@@ -4411,15 +5148,15 @@ static mus_float_t *list_to_partials(XEN harms, int *npartials, int *error_code)
/* the list is '(partial-number partial-amp ... ) */
(*error_code) = NO_PROBLEM_IN_LIST;
- for (i = 0, lst = XEN_COPY_ARG(harms); i < listlen; i += 2, lst = XEN_CDDR(lst))
+ for (i = 0, lst = Xen_copy_arg(harms); i < listlen; i += 2, lst = Xen_cddr(lst))
{
- if ((!(XEN_NUMBER_P(XEN_CAR(lst)))) ||
- (!(XEN_NUMBER_P(XEN_CADR(lst)))))
+ if ((!(Xen_is_number(Xen_car(lst)))) ||
+ (!(Xen_is_number(Xen_cadr(lst)))))
{
(*error_code) = NON_NUMBER_IN_LIST;
return(NULL);
}
- curpartial = XEN_TO_C_INT(XEN_CAR(lst));
+ curpartial = Xen_integer_to_C_int(Xen_car(lst));
if (curpartial < 0)
{
(*error_code) = NEGATIVE_NUMBER_IN_LIST;
@@ -4429,26 +5166,40 @@ static mus_float_t *list_to_partials(XEN harms, int *npartials, int *error_code)
maxpartial = curpartial;
}
+ if (maxpartial > 10000000)
+ {
+ (*error_code) = NEGATIVE_NUMBER_IN_LIST;
+ return(NULL);
+ }
+
partials = (mus_float_t *)calloc(maxpartial + 1, sizeof(mus_float_t));
+ /* here and elsewhere? this won't be null until we touch it in linux, but that gloms up all our
+ * code with once-in-a-billion-years error checks.
+ */
if (partials == NULL)
mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate waveshaping partials list");
(*npartials) = maxpartial + 1;
- for (i = 0, lst = XEN_COPY_ARG(harms); i < listlen; i += 2, lst = XEN_CDDR(lst))
+ for (i = 0, lst = Xen_copy_arg(harms); i < listlen; i += 2, lst = Xen_cddr(lst))
{
- curpartial = XEN_TO_C_INT(XEN_CAR(lst));
- partials[curpartial] = (mus_float_t)XEN_TO_C_DOUBLE(XEN_CADR(lst));
+ curpartial = Xen_integer_to_C_int(Xen_car(lst));
+ partials[curpartial] = (mus_float_t)Xen_real_to_C_double(Xen_cadr(lst));
}
return(partials);
}
-mus_float_t *mus_vct_to_partials(vct *v, int *npartials, int *error_code)
+static mus_float_t *mus_vct_to_partials(vct *v, int *npartials, int *error_code)
{
int len, i, maxpartial, curpartial;
- mus_float_t *partials = NULL;
+ mus_float_t *partials = NULL, *vdata;
- len = v->length;
+ len = mus_vct_length(v);
+ if (len == 0)
+ {
+ (*error_code) = NULL_LIST;
+ return(NULL);
+ }
if (len & 1)
{
(*error_code) = ODD_LENGTH_LIST;
@@ -4456,14 +5207,15 @@ mus_float_t *mus_vct_to_partials(vct *v, int *npartials, int *error_code)
}
(*error_code) = NO_PROBLEM_IN_LIST;
- maxpartial = (int)(v->data[0]);
+ vdata = mus_vct_data(v);
+ maxpartial = (int)(vdata[0]);
if (maxpartial < 0)
(*error_code) = NEGATIVE_NUMBER_IN_LIST;
else
{
for (i = 2; i < len; i += 2)
{
- curpartial = (int)(v->data[i]);
+ curpartial = (int)(vdata[i]);
if (curpartial > maxpartial)
maxpartial = curpartial;
if (curpartial < 0)
@@ -4480,134 +5232,272 @@ mus_float_t *mus_vct_to_partials(vct *v, int *npartials, int *error_code)
for (i = 0; i < len; i += 2)
{
- curpartial = (int)(v->data[i]);
- partials[curpartial] = v->data[i + 1];
+ curpartial = (int)(vdata[i]);
+ partials[curpartial] = vdata[i + 1];
}
return(partials);
}
-static XEN g_partials_to_polynomial(XEN amps, XEN ukind)
+static mus_float_t *mus_vector_to_partials(Xen v, int *npartials, int *error_code)
{
- #if HAVE_SCHEME
- #define p2p_example "(let ((v0 (partials->polynomial '(1 1.0 2 1.0)))\n (os (make-oscil)))\n (polynomial v0 (oscil os)))"
- #endif
- #if HAVE_RUBY
- #define p2p_example "v0 = partials2polynomial([1, 1.0, 2, 1.0])\n os = make_oscil()\n polynomial(v0, oscil(os))"
- #endif
- #if HAVE_FORTH
- #define p2p_example "'( 1 1.0 2 1.0 ) partials->polynomial value v0\n make-oscil value os\n v0 os 0.0 0.0 oscil polynomial"
- #endif
-
- #define H_partials_to_polynomial "(" S_partials_to_polynomial " partials :optional (kind " S_mus_chebyshev_first_kind ")): \
-produce a Chebyshev polynomial suitable for use with the " S_polynomial " generator \
-to create (via waveshaping) the harmonic spectrum described by the partials argument:\n " p2p_example
-
- int npartials = 0;
- mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
- mus_float_t *partials = NULL, *wave;
- int error = NO_PROBLEM_IN_LIST;
-
- XEN_ASSERT_TYPE(MUS_VCT_P(amps) || XEN_LIST_P(amps), amps, XEN_ARG_1, S_partials_to_polynomial, "a list or a vct");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ukind), ukind, XEN_ARG_2, S_partials_to_polynomial, "either " S_mus_chebyshev_first_kind " or " S_mus_chebyshev_second_kind);
+ int len, i, maxpartial, curpartial;
+ mus_float_t *partials = NULL;
- if (XEN_INTEGER_P(ukind))
+ len = Xen_vector_length(v);
+ if (len == 0)
{
- int ck;
- ck = XEN_TO_C_INT(ukind);
- if ((ck >= MUS_CHEBYSHEV_EITHER_KIND) && (ck <= MUS_CHEBYSHEV_SECOND_KIND))
- kind = (mus_polynomial_t)ck;
- else XEN_OUT_OF_RANGE_ERROR(S_partials_to_polynomial, 2, ukind, "~A: unknown Chebyshev polynomial kind");
+ (*error_code) = NULL_LIST;
+ return(NULL);
}
-
- if (MUS_VCT_P(amps))
- partials = mus_vct_to_partials(XEN_TO_VCT(amps), &npartials, &error);
- else partials = list_to_partials(amps, &npartials, &error);
-
- if (partials == NULL)
- XEN_ERROR(NO_DATA,
- XEN_LIST_3(C_TO_XEN_STRING(list_to_partials_error_to_string(error)),
- C_TO_XEN_STRING(S_partials_to_polynomial),
- amps));
-
+ if (len & 1)
+ {
+ (*error_code) = ODD_LENGTH_LIST;
+ return(NULL);
+ }
+ (*error_code) = NO_PROBLEM_IN_LIST;
+
+ maxpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, 0)));
+ if (maxpartial < 0)
+ (*error_code) = NEGATIVE_NUMBER_IN_LIST;
+ else
+ {
+ for (i = 2; i < len; i += 2)
+ {
+ curpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, i)));
+ if (curpartial > maxpartial)
+ maxpartial = curpartial;
+ if (curpartial < 0)
+ (*error_code) = NEGATIVE_NUMBER_IN_LIST;
+ }
+ }
+ if ((*error_code) != NO_PROBLEM_IN_LIST)
+ return(NULL);
+
+ partials = (mus_float_t *)calloc(maxpartial + 1, sizeof(mus_float_t));
+ if (partials == NULL)
+ mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate waveshaping partials list");
+ (*npartials) = maxpartial + 1;
+
+ for (i = 0; i < len; i += 2)
+ {
+ curpartial = (int)(Xen_integer_to_C_int(Xen_vector_ref(v, i)));
+ partials[curpartial] = Xen_real_to_C_double(Xen_vector_ref(v, i + 1));
+ }
+ return(partials);
+}
+
+
+static Xen g_partials_to_polynomial(Xen amps, Xen ukind)
+{
+ #if HAVE_SCHEME
+ #define p2p_example "(let ((v0 (partials->polynomial '(1 1.0 2 1.0)))\n (os (make-oscil)))\n (polynomial v0 (oscil os)))"
+ #endif
+ #if HAVE_RUBY
+ #define p2p_example "v0 = partials2polynomial([1, 1.0, 2, 1.0])\n os = make_oscil()\n polynomial(v0, oscil(os))"
+ #endif
+ #if HAVE_FORTH
+ #define p2p_example "'( 1 1.0 2 1.0 ) partials->polynomial value v0\n make-oscil value os\n v0 os 0.0 0.0 oscil polynomial"
+ #endif
+
+ #define H_partials_to_polynomial "(" S_partials_to_polynomial " partials (kind " S_mus_chebyshev_first_kind ")): \
+produce a Chebyshev polynomial suitable for use with the " S_polynomial " generator \
+to create (via waveshaping) the harmonic spectrum described by the partials argument:\n " p2p_example
+
+ int npartials = 0;
+ mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
+ mus_float_t *partials = NULL, *wave;
+ int error = NO_PROBLEM_IN_LIST;
+
+ Xen_check_type(mus_is_vct(amps) || Xen_is_list(amps), amps, 1, S_partials_to_polynomial, "a list or a " S_vct);
+ Xen_check_type(Xen_is_integer_or_unbound(ukind), ukind, 2, S_partials_to_polynomial, "either " S_mus_chebyshev_first_kind " or " S_mus_chebyshev_second_kind);
+
+ if (Xen_is_integer(ukind))
+ {
+ int ck;
+ ck = Xen_integer_to_C_int(ukind);
+ if ((ck >= MUS_CHEBYSHEV_EITHER_KIND) && (ck <= MUS_CHEBYSHEV_SECOND_KIND))
+ kind = (mus_polynomial_t)ck;
+ else Xen_out_of_range_error(S_partials_to_polynomial, 2, ukind, "unknown Chebyshev polynomial kind");
+ }
+
+ if (mus_is_vct(amps))
+ partials = mus_vct_to_partials(Xen_to_vct(amps), &npartials, &error);
+ else partials = list_to_partials(amps, &npartials, &error);
+
+ if (partials == NULL)
+ Xen_error(NO_DATA,
+ Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
+ C_string_to_Xen_string(S_partials_to_polynomial),
+ amps));
+
wave = mus_partials_to_polynomial(npartials, partials, kind); /* wave == partials; in both vct and list cases, partials is newly allocated */
return(xen_make_vct(npartials, wave));
}
-static XEN g_normalize_partials(XEN partials)
+static Xen g_normalize_partials(Xen partials)
{
#define H_normalize_partials "(" S_normalize_partials " partials) scales the \
-partial amplitudes in the vct or list 'partials' by the inverse of their sum (so that they add to 1.0)."
+partial amplitudes in the " S_vct " or list 'partials' by the inverse of their sum (so that they add to 1.0)."
vct *v;
- XEN xv = XEN_FALSE;
+ Xen xv = Xen_false;
- XEN_ASSERT_TYPE(((XEN_LIST_P(partials)) && (XEN_NOT_NULL_P(partials))) || (MUS_VCT_P(partials)), partials, XEN_ONLY_ARG, S_normalize_partials, "a vct or (non-empty) list");
+ Xen_check_type(((Xen_is_list(partials)) && (!Xen_is_null(partials))) || (mus_is_vct(partials)), partials, 1, S_normalize_partials, "a " S_vct " or (non-empty) list");
- if (MUS_VCT_P(partials))
+ if (mus_is_vct(partials))
xv = partials;
else xv = xen_list_to_vct(partials);
- v = XEN_TO_VCT(xv);
-
- if ((v->length > 1) &&
- ((v->length & 1) == 0))
- mus_normalize_partials(v->length / 2, v->data);
- else XEN_ERROR(BAD_TYPE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: partials, ~A, must be a non-empty list or vct of even length (partial-number partial-amp ...)"),
- C_TO_XEN_STRING(S_normalize_partials),
+ v = Xen_to_vct(xv);
+
+ if ((mus_vct_length(v) > 1) &&
+ ((mus_vct_length(v) & 1) == 0))
+ mus_normalize_partials(mus_vct_length(v) / 2, mus_vct_data(v));
+ else Xen_error(BAD_TYPE,
+ Xen_list_3(C_string_to_Xen_string("~A: partials, ~A, must be a non-empty list or " S_vct " of even length (partial-number partial-amp ...)"),
+ C_string_to_Xen_string(S_normalize_partials),
partials));
return(xv);
}
-static XEN g_chebyshev_tu_sum(XEN x, XEN tn, XEN un)
+static mus_float_t *vector_to_float_array(Xen v)
+{
+ mus_float_t *data;
+ mus_long_t i, len;
+ len = Xen_vector_length(v);
+ data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
+ for (i = 0; i < len; i++)
+ data[i] = Xen_real_to_C_double(Xen_vector_ref(v, i));
+ return(data);
+}
+
+static Xen g_chebyshev_tu_sum(Xen x, Xen tn, Xen un)
{
#define H_chebyshev_tu_sum "(" S_mus_chebyshev_tu_sum " x tn un) returns the sum of the weighted\
-Chebyshev polynomials Tn and Un (vcts), with phase x."
+Chebyshev polynomials Tn and Un (vectors or " S_vct "s), with phase x."
- vct *Tn, *Un;
+ bool need_free = false;
+ int len = 0;
+ mus_float_t *tdata = NULL, *udata = NULL;
+ Xen result;
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(x), x, XEN_ARG_1, S_mus_chebyshev_tu_sum, "a float");
- XEN_ASSERT_TYPE(MUS_VCT_P(tn), tn, XEN_ARG_2, S_mus_chebyshev_tu_sum, "a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(un), un, XEN_ARG_3, S_mus_chebyshev_tu_sum, "a vct");
+ Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_tu_sum, "a float");
+
+ if ((mus_is_vct(tn)) &&
+ (mus_is_vct(un)))
+ {
+ vct *Tn, *Un;
+ Tn = Xen_to_vct(tn);
+ tdata = mus_vct_data(Tn);
+ Un = Xen_to_vct(un);
+ udata = mus_vct_data(Un);
+ len = mus_vct_length(Tn);
+ if (len == 0) return(C_double_to_Xen_real(0.0));
+ if (len != mus_vct_length(Un)) return(C_double_to_Xen_real(0.0));
+ }
+ else
+ {
+ if ((Xen_is_vector(tn)) &&
+ (Xen_is_vector(un)))
+ {
+ len = Xen_vector_length(tn);
+ if (len == 0) return(C_double_to_Xen_real(0.0));
+ if (len != Xen_vector_length(un)) return(C_double_to_Xen_real(0.0));
+ tdata = vector_to_float_array(tn);
+ udata = vector_to_float_array(un);
+ need_free = true;
+ }
+ else
+ {
+ Xen_check_type(false, tn, 1, S_mus_chebyshev_tu_sum, "both arrays should be either " S_vct "s or vectors");
+ }
+ }
- Tn = XEN_TO_VCT(tn);
- Un = XEN_TO_VCT(un);
+ result = C_double_to_Xen_real(mus_chebyshev_tu_sum(Xen_real_to_C_double(x), len, tdata, udata));
+ if (need_free)
+ {
+ free(tdata);
+ free(udata);
+ }
- return(C_TO_XEN_DOUBLE(mus_chebyshev_tu_sum(XEN_TO_C_DOUBLE(x), Tn->length, Tn->data, Un->data)));
+ return(result);
}
-static XEN g_chebyshev_t_sum(XEN x, XEN tn)
+static Xen g_chebyshev_t_sum(Xen x, Xen tn)
{
#define H_chebyshev_t_sum "(" S_mus_chebyshev_t_sum " x tn) returns the sum of the weighted \
-Chebyshev polynomials Tn (a vct)."
+Chebyshev polynomials Tn (a " S_vct ")."
- vct *Tn;
+ bool need_free = false;
+ int len = 0;
+ mus_float_t *data = NULL;
+ Xen result;
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(x), x, XEN_ARG_1, S_mus_chebyshev_tu_sum, "a float");
- XEN_ASSERT_TYPE(MUS_VCT_P(tn), tn, XEN_ARG_2, S_mus_chebyshev_tu_sum, "a vct");
-
- Tn = XEN_TO_VCT(tn);
-
- return(C_TO_XEN_DOUBLE(mus_chebyshev_t_sum(XEN_TO_C_DOUBLE(x), Tn->length, Tn->data)));
+ Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_t_sum, "a float");
+ if (mus_is_vct(tn))
+ {
+ vct *Tn;
+ Tn = Xen_to_vct(tn);
+ data = mus_vct_data(Tn);
+ len = mus_vct_length(Tn);
+ if (len == 0) return(C_double_to_Xen_real(0.0));
+ }
+ else
+ {
+ if (Xen_is_vector(tn))
+ {
+ len = Xen_vector_length(tn);
+ if (len == 0) return(C_double_to_Xen_real(0.0));
+ data = vector_to_float_array(tn);
+ need_free = true;
+ }
+ else Xen_check_type(false, tn, 1, S_mus_chebyshev_t_sum, "a " S_vct " or a vector");
+ }
+ result = C_double_to_Xen_real(mus_chebyshev_t_sum(Xen_real_to_C_double(x), len, data));
+ if (need_free)
+ free(data);
+ return(result);
}
-static XEN g_chebyshev_u_sum(XEN x, XEN un)
+static Xen g_chebyshev_u_sum(Xen x, Xen un)
{
#define H_chebyshev_u_sum "(" S_mus_chebyshev_u_sum " x un) returns the sum of the weighted \
-Chebyshev polynomials Un (a vct)."
+Chebyshev polynomials Un (a " S_vct ")."
- vct *Un;
-
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(x), x, XEN_ARG_1, S_mus_chebyshev_tu_sum, "a float");
- XEN_ASSERT_TYPE(MUS_VCT_P(un), un, XEN_ARG_2, S_mus_chebyshev_tu_sum, "a vct");
+ bool need_free = false;
+ int len = 0;
+ mus_float_t *data = NULL;
+ Xen result;
- Un = XEN_TO_VCT(un);
+ Xen_check_type(Xen_is_double(x), x, 1, S_mus_chebyshev_u_sum, "a float");
- return(C_TO_XEN_DOUBLE(mus_chebyshev_u_sum(XEN_TO_C_DOUBLE(x), Un->length, Un->data)));
+ if (mus_is_vct(un))
+ {
+ vct *Un;
+ Un = Xen_to_vct(un);
+ len = mus_vct_length(Un);
+ if (len == 0) return(C_double_to_Xen_real(0.0));
+ data = mus_vct_data(Un);
+ }
+ else
+ {
+ if (Xen_is_vector(un))
+ {
+ len = Xen_vector_length(un);
+ if (len == 0) return(C_double_to_Xen_real(0.0));
+ data = vector_to_float_array(un);
+ need_free = true;
+ }
+ else Xen_check_type(false, un, 1, S_mus_chebyshev_u_sum, "a " S_vct " or a vector");
+ }
+ result = C_double_to_Xen_real(mus_chebyshev_u_sum(Xen_real_to_C_double(x), len, data));
+ if (need_free)
+ free(data);
+ return(result);
}
@@ -4615,41 +5505,41 @@ Chebyshev polynomials Un (a vct)."
/* ---------------- polyshape ---------------- */
-static XEN g_polyshape(XEN obj, XEN index, XEN fm)
+static Xen g_polyshape(Xen obj, Xen index, Xen fm)
{
- #define H_polyshape "(" S_polyshape " gen :optional (index 1.0) (fm 0.0)): next sample of polynomial-based waveshaper"
+ #define H_polyshape "(" S_polyshape " gen (index 1.0) (fm 0.0)): next sample of polynomial-based waveshaper"
mus_float_t fm1 = 0.0, index1 = 1.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_polyshape_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_polyshape, "a polyshape generator");
+ Xen_to_C_generator(obj, gn, g, mus_is_polyshape, S_polyshape, "a polyshape generator");
+ Xen_real_to_C_double_if_bound(index, index1, S_polyshape, 2);
+ Xen_real_to_C_double_if_bound(fm, fm1, S_polyshape, 3);
- if (XEN_NUMBER_P(index)) index1 = XEN_TO_C_DOUBLE(index); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(index), index, XEN_ARG_2, S_polyshape, "a number");
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_3, S_polyshape, "a number");
- return(C_TO_XEN_DOUBLE(mus_polyshape(XEN_TO_MUS_ANY(obj), index1, fm1)));
+ return(C_double_to_Xen_real(mus_polyshape(g, index1, fm1)));
}
-static XEN g_polyshape_p(XEN obj)
+static Xen g_is_polyshape(Xen obj)
{
- #define H_polyshape_p "(" S_polyshape_p " gen): " PROC_TRUE " if gen is a " S_polyshape
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_polyshape_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_polyshape "(" S_is_polyshape " gen): " PROC_TRUE " if gen is a " S_polyshape
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_polyshape(Xen_to_mus_any(obj)))));
}
-static XEN g_make_polyshape(XEN arglist)
+static Xen g_make_polyshape(Xen arglist)
{
- #define H_make_polyshape "(" S_make_polyshape " (:frequency *clm-default-frequency*) (:initial-phase 0.0) :coeffs (:partials '(1 1)) (:kind " S_mus_chebyshev_first_kind ")): \
+ #define H_make_polyshape "(" S_make_polyshape " (frequency *clm-default-frequency*) (initial-phase 0.0) (coeffs) (partials '(1 1)) (kind " S_mus_chebyshev_first_kind ")): \
return a new polynomial-based waveshaping generator:\n\
(" S_make_polyshape " :coeffs (" S_partials_to_polynomial " '(1 1.0)))\n\
is the same in effect as " S_make_oscil
mus_any *ge;
- XEN args[MAX_ARGLIST_LEN];
- int arglist_len;
- XEN keys[5];
+ Xen args[10];
+ Xen keys[5];
int orig_arg[5] = {0, 0, 0, 0, 0};
- int i, ck, vals, csize = 0, npartials = 0;
- vct *v = NULL;
- XEN orig_v = XEN_FALSE;
+ int vals, csize = 0, npartials = 0;
+ Xen orig_v = Xen_false;
mus_float_t freq, phase = 0.0;
/*
* if we followed the definition directly, the initial phase default would be M_PI_2 (pi/2) so that
@@ -4659,7 +5549,7 @@ is the same in effect as " S_make_oscil
* but these add to exactly the same actual wave -- what you'd expect since Tn doesn't know
* where we started. This also does not affect "signification".
*/
- mus_float_t *coeffs = NULL, *partials = NULL;
+ mus_float_t *coeffs = NULL;
mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
freq = clm_default_frequency;
@@ -4670,50 +5560,56 @@ is the same in effect as " S_make_oscil
keys[3] = kw_partials;
keys[4] = kw_kind;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_polyshape, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 10) clm_error(S_make_polyshape, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_polyshape, 5, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], S_make_polyshape, orig_arg[0], freq);
+ vct *v = NULL;
+ int ck;
+
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_polyshape, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_polyshape, orig_arg[0], keys[0], "freq ~A > srate/2?");
+ Xen_out_of_range_error(S_make_polyshape, orig_arg[0], keys[0], "freq > srate/2?");
- phase = mus_optkey_to_float(keys[1], S_make_polyshape, orig_arg[2], phase);
+ phase = Xen_optkey_to_float(kw_initial_phase, keys[1], S_make_polyshape, orig_arg[2], phase);
- ck = mus_optkey_to_int(keys[4], S_make_polyshape, orig_arg[4], (int)kind);
+ ck = Xen_optkey_to_int(kw_kind, keys[4], S_make_polyshape, orig_arg[4], (int)kind);
if ((ck >= MUS_CHEBYSHEV_EITHER_KIND) && (ck <= MUS_CHEBYSHEV_SECOND_KIND))
kind = (mus_polynomial_t)ck;
- else XEN_OUT_OF_RANGE_ERROR(S_make_polyshape, orig_arg[4], keys[4], "~A: unknown Chebyshev polynomial kind");
+ else Xen_out_of_range_error(S_make_polyshape, orig_arg[4], keys[4], "unknown Chebyshev polynomial kind");
v = mus_optkey_to_vct(keys[2], S_make_polyshape, orig_arg[2], NULL);
if (v)
{
orig_v = keys[2];
- coeffs = v->data;
- csize = v->length;
+ coeffs = mus_vct_data(v);
+ csize = mus_vct_length(v);
}
else
{
- if (!(XEN_KEYWORD_P(keys[3])))
+ if (!(Xen_is_keyword(keys[3])))
{
+ mus_float_t *partials = NULL;
int error = NO_PROBLEM_IN_LIST;
- if (MUS_VCT_P(keys[3]))
- partials = mus_vct_to_partials(XEN_TO_VCT(keys[3]), &npartials, &error);
+ if (mus_is_vct(keys[3]))
+ partials = mus_vct_to_partials(Xen_to_vct(keys[3]), &npartials, &error);
else
{
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[3]), keys[3], orig_arg[3], S_make_polyshape, "a list or a vct");
+ Xen_check_type(Xen_is_list(keys[3]), keys[3], orig_arg[3], S_make_polyshape, "a list or a " S_vct);
partials = list_to_partials(keys[3], &npartials, &error);
}
if (partials == NULL)
- XEN_ERROR(NO_DATA,
- XEN_LIST_3(C_TO_XEN_STRING(list_to_partials_error_to_string(error)),
- C_TO_XEN_STRING(S_make_polyshape),
+ Xen_error(NO_DATA,
+ Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
+ C_string_to_Xen_string(S_make_polyshape),
keys[3]));
coeffs = mus_partials_to_polynomial(npartials, partials, kind);
csize = npartials;
@@ -4726,180 +5622,219 @@ is the same in effect as " S_make_oscil
{
/* clm.html says '(1 1) is the default */
mus_float_t *data;
- data = (mus_float_t *)calloc(2, sizeof(mus_float_t));
+ data = (mus_float_t *)malloc(2 * sizeof(mus_float_t));
data[0] = 0.0;
data[1] = 1.0;
coeffs = mus_partials_to_polynomial(2, data, kind);
csize = 2;
}
- if (XEN_FALSE_P(orig_v))
+ if (Xen_is_false(orig_v))
orig_v = xen_make_vct(csize, coeffs);
ge = mus_make_polyshape(freq, phase, coeffs, csize, kind);
if (ge)
return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(XEN_FALSE);
+ return(Xen_false);
}
/* ---------------- polywave ---------------- */
-static XEN g_polywave(XEN obj, XEN fm)
+static Xen g_polywave(Xen obj, Xen fm)
{
- #define H_polywave "(" S_polywave " gen :optional (fm 0.0)): next sample of polywave waveshaper"
+ #define H_polywave "(" S_polywave " gen (fm 0.0)): next sample of polywave waveshaper"
mus_float_t fm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_polywave_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_polywave, "a polywave generator");
+ Xen_to_C_generator(obj, gn, g, mus_is_polywave, S_polywave, "a polywave generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_polywave, 3);
- if (XEN_NUMBER_P(fm)) fm1 = XEN_TO_C_DOUBLE(fm); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_3, S_polywave, "a number");
- return(C_TO_XEN_DOUBLE(mus_polywave(XEN_TO_MUS_ANY(obj), fm1)));
+ return(C_double_to_Xen_real(mus_polywave(g, fm1)));
}
-static XEN g_polywave_p(XEN obj)
+static Xen g_is_polywave(Xen obj)
{
- #define H_polywave_p "(" S_polywave_p " gen): " PROC_TRUE " if gen is a " S_polywave " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_polywave_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_polywave "(" S_is_polywave " gen): " PROC_TRUE " if gen is a " S_polywave " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_polywave(Xen_to_mus_any(obj)))));
}
-static XEN g_make_polywave(XEN arglist)
+static Xen g_make_polywave(Xen arglist)
{
- #define H_make_polywave "(" S_make_polywave " (:frequency *clm-default-frequency*) (:partials '(1 1)) (:type " S_mus_chebyshev_first_kind ")): \
-return a new polynomial-based waveshaping generator. (" S_make_polywave " :partials (vct 1 1.0)) is the same in effect as " S_make_oscil "."
+ #define H_make_polywave "(" S_make_polywave " (frequency *clm-default-frequency*) (partials '(1 1)) (type " S_mus_chebyshev_first_kind ") xcoeffs ycoeffs): \
+return a new polynomial-based waveshaping generator. (" S_make_polywave " :partials (float-vector 1 1.0)) is the same in effect as " S_make_oscil "."
mus_any *ge;
- XEN args[MAX_ARGLIST_LEN];
- int arglist_len;
- XEN keys[3];
- int orig_arg[3] = {0, 0, 0};
- int i, type, vals, n = 0, npartials = 0;
- XEN orig_v = XEN_FALSE;
+ Xen args[10];
+ Xen keys[5];
+ int orig_arg[5] = {0, 0, 0, 0, 0};
+ int vals, n = 0, npartials = 0;
+ Xen orig_x = Xen_false, orig_y = Xen_false;
mus_float_t freq;
- mus_float_t *coeffs = NULL, *partials = NULL;
+ mus_float_t *xcoeffs = NULL, *ycoeffs = NULL, *partials = NULL;
mus_polynomial_t kind = MUS_CHEBYSHEV_FIRST_KIND;
+ int error = NO_PROBLEM_IN_LIST;
freq = clm_default_frequency;
keys[0] = kw_frequency;
keys[1] = kw_partials;
keys[2] = kw_type;
+ keys[3] = kw_x_coeffs;
+ keys[4] = kw_y_coeffs;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_polywave, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 10) clm_error(S_make_polywave, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
+ }
- vals = mus_optkey_unscramble(S_make_polywave, 3, keys, args, orig_arg);
+ vals = mus_optkey_unscramble(S_make_polywave, 5, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], S_make_polywave, orig_arg[0], freq);
+ vct *v;
+ int type;
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_polywave, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_polywave, orig_arg[0], keys[0], "freq ~A > srate/2?");
+ Xen_out_of_range_error(S_make_polywave, orig_arg[0], keys[0], "freq > srate/2?");
- type = mus_optkey_to_int(keys[2], S_make_polywave, orig_arg[2], (int)kind);
+ type = Xen_optkey_to_int(kw_type, keys[2], S_make_polywave, orig_arg[2], (int)kind);
if ((type >= MUS_CHEBYSHEV_EITHER_KIND) &&
- (type <= MUS_CHEBYSHEV_SECOND_KIND))
+ (type <= MUS_CHEBYSHEV_BOTH_KINDS))
kind = (mus_polynomial_t)type;
- else XEN_OUT_OF_RANGE_ERROR(S_make_polywave, orig_arg[2], keys[2], "~A: unknown Chebyshev polynomial kind");
+ else Xen_out_of_range_error(S_make_polywave, orig_arg[2], keys[2], "unknown Chebyshev polynomial kind");
- if (!(XEN_KEYWORD_P(keys[1])))
+ if (!(Xen_is_keyword(keys[1]))) /* partials were supplied */
{
- int error = NO_PROBLEM_IN_LIST;
- if (MUS_VCT_P(keys[1]))
- partials = mus_vct_to_partials(XEN_TO_VCT(keys[1]), &npartials, &error);
+ if (mus_is_vct(keys[1]))
+ partials = mus_vct_to_partials(Xen_to_vct(keys[1]), &npartials, &error);
else
{
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[1]), keys[1], orig_arg[1], S_make_polywave, "a list or a vct");
- partials = list_to_partials(keys[1], &npartials, &error);
+ if (Xen_is_vector(keys[1]))
+ partials = mus_vector_to_partials(keys[1], &npartials, &error);
+ else
+ {
+ Xen_check_type(Xen_is_list(keys[1]), keys[1], orig_arg[1], S_make_polywave, "a list or a " S_vct);
+ partials = list_to_partials(keys[1], &npartials, &error);
+ }
}
-
- if (partials == NULL)
- XEN_ERROR(NO_DATA,
- XEN_LIST_3(C_TO_XEN_STRING(list_to_partials_error_to_string(error)),
- C_TO_XEN_STRING(S_make_polywave),
+ if (partials == NULL) /* here if null, something went wrong in the translation functions */
+ Xen_error(NO_DATA,
+ Xen_list_3(C_string_to_Xen_string(list_to_partials_error_to_string(error)),
+ C_string_to_Xen_string(S_make_polywave),
keys[1]));
- coeffs = partials;
+ xcoeffs = partials;
n = npartials;
- /* coeffs = partials here, so don't delete */
+ orig_x = xen_make_vct(n, xcoeffs);
+ /* xcoeffs = partials here, so don't delete */
+ }
+
+ if (!(Xen_is_keyword(keys[3])))
+ {
+ Xen_check_type(mus_is_vct(keys[3]), keys[3], orig_arg[3], S_make_polywave, "a " S_vct);
+ orig_x = keys[3];
+ v = Xen_to_vct(orig_x);
+ n = mus_vct_length(v);
+ xcoeffs = mus_vct_data(v);
+ }
+
+ if (!(Xen_is_keyword(keys[4])))
+ {
+ /* make-polyoid in generators.scm */
+ int yn;
+ Xen_check_type(mus_is_vct(keys[4]), keys[4], orig_arg[4], S_make_polywave, "a " S_vct);
+ orig_y = keys[4];
+ v = Xen_to_vct(orig_y);
+ yn = mus_vct_length(v);
+ if ((n == 0) || (yn < n))
+ n = yn;
+ ycoeffs = mus_vct_data(v);
}
}
- if (!coeffs)
+ if (!xcoeffs)
{
/* clm.html says '(1 1) is the default but table-lookup is 0? */
mus_float_t *data;
- data = (mus_float_t *)calloc(2, sizeof(mus_float_t));
+ data = (mus_float_t *)malloc(2 * sizeof(mus_float_t));
data[0] = 0.0;
data[1] = 1.0;
- coeffs = data;
+ xcoeffs = data;
n = 2;
+ orig_x = xen_make_vct(n, xcoeffs);
}
- orig_v = xen_make_vct(n, coeffs);
- ge = mus_make_polywave(freq, coeffs, n, kind);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_v)));
- return(XEN_FALSE);
+ if (ycoeffs)
+ {
+ ge = mus_make_polywave_tu(freq, xcoeffs, ycoeffs, n);
+ if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(ge, orig_x, orig_y)));
+ }
+ ge = mus_make_polywave(freq, xcoeffs, n, kind);
+ if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, orig_x)));
+ return(Xen_false);
}
/* ---------------- nrxysin and nrxycos ---------------- */
-static XEN g_nrxysin_p(XEN obj)
+static Xen g_is_nrxysin(Xen obj)
{
- #define H_nrxysin_p "(" S_nrxysin_p " gen): " PROC_TRUE " if gen is an " S_nrxysin " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) &&
- (mus_nrxysin_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_nrxysin "(" S_is_nrxysin " gen): " PROC_TRUE " if gen is an " S_nrxysin " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
+ (mus_is_nrxysin(Xen_to_mus_any(obj)))));
}
-static XEN g_nrxycos_p(XEN obj)
+static Xen g_is_nrxycos(Xen obj)
{
- #define H_nrxycos_p "(" S_nrxycos_p " gen): " PROC_TRUE " if gen is an " S_nrxycos " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) &&
- (mus_nrxycos_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_nrxycos "(" S_is_nrxycos " gen): " PROC_TRUE " if gen is an " S_nrxycos " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
+ (mus_is_nrxycos(Xen_to_mus_any(obj)))));
}
-static XEN g_nrxysin(XEN obj, XEN fm)
+static Xen g_nrxysin(Xen obj, Xen fm)
{
- #define H_nrxysin "(" S_nrxysin " gen :optional (fm 0.0)): next sample of nrxysin generator"
+ #define H_nrxysin "(" S_nrxysin " gen (fm 0.0)): next sample of nrxysin generator"
mus_float_t fm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_nrxysin_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_nrxysin, "an " S_nrxysin " generator");
+ Xen_to_C_generator(obj, gn, g, mus_is_nrxysin, S_nrxysin, "an nrxysin generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_nrxysin, 2);
- if (XEN_NUMBER_P(fm))
- fm1 = XEN_TO_C_DOUBLE(fm);
- else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_nrxysin, "a number");
- return(C_TO_XEN_DOUBLE(mus_nrxysin(XEN_TO_MUS_ANY(obj), fm1)));
+ return(C_double_to_Xen_real(mus_nrxysin(g, fm1)));
}
-static XEN g_nrxycos(XEN obj, XEN fm)
+static Xen g_nrxycos(Xen obj, Xen fm)
{
- #define H_nrxycos "(" S_nrxycos " gen :optional (fm 0.0)): next sample of nrxycos generator"
+ #define H_nrxycos "(" S_nrxycos " gen (fm 0.0)): next sample of nrxycos generator"
mus_float_t fm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_nrxycos_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_nrxycos, "an " S_nrxycos " generator");
+ Xen_to_C_generator(obj, gn, g, mus_is_nrxycos, S_nrxycos, "an nrxycos generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_nrxycos, 2);
- if (XEN_NUMBER_P(fm))
- fm1 = XEN_TO_C_DOUBLE(fm);
- else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(fm), fm, XEN_ARG_2, S_nrxycos, "a number");
- return(C_TO_XEN_DOUBLE(mus_nrxycos(XEN_TO_MUS_ANY(obj), fm1)));
+ return(C_double_to_Xen_real(mus_nrxycos(g, fm1)));
}
-static XEN g_make_nrxy(bool sin_case, const char *caller, XEN arglist)
+static Xen g_make_nrxy(bool sin_case, const char *caller, Xen arglist)
{
mus_any *ge;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[4];
+ Xen args[8];
+ Xen keys[4];
int orig_arg[4] = {0, 0, 0, 0};
- int vals, i, arglist_len;
+ int vals;
mus_float_t freq, r = 0.5, ratio = 1.0;
int n = 1;
@@ -4910,51 +5845,53 @@ static XEN g_make_nrxy(bool sin_case, const char *caller, XEN arglist)
keys[2] = kw_n;
keys[3] = kw_r;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(caller, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 8) clm_error(caller, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 8; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(caller, 4, keys, args, orig_arg);
if (vals > 0)
{
- freq = mus_optkey_to_float(keys[0], caller, orig_arg[0], freq);
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[0], keys[0], "freq ~A > srate/2?");
+ Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
- ratio = mus_optkey_to_float(keys[1], caller, orig_arg[1], ratio);
+ ratio = Xen_optkey_to_float(kw_ratio, keys[1], caller, orig_arg[1], ratio);
- n = mus_optkey_to_int(keys[2], caller, orig_arg[2], n);
+ n = Xen_optkey_to_int(kw_n, keys[2], caller, orig_arg[2], n);
if (n < 0)
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[2], keys[2], "n (sidebands): ~A?");
+ Xen_out_of_range_error(caller, orig_arg[2], keys[2], "n (sidebands) < 0?");
- r = mus_optkey_to_float(keys[3], caller, orig_arg[3], r);
+ r = Xen_optkey_to_float(kw_r, keys[3], caller, orig_arg[3], r);
if ((r >= 1.0) ||
(r <= -1.0))
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[3], keys[3], "r (sideband amp ratio): ~A?");
- /* if not --with-doubles, this actually maxes out around .99999999 because mus_optkey_to_float (apparently) rounds up */
+ Xen_out_of_range_error(caller, orig_arg[3], keys[3], "r (sideband amp ratio) not within -1.0 to 1.0?");
+ /* if not with doubles, this actually maxes out around .99999999 because mus_optkey_to_float (apparently) rounds up */
}
if (sin_case)
ge = mus_make_nrxysin(freq, ratio, n, r);
else ge = mus_make_nrxycos(freq, ratio, n, r);
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_make_nrxysin(XEN arglist)
+static Xen g_make_nrxysin(Xen arglist)
{
- #define H_make_nrxysin "(" S_make_nrxysin " (:frequency *clm-default-frequency*) (:ratio 1.0) (:n 1) (:r 0.5)): \
+ #define H_make_nrxysin "(" S_make_nrxysin " (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r 0.5)): \
return a new nrxysin generator."
return(g_make_nrxy(true, S_make_nrxysin, arglist));
}
-static XEN g_make_nrxycos(XEN arglist)
+static Xen g_make_nrxycos(Xen arglist)
{
- #define H_make_nrxycos "(" S_make_nrxycos " (:frequency *clm-default-frequency*) (:ratio 1.0) (:n 1) (:r 0.5)): \
+ #define H_make_nrxycos "(" S_make_nrxycos " (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r 0.5)): \
return a new nrxycos generator."
return(g_make_nrxy(false, S_make_nrxycos, arglist));
@@ -4962,89 +5899,208 @@ return a new nrxycos generator."
+/* ---------------- rxyksin and rxykcos ---------------- */
+
+static Xen g_is_rxyksin(Xen obj)
+{
+ #define H_is_rxyksin "(" S_is_rxyksin " gen): " PROC_TRUE " if gen is an " S_rxyksin " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
+ (mus_is_rxyksin(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_is_rxykcos(Xen obj)
+{
+ #define H_is_rxykcos "(" S_is_rxykcos " gen): " PROC_TRUE " if gen is an " S_rxykcos " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) &&
+ (mus_is_rxykcos(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_rxyksin(Xen obj, Xen fm)
+{
+ #define H_rxyksin "(" S_rxyksin " gen (fm 0.0)): next sample of rxyksin generator"
+ mus_float_t fm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_rxyksin, S_rxyksin, "an rxyksin generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_rxyksin, 2);
+
+ return(C_double_to_Xen_real(mus_rxyksin(g, fm1)));
+}
+
+static Xen g_rxykcos(Xen obj, Xen fm)
+{
+ #define H_rxykcos "(" S_rxykcos " gen (fm 0.0)): next sample of rxykcos generator"
+ mus_float_t fm1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_rxykcos, S_rxykcos, "an rxykcos generator");
+ Xen_real_to_C_double_if_bound(fm, fm1, S_rxykcos, 2);
+
+ return(C_double_to_Xen_real(mus_rxykcos(g, fm1)));
+}
+
+
+static Xen g_make_rxyk(bool sin_case, const char *caller, Xen arglist)
+{
+ mus_any *ge;
+ Xen args[6];
+ Xen keys[3];
+ int orig_arg[3] = {0, 0, 0};
+ int vals;
+ mus_float_t freq, r = 0.5, ratio = 1.0; /* original in generators.scm assumes initial-phase = 0.0 */
+
+ freq = clm_default_frequency;
+
+ keys[0] = kw_frequency;
+ keys[1] = kw_ratio;
+ keys[2] = kw_r;
+
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 6) clm_error(caller, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 6; i++) args[i] = Xen_undefined;
+ }
+
+ vals = mus_optkey_unscramble(caller, 3, keys, args, orig_arg);
+ if (vals > 0)
+ {
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], caller, orig_arg[0], freq);
+ if (freq > (0.5 * mus_srate()))
+ Xen_out_of_range_error(caller, orig_arg[0], keys[0], "freq > srate/2?");
+
+ ratio = Xen_optkey_to_float(kw_ratio, keys[1], caller, orig_arg[1], ratio);
+ r = Xen_optkey_to_float(kw_r, keys[2], caller, orig_arg[2], r);
+ }
+ if (sin_case)
+ ge = mus_make_rxyksin(freq, 0.0, r, ratio);
+ else ge = mus_make_rxykcos(freq, 0.0, r, ratio);
+ if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
+ return(Xen_false);
+}
+
+
+static Xen g_make_rxyksin(Xen arglist)
+{
+ #define H_make_rxyksin "(" S_make_rxyksin " (frequency *clm-default-frequency*) (initial-phase 0.0) (ratio 1.0) (r 0.5)): \
+return a new rxyksin generator."
+
+ return(g_make_rxyk(true, S_make_rxyksin, arglist));
+}
+
+static Xen g_make_rxykcos(Xen arglist)
+{
+ #define H_make_rxykcos "(" S_make_rxykcos " (frequency *clm-default-frequency*) (initial-phase 0.0) (ratio 1.0) (r 0.5)): \
+return a new rxykcos generator."
+
+ return(g_make_rxyk(false, S_make_rxykcos, arglist));
+}
+
+
+
/* ---------------- filter ---------------- */
typedef enum {G_FILTER, G_FIR_FILTER, G_IIR_FILTER} xclm_fir_t;
-static XEN g_make_fir_coeffs(XEN order, XEN envl)
+static Xen g_make_fir_coeffs(Xen order, Xen envl)
{
- #define H_make_fir_coeffs "(" S_make_fir_coeffs " order v): turn spectral envelope in vct v into coeffs for FIR filter"
+ #define H_make_fir_coeffs "(" S_make_fir_coeffs " order v): turn spectral envelope in " S_vct " v into coeffs for FIR filter"
int size;
mus_float_t *a;
vct *v;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(order), order, XEN_ARG_1, S_make_fir_coeffs, "int");
- XEN_ASSERT_TYPE(MUS_VCT_P(envl), envl, XEN_ARG_2, S_make_fir_coeffs, "a vct");
+ Xen_check_type(Xen_is_integer(order), order, 1, S_make_fir_coeffs, "int");
+ Xen_check_type(mus_is_vct(envl), envl, 2, S_make_fir_coeffs, "a " S_vct);
- v = XEN_TO_VCT(envl);
+ v = Xen_to_vct(envl);
- size = XEN_TO_C_INT(order);
- if (size != v->length)
- XEN_ERROR(CLM_ERROR,
- XEN_LIST_3(C_TO_XEN_STRING(S_make_fir_coeffs ": order ~A != vct length ~A"),
+ size = Xen_integer_to_C_int(order);
+ if (size != mus_vct_length(v))
+ Xen_error(CLM_ERROR,
+ Xen_list_3(C_string_to_Xen_string(S_make_fir_coeffs ": order ~A != " S_vct " length ~A"),
order,
envl));
- a = mus_make_fir_coeffs(XEN_TO_C_INT(order), v->data, NULL);
- return(xen_make_vct(v->length, a));
+ a = mus_make_fir_coeffs(Xen_integer_to_C_int(order), mus_vct_data(v), NULL);
+ return(xen_make_vct(mus_vct_length(v), a));
}
-static XEN g_filter_p(XEN obj)
+static Xen g_is_filter(Xen obj)
{
- #define H_filter_p "(" S_filter_p " gen): " PROC_TRUE " if gen is a " S_filter
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_filter_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_filter "(" S_is_filter " gen): " PROC_TRUE " if gen is a " S_filter
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_filter(Xen_to_mus_any(obj)))));
}
-static XEN g_fir_filter_p(XEN obj)
+static Xen g_is_fir_filter(Xen obj)
{
- #define H_fir_filter_p "(" S_fir_filter_p " gen): " PROC_TRUE " if gen is an " S_fir_filter
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_fir_filter_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_fir_filter "(" S_is_fir_filter " gen): " PROC_TRUE " if gen is an " S_fir_filter
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_fir_filter(Xen_to_mus_any(obj)))));
}
-static XEN g_iir_filter_p(XEN obj)
+static Xen g_is_iir_filter(Xen obj)
{
- #define H_iir_filter_p "(" S_iir_filter_p " gen): " PROC_TRUE " if gen is an " S_iir_filter
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_iir_filter_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_iir_filter "(" S_is_iir_filter " gen): " PROC_TRUE " if gen is an " S_iir_filter
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_iir_filter(Xen_to_mus_any(obj)))));
}
-static XEN g_filter(XEN obj, XEN input)
+static Xen g_filter(Xen obj, Xen input)
{
- #define H_filter "(" S_filter " gen :optional (input 0.0)): next sample from filter"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_filter_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_filter, " a filter");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(input), input, XEN_ARG_2, S_filter, "a number");
- return(C_TO_XEN_DOUBLE(mus_filter(XEN_TO_MUS_ANY(obj), XEN_TO_C_DOUBLE(input))));
+ #define H_filter "(" S_filter " gen (input 0.0)): next sample from filter"
+ mus_any *g = NULL;
+ mus_xen *gn;
+ mus_float_t x = 0.0;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_filter, S_filter, "a filter");
+ Xen_real_to_C_double_if_bound(input, x, S_filter, 2);
+
+ return(C_double_to_Xen_real(mus_filter(g, x)));
}
-static XEN g_fir_filter(XEN obj, XEN input)
+static Xen g_fir_filter(Xen obj, Xen input)
{
- #define H_fir_filter "(" S_fir_filter " gen :optional (input 0.0)): next sample from FIR filter"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_fir_filter_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_fir_filter, "an FIR filter");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(input), input, XEN_ARG_2, S_fir_filter, "a number");
- return(C_TO_XEN_DOUBLE(mus_fir_filter(XEN_TO_MUS_ANY(obj), XEN_TO_C_DOUBLE(input))));
+ #define H_fir_filter "(" S_fir_filter " gen (input 0.0)): next sample from FIR filter"
+ mus_any *g = NULL;
+ mus_xen *gn;
+ mus_float_t x = 0.0;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_fir_filter, S_fir_filter, "an FIR filter");
+ Xen_real_to_C_double_if_bound(input, x, S_fir_filter, 2);
+
+ return(C_double_to_Xen_real(mus_fir_filter(g, x)));
}
-static XEN g_iir_filter(XEN obj, XEN input)
+static Xen g_iir_filter(Xen obj, Xen input)
{
- #define H_iir_filter "(" S_iir_filter " gen :optional (input 0.0)): next sample from IIR filter"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_iir_filter_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_iir_filter, "an IIR filter");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(input), input, XEN_ARG_2, S_iir_filter, "a number");
- return(C_TO_XEN_DOUBLE(mus_iir_filter(XEN_TO_MUS_ANY(obj), XEN_TO_C_DOUBLE(input))));
+ #define H_iir_filter "(" S_iir_filter " gen (input 0.0)): next sample from IIR filter"
+ mus_any *g = NULL;
+ mus_xen *gn;
+ mus_float_t x = 0.0;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_iir_filter, S_iir_filter, "an IIR filter");
+ Xen_real_to_C_double_if_bound(input, x, S_iir_filter, 2);
+
+ return(C_double_to_Xen_real(mus_iir_filter(g, x)));
}
-static XEN g_make_filter_1(xclm_fir_t choice, XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_filter_1(xclm_fir_t choice, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- XEN xwave = XEN_UNDEFINED, ywave = XEN_UNDEFINED;
+ Xen xwave = Xen_undefined, ywave = Xen_undefined;
mus_any *fgen = NULL;
- mus_xen *gn = NULL;
- XEN args[8];
- XEN keys[4];
+ Xen args[8];
+ Xen keys[4];
int orig_arg[4] = {0, 0, 0, 0};
vct *x = NULL, *y = NULL;
int vals, order = 0;
@@ -5055,41 +6111,41 @@ static XEN g_make_filter_1(xclm_fir_t choice, XEN arg1, XEN arg2, XEN arg3, XEN
keys[1] = kw_x_coeffs;
keys[2] = kw_y_coeffs;
keys[3] = kw_coeffs;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6; args[6] = XEN_UNDEFINED; args[7] = XEN_UNDEFINED;
+ args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6; args[6] = Xen_undefined; args[7] = Xen_undefined;
vals = mus_optkey_unscramble(caller, 4, keys, args, orig_arg);
if (vals > 0)
{
- if (!(XEN_KEYWORD_P(keys[0])))
+ if (!(Xen_is_keyword(keys[0])))
{
- order = mus_optkey_to_int(keys[0], caller, orig_arg[0], 0);
+ order = Xen_optkey_to_int(kw_order, keys[0], caller, orig_arg[0], 0);
if (order <= 0)
- XEN_OUT_OF_RANGE_ERROR(caller, orig_arg[0], keys[0], "order ~A <= 0?");
+ Xen_out_of_range_error(caller, orig_arg[0], keys[0], "order <= 0?");
}
- if (!(XEN_KEYWORD_P(keys[1])))
+ if (!(Xen_is_keyword(keys[1])))
{
- XEN_ASSERT_TYPE(MUS_VCT_P(keys[1]), keys[1], orig_arg[1], caller, "a vct");
+ Xen_check_type(mus_is_vct(keys[1]), keys[1], orig_arg[1], caller, "a " S_vct);
if (choice == G_IIR_FILTER)
{
ywave = keys[1];
- y = XEN_TO_VCT(ywave);
+ y = Xen_to_vct(ywave);
}
else
{
xwave = keys[1];
- x = XEN_TO_VCT(xwave);
+ x = Xen_to_vct(xwave);
}
}
- if (!(XEN_KEYWORD_P(keys[2])))
+ if (!(Xen_is_keyword(keys[2])))
{
- XEN_ASSERT_TYPE(MUS_VCT_P(keys[2]), keys[2], orig_arg[2], caller, "a vct");
+ Xen_check_type(mus_is_vct(keys[2]), keys[2], orig_arg[2], caller, "a " S_vct);
ywave = keys[2];
- y = XEN_TO_VCT(ywave);
+ y = Xen_to_vct(ywave);
}
- if ((choice != G_FILTER) && (!(XEN_KEYWORD_P(keys[3]))))
+ if ((choice != G_FILTER) && (!(Xen_is_keyword(keys[3]))))
{
if (choice == G_IIR_FILTER)
clm_error(caller, "redundant arg passed to " S_make_iir_filter "?", keys[3]);
@@ -5109,83 +6165,82 @@ static XEN g_make_filter_1(xclm_fir_t choice, XEN arg1, XEN arg2, XEN arg3, XEN
}
if (((x == NULL) && (choice != G_IIR_FILTER)) ||
((y == NULL) && (choice != G_FIR_FILTER)))
- XEN_ERROR(NO_DATA,
- XEN_LIST_2(C_TO_XEN_STRING("~A: no coeffs?"),
- C_TO_XEN_STRING(caller)));
+ Xen_error(NO_DATA,
+ Xen_list_2(C_string_to_Xen_string("~A: no coeffs?"),
+ C_string_to_Xen_string(caller)));
if (order == 0)
{
if (x)
- order = x->length;
- else order = y->length;
+ order = mus_vct_length(x);
+ else order = mus_vct_length(y);
}
else
{
- if ((x) && (order > x->length))
+ if ((x) && (order > mus_vct_length(x)))
{
- XEN_ERROR(CLM_ERROR,
- XEN_LIST_4(C_TO_XEN_STRING("~A: xcoeffs, ~A, must match order, ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(CLM_ERROR,
+ Xen_list_4(C_string_to_Xen_string("~A: xcoeffs, ~A, must match order, ~A"),
+ C_string_to_Xen_string(caller),
keys[1],
keys[0]));
}
else
{
- if ((y) && (order > y->length))
- XEN_ERROR(CLM_ERROR,
- XEN_LIST_4(C_TO_XEN_STRING("~A: ycoeffs, ~A, must match order, ~A"),
- C_TO_XEN_STRING(caller),
+ if ((y) && (order > mus_vct_length(y)))
+ Xen_error(CLM_ERROR,
+ Xen_list_4(C_string_to_Xen_string("~A: ycoeffs, ~A, must match order, ~A"),
+ C_string_to_Xen_string(caller),
keys[2],
keys[0]));
else
{
- if ((x) && (y) && (x->length != y->length))
- XEN_ERROR(CLM_ERROR,
- XEN_LIST_4(C_TO_XEN_STRING("~A: coeffs must be same length. x len: ~A, y len: ~A"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT(x->length),
- C_TO_XEN_INT(y->length)));
+ if ((x) && (y) && (mus_vct_length(x) != mus_vct_length(y)))
+ Xen_error(CLM_ERROR,
+ Xen_list_4(C_string_to_Xen_string("~A: coeffs must be same length. x len: ~A, y len: ~A"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer(mus_vct_length(x)),
+ C_int_to_Xen_integer(mus_vct_length(y))));
}
}
}
switch (choice)
{
- case G_FILTER: fgen = mus_make_filter(order, x->data, y->data, NULL); break;
- case G_FIR_FILTER: fgen = mus_make_fir_filter(order, x->data, NULL); break;
- case G_IIR_FILTER: fgen = mus_make_iir_filter(order, y->data, NULL); break;
+ case G_FILTER: fgen = mus_make_filter(order, mus_vct_data(x), mus_vct_data(y), NULL); break;
+ case G_FIR_FILTER: fgen = mus_make_fir_filter(order, mus_vct_data(x), NULL); break;
+ case G_IIR_FILTER: fgen = mus_make_iir_filter(order, mus_vct_data(y), NULL); break;
}
if (fgen)
{
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
+ mus_xen *gn = NULL;
+ gn = mx_alloc(3);
gn->gen = fgen; /* delay gn allocation since make_filter can throw an error */
- gn->nvcts = 3;
- gn->vcts = make_vcts(gn->nvcts);
gn->vcts[G_FILTER_STATE] = xen_make_vct_wrapper(order, mus_data(fgen));
gn->vcts[G_FILTER_XCOEFFS] = xwave;
gn->vcts[G_FILTER_YCOEFFS] = ywave;
return(mus_xen_to_object(gn));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_make_filter(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- #define H_make_filter "(" S_make_filter " :order :xcoeffs :ycoeffs): return a new direct form FIR/IIR filter, coeff args are vcts"
+ #define H_make_filter "(" S_make_filter " order xcoeffs ycoeffs): return a new direct form FIR/IIR filter, coeff args are " S_vct "s"
return(g_make_filter_1(G_FILTER, arg1, arg2, arg3, arg4, arg5, arg6));
}
-static XEN g_make_fir_filter(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen g_make_fir_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
- #define H_make_fir_filter "(" S_make_fir_filter " :order :xcoeffs): return a new FIR filter, xcoeffs a vct"
- return(g_make_filter_1(G_FIR_FILTER, arg1, arg2, arg3, arg4, XEN_UNDEFINED, XEN_UNDEFINED));
+ #define H_make_fir_filter "(" S_make_fir_filter " order xcoeffs): return a new FIR filter, xcoeffs a " S_vct
+ return(g_make_filter_1(G_FIR_FILTER, arg1, arg2, arg3, arg4, Xen_undefined, Xen_undefined));
}
-static XEN g_make_iir_filter(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen g_make_iir_filter(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
- #define H_make_iir_filter "(" S_make_iir_filter " :order :ycoeffs): return a new IIR filter, ycoeffs a vct"
- return(g_make_filter_1(G_IIR_FILTER, arg1, arg2, arg3, arg4, XEN_UNDEFINED, XEN_UNDEFINED));
+ #define H_make_iir_filter "(" S_make_iir_filter " order ycoeffs): return a new IIR filter, ycoeffs a " S_vct
+ return(g_make_filter_1(G_IIR_FILTER, arg1, arg2, arg3, arg4, Xen_undefined, Xen_undefined));
}
@@ -5193,39 +6248,43 @@ static XEN g_make_iir_filter(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
/* ---------------- env ---------------- */
-static XEN g_env_p(XEN obj)
+static Xen g_is_env(Xen obj)
{
- #define H_env_p "(" S_env_p " gen): " PROC_TRUE " if gen is a " S_env
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_env_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_env "(" S_is_env " gen): " PROC_TRUE " if gen is a " S_env
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_env(Xen_to_mus_any(obj)))));
}
-static XEN g_env(XEN obj)
+static Xen g_env(Xen obj)
{
#define H_env "(" S_env " gen): next sample from envelope generator"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_env_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ONLY_ARG, S_env, "an env generator");
- return(C_TO_XEN_DOUBLE(mus_env(XEN_TO_MUS_ANY(obj))));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_env, S_env, "an env generator");
+
+ return(C_double_to_Xen_real(mus_env(g)));
}
-static XEN g_make_env(XEN arglist)
+static Xen g_make_env(Xen arglist)
{
- #define H_make_env "(" S_make_env " :envelope (:scaler 1.0) :duration (:offset 0.0) (:base 1.0) :end :length): \
-return a new envelope generator. 'envelope' is a list or vct of break-point pairs. To create the envelope, \
+ #define H_make_env "(" S_make_env " envelope (scaler 1.0) (duration) (offset 0.0) (base 1.0) (end) (length)): \
+return a new envelope generator. 'envelope' is a list, vector, or " S_vct " of break-point pairs. To create the envelope, \
these points are offset by 'offset', scaled by 'scaler', and mapped over the time interval defined by \
either 'duration' (seconds) or 'length' (samples). If 'base' is 1.0, the connecting segments \
are linear, if 0.0 you get a step function, and anything else produces an exponential connecting segment."
mus_any *ge;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[7];
+ Xen args[14];
+ Xen keys[7];
int orig_arg[7] = {0, 0, 0, 0, 0, 0, 0};
- int vals, i, len = 0, arglist_len;
+ int vals, i;
mus_float_t base = 1.0, scaler = 1.0, offset = 0.0, duration = 0.0;
- mus_long_t end = 0, dur = 0;
+ mus_long_t end = 0, dur = -1;
int npts = 0;
- mus_float_t *brkpts = NULL, *odata = NULL;
- XEN lst;
+ mus_float_t *brkpts = NULL;
+ vct *v = NULL;
keys[0] = kw_envelope;
keys[1] = kw_scaler;
@@ -5235,145 +6294,189 @@ are linear, if 0.0 you get a step function, and anything else produces an expone
keys[5] = kw_end;
keys[6] = kw_length;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_env, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 14) clm_error(S_make_env, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 14; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_env, 7, keys, args, orig_arg);
if (vals > 0)
{
- scaler = mus_optkey_to_float(keys[1], S_make_env, orig_arg[1], 1.0);
+ scaler = Xen_optkey_to_float(kw_scaler, keys[1], S_make_env, orig_arg[1], 1.0);
- duration = mus_optkey_to_float(keys[2], S_make_env, orig_arg[2], 0.0);
- if ((duration < 0.0) || ((duration == 0.0) && (!XEN_KEYWORD_P(keys[2]))))
- XEN_OUT_OF_RANGE_ERROR(S_make_env, orig_arg[2], keys[2], "duration ~A <= 0.0?");
+ duration = Xen_optkey_to_float(kw_duration, keys[2], S_make_env, orig_arg[2], 0.0);
+ if ((duration < 0.0) || ((duration == 0.0) && (!Xen_is_keyword(keys[2]))))
+ Xen_out_of_range_error(S_make_env, orig_arg[2], keys[2], "duration <= 0.0?");
- offset = mus_optkey_to_float(keys[3], S_make_env, orig_arg[3], 0.0);
+ offset = Xen_optkey_to_float(kw_offset, keys[3], S_make_env, orig_arg[3], 0.0);
- base = mus_optkey_to_float(keys[4], S_make_env, orig_arg[4], 1.0);
+ base = Xen_optkey_to_float(kw_base, keys[4], S_make_env, orig_arg[4], 1.0);
if (base < 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_env, orig_arg[4], keys[4], "base ~A < 0.0?");
+ Xen_out_of_range_error(S_make_env, orig_arg[4], keys[4], "base < 0.0?");
- end = mus_optkey_to_mus_long_t(keys[5], S_make_env, orig_arg[5], 0);
+ end = Xen_optkey_to_mus_long_t(kw_end, keys[5], S_make_env, orig_arg[5], 0);
if (end < 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_env, orig_arg[5], keys[5], "end ~A < 0?");
+ Xen_out_of_range_error(S_make_env, orig_arg[5], keys[5], "end < 0?");
- dur = mus_optkey_to_mus_long_t(keys[6], S_make_env, orig_arg[6], 0);
+ dur = Xen_optkey_to_mus_long_t(kw_length, keys[6], S_make_env, orig_arg[6], 0);
if (dur < 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_env, orig_arg[6], keys[6], "dur ~A < 0?");
+ Xen_out_of_range_error(S_make_env, orig_arg[6], keys[6], "length < 0?");
/* env data is a list, checked last to let the preceding throw wrong-type error before calloc */
- if (!(XEN_KEYWORD_P(keys[0])))
+ if (!(Xen_is_keyword(keys[0])))
{
- vct *v = NULL;
- if (MUS_VCT_P(keys[0]))
+ int len;
+ Xen vect = XEN_NULL;
+ if (mus_is_vct(keys[0]))
{
- v = XEN_TO_VCT(keys[0]);
- len = v->length;
+ v = Xen_to_vct(keys[0]);
+ len = mus_vct_length(v);
if ((len < 2) || (len & 1))
- XEN_ERROR(BAD_TYPE,
- XEN_LIST_2(C_TO_XEN_STRING(S_make_env ": vct is a bogus breakpoints list, ~A"),
+ Xen_error(BAD_TYPE,
+ Xen_list_2(C_string_to_Xen_string(S_make_env ": " S_vct " is a bogus breakpoints list, ~A"),
keys[0]));
}
else
{
- XEN_ASSERT_TYPE(XEN_LIST_P_WITH_LENGTH(keys[0], len), keys[0], orig_arg[0], S_make_env, "a list");
- if (len == 0)
- XEN_ERROR(NO_DATA,
- XEN_LIST_2(C_TO_XEN_STRING(S_make_env ": null env? ~A"),
- keys[0]));
-
- if (XEN_LIST_P(XEN_CAR(keys[0])))
- len *= 2;
+#if HAVE_SCHEME
+ /* in Ruby and Forth vectors and lists are the same, so stay with the old code */
+ if (Xen_is_vector(keys[0]))
+ {
+ vect = keys[0];
+ len = Xen_vector_length(vect);
+ if ((len < 2) || (len & 1))
+ Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_make_env ": vector is a bogus breakpoints list, ~A"), vect));
+ }
else
{
- if (len & 1)
- XEN_ERROR(BAD_TYPE,
- XEN_LIST_2(C_TO_XEN_STRING(S_make_env ": odd length breakpoints list? ~A"),
+#endif
+ Xen_check_type(Xen_is_list(keys[0]), keys[0], orig_arg[0], S_make_env, "a list, vector, or " S_vct);
+ len = Xen_list_length(keys[0]);
+ if (len == 0)
+ Xen_error(NO_DATA,
+ Xen_list_2(C_string_to_Xen_string(S_make_env ": null env? ~A"),
keys[0]));
-
- if (!(XEN_NUMBER_P(XEN_CAR(keys[0]))))
- XEN_ASSERT_TYPE(false, keys[0], orig_arg[0], S_make_env, "a list of numbers (breakpoints)");
+
+ if (Xen_is_list(Xen_car(keys[0])))
+ len *= 2;
+ else
+ {
+ if (len & 1)
+ Xen_error(BAD_TYPE,
+ Xen_list_2(C_string_to_Xen_string(S_make_env ": odd length breakpoints list? ~A"),
+ keys[0]));
+
+ if (!(Xen_is_number(Xen_car(keys[0]))))
+ Xen_check_type(false, keys[0], orig_arg[0], S_make_env, "a list of numbers (breakpoints)");
+ }
}
+#if HAVE_SCHEME
}
-
+#endif
npts = len / 2;
- brkpts = (mus_float_t *)calloc(len, sizeof(mus_float_t));
- if (brkpts == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate env list"));
- odata = (mus_float_t *)calloc(len, sizeof(mus_float_t));
- if (odata == NULL)
- return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate env copy"));
-
if (v)
- memcpy((void *)brkpts, (void *)(v->data), len * sizeof(mus_float_t));
+ brkpts = mus_vct_data(v);
else
{
- if (XEN_NUMBER_P(XEN_CAR(keys[0])))
+ brkpts = (mus_float_t *)malloc(len * sizeof(mus_float_t));
+ if (brkpts == NULL)
+ return(clm_mus_error(MUS_MEMORY_ALLOCATION_FAILED, "can't allocate env list", S_make_env));
+ if (vect)
{
- for (i = 0, lst = XEN_COPY_ARG(keys[0]); (i < len) && (XEN_NOT_NULL_P(lst)); i++, lst = XEN_CDR(lst))
- brkpts[i] = XEN_TO_C_DOUBLE_OR_ELSE(XEN_CAR(lst), 0.0);
+ for (i = 0; i < len; i++)
+ brkpts[i] = Xen_real_to_C_double(Xen_vector_ref(vect, i));
}
else
{
- for (i = 0, lst = XEN_COPY_ARG(keys[0]); (i < len) && (XEN_NOT_NULL_P(lst)); i += 2, lst = XEN_CDR(lst))
+ Xen lst;
+ if (Xen_is_number(Xen_car(keys[0])))
+ {
+ for (i = 0, lst = Xen_copy_arg(keys[0]); (i < len) && (!Xen_is_null(lst)); i++, lst = Xen_cdr(lst))
+ brkpts[i] = Xen_real_to_C_double(Xen_car(lst));
+ }
+ else
{
- XEN el;
- el = XEN_CAR(lst);
- brkpts[i] = XEN_TO_C_DOUBLE(XEN_CAR(el));
- brkpts[i + 1] = XEN_TO_C_DOUBLE(XEN_CADR(el));
+ for (i = 0, lst = Xen_copy_arg(keys[0]); (i < len) && (!Xen_is_null(lst)); i += 2, lst = Xen_cdr(lst))
+ {
+ Xen el;
+ el = Xen_car(lst);
+ if ((Xen_is_pair(el)) &&
+ (Xen_is_number(Xen_car(el))) &&
+ (Xen_is_pair(Xen_cdr(el))) &&
+ (Xen_is_number(Xen_cadr(el))))
+ {
+ brkpts[i] = Xen_real_to_C_double(Xen_car(el));
+ brkpts[i + 1] = Xen_real_to_C_double(Xen_cadr(el));
+ }
+ else
+ {
+ Xen_error(BAD_TYPE,
+ Xen_list_2(C_string_to_Xen_string(S_make_env ": odd breakpoints list? ~A"),
+ keys[0]));
+ }
+ }
}
}
}
- memcpy((void *)odata, (void *)brkpts, len * sizeof(mus_float_t));
}
}
if (brkpts == NULL)
- XEN_ERROR(NO_DATA,
- XEN_LIST_1(C_TO_XEN_STRING(S_make_env ": no envelope?")));
+ {
+ Xen_error(NO_DATA,
+ Xen_list_1(C_string_to_Xen_string(S_make_env ": no envelope?")));
+ }
if (dur > 0)
{
if ((end > 0) && ((end + 1) != dur))
{
- if (brkpts) {free(brkpts); brkpts = NULL;}
- if (odata) {free(odata); odata = NULL;}
- XEN_ERROR(CLM_ERROR,
- XEN_LIST_3(C_TO_XEN_STRING(S_make_env ": end, ~A, and dur, ~A, specified, but dur != end+1"),
+ if ((!v) && (brkpts)) {free(brkpts); brkpts = NULL;}
+ Xen_error(CLM_ERROR,
+ Xen_list_3(C_string_to_Xen_string(S_make_env ": end, ~A, and dur, ~A, specified, but dur != end+1"),
keys[5],
keys[6]));
}
end = dur - 1;
}
+ /* (make-env '(0 1 1 0) :duration most-positive-fixnum) -> env linear, pass: 0 (dur: -9223372036854775808)...
+ */
+ if ((end <= 0) && (duration <= 0.0))
+ Xen_out_of_range_error(S_make_env, 0, C_double_to_Xen_real(duration), "duration <= 0.0?");
+ if (duration > (24 * 3600 * 365))
+ Xen_out_of_range_error(S_make_env, 0, C_double_to_Xen_real(duration), "duration > year?");
+
{
mus_error_handler_t *old_error_handler;
old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_env(brkpts, npts, scaler, offset, base, duration, end, odata);
+ ge = mus_make_env(brkpts, npts, scaler, offset, base, duration, end, NULL);
mus_error_set_handler(old_error_handler);
}
-
- free(brkpts);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, xen_make_vct(mus_env_breakpoints(ge) * 2, odata))));
- free(odata);
- return(clm_mus_error(local_error_type, local_error_msg));
+
+ if (ge)
+ {
+ if (v)
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, keys[0]))); /* in s7, keys[0] == v */
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(ge, xen_make_vct(mus_env_breakpoints(ge) * 2, brkpts))));
+ }
+ return(clm_mus_error(local_error_type, local_error_msg, S_make_env));
}
-static XEN g_env_interp(XEN x, XEN env1) /* "env" causes trouble in Objective-C!! */
+static Xen g_env_interp(Xen x, Xen env1) /* "env" causes trouble in Objective-C!! */
{
#define H_env_interp "(" S_env_interp " x env): value of envelope env at x"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_1, S_env_interp, "a number");
- XEN_ASSERT_TYPE((MUS_XEN_P(env1)) && (mus_env_p(XEN_TO_MUS_ANY(env1))), env1, XEN_ARG_2, S_env_interp, "an env generator");
- return(C_TO_XEN_DOUBLE(mus_env_interp(XEN_TO_C_DOUBLE(x), XEN_TO_MUS_ANY(env1))));
+ Xen_check_type(Xen_is_number(x), x, 1, S_env_interp, "a number");
+ Xen_check_type((mus_is_xen(env1)) && (mus_is_env(Xen_to_mus_any(env1))), env1, 2, S_env_interp, "an env generator");
+ return(C_double_to_Xen_real(mus_env_interp(Xen_real_to_C_double(x), Xen_to_mus_any(env1))));
}
-#if (!HAVE_NESTED_FUNCTIONS) || __cplusplus
/* mus_env_any calls the C function itself, so we pass it connect_func,
* connect_func uses the function passed as an argument to g_env_any.
@@ -5381,59 +6484,112 @@ static XEN g_env_interp(XEN x, XEN env1) /* "env" causes trouble in Objective-C!
* Both versions seem to work ok with recursive env-any calls.
*/
-static XEN current_connect_func;
+static Xen current_connect_func;
static mus_float_t connect_func(mus_float_t val)
{
- return(XEN_TO_C_DOUBLE(XEN_CALL_1(current_connect_func,
- C_TO_XEN_DOUBLE(val),
+ return(Xen_real_to_C_double(Xen_call_with_1_arg(current_connect_func,
+ C_double_to_Xen_real(val),
S_env_any " connect function")));
}
-static XEN g_env_any(XEN e, XEN func)
+static Xen g_env_any(Xen e, Xen func)
{
- XEN val;
- XEN old_connect_func = XEN_FALSE;
+ Xen val;
+ Xen old_connect_func = Xen_false;
#define H_env_any "(" S_env_any " e func) uses 'func' to connect the dots in the env 'e'"
- XEN_ASSERT_TYPE((MUS_XEN_P(e)) && (mus_env_p(XEN_TO_MUS_ANY(e))), e, XEN_ARG_1, S_env_any, "an env generator");
- XEN_ASSERT_TYPE((XEN_PROCEDURE_P(func)) && (XEN_REQUIRED_ARGS_OK(func, 1)), func, XEN_ARG_2, S_env_any, "a function of one arg");
+ Xen_check_type((mus_is_xen(e)) && (mus_is_env(Xen_to_mus_any(e))), e, 1, S_env_any, "an env generator");
+ Xen_check_type((Xen_is_procedure(func)) && (Xen_is_aritable(func, 1)), func, 2, S_env_any, "a function of one arg");
old_connect_func = current_connect_func;
current_connect_func = func;
- val = C_TO_XEN_DOUBLE(mus_env_any(XEN_TO_MUS_ANY(e), connect_func));
+ val = C_double_to_Xen_real(mus_env_any(Xen_to_mus_any(e), connect_func));
current_connect_func = old_connect_func;
return(val);
}
-#else
-static XEN g_env_any(XEN e, XEN func)
+
+#define S_envelope_interp "envelope-interp"
+
+static Xen g_envelope_interp(Xen ux, Xen e, Xen ubase)
{
- #define H_env_any "(" S_env_any " e func) uses 'func' to connect the dots in the env 'e'"
+ #define H_envelope_interp "(envelope-interp x e (base 1.0)) -> value of e at x; base controls connecting segment type: (envelope-interp .3 '(0 0 .5 1 1 0)) -> .6"
+ mus_float_t x, base = 1.0, x0, y0, y1;
+ Xen_check_type(Xen_is_number(ux), ux, 1, S_envelope_interp, "a number");
+ Xen_check_type(Xen_is_list(e), e, 2, S_envelope_interp, "a list");
- auto mus_float_t connect_func(mus_float_t val);
- /* this is apparently how you declare these nested functions!
- * without that line, the compiler sez: clm2xen.c:5252: warning: no previous prototype for 'connect_func'
- * if you try to use "static": clm2xen.c:5251: error: invalid storage class for function 'connect_func'
- * if nothing: clm2xen.c:5257: error: static declaration of 'connect_func' follows non-static declaration
- * but isn't "auto" simply the default?
- */
- mus_float_t connect_func(mus_float_t val)
- {
- return(XEN_TO_C_DOUBLE(XEN_CALL_1(func,
- C_TO_XEN_DOUBLE(val),
- S_env_any " connect function")));
- }
+ if (Xen_is_null(e))
+ return(Xen_integer_zero);
- XEN_ASSERT_TYPE((MUS_XEN_P(e)) && (mus_env_p(XEN_TO_MUS_ANY(e))), e, XEN_ARG_1, S_env_any, "an env generator");
- XEN_ASSERT_TYPE((XEN_PROCEDURE_P(func)) && (XEN_REQUIRED_ARGS_OK(func, 1)), func, XEN_ARG_2, S_env_any, "a function of one arg");
-
- return(C_TO_XEN_DOUBLE(mus_env_any(XEN_TO_MUS_ANY(e), connect_func)));
+ x = Xen_real_to_C_double(ux);
+ if (Xen_is_bound(ubase)) base = Xen_real_to_C_double(ubase);
+ x0 = Xen_real_to_C_double(Xen_car(e));
+
+ while (true)
+ {
+ mus_float_t x1;
+ Xen ey;
+ if (!Xen_is_pair(Xen_cdr(e)))
+ Xen_check_type(false, e, 2, S_envelope_interp, "a list of breakpoint values");
+ ey = Xen_cadr(e);
+ if ((x <= x0) ||
+ (!Xen_is_pair(Xen_cddr(e))))
+ return(ey);
+ x1 = Xen_real_to_C_double(Xen_caddr(e));
+ if (x < x1)
+ {
+ if (base == 0.0)
+ return(ey);
+ y0 = Xen_real_to_C_double(ey);
+ y1 = Xen_real_to_C_double(Xen_cadddr(e));
+ if (y0 == y1)
+ return(ey);
+ if (base == 1.0)
+ return(C_double_to_Xen_real(y0 + ((x - x0) * (y1 - y0) / (x1 - x0))));
+ return(C_double_to_Xen_real(y0 + (((y1 - y0) / (base - 1.0)) * (pow(base, (x - x0) / (x1 - x0)) - 1.0))));
+ }
+ e = Xen_cddr(e);
+ x0 = x1;
+ }
+ return(Xen_false);
+}
+
+/* -------------------------------- pulsed-env -------------------------------- */
+
+static Xen g_make_pulsed_env(Xen e, Xen dur, Xen frq)
+{
+ #define H_make_pulsed_env "(" S_make_pulsed_env " envelope duration frequency) returns a pulsed-env generator."
+ Xen gp, ge;
+ mus_any *pl;
+
+ gp = g_make_pulse_train(frq, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined);
+ ge = g_make_env(Xen_list_3(e, C_double_to_Xen_real(1.0), dur));
+
+ pl = mus_make_pulsed_env(Xen_to_mus_any(ge), Xen_to_mus_any(gp));
+ return(mus_xen_to_object(mus_any_to_mus_xen_with_two_vcts(pl, ge, gp)));
+}
+
+static Xen g_is_pulsed_env(Xen os)
+{
+ #define H_is_pulsed_env "(" S_is_pulsed_env " gen) returns " PROC_TRUE " if gen is a pulsed-env generator."
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) && (mus_is_pulsed_env(Xen_to_mus_any(os)))));
+}
+
+static Xen g_pulsed_env(Xen g, Xen fm)
+{
+ #define H_pulsed_env "(" S_pulsed_env " gen fm) runs a pulsed-env generator."
+ mus_any *pl = NULL;
+
+ Xen_check_type((mus_is_xen(g)) && (mus_is_pulsed_env(pl = Xen_to_mus_any(g))), g, 1, S_pulsed_env, "a pulsed-env object");
+
+ if (Xen_is_number(fm))
+ return(C_double_to_Xen_real(mus_pulsed_env(pl, Xen_real_to_C_double(fm))));
+ return(C_double_to_Xen_real(mus_pulsed_env_unmodulated(pl)));
}
-#endif
@@ -5447,373 +6603,555 @@ static XEN g_env_any(XEN e, XEN func)
#define S_reverb "reverb"
#endif
-static XEN clm_output, clm_reverb; /* *output* and *reverb* at extlang level -- these can be output streams, vct, sound-data objects etc */
+static Xen clm_output, clm_reverb; /* *output* and *reverb* at extlang level -- these can be output streams, vct, sound-data objects etc */
-#if (HAVE_SCHEME && (!HAVE_PTHREADS))
-XEN mus_clm_output(void) {return(XEN_VARIABLE_REF(clm_output));}
-XEN mus_clm_reverb(void) {return(XEN_VARIABLE_REF(clm_reverb));}
-#endif
+#if (HAVE_SCHEME)
+static Xen clm_output_slot = NULL, clm_reverb_slot = NULL;
-#if (!HAVE_SCHEME)
-XEN mus_clm_output(void) {return(XEN_VARIABLE_REF(S_output));}
-XEN mus_clm_reverb(void) {return(XEN_VARIABLE_REF(S_reverb));}
-#endif
+#define CLM_OUTPUT s7_slot_value(clm_output_slot)
+#define CLM_REVERB s7_slot_value(clm_reverb_slot)
-#if HAVE_SCHEME && HAVE_PTHREADS
-XEN mus_clm_output(void)
-{
- XEN obj;
- obj = XEN_VARIABLE_REF(clm_output);
- if (s7_is_thread_variable(obj))
- return(s7_thread_variable(s7, obj));
- return(obj);
-}
+#else
+
+#define CLM_OUTPUT Xen_variable_ref(S_output)
+#define CLM_REVERB Xen_variable_ref(S_reverb)
-XEN mus_clm_reverb(void)
-{
- XEN obj;
- obj = XEN_VARIABLE_REF(clm_reverb);
- if (s7_is_thread_variable(obj))
- return(s7_thread_variable(s7, obj));
- return(obj);
-}
#endif
-static XEN g_input_p(XEN obj)
+static Xen g_is_mus_input(Xen obj)
{
- #define H_mus_input_p "(" S_mus_input_p " gen): " PROC_TRUE " if gen is an input generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_input_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_mus_input "(" S_is_mus_input " gen): " PROC_TRUE " if gen is an input generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_input(Xen_to_mus_any(obj)))));
}
-static XEN g_output_p(XEN obj)
+static Xen g_is_mus_output(Xen obj)
{
- #define H_mus_output_p "(" S_mus_output_p " gen): " PROC_TRUE " if gen is an output generator"
-
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(obj))
- obj = s7_thread_variable(s7, obj);
-#endif
+ #define H_is_mus_output "(" S_is_mus_output " gen): " PROC_TRUE " if gen is an output generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_output_p(XEN_TO_MUS_ANY(obj)))));
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_output(Xen_to_mus_any(obj)))));
}
-static XEN g_file_to_sample_p(XEN obj)
+static Xen g_is_file_to_sample(Xen obj)
{
- #define H_file_to_sample_p "(" S_file_to_sample_p " gen): " PROC_TRUE " if gen is a " S_file_to_sample " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_file_to_sample_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_file_to_sample "(" S_is_file_to_sample " gen): " PROC_TRUE " if gen is a " S_file_to_sample " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_file_to_sample(Xen_to_mus_any(obj)))));
}
+static Xen mus_clm_output(void) {return(CLM_OUTPUT);}
+static Xen mus_clm_reverb(void) {return(CLM_REVERB);}
-static XEN g_file_to_frame_p(XEN obj)
+static Xen g_is_file_to_frample(Xen obj)
{
- #define H_file_to_frame_p "(" S_file_to_frame_p " gen): " PROC_TRUE " if gen is a " S_file_to_frame " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_file_to_frame_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_file_to_frample "(" S_is_file_to_frample " gen): " PROC_TRUE " if gen is a " S_file_to_frample " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_file_to_frample(Xen_to_mus_any(obj)))));
}
-static XEN g_sample_to_file_p(XEN obj)
+static Xen g_is_sample_to_file(Xen obj)
{
- #define H_sample_to_file_p "(" S_sample_to_file_p " gen): " PROC_TRUE " if gen is a " S_sample_to_file " generator"
-
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(obj))
- obj = s7_thread_variable(s7, obj);
-#endif
+ #define H_is_sample_to_file "(" S_is_sample_to_file " gen): " PROC_TRUE " if gen is a " S_sample_to_file " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_sample_to_file_p(XEN_TO_MUS_ANY(obj)))));
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_sample_to_file(Xen_to_mus_any(obj)))));
}
-static XEN g_frame_to_file_p(XEN obj)
+static Xen g_is_frample_to_file(Xen obj)
{
- #define H_frame_to_file_p "(" S_frame_to_file_p " gen): " PROC_TRUE " if gen is a " S_frame_to_file " generator"
-
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(obj))
- obj = s7_thread_variable(s7, obj);
-#endif
+ #define H_is_frample_to_file "(" S_is_frample_to_file " gen): " PROC_TRUE " if gen is a " S_frample_to_file " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_frame_to_file_p(XEN_TO_MUS_ANY(obj)))));
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_frample_to_file(Xen_to_mus_any(obj)))));
}
-static XEN g_in_any_1(const char *caller, XEN frame, int in_chan, XEN inp)
+#if HAVE_SCHEME
+static mus_float_t (*in_any_2)(mus_long_t pos, int chn);
+#endif
+
+static Xen g_in_any_1(const char *caller, Xen frample, int in_chan, Xen inp)
{
mus_long_t pos;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(frame), frame, XEN_ARG_1, caller, "a number");
+ Xen_check_type(Xen_is_integer(frample), frample, 1, caller, "an integer");
- pos = XEN_TO_C_INT64_T(frame);
+ pos = Xen_llong_to_C_llong(frample);
if (pos < 0)
- XEN_OUT_OF_RANGE_ERROR(caller, XEN_ARG_1, frame, "must be >= 0");
+ Xen_out_of_range_error(caller, 1, frample, "location should be >= 0");
if (in_chan < 0)
- XEN_OUT_OF_RANGE_ERROR(caller, XEN_ARG_2, C_TO_XEN_INT(in_chan), "must be >= 0");
+ Xen_out_of_range_error(caller, 2, C_int_to_Xen_integer(in_chan), "must be >= 0");
+
+#if HAVE_SCHEME
+ if (Xen_is_false(inp)) return(C_double_to_Xen_real(0.0)); /* ws.scm default for *clm-reverb* is #f */
+ if (inp == CLM_REVERB)
+ return(s7_make_real(s7, in_any_2(pos, in_chan)));
+#endif
- if (MUS_XEN_P(inp))
+ if (mus_is_xen(inp))
{
- XEN_ASSERT_TYPE(mus_input_p(XEN_TO_MUS_ANY(inp)), inp, XEN_ARG_3, caller, "an input generator");
- return(C_TO_XEN_DOUBLE(mus_in_any(pos, in_chan, (mus_any *)XEN_TO_MUS_ANY(inp))));
+ Xen_check_type(mus_is_input(Xen_to_mus_any(inp)), inp, 3, caller, "an input generator");
+ return(C_double_to_Xen_real(mus_in_any(pos, in_chan, (mus_any *)Xen_to_mus_any(inp))));
}
- if (MUS_VCT_P(inp))
+ if (mus_is_vct(inp))
{
+#if HAVE_SCHEME
+ if (pos < s7_vector_length(inp))
+ {
+ if (s7_vector_rank(inp) > 1)
+ return(s7_vector_ref_n(s7, inp, 2, in_chan, pos));
+ return(s7_vector_ref(s7, inp, pos));
+ }
+ return(C_double_to_Xen_real(0.0));
+#else
vct *v;
- v = XEN_TO_VCT(inp);
- if (pos < v->length)
- return(C_TO_XEN_DOUBLE(v->data[pos]));
- return(C_TO_XEN_DOUBLE(0.0));
+ mus_float_t *vdata;
+ v = Xen_to_vct(inp);
+ vdata = mus_vct_data(v);
+ if (pos < mus_vct_length(v))
+ return(C_double_to_Xen_real(vdata[pos]));
+ return(C_double_to_Xen_real(0.0));
+#endif
}
- if (sound_data_p(inp))
+ if (Xen_is_vector(inp))
{
- sound_data *sd;
- sd = XEN_TO_SOUND_DATA(inp);
- if ((in_chan < sd->chans) &&
- (pos < sd->length))
- return(C_TO_XEN_DOUBLE(sd->data[in_chan][pos]));
- return(C_TO_XEN_DOUBLE(0.0)); /* say *reverb* is inp and we're adding decay time, so run off the end... */
- /* in any case, sound-data obj looks like a procedure, and we don't want to hit that in the next block. */
+ if (pos < Xen_vector_length(inp))
+ return(Xen_vector_ref(inp, pos));
}
- if (XEN_PROCEDURE_P(inp))
- {
- if (local_arity_ok(inp, 2))
- return(XEN_CALL_2(inp, frame, C_TO_XEN_INT(in_chan), caller)); /* follow arg order of in-any */
- XEN_ASSERT_TYPE(false, inp, XEN_ARG_3, caller, "a procedure of 2 arguments: the sample number and the channel");
- }
+ return(C_double_to_Xen_real(0.0));
+}
- if (XEN_VECTOR_P(inp))
- {
- if (pos < XEN_VECTOR_LENGTH(inp))
- return(XEN_VECTOR_REF(inp, pos));
- }
- return(C_TO_XEN_DOUBLE(0.0));
+static Xen g_in_any(Xen frample, Xen chan, Xen inp)
+{
+ #define H_in_any "(" S_in_any " frample chan stream): input stream sample at frample in channel chan"
+ Xen_check_type(Xen_is_integer(chan), chan, 2, S_in_any, "an integer");
+ return(g_in_any_1(S_in_any, frample, Xen_integer_to_C_int(chan), inp));
}
-static XEN g_in_any(XEN frame, XEN chan, XEN inp)
+static Xen g_ina(Xen frample, Xen inp)
{
- #define H_in_any "(" S_in_any " frame chan stream): input stream sample at frame in channel chan"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_2, S_in_any, "an integer");
- return(g_in_any_1(S_in_any, frame, XEN_TO_C_INT(chan), inp));
+ #define H_ina "(" S_ina " frample stream): input stream sample in channel 0 at frample"
+ return(g_in_any_1(S_ina, frample, 0, inp));
}
-static XEN g_ina(XEN frame, XEN inp)
+static Xen g_inb(Xen frample, Xen inp)
{
- #define H_ina "(" S_ina " frame stream): input stream sample in channel 0 at frame"
- return(g_in_any_1(S_ina, frame, 0, inp));
+ #define H_inb "(" S_inb " frample stream): input stream sample in channel 1 at frample"
+ return(g_in_any_1(S_inb, frample, 1, inp));
}
-static XEN g_inb(XEN frame, XEN inp)
+#if (!HAVE_SCHEME)
+static Xen out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn, const char *caller)
+#else
+static Xen fallback_out_any_2(Xen outp, mus_long_t pos, mus_float_t inv, int chn, const char *caller)
+#endif
{
- #define H_inb "(" S_inb " frame stream): input stream sample in channel 1 at frame"
- return(g_in_any_1(S_inb, frame, 1, inp));
+ mus_xen *gn;
+
+ gn = (mus_xen *)Xen_object_ref_checked(outp, mus_xen_tag);
+ if (gn)
+ {
+ /* mus_out_any will check the writer so output_p is pointless */
+ mus_out_any(pos, inv, chn, mus_xen_to_mus_any(gn));
+ return(Xen_integer_zero);
+ }
+
+ if (mus_is_vct(outp))
+ {
+ mus_float_t *vdata;
+ vct *v;
+ v = xen_to_vct(outp);
+ vdata = mus_vct_data(v);
+ if (Xen_vector_rank(outp) == 1)
+ {
+ if (chn == 0)
+ {
+ if (pos < mus_vct_length(v))
+ vdata[pos] += inv;
+ }
+ }
+#if HAVE_SCHEME
+ else
+ {
+ s7_int *offsets;
+ offsets = s7_vector_offsets(outp);
+ pos += (chn * offsets[0]);
+ if (pos < mus_vct_length(v))
+ vdata[pos] += inv;
+ }
+#endif
+ return(Xen_integer_zero);
+ }
+
+ if (Xen_is_vector(outp))
+ {
+ if (pos < Xen_vector_length(outp))
+ Xen_vector_set(outp, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(outp, pos)) + inv));
+ }
+
+ return(Xen_integer_zero);
}
+#if HAVE_SCHEME
-static XEN g_out_any_1(const char *caller, XEN frame, int chn, XEN val, XEN outp)
-{
- mus_long_t pos;
- mus_float_t inv;
+static Xen (*out_any_2)(mus_long_t pos, mus_float_t inv, int chn, const char *caller);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(frame), frame, XEN_ARG_1, caller, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, caller, "a number");
+bool mus_simple_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO);
+bool mus_simple_outa_to_file(mus_long_t samp, mus_float_t val, mus_any *IO);
- if (chn < 0)
- XEN_OUT_OF_RANGE_ERROR(caller, XEN_ARG_3, C_TO_XEN_INT(chn), "must be >= 0");
+static mus_xen *clm_output_gn = NULL;
+static mus_any *clm_output_gen = NULL;
+static vct *clm_output_vct;
- pos = XEN_TO_C_INT64_T_OR_ELSE(frame, 0);
- if (pos < 0)
- XEN_OUT_OF_RANGE_ERROR(caller, XEN_ARG_1, frame, "must be >= 0");
+static Xen out_any_2_to_mus_xen(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
+{
+ mus_out_any(pos, inv, chn, clm_output_gen);
+ return(xen_zero);
+}
-#if HAVE_XEN_NAN_AND_INF_P
- if (XEN_INF_P(val))
- XEN_OUT_OF_RANGE_ERROR(caller, XEN_ARG_2, val, "is infinite"); /* arg 2 from caller's point of view */
- if (XEN_NAN_P(val))
- XEN_OUT_OF_RANGE_ERROR(caller, XEN_ARG_2, val, "is not a number");
-#endif
+static Xen safe_out_any_2_to_mus_xen(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
+{
+ if (!mus_simple_out_any_to_file(pos, inv, chn, clm_output_gen))
+ mus_safe_out_any_to_file(pos, inv, chn, clm_output_gen);
+ return(xen_zero);
+}
- inv = XEN_TO_C_DOUBLE(val);
- if (XEN_NOT_BOUND_P(outp))
- outp = mus_clm_output();
-
-#if HAVE_SCHEME && HAVE_PTHREADS
+static Xen out_any_2_to_vct(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
+{
+ mus_float_t *vdata;
+ vdata = mus_vct_data(clm_output_vct);
+
+#if (!HAVE_SCHEME)
+ if ((chn == 0) &&
+ (pos < mus_vct_length(clm_output_vct)))
+ vdata[pos] += inv;
+#else
+ if (Xen_vector_rank(clm_output_vct) == 1)
+ {
+ if ((chn == 0) &&
+ (pos < mus_vct_length(clm_output_vct)))
+ vdata[pos] += inv;
+ }
else
{
- if (s7_is_thread_variable(outp))
- outp = s7_thread_variable(s7, outp);
+ s7_int chans;
+ chans = s7_vector_dimensions(clm_output_vct)[0];
+ if (chn < chans)
+ {
+ s7_int chan_len;
+ chan_len = s7_vector_dimensions(clm_output_vct)[1];
+ if (pos < chan_len)
+ vdata[chn * chan_len + pos] += inv;
+ }
}
#endif
-
- if (MUS_XEN_P(outp))
+ return(xen_zero);
+}
+
+
+static Xen out_any_2_to_vector(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
+{
+ if (pos < Xen_vector_length(CLM_OUTPUT))
+ Xen_vector_set(CLM_OUTPUT, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(CLM_OUTPUT, pos)) + inv));
+ return(xen_zero);
+}
+
+static Xen out_any_2_no_op(mus_long_t pos, mus_float_t inv, int chn, const char *caller)
+{
+ return(xen_zero);
+}
+
+static s7_pointer g_clm_output_set(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer new_output;
+ new_output = s7_cadr(args);
+
+ clm_output_gn = (mus_xen *)Xen_object_ref_checked(new_output, mus_xen_tag);
+ if (clm_output_gn)
{
- XEN_ASSERT_TYPE(mus_output_p(XEN_TO_MUS_ANY(outp)), outp, XEN_ARG_4, caller, "an output generator");
- return(C_TO_XEN_DOUBLE(mus_out_any(pos, inv, chn, (mus_any *)XEN_TO_MUS_ANY(outp))));
- }
+ out_any_2 = out_any_2_to_mus_xen;
+ clm_output_gen = clm_output_gn->gen;
- /* adds to existing -- these have to precede procedure check since vcts/sound-data objects are applicable */
- if (MUS_VCT_P(outp))
+ if (mus_out_any_is_safe(clm_output_gen))
+ out_any_2 = safe_out_any_2_to_mus_xen;
+ }
+ else
{
- if (chn == 0)
+ clm_output_gen = NULL;
+ if (mus_is_vct(new_output))
{
- vct *v;
- v = xen_to_vct(outp);
- if (pos < v->length)
- v->data[pos] += inv;
+ out_any_2 = out_any_2_to_vct;
+ clm_output_vct = xen_to_vct(new_output);
+ }
+ else
+ {
+ if (Xen_is_vector(new_output))
+ {
+ out_any_2 = out_any_2_to_vector;
+ }
+ else out_any_2 = out_any_2_no_op;
}
- return(val);
}
+ return(new_output);
+}
+
+
+/* need in_any_2(pos, 0, caller) -> double + safe case + none-file cases
+ */
+
+static mus_xen *clm_input_gn;
+static mus_any *clm_input_gen;
+static vct *clm_input_vct;
+
+static mus_float_t in_any_2_to_mus_xen(mus_long_t pos, int chn)
+{
+ return(mus_in_any(pos, chn, clm_input_gen));
+}
+
+static mus_float_t safe_in_any_2_to_mus_xen(mus_long_t pos, int chn)
+{
+ return(mus_file_to_sample(clm_input_gen, pos, chn));
+}
+
+static mus_float_t in_any_2_to_vct(mus_long_t pos, int chn)
+{
+ mus_float_t *vdata;
+ vdata = mus_vct_data(clm_input_vct);
+ if ((chn == 0) &&
+ (pos < mus_vct_length(clm_input_vct)))
+ return(vdata[pos]);
+ return(0.0);
+}
- if (sound_data_p(outp))
+static mus_float_t in_any_2_to_vector(mus_long_t pos, int chn)
+{
+ if (pos < Xen_vector_length(CLM_REVERB))
+ return(Xen_real_to_C_double(Xen_vector_ref(CLM_REVERB, pos)));
+ return(0.0);
+}
+
+static mus_float_t in_any_2_no_op(mus_long_t pos, int chn)
+{
+ return(0.0);
+}
+
+static s7_pointer g_clm_reverb_set(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer new_input;
+ new_input = s7_cadr(args);
+
+ clm_input_gn = (mus_xen *)Xen_object_ref_checked(new_input, mus_xen_tag);
+ if (clm_input_gn)
{
- sound_data *sd;
- sd = XEN_TO_SOUND_DATA(outp);
- if ((chn < sd->chans) &&
- (pos < sd->length))
- sd->data[chn][pos] += inv;
- return(val);
- }
+ in_any_2 = in_any_2_to_mus_xen;
+ clm_input_gen = clm_input_gn->gen;
- if (XEN_PROCEDURE_P(outp))
+ if (mus_in_any_is_safe(clm_input_gen))
+ in_any_2 = safe_in_any_2_to_mus_xen;
+ }
+ else
{
- if (local_arity_ok(outp, 3))
- return(XEN_CALL_3(outp, frame, val, C_TO_XEN_INT(chn), caller)); /* follow arg order of out-any */
- XEN_ASSERT_TYPE(false, outp, XEN_ARG_4, caller, "a procedure of 3 arguments: the sample number, the sample value, and the channel");
+ if (mus_is_vct(new_input))
+ {
+ in_any_2 = in_any_2_to_vct;
+ clm_input_vct = xen_to_vct(new_input);
+ }
+ else
+ {
+ if (Xen_is_vector(new_input))
+ {
+ in_any_2 = in_any_2_to_vector;
+ }
+ else in_any_2 = in_any_2_no_op;
+ }
}
+ return(new_input);
+}
+
+
+#endif
+
+
+#define S_out_bank "out-bank"
+static Xen g_out_bank(Xen gens, Xen loc, Xen inval)
+{
+ #define H_out_bank "(out-bank gens location val) calls each generator in the gens vector, passing it the argument val, then \
+sends that output to the output channels in the vector order (the first generator writes to outa, the second to outb, etc)."
+
+ mus_long_t pos;
+ int i, size;
+ mus_float_t x = 0.0;
+
+ Xen_check_type(Xen_is_integer(loc), loc, 2, S_out_bank, "an integer");
+ pos = Xen_llong_to_C_llong(loc);
+ if (pos < 0)
+ Xen_out_of_range_error(S_out_bank, 2, loc, "must be >= 0");
+
+ Xen_check_type(Xen_is_vector(gens), gens, 1, S_out_bank, "a vector of generators");
+ size = Xen_vector_length(gens);
- if (XEN_VECTOR_P(outp))
+ Xen_check_type(Xen_is_number(inval), inval, 3, S_out_bank, "a number");
+ x = Xen_real_to_C_double(inval);
+
+#if HAVE_SCHEME
+ for (i = 0; i < size; i++)
{
- if (pos < XEN_VECTOR_LENGTH(outp))
- XEN_VECTOR_SET(outp, pos, C_TO_XEN_DOUBLE(XEN_TO_C_DOUBLE(XEN_VECTOR_REF(outp, pos)) + inv));
- /* this doesn't handle multiple channels yet, and can't be used with the run macro.
- * if I had written s7 30 years ago, this would do the right thing...
- */
+ mus_any *g = NULL;
+ mus_xen *gn;
+ Xen_to_C_any_generator(Xen_vector_ref(gens, i), gn, g, S_out_bank, "an output generator");
+ out_any_2(pos, mus_apply(g, x, 0.0), i, S_out_bank);
+ }
+#else
+ for (i = 0; i < size; i++)
+ {
+ mus_any *g = NULL;
+ mus_xen *gn;
+ Xen_to_C_any_generator(Xen_vector_ref(gens, i), gn, g, S_out_bank, "an output generator");
+ out_any_2(CLM_OUTPUT, pos, mus_apply(g, x, 0.0), i, S_out_bank);
}
+#endif
- return(val);
+ return(inval);
+}
+
+
+static Xen g_out_any_1(const char *caller, Xen frample, int chn, Xen val, Xen outp)
+{
+ mus_long_t pos = 0;
+ mus_float_t inv;
+
+ if (chn < 0)
+ Xen_out_of_range_error(caller, 3, C_int_to_Xen_integer(chn), "must be >= 0");
+ Xen_to_C_integer_or_error(frample, pos, caller, 1);
+ if (pos < 0)
+ Xen_out_of_range_error(caller, 1, frample, "must be >= 0");
+
+ Xen_to_C_double_or_error(val, inv, caller, 2);
+
+ if (!Xen_is_bound(outp))
+#if (!HAVE_SCHEME)
+ return(out_any_2(CLM_OUTPUT, pos, inv, chn, caller));
+#else
+ return(out_any_2(pos, inv, chn, caller));
+#endif
+
+#if (!HAVE_SCHEME)
+ return(out_any_2(outp, pos, inv, chn, caller));
+#else
+ if (outp == CLM_OUTPUT)
+ return(out_any_2(pos, inv, chn, caller));
+ return(fallback_out_any_2(outp, pos, inv, chn, caller));
+#endif
}
-static XEN g_out_any(XEN frame, XEN val, XEN chan, XEN outp)
+static Xen g_out_any(Xen frample, Xen val, Xen chan, Xen outp)
{
- #define H_out_any "(" S_out_any " frame val chan stream): add val to output stream at frame in channel chan"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_3, S_out_any, "an integer");
- return(g_out_any_1(S_out_any, frame, XEN_TO_C_INT(chan), val, outp));
+ #define H_out_any "(" S_out_any " frample val chan stream): add val to output stream at frample in channel chan"
+ Xen_check_type(Xen_is_integer(chan), chan, 3, S_out_any, "an integer");
+ return(g_out_any_1(S_out_any, frample, Xen_integer_to_C_int(chan), val, outp));
}
-static XEN g_outa(XEN frame, XEN val, XEN outp)
+static Xen g_outa(Xen frample, Xen val, Xen outp)
{
- #define H_outa "(" S_outa " frame val stream): add val to output stream at frame in channel 0"
- return(g_out_any_1(S_outa, frame, 0, val, outp));
+ #define H_outa "(" S_outa " frample val stream): add val to output stream at frample in channel 0"
+ return(g_out_any_1(S_outa, frample, 0, val, outp));
}
-static XEN g_outb(XEN frame, XEN val, XEN outp)
+static Xen g_outb(Xen frample, Xen val, Xen outp)
{
- #define H_outb "(" S_outb " frame val stream): add val to output stream at frame in channel 1"
- return(g_out_any_1(S_outb, frame, 1, val, outp));
+ #define H_outb "(" S_outb " frample val stream): add val to output stream at frample in channel 1"
+ return(g_out_any_1(S_outb, frample, 1, val, outp));
}
-static XEN g_outc(XEN frame, XEN val, XEN outp)
+static Xen g_outc(Xen frample, Xen val, Xen outp)
{
- #define H_outc "(" S_outc " frame val stream): add val to output stream at frame in channel 2"
- return(g_out_any_1(S_outc, frame, 2, val, outp));
+ #define H_outc "(" S_outc " frample val stream): add val to output stream at frample in channel 2"
+ return(g_out_any_1(S_outc, frample, 2, val, outp));
}
-static XEN g_outd(XEN frame, XEN val, XEN outp)
+static Xen g_outd(Xen frample, Xen val, Xen outp)
{
- #define H_outd "(" S_outd " frame val stream): add val to output stream at frame in channel 3"
- return(g_out_any_1(S_outd, frame, 3, val, outp));
+ #define H_outd "(" S_outd " frample val stream): add val to output stream at frample in channel 3"
+ return(g_out_any_1(S_outd, frample, 3, val, outp));
}
-static XEN g_mus_close(XEN ptr)
+static Xen g_mus_close(Xen ptr)
{
#define H_mus_close "(" S_mus_close " gen): close the IO stream managed by 'gen' (a sample->file generator, for example)"
- if (MUS_XEN_P(ptr))
- return(C_TO_XEN_INT(mus_close_file((mus_any *)XEN_TO_MUS_ANY(ptr))));
-
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(ptr))
- {
- if (MUS_XEN_P(s7_thread_variable(s7, ptr)))
- return(C_TO_XEN_INT(mus_close_file((mus_any *)XEN_TO_MUS_ANY(s7_thread_variable(s7, ptr)))));
- return(XEN_ZERO);
- }
-#endif
+ if (mus_is_xen(ptr))
+ return(C_int_to_Xen_integer(mus_close_file((mus_any *)Xen_to_mus_any(ptr))));
- XEN_ASSERT_TYPE(MUS_VCT_P(ptr) || XEN_FALSE_P(ptr) || sound_data_p(ptr) || XEN_PROCEDURE_P(ptr) || XEN_VECTOR_P(ptr),
- ptr, XEN_ONLY_ARG, S_mus_close, "an IO gen or its outa equivalent");
- return(XEN_ZERO);
+ Xen_check_type(mus_is_vct(ptr) || Xen_is_false(ptr) || Xen_is_vector(ptr),
+ ptr, 1, S_mus_close, "an IO gen or its outa equivalent");
+ return(Xen_integer_zero);
}
-static XEN g_make_file_to_sample(XEN name, XEN buffer_size)
+static Xen g_make_file_to_sample(Xen name, Xen buffer_size)
{
- #define H_make_file_to_sample "(" S_make_file_to_sample " filename :optional buffer-size): return an input generator reading 'filename' (a sound file)"
+ #define H_make_file_to_sample "(" S_make_file_to_sample " filename buffer-size): return an input generator reading 'filename' (a sound file)"
mus_any *ge;
mus_long_t size;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, S_make_file_to_sample, "a string");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(buffer_size), buffer_size, XEN_ARG_2, S_make_file_to_sample, "an integer");
+ Xen_check_type(Xen_is_string(name), name, 1, S_make_file_to_sample, "a string");
+ Xen_check_type(Xen_is_llong_or_unbound(buffer_size), buffer_size, 2, S_make_file_to_sample, "an integer");
- if (!(mus_file_probe(XEN_TO_C_STRING(name))))
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_3(C_TO_XEN_STRING(S_make_file_to_sample ": ~S, ~A"),
+ if (!(mus_file_probe(Xen_string_to_C_string(name))))
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_3(C_string_to_Xen_string(S_make_file_to_sample ": ~S, ~A"),
name,
- C_TO_XEN_STRING(STRERROR(errno))));
+ C_string_to_Xen_string(STRERROR(errno))));
- if (XEN_INT64_T_P(buffer_size))
+ if (Xen_is_llong(buffer_size))
{
- size = XEN_TO_C_INT64_T(buffer_size);
+ size = Xen_llong_to_C_llong(buffer_size);
if (size <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_file_to_sample, XEN_ARG_2, buffer_size, "must be > 0");
+ Xen_out_of_range_error(S_make_file_to_sample, 2, buffer_size, "must be > 0");
}
else size = mus_file_buffer_size();
- ge = mus_make_file_to_sample_with_buffer_size(XEN_TO_C_STRING(name), size);
+ ge = mus_make_file_to_sample_with_buffer_size(Xen_string_to_C_string(name), size);
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_file_to_sample(XEN obj, XEN samp, XEN chan)
+static Xen g_file_to_sample(Xen obj, Xen samp, Xen chan)
{
- #define H_file_to_sample "(" S_file_to_sample " obj frame chan): sample value in sound file read by 'obj' in channel chan at frame"
+ #define H_file_to_sample "(" S_file_to_sample " obj frample chan): sample value in sound file read by 'obj' in channel chan at frample"
int channel = 0;
+ mus_any *g = NULL;
+ mus_xen *gn;
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(obj))
- obj = s7_thread_variable(s7, obj);
-#endif
-
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_input_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_file_to_sample, "an input generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp), samp, XEN_ARG_2, S_file_to_sample, "a number");
+ Xen_to_C_generator(obj, gn, g, mus_is_input, S_file_to_sample, "an input generator");
+ Xen_check_type(Xen_is_llong(samp), samp, 2, S_file_to_sample, "an integer");
- if (XEN_BOUND_P(chan))
+ if (Xen_is_bound(chan))
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_3, S_file_to_sample, "an integer");
- channel = XEN_TO_C_INT(chan);
+ Xen_check_type(Xen_is_integer(chan), chan, 3, S_file_to_sample, "an integer");
+ channel = Xen_integer_to_C_int(chan);
}
- return(C_TO_XEN_DOUBLE(mus_file_to_sample(XEN_TO_MUS_ANY(obj),
- XEN_TO_C_INT64_T_OR_ELSE(samp, 0),
- channel)));
+ return(C_double_to_Xen_real(mus_file_to_sample(g, Xen_llong_to_C_llong(samp), channel)));
}
-static XEN g_make_sample_to_file(XEN name, XEN chans, XEN out_format, XEN out_type, XEN comment)
+static Xen g_make_sample_to_file(Xen name, Xen chans, Xen out_format, Xen out_type, Xen comment)
{
#if HAVE_SCHEME
#define make_sample_to_file_example "(" S_make_sample_to_file " \"test.snd\" 2 mus-lshort mus-riff)"
@@ -5825,261 +7163,235 @@ static XEN g_make_sample_to_file(XEN name, XEN chans, XEN out_format, XEN out_ty
#define make_sample_to_file_example "\"test.snd\" 2 mus-lshort mus-riff make-sample->file"
#endif
- #define H_make_sample_to_file "(" S_make_sample_to_file " filename :optional chans data-format header-type comment): \
+ #define H_make_sample_to_file "(" S_make_sample_to_file " filename chans sample-type header-type comment): \
return an output generator writing the sound file 'filename' which is set up to have \
-'chans' channels of 'data-format' samples with a header of 'header-type'. The latter \
+'chans' channels of 'sample-type' samples with a header of 'header-type'. The latter \
should be sndlib identifiers:\n " make_sample_to_file_example
- int df;
+ mus_sample_t df = MUS_OUT_SAMPLE_TYPE;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, S_make_sample_to_file, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chans), chans, XEN_ARG_2, S_make_sample_to_file, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(out_format), out_format, XEN_ARG_3, S_make_sample_to_file, "an integer (data format id)");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(out_type), out_type, XEN_ARG_4, S_make_sample_to_file, "an integer (header type id)");
+ Xen_check_type(Xen_is_string(name), name, 1, S_make_sample_to_file, "a string");
+ Xen_check_type(Xen_is_integer_or_unbound(chans), chans, 2, S_make_sample_to_file, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(out_format), out_format, 3, S_make_sample_to_file, "an integer (sample type)");
+ Xen_check_type(Xen_is_integer_or_unbound(out_type), out_type, 4, S_make_sample_to_file, "an integer (header type)");
- df = XEN_TO_C_INT_OR_ELSE(out_format, (int)MUS_OUT_FORMAT);
- if (mus_data_format_p(df))
+ if (Xen_is_integer(out_format)) df = (mus_sample_t)Xen_integer_to_C_int(out_format);
+ if (mus_is_sample_type(df))
{
- int ht;
- ht = XEN_TO_C_INT_OR_ELSE(out_type, (int)MUS_NEXT);
- if (mus_header_type_p(ht))
+ mus_header_t ht = MUS_NEXT;
+ if (Xen_is_integer(out_type)) ht = (mus_header_t)Xen_integer_to_C_int(out_type);
+ if (mus_is_header_type(ht))
{
- int chns;
- chns = XEN_TO_C_INT_OR_ELSE(chans, 1);
+ int chns = 1;
+ if (Xen_is_integer(chans)) chns = Xen_integer_to_C_int(chans);
if (chns > 0)
{
mus_any *rgen;
- rgen = mus_make_sample_to_file_with_comment(XEN_TO_C_STRING(name),
+ rgen = mus_make_sample_to_file_with_comment(Xen_string_to_C_string(name),
chns, df, ht,
- (XEN_STRING_P(comment)) ? XEN_TO_C_STRING(comment) : NULL);
+ (Xen_is_string(comment)) ? Xen_string_to_C_string(comment) : NULL);
if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
}
- else XEN_OUT_OF_RANGE_ERROR(S_make_sample_to_file, 2, chans, "chans ~A <= 0?");
+ else Xen_out_of_range_error(S_make_sample_to_file, 2, chans, "chans <= 0?");
}
- else XEN_OUT_OF_RANGE_ERROR(S_make_sample_to_file, 4, out_type, "~A: invalid header type");
+ else Xen_out_of_range_error(S_make_sample_to_file, 4, out_type, "invalid header type");
}
- else XEN_OUT_OF_RANGE_ERROR(S_make_sample_to_file, 3, out_format, "~A: invalid data format");
- return(XEN_FALSE);
+ else Xen_out_of_range_error(S_make_sample_to_file, 3, out_format, "invalid sample type");
+ return(Xen_false);
}
-static XEN g_continue_sample_to_file(XEN name)
+static Xen g_continue_sample_to_file(Xen name)
{
#define H_continue_sample_to_file "(" S_continue_sample_to_file " filename): return an output generator \
that reopens an existing sound file 'filename' ready for output via " S_sample_to_file
mus_any *rgen = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, S_continue_sample_to_file, "a string");
- rgen = mus_continue_sample_to_file(XEN_TO_C_STRING(name));
+ Xen_check_type(Xen_is_string(name), name, 1, S_continue_sample_to_file, "a string");
+ rgen = mus_continue_sample_to_file(Xen_string_to_C_string(name));
if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_sample_to_file(XEN obj, XEN samp, XEN chan, XEN val)
+static Xen g_sample_to_file(Xen obj, Xen samp, Xen chan, Xen val)
{
#define H_sample_to_file "(" S_sample_to_file " obj samp chan val): add val to the output stream \
-handled by the output generator 'obj', in channel 'chan' at frame 'samp'"
+handled by the output generator 'obj', in channel 'chan' at frample 'samp'"
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(obj))
- obj = s7_thread_variable(s7, obj);
-#endif
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_any_generator(obj, gn, g, S_sample_to_file, "an output generator");
+ Xen_check_type(mus_is_output(g), obj, 1, S_sample_to_file, "an output generator");
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_output_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_sample_to_file, "an output generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp), samp, XEN_ARG_2, S_sample_to_file, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_3, S_sample_to_file, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_4, S_sample_to_file, "a number");
+ Xen_check_type(Xen_is_integer(samp), samp, 2, S_sample_to_file, "an integer");
+ Xen_check_type(Xen_is_integer(chan), chan, 3, S_sample_to_file, "an integer");
+ Xen_check_type(Xen_is_number(val), val, 4, S_sample_to_file, "a number");
- return(C_TO_XEN_DOUBLE(mus_sample_to_file(XEN_TO_MUS_ANY(obj),
- XEN_TO_C_INT64_T_OR_ELSE(samp, 0),
- XEN_TO_C_INT(chan),
- XEN_TO_C_DOUBLE(val))));
+ mus_sample_to_file(g,
+ Xen_llong_to_C_llong(samp),
+ Xen_integer_to_C_int(chan),
+ Xen_real_to_C_double(val));
+ return(val);
}
-static XEN g_sample_to_file_add(XEN obj1, XEN obj2)
+static Xen g_sample_to_file_add(Xen obj1, Xen obj2)
{
#define H_sample_to_file_add "(" S_sample_to_file_add " obj1 obj2): mixes obj2 (an output generator) into obj1 (also an output generator)"
+ mus_any *g1 = NULL, *g2 = NULL;
+ mus_xen *gn1, *gn2;
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(obj2))
- obj2 = s7_thread_variable(s7, obj2);
-#endif
-
- XEN_ASSERT_TYPE((MUS_XEN_P(obj1)) && (mus_output_p(XEN_TO_MUS_ANY(obj1))), obj1, XEN_ARG_1, S_sample_to_file_add, "an output generator");
- XEN_ASSERT_TYPE((MUS_XEN_P(obj2)) && (mus_output_p(XEN_TO_MUS_ANY(obj2))), obj2, XEN_ARG_2, S_sample_to_file_add, "an output generator");
+ Xen_to_C_any_generator(obj1, gn1, g1, S_sample_to_file_add, "an output generator");
+ Xen_to_C_any_generator(obj2, gn2, g2, S_sample_to_file_add, "an output generator");
+ Xen_check_type(mus_is_output(g1), obj1, 1, S_sample_to_file_add, "an output generator");
+ Xen_check_type(mus_is_output(g2), obj2, 2, S_sample_to_file_add, "an output generator");
- mus_sample_to_file_add(XEN_TO_MUS_ANY(obj1), XEN_TO_MUS_ANY(obj2));
+ mus_sample_to_file_add(g1, g2);
return(obj1);
}
-
-static XEN g_make_file_to_frame(XEN name, XEN buffer_size)
+static Xen g_make_file_to_frample(Xen name, Xen buffer_size)
{
- #define H_make_file_to_frame "(" S_make_file_to_frame " filename :optional buffer-size): return an input generator reading 'filename' (a sound file)"
+ #define H_make_file_to_frample "(" S_make_file_to_frample " filename buffer-size): return an input generator reading 'filename' (a sound file)"
mus_any *ge;
mus_long_t size;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, S_make_file_to_frame, "a string");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(buffer_size), buffer_size, XEN_ARG_2, S_make_file_to_frame, "an integer");
+ Xen_check_type(Xen_is_string(name), name, 1, S_make_file_to_frample, "a string");
+ Xen_check_type(Xen_is_llong_or_unbound(buffer_size), buffer_size, 2, S_make_file_to_frample, "an integer");
- if (!(mus_file_probe(XEN_TO_C_STRING(name))))
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_3(C_TO_XEN_STRING(S_make_file_to_frame ": ~S, ~A"),
+ if (!(mus_file_probe(Xen_string_to_C_string(name))))
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_3(C_string_to_Xen_string(S_make_file_to_frample ": ~S, ~A"),
name,
- C_TO_XEN_STRING(STRERROR(errno))));
+ C_string_to_Xen_string(STRERROR(errno))));
- if (XEN_INT64_T_P(buffer_size))
+ if (Xen_is_llong(buffer_size))
{
- size = XEN_TO_C_INT64_T(buffer_size);
+ size = Xen_llong_to_C_llong(buffer_size);
if (size <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_file_to_frame, XEN_ARG_2, buffer_size, "must be > 0");
+ Xen_out_of_range_error(S_make_file_to_frample, 2, buffer_size, "must be > 0");
}
else size = mus_file_buffer_size();
- ge = mus_make_file_to_frame_with_buffer_size(XEN_TO_C_STRING(name), size);
+ ge = mus_make_file_to_frample_with_buffer_size(Xen_string_to_C_string(name), size);
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_file_to_frame(XEN obj, XEN samp, XEN outfr)
+static Xen g_file_to_frample(Xen obj, Xen samp, Xen outfr)
{
- #define H_file_to_frame "(" S_file_to_frame " obj samp :optional outf): frame of samples at frame 'samp' in sound file read by 'obj'"
- mus_any *res = NULL, *nf = NULL;
-
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_input_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_file_to_frame, "an input generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp), samp, XEN_ARG_2, S_file_to_frame, "a number");
-
- if ((MUS_XEN_P(outfr)) &&
- (mus_frame_p(XEN_TO_MUS_ANY(outfr))))
- res = (mus_any *)XEN_TO_MUS_ANY(outfr);
+ #define H_file_to_frample "(" S_file_to_frample " obj samp outf): frample of samples at frample 'samp' in sound file read by 'obj'"
+
+ Xen_check_type((mus_is_xen(obj)) && (mus_is_input(Xen_to_mus_any(obj))), obj, 1, S_file_to_frample, "an input generator");
+ Xen_check_type(Xen_is_integer(samp), samp, 2, S_file_to_frample, "an integer");
- nf = mus_file_to_frame(XEN_TO_MUS_ANY(obj), XEN_TO_C_INT64_T_OR_ELSE(samp, 0), res);
- if (res)
- return(outfr);
- return(mus_xen_to_object(mus_any_to_mus_xen_with_vct(nf, xen_make_vct_wrapper(mus_length(nf), mus_data(nf)))));
+ mus_file_to_frample(Xen_to_mus_any(obj), Xen_llong_to_C_llong(samp), mus_vct_data(Xen_to_vct(outfr)));
+ return(outfr);
}
-static XEN g_make_frame_to_file(XEN name, XEN chans, XEN out_format, XEN out_type, XEN comment)
+static Xen g_make_frample_to_file(Xen name, Xen chans, Xen out_format, Xen out_type, Xen comment)
{
#if HAVE_SCHEME
- #define make_frame_to_file_example "(" S_make_frame_to_file " \"test.snd\" 2 mus-lshort mus-riff)"
+ #define make_frample_to_file_example "(" S_make_frample_to_file " \"test.snd\" 2 mus-lshort mus-riff)"
#endif
#if HAVE_RUBY
- #define make_frame_to_file_example "\"test.snd\" 2 Mus_lshort Mus_riff make_frame2file"
+ #define make_frample_to_file_example "\"test.snd\" 2 Mus_lshort Mus_riff make_frample2file"
#endif
#if HAVE_FORTH
- #define make_frame_to_file_example "\"test.snd\" 2 mus-lshort mus-riff make-frame->file"
+ #define make_frample_to_file_example "\"test.snd\" 2 mus-lshort mus-riff make-frample->file"
#endif
- #define H_make_frame_to_file "(" S_make_frame_to_file " filename :optional chans data-format header-type comment): \
+ #define H_make_frample_to_file "(" S_make_frample_to_file " filename chans sample-type header-type comment): \
return an output generator writing the sound file 'filename' which is set up to have \
-'chans' channels of 'data-format' samples with a header of 'header-type'. The latter \
-should be sndlib identifiers:\n " make_frame_to_file_example
+'chans' channels of 'sample-type' samples with a header of 'header-type'. The latter \
+should be sndlib identifiers:\n " make_frample_to_file_example
mus_any *fgen = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, S_make_frame_to_file, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chans), chans, XEN_ARG_2, S_make_frame_to_file, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(out_format), out_format, XEN_ARG_3, S_make_frame_to_file, "an integer (data format id)");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(out_type), out_type, XEN_ARG_4, S_make_frame_to_file, "an integer (header-type id)");
+ Xen_check_type(Xen_is_string(name), name, 1, S_make_frample_to_file, "a string");
+ Xen_check_type(Xen_is_integer_or_unbound(chans), chans, 2, S_make_frample_to_file, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(out_format), out_format, 3, S_make_frample_to_file, "an integer (sample type id)");
+ Xen_check_type(Xen_is_integer_or_unbound(out_type), out_type, 4, S_make_frample_to_file, "an integer (header-type id)");
- fgen = mus_make_frame_to_file_with_comment(XEN_TO_C_STRING(name),
- XEN_TO_C_INT_OR_ELSE(chans, 1),
- XEN_TO_C_INT_OR_ELSE(out_format, (int)MUS_OUT_FORMAT),
- XEN_TO_C_INT_OR_ELSE(out_type, (int)MUS_NEXT),
- (XEN_STRING_P(comment)) ? XEN_TO_C_STRING(comment) : NULL);
+ fgen = mus_make_frample_to_file_with_comment(Xen_string_to_C_string(name),
+ (Xen_is_integer(chans)) ? Xen_integer_to_C_int(chans) : 1,
+ (Xen_is_integer(out_format)) ? (mus_sample_t)Xen_integer_to_C_int(out_format) : MUS_OUT_SAMPLE_TYPE,
+ (Xen_is_integer(out_type)) ? (mus_header_t)Xen_integer_to_C_int(out_type) : MUS_NEXT,
+ (Xen_is_string(comment)) ? Xen_string_to_C_string(comment) : NULL);
if (fgen) return(mus_xen_to_object(mus_any_to_mus_xen(fgen)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_continue_frame_to_file(XEN name)
+static Xen g_continue_frample_to_file(Xen name)
{
- #define H_continue_frame_to_file "(" S_continue_frame_to_file " filename): return an output generator \
-that reopens an existing sound file 'filename' ready for output via " S_frame_to_file
+ #define H_continue_frample_to_file "(" S_continue_frample_to_file " filename): return an output generator \
+that reopens an existing sound file 'filename' ready for output via " S_frample_to_file
mus_any *rgen = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, S_continue_frame_to_file, "a string");
- rgen = mus_continue_frame_to_file(XEN_TO_C_STRING(name));
+ Xen_check_type(Xen_is_string(name), name, 1, S_continue_frample_to_file, "a string");
+ rgen = mus_continue_frample_to_file(Xen_string_to_C_string(name));
if (rgen) return(mus_xen_to_object(mus_any_to_mus_xen(rgen)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_frame_to_file(XEN obj, XEN samp, XEN val)
+static Xen g_frample_to_file(Xen obj, Xen samp, Xen val)
{
- #define H_frame_to_file "(" S_frame_to_file " obj samp val): add frame 'val' to the output stream \
-handled by the output generator 'obj' at frame 'samp'"
+ #define H_frample_to_file "(" S_frample_to_file " obj samp val): add frample 'val' to the output stream \
+handled by the output generator 'obj' at frample 'samp'"
+ mus_xen *gn;
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(obj))
- obj = s7_thread_variable(s7, obj);
-#endif
+ gn = (mus_xen *)Xen_object_ref_checked(obj, mus_xen_tag);
+ Xen_check_type(((gn) && (mus_is_output(gn->gen))), obj, 1, S_frample_to_file, "an output generator");
+ Xen_check_type(Xen_is_integer(samp), samp, 2, S_frample_to_file, "an integer");
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_output_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_frame_to_file, "an output generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp), samp, XEN_ARG_2, S_frame_to_file, "a number");
- XEN_ASSERT_TYPE((MUS_XEN_P(val)) && (mus_frame_p(XEN_TO_MUS_ANY(val))), val, XEN_ARG_3, S_frame_to_file, "a frame");
- mus_frame_to_file(XEN_TO_MUS_ANY(obj),
- XEN_TO_C_INT64_T_OR_ELSE(samp, 0),
- (mus_any *)XEN_TO_MUS_ANY(val));
+ mus_frample_to_file(gn->gen, Xen_llong_to_C_llong(samp), mus_vct_data(Xen_to_vct(val)));
return(val);
}
-static XEN g_mus_file_buffer_size(void)
-{
- #define H_mus_file_buffer_size "(" S_mus_file_buffer_size "): current CLM IO buffer size (default is 8192)"
- return(C_TO_XEN_INT64_T(mus_file_buffer_size()));
-}
-
-
-static XEN g_mus_set_file_buffer_size(XEN val)
-{
- mus_long_t len;
- XEN_ASSERT_TYPE(XEN_INT64_T_P(val), val, XEN_ONLY_ARG, S_setB S_mus_file_buffer_size, "an integer");
- len = XEN_TO_C_INT64_T(val);
- if (len <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_mus_file_buffer_size, XEN_ONLY_ARG, val, "must be > 0");
- return(C_TO_XEN_INT64_T(mus_set_file_buffer_size(len)));
-}
-
-
/* ---------------- readin ---------------- */
-static XEN g_readin_p(XEN obj)
+static Xen g_is_readin(Xen obj)
{
- #define H_readin_p "(" S_readin_p " gen): " PROC_TRUE " if gen is a " S_readin
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_readin_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_readin "(" S_is_readin " gen): " PROC_TRUE " if gen is a " S_readin
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_readin(Xen_to_mus_any(obj)))));
}
-static XEN g_readin(XEN obj)
+static Xen g_readin(Xen obj)
{
#define H_readin "(" S_readin " gen): next sample from readin generator (a sound file reader)"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_readin_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_readin, "a readin generator");
- return(C_TO_XEN_DOUBLE(mus_readin(XEN_TO_MUS_ANY(obj))));
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_readin, S_readin, "a readin generator");
+
+ return(C_double_to_Xen_real(mus_readin(g)));
}
-static XEN g_make_readin(XEN arglist)
+static Xen g_make_readin(Xen arglist)
{
- #define H_make_readin "(" S_make_readin " :file (:channel 0) (:start 0) (:direction 1) :size): \
-return a new readin (file input) generator reading the sound file 'file' starting at frame \
+ #define H_make_readin "(" S_make_readin " file (channel 0) (start 0) (direction 1) size): \
+return a new readin (file input) generator reading the sound file 'file' starting at frample \
'start' in channel 'channel' and reading forward if 'direction' is not -1"
/* optkey file channel start direction size */
+
mus_any *ge;
const char *file = NULL;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[5];
+ Xen args[10];
+ Xen keys[5];
int orig_arg[5] = {0, 0, 0, 0, 0};
- int i, vals, arglist_len;
+ int vals, chans;
mus_long_t buffer_size;
int channel = 0, direction = 1;
mus_long_t start = 0;
@@ -6091,335 +7403,291 @@ return a new readin (file input) generator reading the sound file 'file' startin
keys[4] = kw_size;
buffer_size = mus_file_buffer_size();
+ /* this is only 8192! (clm.h MUS_DEFAULT_FILE_BUFFER_SIZE) */
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_readin, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 10) clm_error(S_make_readin, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 10; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_readin, 5, keys, args, orig_arg);
if (vals > 0)
{
file = mus_optkey_to_string(keys[0], S_make_readin, orig_arg[0], NULL); /* not copied */
- channel = mus_optkey_to_int(keys[1], S_make_readin, orig_arg[1], channel);
+ channel = Xen_optkey_to_int(kw_channel, keys[1], S_make_readin, orig_arg[1], channel);
if (channel < 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_readin, orig_arg[1], keys[1], "channel ~A < 0?");
+ Xen_out_of_range_error(S_make_readin, orig_arg[1], keys[1], "channel < 0?");
- start = mus_optkey_to_mus_long_t(keys[2], S_make_readin, orig_arg[2], start);
+ start = Xen_optkey_to_mus_long_t(kw_start, keys[2], S_make_readin, orig_arg[2], start);
- direction = mus_optkey_to_int(keys[3], S_make_readin, orig_arg[3], direction);
+ direction = Xen_optkey_to_int(kw_direction, keys[3], S_make_readin, orig_arg[3], direction);
- buffer_size = mus_optkey_to_mus_long_t(keys[4], S_make_readin, orig_arg[4], buffer_size);
+ buffer_size = Xen_optkey_to_mus_long_t(kw_size, keys[4], S_make_readin, orig_arg[4], buffer_size);
if (buffer_size <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_readin, orig_arg[4], keys[4], "must be > 0");
+ Xen_out_of_range_error(S_make_readin, orig_arg[4], keys[4], "must be > 0");
}
if (file == NULL)
- XEN_OUT_OF_RANGE_ERROR(S_make_readin, orig_arg[0], keys[0], "no file name given");
+ Xen_out_of_range_error(S_make_readin, orig_arg[0], keys[0], "no file name given");
if (!(mus_file_probe(file)))
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_3(C_TO_XEN_STRING(S_make_readin ": ~S, ~A"),
- C_TO_XEN_STRING(file),
- C_TO_XEN_STRING(STRERROR(errno))));
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_3(C_string_to_Xen_string(S_make_readin ": ~S, ~A"),
+ C_string_to_Xen_string(file),
+ C_string_to_Xen_string(STRERROR(errno))));
- if (mus_sound_chans(file) <= 0)
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_2(C_TO_XEN_STRING(S_make_readin ": ~S chans <= 0?"),
- C_TO_XEN_STRING(file)));
+ chans = mus_sound_chans(file);
+ if (chans <= 0)
+ Xen_error(BAD_HEADER,
+ Xen_list_2(C_string_to_Xen_string(S_make_readin ": ~S chans <= 0?"),
+ C_string_to_Xen_string(file)));
- if (channel >= mus_sound_chans(file))
- XEN_OUT_OF_RANGE_ERROR(S_make_readin, orig_arg[1], keys[1], "channel ~A > available chans?");
+ if (channel >= chans)
+ Xen_out_of_range_error(S_make_readin, orig_arg[1], keys[1], "channel > available chans?");
ge = mus_make_readin_with_buffer_size(file, channel, start, direction, buffer_size);
if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
-}
-
-
-static XEN g_mus_increment(XEN obj)
-{
- #define H_mus_increment "(" S_mus_increment " gen): gen's " S_mus_increment " field, if any"
- if (XEN_LIST_P(obj)) return(call_get_method(obj, S_mus_increment));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ONLY_ARG, S_mus_increment, "a generator");
- return(C_TO_XEN_DOUBLE(mus_increment(XEN_TO_MUS_ANY(obj))));
+ return(Xen_false);
}
-static XEN g_mus_set_increment(XEN obj, XEN val)
-{
- if (XEN_LIST_P(obj)) return(call_set_method(obj, val, S_mus_increment));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ARG_1, S_setB S_mus_increment, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_increment, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_increment(XEN_TO_MUS_ANY(obj), XEN_TO_C_DOUBLE(val))));
-}
-
+/* ---------------- locsig ---------------- */
-static XEN g_mus_feedback(XEN obj)
+static Xen g_locsig_ref(Xen obj, Xen chan)
{
- #define H_mus_feedback "(" S_mus_feedback " gen): gen's " S_mus_feedback " field"
- if (XEN_LIST_P(obj)) return(call_get_method(obj, S_mus_feedback));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ONLY_ARG, S_mus_feedback, "a generator");
- return(C_TO_XEN_DOUBLE(mus_feedback(XEN_TO_MUS_ANY(obj))));
+ #define H_locsig_ref "(" S_locsig_ref " gen chan): locsig 'gen' channel 'chan' scaler"
+ Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_ref, "a locsig generator");
+ Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_ref, "an integer");
+ return(C_double_to_Xen_real(mus_locsig_ref(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan))));
}
-static XEN g_mus_set_feedback(XEN obj, XEN val)
+static Xen g_locsig_set(Xen obj, Xen chan, Xen val)
{
- if (XEN_LIST_P(obj)) return(call_set_method(obj, val, S_mus_feedback));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ARG_1, S_setB S_mus_feedback, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_feedback, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_feedback(XEN_TO_MUS_ANY(obj), XEN_TO_C_DOUBLE(val))));
+ #define H_locsig_set "(" S_locsig_set " gen chan val): set the locsig generator's channel 'chan' scaler to 'val'"
+ Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_set, "a locsig generator");
+ Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_set, "an integer");
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(val), val, 3, S_locsig_set, "a number");
+ mus_locsig_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), Xen_real_to_C_double(val));
+#else
+ mus_locsig_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), s7_number_to_real_with_caller(s7, val, S_locsig_set));
+#endif
+ return(val);
}
-static XEN g_mus_location(XEN obj)
+static Xen g_locsig_reverb_ref(Xen obj, Xen chan)
{
- #define H_mus_location "(" S_mus_location " gen): gen's " S_mus_location " field, if any"
- if (XEN_LIST_P(obj)) return(call_get_method(obj, S_mus_location));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ONLY_ARG, S_mus_location, "a generator");
- return(C_TO_XEN_INT64_T(mus_location(XEN_TO_MUS_ANY(obj))));
+ #define H_locsig_reverb_ref "(" S_locsig_reverb_ref " gen chan): locsig reverb channel 'chan' scaler"
+ Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_reverb_ref, "a locsig generator");
+ Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_reverb_ref, "an integer");
+ return(C_double_to_Xen_real(mus_locsig_reverb_ref(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan))));
}
-static XEN g_mus_set_location(XEN obj, XEN val)
+static Xen g_locsig_reverb_set(Xen obj, Xen chan, Xen val)
{
- if (XEN_LIST_P(obj)) return(call_set_method(obj, val, S_mus_location));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ARG_1, S_setB S_mus_location, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_location, "a number");
- return(C_TO_XEN_INT64_T(mus_set_location(XEN_TO_MUS_ANY(obj), XEN_TO_C_INT64_T_OR_ELSE(val, 0))));
+ #define H_locsig_reverb_set "(" S_locsig_reverb_set " gen chan val): set the locsig reverb channel 'chan' scaler to 'val'"
+ Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_locsig_reverb_set, "a locsig generator");
+ Xen_check_type(Xen_is_integer(chan), chan, 2, S_locsig_reverb_set, "an integer");
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(val), val, 3, S_locsig_reverb_set, "a number");
+ mus_locsig_reverb_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), Xen_real_to_C_double(val));
+#else
+ mus_locsig_reverb_set(Xen_to_mus_any(obj), Xen_integer_to_C_int(chan), s7_number_to_real_with_caller(s7, val, S_locsig_reverb_set));
+#endif
+ return(val);
}
-static XEN g_mus_channel(XEN obj)
+static Xen g_is_locsig(Xen obj)
{
- #define H_mus_channel "(" S_mus_channel " gen): gen's " S_mus_channel " field, if any"
- if (XEN_LIST_P(obj)) return(call_get_method(obj, S_mus_channel));
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_input_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ONLY_ARG, S_mus_channel, "an input generator");
- return(C_TO_XEN_INT(mus_channel((mus_any *)XEN_TO_MUS_ANY(obj))));
+ #define H_is_locsig "(" S_is_locsig " gen): " PROC_TRUE " if gen is a " S_locsig
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj)))));
}
-static XEN g_mus_interp_type(XEN obj)
+static void mus_locsig_or_move_sound_to_vct_or_sound_data(mus_xen *ms, mus_any *loc_gen, mus_long_t pos, bool from_locsig)
{
- #define H_mus_interp_type "(" S_mus_interp_type " gen): gen's " S_mus_interp_type " field, if any"
- if (XEN_LIST_P(obj)) return(call_get_method(obj, S_mus_interp_type));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ONLY_ARG, S_mus_interp_type, "a generator");
- return(C_TO_XEN_INT(mus_interp_type((mus_any *)XEN_TO_MUS_ANY(obj))));
-}
-
-
-
-
-/* ---------------- locsig ---------------- */
-
-static XEN g_locsig_ref(XEN obj, XEN chan)
-{
- #define H_locsig_ref "(" S_locsig_ref " gen chan): locsig 'gen' channel 'chan' scaler"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_locsig_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_locsig_ref, "a locsig generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_2, S_locsig_ref, "an integer");
- return(C_TO_XEN_DOUBLE(mus_locsig_ref(XEN_TO_MUS_ANY(obj), XEN_TO_C_INT(chan))));
-}
-
-
-static XEN g_locsig_set(XEN obj, XEN chan, XEN val)
-{
- #define H_locsig_set "(" S_locsig_set " gen chan val): set the locsig generator's channel 'chan' scaler to 'val'"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_locsig_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_locsig_set, "a locsig generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_2, S_locsig_set, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_3, S_locsig_set, "a number");
- return(C_TO_XEN_DOUBLE(mus_locsig_set(XEN_TO_MUS_ANY(obj),
- XEN_TO_C_INT(chan),
- XEN_TO_C_DOUBLE(val))));
-}
-
-
-static XEN g_locsig_reverb_ref(XEN obj, XEN chan)
-{
- #define H_locsig_reverb_ref "(" S_locsig_reverb_ref " gen chan): locsig reverb channel 'chan' scaler"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_locsig_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_locsig_reverb_ref, "a locsig generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_2, S_locsig_reverb_ref, "an integer");
- return(C_TO_XEN_DOUBLE(mus_locsig_reverb_ref(XEN_TO_MUS_ANY(obj), XEN_TO_C_INT(chan))));
-}
-
-
-static XEN g_locsig_reverb_set(XEN obj, XEN chan, XEN val)
-{
- #define H_locsig_reverb_set "(" S_locsig_reverb_set " gen chan val): set the locsig reverb channel 'chan' scaler to 'val'"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_locsig_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_locsig_reverb_set, "a locsig generator");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_2, S_locsig_reverb_set, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_3, S_locsig_reverb_set, "a number");
- return(C_TO_XEN_DOUBLE(mus_locsig_reverb_set(XEN_TO_MUS_ANY(obj),
- XEN_TO_C_INT(chan),
- XEN_TO_C_DOUBLE(val))));
-}
-
-
-static XEN g_locsig_p(XEN obj)
-{
- #define H_locsig_p "(" S_locsig_p " gen): " PROC_TRUE " if gen is a " S_locsig
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_locsig_p(XEN_TO_MUS_ANY(obj)))));
-}
-
-
-enum {G_LOCSIG_DATA, G_LOCSIG_REVDATA, G_LOCSIG_OUT, G_LOCSIG_REVOUT};
-
-mus_float_t mus_locsig_or_move_sound_to_vct_or_sound_data(mus_xen *ms, mus_any *loc_gen, mus_long_t pos, mus_float_t fval, bool from_locsig)
-{
- mus_any *outfr = NULL, *revfr = NULL;
- XEN output, reverb;
+ mus_float_t *outfr = NULL, *revfr = NULL;
+ Xen output, reverb;
+#if HAVE_SCHEME
+ int chans, rev_chans;
+#endif
+ if (pos < 0) return;
if (from_locsig)
{
outfr = mus_locsig_outf(loc_gen);
revfr = mus_locsig_revf(loc_gen);
+#if HAVE_SCHEME
+ chans = mus_locsig_channels(loc_gen);
+ rev_chans = mus_locsig_reverb_channels(loc_gen);
+#endif
}
else
{
outfr = mus_move_sound_outf(loc_gen);
revfr = mus_move_sound_revf(loc_gen);
+#if HAVE_SCHEME
+ chans = mus_move_sound_channels(loc_gen);
+ rev_chans = mus_move_sound_reverb_channels(loc_gen);
+#endif
}
output = ms->vcts[G_LOCSIG_OUT];
if (outfr)
{
- if (MUS_VCT_P(output))
+ if (mus_is_vct(output))
{
vct *v;
- v = xen_to_vct(output);
- if (pos < v->length)
- v->data[pos] += mus_frame_ref(outfr, 0);
- }
- else
- {
- if (sound_data_p(output))
+ mus_float_t *vdata;
+ v = Xen_to_vct(output);
+ vdata = mus_vct_data(v);
+ if (Xen_vector_rank(output) == 1)
{
- sound_data *sd;
- int i;
- sd = XEN_TO_SOUND_DATA(output);
- if (pos < sd->length)
- for (i = 0; i < sd->chans; i++)
- sd->data[i][pos] += mus_frame_ref(outfr, i);
+ if (pos < mus_vct_length(v))
+ vdata[pos] += outfr[0];
}
+#if HAVE_SCHEME
else
{
- /* if make-locsig gets a function for *output*, the writers are not set, so mus_locsig below is a no-op,
- * so I guess this makes sense...
- */
- if (XEN_PROCEDURE_P(output))
+ s7_int chan_len;
+ chan_len = s7_vector_dimensions(output)[1]; /* '(4 20) so each chan len is [1] */
+ if (pos < chan_len)
{
- XEN_CALL_3(output,
- C_TO_XEN_INT64_T(pos),
- C_TO_XEN_DOUBLE(fval),
- XEN_ZERO,
- (from_locsig) ? S_locsig : S_move_sound);
+ int i;
+ for (i = 0; i < chans; i++)
+ vdata[i * chan_len + pos] += outfr[i];
}
}
+#endif
+ }
+ else
+ {
+ if ((Xen_is_vector(output)) &&
+ (pos < Xen_vector_length(output)))
+ Xen_vector_set(output, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(output, pos)) + outfr[0]));
}
}
if ((revfr) &&
- (XEN_BOUND_P(ms->vcts[G_LOCSIG_REVOUT])))
+ (Xen_is_bound(ms->vcts[G_LOCSIG_REVOUT])))
{
reverb = ms->vcts[G_LOCSIG_REVOUT];
- if (MUS_VCT_P(reverb))
+ if (mus_is_vct(reverb))
{
vct *v;
- v = xen_to_vct(reverb);
- if (pos < v->length)
- v->data[pos] += mus_frame_ref(revfr, 0);
- }
- else
- {
- if (sound_data_p(reverb))
+ mus_float_t *vdata;
+ v = Xen_to_vct(reverb);
+ vdata = mus_vct_data(v);
+ if (Xen_vector_rank(reverb) == 1)
{
- sound_data *sd;
- int i;
- sd = XEN_TO_SOUND_DATA(reverb);
- if (pos < sd->length)
- for (i = 0; i < sd->chans; i++)
- sd->data[i][pos] += mus_frame_ref(revfr, i);
+ if (pos < mus_vct_length(v))
+ vdata[pos] += revfr[0];
}
+#if HAVE_SCHEME
else
{
- if (XEN_PROCEDURE_P(reverb))
+ s7_int chan_len;
+ chan_len = s7_vector_dimensions(reverb)[1];
+ if (pos < chan_len)
{
- XEN_CALL_3(reverb,
- C_TO_XEN_INT64_T(pos),
- C_TO_XEN_DOUBLE(fval),
- XEN_ZERO,
- (from_locsig) ? S_locsig : S_move_sound);
+ int i;
+ for (i = 0; i < rev_chans; i++)
+ vdata[i * chan_len + pos] += revfr[i];
}
}
+#endif
+ }
+ else
+ {
+ if ((Xen_is_vector(reverb)) &&
+ (pos < Xen_vector_length(reverb)))
+ Xen_vector_set(reverb, pos, C_double_to_Xen_real(Xen_real_to_C_double(Xen_vector_ref(reverb, pos)) + revfr[0]));
}
}
- return(fval);
}
-static XEN g_locsig(XEN xobj, XEN xpos, XEN xval)
+static Xen g_locsig(Xen xobj, Xen xpos, Xen xval)
{
- #define H_locsig "(" S_locsig " gen loc val): add 'val' to the output of locsig at frame 'loc'"
+ #define H_locsig "(" S_locsig " gen loc val): add 'val' to the output of locsig at frample 'loc'"
mus_any *loc_gen;
mus_xen *ms;
mus_long_t pos;
mus_float_t fval;
- XEN_ASSERT_TYPE(MUS_XEN_P(xobj), xobj, XEN_ARG_1, S_locsig, "a locsig generator");
- ms = XEN_TO_MUS_XEN(xobj);
- loc_gen = (mus_any *)(ms->gen);
- XEN_ASSERT_TYPE(mus_locsig_p(loc_gen), xobj, XEN_ARG_1, S_locsig, "a locsig generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xpos), xpos, XEN_ARG_2, S_locsig, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xval), xval, XEN_ARG_3, S_locsig, "a number");
+ ms = (mus_xen *)Xen_object_ref_checked(xobj, mus_xen_tag);
+ if (!ms) Xen_check_type(false, xobj, 1, S_locsig, "a locsig generator");
+ loc_gen = ms->gen;
+ Xen_check_type(mus_is_locsig(loc_gen), xobj, 1, S_locsig, "a locsig generator");
- pos = XEN_TO_C_INT64_T_OR_ELSE(xpos, 0);
+ Xen_check_type(Xen_is_integer(xpos), xpos, 2, S_locsig, "an integer");
+
+ pos = Xen_llong_to_C_llong(xpos);
if (pos < 0)
- XEN_OUT_OF_RANGE_ERROR(S_locsig, XEN_ARG_2, xpos, "must be >= 0");
- fval = XEN_TO_C_DOUBLE(xval);
+ Xen_out_of_range_error(S_locsig, 2, xpos, "must be >= 0");
+
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(xval), xval, 3, S_locsig, "a number");
+ fval = Xen_real_to_C_double(xval);
+#else
+ fval = s7_number_to_real_with_caller(s7, xval, S_locsig);
+#endif
+
mus_locsig(loc_gen, pos, fval);
- /* now check for vct/sound-data special cases */
- if (ms->nvcts == 4) mus_locsig_or_move_sound_to_vct_or_sound_data(ms, loc_gen, pos, fval, true);
- return(xval); /* changed 30-June-06 to return val rather than a wrapped frame */
+ return(xval); /* changed 30-June-06 to return val rather than a wrapped frample */
}
-
static mus_interp_t clm_locsig_type = MUS_INTERP_LINEAR;
-static XEN g_locsig_type(void)
+static Xen g_locsig_type(void)
{
#define H_locsig_type "(" S_locsig_type "): locsig interpolation type, either " S_mus_interp_linear " or " S_mus_interp_sinusoidal "."
- return(C_TO_XEN_INT((int)clm_locsig_type));
+ return(C_int_to_Xen_integer((int)clm_locsig_type));
}
-static XEN g_set_locsig_type(XEN val)
+static Xen g_set_locsig_type(Xen val)
{
mus_interp_t newval;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_locsig_type, S_mus_interp_linear " or " S_mus_interp_sinusoidal);
- newval = (mus_interp_t)XEN_TO_C_INT(val);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_locsig_type, S_mus_interp_linear " or " S_mus_interp_sinusoidal);
+ newval = (mus_interp_t)Xen_integer_to_C_int(val);
if ((newval == MUS_INTERP_LINEAR) || (newval == MUS_INTERP_SINUSOIDAL))
clm_locsig_type = newval;
- return(C_TO_XEN_INT((int)clm_locsig_type));
+ return(C_int_to_Xen_integer((int)clm_locsig_type));
}
-static XEN g_make_locsig(XEN arglist)
+static void clm_locsig_detour(mus_any *ptr, mus_long_t pos)
{
- #define H_make_locsig "(" S_make_locsig " (:degree 0.0) (:distance 1.0) (:reverb 0.0) (:output *output*) (:revout *reverb*) (:channels (mus-channels *output*)) (:type " S_mus_interp_linear ")): \
+ mus_xen *ms;
+ ms = (mus_xen *)mus_locsig_closure(ptr);
+ /* now check for vct/sound-data special cases */
+ if (ms->nvcts == 4)
+ mus_locsig_or_move_sound_to_vct_or_sound_data(ms, ms->gen, pos, true);
+}
+
+static Xen g_make_locsig(Xen arglist)
+{
+ #define H_make_locsig "(" S_make_locsig " (degree 0.0) (distance 1.0) (reverb 0.0) (output *output*) (revout *reverb*) (channels (mus-channels *output*)) (type " S_mus_interp_linear ")): \
return a new generator for signal placement in n channels. Channel 0 corresponds to 0 degrees."
- mus_xen *gn;
mus_any *ge;
mus_any *outp = NULL, *revp = NULL;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[7];
- XEN ov = XEN_UNDEFINED, rv = XEN_UNDEFINED;
- XEN keys3 = XEN_UNDEFINED, keys4 = XEN_UNDEFINED;
+ Xen args[14];
+ Xen keys[7];
+ Xen ov = Xen_undefined, rv = Xen_undefined;
+ Xen keys3 = Xen_undefined, keys4 = Xen_undefined;
int orig_arg[7] = {0, 0, 0, 0, 0, 0, 0};
- int vals, i, arglist_len, out_chans = -1, rev_chans = -1;
+ int vals, out_chans = -1, rev_chans = -1;
mus_interp_t type;
mus_float_t degree = 0.0, distance = 1.0, reverb = 0.0;
@@ -6433,120 +7701,91 @@ return a new generator for signal placement in n channels. Channel 0 correspond
keys[5] = kw_channels;
keys[6] = kw_type;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_locsig, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 14) clm_error(S_make_locsig, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 14; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_locsig, 7, keys, args, orig_arg);
if (vals > 0)
{
- degree = mus_optkey_to_float(keys[0], S_make_locsig, orig_arg[0], degree);
- distance = mus_optkey_to_float(keys[1], S_make_locsig, orig_arg[1], distance);
- reverb = mus_optkey_to_float(keys[2], S_make_locsig, orig_arg[2], reverb);
+ degree = Xen_optkey_to_float(kw_degree, keys[0], S_make_locsig, orig_arg[0], degree);
+ distance = Xen_optkey_to_float(kw_distance, keys[1], S_make_locsig, orig_arg[1], distance);
+ reverb = Xen_optkey_to_float(kw_reverb, keys[2], S_make_locsig, orig_arg[2], reverb);
- if (!(XEN_KEYWORD_P(keys[3])))
+ if (!(Xen_is_keyword(keys[3])))
keys3 = keys[3];
- if (!(XEN_KEYWORD_P(keys[4])))
+ if (!(Xen_is_keyword(keys[4])))
keys4 = keys[4];
- if (!(XEN_KEYWORD_P(keys[5])))
+ if (!(Xen_is_keyword(keys[5])))
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(keys[5]), keys[5], orig_arg[5], S_make_locsig, "an integer");
- out_chans = XEN_TO_C_INT(keys[5]);
+ Xen_check_type(Xen_is_integer(keys[5]), keys[5], orig_arg[5], S_make_locsig, "an integer");
+ out_chans = Xen_integer_to_C_int(keys[5]);
if (out_chans < 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_locsig, orig_arg[5], keys[5], "chans ~A < 0?");
+ Xen_out_of_range_error(S_make_locsig, orig_arg[5], keys[5], "chans < 0?");
if (out_chans > mus_max_table_size())
- XEN_OUT_OF_RANGE_ERROR(S_make_locsig, orig_arg[5], keys[5], "chans = ~A?");
+ Xen_out_of_range_error(S_make_locsig, orig_arg[5], keys[5], "too many chans");
}
- type = (mus_interp_t)mus_optkey_to_int(keys[6], S_make_locsig, orig_arg[6], type);
+ type = (mus_interp_t)Xen_optkey_to_int(kw_type, keys[6], S_make_locsig, orig_arg[6], (int)type);
if ((type != MUS_INTERP_LINEAR) && (type != MUS_INTERP_SINUSOIDAL))
- XEN_OUT_OF_RANGE_ERROR(S_make_locsig, orig_arg[6], keys[6], "type ~A must be " S_mus_interp_linear " or " S_mus_interp_sinusoidal ".");
+ Xen_out_of_range_error(S_make_locsig, orig_arg[6], keys[6], "type must be " S_mus_interp_linear " or " S_mus_interp_sinusoidal ".");
}
- if (XEN_NOT_BOUND_P(keys3))
- keys3 = mus_clm_output();
-#if HAVE_SCHEME && HAVE_PTHREADS
- else
- if (s7_is_thread_variable(keys3))
- keys3 = s7_thread_variable(s7, keys3);
-#endif
+ if (!Xen_is_bound(keys3))
+ keys3 = CLM_OUTPUT;
- if (XEN_NOT_BOUND_P(keys4))
- keys4 = mus_clm_reverb();
-#if HAVE_SCHEME && HAVE_PTHREADS
- else
- if (s7_is_thread_variable(keys4))
- keys4 = s7_thread_variable(s7, keys4);
-#endif
+ if (!Xen_is_bound(keys4))
+ keys4 = CLM_REVERB;
/* try to default output to *output* and reverb to *reverb*, if they're currently set and not closed */
/* mus_close is actually mus_close_file = sample_to_file_end = free and nullify obufs so we're hoping dynamic-wind works... */
- if ((MUS_XEN_P(keys3)) &&
- (mus_output_p(XEN_TO_MUS_ANY(keys3))))
+ if ((mus_is_xen(keys3)) &&
+ (mus_is_output(Xen_to_mus_any(keys3))))
{
- outp = (mus_any *)XEN_TO_MUS_ANY(keys3);
+ outp = (mus_any *)Xen_to_mus_any(keys3);
if (out_chans < 0)
out_chans = mus_channels((mus_any *)outp);
}
else
{
- if (MUS_VCT_P(keys3))
+ if (mus_is_vct(keys3))
ov = keys3;
- else
- {
- if (sound_data_p(keys3))
- {
- ov = keys3;
- if (out_chans < 0)
- out_chans = (XEN_TO_SOUND_DATA(ov))->chans;
- }
- else
- {
- if (XEN_PROCEDURE_P(keys3)) /* don't combine this with vct case above -- sound-data thinks it is a procedure */
- ov = keys3;
- else XEN_ASSERT_TYPE(XEN_KEYWORD_P(keys[3]) || XEN_FALSE_P(keys[3]), keys[3], orig_arg[3], S_make_locsig, "an output gen, vct, vector, sound-data object, or a function");
- }
- }
+ else Xen_check_type(Xen_is_keyword(keys[3]) || Xen_is_false(keys[3]), keys[3], orig_arg[3], S_make_locsig, "an output gen, " S_vct ", vector, or a sound-data object");
+#if HAVE_SCHEME
+ if ((out_chans < 0) &&
+ (s7_is_vector(ov)) &&
+ (s7_vector_rank(ov) > 1))
+ out_chans = s7_vector_dimensions(ov)[0];
+#endif
}
- if ((MUS_XEN_P(keys4)) &&
- (mus_output_p(XEN_TO_MUS_ANY(keys4))))
+ if ((mus_is_xen(keys4)) &&
+ (mus_is_output(Xen_to_mus_any(keys4))))
{
- revp = (mus_any *)XEN_TO_MUS_ANY(keys4);
+ revp = (mus_any *)Xen_to_mus_any(keys4);
if (rev_chans < 0)
rev_chans = mus_channels((mus_any *)revp);
}
else
{
- if (MUS_VCT_P(keys4))
+ if (mus_is_vct(keys4))
{
rv = keys4;
rev_chans = 1;
+#if HAVE_SCHEME
+ if (Xen_vector_rank(rv) > 1)
+ rev_chans = s7_vector_dimensions(rv)[0];
+#endif
}
- else
- {
- if (sound_data_p(keys4))
- {
- rv = keys4;
- if (rev_chans < 0)
- rev_chans = (XEN_TO_SOUND_DATA(rv))->chans;
- }
- else
- {
- if (XEN_PROCEDURE_P(keys4))
- {
- rv = keys4;
- rev_chans = 1;
- }
- else XEN_ASSERT_TYPE(XEN_KEYWORD_P(keys[4]) || XEN_FALSE_P(keys[4]), keys[4], orig_arg[4], S_make_locsig, "a reverb output generator");
- }
- }
+ else Xen_check_type(Xen_is_keyword(keys[4]) || Xen_is_false(keys[4]), keys[4], orig_arg[4], S_make_locsig, "a reverb output generator");
}
if (out_chans < 0) out_chans = 1;
@@ -6556,23 +7795,23 @@ return a new generator for signal placement in n channels. Channel 0 correspond
if (ge)
{
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
-
- if ((XEN_BOUND_P(ov)) || (XEN_BOUND_P(rv)))
- gn->nvcts = 4;
- else gn->nvcts = 2;
- gn->vcts = make_vcts(gn->nvcts);
+ mus_xen *gn;
+ if (((Xen_is_bound(ov)) && (!Xen_is_false(ov))) ||
+ ((Xen_is_bound(rv)) && (!Xen_is_false(rv))))
+ gn = mx_alloc(4);
+ else gn = mx_alloc(2);
/* these two are for the mus-data and mus-xcoeffs methods in Scheme (etc) = MUS_DATA_WRAPPER and G_FILTER_XCOEFFS */
if (out_chans > 0)
gn->vcts[G_LOCSIG_DATA] = xen_make_vct_wrapper(out_chans, mus_data(ge));
- else gn->vcts[G_LOCSIG_DATA] = XEN_UNDEFINED;
+ else gn->vcts[G_LOCSIG_DATA] = Xen_undefined;
if (rev_chans > 0)
gn->vcts[G_LOCSIG_REVDATA] = xen_make_vct_wrapper(rev_chans, mus_xcoeffs(ge));
- else gn->vcts[G_LOCSIG_REVDATA] = XEN_UNDEFINED;
+ else gn->vcts[G_LOCSIG_REVDATA] = Xen_undefined;
if (gn->nvcts == 4)
{
+ mus_locsig_set_detour(ge, clm_locsig_detour);
gn->vcts[G_LOCSIG_OUT] = ov;
gn->vcts[G_LOCSIG_REVOUT] = rv;
mus_set_environ(ge, (void *)gn);
@@ -6581,44 +7820,23 @@ return a new generator for signal placement in n channels. Channel 0 correspond
gn->gen = ge;
return(mus_xen_to_object(gn));
}
- return(XEN_FALSE);
-}
-
-
-XEN g_mus_channels(XEN obj)
-{
- #define H_mus_channels "(" S_mus_channels " gen): gen's " S_mus_channels " field, if any"
-
- if (XEN_LIST_P(obj)) return(call_get_method(obj, S_mus_channels));
-
- if (MUS_XEN_P(obj))
- return(C_TO_XEN_INT(mus_channels(XEN_TO_MUS_ANY(obj))));
-
- if (MUS_VCT_P(obj))
- return(C_TO_XEN_INT(1));
-
- if (sound_data_p(obj))
- return(C_TO_XEN_INT((XEN_TO_SOUND_DATA(obj))->chans));
-
-#if HAVE_SCHEME && HAVE_PTHREADS
- if (s7_is_thread_variable(obj))
- return(C_TO_XEN_INT(mus_channels(XEN_TO_MUS_ANY(s7_thread_variable(s7, obj)))));
-#endif
-
- XEN_ASSERT_TYPE(false, obj, XEN_ONLY_ARG, S_mus_channels, "an output generator, vct, or sound-data object");
- return(XEN_FALSE); /* make compiler happy */
+ return(Xen_false);
}
-static XEN g_move_locsig(XEN obj, XEN degree, XEN distance)
+static Xen g_move_locsig(Xen obj, Xen degree, Xen distance)
{
#define H_move_locsig "(" S_move_locsig " gen degree distance): move locsig gen to reflect degree and distance"
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_locsig_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_move_locsig, "a locsig generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(degree), degree, XEN_ARG_2, S_move_locsig, "a number in degrees");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(distance), distance, XEN_ARG_3, S_move_locsig, "a number > 1.0");
- mus_move_locsig(XEN_TO_MUS_ANY(obj),
- XEN_TO_C_DOUBLE(degree),
- XEN_TO_C_DOUBLE(distance));
+ Xen_check_type((mus_is_xen(obj)) && (mus_is_locsig(Xen_to_mus_any(obj))), obj, 1, S_move_locsig, "a locsig generator");
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(degree), degree, 2, S_move_locsig, "a number in degrees");
+ Xen_check_type(Xen_is_number(distance), distance, 3, S_move_locsig, "a number > 1.0");
+ mus_move_locsig(Xen_to_mus_any(obj), Xen_real_to_C_double(degree), Xen_real_to_C_double(distance));
+#else
+ mus_move_locsig(Xen_to_mus_any(obj),
+ s7_number_to_real_with_caller(s7, degree, S_move_locsig),
+ s7_number_to_real_with_caller(s7, distance, S_move_locsig));
+#endif
return(obj);
}
@@ -6627,14 +7845,14 @@ static XEN g_move_locsig(XEN obj, XEN degree, XEN distance)
/* ---------------- move-sound ---------------- */
-static XEN g_move_sound_p(XEN obj)
+static Xen g_is_move_sound(Xen obj)
{
- #define H_move_sound_p "(" S_move_sound_p " gen): " PROC_TRUE " if gen is a " S_move_sound
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_move_sound_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_move_sound "(" S_is_move_sound " gen): " PROC_TRUE " if gen is a " S_move_sound
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_move_sound(Xen_to_mus_any(obj)))));
}
-static XEN g_move_sound(XEN obj, XEN loc, XEN val)
+static Xen g_move_sound(Xen obj, Xen loc, Xen val)
{
#define H_move_sound "(" S_move_sound " gen loc val): dlocsig run-time generator handling 'val' at sample 'loc'"
mus_any *move_gen;
@@ -6642,170 +7860,171 @@ static XEN g_move_sound(XEN obj, XEN loc, XEN val)
mus_long_t pos;
mus_float_t fval;
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ARG_1, S_move_sound, "a move-sound generator");
- ms = XEN_TO_MUS_XEN(obj);
+ Xen_check_type(mus_is_xen(obj), obj, 1, S_move_sound, "a move-sound generator");
+ ms = Xen_to_mus_xen(obj);
move_gen = (mus_any *)(ms->gen);
- XEN_ASSERT_TYPE(mus_move_sound_p(move_gen), obj, XEN_ARG_1, S_move_sound, "a move-sound generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(loc), loc, XEN_ARG_2, S_move_sound, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_3, S_move_sound, "a number");
+ Xen_check_type(mus_is_move_sound(move_gen), obj, 1, S_move_sound, "a move-sound generator");
+ Xen_check_type(Xen_is_integer(loc), loc, 2, S_move_sound, "an integer");
+ Xen_check_type(Xen_is_number(val), val, 3, S_move_sound, "a number");
- pos = XEN_TO_C_INT64_T_OR_ELSE(loc, 0);
+ pos = Xen_llong_to_C_llong(loc);
if (pos < 0)
- XEN_OUT_OF_RANGE_ERROR(S_move_sound, XEN_ARG_2, loc, "must be >= 0");
- fval = XEN_TO_C_DOUBLE(val);
+ Xen_out_of_range_error(S_move_sound, 2, loc, "must be >= 0");
+ fval = Xen_real_to_C_double(val);
mus_move_sound(move_gen, pos, fval);
-
- /* now check for vct/sound-data special cases */
- if (ms->nvcts == 4) mus_locsig_or_move_sound_to_vct_or_sound_data(ms, move_gen, pos, fval, false);
-
return(val);
}
-static mus_any **xen_vector_to_mus_any_array(XEN vect)
+static mus_any **xen_vector_to_mus_any_array(Xen vect)
{
mus_any **gens;
mus_long_t i, len;
- if (!(XEN_VECTOR_P(vect))) return(NULL);
- len = XEN_VECTOR_LENGTH(vect);
+ if (!(Xen_is_vector(vect))) return(NULL);
+ len = Xen_vector_length(vect);
gens = (mus_any **)calloc(len, sizeof(mus_any *));
for (i = 0; i < len; i++)
- if (MUS_XEN_P(XEN_VECTOR_REF(vect, i)))
- gens[i] = XEN_TO_MUS_ANY(XEN_VECTOR_REF(vect, i));
+ if (mus_is_xen(Xen_vector_ref(vect, i)))
+ gens[i] = Xen_to_mus_any(Xen_vector_ref(vect, i));
return(gens);
}
-static int *xen_vector_to_int_array(XEN vect)
+static int *xen_vector_to_int_array(Xen vect)
{
int *vals;
mus_long_t i, len;
- len = XEN_VECTOR_LENGTH(vect);
+ len = Xen_vector_length(vect);
vals = (int *)calloc(len, sizeof(int));
for (i = 0; i < len; i++)
- vals[i] = XEN_TO_C_INT(XEN_VECTOR_REF(vect, i));
+ vals[i] = Xen_integer_to_C_int(Xen_vector_ref(vect, i));
return(vals);
}
-static XEN g_make_move_sound(XEN dloc_list, XEN outp, XEN revp)
+static void clm_move_sound_detour(mus_any *ptr, mus_long_t pos)
{
- XEN ov = XEN_UNDEFINED, rv = XEN_UNDEFINED;
- mus_xen *gn;
+ mus_xen *ms;
+ ms = (mus_xen *)mus_move_sound_closure(ptr);
+ /* now check for vct/sound-data special cases */
+ if (ms->nvcts == 4)
+ mus_locsig_or_move_sound_to_vct_or_sound_data(ms, ms->gen, pos, false);
+}
+
+
+static Xen g_make_move_sound(Xen dloc_list, Xen outp, Xen revp)
+{
+ Xen ov = Xen_undefined, rv = Xen_undefined;
mus_any *ge, *dopdly, *dopenv, *globrevenv = NULL, *output = NULL, *revput = NULL;
mus_any **out_delays, **out_envs, **rev_envs;
int *out_map;
mus_long_t start, end;
int outchans = 0, revchans = 0;
- XEN ref;
+ Xen ref;
- #define H_make_move_sound "(" S_make_move_sound " dloc-list :optional (out *output*) (rev *reverb*)): make a dlocsig run-time generator"
+ #define H_make_move_sound "(" S_make_move_sound " dloc-list (out *output*) (rev *reverb*)): make a dlocsig run-time generator"
/* dloc-list is (list start end outchans revchans dopdly dopenv revenv outdelays outenvs revenvs outmap) */
/* outdelays envs and revenvs are vectors */
- XEN_ASSERT_TYPE(XEN_LIST_P(dloc_list) && (XEN_LIST_LENGTH(dloc_list) == 11), dloc_list, XEN_ARG_1, S_make_move_sound, "a dlocsig list");
+ Xen_check_type(Xen_is_list(dloc_list) && (Xen_list_length(dloc_list) == 11), dloc_list, 1, S_make_move_sound, "a dlocsig list");
- if (XEN_NOT_BOUND_P(outp))
- outp = mus_clm_output();
+ if (!Xen_is_bound(outp))
+ outp = CLM_OUTPUT;
- if (XEN_NOT_BOUND_P(revp))
- revp = mus_clm_reverb();
+ if (!Xen_is_bound(revp))
+ revp = CLM_REVERB;
- if (MUS_XEN_P(outp))
+ if (mus_is_xen(outp))
{
- output = XEN_TO_MUS_ANY(outp);
- XEN_ASSERT_TYPE(mus_output_p(output), outp, XEN_ARG_2, S_make_move_sound, "output stream");
+ output = Xen_to_mus_any(outp);
+ Xen_check_type(mus_is_output(output), outp, 2, S_make_move_sound, "output stream");
}
else
{
- if ((MUS_VCT_P(outp)) ||
- (sound_data_p(outp)) ||
- (XEN_FALSE_P(outp)) ||
- (XEN_NOT_BOUND_P(outp)) ||
- (XEN_PROCEDURE_P(outp)))
+ if ((mus_is_vct(outp)) ||
+ (Xen_is_false(outp)) ||
+ (!Xen_is_bound(outp)))
ov = outp;
- else XEN_ASSERT_TYPE(false, outp, XEN_ARG_2, S_make_move_sound, "output stream, vct, sound-data object, or function");
+ else Xen_check_type(false, outp, 2, S_make_move_sound, "output stream, " S_vct ", or a sound-data object");
}
- if (MUS_XEN_P(revp))
+ if (mus_is_xen(revp))
{
- revput = XEN_TO_MUS_ANY(revp);
- XEN_ASSERT_TYPE(mus_output_p(revput), revp, XEN_ARG_3, S_make_move_sound, "reverb stream");
+ revput = Xen_to_mus_any(revp);
+ Xen_check_type(mus_is_output(revput), revp, 3, S_make_move_sound, "reverb stream");
}
else
{
- if ((MUS_VCT_P(revp)) ||
- (sound_data_p(revp)) ||
- (XEN_FALSE_P(revp)) ||
- (XEN_NOT_BOUND_P(revp)) ||
- (XEN_PROCEDURE_P(revp)))
+ if ((mus_is_vct(revp)) ||
+ (Xen_is_false(revp)) ||
+ (!Xen_is_bound(revp)))
rv = revp;
- else XEN_ASSERT_TYPE(false, revp, XEN_ARG_3, S_make_move_sound, "reverb stream, vct, sound-data object, or function");
+ else Xen_check_type(false, revp, 3, S_make_move_sound, "reverb stream, " S_vct ", or a sound-data object");
}
- ref = XEN_LIST_REF(dloc_list, 0);
- XEN_ASSERT_TYPE(XEN_INT64_T_P(ref), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[0] (start): a sample number");
- start = XEN_TO_C_INT64_T(ref);
+ ref = Xen_list_ref(dloc_list, 0);
+ Xen_check_type(Xen_is_llong(ref), ref, 1, S_make_move_sound, "dlocsig list[0] (start): a sample number");
+ start = Xen_llong_to_C_llong(ref);
- ref = XEN_LIST_REF(dloc_list, 1);
- XEN_ASSERT_TYPE(XEN_INT64_T_P(ref), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[1] (end): a sample number");
- end = XEN_TO_C_INT64_T(ref);
+ ref = Xen_list_ref(dloc_list, 1);
+ Xen_check_type(Xen_is_llong(ref), ref, 1, S_make_move_sound, "dlocsig list[1] (end): a sample number");
+ end = Xen_llong_to_C_llong(ref);
- ref = XEN_LIST_REF(dloc_list, 2);
- XEN_ASSERT_TYPE(XEN_INTEGER_P(ref), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[2] (outchans): an integer");
- outchans = XEN_TO_C_INT(ref);
+ ref = Xen_list_ref(dloc_list, 2);
+ Xen_check_type(Xen_is_integer(ref), ref, 1, S_make_move_sound, "dlocsig list[2] (outchans): an integer");
+ outchans = Xen_integer_to_C_int(ref);
- ref = XEN_LIST_REF(dloc_list, 3);
- XEN_ASSERT_TYPE(XEN_INTEGER_P(ref), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[3] (revchans): an integer");
- revchans = XEN_TO_C_INT(ref);
+ ref = Xen_list_ref(dloc_list, 3);
+ Xen_check_type(Xen_is_integer(ref), ref, 1, S_make_move_sound, "dlocsig list[3] (revchans): an integer");
+ revchans = Xen_integer_to_C_int(ref);
- ref = XEN_LIST_REF(dloc_list, 4);
- XEN_ASSERT_TYPE(MUS_XEN_P(ref), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[4] (doppler delay): a delay generator");
- dopdly = XEN_TO_MUS_ANY(ref);
- XEN_ASSERT_TYPE(mus_delay_p(dopdly), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[4] (doppler delay): a delay generator");
+ ref = Xen_list_ref(dloc_list, 4);
+ Xen_check_type(mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[4] (doppler delay): a delay generator");
+ dopdly = Xen_to_mus_any(ref);
+ Xen_check_type(mus_is_delay(dopdly), ref, 1, S_make_move_sound, "dlocsig list[4] (doppler delay): a delay generator");
- ref = XEN_LIST_REF(dloc_list, 5);
- XEN_ASSERT_TYPE(MUS_XEN_P(ref), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[5] (doppler env): an env generator");
- dopenv = XEN_TO_MUS_ANY(ref);
- XEN_ASSERT_TYPE(mus_env_p(dopenv), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[5] (doppler env): an env generator");
+ ref = Xen_list_ref(dloc_list, 5);
+ Xen_check_type(mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[5] (doppler env): an env generator");
+ dopenv = Xen_to_mus_any(ref);
+ Xen_check_type(mus_is_env(dopenv), ref, 1, S_make_move_sound, "dlocsig list[5] (doppler env): an env generator");
- ref = XEN_LIST_REF(dloc_list, 6);
- XEN_ASSERT_TYPE(XEN_FALSE_P(ref) || MUS_XEN_P(ref), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[6] (global rev env): an env generator");
- if (MUS_XEN_P(ref))
+ ref = Xen_list_ref(dloc_list, 6);
+ Xen_check_type(Xen_is_false(ref) || mus_is_xen(ref), ref, 1, S_make_move_sound, "dlocsig list[6] (global rev env): an env generator");
+ if (mus_is_xen(ref))
{
- globrevenv = XEN_TO_MUS_ANY(ref);
- XEN_ASSERT_TYPE(mus_env_p(globrevenv), ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[6] (global rev env): an env generator");
+ globrevenv = Xen_to_mus_any(ref);
+ Xen_check_type(mus_is_env(globrevenv), ref, 1, S_make_move_sound, "dlocsig list[6] (global rev env): an env generator");
}
- ref = XEN_LIST_REF(dloc_list, 7);
- XEN_ASSERT_TYPE(XEN_VECTOR_P(ref) && ((int)XEN_VECTOR_LENGTH(ref) >= outchans),
- ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[7] (out delays): a vector of delay gens");
+ ref = Xen_list_ref(dloc_list, 7);
+ Xen_check_type(Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans),
+ ref, 1, S_make_move_sound, "dlocsig list[7] (out delays): a vector of delay gens");
- ref = XEN_LIST_REF(dloc_list, 8);
- XEN_ASSERT_TYPE(XEN_FALSE_P(ref) || (XEN_VECTOR_P(ref) && ((int)XEN_VECTOR_LENGTH(ref) >= outchans)),
- ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[8] (out envs): " PROC_FALSE " or a vector of envs");
+ ref = Xen_list_ref(dloc_list, 8);
+ Xen_check_type(Xen_is_false(ref) || (Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans)),
+ ref, 1, S_make_move_sound, "dlocsig list[8] (out envs): " PROC_FALSE " or a vector of envs");
- ref = XEN_LIST_REF(dloc_list, 9);
- XEN_ASSERT_TYPE(XEN_FALSE_P(ref) || (XEN_VECTOR_P(ref) && ((int)XEN_VECTOR_LENGTH(ref) >= revchans)),
- ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[9] (rev envs): " PROC_FALSE " or a vector of envs");
+ ref = Xen_list_ref(dloc_list, 9);
+ Xen_check_type(Xen_is_false(ref) || (Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= revchans)),
+ ref, 1, S_make_move_sound, "dlocsig list[9] (rev envs): " PROC_FALSE " or a vector of envs");
- ref = XEN_LIST_REF(dloc_list, 10);
- XEN_ASSERT_TYPE(XEN_VECTOR_P(ref) && ((int)XEN_VECTOR_LENGTH(ref) >= outchans),
- ref, XEN_ARG_1, S_make_move_sound, "dlocsig list[10] (out map): vector of ints");
+ ref = Xen_list_ref(dloc_list, 10);
+ Xen_check_type(Xen_is_vector(ref) && ((int)Xen_vector_length(ref) >= outchans),
+ ref, 1, S_make_move_sound, "dlocsig list[10] (out map): vector of ints");
/* put off allocation until all type error checks are done */
- out_delays = xen_vector_to_mus_any_array(XEN_LIST_REF(dloc_list, 7));
- out_envs = xen_vector_to_mus_any_array(XEN_LIST_REF(dloc_list, 8));
- rev_envs = xen_vector_to_mus_any_array(XEN_LIST_REF(dloc_list, 9));
- out_map = xen_vector_to_int_array(XEN_LIST_REF(dloc_list, 10));
+ out_delays = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 7));
+ out_envs = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 8));
+ rev_envs = xen_vector_to_mus_any_array(Xen_list_ref(dloc_list, 9));
+ out_map = xen_vector_to_int_array(Xen_list_ref(dloc_list, 10));
ge = mus_make_move_sound(start, end, outchans, revchans,
dopdly, dopenv, globrevenv,
@@ -6814,23 +8033,25 @@ static XEN g_make_move_sound(XEN dloc_list, XEN outp, XEN revp)
true, false); /* free outer arrays but not gens */
if (ge)
{
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
- if ((XEN_BOUND_P(ov)) || (XEN_BOUND_P(rv)))
- gn->nvcts = 4;
- else gn->nvcts = 1;
- gn->vcts = make_vcts(gn->nvcts);
+ mus_xen *gn;
+ if (((Xen_is_bound(ov)) && (!Xen_is_false(ov))) ||
+ ((Xen_is_bound(rv)) && (!Xen_is_false(rv))))
+ gn = mx_alloc(4);
+ else gn = mx_alloc(1);
gn->vcts[G_LOCSIG_DATA] = dloc_list; /* it is crucial that the list be gc-protected! */
if (gn->nvcts == 4)
{
+ mus_move_sound_set_detour(ge, clm_move_sound_detour);
gn->vcts[G_LOCSIG_OUT] = ov;
gn->vcts[G_LOCSIG_REVOUT] = rv;
+ gn->vcts[G_LOCSIG_REVDATA] = Xen_undefined;
mus_set_environ(ge, (void *)gn);
}
gn->gen = ge;
return(mus_xen_to_object(gn));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -6838,59 +8059,296 @@ static XEN g_make_move_sound(XEN dloc_list, XEN outp, XEN revp)
/* ---------------- src ---------------- */
+static Xen xen_one, xen_minus_one;
+
+#if HAVE_SCHEME
+static Xen as_needed_arglist;
+
+static s7_pointer env_symbol, polywave_symbol, triangle_wave_symbol, rand_interp_symbol, oscil_symbol;
+static s7_pointer multiply_symbol, add_symbol, vector_ref_symbol, quote_symbol, cos_symbol, comb_bank_symbol;
+
+
+static mus_float_t as_needed_input_float(void *ptr, int direction)
+{
+ mus_xen *gn = (mus_xen *)ptr;
+ return(s7_real(gn->vcts[MUS_INPUT_DATA]));
+}
+
+static mus_float_t as_needed_block_input_float(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
+{
+ mus_xen *gn = (mus_xen *)ptr;
+ mus_float_t val;
+ mus_long_t i, lim4;
+
+ lim4 = end - 4;
+ val = (mus_float_t)s7_real(gn->vcts[MUS_INPUT_DATA]); /* set in the chooser below */
+
+ for (i = start; i <= lim4;)
+ {
+ data[i++] = val;
+ data[i++] = val;
+ data[i++] = val;
+ data[i++] = val;
+ }
+ for (;i < end; i++)
+ data[i] = val;
+ return(val);
+}
+
+
+static mus_float_t as_needed_input_any(void *ptr, int direction)
+{
+ mus_xen *gn = (mus_xen *)ptr;
+ s7_set_car(as_needed_arglist, (direction == 1) ? xen_one : xen_minus_one);
+ return(s7_number_to_real(s7, s7_apply_function(s7, gn->vcts[MUS_INPUT_FUNCTION], as_needed_arglist)));
+}
+#endif
+
+
+static mus_float_t as_needed_input_generator(void *ptr, int direction)
+{
+#if HAVE_EXTENSION_LANGUAGE
+ return(mus_apply((mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]), 0.0, 0.0));
+#else
+ return(0.0);
+#endif
+}
+
+static mus_float_t as_needed_block_input_generator(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
+{
+#if HAVE_EXTENSION_LANGUAGE
+ mus_any *g;
+ mus_long_t i;
+ g = (mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
+ for (i = start; i < end; i++)
+ data[i] = mus_apply(g, 0.0, 0.0);
+#endif
+ return(0.0);
+}
+
+
+static mus_float_t as_needed_input_readin(void *ptr, int direction)
+{
+#if HAVE_EXTENSION_LANGUAGE
+ return(mus_readin((mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA])));
+#else
+ return(0.0);
+#endif
+}
+
+static mus_float_t as_needed_block_input_readin(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
+{
+#if HAVE_EXTENSION_LANGUAGE
+ mus_any *g;
+ mus_long_t i;
+ g = (mus_any *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
+ for (i = start; i < end; i++)
+ data[i] = mus_readin(g);
+#endif
+ return(0.0);
+}
+
+
+#if USE_SND && HAVE_SCHEME
+static mus_float_t as_needed_input_sampler(void *ptr, int direction)
+{
+ return(read_sample((snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA])));
+}
+
+static mus_float_t as_needed_block_input_sampler(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
+{
+ snd_fd *p;
+ mus_long_t i;
+ p = (snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
+ for (i = start; i < end; i++)
+ data[i] = read_sample(p);
+ return(0.0);
+}
+
+
+mus_float_t read_sample_with_direction(void *p, int dir);
+static mus_float_t as_needed_input_sampler_with_direction(void *ptr, int direction)
+{
+ return(read_sample_with_direction((snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]), direction));
+}
+
+static mus_float_t as_needed_block_input_sampler_with_direction(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
+{
+ snd_fd *p;
+ mus_long_t i;
+ p = (snd_fd *)(((mus_xen *)ptr)->vcts[MUS_INPUT_DATA]);
+ for (i = start; i < end; i++)
+ data[i] = read_sample_with_direction(p, direction);
+ return(0.0);
+}
+#endif
+
+
static mus_float_t as_needed_input_func(void *ptr, int direction) /* intended for "as-needed" input funcs */
{
- /* if this is called, it's a callback from C, where ptr is a mus_xen object whose vcts[0]
- * field is a XEN procedure to be called, the result being returned back to C. In the
- * Scheme world, it's a procedure of one arg, the current read direction:
- *
- * as_needed_input_func is input-func for clm.c make args, or the 2nd arg to the gen (mus_src(gen, input))
- * it is called in C (*input)(closure, dir)
- * closure in mus_xen *gn
- * its gn->vcts array [MUS_INPUT_FUNCTION] = scm procedure object (if any) else EMPTY_LIST
- * this is set in the gen call if it's passed there, else in the make-gen call
- * so we get here via *as_needed_input_func(gn, dir)
- * and make sure gn->vcts[MUS_INPUT_FUNCTION] is a procedure, call it with dir as its arg,
- * it returns a float which we then return to C
- */
mus_xen *gn = (mus_xen *)ptr;
- if ((gn) &&
- (gn->vcts) &&
- (XEN_BOUND_P(gn->vcts[MUS_INPUT_FUNCTION])) &&
- (XEN_PROCEDURE_P(gn->vcts[MUS_INPUT_FUNCTION])))
- return(XEN_TO_C_DOUBLE_OR_ELSE(XEN_CALL_1_NO_CATCH(gn->vcts[MUS_INPUT_FUNCTION], C_TO_XEN_INT(direction)), 0.0));
- /* the "or else" is crucial here -- this can be called unprotected in clm.c make_src during setup, and
- * an uncaught error there clobbers our local error chain.
- */
- else return(0.0);
+ if (gn)
+ {
+ Xen in_obj;
+ in_obj = gn->vcts[MUS_INPUT_FUNCTION];
+ if (Xen_is_procedure(in_obj))
+ return(Xen_real_to_C_double(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_INPUT_FUNCTION], (direction == 1) ? xen_one : xen_minus_one)));
+ }
+ return(0.0);
+}
+
+#if HAVE_SCHEME
+static mus_float_t as_needed_input_rf(void *ptr, int direction)
+{
+ mus_xen *gn = (mus_xen *)ptr;
+ if (gn)
+ {
+ s7_rf_t rf;
+ s7_pointer *top, *p;
+ rf = (s7_rf_t)(gn->vcts[MUS_INPUT_FUNCTION]);
+ top = s7_xf_top(s7, (void *)(gn->vcts[MUS_INPUT_DATA]));
+ p = top;
+ return(rf(s7, &p));
+ }
+ return(0.0);
}
+static mus_float_t as_needed_block_input_rf(void *ptr, int direction, mus_float_t *data, mus_long_t start, mus_long_t end)
+{
+ mus_xen *gn = (mus_xen *)ptr;
+ if (gn)
+ {
+ mus_long_t i;
+ s7_rf_t rf;
+ s7_pointer *top, *p;
+ rf = (s7_rf_t)(gn->vcts[MUS_INPUT_FUNCTION]);
+ top = s7_xf_top(s7, (void *)(gn->vcts[MUS_INPUT_DATA]));
+ for (i = start; i < end; i++)
+ {
+ p = top;
+ data[i] = rf(s7, &p);
+ }
+ }
+ return(0.0);
+}
+#endif
-static mus_float_t as_needed_input_generator(void *ptr, int direction) /* intended for "as-needed" input funcs */
+static void set_as_needed_input_choices(mus_any *gen, Xen obj, mus_xen *gn)
{
- return(MUS_RUN(XEN_TO_MUS_ANY(((mus_xen *)ptr)->vcts[MUS_INPUT_FUNCTION]), 0.0, 0.0));
+ /* fprintf(stderr, "set_as_needed_input for %s: %s\n", mus_name(gen), DISPLAY(obj)); */
+ if (mus_is_xen(obj)) /* input function is a generator */
+ {
+ mus_any *p;
+ p = Xen_to_mus_any(obj);
+ if (p)
+ {
+#if HAVE_EXTENSION_LANGUAGE
+ gn->vcts[MUS_INPUT_DATA] = (Xen)p;
+#endif
+ if (mus_is_readin(p))
+ mus_generator_set_feeders(gen, as_needed_input_readin, as_needed_block_input_readin);
+ else mus_generator_set_feeders(gen, as_needed_input_generator, as_needed_block_input_generator);
+ return;
+ }
+ }
+
+#if HAVE_SCHEME
+ if (Xen_is_procedure(obj))
+ {
+ s7_pointer body;
+ body = s7_closure_body(s7, obj);
+ if (s7_is_pair(body))
+ {
+ if (s7_is_null(s7, s7_cdr(body)))
+ {
+ s7_pointer res;
+ res = s7_car(body);
+ if (s7_is_real(res))
+ {
+ gn->vcts[MUS_INPUT_DATA] = res;
+ mus_generator_set_feeders(gen, as_needed_input_float, as_needed_block_input_float);
+ return;
+ }
+ if (s7_is_pair(res))
+ {
+ if (s7_is_symbol(s7_car(res)))
+ {
+ s7_pointer fcar;
+ fcar = s7_symbol_value(s7, s7_car(res));
+ if (s7_rf_function(s7, fcar))
+ {
+ s7_rf_t rf;
+ s7_pointer old_e, e;
+ e = s7_sublet(s7, s7_closure_let(s7, obj), s7_nil(s7));
+ old_e = s7_set_curlet(s7, e);
+ s7_xf_new(s7, e);
+ rf = s7_rf_function(s7, fcar)(s7, res);
+ if (rf)
+ {
+ /* fprintf(stderr, "try %s\n", DISPLAY(res)); */
+ gn->vcts[MUS_INPUT_DATA] = (s7_pointer)s7_xf_detach(s7);
+ gn->vcts[MUS_INPUT_FUNCTION] = (s7_pointer)rf;
+ gn->free_data = true;
+ mus_generator_set_feeders(gen, as_needed_input_rf, as_needed_block_input_rf);
+ s7_set_curlet(s7, old_e);
+ return;
+ }
+ s7_xf_free(s7);
+ s7_set_curlet(s7, old_e);
+ }
+ }
+#if USE_SND
+ {
+ s7_pointer arg;
+ arg = s7_car(s7_closure_args(s7, obj));
+ if ((arg == s7_caddr(res)) &&
+ (s7_car(res) == s7_make_symbol(s7, "read-sample-with-direction")))
+ {
+ gn->vcts[MUS_INPUT_DATA] = (Xen)xen_to_sampler(s7_symbol_local_value(s7, s7_cadr(res), s7_closure_let(s7, obj)));
+ mus_generator_set_feeders(gen, as_needed_input_sampler_with_direction, as_needed_block_input_sampler_with_direction);
+ return;
+ }
+ }
+#endif
+ }
+ }
+ }
+#if USE_SND
+ /* check for a sampler (snd-edits.c) */
+ if (is_sampler(obj))
+ {
+ gn->vcts[MUS_INPUT_DATA] = (Xen)xen_to_sampler(obj);
+ mus_generator_set_feeders(gen, as_needed_input_sampler, as_needed_block_input_sampler);
+ return;
+ }
+ mus_generator_set_feeders(gen, as_needed_input_any, NULL);
+ return;
+#endif
+ }
+#endif
+ mus_generator_set_feeders(gen, as_needed_input_func, NULL);
}
-static XEN g_mus_clear_sincs(void)
+static Xen g_mus_clear_sincs(void)
{
mus_clear_sinc_tables();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_src_p(XEN obj)
+static Xen g_is_src(Xen obj)
{
- #define H_src_p "(" S_src_p " gen): " PROC_TRUE " if gen is an " S_src
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_src_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_src "(" S_is_src " gen): " PROC_TRUE " if gen is an " S_src
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_src(Xen_to_mus_any(obj)))));
}
#define SRC_CHANGE_MAX 1000000.0
-static XEN g_src(XEN obj, XEN pm, XEN func)
+static Xen g_src(Xen obj, Xen pm, Xen func)
{
- #define H_src "(" S_src " gen :optional (pm 0.0) input-function): next sampling rate conversion sample. \
+ #define H_src "(" S_src " gen (pm 0.0) input-function): next sampling rate conversion sample. \
'pm' can be used to change the sampling rate on a sample-by-sample basis. 'input-function' \
is a function of one argument (the current input direction, normally ignored) that is called \
internally whenever a new sample of input data is needed. If the associated " S_make_src " \
@@ -6898,44 +8356,47 @@ included an 'input' argument, input-function is ignored."
mus_float_t pm1 = 0.0;
mus_xen *gn;
+ mus_any *g = NULL;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_src_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_src, "an src generator");
+ Xen_to_C_generator(obj, gn, g, mus_is_src, S_src, "an src generator");
+ Xen_real_to_C_double_if_bound(pm, pm1, S_src, 2);
- gn = XEN_TO_MUS_XEN(obj);
-
- if (XEN_NUMBER_P(pm))
- {
- pm1 = XEN_TO_C_DOUBLE(pm);
- /* if sr_change (pm1) is ridiculous, complain! */
- if ((pm1 > SRC_CHANGE_MAX) || (pm1 < -SRC_CHANGE_MAX))
- XEN_OUT_OF_RANGE_ERROR(S_src, XEN_ARG_2, pm, "src change ~A too large");
- }
- else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(pm), pm, XEN_ARG_2, S_src, "a number");
+ /* if sr_change (pm1) is ridiculous, complain! */
+ if ((pm1 > SRC_CHANGE_MAX) || (pm1 < -SRC_CHANGE_MAX))
+ Xen_out_of_range_error(S_src, 2, pm, "src change too large");
- if (XEN_PROCEDURE_P(func))
+ if (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA]))
{
- if (XEN_REQUIRED_ARGS_OK(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func;
- else XEN_BAD_ARITY_ERROR(S_src, 3, func, "src input function wants 1 arg");
+ if (Xen_is_procedure(func))
+ {
+ if (Xen_is_aritable(func, 1))
+ gn->vcts[MUS_INPUT_FUNCTION] = func;
+ else Xen_bad_arity_error(S_src, 3, func, "src input function wants 1 arg");
+ }
}
- return(C_TO_XEN_DOUBLE(mus_src(XEN_TO_MUS_ANY(obj), pm1, NULL)));
+ return(C_double_to_Xen_real(mus_src(g, pm1, NULL)));
}
+static void set_gn_gen(void *p, mus_any *g)
+{
+ mus_xen *gn = (mus_xen *)p;
+ gn->gen = g;
+}
-static XEN g_make_src(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen g_make_src(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
- #define H_make_src "(" S_make_src " :input (:srate 1.0) (:width 10)): \
+ #define H_make_src "(" S_make_src " input (srate 1.0) (width 10)): \
return a new sampling-rate conversion generator (using 'warped sinc interpolation'). \
'srate' is the ratio between the new rate and the old. 'width' is the sine \
width (effectively the steepness of the low-pass filter), normally between 10 and 100. \
'input' if given is an open file stream."
- XEN in_obj = XEN_UNDEFINED;
+ Xen in_obj = Xen_undefined;
mus_xen *gn;
- mus_any *ge;
+ mus_any *ge = NULL;
int vals, wid = 0; /* 0 here picks up the current default width in clm.c */
- XEN args[6];
- XEN keys[3];
+ Xen args[6];
+ Xen keys[3];
int orig_arg[3] = {0, 0, 0};
mus_float_t srate = 1.0;
@@ -6947,40 +8408,56 @@ width (effectively the steepness of the low-pass filter), normally between 10 an
vals = mus_optkey_unscramble(S_make_src, 3, keys, args, orig_arg);
if (vals > 0)
{
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_src, orig_arg[0], XEN_UNDEFINED, 1, "src input procedure takes 1 arg");
+ in_obj = mus_optkey_to_input_procedure(keys[0], S_make_src, orig_arg[0], Xen_undefined, 1, "src input procedure takes 1 arg");
- srate = mus_optkey_to_float(keys[1], S_make_src, orig_arg[1], srate);
+ srate = Xen_optkey_to_float(kw_srate, keys[1], S_make_src, orig_arg[1], srate);
/* srate can be negative => read in reverse */
- wid = mus_optkey_to_int(keys[2], S_make_src, orig_arg[2], wid);
+ wid = Xen_optkey_to_int(kw_width, keys[2], S_make_src, orig_arg[2], wid);
if (wid < 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_src, orig_arg[2], keys[2], "width ~A < 0?");
+ Xen_out_of_range_error(S_make_src, orig_arg[2], keys[2], "width < 0?");
if (wid > 2000)
- XEN_OUT_OF_RANGE_ERROR(S_make_src, orig_arg[2], keys[2], "width ~A?");
+ Xen_out_of_range_error(S_make_src, orig_arg[2], keys[2], "width > 2000?");
}
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
+ gn = mx_alloc(MUS_MAX_VCTS);
+ {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
/* mus_make_src assumes it can invoke the input function! */
- gn->nvcts = MUS_MAX_VCTS;
- gn->vcts = make_vcts(gn->nvcts);
gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
{
mus_error_handler_t *old_error_handler;
old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_src((MUS_XEN_P(in_obj)) ? as_needed_input_generator : as_needed_input_func, srate, wid, gn);
+ ge = mus_make_src_with_init(NULL, srate, wid, gn, set_gn_gen);
mus_error_set_handler(old_error_handler);
}
if (ge)
{
+ Xen src_obj;
+#if HAVE_SCHEME
+ int loc;
+#endif
+
gn->gen = ge;
- return(mus_xen_to_object(gn));
+ src_obj = mus_xen_to_object(gn);
+#if HAVE_SCHEME
+ loc = s7_gc_protect(s7, src_obj);
+#endif
+ /* src_init can call an input function which can trigger the GC, so we need to GC-protect the new object */
+
+ gn->vcts[MUS_SELF_WRAPPER] = src_obj;
+ set_as_needed_input_choices(ge, in_obj, gn);
+ mus_src_init(ge);
+#if HAVE_SCHEME
+ s7_gc_unprotect_at(s7, loc);
+#endif
+ return(src_obj);
}
free(gn->vcts);
free(gn);
- return(clm_mus_error(local_error_type, local_error_msg));
+ return(clm_mus_error(local_error_type, local_error_msg, S_make_src));
}
@@ -6988,74 +8465,57 @@ width (effectively the steepness of the low-pass filter), normally between 10 an
/* ---------------- granulate ---------------- */
-static XEN g_granulate_p(XEN obj)
+static Xen g_is_granulate(Xen obj)
{
- #define H_granulate_p "(" S_granulate_p " gen): " PROC_TRUE " if gen is a " S_granulate " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_granulate_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_granulate "(" S_is_granulate " gen): " PROC_TRUE " if gen is a " S_granulate " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_granulate(Xen_to_mus_any(obj)))));
}
static int grnedit(void *ptr)
{
mus_xen *gn = (mus_xen *)ptr;
- return(XEN_TO_C_INT(XEN_CALL_1_NO_CATCH(gn->vcts[MUS_EDIT_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
+ return(Xen_integer_to_C_int(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_EDIT_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
}
-static XEN g_granulate(XEN obj, XEN func, XEN edit_func)
+static Xen g_granulate(Xen obj, Xen func, Xen edit_func)
{
- #define H_granulate "(" S_granulate " gen :optional input-func edit-func): next sample from granular synthesis generator"
+ #define H_granulate "(" S_granulate " gen input-func edit-func): next sample from granular synthesis generator"
mus_xen *gn;
+ mus_any *g = NULL;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_granulate_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_granulate, "a granulate generator");
+ Xen_to_C_generator(obj, gn, g, mus_is_granulate, S_granulate, "a granulate generator");
- gn = XEN_TO_MUS_XEN(obj);
- if (XEN_BOUND_P(func))
+ if ((Xen_is_bound(func)) &&
+ (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA])))
{
- if (XEN_PROCEDURE_P(func))
+ if (Xen_is_procedure(func))
{
- if (XEN_REQUIRED_ARGS_OK(func, 1))
+ if (Xen_is_aritable(func, 1))
gn->vcts[MUS_INPUT_FUNCTION] = func;
- else XEN_BAD_ARITY_ERROR(S_granulate, 2, func, "granulate input function wants 1 arg");
+ else Xen_bad_arity_error(S_granulate, 2, func, "granulate input function wants 1 arg");
}
- if (XEN_PROCEDURE_P(edit_func))
+ if (Xen_is_procedure(edit_func))
{
- if (XEN_REQUIRED_ARGS_OK(edit_func, 1))
+ if (Xen_is_aritable(edit_func, 1))
{
- if (!(XEN_BOUND_P(gn->vcts[MUS_EDIT_FUNCTION]))) /* default value is XEN_UNDEFINED */
+ if (!(Xen_is_bound(gn->vcts[MUS_EDIT_FUNCTION]))) /* default value is Xen_undefined */
{
mus_granulate_set_edit_function(gn->gen, grnedit);
gn->vcts[MUS_EDIT_FUNCTION] = edit_func;
}
}
- else XEN_BAD_ARITY_ERROR(S_granulate, 3, edit_func, "granulate edit function wants 1 arg");
+ else Xen_bad_arity_error(S_granulate, 3, edit_func, "granulate edit function wants 1 arg");
}
}
- return(C_TO_XEN_DOUBLE(mus_granulate(XEN_TO_MUS_ANY(obj), NULL)));
-}
-
-
-static XEN g_mus_ramp(XEN obj)
-{
- #define H_mus_ramp "(" S_mus_ramp " gen): granulate generator's " S_mus_ramp " field"
- if (XEN_LIST_P(obj)) return(call_get_method(obj, S_mus_ramp));
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_granulate_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ONLY_ARG, S_mus_ramp, "a granulate generator");
- return(C_TO_XEN_INT64_T(mus_ramp(XEN_TO_MUS_ANY(obj))));
-}
-
-
-static XEN g_mus_set_ramp(XEN obj, XEN val)
-{
- if (XEN_LIST_P(obj)) return(call_set_method(obj, val, S_mus_ramp));
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_granulate_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_setB S_mus_ramp, "a granulate generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_ramp, "a number");
- return(C_TO_XEN_INT64_T(mus_set_ramp(XEN_TO_MUS_ANY(obj), XEN_TO_C_INT64_T_OR_ELSE(val, 0))));
+ return(C_double_to_Xen_real(mus_granulate(g, NULL)));
}
-static XEN g_make_granulate(XEN arglist)
+static Xen g_make_granulate(Xen arglist)
{
- #define H_make_granulate "(" S_make_granulate " :input (:expansion 1.0) (:length .15) (:scaler .6) (:hop .05) (:ramp .4) (:jitter 1.0) :max-size :edit): \
+ #define H_make_granulate "(" S_make_granulate " input (expansion 1.0) (length .15) (scaler .6) (hop .05) (ramp .4) (jitter 1.0) max-size edit): \
return a new granular synthesis generator. 'length' is the grain length (seconds), 'expansion' is the ratio in timing \
between the new and old (expansion > 1.0 slows things down), 'scaler' scales the grains \
to avoid overflows, 'hop' is the spacing (seconds) between successive grains upon output. \
@@ -7064,16 +8524,16 @@ be a function of one arg, the current granulate generator. It is called just be
a grain is added into the output buffer. The current grain is accessible via " S_mus_data ". \
The edit function, if any, should return the length in samples of the grain, or 0."
- XEN in_obj = XEN_UNDEFINED;
+ Xen in_obj = Xen_undefined;
mus_xen *gn;
mus_any *ge;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[9];
+ Xen args[18];
+ Xen keys[9];
int orig_arg[9] = {0, 0, 0, 0, 0, 0, 0, 0, 0};
- int vals, i, arglist_len, maxsize = 0;
+ int vals, maxsize = 0;
mus_float_t expansion = 1.0, segment_length = .15, segment_scaler = .6, ramp_time = .4, output_hop = .05;
mus_float_t jitter = 1.0;
- XEN edit_obj = XEN_UNDEFINED, grn_obj;
+ Xen edit_obj = Xen_undefined, grn_obj;
keys[0] = kw_input;
keys[1] = kw_expansion;
@@ -7085,78 +8545,83 @@ The edit function, if any, should return the length in samples of the grain, or
keys[7] = kw_max_size;
keys[8] = kw_edit;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_granulate, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 18) clm_error(S_make_granulate, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 18; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_granulate, 9, keys, args, orig_arg);
if (vals > 0)
{
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_granulate, orig_arg[0], XEN_UNDEFINED, 1, "granulate input procedure takes 1 arg");
+ in_obj = mus_optkey_to_input_procedure(keys[0], S_make_granulate, orig_arg[0], Xen_undefined, 1, "granulate input procedure takes 1 arg");
- expansion = mus_optkey_to_float(keys[1], S_make_granulate, orig_arg[1], expansion);
+ expansion = Xen_optkey_to_float(kw_expansion, keys[1], S_make_granulate, orig_arg[1], expansion);
if (expansion <= 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_granulate, orig_arg[1], keys[1], "expansion ~A <= 0.0?");
+ Xen_out_of_range_error(S_make_granulate, orig_arg[1], keys[1], "expansion <= 0.0?");
- segment_length = mus_optkey_to_float(keys[2], S_make_granulate, orig_arg[2], segment_length);
+ segment_length = Xen_optkey_to_float(kw_length, keys[2], S_make_granulate, orig_arg[2], segment_length);
if (segment_length <= 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_granulate, orig_arg[2], keys[2], "segment-length ~A <= 0.0?");
+ Xen_out_of_range_error(S_make_granulate, orig_arg[2], keys[2], "segment-length <= 0.0?");
- segment_scaler = mus_optkey_to_float(keys[3], S_make_granulate, orig_arg[3], segment_scaler);
+ segment_scaler = Xen_optkey_to_float(kw_scaler, keys[3], S_make_granulate, orig_arg[3], segment_scaler);
if (segment_scaler == 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_granulate, orig_arg[3], keys[3], "segment-scaler: ~A?");
+ Xen_out_of_range_error(S_make_granulate, orig_arg[3], keys[3], "segment-scaler should be greater than 0.0?");
- output_hop = mus_optkey_to_float(keys[4], S_make_granulate, orig_arg[4], output_hop);
+ output_hop = Xen_optkey_to_float(kw_hop, keys[4], S_make_granulate, orig_arg[4], output_hop);
if (output_hop <= 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_granulate, orig_arg[4], keys[4], "hop ~A <= 0?");
+ Xen_out_of_range_error(S_make_granulate, orig_arg[4], keys[4], "hop <= 0?");
if (output_hop > 3600.0)
- XEN_OUT_OF_RANGE_ERROR(S_make_granulate, orig_arg[4], keys[4], "hop ~A?");
+ Xen_out_of_range_error(S_make_granulate, orig_arg[4], keys[4], "hop > 3600?");
if ((segment_length + output_hop) > 60.0) /* multiplied by srate in mus_make_granulate in array allocation */
- XEN_OUT_OF_RANGE_ERROR(S_make_granulate, orig_arg[2], XEN_LIST_2(keys[2], keys[4]), "segment_length + output_hop = ~A: too large!");
+ Xen_out_of_range_error(S_make_granulate, orig_arg[2], Xen_list_2(keys[2], keys[4]), "segment_length + output_hop too large!");
- ramp_time = mus_optkey_to_float(keys[5], S_make_granulate, orig_arg[5], ramp_time);
+ ramp_time = Xen_optkey_to_float(kw_ramp, keys[5], S_make_granulate, orig_arg[5], ramp_time);
if ((ramp_time < 0.0) || (ramp_time > 0.5))
- XEN_OUT_OF_RANGE_ERROR(S_make_granulate, orig_arg[5], keys[5], "ramp ~A must be between 0.0 and 0.5");
+ Xen_out_of_range_error(S_make_granulate, orig_arg[5], keys[5], "ramp must be between 0.0 and 0.5");
- jitter = mus_optkey_to_float(keys[6], S_make_granulate, orig_arg[6], jitter);
- XEN_ASSERT_TYPE((jitter >= 0.0) && (jitter < 100.0), keys[6], orig_arg[6], S_make_granulate, "0.0 .. 100.0");
+ jitter = Xen_optkey_to_float(kw_jitter, keys[6], S_make_granulate, orig_arg[6], jitter);
+ Xen_check_type((jitter >= 0.0) && (jitter < 100.0), keys[6], orig_arg[6], S_make_granulate, "0.0 .. 100.0");
- maxsize = mus_optkey_to_int(keys[7], S_make_granulate, orig_arg[7], maxsize);
+ maxsize = Xen_optkey_to_int(kw_max_size, keys[7], S_make_granulate, orig_arg[7], maxsize);
if ((maxsize > mus_max_malloc()) ||
(maxsize < 0) ||
- ((maxsize == 0) && (!XEN_KEYWORD_P(keys[7]))))
- XEN_OUT_OF_RANGE_ERROR(S_make_granulate, orig_arg[7], keys[7], "max-size ~A?");
+ ((maxsize == 0) && (!Xen_is_keyword(keys[7]))))
+ Xen_out_of_range_error(S_make_granulate, orig_arg[7], keys[7], "max-size invalid");
- edit_obj = mus_optkey_to_procedure(keys[8], S_make_granulate, orig_arg[8], XEN_UNDEFINED, 1, "granulate edit procedure takes 1 arg");
+ edit_obj = mus_optkey_to_procedure(keys[8], S_make_granulate, orig_arg[8], Xen_undefined, 1, "granulate edit procedure takes 1 arg");
}
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
+ gn = mx_alloc(MUS_MAX_VCTS);
+ {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
{
mus_error_handler_t *old_error_handler;
old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_granulate((MUS_XEN_P(in_obj)) ? as_needed_input_generator : as_needed_input_func,
+ ge = mus_make_granulate(NULL,
expansion, segment_length, segment_scaler, output_hop, ramp_time, jitter, maxsize,
- (XEN_NOT_BOUND_P(edit_obj) ? NULL : grnedit),
+ (!Xen_is_bound(edit_obj) ? NULL : grnedit),
(void *)gn);
mus_error_set_handler(old_error_handler);
}
+
if (ge)
{
- gn->nvcts = MUS_MAX_VCTS;
- gn->vcts = make_vcts(gn->nvcts);
gn->vcts[MUS_DATA_WRAPPER] = xen_make_vct_wrapper(mus_granulate_grain_max_length(ge), mus_data(ge));
gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
gn->vcts[MUS_EDIT_FUNCTION] = edit_obj;
gn->gen = ge;
grn_obj = mus_xen_to_object(gn);
gn->vcts[MUS_SELF_WRAPPER] = grn_obj;
+ set_as_needed_input_choices(ge, in_obj, gn);
return(grn_obj);
}
+
+ free(gn->vcts);
free(gn);
- return(clm_mus_error(local_error_type, local_error_msg));
+ return(clm_mus_error(local_error_type, local_error_msg, S_make_granulate));
}
@@ -7164,127 +8629,138 @@ The edit function, if any, should return the length in samples of the grain, or
/* ---------------- convolve ---------------- */
-static XEN g_convolve_p(XEN obj)
+static Xen g_is_convolve(Xen obj)
{
- #define H_convolve_p "(" S_convolve_p " gen): " PROC_TRUE " if gen is a " S_convolve " generator"
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_convolve_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_convolve "(" S_is_convolve " gen): " PROC_TRUE " if gen is a " S_convolve " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_convolve(Xen_to_mus_any(obj)))));
}
-static XEN g_convolve(XEN obj, XEN func)
+static Xen g_convolve(Xen obj, Xen func)
{
- #define H_convolve_gen "(" S_convolve " gen :optional input-func): next sample from convolution generator"
+ #define H_convolve_gen "(" S_convolve " gen input-func): next sample from convolution generator"
mus_xen *gn;
+ mus_any *g = NULL;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_convolve_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_convolve, "a convolve generator");
+ Xen_to_C_generator(obj, gn, g, mus_is_convolve, S_convolve, "a convolve generator");
- gn = XEN_TO_MUS_XEN(obj);
- if (XEN_PROCEDURE_P(func))
+ if (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA]))
{
- if (XEN_REQUIRED_ARGS_OK(func, 1))
- gn->vcts[MUS_INPUT_FUNCTION] = func;
- else XEN_BAD_ARITY_ERROR(S_convolve, 2, func, "convolve input function wants 1 arg");
+ if (Xen_is_procedure(func))
+ {
+ if (Xen_is_aritable(func, 1))
+ gn->vcts[MUS_INPUT_FUNCTION] = func;
+ else Xen_bad_arity_error(S_convolve, 2, func, "convolve input function wants 1 arg");
+ }
}
- return(C_TO_XEN_DOUBLE(mus_convolve(XEN_TO_MUS_ANY(obj), NULL)));
+ return(C_double_to_Xen_real(mus_convolve(g, NULL)));
}
/* filter-size? */
-static XEN g_make_convolve(XEN arglist)
+static Xen g_make_convolve(Xen arglist)
{
- #define H_make_convolve "(" S_make_convolve " :input :filter :fft-size): \
+ #define H_make_convolve "(" S_make_convolve " input filter fft-size): \
return a new convolution generator which convolves its input with the impulse response 'filter'."
mus_xen *gn;
mus_any *ge;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[3];
+ Xen args[6];
+ Xen keys[3];
int orig_arg[3] = {0, 0, 0};
- int vals, i, arglist_len;
+ int vals;
vct *filter = NULL;
- XEN filt = XEN_UNDEFINED, in_obj = XEN_UNDEFINED;
+ Xen filt = Xen_undefined, in_obj = Xen_undefined;
mus_long_t fftlen, fft_size = 0;
keys[0] = kw_input;
keys[1] = kw_filter;
keys[2] = kw_fft_size;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_convolve, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 6) clm_error(S_make_convolve, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 6; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_convolve, 3, keys, args, orig_arg);
if (vals > 0)
{
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_convolve, orig_arg[0], XEN_UNDEFINED, 1, "convolve input procedure takes 1 arg");
+ in_obj = mus_optkey_to_input_procedure(keys[0], S_make_convolve, orig_arg[0], Xen_undefined, 1, "convolve input procedure takes 1 arg");
filter = mus_optkey_to_vct(keys[1], S_make_convolve, orig_arg[1], NULL);
if (filter) filt = keys[1];
- fft_size = mus_optkey_to_mus_long_t(keys[2], S_make_convolve, orig_arg[2], fft_size);
+ fft_size = Xen_optkey_to_mus_long_t(kw_fft_size, keys[2], S_make_convolve, orig_arg[2], fft_size);
if ((fft_size < 0) ||
- ((fft_size == 0) && (!XEN_KEYWORD_P(keys[2]))) ||
+ ((fft_size == 0) && (!Xen_is_keyword(keys[2]))) ||
(fft_size > mus_max_malloc()))
- XEN_OUT_OF_RANGE_ERROR(S_make_convolve, orig_arg[2], keys[2], "fft-size ~A? (see mus-max-malloc))");
+ Xen_out_of_range_error(S_make_convolve, orig_arg[2], keys[2], "fft-size invalid (see mus-max-malloc))");
}
if (filter == NULL)
- XEN_ERROR(NO_DATA,
- XEN_LIST_1(C_TO_XEN_STRING(S_make_convolve ": no impulse (filter)?")));
+ Xen_error(NO_DATA,
+ Xen_list_1(C_string_to_Xen_string(S_make_convolve ": no impulse (filter)?")));
- if (POWER_OF_2_P(filter->length))
- fftlen = filter->length * 2;
- else fftlen = (mus_long_t)pow(2.0, 1 + (int)(log((mus_float_t)(filter->length + 1)) / log(2.0)));
+ if (is_power_of_2(mus_vct_length(filter)))
+ fftlen = mus_vct_length(filter) * 2;
+ else fftlen = (mus_long_t)pow(2.0, 1 + (int)(log((mus_float_t)(mus_vct_length(filter) + 1)) / log(2.0)));
if (fft_size < fftlen) fft_size = fftlen;
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
+ gn = mx_alloc(MUS_MAX_VCTS);
+ {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
{
mus_error_handler_t *old_error_handler;
old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_convolve((MUS_XEN_P(in_obj)) ? as_needed_input_generator : as_needed_input_func, filter->data, fft_size, filter->length, gn);
+ ge = mus_make_convolve(NULL, mus_vct_data(filter), fft_size, mus_vct_length(filter), gn);
mus_error_set_handler(old_error_handler);
}
+
if (ge)
{
- gn->nvcts = MUS_MAX_VCTS;
- gn->vcts = make_vcts(gn->nvcts);
+ Xen c_obj;
gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
- gn->vcts[2] = filt; /* why is this here? GC protection? (might be a locally-allocated vct as from file->vct) */
+ gn->vcts[MUS_ANALYZE_FUNCTION] = filt; /* why is this here? GC protection? (might be a locally-allocated vct as from file->vct) */
gn->gen = ge;
- return(mus_xen_to_object(gn));
+ c_obj = mus_xen_to_object(gn);
+ gn->vcts[MUS_SELF_WRAPPER] = c_obj;
+ set_as_needed_input_choices(ge, in_obj, gn);
+ return(c_obj);
}
+
+ free(gn->vcts);
free(gn);
- return(clm_mus_error(local_error_type, local_error_msg));
+ return(clm_mus_error(local_error_type, local_error_msg, S_make_convolve));
}
-static XEN g_convolve_files(XEN file1, XEN file2, XEN maxamp, XEN outfile)
+static Xen g_convolve_files(Xen file1, Xen file2, Xen maxamp, Xen outfile)
{
- #define H_convolve_files "(" S_convolve_files " file1 file2 :optional maxamp output-file): convolve \
+ #define H_convolve_files "(" S_convolve_files " file1 file2 maxamp output-file): convolve \
file1 and file2 writing outfile after scaling the convolution result to maxamp."
const char *f1, *f2, *f3;
mus_float_t maxval = 1.0;
- XEN_ASSERT_TYPE(XEN_STRING_P(file1), file1, XEN_ARG_1, S_convolve_files, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(file2), file2, XEN_ARG_2, S_convolve_files, "a string");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(maxamp), maxamp, XEN_ARG_3, S_convolve_files, "a number");
- XEN_ASSERT_TYPE((XEN_NOT_BOUND_P(outfile)) || (XEN_STRING_P(outfile)), outfile, XEN_ARG_4, S_convolve_files, "a string");
+ Xen_check_type(Xen_is_string(file1), file1, 1, S_convolve_files, "a string");
+ Xen_check_type(Xen_is_string(file2), file2, 2, S_convolve_files, "a string");
+ Xen_check_type(Xen_is_number_or_unbound(maxamp), maxamp, 3, S_convolve_files, "a number");
+ Xen_check_type((!Xen_is_bound(outfile)) || (Xen_is_string(outfile)), outfile, 4, S_convolve_files, "a string");
- f1 = XEN_TO_C_STRING(file1);
- f2 = XEN_TO_C_STRING(file2);
- if (XEN_STRING_P(outfile))
- f3 = XEN_TO_C_STRING(outfile);
+ f1 = Xen_string_to_C_string(file1);
+ f2 = Xen_string_to_C_string(file2);
+ if (Xen_is_string(outfile))
+ f3 = Xen_string_to_C_string(outfile);
else f3 = "tmp.snd";
- if (XEN_NUMBER_P(maxamp))
- maxval = XEN_TO_C_DOUBLE(maxamp);
+ if (Xen_is_number(maxamp))
+ maxval = Xen_real_to_C_double(maxamp);
mus_convolve_files(f1, f2, maxval, f3);
- return(C_TO_XEN_STRING(f3));
+ return(C_string_to_Xen_string(f3));
}
@@ -7301,7 +8777,7 @@ file1 and file2 writing outfile after scaling the convolution result to maxamp."
* the mus_xen object that shadows the phase-vocoder generator, with two special
* pointers in the vcts field: vcts[MUS_EDIT_FUNCTION] is the (Scheme-side) function
* passed by the user, and vcts[MUS_SELF_WRAPPER] is a pointer to the (Scheme-relevant)
- * smob that packages the mus_xen pointer for Scheme. This way, the user's
+ * object that packages the mus_xen pointer for Scheme. This way, the user's
* (make-phase-vocoder ... (lambda (v) (mus-length v)) ...)
* treats v as the current pv gen, vcts[MUS_SELF_WRAPPER] = v, vcts[MUS_EDIT_FUNCTION] =
* the lambda form, mus_xen obj->gen is the C-side pv struct pointer. See above
@@ -7315,14 +8791,14 @@ file1 and file2 writing outfile after scaling the convolution result to maxamp."
static int pvedit(void *ptr)
{
mus_xen *gn = (mus_xen *)ptr;
- return(XEN_TO_C_BOOLEAN(XEN_CALL_1_NO_CATCH(gn->vcts[MUS_EDIT_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
+ return(Xen_boolean_to_C_bool(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_EDIT_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
}
static mus_float_t pvsynthesize(void *ptr)
{
mus_xen *gn = (mus_xen *)ptr;
- return(XEN_TO_C_DOUBLE(XEN_CALL_1_NO_CATCH(gn->vcts[MUS_SYNTHESIZE_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
+ return(Xen_real_to_C_double(Xen_unprotected_call_with_1_arg(gn->vcts[MUS_SYNTHESIZE_FUNCTION], gn->vcts[MUS_SELF_WRAPPER])));
}
@@ -7330,72 +8806,74 @@ static bool pvanalyze(void *ptr, mus_float_t (*input)(void *arg1, int direction)
{
mus_xen *gn = (mus_xen *)ptr;
/* we can only get input func if it's already set up by the outer gen call, so (?) we can use that function here */
- return(XEN_TO_C_BOOLEAN(XEN_CALL_2_NO_CATCH(gn->vcts[MUS_ANALYZE_FUNCTION],
+ return(Xen_boolean_to_C_bool(Xen_unprotected_call_with_2_args(gn->vcts[MUS_ANALYZE_FUNCTION],
gn->vcts[MUS_SELF_WRAPPER],
gn->vcts[MUS_INPUT_FUNCTION])));
}
-static XEN g_phase_vocoder_p(XEN obj)
+static Xen g_is_phase_vocoder(Xen obj)
{
- #define H_phase_vocoder_p "(" S_phase_vocoder_p " gen): " PROC_TRUE " if gen is an " S_phase_vocoder
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_phase_vocoder_p(XEN_TO_MUS_ANY(obj)))));
+ #define H_is_phase_vocoder "(" S_is_phase_vocoder " gen): " PROC_TRUE " if gen is an " S_phase_vocoder
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_phase_vocoder(Xen_to_mus_any(obj)))));
}
-static XEN g_phase_vocoder(XEN obj, XEN func, XEN analyze_func, XEN edit_func, XEN synthesize_func)
+static Xen g_phase_vocoder(Xen obj, Xen func, Xen analyze_func, Xen edit_func, Xen synthesize_func)
{
#define H_phase_vocoder "(" S_phase_vocoder " gen input-function analyze-func edit-func synthesize-func): next phase vocoder value"
mus_xen *gn;
+ mus_any *g = NULL;
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_phase_vocoder_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_phase_vocoder, "a " S_phase_vocoder " generator");
+ Xen_to_C_generator(obj, gn, g, mus_is_phase_vocoder, S_phase_vocoder, "a phase-vocoder generator");
- gn = XEN_TO_MUS_XEN(obj);
- if (XEN_BOUND_P(func))
+ if (Xen_is_bound(func))
{
bool (*analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction)) = NULL;
int (*edit)(void *arg) = NULL;
mus_float_t (*synthesize)(void *arg) = NULL;
- if (XEN_PROCEDURE_P(func))
+
+ if ((Xen_is_procedure(func)) &&
+ (!Xen_is_bound(gn->vcts[MUS_INPUT_DATA])))
{
- if (XEN_REQUIRED_ARGS_OK(func, 1))
+ if (Xen_is_aritable(func, 1))
gn->vcts[MUS_INPUT_FUNCTION] = func; /* as_needed_input_func set at make time will pick this up */
- else XEN_BAD_ARITY_ERROR(S_phase_vocoder, 2, func, S_phase_vocoder " input function wants 1 arg");
+ else Xen_bad_arity_error(S_phase_vocoder, 2, func, S_phase_vocoder " input function wants 1 arg");
}
- if (XEN_PROCEDURE_P(analyze_func))
+ if (Xen_is_procedure(analyze_func))
{
- if (XEN_REQUIRED_ARGS_OK(analyze_func, 2))
+ if (Xen_is_aritable(analyze_func, 2))
{
gn->vcts[MUS_ANALYZE_FUNCTION] = analyze_func;
analyze = pvanalyze;
}
- else XEN_BAD_ARITY_ERROR(S_phase_vocoder, 3, analyze_func, S_phase_vocoder " analyze function wants 2 args");
+ else Xen_bad_arity_error(S_phase_vocoder, 3, analyze_func, S_phase_vocoder " analyze function wants 2 args");
}
- if (XEN_PROCEDURE_P(edit_func))
+ if (Xen_is_procedure(edit_func))
{
- if (XEN_REQUIRED_ARGS_OK(edit_func, 1))
+ if (Xen_is_aritable(edit_func, 1))
{
gn->vcts[MUS_EDIT_FUNCTION] = edit_func;
edit = pvedit;
}
- else XEN_BAD_ARITY_ERROR(S_phase_vocoder, 4, edit_func, S_phase_vocoder " edit function wants 1 arg");
+ else Xen_bad_arity_error(S_phase_vocoder, 4, edit_func, S_phase_vocoder " edit function wants 1 arg");
}
- if (XEN_PROCEDURE_P(synthesize_func))
+ if (Xen_is_procedure(synthesize_func))
{
- if (XEN_REQUIRED_ARGS_OK(synthesize_func, 1))
+ if (Xen_is_aritable(synthesize_func, 1))
{
gn->vcts[MUS_SYNTHESIZE_FUNCTION] = synthesize_func;
synthesize = pvsynthesize;
}
- else XEN_BAD_ARITY_ERROR(S_phase_vocoder, 5, synthesize_func, S_phase_vocoder " synthesize function wants 1 arg");
+ else Xen_bad_arity_error(S_phase_vocoder, 5, synthesize_func, S_phase_vocoder " synthesize function wants 1 arg");
}
- return(C_TO_XEN_DOUBLE(mus_phase_vocoder_with_editors(XEN_TO_MUS_ANY(obj), NULL, analyze, edit, synthesize)));
+ return(C_double_to_Xen_real(mus_phase_vocoder_with_editors(g, NULL, analyze, edit, synthesize)));
}
- return(C_TO_XEN_DOUBLE(mus_phase_vocoder(XEN_TO_MUS_ANY(obj), NULL)));
+ return(C_double_to_Xen_real(mus_phase_vocoder(g, NULL)));
}
-static XEN g_make_phase_vocoder(XEN arglist)
+static Xen g_make_phase_vocoder(Xen arglist)
{
#if HAVE_SCHEME
#define pv_example "(" S_make_phase_vocoder " #f 512 4 256 1.0 #f #f #f)"
@@ -7419,7 +8897,7 @@ static XEN g_make_phase_vocoder(XEN arglist)
lambda: <{ v -- r }> \"resynthesizing\" snd-print drop 0.0 ; " S_make_phase_vocoder
#endif
- #define H_make_phase_vocoder "(" S_make_phase_vocoder " :input :fft-size :overlap :interp :pitch :analyze :edit :synthesize): \
+ #define H_make_phase_vocoder "(" S_make_phase_vocoder " input fft-size overlap interp pitch analyze edit synthesize): \
return a new phase-vocoder generator; input is the input function (it can be set at run-time), analyze, edit, \
and synthesize are either " PROC_FALSE " or functions that replace the default innards of the generator, fft-size, overlap \
and interp set the fftsize, the amount of overlap between ffts, and the time between new analysis calls. \
@@ -7428,14 +8906,14 @@ code is also called. 'edit', if given, takes 1 arg, the generator; if it return
is run. 'synthesize' is a function of 1 arg, the generator; it is called to get the current vocoder \
output. \n\n " pv_example "\n\n " pv_edit_example
- XEN in_obj = XEN_UNDEFINED, edit_obj = XEN_UNDEFINED, synthesize_obj = XEN_UNDEFINED, analyze_obj = XEN_UNDEFINED;
+ Xen in_obj = Xen_undefined, edit_obj = Xen_undefined, synthesize_obj = Xen_undefined, analyze_obj = Xen_undefined;
mus_xen *gn;
mus_any *ge;
- XEN args[MAX_ARGLIST_LEN];
- XEN keys[8];
- XEN pv_obj;
+ Xen args[16];
+ Xen keys[8];
+ Xen pv_obj;
int orig_arg[8] = {0, 0, 0, 0, 0, 0, 0, 0};
- int vals, arglist_len, i;
+ int vals;
int fft_size = 512, overlap = 4, interp = 128;
mus_float_t pitch = 1.0;
@@ -7448,57 +8926,59 @@ output. \n\n " pv_example "\n\n " pv_edit_example
keys[6] = kw_edit;
keys[7] = kw_synthesize;
- arglist_len = XEN_LIST_LENGTH(arglist);
- if (arglist_len > MAX_ARGLIST_LEN)
- clm_error(S_make_phase_vocoder, "too many args!", arglist);
-
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
- for (i = arglist_len; i < MAX_ARGLIST_LEN; i++) args[i] = XEN_UNDEFINED;
+ {
+ int i, arglist_len;
+ Xen p;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 16) clm_error(S_make_phase_vocoder, "too many arguments!", arglist);
+ for (i = 0, p = arglist; i < arglist_len; i++, p = Xen_cdr(p)) args[i] = Xen_car(p);
+ for (i = arglist_len; i < 16; i++) args[i] = Xen_undefined;
+ }
vals = mus_optkey_unscramble(S_make_phase_vocoder, 8, keys, args, orig_arg);
if (vals > 0)
{
- in_obj = mus_optkey_to_input_procedure(keys[0], S_make_phase_vocoder, orig_arg[0], XEN_UNDEFINED, 1, S_phase_vocoder " input procedure takes 1 arg");
+ in_obj = mus_optkey_to_input_procedure(keys[0], S_make_phase_vocoder, orig_arg[0], Xen_undefined, 1, S_phase_vocoder " input procedure takes 1 arg");
- fft_size = mus_optkey_to_int(keys[1], S_make_phase_vocoder, orig_arg[1], fft_size);
+ fft_size = Xen_optkey_to_int(kw_fft_size, keys[1], S_make_phase_vocoder, orig_arg[1], fft_size);
if (fft_size <= 1)
- XEN_OUT_OF_RANGE_ERROR(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size ~A <= 1?");
+ Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size <= 1?");
if (fft_size > mus_max_malloc())
- XEN_OUT_OF_RANGE_ERROR(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size ~A too large (see mus-max-malloc)");
- if (!POWER_OF_2_P(fft_size))
- XEN_OUT_OF_RANGE_ERROR(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size ~A must be power of 2");
+ Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size too large (see mus-max-malloc)");
+ if (!is_power_of_2(fft_size))
+ Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[1], keys[1], "fft size must be power of 2");
- overlap = mus_optkey_to_int(keys[2], S_make_phase_vocoder, orig_arg[2], overlap);
+ overlap = Xen_optkey_to_int(kw_overlap, keys[2], S_make_phase_vocoder, orig_arg[2], overlap);
if (overlap <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_phase_vocoder, orig_arg[2], keys[2], "overlap ~A <= 0?");
+ Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[2], keys[2], "overlap <= 0?");
- interp = mus_optkey_to_int(keys[3], S_make_phase_vocoder, orig_arg[3], interp);
+ interp = Xen_optkey_to_int(kw_interp, keys[3], S_make_phase_vocoder, orig_arg[3], interp);
if (interp <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_phase_vocoder, orig_arg[3], keys[3], "interp ~A <= 0?");
+ Xen_out_of_range_error(S_make_phase_vocoder, orig_arg[3], keys[3], "interp <= 0?");
- pitch = mus_optkey_to_float(keys[4], S_make_phase_vocoder, orig_arg[4], pitch);
+ pitch = Xen_optkey_to_float(kw_pitch, keys[4], S_make_phase_vocoder, orig_arg[4], pitch);
- analyze_obj = mus_optkey_to_procedure(keys[5], S_make_phase_vocoder, orig_arg[5], XEN_UNDEFINED, 2, S_phase_vocoder " analyze procedure takes 2 args");
- edit_obj = mus_optkey_to_procedure(keys[6], S_make_phase_vocoder, orig_arg[6], XEN_UNDEFINED, 1, S_phase_vocoder " edit procedure takes 1 arg");
- synthesize_obj = mus_optkey_to_procedure(keys[7], S_make_phase_vocoder, orig_arg[7], XEN_UNDEFINED, 1, S_phase_vocoder " synthesize procedure takes 1 arg");
+ analyze_obj = mus_optkey_to_procedure(keys[5], S_make_phase_vocoder, orig_arg[5], Xen_undefined, 2, S_phase_vocoder " analyze procedure takes 2 args");
+ edit_obj = mus_optkey_to_procedure(keys[6], S_make_phase_vocoder, orig_arg[6], Xen_undefined, 1, S_phase_vocoder " edit procedure takes 1 arg");
+ synthesize_obj = mus_optkey_to_procedure(keys[7], S_make_phase_vocoder, orig_arg[7], Xen_undefined, 1, S_phase_vocoder " synthesize procedure takes 1 arg");
}
- gn = (mus_xen *)calloc(1, sizeof(mus_xen));
+ gn = mx_alloc(MUS_MAX_VCTS);
+ {int i; for (i = 0; i < MUS_MAX_VCTS; i++) gn->vcts[i] = Xen_undefined;}
{
mus_error_handler_t *old_error_handler;
old_error_handler = mus_error_set_handler(local_mus_error);
- ge = mus_make_phase_vocoder((MUS_XEN_P(in_obj)) ? as_needed_input_generator : as_needed_input_func,
+ ge = mus_make_phase_vocoder(NULL,
fft_size, overlap, interp, pitch,
- (XEN_NOT_BOUND_P(analyze_obj) ? NULL : pvanalyze),
- (XEN_NOT_BOUND_P(edit_obj) ? NULL : pvedit),
- (XEN_NOT_BOUND_P(synthesize_obj) ? NULL : pvsynthesize),
+ (!Xen_is_bound(analyze_obj) ? NULL : pvanalyze),
+ (!Xen_is_bound(edit_obj) ? NULL : pvedit),
+ (!Xen_is_bound(synthesize_obj) ? NULL : pvsynthesize),
(void *)gn);
mus_error_set_handler(old_error_handler);
}
+
if (ge)
{
- gn->nvcts = MUS_MAX_VCTS;
- gn->vcts = make_vcts(gn->nvcts);
gn->vcts[MUS_INPUT_FUNCTION] = in_obj;
gn->vcts[MUS_EDIT_FUNCTION] = edit_obj;
gn->vcts[MUS_ANALYZE_FUNCTION] = analyze_obj;
@@ -7507,378 +8987,614 @@ output. \n\n " pv_example "\n\n " pv_edit_example
pv_obj = mus_xen_to_object(gn);
/* need scheme-relative backpointer for possible function calls */
gn->vcts[MUS_SELF_WRAPPER] = pv_obj;
+ set_as_needed_input_choices(ge, in_obj, gn);
return(pv_obj);
}
+
+ free(gn->vcts);
free(gn);
- return(clm_mus_error(local_error_type, local_error_msg));
+ return(clm_mus_error(local_error_type, local_error_msg, S_make_phase_vocoder));
}
-static XEN g_phase_vocoder_amps(XEN pv)
+static Xen g_phase_vocoder_amps(Xen pv)
{
- #define H_phase_vocoder_amps "(" S_phase_vocoder_amps " gen): vct containing the current output sinusoid amplitudes"
+ #define H_phase_vocoder_amps "(" S_phase_vocoder_amps " gen): " S_vct " containing the current output sinusoid amplitudes"
mus_float_t *amps;
int len;
mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(pv)) && (mus_phase_vocoder_p(XEN_TO_MUS_ANY(pv))), pv, XEN_ONLY_ARG, S_phase_vocoder_amps, "a " S_phase_vocoder " generator");
+ Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_amps, "a " S_phase_vocoder " generator");
- gn = XEN_TO_MUS_XEN(pv);
+ gn = Xen_to_mus_xen(pv);
amps = mus_phase_vocoder_amps(gn->gen);
len = (int)mus_length(gn->gen);
return(xen_make_vct_wrapper(len / 2, amps));
}
-static XEN g_phase_vocoder_freqs(XEN pv)
+static Xen g_phase_vocoder_freqs(Xen pv)
{
- #define H_phase_vocoder_freqs "(" S_phase_vocoder_freqs " gen): vct containing the current output sinusoid frequencies"
+ #define H_phase_vocoder_freqs "(" S_phase_vocoder_freqs " gen): " S_vct " containing the current output sinusoid frequencies"
mus_float_t *amps;
int len;
mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(pv)) && (mus_phase_vocoder_p(XEN_TO_MUS_ANY(pv))), pv, XEN_ONLY_ARG, S_phase_vocoder_freqs, "a " S_phase_vocoder " generator");
+ Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_freqs, "a " S_phase_vocoder " generator");
- gn = XEN_TO_MUS_XEN(pv);
+ gn = Xen_to_mus_xen(pv);
amps = mus_phase_vocoder_freqs(gn->gen);
len = (int)mus_length(gn->gen);
return(xen_make_vct_wrapper(len, amps));
}
-static XEN g_phase_vocoder_phases(XEN pv)
+static Xen g_phase_vocoder_phases(Xen pv)
{
- #define H_phase_vocoder_phases "(" S_phase_vocoder_phases " gen): vct containing the current output sinusoid phases"
+ #define H_phase_vocoder_phases "(" S_phase_vocoder_phases " gen): " S_vct " containing the current output sinusoid phases"
mus_float_t *amps;
int len;
mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(pv)) && (mus_phase_vocoder_p(XEN_TO_MUS_ANY(pv))), pv, XEN_ONLY_ARG, S_phase_vocoder_phases, "a " S_phase_vocoder " generator");
+ Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_phases, "a " S_phase_vocoder " generator");
- gn = XEN_TO_MUS_XEN(pv);
+ gn = Xen_to_mus_xen(pv);
amps = mus_phase_vocoder_phases(gn->gen);
len = (int)mus_length(gn->gen);
return(xen_make_vct_wrapper(len / 2, amps));
}
-static XEN g_phase_vocoder_amp_increments(XEN pv)
+static Xen g_phase_vocoder_amp_increments(Xen pv)
{
- #define H_phase_vocoder_amp_increments "(" S_phase_vocoder_amp_increments " gen): vct containing the current output sinusoid amplitude increments per sample"
+ #define H_phase_vocoder_amp_increments "(" S_phase_vocoder_amp_increments " gen): " S_vct " containing the current output sinusoid amplitude increments per sample"
mus_float_t *amps;
int len;
mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(pv)) && (mus_phase_vocoder_p(XEN_TO_MUS_ANY(pv))), pv, XEN_ONLY_ARG, S_phase_vocoder_amp_increments, "a " S_phase_vocoder " generator");
+ Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_amp_increments, "a " S_phase_vocoder " generator");
- gn = XEN_TO_MUS_XEN(pv);
+ gn = Xen_to_mus_xen(pv);
amps = mus_phase_vocoder_amp_increments(gn->gen);
len = (int)mus_length(gn->gen);
return(xen_make_vct_wrapper(len, amps));
}
-static XEN g_phase_vocoder_phase_increments(XEN pv)
+static Xen g_phase_vocoder_phase_increments(Xen pv)
{
- #define H_phase_vocoder_phase_increments "(" S_phase_vocoder_phase_increments " gen): vct containing the current output sinusoid phase increments"
+ #define H_phase_vocoder_phase_increments "(" S_phase_vocoder_phase_increments " gen): " S_vct " containing the current output sinusoid phase increments"
mus_float_t *amps;
int len;
mus_xen *gn;
- XEN_ASSERT_TYPE((MUS_XEN_P(pv)) && (mus_phase_vocoder_p(XEN_TO_MUS_ANY(pv))), pv, XEN_ONLY_ARG, S_phase_vocoder_phase_increments, "a " S_phase_vocoder " generator");
+ Xen_check_type((mus_is_xen(pv)) && (mus_is_phase_vocoder(Xen_to_mus_any(pv))), pv, 1, S_phase_vocoder_phase_increments, "a " S_phase_vocoder " generator");
- gn = XEN_TO_MUS_XEN(pv);
+ gn = Xen_to_mus_xen(pv);
amps = mus_phase_vocoder_phase_increments(gn->gen);
len = (int)mus_length(gn->gen);
return(xen_make_vct_wrapper(len / 2, amps));
}
-static XEN g_mus_hop(XEN obj)
+
+
+/* -------- ssb-am -------- */
+
+static Xen g_is_ssb_am(Xen obj)
{
- #define H_mus_hop "(" S_mus_hop " gen): gen's " S_mus_hop " field"
- if (XEN_LIST_P(obj)) return(call_get_method(obj, S_mus_hop));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ONLY_ARG, S_mus_hop, "a generator");
- return(C_TO_XEN_INT64_T(mus_hop(XEN_TO_MUS_ANY(obj))));
+ #define H_is_ssb_am "(" S_is_ssb_am " gen): " PROC_TRUE " if gen is a " S_ssb_am
+ return(C_bool_to_Xen_boolean((mus_is_xen(obj)) && (mus_is_ssb_am(Xen_to_mus_any(obj)))));
+}
+
+
+static Xen g_make_ssb_am(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
+{
+ #define H_make_ssb_am "(" S_make_ssb_am " (frequency *clm-default-frequency*) (order 40)): \
+return a new " S_ssb_am " generator."
+ #define MUS_MAX_SSB_ORDER 65536
+
+ mus_any *ge;
+ Xen args[4];
+ Xen keys[2];
+ int orig_arg[2] = {0, 0};
+ int vals;
+ int order = 40;
+ mus_float_t freq;
+
+ freq = clm_default_frequency;
+
+ keys[0] = kw_frequency;
+ keys[1] = kw_order;
+ args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
+
+ vals = mus_optkey_unscramble(S_make_ssb_am, 2, keys, args, orig_arg);
+ if (vals > 0)
+ {
+ freq = Xen_optkey_to_float(kw_frequency, keys[0], S_make_ssb_am, orig_arg[0], freq);
+ if (freq > (0.5 * mus_srate()))
+ Xen_out_of_range_error(S_make_ssb_am, orig_arg[0], keys[0], "freq > srate/2?");
+
+ order = Xen_optkey_to_int(kw_order, keys[1], S_make_ssb_am, orig_arg[1], order);
+ if (order <= 0)
+ Xen_out_of_range_error(S_make_ssb_am, orig_arg[1], keys[1], "order <= 0?");
+ if (order > MUS_MAX_SSB_ORDER)
+ Xen_out_of_range_error(S_make_ssb_am, orig_arg[1], keys[1], "order too large?");
+ }
+
+ ge = mus_make_ssb_am(freq, order);
+ if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
+ return(Xen_false);
+}
+
+
+static Xen g_ssb_am(Xen obj, Xen insig, Xen fm)
+{
+ #define H_ssb_am "(" S_ssb_am " gen (insig 0.0) (fm 0.0)): get the next sample from " S_ssb_am " generator"
+
+ mus_float_t insig1 = 0.0;
+ mus_any *g = NULL;
+ mus_xen *gn;
+
+ Xen_to_C_generator(obj, gn, g, mus_is_ssb_am, S_ssb_am, "an ssb-am generator");
+ Xen_real_to_C_double_if_bound(insig, insig1, S_ssb_am, 2);
+
+ if (Xen_is_bound(fm))
+ {
+ Xen_check_type(Xen_is_number(fm), fm, 3, S_ssb_am, "a number");
+ return(C_double_to_Xen_real(mus_ssb_am(g, insig1, Xen_real_to_C_double(fm))));
+ }
+ return(C_double_to_Xen_real(mus_ssb_am_unmodulated(g, insig1)));
}
-static XEN g_mus_set_hop(XEN obj, XEN val)
+#define S_mus_frandom "mus-frandom"
+#define S_mus_irandom "mus-irandom"
+
+static Xen g_mus_frandom(Xen val)
{
- if (XEN_LIST_P(obj)) return(call_set_method(obj, val, S_mus_hop));
- XEN_ASSERT_TYPE(MUS_XEN_P(obj), obj, XEN_ARG_1, S_setB S_mus_hop, "a generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_mus_hop, "a number");
- return(C_TO_XEN_INT64_T(mus_set_hop(XEN_TO_MUS_ANY(obj), XEN_TO_C_INT64_T_OR_ELSE(val, 0))));
+ return(C_double_to_Xen_real(mus_frandom(Xen_real_to_C_double_with_caller(val, S_mus_frandom))));
}
+static Xen g_mus_irandom(Xen val)
+{
+ mus_long_t ind;
+ Xen_to_C_integer_or_error(val, ind, S_mus_irandom, 1);
+ return(C_int_to_Xen_integer(mus_irandom(ind)));
+}
+static Xen mus_clm_output(void);
+static Xen mus_clm_reverb(void);
-/* ---------------- mix ---------------- */
-static XEN g_mus_mix(XEN out, XEN in, XEN ost, XEN olen, XEN ist, XEN mx, XEN envs)
+/* Xen out, Xen in, Xen ost, Xen olen, Xen ist, Xen mx, Xen envs */
+static Xen g_mus_file_mix(Xen args)
{
- #define H_mus_mix "(" S_mus_mix " outfile infile :optional (outloc 0) (frames) (inloc 0) mixer envs): \
+ #define H_mus_file_mix "(" S_mus_file_mix " outfile infile (outloc 0) (framples) (inloc 0) matrix envs): \
mix infile into outfile starting at outloc in outfile and inloc in infile \
-mixing 'frames' frames into 'outfile'. frames defaults to the length of infile. If mixer, \
+mixing 'framples' framples into 'outfile'. framples defaults to the length of infile. If matrix, \
use it to scale the various channels; if envs (an array of envelope generators), use \
-it in conjunction with mixer to scale/envelope all the various ins and outs. \
-'outfile' can also be a " S_frame_to_file " generator, and 'infile' can be a " S_file_to_frame " generator."
+it in conjunction with matrix to scale/envelope all the various ins and outs. \
+'outfile' can also be a " S_frample_to_file " generator, and 'infile' can be a " S_file_to_frample " generator."
+ Xen arg, out, in;
mus_any *outf = NULL, *inf = NULL;
- mus_any *mx1 = NULL;
+ mus_float_t *matrix = NULL;
mus_any ***envs1 = NULL;
int i;
mus_long_t ostart = 0, istart = 0, osamps = 0;
- int in_chans = 0, out_chans = 0, in_size = 0, out_size; /* mus_mix in clm.c assumes the envs array is large enough */
-
- XEN_ASSERT_TYPE(XEN_STRING_P(out) || ((MUS_XEN_P(out)) && (mus_output_p(XEN_TO_MUS_ANY(out)))),
- out, XEN_ARG_1, S_mus_mix, "a filename or a frame->file generator");
- XEN_ASSERT_TYPE(XEN_STRING_P(in) || ((MUS_XEN_P(in)) && (mus_input_p(XEN_TO_MUS_ANY(in)))),
- in, XEN_ARG_2, S_mus_mix, "a filename or a file->frame generator");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(ost), ost, XEN_ARG_3, S_mus_mix, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(olen), olen, XEN_ARG_4, S_mus_mix, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(ist), ist, XEN_ARG_5, S_mus_mix, "a number");
- XEN_ASSERT_TYPE((XEN_NOT_BOUND_P(mx)) || (XEN_FALSE_P(mx)) || ((MUS_XEN_P(mx)) && (mus_mixer_p(XEN_TO_MUS_ANY(mx)))), mx, XEN_ARG_6, S_mus_mix, "a mixer");
- XEN_ASSERT_TYPE((XEN_NOT_BOUND_P(envs)) || (XEN_FALSE_P(envs)) || (XEN_VECTOR_P(envs)), envs, XEN_ARG_7, S_mus_mix, "an env gen or vector of envs");
- if (XEN_BOUND_P(ost)) ostart = XEN_TO_C_INT64_T_OR_ELSE(ost, 0);
- if (XEN_BOUND_P(ist)) istart = XEN_TO_C_INT64_T_OR_ELSE(ist, 0);
- if ((XEN_BOUND_P(mx)) && (MUS_XEN_P(mx))) mx1 = (mus_any *)XEN_TO_MUS_ANY(mx);
- if (XEN_STRING_P(out))
- {
- const char *tmp_outf = NULL;
- tmp_outf = XEN_TO_C_STRING(out);
- if (!mus_file_probe(tmp_outf))
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_2(C_TO_XEN_STRING(S_mus_mix ": no such file, ~S"),
- out));
- else out_chans = mus_sound_chans(tmp_outf);
+ int in_chans = 0, out_chans = 0, mx_chans = 0, in_size = 0; /* mus_mix in clm.c assumes the envs array is large enough */
+ const char *outfile = NULL, *infile = NULL;
+
+ /* -------- setup output gen -------- */
+ arg = args;
+ out = Xen_car(arg);
+ Xen_check_type(Xen_is_string(out) || ((mus_is_xen(out)) && (mus_is_output(Xen_to_mus_any(out)))),
+ out, 1, S_mus_file_mix, "a filename or a " S_frample_to_file " generator");
+ if (Xen_is_string(out))
+ {
+ outfile = Xen_string_to_C_string(out);
+ if (!mus_file_probe(outfile))
+ Xen_error(NO_SUCH_FILE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": no such file, ~S"), out));
+ out_chans = mus_sound_chans(outfile);
+ if (out_chans <= 0)
+ Xen_error(BAD_HEADER, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": ~S output chans <= 0"), out));
}
else
{
- outf = XEN_TO_MUS_ANY(out);
+ outf = Xen_to_mus_any(out);
out_chans = mus_channels(outf);
}
- if (out_chans <= 0)
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_2(C_TO_XEN_STRING(S_mus_mix ": ~S output chans <= 0"),
- out));
-
- if (XEN_STRING_P(in))
+ /* -------- setup input gen -------- */
+ arg = Xen_cdr(arg);
+ in = Xen_car(arg);
+ Xen_check_type(Xen_is_string(in) || ((mus_is_xen(in)) && (mus_is_input(Xen_to_mus_any(in)))),
+ in, 2, S_mus_file_mix, "a filename or a " S_file_to_frample " generator");
+ if (Xen_is_string(in))
{
- const char *tmp_inf = NULL;
- tmp_inf = XEN_TO_C_STRING(in);
- if (!mus_file_probe(tmp_inf))
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_2(C_TO_XEN_STRING(S_mus_mix ": no such file, ~S"),
- in));
- else in_chans = mus_sound_chans(tmp_inf);
+ infile = Xen_string_to_C_string(in);
+ if (!mus_file_probe(infile))
+ Xen_error(NO_SUCH_FILE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": no such file, ~S"), in));
+ in_chans = mus_sound_chans(infile);
+ if (in_chans <= 0)
+ Xen_error(BAD_HEADER, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": ~S input chans <= 0"), in));
+ osamps = mus_sound_framples(infile);
}
else
{
- inf = XEN_TO_MUS_ANY(in);
+ inf = Xen_to_mus_any(in);
in_chans = mus_channels(inf);
+ osamps = mus_length(inf);
}
- if (in_chans <= 0)
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_2(C_TO_XEN_STRING(S_mus_mix ": ~S input chans <= 0"),
- in));
-
- if (XEN_BOUND_P(olen))
- osamps = XEN_TO_C_INT64_T_OR_ELSE(olen, 0);
- else
- {
- if (XEN_STRING_P(in))
- osamps = mus_sound_frames(XEN_TO_C_STRING(in));
- else osamps = mus_length(inf);
- if (osamps < 0)
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_2(C_TO_XEN_STRING(S_mus_mix ": ~S input frames < 0"),
- in));
- }
- if (osamps == 0) return(XEN_FALSE);
+ /* inf and outf only exist during the rest of the arglist scan if not infile or outfile.
+ * we need to delay making the inf/outf gens in this case to greatly simplify error handling.
+ */
- if ((XEN_BOUND_P(envs)) && (!(XEN_FALSE_P(envs))))
+ /* rest of args are optional */
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
{
- int in_len = 0, out_len, j;
- /* pack into a C-style array of arrays of env pointers */
- in_len = XEN_VECTOR_LENGTH(envs);
+ Xen ost;
+ ost = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(ost), ost, 3, S_mus_file_mix, "an integer");
+ ostart = Xen_llong_to_C_llong(ost);
- if (in_len == 0)
- XEN_ERROR(BAD_TYPE,
- XEN_LIST_2(C_TO_XEN_STRING(S_mus_mix ": env vector, ~A, can't be empty"),
- envs));
-
- for (i = 0; i < in_len; i++)
- {
- XEN datum;
- datum = XEN_VECTOR_REF(envs, i);
- if (!(XEN_VECTOR_P(datum)))
- XEN_ERROR(BAD_TYPE,
- XEN_LIST_2(C_TO_XEN_STRING(S_mus_mix ": each element of env vector, ~A, must be a vector (of envelopes)"),
- datum));
- }
- out_len = XEN_VECTOR_LENGTH(XEN_VECTOR_REF(envs, 0));
- if (in_len < in_chans) in_size = in_chans; else in_size = in_len;
- if (out_len < out_chans) out_size = out_chans; else out_size = out_len;
- envs1 = (mus_any ***)calloc(in_size, sizeof(mus_any **));
- for (i = 0; i < in_size; i++) envs1[i] = (mus_any **)calloc(out_size, sizeof(mus_any *));
- for (i = 0; i < in_len; i++)
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
{
- for (j = 0; j < out_len; j++)
+ Xen olen;
+ olen = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(olen), olen, 4, S_mus_file_mix, "an integer");
+ osamps = Xen_llong_to_C_llong(olen);
+ if (osamps <= 0) return(Xen_false);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
{
- XEN datum1;
- datum1 = XEN_VECTOR_REF(XEN_VECTOR_REF(envs, i), j);
- if (MUS_XEN_P(datum1))
+ Xen ist;
+ ist = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(ist), ist, 5, S_mus_file_mix, "an integer");
+ istart = Xen_llong_to_C_llong(ist);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
{
- if (mus_env_p(XEN_TO_MUS_ANY(datum1)))
- envs1[i][j] = XEN_TO_MUS_ANY(datum1);
- else
+ Xen mx;
+ mx = Xen_car(arg);
+ Xen_check_type((mus_is_vct(mx)) || (Xen_is_false(mx)), mx, 6, S_mus_file_mix, "a " S_vct);
+ if (mus_is_vct(mx))
+ {
+ matrix = mus_vct_data(Xen_to_vct(mx));
+ mx_chans = (int)sqrt(mus_vct_length(Xen_to_vct(mx)));
+ }
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
{
- for (i = 0; i < in_size; i++) if (envs1[i]) free(envs1[i]);
- free(envs1);
- XEN_ERROR(BAD_TYPE,
- XEN_LIST_4(C_TO_XEN_STRING(S_mus_mix ": each (non " PROC_FALSE ") element of (inner) envs vector, ~A at ~A ~A, must be an envelope"),
- datum1,
- C_TO_XEN_INT(i),
- C_TO_XEN_INT(j)));
+ Xen envs;
+ envs = Xen_car(arg);
+ Xen_check_type((Xen_is_false(envs)) || (Xen_is_vector(envs)), envs, 7, S_mus_file_mix, "a vector of envs");
+ if (Xen_is_vector(envs))
+ {
+ int in_len = 0, out_len, j, out_size;
+ /* pack into a C-style array of arrays of env pointers */
+ in_len = Xen_vector_length(envs);
+ if (in_len == 0)
+ Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": env vector, ~A, can't be empty"), envs));
+
+ for (i = 0; i < in_len; i++)
+ {
+ Xen datum;
+ datum = Xen_vector_ref(envs, i);
+ if (!(Xen_is_vector(datum)))
+ Xen_error(BAD_TYPE, Xen_list_2(C_string_to_Xen_string(S_mus_file_mix ": vector, ~A, must contain vectors of envelopes"), datum));
+ }
+
+ out_len = Xen_vector_length(Xen_vector_ref(envs, 0));
+ if (in_len < in_chans) in_size = in_chans; else in_size = in_len;
+ if (out_len < out_chans) out_size = out_chans; else out_size = out_len;
+
+ envs1 = (mus_any ***)malloc(in_size * sizeof(mus_any **));
+ for (i = 0; i < in_size; i++)
+ envs1[i] = (mus_any **)calloc(out_size, sizeof(mus_any *));
+
+ for (i = 0; i < in_len; i++)
+ for (j = 0; j < out_len; j++)
+ {
+ Xen datum1;
+ datum1 = Xen_vector_ref(Xen_vector_ref(envs, i), j);
+ if (mus_is_xen(datum1))
+ {
+ if (mus_is_env(Xen_to_mus_any(datum1)))
+ envs1[i][j] = Xen_to_mus_any(datum1);
+ else
+ {
+ for (i = 0; i < in_size; i++) if (envs1[i]) free(envs1[i]);
+ free(envs1);
+ Xen_error(BAD_TYPE, Xen_list_4(C_string_to_Xen_string(S_mus_file_mix ": vector, ~A at ~A ~A, must contain an envelope"),
+ datum1,
+ C_int_to_Xen_integer(i),
+ C_int_to_Xen_integer(j)));
+ }
+ }
+ }
+ }
}
}
}
}
}
- {
- char *outfile = NULL, *infile = NULL;
- if (XEN_STRING_P(out)) outfile = mus_strdup(XEN_TO_C_STRING(out));
- if (XEN_STRING_P(in)) infile = mus_strdup(XEN_TO_C_STRING(in));
- if ((infile) && (outfile))
- mus_mix(outfile, infile, ostart, osamps, istart, mx1, envs1);
- else
- {
- if (infile)
- inf = mus_make_file_to_frame(infile);
- if (outfile)
- outf = mus_continue_sample_to_file(outfile);
- mus_mix_with_reader_and_writer(outf, inf, ostart, osamps, istart, mx1, envs1);
- if (infile)
- mus_free((mus_any *)inf);
- if (outfile)
- mus_free((mus_any *)outf);
- }
- if (envs1)
- {
- for (i = 0; i < in_size; i++) if (envs1[i]) free(envs1[i]);
- free(envs1);
- }
- if (infile) free(infile);
- if (outfile) free(outfile);
- }
- return(XEN_TRUE);
+ if ((infile) && (outfile))
+ mus_file_mix(outfile, infile, ostart, osamps, istart, matrix, mx_chans, envs1);
+ else
+ {
+ if (infile)
+ inf = mus_make_file_to_frample(infile);
+ if (outfile)
+ outf = mus_continue_sample_to_file(outfile);
+ mus_file_mix_with_reader_and_writer(outf, inf, ostart, osamps, istart, matrix, mx_chans, envs1);
+ if (infile)
+ mus_free((mus_any *)inf);
+ if (outfile)
+ mus_free((mus_any *)outf);
+ }
+ if (envs1)
+ {
+ for (i = 0; i < in_size; i++) if (envs1[i]) free(envs1[i]);
+ free(envs1);
+ }
+ return(Xen_true);
}
+/* Xen file, Xen beg, Xen dur, Xen mx, Xen revmx, Xen envs, Xen srcs, Xen srcenv, Xen outstream, Xen revstream */
+static Xen g_mus_file_mix_with_envs(Xen args)
+{
+ #define H_mus_file_mix_with_envs "(" S_mus_file_mix_with_envs " file beg dur mx revmx envs srcs srcenv out rev) is an extension of " S_mus_file_mix ", primarily \
+intended to speed up the fullmix instrument. file is a vector of readin generators. beg is the sample at which to start mixing \
+output, dur is the number of samples to write. mx is a matrix, revmx is either #f or a matrix. "
-/* -------- ssb-am -------- */
+ int i, in_chans, out_chans, mx_chans = 0, rev_chans = 0, rev_mix_chans = 0;
+ mus_long_t st, nd;
+ mus_any *s_env = NULL, *ostr, *rstr = NULL;
+ mus_any **mix_envs, **mix_srcs, **mix_rds;
+ mus_xen *gn;
+ Xen ve, arg, file, beg, dur, mx, revmx, envs, srcs, srcenv, outstream, revstream;
+ mus_float_t *mix = NULL, *rev_mix = NULL;
-static XEN g_ssb_am_p(XEN obj)
-{
- #define H_ssb_am_p "(" S_ssb_am_p " gen): " PROC_TRUE " if gen is a " S_ssb_am
- return(C_TO_XEN_BOOLEAN((MUS_XEN_P(obj)) && (mus_ssb_am_p(XEN_TO_MUS_ANY(obj)))));
-}
+ i = Xen_list_length(args);
+ if ((i < 8) || (i > 10)) /* no wrong-number-of-args error in xen.h, so I'll use out-of-range */
+ Xen_out_of_range_error(S_mus_file_mix_with_envs, 0, args, "wrong number of args");
+
+ arg = args;
+ file = Xen_car(arg);
+ Xen_check_type(Xen_is_vector(file), file, 1, S_mus_file_mix_with_envs, "a vector of readin generators");
+ in_chans = Xen_vector_length(file);
+
+ arg = Xen_cdr(arg);
+ beg = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(beg), beg, 2, S_mus_file_mix_with_envs, "an integer");
+ st = Xen_integer_to_C_int(beg);
+ arg = Xen_cdr(arg);
+ dur = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(dur), dur, 3, S_mus_file_mix_with_envs, "an integer");
+ nd = st + Xen_integer_to_C_int(dur);
-static XEN g_make_ssb_am(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_make_ssb_am "(" S_make_ssb_am " (:frequency *clm-default-frequency*) (:order 40)): \
-return a new " S_ssb_am " generator."
- #define MUS_MAX_SSB_ORDER 65536
+ arg = Xen_cdr(arg);
+ mx = Xen_car(arg);
+ if (mus_is_vct(mx))
+ {
+ mix = mus_vct_data(Xen_to_vct(mx));
+ mx_chans = (int)sqrt(mus_vct_length(Xen_to_vct(mx)));
+ }
- mus_any *ge;
- XEN args[4];
- XEN keys[2];
- int orig_arg[2] = {0, 0};
- int vals;
- int order = 40;
- mus_float_t freq;
+ arg = Xen_cdr(arg);
+ revmx = Xen_car(arg);
+ if (mus_is_vct(revmx))
+ {
+ rev_mix = mus_vct_data(Xen_to_vct(revmx));
+ rev_mix_chans = (int)sqrt(mus_vct_length(Xen_to_vct(revmx)));
+ }
- freq = clm_default_frequency;
+ arg = Xen_cdr(arg);
+ envs = Xen_car(arg);
+ if (!Xen_is_false(envs))
+ Xen_check_type(Xen_is_vector(envs), envs, 6, S_mus_file_mix_with_envs, "a vector of env generators");
- keys[0] = kw_frequency;
- keys[1] = kw_order;
- args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4;
+ arg = Xen_cdr(arg);
+ srcs = Xen_car(arg);
+ if (!Xen_is_false(srcs))
+ Xen_check_type(Xen_is_vector(srcs), srcs, 7, S_mus_file_mix_with_envs, "a vector of src generators");
- vals = mus_optkey_unscramble(S_make_ssb_am, 2, keys, args, orig_arg);
- if (vals > 0)
+ arg = Xen_cdr(arg);
+ srcenv = Xen_car(arg);
+ if (!Xen_is_false(srcenv))
{
- freq = mus_optkey_to_float(keys[0], S_make_ssb_am, orig_arg[0], freq);
- if (freq > (0.5 * mus_srate()))
- XEN_OUT_OF_RANGE_ERROR(S_make_ssb_am, orig_arg[0], keys[0], "freq ~A > srate/2?");
-
- order = mus_optkey_to_int(keys[1], S_make_ssb_am, orig_arg[1], order);
- if (order <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_ssb_am, orig_arg[1], keys[1], "order ~A <= 0?");
- if (order > MUS_MAX_SSB_ORDER)
- XEN_OUT_OF_RANGE_ERROR(S_make_ssb_am, orig_arg[1], keys[1], "order ~A too large?");
+ gn = (mus_xen *)Xen_object_ref_checked(srcenv, mus_xen_tag);
+ if (!gn) Xen_check_type(false, srcenv, 8, S_mus_file_mix_with_envs, "an env generator");
+ s_env = gn->gen;
+ Xen_check_type(mus_is_env(s_env), srcenv, 8, S_mus_file_mix_with_envs, "an env generator");
}
- ge = mus_make_ssb_am(freq, order);
- if (ge) return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
-}
-
+ revstream = Xen_false;
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ outstream = Xen_car(arg);
+ gn = (mus_xen *)Xen_object_ref_checked(outstream, mus_xen_tag);
+ if (!gn)
+ Xen_check_type(false, outstream, 9, S_mus_file_mix_with_envs, "an output generator");
+ ostr = gn->gen;
-static XEN g_ssb_am(XEN obj, XEN insig, XEN fm)
-{
- #define H_ssb_am "(" S_ssb_am " gen :optional (insig 0.0) (fm 0.0)): get the next sample from " S_ssb_am " generator"
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ revstream = Xen_car(arg);
+ }
+ else ostr = Xen_to_mus_any(mus_clm_output());
+ out_chans = mus_channels(ostr);
- mus_float_t insig1 = 0.0;
+ if (rev_mix)
+ {
+ if (!Xen_is_false(revstream))
+ {
+ gn = (mus_xen *)Xen_object_ref_checked(revstream, mus_xen_tag);
+ if (!gn)
+ Xen_check_type(false, revstream, 10, S_mus_file_mix_with_envs, "an output generator");
+ rstr = gn->gen;
+ }
+ else rstr = Xen_to_mus_any(mus_clm_reverb());
+ rev_chans = mus_channels(rstr);
+ }
- XEN_ASSERT_TYPE((MUS_XEN_P(obj)) && (mus_ssb_am_p(XEN_TO_MUS_ANY(obj))), obj, XEN_ARG_1, S_ssb_am, "an ssb_am generator");
+ mix_rds = (mus_any **)calloc(in_chans, sizeof(mus_any *));
+ mix_srcs = (mus_any **)calloc(in_chans, sizeof(mus_any *));
- if (XEN_NUMBER_P(insig)) insig1 = XEN_TO_C_DOUBLE(insig); else XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(insig), insig, XEN_ARG_2, S_ssb_am, "a number");
- if (XEN_BOUND_P(fm))
+ for (i = 0; i < in_chans; i++)
+ mix_rds[i] = Xen_to_mus_any(Xen_vector_ref(file, i));
+
+ if (Xen_is_vector(srcs))
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(fm), fm, XEN_ARG_3, S_ssb_am, "a number");
- return(C_TO_XEN_DOUBLE(mus_ssb_am(XEN_TO_MUS_ANY(obj), insig1, XEN_TO_C_DOUBLE(fm))));
+ for (i = 0; i < in_chans; i++)
+ {
+ ve = Xen_vector_ref(srcs, i);
+ if (!Xen_is_false(ve)) mix_srcs[i] = Xen_to_mus_any(ve);
+ }
}
- return(C_TO_XEN_DOUBLE(mus_ssb_am_unmodulated(XEN_TO_MUS_ANY(obj), insig1)));
+
+ mix_envs = (mus_any **)calloc(in_chans * out_chans, sizeof(mus_any *));
+ if (Xen_is_vector(envs))
+ for (i = 0; i < in_chans * out_chans; i++)
+ {
+ ve = Xen_vector_ref(envs, i);
+ if (!Xen_is_false(ve)) mix_envs[i] = Xen_to_mus_any(ve);
+ }
+
+ {
+ mus_long_t samp;
+ int outp;
+ mus_float_t src_env_val = 0.0;
+ mus_float_t *infs, *out_frample, *rev_frample = NULL;
+
+ infs = (mus_float_t *)calloc(in_chans, sizeof(mus_float_t));
+ out_frample = (mus_float_t *)calloc(out_chans, sizeof(mus_float_t));
+ if (rev_mix) rev_frample = (mus_float_t *)calloc(rev_chans, sizeof(mus_float_t));
+
+ if (in_chans == 1)
+ {
+ mus_any *s = NULL, *r = NULL;
+ s = mix_srcs[0];
+ if (!s) r = mix_rds[0];
+
+ for (samp = st; samp < nd; samp++)
+ {
+ for (outp = 0; outp < out_chans; outp++)
+ {
+ mus_any *e;
+ e = mix_envs[outp];
+ if (e)
+ mix[outp] = mus_env(e);
+ }
+ if (s_env)
+ src_env_val = mus_env(s_env);
+ if (s)
+ infs[0] = mus_src(s, src_env_val, NULL);
+ else
+ {
+ if (r)
+ infs[0] = mus_readin(r);
+ else infs[0] = 0.0;
+ }
+ mus_frample_to_file(ostr, samp, mus_frample_to_frample(mix, mx_chans, infs, in_chans, out_frample, out_chans));
+ if (rev_mix) mus_frample_to_file(rstr, samp, mus_frample_to_frample(rev_mix, rev_mix_chans, infs, in_chans, rev_frample, rev_chans));
+ }
+ }
+ else
+ {
+ for (samp = st; samp < nd; samp++)
+ {
+ int inp, off;
+ for (inp = 0, off = 0; inp < in_chans; inp++, off += mx_chans)
+ for (outp = 0; outp < out_chans; outp++)
+ {
+ mus_any *e;
+ e = mix_envs[inp * out_chans + outp]; /* this is different from the matrix setup -- I don't know why */
+ if (e)
+ mix[off + outp] = mus_env(e);
+ }
+ if (s_env)
+ src_env_val = mus_env(s_env);
+ for (inp = 0; inp < in_chans; inp++)
+ {
+ mus_any *s;
+ s = mix_srcs[inp];
+ if (s)
+ infs[inp] = mus_src(s, src_env_val, NULL);
+ else
+ {
+ s = mix_rds[inp];
+ if (s)
+ infs[inp] = mus_readin(s);
+ else infs[inp] = 0.0;
+ }
+ }
+ mus_frample_to_file(ostr, samp, mus_frample_to_frample(mix, mx_chans, infs, in_chans, out_frample, out_chans));
+ if (rev_mix) mus_frample_to_file(rstr, samp, mus_frample_to_frample(rev_mix, rev_mix_chans, infs, in_chans, rev_frample, rev_chans));
+ }
+ }
+ free(infs);
+ free(out_frample);
+ if (rev_frample) free(rev_frample);
+ }
+
+ free(mix_rds);
+ free(mix_srcs);
+ free(mix_envs);
+ return(Xen_false);
}
-static XEN g_ssb_bank(XEN ssbs, XEN filters, XEN inval, XEN size)
+static Xen g_frample_to_frample(Xen mx, Xen infr, Xen inchans, Xen outfr, Xen outchans)
{
- /* an experiment */
- int i, len;
- mus_float_t sum = 0.0, val = 0.0;
+ #define H_frample_to_frample "(" S_frample_to_frample " matrix in-data in-chans out-data out-chans): pass frample in-data through matrix \
+returning frample out-data; this is a matrix multiply of matrix and in-data"
+ int ins, outs, mxs;
+ vct *vin, *vout, *vmx;
- XEN_ASSERT_TYPE(XEN_VECTOR_P(ssbs), ssbs, XEN_ARG_1, "ssb-bank", "vector of " S_ssb_am " gens");
- XEN_ASSERT_TYPE(XEN_VECTOR_P(filters), filters, XEN_ARG_2, "ssb-bank", "vector of FIR filter gens");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(inval), inval, XEN_ARG_3, "ssb-bank", "number");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(size), size, XEN_ARG_4, "ssb-bank", "int");
+ Xen_check_type(mus_is_vct(mx), mx, 1, S_frample_to_frample, "a " S_vct);
+ Xen_check_type(mus_is_vct(infr), infr, 2, S_frample_to_frample, "a " S_vct);
+ Xen_check_type(mus_is_vct(outfr), outfr, 4, S_frample_to_frample, "a " S_vct);
+ Xen_check_type(Xen_is_integer(inchans), inchans, 3, S_frample_to_frample, "an integer");
+ Xen_check_type(Xen_is_integer(outchans), outchans, 5, S_frample_to_frample, "an integer");
- len = XEN_TO_C_INT(size);
- val = XEN_TO_C_DOUBLE(inval);
- for (i = 0; i < len; i++)
- sum += mus_ssb_am_unmodulated(XEN_TO_MUS_ANY(XEN_VECTOR_REF(ssbs, i)),
- mus_fir_filter(XEN_TO_MUS_ANY(XEN_VECTOR_REF(filters, i)), val));
- return(C_TO_XEN_DOUBLE(sum));
-}
+ ins = Xen_integer_to_C_int(inchans);
+ vin = Xen_to_vct(infr);
+ if (mus_vct_length(vin) < ins) ins = mus_vct_length(vin);
+ if (ins <= 0) return(outfr);
+ outs = Xen_integer_to_C_int(outchans);
+ vout = Xen_to_vct(outfr);
+ if (mus_vct_length(vout) < outs) outs = mus_vct_length(vout);
+ if (outs <= 0) return(outfr);
+
+ vmx = Xen_to_vct(mx);
+ mxs = (int)sqrt(mus_vct_length(vmx));
+
+ mus_frample_to_frample(mus_vct_data(vmx), mxs, mus_vct_data(vin), ins, mus_vct_data(vout), outs);
+ return(outfr);
+}
-#define S_mus_frandom "mus-frandom"
-#define S_mus_irandom "mus-irandom"
-static XEN g_mus_frandom(XEN val) {return(C_TO_XEN_DOUBLE(mus_frandom(XEN_TO_C_DOUBLE(val))));}
-static XEN g_mus_irandom(XEN val) {return(C_TO_XEN_INT(mus_irandom(XEN_TO_C_INT(val))));}
#if HAVE_SCHEME
-#if HAVE_GETTIMEOFDAY && HAVE_DIFFTIME && HAVE_SYS_TIME_H && (!_MSC_VER)
+#ifndef _MSC_VER
#include <time.h>
#include <sys/time.h>
@@ -7887,1157 +9603,3547 @@ static struct timeval overall_start_time;
#define S_get_internal_real_time "get-internal-real-time"
#define S_internal_time_units_per_second "internal-time-units-per-second"
-static XEN g_get_internal_real_time(void)
+static Xen g_get_internal_real_time(void)
{
#define H_get_internal_real_time "(" S_get_internal_real_time ") returns the number of seconds since \
the program started. The number is in terms of " S_internal_time_units_per_second ", usually 1"
struct timezone z0;
struct timeval t0;
- double secs;
+ mus_float_t secs;
gettimeofday(&t0, &z0);
secs = difftime(t0.tv_sec, overall_start_time.tv_sec);
- return(C_TO_XEN_DOUBLE(secs + 0.000001 * (t0.tv_usec - overall_start_time.tv_usec)));
+ return(C_double_to_Xen_real(secs + 0.000001 * (t0.tv_usec - overall_start_time.tv_usec)));
}
#else
-static XEN g_get_internal_real_time(void) {return(C_TO_XEN_DOUBLE(0.0));}
-#endif
-
-XEN_NARGIFY_0(g_get_internal_real_time_w, g_get_internal_real_time)
-#endif
-
-
-
-/* ---------------- export ---------------- */
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_mus_srate_w, g_mus_srate)
-XEN_NARGIFY_1(g_mus_set_srate_w, g_mus_set_srate)
-XEN_NARGIFY_0(g_mus_float_equal_fudge_factor_w, g_mus_float_equal_fudge_factor)
-XEN_NARGIFY_1(g_mus_set_float_equal_fudge_factor_w, g_mus_set_float_equal_fudge_factor)
-XEN_NARGIFY_0(g_mus_array_print_length_w, g_mus_array_print_length)
-XEN_NARGIFY_1(g_mus_set_array_print_length_w, g_mus_set_array_print_length)
-XEN_NARGIFY_1(g_radians_to_hz_w, g_radians_to_hz)
-XEN_NARGIFY_1(g_hz_to_radians_w, g_hz_to_radians)
-XEN_NARGIFY_1(g_radians_to_degrees_w, g_radians_to_degrees)
-XEN_NARGIFY_1(g_degrees_to_radians_w, g_degrees_to_radians)
-XEN_NARGIFY_1(g_db_to_linear_w, g_db_to_linear)
-XEN_NARGIFY_1(g_linear_to_db_w, g_linear_to_db)
-XEN_NARGIFY_1(g_seconds_to_samples_w, g_seconds_to_samples)
-XEN_NARGIFY_1(g_samples_to_seconds_w, g_samples_to_seconds)
-XEN_NARGIFY_2(g_ring_modulate_w, g_ring_modulate)
-XEN_NARGIFY_3(g_amplitude_modulate_w, g_amplitude_modulate)
-XEN_ARGIFY_2(g_contrast_enhancement_w, g_contrast_enhancement)
-XEN_ARGIFY_3(g_dot_product_w, g_dot_product)
-#if HAVE_COMPLEX_TRIG && XEN_HAVE_COMPLEX_NUMBERS
-XEN_NARGIFY_2(g_edot_product_w, g_edot_product)
-#endif
-XEN_NARGIFY_1(g_clear_array_w, g_clear_array)
-XEN_NARGIFY_2(g_polynomial_w, g_polynomial)
-XEN_ARGIFY_3(g_multiply_arrays_w, g_multiply_arrays)
-XEN_ARGIFY_4(g_make_fft_window_w, g_make_fft_window)
-XEN_ARGIFY_4(g_mus_fft_w, g_mus_fft)
-XEN_ARGIFY_4(g_spectrum_w, g_spectrum)
-XEN_NARGIFY_1(g_autocorrelate_w, g_autocorrelate)
-XEN_NARGIFY_2(g_correlate_w, g_correlate)
-XEN_ARGIFY_3(g_convolution_w, g_convolution)
-XEN_NARGIFY_2(g_rectangular_to_polar_w, g_rectangular_to_polar)
-XEN_NARGIFY_2(g_rectangular_to_magnitudes_w, g_rectangular_to_magnitudes)
-XEN_NARGIFY_2(g_polar_to_rectangular_w, g_polar_to_rectangular)
-XEN_ARGIFY_3(g_array_interp_w, g_array_interp)
-XEN_ARGIFY_5(g_mus_interpolate_w, g_mus_interpolate)
-XEN_NARGIFY_1(g_mus_describe_w, g_mus_describe)
-XEN_NARGIFY_1(g_mus_name_w, g_mus_name)
-XEN_NARGIFY_2(g_mus_set_name_w, g_mus_set_name)
-XEN_ARGIFY_3(g_mus_run_w, g_mus_run)
-XEN_NARGIFY_1(g_mus_phase_w, g_mus_phase)
-XEN_NARGIFY_2(g_mus_set_phase_w, g_mus_set_phase)
-XEN_NARGIFY_1(g_mus_width_w, g_mus_width)
-XEN_NARGIFY_2(g_mus_set_width_w, g_mus_set_width)
-XEN_NARGIFY_1(g_mus_scaler_w, g_mus_scaler)
-XEN_NARGIFY_2(g_mus_set_scaler_w, g_mus_set_scaler)
-XEN_NARGIFY_1(g_mus_safety_w, g_mus_safety)
-XEN_NARGIFY_2(g_mus_set_safety_w, g_mus_set_safety)
-XEN_NARGIFY_1(g_mus_feedforward_w, g_mus_feedforward)
-XEN_NARGIFY_2(g_mus_set_feedforward_w, g_mus_set_feedforward)
-XEN_NARGIFY_1(g_mus_reset_w, g_mus_reset)
-XEN_NARGIFY_1(g_mus_offset_w, g_mus_offset)
-XEN_NARGIFY_2(g_mus_set_offset_w, g_mus_set_offset)
-XEN_NARGIFY_1(g_mus_frequency_w, g_mus_frequency)
-XEN_NARGIFY_2(g_mus_set_frequency_w, g_mus_set_frequency)
-XEN_NARGIFY_1(g_mus_length_w, g_mus_length)
-XEN_NARGIFY_1(g_mus_file_name_w, g_mus_file_name)
-XEN_NARGIFY_2(g_mus_set_length_w, g_mus_set_length)
-XEN_NARGIFY_1(g_mus_order_w, g_mus_order)
-XEN_NARGIFY_1(g_mus_data_w, g_mus_data)
-XEN_NARGIFY_2(g_mus_set_data_w, g_mus_set_data)
-XEN_NARGIFY_1(g_oscil_p_w, g_oscil_p)
-XEN_ARGIFY_3(g_oscil_w, g_oscil)
-XEN_VARGIFY(g_mus_apply_w, g_mus_apply)
-XEN_VARGIFY(g_make_delay_w, g_make_delay)
-XEN_VARGIFY(g_make_comb_w, g_make_comb)
-XEN_VARGIFY(g_make_filtered_comb_w, g_make_filtered_comb)
-XEN_VARGIFY(g_make_notch_w, g_make_notch)
-XEN_VARGIFY(g_make_all_pass_w, g_make_all_pass)
-XEN_VARGIFY(g_make_moving_average_w, g_make_moving_average)
-XEN_ARGIFY_3(g_delay_w, g_delay)
-XEN_ARGIFY_2(g_delay_tick_w, g_delay_tick)
-XEN_ARGIFY_2(g_tap_w, g_tap)
-XEN_ARGIFY_3(g_notch_w, g_notch)
-XEN_ARGIFY_3(g_comb_w, g_comb)
-XEN_ARGIFY_3(g_filtered_comb_w, g_filtered_comb)
-XEN_ARGIFY_3(g_all_pass_w, g_all_pass)
-XEN_ARGIFY_2(g_moving_average_w, g_moving_average)
-XEN_NARGIFY_1(g_delay_p_w, g_delay_p)
-XEN_NARGIFY_1(g_notch_p_w, g_notch_p)
-XEN_NARGIFY_1(g_comb_p_w, g_comb_p)
-XEN_NARGIFY_1(g_filtered_comb_p_w, g_filtered_comb_p)
-XEN_NARGIFY_1(g_all_pass_p_w, g_all_pass_p)
-XEN_NARGIFY_1(g_moving_average_p_w, g_moving_average_p)
-
-XEN_ARGIFY_2(g_ncos_w, g_ncos)
-XEN_NARGIFY_1(g_ncos_p_w, g_ncos_p)
-XEN_ARGIFY_2(g_nsin_w, g_nsin)
-XEN_NARGIFY_1(g_nsin_p_w, g_nsin_p)
-
-XEN_VARGIFY(g_make_rand_w, g_make_rand)
-XEN_VARGIFY(g_make_rand_interp_w, g_make_rand_interp)
-XEN_ARGIFY_2(g_rand_w, g_rand)
-XEN_ARGIFY_2(g_rand_interp_w, g_rand_interp)
-XEN_NARGIFY_1(g_rand_p_w, g_rand_p)
-XEN_NARGIFY_1(g_rand_interp_p_w, g_rand_interp_p)
-XEN_NARGIFY_1(g_mus_random_w, g_mus_random)
-XEN_NARGIFY_0(g_mus_rand_seed_w, g_mus_rand_seed)
-XEN_NARGIFY_1(g_mus_set_rand_seed_w, g_mus_set_rand_seed)
-XEN_NARGIFY_1(g_table_lookup_p_w, g_table_lookup_p)
-XEN_VARGIFY(g_make_table_lookup_w, g_make_table_lookup)
-XEN_ARGIFY_2(g_table_lookup_w, g_table_lookup)
-XEN_ARGIFY_3(g_partials_to_wave_w, g_partials_to_wave)
-XEN_ARGIFY_3(g_phase_partials_to_wave_w, g_phase_partials_to_wave)
-XEN_ARGIFY_6(g_make_sawtooth_wave_w, g_make_sawtooth_wave)
-XEN_ARGIFY_2(g_sawtooth_wave_w, g_sawtooth_wave)
-XEN_NARGIFY_1(g_sawtooth_wave_p_w, g_sawtooth_wave_p)
-XEN_ARGIFY_6(g_make_triangle_wave_w, g_make_triangle_wave)
-XEN_ARGIFY_2(g_triangle_wave_w, g_triangle_wave)
-XEN_NARGIFY_1(g_triangle_wave_p_w, g_triangle_wave_p)
-XEN_ARGIFY_6(g_make_square_wave_w, g_make_square_wave)
-XEN_ARGIFY_2(g_square_wave_w, g_square_wave)
-XEN_NARGIFY_1(g_square_wave_p_w, g_square_wave_p)
-XEN_ARGIFY_6(g_make_pulse_train_w, g_make_pulse_train)
-XEN_ARGIFY_2(g_pulse_train_w, g_pulse_train)
-XEN_NARGIFY_1(g_pulse_train_p_w, g_pulse_train_p)
-XEN_ARGIFY_3(g_asymmetric_fm_w, g_asymmetric_fm)
-XEN_NARGIFY_1(g_asymmetric_fm_p_w, g_asymmetric_fm_p)
-XEN_ARGIFY_4(g_make_one_zero_w, g_make_one_zero)
-XEN_ARGIFY_2(g_one_zero_w, g_one_zero)
-XEN_NARGIFY_1(g_one_zero_p_w, g_one_zero_p)
-XEN_ARGIFY_4(g_make_one_pole_w, g_make_one_pole)
-XEN_ARGIFY_2(g_one_pole_w, g_one_pole)
-XEN_NARGIFY_1(g_one_pole_p_w, g_one_pole_p)
-XEN_ARGIFY_6(g_make_two_zero_w, g_make_two_zero)
-XEN_ARGIFY_2(g_two_zero_w, g_two_zero)
-XEN_NARGIFY_1(g_two_zero_p_w, g_two_zero_p)
-XEN_ARGIFY_6(g_make_two_pole_w, g_make_two_pole)
-XEN_ARGIFY_2(g_two_pole_w, g_two_pole)
-XEN_NARGIFY_1(g_two_pole_p_w, g_two_pole_p)
-XEN_ARGIFY_3(g_formant_bank_w, g_formant_bank)
-
-XEN_NARGIFY_1(g_formant_p_w, g_formant_p)
-XEN_ARGIFY_4(g_make_formant_w, g_make_formant)
-XEN_ARGIFY_3(g_formant_w, g_formant)
-
-XEN_NARGIFY_1(g_firmant_p_w, g_firmant_p)
-XEN_ARGIFY_4(g_make_firmant_w, g_make_firmant)
-XEN_ARGIFY_3(g_firmant_w, g_firmant)
-
-XEN_NARGIFY_3(g_set_formant_radius_and_frequency_w, g_set_formant_radius_and_frequency)
-XEN_VARGIFY(g_make_frame_w, g_make_frame)
-XEN_VARGIFY(g_make_frame_unchecked_w, g_make_frame_unchecked)
-XEN_VARGIFY(g_frame_w, g_frame)
-XEN_NARGIFY_1(g_frame_p_w, g_frame_p)
-XEN_ARGIFY_3(g_frame_add_w, g_frame_add)
-XEN_ARGIFY_3(g_frame_multiply_w, g_frame_multiply)
-XEN_NARGIFY_2(g_frame_ref_w, g_frame_ref)
-XEN_NARGIFY_3(g_frame_set_w, g_frame_set)
-XEN_VARGIFY(g_make_mixer_w, g_make_mixer)
-XEN_VARGIFY(g_make_mixer_unchecked_w, g_make_mixer_unchecked)
-XEN_VARGIFY(g_mixer_w, g_mixer)
-XEN_NARGIFY_1(g_mixer_p_w, g_mixer_p)
-XEN_ARGIFY_3(g_mixer_multiply_w, g_mixer_multiply)
-XEN_ARGIFY_3(g_mixer_add_w, g_mixer_add)
-XEN_NARGIFY_2(g_make_scalar_mixer_w, g_make_scalar_mixer)
-XEN_NARGIFY_3(g_mixer_ref_w, g_mixer_ref)
-XEN_NARGIFY_4(g_mixer_set_w, g_mixer_set)
-XEN_NARGIFY_2(g_frame_to_sample_w, g_frame_to_sample)
-XEN_NARGIFY_1(g_frame_to_list_w, g_frame_to_list)
-XEN_ARGIFY_3(g_frame_to_frame_w, g_frame_to_frame)
-XEN_ARGIFY_3(g_sample_to_frame_w, g_sample_to_frame)
-XEN_VARGIFY(g_make_wave_train_w, g_make_wave_train)
-XEN_ARGIFY_2(g_wave_train_w, g_wave_train)
-XEN_NARGIFY_1(g_wave_train_p_w, g_wave_train_p)
-XEN_VARGIFY(g_make_polyshape_w, g_make_polyshape)
-XEN_ARGIFY_3(g_polyshape_w, g_polyshape)
-XEN_NARGIFY_1(g_polyshape_p_w, g_polyshape_p)
-XEN_ARGIFY_2(g_partials_to_polynomial_w, g_partials_to_polynomial)
-XEN_NARGIFY_1(g_normalize_partials_w, g_normalize_partials)
-XEN_NARGIFY_2(g_chebyshev_t_sum_w, g_chebyshev_t_sum)
-XEN_NARGIFY_2(g_chebyshev_u_sum_w, g_chebyshev_u_sum)
-XEN_NARGIFY_3(g_chebyshev_tu_sum_w, g_chebyshev_tu_sum)
-XEN_VARGIFY(g_make_polywave_w, g_make_polywave)
-XEN_ARGIFY_2(g_polywave_w, g_polywave)
-XEN_NARGIFY_1(g_polywave_p_w, g_polywave_p)
-
-XEN_VARGIFY(g_make_nrxysin_w, g_make_nrxysin)
-XEN_ARGIFY_2(g_nrxysin_w, g_nrxysin)
-XEN_NARGIFY_1(g_nrxysin_p_w, g_nrxysin_p)
-XEN_VARGIFY(g_make_nrxycos_w, g_make_nrxycos)
-XEN_ARGIFY_2(g_nrxycos_w, g_nrxycos)
-XEN_NARGIFY_1(g_nrxycos_p_w, g_nrxycos_p)
-
-XEN_ARGIFY_6(g_make_filter_w, g_make_filter)
-XEN_NARGIFY_2(g_filter_w, g_filter)
-XEN_NARGIFY_1(g_filter_p_w, g_filter_p)
-XEN_ARGIFY_4(g_make_fir_filter_w, g_make_fir_filter)
-XEN_NARGIFY_2(g_make_fir_coeffs_w, g_make_fir_coeffs)
-XEN_NARGIFY_2(g_fir_filter_w, g_fir_filter)
-XEN_NARGIFY_1(g_fir_filter_p_w, g_fir_filter_p)
-XEN_ARGIFY_4(g_make_iir_filter_w, g_make_iir_filter)
-XEN_NARGIFY_2(g_iir_filter_w, g_iir_filter)
-XEN_NARGIFY_1(g_iir_filter_p_w, g_iir_filter_p)
-XEN_NARGIFY_1(g_mus_xcoeffs_w, g_mus_xcoeffs)
-XEN_NARGIFY_1(g_mus_ycoeffs_w, g_mus_ycoeffs)
-XEN_NARGIFY_2(g_mus_xcoeff_w, g_mus_xcoeff)
-XEN_NARGIFY_3(g_mus_set_xcoeff_w, g_mus_set_xcoeff)
-XEN_NARGIFY_2(g_mus_ycoeff_w, g_mus_ycoeff)
-XEN_NARGIFY_3(g_mus_set_ycoeff_w, g_mus_set_ycoeff)
-XEN_NARGIFY_1(g_env_p_w, g_env_p)
-XEN_NARGIFY_1(g_env_w, g_env)
-XEN_VARGIFY(g_make_env_w, g_make_env)
-XEN_NARGIFY_2(g_env_interp_w, g_env_interp)
-XEN_NARGIFY_2(g_env_any_w, g_env_any)
-XEN_NARGIFY_1(g_file_to_sample_p_w, g_file_to_sample_p)
-XEN_ARGIFY_2(g_make_file_to_sample_w, g_make_file_to_sample)
-XEN_ARGIFY_3(g_file_to_sample_w, g_file_to_sample)
-XEN_NARGIFY_1(g_file_to_frame_p_w, g_file_to_frame_p)
-XEN_ARGIFY_2(g_make_file_to_frame_w, g_make_file_to_frame)
-XEN_ARGIFY_3(g_file_to_frame_w, g_file_to_frame)
-XEN_NARGIFY_1(g_sample_to_file_p_w, g_sample_to_file_p)
-XEN_ARGIFY_5(g_make_sample_to_file_w, g_make_sample_to_file)
-XEN_NARGIFY_1(g_continue_sample_to_file_w, g_continue_sample_to_file)
-XEN_NARGIFY_1(g_continue_frame_to_file_w, g_continue_frame_to_file)
-XEN_NARGIFY_4(g_sample_to_file_w, g_sample_to_file)
-XEN_NARGIFY_2(g_sample_to_file_add_w, g_sample_to_file_add)
-XEN_NARGIFY_1(g_frame_to_file_p_w, g_frame_to_file_p)
-XEN_NARGIFY_3(g_frame_to_file_w, g_frame_to_file)
-XEN_ARGIFY_5(g_make_frame_to_file_w, g_make_frame_to_file)
-XEN_NARGIFY_1(g_input_p_w, g_input_p)
-XEN_NARGIFY_1(g_output_p_w, g_output_p)
-XEN_NARGIFY_3(g_in_any_w, g_in_any)
-XEN_NARGIFY_2(g_ina_w, g_ina)
-XEN_NARGIFY_2(g_inb_w, g_inb)
-XEN_ARGIFY_4(g_out_any_w, g_out_any)
-XEN_ARGIFY_3(g_outa_w, g_outa)
-XEN_ARGIFY_3(g_outb_w, g_outb)
-XEN_ARGIFY_3(g_outc_w, g_outc)
-XEN_ARGIFY_3(g_outd_w, g_outd)
-XEN_NARGIFY_1(g_mus_close_w, g_mus_close)
-XEN_NARGIFY_0(g_mus_file_buffer_size_w, g_mus_file_buffer_size)
-XEN_NARGIFY_1(g_mus_set_file_buffer_size_w, g_mus_set_file_buffer_size)
-XEN_NARGIFY_1(g_readin_p_w, g_readin_p)
-XEN_NARGIFY_1(g_readin_w, g_readin)
-XEN_VARGIFY(g_make_readin_w, g_make_readin)
-XEN_NARGIFY_1(g_mus_channel_w, g_mus_channel)
-XEN_NARGIFY_1(g_mus_interp_type_w, g_mus_interp_type)
-XEN_NARGIFY_1(g_mus_location_w, g_mus_location)
-XEN_NARGIFY_2(g_mus_set_location_w, g_mus_set_location)
-XEN_NARGIFY_1(g_mus_increment_w, g_mus_increment)
-XEN_NARGIFY_2(g_mus_set_increment_w, g_mus_set_increment)
-XEN_NARGIFY_1(g_mus_feedback_w, g_mus_feedback)
-XEN_NARGIFY_2(g_mus_set_feedback_w, g_mus_set_feedback)
-XEN_NARGIFY_1(g_locsig_p_w, g_locsig_p)
-XEN_NARGIFY_3(g_locsig_w, g_locsig)
-XEN_VARGIFY(g_make_locsig_w, g_make_locsig)
-XEN_NARGIFY_3(g_move_locsig_w, g_move_locsig)
-XEN_NARGIFY_0(g_locsig_type_w, g_locsig_type)
-XEN_NARGIFY_1(g_set_locsig_type_w, g_set_locsig_type)
-XEN_NARGIFY_1(g_mus_channels_w, g_mus_channels)
-XEN_NARGIFY_2(g_locsig_ref_w, g_locsig_ref)
-XEN_NARGIFY_2(g_locsig_reverb_ref_w, g_locsig_reverb_ref)
-XEN_NARGIFY_3(g_locsig_set_w, g_locsig_set)
-XEN_NARGIFY_3(g_locsig_reverb_set_w, g_locsig_reverb_set)
-XEN_NARGIFY_1(g_move_sound_p_w, g_move_sound_p)
-XEN_NARGIFY_3(g_move_sound_w, g_move_sound)
-XEN_ARGIFY_3(g_make_move_sound_w, g_make_move_sound)
-XEN_NARGIFY_0(g_mus_clear_sincs_w, g_mus_clear_sincs)
-XEN_NARGIFY_1(g_src_p_w, g_src_p)
-XEN_ARGIFY_3(g_src_w, g_src)
-XEN_ARGIFY_6(g_make_src_w, g_make_src)
-XEN_NARGIFY_1(g_granulate_p_w, g_granulate_p)
-XEN_ARGIFY_3(g_granulate_w, g_granulate)
-XEN_VARGIFY(g_make_granulate_w, g_make_granulate)
-XEN_NARGIFY_1(g_mus_ramp_w, g_mus_ramp)
-XEN_NARGIFY_2(g_mus_set_ramp_w, g_mus_set_ramp)
-XEN_NARGIFY_1(g_convolve_p_w, g_convolve_p)
-XEN_ARGIFY_2(g_convolve_w, g_convolve)
-XEN_VARGIFY(g_make_convolve_w, g_make_convolve)
-XEN_ARGIFY_4(g_convolve_files_w, g_convolve_files)
-XEN_NARGIFY_1(g_phase_vocoder_p_w, g_phase_vocoder_p)
-XEN_ARGIFY_5(g_phase_vocoder_w, g_phase_vocoder)
-XEN_VARGIFY(g_make_phase_vocoder_w, g_make_phase_vocoder)
-XEN_NARGIFY_1(g_phase_vocoder_amp_increments_w, g_phase_vocoder_amp_increments)
-XEN_NARGIFY_1(g_phase_vocoder_amps_w, g_phase_vocoder_amps)
-XEN_NARGIFY_1(g_phase_vocoder_freqs_w, g_phase_vocoder_freqs)
-XEN_NARGIFY_1(g_phase_vocoder_phases_w, g_phase_vocoder_phases)
-XEN_NARGIFY_1(g_phase_vocoder_phase_increments_w, g_phase_vocoder_phase_increments)
-XEN_NARGIFY_1(g_mus_hop_w, g_mus_hop)
-XEN_NARGIFY_2(g_mus_set_hop_w, g_mus_set_hop)
-XEN_ARGIFY_7(g_mus_mix_w, g_mus_mix)
-XEN_ARGIFY_4(g_make_ssb_am_w, g_make_ssb_am)
-XEN_ARGIFY_3(g_ssb_am_w, g_ssb_am)
-XEN_NARGIFY_1(g_ssb_am_p_w, g_ssb_am_p)
-XEN_NARGIFY_4(g_ssb_bank_w, g_ssb_bank)
-XEN_NARGIFY_0(g_clm_table_size_w, g_clm_table_size)
-XEN_NARGIFY_1(g_set_clm_table_size_w, g_set_clm_table_size)
-XEN_NARGIFY_0(g_clm_default_frequency_w, g_clm_default_frequency)
-XEN_NARGIFY_1(g_set_clm_default_frequency_w, g_set_clm_default_frequency)
-XEN_NARGIFY_1(g_mus_generator_p_w, g_mus_generator_p)
-XEN_NARGIFY_1(g_mus_frandom_w, g_mus_frandom)
-XEN_NARGIFY_1(g_mus_irandom_w, g_mus_irandom)
-
-#if (!HAVE_SCHEME)
-XEN_ARGIFY_4(g_make_oscil_w, g_make_oscil)
-XEN_ARGIFY_4(g_make_ncos_w, g_make_ncos)
-XEN_ARGIFY_4(g_make_nsin_w, g_make_nsin)
-XEN_ARGIFY_8(g_make_asymmetric_fm_w, g_make_asymmetric_fm)
-#else
-XEN_NARGIFY_2(g_make_oscil_w, g_make_oscil)
-XEN_NARGIFY_2(g_make_ncos_w, g_make_ncos)
-XEN_NARGIFY_2(g_make_nsin_w, g_make_nsin)
-XEN_NARGIFY_4(g_make_asymmetric_fm_w, g_make_asymmetric_fm)
+static Xen g_get_internal_real_time(void) {return(C_double_to_Xen_real(0.0));}
#endif
-#else
-#define g_mus_srate_w g_mus_srate
-#define g_mus_set_srate_w g_mus_set_srate
-#define g_mus_float_equal_fudge_factor_w g_mus_float_equal_fudge_factor
-#define g_mus_set_float_equal_fudge_factor_w g_mus_set_float_equal_fudge_factor
-#define g_mus_array_print_length_w g_mus_array_print_length
-#define g_mus_set_array_print_length_w g_mus_set_array_print_length
-#define g_radians_to_hz_w g_radians_to_hz
-#define g_hz_to_radians_w g_hz_to_radians
-#define g_radians_to_degrees_w g_radians_to_degrees
-#define g_degrees_to_radians_w g_degrees_to_radians
-#define g_db_to_linear_w g_db_to_linear
-#define g_linear_to_db_w g_linear_to_db
-#define g_seconds_to_samples_w g_seconds_to_samples
-#define g_samples_to_seconds_w g_samples_to_seconds
-#define g_ring_modulate_w g_ring_modulate
-#define g_amplitude_modulate_w g_amplitude_modulate
-#define g_contrast_enhancement_w g_contrast_enhancement
-#define g_dot_product_w g_dot_product
-#if HAVE_COMPLEX_TRIG && XEN_HAVE_COMPLEX_NUMBERS
-#define g_edot_product_w g_edot_product
-#endif
-#define g_clear_array_w g_clear_array
-#define g_polynomial_w g_polynomial
-#define g_multiply_arrays_w g_multiply_arrays
-#define g_make_fft_window_w g_make_fft_window
-#define g_mus_fft_w g_mus_fft
-#define g_spectrum_w g_spectrum
-#define g_autocorrelate_w g_autocorrelate
-#define g_correlate_w g_correlate
-#define g_convolution_w g_convolution
-#define g_rectangular_to_polar_w g_rectangular_to_polar
-#define g_rectangular_to_magnitudes_w g_rectangular_to_magnitudes
-#define g_polar_to_rectangular_w g_polar_to_rectangular
-#define g_array_interp_w g_array_interp
-#define g_mus_interpolate_w g_mus_interpolate
-#define g_mus_describe_w g_mus_describe
-#define g_mus_name_w g_mus_name
-#define g_mus_set_name_w g_mus_set_name
-#define g_mus_run_w g_mus_run
-#define g_mus_phase_w g_mus_phase
-#define g_mus_set_phase_w g_mus_set_phase
-#define g_mus_scaler_w g_mus_scaler
-#define g_mus_set_scaler_w g_mus_set_scaler
-#define g_mus_safety_w g_mus_safety
-#define g_mus_set_safety_w g_mus_set_safety
-#define g_mus_feedforward_w g_mus_feedforward
-#define g_mus_set_feedforward_w g_mus_set_feedforward
-#define g_mus_width_w g_mus_width
-#define g_mus_set_width_w g_mus_set_width
-#define g_mus_reset_w g_mus_reset
-#define g_mus_offset_w g_mus_offset
-#define g_mus_set_offset_w g_mus_set_offset
-#define g_mus_frequency_w g_mus_frequency
-#define g_mus_set_frequency_w g_mus_set_frequency
-#define g_mus_length_w g_mus_length
-#define g_mus_order_w g_mus_order
-#define g_mus_file_name_w g_mus_file_name
-#define g_mus_set_length_w g_mus_set_length
-#define g_mus_data_w g_mus_data
-#define g_mus_set_data_w g_mus_set_data
-#define g_oscil_p_w g_oscil_p
-#define g_make_oscil_w g_make_oscil
-#define g_oscil_w g_oscil
-#define g_mus_apply_w g_mus_apply
-#define g_make_delay_w g_make_delay
-#define g_make_comb_w g_make_comb
-#define g_make_filtered_comb_w g_make_filtered_comb
-#define g_make_notch_w g_make_notch
-#define g_make_all_pass_w g_make_all_pass
-#define g_make_moving_average_w g_make_moving_average
-#define g_delay_w g_delay
-#define g_delay_tick_w g_delay_tick
-#define g_tap_w g_tap
-#define g_notch_w g_notch
-#define g_comb_w g_comb
-#define g_filtered_comb_w g_filtered_comb
-#define g_all_pass_w g_all_pass
-#define g_moving_average_w g_moving_average
-#define g_delay_p_w g_delay_p
-#define g_notch_p_w g_notch_p
-#define g_comb_p_w g_comb_p
-#define g_filtered_comb_p_w g_filtered_comb_p
-#define g_all_pass_p_w g_all_pass_p
-#define g_moving_average_p_w g_moving_average_p
-
-#define g_make_ncos_w g_make_ncos
-#define g_ncos_w g_ncos
-#define g_ncos_p_w g_ncos_p
-#define g_make_nsin_w g_make_nsin
-#define g_nsin_w g_nsin
-#define g_nsin_p_w g_nsin_p
-
-#define g_make_rand_w g_make_rand
-#define g_make_rand_interp_w g_make_rand_interp
-#define g_rand_w g_rand
-#define g_rand_interp_w g_rand_interp
-#define g_rand_p_w g_rand_p
-#define g_rand_interp_p_w g_rand_interp_p
-#define g_mus_random_w g_mus_random
-#define g_mus_rand_seed_w g_mus_rand_seed
-#define g_mus_set_rand_seed_w g_mus_set_rand_seed
-#define g_table_lookup_p_w g_table_lookup_p
-#define g_make_table_lookup_w g_make_table_lookup
-#define g_table_lookup_w g_table_lookup
-#define g_partials_to_wave_w g_partials_to_wave
-#define g_phase_partials_to_wave_w g_phase_partials_to_wave
-#define g_make_sawtooth_wave_w g_make_sawtooth_wave
-#define g_sawtooth_wave_w g_sawtooth_wave
-#define g_sawtooth_wave_p_w g_sawtooth_wave_p
-#define g_make_triangle_wave_w g_make_triangle_wave
-#define g_triangle_wave_w g_triangle_wave
-#define g_triangle_wave_p_w g_triangle_wave_p
-#define g_make_square_wave_w g_make_square_wave
-#define g_square_wave_w g_square_wave
-#define g_square_wave_p_w g_square_wave_p
-#define g_make_pulse_train_w g_make_pulse_train
-#define g_pulse_train_w g_pulse_train
-#define g_pulse_train_p_w g_pulse_train_p
-#define g_make_asymmetric_fm_w g_make_asymmetric_fm
-#define g_asymmetric_fm_w g_asymmetric_fm
-#define g_asymmetric_fm_p_w g_asymmetric_fm_p
-#define g_make_one_zero_w g_make_one_zero
-#define g_one_zero_w g_one_zero
-#define g_one_zero_p_w g_one_zero_p
-#define g_make_one_pole_w g_make_one_pole
-#define g_one_pole_w g_one_pole
-#define g_one_pole_p_w g_one_pole_p
-#define g_make_two_zero_w g_make_two_zero
-#define g_two_zero_w g_two_zero
-#define g_two_zero_p_w g_two_zero_p
-#define g_make_two_pole_w g_make_two_pole
-#define g_two_pole_w g_two_pole
-#define g_two_pole_p_w g_two_pole_p
-#define g_formant_bank_w g_formant_bank
-
-#define g_formant_p_w g_formant_p
-#define g_make_formant_w g_make_formant
-#define g_formant_w g_formant
-
-#define g_firmant_p_w g_firmant_p
-#define g_make_firmant_w g_make_firmant
-#define g_firmant_w g_firmant
-
-#define g_set_formant_radius_and_frequency_w g_set_formant_radius_and_frequency
-#define g_make_frame_w g_make_frame
-#define g_make_frame_unchecked_w g_make_frame_unchecked
-#define g_frame_w g_frame
-#define g_frame_p_w g_frame_p
-#define g_frame_add_w g_frame_add
-#define g_frame_multiply_w g_frame_multiply
-#define g_frame_ref_w g_frame_ref
-#define g_frame_set_w g_frame_set
-#define g_make_mixer_w g_make_mixer
-#define g_make_mixer_unchecked_w g_make_mixer_unchecked
-#define g_mixer_w g_mixer
-#define g_mixer_p_w g_mixer_p
-#define g_mixer_multiply_w g_mixer_multiply
-#define g_mixer_add_w g_mixer_add
-#define g_make_scalar_mixer_w g_make_scalar_mixer
-#define g_mixer_ref_w g_mixer_ref
-#define g_mixer_set_w g_mixer_set
-#define g_frame_to_sample_w g_frame_to_sample
-#define g_frame_to_list_w g_frame_to_list
-#define g_frame_to_frame_w g_frame_to_frame
-#define g_sample_to_frame_w g_sample_to_frame
-#define g_make_wave_train_w g_make_wave_train
-#define g_wave_train_w g_wave_train
-#define g_wave_train_p_w g_wave_train_p
-#define g_make_polyshape_w g_make_polyshape
-#define g_polyshape_w g_polyshape
-#define g_polyshape_p_w g_polyshape_p
-#define g_partials_to_polynomial_w g_partials_to_polynomial
-#define g_normalize_partials_w g_normalize_partials
-#define g_chebyshev_t_sum_w g_chebyshev_t_sum
-#define g_chebyshev_u_sum_w g_chebyshev_u_sum
-#define g_chebyshev_tu_sum_w g_chebyshev_tu_sum
-#define g_make_polywave_w g_make_polywave
-#define g_polywave_w g_polywave
-#define g_polywave_p_w g_polywave_p
-
-#define g_make_nrxysin_w g_make_nrxysin
-#define g_nrxysin_w g_nrxysin
-#define g_nrxysin_p_w g_nrxysin_p
-#define g_make_nrxycos_w g_make_nrxycos
-#define g_nrxycos_w g_nrxycos
-#define g_nrxycos_p_w g_nrxycos_p
-
-#define g_make_filter_w g_make_filter
-#define g_filter_w g_filter
-#define g_filter_p_w g_filter_p
-#define g_make_fir_filter_w g_make_fir_filter
-#define g_make_fir_coeffs_w g_make_fir_coeffs
-#define g_fir_filter_w g_fir_filter
-#define g_fir_filter_p_w g_fir_filter_p
-#define g_make_iir_filter_w g_make_iir_filter
-#define g_iir_filter_w g_iir_filter
-#define g_iir_filter_p_w g_iir_filter_p
-#define g_mus_xcoeffs_w g_mus_xcoeffs
-#define g_mus_xcoeff_w g_mus_xcoeff
-#define g_mus_set_xcoeff_w g_mus_set_xcoeff
-#define g_mus_ycoeffs_w g_mus_ycoeffs
-#define g_mus_ycoeff_w g_mus_ycoeff
-#define g_mus_set_ycoeff_w g_mus_set_ycoeff
-#define g_env_p_w g_env_p
-#define g_env_w g_env
-#define g_make_env_w g_make_env
-#define g_env_interp_w g_env_interp
-#define g_env_any_w g_env_any
-#define g_file_to_sample_p_w g_file_to_sample_p
-#define g_make_file_to_sample_w g_make_file_to_sample
-#define g_file_to_sample_w g_file_to_sample
-#define g_file_to_frame_p_w g_file_to_frame_p
-#define g_make_file_to_frame_w g_make_file_to_frame
-#define g_file_to_frame_w g_file_to_frame
-#define g_sample_to_file_p_w g_sample_to_file_p
-#define g_make_sample_to_file_w g_make_sample_to_file
-#define g_continue_sample_to_file_w g_continue_sample_to_file
-#define g_continue_frame_to_file_w g_continue_frame_to_file
-#define g_sample_to_file_w g_sample_to_file
-#define g_sample_to_file_add_w g_sample_to_file_add
-#define g_frame_to_file_p_w g_frame_to_file_p
-#define g_frame_to_file_w g_frame_to_file
-#define g_make_frame_to_file_w g_make_frame_to_file
-#define g_input_p_w g_input_p
-#define g_output_p_w g_output_p
-#define g_in_any_w g_in_any
-#define g_ina_w g_ina
-#define g_inb_w g_inb
-#define g_out_any_w g_out_any
-#define g_outa_w g_outa
-#define g_outb_w g_outb
-#define g_outc_w g_outc
-#define g_outd_w g_outd
-#define g_mus_close_w g_mus_close
-#define g_mus_file_buffer_size_w g_mus_file_buffer_size
-#define g_mus_set_file_buffer_size_w g_mus_set_file_buffer_size
-#define g_readin_p_w g_readin_p
-#define g_readin_w g_readin
-#define g_make_readin_w g_make_readin
-#define g_mus_channel_w g_mus_channel
-#define g_mus_interp_type_w g_mus_interp_type
-#define g_mus_location_w g_mus_location
-#define g_mus_set_location_w g_mus_set_location
-#define g_mus_increment_w g_mus_increment
-#define g_mus_set_increment_w g_mus_set_increment
-#define g_mus_feedback_w g_mus_feedback
-#define g_mus_set_feedback_w g_mus_set_feedback
-#define g_locsig_p_w g_locsig_p
-#define g_locsig_w g_locsig
-#define g_make_locsig_w g_make_locsig
-#define g_move_locsig_w g_move_locsig
-#define g_locsig_type_w g_locsig_type
-#define g_set_locsig_type_w g_set_locsig_type
-#define g_mus_channels_w g_mus_channels
-#define g_locsig_ref_w g_locsig_ref
-#define g_locsig_reverb_ref_w g_locsig_reverb_ref
-#define g_locsig_set_w g_locsig_set
-#define g_locsig_reverb_set_w g_locsig_reverb_set
-#define g_move_sound_p_w g_move_sound_p
-#define g_move_sound_w g_move_sound
-#define g_make_move_sound_w g_make_move_sound
-#define g_mus_clear_sincs_w g_mus_clear_sincs
-#define g_src_p_w g_src_p
-#define g_src_w g_src
-#define g_make_src_w g_make_src
-#define g_granulate_p_w g_granulate_p
-#define g_granulate_w g_granulate
-#define g_make_granulate_w g_make_granulate
-#define g_mus_ramp_w g_mus_ramp
-#define g_mus_set_ramp_w g_mus_set_ramp
-#define g_convolve_p_w g_convolve_p
-#define g_convolve_w g_convolve
-#define g_make_convolve_w g_make_convolve
-#define g_convolve_files_w g_convolve_files
-#define g_phase_vocoder_p_w g_phase_vocoder_p
-#define g_phase_vocoder_w g_phase_vocoder
-#define g_make_phase_vocoder_w g_make_phase_vocoder
-#define g_phase_vocoder_amp_increments_w g_phase_vocoder_amp_increments
-#define g_phase_vocoder_amps_w g_phase_vocoder_amps
-#define g_phase_vocoder_freqs_w g_phase_vocoder_freqs
-#define g_phase_vocoder_phases_w g_phase_vocoder_phases
-#define g_phase_vocoder_phase_increments_w g_phase_vocoder_phase_increments
-#define g_mus_hop_w g_mus_hop
-#define g_mus_set_hop_w g_mus_set_hop
-#define g_mus_mix_w g_mus_mix
-#define g_make_ssb_am_w g_make_ssb_am
-#define g_ssb_am_w g_ssb_am
-#define g_ssb_am_p_w g_ssb_am_p
-#define g_ssb_bank_w g_ssb_bank
-#define g_clm_table_size_w g_clm_table_size
-#define g_set_clm_table_size_w g_set_clm_table_size
-#define g_clm_default_frequency_w g_clm_default_frequency
-#define g_set_clm_default_frequency_w g_set_clm_default_frequency
-#define g_mus_generator_p_w g_mus_generator_p
-#define g_mus_frandom_w g_mus_frandom
-#define g_mus_irandom_w g_mus_irandom
+Xen_wrap_no_args(g_get_internal_real_time_w, g_get_internal_real_time)
#endif
-static void mus_xen_init(void)
-{
- mus_initialize();
-#if (!HAVE_NESTED_FUNCTIONS) || __cplusplus
- current_connect_func = XEN_FALSE;
-#endif
+
+/* -------------------------------- scheme-side optimization -------------------------------- */
#if HAVE_SCHEME
- mus_xen_tag = XEN_MAKE_OBJECT_TYPE("<generator>", print_mus_xen, free_mus_xen, s7_equalp_mus_xen, mark_mus_xen,
- mus_xen_apply, s7_mus_set, s7_mus_length, s7_mus_copy, s7_mus_fill);
-#else
- mus_xen_tag = XEN_MAKE_OBJECT_TYPE("Mus", sizeof(mus_xen));
-#endif
+#if (!WITH_GMP)
+#define car(E) s7_car(E)
+#define cdr(E) s7_cdr(E)
+#define cadr(E) s7_cadr(E)
+#define caddr(E) s7_caddr(E)
+#define cadddr(E) s7_cadddr(E)
+#define cadddr(E) s7_cadddr(E)
+
+static mus_float_t mus_nsin_unmodulated(mus_any *p) {return(mus_nsin(p, 0.0));}
+static mus_float_t mus_ncos_unmodulated(mus_any *p) {return(mus_ncos(p, 0.0));}
+static mus_float_t mus_nrxysin_unmodulated(mus_any *p) {return(mus_nrxysin(p, 0.0));}
+static mus_float_t mus_nrxycos_unmodulated(mus_any *p) {return(mus_nrxycos(p, 0.0));}
+static mus_float_t mus_rxyksin_unmodulated(mus_any *p) {return(mus_rxyksin(p, 0.0));}
+static mus_float_t mus_rxykcos_unmodulated(mus_any *p) {return(mus_rxykcos(p, 0.0));}
+static mus_float_t mus_square_wave_unmodulated(mus_any *p) {return(mus_square_wave(p, 0.0));}
+static mus_float_t mus_sawtooth_wave_unmodulated(mus_any *p) {return(mus_sawtooth_wave(p, 0.0));}
+
+static mus_float_t mus_src_simple(mus_any *p) {return(mus_src(p, 0.0, NULL));}
+static mus_float_t mus_src_two(mus_any *p, mus_float_t x) {return(mus_src(p, x, NULL));}
+static mus_float_t mus_granulate_simple(mus_any *p) {return(mus_granulate_with_editor(p, NULL, NULL));}
+static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL));}
+static mus_float_t mus_phase_vocoder_simple(mus_any *p) {return(mus_phase_vocoder(p, NULL));}
+
+#define mus_oscil_rf mus_oscil_unmodulated
+#define mus_polywave_rf mus_polywave_unmodulated
+#define mus_ncos_rf mus_ncos_unmodulated
+#define mus_nsin_rf mus_nsin_unmodulated
+#define mus_nrxycos_rf mus_nrxycos_unmodulated
+#define mus_nrxysin_rf mus_nrxysin_unmodulated
+#define mus_rxykcos_rf mus_rxykcos_unmodulated
+#define mus_rxyksin_rf mus_rxyksin_unmodulated
+#define mus_rand_rf mus_rand_unmodulated
+#define mus_rand_interp_rf mus_rand_interp_unmodulated
+#define mus_readin_rf mus_readin
+#define mus_env_rf mus_env
+#define mus_pulsed_env_rf mus_pulsed_env_unmodulated
+#define mus_oscil_bank_rf mus_oscil_bank
+#define mus_table_lookup_rf mus_table_lookup_unmodulated
+#define mus_sawtooth_wave_rf mus_sawtooth_wave_unmodulated
+#define mus_pulse_train_rf mus_pulse_train_unmodulated
+#define mus_triangle_wave_rf mus_triangle_wave_unmodulated
+#define mus_square_wave_rf mus_square_wave_unmodulated
+#define mus_wave_train_rf mus_wave_train_unmodulated
+
+#define mus_convolve_rf mus_convolve_simple
+#define mus_src_rf mus_src_simple
+#define mus_granulate_rf mus_granulate_simple
+#define mus_phase_vocoder_rf mus_phase_vocoder_simple
+
+static mus_float_t mus_one_pole_rf(mus_any *p) {return(mus_one_pole(p, 0.0));}
+static mus_float_t mus_two_pole_rf(mus_any *p) {return(mus_two_pole(p, 0.0));}
+static mus_float_t mus_one_zero_rf(mus_any *p) {return(mus_one_zero(p, 0.0));}
+static mus_float_t mus_two_zero_rf(mus_any *p) {return(mus_two_zero(p, 0.0));}
+static mus_float_t mus_delay_rf(mus_any *p) {return(mus_delay_unmodulated(p, 0.0));}
+static mus_float_t mus_comb_rf(mus_any *p) {return(mus_comb_unmodulated(p, 0.0));}
+static mus_float_t mus_comb_bank_rf(mus_any *p) {return(mus_comb_bank(p, 0.0));}
+static mus_float_t mus_all_pass_bank_rf(mus_any *p) {return(mus_all_pass_bank(p, 0.0));}
+static mus_float_t mus_notch_rf(mus_any *p) {return(mus_notch_unmodulated(p, 0.0));}
+static mus_float_t mus_all_pass_rf(mus_any *p) {return(mus_all_pass_unmodulated(p, 0.0));}
+static mus_float_t mus_one_pole_all_pass_rf(mus_any *p) {return(mus_one_pole_all_pass(p, 0.0));}
+static mus_float_t mus_moving_average_rf(mus_any *p) {return(mus_moving_average(p, 0.0));}
+static mus_float_t mus_moving_max_rf(mus_any *p) {return(mus_moving_max(p, 0.0));}
+static mus_float_t mus_moving_norm_rf(mus_any *p) {return(mus_moving_norm(p, 0.0));}
+static mus_float_t mus_filter_rf(mus_any *p) {return(mus_filter(p, 0.0));}
+static mus_float_t mus_fir_filter_rf(mus_any *p) {return(mus_fir_filter(p, 0.0));}
+static mus_float_t mus_iir_filter_rf(mus_any *p) {return(mus_iir_filter(p, 0.0));}
+static mus_float_t mus_polyshape_rf(mus_any *p) {return(mus_polyshape_unmodulated(p, 1.0));}
+static mus_float_t mus_filtered_comb_rf(mus_any *p) {return(mus_filtered_comb_unmodulated(p, 0.0));}
+static mus_float_t mus_filtered_comb_bank_rf(mus_any *p) {return(mus_filtered_comb_bank(p, 0.0));}
+static mus_float_t mus_asymmetric_fm_rf(mus_any *p) {return(mus_asymmetric_fm_unmodulated(p, 0.0));}
+static mus_float_t mus_formant_rf(mus_any *p) {return(mus_formant(p, 0.0));}
+static mus_float_t mus_firmant_rf(mus_any *p) {return(mus_firmant(p, 0.0));}
+
+static mus_float_t mus_ssb_am_rf_1(mus_any *p) {return(mus_ssb_am(p, 0.0, 0.0));}
+
+static mus_any *cadr_gen(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer sym, o;
+ mus_xen *gn;
+ sym = s7_cadr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ if (s7_xf_is_stepper(sc, sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
+ if (!gn) return(NULL);
+ return(gn->gen);
+}
+
+static s7_rf_t caddr_rf(s7_scheme *sc, s7_pointer a2, s7_rf_t func)
+{
+ s7_int loc;
+ s7_pointer val_sym, val;
+ s7_rf_t rf;
+ s7_rp_t rp;
+
+ val_sym = car(a2);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ rp = s7_rf_function(sc, val);
+ if (!rp) return(NULL);
+ loc = s7_xf_store(sc, NULL);
+ rf = rp(sc, a2);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+ return(func);
+}
+
+#define GEN_RF_1(Type, Func) \
+ static s7_double Type ## _rf_g(s7_scheme *sc, s7_pointer **p) \
+ { \
+ mus_any *g; g = (mus_any *)(**p); (*p)++; \
+ return(Func(g)); \
+ } \
+ static s7_rf_t Type ## _rf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ mus_any *g; \
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
+ g = cadr_gen(sc, expr); \
+ if ((g) && (mus_is_ ## Type(g))) {s7_xf_store(sc, (s7_pointer)g); return(Type ## _rf_g);} \
+ return(NULL); \
+ } \
+ static s7_pointer is_ ## Type ## _pf_g(s7_scheme *sc, s7_pointer **p) \
+ { \
+ mus_xen *gn; \
+ s7_pf_t pf; pf = (s7_pf_t)(**p); (*p)++; \
+ gn = (mus_xen *)s7_object_value_checked(pf(sc, p), mus_xen_tag); \
+ return(s7_make_boolean(sc, (gn) && (mus_is_ ## Type(gn->gen)))); \
+ } \
+ static s7_pf_t is_ ## Type ## _pf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
+ if (s7_arg_to_pf(sc, s7_cadr(expr))) return(is_ ## Type ## _pf_g); \
+ return(NULL); \
+ }
-#if HAVE_FORTH
- fth_set_object_inspect(mus_xen_tag, print_mus_xen);
- fth_set_object_equal(mus_xen_tag, equalp_mus_xen);
- fth_set_object_mark(mus_xen_tag, mark_mus_xen);
- fth_set_object_free(mus_xen_tag, free_mus_xen);
- fth_set_object_apply(mus_xen_tag, XEN_PROCEDURE_CAST mus_xen_apply, 0, 2, 0);
-#endif
+#define GEN_RF(Type, Func1, Func2) \
+ static s7_double Type ## _rf_g(s7_scheme *sc, s7_pointer **p) \
+ { \
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
+ return(Func1(g)); \
+ } \
+ static s7_double Type ## _rf_gr(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pointer a2; \
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
+ a2 = (**p); (*p)++; \
+ return(Func2(g, s7_number_to_real(sc, a2))); \
+ } \
+ static s7_double Type ## _rf_gs(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_double a2; \
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
+ a2 = s7_slot_real_value(sc, **p, #Type); (*p)++; \
+ return(Func2(g, a2)); \
+ } \
+ static s7_double Type ## _rf_gx(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_rf_t f; \
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++; \
+ f = (s7_rf_t)(**p); (*p)++; \
+ return(Func2(g, f(sc, p))); \
+ } \
+ static s7_rf_t Type ## _rf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ mus_any *g; \
+ g = cadr_gen(sc, expr); \
+ if ((g) && (mus_is_ ## Type(g))) \
+ { \
+ s7_pointer a2; \
+ s7_xf_store(sc, (s7_pointer)g); \
+ if (s7_is_null(sc, s7_cddr(expr))) return(Type ## _rf_g); \
+ if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL); \
+ a2 = caddr(expr); \
+ if (s7_is_real(a2)) {s7_xf_store(sc, a2); return(Type ## _rf_gr);} \
+ if (s7_is_symbol(a2)) \
+ { \
+ s7_pointer slot; \
+ slot = s7_slot(sc, a2); \
+ if (slot != xen_undefined) {s7_xf_store(sc, (s7_pointer)slot); return(Type ## _rf_gs);} \
+ return(NULL); \
+ } \
+ if (s7_is_pair(a2)) \
+ return(caddr_rf(sc, a2, Type ## _rf_gx)); \
+ } \
+ return(NULL); \
+ } \
+ static s7_pointer is_ ## Type ## _pf_g(s7_scheme *sc, s7_pointer **p) \
+ { \
+ mus_xen *gn; \
+ s7_pf_t pf; pf = (s7_pf_t)(**p); (*p)++; \
+ gn = (mus_xen *)s7_object_value_checked(pf(sc, p), mus_xen_tag); \
+ return(s7_make_boolean(sc, (gn) && (mus_is_ ## Type(gn->gen)))); \
+ } \
+ static s7_pf_t is_ ## Type ## _pf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
+ if (s7_arg_to_pf(sc, s7_cadr(expr))) return(is_ ## Type ## _pf_g); \
+ return(NULL); \
+ }
-#if HAVE_RUBY
- rb_define_method(mus_xen_tag, "to_s", XEN_PROCEDURE_CAST mus_xen_to_s, 0);
- rb_define_method(mus_xen_tag, "eql?", XEN_PROCEDURE_CAST equalp_mus_xen, 1);
- rb_define_method(mus_xen_tag, "frequency", XEN_PROCEDURE_CAST g_mus_frequency, 0);
- rb_define_method(mus_xen_tag, "frequency=", XEN_PROCEDURE_CAST g_mus_set_frequency, 1);
- rb_define_method(mus_xen_tag, "phase", XEN_PROCEDURE_CAST g_mus_phase, 0);
- rb_define_method(mus_xen_tag, "phase=", XEN_PROCEDURE_CAST g_mus_set_phase, 1);
- rb_define_method(mus_xen_tag, "scaler", XEN_PROCEDURE_CAST g_mus_scaler, 0);
- rb_define_method(mus_xen_tag, "scaler=", XEN_PROCEDURE_CAST g_mus_set_scaler, 1);
- rb_define_method(mus_xen_tag, "width", XEN_PROCEDURE_CAST g_mus_width, 0);
- rb_define_method(mus_xen_tag, "width=", XEN_PROCEDURE_CAST g_mus_set_width, 1);
- rb_define_method(mus_xen_tag, "offset", XEN_PROCEDURE_CAST g_mus_offset, 0);
- rb_define_method(mus_xen_tag, "offset=", XEN_PROCEDURE_CAST g_mus_set_offset, 1);
- rb_define_method(mus_xen_tag, "reset", XEN_PROCEDURE_CAST g_mus_reset, 0);
- rb_define_method(mus_xen_tag, "length", XEN_PROCEDURE_CAST g_mus_length, 0);
- rb_define_method(mus_xen_tag, "length=", XEN_PROCEDURE_CAST g_mus_set_length, 1);
- rb_define_method(mus_xen_tag, "data", XEN_PROCEDURE_CAST g_mus_data, 0);
- rb_define_method(mus_xen_tag, "data=", XEN_PROCEDURE_CAST g_mus_set_data, 1);
- rb_define_method(mus_xen_tag, "feedforward", XEN_PROCEDURE_CAST g_mus_feedforward, 0);
- rb_define_method(mus_xen_tag, "feedforward=", XEN_PROCEDURE_CAST g_mus_set_feedforward, 1);
- rb_define_method(mus_xen_tag, "feedback", XEN_PROCEDURE_CAST g_mus_feedback, 0);
- rb_define_method(mus_xen_tag, "feedback=", XEN_PROCEDURE_CAST g_mus_set_increment, 1);
- rb_define_method(mus_xen_tag, "order", XEN_PROCEDURE_CAST g_mus_order, 0);
- rb_define_method(mus_xen_tag, "order=", XEN_PROCEDURE_CAST g_mus_set_length, 1);
- rb_define_method(mus_xen_tag, "call", XEN_PROCEDURE_CAST mus_xen_apply, 2);
- rb_define_method(mus_xen_tag, "location", XEN_PROCEDURE_CAST g_mus_location, 0);
- rb_define_method(mus_xen_tag, "location=", XEN_PROCEDURE_CAST g_mus_set_location, 1);
- rb_define_method(mus_xen_tag, "increment", XEN_PROCEDURE_CAST g_mus_increment, 0);
- rb_define_method(mus_xen_tag, "increment=", XEN_PROCEDURE_CAST g_mus_set_increment, 1);
- rb_define_method(mus_xen_tag, "channels", XEN_PROCEDURE_CAST g_mus_channels, 0);
- rb_define_method(mus_xen_tag, "channel", XEN_PROCEDURE_CAST g_mus_channel, 0);
- rb_define_method(mus_xen_tag, "interp_type", XEN_PROCEDURE_CAST g_mus_interp_type, 0);
- rb_define_method(mus_xen_tag, "xcoeffs", XEN_PROCEDURE_CAST g_mus_xcoeffs, 0);
- rb_define_method(mus_xen_tag, "ycoeffs", XEN_PROCEDURE_CAST g_mus_ycoeffs, 0);
- rb_define_method(mus_xen_tag, "xcoeff", XEN_PROCEDURE_CAST g_mus_xcoeff, 1);
- rb_define_method(mus_xen_tag, "ycoeff", XEN_PROCEDURE_CAST g_mus_ycoeff, 1);
- /*
- rb_define_method(mus_xen_tag, "xcoeff=", XEN_PROCEDURE_CAST g_mus_set_xcoeff, 1);
- rb_define_method(mus_xen_tag, "ycoeff=", XEN_PROCEDURE_CAST g_mus_set_ycoeff, 1);
- */
- rb_define_method(mus_xen_tag, "ramp", XEN_PROCEDURE_CAST g_mus_ramp, 0);
- rb_define_method(mus_xen_tag, "ramp=", XEN_PROCEDURE_CAST g_mus_set_ramp, 1);
- rb_define_method(mus_xen_tag, "hop", XEN_PROCEDURE_CAST g_mus_hop, 0);
- rb_define_method(mus_xen_tag, "hop=", XEN_PROCEDURE_CAST g_mus_set_hop, 1);
- rb_define_method(mus_xen_tag, "name", XEN_PROCEDURE_CAST g_mus_name, 0);
- rb_define_method(mus_xen_tag, "file_name", XEN_PROCEDURE_CAST g_mus_file_name, 0);
-#endif
+GEN_RF(all_pass, mus_all_pass_rf, mus_all_pass_unmodulated)
+GEN_RF(asymmetric_fm, mus_asymmetric_fm_rf, mus_asymmetric_fm_unmodulated)
+GEN_RF(comb, mus_comb_rf, mus_comb_unmodulated)
+GEN_RF(comb_bank, mus_comb_bank_rf, mus_comb_bank)
+GEN_RF(all_pass_bank, mus_all_pass_bank_rf, mus_all_pass_bank)
+GEN_RF_1(convolve, mus_convolve_rf)
+GEN_RF(delay, mus_delay_rf, mus_delay_unmodulated)
+GEN_RF_1(env, mus_env_rf)
+GEN_RF(filter, mus_filter_rf, mus_filter)
+GEN_RF(filtered_comb, mus_filtered_comb_rf, mus_filtered_comb_unmodulated)
+GEN_RF(filtered_comb_bank, mus_filtered_comb_bank_rf, mus_filtered_comb_bank)
+GEN_RF(fir_filter, mus_fir_filter_rf, mus_fir_filter)
+GEN_RF(firmant, mus_firmant_rf, mus_firmant)
+GEN_RF(formant, mus_formant_rf, mus_formant)
+GEN_RF_1(granulate, mus_granulate_rf)
+GEN_RF(iir_filter, mus_iir_filter_rf, mus_iir_filter)
+GEN_RF(moving_average, mus_moving_average_rf, mus_moving_average)
+GEN_RF(moving_max, mus_moving_max_rf, mus_moving_max)
+GEN_RF(moving_norm, mus_moving_norm_rf, mus_moving_norm)
+GEN_RF(ncos, mus_ncos_rf, mus_ncos)
+GEN_RF(notch, mus_notch_rf, mus_notch_unmodulated)
+GEN_RF(nrxycos, mus_nrxycos_rf, mus_nrxycos)
+GEN_RF(nrxysin, mus_nrxysin_rf, mus_nrxysin)
+GEN_RF(nsin, mus_nsin_rf, mus_nsin)
+GEN_RF(one_pole, mus_one_pole_rf, mus_one_pole)
+GEN_RF(one_pole_all_pass, mus_one_pole_all_pass_rf, mus_one_pole_all_pass)
+GEN_RF(one_zero, mus_one_zero_rf, mus_one_zero)
+GEN_RF(oscil, mus_oscil_rf, mus_oscil_fm)
+GEN_RF_1(oscil_bank, mus_oscil_bank_rf)
+GEN_RF_1(phase_vocoder, mus_phase_vocoder_rf)
+GEN_RF(polyshape, mus_polyshape_rf, mus_polyshape_unmodulated)
+GEN_RF(polywave, mus_polywave_rf, mus_polywave)
+GEN_RF(pulse_train, mus_pulse_train_rf, mus_pulse_train)
+GEN_RF(pulsed_env, mus_pulsed_env_rf, mus_pulsed_env)
+GEN_RF(rand, mus_rand_rf, mus_rand)
+GEN_RF(rand_interp, mus_rand_interp_rf, mus_rand_interp)
+GEN_RF_1(readin, mus_readin_rf)
+GEN_RF(rxykcos, mus_rxykcos_rf, mus_rxykcos)
+GEN_RF(rxyksin, mus_rxyksin_rf, mus_rxyksin)
+GEN_RF(sawtooth_wave, mus_sawtooth_wave_rf, mus_sawtooth_wave)
+GEN_RF(square_wave, mus_square_wave_rf, mus_square_wave)
+GEN_RF(src, mus_src_rf, mus_src_two)
+GEN_RF(table_lookup, mus_table_lookup_rf, mus_table_lookup)
+GEN_RF(triangle_wave, mus_triangle_wave_rf, mus_triangle_wave)
+GEN_RF(two_pole, mus_two_pole_rf, mus_two_pole)
+GEN_RF(two_zero, mus_two_zero_rf, mus_two_zero)
+GEN_RF(wave_train, mus_wave_train_rf, mus_wave_train)
+GEN_RF(ssb_am, mus_ssb_am_rf_1, mus_ssb_am_unmodulated)
+GEN_RF(tap, mus_tap_unmodulated, mus_tap)
+
+static s7_double oscil_rf_sxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1, rf2;
+ s7_double v1, v2;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ v1 = rf1(sc, p);
+ rf2 = (s7_rf_t)(**p); (*p)++;
+ v2 = rf2(sc, p);
+ return(mus_oscil(g, v1, v2));
+}
+
+static s7_double oscil_rf_ssx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1;
+ s7_pointer s1;
+ s7_double v1;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ v1 = rf1(sc, p);
+ return(mus_oscil(g, s7_slot_real_value(sc, s1, "oscil"), v1));
+}
+
+static s7_double oscil_rf_sss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ s2 = (**p); (*p)++;
+ return(mus_oscil(g, s7_slot_real_value(sc, s1, "oscil"), s7_slot_real_value(sc, s2, "oscil")));
+}
+
+static s7_double oscil_rf_srs(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ s2 = (**p); (*p)++;
+ return(mus_oscil(g, s7_number_to_real(sc, s1), s7_slot_real_value(sc, s2, "oscil")));
+}
+
+static s7_double oscil_rf_srx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1;
+ s7_pointer s1;
+ s7_double v1;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ v1 = rf1(sc, p);
+ return(mus_oscil(g, s7_number_to_real(sc, s1), v1));
+}
+
+
+static s7_rf_t oscil_rf_3(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ int len;
- init_keywords();
+ len = s7_list_length(sc, expr);
+ g = cadr_gen(sc, expr);
+ if (!g) return(NULL);
+ if (len < 4) return(oscil_rf(sc, expr));
+ if (len > 5) return(NULL);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_srate, g_mus_srate_w, H_mus_srate,
- S_setB S_mus_srate, g_mus_set_srate_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_float_equal_fudge_factor, g_mus_float_equal_fudge_factor_w, H_mus_float_equal_fudge_factor,
- S_setB S_mus_float_equal_fudge_factor, g_mus_set_float_equal_fudge_factor_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_array_print_length, g_mus_array_print_length_w, H_mus_array_print_length,
- S_setB S_mus_array_print_length, g_mus_set_array_print_length_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_clm_table_size, g_clm_table_size_w, H_clm_table_size,
- S_setB S_clm_table_size, g_set_clm_table_size_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_clm_default_frequency, g_clm_default_frequency_w, H_clm_default_frequency,
- S_setB S_clm_default_frequency, g_set_clm_default_frequency_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE(S_radians_to_hz, g_radians_to_hz_w, 1, 0, 0, H_radians_to_hz);
- XEN_DEFINE_PROCEDURE(S_hz_to_radians, g_hz_to_radians_w, 1, 0, 0, H_hz_to_radians);
- XEN_DEFINE_PROCEDURE(S_radians_to_degrees, g_radians_to_degrees_w, 1, 0, 0, H_radians_to_degrees);
- XEN_DEFINE_PROCEDURE(S_degrees_to_radians, g_degrees_to_radians_w, 1, 0, 0, H_degrees_to_radians);
- XEN_DEFINE_PROCEDURE(S_db_to_linear, g_db_to_linear_w, 1, 0, 0, H_db_to_linear);
- XEN_DEFINE_PROCEDURE(S_linear_to_db, g_linear_to_db_w, 1, 0, 0, H_linear_to_db);
- XEN_DEFINE_PROCEDURE(S_seconds_to_samples, g_seconds_to_samples_w, 1, 0, 0, H_seconds_to_samples);
- XEN_DEFINE_PROCEDURE(S_samples_to_seconds, g_samples_to_seconds_w, 1, 0, 0, H_samples_to_seconds);
- XEN_DEFINE_PROCEDURE(S_ring_modulate, g_ring_modulate_w, 2, 0, 0, H_ring_modulate);
- XEN_DEFINE_PROCEDURE(S_amplitude_modulate, g_amplitude_modulate_w, 3, 0, 0, H_amplitude_modulate);
- XEN_DEFINE_PROCEDURE(S_contrast_enhancement, g_contrast_enhancement_w, 1, 1, 0, H_contrast_enhancement);
- XEN_DEFINE_PROCEDURE(S_dot_product, g_dot_product_w, 2, 1, 0, H_dot_product);
-#if HAVE_COMPLEX_TRIG && XEN_HAVE_COMPLEX_NUMBERS
- XEN_DEFINE_PROCEDURE(S_edot_product, g_edot_product_w, 2, 0, 0, H_edot_product);
-#endif
- XEN_DEFINE_PROCEDURE(S_clear_array, g_clear_array_w, 1, 0, 0, H_clear_array);
- XEN_DEFINE_PROCEDURE(S_polynomial, g_polynomial_w, 2, 0, 0, H_polynomial);
- XEN_DEFINE_PROCEDURE(S_multiply_arrays, g_multiply_arrays_w, 2, 1, 0, H_multiply_arrays);
- XEN_DEFINE_PROCEDURE(S_make_fft_window, g_make_fft_window_w, 2, 2, 0, H_make_fft_window);
- XEN_DEFINE_PROCEDURE(S_mus_fft, g_mus_fft_w, 2, 2, 0, H_mus_fft);
- XEN_DEFINE_PROCEDURE(S_spectrum, g_spectrum_w, 3, 1, 0, H_mus_spectrum);
- XEN_DEFINE_PROCEDURE(S_autocorrelate, g_autocorrelate_w, 1, 0, 0, H_autocorrelate);
- XEN_DEFINE_PROCEDURE(S_correlate, g_correlate_w, 2, 0, 0, H_correlate);
- XEN_DEFINE_PROCEDURE(S_convolution, g_convolution_w, 2, 1, 0, H_mus_convolution);
- XEN_DEFINE_PROCEDURE(S_rectangular_to_polar, g_rectangular_to_polar_w, 2, 0, 0, H_rectangular_to_polar);
- XEN_DEFINE_PROCEDURE(S_rectangular_to_magnitudes, g_rectangular_to_magnitudes_w, 2, 0, 0, H_rectangular_to_magnitudes);
- XEN_DEFINE_PROCEDURE(S_polar_to_rectangular, g_polar_to_rectangular_w, 2, 0, 0, H_polar_to_rectangular);
- XEN_DEFINE_PROCEDURE(S_array_interp, g_array_interp_w, 2, 1, 0, H_array_interp);
- XEN_DEFINE_PROCEDURE(S_mus_interpolate, g_mus_interpolate_w, 3, 2, 0, H_mus_interpolate);
- XEN_DEFINE_PROCEDURE(S_mus_frandom, g_mus_frandom_w, 1, 0, 0, "random reals");
- XEN_DEFINE_PROCEDURE(S_mus_irandom, g_mus_irandom_w, 1, 0, 0, "random integers");
-
- XEN_DEFINE_CONSTANT(S_rectangular_window, MUS_RECTANGULAR_WINDOW, "The un-window, so to speak");
- XEN_DEFINE_CONSTANT(S_hann_window, MUS_HANN_WINDOW, "A simple raised cosine window");
- XEN_DEFINE_CONSTANT(S_welch_window, MUS_WELCH_WINDOW, "A triangular window squared");
- XEN_DEFINE_CONSTANT(S_parzen_window, MUS_PARZEN_WINDOW, "A triangular window");
- XEN_DEFINE_CONSTANT(S_bartlett_window, MUS_BARTLETT_WINDOW, "A triangular window");
- XEN_DEFINE_CONSTANT(S_bartlett_hann_window, MUS_BARTLETT_HANN_WINDOW, "A combination of the bartlett and hann windows");
- XEN_DEFINE_CONSTANT(S_bohman_window, MUS_BOHMAN_WINDOW, "A weighted cosine window");
- XEN_DEFINE_CONSTANT(S_flat_top_window, MUS_FLAT_TOP_WINDOW, "A sum of cosines window");
- XEN_DEFINE_CONSTANT(S_hamming_window, MUS_HAMMING_WINDOW, "A raised cosine");
- XEN_DEFINE_CONSTANT(S_blackman2_window, MUS_BLACKMAN2_WINDOW, "2nd order cosine window");
- XEN_DEFINE_CONSTANT(S_blackman3_window, MUS_BLACKMAN3_WINDOW, "3rd order cosine window");
- XEN_DEFINE_CONSTANT(S_blackman4_window, MUS_BLACKMAN4_WINDOW, "4th order cosine window");
- XEN_DEFINE_CONSTANT(S_blackman5_window, MUS_BLACKMAN5_WINDOW, "5th order cosine window");
- XEN_DEFINE_CONSTANT(S_blackman6_window, MUS_BLACKMAN6_WINDOW, "6th order cosine window");
- XEN_DEFINE_CONSTANT(S_blackman7_window, MUS_BLACKMAN7_WINDOW, "7th order cosine window");
- XEN_DEFINE_CONSTANT(S_blackman8_window, MUS_BLACKMAN8_WINDOW, "8th order cosine window");
- XEN_DEFINE_CONSTANT(S_blackman9_window, MUS_BLACKMAN9_WINDOW, "9th order cosine window");
- XEN_DEFINE_CONSTANT(S_blackman10_window, MUS_BLACKMAN10_WINDOW, "10th order cosine window");
- XEN_DEFINE_CONSTANT(S_exponential_window, MUS_EXPONENTIAL_WINDOW, "An inverted triangle from exp");
- XEN_DEFINE_CONSTANT(S_riemann_window, MUS_RIEMANN_WINDOW, "sinc-based window");
- XEN_DEFINE_CONSTANT(S_kaiser_window, MUS_KAISER_WINDOW, "Bessel I0 based window");
- XEN_DEFINE_CONSTANT(S_cauchy_window, MUS_CAUCHY_WINDOW, "window based on 1/(1+sqr(angle)");
- XEN_DEFINE_CONSTANT(S_poisson_window, MUS_POISSON_WINDOW, "window based on exp(-angle)");
- XEN_DEFINE_CONSTANT(S_gaussian_window, MUS_GAUSSIAN_WINDOW, "window based on exp(-sqr(angle))");
- XEN_DEFINE_CONSTANT(S_tukey_window, MUS_TUKEY_WINDOW, "window based on truncated cosine");
- XEN_DEFINE_CONSTANT(S_dolph_chebyshev_window, MUS_DOLPH_CHEBYSHEV_WINDOW, "window from inverse fft (using Chebyshev Tn)");
- XEN_DEFINE_CONSTANT(S_connes_window, MUS_CONNES_WINDOW, "triangle window squared twice");
- XEN_DEFINE_CONSTANT(S_hann_poisson_window, MUS_HANN_POISSON_WINDOW, "poisson window * hann window");
- XEN_DEFINE_CONSTANT(S_samaraki_window, MUS_SAMARAKI_WINDOW, "window from inverse fft (using Chebyshev Un)");
- XEN_DEFINE_CONSTANT(S_ultraspherical_window, MUS_ULTRASPHERICAL_WINDOW, "window from inverse fft (using Ultraspherical Cn)");
- XEN_DEFINE_CONSTANT(S_rv2_window, MUS_RV2_WINDOW, "Rife-Vincent 2nd order window (Hann extension)");
- XEN_DEFINE_CONSTANT(S_rv3_window, MUS_RV3_WINDOW, "Rife-Vincent 3rd order window (Hann extension)");
- XEN_DEFINE_CONSTANT(S_rv4_window, MUS_RV4_WINDOW, "Rife-Vincent 4th order window (Hann extension)");
- XEN_DEFINE_CONSTANT(S_mlt_sine_window, MUS_MLT_SINE_WINDOW, "modulated lapped transform sine window");
- XEN_DEFINE_CONSTANT(S_papoulis_window, MUS_PAPOULIS_WINDOW, "papoulise window");
- XEN_DEFINE_CONSTANT(S_dpss_window, MUS_DPSS_WINDOW, "proplate spheroidal (slepian) window");
- XEN_DEFINE_CONSTANT(S_sinc_window, MUS_SINC_WINDOW, "sinc (Lanczos) window");
-
- XEN_DEFINE_CONSTANT(S_mus_interp_linear, MUS_INTERP_LINEAR, "locsig/delay linear interpolation");
- XEN_DEFINE_CONSTANT(S_mus_interp_sinusoidal, MUS_INTERP_SINUSOIDAL, "locsig sinusoidal interpolation");
- XEN_DEFINE_CONSTANT(S_mus_interp_all_pass, MUS_INTERP_ALL_PASS, "delay interpolation");
- XEN_DEFINE_CONSTANT(S_mus_interp_lagrange, MUS_INTERP_LAGRANGE, "2nd order lagrange interpolation");
- XEN_DEFINE_CONSTANT(S_mus_interp_hermite, MUS_INTERP_HERMITE, "3rd order hermite interpolation");
- XEN_DEFINE_CONSTANT(S_mus_interp_none, MUS_INTERP_NONE, "no interpolation -- step func");
- XEN_DEFINE_CONSTANT(S_mus_interp_bezier, MUS_INTERP_BEZIER, "bezier interpolation");
-
- XEN_DEFINE_CONSTANT(S_mus_chebyshev_first_kind, MUS_CHEBYSHEV_FIRST_KIND, "Chebyshev polynomial of first kind, for " S_partials_to_polynomial);
- XEN_DEFINE_CONSTANT(S_mus_chebyshev_second_kind, MUS_CHEBYSHEV_SECOND_KIND, "Chebyshev polynomial of second kind, for " S_partials_to_polynomial);
-
- XEN_DEFINE_PROCEDURE(S_mus_describe, g_mus_describe_w, 1, 0, 0, H_mus_describe);
- XEN_DEFINE_PROCEDURE(S_mus_run, g_mus_run_w, 1, 2, 0, H_mus_run);
- XEN_DEFINE_PROCEDURE(S_mus_file_name, g_mus_file_name_w, 1, 0, 0, H_mus_file_name);
- XEN_DEFINE_PROCEDURE(S_mus_reset, g_mus_reset_w, 1, 0, 0, H_mus_reset);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_name, g_mus_name_w, H_mus_name, S_setB S_mus_name, g_mus_set_name_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_phase, g_mus_phase_w, H_mus_phase, S_setB S_mus_phase, g_mus_set_phase_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_scaler, g_mus_scaler_w, H_mus_scaler, S_setB S_mus_scaler, g_mus_set_scaler_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_safety, g_mus_safety_w, H_mus_safety, S_setB S_mus_safety, g_mus_set_safety_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_width, g_mus_width_w, H_mus_width, S_setB S_mus_width, g_mus_set_width_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_frequency, g_mus_frequency_w, H_mus_frequency, S_setB S_mus_frequency, g_mus_set_frequency_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_length, g_mus_length_w, H_mus_length, S_setB S_mus_length, g_mus_set_length_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_data, g_mus_data_w, H_mus_data, S_setB S_mus_data, g_mus_set_data_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_xcoeff, g_mus_xcoeff_w, H_mus_xcoeff, S_setB S_mus_xcoeff, g_mus_set_xcoeff_w, 2, 0, 3, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_ycoeff, g_mus_ycoeff_w, H_mus_ycoeff, S_setB S_mus_ycoeff, g_mus_set_ycoeff_w, 2, 0, 3, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_offset, g_mus_offset_w, H_mus_offset, S_setB S_mus_offset, g_mus_set_offset_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE(S_mus_xcoeffs, g_mus_xcoeffs_w, 1, 0, 0, H_mus_xcoeffs);
- XEN_DEFINE_PROCEDURE(S_mus_ycoeffs, g_mus_ycoeffs_w, 1, 0, 0, H_mus_ycoeffs);
- XEN_DEFINE_PROCEDURE(S_oscil_p, g_oscil_p_w, 1, 0, 0, H_oscil_p);
- XEN_DEFINE_PROCEDURE(S_oscil, g_oscil_w, 1, 2, 0, H_oscil);
- XEN_DEFINE_PROCEDURE(S_mus_apply, g_mus_apply_w, 0, 0, 1, H_mus_apply);
-
-
- XEN_DEFINE_PROCEDURE(S_make_delay, g_make_delay_w, 0, 0, 1, H_make_delay);
- XEN_DEFINE_PROCEDURE(S_make_comb, g_make_comb_w, 0, 0, 1, H_make_comb);
- XEN_DEFINE_PROCEDURE(S_make_filtered_comb, g_make_filtered_comb_w, 0, 0, 1, H_make_filtered_comb);
- XEN_DEFINE_PROCEDURE(S_make_notch, g_make_notch_w, 0, 0, 1, H_make_notch);
- XEN_DEFINE_PROCEDURE(S_make_all_pass, g_make_all_pass_w, 0, 0, 1, H_make_all_pass);
- XEN_DEFINE_PROCEDURE(S_make_moving_average, g_make_moving_average_w, 0, 0, 1, H_make_moving_average);
- XEN_DEFINE_PROCEDURE(S_delay, g_delay_w, 1, 2, 0, H_delay);
- XEN_DEFINE_PROCEDURE(S_delay_tick, g_delay_tick_w, 1, 1, 0, H_delay_tick);
- XEN_DEFINE_PROCEDURE(S_tap, g_tap_w, 1, 1, 0, H_tap);
- XEN_DEFINE_PROCEDURE(S_notch, g_notch_w, 1, 2, 0, H_notch);
- XEN_DEFINE_PROCEDURE(S_comb, g_comb_w, 1, 2, 0, H_comb);
- XEN_DEFINE_PROCEDURE(S_filtered_comb, g_filtered_comb_w, 1, 2, 0, H_filtered_comb);
- XEN_DEFINE_PROCEDURE(S_all_pass, g_all_pass_w, 1, 2, 0, H_all_pass);
- XEN_DEFINE_PROCEDURE(S_moving_average, g_moving_average_w, 1, 1, 0, H_moving_average);
- XEN_DEFINE_PROCEDURE(S_delay_p, g_delay_p_w, 1, 0, 0, H_delay_p);
- XEN_DEFINE_PROCEDURE(S_notch_p, g_notch_p_w, 1, 0, 0, H_notch_p);
- XEN_DEFINE_PROCEDURE(S_comb_p, g_comb_p_w, 1, 0, 0, H_comb_p);
- XEN_DEFINE_PROCEDURE(S_filtered_comb_p, g_filtered_comb_p_w, 1, 0, 0, H_filtered_comb_p);
- XEN_DEFINE_PROCEDURE(S_all_pass_p, g_all_pass_p_w, 1, 0, 0, H_all_pass_p);
- XEN_DEFINE_PROCEDURE(S_moving_average_p, g_moving_average_p_w, 1, 0, 0, H_moving_average_p);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_feedback, g_mus_feedback_w, H_mus_feedback, S_setB S_mus_feedback, g_mus_set_feedback_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_feedforward, g_mus_feedforward_w, H_mus_feedforward, S_setB S_mus_feedforward, g_mus_set_feedforward_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE(S_make_rand, g_make_rand_w, 0, 0, 1, H_make_rand);
- XEN_DEFINE_PROCEDURE(S_make_rand_interp, g_make_rand_interp_w, 0, 0, 1, H_make_rand_interp);
-#if HAVE_RUBY
- rb_define_alias(rb_mKernel, "kernel_rand", "rand");
-#endif
- XEN_DEFINE_PROCEDURE(S_rand, g_rand_w, 1, 1, 0, H_rand);
- XEN_DEFINE_PROCEDURE(S_rand_interp, g_rand_interp_w, 1, 1, 0, H_rand_interp);
- XEN_DEFINE_PROCEDURE(S_rand_p, g_rand_p_w, 1, 0, 0, H_rand_p);
- XEN_DEFINE_PROCEDURE(S_rand_interp_p, g_rand_interp_p_w, 1, 0, 0, H_rand_interp_p);
- XEN_DEFINE_PROCEDURE(S_mus_random, g_mus_random_w, 1, 0, 0, H_mus_random);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_rand_seed, g_mus_rand_seed_w, H_mus_rand_seed,
- S_setB S_mus_rand_seed, g_mus_set_rand_seed_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE(S_ncos, g_ncos_w, 1, 1, 0, H_ncos);
- XEN_DEFINE_PROCEDURE(S_ncos_p, g_ncos_p_w, 1, 0, 0, H_ncos_p);
- XEN_DEFINE_PROCEDURE(S_nsin, g_nsin_w, 1, 1, 0, H_nsin);
- XEN_DEFINE_PROCEDURE(S_nsin_p, g_nsin_p_w, 1, 0, 0, H_nsin_p);
-
- XEN_DEFINE_PROCEDURE(S_table_lookup_p, g_table_lookup_p_w, 1, 0, 0, H_table_lookup_p);
- XEN_DEFINE_PROCEDURE(S_make_table_lookup, g_make_table_lookup_w, 0, 0, 1, H_make_table_lookup);
- XEN_DEFINE_PROCEDURE(S_table_lookup, g_table_lookup_w, 1, 1, 0, H_table_lookup);
- XEN_DEFINE_PROCEDURE(S_partials_to_wave, g_partials_to_wave_w, 1, 2, 0, H_partials_to_wave);
- XEN_DEFINE_PROCEDURE(S_phase_partials_to_wave, g_phase_partials_to_wave_w, 1, 2, 0, H_phase_partials_to_wave);
-
-
- XEN_DEFINE_PROCEDURE(S_make_sawtooth_wave, g_make_sawtooth_wave_w, 0, 6, 0, H_make_sawtooth_wave);
- XEN_DEFINE_PROCEDURE(S_sawtooth_wave, g_sawtooth_wave_w, 1, 1, 0, H_sawtooth_wave);
- XEN_DEFINE_PROCEDURE(S_sawtooth_wave_p, g_sawtooth_wave_p_w, 1, 0, 0, H_sawtooth_wave_p);
- XEN_DEFINE_PROCEDURE(S_make_triangle_wave, g_make_triangle_wave_w, 0, 6, 0, H_make_triangle_wave);
- XEN_DEFINE_PROCEDURE(S_triangle_wave, g_triangle_wave_w, 1, 1, 0, H_triangle_wave);
- XEN_DEFINE_PROCEDURE(S_triangle_wave_p, g_triangle_wave_p_w, 1, 0, 0, H_triangle_wave_p);
- XEN_DEFINE_PROCEDURE(S_make_square_wave, g_make_square_wave_w, 0, 6, 0, H_make_square_wave);
- XEN_DEFINE_PROCEDURE(S_square_wave, g_square_wave_w, 1, 1, 0, H_square_wave);
- XEN_DEFINE_PROCEDURE(S_square_wave_p, g_square_wave_p_w, 1, 0, 0, H_square_wave_p);
- XEN_DEFINE_PROCEDURE(S_make_pulse_train, g_make_pulse_train_w, 0, 6, 0, H_make_pulse_train);
- XEN_DEFINE_PROCEDURE(S_pulse_train, g_pulse_train_w, 1, 1, 0, H_pulse_train);
- XEN_DEFINE_PROCEDURE(S_pulse_train_p, g_pulse_train_p_w, 1, 0, 0, H_pulse_train_p);
-
-
- XEN_DEFINE_PROCEDURE(S_asymmetric_fm, g_asymmetric_fm_w, 1, 2, 0, H_asymmetric_fm);
- XEN_DEFINE_PROCEDURE(S_asymmetric_fm_p, g_asymmetric_fm_p_w, 1, 0, 0, H_asymmetric_fm_p);
-
-
- XEN_DEFINE_PROCEDURE(S_make_one_zero, g_make_one_zero_w, 0, 4, 0, H_make_one_zero);
- XEN_DEFINE_PROCEDURE(S_one_zero, g_one_zero_w, 1, 1, 0, H_one_zero);
- XEN_DEFINE_PROCEDURE(S_one_zero_p, g_one_zero_p_w, 1, 0, 0, H_one_zero_p);
- XEN_DEFINE_PROCEDURE(S_make_one_pole, g_make_one_pole_w, 0, 4, 0, H_make_one_pole);
- XEN_DEFINE_PROCEDURE(S_one_pole, g_one_pole_w, 1, 1, 0, H_one_pole);
- XEN_DEFINE_PROCEDURE(S_one_pole_p, g_one_pole_p_w, 1, 0, 0, H_one_pole_p);
- XEN_DEFINE_PROCEDURE(S_make_two_zero, g_make_two_zero_w, 0, 6, 0, H_make_two_zero);
- XEN_DEFINE_PROCEDURE(S_two_zero, g_two_zero_w, 1, 1, 0, H_two_zero);
- XEN_DEFINE_PROCEDURE(S_two_zero_p, g_two_zero_p_w, 1, 0, 0, H_two_zero_p);
- XEN_DEFINE_PROCEDURE(S_make_two_pole, g_make_two_pole_w, 0, 6, 0, H_make_two_pole);
- XEN_DEFINE_PROCEDURE(S_two_pole, g_two_pole_w, 1, 1, 0, H_two_pole);
- XEN_DEFINE_PROCEDURE(S_two_pole_p, g_two_pole_p_w, 1, 0, 0, H_two_pole_p);
-
- XEN_DEFINE_PROCEDURE(S_make_wave_train, g_make_wave_train_w, 0, 0, 1, H_make_wave_train);
- XEN_DEFINE_PROCEDURE(S_wave_train, g_wave_train_w, 1, 1, 0, H_wave_train);
- XEN_DEFINE_PROCEDURE(S_wave_train_p, g_wave_train_p_w, 1, 0, 0, H_wave_train_p);
-
- XEN_DEFINE_PROCEDURE(S_make_frame, g_make_frame_w, 0, 0, 1, H_make_frame);
- XEN_DEFINE_PROCEDURE(S_make_frame "!", g_make_frame_unchecked_w, 0, 0, 1, H_make_frame);
- XEN_DEFINE_PROCEDURE(S_frame, g_frame_w, 0, 0, 1, H_frame);
-
- XEN_DEFINE_PROCEDURE(S_frame_p, g_frame_p_w, 1, 0, 0, H_frame_p);
- XEN_DEFINE_PROCEDURE(S_frame_add, g_frame_add_w, 2, 1, 0, H_frame_add);
- XEN_DEFINE_PROCEDURE(S_frame_multiply, g_frame_multiply_w, 2, 1, 0, H_frame_multiply);
-#if HAVE_SCHEME || HAVE_FORTH
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_frame_ref, g_frame_ref_w, H_frame_ref, S_setB S_frame_ref, g_frame_set_w, 2, 0, 3, 0);
-#endif
-#if HAVE_RUBY
- XEN_DEFINE_PROCEDURE(S_frame_ref, g_frame_ref_w, 2, 0, 0, H_frame_ref);
-#endif
- XEN_DEFINE_PROCEDURE(S_frame_set, g_frame_set_w, 3, 0, 0, H_frame_set);
+ s7_xf_store(sc, (s7_pointer)g);
+ return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, oscil_rf_srs, oscil_rf_sss, NULL, oscil_rf_srx, oscil_rf_ssx, oscil_rf_sxx));
+}
- XEN_DEFINE_PROCEDURE(S_make_mixer, g_make_mixer_w, 0, 0, 1, H_make_mixer);
- XEN_DEFINE_PROCEDURE(S_make_mixer "!", g_make_mixer_unchecked_w, 0, 0, 1, H_make_mixer);
- XEN_DEFINE_PROCEDURE(S_mixer, g_mixer_w, 0, 0, 1, H_mixer);
- XEN_DEFINE_PROCEDURE(S_mixer_p, g_mixer_p_w, 1, 0, 0, H_mixer_p);
- XEN_DEFINE_PROCEDURE(S_mixer_multiply, g_mixer_multiply_w, 2, 1, 0, H_mixer_multiply);
- XEN_DEFINE_PROCEDURE(S_mixer_add, g_mixer_add_w, 2, 1, 0, H_mixer_add);
- XEN_DEFINE_PROCEDURE(S_make_scalar_mixer, g_make_scalar_mixer_w, 2, 0, 0, H_make_scalar_mixer);
-#if HAVE_SCHEME || HAVE_FORTH
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mixer_ref, g_mixer_ref_w, H_mixer_ref, S_setB S_mixer_ref, g_mixer_set_w, 3, 0, 4, 0);
-#endif
-#if HAVE_RUBY
- XEN_DEFINE_PROCEDURE(S_mixer_ref, g_mixer_ref_w, 3, 0, 0, H_mixer_ref);
-#endif
- XEN_DEFINE_PROCEDURE(S_mixer_set, g_mixer_set_w, 4, 0, 0, H_mixer_set);
- XEN_DEFINE_PROCEDURE(S_frame_to_sample, g_frame_to_sample_w, 2, 0, 0, H_frame_to_sample);
- XEN_DEFINE_PROCEDURE(S_frame_to_list, g_frame_to_list_w, 1, 0, 0, H_frame_to_list);
- XEN_DEFINE_PROCEDURE(S_frame_to_frame, g_frame_to_frame_w, 2, 1, 0, H_frame_to_frame);
- XEN_DEFINE_PROCEDURE(S_sample_to_frame, g_sample_to_frame_w, 2, 1, 0, H_sample_to_frame);
-
-
- XEN_DEFINE_PROCEDURE(S_formant_bank, g_formant_bank_w, 2, 1, 0, H_formant_bank);
- XEN_DEFINE_PROCEDURE(S_formant_p, g_formant_p_w, 1, 0, 0, H_formant_p);
- XEN_DEFINE_PROCEDURE(S_make_formant, g_make_formant_w, 0, 4, 0, H_make_formant);
- XEN_DEFINE_PROCEDURE(S_formant, g_formant_w, 1, 2, 0, H_formant);
- XEN_DEFINE_PROCEDURE(S_firmant_p, g_firmant_p_w, 1, 0, 0, H_firmant_p);
- XEN_DEFINE_PROCEDURE(S_make_firmant, g_make_firmant_w, 0, 4, 0, H_make_firmant);
- XEN_DEFINE_PROCEDURE(S_firmant, g_firmant_w, 1, 2, 0, H_firmant);
-
- XEN_DEFINE_PROCEDURE(S_mus_set_formant_radius_and_frequency, g_set_formant_radius_and_frequency_w, 3, 0, 0, H_mus_set_formant_radius_and_frequency);
-
-
- XEN_DEFINE_PROCEDURE(S_make_polyshape, g_make_polyshape_w, 0, 0, 1, H_make_polyshape);
- XEN_DEFINE_PROCEDURE(S_polyshape, g_polyshape_w, 1, 2, 0, H_polyshape);
- XEN_DEFINE_PROCEDURE(S_polyshape_p, g_polyshape_p_w, 1, 0, 0, H_polyshape_p);
- XEN_DEFINE_PROCEDURE(S_partials_to_polynomial, g_partials_to_polynomial_w, 1, 1, 0, H_partials_to_polynomial);
- XEN_DEFINE_PROCEDURE(S_normalize_partials, g_normalize_partials_w, 1, 0, 0, H_normalize_partials);
- XEN_DEFINE_PROCEDURE(S_mus_chebyshev_t_sum, g_chebyshev_t_sum_w, 2, 0, 0, H_chebyshev_t_sum);
- XEN_DEFINE_PROCEDURE(S_mus_chebyshev_u_sum, g_chebyshev_u_sum_w, 2, 0, 0, H_chebyshev_u_sum);
- XEN_DEFINE_PROCEDURE(S_mus_chebyshev_tu_sum, g_chebyshev_tu_sum_w, 3, 0, 0, H_chebyshev_tu_sum);
- XEN_DEFINE_PROCEDURE(S_make_polywave, g_make_polywave_w, 0, 0, 1, H_make_polywave);
- XEN_DEFINE_PROCEDURE(S_polywave, g_polywave_w, 1, 1, 0, H_polywave);
- XEN_DEFINE_PROCEDURE(S_polywave_p, g_polywave_p_w, 1, 0, 0, H_polywave_p);
-
- XEN_DEFINE_PROCEDURE(S_make_nrxysin, g_make_nrxysin_w, 0, 0, 1, H_make_nrxysin);
- XEN_DEFINE_PROCEDURE(S_nrxysin, g_nrxysin_w, 1, 1, 0, H_nrxysin);
- XEN_DEFINE_PROCEDURE(S_nrxysin_p, g_nrxysin_p_w, 1, 0, 0, H_nrxysin_p);
- XEN_DEFINE_PROCEDURE(S_make_nrxycos, g_make_nrxycos_w, 0, 0, 1, H_make_nrxycos);
- XEN_DEFINE_PROCEDURE(S_nrxycos, g_nrxycos_w, 1, 1, 0, H_nrxycos);
- XEN_DEFINE_PROCEDURE(S_nrxycos_p, g_nrxycos_p_w, 1, 0, 0, H_nrxycos_p);
-
-
- XEN_DEFINE_PROCEDURE(S_make_filter, g_make_filter_w, 0, 6, 0, H_make_filter);
- XEN_DEFINE_PROCEDURE(S_filter, g_filter_w, 2, 0, 0, H_filter);
- XEN_DEFINE_PROCEDURE(S_filter_p, g_filter_p_w, 1, 0, 0, H_filter_p);
- XEN_DEFINE_PROCEDURE(S_make_fir_coeffs, g_make_fir_coeffs_w, 2, 0, 0, H_make_fir_coeffs);
- XEN_DEFINE_PROCEDURE(S_make_fir_filter, g_make_fir_filter_w, 0, 4, 0, H_make_fir_filter);
- XEN_DEFINE_PROCEDURE(S_fir_filter, g_fir_filter_w, 2, 0, 0, H_fir_filter);
- XEN_DEFINE_PROCEDURE(S_fir_filter_p, g_fir_filter_p_w, 1, 0, 0, H_fir_filter_p);
- XEN_DEFINE_PROCEDURE(S_make_iir_filter, g_make_iir_filter_w, 0, 4, 0, H_make_iir_filter);
- XEN_DEFINE_PROCEDURE(S_iir_filter, g_iir_filter_w, 2, 0, 0, H_iir_filter);
- XEN_DEFINE_PROCEDURE(S_iir_filter_p, g_iir_filter_p_w, 1, 0, 0, H_iir_filter_p);
- XEN_DEFINE_PROCEDURE(S_mus_order, g_mus_order_w, 1, 0, 0, H_mus_order);
-
-
- XEN_DEFINE_PROCEDURE(S_env_p, g_env_p_w, 1, 0, 0, H_env_p);
- XEN_DEFINE_PROCEDURE(S_env, g_env_w, 1, 0, 0, H_env);
- XEN_DEFINE_PROCEDURE(S_make_env, g_make_env_w, 0, 0, 1, H_make_env);
- XEN_DEFINE_PROCEDURE(S_env_interp, g_env_interp_w, 2, 0, 0, H_env_interp);
- XEN_DEFINE_PROCEDURE(S_env_any, g_env_any_w, 2, 0, 0, H_env_any);
-
-
- XEN_DEFINE_PROCEDURE(S_locsig_p, g_locsig_p_w, 1, 0, 0, H_locsig_p);
- XEN_DEFINE_PROCEDURE(S_locsig, g_locsig_w, 3, 0, 0, H_locsig);
- XEN_DEFINE_PROCEDURE(S_make_locsig, g_make_locsig_w, 0, 0, 1, H_make_locsig);
- XEN_DEFINE_PROCEDURE(S_move_locsig, g_move_locsig_w, 3, 0, 0, H_move_locsig);
- XEN_DEFINE_PROCEDURE(S_mus_channels, g_mus_channels_w, 1, 0, 0, H_mus_channels);
+static s7_double comb_rf_sxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1, rf2;
+ s7_double v1;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ v1 = rf1(sc, p);
+ rf2 = (s7_rf_t)(**p); (*p)++;
+ return(mus_comb(g, v1, rf2(sc, p)));
+}
-#if HAVE_SCHEME || HAVE_FORTH
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_locsig_ref, g_locsig_ref_w, H_locsig_ref, S_setB S_locsig_ref, g_locsig_set_w, 2, 0, 3, 0);
-#endif
+static s7_double comb_rf_ssx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1;
+ s7_pointer s1;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ return(mus_comb(g, s7_slot_real_value(sc, s1, "comb"), rf1(sc, p)));
+}
-#if HAVE_RUBY
- XEN_DEFINE_PROCEDURE(S_locsig_ref, g_locsig_ref_w, 2, 0, 0, H_locsig_ref);
-#endif
+static s7_double comb_rf_sss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ s2 = (**p); (*p)++;
+ return(mus_comb(g, s7_slot_real_value(sc, s1, "comb"), s7_slot_real_value(sc, s2, "comb")));
+}
- XEN_DEFINE_PROCEDURE(S_locsig_set, g_locsig_set_w, 3, 0, 0, H_locsig_set);
+static s7_rf_t comb_rf_3(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len < 4) return(comb_rf(sc, expr));
+ if (len > 5) return(NULL);
+ g = cadr_gen(sc, expr);
+ if ((!g) || (!mus_is_comb(g))) return(NULL);
+ s7_xf_store(sc, (s7_pointer)g);
+ return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, comb_rf_sss, NULL, NULL, comb_rf_ssx, comb_rf_sxx));
+}
-#if HAVE_SCHEME || HAVE_FORTH
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_locsig_reverb_ref, g_locsig_reverb_ref_w, H_locsig_reverb_ref,
- S_locsig_reverb_set, g_locsig_reverb_set_w, 2, 0, 3, 0);
-#endif
+static s7_double notch_rf_sxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1, rf2;
+ s7_double v1;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ v1 = rf1(sc, p);
+ rf2 = (s7_rf_t)(**p); (*p)++;
+ return(mus_notch(g, v1, rf2(sc, p)));
+}
-#if HAVE_RUBY
- XEN_DEFINE_PROCEDURE(S_locsig_reverb_ref, g_locsig_reverb_ref_w, 2, 0, 0, H_locsig_reverb_ref);
-#endif
-
- XEN_DEFINE_PROCEDURE(S_locsig_reverb_set, g_locsig_reverb_set_w, 3, 0, 0, H_locsig_reverb_set);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_locsig_type, g_locsig_type_w, H_locsig_type, S_setB S_locsig_type, g_set_locsig_type_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE(S_move_sound_p, g_move_sound_p_w, 1, 0, 0, H_move_sound_p);
- XEN_DEFINE_PROCEDURE(S_move_sound, g_move_sound_w, 3, 0, 0, H_move_sound);
- XEN_DEFINE_PROCEDURE(S_make_move_sound, g_make_move_sound_w, 1, 2, 0, H_make_move_sound);
-
- XEN_DEFINE_PROCEDURE(S_file_to_sample_p, g_file_to_sample_p_w, 1, 0, 0, H_file_to_sample_p);
- XEN_DEFINE_PROCEDURE(S_make_file_to_sample, g_make_file_to_sample_w, 1, 1, 0, H_make_file_to_sample);
- XEN_DEFINE_PROCEDURE(S_file_to_sample, g_file_to_sample_w, 2, 1, 0, H_file_to_sample);
- XEN_DEFINE_PROCEDURE(S_file_to_frame_p, g_file_to_frame_p_w, 1, 0, 0, H_file_to_frame_p);
- XEN_DEFINE_PROCEDURE(S_make_file_to_frame, g_make_file_to_frame_w, 1, 1, 0, H_make_file_to_frame);
- XEN_DEFINE_PROCEDURE(S_file_to_frame, g_file_to_frame_w, 2, 1, 0, H_file_to_frame);
- XEN_DEFINE_PROCEDURE(S_sample_to_file_p, g_sample_to_file_p_w, 1, 0, 0, H_sample_to_file_p);
- XEN_DEFINE_PROCEDURE(S_make_sample_to_file, g_make_sample_to_file_w, 1, 4, 0, H_make_sample_to_file);
- XEN_DEFINE_PROCEDURE(S_continue_sample_to_file, g_continue_sample_to_file_w, 1, 0, 0, H_continue_sample_to_file);
- XEN_DEFINE_PROCEDURE(S_continue_frame_to_file, g_continue_frame_to_file_w, 1, 0, 0, H_continue_frame_to_file);
- XEN_DEFINE_PROCEDURE(S_sample_to_file, g_sample_to_file_w, 4, 0, 0, H_sample_to_file);
- XEN_DEFINE_PROCEDURE(S_sample_to_file_add, g_sample_to_file_add_w, 2, 0, 0, H_sample_to_file_add);
- XEN_DEFINE_PROCEDURE(S_frame_to_file_p, g_frame_to_file_p_w, 1, 0, 0, H_frame_to_file_p);
- XEN_DEFINE_PROCEDURE(S_frame_to_file, g_frame_to_file_w, 3, 0, 0, H_frame_to_file);
- XEN_DEFINE_PROCEDURE(S_make_frame_to_file, g_make_frame_to_file_w, 1, 4, 0, H_make_frame_to_file);
- XEN_DEFINE_PROCEDURE(S_mus_input_p, g_input_p_w, 1, 0, 0, H_mus_input_p);
- XEN_DEFINE_PROCEDURE(S_mus_output_p, g_output_p_w, 1, 0, 0, H_mus_output_p);
- XEN_DEFINE_PROCEDURE(S_in_any, g_in_any_w, 3, 0, 0, H_in_any);
- XEN_DEFINE_PROCEDURE(S_ina, g_ina_w, 2, 0, 0, H_ina);
- XEN_DEFINE_PROCEDURE(S_inb, g_inb_w, 2, 0, 0, H_inb);
- XEN_DEFINE_PROCEDURE(S_out_any, g_out_any_w, 3, 1, 0, H_out_any);
- XEN_DEFINE_PROCEDURE(S_outa, g_outa_w, 2, 1, 0, H_outa);
- XEN_DEFINE_PROCEDURE(S_outb, g_outb_w, 2, 1, 0, H_outb);
- XEN_DEFINE_PROCEDURE(S_outc, g_outc_w, 2, 1, 0, H_outc);
- XEN_DEFINE_PROCEDURE(S_outd, g_outd_w, 2, 1, 0, H_outd);
- XEN_DEFINE_PROCEDURE(S_mus_close, g_mus_close_w, 1, 0, 0, H_mus_close);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_file_buffer_size, g_mus_file_buffer_size_w, H_mus_file_buffer_size,
- S_setB S_mus_file_buffer_size, g_mus_set_file_buffer_size_w, 0, 0, 1, 0);
-
-
- XEN_DEFINE_PROCEDURE(S_readin_p, g_readin_p_w, 1, 0, 0, H_readin_p);
- XEN_DEFINE_PROCEDURE(S_readin, g_readin_w, 1, 0, 0, H_readin);
- XEN_DEFINE_PROCEDURE(S_make_readin, g_make_readin_w, 0, 0, 1, H_make_readin);
- XEN_DEFINE_PROCEDURE(S_mus_channel, g_mus_channel_w, 1, 0, 0, H_mus_channel);
- XEN_DEFINE_PROCEDURE(S_mus_interp_type, g_mus_interp_type_w, 1, 0, 0, H_mus_interp_type);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_location, g_mus_location_w, H_mus_location, S_setB S_mus_location, g_mus_set_location_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_increment, g_mus_increment_w, H_mus_increment, S_setB S_mus_increment, g_mus_set_increment_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE(S_granulate_p, g_granulate_p_w, 1, 0, 0, H_granulate_p);
- XEN_DEFINE_PROCEDURE(S_granulate, g_granulate_w, 1, 2, 0, H_granulate);
- XEN_DEFINE_PROCEDURE(S_make_granulate, g_make_granulate_w, 0, 0, 1, H_make_granulate);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_ramp, g_mus_ramp_w, H_mus_ramp,
- S_setB S_mus_ramp, g_mus_set_ramp_w, 1, 0, 2, 0);
-
-
- XEN_DEFINE_PROCEDURE(S_clear_sincs, g_mus_clear_sincs_w, 0, 0, 0, "clears out any sinc tables");
- XEN_DEFINE_PROCEDURE(S_src_p, g_src_p_w, 1, 0, 0, H_src_p);
- XEN_DEFINE_PROCEDURE(S_src, g_src_w, 1, 2, 0, H_src);
- XEN_DEFINE_PROCEDURE(S_make_src, g_make_src_w, 0, 6, 0, H_make_src);
-
-
- XEN_DEFINE_PROCEDURE(S_convolve_p, g_convolve_p_w, 1, 0, 0, H_convolve_p);
- XEN_DEFINE_PROCEDURE(S_convolve, g_convolve_w, 1, 1, 0, H_convolve_gen);
- XEN_DEFINE_PROCEDURE(S_make_convolve, g_make_convolve_w, 0, 0, 1, H_make_convolve);
- XEN_DEFINE_PROCEDURE(S_convolve_files, g_convolve_files_w, 2, 2, 0, H_convolve_files);
-
- XEN_DEFINE_PROCEDURE(S_phase_vocoder_p, g_phase_vocoder_p_w, 1, 0, 0, H_phase_vocoder_p);
- XEN_DEFINE_PROCEDURE(S_phase_vocoder, g_phase_vocoder_w, 1, 4, 0, H_phase_vocoder);
- XEN_DEFINE_PROCEDURE(S_make_phase_vocoder, g_make_phase_vocoder_w, 0, 0, 1, H_make_phase_vocoder);
- XEN_DEFINE_PROCEDURE(S_phase_vocoder_amp_increments, g_phase_vocoder_amp_increments_w, 1, 0, 0, H_phase_vocoder_amp_increments);
- XEN_DEFINE_PROCEDURE(S_phase_vocoder_amps, g_phase_vocoder_amps_w, 1, 0, 0, H_phase_vocoder_amps);
- XEN_DEFINE_PROCEDURE(S_phase_vocoder_freqs, g_phase_vocoder_freqs_w, 1, 0, 0, H_phase_vocoder_freqs);
- XEN_DEFINE_PROCEDURE(S_phase_vocoder_phases, g_phase_vocoder_phases_w, 1, 0, 0, H_phase_vocoder_phases);
- XEN_DEFINE_PROCEDURE(S_phase_vocoder_phase_increments, g_phase_vocoder_phase_increments_w, 1, 0, 0, H_phase_vocoder_phase_increments);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_hop, g_mus_hop_w, H_mus_hop, S_setB S_mus_hop, g_mus_set_hop_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE(S_mus_mix, g_mus_mix_w, 2, 5, 0, H_mus_mix);
-
- XEN_DEFINE_PROCEDURE(S_make_ssb_am, g_make_ssb_am_w, 0, 4, 0, H_make_ssb_am);
- XEN_DEFINE_PROCEDURE(S_ssb_am, g_ssb_am_w, 1, 2, 0, H_ssb_am);
- XEN_DEFINE_PROCEDURE(S_ssb_am_p, g_ssb_am_p_w, 1, 0, 0, H_ssb_am_p);
- XEN_DEFINE_PROCEDURE("mus-ssb-bank", g_ssb_bank_w, 4, 0, 0, "an experiment");
-
- XEN_DEFINE_PROCEDURE(S_mus_generator_p, g_mus_generator_p_w, 1, 0, 0, H_mus_generator_p);
-
- XEN_DEFINE_VARIABLE(S_output, clm_output, XEN_FALSE);
- XEN_DEFINE_VARIABLE(S_reverb, clm_reverb, XEN_FALSE);
-
-#if HAVE_SCHEME && HAVE_GETTIMEOFDAY && HAVE_DIFFTIME && HAVE_SYS_TIME_H && (!_MSC_VER)
- XEN_DEFINE_PROCEDURE(S_get_internal_real_time, g_get_internal_real_time_w, 0, 0, 0, H_get_internal_real_time);
- XEN_DEFINE_CONSTANT(S_internal_time_units_per_second, 1, "units used by " S_get_internal_real_time);
-#endif
+static s7_rf_t notch_rf_3(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len < 4) return(notch_rf(sc, expr));
+ if (len > 5) return(NULL);
+ g = cadr_gen(sc, expr);
+ if ((!g) || (!mus_is_notch(g))) return(NULL);
+ s7_xf_store(sc, (s7_pointer)g);
+ return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, notch_rf_sxx));
+}
-#if (!HAVE_SCHEME)
- XEN_DEFINE_PROCEDURE(S_make_oscil, g_make_oscil_w, 0, 4, 0, H_make_oscil);
- XEN_DEFINE_PROCEDURE(S_make_ncos, g_make_ncos_w, 0, 4, 0, H_make_ncos);
- XEN_DEFINE_PROCEDURE(S_make_nsin, g_make_nsin_w, 0, 4, 0, H_make_nsin);
- XEN_DEFINE_PROCEDURE(S_make_asymmetric_fm, g_make_asymmetric_fm_w, 0, 8, 0, H_make_asymmetric_fm);
-#else
- XEN_DEFINE_PROCEDURE_STAR(S_make_oscil, g_make_oscil_w, "(frequency #f) (initial-phase 0.0)", H_make_oscil);
- XEN_DEFINE_PROCEDURE_STAR(S_make_ncos, g_make_ncos_w, "(frequency #f) (n 1)", H_make_ncos);
- XEN_DEFINE_PROCEDURE_STAR(S_make_nsin, g_make_nsin_w, "(frequency #f) (n 1)", H_make_nsin);
- XEN_DEFINE_PROCEDURE_STAR(S_make_asymmetric_fm, g_make_asymmetric_fm_w, "(frequency #f) (initial-phase 0.0) (r 1.0) (ratio 1.0)", H_make_asymmetric_fm);
-#endif
+static s7_double delay_rf_sxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1, rf2;
+ s7_double v1;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ v1 = rf1(sc, p);
+ rf2 = (s7_rf_t)(**p); (*p)++;
+ return(mus_delay(g, v1, rf2(sc, p)));
+}
+static s7_rf_t delay_rf_3(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len < 4) return(delay_rf(sc, expr));
+ if (len > 5) return(NULL);
+ g = cadr_gen(sc, expr);
+ if ((!g) || (!mus_is_delay(g))) return(NULL);
+ s7_xf_store(sc, (s7_pointer)g);
+ return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, delay_rf_sxx));
+}
+static s7_double all_pass_rf_sxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1, rf2;
+ s7_double v1;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ v1 = rf1(sc, p);
+ rf2 = (s7_rf_t)(**p); (*p)++;
+ return(mus_all_pass(g, v1, rf2(sc, p)));
+}
- /* -------- clm-print (see also snd-xen.c) -------- */
-#if (!USE_SND)
+static s7_rf_t all_pass_rf_3(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len < 4) return(all_pass_rf(sc, expr));
+ if (len > 5) return(NULL);
+ g = cadr_gen(sc, expr);
+ if ((!g) || (!mus_is_all_pass(g))) return(NULL);
+ s7_xf_store(sc, (s7_pointer)g);
+ return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, all_pass_rf_sxx));
+}
-#if HAVE_FORTH
-XEN_EVAL_C_STRING("<'> fth-print alias clm-print ( fmt :optional args -- )");
-#endif
+static s7_double ssb_am_rf_sss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ s2 = (**p); (*p)++;
+ return(mus_ssb_am(g, s7_slot_real_value(sc, s1, "ssb-am"), s7_slot_real_value(sc, s2, "ssb-am")));
+}
-#if HAVE_RUBY
- XEN_EVAL_C_STRING("def clm_print(str, *args)\n\
- $stdout.print format(str, *args)\n\
- end");
-#endif
+static s7_rf_t ssb_am_rf_3(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len < 4) return(ssb_am_rf(sc, expr));
+ if (len > 5) return(NULL);
+ g = cadr_gen(sc, expr);
+ if ((!g) || (!mus_is_ssb_am(g))) return(NULL);
+ s7_xf_store(sc, (s7_pointer)g);
+ return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, ssb_am_rf_sss, NULL, NULL, NULL, NULL));
+}
+
+static s7_double formant_rf_ssx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf1;
+ s7_pointer s1;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ rf1 = (s7_rf_t)(**p); (*p)++;
+ return(mus_formant_with_frequency(g, s7_slot_real_value(sc, s1, "formant"), rf1(sc, p)));
+}
+
+static s7_double formant_rf_sss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ mus_any *g; g = (mus_any *)(*(*p)); (*p)++;
+ s1 = (**p); (*p)++;
+ s2 = (**p); (*p)++;
+ return(mus_formant_with_frequency(g, s7_slot_real_value(sc, s1, "formant"), s7_slot_real_value(sc, s2, "formant")));
+}
+
+static s7_rf_t formant_rf_3(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len < 4) return(formant_rf(sc, expr));
+ if (len > 5) return(NULL);
+ g = cadr_gen(sc, expr);
+ if ((!g) || (!mus_is_formant(g))) return(NULL);
+ s7_xf_store(sc, (s7_pointer)g);
+ return(s7_rf_2(sc, cdr(expr), NULL, NULL, NULL, NULL, formant_rf_sss, NULL, NULL, formant_rf_ssx, NULL));
+}
+
+
+ /* formant-bank: c g r, or v for with_inputs */
+static s7_double formant_bank_rf_s(s7_scheme *sc, s7_pointer **p)
+{
+ mus_any *bank;
+ s7_pointer slot;
+ bank = (mus_any *)(**p); (*p)++;
+ slot = (**p); (*p)++;
+ return(mus_formant_bank(bank, s7_slot_real_value(sc, slot, "formant-bank")));
+}
+
+static s7_double formant_bank_rf_r(s7_scheme *sc, s7_pointer **p)
+{
+ mus_any *bank;
+ s7_pointer slot;
+ bank = (mus_any *)(**p); (*p)++;
+ slot = (**p); (*p)++;
+ return(mus_formant_bank(bank, s7_number_to_real(sc, slot)));
+}
+
+static s7_double formant_bank_rf_x(s7_scheme *sc, s7_pointer **p)
+{
+ mus_any *bank;
+ s7_rf_t r1;
+ bank = (mus_any *)(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ return(mus_formant_bank(bank, r1(sc, p)));
+}
+
+static s7_double formant_bank_rf_v(s7_scheme *sc, s7_pointer **p)
+{
+ mus_any *bank;
+ s7_double *els;
+ bank = (mus_any *)(**p); (*p)++;
+ els = (s7_double *)(**p); (*p)++;
+ return(mus_formant_bank_with_inputs(bank, els));
+}
+
+static s7_rf_t formant_bank_rf(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
+ g = cadr_gen(sc, expr);
+ if ((g) && (mus_is_formant_bank(g)))
+ {
+ s7_pointer a1, val_sym, val;
+ s7_int loc;
+ s7_rf_t rf;
+
+ s7_xf_store(sc, (s7_pointer)g);
+ a1 = caddr(expr);
+ if (s7_is_symbol(a1))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, a1);
+ if (slot == xen_undefined) return(NULL);
+ val = s7_slot_value(slot);
+ if (s7_is_real(val))
+ {
+ s7_xf_store(sc, (s7_pointer)slot);
+ return(formant_bank_rf_s);
+ }
+ if (s7_is_float_vector(val))
+ {
+ s7_xf_store(sc, (s7_pointer)s7_float_vector_elements(val));
+ return(formant_bank_rf_v);
+ }
+ return(NULL);
+ }
+ if (s7_is_real(a1))
+ {
+ s7_xf_store(sc, a1);
+ return(formant_bank_rf_r);
+ }
+ if (!s7_is_pair(a1)) return(NULL);
+ val_sym = car(a1);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ if (!s7_rf_function(sc, val)) return(NULL);
+ loc = s7_xf_store(sc, NULL);
+ rf = s7_rf_function(sc, val)(sc, a1);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+ return(formant_bank_rf_x);
+ }
+ return(NULL);
+}
+
+
+static s7_double set_formant_frequency_rf_x(s7_scheme *sc, s7_pointer **p)
+{
+ mus_any *f;
+ s7_rf_t r1;
+ f = (mus_any *)(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ return(mus_set_formant_frequency(f, r1(sc, p)));
+}
+
+static s7_rf_t set_formant_frequency_rf(s7_scheme *sc, s7_pointer expr)
+{
+ mus_any *g;
+ if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
+ g = cadr_gen(sc, expr);
+ if ((g) && (mus_is_formant(g)))
+ {
+ s7_pointer a1;
+ a1 = s7_caddr(expr);
+ if (s7_is_pair(a1))
+ {
+ s7_int loc;
+ s7_pointer val, val_sym;
+ s7_rf_t rf;
+ val_sym = car(a1);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ if (!s7_rf_function(sc, val)) return(NULL);
+ s7_xf_store(sc, (s7_pointer)g);
+ loc = s7_xf_store(sc, NULL);
+ rf = s7_rf_function(sc, val)(sc, a1);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+ return(set_formant_frequency_rf_x);
+ }
+ }
+ return(NULL);
+}
+
+
+static s7_double outa_x_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ s7_double val;
+ s7_rf_t rf;
+
+ ind = s7_slot_integer_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ out_any_2(ind, val, 0, S_outa);
+ return(val);
+}
+
+static s7_double outa_x_rf_checked(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer ind;
+ s7_double val;
+ s7_rf_t rf;
+
+ ind = s7_slot_value(**p); (*p)++;
+ if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_outa, 1, ind, "an integer");
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ out_any_2(s7_integer(ind), val, 0, S_outa);
+ return(val);
+}
+
+static s7_double outa_s_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_int ind;
+
+ ind = s7_slot_integer_value(**p); (*p)++;
+ val = s7_slot_real_value(sc, **p, "outa"); (*p)++;
+ out_any_2(ind, val, 0, S_outa);
+ return(val);
+}
+
+static s7_double outa_s_rf_checked(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_pointer ind;
+
+ ind = s7_slot_value(**p); (*p)++;
+ if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_outa, 1, ind, "an integer");
+ val = s7_slot_real_value(sc, **p, "outa"); (*p)++;
+ out_any_2(s7_integer(ind), val, 0, S_outa);
+ return(val);
+}
+
+static s7_double outa_x_rf_to_mus_xen(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_int pos;
+ s7_rf_t rf;
+
+ pos = s7_slot_integer_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+
+ if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
+ mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
+ return(val);
+}
+
+static s7_double outa_s_rf_to_mus_xen(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_int pos;
+
+ pos = s7_slot_integer_value(**p); (*p)++;
+ val = s7_slot_real_value(sc, **p, "outa"); (*p)++;
+ if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
+ mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
+ return(val);
+}
+
+static s7_double outb_x_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ s7_double val;
+ s7_rf_t rf;
+
+ ind = s7_slot_integer_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ out_any_2(ind, val, 1, S_outb);
+ return(val);
+}
+
+static s7_double outb_s_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ s7_double val;
+
+ ind = s7_slot_integer_value(**p); (*p)++;
+ val = s7_slot_real_value(sc, **p, "outb"); (*p)++;
+ out_any_2(ind, val, 1, S_outb);
+ return(val);
+}
+
+static s7_double mul_env_x_rf(s7_scheme *sc, s7_pointer **p);
+static s7_double mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p);
+
+static s7_double outa_mul_env_x_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_int pos;
+ s7_rf_t r2;
+ mus_any *g;
+
+ pos = s7_slot_integer_value(**p); (*p) += 3;
+ g = (mus_any *)(**p); (*p)++;
+ r2 = (s7_rf_t)(**p); (*p)++;
+ val = mus_env(g) * r2(sc, p);
+ if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
+ mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
+ return(val);
+}
+
+static s7_double outa_mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_int pos;
+ s7_rf_t r2;
+ mus_any *e, *o;
+
+ pos = s7_slot_integer_value(**p); (*p) += 3;
+ e = (mus_any *)(**p); (*p) += 2;
+ o = (mus_any *)(**p); (*p)++;
+ r2 = (s7_rf_t)(**p); (*p)++;
+ val = mus_env(e) * mus_polywave(o, r2(sc, p));
+
+ if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
+ mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
+ return(val);
+}
+
+
+static s7_double outa_mul_env_polywave_env_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_int pos;
+ mus_any *e, *o, *fe;
+
+ pos = s7_slot_integer_value(**p); (*p) += 3;
+ e = (mus_any *)(**p); (*p) += 2;
+ o = (mus_any *)(**p); (*p) += 2;
+ fe = (mus_any *)(**p); (*p)++;
+ val = mus_env(e) * mus_polywave(o, mus_env(fe));
+
+ if (!mus_simple_out_any_to_file(pos, val, 0, clm_output_gen))
+ mus_safe_out_any_to_file(pos, val, 0, clm_output_gen);
+ return(val);
+}
+
+
+static s7_rf_t out_rf(s7_scheme *sc, s7_pointer expr, int chan)
+{
+ s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
+ s7_rf_t rf = NULL;
+
+ if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
+ ind_sym = s7_cadr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if (ind_slot == xen_undefined) return(NULL);
+ ind = s7_slot_value(ind_slot);
+ if (!s7_is_integer(ind)) return(NULL);
+ if (ind < 0) return(NULL);
+ s7_xf_store(sc, ind_slot);
+
+ val_expr = s7_caddr(expr);
+ if (s7_is_symbol(val_expr))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, val_expr);
+ if (slot == xen_undefined) return(NULL);
+ s7_xf_store(sc, slot);
+ }
+ else
+ {
+ s7_int loc;
+ if (!s7_is_pair(val_expr)) return(NULL);
+ val_sym = car(val_expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ if (!s7_rf_function(sc, val)) return(NULL);
+ loc = s7_xf_store(sc, NULL);
+ rf = s7_rf_function(sc, val)(sc, val_expr);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+ }
+
+ if (s7_is_stepper(ind_slot))
+ {
+ if (chan == 0)
+ {
+ if (out_any_2 == safe_out_any_2_to_mus_xen)
+ {
+ if (rf == mul_env_polywave_x_rf)
+ {
+ s7_pointer fm;
+ fm = s7_caddr(s7_caddr(val_expr));
+ if ((s7_is_pair(fm)) &&
+ (s7_car(fm) == env_symbol) &&
+ (s7_is_symbol(s7_cadr(fm))))
+ return(outa_mul_env_polywave_env_rf);
+ return(outa_mul_env_polywave_x_rf);
+ }
+ if (rf == mul_env_x_rf)
+ return(outa_mul_env_x_rf);
+ return((rf) ? outa_x_rf_to_mus_xen : outa_s_rf_to_mus_xen);
+ }
+ return((rf) ? outa_x_rf : outa_s_rf);
+ }
+ return((rf) ? outb_x_rf : outb_s_rf);
+ }
+
+ if (chan == 0)
+ return((rf) ? outa_x_rf_checked : outa_s_rf_checked);
+ return(NULL);
+}
+
+static s7_rf_t outa_rf(s7_scheme *sc, s7_pointer expr)
+{
+ return(out_rf(sc, expr, 0));
+}
+
+static s7_rf_t outb_rf(s7_scheme *sc, s7_pointer expr)
+{
+ return(out_rf(sc, expr, 1));
+}
+
+
+static s7_double sample_to_file_rf_g(s7_scheme *sc, s7_pointer **p)
+{
+ /* (sample->file obj samp chan[always int] val) */
+ s7_int ind, chan;
+ mus_any *lc;
+ s7_double val;
+ s7_rf_t rf;
+
+ lc = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ chan = s7_integer(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ mus_sample_to_file(lc, ind, chan, val);
+ return(val);
+}
+
+static s7_rf_t sample_to_file_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer ind_sym, ind, ind_slot, chan, val_sym, val, val_expr;
+ s7_int loc;
+ s7_rf_t rf;
+ mus_any *lc;
+
+ lc = cadr_gen(sc, expr);
+ if ((!lc) || (!mus_is_sample_to_file(lc))) return(NULL);
+
+ ind_sym = s7_caddr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
+ ind = s7_slot_value(ind_slot);
+ if (!s7_is_integer(ind)) return(NULL);
+
+ chan = s7_cadddr(expr);
+ if (!s7_is_integer(chan)) return(NULL);
+
+ val_expr = s7_car(s7_cddddr(expr));
+ if (!s7_is_pair(val_expr)) return(NULL);
+ val_sym = s7_car(val_expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ if (!s7_rf_function(sc, val)) return(NULL);
+
+ s7_xf_store(sc, (s7_pointer)lc);
+ s7_xf_store(sc, ind_slot);
+ s7_xf_store(sc, chan);
+ loc = s7_xf_store(sc, NULL);
+ rf = s7_rf_function(sc, val)(sc, val_expr);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+
+ return(sample_to_file_rf_g);
+}
+
+
+static s7_double locsig_rf_x(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ mus_any *lc;
+ s7_double val;
+ s7_rf_t rf;
+
+ lc = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ mus_locsig(lc, ind, val);
+ return(val);
+}
+
+static s7_double locsig_rf_x_checked(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer ind;
+ mus_any *lc;
+ s7_double val;
+ s7_rf_t rf;
+
+ lc = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_value(**p); (*p)++;
+ if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_locsig, 2, ind, "an integer");
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ mus_locsig(lc, s7_integer(ind), val);
+ return(val);
+}
+
+static s7_double fm_violin_rf(s7_scheme *sc, s7_pointer **p);
+
+static s7_double locsig_fm_violin_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ mus_any *lc, *e, *o, *fp, *a;
+ s7_double val, vib;
+
+ lc = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p) += 3;
+
+ /* fm_violin_rf */
+ e = (mus_any *)(**p); (*p) += 2;
+ o = (mus_any *)(**p); (*p) += 2;
+ vib = s7_slot_real_value(sc, **p, "oscil"); (*p) += 3;
+ a = (mus_any *)(**p); (*p) += 2;
+ fp = (mus_any *)(**p); (*p)++;
+ val = mus_env(e) * mus_oscil_fm(o, vib + (mus_env(a) * mus_polywave(fp, vib)));
+
+ mus_locsig(lc, ind, val);
+ return(val);
+}
+
+static s7_rf_t locsig_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
+ s7_int loc;
+ s7_rf_t rf;
+ mus_any *lc;
+
+ lc = cadr_gen(sc, expr);
+ if ((!lc) || (!mus_is_locsig(lc))) return(NULL);
+
+ ind_sym = s7_caddr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if (ind_slot == xen_undefined) return(NULL);
+ ind = s7_slot_value(ind_slot);
+ if (!s7_is_integer(ind)) return(NULL);
+
+ val_expr = s7_cadddr(expr);
+ if (!s7_is_pair(val_expr)) return(NULL);
+ val_sym = s7_car(val_expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ if (!s7_rf_function(sc, val)) return(NULL);
+
+ s7_xf_store(sc, (s7_pointer)lc);
+ s7_xf_store(sc, ind_slot);
+ loc = s7_xf_store(sc, NULL);
+ rf = s7_rf_function(sc, val)(sc, val_expr);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+
+ if (rf == fm_violin_rf)
+ return(locsig_fm_violin_rf);
+ return((s7_is_stepper(ind_slot)) ? locsig_rf_x : locsig_rf_x_checked);
+}
+
+
+static s7_double move_sound_rf_g(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ mus_any *lc;
+ s7_double val;
+ s7_rf_t rf;
+
+ lc = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ mus_move_sound(lc, ind, val);
+ return(val);
+}
+
+static s7_rf_t move_sound_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr;
+ s7_int loc;
+ s7_rf_t rf;
+ mus_any *lc;
+
+ lc = cadr_gen(sc, expr);
+ if ((!lc) || (!mus_is_move_sound(lc))) return(NULL);
+
+ ind_sym = s7_caddr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
+ ind = s7_slot_value(ind_slot);
+ if (!s7_is_integer(ind)) return(NULL);
+
+ val_expr = s7_cadddr(expr);
+ if (!s7_is_pair(val_expr)) return(NULL);
+ val_sym = s7_car(val_expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ if (!s7_rf_function(sc, val)) return(NULL);
+
+ s7_xf_store(sc, (s7_pointer)lc);
+ s7_xf_store(sc, ind_slot);
+ loc = s7_xf_store(sc, NULL);
+ rf = s7_rf_function(sc, val)(sc, val_expr);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+
+ return(move_sound_rf_g);
+}
+
+
+static s7_double out_bank_rf_1(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_rf_t rf;
+ s7_int loc;
+ mus_any *g1;
+
+ g1 = (mus_any *)(**p); (*p)++;
+ loc = s7_slot_integer_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ if (mus_is_delay(g1))
+ out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
+ else out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
+ return(val);
+}
+
+static s7_double mul_s_comb_bank_x_rf(s7_scheme *sc, s7_pointer **p);
+
+static s7_double out_bank_rf_comb_bank_1(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val, s1;
+ s7_rf_t rf;
+ s7_int loc;
+ mus_any *g1, *o;
+
+ g1 = (mus_any *)(**p); (*p)++;
+ loc = s7_slot_integer_value(**p); (*p) += 2;
+
+ s1 = s7_slot_real_value(sc, **p, "out-bank"); (*p) += 2;
+ o = (mus_any *)(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = s1 * mus_comb_bank(o, rf(sc, p));
+
+ if (mus_is_delay(g1))
+ out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
+ else out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
+ return(val);
+}
+
+static s7_double out_bank_rf_comb_bank_2(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val, s1;
+ s7_rf_t rf;
+ s7_int loc;
+ mus_any *g1, *g2, *o;
+
+ g1 = (mus_any *)(**p); (*p)++;
+ g2 = (mus_any *)(**p); (*p)++;
+ loc = s7_slot_integer_value(**p); (*p) += 2;
+
+ s1 = s7_slot_real_value(sc, **p, "out-bank"); (*p) += 2;
+ o = (mus_any *)(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = s1 * mus_comb_bank(o, rf(sc, p));
+
+ if (mus_is_delay(g1))
+ {
+ out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
+ out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
+ }
+ else
+ {
+ out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
+ out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
+ }
+ return(val);
+}
+
+static s7_double out_bank_rf_2(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_rf_t rf;
+ s7_int loc;
+ mus_any *g1, *g2;
+
+ g1 = (mus_any *)(**p); (*p)++;
+ g2 = (mus_any *)(**p); (*p)++;
+ loc = s7_slot_integer_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ if (mus_is_delay(g1))
+ {
+ out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
+ out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
+ }
+ else
+ {
+ out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
+ out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
+ }
+ return(val);
+}
+
+static s7_double out_bank_rf_4(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double val;
+ s7_rf_t rf;
+ s7_int loc;
+ mus_any *g1, *g2, *g3, *g4;
+
+ g1 = (mus_any *)(**p); (*p)++;
+ g2 = (mus_any *)(**p); (*p)++;
+ g3 = (mus_any *)(**p); (*p)++;
+ g4 = (mus_any *)(**p); (*p)++;
+ loc = s7_slot_integer_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ if (mus_is_delay(g1))
+ {
+ out_any_2(loc, mus_delay_unmodulated_noz(g1, val), 0, "out-bank");
+ out_any_2(loc, mus_delay_unmodulated_noz(g2, val), 1, "out-bank");
+ out_any_2(loc, mus_delay_unmodulated_noz(g3, val), 2, "out-bank");
+ out_any_2(loc, mus_delay_unmodulated_noz(g4, val), 3, "out-bank");
+ }
+ else
+ {
+ out_any_2(loc, mus_all_pass_unmodulated_noz(g1, val), 0, "out-bank");
+ out_any_2(loc, mus_all_pass_unmodulated_noz(g2, val), 1, "out-bank");
+ out_any_2(loc, mus_all_pass_unmodulated_noz(g3, val), 2, "out-bank");
+ out_any_2(loc, mus_all_pass_unmodulated_noz(g4, val), 3, "out-bank");
+ }
+ return(val);
+}
+
+static s7_rf_t out_bank_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer ind_sym, ind, ind_slot, val_sym, val, val_expr, filts;
+ s7_int loc;
+ s7_rf_t rf;
+ s7_int i, len;
+ mus_xen *gn;
+ mus_any *g;
+ s7_pointer *els;
+
+ filts = s7_cadr(expr);
+ if (!s7_is_symbol(filts)) return(NULL);
+ filts = s7_symbol_value(sc, filts);
+ if (!s7_is_vector(filts)) return(NULL);
+ len = s7_vector_length(filts);
+ if ((len != 1) && (len != 2) && (len != 4)) return(NULL);
+ els = s7_vector_elements(filts);
+ gn = (mus_xen *)s7_object_value_checked(els[0], mus_xen_tag);
+ if (!gn) return(NULL);
+ g = gn->gen;
+ if ((!mus_is_delay(g)) && (!mus_is_all_pass(g))) return(NULL);
+ for (i = 0; i < len; i++)
+ s7_xf_store(sc, (s7_pointer)((mus_xen *)s7_object_value(els[i]))->gen);
+
+ ind_sym = s7_caddr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
+ ind = s7_slot_value(ind_slot);
+ if (!s7_is_integer(ind)) return(NULL);
+ s7_xf_store(sc, ind_slot);
+
+ val_expr = s7_cadddr(expr);
+ if (!s7_is_pair(val_expr)) return(NULL);
+ val_sym = s7_car(val_expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ if (!s7_rf_function(sc, val)) return(NULL);
+
+ loc = s7_xf_store(sc, NULL);
+ rf = s7_rf_function(sc, val)(sc, val_expr);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+
+ if (len == 1)
+ {
+ if (rf == mul_s_comb_bank_x_rf)
+ return(out_bank_rf_comb_bank_1);
+ return(out_bank_rf_1);
+ }
+ if (len == 2)
+ {
+ if (rf == mul_s_comb_bank_x_rf)
+ return(out_bank_rf_comb_bank_2);
+ return(out_bank_rf_2);
+ }
+ return(out_bank_rf_4);
+}
+
+
+static s7_double file_to_sample_rf_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ mus_any *stream;
+ stream = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ return(mus_file_to_sample(stream, ind, 0));
+}
+
+static s7_rf_t file_to_sample_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer ind_sym, ind_slot, ind, sym, o;
+ mus_xen *gn;
+
+ sym = s7_cadr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
+ if (!gn) return(NULL);
+ s7_xf_store(sc, (s7_pointer)(gn->gen));
+
+ if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
+ ind_sym = s7_caddr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
+ ind = s7_slot_value(ind_slot);
+ if (!s7_is_integer(ind)) return(NULL);
+ s7_xf_store(sc, ind_slot);
+
+ return(file_to_sample_rf_ss);
+}
+
+
+static s7_pointer file_to_frample_pf_sss(s7_scheme *sc, s7_pointer **p)
+{
+ /* (file->frample gen loc fv) -> fv */
+ s7_pointer fv;
+ s7_int ind;
+ mus_any *stream;
+
+ stream = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ fv = s7_slot_value(**p); (*p)++;
+ mus_file_to_frample(stream, ind, s7_float_vector_elements(fv));
+ return(fv);
+}
+
+static s7_pf_t file_to_frample_pf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer ind_sym, ind_slot, fv_slot, fv_sym, sym, o;
+ mus_xen *gn;
+
+ if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
+
+ sym = s7_cadr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
+ if (!gn) return(NULL);
+ s7_xf_store(sc, (s7_pointer)(gn->gen));
+
+ ind_sym = s7_caddr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
+ if (!s7_is_integer(s7_slot_value(ind_slot))) return(NULL);
+ s7_xf_store(sc, ind_slot);
+
+ fv_sym = s7_cadddr(expr);
+ if (!s7_is_symbol(fv_sym)) return(NULL);
+ fv_slot = s7_slot(sc, fv_sym);
+ if (fv_slot == xen_undefined) return(NULL);
+ if (!s7_is_float_vector(s7_slot_value(fv_slot))) return(NULL);
+ s7_xf_store(sc, fv_slot);
+
+ return(file_to_frample_pf_sss);
+}
+
+
+static s7_pointer frample_to_file_pf_sss(s7_scheme *sc, s7_pointer **p)
+{
+ /* (frample->file gen loc fv) -> fv */
+ s7_pointer fv;
+ s7_int ind;
+ mus_any *stream;
+
+ stream = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ fv = s7_slot_value(**p); (*p)++;
+ mus_frample_to_file(stream, ind, s7_float_vector_elements(fv));
+ return(fv);
+}
+
+static s7_pointer frample_to_file_pf_ssx(s7_scheme *sc, s7_pointer **p)
+{
+ /* (frample->file gen loc fv) -> fv */
+ s7_pointer fv;
+ s7_int ind;
+ s7_pf_t pf;
+ mus_any *stream;
+
+ stream = (mus_any *)(**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ pf = (s7_pf_t)(**p); (*p)++;
+ fv = pf(sc, p);
+ mus_frample_to_file(stream, ind, s7_float_vector_elements(fv));
+ return(fv);
+}
+
+static s7_pf_t frample_to_file_pf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer ind_sym, ind_slot, fv_slot, fv_sym, sym, o;
+ mus_xen *gn;
+ if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
+
+ sym = s7_cadr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
+ if (!gn) return(NULL);
+ s7_xf_store(sc, (s7_pointer)(gn->gen));
+
+ ind_sym = s7_caddr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
+ if (!s7_is_integer(s7_slot_value(ind_slot))) return(NULL);
+ s7_xf_store(sc, ind_slot);
+
+ fv_sym = s7_cadddr(expr);
+ if (s7_is_symbol(fv_sym))
+ {
+ fv_slot = s7_slot(sc, fv_sym);
+ if (fv_slot == xen_undefined) return(NULL);
+ if (!s7_is_float_vector(s7_slot_value(fv_slot))) return(NULL);
+ s7_xf_store(sc, fv_slot);
+ return(frample_to_file_pf_sss);
+ }
+ if (s7_is_pair(fv_sym))
+ {
+ s7_pp_t pp;
+ s7_pf_t pf;
+ s7_int loc;
+ pp = s7_pf_function(sc, s7_symbol_value(sc, s7_car(fv_sym)));
+ if (!pp) return(NULL);
+ loc = s7_xf_store(sc, NULL);
+ pf = pp(sc, fv_sym);
+ if (!pf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)pf);
+ return(frample_to_file_pf_ssx);
+ }
+ return(NULL);
+}
+
+
+static s7_pointer frample_to_frample_pf_all_s(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer matrix, in_data, in_chans, out_data, out_chans;
+ matrix = s7_slot_value(**p); (*p)++;
+ in_data = s7_slot_value(**p); (*p)++;
+ in_chans = s7_slot_value(**p); (*p)++;
+ out_data = s7_slot_value(**p); (*p)++;
+ out_chans = s7_slot_value(**p); (*p)++;
+
+ mus_frample_to_frample(s7_float_vector_elements(matrix), (int)sqrt(s7_vector_length(matrix)),
+ s7_float_vector_elements(in_data), s7_integer(in_chans),
+ s7_float_vector_elements(out_data), s7_integer(out_chans));
+ return(out_data);
+}
+
+static s7_pf_t frample_to_frample_pf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_int i;
+ s7_pointer p;
+ for (i = 0, p = s7_cdr(expr); (s7_is_pair(p)) && (i < 5); i++, p = s7_cdr(p))
+ {
+ if (s7_is_symbol(s7_car(p)))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, s7_car(p));
+ if (slot == xen_undefined) return(NULL);
+ s7_xf_store(sc, slot);
+ }
+ else return(NULL);
+ }
+ if ((i == 5) && (s7_is_null(sc, p)))
+ return(frample_to_frample_pf_all_s);
+ return(NULL);
+}
+
+static s7_double ina_rf_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ mus_any *stream;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ stream = (mus_any *)(**p); (*p)++;
+ return(mus_in_any(ind, 0, stream));
+}
+
+static s7_double ina_rf_ss_checked(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer ind;
+ mus_any *stream;
+ ind = s7_slot_value(**p); (*p)++;
+ if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_ina, 1, ind, "an integer");
+ stream = (mus_any *)(**p); (*p)++;
+ return(mus_in_any(s7_integer(ind), 0, stream));
+}
+
+static s7_double inb_rf_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ mus_any *stream;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ stream = (mus_any *)(**p); (*p)++;
+ return(mus_in_any(ind, 1, stream));
+}
+
+static s7_double inb_rf_ss_checked(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer ind;
+ mus_any *stream;
+ ind = s7_slot_value(**p); (*p)++;
+ if (!s7_is_integer(ind)) s7_wrong_type_arg_error(s7, S_inb, 1, ind, "an integer");
+ stream = (mus_any *)(**p); (*p)++;
+ return(mus_in_any(s7_integer(ind), 1, stream));
+}
+
+static s7_double ina_rf_fv(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer fv;
+ s7_int index;
+ index = s7_slot_integer_value(**p); (*p)++;
+ fv = (**p); (*p)++;
+ if ((index >= 0) && (index < s7_vector_length(fv)))
+ return(s7_float_vector_elements(fv)[index]);
+ return(0.0);
+}
+
+static s7_rf_t in_rf(s7_scheme *sc, s7_pointer expr, int chan)
+{
+ s7_pointer ind_sym, ind_slot, ind, sym, o;
+ mus_xen *gn;
+
+ if (!s7_is_null(sc, s7_cdddr(expr))) return(NULL);
+ ind_sym = s7_cadr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if (ind_slot == xen_undefined) return(NULL);
+ ind = s7_slot_value(ind_slot);
+ if (!s7_is_integer(ind)) return(NULL);
+ s7_xf_store(sc, ind_slot);
+
+ sym = s7_caddr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ if (s7_is_float_vector(o))
+ {
+ if ((chan == 0) &&
+ (s7_is_stepper(ind_slot)))
+ {
+ s7_xf_store(sc, o);
+ return(ina_rf_fv);
+ }
+ return(NULL);
+ }
+ gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
+ if (!gn) return(NULL);
+ s7_xf_store(sc, (s7_pointer)(gn->gen));
+ if (s7_is_stepper(ind_slot))
+ {
+ if (chan == 0)
+ return(ina_rf_ss);
+ return(inb_rf_ss);
+ }
+ if (chan == 0)
+ return(ina_rf_ss_checked);
+ return(inb_rf_ss_checked);
+}
+
+static s7_rf_t ina_rf(s7_scheme *sc, s7_pointer expr)
+{
+ return(in_rf(sc, expr, 0));
+}
+
+static s7_rf_t inb_rf(s7_scheme *sc, s7_pointer expr)
+{
+ return(in_rf(sc, expr, 1));
+}
+
+static s7_double in_any_rf_srs(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind, chan;
+ mus_any *stream;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ chan = s7_integer(**p); (*p)++;
+ stream = (mus_any *)(**p); (*p)++;
+ return(mus_in_any(ind, chan, stream));
+}
+
+static s7_rf_t in_any_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer ind_sym, ind_slot, ind, sym, o, chan;
+ mus_xen *gn;
+
+ if (!s7_is_null(sc, s7_cddddr(expr))) return(NULL);
+ ind_sym = s7_cadr(expr);
+ if (!s7_is_symbol(ind_sym)) return(NULL);
+ ind_slot = s7_slot(sc, ind_sym);
+ if ((ind_slot == xen_undefined) || (!s7_is_stepper(ind_slot))) return(NULL);
+ ind = s7_slot_value(ind_slot);
+ if (!s7_is_integer(ind)) return(NULL);
+ s7_xf_store(sc, ind_slot);
+
+ chan = s7_caddr(expr);
+ if (!s7_is_integer(chan)) return(NULL);
+ s7_xf_store(sc, chan);
+
+ sym = s7_cadddr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ gn = (mus_xen *)s7_object_value_checked(o, mus_xen_tag);
+ if (!gn) return(NULL);
+ s7_xf_store(sc, (s7_pointer)(gn->gen));
+ return(in_any_rf_srs);
+}
+
+
+#define RF2_TO_RF(CName, Rfnc) \
+ static s7_double CName ## _rf_r2(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_rf_t f; \
+ s7_double x, y; \
+ f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); \
+ f = (s7_rf_t)(**p); (*p)++; y = f(sc, p); \
+ return(Rfnc); \
+ } \
+ static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
+ (s7_arg_to_rf(sc, s7_cadr(expr))) && \
+ (s7_arg_to_rf(sc, s7_caddr(expr)))) \
+ return(CName ## _rf_r2); \
+ return(NULL); \
+ }
+
+#define RF_0(Call) \
+ static s7_double Call ## _rf_0(s7_scheme *sc, s7_pointer **p) \
+ { \
+ return(mus_ ## Call()); \
+ } \
+ static s7_rf_t Call ## _rf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if (!s7_is_null(sc, s7_cdr(expr))) return(NULL); \
+ return(Call ## _rf_0); \
+ }
+
+RF_0(srate)
+
+
+#define RF_1(Call) \
+ static s7_double Call ## _rf_s(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pointer slot; \
+ slot = (**p); (*p)++; \
+ return(mus_ ## Call(s7_slot_real_value(sc, slot, #Call))); \
+ } \
+ static s7_double Call ## _rf_c(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pointer slot; \
+ slot = (**p); (*p)++; \
+ return(mus_ ## Call(s7_number_to_real(sc, slot))); \
+ } \
+ static s7_double Call ## _rf_r(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_rf_t r; \
+ r = (s7_rf_t)(**p); (*p)++; \
+ return(mus_ ## Call(r(sc, p))); \
+ } \
+ static s7_rf_t Call ## _rf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ return(s7_rf_1(sc, expr, Call ## _rf_c, Call ## _rf_s, Call ## _rf_r)); \
+ }
+
+RF_1(odd_weight)
+RF_1(even_weight)
+RF_1(hz_to_radians)
+RF_1(radians_to_hz)
+RF_1(db_to_linear)
+RF_1(linear_to_db)
+RF_1(radians_to_degrees)
+RF_1(degrees_to_radians)
+RF_1(random)
+
+RF2_TO_RF(contrast_enhancement, mus_contrast_enhancement(x, y))
+RF2_TO_RF(odd_multiple, mus_odd_multiple(x, y))
+RF2_TO_RF(even_multiple, mus_even_multiple(x, y))
+RF2_TO_RF(ring_modulate, x * y)
+
+
+static s7_double polynomial_rf_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_double s2;
+ s1 = s7_slot_value(**p); (*p)++;
+ s2 = s7_slot_real_value(sc, **p, "polynomial"); (*p)++;
+ return(mus_polynomial(s7_float_vector_elements(s1), s2, s7_vector_length(s1)));
+}
+
+static s7_double polynomial_rf_sx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_rf_t r1;
+ s1 = s7_slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ return(mus_polynomial(s7_float_vector_elements(s1), r1(sc, p), s7_vector_length(s1)));
+}
+
+static s7_rf_t polynomial_rf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((s7_is_symbol(s7_cadr(expr))) &&
+ (s7_is_float_vector(s7_symbol_value(sc, s7_cadr(expr)))))
+ return(s7_rf_2(sc, expr, NULL, NULL, NULL, NULL, polynomial_rf_ss, NULL, NULL, polynomial_rf_sx, NULL));
+ return(NULL);
+}
+
+static s7_double pink_noise_rf_v(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s1 = s7_slot_value(**p); (*p)++;
+ return(mus_pink_noise(s1));
+}
+
+static s7_rf_t pink_noise_rf(s7_scheme *sc, s7_pointer expr)
+{
+ if (s7_is_symbol(s7_cadr(expr)))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, s7_cadr(expr));
+ if (s7_is_float_vector(s7_slot_value(slot)))
+ {
+ s7_xf_store(sc, slot);
+ return(pink_noise_rf_v);
+ }
+ }
+ return(NULL);
+}
+
+static s7_double piano_noise_rf_vr(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_double s2;
+ s1 = s7_slot_value(**p); (*p)++;
+ s2 = s7_slot_real_value(sc, **p, "piano-noise"); (*p)++;
+ return(piano_noise(s7_int_vector_elements(s1), s2));
+}
+
+static s7_rf_t piano_noise_rf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((s7_is_symbol(s7_cadr(expr))) &&
+ (s7_is_symbol(s7_caddr(expr))))
+ {
+ s7_pointer slot1, slot2;
+ slot1 = s7_slot(sc, s7_cadr(expr));
+ slot2 = s7_slot(sc, s7_caddr(expr));
+ if ((s7_is_int_vector(s7_slot_value(slot1))) &&
+ (s7_is_real(s7_slot_value(slot2))))
+ {
+ s7_xf_store(sc, slot1);
+ s7_xf_store(sc, slot2);
+ return(piano_noise_rf_vr);
+ }
+ }
+ return(NULL);
+}
+
+
+static s7_double array_interp_rf_sxr(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_int c2;
+ s7_rf_t r1;
+ s7_double x;
+ s1 = s7_slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ c2 = s7_integer(**p); (*p)++;
+ return(mus_array_interp(s7_float_vector_elements(s1), x, c2));
+}
+
+static s7_double array_interp_rf_sxs(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_int s2;
+ s7_rf_t r1;
+ s7_double x;
+ s1 = s7_slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ s2 = s7_slot_integer_value(**p); (*p)++;
+ return(mus_array_interp(s7_float_vector_elements(s1), x, s2));
+}
+
+static s7_rf_t array_interp_rf(s7_scheme *sc, s7_pointer expr)
+{
+ if (s7_is_symbol(s7_cadr(expr)))
+ {
+ s7_pointer rst, fv;
+ rst = cdr(expr);
+ fv = s7_slot(sc, s7_car(rst));
+ if ((fv != xen_undefined) &&
+ (s7_is_float_vector(s7_slot_value(fv))))
+ {
+ if ((!s7_is_null(sc, s7_cddr(rst))) &&
+ (s7_is_null(sc, s7_cdddr(rst))))
+ {
+ s7_xf_store(sc, fv);
+ return(s7_rf_2(sc, rst, NULL, NULL, array_interp_rf_sxr, NULL, NULL, array_interp_rf_sxs, NULL, NULL, NULL));
+ }
+ }
+ }
+ return(NULL);
+}
+
+static s7_double am_rf_rsx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double c1, c2;
+ s7_rf_t r1;
+ c1 = s7_number_to_real(sc, **p); (*p)++;
+ c2 = s7_slot_real_value(sc, **p, "amplitude-modulation"); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ return(mus_amplitude_modulate(c1, c2, r1(sc, p)));
+}
+
+static s7_rf_t am_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer a1, a2, a3;
+ a1 = s7_cadr(expr);
+ a2 = s7_caddr(expr);
+ a3 = s7_cadddr(expr);
+ if ((s7_is_real(a1)) &&
+ (s7_is_symbol(a2)) &&
+ (s7_is_pair(a3)))
+ {
+ s7_rp_t rp;
+ s7_rf_t rf;
+ s7_int loc;
+ s7_pointer sym, val;
+
+ s7_xf_store(sc, a1);
+ val = s7_slot(sc, a2);
+ if (val == xen_undefined) return(NULL);
+ s7_xf_store(sc, val);
+
+ sym = car(a3);
+ if (!s7_is_symbol(sym)) return(NULL);
+ val = s7_symbol_value(sc, sym);
+ rp = s7_rf_function(sc, val);
+ if (!rp) return(NULL);
+ loc = s7_xf_store(sc, NULL);
+ rf = rp(sc, a3);
+ if (!rf) return(NULL);
+ s7_xf_store_at(sc, loc, (s7_pointer)rf);
+
+ return(am_rf_rsx);
+ }
+ return(NULL);
+}
+
+
+static s7_double mul_env_x_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t r2;
+ mus_any *g;
+ (*p)++;
+ g = (mus_any *)(**p); (*p)++;
+ r2 = (s7_rf_t)(**p); (*p)++;
+ return(mus_env(g) * r2(sc, p));
+}
+
+static s7_double mul_env_oscil_x_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t r2;
+ mus_any *e, *o;
+ (*p)++;
+ e = (mus_any *)(**p); (*p) += 2;
+ o = (mus_any *)(**p); (*p)++;
+ r2 = (s7_rf_t)(**p); (*p)++;
+ return(mus_env(e) * mus_oscil_fm(o, r2(sc, p)));
+}
+
+static s7_double fm_violin_rf(s7_scheme *sc, s7_pointer **p)
+{
+ mus_any *e, *o, *fp, *a;
+ s7_double vib;
+ (*p)++;
+ e = (mus_any *)(**p); (*p) += 2;
+ o = (mus_any *)(**p); (*p) += 2;
+ vib = s7_slot_real_value(sc, **p, "oscil"); (*p) += 3;
+ a = (mus_any *)(**p); (*p) += 2;
+ fp = (mus_any *)(**p); (*p)++;
+ return(mus_env(e) * mus_oscil_fm(o, vib + (mus_env(a) * mus_polywave(fp, vib))));
+}
+
+static s7_double mul_env_polywave_x_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t r2;
+ mus_any *e, *o;
+ (*p)++;
+ e = (mus_any *)(**p); (*p) += 2;
+ o = (mus_any *)(**p); (*p)++;
+ r2 = (s7_rf_t)(**p); (*p)++;
+ return(mus_env(e) * mus_polywave(o, r2(sc, p)));
+}
+
+static s7_double mul_env_polywave_s_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double s1;
+ mus_any *e, *o;
+ (*p)++;
+ e = (mus_any *)(**p); (*p) += 2;
+ o = (mus_any *)(**p); (*p)++;
+ s1 = s7_slot_real_value(sc, **p, "polywave"); (*p)++;
+ return(mus_env(e) * mus_polywave(o, s1));
+}
+
+static s7_double mul_s_comb_bank_x_rf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t r1;
+ s7_double s1;
+ mus_any *o;
+ s1 = s7_slot_real_value(sc, **p, "comb-bank"); (*p) += 2;
+ o = (mus_any *)(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ return(s1 * mus_comb_bank(o, r1(sc, p)));
+}
+
+static s7_rp_t initial_multiply_rf;
+static s7_rf_t clm_multiply_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_rf_t f;
+ f = initial_multiply_rf(sc, expr);
+ if ((f) &&
+ (s7_is_null(sc, s7_cdddr(expr))))
+ {
+ s7_pointer a1, a2;
+ a1 = s7_cadr(expr);
+ a2 = s7_caddr(expr);
+ if (s7_is_pair(a1))
+ {
+ if ((s7_car(a1) == env_symbol) &&
+ (s7_is_pair(a2)) &&
+ (s7_is_symbol(s7_cadr(a1))) &&
+ (s7_is_null(sc, s7_cdddr(expr))))
+ {
+ if ((s7_is_symbol(s7_cadr(a2))) &&
+ (s7_is_null(sc, s7_cdddr(a2))))
+ {
+ if (s7_is_pair(s7_caddr(a2)))
+ {
+ if (s7_car(a2) == oscil_symbol)
+ {
+ s7_pointer fm;
+ fm = s7_caddr(a2);
+ if ((s7_car(fm) == add_symbol) &&
+ (s7_is_symbol(s7_cadr(fm))) &&
+ (s7_is_pair(s7_caddr(fm))))
+ {
+ s7_pointer vib_sym;
+ vib_sym = s7_cadr(fm);
+ fm = s7_caddr(fm);
+ if ((s7_car(fm) == multiply_symbol) &&
+ (s7_is_pair(s7_cadr(fm))) &&
+ (s7_caadr(fm) == env_symbol) &&
+ (s7_is_pair(s7_caddr(fm))) &&
+ (s7_is_null(sc, s7_cdddr(fm))))
+ {
+ fm = s7_caddr(fm);
+ if ((s7_car(fm) == polywave_symbol) &&
+ (s7_is_symbol(s7_cadr(fm))) &&
+ (s7_is_symbol(s7_caddr(fm))) &&
+ (s7_caddr(fm) == vib_sym))
+ return(fm_violin_rf);
+ }
+ }
+ return(mul_env_oscil_x_rf);
+ }
+ else
+ {
+ if (s7_car(a2) == polywave_symbol)
+ return(mul_env_polywave_x_rf);
+ }
+ }
+ if (s7_is_symbol(s7_caddr(a2)))
+ {
+ if (s7_car(a2) == polywave_symbol)
+ return(mul_env_polywave_s_rf);
+ }
+ }
+ return(mul_env_x_rf);
+ }
+ }
+ else
+ {
+ if ((s7_is_symbol(a1)) &&
+ (s7_is_pair(a2)) &&
+ (s7_is_symbol(s7_cadr(a2))) &&
+ (s7_car(a2) == comb_bank_symbol) &&
+ (s7_is_pair(s7_caddr(a2))) &&
+ (s7_is_null(sc, s7_cdddr(a2))))
+ return(mul_s_comb_bank_x_rf);
+ }
+ }
+ return(f);
+}
+
+
+static s7_double add_env_ri_rf(s7_scheme *sc, s7_pointer **p)
+{
+ mus_any *e, *o;
+ (*p)++;
+ e = (mus_any *)(**p); (*p) += 2;
+ o = (mus_any *)(**p); (*p)++;
+ return(mus_env(e) + mus_rand_interp_unmodulated(o));
+}
+
+static s7_double add_tri_ri_rf(s7_scheme *sc, s7_pointer **p)
+{
+ mus_any *e, *o;
+ (*p)++; /* triangle-wave */
+ e = (mus_any *)(**p); (*p) += 2; /* rand-interp */
+ o = (mus_any *)(**p); (*p)++;
+ return(mus_triangle_wave_unmodulated(e) + mus_rand_interp_unmodulated(o));
+}
+
+static s7_rp_t initial_add_rf;
+static s7_rf_t clm_add_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_rf_t f;
+ f = initial_add_rf(sc, expr);
+ if (f)
+ {
+ s7_pointer a1, a2;
+ a1 = s7_cadr(expr);
+ a2 = s7_caddr(expr);
+ if ((s7_is_pair(a1)) &&
+ (s7_is_pair(a2)) &&
+ (s7_car(a2) == rand_interp_symbol) &&
+ (s7_is_symbol(s7_cadr(a1))) &&
+ (s7_is_symbol(s7_cadr(a2))) &&
+ (s7_is_null(sc, s7_cddr(a1))) &&
+ (s7_is_null(sc, s7_cddr(a2))) &&
+ (s7_is_null(sc, s7_cdddr(expr))))
+ {
+ if (s7_car(a1) == triangle_wave_symbol)
+ return(add_tri_ri_rf);
+ if (s7_car(a1) == env_symbol)
+ return(add_env_ri_rf);
+ }
+ }
+ return(f);
+}
+
+
+static s7_double env_rf_v(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer v;
+ mus_xen *gn;
+ s7_Int ind;
+
+ v = (**p); (*p)++;
+ ind = s7_slot_integer_value(**p); (*p)++;
+ if ((ind < 0) || (ind >= s7_vector_length(v)))
+ s7_out_of_range_error(s7, "vector-ref", 2, s7_make_integer(sc, ind), "must fit in vector");
+
+ gn = (mus_xen *)s7_object_value_checked(s7_vector_elements(v)[ind], mus_xen_tag);
+ return(mus_env(gn->gen));
+}
+
+static s7_rf_t env_rf_1(s7_scheme *sc, s7_pointer expr)
+{
+ if ((s7_is_pair(expr)) &&
+ (s7_is_pair(cdr(expr))) &&
+ (s7_is_pair(cadr(expr))))
+ {
+ s7_pointer a1;
+ a1 = s7_cadr(expr);
+ if ((s7_car(a1) == vector_ref_symbol) &&
+ (s7_is_symbol(s7_cadr(a1))) &&
+ (s7_is_symbol(s7_caddr(a1))) &&
+ (s7_is_null(sc, s7_cdddr(a1))))
+ {
+ s7_pointer s1, s2, v, ind;
+ s7_pointer *els;
+ int i, vlen;
+
+ s1 = s7_cadr(a1);
+ s2 = s7_caddr(a1);
+
+ v = s7_symbol_value(sc, s1);
+ if (!s7_is_vector(v)) return(NULL);
+ vlen = s7_vector_length(v);
+ els = s7_vector_elements(v);
+ for (i= 0; i < vlen; i++)
+ {
+ mus_xen *gn;
+ gn = (mus_xen *)s7_object_value_checked(els[i], mus_xen_tag);
+ if ((!gn) || (!(gn->gen)) || (!mus_is_env(gn->gen))) return(NULL);
+ }
+
+ ind = s7_slot(sc, s2);
+ if ((ind == xen_undefined) || (!s7_is_integer(s7_slot_value(ind)))) return(NULL);
+
+ s7_xf_store(sc, v);
+ s7_xf_store(sc, ind);
+ return(env_rf_v);
+ }
+ }
+ return(env_rf(sc, expr));
+}
+
+
+static s7_double chebyshev_t_rf_a(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf;
+ s7_pf_t pf;
+ s7_double x;
+ s7_pointer fv;
+ rf = (s7_rf_t)(**p); (*p)++;
+ x = rf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ fv = pf(sc, p);
+ return(mus_chebyshev_t_sum(x, s7_vector_length(fv), s7_float_vector_elements(fv)));
+}
+
+static s7_rf_t chebyshev_t_rf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) &&
+ (s7_arg_to_rf(sc, s7_cadr(expr))) &&
+ (s7_arg_to_pf(sc, s7_caddr(expr))))
+ return(chebyshev_t_rf_a);
+ return(NULL);
+}
+
+static s7_double chebyshev_u_rf_a(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf;
+ s7_pf_t pf;
+ s7_double x;
+ s7_pointer fv;
+ rf = (s7_rf_t)(**p); (*p)++;
+ x = rf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ fv = pf(sc, p);
+ return(mus_chebyshev_u_sum(x, s7_vector_length(fv), s7_float_vector_elements(fv)));
+}
+
+static s7_rf_t chebyshev_u_rf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) &&
+ (s7_arg_to_rf(sc, s7_cadr(expr))) &&
+ (s7_arg_to_pf(sc, s7_caddr(expr))))
+ return(chebyshev_u_rf_a);
+ return(NULL);
+}
+
+static s7_double chebyshev_tu_rf_a(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf;
+ s7_pf_t pf;
+ s7_double x;
+ s7_pointer t, u;
+ rf = (s7_rf_t)(**p); (*p)++;
+ x = rf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ t = pf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ u = pf(sc, p);
+ return(mus_chebyshev_tu_sum(x, s7_vector_length(t), s7_float_vector_elements(t), s7_float_vector_elements(u)));
+}
+
+static s7_rf_t chebyshev_tu_rf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_pair(s7_cdddr(expr))) && (s7_is_null(sc, s7_cddddr(expr))) &&
+ (s7_arg_to_rf(sc, s7_cadr(expr))) &&
+ (s7_arg_to_pf(sc, s7_caddr(expr))) &&
+ (s7_arg_to_pf(sc, s7_cadddr(expr))))
+ return(chebyshev_tu_rf_a);
+ return(NULL);
+}
+
+
+#define PF2_TO_RF(CName, Cfnc) \
+ static s7_double CName ## _rf_a(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pf_t f; \
+ s7_pointer x, y; \
+ f = (s7_pf_t)(**p); (*p)++; \
+ x = f(sc, p); \
+ f = (s7_pf_t)(**p); (*p)++; \
+ y = f(sc, p); \
+ return(Cfnc); \
+ } \
+ static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
+ (s7_arg_to_pf(sc, s7_cadr(expr))) && \
+ (s7_arg_to_pf(sc, s7_caddr(expr)))) \
+ return(CName ## _rf_a); \
+ return(NULL); \
+ }
+
+static s7_double c_dot_product(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ s7_int len, lim;
+ len = s7_vector_length(x);
+ lim = s7_vector_length(y);
+ if (lim < len) len = lim;
+ if (len == 0) return(0.0);
+ return(mus_dot_product(s7_float_vector_elements(x), s7_float_vector_elements(y), len));
+}
+
+PF2_TO_RF(dot_product, c_dot_product(sc, x, y))
+
+static s7_pointer mus_fft_pf_i2(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t pf;
+ s7_if_t xf;
+ s7_pointer rl, im;
+ s7_int size, dir;
+ pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
+ xf = (s7_if_t)(**p); (*p)++; size = xf(sc, p);
+ xf = (s7_if_t)(**p); (*p)++; dir = xf(sc, p);
+ mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), size, dir);
+ return(rl);
+}
+
+static s7_pointer mus_fft_pf_i1(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t pf;
+ s7_if_t xf;
+ s7_pointer rl, im;
+ s7_int size;
+ pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
+ xf = (s7_if_t)(**p); (*p)++; size = xf(sc, p);
+ mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), size, 1);
+ return(rl);
+}
+
+static s7_pointer mus_fft_pf_i0(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t pf;
+ s7_pointer rl, im;
+ pf = (s7_pf_t)(**p); (*p)++; rl = pf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++; im = pf(sc, p);
+ mus_fft(s7_float_vector_elements(rl), s7_float_vector_elements(im), s7_vector_length(rl), 1);
+ return(rl);
+}
+
+static s7_pf_t mus_fft_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))))
+ {
+ s7_pointer trailers;
+ if (!s7_arg_to_pf(sc, s7_cadr(expr))) return(NULL);
+ if (!s7_arg_to_pf(sc, s7_caddr(expr))) return(NULL);
+ trailers = s7_cdddr(expr);
+ if (s7_is_null(sc, trailers)) return(mus_fft_pf_i0);
+ if (!s7_arg_to_if(sc, s7_car(trailers))) return(NULL);
+ if (s7_is_null(sc, s7_cdr(trailers))) return(mus_fft_pf_i1);
+ if (!s7_arg_to_if(sc, s7_cadr(trailers))) return(NULL);
+ if (!s7_is_null(sc, s7_cddr(trailers))) return(NULL);
+ return(mus_fft_pf_i2);
+ }
+ return(NULL);
+}
+
+
+#define MG_RF(Method, Func) \
+ static s7_double mus_ ## Method ## _rf_g(s7_scheme *sc, s7_pointer **p) \
+ { \
+ mus_any *g; g = (mus_any *)(**p); (*p)++; \
+ return(Func(g)); \
+ } \
+ static s7_rf_t mus_ ## Method ## _rf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ mus_any *g; \
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
+ g = cadr_gen(sc, expr); \
+ if (g) {s7_xf_store(sc, (s7_pointer)g); return(mus_ ## Method ## _rf_g);} \
+ return(NULL); \
+ }
+
+#define MG_IF(Method, Func) \
+ static s7_int mus_ ## Method ## _if_g(s7_scheme *sc, s7_pointer **p) \
+ { \
+ mus_any *g; g = (mus_any *)(**p); (*p)++; \
+ return(Func(g)); \
+ } \
+ static s7_if_t mus_ ## Method ## _if(s7_scheme *sc, s7_pointer expr) \
+ { \
+ mus_any *g; \
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
+ g = cadr_gen(sc, expr); \
+ if (g) {s7_xf_store(sc, (s7_pointer)g); return(mus_ ## Method ## _if_g);} \
+ return(NULL); \
+ }
+
+#define PF_PF(Method, Func) \
+ static s7_pointer mus_ ## Method ## _pf_g(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pf_t f; \
+ s7_pointer g; \
+ f = (s7_pf_t)(**p); (*p)++; \
+ g = f(sc, p); \
+ return(Func(g)); \
+ } \
+ static s7_pf_t mus_ ## Method ## _pf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); \
+ if (s7_arg_to_pf(sc, s7_cadr(expr))) return(mus_ ## Method ## _pf_g); \
+ return(NULL); \
+ }
+
+MG_RF(scaler, mus_scaler)
+MG_RF(phase, mus_phase)
+MG_RF(frequency, mus_frequency)
+MG_RF(offset, mus_offset)
+MG_RF(width, mus_width)
+MG_RF(increment, mus_increment)
+MG_RF(feedforward, mus_feedforward)
+MG_RF(feedback, mus_feedback)
+
+MG_IF(length, mus_length)
+MG_IF(order, mus_order)
+MG_IF(location, mus_location)
+MG_IF(channel, mus_channel)
+MG_IF(channels, mus_channels)
+MG_IF(ramp, mus_ramp)
+MG_IF(hop, mus_hop)
+
+
+PF_PF(data, g_mus_data)
+PF_PF(reset, g_mus_reset)
+
+#if 0
+MG_RFIF(xcoeff, mus_xcoeff)
+MG_RFIF(ycoeff, mus_ycoeff)
+MG_PF(xcoeffs, c_mus_xcoeffs) -- x|ycoeffs are complicated and may involve wrapper creation
+MG_PF(ycoeffs, c_mus_ycoeffs)
+MG_PF(file_name, c_mus_file_name) -- requires c->xen string creation
+MG_PF(copy, c_mus_copy) -- allocation
+#endif
+#endif /* gmp */
+
+
+static void init_choosers(s7_scheme *sc)
+{
+#if (!WITH_GMP)
+ s7_pointer f;
+#endif
+
+ env_symbol = s7_make_symbol(sc, "env");
+ comb_bank_symbol = s7_make_symbol(sc, "comb-bank");
+ vector_ref_symbol = s7_make_symbol(sc, "vector-ref");
+ polywave_symbol = s7_make_symbol(sc, "polywave");
+ triangle_wave_symbol = s7_make_symbol(sc, "triangle-wave");
+ rand_interp_symbol = s7_make_symbol(sc, "rand-interp");
+ oscil_symbol = s7_make_symbol(sc, "oscil");
+ multiply_symbol = s7_make_symbol(sc, "*");
+ add_symbol = s7_make_symbol(sc, "+");
+ quote_symbol = s7_make_symbol(sc, "quote");
+ cos_symbol = s7_make_symbol(sc, "cos");
+ mus_copy_symbol = s7_make_symbol(sc, "mus-copy");
+ copy_function = s7_name_to_value(sc, "copy");
+
+ sym_frequency = s7_make_symbol(sc, S_mus_frequency);
+ sym_phase = s7_make_symbol(sc, S_mus_phase);
+ sym_scaler = s7_make_symbol(sc, S_mus_scaler);
+ sym_increment = s7_make_symbol(sc, S_mus_increment);
+ sym_width = s7_make_symbol(sc, S_mus_width);
+ sym_offset = s7_make_symbol(sc, S_mus_offset);
+ sym_feedforward = s7_make_symbol(sc, S_mus_feedforward);
+ sym_feedback = s7_make_symbol(sc, S_mus_feedback);
+
+#if (!WITH_GMP)
+ f = s7_name_to_value(sc, "*");
+ initial_multiply_rf = s7_rf_function(sc, f);
+ s7_rf_set_function(f, clm_multiply_rf);
+
+ f = s7_name_to_value(sc, "+");
+ initial_add_rf = s7_rf_function(sc, f);
+ s7_rf_set_function(f, clm_add_rf);
+
+ s7_rf_set_function(s7_name_to_value(sc, S_outa), outa_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_outb), outb_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_ina), ina_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_file_to_sample), file_to_sample_rf);
+ s7_pf_set_function(s7_name_to_value(sc, S_file_to_frample), file_to_frample_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_frample_to_file), frample_to_file_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_frample_to_frample), frample_to_frample_pf);
+ s7_rf_set_function(s7_name_to_value(sc, S_oscil), oscil_rf_3);
+ s7_rf_set_function(s7_name_to_value(sc, S_polywave), polywave_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_wave_train), wave_train_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_granulate), granulate_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_ncos), ncos_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_nrxycos), nrxycos_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_env), env_rf_1);
+ s7_rf_set_function(s7_name_to_value(sc, S_readin), readin_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_one_pole), one_pole_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_moving_average), moving_average_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_moving_max), moving_max_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_fir_filter), fir_filter_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_triangle_wave), triangle_wave_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_pulse_train), pulse_train_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_rand_interp), rand_interp_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_formant), formant_rf_3);
+ s7_rf_set_function(s7_name_to_value(sc, S_one_pole_all_pass), one_pole_all_pass_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_delay), delay_rf_3);
+ s7_rf_set_function(s7_name_to_value(sc, S_formant_bank), formant_bank_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_oscil_bank), oscil_bank_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_rand), rand_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_filter), filter_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_table_lookup), table_lookup_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_src), src_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_sawtooth_wave), sawtooth_wave_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_inb), inb_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_in_any), in_any_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_polynomial), polynomial_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_pink_noise), pink_noise_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_piano_noise), piano_noise_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_nsin), nsin_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_nrxysin), nrxysin_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_rxyksin), rxyksin_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_rxykcos), rxykcos_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_tap), tap_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_comb), comb_rf_3);
+ s7_rf_set_function(s7_name_to_value(sc, S_comb_bank), comb_bank_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_notch), notch_rf_3);
+ s7_rf_set_function(s7_name_to_value(sc, S_two_zero), two_zero_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_one_zero), one_zero_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_two_pole), two_pole_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_moving_norm), moving_norm_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_iir_filter), iir_filter_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_square_wave), square_wave_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_firmant), firmant_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_all_pass), all_pass_rf_3);
+ s7_rf_set_function(s7_name_to_value(sc, S_all_pass_bank), all_pass_bank_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_polyshape), polyshape_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_pulsed_env), pulsed_env_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_ssb_am), ssb_am_rf_3);
+ s7_rf_set_function(s7_name_to_value(sc, S_asymmetric_fm), asymmetric_fm_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_filtered_comb), filtered_comb_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_filtered_comb_bank), filtered_comb_bank_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_move_sound), move_sound_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_locsig), locsig_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_out_bank), out_bank_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_phase_vocoder), phase_vocoder_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_convolve), convolve_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_sample_to_file), sample_to_file_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_srate), srate_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_contrast_enhancement), contrast_enhancement_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_set_formant_frequency), set_formant_frequency_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_odd_weight), odd_weight_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_even_weight), even_weight_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_odd_multiple), odd_multiple_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_even_multiple), even_multiple_rf);
+
+ s7_rf_set_function(s7_name_to_value(sc, S_hz_to_radians), hz_to_radians_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_radians_to_hz), radians_to_hz_rf);
+
+ s7_rf_set_function(s7_name_to_value(sc, S_radians_to_degrees), radians_to_degrees_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_degrees_to_radians), degrees_to_radians_rf);
+
+ s7_rf_set_function(s7_name_to_value(sc, S_db_to_linear), db_to_linear_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_linear_to_db), linear_to_db_rf);
+
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_random), random_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_amplitude_modulate), am_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_ring_modulate), ring_modulate_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_array_interp), array_interp_rf);
+
+ s7_pf_set_function(s7_name_to_value(sc, S_is_all_pass), is_all_pass_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_asymmetric_fm), is_asymmetric_fm_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_comb), is_comb_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_comb_bank), is_comb_bank_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_all_pass_bank), is_all_pass_bank_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_convolve), is_convolve_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_delay), is_delay_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_env), is_env_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_filter), is_filter_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_filtered_comb), is_filtered_comb_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_filtered_comb_bank), is_filtered_comb_bank_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_fir_filter), is_fir_filter_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_firmant), is_firmant_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_formant), is_formant_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_granulate), is_granulate_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_iir_filter), is_iir_filter_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_moving_average), is_moving_average_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_moving_max), is_moving_max_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_moving_norm), is_moving_norm_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_ncos), is_ncos_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_notch), is_notch_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_nrxycos), is_nrxycos_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_nrxysin), is_nrxysin_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_nsin), is_nsin_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_one_pole), is_one_pole_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_one_pole_all_pass), is_one_pole_all_pass_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_one_zero), is_one_zero_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_oscil), is_oscil_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_oscil_bank), is_oscil_bank_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_phase_vocoder), is_phase_vocoder_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_polyshape), is_polyshape_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_polywave), is_polywave_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_pulse_train), is_pulse_train_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_pulsed_env), is_pulsed_env_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_rand), is_rand_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_rand_interp), is_rand_interp_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_readin), is_readin_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_rxykcos), is_rxykcos_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_rxyksin), is_rxyksin_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_sawtooth_wave), is_sawtooth_wave_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_square_wave), is_square_wave_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_src), is_src_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_table_lookup), is_table_lookup_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_triangle_wave), is_triangle_wave_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_two_pole), is_two_pole_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_two_zero), is_two_zero_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_wave_train), is_wave_train_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_ssb_am), is_ssb_am_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_is_tap), is_tap_pf);
+
+ s7_rf_set_function(s7_name_to_value(sc, S_dot_product), dot_product_rf);
+ s7_pf_set_function(s7_name_to_value(sc, S_mus_fft), mus_fft_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_rectangular_to_polar), rectangular_to_polar_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_polar_to_rectangular), polar_to_rectangular_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_rectangular_to_magnitudes), rectangular_to_magnitudes_pf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_t_sum), chebyshev_t_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_u_sum), chebyshev_u_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_chebyshev_tu_sum), chebyshev_tu_rf);
+
+ s7_pf_set_function(s7_name_to_value(sc, S_mus_data), mus_data_pf);
+ s7_pf_set_function(s7_name_to_value(sc, S_mus_reset), mus_reset_pf);
+
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_scaler), mus_scaler_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_phase), mus_phase_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_frequency), mus_frequency_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_offset), mus_offset_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_width), mus_width_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_increment), mus_increment_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_feedforward), mus_feedforward_rf);
+ s7_rf_set_function(s7_name_to_value(sc, S_mus_feedback), mus_feedback_rf);
+
+ s7_if_set_function(s7_name_to_value(sc, S_mus_length), mus_length_if);
+ s7_if_set_function(s7_name_to_value(sc, S_mus_order), mus_order_if);
+ s7_if_set_function(s7_name_to_value(sc, S_mus_location), mus_location_if);
+ s7_if_set_function(s7_name_to_value(sc, S_mus_channel), mus_channel_if);
+ s7_if_set_function(s7_name_to_value(sc, S_mus_channels), mus_channels_if);
+ s7_if_set_function(s7_name_to_value(sc, S_mus_ramp), mus_ramp_if);
+ s7_if_set_function(s7_name_to_value(sc, S_mus_hop), mus_hop_if);
+#endif /* gmp */
+}
+#endif /*s7 */
+
+
+Xen_wrap_no_args(g_mus_srate_w, g_mus_srate)
+Xen_wrap_1_arg(g_mus_set_srate_w, g_mus_set_srate)
+Xen_wrap_no_args(g_mus_float_equal_fudge_factor_w, g_mus_float_equal_fudge_factor)
+Xen_wrap_1_arg(g_mus_set_float_equal_fudge_factor_w, g_mus_set_float_equal_fudge_factor)
+Xen_wrap_no_args(g_mus_array_print_length_w, g_mus_array_print_length)
+Xen_wrap_1_arg(g_mus_set_array_print_length_w, g_mus_set_array_print_length)
+Xen_wrap_1_arg(g_radians_to_hz_w, g_radians_to_hz)
+Xen_wrap_1_arg(g_hz_to_radians_w, g_hz_to_radians)
+Xen_wrap_1_arg(g_radians_to_degrees_w, g_radians_to_degrees)
+Xen_wrap_1_arg(g_degrees_to_radians_w, g_degrees_to_radians)
+Xen_wrap_1_arg(g_db_to_linear_w, g_db_to_linear)
+Xen_wrap_1_arg(g_linear_to_db_w, g_linear_to_db)
+Xen_wrap_1_arg(g_even_weight_w, g_even_weight)
+Xen_wrap_1_arg(g_odd_weight_w, g_odd_weight)
+Xen_wrap_2_args(g_even_multiple_w, g_even_multiple)
+Xen_wrap_2_args(g_odd_multiple_w, g_odd_multiple)
+Xen_wrap_1_arg(g_seconds_to_samples_w, g_seconds_to_samples)
+Xen_wrap_1_arg(g_samples_to_seconds_w, g_samples_to_seconds)
+Xen_wrap_2_args(g_ring_modulate_w, g_ring_modulate)
+Xen_wrap_3_args(g_amplitude_modulate_w, g_amplitude_modulate)
+Xen_wrap_2_optional_args(g_contrast_enhancement_w, g_contrast_enhancement)
+Xen_wrap_3_optional_args(g_dot_product_w, g_dot_product)
+#if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
+Xen_wrap_2_args(g_edot_product_w, g_edot_product)
+#endif
+Xen_wrap_2_args(g_polynomial_w, g_polynomial)
+Xen_wrap_4_optional_args(g_make_fft_window_w, g_make_fft_window)
+Xen_wrap_4_optional_args(g_mus_fft_w, g_mus_fft)
+Xen_wrap_4_optional_args(g_spectrum_w, g_spectrum)
+Xen_wrap_1_arg(g_autocorrelate_w, g_autocorrelate)
+Xen_wrap_2_args(g_correlate_w, g_correlate)
+Xen_wrap_3_optional_args(g_convolution_w, g_convolution)
+Xen_wrap_2_args(g_rectangular_to_polar_w, g_rectangular_to_polar)
+Xen_wrap_2_args(g_rectangular_to_magnitudes_w, g_rectangular_to_magnitudes)
+Xen_wrap_2_args(g_polar_to_rectangular_w, g_polar_to_rectangular)
+Xen_wrap_3_optional_args(g_array_interp_w, g_array_interp)
+Xen_wrap_5_optional_args(g_mus_interpolate_w, g_mus_interpolate)
+Xen_wrap_1_arg(g_mus_describe_w, g_mus_describe)
+Xen_wrap_1_arg(g_mus_name_w, g_mus_name)
+Xen_wrap_3_optional_args(g_mus_run_w, g_mus_run)
+Xen_wrap_1_arg(g_mus_phase_w, g_mus_phase)
+Xen_wrap_2_args(g_mus_set_phase_w, g_mus_set_phase)
+Xen_wrap_1_arg(g_mus_width_w, g_mus_width)
+Xen_wrap_2_args(g_mus_set_width_w, g_mus_set_width)
+Xen_wrap_1_arg(g_mus_scaler_w, g_mus_scaler)
+Xen_wrap_2_args(g_mus_set_scaler_w, g_mus_set_scaler)
+Xen_wrap_1_arg(g_mus_feedforward_w, g_mus_feedforward)
+Xen_wrap_2_args(g_mus_set_feedforward_w, g_mus_set_feedforward)
+Xen_wrap_1_arg(g_mus_reset_w, g_mus_reset)
+Xen_wrap_1_arg(g_mus_copy_w, g_mus_copy)
+Xen_wrap_1_arg(g_mus_offset_w, g_mus_offset)
+Xen_wrap_2_args(g_mus_set_offset_w, g_mus_set_offset)
+Xen_wrap_1_arg(g_mus_frequency_w, g_mus_frequency)
+Xen_wrap_2_args(g_mus_set_frequency_w, g_mus_set_frequency)
+Xen_wrap_1_arg(g_mus_length_w, g_mus_length)
+Xen_wrap_1_arg(g_mus_file_name_w, g_mus_file_name)
+Xen_wrap_2_args(g_mus_set_length_w, g_mus_set_length)
+Xen_wrap_1_arg(g_mus_type_w, g_mus_type)
+Xen_wrap_1_arg(g_mus_order_w, g_mus_order)
+Xen_wrap_1_arg(g_mus_data_w, g_mus_data)
+Xen_wrap_2_args(g_mus_set_data_w, g_mus_set_data)
+Xen_wrap_1_arg(g_is_oscil_w, g_is_oscil)
+Xen_wrap_3_optional_args(g_oscil_w, g_oscil)
+Xen_wrap_1_arg(g_is_oscil_bank_w, g_is_oscil_bank)
+Xen_wrap_1_arg(g_oscil_bank_w, g_oscil_bank)
+Xen_wrap_any_args(g_mus_apply_w, g_mus_apply)
+Xen_wrap_any_args(g_make_delay_w, g_make_delay)
+Xen_wrap_any_args(g_make_comb_w, g_make_comb)
+Xen_wrap_any_args(g_make_filtered_comb_w, g_make_filtered_comb)
+Xen_wrap_any_args(g_make_notch_w, g_make_notch)
+Xen_wrap_any_args(g_make_all_pass_w, g_make_all_pass)
+Xen_wrap_any_args(g_make_moving_average_w, g_make_moving_average)
+Xen_wrap_any_args(g_make_moving_max_w, g_make_moving_max)
+Xen_wrap_any_args(g_make_moving_norm_w, g_make_moving_norm)
+Xen_wrap_3_optional_args(g_delay_w, g_delay)
+Xen_wrap_2_optional_args(g_delay_tick_w, g_delay_tick)
+Xen_wrap_2_optional_args(g_tap_w, g_tap)
+Xen_wrap_3_optional_args(g_notch_w, g_notch)
+Xen_wrap_3_optional_args(g_comb_w, g_comb)
+Xen_wrap_3_optional_args(g_filtered_comb_w, g_filtered_comb)
+Xen_wrap_3_optional_args(g_all_pass_w, g_all_pass)
+Xen_wrap_2_optional_args(g_moving_average_w, g_moving_average)
+Xen_wrap_2_optional_args(g_moving_max_w, g_moving_max)
+Xen_wrap_2_optional_args(g_moving_norm_w, g_moving_norm)
+Xen_wrap_1_arg(g_is_tap_w, g_is_tap)
+Xen_wrap_1_arg(g_is_delay_w, g_is_delay)
+Xen_wrap_1_arg(g_is_notch_w, g_is_notch)
+Xen_wrap_1_arg(g_is_comb_w, g_is_comb)
+Xen_wrap_1_arg(g_is_filtered_comb_w, g_is_filtered_comb)
+Xen_wrap_1_arg(g_is_all_pass_w, g_is_all_pass)
+Xen_wrap_1_arg(g_is_moving_average_w, g_is_moving_average)
+Xen_wrap_1_arg(g_is_moving_max_w, g_is_moving_max)
+Xen_wrap_1_arg(g_is_moving_norm_w, g_is_moving_norm)
+
+Xen_wrap_2_optional_args(g_ncos_w, g_ncos)
+Xen_wrap_1_arg(g_is_ncos_w, g_is_ncos)
+Xen_wrap_2_optional_args(g_nsin_w, g_nsin)
+Xen_wrap_1_arg(g_is_nsin_w, g_is_nsin)
+
+Xen_wrap_any_args(g_make_rand_w, g_make_rand)
+Xen_wrap_any_args(g_make_rand_interp_w, g_make_rand_interp)
+Xen_wrap_2_optional_args(g_rand_w, g_rand)
+Xen_wrap_2_optional_args(g_rand_interp_w, g_rand_interp)
+Xen_wrap_1_arg(g_is_rand_w, g_is_rand)
+Xen_wrap_1_arg(g_is_rand_interp_w, g_is_rand_interp)
+Xen_wrap_1_arg(g_mus_random_w, g_mus_random)
+Xen_wrap_no_args(g_mus_rand_seed_w, g_mus_rand_seed)
+Xen_wrap_1_arg(g_mus_set_rand_seed_w, g_mus_set_rand_seed)
+Xen_wrap_1_arg(g_is_table_lookup_w, g_is_table_lookup)
+Xen_wrap_any_args(g_make_table_lookup_w, g_make_table_lookup)
+Xen_wrap_2_optional_args(g_table_lookup_w, g_table_lookup)
+Xen_wrap_3_optional_args(g_partials_to_wave_w, g_partials_to_wave)
+Xen_wrap_3_optional_args(g_phase_partials_to_wave_w, g_phase_partials_to_wave)
+Xen_wrap_6_optional_args(g_make_sawtooth_wave_w, g_make_sawtooth_wave)
+Xen_wrap_2_optional_args(g_sawtooth_wave_w, g_sawtooth_wave)
+Xen_wrap_1_arg(g_is_sawtooth_wave_w, g_is_sawtooth_wave)
+Xen_wrap_6_optional_args(g_make_triangle_wave_w, g_make_triangle_wave)
+Xen_wrap_2_optional_args(g_triangle_wave_w, g_triangle_wave)
+Xen_wrap_1_arg(g_is_triangle_wave_w, g_is_triangle_wave)
+Xen_wrap_6_optional_args(g_make_square_wave_w, g_make_square_wave)
+Xen_wrap_2_optional_args(g_square_wave_w, g_square_wave)
+Xen_wrap_1_arg(g_is_square_wave_w, g_is_square_wave)
+Xen_wrap_6_optional_args(g_make_pulse_train_w, g_make_pulse_train)
+Xen_wrap_2_optional_args(g_pulse_train_w, g_pulse_train)
+Xen_wrap_1_arg(g_is_pulse_train_w, g_is_pulse_train)
+
+Xen_wrap_3_args(g_make_pulsed_env_w, g_make_pulsed_env)
+Xen_wrap_2_optional_args(g_pulsed_env_w, g_pulsed_env)
+Xen_wrap_1_arg(g_is_pulsed_env_w, g_is_pulsed_env)
+
+Xen_wrap_3_optional_args(g_asymmetric_fm_w, g_asymmetric_fm)
+Xen_wrap_1_arg(g_is_asymmetric_fm_w, g_is_asymmetric_fm)
+Xen_wrap_4_optional_args(g_make_one_zero_w, g_make_one_zero)
+Xen_wrap_2_optional_args(g_one_zero_w, g_one_zero)
+Xen_wrap_1_arg(g_is_one_zero_w, g_is_one_zero)
+Xen_wrap_4_optional_args(g_make_one_pole_w, g_make_one_pole)
+Xen_wrap_2_optional_args(g_one_pole_w, g_one_pole)
+Xen_wrap_1_arg(g_is_one_pole_w, g_is_one_pole)
+Xen_wrap_6_optional_args(g_make_two_zero_w, g_make_two_zero)
+Xen_wrap_2_optional_args(g_two_zero_w, g_two_zero)
+Xen_wrap_1_arg(g_is_two_zero_w, g_is_two_zero)
+Xen_wrap_6_optional_args(g_make_two_pole_w, g_make_two_pole)
+Xen_wrap_2_optional_args(g_two_pole_w, g_two_pole)
+Xen_wrap_1_arg(g_is_two_pole_w, g_is_two_pole)
+
+Xen_wrap_1_arg(g_is_formant_w, g_is_formant)
+Xen_wrap_4_optional_args(g_make_formant_w, g_make_formant)
+Xen_wrap_3_optional_args(g_formant_w, g_formant)
+
+Xen_wrap_2_optional_args(g_formant_bank_w, g_formant_bank)
+Xen_wrap_1_arg(g_is_formant_bank_w, g_is_formant_bank)
+Xen_wrap_2_optional_args(g_make_formant_bank_w, g_make_formant_bank)
+
+Xen_wrap_1_arg(g_is_firmant_w, g_is_firmant)
+Xen_wrap_4_optional_args(g_make_firmant_w, g_make_firmant)
+Xen_wrap_3_optional_args(g_firmant_w, g_firmant)
+
+Xen_wrap_1_arg(g_is_one_pole_all_pass_w, g_is_one_pole_all_pass)
+Xen_wrap_2_args(g_make_one_pole_all_pass_w, g_make_one_pole_all_pass)
+Xen_wrap_2_optional_args(g_one_pole_all_pass_w, g_one_pole_all_pass)
+
+Xen_wrap_2_args(g_set_formant_frequency_w, g_set_formant_frequency)
+Xen_wrap_3_args(g_set_formant_radius_and_frequency_w, g_set_formant_radius_and_frequency)
+
+Xen_wrap_5_args(g_frample_to_frample_w, g_frample_to_frample)
+
+Xen_wrap_any_args(g_make_wave_train_w, g_make_wave_train)
+Xen_wrap_2_optional_args(g_wave_train_w, g_wave_train)
+Xen_wrap_1_arg(g_is_wave_train_w, g_is_wave_train)
+Xen_wrap_any_args(g_make_polyshape_w, g_make_polyshape)
+Xen_wrap_3_optional_args(g_polyshape_w, g_polyshape)
+Xen_wrap_1_arg(g_is_polyshape_w, g_is_polyshape)
+Xen_wrap_2_optional_args(g_partials_to_polynomial_w, g_partials_to_polynomial)
+Xen_wrap_1_arg(g_normalize_partials_w, g_normalize_partials)
+Xen_wrap_2_args(g_chebyshev_t_sum_w, g_chebyshev_t_sum)
+Xen_wrap_2_args(g_chebyshev_u_sum_w, g_chebyshev_u_sum)
+Xen_wrap_3_args(g_chebyshev_tu_sum_w, g_chebyshev_tu_sum)
+Xen_wrap_any_args(g_make_polywave_w, g_make_polywave)
+Xen_wrap_2_optional_args(g_polywave_w, g_polywave)
+Xen_wrap_1_arg(g_is_polywave_w, g_is_polywave)
+
+Xen_wrap_any_args(g_make_nrxysin_w, g_make_nrxysin)
+Xen_wrap_2_optional_args(g_nrxysin_w, g_nrxysin)
+Xen_wrap_1_arg(g_is_nrxysin_w, g_is_nrxysin)
+Xen_wrap_any_args(g_make_nrxycos_w, g_make_nrxycos)
+Xen_wrap_2_optional_args(g_nrxycos_w, g_nrxycos)
+Xen_wrap_1_arg(g_is_nrxycos_w, g_is_nrxycos)
+
+Xen_wrap_any_args(g_make_rxyksin_w, g_make_rxyksin)
+Xen_wrap_2_optional_args(g_rxyksin_w, g_rxyksin)
+Xen_wrap_1_arg(g_is_rxyksin_w, g_is_rxyksin)
+Xen_wrap_any_args(g_make_rxykcos_w, g_make_rxykcos)
+Xen_wrap_2_optional_args(g_rxykcos_w, g_rxykcos)
+Xen_wrap_1_arg(g_is_rxykcos_w, g_is_rxykcos)
+
+Xen_wrap_6_optional_args(g_make_filter_w, g_make_filter)
+Xen_wrap_2_optional_args(g_filter_w, g_filter)
+Xen_wrap_1_arg(g_is_filter_w, g_is_filter)
+Xen_wrap_4_optional_args(g_make_fir_filter_w, g_make_fir_filter)
+Xen_wrap_2_args(g_make_fir_coeffs_w, g_make_fir_coeffs)
+Xen_wrap_2_optional_args(g_fir_filter_w, g_fir_filter)
+Xen_wrap_1_arg(g_is_fir_filter_w, g_is_fir_filter)
+Xen_wrap_4_optional_args(g_make_iir_filter_w, g_make_iir_filter)
+Xen_wrap_2_optional_args(g_iir_filter_w, g_iir_filter)
+Xen_wrap_1_arg(g_is_iir_filter_w, g_is_iir_filter)
+Xen_wrap_1_arg(g_mus_xcoeffs_w, g_mus_xcoeffs)
+Xen_wrap_1_arg(g_mus_ycoeffs_w, g_mus_ycoeffs)
+Xen_wrap_2_args(g_mus_xcoeff_w, g_mus_xcoeff)
+Xen_wrap_3_args(g_mus_set_xcoeff_w, g_mus_set_xcoeff)
+Xen_wrap_2_args(g_mus_ycoeff_w, g_mus_ycoeff)
+Xen_wrap_3_args(g_mus_set_ycoeff_w, g_mus_set_ycoeff)
+Xen_wrap_1_arg(g_is_env_w, g_is_env)
+Xen_wrap_1_arg(g_env_w, g_env)
+Xen_wrap_any_args(g_make_env_w, g_make_env)
+Xen_wrap_2_args(g_env_interp_w, g_env_interp)
+Xen_wrap_3_optional_args(g_envelope_interp_w, g_envelope_interp)
+Xen_wrap_2_args(g_env_any_w, g_env_any)
+Xen_wrap_1_arg(g_is_file_to_sample_w, g_is_file_to_sample)
+Xen_wrap_2_optional_args(g_make_file_to_sample_w, g_make_file_to_sample)
+Xen_wrap_3_optional_args(g_file_to_sample_w, g_file_to_sample)
+Xen_wrap_1_arg(g_is_sample_to_file_w, g_is_sample_to_file)
+Xen_wrap_5_optional_args(g_make_sample_to_file_w, g_make_sample_to_file)
+Xen_wrap_1_arg(g_continue_sample_to_file_w, g_continue_sample_to_file)
+Xen_wrap_4_args(g_sample_to_file_w, g_sample_to_file)
+Xen_wrap_2_args(g_sample_to_file_add_w, g_sample_to_file_add)
+
+Xen_wrap_1_arg(g_is_file_to_frample_w, g_is_file_to_frample)
+Xen_wrap_2_optional_args(g_make_file_to_frample_w, g_make_file_to_frample)
+Xen_wrap_3_optional_args(g_file_to_frample_w, g_file_to_frample)
+Xen_wrap_1_arg(g_continue_frample_to_file_w, g_continue_frample_to_file)
+Xen_wrap_1_arg(g_is_frample_to_file_w, g_is_frample_to_file)
+Xen_wrap_3_args(g_frample_to_file_w, g_frample_to_file)
+Xen_wrap_5_optional_args(g_make_frample_to_file_w, g_make_frample_to_file)
+
+
+Xen_wrap_1_arg(g_is_mus_input_w, g_is_mus_input)
+Xen_wrap_1_arg(g_is_mus_output_w, g_is_mus_output)
+Xen_wrap_3_args(g_in_any_w, g_in_any)
+Xen_wrap_2_args(g_ina_w, g_ina)
+Xen_wrap_2_args(g_inb_w, g_inb)
+Xen_wrap_4_optional_args(g_out_any_w, g_out_any)
+Xen_wrap_3_optional_args(g_outa_w, g_outa)
+Xen_wrap_3_optional_args(g_outb_w, g_outb)
+Xen_wrap_3_optional_args(g_outc_w, g_outc)
+Xen_wrap_3_optional_args(g_outd_w, g_outd)
+Xen_wrap_1_arg(g_mus_close_w, g_mus_close)
+Xen_wrap_no_args(g_mus_file_buffer_size_w, g_mus_file_buffer_size)
+Xen_wrap_1_arg(g_mus_set_file_buffer_size_w, g_mus_set_file_buffer_size)
+Xen_wrap_1_arg(g_is_readin_w, g_is_readin)
+Xen_wrap_1_arg(g_readin_w, g_readin)
+Xen_wrap_any_args(g_make_readin_w, g_make_readin)
+Xen_wrap_1_arg(g_mus_channel_w, g_mus_channel)
+Xen_wrap_1_arg(g_mus_interp_type_w, g_mus_interp_type)
+Xen_wrap_1_arg(g_mus_location_w, g_mus_location)
+Xen_wrap_2_args(g_mus_set_location_w, g_mus_set_location)
+Xen_wrap_1_arg(g_mus_increment_w, g_mus_increment)
+Xen_wrap_2_args(g_mus_set_increment_w, g_mus_set_increment)
+Xen_wrap_1_arg(g_mus_feedback_w, g_mus_feedback)
+Xen_wrap_2_args(g_mus_set_feedback_w, g_mus_set_feedback)
+Xen_wrap_1_arg(g_is_locsig_w, g_is_locsig)
+Xen_wrap_3_args(g_locsig_w, g_locsig)
+Xen_wrap_any_args(g_make_locsig_w, g_make_locsig)
+Xen_wrap_3_args(g_move_locsig_w, g_move_locsig)
+Xen_wrap_no_args(g_locsig_type_w, g_locsig_type)
+Xen_wrap_1_arg(g_set_locsig_type_w, g_set_locsig_type)
+Xen_wrap_1_arg(g_mus_channels_w, g_mus_channels)
+Xen_wrap_2_args(g_locsig_ref_w, g_locsig_ref)
+Xen_wrap_2_args(g_locsig_reverb_ref_w, g_locsig_reverb_ref)
+Xen_wrap_3_args(g_locsig_set_w, g_locsig_set)
+Xen_wrap_3_args(g_locsig_reverb_set_w, g_locsig_reverb_set)
+Xen_wrap_1_arg(g_is_move_sound_w, g_is_move_sound)
+Xen_wrap_3_args(g_move_sound_w, g_move_sound)
+Xen_wrap_3_optional_args(g_make_move_sound_w, g_make_move_sound)
+Xen_wrap_no_args(g_mus_clear_sincs_w, g_mus_clear_sincs)
+Xen_wrap_1_arg(g_is_src_w, g_is_src)
+Xen_wrap_3_optional_args(g_src_w, g_src)
+Xen_wrap_6_optional_args(g_make_src_w, g_make_src)
+Xen_wrap_1_arg(g_is_granulate_w, g_is_granulate)
+Xen_wrap_3_optional_args(g_granulate_w, g_granulate)
+Xen_wrap_any_args(g_make_granulate_w, g_make_granulate)
+Xen_wrap_1_arg(g_mus_ramp_w, g_mus_ramp)
+Xen_wrap_2_args(g_mus_set_ramp_w, g_mus_set_ramp)
+Xen_wrap_1_arg(g_is_convolve_w, g_is_convolve)
+Xen_wrap_2_optional_args(g_convolve_w, g_convolve)
+Xen_wrap_any_args(g_make_convolve_w, g_make_convolve)
+Xen_wrap_4_optional_args(g_convolve_files_w, g_convolve_files)
+Xen_wrap_1_arg(g_is_phase_vocoder_w, g_is_phase_vocoder)
+Xen_wrap_5_optional_args(g_phase_vocoder_w, g_phase_vocoder)
+Xen_wrap_any_args(g_make_phase_vocoder_w, g_make_phase_vocoder)
+Xen_wrap_1_arg(g_phase_vocoder_amp_increments_w, g_phase_vocoder_amp_increments)
+Xen_wrap_1_arg(g_phase_vocoder_amps_w, g_phase_vocoder_amps)
+Xen_wrap_1_arg(g_phase_vocoder_freqs_w, g_phase_vocoder_freqs)
+Xen_wrap_1_arg(g_phase_vocoder_phases_w, g_phase_vocoder_phases)
+Xen_wrap_1_arg(g_phase_vocoder_phase_increments_w, g_phase_vocoder_phase_increments)
+Xen_wrap_1_arg(g_mus_hop_w, g_mus_hop)
+Xen_wrap_2_args(g_mus_set_hop_w, g_mus_set_hop)
+Xen_wrap_4_optional_args(g_make_ssb_am_w, g_make_ssb_am)
+Xen_wrap_3_optional_args(g_ssb_am_w, g_ssb_am)
+Xen_wrap_1_arg(g_is_ssb_am_w, g_is_ssb_am)
+Xen_wrap_no_args(g_clm_table_size_w, g_clm_table_size)
+Xen_wrap_1_arg(g_set_clm_table_size_w, g_set_clm_table_size)
+Xen_wrap_no_args(g_clm_default_frequency_w, g_clm_default_frequency)
+Xen_wrap_1_arg(g_set_clm_default_frequency_w, g_set_clm_default_frequency)
+Xen_wrap_1_arg(g_is_mus_generator_w, g_is_mus_generator)
+Xen_wrap_1_arg(g_mus_frandom_w, g_mus_frandom)
+Xen_wrap_1_arg(g_mus_irandom_w, g_mus_irandom)
+Xen_wrap_4_optional_args(g_make_oscil_w, g_make_oscil)
+Xen_wrap_4_optional_args(g_make_ncos_w, g_make_ncos)
+Xen_wrap_4_optional_args(g_make_oscil_bank_w, g_make_oscil_bank)
+Xen_wrap_4_optional_args(g_make_nsin_w, g_make_nsin)
+Xen_wrap_8_optional_args(g_make_asymmetric_fm_w, g_make_asymmetric_fm)
+Xen_wrap_any_args(g_mus_file_mix_w, g_mus_file_mix)
+Xen_wrap_any_args(g_mus_file_mix_with_envs_w, g_mus_file_mix_with_envs)
+Xen_wrap_2_optional_args(g_comb_bank_w, g_comb_bank)
+Xen_wrap_1_arg(g_is_comb_bank_w, g_is_comb_bank)
+Xen_wrap_1_arg(g_make_comb_bank_w, g_make_comb_bank)
+Xen_wrap_2_optional_args(g_filtered_comb_bank_w, g_filtered_comb_bank)
+Xen_wrap_1_arg(g_is_filtered_comb_bank_w, g_is_filtered_comb_bank)
+Xen_wrap_1_arg(g_make_filtered_comb_bank_w, g_make_filtered_comb_bank)
+Xen_wrap_2_optional_args(g_all_pass_bank_w, g_all_pass_bank)
+Xen_wrap_1_arg(g_is_all_pass_bank_w, g_is_all_pass_bank)
+Xen_wrap_1_arg(g_make_all_pass_bank_w, g_make_all_pass_bank)
+Xen_wrap_1_arg(g_pink_noise_w, g_pink_noise)
+Xen_wrap_3_args(g_out_bank_w, g_out_bank)
+
+#if HAVE_SCHEME
+Xen_wrap_2_args(g_piano_noise_w, g_piano_noise)
+Xen_wrap_6_args(g_singer_filter_w, g_singer_filter)
+Xen_wrap_5_args(g_singer_nose_filter_w, g_singer_nose_filter)
+#endif
+
+#if HAVE_SCHEME
+ static s7_pointer acc_clm_srate(s7_scheme *sc, s7_pointer args) {return(g_mus_set_srate(s7_cadr(args)));}
+ static s7_pointer acc_clm_default_frequency(s7_scheme *sc, s7_pointer args) {return(g_set_clm_default_frequency(s7_cadr(args)));}
+ static s7_pointer acc_clm_table_size(s7_scheme *sc, s7_pointer args) {return(g_set_clm_table_size(s7_cadr(args)));}
+ static s7_pointer acc_mus_file_buffer_size(s7_scheme *sc, s7_pointer args) {return(g_mus_set_file_buffer_size(s7_cadr(args)));}
+ static s7_pointer acc_mus_float_equal_fudge_factor(s7_scheme *sc, s7_pointer args) {return(g_mus_set_float_equal_fudge_factor(s7_cadr(args)));}
+ static s7_pointer acc_mus_array_print_length(s7_scheme *sc, s7_pointer args) {return(g_mus_set_array_print_length(s7_cadr(args)));}
+#endif
+
+#if HAVE_SCHEME
+static char *mus_generator_to_readable_string(s7_scheme *sc, void *obj)
+{
+ char *str;
+ str = (char *)malloc(64 * sizeof(char));
+ snprintf(str, 64, "#<%s>", mus_name(((mus_xen *)obj)->gen));
+ return(str);
+ /* we need a new function to fill this role */
+ /* s7_error(sc, s7_make_symbol(sc, "io-error"), s7_list(sc, 1, s7_make_string(sc, "can't write a clm generator readably"))); */
+ /* return(NULL); */
+}
+#endif
+
+static void mus_xen_init(void)
+{
+#if HAVE_SCHEME
+ s7_pointer s, i, p, t, r, c, f, v, b, d;
+
+ s7_pointer pcl_ct, pl_rcr, pl_bt, pl_ir, pl_cc, pl_ccic, pl_ccrr, pl_fc, pl_fcif, pl_cs, pl_ff, pl_tt, pl_fffifi, pl_ffftii, pl_fffi,
+ pl_fti, pl_fif, pl_fiir, pl_fttb, pl_ic, pl_rciir, pl_rcir, pl_ririt, pl_rcrr, pl_rirt, pl_riirfff, pl_rirfff, pl_rrpr, pcl_zt,
+ pl_sc, pl_sssrs, pl_tc, pl_ct, pl_ici, pl_i, pl_fcf, pl_dcr, pl_dr, pl_dffi, pl_dfri, pl_dirfir, pl_dc, pl_dci, pl_dcir, pl_dv,
+ pl_dvir, pl_drf, pl_drc, pl_diit, pl_dit, pl_dct, pl_d;
+#endif
+
+ mus_initialize();
+ current_connect_func = Xen_false;
+
+#if HAVE_SCHEME
+ mus_xen_tag = s7_new_type_x(s7, "<generator>", print_mus_xen, free_mus_xen, s7_equalp_mus_xen, mark_mus_xen,
+ mus_xen_apply, NULL, s7_mus_length, s7_mus_copy, NULL, NULL);
+ as_needed_arglist = Xen_list_1(Xen_integer_zero);
+ Xen_GC_protect(as_needed_arglist);
+ s7_set_object_print_readably(mus_xen_tag, mus_generator_to_readable_string);
+
+ s = s7_make_symbol(s7, "string?");
+ i = s7_make_symbol(s7, "integer?");
+ p = s7_make_symbol(s7, "pair?");
+ t = s7_t(s7);
+ r = s7_make_symbol(s7, "real?");
+ c = s7_make_symbol(s7, "c-object?");
+ f = s7_make_symbol(s7, "float-vector?");
+ v = s7_make_symbol(s7, "vector?");
+ b = s7_make_symbol(s7, "boolean?");
+ d = s7_make_symbol(s7, "float?");
+
+ pcl_ct = s7_make_circular_signature(s7, 1, 2, c, t);
+ pcl_zt = s7_make_circular_signature(s7, 1, 2, s7_make_signature(s7, 2, b, c), t);
+ pl_bt = s7_make_signature(s7, 2, b, t);
+ pl_rcr = s7_make_signature(s7, 3, r, c, r);
+
+ pl_d = s7_make_signature(s7, 1, d);
+ pl_dcr = s7_make_circular_signature(s7, 2, 3, d, c, r);
+ pl_dct = s7_make_signature(s7, 3, d, c, t);
+ pl_dci = s7_make_circular_signature(s7, 2, 3, d, c, i);
+ pl_dcir = s7_make_signature(s7, 4, d, c, i, r);
+ pl_dr = s7_make_circular_signature(s7, 1, 2, d, r);
+ pl_dffi = s7_make_signature(s7, 4, d, f, f, i);
+ pl_dfri = s7_make_signature(s7, 4, d, f, r, i);
+ pl_dirfir = s7_make_signature(s7, 6, d, i, r, f, i, r);
+ pl_dc = s7_make_signature(s7, 2, d, c);
+ pl_dv = s7_make_signature(s7, 2, d, v);
+ pl_dvir = s7_make_signature(s7, 4, d, v, i, r);
+ pl_drf = s7_make_circular_signature(s7, 2, 3, d, r, f);
+ pl_drc = s7_make_signature(s7, 3, d, r, c);
+ pl_diit = s7_make_signature(s7, 4, d, i, i, t);
+ pl_dit = s7_make_signature(s7, 3, d, i, t);
+
+ pl_ir = s7_make_signature(s7, 2, i, r);
+ pl_i = s7_make_circular_signature(s7, 0, 1, i);
+ pl_ct = s7_make_signature(s7, 2, c, t);
+ pl_cc = s7_make_circular_signature(s7, 1, 2, c, c);
+ pl_ici = s7_make_signature(s7, 3, i, c, i);
+ pl_ccic = s7_make_signature(s7, 3, c, c, i, c);
+ pl_ccrr = s7_make_signature(s7, 4, c, c, r, r);
+ pl_fc = s7_make_signature(s7, 2, s7_make_signature(s7, 2, f, b), c);
+ pl_cs = s7_make_signature(s7, 2, c, s);
+ pl_ff = s7_make_circular_signature(s7, 1, 2, f, f);
+ pl_tt = s7_make_signature(s7, 2, t, t);
+ pl_fcf = s7_make_signature(s7, 3, f, c, f);
+ pl_fffifi = s7_make_signature(s7, 6, f, f, f, i, f, i);
+ pl_ffftii = s7_make_signature(s7, 6, f, f, f, t, i, i);
+ pl_fffi = s7_make_circular_signature(s7, 3, 4, f, f, f, i);
+ pl_fti = s7_make_signature(s7, 3, f, t, i);
+ pl_fif = s7_make_signature(s7, 3, f, i, f);
+ pl_fiir = s7_make_signature(s7, 4, f, i, i, r);
+ pl_fttb = s7_make_signature(s7, 4, f, t, t, b);
+ pl_ic = s7_make_signature(s7, 2, i, c);
+ pl_rciir = s7_make_signature(s7, 5, r, c, i, i, r);
+ pl_rcir = s7_make_signature(s7, 4, r, c, i, r);
+ pl_ririt = s7_make_signature(s7,5, r, i, r, i, t);
+ pl_rcrr = s7_make_signature(s7, 4, r, c, r, r);
+ pl_rirt = s7_make_signature(s7, 4, r, i, r, t);
+ pl_riirfff = s7_make_signature(s7, 7, r, i, i, r, f, f, f);
+ pl_rirfff = s7_make_signature(s7, 6, r, i, r, f, f, f);
+ pl_rrpr = s7_make_signature(s7, 4, r, r, p, r);
+ pl_sc = s7_make_signature(s7, 2, s, c);
+ pl_sssrs = s7_make_signature(s7, 5, s, s, s, r, s);
+ pl_tc = s7_make_signature(s7, 2, t, c);
+ pl_fcif = s7_make_signature(s7, 4, f, c, i, f);
+#else
+ mus_xen_tag = Xen_make_object_type("Mus", sizeof(mus_xen));
+#endif
+
+ xen_one = C_int_to_Xen_integer(1);
+ Xen_GC_protect(xen_one);
+ xen_minus_one = C_int_to_Xen_integer(-1);
+ Xen_GC_protect(xen_minus_one);
+
+#if HAVE_FORTH
+ fth_set_object_inspect(mus_xen_tag, print_mus_xen);
+ fth_set_object_equal(mus_xen_tag, equalp_mus_xen);
+ fth_set_object_mark(mus_xen_tag, mark_mus_xen);
+ fth_set_object_free(mus_xen_tag, free_mus_xen);
+ fth_set_object_apply(mus_xen_tag, Xen_procedure_cast mus_xen_apply, 0, 2, 0);
+#endif
+
+#if HAVE_RUBY
+ rb_define_method(mus_xen_tag, "to_s", Xen_procedure_cast mus_xen_to_s, 0);
+ rb_define_method(mus_xen_tag, "eql?", Xen_procedure_cast equalp_mus_xen, 1);
+ rb_define_method(mus_xen_tag, "frequency", Xen_procedure_cast g_mus_frequency, 0);
+ rb_define_method(mus_xen_tag, "frequency=", Xen_procedure_cast g_mus_set_frequency, 1);
+ rb_define_method(mus_xen_tag, "phase", Xen_procedure_cast g_mus_phase, 0);
+ rb_define_method(mus_xen_tag, "phase=", Xen_procedure_cast g_mus_set_phase, 1);
+ rb_define_method(mus_xen_tag, "scaler", Xen_procedure_cast g_mus_scaler, 0);
+ rb_define_method(mus_xen_tag, "scaler=", Xen_procedure_cast g_mus_set_scaler, 1);
+ rb_define_method(mus_xen_tag, "width", Xen_procedure_cast g_mus_width, 0);
+ rb_define_method(mus_xen_tag, "width=", Xen_procedure_cast g_mus_set_width, 1);
+ rb_define_method(mus_xen_tag, "offset", Xen_procedure_cast g_mus_offset, 0);
+ rb_define_method(mus_xen_tag, "offset=", Xen_procedure_cast g_mus_set_offset, 1);
+ rb_define_method(mus_xen_tag, "reset", Xen_procedure_cast g_mus_reset, 0);
+ /* rb_define_method(mus_xen_tag, "copy", Xen_procedure_cast g_mus_copy, 0); */
+ rb_define_method(mus_xen_tag, "length", Xen_procedure_cast g_mus_length, 0);
+ rb_define_method(mus_xen_tag, "length=", Xen_procedure_cast g_mus_set_length, 1);
+ rb_define_method(mus_xen_tag, "data", Xen_procedure_cast g_mus_data, 0);
+ rb_define_method(mus_xen_tag, "data=", Xen_procedure_cast g_mus_set_data, 1);
+ rb_define_method(mus_xen_tag, "feedforward", Xen_procedure_cast g_mus_feedforward, 0);
+ rb_define_method(mus_xen_tag, "feedforward=", Xen_procedure_cast g_mus_set_feedforward, 1);
+ rb_define_method(mus_xen_tag, "feedback", Xen_procedure_cast g_mus_feedback, 0);
+ rb_define_method(mus_xen_tag, "feedback=", Xen_procedure_cast g_mus_set_increment, 1);
+ rb_define_method(mus_xen_tag, "order", Xen_procedure_cast g_mus_order, 0);
+ rb_define_method(mus_xen_tag, "type", Xen_procedure_cast g_mus_type, 0);
+ rb_define_method(mus_xen_tag, "order=", Xen_procedure_cast g_mus_set_length, 1);
+ rb_define_method(mus_xen_tag, "call", Xen_procedure_cast mus_xen_apply, 2);
+ rb_define_method(mus_xen_tag, "location", Xen_procedure_cast g_mus_location, 0);
+ rb_define_method(mus_xen_tag, "location=", Xen_procedure_cast g_mus_set_location, 1);
+ rb_define_method(mus_xen_tag, "increment", Xen_procedure_cast g_mus_increment, 0);
+ rb_define_method(mus_xen_tag, "increment=", Xen_procedure_cast g_mus_set_increment, 1);
+ rb_define_method(mus_xen_tag, "channels", Xen_procedure_cast g_mus_channels, 0);
+ rb_define_method(mus_xen_tag, "channel", Xen_procedure_cast g_mus_channel, 0);
+ rb_define_method(mus_xen_tag, "interp_type", Xen_procedure_cast g_mus_interp_type, 0);
+ rb_define_method(mus_xen_tag, "xcoeffs", Xen_procedure_cast g_mus_xcoeffs, 0);
+ rb_define_method(mus_xen_tag, "ycoeffs", Xen_procedure_cast g_mus_ycoeffs, 0);
+ rb_define_method(mus_xen_tag, "xcoeff", Xen_procedure_cast g_mus_xcoeff, 1);
+ rb_define_method(mus_xen_tag, "ycoeff", Xen_procedure_cast g_mus_ycoeff, 1);
+ /*
+ rb_define_method(mus_xen_tag, "xcoeff=", Xen_procedure_cast g_mus_set_xcoeff, 1);
+ rb_define_method(mus_xen_tag, "ycoeff=", Xen_procedure_cast g_mus_set_ycoeff, 1);
+ */
+ rb_define_method(mus_xen_tag, "ramp", Xen_procedure_cast g_mus_ramp, 0);
+ rb_define_method(mus_xen_tag, "ramp=", Xen_procedure_cast g_mus_set_ramp, 1);
+ rb_define_method(mus_xen_tag, "hop", Xen_procedure_cast g_mus_hop, 0);
+ rb_define_method(mus_xen_tag, "hop=", Xen_procedure_cast g_mus_set_hop, 1);
+ rb_define_method(mus_xen_tag, "name", Xen_procedure_cast g_mus_name, 0);
+ rb_define_method(mus_xen_tag, "file_name", Xen_procedure_cast g_mus_file_name, 0);
+#endif
+
+ init_keywords();
+
+ Xen_define_typed_dilambda(S_mus_srate, g_mus_srate_w, H_mus_srate,
+ S_set S_mus_srate, g_mus_set_srate_w, 0, 0, 1, 0, pl_d, pl_dr);
+ Xen_define_typed_dilambda(S_mus_float_equal_fudge_factor, g_mus_float_equal_fudge_factor_w, H_mus_float_equal_fudge_factor,
+ S_set S_mus_float_equal_fudge_factor, g_mus_set_float_equal_fudge_factor_w, 0, 0, 1, 0, pl_d, pl_dr);
+ Xen_define_typed_dilambda(S_mus_array_print_length, g_mus_array_print_length_w, H_mus_array_print_length,
+ S_set S_mus_array_print_length, g_mus_set_array_print_length_w, 0, 0, 1, 0, pl_i, pl_i);
+ Xen_define_typed_dilambda(S_clm_table_size, g_clm_table_size_w, H_clm_table_size,
+ S_set S_clm_table_size, g_set_clm_table_size_w, 0, 0, 1, 0, pl_i, pl_i);
+ Xen_define_typed_dilambda(S_clm_default_frequency, g_clm_default_frequency_w, H_clm_default_frequency,
+ S_set S_clm_default_frequency, g_set_clm_default_frequency_w, 0, 0, 1, 0, pl_d, pl_dr);
+
+#if HAVE_SCHEME
+ clm_srate_symbol = s7_define_variable(s7, "*clm-srate*", s7_make_real(s7, MUS_DEFAULT_SAMPLING_RATE));
+ s7_symbol_set_access(s7, clm_srate_symbol, s7_make_function(s7, "[acc-clm-srate]", acc_clm_srate, 2, 0, false, "accessor"));
+
+ clm_default_frequency_symbol = s7_define_variable(s7, "*" S_clm_default_frequency "*", s7_make_real(s7, MUS_CLM_DEFAULT_FREQUENCY));
+ s7_symbol_set_documentation(s7, clm_default_frequency_symbol, "*clm-default-frequency*: the default frequency for most generators (0.0)");
+ s7_symbol_set_access(s7, clm_default_frequency_symbol, s7_make_function(s7, "[acc-clm-default-frequency]", acc_clm_default_frequency, 2, 0, false, "accessor"));
+
+ clm_table_size_symbol = s7_define_variable(s7, "*" S_clm_table_size "*", s7_make_integer(s7, MUS_CLM_DEFAULT_TABLE_SIZE));
+ s7_symbol_set_documentation(s7, clm_table_size_symbol, "*clm-table-size*: the default table size for most generators (512)");
+ s7_symbol_set_access(s7, clm_table_size_symbol, s7_make_function(s7, "[acc-clm-table-size]", acc_clm_table_size, 2, 0, false, "accessor"));
+
+ mus_file_buffer_size_symbol = s7_define_variable(s7, "*clm-file-buffer-size*", s7_make_integer(s7, MUS_DEFAULT_FILE_BUFFER_SIZE));
+ s7_symbol_set_access(s7, mus_file_buffer_size_symbol, s7_make_function(s7, "[acc-mus-file-buffer-size]", acc_mus_file_buffer_size, 2, 0, false, "accessor"));
+
+ mus_float_equal_fudge_factor_symbol = s7_define_variable(s7, "*" S_mus_float_equal_fudge_factor "*", s7_make_real(s7, 0.0000001)); /* clm.c */
+ s7_symbol_set_documentation(s7, mus_float_equal_fudge_factor_symbol, "*mus-float-equal-fudge-factor*: floating point equality fudge factor");
+ s7_symbol_set_access(s7, mus_float_equal_fudge_factor_symbol, s7_make_function(s7, "[acc-mus-float-equal-fudge-factor]", acc_mus_float_equal_fudge_factor, 2, 0, false, "accessor"));
+
+ mus_array_print_length_symbol = s7_define_variable(s7, "*" S_mus_array_print_length "*", s7_make_integer(s7, MUS_DEFAULT_ARRAY_PRINT_LENGTH));
+ s7_symbol_set_documentation(s7, mus_array_print_length_symbol, "*mus-array-print-length*: current clm array print length (default is 8).");
+ s7_symbol_set_access(s7, mus_array_print_length_symbol, s7_make_function(s7, "[acc-mus-array-print-length]", acc_mus_array_print_length, 2, 0, false, "accessor"));
+#endif
+
+ Xen_define_typed_procedure(S_radians_to_hz, g_radians_to_hz_w, 1, 0, 0, H_radians_to_hz, pl_dr);
+ Xen_define_typed_procedure(S_hz_to_radians, g_hz_to_radians_w, 1, 0, 0, H_hz_to_radians, pl_dr);
+ Xen_define_typed_procedure(S_radians_to_degrees, g_radians_to_degrees_w, 1, 0, 0, H_radians_to_degrees, pl_dr);
+ Xen_define_typed_procedure(S_degrees_to_radians, g_degrees_to_radians_w, 1, 0, 0, H_degrees_to_radians, pl_dr);
+ Xen_define_typed_procedure(S_db_to_linear, g_db_to_linear_w, 1, 0, 0, H_db_to_linear, pl_dr);
+ Xen_define_typed_procedure(S_linear_to_db, g_linear_to_db_w, 1, 0, 0, H_linear_to_db, pl_dr);
+ Xen_define_typed_procedure(S_even_weight, g_even_weight_w, 1, 0, 0, H_even_weight, pl_dr);
+ Xen_define_typed_procedure(S_odd_weight, g_odd_weight_w, 1, 0, 0, H_odd_weight, pl_dr);
+ Xen_define_typed_procedure(S_even_multiple, g_even_multiple_w, 2, 0, 0, H_even_multiple, pl_dr);
+ Xen_define_typed_procedure(S_odd_multiple, g_odd_multiple_w, 2, 0, 0, H_odd_multiple, pl_dr);
+ Xen_define_typed_procedure(S_seconds_to_samples, g_seconds_to_samples_w, 1, 0, 0, H_seconds_to_samples, pl_ir);
+ Xen_define_typed_procedure(S_samples_to_seconds, g_samples_to_seconds_w, 1, 0, 0, H_samples_to_seconds, pl_dr);
+ Xen_define_typed_procedure(S_ring_modulate, g_ring_modulate_w, 2, 0, 0, H_ring_modulate, pl_dr);
+ Xen_define_typed_procedure(S_amplitude_modulate, g_amplitude_modulate_w, 3, 0, 0, H_amplitude_modulate, pl_dr);
+ Xen_define_typed_procedure(S_contrast_enhancement, g_contrast_enhancement_w, 1, 1, 0, H_contrast_enhancement, pl_dr);
+ Xen_define_typed_procedure(S_dot_product, g_dot_product_w, 2, 1, 0, H_dot_product, pl_dffi);
+#if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS && (!HAVE_RUBY)
+ Xen_define_typed_procedure(S_edot_product, g_edot_product_w, 2, 0, 0, H_edot_product, NULL);
+#endif
+ Xen_define_typed_procedure(S_polynomial, g_polynomial_w, 2, 0, 0, H_polynomial, pl_dfri);
+ Xen_define_typed_procedure(S_make_fft_window, g_make_fft_window_w, 2, 2, 0, H_make_fft_window, pl_fiir);
+ Xen_define_typed_procedure(S_mus_fft, g_mus_fft_w, 2, 2, 0, H_mus_fft, pl_fffi);
+ Xen_define_typed_procedure(S_spectrum, g_spectrum_w, 3, 1, 0, H_mus_spectrum, pl_ffftii);
+ Xen_define_typed_procedure(S_autocorrelate, g_autocorrelate_w, 1, 0, 0, H_autocorrelate, pl_ff);
+ Xen_define_typed_procedure(S_correlate, g_correlate_w, 2, 0, 0, H_correlate, pl_ff);
+ Xen_define_typed_procedure(S_convolution, g_convolution_w, 2, 1, 0, H_mus_convolution, pl_fffi);
+ Xen_define_typed_procedure(S_rectangular_to_polar, g_rectangular_to_polar_w, 2, 0, 0, H_rectangular_to_polar, pl_ff);
+ Xen_define_typed_procedure(S_rectangular_to_magnitudes, g_rectangular_to_magnitudes_w, 2, 0, 0, H_rectangular_to_magnitudes, pl_ff);
+ Xen_define_typed_procedure(S_polar_to_rectangular, g_polar_to_rectangular_w, 2, 0, 0, H_polar_to_rectangular, pl_ff);
+ Xen_define_typed_procedure(S_array_interp, g_array_interp_w, 2, 1, 0, H_array_interp, pl_dfri);
+ Xen_define_typed_procedure(S_mus_interpolate, g_mus_interpolate_w, 3, 2, 0, H_mus_interpolate, pl_dirfir);
+ Xen_define_typed_procedure(S_mus_frandom, g_mus_frandom_w, 1, 0, 0, "random reals", pl_dr);
+ Xen_define_typed_procedure(S_mus_irandom, g_mus_irandom_w, 1, 0, 0, "random integers", pl_i);
+
+ Xen_define_constant(S_rectangular_window, MUS_RECTANGULAR_WINDOW, "The un-window, so to speak");
+ Xen_define_constant(S_hann_window, MUS_HANN_WINDOW, "A simple raised cosine window");
+ Xen_define_constant(S_welch_window, MUS_WELCH_WINDOW, "A triangular window squared");
+ Xen_define_constant(S_parzen_window, MUS_PARZEN_WINDOW, "A triangular window");
+ Xen_define_constant(S_bartlett_window, MUS_BARTLETT_WINDOW, "A triangular window");
+ Xen_define_constant(S_bartlett_hann_window, MUS_BARTLETT_HANN_WINDOW, "A combination of the bartlett and hann windows");
+ Xen_define_constant(S_bohman_window, MUS_BOHMAN_WINDOW, "A weighted cosine window");
+ Xen_define_constant(S_flat_top_window, MUS_FLAT_TOP_WINDOW, "A sum of cosines window");
+ Xen_define_constant(S_hamming_window, MUS_HAMMING_WINDOW, "A raised cosine");
+ Xen_define_constant(S_blackman2_window, MUS_BLACKMAN2_WINDOW, "second order cosine window");
+ Xen_define_constant(S_blackman3_window, MUS_BLACKMAN3_WINDOW, "third order cosine window");
+ Xen_define_constant(S_blackman4_window, MUS_BLACKMAN4_WINDOW, "4th order cosine window");
+ Xen_define_constant(S_blackman5_window, MUS_BLACKMAN5_WINDOW, "5th order cosine window");
+ Xen_define_constant(S_blackman6_window, MUS_BLACKMAN6_WINDOW, "6th order cosine window");
+ Xen_define_constant(S_blackman7_window, MUS_BLACKMAN7_WINDOW, "7th order cosine window");
+ Xen_define_constant(S_blackman8_window, MUS_BLACKMAN8_WINDOW, "8th order cosine window");
+ Xen_define_constant(S_blackman9_window, MUS_BLACKMAN9_WINDOW, "9th order cosine window");
+ Xen_define_constant(S_blackman10_window, MUS_BLACKMAN10_WINDOW, "10th order cosine window");
+ Xen_define_constant(S_exponential_window, MUS_EXPONENTIAL_WINDOW, "An inverted triangle from exp");
+ Xen_define_constant(S_riemann_window, MUS_RIEMANN_WINDOW, "sinc-based window");
+ Xen_define_constant(S_kaiser_window, MUS_KAISER_WINDOW, "Bessel I0 based window");
+ Xen_define_constant(S_cauchy_window, MUS_CAUCHY_WINDOW, "window based on 1/(1+sqr(angle)");
+ Xen_define_constant(S_poisson_window, MUS_POISSON_WINDOW, "window based on exp(-angle)");
+ Xen_define_constant(S_gaussian_window, MUS_GAUSSIAN_WINDOW, "window based on exp(-sqr(angle))");
+ Xen_define_constant(S_tukey_window, MUS_TUKEY_WINDOW, "window based on truncated cosine");
+ Xen_define_constant(S_dolph_chebyshev_window, MUS_DOLPH_CHEBYSHEV_WINDOW, "window from inverse fft (using Chebyshev Tn)");
+ Xen_define_constant(S_connes_window, MUS_CONNES_WINDOW, "triangle window squared twice");
+ Xen_define_constant(S_hann_poisson_window, MUS_HANN_POISSON_WINDOW, "poisson window * hann window");
+ Xen_define_constant(S_samaraki_window, MUS_SAMARAKI_WINDOW, "window from inverse fft (using Chebyshev Un)");
+ Xen_define_constant(S_ultraspherical_window, MUS_ULTRASPHERICAL_WINDOW, "window from inverse fft (using Ultraspherical Cn)");
+ Xen_define_constant(S_rv2_window, MUS_RV2_WINDOW, "Rife-Vincent second order window (Hann extension)");
+ Xen_define_constant(S_rv3_window, MUS_RV3_WINDOW, "Rife-Vincent third order window (Hann extension)");
+ Xen_define_constant(S_rv4_window, MUS_RV4_WINDOW, "Rife-Vincent 4th order window (Hann extension)");
+ Xen_define_constant(S_mlt_sine_window, MUS_MLT_SINE_WINDOW, "modulated lapped transform sine window");
+ Xen_define_constant(S_papoulis_window, MUS_PAPOULIS_WINDOW, "papoulise window");
+ Xen_define_constant(S_dpss_window, MUS_DPSS_WINDOW, "proplate spheroidal (slepian) window");
+ Xen_define_constant(S_sinc_window, MUS_SINC_WINDOW, "sinc (Lanczos) window");
+
+ Xen_define_constant(S_mus_interp_linear, MUS_INTERP_LINEAR, "locsig/delay linear interpolation");
+ Xen_define_constant(S_mus_interp_sinusoidal, MUS_INTERP_SINUSOIDAL, "locsig sinusoidal interpolation");
+ Xen_define_constant(S_mus_interp_all_pass, MUS_INTERP_ALL_PASS, "delay interpolation");
+ Xen_define_constant(S_mus_interp_lagrange, MUS_INTERP_LAGRANGE, "second order lagrange interpolation");
+ Xen_define_constant(S_mus_interp_hermite, MUS_INTERP_HERMITE, "third order hermite interpolation");
+ Xen_define_constant(S_mus_interp_none, MUS_INTERP_NONE, "no interpolation -- step func");
+ Xen_define_constant(S_mus_interp_bezier, MUS_INTERP_BEZIER, "bezier interpolation");
+
+ Xen_define_constant(S_mus_chebyshev_first_kind, MUS_CHEBYSHEV_FIRST_KIND, "Chebyshev polynomial of first kind, for " S_partials_to_polynomial);
+ Xen_define_constant(S_mus_chebyshev_second_kind, MUS_CHEBYSHEV_SECOND_KIND, "Chebyshev polynomial of second kind, for " S_partials_to_polynomial);
+ Xen_define_constant(S_mus_chebyshev_both_kinds, MUS_CHEBYSHEV_BOTH_KINDS, "use both Chebyshev polynomials in polywave");
+
+ Xen_define_typed_procedure(S_mus_describe, g_mus_describe_w, 1, 0, 0, H_mus_describe, pl_sc);
+ Xen_define_typed_procedure(S_mus_file_name, g_mus_file_name_w, 1, 0, 0, H_mus_file_name, pl_sc);
+ Xen_define_typed_procedure(S_mus_reset, g_mus_reset_w, 1, 0, 0, H_mus_reset, pl_tc);
+ Xen_define_typed_procedure(S_mus_copy, g_mus_copy_w, 1, 0, 0, H_mus_copy, pl_cc);
+ Xen_define_procedure(S_mus_run, g_mus_run_w, 1, 2, 0, H_mus_run);
+
+ Xen_define_typed_procedure(S_mus_name, g_mus_name_w, 1, 0, 0, H_mus_name, pl_sc);
+ Xen_define_typed_dilambda(S_mus_phase, g_mus_phase_w, H_mus_phase, S_set S_mus_phase, g_mus_set_phase_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+ Xen_define_typed_dilambda(S_mus_scaler, g_mus_scaler_w, H_mus_scaler, S_set S_mus_scaler, g_mus_set_scaler_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+ Xen_define_typed_dilambda(S_mus_width, g_mus_width_w, H_mus_width, S_set S_mus_width, g_mus_set_width_w, 1, 0, 2, 0, pl_ic, pl_ici);
+ Xen_define_typed_dilambda(S_mus_frequency, g_mus_frequency_w, H_mus_frequency, S_set S_mus_frequency, g_mus_set_frequency_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+ Xen_define_typed_dilambda(S_mus_length, g_mus_length_w, H_mus_length, S_set S_mus_length, g_mus_set_length_w, 1, 0, 2, 0, pl_ic, pl_ici);
+ Xen_define_typed_dilambda(S_mus_data, g_mus_data_w, H_mus_data, S_set S_mus_data, g_mus_set_data_w, 1, 0, 2, 0, pl_fc, pl_fcf);
+ Xen_define_typed_dilambda(S_mus_xcoeff, g_mus_xcoeff_w, H_mus_xcoeff, S_set S_mus_xcoeff, g_mus_set_xcoeff_w, 2, 0, 3, 0, pl_dci, pl_dcir);
+ Xen_define_typed_dilambda(S_mus_ycoeff, g_mus_ycoeff_w, H_mus_ycoeff, S_set S_mus_ycoeff, g_mus_set_ycoeff_w, 2, 0, 3, 0, pl_dci, pl_dcir);
+ Xen_define_typed_dilambda(S_mus_offset, g_mus_offset_w, H_mus_offset, S_set S_mus_offset, g_mus_set_offset_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+
+ Xen_define_typed_procedure(S_mus_xcoeffs, g_mus_xcoeffs_w, 1, 0, 0, H_mus_xcoeffs, pl_fc);
+ Xen_define_typed_procedure(S_mus_ycoeffs, g_mus_ycoeffs_w, 1, 0, 0, H_mus_ycoeffs, pl_fc);
+ Xen_define_typed_procedure(S_is_oscil, g_is_oscil_w, 1, 0, 0, H_is_oscil, pl_bt);
+ Xen_define_typed_procedure(S_oscil, g_oscil_w, 1, 2, 0, H_oscil, Q_oscil);
+ Xen_define_typed_procedure(S_is_oscil_bank, g_is_oscil_bank_w, 1, 0, 0, H_is_oscil_bank, pl_bt);
+ Xen_define_typed_procedure(S_oscil_bank, g_oscil_bank_w, 1, 0, 0, H_oscil_bank, pl_dc);
+
+ Xen_define_procedure(S_mus_apply, g_mus_apply_w, 0, 0, 1, H_mus_apply);
+
+ Xen_define_typed_procedure(S_make_delay, g_make_delay_w, 0, 0, 1, H_make_delay, pcl_ct);
+ Xen_define_typed_procedure(S_make_comb, g_make_comb_w, 0, 0, 1, H_make_comb, pcl_ct);
+ Xen_define_typed_procedure(S_make_filtered_comb, g_make_filtered_comb_w, 0, 0, 1, H_make_filtered_comb, pcl_ct);
+ Xen_define_typed_procedure(S_make_notch, g_make_notch_w, 0, 0, 1, H_make_notch, pcl_ct);
+ Xen_define_typed_procedure(S_make_all_pass, g_make_all_pass_w, 0, 0, 1, H_make_all_pass, pcl_ct);
+ Xen_define_typed_procedure(S_make_moving_average, g_make_moving_average_w, 0, 0, 1, H_make_moving_average, pcl_ct);
+ Xen_define_typed_procedure(S_make_moving_max, g_make_moving_max_w, 0, 0, 1, H_make_moving_max, pcl_ct);
+ Xen_define_typed_procedure(S_make_moving_norm, g_make_moving_norm_w, 0, 0, 1, H_make_moving_norm, pcl_ct);
+ Xen_define_typed_procedure(S_delay, g_delay_w, 1, 2, 0, H_delay, pl_dcr);
+ Xen_define_typed_procedure(S_delay_tick, g_delay_tick_w, 1, 1, 0, H_delay_tick, pl_dcr);
+ Xen_define_typed_procedure(S_tap, g_tap_w, 1, 1, 0, H_tap, pl_dcr);
+ Xen_define_typed_procedure(S_notch, g_notch_w, 1, 2, 0, H_notch, pl_dcr);
+ Xen_define_typed_procedure(S_comb, g_comb_w, 1, 2, 0, H_comb, pl_dcr);
+ Xen_define_typed_procedure(S_filtered_comb, g_filtered_comb_w, 1, 2, 0, H_filtered_comb, pl_dcr);
+ Xen_define_typed_procedure(S_all_pass, g_all_pass_w, 1, 2, 0, H_all_pass, pl_dcr);
+ Xen_define_typed_procedure(S_moving_average, g_moving_average_w, 1, 1, 0, H_moving_average, pl_dcr);
+ Xen_define_typed_procedure(S_moving_max, g_moving_max_w, 1, 1, 0, H_moving_max, pl_dcr);
+ Xen_define_typed_procedure(S_moving_norm, g_moving_norm_w, 1, 1, 0, H_moving_norm, pl_dcr);
+ Xen_define_typed_procedure(S_is_tap, g_is_tap_w, 1, 0, 0, H_is_tap, pl_bt);
+ Xen_define_typed_procedure(S_is_delay, g_is_delay_w, 1, 0, 0, H_is_delay, pl_bt);
+ Xen_define_typed_procedure(S_is_notch, g_is_notch_w, 1, 0, 0, H_is_notch, pl_bt);
+ Xen_define_typed_procedure(S_is_comb, g_is_comb_w, 1, 0, 0, H_is_comb, pl_bt);
+ Xen_define_typed_procedure(S_is_filtered_comb, g_is_filtered_comb_w, 1, 0, 0, H_is_filtered_comb, pl_bt);
+ Xen_define_typed_procedure(S_is_all_pass, g_is_all_pass_w, 1, 0, 0, H_is_all_pass, pl_bt);
+ Xen_define_typed_procedure(S_is_moving_average, g_is_moving_average_w, 1, 0, 0, H_is_moving_average, pl_bt);
+ Xen_define_typed_procedure(S_is_moving_max, g_is_moving_max_w, 1, 0, 0, H_is_moving_max, pl_bt);
+ Xen_define_typed_procedure(S_is_moving_norm, g_is_moving_norm_w, 1, 0, 0, H_is_moving_norm, pl_bt);
+
+ Xen_define_typed_procedure(S_comb_bank, g_comb_bank_w, 1, 1, 0, H_comb_bank, pl_dcr);
+ Xen_define_typed_procedure(S_is_comb_bank, g_is_comb_bank_w, 1, 0, 0, H_is_comb_bank, pl_bt);
+ Xen_define_typed_procedure(S_make_comb_bank, g_make_comb_bank_w, 1, 0, 0, H_make_comb_bank, pcl_ct);
+
+ Xen_define_typed_procedure(S_filtered_comb_bank, g_filtered_comb_bank_w, 1, 1, 0, H_filtered_comb_bank, pl_dcr);
+ Xen_define_typed_procedure(S_is_filtered_comb_bank, g_is_filtered_comb_bank_w, 1, 0, 0, H_is_filtered_comb_bank, pl_bt);
+ Xen_define_typed_procedure(S_make_filtered_comb_bank, g_make_filtered_comb_bank_w, 1, 0, 0, H_make_filtered_comb_bank, pcl_ct);
+
+ Xen_define_typed_procedure(S_all_pass_bank, g_all_pass_bank_w, 1, 1, 0, H_all_pass_bank, pl_dcr);
+ Xen_define_typed_procedure(S_is_all_pass_bank, g_is_all_pass_bank_w, 1, 0, 0, H_is_all_pass_bank, pl_bt);
+ Xen_define_typed_procedure(S_make_all_pass_bank, g_make_all_pass_bank_w, 1, 0, 0, H_make_all_pass_bank, pcl_ct);
+
+ Xen_define_typed_procedure(S_pink_noise, g_pink_noise_w, 1, 0, 0, H_pink_noise, pl_dv);
+
+ Xen_define_typed_procedure(S_out_bank, g_out_bank_w, 3, 0, 0, H_out_bank, pl_dvir);
+
+ Xen_define_typed_dilambda(S_mus_feedback, g_mus_feedback_w, H_mus_feedback,
+ S_set S_mus_feedback, g_mus_set_feedback_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+ Xen_define_typed_dilambda(S_mus_feedforward, g_mus_feedforward_w, H_mus_feedforward,
+ S_set S_mus_feedforward, g_mus_set_feedforward_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+
+ Xen_define_typed_procedure(S_make_rand, g_make_rand_w, 0, 0, 1, H_make_rand, pcl_ct);
+ Xen_define_typed_procedure(S_make_rand_interp, g_make_rand_interp_w, 0, 0, 1, H_make_rand_interp, pcl_ct);
+#if HAVE_RUBY
+ rb_define_alias(rb_mKernel, "kernel_rand", "rand");
+#endif
+ Xen_define_typed_procedure(S_rand, g_rand_w, 1, 1, 0, H_rand, pl_dcr);
+ Xen_define_typed_procedure(S_rand_interp, g_rand_interp_w, 1, 1, 0, H_rand_interp, pl_dcr);
+ Xen_define_typed_procedure(S_is_rand, g_is_rand_w, 1, 0, 0, H_is_rand, pl_bt);
+ Xen_define_typed_procedure(S_is_rand_interp, g_is_rand_interp_w, 1, 0, 0, H_is_rand_interp, pl_bt);
+ Xen_define_typed_procedure(S_mus_random, g_mus_random_w, 1, 0, 0, H_mus_random, pl_dr);
+
+ Xen_define_typed_dilambda(S_mus_rand_seed, g_mus_rand_seed_w, H_mus_rand_seed,
+ S_set S_mus_rand_seed, g_mus_set_rand_seed_w, 0, 0, 1, 0, pl_i, pl_i);
+
+ Xen_define_typed_procedure(S_ncos, g_ncos_w, 1, 1, 0, H_ncos, pl_dcr);
+ Xen_define_typed_procedure(S_is_ncos, g_is_ncos_w, 1, 0, 0, H_is_ncos, pl_bt);
+ Xen_define_typed_procedure(S_nsin, g_nsin_w, 1, 1, 0, H_nsin, pl_dcr);
+ Xen_define_typed_procedure(S_is_nsin, g_is_nsin_w, 1, 0, 0, H_is_nsin, pl_bt);
+
+ Xen_define_typed_procedure(S_is_table_lookup, g_is_table_lookup_w, 1, 0, 0, H_is_table_lookup, pl_bt);
+ Xen_define_typed_procedure(S_make_table_lookup, g_make_table_lookup_w, 0, 0, 1, H_make_table_lookup, pcl_ct);
+ Xen_define_typed_procedure(S_table_lookup, g_table_lookup_w, 1, 1, 0, H_table_lookup, pl_dcr);
+ Xen_define_typed_procedure(S_partials_to_wave, g_partials_to_wave_w, 1, 2, 0, H_partials_to_wave, pl_fttb);
+ Xen_define_typed_procedure(S_phase_partials_to_wave, g_phase_partials_to_wave_w, 1, 2, 0, H_phase_partials_to_wave, pl_fttb);
+
+
+ Xen_define_typed_procedure(S_make_sawtooth_wave, g_make_sawtooth_wave_w, 0, 6, 0, H_make_sawtooth_wave, pcl_ct);
+ Xen_define_typed_procedure(S_sawtooth_wave, g_sawtooth_wave_w, 1, 1, 0, H_sawtooth_wave, pl_dcr);
+ Xen_define_typed_procedure(S_is_sawtooth_wave, g_is_sawtooth_wave_w, 1, 0, 0, H_is_sawtooth_wave, pl_bt);
+ Xen_define_typed_procedure(S_make_triangle_wave, g_make_triangle_wave_w, 0, 6, 0, H_make_triangle_wave, pcl_ct);
+ Xen_define_typed_procedure(S_triangle_wave, g_triangle_wave_w, 1, 1, 0, H_triangle_wave, pl_dcr);
+ Xen_define_typed_procedure(S_is_triangle_wave, g_is_triangle_wave_w, 1, 0, 0, H_is_triangle_wave, pl_bt);
+ Xen_define_typed_procedure(S_make_square_wave, g_make_square_wave_w, 0, 6, 0, H_make_square_wave, pcl_ct);
+ Xen_define_typed_procedure(S_square_wave, g_square_wave_w, 1, 1, 0, H_square_wave, pl_dcr);
+ Xen_define_typed_procedure(S_is_square_wave, g_is_square_wave_w, 1, 0, 0, H_is_square_wave, pl_bt);
+ Xen_define_typed_procedure(S_make_pulse_train, g_make_pulse_train_w, 0, 6, 0, H_make_pulse_train, pcl_ct);
+ Xen_define_typed_procedure(S_pulse_train, g_pulse_train_w, 1, 1, 0, H_pulse_train, pl_dcr);
+ Xen_define_typed_procedure(S_is_pulse_train, g_is_pulse_train_w, 1, 0, 0, H_is_pulse_train, pl_bt);
+
+
+ Xen_define_typed_procedure(S_make_pulsed_env, g_make_pulsed_env_w, 3, 0, 0, H_make_pulsed_env, pcl_ct);
+ Xen_define_typed_procedure(S_pulsed_env, g_pulsed_env_w, 1, 1, 0, H_pulsed_env, pl_dcr);
+ Xen_define_typed_procedure(S_is_pulsed_env, g_is_pulsed_env_w, 1, 0, 0, H_is_pulsed_env, pl_bt);
+
+
+ Xen_define_typed_procedure(S_asymmetric_fm, g_asymmetric_fm_w, 1, 2, 0, H_asymmetric_fm, pl_dcr);
+ Xen_define_typed_procedure(S_is_asymmetric_fm, g_is_asymmetric_fm_w, 1, 0, 0, H_is_asymmetric_fm, pl_bt);
+
+
+ Xen_define_typed_procedure(S_make_one_zero, g_make_one_zero_w, 0, 4, 0, H_make_one_zero, pcl_ct);
+ Xen_define_typed_procedure(S_one_zero, g_one_zero_w, 1, 1, 0, H_one_zero, pl_dcr);
+ Xen_define_typed_procedure(S_is_one_zero, g_is_one_zero_w, 1, 0, 0, H_is_one_zero, pl_bt);
+ Xen_define_typed_procedure(S_make_one_pole, g_make_one_pole_w, 0, 4, 0, H_make_one_pole, pcl_ct);
+ Xen_define_typed_procedure(S_one_pole, g_one_pole_w, 1, 1, 0, H_one_pole, pl_dcr);
+ Xen_define_typed_procedure(S_is_one_pole, g_is_one_pole_w, 1, 0, 0, H_is_one_pole, pl_bt);
+ Xen_define_typed_procedure(S_make_two_zero, g_make_two_zero_w, 0, 6, 0, H_make_two_zero, pcl_ct);
+ Xen_define_typed_procedure(S_two_zero, g_two_zero_w, 1, 1, 0, H_two_zero, pl_dcr);
+ Xen_define_typed_procedure(S_is_two_zero, g_is_two_zero_w, 1, 0, 0, H_is_two_zero, pl_bt);
+ Xen_define_typed_procedure(S_make_two_pole, g_make_two_pole_w, 0, 6, 0, H_make_two_pole, pcl_ct);
+ Xen_define_typed_procedure(S_two_pole, g_two_pole_w, 1, 1, 0, H_two_pole, pl_dcr);
+ Xen_define_typed_procedure(S_is_two_pole, g_is_two_pole_w, 1, 0, 0, H_is_two_pole, pl_bt);
+
+ Xen_define_typed_procedure(S_make_wave_train, g_make_wave_train_w, 0, 0, 1, H_make_wave_train, pcl_ct);
+ Xen_define_typed_procedure(S_wave_train, g_wave_train_w, 1, 1, 0, H_wave_train, pl_dcr);
+ Xen_define_typed_procedure(S_is_wave_train, g_is_wave_train_w, 1, 0, 0, H_is_wave_train, pl_bt);
+
+ Xen_define_typed_procedure(S_is_formant, g_is_formant_w, 1, 0, 0, H_is_formant, pl_bt);
+ Xen_define_typed_procedure(S_make_formant, g_make_formant_w, 0, 4, 0, H_make_formant, pcl_ct);
+ Xen_define_typed_procedure(S_formant, g_formant_w, 1, 2, 0, H_formant, pl_dcr);
+
+ Xen_define_typed_procedure(S_formant_bank, g_formant_bank_w, 1, 1, 0, H_formant_bank, pl_dcr);
+ Xen_define_typed_procedure(S_is_formant_bank, g_is_formant_bank_w, 1, 0, 0, H_is_formant_bank, pl_bt);
+ Xen_define_typed_procedure(S_make_formant_bank, g_make_formant_bank_w, 1, 1, 0, H_make_formant_bank, pcl_zt);
+
+ Xen_define_typed_procedure(S_is_firmant, g_is_firmant_w, 1, 0, 0, H_is_firmant, pl_bt);
+ Xen_define_typed_procedure(S_make_firmant, g_make_firmant_w, 0, 4, 0, H_make_firmant, pcl_ct);
+ Xen_define_typed_procedure(S_firmant, g_firmant_w, 1, 2, 0, H_firmant, pl_dcr);
+
+ Xen_define_typed_procedure(S_is_one_pole_all_pass, g_is_one_pole_all_pass_w, 1, 0, 0, H_is_one_pole_all_pass, pl_bt);
+ Xen_define_typed_procedure(S_make_one_pole_all_pass, g_make_one_pole_all_pass_w, 2, 0, 0, H_make_one_pole_all_pass, pcl_ct);
+ Xen_define_typed_procedure(S_one_pole_all_pass, g_one_pole_all_pass_w, 1, 1, 0, H_one_pole_all_pass, pl_dcr);
+
+ Xen_define_typed_procedure(S_mus_set_formant_frequency, g_set_formant_frequency_w, 2, 0, 0, H_mus_set_formant_frequency, pl_rcr);
+ Xen_define_typed_procedure(S_mus_set_formant_radius_and_frequency, g_set_formant_radius_and_frequency_w, 3, 0, 0, H_mus_set_formant_radius_and_frequency, pl_rcrr);
+
+
+ Xen_define_typed_procedure(S_make_polyshape, g_make_polyshape_w, 0, 0, 1, H_make_polyshape, pcl_ct);
+ Xen_define_typed_procedure(S_polyshape, g_polyshape_w, 1, 2, 0, H_polyshape, pl_dcr);
+ Xen_define_typed_procedure(S_is_polyshape, g_is_polyshape_w, 1, 0, 0, H_is_polyshape, pl_bt);
+ Xen_define_typed_procedure(S_partials_to_polynomial, g_partials_to_polynomial_w, 1, 1, 0, H_partials_to_polynomial, pl_fti);
+ Xen_define_typed_procedure(S_normalize_partials, g_normalize_partials_w, 1, 0, 0, H_normalize_partials, pl_tt);
+ Xen_define_typed_procedure(S_mus_chebyshev_t_sum, g_chebyshev_t_sum_w, 2, 0, 0, H_chebyshev_t_sum, pl_drf);
+ Xen_define_typed_procedure(S_mus_chebyshev_u_sum, g_chebyshev_u_sum_w, 2, 0, 0, H_chebyshev_u_sum, pl_drf);
+ Xen_define_typed_procedure(S_mus_chebyshev_tu_sum, g_chebyshev_tu_sum_w, 3, 0, 0, H_chebyshev_tu_sum, pl_drf);
+ Xen_define_typed_procedure(S_make_polywave, g_make_polywave_w, 0, 0, 1, H_make_polywave, pcl_ct);
+ Xen_define_typed_procedure(S_polywave, g_polywave_w, 1, 1, 0, H_polywave, pl_dcr);
+ Xen_define_typed_procedure(S_is_polywave, g_is_polywave_w, 1, 0, 0, H_is_polywave, pl_bt);
+
+ Xen_define_typed_procedure(S_make_nrxysin, g_make_nrxysin_w, 0, 0, 1, H_make_nrxysin, pcl_ct);
+ Xen_define_typed_procedure(S_nrxysin, g_nrxysin_w, 1, 1, 0, H_nrxysin, pl_dcr);
+ Xen_define_typed_procedure(S_is_nrxysin, g_is_nrxysin_w, 1, 0, 0, H_is_nrxysin, pl_bt);
+ Xen_define_typed_procedure(S_make_nrxycos, g_make_nrxycos_w, 0, 0, 1, H_make_nrxycos, pcl_ct);
+ Xen_define_typed_procedure(S_nrxycos, g_nrxycos_w, 1, 1, 0, H_nrxycos, pl_dcr);
+ Xen_define_typed_procedure(S_is_nrxycos, g_is_nrxycos_w, 1, 0, 0, H_is_nrxycos, pl_bt);
+
+ Xen_define_typed_procedure(S_make_rxyksin, g_make_rxyksin_w, 0, 0, 1, H_make_rxyksin, pl_ct);
+ Xen_define_typed_procedure(S_rxyksin, g_rxyksin_w, 1, 1, 0, H_rxyksin, pl_dcr);
+ Xen_define_typed_procedure(S_is_rxyksin, g_is_rxyksin_w, 1, 0, 0, H_is_rxyksin, pl_bt);
+ Xen_define_typed_procedure(S_make_rxykcos, g_make_rxykcos_w, 0, 0, 1, H_make_rxykcos, pcl_ct);
+ Xen_define_typed_procedure(S_rxykcos, g_rxykcos_w, 1, 1, 0, H_rxykcos, pl_dcr);
+ Xen_define_typed_procedure(S_is_rxykcos, g_is_rxykcos_w, 1, 0, 0, H_is_rxykcos, pl_bt);
+
+
+ Xen_define_typed_procedure(S_make_filter, g_make_filter_w, 0, 6, 0, H_make_filter, pcl_ct);
+ Xen_define_typed_procedure(S_filter, g_filter_w, 1, 1, 0, H_filter, pl_dcr);
+ Xen_define_typed_procedure(S_is_filter, g_is_filter_w, 1, 0, 0, H_is_filter, pl_bt);
+ Xen_define_typed_procedure(S_make_fir_coeffs, g_make_fir_coeffs_w, 2, 0, 0, H_make_fir_coeffs, pl_fif);
+ Xen_define_typed_procedure(S_make_fir_filter, g_make_fir_filter_w, 0, 4, 0, H_make_fir_filter, pcl_ct);
+ Xen_define_typed_procedure(S_fir_filter, g_fir_filter_w, 1, 1, 0, H_fir_filter, pl_dcr);
+ Xen_define_typed_procedure(S_is_fir_filter, g_is_fir_filter_w, 1, 0, 0, H_is_fir_filter, pl_bt);
+ Xen_define_typed_procedure(S_make_iir_filter, g_make_iir_filter_w, 0, 4, 0, H_make_iir_filter, pcl_ct);
+ Xen_define_typed_procedure(S_iir_filter, g_iir_filter_w, 1, 1, 0, H_iir_filter, pl_dcr);
+ Xen_define_typed_procedure(S_is_iir_filter, g_is_iir_filter_w, 1, 0, 0, H_is_iir_filter, pl_bt);
+ Xen_define_typed_procedure(S_mus_order, g_mus_order_w, 1, 0, 0, H_mus_order, pl_ic);
+ Xen_define_typed_procedure(S_mus_type, g_mus_type_w, 1, 0, 0, H_mus_type, pl_ic);
+
+
+ Xen_define_typed_procedure(S_is_env, g_is_env_w, 1, 0, 0, H_is_env, pl_bt);
+ Xen_define_typed_procedure(S_env, g_env_w, 1, 0, 0, H_env, pl_dc);
+ Xen_define_typed_procedure(S_make_env, g_make_env_w, 0, 0, 1, H_make_env, pcl_ct);
+ Xen_define_typed_procedure(S_env_interp, g_env_interp_w, 2, 0, 0, H_env_interp, pl_drc);
+ Xen_define_typed_procedure(S_envelope_interp, g_envelope_interp_w, 2, 1, 0, H_envelope_interp, pl_rrpr);
+ Xen_define_typed_procedure(S_env_any, g_env_any_w, 2, 0, 0, H_env_any, pl_dct);
+
+ Xen_define_typed_procedure(S_is_locsig, g_is_locsig_w, 1, 0, 0, H_is_locsig, pl_bt);
+ Xen_define_typed_procedure(S_locsig, g_locsig_w, 3, 0, 0, H_locsig, pl_rcr);
+ Xen_define_typed_procedure(S_make_locsig, g_make_locsig_w, 0, 0, 1, H_make_locsig, pcl_ct);
+ Xen_define_typed_procedure(S_move_locsig, g_move_locsig_w, 3, 0, 0, H_move_locsig, pl_ccrr);
+ Xen_define_typed_procedure(S_mus_channels, g_mus_channels_w, 1, 0, 0, H_mus_channels, pl_ic);
+
+#if HAVE_RUBY
+ Xen_define_procedure(S_locsig_ref, g_locsig_ref_w, 2, 0, 0, H_locsig_ref);
+ Xen_define_procedure(S_locsig_reverb_ref, g_locsig_reverb_ref_w, 2, 0, 0, H_locsig_reverb_ref);
+#endif
+
+ Xen_define_typed_procedure(S_locsig_set, g_locsig_set_w, 3, 0, 0, H_locsig_set, pl_rcir);
+
+#if HAVE_SCHEME || HAVE_FORTH
+ Xen_define_typed_dilambda(S_locsig_ref, g_locsig_ref_w, H_locsig_ref,
+ S_set S_locsig_ref, g_locsig_set_w, 2, 0, 3, 0, pl_dci, pl_dcir);
+ Xen_define_typed_dilambda(S_locsig_reverb_ref, g_locsig_reverb_ref_w, H_locsig_reverb_ref,
+ S_locsig_reverb_set, g_locsig_reverb_set_w, 2, 0, 3, 0, pl_dci, pl_dcir);
+#endif
+
+ Xen_define_typed_procedure(S_locsig_reverb_set, g_locsig_reverb_set_w, 3, 0, 0, H_locsig_reverb_set, pl_rcir);
+ Xen_define_typed_dilambda(S_locsig_type, g_locsig_type_w, H_locsig_type,
+ S_set S_locsig_type, g_set_locsig_type_w, 0, 0, 1, 0, pl_i, pl_i);
+
+ Xen_define_typed_procedure(S_is_move_sound, g_is_move_sound_w, 1, 0, 0, H_is_move_sound, pl_bt);
+ Xen_define_typed_procedure(S_move_sound, g_move_sound_w, 3, 0, 0, H_move_sound, pl_rcr);
+ Xen_define_typed_procedure(S_make_move_sound, g_make_move_sound_w, 1, 2, 0, H_make_move_sound, pcl_ct);
+
+ Xen_define_typed_procedure(S_is_file_to_sample, g_is_file_to_sample_w, 1, 0, 0, H_is_file_to_sample, pl_bt);
+ Xen_define_typed_procedure(S_make_file_to_sample, g_make_file_to_sample_w, 1, 1, 0, H_make_file_to_sample, pcl_ct);
+ Xen_define_typed_procedure(S_file_to_sample, g_file_to_sample_w, 2, 1, 0, H_file_to_sample, pl_dci);
+ Xen_define_typed_procedure(S_is_sample_to_file, g_is_sample_to_file_w, 1, 0, 0, H_is_sample_to_file, pl_bt);
+ Xen_define_typed_procedure(S_make_sample_to_file, g_make_sample_to_file_w, 1, 4, 0, H_make_sample_to_file, pcl_ct);
+ Xen_define_typed_procedure(S_continue_sample_to_file, g_continue_sample_to_file_w, 1, 0, 0, H_continue_sample_to_file, pl_cs);
+ Xen_define_typed_procedure(S_sample_to_file, g_sample_to_file_w, 4, 0, 0, H_sample_to_file, pl_rciir);
+ Xen_define_typed_procedure(S_sample_to_file_add, g_sample_to_file_add_w, 2, 0, 0, H_sample_to_file_add, pl_cc);
+
+ Xen_define_typed_procedure(S_is_file_to_frample, g_is_file_to_frample_w, 1, 0, 0, H_is_file_to_frample, pl_bt);
+ Xen_define_typed_procedure(S_make_file_to_frample, g_make_file_to_frample_w, 1, 1, 0, H_make_file_to_frample, pcl_ct);
+ Xen_define_typed_procedure(S_file_to_frample, g_file_to_frample_w, 2, 1, 0, H_file_to_frample, pl_ccic);
+ Xen_define_typed_procedure(S_continue_frample_to_file, g_continue_frample_to_file_w, 1, 0, 0, H_continue_frample_to_file, pl_cs);
+ Xen_define_typed_procedure(S_is_frample_to_file, g_is_frample_to_file_w, 1, 0, 0, H_is_frample_to_file, pl_bt);
+ Xen_define_typed_procedure(S_frample_to_file, g_frample_to_file_w, 3, 0, 0, H_frample_to_file, pl_fcif);
+ Xen_define_typed_procedure(S_make_frample_to_file, g_make_frample_to_file_w, 1, 4, 0, H_make_frample_to_file, pcl_zt);
+
+ Xen_define_typed_procedure(S_is_mus_input, g_is_mus_input_w, 1, 0, 0, H_is_mus_input, pl_bt);
+ Xen_define_typed_procedure(S_is_mus_output, g_is_mus_output_w, 1, 0, 0, H_is_mus_output, pl_bt);
+ Xen_define_typed_procedure(S_in_any, g_in_any_w, 3, 0, 0, H_in_any, pl_diit);
+ Xen_define_typed_procedure(S_ina, g_ina_w, 2, 0, 0, H_ina, pl_dit);
+ Xen_define_typed_procedure(S_inb, g_inb_w, 2, 0, 0, H_inb, pl_dit);
+ Xen_define_typed_procedure(S_out_any, g_out_any_w, 3, 1, 0, H_out_any, pl_ririt);
+ Xen_define_typed_procedure(S_outa, g_outa_w, 2, 1, 0, H_outa, pl_rirt);
+ Xen_define_typed_procedure(S_outb, g_outb_w, 2, 1, 0, H_outb, pl_rirt);
+ Xen_define_typed_procedure(S_outc, g_outc_w, 2, 1, 0, H_outc, pl_rirt);
+ Xen_define_typed_procedure(S_outd, g_outd_w, 2, 1, 0, H_outd, pl_rirt);
+ Xen_define_typed_procedure(S_mus_close, g_mus_close_w, 1, 0, 0, H_mus_close, pl_tc);
+
+ Xen_define_typed_dilambda(S_mus_file_buffer_size, g_mus_file_buffer_size_w, H_mus_file_buffer_size,
+ S_set S_mus_file_buffer_size, g_mus_set_file_buffer_size_w, 0, 0, 1, 0, pl_i, pl_i);
+
+
+ Xen_define_typed_procedure(S_is_readin, g_is_readin_w, 1, 0, 0, H_is_readin, pl_bt);
+ Xen_define_typed_procedure(S_readin, g_readin_w, 1, 0, 0, H_readin, pl_dc);
+ Xen_define_typed_procedure(S_make_readin, g_make_readin_w, 0, 0, 1, H_make_readin, pcl_ct);
+ Xen_define_typed_procedure(S_mus_channel, g_mus_channel_w, 1, 0, 0, H_mus_channel, pl_ic);
+ Xen_define_typed_procedure(S_mus_interp_type, g_mus_interp_type_w, 1, 0, 0, H_mus_interp_type, pl_ic);
+
+ Xen_define_typed_dilambda(S_mus_location, g_mus_location_w, H_mus_location,
+ S_set S_mus_location, g_mus_set_location_w, 1, 0, 2, 0, pl_ic, pl_ici);
+ Xen_define_typed_dilambda(S_mus_increment, g_mus_increment_w, H_mus_increment,
+ S_set S_mus_increment, g_mus_set_increment_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+
+ Xen_define_typed_procedure(S_is_granulate, g_is_granulate_w, 1, 0, 0, H_is_granulate, pl_bt);
+ Xen_define_typed_procedure(S_granulate, g_granulate_w, 1, 2, 0, H_granulate, pl_dc);
+ Xen_define_typed_procedure(S_make_granulate, g_make_granulate_w, 0, 0, 1, H_make_granulate, pcl_ct);
+
+ Xen_define_typed_dilambda(S_mus_ramp, g_mus_ramp_w, H_mus_ramp,
+ S_set S_mus_ramp, g_mus_set_ramp_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+
+
+ Xen_define_typed_procedure(S_clear_sincs, g_mus_clear_sincs_w, 0, 0, 0, "clears out any sinc tables", NULL);
+ Xen_define_typed_procedure(S_is_src, g_is_src_w, 1, 0, 0, H_is_src, pl_bt);
+ Xen_define_typed_procedure(S_src, g_src_w, 1, 2, 0, H_src, pl_dcr);
+ Xen_define_typed_procedure(S_make_src, g_make_src_w, 0, 6, 0, H_make_src, pcl_ct);
+
+
+ Xen_define_typed_procedure(S_is_convolve, g_is_convolve_w, 1, 0, 0, H_is_convolve, pl_bt);
+ Xen_define_typed_procedure(S_convolve, g_convolve_w, 1, 1, 0, H_convolve_gen, pl_dc);
+ Xen_define_typed_procedure(S_make_convolve, g_make_convolve_w, 0, 0, 1, H_make_convolve, pcl_ct);
+ Xen_define_typed_procedure(S_convolve_files, g_convolve_files_w, 2, 2, 0, H_convolve_files, pl_sssrs);
+
+ Xen_define_typed_procedure(S_is_phase_vocoder, g_is_phase_vocoder_w, 1, 0, 0, H_is_phase_vocoder, pl_bt);
+ Xen_define_typed_procedure(S_phase_vocoder, g_phase_vocoder_w, 1, 4, 0, H_phase_vocoder, pl_dc);
+ Xen_define_typed_procedure(S_make_phase_vocoder, g_make_phase_vocoder_w, 0, 0, 1, H_make_phase_vocoder, pcl_ct);
+ Xen_define_typed_procedure(S_phase_vocoder_amp_increments, g_phase_vocoder_amp_increments_w, 1, 0, 0, H_phase_vocoder_amp_increments, pl_fc);
+ Xen_define_typed_procedure(S_phase_vocoder_amps, g_phase_vocoder_amps_w, 1, 0, 0, H_phase_vocoder_amps, pl_fc);
+ Xen_define_typed_procedure(S_phase_vocoder_freqs, g_phase_vocoder_freqs_w, 1, 0, 0, H_phase_vocoder_freqs, pl_fc);
+ Xen_define_typed_procedure(S_phase_vocoder_phases, g_phase_vocoder_phases_w, 1, 0, 0, H_phase_vocoder_phases, pl_fc);
+ Xen_define_typed_procedure(S_phase_vocoder_phase_increments, g_phase_vocoder_phase_increments_w, 1, 0, 0, H_phase_vocoder_phase_increments, pl_fc);
+
+ Xen_define_typed_dilambda(S_mus_hop, g_mus_hop_w, H_mus_hop,
+ S_set S_mus_hop, g_mus_set_hop_w, 1, 0, 2, 0, pl_dc, pl_dcr);
+
+ Xen_define_typed_procedure(S_make_ssb_am, g_make_ssb_am_w, 0, 4, 0, H_make_ssb_am, pcl_ct);
+ Xen_define_typed_procedure(S_ssb_am, g_ssb_am_w, 1, 2, 0, H_ssb_am, pl_dcr);
+ Xen_define_typed_procedure(S_is_ssb_am, g_is_ssb_am_w, 1, 0, 0, H_is_ssb_am, pl_bt);
+
+ Xen_define_typed_procedure(S_is_mus_generator, g_is_mus_generator_w, 1, 0, 0, H_is_mus_generator, pl_bt);
+
+ Xen_define_variable(S_output, clm_output, Xen_false);
+ Xen_define_variable(S_reverb, clm_reverb, Xen_false);
+
+#if HAVE_SCHEME
+ {
+ s7_pointer clm_output_accessor, clm_reverb_accessor;
+ /* these are globals in s7, so they aren't going to move */
+ clm_output_slot = s7_slot(s7, clm_output);
+ clm_reverb_slot = s7_slot(s7, clm_reverb);
+ out_any_2 = out_any_2_to_mus_xen;
+ /* these can't be safe functions */
+ clm_output_accessor = s7_make_function(s7, "(set " S_output ")", g_clm_output_set, 2, 0, false, "called if " S_output " is set");
+ s7_symbol_set_access(s7, s7_make_symbol(s7, S_output), clm_output_accessor);
+
+ clm_reverb_accessor = s7_make_function(s7, "(set " S_reverb ")", g_clm_reverb_set, 2, 0, false, "called if " S_reverb " is set");
+ s7_symbol_set_access(s7, s7_make_symbol(s7, S_reverb), clm_reverb_accessor);
+ }
+#endif
+
+#if HAVE_SCHEME && (!_MSC_VER)
+ Xen_define_typed_procedure(S_get_internal_real_time, g_get_internal_real_time_w, 0, 0, 0, H_get_internal_real_time, NULL);
+ Xen_define_constant(S_internal_time_units_per_second, 1, "units used by " S_get_internal_real_time);
+#endif
#if HAVE_SCHEME
- XEN_EVAL_C_STRING("(define (clm-print . args) (apply format #t args))");
+ Xen_define_typed_procedure(S_piano_noise, g_piano_noise_w, 2, 0, 0, H_piano_noise, pl_dcr);
+ Xen_define_typed_procedure(S_singer_filter, g_singer_filter_w, 6, 0, 0, H_singer_filter, pl_riirfff);
+ Xen_define_typed_procedure(S_singer_nose_filter, g_singer_nose_filter_w, 5, 0, 0, H_singer_nose_filter, pl_rirfff);
#endif
+
+ Xen_define_typed_procedure(S_make_oscil, g_make_oscil_w, 0, 4, 0, H_make_oscil, pcl_ct);
+ Xen_define_typed_procedure(S_make_ncos, g_make_ncos_w, 0, 4, 0, H_make_ncos, pcl_ct);
+ Xen_define_typed_procedure(S_make_oscil_bank, g_make_oscil_bank_w, 2, 2, 0, H_make_oscil_bank, pcl_ct);
+ Xen_define_typed_procedure(S_make_nsin, g_make_nsin_w, 0, 4, 0, H_make_nsin, pcl_ct);
+ Xen_define_typed_procedure(S_make_asymmetric_fm, g_make_asymmetric_fm_w, 0, 8, 0, H_make_asymmetric_fm, pcl_ct);
+
+ Xen_define_typed_procedure(S_mus_file_mix, g_mus_file_mix_w, 0, 0, 1, H_mus_file_mix, NULL);
+ Xen_define_typed_procedure(S_mus_file_mix_with_envs, g_mus_file_mix_with_envs_w, 0, 0, 1, H_mus_file_mix_with_envs, NULL); /* actually 8 2 0 I think */
+ Xen_define_typed_procedure(S_frample_to_frample, g_frample_to_frample_w, 5, 0, 0, H_frample_to_frample, pl_fffifi);
+
+#if HAVE_SCHEME
+ init_choosers(s7);
+#endif
+
+
+ /* -------- clm-print (see also snd-xen.c) -------- */
+#if (!USE_SND)
+
+#if HAVE_FORTH
+Xen_eval_C_string("<'> fth-print alias clm-print ( fmt args -- )");
#endif
+#if HAVE_RUBY
+ Xen_eval_C_string("def clm_print(str, *args)\n\
+ $stdout.print format(str, *args)\n\
+ end");
+#endif
+#endif
- XEN_YES_WE_HAVE("clm");
+ Xen_provide_feature("clm");
{
char *clm_version;
clm_version = mus_format("clm%d", MUS_VERSION);
- XEN_YES_WE_HAVE(clm_version);
+ Xen_provide_feature(clm_version);
free(clm_version);
}
-#if HAVE_SCHEME && HAVE_GETTIMEOFDAY && HAVE_DIFFTIME && HAVE_SYS_TIME_H && (!_MSC_VER)
+#if HAVE_SCHEME && (!_MSC_VER)
{
struct timezone z0;
gettimeofday(&overall_start_time, &z0);
@@ -9051,7 +13157,19 @@ void Init_sndlib(void)
mus_sndlib_xen_initialize();
mus_vct_init();
mus_xen_init();
-#if (!USE_SND)
- mus_init_run();
+
+#if HAVE_SCHEME
+ if (sizeof(mus_float_t) != sizeof(s7_double))
+ fprintf(stderr, "in s7-clm, s7_double must match mus_float_t. Currently s7_double has %d bytes, but mus_float_t has %d\n",
+ (int)sizeof(s7_double),
+ (int)sizeof(mus_float_t));
#endif
}
+
+#if HAVE_SCHEME
+void s7_init_sndlib(s7_scheme *sc)
+{
+ s7_xen_initialize(sc);
+ Init_sndlib();
+}
+#endif
diff --git a/clm2xen.h b/clm2xen.h
index 2866306..7e4c906 100644
--- a/clm2xen.h
+++ b/clm2xen.h
@@ -3,19 +3,10 @@
#include "vct.h"
-typedef struct mus_xen {
- mus_any *gen;
- XEN *vcts; /* one for each accessible mus_float_t array (wrapped up here in a vct) */
- int nvcts;
- bool dont_free_gen;
- struct ptree *input_ptree; /* added 24-Apr-02 for run optimizer */
- struct ptree *edit_ptree; /* ditto 26-Jul-04 */
- struct ptree *analyze_ptree;
- struct ptree *synthesize_ptree;
-} mus_xen;
-
-#define XEN_TO_MUS_XEN(arg) ((mus_xen *)XEN_OBJECT_REF(arg))
-#define XEN_TO_MUS_ANY(obj) ((mus_any *)((XEN_TO_MUS_XEN(obj))->gen))
+typedef struct mus_xen mus_xen;
+
+#define Xen_to_mus_xen(arg) ((mus_xen *)Xen_object_ref(arg))
+#define Xen_to_mus_any(obj) mus_xen_gen(Xen_to_mus_xen(obj))
#define MUS_CLM_DEFAULT_TABLE_SIZE 512
#define MUS_CLM_DEFAULT_FREQUENCY 0.0
@@ -24,33 +15,37 @@ extern "C" {
#endif
MUS_EXPORT mus_long_t clm_default_table_size_c(void);
-MUS_EXPORT double clm_default_frequency_c(void);
+MUS_EXPORT mus_float_t clm_default_frequency_c(void);
+
+MUS_EXPORT mus_any *mus_xen_gen(mus_xen *x);
-MUS_EXPORT bool mus_xen_p(XEN obj);
+MUS_EXPORT bool mus_is_xen(Xen obj);
MUS_EXPORT const char *mus_fft_window_xen_name(mus_fft_window_t i);
-MUS_EXPORT XEN mus_xen_to_object(mus_xen *gn);
-MUS_EXPORT XEN mus_xen_to_object_with_vct(mus_xen *gn, XEN v);
-MUS_EXPORT mus_any *mus_optkey_to_mus_any(XEN key, const char *caller, int n, mus_any *def);
-MUS_EXPORT int mus_optkey_unscramble(const char *caller, int nkeys, XEN *keys, XEN *args, int *orig);
-MUS_EXPORT mus_float_t mus_optkey_to_float(XEN key, const char *caller, int n, mus_float_t def);
-MUS_EXPORT int mus_optkey_to_int(XEN key, const char *caller, int n, int def);
-MUS_EXPORT bool mus_optkey_to_bool(XEN key, const char *caller, int n, bool def);
-MUS_EXPORT mus_long_t mus_optkey_to_mus_long_t(XEN key, const char *caller, int n, mus_long_t def);
-MUS_EXPORT const char *mus_optkey_to_string(XEN key, const char *caller, int n, char *def);
-MUS_EXPORT XEN mus_optkey_to_procedure(XEN key, const char *caller, int n, XEN def, int required_args, const char *err);
+MUS_EXPORT Xen mus_xen_to_object(mus_xen *gn);
+MUS_EXPORT Xen mus_xen_to_object_with_vct(mus_xen *gn, Xen v);
+MUS_EXPORT mus_any *mus_optkey_to_mus_any(Xen key, const char *caller, int n, mus_any *def);
+MUS_EXPORT int mus_optkey_unscramble(const char *caller, int nkeys, Xen *keys, Xen *args, int *orig);
+MUS_EXPORT mus_float_t mus_optkey_to_float(Xen key, const char *caller, int n, mus_float_t def);
+MUS_EXPORT int mus_optkey_to_int(Xen key, const char *caller, int n, int def);
+MUS_EXPORT bool mus_optkey_to_bool(Xen key, const char *caller, int n, bool def);
+MUS_EXPORT mus_long_t mus_optkey_to_mus_long_t(Xen key, const char *caller, int n, mus_long_t def);
+MUS_EXPORT const char *mus_optkey_to_string(Xen key, const char *caller, int n, char *def);
+MUS_EXPORT Xen mus_optkey_to_procedure(Xen key, const char *caller, int n, Xen def, int required_args, const char *err);
+
MUS_EXPORT mus_xen *mus_any_to_mus_xen(mus_any *ge);
-MUS_EXPORT mus_float_t mus_locsig_or_move_sound_to_vct_or_sound_data(mus_xen *ms, mus_any *loc_gen, mus_long_t pos, mus_float_t fval, bool from_locsig);
-MUS_EXPORT mus_float_t *mus_vct_to_partials(vct *v, int *npartials, int *error_code);
-MUS_EXPORT XEN mus_clm_output(void);
-MUS_EXPORT XEN mus_clm_reverb(void);
+MUS_EXPORT mus_xen *mus_any_to_mus_xen_with_vct(mus_any *ge, Xen v);
+MUS_EXPORT mus_xen *mus_any_to_mus_xen_with_two_vcts(mus_any *ge, Xen v1, Xen v2);
-MUS_EXPORT XEN g_mus_channels(XEN obj);
-MUS_EXPORT XEN g_mus_length(XEN gen);
-MUS_EXPORT XEN g_mus_file_name(XEN gen);
-MUS_EXPORT XEN g_mus_data(XEN gen);
+MUS_EXPORT Xen g_mus_channels(Xen obj);
+MUS_EXPORT Xen g_mus_length(Xen gen);
+MUS_EXPORT Xen g_mus_file_name(Xen gen);
+MUS_EXPORT Xen g_mus_data(Xen gen);
-MUS_EXPORT void Init_sndlib(void);
+#if HAVE_SCHEME
+MUS_EXPORT void s7_init_sndlib(s7_scheme *sc);
+#endif
+MUS_EXPORT void Init_sndlib(void);
#ifdef __cplusplus
}
#endif
diff --git a/cload.scm b/cload.scm
new file mode 100644
index 0000000..64ceeb3
--- /dev/null
+++ b/cload.scm
@@ -0,0 +1,659 @@
+(provide 'cload.scm)
+
+;;; --------------------------------------------------------------------------------
+;;; automatically link a C function into s7 (there are a bunch of examples below)
+;;; (c-define '(double j0 (double)) "m" "math.h")
+;;; means link the name m:j0 to the math library function j0 passing a double arg and getting a double result (reals in s7)
+;;;
+;;; (c-define c-info prefix headers cflags ldflags)
+;;; prefix is some arbitrary prefix (it can be "") that you want prepended to various names.
+;;; headers is a list of headers (as strings) that the c-info relies on, (("math.h") for example).
+;;; cflags are any special C compiler flags that are needed ("-I." in particular).
+;;; ldflags is the similar case for the loader.
+;;; c-info is a list that describes the C entities that you want to tie into s7.
+;;; it can be either one list describing one entity, or a list of such lists.
+;;; Each description has the form: (return-type entity-name-in-C (argument-type...))
+;;; where each entry is a symbol, and C names are used throughout. So, in the j0
+;;; example above, (double j0 (double)) says we want access to j0, it returns
+;;; a C double, and takes one argument, also a C double. s7 tries to figure out
+;;; what the corresponding s7 type is, but in tricky cases, you should tell it
+;;; by replacing the bare type name with a list: (C-type underlying-C-type). For example,
+;;; the Snd function set_graph_style takes an (enum) argument of type graph_style_t.
+;;; This is actually an int, so we use (graph_style_t int) as the type:
+;;; (void set_graph_style ((graph_style_t int)))
+;;; If the C entity is a constant, then the descriptor list has just two entries,
+;;; the C-type and the entity name: (int F_OK) for example. The entity name can also be a list
+;;; (an enum listing for example).
+;;; If the C type has a space ("struct tm*" for example), use (symbol "struct tm*")
+;;; to construct the corresponding symbol.
+;;; The entity is placed in the current s7 environment under the name (string-append prefix ":" name)
+;;; where the ":" is omitted if the prefix is null. So in the j0 example, we get in s7 the function m:j0.
+;;;
+;;; some examples:
+;;;
+;;; (c-define '((double j0 (double))
+;;; (double j1 (double))
+;;; (double erf (double))
+;;; (double erfc (double))
+;;; (double lgamma (double)))
+;;; "m" "math.h")
+;;;
+;;;
+;;; (c-define '(char* getenv (char*)))
+;;; (c-define '(int setenv (char* char* int)))
+;;; (define get-environment-variable (let () (c-define '(char* getenv (char*))) getenv))
+;;;
+;;; (define file-exists? (let () (c-define '((int F_OK) (int access (char* int))) "" "unistd.h") (lambda (arg) (= (access arg F_OK) 0))))
+;;; (define delete-file (let () (c-define '(int unlink (char*)) "" "unistd.h") (lambda (file) (= (unlink file) 0)))) ; 0=success, -1=failure
+;;;
+;;;
+;;; these pick up Snd stuff:
+;;; (c-define '(char* version_info ()) "" "snd.h" "-I.")
+;;; (c-define '(mus_float_t mus_degrees_to_radians (mus_float_t)) "" "snd.h" "-I.")
+;;;
+;;; (c-define '(snd_info* any_selected_sound ()) "" "snd.h" "-I.")
+;;; (c-define '(void select_channel (snd_info* int)) "" "snd.h" "-I.")
+;;; (c-define '(((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS))
+;;; (void set_graph_style ((graph_style_t int))))
+;;; "" "snd.h" "-I.")
+;;;
+;;;
+;;; (c-define '(char* getcwd (char* size_t)) "" "unistd.h")
+;;; :(let ((str (make-string 32))) (getcwd str 32) str)
+;;; "/home/bil/cl\x00 "
+;;; so it works in a sense -- there is a memory leak here
+;;;
+;;;
+;;; (c-define (list '(void* calloc (size_t size_t))
+;;; '(void* malloc (size_t))
+;;; '(void free (void*))
+;;; '(void* realloc(void* size_t))
+;;; '(void time (time_t*)) ; ignore returned value
+;;; (list (symbol "struct tm*") 'localtime '(time_t*))
+;;; (list 'size_t 'strftime (list 'char* 'size_t 'char* (symbol "struct tm*"))))
+;;; "" "time.h")
+;;; > (let ((p (calloc 1 8)) (str (make-string 32))) (time p) (strftime str 32 "%a %d-%b-%Y %H:%M %Z" (localtime p)) (free p) str)
+;;; "Sat 11-Aug-2012 08:55 PDT\x00 "
+;;;
+;;;
+;;; (c-define '((int closedir (DIR*))
+;;; (DIR* opendir (char*))
+;;; (in-C "static char *read_dir(DIR *p) \
+;;; { \
+;;; struct dirent *dirp; \
+;;; dirp = readdir(p); \
+;;; if (!dirp) return(NULL); \
+;;; else return(dirp->d_name); \
+;;; }")
+;;; (char* read_dir (DIR*)))
+;;; "" '("sys/types.h" "dirent.h"))
+;;;
+;;; (let ((dir (opendir "/home/bil/gtk-snd")))
+;;; (do ((p (read_dir dir) (read_dir dir)))
+;;; ((= (length p) 0))
+;;; (format *stderr* "~A " p))
+;;; (closedir dir))
+;;;
+;;; (define (memory-usage)
+;;; (with-let *libc*
+;;; (let ((v (rusage.make)))
+;;; (getrusage RUSAGE_SELF v)
+;;; (let ((mem (rusage.ru_maxrss v)))
+;;; (free v)
+;;; (* 1024 mem)))))
+;;; --------------------------------------------------------------------------------
+
+(define *cload-cflags* "")
+(define *cload-ldflags* "")
+
+
+(define-macro (defvar name value)
+ `(if (not (defined? ',name))
+ (define ,name ,value)))
+
+(defvar c-define-output-file-counter 0) ; ugly, but I can't find a way around this (dlopen/dlsym stupidity)
+
+
+;;; to place the new function in the caller's current environment, we need to pass the environment in explicitly:
+(define-macro (c-define . args)
+ `(c-define-1 (curlet) , at args))
+
+
+(define* (c-define-1 cur-env function-info (prefix "") (headers ()) (cflags "") (ldflags "") output-name)
+ ;; write a C shared library module that links in the functions in function-info
+ ;; function info is either a list: (return-type c-name arg-type) or a list thereof
+ ;; the new functions are placed in cur-env
+
+ (define collides?
+ (let ((all-names ()))
+ (lambda (name)
+ (if (member name all-names eq?)
+ (format *stderr* "~A twice?~%" name)
+ (set! all-names (cons name all-names)))
+ name)))
+
+ (define handlers (list '(integer s7_is_integer s7_integer s7_make_integer s7_int)
+ '(boolean s7_is_boolean s7_boolean s7_make_boolean bool)
+ '(real s7_is_real s7_number_to_real s7_make_real s7_double)
+
+ ;; '(complex s7_is_complex #f s7_make_complex s7_Complex)
+ ;; the typedef is around line 6116 in s7.c, but we also need s7_complex which requires the s7_Complex type
+ ;; xen.h uses (s7_real_part(a) + s7_imag_part(a) * _Complex_I) instead since c++ won't let use define s7_Complex in s7.h
+
+ '(string s7_is_string s7_string s7_make_string char*)
+ (list 'character 's7_is_character 's7_character 's7_make_character (symbol "unsigned char"))
+ '(c_pointer s7_is_c_pointer s7_c_pointer s7_make_c_pointer void*)
+ '(s7_pointer #f #f #f s7_pointer)
+ ))
+
+ (define (find-handler handle choice)
+ (let ((found (assoc handle handlers eq?)))
+ (if (pair? found)
+ (choice found)
+ #t)))
+
+
+ (define (C-type->s7-type type)
+
+ (if (pair? type) ; in case the type name does not make its C type obvious: (graph_style_t int)
+ (symbol->string (cadr type))
+ (let ((type-name (symbol->string type)))
+ (cond ((string-position "**" type-name) ; any complicated C pointer is uninterpreted
+ 'c_pointer)
+
+ ((string=? "s7_pointer" type-name)
+ 's7_pointer)
+
+ ((string-position "char*" type-name) ; but not char** (caught above)
+ 'string)
+
+ ((or (string-position "*" type-name) ; float* etc
+ (string-position "pointer" type-name))
+ 'c_pointer)
+
+ ((string-position "char" type-name)
+ 'character)
+
+ ((string-position "bool" type-name)
+ 'boolean)
+
+ ;; ((string-position "complex" type-name)
+ ;; 'complex) ; double complex or complex double (mus_edot_product in clm.c uses the latter)
+
+ ((or (string-position "float" type-name)
+ (string-position "double" type-name))
+ 'real)
+
+ ((or (string-position "int" type-name)
+ (string-position "long" type-name) ; assuming not "long double" here so we need to look for it first (above)
+ (string-position "short" type-name)
+ (string-position "size" type-name)
+ (string-position "byte" type-name))
+ 'integer)
+
+ (#t #t)))))
+
+ (define (C->s7-cast type)
+ (find-handler (C-type->s7-type type) (lambda (p) (car (cddddr p)))))
+
+ (define (C->s7 type)
+ (find-handler (C-type->s7-type type) cadddr))
+
+ (define (s7->C type)
+ (find-handler (C-type->s7-type type) caddr))
+
+ (define (checker type)
+ (find-handler (C-type->s7-type type) cadr))
+
+ (define* (cload->signature type (rtn #f))
+ (case (C-type->s7-type type)
+ ((real) (if rtn 'float? 'real?))
+ ((integer) 'integer?)
+ ((string) 'string?)
+ ((boolean) 'boolean?)
+ ((character) 'char?)
+ ((c_pointer) 'c-pointer?)
+ (else #t)))
+
+ (define (signature->pl type)
+ (case type
+ ((integer?) #\i)
+ ((boolean?) #\b)
+ ((real?) #\r)
+ ((float?) #\d)
+ ((char?) #\c)
+ ((string?) #\s)
+ ((c-pointer?) #\x)
+ (else #\t)))
+
+ (set! c-define-output-file-counter (+ c-define-output-file-counter 1))
+
+ (let* ((file-name (or output-name (format "temp-s7-output-~D" c-define-output-file-counter)))
+ (c-file-name (string-append file-name ".c"))
+ (o-file-name (string-append file-name ".o"))
+ (so-file-name (string-append file-name ".so"))
+ (init-name (if output-name
+ (string-append output-name "_init")
+ (string-append "init_" (number->string c-define-output-file-counter))))
+ (functions ())
+ (constants ())
+ (macros ()) ; these are protected by #ifdef ... #endif
+ (inits ()) ; C code (a string in s7) inserted in the library initialization function
+ (p #f)
+ (if-funcs ()) ; if-functions (guaranteed to return int, so we can optimize away make-integer etc)
+ (rf-funcs ()) ; rf-functions
+ (sig-symbols (list (cons 'integer? 0) (cons 'boolean? 0) (cons 'real? 0) (cons 'float? 0)
+ (cons 'char? 0) (cons 'string? 0) (cons 'c-pointer? 0) (cons 't 0)))
+ (signatures (make-hash-table)))
+
+ (define (make-signature rtn args)
+
+ (define (compress sig)
+ (if (and (pair? sig)
+ (pair? (cdr sig))
+ (eq? (car sig) (cadr sig)))
+ (compress (cdr sig))
+ sig))
+
+ (let ((sig (list (cload->signature rtn #t)))
+ (cyclic #f))
+ (for-each
+ (lambda (arg)
+ (set! sig (cons (cload->signature arg) sig)))
+ args)
+ (let ((len (length sig)))
+ (set! sig (compress sig))
+ (set! cyclic (not (= len (length sig)))))
+ (set! sig (reverse sig))
+ (when (not (signatures sig)) ; it's not in our collection yet
+ (let ((pl (make-string (+ (if cyclic 4 3) (length sig))))
+ (loc (if cyclic 4 3)))
+ (set! (pl 0) #\p)
+ (if cyclic
+ (begin (set! (pl 1) #\c) (set! (pl 2) #\l) (set! (pl 3) #\_))
+ (begin (set! (pl 1) #\l) (set! (pl 2) #\_)))
+ (for-each
+ (lambda (typer)
+ (set! (pl loc) (signature->pl typer))
+ (let ((count (or (assoc typer sig-symbols eq?)
+ (assoc 't sig-symbols eq?))))
+ (set-cdr! count (+ (cdr count) 1)))
+ (set! loc (+ loc 1)))
+ sig)
+ (set! (signatures sig) pl)))
+ sig))
+
+ (define (initialize-c-file)
+ ;; C header stuff
+ (set! p (open-output-file c-file-name))
+ (format p "#include <stdlib.h>~%")
+ (format p "#include <stdio.h>~%")
+ (format p "#include <string.h>~%")
+ (if (string? headers)
+ (format p "#include <~A>~%" headers)
+ (for-each
+ (lambda (header)
+ (format p "#include <~A>~%" header))
+ headers))
+ (format p "#include \"s7.h\"~%~%"))
+
+
+ (define* (add-one-function return-type name arg-types doc)
+ ;; (format *stderr* "~A ~A ~A~%" return-type name arg-types): double j0 (double) for example
+ ;; C function -> scheme
+ (let* ((func-name (symbol->string (collides? name)))
+ (num-args (length arg-types))
+ (base-name (string-append (if (> (length prefix) 0) prefix "s7_dl") "_" func-name)) ; not "g" -- collides with glib
+ (scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") func-name)))
+
+ (if (and (= num-args 1)
+ (eq? (car arg-types) 'void))
+ (set! num-args 0))
+ (format p "~%/* -------- ~A -------- */~%" func-name)
+ (format p "static s7_pointer ~A(s7_scheme *sc, s7_pointer args)~%" base-name)
+ (format p "{~%")
+
+ ;; get the Scheme args, check their types, assign to local C variables
+ (if (positive? num-args)
+ (begin
+ (format p " s7_pointer arg;~%")
+ (do ((i 0 (+ i 1))
+ (type arg-types (cdr type)))
+ ((= i num-args))
+ (format p " ~A ~A_~D;~%" (if (pair? (car type)) (caar type) (car type)) base-name i))
+ (format p " arg = args;~%")
+ (do ((i 0 (+ i 1))
+ (type arg-types (cdr type)))
+ ((= i num-args))
+
+ (let* ((nominal-type (if (pair? (car type)) (caar type) (car type))) ; double in the example
+ (true-type (if (pair? (car type)) (cadar type) (car type)))
+ (s7-type (C-type->s7-type true-type))) ; real
+ (if (eq? true-type 's7_pointer)
+ (format p " ~A_~D = s7_car(arg);~%" base-name i)
+ (begin
+ (format p " if (~A(s7_car(arg)))~%" (checker true-type))
+ (format p " ~A_~D = (~A)~A(~As7_car(arg));~%"
+ base-name i
+ nominal-type
+ (s7->C true-type) ; s7_number_to_real which requires
+ (if (member s7-type '(boolean real) eq?) ; the extra sc arg
+ "sc, " ""))
+ (format p " else return(s7_wrong_type_arg_error(sc, ~S, ~D, s7_car(arg), ~S));~%"
+ func-name
+ (if (= num-args 1) 0 (+ i 1))
+ (if (symbol? s7-type)
+ (symbol->string s7-type)
+ (error 'bad-arg (format #f "in ~S, ~S is not a symbol~%" name s7-type))))))
+ (if (< i (- num-args 1))
+ (format p " arg = s7_cdr(arg);~%"))))))
+
+ ;; return C value to Scheme
+ (if (pair? return-type)
+ (set! return-type (cadr return-type)))
+ (let ((return-translator (C->s7 return-type)))
+ (format p " ")
+ (if (not (eq? return-translator #t))
+ (format p "return("))
+ (if (symbol? return-translator)
+ (format p "~A(sc, (~A)" return-translator (C->s7-cast return-type)))
+ (format p "~A(" func-name)
+ (do ((i 0 (+ i 1)))
+ ((>= i (- num-args 1)))
+ (format p "~A_~D, " base-name i))
+ (if (positive? num-args)
+ (format p "~A_~D" base-name (- num-args 1)))
+ (format p ")")
+ (if (symbol? return-translator)
+ (format p ")"))
+ (if (not (eq? return-translator #t))
+ (format p ");~%")
+ (format p ";~% return(s7_unspecified(sc));~%"))
+ (format p "}~%"))
+
+ ;; add optimizer connection
+ (when (and (eq? return-type 'double) ; double (f double) -- s7_rf_t: double f(s7, s7_pointer **p)
+ (eq? (car arg-types) 'double)
+ (or (= num-args 1)
+ (and (= num-args 2) ; double (f double double)
+ (eq? (cadr arg-types) 'double))))
+ (set! rf-funcs (cons (cons func-name scheme-name) rf-funcs))
+ (if (= num-args 1)
+ (format p "static s7_double ~A_rf_r(s7_scheme *sc, s7_pointer **p)~
+ {s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
+ func-name func-name)
+ (format p "static s7_double ~A_rf_r(s7_scheme *sc, s7_pointer **p)~% ~
+ {s7_rf_t f; s7_double x, y; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); f = (s7_rf_t)(**p); (*p)++; y = f(sc, p); return(~A(x, y));}~%"
+ func-name func-name))
+ (format p "static s7_rf_t ~A_rf(s7_scheme *sc, s7_pointer expr) ~
+ {if (s7_arg_to_rf(sc, s7_cadr(expr))) return(~A_rf_r); return(NULL);}~%"
+ func-name func-name))
+
+ (when (and (eq? return-type 'int) ; int (f int|double|void)
+ (member (car arg-types) '(int double void) eq?)
+ (<= num-args 1))
+ (set! if-funcs (cons (cons func-name scheme-name) if-funcs))
+ (case (car arg-types)
+ ((double)
+ (format p "static s7_int ~A_if_r(s7_scheme *sc, s7_pointer **p)~
+ {s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
+ func-name func-name)
+ (format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) ~
+ {if (s7_arg_to_if(sc, s7_cadr(expr))) return(~A_if_r); return(NULL);}~%"
+ func-name func-name))
+ ((int)
+ (format p "static s7_int ~A_if_i(s7_scheme *sc, s7_pointer **p)~
+ {s7_if_t f; s7_int x; f = (s7_if_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
+ func-name func-name)
+ (format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) ~
+ {if (s7_arg_to_if(sc, s7_cadr(expr))) return(~A_if_i); return(NULL);}~%"
+ func-name func-name))
+ ((void)
+ (format p "static s7_int ~A_if_i(s7_scheme *sc, s7_pointer **p) {return(~A());}~%" func-name func-name)
+ (format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) {return(~A_if_i);}~%" func-name func-name))))
+
+ (format p "~%")
+ (set! functions (cons (list scheme-name base-name
+ (if (and (string? doc)
+ (> (length doc) 0))
+ doc
+ (format #f "~A ~A~A" return-type func-name arg-types))
+ num-args 0
+ (make-signature return-type arg-types))
+ functions))))
+
+
+ (define (add-one-constant type name)
+ ;; C constant -> scheme
+ (let ((c-type (if (pair? type) (cadr type) type)))
+ (if (symbol? name)
+ (set! constants (cons (list c-type (symbol->string (collides? name))) constants))
+ (for-each
+ (lambda (c)
+ (set! constants (cons (list c-type (symbol->string (collides? c))) constants)))
+ name))))
+
+
+ (define (add-one-macro type name)
+ ;; C macro (with definition check) -> scheme
+ (let ((c-type (if (pair? type) (cadr type) type)))
+ (if (symbol? name)
+ (set! macros (cons (list c-type (symbol->string (collides? name))) macros))
+ (for-each
+ (lambda (c)
+ (set! macros (cons (list c-type (symbol->string (collides? c))) macros)))
+ name))))
+
+
+ (define (end-c-file)
+ ;; now the init function
+ ;; the new scheme variables and functions are placed in the current environment
+
+ (format p "void ~A(s7_scheme *sc);~%" init-name)
+ (format p "void ~A(s7_scheme *sc)~%" init-name)
+ (format p "{~%")
+ (format p " s7_pointer cur_env;~%")
+ (format p " s7_pointer ")
+ (let ((pls (hash-table-entries signatures))
+ (loc 1))
+ (for-each
+ (lambda (s)
+ (format p "~A~A~A" (cdr s) (if (< loc pls) "," ";") (if (< loc pls) " " #\newline))
+ (set! loc (+ loc 1)))
+ signatures))
+
+ (let ((syms ())
+ (names ()))
+ (for-each
+ (lambda (q)
+ (when (positive? (cdr q))
+ (set! syms (cons (car q) syms))
+ (set! names (cons (signature->pl (car q)) names))))
+ sig-symbols)
+ (when (pair? syms)
+ (format p " {~% s7_pointer ~{~C~^, ~};~%" names)
+ (for-each
+ (lambda (name sym)
+ (if (eq? sym 't)
+ (format p " t = s7_t(sc);~%")
+ (format p " ~C = s7_make_symbol(sc, ~S);~%" name (symbol->string sym))))
+ names syms))
+ (format p "~%")
+ (for-each
+ (lambda (sig)
+ (let ((cyclic (char=? ((cdr sig) 1) #\c)))
+ (if cyclic
+ (format p " ~A = s7_make_circular_signature(sc, ~D, ~D" (cdr sig) (- (length (car sig)) 1) (length (car sig)))
+ (format p " ~A = s7_make_signature(sc, ~D" (cdr sig) (length (car sig))))
+ (format p "~{~^, ~C~}" (substring (cdr sig) (if cyclic 4 3)))
+ (format p ");~%")))
+ signatures)
+ (format p " }~%~%"))
+
+ (format p " cur_env = s7_outlet(sc, s7_curlet(sc));~%") ; this must exist because we pass load the env ourselves
+
+ ;; send out any special initialization code
+ (for-each
+ (lambda (init-str)
+ (format p " ~A~%" init-str))
+ (reverse inits))
+
+ ;; "constants" -- actually variables in s7 because we want them to be local to the current environment
+ (if (pair? constants)
+ (begin
+ (format p "~%")
+ (for-each
+ (lambda (c)
+ (let* ((type (c 0))
+ (c-name (c 1))
+ (scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") c-name)))
+ (format p " s7_define(sc, cur_env, s7_make_symbol(sc, ~S), ~A(sc, (~A)~A));~%"
+ scheme-name
+ (C->s7 type)
+ (C->s7-cast type)
+ c-name)))
+ constants)))
+
+ ;; C macros -- need #ifdef name #endif wrapper
+ (if (pair? macros)
+ (begin
+ (format p "~%")
+ (for-each
+ (lambda (c)
+ (let* ((type (c 0))
+ (c-name (c 1))
+ (scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") c-name)))
+ (format p "#ifdef ~A~%" c-name)
+ (format p " s7_define(sc, cur_env, s7_make_symbol(sc, ~S), ~A(sc, (~A)~A));~%"
+ scheme-name
+ (C->s7 type)
+ (C->s7-cast type)
+ c-name)
+ (format p "#endif~%")))
+ macros)))
+
+ ;; functions
+ (for-each
+ (lambda (f)
+ (let ((scheme-name (f 0))
+ (base-name (f 1))
+ (help (f 2))
+ (num-args (f 3))
+ (opt-args (if (> (length f) 4) (f 4) 0))
+ (sig (and (> (length f) 5) (f 5))))
+ (format p "~% s7_define(sc, cur_env,~% s7_make_symbol(sc, ~S),~%" scheme-name)
+ (format p " s7_make_typed_function(sc, ~S, ~A, ~D, ~D, false, ~S, ~A));~%"
+ scheme-name
+ base-name
+ num-args
+ opt-args
+ help
+ (if (pair? sig) (signatures sig) 'NULL))))
+ functions)
+
+ ;; optimizer connection
+ (when (pair? rf-funcs)
+ (format p "~% /* rf optimizer connections */~%")
+ (for-each
+ (lambda (f)
+ (format p " s7_rf_set_function(s7_name_to_value(sc, ~S), ~A_rf);~%" (cdr f) (car f)))
+ rf-funcs))
+
+ (when (pair? if-funcs)
+ (format p "~% /* if optimizer connections */~%")
+ (for-each
+ (lambda (f)
+ (format p " s7_if_set_function(s7_name_to_value(sc, ~S), ~A_if);~%" (cdr f) (car f)))
+ if-funcs))
+
+ (format p "}~%")
+ (close-output-port p)
+
+ ;; now we have the module .c file -- make it into a shared object, load it, delete the temp files
+
+ (if (provided? 'osx)
+ (begin
+ ;; I assume the caller is also compiled with these flags?
+ (system (format #f "gcc -c ~A ~A"
+ c-file-name (string-append *cload-cflags* " " cflags)))
+ (system (format #f "gcc ~A -o ~A -dynamic -bundle -undefined suppress -flat_namespace ~A"
+ o-file-name so-file-name (string-append *cload-ldflags* " " ldflags))))
+
+ (if (provided? 'freebsd)
+ (begin
+ (system (format #f "cc -fPIC -c ~A ~A"
+ c-file-name (string-append *cload-cflags* " " cflags)))
+ (system (format #f "cc ~A -shared -o ~A ~A"
+ o-file-name so-file-name (string-append *cload-ldflags* " " ldflags))))
+
+ (if (provided? 'openbsd)
+ (begin
+ (system (format #f "cc -fPIC -ftrampolines -c ~A ~A"
+ c-file-name (string-append *cload-cflags* " " cflags)))
+ (system (format #f "cc ~A -shared -o ~A ~A"
+ o-file-name so-file-name (string-append *cload-ldflags* " " ldflags))))
+
+ (begin
+ (system (format #f "gcc -fPIC -c ~A ~A"
+ c-file-name (string-append *cload-cflags* " " cflags)))
+ (system (format #f "gcc ~A -shared -o ~A ~A"
+ o-file-name so-file-name (string-append *cload-ldflags* " " ldflags))))))))
+
+ (define (check-doc func-data)
+ (let ((doc (caddr func-data)))
+ (if (and (string? doc)
+ (> (length doc) 0))
+ func-data
+ (append (list (car func-data) (cadr func-data) (car func-data)) (cdddr func-data)))))
+
+ (define (handle-declaration func)
+ ;; functions
+ (if (>= (length func) 3)
+ (apply add-one-function func)
+ (case (car func)
+ ((in-C) (format p "~A~%" (cadr func)))
+ ((C-init) (set! inits (cons (cadr func) inits)))
+ ((C-macro) (apply add-one-macro (cadr func)))
+ ((C-function) (collides? (caadr func)) (set! functions (cons (check-doc (cadr func)) functions)))
+ (else (apply add-one-constant func)))))
+
+
+ ;; this is the body of c-define
+ (if (or (not output-name)
+ (not (file-exists? c-file-name))
+ (not (file-exists? so-file-name))
+ (not (provided? 'system-extras))
+ (< (file-mtime so-file-name) (file-mtime c-file-name)) ; they are equal on my linux system
+ (and (file-exists? (port-filename (current-input-port))) ; we're actually loading a file
+ (< (file-mtime so-file-name) (file-mtime (port-filename (current-input-port))))))
+ (begin
+ (format *stderr* "writing ~A~%" c-file-name)
+ ;; write a new C file and compile it
+ (initialize-c-file)
+
+ (if (and (pair? (cdr function-info))
+ (symbol? (cadr function-info)))
+ (handle-declaration function-info)
+ (for-each handle-declaration function-info))
+
+ (end-c-file)
+ (delete-file o-file-name)))
+
+ ;; load the object file, clean up
+ (let ((new-env (sublet cur-env 'init_func (string->symbol init-name))))
+ (format *stderr* "loading ~A~%" so-file-name)
+ (load so-file-name new-env))))
+
+
+
+;;; backwards compatibility
+(define define-c-function c-define)
+
+
+#|
+(let ((cd (symbol "complex double"))
+ (cd* (symbol "complex double *")))
+ (c-define (list cd 'mus_edot_product (list cd cd* 'int))))
+
+;complex double mus_edot_product(complex double freq, complex double *data, mus_long_t size)
+|#
diff --git a/config.guess b/config.guess
index 2852378..0aee604 100755
--- a/config.guess
+++ b/config.guess
@@ -1,14 +1,14 @@
#! /bin/sh
# Attempt to guess a canonical system name.
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-# Free Software Foundation, Inc.
+# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+# 2011, 2012, 2013 Free Software Foundation, Inc.
-timestamp='2010-08-21'
+timestamp='2012-12-30'
# This file 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 2 of the License, or
+# 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
@@ -17,26 +17,22 @@ timestamp='2010-08-21'
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
-# 02110-1301, USA.
+# along with this program; if not, see <http://www.gnu.org/licenses/>.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-
-# Originally written by Per Bothner. Please send patches (context
-# diff format) to <config-patches at gnu.org> and include a ChangeLog
-# entry.
+# the same distribution terms that you use for the rest of that
+# program. This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
#
-# This script attempts to guess a canonical system name similar to
-# config.sub. If it succeeds, it prints the system name on stdout, and
-# exits with 0. Otherwise, it exits with 1.
+# Originally written by Per Bothner.
#
# You can get the latest version of this script from:
# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
+#
+# Please send patches with a ChangeLog entry to config-patches at gnu.org.
+
me=`echo "$0" | sed -e 's,.*/,,'`
@@ -57,8 +53,8 @@ GNU config.guess ($timestamp)
Originally written by Per Bothner.
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free
-Software Foundation, Inc.
+2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011,
+2012, 2013 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -92,7 +88,7 @@ if test $# != 0; then
exit 1
fi
-trap 'exit 1' HUP INT TERM
+trap 'exit 1' 1 2 15
# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
# compiler to aid in system detection is discouraged as it requires
@@ -106,7 +102,7 @@ trap 'exit 1' HUP INT TERM
set_cc_for_build='
trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
-trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" HUP INT PIPE TERM ;
+trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
: ${TMPDIR=/tmp} ;
{ tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
{ test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
@@ -145,7 +141,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
*:NetBSD:*:*)
# NetBSD (nbsd) targets should (where applicable) match one or
- # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,
+ # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
# *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
# switched to ELF, *-*-netbsd* would select the old
# object file format. This provides both forward
@@ -181,7 +177,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
fi
;;
*)
- os=netbsd
+ os=netbsd
;;
esac
# The OS release
@@ -202,6 +198,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
echo "${machine}-${os}${release}"
exit ;;
+ *:Bitrig:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
+ echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE}
+ exit ;;
*:OpenBSD:*:*)
UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
@@ -224,7 +224,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
;;
*5.*)
- UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
;;
esac
# According to Compaq, /usr/sbin/psrinfo has been available on
@@ -270,7 +270,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
# A Xn.n version is an unreleased experimental baselevel.
# 1.2 uses "1.2" for uname -r.
echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
- exit ;;
+ # Reset EXIT trap before exiting to avoid spurious non-zero exit code.
+ exitcode=$?
+ trap '' 0
+ exit $exitcode ;;
Alpha\ *:Windows_NT*:*)
# How do we know it's Interix rather than the generic POSIX subsystem?
# Should we change UNAME_MACHINE based on the output of uname instead
@@ -296,12 +299,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
echo s390-ibm-zvmoe
exit ;;
*:OS400:*:*)
- echo powerpc-ibm-os400
+ echo powerpc-ibm-os400
exit ;;
arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
echo arm-acorn-riscix${UNAME_RELEASE}
exit ;;
- arm:riscos:*:*|arm:RISCOS:*:*)
+ arm*:riscos:*:*|arm*:RISCOS:*:*)
echo arm-unknown-riscos
exit ;;
SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
@@ -395,23 +398,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
# MiNT. But MiNT is downward compatible to TOS, so this should
# be no problem.
atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
- echo m68k-atari-mint${UNAME_RELEASE}
+ echo m68k-atari-mint${UNAME_RELEASE}
exit ;;
atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
echo m68k-atari-mint${UNAME_RELEASE}
- exit ;;
+ exit ;;
*falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
- echo m68k-atari-mint${UNAME_RELEASE}
+ echo m68k-atari-mint${UNAME_RELEASE}
exit ;;
milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
- echo m68k-milan-mint${UNAME_RELEASE}
- exit ;;
+ echo m68k-milan-mint${UNAME_RELEASE}
+ exit ;;
hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
- echo m68k-hades-mint${UNAME_RELEASE}
- exit ;;
+ echo m68k-hades-mint${UNAME_RELEASE}
+ exit ;;
*:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
- echo m68k-unknown-mint${UNAME_RELEASE}
- exit ;;
+ echo m68k-unknown-mint${UNAME_RELEASE}
+ exit ;;
m68k:machten:*:*)
echo m68k-apple-machten${UNAME_RELEASE}
exit ;;
@@ -481,8 +484,8 @@ EOF
echo m88k-motorola-sysv3
exit ;;
AViiON:dgux:*:*)
- # DG/UX returns AViiON for all architectures
- UNAME_PROCESSOR=`/usr/bin/uname -p`
+ # DG/UX returns AViiON for all architectures
+ UNAME_PROCESSOR=`/usr/bin/uname -p`
if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
then
if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
@@ -495,7 +498,7 @@ EOF
else
echo i586-dg-dgux${UNAME_RELEASE}
fi
- exit ;;
+ exit ;;
M88*:DolphinOS:*:*) # DolphinOS (SVR3)
echo m88k-dolphin-sysv3
exit ;;
@@ -595,52 +598,52 @@ EOF
9000/[678][0-9][0-9])
if [ -x /usr/bin/getconf ]; then
sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
- sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
- case "${sc_cpu_version}" in
- 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
- 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
- 532) # CPU_PA_RISC2_0
- case "${sc_kernel_bits}" in
- 32) HP_ARCH="hppa2.0n" ;;
- 64) HP_ARCH="hppa2.0w" ;;
+ sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+ case "${sc_cpu_version}" in
+ 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
+ 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
+ 532) # CPU_PA_RISC2_0
+ case "${sc_kernel_bits}" in
+ 32) HP_ARCH="hppa2.0n" ;;
+ 64) HP_ARCH="hppa2.0w" ;;
'') HP_ARCH="hppa2.0" ;; # HP-UX 10.20
- esac ;;
- esac
+ esac ;;
+ esac
fi
if [ "${HP_ARCH}" = "" ]; then
eval $set_cc_for_build
- sed 's/^ //' << EOF >$dummy.c
+ sed 's/^ //' << EOF >$dummy.c
- #define _HPUX_SOURCE
- #include <stdlib.h>
- #include <unistd.h>
+ #define _HPUX_SOURCE
+ #include <stdlib.h>
+ #include <unistd.h>
- int main ()
- {
- #if defined(_SC_KERNEL_BITS)
- long bits = sysconf(_SC_KERNEL_BITS);
- #endif
- long cpu = sysconf (_SC_CPU_VERSION);
+ int main ()
+ {
+ #if defined(_SC_KERNEL_BITS)
+ long bits = sysconf(_SC_KERNEL_BITS);
+ #endif
+ long cpu = sysconf (_SC_CPU_VERSION);
- switch (cpu)
- {
- case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
- case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
- case CPU_PA_RISC2_0:
- #if defined(_SC_KERNEL_BITS)
- switch (bits)
- {
- case 64: puts ("hppa2.0w"); break;
- case 32: puts ("hppa2.0n"); break;
- default: puts ("hppa2.0"); break;
- } break;
- #else /* !defined(_SC_KERNEL_BITS) */
- puts ("hppa2.0"); break;
- #endif
- default: puts ("hppa1.0"); break;
- }
- exit (0);
- }
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+ case CPU_PA_RISC2_0:
+ #if defined(_SC_KERNEL_BITS)
+ switch (bits)
+ {
+ case 64: puts ("hppa2.0w"); break;
+ case 32: puts ("hppa2.0n"); break;
+ default: puts ("hppa2.0"); break;
+ } break;
+ #else /* !defined(_SC_KERNEL_BITS) */
+ puts ("hppa2.0"); break;
+ #endif
+ default: puts ("hppa1.0"); break;
+ }
+ exit (0);
+ }
EOF
(CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`
test -z "$HP_ARCH" && HP_ARCH=hppa
@@ -731,22 +734,22 @@ EOF
exit ;;
C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
echo c1-convex-bsd
- exit ;;
+ exit ;;
C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
if getsysinfo -f scalar_acc
then echo c32-convex-bsd
else echo c2-convex-bsd
fi
- exit ;;
+ exit ;;
C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
echo c34-convex-bsd
- exit ;;
+ exit ;;
C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
echo c38-convex-bsd
- exit ;;
+ exit ;;
C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
echo c4-convex-bsd
- exit ;;
+ exit ;;
CRAY*Y-MP:*:*:*)
echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
exit ;;
@@ -770,14 +773,14 @@ EOF
exit ;;
F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
- FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
- echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
- exit ;;
+ FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+ FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
+ echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+ exit ;;
5000:UNIX_System_V:4.*:*)
- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
- FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
- echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+ FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+ FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
+ echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
exit ;;
i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
@@ -789,30 +792,35 @@ EOF
echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
exit ;;
*:FreeBSD:*:*)
- case ${UNAME_MACHINE} in
- pc98)
- echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+ UNAME_PROCESSOR=`/usr/bin/uname -p`
+ case ${UNAME_PROCESSOR} in
amd64)
echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
*)
- echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+ echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
esac
exit ;;
i*:CYGWIN*:*)
echo ${UNAME_MACHINE}-pc-cygwin
exit ;;
+ *:MINGW64*:*)
+ echo ${UNAME_MACHINE}-pc-mingw64
+ exit ;;
*:MINGW*:*)
echo ${UNAME_MACHINE}-pc-mingw32
exit ;;
+ i*:MSYS*:*)
+ echo ${UNAME_MACHINE}-pc-msys
+ exit ;;
i*:windows32*:*)
- # uname -m includes "-pc" on this system.
- echo ${UNAME_MACHINE}-mingw32
+ # uname -m includes "-pc" on this system.
+ echo ${UNAME_MACHINE}-mingw32
exit ;;
i*:PW*:*)
echo ${UNAME_MACHINE}-pc-pw32
exit ;;
*:Interix*:*)
- case ${UNAME_MACHINE} in
+ case ${UNAME_MACHINE} in
x86)
echo i586-pc-interix${UNAME_RELEASE}
exit ;;
@@ -858,6 +866,13 @@ EOF
i*86:Minix:*:*)
echo ${UNAME_MACHINE}-pc-minix
exit ;;
+ aarch64:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ aarch64_be:Linux:*:*)
+ UNAME_MACHINE=aarch64_be
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
alpha:Linux:*:*)
case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
EV5) UNAME_MACHINE=alphaev5 ;;
@@ -867,7 +882,7 @@ EOF
EV6) UNAME_MACHINE=alphaev6 ;;
EV67) UNAME_MACHINE=alphaev67 ;;
EV68*) UNAME_MACHINE=alphaev68 ;;
- esac
+ esac
objdump --private-headers /bin/sh | grep -q ld.so.1
if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
@@ -879,20 +894,29 @@ EOF
then
echo ${UNAME_MACHINE}-unknown-linux-gnu
else
- echo ${UNAME_MACHINE}-unknown-linux-gnueabi
+ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep -q __ARM_PCS_VFP
+ then
+ echo ${UNAME_MACHINE}-unknown-linux-gnueabi
+ else
+ echo ${UNAME_MACHINE}-unknown-linux-gnueabihf
+ fi
fi
exit ;;
avr32*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
cris:Linux:*:*)
- echo cris-axis-linux-gnu
+ echo ${UNAME_MACHINE}-axis-linux-gnu
exit ;;
crisv32:Linux:*:*)
- echo crisv32-axis-linux-gnu
+ echo ${UNAME_MACHINE}-axis-linux-gnu
exit ;;
frv:Linux:*:*)
- echo frv-unknown-linux-gnu
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ hexagon:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
i*86:Linux:*:*)
LIBC=gnu
@@ -934,7 +958,7 @@ EOF
test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
;;
or32:Linux:*:*)
- echo or32-unknown-linux-gnu
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
padre:Linux:*:*)
echo sparc-unknown-linux-gnu
@@ -960,7 +984,7 @@ EOF
echo ${UNAME_MACHINE}-ibm-linux
exit ;;
sh64*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
sh*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-gnu
@@ -969,16 +993,16 @@ EOF
echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
tile*:Linux:*:*)
- echo ${UNAME_MACHINE}-tilera-linux-gnu
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
vax:Linux:*:*)
echo ${UNAME_MACHINE}-dec-linux-gnu
exit ;;
x86_64:Linux:*:*)
- echo x86_64-unknown-linux-gnu
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
xtensa*:Linux:*:*)
- echo ${UNAME_MACHINE}-unknown-linux-gnu
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
i*86:DYNIX/ptx:4*:*)
# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
@@ -987,11 +1011,11 @@ EOF
echo i386-sequent-sysv4
exit ;;
i*86:UNIX_SV:4.2MP:2.*)
- # Unixware is an offshoot of SVR4, but it has its own version
- # number series starting with 2...
- # I am not positive that other SVR4 systems won't match this,
+ # Unixware is an offshoot of SVR4, but it has its own version
+ # number series starting with 2...
+ # I am not positive that other SVR4 systems won't match this,
# I just have to hope. -- rms.
- # Use sysv4.2uw... so that sysv4* matches it.
+ # Use sysv4.2uw... so that sysv4* matches it.
echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
exit ;;
i*86:OS/2:*:*)
@@ -1023,7 +1047,7 @@ EOF
fi
exit ;;
i*86:*:5:[678]*)
- # UnixWare 7.x, OpenUNIX and OpenServer 6.
+ # UnixWare 7.x, OpenUNIX and OpenServer 6.
case `/bin/uname -X | grep "^Machine"` in
*486*) UNAME_MACHINE=i486 ;;
*Pentium) UNAME_MACHINE=i586 ;;
@@ -1051,13 +1075,13 @@ EOF
exit ;;
pc:*:*:*)
# Left here for compatibility:
- # uname -m prints for DJGPP always 'pc', but it prints nothing about
- # the processor, so we play safe by assuming i586.
+ # uname -m prints for DJGPP always 'pc', but it prints nothing about
+ # the processor, so we play safe by assuming i586.
# Note: whatever this is, it MUST be the same as what config.sub
# prints for the "djgpp" host, or else GDB configury will decide that
# this is a cross-build.
echo i586-pc-msdosdjgpp
- exit ;;
+ exit ;;
Intel:Mach:3*:*)
echo i386-pc-mach3
exit ;;
@@ -1092,8 +1116,8 @@ EOF
/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
&& { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
- /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
- && { echo i486-ncr-sysv4; exit; } ;;
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4; exit; } ;;
NCR*:*:4.2:* | MPRAS*:*:4.2:*)
OS_REL='.3'
test -r /etc/.relid \
@@ -1136,10 +1160,10 @@ EOF
echo ns32k-sni-sysv
fi
exit ;;
- PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
- # says <Richard.M.Bartel at ccMail.Census.GOV>
- echo i586-unisys-sysv4
- exit ;;
+ PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+ # says <Richard.M.Bartel at ccMail.Census.GOV>
+ echo i586-unisys-sysv4
+ exit ;;
*:UNIX_System_V:4*:FTX*)
# From Gerald Hewes <hewes at openmarket.com>.
# How about differentiating between stratus architectures? -djm
@@ -1165,11 +1189,11 @@ EOF
exit ;;
R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
if [ -d /usr/nec ]; then
- echo mips-nec-sysv${UNAME_RELEASE}
+ echo mips-nec-sysv${UNAME_RELEASE}
else
- echo mips-unknown-sysv${UNAME_RELEASE}
+ echo mips-unknown-sysv${UNAME_RELEASE}
fi
- exit ;;
+ exit ;;
BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
echo powerpc-be-beos
exit ;;
@@ -1182,6 +1206,9 @@ EOF
BePC:Haiku:*:*) # Haiku running on Intel PC compatible.
echo i586-pc-haiku
exit ;;
+ x86_64:Haiku:*:*)
+ echo x86_64-unknown-haiku
+ exit ;;
SX-4:SUPER-UX:*:*)
echo sx4-nec-superux${UNAME_RELEASE}
exit ;;
@@ -1234,7 +1261,10 @@ EOF
*:QNX:*:4*)
echo i386-pc-qnx
exit ;;
- NSE-?:NONSTOP_KERNEL:*:*)
+ NEO-?:NONSTOP_KERNEL:*:*)
+ echo neo-tandem-nsk${UNAME_RELEASE}
+ exit ;;
+ NSE-*:NONSTOP_KERNEL:*:*)
echo nse-tandem-nsk${UNAME_RELEASE}
exit ;;
NSR-?:NONSTOP_KERNEL:*:*)
@@ -1279,13 +1309,13 @@ EOF
echo pdp10-unknown-its
exit ;;
SEI:*:*:SEIUX)
- echo mips-sei-seiux${UNAME_RELEASE}
+ echo mips-sei-seiux${UNAME_RELEASE}
exit ;;
*:DragonFly:*:*)
echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
exit ;;
*:*VMS:*:*)
- UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
case "${UNAME_MACHINE}" in
A*) echo alpha-dec-vms ; exit ;;
I*) echo ia64-dec-vms ; exit ;;
@@ -1303,11 +1333,11 @@ EOF
i*86:AROS:*:*)
echo ${UNAME_MACHINE}-pc-aros
exit ;;
+ x86_64:VMkernel:*:*)
+ echo ${UNAME_MACHINE}-unknown-esx
+ exit ;;
esac
-#echo '(No uname command or uname output not recognized.)' 1>&2
-#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
-
eval $set_cc_for_build
cat >$dummy.c <<EOF
#ifdef _SEQUENT_
@@ -1325,11 +1355,11 @@ main ()
#include <sys/param.h>
printf ("m68k-sony-newsos%s\n",
#ifdef NEWSOS4
- "4"
+ "4"
#else
- ""
+ ""
#endif
- ); exit (0);
+ ); exit (0);
#endif
#endif
diff --git a/config.rpath b/config.rpath
deleted file mode 100755
index 5ead758..0000000
--- a/config.rpath
+++ /dev/null
@@ -1,513 +0,0 @@
-#! /bin/sh
-# Output a system dependent set of variables, describing how to set the
-# run time search path of shared libraries in an executable.
-#
-# Copyright 1996-2002 Free Software Foundation, Inc.
-# Taken from GNU libtool, 2001
-# Originally by Gordon Matzigkeit <gord at gnu.ai.mit.edu>, 1996
-#
-# 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 2 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-#
-# The first argument passed to this file is the canonical host specification,
-# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
-# or
-# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
-# The environment variables CC, GCC, LDFLAGS, LD, with_gnu_ld
-# should be set by the caller.
-#
-# The set of defined variables is at the end of this script.
-
-# All known linkers require a `.a' archive for static linking (except M$VC,
-# which needs '.lib').
-libext=a
-shlibext=
-
-host="$1"
-host_cpu=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-host_vendor=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-host_os=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-
-wl=
-if test "$GCC" = yes; then
- wl='-Wl,'
-else
- case "$host_os" in
- aix3* | aix4* | aix5*)
- wl='-Wl,'
- ;;
- hpux9* | hpux10* | hpux11*)
- wl='-Wl,'
- ;;
- irix5* | irix6*)
- wl='-Wl,'
- ;;
- linux*)
- echo '__INTEL_COMPILER' > conftest.$ac_ext
- if $CC -E conftest.$ac_ext >/dev/null | grep __INTEL_COMPILER >/dev/null
- then
- :
- else
- # Intel icc
- wl='-Qoption,ld,'
- fi
- ;;
- osf3* | osf4* | osf5*)
- wl='-Wl,'
- ;;
- solaris*)
- wl='-Wl,'
- ;;
- sunos4*)
- wl='-Qoption ld '
- ;;
- sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
- if test "x$host_vendor" = xsni; then
- wl='-LD'
- else
- wl='-Wl,'
- fi
- ;;
- esac
-fi
-
-hardcode_libdir_flag_spec=
-hardcode_libdir_separator=
-hardcode_direct=no
-hardcode_minus_L=no
-
-case "$host_os" in
- cygwin* | mingw* | pw32*)
- # FIXME: the MSVC++ port hasn't been tested in a loooong time
- # When not using gcc, we currently assume that we are using
- # Microsoft Visual C++.
- if test "$GCC" != yes; then
- with_gnu_ld=no
- fi
- ;;
- openbsd*)
- with_gnu_ld=no
- ;;
-esac
-
-ld_shlibs=yes
-if test "$with_gnu_ld" = yes; then
- case "$host_os" in
- aix3* | aix4* | aix5*)
- # On AIX, the GNU linker is very broken
- ld_shlibs=no
- ;;
- amigaos*)
- hardcode_libdir_flag_spec='-L$libdir'
- hardcode_minus_L=yes
- # Samuel A. Falvo II <kc5tja at dolphin.openprojects.net> reports
- # that the semantics of dynamic libraries on AmigaOS, at least up
- # to version 4, is to share data among multiple programs linked
- # with the same dynamic library. Since this doesn't match the
- # behavior of shared libraries on other platforms, we can use
- # them.
- ld_shlibs=no
- ;;
- beos*)
- if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
- :
- else
- ld_shlibs=no
- fi
- ;;
- cygwin* | mingw* | pw32*)
- # hardcode_libdir_flag_spec is actually meaningless, as there is
- # no search path for DLLs.
- hardcode_libdir_flag_spec='-L$libdir'
- ;;
- solaris* | sysv5*)
- if $LD -v 2>&1 | egrep 'BFD 2\.8' > /dev/null; then
- ld_shlibs=no
- elif $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
- :
- else
- ld_shlibs=no
- fi
- ;;
- sunos4*)
- hardcode_direct=yes
- ;;
- *)
- if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
- :
- else
- ld_shlibs=no
- fi
- ;;
- esac
- if test "$ld_shlibs" = yes; then
- hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
- fi
-else
- case "$host_os" in
- aix3*)
- # Note: this linker hardcodes the directories in LIBPATH if there
- # are no directories specified by -L.
- hardcode_minus_L=yes
- if test "$GCC" = yes; then
- # Neither direct hardcoding nor static linking is supported with a
- # broken collect2.
- hardcode_direct=unsupported
- fi
- ;;
- aix4* | aix5*)
- if test "$host_cpu" = ia64; then
- # On IA64, the linker does run time linking by default, so we don't
- # have to do anything special.
- aix_use_runtimelinking=no
- else
- aix_use_runtimelinking=no
- # Test if we are trying to use run time linking or normal
- # AIX style linking. If -brtl is somewhere in LDFLAGS, we
- # need to do runtime linking.
- case $host_os in aix4.[23]|aix4.[23].*|aix5*)
- for ld_flag in $LDFLAGS; do
- if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
- aix_use_runtimelinking=yes
- break
- fi
- done
- esac
- fi
- hardcode_direct=yes
- hardcode_libdir_separator=':'
- if test "$GCC" = yes; then
- case $host_os in aix4.[012]|aix4.[012].*)
- collect2name=`${CC} -print-prog-name=collect2`
- if test -f "$collect2name" && \
- strings "$collect2name" | grep resolve_lib_name >/dev/null
- then
- # We have reworked collect2
- hardcode_direct=yes
- else
- # We have old collect2
- hardcode_direct=unsupported
- hardcode_minus_L=yes
- hardcode_libdir_flag_spec='-L$libdir'
- hardcode_libdir_separator=
- fi
- esac
- fi
- if test "$aix_use_runtimelinking" = yes; then
- hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:/usr/lib:/lib'
- else
- if test "$host_cpu" = ia64; then
- hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib'
- else
- hardcode_libdir_flag_spec='${wl}-bnolibpath ${wl}-blibpath:$libdir:/usr/lib:/lib'
- fi
- fi
- ;;
- amigaos*)
- hardcode_libdir_flag_spec='-L$libdir'
- hardcode_minus_L=yes
- # see comment about different semantics on the GNU ld section
- ld_shlibs=no
- ;;
- cygwin* | mingw* | pw32*)
- # When not using gcc, we currently assume that we are using
- # Microsoft Visual C++.
- # hardcode_libdir_flag_spec is actually meaningless, as there is
- # no search path for DLLs.
- hardcode_libdir_flag_spec=' '
- libext=lib
- ;;
- darwin* | rhapsody*)
- hardcode_direct=yes
- ;;
- freebsd1*)
- ld_shlibs=no
- ;;
- freebsd2.2*)
- hardcode_libdir_flag_spec='-R$libdir'
- hardcode_direct=yes
- ;;
- freebsd2*)
- hardcode_direct=yes
- hardcode_minus_L=yes
- ;;
- freebsd*)
- hardcode_libdir_flag_spec='-R$libdir'
- hardcode_direct=yes
- ;;
- hpux9* | hpux10* | hpux11*)
- hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
- hardcode_libdir_separator=:
- hardcode_direct=yes
- hardcode_minus_L=yes # Not in the search PATH, but as the default
- # location of the library.
- ;;
- irix5* | irix6*)
- hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
- hardcode_libdir_separator=:
- ;;
- netbsd*)
- hardcode_libdir_flag_spec='-R$libdir'
- hardcode_direct=yes
- ;;
- newsos6)
- hardcode_direct=yes
- hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
- hardcode_libdir_separator=:
- ;;
- openbsd*)
- hardcode_direct=yes
- if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
- hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
- else
- case "$host_os" in
- openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*)
- hardcode_libdir_flag_spec='-R$libdir'
- ;;
- *)
- hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
- ;;
- esac
- fi
- ;;
- os2*)
- hardcode_libdir_flag_spec='-L$libdir'
- hardcode_minus_L=yes
- ;;
- osf3*)
- hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
- hardcode_libdir_separator=:
- ;;
- osf4* | osf5*)
- if test "$GCC" = yes; then
- hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
- else
- # Both cc and cxx compiler support -rpath directly
- hardcode_libdir_flag_spec='-rpath $libdir'
- fi
- hardcode_libdir_separator=:
- ;;
- sco3.2v5*)
- ;;
- solaris*)
- hardcode_libdir_flag_spec='-R$libdir'
- ;;
- sunos4*)
- hardcode_libdir_flag_spec='-L$libdir'
- hardcode_direct=yes
- hardcode_minus_L=yes
- ;;
- sysv4)
- if test "x$host_vendor" = xsno; then
- hardcode_direct=yes # is this really true???
- else
- hardcode_direct=no # Motorola manual says yes, but my tests say they lie
- fi
- ;;
- sysv4.3*)
- ;;
- sysv5*)
- hardcode_libdir_flag_spec=
- ;;
- uts4*)
- hardcode_libdir_flag_spec='-L$libdir'
- ;;
- dgux*)
- hardcode_libdir_flag_spec='-L$libdir'
- ;;
- sysv4*MP*)
- if test -d /usr/nec; then
- ld_shlibs=yes
- fi
- ;;
- sysv4.2uw2*)
- hardcode_direct=yes
- hardcode_minus_L=no
- ;;
- sysv5uw7* | unixware7*)
- ;;
- *)
- ld_shlibs=no
- ;;
- esac
-fi
-
-# Check dynamic linker characteristics
-libname_spec='lib$name'
-sys_lib_dlsearch_path_spec="/lib /usr/lib"
-sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
-case "$host_os" in
- aix3*)
- shlibext=so
- ;;
- aix4* | aix5*)
- shlibext=so
- ;;
- amigaos*)
- shlibext=ixlibrary
- ;;
- beos*)
- shlibext=so
- ;;
- bsdi4*)
- shlibext=so
- sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
- sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
- ;;
- cygwin* | mingw* | pw32*)
- case $GCC,$host_os in
- yes,cygwin*)
- shlibext=dll.a
- ;;
- yes,mingw*)
- shlibext=dll
- sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | sed -e "s/^libraries://" -e "s/;/ /g"`
- ;;
- yes,pw32*)
- shlibext=dll
- ;;
- *)
- shlibext=dll
- ;;
- esac
- ;;
- darwin* | rhapsody*)
- shlibext=dylib
- ;;
- freebsd1*)
- ;;
- freebsd*)
- shlibext=so
- ;;
- gnu*)
- shlibext=so
- ;;
- hpux9* | hpux10* | hpux11*)
- shlibext=sl
- ;;
- irix5* | irix6*)
- shlibext=so
- case "$host_os" in
- irix5*)
- libsuff= shlibsuff=
- ;;
- *)
- case $LD in
- *-32|*"-32 ") libsuff= shlibsuff= ;;
- *-n32|*"-n32 ") libsuff=32 shlibsuff=N32 ;;
- *-64|*"-64 ") libsuff=64 shlibsuff=64 ;;
- *) libsuff= shlibsuff= ;;
- esac
- ;;
- esac
- sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
- sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
- ;;
- linux-gnuoldld* | linux-gnuaout* | linux-gnucoff*)
- ;;
- linux-gnu*)
- shlibext=so
- ;;
- netbsd*)
- shlibext=so
- ;;
- newsos6)
- shlibext=so
- ;;
- openbsd*)
- shlibext=so
- ;;
- os2*)
- libname_spec='$name'
- shlibext=dll
- ;;
- osf3* | osf4* | osf5*)
- shlibext=so
- sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
- sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
- ;;
- sco3.2v5*)
- shlibext=so
- ;;
- solaris*)
- shlibext=so
- ;;
- sunos4*)
- shlibext=so
- ;;
- sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
- shlibext=so
- case "$host_vendor" in
- motorola)
- sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
- ;;
- esac
- ;;
- uts4*)
- shlibext=so
- ;;
- dgux*)
- shlibext=so
- ;;
- sysv4*MP*)
- if test -d /usr/nec; then
- shlibext=so
- fi
- ;;
-esac
-
-sed_quote_subst='s/\(["`$\\]\)/\\\1/g'
-escaped_wl=`echo "X$wl" | sed -e 's/^X//' -e "$sed_quote_subst"`
-escaped_hardcode_libdir_flag_spec=`echo "X$hardcode_libdir_flag_spec" | sed -e 's/^X//' -e "$sed_quote_subst"`
-escaped_sys_lib_search_path_spec=`echo "X$sys_lib_search_path_spec" | sed -e 's/^X//' -e "$sed_quote_subst"`
-escaped_sys_lib_dlsearch_path_spec=`echo "X$sys_lib_dlsearch_path_spec" | sed -e 's/^X//' -e "$sed_quote_subst"`
-
-sed -e 's/^\([a-zA-Z0-9_]*\)=/acl_cv_\1=/' <<EOF
-
-# How to pass a linker flag through the compiler.
-wl="$escaped_wl"
-
-# Static library suffix (normally "a").
-libext="$libext"
-
-# Shared library suffix (normally "so").
-shlibext="$shlibext"
-
-# Flag to hardcode \$libdir into a binary during linking.
-# This must work even if \$libdir does not exist.
-hardcode_libdir_flag_spec="$escaped_hardcode_libdir_flag_spec"
-
-# Whether we need a single -rpath flag with a separated argument.
-hardcode_libdir_separator="$hardcode_libdir_separator"
-
-# Set to yes if using DIR/libNAME.so during linking hardcodes DIR into the
-# resulting binary.
-hardcode_direct="$hardcode_direct"
-
-# Set to yes if using the -LDIR flag during linking hardcodes DIR into the
-# resulting binary.
-hardcode_minus_L="$hardcode_minus_L"
-
-# Compile-time system search path for libraries
-sys_lib_search_path_spec="$escaped_sys_lib_search_path_spec"
-
-# Run-time system search path for libraries
-sys_lib_dlsearch_path_spec="$escaped_sys_lib_dlsearch_path_spec"
-
-EOF
diff --git a/config.sub b/config.sub
index 320e303..707e9e2 100755
--- a/config.sub
+++ b/config.sub
@@ -1,38 +1,33 @@
#! /bin/sh
# Configuration validation subroutine script.
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-# Free Software Foundation, Inc.
+# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+# 2011, 2012, 2013 Free Software Foundation, Inc.
-timestamp='2010-09-11'
+timestamp='2013-01-11'
-# This file is (in principle) common to ALL GNU software.
-# The presence of a machine in this file suggests that SOME GNU software
-# can handle that machine. It does not imply ALL GNU software can.
-#
-# This file 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 2 of the License, or
+# This file 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.
+# 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, write to the Free Software
-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
-# 02110-1301, USA.
+# along with this program; if not, see <http://www.gnu.org/licenses/>.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
+# the same distribution terms that you use for the rest of that
+# program. This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
-# Please send patches to <config-patches at gnu.org>. Submit a context
-# diff and a properly formatted GNU ChangeLog entry.
+# Please send patches with a ChangeLog entry to config-patches at gnu.org.
#
# Configuration subroutine to validate and canonicalize a configuration type.
# Supply the specified configuration type as an argument.
@@ -76,8 +71,8 @@ version="\
GNU config.sub ($timestamp)
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free
-Software Foundation, Inc.
+2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011,
+2012, 2013 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
@@ -125,13 +120,17 @@ esac
maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
case $maybe_os in
nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \
- linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
+ linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
knetbsd*-gnu* | netbsd*-gnu* | \
kopensolaris*-gnu* | \
storm-chaos* | os2-emx* | rtmk-nova*)
os=-$maybe_os
basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
;;
+ android-linux)
+ os=-linux-android
+ basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown
+ ;;
*)
basic_machine=`echo $1 | sed 's/-[^-]*$//'`
if [ $basic_machine != $1 ]
@@ -154,12 +153,12 @@ case $os in
-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
- -apple | -axis | -knuth | -cray | -microblaze)
+ -apple | -axis | -knuth | -cray | -microblaze*)
os=
basic_machine=$1
;;
- -bluegene*)
- os=-cnk
+ -bluegene*)
+ os=-cnk
;;
-sim | -cisco | -oki | -wec | -winbond)
os=
@@ -175,10 +174,10 @@ case $os in
os=-chorusos
basic_machine=$1
;;
- -chorusrdb)
- os=-chorusrdb
+ -chorusrdb)
+ os=-chorusrdb
basic_machine=$1
- ;;
+ ;;
-hiux*)
os=-hiuxwe2
;;
@@ -223,6 +222,12 @@ case $os in
-isc*)
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
+ -lynx*178)
+ os=-lynxos178
+ ;;
+ -lynx*5)
+ os=-lynxos5
+ ;;
-lynx*)
os=-lynxos
;;
@@ -247,20 +252,27 @@ case $basic_machine in
# Some are omitted here because they have special meanings below.
1750a | 580 \
| a29k \
+ | aarch64 | aarch64_be \
| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
| am33_2.0 \
- | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \
+ | arc \
+ | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \
+ | avr | avr32 \
+ | be32 | be64 \
| bfin \
| c4x | clipper \
| d10v | d30v | dlx | dsp16xx \
+ | epiphany \
| fido | fr30 | frv \
| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+ | hexagon \
| i370 | i860 | i960 | ia64 \
| ip2k | iq2000 \
+ | le32 | le64 \
| lm32 \
| m32c | m32r | m32rle | m68000 | m68k | m88k \
- | maxq | mb | microblaze | mcore | mep | metag \
+ | maxq | mb | microblaze | microblazeel | mcore | mep | metag \
| mips | mipsbe | mipseb | mipsel | mipsle \
| mips16 \
| mips64 | mips64el \
@@ -278,6 +290,7 @@ case $basic_machine in
| mipsisa64r2 | mipsisa64r2el \
| mipsisa64sb1 | mipsisa64sb1el \
| mipsisa64sr71k | mipsisa64sr71kel \
+ | mipsr5900 | mipsr5900el \
| mipstx39 | mipstx39el \
| mn10200 | mn10300 \
| moxie \
@@ -286,22 +299,23 @@ case $basic_machine in
| nds32 | nds32le | nds32be \
| nios | nios2 \
| ns16k | ns32k \
+ | open8 \
| or32 \
| pdp10 | pdp11 | pj | pjl \
- | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
+ | powerpc | powerpc64 | powerpc64le | powerpcle \
| pyramid \
- | rx \
+ | rl78 | rx \
| score \
| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
| sh64 | sh64le \
| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
- | spu | strongarm \
- | tahoe | thumb | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
+ | spu \
+ | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
| ubicom32 \
- | v850 | v850e \
+ | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
| we32k \
- | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \
+ | x86 | xc16x | xstormy16 | xtensa \
| z8k | z80)
basic_machine=$basic_machine-unknown
;;
@@ -314,8 +328,7 @@ case $basic_machine in
c6x)
basic_machine=tic6x-unknown
;;
- m6811 | m68hc11 | m6812 | m68hc12 | picochip)
- # Motorola 68HC11/12.
+ m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip)
basic_machine=$basic_machine-unknown
os=-none
;;
@@ -325,6 +338,21 @@ case $basic_machine in
basic_machine=mt-unknown
;;
+ strongarm | thumb | xscale)
+ basic_machine=arm-unknown
+ ;;
+ xgate)
+ basic_machine=$basic_machine-unknown
+ os=-none
+ ;;
+ xscaleeb)
+ basic_machine=armeb-unknown
+ ;;
+
+ xscaleel)
+ basic_machine=armel-unknown
+ ;;
+
# We use `pc' rather than `unknown'
# because (1) that's what they normally are, and
# (2) the word "unknown" tends to confuse beginning users.
@@ -339,11 +367,13 @@ case $basic_machine in
# Recognize the basic CPU types with company name.
580-* \
| a29k-* \
+ | aarch64-* | aarch64_be-* \
| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
| alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
| arm-* | armbe-* | armle-* | armeb-* | armv*-* \
| avr-* | avr32-* \
+ | be32-* | be64-* \
| bfin-* | bs2000-* \
| c[123]* | c30-* | [cjt]90-* | c4x-* \
| clipper-* | craynv-* | cydra-* \
@@ -352,12 +382,15 @@ case $basic_machine in
| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
| h8300-* | h8500-* \
| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+ | hexagon-* \
| i*86-* | i860-* | i960-* | ia64-* \
| ip2k-* | iq2000-* \
+ | le32-* | le64-* \
| lm32-* \
| m32c-* | m32r-* | m32rle-* \
| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
- | m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \
+ | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
+ | microblaze-* | microblazeel-* \
| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
| mips16-* \
| mips64-* | mips64el-* \
@@ -375,6 +408,7 @@ case $basic_machine in
| mipsisa64r2-* | mipsisa64r2el-* \
| mipsisa64sb1-* | mipsisa64sb1el-* \
| mipsisa64sr71k-* | mipsisa64sr71kel-* \
+ | mipsr5900-* | mipsr5900el-* \
| mipstx39-* | mipstx39el-* \
| mmix-* \
| mt-* \
@@ -382,24 +416,26 @@ case $basic_machine in
| nds32-* | nds32le-* | nds32be-* \
| nios-* | nios2-* \
| none-* | np1-* | ns16k-* | ns32k-* \
+ | open8-* \
| orion-* \
| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
- | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
+ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
| pyramid-* \
- | romp-* | rs6000-* | rx-* \
+ | rl78-* | romp-* | rs6000-* | rx-* \
| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
| sparclite-* \
- | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \
- | tahoe-* | thumb-* \
+ | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \
+ | tahoe-* \
| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
- | tile-* | tilegx-* \
+ | tile*-* \
| tron-* \
| ubicom32-* \
- | v850-* | v850e-* | vax-* \
+ | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
+ | vax-* \
| we32k-* \
- | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \
+ | x86-* | x86_64-* | xc16x-* | xps100-* \
| xstormy16-* | xtensa*-* \
| ymp-* \
| z8k-* | z80-*)
@@ -424,7 +460,7 @@ case $basic_machine in
basic_machine=a29k-amd
os=-udi
;;
- abacus)
+ abacus)
basic_machine=abacus-unknown
;;
adobe68k)
@@ -507,7 +543,7 @@ case $basic_machine in
basic_machine=c90-cray
os=-unicos
;;
- cegcc)
+ cegcc)
basic_machine=arm-unknown
os=-cegcc
;;
@@ -539,7 +575,7 @@ case $basic_machine in
basic_machine=craynv-cray
os=-unicosmp
;;
- cr16)
+ cr16 | cr16-*)
basic_machine=cr16-unknown
os=-elf
;;
@@ -697,7 +733,6 @@ case $basic_machine in
i370-ibm* | ibm*)
basic_machine=i370-ibm
;;
-# I'm not sure what "Sysv32" means. Should this be sysv3.2?
i*86v32)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-sysv32
@@ -755,9 +790,13 @@ case $basic_machine in
basic_machine=ns32k-utek
os=-sysv
;;
- microblaze)
+ microblaze*)
basic_machine=microblaze-xilinx
;;
+ mingw64)
+ basic_machine=x86_64-pc
+ os=-mingw64
+ ;;
mingw32)
basic_machine=i386-pc
os=-mingw32
@@ -794,10 +833,18 @@ case $basic_machine in
ms1-*)
basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`
;;
+ msys)
+ basic_machine=i386-pc
+ os=-msys
+ ;;
mvs)
basic_machine=i370-ibm
os=-mvs
;;
+ nacl)
+ basic_machine=le32-unknown
+ os=-nacl
+ ;;
ncr3000)
basic_machine=i486-ncr
os=-sysv4
@@ -862,10 +909,10 @@ case $basic_machine in
np1)
basic_machine=np1-gould
;;
- neo-tandem)
+ neo-tandem)
basic_machine=neo-tandem
;;
- nse-tandem)
+ nse-tandem)
basic_machine=nse-tandem
;;
nsr-tandem)
@@ -950,9 +997,10 @@ case $basic_machine in
;;
power) basic_machine=power-ibm
;;
- ppc) basic_machine=powerpc-unknown
+ ppc | ppcbe) basic_machine=powerpc-unknown
;;
- ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ppc-* | ppcbe-*)
+ basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ppcle | powerpclittle | ppc-le | powerpc-little)
basic_machine=powerpcle-unknown
@@ -977,7 +1025,11 @@ case $basic_machine in
basic_machine=i586-unknown
os=-pw32
;;
- rdos)
+ rdos | rdos64)
+ basic_machine=x86_64-pc
+ os=-rdos
+ ;;
+ rdos32)
basic_machine=i386-pc
os=-rdos
;;
@@ -1046,6 +1098,9 @@ case $basic_machine in
basic_machine=i860-stratus
os=-sysv4
;;
+ strongarm-* | thumb-*)
+ basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
sun2)
basic_machine=m68000-sun
;;
@@ -1102,13 +1157,8 @@ case $basic_machine in
basic_machine=t90-cray
os=-unicos
;;
- # This must be matched before tile*.
- tilegx*)
- basic_machine=tilegx-unknown
- os=-linux-gnu
- ;;
tile*)
- basic_machine=tile-unknown
+ basic_machine=$basic_machine-unknown
os=-linux-gnu
;;
tx39)
@@ -1178,6 +1228,9 @@ case $basic_machine in
xps | xps100)
basic_machine=xps100-honeywell
;;
+ xscale-* | xscalee[bl]-*)
+ basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'`
+ ;;
ymp)
basic_machine=ymp-cray
os=-unicos
@@ -1275,11 +1328,11 @@ esac
if [ x"$os" != x"" ]
then
case $os in
- # First match some system type aliases
- # that might get confused with valid system types.
+ # First match some system type aliases
+ # that might get confused with valid system types.
# -solaris* is a basic system type, with this one exception.
- -auroraux)
- os=-auroraux
+ -auroraux)
+ os=-auroraux
;;
-solaris1 | -solaris1.*)
os=`echo $os | sed -e 's|solaris1|sunos4|'`
@@ -1303,21 +1356,21 @@ case $os in
-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
| -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
| -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
- | -sym* | -kopensolaris* \
+ | -sym* | -kopensolaris* | -plan9* \
| -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
| -aos* | -aros* \
| -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
| -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
| -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \
- | -openbsd* | -solidbsd* \
+ | -bitrig* | -openbsd* | -solidbsd* \
| -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
| -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
| -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
| -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
| -chorusos* | -chorusrdb* | -cegcc* \
- | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
- | -mingw32* | -linux-gnu* | -linux-android* \
- | -linux-newlib* | -linux-uclibc* \
+ | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+ | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \
+ | -linux-newlib* | -linux-musl* | -linux-uclibc* \
| -uxpv* | -beos* | -mpeix* | -udk* \
| -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
| -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
@@ -1364,7 +1417,7 @@ case $os in
-opened*)
os=-openedition
;;
- -os400*)
+ -os400*)
os=-os400
;;
-wince*)
@@ -1413,7 +1466,7 @@ case $os in
-sinix*)
os=-sysv4
;;
- -tpf*)
+ -tpf*)
os=-tpf
;;
-triton*)
@@ -1449,17 +1502,14 @@ case $os in
-aros*)
os=-aros
;;
- -kaos*)
- os=-kaos
- ;;
-zvmoe)
os=-zvmoe
;;
-dicos*)
os=-dicos
;;
- -nacl*)
- ;;
+ -nacl*)
+ ;;
-none)
;;
*)
@@ -1482,10 +1532,10 @@ else
# system, and we'll never get to this point.
case $basic_machine in
- score-*)
+ score-*)
os=-elf
;;
- spu-*)
+ spu-*)
os=-elf
;;
*-acorn)
@@ -1497,8 +1547,11 @@ case $basic_machine in
arm*-semi)
os=-aout
;;
- c4x-* | tic4x-*)
- os=-coff
+ c4x-* | tic4x-*)
+ os=-coff
+ ;;
+ hexagon-*)
+ os=-elf
;;
tic54x-*)
os=-coff
@@ -1527,14 +1580,11 @@ case $basic_machine in
;;
m68000-sun)
os=-sunos3
- # This also exists in the configure program, but was not the
- # default.
- # os=-sunos4
;;
m68*-cisco)
os=-aout
;;
- mep-*)
+ mep-*)
os=-elf
;;
mips*-cisco)
@@ -1561,7 +1611,7 @@ case $basic_machine in
*-ibm)
os=-aix
;;
- *-knuth)
+ *-knuth)
os=-mmixware
;;
*-wec)
diff --git a/configure b/configure
index 97bf059..195c06b 100755
--- a/configure
+++ b/configure
@@ -1,13 +1,11 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.68 for snd 12.0.
+# Generated by GNU Autoconf 2.69 for snd 16.1.
#
# Report bugs to <bil at ccrma.stanford.edu>.
#
#
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software
-# Foundation, Inc.
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
@@ -136,6 +134,31 @@ export LANGUAGE
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+# Use a proper internal environment variable to ensure we don't fall
+ # into an infinite loop, continuously re-executing ourselves.
+ if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+ _as_can_reexec=no; export _as_can_reexec;
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+ fi
+ # We don't want this to propagate to other subprocesses.
+ { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
@@ -169,7 +192,8 @@ if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
else
exitcode=1; echo positional parameters were not saved.
fi
-test x\$exitcode = x0 || exit 1"
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
@@ -214,21 +238,25 @@ IFS=$as_save_IFS
if test "x$CONFIG_SHELL" != x; then :
- # We cannot yet assume a decent shell, so we have to provide a
- # neutralization value for shells without unset; and this also
- # works around shells that cannot unset nonexistent variables.
- # Preserve -v and -x to the replacement shell.
- BASH_ENV=/dev/null
- ENV=/dev/null
- (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
- export CONFIG_SHELL
- case $- in # ((((
- *v*x* | *x*v* ) as_opts=-vx ;;
- *v* ) as_opts=-v ;;
- *x* ) as_opts=-x ;;
- * ) as_opts= ;;
- esac
- exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"}
+ export CONFIG_SHELL
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
fi
if test x$as_have_required = xno; then :
@@ -331,6 +359,14 @@ $as_echo X"$as_dir" |
} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
@@ -452,6 +488,10 @@ as_cr_alnum=$as_cr_Letters$as_cr_digits
chmod +x "$as_me.lineno" ||
{ $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+ # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+ # already done that, so ensure we don't try to do so again and fall
+ # in an infinite loop. This has already happened in practice.
+ _as_can_reexec=no; export _as_can_reexec
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
# original and so on. Autoconf is especially sensitive to this).
@@ -486,16 +526,16 @@ if (echo >conf$$.file) 2>/dev/null; then
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
+ # In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
@@ -507,28 +547,8 @@ else
as_mkdir_p=false
fi
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -559,9 +579,9 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='snd'
-PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-12.tar.gz'
-PACKAGE_VERSION='12.0'
-PACKAGE_STRING='snd 12.0'
+PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz'
+PACKAGE_VERSION='16.1'
+PACKAGE_STRING='snd 16.1'
PACKAGE_BUGREPORT='bil at ccrma.stanford.edu'
PACKAGE_URL=''
@@ -606,13 +626,16 @@ ac_subst_vars='LTLIBOBJS
LIBOBJS
MAKE_TARGET
ORIGINAL_LDFLAGS
-SNDLIB_LIB
-SNDLIB_FILES
-SNDLIB_CONFIG
+INSTALL
+SO_LD
+SO_FLAGS
+LDSO_FLAGS
+JACK_FLAGS
+JACK_LIBS
+AUDIO_LIB
PATH_WVUNPACK
PATH_WAVPACK
PATH_TTA
-PATH_SHORTEN
PATH_TIMIDITY
PATH_FLAC
PATH_SPEEXENC
@@ -621,39 +644,21 @@ PATH_MPG321
PATH_MPG123
PATH_OGGENC
PATH_OGGDEC
-SO_LD
-SO_FLAGS
-LDSO_FLAGS
-JACK_FLAGS
-JACK_LIBS
-AUDIO_LIB
-S7_LIB
-FTH
-FTH_HAVE_RATIO
-FTH_HAVE_COMPLEX
-FTH_LIBS
-FTH_CFLAGS
-FTH_VERSION
XEN_CFLAGS
XEN_LIBS
-RUBY
-RUBY_LIBS
-RUBY_CFLAGS
-RUBY_SEARCH_PATH
-RUBY_RELEASE_DATE
-RUBY_VERSION
-FAM_LIB
+S7_LIB
+FTH
GL_FLAGS
GL_FILES
GL_LIBS
-GX_HEADERS
-GX_FILES
-CAIRO_CFLAGS
GTK_LD_LIBS
-GTK_LIBS
GTK_CFLAGS
+GTK_LIBS
+GX_HEADERS
+GX_FILES
XFLAGS
XLIBS
+CAIRO_CFLAGS
X_EXTRA_LIBS
X_LIBS
X_PRE_LIBS
@@ -661,20 +666,16 @@ X_CFLAGS
XMKMF
GSL_CFLAGS
GSL_LIBS
-GSL_CONFIG
GMP_LIBS
FFTW_CFLAGS
FFTW_LIBS
PKG_CONFIG
-FGREP
-SND_VERSION
-SND_PACKAGE
-INSTALL_DATA
-INSTALL_SCRIPT
-INSTALL_PROGRAM
EGREP
GREP
CPP
+INSTALL_DATA
+INSTALL_SCRIPT
+INSTALL_PROGRAM
OBJEXT
EXEEXT
ac_ct_CC
@@ -731,53 +732,31 @@ SHELL'
ac_subst_files=''
ac_user_opts='
enable_option_checking
-with_esd
-with_alsa
-with_oss
-with_jack
-with_static_alsa
with_gtk
-with_no_gui
-with_static_xm
-with_static_xg
+with_gui
with_gl
-with_just_gl
with_gl2ps
with_motif
-with_static_motif
with_editres
+with_alsa
+with_oss
+with_jack
with_ladspa
-with_doubles
-with_float_samples
with_pulseaudio
with_portaudio
-with_profiling
+with_extension_language
+with_s7
+with_forth
+with_ruby
with_gsl
with_fftw
-with_fam
with_gmp
-with_s7
-with_extension_language
-with_directfb
with_audio
-with_sample_width
-with_motif_prefix
with_temp_dir
with_save_dir
with_doc_dir
-with_snd_as_widget
-with_threads
-enable_threads
-enable_largefile
-with_gnu_ld
-with_x
-enable_readline
-with_ruby_prefix
-with_ruby
-with_forth
-enable_snd_debug
-with_shared_sndlib
enable_deprecated
+with_x
'
ac_precious_vars='build_alias
host_alias
@@ -1244,8 +1223,6 @@ target=$target_alias
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
- $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.
- If a cross compiler is detected then cross compile mode will be used" >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
fi
@@ -1331,7 +1308,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures snd 12.0 to adapt to many kinds of systems.
+\`configure' configures snd 16.1 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1380,7 +1357,7 @@ Fine tuning of the installation directories:
--localedir=DIR locale-dependent data [DATAROOTDIR/locale]
--mandir=DIR man documentation [DATAROOTDIR/man]
--docdir=DIR documentation root
- [DATAROOTDIR/doc/ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-12.tar.gz]
+ [DATAROOTDIR/doc/ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz]
--htmldir=DIR html documentation [DOCDIR]
--dvidir=DIR dvi documentation [DOCDIR]
--pdfdir=DIR pdf documentation [DOCDIR]
@@ -1401,7 +1378,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of snd 12.0:";;
+ short | recursive ) echo "Configuration of snd 16.1:";;
esac
cat <<\_ACEOF
@@ -1409,57 +1386,35 @@ Optional Features:
--disable-option-checking ignore unrecognized --enable/--with options
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --enable-threads include pthread support, same as --with-threads
- --disable-largefile omit support for large files
- --enable-readline include readline (the default)
- --enable-snd-debug include internal Snd debugging functions
--disable-deprecated do not include any deprecated stuff from gtk, s7, motif, clm, snd, or sndlib
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --with-esd use ESD
- --with-alsa use ALSA
- --with-oss use OSS
- --with-jack use JACK
- --with-static-alsa use ALSA statically loaded
--with-gtk use Gtk+ to build Snd
- --with-no-gui make Snd without any graphics support
- --with-static-xm include the xm module
- --with-static-xg include the xg module
+ --with-gui make Snd with graphics support
--with-gl include OpenGL support, Motif only
- --with-just-gl include OpenGL support, but omit the extension language bindings, Motif only
--with-gl2ps include gl2ps, Motif only
--with-motif use libXm to build Snd
- --with-static-motif use libXm.a to build Snd
--with-editres include editres in xm
+ --with-alsa use ALSA
+ --with-oss use OSS
+ --with-jack use JACK
--with-ladspa include support for LADSPA plugins, Linux only
- --with-doubles use doubles throughout
- --with-float-samples use floats (or doubles) as the internal sample respresentation, default=yes
- --with-pulseaudio use PulseAudio, default=no
- --with-portaudio use portaudio, default=no
- --with-profiling add code to keep profiling stats (s7 only)
+ --with-pulseaudio use PulseAudio, default=no
+ --with-portaudio use portaudio, default=no
+ --with-extension-language use some extension language, default=yes
+ --with-s7 use S7, default=yes
+ --with-forth use Forth as the extension language
+ --with-ruby use Ruby as the extension language
--with-gsl use GSL, default=yes
--with-fftw use fftw, default=yes
- --with-fam use libfam (Gamin), default=yes
--with-gmp include multiprecision arithmetic via gmp, mpfr, and mpc, default=no
- --with-s7 use S7, default=yes
- --with-extension-language use some extension language, default=yes
- --with-directfb use directfb config scripts, rather than gtk, default=no
- --without-audio don't include any audio functionality
- --with-sample-width=N use N bits of samples
- --with-motif-prefix=PFX where Motif is installed
+ --without-audio don't include any audio functionality
--with-temp-dir directory to use for temp files
--with-save-dir directory to use for saved-state files
--with-doc-dir directory to search for documentation
- --with-snd-as-widget make Snd a loadable widget, not a standalone program
- --with-threads include pthread support, same as --enable-threads
- --with-gnu-ld assume the C compiler uses GNU ld default=no
--with-x use the X Window System
- --with-ruby-prefix=PFX where Ruby is installed
- --with-ruby use Ruby as the extension language
- --with-forth use Forth as the extension language
- --with-shared-sndlib try to load libsndlib.so
Some influential environment variables:
CC C compiler command
@@ -1538,10 +1493,10 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-snd configure 12.0
-generated by GNU Autoconf 2.68
+snd configure 16.1
+generated by GNU Autoconf 2.69
-Copyright (C) 2010 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
@@ -1590,43 +1545,6 @@ fi
} # ac_fn_c_try_compile
-# ac_fn_c_try_cpp LINENO
-# ----------------------
-# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
-ac_fn_c_try_cpp ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- if { { ac_try="$ac_cpp conftest.$ac_ext"
-case "(($ac_try" in
- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
- *) ac_try_echo=$ac_try;;
-esac
-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
-$as_echo "$ac_try_echo"; } >&5
- (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
- ac_status=$?
- if test -s conftest.err; then
- grep -v '^ *+' conftest.err >conftest.er1
- cat conftest.er1 >&5
- mv -f conftest.er1 conftest.err
- fi
- $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
- test $ac_status = 0; } > conftest.i && {
- test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
- test ! -s conftest.err
- }; then :
- ac_retval=0
-else
- $as_echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_retval=1
-fi
- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
- as_fn_set_status $ac_retval
-
-} # ac_fn_c_try_cpp
-
# ac_fn_c_try_run LINENO
# ----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
@@ -1669,21 +1587,20 @@ fi
} # ac_fn_c_try_run
-# ac_fn_c_try_link LINENO
-# -----------------------
-# Try to link conftest.$ac_ext, and return whether this succeeded.
-ac_fn_c_try_link ()
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- rm -f conftest.$ac_objext conftest$ac_exeext
- if { { ac_try="$ac_link"
+ if { { ac_try="$ac_cpp conftest.$ac_ext"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
- (eval "$ac_link") 2>conftest.err
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
ac_status=$?
if test -s conftest.err; then
grep -v '^ *+' conftest.err >conftest.er1
@@ -1691,120 +1608,21 @@ $as_echo "$ac_try_echo"; } >&5
mv -f conftest.er1 conftest.err
fi
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
- test $ac_status = 0; } && {
- test -z "$ac_c_werror_flag" ||
+ test $ac_status = 0; } > conftest.i && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
test ! -s conftest.err
- } && test -s conftest$ac_exeext && {
- test "$cross_compiling" = yes ||
- $as_test_x conftest$ac_exeext
}; then :
ac_retval=0
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
- ac_retval=1
+ ac_retval=1
fi
- # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
- # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
- # interfere with the next link command; also delete a directory that is
- # left behind by Apple's compiler. We do this before executing the actions.
- rm -rf conftest.dSYM conftest_ipa8_conftest.oo
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
as_fn_set_status $ac_retval
-} # ac_fn_c_try_link
-
-# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES
-# -------------------------------------------------------
-# Tests whether HEADER exists, giving a warning if it cannot be compiled using
-# the include files in INCLUDES and setting the cache variable VAR
-# accordingly.
-ac_fn_c_check_header_mongrel ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- if eval \${$3+:} false; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
-$as_echo_n "checking for $2... " >&6; }
-if eval \${$3+:} false; then :
- $as_echo_n "(cached) " >&6
-fi
-eval ac_res=\$$3
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
-else
- # Is the header compilable?
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
-$as_echo_n "checking $2 usability... " >&6; }
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-#include <$2>
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_header_compiler=yes
-else
- ac_header_compiler=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
-$as_echo "$ac_header_compiler" >&6; }
-
-# Is the header present?
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
-$as_echo_n "checking $2 presence... " >&6; }
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <$2>
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- ac_header_preproc=yes
-else
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.i conftest.$ac_ext
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
-$as_echo "$ac_header_preproc" >&6; }
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
- yes:no: )
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
-$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
-$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
- ;;
- no:yes:* )
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
-$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5
-$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;}
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
-$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5
-$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;}
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
-$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
-( $as_echo "## ------------------------------------- ##
-## Report this to bil at ccrma.stanford.edu ##
-## ------------------------------------- ##"
- ) | sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
-$as_echo_n "checking for $2... " >&6; }
-if eval \${$3+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- eval "$3=\$ac_header_compiler"
-fi
-eval ac_res=\$$3
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
-fi
- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
-
-} # ac_fn_c_check_header_mongrel
+} # ac_fn_c_try_cpp
# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
@@ -1837,270 +1655,100 @@ $as_echo "$ac_res" >&6; }
} # ac_fn_c_check_header_compile
-# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES
-# ---------------------------------------------
-# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
-# accordingly.
-ac_fn_c_check_decl ()
+# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES
+# --------------------------------------------
+# Tries to find the compile-time value of EXPR in a program that includes
+# INCLUDES, setting VAR accordingly. Returns whether the value could be
+# computed
+ac_fn_c_compute_int ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- as_decl_name=`echo $2|sed 's/ *(.*//'`
- as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
-$as_echo_n "checking whether $as_decl_name is declared... " >&6; }
-if eval \${$3+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ if test "$cross_compiling" = yes; then
+ # Depending upon the size, compute the lo and hi bounds.
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$4
int
main ()
{
-#ifndef $as_decl_name
-#ifdef __cplusplus
- (void) $as_decl_use;
-#else
- (void) $as_decl_name;
-#endif
-#endif
+static int test_array [1 - 2 * !(($2) >= 0)];
+test_array [0] = 0;
+return test_array [0];
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- eval "$3=yes"
+ ac_lo=0 ac_mid=0
+ while :; do
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+static int test_array [1 - 2 * !(($2) <= $ac_mid)];
+test_array [0] = 0;
+return test_array [0];
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_hi=$ac_mid; break
else
- eval "$3=no"
+ as_fn_arith $ac_mid + 1 && ac_lo=$as_val
+ if test $ac_lo -le $ac_mid; then
+ ac_lo= ac_hi=
+ break
+ fi
+ as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-eval ac_res=\$$3
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
-
-} # ac_fn_c_check_decl
-
-# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
-# -------------------------------------------
-# Tests whether TYPE exists after having included INCLUDES, setting cache
-# variable VAR accordingly.
-ac_fn_c_check_type ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
-$as_echo_n "checking for $2... " >&6; }
-if eval \${$3+:} false; then :
- $as_echo_n "(cached) " >&6
+ done
else
- eval "$3=no"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$4
int
main ()
{
-if (sizeof ($2))
- return 0;
+static int test_array [1 - 2 * !(($2) < 0)];
+test_array [0] = 0;
+return test_array [0];
+
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_hi=-1 ac_mid=-1
+ while :; do
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$4
int
main ()
{
-if (sizeof (($2)))
- return 0;
+static int test_array [1 - 2 * !(($2) >= $ac_mid)];
+test_array [0] = 0;
+return test_array [0];
+
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
-
+ ac_lo=$ac_mid; break
else
- eval "$3=yes"
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-eval ac_res=\$$3
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
-
-} # ac_fn_c_check_type
-
-# ac_fn_c_find_intX_t LINENO BITS VAR
-# -----------------------------------
-# Finds a signed integer type with width BITS, setting cache variable VAR
-# accordingly.
-ac_fn_c_find_intX_t ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for int$2_t" >&5
-$as_echo_n "checking for int$2_t... " >&6; }
-if eval \${$3+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- eval "$3=no"
- # Order is important - never check a type that is potentially smaller
- # than half of the expected target width.
- for ac_type in int$2_t 'int' 'long int' \
- 'long long int' 'short int' 'signed char'; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
- enum { N = $2 / 2 - 1 };
-int
-main ()
-{
-static int test_array [1 - 2 * !(0 < ($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 1))];
-test_array [0] = 0
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
- enum { N = $2 / 2 - 1 };
-int
-main ()
-{
-static int test_array [1 - 2 * !(($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 1)
- < ($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 2))];
-test_array [0] = 0
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
-
-else
- case $ac_type in #(
- int$2_t) :
- eval "$3=yes" ;; #(
- *) :
- eval "$3=\$ac_type" ;;
-esac
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if eval test \"x\$"$3"\" = x"no"; then :
-
-else
- break
-fi
- done
-fi
-eval ac_res=\$$3
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
-
-} # ac_fn_c_find_intX_t
-
-# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES
-# --------------------------------------------
-# Tries to find the compile-time value of EXPR in a program that includes
-# INCLUDES, setting VAR accordingly. Returns whether the value could be
-# computed
-ac_fn_c_compute_int ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- if test "$cross_compiling" = yes; then
- # Depending upon the size, compute the lo and hi bounds.
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main ()
-{
-static int test_array [1 - 2 * !(($2) >= 0)];
-test_array [0] = 0
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_lo=0 ac_mid=0
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main ()
-{
-static int test_array [1 - 2 * !(($2) <= $ac_mid)];
-test_array [0] = 0
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_hi=$ac_mid; break
-else
- as_fn_arith $ac_mid + 1 && ac_lo=$as_val
- if test $ac_lo -le $ac_mid; then
- ac_lo= ac_hi=
- break
- fi
- as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- done
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main ()
-{
-static int test_array [1 - 2 * !(($2) < 0)];
-test_array [0] = 0
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_hi=-1 ac_mid=-1
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main ()
-{
-static int test_array [1 - 2 * !(($2) >= $ac_mid)];
-test_array [0] = 0
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_lo=$ac_mid; break
-else
- as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val
- if test $ac_mid -le $ac_hi; then
- ac_lo= ac_hi=
- break
- fi
- as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val
+ as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val
+ if test $ac_mid -le $ac_hi; then
+ ac_lo= ac_hi=
+ break
+ fi
+ as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
done
@@ -2120,7 +1768,8 @@ int
main ()
{
static int test_array [1 - 2 * !(($2) <= $ac_mid)];
-test_array [0] = 0
+test_array [0] = 0;
+return test_array [0];
;
return 0;
@@ -2189,6 +1838,52 @@ rm -f conftest.val
} # ac_fn_c_compute_int
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext conftest$ac_exeext
+ if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest$ac_exeext && {
+ test "$cross_compiling" = yes ||
+ test -x conftest$ac_exeext
+ }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+ # interfere with the next link command; also delete a directory that is
+ # left behind by Apple's compiler. We do this before executing the actions.
+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_link
+
# ac_fn_c_check_func LINENO FUNC VAR
# ----------------------------------
# Tests whether FUNC exists, setting the cache variable VAR accordingly
@@ -2259,8 +1954,8 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by snd $as_me 12.0, which was
-generated by GNU Autoconf 2.68. Invocation command line was
+It was created by snd $as_me 16.1, which was
+generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -2708,8 +2403,8 @@ host_os=$*
IFS=$ac_save_IFS
case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac
-
-ac_config_headers="$ac_config_headers mus-config.h sndlib.h"
+ # needed by case $host below
+ac_config_headers="$ac_config_headers mus-config.h"
ac_config_files="$ac_config_files makefile"
@@ -2735,7 +2430,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2775,7 +2470,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2828,7 +2523,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2869,7 +2564,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
@@ -2927,7 +2622,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2971,7 +2666,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -3417,8 +3112,7 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
+struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
@@ -3504,470 +3198,91 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
-$as_echo_n "checking how to run the C preprocessor... " >&6; }
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
- CPP=
-fi
-if test -z "$CPP"; then
- if ${ac_cv_prog_CPP+:} false; then :
+# AC_HEADER_STDC
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AmigaOS /C/install, which installs bootblocks on floppy discs
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# OS/2's system install, which has a completely different semantic
+# ./install, which can be erroneously created by make from ./install.sh.
+# Reject install programs that cannot install multiple files.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5
+$as_echo_n "checking for a BSD-compatible install... " >&6; }
+if test -z "$INSTALL"; then
+if ${ac_cv_path_install+:} false; then :
$as_echo_n "(cached) " >&6
else
- # Double quotes because CPP needs to be expanded
- for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
- do
- ac_preproc_ok=false
-for ac_c_preproc_warn_flag in '' yes
-do
- # Use a header file that comes with gcc, so configuring glibc
- # with a fresh cross-compiler works.
- # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- # <limits.h> exists even on freestanding compilers.
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp. "Syntax error" is here to catch this case.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
- Syntax error
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
-
-else
- # Broken: fails on valid input.
-continue
-fi
-rm -f conftest.err conftest.i conftest.$ac_ext
-
- # OK, works on sane cases. Now check whether nonexistent headers
- # can be detected and how.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <ac_nonexistent.h>
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- # Broken: success on invalid input.
-continue
-else
- # Passes both tests.
-ac_preproc_ok=:
-break
-fi
-rm -f conftest.err conftest.i conftest.$ac_ext
-
-done
-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.i conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then :
- break
-fi
-
- done
- ac_cv_prog_CPP=$CPP
-
-fi
- CPP=$ac_cv_prog_CPP
-else
- ac_cv_prog_CPP=$CPP
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
-$as_echo "$CPP" >&6; }
-ac_preproc_ok=false
-for ac_c_preproc_warn_flag in '' yes
-do
- # Use a header file that comes with gcc, so configuring glibc
- # with a fresh cross-compiler works.
- # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- # <limits.h> exists even on freestanding compilers.
- # On the NeXT, cc -E runs the code through the compiler's parser,
- # not just through cpp. "Syntax error" is here to catch this case.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
- Syntax error
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
-
-else
- # Broken: fails on valid input.
-continue
-fi
-rm -f conftest.err conftest.i conftest.$ac_ext
-
- # OK, works on sane cases. Now check whether nonexistent headers
- # can be detected and how.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <ac_nonexistent.h>
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- # Broken: success on invalid input.
-continue
-else
- # Passes both tests.
-ac_preproc_ok=:
-break
-fi
-rm -f conftest.err conftest.i conftest.$ac_ext
-
-done
-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.i conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then :
-
-else
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details" "$LINENO" 5; }
-fi
-
-ac_ext=c
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
-ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
-$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
-if ${ac_cv_path_GREP+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if test -z "$GREP"; then
- ac_path_GREP_found=false
- # Loop through the user's path and test for each of PROGNAME-LIST
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_prog in grep ggrep; do
- for ac_exec_ext in '' $ac_executable_extensions; do
- ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
- { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
-# Check for GNU ac_path_GREP and select it if it is found.
- # Check for GNU $ac_path_GREP
-case `"$ac_path_GREP" --version 2>&1` in
-*GNU*)
- ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
-*)
- ac_count=0
- $as_echo_n 0123456789 >"conftest.in"
- while :
- do
- cat "conftest.in" "conftest.in" >"conftest.tmp"
- mv "conftest.tmp" "conftest.in"
- cp "conftest.in" "conftest.nl"
- $as_echo 'GREP' >> "conftest.nl"
- "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
- diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
- as_fn_arith $ac_count + 1 && ac_count=$as_val
- if test $ac_count -gt ${ac_path_GREP_max-0}; then
- # Best one so far, save it but keep looking for a better one
- ac_cv_path_GREP="$ac_path_GREP"
- ac_path_GREP_max=$ac_count
- fi
- # 10*(2^10) chars as input seems more than enough
- test $ac_count -gt 10 && break
- done
- rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+ # Account for people who put trailing slashes in PATH elements.
+case $as_dir/ in #((
+ ./ | .// | /[cC]/* | \
+ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+ ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \
+ /usr/ucb/* ) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
+ if test $ac_prog = install &&
+ grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ elif test $ac_prog = install &&
+ grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # program-specific install script used by HP pwplus--don't use.
+ :
+ else
+ rm -rf conftest.one conftest.two conftest.dir
+ echo one > conftest.one
+ echo two > conftest.two
+ mkdir conftest.dir
+ if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" &&
+ test -s conftest.one && test -s conftest.two &&
+ test -s conftest.dir/conftest.one &&
+ test -s conftest.dir/conftest.two
+ then
+ ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+ break 3
+ fi
+ fi
+ fi
+ done
+ done
+ ;;
esac
- $ac_path_GREP_found && break 3
- done
- done
done
IFS=$as_save_IFS
- if test -z "$ac_cv_path_GREP"; then
- as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
- fi
-else
- ac_cv_path_GREP=$GREP
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
-$as_echo "$ac_cv_path_GREP" >&6; }
- GREP="$ac_cv_path_GREP"
+rm -rf conftest.one conftest.two conftest.dir
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
-$as_echo_n "checking for egrep... " >&6; }
-if ${ac_cv_path_EGREP+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
- then ac_cv_path_EGREP="$GREP -E"
- else
- if test -z "$EGREP"; then
- ac_path_EGREP_found=false
- # Loop through the user's path and test for each of PROGNAME-LIST
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_prog in egrep; do
- for ac_exec_ext in '' $ac_executable_extensions; do
- ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
- { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
-# Check for GNU ac_path_EGREP and select it if it is found.
- # Check for GNU $ac_path_EGREP
-case `"$ac_path_EGREP" --version 2>&1` in
-*GNU*)
- ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
-*)
- ac_count=0
- $as_echo_n 0123456789 >"conftest.in"
- while :
- do
- cat "conftest.in" "conftest.in" >"conftest.tmp"
- mv "conftest.tmp" "conftest.in"
- cp "conftest.in" "conftest.nl"
- $as_echo 'EGREP' >> "conftest.nl"
- "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
- diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
- as_fn_arith $ac_count + 1 && ac_count=$as_val
- if test $ac_count -gt ${ac_path_EGREP_max-0}; then
- # Best one so far, save it but keep looking for a better one
- ac_cv_path_EGREP="$ac_path_EGREP"
- ac_path_EGREP_max=$ac_count
- fi
- # 10*(2^10) chars as input seems more than enough
- test $ac_count -gt 10 && break
- done
- rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
-esac
-
- $ac_path_EGREP_found && break 3
- done
- done
- done
-IFS=$as_save_IFS
- if test -z "$ac_cv_path_EGREP"; then
- as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
- fi
-else
- ac_cv_path_EGREP=$EGREP
fi
-
- fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL=$ac_cv_path_install
+ else
+ # As a last resort, use the slow shell script. Don't cache a
+ # value for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the value is a relative name.
+ INSTALL=$ac_install_sh
+ fi
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
-$as_echo "$ac_cv_path_EGREP" >&6; }
- EGREP="$ac_cv_path_EGREP"
-
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
-$as_echo_n "checking for ANSI C header files... " >&6; }
-if ${ac_cv_header_stdc+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <stdlib.h>
-#include <stdarg.h>
-#include <string.h>
-#include <float.h>
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_header_stdc=yes
-else
- ac_cv_header_stdc=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-
-if test $ac_cv_header_stdc = yes; then
- # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <string.h>
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "memchr" >/dev/null 2>&1; then :
-
-else
- ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
- # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <stdlib.h>
-
-_ACEOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "free" >/dev/null 2>&1; then :
-
-else
- ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
- # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
- if test "$cross_compiling" = yes; then :
- :
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <ctype.h>
-#include <stdlib.h>
-#if ((' ' & 0x0FF) == 0x020)
-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
-#else
-# define ISLOWER(c) \
- (('a' <= (c) && (c) <= 'i') \
- || ('j' <= (c) && (c) <= 'r') \
- || ('s' <= (c) && (c) <= 'z'))
-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
-#endif
-
-#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
-int
-main ()
-{
- int i;
- for (i = 0; i < 256; i++)
- if (XOR (islower (i), ISLOWER (i))
- || toupper (i) != TOUPPER (i))
- return 2;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
-
-else
- ac_cv_header_stdc=no
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-
-fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
-$as_echo "$ac_cv_header_stdc" >&6; }
-if test $ac_cv_header_stdc = yes; then
-
-$as_echo "#define STDC_HEADERS 1" >>confdefs.h
-
-fi
- # this needs to precede AC_CHECK_HEADER! (is this the case in 2.60?)
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AmigaOS /C/install, which installs bootblocks on floppy discs
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# OS/2's system install, which has a completely different semantic
-# ./install, which can be erroneously created by make from ./install.sh.
-# Reject install programs that cannot install multiple files.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5
-$as_echo_n "checking for a BSD-compatible install... " >&6; }
-if test -z "$INSTALL"; then
-if ${ac_cv_path_install+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- # Account for people who put trailing slashes in PATH elements.
-case $as_dir/ in #((
- ./ | .// | /[cC]/* | \
- /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
- ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \
- /usr/ucb/* ) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- # Don't use installbsd from OSF since it installs stuff as root
- # by default.
- for ac_prog in ginstall scoinst install; do
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then
- if test $ac_prog = install &&
- grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- :
- elif test $ac_prog = install &&
- grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- # program-specific install script used by HP pwplus--don't use.
- :
- else
- rm -rf conftest.one conftest.two conftest.dir
- echo one > conftest.one
- echo two > conftest.two
- mkdir conftest.dir
- if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" &&
- test -s conftest.one && test -s conftest.two &&
- test -s conftest.dir/conftest.one &&
- test -s conftest.dir/conftest.two
- then
- ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
- break 3
- fi
- fi
- fi
- done
- done
- ;;
-esac
-
- done
-IFS=$as_save_IFS
-
-rm -rf conftest.one conftest.two conftest.dir
-
-fi
- if test "${ac_cv_path_install+set}" = set; then
- INSTALL=$ac_cv_path_install
- else
- # As a last resort, use the slow shell script. Don't cache a
- # value for INSTALL within a source directory, because that will
- # break other packages using the cache if that directory is
- # removed, or if the value is a relative name.
- INSTALL=$ac_install_sh
- fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5
-$as_echo "$INSTALL" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5
+$as_echo "$INSTALL" >&6; }
# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
# It thinks the first close brace ends the variable substitution.
@@ -3975,4722 +3290,928 @@ test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-
-
-MAKE_TARGET="snd"
-
-AUDIO_SYSTEM="None"
-RANDOM_FEATURES=""
-OPTIONAL_LIBRARIES=""
-LOCAL_LANGUAGE="None"
-GRAPHICS_TOOLKIT="None"
-
-PACKAGE=Snd
-VERSION=12.0
-cat >>confdefs.h <<_ACEOF
-#define SND_PACKAGE "$PACKAGE"
-_ACEOF
-
-cat >>confdefs.h <<_ACEOF
-#define SND_VERSION "$VERSION"
-_ACEOF
-
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SND_HOST "$host"
-_ACEOF
-
-
-#--------------------------------------------------------------------------------
-# configuration options
-# --with-motif use Motif (the default)
-# --with-static-motif use Motif statically loaded (for RPM generation)
-# --with-gtk use Gtk+
-# --with-alsa use ALSA if possible (the default)
-# --with-oss use OSS
-# --with-jack use Jack
-# --with-static-alsa use ALSA statically loaded (for RPM generation)
-# --without-audio stub out all audio
-# --with-snd-as-widget make Snd a loadable widget, not a standalone program
-# --with-doubles use doubles throughout (default=yes)
-# --with-float-samples represent samples internally as floats or doubles (default=yes)
-# --with-gmp include multiprecision arithmetic via gmp, mpfr, and mpc
-# --enable-snd-debug include Snd internal debugging stuff
-# --enable-threads include pthread stuff [also "--with-threads" since I can't remember which is correct]
-# --disable-deprecated do not include any deprecated stuff (in gtk, motif, s7, sndlib, clm, etc)
-# --with-ladspa include LADSPA plugin support (Linux)
-# --with-sample-width=N use N bits of samples (default = 24)
-# --with-esd use Enlightened Sound Daemon
-# --with-no-gui make Snd without any graphics support
-# --with-motif-prefix set location of Motif
-# --with-forth use Forth as the extension language
-# --with-ruby use Ruby as the extension language
-# --with-ruby-prefix set location of Ruby
-# --with-s7 use S7 as the extension language (default = yes)
-# --with-extension-language use some extension language (default=yes)
-# --with-static-xm include xm module
-# --with-temp-dir directory to use for temp files
-# --with-save-dir directory to use for saved-state files
-# --with-doc-dir directory to search for documentation
-# --with-gl include OpenGL support (default=no, Motif only)
-# --with-just-gl include OpenGL support but omit the extension language bindings (default=no, Motif only)
-# --with-gl2ps include gl2ps (Motif only)
-# --with-editres include EditRes in xm
-# --with-shared-sndlib load sndlib.so if possible
-# --without-gsl omit GSL even if it exists
-# --without-fftw omit FFTW even if it exists
-# --without-fam libfam can be obsolete, but it's not clear how to test this
-# --with-pulseaudio use PulseAudio
-# --with-portaudio use portaudio
-# --with-profiling add code to keep profiling stats (s7)
-# SNDLIB_CONFIG_path where to look for sndlib-config
-
-#--------------------------------------------------------------------------------
-
-
-# Check whether --with-esd was given.
-if test "${with_esd+set}" = set; then :
- withval=$with_esd;
-fi
-
-
-# Check whether --with-alsa was given.
-if test "${with_alsa+set}" = set; then :
- withval=$with_alsa;
-fi
-
-
-# Check whether --with-oss was given.
-if test "${with_oss+set}" = set; then :
- withval=$with_oss;
-fi
-
-
-# Check whether --with-jack was given.
-if test "${with_jack+set}" = set; then :
- withval=$with_jack;
-fi
-
-
-# Check whether --with-static-alsa was given.
-if test "${with_static_alsa+set}" = set; then :
- withval=$with_static_alsa;
-fi
-
-
-# Check whether --with-gtk was given.
-if test "${with_gtk+set}" = set; then :
- withval=$with_gtk;
-fi
-
-
-# Check whether --with-no-gui was given.
-if test "${with_no_gui+set}" = set; then :
- withval=$with_no_gui;
-fi
-
-
-# Check whether --with-static-xm was given.
-if test "${with_static_xm+set}" = set; then :
- withval=$with_static_xm;
-fi
-
-
-# Check whether --with-static-xg was given.
-if test "${with_static_xg+set}" = set; then :
- withval=$with_static_xg;
-fi
-
-
-# Check whether --with-gl was given.
-if test "${with_gl+set}" = set; then :
- withval=$with_gl;
-fi
-
-
-# Check whether --with-just-gl was given.
-if test "${with_just_gl+set}" = set; then :
- withval=$with_just_gl;
-fi
-
-
-# Check whether --with-gl2ps was given.
-if test "${with_gl2ps+set}" = set; then :
- withval=$with_gl2ps;
-fi
-
-
-# Check whether --with-motif was given.
-if test "${with_motif+set}" = set; then :
- withval=$with_motif;
-fi
-
-
-# Check whether --with-static-motif was given.
-if test "${with_static_motif+set}" = set; then :
- withval=$with_static_motif;
-fi
-
-
-# Check whether --with-editres was given.
-if test "${with_editres+set}" = set; then :
- withval=$with_editres;
-fi
-
-
-# Check whether --with-ladspa was given.
-if test "${with_ladspa+set}" = set; then :
- withval=$with_ladspa;
-fi
-
-
-# Check whether --with-doubles was given.
-if test "${with_doubles+set}" = set; then :
- withval=$with_doubles;
-fi
-
-
-# Check whether --with-float-samples was given.
-if test "${with_float_samples+set}" = set; then :
- withval=$with_float_samples;
-fi
-
-
-# Check whether --with-pulseaudio was given.
-if test "${with_pulseaudio+set}" = set; then :
- withval=$with_pulseaudio;
-fi
-
-
-# Check whether --with-portaudio was given.
-if test "${with_portaudio+set}" = set; then :
- withval=$with_portaudio;
-fi
-
-
-# Check whether --with-profiling was given.
-if test "${with_profiling+set}" = set; then :
- withval=$with_profiling;
-fi
-
-
-# these are primarily for testing
-
-# Check whether --with-gsl was given.
-if test "${with_gsl+set}" = set; then :
- withval=$with_gsl;
-fi
-
-
-# Check whether --with-fftw was given.
-if test "${with_fftw+set}" = set; then :
- withval=$with_fftw;
-fi
-
-
-# Check whether --with-fam was given.
-if test "${with_fam+set}" = set; then :
- withval=$with_fam;
-fi
-
-
-# Check whether --with-gmp was given.
-if test "${with_gmp+set}" = set; then :
- withval=$with_gmp;
-fi
-
-
-
-# Check whether --with-s7 was given.
-if test "${with_s7+set}" = set; then :
- withval=$with_s7;
-fi
-
-
-# Check whether --with-extension-language was given.
-if test "${with_extension_language+set}" = set; then :
- withval=$with_extension_language;
-fi
-
-
-# an experiment
-
-# Check whether --with-directfb was given.
-if test "${with_directfb+set}" = set; then :
- withval=$with_directfb;
-fi
-
-
-# Check whether --with-audio was given.
-if test "${with_audio+set}" = set; then :
- withval=$with_audio;
-fi
-
-
-
-# -------- internal sample data type --------
-
-# sample-width only applies to the int case (ignored if float)
-LOCAL_SNDLIB_BITS="24"
-
-# Check whether --with-sample-width was given.
-if test "${with_sample_width+set}" = set; then :
- withval=$with_sample_width; { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using $with_sample_width bit samples" >&5
-$as_echo "Using $with_sample_width bit samples" >&6; }
- cat >>confdefs.h <<_ACEOF
-#define MUS_SAMPLE_BITS $with_sample_width
-_ACEOF
-
- LOCAL_SNDLIB_BITS=$with_sample_width
-
-else
- $as_echo "#define MUS_SAMPLE_BITS 24" >>confdefs.h
-
-
-fi
-
-
-if test "$with_float_samples" != no ; then
- $as_echo "#define SNDLIB_USE_FLOATS 1" >>confdefs.h
-
- if test "$with_doubles" != no ; then
- LOCAL_SNDLIB_BITS="8"
- else
- LOCAL_SNDLIB_BITS="4"
- fi
-else
- $as_echo "#define SNDLIB_USE_FLOATS 0" >>confdefs.h
-
-fi
-
-if test "$with_doubles" != no ; then
- $as_echo "#define mus_float_t double" >>confdefs.h
-
- $as_echo "#define WITH_DOUBLES 1" >>confdefs.h
-
-else
- $as_echo "#define mus_float_t float" >>confdefs.h
-
-fi
-
-if test "$with_static_xg" = yes ; then
- with_static_xm=yes
-fi
-
-
-# Check whether --with-motif-prefix was given.
-if test "${with_motif_prefix+set}" = set; then :
- withval=$with_motif_prefix; motif_prefix="$withval"
-else
- motif_prefix=""
-fi
-
-
-if test "$with_static_motif" = yes ; then
- with_motif=yes
-fi
-
-
-# Check whether --with-temp-dir was given.
-if test "${with_temp_dir+set}" = set; then :
- withval=$with_temp_dir; cat >>confdefs.h <<_ACEOF
-#define MUS_DEFAULT_TEMP_DIR "${withval}"
-_ACEOF
-
-
-fi
-
-
-
-# Check whether --with-save-dir was given.
-if test "${with_save_dir+set}" = set; then :
- withval=$with_save_dir; cat >>confdefs.h <<_ACEOF
-#define MUS_DEFAULT_SAVE_DIR "${withval}"
-_ACEOF
-
-
-fi
-
-
-
-# Check whether --with-doc-dir was given.
-if test "${with_doc_dir+set}" = set; then :
- withval=$with_doc_dir; cat >>confdefs.h <<_ACEOF
-#define MUS_DEFAULT_DOC_DIR "${withval}"
-_ACEOF
-
-
-fi
-
-
-
-# Check whether --with-snd-as-widget was given.
-if test "${with_snd_as_widget+set}" = set; then :
- withval=$with_snd_as_widget; if test "$with_snd_as_widget" = yes ; then
- $as_echo "#define SND_AS_WIDGET 1" >>confdefs.h
-
- MAKE_TARGET=widget
- fi
-fi
-
-
-# if mingw add -mwindows to the load flags (I think this means we're trying to build a GUI app, not just a console app??)
-case "$host" in
- *-*-mingw*)
- LDFLAGS="$LDFLAGS -mwindows"
- ;;
-esac
-
-
-
-#--------------------------------------------------------------------------------
-# standard libraries, header files, functions, OSS special cases
-#--------------------------------------------------------------------------------
-
-LIBS=""
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lm" >&5
-$as_echo_n "checking for main in -lm... " >&6; }
-if ${ac_cv_lib_m_main+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-
-int
-main ()
-{
-return main ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_main=yes
-else
- ac_cv_lib_m_main=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_main" >&5
-$as_echo "$ac_cv_lib_m_main" >&6; }
-if test "x$ac_cv_lib_m_main" = xyes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_LIBM 1
-_ACEOF
-
- LIBS="-lm $LIBS"
-
-fi
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lc" >&5
-$as_echo_n "checking for main in -lc... " >&6; }
-if ${ac_cv_lib_c_main+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lc $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-
-int
-main ()
-{
-return main ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_c_main=yes
-else
- ac_cv_lib_c_main=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_main" >&5
-$as_echo "$ac_cv_lib_c_main" >&6; }
-if test "x$ac_cv_lib_c_main" = xyes; then :
- cat >>confdefs.h <<_ACEOF
-#define HAVE_LIBC 1
-_ACEOF
-
- LIBS="-lc $LIBS"
-
-fi
-
-# AC_CHECK_LIB(dl,main)
-# I don't think I need libdl in S7, and the other extension languages will call for it if needed
-
-# On IRIX 5.3, sys/types and inttypes.h are conflicting.
-for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
- inttypes.h stdint.h unistd.h
-do :
- as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
-"
-if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-
-done
-
-
-for ac_header in fcntl.h limits.h unistd.h string.h sys/soundcard.h machine/soundcard.h sys/mixer.h stdbool.h sys/time.h
-do :
- as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
-if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-
-done
-
-for ac_header in libc.h sys/statvfs.h setjmp.h dlfcn.h sys/param.h byteswap.h pthread.h stdint.h fam.h dirent.h
-do :
- as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
-ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
-if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-
-done
-
-
-ac_fn_c_check_header_compile "$LINENO" "sys/mount.h" "ac_cv_header_sys_mount_h" "#if HAVE_SYS_PARAM_H
- #include <sys/param.h>
- #endif
-
-"
-if test "x$ac_cv_header_sys_mount_h" = xyes; then :
-
-fi
-
-
-# this still screws up in netBSD!
-
-
-# check for pthreads -- allow either --with-threads or --enable-threads
-
-
-# Check whether --with-threads was given.
-if test "${with_threads+set}" = set; then :
- withval=$with_threads;
- if test "$ac_cv_header_pthread_h" = yes ; then
- $as_echo "#define HAVE_PTHREADS 1" >>confdefs.h
-
- LIBS="$LIBS -lpthread"
- RANDOM_FEATURES="$RANDOM_FEATURES threads"
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't go with threads -- can't find pthread.h" >&5
-$as_echo "$as_me: WARNING: can't go with threads -- can't find pthread.h" >&2;}
- fi
-
-fi
-
-
-# Check whether --enable-threads was given.
-if test "${enable_threads+set}" = set; then :
- enableval=$enable_threads;
- if test "$enable_threads" = yes ; then
- if test "$ac_cv_header_pthread_h" = yes ; then
- $as_echo "#define HAVE_PTHREADS 1" >>confdefs.h
-
- LIBS="$LIBS -lpthread"
- RANDOM_FEATURES="$RANDOM_FEATURES threads"
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't enable threads -- can't find pthread.h" >&5
-$as_echo "$as_me: WARNING: can't enable threads -- can't find pthread.h" >&2;}
- fi
- fi
-fi
-
-
-
-
-ac_fn_c_check_header_mongrel "$LINENO" "/usr/local/lib/oss/include/sys/soundcard.h" "ac_cv_header__usr_local_lib_oss_include_sys_soundcard_h" "$ac_includes_default"
-if test "x$ac_cv_header__usr_local_lib_oss_include_sys_soundcard_h" = xyes; then :
- $as_echo "#define MUS_HAVE_USR_LOCAL_LIB_OSS 1" >>confdefs.h
-
-fi
-
-
-ac_fn_c_check_header_mongrel "$LINENO" "/usr/lib/oss/include/sys/soundcard.h" "ac_cv_header__usr_lib_oss_include_sys_soundcard_h" "$ac_includes_default"
-if test "x$ac_cv_header__usr_lib_oss_include_sys_soundcard_h" = xyes; then :
- $as_echo "#define MUS_HAVE_USR_LIB_OSS 1" >>confdefs.h
-
-fi
-
-
-ac_fn_c_check_header_mongrel "$LINENO" "/opt/oss/include/sys/soundcard.h" "ac_cv_header__opt_oss_include_sys_soundcard_h" "$ac_includes_default"
-if test "x$ac_cv_header__opt_oss_include_sys_soundcard_h" = xyes; then :
- $as_echo "#define MUS_HAVE_OPT_OSS 1" >>confdefs.h
-
-fi
-
-
-ac_fn_c_check_header_mongrel "$LINENO" "/var/lib/oss/include/sys/soundcard.h" "ac_cv_header__var_lib_oss_include_sys_soundcard_h" "$ac_includes_default"
-if test "x$ac_cv_header__var_lib_oss_include_sys_soundcard_h" = xyes; then :
- $as_echo "#define MUS_HAVE_VAR_LIB_OSS 1" >>confdefs.h
-
-fi
-
-
-ac_fn_c_check_header_mongrel "$LINENO" "gnu/libc-version.h" "ac_cv_header_gnu_libc_version_h" "$ac_includes_default"
-if test "x$ac_cv_header_gnu_libc_version_h" = xyes; then :
- $as_echo "#define HAVE_GNU_LIBC_VERSION_H 1" >>confdefs.h
-
-fi
-
-
-ac_fn_c_check_header_mongrel "$LINENO" "alsa/asoundlib.h" "ac_cv_header_alsa_asoundlib_h" "$ac_includes_default"
-if test "x$ac_cv_header_alsa_asoundlib_h" = xyes; then :
- $as_echo "#define HAVE_ALSA_ASOUNDLIB_H 1" >>confdefs.h
-
-fi
-
-
-
-ac_fn_c_check_decl "$LINENO" "hypot" "ac_cv_have_decl_hypot" "#include <math.h>
-"
-if test "x$ac_cv_have_decl_hypot" = xyes; then :
- ac_have_decl=1
-else
- ac_have_decl=0
-fi
-
-cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_HYPOT $ac_have_decl
-_ACEOF
-
-ac_fn_c_check_decl "$LINENO" "isnan" "ac_cv_have_decl_isnan" "#include <math.h>
-"
-if test "x$ac_cv_have_decl_isnan" = xyes; then :
- ac_have_decl=1
-else
- ac_have_decl=0
-fi
-
-cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_ISNAN $ac_have_decl
-_ACEOF
-
-ac_fn_c_check_decl "$LINENO" "isinf" "ac_cv_have_decl_isinf" "#include <math.h>
-"
-if test "x$ac_cv_have_decl_isinf" = xyes; then :
- ac_have_decl=1
-else
- ac_have_decl=0
-fi
-
-cat >>confdefs.h <<_ACEOF
-#define HAVE_DECL_ISINF $ac_have_decl
-_ACEOF
-
-
-ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"
-if test "x$ac_cv_type_mode_t" = xyes; then :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define mode_t int
-_ACEOF
-
-fi
-
-ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default"
-if test "x$ac_cv_type_size_t" = xyes; then :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define size_t unsigned int
-_ACEOF
-
-fi
-
-# AC_TYPE_SSIZE_T -- in the docs, but apparently doesn't actually work
-ac_fn_c_check_type "$LINENO" "ssize_t" "ac_cv_type_ssize_t" "$ac_includes_default"
-if test "x$ac_cv_type_ssize_t" = xyes; then :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define ssize_t int
-_ACEOF
-
-fi
-
-ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default"
-if test "x$ac_cv_type_pid_t" = xyes; then :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define pid_t int
-_ACEOF
-
-fi
-
-ac_fn_c_find_intX_t "$LINENO" "64" "ac_cv_c_int64_t"
-case $ac_cv_c_int64_t in #(
- no|yes) ;; #(
- *)
-
-cat >>confdefs.h <<_ACEOF
-#define int64_t $ac_cv_c_int64_t
-_ACEOF
-;;
-esac
-
-
-# new form of this macro from autoconf 2.62 makes the Mac case a real headache
-# so this is a call on the old form
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
-$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
-if ${ac_cv_c_bigendian+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- # See if sys/param.h defines the BYTE_ORDER macro.
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
-#include <sys/param.h>
-
-int
-main ()
-{
-#if ! (defined BYTE_ORDER && defined BIG_ENDIAN && defined LITTLE_ENDIAN \
- && BYTE_ORDER && BIG_ENDIAN && LITTLE_ENDIAN)
- bogus endian macros
-#endif
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- # It does; now see whether it defined to BIG_ENDIAN or not.
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
-#include <sys/param.h>
-
-int
-main ()
-{
-#if BYTE_ORDER != BIG_ENDIAN
- not big endian
-#endif
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_c_bigendian=yes
-else
- ac_cv_c_bigendian=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-else
- # It does not; compile a test program.
-if test "$cross_compiling" = yes; then :
- # try to guess the endianness by grepping values into an object file
- ac_cv_c_bigendian=unknown
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-short int ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
-short int ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
-void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; }
-short int ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
-short int ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
-void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; }
-int
-main ()
-{
- _ascii (); _ebcdic ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then
- ac_cv_c_bigendian=yes
-fi
-if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
- if test "$ac_cv_c_bigendian" = unknown; then
- ac_cv_c_bigendian=no
- else
- # finding both strings is unlikely to happen, but who knows?
- ac_cv_c_bigendian=unknown
- fi
-fi
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-
- /* Are we little or big endian? From Harbison&Steele. */
- union
- {
- long int l;
- char c[sizeof (long int)];
- } u;
- u.l = 1;
- return u.c[sizeof (long int) - 1] == 1;
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- ac_cv_c_bigendian=no
-else
- ac_cv_c_bigendian=yes
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
-$as_echo "$ac_cv_c_bigendian" >&6; }
-case $ac_cv_c_bigendian in
- yes)
-
-$as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
- ;;
- no)
- ;;
- *)
- as_fn_error $? "unknown endianness
-presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;;
-esac
-
-
-# Check whether --enable-largefile was given.
-if test "${enable_largefile+set}" = set; then :
- enableval=$enable_largefile;
-fi
-
-if test "$enable_largefile" != no; then
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5
-$as_echo_n "checking for special C compiler options needed for large files... " >&6; }
-if ${ac_cv_sys_largefile_CC+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_cv_sys_largefile_CC=no
- if test "$GCC" != yes; then
- ac_save_CC=$CC
- while :; do
- # IRIX 6.2 and later do not support large files by default,
- # so use the C compiler's -n32 option if that helps.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
- if ac_fn_c_try_compile "$LINENO"; then :
- break
-fi
-rm -f core conftest.err conftest.$ac_objext
- CC="$CC -n32"
- if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_largefile_CC=' -n32'; break
-fi
-rm -f core conftest.err conftest.$ac_objext
- break
- done
- CC=$ac_save_CC
- rm -f conftest.$ac_ext
- fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5
-$as_echo "$ac_cv_sys_largefile_CC" >&6; }
- if test "$ac_cv_sys_largefile_CC" != no; then
- CC=$CC$ac_cv_sys_largefile_CC
- fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5
-$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; }
-if ${ac_cv_sys_file_offset_bits+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_file_offset_bits=no; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#define _FILE_OFFSET_BITS 64
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_file_offset_bits=64; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- ac_cv_sys_file_offset_bits=unknown
- break
-done
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5
-$as_echo "$ac_cv_sys_file_offset_bits" >&6; }
-case $ac_cv_sys_file_offset_bits in #(
- no | unknown) ;;
- *)
-cat >>confdefs.h <<_ACEOF
-#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits
-_ACEOF
-;;
-esac
-rm -rf conftest*
- if test $ac_cv_sys_file_offset_bits = unknown; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5
-$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; }
-if ${ac_cv_sys_large_files+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- while :; do
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_large_files=no; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#define _LARGE_FILES 1
-#include <sys/types.h>
- /* Check that off_t can represent 2**63 - 1 correctly.
- We can't simply define LARGE_OFF_T to be 9223372036854775807,
- since some C++ compilers masquerading as C compilers
- incorrectly reject 9223372036854775807. */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
- int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
- && LARGE_OFF_T % 2147483647 == 1)
- ? 1 : -1];
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- ac_cv_sys_large_files=1; break
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- ac_cv_sys_large_files=unknown
- break
-done
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5
-$as_echo "$ac_cv_sys_large_files" >&6; }
-case $ac_cv_sys_large_files in #(
- no | unknown) ;;
- *)
-cat >>confdefs.h <<_ACEOF
-#define _LARGE_FILES $ac_cv_sys_large_files
-_ACEOF
-;;
-esac
-rm -rf conftest*
- fi
-fi
-
-ac_fn_c_check_type "$LINENO" "off_t" "ac_cv_type_off_t" "$ac_includes_default"
-if test "x$ac_cv_type_off_t" = xyes; then :
-
-else
-
-cat >>confdefs.h <<_ACEOF
-#define off_t long int
-_ACEOF
-
-fi
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of off_t" >&5
-$as_echo_n "checking size of off_t... " >&6; }
-if ${ac_cv_sizeof_off_t+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (off_t))" "ac_cv_sizeof_off_t" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_off_t" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (off_t)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_off_t=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_off_t" >&5
-$as_echo "$ac_cv_sizeof_off_t" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_OFF_T $ac_cv_sizeof_off_t
-_ACEOF
-
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long" >&5
-$as_echo_n "checking size of long... " >&6; }
-if ${ac_cv_sizeof_long+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_long" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (long)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_long=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long" >&5
-$as_echo "$ac_cv_sizeof_long" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_LONG $ac_cv_sizeof_long
-_ACEOF
-
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long long" >&5
-$as_echo_n "checking size of long long... " >&6; }
-if ${ac_cv_sizeof_long_long+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long long))" "ac_cv_sizeof_long_long" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_long_long" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (long long)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_long_long=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long_long" >&5
-$as_echo "$ac_cv_sizeof_long_long" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_LONG_LONG $ac_cv_sizeof_long_long
-_ACEOF
-
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of unsigned long long" >&5
-$as_echo_n "checking size of unsigned long long... " >&6; }
-if ${ac_cv_sizeof_unsigned_long_long+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (unsigned long long))" "ac_cv_sizeof_unsigned_long_long" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_unsigned_long_long" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (unsigned long long)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_unsigned_long_long=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_unsigned_long_long" >&5
-$as_echo "$ac_cv_sizeof_unsigned_long_long" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_UNSIGNED_LONG_LONG $ac_cv_sizeof_unsigned_long_long
-_ACEOF
-
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of unsigned long" >&5
-$as_echo_n "checking size of unsigned long... " >&6; }
-if ${ac_cv_sizeof_unsigned_long+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (unsigned long))" "ac_cv_sizeof_unsigned_long" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_unsigned_long" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (unsigned long)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_unsigned_long=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_unsigned_long" >&5
-$as_echo "$ac_cv_sizeof_unsigned_long" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_UNSIGNED_LONG $ac_cv_sizeof_unsigned_long
-_ACEOF
-
-
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of void *" >&5
-$as_echo_n "checking size of void *... " >&6; }
-if ${ac_cv_sizeof_void_p+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (void *))" "ac_cv_sizeof_void_p" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_void_p" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (void *)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_void_p=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_void_p" >&5
-$as_echo "$ac_cv_sizeof_void_p" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_VOID_P $ac_cv_sizeof_void_p
-_ACEOF
-
-
-# this won't work in version 2.66 (fixed in 2.67)
-# AC_CHECK_SIZEOF(intptr_t)
-# AC_DEFINE_UNQUOTED(SIZEOF_VOID_P, $ac_cv_sizeof_intptr_t)
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of int" >&5
-$as_echo_n "checking size of int... " >&6; }
-if ${ac_cv_sizeof_int+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (int))" "ac_cv_sizeof_int" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_int" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (int)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_int=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_int" >&5
-$as_echo "$ac_cv_sizeof_int" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_INT $ac_cv_sizeof_int
-_ACEOF
-
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of int64_t" >&5
-$as_echo_n "checking size of int64_t... " >&6; }
-if ${ac_cv_sizeof_int64_t+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (int64_t))" "ac_cv_sizeof_int64_t" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_int64_t" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (int64_t)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_int64_t=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_int64_t" >&5
-$as_echo "$ac_cv_sizeof_int64_t" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_INT64_T $ac_cv_sizeof_int64_t
-_ACEOF
-
-
-# The cast to long int works around a bug in the HP C Compiler
-# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
-# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
-# This bug is HP SR number 8606223364.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of ssize_t" >&5
-$as_echo_n "checking size of ssize_t... " >&6; }
-if ${ac_cv_sizeof_ssize_t+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (ssize_t))" "ac_cv_sizeof_ssize_t" "$ac_includes_default"; then :
-
-else
- if test "$ac_cv_type_ssize_t" = yes; then
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error 77 "cannot compute sizeof (ssize_t)
-See \`config.log' for more details" "$LINENO" 5; }
- else
- ac_cv_sizeof_ssize_t=0
- fi
-fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_ssize_t" >&5
-$as_echo "$ac_cv_sizeof_ssize_t" >&6; }
-
-
-
-cat >>confdefs.h <<_ACEOF
-#define SIZEOF_SSIZE_T $ac_cv_sizeof_ssize_t
-_ACEOF
-
-
-
-for ac_func in getcwd strerror readlink setlocale access opendir sleep signal statvfs statfs getline difftime gettimeofday
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
-for ac_func in vsnprintf vasprintf snprintf strftime memmove lstat strcasecmp pathconf
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
-
-
-# Check whether --with-gnu-ld was given.
-if test "${with_gnu_ld+set}" = set; then :
- withval=$with_gnu_ld; test "$withval" = no || with_gnu_ld=yes
-else
- with_gnu_ld=no
-fi
-
-# Prepare PATH_SEPARATOR.
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-ac_prog=ld
-if test "$GCC" = yes; then
- # Check if gcc -print-prog-name=ld gives a path.
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by GCC" >&5
-$as_echo_n "checking for ld used by GCC... " >&6; }
- case $host in
- *-*-mingw*)
- # gcc leaves a trailing carriage return which upsets mingw
- ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
- *)
- ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
- esac
- case $ac_prog in
- # Accept absolute paths.
- [\\/]* | [A-Za-z]:[\\/]*)
- re_direlt='/[^/][^/]*/\.\./'
- # Canonicalize the path of ld
- ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
- while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
- ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
- done
- test -z "$LD" && LD="$ac_prog"
- ;;
- "")
- # If it fails, then pretend we aren't using GCC.
- ac_prog=ld
- ;;
- *)
- # If it is relative, then search for the first ld in PATH.
- with_gnu_ld=unknown
- ;;
- esac
-elif test "$with_gnu_ld" = yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5
-$as_echo_n "checking for GNU ld... " >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5
-$as_echo_n "checking for non-GNU ld... " >&6; }
-fi
-if ${acl_cv_path_LD+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if test -z "$LD"; then
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
- for ac_dir in $PATH; do
- test -z "$ac_dir" && ac_dir=.
- if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
- acl_cv_path_LD="$ac_dir/$ac_prog"
- # Check to see if the program is GNU ld. I'd rather use --version,
- # but apparently some GNU ld's only accept -v.
- # Break only if it was the GNU/non-GNU ld that we prefer.
- case `"$acl_cv_path_LD" -v 2>&1 < /dev/null` in
- *GNU* | *'with BFD'*)
- test "$with_gnu_ld" != no && break ;;
- *)
- test "$with_gnu_ld" != yes && break ;;
- esac
- fi
- done
- IFS="$ac_save_ifs"
-else
- acl_cv_path_LD="$LD" # Let the user override the test with a path.
-fi
-fi
-
-LD="$acl_cv_path_LD"
-if test -n "$LD"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LD" >&5
-$as_echo "$LD" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5
-$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; }
-if ${acl_cv_prog_gnu_ld+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- # I'd rather use --version here, but apparently some GNU ld's only accept -v.
-case `$LD -v 2>&1 </dev/null` in
-*GNU* | *'with BFD'*)
- acl_cv_prog_gnu_ld=yes ;;
-*)
- acl_cv_prog_gnu_ld=no ;;
-esac
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $acl_cv_prog_gnu_ld" >&5
-$as_echo "$acl_cv_prog_gnu_ld" >&6; }
-with_gnu_ld=$acl_cv_prog_gnu_ld
-
-
-# this is needed for the -export-dynamic check below (export dynamic is needed to get the xm.so module loadable at run-time)
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5
-$as_echo_n "checking for fgrep... " >&6; }
-if ${ac_cv_path_FGREP+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1
- then ac_cv_path_FGREP="$GREP -F"
- else
- if test -z "$FGREP"; then
- ac_path_FGREP_found=false
- # Loop through the user's path and test for each of PROGNAME-LIST
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_prog in fgrep; do
- for ac_exec_ext in '' $ac_executable_extensions; do
- ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext"
- { test -f "$ac_path_FGREP" && $as_test_x "$ac_path_FGREP"; } || continue
-# Check for GNU ac_path_FGREP and select it if it is found.
- # Check for GNU $ac_path_FGREP
-case `"$ac_path_FGREP" --version 2>&1` in
-*GNU*)
- ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;;
-*)
- ac_count=0
- $as_echo_n 0123456789 >"conftest.in"
- while :
- do
- cat "conftest.in" "conftest.in" >"conftest.tmp"
- mv "conftest.tmp" "conftest.in"
- cp "conftest.in" "conftest.nl"
- $as_echo 'FGREP' >> "conftest.nl"
- "$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break
- diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
- as_fn_arith $ac_count + 1 && ac_count=$as_val
- if test $ac_count -gt ${ac_path_FGREP_max-0}; then
- # Best one so far, save it but keep looking for a better one
- ac_cv_path_FGREP="$ac_path_FGREP"
- ac_path_FGREP_max=$ac_count
- fi
- # 10*(2^10) chars as input seems more than enough
- test $ac_count -gt 10 && break
- done
- rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
-esac
-
- $ac_path_FGREP_found && break 3
- done
- done
- done
-IFS=$as_save_IFS
- if test -z "$ac_cv_path_FGREP"; then
- as_fn_error $? "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
- fi
-else
- ac_cv_path_FGREP=$FGREP
-fi
-
- fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5
-$as_echo "$ac_cv_path_FGREP" >&6; }
- FGREP="$ac_cv_path_FGREP"
-
-
-cat >>confdefs.h <<_ACEOF
-#define FGREP_PROG "$FGREP"
-_ACEOF
-
-
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __func__" >&5
-$as_echo_n "checking for __func__... " >&6; }
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-int
-main ()
-{
- char *s;
- s = (char *)__func__
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- $as_echo "#define HAVE___FUNC__ 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
-# Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PKG_CONFIG+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
-
-# look for special functions in libm
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for jn in -lm" >&5
-$as_echo_n "checking for jn in -lm... " >&6; }
-if ${ac_cv_lib_m_jn+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char jn ();
-int
-main ()
-{
-return jn ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_jn=yes
-else
- ac_cv_lib_m_jn=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_jn" >&5
-$as_echo "$ac_cv_lib_m_jn" >&6; }
-if test "x$ac_cv_lib_m_jn" = xyes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for yn in -lm" >&5
-$as_echo_n "checking for yn in -lm... " >&6; }
-if ${ac_cv_lib_m_yn+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char yn ();
-int
-main ()
-{
-return yn ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_yn=yes
-else
- ac_cv_lib_m_yn=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_yn" >&5
-$as_echo "$ac_cv_lib_m_yn" >&6; }
-if test "x$ac_cv_lib_m_yn" = xyes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgamma in -lm" >&5
-$as_echo_n "checking for lgamma in -lm... " >&6; }
-if ${ac_cv_lib_m_lgamma+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char lgamma ();
-int
-main ()
-{
-return lgamma ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_lgamma=yes
-else
- ac_cv_lib_m_lgamma=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_lgamma" >&5
-$as_echo "$ac_cv_lib_m_lgamma" >&6; }
-if test "x$ac_cv_lib_m_lgamma" = xyes; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for erf in -lm" >&5
-$as_echo_n "checking for erf in -lm... " >&6; }
-if ${ac_cv_lib_m_erf+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char erf ();
-int
-main ()
-{
-return erf ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_erf=yes
-else
- ac_cv_lib_m_erf=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_erf" >&5
-$as_echo "$ac_cv_lib_m_erf" >&6; }
-if test "x$ac_cv_lib_m_erf" = xyes; then :
- $as_echo "#define HAVE_SPECIAL_FUNCTIONS 1" >>confdefs.h
-
-fi
-
-fi
-
-fi
-
-fi
-
-
-
-# look for nested function support
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether nested functions work" >&5
-$as_echo_n "checking whether nested functions work... " >&6; }
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-int
-main ()
-{
- double bar;
- double foo(double a, double b)
- {
- auto double square (double z);
- double square (double z) {return(z * z);}
- return(square(a) + square(b));
- }
- bar = foo(1.0, 2.0)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- $as_echo "#define HAVE_NESTED_FUNCTIONS 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
-
-case "$host" in
- *-*-linux*)
- $as_echo "#define HAVE_LINUX 1" >>confdefs.h
-
- ;;
- *-*-sunos4*)
- $as_echo "#define HAVE_SUN 1" >>confdefs.h
-
- ;;
- *-*-solaris*)
- $as_echo "#define HAVE_SUN 1" >>confdefs.h
-
- ;;
- *-*-netbsd*)
- $as_echo "#define HAVE_NETBSD 1" >>confdefs.h
-
- ;;
- *-*-cygwin*)
- $as_echo "#define HAVE_WINDOZE 1" >>confdefs.h
-
- ;;
- *-*-mingw*)
- $as_echo "#define HAVE_WINDOZE 1" >>confdefs.h
-
- ;;
- *-apple-*)
- $as_echo "#define HAVE_OSX 1" >>confdefs.h
-
- ;;
-esac
-
-
-
-
-
-#--------------------------------------------------------------------------------
-# fftw
-#--------------------------------------------------------------------------------
-
-FFTW_LIBS=""
-FFTW_CFLAGS=""
-if test "$with_fftw" != no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fftw3" >&5
-$as_echo_n "checking for fftw3... " >&6; }
- if test x$PKG_CONFIG != xno ; then
- if $PKG_CONFIG fftw3 --exists ; then
- FFTW_LIBS="`$PKG_CONFIG fftw3 --libs`"
- FFTW_CFLAGS="`$PKG_CONFIG fftw3 --cflags`"
- $as_echo "#define HAVE_FFTW3 1" >>confdefs.h
-
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES fftw3"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- fi
- else
- SAVELIBS=$LIBS
- LIBS="$LIBS -lfftw3 -lm"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fftw-3" >&5
-$as_echo_n "checking for fftw-3... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <fftw3.h>
-int
-main ()
-{
-fftw_plan plan; fftw_execute(plan)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- $as_echo "#define HAVE_FFTW3 1" >>confdefs.h
-
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES fftw3"
- FFTW_LIBS="-lfftw3"
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- LIBS=$SAVELIBS
-
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- LIBS=$SAVELIBS
- fi
-fi
-
-
-
-
-#--------------------------------------------------------------------------------
-# complex trig
-#--------------------------------------------------------------------------------
-
-# having <complex.h> + a cacos declaration is not enough: C++ dies with a complaint about a "deprecated header"
-#
-# I'm also using cexp and in xen creal, cimag, and _Complex_I
-# I'm currently using the data type "complex double" though the header seems to prefer "double complex" and
-# the gcc documentation mentions _Complex double.
-#
-# in C++, we want to set these to WITH_COMPLEX 1 and HAVE_COMPLEX_TRIG 0 no matter what
-#
-LIBS="$LIBS -lm"
-
-if test "$CC" = "g++" ; then
- $as_echo "#define WITH_COMPLEX 1" >>confdefs.h
-
- ac_snd_have_complex_trig=no
-else
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for complex numbers" >&5
-$as_echo_n "checking for complex numbers... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <complex.h>
-int
-main ()
-{
- double complex val;
- double rl, im;
- val = 1.0 + 0.5 * _Complex_I;
- rl = creal(val);
- im = cimag(val);
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define WITH_COMPLEX 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
-
- ac_snd_have_complex_trig=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for complex trig" >&5
-$as_echo_n "checking for complex trig... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <complex.h>
-int
-main ()
-{
- _Complex double val;
- double rl, im;
- val = 1.0 + 0.5 * _Complex_I;
- rl = creal(val);
- im = cimag(val);
- val = ccosh(cacosh(1.5) / 100.0)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define HAVE_COMPLEX_TRIG 1" >>confdefs.h
-
- ac_snd_have_complex_trig=yes
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-
-
-#--------------------------------------------------------------------------------
-# GMP, MPFR, MPC
-#--------------------------------------------------------------------------------
-
-GMP_LIBS=""
-GMP_CFLAGS=""
-LOCAL_GMP_LIBS=""
-ac_snd_have_gmp=no
-
-if test "$with_gmp" = yes ; then
- # look for gmp, mpfr, and mpc
-
- SAVELIBS=$LIBS
- LIBS="$LIBS -lgmp -lm"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_init in -lgmp" >&5
-$as_echo_n "checking for __gmpz_init in -lgmp... " >&6; }
-if ${ac_cv_lib_gmp___gmpz_init+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lgmp $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char __gmpz_init ();
-int
-main ()
-{
-return __gmpz_init ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_gmp___gmpz_init=yes
-else
- ac_cv_lib_gmp___gmpz_init=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_init" >&5
-$as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; }
-if test "x$ac_cv_lib_gmp___gmpz_init" = xyes; then :
-
- LOCAL_GMP_LIBS="-lgmp"
- ac_snd_have_gmp=yes
-
-else
- as_fn_error $? "libgmp not found" "$LINENO" 5
-fi
-
-
- if test "$ac_snd_have_gmp" != no ; then
- LIBS="$LIBS -lmpfr"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libmpfr" >&5
-$as_echo_n "checking for libmpfr... " >&6; }
- LOCAL_GMP_LIBS="$LOCAL_GMP_LIBS -lmpfr"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <mpfr.h>
-int
-main ()
-{
-mpfr_t x; mpfr_init(x) ; mpfr_clear(x);
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-else
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- ac_snd_have_gmp=no
-
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- fi
-
- if test "$ac_snd_have_gmp" != no ; then
- LIBS="$LIBS -lmpc"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libmpc" >&5
-$as_echo_n "checking for libmpc... " >&6; }
- LOCAL_GMP_LIBS="$LOCAL_GMP_LIBS -lmpc"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <mpc.h>
-int
-main ()
-{
-mpc_t x; mpc_init2(x, 53); mpc_clear(x); mpc_asin(x, x, MPC_RNDNN);
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mpc_arg in -lmpc" >&5
-$as_echo_n "checking for mpc_arg in -lmpc... " >&6; }
-if ${ac_cv_lib_mpc_mpc_arg+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lmpc $GMP_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char mpc_arg ();
-int
-main ()
-{
-return mpc_arg ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_mpc_mpc_arg=yes
-else
- ac_cv_lib_mpc_mpc_arg=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpc_mpc_arg" >&5
-$as_echo "$ac_cv_lib_mpc_mpc_arg" >&6; }
-if test "x$ac_cv_lib_mpc_mpc_arg" = xyes; then :
-
- $as_echo "#define WITH_GMP 1" >>confdefs.h
-
- GMP_LIBS="$LOCAL_GMP_LIBS"
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gmp mpfr mpc"
-
-else
- as_fn_error $? "libmpc too old" "$LINENO" 5
-fi
-
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- fi
-
- LIBS=$SAVELIBS
-fi
-
-
-
-
-
-#--------------------------------------------------------------------------------
-# GSL
-#--------------------------------------------------------------------------------
-
-GSL_LIBS=""
-GSL_CFLAGS=""
-if test "$with_gsl" != no; then
- # Extract the first word of "gsl-config", so it can be a program name with args.
-set dummy gsl-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_GSL_CONFIG+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- case $GSL_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_GSL_CONFIG="$GSL_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_GSL_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_GSL_CONFIG" && ac_cv_path_GSL_CONFIG="no"
- ;;
-esac
-fi
-GSL_CONFIG=$ac_cv_path_GSL_CONFIG
-if test -n "$GSL_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GSL_CONFIG" >&5
-$as_echo "$GSL_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GSL" >&5
-$as_echo_n "checking for GSL... " >&6; }
- if test "$GSL_CONFIG" = "no" ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- else
- GSL_CFLAGS=`$GSL_CONFIG --cflags`
- GSL_PREFIX=`$GSL_CONFIG --prefix`
- GSL_LIBS=`$GSL_CONFIG --libs`
- gsl_version="`$GSL_CONFIG --version`"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gsl_version" >&5
-$as_echo "$gsl_version" >&6; }
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gsl"
-
- $as_echo "#define HAVE_GSL 1" >>confdefs.h
-
- cat >>confdefs.h <<_ACEOF
-#define MUS_GSL_VERSION "${gsl_version}"
-_ACEOF
-
-
- SAVELIBS=$LIBS
- LIBS="$LIBS $GSL_LIBS"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gsl_eigen_nonsymmv_workspace" >&5
-$as_echo_n "checking for gsl_eigen_nonsymmv_workspace... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <gsl/gsl_math.h>
- #include <gsl/gsl_eigen.h>
-int
-main ()
-{
- gsl_eigen_nonsymmv_workspace *w = gsl_eigen_nonsymmv_alloc(4)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- LIBS=$SAVELIBS
- fi
- fi
-
-
-
-
-
-#--------------------------------------------------------------------------------
-# Ladspa
-#--------------------------------------------------------------------------------
-
-if test "$with_ladspa" != no ; then
- # we also need dlfcn.h and dirent.h here, but presumably this is on Linux
- ac_fn_c_check_header_mongrel "$LINENO" "ladspa.h" "ac_cv_header_ladspa_h" "$ac_includes_default"
-if test "x$ac_cv_header_ladspa_h" = xyes; then :
- $as_echo "#define HAVE_LADSPA 1" >>confdefs.h
-
- RANDOM_FEATURES="$RANDOM_FEATURES ladspa"
-
-else
- if test "$with_ladspa" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find ladspa.h!" >&5
-$as_echo "$as_me: WARNING: can't find ladspa.h!" >&2;}
- fi
-fi
-
-
-fi
-
-
-#--------------------------------------------------------------------------------
-# X/Motif
-#--------------------------------------------------------------------------------
-
-ac_snd_have_gui=no
-
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5
-$as_echo_n "checking for X... " >&6; }
-
-
-# Check whether --with-x was given.
-if test "${with_x+set}" = set; then :
- withval=$with_x;
-fi
-
-# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
-if test "x$with_x" = xno; then
- # The user explicitly disabled X.
- have_x=disabled
-else
- case $x_includes,$x_libraries in #(
- *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #(
- *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- # One or both of the vars are not set, and there is no cached value.
-ac_x_includes=no ac_x_libraries=no
-rm -f -r conftest.dir
-if mkdir conftest.dir; then
- cd conftest.dir
- cat >Imakefile <<'_ACEOF'
-incroot:
- @echo incroot='${INCROOT}'
-usrlibdir:
- @echo usrlibdir='${USRLIBDIR}'
-libdir:
- @echo libdir='${LIBDIR}'
-_ACEOF
- if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then
- # GNU make sometimes prints "make[1]: Entering ...", which would confuse us.
- for ac_var in incroot usrlibdir libdir; do
- eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`"
- done
- # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
- for ac_extension in a so sl dylib la dll; do
- if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" &&
- test -f "$ac_im_libdir/libX11.$ac_extension"; then
- ac_im_usrlibdir=$ac_im_libdir; break
- fi
- done
- # Screen out bogus values from the imake configuration. They are
- # bogus both because they are the default anyway, and because
- # using them would break gcc on systems where it needs fixed includes.
- case $ac_im_incroot in
- /usr/include) ac_x_includes= ;;
- *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;;
- esac
- case $ac_im_usrlibdir in
- /usr/lib | /usr/lib64 | /lib | /lib64) ;;
- *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;;
- esac
- fi
- cd ..
- rm -f -r conftest.dir
-fi
-
-# Standard set of common directories for X headers.
-# Check X11 before X11Rn because it is often a symlink to the current release.
-ac_x_header_dirs='
-/usr/X11/include
-/usr/X11R7/include
-/usr/X11R6/include
-/usr/X11R5/include
-/usr/X11R4/include
-
-/usr/include/X11
-/usr/include/X11R7
-/usr/include/X11R6
-/usr/include/X11R5
-/usr/include/X11R4
-
-/usr/local/X11/include
-/usr/local/X11R7/include
-/usr/local/X11R6/include
-/usr/local/X11R5/include
-/usr/local/X11R4/include
-
-/usr/local/include/X11
-/usr/local/include/X11R7
-/usr/local/include/X11R6
-/usr/local/include/X11R5
-/usr/local/include/X11R4
-
-/usr/X386/include
-/usr/x386/include
-/usr/XFree86/include/X11
-
-/usr/include
-/usr/local/include
-/usr/unsupported/include
-/usr/athena/include
-/usr/local/x11r5/include
-/usr/lpp/Xamples/include
-
-/usr/openwin/include
-/usr/openwin/share/include'
-
-if test "$ac_x_includes" = no; then
- # Guess where to find include files, by looking for Xlib.h.
- # First, try using that file with no special directory specified.
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <X11/Xlib.h>
-_ACEOF
-if ac_fn_c_try_cpp "$LINENO"; then :
- # We can compile using X headers with no special include directory.
-ac_x_includes=
-else
- for ac_dir in $ac_x_header_dirs; do
- if test -r "$ac_dir/X11/Xlib.h"; then
- ac_x_includes=$ac_dir
- break
- fi
-done
-fi
-rm -f conftest.err conftest.i conftest.$ac_ext
-fi # $ac_x_includes = no
-
-if test "$ac_x_libraries" = no; then
- # Check for the libraries.
- # See if we find them without any special options.
- # Don't add to $LIBS permanently.
- ac_save_LIBS=$LIBS
- LIBS="-lX11 $LIBS"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <X11/Xlib.h>
-int
-main ()
-{
-XrmInitialize ()
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- LIBS=$ac_save_LIBS
-# We can link X programs with no special library path.
-ac_x_libraries=
-else
- LIBS=$ac_save_LIBS
-for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g`
-do
- # Don't even attempt the hair of trying to link an X program!
- for ac_extension in a so sl dylib la dll; do
- if test -r "$ac_dir/libX11.$ac_extension"; then
- ac_x_libraries=$ac_dir
- break 2
- fi
- done
-done
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi # $ac_x_libraries = no
-
-case $ac_x_includes,$ac_x_libraries in #(
- no,* | *,no | *\'*)
- # Didn't find X, or a directory has "'" in its name.
- ac_cv_have_x="have_x=no";; #(
- *)
- # Record where we found X for the cache.
- ac_cv_have_x="have_x=yes\
- ac_x_includes='$ac_x_includes'\
- ac_x_libraries='$ac_x_libraries'"
-esac
-fi
-;; #(
- *) have_x=yes;;
- esac
- eval "$ac_cv_have_x"
-fi # $with_x != no
-
-if test "$have_x" != yes; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5
-$as_echo "$have_x" >&6; }
- no_x=yes
-else
- # If each of the values was on the command line, it overrides each guess.
- test "x$x_includes" = xNONE && x_includes=$ac_x_includes
- test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
- # Update the cache value to reflect the command line values.
- ac_cv_have_x="have_x=yes\
- ac_x_includes='$x_includes'\
- ac_x_libraries='$x_libraries'"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5
-$as_echo "libraries $x_libraries, headers $x_includes" >&6; }
-fi
-
-if test "$no_x" = yes; then
- # Not all programs may use this symbol, but it does not hurt to define it.
-
-$as_echo "#define X_DISPLAY_MISSING 1" >>confdefs.h
-
- X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS=
-else
- if test -n "$x_includes"; then
- X_CFLAGS="$X_CFLAGS -I$x_includes"
- fi
-
- # It would also be nice to do this for all -L options, not just this one.
- if test -n "$x_libraries"; then
- X_LIBS="$X_LIBS -L$x_libraries"
- # For Solaris; some versions of Sun CC require a space after -R and
- # others require no space. Words are not sufficient . . . .
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -R must be followed by a space" >&5
-$as_echo_n "checking whether -R must be followed by a space... " >&6; }
- ac_xsave_LIBS=$LIBS; LIBS="$LIBS -R$x_libraries"
- ac_xsave_c_werror_flag=$ac_c_werror_flag
- ac_c_werror_flag=yes
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- X_LIBS="$X_LIBS -R$x_libraries"
-else
- LIBS="$ac_xsave_LIBS -R $x_libraries"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-int
-main ()
-{
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- X_LIBS="$X_LIBS -R $x_libraries"
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: neither works" >&5
-$as_echo "neither works" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- ac_c_werror_flag=$ac_xsave_c_werror_flag
- LIBS=$ac_xsave_LIBS
- fi
-
- # Check for system-dependent libraries X programs must link with.
- # Do this before checking for the system-independent R6 libraries
- # (-lICE), since we may need -lsocket or whatever for X linking.
-
- if test "$ISC" = yes; then
- X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet"
- else
- # Martyn Johnson says this is needed for Ultrix, if the X
- # libraries were built with DECnet support. And Karl Berry says
- # the Alpha needs dnet_stub (dnet does not exist).
- ac_xsave_LIBS="$LIBS"; LIBS="$LIBS $X_LIBS -lX11"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XOpenDisplay ();
-int
-main ()
-{
-return XOpenDisplay ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5
-$as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; }
-if ${ac_cv_lib_dnet_dnet_ntoa+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ldnet $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char dnet_ntoa ();
-int
-main ()
-{
-return dnet_ntoa ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_dnet_dnet_ntoa=yes
-else
- ac_cv_lib_dnet_dnet_ntoa=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5
-$as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; }
-if test "x$ac_cv_lib_dnet_dnet_ntoa" = xyes; then :
- X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet"
-fi
-
- if test $ac_cv_lib_dnet_dnet_ntoa = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet_stub" >&5
-$as_echo_n "checking for dnet_ntoa in -ldnet_stub... " >&6; }
-if ${ac_cv_lib_dnet_stub_dnet_ntoa+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-ldnet_stub $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char dnet_ntoa ();
-int
-main ()
-{
-return dnet_ntoa ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_dnet_stub_dnet_ntoa=yes
-else
- ac_cv_lib_dnet_stub_dnet_ntoa=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_stub_dnet_ntoa" >&5
-$as_echo "$ac_cv_lib_dnet_stub_dnet_ntoa" >&6; }
-if test "x$ac_cv_lib_dnet_stub_dnet_ntoa" = xyes; then :
- X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub"
-fi
-
- fi
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- LIBS="$ac_xsave_LIBS"
-
- # msh at cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT,
- # to get the SysV transport functions.
- # Chad R. Larson says the Pyramis MIS-ES running DC/OSx (SVR4)
- # needs -lnsl.
- # The nsl library prevents programs from opening the X display
- # on Irix 5.2, according to T.E. Dickey.
- # The functions gethostbyname, getservbyname, and inet_addr are
- # in -lbsd on LynxOS 3.0.1/i386, according to Lars Hecking.
- ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname"
-if test "x$ac_cv_func_gethostbyname" = xyes; then :
-
-fi
-
- if test $ac_cv_func_gethostbyname = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5
-$as_echo_n "checking for gethostbyname in -lnsl... " >&6; }
-if ${ac_cv_lib_nsl_gethostbyname+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lnsl $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gethostbyname ();
-int
-main ()
-{
-return gethostbyname ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_nsl_gethostbyname=yes
-else
- ac_cv_lib_nsl_gethostbyname=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5
-$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; }
-if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then :
- X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl"
-fi
-
- if test $ac_cv_lib_nsl_gethostbyname = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lbsd" >&5
-$as_echo_n "checking for gethostbyname in -lbsd... " >&6; }
-if ${ac_cv_lib_bsd_gethostbyname+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lbsd $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gethostbyname ();
-int
-main ()
-{
-return gethostbyname ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_bsd_gethostbyname=yes
-else
- ac_cv_lib_bsd_gethostbyname=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_gethostbyname" >&5
-$as_echo "$ac_cv_lib_bsd_gethostbyname" >&6; }
-if test "x$ac_cv_lib_bsd_gethostbyname" = xyes; then :
- X_EXTRA_LIBS="$X_EXTRA_LIBS -lbsd"
-fi
-
- fi
- fi
-
- # lieder at skyler.mavd.honeywell.com says without -lsocket,
- # socket/setsockopt and other routines are undefined under SCO ODT
- # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary
- # on later versions), says Simon Leinen: it contains gethostby*
- # variants that don't use the name server (or something). -lsocket
- # must be given before -lnsl if both are needed. We assume that
- # if connect needs -lnsl, so does gethostbyname.
- ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect"
-if test "x$ac_cv_func_connect" = xyes; then :
-
-fi
-
- if test $ac_cv_func_connect = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for connect in -lsocket" >&5
-$as_echo_n "checking for connect in -lsocket... " >&6; }
-if ${ac_cv_lib_socket_connect+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lsocket $X_EXTRA_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char connect ();
-int
-main ()
-{
-return connect ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_socket_connect=yes
-else
- ac_cv_lib_socket_connect=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_connect" >&5
-$as_echo "$ac_cv_lib_socket_connect" >&6; }
-if test "x$ac_cv_lib_socket_connect" = xyes; then :
- X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS"
-fi
-
- fi
-
- # Guillermo Gomez says -lposix is necessary on A/UX.
- ac_fn_c_check_func "$LINENO" "remove" "ac_cv_func_remove"
-if test "x$ac_cv_func_remove" = xyes; then :
-
-fi
-
- if test $ac_cv_func_remove = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for remove in -lposix" >&5
-$as_echo_n "checking for remove in -lposix... " >&6; }
-if ${ac_cv_lib_posix_remove+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lposix $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char remove ();
-int
-main ()
-{
-return remove ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_posix_remove=yes
-else
- ac_cv_lib_posix_remove=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_posix_remove" >&5
-$as_echo "$ac_cv_lib_posix_remove" >&6; }
-if test "x$ac_cv_lib_posix_remove" = xyes; then :
- X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix"
-fi
-
- fi
-
- # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay.
- ac_fn_c_check_func "$LINENO" "shmat" "ac_cv_func_shmat"
-if test "x$ac_cv_func_shmat" = xyes; then :
-
-fi
-
- if test $ac_cv_func_shmat = no; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shmat in -lipc" >&5
-$as_echo_n "checking for shmat in -lipc... " >&6; }
-if ${ac_cv_lib_ipc_shmat+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lipc $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char shmat ();
-int
-main ()
-{
-return shmat ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_ipc_shmat=yes
-else
- ac_cv_lib_ipc_shmat=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ipc_shmat" >&5
-$as_echo "$ac_cv_lib_ipc_shmat" >&6; }
-if test "x$ac_cv_lib_ipc_shmat" = xyes; then :
- X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc"
-fi
-
- fi
- fi
-
- # Check for libraries that X11R6 Xt/Xaw programs need.
- ac_save_LDFLAGS=$LDFLAGS
- test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries"
- # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to
- # check for ICE first), but we must link in the order -lSM -lICE or
- # we get undefined symbols. So assume we have SM if we have ICE.
- # These have to be linked with before -lX11, unlike the other
- # libraries we check for below, so use a different variable.
- # John Interrante, Karl Berry
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for IceConnectionNumber in -lICE" >&5
-$as_echo_n "checking for IceConnectionNumber in -lICE... " >&6; }
-if ${ac_cv_lib_ICE_IceConnectionNumber+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lICE $X_EXTRA_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char IceConnectionNumber ();
-int
-main ()
-{
-return IceConnectionNumber ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_ICE_IceConnectionNumber=yes
-else
- ac_cv_lib_ICE_IceConnectionNumber=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ICE_IceConnectionNumber" >&5
-$as_echo "$ac_cv_lib_ICE_IceConnectionNumber" >&6; }
-if test "x$ac_cv_lib_ICE_IceConnectionNumber" = xyes; then :
- X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE"
-fi
-
- LDFLAGS=$ac_save_LDFLAGS
-
-fi
-
-
-if test "$with_motif" = no && test "$with_gtk" = no ; then
- with_no_gui=yes
-fi
-
-if test "$with_motif" = yes && test "$with_gtk" = yes ; then
- with_gtk=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: You asked for both Motif and Gtk -- Motif will be used" >&5
-$as_echo "$as_me: WARNING: You asked for both Motif and Gtk -- Motif will be used" >&2;}
-fi
-
-if test "$with_no_gui" = yes ; then
-
- $as_echo "#define USE_NO_GUI 1" >>confdefs.h
-
- XLIBS=""
- XFLAGS=""
-
-
- GX_FILES="NO_GUI_O_FILES"
- GX_HEADERS="NO_GUI_HEADERS"
-
-else
-
- # can we have gtk without X in mingw? -- depend on fixup around line 1030, I guess
-
- if test "$no_x" != yes; then
-
- $as_echo "#define HAVE_X 1" >>confdefs.h
-
- XFLAGS="$X_CFLAGS"
- X_POST_LIBS="-lX11 $X_EXTRA_LIBS"
-
- case "$host" in
- *-apple-*)
- X_POST_LIBS="$X_POST_LIBS -lSM -lICE"
- ;;
- esac
-
- # this needs to precede the Xm check
- TEST_PRE_LIBS="$X_LIBS $X_PRE_LIBS"
- TEST_POST_LIBS="$X_POST_LIBS"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XShapeQueryExtension in -lXext" >&5
-$as_echo_n "checking for XShapeQueryExtension in -lXext... " >&6; }
-if ${ac_cv_lib_Xext_XShapeQueryExtension+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXext $TEST_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XShapeQueryExtension ();
-int
-main ()
-{
-return XShapeQueryExtension ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xext_XShapeQueryExtension=yes
-else
- ac_cv_lib_Xext_XShapeQueryExtension=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xext_XShapeQueryExtension" >&5
-$as_echo "$ac_cv_lib_Xext_XShapeQueryExtension" >&6; }
-if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = xyes; then :
-
- X_POST_LIBS="$X_POST_LIBS -lXext"
- TEST_POST_LIBS="$TEST_POST_LIBS -lXext"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
- $as_echo "#define HAVE_XSHAPEQUERYEXTENSION 1" >>confdefs.h
-
-
-fi
-
-
- # search for libXp and libXm may need libXft so...
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XftFontOpen in -lXft" >&5
-$as_echo_n "checking for XftFontOpen in -lXft... " >&6; }
-if ${ac_cv_lib_Xft_XftFontOpen+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXft $TEST_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XftFontOpen ();
-int
-main ()
-{
-return XftFontOpen ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xft_XftFontOpen=yes
-else
- ac_cv_lib_Xft_XftFontOpen=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xft_XftFontOpen" >&5
-$as_echo "$ac_cv_lib_Xft_XftFontOpen" >&6; }
-if test "x$ac_cv_lib_Xft_XftFontOpen" = xyes; then :
-
- X_PRE_LIBS="$X_PRE_LIBS -lXft"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXft"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
-
-fi
-
-
- if test "$with_static_motif" = yes ; then
- if test x$motif_prefix != x ; then
- as_ac_File=`$as_echo "ac_cv_file_$motif_prefix/lib/libXm.a" | $as_tr_sh`
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $motif_prefix/lib/libXm.a" >&5
-$as_echo_n "checking for $motif_prefix/lib/libXm.a... " >&6; }
-if eval \${$as_ac_File+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- test "$cross_compiling" = yes &&
- as_fn_error $? "cannot check for file existence when cross compiling" "$LINENO" 5
-if test -r "$motif_prefix/lib/libXm.a"; then
- eval "$as_ac_File=yes"
-else
- eval "$as_ac_File=no"
-fi
-fi
-eval ac_res=\$$as_ac_File
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
-if eval test \"x\$"$as_ac_File"\" = x"yes"; then :
-
- X_PRE_LIBS="$motif_prefix/lib/libXm.a $X_LIBS $X_PRE_LIBS -lXt"
- XFLAGS="-I$motif_prefix/include $XFLAGS"
-
-else
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find $motif_prefix/lib/libXm.a!" >&5
-$as_echo "$as_me: WARNING: can't find $motif_prefix/lib/libXm.a!" >&2;}
- X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -lXm -lXt"
-
-fi
-
- else
- as_ac_File=`$as_echo "ac_cv_file_$x_libraries/libXm.a" | $as_tr_sh`
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $x_libraries/libXm.a" >&5
-$as_echo_n "checking for $x_libraries/libXm.a... " >&6; }
-if eval \${$as_ac_File+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- test "$cross_compiling" = yes &&
- as_fn_error $? "cannot check for file existence when cross compiling" "$LINENO" 5
-if test -r "$x_libraries/libXm.a"; then
- eval "$as_ac_File=yes"
-else
- eval "$as_ac_File=no"
-fi
-fi
-eval ac_res=\$$as_ac_File
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
-if eval test \"x\$"$as_ac_File"\" = x"yes"; then :
-
- X_PRE_LIBS="$x_libraries/libXm.a $X_LIBS $X_PRE_LIBS -lXt"
-
-else
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find $x_libraries/libXm.a!" >&5
-$as_echo "$as_me: WARNING: can't find $x_libraries/libXm.a!" >&2;}
- X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -lXm -lXt"
-
-fi
-
- fi
- else
- if test x$motif_prefix != x ; then
- X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -L$motif_prefix/lib -lXm -lXt"
- XFLAGS="-I$motif_prefix/include $XFLAGS"
- else
- X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -lXm -lXt"
- fi
- fi
-
- TEST_PRE_LIBS="$X_LIBS $X_PRE_LIBS"
- TEST_POST_LIBS="$X_POST_LIBS"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
-
- GX_FILES="X_O_FILES"
- GX_HEADERS="SND_X_HEADERS"
-
- fi
-
- if test "$with_gtk" != yes && test "$with_motif" != no ; then
-
- SAVELIBS=$LIBS
- SAVEFLAGS=$CFLAGS
-
- # search for libXm will fail with Xp complaints in Linux, so we need to search for -lXp first
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpGetDocumentData in -lXp" >&5
-$as_echo_n "checking for XpGetDocumentData in -lXp... " >&6; }
-if ${ac_cv_lib_Xp_XpGetDocumentData+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXp $TEST_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XpGetDocumentData ();
-int
-main ()
-{
-return XpGetDocumentData ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xp_XpGetDocumentData=yes
-else
- ac_cv_lib_Xp_XpGetDocumentData=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xp_XpGetDocumentData" >&5
-$as_echo "$ac_cv_lib_Xp_XpGetDocumentData" >&6; }
-if test "x$ac_cv_lib_Xp_XpGetDocumentData" = xyes; then :
-
- X_PRE_LIBS="$X_PRE_LIBS -lXp"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXp"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
-
-fi
-
-
- LIBS="$LIBS $X_PRE_LIBS $X_POST_LIBS"
- CFLAGS="$CFLAGS $XFLAGS"
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether libXm requires libpng etc" >&5
-$as_echo_n "checking whether libXm requires libpng etc... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XmCreateForm ();
-int
-main ()
-{
-return XmCreateForm ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-else
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- X_PRE_LIBS="$X_PRE_LIBS -lXmu -L/usr/local/lib -liconv -lpng -ljpeg"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXmu -L/usr/local/lib -liconv -lpng -ljpeg"
-
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- if test "$with_editres" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _XEditResCheckMessages in -lXmu" >&5
-$as_echo_n "checking for _XEditResCheckMessages in -lXmu... " >&6; }
-if ${ac_cv_lib_Xmu__XEditResCheckMessages+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lXmu $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char _XEditResCheckMessages ();
-int
-main ()
-{
-return _XEditResCheckMessages ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_Xmu__XEditResCheckMessages=yes
-else
- ac_cv_lib_Xmu__XEditResCheckMessages=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xmu__XEditResCheckMessages" >&5
-$as_echo "$ac_cv_lib_Xmu__XEditResCheckMessages" >&6; }
-if test "x$ac_cv_lib_Xmu__XEditResCheckMessages" = xyes; then :
- $as_echo "#define MUS_WITH_EDITRES 1" >>confdefs.h
-
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES editres"
- X_PRE_LIBS="$X_PRE_LIBS -lXmu"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXmu"
-
-fi
-
- else
- # need to check for -lXmu required by (buggy) libXm.a (openmotif 2.2.2)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether libXm requires libXmu" >&5
-$as_echo_n "checking whether libXm requires libXmu... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XmCreateForm ();
-int
-main ()
-{
-return XmCreateForm ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-else
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- X_PRE_LIBS="$X_PRE_LIBS -lXmu"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXmu"
-
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- fi
-
- XLIBS="$X_PRE_LIBS $X_POST_LIBS"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmCreateForm in -lm" >&5
-$as_echo_n "checking for XmCreateForm in -lm... " >&6; }
-if ${ac_cv_lib_m_XmCreateForm+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $TEST_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char XmCreateForm ();
-int
-main ()
-{
-return XmCreateForm ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_XmCreateForm=yes
-else
- ac_cv_lib_m_XmCreateForm=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_XmCreateForm" >&5
-$as_echo "$ac_cv_lib_m_XmCreateForm" >&6; }
-if test "x$ac_cv_lib_m_XmCreateForm" = xyes; then :
- # was Xm here but that introduces a bogus -lXm into the load list
-
- with_motif=yes
- ac_snd_have_gui=yes
-
- XLIBS="$XLIBS -lXpm"
- TEST_LIBS="$TEST_LIBS -lXpm"
-
- if test "$with_static_xm" = yes ; then
- GX_FILES="XM_O_FILES"
- $as_echo "#define HAVE_STATIC_XM 1" >>confdefs.h
-
- fi
-
-
-
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmDataField" >&5
-$as_echo_n "checking for XmDataField... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/DataF.h>
-int
-main ()
-{
- Widget w;
- w = XmCreateDataField(NULL, "data-field", NULL, 0)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define HAVE_XmCreateDataField 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmButtonBox" >&5
-$as_echo_n "checking for XmButtonBox... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/ButtonBox.h>
-int
-main ()
-{
- Widget w; int i; i = XmIconTop;
- w = XmCreateButtonBox(NULL, "button-box", NULL, 0)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define HAVE_XmCreateButtonBox 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmTabStack" >&5
-$as_echo_n "checking for XmTabStack... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/TabStack.h>
-int
-main ()
-{
- Widget w, w1, w2;
- w = XmCreateTabStack(NULL, "tab-stack", NULL, 0);
- /* w1 = XmTabStackXYToWidget(w, 0, 0); */
- w2 = XmTabStackIndexToWidget(w, 0)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define HAVE_XmCreateTabStack 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmTabStackXYToWidget" >&5
-$as_echo_n "checking for XmTabStackXYToWidget... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/TabStack.h>
-int
-main ()
-{
- Widget w, w1, w2;
- w = XmCreateTabStack(NULL, "tab-stack", NULL, 0);
- w1 = XmTabStackXYToWidget(w, 0, 0)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define HAVE_XmTabStackXYToWidget 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmColumn" >&5
-$as_echo_n "checking for XmColumn... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/Column.h>
-int
-main ()
-{
- Widget w;
- w = XmCreateColumn(NULL, "column", NULL, 0)
- /* w = XmColumnGetChildLabel(w) */
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define HAVE_XmCreateColumn 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmColumnGetChildLabel" >&5
-$as_echo_n "checking for XmColumnGetChildLabel... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/Column.h>
-int
-main ()
-{
- Widget w;
- w = XmCreateColumn(NULL, "column", NULL, 0);
- w = XmColumnGetChildLabel(w)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
-
- $as_echo "#define HAVE_XmColumnGetChildLabel 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmDropDown" >&5
-$as_echo_n "checking for XmDropDown... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/DropDown.h>
-int
-main ()
-{
- Widget w;
- w = XmCreateDropDown(NULL, "drop-down", NULL, 0)
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- $as_echo "#define HAVE_XmCreateDropDown 1" >>confdefs.h
+MAKE_TARGET="snd"
+AUDIO_SYSTEM="None"
+RANDOM_FEATURES=""
+OPTIONAL_LIBRARIES=""
+LOCAL_LANGUAGE="None"
+GRAPHICS_TOOLKIT="None"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+PACKAGE=Snd
+VERSION=16.1
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+#--------------------------------------------------------------------------------
+# configuration options
+# --with-motif use Motif (the default)
+# --with-gtk use Gtk+
+# --with-alsa use ALSA if possible (the default)
+# --with-oss use OSS
+# --with-jack use Jack
+# --without-audio stub out all audio
+# --with-gmp include multiprecision arithmetic via gmp, mpfr, and mpc
+# --disable-deprecated do not include any deprecated stuff (in gtk, motif, s7, sndlib, clm, etc)
+# --with-ladspa include LADSPA plugin support (Linux)
+# --with-gui make Snd with(out) any graphics support
+# --with-forth use Forth as the extension language
+# --with-ruby use Ruby as the extension language
+# --with-s7 use S7 as the extension language (default = yes)
+# --with-extension-language use some extension language (default=yes)
+# --with-temp-dir directory to use for temp files
+# --with-save-dir directory to use for saved-state files
+# --with-doc-dir directory to search for documentation
+# --with-gl include OpenGL support (default=no, Motif only)
+# --with-gl2ps include gl2ps (Motif only)
+# --with-editres include EditRes in xm
+# --without-gsl omit GSL even if it exists
+# --without-fftw omit FFTW even if it exists
+# --with-pulseaudio use PulseAudio
+# --with-portaudio use portaudio
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmCreateFontSelector" >&5
-$as_echo_n "checking for XmCreateFontSelector... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/FontS.h>
-int
-main ()
-{
- Widget w;
- w = XmCreateFontSelector(NULL, "font-selector", NULL, 0)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- $as_echo "#define HAVE_XmCreateFontSelector 1" >>confdefs.h
+# Check whether --with-gtk was given.
+if test "${with_gtk+set}" = set; then :
+ withval=$with_gtk;
+fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+# Check whether --with-gui was given.
+if test "${with_gui+set}" = set; then :
+ withval=$with_gui;
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmCreateColorSelector" >&5
-$as_echo_n "checking for XmCreateColorSelector... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
- #include <Xm/ColorS.h>
-int
-main ()
-{
- Widget w;
- w = XmCreateColorSelector(NULL, "color-selector", NULL, 0)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
+# Check whether --with-gl was given.
+if test "${with_gl+set}" = set; then :
+ withval=$with_gl;
+fi
- $as_echo "#define HAVE_XmCreateColorSelector 1" >>confdefs.h
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+# Check whether --with-gl2ps was given.
+if test "${with_gl2ps+set}" = set; then :
+ withval=$with_gl2ps;
+fi
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+
+# Check whether --with-motif was given.
+if test "${with_motif+set}" = set; then :
+ withval=$with_motif;
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmToolTipGetLabel" >&5
-$as_echo_n "checking for XmToolTipGetLabel... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
-int
-main ()
-{
- Widget w = NULL;
- w = XmToolTipGetLabel(w)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
+# Check whether --with-editres was given.
+if test "${with_editres+set}" = set; then :
+ withval=$with_editres;
+fi
- $as_echo "#define HAVE_XmToolTipGetLabel 1" >>confdefs.h
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+# Check whether --with-alsa was given.
+if test "${with_alsa+set}" = set; then :
+ withval=$with_alsa;
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether sashes support relative panes" >&5
-$as_echo_n "checking whether sashes support relative panes... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/SashP.h>
-int
-main ()
-{
- Widget w; int happy = 0;
- SashCallData call_data;
- if ((XtIsSubclass(w, xmSashWidgetClass)) &&
- (strcmp(call_data->params[0], "Start") == 0)) {happy = 1;}
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- $as_echo "#define WITH_RELATIVE_PANES 1" >>confdefs.h
+# Check whether --with-oss was given.
+if test "${with_oss+set}" = set; then :
+ withval=$with_oss;
+fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+# Check whether --with-jack was given.
+if test "${with_jack+set}" = set; then :
+ withval=$with_jack;
+fi
- # perhaps the user hasn't installed the Motif headers?
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Motif headers" >&5
-$as_echo_n "checking for Motif headers... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <Xm/XmAll.h>
-int
-main ()
-{
- Widget w;
- w = XmCreateForm(NULL, "form", NULL, 0)
+# Check whether --with-ladspa was given.
+if test "${with_ladspa+set}" = set; then :
+ withval=$with_ladspa;
+fi
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the Motif headers! These are in openmotif-devel or some such package, or perhaps you need to include the --with-motif-prefix switch: --with-motif-prefix=/usr/pkg for example -- I will look for Gtk" >&5
-$as_echo "$as_me: WARNING: can't find the Motif headers! These are in openmotif-devel or some such package, or perhaps you need to include the --with-motif-prefix switch: --with-motif-prefix=/usr/pkg for example -- I will look for Gtk" >&2;}
- with_gtk=yes
- with_motif=no
+# Check whether --with-pulseaudio was given.
+if test "${with_pulseaudio+set}" = set; then :
+ withval=$with_pulseaudio;
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+# Check whether --with-portaudio was given.
+if test "${with_portaudio+set}" = set; then :
+ withval=$with_portaudio;
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the Motif library! -- will look for Gtk" >&5
-$as_echo "$as_me: WARNING: can't find the Motif library! -- will look for Gtk" >&2;}
- with_gtk=yes
- with_motif=no
+# Check whether --with-extension-language was given.
+if test "${with_extension_language+set}" = set; then :
+ withval=$with_extension_language;
fi
- LIBS=$SAVELIBS
- CFLAGS=$SAVEFLAGS
- else
- if test "$with_gtk" != no ; then
- with_gtk=yes
- fi
- fi
+# Check whether --with-s7 was given.
+if test "${with_s7+set}" = set; then :
+ withval=$with_s7;
+fi
- if test "$with_motif" = yes ; then
- $as_echo "#define USE_MOTIF 1" >>confdefs.h
- # for Snd
- $as_echo "#define HAVE_MOTIF 1" >>confdefs.h
- # for xm
- GRAPHICS_TOOLKIT="Motif"
- fi
+# Check whether --with-forth was given.
+if test "${with_forth+set}" = set; then :
+ withval=$with_forth;
+fi
-#--------------------------------------------------------------------------------
-# Gtk
-#--------------------------------------------------------------------------------
- if test "$with_gtk" = yes ; then
+# Check whether --with-ruby was given.
+if test "${with_ruby+set}" = set; then :
+ withval=$with_ruby;
+fi
- if test x$PKG_CONFIG != xno ; then
- if $PKG_CONFIG gtk+-3.0 --exists ; then
- pkg_config_args=gtk+-3.0
- for module in .
- do
- case "$module" in
- gthread)
- pkg_config_args="$pkg_config_args gthread-3.0"
- ;;
- esac
- done
- no_gtk=""
+# Check whether --with-gsl was given.
+if test "${with_gsl+set}" = set; then :
+ withval=$with_gsl;
+fi
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PKG_CONFIG+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
+# Check whether --with-fftw was given.
+if test "${with_fftw+set}" = set; then :
+ withval=$with_fftw;
fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+
+
+# Check whether --with-gmp was given.
+if test "${with_gmp+set}" = set; then :
+ withval=$with_gmp;
fi
+# Check whether --with-audio was given.
+if test "${with_audio+set}" = set; then :
+ withval=$with_audio;
+fi
- if test x$PKG_CONFIG != xno ; then
- if pkg-config --atleast-pkgconfig-version 0.7 ; then
- :
- else
- echo *** pkg-config too old; version 0.7 or better required.
- no_gtk=yes
- PKG_CONFIG=no
- fi
- else
- no_gtk=yes
- fi
- min_gtk_version=2.90.0
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTK+ - version >= $min_gtk_version" >&5
-$as_echo_n "checking for GTK+ - version >= $min_gtk_version... " >&6; }
- if test x$PKG_CONFIG != xno ; then
- ## don't try to run the test against uninstalled libtool libs
- if $PKG_CONFIG --uninstalled $pkg_config_args; then
- echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH"
- fi
+# Check whether --with-temp-dir was given.
+if test "${with_temp_dir+set}" = set; then :
+ withval=$with_temp_dir; cat >>confdefs.h <<_ACEOF
+#define MUS_DEFAULT_TEMP_DIR "${withval}"
+_ACEOF
- if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then
- :
- else
- no_gtk=yes
- fi
- fi
+fi
- if test x"$no_gtk" = x ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags`
- GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs`
- gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\1/'`
- gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\2/'`
- gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-3.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\3/'`
- with_gtk=yes
+# Check whether --with-save-dir was given.
+if test "${with_save_dir+set}" = set; then :
+ withval=$with_save_dir; cat >>confdefs.h <<_ACEOF
+#define MUS_DEFAULT_SAVE_DIR "${withval}"
+_ACEOF
+fi
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+# Check whether --with-doc-dir was given.
+if test "${with_doc_dir+set}" = set; then :
+ withval=$with_doc_dir; cat >>confdefs.h <<_ACEOF
+#define MUS_DEFAULT_DOC_DIR "${withval}"
+_ACEOF
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&5
-$as_echo "$as_me: WARNING: trouble with gtk -- will try to make Snd without any GUI" >&2;}
- with_gtk=no
+fi
- fi
- else
+# Check whether --enable-deprecated was given.
+if test "${enable_deprecated+set}" = set; then :
+ enableval=$enable_deprecated;
+fi
- pkg_config_args=gtk+-2.0
- for module in .
- do
- case "$module" in
- gthread)
- pkg_config_args="$pkg_config_args gthread-2.0"
- ;;
- esac
- done
- no_gtk=""
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PKG_CONFIG+:} false; then :
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+ if ${ac_cv_prog_CPP+:} false; then :
$as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
+ # Double quotes because CPP needs to be expanded
+ for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+ do
+ ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+ Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
-esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ # Broken: fails on valid input.
+continue
fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+ # OK, works on sane cases. Now check whether nonexistent headers
+ # can be detected and how.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ # Broken: success on invalid input.
+continue
+else
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+ break
+fi
- if test x$PKG_CONFIG != xno ; then
- if pkg-config --atleast-pkgconfig-version 0.7 ; then
- :
- else
- echo *** pkg-config too old; version 0.7 or better required.
- no_gtk=yes
- PKG_CONFIG=no
- fi
- else
- no_gtk=yes
- fi
-
- min_gtk_version=2.12.0
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTK+ - version >= $min_gtk_version" >&5
-$as_echo_n "checking for GTK+ - version >= $min_gtk_version... " >&6; }
-
- if test x$PKG_CONFIG != xno ; then
- ## don't try to run the test against uninstalled libtool libs
- if $PKG_CONFIG --uninstalled $pkg_config_args; then
- echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH"
- fi
-
- if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then
- :
- else
- no_gtk=yes
- fi
- fi
-
- if test x"$no_gtk" = x ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags`
- GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs`
- gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\1/'`
- gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\2/'`
- gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\3/'`
-
- with_gtk=yes
-
+ done
+ ac_cv_prog_CPP=$CPP
+fi
+ CPP=$ac_cv_prog_CPP
+else
+ ac_cv_prog_CPP=$CPP
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+ Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+else
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: trouble with gtk (we need version 2.12.0 or later) -- will try to make Snd without any GUI" >&5
-$as_echo "$as_me: WARNING: trouble with gtk (we need version 2.12.0 or later) -- will try to make Snd without any GUI" >&2;}
- with_gtk=no
+ # OK, works on sane cases. Now check whether nonexistent headers
+ # can be detected and how.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ # Broken: success on invalid input.
+continue
+else
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
- fi
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
- fi
+else
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details" "$LINENO" 5; }
+fi
- else
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
- pkg_config_args=gtk+-2.0
- for module in .
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if ${ac_cv_path_GREP+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -z "$GREP"; then
+ ac_path_GREP_found=false
+ # Loop through the user's path and test for each of PROGNAME-LIST
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in grep ggrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+ as_fn_executable_p "$ac_path_GREP" || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+ # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+ ac_count=0
+ $as_echo_n 0123456789 >"conftest.in"
+ while :
do
- case "$module" in
- gthread)
- pkg_config_args="$pkg_config_args gthread-2.0"
- ;;
- esac
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ $as_echo 'GREP' >> "conftest.nl"
+ "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ as_fn_arith $ac_count + 1 && ac_count=$as_val
+ if test $ac_count -gt ${ac_path_GREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_GREP="$ac_path_GREP"
+ ac_path_GREP_max=$ac_count
+ fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+ $ac_path_GREP_found && break 3
+ done
done
+ done
+IFS=$as_save_IFS
+ if test -z "$ac_cv_path_GREP"; then
+ as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+ fi
+else
+ ac_cv_path_GREP=$GREP
+fi
- no_gtk=""
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
- # Extract the first word of "pkg-config", so it can be a program name with args.
-set dummy pkg-config; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PKG_CONFIG+:} false; then :
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if ${ac_cv_path_EGREP+:} false; then :
$as_echo_n "(cached) " >&6
else
- case $PKG_CONFIG in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
- ;;
- *)
+ if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+ then ac_cv_path_EGREP="$GREP -E"
+ else
+ if test -z "$EGREP"; then
+ ac_path_EGREP_found=false
+ # Loop through the user's path and test for each of PROGNAME-LIST
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
+ for ac_prog in egrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
+ ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+ as_fn_executable_p "$ac_path_EGREP" || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+ # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+ ac_count=0
+ $as_echo_n 0123456789 >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ $as_echo 'EGREP' >> "conftest.nl"
+ "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ as_fn_arith $ac_count + 1 && ac_count=$as_val
+ if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_EGREP="$ac_path_EGREP"
+ ac_path_EGREP_max=$ac_count
+ fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
- ;;
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac
-fi
-PKG_CONFIG=$ac_cv_path_PKG_CONFIG
-if test -n "$PKG_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
-$as_echo "$PKG_CONFIG" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
- if test x$PKG_CONFIG != xno ; then
- if pkg-config --atleast-pkgconfig-version 0.7 ; then
- :
- else
- echo *** pkg-config too old; version 0.7 or better required.
- no_gtk=yes
- PKG_CONFIG=no
- fi
- else
- no_gtk=yes
- fi
-
- min_gtk_version=2.12.0
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTK+ - version >= $min_gtk_version" >&5
-$as_echo_n "checking for GTK+ - version >= $min_gtk_version... " >&6; }
-
- if test x$PKG_CONFIG != xno ; then
- ## don't try to run the test against uninstalled libtool libs
- if $PKG_CONFIG --uninstalled $pkg_config_args; then
- echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH"
- fi
-
- if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then
- :
- else
- no_gtk=yes
- fi
- fi
-
- if test x"$no_gtk" = x ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags`
- GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs`
- gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\1/'`
- gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\2/'`
- gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-2.0 | \
- sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\3/'`
-
- with_gtk=yes
-
-
-
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: trouble with gtk (we need version 2.12.0 or later) -- will try to make Snd without any GUI" >&5
-$as_echo "$as_me: WARNING: trouble with gtk (we need version 2.12.0 or later) -- will try to make Snd without any GUI" >&2;}
- with_gtk=no
+ $ac_path_EGREP_found && break 3
+ done
+ done
+ done
+IFS=$as_save_IFS
+ if test -z "$ac_cv_path_EGREP"; then
+ as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
fi
+else
+ ac_cv_path_EGREP=$EGREP
+fi
- fi
-
- if test "$with_gtk" = yes ; then
- GX_FILES="G_O_FILES"
- GX_HEADERS="SND_G_HEADERS"
-
- case "$host" in
- *-*-solaris*)
- GTK_LIBS="$GTK_LIBS -lX11"
- ;;
- esac
-
-
-
- $as_echo "#define USE_GTK 1" >>confdefs.h
-
- GRAPHICS_TOOLKIT="Gtk"
- ac_snd_have_gui=yes
-
- GTK_LD_LIBS="$GTK_LIBS"
- if test x$PKG_CONFIG != xno ; then
- if $PKG_CONFIG gtk+-3.0 --exists ; then
- if test "$with_directfb" = yes ; then
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-3.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-3.0 --libs-only-l`"
- else
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-3.0 --libs-only-L` `$PKG_CONFIG gtk+-3.0 --libs-only-l`"
- fi
- else
- if test "$with_directfb" = yes ; then
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-2.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-2.0 --libs-only-l`"
- else
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
- fi
- fi
- pango_version="`$PKG_CONFIG pango --modversion`"
- cat >>confdefs.h <<_ACEOF
-#define MUS_PANGO_VERSION "${pango_version}"
-_ACEOF
-
- fi
-
-
-
- if test x$PKG_CONFIG != xno ; then
- CAIRO_CFLAGS="`$PKG_CONFIG cairo --cflags-only-I`"
-
- cairo_version="`$PKG_CONFIG cairo --modversion`"
- cat >>confdefs.h <<_ACEOF
-#define MUS_CAIRO_VERSION "${cairo_version}"
-_ACEOF
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_widget_get_has_tooltip in -lm" >&5
-$as_echo_n "checking for gtk_widget_get_has_tooltip in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_widget_get_has_tooltip+:} false; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if ${ac_cv_header_stdc+:} false; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gtk_widget_get_has_tooltip ();
int
main ()
{
-return gtk_widget_get_has_tooltip ();
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_widget_get_has_tooltip=yes
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_header_stdc=yes
else
- ac_cv_lib_m_gtk_widget_get_has_tooltip=no
+ ac_cv_header_stdc=no
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "memchr" >/dev/null 2>&1; then :
+
+else
+ ac_cv_header_stdc=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_widget_get_has_tooltip" >&5
-$as_echo "$ac_cv_lib_m_gtk_widget_get_has_tooltip" >&6; }
-if test "x$ac_cv_lib_m_gtk_widget_get_has_tooltip" = xyes; then :
- $as_echo "#define HAVE_GTK_WIDGET_GET_HAS_TOOLTIP 1" >>confdefs.h
+rm -f conftest*
fi
- # for 2.13.0
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_test_widget_click in -lm" >&5
-$as_echo_n "checking for gtk_test_widget_click in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_test_widget_click+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+#include <stdlib.h>
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gtk_test_widget_click ();
-int
-main ()
-{
-return gtk_test_widget_click ();
- ;
- return 0;
-}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_test_widget_click=yes
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "free" >/dev/null 2>&1; then :
+
else
- ac_cv_lib_m_gtk_test_widget_click=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+ ac_cv_header_stdc=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_test_widget_click" >&5
-$as_echo "$ac_cv_lib_m_gtk_test_widget_click" >&6; }
-if test "x$ac_cv_lib_m_gtk_test_widget_click" = xyes; then :
- $as_echo "#define HAVE_GTK_TEST_WIDGET_CLICK 1" >>confdefs.h
+rm -f conftest*
fi
- # for 2.13.6 (uses 2134)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_adjustment_get_upper in -lm" >&5
-$as_echo_n "checking for gtk_adjustment_get_upper in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_adjustment_get_upper+:} false; then :
- $as_echo_n "(cached) " >&6
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+ if test "$cross_compiling" = yes; then :
+ :
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
+#include <ctype.h>
+#include <stdlib.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+ (('a' <= (c) && (c) <= 'i') \
+ || ('j' <= (c) && (c) <= 'r') \
+ || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
#endif
-char gtk_adjustment_get_upper ();
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
int
main ()
{
-return gtk_adjustment_get_upper ();
- ;
+ int i;
+ for (i = 0; i < 256; i++)
+ if (XOR (islower (i), ISLOWER (i))
+ || toupper (i) != TOUPPER (i))
+ return 2;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_adjustment_get_upper=yes
+if ac_fn_c_try_run "$LINENO"; then :
+
else
- ac_cv_lib_m_gtk_adjustment_get_upper=no
+ ac_cv_header_stdc=no
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
+
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_adjustment_get_upper" >&5
-$as_echo "$ac_cv_lib_m_gtk_adjustment_get_upper" >&6; }
-if test "x$ac_cv_lib_m_gtk_adjustment_get_upper" = xyes; then :
- $as_echo "#define HAVE_GTK_ADJUSTMENT_GET_UPPER 1" >>confdefs.h
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+ inttypes.h stdint.h unistd.h
+do :
+ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
fi
- # for 2.15.0|1|2|3 and 2.16.0 (uses 2150)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_scale_add_mark in -lm" >&5
-$as_echo_n "checking for gtk_scale_add_mark in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_scale_add_mark+:} false; then :
+done
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
+$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
+if ${ac_cv_c_bigendian+:} false; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_cv_c_bigendian=unknown
+ # See if we're dealing with a universal compiler.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+#ifndef __APPLE_CC__
+ not a universal capable compiler
+ #endif
+ typedef int dummy;
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+ # Check for potential -arch flags. It is not universal unless
+ # there are at least two -arch flags with different values.
+ ac_arch=
+ ac_prev=
+ for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do
+ if test -n "$ac_prev"; then
+ case $ac_word in
+ i?86 | x86_64 | ppc | ppc64)
+ if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then
+ ac_arch=$ac_word
+ else
+ ac_cv_c_bigendian=universal
+ break
+ fi
+ ;;
+ esac
+ ac_prev=
+ elif test "x$ac_word" = "x-arch"; then
+ ac_prev=arch
+ fi
+ done
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test $ac_cv_c_bigendian = unknown; then
+ # See if sys/param.h defines the BYTE_ORDER macro.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <sys/types.h>
+ #include <sys/param.h>
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gtk_scale_add_mark ();
int
main ()
{
-return gtk_scale_add_mark ();
+#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \
+ && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \
+ && LITTLE_ENDIAN)
+ bogus endian macros
+ #endif
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_scale_add_mark=yes
-else
- ac_cv_lib_m_gtk_scale_add_mark=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_scale_add_mark" >&5
-$as_echo "$ac_cv_lib_m_gtk_scale_add_mark" >&6; }
-if test "x$ac_cv_lib_m_gtk_scale_add_mark" = xyes; then :
- $as_echo "#define HAVE_GTK_SCALE_ADD_MARK 1" >>confdefs.h
-
-fi
-
- # for 2.15.1 up to 2.17.2
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_info_bar_new in -lm" >&5
-$as_echo_n "checking for gtk_info_bar_new in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_info_bar_new+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+if ac_fn_c_try_compile "$LINENO"; then :
+ # It does; now see whether it defined to BIG_ENDIAN or not.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+#include <sys/types.h>
+ #include <sys/param.h>
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gtk_info_bar_new ();
int
main ()
{
-return gtk_info_bar_new ();
+#if BYTE_ORDER != BIG_ENDIAN
+ not big endian
+ #endif
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_info_bar_new=yes
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_c_bigendian=yes
else
- ac_cv_lib_m_gtk_info_bar_new=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+ ac_cv_c_bigendian=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_info_bar_new" >&5
-$as_echo "$ac_cv_lib_m_gtk_info_bar_new" >&6; }
-if test "x$ac_cv_lib_m_gtk_info_bar_new" = xyes; then :
- $as_echo "#define HAVE_GTK_INFO_BAR_NEW 1" >>confdefs.h
-
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-
- # for 2.17.3|4|5|6
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_status_icon_get_title in -lm" >&5
-$as_echo_n "checking for gtk_status_icon_get_title in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_status_icon_get_title+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ fi
+ if test $ac_cv_c_bigendian = unknown; then
+ # See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris).
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+#include <limits.h>
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gtk_status_icon_get_title ();
int
main ()
{
-return gtk_status_icon_get_title ();
+#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN)
+ bogus endian macros
+ #endif
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_status_icon_get_title=yes
-else
- ac_cv_lib_m_gtk_status_icon_get_title=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_status_icon_get_title" >&5
-$as_echo "$ac_cv_lib_m_gtk_status_icon_get_title" >&6; }
-if test "x$ac_cv_lib_m_gtk_status_icon_get_title" = xyes; then :
- $as_echo "#define HAVE_GTK_STATUS_ICON_GET_TITLE 1" >>confdefs.h
-
-fi
-
- # for 2.17.7, 2.18.n
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_widget_get_visible in -lm" >&5
-$as_echo_n "checking for gtk_widget_get_visible in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_widget_get_visible+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+if ac_fn_c_try_compile "$LINENO"; then :
+ # It does; now see whether it defined to _BIG_ENDIAN or not.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+#include <limits.h>
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gtk_widget_get_visible ();
int
main ()
{
-return gtk_widget_get_visible ();
+#ifndef _BIG_ENDIAN
+ not big endian
+ #endif
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_widget_get_visible=yes
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_c_bigendian=yes
else
- ac_cv_lib_m_gtk_widget_get_visible=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+ ac_cv_c_bigendian=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_widget_get_visible" >&5
-$as_echo "$ac_cv_lib_m_gtk_widget_get_visible" >&6; }
-if test "x$ac_cv_lib_m_gtk_widget_get_visible" = xyes; then :
- $as_echo "#define HAVE_GTK_WIDGET_GET_VISIBLE 1" >>confdefs.h
-
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-
- # for 2.19.n
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_widget_get_mapped in -lm" >&5
-$as_echo_n "checking for gtk_widget_get_mapped in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_widget_get_mapped+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ fi
+ if test $ac_cv_c_bigendian = unknown; then
+ # Compile a test program.
+ if test "$cross_compiling" = yes; then :
+ # Try to guess by grepping values from an object file.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+short int ascii_mm[] =
+ { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
+ short int ascii_ii[] =
+ { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
+ int use_ascii (int i) {
+ return ascii_mm[i] + ascii_ii[i];
+ }
+ short int ebcdic_ii[] =
+ { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
+ short int ebcdic_mm[] =
+ { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
+ int use_ebcdic (int i) {
+ return ebcdic_mm[i] + ebcdic_ii[i];
+ }
+ extern int foo;
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gtk_widget_get_mapped ();
int
main ()
{
-return gtk_widget_get_mapped ();
+return use_ascii (foo) == use_ebcdic (foo);
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_widget_get_mapped=yes
-else
- ac_cv_lib_m_gtk_widget_get_mapped=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_widget_get_mapped" >&5
-$as_echo "$ac_cv_lib_m_gtk_widget_get_mapped" >&6; }
-if test "x$ac_cv_lib_m_gtk_widget_get_mapped" = xyes; then :
- $as_echo "#define HAVE_GTK_WIDGET_GET_MAPPED 1" >>confdefs.h
-
+if ac_fn_c_try_compile "$LINENO"; then :
+ if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then
+ ac_cv_c_bigendian=yes
+ fi
+ if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
+ if test "$ac_cv_c_bigendian" = unknown; then
+ ac_cv_c_bigendian=no
+ else
+ # finding both strings is unlikely to happen, but who knows?
+ ac_cv_c_bigendian=unknown
+ fi
+ fi
fi
-
- # for 2.9n.n
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gtk_combo_box_new_with_area in -lm" >&5
-$as_echo_n "checking for gtk_combo_box_new_with_area in -lm... " >&6; }
-if ${ac_cv_lib_m_gtk_combo_box_new_with_area+:} false; then :
- $as_echo_n "(cached) " >&6
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char gtk_combo_box_new_with_area ();
+$ac_includes_default
int
main ()
{
-return gtk_combo_box_new_with_area ();
+
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long int l;
+ char c[sizeof (long int)];
+ } u;
+ u.l = 1;
+ return u.c[sizeof (long int) - 1] == 1;
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_gtk_combo_box_new_with_area=yes
+if ac_fn_c_try_run "$LINENO"; then :
+ ac_cv_c_bigendian=no
else
- ac_cv_lib_m_gtk_combo_box_new_with_area=no
+ ac_cv_c_bigendian=yes
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_gtk_combo_box_new_with_area" >&5
-$as_echo "$ac_cv_lib_m_gtk_combo_box_new_with_area" >&6; }
-if test "x$ac_cv_lib_m_gtk_combo_box_new_with_area" = xyes; then :
- $as_echo "#define HAVE_GTK_COMBO_BOX_NEW_WITH_AREA 1" >>confdefs.h
-
- $as_echo "#define HAVE_GTK_3 1" >>confdefs.h
-
+ fi
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
+$as_echo "$ac_cv_c_bigendian" >&6; }
+ case $ac_cv_c_bigendian in #(
+ yes)
+ $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
+;; #(
+ no)
+ ;; #(
+ universal)
+$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cairo_glyph_allocate in -lcairo" >&5
-$as_echo_n "checking for cairo_glyph_allocate in -lcairo... " >&6; }
-if ${ac_cv_lib_cairo_cairo_glyph_allocate+:} false; then :
+ ;; #(
+ *)
+ as_fn_error $? "unknown endianness
+ presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;;
+ esac
+
+# The cast to long int works around a bug in the HP C Compiler
+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.
+# This bug is HP SR number 8606223364.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of void *" >&5
+$as_echo_n "checking size of void *... " >&6; }
+if ${ac_cv_sizeof_void_p+:} false; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lcairo $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (void *))" "ac_cv_sizeof_void_p" "$ac_includes_default"; then :
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char cairo_glyph_allocate ();
-int
-main ()
-{
-return cairo_glyph_allocate ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_cairo_cairo_glyph_allocate=yes
else
- ac_cv_lib_cairo_cairo_glyph_allocate=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+ if test "$ac_cv_type_void_p" = yes; then
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "cannot compute sizeof (void *)
+See \`config.log' for more details" "$LINENO" 5; }
+ else
+ ac_cv_sizeof_void_p=0
+ fi
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_cairo_cairo_glyph_allocate" >&5
-$as_echo "$ac_cv_lib_cairo_cairo_glyph_allocate" >&6; }
-if test "x$ac_cv_lib_cairo_cairo_glyph_allocate" = xyes; then :
- $as_echo "#define HAVE_CAIRO_GLYPH_ALLOCATE 1" >>confdefs.h
fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_void_p" >&5
+$as_echo "$ac_cv_sizeof_void_p" >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cairo_region_xor in -lcairo" >&5
-$as_echo_n "checking for cairo_region_xor in -lcairo... " >&6; }
-if ${ac_cv_lib_cairo_cairo_region_xor+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lcairo $GTK_LIBS $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char cairo_region_xor ();
-int
-main ()
-{
-return cairo_region_xor ();
- ;
- return 0;
-}
+
+cat >>confdefs.h <<_ACEOF
+#define SIZEOF_VOID_P $ac_cv_sizeof_void_p
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_cairo_cairo_region_xor=yes
+
+
+# Extract the first word of "pkg-config", so it can be a program name with args.
+set dummy pkg-config; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_path_PKG_CONFIG+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- ac_cv_lib_cairo_cairo_region_xor=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_cairo_cairo_region_xor" >&5
-$as_echo "$ac_cv_lib_cairo_cairo_region_xor" >&6; }
-if test "x$ac_cv_lib_cairo_cairo_region_xor" = xyes; then :
- $as_echo "#define HAVE_CAIRO_REGION_XOR 1" >>confdefs.h
+ case $PKG_CONFIG in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+ test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no"
+ ;;
+esac
+fi
+PKG_CONFIG=$ac_cv_path_PKG_CONFIG
+if test -n "$PKG_CONFIG"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5
+$as_echo "$PKG_CONFIG" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- XLIBS=""
- XFLAGS=""
-
-
- if test "$with_static_xm" = yes ; then
- GX_FILES="XG_O_FILES"
- $as_echo "#define HAVE_STATIC_XM 1" >>confdefs.h
-
- fi
- fi
- fi
- if test "$with_gtk" != yes && test "$with_motif" != yes ; then
- $as_echo "#define USE_NO_GUI 1" >>confdefs.h
- XLIBS=""
- XFLAGS=""
+#--------------------------------------------------------------------------------
+# fftw
+#--------------------------------------------------------------------------------
+FFTW_LIBS=""
+FFTW_CFLAGS=""
+if test "$with_fftw" != no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fftw3" >&5
+$as_echo_n "checking for fftw3... " >&6; }
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG fftw3 --exists ; then
+ FFTW_LIBS="`$PKG_CONFIG fftw3 --libs`"
+ FFTW_CFLAGS="`$PKG_CONFIG fftw3 --cflags`"
+ $as_echo "#define HAVE_FFTW3 1" >>confdefs.h
- GX_FILES="NO_GUI_O_FILES"
- GX_HEADERS="NO_GUI_HEADERS"
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES fftw3"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ fi
fi
-
fi
@@ -8699,606 +4220,409 @@ fi
#--------------------------------------------------------------------------------
-# OpenGL
+# GMP, MPFR, MPC
#--------------------------------------------------------------------------------
-GL_LIBS=""
-GL_FILES=""
-GL_FLAGS=""
-have_gl=no
-if test "$with_gl" = yes || test "$with_just_gl" = yes ; then
- if test "$with_motif" = yes ; then
- ac_fn_c_check_header_mongrel "$LINENO" "GL/gl.h" "ac_cv_header_GL_gl_h" "$ac_includes_default"
-if test "x$ac_cv_header_GL_gl_h" = xyes; then :
- have_gl=yes
-else
+# no pc files -- deliberately! We'll just add the libraries and let the chips fall...
- OLD_CFLAGS="$CFLAGS"
- CFLAGS="-I/usr/X11R6/include $CFLAGS"
- # can't use AC_CHECK_HEADER here (GL/gl.h includes GL/glext.h, so the -I business has to be set up first)
+GMP_LIBS=""
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for /usr/X11R6/include/GL/gl.h" >&5
-$as_echo_n "checking for /usr/X11R6/include/GL/gl.h... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <GL/gl.h>
-int
-main ()
-{
-int i; i = GL_TRUE
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- have_gl=yes
- GL_FLAGS="-I/usr/X11R6/include"
- CFLAGS="$OLD_CFLAGS"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+if test "$with_gmp" = yes ; then
+ GMP_LIBS="-lgmp -lmpfr -lmpc -lm"
+ $as_echo "#define WITH_GMP 1" >>confdefs.h
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find GL headers" >&5
-$as_echo "$as_me: WARNING: can't find GL headers" >&2;}
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gmp mpfr mpc"
fi
- # in FC5 glu.h and libGLU are missing by default -- do they come from Mesa?
- if test "$have_gl" = yes ; then
- ac_fn_c_check_header_mongrel "$LINENO" "GL/glu.h" "ac_cv_header_GL_glu_h" "$ac_includes_default"
-if test "x$ac_cv_header_GL_glu_h" = xyes; then :
- $as_echo "#define HAVE_GLU 1" >>confdefs.h
- GL_LIBS="$GL_LIBS -lGLU"
-fi
+#--------------------------------------------------------------------------------
+# GSL
+#--------------------------------------------------------------------------------
+
+GSL_LIBS=""
+GSL_CFLAGS=""
+if test "$with_gsl" != no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gsl" >&5
+$as_echo_n "checking for gsl... " >&6; }
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG gsl --exists ; then
+ GSL_LIBS="`$PKG_CONFIG gsl --libs`"
+ GSL_CFLAGS="`$PKG_CONFIG gsl --cflags`"
+ $as_echo "#define HAVE_GSL 1" >>confdefs.h
- GL_LIBS="$GL_LIBS -lGL"
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gsl"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: GL only works with Motif" >&5
-$as_echo "$as_me: WARNING: GL only works with Motif" >&2;}
fi
fi
-if test "$have_gl" = yes ; then
- $as_echo "#define HAVE_GL 1" >>confdefs.h
-
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES openGL"
- if test "$with_gl2ps" = yes ; then
- $as_echo "#define WITH_GL2PS 1" >>confdefs.h
-
- RANDOM_FEATURES="$RANDOM_FEATURES gl2ps"
- GL_FILES="gl2ps.o"
- fi
- if test "$with_just_gl" = yes ; then
- $as_echo "#define JUST_GL 1" >>confdefs.h
- else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <GL/gl.h>
-int
-main ()
-{
-int i; i = GL_TEXTURE_BINDING_3D
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- GL_FILES="$GL_FILES gl.o"
-else
- $as_echo "#define JUST_GL 1" >>confdefs.h
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- fi
- case "$host" in
- *-apple-*)
-# GL_LIBS="-framework OpenGL"
-# is this in place of or in addition to -lGL etc?
-# on OSX 10.5 we need the following:
- GL_LIBS="-L/usr/X11/lib -lGLU -lGL -Wl,-dylib_file,/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib -framework OpenGL"
- ;;
- esac
-else
- GL_LIBS=""
- GL_FILES=""
- GL_FLAGS=""
-fi
+#--------------------------------------------------------------------------------
+# Ladspa
+#--------------------------------------------------------------------------------
+if test "$with_ladspa" = yes ; then
+ $as_echo "#define HAVE_LADSPA 1" >>confdefs.h
+ RANDOM_FEATURES="$RANDOM_FEATURES ladspa"
+fi
#--------------------------------------------------------------------------------
-# fam/gamin (needs GUI)
+# graphics
#--------------------------------------------------------------------------------
-FAM_LIB=""
-if test "$ac_snd_have_gui" != no ; then
- if test "$with_fam" != no ; then
- # look for the File Alteration Monitor (gamin or SGI's fam -- both use fam.h and libfam apparently)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Gamin" >&5
-$as_echo_n "checking for Gamin... " >&6; }
- if test x$PKG_CONFIG != xno && $PKG_CONFIG gamin --exists ; then
- gamin_version="`$PKG_CONFIG gamin --modversion`"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gamin_version" >&5
-$as_echo "$gamin_version" >&6; }
- # before version 0.0.18, gamin.pc messed up the --libs result, so we'll just insist on a later version
- if $PKG_CONFIG --atleast-version 0.1.0 gamin; then
- cat >>confdefs.h <<_ACEOF
-#define MUS_GAMIN_VERSION "${gamin_version}"
-_ACEOF
-
- FAM_LIB="`$PKG_CONFIG gamin --libs`"
- $as_echo "#define HAVE_FAM 1" >>confdefs.h
-
- $as_echo "#define HAVE_FAM_NO_EXISTS 1" >>confdefs.h
-
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gamin"
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: need gamin version 0.1.0 or later" >&5
-$as_echo "$as_me: WARNING: need gamin version 0.1.0 or later" >&2;}
- fi
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fam" >&5
-$as_echo_n "checking for Fam... " >&6; }
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for FAMOpen in -lfam" >&5
-$as_echo_n "checking for FAMOpen in -lfam... " >&6; }
-if ${ac_cv_lib_fam_FAMOpen+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lfam $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+# graphics: motif chosen if --with-motif
+# no gui chosen if --without-gui
+# gtk chosen if neither of above and we can find gtk-2.0.pc or gtk-3.0.pc
+# else no gui
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char FAMOpen ();
-int
-main ()
-{
-return FAMOpen ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_fam_FAMOpen=yes
-else
- ac_cv_lib_fam_FAMOpen=no
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fam_FAMOpen" >&5
-$as_echo "$ac_cv_lib_fam_FAMOpen" >&6; }
-if test "x$ac_cv_lib_fam_FAMOpen" = xyes; then :
+XLIBS=""
+XFLAGS=""
- $as_echo "#define HAVE_FAM 1" >>confdefs.h
+GX_FILES=""
+GX_HEADERS=""
- FAM_LIB="-lfam"
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES fam"
+GTK_FILES=""
+GTK_HEADERS=""
+GTK_CFLAGS=""
+GTK_LIBS=""
+GTK_LD_LIBS=""
-fi
+ac_snd_gui_choice=none
- fi
- fi
+if test "$with_motif" = no && test "$with_gtk" = no ; then
+ with_gui=no
fi
+if test "$with_gui" = no ; then
+ $as_echo "#define USE_NO_GUI 1" >>confdefs.h
-
-
-ac_snd_have_extension_language=no
+ GX_FILES="NO_GUI_O_FILES"
+ GX_HEADERS="NO_GUI_HEADERS"
+ ac_snd_gui_choice=no
+fi
#--------------------------------------------------------------------------------
-# Ruby
+# X/Motif
#--------------------------------------------------------------------------------
+# here as in the gmp case, we simply set up the libs/flags and hope for the best
-# AC_CHECK_RUBY
-
-# readline (for Ruby)
-# Check whether --enable-readline was given.
-if test "${enable_readline+set}" = set; then :
- enableval=$enable_readline;
-fi
-
-
-
-# Check whether --with-ruby-prefix was given.
-if test "${with_ruby_prefix+set}" = set; then :
- withval=$with_ruby_prefix; ruby_prefix="$withval"
- RUBY="$ruby_prefix/bin/ruby"
-else
- ruby_prefix="/usr/local"
-fi
+if test "$with_motif" = yes ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5
+$as_echo_n "checking for X... " >&6; }
-if test "$with_ruby" = yes && test "$ac_snd_have_extension_language" = yes ; then
- with_ruby=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: You asked for both Ruby and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used" >&5
-$as_echo "$as_me: WARNING: You asked for both Ruby and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used" >&2;}
+# Check whether --with-x was given.
+if test "${with_x+set}" = set; then :
+ withval=$with_x;
fi
-
-# Check whether --with-ruby was given.
-if test "${with_ruby+set}" = set; then :
- withval=$with_ruby; if test "$with_ruby" = yes ; then
-
- for ac_prog in $RUBY ruby
-do
- # Extract the first word of "$ac_prog", so it can be a program name with args.
-set dummy $ac_prog; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_RUBY+:} false; then :
+# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
+if test "x$with_x" = xno; then
+ # The user explicitly disabled X.
+ have_x=disabled
+else
+ case $x_includes,$x_libraries in #(
+ *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #(
+ *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then :
$as_echo_n "(cached) " >&6
else
- case $RUBY in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_RUBY="$RUBY" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_RUBY="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
+ # One or both of the vars are not set, and there is no cached value.
+ac_x_includes=no ac_x_libraries=no
+rm -f -r conftest.dir
+if mkdir conftest.dir; then
+ cd conftest.dir
+ cat >Imakefile <<'_ACEOF'
+incroot:
+ @echo incroot='${INCROOT}'
+usrlibdir:
+ @echo usrlibdir='${USRLIBDIR}'
+libdir:
+ @echo libdir='${LIBDIR}'
+_ACEOF
+ if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering ...", which would confuse us.
+ for ac_var in incroot usrlibdir libdir; do
+ eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`"
+ done
+ # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
+ for ac_extension in a so sl dylib la dll; do
+ if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" &&
+ test -f "$ac_im_libdir/libX11.$ac_extension"; then
+ ac_im_usrlibdir=$ac_im_libdir; break
+ fi
+ done
+ # Screen out bogus values from the imake configuration. They are
+ # bogus both because they are the default anyway, and because
+ # using them would break gcc on systems where it needs fixed includes.
+ case $ac_im_incroot in
+ /usr/include) ac_x_includes= ;;
+ *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;;
+ esac
+ case $ac_im_usrlibdir in
+ /usr/lib | /usr/lib64 | /lib | /lib64) ;;
+ *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;;
+ esac
fi
-done
- done
-IFS=$as_save_IFS
-
- ;;
-esac
-fi
-RUBY=$ac_cv_path_RUBY
-if test -n "$RUBY"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RUBY" >&5
-$as_echo "$RUBY" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ cd ..
+ rm -f -r conftest.dir
fi
+# Standard set of common directories for X headers.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+ac_x_header_dirs='
+/usr/X11/include
+/usr/X11R7/include
+/usr/X11R6/include
+/usr/X11R5/include
+/usr/X11R4/include
+
+/usr/include/X11
+/usr/include/X11R7
+/usr/include/X11R6
+/usr/include/X11R5
+/usr/include/X11R4
+
+/usr/local/X11/include
+/usr/local/X11R7/include
+/usr/local/X11R6/include
+/usr/local/X11R5/include
+/usr/local/X11R4/include
- test -n "$RUBY" && break
-done
-test -n "$RUBY" || RUBY="no"
-
- RUBY_VERSION=""
- RUBY_RELEASE_DATE=""
- RUBY_SEARCH_PATH=""
- RUBY_CFLAGS=""
- RUBY_LIBS=""
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Ruby" >&5
-$as_echo_n "checking for Ruby... " >&6; }
- if test "$RUBY" != no ; then
- minimum_version=1.8.0
- RUBY_VERSION=`$RUBY -e 'puts RUBY_VERSION'`
- if `$RUBY -e "exit(RUBY_VERSION >= '$minimum_version' ? 0 : 1)"` ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RUBY_VERSION" >&5
-$as_echo "$RUBY_VERSION" >&6; }
- RUBY_RELEASE_DATE=`$RUBY -e 'puts RUBY_RELEASE_DATE'`
- RUBY_SEARCH_PATH=`$RUBY -e 'puts $:.join(":")'`
- ruby_ldflags=""
- ruby_libs=""
- if `$RUBY -e "exit(RUBY_VERSION < '1.9.0' ? 0 : 1)"` ; then
- ruby_hdrdir=`$RUBY -rrbconfig -e "puts Config::CONFIG['archdir']"`
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ruby.h" >&5
-$as_echo_n "checking for ruby.h... " >&6; }
- if test -e "$ruby_hdrdir/ruby.h" ; then
- RUBY_CFLAGS="-I$ruby_hdrdir"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ruby_hdrdir/ruby.h" >&5
-$as_echo "$ruby_hdrdir/ruby.h" >&6; }
- else
- RUBY_CFLAGS=`$RUBY -e 'puts "-I" + $:.join(" -I")'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: use \$LOAD_PATH" >&5
-$as_echo "use \$LOAD_PATH" >&6; }
- fi
- ruby_ldflags=`$RUBY -rrbconfig -e "puts Config::CONFIG['LIBRUBYARG']"`
- ruby_libs=`$RUBY -rrbconfig -e "puts Config::CONFIG['LIBS']"`
- else
- ruby_hdrdir=`$RUBY -rrbconfig -e "puts RbConfig::CONFIG['rubyhdrdir']"`
- ruby_arch=`$RUBY -rrbconfig -e "puts RbConfig::CONFIG['arch']"`
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ruby.h" >&5
-$as_echo_n "checking for ruby.h... " >&6; }
- if test -e "$ruby_hdrdir/ruby.h" ; then
- RUBY_CFLAGS="-I$ruby_hdrdir -I$ruby_hdrdir/$ruby_arch"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ruby_hdrdir/ruby.h" >&5
-$as_echo "$ruby_hdrdir/ruby.h" >&6; }
- else
- ruby_hdrdir=`$RUBY -rrbconfig -e "puts RbConfig::CONFIG['archdir']"`
- if test -e "$ruby_hdrdir/ruby.h" ; then
- RUBY_CFLAGS="-I$ruby_hdrdir"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ruby_hdrdir/ruby.h" >&5
-$as_echo "$ruby_hdrdir/ruby.h" >&6; }
- else
- RUBY_CFLAGS=`$RUBY -e 'puts "-I" + $:.join(" -I")'`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: use \$LOAD_PATH" >&5
-$as_echo "use \$LOAD_PATH" >&6; }
- fi
- fi
- ruby_ldflags=`$RUBY -rrbconfig -e "puts RbConfig::CONFIG['LIBRUBYARG']"`
- ruby_libs=`$RUBY -rrbconfig -e "puts RbConfig::CONFIG['LIBS']"`
- fi
- RUBY_LIBS="$ruby_ldflags $ruby_libs"
- $as_echo "#define HAVE_RUBY 1" >>confdefs.h
+/usr/local/include/X11
+/usr/local/include/X11R7
+/usr/local/include/X11R6
+/usr/local/include/X11R5
+/usr/local/include/X11R4
- $as_echo "#define HAVE_EXTENSION_LANGUAGE 1" >>confdefs.h
+/usr/X386/include
+/usr/x386/include
+/usr/XFree86/include/X11
- cat >>confdefs.h <<_ACEOF
-#define MUS_RUBY_VERSION "$RUBY_VERSION"
-_ACEOF
+/usr/include
+/usr/local/include
+/usr/unsupported/include
+/usr/athena/include
+/usr/local/x11r5/include
+/usr/lpp/Xamples/include
- cat >>confdefs.h <<_ACEOF
-#define RUBY_RELEASE_DATE "$RUBY_RELEASE_DATE"
-_ACEOF
+/usr/openwin/include
+/usr/openwin/share/include'
- cat >>confdefs.h <<_ACEOF
-#define RUBY_SEARCH_PATH "$RUBY_SEARCH_PATH"
+if test "$ac_x_includes" = no; then
+ # Guess where to find include files, by looking for Xlib.h.
+ # First, try using that file with no special directory specified.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <X11/Xlib.h>
_ACEOF
-
- XEN_CFLAGS="$XEN_CFLAGS $RUBY_CFLAGS"
- XEN_LIBS="$XEN_LIBS $RUBY_LIBS"
- if test "$enable_readline" != no ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for readline in -lreadline" >&5
-$as_echo_n "checking for readline in -lreadline... " >&6; }
-if ${ac_cv_lib_readline_readline+:} false; then :
- $as_echo_n "(cached) " >&6
+if ac_fn_c_try_cpp "$LINENO"; then :
+ # We can compile using X headers with no special include directory.
+ac_x_includes=
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lreadline "-lncurses" $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ for ac_dir in $ac_x_header_dirs; do
+ if test -r "$ac_dir/X11/Xlib.h"; then
+ ac_x_includes=$ac_dir
+ break
+ fi
+done
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+fi # $ac_x_includes = no
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char readline ();
+if test "$ac_x_libraries" = no; then
+ # Check for the libraries.
+ # See if we find them without any special options.
+ # Don't add to $LIBS permanently.
+ ac_save_LIBS=$LIBS
+ LIBS="-lX11 $LIBS"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <X11/Xlib.h>
int
main ()
{
-return readline ();
+XrmInitialize ()
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_readline_readline=yes
+ LIBS=$ac_save_LIBS
+# We can link X programs with no special library path.
+ac_x_libraries=
else
- ac_cv_lib_readline_readline=no
+ LIBS=$ac_save_LIBS
+for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g`
+do
+ # Don't even attempt the hair of trying to link an X program!
+ for ac_extension in a so sl dylib la dll; do
+ if test -r "$ac_dir/libX11.$ac_extension"; then
+ ac_x_libraries=$ac_dir
+ break 2
+ fi
+ done
+done
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_readline_readline" >&5
-$as_echo "$ac_cv_lib_readline_readline" >&6; }
-if test "x$ac_cv_lib_readline_readline" = xyes; then :
- $as_echo "#define HAVE_READLINE 1" >>confdefs.h
+fi # $ac_x_libraries = no
- XEN_LIBS="$XEN_LIBS -lreadline -lncurses"
+case $ac_x_includes,$ac_x_libraries in #(
+ no,* | *,no | *\'*)
+ # Didn't find X, or a directory has "'" in its name.
+ ac_cv_have_x="have_x=no";; #(
+ *)
+ # Record where we found X for the cache.
+ ac_cv_have_x="have_x=yes\
+ ac_x_includes='$ac_x_includes'\
+ ac_x_libraries='$ac_x_libraries'"
+esac
fi
+;; #(
+ *) have_x=yes;;
+ esac
+ eval "$ac_cv_have_x"
+fi # $with_x != no
- fi
+if test "$have_x" != yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5
+$as_echo "$have_x" >&6; }
+ no_x=yes
+else
+ # If each of the values was on the command line, it overrides each guess.
+ test "x$x_includes" = xNONE && x_includes=$ac_x_includes
+ test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
+ # Update the cache value to reflect the command line values.
+ ac_cv_have_x="have_x=yes\
+ ac_x_includes='$x_includes'\
+ ac_x_libraries='$x_libraries'"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5
+$as_echo "libraries $x_libraries, headers $x_includes" >&6; }
+fi
+if test "$no_x" = yes; then
+ # Not all programs may use this symbol, but it does not hurt to define it.
- OLD_LIBS="$LIBS"
- LIBS="$XEN_LIBS $LIBS -lm"
- OLD_CFLAGS="$CFLAGS"
- CFLAGS="$XEN_CFLAGS $CFLAGS"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rb_proc_new" >&5
-$as_echo_n "checking for rb_proc_new... " >&6; }
+$as_echo "#define X_DISPLAY_MISSING 1" >>confdefs.h
- if test "$cross_compiling" = yes; then :
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error $? "cannot run test program while cross compiling
-See \`config.log' for more details" "$LINENO" 5; }
+ X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS=
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ if test -n "$x_includes"; then
+ X_CFLAGS="$X_CFLAGS -I$x_includes"
+ fi
+
+ # It would also be nice to do this for all -L options, not just this one.
+ if test -n "$x_libraries"; then
+ X_LIBS="$X_LIBS -L$x_libraries"
+ # For Solaris; some versions of Sun CC require a space after -R and
+ # others require no space. Words are not sufficient . . . .
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -R must be followed by a space" >&5
+$as_echo_n "checking whether -R must be followed by a space... " >&6; }
+ ac_xsave_LIBS=$LIBS; LIBS="$LIBS -R$x_libraries"
+ ac_xsave_c_werror_flag=$ac_c_werror_flag
+ ac_c_werror_flag=yes
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <ruby.h>
- VALUE proc_call(VALUE args, VALUE id) {return(rb_apply(rb_mKernel, (ID)id, args));}
int
main ()
{
-VALUE proc;
- ruby_init();
-#ifdef __cplusplus
- proc = rb_proc_new((VALUE (*)(...))proc_call, rb_intern("hi"))
-#else
- proc = rb_proc_new(proc_call, rb_intern("hi"))
-#endif
;
return 0;
}
-
_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- $as_echo "#define HAVE_RB_PROC_NEW 1" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-
-else
+if ac_fn_c_try_link "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
-
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ruby_vsnprintf" >&5
-$as_echo_n "checking for ruby_vsnprintf... " >&6; }
- if test "$cross_compiling" = yes; then :
- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
-as_fn_error $? "cannot run test program while cross compiling
-See \`config.log' for more details" "$LINENO" 5; }
+ X_LIBS="$X_LIBS -R$x_libraries"
else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ LIBS="$ac_xsave_LIBS -R $x_libraries"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-#include <ruby.h>
+
int
main ()
{
-ruby_init(); ruby_vsnprintf(0, 0, 0, 0); return(0)
+
;
return 0;
}
_ACEOF
-if ac_fn_c_try_run "$LINENO"; then :
- $as_echo "#define HAVE_VSNPRINTF 0" >>confdefs.h
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+if ac_fn_c_try_link "$LINENO"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-
-fi
-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
- conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-
- LIBS="$OLD_LIBS"
- CFLAGS="$OLD_CFLAGS"
- LOCAL_LANGUAGE="Ruby"
- ac_snd_have_extension_language=yes
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: Ruby version $RUBY_VERSION < $minimum_version" >&5
-$as_echo "Ruby version $RUBY_VERSION < $minimum_version" >&6; }
-
- fi
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-
- fi
-
-
-
-
-
-
- fi
-fi
-
-
-
-
-#--------------------------------------------------------------------------------
-# Forth
-#--------------------------------------------------------------------------------
-
-if test "$with_forth" = yes && test "$ac_snd_have_extension_language" = yes ; then
- with_forth=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: You asked for both Forth and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used" >&5
-$as_echo "$as_me: WARNING: You asked for both Forth and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used" >&2;}
-fi
-
-
-# Check whether --with-forth was given.
-if test "${with_forth+set}" = set; then :
- withval=$with_forth; if test "$with_forth" = yes ; then
-
- # Extract the first word of "fth", so it can be a program name with args.
-set dummy fth; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_FTH+:} false; then :
- $as_echo_n "(cached) " >&6
+ X_LIBS="$X_LIBS -R $x_libraries"
else
- case $FTH in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_FTH="$FTH" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_FTH="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_FTH" && ac_cv_path_FTH="no"
- ;;
-esac
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: neither works" >&5
+$as_echo "neither works" >&6; }
fi
-FTH=$ac_cv_path_FTH
-if test -n "$FTH"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FTH" >&5
-$as_echo "$FTH" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ ac_c_werror_flag=$ac_xsave_c_werror_flag
+ LIBS=$ac_xsave_LIBS
+ fi
+ # Check for system-dependent libraries X programs must link with.
+ # Do this before checking for the system-independent R6 libraries
+ # (-lICE), since we may need -lsocket or whatever for X linking.
- FTH_VERSION=""
- FTH_CFLAGS=""
- FTH_LIBS=""
- FTH_HAVE_COMPLEX=no
- FTH_HAVE_RATIO=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Forth" >&5
-$as_echo_n "checking for Forth... " >&6; }
- if test "${FTH}" != no ; then
- FTH_VERSION=`${FTH} --no-init-file --eval .version`
- FTH_CFLAGS=`${FTH} --no-init-file --eval .cflags`
- FTH_LIBS=`${FTH} --no-init-file --eval .libs`
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: FTH version ${FTH_VERSION}" >&5
-$as_echo "FTH version ${FTH_VERSION}" >&6; }
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FTH supports complex numbers" >&5
-$as_echo_n "checking whether FTH supports complex numbers... " >&6; }
-if ${ac_cv_lib_fth_fth_make_complex+:} false; then :
+ if test "$ISC" = yes; then
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet"
+ else
+ # Martyn Johnson says this is needed for Ultrix, if the X
+ # libraries were built with DECnet support. And Karl Berry says
+ # the Alpha needs dnet_stub (dnet does not exist).
+ ac_xsave_LIBS="$LIBS"; LIBS="$LIBS $X_LIBS -lX11"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char XOpenDisplay ();
+int
+main ()
+{
+return XOpenDisplay ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5
+$as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; }
+if ${ac_cv_lib_dnet_dnet_ntoa+:} false; then :
$as_echo_n "(cached) " >&6
else
- fth_check_lib_save_LIBS=$LIBS
- LIBS="-lfth ${FTH_LIBS} $LIBS"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldnet $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
@@ -9307,38 +4631,39 @@ else
#ifdef __cplusplus
extern "C"
#endif
-char fth_make_complex ();
+char dnet_ntoa ();
int
main ()
{
-return fth_make_complex ();
+return dnet_ntoa ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_fth_fth_make_complex=yes
+ ac_cv_lib_dnet_dnet_ntoa=yes
else
- ac_cv_lib_fth_fth_make_complex=no
+ ac_cv_lib_dnet_dnet_ntoa=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
- LIBS=$fth_check_lib_save_LIBS
+LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fth_fth_make_complex" >&5
-$as_echo "$ac_cv_lib_fth_fth_make_complex" >&6; }
- if test $ac_cv_lib_fth_fth_make_complex = yes; then :
- FTH_HAVE_COMPLEX=yes
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5
+$as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; }
+if test "x$ac_cv_lib_dnet_dnet_ntoa" = xyes; then :
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet"
fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FTH supports rational numbers" >&5
-$as_echo_n "checking whether FTH supports rational numbers... " >&6; }
-if ${ac_cv_lib_fth_fth_ratio_floor+:} false; then :
+ if test $ac_cv_lib_dnet_dnet_ntoa = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet_stub" >&5
+$as_echo_n "checking for dnet_ntoa in -ldnet_stub... " >&6; }
+if ${ac_cv_lib_dnet_stub_dnet_ntoa+:} false; then :
$as_echo_n "(cached) " >&6
else
- fth_check_lib_save_LIBS=$LIBS
- LIBS="-lfth ${FTH_LIBS} $LIBS"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldnet_stub $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
@@ -9347,760 +4672,669 @@ else
#ifdef __cplusplus
extern "C"
#endif
-char fth_ratio_floor ();
+char dnet_ntoa ();
int
main ()
{
-return fth_ratio_floor ();
+return dnet_ntoa ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_fth_fth_ratio_floor=yes
+ ac_cv_lib_dnet_stub_dnet_ntoa=yes
else
- ac_cv_lib_fth_fth_ratio_floor=no
+ ac_cv_lib_dnet_stub_dnet_ntoa=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
- LIBS=$fth_check_lib_save_LIBS
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fth_fth_ratio_floor" >&5
-$as_echo "$ac_cv_lib_fth_fth_ratio_floor" >&6; }
- if test $ac_cv_lib_fth_fth_ratio_floor = yes; then :
- FTH_HAVE_RATIO=yes
-fi
- $as_echo "#define HAVE_FORTH 1" >>confdefs.h
-
- $as_echo "#define HAVE_EXTENSION_LANGUAGE 1" >>confdefs.h
-
- if test "$FTH_HAVE_COMPLEX" = yes ; then
- $as_echo "#define HAVE_COMPLEX_TRIG 1" >>confdefs.h
-
- $as_echo "#define HAVE_MAKE_COMPLEX 1" >>confdefs.h
-
- $as_echo "#define HAVE_MAKE_RECTANGULAR 1" >>confdefs.h
-
- fi
- if test "$FTH_HAVE_RATIO" = yes ; then
- $as_echo "#define HAVE_MAKE_RATIO 1" >>confdefs.h
-
- fi
- XEN_CFLAGS=$FTH_CFLAGS
-
- XEN_LIBS=$FTH_LIBS
-
- LOCAL_LANGUAGE="Forth"
- ac_snd_have_extension_language=yes
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-
- fi
-
-
-
-
-
-
- fi
+LIBS=$ac_check_lib_save_LIBS
fi
-
-
-
-
-#--------------------------------------------------------------------------------
-# S7 (the default)
-#--------------------------------------------------------------------------------
-
-S7_LIB=""
-
-if test "$with_s7" = yes && test "$ac_snd_have_extension_language" = yes ; then
- with_s7=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: You asked for both s7 and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used" >&5
-$as_echo "$as_me: WARNING: You asked for both s7 and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used" >&2;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_stub_dnet_ntoa" >&5
+$as_echo "$ac_cv_lib_dnet_stub_dnet_ntoa" >&6; }
+if test "x$ac_cv_lib_dnet_stub_dnet_ntoa" = xyes; then :
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub"
fi
-if test "$with_s7" != no && test "$with_extension_language" != no && test "$ac_snd_have_extension_language" != yes ; then
- $as_echo "#define HAVE_S7 1" >>confdefs.h
-
- $as_echo "#define HAVE_SCHEME 1" >>confdefs.h
-
- ac_snd_have_extension_language=yes
- $as_echo "#define HAVE_EXTENSION_LANGUAGE 1" >>confdefs.h
-
- $as_echo "#define HAVE_MAKE_RATIO 1" >>confdefs.h
-
- ac_fn_c_check_header_mongrel "$LINENO" "complex.h" "ac_cv_header_complex_h" "$ac_includes_default"
-if test "x$ac_cv_header_complex_h" = xyes; then :
-
- $as_echo "#define HAVE_MAKE_RECTANGULAR 1" >>confdefs.h
-
-
+ fi
fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ LIBS="$ac_xsave_LIBS"
+ # msh at cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT,
+ # to get the SysV transport functions.
+ # Chad R. Larson says the Pyramis MIS-ES running DC/OSx (SVR4)
+ # needs -lnsl.
+ # The nsl library prevents programs from opening the X display
+ # on Irix 5.2, according to T.E. Dickey.
+ # The functions gethostbyname, getservbyname, and inet_addr are
+ # in -lbsd on LynxOS 3.0.1/i386, according to Lars Hecking.
+ ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname"
+if test "x$ac_cv_func_gethostbyname" = xyes; then :
-
- LOCAL_LANGUAGE="s7"
- S7_LIB="s7.o"
fi
-
-
-
-
-#--------------------------------------------------------------------------------
-# Audio library
-#--------------------------------------------------------------------------------
-
-AUDIO_LIB=""
-LDSO_FLAGS=""
-SO_FLAGS=""
-SO_LD="ld"
-
-JACK_LIBS=""
-JACK_FLAGS=""
-
-
-if test "$with_audio" != no ; then
-
-# we need the sndlib.h equivalents to try to find the native sound support (see config.guess)
-# this only matters for those cases where we've implemented the audio code in audio.c
-# test for ALSA courtesy of Paul Davis
-# test for ESD courtesy of Nick Bailey
-# test for BSD courtesy of Steven Schultz
-# test for Jack courtesy of Kjetil S. Matheussen
-
-if test "$with_esd" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lesd" >&5
-$as_echo_n "checking for main in -lesd... " >&6; }
-if ${ac_cv_lib_esd_main+:} false; then :
+ if test $ac_cv_func_gethostbyname = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5
+$as_echo_n "checking for gethostbyname in -lnsl... " >&6; }
+if ${ac_cv_lib_nsl_gethostbyname+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lesd $LIBS"
+LIBS="-lnsl $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char gethostbyname ();
int
main ()
{
-return main ();
+return gethostbyname ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_esd_main=yes
+ ac_cv_lib_nsl_gethostbyname=yes
else
- ac_cv_lib_esd_main=no
+ ac_cv_lib_nsl_gethostbyname=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_esd_main" >&5
-$as_echo "$ac_cv_lib_esd_main" >&6; }
-if test "x$ac_cv_lib_esd_main" = xyes; then :
-
- ac_fn_c_check_header_mongrel "$LINENO" "esd.h" "ac_cv_header_esd_h" "$ac_includes_default"
-if test "x$ac_cv_header_esd_h" = xyes; then :
- $as_echo "#define MUS_ESD 1" >>confdefs.h
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5
+$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; }
+if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then :
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl"
+fi
- esd_version="`esd-config --version`"
- cat >>confdefs.h <<_ACEOF
-#define MUS_ESD_VERSION "${esd_version}"
-_ACEOF
+ if test $ac_cv_lib_nsl_gethostbyname = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lbsd" >&5
+$as_echo_n "checking for gethostbyname in -lbsd... " >&6; }
+if ${ac_cv_lib_bsd_gethostbyname+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lbsd $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- audiofile_version="`audiofile-config --version`"
- cat >>confdefs.h <<_ACEOF
-#define MUS_AUDIOFILE_VERSION "${audiofile_version}"
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char gethostbyname ();
+int
+main ()
+{
+return gethostbyname ();
+ ;
+ return 0;
+}
_ACEOF
-
- AUDIO_LIB="`esd-config --libs`"
- if test "$with_alsa" = yes || test "$with_static_alsa" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: esd takes precedence over alsa -- the two are not compatible" >&5
-$as_echo "$as_me: WARNING: esd takes precedence over alsa -- the two are not compatible" >&2;}
- fi
- AUDIO_SYSTEM=esd
-
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_bsd_gethostbyname=yes
else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the ESD header files" >&5
-$as_echo "$as_me: WARNING: can't find the ESD header files" >&2;}
+ ac_cv_lib_bsd_gethostbyname=no
fi
-
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the ESD library" >&5
-$as_echo "$as_me: WARNING: can't find the ESD library" >&2;}
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_gethostbyname" >&5
+$as_echo "$ac_cv_lib_bsd_gethostbyname" >&6; }
+if test "x$ac_cv_lib_bsd_gethostbyname" = xyes; then :
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lbsd"
fi
+ fi
+ fi
-else
+ # lieder at skyler.mavd.honeywell.com says without -lsocket,
+ # socket/setsockopt and other routines are undefined under SCO ODT
+ # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary
+ # on later versions), says Simon Leinen: it contains gethostby*
+ # variants that don't use the name server (or something). -lsocket
+ # must be given before -lnsl if both are needed. We assume that
+ # if connect needs -lnsl, so does gethostbyname.
+ ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect"
+if test "x$ac_cv_func_connect" = xyes; then :
-if test "$with_pulseaudio" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lpulse-simple" >&5
-$as_echo_n "checking for main in -lpulse-simple... " >&6; }
-if ${ac_cv_lib_pulse_simple_main+:} false; then :
+fi
+
+ if test $ac_cv_func_connect = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for connect in -lsocket" >&5
+$as_echo_n "checking for connect in -lsocket... " >&6; }
+if ${ac_cv_lib_socket_connect+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lpulse-simple $LIBS"
+LIBS="-lsocket $X_EXTRA_LIBS $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char connect ();
int
main ()
{
-return main ();
+return connect ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_pulse_simple_main=yes
+ ac_cv_lib_socket_connect=yes
else
- ac_cv_lib_pulse_simple_main=no
+ ac_cv_lib_socket_connect=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pulse_simple_main" >&5
-$as_echo "$ac_cv_lib_pulse_simple_main" >&6; }
-if test "x$ac_cv_lib_pulse_simple_main" = xyes; then :
-
- ac_fn_c_check_header_mongrel "$LINENO" "pulse/simple.h" "ac_cv_header_pulse_simple_h" "$ac_includes_default"
-if test "x$ac_cv_header_pulse_simple_h" = xyes; then :
- $as_echo "#define MUS_PULSEAUDIO 1" >>confdefs.h
-
- if test x$PKG_CONFIG != xno ; then
- AUDIO_LIB="`$PKG_CONFIG libpulse-simple --libs`"
- else
- AUDIO_LIB="-lpulse-simple"
- fi
- AUDIO_SYSTEM=pulseaudio
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the pulseaudio header files" >&5
-$as_echo "$as_me: WARNING: can't find the pulseaudio header files" >&2;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_connect" >&5
+$as_echo "$ac_cv_lib_socket_connect" >&6; }
+if test "x$ac_cv_lib_socket_connect" = xyes; then :
+ X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS"
fi
+ fi
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the pulseaudio library" >&5
-$as_echo "$as_me: WARNING: can't find the pulseaudio library" >&2;}
-fi
+ # Guillermo Gomez says -lposix is necessary on A/UX.
+ ac_fn_c_check_func "$LINENO" "remove" "ac_cv_func_remove"
+if test "x$ac_cv_func_remove" = xyes; then :
fi
-fi
-
-if test "$with_portaudio" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lportaudio" >&5
-$as_echo_n "checking for main in -lportaudio... " >&6; }
-if ${ac_cv_lib_portaudio_main+:} false; then :
+ if test $ac_cv_func_remove = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for remove in -lposix" >&5
+$as_echo_n "checking for remove in -lposix... " >&6; }
+if ${ac_cv_lib_posix_remove+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lportaudio $LIBS"
+LIBS="-lposix $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char remove ();
int
main ()
{
-return main ();
+return remove ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_portaudio_main=yes
+ ac_cv_lib_posix_remove=yes
else
- ac_cv_lib_portaudio_main=no
+ ac_cv_lib_posix_remove=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_portaudio_main" >&5
-$as_echo "$ac_cv_lib_portaudio_main" >&6; }
-if test "x$ac_cv_lib_portaudio_main" = xyes; then :
-
- ac_fn_c_check_header_mongrel "$LINENO" "portaudio.h" "ac_cv_header_portaudio_h" "$ac_includes_default"
-if test "x$ac_cv_header_portaudio_h" = xyes; then :
-
- AUDIO_SYSTEM=portaudio
- $as_echo "#define MUS_PORTAUDIO 1" >>confdefs.h
-
- if test x$PKG_CONFIG != xno ; then
- AUDIO_LIB="`$PKG_CONFIG portaudio-2.0 --libs`"
- else
- AUDIO_LIB="-lportaudio"
- fi
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the portaudio header file" >&5
-$as_echo "$as_me: WARNING: can't find the portaudio header file" >&2;}
-fi
-
-
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the portaudio library" >&5
-$as_echo "$as_me: WARNING: can't find the portaudio library" >&2;}
-fi
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_posix_remove" >&5
+$as_echo "$ac_cv_lib_posix_remove" >&6; }
+if test "x$ac_cv_lib_posix_remove" = xyes; then :
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix"
fi
+ fi
-if test "$AUDIO_SYSTEM" != None ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using the $AUDIO_SYSTEM audio system" >&5
-$as_echo "Using the $AUDIO_SYSTEM audio system" >&6; }
-else
+ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay.
+ ac_fn_c_check_func "$LINENO" "shmat" "ac_cv_func_shmat"
+if test "x$ac_cv_func_shmat" = xyes; then :
-if test "$with_alsa" = yes && test "$with_oss" = yes ; then
- with_oss=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: You asked for both ALSA and OSS -- ALSA will be used" >&5
-$as_echo "$as_me: WARNING: You asked for both ALSA and OSS -- ALSA will be used" >&2;}
fi
-if test "$with_jack" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -ljack" >&5
-$as_echo_n "checking for main in -ljack... " >&6; }
-if ${ac_cv_lib_jack_main+:} false; then :
+ if test $ac_cv_func_shmat = no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shmat in -lipc" >&5
+$as_echo_n "checking for shmat in -lipc... " >&6; }
+if ${ac_cv_lib_ipc_shmat+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-ljack $LIBS"
+LIBS="-lipc $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char shmat ();
int
main ()
{
-return main ();
+return shmat ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_jack_main=yes
+ ac_cv_lib_ipc_shmat=yes
else
- ac_cv_lib_jack_main=no
+ ac_cv_lib_ipc_shmat=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_jack_main" >&5
-$as_echo "$ac_cv_lib_jack_main" >&6; }
-if test "x$ac_cv_lib_jack_main" = xyes; then :
-
- ac_fn_c_check_header_mongrel "$LINENO" "jack/jack.h" "ac_cv_header_jack_jack_h" "$ac_includes_default"
-if test "x$ac_cv_header_jack_jack_h" = xyes; then :
-
-else
- with_jack=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the JACK header files" >&5
-$as_echo "$as_me: WARNING: can't find the JACK header files" >&2;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ipc_shmat" >&5
+$as_echo "$ac_cv_lib_ipc_shmat" >&6; }
+if test "x$ac_cv_lib_ipc_shmat" = xyes; then :
+ X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc"
fi
+ fi
+ fi
-else
- with_jack=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the JACK library" >&5
-$as_echo "$as_me: WARNING: can't find the JACK library" >&2;}
-fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lsamplerate" >&5
-$as_echo_n "checking for main in -lsamplerate... " >&6; }
-if ${ac_cv_lib_samplerate_main+:} false; then :
+ # Check for libraries that X11R6 Xt/Xaw programs need.
+ ac_save_LDFLAGS=$LDFLAGS
+ test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries"
+ # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to
+ # check for ICE first), but we must link in the order -lSM -lICE or
+ # we get undefined symbols. So assume we have SM if we have ICE.
+ # These have to be linked with before -lX11, unlike the other
+ # libraries we check for below, so use a different variable.
+ # John Interrante, Karl Berry
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for IceConnectionNumber in -lICE" >&5
+$as_echo_n "checking for IceConnectionNumber in -lICE... " >&6; }
+if ${ac_cv_lib_ICE_IceConnectionNumber+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lsamplerate $LIBS"
+LIBS="-lICE $X_EXTRA_LIBS $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char IceConnectionNumber ();
int
main ()
{
-return main ();
+return IceConnectionNumber ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_samplerate_main=yes
+ ac_cv_lib_ICE_IceConnectionNumber=yes
else
- ac_cv_lib_samplerate_main=no
+ ac_cv_lib_ICE_IceConnectionNumber=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_samplerate_main" >&5
-$as_echo "$ac_cv_lib_samplerate_main" >&6; }
-if test "x$ac_cv_lib_samplerate_main" = xyes; then :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ICE_IceConnectionNumber" >&5
+$as_echo "$ac_cv_lib_ICE_IceConnectionNumber" >&6; }
+if test "x$ac_cv_lib_ICE_IceConnectionNumber" = xyes; then :
+ X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE"
+fi
- ac_fn_c_check_header_mongrel "$LINENO" "samplerate.h" "ac_cv_header_samplerate_h" "$ac_includes_default"
-if test "x$ac_cv_header_samplerate_h" = xyes; then :
+ LDFLAGS=$ac_save_LDFLAGS
-else
- with_jack=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the samplerate header files. JACK will not be used." >&5
-$as_echo "$as_me: WARNING: can't find the samplerate header files. JACK will not be used." >&2;}
fi
-else
- with_jack=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the samplerate library. JACK will not be used." >&5
-$as_echo "$as_me: WARNING: can't find the samplerate library. JACK will not be used." >&2;}
-fi
+ GTK_FLAGS="$X_CFLAGS"
+ X_POST_LIBS="-lX11 $X_EXTRA_LIBS -lXext"
+ case "$host" in
+ *-apple-*)
+ X_POST_LIBS="$X_POST_LIBS -lSM -lICE"
+ ;;
+ *-*-linux*)
+ X_POST_LIBS="$X_POST_LIBS -lSM -lICE -lXft"
+ ;;
+ esac
+ X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -lXm -lXt"
- if test $with_jack = yes ; then
- AUDIO_SYSTEM=JACK
- $as_echo "#define MUS_JACK 1" >>confdefs.h
+ GX_FILES="MOTIF_O_FILES"
+ GX_HEADERS="SND_X_HEADERS"
- if test x$PKG_CONFIG != xno ; then
- jack_version="`$PKG_CONFIG jack --modversion`"
- cat >>confdefs.h <<_ACEOF
-#define MUS_JACK_VERSION "Jack: ${jack_version}"
-_ACEOF
+ if test "$with_editres" = yes ; then
+ $as_echo "#define WITH_EDITRES 1" >>confdefs.h
+
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES editres"
+ X_PRE_LIBS="$X_PRE_LIBS -lXmu"
+ fi
+
+ GTK_LIBS="$X_PRE_LIBS $X_POST_LIBS -lXpm"
+ $as_echo "#define USE_MOTIF 1" >>confdefs.h
- JACK_LIBS="`$PKG_CONFIG jack --libs`"
- JACK_FLAGS="`$PKG_CONFIG jack --cflags`"
- fi
- fi
+ GRAPHICS_TOOLKIT="Motif"
+ ac_snd_gui_choice=Motif
fi
-case "$host" in
- *-*-linux*)
- $as_echo "#define MUS_LINUX 1" >>confdefs.h
+#--------------------------------------------------------------------------------
+# Gtk
+#--------------------------------------------------------------------------------
- LDSO_FLAGS="-shared"
- LIBS="$LIBS -lm"
- if test "$ac_cv_header_dlfcn_h" = yes ; then
- LDFLAGS="$LDFLAGS -ldl"
- fi
- if test "$GCC" = yes ; then
- SO_FLAGS="-fPIC $SO_FLAGS"
- fi
+if test "$ac_snd_gui_choice" = none ; then
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG gtk+-3.0 --exists ; then
+ GTK_CFLAGS="`$PKG_CONFIG gtk+-3.0 --cflags`"
+ GTK_LIBS="`$PKG_CONFIG gtk+-3.0 --libs`"
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-3.0 --libs-only-L` `$PKG_CONFIG gtk+-3.0 --libs-only-l`"
+ ac_snd_gui_choice=gtk
+ else
+ if $PKG_CONFIG gtk+-2.0 --exists ; then
+ GTK_CFLAGS="`$PKG_CONFIG gtk+-2.0 --cflags`"
+ GTK_LIBS="`$PKG_CONFIG gtk+-2.0 --libs`"
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
+ ac_snd_gui_choice=gtk
+ fi
+ fi
+ fi
+ if test "$ac_snd_gui_choice" = gtk ; then
+ GX_FILES="GTK_O_FILES"
+ GX_HEADERS="SND_G_HEADERS"
+ $as_echo "#define USE_GTK 1" >>confdefs.h
- AUDIO_SYSTEM=ALSA
- if test "$with_oss" = yes ; then
- AUDIO_SYSTEM=OSS
- else
+ GRAPHICS_TOOLKIT="Gtk"
- if test "$ac_cv_header_alsa_asoundlib_h" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lasound" >&5
-$as_echo_n "checking for main in -lasound... " >&6; }
-if ${ac_cv_lib_asound_main+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lasound $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ if test x$PKG_CONFIG != xno ; then
+ CAIRO_CFLAGS="`$PKG_CONFIG cairo --cflags-only-I`"
+
+ fi
+ fi
+fi
-int
-main ()
-{
-return main ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_asound_main=yes
-else
- ac_cv_lib_asound_main=no
+if test "$ac_snd_gui_choice" = none ; then
+ $as_echo "#define USE_NO_GUI 1" >>confdefs.h
+
+ GX_FILES="NO_GUI_O_FILES"
+ GX_HEADERS="NO_GUI_HEADERS"
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+
+
+# fallback on no-gui
+if test "$with_gui" = no ; then
+ $as_echo "#define USE_NO_GUI 1" >>confdefs.h
+
+ GX_FILES="NO_GUI_O_FILES"
+ GX_HEADERS="NO_GUI_HEADERS"
+ ac_snd_gui_choice=no
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_asound_main" >&5
-$as_echo "$ac_cv_lib_asound_main" >&6; }
-if test "x$ac_cv_lib_asound_main" = xyes; then :
- AUDIO_SYSTEM=ALSA
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the ALSA library" >&5
-$as_echo "$as_me: WARNING: can't find the ALSA library" >&2;}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#--------------------------------------------------------------------------------
+# OpenGL
+#--------------------------------------------------------------------------------
+
+GL_LIBS=""
+GL_FILES=""
+GL_FLAGS=""
+
+if test "$with_gl" = yes ; then
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG gl --exists ; then
+
+ GL_CFLAGS="`$PKG_CONFIG gl --cflags`"
+ GL_LIBS="`$PKG_CONFIG gl --libs`"
+ GL_FILES="gl.o"
+ $as_echo "#define HAVE_GL 1" >>confdefs.h
+
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES openGL"
+
+ if $PKG_CONFIG glu --exists ; then
+ $as_echo "#define HAVE_GLU 1" >>confdefs.h
+
+ GL_CFLAGS="$GL_CFLAGS `$PKG_CONFIG glu --cflags`"
+ GL_LIBS="$GL_LIBS `$PKG_CONFIG glu --libs`"
+ fi
+
+ if test "$with_gl2ps" = yes ; then
+ $as_echo "#define WITH_GL2PS 1" >>confdefs.h
+
+ RANDOM_FEATURES="$RANDOM_FEATURES gl2ps"
+ GL_FILES="$GL_FILES gl2ps.o"
+ fi
+ fi
+ fi
fi
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find the ALSA header files" >&5
-$as_echo "$as_me: WARNING: can't find the ALSA header files" >&2;}
- AUDIO_SYSTEM=OSS
- fi
- fi
- if test "$with_jack" = yes ; then
- if test "$with_alsa" != yes ; then
- AUDIO_SYSTEM=JACK
- fi
- fi
- case $AUDIO_SYSTEM in
- ALSA)
- # if alsa version < 1.0 complain and use OSS
- alsa_ok=yes
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ALSA 1.0 or later" >&5
-$as_echo_n "checking for ALSA 1.0 or later... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <alsa/asoundlib.h>
-int
-main ()
-{
- #if (SND_LIB_MAJOR < 1)
- #error too old
- #endif
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- alsa_ok=yes
-else
- alsa_ok=no
+
+
+#--------------------------------------------------------------------------------
+# language
+#--------------------------------------------------------------------------------
+
+# language choice: ruby if --with-ruby and we can find a ruby pc file
+# forth if --with-forth
+# none if --without-extension-language
+# s7 otherwise
+
+XEN_LIBS=""
+XEN_CFLAGS=""
+ac_snd_extension_language=none
+
+if test "$with_extension_language" = no ; then
+ ac_snd_extension_language=no
+ LOCAL_LANGUAGE="None"
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $alsa_ok" >&5
-$as_echo "$alsa_ok" >&6; }
- if test "$alsa_ok" = yes ; then
- $as_echo "#define HAVE_ALSA 1" >>confdefs.h
-
- if test "$with_static_alsa" = yes ; then
- AUDIO_LIB="/usr/lib/libasound.a"
- else
- AUDIO_LIB="-lasound"
- fi
- if test "$with_jack" = yes ; then
- if test "$with_static_alsa" = yes ; then
- AUDIO_LIB="/usr/lib/libasound.a -lsamplerate"
- else
- AUDIO_LIB="-lasound -lsamplerate"
- fi
- $as_echo "#define HAVE_JACK_IN_LINUX 1" >>confdefs.h
-
- fi
- else
- AUDIO_SYSTEM=OSS
- $as_echo "#define HAVE_OSS 1" >>confdefs.h
-
- fi
- ;;
- JACK)
- $as_echo "#define HAVE_JACK_IN_LINUX 1" >>confdefs.h
-
- $as_echo "#define HAVE_OSS 1" >>confdefs.h
-
- JACK_LIBS="$JACK_LIBS -lpthread"
-# added -lpthread 21-May-10 for FC13 (Bill S)
- AUDIO_LIB="-lsamplerate"
- ;;
- OSS)
- $as_echo "#define HAVE_OSS 1" >>confdefs.h
-
- AUDIO_SYSTEM=OSS
- ;;
- esac
- ;;
- *-*-sunos4*)
- $as_echo "#define MUS_SUN 1" >>confdefs.h
- LIBS="$LIBS -lm"
- AUDIO_SYSTEM=Sun
- ;;
- *-*-solaris*)
- $as_echo "#define MUS_SUN 1" >>confdefs.h
- LIBS="$LIBS -lm -ldl"
-# odd... this causes an error in the sndlib configure (can't find libdl) but is needed here?
- AUDIO_SYSTEM=Sun
- LDSO_FLAGS="-G"
-# if __SUNPRO_C we could add -xO3
- ;;
- *-*-hpux*)
- $as_echo "#define MUS_HPUX 1" >>confdefs.h
+#--------------------------------------------------------------------------------
+# Ruby
+#--------------------------------------------------------------------------------
- AUDIO_SYSTEM=Hpux
- LDSO_FLAGS="+z -Ae +DA1.1"
- if test "$GCC" = yes ; then
- SO_FLAGS="-fPIC $SO_FLAGS"
- fi
- ;;
- *-*-bsdi*)
- $as_echo "#define HAVE_OSS 1" >>confdefs.h
+if test "$with_ruby" = yes ; then
+ if test x$PKG_CONFIG != xno ; then
- LIBS="$LIBS -lm"
- AUDIO_SYSTEM=OSS
- if test "$GCC" = yes ; then
- SO_FLAGS="-fPIC $SO_FLAGS"
- fi
- ;;
- *-*-freebsd*)
- $as_echo "#define HAVE_OSS 1" >>confdefs.h
+ if test "$ac_snd_extension_language" = none ; then
+ if $PKG_CONFIG ruby-2.2 --exists ; then
+ $as_echo "#define HAVE_RUBY 1" >>confdefs.h
- LIBS="$LIBS -lm"
- AUDIO_SYSTEM=OSS
- if test "$GCC" = yes ; then
- SO_LD="gcc"
- SO_FLAGS="-fPIC $SO_FLAGS"
- LDSO_FLAGS="-shared"
+ XEN_CFLAGS="`$PKG_CONFIG ruby-2.2 --cflags`"
+ # this depends on building ruby itself with the --enable-shared flag
+ XEN_LIBS="`$PKG_CONFIG ruby-2.2 --libs`"
+ LOCAL_LANGUAGE="Ruby"
+ ac_snd_extension_language=Ruby
fi
- ;;
- *-*-openbsd*)
- $as_echo "#define MUS_OPENBSD 1" >>confdefs.h
+ fi
- AUDIO_SYSTEM=OpenBSD
- if test "$GCC" = yes ; then
- SO_FLAGS="-fPIC $SO_FLAGS"
+ if test "$ac_snd_extension_language" = none ; then
+ if $PKG_CONFIG ruby-2.1 --exists ; then
+ $as_echo "#define HAVE_RUBY 1" >>confdefs.h
+
+ XEN_CFLAGS="`$PKG_CONFIG ruby-2.1 --cflags`"
+ # this depends on building ruby itself with the --enable-shared flag
+ XEN_LIBS="`$PKG_CONFIG ruby-2.1 --libs`"
+ LOCAL_LANGUAGE="Ruby"
+ ac_snd_extension_language=Ruby
fi
- ;;
- *-*-netbsd*)
- $as_echo "#define MUS_NETBSD 1" >>confdefs.h
+ fi
- AUDIO_SYSTEM=NetBSD
- if test "$GCC" = yes ; then
- SO_LD="gcc"
- SO_FLAGS="-fPIC $SO_FLAGS"
- LDSO_FLAGS="-shared"
+ if test "$ac_snd_extension_language" = none ; then
+ if $PKG_CONFIG ruby-2.0 --exists ; then
+ $as_echo "#define HAVE_RUBY 1" >>confdefs.h
+
+ XEN_CFLAGS="`$PKG_CONFIG ruby-2.0 --cflags`"
+ # this depends on building ruby itself with the --enable-shared flag
+ XEN_LIBS="`$PKG_CONFIG ruby-2.0 --libs`"
+ LOCAL_LANGUAGE="Ruby"
+ ac_snd_extension_language=Ruby
fi
- ;;
- *-*-cygwin*)
- if test "$with_jack" != yes ; then
- $as_echo "#define MUS_WINDOZE 1" >>confdefs.h
+ fi
- AUDIO_SYSTEM=Windoze
- fi
- ;;
- *-*-mingw*)
- $as_echo "#define MUS_WINDOZE 1" >>confdefs.h
+ if test "$ac_snd_extension_language" = none ; then
+ if $PKG_CONFIG ruby --exists ; then
+ $as_echo "#define HAVE_RUBY 1" >>confdefs.h
- audio_system=Windoze
- LIBS="$LIBS -lwinmm -lwsock32"
- ;;
- *-apple-*)
- if test "$with_jack" != yes ; then
+ XEN_CFLAGS="`$PKG_CONFIG ruby --cflags`"
+ # this depends on building ruby itself with the --enable-shared flag
+ XEN_LIBS="`$PKG_CONFIG ruby --libs`"
+ LOCAL_LANGUAGE="Ruby"
+ ac_snd_extension_language=Ruby
+ fi
+ fi
- $as_echo "#define MUS_MAC_OSX 1" >>confdefs.h
+ if test "$ac_snd_extension_language" = none ; then
+ if $PKG_CONFIG ruby-1.9.3 --exists ; then
+ $as_echo "#define HAVE_RUBY 1" >>confdefs.h
- AUDIO_SYSTEM=MacOSX
- AUDIO_LIB="-framework CoreAudio -framework CoreFoundation -framework CoreMIDI"
+ XEN_CFLAGS="`$PKG_CONFIG ruby-1.9.3 --cflags`"
+ # this depends on building ruby itself with the --enable-shared flag
+ XEN_LIBS="`$PKG_CONFIG ruby-1.9.3 --libs`"
+ LOCAL_LANGUAGE="Ruby"
+ ac_snd_extension_language=Ruby
+ fi
+ fi
- # OSX 10.5, deprecating earlier AudioDeviceRemoveIOProc
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for AudioDeviceDestroyIOProcID" >&5
-$as_echo_n "checking for AudioDeviceDestroyIOProcID... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <CoreServices/CoreServices.h>
- #include <CoreAudio/CoreAudio.h>
-int
-main ()
-{
-AudioDeviceIOProcID procId;
- AudioDeviceID device = kAudioDeviceUnknown;
- AudioDeviceDestroyIOProcID(device, procId)
+ if test "$ac_snd_extension_language" = none ; then
+ if $PKG_CONFIG ruby-1.9 --exists ; then
+ $as_echo "#define HAVE_RUBY 1" >>confdefs.h
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- $as_echo "#define HAVE_AUDIODEVICEDESTROYIOPROCID 1" >>confdefs.h
+ XEN_CFLAGS="`$PKG_CONFIG ruby-1.9 --cflags`"
+ # this depends on building ruby itself with the --enable-shared flag
+ XEN_LIBS="`$PKG_CONFIG ruby-1.9 --libs`"
+ LOCAL_LANGUAGE="Ruby"
+ ac_snd_extension_language=Ruby
+ fi
+ fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
+ if test "$ac_snd_extension_language" = none ; then
+ if $PKG_CONFIG ruby-1.8 --exists ; then
+ $as_echo "#define HAVE_RUBY 1" >>confdefs.h
+
+ XEN_CFLAGS="`$PKG_CONFIG ruby-1.8 --cflags`"
+ # this depends on building ruby itself with the --enable-shared flag
+ XEN_LIBS="`$PKG_CONFIG ruby-1.8 --libs`"
+ LOCAL_LANGUAGE="Ruby"
+ ac_snd_extension_language=Ruby
+ fi
+ fi
+
+ fi
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kAudioDevicePropertyDeviceManufacturer" >&5
-$as_echo_n "checking for kAudioDevicePropertyDeviceManufacturer... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <CoreServices/CoreServices.h>
- #include <CoreAudio/CoreAudio.h>
-int
-main ()
-{
-AudioDeviceID deviceID;
- UInt32 trans_size = 0, trans;
- trans_size = sizeof(UInt32);
- AudioDeviceGetProperty(deviceID, 0, true, kAudioDevicePropertyTransportType, &trans_size, &trans)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- $as_echo "#define HAVE_KAUDIODEVICEPROPERTYTRANSPORTTYPE 1" >>confdefs.h
+#--------------------------------------------------------------------------------
+# Forth
+#--------------------------------------------------------------------------------
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
+if test "$with_forth" = yes ; then
+ # Extract the first word of "fth", so it can be a program name with args.
+set dummy fth; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_path_FTH+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ case $FTH in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_FTH="$FTH" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_FTH="$as_dir/$ac_word$ac_exec_ext"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+ test -z "$ac_cv_path_FTH" && ac_cv_path_FTH="no"
+ ;;
+esac
+fi
+FTH=$ac_cv_path_FTH
+if test -n "$FTH"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FTH" >&5
+$as_echo "$FTH" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kLinearPCMFormatFlagIsNonInterleaved" >&5
-$as_echo_n "checking for kLinearPCMFormatFlagIsNonInterleaved... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <CoreServices/CoreServices.h>
- #include <CoreAudio/CoreAudio.h>
-int
-main ()
-{
-int i; i = kLinearPCMFormatFlagIsNonInterleaved
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- $as_echo "#define HAVE_KLINEARPCMFORMATFLAGISNONINTERLEAVED 1" >>confdefs.h
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Forth" >&5
+$as_echo_n "checking for Forth... " >&6; }
+ if test "${FTH}" != no ; then
+ XEN_CFLAGS=`${FTH} --no-init-file --eval .cflags`
+ XEN_LIBS=`${FTH} --no-init-file --eval .libs`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+ $as_echo "#define HAVE_FORTH 1" >>confdefs.h
+
+ LOCAL_LANGUAGE="Forth"
+ ac_snd_extension_language=Forth
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
+ fi
fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- else
- AUDIO_SYSTEM=JACK
- JACK_LIBS="-framework CoreAudio -framework CoreServices -framework AudioUnit -L/usr/local/lib -ljack -lsamplerate"
- JACK_FLAGS="-I/usr/local/include"
- fi
- ;;
-esac
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for audio system" >&5
-$as_echo_n "checking for audio system... " >&6; }
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $AUDIO_SYSTEM" >&5
-$as_echo "$AUDIO_SYSTEM" >&6; }
-fi
-fi
+#--------------------------------------------------------------------------------
+# s7 (the default)
+#--------------------------------------------------------------------------------
+
+if test "$with_s7" != no && test "$ac_snd_extension_language" = none ; then
+ $as_echo "#define HAVE_SCHEME 1" >>confdefs.h
+ ac_snd_extension_language=s7
+ LOCAL_LANGUAGE="s7"
+ S7_LIB="s7.o"
+fi
@@ -10109,7 +5343,7 @@ fi
#--------------------------------------------------------------------------------
-# OGG, Flac, Speex, Mpeg, Timidity, Shorten, TTA, Wavpack
+# OGG, Flac, Speex, Mpeg, Timidity, TTA, Wavpack
# --------------------------------------------------------------------------------
# Extract the first word of "oggdec", so it can be a program name with args.
@@ -10130,7 +5364,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_PATH_OGGDEC="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -10171,7 +5405,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_PATH_OGGENC="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -10229,7 +5463,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_PATH_MPG123="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -10281,7 +5515,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_PATH_MPG321="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -10308,6 +5542,8 @@ fi
if test "$PATH_MPG321" != "no" ; then
$as_echo "#define HAVE_MPEG 1" >>confdefs.h
+ $as_echo "#define HAVE_MPG321 1" >>confdefs.h
+
cat >>confdefs.h <<_ACEOF
#define PATH_MPG321 "${PATH_MPG321}"
_ACEOF
@@ -10333,7 +5569,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_PATH_SPEEXDEC="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -10350,184 +5586,22 @@ PATH_SPEEXDEC=$ac_cv_path_PATH_SPEEXDEC
if test -n "$PATH_SPEEXDEC"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_SPEEXDEC" >&5
$as_echo "$PATH_SPEEXDEC" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
- # Speex read
-# Extract the first word of "speexenc", so it can be a program name with args.
-set dummy speexenc; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PATH_SPEEXENC+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- case $PATH_SPEEXENC in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PATH_SPEEXENC="$PATH_SPEEXENC" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PATH_SPEEXENC="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PATH_SPEEXENC" && ac_cv_path_PATH_SPEEXENC="no"
- ;;
-esac
-fi
-PATH_SPEEXENC=$ac_cv_path_PATH_SPEEXENC
-if test -n "$PATH_SPEEXENC"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_SPEEXENC" >&5
-$as_echo "$PATH_SPEEXENC" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
- # Speex write
-
-if test "$PATH_SPEEXDEC" != "no" ; then
- if test "$PATH_SPEEXENC" != "no" ; then
- $as_echo "#define HAVE_SPEEX 1" >>confdefs.h
-
- cat >>confdefs.h <<_ACEOF
-#define PATH_SPEEXDEC "${PATH_SPEEXDEC}"
-_ACEOF
-
- cat >>confdefs.h <<_ACEOF
-#define PATH_SPEEXENC "${PATH_SPEEXENC}"
-_ACEOF
-
- fi
-fi
-
-
-# Extract the first word of "flac", so it can be a program name with args.
-set dummy flac; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PATH_FLAC+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- case $PATH_FLAC in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PATH_FLAC="$PATH_FLAC" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PATH_FLAC="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PATH_FLAC" && ac_cv_path_PATH_FLAC="no"
- ;;
-esac
-fi
-PATH_FLAC=$ac_cv_path_PATH_FLAC
-if test -n "$PATH_FLAC"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_FLAC" >&5
-$as_echo "$PATH_FLAC" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
- # Flac read/write
-
-if test "$PATH_FLAC" != "no" ; then
- $as_echo "#define HAVE_FLAC 1" >>confdefs.h
-
- cat >>confdefs.h <<_ACEOF
-#define PATH_FLAC "${PATH_FLAC}"
-_ACEOF
-
-fi
-
-
-# Extract the first word of "timidity", so it can be a program name with args.
-set dummy timidity; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PATH_TIMIDITY+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- case $PATH_TIMIDITY in
- [\\/]* | ?:[\\/]*)
- ac_cv_path_PATH_TIMIDITY="$PATH_TIMIDITY" # Let the user override the test with a path.
- ;;
- *)
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PATH_TIMIDITY="$as_dir/$ac_word$ac_exec_ext"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PATH_TIMIDITY" && ac_cv_path_PATH_TIMIDITY="no"
- ;;
-esac
-fi
-PATH_TIMIDITY=$ac_cv_path_PATH_TIMIDITY
-if test -n "$PATH_TIMIDITY"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_TIMIDITY" >&5
-$as_echo "$PATH_TIMIDITY" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
- # Timidity for .mid -> .wav
-
-if test "$PATH_TIMIDITY" != "no" ; then
- $as_echo "#define HAVE_TIMIDITY 1" >>confdefs.h
-
- cat >>confdefs.h <<_ACEOF
-#define PATH_TIMIDITY "${PATH_TIMIDITY}"
-_ACEOF
-
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
-
-# Extract the first word of "shorten", so it can be a program name with args.
-set dummy shorten; ac_word=$2
+ # Speex read
+# Extract the first word of "speexenc", so it can be a program name with args.
+set dummy speexenc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PATH_SHORTEN+:} false; then :
+if ${ac_cv_path_PATH_SPEEXENC+:} false; then :
$as_echo_n "(cached) " >&6
else
- case $PATH_SHORTEN in
+ case $PATH_SPEEXENC in
[\\/]* | ?:[\\/]*)
- ac_cv_path_PATH_SHORTEN="$PATH_SHORTEN" # Let the user override the test with a path.
+ ac_cv_path_PATH_SPEEXENC="$PATH_SPEEXENC" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
@@ -10536,8 +5610,8 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PATH_SHORTEN="$as_dir/$ac_word$ac_exec_ext"
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_PATH_SPEEXENC="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -10545,41 +5619,47 @@ done
done
IFS=$as_save_IFS
- test -z "$ac_cv_path_PATH_SHORTEN" && ac_cv_path_PATH_SHORTEN="no"
+ test -z "$ac_cv_path_PATH_SPEEXENC" && ac_cv_path_PATH_SPEEXENC="no"
;;
esac
fi
-PATH_SHORTEN=$ac_cv_path_PATH_SHORTEN
-if test -n "$PATH_SHORTEN"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_SHORTEN" >&5
-$as_echo "$PATH_SHORTEN" >&6; }
+PATH_SPEEXENC=$ac_cv_path_PATH_SPEEXENC
+if test -n "$PATH_SPEEXENC"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_SPEEXENC" >&5
+$as_echo "$PATH_SPEEXENC" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
+ # Speex write
+if test "$PATH_SPEEXDEC" != "no" ; then
+ if test "$PATH_SPEEXENC" != "no" ; then
+ $as_echo "#define HAVE_SPEEX 1" >>confdefs.h
-if test "$PATH_SHORTEN" != "no" ; then
- $as_echo "#define HAVE_SHORTEN 1" >>confdefs.h
+ cat >>confdefs.h <<_ACEOF
+#define PATH_SPEEXDEC "${PATH_SPEEXDEC}"
+_ACEOF
- cat >>confdefs.h <<_ACEOF
-#define PATH_SHORTEN "${PATH_SHORTEN}"
+ cat >>confdefs.h <<_ACEOF
+#define PATH_SPEEXENC "${PATH_SPEEXENC}"
_ACEOF
+ fi
fi
-# Extract the first word of "ttaenc", so it can be a program name with args.
-set dummy ttaenc; ac_word=$2
+# Extract the first word of "flac", so it can be a program name with args.
+set dummy flac; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PATH_TTA+:} false; then :
+if ${ac_cv_path_PATH_FLAC+:} false; then :
$as_echo_n "(cached) " >&6
else
- case $PATH_TTA in
+ case $PATH_FLAC in
[\\/]* | ?:[\\/]*)
- ac_cv_path_PATH_TTA="$PATH_TTA" # Let the user override the test with a path.
+ ac_cv_path_PATH_FLAC="$PATH_FLAC" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
@@ -10588,8 +5668,8 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PATH_TTA="$as_dir/$ac_word$ac_exec_ext"
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_PATH_FLAC="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -10597,41 +5677,41 @@ done
done
IFS=$as_save_IFS
- test -z "$ac_cv_path_PATH_TTA" && ac_cv_path_PATH_TTA="no"
+ test -z "$ac_cv_path_PATH_FLAC" && ac_cv_path_PATH_FLAC="no"
;;
esac
fi
-PATH_TTA=$ac_cv_path_PATH_TTA
-if test -n "$PATH_TTA"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_TTA" >&5
-$as_echo "$PATH_TTA" >&6; }
+PATH_FLAC=$ac_cv_path_PATH_FLAC
+if test -n "$PATH_FLAC"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_FLAC" >&5
+$as_echo "$PATH_FLAC" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
+ # Flac read/write
-
-if test "$PATH_TTA" != "no" ; then
- $as_echo "#define HAVE_TTA 1" >>confdefs.h
+if test "$PATH_FLAC" != "no" ; then
+ $as_echo "#define HAVE_FLAC 1" >>confdefs.h
cat >>confdefs.h <<_ACEOF
-#define PATH_TTA "${PATH_TTA}"
+#define PATH_FLAC "${PATH_FLAC}"
_ACEOF
fi
-# Extract the first word of "wavpack", so it can be a program name with args.
-set dummy wavpack; ac_word=$2
+# Extract the first word of "timidity", so it can be a program name with args.
+set dummy timidity; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PATH_WAVPACK+:} false; then :
+if ${ac_cv_path_PATH_TIMIDITY+:} false; then :
$as_echo_n "(cached) " >&6
else
- case $PATH_WAVPACK in
+ case $PATH_TIMIDITY in
[\\/]* | ?:[\\/]*)
- ac_cv_path_PATH_WAVPACK="$PATH_WAVPACK" # Let the user override the test with a path.
+ ac_cv_path_PATH_TIMIDITY="$PATH_TIMIDITY" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
@@ -10640,8 +5720,8 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PATH_WAVPACK="$as_dir/$ac_word$ac_exec_ext"
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_PATH_TIMIDITY="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -10649,30 +5729,41 @@ done
done
IFS=$as_save_IFS
- test -z "$ac_cv_path_PATH_WAVPACK" && ac_cv_path_PATH_WAVPACK="no"
+ test -z "$ac_cv_path_PATH_TIMIDITY" && ac_cv_path_PATH_TIMIDITY="no"
;;
esac
fi
-PATH_WAVPACK=$ac_cv_path_PATH_WAVPACK
-if test -n "$PATH_WAVPACK"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_WAVPACK" >&5
-$as_echo "$PATH_WAVPACK" >&6; }
+PATH_TIMIDITY=$ac_cv_path_PATH_TIMIDITY
+if test -n "$PATH_TIMIDITY"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_TIMIDITY" >&5
+$as_echo "$PATH_TIMIDITY" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
+ # Timidity for .mid -> .wav
+
+if test "$PATH_TIMIDITY" != "no" ; then
+ $as_echo "#define HAVE_TIMIDITY 1" >>confdefs.h
+
+ cat >>confdefs.h <<_ACEOF
+#define PATH_TIMIDITY "${PATH_TIMIDITY}"
+_ACEOF
+
+fi
+
-# Extract the first word of "wvunpack", so it can be a program name with args.
-set dummy wvunpack; ac_word=$2
+# Extract the first word of "ttaenc", so it can be a program name with args.
+set dummy ttaenc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_PATH_WVUNPACK+:} false; then :
+if ${ac_cv_path_PATH_TTA+:} false; then :
$as_echo_n "(cached) " >&6
else
- case $PATH_WVUNPACK in
+ case $PATH_TTA in
[\\/]* | ?:[\\/]*)
- ac_cv_path_PATH_WVUNPACK="$PATH_WVUNPACK" # Let the user override the test with a path.
+ ac_cv_path_PATH_TTA="$PATH_TTA" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
@@ -10681,326 +5772,50 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_PATH_WVUNPACK="$as_dir/$ac_word$ac_exec_ext"
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_PATH_TTA="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
- done
-IFS=$as_save_IFS
-
- test -z "$ac_cv_path_PATH_WVUNPACK" && ac_cv_path_PATH_WVUNPACK="no"
- ;;
-esac
-fi
-PATH_WVUNPACK=$ac_cv_path_PATH_WVUNPACK
-if test -n "$PATH_WVUNPACK"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_WVUNPACK" >&5
-$as_echo "$PATH_WVUNPACK" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
-
-
-if test "$PATH_WAVPACK" != "no" ; then
- if test "$PATH_WVUNPACK" != "no" ; then
- $as_echo "#define HAVE_WAVPACK 1" >>confdefs.h
-
- cat >>confdefs.h <<_ACEOF
-#define PATH_WAVPACK "${PATH_WAVPACK}"
-_ACEOF
-
- cat >>confdefs.h <<_ACEOF
-#define PATH_WVUNPACK "${PATH_WVUNPACK}"
-_ACEOF
-
- fi
-fi
-
-# other decoders that I've looked at aren't acceptable in this context because they put various
-# special restrictions on use, or hide source code, or are just nuts.
-
-
-
-
-#--------------------------------------------------------------------------------
-# statvfs
-#--------------------------------------------------------------------------------
-
-statvfs_ok=0
-if test "$ac_cv_func_statvfs" = yes ; then
- if test "$ac_cv_header_sys_statvfs_h" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for statvfs" >&5
-$as_echo_n "checking for statvfs... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/statvfs.h>
-int
-main ()
-{
-struct statvfs buf; statvfs("test.snd", &buf)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- $as_echo "#define USE_STATVFS 1" >>confdefs.h
-
- statvfs_ok=1
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if test $statvfs_ok = 1 ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- fi
- fi
-fi
-
-statfs_ok=0
-if test $statvfs_ok = 0 ; then
- if test "$ac_cv_func_statfs" = yes ; then
- if test "$ac_cv_header_sys_param_h" = yes ; then
- if test "$ac_cv_header_sys_mount_h" = yes ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for statfs" >&5
-$as_echo_n "checking for statfs... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <sys/param.h>
- #include <sys/mount.h>
-
-int
-main ()
-{
-struct statfs buf;
- int size = 0;
- statfs("test.snd", &buf);
- if (buf.f_bsize = 1024)
- size = (int)(buf.f_bavail)
-
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- $as_echo "#define USE_STATFS 1" >>confdefs.h
-
- statfs_ok=1
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
- if test $statfs_ok = 1 ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
-$as_echo "yes" >&6; }
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- fi
- fi
- fi
- fi
-fi
-
-
-#--------------------------------------------------------------------------------
-# debugging flag
-#--------------------------------------------------------------------------------
-
-# Check whether --enable-snd-debug was given.
-if test "${enable_snd_debug+set}" = set; then :
- enableval=$enable_snd_debug; if test "$enable_snd_debug" = yes ; then
- $as_echo "#define MUS_DEBUGGING 1" >>confdefs.h
-
- RANDOM_FEATURES="$RANDOM_FEATURES debugging"
-
- ansi=
- if test -z "$ansi"; then
- msg="for C compiler warning flags"
- else
- msg="for C compiler warning and ANSI conformance flags"
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking $msg" >&5
-$as_echo_n "checking $msg... " >&6; }
-if ${vl_cv_prog_cc_warnings+:} false; then :
- $as_echo_n "(cached) " >&6
-else
-
- if test -n "$CC"; then
- cat > conftest.c <<EOF
-int main(int argc, char **argv) { return 0; }
-EOF
-
- if test "$GCC" = "yes"; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-g3 -Wall"
- else
- vl_cv_prog_cc_warnings="-g3 -Wall -ansi -pedantic"
- fi
-
-
- elif $CC -V 2>&1 | grep -i "WorkShop" > /dev/null 2>&1 &&
- $CC -c -v -Xc conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-v"
- else
- vl_cv_prog_cc_warnings="-v -Xc"
- fi
-
- elif $CC -V 2>&1 | grep -i "Digital UNIX Compiler" > /dev/null 2>&1 &&
- $CC -c -verbose -w0 -warnprotos -std1 conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-verbose -w0 -warnprotos"
- else
- vl_cv_prog_cc_warnings="-verbose -w0 -warnprotos -std1"
- fi
-
- elif $CC 2>&1 | grep -i "C for AIX Compiler" > /dev/null 2>&1 &&
- $CC -c -qlanglvl=ansi -qinfo=all conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-qsrcmsg -qinfo=all:noppt:noppc:noobs:nocnd"
- else
- vl_cv_prog_cc_warnings="-qsrcmsg -qinfo=all:noppt:noppc:noobs:nocnd -qlanglvl=ansi"
- fi
-
- elif $CC -version 2>&1 | grep -i "MIPSpro Compilers" > /dev/null 2>&1 &&
- $CC -c -fullwarn -ansi -ansiE conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-fullwarn"
- else
- vl_cv_prog_cc_warnings="-fullwarn -ansi -ansiE"
- fi
-
- elif what $CC 2>&1 | grep -i "HP C Compiler" > /dev/null 2>&1 &&
- $CC -c -Aa +w1 conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="+w1"
- else
- vl_cv_prog_cc_warnings="+w1 -Aa"
- fi
-
- elif $CC -V 2>&1 | grep "/SX" > /dev/null 2>&1 &&
- $CC -c -pvctl,fullmsg -Xc conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-pvctl,fullmsg"
- else
- vl_cv_prog_cc_warnings="-pvctl,fullmsg -Xc"
- fi
-
- elif $CC -V 2>&1 | grep -i "Cray" > /dev/null 2>&1 &&
- $CC -c -h msglevel 2 conftest.c > /dev/null 2>&1 &&
- test -f conftest.o; then
- if test -z "$ansi"; then
- vl_cv_prog_cc_warnings="-h msglevel 2"
- else
- vl_cv_prog_cc_warnings="-h msglevel 2 -h conform"
- fi
-
- fi
- rm -f conftest.*
- fi
- if test -n "$vl_cv_prog_cc_warnings"; then
- CFLAGS="$CFLAGS $vl_cv_prog_cc_warnings"
- else
- vl_cv_prog_cc_warnings="unknown"
- fi
-
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $vl_cv_prog_cc_warnings" >&5
-$as_echo "$vl_cv_prog_cc_warnings" >&6; }
-
- fi
-fi
-
-
-if test "$with_profiling" = yes ; then
- $as_echo "#define WITH_PROFILING 1" >>confdefs.h
-
-fi
-
-
-
-#--------------------------------------------------------------------------------
-# sigsetjmp special case
-#--------------------------------------------------------------------------------
-
-# look for sigsetjmp for segfault trap
-if test "$enable_snd_debug" != yes ; then
- trap_segfault=no
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigsetjmp" >&5
-$as_echo_n "checking for sigsetjmp... " >&6; }
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-#include <setjmp.h>
-int
-main ()
-{
-sigjmp_buf hi; sigsetjmp(hi,1)
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- trap_segfault=yes
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- if test $trap_segfault = yes; then
- $as_echo "#define MUS_TRAP_SEGFAULT 1" >>confdefs.h
+ done
+IFS=$as_save_IFS
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $trap_segfault" >&5
-$as_echo "$trap_segfault" >&6; }
+ test -z "$ac_cv_path_PATH_TTA" && ac_cv_path_PATH_TTA="no"
+ ;;
+esac
+fi
+PATH_TTA=$ac_cv_path_PATH_TTA
+if test -n "$PATH_TTA"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_TTA" >&5
+$as_echo "$PATH_TTA" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
-#--------------------------------------------------------------------------------
-# sndlib
-#--------------------------------------------------------------------------------
-#
-# look for sndlib-config, check mus_sample_bits against current choice [with-float-sample, with-sample-width]
-# also language (s7, Ruby, Forth) needs to match (what about versions!) and audio choice
-# check against needed version (17.2 for now -- need mus_vct_copy in vct.c)
-# set SNDLIB_FILES and SNDLIB_LIB
-SNDLIB_FILES="SNDLIB_O_FILES"
-if test "$enable_snd_debug" != yes ; then
- SNDLIB_LIB=""
-fi
-SNDLIB_PREFIX=""
+if test "$PATH_TTA" != "no" ; then
+ $as_echo "#define HAVE_TTA 1" >>confdefs.h
+
+ cat >>confdefs.h <<_ACEOF
+#define PATH_TTA "${PATH_TTA}"
+_ACEOF
-# Check whether --with-shared-sndlib was given.
-if test "${with_shared_sndlib+set}" = set; then :
- withval=$with_shared_sndlib;
fi
-if test "$with_shared_sndlib" = yes; then
- if test "$SNDLIB_CONFIG_path" != "" ; then
- if ! test -x "${SNDLIB_CONFIG_path}sndlib-config" ; then
- # try adding the "/" to the path
- SNDLIB_CONFIG_path="${SNDLIB_CONFIG_path}/"
- fi
- fi
- if ! test -x "${SNDLIB_CONFIG_path}sndlib-config" ; then
- # Extract the first word of "sndlib-config", so it can be a program name with args.
-set dummy sndlib-config; ac_word=$2
+
+# Extract the first word of "wavpack", so it can be a program name with args.
+set dummy wavpack; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_path_SNDLIB_CONFIG+:} false; then :
+if ${ac_cv_path_PATH_WAVPACK+:} false; then :
$as_echo_n "(cached) " >&6
else
- case $SNDLIB_CONFIG in
+ case $PATH_WAVPACK in
[\\/]* | ?:[\\/]*)
- ac_cv_path_SNDLIB_CONFIG="$SNDLIB_CONFIG" # Let the user override the test with a path.
+ ac_cv_path_PATH_WAVPACK="$PATH_WAVPACK" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
@@ -11009,8 +5824,8 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_path_SNDLIB_CONFIG="$as_dir/$ac_word$ac_exec_ext"
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_PATH_WAVPACK="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -11018,193 +5833,341 @@ done
done
IFS=$as_save_IFS
- test -z "$ac_cv_path_SNDLIB_CONFIG" && ac_cv_path_SNDLIB_CONFIG="no"
+ test -z "$ac_cv_path_PATH_WAVPACK" && ac_cv_path_PATH_WAVPACK="no"
;;
esac
fi
-SNDLIB_CONFIG=$ac_cv_path_SNDLIB_CONFIG
-if test -n "$SNDLIB_CONFIG"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $SNDLIB_CONFIG" >&5
-$as_echo "$SNDLIB_CONFIG" >&6; }
+PATH_WAVPACK=$ac_cv_path_PATH_WAVPACK
+if test -n "$PATH_WAVPACK"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_WAVPACK" >&5
+$as_echo "$PATH_WAVPACK" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
- else
- SNDLIB_CONFIG="${SNDLIB_CONFIG_path}sndlib-config"
- fi
- if test "$SNDLIB_CONFIG" = "no" ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
- else
- SNDLIB_PREFIX=`$SNDLIB_CONFIG --prefix`
- OLD_CFLAGS="$CFLAGS"
- CFLAGS="$CFLAGS -L$SNDLIB_PREFIX/lib"
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mus_vct_copy in -lsndlib" >&5
-$as_echo_n "checking for mus_vct_copy in -lsndlib... " >&6; }
-if ${ac_cv_lib_sndlib_mus_vct_copy+:} false; then :
+# Extract the first word of "wvunpack", so it can be a program name with args.
+set dummy wvunpack; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_path_PATH_WVUNPACK+:} false; then :
$as_echo_n "(cached) " >&6
else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lsndlib $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ case $PATH_WVUNPACK in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_PATH_WVUNPACK="$PATH_WVUNPACK" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_PATH_WVUNPACK="$as_dir/$ac_word$ac_exec_ext"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char mus_vct_copy ();
-int
-main ()
-{
-return mus_vct_copy ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_sndlib_mus_vct_copy=yes
-else
- ac_cv_lib_sndlib_mus_vct_copy=no
+ test -z "$ac_cv_path_PATH_WVUNPACK" && ac_cv_path_PATH_WVUNPACK="no"
+ ;;
+esac
fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
+PATH_WVUNPACK=$ac_cv_path_PATH_WVUNPACK
+if test -n "$PATH_WVUNPACK"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PATH_WVUNPACK" >&5
+$as_echo "$PATH_WVUNPACK" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sndlib_mus_vct_copy" >&5
-$as_echo "$ac_cv_lib_sndlib_mus_vct_copy" >&6; }
-if test "x$ac_cv_lib_sndlib_mus_vct_copy" = xyes; then :
- SNDLIB_AUDIO_CHOICE=`$SNDLIB_CONFIG --audio`
- if test "$SNDLIB_AUDIO_CHOICE" != "$AUDIO_SYSTEM" ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: libsndlib.so audio choice is $SNDLIB_AUDIO_CHOICE, but the current choice is $AUDIO_SYSTEM" >&5
-$as_echo "$as_me: WARNING: libsndlib.so audio choice is $SNDLIB_AUDIO_CHOICE, but the current choice is $AUDIO_SYSTEM" >&2;}
- fi
- SNDLIB_BITS=`$SNDLIB_CONFIG --bits`
- if test "$SNDLIB_BITS" = "$LOCAL_SNDLIB_BITS" ; then
- SNDLIB_LANGUAGE=`$SNDLIB_CONFIG --language`
- if test "$SNDLIB_LANGUAGE" = $LOCAL_LANGUAGE ; then
- SNDLIB_FILES="NO_FILES"
- SNDLIB_LIB="-L$SNDLIB_PREFIX/lib -lsndlib"
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES sndlib"
- $as_echo "#define WITH_SHARED_SNDLIB 1" >>confdefs.h
-
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: libsndlib.so was built with $SNDLIB_LANGUAGE, but current choice is $LOCAL_LANGUAGE" >&5
-$as_echo "$as_me: WARNING: libsndlib.so was built with $SNDLIB_LANGUAGE, but current choice is $LOCAL_LANGUAGE" >&2;}
- fi
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: libsndlib.so is not compatible with current Snd mus_sample_t choice" >&5
-$as_echo "$as_me: WARNING: libsndlib.so is not compatible with current Snd mus_sample_t choice" >&2;}
- fi
-fi
- CFLAGS="$OLD_CFLAGS"
- fi
+if test "$PATH_WAVPACK" != "no" ; then
+ if test "$PATH_WVUNPACK" != "no" ; then
+ $as_echo "#define HAVE_WAVPACK 1" >>confdefs.h
+
+ cat >>confdefs.h <<_ACEOF
+#define PATH_WAVPACK "${PATH_WAVPACK}"
+_ACEOF
+
+ cat >>confdefs.h <<_ACEOF
+#define PATH_WVUNPACK "${PATH_WVUNPACK}"
+_ACEOF
+
+ fi
fi
#--------------------------------------------------------------------------------
-# debugging stuff
+# Audio
#--------------------------------------------------------------------------------
-# Check whether --enable-deprecated was given.
-if test "${enable_deprecated+set}" = set; then :
- enableval=$enable_deprecated; if test "$enable_deprecated" = no ; then
- CFLAGS="-DGTK_DISABLE_DEPRECATED -DG_DISABLE_DEPRECATED -DGDK_DISABLE_DEPRECATED -DPANGO_DISABLE_DEPRECATED -DCAIRO_DISABLE_DEPRECATED -DGSEAL_ENABLE -DGTK_DISABLE_SINGLE_INCLUDES -Wall $CFLAGS"
- $as_echo "#define XM_DISABLE_DEPRECATED 1" >>confdefs.h
-
- $as_echo "#define CLM_DISABLE_DEPRECATED 1" >>confdefs.h
+AUDIO_LIB=""
+JACK_LIBS=""
+JACK_FLAGS=""
- $as_echo "#define SNDLIB_DISABLE_DEPRECATED 1" >>confdefs.h
+if test "$with_audio" != no ; then
- $as_echo "#define XEN_DISABLE_DEPRECATED 1" >>confdefs.h
+ if test "$with_pulseaudio" = yes ; then
+ $as_echo "#define MUS_PULSEAUDIO 1" >>confdefs.h
- $as_echo "#define S7_DISABLE_DEPRECATED 1" >>confdefs.h
+ AUDIO_LIB="-lpulse-simple"
+ AUDIO_SYSTEM=pulseaudio
+ fi
- $as_echo "#define SND_DISABLE_DEPRECATED 1" >>confdefs.h
+ if test "$with_portaudio" = yes ; then
+ $as_echo "#define MUS_PORTAUDIO 1" >>confdefs.h
+ AUDIO_SYSTEM=portaudio
+ AUDIO_LIB="-lportaudio"
fi
-fi
+ if test "$with_jack" = yes ; then
+ if test "$with_alsa" = yes ; then
+ AUDIO_SYSTEM=ALSA+JACK
+ else
+ AUDIO_SYSTEM=JACK
+ fi
+ $as_echo "#define MUS_JACK 1" >>confdefs.h
-if test "$enable_snd_debug" = yes ; then
- CFLAGS="-I. $CFLAGS"
- if test "$GCC" = yes ; then
- if test "$LOCAL_LANGUAGE" = "Ruby" ; then
- if test "$CC" = "g++" ; then
- CFLAGS="$CFLAGS -O -g3 -Wcast-align -Wpointer-arith -Wimplicit -Wreturn-type -Wunused-label -Wunused-variable -Wunused-value -Wcomment -Wformat -Wunused-function -Wuninitialized -Wparentheses -Wall -Winit-self -Wsequence-point -Wmissing-field-initializers -Wmissing-prototypes"
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG jack --exists ; then
+ JACK_LIBS="`$PKG_CONFIG jack --libs`"
+ JACK_FLAGS="`$PKG_CONFIG jack --cflags`"
+ if $PKG_CONFIG samplerate --exists ; then
+ JACK_LIBS="$JACK_LIBS `$PKG_CONFIG samplerate --libs`"
+ JACK_FLAGS="$JACK_FLAGS `$PKG_CONFIG samplerate --cflags`"
+ else
+ JACK_LIBS="$JACK_LIBS -lsamplerate"
+ fi
else
- CFLAGS="$CFLAGS -O -g3 -Wcast-align -Wpointer-arith -Wimplicit -Wreturn-type -Wunused-label -Wunused-variable -Wunused-value -Wcomment -Wformat -Wunused-function -Wuninitialized -Wparentheses -Wall -Winit-self -Wsequence-point -Wmissing-field-initializers -Wmissing-prototypes"
+ JACK_LIBS="-ljack -lsamplerate"
fi
else
- if test "$CC" = "g++" ; then
- CFLAGS="$CFLAGS -O -g3 -Wredundant-decls -Wcast-align -Wpointer-arith -Wimplicit -Wreturn-type -Wunused-label -Wunused-variable -Wunused-value -Wcomment -Wformat -Wunused-function -Wuninitialized -Wparentheses -Wall -Winit-self -Wsequence-point -Wmissing-field-initializers -Wmissing-prototypes"
- else
- CFLAGS="$CFLAGS -O -g3 -Wredundant-decls -Wcast-align -Wmissing-prototypes -Wpointer-arith -Wimplicit -Wreturn-type -Wunused-label -Wunused-variable -Wunused-value -Wcomment -Wformat -Wunused-function -Wuninitialized -Wparentheses -Wall -Winit-self -Wsequence-point -Wmissing-field-initializers -Wmissing-prototypes"
- fi
+ JACK_LIBS="-ljack -lsamplerate"
fi
+ JACK_LIBS="$JACK_LIBS -lpthread"
+ fi
+
+ if test "$with_alsa" = yes ; then
+ $as_echo "#define HAVE_ALSA 1" >>confdefs.h
+
+ AUDIO_LIB="-lasound"
+ if test "$with_jack" = yes ; then
+ AUDIO_SYSTEM=ALSA+JACK
+ else
+ AUDIO_SYSTEM=ALSA
+ fi
+ fi
+
+ if test "$with_oss" = yes ; then
+ $as_echo "#define HAVE_OSS 1" >>confdefs.h
+
+ AUDIO_SYSTEM=OSS
+ fi
+
+ if test "$AUDIO_SYSTEM" = None ; then
+ case "$host" in
+ *-*-linux*)
+ AUDIO_SYSTEM=ALSA
+ $as_echo "#define HAVE_ALSA 1" >>confdefs.h
+
+ AUDIO_LIB="-lasound"
+ ;;
+ *-*-sunos4*)
+ AUDIO_SYSTEM=Sun
+ ;;
+ *-*-solaris*)
+ AUDIO_SYSTEM=Sun
+ ;;
+ *-*-hpux*)
+ AUDIO_SYSTEM=Hpux
+ ;;
+ *-*-bsdi*)
+ $as_echo "#define HAVE_OSS 1" >>confdefs.h
+
+ AUDIO_SYSTEM=OSS
+ ;;
+ *-*-freebsd*)
+ $as_echo "#define HAVE_OSS 1" >>confdefs.h
+
+ AUDIO_SYSTEM=OSS
+ ;;
+ *-*-openbsd*)
+ AUDIO_SYSTEM=OpenBSD
+ ;;
+ *-*-netbsd*)
+ AUDIO_SYSTEM=NetBSD
+ ;;
+ *-*-cygwin*)
+ if test "$with_jack" != yes ; then
+ AUDIO_SYSTEM=Windows
+ fi
+ ;;
+ *-*-mingw*)
+ audio_system=Windows
+ ;;
+ *-apple-*)
+ if test "$with_jack" != yes ; then
+ AUDIO_SYSTEM=MacOSX
+ AUDIO_LIB="-framework CoreAudio -framework CoreFoundation -framework CoreMIDI"
+ else
+ AUDIO_SYSTEM=JACK
+ JACK_LIBS="-framework CoreAudio -framework CoreServices -framework AudioUnit -L/usr/local/lib -ljack -lsamplerate"
+ JACK_FLAGS="-I/usr/local/include"
+ fi
+ ;;
+ esac
fi
-else
- CFLAGS="-O2 -I. $CFLAGS"
fi
-# -ffast-math appears to make exp about twice as fast, but slows down filtering by the same amount -- kinda strange
-# timing tests using -O3 -ffast-math indicate an overall speedup of maybe 4-5% in Snd, 1951 -> 1936 in s7test
-#
-# I also tried -ftree-vectorize but didn't see any big improvement
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for audio system" >&5
+$as_echo_n "checking for audio system... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $AUDIO_SYSTEM" >&5
+$as_echo "$AUDIO_SYSTEM" >&6; }
+
+if test "$AUDIO_SYSTEM" != None ; then
+ $as_echo "#define WITH_AUDIO 1" >>confdefs.h
+
+fi
+
+
+
+
+
+
+
+#--------------------------------------------------------------------------------
+# compiler/loader flags
+#--------------------------------------------------------------------------------
+
+LIBS=""
+LDSO_FLAGS=""
+SO_FLAGS=""
+SO_LD="ld"
+# the SO_* stuff here is for consistency with the sndlib configure script
+
+case "$host" in
+ *-*-linux*)
+ LDSO_FLAGS="-shared"
+ LIBS="$LIBS -lm -ldl"
+ if test "$GCC" = yes ; then
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ SO_LD="$CC"
+ fi
+ ;;
+
+ *-*-sunos4*)
+ LIBS="$LIBS -lm"
+ ;;
+
+ *-*-solaris*)
+ LIBS="$LIBS -lm"
+ LDSO_FLAGS="-G"
+ ;;
+
+ *-*-hpux*)
+ LDSO_FLAGS="+z -Ae +DA1.1"
+ if test "$GCC" = yes ; then
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ fi
+ ;;
+
+ *-*-bsdi*)
+ LIBS="$LIBS -lm"
+ if test "$GCC" = yes ; then
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ fi
+ ;;
+
+ *-*-freebsd*)
+ LIBS="$LIBS -lm"
+ if test "$GCC" = yes ; then
+ SO_LD="$CC"
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ CFLAGS="-fPIC $CFLAGS"
+ LDSO_FLAGS="-shared"
+ fi
+ ;;
+
+ *-*-openbsd*)
+ LIBS="$LIBS -lm"
+ if test "$GCC" = yes ; then
+ SO_LD="$CC"
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ CFLAGS="-ftrampolines $CFLAGS"
+ LDSO_FLAGS="-shared"
+ fi
+ ;;
+
+ *-*-netbsd*)
+ LIBS="$LIBS -lm"
+ if test "$GCC" = yes ; then
+ SO_LD="$CC"
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ LDSO_FLAGS="-shared"
+ fi
+ ;;
+
+ *-*-mingw*)
+ LIBS="$LIBS -lwinmm -lwsock32"
+ LDFLAGS="$LDFLAGS -mwindows"
+ SO_INSTALL=":"
+ SO_LD=":"
+ ;;
+
+ *-apple-*)
+ SO_LD="$CC"
+ LDSO_FLAGS="-dynamic -bundle -undefined suppress -flat_namespace"
+ ;;
+esac
+
+
+
+
+
#--------------------------------------------------------------------------------
# export-dynamic
#--------------------------------------------------------------------------------
+CFLAGS="-O2 -I. $CFLAGS"
ORIGINAL_LDFLAGS="$LDFLAGS"
-if test "$with_snd_as_widget" != yes ; then
- if test "$ac_cv_header_dlfcn_h" = yes ; then
- if test "$with_gnu_ld" = yes ; then
+case "$host" in
+ *-*-linux* | *-*-bsdi* | *-*-freebsd* | *-*-openbsd* | *-*-netbsd*)
+ if test "$CC" = "gcc" || test "$CC" = "g++" || test "$CC" = "cc" ; then
LDFLAGS="$LDFLAGS -Wl,-export-dynamic"
- # I think this really should be CFLAGS since it's assuming it's passed to gcc, not ld, but
- # that ends up generating endless dumb warnings in gcc
fi
- fi
-fi
+esac
+
#--------------------------------------------------------------------------------
-# error checks, output
+# disable-deprecated
#--------------------------------------------------------------------------------
-if test "$ac_snd_have_extension_language" = yes ; then
- if test "$ac_snd_have_gui" = yes ; then
- if test "$ac_cv_header_pthread_h" = yes ; then
- LDFLAGS="$LDFLAGS -lpthread"
- fi
- fi
-fi
+if test "$enable_deprecated" = no ; then
+ CFLAGS="-DGTK_DISABLE_DEPRECATED -DG_DISABLE_DEPRECATED -DGDK_DISABLE_DEPRECATED -DPANGO_DISABLE_DEPRECATED -DCAIRO_DISABLE_DEPRECATED -DGSL_DISABLE_DEPRECATED -Wall $CFLAGS"
+ $as_echo "#define DISABLE_DEPRECATED 1" >>confdefs.h
-if test "$ac_snd_have_extension_language" = no ; then
- if test "$ac_snd_have_gui" = no ; then
- if test "$ac_cv_header_dlfcn_h" = yes ; then
- LDFLAGS="$LDFLAGS -ldl"
- fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Snd needs either an extension language (s7, Fth, or Ruby), or a graphics toolkit (Gtk or Motif), or preferably both. As currently configured, this version of Snd is useless." >&5
-$as_echo "$as_me: WARNING: Snd needs either an extension language (s7, Fth, or Ruby), or a graphics toolkit (Gtk or Motif), or preferably both. As currently configured, this version of Snd is useless." >&2;}
- fi
fi
-if test "$ac_snd_have_extension_language" = yes && test "$with_audio" = no && test "$ac_snd_have_gui" = no && test "$ac_cv_header_dlfcn_h" = yes ; then
- LDFLAGS="$LDFLAGS -ldl"
-fi
+
+
+#--------------------------------------------------------------------------------
+# output
+#--------------------------------------------------------------------------------
@@ -11321,6 +6284,7 @@ LTLIBOBJS=$ac_ltlibobjs
+
: "${CONFIG_STATUS=./config.status}"
ac_write_fail=0
ac_clean_files_save=$ac_clean_files
@@ -11618,16 +6582,16 @@ if (echo >conf$$.file) 2>/dev/null; then
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
+ # In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
@@ -11687,28 +6651,16 @@ else
as_mkdir_p=false
fi
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -11729,8 +6681,8 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by snd $as_me 12.0, which was
-generated by GNU Autoconf 2.68. Invocation command line was
+This file was extended by snd $as_me 16.1, which was
+generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -11791,11 +6743,11 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-snd config.status 12.0
-configured by $0, generated by GNU Autoconf 2.68,
+snd config.status 16.1
+configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
-Copyright (C) 2010 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
@@ -11884,7 +6836,7 @@ fi
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
- set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
shift
\$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
CONFIG_SHELL='$SHELL'
@@ -11914,7 +6866,6 @@ for ac_config_target in $ac_config_targets
do
case $ac_config_target in
"mus-config.h") CONFIG_HEADERS="$CONFIG_HEADERS mus-config.h" ;;
- "sndlib.h") CONFIG_HEADERS="$CONFIG_HEADERS sndlib.h" ;;
"makefile") CONFIG_FILES="$CONFIG_FILES makefile" ;;
*) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
@@ -12503,14 +7454,13 @@ $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi
-# borrowed from gnucash
-
{ $as_echo "$as_me:${as_lineno-$LINENO}: result:
Options selected
-------------------------
Snd version ...........: $VERSION
CFLAGS ................: $CFLAGS
LDFLAGS ...............:$LDFLAGS
+ LIBS...................: $LIBS
prefix.................: ${prefix}
extension language.....: $LOCAL_LANGUAGE
audio system...........: $AUDIO_SYSTEM
@@ -12525,6 +7475,7 @@ $as_echo "
Snd version ...........: $VERSION
CFLAGS ................: $CFLAGS
LDFLAGS ...............:$LDFLAGS
+ LIBS...................: $LIBS
prefix.................: ${prefix}
extension language.....: $LOCAL_LANGUAGE
audio system...........: $AUDIO_SYSTEM
diff --git a/configure.ac b/configure.ac
index 92d66a4..361da46 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,17 +1,22 @@
# Configuration script for Snd
+#
+# we now depend completely on pc (pkgconfig) files.
+# Motif apparently has none.
+# gmp, mpfr, and mpc deliberately have none!
+
-AC_INIT(snd, 12.0, bil at ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-12.tar.gz)
+AC_INIT(snd, 16.1, bil at ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz)
AC_CONFIG_SRCDIR(snd.c)
-AC_CANONICAL_HOST
-AC_CONFIG_HEADERS(mus-config.h sndlib.h)
-AC_CONFIG_FILES(makefile )
+AC_CANONICAL_HOST # needed by case $host below
+AC_CONFIG_HEADERS(mus-config.h)
+AC_CONFIG_FILES(makefile)
AC_PROG_CC
-AC_HEADER_STDC # this needs to precede AC_CHECK_HEADER! (is this the case in 2.60?)
+
+# AC_HEADER_STDC
AC_PROG_INSTALL
MAKE_TARGET="snd"
-
AUDIO_SYSTEM="None"
RANDOM_FEATURES=""
OPTIONAL_LIBRARIES=""
@@ -19,335 +24,72 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
-VERSION=12.0
-AC_DEFINE_UNQUOTED(SND_PACKAGE, "$PACKAGE")
-AC_DEFINE_UNQUOTED(SND_VERSION, "$VERSION")
-AC_SUBST(SND_PACKAGE)
-AC_SUBST(SND_VERSION)
-
-AC_DEFINE_UNQUOTED(SND_HOST, "$host")
+VERSION=16.1
#--------------------------------------------------------------------------------
# configuration options
-# --with-motif use Motif (the default)
-# --with-static-motif use Motif statically loaded (for RPM generation)
-# --with-gtk use Gtk+
+# --with-motif use Motif
+# --with-gtk use Gtk+ (the default)
# --with-alsa use ALSA if possible (the default)
# --with-oss use OSS
# --with-jack use Jack
-# --with-static-alsa use ALSA statically loaded (for RPM generation)
# --without-audio stub out all audio
-# --with-snd-as-widget make Snd a loadable widget, not a standalone program
-# --with-doubles use doubles throughout (default=yes)
-# --with-float-samples represent samples internally as floats or doubles (default=yes)
# --with-gmp include multiprecision arithmetic via gmp, mpfr, and mpc
-# --enable-snd-debug include Snd internal debugging stuff
-# --enable-threads include pthread stuff [also "--with-threads" since I can't remember which is correct]
# --disable-deprecated do not include any deprecated stuff (in gtk, motif, s7, sndlib, clm, etc)
# --with-ladspa include LADSPA plugin support (Linux)
-# --with-sample-width=N use N bits of samples (default = 24)
-# --with-esd use Enlightened Sound Daemon
-# --with-no-gui make Snd without any graphics support
-# --with-motif-prefix set location of Motif
+# --with-gui make Snd with(out) any graphics support
# --with-forth use Forth as the extension language
# --with-ruby use Ruby as the extension language
-# --with-ruby-prefix set location of Ruby
# --with-s7 use S7 as the extension language (default = yes)
# --with-extension-language use some extension language (default=yes)
-# --with-static-xm include xm module
# --with-temp-dir directory to use for temp files
# --with-save-dir directory to use for saved-state files
# --with-doc-dir directory to search for documentation
# --with-gl include OpenGL support (default=no, Motif only)
-# --with-just-gl include OpenGL support but omit the extension language bindings (default=no, Motif only)
# --with-gl2ps include gl2ps (Motif only)
# --with-editres include EditRes in xm
-# --with-shared-sndlib load sndlib.so if possible
# --without-gsl omit GSL even if it exists
# --without-fftw omit FFTW even if it exists
-# --without-fam libfam can be obsolete, but it's not clear how to test this
# --with-pulseaudio use PulseAudio
# --with-portaudio use portaudio
-# --with-profiling add code to keep profiling stats (s7)
-# SNDLIB_CONFIG_path where to look for sndlib-config
-#--------------------------------------------------------------------------------
-AC_ARG_WITH(esd, [ --with-esd use ESD])
-AC_ARG_WITH(alsa, [ --with-alsa use ALSA])
-AC_ARG_WITH(oss, [ --with-oss use OSS])
-AC_ARG_WITH(jack, [ --with-jack use JACK])
-AC_ARG_WITH(static-alsa, [ --with-static-alsa use ALSA statically loaded])
AC_ARG_WITH(gtk, [ --with-gtk use Gtk+ to build Snd])
-AC_ARG_WITH(no-gui, [ --with-no-gui make Snd without any graphics support])
-AC_ARG_WITH(static-xm, [ --with-static-xm include the xm module])
-AC_ARG_WITH(static-xg, [ --with-static-xg include the xg module])
+AC_ARG_WITH(gui, [ --with-gui make Snd with graphics support])
AC_ARG_WITH(gl, [ --with-gl include OpenGL support, Motif only])
-AC_ARG_WITH(just-gl, [ --with-just-gl include OpenGL support, but omit the extension language bindings, Motif only])
AC_ARG_WITH(gl2ps, [ --with-gl2ps include gl2ps, Motif only])
AC_ARG_WITH(motif, [ --with-motif use libXm to build Snd])
-AC_ARG_WITH(static-motif,[ --with-static-motif use libXm.a to build Snd])
AC_ARG_WITH(editres, [ --with-editres include editres in xm])
+
+AC_ARG_WITH(alsa, [ --with-alsa use ALSA])
+AC_ARG_WITH(oss, [ --with-oss use OSS])
+AC_ARG_WITH(jack, [ --with-jack use JACK])
AC_ARG_WITH(ladspa, [ --with-ladspa include support for LADSPA plugins, Linux only])
-AC_ARG_WITH(doubles, [ --with-doubles use doubles throughout])
-AC_ARG_WITH(float-samples, [ --with-float-samples use floats (or doubles) as the internal sample respresentation, default=yes])
-AC_ARG_WITH(pulseaudio, [ --with-pulseaudio use PulseAudio, default=no])
-AC_ARG_WITH(portaudio, [ --with-portaudio use portaudio, default=no])
-AC_ARG_WITH(profiling, [ --with-profiling add code to keep profiling stats (s7 only)])
+AC_ARG_WITH(pulseaudio, [ --with-pulseaudio use PulseAudio, default=no])
+AC_ARG_WITH(portaudio, [ --with-portaudio use portaudio, default=no])
+
+AC_ARG_WITH(extension-language, [ --with-extension-language use some extension language, default=yes])
+AC_ARG_WITH(s7, [ --with-s7 use S7, default=yes])
+AC_ARG_WITH(forth, [ --with-forth use Forth as the extension language])
+AC_ARG_WITH(ruby, [ --with-ruby use Ruby as the extension language])
-# these are primarily for testing
AC_ARG_WITH(gsl, [ --with-gsl use GSL, default=yes])
AC_ARG_WITH(fftw, [ --with-fftw use fftw, default=yes])
-AC_ARG_WITH(fam, [ --with-fam use libfam (Gamin), default=yes])
AC_ARG_WITH(gmp, [ --with-gmp include multiprecision arithmetic via gmp, mpfr, and mpc, default=no])
+AC_ARG_WITH(audio, [ --without-audio don't include any audio functionality])
-AC_ARG_WITH(s7, [ --with-s7 use S7, default=yes])
-AC_ARG_WITH(extension-language, [ --with-extension-language use some extension language, default=yes])
-
-# an experiment
-AC_ARG_WITH(directfb, [ --with-directfb use directfb config scripts, rather than gtk, default=no])
-AC_ARG_WITH(audio, [ --without-audio don't include any audio functionality])
-
-
-# -------- internal sample data type --------
-
-# sample-width only applies to the int case (ignored if float)
-LOCAL_SNDLIB_BITS="24"
-AC_ARG_WITH(sample-width,
- [ --with-sample-width=N use N bits of samples],
- [AC_MSG_RESULT(Using $with_sample_width bit samples)
- AC_DEFINE_UNQUOTED(MUS_SAMPLE_BITS, $with_sample_width)
- LOCAL_SNDLIB_BITS=$with_sample_width
- ],
- [AC_DEFINE(MUS_SAMPLE_BITS, 24)]
- )
-
-if test "$with_float_samples" != no ; then
- AC_DEFINE(SNDLIB_USE_FLOATS, 1)
- if test "$with_doubles" != no ; then
- LOCAL_SNDLIB_BITS="8"
- else
- LOCAL_SNDLIB_BITS="4"
- fi
-else
- AC_DEFINE(SNDLIB_USE_FLOATS, 0)
-fi
+AC_ARG_WITH(temp-dir, [ --with-temp-dir directory to use for temp files], AC_DEFINE_UNQUOTED(MUS_DEFAULT_TEMP_DIR, "${withval}"))
+AC_ARG_WITH(save-dir, [ --with-save-dir directory to use for saved-state files], AC_DEFINE_UNQUOTED(MUS_DEFAULT_SAVE_DIR, "${withval}"))
+AC_ARG_WITH(doc-dir, [ --with-doc-dir directory to search for documentation], AC_DEFINE_UNQUOTED(MUS_DEFAULT_DOC_DIR, "${withval}"))
-if test "$with_doubles" != no ; then
- AC_DEFINE(mus_float_t, double)
- AC_DEFINE(WITH_DOUBLES)
-else
- AC_DEFINE(mus_float_t, float)
-fi
+AC_ARG_ENABLE(deprecated,[ --disable-deprecated do not include any deprecated stuff from gtk, s7, motif, clm, snd, or sndlib])
-if test "$with_static_xg" = yes ; then
- with_static_xm=yes
-fi
-
-AC_ARG_WITH(motif-prefix,[ --with-motif-prefix=PFX where Motif is installed],
- motif_prefix="$withval", motif_prefix="")
-
-if test "$with_static_motif" = yes ; then
- with_motif=yes
-fi
-
-AC_ARG_WITH(temp-dir,
- [ --with-temp-dir directory to use for temp files],
- AC_DEFINE_UNQUOTED(MUS_DEFAULT_TEMP_DIR, "${withval}")
- )
-
-AC_ARG_WITH(save-dir,
- [ --with-save-dir directory to use for saved-state files],
- AC_DEFINE_UNQUOTED(MUS_DEFAULT_SAVE_DIR, "${withval}")
- )
-
-AC_ARG_WITH(doc-dir,
- [ --with-doc-dir directory to search for documentation],
- AC_DEFINE_UNQUOTED(MUS_DEFAULT_DOC_DIR, "${withval}")
- )
-
-AC_ARG_WITH(snd-as-widget,
- [ --with-snd-as-widget make Snd a loadable widget, not a standalone program],
- if test "$with_snd_as_widget" = yes ; then
- AC_DEFINE(SND_AS_WIDGET)
- MAKE_TARGET=widget
- fi)
-
-# if mingw add -mwindows to the load flags (I think this means we're trying to build a GUI app, not just a console app??)
-case "$host" in
- *-*-mingw*)
- LDFLAGS="$LDFLAGS -mwindows"
- ;;
-esac
-
-
-
-#--------------------------------------------------------------------------------
-# standard libraries, header files, functions, OSS special cases
-#--------------------------------------------------------------------------------
-
-LIBS=""
-AC_CHECK_LIB(m,main)
-AC_CHECK_LIB(c,main)
-# AC_CHECK_LIB(dl,main)
-# I don't think I need libdl in S7, and the other extension languages will call for it if needed
-
-AC_CHECK_HEADERS(fcntl.h limits.h unistd.h string.h sys/soundcard.h machine/soundcard.h sys/mixer.h stdbool.h sys/time.h)
-AC_CHECK_HEADERS(libc.h sys/statvfs.h setjmp.h dlfcn.h sys/param.h byteswap.h pthread.h stdint.h fam.h dirent.h)
-
-AC_CHECK_HEADER([sys/mount.h], [], [], [#if HAVE_SYS_PARAM_H
- #include <sys/param.h>
- #endif
- ])
-# this still screws up in netBSD!
-
-
-# check for pthreads -- allow either --with-threads or --enable-threads
-
-AC_ARG_WITH(threads,
- [ --with-threads include pthread support, same as --enable-threads],
- [
- if test "$ac_cv_header_pthread_h" = yes ; then
- AC_DEFINE(HAVE_PTHREADS)
- LIBS="$LIBS -lpthread"
- RANDOM_FEATURES="$RANDOM_FEATURES threads"
- else
- AC_MSG_WARN([can't go with threads -- can't find pthread.h])
- fi
- ])
-
-AC_ARG_ENABLE(threads,
- [ --enable-threads include pthread support, same as --with-threads],
- [
- if test "$enable_threads" = yes ; then
- if test "$ac_cv_header_pthread_h" = yes ; then
- AC_DEFINE(HAVE_PTHREADS)
- LIBS="$LIBS -lpthread"
- RANDOM_FEATURES="$RANDOM_FEATURES threads"
- else
- AC_MSG_WARN([can't enable threads -- can't find pthread.h])
- fi]
- fi)
-
-
-
-AC_CHECK_HEADER(/usr/local/lib/oss/include/sys/soundcard.h,[AC_DEFINE(MUS_HAVE_USR_LOCAL_LIB_OSS)])
-AC_CHECK_HEADER(/usr/lib/oss/include/sys/soundcard.h,[AC_DEFINE(MUS_HAVE_USR_LIB_OSS)])
-AC_CHECK_HEADER(/opt/oss/include/sys/soundcard.h,[AC_DEFINE(MUS_HAVE_OPT_OSS)])
-AC_CHECK_HEADER(/var/lib/oss/include/sys/soundcard.h,[AC_DEFINE(MUS_HAVE_VAR_LIB_OSS)])
-AC_CHECK_HEADER(gnu/libc-version.h,[AC_DEFINE(HAVE_GNU_LIBC_VERSION_H)])
-AC_CHECK_HEADER(alsa/asoundlib.h,[AC_DEFINE(HAVE_ALSA_ASOUNDLIB_H)])
-
-AC_CHECK_DECLS(hypot,,,[#include <math.h>])
-AC_CHECK_DECLS(isnan,,,[#include <math.h>])
-AC_CHECK_DECLS(isinf,,,[#include <math.h>])
-
-AC_TYPE_MODE_T
-AC_TYPE_SIZE_T
-# AC_TYPE_SSIZE_T -- in the docs, but apparently doesn't actually work
-AC_CHECK_TYPE(ssize_t, int)
-AC_TYPE_PID_T
-AC_TYPE_INT64_T
-
-# new form of this macro from autoconf 2.62 makes the Mac case a real headache
-# so this is a call on the old form
-AC_OLD_BIGENDIAN
-
-AC_SYS_LARGEFILE
-AC_TYPE_OFF_T
-AC_CHECK_SIZEOF(off_t)
-AC_CHECK_SIZEOF(long)
-AC_CHECK_SIZEOF(long long)
-AC_CHECK_SIZEOF(unsigned long long)
-AC_CHECK_SIZEOF(unsigned long)
+AC_C_BIGENDIAN
AC_CHECK_SIZEOF(void *)
-# this won't work in version 2.66 (fixed in 2.67)
-# AC_CHECK_SIZEOF(intptr_t)
-# AC_DEFINE_UNQUOTED(SIZEOF_VOID_P, $ac_cv_sizeof_intptr_t)
-
-AC_CHECK_SIZEOF(int)
-AC_CHECK_SIZEOF(int64_t)
-AC_CHECK_SIZEOF(ssize_t)
-
-AC_CHECK_FUNCS(getcwd strerror readlink setlocale access opendir sleep signal statvfs statfs getline difftime gettimeofday)
-AC_CHECK_FUNCS(vsnprintf vasprintf snprintf strftime memmove lstat strcasecmp pathconf)
-
-AC_LIB_PROG_LD
-# this is needed for the -export-dynamic check below (export dynamic is needed to get the xm.so module loadable at run-time)
-
-AC_PROG_FGREP
-AC_DEFINE_UNQUOTED(FGREP_PROG, "$FGREP")
-
-
-AC_MSG_CHECKING(for __func__)
-AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(,
- [ char *s;
- s = (char *)__func__
- ])],
- [AC_DEFINE(HAVE___FUNC__)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
AC_PATH_PROG(PKG_CONFIG, pkg-config, no)
-# look for special functions in libm
-AC_CHECK_LIB(m, jn,
- [AC_CHECK_LIB(m, yn,
- [AC_CHECK_LIB(m, lgamma,
- [AC_CHECK_LIB(m, erf,
- [AC_DEFINE(HAVE_SPECIAL_FUNCTIONS)])])])])
-
-
-# look for nested function support
-AC_MSG_CHECKING(whether nested functions work)
-AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(,
- [ double bar;
- double foo(double a, double b)
- {
- auto double square (double z);
- double square (double z) {return(z * z);}
- return(square(a) + square(b));
- }
- bar = foo(1.0, 2.0)
- ])],
- [AC_DEFINE(HAVE_NESTED_FUNCTIONS)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
-
-case "$host" in
- *-*-linux*)
- AC_DEFINE(HAVE_LINUX)
- ;;
- *-*-sunos4*)
- AC_DEFINE(HAVE_SUN)
- ;;
- *-*-solaris*)
- AC_DEFINE(HAVE_SUN)
- ;;
- *-*-netbsd*)
- AC_DEFINE(HAVE_NETBSD)
- ;;
- *-*-cygwin*)
- AC_DEFINE(HAVE_WINDOZE)
- ;;
- *-*-mingw*)
- AC_DEFINE(HAVE_WINDOZE)
- ;;
- *-apple-*)
- AC_DEFINE(HAVE_OSX)
- ;;
-esac
-
-
-
-
#--------------------------------------------------------------------------------
# fftw
@@ -367,143 +109,26 @@ if test "$with_fftw" != no; then
else
AC_MSG_RESULT(no)
fi
- else
- SAVELIBS=$LIBS
- LIBS="$LIBS -lfftw3 -lm"
- AC_MSG_CHECKING([for fftw-3])
- AC_LINK_IFELSE([AC_LANG_PROGRAM([#include <fftw3.h>],
- [fftw_plan plan; fftw_execute(plan)])],
- [AC_MSG_RESULT(yes)
- AC_DEFINE(HAVE_FFTW3)
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES fftw3"
- FFTW_LIBS="-lfftw3"],
- [AC_MSG_RESULT(no)
- LIBS=$SAVELIBS
- ])
- LIBS=$SAVELIBS
fi
fi
AC_SUBST(FFTW_LIBS)
AC_SUBST(FFTW_CFLAGS)
-#--------------------------------------------------------------------------------
-# complex trig
-#--------------------------------------------------------------------------------
-
-# having <complex.h> + a cacos declaration is not enough: C++ dies with a complaint about a "deprecated header"
-#
-# I'm also using cexp and in xen creal, cimag, and _Complex_I
-# I'm currently using the data type "complex double" though the header seems to prefer "double complex" and
-# the gcc documentation mentions _Complex double.
-#
-# in C++, we want to set these to WITH_COMPLEX 1 and HAVE_COMPLEX_TRIG 0 no matter what
-#
-LIBS="$LIBS -lm"
-
-if test "$CC" = "g++" ; then
- AC_DEFINE(WITH_COMPLEX)
- ac_snd_have_complex_trig=no
-else
-
- AC_MSG_CHECKING(for complex numbers)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <complex.h>],
- [ double complex val;
- double rl, im;
- val = 1.0 + 0.5 * _Complex_I;
- rl = creal(val);
- im = cimag(val);
- ])],
- [
- AC_DEFINE(WITH_COMPLEX)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
-
- ac_snd_have_complex_trig=no
- AC_MSG_CHECKING(for complex trig)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <complex.h>],
- [ _Complex double val;
- double rl, im;
- val = 1.0 + 0.5 * _Complex_I;
- rl = creal(val);
- im = cimag(val);
- val = ccosh(cacosh(1.5) / 100.0)
- ])],
- [
- AC_DEFINE(HAVE_COMPLEX_TRIG)
- ac_snd_have_complex_trig=yes
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-fi
#--------------------------------------------------------------------------------
# GMP, MPFR, MPC
#--------------------------------------------------------------------------------
+# no pc files -- deliberately! We'll just add the libraries and let the chips fall...
+
GMP_LIBS=""
-GMP_CFLAGS=""
-LOCAL_GMP_LIBS=""
-ac_snd_have_gmp=no
if test "$with_gmp" = yes ; then
- # look for gmp, mpfr, and mpc
-
- SAVELIBS=$LIBS
- LIBS="$LIBS -lgmp -lm"
- AC_CHECK_LIB(gmp, __gmpz_init,
- [
- LOCAL_GMP_LIBS="-lgmp"
- ac_snd_have_gmp=yes
- ],
- [AC_MSG_ERROR(libgmp not found)])
-
- if test "$ac_snd_have_gmp" != no ; then
- LIBS="$LIBS -lmpfr"
- AC_MSG_CHECKING(for libmpfr)
- LOCAL_GMP_LIBS="$LOCAL_GMP_LIBS -lmpfr"
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <mpfr.h>],
- [mpfr_t x; mpfr_init(x) ; mpfr_clear(x);]
- )],
- [AC_MSG_RESULT(yes)],
- [
- AC_MSG_RESULT(no)
- ac_snd_have_gmp=no
- ])
- fi
-
- if test "$ac_snd_have_gmp" != no ; then
- LIBS="$LIBS -lmpc"
- AC_MSG_CHECKING(for libmpc)
- LOCAL_GMP_LIBS="$LOCAL_GMP_LIBS -lmpc"
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <mpc.h>],
- [mpc_t x; mpc_init2(x, 53); mpc_clear(x); mpc_asin(x, x, MPC_RNDNN);]
- )],
- [AC_MSG_RESULT(yes)
- AC_CHECK_LIB(mpc, mpc_arg,
- [
- AC_DEFINE(WITH_GMP)
- GMP_LIBS="$LOCAL_GMP_LIBS"
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gmp mpfr mpc"
- ],
- [AC_MSG_ERROR(libmpc too old)],
- $GMP_LIBS)
- ],
- [AC_MSG_RESULT(no)])
- fi
-
- LIBS=$SAVELIBS
+ GMP_LIBS="-lgmp -lmpfr -lmpc -lm"
+ AC_DEFINE(WITH_GMP)
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gmp mpfr mpc"
fi
AC_SUBST(GMP_LIBS)
@@ -516,39 +141,22 @@ AC_SUBST(GMP_LIBS)
GSL_LIBS=""
GSL_CFLAGS=""
+
if test "$with_gsl" != no; then
- AC_PATH_PROG(GSL_CONFIG, gsl-config, no)
- AC_MSG_CHECKING(for GSL)
- if test "$GSL_CONFIG" = "no" ; then
- AC_MSG_RESULT(no)
- else
- GSL_CFLAGS=`$GSL_CONFIG --cflags`
- GSL_PREFIX=`$GSL_CONFIG --prefix`
- GSL_LIBS=`$GSL_CONFIG --libs`
- gsl_version="`$GSL_CONFIG --version`"
- AC_MSG_RESULT($gsl_version)
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gsl"
-
- AC_DEFINE(HAVE_GSL)
- AC_DEFINE_UNQUOTED(MUS_GSL_VERSION,"${gsl_version}")
-
- SAVELIBS=$LIBS
- LIBS="$LIBS $GSL_LIBS"
- AC_MSG_CHECKING(for gsl_eigen_nonsymmv_workspace)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <gsl/gsl_math.h>
- #include <gsl/gsl_eigen.h>],
- [ gsl_eigen_nonsymmv_workspace *w = gsl_eigen_nonsymmv_alloc(4)
- ])],
- [
- AC_DEFINE(HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
- LIBS=$SAVELIBS
+ AC_MSG_CHECKING(for gsl)
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG gsl --exists ; then
+ GSL_LIBS="`$PKG_CONFIG gsl --libs`"
+ GSL_CFLAGS="`$PKG_CONFIG gsl --cflags`"
+ AC_DEFINE(HAVE_GSL)
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gsl"
+ AC_MSG_RESULT(yes)
+ else
+ AC_MSG_RESULT(no)
fi
fi
+fi
+
AC_SUBST(GSL_LIBS)
AC_SUBST(GSL_CFLAGS)
@@ -558,515 +166,145 @@ AC_SUBST(GSL_CFLAGS)
# Ladspa
#--------------------------------------------------------------------------------
-if test "$with_ladspa" != no ; then
- # we also need dlfcn.h and dirent.h here, but presumably this is on Linux
- AC_CHECK_HEADER(ladspa.h,
- [AC_DEFINE(HAVE_LADSPA)
- RANDOM_FEATURES="$RANDOM_FEATURES ladspa"
- ],
- if test "$with_ladspa" = yes ; then
- AC_MSG_WARN([can't find ladspa.h!])
- fi)
+if test "$with_ladspa" = yes ; then
+ AC_DEFINE(HAVE_LADSPA)
+ RANDOM_FEATURES="$RANDOM_FEATURES ladspa"
fi
+
#--------------------------------------------------------------------------------
-# X/Motif
+# graphics
#--------------------------------------------------------------------------------
-ac_snd_have_gui=no
+# graphics: motif chosen if --with-motif
+# no gui chosen if --without-gui
+# gtk chosen if neither of above and we can find gtk-2.0.pc or gtk-3.0.pc
+# else no gui
-AC_PATH_XTRA
+XLIBS=""
+XFLAGS=""
-if test "$with_motif" = no && test "$with_gtk" = no ; then
- with_no_gui=yes
-fi
+GX_FILES=""
+GX_HEADERS=""
-if test "$with_motif" = yes && test "$with_gtk" = yes ; then
- with_gtk=no
- AC_MSG_WARN([You asked for both Motif and Gtk -- Motif will be used])
-fi
+GTK_FILES=""
+GTK_HEADERS=""
+GTK_CFLAGS=""
+GTK_LIBS=""
+GTK_LD_LIBS=""
-if test "$with_no_gui" = yes ; then
+ac_snd_gui_choice=none
+if test "$with_motif" = no && test "$with_gtk" = no ; then
+ with_gui=no
+fi
+
+if test "$with_gui" = no ; then
AC_DEFINE(USE_NO_GUI)
- XLIBS=""
- XFLAGS=""
- AC_SUBST(XLIBS)
- AC_SUBST(XFLAGS)
GX_FILES="NO_GUI_O_FILES"
GX_HEADERS="NO_GUI_HEADERS"
+ ac_snd_gui_choice=no
+fi
-else
-
- # can we have gtk without X in mingw? -- depend on fixup around line 1030, I guess
-
- if test "$no_x" != yes; then
-
- AC_DEFINE(HAVE_X)
- XFLAGS="$X_CFLAGS"
- X_POST_LIBS="-lX11 $X_EXTRA_LIBS"
-
- case "$host" in
- *-apple-*)
- X_POST_LIBS="$X_POST_LIBS -lSM -lICE"
- ;;
- esac
-
- # this needs to precede the Xm check
- TEST_PRE_LIBS="$X_LIBS $X_PRE_LIBS"
- TEST_POST_LIBS="$X_POST_LIBS"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
-
- AC_CHECK_LIB(Xext, XShapeQueryExtension,
- [
- X_POST_LIBS="$X_POST_LIBS -lXext"
- TEST_POST_LIBS="$TEST_POST_LIBS -lXext"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
- AC_DEFINE(HAVE_XSHAPEQUERYEXTENSION)
- ], , $TEST_LIBS)
-
- # search for libXp and libXm may need libXft so...
- AC_CHECK_LIB(Xft, XftFontOpen, [
- X_PRE_LIBS="$X_PRE_LIBS -lXft"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXft"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
- ], , $TEST_LIBS)
-
- if test "$with_static_motif" = yes ; then
- if test x$motif_prefix != x ; then
- AC_CHECK_FILE($motif_prefix/lib/libXm.a,[
- X_PRE_LIBS="$motif_prefix/lib/libXm.a $X_LIBS $X_PRE_LIBS -lXt"
- XFLAGS="-I$motif_prefix/include $XFLAGS"
- ],
- [
- AC_MSG_WARN(can't find $motif_prefix/lib/libXm.a!)
- X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -lXm -lXt"
- ])
- else
- AC_CHECK_FILE($x_libraries/libXm.a,[
- X_PRE_LIBS="$x_libraries/libXm.a $X_LIBS $X_PRE_LIBS -lXt"
- ],
- [
- AC_MSG_WARN(can't find $x_libraries/libXm.a!)
- X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -lXm -lXt"
- ])
- fi
- else
- if test x$motif_prefix != x ; then
- X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -L$motif_prefix/lib -lXm -lXt"
- XFLAGS="-I$motif_prefix/include $XFLAGS"
- else
- X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -lXm -lXt"
- fi
- fi
- TEST_PRE_LIBS="$X_LIBS $X_PRE_LIBS"
- TEST_POST_LIBS="$X_POST_LIBS"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
+#--------------------------------------------------------------------------------
+# X/Motif
+#--------------------------------------------------------------------------------
- GX_FILES="X_O_FILES"
- GX_HEADERS="SND_X_HEADERS"
+# here as in the gmp case, we simply set up the libs/flags and hope for the best
- fi
+if test "$with_motif" = yes ; then
+ AC_PATH_XTRA
- if test "$with_gtk" != yes && test "$with_motif" != no ; then
-
- SAVELIBS=$LIBS
- SAVEFLAGS=$CFLAGS
-
- # search for libXm will fail with Xp complaints in Linux, so we need to search for -lXp first
- AC_CHECK_LIB(Xp, XpGetDocumentData, [
- X_PRE_LIBS="$X_PRE_LIBS -lXp"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXp"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
- ], , $TEST_LIBS)
-
- LIBS="$LIBS $X_PRE_LIBS $X_POST_LIBS"
- CFLAGS="$CFLAGS $XFLAGS"
-
- AC_MSG_CHECKING([whether libXm requires libpng etc])
- AC_TRY_LINK_FUNC(XmCreateForm,
- AC_MSG_RESULT(no),
- [
- AC_MSG_RESULT(yes)
- X_PRE_LIBS="$X_PRE_LIBS -lXmu -L/usr/local/lib -liconv -lpng -ljpeg"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXmu -L/usr/local/lib -liconv -lpng -ljpeg"
- ],
- $TEST_LIBS)
-
- if test "$with_editres" = yes ; then
- AC_CHECK_LIB(Xmu, _XEditResCheckMessages,
- [AC_DEFINE(MUS_WITH_EDITRES)
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES editres"
- X_PRE_LIBS="$X_PRE_LIBS -lXmu"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXmu"
- ])
- else
- # need to check for -lXmu required by (buggy) libXm.a (openmotif 2.2.2)
- AC_MSG_CHECKING([whether libXm requires libXmu])
- AC_TRY_LINK_FUNC(XmCreateForm,
- AC_MSG_RESULT(no),
- [
- AC_MSG_RESULT(yes)
- X_PRE_LIBS="$X_PRE_LIBS -lXmu"
- TEST_PRE_LIBS="$TEST_PRE_LIBS -lXmu"
- ],
- $TEST_LIBS)
- fi
+ GTK_FLAGS="$X_CFLAGS"
+ X_POST_LIBS="-lX11 $X_EXTRA_LIBS -lXext"
+ case "$host" in
+ *-apple-*)
+ X_POST_LIBS="$X_POST_LIBS -lSM -lICE"
+ ;;
+ *-*-linux*)
+ X_POST_LIBS="$X_POST_LIBS -lSM -lICE -lXft"
+ ;;
+ esac
+ X_PRE_LIBS="$X_LIBS $X_PRE_LIBS -lXm -lXt"
- XLIBS="$X_PRE_LIBS $X_POST_LIBS"
- TEST_LIBS="$TEST_PRE_LIBS $TEST_POST_LIBS"
-
- AC_CHECK_LIB(m, XmCreateForm,
- # was Xm here but that introduces a bogus -lXm into the load list
- [
- with_motif=yes
- ac_snd_have_gui=yes
-
- XLIBS="$XLIBS -lXpm"
- TEST_LIBS="$TEST_LIBS -lXpm"
-
- if test "$with_static_xm" = yes ; then
- GX_FILES="XM_O_FILES"
- AC_DEFINE(HAVE_STATIC_XM)
- fi
-
- AC_SUBST(XLIBS)
- AC_SUBST(XFLAGS)
-
- AC_MSG_CHECKING(for XmDataField)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/DataF.h>],
- [ Widget w;
- w = XmCreateDataField(NULL, "data-field", NULL, 0)
- ])],
- [
- AC_DEFINE(HAVE_XmCreateDataField)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmButtonBox)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/ButtonBox.h>],
- [ Widget w; int i; i = XmIconTop;
- w = XmCreateButtonBox(NULL, "button-box", NULL, 0)
- ])],
- [
- AC_DEFINE(HAVE_XmCreateButtonBox)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmTabStack)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/TabStack.h>],
- [ Widget w, w1, w2;
- w = XmCreateTabStack(NULL, "tab-stack", NULL, 0);
- /* w1 = XmTabStackXYToWidget(w, 0, 0); */
- w2 = XmTabStackIndexToWidget(w, 0)
- ])],
- [
- AC_DEFINE(HAVE_XmCreateTabStack)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmTabStackXYToWidget)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/TabStack.h>],
- [ Widget w, w1, w2;
- w = XmCreateTabStack(NULL, "tab-stack", NULL, 0);
- w1 = XmTabStackXYToWidget(w, 0, 0)
- ])],
- [
- AC_DEFINE(HAVE_XmTabStackXYToWidget)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmColumn)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/Column.h>],
- [ Widget w;
- w = XmCreateColumn(NULL, "column", NULL, 0)
- /* w = XmColumnGetChildLabel(w) */
- ])],
- [
- AC_DEFINE(HAVE_XmCreateColumn)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmColumnGetChildLabel)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/Column.h>],
- [ Widget w;
- w = XmCreateColumn(NULL, "column", NULL, 0);
- w = XmColumnGetChildLabel(w)
- ])],
- [
- AC_DEFINE(HAVE_XmColumnGetChildLabel)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmDropDown)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/DropDown.h>],
- [ Widget w;
- w = XmCreateDropDown(NULL, "drop-down", NULL, 0)
- ])],
- [
- AC_DEFINE(HAVE_XmCreateDropDown)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmCreateFontSelector)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/FontS.h>],
- [ Widget w;
- w = XmCreateFontSelector(NULL, "font-selector", NULL, 0)
- ])],
- [
- AC_DEFINE(HAVE_XmCreateFontSelector)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmCreateColorSelector)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>
- #include <Xm/ColorS.h>],
- [ Widget w;
- w = XmCreateColorSelector(NULL, "color-selector", NULL, 0)
- ])],
- [
- AC_DEFINE(HAVE_XmCreateColorSelector)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING(for XmToolTipGetLabel)
- AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [#include <Xm/XmAll.h>],
- [ Widget w = NULL;
- w = XmToolTipGetLabel(w)
- ])],
- [
- AC_DEFINE(HAVE_XmToolTipGetLabel)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING([whether sashes support relative panes])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <Xm/SashP.h>],
- [[ Widget w; int happy = 0;
- SashCallData call_data;
- if ((XtIsSubclass(w, xmSashWidgetClass)) &&
- (strcmp(call_data->params[0], "Start") == 0)) {happy = 1;}
- ]])],
- [
- AC_DEFINE(WITH_RELATIVE_PANES)
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_RESULT(no)
-
- # perhaps the user hasn't installed the Motif headers?
- AC_MSG_CHECKING([for Motif headers])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <Xm/XmAll.h>],
- [[ Widget w;
- w = XmCreateForm(NULL, "form", NULL, 0)
- ]]
- )],
- [AC_MSG_RESULT(yes)],
- [AC_MSG_RESULT(no)
- AC_MSG_WARN([can't find the Motif headers! These are in openmotif-devel or some such package, or perhaps you need to include the --with-motif-prefix switch: --with-motif-prefix=/usr/pkg for example -- I will look for Gtk])
- with_gtk=yes
- with_motif=no
- ])
- ])
- ],
- [
- AC_MSG_WARN([can't find the Motif library! -- will look for Gtk])
- with_gtk=yes
- with_motif=no
- ],
- $TEST_LIBS)
- LIBS=$SAVELIBS
- CFLAGS=$SAVEFLAGS
+ GX_FILES="MOTIF_O_FILES"
+ GX_HEADERS="SND_X_HEADERS"
- else
- if test "$with_gtk" != no ; then
- with_gtk=yes
- fi
+ if test "$with_editres" = yes ; then
+ AC_DEFINE(WITH_EDITRES)
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES editres"
+ X_PRE_LIBS="$X_PRE_LIBS -lXmu"
fi
- if test "$with_motif" = yes ; then
- AC_DEFINE(USE_MOTIF) # for Snd
- AC_DEFINE(HAVE_MOTIF) # for xm
- GRAPHICS_TOOLKIT="Motif"
- fi
+ GTK_LIBS="$X_PRE_LIBS $X_POST_LIBS -lXpm"
+ AC_DEFINE(USE_MOTIF)
+ GRAPHICS_TOOLKIT="Motif"
+ ac_snd_gui_choice=Motif
+fi
#--------------------------------------------------------------------------------
# Gtk
#--------------------------------------------------------------------------------
- if test "$with_gtk" = yes ; then
-
- if test x$PKG_CONFIG != xno ; then
- if $PKG_CONFIG gtk+-3.0 --exists ; then
-
- AM_PATH_GTK_3_0(2.90.0,
- [
- with_gtk=yes
- ],
- [
- AC_MSG_WARN([trouble with gtk -- will try to make Snd without any GUI])
- with_gtk=no
- ])
- else
-
- AM_PATH_GTK_2_0(2.12.0,
- [
- with_gtk=yes
- ],
- [
- AC_MSG_WARN([trouble with gtk (we need version 2.12.0 or later) -- will try to make Snd without any GUI])
- with_gtk=no
- ])
- fi
-
+if test "$ac_snd_gui_choice" = none ; then
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG gtk+-3.0 --exists ; then
+ GTK_CFLAGS="`$PKG_CONFIG gtk+-3.0 --cflags`"
+ GTK_LIBS="`$PKG_CONFIG gtk+-3.0 --libs`"
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-3.0 --libs-only-L` `$PKG_CONFIG gtk+-3.0 --libs-only-l`"
+ ac_snd_gui_choice=gtk
else
-
- AM_PATH_GTK_2_0(2.12.0,
- [
- with_gtk=yes
- ],
- [
- AC_MSG_WARN([trouble with gtk (we need version 2.12.0 or later) -- will try to make Snd without any GUI])
- with_gtk=no
- ])
+ if $PKG_CONFIG gtk+-2.0 --exists ; then
+ GTK_CFLAGS="`$PKG_CONFIG gtk+-2.0 --cflags`"
+ GTK_LIBS="`$PKG_CONFIG gtk+-2.0 --libs`"
+ GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
+ ac_snd_gui_choice=gtk
+ fi
fi
+ fi
+ if test "$ac_snd_gui_choice" = gtk ; then
+ GX_FILES="GTK_O_FILES"
+ GX_HEADERS="SND_G_HEADERS"
+ AC_DEFINE(USE_GTK)
+ GRAPHICS_TOOLKIT="Gtk"
- if test "$with_gtk" = yes ; then
- GX_FILES="G_O_FILES"
- GX_HEADERS="SND_G_HEADERS"
-
- case "$host" in
- *-*-solaris*)
- GTK_LIBS="$GTK_LIBS -lX11"
- ;;
- esac
-
- AC_SUBST(GTK_LIBS)
- AC_SUBST(GTK_CFLAGS)
- AC_DEFINE(USE_GTK)
- GRAPHICS_TOOLKIT="Gtk"
- ac_snd_have_gui=yes
-
- GTK_LD_LIBS="$GTK_LIBS"
- if test x$PKG_CONFIG != xno ; then
- if $PKG_CONFIG gtk+-3.0 --exists ; then
- if test "$with_directfb" = yes ; then
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-3.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-3.0 --libs-only-l`"
- else
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-3.0 --libs-only-L` `$PKG_CONFIG gtk+-3.0 --libs-only-l`"
- fi
- else
- if test "$with_directfb" = yes ; then
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-directfb-2.0 --libs-only-L` `$PKG_CONFIG gtk+-directfb-2.0 --libs-only-l`"
- else
- GTK_LD_LIBS="`$PKG_CONFIG gtk+-2.0 --libs-only-L` `$PKG_CONFIG gtk+-2.0 --libs-only-l`"
- fi
- fi
- pango_version="`$PKG_CONFIG pango --modversion`"
- AC_DEFINE_UNQUOTED(MUS_PANGO_VERSION,"${pango_version}")
- fi
-
- AC_SUBST(GTK_LD_LIBS)
-
- if test x$PKG_CONFIG != xno ; then
- CAIRO_CFLAGS="`$PKG_CONFIG cairo --cflags-only-I`"
- AC_SUBST(CAIRO_CFLAGS)
- cairo_version="`$PKG_CONFIG cairo --modversion`"
- AC_DEFINE_UNQUOTED(MUS_CAIRO_VERSION,"${cairo_version}")
- fi
-
- AC_CHECK_LIB(m, gtk_widget_get_has_tooltip, [AC_DEFINE(HAVE_GTK_WIDGET_GET_HAS_TOOLTIP)], ,$GTK_LIBS)
- # for 2.13.0
- AC_CHECK_LIB(m, gtk_test_widget_click, [AC_DEFINE(HAVE_GTK_TEST_WIDGET_CLICK)], ,$GTK_LIBS)
- # for 2.13.6 (uses 2134)
- AC_CHECK_LIB(m, gtk_adjustment_get_upper, [AC_DEFINE(HAVE_GTK_ADJUSTMENT_GET_UPPER)], ,$GTK_LIBS)
- # for 2.15.0|1|2|3 and 2.16.0 (uses 2150)
- AC_CHECK_LIB(m, gtk_scale_add_mark, [AC_DEFINE(HAVE_GTK_SCALE_ADD_MARK)], ,$GTK_LIBS)
- # for 2.15.1 up to 2.17.2
- AC_CHECK_LIB(m, gtk_info_bar_new, [AC_DEFINE(HAVE_GTK_INFO_BAR_NEW)], ,$GTK_LIBS)
- # for 2.17.3|4|5|6
- AC_CHECK_LIB(m, gtk_status_icon_get_title, [AC_DEFINE(HAVE_GTK_STATUS_ICON_GET_TITLE)], ,$GTK_LIBS)
- # for 2.17.7, 2.18.n
- AC_CHECK_LIB(m, gtk_widget_get_visible, [AC_DEFINE(HAVE_GTK_WIDGET_GET_VISIBLE)], ,$GTK_LIBS)
- # for 2.19.n
- AC_CHECK_LIB(m, gtk_widget_get_mapped, [AC_DEFINE(HAVE_GTK_WIDGET_GET_MAPPED)], ,$GTK_LIBS)
- # for 2.9n.n
- AC_CHECK_LIB(m, gtk_combo_box_new_with_area,
- [AC_DEFINE(HAVE_GTK_COMBO_BOX_NEW_WITH_AREA)
- AC_DEFINE(HAVE_GTK_3)
- ], ,$GTK_LIBS)
-
- AC_CHECK_LIB(cairo, cairo_glyph_allocate, [AC_DEFINE(HAVE_CAIRO_GLYPH_ALLOCATE)], ,$GTK_LIBS)
- AC_CHECK_LIB(cairo, cairo_region_xor, [AC_DEFINE(HAVE_CAIRO_REGION_XOR)], ,$GTK_LIBS)
-
- XLIBS=""
- XFLAGS=""
- AC_SUBST(XLIBS)
- AC_SUBST(XFLAGS)
- if test "$with_static_xm" = yes ; then
- GX_FILES="XG_O_FILES"
- AC_DEFINE(HAVE_STATIC_XM)
- fi
- fi
+ if test x$PKG_CONFIG != xno ; then
+ CAIRO_CFLAGS="`$PKG_CONFIG cairo --cflags-only-I`"
+ AC_SUBST(CAIRO_CFLAGS)
+ fi
fi
+fi
- if test "$with_gtk" != yes && test "$with_motif" != yes ; then
+if test "$ac_snd_gui_choice" = none ; then
AC_DEFINE(USE_NO_GUI)
- XLIBS=""
- XFLAGS=""
- AC_SUBST(XLIBS)
- AC_SUBST(XFLAGS)
GX_FILES="NO_GUI_O_FILES"
GX_HEADERS="NO_GUI_HEADERS"
- fi
+fi
+
+# fallback on no-gui
+if test "$with_gui" = no ; then
+ AC_DEFINE(USE_NO_GUI)
+ GX_FILES="NO_GUI_O_FILES"
+ GX_HEADERS="NO_GUI_HEADERS"
+ ac_snd_gui_choice=no
fi
+AC_SUBST(XLIBS)
+AC_SUBST(XFLAGS)
+
AC_SUBST(GX_FILES)
AC_SUBST(GX_HEADERS)
+AC_SUBST(GTK_LIBS)
+AC_SUBST(GTK_CFLAGS)
+AC_SUBST(GTK_LD_LIBS)
+
+
#--------------------------------------------------------------------------------
@@ -1076,72 +314,32 @@ AC_SUBST(GX_HEADERS)
GL_LIBS=""
GL_FILES=""
GL_FLAGS=""
-have_gl=no
-if test "$with_gl" = yes || test "$with_just_gl" = yes ; then
- if test "$with_motif" = yes ; then
- AC_CHECK_HEADER(GL/gl.h,
- [have_gl=yes],
- [
- OLD_CFLAGS="$CFLAGS"
- CFLAGS="-I/usr/X11R6/include $CFLAGS"
- # can't use AC_CHECK_HEADER here (GL/gl.h includes GL/glext.h, so the -I business has to be set up first)
-
- AC_MSG_CHECKING([for /usr/X11R6/include/GL/gl.h])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <GL/gl.h>],
- [int i; i = GL_TRUE])],
- [have_gl=yes
- GL_FLAGS="-I/usr/X11R6/include"
- CFLAGS="$OLD_CFLAGS"
- AC_MSG_RESULT(yes)
- ],
- [AC_MSG_WARN(can't find GL headers)])])
-
- # in FC5 glu.h and libGLU are missing by default -- do they come from Mesa?
- if test "$have_gl" = yes ; then
- AC_CHECK_HEADER(GL/glu.h,
- [AC_DEFINE(HAVE_GLU)
- GL_LIBS="$GL_LIBS -lGLU"
- ])
- GL_LIBS="$GL_LIBS -lGL"
+
+if test "$with_gl" = yes ; then
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG gl --exists ; then
+
+ GL_CFLAGS="`$PKG_CONFIG gl --cflags`"
+ GL_LIBS="`$PKG_CONFIG gl --libs`"
+ GL_FILES="gl.o"
+ AC_DEFINE(HAVE_GL)
+ OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES openGL"
+
+ if $PKG_CONFIG glu --exists ; then
+ AC_DEFINE(HAVE_GLU)
+ GL_CFLAGS="$GL_CFLAGS `$PKG_CONFIG glu --cflags`"
+ GL_LIBS="$GL_LIBS `$PKG_CONFIG glu --libs`"
+ fi
+
+ if test "$with_gl2ps" = yes ; then
+ AC_DEFINE(WITH_GL2PS)
+ RANDOM_FEATURES="$RANDOM_FEATURES gl2ps"
+ GL_FILES="$GL_FILES gl2ps.o"
+ fi
fi
- else
- AC_MSG_WARN([GL only works with Motif])
fi
fi
-if test "$have_gl" = yes ; then
- AC_DEFINE(HAVE_GL)
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES openGL"
- if test "$with_gl2ps" = yes ; then
- AC_DEFINE(WITH_GL2PS)
- RANDOM_FEATURES="$RANDOM_FEATURES gl2ps"
- GL_FILES="gl2ps.o"
- fi
- if test "$with_just_gl" = yes ; then
- AC_DEFINE(JUST_GL)
- else
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <GL/gl.h>],
- [int i; i = GL_TEXTURE_BINDING_3D])],
- [GL_FILES="$GL_FILES gl.o"],
- [AC_DEFINE(JUST_GL)])
- fi
- case "$host" in
- *-apple-*)
-
-# GL_LIBS="-framework OpenGL"
-# is this in place of or in addition to -lGL etc?
-# on OSX 10.5 we need the following:
-
- GL_LIBS="-L/usr/X11/lib -lGLU -lGL -Wl,-dylib_file,/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib -framework OpenGL"
- ;;
- esac
-else
- GL_LIBS=""
- GL_FILES=""
- GL_FLAGS=""
-fi
AC_SUBST(GL_LIBS)
AC_SUBST(GL_FILES)
AC_SUBST(GL_FLAGS)
@@ -1149,580 +347,87 @@ AC_SUBST(GL_FLAGS)
#--------------------------------------------------------------------------------
-# fam/gamin (needs GUI)
+# language
#--------------------------------------------------------------------------------
-FAM_LIB=""
-if test "$ac_snd_have_gui" != no ; then
- if test "$with_fam" != no ; then
- # look for the File Alteration Monitor (gamin or SGI's fam -- both use fam.h and libfam apparently)
- AC_MSG_CHECKING(for Gamin)
- if test x$PKG_CONFIG != xno && $PKG_CONFIG gamin --exists ; then
- gamin_version="`$PKG_CONFIG gamin --modversion`"
- AC_MSG_RESULT($gamin_version)
- # before version 0.0.18, gamin.pc messed up the --libs result, so we'll just insist on a later version
- if $PKG_CONFIG --atleast-version 0.1.0 gamin; then
- AC_DEFINE_UNQUOTED(MUS_GAMIN_VERSION,"${gamin_version}")
- FAM_LIB="`$PKG_CONFIG gamin --libs`"
- AC_DEFINE(HAVE_FAM)
- AC_DEFINE(HAVE_FAM_NO_EXISTS)
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gamin"
- else
- AC_MSG_WARN([need gamin version 0.1.0 or later])
- fi
- else
- AC_MSG_RESULT(no)
- AC_MSG_CHECKING(for Fam)
- AC_CHECK_LIB(fam, FAMOpen,
- [
- AC_DEFINE(HAVE_FAM)
- FAM_LIB="-lfam"
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES fam"
- ])
- fi
- fi
-fi
-AC_SUBST(FAM_LIB)
-
+# language choice: ruby if --with-ruby and we can find a ruby pc file
+# forth if --with-forth
+# none if --without-extension-language
+# s7 otherwise
+XEN_LIBS=""
+XEN_CFLAGS=""
+ac_snd_extension_language=none
-ac_snd_have_extension_language=no
+if test "$with_extension_language" = no ; then
+ ac_snd_extension_language=no
+ LOCAL_LANGUAGE="None"
+fi
#--------------------------------------------------------------------------------
# Ruby
#--------------------------------------------------------------------------------
-dnl AC_CHECK_RUBY([MINIMUM-VERSION [, ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]]])
-dnl Test for Ruby, defines
-dnl RUBY_VERSION
-dnl RUBY_RELEASE_DATE
-dnl RUBY_SEARCH_PATH
-dnl RUBY_CFLAGS
-dnl RUBY_LIBS
-
-AC_DEFUN([AC_CHECK_RUBY],
-[
- [AC_PATH_PROGS([RUBY], [$RUBY ruby], [no])]
- RUBY_VERSION=""
- RUBY_RELEASE_DATE=""
- RUBY_SEARCH_PATH=""
- RUBY_CFLAGS=""
- RUBY_LIBS=""
- AC_MSG_CHECKING([for Ruby])
- if test "$RUBY" != no ; then
- minimum_version=ifelse([$1], [], [1.8.0], [$1])
- RUBY_VERSION=`$RUBY -e 'puts RUBY_VERSION'`
- if `$RUBY -e "exit(RUBY_VERSION >= '$minimum_version' ? 0 : 1)"` ; then
- AC_MSG_RESULT([$RUBY_VERSION])
- RUBY_RELEASE_DATE=`$RUBY -e 'puts RUBY_RELEASE_DATE'`
- RUBY_SEARCH_PATH=`$RUBY -e 'puts $:.join(":")'`
- ruby_ldflags=""
- ruby_libs=""
- if `$RUBY -e "exit(RUBY_VERSION < '1.9.0' ? 0 : 1)"` ; then
- ruby_hdrdir=`$RUBY -rrbconfig -e [["puts Config::CONFIG['archdir']"]]`
- AC_MSG_CHECKING([for ruby.h])
- if test -e "$ruby_hdrdir/ruby.h" ; then
- RUBY_CFLAGS="-I$ruby_hdrdir"
- AC_MSG_RESULT([$ruby_hdrdir/ruby.h])
- else
- RUBY_CFLAGS=`$RUBY -e 'puts "-I" + $:.join(" -I")'`
- AC_MSG_RESULT([use \$LOAD_PATH])
- fi
- ruby_ldflags=`$RUBY -rrbconfig -e [["puts Config::CONFIG['LIBRUBYARG']"]]`
- ruby_libs=`$RUBY -rrbconfig -e [["puts Config::CONFIG['LIBS']"]]`
- else
- ruby_hdrdir=`$RUBY -rrbconfig -e [["puts RbConfig::CONFIG['rubyhdrdir']"]]`
- ruby_arch=`$RUBY -rrbconfig -e [["puts RbConfig::CONFIG['arch']"]]`
- AC_MSG_CHECKING([for ruby.h])
- if test -e "$ruby_hdrdir/ruby.h" ; then
- RUBY_CFLAGS="-I$ruby_hdrdir -I$ruby_hdrdir/$ruby_arch"
- AC_MSG_RESULT([$ruby_hdrdir/ruby.h])
- else
- ruby_hdrdir=`$RUBY -rrbconfig -e [["puts RbConfig::CONFIG['archdir']"]]`
- if test -e "$ruby_hdrdir/ruby.h" ; then
- RUBY_CFLAGS="-I$ruby_hdrdir"
- AC_MSG_RESULT([$ruby_hdrdir/ruby.h])
- else
- RUBY_CFLAGS=`$RUBY -e 'puts "-I" + $:.join(" -I")'`
- AC_MSG_RESULT([use \$LOAD_PATH])
- fi
+if test "$with_ruby" = yes ; then
+ if test x$PKG_CONFIG != xno ; then
+ m4_foreach([ruby_version], [[ruby-2.2], [ruby-2.1], [ruby-2.0], [ruby], [ruby-1.9.3], [ruby-1.9], [ruby-1.8]],
+ [
+ if test "$ac_snd_extension_language" = none ; then
+ if $PKG_CONFIG ruby_version --exists ; then
+ AC_DEFINE(HAVE_RUBY)
+ XEN_CFLAGS="`$PKG_CONFIG ruby_version --cflags`"
+ # this depends on building ruby itself with the --enable-shared flag
+ XEN_LIBS="`$PKG_CONFIG ruby_version --libs`"
+ LOCAL_LANGUAGE="Ruby"
+ ac_snd_extension_language=Ruby
fi
- ruby_ldflags=`$RUBY -rrbconfig -e [["puts RbConfig::CONFIG['LIBRUBYARG']"]]`
- ruby_libs=`$RUBY -rrbconfig -e [["puts RbConfig::CONFIG['LIBS']"]]`
fi
- RUBY_LIBS="$ruby_ldflags $ruby_libs"
- [$2]
- else
- AC_MSG_RESULT([Ruby version $RUBY_VERSION < $minimum_version])
- [$3]
- fi
- else
- AC_MSG_RESULT([no])
- [$3]
+ ])
fi
- AC_SUBST([RUBY_VERSION])
- AC_SUBST([RUBY_RELEASE_DATE])
- AC_SUBST([RUBY_SEARCH_PATH])
- AC_SUBST([RUBY_CFLAGS])
- AC_SUBST([RUBY_LIBS])
-])# AC_CHECK_RUBY
-
-# readline (for Ruby)
-AC_ARG_ENABLE(readline,
- [ --enable-readline include readline (the default)], ,)
-
-AC_ARG_WITH(ruby-prefix,[ --with-ruby-prefix=PFX where Ruby is installed],
- ruby_prefix="$withval"
- RUBY="$ruby_prefix/bin/ruby",
- ruby_prefix="/usr/local")
-
-if test "$with_ruby" = yes && test "$ac_snd_have_extension_language" = yes ; then
- with_ruby=no
- AC_MSG_WARN([You asked for both Ruby and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used])
fi
-AC_ARG_WITH(ruby,
- [ --with-ruby use Ruby as the extension language],
- if test "$with_ruby" = yes ; then
- AC_CHECK_RUBY([1.8.0],
- [AC_DEFINE(HAVE_RUBY)
- AC_DEFINE(HAVE_EXTENSION_LANGUAGE)
- AC_DEFINE_UNQUOTED(MUS_RUBY_VERSION, "$RUBY_VERSION")
- AC_DEFINE_UNQUOTED(RUBY_RELEASE_DATE, "$RUBY_RELEASE_DATE")
- AC_DEFINE_UNQUOTED(RUBY_SEARCH_PATH, "$RUBY_SEARCH_PATH")
- XEN_CFLAGS="$XEN_CFLAGS $RUBY_CFLAGS"
- XEN_LIBS="$XEN_LIBS $RUBY_LIBS"
- if test "$enable_readline" != no ; then
- AC_CHECK_LIB(readline, readline,
- [AC_DEFINE(HAVE_READLINE)
- XEN_LIBS="$XEN_LIBS -lreadline -lncurses"], ,"-lncurses")
- fi
- AC_SUBST(XEN_LIBS)
- AC_SUBST(XEN_CFLAGS)
- OLD_LIBS="$LIBS"
- LIBS="$XEN_LIBS $LIBS -lm"
- OLD_CFLAGS="$CFLAGS"
- CFLAGS="$XEN_CFLAGS $CFLAGS"
- AC_MSG_CHECKING([for rb_proc_new])
-
- AC_RUN_IFELSE(
- [AC_LANG_PROGRAM([@%:@include <ruby.h>
- VALUE proc_call(VALUE args, VALUE id) {return(rb_apply(rb_mKernel, (ID)id, args));}
- ],
- [VALUE proc;
- ruby_init();
-@%:@ifdef __cplusplus
- proc = rb_proc_new((VALUE (*)(...))proc_call, rb_intern("hi"))
-@%:@else
- proc = rb_proc_new(proc_call, rb_intern("hi"))
-@%:@endif
- ])
- ],
- [AC_DEFINE(HAVE_RB_PROC_NEW)
- AC_MSG_RESULT(yes)
- ],
- AC_MSG_RESULT(no)
- )
-
- AC_MSG_CHECKING([for ruby_vsnprintf])
- AC_RUN_IFELSE(
- [AC_LANG_PROGRAM([@%:@include <ruby.h>],
- [ruby_init(); ruby_vsnprintf(0, 0, 0, 0); return(0)])],
- [AC_DEFINE(HAVE_VSNPRINTF, 0)
- AC_MSG_RESULT(yes)
- ],
- AC_MSG_RESULT(no)
- )
- LIBS="$OLD_LIBS"
- CFLAGS="$OLD_CFLAGS"
- LOCAL_LANGUAGE="Ruby"
- ac_snd_have_extension_language=yes])
- fi)
-
-
#--------------------------------------------------------------------------------
# Forth
#--------------------------------------------------------------------------------
-if test "$with_forth" = yes && test "$ac_snd_have_extension_language" = yes ; then
- with_forth=no
- AC_MSG_WARN([You asked for both Forth and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used])
+if test "$with_forth" = yes ; then
+ AC_PATH_PROG([FTH], [fth], [no])
+ AC_MSG_CHECKING([for Forth])
+ if test "${FTH}" != no ; then
+ XEN_CFLAGS=`${FTH} --no-init-file --eval .cflags`
+ XEN_LIBS=`${FTH} --no-init-file --eval .libs`
+ AC_MSG_RESULT([yes])
+ AC_DEFINE(HAVE_FORTH)
+ LOCAL_LANGUAGE="Forth"
+ ac_snd_extension_language=Forth
+ else
+ AC_MSG_RESULT([no])
+ fi
fi
-AC_ARG_WITH(forth,
- [ --with-forth use Forth as the extension language],
- if test "$with_forth" = yes ; then
- FTH_CHECK_LIB([AC_DEFINE(HAVE_FORTH)
- AC_DEFINE(HAVE_EXTENSION_LANGUAGE)
- if test "$FTH_HAVE_COMPLEX" = yes ; then
- AC_DEFINE(HAVE_COMPLEX_TRIG)
- AC_DEFINE(HAVE_MAKE_COMPLEX)
- AC_DEFINE(HAVE_MAKE_RECTANGULAR)
- fi
- if test "$FTH_HAVE_RATIO" = yes ; then
- AC_DEFINE(HAVE_MAKE_RATIO)
- fi
- AC_SUBST(XEN_CFLAGS, $FTH_CFLAGS)
- AC_SUBST(XEN_LIBS, $FTH_LIBS)
- LOCAL_LANGUAGE="Forth"
- ac_snd_have_extension_language=yes])
- fi)
-
-
#--------------------------------------------------------------------------------
-# S7 (the default)
+# s7 (the default)
#--------------------------------------------------------------------------------
-S7_LIB=""
-
-if test "$with_s7" = yes && test "$ac_snd_have_extension_language" = yes ; then
- with_s7=no
- AC_MSG_WARN([You asked for both s7 and $LOCAL_LANGUAGE -- $LOCAL_LANGUAGE will be used])
+if test "$with_s7" != no && test "$ac_snd_extension_language" = none ; then
+ AC_DEFINE(HAVE_SCHEME)
+ ac_snd_extension_language=s7
+ LOCAL_LANGUAGE="s7"
+ S7_LIB="s7.o"
+ AC_SUBST(S7_LIB)
fi
-if test "$with_s7" != no && test "$with_extension_language" != no && test "$ac_snd_have_extension_language" != yes ; then
- AC_DEFINE(HAVE_S7)
- AC_DEFINE(HAVE_SCHEME)
- ac_snd_have_extension_language=yes
- AC_DEFINE(HAVE_EXTENSION_LANGUAGE)
- AC_DEFINE(HAVE_MAKE_RATIO)
- AC_CHECK_HEADER(complex.h,
- [
- AC_DEFINE(HAVE_MAKE_RECTANGULAR)
- ])
-
- LOCAL_LANGUAGE="s7"
- S7_LIB="s7.o"
-fi
+AC_SUBST(XEN_LIBS)
+AC_SUBST(XEN_CFLAGS)
-AC_SUBST(S7_LIB)
#--------------------------------------------------------------------------------
-# Audio library
-#--------------------------------------------------------------------------------
-
-AUDIO_LIB=""
-LDSO_FLAGS=""
-SO_FLAGS=""
-SO_LD="ld"
-
-JACK_LIBS=""
-JACK_FLAGS=""
-
-
-if test "$with_audio" != no ; then
-
-# we need the sndlib.h equivalents to try to find the native sound support (see config.guess)
-# this only matters for those cases where we've implemented the audio code in audio.c
-# test for ALSA courtesy of Paul Davis
-# test for ESD courtesy of Nick Bailey
-# test for BSD courtesy of Steven Schultz
-# test for Jack courtesy of Kjetil S. Matheussen
-
-if test "$with_esd" = yes ; then
- AC_CHECK_LIB(esd, main, [
- AC_CHECK_HEADER(esd.h,
- [AC_DEFINE(MUS_ESD)
- esd_version="`esd-config --version`"
- AC_DEFINE_UNQUOTED(MUS_ESD_VERSION,"${esd_version}")
- audiofile_version="`audiofile-config --version`"
- AC_DEFINE_UNQUOTED(MUS_AUDIOFILE_VERSION,"${audiofile_version}")
- AUDIO_LIB="`esd-config --libs`"
- if test "$with_alsa" = yes || test "$with_static_alsa" = yes ; then
- AC_MSG_WARN([esd takes precedence over alsa -- the two are not compatible])
- fi
- AUDIO_SYSTEM=esd
- ],
- [AC_MSG_WARN(can't find the ESD header files)])],
- [AC_MSG_WARN(can't find the ESD library)])
-
-else
-
-if test "$with_pulseaudio" = yes ; then
- AC_CHECK_LIB(pulse-simple, main, [
- AC_CHECK_HEADER(pulse/simple.h,
- [AC_DEFINE(MUS_PULSEAUDIO)
- if test x$PKG_CONFIG != xno ; then
- AUDIO_LIB="`$PKG_CONFIG libpulse-simple --libs`"
- else
- AUDIO_LIB="-lpulse-simple"
- fi
- AUDIO_SYSTEM=pulseaudio
- ],
- [AC_MSG_WARN(can't find the pulseaudio header files)])],
- [AC_MSG_WARN(can't find the pulseaudio library)])
-fi
-fi
-
-
-if test "$with_portaudio" = yes ; then
- AC_CHECK_LIB(portaudio, main, [
- AC_CHECK_HEADER(portaudio.h, [
- AUDIO_SYSTEM=portaudio
- AC_DEFINE(MUS_PORTAUDIO)
- if test x$PKG_CONFIG != xno ; then
- AUDIO_LIB="`$PKG_CONFIG portaudio-2.0 --libs`"
- else
- AUDIO_LIB="-lportaudio"
- fi
- ],
- [AC_MSG_WARN(can't find the portaudio header file)])],
- [AC_MSG_WARN(can't find the portaudio library)])
-fi
-
-
-if test "$AUDIO_SYSTEM" != None ; then
- AC_MSG_RESULT(Using the $AUDIO_SYSTEM audio system)
-else
-
-if test "$with_alsa" = yes && test "$with_oss" = yes ; then
- with_oss=no
- AC_MSG_WARN([You asked for both ALSA and OSS -- ALSA will be used])
-fi
-
-if test "$with_jack" = yes ; then
- AC_CHECK_LIB(jack, main, [
- AC_CHECK_HEADER(jack/jack.h, ,
- [with_jack=no
- AC_MSG_WARN(can't find the JACK header files)])],
- [with_jack=no
- AC_MSG_WARN(can't find the JACK library)])
- AC_CHECK_LIB(samplerate, main,[
- AC_CHECK_HEADER(samplerate.h, ,
- [with_jack=no
- AC_MSG_WARN(can't find the samplerate header files. JACK will not be used.)])],
- [with_jack=no
- AC_MSG_WARN(can't find the samplerate library. JACK will not be used.)])
- if test $with_jack = yes ; then
- AUDIO_SYSTEM=JACK
- AC_DEFINE(MUS_JACK)
- if test x$PKG_CONFIG != xno ; then
- jack_version="`$PKG_CONFIG jack --modversion`"
- AC_DEFINE_UNQUOTED(MUS_JACK_VERSION, "Jack: ${jack_version}")
- JACK_LIBS="`$PKG_CONFIG jack --libs`"
- JACK_FLAGS="`$PKG_CONFIG jack --cflags`"
- fi
- fi
-fi
-
-
-case "$host" in
- *-*-linux*)
- AC_DEFINE(MUS_LINUX)
- LDSO_FLAGS="-shared"
- LIBS="$LIBS -lm"
- if test "$ac_cv_header_dlfcn_h" = yes ; then
- LDFLAGS="$LDFLAGS -ldl"
- fi
- if test "$GCC" = yes ; then
- SO_FLAGS="-fPIC $SO_FLAGS"
- fi
-
- AUDIO_SYSTEM=ALSA
- if test "$with_oss" = yes ; then
- AUDIO_SYSTEM=OSS
- else
-
- if test "$ac_cv_header_alsa_asoundlib_h" = yes ; then
- AC_CHECK_LIB(asound, main,
- AUDIO_SYSTEM=ALSA,
- [AC_MSG_WARN(can't find the ALSA library)])
- else
- AC_MSG_WARN(can't find the ALSA header files)
- AUDIO_SYSTEM=OSS
- fi
- fi
-
- if test "$with_jack" = yes ; then
- if test "$with_alsa" != yes ; then
- AUDIO_SYSTEM=JACK
- fi
- fi
-
- case $AUDIO_SYSTEM in
- ALSA)
- # if alsa version < 1.0 complain and use OSS
- alsa_ok=yes
- AC_MSG_CHECKING([for ALSA 1.0 or later])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <alsa/asoundlib.h>],
- [
- #if (SND_LIB_MAJOR < 1)
- #error too old
- #endif
- ])],
- alsa_ok=yes,
- alsa_ok=no)
- AC_MSG_RESULT($alsa_ok)
- if test "$alsa_ok" = yes ; then
- AC_DEFINE(HAVE_ALSA)
- if test "$with_static_alsa" = yes ; then
- AUDIO_LIB="/usr/lib/libasound.a"
- else
- AUDIO_LIB="-lasound"
- fi
- if test "$with_jack" = yes ; then
- if test "$with_static_alsa" = yes ; then
- AUDIO_LIB="/usr/lib/libasound.a -lsamplerate"
- else
- AUDIO_LIB="-lasound -lsamplerate"
- fi
- AC_DEFINE(HAVE_JACK_IN_LINUX)
- fi
- else
- AUDIO_SYSTEM=OSS
- AC_DEFINE(HAVE_OSS)
- fi
- ;;
- JACK)
- AC_DEFINE(HAVE_JACK_IN_LINUX)
- AC_DEFINE(HAVE_OSS)
- JACK_LIBS="$JACK_LIBS -lpthread"
-# added -lpthread 21-May-10 for FC13 (Bill S)
- AUDIO_LIB="-lsamplerate"
- ;;
- OSS)
- AC_DEFINE(HAVE_OSS)
- AUDIO_SYSTEM=OSS
- ;;
- esac
- ;;
- *-*-sunos4*)
- AC_DEFINE(MUS_SUN)
- LIBS="$LIBS -lm"
- AUDIO_SYSTEM=Sun
- ;;
- *-*-solaris*)
- AC_DEFINE(MUS_SUN)
- LIBS="$LIBS -lm -ldl"
-# odd... this causes an error in the sndlib configure (can't find libdl) but is needed here?
- AUDIO_SYSTEM=Sun
- LDSO_FLAGS="-G"
-# if __SUNPRO_C we could add -xO3
- ;;
- *-*-hpux*)
- AC_DEFINE(MUS_HPUX)
- AUDIO_SYSTEM=Hpux
- LDSO_FLAGS="+z -Ae +DA1.1"
- if test "$GCC" = yes ; then
- SO_FLAGS="-fPIC $SO_FLAGS"
- fi
- ;;
- *-*-bsdi*)
- AC_DEFINE(HAVE_OSS)
- LIBS="$LIBS -lm"
- AUDIO_SYSTEM=OSS
- if test "$GCC" = yes ; then
- SO_FLAGS="-fPIC $SO_FLAGS"
- fi
- ;;
- *-*-freebsd*)
- AC_DEFINE(HAVE_OSS)
- LIBS="$LIBS -lm"
- AUDIO_SYSTEM=OSS
- if test "$GCC" = yes ; then
- SO_LD="gcc"
- SO_FLAGS="-fPIC $SO_FLAGS"
- LDSO_FLAGS="-shared"
- fi
- ;;
- *-*-openbsd*)
- AC_DEFINE(MUS_OPENBSD)
- AUDIO_SYSTEM=OpenBSD
- if test "$GCC" = yes ; then
- SO_FLAGS="-fPIC $SO_FLAGS"
- fi
- ;;
- *-*-netbsd*)
- AC_DEFINE(MUS_NETBSD)
- AUDIO_SYSTEM=NetBSD
- if test "$GCC" = yes ; then
- SO_LD="gcc"
- SO_FLAGS="-fPIC $SO_FLAGS"
- LDSO_FLAGS="-shared"
- fi
- ;;
- *-*-cygwin*)
- if test "$with_jack" != yes ; then
- AC_DEFINE(MUS_WINDOZE)
- AUDIO_SYSTEM=Windoze
- fi
- ;;
- *-*-mingw*)
- AC_DEFINE(MUS_WINDOZE)
- audio_system=Windoze
- LIBS="$LIBS -lwinmm -lwsock32"
- ;;
- *-apple-*)
- if test "$with_jack" != yes ; then
-
- AC_DEFINE(MUS_MAC_OSX)
- AUDIO_SYSTEM=MacOSX
- AUDIO_LIB="-framework CoreAudio -framework CoreFoundation -framework CoreMIDI"
-
- # OSX 10.5, deprecating earlier AudioDeviceRemoveIOProc
- AC_MSG_CHECKING([for AudioDeviceDestroyIOProcID])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <CoreServices/CoreServices.h>
- #include <CoreAudio/CoreAudio.h>],
- [AudioDeviceIOProcID procId;
- AudioDeviceID device = kAudioDeviceUnknown;
- AudioDeviceDestroyIOProcID(device, procId)
- ])],
- [AC_DEFINE(HAVE_AUDIODEVICEDESTROYIOPROCID)
- AC_MSG_RESULT(yes)],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING([for kAudioDevicePropertyDeviceManufacturer])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <CoreServices/CoreServices.h>
- #include <CoreAudio/CoreAudio.h>],
- [AudioDeviceID deviceID;
- UInt32 trans_size = 0, trans;
- trans_size = sizeof(UInt32);
- AudioDeviceGetProperty(deviceID, 0, true, kAudioDevicePropertyTransportType, &trans_size, &trans)
- ])],
- [AC_DEFINE(HAVE_KAUDIODEVICEPROPERTYTRANSPORTTYPE)
- AC_MSG_RESULT(yes)],
- [AC_MSG_RESULT(no)])
-
- AC_MSG_CHECKING([for kLinearPCMFormatFlagIsNonInterleaved])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <CoreServices/CoreServices.h>
- #include <CoreAudio/CoreAudio.h>],
- [int i; i = kLinearPCMFormatFlagIsNonInterleaved])],
- [AC_DEFINE(HAVE_KLINEARPCMFORMATFLAGISNONINTERLEAVED)
- AC_MSG_RESULT(yes)],
- [AC_MSG_RESULT(no)])
- else
- AUDIO_SYSTEM=JACK
- JACK_LIBS="-framework CoreAudio -framework CoreServices -framework AudioUnit -L/usr/local/lib -ljack -lsamplerate"
- JACK_FLAGS="-I/usr/local/include"
- fi
- ;;
-esac
-AC_MSG_CHECKING([for audio system])
-AC_MSG_RESULT($AUDIO_SYSTEM)
-fi
-fi
-
-AC_SUBST(AUDIO_LIB)
-AC_SUBST(JACK_LIBS)
-AC_SUBST(JACK_FLAGS)
-
-
-AC_SUBST(LDSO_FLAGS)
-AC_SUBST(SO_FLAGS)
-AC_SUBST(SO_LD)
-
-
-#--------------------------------------------------------------------------------
-# OGG, Flac, Speex, Mpeg, Timidity, Shorten, TTA, Wavpack
+# OGG, Flac, Speex, Mpeg, Timidity, TTA, Wavpack
# --------------------------------------------------------------------------------
AC_PATH_PROG(PATH_OGGDEC, oggdec, no) # OGG read
@@ -1749,6 +454,7 @@ AC_PATH_PROG(PATH_MPG321, mpg321, no) # MPEG read/write?
if test "$PATH_MPG321" != "no" ; then
AC_DEFINE(HAVE_MPEG)
+ AC_DEFINE(HAVE_MPG321)
AC_DEFINE_UNQUOTED(PATH_MPG321, "${PATH_MPG321}")
fi
@@ -1781,14 +487,6 @@ if test "$PATH_TIMIDITY" != "no" ; then
fi
-AC_PATH_PROG(PATH_SHORTEN, shorten, no)
-
-if test "$PATH_SHORTEN" != "no" ; then
- AC_DEFINE(HAVE_SHORTEN)
- AC_DEFINE_UNQUOTED(PATH_SHORTEN, "${PATH_SHORTEN}")
-fi
-
-
AC_PATH_PROG(PATH_TTA, ttaenc, no)
if test "$PATH_TTA" != "no" ; then
@@ -1807,260 +505,274 @@ if test "$PATH_WAVPACK" != "no" ; then
AC_DEFINE_UNQUOTED(PATH_WVUNPACK, "${PATH_WVUNPACK}")
fi
fi
-
-# other decoders that I've looked at aren't acceptable in this context because they put various
-# special restrictions on use, or hide source code, or are just nuts.
#--------------------------------------------------------------------------------
-# statvfs
+# Audio
#--------------------------------------------------------------------------------
-statvfs_ok=0
-if test "$ac_cv_func_statvfs" = yes ; then
- if test "$ac_cv_header_sys_statvfs_h" = yes ; then
- AC_MSG_CHECKING([for statvfs])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <sys/statvfs.h>],
- [struct statvfs buf; statvfs("test.snd", &buf)])],
- AC_DEFINE(USE_STATVFS)
- statvfs_ok=1)
- if test $statvfs_ok = 1 ; then
- AC_MSG_RESULT(yes)
- else
- AC_MSG_RESULT(no)
- fi
+AUDIO_LIB=""
+JACK_LIBS=""
+JACK_FLAGS=""
+
+if test "$with_audio" != no ; then
+
+ if test "$with_pulseaudio" = yes ; then
+ AC_DEFINE(MUS_PULSEAUDIO)
+ AUDIO_LIB="-lpulse-simple"
+ AUDIO_SYSTEM=pulseaudio
+ fi
+
+ if test "$with_portaudio" = yes ; then
+ AC_DEFINE(MUS_PORTAUDIO)
+ AUDIO_SYSTEM=portaudio
+ AUDIO_LIB="-lportaudio"
fi
-fi
-statfs_ok=0
-if test $statvfs_ok = 0 ; then
- if test "$ac_cv_func_statfs" = yes ; then
- if test "$ac_cv_header_sys_param_h" = yes ; then
- if test "$ac_cv_header_sys_mount_h" = yes ; then
- AC_MSG_CHECKING([for statfs])
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([#include <sys/param.h>
- #include <sys/mount.h>
- ],
- [struct statfs buf;
- int size = 0;
- statfs("test.snd", &buf);
- if (buf.f_bsize = 1024)
- size = (int)(buf.f_bavail)
- ])],
- AC_DEFINE(USE_STATFS)
- statfs_ok=1)
- if test $statfs_ok = 1 ; then
- AC_MSG_RESULT(yes)
+ if test "$with_jack" = yes ; then
+ if test "$with_alsa" = yes ; then
+ AUDIO_SYSTEM=ALSA+JACK
+ else
+ AUDIO_SYSTEM=JACK
+ fi
+ AC_DEFINE(MUS_JACK)
+ if test x$PKG_CONFIG != xno ; then
+ if $PKG_CONFIG jack --exists ; then
+ JACK_LIBS="`$PKG_CONFIG jack --libs`"
+ JACK_FLAGS="`$PKG_CONFIG jack --cflags`"
+ if $PKG_CONFIG samplerate --exists ; then
+ JACK_LIBS="$JACK_LIBS `$PKG_CONFIG samplerate --libs`"
+ JACK_FLAGS="$JACK_FLAGS `$PKG_CONFIG samplerate --cflags`"
else
- AC_MSG_RESULT(no)
+ JACK_LIBS="$JACK_LIBS -lsamplerate"
fi
+ else
+ JACK_LIBS="-ljack -lsamplerate"
fi
+ else
+ JACK_LIBS="-ljack -lsamplerate"
fi
+ JACK_LIBS="$JACK_LIBS -lpthread"
fi
-fi
+ if test "$with_alsa" = yes ; then
+ AC_DEFINE(HAVE_ALSA)
+ AUDIO_LIB="-lasound"
+ if test "$with_jack" = yes ; then
+ AUDIO_SYSTEM=ALSA+JACK
+ else
+ AUDIO_SYSTEM=ALSA
+ fi
+ fi
-#--------------------------------------------------------------------------------
-# debugging flag
-#--------------------------------------------------------------------------------
+ if test "$with_oss" = yes ; then
+ AC_DEFINE(HAVE_OSS)
+ AUDIO_SYSTEM=OSS
+ fi
+
+ if test "$AUDIO_SYSTEM" = None ; then
+ case "$host" in
+ *-*-linux*)
+ AUDIO_SYSTEM=ALSA
+ AC_DEFINE(HAVE_ALSA)
+ AUDIO_LIB="-lasound"
+ ;;
+ *-*-sunos4*)
+ AUDIO_SYSTEM=Sun
+ ;;
+ *-*-solaris*)
+ AUDIO_SYSTEM=Sun
+ ;;
+ *-*-hpux*)
+ AUDIO_SYSTEM=Hpux
+ ;;
+ *-*-bsdi*)
+ AC_DEFINE(HAVE_OSS)
+ AUDIO_SYSTEM=OSS
+ ;;
+ *-*-freebsd*)
+ AC_DEFINE(HAVE_OSS)
+ AUDIO_SYSTEM=OSS
+ ;;
+ *-*-openbsd*)
+ AUDIO_SYSTEM=OpenBSD
+ ;;
+ *-*-netbsd*)
+ AUDIO_SYSTEM=NetBSD
+ ;;
+ *-*-cygwin*)
+ if test "$with_jack" != yes ; then
+ AUDIO_SYSTEM=Windows
+ fi
+ ;;
+ *-*-mingw*)
+ audio_system=Windows
+ ;;
+ *-apple-*)
+ if test "$with_jack" != yes ; then
+ AUDIO_SYSTEM=MacOSX
+ AUDIO_LIB="-framework CoreAudio -framework CoreFoundation -framework CoreMIDI"
+ else
+ AUDIO_SYSTEM=JACK
+ JACK_LIBS="-framework CoreAudio -framework CoreServices -framework AudioUnit -L/usr/local/lib -ljack -lsamplerate"
+ JACK_FLAGS="-I/usr/local/include"
+ fi
+ ;;
+ esac
+ fi
+fi
-AC_ARG_ENABLE(snd-debug,
- [ --enable-snd-debug include internal Snd debugging functions],
- if test "$enable_snd_debug" = yes ; then
- AC_DEFINE(MUS_DEBUGGING)
- RANDOM_FEATURES="$RANDOM_FEATURES debugging"
- VL_PROG_CC_WARNINGS()
- fi)
+AC_MSG_CHECKING([for audio system])
+AC_MSG_RESULT($AUDIO_SYSTEM)
-if test "$with_profiling" = yes ; then
- AC_DEFINE(WITH_PROFILING)
+if test "$AUDIO_SYSTEM" != None ; then
+ AC_DEFINE(WITH_AUDIO)
fi
+AC_SUBST(AUDIO_LIB)
+AC_SUBST(JACK_LIBS)
+AC_SUBST(JACK_FLAGS)
+
#--------------------------------------------------------------------------------
-# sigsetjmp special case
+# compiler/loader flags
#--------------------------------------------------------------------------------
-# look for sigsetjmp for segfault trap
-if test "$enable_snd_debug" != yes ; then
- trap_segfault=no
- AC_MSG_CHECKING([for sigsetjmp])
- AC_LINK_IFELSE([AC_LANG_PROGRAM([#include <setjmp.h>],
- [sigjmp_buf hi; sigsetjmp(hi,1)])],
- trap_segfault=yes)
- if test $trap_segfault = yes; then
- AC_DEFINE(MUS_TRAP_SEGFAULT,1)
- fi
- AC_MSG_RESULT($trap_segfault)
-fi
+LIBS=""
+LDSO_FLAGS=""
+SO_FLAGS=""
+SO_LD="ld"
+# the SO_* stuff here is for consistency with the sndlib configure script
+case "$host" in
+ *-*-linux*)
+ LDSO_FLAGS="-shared"
+ LIBS="$LIBS -lm -ldl"
+ if test "$GCC" = yes ; then
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ SO_LD="$CC"
+ fi
+ ;;
-#--------------------------------------------------------------------------------
-# sndlib
-#--------------------------------------------------------------------------------
-#
-# look for sndlib-config, check mus_sample_bits against current choice [with-float-sample, with-sample-width]
-# also language (s7, Ruby, Forth) needs to match (what about versions!) and audio choice
-# check against needed version (17.2 for now -- need mus_vct_copy in vct.c)
-# set SNDLIB_FILES and SNDLIB_LIB
-
-SNDLIB_FILES="SNDLIB_O_FILES"
-if test "$enable_snd_debug" != yes ; then
- SNDLIB_LIB=""
-fi
-SNDLIB_PREFIX=""
-AC_ARG_WITH(shared-sndlib,[ --with-shared-sndlib try to load libsndlib.so])
-if test "$with_shared_sndlib" = yes; then
- if test "$SNDLIB_CONFIG_path" != "" ; then
- if ! test -x "${SNDLIB_CONFIG_path}sndlib-config" ; then
- # try adding the "/" to the path
- SNDLIB_CONFIG_path="${SNDLIB_CONFIG_path}/"
+ *-*-sunos4*)
+ LIBS="$LIBS -lm"
+ ;;
+
+ *-*-solaris*)
+ LIBS="$LIBS -lm"
+ LDSO_FLAGS="-G"
+ ;;
+
+ *-*-hpux*)
+ LDSO_FLAGS="+z -Ae +DA1.1"
+ if test "$GCC" = yes ; then
+ SO_FLAGS="-fPIC $SO_FLAGS"
fi
- fi
- if ! test -x "${SNDLIB_CONFIG_path}sndlib-config" ; then
- AC_PATH_PROG(SNDLIB_CONFIG, sndlib-config, no)
- else
- SNDLIB_CONFIG="${SNDLIB_CONFIG_path}sndlib-config"
- fi
- if test "$SNDLIB_CONFIG" = "no" ; then
- AC_MSG_RESULT(no)
- else
- SNDLIB_PREFIX=`$SNDLIB_CONFIG --prefix`
- OLD_CFLAGS="$CFLAGS"
- CFLAGS="$CFLAGS -L$SNDLIB_PREFIX/lib"
- AC_CHECK_LIB(sndlib, mus_vct_copy,
- [
- SNDLIB_AUDIO_CHOICE=`$SNDLIB_CONFIG --audio`
- if test "$SNDLIB_AUDIO_CHOICE" != "$AUDIO_SYSTEM" ; then
- AC_MSG_WARN([libsndlib.so audio choice is $SNDLIB_AUDIO_CHOICE, but the current choice is $AUDIO_SYSTEM])
- fi
- SNDLIB_BITS=`$SNDLIB_CONFIG --bits`
- if test "$SNDLIB_BITS" = "$LOCAL_SNDLIB_BITS" ; then
- SNDLIB_LANGUAGE=`$SNDLIB_CONFIG --language`
- if test "$SNDLIB_LANGUAGE" = $LOCAL_LANGUAGE ; then
- SNDLIB_FILES="NO_FILES"
- SNDLIB_LIB="-L$SNDLIB_PREFIX/lib -lsndlib"
- OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES sndlib"
- AC_DEFINE(WITH_SHARED_SNDLIB)
- else
- AC_MSG_WARN([libsndlib.so was built with $SNDLIB_LANGUAGE, but current choice is $LOCAL_LANGUAGE])
- fi
- else
- AC_MSG_WARN([libsndlib.so is not compatible with current Snd mus_sample_t choice])
- fi
- ])
- CFLAGS="$OLD_CFLAGS"
+ ;;
+
+ *-*-bsdi*)
+ LIBS="$LIBS -lm"
+ if test "$GCC" = yes ; then
+ SO_FLAGS="-fPIC $SO_FLAGS"
fi
-fi
-AC_SUBST(SNDLIB_FILES)
-AC_SUBST(SNDLIB_LIB)
+ ;;
+ *-*-freebsd*)
+ LIBS="$LIBS -lm"
+ if test "$GCC" = yes ; then
+ SO_LD="$CC"
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ CFLAGS="-fPIC $CFLAGS"
+ LDSO_FLAGS="-shared"
+ fi
+ ;;
-#--------------------------------------------------------------------------------
-# debugging stuff
-#--------------------------------------------------------------------------------
+ *-*-openbsd*)
+ LIBS="$LIBS -lm"
+ if test "$GCC" = yes ; then
+ SO_LD="$CC"
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ CFLAGS="-ftrampolines $CFLAGS"
+ LDSO_FLAGS="-shared"
+ fi
+ ;;
-AC_ARG_ENABLE(deprecated,
- [ --disable-deprecated do not include any deprecated stuff from gtk, s7, motif, clm, snd, or sndlib],
- if test "$enable_deprecated" = no ; then
- CFLAGS="-DGTK_DISABLE_DEPRECATED -DG_DISABLE_DEPRECATED -DGDK_DISABLE_DEPRECATED -DPANGO_DISABLE_DEPRECATED -DCAIRO_DISABLE_DEPRECATED -DGSEAL_ENABLE -DGTK_DISABLE_SINGLE_INCLUDES -Wall $CFLAGS"
- AC_DEFINE(XM_DISABLE_DEPRECATED)
- AC_DEFINE(CLM_DISABLE_DEPRECATED)
- AC_DEFINE(SNDLIB_DISABLE_DEPRECATED)
- AC_DEFINE(XEN_DISABLE_DEPRECATED)
- AC_DEFINE(S7_DISABLE_DEPRECATED)
- AC_DEFINE(SND_DISABLE_DEPRECATED)
- fi)
-
-if test "$enable_snd_debug" = yes ; then
- CFLAGS="-I. $CFLAGS"
- if test "$GCC" = yes ; then
- if test "$LOCAL_LANGUAGE" = "Ruby" ; then
- if test "$CC" = "g++" ; then
- CFLAGS="$CFLAGS -O -g3 -Wcast-align -Wpointer-arith -Wimplicit -Wreturn-type -Wunused-label -Wunused-variable -Wunused-value -Wcomment -Wformat -Wunused-function -Wuninitialized -Wparentheses -Wall -Winit-self -Wsequence-point -Wmissing-field-initializers -Wmissing-prototypes"
- else
- CFLAGS="$CFLAGS -O -g3 -Wcast-align -Wpointer-arith -Wimplicit -Wreturn-type -Wunused-label -Wunused-variable -Wunused-value -Wcomment -Wformat -Wunused-function -Wuninitialized -Wparentheses -Wall -Winit-self -Wsequence-point -Wmissing-field-initializers -Wmissing-prototypes"
- fi
- else
- if test "$CC" = "g++" ; then
- CFLAGS="$CFLAGS -O -g3 -Wredundant-decls -Wcast-align -Wpointer-arith -Wimplicit -Wreturn-type -Wunused-label -Wunused-variable -Wunused-value -Wcomment -Wformat -Wunused-function -Wuninitialized -Wparentheses -Wall -Winit-self -Wsequence-point -Wmissing-field-initializers -Wmissing-prototypes"
- else
- CFLAGS="$CFLAGS -O -g3 -Wredundant-decls -Wcast-align -Wmissing-prototypes -Wpointer-arith -Wimplicit -Wreturn-type -Wunused-label -Wunused-variable -Wunused-value -Wcomment -Wformat -Wunused-function -Wuninitialized -Wparentheses -Wall -Winit-self -Wsequence-point -Wmissing-field-initializers -Wmissing-prototypes"
- fi
+ *-*-netbsd*)
+ LIBS="$LIBS -lm"
+ if test "$GCC" = yes ; then
+ SO_LD="$CC"
+ SO_FLAGS="-fPIC $SO_FLAGS"
+ LDSO_FLAGS="-shared"
fi
- fi
-else
- CFLAGS="-O2 -I. $CFLAGS"
-fi
+ ;;
+
+ *-*-mingw*)
+ LIBS="$LIBS -lwinmm -lwsock32"
+ LDFLAGS="$LDFLAGS -mwindows"
+ SO_INSTALL=":"
+ SO_LD=":"
+ ;;
+
+ *-apple-*)
+ SO_LD="$CC"
+ LDSO_FLAGS="-dynamic -bundle -undefined suppress -flat_namespace"
+ ;;
+esac
+
+AC_SUBST(LDSO_FLAGS)
+AC_SUBST(SO_FLAGS)
+AC_SUBST(SO_LD)
-# -ffast-math appears to make exp about twice as fast, but slows down filtering by the same amount -- kinda strange
-# timing tests using -O3 -ffast-math indicate an overall speedup of maybe 4-5% in Snd, 1951 -> 1936 in s7test
-#
-# I also tried -ftree-vectorize but didn't see any big improvement
#--------------------------------------------------------------------------------
# export-dynamic
#--------------------------------------------------------------------------------
+CFLAGS="-O2 -I. $CFLAGS"
ORIGINAL_LDFLAGS="$LDFLAGS"
-if test "$with_snd_as_widget" != yes ; then
- if test "$ac_cv_header_dlfcn_h" = yes ; then
- if test "$with_gnu_ld" = yes ; then
+case "$host" in
+ *-*-linux* | *-*-bsdi* | *-*-freebsd* | *-*-openbsd* | *-*-netbsd*)
+ if test "$CC" = "gcc" || test "$CC" = "g++" || test "$CC" = "cc" ; then
LDFLAGS="$LDFLAGS -Wl,-export-dynamic"
- # I think this really should be CFLAGS since it's assuming it's passed to gcc, not ld, but
- # that ends up generating endless dumb warnings in gcc
fi
- fi
-fi
+esac
+
#--------------------------------------------------------------------------------
-# error checks, output
+# disable-deprecated
#--------------------------------------------------------------------------------
-if test "$ac_snd_have_extension_language" = yes ; then
- if test "$ac_snd_have_gui" = yes ; then
- if test "$ac_cv_header_pthread_h" = yes ; then
- LDFLAGS="$LDFLAGS -lpthread"
- fi
- fi
+if test "$enable_deprecated" = no ; then
+ CFLAGS="-DGTK_DISABLE_DEPRECATED -DG_DISABLE_DEPRECATED -DGDK_DISABLE_DEPRECATED -DPANGO_DISABLE_DEPRECATED -DCAIRO_DISABLE_DEPRECATED -DGSL_DISABLE_DEPRECATED -Wall $CFLAGS"
+ AC_DEFINE(DISABLE_DEPRECATED)
fi
-if test "$ac_snd_have_extension_language" = no ; then
- if test "$ac_snd_have_gui" = no ; then
- if test "$ac_cv_header_dlfcn_h" = yes ; then
- LDFLAGS="$LDFLAGS -ldl"
- fi
- AC_MSG_WARN([Snd needs either an extension language (s7, Fth, or Ruby), or a graphics toolkit (Gtk or Motif), or preferably both. As currently configured, this version of Snd is useless.])
- fi
-fi
-if test "$ac_snd_have_extension_language" = yes && test "$with_audio" = no && test "$ac_snd_have_gui" = no && test "$ac_cv_header_dlfcn_h" = yes ; then
- LDFLAGS="$LDFLAGS -ldl"
-fi
+#--------------------------------------------------------------------------------
+# output
+#--------------------------------------------------------------------------------
+AC_SUBST(INSTALL)
AC_SUBST(CFLAGS)
AC_SUBST(ORIGINAL_LDFLAGS)
AC_SUBST(LDFLAGS)
AC_SUBST(MAKE_TARGET)
AC_OUTPUT
-# borrowed from gnucash
-
AC_MSG_RESULT([
Options selected
-------------------------
Snd version ...........: $VERSION
CFLAGS ................: $CFLAGS
LDFLAGS ...............:$LDFLAGS
+ LIBS...................: $LIBS
prefix.................: ${prefix}
extension language.....: $LOCAL_LANGUAGE
audio system...........: $AUDIO_SYSTEM
diff --git a/dlocsig.rb b/dlocsig.rb
index aea5436..c5d9dbc 100644
--- a/dlocsig.rb
+++ b/dlocsig.rb
@@ -1,7 +1,7 @@
# dlocsig.rb -- CLM -> Snd/Ruby translation of dlocsig.lisp
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Copyright (c) 2003--2011 Michael Scholz <mi-scholz at users.sourceforge.net>
+# Copyright (c) 2003-2012 Michael Scholz <mi-scholz at users.sourceforge.net>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -317,8 +317,9 @@ class Sndplot
set_sound_property(:dlocsig_created, false, @snd)
select_sound(@snd)
else
- @snd = new_sound(snd_tempnam, default_output_header_type, default_output_data_format,
- default_output_srate, @chns)
+ @snd = new_sound(snd_tempnam, @chns, default_output_srate,
+ default_output_sample_type,
+ default_output_header_type)
set_sound_property(:dlocsig_created, true, @snd)
end
channels(@snd).times do |chn|
@@ -825,7 +826,7 @@ module DL
end
else
out = vct_multiply!(vct_copy(out_data),
- vct_map!(make_vct(len), lambda do | | env(@output_gains[chn]) end))
+ Vct.new(len) do |x| env(@output_gains[chn]) end)
mix_vct(out, @run_beg, @rbm_output, chn, false)
end
end
@@ -836,7 +837,7 @@ module DL
end
else
out = vct_multiply!(vct_copy(out_data),
- vct_map!(make_vct(len), lambda do | | env(@reverb_gains[chn]) end))
+ Vct.new(len) do |x| env(@reverb_gains[chn]) end)
mix_vct(out, @run_beg, @rbm_reverb, chn, false)
end
end
diff --git a/dlocsig.scm b/dlocsig.scm
index 911e3bf..84418aa 100644
--- a/dlocsig.scm
+++ b/dlocsig.scm
@@ -23,6 +23,8 @@
;;; http://www.york.ac.uk/inst/mustech/3d_audio/ambison.htm for more details...
;;; CHANGES:
+;;; 01/28/2012: third order ambisonics support (Nando).
+;;; 04/18/2011: various small changes from lint.scm.
;;; 04/26/2010: add delay hack to remove artifacts in delay output, fix other bugs (Nando)
;;; added proper doppler src conversion thanks to Bill's code in dsp.scm
;;; merged in code for higher order ambisonics (up to 2nd order h/v)
@@ -83,41 +85,39 @@
(provide 'snd-dlocsig.scm)
-
-(define* (envelope-interp x env base) ;env is list of x y breakpoint pairs, interpolate at x returning y
- "(envelope-interp x env (base 1.0)) -> value of env at x; base controls connecting segment
-type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
- (cond ((null? env) 0.0) ;no data -- return 0.0
- ((or (<= x (car env)) ;we're sitting on x val (or if < we blew it)
- (null? (cddr env))) ;or we're at the end of the list
- (cadr env)) ;so return current y value
- ((> (caddr env) x) ;x <= next env x axis value
- (if (or (= (cadr env) (cadddr env))
+#|
+(define* (envelope-interp x e base) ;e is list of x y breakpoint pairs, interpolate at x returning y
+ ;; "(envelope-interp x e (base 1.0)) -> value of e at x; base controls connecting segment type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
+ (cond ((null? e) 0.0) ;no data -- return 0.0
+ ((or (<= x (car e)) ;we're sitting on x val (or if < we blew it)
+ (null? (cddr e))) ;or we're at the end of the list
+ (cadr e)) ;so return current y value
+ ((> (caddr e) x) ;x <= next env x axis value
+ (if (or (= (cadr e) (cadddr e))
(and base (= base 0.0)))
- (cadr env) ;y1=y0, so just return y0 (avoid endless calculations below)
+ (cadr e) ;y1=y0, so just return y0 (avoid endless calculations below)
(if (or (not base) (= base 1.0))
- (+ (cadr env) ;y0+(x-x0)*(y1-y0)/(x1-x0)
- (* (- x (car env))
- (/ (- (cadddr env) (cadr env))
- (- (caddr env) (car env)))))
- (+ (cadr env) ; this does not exactly match xramp-channel
- (* (/ (- (cadddr env) (cadr env))
+ (+ (cadr e) ;y0+(x-x0)*(y1-y0)/(x1-x0)
+ (* (- x (car e))
+ (/ (- (cadddr e) (cadr e))
+ (- (caddr e) (car e)))))
+ (+ (cadr e) ; this does not exactly match xramp-channel
+ (* (/ (- (cadddr e) (cadr e))
(- base 1.0))
- (- (expt base (/ (- x (car env))
- (- (caddr env) (car env))))
+ (- (expt base (/ (- x (car e))
+ (- (caddr e) (car e))))
1.0))))))
- (else (envelope-interp x (cddr env) base)))) ;go on looking for x segment
+ (else (envelope-interp x (cddr e) base)))) ;go on looking for x segment
+|#
-(define (x-norm env xmax)
- "(x-norm env xmax) changes 'env' x axis values so that they run to 'xmax'"
- (let ((scl (/ xmax (list-ref env (- (length env) 2))))
- (val '())
- (len (length env)))
- (do ((i 0 (+ i 2)))
- ((>= i len))
- (set! val (cons (* (list-ref env i) scl) val))
- (set! val (cons (list-ref env (+ i 1)) val)))
- (reverse val)))
+(define x-norm
+ (let ((documentation "(x-norm e xmax) changes 'e' x axis values so that they run to 'xmax'"))
+ (lambda (e xmax)
+ (define (x-norm-1 e scl new-e)
+ (if (null? e)
+ (reverse! new-e)
+ (x-norm-1 (cddr e) scl (cons (cadr e) (cons (* scl (car e)) new-e)))))
+ (x-norm-1 e (/ xmax (e (- (length e) 2))) ()))))
@@ -127,35 +127,38 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; Define the base in which all angles are expressed
(define dlocsig-one-turn 360)
-(define (one-turn-is unit)
- "(one-turn-is unit) sets dlocsig's angle unit (degrees=360, the default or radians=2*pi)"
- (set! dlocsig-one-turn unit)
- unit)
+(define one-turn-is
+ (let ((documentation "(one-turn-is unit) sets dlocsig's angle unit (degrees=360, the default or radians=2*pi)"))
+ (lambda (unit)
+ (set! dlocsig-one-turn unit))))
-(define (angles-in-degree)
- "(angles-in-degree) sets dlocsig's unit to degrees (the default)"
- (one-turn-is 360))
+(define angles-in-degree
+ (let ((documentation "(angles-in-degree) sets dlocsig's unit to degrees (the default)"))
+ (lambda ()
+ (one-turn-is 360))))
-(define (angles-in-radians)
- "(angles-in-radians) sets dlocsig's unit to radians (default is degrees)"
- (one-turn-is (* 2 pi)))
+(define angles-in-radians
+ (let ((documentation "(angles-in-radians) sets dlocsig's unit to radians (default is degrees)"))
+ (lambda ()
+ (one-turn-is (* 2 pi)))))
-(define (angles-in-turns)
- "(angles-in-turns) sets dlocsig's angle unit to turns"
- (one-turn-is 1))
+(define angles-in-turns
+ (let ((documentation "(angles-in-turns) sets dlocsig's angle unit to turns"))
+ (lambda ()
+ (one-turn-is 1))))
;; speed of sound in air, in meters per second under normal conditions
(define dlocsig-speed-of-sound 344)
-(define (distances-in-meters)
- "(distances-in-meters) sets dlocsig's distances in meters (the default)"
- (set! dlocsig-speed-of-sound 344)
- 344)
+(define distances-in-meters
+ (let ((documentation "(distances-in-meters) sets dlocsig's distances in meters (the default)"))
+ (lambda ()
+ (set! dlocsig-speed-of-sound 344))))
-(define (distances-in-feet)
- "(distances-in-feet) sets dlocsig's distances in feet (default is meters)"
- (set! dlocsig-speed-of-sound 1128)
- 1128)
+(define distances-in-feet
+ (let ((documentation "(distances-in-feet) sets dlocsig's distances in feet (default is meters)"))
+ (lambda ()
+ (set! dlocsig-speed-of-sound 1128))))
;; default for whether to use two or three-dimensional speaker configurations
(define dlocsig-3d #f)
@@ -166,22 +169,22 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(define* (make-group (id 0) (size 0) vertices speakers matrix)
(list 'group id size vertices speakers matrix))
-(define group-id (make-procedure-with-setter (lambda (a) (list-ref a 1)) (lambda (a b) (list-set! a 1 b))))
-(define group-size (make-procedure-with-setter (lambda (a) (list-ref a 2)) (lambda (a b) (list-set! a 2 b))))
-(define group-vertices (make-procedure-with-setter (lambda (a) (list-ref a 3)) (lambda (a b) (list-set! a 3 b))))
-(define group-speakers (make-procedure-with-setter (lambda (a) (list-ref a 4)) (lambda (a b) (list-set! a 4 b))))
-(define group-matrix (make-procedure-with-setter (lambda (a) (list-ref a 5)) (lambda (a b) (list-set! a 5 b))))
+(define group-id (dilambda (lambda (a) (a 1)) (lambda (a b) (set! (a 1) b))))
+(define group-size (dilambda (lambda (a) (a 2)) (lambda (a b) (set! (a 2) b))))
+(define group-vertices (dilambda (lambda (a) (a 3)) (lambda (a b) (set! (a 3) b))))
+(define group-speakers (dilambda (lambda (a) (a 4)) (lambda (a b) (set! (a 4) b))))
+(define group-matrix (dilambda (lambda (a) (a 5)) (lambda (a b) (set! (a 5) b))))
(define* (make-speaker-config number dimension coords groups delays omap)
(list 'speaker-config number dimension coords groups delays omap))
-(define speaker-config-number (make-procedure-with-setter (lambda (a) (list-ref a 1)) (lambda (a b) (list-set! a 1 b))))
-(define speaker-config-dimension (make-procedure-with-setter (lambda (a) (list-ref a 2)) (lambda (a b) (list-set! a 2 b))))
-(define speaker-config-coords (make-procedure-with-setter (lambda (a) (list-ref a 3)) (lambda (a b) (list-set! a 3 b))))
-(define speaker-config-groups (make-procedure-with-setter (lambda (a) (list-ref a 4)) (lambda (a b) (list-set! a 4 b))))
-(define speaker-config-delays (make-procedure-with-setter (lambda (a) (list-ref a 5)) (lambda (a b) (list-set! a 5 b))))
-(define speaker-config-map (make-procedure-with-setter (lambda (a) (list-ref a 6)) (lambda (a b) (list-set! a 6 b))))
+(define speaker-config-number (dilambda (lambda (a) (a 1)) (lambda (a b) (set! (a 1) b))))
+(define speaker-config-dimension (dilambda (lambda (a) (a 2)) (lambda (a b) (set! (a 2) b))))
+(define speaker-config-coords (dilambda (lambda (a) (a 3)) (lambda (a b) (set! (a 3) b))))
+(define speaker-config-groups (dilambda (lambda (a) (a 4)) (lambda (a b) (set! (a 4) b))))
+(define speaker-config-delays (dilambda (lambda (a) (a 5)) (lambda (a b) (set! (a 5) b))))
+(define speaker-config-map (dilambda (lambda (a) (a 6)) (lambda (a b) (set! (a 6) b))))
;;; Create a speaker configuration structure based on a list of speakers
@@ -193,175 +196,174 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; omap: mapping of speakers to output channels
;;; content should be output channel number, zero based
-(define (cis a)
- "(cis a) returns e^(ia)"
- (exp (* 0.0+1.0i a)))
-
-(defmacro when (test . forms)
- `(if ,test (begin , at forms)))
-
-(define (third a)
- "(third lst) returns the 3rd element of 'lst'"
- (if (>= (length a) 3) (list-ref a 2) #f))
-
-(define (fourth a)
- "(fourth lst) returns the 4th element of 'lst'"
- (if (>= (length a) 4) (list-ref a 3) #f))
-
-(define* (last a n)
- "(last lst) returns the last 'n' elements of 'lst' as a list"
- (if (null? a)
- #f
- (if (not n)
- (list (list-ref a (- (length a) 1)))
- (let ((res '()))
- (do ((i 0 (+ 1 i)))
- ((= i n))
- (set! res (cons (list-ref a (- (length a) (+ i 1))) res)))
- res))))
-
-(define (listp a)
- "(listp lst) is #t is 'lst' is a non-null list"
- (and (list? a) (not (null? a))))
+(define cis
+ (let ((documentation "(cis a) returns e^(ia)"))
+ (lambda (a)
+ (exp (* 0.0+1.0i a)))))
+
+;; built-in 1-Feb-14
+;; (define-macro (when test . forms) `(if ,test (begin , at forms)))
+
+(define third
+ (let ((documentation "(third lst) returns the 3rd element of 'lst'"))
+ (lambda (a)
+ (and (>= (length a) 3) (a 2)))))
+
+(define fourth
+ (let ((documentation "(fourth lst) returns the 4th element of 'lst'"))
+ (lambda (a)
+ (and (>= (length a) 4) (a 3)))))
+
+(define last
+ (let ((documentation "(last lst n) returns the last 'n' elements of 'lst' as a list"))
+ (lambda* (a n)
+ (and (not (null? a))
+ (if (not n)
+ (list (a (- (length a) 1)))
+ (let ((res ()))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (set! res (cons (a (- (length a) (+ i 1))) res)))
+ res))))))
+
+(define listp pair?)
(define (make-list-1 n val)
- (let ((lst '()))
+ (let ((lst ()))
(do ((i 0 (+ i 1)))
((= i n))
(set! lst (cons val lst)))
lst))
-(define* (arrange-speakers (speakers '())
- (groups '())
- (delays '())
- (distances '())
- (channel-map '()))
+(define* (arrange-speakers (speakers ())
+ (groups ())
+ (delays ())
+ (distances ())
+ (channel-map ()))
;; sanity checking of configuration
-
+
(define (has-duplicates? lst)
;; from ice-9/common-list.scm
(cond ((null? lst) #f)
((member (car lst) (cdr lst)) #t)
(else (has-duplicates? (cdr lst)))))
-
+
(define (invert3x3 mat) ; invert a 3x3 matrix using cofactors
- (let ((m (make-mixer 3))
- (det 0.0)
- (invdet 0.0))
- (do ((i 0 (+ 1 i)))
+ (let ((m (make-float-vector (list 3 3) 0.0))
+ (det 0.0)
+ (invdet 0.0))
+ (do ((i 0 (+ i 1)))
((= i 3))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((= j 3))
- (set! (mixer-ref m i j) (mixer-ref mat i j))))
- (set! (mixer-ref mat 0 0) (- (* (mixer-ref m 1 1) (mixer-ref m 2 2)) (* (mixer-ref m 1 2) (mixer-ref m 2 1))))
- (set! (mixer-ref mat 0 1) (- (* (mixer-ref m 0 2) (mixer-ref m 2 1)) (* (mixer-ref m 0 1) (mixer-ref m 2 2))))
- (set! (mixer-ref mat 0 2) (- (* (mixer-ref m 0 1) (mixer-ref m 1 2)) (* (mixer-ref m 0 2) (mixer-ref m 1 1))))
- (set! (mixer-ref mat 1 0) (- (* (mixer-ref m 1 2) (mixer-ref m 2 0)) (* (mixer-ref m 1 0) (mixer-ref m 2 2))))
- (set! (mixer-ref mat 1 1) (- (* (mixer-ref m 0 0) (mixer-ref m 2 2)) (* (mixer-ref m 0 2) (mixer-ref m 2 0))))
- (set! (mixer-ref mat 1 2) (- (* (mixer-ref m 0 2) (mixer-ref m 1 0)) (* (mixer-ref m 0 0) (mixer-ref m 1 2))))
- (set! (mixer-ref mat 2 0) (- (* (mixer-ref m 1 0) (mixer-ref m 2 1)) (* (mixer-ref m 1 1) (mixer-ref m 2 0))))
- (set! (mixer-ref mat 2 1) (- (* (mixer-ref m 0 1) (mixer-ref m 2 0)) (* (mixer-ref m 0 0) (mixer-ref m 2 1))))
- (set! (mixer-ref mat 2 2) (- (* (mixer-ref m 0 0) (mixer-ref m 1 1)) (* (mixer-ref m 0 1) (mixer-ref m 1 0))))
- (set! det (+ (* (mixer-ref m 0 0) (mixer-ref mat 0 0))
- (* (mixer-ref m 0 1) (mixer-ref mat 1 0))
- (* (mixer-ref m 0 2) (mixer-ref mat 2 0))))
+ (set! (m i j) (mat i j))))
+ (set! (mat 0 0) (- (* (m 1 1) (m 2 2)) (* (m 1 2) (m 2 1))))
+ (set! (mat 0 1) (- (* (m 0 2) (m 2 1)) (* (m 0 1) (m 2 2))))
+ (set! (mat 0 2) (- (* (m 0 1) (m 1 2)) (* (m 0 2) (m 1 1))))
+ (set! (mat 1 0) (- (* (m 1 2) (m 2 0)) (* (m 1 0) (m 2 2))))
+ (set! (mat 1 1) (- (* (m 0 0) (m 2 2)) (* (m 0 2) (m 2 0))))
+ (set! (mat 1 2) (- (* (m 0 2) (m 1 0)) (* (m 0 0) (m 1 2))))
+ (set! (mat 2 0) (- (* (m 1 0) (m 2 1)) (* (m 1 1) (m 2 0))))
+ (set! (mat 2 1) (- (* (m 0 1) (m 2 0)) (* (m 0 0) (m 2 1))))
+ (set! (mat 2 2) (- (* (m 0 0) (m 1 1)) (* (m 0 1) (m 1 0))))
+ (set! det (+ (* (m 0 0) (mat 0 0))
+ (* (m 0 1) (mat 1 0))
+ (* (m 0 2) (mat 2 0))))
(if (<= (abs det) 1e-06)
#f
- (begin
- (set! invdet (/ 1.0 det))
- (do ((row 0 (+ 1 row)))
- ((= row 3))
- (do ((col 0 (+ 1 col)))
- ((= col 3))
- (set! (mixer-ref mat row col) (* (mixer-ref mat row col) invdet))))
- mat))))
-
+ (begin
+ (set! invdet (/ 1.0 det))
+ (do ((row 0 (+ 1 row)))
+ ((= row 3))
+ (do ((col 0 (+ 1 col)))
+ ((= col 3))
+ (set! (mat row col) (* (mat row col) invdet))))
+ mat))))
+
(define (invert2x2 mat) ; invert a 2x2 matrix
- (let* ((m (make-mixer 2))
- (det (- (* (mixer-ref mat 0 0) (mixer-ref mat 1 1))
- (* (mixer-ref mat 1 0) (mixer-ref mat 0 1)))))
+ (let ((m (make-float-vector (list 2 2) 0.0))
+ (det (- (* (mat 0 0) (mat 1 1))
+ (* (mat 1 0) (mat 0 1)))))
(if (<= (abs det) 1e-06)
#f
- (begin
- (set! (mixer-ref m 0 0) (/ (mixer-ref mat 1 1) det))
- (set! (mixer-ref m 1 1) (/ (mixer-ref mat 0 0) det))
- (set! (mixer-ref m 0 1) (- (/ (mixer-ref mat 0 1) det)))
- (set! (mixer-ref m 1 0) (- (/ (mixer-ref mat 1 0) det)))
- m))))
-
+ (begin
+ (set! (m 0 0) (/ (mat 1 1) det))
+ (set! (m 1 1) (/ (mat 0 0) det))
+ (set! (m 0 1) (- (/ (mat 0 1) det)))
+ (set! (m 1 0) (- (/ (mat 1 0) det)))
+ m))))
+
(if (null? speakers)
(error 'mus-error "ERROR: a speaker configuration must have at least one speaker!~%"))
-
- (if (not (null? groups))
+
+ (if (pair? groups)
(let ((first-len (length (car groups))))
(for-each
(lambda (group)
(if (not (= (length group) first-len))
(error 'mus-error "ERROR: all groups must be of the same length! (~A)~%" first-len)))
groups))
-
- ;; if the speakers are defined with only azimuth angles (no elevation)
- (if (not (list? (car speakers)))
- ;; then create the groups ourselves because it is a 2d configuration;
- ;; we could create the 3d configuration groups but the algorithm for
- ;; doing that in the generic case is not trivial
-
- (let ((len (length speakers)))
- (if (= len 1)
- (set! groups (list (list 0)))
- (begin
- (do ((i 0 (+ 1 i))
- (j 1 (+ 1 j)))
- ((= i len))
- (set! groups (cons (list i (modulo j len)) groups)))
- (set! groups (reverse groups)))))))
-
+
+ ;; if the speakers are defined with only azimuth angles (no elevation)
+ (if (not (pair? (car speakers)))
+ ;; then create the groups ourselves because it is a 2d configuration;
+ ;; we could create the 3d configuration groups but the algorithm for
+ ;; doing that in the generic case is not trivial
+
+ (let ((len (length speakers)))
+ (if (= len 1)
+ (set! groups (list (list 0)))
+ (begin
+ (do ((i 0 (+ i 1))
+ (j 1 (+ j 1)))
+ ((= i len))
+ (set! groups (cons (list i (modulo j len)) groups)))
+ (set! groups (reverse groups)))))))
+
(if (null? groups)
(error 'mus-error "ERROR: no groups specified, speakers must be arranged in groups~%"))
-
- (if (and (not (null? delays))
- (not (null? distances)))
+
+ (if (and (pair? delays)
+ (pair? distances))
(error 'mus-error "ERROR: please specify delays or distances but not both~%"))
-
- (if (not (null? delays))
+
+ (if (pair? delays)
(if (> (length speakers) (length delays))
(error 'mus-error "ERROR: all speaker delays have to be specified, only ~A supplied [~A]~%" (length delays) delays)
- (if (< (length speakers) (length delays))
- (error 'mus-error "ERROR: more speaker delays than speakers, ~A supplied instead of ~A [~A]~%" (length delays) (length speakers) delays))))
-
- (if (not (null? delays))
- (for-each
- (lambda (delay)
- (if (< delay 0.0) (error 'mus-error "ERROR: delays must be all positive, ~A is negative~%" delay)))
- delays))
-
- (if (not (null? distances))
+ (if (< (length speakers) (length delays))
+ (error 'mus-error "ERROR: more speaker delays than speakers, ~A supplied instead of ~A [~A]~%" (length delays) (length speakers) delays))))
+
+ (for-each
+ (lambda (dly)
+ (if (< dly 0.0) (error 'mus-error "ERROR: delays must be all positive, ~A is negative~%" dly)))
+ delays)
+
+ (if (pair? distances)
(if (> (length speakers) (length distances))
(error 'mus-error "ERROR: all speaker distances have to be specified, only ~A supplied [~A]~%" (length distances) distances)
- (if (< (length speakers) (length distances))
- (error 'mus-error "ERROR: more speaker distances than speakers, ~A supplied instead of ~A [~A]~%" (length distances) (length speakers) distances))))
-
- (if (not (null? distances))
- (for-each
- (lambda (delay)
- (if (< delay 0.0) (error 'mus-error "ERROR: distances must be all positive, ~A is negative~%" delay)))
- distances))
-
- (if (not (null? channel-map))
+ (if (< (length speakers) (length distances))
+ (error 'mus-error "ERROR: more speaker distances than speakers, ~A supplied instead of ~A [~A]~%" (length distances) (length speakers) distances))))
+
+ (for-each
+ (lambda (dly)
+ (if (< dly 0.0) (error 'mus-error "ERROR: distances must be all positive, ~A is negative~%" dly)))
+ distances)
+
+ (if (pair? channel-map)
(if (> (length speakers) (length channel-map))
(error 'mus-error "ERROR: must map all speakers to output channels, only ~A mapped [~A]~%" (length channel-map) channel-map)
- (if (< (length speakers) (length channel-map))
- (error 'mus-error "ERROR: trying to map more channels than there are speakers, ~A supplied instead of ~A [~A]~%"
- (length channel-map) (length speakers) channel-map))))
-
+ (if (< (length speakers) (length channel-map))
+ (error 'mus-error "ERROR: trying to map more channels than there are speakers, ~A supplied instead of ~A [~A]~%"
+ (length channel-map) (length speakers) channel-map))))
+
;; collect unit vectors describing the speaker positions
(let* ((coords
- (let ((val '()))
+ (let ((val ()))
(for-each
(lambda (s) ; speakers
- (let* ((a (if (list? s) (car s) s))
- (e (if (list? s) (or (cadr s) 0.0) 0.0))
+ (let* ((a (if (pair? s) (car s) s))
+ (e (if (pair? s) (or (cadr s) 0.0) 0.0))
(evec (cis (* (/ e dlocsig-one-turn) 2 pi)))
(dxy (real-part evec))
(avec (cis (* (/ a dlocsig-one-turn) 2 pi)))
@@ -372,66 +374,64 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! val (cons (list (/ x mag) (/ y mag) (/ z mag)) val))))
speakers)
(reverse val)))
-
- ;; minimum distance
- (min-dist (if (not (null? distances))
- (let ((mind (car distances)))
- (for-each
- (lambda (d)
- (if (< d mind) (set! mind d)))
- distances)
- mind)
+
+ ;; minimum distance
+ (min-dist (if (pair? distances)
+ (let ((mind (car distances)))
+ (for-each
+ (lambda (d)
+ (if (< d mind) (set! mind d)))
+ distances)
+ mind)
0.0))
-
- ;; find delay times from specified distances or delays
- (times (let ((v (make-vct (length speakers))))
- (do ((i 0 (+ 1 i)))
- ((= i (length speakers)))
- (vct-set! v i (let ((distance (and (not (null? distances)) (list-ref distances i)))
- (delay (and (not (null? delays)) (list-ref delays i))))
- (or delay
- (and distance
- (/ (- distance min-dist) dlocsig-speed-of-sound))
- 0.0))))
- v))
-
- ;; create the group structures
- (groups (let* ((vals '())
- (id 0))
- (for-each
- (lambda (group)
- (let* ((size (length group))
- (vertices (map (lambda (n)
- (list-ref coords n))
- group))
- (matrix (if (= size 3)
- (let* ((m (make-mixer 3)))
- (do ((i 0 (+ 1 i)))
- ((= i 3))
- (do ((j 0 (+ 1 j)))
- ((= j 3))
- (mixer-set! m i j (list-ref (list-ref vertices i) j))))
- (invert3x3 m))
+
+ ;; find delay times from specified distances or delays
+ (times (let ((v (make-float-vector (length speakers))))
+ (do ((i 0 (+ i 1)))
+ ((= i (length speakers)))
+ (set! (v i) (let ((distance (and (pair? distances) (distances i)))
+ (dly (and (pair? delays) (delays i))))
+ (or dly
+ (and distance
+ (/ (- distance min-dist) dlocsig-speed-of-sound))
+ 0.0))))
+ v))
+
+ ;; create the group structures
+ (groups (let ((vals ())
+ (id 0))
+ (for-each
+ (lambda (group)
+ (let* ((size (length group))
+ (vertices (map coords group))
+ (matrix (if (= size 3)
+ (let ((m (make-float-vector (list 3 3) 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! (m i j) ((vertices i) j))))
+ (invert3x3 m))
(if (= size 2)
- (let* ((m (make-mixer 2)))
- (do ((i 0 (+ 1 i)))
+ (let ((m (make-float-vector (list 2 2) 0.0)))
+ (do ((i 0 (+ i 1)))
((= i 2))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((= j 2))
- (mixer-set! m i j (list-ref (list-ref vertices i) j))))
+ (set! (m i j) ((vertices i) j))))
(invert2x2 m))
- #f))))
- (set! vals (cons (make-group :id id
- :size size
- :speakers group
- :vertices vertices
- :matrix matrix)
- vals))
- (set! id (+ 1 id))))
- groups)
- (reverse vals))))
+ #f))))
+ (set! vals (cons (make-group :id id
+ :size size
+ :speakers group
+ :vertices vertices
+ :matrix matrix)
+ vals))
+ (set! id (+ 1 id))))
+ groups)
+ (reverse vals))))
- ;; check validity of map entries
+ ;; check validity of map entries
(if channel-map
(let ((entries (length channel-map)))
(for-each
@@ -441,9 +441,9 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
channel-map)
(if (has-duplicates? channel-map)
(error 'mus-error "ERROR: there are duplicate channels in channel-map ~A~%" channel-map))))
-
+
;; create the speaker configuration structure
-
+
(make-speaker-config :number (length speakers)
:dimension (group-size (car groups))
:coords coords
@@ -452,8 +452,8 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
:omap (let ((v (make-vector (length speakers))))
(do ((chan 0 (+ 1 chan)))
((= chan (length speakers)))
- (vector-set! v chan (or (and (not (null? channel-map)) (list-ref channel-map chan))
- chan)))
+ (set! (v chan) (or (and (pair? channel-map) (channel-map chan))
+ chan)))
v))))
;;; Default speaker configurations
@@ -531,25 +531,27 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; Set a particular speaker configuration
-(define* (set-speaker-configuration config (configs dlocsig-speaker-configs))
- "(set-speaker-configuration config (configs dlocsig-speaker-configs)) sets a dlocsig speaker configuration"
- (let ((lst (if (< (speaker-config-dimension config) 3)
- (car configs)
- (cadr configs)))
- (num (speaker-config-number config)))
- (list-set! lst num config)))
+(define set-speaker-configuration
+ (let ((documentation "(set-speaker-configuration config (configs dlocsig-speaker-configs)) sets a dlocsig speaker configuration"))
+ (lambda* (config (configs dlocsig-speaker-configs))
+ (let ((lst (if (< (speaker-config-dimension config) 3)
+ (car configs)
+ (cadr configs)))
+ (num (speaker-config-number config)))
+ (set! (lst num) config)))))
;;; Get the speaker configuration for a given number of output channels
-(define* (get-speaker-configuration channels (3d dlocsig-3d) (configs dlocsig-speaker-configs))
- "(get-speaker-configuration channels (3d dlocsig-3d) (configs dlocsig-speaker-configs)) returns a dlocsig speaker configuration"
- (let* ((config (if 3d (list-ref (cadr configs) channels) (list-ref (car configs) channels))))
- (if (null? config)
- (error 'mus-error "ERROR: no speaker configuration exists for ~A ~A output channel~A~%~%"
- (if 3d "tridimensional" "bidimensional")
- channels (if (= channels 1) "s" "")))
- config))
+(define get-speaker-configuration
+ (let ((documentation "(get-speaker-configuration channels (3d dlocsig-3d) (configs dlocsig-speaker-configs)) returns a dlocsig speaker configuration"))
+ (lambda* (channels (3d dlocsig-3d) (configs dlocsig-speaker-configs))
+ (let ((config (if 3d ((cadr configs) channels) ((car configs) channels))))
+ (if (null? config)
+ (error 'mus-error "ERROR: no speaker configuration exists for ~A ~A output channel~A~%~%"
+ (if 3d "tridimensional" "bidimensional")
+ channels (if (= channels 1) "s" "")))
+ config))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -558,7 +560,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; global dlocsig parameters
-(define dlocsig-path '())
+(define dlocsig-path ())
(define dlocsig-scaler 1.0)
(define dlocsig-direct-power 1.5)
(define dlocsig-inside-direct-power 1.5)
@@ -575,12 +577,12 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(define amplitude-panning 1)
(define ambisonics 2)
(define decoded-ambisonics 3)
-;(define stereo-hrtf 4)
+ ;(define stereo-hrtf 4)
-; for backwards compatibility
+ ; for backwards compatibility
(define b-format-ambisonics ambisonics)
-; a reasonable default
+ ; a reasonable default
(define dlocsig-render-using amplitude-panning)
@@ -595,12 +597,17 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(define point707 (cos (/ (* pi 2) 8.0)))
(define dlocsig-ambisonics-scaler point707)
(define dlocsig-ambisonics-ho-rev-scaler 0.05)
+;; for 3rd order FuMa
+(define ambisonics-k1 (sqrt (/ (* 21 45) 224 8)))
+(define ambisonics-k2 (* (sqrt 3) 3 0.5))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Get number of channels needed by ambisonics
-(define (ambisonics-channels h-order v-order)
- (let* ((count 0))
+(define* (ambisonics-channels
+ (h-order dlocsig-ambisonics-h-order)
+ (v-order dlocsig-ambisonics-v-order))
+ (let ((count 0))
(if (>= h-order 0)
(begin
(if (>= h-order 1)
@@ -615,6 +622,12 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(if (>= h-order 2)
;; U V
(set! count (+ count 2)))
+ (if (>= v-order 3)
+ ;; K L M N O
+ (set! count (+ count 5)))
+ (if (>= h-order 3)
+ ;; P Q
+ (set! count (+ count 2)))
count)
;; error: we need at least horizontal order 1!
0)))
@@ -627,21 +640,20 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; path is a list (type rx ry rz rv rt tx ty tz tt ...)
-(define path-rx (make-procedure-with-setter (lambda (p) (list-ref p 1)) (lambda (p val) (list-set! p 1 val))))
-(define path-ry (make-procedure-with-setter (lambda (p) (list-ref p 2)) (lambda (p val) (list-set! p 2 val))))
-(define path-rz (make-procedure-with-setter (lambda (p) (list-ref p 3)) (lambda (p val) (list-set! p 3 val))))
-(define path-rv (make-procedure-with-setter (lambda (p) (list-ref p 4)) (lambda (p val) (list-set! p 4 val))))
-(define path-rt (make-procedure-with-setter (lambda (p) (list-ref p 5)) (lambda (p val) (list-set! p 5 val))))
-(define path-tx (make-procedure-with-setter (lambda (p) (list-ref p 6)) (lambda (p val) (list-set! p 6 val))))
-(define path-ty (make-procedure-with-setter (lambda (p) (list-ref p 7)) (lambda (p val) (list-set! p 7 val))))
-(define path-tz (make-procedure-with-setter (lambda (p) (list-ref p 8)) (lambda (p val) (list-set! p 8 val))))
-(define path-tt (make-procedure-with-setter (lambda (p) (list-ref p 9)) (lambda (p val) (list-set! p 9 val))))
+(define path-rx (dilambda (lambda (p) (p 1)) (lambda (p val) (set! (p 1) val))))
+(define path-ry (dilambda (lambda (p) (p 2)) (lambda (p val) (set! (p 2) val))))
+(define path-rz (dilambda (lambda (p) (p 3)) (lambda (p val) (set! (p 3) val))))
+(define path-rv (dilambda (lambda (p) (p 4)) (lambda (p val) (set! (p 4) val))))
+(define path-rt (dilambda (lambda (p) (p 5)) (lambda (p val) (set! (p 5) val))))
+(define path-tx (dilambda (lambda (p) (p 6)) (lambda (p val) (set! (p 6) val))))
+(define path-ty (dilambda (lambda (p) (p 7)) (lambda (p val) (set! (p 7) val))))
+(define path-tz (dilambda (lambda (p) (p 8)) (lambda (p val) (set! (p 8) val))))
+(define path-tt (dilambda (lambda (p) (p 9)) (lambda (p val) (set! (p 9) val))))
-;(define (make-path) (list 'path '() '() '() '() '() '() '() '() '()))
+ ;(define (make-path) (list 'path () () () () () () () () ()))
(define (describe path)
- (cond ((or (eq? (car path) 'bezier-path)
- (eq? (car path) 'open-bezier-path))
+ (cond ((memq (car path) '(bezier-path open-bezier-path))
(format #f "<bezier-path>:~% rx: ~A~% ry: ~A~% rz: ~A~% rv: ~A~% rt: ~A~% tx: ~A~% ty: ~A~% tz: ~A~% tt: ~A~% ~
x: ~A~% y: ~A~% z: ~A~% v: ~A~% bx: ~A~% by: ~A~% bz: ~A~% error: ~A~% curvature: ~A~%"
(path-rx path) (path-ry path) (path-rz path) (path-rv path) (path-rt path) (path-tx path) (path-ty path) (path-tz path) (path-tt path)
@@ -662,27 +674,28 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; Reset any transformations on the originally rendered path
(define (reset-transformation path)
- (set! (path-tt path) '())
- (set! (path-tx path) '())
- (set! (path-ty path) '())
- (set! (path-tz path) '())
+ (set! (path-tt path) ())
+ (set! (path-tx path) ())
+ (set! (path-ty path) ())
+ (set! (path-tz path) ())
path)
;;; Reset the rendered path (and any transformations)
(define (reset-rendering path)
- (set! (path-rt path) '())
- (set! (path-rv path) '())
- (set! (path-rx path) '())
- (set! (path-ry path) '())
- (set! (path-rz path) '())
+ (set! (path-rt path) ())
+ (set! (path-rv path) ())
+ (set! (path-rx path) ())
+ (set! (path-ry path) ())
+ (set! (path-rz path) ())
(reset-transformation path))
;;; Return the best possible set of coordinates
-(define (list?? a)
- "list?? returns a if it is a list"
- (and (listp a) a))
+(define list??
+ (let ((documentation "list?? returns a if it is a list"))
+ (lambda (a)
+ (and (listp a) a))))
(define (path-x path)
(or (list?? (path-tx path))
@@ -718,31 +731,31 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; bezier-path is path + path 3d polar x y z v bx by bz error curvature
-(define bezier-path (make-procedure-with-setter (lambda (p) (list-ref p 10)) (lambda (p val) (list-set! p 10 val))))
-(define bezier-3d (make-procedure-with-setter (lambda (p) (list-ref p 11)) (lambda (p val) (list-set! p 11 val))))
-(define bezier-polar (make-procedure-with-setter (lambda (p) (list-ref p 12)) (lambda (p val) (list-set! p 12 val))))
-(define bezier-x (make-procedure-with-setter (lambda (p) (list-ref p 13)) (lambda (p val) (list-set! p 13 val))))
-(define bezier-y (make-procedure-with-setter (lambda (p) (list-ref p 14)) (lambda (p val) (list-set! p 14 val))))
-(define bezier-z (make-procedure-with-setter (lambda (p) (list-ref p 15)) (lambda (p val) (list-set! p 15 val))))
-(define bezier-v (make-procedure-with-setter (lambda (p) (list-ref p 16)) (lambda (p val) (list-set! p 16 val))))
-(define bezier-bx (make-procedure-with-setter (lambda (p) (list-ref p 17)) (lambda (p val) (list-set! p 17 val))))
-(define bezier-by (make-procedure-with-setter (lambda (p) (list-ref p 18)) (lambda (p val) (list-set! p 18 val))))
-(define bezier-bz (make-procedure-with-setter (lambda (p) (list-ref p 19)) (lambda (p val) (list-set! p 19 val))))
-(define bezier-error (make-procedure-with-setter (lambda (p) (list-ref p 20)) (lambda (p val) (list-set! p 20 val))))
-(define bezier-curvature (make-procedure-with-setter (lambda (p) (list-ref p 21)) (lambda (p val) (list-set! p 21 val))))
+(define bezier-path (dilambda (lambda (p) (p 10)) (lambda (p val) (set! (p 10) val))))
+(define bezier-3d (dilambda (lambda (p) (p 11)) (lambda (p val) (set! (p 11) val))))
+(define bezier-polar (dilambda (lambda (p) (p 12)) (lambda (p val) (set! (p 12) val))))
+(define bezier-x (dilambda (lambda (p) (p 13)) (lambda (p val) (set! (p 13) val))))
+(define bezier-y (dilambda (lambda (p) (p 14)) (lambda (p val) (set! (p 14) val))))
+(define bezier-z (dilambda (lambda (p) (p 15)) (lambda (p val) (set! (p 15) val))))
+(define bezier-v (dilambda (lambda (p) (p 16)) (lambda (p val) (set! (p 16) val))))
+(define bezier-bx (dilambda (lambda (p) (p 17)) (lambda (p val) (set! (p 17) val))))
+(define bezier-by (dilambda (lambda (p) (p 18)) (lambda (p val) (set! (p 18) val))))
+(define bezier-bz (dilambda (lambda (p) (p 19)) (lambda (p val) (set! (p 19) val))))
+(define bezier-error (dilambda (lambda (p) (p 20)) (lambda (p val) (set! (p 20) val))))
+(define bezier-curvature (dilambda (lambda (p) (p 21)) (lambda (p val) (set! (p 21) val))))
-(define* (make-bezier-path (path '()) (3d #t) (polar #f) (error 0.01) (curvature #f))
- (list 'bezier-path '() '() '() '() '() '() '() '() '() path 3d polar '() '() '() '() '() '() '() error curvature))
+(define* (make-bezier-path (path ()) (3d #t) polar (error 0.01) curvature)
+ (list 'bezier-path () () () () () () () () () path 3d polar () () () () () () () error curvature))
;;; Path class for open bezier paths
-(define initial-direction (make-procedure-with-setter (lambda (p) (list-ref p 22)) (lambda (p val) (list-set! p 22 val))))
-(define final-direction (make-procedure-with-setter (lambda (p) (list-ref p 23)) (lambda (p val) (list-set! p 23 val))))
+(define initial-direction (dilambda (lambda (p) (p 22)) (lambda (p val) (set! (p 22) val))))
+(define final-direction (dilambda (lambda (p) (p 23)) (lambda (p val) (set! (p 23) val))))
-(define* (make-open-bezier-path (path '()) (3d #t) (polar #f) (error 0.01) (curvature #f)
- (initial-direction '(0.0 0.0 0.0)) (final-direction '(0.0 0.0 0.0)))
- (list 'open-bezier-path '() '() '() '() '() '() '() '() '() path 3d polar '() '() '() '() '() '() '() error curvature initial-direction final-direction))
+(define* (make-open-bezier-path (path ()) (3d #t) polar (error 0.01) curvature
+ (initial-direction '(0.0 0.0 0.0)) (final-direction '(0.0 0.0 0.0)))
+ (list 'open-bezier-path () () () () () () () () () path 3d polar () () () () () () () error curvature initial-direction final-direction))
@@ -766,38 +779,38 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(error 'mus-error "ERROR: Can't specify initial direction ~A for a closed path ~A~%" initial-direction path))
(if (and closed final-direction)
(error 'mus-error "ERROR: Can't specify final direction ~A for a closed path ~A~%" final-direction path))
-
+
(if (and closed
- (not (if (list? (car path))
- (let* ((start (car path))
- (end (car (last path))))
+ (not (if (pair? (car path))
+ (let ((start (car path))
+ (end (car (last path))))
(and (= (car start) (car end))
(= (cadr start) (cadr end))
- (if path-3d
- (= (third start) (third end)) #t)))
- (let* ((end (last path (if path-3d 3 2))))
- (and (= (car path) (car end))
- (= (cadr path) (cadr end))
- (if path-3d
- (= (third path) (third end)) #t))))))
+ (or (not path-3d)
+ (= (third start) (third end)))))
+ (let ((end (last path (if path-3d 3 2))))
+ (and (= (car path) (car end))
+ (= (cadr path) (cadr end))
+ (or (not path-3d)
+ (= (third path) (third end))))))))
(error 'mus-error "ERROR: Closed path ~A is not closed~%" path))
-
+
;; create the path structure
(if closed
(make-bezier-path
- :path path
- :3d 3d
- :polar polar
- :curvature curvature
- :error error)
- (make-open-bezier-path
- :path path
- :3d 3d
- :polar polar
- :curvature curvature
- :error error
- :initial-direction initial-direction
- :final-direction final-direction)))
+ :path path
+ :3d 3d
+ :polar polar
+ :curvature curvature
+ :error error)
+ (make-open-bezier-path
+ :path path
+ :3d 3d
+ :polar polar
+ :curvature curvature
+ :error error
+ :initial-direction initial-direction
+ :final-direction final-direction)))
;;; Some convenient abbreviations
@@ -817,14 +830,14 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
:closed closed
:curvature curvature
:error error)
- (make-path :path path
- :3d 3d
- :polar #t
- :closed closed
- :curvature curvature
- :error error
- :initial-direction initial-direction
- :final-direction final-direction)))
+ (make-path :path path
+ :3d 3d
+ :polar #t
+ :closed closed
+ :curvature curvature
+ :error error
+ :initial-direction initial-direction
+ :final-direction final-direction)))
(define* (make-closed-path path
(3d path-3d)
@@ -850,147 +863,149 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; Parse a set of 2d or 3d points into the separate coordinates
-(define (parse-cartesian-coordinates points 3d)
- "(parse-cartesian-coordinates points 3d) parses a set of 2d or 3d points into the separate coordinates"
- (if (list? (car points))
- ;; decode a list of lists into x:y:z:v components
- ;; 3d -> t [default]
- ;; '((x0 y0 z0 v0) (x1 y1 z1 v1)...(xn yn zn vn))
- ;; '((x0 y0 z0) (x1 y1 z1)...(xn yn zn))
- ;; '((x0 y0) (x1 y1)...(xn yn))
- ;; v: relative velocity
- ;; x, y, z: coordinates of source [missing z's assumed 0.0]
- ;; 3d -> nil
- ;; '((x0 y0 v0) (x1 y1 v1)...(xn yn vn))
- ;; '((x0 y0) (x1 y1)...(xn yn))
- ;; v: relative velocity
- ;; x, y, z: coordinates of source [missing z's assumed 0.0]
- (let* ((v '())
- (x '())
- (y '())
- (z '()))
- (for-each
- (lambda (p)
- (set! x (cons (car p) x))
- (set! y (cons (cadr p) y))
- (set! z (cons (if 3d (or (third p) 0.0) 0.0) z))
- (set! v (cons (if 3d
- (fourth p)
- (third p))
- v)))
- points)
- (list (reverse x) (reverse y) (reverse z) (reverse v)))
-
- ;; decode a plain list
- (if 3d
- ;; it's a three dimensional list
- ;; '(x0 y0 z0 x1 y1 z1 ... xn yn zn)
- ;; x, y, z: coordinates of source
- (let ((px '())
- (py '())
- (pz '())
- (len (length points)))
- (do ((i 0 (+ i 3)))
- ((>= i len))
- (set! px (cons (list-ref points i) px))
- (set! py (cons (list-ref points (+ i 1)) py))
- (set! pz (cons (list-ref points (+ i 2)) pz)))
- (list (reverse px) (reverse py) (reverse pz) (make-list-1 (length px) #f)))
-
- ;; it's a two dimensional list
- ;; '(x0 y0 x1 y1 ... xn yn)
- ;; x, y, z: coordinates of source [missing z's assumed 0.0]
- (let ((px '())
- (py '())
- (len (length points)))
- (do ((i 0 (+ i 2)))
- ((>= i len))
- (set! px (cons (list-ref points i) px))
- (set! py (cons (list-ref points (+ i 1)) py)))
- (list (reverse px) (reverse py) (make-list-1 (length px) 0.0) (make-list-1 (length px) #f))))))
+(define parse-cartesian-coordinates
+ (let ((documentation "(parse-cartesian-coordinates points 3d) parses a set of 2d or 3d points into the separate coordinates"))
+ (lambda (points 3d)
+ (if (pair? (car points))
+ ;; decode a list of lists into x:y:z:v components
+ ;; 3d -> t [default]
+ ;; '((x0 y0 z0 v0) (x1 y1 z1 v1)...(xn yn zn vn))
+ ;; '((x0 y0 z0) (x1 y1 z1)...(xn yn zn))
+ ;; '((x0 y0) (x1 y1)...(xn yn))
+ ;; v: relative velocity
+ ;; x, y, z: coordinates of source [missing z's assumed 0.0]
+ ;; 3d -> nil
+ ;; '((x0 y0 v0) (x1 y1 v1)...(xn yn vn))
+ ;; '((x0 y0) (x1 y1)...(xn yn))
+ ;; v: relative velocity
+ ;; x, y, z: coordinates of source [missing z's assumed 0.0]
+ (let ((v ())
+ (x ())
+ (y ())
+ (z ()))
+ (for-each
+ (lambda (p)
+ (set! x (cons (car p) x))
+ (set! y (cons (cadr p) y))
+ (set! z (cons (if 3d (or (third p) 0.0) 0.0) z))
+ (set! v (cons (if 3d
+ (fourth p)
+ (third p))
+ v)))
+ points)
+ (list (reverse x) (reverse y) (reverse z) (reverse v)))
+
+ ;; decode a plain list
+ (if 3d
+ ;; it's a three dimensional list
+ ;; '(x0 y0 z0 x1 y1 z1 ... xn yn zn)
+ ;; x, y, z: coordinates of source
+ (let ((px ())
+ (py ())
+ (pz ())
+ (len (length points)))
+ (do ((i 0 (+ i 3)))
+ ((>= i len))
+ (set! px (cons (points i) px))
+ (set! py (cons (points (+ i 1)) py))
+ (set! pz (cons (points (+ i 2)) pz)))
+ (list (reverse px) (reverse py) (reverse pz) (make-list-1 (length px) #f)))
+
+ ;; it's a two dimensional list
+ ;; '(x0 y0 x1 y1 ... xn yn)
+ ;; x, y, z: coordinates of source [missing z's assumed 0.0]
+ (let ((px ())
+ (py ())
+ (len (length points)))
+ (do ((i 0 (+ i 2)))
+ ((>= i len))
+ (set! px (cons (points i) px))
+ (set! py (cons (points (+ i 1)) py)))
+ (list (reverse px) (reverse py) (make-list-1 (length px) 0.0) (make-list-1 (length px) #f))))))))
;;; Parse a set of 2d or 3d polar points into the separate coordinates
-(define (parse-polar-coordinates points 3d)
- "(parse-polar-coordinates points 3d) parses a polar path"
- (if (list? (car points))
- ;; decode a list of lists of d:a:e:v into x:y:z:v components
- ;; 3d --> t [default]
- ;; '((d0 a0 e0 v0) (d1 a1 e1 v1)...(dn an en vn))
- ;; '((d0 a0 e0) (d1 a1 e1)...(dn an en))
- ;; '((d0 a0) (d1 a1)...(dn an))
- ;; 3d --> nil
- ;; '((d0 a0 v0) (d1 a1 v1)...(dn an vn))
- ;; '((d0 a0) (d1 a1)...(dn an))
- ;; v: velocity
- ;; d: distance
- ;; a: azimut angle
- ;; e: elevarion angle [missing elevations assumed 0.0]
- (let ((x '())
- (y '())
- (z '())
- (v '()))
- (for-each
- (lambda (p)
- (let* ((d (car p))
- (a (cadr p))
- (e (if 3d (if (not (null? (cddr p))) (caddr p) 0.0) 0.0))
- (evec (cis (* (/ e dlocsig-one-turn) 2 pi)))
- (dxy (* d (real-part evec)))
- (avec (cis (* (/ a dlocsig-one-turn) 2 pi))))
- (set! x (cons (* dxy (imag-part avec)) x))
- (set! y (cons (* dxy (real-part avec)) y))
- (set! z (cons (* d (imag-part evec)) z))
- (set! v (cons (if 3d (fourth p) (third p)) v))))
- points)
- (list (reverse x) (reverse y) (reverse z) (reverse v)))
-
- ;; decode a list of d:a:e components
- (if 3d
- ;; decode a three dimensional list
- ;; '(d0 a0 e0 d1 a1 e1 ... dn an en)
- ;; d: distance
- ;; a: azimut angle
- ;; e: elevarion angle [missing elevations assumed 0.0]
- (let ((x '())
- (y '())
- (z '())
- (len (length points)))
- (do ((i 0 (+ i 3)))
- ((>= i len))
- (let* ((d (list-ref points i))
- (a (list-ref points (+ i 1)))
- (e (list-ref points (+ i 2)))
- (evec (cis (* (/ e dlocsig-one-turn) 2 pi)))
- (dxy (* d (real-part evec)))
- (avec (cis (* (/ a dlocsig-one-turn) 2 pi))))
- (set! x (cons (* dxy (imag-part avec)) x))
- (set! y (cons (* dxy (real-part avec)) y))
- (set! z (cons (* d (imag-part evec)) z))))
- (list (reverse x) (reverse y) (reverse z) (make-list-1 (length x) #f)))
-
- ;; decode a two dimensional list
- ;; '(d0 a0 d1 a1 ... dn an)
- ;; d: distance
- ;; a: azimut angle
- ;; e: elevarion angle [missing elevations assumed 0.0]
- (let* ((x '())
- (y '())
- (len (length points)))
- (do ((i 0 (+ i 2)))
- ((>= i len))
- (let* ((d (list-ref points i))
- (a (list-ref points (+ i 1)))
- (avec (cis (* (/ a dlocsig-one-turn) 2 pi))))
- (set! x (cons (* d (imag-part avec)) x))
- (set! y (cons (* d (real-part avec)) y))))
- (list (reverse x) (reverse y) (make-list-1 (length x) 0.0) (make-list-1 (length x) #f))))))
+(define parse-polar-coordinates
+ (let ((documentation "(parse-polar-coordinates points 3d) parses a polar path"))
+ (lambda (points 3d)
+ (if (pair? (car points))
+ ;; decode a list of lists of d:a:e:v into x:y:z:v components
+ ;; 3d --> t [default]
+ ;; '((d0 a0 e0 v0) (d1 a1 e1 v1)...(dn an en vn))
+ ;; '((d0 a0 e0) (d1 a1 e1)...(dn an en))
+ ;; '((d0 a0) (d1 a1)...(dn an))
+ ;; 3d --> nil
+ ;; '((d0 a0 v0) (d1 a1 v1)...(dn an vn))
+ ;; '((d0 a0) (d1 a1)...(dn an))
+ ;; v: velocity
+ ;; d: distance
+ ;; a: azimut angle
+ ;; e: elevarion angle [missing elevations assumed 0.0]
+ (let ((x ())
+ (y ())
+ (z ())
+ (v ()))
+ (for-each
+ (lambda (p)
+ (let* ((d (car p))
+ (a (cadr p))
+ (e (if 3d (if (pair? (cddr p)) (caddr p) 0.0) 0.0))
+ (evec (cis (* (/ e dlocsig-one-turn) 2 pi)))
+ (dxy (* d (real-part evec)))
+ (avec (cis (* (/ a dlocsig-one-turn) 2 pi))))
+ (set! x (cons (* dxy (imag-part avec)) x))
+ (set! y (cons (* dxy (real-part avec)) y))
+ (set! z (cons (* d (imag-part evec)) z))
+ (set! v (cons (if 3d (fourth p) (third p)) v))))
+ points)
+ (list (reverse x) (reverse y) (reverse z) (reverse v)))
+
+ ;; decode a list of d:a:e components
+ (if 3d
+ ;; decode a three dimensional list
+ ;; '(d0 a0 e0 d1 a1 e1 ... dn an en)
+ ;; d: distance
+ ;; a: azimut angle
+ ;; e: elevarion angle [missing elevations assumed 0.0]
+ (let ((x ())
+ (y ())
+ (z ())
+ (len (length points)))
+ (do ((i 0 (+ i 3)))
+ ((>= i len))
+ (let* ((d (points i))
+ (a (points (+ i 1)))
+ (e (points (+ i 2)))
+ (evec (cis (* (/ e dlocsig-one-turn) 2 pi)))
+ (dxy (* d (real-part evec)))
+ (avec (cis (* (/ a dlocsig-one-turn) 2 pi))))
+ (set! x (cons (* dxy (imag-part avec)) x))
+ (set! y (cons (* dxy (real-part avec)) y))
+ (set! z (cons (* d (imag-part evec)) z))))
+ (list (reverse x) (reverse y) (reverse z) (make-list-1 (length x) #f)))
+
+ ;; decode a two dimensional list
+ ;; '(d0 a0 d1 a1 ... dn an)
+ ;; d: distance
+ ;; a: azimut angle
+ ;; e: elevarion angle [missing elevations assumed 0.0]
+ (let ((x ())
+ (y ())
+ (len (length points)))
+ (do ((i 0 (+ i 2)))
+ ((>= i len))
+ (let* ((d (points i))
+ (a (points (+ i 1)))
+ (avec (cis (* (/ a dlocsig-one-turn) 2 pi))))
+ (set! x (cons (* d (imag-part avec)) x))
+ (set! y (cons (* d (real-part avec)) y))))
+ (list (reverse x) (reverse y) (make-list-1 (length x) 0.0) (make-list-1 (length x) #f))))))))
(define (xparse-path xpath)
- (let* ((polar (bezier-polar xpath))
- (points (bezier-path xpath))
- (3d (bezier-3d xpath)))
+ (let ((polar (bezier-polar xpath))
+ (points (bezier-path xpath))
+ (3d (bezier-3d xpath)))
(if polar
;; parse a polar path
(let ((vals (parse-polar-coordinates points 3d)))
@@ -998,12 +1013,12 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! (bezier-y xpath) (cadr vals))
(set! (bezier-z xpath) (caddr vals))
(set! (bezier-v xpath) (cadddr vals)))
- (let ((vals (parse-cartesian-coordinates points 3d)))
- ;; parse a cartesian path
- (set! (bezier-x xpath) (car vals))
- (set! (bezier-y xpath) (cadr vals))
- (set! (bezier-z xpath) (caddr vals))
- (set! (bezier-v xpath) (cadddr vals)))))
+ (let ((vals (parse-cartesian-coordinates points 3d)))
+ ;; parse a cartesian path
+ (set! (bezier-x xpath) (car vals))
+ (set! (bezier-y xpath) (cadr vals))
+ (set! (bezier-z xpath) (caddr vals))
+ (set! (bezier-v xpath) (cadddr vals)))))
(for-each
(lambda (v)
(if (and (number? v)
@@ -1019,42 +1034,43 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; Pythagoras
-(define (distance x y z)
- "(distance x y z) returns the euclidean distance of (x y z) from the origin"
- (sqrt (+ (* x x) (* y y) (* z z))))
+(define distance
+ (let ((documentation "(distance x y z) returns the euclidean distance of (x y z) from the origin"))
+ (lambda (x y z)
+ (sqrt (+ (* x x) (* y y) (* z z))))))
;;; Nearest point in a line
(define (nearest-point x0 y0 z0 x1 y1 z1 px py pz)
-
+
(define (vmag a b c)
(sqrt (+ (* a a) (* b b) (* c c))))
-
+
(define (vcos a0 b0 c0 a1 b1 c1)
(/ (+ (* a0 a1) (* b0 b1) (* c0 c1))
(* (vmag a0 b0 c0) (vmag a1 b1 c1))))
-
+
(define (same a0 b0 c0 a1 b1 c1)
(and (= a0 a1) (= b0 b1) (= c0 c1)))
-
+
(if (same x0 y0 z0 px py pz)
(list x0 y0 z0)
- (if (same x1 y1 z1 px py pz)
- (list x1 y1 z1)
- (if (same x0 y0 z0 x1 y1 z1)
- (list x0 y0 z0)
- (let* ((xm0 (- x1 x0))
- (ym0 (- y1 y0))
- (zm0 (- z1 z0))
- (xm1 (- px x0))
- (ym1 (- py y0))
- (zm1 (- pz z0))
- (p (* (vmag xm1 ym1 zm1) (vcos xm0 ym0 zm0 xm1 ym1 zm1)))
- (l (vmag xm0 ym0 zm0))
- (ratio (/ p l)))
- (list (+ x0 (* xm0 ratio))
- (+ y0 (* ym0 ratio))
- (+ z0 (* zm0 ratio))))))))
+ (if (same x1 y1 z1 px py pz)
+ (list x1 y1 z1)
+ (if (same x0 y0 z0 x1 y1 z1)
+ (list x0 y0 z0)
+ (let* ((xm0 (- x1 x0))
+ (ym0 (- y1 y0))
+ (zm0 (- z1 z0))
+ (xm1 (- px x0))
+ (ym1 (- py y0))
+ (zm1 (- pz z0))
+ (p (* (vmag xm1 ym1 zm1) (vcos xm0 ym0 zm0 xm1 ym1 zm1)))
+ (l (vmag xm0 ym0 zm0))
+ (ratio (/ p l)))
+ (list (+ x0 (* xm0 ratio))
+ (+ y0 (* ym0 ratio))
+ (+ z0 (* zm0 ratio))))))))
;;; Bezier curve fitting auxilliary functions
@@ -1064,50 +1080,50 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(define path-gtab #f)
(define (make-a-even)
-
+
(define (g m)
(if (not path-gtab)
(begin
- (set! path-gtab (make-vector path-maxcoeff))
- (vector-set! path-gtab 0 1)
- (vector-set! path-gtab 1 -4)
- (do ((i 2 (+ i 1)))
- ((= i path-maxcoeff))
- (vector-set! path-gtab i (- (* -4 (vector-ref path-gtab (- i 1)))
- (vector-ref path-gtab (- i 2)))))))
- (vector-ref path-gtab m))
-
+ (set! path-gtab (make-vector path-maxcoeff))
+ (set! (path-gtab 0) 1)
+ (set! (path-gtab 1) -4)
+ (do ((i 2 (+ i 1)))
+ ((= i path-maxcoeff))
+ (set! (path-gtab i) (- (* -4 (path-gtab (- i 1)))
+ (path-gtab (- i 2)))))))
+ (path-gtab m))
+
(set! path-ak-even (make-vector (- path-maxcoeff 1)))
(do ((m 1 (+ 1 m)))
((= m path-maxcoeff))
- (vector-set! path-ak-even (- m 1) (make-vector m))
- (do ((k 1 (+ 1 k)))
+ (set! (path-ak-even (- m 1)) (make-vector m))
+ (do ((k 1 (+ k 1)))
((> k m))
- (vector-set! (vector-ref path-ak-even (- m 1)) (- k 1) (exact->inexact (/ (- (g (- m k))) (g m)))))))
+ (set! ((path-ak-even (- m 1)) (- k 1)) (* 1.0 (/ (- (g (- m k))) (g m)))))))
(define path-ftab #f)
(define (make-a-odd)
-
+
(define (f m)
(if (not path-ftab)
(begin
- (set! path-ftab (make-vector path-maxcoeff))
- (vector-set! path-ftab 0 1)
- (vector-set! path-ftab 1 -3)
- (do ((i 2 (+ i 1)))
- ((= i path-maxcoeff))
- (vector-set! path-ftab i (- (* -4 (vector-ref path-ftab (- i 1)))
- (vector-ref path-ftab (- i 2)))))))
- (vector-ref path-ftab m))
-
+ (set! path-ftab (make-vector path-maxcoeff))
+ (set! (path-ftab 0) 1)
+ (set! (path-ftab 1) -3)
+ (do ((i 2 (+ i 1)))
+ ((= i path-maxcoeff))
+ (set! (path-ftab i) (- (* -4 (path-ftab (- i 1)))
+ (path-ftab (- i 2)))))))
+ (path-ftab m))
+
(set! path-ak-odd (make-vector (- path-maxcoeff 1)))
(do ((m 1 (+ 1 m)))
((= m path-maxcoeff))
- (vector-set! path-ak-odd (- m 1) (make-vector m))
- (do ((k 1 (+ 1 k)))
+ (set! (path-ak-odd (- m 1)) (make-vector m))
+ (do ((k 1 (+ k 1)))
((> k m))
- (vector-set! (vector-ref path-ak-odd (- m 1)) (- k 1) (exact->inexact (/ (- (f (- m k))) (f m)))))))
+ (set! ((path-ak-odd (- m 1)) (- k 1)) (* 1.0 (/ (- (f (- m k))) (f m)))))))
;;; Calculate bezier difference vectors for the given path
;;; (path-x (make-path '((-10 10)(0 5)(10 10))))
@@ -1117,55 +1133,55 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(let* ((n (- (length (bezier-x path )) 1))
(m (/ (- n (if (odd? n) 3 4)) 2))
;; data points P(i)
- (p (vector (list->vector (bezier-x path))
- (list->vector (bezier-y path))
- (list->vector (bezier-z path))))
+ (p (vector (apply vector (bezier-x path))
+ (apply vector (bezier-y path))
+ (apply vector (bezier-z path))))
;; control points D(i)
(d (vector (make-vector n 0.0)
(make-vector n 0.0)
(make-vector n 0.0))))
-
+
(define (a-1 k n)
(if (odd? (min (+ (* path-maxcoeff 2) 1) n))
(begin
(if (not path-ak-odd) (make-a-odd))
- (vector-ref (vector-ref path-ak-odd (/ (- n 3) 2)) (- k 1)))
+ ((path-ak-odd (/ (- n 3) 2)) (- k 1)))
(begin
(if (not path-ak-even) (make-a-even))
- (vector-ref (vector-ref path-ak-even (/ (- n 4) 2)) (- k 1)))))
-
+ ((path-ak-even (/ (- n 4) 2)) (- k 1)))))
+
(define (xvector-ref z j i)
(if (> i (- n 1))
- (vector-ref (vector-ref z j) (- i n))
+ ((z j) (- i n))
(if (< i 0)
- (vector-ref (vector-ref z j) (+ i n))
- (vector-ref (vector-ref z j) i))))
-
- (do ((i 0 (+ 1 i)))
+ ((z j) (+ i n))
+ ((z j) i))))
+
+ (do ((i 0 (+ i 1)))
((= i n))
- (do ((k 1 (+ 1 k)))
+ (do ((k 1 (+ k 1)))
((> k m))
(do ((a 0 (+ 1 a)))
((> a 2))
- (vector-set! (vector-ref d a) i
- (+ (vector-ref (vector-ref d a) i)
- (* (a-1 k n)
- (- (xvector-ref p a (+ i k))
- (xvector-ref p a (- i k)))))))))
+ (set! ((d a) i)
+ (+ ((d a) i)
+ (* (a-1 k n)
+ (- (xvector-ref p a (+ i k))
+ (xvector-ref p a (- i k)))))))))
(if (bezier-curvature path)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i n))
- (vector-set! (vector-ref d 0) i (* (vector-ref (vector-ref d 0) i) curve))
- (vector-set! (vector-ref d 1) i (* (vector-ref (vector-ref d 1) i) curve))
- (vector-set! (vector-ref d 2) i (* (vector-ref (vector-ref d 2) i) curve))))
+ (set! ((d 0) i) (* ((d 0) i) (bezier-curvature path)))
+ (set! ((d 1) i) (* ((d 1) i) (bezier-curvature path)))
+ (set! ((d 2) i) (* ((d 2) i) (bezier-curvature path)))))
(list (- n 1) p d)))
(else
(let* ((n (- (length (bezier-x path)) 1))
(m (- n 1))
;; data points P(i)
- (p (vector (list->vector (bezier-x path))
- (list->vector (bezier-y path))
- (list->vector (bezier-z path))))
+ (p (vector (apply vector (bezier-x path))
+ (apply vector (bezier-y path))
+ (apply vector (bezier-z path))))
;; control points D(i)
(d (vector (make-vector (+ n 1) 0.0)
(make-vector (+ n 1) 0.0)
@@ -1174,63 +1190,63 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(define (ac k n)
(let ((un (min n path-maxcoeff)))
(if (not path-ak-even) (make-a-even))
- (vector-ref (vector-ref path-ak-even (- un 2)) (- k 1))))
+ ((path-ak-even (- un 2)) (- k 1))))
(define (ref z j i)
(if (> i n)
- (vector-ref (vector-ref z j) (- i n))
+ ((z j) (- i n))
(if (< i 0)
- (vector-ref (vector-ref z j) (+ i n))
+ ((z j) (+ i n))
(if (= i n)
- (- (vector-ref (vector-ref z j) n)
- (vector-ref (vector-ref d j) n))
+ (- ((z j) n)
+ ((d j) n))
(if (= i 0)
- (+ (vector-ref (vector-ref z j) 0)
- (vector-ref (vector-ref d j) 0))
- (vector-ref (vector-ref z j) i))))))
+ (+ ((z j) 0)
+ ((d j) 0))
+ ((z j) i))))))
;; forced initial direction
(if (initial-direction path)
(begin
- (vector-set! (vector-ref d 0) 0 (car (initial-direction path)))
- (vector-set! (vector-ref d 1) 0 (cadr (initial-direction path)))
- (vector-set! (vector-ref d 2) 0 (third (initial-direction path))))
+ (set! ((d 0) 0) (car (initial-direction path)))
+ (set! ((d 1) 0) (cadr (initial-direction path)))
+ (set! ((d 2) 0) (third (initial-direction path))))
(begin
- (vector-set! (vector-ref d 0) 0 0.0)
- (vector-set! (vector-ref d 1) 0 0.0)
- (vector-set! (vector-ref d 2) 0 0.0)))
+ (set! ((d 0) 0) 0.0)
+ (set! ((d 1) 0) 0.0)
+ (set! ((d 2) 0) 0.0)))
;; forced final direction
(if (final-direction path)
(begin
- (vector-set! (vector-ref d 0) n (car (final-direction path)))
- (vector-set! (vector-ref d 1) n (cadr (final-direction path)))
- (vector-set! (vector-ref d 2) n (caddr (final-direction path))))
+ (set! ((d 0) n) (car (final-direction path)))
+ (set! ((d 1) n) (cadr (final-direction path)))
+ (set! ((d 2) n) (caddr (final-direction path))))
(begin
- (vector-set! (vector-ref d 0) n 0.0)
- (vector-set! (vector-ref d 1) n 0.0)
- (vector-set! (vector-ref d 2) n 0.0)))
+ (set! ((d 0) n) 0.0)
+ (set! ((d 1) n) 0.0)
+ (set! ((d 2) n) 0.0)))
;; calculate fit
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((= i n))
- (do ((k 1 (+ 1 k)))
+ (do ((k 1 (+ k 1)))
((> k (min m (- path-maxcoeff 1))))
- (let ((d0 (vector-ref (vector-ref d 0) i))
- (d1 (vector-ref (vector-ref d 1) i))
- (d2 (vector-ref (vector-ref d 2) i)))
- (vector-set! (vector-ref d 0) i (+ d0
- (* (ac k n)
- (- (ref p 0 (+ i k))
- (ref p 0 (- i k))))))
- (vector-set! (vector-ref d 1) i (+ d1
- (* (ac k n)
- (- (ref p 1 (+ i k))
- (ref p 1 (- i k))))))
- (vector-set! (vector-ref d 2) i (+ d2
- (* (ac k n)
- (- (ref p 2 (+ i k))
- (ref p 2 (- i k)))))))))
+ (let ((d0 ((d 0) i))
+ (d1 ((d 1) i))
+ (d2 ((d 2) i)))
+ (set! ((d 0) i) (+ d0
+ (* (ac k n)
+ (- (ref p 0 (+ i k))
+ (ref p 0 (- i k))))))
+ (set! ((d 1) i) (+ d1
+ (* (ac k n)
+ (- (ref p 1 (+ i k))
+ (ref p 1 (- i k))))))
+ (set! ((d 2) i) (+ d2
+ (* (ac k n)
+ (- (ref p 2 (+ i k))
+ (ref p 2 (- i k)))))))))
(list n p d)))))
;;; Calculate bezier control points for the given open path
@@ -1239,9 +1255,9 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(null? (bezier-bx path)))
(define (reset-fit path)
- (set! (bezier-bx path) '())
- (set! (bezier-by path) '())
- (set! (bezier-bz path) '())
+ (set! (bezier-bx path) ())
+ (set! (bezier-by path) ())
+ (set! (bezier-bz path) ())
(reset-rendering path))
(define (fit-path path)
@@ -1255,129 +1271,129 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(n (car vals))
(p (cadr vals))
(d (caddr vals)))
- (let* ((c (bezier-curvature path))
- (cs (make-vector n)))
+ (let ((c (bezier-curvature path))
+ (cs (make-vector n)))
;; setup the curvatures array
(if (or (not c) (null? c)) ; no curvature specified, default is 1.0
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i n))
- (vector-set! cs i (list 1.0 1.0)))
+ (set! (cs i) (list 1.0 1.0)))
(if (number? c) ; same curvature for all segments
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i n))
- (vector-set! cs i (list c c)))
- (if (and (list? c) (= n (length c))) ; list of curvatures
+ (set! (cs i) (list c c)))
+ (if (and (pair? c) (= n (length c))) ; list of curvatures
(let ((i 0))
(for-each
(lambda (ci)
- (vector-set! cs i (if (list? ci)
- (if (not (= (length ci) 2))
- (error 'mus-error "ERROR: curvature sublist must have two elements ~A~%" ci)
- ci)
- (list ci ci)))
- (set! i (+ 1 i)))
+ (set! (cs i) (if (pair? ci)
+ (if (not (= (length ci) 2))
+ (error 'mus-error "ERROR: curvature sublist must have two elements ~A~%" ci)
+ ci)
+ (list ci ci)))
+ (set! i (+ i 1)))
c))
(error 'mus-error "ERROR: bad curvature argument ~A to path, need ~A elements~%" c n))))
-
+
;; calculate control points
- (let ((xc '())
- (yc '())
- (zc '()))
- (do ((i 0 (+ 1 i)))
+ (let ((xc ())
+ (yc ())
+ (zc ()))
+ (do ((i 0 (+ i 1)))
((= i n))
- (set! xc (cons (list (vector-ref (vector-ref p 0) i)
- (+ (vector-ref (vector-ref p 0) i) (* (vector-ref (vector-ref d 0) i) (car (vector-ref cs i))))
- (- (vector-ref (vector-ref p 0) (+ i 1)) (* (vector-ref (vector-ref d 0) (+ i 1)) (cadr (vector-ref cs i))))
- (vector-ref (vector-ref p 0) (+ i 1))) xc))
- (set! yc (cons (list (vector-ref (vector-ref p 1) i)
- (+ (vector-ref (vector-ref p 1) i) (* (vector-ref (vector-ref d 1) i) (car (vector-ref cs i))))
- (- (vector-ref (vector-ref p 1) (+ i 1)) (* (vector-ref (vector-ref d 1) (+ i 1)) (cadr (vector-ref cs i))))
- (vector-ref (vector-ref p 1) (+ i 1))) yc))
- (set! zc (cons (list (vector-ref (vector-ref p 2) i)
- (+ (vector-ref (vector-ref p 2) i) (* (vector-ref (vector-ref d 2) i) (car (vector-ref cs i))))
- (- (vector-ref (vector-ref p 2) (+ i 1)) (* (vector-ref (vector-ref d 2) (+ i 1)) (cadr (vector-ref cs i))))
- (vector-ref (vector-ref p 2) (+ i 1))) zc)))
+ (set! xc (cons (list ((p 0) i)
+ (+ ((p 0) i) (* ((d 0) i) (car (cs i))))
+ (- ((p 0) (+ i 1)) (* ((d 0) (+ i 1)) (cadr (cs i))))
+ ((p 0) (+ i 1))) xc))
+ (set! yc (cons (list ((p 1) i)
+ (+ ((p 1) i) (* ((d 1) i) (car (cs i))))
+ (- ((p 1) (+ i 1)) (* ((d 1) (+ i 1)) (cadr (cs i))))
+ ((p 1) (+ i 1))) yc))
+ (set! zc (cons (list ((p 2) i)
+ (+ ((p 2) i) (* ((d 2) i) (car (cs i))))
+ (- ((p 2) (+ i 1)) (* ((d 2) (+ i 1)) (cadr (cs i))))
+ ((p 2) (+ i 1))) zc)))
(set! (bezier-bx path) (reverse xc))
(set! (bezier-by path) (reverse yc))
(set! (bezier-bz path) (reverse zc)))))
(if (= points 2)
;; just a line, stays a line
- (let* ((x1 (car (bezier-x path)))
- (x2 (cadr (bezier-x path)))
- (y1 (car (bezier-y path)))
- (y2 (cadr (bezier-y path)))
- (z1 (car (bezier-z path)))
- (z2 (cadr (bezier-z path))))
+ (let ((x1 (car (bezier-x path)))
+ (x2 (cadr (bezier-x path)))
+ (y1 (car (bezier-y path)))
+ (y2 (cadr (bezier-y path)))
+ (z1 (car (bezier-z path)))
+ (z2 (cadr (bezier-z path))))
(set! (bezier-bx path) (list (list x1 x1 x2 x2)))
(set! (bezier-by path) (list (list y1 y1 y2 y2)))
(set! (bezier-bz path) (list (list z1 z1 z2 z2))))
(if (= points 1)
;; just one point, bezier won't do much here
(begin
- (set! (bezier-bx path) '())
- (set! (bezier-by path) '())
- (set! (bezier-bz path) '())))))
+ (set! (bezier-bx path) ())
+ (set! (bezier-by path) ())
+ (set! (bezier-bz path) ())))))
(reset-rendering path)))
(else
(if (not-parsed path)
(xparse-path path))
-
+
(if (> (length (bezier-x path)) 4)
(let* ((vals (calculate-fit path))
(n (car vals))
(p (cadr vals))
(d (caddr vals)))
;; enough points, fit path
- (let ((xc '())
- (yc '())
- (zc '()))
- (do ((i 0 (+ 1 i)))
+ (let ((xc ())
+ (yc ())
+ (zc ()))
+ (do ((i 0 (+ i 1)))
((= i n))
- (set! xc (cons (list (vector-ref (vector-ref p 0) i)
- (+ (vector-ref (vector-ref p 0) i) (vector-ref (vector-ref d 0) i))
- (- (vector-ref (vector-ref p 0) (+ i 1)) (vector-ref (vector-ref d 0) (+ i 1)))
- (vector-ref (vector-ref p 0) (+ i 1))) xc))
- (set! yc (cons (list (vector-ref (vector-ref p 1) i)
- (+ (vector-ref (vector-ref p 1) i) (vector-ref (vector-ref d 1) i))
- (- (vector-ref (vector-ref p 1) (+ i 1)) (vector-ref (vector-ref d 1) (+ i 1)))
- (vector-ref (vector-ref p 1) (+ i 1))) yc))
- (set! zc (cons (list (vector-ref (vector-ref p 2) i)
- (+ (vector-ref (vector-ref p 2) i) (vector-ref (vector-ref d 2) i))
- (- (vector-ref (vector-ref p 2) (+ i 1)) (vector-ref (vector-ref d 2) (+ i 1)))
- (vector-ref (vector-ref p 2) (+ i 1))) zc)))
- (set! (bezier-bx path) (append (reverse xc) (list (list (vector-ref (vector-ref p 0) n)
- (+ (vector-ref (vector-ref p 0) n) (vector-ref (vector-ref d 0) n))
- (- (vector-ref (vector-ref p 0) 0) (vector-ref (vector-ref d 0) 0))
- (vector-ref (vector-ref p 0) 0)))))
- (set! (bezier-by path) (append (reverse yc) (list (list (vector-ref (vector-ref p 1) n)
- (+ (vector-ref (vector-ref p 1) n) (vector-ref (vector-ref d 1) n))
- (- (vector-ref (vector-ref p 1) 0) (vector-ref (vector-ref d 1) 0))
- (vector-ref (vector-ref p 1) 0)))))
- (set! (bezier-bz path) (append (reverse zc) (list (list (vector-ref (vector-ref p 2) n)
- (+ (vector-ref (vector-ref p 2) n) (vector-ref (vector-ref d 2) n))
- (- (vector-ref (vector-ref p 2) 0) (vector-ref (vector-ref d 2) 0))
- (vector-ref (vector-ref p 2) 0)))))))
+ (set! xc (cons (list ((p 0) i)
+ (+ ((p 0) i) ((d 0) i))
+ (- ((p 0) (+ i 1)) ((d 0) (+ i 1)))
+ ((p 0) (+ i 1))) xc))
+ (set! yc (cons (list ((p 1) i)
+ (+ ((p 1) i) ((d 1) i))
+ (- ((p 1) (+ i 1)) ((d 1) (+ i 1)))
+ ((p 1) (+ i 1))) yc))
+ (set! zc (cons (list ((p 2) i)
+ (+ ((p 2) i) ((d 2) i))
+ (- ((p 2) (+ i 1)) ((d 2) (+ i 1)))
+ ((p 2) (+ i 1))) zc)))
+ (set! (bezier-bx path) (append (reverse xc) (list (list ((p 0) n)
+ (+ ((p 0) n) ((d 0) n))
+ (- ((p 0) 0) ((d 0) 0))
+ ((p 0) 0)))))
+ (set! (bezier-by path) (append (reverse yc) (list (list ((p 1) n)
+ (+ ((p 1) n) ((d 1) n))
+ (- ((p 1) 0) ((d 1) 0))
+ ((p 1) 0)))))
+ (set! (bezier-bz path) (append (reverse zc) (list (list ((p 2) n)
+ (+ ((p 2) n) ((d 2) n))
+ (- ((p 2) 0) ((d 2) 0))
+ ((p 2) 0)))))))
;; not enough points to fit a closed path
- (let ((xc '())
- (yc '())
- (zc '())
+ (let ((xc ())
+ (yc ())
+ (zc ())
(len (min (length (bezier-x path)) (length (bezier-y path)) (length (bezier-z path)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((>= i len))
- (let ((x1 (list-ref (bezier-x path) i))
- (x2 (list-ref (bezier-x path) (+ i 1)))
- (y1 (list-ref (bezier-y path) i))
- (y2 (list-ref (bezier-y path) (+ i 1)))
- (z1 (list-ref (bezier-z path) i))
- (z2 (list-ref (bezier-z path) (+ i 1))))
+ (let ((x1 ((bezier-x path) i))
+ (x2 ((bezier-x path) (+ i 1)))
+ (y1 ((bezier-y path) i))
+ (y2 ((bezier-y path) (+ i 1)))
+ (z1 ((bezier-z path) i))
+ (z2 ((bezier-z path) (+ i 1))))
(set! xc (cons (list x1 x1 x2 x2) xc))
(set! yc (cons (list y1 y1 y2 y2) yc))
(set! zc (cons (list z1 z1 z2 z2) zc))))
- (warn "[fit-path:closed-path] not enough points to do bezier fit (~A points)" len)
+ (format *stderr* "[fit-path:closed-path] not enough points to do bezier fit (~A points)" len)
(set! (bezier-bx path) (reverse xc))
(set! (bezier-by path) (reverse yc))
(set! (bezier-bz path) (reverse zc))))
@@ -1390,16 +1406,16 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;;;;;;;;;;;;;;;;
-(define literal-points (make-procedure-with-setter (lambda (p) (list-ref p 10)) (lambda (p val) (list-set! p 10 val))))
-(define literal-3d (make-procedure-with-setter (lambda (p) (list-ref p 11)) (lambda (p val) (list-set! p 11 val))))
-(define literal-polar (make-procedure-with-setter (lambda (p) (list-ref p 12)) (lambda (p val) (list-set! p 12 val))))
+(define literal-points (dilambda (lambda (p) (p 10)) (lambda (p val) (set! (p 10) val))))
+(define literal-3d (dilambda (lambda (p) (p 11)) (lambda (p val) (set! (p 11) val))))
+(define literal-polar (dilambda (lambda (p) (p 12)) (lambda (p val) (set! (p 12) val))))
;;; Generic literal path creation function
-(define* (make-literal-path (points '()) (3d path-3d) polar)
- (list 'literal-path '() '() '() '() '() '() '() '() '() points 3d polar))
+(define* (make-literal-path (points ()) (3d path-3d) polar)
+ (list 'literal-path () () () () () () () () () points 3d polar))
;;; Specific polar literal path creation function
-(define* (make-literal-polar-path (points '()) (3d path-3d))
+(define* (make-literal-polar-path (points ()) (3d path-3d))
(make-literal-path points 3d #t))
@@ -1407,25 +1423,25 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; Spirals
;;;;;;;;;;;
-(define spiral-start-angle (make-procedure-with-setter (lambda (p) (list-ref p 13)) (lambda (p val) (list-set! p 13 val))))
-(define spiral-total-angle (make-procedure-with-setter (lambda (p) (list-ref p 14)) (lambda (p val) (list-set! p 14 val))))
-(define spiral-step-angle (make-procedure-with-setter (lambda (p) (list-ref p 15)) (lambda (p val) (list-set! p 15 val))))
-(define spiral-turns (make-procedure-with-setter (lambda (p) (list-ref p 16)) (lambda (p val) (list-set! p 16 val))))
-(define spiral-distance (make-procedure-with-setter (lambda (p) (list-ref p 17)) (lambda (p val) (list-set! p 17 val))))
-(define spiral-height (make-procedure-with-setter (lambda (p) (list-ref p 18)) (lambda (p val) (list-set! p 18 val))))
-(define spiral-velocity (make-procedure-with-setter (lambda (p) (list-ref p 19)) (lambda (p val) (list-set! p 19 val))))
+(define spiral-start-angle (dilambda (lambda (p) (p 13)) (lambda (p val) (set! (p 13) val))))
+(define spiral-total-angle (dilambda (lambda (p) (p 14)) (lambda (p val) (set! (p 14) val))))
+(define spiral-step-angle (dilambda (lambda (p) (p 15)) (lambda (p val) (set! (p 15) val))))
+(define spiral-turns (dilambda (lambda (p) (p 16)) (lambda (p val) (set! (p 16) val))))
+(define spiral-distance (dilambda (lambda (p) (p 17)) (lambda (p val) (set! (p 17) val))))
+(define spiral-height (dilambda (lambda (p) (p 18)) (lambda (p val) (set! (p 18) val))))
+(define spiral-velocity (dilambda (lambda (p) (p 19)) (lambda (p val) (set! (p 19) val))))
(define* (make-spiral-path (start-angle 0.0)
total-angle
step-angle
- (turns '())
+ (turns ())
(distance '(0 10 1 10))
(height '(0 0 1 0))
(velocity '(0 1 1 1)))
- (if (and total-angle (not (null? turns)))
+ (if (and total-angle (pair? turns))
(error 'mus-error "ERROR: can't specify total-angle [~A] and turns [~A] at the same time for the spiral path~%" total-angle turns))
- (list 'spiral-path '() '() '() '() '() '() '() '() '() '() path-3d #f
+ (list 'spiral-path () () () () () () () () () () path-3d #f
start-angle total-angle
(or step-angle (/ dlocsig-one-turn 100))
turns distance height velocity))
@@ -1437,29 +1453,29 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(define (bezier-render path)
(if (not-fitted path)
(fit-path path))
- (let ((xrx '()) (xry '()) (xrz '()) (xrv '()))
+ (let ((xrx ()) (xry ()) (xrz ()) (xrv ()))
(define (bezier-point u c)
;; Evaluate a point at parameter u in bezier segment
- (let* ((u1 (- 1 u))
- (cr (vector (make-vector 3 0.0) (make-vector 3 0.0) (make-vector 3 0.0))))
- (do ((j 0 (+ 1 j)))
+ (let ((u1 (- 1 u))
+ (cr (vector (make-vector 3 0.0) (make-vector 3 0.0) (make-vector 3 0.0))))
+ (do ((j 0 (+ j 1)))
((= j 3))
- (vector-set! (vector-ref cr 0) j (+ (* u1 (vector-ref (vector-ref c 0) j)) (* u (vector-ref (vector-ref c 0) (+ j 1)))))
- (vector-set! (vector-ref cr 1) j (+ (* u1 (vector-ref (vector-ref c 1) j)) (* u (vector-ref (vector-ref c 1) (+ j 1)))))
- (vector-set! (vector-ref cr 2) j (+ (* u1 (vector-ref (vector-ref c 2) j)) (* u (vector-ref (vector-ref c 2) (+ j 1))))))
+ (set! ((cr 0) j) (+ (* u1 ((c 0) j)) (* u ((c 0) (+ j 1)))))
+ (set! ((cr 1) j) (+ (* u1 ((c 1) j)) (* u ((c 1) (+ j 1)))))
+ (set! ((cr 2) j) (+ (* u1 ((c 2) j)) (* u ((c 2) (+ j 1))))))
(do ((i 1 (- i 1)))
((< i 0))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((> j i))
- (vector-set! (vector-ref cr 0) j (+ (* u1 (vector-ref (vector-ref cr 0) j)) (* u (vector-ref (vector-ref cr 0) (+ j 1)))))
- (vector-set! (vector-ref cr 1) j (+ (* u1 (vector-ref (vector-ref cr 1) j)) (* u (vector-ref (vector-ref cr 1) (+ j 1)))))
- (vector-set! (vector-ref cr 2) j (+ (* u1 (vector-ref (vector-ref cr 2) j)) (* u (vector-ref (vector-ref cr 2) (+ j 1)))))
+ (set! ((cr 0) j) (+ (* u1 ((cr 0) j)) (* u ((cr 0) (+ j 1)))))
+ (set! ((cr 1) j) (+ (* u1 ((cr 1) j)) (* u ((cr 1) (+ j 1)))))
+ (set! ((cr 2) j) (+ (* u1 ((cr 2) j)) (* u ((cr 2) (+ j 1)))))
))
- (list (vector-ref (vector-ref cr 0) 0)
- (vector-ref (vector-ref cr 1) 0)
- (vector-ref (vector-ref cr 2) 0))))
+ (list ((cr 0) 0)
+ ((cr 1) 0)
+ ((cr 2) 0))))
(define (berny xl yl zl xh yh zh ul u uh c err)
;; Create a linear segment rendering of a bezier segment
@@ -1483,7 +1499,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(list (append xi (list x) xj)
(append yi (list y) yj)
(append zi (list z) zj))))
- (list '() '() '())))))
+ (list () () ())))))
;; Create linear segment approximations of the bezier segments
;; make sure there are initial and final velocity values
@@ -1491,8 +1507,8 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! (bezier-v path) (list 1 1))
(if (not (car (bezier-v path)))
(begin
- (list-set! (bezier-v path) 0 1)
- (list-set! (bezier-v path) (- (length (bezier-v path)) 1) 1))))
+ (set! ((bezier-v path) 0) 1)
+ (set! ((bezier-v path) (- (length (bezier-v path)) 1)) 1))))
;; only one point means no movement, static source
(if (= (length (bezier-x path)) 1)
@@ -1506,23 +1522,23 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(let ((len (length (bezier-bx path))))
;(path-x (make-path '((-10 10)(0 5)(10 10))))
;; render the path only if it has at least two points
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let* ((x-bz (list-ref (bezier-bx path) i))
- (y-bz (list-ref (bezier-by path) i))
- (z-bz (list-ref (bezier-bz path) i))
- (vi-bz (list-ref (bezier-v path) i))
- (vf-bz (list-ref (bezier-v path) (+ i 1)))
+ (let* ((x-bz ((bezier-bx path) i))
+ (y-bz ((bezier-by path) i))
+ (z-bz ((bezier-bz path) i))
+ (vi-bz ((bezier-v path) i))
+ (vf-bz ((bezier-v path) (+ i 1)))
(xi-bz (car x-bz))
- (xf-bz (list-ref x-bz (- (length x-bz) 1)))
+ (xf-bz (x-bz (- (length x-bz) 1)))
(yi-bz (car y-bz))
- (yf-bz (list-ref y-bz (- (length y-bz) 1)))
+ (yf-bz (y-bz (- (length y-bz) 1)))
(zi-bz (car z-bz))
- (zf-bz (list-ref z-bz (- (length z-bz) 1))))
+ (zf-bz (z-bz (- (length z-bz) 1))))
(let* ((vals (berny xi-bz yi-bz zi-bz xf-bz yf-bz zf-bz 0.0 0.5 1.0
- (vector (list->vector x-bz)
- (list->vector y-bz)
- (list->vector z-bz))
+ (vector (apply vector x-bz)
+ (apply vector y-bz)
+ (apply vector z-bz))
(bezier-error path)))
(xs (car vals))
(ys (cadr vals))
@@ -1548,42 +1564,41 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(let ((len (- (length xrx) 1))
(ti 0)
(times (list 0))
- (xseg (list (list-ref xrx 0)))
- (yseg (list (list-ref xry 0)))
- (zseg (list (list-ref xrz 0)))
- (vseg (list (list-ref xrv 0)))
- (vi (list-ref xrv 0)))
- (do ((i 0 (+ 1 i)))
+ (xseg (list (xrx 0)))
+ (yseg (list (xry 0)))
+ (zseg (list (xrz 0)))
+ (vseg (list (xrv 0)))
+ (vi (xrv 0)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let* ((x (list-ref xrx (+ i 1)))
- (y (list-ref xry (+ i 1)))
- (z (list-ref xrz (+ i 1)))
- (v (list-ref xrv (+ i 1))))
+ (let ((x (xrx (+ i 1)))
+ (y (xry (+ i 1)))
+ (z (xrz (+ i 1)))
+ (v (xrv (+ i 1))))
(set! xseg (append xseg (list x)))
(set! yseg (append yseg (list y)))
(set! zseg (append zseg (list z)))
(set! vseg (append vseg (list v)))
(if v
- (let* ((dseg (list))
- (sum 0.0)
- (len (- (length xseg) 1)))
-
- (do ((i 0 (+ 1 i)))
+ (let ((dseg (list))
+ (sum 0.0)
+ (len (- (length xseg) 1)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let* ((xsi (list-ref xseg i))
- (ysi (list-ref yseg i))
- (zsi (list-ref zseg i))
- (xsf (list-ref xseg (+ i 1)))
- (ysf (list-ref yseg (+ i 1)))
- (zsf (list-ref zseg (+ i 1))))
+ (let ((xsi (xseg i))
+ (ysi (yseg i))
+ (zsi (zseg i))
+ (xsf (xseg (+ i 1)))
+ (ysf (yseg (+ i 1)))
+ (zsf (zseg (+ i 1))))
(set! sum (+ sum (distance (- xsf xsi) (- ysf ysi) (- zsf zsi))))
(set! dseg (cons sum dseg))))
- (let* ((df (car dseg)))
+ (let ((df (car dseg)))
(set! dseg (reverse dseg))
- (let* ((tseg '())
+ (let* ((tseg ())
(vf v)
(a (/ (* (- vf vi) (+ vf vi)) df 4)))
(if (= vi 0.0) (set! vi 1))
@@ -1609,8 +1624,8 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! (path-ry path) xry)
(set! (path-rz path) xrz)
(set! (path-rt path)
- (let* ((tf (list-ref times (- (length times) 1)))
- (val '()))
+ (let ((tf (times (- (length times) 1)))
+ (val ()))
(for-each
(lambda (ti)
(set! val (cons (/ ti tf) val)))
@@ -1628,9 +1643,9 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; Render a user-defined literal path from the data points
;; decode the points into coordinates
- (let* ((points (literal-points path))
- (3d (literal-3d path))
- (polar (literal-polar path)))
+ (let ((points (literal-points path))
+ (3d (literal-3d path))
+ (polar (literal-polar path)))
(let ((vals (if polar (parse-polar-coordinates points 3d) (parse-cartesian-coordinates points 3d))))
(set! (path-rx path) (car vals))
(set! (path-ry path) (cadr vals))
@@ -1640,8 +1655,8 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; make sure there are initial and final velocity values
(if (not (car (path-rv path)))
(begin
- (list-set! (path-rv path) 0 1)
- (list-set! (path-rv path) (- (length (path-rv path)) 1) 1)))
+ (set! ((path-rv path) 0) 1)
+ (set! ((path-rv path) (- (length (path-rv path)) 1)) 1)))
;; only one point means no movement, static source
(if (= (length (path-rx path)) 1)
@@ -1660,34 +1675,34 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(len (length rx))
(ti 0)
(times (list ti)))
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((= i len))
- (let ((x (list-ref rx i))
- (y (list-ref ry i))
- (z (list-ref rz i))
- (v (list-ref rv i)))
+ (let ((x (rx i))
+ (y (ry i))
+ (z (rz i))
+ (v (rv i)))
(set! xseg (append xseg (list x)))
(set! yseg (append yseg (list y)))
(set! zseg (append zseg (list z)))
(set! vseg (append vseg (list v)))
(if (number? v) ; when v
- (let* ((sofar 0.0)
- (dseg '())
- (len (- (length xseg) 1)))
- (do ((i 0 (+ 1 i)))
+ (let ((sofar 0.0)
+ (dseg ())
+ (len (- (length xseg) 1)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let* ((xsi (list-ref xseg i))
- (ysi (list-ref yseg i))
- (zsi (list-ref zseg i))
- (xsf (list-ref xseg (+ i 1)))
- (ysf (list-ref yseg (+ i 1)))
- (zsf (list-ref zseg (+ i 1))))
+ (let ((xsi (xseg i))
+ (ysi (yseg i))
+ (zsi (zseg i))
+ (xsf (xseg (+ i 1)))
+ (ysf (yseg (+ i 1)))
+ (zsf (zseg (+ i 1))))
(set! sofar (+ sofar (distance (- xsf xsi) (- ysf ysi) (- zsf zsi))))
(set! dseg (cons sofar dseg))))
- (let* ((df (car dseg)))
+ (let ((df (car dseg)))
(set! dseg (reverse dseg))
- (let* ((tseg '())
+ (let* ((tseg ())
(vf v)
(a (/ (* (- vf vi) (+ vf vi)) df 4)))
(for-each
@@ -1706,13 +1721,13 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! vseg (list v))
(set! vi v)))))))
- (set! (path-rt path) (let ((val '())
- (tf (list-ref times (- (length times) 1))))
- (for-each
- (lambda (ti)
- (set! val (cons (/ ti tf) val)))
- times)
- (reverse val)))
+ (set! (path-rt path) (let ((val ())
+ (tf (times (- (length times) 1))))
+ (for-each
+ (lambda (ti)
+ (set! val (cons (/ ti tf) val)))
+ times)
+ (reverse val)))
(reset-transformation path)))))
(define (spiral-render path)
@@ -1729,16 +1744,16 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(if (< (spiral-step-angle path) 0) -1 1)))
(xdistance (x-norm (spiral-distance path) total))
(height (x-norm (spiral-height path) total)))
- (let* ((x '())
- (y '())
- (z '())
- (segments (inexact->exact (round (abs (/ total step)))))
+ (let* ((x ())
+ (y ())
+ (z ())
+ (segments (round (abs (/ total step))))
(len (+ 1 segments)))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle start (+ angle step)))
((>= i len))
- (let* ((xy (cis angle))
- (d (envelope-interp angle xdistance)))
+ (let ((xy (cis angle))
+ (d (envelope-interp angle xdistance)))
(set! x (cons (* d (imag-part xy)) x))
(set! y (cons (* d (real-part xy)) y))
(set! z (cons (envelope-interp angle height) z))))
@@ -1747,28 +1762,28 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! y (reverse y))
(set! z (reverse z))
- (let* ((dp '())
- (len (- (length x) 1))
- (sofar 0.0))
- (do ((i 0 (+ 1 i)))
+ (let ((dp ())
+ (len (- (length x) 1))
+ (sofar 0.0))
+ (do ((i 0 (+ i 1)))
((>= i len))
- (let* ((xi (list-ref x i))
- (xf (list-ref x (+ i 1)))
- (yi (list-ref y i))
- (yf (list-ref y (+ i 1)))
- (zi (list-ref z i))
- (zf (list-ref z (+ i 1))))
+ (let ((xi (x i))
+ (xf (x (+ i 1)))
+ (yi (y i))
+ (yf (y (+ i 1)))
+ (zi (z i))
+ (zf (z (+ i 1))))
(set! sofar (+ sofar (distance (- xf xi) (- yf yi) (- zf zi))))
(set! dp (cons sofar dp))))
- (let ((df (car dp)))
+ (let ()
(set! dp (reverse dp))
- (let* ((tp '())
- (td 0)
- (len (- (length dp) 1)))
- (do ((i 0 (+ 1 i)))
+ (let ((tp ())
+ (td 0)
+ (len (- (length dp) 1)))
+ (do ((i 0 (+ i 1)))
((>= i len))
- (let* ((di (list-ref dp i))
- (df (list-ref dp (+ i 1)))
+ (let* ((di (dp i))
+ (df (dp (+ i 1)))
(vp (x-norm (spiral-velocity path) df))
(vi (envelope-interp di vp))
(vf (envelope-interp df vp)))
@@ -1779,7 +1794,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! (path-rx path) x)
(set! (path-ry path) y)
(set! (path-rz path) z)
- (let ((val '()))
+ (let ((val ()))
(for-each
(lambda (ti)
(set! val (cons (/ ti tf) val)))
@@ -1790,8 +1805,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(define (render-path path)
- (cond ((or (eq? (car path) 'bezier-path)
- (eq? (car path) 'open-bezier-path))
+ (cond ((memq (car path) '(bezier-path open-bezier-path))
(bezier-render path))
((eq? (car path) 'literal-path)
(literal-render path))
@@ -1816,13 +1830,13 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(rotation-axis '(0.0 0.0 1.0)))
;; Derive a rotation matrix from an axis vector and an angle
-
+
(define (rotation-matrix x y z angle)
;; translated from C routine by David Eberly
;; (http://www.magic-software.com/)
(define (normalize a b c)
- (let* ((mag (sqrt (+ (* a a) (* b b) (* c c)))))
+ (let ((mag (sqrt (+ (* a a) (* b b) (* c c)))))
(list (/ a mag) (/ b mag) (/ c mag))))
(let* ((vals (normalize x y z))
@@ -1834,29 +1848,29 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(A (vector (vector 0.0 dz (- dy)) (vector (- dz) 0.0 dx) (vector dy (- dx) 0.0)))
(AA (vector (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0) (vector 0.0 0.0 0.0)))
(sn (sin (- angle)))
- (omcs (- 1 (cos (- angle)))))
+ (omcs (- 1 (cos angle)))) ; (cos (- angle)) == (cos angle)
(do ((row 0 (+ 1 row)))
((= row 3))
(do ((col 0 (+ 1 col)))
((= col 3))
- (vector-set! (vector-ref AA row) col 0.0)
+ (set! ((AA row) col) 0.0)
(do ((mid 0 (+ 1 mid)))
((= mid 3))
- (vector-set! (vector-ref AA row) col
- (+ (vector-ref (vector-ref AA row) col)
- (* (vector-ref (vector-ref A row) mid)
- (vector-ref (vector-ref A mid) col)))))))
+ (set! ((AA row) col)
+ (+ ((AA row) col)
+ (* ((A row) mid)
+ ((A mid) col)))))))
;; rotation matrix is I+sin(angle)*A+[1-cos(angle)]*A*A
(do ((row 0 (+ 1 row)))
((= row 3))
(do ((col 0 (+ 1 col)))
((= col 3))
- (vector-set! (vector-ref rotate row) col
- (+ (vector-ref (vector-ref I row) col)
- (* sn (vector-ref (vector-ref A row) col))
- (* omcs (vector-ref (vector-ref AA row) col))))))
+ (set! ((rotate row) col)
+ (+ ((I row) col)
+ (* sn ((A row) col))
+ (* omcs ((AA row) col))))))
rotate))
@@ -1864,12 +1878,11 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(render-path path))
(if (or scaling translation rotation)
;; there's at least one transformation to execute
- (let* ((rotation (if rotation (* 2 pi (/ rotation dlocsig-one-turn)) #f))
- (matrix (if rotation (rotation-matrix (car rotation-axis)
+ (let* ((rotation (and rotation (* 2 pi (/ rotation dlocsig-one-turn))))
+ (matrix (and rotation (rotation-matrix (car rotation-axis)
(cadr rotation-axis)
(third rotation-axis)
- rotation)
- #f))
+ rotation)))
(xc (path-x path))
(yc (path-y path))
(zc (path-z path)))
@@ -1878,14 +1891,14 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(if (and rotation-axis (not (= (length rotation-axis) 3)))
(error 'mus-error "ERROR: rotation axis has to have all three coordinates~%"))
(let ((len (length xc))
- (xtr '())
- (ytr '())
- (ztr '()))
- (do ((i 0 (+ 1 i)))
+ (xtr ())
+ (ytr ())
+ (ztr ()))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let* ((x (list-ref xc i))
- (y (list-ref yc i))
- (z (list-ref zc i))
+ (let* ((x (xc i))
+ (y (yc i))
+ (z (zc i))
(xw x)
(yw y)
(zw z))
@@ -1897,15 +1910,15 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! zw (- zw (third rotation-center)))))
;; rotation
(if rotation
- (let* ((xr (+ (* (vector-ref (vector-ref matrix 0) 0) xw)
- (* (vector-ref (vector-ref matrix 1) 0) yw)
- (* (vector-ref (vector-ref matrix 2) 0) zw)))
- (yr (+ (* (vector-ref (vector-ref matrix 0) 1) xw)
- (* (vector-ref (vector-ref matrix 1) 1) yw)
- (* (vector-ref (vector-ref matrix 2) 1) zw)))
- (zr (+ (* (vector-ref (vector-ref matrix 0) 2) xw)
- (* (vector-ref (vector-ref matrix 1) 2) yw)
- (* (vector-ref (vector-ref matrix 2) 2) zw))))
+ (let ((xr (+ (* ((matrix 0) 0) xw)
+ (* ((matrix 1) 0) yw)
+ (* ((matrix 2) 0) zw)))
+ (yr (+ (* ((matrix 0) 1) xw)
+ (* ((matrix 1) 1) yw)
+ (* ((matrix 2) 1) zw)))
+ (zr (+ (* ((matrix 0) 2) xw)
+ (* ((matrix 1) 2) yw)
+ (* ((matrix 2) 2) zw))))
(set! xw xr)
(set! yw yr)
(set! zw zr)))
@@ -1935,7 +1948,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! xtr (cons xw xtr))
(set! ytr (cons yw ytr))
(set! ztr (cons zw ztr))))
-
+
(set! (path-tx path) (reverse xtr))
(set! (path-ty path) (reverse ytr))
(set! (path-tz path) (reverse ztr))))
@@ -1949,39 +1962,37 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; Scale a path
-(define (scale-path path)
+(define (scale-path path scaling)
(transform-path path :scaling scaling))
;;; Translate a path
-(define (translate-path path)
+(define (translate-path path translation)
(transform-path path :translation translation))
;;; Rotate a path
-(define* (rotate-path path rotation
- :key
- rotation-center
- (rotation-axis '(0.0 0.0 1.0)))
- "rotate-path is a dlocsig function that rotates a dlocsig path"
- (transform-path path
- :rotation rotation
- :rotation-center rotation-center
- :rotation-axis rotation-axis))
+(define rotate-path
+ (let ((documentation "rotate-path is a dlocsig function that rotates a dlocsig path"))
+ (lambda* (path rotation rotation-center (rotation-axis '(0.0 0.0 1.0)))
+ (transform-path path
+ :rotation rotation
+ :rotation-center rotation-center
+ :rotation-axis rotation-axis))))
;;; Mirror a path around an axis
(define* (mirror-path path (axis 'y) (around 0))
(if (not-transformed path)
(transform-path path))
- (if (equal axis 'y)
- (let ((val '()))
+ (if (eq? axis 'y)
+ (let ((val ()))
(for-each
(lambda (x)
(set! val (cons (- around x) val)))
(path-tx path))
(set! (path-tx path) (reverse val)))
- (let ((val '()))
+ (let ((val ()))
(for-each
(lambda (y)
(set! val (cons (- around y) val)))
@@ -1991,51 +2002,52 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;;; Change the times of the rendered envelope so that the velocity is constant
-(define (constant-velocity path)
- "constant-velocity is a dlocsig function that changes the times of the rendered envelope so that the velocity is constant"
- (if (not (path-rx path))
- (render-path path))
- (reset-transformation path)
- (let* ((xcoords (path-x path))
- (ycoords (path-y path))
- (zcoords (path-z path))
- (tcoords (path-time path))
- (total-distance
- (let* ((sum 0.0)
- (len (length xcoords)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let ((x1 (list-ref xcoords i))
- (x2 (list-ref xcoords (+ i 1)))
- (y1 (list-ref ycoords i))
- (y2 (list-ref ycoords (+ i 1)))
- (z1 (list-ref zcoords i))
- (z2 (list-ref zcoords (+ i 1))))
- (set! sum (+ sum (distance (- x2 x1) (- y2 y1) (- z2 z1))))))
- sum))
- (start-time (car tcoords))
- (end-time (list-ref tcoords (- (length tcoords) 1)))
- (total-time (- end-time start-time))
- (velocity (/ total-distance total-time)))
- (let ((len (length xcoords))
- (now '())
- (dist 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let* ((xp (list-ref xcoords i))
- (x (list-ref xcoords (+ i 1)))
- (yp (list-ref ycoords i))
- (y (list-ref ycoords (+ i 1)))
- (zp (list-ref zcoords i))
- (z (list-ref zcoords (+ i 1))))
- (set! dist (+ dist (distance (- x xp) (- y yp) (- z zp))))
- (set! now (cons (/ dist velocity) now))))
- (set! now (reverse now))
- (set! (path-rt path) (append (list start-time) now))
- (set! (path-tx path) (copy (path-rx path)))
- (set! (path-ty path) (copy (path-ry path)))
- (set! (path-tz path) (copy (path-rz path)))))
- path)
+(define constant-velocity
+ (let ((documentation "constant-velocity is a dlocsig function that changes the times of the rendered envelope so that the velocity is constant"))
+ (lambda (path)
+ (if (not (path-rx path))
+ (render-path path))
+ (reset-transformation path)
+ (let* ((xcoords (path-x path))
+ (ycoords (path-y path))
+ (zcoords (path-z path))
+ (tcoords (path-time path))
+ (total-distance
+ (let ((sum 0.0)
+ (len (length xcoords)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((x1 (xcoords i))
+ (x2 (xcoords (+ i 1)))
+ (y1 (ycoords i))
+ (y2 (ycoords (+ i 1)))
+ (z1 (zcoords i))
+ (z2 (zcoords (+ i 1))))
+ (set! sum (+ sum (distance (- x2 x1) (- y2 y1) (- z2 z1))))))
+ sum))
+ (start-time (car tcoords))
+ (end-time (tcoords (- (length tcoords) 1)))
+ (total-time (- end-time start-time))
+ (velocity (/ total-distance total-time)))
+ (let ((len (length xcoords))
+ (now ())
+ (dist 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((xp (xcoords i))
+ (x (xcoords (+ i 1)))
+ (yp (ycoords i))
+ (y (ycoords (+ i 1)))
+ (zp (zcoords i))
+ (z (zcoords (+ i 1))))
+ (set! dist (+ dist (distance (- x xp) (- y yp) (- z zp))))
+ (set! now (cons (/ dist velocity) now))))
+ (set! now (reverse now))
+ (set! (path-rt path) (append (list start-time) now))
+ (set! (path-tx path) (copy (path-rx path)))
+ (set! (path-ty path) (copy (path-ry path)))
+ (set! (path-tz path) (copy (path-rz path)))))
+ path)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2059,59 +2071,59 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(ambisonics-v-order dlocsig-ambisonics-v-order)
out-channels
rev-channels)
-
+
(if (null? start-time)
(error 'mus-error "ERROR: a start time is required in make-dlocsig~%"))
(if (null? duration)
(error 'mus-error "ERROR: a duration has to be specified in make-dlocsig~%"))
-
+
;; check to see if we have the right number of channels for b-format ambisonics
(if (= render-using ambisonics)
(begin
- (if (or (> ambisonics-h-order 2)
- (> ambisonics-v-order 2))
- (error 'mus-error "ERROR: ambisonics encoding is currently limited to second order components~%"))
- (let* ((channels (ambisonics-channels ambisonics-h-order ambisonics-v-order)))
+ (if (or (> ambisonics-h-order 3)
+ (> ambisonics-v-order 3))
+ (error 'mus-error "ERROR: ambisonics encoding is currently limited to third order components~%"))
+ (let ((channels (ambisonics-channels ambisonics-h-order ambisonics-v-order)))
(if (< (or out-channels (mus-channels *output*)) channels)
(error 'mus-error "ERROR: ambisonics number of channels is wrong, dlocsig needs ~A output channels for h:~A, v:~A order (current number is ~A)~%"
- channels ambisonics-h-order ambisonics-v-order (or out-channels (mus-channels *output*)))))))
-
+ channels ambisonics-h-order ambisonics-v-order (or out-channels (mus-channels *output*)))))))
+
(if (not out-channels)
(if *output*
(set! out-channels (channels *output*))
(begin
- (format #t "WARNING: no *output*? Will set out-channels to 2~%~%")
+ (format #t "WARNING: no *output*? Will set out-channels to 2~%")
(set! out-channels 2))))
(if (not rev-channels)
(set! rev-channels (if *reverb* (channels *reverb*) 0)))
-
+
(let* (;; speaker configuration for current number of channels
(speakers (if (= render-using ambisonics)
#f
(get-speaker-configuration out-channels)))
-
+
;; array of gains -- envelopes
- (channel-gains (make-vector out-channels '()))
- (channel-rev-gains (make-vector out-channels '()))
-
+ (channel-gains (make-vector out-channels ()))
+ (channel-rev-gains (make-vector out-channels ()))
+
;; speaker output delays
(max-out-delay 0.0)
(out-delays (make-vector out-channels))
-
+
;; coordinates of rendered path
(xpoints (path-x path))
(ypoints (path-y path))
(zpoints (path-z path))
(tpoints (path-time path))
-
+
;; speed of sound expressed in terms of path time coordinates
(speed-limit (/ (* dlocsig-speed-of-sound
(- (car (last tpoints)) (car tpoints)))
duration))
(start 0)
- (end 0)
- (delay '())
- (doppler '())
+ ;(end 0)
+ (dly ())
+ (doppler ())
(real-dur 0)
(prev-time #f)
(prev-dist #f)
@@ -2130,6 +2142,8 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(min-dist-unity #f)
(unity-gain 1.0)
(unity-rev-gain 1.0)
+ (amb-unity-gain 1.0)
+ (amb-unity-rev-gain 1.0)
(run-beg #f)
(run-end #f)
;; channel offsets in output stream for ambisonics
@@ -2142,11 +2156,18 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(s-offset #f)
(t-offset #f)
(u-offset #f)
- (v-offset #f))
-
+ (v-offset #f)
+ (k-offset #f)
+ (l-offset #f)
+ (m-offset #f)
+ (n-offset #f)
+ (o-offset #f)
+ (p-offset #f)
+ (q-offset #f))
+
(if (= render-using ambisonics)
;; calculate output channel offsets for ambisonics rendering
- (let* ((offset 3))
+ (let ((offset 3))
;; the default is at least a horizontal order of 1
(if (>= ambisonics-v-order 1)
(begin
@@ -2165,13 +2186,28 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; add U V
(set! u-offset offset)
(set! v-offset (+ offset 1))
- (set! offset (+ offset 2))))))
-
+ (set! offset (+ offset 2))))
+ (if (>= ambisonics-v-order 3)
+ (begin
+ ;; add K L M N O
+ (set! k-offset offset)
+ (set! l-offset (+ offset 1))
+ (set! m-offset (+ offset 2))
+ (set! n-offset (+ offset 3))
+ (set! o-offset (+ offset 4))
+ (set! offset (+ offset 5))))
+ (if (>= ambisonics-h-order 3)
+ (begin
+ ;; add P Q
+ (set! p-offset offset)
+ (set! q-offset (+ offset 1)))
+ (set! offset (+ offset 2)))))
+
(define (equalp-intersection l1 l2)
(if (null? l2)
l2
(let loop1 ((l1 l1)
- (result '()))
+ (result ()))
(cond ((null? l1)
(reverse! result))
((member (car l1) l2)
@@ -2180,11 +2216,11 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
result)))
(else (loop1 (cdr l1)
result))))))
-
- (define (dist->samples d) (inexact->exact (round (* d (/ (mus-srate) dlocsig-speed-of-sound)))))
- (define (dist->seconds d) (/ d dlocsig-speed-of-sound))
- (define (time->samples time) (inexact->exact (round (* time (mus-srate)))))
-
+
+ (define (dist->samples d) (round (* d (/ *clm-srate* dlocsig-speed-of-sound))))
+ ;; (define (dist->seconds d) (/ d dlocsig-speed-of-sound))
+ (define (time->samples time) (round (* time *clm-srate*)))
+
(define (transition-point-3 vert-a vert-b xa ya za xb yb zb)
(define (cross v1 v2)
(list (- (* (cadr v1) (third v2))
@@ -2195,21 +2231,21 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(* (cadr v1) (car v2)))))
(define (dot v1 v2)
(+ (* (car v1) (car v2))
- (* (cadr v1) (cadr v2))
- (* (third v1) (third v2))))
+ (* (cadr v1) (cadr v2))
+ (* (third v1) (third v2))))
(define (sub v1 v2)
(list (- (car v1) (car v2))
(- (cadr v1) (cadr v2))
(- (third v1) (third v2))))
(define (add v1 v2)
(list (+ (car v1) (car v2))
- (+ (cadr v1) (cadr v2))
- (+ (third v1) (third v2))))
+ (+ (cadr v1) (cadr v2))
+ (+ (third v1) (third v2))))
(define (scale v1 c)
(list (* (car v1) c)
- (* (cadr v1) c)
- (* (third v1) c)))
-
+ (* (cadr v1) c)
+ (* (third v1) c)))
+
(let* ((tolerance 1.0e-6)
(line-b (list xa ya za))
(line-m (sub (list xb yb zb) line-b))
@@ -2218,7 +2254,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(if (<= (abs denominator) tolerance)
#f
(add line-b (scale line-m (/ (- (dot normal line-b)) denominator))))))
-
+
;; calculate transition point between two adjacent two-speaker groups
;; original line intersection code from Graphic Gems III
(define (transition-point-2 vert xa ya xb yb)
@@ -2230,32 +2266,31 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(Cy (- ya))
(d (- (* By Cx) (* Bx Cy)))
(f (- (* Ay Bx) (* Ax By))))
- (if (= f 0)
- #f
- (list (/ (* d Ax) f)
- (/ (* d Ay) f)))))
-
+ (and (not (= f 0))
+ (list (/ (* d Ax) f)
+ (/ (* d Ay) f)))))
+
;; calculate speaker gains for group
(define (calculate-gains x y z group)
- (let* ((zero-coord 1.0e-10)
- (zero-gain 1.0e-10)
- (size (group-size group))
- (mat (group-matrix group))) ; returns mixer
+ (let ((zero-coord 1.0e-10)
+ (zero-gain 1.0e-10)
+ (size (group-size group))
+ (mat (group-matrix group))) ; returns float-vector
(if (and (< (abs x) zero-coord)
(< (abs y) zero-coord)
(< (abs z) zero-coord))
(list #t (list 1.0 1.0 1.0))
-
+
(if (= size 3)
- (let* ((gain-a (+ (* (mixer-ref mat 0 0) x)
- (* (mixer-ref mat 1 0) y)
- (* (mixer-ref mat 2 0) z)))
- (gain-b (+ (* (mixer-ref mat 0 1) x)
- (* (mixer-ref mat 1 1) y)
- (* (mixer-ref mat 2 1) z)))
- (gain-c (+ (* (mixer-ref mat 0 2) x)
- (* (mixer-ref mat 1 2) y)
- (* (mixer-ref mat 2 2) z)))
+ (let* ((gain-a (+ (* (mat 0 0) x)
+ (* (mat 1 0) y)
+ (* (mat 2 0) z)))
+ (gain-b (+ (* (mat 0 1) x)
+ (* (mat 1 1) y)
+ (* (mat 2 1) z)))
+ (gain-c (+ (* (mat 0 2) x)
+ (* (mat 1 2) y)
+ (* (mat 2 2) z)))
(mag (sqrt (+ (* gain-a gain-a)
(* gain-b gain-b)
(* gain-c gain-c)))))
@@ -2268,12 +2303,12 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! gain-c 0.0))
(list (and (>= gain-a 0) (>= gain-b 0) (>= gain-c 0))
(list (/ gain-a mag) (/ gain-b mag) (/ gain-c mag))))
-
+
(if (= size 2)
- (let* ((gain-a (+ (* (mixer-ref mat 0 0) x)
- (* (mixer-ref mat 1 0) y)))
- (gain-b (+ (* (mixer-ref mat 0 1) x)
- (* (mixer-ref mat 1 1) y)))
+ (let* ((gain-a (+ (* (mat 0 0) x)
+ (* (mat 1 0) y)))
+ (gain-b (+ (* (mat 0 1) x)
+ (* (mat 1 1) y)))
(mag (sqrt (+ (* gain-a gain-a)
(* gain-b gain-b)))))
;; truncate to zero roundoff errors
@@ -2283,10 +2318,10 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(set! gain-b 0.0))
(list (and (>= gain-a 0) (>= gain-b 0))
(list (/ gain-a mag) (/ gain-b mag))))
-
+
(if (= size 1)
(list #t (list 1.0))))))))
-
+
;; find the speaker group that contains a point
(define (find-group x y z)
(call-with-exit
@@ -2300,55 +2335,54 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(return (list group gains)))))
(speaker-config-groups speakers))
(list #f #f))))
-
+
;; push zero gains on all channels
(define (push-zero-gains time)
(let ((len (speaker-config-number speakers)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (vector-set! channel-gains i (cons time (vector-ref channel-gains i)))
- (vector-set! channel-gains i (cons 0.0 (vector-ref channel-gains i)))))
+ (set! (channel-gains i) (cons time (channel-gains i)))
+ (set! (channel-gains i) (cons 0.0 (channel-gains i)))))
(let ((len rev-channels))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (vector-set! channel-rev-gains i (cons time (vector-ref channel-rev-gains i)))
- (vector-set! channel-rev-gains i (cons 0.0 (vector-ref channel-rev-gains i))))))
-
+ (set! (channel-rev-gains i) (cons time (channel-rev-gains i)))
+ (set! (channel-rev-gains i) (cons 0.0 (channel-rev-gains i))))))
+
(define (position val lst)
(define (position-1 val lst pos)
(call-with-exit
(lambda (return)
- (if (null? lst)
- #f
- (if (= val (car lst))
- (return pos)
- (position-1 val (cdr lst) (+ 1 pos)))))))
+ (and (not (null? lst))
+ (if (= val (car lst))
+ (return pos)
+ (position-1 val (cdr lst) (+ 1 pos)))))))
(position-1 val lst 0))
-
+
;; push gain and time into envelopes
(define (push-gains group gains dist time num)
- (let* ((outputs (make-vector out-channels 0.0))
- (rev-outputs (make-vector rev-channels 0.0))
+ (let ((outputs (make-vector out-channels 0.0))
+ (rev-outputs (make-vector rev-channels 0.0))
;; attenuation with distance of direct signal
- (att (if (>= dist inside-radius)
+ (att (if (>= dist inside-radius)
(/ (expt dist direct-power))
(- 1.0 (expt (/ dist inside-radius) (/ inside-direct-power)))))
;; attenuation with distance of reverberated signal
- (ratt (if (>= dist inside-radius)
+ (ratt (if (>= dist inside-radius)
(/ (expt dist reverb-power))
(- 1.0 (expt (/ dist inside-radius) (/ inside-reverb-power))))))
(if (>= dist inside-radius)
;; outside the inner sphere, signal is sent to group
(let ((len (length gains)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((speaker (list-ref (group-speakers group) i))
- (gain (list-ref gains i)))
- (vector-set! outputs speaker (* gain att))
+ (let ((speaker ((group-speakers group) i))
+ (gain (gains i)))
+ (set! (outputs speaker) (* gain att))
(if (and (> rev-channels 1)
(< speaker (length rev-outputs)))
- (vector-set! rev-outputs speaker (* gain ratt))))))
-
+ (set! (rev-outputs speaker) (* gain ratt))))))
+
(let ((gain 0.0)
(len (speaker-config-number speakers)))
(do ((speaker 0 (+ 1 speaker)))
@@ -2358,42 +2392,41 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(if found
;; speaker belongs to group, add to existing gain
(begin
- (set! gain (list-ref gains found))
- (vector-set! outputs speaker (+ gain (* (- 1.0 gain) att)))
- (if (> rev-channels 1) (vector-set! rev-outputs speaker (+ gain (* (- 1.0 gain) ratt)))))
+ (set! gain (gains found))
+ (set! (outputs speaker) (+ gain (* (- 1.0 gain) att)))
+ (if (> rev-channels 1) (set! (rev-outputs speaker) (+ gain (* (- 1.0 gain) ratt)))))
;; speaker outside of group
(begin
- (vector-set! outputs speaker att)
- (if (> rev-channels 1) (vector-set! rev-outputs speaker ratt))))))))
-
+ (set! (outputs speaker) att)
+ (if (> rev-channels 1) (set! (rev-outputs speaker) ratt))))))))
+
;; push all channel gains into envelopes
(let ((len (speaker-config-number speakers)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (if (or (null? (vector-ref channel-gains i))
- (> time (cadr (vector-ref channel-gains i))))
+ (if (or (null? (channel-gains i))
+ (> time (cadr (channel-gains i))))
(begin
- (vector-set! channel-gains i (cons time (vector-ref channel-gains i)))
- (vector-set! channel-gains i (cons (vector-ref outputs i) (vector-ref channel-gains i)))))))
-
+ (set! (channel-gains i) (cons time (channel-gains i)))
+ (set! (channel-gains i) (cons (outputs i) (channel-gains i)))))))
+
(if (> rev-channels 1)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i rev-channels))
- (if (or (null? (vector-ref channel-rev-gains i))
- (> time (cadr (vector-ref channel-rev-gains i))))
+ (if (or (null? (channel-rev-gains i))
+ (> time (cadr (channel-rev-gains i))))
(begin
- (vector-set! channel-rev-gains i (cons time (vector-ref channel-rev-gains i)))
- (vector-set! channel-rev-gains i (cons (vector-ref rev-outputs i) (vector-ref channel-rev-gains i)))))))
-
+ (set! (channel-rev-gains i) (cons time (channel-rev-gains i)))
+ (set! (channel-rev-gains i) (cons (rev-outputs i) (channel-rev-gains i)))))))
+
;; push reverb gain into envelope for mono reverb
- (if (= rev-channels 1)
+ (if (and (= rev-channels 1)
+ (or (null? (channel-rev-gains 0))
+ (> time (cadr (channel-rev-gains 0)))))
(begin
- (if (or (null? (vector-ref channel-rev-gains 0))
- (> time (cadr (vector-ref channel-rev-gains 0))))
- (begin
- (vector-set! channel-rev-gains 0 (cons time (vector-ref channel-rev-gains 0)))
- (vector-set! channel-rev-gains 0 (cons ratt (vector-ref channel-rev-gains 0)))))))))
-
+ (set! (channel-rev-gains 0) (cons time (channel-rev-gains 0)))
+ (set! (channel-rev-gains 0) (cons ratt (channel-rev-gains 0)))))))
+
;; Render a trajectory breakpoint through amplitude panning
(define (famplitude-panning x y z dist time q)
;; output gains for current point
@@ -2403,9 +2436,9 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(gains (cadr vals)))
;; check that the source is not moving faster than sound
(if (not (= time prev-time))
- (let* ((speed (/ (- dist prev-dist) (- time prev-time))))
+ (let ((speed (/ (- dist prev-dist) (- time prev-time))))
(if (> speed speed-limit)
- (format #t "WARNING: supersonic radial movement at [~F,~F,~F, ~F], speed=~F~%~%" x y z time speed))))
+ (format #t "WARNING: supersonic radial movement at [~F,~F,~F, ~F], speed=~F~%" x y z time speed))))
(if inside
;; still in the same group
(begin
@@ -2421,12 +2454,12 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; we have to interpolate a new point that lies on the shared
;; edge of the adjacent groups so that the speakers opposite
;; the edge have zero gain when the trajectory switches groups
- (let* ((edge (equalp-intersection (group-vertices group)
+ (let ((edge (equalp-intersection (group-vertices group)
(group-vertices prev-group))))
(if (= (length edge) 2)
;; the groups have two shared points (ie: share an edge)
;; this must be a three speaker groups transition
- (let* ((pint (transition-point-3 (car edge) (cadr edge) x y z prev-x prev-y prev-z)))
+ (let ((pint (transition-point-3 (car edge) (cadr edge) x y z prev-x prev-y prev-z)))
(if pint
(let* ((xi (car pint))
(yi (cadr pint))
@@ -2453,11 +2486,11 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(push-gains group gains di ti 3)
;; how did we get here?
(error 'mus-error "ERROR: Outside of both adjacent groups [~A:~A:~A @~A]~%~%" xi yi zi ti))))))))
-
+
(if (and (= (length edge) 1) (= (group-size group) 2))
;; two two-speaker groups share one point
;; z coordinates are silently ignored
- (let* ((pint (transition-point-2 (car edge) x y prev-x prev-y)))
+ (let ((pint (transition-point-2 (car edge) x y prev-x prev-y)))
(if pint
(let* ((xi (car pint))
(yi (cadr pint))
@@ -2488,26 +2521,26 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; we should calculate two additional interpolated
;; points as the trajectory must be crossing a third
;; group
- (begin
- (for-each
- (lambda (int-group)
- (if (and (member (car edge) (group-vertices int-group))
- (not (equal? int-group group))
- (not (equal? int-group prev-group)))
- (let* ((edge1 (equal-intersection (group-vertices int-group)
- (group-vertices prev-group)))
- (edge2 (equal-intersection (group-vertices int-group)
- (group-vertices group))))
- (format #t "e1=~A; e2=~A~%~%" edge1 edge2))))
- (speaker-config-groups speakers))
- (format #t "WARNING: crossing between groups with only one point in common~% prev=~A~% curr=~A~%~%" prev-group group))
-
- ;; groups don't share points... how did we get here?
- (if (= (length edge) 0)
- (format #t "WARNING: crossing between groups with no common points, ~A~A to ~A~A~%~%"
- (group-id prev-group) (group-speakers prev-group)
- (group-id group) (group-speakers group))))))
-
+ (begin
+ (for-each
+ (lambda (int-group)
+ (if (and (member (car edge) (group-vertices int-group))
+ (not (equal? int-group group))
+ (not (equal? int-group prev-group)))
+ (let ((edge1 (equalp-intersection (group-vertices int-group)
+ (group-vertices prev-group)))
+ (edge2 (equalp-intersection (group-vertices int-group)
+ (group-vertices group))))
+ (format #t "e1=~A; e2=~A~%~%" edge1 edge2))))
+ (speaker-config-groups speakers))
+ (format #t "WARNING: crossing between groups with only one point in common~% prev=~A~% curr=~A~%" prev-group group))
+
+ ;; groups don't share points... how did we get here?
+ (if (= (length edge) 0)
+ (format #t "WARNING: crossing between groups with no common points, ~A~A to ~A~A~%"
+ (group-id prev-group) (group-speakers prev-group)
+ (group-id group) (group-speakers group))))))
+
;; finally push gains for current group
(push-gains group gains dist time 6)
(set! prev-group group)
@@ -2533,7 +2566,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(begin
(push-zero-gains time)
(set! prev-group #f))))))
-
+
;; Render a trajectory breakpoint for ambisonics b-format coding
;; http://www.york.ac.uk/inst/mustech/3d_audio/ambis2.htm
;;
@@ -2546,6 +2579,15 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; T sin(A)sin(2E) 2yz
;; U cos(2A)cos(E)cos(E) xx-yy
;; V sin(2A)cos(E)cos(E) 2xy
+ ;; K z(2.5zz-1.5)
+ ;; L K1(x(5zz-1)
+ ;; K1=sqrt(21*45/(224*8))
+ ;; M K1(y(5zz-1))
+ ;; N K2(Uz)
+ ;; K2=sqrt(3)*3/2
+ ;; O K2(Vz)
+ ;; P x(xx-3yy)
+ ;; Q y(3xx-yy)
;;
;; where:
;; A: counter-clockwise angle of rotation from the front center
@@ -2569,6 +2611,14 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; U: (* signal (- (* x x 1/dist 1/dist) (* y y 1/dist 1/dist)))
;; V: (* signal 2 (- x) y 1/dist 1/dist)
;;
+ ;; K: (* signal z (- (* 2.5 z z 1/dist 1/dist) 1.5))
+ ;; L: (* signal K1 x 1/dist (- (* 5 z z 1/dist 1/dist) 1))
+ ;; M: (* signal K1 y 1/dist (- (* 5 z z 1/dist 1/dist) 1))
+ ;; N: (* signal K2 U z 1/dist)
+ ;; O: (* signal K2 V z 1/dist)
+ ;; P: (* signal x 1/dist (- (* x x 1/dist 1/dist) (* 3 y y 1/dist 1/dist)))
+ ;; Q: (* signal y 1/dist (- (* 3 x x 1/dist 1/dist) (* y y 1/dist 1/dist)))
+ ;;
;; see also: http://wiki.xiph.org/index.php/Ambisonics
;; for mixed order systems
;;
@@ -2584,101 +2634,170 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(expt (/ dist inside-radius) (/ inside-reverb-power))))
(rattW (if (> dist inside-radius)
(* point707 ratt)
- (- 1 (* (- 1 point707) (expt (/ dist inside-radius) reverb-power))))))
+ (- 1 (* (- 1 point707) (expt (/ dist inside-radius) reverb-power)))))
+ ;; storage for some intermediate calculations
+ (u 0)
+ (v 0)
+ (lm 0)
+ (no 0))
;; output encoding gains for point
;; W: 0.707
- (vector-set! channel-gains w-offset (cons time (vector-ref channel-gains w-offset)))
- (vector-set! channel-gains w-offset (cons attW (vector-ref channel-gains w-offset)))
+ (set! (channel-gains w-offset) (cons time (channel-gains w-offset)))
+ (set! (channel-gains w-offset) (cons attW (channel-gains w-offset)))
;; X: (* (cos A) (cos E))
- (vector-set! channel-gains x-offset (cons time (vector-ref channel-gains x-offset)))
- (vector-set! channel-gains x-offset (cons (* (if (zero? dist) 0 (/ y dist)) att) (vector-ref channel-gains x-offset)))
+ (set! (channel-gains x-offset) (cons time (channel-gains x-offset)))
+ (set! (channel-gains x-offset) (cons (* (if (zero? dist) 0 (/ y dist)) att) (channel-gains x-offset)))
;; Y: (* (sin A) (cos E))
- (vector-set! channel-gains y-offset (cons time (vector-ref channel-gains y-offset)))
- (vector-set! channel-gains y-offset (cons (* (if (zero? dist) 0 (/ (- x) dist)) att) (vector-ref channel-gains y-offset)))
+ (set! (channel-gains y-offset) (cons time (channel-gains y-offset)))
+ (set! (channel-gains y-offset) (cons (* (if (zero? dist) 0 (/ (- x) dist)) att) (channel-gains y-offset)))
(if (>= ambisonics-v-order 1)
(begin
;; Z: (sin E)
- (vector-set! channel-gains z-offset (cons time (vector-ref channel-gains z-offset)))
- (vector-set! channel-gains z-offset (cons (* (if (zero? dist) 0 (/ z dist)) att) (vector-ref channel-gains z-offset)))))
+ (set! (channel-gains z-offset) (cons time (channel-gains z-offset)))
+ (set! (channel-gains z-offset) (cons (* (if (zero? dist) 0 (/ z dist)) att) (channel-gains z-offset)))))
(if (>= ambisonics-v-order 2)
(begin
;; R
- (vector-set! channel-gains r-offset (cons time (vector-ref channel-gains r-offset)))
- (vector-set! channel-gains r-offset (cons (* (if (zero? dist) 0 (- (* 1.5 z z (if (zerop dist) 1 (/ 1 (* dist dist)))) 0.5) att)
- (vector-ref channel-gains r-offset))))
+ (set! (channel-gains r-offset) (cons time (channel-gains r-offset)))
+ (set! (channel-gains r-offset) (cons (* (if (zero? dist) 0 (- (* 1.5 z z (if (zero? dist) 1 (/ 1.0 (* dist dist)))) 0.5)) att)
+ (channel-gains r-offset)))
;; S
- (vector-set! channel-gains s-offset (cons time (vector-ref channel-gains s-offset)))
- (vector-set! channel-gains s-offset (cons (* (if (zero? dist) 0 2) z (- x) (if (zero? dist) 1 (/ 1 (* dist dist))) att)
- (vector-ref channel-gains s-offset)))
+ (set! (channel-gains s-offset) (cons time (channel-gains s-offset)))
+ (set! (channel-gains s-offset) (cons (* (if (zero? dist) 0 2) z (- x) (if (zero? dist) 1 (/ 1.0 (* dist dist))) att)
+ (channel-gains s-offset)))
;; T
- (vector-set! channel-gains t-offset (cons time (vector-ref channel-gains t-offset)))
- (vector-set! channel-gains t-offset (cons (* (if (zero? dist) 0 2) z y (if (zero? dist) 1 (/ 1 (* dist dist))) att)
- (vector-ref channel-gains t-offset)))))
+ (set! (channel-gains t-offset) (cons time (channel-gains t-offset)))
+ (set! (channel-gains t-offset) (cons (* (if (zero? dist) 0 2) z y (if (zero? dist) 1 (/ 1.0 (* dist dist))) att)
+ (channel-gains t-offset)))))
(if (>= ambisonics-h-order 2)
(begin
+ (set! u (* (if (zero? dist) 0 1) (- (* x x (if (zero? dist) 1 (/ 1.0 (* dist dist))))
+ (* y y (if (zero? dist) 1 (/ 1.0 (* dist dist))))) att))
+ (set! v (* (if (zero? dist) 0 2) (- x) y (if (zero? dist) 1 (/ 1.0 (* dist dist))) att))
;; U
- (vector-set! channel-gains u-offset (cons time (vector-ref channel-gains u-offset)))
- (vector-set! channel-gains u-offset (cons (* (if (zero? dist) 0 1) (- (* x x (if (zero? dist) 1 (/ 1 (* dist dist))))
- (* y y (if (zero? dist) 1 (/ 1 (* dist dist))))) att)
- (vector-ref channel-gains u-offset)))
+ (set! (channel-gains u-offset) (cons time (channel-gains u-offset)))
+ (set! (channel-gains u-offset) (cons u (channel-gains u-offset)))
;; V
- (vector-set! channel-gains v-offset (cons time (vector-ref channel-gains v-offset)))
- (vector-set! channel-gains v-offset (cons (* (if (zero? dist) 0 2) (- x) y (if (zero? dist) 1 (/ 1 (* dist dist))) att)
- (vector-ref channel-gains v-offset)))))
+ (set! (channel-gains v-offset) (cons time (channel-gains v-offset)))
+ (set! (channel-gains v-offset) (cons v (channel-gains v-offset)))))
+ (if (>= ambisonics-v-order 3)
+ (begin
+ (set! lm (* ambisonics-k1 (- (* 5 z z (if (zero? dist) 1 (/ 1.0 (* dist dist)))) 1) att))
+ (set! no (* ambisonics-k2 z (if (zero? dist) 1 (/ dist)) att))
+ ;; K
+ (set! (channel-gains k-offset) (cons time (channel-gains k-offset)))
+ (set! (channel-gains k-offset) (cons (* (if (zero? dist) 0 1) (- (* 2.5 z z (if (zero? dist) 1 (/ 1.0 (* dist dist)))) 1.5) att) (channel-gains k-offset)))
+ ;; L
+ (set! (channel-gains l-offset) (cons time (channel-gains l-offset)))
+ (set! (channel-gains l-offset) (cons (* (if (zero? dist) 0 (/ x dist)) lm) (channel-gains l-offset)))
+ ;; M
+ (set! (channel-gains m-offset) (cons time (channel-gains m-offset)))
+ (set! (channel-gains m-offset) (cons (* (if (zero? dist) 0 (/ y dist)) lm) (channel-gains m-offset)))
+ ;; N
+ (set! (channel-gains n-offset) (cons time (channel-gains n-offset)))
+ (set! (channel-gains n-offset) (cons (* (if (zero? dist) 0 no) u) (channel-gains n-offset)))
+ ;; O
+ (set! (channel-gains o-offset) (cons time (channel-gains o-offset)))
+ (set! (channel-gains o-offset) (cons (* (if (zero? dist) 0 no) v) (channel-gains o-offset)))))
+ (if (>= ambisonics-h-order 3)
+ (begin
+ ;; P
+ (set! (channel-gains p-offset) (cons time (channel-gains p-offset)))
+ (set! (channel-gains p-offset) (cons (* (if (zero? dist) 0 (/ att dist)) x
+ (- (* x x (if (zero? dist) 1 (/ 1.0 (* dist dist))))
+ (* 3 y y (if (zero? dist) 1 (/ 1.0 (* dist dist)))))) (channel-gains p-offset)))
+ ;; Q
+ (set! (channel-gains q-offset) (cons time (channel-gains q-offset)))
+ (set! (channel-gains q-offset) (cons (* (if (zero? dist) 0 (/ att dist)) y
+ (- (* 3 x x (if (zero? dist) 1 (/ 1.0 (* dist dist))))
+ (* y y (if (zero? dist) 1 (/ 1.0 (* dist dist)))))) (channel-gains q-offset)))))
;; push reverb gain into envelope
(if (= rev-channels 1)
(begin
;; mono reverb output
- (vector-set! channel-rev-gains 0 (cons time (vector-ref channel-rev-gains 0)))
- (vector-set! channel-rev-gains 0 (cons (if (>= dist inside-radius)
- (/ (expt dist reverb-power))
- (- 1.0 (expt (/ dist inside-radius) (/ inside-reverb-power))))
- (vector-ref channel-rev-gains 0)))))
+ (set! (channel-rev-gains 0) (cons time (channel-rev-gains 0)))
+ (set! (channel-rev-gains 0) (cons (if (>= dist inside-radius)
+ (/ (expt dist reverb-power))
+ (- 1.0 (expt (/ dist inside-radius) (/ inside-reverb-power))))
+ (channel-rev-gains 0)))))
(if (> rev-channels 1)
- (begin
+ (let ((ho-ratt dlocsig-ambisonics-ho-rev-scaler))
;; multichannel reverb, send ambisonics components
;; W: 0.707
- (vector-set! channel-rev-gains w-offset (cons time (vector-ref channel-rev-gains w-offset)))
- (vector-set! channel-rev-gains w-offset (cons rattW (vector-ref channel-rev-gains w-offset)))
+ (set! (channel-rev-gains w-offset) (cons time (channel-rev-gains w-offset)))
+ (set! (channel-rev-gains w-offset) (cons rattW (channel-rev-gains w-offset)))
;; X: (* (cos A)(cos E))
- (vector-set! channel-rev-gains x-offset (cons time (vector-ref channel-rev-gains x-offset)))
- (vector-set! channel-rev-gains x-offset (cons (* (if (zero? dist) 0 1) y (if (zerop dist) 1 (/ dist)) ratt)(vector-ref channel-rev-gains x-offset)))
+ (set! (channel-rev-gains x-offset) (cons time (channel-rev-gains x-offset)))
+ (set! (channel-rev-gains x-offset) (cons (* (if (zero? dist) 0 1) y (if (zero? dist) 1 (/ dist)) ratt)(channel-rev-gains x-offset)))
;; Y: (* (sin A)(cos E))
- (vector-set! channel-rev-gains y-offset (cons time (vector-ref channel-rev-gains y-offset)))
- (vector-set! channel-rev-gains y-offset (cons (* (if (zero? dist) 0 1) (- x) (if (zerop dist) 1 (/ dist)) ratt)
- (vector-ref channel-rev-gains y-offset)))
+ (set! (channel-rev-gains y-offset) (cons time (channel-rev-gains y-offset)))
+ (set! (channel-rev-gains y-offset) (cons (* (if (zero? dist) 0 1) (- x) (if (zero? dist) 1 (/ dist)) ratt)
+ (channel-rev-gains y-offset)))
(if (>= ambisonics-v-order 1)
(begin
;; Z: (sin E)
- (vector-set! channel-rev-gains z-offset (cons time (vector-ref channel-rev-gains z-offset)))
- (vector-set! channel-rev-gains z-offset (cons (* (if (zero? dist) 0 1) z (if (zerop dist) 1 (/ dist)) ratt)
- (vector-ref channel-rev-gains z-offset)))))
+ (set! (channel-rev-gains z-offset) (cons time (channel-rev-gains z-offset)))
+ (set! (channel-rev-gains z-offset) (cons (* (if (zero? dist) 0 1) z (if (zero? dist) 1 (/ dist)) ratt)
+ (channel-rev-gains z-offset)))))
(if (>= ambisonics-v-order 2)
(begin
;; R
- (vector-set! channel-rev-gains r-offset (cons time (vector-ref channel-rev-gains r-offset)))
- (vector-set! channel-rev-gains r-offset (cons (* (if (zero? dist) 0 (- (* 1.5 z z (if (zero? dist) 1 (/ 1 (* dist dist)))) 0.5)) ho-ratt ratt)
- (vector-ref channel-rev-gains r-offset)))
+ (set! (channel-rev-gains r-offset) (cons time (channel-rev-gains r-offset)))
+ (set! (channel-rev-gains r-offset) (cons (* (if (zero? dist) 0 (- (* 1.5 z z (if (zero? dist) 1 (/ 1.0 (* dist dist)))) 0.5)) ho-ratt ratt)
+ (channel-rev-gains r-offset)))
;; S
- (vector-set! channel-rev-gains s-offset (cons time (vector-ref channel-rev-gains s-offset)))
- (vector-set! channel-rev-gains s-offset (cons (* (if (zero? dist) 0 2) z (- x) (if (zero? dist) 1 (/ 1 (* dist dist))) ho-ratt ratt)
- (vector-ref channel-rev-gains s-offset)))
+ (set! (channel-rev-gains s-offset) (cons time (channel-rev-gains s-offset)))
+ (set! (channel-rev-gains s-offset) (cons (* (if (zero? dist) 0 2) z (- x) (if (zero? dist) 1 (/ 1.0 (* dist dist))) ho-ratt ratt)
+ (channel-rev-gains s-offset)))
;; T
- (vector-set! channel-rev-gains t-offset (cons time (vector-ref channel-rev-gains t-offset)))
- (vector-set! channel-rev-gains t-offset (cons (* (if (zero? dist) 0 2) z y (if (zero? dist) 1 (/ 1 (* dist dist))) ho-ratt ratt)
- (vector-ref channel-rev-gains t-offset)))))
+ (set! (channel-rev-gains t-offset) (cons time (channel-rev-gains t-offset)))
+ (set! (channel-rev-gains t-offset) (cons (* (if (zero? dist) 0 2) z y (if (zero? dist) 1 (/ 1.0 (* dist dist))) ho-ratt ratt)
+ (channel-rev-gains t-offset)))))
(if (>= ambisonics-h-order 2)
(begin
;; U
- (vector-set! channel-rev-gains u-offset (cons time (vector-ref channel-rev-gains u-offset)))
- (vector-set! channel-rev-gains u-offset (cons (* (if (zero? dist) 0 (- (* x x (if (zero? dist) 1 (/ 1 (* dist dist))))
- (* y y (if (zero? dist) 1 (/ 1 (* dist dist)))))) ho-ratt ratt)
- (vector-ref channel-rev-gains u-offset)))
+ (set! (channel-rev-gains u-offset) (cons time (channel-rev-gains u-offset)))
+ (set! (channel-rev-gains u-offset) (cons (* (if (zero? dist) 0 (- (* x x (if (zero? dist) 1 (/ 1.0 (* dist dist))))
+ (* y y (if (zero? dist) 1 (/ 1.0 (* dist dist)))))) ho-ratt ratt)
+ (channel-rev-gains u-offset)))
;; V
- (vector-set! channel-rev-gains v-offset (cons time (vector-ref channel-rev-gains v-offset)))
- (vector-set! channel-rev-gains v-offset (cons (* (if (zero? dist) 0 2) (- x) y (if (zero? dist) 1 (/ 1 (* dist dist))) ho-ratt ratt)
- (vector-ref channel-rev-gains v-offset)))))))))
+ (set! (channel-rev-gains v-offset) (cons time (channel-rev-gains v-offset)))
+ (set! (channel-rev-gains v-offset) (cons (* (if (zero? dist) 0 2) (- x) y (if (zero? dist) 1 (/ 1.0 (* dist dist))) ho-ratt ratt)
+ (channel-rev-gains v-offset)))))
+ (if (>= ambisonics-v-order 3)
+ (begin
+ (set! lm (* ambisonics-k1 (- (* 5 z z (if (zero? dist) 1 (/ 1.0 (* dist dist)))) 1) ho-ratt ratt))
+ (set! no (* ambisonics-k2 z (if (zero? dist) 1 (/ dist)) ratt))
+ ;; K
+ (set! (channel-rev-gains k-offset) (cons time (channel-rev-gains k-offset)))
+ (set! (channel-rev-gains k-offset) (cons (* (if (zero? dist) 0 1) (- (* 2.5 z z (if (zero? dist) 1 (/ 1.0 (* dist dist)))) 1.5) ho-ratt ratt) (channel-rev-gains k-offset)))
+ ;; L
+ (set! (channel-rev-gains l-offset) (cons time (channel-rev-gains l-offset)))
+ (set! (channel-rev-gains l-offset) (cons (* (if (zero? dist) 0 (/ x dist)) lm) (channel-rev-gains l-offset)))
+ ;; M
+ (set! (channel-rev-gains m-offset) (cons time (channel-rev-gains m-offset)))
+ (set! (channel-rev-gains m-offset) (cons (* (if (zero? dist) 0 (/ y dist)) lm) (channel-rev-gains m-offset)))
+ ;; N
+ (set! (channel-rev-gains n-offset) (cons time (channel-rev-gains n-offset)))
+ (set! (channel-rev-gains n-offset) (cons (* (if (zero? dist) 0 no) u) (channel-rev-gains n-offset)))
+ ;; O
+ (set! (channel-rev-gains o-offset) (cons time (channel-rev-gains o-offset)))
+ (set! (channel-rev-gains o-offset) (cons (* (if (zero? dist) 0 no) v) (channel-rev-gains o-offset)))))
+ (if (>= ambisonics-h-order 3)
+ (begin
+ ;; P
+ (set! (channel-rev-gains p-offset) (cons time (channel-rev-gains p-offset)))
+ (set! (channel-rev-gains p-offset) (cons (* (if (zero? dist) 0 (/ ratt dist)) ho-ratt x
+ (- (* x x (if (zero? dist) 1 (/ 1.0 (* dist dist))))
+ (* 3 y y (if (zero? dist) 1 (/ 1.0 (* dist dist)))))) (channel-rev-gains p-offset)))
+ ;; Q
+ (set! (channel-rev-gains q-offset) (cons time (channel-rev-gains q-offset)))
+ (set! (channel-rev-gains q-offset) (cons (* (if (zero? dist) 0 (/ ratt dist)) ho-ratt y
+ (- (* 3 x x (if (zero? dist) 1 (/ 1.0 (* dist dist))))
+ (* y y (if (zero? dist) 1 (/ 1.0 (* dist dist)))))) (channel-rev-gains q-offset)))))
+ ))))
+
;; Render a trajectory breakpoint to a room for decoded ambisonics
;;
;; for a given speaker located in 3d space in polar coordinates:
@@ -2705,9 +2824,9 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; output decoded gains for point
(let ((len (speaker-config-number speakers))
(spkrs (speaker-config-coords speakers)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let* ((s (list-ref spkrs i))
+ (let* ((s (spkrs i))
(signal (* dlocsig-ambisonics-scaler
(+
;; W
@@ -2718,22 +2837,22 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(* att (if (= dist 0) 0 (/ x dist)) (car s))
;; (* Z (sin el)
(* att (if (= dist 0) 0 (/ z dist)) (third s))))))
- (vector-set! channel-gains i (cons time (vector-ref channel-gains i)))
- (vector-set! channel-gains i (cons signal (vector-ref channel-gains i))))))
-
+ (set! (channel-gains i) (cons time (channel-gains i)))
+ (set! (channel-gains i) (cons signal (channel-gains i))))))
+
;; push reverb gain into envelope
(if (= rev-channels 1)
(begin
;; mono reverberation
- (vector-set! channel-rev-gains 0 (cons time (vector-ref channel-rev-gains 0)))
- (vector-set! channel-rev-gains 0 (cons (if (>= dist inside-radius)
- (/ (expt dist reverb-power))
- (- 1.0 (expt (/ dist inside-radius) (/ inside-reverb-power))))
- (vector-ref channel-rev-gains 0))))
+ (set! (channel-rev-gains 0) (cons time (channel-rev-gains 0)))
+ (set! (channel-rev-gains 0) (cons (if (>= dist inside-radius)
+ (/ (expt dist reverb-power))
+ (- 1.0 (expt (/ dist inside-radius) (/ inside-reverb-power))))
+ (channel-rev-gains 0))))
;; multichannel reverb
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i rev-channels))
- (let* ((s (list-ref (speaker-config-coords speakers) i))
+ (let* ((s ((speaker-config-coords speakers) i))
(signal (* dlocsig-ambisonics-scaler
(+
;; W
@@ -2744,9 +2863,9 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(* ratt (if (zero? dist) 0 (/ x dist)) (car s))
;; (* Z (sin el)
(* ratt (if (zero? dist) 0 (/ z dist)) (third s))))))
- (vector-set! channel-rev-gains i (cons time (vector-ref channel-rev-gains i)))
- (vector-set! channel-rev-gains i (cons signal (vector-ref channel-rev-gains i))))))))
-
+ (set! (channel-rev-gains i) (cons time (channel-rev-gains i)))
+ (set! (channel-rev-gains i) (cons signal (channel-rev-gains i))))))))
+
;; Loop through all virtual rooms for one breakpoint in the trajectory
(define (walk-all-rooms x y z time num)
(let ((room 0)
@@ -2761,11 +2880,11 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(if (or (not max-dist) (> dist max-dist))
(set! max-dist dist))
;; push delay for current point (for doppler)
- (if (or (null? delay)
- (> time (cadr delay)))
+ (if (or (null? dly)
+ (> time (cadr dly)))
(begin
- (set! delay (cons time delay))
- (set! delay (cons (dist->samples dist) delay))
+ (set! dly (cons time dly))
+ (set! dly (cons (dist->samples dist) dly))
;; doppler should be easy, yeah right. We use "relativistic" correction
;; as the sound object can be travelling close to the speed of sound.
;; http://www.mathpages.com/rr/s2-04/2-04.htm,
@@ -2773,10 +2892,10 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; ve = moving object
;; va = (* ve (/ 1 (+ 1 (/ ve c))) (sqrt (- 1 (* (/ ve c) (/ ve c)))))
(if prev-time
- (let* ((ratio (/ (- dist prev-dist)
+ (let ((ratio (/ (- dist prev-dist)
(* duration (- time prev-time) dlocsig-speed-of-sound))))
(set! doppler (cons (/ (+ prev-time time) 2) doppler))
- (set! doppler (cons (* (/ 1 (+ 1 ratio)) (sqrt (- 1 (* ratio ratio)))) doppler))))))
+ (set! doppler (cons (* (/ 1.0 (+ 1 ratio)) (sqrt (- 1 (* ratio ratio)))) doppler))))))
;; do the rendering of the point
(if (= render-using amplitude-panning)
;; amplitude panning
@@ -2787,14 +2906,14 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(if (= render-using decoded-ambisonics)
;; ambisonics decoded
(fdecoded-ambisonics x y z dist time))))
-
+
(set! room (+ 1 room))
;; remember current time and distance for next point
(set! prev-time time)
(set! prev-dist dist)
;; return number of rooms processed
room))
-
+
;; Check to see if a segment changes radial direction:
;; a change in radial direction implies a change in
;; doppler shift that has to be reflected as a new
@@ -2818,7 +2937,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(distance (- xb xa) (- yb ya) (- zb za)))))
2
)))))
-
+
;; Check to see if a segment intersects the inner sphere:
;; points inside are rendered differently so we need to
;; create additional envelope points in the boundaries
@@ -2838,7 +2957,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(rin (- (- bsq) root))
(rout (+ (- bsq) root))
(xi #f) (yi #f) (zi #f) (ti #f) (xo #f) (yo #f) (zo #f) (to #f))
- (if (and (> rin 0) (< rin mag))
+ (if (> mag rin 0) ;(and (> rin 0) (< rin mag))
;; intersects entering sphere
(begin
(set! xi (+ xa (* vx rin)))
@@ -2870,13 +2989,13 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(change-direction xo yo zo to xb yb zb tb 6))
(change-direction xa ya za ta xb yb zb tb 7))))
(change-direction xa ya za ta xb yb zb tb 8))))
-
+
;; Recursively split segment if longer than minimum rendering distance:
;; otherwise long line segments that have changes in distance render
;; the amplitude envelope as a linear function that does not reflect
;; the chosen power function (1/d^n)
(define (fminimum-segment-length xa ya za ta xb yb zb tb)
- (let* ((dist (distance (- xb xa) (- yb ya) (- zb za))))
+ (let ((dist (distance (- xb xa) (- yb ya) (- zb za))))
(if (< dist minimum-segment-length)
(intersects-inside-radius xa ya za ta xb yb zb tb)
;; interpolate a new point half way thorugh the segment
@@ -2888,77 +3007,78 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(distance (- xb xa) (- yb ya) (- zb za)))))))
(fminimum-segment-length xa ya za ta xi yi zi ti)
(fminimum-segment-length xi yi zi ti xb yb zb tb)))))
-
-
- ;; Loop for each pair of points in the position envelope and render them
- (if (= (length xpoints) 1)
- ;; static source (we should check if this is inside the inner radius?)
- (walk-all-rooms (car xpoints) (car ypoints) (car zpoints) (car tpoints) 3)
-
- ;; moving source
- (let ((len (- (min (length xpoints) (length ypoints) (length zpoints) (length tpoints)) 1)))
- (do ((i 0 (+ 1 i)))
- ((>= i len))
- (let* ((xa (list-ref xpoints i))
- (ya (list-ref ypoints i))
- (za (list-ref zpoints i))
- (ta (list-ref tpoints i))
- (xb (list-ref xpoints (+ i 1)))
- (yb (list-ref ypoints (+ i 1)))
- (zb (list-ref zpoints (+ i 1)))
- (tb (list-ref tpoints (+ i 1))))
- (fminimum-segment-length xa ya za ta xb yb zb tb)
- (if (= i len)
- (walk-all-rooms xb yb zb tb 4))))))
-
+
;; returns the new duration of a sound after using an envelope for time-varying sampling-rate conversion
;; (from Bill's dsp.scm)
(define (src-duration e)
(let* ((len (length e))
(ex0 (car e))
- (ex1 (list-ref e (- len 2)))
+ (ex1 (e (- len 2)))
(all-x (- ex1 ex0))
(dur 0.0))
(do ((i 0 (+ i 2)))
((>= i (- len 2)) dur)
- (let* ((x0 (list-ref e i))
- (x1 (list-ref e (+ i 2)))
- (y0 (list-ref e (+ i 1))) ; 1/x x points
- (y1 (list-ref e (+ i 3)))
- (area (if (< (abs (- y0 y1)) .0001)
+ (let* ((x0 (e i))
+ (x1 (e (+ i 2)))
+ (y0 (e (+ i 1))) ; 1/x x points
+ (y1 (e (+ i 3)))
+ (area (if (< (abs (real-part (- y0 y1))) .0001)
(/ (- x1 x0) (* y0 all-x))
(* (/ (- (log y1) (log y0))
(- y1 y0))
(/ (- x1 x0) all-x)))))
- (set! dur (+ dur (abs area)))))))
-
+ (set! dur (+ dur (abs (real-part area))))))))
+
+ ;; Loop for each pair of points in the position envelope and render them
+ (if (= (length xpoints) 1)
+ ;; static source (we should check if this is inside the inner radius?)
+ (walk-all-rooms (car xpoints) (car ypoints) (car zpoints) (car tpoints) 3)
+
+ ;; moving source
+ (let ((len (- (min (length xpoints) (length ypoints) (length zpoints) (length tpoints)) 1)))
+ (do ((i 0 (+ i 1)))
+ ((>= i len))
+ (let ((xa (xpoints i))
+ (ya (ypoints i))
+ (za (zpoints i))
+ (ta (tpoints i))
+ (xb (xpoints (+ i 1)))
+ (yb (ypoints (+ i 1)))
+ (zb (zpoints (+ i 1)))
+ (tb (tpoints (+ i 1))))
+ (fminimum-segment-length xa ya za ta xb yb zb tb)
+ (if (= i len)
+ (walk-all-rooms xb yb zb tb 4))))))
+
;; create delay lines for output channels that need them
(if speakers
(let* ((delays (speaker-config-delays speakers))
(len (length delays)))
(do ((channel 0 (+ 1 channel)))
((= channel len))
- (let ((delayo (vct-ref delays channel)))
- (vector-set! out-delays channel (if (not (= delayo 0.0))
- (make-delay (time->samples delayo))
- #f))
+ (let ((delayo (delays channel)))
+ (set! (out-delays channel) (and (not (= delayo 0.0))
+ (make-delay (time->samples delayo))))
(set! max-out-delay (max max-out-delay delayo))))))
-
+
;; delay from the minimum distance to the listener
(set! min-delay (dist->samples min-dist))
;; duration of sound at listener's position after doppler src
;;
;; this does not work quite right but the error leads to a longer
;; run with zeroed samples at the end so it should be fine
- (set! real-dur (* duration (src-duration (reverse doppler))))
+ ; (format #t "doppler: ~S~%" doppler)
+
+ (set! real-dur (* duration (if (null? doppler) 1.0 (src-duration (reverse doppler)))))
+
;; end of the run according to the duration of the note
- (set! end (time->samples duration))
- ;; start and end of the run loop in samples
+ ;; (set! end (time->samples duration))
+ ;; start and end of the loop in samples
(set! run-beg (time->samples start-time))
- (set! run-end (inexact->exact (floor (- (+ (time->samples (+ start-time (max duration real-dur)))
- (dist->samples last-dist)
- (time->samples max-out-delay))
- (if initial-delay 0.0 min-delay)))))
+ (set! run-end (floor (- (+ (time->samples (+ start-time (max duration real-dur)))
+ (dist->samples last-dist)
+ (time->samples max-out-delay))
+ (if initial-delay 0.0 min-delay))))
;; sample at which signal first arrives to the listener
(set! start (+ run-beg (dist->samples (- first-dist (if initial-delay 0.0 min-dist)))))
;; minimum distance for unity gain calculation
@@ -2978,6 +3098,25 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(if (not unity-gain-dist) ; defaults to #f above
(expt min-dist-unity reverb-power)
1.0))))
+ ;; unity-gain ambisonics gain scalers
+ (set! amb-unity-gain (* scaler
+ (if (number? unity-gain-dist)
+ (expt unity-gain-dist direct-power)
+ (if (not unity-gain-dist)
+ (expt min-dist-unity direct-power)
+ 1.0))))
+ (set! amb-unity-rev-gain (* scaler
+ (if (number? unity-gain-dist)
+ (expt unity-gain-dist reverb-power)
+ (if (not unity-gain-dist) ; defaults to #f above
+ (expt min-dist-unity reverb-power)
+ 1.0))))
+
+ ;;; XXX hack!! this should be intercepted in the calling code, no 0 duration please...
+ (if (<= real-dur 0.0)
+ (begin
+ (format #t ";;; ERROR: resetting real duration to 0.1 (was ~A)~%" real-dur)
+ (set! real-dur 0.1)))
(list
(make-move-sound
@@ -2993,7 +3132,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
;; :path
(make-delay delay-hack :max-size (max 1 (+ (ceiling (dist->samples max-dist)) delay-hack)))
;; :delay
- (make-env (reverse delay)
+ (make-env (reverse dly)
:offset (if initial-delay 0.0 (- min-delay))
:duration real-dur)
;; :rev
@@ -3005,20 +3144,20 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
out-delays
;; :gains
(let ((v (make-vector out-channels)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i out-channels))
- (vector-set! v i (make-env (reverse (vector-ref channel-gains i))
- :scaler (if (= render-using ambisonics) 1.0 unity-gain)
- :duration real-dur)))
+ (set! (v i) (make-env (reverse (channel-gains i))
+ :scaler (if (= render-using ambisonics) amb-unity-gain unity-gain)
+ :duration real-dur)))
v)
;; :rev-gains
(if (> rev-channels 0)
(let ((v (make-vector rev-channels)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i rev-channels))
- (vector-set! v i (make-env (reverse (vector-ref channel-rev-gains i))
- :scaler (if (= render-using ambisonics) 1.0 unity-rev-gain)
- :duration real-dur)))
+ (set! (v i) (make-env (reverse (channel-rev-gains i))
+ :scaler (if (= render-using ambisonics) amb-unity-rev-gain unity-rev-gain)
+ :duration real-dur)))
v)
#f)
;; :out-map
@@ -3027,7 +3166,7 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(let ((v (make-vector out-channels)))
(do ((i 0 (+ i 1)))
((= i out-channels))
- (vector-set! v i i))
+ (set! (v i) i))
v)))
*output*
*reverb*)
@@ -3035,26 +3174,27 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
run-beg
run-end)))
-;(with-sound(:channels 6 :play #f :statistics #t) (sinewave 0 10 440 0.5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :error 0.001)))
-;
-;(with-sound(:statistics #t :channels 4 :reverb-channels 4 :reverb freeverb :decay-time 3)
-; (move 0 "/usr/ccrma/snd/nando/sounds/kitchen/bowl/small-medium-large-1.snd"
-; :paths (list (make-spiral-path :start-angle 0 :turns 2.5)
-; (make-spiral-path :start-angle 180 :turns 3.5))))
+ ;(with-sound(:channels 6 :play #f :statistics #t) (sinewave 0 10 440 0.5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :error 0.001)))
+ ;
+ ;(with-sound(:statistics #t :channels 4 :reverb-channels 4 :reverb freeverb :decay-time 3)
+ ; (move 0 "/usr/ccrma/snd/nando/sounds/kitchen/bowl/small-medium-large-1.snd"
+ ; :paths (list (make-spiral-path :start-angle 0 :turns 2.5)
+ ; (make-spiral-path :start-angle 180 :turns 3.5))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Run macro to localize samples
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (dlocsig a b c)
- "(dlocsig a b c) is the same as move-sound"
- (move-sound a b c)) ; use this form for run's benefit
+(define dlocsig move-sound)
+
#|
-;(define hi (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f :error 0.001))
-;(make-dlocsig 0 1.0 :out-channels 2 :rev-channels 0 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f))
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+ ;(define hi (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f :error 0.001))
+ ;(make-dlocsig 0 1.0 :out-channels 2 :rev-channels 0 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(define* (sinewave start-time duration freq amp
(amp-env '(0 1 1 1))
@@ -3065,12 +3205,11 @@ type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
(dloc (car vals))
(beg (cadr vals))
(end (caddr vals)))
- (let* ((osc (make-oscil :frequency freq))
- (aenv (make-env :envelope amp-env :scaler amp :duration duration)))
- (run
- (do ((i beg (+ 1 i)))
+ (let ((osc (make-oscil :frequency freq))
+ (aenv (make-env :envelope amp-env :scaler amp :duration duration)))
+ (do ((i beg (+ i 1)))
((= i end))
- (dlocsig dloc i (* (env aenv) (oscil osc))))))))
+ (dlocsig dloc i (* (env aenv) (oscil osc)))))))
(with-sound (:channels 2) (sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
diff --git a/draw.fs b/draw.fs
index 4f35d54..a7f8ee3 100644
--- a/draw.fs
+++ b/draw.fs
@@ -1,17 +1,14 @@
-\ -*- snd-forth -*-
\ draw.fs -- draw.scm -> draw.fs
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Sun Dec 18 23:36:09 CET 2005
-\ Changed: Sat Jul 25 17:37:39 CEST 2009
-
-\ Commentary:
+\ Created: 05/12/18 23:36:09
+\ Changed: 14/04/28 03:52:17
+\
+\ @(#)draw.fs 1.19 4/28/14
\ make-current-window-display ( -- )
\ close-current-window-display ( -- )
-\ Code:
-
require extensions
\ --- inset overall waveform; if click, move to that location ---
@@ -23,210 +20,303 @@ hide
0.25 constant inset-height
: update-current-window-location <{ snd -- #f }>
- current-window-display-is-running if
- snd channels 0 ?do
- 'inset-envelope snd i channel-property { vals }
- \ set edit-position to impossible value
- vals array? if vals 'edit-position -2 array-assoc-set! to vals then
- loop
- then
- #f
-;
-: display-current-window-location <{ snd chn -- }>
- current-window-display-is-running
- snd chn time-graph? && if
- snd chn undef axis-info { axinf }
- axinf 12 array-ref { grf-width }
- inset-width grf-width f* fround->s { width }
- grf-width width - { x-offset }
- axinf 11 array-ref axinf 13 array-ref - { grf-height }
- inset-height grf-height f* fround->s { height }
- axinf 13 array-ref 10 - { chan-offset }
- chan-offset height 2/ + { y-offset }
- snd channel-style channels-separate = if chn else 0 then { grf-chn }
- axinf 19 array-ref { new-peaks }
- snd chn #f frames { frms }
- #f { data0 }
- #f { data1 }
- width 10 >
- height 10 > &&
- frms 0> &&
- chn 0= snd channel-style channels-superimposed <> || && if
- x-offset chan-offset height + width 2 snd grf-chn undef #f fill-rectangle drop
- x-offset chan-offset 2 height snd grf-chn undef #f fill-rectangle drop
- snd chn right-sample frms f/ width f* fround->s { rx }
- snd chn left-sample frms f/ width f* fround->s { lx }
- x-offset lx + chan-offset rx lx - 1 max height
- snd grf-chn selection-context #f fill-rectangle drop
- 'inset-envelope snd chn channel-property { old-env }
- old-env array? if
- new-peaks not
- old-env 'width array-assoc-ref width = &&
- old-env 'height array-assoc-ref height = &&
- old-env 'y-offset array-assoc-ref y-offset = &&
- old-env 'edit-position array-assoc-ref snd chn edit-position = && if
- old-env 'data0 array-assoc-ref to data0
- old-env 'data1 array-assoc-ref to data1
- #t
- else
- #f
+ current-window-display-is-running if
+ snd channels 0 ?do
+ 'inset-envelope snd i channel-property { vals }
+ \ set edit-position to impossible value
+ vals array? if
+ vals 'edit-position -2 array-assoc-set! to vals
+ then
+ loop
then
- else
#f
- then unless \ else (old-env == #f)
- snd chn current-edit-position 0 frms make-graph-data { data }
- \ data may be a vct or a list of two vcts
- data vct? if
- data vct-peak
- else
- data 0 array-ref vct-peak data 1 array-ref vct-peak fmax
- then { data-max }
- data-max f0> if height data-max f2* f/ else 0.0 then { data-scaler }
- width 2* { new-len }
- data vct? if data length else data 0 array-ref length then { data-len }
- data-len width f/ fround->s { step }
- data-len width > if
- new-len make-array to data0
- data array? if new-len make-array to data1 then
- 0 { idxi }
- 0 { idxj }
- data-max fnegate { max-y }
- data-max { min-y }
- 0 { stepper }
- begin idxi data-len < idxj new-len < && while
- data1 if
- max-y data 1 array-ref idxi vct-ref fmax to max-y
- min-y data 0 array-ref idxi vct-ref fmin to min-y
- else
- max-y data idxi vct-ref fmax to max-y
- then
- stepper 1+ to stepper
- stepper step >= if
- data0 idxj x-offset array-set!
- data0 idxj 1+ y-offset max-y data-scaler f* f- fround->s array-set!
- data-max fnegate to max-y
- data1 if
- data1 idxj x-offset array-set!
- data1 idxj 1+ y-offset min-y data-scaler f* f- fround->s array-set!
- data-max to min-y
+;
+
+: display-current-window-location <{ snd chn -- }>
+ current-window-display-is-running
+ snd chn time-graph? && if
+ snd chn undef axis-info { axinf }
+ axinf 12 array-ref { grf-width }
+ inset-width grf-width f* fround->s { width }
+ grf-width width - { x-offset }
+ axinf 11 array-ref axinf 13 array-ref - { grf-height }
+ inset-height grf-height f* fround->s { height }
+ axinf 13 array-ref 10 - { chan-offset }
+ chan-offset height 2/ + { y-offset }
+ snd channel-style channels-separate = if
+ chn
+ else
+ 0
+ then { grf-chn }
+ axinf 19 array-ref { new-peaks }
+ snd chn #f framples { frms }
+ #f { data0 }
+ #f { data1 }
+ width 10 >
+ height 10 > &&
+ frms 0> &&
+ chn 0= snd channel-style channels-superimposed <> || && if
+ x-offset chan-offset height + width 2
+ snd grf-chn undef #f fill-rectangle drop
+ x-offset chan-offset 2 height
+ snd grf-chn undef #f fill-rectangle drop
+ snd chn right-sample frms f/ width f* fround->s { rx }
+ snd chn left-sample frms f/ width f* fround->s { lx }
+ x-offset lx + chan-offset rx lx - 1 max height
+ snd grf-chn selection-context #f fill-rectangle drop
+ 'inset-envelope snd chn channel-property { old-env }
+ old-env array? if
+ new-peaks not
+ old-env 'width array-assoc-ref width = &&
+ old-env 'height array-assoc-ref height = &&
+ old-env 'y-offset array-assoc-ref y-offset = &&
+ old-env 'edit-position array-assoc-ref
+ snd chn edit-position = && if
+ old-env 'data0 array-assoc-ref to data0
+ old-env 'data1 array-assoc-ref to data1
+ #t
+ else
+ #f
+ then
+ else
+ #f
+ then unless \ else (old-env == #f)
+ snd chn current-edit-position 0
+ frms make-graph-data { data }
+ \ data may be a vct or a list of two vcts
+ data vct? if
+ data vct-peak
+ else
+ data 0 array-ref vct-peak
+ data 1 array-ref vct-peak fmax
+ then { data-max }
+ data-max f0> if
+ height data-max f2* f/
+ else
+ 0.0
+ then { data-scaler }
+ width 2* { new-len }
+ data vct? if
+ data
+ else
+ data 0 array-ref
+ then length { data-len }
+ data-len width f/ fround->s { step }
+ data-len width > if
+ new-len make-array to data0
+ data array? if
+ new-len make-array to data1
+ then
+ 0 { idxi }
+ 0 { idxj }
+ data-max fnegate { max-y }
+ data-max { min-y }
+ 0 { stepper }
+ begin
+ idxi data-len <
+ idxj new-len < &&
+ while
+ data1 if
+ max-y data 1 array-ref
+ idxi vct-ref fmax
+ to max-y
+ min-y data 0 array-ref
+ idxi vct-ref fmin
+ to min-y
+ else
+ max-y data idxi vct-ref
+ fmax to max-y
+ then
+ stepper 1+ to stepper
+ stepper step >= if
+ data0 idxj x-offset
+ array-set!
+ data0 idxj 1+ y-offset
+ max-y data-scaler
+ f* f- fround->s
+ array-set!
+ data-max fnegate
+ to max-y
+ data1 if
+ data1 idxj
+ x-offset
+ array-set!
+ data1 idxj 1+
+ y-offset
+ min-y
+ data-scaler
+ f* f-
+ fround->s
+ array-set!
+ data-max
+ to min-y
+ then
+ x-offset 1+ to x-offset
+ stepper step -
+ to stepper
+ idxj 2 + to idxj
+ then
+ idxi 1+ to idxi
+ repeat
+ begin idxj new-len < while
+ data0 idxj
+ data0 idxj 2 - array-ref
+ array-set!
+ data0 idxj 1+
+ data0 idxj 1 - array-ref
+ array-set!
+ data1 if
+ data1 idxj
+ data1 idxj 2 -
+ array-ref
+ array-set!
+ data1 idxj 1+
+ data1 idxj 1 -
+ array-ref
+ array-set!
+ then
+ idxj 2 + to idxj
+ repeat
+ else
+ width data-len f/ fround->s { xstep }
+ data-len 2* make-array to data0
+ data array? if
+ new-len 2* make-array to data1
+ then
+ 0 { idxj }
+ x-offset { xj }
+ data-len 0 ?do
+ data0 idxj xj array-set!
+ data1 if
+ data0 idxj 1+
+ y-offset
+ data 1 array-ref
+ i vct-ref
+ data-scaler
+ f* f- fround->s
+ array-set!
+ data1 idxj
+ xj array-set!
+ data1 idxj 1+
+ y-offset
+ data 0 array-ref
+ i vct-ref
+ data-scaler
+ f* f- fround->s
+ array-set!
+ else
+ data0 idxj 1+
+ y-offset
+ data i vct-ref
+ data-scaler f* f-
+ fround->s array-set!
+ then
+ idxj 2 + to idxj
+ xj xstep + to xj
+ loop
+ then
+ #() 'width width array-assoc-set!
+ ( vals ) 'height height array-assoc-set!
+ ( vals ) 'edit-position
+ snd chn edit-position array-assoc-set!
+ ( vals ) 'data0 data0 array-assoc-set!
+ ( vals ) 'data1 data1 array-assoc-set!
+ ( vals ) 'y-offset
+ y-offset array-assoc-set! { vals }
+ 'inset-envelope vals
+ snd chn set-channel-property drop
+ then
+ data1 length 2 mod if
+ data1 array-pop drop
+ then
+ data0 snd grf-chn time-graph draw-lines drop
+ data1 if
+ data1 snd grf-chn time-graph draw-lines drop
+ then
then
- x-offset 1+ to x-offset
- stepper step - to stepper
- idxj 2 + to idxj
- then
- idxi 1+ to idxi
- repeat
- begin idxj new-len < while
- data0 idxj data0 idxj 2 - array-ref array-set!
- data0 idxj 1+ data0 idxj 1 - array-ref array-set!
- data1 if
- data1 idxj data1 idxj 2 - array-ref array-set!
- data1 idxj 1+ data1 idxj 1 - array-ref array-set!
- then
- idxj 2 + to idxj
- repeat
- else
- width data-len f/ fround->s { xstep }
- data-len 2* make-array to data0
- data array? if new-len 2* make-array to data1 then
- 0 { idxj }
- x-offset { xj }
- data-len 0 ?do
- data0 idxj xj array-set!
- data1 if
- data0 idxj 1+ y-offset data 1 array-ref i vct-ref data-scaler f* f- fround->s
- array-set!
- data1 idxj xj array-set!
- data1 idxj 1+ y-offset data 0 array-ref i vct-ref data-scaler f* f- fround->s
- array-set!
- else
- data0 idxj 1+ y-offset data i vct-ref data-scaler f* f- fround->s array-set!
- then
- idxj 2 + to idxj
- xj xstep + to xj
- loop
then
- #() 'width width array-assoc-set!
- ( vals ) 'height height array-assoc-set!
- ( vals ) 'edit-position snd chn edit-position array-assoc-set!
- ( vals ) 'data0 data0 array-assoc-set!
- ( vals ) 'data1 data1 array-assoc-set!
- ( vals ) 'y-offset y-offset array-assoc-set! { vals }
- 'inset-envelope vals snd chn set-channel-property drop
- then
- data1 length 2 mod if data1 array-pop drop then
- data0 snd grf-chn time-graph draw-lines drop
- data1 if data1 snd grf-chn time-graph draw-lines drop then
- then
- then
;
+
: click-current-window-location <{ snd chn button state x y axis -- f }>
- current-window-display-is-running
- axis time-graph = && if
- snd chn undef axis-info { axinf }
- axinf 12 array-ref { grf-width }
- inset-width grf-width f* fround->s { width }
- grf-width width - { x-offset }
- axinf 11 array-ref axinf 13 array-ref - inset-height f* fround->s { height }
- axinf 13 array-ref 10 - { chan-offset }
- width 0>
- x x-offset >= &&
- x grf-width <= &&
- y chan-offset >= &&
- y chan-offset height + <= && if
- snd chn #f frames x x-offset f- width f/ f* fround->s { samp }
- snd chn left-sample { ls }
- snd chn right-sample { rs }
- samp snd chn #f set-cursor drop
- samp ls < samp rs > || if
- samp ls rs - 2/ - 0 max snd chn #f frames 1- min snd chn set-right-sample drop
- then
- snd chn update-time-graph drop
- #t
- else
- #f
- then
- else
- #f
- then
+ current-window-display-is-running
+ axis time-graph = && if
+ snd chn undef axis-info { axinf }
+ axinf 12 array-ref { grf-width }
+ inset-width grf-width f* fround->s { width }
+ grf-width width - { x-offset }
+ axinf 11 array-ref axinf 13 array-ref
+ - inset-height f* fround->s { height }
+ axinf 13 array-ref 10 - { chan-offset }
+ width 0>
+ x x-offset >= &&
+ x grf-width <= &&
+ y chan-offset >= &&
+ y chan-offset height + <= && if
+ snd chn #f framples x x-offset f- width f/ f*
+ fround->s { samp }
+ snd chn left-sample { ls }
+ snd chn right-sample { rs }
+ samp snd chn #f set-cursor drop
+ samp ls < samp rs > || if
+ samp ls rs - 2/ - 0 max
+ snd chn #f framples 1- min
+ snd chn set-right-sample drop
+ then
+ snd chn update-time-graph drop
+ #t
+ else
+ #f
+ then
+ else
+ #f
+ then
;
+
: undo-cb { snd chn -- proc; self -- }
- 0 proc-create snd , chn ,
- does> ( self -- )
- { self }
- 'inset-envelope #f self @ ( snd ) self cell+ @ ( chn ) set-channel-property drop
+ 0 proc-create snd , chn ,
+ does> { self -- }
+ 'inset-envelope #f self @ ( snd ) self cell+ @ ( chn )
+ set-channel-property drop
;
+
: install-current-window-location <{ snd -- }>
- snd channels 0 ?do
- 'inset-envelope snd i set-channel-property-save-state-ignore drop
- snd i undo-hook snd i undo-cb add-hook!
- loop
+ snd channels 0 ?do
+ 'inset-envelope snd i
+ set-channel-property-save-state-ignore drop
+ snd i undo-hook snd i undo-cb add-hook!
+ loop
;
set-current
: make-current-window-display ( -- )
- doc" Displays in upper right corner the overall current sound \
+ doc" Display in upper right corner the overall current sound \
and where the current window fits in it."
- current-window-display-is-running unless
- #t to current-window-display-is-running
- after-open-hook <'> install-current-window-location add-hook!
- after-graph-hook <'> display-current-window-location add-hook!
- mouse-click-hook <'> click-current-window-location add-hook!
- update-hook <'> update-current-window-location add-hook!
- then
+ current-window-display-is-running unless
+ #t to current-window-display-is-running
+ after-open-hook <'> install-current-window-location add-hook!
+ after-graph-hook <'> display-current-window-location add-hook!
+ mouse-click-hook <'> click-current-window-location add-hook!
+ update-hook <'> update-current-window-location add-hook!
+ then
;
: close-current-window-display ( -- )
- current-window-display-is-running if
- #f to current-window-display-is-running
- after-open-hook <'> install-current-window-location remove-hook! drop
- after-graph-hook <'> display-current-window-location remove-hook! drop
- mouse-click-hook <'> click-current-window-location remove-hook! drop
- update-hook <'> update-current-window-location remove-hook! drop
- sounds each { snd }
- snd channels 0 ?do snd i undo-hook <'> undo-cb remove-hook! drop loop
- end-each
- then
+ current-window-display-is-running if
+ #f to current-window-display-is-running
+ after-open-hook <'> install-current-window-location
+ remove-hook! drop
+ after-graph-hook <'> display-current-window-location
+ remove-hook! drop
+ mouse-click-hook <'> click-current-window-location
+ remove-hook! drop
+ update-hook <'> update-current-window-location
+ remove-hook! drop
+ sounds each { snd }
+ snd channels 0 ?do
+ snd i undo-hook <'> undo-cb remove-hook! drop
+ loop
+ end-each
+ then
;
previous
diff --git a/draw.rb b/draw.rb
index a9e8941..2085429 100644
--- a/draw.rb
+++ b/draw.rb
@@ -1,11 +1,9 @@
-# draw.rb -- draw.scm --> draw.rb -*- snd-ruby -*-
+# draw.rb -- draw.scm --> draw.rb
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Tue Apr 05 00:17:04 CEST 2005
-# Changed: Wed Nov 17 21:38:19 CET 2010
+# Created: 05/04/05 00:17:04
+# Changed: 14/11/13 03:06:52
-# Commentary:
-#
# examples of extensions to Snd's graphics
#
# module Draw
@@ -17,16 +15,14 @@
# overlay_sounds(*rest)
# samples_via_colormap(snd, chn)
# click_for_listener_help(pos)
-#
-
-# Code:
require "extensions"
module Draw
add_help(:display_colored_samples,
- "display_colored_samples(color, beg, dur, [snd=false, [chn=false]]) \
-displays samples from beg for dur in color whenever they\'re in the current view.")
+ "display_colored_samples(color, beg, dur, snd=false, chn=false) \
+Displays samples from beg for dur in color \
+whenever they're in the current view.")
def display_colored_samples(color, beg, dur, snd = false, chn = false)
unless array?(color) and number?(beg) and number?(dur)
return
@@ -36,12 +32,17 @@ displays samples from beg for dur in color whenever they\'re in the current view
len = beg + dur
old_color = foreground_color(snd, chn)
if left < len and right > beg
+ cr = make_cairo(channel_widgets(snd, chn)[0])
if vct?(data = make_graph_data(snd, chn))
samps = [right, len].min - [left, beg].max
offset = [0, beg - left].max
new_data = data.subseq(offset, offset + samps)
set_foreground_color(color, snd, chn)
- graph_data(new_data, snd, chn, Copy_context, [beg, left].max, [len, right].min)
+ graph_data(new_data,
+ snd, chn,
+ Copy_context,
+ [beg, left].max,
+ [len, right].min, Graph_lines, cr)
set_foreground_color(old_color, snd, chn)
else
low_data, high_data = data[0, 2]
@@ -54,9 +55,11 @@ displays samples from beg for dur in color whenever they\'re in the current view
new_low_data = low_data.subseq(left_bin, right_bin)
new_high_data = high_data.subseq(left_bin, right_bin)
set_foreground_color(color, snd, chn)
- graph_data([new_low_data, new_high_data], snd, chn, Copy_context, left_bin, right_bin)
+ graph_data([new_low_data, new_high_data],
+ snd, chn, Copy_context, left_bin, right_bin, Graph_lines, cr)
set_foreground_color(old_color, snd, chn)
end
+ free_cairo(cr)
end
end
@@ -66,21 +69,22 @@ displays samples from beg for dur in color whenever they\'re in the current view
end
add_help(:color_samples,
- "color_samples(color, [beg=0, [dur=false, [snd=false, [chn=false]]]]) \
-causes samples from beg to beg+dur to be displayed in color")
+ "color_samples(color, beg=0, dur=false, snd=false, chn=false) \
+Causes samples from BEG to BEG+DUR to be displayed in COLOR.")
def color_samples(color, beg = 0, dur = false, snd = Snd.snd, chn = Snd.chn)
unless $after_graph_hook.member?("display-samples-in-color")
$after_graph_hook.add_hook!("display-samples-in-color") do |s, c|
display_samples_in_color(s, c)
end
end
- unless dur then dur = frames(snd, chn) - beg end
+ unless dur then dur = framples(snd, chn) - beg end
set_channel_property(:colored_samples, [color, beg, dur], snd, chn)
update_time_graph(snd, chn)
end
add_help(:uncolor_samples,
- "uncolor_samples([snd=false, [chn=false]]) cancels sample coloring in the given channel")
+ "uncolor_samples(snd=false, chn=false) \
+Cancels sample coloring in the given channel.")
def uncolor_samples(snd = Snd.snd, chn = Snd.chn)
set_channel_property(:colored_samples, [], snd, chn)
update_time_graph(snd, chn)
@@ -88,74 +92,93 @@ causes samples from beg to beg+dur to be displayed in color")
add_help(:display_previous_edits,
"display_previous_edits(snd, chn) \
-displays all edits of the current sound, with older versions gradually fading away")
+Displays all edits of the current sound, \
+with older versions gradually fading away.")
def display_previous_edits(snd, chn)
edits = edit_position(snd, chn)
- old_color = foreground_color(snd, chn)
- clist = color2list(old_color)
- r = clist[0]
- g = clist[1]
- b = clist[2]
- rinc = (1.0 - r) / (edits + 1)
- ginc = (1.0 - g) / (edits + 1)
- binc = (1.0 - b) / (edits + 1)
if edits > 0
+ old_color = foreground_color(snd, chn)
+ clist = color2list(old_color)
+ r = clist[0]
+ g = clist[1]
+ b = clist[2]
+ rinc = (1.0 - r) / (edits + 1)
+ ginc = (1.0 - g) / (edits + 1)
+ binc = (1.0 - b) / (edits + 1)
+ cr = make_cairo(channel_widgets(snd, chn)[0])
re = 1.0 - rinc
ge = 1.0 - ginc
be = 1.0 - binc
0.upto(edits) do |pos|
data = make_graph_data(snd, chn, pos)
set_foreground_color(make_color(re, ge, be), snd, chn)
- graph_data(data, snd, chn)
+ graph_data(data,
+ snd, chn, Copy_context,
+ false, false, time_graph_style(snd, chn), cr)
re -= rinc
ge -= ginc
be -= binc
end
set_foreground_color(old_color, snd, chn)
+ free_cairo(cr)
end
end
add_help(:overlay_sounds,
"overlay_sounds(*rest) \
-overlays onto its first argument all subsequent arguments: overlay_sounds(1, 0, 3)")
+Overlays onto its first argument all \
+subsequent arguments: overlay_sounds(1, 0, 3)")
def overlay_sounds(*rest)
base = rest.shift
+ if integer?(base)
+ base = integer2sound(base)
+ end
$after_graph_hook.add_hook!(get_func_name) do |snd, chn|
- if sound?(base) and snd == base
+ if snd == base
+ cr = make_cairo(channel_widgets(snd, chn)[0])
rest.each do |s|
- if sound?(s) and channels(s) > chn and channels(base) > chn
- graph_data(make_graph_data(s, chn), base, chn, Copy_context, -1, -1, Graph_dots)
- end
+ graph_data(make_graph_data(s, chn),
+ base, chn, Copy_context, false, false, Graph_dots, cr)
end
+ free_cairo(cr)
end
end
end
add_help(:samples_via_colormap,
"samples_via_colormap(snd, chn) \
-displays time domain graph using current colormap (just an example of colormap-ref)")
+Displays time domain graph using current \
+colormap (just an example of colormap_ref).")
def samples_via_colormap(snd, chn)
left = left_sample(snd, chn)
old_color = foreground_color(snd, chn)
- data = make_graph_data(snd, chn)[0]
- x0 = x2position(left / srate())
- y0 = y2position(data[0])
- colors = make_array(colormap_size)
- j = 1
- (left + 1).upto(left + data.length - 1) do |i|
- x1 = x2position(i / srate)
- y1 = y2position(data[j])
- x = data[j].abs
- ref = (colormap_size * x).floor
- unless colors[ref]
- colors[ref] = make_color(*colormap_ref(colormap, x))
+ if data = make_graph_data(snd, chn)
+ cr = make_cairo(channel_widgets(snd, chn)[0])
+ if vct?(data)
+ data = [data]
end
- set_foreground_color(colors[ref], snd, chn)
- draw_line(x0, y0, x1, y1)
- x0, y0 = x1, y1
- j += 1
+ data.each do |cur_data|
+ x0 = x2position(left / srate(snd))
+ y0 = y2position(cur_data[0])
+ colors = make_array(colormap_size)
+ j = 1
+ (left + 1).upto(left + cur_data.length - 1) do |i|
+ x1 = x2position(i / srate(snd))
+ y1 = y2position(cur_data[j])
+ x = cur_data[j].abs
+ ref = (colormap_size * x).floor
+ unless colors[ref]
+ colors[ref] = make_color(*colormap_ref(colormap, x))
+ end
+ set_foreground_color(colors[ref], snd, chn)
+ draw_line(x0, y0, x1, y1, snd, chn, Time_graph, cr)
+ x0, y0 = x1, y1
+ j += 1
+ end
+ end
+ free_cairo(cr)
+ set_foreground_color(old_color, snd, chn)
end
- set_foreground_color(old_color, snd, chn)
end
# click-for-listener-help
@@ -166,9 +189,12 @@ displays time domain graph using current colormap (just an example of colormap-r
time = Time.now.to_f
if time - $last_click_time < 0.2
$last_click_time = 0.0
- if string?(text = widget_text(main_widgets[4]))
- if string?(subject = text.slice(text.rindex(/\b/m, pos)...text.index(/\b/m, pos)))
- if string?(help = snd_help(subject, false))
+ text = widget_text(main_widgets[4])
+ if string?(text)
+ subject = text.slice(text.rindex(/\b/m, pos)...text.index(/\b/m, pos))
+ if string?(subject)
+ help = snd_help(subject, false)
+ if string?(help)
help_dialog(subject, help)
end
end
@@ -177,7 +203,8 @@ displays time domain graph using current colormap (just an example of colormap-r
$last_click_time = time
end
end
- # $listener_click_hook.add_hook!("listener-help", &method(:click_for_listener_help).to_proc)
+ # $listener_click_hook.add_hook!("listener-help",
+ # &method(:click_for_listener_help).to_proc)
end
include Draw
diff --git a/draw.scm b/draw.scm
index 8836212..60bfbac 100644
--- a/draw.scm
+++ b/draw.scm
@@ -2,18 +2,17 @@
(provide 'snd-draw.scm)
-
(define (overlay-rms-env snd chn)
- (let* ((red (make-color 1 0 0)) ; rms env displayed in red
- (left (left-sample snd chn))
- (right (right-sample snd chn))
- (rms-size 128) ; this could be a parameter -- not sure what the "right" size is
- (sr (/ 1.0 (srate snd)))
- (old-color (foreground-color snd chn))
- (axinf (axis-info snd chn))
- (old-axinf (channel-property 'rms-axis-info snd chn))
- (cr (make-cairo (car (channel-widgets snd chn)))))
-
+ (let ((red (make-color 1 0 0)) ; rms env displayed in red
+ (left (left-sample snd chn))
+ (right (right-sample snd chn))
+ (rms-size 128) ; this could be a parameter -- not sure what the "right" size is
+ (sr (/ 1.0 (srate snd)))
+ (old-color (foreground-color snd chn))
+ (axinf (axis-info snd chn))
+ (old-axinf (channel-property 'rms-axis-info snd chn))
+ (cr (make-cairo (car (channel-widgets snd chn)))))
+
;; these functions are an optimization to speed up calculating the rms env graph.
;; ideally we'd use something like:
;;
@@ -29,23 +28,23 @@
;; integer vector (and preload it with 0). We save the vector in the channel property 'rms-lines,
;; and the associated axis info in 'rms-axis-info. Since redisplay is common in Snd, it reduces
;; flicker a lot to have this data instantly available.
-
+
(define (pack-x-info axinf)
- (vct (list-ref axinf 2) ; x0
- (list-ref axinf 4) ; x1
- (list-ref axinf 10) ; x_axis_x0
- (list-ref axinf 12) ; x_axis_x1
- (list-ref axinf 15) ; scale
- (- (list-ref axinf 10) (* (list-ref axinf 2) (list-ref axinf 15))))) ; base
-
+ (float-vector (axinf 2) ; x0
+ (axinf 4) ; x1
+ (axinf 10) ; x_axis_x0
+ (axinf 12) ; x_axis_x1
+ (axinf 15) ; scale
+ (- (axinf 10) (* (axinf 2) (axinf 15))))) ; base
+
(define (pack-y-info axinf)
- (vct (list-ref axinf 3) ; y0
- (list-ref axinf 5) ; y1
- (list-ref axinf 11) ; y_axis_y0
- (list-ref axinf 13) ; y_axis_y1
- (list-ref axinf 16) ; scale
- (- (list-ref axinf 11) (* (list-ref axinf 3) (list-ref axinf 16))))) ; base
-
+ (float-vector (axinf 3) ; y0
+ (axinf 5) ; y1
+ (axinf 11) ; y_axis_y0
+ (axinf 13) ; y_axis_y1
+ (axinf 16) ; scale
+ (- (axinf 11) (* (axinf 3) (axinf 16))))) ; base
+
(define (grf-it val v)
(round
(if (>= val (v 1))
@@ -53,13 +52,13 @@
(if (<= val (v 0))
(v 2)
(+ (v 5) (* val (v 4)))))))
-
+
(define* (make-moving-rms (size 128))
(make-moving-average size))
-
+
(define (moving-rms gen y)
(sqrt (moving-average gen (* y y))))
-
+
(if (equal? axinf old-axinf) ; the previously calculated lines can be re-used
(begin
(set! (foreground-color snd chn) red)
@@ -73,32 +72,31 @@
(x0 0)
(y0 0)
(line-ctr 2)
- (lines (make-vector (* 2 (+ 1 (- (list-ref axinf 12) (list-ref axinf 10)))) 0)))
+ (lines (make-vector (* 2 (+ 1 (- (axinf 12) (axinf 10)))) 0)))
(dynamic-wind
(lambda ()
(set! (foreground-color snd chn) red))
(lambda ()
- (run
- (if (< start left) ; check previous samples to get first rms value
- (do ((i start (+ 1 i)))
- ((= i left))
- (moving-rms rms (reader))))
- (let ((first-sample (next-sample reader)))
- (set! x0 (grf-it (* left sr) xdata))
- (set! y0 (grf-it first-sample ydata))
- (set! (lines 0) x0) ; first graph point
- (set! (lines 1) y0))
- (do ((i (+ left 1) (+ 1 i))) ; loop through all samples calling moving-rms
- ((= i right))
- (let* ((x1 (grf-it (* i sr) xdata))
- (y (moving-rms rms (next-sample reader))))
- (if (> x1 x0) ; very often many samples are represented by one pixel
- (let ((y1 (grf-it y ydata)))
- (set! (lines line-ctr) x1)
- (set! (lines (+ 1 line-ctr)) y1)
- (set! line-ctr (+ line-ctr 2))
- (set! x0 x1)
- (set! y0 y1)))))) ; else should we do "max" here? or draw a vertical line from min to max?
+ (if (< start left) ; check previous samples to get first rms value
+ (do ((i start (+ 1 i)))
+ ((= i left))
+ (moving-rms rms (reader))))
+ (let ((first-sample (next-sample reader)))
+ (set! x0 (grf-it (* left sr) xdata))
+ (set! y0 (grf-it first-sample ydata))
+ (set! (lines 0) x0) ; first graph point
+ (set! (lines 1) y0))
+ (do ((i (+ left 1) (+ 1 i))) ; loop through all samples calling moving-rms
+ ((= i right))
+ (let ((x1 (grf-it (* i sr) xdata))
+ (y (moving-rms rms (next-sample reader))))
+ (if (> x1 x0) ; very often many samples are represented by one pixel
+ (let ((y1 (grf-it y ydata)))
+ (set! (lines line-ctr) x1)
+ (set! (lines (+ 1 line-ctr)) y1)
+ (set! line-ctr (+ line-ctr 2))
+ (set! x0 x1)
+ (set! y0 y1))))) ; else should we do "max" here? or draw a vertical line from min to max?
(if (< line-ctr (length lines))
(do ((j line-ctr (+ j 2))) ; off-by-one in vector size calc -- need to pad so we don't get a bogus line to (0, 0)
((>= j (length lines)))
@@ -111,157 +109,166 @@
(set! (foreground-color snd chn) old-color)))))
(free-cairo cr)))
-;(hook-push after-graph-hook overlay-rms-env)
+ ;(hook-push after-graph-hook (lambda (hook) (overlay-rms-env (hook 'snd) (hook 'chn))))
-(define* (display-colored-samples color beg dur snd chn)
- "(display-colored-samples color beg dur snd chn) displays samples from beg for dur in color
-whenever they're in the current view."
- (let ((left (left-sample snd chn))
- (right (right-sample snd chn))
- (end (+ beg dur))
- (old-color (foreground-color snd chn))
- (cr (make-cairo (car (channel-widgets snd chn)))))
- (if (and (< left end)
- (> right beg))
- (let* ((data (make-graph-data snd chn)))
- (if (vct? data)
- (let* ((samps (- (min right end) (max left beg)))
- (offset (max 0 (- beg left)))
- (new-data (vct-subseq data offset (+ offset samps))))
- (set! (foreground-color snd chn) color)
- (graph-data new-data snd chn copy-context (max beg left) (min end right) (time-graph-style snd chn) cr)
- (set! (foreground-color snd chn) old-color))
- (let* ((low-data (car data))
- (high-data (cadr data))
- (size (length low-data))
- (samps (- right left))
- (left-offset (max 0 (- beg left)))
- (left-bin (floor (/ (* size left-offset) samps)))
- (right-offset (- (min end right) left))
- (right-bin (floor (/ (* size right-offset) samps)))
- (new-low-data (vct-subseq low-data left-bin right-bin))
- (new-high-data (vct-subseq high-data left-bin right-bin)))
- (set! (foreground-color snd chn) color)
- (graph-data (list new-low-data new-high-data) snd chn copy-context left-bin right-bin (time-graph-style snd chn) cr)
- (set! (foreground-color snd chn) old-color)))))
- (free-cairo cr)))
-
-
-(define (display-samples-in-color snd chn)
- ;; intended as after-graph-hook member
- ;; run through 'colored-samples lists passing each to display-colored-samples
- (let ((colors (channel-property 'colored-samples snd chn)))
- (if colors
- (for-each
- (lambda (vals)
- (apply display-colored-samples (append vals (list snd chn))))
- colors))))
+(define display-colored-samples
+ (let ((documentation "(display-colored-samples color beg dur snd chn) displays samples from beg for dur in color
+whenever they're in the current view."))
+ (lambda* (color beg dur snd chn)
+ (let ((left (left-sample snd chn))
+ (right (right-sample snd chn))
+ (end (+ beg dur))
+ (old-color (foreground-color snd chn))
+ (cr (make-cairo (car (channel-widgets snd chn)))))
+ (if (and (< left end)
+ (> right beg))
+ (let ((data (make-graph-data snd chn)))
+ (if (float-vector? data)
+ (let* ((samps (- (min right end) (max left beg)))
+ (offset (max 0 (- beg left)))
+ (new-data (float-vector-subseq data offset (+ offset samps))))
+ (set! (foreground-color snd chn) color)
+ (graph-data new-data snd chn copy-context (max beg left) (min end right) (time-graph-style snd chn) cr)
+ (set! (foreground-color snd chn) old-color))
+ (let* ((low-data (car data))
+ (high-data (cadr data))
+ (size (length low-data))
+ (samps (- right left))
+ (left-offset (max 0 (- beg left)))
+ (left-bin (floor (/ (* size left-offset) samps)))
+ (right-offset (- (min end right) left))
+ (right-bin (floor (/ (* size right-offset) samps)))
+ (new-low-data (float-vector-subseq low-data left-bin right-bin))
+ (new-high-data (float-vector-subseq high-data left-bin right-bin)))
+ (set! (foreground-color snd chn) color)
+ (graph-data (list new-low-data new-high-data) snd chn copy-context left-bin right-bin (time-graph-style snd chn) cr)
+ (set! (foreground-color snd chn) old-color)))))
+ (free-cairo cr)))))
-(define* (color-samples color ubeg udur usnd uchn)
- "(color-samples color beg dur snd chn) causes samples from beg to beg+dur to be displayed in color"
- (if (not (member display-samples-in-color (hook-functions after-graph-hook)))
- (hook-push after-graph-hook display-samples-in-color))
- (let* ((beg (or ubeg 0))
- (snd (or usnd (selected-sound) (car (sounds))))
- (chn (or uchn (selected-channel snd) 0))
- (dur (or udur (- (frames snd chn) beg)))
- (old-colors (or (channel-property 'colored-samples snd chn) '())))
- (set! (channel-property 'colored-samples snd chn) (cons (list color beg dur) old-colors))
- (update-time-graph snd chn)))
+(define (display-samples-in-color hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ ;; intended as after-graph-hook member
+ ;; run through 'colored-samples lists passing each to display-colored-samples
+ (let ((colors (channel-property 'colored-samples snd chn)))
+ (if colors
+ (for-each
+ (lambda (vals)
+ (apply display-colored-samples (append vals (list snd chn))))
+ colors)))))
-(define* (uncolor-samples usnd uchn)
- "(uncolor-samples snd chn) cancels sample coloring in the given channel"
- (let* ((snd (or usnd (selected-sound) (car (sounds))))
- (chn (or uchn (selected-channel snd) 0)))
- (set! (channel-property 'colored-samples snd chn) '())
- (update-time-graph snd chn)))
+(define color-samples
+ (let ((documentation "(color-samples color beg dur snd chn) causes samples from beg to beg+dur to be displayed in color"))
+ (lambda* (color ubeg udur usnd uchn)
+ (if (not (member display-samples-in-color (hook-functions after-graph-hook)))
+ (hook-push after-graph-hook display-samples-in-color))
+ (let* ((beg (or ubeg 0))
+ (snd (or usnd (selected-sound) (car (sounds))))
+ (chn (or uchn (selected-channel snd) 0))
+ (dur (or udur (- (framples snd chn) beg)))
+ (old-colors (or (channel-property 'colored-samples snd chn) ())))
+ (set! (channel-property 'colored-samples snd chn) (cons (list color beg dur) old-colors))
+ (update-time-graph snd chn)))))
+(define uncolor-samples
+ (let ((documentation "(uncolor-samples snd chn) cancels sample coloring in the given channel"))
+ (lambda* (usnd uchn)
+ (let* ((snd (or usnd (selected-sound) (car (sounds))))
+ (chn (or uchn (selected-channel snd) 0)))
+ (set! (channel-property 'colored-samples snd chn) ())
+ (update-time-graph snd chn)))))
-(define (display-previous-edits snd chn)
- "(display-previous-edits snd chn) displays all edits of the current sound, with older versions gradually fading away"
- (let ((edits (edit-position snd chn)))
- (if (> edits 0)
- (let* ((old-color (foreground-color snd chn))
- (clist (color->list old-color))
- (r (car clist))
- (g (cadr clist))
- (b (caddr clist))
- (rinc (/ (- 1.0 r) (+ edits 1)))
- (ginc (/ (- 1.0 g) (+ edits 1)))
- (binc (/ (- 1.0 b) (+ edits 1)))
- (cr (make-cairo (car (channel-widgets snd chn)))))
- (do ((pos 0 (+ 1 pos))
- (re (- 1.0 rinc) (- re rinc))
- (ge (- 1.0 ginc) (- ge ginc))
- (be (- 1.0 binc) (- be binc)))
- ((> pos edits))
- (let ((data (make-graph-data snd chn pos)))
- (set! (foreground-color snd chn) (make-color re ge be))
- (graph-data data snd chn copy-context #f #f (time-graph-style snd chn) cr)))
- (set! (foreground-color snd chn) old-color)
- (free-cairo cr)))))
-(define (overlay-sounds . args)
- "(overlay-sounds . args) overlays onto its first argument all subsequent arguments: (overlay-sounds 1 0 3)"
- (let ((base (if (integer? (car args))
- (integer->sound (car args))
- (car args))))
- (hook-push after-graph-hook
- (lambda (snd chn)
- (if (equal? snd base)
- (let ((cr (make-cairo (car (channel-widgets snd chn)))))
- (for-each
- (lambda (nsnd)
- (if (and (sound? nsnd)
- (> (chans nsnd) chn))
- (graph-data (make-graph-data nsnd chn) base chn copy-context #f #f graph-dots cr)))
- (cdr args))
- (free-cairo cr)))))))
+(define display-previous-edits
+ (let ((documentation "(display-previous-edits snd chn) displays all edits of the current sound, with older versions gradually fading away"))
+ (lambda (snd chn)
+ (let ((edits (edit-position snd chn)))
+ (if (> edits 0)
+ (let* ((old-color (foreground-color snd chn))
+ (clist (color->list old-color))
+ (r (car clist))
+ (g (cadr clist))
+ (b (caddr clist))
+ (rinc (/ (- 1.0 r) (+ edits 1)))
+ (ginc (/ (- 1.0 g) (+ edits 1)))
+ (binc (/ (- 1.0 b) (+ edits 1)))
+ (cr (make-cairo (car (channel-widgets snd chn)))))
+ (do ((pos 0 (+ 1 pos))
+ (re (- 1.0 rinc) (- re rinc))
+ (ge (- 1.0 ginc) (- ge ginc))
+ (be (- 1.0 binc) (- be binc)))
+ ((> pos edits))
+ (let ((data (make-graph-data snd chn pos)))
+ (set! (foreground-color snd chn) (make-color re ge be))
+ (graph-data data snd chn copy-context #f #f (time-graph-style snd chn) cr)))
+ (set! (foreground-color snd chn) old-color)
+ (free-cairo cr)))))))
-(define (samples-via-colormap snd chn)
- "(samples-via-colormap snd chn) displays time domain graph using current colormap (just an example of colormap-ref)"
- (let* ((left (left-sample snd chn))
- (right (right-sample snd chn))
- (old-color (foreground-color snd chn))
- (data (make-graph-data snd chn))
- (cr (make-cairo (car (channel-widgets snd chn)))))
+(define overlay-sounds
+ (let ((documentation "(overlay-sounds . args) overlays onto its first argument all subsequent arguments: (overlay-sounds 1 0 3)"))
+ (lambda args
+ (let ((base (if (integer? (car args))
+ (integer->sound (car args))
+ (car args))))
+ (hook-push after-graph-hook
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (if (equal? snd base)
+ (let ((cr (make-cairo (car (channel-widgets snd chn)))))
+ (for-each
+ (lambda (nsnd)
+ (if (and (sound? nsnd)
+ (> (chans nsnd) chn))
+ (graph-data (make-graph-data nsnd chn) base chn copy-context #f #f graph-dots cr)))
+ (cdr args))
+ (free-cairo cr))))))))))
- (define (samples-1 cur-data)
- (let* ((x0 (x->position (/ left (srate snd))))
- (y0 (y->position (cur-data 0)))
- (colors (make-vector (colormap-size) #f))
- (len (length cur-data))
- (incr (/ (+ 1 (- right left)) len)))
- (do ((i (+ left incr) (+ i incr))
- (j 1 (+ 1 j)))
- ((or (>= i right)
- (>= j len)))
- (let* ((x1 (x->position (/ i (srate snd))))
- (y1 (y->position (cur-data j)))
- (x (abs (cur-data j)))
- (ref (floor (* (colormap-size) x)))
- (color (or (colors ref)
- (let ((new-color (apply make-color (colormap-ref (colormap) x))))
- (set! (colors ref) new-color)
- new-color))))
- (set! (foreground-color snd chn) color)
- (draw-line x0 y0 x1 y1 snd chn time-graph cr)
- (set! x0 x1)
- (set! y0 y1)))
- (set! (foreground-color snd chn) old-color)))
- (if data
- (if (vct? data)
- (samples-1 data)
- (begin
- (samples-1 (car data))
- (samples-1 (cadr data)))))
- (free-cairo cr)))
+(define samples-via-colormap
+ (let ((documentation "(samples-via-colormap snd chn) displays time domain graph using current colormap (just an example of colormap-ref)"))
+ (lambda (snd chn)
+ (let ((left (left-sample snd chn))
+ (right (right-sample snd chn))
+ (old-color (foreground-color snd chn))
+ (data (make-graph-data snd chn))
+ (cr (make-cairo (car (channel-widgets snd chn)))))
+
+ (define (samples-1 cur-data)
+ (let* ((x0 (x->position (/ left (srate snd))))
+ (y0 (y->position (cur-data 0)))
+ (colors (make-vector *colormap-size* #f))
+ (len (length cur-data))
+ (incr (/ (+ 1 (- right left)) len)))
+ (do ((i (+ left incr) (+ i incr))
+ (j 1 (+ 1 j)))
+ ((or (>= i right)
+ (>= j len)))
+ (let* ((x1 (x->position (/ i (srate snd))))
+ (y1 (y->position (cur-data j)))
+ (x (abs (cur-data j)))
+ (ref (floor (* *colormap-size* x)))
+ (color (or (colors ref)
+ (let ((new-color (apply make-color (colormap-ref (colormap) x))))
+ (set! (colors ref) new-color)))))
+ (set! (foreground-color snd chn) color)
+ (draw-line x0 y0 x1 y1 snd chn time-graph cr)
+ (set! x0 x1)
+ (set! y0 y1)))
+ (set! (foreground-color snd chn) old-color)))
+
+ (if data
+ (if (float-vector? data)
+ (samples-1 data)
+ (begin
+ (samples-1 (car data))
+ (samples-1 (cadr data)))))
+ (free-cairo cr)))))
diff --git a/dsp.fs b/dsp.fs
index 05bcd9d..8c3c024 100644
--- a/dsp.fs
+++ b/dsp.fs
@@ -1,141 +1,141 @@
\ dsp.fs -- dsp.scm|rb --> dsp.fs
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Fri Dec 30 04:52:13 CET 2005
-\ Changed: Sat Feb 19 17:00:03 CET 2011
-
-\ src-duration ( en -- dur )
-\ src-fit-envelope ( e1 target-dur -- e2 )
-\ dolph ( n gamma -- im )
-\ dolph-1 ( n gamma -- im )
-\ down-oct ( n :optional snd chn -- vct )
-\ stretch-sound-via-dft ( factor :optional snd chn -- )
+\ Created: 05/12/30 04:52:13
+\ Changed: 14/04/28 03:52:17
+\
+\ @(#)dsp.fs 1.51 4/28/14
+
+\ src-duration ( en -- dur )
+\ src-fit-envelope ( e1 target-dur -- e2 )
+\ dolph ( n gamma -- im )
+\ dolph-1 (n gamma -- im )
+\ down-oct ( n :optional snd chn -- vct )
+\ stretch-sound-via-dft ( factor :optional snd chn -- )
\ compute-uniform-circular-string ( size x0 x1 x2 mass xspring damp -- )
-\ compute-string ( size x0 x1 x2 masses xsprings esprings damps haptics -- )
-\ freqdiv ( n :optional snd chn -- )
-\ adsat ( size :optional beg dur snd chn -- res )
-\ spike ( :optional snd chn -- res )
-\ spot-freq ( samp :optional snd chn -- )
-\ chorus ( -- proc; inval self -- val )
-\ chordalize ( -- proc; x self -- val )
-\ zero-phase ( :optional snd chn -- vct )
-\ rotate-phase ( func :optional snd chn -- vct)
-\ make-asyfm ( :key frequency initial-phase ratio r index -- gen )
-\ asyfm-J ( gen input -- val )
-\ asyfm-I ( gen input -- val )
-\ make-cosine-summation ( :key frequency initial-phase -- gen )
-\ cosine-summation ( gen r -- val )
-\ make-kosine-summation ( :key frequency initial-phase -- gen )
-\ kosine-summation ( gen r k -- val )
-\ fejer-sum ( angle n -- val )
-\ legendre-sum ( angle n -- val )
-\ sum-of-n-sines ( angle n -- val )
-\ sum-of-n-odd-sines ( angle n -- val )
-\ sum-of-n-odd-cosines ( angle n -- val )
-\ band-limited-sawtooth ( x a N fi -- val )
-\ band-limited-square-wave ( theta n -- val )
-\ brighten-slightly ( amount :optional snd chn -- )
-\ brighten-slightly-1 ( coeffs :optional snd chn -- )
-\ spectrum->coeffs ( order spectr -- vct )
-\ fltit-1 ( order spectr -- proc; y self -- val )
+\ compute-string ( size x0 x1 x2 ms xs esprs damps haptics -- )
+\ freqdiv ( n :optional snd chn -- )
+\ adsat ( size :optional beg dur snd chn -- res )
+\ spike ( :optional snd chn -- res )
+\ spot-freq ( samp :optional snd chn -- )
+\ chorus ( -- proc; inval self -- val )
+\ chordalize ( -- proc; x self -- val )
+\ zero-phase ( :optional snd chn -- vct )
+\ rotate-phase ( func :optional snd chn -- vct)
+\ make-asyfm ( :key freq initial-phase ratio r index -- gen )
+\ asyfm-J ( gen input -- val )
+\ asyfm-I ( gen input -- val )
+\ make-cosine-summation ( :key frequency initial-phase -- gen )
+\ cosine-summation ( gen r -- val )
+\ make-kosine-summation ( :key frequency initial-phase -- gen )
+\ kosine-summation ( gen r k -- val )
+\ fejer-sum ( angle n -- val )
+\ legendre-sum ( angle n -- val )
+\ sum-of-n-sines ( angle n -- val )
+\ sum-of-n-odd-sines ( angle n -- val )
+\ sum-of-n-odd-cosines ( angle n -- val )
+\ band-limited-sawtooth ( x a N fi -- val )
+\ band-limited-square-wave ( theta n -- val )
+\ brighten-slightly ( amount :optional snd chn -- )
+\ brighten-slightly-1 ( coeffs :optional snd chn -- )
+\ spectrum->coeffs ( order spectr -- vct )
+\ fltit-1 ( order spectr -- proc; y self -- val )
\
-\ make-hilbert-transform ( :optional len -- gen )
-\ make-highpass ( fc :optional len -- gen )
-\ make-lowpass ( fc :optional len -- gen )
-\ make-bandpass ( flo fhi :optional len -- gen )
-\ make-bandstop ( flo fhi :optional len -- gen )
-\ make-differentiator ( :optional len -- gen )
-\ make-butter-high-pass ( freq -- flt )
-\ make-butter-low-pass ( freq -- flt )
-\ make-butter-band-pass ( freq band -- flt )
-\ make-butter-band-reject ( freq band -- flt )
-\ make-biquad ( a0 a1 a2 b1 b2 -- gen )
-\ make-iir-low-pass-2 ( fc :optional d -- gen )
-\ make-iir-high-pass-2 ( fc :optional d -- gen )
-\ make-iir-band-pass-2 ( f1 f2 -- gen )
-\ make-iir-band-stop-2 ( f1 f2 -- gen )
-\ make-eliminate-hum ( :optional hum-freq hum-harmonics bandwith -- )
+\ make-hilbert-transform ( :optional len -- gen )
+\ make-highpass ( fc :optional len -- gen )
+\ make-lowpass ( fc :optional len -- gen )
+\ make-bandpass ( flo fhi :optional len -- gen )
+\ make-bandstop ( flo fhi :optional len -- gen )
+\ make-differentiator ( :optional len -- gen )
+\ make-butter-high-pass ( freq -- flt )
+\ make-butter-low-pass ( freq -- flt )
+\ make-butter-band-pass ( freq band -- flt )
+\ make-butter-band-reject ( freq band -- flt )
+\ make-biquad ( a0 a1 a2 b1 b2 -- gen )
+\ make-iir-low-pass-2 ( fc :optional d -- gen )
+\ make-iir-high-pass-2 ( fc :optional d -- gen )
+\ make-iir-band-pass-2 ( f1 f2 -- gen )
+\ make-iir-band-stop-2 ( f1 f2 -- gen )
+\ make-eliminate-hum ( :optional hum-frq hum-harm bw -- )
\
-\ make-peaking-2 ( f1 f2 m -- prc; y self -- val )
-\ cascade->canonical ( A -- A' )
-\ make-butter-lp ( M fc -- flt )
-\ make-butter-hp ( M fc -- flt )
-\ make-butter-bp ( M f1 f2 -- flt )
-\ make-butter-bs ( M f1 f2 -- flt )
+\ make-peaking-2 ( f1 f2 m -- prc; y self -- val )
+\ cascade->canonical ( A -- A' )
+\ make-butter-lp ( M fc -- flt )
+\ make-butter-hp ( M fc -- flt )
+\ make-butter-bp ( M f1 f2 -- flt )
+\ make-butter-bs ( M f1 f2 -- flt )
\
-\ make-notch-frequency-response ( cur-srate freqs :optional notch-width -- fresp )
-\ notch-channel ( freqs :optional ... )
-\ notch-sound ( freqs :optional filter-order snd chn notch-width -- f )
-\ notch-selection ( freqs :optional filter-order notch-width -- f )
-\ fractional-fourier-transform ( real imaginary n angle -- hr hi )
-\ z-transform ( data n z -- )
-\ dht ( data -- vct )
-\ find-sine ( freq beg dur -- amp ph )
-\ goertzel ( freq :optional beg dur -- amp )
+\ make-notch-frequency-response ( cur-sr freqs :optional notchw -- fresp )
+\ notch-channel ( freqs :optional ... )
+\ notch-sound ( freqs :optional filtero snd chn notchw -- f )
+\ notch-selection ( freqs :optional filtero notchw -- f )
+\ fractional-fourier-transform ( real imaginary n angle -- hr hi )
+\ z-transform ( data n z -- )
+\ dht ( data -- vct )
+\ find-sine ( freq beg dur -- amp ph )
+\ goertzel ( freq :optional beg dur -- amp )
\
-\ make-spencer-filter ( -- gen )
-\ any-random ( amount :optional en -- r )
-\ gaussian-distribution ( s -- en )
-\ pareto-distribution ( a -- en )
-\ inverse-integrate ( dist :optional data-size e-size -- vct )
-\ gaussian-envelope ( s -- en )
+\ make-spencer-filter ( -- gen )
+\ any-random ( amount :optional en -- r )
+\ gaussian-distribution ( s -- en )
+\ pareto-distribution ( a -- en )
+\ inverse-integrate ( dist :optional data-size e-size -- vct )
+\ gaussian-envelope ( s -- en )
\
-\ channel-mean ( :optional snd chn -- val )
-\ channel-total-energy ( :optional snd chn -- val )
-\ channel-average-power ( :optional snd chn -- val )
-\ channel-rms ( :optional snd chn -- val )
-\ channel-variance ( :optional snd chn -- val )
-\ channel-norm ( :optional snd chn -- val )
-\ channel-lp ( p :optional snd chn -- val )
-\ channel-lp-inf ( :optional snd chn -- val )
-\ channel2-inner-product ( s1 c1 s2 c2 -- val )
-\ channel2-angle ( s1 c1 s2 c2 -- val )
-\ channel2-orthogonal? ( s1 c1 s2 c2 -- f )
+\ channel-mean ( :optional snd chn -- val )
+\ channel-total-energy ( :optional snd chn -- val )
+\ channel-average-power ( :optional snd chn -- val )
+\ channel-rms ( :optional snd chn -- val )
+\ channel-variance ( :optional snd chn -- val )
+\ channel-norm ( :optional snd chn -- val )
+\ channel-lp ( p :optional snd chn -- val )
+\ channel-lp-inf ( :optional snd chn -- val )
+\ channel2-inner-product ( s1 c1 s2 c2 -- val )
+\ channel2-angle ( s1 c1 s2 c2 -- val )
+\ channel2-orthogonal? ( s1 c1 s2 c2 -- f )
\ channel2-coefficient-of-projection ( s1 c1 s2 c2 -- val )
-\ channel-distance ( s1 c1 s2 c2 -- val )
-\ periodogram ( N -- )
+\ channel-distance ( s1 c1 s2 c2 -- val )
+\ periodogram ( N -- )
\
-\ shift-channel-pitch ( freq :optional order beg dur snd chn edpos -- val )
-\ ssb-bank ( old-freq new-freq pairs :optional ... )
-\ ssb-bank-env ( old-freq new-freq freq-env pairs :optional ... )
-\ make-transposer ( old-freq new-freq pairs :optional order bw -- gen )
-\ transpose ( gen input -- val )
-\ make-fdelay ( len pitch scaler -- prc; y self -- val )
-\ fdelay ( gen input -- val )
-\ transposed-echo ( pitch scaler secs -- val )
+\ shift-channel-pitch ( frq :optional ord beg dur snd chn ep -- val )
+\ ssb-bank ( ofreq nfreq pairs :optional ... )
+\ ssb-bank-env ( ofreq nfreq freq-env pairs :optional ... )
+\ make-transposer ( ofreq nfreq pairs :optional ord bw -- gen )
+\ transpose ( gen input -- val )
+\ make-fdelay ( len pitch scaler -- prc; y self -- val )
+\ fdelay ( gen input -- val )
+\ transposed-echo ( pitch scaler secs -- val )
\
-\ vct-polynomial ( v coeffs -- vct )
-\ channel-polynomial ( coeffs :optional snd chn -- vct )
-\ spectral-polynomial ( coeffs :optional snd chn -- vct )
+\ vct-polynomial ( v coeffs -- vct )
+\ channel-polynomial ( coeffs :optional snd chn -- vct )
+\ spectral-polynomial ( coeffs :optional snd chn -- vct )
\
-\ scentroid ( file :key beg dur db-floor rfreq fftsize -- vals )
-\ invert-filter ( fcoeffs -- res )
-\ make-volterra-filter ( acoeffs bcoeffs -- gen )
-\ volterra-filter ( flt x -- val )
+\ scentroid ( file :key beg dur db-floor rf ffts -- vals )
+\ invert-filter ( fcoeffs -- res )
+\ make-volterra-filter ( acoeffs bcoeffs -- gen )
+\ volterra-filter ( flt y -- val )
\
-\ make-moving-max ( :optional size -- gen )
-\ moving-max ( gen y -- scl )
-\ make-moving-sum ( :optional size -- gen )
-\ moving-sum ( gen y -- val )
-\ make-moving-rms ( :optional size -- gen )
-\ moving-rms ( gen y -- val )
-\ make-moving-length ( :optional size -- gen )
-\ moving-length ( gen y -- val )
-\ make-smoothing-filter ( size -- gen )
-\ smoothing-filter ( gen sig -- r )
-\ make-exponentially-weighted-moving-average ( order -- r )
-\ make-weighted-moving-average ( order -- r )
-\ weighted-moving-average ( gen sig -- r )
-\ harmonicizer ( freq coeffs pairs :optional ... )
-\ linear-src-channel ( sr :optional snd chn -- file )
-\ make-mfilter ( :key decay frequency -- gen )
-\ mfilter ( m :optional x-input y-input -- val )
-\ display-bark-fft ( :optional off -- )
-\ undisplay-bark-fft ( -- )
-\ lpc-coeffs ( data n m -- val )
-\ lpc-predict ( data n coeffs m nf :optional clipped -- val )
-\ unclip-channel ( :optional snd chn -- assoc )
-\ unclip-sound ( :optional snd -- assoc )
+\ make-moving-max ( :optional size -- gen )
+\ moving-max ( gen y -- scl )
+\ make-moving-sum ( :optional size -- gen )
+\ moving-sum ( gen y -- val )
+\ make-moving-rms ( :optional size -- gen )
+\ moving-rms ( gen y -- val )
+\ make-moving-length ( :optional size -- gen )
+\ moving-length ( gen y -- val )
+\ make-smoothing-filter ( size -- gen )
+\ smoothing-filter ( gen sig -- r )
+\ make-exponentially-weighted-moving-average ( order -- r )
+\ make-weighted-moving-average ( order -- r )
+\ weighted-moving-average ( gen sig -- r )
+\ harmonicizer ( freq coeffs pairs :optional ... )
+\ linear-src-channel ( sr :optional snd chn -- file )
+\ display-bark-fft ( :optional off -- )
+\ undisplay-bark-fft ( -- )
+\ lpc-coeffs ( data n m -- val )
+\ lpc-predict ( data n coeffs m nf :optional clipped -- val )
+\ unclip-channel ( :optional snd chn -- assoc )
+\ unclip-sound ( :optional snd -- assoc )
require clm
require env
@@ -144,235 +144,272 @@ require examp
\ ;;; -------- src-duration (see src-channel in extsnd.html)
: src-duration ( en -- dur )
- doc" Returns the new duration of a sound after using ENVELOPE \
+ doc" Return new duration of a sound after using ENVELOPE \
for time-varying sampling-rate conversion."
- { en }
- en 0 object-ref { ex0 }
- en -2 object-ref { ex1 }
- ex1 ex0 f- { all-x }
- 0.0 ( dur )
- en object-length 3 - 0 ?do
- en i object-ref { x0 }
- en i 1 + object-ref { xy0 }
- en i 2 + object-ref { x1 }
- en i 3 + object-ref { xy1 }
- xy0 f0= if 1.0 else xy0 1/f then { y0 }
- xy1 f0= if 1.0 else xy1 1/f then { y1 }
- xy0 xy1 f- fabs 0.0001 f< if
- x1 x0 f- all-x f/ y0 f*
- else
- y1 flog y0 flog f- xy0 xy1 f- f/ x1 x0 f- all-x f/ f*
- then ( area ) fabs ( dur ) f+
- 2 +loop
- ( dur )
-;
-: src-fit-envelope { e1 target-dur -- e2 } e1 e1 src-duration target-dur f/ scale-envelope ;
+ { en }
+ en 0 object-ref { ex0 }
+ en -2 object-ref { ex1 }
+ ex1 ex0 f- { all-x }
+ 0.0 ( dur )
+ en object-length 3 - 0 ?do
+ en i object-ref { x0 }
+ en i 1 + object-ref { xy0 }
+ en i 2 + object-ref { x1 }
+ en i 3 + object-ref { xy1 }
+ xy0 f0= if 1.0 else xy0 1/f then { y0 }
+ xy1 f0= if 1.0 else xy1 1/f then { y1 }
+ xy0 xy1 f- fabs 0.0001 f< if
+ x1 x0 f- all-x f/ y0 f*
+ else
+ y1 flog y0 flog f- xy0 xy1 f- f/ x1 x0 f- all-x f/ f*
+ then ( area ) fabs ( dur ) f+
+ 2 +loop
+ ( dur )
+;
+
+: src-fit-envelope { e1 target-dur -- e2 }
+ e1 e1 src-duration target-dur f/ scale-envelope
+;
'complex provided? [if]
- \ ;;; -------- Dolph-Chebyshev window
- \ ;;;
- \ ;;; formula taken from Richard Lyons, "Understanding DSP"
- \ ;;; see clm.c for C version (using either GSL's or GCC's complex trig functions)
-
- : dolph ( n gamma -- im )
- doc" Produces a Dolph-Chebyshev FFT data window of N points using GAMMA as the window parameter."
- { n gamma }
- 10.0 gamma f** cacosh n c/ ccosh { alpha }
- alpha cacosh n c* ccosh 1/c { den }
- n 0.0 make-vct { rl }
- n 0.0 make-vct { im }
- pi n f/ { freq }
- 0.0 { phase }
- n 0 ?do
- phase ccos alpha c* cacos n c* ccos den c* { val }
- rl i val real-ref vct-set! drop
- im i val imag-ref vct-set! drop
- phase freq f+ to phase
- loop
- rl im -1 fft ( rl ) dup vct-peak 1/f vct-scale! ( rl ) n 2/ cycle-start!
- n 0 ?do im i rl cycle-ref vct-set! drop loop
- im
- ;
-
- \ ;;; this version taken from Julius Smith's "Spectral Audio..." with three changes
- \ ;;; it does the DFT by hand, and is independent of anything from Snd (fft, vcts etc)
-
- : dolph-1 ( n gamma -- im )
- { n gamma }
- 10.0 gamma f** cacosh n c/ ccosh { alpha }
- alpha cacosh n c* ccosh 1/c { den }
- pi n f/ { freq }
- half-pi fnegate { phase }
- -1.0 { mult }
- n make-array map!
- phase ccos alpha c* cacos n c* ccos den c* mult c* ( val )
- mult fnegate to mult
- phase freq f+ to phase
- ( val )
- end-map { vals }
- \ now take the DFT
- 0.0 { pk }
- n make-array map!
- 0.0 ( sum )
- vals each ( val ) 0+1.0i two-pi c* j c* i c* n c/ cexp c* c+ ( sum++ ) end-each cabs { sum }
- sum pk f> if sum to pk then
- sum
- end-map ( w ) map! *key* pk f/ end-map ( w )
- ;
+ \ ;;; -------- Dolph-Chebyshev window
+ \ ;;;
+ \ ;;; formula taken from Richard Lyons, "Understanding DSP"
+ \ ;;; see clm.c for C version (using either GSL's or GCC's complex
+ \ ;;; trig functions)
+
+ : dolph ( n gamma -- im )
+ doc" Produce Dolph-Chebyshev FFT data window \
+of N points using GAMMA as the window parameter."
+ { n gamma }
+ 10.0 gamma f** cacosh n c/ ccosh { alpha }
+ alpha cacosh n c* ccosh 1/c { den }
+ n 0.0 make-vct { rl }
+ n 0.0 make-vct { im }
+ pi n f/ { freq }
+ 0.0 { phase }
+ n 0 ?do
+ phase ccos alpha c* cacos n c* ccos den c* { val }
+ rl i val real-ref vct-set! drop
+ im i val imag-ref vct-set! drop
+ phase freq f+ to phase
+ loop
+ rl im -1 fft ( rl ) dup
+ vct-peak 1/f vct-scale! ( rl ) n 2/ cycle-start!
+ n 0 ?do
+ im i rl cycle-ref vct-set! drop
+ loop
+ im
+ ;
+
+ \ ;;; this version taken from Julius Smith's "Spectral Audio..." with
+ \ ;;; three changes it does the DFT by hand, and is independent of
+ \ ;;; anything from Snd (fft, vcts etc)
+
+ : dolph-1 ( n gamma -- im )
+ { n gamma }
+ 10.0 gamma f** cacosh n c/ ccosh { alpha }
+ alpha cacosh n c* ccosh 1/c { den }
+ pi n f/ { freq }
+ half-pi fnegate { phase }
+ -1.0 { mult }
+ n make-array map!
+ phase ccos alpha c* cacos n c* ccos den c* mult c* ( x )
+ mult fnegate to mult
+ phase freq f+ to phase
+ ( x )
+ end-map { vals }
+ \ now take the DFT
+ 0.0 { pk }
+ n make-array map!
+ 0.0 ( sum )
+ vals each ( val )
+ 0+1.0i two-pi c*
+ j c* i c* n c/ cexp c* c+ ( sum++ )
+ end-each cabs { sum }
+ sum pk f> if
+ sum to pk
+ then
+ sum
+ end-map ( w ) map! *key* pk f/ end-map ( w )
+ ;
[then]
\ ;;; ------- move sound down by n (a power of 2) ---
: down-oct <{ n :optional snd #f chn #f -- vct }>
- doc" Moves a sound down by power of 2 n."
- snd chn #f frames { len }
- 2.0 len flog 2.0 flog f/ fceil ( pow2 ) f** f>s { fftlen }
- fftlen 1/f { fftscale }
- 0 fftlen snd chn #f channel->vct { rl1 }
- fftlen 0.0 make-vct { im1 }
- rl1 im1 1 fft drop
- rl1 fftscale vct-scale! drop
- im1 fftscale vct-scale! drop
- fftlen n * 0.0 make-vct { rl2 }
- fftlen n * 0.0 make-vct { im2 }
- fftlen 1- { kdx }
- fftlen n * 1- { jdx }
- fftlen 2/ 0 ?do
- rl2 i rl1 i vct-ref vct-set! drop
- rl2 jdx rl1 kdx vct-ref vct-set! drop
- im2 i im1 i vct-ref vct-set! drop
- im2 jdx im1 kdx vct-ref vct-set! drop
- jdx 1- to jdx
- kdx 1- to kdx
- loop
- rl2 im2 -1 fft
- rl2 0 n len * snd chn #f $" %s %s" #( n get-func-name ) string-format vct->channel
+ doc" Move sound down by power of 2 n."
+ snd chn #f framples { len }
+ 2.0 len flog 2.0 flog f/ fceil ( pow2 ) f** f>s { fftlen }
+ fftlen 1/f { fftscale }
+ 0 fftlen snd chn #f channel->vct { rl1 }
+ fftlen 0.0 make-vct { im1 }
+ rl1 im1 1 fft ( rl1 ) fftscale vct-scale! drop
+ im1 fftscale vct-scale! drop
+ fftlen n * 0.0 make-vct { rl2 }
+ fftlen n * 0.0 make-vct { im2 }
+ fftlen 1- { kdx }
+ fftlen n * 1- { jdx }
+ fftlen 2/ 0 ?do
+ rl2 i rl1 i vct-ref vct-set! drop
+ rl2 jdx rl1 kdx vct-ref vct-set! drop
+ im2 i im1 i vct-ref vct-set! drop
+ im2 jdx im1 kdx vct-ref vct-set! drop
+ jdx 1- to jdx
+ kdx 1- to kdx
+ loop
+ rl2 im2 -1 fft ( rl2 ) 0 n len * snd chn #f
+ "%s %s" #( n get-func-name ) string-format vct->channel
;
'complex provided? [if]
- : stretch-sound-via-dft <{ factor :optional snd #f chn #f -- }>
- doc" Makes the given channel longer (FACTOR should be > 1.0) \
- by squeezing in the frequency domain, then using the inverse DFT to get the time domain result."
- snd chn #f frames { n }
- n f2/ floor f>s { n2 }
- n factor f* fround->s { out-n }
- 0 n snd chn #f channel->vct { in-data }
- out-n :initial-element 0.0 make-array { fr }
- two-pi n f/ { freq }
- n 0 ?do
- i n2 < if
- fr i freq 0.0-1.0i c* i c* in-data edot-product array-set!
- else
- fr out-n n - 1- i + freq 0.0-1.0i c* i c* in-data edot-product array-set!
- then
- loop
- two-pi out-n f/ { freq }
- out-n 0.0 make-vct map! freq 0.0+1.0i c* i c* fr edot-product n c/ real-ref end-map ( out-data )
- 0 out-n snd chn #f $" %s %s" #( factor get-func-name ) string-format vct->channel drop
- ;
+ : stretch-sound-via-dft <{ factor :optional snd #f chn #f -- }>
+ doc" Make given channel longer (FACTOR should be > 1.0) \
+by squeezing in the frequency domain, then using the inverse DFT \
+to get the time domain result."
+ snd chn #f framples { n }
+ n f2/ floor f>s { n2 }
+ n factor f* fround->s { out-n }
+ 0 n snd chn #f channel->vct { in-data }
+ out-n :initial-element 0.0 make-array { fr }
+ two-pi n f/ { freq }
+ n 0 ?do
+ i n2 < if
+ fr i freq 0.0-1.0i c* i c*
+ else
+ fr out-n n - 1- i + freq 0.0-1.0i c* i c*
+ then in-data edot-product array-set!
+ loop
+ two-pi out-n f/ { freq }
+ out-n 0.0 make-vct map!
+ freq 0.0+1.0i c* i c* fr edot-product n c/ real-ref
+ end-map ( out-data ) 0 out-n snd chn #f
+ "%s %s" #( factor get-func-name ) string-format
+ vct->channel drop
+ ;
[then]
\ ;;; -------- compute-uniform-circular-string
\ ;;;
-\ ;;; this is a simplification of the underlying table-filling routine for "scanned synthesis".
-\ ;;; To watch the wave, open some sound (so Snd has some place to put the graph), turn off
-\ ;;; the time domain display (to give our graph all the window -- to do this in a much more
-\ ;;; elegant manner, see snd-motif.scm under scanned-synthesis).
+\ ;;; this is a simplification of the underlying table-filling routine
+\ ;;; for "scanned synthesis". To watch the wave, open some sound (so
+\ ;;; Snd has some place to put the graph), turn off the time domain display
+\ ;;; (to give our graph all the window -- to do this in a much more elegant
+\ ;;; manner, see snd-motif.scm under scanned-synthesis).
: compute-uniform-circular-string ( size x0 x1 x2 mass xspring damp -- )
- { size x0 x1 x2 mass xspring damp }
- damp mass f/ { dm }
- xspring mass f/ { km }
- 1.0 dm f+ { denom }
- dm km f2* f- 2.0 f+ denom f/ { p1 }
- km denom f/ { p2 }
- -1.0 denom f/ { p3 }
- x0 map!
- x1 i vct-ref p1 f*
- x1 i 1- object-ref x1 i 1+ size = if 0 else i 1+ then object-ref f+ p2 f* f+
- x2 i vct-ref p3 f* f+
- end-map to x0
- x2 0.0 vct-fill! drop
- x2 x1 vct-add! drop
- x1 0.0 vct-fill! drop
- x1 x2 vct-add! drop
+ { size x0 x1 x2 mass xspring damp }
+ damp mass f/ { dm }
+ xspring mass f/ { km }
+ 1.0 dm f+ { denom }
+ dm km f2* f- 2.0 f+ denom f/ { p1 }
+ km denom f/ { p2 }
+ -1.0 denom f/ { p3 }
+ x0 map!
+ x1 i vct-ref p1 f*
+ x1 i 1- object-ref x1 i 1+ size = if
+ 0
+ else
+ i 1+
+ then object-ref f+ p2 f* f+
+ x2 i vct-ref p3 f* f+
+ end-map to x0
+ x2 0.0 vct-fill! drop
+ x2 x1 vct-add! drop
+ x1 0.0 vct-fill! drop
+ x1 x2 vct-add! drop
;
: compute-string ( size x0 x1 x2 masses xsprings esprings damps haptics -- )
- { size x0 x1 x2 masses xsprings esprings damps haptics }
- x0 map!
- damps i vct-ref masses i vct-ref f/ { dm }
- xsprings i vct-ref masses i vct-ref f/ { km }
- esprings i vct-ref masses i vct-ref f/ { cm }
- 1.0 dm cm f+ f+ { denom }
- dm km f2* f- 2.0 f+ denom f/ { p1 }
- km denom f/ { p2 }
- -1.0 denom f/ { p3 }
- haptics i vct-ref masses i vct-ref denom f* f/ { p4 }
- x1 i vct-ref p1 f*
- x1 i 1- object-ref x1 i 1+ size = if 0 else i 1+ then vct-ref f+ p2 f* f+
- x2 i vct-ref p3 f* f+
- p4 f+
- end-map to x0
- size 0 ?do
- x2 i x1 i vct-ref vct-set! drop
- x1 i x0 i vct-ref vct-set! drop
- loop
+ { size x0 x1 x2 masses xsprings esprings damps haptics }
+ x0 map!
+ damps i vct-ref masses i vct-ref f/ { dm }
+ xsprings i vct-ref masses i vct-ref f/ { km }
+ esprings i vct-ref masses i vct-ref f/ { cm }
+ 1.0 dm cm f+ f+ { denom }
+ dm km f2* f- 2.0 f+ denom f/ { p1 }
+ km denom f/ { p2 }
+ -1.0 denom f/ { p3 }
+ haptics i vct-ref masses i vct-ref denom f* f/ { p4 }
+ x1 i vct-ref p1 f*
+ x1 i 1- object-ref
+ x1 i 1+ size = if
+ 0
+ else
+ i 1+
+ then vct-ref f+ p2 f* f+
+ x2 i vct-ref p3 f* f+ p4 f+
+ end-map to x0
+ size 0 ?do
+ x2 i x1 i vct-ref vct-set! drop
+ x1 i x0 i vct-ref vct-set! drop
+ loop
;
\ ;;; -------- "frequency division" -- an effect from sed_sed at my-dejanews.com
hide
-: freqdiv-cb { div n curval -- proc; y self -- val }
- 1 proc-create div , n , curval ,
- does> ( y self -- val )
- { y self }
- self @ { div }
- self cell+ @ { n }
- div 0= if y self 2 cells + ! ( curval ) then
- 1 self +! ( div++ )
- div n = if 0 self ! then
- self 2 cells + @ ( curval )
+: freqdiv-cb { div n curval -- prc; y self -- val }
+ 1 proc-create ( prc )
+ div , n , curval ,
+ does> ( y self -- val )
+ { y self }
+ self @ { div }
+ self cell+ @ { n }
+ div 0= if
+ y self 2 cells + ! ( curval )
+ then
+ 1 self +! ( div++ )
+ div n = if
+ 0 self !
+ then
+ self 2 cells + @ ( curval )
;
set-current
+
: freqdiv <{ n :optional snd #f chn #f -- val }>
- doc" Repeats each nth sample N times (clobbering the intermediate samples): 8 freqdiv"
- 0 n 0.0 freqdiv-cb 0 #f snd chn #f $" %s %s" #( n get-func-name ) format map-channel
+ doc" Repeat each nth sample N times (clobbering the \
+intermediate samples): 8 freqdiv."
+ 0 n 0.0 freqdiv-cb 0 #f snd chn #f
+ "%s %s" #( n get-func-name ) string-format map-channel
;
previous
-\ ;;; -------- "adaptive saturation" -- an effect from sed_sed at my-dejanews.com ---
+\ ;;; -------- "adaptive saturation" -- an effect from sed_sed at my-dejanews.com
hide
-: adsat-cb { mn mx n vals -- proc; inval self -- res }
- 1 proc-create { prc } vals , n , mx , mn , prc
- does> ( inval self -- res )
- { inval self }
- self @ { vals }
- self 1 cells + @ { n }
- self 2 cells + @ { mx }
- self 3 cells + @ { mn }
- vals length n = if
- vals each { x }
- vals i x f0>= if mx else mn then vct-set! drop
- end-each
- 0 self 1 cells + ! ( n )
- 0.0 self 2 cells + ! ( mx )
- 0.0 self 3 cells + ! ( mn )
- vals
- else
- vals n inval vct-set! drop
- 1 self 1 cells + +! ( n++ )
- inval mx fmax self 2 cells + ! ( mx )
- inval mn fmin self 3 cells + ! ( mn )
- #f
- then
+: adsat-cb { mn mx n vals -- prc; inval self -- res }
+ 1 proc-create ( prc )
+ vals , n , mx , mn ,
+ does> ( inval self -- res )
+ { inval self }
+ self @ { vals }
+ self 1 cells + @ { n }
+ self 2 cells + @ { mx }
+ self 3 cells + @ { mn }
+ vals length n = if
+ vals each { x }
+ vals i x f0>= if mx else mn then vct-set! drop
+ end-each
+ 0 self 1 cells + ! ( n )
+ 0.0 self 2 cells + ! ( mx )
+ 0.0 self 3 cells + ! ( mn )
+ vals
+ else
+ vals n inval vct-set! drop
+ 1 self 1 cells + +! ( n++ )
+ inval mx fmax self 2 cells + ! ( mx )
+ inval mn fmin self 3 cells + ! ( mn )
+ #f
+ then
;
set-current
+
: adsat <{ size :optional beg 0 dur #f snd #f chn #f -- val }>
- doc" An 'adaptive saturation' sound effect."
- $" %s %s %s %s" #( size beg dur get-func-name ) string-format { origin }
- 0.0 0.0 0 size 0.0 make-vct adsat-cb beg dur snd chn #f origin map-channel
+ doc" An 'adaptive saturation' sound effect."
+ 0.0 0.0 0 size 0.0 make-vct adsat-cb
+ beg dur snd chn #f "%s %s %s %s"
+ #( size beg dur get-func-name ) string-format map-channel
;
previous
@@ -381,65 +418,73 @@ previous
\ ;;; makes sound more spikey -- sometimes a nice effect
hide
-: spike-cb ( snd chn -- proc; x0 self -- res )
- { snd chn }
- snd chn #f maxamp { amp }
- 1 proc-create 0.0 ( x1 ) , 0.0 ( x2 ) , amp ,
- does> ( x0 self -- res )
- { x0 self }
- self @ { x1 }
- self 1 cells + @ { x2 }
- self 2 cells + @ { amp }
- x0 amp amp f* f/ x2 fabs f* x1 fabs f* { res }
- x1 self cell+ ! ( x2 )
- x0 self ! ( x1 )
- res
+: spike-cb ( snd chn -- prc; x0 self -- res )
+ { snd chn }
+ snd chn #f maxamp { amp }
+ 1 proc-create ( prc )
+ 0.0 ( x1 ) , 0.0 ( x2 ) , amp ,
+ does> ( x0 self -- res )
+ { x0 self }
+ self @ { x1 }
+ self 1 cells + @ { x2 }
+ self 2 cells + @ { amp }
+ x0 amp amp f* f/ x2 fabs f* x1 fabs f* { res }
+ x1 self cell+ ! ( x2 )
+ x0 self ! ( x1 )
+ res
;
set-current
+
: spike <{ :optional snd #f chn #f -- val }>
- doc" Multiplies successive samples together to make a sound more spikey."
- snd chn spike-cb 0 #f snd chn #f get-func-name map-channel
+ doc" Multiply successive samples together to make a sound more spikey."
+ snd chn spike-cb 0 #f snd chn #f get-func-name map-channel
;
previous
\ ;;; -------- easily-fooled autocorrelation-based pitch tracker
: spot-freq <{ samp :optional snd #f chn #f -- }>
- doc" Tries to determine the current pitch: left-sample spot-freq"
- snd srate s>f { sr }
- 2.0 sr 20.0 f/ flog 2.0 flog f/ fceil f** fround->s { fftlen }
- samp fftlen snd chn #f channel->vct autocorrelate { data }
- data vct-peak { cor-peak }
- cor-peak f2* { cor-peak2 }
- 0.0 ( ret )
- fftlen 2 - 1 ?do
- data i vct-ref data i 1 + vct-ref f<
- data i 1 + vct-ref data i 2 + vct-ref f> && if
- drop ( old ret )
- data i vct-ref cor-peak f+ cor-peak2 f/ flog10 { logla }
- data i 1 + vct-ref cor-peak f+ cor-peak2 f/ flog10 { logca }
- data i 2 + vct-ref cor-peak f+ cor-peak2 f/ flog10 { logra }
- logla logra f- f2/ logla logra f+ logca -2.0 f* f+ f/ { offset }
- sr offset i f+ 1.0 f+ f2* f/ ( new ret )
- leave
- then
- loop
+ doc" Try to determine the current pitch: left-sample spot-freq."
+ snd srate s>f { sr }
+ 2.0 sr 20.0 f/ flog 2.0 flog f/ fceil f** fround->s { fftlen }
+ samp fftlen snd chn #f channel->vct autocorrelate { data }
+ data vct-peak { cor-peak }
+ cor-peak f2* { cor-peak2 }
+ 0.0 ( ret )
+ fftlen 2 - 1 ?do
+ data i vct-ref data i 1 + vct-ref f<
+ data i 1 + vct-ref data i 2 + vct-ref f> && if
+ drop ( old ret )
+ data i vct-ref cor-peak f+ cor-peak2 f/
+ flog10 { logla }
+ data i 1 + vct-ref cor-peak f+ cor-peak2 f/
+ flog10 { logca }
+ data i 2 + vct-ref cor-peak f+ cor-peak2 f/
+ flog10 { logra }
+ logla logra f- f2/ logla logra f+ logca -2.0
+ f* f+ f/ { offset }
+ sr offset i f+ 1.0 f+ f2* f/ ( new ret )
+ leave
+ then
+ loop
;
0 [if]
\ Left sample:
graph-hook lambda: <{ snd chn y0 y1 -- f }>
- $" freq: %.3f" #( snd chn LEFT-SAMPLE snd chn spot-freq ) string-format
- snd #f report-in-minibuffer drop
- #f
+ "freq: %.3f"
+ #( snd chn LEFT-SAMPLE snd chn spot-freq )
+ string-format snd status-report drop
+ #f
; add-hook!
\ At cursor position:
mouse-click-hook lambda: <{ snd chn button state x y axis -- }>
- axis time-graph = if
- $" freq: %.3f" #( snd chn #f CURSOR snd chn spot-freq ) string-format
- snd #f report-in-minibuffer
- else
- #f
- then
+ axis time-graph = if
+ "freq: %.3f"
+ #( snd chn #f CURSOR snd chn spot-freq )
+ string-format snd status-report
+ else
+ #f
+ then
; add-hook!
[then]
@@ -452,151 +497,216 @@ mouse-click-hook lambda: <{ snd chn button state x y axis -- }>
hide
: make-flanger ( -- ri gen )
- :frequency chorus-speed :amplitude chorus-amount make-rand-interp { ri }
- chorus-time 3.0 f* #f srate f* random floor f>s { len }
- len :max-size len chorus-amount f>s + 1+ make-delay { gen }
- #( gen ri )
+ :frequency chorus-speed :amplitude chorus-amount make-rand-interp { ri }
+ chorus-time 3.0 f* #f srate f* random floor f>s { len }
+ len :max-size len chorus-amount f>s + 1+ make-delay { gen }
+ #( gen ri )
;
+
: flanger ( dly inval -- val )
- { dly inval }
- dly 0 array-ref inval dly 1 array-ref 0.0 rand-interp delay inval f+
+ { dly inval }
+ dly 0 array-ref inval dly 1 array-ref 0.0 rand-interp delay inval f+
;
set-current
-: chorus ( -- proc; inval self -- val )
- doc" Tries to produce the chorus sound effect."
- chorus-size make-array map! make-flanger end-map { dlys }
- 1 proc-create dlys ,
- does> ( inval self -- val )
- { inval self }
- self @ { dlys }
- 0.0 ( sum ) dlys each ( dly ) inval flanger f+ ( sum++ ) end-each
+
+: chorus ( -- prc; inval self -- val )
+ doc" Try to produce the chorus sound effect."
+ chorus-size make-array map!
+ make-flanger
+ end-map { dlys }
+ 1 proc-create ( prc )
+ dlys ,
+ does> { inval self -- val }
+ self @ { dlys }
+ 0.0 ( sum )
+ dlys each ( dly )
+ inval flanger f+ ( sum++ )
+ end-each
;
previous
-\ ;;; -------- chordalize (comb filters to make a chord using chordalize-amount and chordalize-base)
-
-0.95 value chordalize-amount
-100 value chordalize-base
-#( 1 3/4 5/4 ) value chordalize-chord
-
-: chordalize ( -- proc; x self -- val )
- doc" Uses harmonically-related comb-filters to bring out a chord in a sound. \
-Global variable CHORDALIZE-CHORD is an array of members of chord such as #( 1 5/4 3/2 )."
- chordalize-chord map
- :scaler chordalize-amount :size chordalize-base *key* r* r>s make-comb
- end-map { combs }
- chordalize-chord length 0.5 f/ { scaler }
- 1 proc-create combs , scaler ,
- does> ( x self -- val )
- { x self }
- self @ { combs }
- self cell+ @ { scaler }
- 0.0 ( val ) combs each ( gen ) x 0.0 comb f+ ( val += ... ) end-each scaler f*
+\ ;;; -------- chordalize (comb filters to make a chord using
+\ ;;; chordalize-amount and chordalize-base)
+
+0.95 value chordalize-amount
+100 value chordalize-base
+'ratio provided? [if]
+ #( 1 3/4 5/4 )
+[else]
+ <'> f* alias q*
+ <'> f>s alias q>s
+ #( 1 3 4 f/ 5 4 f/ )
+[then] value chordalize-chord
+
+: chordalize ( -- prc; x self -- val )
+ doc" Use harmonically-related comb-filters to bring \
+out a chord in a sound. \
+Global variable CHORDALIZE-CHORD is an array of members \
+of chord such as #( 1 5/4 3/2 )."
+ chordalize-chord map
+ :scaler chordalize-amount
+ :size chordalize-base *key* q* q>s make-comb
+ end-map { combs }
+ chordalize-chord length 0.5 f/ { scaler }
+ 1 proc-create ( prc )
+ combs , scaler ,
+ does> { x self -- val }
+ self @ { combs }
+ self cell+ @ { scaler }
+ 0.0 ( val ) combs each ( gen )
+ x 0.0 comb f+ ( val += ... )
+ end-each scaler f*
;
\ ;;; -------- zero-phase, rotate-phase
\ ;;; fft games (from the "phazor" package of Scott McNab)
: zero-phase <{ :optional snd #f chn #f -- vct }>
- doc" Calls fft, sets all phases to 0, and un-ffts."
- snd chn #f frames { len }
- 2.0 len flog 2.0 flog f/ fceil ( pow2 ) f** fround->s { fftlen }
- fftlen 1/f { fftscale }
- 0 fftlen snd chn #f channel->vct { rl }
- rl vct-peak { old-pk }
- fftlen 0.0 make-vct { im }
- rl im 1 fft drop
- rl im rectangular->polar drop
- rl fftscale vct-scale! drop
- im 0.0 vct-scale! drop
- rl im -1 fft drop
- rl vct-peak { pk }
- rl old-pk pk f/ vct-scale! 0 len snd chn #f get-func-name vct->channel
+ doc" Call fft, set all phases to 0, and un-fft."
+ snd chn #f framples { len }
+ 2.0 len flog 2.0 flog f/ fceil ( pow2 ) f** fround->s { fftlen }
+ fftlen 1/f { fftscale }
+ 0 fftlen snd chn #f channel->vct { rl }
+ rl vct-peak { old-pk }
+ fftlen 0.0 make-vct { im }
+ rl im 1 fft ( rl ) im rectangular->polar drop
+ rl fftscale vct-scale! drop
+ im 0.0 vct-scale! drop
+ rl im -1 fft ( rl ) vct-peak { pk }
+ rl old-pk pk f/ vct-scale! 0 len snd chn #f get-func-name vct->channel
;
: rotate-phase <{ func :optional snd #f chn #f -- vct }>
- doc" Calls fft, applies FUNC, a proc or xt, to each phase, then un-ffts."
- func word? func 1 $" a proc or xt" assert-type
- snd chn #f frames { len }
- 2.0 len flog 2.0 flog f/ fceil ( pow2 ) f** fround->s { fftlen }
- fftlen 2/ { fftlen2 }
- fftlen 1/f { fftscale }
- 0 fftlen snd chn #f channel->vct { rl }
- rl vct-peak { old-pk }
- fftlen 0.0 make-vct { im }
- rl im 1 fft drop
- rl im rectangular->polar drop
- rl fftscale vct-scale! drop
- im 0 0.0 vct-set! drop
- func xt? if func 1 make-proc to func then
- fftlen2 1 ?do
- im i func #( im i object-ref ) run-proc object-set!
- im i negate im i negate object-ref fnegate object-set! \ handles negative index
- loop
- rl im -1 fft drop
- rl vct-peak { pk }
- $" <'> %s %s" #( func proc-name get-func-name ) string-format { origin }
- rl old-pk pk f/ vct-scale! 0 len snd chn #f origin vct->channel
-;
-\ See note above for a good origin for reuse.
-\ lambda: <{ x }> 0.0 ; rotate-phase \ is the same as zero-phase
-\ lambda: <{ x }> pi random ; rotate-phase \ randomizes phases
-\ lambda: <{ x }> x ; rotate-phase \ returns original
-\ lambda: <{ x }> x fnegate ; rotate-phase \ reverses original
-\ lambda: <{ x }> x f2* ; rotate-phase \ reverb-effect (best with voice)
-\ lambda: <{ x }> x 12.0 f* ; rotate-phase \ "bruise blood" effect
+ doc" Call fft, apply FUNC, a proc or xt, to each phase, then un-fft."
+ func word? func 1 "a proc or xt" assert-type
+ snd chn #f framples { len }
+ 2.0 len flog 2.0 flog f/ fceil ( pow2 ) f** fround->s { fftlen }
+ fftlen 2/ { fftlen2 }
+ fftlen 1/f { fftscale }
+ 0 fftlen snd chn #f channel->vct { rl }
+ rl vct-peak { old-pk }
+ fftlen 0.0 make-vct { im }
+ \ fft returns result in rl
+ rl im 1 fft ( rl ) im rectangular->polar drop
+ rl fftscale vct-scale! drop
+ im 0 0.0 vct-set! drop
+ func xt? if
+ func 1 make-proc to func
+ then
+ fftlen2 1 ?do
+ im i func #( im i object-ref ) run-proc object-set!
+ \ handles negative index
+ im i negate im i negate object-ref fnegate object-set!
+ loop
+ rl im -1 fft ( rl ) vct-peak { pk }
+ func proc-name { pn }
+ pn length 0= if
+ "noname" to pn
+ then
+ "<'> %s %s" #( pn get-func-name ) string-format { origin }
+ rl old-pk pk f/ vct-scale! 0 len snd chn #f origin vct->channel
+;
+
+\ XXX: origin in rotate-phase [ms]
+\ If FUNC isn't a proc or xt with a name (eg: 'lambda:' has no name),
+\ the origin will not be useful.
+\
+\ The next two lines will deliver a useful origin:
+\ : rot-zero-ph ( y -- 0.0 ) drop 0.0 ;
+\ <'> rot-zero-ph rotate-phase
+\
+\ while this won't:
+\ lambda: { y -- 0.0 } 0.0 ; rotate-phase
+\
+\ Here are the examples from dsp.scm:
+\ lambda: { y -- r } 0.0 ; rotate-phase \ is the same as zero-phase
+\ lambda: { y -- r } pi random ; rotate-phase \ randomizes phases
+\ lambda: { y -- r } y ; rotate-phase \ returns original
+\ lambda: { y -- r } y fnegate ; rotate-phase \ reverses original
+\ lambda: { y -- r } y f2* ; rotate-phase \ reverb-effect (best with voice)
+\ lambda: { y -- r } y 12.0 f* ; rotate-phase \ "bruise blood" effect
\ ;;; -------- asymmetric FM (bes-i0 case)
-: make-asyfm <{ :key frequency 440.0 initial-phase 0.0 ratio 1.0 r 1.0 index 1.0 -- gen }>
- #{ :freq frequency hz->radians
- :phase initial-phase
- :ratio ratio
- :r r
- :index index }
-;
-: asyfm-freq-ref ( gen -- val ) :freq hash-ref radians->hz ;
-: asyfm-freq-set! ( gen val -- ) :freq swap hz->radians hash-set! drop ;
-: asyfm-phase-ref ( gen -- val ) :phase hash-ref ;
-: asyfm-phase-set! ( gen val -- ) :phase swap hash-set! drop ;
-: asyfm-ratio-ref ( gen -- val ) :ratio hash-ref ;
-: asyfm-ratio-set! ( gen val -- ) :ratio swap hash-set! drop ;
-: asyfm-r-ref ( gen -- val ) :r hash-ref ;
-: asyfm-r-set! ( gen val -- ) :r swap hash-set! drop ;
-: asyfm-index-ref ( gen -- val ) :index hash-ref ;
-: asyfm-index-set! ( gen val -- ) :index swap hash-set! drop ;
+#( "asyfm-freq"
+ "asyfm-phase"
+ "asyfm-ratio"
+ "asyfm-r"
+ "asyfm-index" ) create-struct make-asymmetric-struct
+
+: make-asyfm <{ :key frequency *clm-default-frequency* initial-phase 0.0 ratio 1.0 r 1.0 index 1.0 -- gen }>
+ make-asymmetric-struct { gen }
+ gen frequency hz->radians asyfm-freq!
+ gen initial-phase asyfm-phase!
+ gen ratio asyfm-ratio!
+ gen r asyfm-r!
+ gen index asyfm-index!
+ gen
+;
+
: asyfm-J ( gen input -- val )
- doc" ;; this is the same as the CLM asymmetric-fm generator, \
+ doc" ;; This is the same as the CLM asymmetric-fm generator, \
set r != 1.0 to get the asymmetric spectra.\n\
:frequency 2000 :ratio 0.1 make-asyfm value gen\n\
-lambda: <{ n }> gen 0.0 asyfm-J ; map-channel."
- { gen input }
- gen :freq hash-ref { freq }
- gen :phase hash-ref { phase }
- gen :ratio hash-ref { ratio }
- gen :r hash-ref { r }
- gen :index hash-ref { index }
- r 1/f { r1 }
- ratio phase f* { modphase }
- modphase fcos r r1 f- f* index f* 0.5 f* fexp
- modphase fsin r r1 f+ f* index f* 0.5 f* phase f+ fsin f* ( val )
- gen :phase phase input freq f+ f+ hash-set! drop
-;
-\ :frequency 2000 :ratio 0.1 value gen
-\ lambda: <{ n -- val }> gen 0.0 asyfm-J ; map-channel
-: asyfm-I ( gen input -- val )
- { gen input }
- gen :freq hash-ref { freq }
- gen :phase hash-ref { phase }
- gen :ratio hash-ref { ratio }
- gen :r hash-ref { r }
- gen :index hash-ref { index }
- r 1/f { r1 }
- ratio phase f* { modphase }
- modphase fcos r r1 f+ f* index f* 0.5 f*
- r r1 f+ index f* bes-i0 flog 0.5 f* f- fexp
- modphase fsin r r1 f- f* index f* 0.5 f* phase f+ fsin f* ( val )
- gen :phase phase input freq f+ f+ hash-set! drop
+lambda: <{ n -- r }> gen 0.0 asyfm-J ; map-channel."
+ { gen input }
+ gen asyfm-phase@ { phase }
+ gen asyfm-ratio@ { ratio }
+ gen asyfm-r@ { r }
+ gen asyfm-index@ { index }
+ r 1/f { r1 }
+ ratio phase f* { modphase }
+ r f0<
+ r -1.0 f> &&
+ r 1.0 f> || if
+ -1.0
+ else
+ 1.0
+ then { one }
+ modphase fcos one f+ r r1 f- f* index f* 0.5 f* fexp
+ modphase fsin r r1 f+ f* index f* 0.5 f* phase f+ fcos f* ( val )
+ gen
+ phase input f+ gen asyfm-freq@ f+
+ asyfm-phase!
+ ( val )
+;
+\ Example from old dsp.scm (now in clm23.scm):
+\ :frequency 2000 :ratio 0.1 make-asyfm value gen
+\ lambda: <{ n -- r }> gen 0.0 asyfm-J ; map-channel
+\
+\ Examples from generators.scm:
+0 [if]
+ lambda: ( -- )
+ :frequency 2000 :ratio 0.1 make-asyfm { gen }
+ 10000 0 do
+ i gen 0.0 asyfm-J f2/ *output* outa drop
+ loop
+ ; :clipped #f :statistics #t :play #t with-sound
+
+ lambda: ( -- )
+ :frequency 2000 :ratio 0.1 :index 1 make-asyfm { gen }
+ '( 0 -4 1 -1 ) :length 20000 make-env { r-env }
+ 20000 0 do
+ gen r-env env asyfm-r!
+ i gen 0.0 asyfm-J *output* outa drop
+ loop
+ ; :clipped #f :statistics #t :play #t with-sound
+[then]
+
+: asyfm-I { gen input -- val }
+ gen asyfm-phase@ { phase }
+ gen asyfm-ratio@ { ratio }
+ gen asyfm-r@ { r }
+ gen asyfm-index@ { index }
+ r 1/f { r1 }
+ ratio phase f* { modphase }
+ modphase fcos r r1 f+ f* index f* 0.5 f*
+ r r1 f+ index f* bes-i0 flog 0.5 f* f- fexp
+ modphase fsin r r1 f- f* index f* 0.5 f* phase f+ fsin f* ( val )
+ gen
+ phase input f+ gen asyfm-freq@ f+
+ asyfm-phase!
+ ( val )
;
\ ;;; -------- cosine-summation (a simpler version of sine-summation)
@@ -604,12 +714,13 @@ lambda: <{ n }> gen 0.0 asyfm-J ; map-channel."
\ ;;; from Andrews, Askey, Roy "Special Functions" 5.1.16
: cosine-summation ( gen r -- val )
- doc" A variant of the CLM sine-summation generator; R controls successive sinusoid amplitudes."
- { gen r }
- 1.0 r r f* f-
- 1.0 r r f* f+ r f2* gen 0.0 0.0 oscil f* f- f/ 1.0 f-
- 1.0 r r f* f-
- 1.0 r r f* f+ r f2* f* f/ f*
+ doc" A variant of the CLM sine-summation generator; \
+R controls successive sinusoid amplitudes."
+ { gen r }
+ 1.0 r r f* f-
+ 1.0 r r f* f+ r f2* gen 0.0 0.0 oscil f* f- f/ 1.0 f-
+ 1.0 r r f* f-
+ 1.0 r r f* f+ r f2* f* f/ f*
;
<'> make-oscil alias make-cosine-summation
\ 100.0 make-cosine-summation value gen
@@ -621,18 +732,18 @@ lambda: <{ n }> gen 0.0 asyfm-J ; map-channel."
\ ;;; Rankin "Ramanujan: Essays and Surveys"
\ ;;;
-\ ;;; this gives a sum of cosines of decreasing amp where the "k" parameter determines
-\ ;;; the "index" (in FM nomenclature) -- higher k = more cosines; the actual amount
-\ ;;; of the nth cos involves hypergeometric series (looks like r^n/n!
-\ ;;; (~=e^n?) with a million other terms).
+\ ;;; this gives a sum of cosines of decreasing amp where the "k" parameter
+\ ;;; determines the "index" (in FM nomenclature) -- higher k = more cosines;
+\ ;;; the actual amount of the nth cos involves hypergeometric series
+\ ;;; (looks like r^n/n! (~=e^n?) with a million other terms).
: kosine-summation ( gen r k -- val )
- doc" It's a variant of sum-of-cosines; \
+ doc" It's a variant of sum-of-cosines; \
R controls successive sinusoid amplitude; \
K controls how many sinusoids are produced."
- { gen r k }
- 1.0 r r f* f+ r f2* gen 0.0 0.0 oscil f* f- k fnegate f**
- 1.0 r r f* f+ r f2* f- k f** f*
+ { gen r k }
+ 1.0 r r f* f+ r f2* gen 0.0 0.0 oscil f* f- k fnegate f**
+ 1.0 r r f* f+ r f2* f- k f** f*
;
<'> make-oscil alias make-kosine-summation
\ 100.0 make-kosine-summation value gen
@@ -641,118 +752,154 @@ K controls how many sinusoids are produced."
\ ;;; -------- legendre, fejer
: fejer-sum ( angle n -- val )
- doc" Produces a band-limited pulse train."
- \ ;; from "Trigonometric Series" Zygmund p88
- { angle n }
- angle f0= if
- 1.0
- else
- n 1.0 f+ angle f* f2/ fsin angle f2/ fsin f2* f/ ( val ) dup f* n 1.0 f+ f/ f2*
- then
+ doc" Produce band-limited pulse train."
+ \ ;; from "Trigonometric Series" Zygmund p88
+ { angle n }
+ angle f0= if
+ 1.0
+ else
+ n 1.0 f+ angle f* f2/ fsin angle f2/ fsin f2* f/ ( val )
+ dup f* n 1.0 f+ f/ f2*
+ then
;
\ 0.0 value angle
-\ lambda: <{ y }> angle 3.0 fejer-sum 0.1 f* ( val ) 0.1 +to angle ; map-channel
+\ lambda: <{ y -- val }>
+\ angle 3.0 fejer-sum 0.1 f* ( val )
+\ angle 0.1 f+ to angle
+\ ; map-channel
: legendre-sum ( angle n -- val )
- doc" Produces a band-limited pulse train."
- \ ;; from Andrews, Askey, Roy "Special Functions" p 314
- { angle n }
- angle f0= if
- 1.0
- else
- n 0.5 f+ angle f* fsin angle f2/ fsin f/ dup f*
- then
+ doc" Produce band-limited pulse train."
+ \ ;; from Andrews, Askey, Roy "Special Functions" p 314
+ { angle n }
+ angle f0= if
+ 1.0
+ else
+ n 0.5 f+ angle f* fsin angle f2/ fsin f/ dup f*
+ then
;
\ 0.0 value angle
-\ lambda: <{ y }> angle 3.0 legendre-sum 0.1 f* ( val ) 0.1 +to angle ; map-channel
+\ lambda: <{ y -- val }>
+\ angle 3.0 legendre-sum 0.1 f* ( val )
+\ angle 0.1 f+ to angle
+\ ; map-channel
\ ;;; -------- variations on sum-of-cosines
\ ;;; from "Trigonometric Delights" by Eli Maor
: sum-of-n-sines ( angle n -- val )
- doc" Produces the sum of N sines."
- { angle n }
- angle f2/ { a2 }
- a2 fsin { den }
- den f0= if 0.0 else n a2 f* fsin n 1.0 f+ a2 f* fsin f* den f/ then
+ doc" Produce the sum of N sines."
+ { angle n }
+ angle f2/ { a2 }
+ a2 fsin { den }
+ den f0= if
+ 0.0
+ else
+ n a2 f* fsin n 1.0 f+ a2 f* fsin f* den f/
+ then
;
\ 0.0 value angle
-\ lambda: <{ y }> angle 3.0 sum-of-n-sines 0.1 f* 0.1 +to angle ; map-channel
+\ lambda: <{ y -- val }>
+\ angle 3.0 sum-of-n-sines 0.1 f* ( val )
+\ angle 0.1 f+ to angle
+\ ; map-channel
: sum-of-n-odd-sines ( angle n -- val )
- doc" Produces the sum of N odd-numbered sines."
- { angle n }
- angle fsin { den }
- angle n f* fsin dup { na2 }
- den f0= if 0.0 else na2 den f/ then
+ doc" Produce the sum of N odd-numbered sines."
+ { angle n }
+ angle fsin { den }
+ angle n f* fsin dup { na2 }
+ den f0= if
+ 0.0
+ else
+ na2 den f/
+ then
;
+
: sum-of-n-odd-cosines ( angle n -- val )
- doc" Produces the sum of N odd-numbered cosines."
- { angle n }
- angle fsin f2* { den }
- den f0= if n else angle n f* f2* den f/ then
+ doc" Produce the sum of N odd-numbered cosines."
+ { angle n }
+ angle fsin f2* { den }
+ den f0= if
+ n
+ else
+ angle n f* f2* den f/
+ then
;
+
: band-limited-sawtooth ( x a N fi -- val )
- doc" Produces a band-limited sawtooth; \
+ doc" Produce a band-limited sawtooth; \
X is the current phase, \
A is the amp (more or less), \
N is 1..10 or thereabouts, \
FI is the phase increment."
- { x a N fi }
- a dup f* x fcos a f* -2.0 f* f+ 1.0 f+ { s4 }
- s4 f0= if
- 0.0
- else
- a N 1.0 f- f** N 1.0 f- x f* fi f+ fsin f* { s1 }
- a N f** N x f* fi f+ fsin f* { s2 }
- x fi f+ fsin a f+ { s3 }
- fi fsin s3 fnegate f+ s2 fnegate f+ s1 f+ s4 f/
- then
+ { x a N fi }
+ a dup f* x fcos a f* -2.0 f* f+ 1.0 f+ { s4 }
+ s4 f0= if
+ 0.0
+ else
+ a N 1.0 f- f** N 1.0 f- x f* fi f+ fsin f* { s1 }
+ a N f** N x f* fi f+ fsin f* { s2 }
+ x fi f+ fsin a f+ { s3 }
+ fi fsin s3 fnegate f+ s2 fnegate f+ s1 f+ s4 f/
+ then
;
\ 0.0 value angle
-\ lambda: <{ y }> angle 0.5 8.0 0.2 band-limited-sawtooth 0.2 +to angle ; map-channel
+\ lambda: <{ y -- val }>
+\ angle 0.5 8.0 0.2 band-limited-sawtooth ( val )
+\ angle 0.2 f+ to angle
+\ ; map-channel
: band-limited-square-wave ( theta n -- val )
- doc" Produces a square-wave; N sets how squared-off it is, THETA is instantaneous phase."
- swap fsin f* ftanh
+ doc" Produce square-wave; N sets how squared-off it is, \
+THETA is instantaneous phase."
+ swap fsin f* ftanh
;
\ 0.0 value angle
-\ lambda: <{ y }> angle 10.0 band-limited-square-wave 0.2 +to angle ; map-channel
+\ lambda: <{ y -- val }>
+\ angle 10.0 band-limited-square-wave ( val )
+\ angle 0.2 f+ to angle
+\ ; map-channel
\ ;;; -------- brighten-slightly
hide
-: bs-cb { brt mx -- proc; y self -- val }
- 1 proc-create mx , brt ,
- does> { y self -- val }
- self @ { mx }
- self cell+ @ { brt }
- brt y f* fsin mx f*
+: bs-cb { brt mx -- prc; y self -- val }
+ 1 proc-create ( prc )
+ mx , brt ,
+ does> { y self -- val }
+ self @ { mx }
+ self cell+ @ { brt }
+ brt y f* fsin mx f*
;
set-current
+
: brighten-slightly <{ amount :optional snd #f chn #f -- val }>
- doc" It's a form of contrast-enhancement (AMOUNT between ca 0.1 and 1)."
- snd chn #f maxamp { mx }
- two-pi amount f* mx f/ { brt }
- brt mx bs-cb 0 #f snd chn #f $" %s %s" #( amount get-func-name ) string-format map-channel
+ doc" It's a form of contrast-enhancement (AMOUNT between ca 0.1 and 1)."
+ snd chn #f maxamp { mx }
+ two-pi amount f* mx f/ { brt }
+ brt mx bs-cb 0 #f snd chn #f "%s %s"
+ #( amount get-func-name ) string-format map-channel
;
previous
hide
-: brighten-slightly-1-cb { pcoeffs mx -- proc; y self -- val }
- 1 proc-create mx , pcoeffs ,
- does> { y self -- val }
- self @ { mx }
- self cell+ @ { pcoeffs }
- pcoeffs y mx f/ polynomial mx f*
+: brighten-slightly-1-cb { pcoeffs mx -- prc; y self -- val }
+ 1 proc-create ( prc )
+ mx , pcoeffs ,
+ does> { y self -- val }
+ self @ { mx }
+ self cell+ @ { pcoeffs }
+ pcoeffs y mx f/ polynomial mx f*
;
set-current
-: brighten-slightly-1 <{ coeffs :optional snd #f chn #f -- }>
- doc" It's a form of contrast-enhancement (AMOUNT between ca 0.1 and 1)."
- snd chn #f maxamp { mx }
- coeffs mus-chebyshev-first-kind partials->polynomial { pcoeffs }
- pcoeffs mx brighten-slightly-1-cb 0 #f snd chn #f
- $" %s %s" #( coeffs get-func-name ) string-format map-channel drop
+
+: brighten-slightly-1 <{ coeffs :optional snd #f chn #f -- val }>
+ doc" It's a form of contrast-enhancement (AMOUNT between ca 0.1 and 1)."
+ snd chn #f maxamp { mx }
+ coeffs mus-chebyshev-first-kind partials->polynomial { pcoeffs }
+ pcoeffs mx brighten-slightly-1-cb 0 #f snd chn #f
+ "%s %s" #( coeffs get-func-name ) string-format map-channel
;
\ #( 1 0.5 3 1 ) brighten-slightly-1
previous
@@ -760,185 +907,197 @@ previous
\ ;;; -------- FIR filters
: spectrum->coeffs ( order spectr -- vct )
- doc" Returns FIR filter coefficients given the filter order and desired spectral envelope"
- { order spectr }
- order 0.0 make-vct { coeffs }
- order { n }
- n 1+ f2/ { am }
- am floor f>s { m }
- two-pi n f/ { q }
- n 1- { jj }
- m 0 ?do
- spectr 0 vct-ref f2/ ( xt )
- m 1 ?do spectr i vct-ref q i am j 1 f- f- f* f* fcos f* f+ ( xt += ... ) loop
- ( xt ) n f/ f2* { coeff }
- coeffs i coeff vct-set! drop
- coeffs jj coeff vct-set! drop
- -1 +to jj
- loop
- coeffs
-;
-: fltit-1 ( order spectr -- proc; y self -- val )
- doc" Creates an FIR filter from spectrum and order and returns a closure that calls it:\n\
-10 vct( 0 1.0 0 0 0 0 0 0 1.0 0 ) fltit-1 map-channel"
- { order spectr }
- :order order :xcoeffs order spectr spectrum->coeffs make-fir-filter
- 1 proc-create swap ,
- does> ( y self -- val )
- @ swap fir-filter
+ doc" Return FIR filter coefficients given the filter order and \
+desired spectral envelope."
+ { order spectr }
+ order 0.0 make-vct { coeffs }
+ order { n }
+ n 1+ f2/ { am }
+ am floor f>s { m }
+ two-pi n f/ { q }
+ n 1- { jj }
+ m 0 ?do
+ spectr 0 vct-ref f2/ ( xt )
+ m 1 ?do
+ spectr i vct-ref
+ q i am j 1.0 f- f- f* f* fcos f* f+ ( xt += ... )
+ loop
+ ( xt ) n f/ f2* { coeff }
+ coeffs i coeff vct-set! drop
+ coeffs jj coeff vct-set! drop
+ -1 +to jj
+ loop
+ coeffs
+;
+
+: fltit-1 ( order spectr -- prc; y self -- val )
+ doc" Create FIR filter from spectrum and order and \
+return a closure that calls it:\n\
+10 vct( 0 1.0 0 0 0 0 0 0 1.0 0 ) fltit-1 map-channel."
+ { order spectr }
+ :order order
+ :xcoeffs order spectr spectrum->coeffs make-fir-filter { gen }
+ 1 proc-create ( prc )
+ gen ,
+ does> { y self -- val }
+ self @ ( gen ) y fir-filter
;
\ 10 vct( 0 1.0 0 0 0 0 0 0 1.0 0 ) fltit-1 map-channel
\ ;;; -------- Hilbert transform
: make-hilbert-transform <{ :optional len 30 -- gen }>
- doc" Makes a Hilbert transform filter."
- len 2* 1+ { arrlen }
- arrlen 0.0 make-vct { arr }
- len even? if len else len 1+ then { lim }
- lim len negate ?do
- i len + { kk }
- i pi f* { denom }
- 1.0 denom fcos f- { num }
- num f0<> i 0<> || if
- arr kk num denom f/ denom len f/ fcos 0.46 f* 0.54 f+ f* vct-set! drop
- then
- loop
- :order arrlen :xcoeffs arr make-fir-filter
+ doc" Make Hilbert transform filter."
+ len 2* 1+ { arrlen }
+ arrlen 0.0 make-vct { arr }
+ len even? if
+ len
+ else
+ len 1+
+ then { lim }
+ lim len negate ?do
+ i len + { kk }
+ i pi f* { denom }
+ 1.0 denom fcos f- { num }
+ num f0<>
+ i 0<> || if
+ arr kk
+ num denom f/ denom len f/ fcos 0.46 f* 0.54 f+ f*
+ vct-set! drop
+ then
+ loop
+ :order arrlen :xcoeffs arr make-fir-filter
;
<'> fir-filter alias hilbert-transform
-<'> hilbert-transform $" ( gen :optional input 0.0 -- val ) \
+<'> hilbert-transform "( gen :optional input 0.0 -- val ) \
The generator corresponding to make-hilbert-transform." help-set!
\ 15 make-hilbert-transform value h
-\ lambda: <{ y }> h y hilbert-transform ; map-channel
+\ lambda: <{ y -- val }> h y hilbert-transform ; map-channel
\ ;;; -------- highpass filter
: make-highpass <{ fc :optional len 30 -- gen }>
- doc" Makes an FIR highpass filter."
- len 2* 1+ { arrlen }
- arrlen 0.0 make-vct { arr }
- len len negate ?do
- pi i f* { denom }
- fc i f* fsin fnegate { num }
- arr i len +
- i 0= if
- 1.0 fc pi f/ f-
- else
- num denom f/
- pi i f* len f/ fcos 0.46 f* 0.54 f+ f*
- then vct-set! drop
- loop
- :order arrlen :xcoeffs arr make-fir-filter
+ doc" Make FIR highpass filter."
+ len 2* 1+ { arrlen }
+ arrlen 0.0 make-vct { arr }
+ len len negate ?do
+ pi i f* { denom }
+ fc i f* fsin fnegate { num }
+ arr i len +
+ i 0= if
+ 1.0 fc pi f/ f-
+ else
+ num denom f/ pi i f* len f/ fcos 0.46 f* 0.54 f+ f*
+ then vct-set! drop
+ loop
+ :order arrlen :xcoeffs arr make-fir-filter
;
<'> fir-filter alias highpass
-<'> highpass $" ( gen :optional input 0.0 -- val ) \
+<'> highpass "( gen :optional input 0.0 -- val ) \
The generator corresponding to make-highpass." help-set!
\ pi 0.1 f* make-highpass value hp
-\ lambda: <{ y }> hp y highpass ; map-channel
+\ lambda: <{ y -- val }> hp y highpass ; map-channel
\ ;;; -------- lowpass filter
: make-lowpass <{ fc :optional len 30 -- gen }>
- doc" Makes an FIR lowpass filter."
- len 2* 1+ { arrlen }
- arrlen 0.0 make-vct { arr }
- len len negate ?do
- pi i f* { denom }
- fc i f* fsin { num }
- arr i len +
- i 0= if
- fc pi f/
- else
- num denom f/
- pi i f* len f/ fcos 0.46 f* 0.54 f+ f*
- then vct-set! drop
- loop
- :order arrlen :xcoeffs arr make-fir-filter
+ doc" Make FIR lowpass filter."
+ len 2* 1+ { arrlen }
+ arrlen 0.0 make-vct { arr }
+ len len negate ?do
+ pi i f* { denom }
+ fc i f* fsin { num }
+ arr i len +
+ i 0= if
+ fc pi f/
+ else
+ num denom f/ pi i f* len f/ fcos 0.46 f* 0.54 f+ f*
+ then vct-set! drop
+ loop
+ :order arrlen :xcoeffs arr make-fir-filter
;
<'> fir-filter alias lowpass
-<'> lowpass $" ( gen :optional input 0.0 -- val ) \
+<'> lowpass "( gen :optional input 0.0 -- val ) \
The generator corresponding to make-lowpass." help-set!
\ pi 0.2 f* make-lowpass value lp
-\ lambda: <{ y }> lp y lowpass ; map-channel
+\ lambda: <{ y -- val }> lp y lowpass ; map-channel
\ ;;; -------- bandpass filter
: make-bandpass <{ flo fhi :optional len 30 -- gen }>
- doc" Makes an FIR bandpass filter."
- len 2* 1+ { arrlen }
- arrlen 0.0 make-vct { arr }
- len len negate ?do
- pi i f* { denom }
- fhi i f* fsin flo i f* fsin f- { num }
- arr i len +
- i 0= if
- fhi flo f- pi f/
- else
- num denom f/
- pi i f* len f/ fcos 0.46 f* 0.54 f+ f*
- then vct-set! drop
- loop
- :order arrlen :xcoeffs arr make-fir-filter
+ doc" Make FIR bandpass filter."
+ len 2* 1+ { arrlen }
+ arrlen 0.0 make-vct { arr }
+ len len negate ?do
+ pi i f* { denom }
+ fhi i f* fsin flo i f* fsin f- { num }
+ arr i len +
+ i 0= if
+ fhi flo f- pi f/
+ else
+ num denom f/ pi i f* len f/ fcos 0.46 f* 0.54 f+ f*
+ then vct-set! drop
+ loop
+ :order arrlen :xcoeffs arr make-fir-filter
;
<'> fir-filter alias bandpass
-<'> bandpass $" ( gen :optional input 0.0 -- val ) \
+<'> bandpass "( gen :optional input 0.0 -- val ) \
The generator corresponding to make-bandpass." help-set!
\ pi 0.1 f* pi 0.2 f* make-bandpass value bp
-\ lambda: <{ y }> bp y bandpass ; map-channel
+\ lambda: <{ y -- val }> bp y bandpass ; map-channel
\ ;;; -------- bandstop filter
: make-bandstop <{ flo fhi :optional len 30 -- gen }>
- doc" Makes an FIR bandstop (notch) filter."
- len 2* 1+ { arrlen }
- arrlen 0.0 make-vct { arr }
- len len negate ?do
- pi i f* { denom }
- fhi i f* fsin flo i f* fsin f- { num }
- arr i len +
- i 0= if
- 1.0 fhi flo f- pi f/ f-
- else
- num denom f/
- pi i f* len f/ fcos 0.46 f* 0.54 f+ f*
- then vct-set! drop
- loop
- :order arrlen :xcoeffs arr make-fir-filter
+ doc" Make FIR bandstop (notch) filter."
+ len 2* 1+ { arrlen }
+ arrlen 0.0 make-vct { arr }
+ len len negate ?do
+ pi i f* { denom }
+ fhi i f* fsin flo i f* fsin f- { num }
+ arr i len +
+ i 0= if
+ 1.0 fhi flo f- pi f/ f-
+ else
+ num denom f/ pi i f* len f/ fcos 0.46 f* 0.54 f+ f*
+ then vct-set! drop
+ loop
+ :order arrlen :xcoeffs arr make-fir-filter
;
<'> fir-filter alias bandstop
-<'> bandstop $" ( gen :optional input 0.0 -- val ) \
+<'> bandstop "( gen :optional input 0.0 -- val ) \
The generator corresponding to make-bandstop." help-set!
\ pi 0.1 f* pi 0.3 f* make-bandstop value bs
-\ lambda: <{ y }> bs y bandstop ; map-channel
+\ lambda: <{ y -- val }> bs y bandstop ; map-channel
\ ;;; -------- differentiator
: make-differentiator <{ :optional len 30 -- gen }>
- doc" Makes an FIR differentiator (highpass) filter."
- len 2* 1+ { arrlen }
- arrlen 0.0 make-vct { arr }
- len len negate ?do
- i 0<> if
- pi i f* { pi*i }
- arr i len +
- pi*i fcos i f/ pi*i fsin pi*i i f* f/ f-
- pi*i len f/ fcos 0.46 f* 0.54 f+ f*
- vct-set! drop
- then
- loop
- :order arrlen :xcoeffs arr make-fir-filter
+ doc" Make FIR differentiator (highpass) filter."
+ len 2* 1+ { arrlen }
+ arrlen 0.0 make-vct { arr }
+ len len negate ?do
+ i 0<> if
+ pi i f* { pi*i }
+ arr i len +
+ pi*i fcos i f/ pi*i fsin pi*i i f* f/ f-
+ pi*i len f/ fcos 0.46 f* 0.54 f+ f*
+ vct-set! drop
+ then
+ loop
+ :order arrlen :xcoeffs arr make-fir-filter
;
<'> fir-filter alias differentiator
-<'> differentiator $" ( gen :optional input 0.0 -- val ) \
+<'> differentiator "( gen :optional input 0.0 -- val ) \
The generator corresponding to make-differentiator." help-set!
\ make-differentiator value dt
-\ lambda: <{ y }> dt y differentiator ; map-channel
+\ lambda: <{ y -- val }> dt y differentiator ; map-channel
\ ;;; -------- IIR filters
\ ;;; see analog-filter.scm for the usual suspects
-\ ;;; -------- Butterworth filters (see also further below -- make-butter-lp et al)
+\ ;;; -------- Butterworth filters
+\ ;;; (see also further below -- make-butter-lp et al)
\ ;;;
\ ;; translated from CLM butterworth.cl:
\ ;;
@@ -948,59 +1107,64 @@ The generator corresponding to make-differentiator." help-set!
\ ;; Charles Dodge, Computer music: synthesis, composition, and performance.
: make-butter-high-pass ( freq -- flt )
- doc" Makes a Butterworth filter with high pass cutoff at FREQ."
- { freq }
- pi freq f* #f srate f/ ftan { r }
- r r f* { r2 }
- r 2.0 fsqrt r2 f* f* 1/f { c1 }
- -2.0 c1 f* { c2 }
- c1 { c3 }
- r2 1.0 f- c1 f* f2* { c4 }
- 1.0 2.0 fsqrt r f* f- r2 f+ c1 f* { c5 }
- 3 vct( c1 c2 c3 ) vct( 0.0 c4 c5 ) make-filter
+ doc" Make Butterworth filter with high pass cutoff at FREQ."
+ { freq }
+ pi freq f* #f srate f/ ftan { r }
+ r r f* { r2 }
+ r 2.0 fsqrt r2 f* f* 1/f { c1 }
+ -2.0 c1 f* { c2 }
+ c1 { c3 }
+ r2 1.0 f- c1 f* f2* { c4 }
+ 1.0 2.0 fsqrt r f* f- r2 f+ c1 f* { c5 }
+ 3 vct( c1 c2 c3 ) vct( 0.0 c4 c5 ) make-filter
;
+
: make-butter-low-pass ( freq -- flt )
- doc" Makes a Butterworth filter with low pass cutoff at FREQ. \
+ doc" Make Butterworth filter with low pass cutoff at FREQ. \
The result can be used directly: 500.0 make-butter-low-pass filter-sound, \
or via the 'butter' generator."
- { freq }
- pi freq f* #f srate f/ ftan 1/f { r }
- r r f* { r2 }
- r 2.0 fsqrt f* 1.0 r2 f* f* 1/f { c1 }
- c1 f2* { c2 }
- c1 { c3 }
- 1.0 r2 f- c1 f* f2* { c4 }
- 1.0 2.0 fsqrt r f* f- r2 f+ c1 f* { c5 }
- 3 vct( c1 c2 c3 ) vct( 0.0 c4 c5 ) make-filter
+ { freq }
+ pi freq f* #f srate f/ ftan 1/f { r }
+ r r f* { r2 }
+ r 2.0 fsqrt f* 1.0 r2 f* f* 1/f { c1 }
+ c1 f2* { c2 }
+ c1 { c3 }
+ 1.0 r2 f- c1 f* f2* { c4 }
+ 1.0 2.0 fsqrt r f* f- r2 f+ c1 f* { c5 }
+ 3 vct( c1 c2 c3 ) vct( 0.0 c4 c5 ) make-filter
;
+
: make-butter-band-pass ( freq bw -- flt )
- doc" Makes a bandpass Butterworth filter with low edge at FREQ and width BAND."
- { freq bw }
- #f srate { sr }
- 2.0 pi freq f* f* sr f/ fcos f2* { d }
- pi bw f* sr f/ ftan 1/f { c }
- 1.0 c f+ 1/f { c1 }
- 0.0 { c2 }
- c1 fnegate { c3 }
- c fnegate d c1 f* f* { c4 }
- c 1.0 f- c1 f* { c5 }
- 3 vct( c1 c2 c3 ) vct( 0.0 c4 c5 ) make-filter
+ doc" Make bandpass Butterworth filter with \
+low edge at FREQ and width BAND."
+ { freq bw }
+ #f srate { sr }
+ 2.0 pi freq f* f* sr f/ fcos f2* { d }
+ pi bw f* sr f/ ftan 1/f { c }
+ 1.0 c f+ 1/f { c1 }
+ 0.0 { c2 }
+ c1 fnegate { c3 }
+ c fnegate d c1 f* f* { c4 }
+ c 1.0 f- c1 f* { c5 }
+ 3 vct( c1 c2 c3 ) vct( 0.0 c4 c5 ) make-filter
;
+
: make-butter-band-reject ( freq bw -- flt )
- doc" Makes a band-reject Butterworth filter with low edge at FREQ and width BAND."
- { freq bw }
- #f srate { sr }
- 2.0 pi freq f* f* sr f/ fcos f2* { d }
- pi bw f* sr f/ ftan { c }
- 1.0 c f+ 1/f { c1 }
- d fnegate c1 f* { c2 }
- c1 { c3 }
- c2 { c4 }
- 1.0 c f- c1 f* { c5 }
- 3 vct( c1 c2 c3 ) vct( 0.0 c4 c5 ) make-filter
+ doc" Make band-reject Butterworth filter with low edge at FREQ \
+and width BAND."
+ { freq bw }
+ #f srate { sr }
+ 2.0 pi freq f* f* sr f/ fcos f2* { d }
+ pi bw f* sr f/ ftan { c }
+ 1.0 c f+ 1/f { c1 }
+ d fnegate c1 f* { c2 }
+ c1 { c3 }
+ c2 { c4 }
+ 1.0 c f- c1 f* { c5 }
+ 3 vct( c1 c2 c3 ) vct( 0.0 c4 c5 ) make-filter
;
<'> filter alias butter
-<'> butter $" ( gen :optional input 0.0 -- val ) \
+<'> butter "( gen :optional input 0.0 -- val ) \
The generator side for the various make-butter procedures." help-set!
\ 500.0 make-butter-low-pass filter-sound
@@ -1012,261 +1176,306 @@ The generator side for the various make-butter procedures." help-set!
\ ;;; etc
: make-biquad ( a0 a1 a2 b1 b2 -- gen )
- doc" Returns a biquad filter (use with the CLM filter gen)"
- { a0 a1 a2 b1 b2 }
- 3 vct( a0 a1 a2 ) vct( 0.0 b1 b2 ) make-filter
+ doc" Return biquad filter (use with the CLM filter gen)."
+ { a0 a1 a2 b1 b2 }
+ 3 vct( a0 a1 a2 ) vct( 0.0 b1 b2 ) make-filter
;
+
: make-iir-low-pass-2 ( fc :optional d -- gen )
- #( 2.0 fsqrt ) 1 get-optargs { fc d }
- two-pi fc f* mus-srate f/ { theta }
- 1.0 d f2/ theta fsin f* f- 1.0 d f2/ theta fsin f* f+ f/ f2/ { beta }
- beta 0.5 f+ theta fcos f* { gamma }
- beta 0.5 f+ gamma fnegate f+ f2/ { alpha }
- 3 vct( alpha alpha f2* alpha ) vct( 0.0 gamma -2.0 f* beta f2* ) make-filter
+ #( 2.0 fsqrt ) 1 get-optargs { fc d }
+ two-pi fc f* mus-srate f/ { theta }
+ 1.0 d f2/ theta fsin f* f- 1.0 d f2/ theta fsin f* f+ f/ f2/ { beta }
+ beta 0.5 f+ theta fcos f* { gamma }
+ beta 0.5 f+ gamma fnegate f+ f2/ { alpha }
+ 3 vct( alpha alpha f2* alpha )
+ vct( 0.0 gamma -2.0 f* beta f2* ) make-filter
;
+
: make-iir-high-pass-2 ( fc :optional d -- gen )
- #( 2.0 fsqrt ) 1 get-optargs { fc d }
- two-pi fc f* mus-srate f/ { theta }
- 1.0 d f2/ theta fsin f* f- 1.0 d f2/ theta fsin f* f+ f/ f2/ { beta }
- beta 0.5 f+ theta fcos f* { gamma }
- beta 0.5 f+ gamma f+ f2/ { alpha }
- 3 vct( alpha alpha -2.0 f* alpha ) vct( 0.0 gamma -2.0 f* beta f2* ) make-filter
+ #( 2.0 fsqrt ) 1 get-optargs { fc d }
+ two-pi fc f* mus-srate f/ { theta }
+ 1.0 d f2/ theta fsin f* f- 1.0 d f2/ theta fsin f* f+ f/ f2/ { beta }
+ beta 0.5 f+ theta fcos f* { gamma }
+ beta 0.5 f+ gamma f+ f2/ { alpha }
+ 3 vct( alpha alpha -2.0 f* alpha )
+ vct( 0.0 gamma -2.0 f* beta f2* ) make-filter
;
+
: make-iir-band-pass-2 ( f1 f2 -- gen )
- { f1 f2 }
- two-pi f1 f2 f* fsqrt mus-srate f/ { theta }
- f1 f2 f* fsqrt f2 f1 f- f/ { Q }
- theta Q f2* f/ ftan { t2 }
- 1.0 t2 f- 1.0 t2 f+ f/ f2/ { beta }
- beta 0.5 f+ theta fcos f* { gamma }
- 0.5 beta f- { alpha }
- 3 vct( alpha 0.0 alpha fnegate ) vct( 0.0 gamma -2.0 f* beta f2* ) make-filter
+ { f1 f2 }
+ two-pi f1 f2 f* fsqrt mus-srate f/ { theta }
+ f1 f2 f* fsqrt f2 f1 f- f/ { Q }
+ theta Q f2* f/ ftan { t2 }
+ 1.0 t2 f- 1.0 t2 f+ f/ f2/ { beta }
+ beta 0.5 f+ theta fcos f* { gamma }
+ 0.5 beta f- { alpha }
+ 3 vct( alpha 0.0 alpha fnegate )
+ vct( 0.0 gamma -2.0 f* beta f2* ) make-filter
;
+
: make-iir-band-stop-2 ( f1 f2 -- gen )
- { f1 f2 }
- two-pi f1 f2 f* fsqrt mus-srate f/ { theta }
- f1 f2 f* fsqrt f2 f1 f- f/ { Q }
- theta Q f2* f/ ftan { t2 }
- 1.0 t2 f- 1.0 t2 f+ f/ f2/ { beta }
- beta 0.5 f+ theta fcos f* { gamma }
- 0.5 beta f+ { alpha }
- 3 vct( alpha gamma -2.0 f* alpha fnegate ) vct( 0.0 gamma -2.0 f* beta f2* ) make-filter
-;
-: make-eliminate-hum <{ :optional hum-freq 60.0 hum-harmonics 5 bandwith 10 -- }>
- hum-harmonics make-array map!
- hum-freq i 1.0 f+ f* { center }
- bandwith f2/ { b2 }
- center b2 f- center b2 f+ make-iir-band-stop-2
- end-map ( gen )
+ { f1 f2 }
+ two-pi f1 f2 f* fsqrt mus-srate f/ { theta }
+ f1 f2 f* fsqrt f2 f1 f- f/ { Q }
+ theta Q f2* f/ ftan { t2 }
+ 1.0 t2 f- 1.0 t2 f+ f/ f2/ { beta }
+ beta 0.5 f+ theta fcos f* { gamma }
+ 0.5 beta f+ { alpha }
+ 3 vct( alpha gamma -2.0 f* alpha fnegate )
+ vct( 0.0 gamma -2.0 f* beta f2* ) make-filter
+;
+
+: make-eliminate-hum
+ <{ :optional hum-freq 60.0 hum-harmonics 5 bandwith 10 -- gen }>
+ hum-harmonics make-array map!
+ hum-freq i 1.0 f+ f* { center }
+ bandwith f2/ { b2 }
+ center b2 f- center b2 f+ make-iir-band-stop-2
+ end-map ( gen )
;
+
: eliminate-hum ( gens x0 -- val )
- { gens x0 }
- gens each ( gen ) x0 filter to x0 end-each
- x0
+ { gens x0 }
+ gens each ( gen )
+ x0 filter to x0
+ end-each
+ x0
;
\ make-eliminate-hum value hummer
-\ lambda: <{ x }> hummer x eliminate-hum ; map-channel
+\ lambda: <{ y -- val }> hummer y eliminate-hum ; map-channel
\ ;; bandpass, m is gain at center of peak
\ ;; use map-channel with this one (not clm-channel or filter)
: make-peaking-2 ( f1 f2 m -- prc; y self -- val )
- { f1 f2 m }
- f1 f2 f* fsqrt two-pi f* mus-srate f/ { theta }
- f1 f2 f* fsqrt f2 f1 f- f/ { Q }
- 4.0 m 1.0 f+ f/ theta Q f2* f/ ftan f* { t2 }
- 1.0 t2 f- 1.0 t2 f+ f/ f2/ { beta }
- 0.5 beta f+ theta fcos f* { gamma }
- 0.5 beta f- { alpha }
- 3
- vct( alpha 0.0 alpha fnegate )
- vct( 0.0 -2.0 gamma f* beta f2* ) make-filter { flt }
- 1 proc-create flt , m 1.0 f- , ( prc )
- does> { y self -- val }
- self @ ( flt ) y filter self cell+ @ ( m ) f* y f+
+ { f1 f2 m }
+ f1 f2 f* fsqrt two-pi f* mus-srate f/ { theta }
+ f1 f2 f* fsqrt f2 f1 f- f/ { Q }
+ 4.0 m 1.0 f+ f/ theta Q f2* f/ ftan f* { t2 }
+ 1.0 t2 f- 1.0 t2 f+ f/ f2/ { beta }
+ 0.5 beta f+ theta fcos f* { gamma }
+ 0.5 beta f- { alpha }
+ 3 vct( alpha 0.0 alpha fnegate )
+ vct( 0.0 -2.0 gamma f* beta f2* ) make-filter { flt }
+ 1 proc-create ( prc )
+ flt , m 1.0 f- ,
+ does> { y self -- val }
+ self @ ( flt ) y filter self cell+ @ ( m ) f* y f+
;
: cascade->canonical ( A -- A' )
- doc" Converts an array of cascade coeffs (vcts with 3 entries) to canonical form."
- { A }
- A length { K }
- K 2* 1+ 0.0 make-vct { d }
- K 2* 1+ 0.0 make-vct { a1 }
- a1 0 1.0 vct-set! drop
- A each { h }
- i 2* 3 + 0 ?do
- d i 0.0 vct-set! drop
- 2 i min 0 ?do d j h i vct-ref a1 j i - vct-ref f* object-set+! loop
- loop
- i 2* 3 + 0 ?do a1 j d j vct-ref vct-set! drop loop
- end-each
- a1
+ doc" Convert array of cascade coeffs (vcts with 3 entries) \
+to canonical form."
+ { A }
+ A length { K }
+ K 2* 1+ 0.0 make-vct { d }
+ K 2* 1+ 0.0 make-vct { a1 }
+ a1 0 1.0 vct-set! drop
+ A each { h }
+ i 2* 3 + 0 ?do
+ d i 0.0 vct-set! drop
+ 2 i min 0 ?do
+ d j h i vct-ref a1 j i - vct-ref f* object-set+!
+ loop
+ loop
+ i 2* 3 + 0 ?do
+ a1 j d j vct-ref vct-set! drop
+ loop
+ end-each
+ a1
;
: make-butter-lp ( M fc -- flt )
- doc" Returns a butterworth low-pass filter; \
+ doc" Return butterworth low-pass filter; \
its order is M * 2, FC is the cutoff frequency in Hz."
- { M fc }
- #() { xcoeffs }
- #() { ycoeffs }
- two-pi fc f* mus-srate f/ { theta }
- theta fsin { st }
- theta fcos { ct }
- M 0 ?do
- i 1+ 2* 1- pi f* 4 M * f/ fsin f2* { d }
- 1.0 d st f* f2/ f- 1.0 d st f* f2/ f/ f2/ { beta }
- beta 0.5 f+ ct f* { gamma }
- gamma fnegate beta f+ 0.5 f+ 0.25 f* { alpha }
- xcoeffs vct( alpha f2* alpha 4.0 f* alpha f2* ) array-push drop
- ycoeffs vct( 1.0 -2.0 gamma f* beta f2* ) array-push drop
- loop
- M 2* 1+
- xcoeffs cascade->canonical
- ycoeffs cascade->canonical make-filter
+ { M fc }
+ #() { xcoeffs }
+ #() { ycoeffs }
+ two-pi fc f* mus-srate f/ { theta }
+ theta fsin { st }
+ theta fcos { ct }
+ M 0 ?do
+ i 1+ 2* 1- pi f* 4 M * f/ fsin f2* { d }
+ 1.0 d st f* f2/ f- 1.0 d st f* f2/ f/ f2/ { beta }
+ beta 0.5 f+ ct f* { gamma }
+ gamma fnegate beta f+ 0.5 f+ 0.25 f* { alpha }
+ xcoeffs vct( alpha f2* alpha 4.0 f* alpha f2* ) array-push drop
+ ycoeffs vct( 1.0 -2.0 gamma f* beta f2* ) array-push drop
+ loop
+ M 2* 1+
+ xcoeffs cascade->canonical
+ ycoeffs cascade->canonical make-filter
;
: make-butter-hp ( M fc -- flt )
- doc" Returns a butterworth high-pass filter; \
+ doc" Return butterworth high-pass filter; \
its order is M * 2, FC is the cutoff frequency in Hz."
- { M fc }
- #() { xcoeffs }
- #() { ycoeffs }
- two-pi fc f* mus-srate f/ { theta }
- theta fsin { st }
- theta fcos { ct }
- M 0 ?do
- i 1+ 2* 1- pi f* 4 M * f/ fsin f2* { d }
- 1.0 d st f* f2/ f- 1.0 d st f* f2/ f/ f2/ { beta }
- beta 0.5 f+ ct f* { gamma }
- gamma beta f+ 0.5 f+ 0.25 f* { alpha }
- xcoeffs vct( alpha f2* alpha -4.0 f* alpha f2* ) array-push drop
- ycoeffs vct( 1.0 -2.0 gamma f* beta f2* ) array-push drop
- loop
- M 2* 1+
- xcoeffs cascade->canonical
- ycoeffs cascade->canonical make-filter
+ { M fc }
+ #() { xcoeffs }
+ #() { ycoeffs }
+ two-pi fc f* mus-srate f/ { theta }
+ theta fsin { st }
+ theta fcos { ct }
+ M 0 ?do
+ i 1+ 2* 1- pi f* 4 M * f/ fsin f2* { d }
+ 1.0 d st f* f2/ f- 1.0 d st f* f2/ f/ f2/ { beta }
+ beta 0.5 f+ ct f* { gamma }
+ gamma beta f+ 0.5 f+ 0.25 f* { alpha }
+ xcoeffs vct( alpha f2* alpha -4.0 f* alpha f2* ) array-push drop
+ ycoeffs vct( 1.0 -2.0 gamma f* beta f2* ) array-push drop
+ loop
+ M 2* 1+
+ xcoeffs cascade->canonical
+ ycoeffs cascade->canonical make-filter
;
: make-butter-bp ( M f1 f2 -- flt )
- doc" Returns a butterworth band-pass filter; \
+ doc" Return butterworth band-pass filter; \
its order is M * 2, F1 and F2 are the band edge frequencies in Hz."
- { M f1 f2 }
- #() { xcoeffs }
- #() { ycoeffs }
- f1 f2 f* fsqrt { f0 }
- f0 f2 f1 f- f/ { Q }
- two-pi f0 f* mus-srate f/ { theta0 }
- theta0 Q f2* f/ theta0 fsin f* f2* { de }
- de f2/ { de2 }
- theta0 f2/ ftan { tn0 }
- 1 1 { jj kk }
- M 0 ?do
- kk 2* 1- pi f* M 2* f/ fsin f2* { Dk }
- de2 de2 f* 1.0 f+ Dk de2 f* f/ { Ak }
- de Dk f* Ak Ak f* 1.0 f- fsqrt Ak f+ f/ fsqrt { dk1 }
- Dk dk1 f/ de2 f* { Bk }
- Bk Bk f* 1.0 f- fsqrt Bk f+ { Wk }
- jj 1 = if tn0 Wk f/ else tn0 Wk f* then fatan f2* { thetajk }
- 1.0 0.5 dk1 f* thetajk fsin f* f-
- 1.0 0.5 dk1 f* thetajk fsin f* f+ f/ f2/ { betajk }
- 0.5 betajk f+ thetajk fcos f* { gammajk }
- Wk Wk 1/f f- dk1 f/ { wk2 }
- 0.5 betajk f- wk2 wk2 f* 1.0 f+ fsqrt f* { alphajk }
- xcoeffs vct( alphajk f2* 0.0 -2.0 alphajk f* ) array-push drop
- ycoeffs vct( 1.0 -2.0 gammajk f* betajk f2* ) array-push drop
- jj 1 = if
- 2 to jj
- else
- 1 +to kk
- 1 to jj
- then
- loop
- M 2* 1+
- xcoeffs cascade->canonical
- ycoeffs cascade->canonical make-filter
+ { M f1 f2 }
+ #() { xcoeffs }
+ #() { ycoeffs }
+ f1 f2 f* fsqrt { f0 }
+ f0 f2 f1 f- f/ { Q }
+ two-pi f0 f* mus-srate f/ { theta0 }
+ theta0 Q f2* f/ theta0 fsin f* f2* { de }
+ de f2/ { de2 }
+ theta0 f2/ ftan { tn0 }
+ 1 1 { jj kk }
+ M 0 ?do
+ kk 2* 1- pi f* M 2* f/ fsin f2* { Dk }
+ de2 de2 f* 1.0 f+ Dk de2 f* f/ { Ak }
+ de Dk f* Ak Ak f* 1.0 f- fsqrt Ak f+ f/ fsqrt { dk1 }
+ Dk dk1 f/ de2 f* { Bk }
+ Bk Bk f* 1.0 f- fsqrt Bk f+ { Wk }
+ jj 1 = if
+ tn0 Wk f/
+ else
+ tn0 Wk f*
+ then fatan f2* { thetajk }
+ 1.0 0.5 dk1 f* thetajk fsin f* f-
+ 1.0 0.5 dk1 f* thetajk fsin f* f+ f/ f2/ { betajk }
+ 0.5 betajk f+ thetajk fcos f* { gammajk }
+ Wk Wk 1/f f- dk1 f/ { wk2 }
+ 0.5 betajk f- wk2 wk2 f* 1.0 f+ fsqrt f* { alphajk }
+ xcoeffs vct( alphajk f2* 0.0 -2.0 alphajk f* ) array-push drop
+ ycoeffs vct( 1.0 -2.0 gammajk f* betajk f2* ) array-push drop
+ jj 1 = if
+ 2 to jj
+ else
+ 1 +to kk
+ 1 to jj
+ then
+ loop
+ M 2* 1+
+ xcoeffs cascade->canonical
+ ycoeffs cascade->canonical make-filter
;
: make-butter-bs ( M f1 f2 -- flt )
- doc" Returns a butterworth band-stop filter; \
+ doc" Return butterworth band-stop filter; \
its order is M * 2, F1 and F2 are the band edge frequencies in Hz."
- { M f1 f2 }
- #() { xcoeffs }
- #() { ycoeffs }
- f1 f2 f* fsqrt { f0 }
- f0 f2 f1 f- f/ { Q }
- two-pi f0 f* mus-srate f/ { theta0 }
- theta0 Q f2* f/ theta0 fsin f* f2* { de }
- de f2/ { de2 }
- theta0 fcos { ct }
- theta0 f2/ ftan { tn0 }
- 1 1 { jj kk }
- M 0 ?do
- kk 2* 1- pi f* M 2* f/ fsin f2* { Dk }
- de2 de2 f* 1.0 f+ Dk de2 f* f/ { Ak }
- de Dk f* Ak Ak f* 1.0 f- fsqrt Ak f+ f/ fsqrt { dk1 }
- Dk dk1 f/ de2 f* { Bk }
- Bk Bk f* 1.0 f- fsqrt Bk f+ { Wk }
- jj 1 = if tn0 Wk f/ else tn0 Wk f* then fatan f2* { thetajk }
- 1.0 0.5 dk1 f* thetajk fsin f* f-
- 1.0 0.5 dk1 f* thetajk fsin f* f+ f/ f2/ { betajk }
- 0.5 betajk f+ thetajk fcos f* { gammajk }
- 0.5 betajk f+ 1.0 thetajk fcos f- 1.0 ct f- f/ f* f2/ { alphajk }
- xcoeffs vct( alphajk f2* ct alphajk f* -4.0 f* alphajk f2* ) array-push drop
- ycoeffs vct( 1.0 -2.0 gammajk f* betajk f2* ) array-push drop
- jj 1 = if
- 2 to jj
- else
- 1 +to kk
- 1 to jj
- then
- loop
- M 2* 1+
- xcoeffs cascade->canonical
- ycoeffs cascade->canonical make-filter
+ { M f1 f2 }
+ #() { xcoeffs }
+ #() { ycoeffs }
+ f1 f2 f* fsqrt { f0 }
+ f0 f2 f1 f- f/ { Q }
+ two-pi f0 f* mus-srate f/ { theta0 }
+ theta0 Q f2* f/ theta0 fsin f* f2* { de }
+ de f2/ { de2 }
+ theta0 fcos { ct }
+ theta0 f2/ ftan { tn0 }
+ 1 1 { jj kk }
+ M 0 ?do
+ kk 2* 1- pi f* M 2* f/ fsin f2* { Dk }
+ de2 de2 f* 1.0 f+ Dk de2 f* f/ { Ak }
+ de Dk f* Ak Ak f* 1.0 f- fsqrt Ak f+ f/ fsqrt { dk1 }
+ Dk dk1 f/ de2 f* { Bk }
+ Bk Bk f* 1.0 f- fsqrt Bk f+ { Wk }
+ jj 1 = if
+ tn0 Wk f/
+ else
+ tn0 Wk f*
+ then fatan f2* { thetajk }
+ 1.0 0.5 dk1 f* thetajk fsin f* f-
+ 1.0 0.5 dk1 f* thetajk fsin f* f+ f/ f2/ { betajk }
+ 0.5 betajk f+ thetajk fcos f* { gammajk }
+ 0.5 betajk f+ 1.0 thetajk fcos f- 1.0 ct f- f/
+ f* f2/ { alphajk }
+ xcoeffs
+ vct( alphajk f2* ct alphajk f* -4.0 f* alphajk f2* )
+ array-push drop
+ ycoeffs vct( 1.0 -2.0 gammajk f* betajk f2* ) array-push drop
+ jj 1 = if
+ 2 to jj
+ else
+ 1 +to kk
+ 1 to jj
+ then
+ loop
+ M 2* 1+
+ xcoeffs cascade->canonical
+ ycoeffs cascade->canonical make-filter
;
\ ;;; -------- notch filters
-: make-notch-frequency-response <{ cur-srate freqs :optional notch-width 2 -- fresp }>
- #( 0.0 1.0 ) ( freq-response )
- freqs each { f }
- f notch-width f- f2* cur-srate f/ array-push \ ; left upper y hz
- 1.0 array-push \ ; left upper y resp
- f notch-width f2/ f- f2* cur-srate f/ array-push \ ; left bottom y hz
- 0.0 array-push \ ; left bottom y resp
- f notch-width f2/ f+ f2* cur-srate f/ array-push \ ; right bottom y hz
- 0.0 array-push \ ; right bottom y resp
- f notch-width f+ f2* cur-srate f/ array-push \ ; right upper y hz
- 1.0 array-push \ ; right upper y resp
- end-each
- #( 1.0 1.0 ) array-append ( freq-response )
-;
-
-: notch-channel <{ freqs
- :optional filter-order #f beg 0 dur #f snd #f chn #f edpos #f truncate #t notch-width 2 -- f }>
- doc" Returns a notch filter removing freqs."
- snd srate s>f freqs notch-width make-notch-frequency-response { nf }
- filter-order 2.0 snd srate notch-width f/ flog 2.0 flog f/ fceil f** fround->s || { order }
- $" %s %s %s %s %s" #( freqs filter-order beg dur get-func-name ) string-format { origin }
- nf order beg dur snd chn edpos truncate origin filter-channel
-;
-
-: notch-sound <{ freqs :optional filter-order #f snd #f chn #f notch-width 2 -- f }>
- doc" Returns a notch filter removing freqs."
- snd srate s>f freqs notch-width make-notch-frequency-response { nf }
- filter-order 2.0 snd srate notch-width f/ flog 2.0 flog f/ fceil f** fround->s || { order }
- $" %s %s 0 #f notch-channel " #( freqs filter-order ) string-format { origin }
- nf order snd chn #f origin filter-sound
+: make-notch-frequency-response
+ <{ cur-srate freqs :optional notch-width 2 -- fresp }>
+ #( 0.0 1.0 ) ( freq-response )
+ freqs each { f }
+ \ ; left upper y hz
+ f notch-width f- f2* cur-srate f/ array-push
+ \ ; left upper y resp
+ 1.0 array-push
+ \ ; left bottom y hz
+ f notch-width f2/ f- f2* cur-srate f/ array-push
+ \ ; left bottom y resp
+ 0.0 array-push
+ \ ; right bottom y hz
+ f notch-width f2/ f+ f2* cur-srate f/ array-push
+ \ ; right bottom y resp
+ 0.0 array-push
+ \ ; right upper y hz
+ f notch-width f+ f2* cur-srate f/ array-push
+ \ ; right upper y resp
+ 1.0 array-push
+ end-each
+ #( 1.0 1.0 ) array-append ( freq-response )
+;
+
+: notch-channel
+ <{ freqs :optional filter-order #f beg 0 dur #f snd #f chn #f edpos #f truncate #t notch-width 2 -- f }>
+ doc" Return notch filter removing freqs."
+ snd srate s>f freqs notch-width make-notch-frequency-response { nf }
+ filter-order 2.0 snd srate notch-width f/
+ flog 2.0 flog f/ fceil f** fround->s || { order }
+ "%s %s %s %s %s" #( freqs filter-order beg dur get-func-name )
+ string-format { origin }
+ nf order beg dur snd chn edpos truncate origin filter-channel
+;
+
+: notch-sound
+ <{ freqs :optional filter-order #f snd #f chn #f notch-width 2 -- f }>
+ doc" Return notch filter removing freqs."
+ snd srate s>f freqs notch-width make-notch-frequency-response { nf }
+ filter-order 2.0 snd srate notch-width f/
+ flog 2.0 flog f/ fceil f** fround->s || { order }
+ "%s %s 0 #f notch-channel " #( freqs filter-order )
+ string-format { origin }
+ nf order snd chn #f origin filter-sound
;
: notch-selection <{ freqs :optional filter-order #f notch-width 2 -- f }>
- doc" Returns a notch filter removing freqs."
- undef selection? if
- selection-srate s>f freqs notch-width make-notch-frequency-response ( nf )
- filter-order
- 2.0 selection-srate notch-width f/ flog 2.0 flog f/ fceil f** fround->s || ( order )
- #t ( truncate ) filter-selection
- then
+ doc" Return notch filter removing freqs."
+ undef selection? if
+ selection-srate s>f freqs notch-width
+ make-notch-frequency-response ( nf )
+ filter-order 2.0 selection-srate notch-width f/
+ flog 2.0 flog f/ fceil f** fround->s || ( order )
+ #t ( truncate )
+ filter-selection
+ then
;
\ ;;; -------- fractional Fourier Transform, z transform
@@ -1274,113 +1483,121 @@ its order is M * 2, F1 and F2 are the band edge frequencies in Hz."
\ ;;; translated from the fxt package of Joerg Arndt
: fractional-fourier-transform ( real imaginary n angle -- hr hi )
- doc" performs a fractional Fourier transform on data; \
+ doc" Perform fractional Fourier transform on data; \
if angle=1.0, you get a normal Fourier transform."
- { fr fi n v }
- v two-pi f* n f/ { ph0 }
- n 0.0 make-vct { hi }
- n 0.0 make-vct map!
- 0.0 0.0 { sr si }
- fr each { x }
- ph0 i f* j f* { phase }
- phase fcos { c }
- phase fsin { s }
- phase fcos { c }
- fi i vct-ref { y }
- x c f* y s f* f- { r }
- y c f* x s f* f+ { i }
- sr r f+ to sr
- si i f+ to si
- end-each
- hi i si vct-set! drop
- sr
- end-map ( hr ) hi
+ { fr fi n v }
+ v two-pi f* n f/ { ph0 }
+ n 0.0 make-vct { hi }
+ n 0.0 make-vct map!
+ 0.0 0.0 { sr si }
+ fr each { x }
+ ph0 i f* j f* { phase }
+ phase fcos { c }
+ phase fsin { s }
+ phase fcos { c }
+ fi i vct-ref { y }
+ x c f* y s f* f- { r }
+ y c f* x s f* f+ { i }
+ sr r f+ to sr
+ si i f+ to si
+ end-each
+ hi i si vct-set! drop
+ sr
+ end-map ( hr ) hi
;
'complex provided? [if]
- : z-transform ( data n z -- )
- doc" Performs a Z transform on DATA; \
- if z=e^2*pi*j/n you get a Fourier transform; complex results in returned vector."
- { f n z }
- n make-array map!
- 0.0 ( sum )
- 1.0 { t }
- z i f** { m }
- n 0 ?do
- f i vct-ref t c* c+ ( sum += ... )
- t m c* to t
- loop ( sum )
- end-map
- ;
- \ data n 0.0 2.0 n f/ pi f* make-rectangular cexp z-transform
+ : z-transform ( data n z -- )
+ doc" Perform Z transform on DATA; \
+if z=e^2*pi*j/n you get a Fourier transform; \
+complex results in returned vector."
+ { f n z }
+ n make-array map!
+ 0.0 ( sum )
+ 1.0 { t }
+ z i f** { m }
+ n 0 ?do
+ f i vct-ref t c* c+ ( sum += ... )
+ t m c* to t
+ loop ( sum )
+ end-map
+ ;
+ \ data n 0.0 2.0 n f/ pi f* make-rectangular cexp z-transform
[then]
\ ;;; -------- slow Hartley transform
: dht ( data -- vct )
- doc" Returns the Hartley transform of DATA."
- { data }
- data length { len }
- two-pi len f/ { w }
- len 0.0 make-vct { arr }
- len 0 do
- len 0 do
- arr j
- data i vct-ref
- i j w f* f* fcos
- i j w f* f* fsin f+ f* object-set+!
- loop
- loop
- arr
+ doc" Return the Hartley transform of DATA."
+ { data }
+ data length { len }
+ two-pi len f/ { w }
+ len 0.0 make-vct { arr }
+ len 0 do
+ len 0 do
+ arr j
+ data i vct-ref
+ i j w f* f* fcos
+ i j w f* f* fsin f+ f* object-set+!
+ loop
+ loop
+ arr
;
'complex provided? [if]
- : find-sine ( freq beg dur -- amp ph )
- doc" Returns the amplitude and initial-phase (for sin) at FREQ."
- { freq beg dur }
- freq hz->radians { incr }
- 0.0 0.0 { sw cw }
- beg #f #f 1 #f make-sampler { reader }
- dur 0 do
- reader next-sample { samp }
- i incr c* csin samp c* sw c+ to sw
- i incr c* ccos samp c* cw c+ to sw
- loop
- sw sw c* cw cw c* c+ csqrt dur c/ 2.0 c* ( amp )
- cw sw catan2 ( ph )
- ;
-
- hide
- : goert-cb { y0 y1 y2 cs -- prc; y self -- f }
- 1 proc-create y0 , y1 , y2 , cs , ( prc )
- does> { y self -- f }
- self 1 cells + @ self 2 cells + ! ( y2 = y1 )
- self @ self 1 cells + ! ( y1 = y0 )
- self 1 cells + @ { y1 }
- self 2 cells + @ { y2 }
- self 3 cells + @ { cs }
- y1 cs c* y2 c- y c+ self ! ( y0 = ... )
- #f
- ;
- set-current
- : goertzel <{ freq :optional beg 0 dur #f -- amp }>
- doc" Returns the amplitude of the FREQ spectral component."
- #f srate { sr }
- 0.0 0.0 0.0 { y0 y1 y2 }
- two-pi freq f* sr f/ { rfreq }
- rfreq fcos f2* { cs }
- dur unless #f #f #f frames to dur then
- y0 y1 y2 cs goert-cb beg dur #f #f #f scan-channel drop
- 0.0 rfreq fnegate make-rectangular cexp y1 c* y0 c+ magnitude
- ;
- previous
+ : find-sine ( freq beg dur -- amp ph )
+ doc" Return the amplitude and initial-phase (for sin) at FREQ."
+ { freq beg dur }
+ freq hz->radians { incr }
+ 0.0 0.0 { sw cw }
+ beg #f #f 1 #f make-sampler { reader }
+ dur 0 do
+ reader next-sample { samp }
+ i incr c* csin samp c* sw c+ to sw
+ i incr c* ccos samp c* cw c+ to cw
+ loop
+ sw dup c* cw dup c* c+ csqrt dur c/ 2.0 c* ( amp )
+ cw sw catan2 ( ph )
+ ;
+
+ hide
+ : goert-cb { y0 y1 y2 cs -- prc; y self -- f }
+ 1 proc-create ( prc )
+ y0 , y1 , y2 , cs ,
+ does> { y self -- f }
+ self 1 cells + @ self 2 cells + ! ( y2 = y1 )
+ self @ self 1 cells + ! ( y1 = y0 )
+ self 1 cells + @ { y1 }
+ self 2 cells + @ { y2 }
+ self 3 cells + @ { cs }
+ y1 cs c* y2 c- y c+ self ! ( y0 = ... )
+ #f
+ ;
+ set-current
+
+ : goertzel <{ freq :optional beg 0 dur #f -- amp }>
+ doc" Return the amplitude of the FREQ spectral component."
+ #f srate { sr }
+ 0.0 0.0 0.0 { y0 y1 y2 }
+ two-pi freq f* sr f/ { rfreq }
+ rfreq fcos f2* { cs }
+ dur unless
+ #f #f #f framples to dur
+ then
+ y0 y1 y2 cs goert-cb beg dur #f #f #f scan-channel drop
+ 0.0 rfreq fnegate make-rectangular cexp y1 c* y0 c+ magnitude
+ ;
+ previous
[then]
: make-spencer-filter ( -- gen )
- doc" It's a version of make-fir-filter; \
-it returns one of the standard smoothing filters from the era when computers were human beings."
- #( -3 -6 -5 3 21 46 67 74 67 46 21 3 -5 -6 -3 ) { lst }
- :xcoeffs lst 0.0 make-vct map! *key* 320.0 f/ end-map :order 15 make-fir-filter
+ doc" It's a version of make-fir-filter; \
+it returns one of the standard smoothing filters \
+from the era when computers were human beings."
+ #( -3 -6 -5 3 21 46 67 74 67 46 21 3 -5 -6 -3 ) { lst }
+ :xcoeffs lst 0.0 make-vct map!
+ *key* 320.0 f/
+ end-map :order 15 make-fir-filter
;
\ ;;; -------- any-random
@@ -1388,89 +1605,96 @@ it returns one of the standard smoothing filters from the era when computers wer
\ ;;; arbitrary random number distributions via the "rejection method"
: any-random <{ amount :optional en #f -- r }>
- amount f0= if
- 0.0
- else
- en if
- en envelope-last-x { x1 }
- 0.0 0.0 { x y }
- begin
- x1 random to x
- 1.0 random to y
- y x en 1.0 envelope-interp f<=
- until
- x
- else
- amount random
- then
- then
+ amount f0= if
+ 0.0
+ else
+ en if
+ en envelope-last-x { x1 }
+ 0.0 0.0 { x y }
+ begin
+ x1 random to x
+ 1.0 random to y
+ y x en 1.0 envelope-interp f<=
+ until
+ x
+ else
+ amount random
+ then
+ then
;
+
: gaussian-distribution ( s -- en )
- { s }
- #() { en }
- 2.0 s s f* f* { den }
- 0.0 -4.0 { x y }
- 21 0 do
- en x array-push
- y y f* den f/ fexp array-push to en
- x 0.05 f+ to x
- y 0.40 f* to y
- loop
- en
+ { s }
+ #() { en }
+ 2.0 s s f* f* { den }
+ 0.0 -4.0 { x y }
+ 21 0 do
+ en x array-push
+ y y f* den f/ fexp array-push to en
+ x 0.05 f+ to x
+ y 0.40 f* to y
+ loop
+ en
;
+
: pareto-distribution ( a -- en )
- { a }
- #() { en }
- 1.0 a 1.0 f+ f** a f/ { scl }
- 0.0 1.0 { x y }
- 21 0 do
- en x array-push
- a y a 1.0 f+ f** f/ scl f* array-push to en
- x 0.05 f+ to x
- y 0.20 f* to y
- loop
- en
-;
-\ lambda: <{ y -- val }> 1.0 #( 0 1 1 1 ) any-random ; map-channel \ uniform distribution
-\ lambda: <{ y -- val }> 1.0 #( 0 0 0.95 0.1 1 1 ) any-random ; map-channel \ mostly toward 1.0
-\ 1.0 gaussian-distribution value g lambda: <{ y -- val }> 1.0 g any-random ; map-channel
-\ 1.0 pareto-distribution value g lambda: <{ y -- val }> 1.0 g any-random ; map-channel
+ { a }
+ #() { en }
+ 1.0 a 1.0 f+ f** a f/ { scl }
+ 0.0 1.0 { x y }
+ 21 0 do
+ en x array-push
+ a y a 1.0 f+ f** f/ scl f* array-push to en
+ x 0.05 f+ to x
+ y 0.20 f* to y
+ loop
+ en
+;
+\ uniform distribution
+\ lambda: <{ y -- val }> 1.0 #( 0 1 1 1 ) any-random ; map-channel
+\ mostly toward 1.0
+\ lambda: <{ y -- val }> 1.0 #( 0 0 0.95 0.1 1 1 ) any-random ; map-channel
+\ 1.0 gaussian-distribution value g
+\ lambda: <{ y -- val }> 1.0 g any-random ; map-channel
+\ 1.0 pareto-distribution value g
+\ lambda: <{ y -- val }> 1.0 g any-random ; map-channel
\ ;;; this is the inverse integration function used by CLM to turn a
\ ;;; distribution function into a weighting function
: inverse-integrate <{ dist :optional data-size 512 e-size 50 -- vct }>
- #() { en }
- dist 1 array-ref exact->inexact dup { sum first-sum }
- dist 0 array-ref { x0 }
- dist envelope-last-x { x1 }
- x1 x0 f- e-size f/ { xincr }
- x0 { x }
- e-size 0 ?do
- en sum array-push
- x array-push to en
- x dist 1.0 envelope-interp sum f+ to sum
- x xincr f+ to x
- loop
- en -2 array-ref first-sum f- data-size 1- f/ { incr }
- first-sum to x
- data-size 0.0 make-vct map!
- x en 1.0 envelope-interp
- x incr f+ to x
- end-map ( data )
+ #() { en }
+ dist 1 array-ref exact->inexact dup { sum first-sum }
+ dist 0 array-ref { x0 }
+ dist envelope-last-x { x1 }
+ x1 x0 f- e-size f/ { xincr }
+ x0 { x }
+ e-size 0 ?do
+ en sum array-push
+ x array-push to en
+ x dist 1.0 envelope-interp sum f+ to sum
+ x xincr f+ to x
+ loop
+ en -2 array-ref first-sum f- data-size 1- f/ { incr }
+ first-sum to x
+ data-size 0.0 make-vct map!
+ x en 1.0 envelope-interp ( val )
+ x incr f+ to x
+ end-map ( data )
;
+
: gaussian-envelope ( s -- en )
- { s }
- #() { en }
- 2.0 s s f* f* { den }
- -1.0 -4.0 { x y }
- 21 0 do
- en x array-push
- y y f* den f/ fexp array-push to en
- x 0.1 f+ to x
- y 0.4 f* to y
- loop
- en
+ { s }
+ #() { en }
+ 2.0 s s f* f* { den }
+ -1.0 -4.0 { x y }
+ 21 0 do
+ en x array-push
+ y y f* den f/ fexp array-push to en
+ x 0.1 f+ to x
+ y 0.4 f* to y
+ loop
+ en
;
\ :envelope 1.0 gaussian-envelope make-rand
@@ -1480,326 +1704,392 @@ it returns one of the standard smoothing filters from the era when computers wer
hide
: chm-cb { sum -- prc; y self -- f }
- 1 proc-create sum , ( prc )
- does> { y self -- f }
- y self +! ( sum += y )
- #f
+ 1 proc-create ( prc )
+ sum ,
+ does> { y self -- f }
+ y self +! ( sum += y )
+ #f
;
set-current
+
: channel-mean <{ :optional snd #f chn #f -- val }> \ <f, 1> / n
- doc" Returns the average of the samples in the given channel: <f,1>/n."
- 0.0 { sum }
- snd chn #f frames { len }
- sum chm-cb 0 len snd chn #f scan-channel drop
- sum len f/
+ doc" Return the average of the samples in the given channel: <f,1>/n."
+ 0.0 { sum }
+ snd chn #f framples { len }
+ sum chm-cb 0 len snd chn #f scan-channel drop
+ sum len f/
;
previous
hide
: chte-cb { sum -- prc; y self -- f }
- 1 proc-create sum , ( prc )
- does> { y self -- f }
- y y f* self +! ( sum += y )
- #f
+ 1 proc-create ( prc )
+ sum ,
+ does> { y self -- f }
+ y dup f* self +! ( sum += y )
+ #f
;
set-current
+
: channel-total-energy <{ :optional snd #f chn #f -- val }> \ <f, f>
- doc" Returns the sum of the squares of all the samples in the given channel: <f,f>."
- 0.0 { sum }
- snd chn #f frames { len }
- sum chte-cb 0 len snd chn #f scan-channel drop
- sum
+ doc" Return the sum of the squares of all the samples \
+in the given channel: <f,f>."
+ 0.0 { sum }
+ snd chn #f framples { len }
+ sum chte-cb 0 len snd chn #f scan-channel drop
+ sum
;
previous
: channel-average-power <{ :optional snd #f chn #f -- val }> \ <f, f> / n
- doc" Returns the average power in the given channel: <f,f>/n."
- snd chn channel-total-energy snd chn #f frames f/
+ doc" Return the average power in the given channel: <f,f>/n."
+ snd chn channel-total-energy snd chn #f framples f/
;
+
: channel-rms <{ :optional snd #f chn #f -- val }> \ sqrt(<f, f> / n)
- doc" Returns the RMS value of the samples in the given channel: sqrt(<f,f>/n)."
- snd chn channel-average-power fsqrt
+ doc" Return the RMS value of the samples \
+in the given channel: sqrt(<f,f>/n)."
+ snd chn channel-average-power fsqrt
;
-: channel-variance <{ :optional snd #f chn #f -- val }> \ <f, f> - (<f, 1> / n) ^ 2 with quibbles
- doc" Returns the sample variance in the given channel: <f,f>-((<f,1>/ n)^2."
- snd chn #f frames { len }
- len len 1- f/ snd chn channel-mean f* { mu }
- snd chn channel-total-energy { P }
- P mu mu f* f-
+
+\ <f, f> - (<f, 1> / n) ^ 2 with quibbles
+: channel-variance <{ :optional snd #f chn #f -- val }>
+ doc" Return the sample variance in the \
+given channel: <f,f>-((<f,1>/ n)^2."
+ snd chn #f framples { len }
+ len len 1- f/ snd chn channel-mean f* { mu }
+ snd chn channel-total-energy { P }
+ P mu dup f* f-
;
+
: channel-norm <{ :optional snd #f chn #f -- val }> \ sqrt(<f, f>)
- doc" Returns the norm of the samples in the given channel: sqrt(<f,f>)."
- snd chn channel-total-energy fsqrt
+ doc" Return the norm of the samples in the given channel: sqrt(<f,f>)."
+ snd chn channel-total-energy fsqrt
;
hide
: chlp-cb { sum p -- prc; y self -- f }
- 1 proc-create sum , p , ( prc )
- does> { y self -- f }
- y fabs self cell+ @ ( p ) f** self +! ( sum += y ** p )
+ 1 proc-create ( prc )
+ sum , p ,
+ does> { y self -- f }
+ y fabs self cell+ @ ( p ) f** self +! ( sum += y ** p )
;
set-current
+
: channel-lp <{ p :optional snd #f chn #f -- val }>
- doc" Returns the Lp norm of the samples in the given channel."
- 0.0 { sum }
- snd chn #f frames { len }
- sum p chlp-cb 0 len snd chn #f scan-channel drop
- sum p 1/f f**
+ doc" Return the Lp norm of the samples in the given channel."
+ 0.0 { sum }
+ snd chn #f framples { len }
+ sum p chlp-cb 0 len snd chn #f scan-channel drop
+ sum p 1/f f**
;
previous
hide
: chlpinf-cb { mx -- prc; y self -- f }
- 1 proc-create mx , ( prc )
- does> { y self -- f }
- y fabs self @ fmax self !
+ 1 proc-create ( prc )
+ mx ,
+ does> { y self -- f }
+ y fabs self @ fmax self !
;
set-current
+
: channel-lp-inf <{ :optional snd #f chn #f -- val }>
- doc" Returns the maxamp in the given channel (the name is just math jargon for maxamp)."
- 0.0 { mx }
- snd chn #f frames { len }
- mx chlpinf-cb 0 len snd chn #f scan-channel drop
- mx
+ doc" Return the maxamp in the given channel (the name is \
+just math jargon for maxamp)."
+ 0.0 { mx }
+ snd chn #f framples { len }
+ mx chlpinf-cb 0 len snd chn #f scan-channel drop
+ mx
;
previous
: channel2-inner-product ( s1 c1 s2 c2 -- val ) \ <f, g>
- doc" Returns the inner-product of the two channels: <f,g>."
- { s1 c1 s2 c2 }
- 0.0 { sum }
- 0 s1 c1 1 #f make-sampler { r1 }
- 0 s2 c2 1 #f make-sampler { r2 }
- 0.0 ( sum )
- s1 c1 #f frames 0 ?do r1 next-sample r2 next-sample f* f+ ( sum += ... ) loop
- ( sum )
-;
-: channel2-angle ( s1 c1 s2 c2 -- val ) \ acos(<f, g> / (sqrt(<f, f>) * sqrt(<g, g>)))
- doc" Treats the two channels as vectors, \
-returning the 'angle' between them: acos(<f,g>/(sqrt(<f,f>)*sqrt(<g,g>)))"
+ doc" Return the inner-product of the two channels: <f,g>."
+ { s1 c1 s2 c2 }
+ 0.0 { sum }
+ 0 s1 c1 1 #f make-sampler { r1 }
+ 0 s2 c2 1 #f make-sampler { r2 }
+ 0.0 ( sum )
+ s1 c1 #f framples 0 ?do
+ r1 next-sample r2 next-sample f* f+ ( sum += ... )
+ loop
+ ( sum )
+;
+
+\ acos(<f, g> / (sqrt(<f, f>) * sqrt(<g, g>)))
+: channel2-angle ( s1 c1 s2 c2 -- val )
+ doc" Treat the two channels as vectors, \
+returning the 'angle' between them: acos(<f,g>/(sqrt(<f,f>)*sqrt(<g,g>)))."
{ s1 c1 s2 c2 }
- s1 c1 s2 c2 channel2-inner-product { inprod }
- s1 c1 channel-norm { norm1 }
- s2 c2 channel-norm { norm2 }
- inprod norm1 norm2 f* f/ facos
+ s1 c1 s2 c2 channel2-inner-product { inprod }
+ s1 c1 channel-norm { norm1 }
+ s2 c2 channel-norm { norm2 }
+ inprod norm1 norm2 f* f/ facos
;
+
: channel2-orthogonal? ( s1 c1 s2 c2 -- f ) \ <f, g> == 0
- doc" Returns #t if the two channels' inner-product is 0: <f,g>==0."
- { s1 c1 s2 c2 }
- s1 c1 s2 c2 channel2-inner-product fzero?
+ doc" Return #t if the two channels' inner-product is 0: <f,g>==0."
+ { s1 c1 s2 c2 }
+ s1 c1 s2 c2 channel2-inner-product fzero?
;
-: channel2-coefficient-of-projection ( s1 c1 s2 c2 -- val ) \ s1,c1 = x, s2,c2 = y, <f, g> / <f, f>
- doc" Returns <f,g>/<f,f>."
- { s1 c1 s2 c2 }
- s1 c1 s2 c2 channel2-inner-product s1 c1 channel-total-energy f/
+
+\ s1,c1 = x, s2,c2 = y, <f, g> / <f, f>
+: channel2-coefficient-of-projection ( s1 c1 s2 c2 -- val )
+ doc" Return <f,g>/<f,f>."
+ { s1 c1 s2 c2 }
+ s1 c1 s2 c2 channel2-inner-product s1 c1 channel-total-energy f/
;
\ ;;; -------- end of JOS stuff --------
: channel-distance ( s1 c1 s2 c2 -- val )
- doc" Returns the euclidean distance between the two channels: sqrt(<f-g,f-g>)."
- { s1 c1 s2 c2 }
- 0 s1 c1 1 #f make-sampler { r1 }
- 0 s2 c2 1 #f make-sampler { r2 }
- 0.0 ( sum )
- s1 c1 #f frames s2 c2 #f frames min 0 ?do
- r1 next-sample r2 next-sample f- dup f* f+ ( sum += diff^2 )
- loop
- ( sum ) fsqrt
+ doc" Return the euclidean distance between the two channels: \
+sqrt(<f-g,f-g>)."
+ { s1 c1 s2 c2 }
+ 0 s1 c1 1 #f make-sampler { r1 }
+ 0 s2 c2 1 #f make-sampler { r2 }
+ 0.0 ( sum )
+ s1 c1 #f framples s2 c2 #f framples min 0 ?do
+ r1 next-sample r2 next-sample f- dup f* f+ ( sum += diff^2 )
+ loop
+ ( sum ) fsqrt
;
: periodogram ( N -- )
- doc" Displays an 'N' point Bartlett periodogram of the samples in the current channel."
- { N }
- #f #f #f frames { len }
- 0 #f #f 1 #f make-sampler { rd }
- N 2* { N2 }
- N2 0.0 make-vct { rl }
- N 0 ?do rl i rd next-sample vct-set! drop loop
- N2 0.0 make-vct { im }
- rl im N2 1 mus-fft drop
- N 0.0 make-vct map!
- rl i vct-ref dup f*
- im i vct-ref dup f* f+
- end-map ( average-data ) len N f/ fceil 1/f vct-scale! "average-data"
- 0.0 1.0 #f #f #f #f #t #t graph
+ doc" Display an 'N' point Bartlett periodogram \
+of the samples in the current channel."
+ { N }
+ #f #f #f framples { len }
+ 0 #f #f 1 #f make-sampler { rd }
+ N 2* { N2 }
+ N2 0.0 make-vct { rl }
+ N 0 ?do
+ rl i rd next-sample vct-set! drop
+ loop
+ N2 0.0 make-vct { im }
+ rl im N2 1 mus-fft drop
+ N 0.0 make-vct map!
+ rl i vct-ref dup f*
+ im i vct-ref dup f* f+
+ end-map ( average-data ) len N f/ fceil 1/f vct-scale!
+ "average-data" 0.0 1.0 #f #f #f #f #t #t graph
;
\ ;;; -------- ssb-am friends
hide
: scp-cb { gen -- prc; y self -- val }
- 1 proc-create gen , ( prc )
- does> { y self -- val }
- self @ y 0.0 ssb-am
+ 1 proc-create ( prc )
+ gen ,
+ does> { y self -- val }
+ self @ y 0.0 ssb-am
;
set-current
-: shift-channel-pitch <{ freq :optional order 40 beg 0 dur #f snd #f chn #f edpos #f -- val }>
- :frequency freq :order order make-ssb-am { gen }
- $" %s %s %s %s %s" #( freq order beg dur get-func-name ) string-format { origin }
- gen scp-cb beg dur snd chn edpos origin map-channel
+
+: shift-channel-pitch
+ <{ freq :optional order 40 beg 0 dur #f snd #f chn #f edpos #f -- val }>
+ :frequency freq :order order make-ssb-am { gen }
+ "%s %s %s %s %s" #( freq order beg dur get-func-name )
+ string-format { origin }
+ gen scp-cb beg dur snd chn edpos origin map-channel
;
previous
-: hz->2pi ( freq -- r ) two-pi f* #f srate f/ ;
+: hz->2pi ( freq -- r )
+ two-pi f* #f srate f/
+;
hide
: ssbmc-cb { nmx ssbs bands -- prc; y self -- val }
- 1 proc-create nmx , ssbs , bands ,
- does> { y self -- val }
- self @ { nmx }
- self 1 cells + @ { ssbs }
- self 2 cells + @ { bands }
- 0.0 ssbs each ( gen ) bands i array-ref y bandpass 0.0 ssb-am f+ ( sum+=... ) end-each
- ( sum ) dup fabs nmx fmax self ! ( to nmx )
+ 1 proc-create ( prc )
+ nmx , ssbs , bands ,
+ does> { y self -- val }
+ self @ { nmx }
+ self 1 cells + @ { ssbs }
+ self 2 cells + @ { bands }
+ 0.0 ssbs each ( gen )
+ bands i array-ref y bandpass 0.0 ssb-am f+ ( sum+=... )
+ end-each
+ ( sum ) dup fabs nmx fmax self ! ( to nmx )
;
+
: ssbaoe-cb { mx ssbs bands beg dur snd chn edpos -- prc; self -- val }
- 0.0 { nmx }
- nmx ssbs bands ssbmc-cb { proc }
- 0 proc-create proc , mx , nmx , beg , dur , snd , chn , edpos , ( prc )
- does> { self -- val }
- self @ { proc }
- self 1 cells + @ { mx }
- self 2 cells + @ { nmx }
- self 3 cells + @ { beg }
- self 4 cells + @ { dur }
- self 5 cells + @ { snd }
- self 6 cells + @ { chn }
- self 7 cells + @ { edpos }
- proc beg dur snd chn edpos #f map-channel drop
- mx nmx f/ beg dur snd chn #f scale-channel
+ 0.0 { nmx }
+ nmx ssbs bands ssbmc-cb { proc }
+ 0 proc-create ( prc )
+ proc , mx , nmx , beg , dur , snd , chn , edpos ,
+ does> { self -- val }
+ self @ { proc }
+ self 1 cells + @ { mx }
+ self 2 cells + @ { nmx }
+ self 3 cells + @ { beg }
+ self 4 cells + @ { dur }
+ self 5 cells + @ { snd }
+ self 6 cells + @ { chn }
+ self 7 cells + @ { edpos }
+ proc beg dur snd chn edpos #f map-channel drop
+ mx nmx f/ beg dur snd chn #f scale-channel
;
set-current
-: ssb-bank <{ old-freq new-freq pairs
- :optional order 40 bw 50.0 beg 0 dur #f snd #f chn #f edpos #f -- val }>
- pairs make-array { ssbs }
- pairs make-array { bands }
- new-freq old-freq f- old-freq f/ { factor }
- snd chn #f maxamp { mx }
- pairs 0 ?do
- i 1.0 f+ { idx }
- old-freq idx f* { aff }
- idx pairs f2* f/ 1.0 f+ bw f* { bwf }
- ssbs i :frequency idx factor f* old-freq f* :order 40 make-ssb-am array-set!
- bands i aff bwf f- hz->2pi aff bwf f+ hz->2pi order make-bandpass array-set!
- loop
- $" %s %s %s %s %s %s %s %s"
- #( old-freq new-freq pairs order bw beg dur get-func-name ) string-format { origin }
- mx ssbs bands beg dur snd chn edpos ssbaoe-cb origin as-one-edit
+
+: ssb-bank
+ <{ old-freq new-freq pairs :optional order 40 bw 50.0 beg 0 dur #f snd #f chn #f edpos #f -- val }>
+ pairs make-array { ssbs }
+ pairs make-array { bands }
+ new-freq old-freq f- old-freq f/ { factor }
+ snd chn #f maxamp { mx }
+ pairs 0 ?do
+ i 1.0 f+ { idx }
+ old-freq idx f* { aff }
+ idx pairs f2* f/ 1.0 f+ bw f* { bwf }
+ ssbs i
+ :frequency idx factor f* old-freq f* :order 40 make-ssb-am
+ array-set!
+ bands i
+ aff bwf f- hz->2pi aff bwf f+ hz->2pi order make-bandpass
+ array-set!
+ loop
+ "%s %s %s %s %s %s %s %s"
+ #( old-freq new-freq pairs order bw beg dur get-func-name )
+ string-format { origin }
+ mx ssbs bands beg dur snd chn edpos ssbaoe-cb origin as-one-edit
;
previous
hide
: ssbemc-cb { nmx ssbs bands frenvs -- prc; y self -- val }
- 1 proc-create nmx , ssbs , bands , frenvs ,
- does> { y self -- val }
- self @ { nmx }
- self 1 cells + @ { ssbs }
- self 2 cells + @ { bands }
- self 3 cells + @ { frenvs }
- 0.0 ssbs each ( gen )
- bands i array-ref y bandpass frenvs i array-ref env ssb-am f+ ( sum+=... )
- end-each
- ( sum ) dup fabs nmx fmax self ! ( to nmx )
+ 1 proc-create ( prc )
+ nmx , ssbs , bands , frenvs ,
+ does> { y self -- val }
+ self @ { nmx }
+ self 1 cells + @ { ssbs }
+ self 2 cells + @ { bands }
+ self 3 cells + @ { frenvs }
+ 0.0 ssbs each ( gen )
+ bands i array-ref y bandpass
+ frenvs i array-ref env ssb-am f+ ( sum+=... )
+ end-each
+ ( sum ) dup fabs nmx fmax self ! ( to nmx )
+ ( sum )
;
+
: ssbeaoe-cb { mx ssbs bands frenvs beg dur snd chn edpos -- prc; self -- val }
- 0.0 { nmx }
- nmx ssbs bands frenvs ssbemc-cb { proc }
- 0 proc-create proc , mx , nmx , beg , dur , snd , chn , edpos , ( prc )
- does> { self -- val }
- self @ { proc }
- self 1 cells + @ { mx }
- self 2 cells + @ { nmx }
- self 3 cells + @ { beg }
- self 4 cells + @ { dur }
- self 5 cells + @ { snd }
- self 6 cells + @ { chn }
- self 7 cells + @ { edpos }
- proc beg dur snd chn edpos #f map-channel drop
- mx nmx f/ beg dur snd chn #f scale-channel
+ 0.0 { nmx }
+ nmx ssbs bands frenvs ssbemc-cb { proc }
+ 0 proc-create ( prc )
+ proc , mx , nmx , beg , dur , snd , chn , edpos ,
+ does> { self -- val }
+ self @ { proc }
+ self 1 cells + @ { mx }
+ self 2 cells + @ { nmx }
+ self 3 cells + @ { beg }
+ self 4 cells + @ { dur }
+ self 5 cells + @ { snd }
+ self 6 cells + @ { chn }
+ self 7 cells + @ { edpos }
+ proc beg dur snd chn edpos #f map-channel drop
+ mx nmx f/ beg dur snd chn #f scale-channel
;
set-current
+
: ssb-bank-env <{ old-freq new-freq freq-env pairs
- :optional order 40 bw 50.0 beg 0 dur #f snd #f chn #f edpos #f -- val }>
- pairs make-array { ssbs }
- pairs make-array { bands }
- pairs make-array { frenvs }
- new-freq old-freq f- old-freq f/ { factor }
- snd chn #f maxamp { mx }
- snd chn #f frames 1- { len }
- pairs 0 ?do
- i 1.0 f+ { idx }
- old-freq idx f* { aff }
- idx pairs f2* f/ 1.0 f+ bw f* { bwf }
- ssbs i :frequency idx factor f* old-freq f* :order 40 make-ssb-am array-set!
- bands i aff bwf f- hz->2pi aff bwf f+ hz->2pi order make-bandpass array-set!
- :envelope freq-env :scaler idx hz->radians :length len make-env
- frenvs i rot array-set!
- loop
- $" %s %s %s %s %s %s %s %s %s"
- #( old-freq new-freq freq-env pairs order bw beg dur get-func-name ) string-format { origin }
- mx ssbs bands frenvs beg dur snd chn edpos ssbeaoe-cb origin as-one-edit
+ :optional order 40 bw 50.0 beg 0 dur #f snd #f chn #f edpos #f -- val }>
+ pairs make-array { ssbs }
+ pairs make-array { bands }
+ pairs make-array { frenvs }
+ new-freq old-freq f- old-freq f/ { factor }
+ snd chn #f maxamp { mx }
+ snd chn #f framples 1- { len }
+ pairs 0 ?do
+ i 1.0 f+ { idx }
+ old-freq idx f* { aff }
+ idx pairs f2* f/ 1.0 f+ bw f* { bwf }
+ ssbs i
+ :frequency idx factor f* old-freq f* :order 40 make-ssb-am
+ array-set!
+ bands i
+ aff bwf f- hz->2pi aff bwf f+ hz->2pi order make-bandpass
+ array-set!
+ :envelope freq-env
+ :scaler idx hz->radians :length len make-env { en }
+ frenvs i en array-set!
+ loop
+ "%s %s %s %s %s %s %s %s %s"
+ #( old-freq new-freq freq-env pairs order bw beg dur get-func-name )
+ string-format { origin }
+ mx ssbs bands frenvs beg dur snd chn edpos ssbeaoe-cb origin as-one-edit
;
previous
\ ;; echoes with each echo at a new pitch via ssb-am etc
-: make-transposer <{ old-freq new-freq pairs :optional order 40 bw 50.0 -- gen }>
- new-freq old-freq f- old-freq f/ { factor }
- pairs make-array map! i 1+ factor f* old-freq f* make-ssb-am end-map { ssbs }
- pairs make-array map!
- i 1.0 f+ { idx }
- idx old-freq f* { aff }
- idx pairs f2* f/ 1.0 f+ bw f* { bwf }
- aff bwf f- hz->radians aff bwf f+ hz->radians order make-bandpass
- end-map { bands }
- #( ssbs bands )
+: make-transposer <{ old-freq new-freq pairs :optional order 40 bw 50.0 -- g }>
+ new-freq old-freq f- old-freq f/ { factor }
+ pairs make-array map!
+ i 1+ factor f* old-freq f* make-ssb-am
+ end-map { ssbs }
+ pairs make-array map!
+ i 1.0 f+ { idx }
+ idx old-freq f* { aff }
+ idx pairs f2* f/ 1.0 f+ bw f* { bwf }
+ aff bwf f- hz->radians aff bwf f+ hz->radians
+ order make-bandpass
+ end-map { bands }
+ #( ssbs bands )
;
+
: transpose ( gen input -- val )
- { gen input }
- gen 0 array-ref { ssbs }
- gen 1 array-ref { bands }
- 0.0 ( sum )
- ssbs each { g }
- g bands i array-ref input bandpass 0.0 ssb-am f+ ( sum += )
- end-each
- ( sum )
+ { gen input }
+ gen 0 array-ref { ssbs }
+ gen 1 array-ref { bands }
+ 0.0 ( sum )
+ ssbs each { g }
+ g bands i array-ref input bandpass 0.0 ssb-am f+ ( sum += )
+ end-each
+ ( sum )
;
: make-fdelay ( len pitch scaler -- prc; y self -- val )
- { len pitch scaler }
- len make-delay { dly }
- 440.0 440.0 pitch f* 10 make-transposer { ssb }
- 1 proc-create dly , ssb , scaler , ( prc )
- does> { y self -- val }
- self @ { dly }
- self cell+ @ { ssb }
- self 2 cells + @ { scaler }
- dly ssb dly 0.0 tap transpose scaler f* y f+ 0.0 delay
+ { len pitch scaler }
+ len make-delay { dly }
+ 440.0 440.0 pitch f* 10 make-transposer { ssb }
+ 1 proc-create ( prc )
+ dly , ssb , scaler ,
+ does> { y self -- val }
+ self @ { dly }
+ self cell+ @ { ssb }
+ self 2 cells + @ { scaler }
+ dly ssb dly 0.0 tap transpose scaler f* y f+ 0.0 delay
;
+
: fdelay ( gen input -- val )
- { gen input }
- gen #( input ) run-proc
+ { gen input }
+ gen #( input ) run-proc
;
+
: transposed-echo ( pitch scaler secs -- val )
- { pitch scaler secs }
- #f srate secs f* fround->s pitch scaler make-fdelay 0 #f #f #f #f #f map-channel
+ { pitch scaler secs }
+ #f srate secs f* fround->s pitch scaler make-fdelay
+ 0 #f #f #f #f #f map-channel
;
\ ;;; vct|channel|spectral-polynomial
: vct-polynomial ( v coeffs -- vct )
- { v coeffs }
- v vct-length coeffs last-ref make-vct { new-v }
- coeffs vct-length 2- 0 ?do
- new-v v vct-multiply! coeffs i vct-ref vct-offset! drop
- -1 +loop
- new-v
+ { v coeffs }
+ v vct-length coeffs last-ref make-vct { new-v }
+ coeffs vct-length 2- 0 ?do
+ new-v v vct-multiply! coeffs i vct-ref vct-offset! drop
+ -1 +loop
+ new-v
;
+
: channel-polynomial <{ coeffs :optional snd #f chn #f -- vct }>
- snd chn #f frames { len }
- $" %S %s" #( coeffs get-func-name ) string-format { origin }
- 0 len snd chn #f channel->vct coeffs vct-polynomial 0 len snd chn #f origin vct->channel
+ snd chn #f framples { len }
+ "%S %s" #( coeffs get-func-name ) string-format { origin }
+ 0 len snd chn #f channel->vct coeffs vct-polynomial 0 len snd chn
+ #f origin vct->channel
;
\ vct( 0.0 0.5 ) channel-polynomial == x*0.5
\ vct( 0.0 1.0 1.0 1.0 ) channel-polynomial == x*x*x + x*x + x
@@ -1807,38 +2097,43 @@ previous
\ ;;; convolution -> * in freq
: spectral-polynomial <{ coeffs :optional snd #f chn #f -- vct }>
- snd chn #f frames { len }
- 0 len snd chn #f channel->vct { sound }
- coeffs vct-length { num-coeffs }
- num-coeffs 2 < if
- len
- else
- 2.0 num-coeffs 1.0 f- len f* flog 2.0 flog f/ fceil f** fround->s
- then { fft-len }
- fft-len 0.0 make-vct { rl1 }
- fft-len 0.0 make-vct { rl2 }
- fft-len 0.0 make-vct { new-sound }
- coeffs 0 vct-ref f0> if
- coeffs 0 vct-ref { dither }
- new-sound map! dither mus-random end-map drop
- then
- num-coeffs 1 > if
- new-sound sound vct-copy coeffs 1 vct-ref vct-scale! vct-add! drop
- num-coeffs 2 > if
- snd chn #f maxamp { peak }
- rl1 0.0 vct-scale! sound vct-add! drop
- 0.0 { pk }
- num-coeffs 2 ?do
- rl1 rl2 0.0 vct-scale! sound vct-add! fft-len convolution drop
- rl1 vct-peak to pk
- new-sound rl1 vct-copy coeffs i vct-ref peak f* pk f/ vct-scale! vct-add! drop
- loop
- new-sound vct-peak to pk
- new-sound peak pk f/ vct-scale! drop
- then
- then
- $" %S %s" #( coeffs get-func-name ) string-format { origin }
- new-sound 0 num-coeffs 1- len * len max snd chn #f origin vct->channel
+ snd chn #f framples { len }
+ 0 len snd chn #f channel->vct { sound }
+ coeffs vct-length { num-coeffs }
+ num-coeffs 2 < if
+ len
+ else
+ 2.0 num-coeffs 1 f- len f* flog 2.0 flog f/ fceil f** fround->s
+ then { fft-len }
+ fft-len 0.0 make-vct { rl1 }
+ fft-len 0.0 make-vct { rl2 }
+ fft-len 0.0 make-vct { new-sound }
+ coeffs 0 vct-ref f0> if
+ coeffs 0 vct-ref { dither }
+ new-sound map!
+ dither mus-random
+ end-map drop
+ then
+ num-coeffs 1 > if
+ new-sound sound vct-copy coeffs 1 vct-ref
+ vct-scale! vct-add! drop
+ num-coeffs 2 > if
+ snd chn #f maxamp { peak }
+ rl1 0.0 vct-scale! sound vct-add! drop
+ 0.0 { pk }
+ num-coeffs 2 ?do
+ rl1 rl2 0.0 vct-scale!
+ sound vct-add! fft-len convolution drop
+ rl1 vct-peak to pk
+ new-sound rl1 vct-copy coeffs i vct-ref
+ peak f* pk f/ vct-scale! vct-add! drop
+ loop
+ new-sound vct-peak to pk
+ new-sound peak pk f/ vct-scale! drop
+ then
+ then
+ "%S %s" #( coeffs get-func-name ) string-format { origin }
+ new-sound 0 num-coeffs 1- len * len max snd chn #f origin vct->channel
;
\ ;;; ----------------
@@ -1849,11 +2144,12 @@ previous
\ ;;; translated to Snd/Scheme Bill S 19-Jan-05
\ ;;;
\ ;;; Returns the continuous spectral centroid envelope of a sound.
-\ ;;; The spectral centroid is the "center of gravity" of the spectrum, and it
-\ ;;; has a rough correlation to our sense of "brightness" of a sound.
+\ ;;; The spectral centroid is the "center of gravity" of the spectrum,
+\ ;;; and it has a rough correlation to our sense of "brightness" of a sound.
\ ;;;
-\ ;;; [Beauchamp, J., "Synthesis by spectral amplitude and 'brightness' matching
-\ ;;; analyzed musical sounds". Journal of Audio Engineering Society 30(6), 396-406]
+\ ;;; [Beauchamp, J., "Synthesis by spectral amplitude and 'brightness'
+\ ;;; matching analyzed musical sounds".
+\ ;;; Journal of Audio Engineering Society 30(6), 396-406]
\ ;;;
\ ;;; The formula used is:
\ ;;; C = [SUM<n=1toj>F(n)A(n)] / [SUM<n=1toj>A(n)]
@@ -1865,87 +2161,99 @@ previous
\ ;;; of SCENTROID can be used with the function NORMALIZE-CENTROID, below,
\ ;;; to provide a "normalized spectral centroid".
\ ;;;
-\ ;;; DB-FLOOR -- Frames below this decibel level (0 dB = max) will be discarded
-\ ;;; and returned with spectral centroid = 0
+\ ;;; DB-FLOOR -- Frames below this decibel level (0 dB = max) will be
+\ ;;; discarded and returned with spectral centroid = 0
\ ;;;
\ ;;; RFREQ -- Rendering frequency. Number of measurements per second.
\ ;;;
\ ;;; FFTSIZE -- FFT window size. Must be a power of 2. 4096 is recommended.
-: scentroid <{ file :key beg 0.0 dur #f db-floor -40.0 rfreq 100.0 fftsize 4094 -- vals }>
- doc" Returns the spectral centroid envelope of a sound; \
+: scentroid
+ <{ file :key beg 0.0 dur #f db-floor -40.0 rfreq 100.0 fftsize 4094 -- vals }>
+ doc" Return the spectral centroid envelope of a sound; \
RFREQ is the rendering frequency, the number of measurements per second; \
DB-FLOOR is the level below which data will be ignored."
- file find-file to file
- file false? if 'no-such-file #( get-func-name file ) fth-throw then
- file mus-sound-srate { fsr }
- fsr rfreq f/ fround->s { incrsamps }
- beg fsr f* fround->s { start }
- dur if dur fsr f* else file mus-sound-frames beg d- then { end }
- fftsize 0.0 make-vct { fdr }
- fftsize 0.0 make-vct { fdi }
- end start d- incrsamps d/ 1 d+ { windows }
- windows 0.0 make-vct { results }
- fftsize 2/ { fft2 }
- fsr fftsize f/ fround->s { binwidth }
- file make-readin { rd }
- 0 { loc }
- end start ?do
- rd i set-mus-location drop
- 0.0 { sum-of-squares }
- fdr map!
- rd readin { val }
- val dup f* sum-of-squares f+ to sum-of-squares
- val
- end-map
- sum-of-squares fftsize f/ fsqrt linear->db db-floor f>= if
- 0.0 0.0 { numsum densum }
- fdi 0.0 vct-fill! drop
- fdr fdi fftsize 1 mus-fft drop
- fdr fdi rectangular->polar drop
- fft2 0 ?do
- fdr i vct-ref binwidth f* i f* numsum f+ to numsum
- fdr i vct-ref densum f+ to densum
- loop
- results loc numsum densum f/ vct-set! drop
- then
- loc 1+ to loc
- incrsamps +loop
- results
+ file find-file to file
+ file unless
+ 'no-such-file #( "%s: %s" get-func-name file ) fth-throw
+ then
+ file mus-sound-srate { fsr }
+ fsr rfreq f/ fround->s { incrsamps }
+ beg fsr f* fround->s { start }
+ dur if
+ dur fsr f*
+ else
+ file mus-sound-framples beg d-
+ then { end }
+ fftsize 0.0 make-vct { fdr }
+ fftsize 0.0 make-vct { fdi }
+ end start d- incrsamps d/ 1 d+ { windows }
+ windows 0.0 make-vct { results }
+ fftsize 2/ { fft2 }
+ fsr fftsize f/ fround->s { binwidth }
+ file make-readin { rd }
+ 0 { loc }
+ end start ?do
+ rd i set-mus-location drop
+ 0.0 { sum-of-squares }
+ fdr map!
+ rd readin { val }
+ val dup f* sum-of-squares f+ to sum-of-squares
+ val
+ end-map
+ sum-of-squares fftsize f/ fsqrt linear->db db-floor f>= if
+ 0.0 0.0 { numsum densum }
+ fdi 0.0 vct-fill! drop
+ fdr fdi fftsize 1 mus-fft ( fdr ) fdi
+ rectangular->polar drop
+ fft2 0 ?do
+ fdr i vct-ref
+ binwidth f* i f* numsum f+ to numsum
+ fdr i vct-ref densum f+ to densum
+ loop
+ results loc numsum densum f/ vct-set! drop
+ then
+ loc 1+ to loc
+ incrsamps +loop
+ results
;
\ ;;; ----------------
\ ;;;
\ ;;; invert-filter inverts an FIR filter
\ ;;;
-\ ;;; say we previously filtered a sound via (filter-channel (vct .5 .25 .125))
+\ ;;; say we previously filtered a sound via
+\ ;;; (filter-channel (vct .5 .25 .125))
\ ;;; and we want to undo it without using (undo):
\ ;;; (filter-channel (invert-filter (vct .5 .25 .125)))
\ ;;;
-\ ;;; there are a million gotchas here. The primary one is that the inverse filter
-\ ;;; can "explode" -- the coefficients can grow without bound. For example, any
-\ ;;; filter returned by spectrum->coeffs above will be a problem (it always returns
-\ ;;; a "linear phase" filter).
+\ ;;; there are a million gotchas here. The primary one is that the inverse
+\ ;;; filter can "explode" -- the coefficients can grow without bound.
+\ ;;; For example, any filter returned by spectrum->coeffs above will
+\ ;;; be a problem (it always returns a "linear phase" filter).
: invert-filter ( fcoeffs -- res )
- doc" Tries to return an inverse filter to undo the effect of the FIR filter coeffs."
- { fcoeffs }
- fcoeffs length { flen }
- 32 flen + 0.0 make-vct { coeffs }
- coeffs length { order }
- flen 0 do coeffs i fcoeffs i vct-ref vct-set! drop loop
- order 0.0 make-vct { nfilt }
- nfilt 0 coeffs 0 vct-ref 1/f vct-set! drop
- order 1 ?do
- i { kk }
- 0.0 ( sum )
- i 0 ?do
- nfilt i vct-ref coeffs kk vct-ref f* f+ ( sum += ... )
- kk 1- to kk
- loop
- ( sum ) coeffs 0 vct-ref fnegate f/ nfilt i -rot vct-set! drop
- loop
- nfilt
+ doc" Try to return an inverse filter to undo \
+the effect of the FIR filter coeffs."
+ { fcoeffs }
+ fcoeffs length { flen }
+ 32 flen + 0.0 make-vct { coeffs }
+ coeffs length { order }
+ flen 0 do
+ coeffs i fcoeffs i vct-ref vct-set! drop
+ loop
+ order 0.0 make-vct { nfilt }
+ nfilt 0 coeffs 0 vct-ref 1/f vct-set! drop
+ order 1 ?do
+ i { kk }
+ 0.0 ( sum )
+ i 0 ?do
+ nfilt i vct-ref coeffs kk vct-ref f* f+ ( sum += ... )
+ kk 1- to kk
+ loop
+ ( sum ) coeffs 0 vct-ref fnegate f/ nfilt i -rot vct-set! drop
+ loop
+ nfilt
;
\ ;;; ----------------
@@ -1954,35 +2262,38 @@ DB-FLOOR is the level below which data will be ignored."
\ ;;;
\ ;;; one of the standard non-linear filters
\ ;;; this version is taken from Monson Hayes "Statistical DSP and Modeling"
-\ ;;; it is a slight specialization of the form mentioned by J O Smith and others
+\ ;;; it is a slight specialization of the form mentioned by J O Smith
+\ ;;; and others
: make-volterra-filter ( acoeffs bcoeffs -- gen )
- doc" Returns an array for use with volterra-filter, \
+ doc" Return array for use with volterra-filter, \
producing one of the standard non-linear filters."
- { acoeffs bcoeffs }
- #( acoeffs
- bcoeffs
- acoeffs length bcoeffs length max 0.0 make-vct )
+ { acoeffs bcoeffs }
+ #( acoeffs
+ bcoeffs
+ acoeffs length bcoeffs length max 0.0 make-vct )
;
-: volterra-filter ( flt x -- val )
- doc" Takes FLT, an array returned by make-volterra-filter, \
+
+: volterra-filter ( flt y -- val )
+ doc" Take FLT, an array returned by make-volterra-filter, \
and an input X, and returns the (non-linear filtered) result."
- { flt x }
- flt 0 array-ref { as }
- flt 1 array-ref { bs }
- flt 2 array-ref { xs }
- as length { x1len }
- bs length { x2len }
- xs length { xlen }
- xs xlen 1- xlen 2- #t vct-move! drop
- xs 0 x vct-set! drop
- as xs x1len dot-product ( sum )
- x2len 0 ?do
- x2len 0 ?do
- bs i vct-ref xs j vct-ref f* xs i vct-ref f* f+ ( sum += ... )
- loop
- loop
- ( sum )
+ { flt y }
+ flt 0 array-ref { as }
+ flt 1 array-ref { bs }
+ flt 2 array-ref { xs }
+ as length { x1len }
+ bs length { x2len }
+ xs length { xlen }
+ xs xlen 1- xlen 2- #t vct-move! drop
+ xs 0 y vct-set! drop
+ as xs x1len dot-product ( sum )
+ x2len 0 ?do
+ x2len 0 ?do
+ bs i vct-ref
+ xs j vct-ref f* xs i vct-ref f* f+ ( sum += ... )
+ loop
+ loop
+ ( sum )
;
\ vct( 0.5 0.1 ) vct( 0.3 0.2 0.1 ) make-volterra-filter value flt
\ lambda: <{ y -- val }> flt y volterra-filter ; map-channel
@@ -1992,28 +2303,30 @@ and an input X, and returns the (non-linear filtered) result."
\ ;;; moving-max generator (the max norm, or uniform norm, infinity-norm)
: make-moving-max <{ :optional size 128 -- gen }>
- doc" Returns a moving-max generator. \
-The generator keeps a running window of the last SIZE inputs, returning the maxamp in that window."
- save-stack { s }
- size make-delay { gen }
- s restore-stack
- gen 0.0 set-mus-scaler drop
- gen
+ doc" Return moving-max generator. \
+The generator keeps a running window of the last SIZE inputs, \
+returning the maxamp in that window."
+ save-stack { s }
+ size make-delay { gen }
+ s restore-stack
+ gen 0.0 set-mus-scaler drop
+ gen
;
+
: moving-max ( gen y -- scl )
- doc" Returns the maxamp in a moving window over the last few inputs."
- { gen y }
- y fabs { absy }
- gen absy 0.0 delay { mx }
- absy gen mus-scaler f>= if
- gen absy set-mus-scaler
- else
- mx gen mus-scaler f>= if
- gen gen mus-data vct-peak set-mus-scaler
- else
- gen mus-scaler
- then
- then
+ doc" Return the maxamp in a moving window over the last few inputs."
+ { gen y }
+ y fabs { absy }
+ gen absy 0.0 delay { mx }
+ absy gen mus-scaler f>= if
+ gen absy set-mus-scaler
+ else
+ mx gen mus-scaler f>= if
+ gen gen mus-data vct-peak set-mus-scaler
+ else
+ gen mus-scaler
+ then
+ then
;
\ ;;; ----------------
@@ -2021,16 +2334,18 @@ The generator keeps a running window of the last SIZE inputs, returning the maxa
\ ;;; moving-sum generator (the sum norm or 1-norm)
: make-moving-sum <{ :optional size 128 -- gen }>
- doc" Returns a moving-sum generator. \
+ doc" Return moving-sum generator. \
The generator keeps a running window of the last SIZE inputs, \
returning the sum of the absolute values of the samples in that window."
- size make-moving-average { gen }
- gen 1.0 set-mus-increment drop
- gen
+ size make-moving-average { gen }
+ gen 1.0 set-mus-increment drop
+ gen
;
+
: moving-sum ( gen y -- val )
- doc" Returns the sum of the absolute values in a moving window over the last few inputs."
- ( gen y ) fabs moving-average
+ doc" Return the sum of the absolute values in a moving window over the \
+last few inputs."
+ ( gen y ) fabs moving-average
;
\ ;;; ----------------
@@ -2038,14 +2353,15 @@ returning the sum of the absolute values of the samples in that window."
\ ;;; moving-rms generator
: make-moving-rms <{ :optional size 128 -- gen }>
- doc" Returns a moving-rms generator. \
+ doc" Return moving-rms generator. \
The generator keeps a running window of the last SIZE inputs, \
returning the rms of the samples in that window."
- size make-moving-average
+ size make-moving-average
;
+
: moving-rms ( gen y -- val )
- doc" Returns the rms of the values in a window over the last few inputs."
- ( gen y ) dup f* moving-average fsqrt
+ doc" Return the rms of the values in a window over the last few inputs."
+ ( gen y ) dup f* moving-average fsqrt
;
\ ;;; ----------------
@@ -2053,16 +2369,18 @@ returning the rms of the samples in that window."
\ ;;; moving-length generator (euclidean norm or 2-norm)
: make-moving-length <{ :optional size 128 -- gen }>
- doc" Returns a moving-length generator. \
+ doc" Return moving-length generator. \
The generator keeps a running window of the last SIZE inputs, \
returning the euclidean length of the vector in that window."
- size make-moving-average { gen }
- gen 1.0 set-mus-increment drop
- gen
+ size make-moving-average { gen }
+ gen 1.0 set-mus-increment drop
+ gen
;
+
: moving-length ( gen y -- val )
- doc" Returns the length of the values in a window over the last few inputs."
- ( gen y ) dup f* moving-average fsqrt
+ doc" Return the length of the values in a \
+window over the last few inputs."
+ ( gen y ) dup f* moving-average fsqrt
;
\ ;;; ----------------
@@ -2074,117 +2392,134 @@ returning the euclidean length of the vector in that window."
<'> make-moving-average alias make-smoothing-filter
: smoothing-filter ( gen sig -- r )
- { gen sig }
- gen sig moving-average { val }
- gen tap { old-sig }
- gen mus-order { n }
- n n 1- f/
- val gen mus-increment 0.5 f* sig old-sig f+ f* f- f*
+ { gen sig }
+ gen sig moving-average { val }
+ gen tap { old-sig }
+ gen mus-order { n }
+ n n 1- f/
+ val gen mus-increment 0.5 f* sig old-sig f+ f* f- f*
;
\ ;;; exponential weights
: make-exponentially-weighted-moving-average ( order -- r )
- { order }
- order 1/f
- order fnegate 1.0 order f+ f/ make-one-pole
+ { order }
+ order 1/f
+ order fnegate 1.0 order f+ f/ make-one-pole
;
<'> one-pole alias exponentially-weighted-moving-average
\ ;;; arithmetic (1/n) weights
: make-weighted-moving-average ( order -- r )
- { order }
- order make-moving-average { gen }
- gen 1.0 set-mus-increment drop
- #( gen 0.0 0.0 )
+ { order }
+ order make-moving-average { gen }
+ gen 1.0 set-mus-increment drop
+ #( gen 0.0 0.0 )
;
: weighted-moving-average ( gen sig -- r )
- { gen-ary sig }
- gen-ary 0 array-ref { gen }
- gen-ary 1 array-ref { num }
- gen-ary 2 array-ref { sum }
- gen mus-order { n }
- n 1+ n * 2/ { den }
- n sig f* num f+ sum f- to num
- gen sig moving-average to sum
- gen-ary num 1 array-set!
- gen-ary sum 2 array-set!
- num den f/
+ { gen-ary sig }
+ gen-ary 0 array-ref { gen }
+ gen-ary 1 array-ref { num }
+ gen-ary 2 array-ref { sum }
+ gen mus-order { n }
+ n 1+ n * 2/ { den }
+ n sig f* num f+ sum f- to num
+ gen sig moving-average to sum
+ gen-ary num 1 array-set!
+ gen-ary sum 2 array-set!
+ num den f/
;
\ ;;; ----------------
\ ;;;
-\ ;;; harmonicizer (each harmonic is split into a set of harmonics via Chebyshev polynomials)
-\ ;;; obviously very similar to ssb-bank above, but splits harmonics individually,
-\ ;;; rather than pitch-shifting them
+\ ;;; harmonicizer (each harmonic is split into a set of harmonics
+\ ;;; via Chebyshev polynomials) obviously very similar to ssb-bank
+\ ;;; above, but splits harmonics individually, rather than
+\ ;;; pitch-shifting them
hide
: harm-mc-cb { bands avgs peaks pcoeffs flt new-mx -- prc; y self -- val }
- 1 proc-create 40 ( ctr ) , bands , avgs , peaks , pcoeffs , flt , new-mx , ( prc )
- does> { y self -- val }
- self @ { ctr }
- self cell+ @ { bands }
- self 2 cells + @ { avgs }
- self 3 cells + @ { peaks }
- self 4 cells + @ { pcoeffs }
- self 5 cells + @ { flt }
- self 6 cells + @ { new-mx }
- 0.0 ( sum )
- bands each { bd }
- bd y bandpass { sig }
- peaks i array-ref sig moving-max { mx }
- avgs i array-ref mx f0> if 100.0 mx 1/f fmin else 0.0 then moving-average { amp }
- amp f0> if pcoeffs amp sig f* polynomial mx f* f+ ( sum += ... ) then
- end-each
- flt swap ( sum ) filter { val }
- val fabs new-mx fmax self 6 cells + ! ( to new-mx )
- ctr 0= if
- val
- else
- -1 self +! ( ctr-- )
- 0.0
- then
-;
-: harm-aoe-cb { bands avgs peaks pcoeffs flt old-mx beg dur snd chn edpos -- prc; self -- val }
- 0 proc-create
- 0.0 ( new-mx ) ,
- bands , avgs , peaks , pcoeffs , flt , old-mx ,
- beg , dur , snd , chn , edpos ,
- ( prc )
- does> { self -- val }
- self @ { new-mx }
- self cell+ @ { bands }
- self 2 cells + @ { avgs }
- self 3 cells + @ { peaks }
- self 4 cells + @ { pcoeffs }
- self 5 cells + @ { flt }
- self 6 cells + @ { old-mx }
- self 7 cells + @ { beg }
- self 8 cells + @ { dur }
- self 9 cells + @ { snd }
- self 10 cells + @ { chn }
- self 11 cells + @ { edpos }
- bands avgs peaks pcoeffs flt new-mx harm-mc-cb beg dur snd chn edpos map-channel ( retval )
- new-mx f0> if
- old-mx new-mx f/ beg dur snd chn #f scale-channel drop
- then
+ 1 proc-create ( prc )
+ 40 ( ctr ) , bands , avgs , peaks , pcoeffs , flt , new-mx ,
+ does> { y self -- val }
+ self @ { ctr }
+ self cell+ @ { bands }
+ self 2 cells + @ { avgs }
+ self 3 cells + @ { peaks }
+ self 4 cells + @ { pcoeffs }
+ self 5 cells + @ { flt }
+ self 6 cells + @ { new-mx }
+ 0.0 ( sum )
+ bands each { bd }
+ bd y bandpass { sig }
+ peaks i array-ref sig moving-max { mx }
+ avgs i array-ref mx f0> if
+ 100.0 mx 1/f fmin
+ else
+ 0.0
+ then moving-average { amp }
+ amp f0> if
+ pcoeffs amp sig f* polynomial mx f* f+ ( sum += ... )
+ then
+ end-each
+ flt swap ( sum ) filter { val }
+ val fabs new-mx fmax self 6 cells + ! ( to new-mx )
+ ctr 0= if
+ val
+ else
+ -1 self +! ( ctr-- )
+ 0.0
+ then
+;
+
+: harm-aoe-cb ( bands avgs peaks pcoeffs flt old-mx beg dur snd chn edpos -- prc; self -- val )
+ { bands avgs peaks pcoeffs flt old-mx beg dur snd chn edpos }
+ 0 proc-create ( prc )
+ 0.0 ( new-mx ) ,
+ bands , avgs , peaks , pcoeffs , flt , old-mx ,
+ beg , dur , snd , chn , edpos ,
+ does> { self -- val }
+ self @ { new-mx }
+ self cell+ @ { bands }
+ self 2 cells + @ { avgs }
+ self 3 cells + @ { peaks }
+ self 4 cells + @ { pcoeffs }
+ self 5 cells + @ { flt }
+ self 6 cells + @ { old-mx }
+ self 7 cells + @ { beg }
+ self 8 cells + @ { dur }
+ self 9 cells + @ { snd }
+ self 10 cells + @ { chn }
+ self 11 cells + @ { edpos }
+ bands avgs peaks pcoeffs flt new-mx harm-mc-cb
+ beg dur snd chn edpos map-channel { retval }
+ new-mx f0> if
+ old-mx new-mx f/ beg dur snd chn #f scale-channel drop
+ then
+ { retval }
;
set-current
-: harmonicizer <{ freq coeffs pairs
- :optional order 40 bw 50.0 beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Splits out each harmonic and replaces it with the spectrum given in coeffs."
- pairs make-array map!
- i 1.0 f+ { idx }
- idx freq f/ { aff }
- idx pairs f2* f/ 1.0 f+ bw f* { bwf }
- aff bwf f- hz->2pi aff bwf f+ hz->2pi order make-bandpass
- end-map { bands }
- pairs make-array map! 128 make-moving-average end-map { avgs }
- pairs make-array map! 128 make-moving-max end-map { peaks }
- coeffs mus-chebyshev-first-kind partials->polynomial { pcoeffs }
- 2 vct( 1 -1 ) vct( 0 -0.9 ) make-filter { flt }
- snd chn #f maxamp { old-mx }
- bands avgs peaks pcoeffs flt old-mx beg dur snd chn edpos harm-aoe-cb get-func-name as-one-edit
+
+: harmonicizer <{ freq coeffs pairs :optional order 40 bw 50.0 beg 0 dur #f snd #f chn #f edpos #f -- val }>
+ doc" Split out each harmonic and replaces it \
+with the spectrum given in coeffs."
+ pairs make-array map!
+ i 1.0 f+ { idx }
+ idx freq f/ { aff }
+ idx pairs f2* f/ 1.0 f+ bw f* { bwf }
+ aff bwf f- hz->2pi aff bwf f+ hz->2pi order make-bandpass
+ end-map { bands }
+ pairs make-array map!
+ 128 make-moving-average
+ end-map { avgs }
+ pairs make-array map!
+ 128 make-moving-max
+ end-map { peaks }
+ coeffs mus-chebyshev-first-kind partials->polynomial { pcoeffs }
+ 2 vct( 1 -1 ) vct( 0 -0.9 ) make-filter { flt }
+ snd chn #f maxamp { old-mx }
+ bands avgs peaks pcoeffs flt old-mx
+ beg dur snd chn edpos harm-aoe-cb get-func-name as-one-edit
;
previous
@@ -2194,429 +2529,520 @@ previous
hide
: lsc-ws-cb { rd sr -- prc; self -- f }
- 0 proc-create rd next-sample , rd next-sample , 0.0 , rd , sr , ( prc )
- does> { self -- f }
- self @ { last }
- self cell+ @ { next }
- self 2 cells + @ { intrp }
- self 3 cells + @ { rd }
- self 4 cells + @ { sr }
- 0 { samp }
- begin
- intrp { pos }
- pos 1.0 f>= if
- pos fround->s { num }
- num 0 ?do
- next to last
- rd next-sample to next
- loop
- pos num f- to pos
- then
- pos sr f+ to intrp
- samp next last f- pos f* last f+ 0 *output* out-any drop
- samp 1+ to samp
- rd sampler-at-end?
- until
- #f
+ 0 proc-create ( prc )
+ rd next-sample , rd next-sample , 0.0 , rd , sr ,
+ does> { self -- f }
+ self @ { last }
+ self cell+ @ { next }
+ self 2 cells + @ { intrp }
+ self 3 cells + @ { rd }
+ self 4 cells + @ { sr }
+ 0 { samp }
+ begin
+ intrp { pos }
+ pos 1.0 f>= if
+ pos fround->s { num }
+ num 0 ?do
+ next to last
+ rd next-sample to next
+ loop
+ pos num f- to pos
+ then
+ pos sr f+ to intrp
+ samp next last f- pos f* last f+ 0 *output* out-any drop
+ samp 1+ to samp
+ rd sampler-at-end?
+ until
+ #f
;
set-current
+
: linear-src-channel <{ sr :optional snd #f chn #f -- file }>
- doc" Performs sampling rate conversion using linear interpolation."
- 0 snd chn 1 #f make-sampler { rd }
- rd sr lsc-ws-cb :output snd-tempnam :srate snd srate with-sound { tempfile }
- tempfile mus-sound-frames { len }
- 0 len 1- tempfile snd chn #t ( trunc ) get-func-name 0 #f ( edpos ) #t ( autodel ) set-samples
+ doc" Perform sampling rate conversion using linear interpolation."
+ 0 snd chn 1 #f make-sampler { rd }
+ rd sr lsc-ws-cb :output snd-tempnam
+ :srate snd srate with-sound :output ws-ref { tempfile }
+ tempfile mus-sound-framples { len }
+ 0 len 1- tempfile snd chn #t ( trunc ) get-func-name 0
+ #f ( edpos ) #t ( autodel ) set-samples
;
previous
-\ ;;; Mathews/Smith High-Q filter as described in http://ccrma.stanford.edu/~jos/smac03maxjos/
-
-: make-mfilter <{ :key decay 0.99 frequency 1000.0 -- gen }>
- #{ :decay decay
- :frequency frequency
- :eps frequency pi f* mus-srate f/ fsin f2*
- :xn 0.0
- :yn 0.0 }
-;
-: mfilter <{ m :optional x-input 0.0 y-input 0.0 -- val }>
- m :xn hash-ref
- m :eps hash-ref
- m :yn hash-ref f* f-
- m :decay hash-ref f*
- x-input f+ { xn1 }
- m :eps hash-ref xn1 f*
- m :yn hash-ref f+
- m :decay hash-ref f*
- y-input f+ { yn1 }
- m :xn xn1 hash-set!
- ( m ) :yn yn1 hash-set! drop
- yn1
-;
-0 [if]
-: m-ws-cb ( file -- prc; self -- )
- { file }
- file find-file to file
- file false? if 'no-such-file #( get-func-name file ) fth-throw then
- 0 file 0 1 #f make-sampler { rd }
- make-mfilter { m }
- 0 proc-create rd , m , ( prc )
- does> { self -- }
- self @ { rd }
- self cell+ @ { m }
- 10000 0 do i m rd next-sample 0.1 f* 0.0 mfilter *output* outa drop loop
-;
-"now.snd" m-ws-cb with-sound
-[then]
-
\ ;;; -------- spectrum displayed in various frequency scales
-'snd-nogui provided? [unless]
- hide
- 0 value bark-fft-size
- 0 value bark-tick-function
-
- : bark ( r1 -- r2 )
- { f }
- f 7500.0 f/ { f2 }
- f2 f2 f* fatan 3.5 f* 0.00076 f f* fatan 13.5 f* f+
- ;
- : mel ( r1 -- r2 )
- { f }
- f 700.0 f/ 1.0 f+ flog 1127.0 f*
- ;
- : erb ( r1 -- r2 )
- { f }
- f 312.0 f+ f 14675.0 f+ f/ flog 11.17 f* 43.0 f+
- ;
- : display-bark-fft-cb <{ snd chn -- f }>
- snd chn left-sample { ls }
- snd chn right-sample { rs }
- 2.0 rs ls - 1+ flog 2.0 flog f/ fceil f** fround->s { fftlen }
- fftlen 0> if
- ls fftlen snd chn #f channel->vct { data }
- snd chn transform-normalization dont-normalize <> { normalized }
- #t { linear }
- data vct? if
- data
- snd chn fft-window fftlen linear
- snd chn fft-window-beta #f normalized snd-spectrum { fft }
- fft vct? if
- snd srate { sr }
- fft vct-peak { mx }
- fft length { data-len }
- \ bark settings
- 20.0 bark floor { bark-low }
- sr f2/ bark fceil { bark-high }
- data-len bark-high bark-low f- f/ { bark-frqscl }
- data-len 0.0 make-vct { bark-data }
- \ mel settings
- 20.0 mel floor { mel-low }
- sr f2/ bark fceil { mel-high }
- data-len mel-high mel-low f- f/ { mel-frqscl }
- data-len 0.0 make-vct { mel-data }
- \ erb settings
- 20.0 erb floor { erb-low }
- sr f2/ bark fceil { erb-high }
- data-len erb-high erb-low f- f/ { erb-frqscl }
- data-len 0.0 make-vct { erb-data }
- fftlen to bark-fft-size
- fft each { val }
- i fftlen f/ sr f* { frq }
- frq bark bark-low f- bark-frqscl f* fround->s { bark-bin }
- frq mel mel-low f- mel-frqscl f* fround->s { mel-bin }
- frq erb erb-low f- erb-frqscl f* fround->s { erb-bin }
- bark-bin 0>=
- bark-bin data-len < && if bark-data bark-bin val object-set+! then
- mel-bin 0>=
- mel-bin data-len < && if mel-data mel-bin val object-set+! then
- erb-bin 0>=
- erb-bin data-len < && if erb-data erb-bin val object-set+! then
- end-each
- normalized if
- bark-data vct-peak { bmx }
- mel-data vct-peak { mmx }
- erb-data vct-peak { emx }
- mx bmx f- fabs 0.01 f> if bark-data mx bmx f/ vct-scale! drop then
- mx mmx f- fabs 0.01 f> if mel-data mx mmx f/ vct-scale! drop then
- mx emx f- fabs 0.01 f> if erb-data mx emx f/ vct-scale! drop then
- then
- #( bark-data mel-data erb-data )
- "ignored"
- 20.0 sr f2/
- 0.0 normalized if 1.0 else data-len snd chn y-zoom-slider * then
- snd chn
- #f show-bare-x-axis graph drop
- then
- then
- then
- #f
- ;
- : scale-pos { axis-x0 axis-x1 sr2 f scale -- n }
- 20.0 scale execute { b20 }
- axis-x1 axis-x0 f- f scale execute b20 f- f*
- sr2 scale execute b20 f- f/ axis-x0 f+ fround->s
- ;
- : draw-bark-ticks { axis-x0 axis-x1 axis-y0 major-y0 minor-y0 tick-y0 sr2 bark-function snd chn }
- 2 snd-font ?dup-if snd chn copy-context set-current-font drop then
- axis-x0 tick-y0 axis-x0 major-y0 snd chn copy-context draw-line drop
- axis-x0 axis-x1 sr2 1000.0 bark-function scale-pos { i1000 }
- axis-x0 axis-x1 sr2 10000.0 bark-function scale-pos { i10000 }
- i1000 tick-y0 i1000 major-y0 snd chn copy-context draw-line drop
- i10000 tick-y0 i10000 major-y0 snd chn copy-context draw-line drop
- "20" axis-x0 major-y0 snd chn copy-context draw-string drop
- "1000" i1000 12 - major-y0 snd chn copy-context draw-string drop
- "10000" i10000 24 - major-y0 snd chn copy-context draw-string drop
- $" fft size: %d" #( bark-fft-size ) string-format
- axis-x0 10 + axis-y0 snd chn copy-context draw-string drop
- 1000 100 do
- axis-x0 axis-x1 sr2 i bark-function scale-pos { i100 }
- i100 tick-y0 i100 minor-y0 snd chn copy-context draw-line drop
- 100 +loop
- 10000 2000 do
- axis-x0 axis-x1 sr2 i bark-function scale-pos { i1000 }
- i1000 tick-y0 i1000 minor-y0 snd chn copy-context draw-line drop
- 1000 +loop
- ;
- : make-bark-labels <{ snd chn -- f }>
- snd chn copy-context foreground-color { old-foreground-color }
- snd chn lisp-graph axis-info { axinfo }
- axinfo 10 array-ref { axis-x0 }
- axinfo 12 array-ref { axis-x1 }
- axinfo 13 array-ref { axis-y0 }
- axinfo 11 array-ref { axis-y1 }
- 15 { label-height }
- 8 { char-width }
- snd srate 2/ { sr2 }
- 6 { minor-tick-len }
- 12 { major-tick-len }
- axis-y1 { tick-y0 }
- axis-y1 minor-tick-len + { minor-y0 }
- axis-y1 major-tick-len + { major-y0 }
- 3 snd-font { bark-label-font }
- axis-x1 axis-x0 f- 0.45 f* axis-x0 f+ fround->s { label-pos }
-
- \ bark label/ticks
- bark-tick-function 0= if
- axis-x0 axis-x1 axis-y0 major-y0 minor-y0 tick-y0 sr2 <'> bark snd chn draw-bark-ticks
- then
- bark-label-font ?dup-if snd chn copy-context set-current-font drop then
- "bark," label-pos axis-y1 label-height + snd chn copy-context draw-string drop
-
- \ mel label/ticks
- 2 snd-color snd chn copy-context set-foreground-color drop
- bark-tick-function 1 = if
- axis-x0 axis-x1 axis-y0 major-y0 minor-y0 tick-y0 sr2 <'> mel snd chn draw-bark-ticks
- then
- bark-label-font ?dup-if snd chn copy-context set-current-font drop then
- "mel," label-pos char-width 6 * + axis-y1 label-height + snd chn copy-context draw-string drop
-
- \ erb label/ticks
- 4 snd-color snd chn copy-context set-foreground-color drop
- bark-tick-function 2 = if
- axis-x0 axis-x1 axis-y0 major-y0 minor-y0 tick-y0 sr2 <'> erb snd chn draw-bark-ticks
- then
- bark-label-font ?dup-if snd chn copy-context set-current-font drop then
- "erb" label-pos char-width 11 * + axis-y1 label-height + snd chn copy-context draw-string drop
-
- old-foreground-color snd chn copy-context set-foreground-color
- ;
- : choose-bark-ticks <{ snd chn button state x y axis -- f }>
- axis lisp-graph = if
- bark-tick-function 1+ to bark-tick-function
- bark-tick-function 2 > if 0 to bark-tick-function then
- snd chn update-lisp-graph
- else
- #f
- then
- ;
- set-current
- : display-bark-fft <{ :optional off #f -- }>
- off unless
- lisp-graph-hook <'> display-bark-fft-cb add-hook!
- after-lisp-graph-hook <'> make-bark-labels add-hook!
- mouse-click-hook <'> choose-bark-ticks add-hook!
- sounds each { snd }
- snd channels 0 ?do snd i update-lisp-graph drop loop
- end-each
- else
- lisp-graph-hook <'> display-bark-fft-cb remove-hook!
- after-lisp-graph-hook <'> make-bark-labels remove-hook!
- mouse-click-hook <'> choose-bark-ticks remove-hook!
- sounds each { snd }
- snd channels 0 ?do #f snd i set-lisp-graph? drop loop
- end-each
- then
- ;
- previous
- : undisplay-bark-fft ( -- ) #t display-bark-fft ;
+'snd-nogui provided? not [if]
+ hide
+ 0 value bark-fft-size
+ 0 value bark-tick-function
+
+ : bark ( r1 -- r2 )
+ { f }
+ f 7500.0 f/ { f2 }
+ f2 f2 f* fatan 3.5 f* 0.00076 f f* fatan 13.5 f* f+
+ ;
+
+ : mel ( r1 -- r2 )
+ { f }
+ f 700.0 f/ 1.0 f+ flog 1127.0 f*
+ ;
+
+ : erb ( r1 -- r2 )
+ { f }
+ f 312.0 f+ f 14675.0 f+ f/ flog 11.17 f* 43.0 f+
+ ;
+
+ : display-bark-fft-cb <{ snd chn -- f }>
+ snd chn left-sample { ls }
+ snd chn right-sample { rs }
+ 2.0 rs ls - 1+ flog 2.0 flog f/ fceil f** fround->s { fftlen }
+ fftlen 0<= if
+ #f
+ exit
+ then
+ ls fftlen snd chn #f channel->vct { data }
+ snd chn transform-normalization
+ dont-normalize <> { normalized }
+ #t { linear }
+ data vct? unless
+ #f
+ exit
+ then
+ data snd chn fft-window fftlen linear
+ snd chn fft-window-beta #f normalized snd-spectrum { fft }
+ fft vct? unless
+ #f
+ exit
+ then
+ snd srate { sr }
+ fft vct-peak { mx }
+ fft length { data-len }
+ \ bark settings
+ 20.0 bark floor { bark-low }
+ sr f2/ bark fceil { bark-high }
+ data-len bark-high bark-low f- f/ { bark-frqscl }
+ data-len 0.0 make-vct { bark-data }
+ \ mel settings
+ 20.0 mel floor { mel-low }
+ sr f2/ bark fceil { mel-high }
+ data-len mel-high mel-low f- f/ { mel-frqscl }
+ data-len 0.0 make-vct { mel-data }
+ \ erb settings
+ 20.0 erb floor { erb-low }
+ sr f2/ bark fceil { erb-high }
+ data-len erb-high erb-low f- f/ { erb-frqscl }
+ data-len 0.0 make-vct { erb-data }
+ fftlen to bark-fft-size
+ fft each { val }
+ i fftlen f/ sr f* { frq }
+ frq bark bark-low f- bark-frqscl f* fround->s { b-bin }
+ frq mel mel-low f- mel-frqscl f* fround->s { mel-bin }
+ frq erb erb-low f- erb-frqscl f* fround->s { erb-bin }
+ b-bin 0>=
+ b-bin data-len < && if
+ bark-data b-bin val object-set+!
+ then
+ mel-bin 0>=
+ mel-bin data-len < && if
+ mel-data mel-bin val object-set+!
+ then
+ erb-bin 0>=
+ erb-bin data-len < && if
+ erb-data erb-bin val object-set+!
+ then
+ end-each
+ normalized if
+ bark-data vct-peak { bmx }
+ mel-data vct-peak { mmx }
+ erb-data vct-peak { emx }
+ mx bmx f- fabs 0.01 f> if
+ bark-data mx bmx f/ vct-scale! drop
+ then
+ mx mmx f- fabs 0.01 f> if
+ mel-data mx mmx f/ vct-scale! drop
+ then
+ mx emx f- fabs 0.01 f> if
+ erb-data mx emx f/ vct-scale! drop
+ then
+ then
+ #( bark-data mel-data erb-data ) "ignored" 20.0 sr f2/ 0.0
+ normalized if
+ 1.0
+ else
+ data-len snd chn y-zoom-slider *
+ then snd chn #f show-bare-x-axis graph drop
+ #f
+ ;
+
+ : scale-pos { axis-x0 axis-x1 sr2 f scale -- n }
+ 20.0 scale execute { b20 }
+ axis-x1 axis-x0 f- f scale execute b20 f- f*
+ sr2 scale execute b20 f- f/ axis-x0 f+ fround->s
+ ;
+
+ : draw-bark-ticks { axis-x0 axis-x1 axis-y0 major-y0 minor-y0 tick-y0 sr2 bark-function cro snd chn }
+ 2 snd-font ?dup-if
+ snd chn copy-context set-current-font drop
+ then
+ axis-x0 tick-y0 axis-x0 major-y0 snd chn
+ copy-context cro draw-line drop
+ axis-x0 axis-x1 sr2 1000.0 bark-function scale-pos { i1000 }
+ axis-x0 axis-x1 sr2 10000.0 bark-function scale-pos { i10000 }
+ i1000 tick-y0 i1000 major-y0 snd chn
+ copy-context cro draw-line drop
+ i10000 tick-y0 i10000 major-y0 snd chn
+ copy-context cro draw-line drop
+ "20" axis-x0 major-y0 snd chn
+ copy-context cro draw-string drop
+ "1000" i1000 12 - major-y0 snd chn
+ copy-context cro draw-string drop
+ "10000" i10000 24 - major-y0 snd chn
+ copy-context cro draw-string drop
+ "fft size: %d" #( bark-fft-size ) string-format
+ axis-x0 10 + axis-y0 snd chn
+ copy-context cro draw-string drop
+ 1000 100 do
+ axis-x0 axis-x1 sr2 i bark-function scale-pos { i100 }
+ i100 tick-y0 i100 minor-y0 snd chn
+ copy-context cro draw-line drop
+ 100 +loop
+ 10000 2000 do
+ axis-x0 axis-x1 sr2 i bark-function scale-pos { i1000 }
+ i1000 tick-y0 i1000 minor-y0 snd chn
+ copy-context cro draw-line drop
+ 1000 +loop
+ ;
+
+ : make-bark-labels <{ snd chn -- f }>
+ snd chn copy-context foreground-color { old-foreground-color }
+ snd chn lisp-graph axis-info { axinfo }
+ axinfo 10 array-ref { axis-x0 }
+ axinfo 12 array-ref { axis-x1 }
+ axinfo 13 array-ref { axis-y0 }
+ axinfo 11 array-ref { axis-y1 }
+ 15 { label-height }
+ 8 { char-width }
+ snd srate 2/ { sr2 }
+ 6 { minor-tick-len }
+ 12 { major-tick-len }
+ axis-y1 { tick-y0 }
+ axis-y1 minor-tick-len + { minor-y0 }
+ axis-y1 major-tick-len + { major-y0 }
+ 3 snd-font { bark-label-font }
+ axis-x1 axis-x0 f- 0.45 f* axis-x0 f+ fround->s { label-pos }
+ snd chn channel-widgets car make-cairo { cro }
+ \ bark label/ticks
+ bark-tick-function 0= if
+ axis-x0 axis-x1 axis-y0 major-y0 minor-y0
+ tick-y0 sr2 <'> bark cro snd chn draw-bark-ticks
+ then
+ bark-label-font ?dup-if
+ snd chn copy-context set-current-font drop
+ then
+ "bark," label-pos axis-y1 label-height + snd chn
+ copy-context cro draw-string drop
+ \ mel label/ticks
+ 2 snd-color snd chn copy-context set-foreground-color drop
+ bark-tick-function 1 = if
+ axis-x0 axis-x1 axis-y0 major-y0 minor-y0
+ tick-y0 sr2 <'> mel cro snd chn draw-bark-ticks
+ then
+ bark-label-font ?dup-if
+ snd chn copy-context set-current-font drop
+ then
+ "mel," label-pos char-width 6 * + axis-y1 label-height +
+ snd chn copy-context cro draw-string drop
+ \ erb label/ticks
+ 4 snd-color snd chn copy-context set-foreground-color drop
+ bark-tick-function 2 = if
+ axis-x0 axis-x1 axis-y0 major-y0 minor-y0
+ tick-y0 sr2 <'> erb cro snd chn draw-bark-ticks
+ then
+ bark-label-font ?dup-if
+ snd chn copy-context set-current-font drop
+ then
+ "erb" label-pos char-width 11 * + axis-y1 label-height +
+ snd chn copy-context cro draw-string drop
+ old-foreground-color snd chn copy-context set-foreground-color
+ cro free-cairo drop
+ ;
+
+ : choose-bark-ticks <{ snd chn button state x y axis -- f }>
+ axis lisp-graph = if
+ bark-tick-function 1+ to bark-tick-function
+ bark-tick-function 2 > if
+ 0 to bark-tick-function
+ then
+ snd chn update-lisp-graph
+ else
+ #f
+ then
+ ;
+ set-current
+
+ : display-bark-fft <{ :optional off #f -- }>
+ off unless
+ lisp-graph-hook <'> display-bark-fft-cb add-hook!
+ after-lisp-graph-hook <'> make-bark-labels add-hook!
+ mouse-click-hook <'> choose-bark-ticks add-hook!
+ sounds each { snd }
+ snd channels 0 ?do
+ snd i ( chn ) update-lisp-graph drop
+ loop
+ end-each
+ else
+ lisp-graph-hook <'> display-bark-fft-cb remove-hook!
+ after-lisp-graph-hook <'> make-bark-labels remove-hook!
+ mouse-click-hook <'> choose-bark-ticks remove-hook!
+ sounds each { snd }
+ snd channels 0 ?do
+ #f snd i ( chn ) set-lisp-graph? drop
+ loop
+ end-each
+ then
+ ;
+ previous
+
+ : undisplay-bark-fft ( -- )
+ #t display-bark-fft
+ ;
[then]
\ ;;; -------- lpc-coeffs, lpc-predict
: lpc-coeffs ( data n m -- val )
- doc" Returns M LPC coeffients (in a vector) given N data points in the vct DATA."
- { data n m }
- m :initial-element 0.0 make-array { d }
- n :initial-element 0.0 make-array { wk1 }
- n :initial-element 0.0 make-array { wk2 }
- n :initial-element 0.0 make-array { wkm }
- wk1 0 data 0 vct-ref array-set!
- wk2 n 2- data n 1- vct-ref array-set!
- n 1- 1 ?do
- wk1 i data i vct-ref array-set!
- wk2 i 1- data i vct-ref array-set!
- loop
- m 0 ?do
- 0.0 0.0 { num denom }
- n i - 1- 0 ?do
- wk1 i array-ref wk2 i array-ref f* num f+ to num
- wk1 i array-ref wk2 i array-ref f* dup f* denom f+ to denom
- loop
- denom f0<> if d i num f2* denom f/ array-set! then
- i 0 ?do d i wkm i array-ref d j array-ref wkm j i - 1- array-ref f* f- array-set! loop
- i m 1- < if
- i 1+ 0 ?do wkm i d i array-ref array-set! loop
- n i - 2- 0 ?do
- wk1 i wk1 i array-ref wkm j array-ref wk2 i array-ref f* f- array-set!
- wk2 i wk2 i 1+ array-ref wkm j array-ref wk1 i 1+ array-ref f* f- array-set!
- loop
- then
- loop
- d
+ doc" Return M LPC coeffients (in a vector) given N data \
+points in the vct DATA."
+ { data n m }
+ m :initial-element 0.0 make-array { d }
+ n :initial-element 0.0 make-array { wk1 }
+ n :initial-element 0.0 make-array { wk2 }
+ n :initial-element 0.0 make-array { wkm }
+ wk1 0 data 0 vct-ref array-set!
+ wk2 n 2- data n 1- vct-ref array-set!
+ n 1- 1 ?do
+ wk1 i data i vct-ref array-set!
+ wk2 i 1- data i vct-ref array-set!
+ loop
+ m 0 ?do
+ 0.0 0.0 { num denom }
+ n i - 1- 0 ?do
+ wk1 i array-ref wk2 i array-ref f*
+ num f+ to num
+ wk1 i array-ref wk2 i array-ref f*
+ dup f* denom f+ to denom
+ loop
+ denom f0<> if
+ d i num f2* denom f/ array-set!
+ then
+ i 0 ?do
+ d i
+ wkm i array-ref
+ d j array-ref
+ wkm j i - 1- array-ref f* f-
+ array-set!
+ loop
+ i m 1- < if
+ i 1+ 0 ?do
+ wkm i d i array-ref array-set!
+ loop
+ n i - 2- 0 ?do
+ wk1 i
+ wk1 i array-ref
+ wkm j array-ref
+ wk2 i array-ref f* f-
+ array-set!
+ wk2 i
+ wk2 i 1+ array-ref
+ wkm j array-ref
+ wk1 i 1+ array-ref f* f-
+ array-set!
+ loop
+ then
+ loop
+ d
;
+
: lpc-predict <{ data n coeffs m nf :optional clipped #f -- val }>
- doc" Takes the output of lpc-coeffs (COEFFS, a vector) and the length thereof (M), \
-N data points of DATA (a vct), and produces NF new data points (in a vct) as its prediction. \
+ doc" Take the output of lpc-coeffs (COEFFS, a vector) and \
+the length thereof (M), N data points of DATA (a vct), \
+and produces NF new data points (in a vct) as its prediction. \
If CLIPPED is #t, the new data is assumed to be outside -1.0 to 1.0."
- n 1- { jj }
- m 0.0 make-vct map!
- data jj vct-ref
- jj 1- to jj
- end-map { reg }
- nf 0.0 make-vct map!
- 0.0 ( sum ) reg each ( val ) coeffs i array-ref f* f+ ( sum += ... ) end-each { sum }
- 0 m 1- do reg i reg i 1- vct-ref vct-set! drop -1 +loop
- clipped if
- sum f0> if
- sum 1.0 f< if 1.0 to sum then
- else
- sum -1.0 f> if -1.0 to sum then
- then
- then
- reg 0 sum vct-set! drop
- sum
- end-map ( future )
+ n 1- { jj }
+ m 0.0 make-vct map!
+ data jj vct-ref ( val )
+ jj 1- to jj
+ end-map { reg }
+ nf 0.0 make-vct map!
+ 0.0 ( sum )
+ reg each ( val )
+ coeffs i array-ref f* f+ ( sum += ... )
+ end-each { sum }
+ 0 m 1- do
+ reg i reg i 1- vct-ref vct-set! drop
+ -1 +loop
+ clipped if
+ sum f0> if
+ sum 1.0 f< if
+ 1.0 to sum
+ then
+ else
+ sum -1.0 f> if
+ -1.0 to sum
+ then
+ then
+ then
+ reg 0 sum vct-set! drop
+ sum
+ end-map ( future )
;
\ ;;; -------- unclip-channel
hide
: uncchn-sc-cb { clip-data unclipped-max -- prc; y self -- f }
- 1 proc-create
- clip-data , unclipped-max , 0 ( clip-beg ) , 0 ( samp ) , #f ( in-clip ) ,
- ( prc )
- does> { y self -- f }
- self @ { clip-data }
- self 1 cells + @ { unclipped-max }
- self 2 cells + @ { clip-beg }
- self 3 cells + @ { samp }
- self 4 cells + @ { in-clip }
- y fabs { absy }
- absy 0.9999 f> if
- in-clip unless
- #t to in-clip
- samp self 2 cells + ! ( to clip-beg )
- then
- else
- absy unclipped-max fmax self 2 cells + ! ( to unclipped-max )
- in-clip if
- #f self 4 cells + ! ( in-clip = #f )
- clip-data #( clip-beg samp 1- ) array-push to clip-data
- then
- then
- 1 self 3 cells + +! ( samp++ )
- #f
+ 1 proc-create ( prc )
+ clip-data , unclipped-max ,
+ 0 ( clip-beg ) , 0 ( samp ) , #f ( in-clip ) ,
+ does> { y self -- f }
+ self @ { clip-data }
+ self 1 cells + @ { unclipped-max }
+ self 2 cells + @ { clip-beg }
+ self 3 cells + @ { samp }
+ self 4 cells + @ { in-clip }
+ y fabs { absy }
+ absy 0.9999 f> if
+ in-clip unless
+ #t to in-clip
+ samp self 2 cells + ! ( to clip-beg )
+ then
+ else
+ absy unclipped-max fmax self 2 cells + ! ( to unclipped-max )
+ in-clip if
+ #f self 4 cells + ! ( in-clip = #f )
+ clip-data #( clip-beg samp 1- ) array-push to clip-data
+ then
+ then
+ 1 self 3 cells + +! ( samp++ )
+ #f
;
+
: uncchn-aoe-cb { clip-data max-len snd chn len -- prc; self -- val }
- 0 proc-create clip-data , max-len , snd , chn , ( prc )
- does> { self -- val }
- self @ { clip-data }
- self cell+ @ { max-len }
- self 2 cells + @ { snd }
- self 3 cells + @ { chn }
- self 4 cells + @ { len }
- 32 { min-data-len }
- clip-data each { lst }
- lst 0 array-ref { clip-beg }
- lst 1 array-ref { clip-end }
- clip-end clip-beg = 1+ { clip-len }
- min-data-len clip-len 4 * max { data-len }
- clip-len max-len > if clip-len to max-len then
- data-len { forward-data-len }
- data-len { backward-data-len }
- i 0= if 0 else clip-data i 1- array-ref 1 array-ref then { previous-end }
- i clip-data length 3 - < if clip-data i 1+ array-ref 0 array-ref else len then { next-beg }
- clip-beg data-len - previous-end < if clip-beg previous-end - 4 max to forward-data-len then
- clip-len data-len + next-beg > if next-beg clip-end - 4 max to backward-data-len then
- clip-len forward-data-len f2/ fround->s max { forward-predict-len }
- clip-len backward-data-len f2/ fround->s max { backward-predict-len }
- clip-beg forward-data-len - forward-data-len snd chn #f channel->vct { data }
- data forward-data-len
- data forward-data-len forward-predict-len lpc-coeffs
- forward-predict-len clip-len #f lpc-predict { future }
- clip-end 1+ backward-data-len snd chn #f channel->vct vct-reverse! { rdata }
- rdata backward-data-len
- rdata backward-data-len backward-predict-len lpc-coeffs
- backward-predict-len clip-len #f lpc-predict { past }
- clip-len 0.0 make-vct { new-data }
- clip-len 1 > if
- clip-len 1- { jj }
- clip-len 1- { clen }
- new-data map!
- i clen f/ pi f* fcos 1.0 f+ f2/ { sn }
- sn future i vct-ref f*
- 1.0 sn f- past jj vct-ref f* f+
- jj 1- to jj
- end-map
- else
- new-data 0
- future 0 vct-ref past 0 vct-ref future 0 vct-ref f0> if fmax else fmin then vct-set! drop
- then
- new-data clip-beg clip-len snd chn #f get-func-name vct->channel drop
- end-each
- #f
+ 0 proc-create ( prc )
+ clip-data , max-len , snd , chn ,
+ does> { self -- val }
+ self @ { clip-data }
+ self cell+ @ { max-len }
+ self 2 cells + @ { snd }
+ self 3 cells + @ { chn }
+ self 4 cells + @ { len }
+ 32 { min-data-len }
+ clip-data each { lst }
+ lst 0 array-ref { clip-beg }
+ lst 1 array-ref { clip-end }
+ clip-end clip-beg = 1+ { clip-len }
+ min-data-len clip-len 4 * max { data-len }
+ clip-len max-len > if
+ clip-len to max-len
+ then
+ data-len { forward-data-len }
+ data-len { backward-data-len }
+ i 0= if
+ 0
+ else
+ clip-data i 1- array-ref 1 array-ref
+ then { previous-end }
+ i clip-data length 3 - < if
+ clip-data i 1+ array-ref 0 array-ref
+ else
+ len
+ then { next-beg }
+ clip-beg data-len - previous-end < if
+ clip-beg previous-end - 4 max to forward-data-len
+ then
+ clip-len data-len + next-beg > if
+ next-beg clip-end - 4 max to backward-data-len
+ then
+ clip-len forward-data-len
+ f2/ fround->s max { forward-predict-len }
+ clip-len backward-data-len
+ f2/ fround->s max { backward-predict-len }
+ clip-beg forward-data-len - forward-data-len
+ snd chn #f channel->vct { data }
+ data forward-data-len data forward-data-len forward-predict-len
+ lpc-coeffs forward-predict-len
+ clip-len #f lpc-predict { future }
+ clip-end 1+ backward-data-len snd chn #f
+ channel->vct vct-reverse! { rdata }
+ rdata backward-data-len rdata backward-data-len
+ backward-predict-len lpc-coeffs backward-predict-len
+ clip-len #f lpc-predict { past }
+ clip-len 0.0 make-vct { new-data }
+ clip-len 1 > if
+ clip-len 1- { jj }
+ clip-len 1- { clen }
+ new-data map!
+ i clen f/ pi f* fcos 1.0 f+ f2/ { sn }
+ sn future i vct-ref f*
+ 1.0 sn f- past jj vct-ref f* f+
+ jj 1- to jj
+ end-map
+ else
+ new-data 0
+ future 0 vct-ref
+ past 0 vct-ref future 0 vct-ref f0> if
+ fmax
+ else
+ fmin
+ then vct-set! drop
+ then
+ new-data clip-beg clip-len snd chn #f
+ get-func-name vct->channel drop
+ end-each
+ #f
;
set-current
+
: unclip-channel <{ :optional snd #f chn #f -- assoc }>
- doc" Looks for clipped portions and tries to reconstruct the original using LPC."
- #() { clip-data } \ #( #( beg end ) #( ... ) ... )
- 0.0 { unclipped-max }
- snd chn #f frames { len }
- clip-data unclipped-max uncchn-sc-cb 0 len snd chn #f scan-channel drop
- clip-data length 0> if
- 0 { max-len }
- clip-data max-len snd chn len uncchn-aoe-cb get-func-name as-one-edit drop
- unclipped-max 0.95 f> if 0.999 to unclipped-max then
- unclipped-max snd chn #f maxamp f/ 0 len snd chn #f scale-channel drop
- #{ :max unclipped-max :clips clip-data length 2/ :max-len max-len }
- else
- #()
- then
+ doc" Look for clipped portions and try to \
+reconstruct the original using LPC."
+ #() { clip-data } \ #( #( beg end ) #( ... ) ... )
+ 0.0 { unclipped-max }
+ snd chn #f framples { len }
+ clip-data unclipped-max uncchn-sc-cb 0 len
+ snd chn #f scan-channel drop
+ clip-data length 0> if
+ 0 { max-len }
+ clip-data max-len snd chn len uncchn-aoe-cb
+ get-func-name as-one-edit drop
+ unclipped-max 0.95 f> if
+ 0.999 to unclipped-max
+ then
+ unclipped-max snd chn #f maxamp f/ 0 len
+ snd chn #f scale-channel drop
+ #a( :max unclipped-max
+ :clips clip-data length 2/
+ :max-len max-len )
+ else
+ #()
+ then
;
previous
+
: unclip-sound <{ :optional snd #f -- assoc }>
- doc" Applies unclip-channel to each channel of SND."
- snd snd-snd to snd
- snd sound? if
- snd channels make-array map! snd i unclip-channel end-map ( res )
- #() ( assoc )
- snd channels 0 ?do
- ( assoc ) snd i unclip-channel assoc
- loop
- ( assoc )
- else
- 'no-such-sound #( get-func-name snd ) fth-throw
- then
+ doc" Apply unclip-channel to each channel of SND."
+ snd snd-snd to snd
+ snd sound? if
+ snd channels make-array map!
+ snd i unclip-channel
+ end-map ( res )
+ #() ( assoc )
+ snd channels 0 ?do
+ ( assoc ) snd i unclip-channel assoc
+ loop
+ ( assoc )
+ else
+ 'no-such-sound #( "%s: %s" get-func-name snd ) fth-throw
+ then
;
\ dsp.fs ends here
diff --git a/dsp.rb b/dsp.rb
index eea430e..0127184 100644
--- a/dsp.rb
+++ b/dsp.rb
@@ -1,11 +1,9 @@
# dsp.rb -- dsp.scm --> dsp.rb
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Mon Mar 07 13:50:44 CET 2005
-# Changed: Sat Feb 19 17:17:10 CET 2011
+# Created: 05/03/07 13:50:44
+# Changed: 15/03/04 17:18:38
-# Commentary:
-#
# comments are taken mostly from dsp.scm
#
# module Dsp
@@ -98,7 +96,7 @@
# make_butter_bs(m, f1, f2)
# make_notch_frequency_response(cur_srate, freqs, notch_width)
-# notch_channel(freqs, filter_order, beg, dur, snd, chn, edpos, truncate, notch_width)
+# notch_channel(freqs, filter_order, beg, dur, snd, chn, edpos, trc, n_width)
# notch_sound(freqs, filter_order, snd, chn, notch_width)
# notch_selection(freqs, filter_order, snd, chn, notch_width)
# fractional_fourier_transform(fr, fi, n, v)
@@ -132,7 +130,7 @@
# shift_channel_pitch(freq, order, beg, dur, snd, chn, edpos)
# hz_to_2pi(freq)
# ssb_bank(old_freq, new_freq, pairs, order, bw, beg, dur, snd, chn, edpos)
-# ssb_bank_env(old_freq, new_freq, freq_env, pairs, order, bw, beg, dur, snd, chn, edpos)
+# ssb_bank_env(old_freq, new_freq, fq_env, pairs, ord, bw, beg, dur, s, c, ep)
#
# vct_polynomial(v, coeffs)
# channel_polynomial(coeffs, snd, chn)
@@ -149,16 +147,6 @@
#
# make_volterra_filter(acoeffs, bcoeffs)
# volterra_filter(flt, x)
-#
-# class Moving_max < Musgen
-# initialize(size)
-# inspect
-# to_s
-# run_func(val1, val2)
-# moving_max(y)
-#
-# make_moving_max(size)
-# moving_max(gen, y)
# make_moving_sum(size)
# moving_sum(gen, y)
# make_moving_rms(size)
@@ -185,8 +173,6 @@
# display_bark_fft(off)
# undisplay_bark_fft
-# Code:
-
require "ws"
require "env"
@@ -194,9 +180,12 @@ module Dsp
# src_duration (see src-channel in extsnd.html)
add_help(:src_duration,
"src_duration(envelope) \
-returns the new duration of a sound after using ENVELOPE for time-varying sampling-rate conversion.")
+Returns the new duration of a sound after using ENVELOPE for \
+time-varying sampling-rate conversion.")
def src_duration(e)
- e.map! do |x| x.to_f end
+ e.map! do |x|
+ x.to_f
+ end
ex0 = e.first
ex1 = e[-2]
all_x = ex1 - ex0
@@ -221,7 +210,8 @@ returns the new duration of a sound after using ENVELOPE for time-varying sampli
# see clm.c for C version (using either GSL's or GCC's complex trig functions)
add_help(:dolph,
"dolph(n, gamma) \
-produces a Dolph-Chebyshev FFT data window of N points using GAMMA as the window parameter.")
+Produces a Dolph-Chebyshev FFT data window of N points \
+using GAMMA as the window parameter.")
def dolph(n, gamma)
alpha = cosh(acosh(10.0 ** gamma) / n)
den = 1.0 / cosh(n * acosh(alpha))
@@ -253,7 +243,8 @@ produces a Dolph-Chebyshev FFT data window of N points using GAMMA as the window
# anything from Snd (fft, vcts etc)
add_help(:dolph_1,
"dolph_1(n, gamma) \
-produces a Dolph-Chebyshev FFT data window of N points using GAMMA as the window parameter.")
+Produces a Dolph-Chebyshev FFT data window of N points \
+using GAMMA as the window parameter.")
def dolph_1(n, gamma)
alpha = cosh(acosh(10.0 ** gamma) / n)
den = 1.0 / cosh(n * acosh(alpha))
@@ -278,7 +269,9 @@ produces a Dolph-Chebyshev FFT data window of N points using GAMMA as the window
pk = w[i]
end
end
- w.map! do |val| val / pk end
+ w.map! do |val|
+ val / pk
+ end
end if defined? acosh
# move sound down by n (a power of 2)
@@ -289,9 +282,9 @@ produces a Dolph-Chebyshev FFT data window of N points using GAMMA as the window
# general version
add_help(:down_oct,
"down_oct(n, snd=false, chn=false) \
-moves a sound down by power of 2 n")
+Moves a sound down by power of 2 N.")
def down_oct(n, snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
pow2 = (log(len) / log(2)).ceil
fftlen = (2 ** pow2).round
fftscale = 1.0 / fftlen
@@ -313,12 +306,13 @@ moves a sound down by power of 2 n")
j -= 1
end
fft(rl2, im2, -1)
- vct2channel(rl2, 0, n * len, snd, chn, false, format("%s(%s", get_func_name, n))
+ vct2channel(rl2, 0, n * len, snd, chn, false,
+ format("%s(%s", get_func_name, n))
end
add_help(:edot_product,
"edot_product(freq, data) \
-sum of (e^freq*i) * data[i]")
+Sum of (e^freq*i) * data[i]")
def edot_product(freq, data)
sum = 0.0
data.each_with_index do |val, i|
@@ -329,11 +323,12 @@ sum of (e^freq*i) * data[i]")
add_help(:stretch_sound_via_dft,
"stretch_sound_via_dft(factor, snd=false, chn=false) \
-makes the given channel longer (FACTOR should be > 1.0) by squeezing in the frequency domain, \
+Makes the given channel longer (FACTOR should be > 1.0) by \
+squeezing in the frequency domain, \
then using the inverse DFT to get the time domain result.")
def stretch_sound_via_dft(factor, snd = false, chn = false)
factor = factor.to_f
- n = frames(snd, chn)
+ n = framples(snd, chn)
n2 = (n / 2.0).floor
out_n = (n * factor).round
in_data = channel2vct(0, n, snd, chn)
@@ -341,17 +336,19 @@ then using the inverse DFT to get the time domain result.")
fr = make_array(out_n, 0.0)
freq = (PI * 2) / n
n.times do |i|
+ d = edot_product(freq * Complex(0.0, 1.0) * i, in_data)
if i < n2
- fr[i] = edot_product(freq * Complex(0.0, 1.0) * i, in_data)
+ fr[i] = d
else
- fr[i + (out_n - n - 1)] = edot_product(freq * Complex(0.0, 1.0) * i, in_data)
+ fr[i + (out_n - n - 1)] = d
end
end
freq = (PI * 2) / out_n
out_n.times do |i|
out_data[i] = (edot_product(freq * Complex(0.0, 1.0) * i, fr) / n).real
end
- vct2channel(out_data, 0, out_n, snd, chn, false, format("%s(%s", get_func_name, factor))
+ vct2channel(out_data, 0, out_n, snd, chn, false,
+ format("%s(%s", get_func_name, factor))
end
# compute-uniform-circular-string
@@ -379,7 +376,8 @@ then using the inverse DFT to get the time domain result.")
p3 = -1.0 / denom
size.times do |i|
x0[i] = p1 * x1[i] +
- p2 * (circle_vct_ref.call(x1, i - 1) + circle_vct_ref.call(x1, i + 1)) +
+ p2 * (circle_vct_ref.call(x1, i - 1) +
+ circle_vct_ref.call(x1, i + 1)) +
p3 * x2[i]
end
vct_fill!(x2, 0.0)
@@ -393,7 +391,9 @@ then using the inverse DFT to get the time domain result.")
x0 = make_vct(size)
x1 = make_vct(size)
x2 = make_vct(size)
- 12.times do |i| x1[i + size / 4 - 6] = sin((TWO_PI * i) / 12.0) end
+ 12.times do |i|
+ x1[i + size / 4 - 6] = sin((TWO_PI * i) / 12.0)
+ end
1024.times do |i|
compute_uniform_circular_string(size, x0, x1, x2, mass, xspring, damp)
graph(x0, "string", 0, 1.0, -10.0, 10.0)
@@ -405,7 +405,9 @@ then using the inverse DFT to get the time domain result.")
x0 = make_vct(size)
gx1 = make_vct(size)
gx2 = make_vct(size)
- 12.times do |i| gx1[i + size / 4 - 6] = sin((TWO_PI * i) / 12.0) end
+ 12.times do |i|
+ gx1[i + size / 4 - 6] = sin((TWO_PI * i) / 12.0)
+ end
gen1 = make_table_lookup(440.0, :wave, gx1)
gen2 = make_table_lookup(440.0, :wave, gx2)
x1 = gen1.data
@@ -429,7 +431,8 @@ then using the inverse DFT to get the time domain result.")
end
# this is the more general form
- def compute_string(size, x0, x1, x2, masses, xsprings, esprings, damps, haptics)
+ def compute_string(size, x0, x1, x2,
+ masses, xsprings, esprings, damps, haptics)
circle_vct_ref = lambda do |v, i|
if i < 0
v[i + size]
@@ -449,17 +452,21 @@ then using the inverse DFT to get the time domain result.")
p3 = -1.0 / denom
p4 = haptics / (masses[i] * denom)
x0[i] = p1 * x1[i] +
- p2 * (circle_vct_ref.call(x1, i - 1) + circle_vct_ref.call(x1, i + 1)) +
+ p2 * (circle_vct_ref.call(x1, i - 1) +
+ circle_vct_ref.call(x1, i + 1)) +
p3 * x2[i] +
p4
end
- size.times do |i| x2[i], x1[i] = x1[i], x0[i] end
+ size.times do |i|
+ x2[i], x1[i] = x1[i], x0[i]
+ end
end
# "frequency division" -- an effect from sed_sed at my-dejanews.com
add_help(:freqdiv,
"freqdiv(n, snd=false, chn=false) \
-repeats each nth sample n times (clobbering the intermediate samples): freqdiv(8)")
+Repeats each nth sample N times (clobbering the intermediate samples): \
+freqdiv(8)")
def freqdiv(n, snd = false, chn = false)
div = 0
curval = 0.0
@@ -468,16 +475,18 @@ repeats each nth sample n times (clobbering the intermediate samples): freqdiv(8
div += 1
div = 0 if div == n
curval
- end, 0, false, snd, chn, false, format("%s(%s", get_func_name, n))
+ end, 0, false, snd, chn, false,
+ format("%s(%s", get_func_name, n))
end
# "adaptive saturation" -- an effect from sed_sed at my-dejanews.com
#
# a more extreme effect is "saturation":
- # (map-channel (lambda (val) (if (< (abs val) .1) val (if (>= val 0.0) 0.25 -0.25))))
+ # (map-channel (lambda (val)
+ # (if (< (abs val) .1) val (if (>= val 0.0) 0.25 -0.25))))
add_help(:adsat,
"adsat(size, beg=false, dur=false, snd=false, chn=false) \
-is an 'adaptive saturation' sound effect")
+Is an 'adaptive saturation' sound effect.")
def adsat(size, beg = false, dur = false, snd = false, chn = false)
mn = 0.0
mx = 0.0
@@ -504,7 +513,7 @@ is an 'adaptive saturation' sound effect")
false
end
end, beg, dur, snd, chn, false,
- format("%s(%s, %s, %s", get_func_name, size, beg, dur))
+ format("%s(%s, %s, %s", get_func_name, size, beg, dur))
end
# spike
@@ -512,7 +521,7 @@ is an 'adaptive saturation' sound effect")
# makes sound more spikey -- sometimes a nice effect
add_help(:spike,
"spike(snd=false, chn=false) \
-multiplies successive samples together to make a sound more spikey")
+Multiplies successive samples together to make a sound more spikey.")
def spike(snd = false, chn = false)
x1 = x2 = 0.0
amp = maxamp(snd, chn)
@@ -526,7 +535,7 @@ multiplies successive samples together to make a sound more spikey")
# easily-fooled autocorrelation-based pitch tracker
add_help(:spot_freq,
"spot_freq(samp=0, snd=false, chn=false) \
-tries to determine the current pitch: spot_freq(left_sample)")
+Tries to determine the current pitch: spot_freq(left_sample)")
def spot_freq(samp = 0, snd = false, chn = false)
pow2 = (log(srate(snd) / 20.0) / log(2)).ceil
fftlen = (2 ** pow2).round
@@ -547,14 +556,17 @@ tries to determine the current pitch: spot_freq(left_sample)")
ret
end
# $graph_hook.add_hook!("examp-left-sample-hook") do |snd, chn, y0, y1|
- # report_in_minibuffer(format("(freq: %.3f)", spot_freq(left_sample(snd, chn))))
+ # msg = format("(freq: %.3f)", spot_freq(left_sample(snd, chn)))
+ # status_report(msg, snd)
# end
#
# or
#
- # $mouse_click_hook.add_hook!("examp-cursor-hook") do |snd, chn, button, state, x, y, axis|
+ # $mouse_click_hook.add_hook!("examp-cursor-hook") do |snd, chn,
+ # button, state,
+ # x, y, axis|
# if axis == Time_graph
- # report_in_minibuffer(format("(freq: %.3f)", spot_freq(cursor(snd, chn))))
+ # status_report(format("(freq: %.3f)", spot_freq(cursor(snd, chn))), snd)
# end
# end
@@ -577,7 +589,8 @@ tries to determine the current pitch: spot_freq(left_sample)")
end
def to_s
- format("#<%s time: %1.3f, amount: %1.3f, speed: %1.3f>", self.class, @time, @amount, @speed)
+ format("#<%s time: %1.3f, amount: %1.3f, speed: %1.3f>",
+ self.class, @time, @amount, @speed)
end
def run_func(val1 = 0.0, val2 = 0.0)
@@ -603,12 +616,16 @@ tries to determine the current pitch: spot_freq(left_sample)")
add_help(:chorus,
"chorus(size=5) \
-tries to produce the chorus sound effect")
+Tries to produce the chorus sound effect.")
def chorus(size = 5)
- dlys = make_array(size) do make_flanger end
+ dlys = make_array(size) do
+ make_flanger
+ end
sum = 0.0
lambda do |inval|
- dlys.each do |dly| sum += dly.flanger(inval) end
+ dlys.each do |dly|
+ sum += dly.flanger(inval)
+ end
sum * 0.25
end
end
@@ -617,13 +634,17 @@ tries to produce the chorus sound effect")
# and chordalize-base)
add_help(:chordalize,
"chordalize(amount=0.95, base=100, chord=[1.00, 0.75, 1.25]) \
-uses harmonically-related comb-filters to bring out a chord in a sound")
+Uses harmonically-related comb-filters to bring out a chord in a sound.")
def chordalize(amount = 0.95, base = 100, chord = [1.00, 0.75, 1.25])
- combs = chord.map do |interval| make_comb(:scaler, amount, :size, (base * interval).round) end
+ combs = chord.map do |interval|
+ make_comb(:scaler, amount, :size, (base * interval).round)
+ end
scaler = 0.5 / chord.length
lambda do |x|
val = 0.0
- combs.each do |c| val += comb(c, x) end
+ combs.each do |c|
+ val += comb(c, x)
+ end
scaler * val
end
end
@@ -632,9 +653,9 @@ uses harmonically-related comb-filters to bring out a chord in a sound")
# fft games (from the "phazor" package of Scott McNab)
add_help(:zero_phase,
"zero_phase(snd=false, chn=false) \
-calls fft, sets all phases to 0, and un-ffts")
+Calls fft, sets all phases to 0, and un-ffts.")
def zero_phase(snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
pow2 = (log(len) / log(2)).ceil
fftlen = (2 ** pow2).round
fftscale = 1.0 / fftlen
@@ -647,19 +668,21 @@ calls fft, sets all phases to 0, and un-ffts")
vct_scale!(im, 0.0)
fft(rl, im, -1)
pk = vct_peak(rl)
- vct2channel(vct_scale!(rl, old_pk / pk), 0, len, snd, chn, false, "zero_phase(")
+ vct2channel(rl.scale(old_pk / pk), 0, len, snd, chn, false, "zero_phase(")
end
# (set_)edit_list_proc_counter is defined in clm.rb
- # it's necessary to produce a uniq method name
+ # It's necessary to produce a uniq method name.
add_help(:rotate_phase,
"rotate_phase(func, snd=false, chn=false) \
-calls fft, applies func to each phase, then un-ffts")
+Calls fft, applies func to each phase, then un-ffts.")
def rotate_phase(func, snd = false, chn = false)
- func_name = format("%s_%d", get_func_name, set_edit_list_proc_counter).intern
+ func_name = format("%s_%d",
+ get_func_name,
+ set_edit_list_proc_counter).intern
# Proc converted to Method (ie. normal function) for edit_list2function
func.to_method(func_name)
- len = frames(snd, chn)
+ len = framples(snd, chn)
pow2 = (log(len) / log(2)).ceil
fftlen = (2 ** pow2).round
fftlen2 = (fftlen / 2).floor
@@ -681,24 +704,25 @@ calls fft, applies func to each phase, then un-ffts")
fft(rl, im, -1)
pk = rl.peak
vct2channel(rl.scale(old_pk / pk), 0, len, snd, chn, false,
- format("%s(Proc.new {|val_r| %s(val_r) }", get_func_name, func_name))
+ format("%s(Proc.new {|val_r| %s(val_r) }",
+ get_func_name, func_name))
end
# rotate_phase(lambda {|x| 0.0 }) # is the same as (zero-phase)
# rotate_phase(lambda {|x| random(PI) }) # randomizes phases
# rotate_phase(lambda {|x| x }) # returns original
- # rotate_phase(lambda {|x| -x }) # reverses original (might want to write fftlen samps here)
+ # rotate_phase(lambda {|x| -x }) # reverses original
+ # # (might want to write fftlen samps here)
# asymmetric FM (bes-i0 case)
class Asyfm < Musgen
def initialize(*args)
super()
- frequency, ratio, r, index, freq, phase = nil
+ frequency, ratio, r, index, phase = nil
optkey(args, binding,
[:frequency, $clm_default_frequency],
[:ratio, 1.0],
[:r, 1.0],
[:index, 1.0],
- [:freq, 0.0],
[:phase, 0.0])
@frequency = frequency.to_f
@ratio = ratio.to_f
@@ -710,12 +734,14 @@ calls fft, applies func to each phase, then un-ffts")
attr_accessor :ratio, :r, :index
def inspect
- format("%s.new(:frequency, %s, :ratio, %s, :r, %s, :index, %s, :freq, %s, :phase, %s)",
+ format("%s.new(:frequency, %s, :ratio, %s, :r, %s, \
+:index, %s, :freq, %s, :phase, %s)",
self.class, @frequency, @ratio, @r, @index, @freq, @phase)
end
def to_s
- format("#<%s freq: %1.3f, ratio: %1.3f, r: %1.3f, index: %1.3f, freq: %1.3f, phase: %1.3f>",
+ format("#<%s freq: %1.3f, ratio: %1.3f, r: %1.3f, \
+index: %1.3f, freq: %1.3f, phase: %1.3f>",
self.class, @frequency, @ratio, @r, @index, @freq, @phase)
end
@@ -729,7 +755,7 @@ calls fft, applies func to each phase, then un-ffts")
one = ((@r > 1.0) or (@r < 0.0 and @r > -1.0)) ? -1.0 : 1.0
modphase = @ratio * @phase
result = exp(0.5 * @index * (@r - r1) * (one + cos(modphase))) *
- cos(@phase + 0.5 * @index * (@r + r1) * sin(modphase))
+ cos(@phase + 0.5 * @index * (@r + r1) * sin(modphase))
@phase = @phase + input + @freq
result
end
@@ -738,7 +764,7 @@ calls fft, applies func to each phase, then un-ffts")
r1 = 1.0 / @r
modphase = @ratio * @phase
result = exp(0.5 * @index * (@r + r1) * (cos(modphase) - 1.0)) -
- cos(@phase + 0.5 * @index * (@r - r1) * sin(modphase))
+ cos(@phase + 0.5 * @index * (@r - r1) * sin(modphase))
@phase = @phase + input + @freq
result
end
@@ -765,7 +791,8 @@ calls fft, applies func to each phase, then un-ffts")
# from Andrews, Askey, Roy "Special Functions" 5.1.16
add_help(:cosine_summation,
"cosine_summation(gen, r) \
-is a variant of the CLM sine-summation generator; R controls successive sinusoid amplitudes.")
+Is a variant of the CLM sine-summation generator; \
+R controls successive sinusoid amplitudes.")
def cosine_summation(gen, r)
rr = r * r
rrp1 = 1.0 + rr
@@ -787,7 +814,7 @@ is a variant of the CLM sine-summation generator; R controls successive sinusoid
# other terms).
add_help(:kosine_summation,
"kosine_summation(gen, r, k) \
-is a variant of sum-of-cosines; \
+Is a variant of sum-of-cosines; \
R controls successive sinusoid amplitude; \
K controls how many sinusoids are produced.")
def kosine_summation(gen, r, k)
@@ -866,23 +893,26 @@ K controls how many sinusoids are produced.")
# brighten-slightly
add_help(:brighten_slightly,
"brighten_slightly(amount, snd=false, chn=false) \
-is a form of contrast-enhancement (AMOUNT between ca 0.1 and 1.0)")
+Is a form of contrast-enhancement (AMOUNT between ca 0.1 and 1.0).")
def brighten_slightly(amount, snd = false, chn = false)
mx = maxamp
brt = (TWO_PI * amount) / mx
map_channel(lambda do |y|
mx * sin(y * brt)
- end, 0, false, snd, chn, false, format("%s(%s", get_func_name, amount))
+ end, 0, false, snd, chn, false,
+ format("%s(%s", get_func_name, amount))
end
add_help(:brighten_slightly_1,
"brighten_slightly_1(coeffs, snd=false, chn=false) \
-is a form of contrast-enhancement: brighten_slightly-1([1, 0.5, 3, 1])")
+Is a form of contrast-enhancement: brighten_slightly-1([1, 0.5, 3, 1])")
def brighten_slightly_1(coeffs, snd = false, chn = false)
pcoeffs = partials2polynomial(coeffs)
mx = maxamp(snd, chn)
- map_channel(lambda do |y| mx * polynomial(pcoeffs, y / mx) end,
- 0, false, snd, chn, false, format("%s(%s", get_func_name, coeffs))
+ map_channel(lambda do |y|
+ mx * polynomial(pcoeffs, y / mx)
+ end, 0, false, snd, chn, false,
+ format("%s(%s", get_func_name, coeffs))
end
# FIR filters
@@ -890,7 +920,8 @@ is a form of contrast-enhancement: brighten_slightly-1([1, 0.5, 3, 1])")
# Snd's (very simple) spectrum->coefficients procedure is:
add_help(:spectrum2coeffs,
"spectrum2coeffs(order, spectr) \
-returns FIR filter coefficients given the filter order and desired spectral envelope (a vct)")
+Returns FIR filter coefficients given the filter ORDER \
+and desired spectral envelope (a vct).")
def spectrum2coeffs(order, spectr)
coeffs = make_vct(order)
n = order
@@ -913,28 +944,31 @@ returns FIR filter coefficients given the filter order and desired spectral enve
add_help(:fltit_1,
"fltit_1(order, spectrum) \
-creates an FIR filter from spectrum and order and returns a closure that calls it:
+Creates an FIR filter from SPECTRUM and ORDER and \
+returns a closure that calls it: \
map_channel(fltit_1(10, vct(0, 1.0, 0, 0, 0, 0, 0, 0, 1.0, 0)))")
def fltit_1(order, spectr)
flt = make_fir_filter(order, spectrum2coeffs(order, spectr))
- lambda do |x| fir_filter(flt, x) end
+ lambda do |x|
+ fir_filter(flt, x)
+ end
end
# Hilbert transform
add_help(:make_hilbert_transform,
"make_hilbert_transform(len=30) \
-makes a Hilbert transform filter")
+Makes a Hilbert transform filter.")
def make_hilbert_transform(len = 30)
arrlen = len * 2 + 1
arr = make_vct(arrlen)
(-len...len).each do |i|
k = i + len
denom = PI * i
- num = 1.0 - cos(PI * i)
- if i.zero?
+ num = 1.0 - cos(denom)
+ if num.zero? or i.zero?
arr[k] = 0.0
else
- arr[k] = (num / denom) * (0.54 + 0.46 * cos((PI * i) / len))
+ arr[k] = (num / denom) * (0.54 + 0.46 * cos(denom / len))
end
end
make_fir_filter(arrlen, arr)
@@ -942,13 +976,13 @@ makes a Hilbert transform filter")
add_help(:hilbert_transform,
"hilbert_transform(f, in) \
-is the generator corresponding to make_hilbert_transform")
+Is the generator corresponding to make_hilbert_transform.")
alias hilbert_transform fir_filter
# highpass filter
add_help(:make_highpass,
"make_highpass(fc, len=30) \
-makes an FIR highpass filter")
+Makes an FIR highpass filter.")
def make_highpass(fc, len = 30)
fc = fc.to_f
arrlen = len * 2 + 1
@@ -968,13 +1002,13 @@ makes an FIR highpass filter")
add_help(:highpass,
"highpass(f, in) \
-is the generator corresponding to make_highpass")
+Is the generator corresponding to make_highpass.")
alias highpass fir_filter
# lowpass filter
add_help(:make_lowpass,
"make_lowpass(fc, len=30) \
-makes an FIR lowpass filter")
+Makes an FIR lowpass filter.")
def make_lowpass(fc, len = 30)
fc = fc.to_f
arrlen = len * 2 + 1
@@ -994,13 +1028,13 @@ makes an FIR lowpass filter")
add_help(:lowpass,
"lowpass(f, in) \
-is the generator corresponding to make_lowpass")
+Is the generator corresponding to make_lowpass.")
alias lowpass fir_filter
# bandpass filter
add_help(:make_bandpass,
"make_bandpass(flo, fhi, len=30) \
-makes an FIR bandpass filter")
+Makes an FIR bandpass filter.")
def make_bandpass(flo, fhi, len = 30)
flo = flo.to_f
fhi = fhi.to_f
@@ -1021,13 +1055,13 @@ makes an FIR bandpass filter")
add_help(:bandpass,
"bandpass(f, in) \
-is the generator corresponding to make_bandpass")
+Is the generator corresponding to make_bandpass.")
alias bandpass fir_filter
# bandstop filter
add_help(:make_bandstop,
"make_bandstop(flo, fhi, len=30) \
-makes an FIR bandstop (notch) filter")
+Makes an FIR bandstop (notch) filter.")
def make_bandstop(flo, fhi, len = 30)
flo = flo.to_f
fhi = fhi.to_f
@@ -1048,13 +1082,13 @@ makes an FIR bandstop (notch) filter")
add_help(:bandstop,
"bandstop(f, in) \
-is the generator corresponding to make_bandstop")
+Is the generator corresponding to make_bandstop.")
alias bandstop fir_filter
# differentiator
add_help(:make_differentiator,
"make_differentiator(len=30) \
-makes an FIR differentiator (highpass) filter")
+Makes an FIR differentiator (highpass) filter.")
def make_differentiator(len = 30)
arrlen = len * 2 + 1
arr = make_vct(arrlen)
@@ -1072,7 +1106,7 @@ makes an FIR differentiator (highpass) filter")
add_help(:differentiator,
"differentiator(f, in) \
-is the generator corresponding to make_differentiator")
+Is the generator corresponding to make_differentiator.")
alias differentiator fir_filter
# IIR filters
@@ -1088,11 +1122,11 @@ is the generator corresponding to make_differentiator")
add_help(:butter,
"butter(b, sig) \
-is the generator side for the various make_butter procedure")
+Is the generator side for the various make_butter procedure.")
alias butter filter
add_help(:make_butter_high_pass,
"make_butter_high_pass(freq) \
-makes a Butterworth filter with high pass cutoff at FREQ")
+Makes a Butterworth filter with high pass cutoff at FREQ.")
def make_butter_high_pass(freq)
r = tan(PI * freq / srate())
r2 = r * r
@@ -1101,14 +1135,14 @@ makes a Butterworth filter with high pass cutoff at FREQ")
c3 = c1
c4 = 2.0 * (r2 - 1.0) * c1
c5 = ((1.0 - r * sqrt(2.0)) + r2) * c1
- make_filter(3, vector2vct([c1, c2, c3]), vector2vct([0.0, c4, c5]))
+ make_filter(3, vct(c1, c2, c3), vct(0.0, c4, c5))
end
add_help(:make_butter_low_pass,
"make_butter_low_pass(freq) \
-makes a Butterworth filter with high pass cutoff at FREQ. \
+Makes a Butterworth filter with high pass cutoff at FREQ. \
The result can be used directly: \
-filter_sound(make_butter_low_pass(500.0)), or via the 'butter' generator")
+filter_sound(make_butter_low_pass(500.0)), or via the 'butter' generator.")
def make_butter_low_pass(freq)
r = 1.0 / tan(PI * freq / srate())
r2 = r * r
@@ -1117,12 +1151,12 @@ filter_sound(make_butter_low_pass(500.0)), or via the 'butter' generator")
c3 = c1
c4 = 2.0 * (1.0 - r2) * c1
c5 = ((1.0 - r * sqrt(2.0)) + r2) * c1
- make_filter(3, vector2vct([c1, c2, c3]), vector2vct([0.0, c4, c5]))
+ make_filter(3, vct(c1, c2, c3), vct(0.0, c4, c5))
end
add_help(:make_butter_band_pass,
"make_butter_band_pass(freq, band) \
-makes a bandpass Butterworth filter with low edge at FREQ and width BAND")
+Makes a bandpass Butterworth filter with low edge at FREQ and width BAND.")
def make_butter_band_pass(freq, band)
d = 2.0 * cos(2.0 * PI * freq / srate())
c = 1.0 / tan(PI * band / srate())
@@ -1131,12 +1165,12 @@ makes a bandpass Butterworth filter with low edge at FREQ and width BAND")
c3 = -c1
c4 = -c * d * c1
c5 = (c - 1.0) * c1
- make_filter(3, vector2vct([c1, c2, c3]), vector2vct([0.0, c4, c5]))
+ make_filter(3, vct(c1, c2, c3), vct(0.0, c4, c5))
end
add_help(:make_butter_band_reject,
"make_butter_band_reject(freq, band) \
-makes a band-reject Butterworth filter with low edge at FREQ and width BAND")
+Makes a band-reject Butterworth filter with low edge at FREQ and width BAND.")
def make_butter_band_reject(freq, band)
d = 2.0 * cos(2.0 * PI * freq / srate())
c = tan(PI * band / srate())
@@ -1145,7 +1179,7 @@ makes a band-reject Butterworth filter with low edge at FREQ and width BAND")
c3 = c1
c4 = c2
c5 = (1.0 - c) * c1
- make_filter(3, vector2vct([c1, c2, c3]), vector2vct([0.0, c4, c5]))
+ make_filter(3, vct(c1, c2, c3), vct(0.0, c4, c5))
end
# from "DSP Filter Cookbook" by Lane et al, Prompt Pubs, 2001
@@ -1156,7 +1190,7 @@ makes a band-reject Butterworth filter with low edge at FREQ and width BAND")
# etc
add_help(:make_biquad,
"make_biquad(a0, a1, a2, b1, b2) \
-returns a biquad filter (use with the CLM filter gen)")
+Returns a biquad filter (use with the CLM filter gen).")
def make_biquad(a0, a1, a2, b1, b2)
make_filter(3, vct(a0, a1, a2), vct(0.0, b1, b2))
end
@@ -1166,20 +1200,26 @@ returns a biquad filter (use with the CLM filter gen)")
fc = fc.to_f
theta = (TWO_PI * fc) / mus_srate()
d = (din or sqrt(2.0))
- beta = 0.5 * ((1.0 - (d / 2.0) * sin(theta)) / (1.0 + (d / 2.0) * sin(theta)))
+ beta = 0.5 * ((1.0 - (d / 2.0) * sin(theta)) /
+ (1.0 + (d / 2.0) * sin(theta)))
gamma = (0.5 + beta) * cos(theta)
alpha = 0.5 * (0.5 + beta + -gamma)
- make_filter(3, vct(alpha, 2.0 * alpha, alpha), vct(0.0, -2.0 * gamma, 2.0 * beta))
+ make_filter(3,
+ vct(alpha, 2.0 * alpha, alpha),
+ vct(0.0, -2.0 * gamma, 2.0 * beta))
end
def make_iir_high_pass_2(fc, din = false)
fc = fc.to_f
theta = (TWO_PI * fc) / mus_srate()
d = (din or sqrt(2.0))
- beta = 0.5 * ((1.0 - (d / 2.0) * sin(theta)) / (1.0 + (d / 2.0) * sin(theta)))
+ beta = 0.5 * ((1.0 - (d / 2.0) * sin(theta)) /
+ (1.0 + (d / 2.0) * sin(theta)))
gamma = (0.5 + beta) * cos(theta)
alpha = 0.5 * (0.5 + beta + gamma)
- make_filter(3, vct(alpha, -2.0 * alpha, alpha), vct(0.0, -2.0 * gamma, 2.0 * beta))
+ make_filter(3,
+ vct(alpha, -2.0 * alpha, alpha),
+ vct(0.0, -2.0 * gamma, 2.0 * beta))
end
def make_iir_band_pass_2(f1, f2)
@@ -1191,7 +1231,9 @@ returns a biquad filter (use with the CLM filter gen)")
beta = 0.5 * ((1.0 - t2) / (1.0 + t2))
gamma = (0.5 + beta) * cos(theta)
alpha = 0.5 - beta
- make_filter(3, vct(alpha, 0.0, -alpha), vct(0.0, -2.0 * gamma, 2.0 * beta))
+ make_filter(3,
+ vct(alpha, 0.0, -alpha),
+ vct(0.0, -2.0 * gamma, 2.0 * beta))
end
def make_iir_band_stop_2(f1, f2)
@@ -1203,7 +1245,9 @@ returns a biquad filter (use with the CLM filter gen)")
beta = 0.5 * ((1.0 - t2) / (1.0 + t2))
gamma = (0.5 + beta) * cos(theta)
alpha = 0.5 + beta
- make_filter(3, vct(alpha, -2.0 * gamma, alpha), vct(0.0, -2.0 * gamma, 2.0 * beta))
+ make_filter(3,
+ vct(alpha, -2.0 * gamma, alpha),
+ vct(0.0, -2.0 * gamma, 2.0 * beta))
end
def make_eliminate_hum(hum_freq = 60.0, hum_harmonics = 5, bandwidth = 10)
@@ -1216,7 +1260,9 @@ returns a biquad filter (use with the CLM filter gen)")
def eliminate_hum(gens, x0)
val = x0
- gens.each do |gen| val = filter(gen, val) end
+ gens.each do |gen|
+ val = filter(gen, val)
+ end
val
end
@@ -1231,8 +1277,12 @@ returns a biquad filter (use with the CLM filter gen)")
beta = 0.5 * ((1.0 - t2) / (1.0 + t2))
gamma = (0.5 + beta) * cos(theta)
alpha = 0.5 - beta
- flt = make_filter(3, vct(alpha, 0.0, -alpha), vct(0.0, -2.0 * gamma, 2.0 * beta))
- lambda do |x| x + (m - 1.0) * filter(flt, x) end
+ flt = make_filter(3,
+ vct(alpha, 0.0, -alpha),
+ vct(0.0, -2.0 * gamma, 2.0 * beta))
+ lambda do |x|
+ x + (m - 1.0) * filter(flt, x)
+ end
end
# convert cascade coeffs to canonical form
@@ -1248,7 +1298,7 @@ returns a biquad filter (use with the CLM filter gen)")
add_help(:cascade2canonical,
"cascade2canonical(a) \
-converts a list of cascade coeffs (vcts with 3 entries) to canonical form")
+Converts a list of cascade coeffs (vcts with 3 entries) to canonical form.")
def cascade2canonical(a)
k = a.length
d = make_vct(2 * k + 1)
@@ -1266,7 +1316,8 @@ converts a list of cascade coeffs (vcts with 3 entries) to canonical form")
# order is M*2, fc is cutoff freq (Hz)
add_help(:make_butter_lp,
"make_butter_lp(m, fc) \
-returns a butterworth low-pass filter; its order is M * 2, FC is the cutoff frequency in Hz")
+Returns a butterworth low-pass filter; \
+its order is M * 2, FC is the cutoff frequency in Hz.")
def make_butter_lp(m, fc)
fc = fc.to_f
xcoeffs = make_array(m)
@@ -1282,13 +1333,15 @@ returns a butterworth low-pass filter; its order is M * 2, FC is the cutoff freq
xcoeffs[k] = vct(2.0 * alpha, 4.0 * alpha, 2.0 * alpha)
ycoeffs[k] = vct(1.0, -2.0 * gamma, 2.0 * beta)
end
- make_filter(2 * m + 1, cascade2canonical(xcoeffs), cascade2canonical(ycoeffs))
+ make_filter(2 * m + 1,
+ cascade2canonical(xcoeffs), cascade2canonical(ycoeffs))
end
# order is M*2, fc is cutoff freq (Hz)
add_help(:make_butter_hp,
"make_butter_hp(m, fc) \
-returns a butterworth high-pass filter; its order is M * 2, FC is the cutoff frequency in Hz")
+Returns a butterworth high-pass filter; \
+its order is M * 2, FC is the cutoff frequency in Hz.")
def make_butter_hp(m, fc)
fc = fc.to_f
xcoeffs = make_array(m)
@@ -1304,14 +1357,15 @@ returns a butterworth high-pass filter; its order is M * 2, FC is the cutoff fre
xcoeffs[k] = vct(2.0 * alpha, -4 * alpha, 2.0 * alpha)
ycoeffs[k] = vct(1.0, -2.0 * gamma, 2.0 * beta)
end
- make_filter(2 * m + 1, cascade2canonical(xcoeffs), cascade2canonical(ycoeffs))
+ make_filter(2 * m + 1,
+ cascade2canonical(xcoeffs), cascade2canonical(ycoeffs))
end
# order is M*2, f1 and f2 are band edge freqs (Hz)
add_help(:make_butter_bp,
"make_butter_bp(m, f1, f2) \
-returns a butterworth band-pass filter; \
-its order is M * 2, F1 and F2 are the band edge frequencies in Hz")
+Returns a butterworth band-pass filter; \
+its order is M * 2, F1 and F2 are the band edge frequencies in Hz.")
def make_butter_bp(m, f1, f2)
f1 = f1.to_f
f2 = f2.to_f
@@ -1331,7 +1385,8 @@ its order is M * 2, F1 and F2 are the band edge frequencies in Hz")
bk = de2 * (dk / dk1)
wk = (bk + sqrt(bk * bk - 1.0)).real
thetajk = ((j == 1) ? (2.0 * atan(tn0 / wk)) : (2.0 * atan(tn0 * wk)))
- betajk = 0.5 * ((1.0 - 0.5 * dk1 * sin(thetajk)) / (1.0 + 0.5 * dk1 * sin(thetajk)))
+ betajk = 0.5 * ((1.0 - 0.5 * dk1 * sin(thetajk)) /
+ (1.0 + 0.5 * dk1 * sin(thetajk)))
gammajk = (0.5 + betajk) * cos(thetajk)
wk2 = (wk - 1.0 / wk) / dk1
alphajk = 0.5 * (0.5 - betajk) * sqrt(1.0 + wk2 * wk2)
@@ -1344,14 +1399,15 @@ its order is M * 2, F1 and F2 are the band edge frequencies in Hz")
j = 1
end
end
- make_filter(2 * m + 1, cascade2canonical(xcoeffs), cascade2canonical(ycoeffs))
+ make_filter(2 * m + 1,
+ cascade2canonical(xcoeffs), cascade2canonical(ycoeffs))
end
# order is M*2, f1 and f2 are band edge freqs (Hz)
add_help(:make_butter_bs,
"make_butter_bs(m, f1, f2) \
-returns a butterworth band-stop filter; \
-its order is M * 2, F1 and F2 are the band edge frequencies in Hz")
+Returns a butterworth band-stop filter; \
+its order is M * 2, F1 and F2 are the band edge frequencies in Hz.")
def make_butter_bs(m, f1, f2)
f1 = f1.to_f
f2 = f2.to_f
@@ -1372,7 +1428,8 @@ its order is M * 2, F1 and F2 are the band edge frequencies in Hz")
bk = de2 * (dk / dk1)
wk = (bk + sqrt(bk * bk - 1.0)).real
thetajk = ((j == 1) ? (2.0 * atan(tn0 / wk)) : (2.0 * atan(tn0 * wk)))
- betajk = 0.5 * ((1.0 - 0.5 * dk1 * sin(thetajk)) / (1.0 + 0.5 * dk1 * sin(thetajk)))
+ betajk = 0.5 * ((1.0 - 0.5 * dk1 * sin(thetajk)) /
+ (1.0 + 0.5 * dk1 * sin(thetajk)))
gammajk = (0.5 + betajk) * cos(thetajk)
alphajk = 0.5 * (0.5 + betajk) * ((1.0 - cos(thetajk)) / (1.0 - ct))
xcoeffs[i] = vct(2.0 * alphajk, -4.0 * ct * alphajk, 2.0 * alphajk)
@@ -1384,7 +1441,8 @@ its order is M * 2, F1 and F2 are the band edge frequencies in Hz")
j = 1
end
end
- make_filter(2 * m + 1, cascade2canonical(xcoeffs), cascade2canonical(ycoeffs))
+ make_filter(2 * m + 1,
+ cascade2canonical(xcoeffs), cascade2canonical(ycoeffs))
end
# notch filters
@@ -1393,14 +1451,22 @@ its order is M * 2, F1 and F2 are the band edge frequencies in Hz")
notch_width = notch_width.to_f
freq_response = [0.0, 1.0]
freqs.each do |f|
- freq_response.push((2.0 * (f - notch_width)) / cur_srate) # left upper y hz
- freq_response.push(1.0) # left upper y resp
- freq_response.push((2.0 * (f - notch_width / 2.0)) / cur_srate) # left bottom y hz
- freq_response.push(0.0) # left bottom y resp
- freq_response.push((2.0 * (f + notch_width / 2.0)) / cur_srate) # right bottom y hz
- freq_response.push(0.0) # right bottom y resp
- freq_response.push((2.0 * (f + notch_width)) / cur_srate) # right upper y hz
- freq_response.push(1.0) # right upper y resp
+ # left upper y hz
+ freq_response.push((2.0 * (f - notch_width)) / cur_srate)
+ # left upper y resp
+ freq_response.push(1.0)
+ # left bottom y hz
+ freq_response.push((2.0 * (f - notch_width / 2.0)) / cur_srate)
+ # left bottom y resp
+ freq_response.push(0.0)
+ # right bottom y hz
+ freq_response.push((2.0 * (f + notch_width / 2.0)) / cur_srate)
+ # right bottom y resp
+ freq_response.push(0.0)
+ # right upper y hz
+ freq_response.push((2.0 * (f + notch_width)) / cur_srate)
+ # right upper y resp
+ freq_response.push(1.0)
end
freq_response.push(1.0, 1.0)
end
@@ -1408,7 +1474,7 @@ its order is M * 2, F1 and F2 are the band edge frequencies in Hz")
add_help(:notch_channel,
"notch_channel(freqs, order=false, beg=false, dur=false, \
snd=false, chn=false, edpos=false, trunc=true, notch_width=2) \
--> notch filter removing freqs")
+Returns notch filter removing freqs.")
def notch_channel(freqs,
filter_order = false,
beg = false,
@@ -1418,31 +1484,41 @@ snd=false, chn=false, edpos=false, trunc=true, notch_width=2) \
edpos = false,
truncate = true,
notch_width = 2)
- filter_channel(make_notch_frequency_response(srate(snd).to_f, freqs, notch_width),
- (filter_order or (2 ** (log(srate(snd).to_f / notch_width) / log(2.0)).ceil)),
+ sr = srate(snd).to_f
+ lm = [framples(snd, chn), 2 ** (log(sr / notch_width) / log(2.0)).floor].min
+ filter_channel(make_notch_frequency_response(sr, freqs, notch_width),
+ (filter_order or lm),
beg, dur, snd, chn, edpos, truncate,
- format("%s(%s, %s, %s, %s",
- get_func_name, freqs.inspect, filter_order, beg, dur))
+ format("%s(%p, %s, %s, %s",
+ get_func_name, freqs, filter_order, beg, dur))
end
add_help(:notch_sound,
- "notch_sound(freqs, order=false, snd=false, chn=false, notch_width=2) \
--> notch filter removing freqs")
- def notch_sound(freqs, filter_order = false, snd = false, chn = false, notch_width = 2)
- filter_sound(make_notch_frequency_response(srate(snd).to_f, freqs, notch_width),
- (filter_order or (2 ** (log(srate(snd).to_f / notch_width) / log(2.0)).ceil)),
+ "notch_sound(freqs, order=false, \
+snd=false, chn=false, notch_width=2) \
+Returns notch filter removing freqs.")
+ def notch_sound(freqs, filter_order = false,
+ snd = false, chn = false, notch_width = 2)
+ sr = srate(snd).to_f
+ lm = [framples(snd, chn), 2 ** (log(sr / notch_width) / log(2.0)).floor].min
+ filter_sound(make_notch_frequency_response(sr, freqs, notch_width),
+ (filter_order or lm),
snd, chn, false,
- format("%s(%s, %s, 0, false", get_func_name, freqs.inspect, filter_order))
+ format("%s(%p, %s, 0, false",
+ get_func_name, freqs, filter_order))
end
add_help(:notch_selection,
"notch_selection(freqs, order=false, notch_width=2) \
--> notch filter removing freqs")
- def notch_selection(freqs, filter_order = false, snd = false, chn = false, notch_width = 2)
+Returns notch filter removing freqs.")
+ def notch_selection(freqs, filter_order = false,
+ snd = false, chn = false, notch_width = 2)
if selection?
- filter_selection(make_notch_frequency_response(selection_srate.to_f, freqs, notch_width),
- (filter_order or
- (2 ** (log(selection_srate.to_f / notch_width) / log(2.0)).ceil)))
+ sr = selection_srate.to_f
+ fr = selection_framples()
+ lm = [fr, 2 ** (log(sr / notch_width) / log(2.0)).floor].min
+ filter_selection(make_notch_frequency_response(sr, freqs, notch_width),
+ (filter_order or lm))
end
end
@@ -1451,8 +1527,8 @@ snd=false, chn=false, edpos=false, trunc=true, notch_width=2) \
# translated from the fxt package of Joerg Arndt
add_help(:fractional_fourier_transform,
"fractional_fourier_transform(real, imaginary, n, angle) \
-performs a fractional Fourier transform on data; \
-if angle=1.0, you get a normal Fourier transform")
+Performs a fractional Fourier transform on data; \
+if angle=1.0, you get a normal Fourier transform.")
def fractional_fourier_transform(fr, fi, n, v)
hr = make_vct(n)
hi = make_vct(n)
@@ -1481,8 +1557,9 @@ if angle=1.0, you get a normal Fourier transform")
# z_transform(data, n, exp(Complex(0.0, (2.0 / n) * PI)))
add_help(:z_transform,
"z_transform(data, n, z) \
-performs a Z transform on data; \
-if z=e^2*pi*j/n you get a Fourier transform; complex results in returned vector")
+Performs a Z transform on data; \
+if z=e^2*pi*j/n you get a Fourier transform; \
+complex results in returned vector.")
def z_transform(f, n, z)
make_array(n) do |w|
sum = 0.0
@@ -1502,7 +1579,7 @@ if z=e^2*pi*j/n you get a Fourier transform; complex results in returned vector"
# Hartley transform)
add_help(:dht,
"dht(data) \
-returns the Hartley transform of DATA.")
+Returns the Hartley transform of DATA.")
def dht(data)
len = data.length
arr = make_vct(len)
@@ -1517,7 +1594,7 @@ returns the Hartley transform of DATA.")
add_help(:find_sine,
"find_sine(freq, beg, dur, snd=false) \
-returns the amplitude and initial-phase (for sin) at freq between beg and dur")
+Returns the amplitude and initial-phase (for sin) at FREQ between BEG and DUR.")
def find_sine(freq, beg, dur, snd = false)
incr = (TWO_PI * freq) / srate(snd)
sw = 0.0
@@ -1539,7 +1616,7 @@ returns the amplitude and initial-phase (for sin) at freq between beg and dur")
add_help(:goertzel,
"goertzel(freq, beg=0, dur=false, snd=false) \
-returns the amplitude of the FREQ spectral component")
+Returns the amplitude of the FREQ spectral component.")
def goertzel(freq, beg = 0, dur = false, snd = false)
y0 = 0.0
y1 = 0.0
@@ -1550,17 +1627,21 @@ returns the amplitude of the FREQ spectral component")
y2, y1 = y1, y0
y0 = (y1 * cs - y2) + y
false
- end, beg, (dur or frames(snd)), snd)
+ end, beg, (dur or framples(snd)), snd)
(y0 - y1 * exp(Complex(0.0, -rfreq))).abs
end
add_help(:make_spencer_filter,
"make_spencer_filter() \
-is a version of make_fir_filter; \
-it returns one of the standard smoothing filters from the era when computers were human beings")
+Is a version of make_fir_filter; \
+it returns one of the standard smoothing filters from \
+the era when computers were human beings.")
def make_spencer_filter
- data = [-3, -6, -5, 3, 21, 46, 67, 74, 67, 46, 21, 3, -5, -6, -3].map do |n| n / 320.0 end
- make_fir_filter(15, vector2vct(data))
+ data = vct(-3, -6, -5, 3, 21, 46, 67, 74, 67, 46, 21, 3, -5, -6, -3)
+ data.map! do |n|
+ n / 320.0
+ end
+ make_fir_filter(data.length, data)
end
# any-random
@@ -1614,10 +1695,16 @@ it returns one of the standard smoothing filters from the era when computers wer
end
e
end
- # map_channel(lambda do |y| any_random(1.0, [0, 1, 1, 1])) # uniform distribution
- # map_channel(lambda do |y| any_random(1.0, [0, 0, 0.95, 0.1, 1, 1])) # mostly toward 1.0
- # let(gaussian-distribution(1.0)) do |g| map_channel(lambda do |y| any_random(1.0, g)) end
- # let(pareto-distribution(1.0)) do |g| map_channel(lambda do |y| any_random(1.0, g)) end
+ # uniform distribution
+ # map_channel(lambda do |y| any_random(1.0, [0, 1, 1, 1]))
+ # mostly toward 1.0
+ # map_channel(lambda do |y| any_random(1.0, [0, 0, 0.95, 0.1, 1, 1]))
+ # let(gaussian-distribution(1.0)) do |g|
+ # map_channel(lambda do |y| any_random(1.0, g))
+ # end
+ # let(pareto-distribution(1.0)) do |g|
+ # map_channel(lambda do |y| any_random(1.0, g))
+ # end
# this is the inverse integration function used by CLM to turn a
# distribution function into a weighting function
@@ -1662,10 +1749,10 @@ it returns one of the standard smoothing filters from the era when computers wer
# these are from "Mathematics of the DFT", W3K Pubs
add_help(:channel_mean,
"channel_mean(snd, chn) \
-returns the average of the samples in the given channel: <f,1>/n")
+Returns the average of the samples in the given channel: <f,1>/n")
def channel_mean(snd, chn)
sum = 0.0
- n = frames(snd, chn)
+ n = framples(snd, chn)
scan_channel(lambda do |y|
sum += y
false
@@ -1675,35 +1762,35 @@ returns the average of the samples in the given channel: <f,1>/n")
add_help(:channel_total_energy,
"channel_total_energy(snd, chn) \
-returns the sum of the squares of all the samples in the given channel: <f,f>")
+Returns the sum of the squares of all the samples in the given channel: <f,f>")
def channel_total_energy(snd, chn)
sum = 0.0
scan_channel(lambda do |y|
sum = sum + y * y
false
- end, 0, frames(snd, chn), snd, chn)
+ end, 0, framples(snd, chn), snd, chn)
sum
end
add_help(:channel_average_power,
"channel_average_power(snd, chn) \
-returns the average power in the given channel: <f,f>/n")
+Returns the average power in the given channel: <f,f>/n")
def channel_average_power(snd, chn)
- channel_total_energy(snd, chn) / frames(snd, chn)
+ channel_total_energy(snd, chn) / framples(snd, chn)
end
add_help(:channel_rms,
"channel_rms(snd, chn) \
-returns the RMS value of the samples in the given channel: sqrt(<f,f>/n)")
+Returns the RMS value of the samples in the given channel: sqrt(<f,f>/n)")
def channel_rms(snd, chn)
sqrt(channel_average_power(snd, chn))
end
add_help(:channel_variance,
"channel_variance(snd, chn) \
-returns the sample variance in the given channel: <f,f>-((<f,1>/ n)^2")
+Returns the sample variance in the given channel: <f,f>-((<f,1>/ n)^2")
def channel_variance(snd, chn)
- n = frames(snd, chn).to_f
+ n = framples(snd, chn).to_f
mu = (n / (n - 1.0)) * channel_mean(snd, chn)
p = channel_total_energy(snd, chn)
p - mu * mu
@@ -1711,43 +1798,44 @@ returns the sample variance in the given channel: <f,f>-((<f,1>/ n)^2")
add_help(:channel_norm,
"channel_norm(snd, chn) \
-returns the norm of the samples in the given channel: sqrt(<f,f>)")
+Returns the norm of the samples in the given channel: sqrt(<f,f>)")
def channel_norm(snd, chn)
sqrt(channel_total_energy(snd, chn))
end
add_help(:channel_lp,
"channel_lp(p, snd, chn) \
-returns the Lp norm of the samples in the given channel")
+Returns the Lp norm of the samples in the given channel.")
def channel_lp(lp, snd, chn)
sum = 0.0
scan_channel(lambda do |y|
sum = sum + y.abs ** lp
false
- end, 0, frames(snd, chn), snd, chn)
+ end, 0, framples(snd, chn), snd, chn)
sum ** (1.0 / lp)
end
add_help(:channel_lp_inf,
"channel_lp_inf(snd, chn) \
-returns the maxamp in the given channel (the name is just math jargon for maxamp)")
+Returns the maxamp in the given channel (the name is \
+just math jargon for maxamp).")
def channel_lp_inf(snd, chn)
mx = 0.0
scan_channel(lambda do |y|
mx = [mx, y.abs].max
false
- end, 0, frames(snd, chn), snd, chn)
+ end, 0, framples(snd, chn), snd, chn)
mx
end
add_help(:channel2_inner_product,
"channel2_inner_product(s1, c1, s2, c2) \
-returns the inner-product of the two channels: <f,g>")
+Returns the inner-product of the two channels: <f,g>")
def channel2_inner_product(s1, c1, s2, c2)
sum = 0.0
r1 = make_sampler(0, s1, c1)
r2 = make_sampler(0, s2, c2)
- frames(s1, c1).times do |i|
+ framples(s1, c1).times do |i|
sum = sum + r1.call * r2.call
end
sum
@@ -1755,8 +1843,8 @@ returns the inner-product of the two channels: <f,g>")
add_help(:channel2_angle,
"channel2_angle(s1, c1, s2, c2) \
-treats the two channels as vectors, \
-returning the 'angle' between them: acos(<f,g>/(sqrt(<f,f>)*sqrt(<g,g>)))")
+Treats the two channels as vectors, \
+returning the ANGLE between them: acos(<f,g>/(sqrt(<f,f>)*sqrt(<g,g>)))")
def channel2_angle(s1, c1, s2, c2)
inprod = channel2_inner_product(s1, c1, s2, c2)
norm1 = channel_norm(s1, c1)
@@ -1766,14 +1854,14 @@ returning the 'angle' between them: acos(<f,g>/(sqrt(<f,f>)*sqrt(<g,g>)))")
add_help(:channel2_orthogonal?,
"channel2_orthogonal?(s1, c1, s2, c2) \
-returns true if the two channels' inner-product is 0: <f,g>==0")
+Returns true if the two channels' inner-product is 0: <f,g>==0")
def channel2_orthogonal?(s1, c1, s2, c2)
channel2_inner_product(s1, c1, s2, c2).zero?
end
add_help(:channel2_coefficient_of_projection,
"channel2_coefficient_of_projection(s1, c1, s2, c2) \
-returns <f,g>/<f,f>")
+Returns <f,g>/<f,f>")
def channel2_coefficient_of_projection(s1, c1, s2, c2)
channel2_inner_product(s1, c1, s2, c2) / channel_total_energy(s1, c1)
end
@@ -1782,12 +1870,12 @@ returns <f,g>/<f,f>")
add_help(:channel_distance,
"channel_distance(s1, c1, s2, c2) \
-returns the euclidean distance between the two channels: sqrt(<f-g,f-g>)")
+Returns the euclidean distance between the two channels: sqrt(<f-g,f-g>)")
def channel_distance(s1, c1, s2, c2)
r1 = make_sampler(0, s1, c1)
r2 = make_sampler(0, s2, c2)
sum = 0.0
- [frames(s1, c1), frames(s2, c2)].min.times do
+ [framples(s1, c1), framples(s2, c2)].min.times do
diff = r1.call - r2.call
sum = sum + diff * diff
end
@@ -1796,9 +1884,9 @@ returns the euclidean distance between the two channels: sqrt(<f-g,f-g>)")
add_help(:periodogram,
"periodogram(n) \
-displays an N point Bartlett periodogram of the samples in the current channel")
+Displays an N point Bartlett periodogram of the samples in the current channel")
def periodogram(n)
- len = frames()
+ len = framples()
average_data = make_vct(n)
rd = make_sampler(0)
n2 = n * 2
@@ -1821,8 +1909,10 @@ displays an N point Bartlett periodogram of the samples in the current channel")
# ssb-am friends
add_help(:shift_channel_pitch,
- "shift_channel_pitch(freq, order=40, beg=0, dur=false, snd=false, chn=false, edpos=false)\
- uses the ssb-am CLM generator to shift the given channel in pitch without changing its length. \
+ "shift_channel_pitch(freq, order=40, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Uses the ssb-am CLM generator to shift the given channel \
+in pitch without changing its length. \
The higher ORDER, the better usually.")
def shift_channel_pitch(freq, order = 40, beg = 0, dur = false,
snd = false, chn = false, edpos = false)
@@ -1831,12 +1921,13 @@ The higher ORDER, the better usually.")
ssb_am(gen, y)
end,
beg, dur, snd, chn, edpos,
- format("%s(%s, %s, %s, %s", get_func_name, freq, order, beg, dur))
+ format("%s(%s, %s, %s, %s",
+ get_func_name, freq, order, beg, dur))
end
add_help(:hz_to_2pi,
"hz_to_2pi(freq) \
-is like hz2radians but uses the current sound's srate, not mus_srate")
+Is like hz2radians but uses the current sound's srate, not mus_srate.")
def hz_to_2pi(freq)
(TWO_PI * freq) / srate()
end
@@ -1854,7 +1945,8 @@ is like hz2radians but uses the current sound's srate, not mus_srate")
make_bandpass(hz_to_2pi(aff - bwf), hz_to_2pi(aff + bwf), order)
end
as_one_edit_rb("%s(%s, %s, %s, %s, %s, %s, %s",
- get_func_name, old_freq, new_freq, pairs, order, bw, beg, dur) do | |
+ get_func_name, old_freq, new_freq,
+ pairs, order, bw, beg, dur) do | |
nmx = 0.0
map_channel_rb(beg, dur, snd, chn, edpos) do |y|
sum = 0.0
@@ -1881,7 +1973,9 @@ is like hz2radians but uses the current sound's srate, not mus_srate")
aff = (i + 1.0) * old_freq
bwf = bw * (1.0 + (i + 1.0) / (2.0 * pairs))
ssbs[i] = make_ssb_am((i + 1.0) * factor * old_freq)
- frenvs[i] = make_env(:envelope, freq_env, :scaler, hz2radians(i.to_f), :length, frames() - 1)
+ frenvs[i] = make_env(:envelope, freq_env,
+ :scaler, hz2radians(i.to_f),
+ :length, framples(snd, chn) - 1)
make_bandpass(hz_to_2pi(aff - bwf), hz_to_2pi(aff + bwf), order)
end
as_one_edit_rb("%s(%s, %s, %s, %s, %s, %s, %s, %s",
@@ -1910,8 +2004,9 @@ is like hz2radians but uses the current sound's srate, not mus_srate")
end
def channel_polynomial(coeffs, snd = false, chn = false)
- len = frames(snd, chn)
- vct2channel(vct_polynomial(channel2vct(0, len, snd, chn), coeffs), 0, len, snd, chn, false,
+ len = framples(snd, chn)
+ v = channel2vct(0, len, snd, chn)
+ vct2channel(vct_polynomial(v, coeffs), 0, len, snd, chn, false,
format("%s(%s", get_func_name, coeffs.to_str))
end
@@ -1921,7 +2016,7 @@ is like hz2radians but uses the current sound's srate, not mus_srate")
# convolution -> * in freq
def spectral_polynomial(coeffs, snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
sound = channel2vct(0, len, snd, chn)
num_coeffs = coeffs.length
fft_len = if num_coeffs < 2
@@ -1933,7 +2028,9 @@ is like hz2radians but uses the current sound's srate, not mus_srate")
rl2 = make_vct(fft_len)
new_sound = make_vct(fft_len)
if coeffs[0] > 0.0
- new_sound.map! do mus_random(coeffs[0]) end
+ new_sound.map! do
+ mus_random(coeffs[0])
+ end
end
if num_coeffs > 1
new_sound.add!(sound.scale(coeffs[1]))
@@ -1947,7 +2044,8 @@ is like hz2radians but uses the current sound's srate, not mus_srate")
new_sound.scale!(peak / new_sound.peak)
end
end
- vct2channel(new_sound, 0, [len, len * (num_coeffs - 1)].max, snd, chn, false,
+ vct2channel(new_sound, 0, [len, len * (num_coeffs - 1)].max,
+ snd, chn, false,
format("%s(%s", get_func_name, coeffs.to_str))
end
@@ -1962,7 +2060,8 @@ is like hz2radians but uses the current sound's srate, not mus_srate")
# has a rough correlation to our sense of "brightness" of a sound.
#
# [Beauchamp, J., "Synthesis by spectral amplitude and 'brightness' matching
- # analyzed musical sounds". Journal of Audio Engineering Society 30(6), 396-406]
+ # analyzed musical sounds".
+ # Journal of Audio Engineering Society 30(6), 396-406]
#
# The formula used is:
# C = [SUM<n=1toj>F(n)A(n)] / [SUM<n=1toj>A(n)]
@@ -1983,16 +2082,18 @@ is like hz2radians but uses the current sound's srate, not mus_srate")
# recommended.
add_help(:scentroid,
- "scentroid(file, beg=0, dur=false, db_floor=-40, rfreq=100, fftsize=4096) \
-returns the spectral centroid envelope of a sound; \
+ "scentroid(file, beg=0, dur=false, db_floor=-40, \
+rfreq=100, fftsize=4096) \
+Returns the spectral centroid envelope of a sound; \
RFREQ is the rendering frequency, the number of measurements per second; \
-DB_FLOOR is the level below which data will be ignored")
- def scentroid(file, beg = 0.0, dur = false, db_floor = -40, rfreq = 100.0, fftsize = 4096)
- assert_type(File.exists?(file), file, 0, "an existing file")
+DB_FLOOR is the level below which data will be ignored.")
+ def scentroid(file, beg = 0.0, dur = false, db_floor = -40,
+ rfreq = 100.0, fftsize = 4096)
+ assert_type(File.exist?(file), file, 0, "an existing file")
fsr = srate(file)
incrsamps = (fsr / rfreq).floor
start = (beg * fsr).floor
- ende = start + (dur ? (dur * fsr).floor : (frames(file) - beg))
+ ende = (start + (dur ? (dur * fsr).floor : (framples(file) - beg))).floor
fdr = make_vct(fftsize)
fdi = make_vct(fftsize)
windows = ((ende - start) / incrsamps).floor + 1
@@ -2012,7 +2113,9 @@ DB_FLOOR is the level below which data will be ignored")
if linear2db(sqrt(sum_of_squares / fftsize.to_f)) >= db_floor
numsum = 0.0
densum = 0.0
- clear_array(fdi)
+ fdi.map! do |x|
+ 0.0
+ end
mus_fft(fdr, fdi, fftsize)
rectangular2polar(fdr, fdi)
fft2.times do |j|
@@ -2028,22 +2131,24 @@ DB_FLOOR is the level below which data will be ignored")
# invert_filter inverts an FIR filter
#
- # say we previously filtered a sound via filter_channel([0.5, 0.25, 0.125].to_vct)
+ # say we previously filtered a sound via filter_channel(vct(0.5, 0.25, 0.125))
# and we want to undo it without using undo_edit:
- # filter_channel(invert_filter([0.5, 0.25, 0.125].to_vct))
+ # filter_channel(invert_filter(vct(0.5, 0.25, 0.125)))
#
- # there are a million gotchas here. The primary one is that the inverse filter
- # can "explode" -- the coefficients can grow without bound. For example, any
- # filter returned by spectrum2coeffs above will be a problem (it always returns
- # a "linear phase" filter).
+ # there are a million gotchas here. The primary one is that the inverse
+ # filtercan "explode" -- the coefficients can grow without bound. For
+ # example, any filter returned by spectrum2coeffs above will be a problem
+ # (it always returns a "linear phase" filter).
add_help(:invert_filter,
"invert_filter(coeffs) \
-tries to return an inverse filter to undo the effect of the FIR filter coeffs.")
+Tries to return an inverse filter to undo the effect of the FIR filter coeffs.")
def invert_filter(fcoeffs)
order = fcoeffs.length + 32
coeffs = Vct.new(order)
- fcoeffs.each_with_index do |val, i| coeffs[i] = val end
+ fcoeffs.each_with_index do |val, i|
+ coeffs[i] = val
+ end
nfilt = Vct.new(order)
nfilt[0] = 1.0 / coeffs.first
(1...order).each do |i|
@@ -2100,79 +2205,27 @@ tries to return an inverse filter to undo the effect of the FIR filter coeffs.")
add_help(:make_volterra_filter,
"make_volterra_filter(acoeffs, bcoeffs) \
-returns a list for use with volterra-filter, producing one of the standard non-linear filters")
+Returns a list for use with volterra-filter, \
+producing one of the standard non-linear filters.")
def make_volterra_filter(acoeffs, bcoeffs)
Volterra_filter.new(acoeffs, bcoeffs)
end
add_help(:volterra_filter,
"volterra_filter(flt, x) \
-takes FLT, a Volterra_filter object returned by make_volterra_filter, \
-and an input X, and returns the (non-linear filtered) result")
+Takes FLT, a Volterra_filter object returned by make_volterra_filter, \
+and an input X, and returns the (non-linear filtered) result.")
def volterra_filter(flt, x)
flt.volterra_filter(x)
end
# flt = make_volterra_filter(vct(0.5, 0.1), vct(0.3, 0.2, 0.1))
# map_channel(lambda do |y| volterra_filter(flt, y) end)
- class Moving_max < Musgen
- def initialize(size = 128)
- super()
- @length = size
- @gen = make_delay(:size, size)
- @gen.scaler = 0.0
- @data = @gen.data
- end
-
- def inspect
- format("%s.new(%s)", self.class, @length)
- end
-
- def to_s
- format("#<%s size: %s, scaler: %s>", self.class, @length, @gen.scaler)
- end
-
- def run_func(val1 = 0.0, val2 = 0.0)
- moving_max(val1)
- end
-
- def moving_max(y)
- absy = y.abs
- mx = delay(@gen, absy)
- pk = @gen.scaler - 0.001
- if absy > pk
- @gen.scaler = absy
- else
- if mx >= pk
- @gen.scaler = @gen.data.peak
- end
- end
- @gen.scaler
- end
- end
-
- add_help(:make_moving_max,
- "make_moving_max(size = 128) \
-returns a windowed-maxamp generator. \
-The generator keeps a running window of the last SIZE inputs, returning the maxamp in that window.")
- def make_moving_max(size = 128)
- Moving_max.new(size)
- end
-
- add_help(:moving_max,
- "moving_max(gen, input) \
-returns the maxamp in a running window on the last few inputs.")
- def moving_max(gen, y)
- gen.moving_max(y)
- end
- alias windowed_maxamp moving_max
- alias make_windowed_maxamp make_moving_max
-
# moving-sum generator (the sum norm or 1-norm)
-
+
add_help(:make_moving_sum,
"make_moving_sum(size=128) \
-returns a moving-sum generator. \
+Returns a moving-sum generator. \
The generator keeps a running window of the last SIZE inputs, \
returning the sum of the absolute values of the samples in that window.")
def make_moving_sum(size = 128)
@@ -2183,16 +2236,22 @@ returning the sum of the absolute values of the samples in that window.")
add_help(:moving_sum,
"moving_sum(gen, y) \
-returns the sum of the absolute values in a moving window over the last few inputs.")
+Returns the sum of the absolute values in a moving \
+window over the last few inputs.")
def moving_sum(gen, y)
moving_average(gen, y.abs)
end
+ def make_unmoving_sum()
+ make_one_pole(1.0, -1.0)
+ end
+ alias unmoving_sum one_pole
+
# moving-rms generator
add_help(:make_moving_rms,
"make_moving_rms(size=128) \
-returns a moving-rms generator. \
+Returns a moving-rms generator. \
The generator keeps a running window of the last SIZE inputs, \
returning the rms of the samples in that window.")
def make_moving_rms(size = 128)
@@ -2201,39 +2260,33 @@ returning the rms of the samples in that window.")
add_help(:moving_rms,
"moving_rms(gen, y) \
-returns the rms of the values in a window over the last few inputs.")
+Returns the rms of the values in a window over the last few inputs.")
def moving_rms(gen, y)
- sqrt(moving_average(gen, y * y))
+ sqrt([0.0, moving_average(gen, y * y)].max)
end
# moving-length generator (euclidean norm or 2-norm)
add_help(:make_moving_length,
"make_moving_length(size=128) \
-returns a moving-length generator. \
+Returns a moving-length generator. \
The generator keeps a running window of the last SIZE inputs, \
returning the euclidean length of the vector in that window.")
- def make_moving_length(size = 128)
- gen = make_moving_average(size)
- gen.increment = 1.0
- gen
- end
+ alias make_moving_length make_moving_sum
add_help(:moving_length,
"moving_length(gen, y) \
-returns the length of the values in a window over the last few inputs.")
- def moving_length(gen, y)
- sqrt(moving_average(gen, y * y))
- end
+Returns the length of the values in a window over the last few inputs.")
+ alias moving_length moving_rms
-
- # harmonicizer (each harmonic is split into a set of harmonics via Chebyshev polynomials)
+ # harmonicizer
+ # (each harmonic is split into a set of harmonics via Chebyshev polynomials)
# obviously very similar to ssb_bank above, but splits harmonics
# individually, rather than pitch-shifting them
add_help(:harmonicizer,
- "harmonicizer(freq, coeffs, pairs, \
-order=40, bw=50.0, beg=0, dur=false, snd=false, chn=false, edpos=false) \
-splits out each harmonic and replaces it with the spectrum given in coeffs")
+ "harmonicizer(freq, coeffs, pairs, order=40, bw=50.0, \
+beg=0, dur=false, snd=false, chn=false, edpos=false) \
+Splits out each harmonic and replaces it with the spectrum given in coeffs.")
def harmonicizer(freq, coeffs, pairs,
order = 40,
bw = 50.0,
@@ -2255,7 +2308,8 @@ splits out each harmonic and replaces it with the spectrum given in coeffs")
bwf = bw * (1.0 + i / (2 * pairs))
peaks[i - 1] = make_moving_max(128)
avgs[i - 1] = make_moving_average(128)
- bands[i - 1] = make_bandpass(hz_to_2pi(aff - bwf), hz_to_2pi(aff + bwf), order)
+ bands[i - 1] = make_bandpass(hz_to_2pi(aff - bwf),
+ hz_to_2pi(aff + bwf), order)
end
as_one_edit_rb do
map_channel_rb(beg, dur, snd, chn, edpos) do |y|
@@ -2287,17 +2341,21 @@ splits out each harmonic and replaces it with the spectrum given in coeffs")
add_help(:linear_src_channel,
"linear_src_channel(sr, snd=false, chn=false) \
-performs sampling rate conversion using linear interpolation.")
+Performs sampling rate conversion using linear interpolation.")
def linear_src_channel(srinc, snd = false, chn = false)
rd = make_sampler(0, snd, chn)
last = rd.call
nxt = rd.call
intrp = 0.0
- tempfile = with_sound(:clm, true, :output, snd_tempnam, :srate, srate()) do
+ tempfile = with_sound(:clm, true,
+ :output, snd_tempnam,
+ :srate, srate(snd)) do
samp = 0
until sampler_at_end?(rd)
if (pos = intrp) >= 1.0
- pos.floor.times do |i| last, nxt = nxt, rd.call end
+ pos.floor.times do |i|
+ last, nxt = nxt, rd.call
+ end
pos -= pos.floor
end
intrp = pos + pos.floor
@@ -2305,12 +2363,15 @@ performs sampling rate conversion using linear interpolation.")
samp += 1
end
end.output
- len = mus_sound_frames(tempfile)
- set_samples(0, len - 1, tempfile, snd, chn, true, "%s(%s", get_func_name, srinc, 0, false, true)
- # first true=truncate to new length, false=at current edpos, true=auto delete temp file
+ len = mus_sound_framples(tempfile)
+ set_samples(0, len - 1, tempfile, snd, chn, true,
+ "%s(%s", get_func_name, srinc, 0, false, true)
+ # first true=truncate to new length, false=at current edpos,
+ # true=auto delete temp file
end
- # Mathews/Smith High-Q filter as described in http://ccrma.stanford.edu/~jos/smac03maxjos/
+ # Mathews/Smith High-Q filter as described in
+ # http://ccrma.stanford.edu/~jos/smac03maxjos/
class Mfilter < Musgen
def initialize(decay, freq)
@@ -2327,7 +2388,8 @@ performs sampling rate conversion using linear interpolation.")
end
def to_s
- format("#<%s decay: %0.3f, frequency: %0.3f>", self.class, @decay, @frequency)
+ format("#<%s decay: %0.3f, frequency: %0.3f>",
+ self.class, @decay, @frequency)
end
def mfilter(x_input = 0.0, y_input = 0.0)
@@ -2337,7 +2399,8 @@ performs sampling rate conversion using linear interpolation.")
end
def make_mfilter(*args)
- Mfilter.new(get_args(args, :decay, 0.99), get_args(args, :frequency, 1000.0))
+ Mfilter.new(get_args(args, :decay, 0.99),
+ get_args(args, :frequency, 1000.0))
end
def mfilter(m, x_input = 0.0, y_input = 0.0)
@@ -2368,7 +2431,9 @@ performs sampling rate conversion using linear interpolation.")
=begin
with_sound(:clm, true, :statistics, true) do
noi = make_rand(10000)
- filters = make_array(9) do make_mfilter(:decay, 0.999, :frequency, 400.0 * (i + 1)) end
+ filters = make_array(9) do
+ make_mfilter(:decay, 0.999, :frequency, 400.0 * (i + 1))
+ end
10000.times do |i|
sum = 0.0
input = 0.01 * rand(noi)
@@ -2392,7 +2457,8 @@ performs sampling rate conversion using linear interpolation.")
def display_bark_fft(snd, chn)
ls = left_sample(snd, chn)
rs = right_sample(snd, chn)
- if (fftlen = (2 ** (log((rs - ls) + 1.0) / log(2.0)).ceil.to_i).to_i) > 0
+ fftlen = (2 ** (log((rs - ls) + 1.0) / log(2.0)).ceil.to_i).to_i
+ if fftlen > 0
data = channel2vct(ls, fftlen, snd, chn)
normalized = (transform_normalization(snd, chn) != Dont_normalize)
linear = true
@@ -2431,18 +2497,30 @@ performs sampling rate conversion using linear interpolation.")
bark_bin = (bark_frqscl * (bark(frq) - bark_low)).round
mel_bin = (mel_frqscl * (mel(frq) - mel_low)).round
erb_bin = (erb_frqscl * (erb(frq) - erb_low)).round
- if bark_bin.between?(0, data_len - 1) then bark_data[bark_bin] += val end
- if mel_bin.between?(0, data_len - 1) then mel_data[mel_bin] += val end
- if erb_bin.between?(0, data_len - 1) then erb_data[erb_bin] += val end
+ if bark_bin.between?(0, data_len - 1)
+ bark_data[bark_bin] += val
+ end
+ if mel_bin.between?(0, data_len - 1)
+ mel_data[mel_bin] += val
+ end
+ if erb_bin.between?(0, data_len - 1)
+ erb_data[erb_bin] += val
+ end
end
if normalized
bmx = bark_data.peak
mmx = mel_data.peak
emx = erb_data.peak
- if (mx - bmx).abs > 0.01 then bark_data.scale!(mx / bmx) end
- if (mx - mmx).abs > 0.01 then mel_data.scale!(mx / mmx) end
- if (mx - emx).abs > 0.01 then erb_data.scale!(mx / emx) end
+ if (mx - bmx).abs > 0.01
+ bark_data.scale!(mx / bmx)
+ end
+ if (mx - mmx).abs > 0.01
+ mel_data.scale!(mx / mmx)
+ end
+ if (mx - emx).abs > 0.01
+ erb_data.scale!(mx / emx)
+ end
end
graph([bark_data, mel_data, erb_data],
"ignored",
@@ -2457,7 +2535,8 @@ performs sampling rate conversion using linear interpolation.")
end
def mark_bark_labels(snd, chn)
- # at this point the x axis has no markings, but there is room for labels and ticks
+ # at this point the x axis has no markings, but there is room
+ # for labels and ticks
old_foreground_color = foreground_color(snd, chn, Copy_context)
# assume at start the foreground color is correct
axinfo = axis_info(snd, chn, Lisp_graph)
@@ -2473,36 +2552,52 @@ performs sampling rate conversion using linear interpolation.")
tick_y0 = axis_y1
minor_y0 = axis_y1 + minor_tick_len
major_y0 = axis_y1 + major_tick_len
- label_pos = (axis_x0 + 0.45 * (axis_x1 - axis_x0)).to_i
bark_label_font = snd_font(3)
bark_numbers_font = snd_font(2)
+ label_pos = (axis_x0 + 0.45 * (axis_x1 - axis_x0)).to_i
+ cr = make_cairo(channel_widgets(snd, chn)[0])
scale_position = lambda do |scale, f|
b20 = scale.call(20.0)
(axis_x0 +
((axis_x1 - axis_x0) * (scale.call(f) - b20)) /
(scale.call(sr2) - b20)).round
end
- bark_position = lambda do |f| scale_position.call(method(:bark).to_proc, f) end
- mel_position = lambda do |f| scale_position.call(method(:mel).to_proc, f) end
- erb_position = lambda do |f| scale_position.call(method(:erb).to_proc, f) end
+ bark_position = lambda do |f|
+ scale_position.call(method(:bark).to_proc, f)
+ end
+ mel_position = lambda do |f|
+ scale_position.call(method(:mel).to_proc, f)
+ end
+ erb_position = lambda do |f|
+ scale_position.call(method(:erb).to_proc, f)
+ end
draw_bark_ticks = lambda do |bark_function|
- if bark_numbers_font then set_current_font(bark_numbers_font, snd, chn, Copy_context) end
- draw_line(axis_x0, tick_y0, axis_x0, major_y0, snd, chn, Copy_context)
- i1000 = scale_position.call(bark_function, 1000.0)
+ if bark_numbers_font
+ set_current_font(bark_numbers_font, snd, chn, Copy_context)
+ end
+ draw_line(axis_x0, tick_y0, axis_x0, major_y0,
+ snd, chn, Copy_context, cr)
+ i1000 = scale_position.call(bark_function, 1000.0)
i10000 = scale_position.call(bark_function, 10000.0)
- draw_line( i1000, tick_y0, i1000, major_y0, snd, chn, Copy_context)
- draw_line(i10000, tick_y0, i10000, major_y0, snd, chn, Copy_context)
- draw_string( "20", axis_x0, major_y0, snd, chn, Copy_context)
- draw_string( "1000", i1000 - 3 * 4, major_y0, snd, chn, Copy_context)
- draw_string("10000", i10000 - 6 * 4, major_y0, snd, chn, Copy_context)
- draw_string("fft size: #{@bark_fft_size}", axis_x0 + 10, axis_y0, snd, chn, Copy_context)
+ draw_line(i1000, tick_y0, i1000, major_y0,
+ snd, chn, Copy_context, cr)
+ draw_line(i10000, tick_y0, i10000, major_y0,
+ snd, chn, Copy_context, cr)
+ draw_string("20", axis_x0, major_y0,
+ snd, chn, Copy_context, cr)
+ draw_string("1000", i1000 - 3 * 4, major_y0,
+ snd, chn, Copy_context, cr)
+ draw_string("10000", i10000 - 6 * 4, major_y0,
+ snd, chn, Copy_context, cr)
+ draw_string("fft size: #{@bark_fft_size}", axis_x0 + 10, axis_y0,
+ snd, chn, Copy_context, cr)
100.step(1000, 100) do |i|
i100 = scale_position.call(bark_function, i)
- draw_line(i100, tick_y0, i100, minor_y0, snd, chn, Copy_context)
+ draw_line(i100, tick_y0, i100, minor_y0, snd, chn, Copy_context, cr)
end
2000.step(10000, 1000) do |i|
i1000 = scale_position.call(bark_function, i)
- draw_line(i1000, tick_y0, i1000, minor_y0, snd, chn, Copy_context)
+ draw_line(i1000, tick_y0, i1000, minor_y0, snd, chn, Copy_context, cr)
end
end
@@ -2510,35 +2605,44 @@ performs sampling rate conversion using linear interpolation.")
if self.bark_tick_function.zero?
draw_bark_ticks.call(bark_position)
end
- if bark_label_font then set_current_font(bark_label_font, snd, chn, Copy_context) end
- draw_string("bark,", label_pos, axis_y1 + label_height, snd, chn, Copy_context)
-
+ if bark_label_font
+ set_current_font(bark_label_font, snd, chn, Copy_context)
+ end
+ draw_string("bark,", label_pos, axis_y1 + label_height,
+ snd, chn, Copy_context, cr)
# mel label/ticks
set_foreground_color(snd_color(2), snd, chn, Copy_context)
if self.bark_tick_function == 1
draw_bark_ticks.call(mel_position)
end
- if bark_label_font then set_current_font(bark_label_font, snd, chn, Copy_context) end
+ if bark_label_font
+ set_current_font(bark_label_font, snd, chn, Copy_context)
+ end
draw_string("mel,", char_width * 6 + label_pos, axis_y1 + label_height,
- snd, chn, Copy_context)
-
+ snd, chn, Copy_context, cr)
# erb label/ticks
set_foreground_color(snd_color(4), snd, chn, Copy_context)
if self.bark_tick_function == 2
draw_bark_ticks.call(erb_position)
end
- if bark_label_font then set_current_font(bark_label_font, snd, chn, Copy_context) end
- draw_string("erb", char_width * (6 + 5) + label_pos, axis_y1 + label_height,
- snd, chn, Copy_context)
-
+ if bark_label_font
+ set_current_font(bark_label_font, snd, chn, Copy_context)
+ end
+ draw_string("erb",
+ char_width * (6 + 5) + label_pos,
+ axis_y1 + label_height,
+ snd, chn, Copy_context, cr)
set_foreground_color(old_foreground_color, snd, chn, Copy_context)
+ free_cairo(cr)
end
# mouse click = move to next scale's ticks
def choose_bark_ticks(snd, chn, button, state, x, y, axis)
if axis == Lisp_graph
@bark_tick_function += 1
- if @bark_tick_function > 2 then @bark_tick_function = 0 end
+ if @bark_tick_function > 2
+ @bark_tick_function = 0
+ end
update_lisp_graph(snd, chn)
end
end
@@ -2557,6 +2661,7 @@ performs sampling rate conversion using linear interpolation.")
43.0 + 11.17 * log((f + 312.0) / (f + 14675.0))
end
end
+
# user's view of display-bark-fft function
def display_bark_fft(off = false)
if off.kind_of?(FalseClass)
@@ -2567,18 +2672,22 @@ performs sampling rate conversion using linear interpolation.")
$after_lisp_graph_hook.add_hook!("make-bark-label") do |snd, chn|
db.mark_bark_labels(snd, chn)
end
- $mouse_click_hook.add_hook!("choose-bark-ticks") do |snd, chn, button, state, x, y, axis|
- db.choose_bark_ticks(snd, chn, button, state, x, y, axis)
+ $mouse_click_hook.add_hook!("choose-bark-ticks") do |s, c, b, st, x, y, a|
+ db.choose_bark_ticks(s, c, b, st, x, y, a)
end
Snd.sounds.each do |snd|
- channels(snd).times do |chn| update_lisp_graph(snd, chn) end
+ channels(snd).times do |chn|
+ update_lisp_graph(snd, chn)
+ end
end
else
$lisp_graph_hook.remove_hook!("display-bark-fft")
$after_lisp_graph_hook.remove_hook!("make-bark-label")
$mouse_click_hook.remove_hook!("choose-bark-ticks")
Snd.sounds.each do |snd|
- channels(snd).times do |chn| set_lisp_graph?(false, snd, chn) end
+ channels(snd).times do |chn|
+ set_lisp_graph?(false, snd, chn)
+ end
end
end
off
diff --git a/dsp.scm b/dsp.scm
index 54639d9..49ca44a 100644
--- a/dsp.scm
+++ b/dsp.scm
@@ -1,34 +1,58 @@
;;; a DSP-related grabbag
(provide 'snd-dsp.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-(if (not (provided? 'snd-generators.scm)) (load "generators.scm")) ; moving-*
-
-(define (log10 a)
- "(log10 a) returns the log base 10 of 'a'"
- (log a 10))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(require snd-env.scm)
+
+(when (provided? 'pure-s7)
+ (define (make-polar mag ang)
+ (if (and (real? mag) (real? ang))
+ (complex (* mag (cos ang)) (* mag (sin ang)))
+ (error 'wrong-type-arg "make-polar args should be real"))))
+
+
+(define binomial
+ (let ((documentation "(binomial n k) computes the binomial coefficient C(N,K)"))
+ (lambda (n k)
+ (let ((mn (min k (- n k))))
+ (if (< mn 0)
+ 0
+ (if (= mn 0)
+ 1
+ (let* ((mx (max k (- n k)))
+ (cnk (+ 1 mx)))
+ (do ((i 2 (+ 1 i)))
+ ((> i mn) cnk)
+ (set! cnk (/ (* cnk (+ mx i)) i))))))))))
+
+(define log10
+ (let ((documentation "(log10 a) returns the log base 10 of 'a'"))
+ (lambda (a)
+ (log a 10))))
;;; src-duration (see src-channel in extsnd.html)
-(define (src-duration e)
- "(src-duration envelope) returns the new duration of a sound after using 'envelope' for time-varying sampling-rate conversion"
- (let* ((len (length e))
- (ex0 (e 0))
- (ex1 (e (- len 2)))
- (all-x (- ex1 ex0))
- (dur 0.0))
- (do ((i 0 (+ i 2)))
- ((>= i (- len 2)) dur)
- (let* ((x0 (e i))
- (x1 (e (+ i 2)))
- (y0 (e (+ i 1))) ; 1/x x points
- (y1 (e (+ i 3)))
- (area (if (< (abs (- y0 y1)) .0001)
- (/ (- x1 x0) (* y0 all-x))
- (* (/ (- (log y1) (log y0))
- (- y1 y0))
- (/ (- x1 x0) all-x)))))
- (set! dur (+ dur (abs area)))))))
+(define src-duration
+ (let ((documentation "(src-duration envelope) returns the new duration of a sound after using 'envelope' for time-varying sampling-rate conversion"))
+ (lambda (e)
+ (let* ((len (length e))
+ (ex0 (e 0))
+ (ex1 (e (- len 2)))
+ (all-x (- ex1 ex0))
+ (dur 0.0))
+ (do ((i 0 (+ i 2)))
+ ((>= i (- len 2)) dur)
+ (let* ((x0 (e i))
+ (x1 (e (+ i 2)))
+ (y0 (e (+ i 1))) ; 1/x x points
+ (y1 (e (+ i 3)))
+ (area (if (< (abs (- y0 y1)) .0001)
+ (/ (- x1 x0) (* y0 all-x))
+ (* (/ (- (log y1) (log y0)) (- y1 y0)) ; or (/ (log (/ y1 y0)) (- y1 y0))
+ (/ (- x1 x0) all-x)))))
+ (set! dur (+ dur (abs area)))))))))
;;; :(src-duration '(0 1 1 2))
;;; 0.69314718055995
@@ -44,118 +68,121 @@
;;; formula taken from Richard Lyons, "Understanding DSP"
;;; see clm.c for C version (using either GSL's or GCC's complex trig functions)
-(define (dolph N gamma)
- "(dolph n gamma) produces a Dolph-Chebyshev FFT data window of 'n' points using 'gamma' as the window parameter."
- (let* ((alpha (cosh (/ (acosh (expt 10.0 gamma)) N)))
- (den (/ 1.0 (cosh (* N (acosh alpha)))))
- (freq (/ pi N))
- (rl (make-vct N))
- (im (make-vct N)))
- (do ((i 0 (+ i 1))
- (phase 0.0 (+ phase freq)))
- ((= i N))
- (let ((val (* den (cos (* N (acos (* alpha (cos phase))))))))
- (set! (rl i) (real-part val))
- (set! (im i) (imag-part val)))) ;this is actually always essentially 0.0
- (fft rl im -1) ;direction could also be 1
- (let ((pk (vct-peak rl)))
- (vct-scale! rl (/ 1.0 pk)))
- (do ((i 0 (+ i 1))
- (j (/ N 2)))
- ((= i N))
- (set! (im i) (rl j))
- (set! j (+ j 1))
- (if (= j N) (set! j 0)))
- im))
+(define dolph
+ (let ((documentation "(dolph n gamma) produces a Dolph-Chebyshev FFT data window of 'n' points using 'gamma' as the window parameter."))
+ (lambda (N gamma)
+ (let* ((alpha (cosh (/ (acosh (expt 10.0 gamma)) N)))
+ (den (/ 1.0 (cosh (* N (acosh alpha)))))
+ (freq (/ pi N))
+ (rl (make-float-vector N))
+ (im (make-float-vector N)))
+ (do ((i 0 (+ i 1))
+ (phase 0.0 (+ phase freq)))
+ ((= i N))
+ (let ((val (* den (cos (* N (acos (* alpha (cos phase))))))))
+ (set! (rl i) (real-part val))
+ (set! (im i) (imag-part val)))) ;this is always essentially 0.0
+ (fft rl im -1) ;direction could also be 1
+ (let ((pk (float-vector-peak rl)))
+ (float-vector-scale! rl (/ 1.0 pk)))
+ (do ((i 0 (+ i 1))
+ (j (/ N 2)))
+ ((= i N))
+ (set! (im i) (rl j))
+ (set! j (+ j 1))
+ (if (= j N) (set! j 0)))
+ im))))
;;; this version taken from Julius Smith's "Spectral Audio..." with three changes
-;;; it does the DFT by hand, and is independent of anything from Snd (fft, vcts etc)
-
-(define (dolph-1 N gamma)
- "(dolph-1 n gamma) produces a Dolph-Chebyshev FFT data window of 'n' points using 'gamma' as the window parameter."
- (let* ((alpha (cosh (/ (acosh (expt 10.0 gamma)) N)))
- (den (/ 1.0 (cosh (* N (acosh alpha)))))
- (freq (/ pi N))
- (vals (make-vector N))
- (w (make-vector N))
- (pk 0.0)
- (mult -1))
- (do ((i 0 (+ i 1))
- (phase (- (/ pi 2)) (+ phase freq)))
- ((= i N))
- (set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))
- (set! mult (* -1 mult)))
- ;; now take the DFT
- (do ((i 0 (+ i 1)))
- ((= i N))
- (let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k N))
- (set! sum (+ sum (* (vals k) (exp (/ (* 2.0 0+1.0i pi k i) N))))))
- (set! (w i) (magnitude sum))
- (if (> (w i) pk) (set! pk (w i)))))
- ;; scale to 1.0 (it's usually pretty close already, that is pk is close to 1.0)
- (do ((i 0 (+ i 1)))
- ((= i N))
- (set! (w i) (/ (w i) pk)))
- w))
+;;; it does the DFT by hand, and is independent of anything from Snd (fft, float-vectors etc)
+
+(define dolph-1
+ (let ((documentation "(dolph-1 n gamma) produces a Dolph-Chebyshev FFT data window of 'n' points using 'gamma' as the window parameter."))
+ (lambda (N gamma)
+ (let* ((alpha (cosh (/ (acosh (expt 10.0 gamma)) N)))
+ (den (/ 1.0 (cosh (* N (acosh alpha)))))
+ (freq (/ pi N))
+ (vals (make-vector N))
+ (w (make-vector N))
+ (pk 0.0)
+ (mult -1))
+ (do ((i 0 (+ i 1))
+ (phase (* -0.5 pi) (+ phase freq)))
+ ((= i N))
+ (set! (vals i) (* mult den (cos (* N (acos (* alpha (cos phase)))))))
+ (set! mult (- mult)))
+ ;; now take the DFT
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (let ((sum 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k N))
+ (set! sum (+ sum (* (vals k) (exp (/ (* 2.0 0+1.0i pi k i) N))))))
+ (set! (w i) (magnitude sum))
+ (if (> (w i) pk) (set! pk (w i)))))
+ ;; scale to 1.0 (it's usually pretty close already, that is pk is close to 1.0)
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (set! (w i) (/ (w i) pk)))
+ w))))
;;; -------- move sound down by n (a power of 2)
-(define* (down-oct n snd chn)
- "(down-n n) moves a sound down by power of 2 n"
- ;; I think this is "stretch" in DSP jargon -- to interpolate in the time domain we're squeezing the frequency domain
- ;; the power-of-2 limitation is based on the underlying fft function's insistence on power-of-2 data sizes
- ;; see stretch-sound-via-dft below for a general version
- (let* ((len (frames snd chn))
- (pow2 (ceiling (/ (log len) (log 2))))
- (fftlen (floor (expt 2 pow2)))
- (fftscale (/ 1.0 fftlen))
- (rl1 (channel->vct 0 fftlen snd chn))
- (im1 (make-vct fftlen)))
- (fft rl1 im1 1)
- (vct-scale! rl1 fftscale)
- (vct-scale! im1 fftscale)
- (let ((rl2 (make-vct (* n fftlen)))
- (im2 (make-vct (* n fftlen))))
- (set! (rl2 0) (rl1 0))
- (set! (im2 0) (im1 0))
- (do ((i 1 (+ i 1)) ; lower half
- (k (- fftlen 1) (- k 1))
- (j (- (* n fftlen) 1) (- j 1)))
- ((= i (/ fftlen 2)))
- (set! (rl2 i) (rl1 i))
- (set! (rl2 j) (rl1 k))
- (set! (im2 i) (im1 i))
- (set! (im2 j) (im1 k)))
- (fft rl2 im2 -1)
- (vct->channel rl2 0 (* n len) snd chn #f (format #f "down-oct ~A" n)))))
-
-(define* (stretch-sound-via-dft factor snd chn)
- "(stretch-sound-via-dft factor snd chn) makes the given channel longer ('factor' should be > 1.0) by \
-squeezing in the frequency domain, then using the inverse DFT to get the time domain result."
- ;; this is very slow! factor>1.0
- (let* ((n (frames snd chn))
- (n2 (floor (/ n 2.0)))
- (out-n (round (* n factor)))
- (in-data (channel->vct 0 n snd chn))
- (out-data (make-vct out-n))
- (fr (make-vector out-n 0.0))
- (freq (/ (* 2 pi) n)))
- (do ((i 0 (+ i 1)))
- ((= i n))
- ;; DFT + split
- (if (< i n2)
- (set! (fr i) (edot-product (* freq 0.0-1.0i i) in-data))
- (set! (fr (+ i (- out-n n 1))) (edot-product (* freq 0.0-1.0i i) in-data))))
- (set! freq (/ (* 2 pi) out-n))
- (do ((i 0 (+ i 1)))
- ((= i out-n))
- ;; inverse DFT
- (set! (out-data i) (real-part (/ (edot-product (* freq 0.0+1.0i i) fr) n))))
- (vct->channel out-data 0 out-n snd chn #f (format #f "stretch-sound-via-dft ~A" factor))))
+(define down-oct
+ (let ((documentation "(down-n n) moves a sound down by n-1 octaves"))
+ (lambda* (n snd chn)
+ ;; I think this is "stretch" in DSP jargon -- to interpolate in the time domain we're squeezing the frequency domain
+ ;; the power-of-2 limitation is based on the underlying fft function's insistence on power-of-2 data sizes
+ ;; see stretch-sound-via-dft below for a general version
+ (let* ((len (framples snd chn))
+ (pow2 (ceiling (log len 2)))
+ (fftlen (floor (expt 2 pow2)))
+ (fftlen2 (/ fftlen 2))
+ (fft-1 (- (* n fftlen) 1))
+ (fftscale (/ 1.0 fftlen))
+ (rl1 (channel->float-vector 0 fftlen snd chn))
+ (im1 (make-float-vector fftlen)))
+ (fft rl1 im1 1)
+ (float-vector-scale! rl1 fftscale)
+ (float-vector-scale! im1 fftscale)
+ (let ((rl2 (make-float-vector (* n fftlen)))
+ (im2 (make-float-vector (* n fftlen))))
+ (copy rl1 rl2 0 fftlen2)
+ (copy im1 im2 0 fftlen2)
+ (do ((k (- fftlen 1) (- k 1))
+ (j fft-1 (- j 1)))
+ ((= k fftlen2))
+ (float-vector-set! rl2 j (float-vector-ref rl1 k))
+ (float-vector-set! im2 j (float-vector-ref im1 k)))
+ (fft rl2 im2 -1)
+ (float-vector->channel rl2 0 (* n len) snd chn #f (format #f "down-oct ~A" n)))))))
+
+(define stretch-sound-via-dft
+ (let ((documentation "(stretch-sound-via-dft factor snd chn) makes the given channel longer ('factor' should be > 1.0) by \
+squeezing in the frequency domain, then using the inverse DFT to get the time domain result."))
+ (lambda* (factor snd chn)
+ ;; this is very slow! factor>1.0
+ (let* ((n (framples snd chn))
+ (n2 (floor (/ n 2.0)))
+ (out-n (round (* n factor)))
+ (in-data (channel->float-vector 0 n snd chn))
+ (out-data (make-float-vector out-n))
+ (fr (make-vector out-n 0.0))
+ (freq (/ (* 2 pi) n)))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ ;; DFT + split
+ (if (< i n2)
+ (set! (fr i) (edot-product (* freq 0.0-1.0i i) in-data))
+ (set! (fr (+ i (- out-n n 1))) (edot-product (* freq 0.0-1.0i i) in-data))))
+ (set! freq (/ (* 2 pi) out-n))
+ (do ((i 0 (+ i 1)))
+ ((= i out-n))
+ ;; inverse DFT
+ (set! (out-data i) (real-part (/ (edot-product (* freq 0.0+1.0i i) fr) n))))
+ (float-vector->channel out-data 0 out-n snd chn #f (format #f "stretch-sound-via-dft ~A" factor))))))
@@ -166,9 +193,10 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
;;; the time domain display (to give our graph all the window -- to do this in a much more
;;; elegant manner, see snd-motif.scm under scanned-synthesis).
-(define compute-uniform-circular-string
+#|
+(define old-compute-uniform-circular-string
(lambda (size x0 x1 x2 mass xspring damp)
- (define circle-vct-ref
+ (define circle-ref
(lambda (v i)
(if (< i 0)
(v (+ size i))
@@ -184,57 +212,71 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(do ((i 0 (+ i 1)))
((= i size))
(set! (x0 i) (+ (* p1 (x1 i))
- (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
+ (* p2 (+ (circle-ref x1 (- i 1)) (circle-ref x1 (+ i 1))))
(* p3 (x2 i)))))
- (vct-fill! x2 0.0)
- (vct-add! x2 x1)
- (vct-fill! x1 0.0)
- (vct-add! x1 x0))))
+ (copy x1 x2)
+ (copy x0 x1))))
-(define compute-string
+;;; (compute-uniform-circular-string 100 (make-float-vector 100) (make-float-vector 100) (make-float-vector 100) .5 .5 .5)
+|#
+
+(define (compute-uniform-circular-string size x0 x1 x2 mass xspring damp)
+ (let* ((dm (/ damp mass))
+ (km (/ xspring mass))
+ (denom (+ 1.0 dm))
+ (p2 (/ km denom))
+ (s1 (- size 1)))
+ (float-vector-scale! x2 (/ -1.0 denom))
+ (copy x1 x0)
+ (float-vector-scale! x0 (/ (+ 2.0 (- dm (* 2.0 km))) denom))
+ (float-vector-add! x0 x2)
+ (set! (x0 0) (+ (x0 0) (* p2 (+ (x1 s1) (x1 1)))))
+ (do ((i 1 (+ i 1)))
+ ((= i s1))
+ (float-vector-set! x0 i (+ (float-vector-ref x0 i) (* p2 (+ (float-vector-ref x1 (- i 1)) (float-vector-ref x1 (+ i 1)))))))
+ (set! (x0 s1) (+ (x0 s1) (* p2 (+ (x1 (- s1 1)) (x1 0)))))
+ (copy x1 x2)
+ (copy x0 x1)))
+
+(define (compute-string size x0 x1 x2 masses xsprings esprings damps haptics)
;; this is the more general form
- (lambda (size x0 x1 x2 masses xsprings esprings damps haptics)
- (define circle-vct-ref
- (lambda (v i)
- (if (< i 0)
- (v (+ size i))
- (if (>= i size)
- (v (- i size))
- (v i)))))
- (do ((i 0 (+ i 1)))
- ((= i size))
- (let* ((dm (/ (damps i) (masses i)))
- (km (/ (xsprings i) (masses i)))
- (cm (/ (esprings i) (masses i)))
- (denom (+ 1.0 dm cm))
- (p1 (/ (+ 2.0 (- dm (* 2.0 km))) denom))
- (p2 (/ km denom))
- (p3 (/ -1.0 denom))
- (p4 (/ (haptics i) (* (masses i) denom))))
- (set! (x0 i) (+ (* p1 (x1 i))
- (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
- (* p3 (x2 i))
- p4))))
- (do ((i 0 (+ i 1)))
- ((= i size))
- (set! (x2 i) (x1 i))
- (set! (x1 i) (x0 i)))))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (let ((mass (masses i)))
+ (let ((dm (/ (damps i) mass))
+ (km (/ (xsprings i) mass))
+ (cm (/ (esprings i) mass)))
+ (let ((denom (+ 1.0 dm cm)))
+ (let ((p1 (/ (+ 2.0 (- dm (* 2.0 km))) denom))
+ (p2 (/ km denom))
+ (p3 (/ -1.0 denom))
+ (p4 (/ (haptics i) (* mass denom)))
+ (j (if (= i 0) size (- i 1)))
+ (k (if (= i (- size 1)) 0 (+ i 1))))
+ (set! (x0 i) (+ (* p1 (x1 i))
+ (* p2 (+ (x1 j) (x1 k)))
+ (* p3 (x2 i))
+ p4)))))))
+ (copy x1 x2)
+ (copy x0 x1))
;;; -------- "frequency division" -- an effect from sed_sed at my-dejanews.com
-(define* (freqdiv n snd chn)
- "(freqdiv n) repeats each nth sample n times (clobbering the intermediate samples): (freqdiv 8)"
- (let ((div 0)
- (curval 0.0))
- (map-channel (lambda (val)
- (if (= div 0)
- (set! curval val))
- (set! div (+ 1 div))
- (if (= div n) (set! div 0))
- curval)
- 0 #f snd chn #f (format #f "freqdiv ~A" n))))
-
+(define freqdiv
+ (let ((documentation "(freqdiv n snd chn) repeats each nth sample n times (clobbering the intermediate samples): (freqdiv 8)"))
+ (lambda* (n snd chn)
+ (let* ((data (channel->float-vector 0 #f snd chn))
+ (len (length data)))
+ (if (> n 1)
+ (do ((i 0 (+ i n)))
+ ((>= i len)
+ (float-vector->channel data 0 len snd chn))
+ (let ((val (data i))
+ (stop (min len (+ i n))))
+ (do ((k (+ i 1) (+ k 1)))
+ ((= k stop))
+ (float-vector-set! data k val)))))))))
;;; -------- "adaptive saturation" -- an effect from sed_sed at my-dejanews.com
@@ -242,50 +284,66 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
;;; a more extreme effect is "saturation":
;;; (map-channel (lambda (val) (if (< (abs val) .1) val (if (>= val 0.0) 0.25 -0.25))))
-(define* (adsat size beg dur snd chn)
- "(adsat size) is an 'adaptive saturation' sound effect"
- (let* ((mn 0.0)
- (mx 0.0)
- (n 0)
- (vals (make-vct size)))
- (map-channel (lambda (val)
- (if (= n size)
- (begin
- (do ((i 0 (+ i 1)))
- ((= i size))
- (if (>= (vals i) 0.0)
- (set! (vals i) mx)
- (set! (vals i) mn)))
- (set! n 0)
- (set! mx 0.0)
- (set! mn 0.0)
- vals)
- (begin
- (set! (vals n) val)
- (if (> val mx) (set! mx val))
- (if (< val mn) (set! mn val))
- (set! n (+ 1 n))
- #f)))
- beg dur snd chn #f (format #f "adsat ~A ~A ~A" size beg dur))))
+(define adsat
+ (let ((documentation "(adsat size beg dur snd chn) is an 'adaptive saturation' sound effect"))
+ (lambda* (size (beg 0) dur snd chn)
+ (let* ((len (if (number? dur) dur (- (framples snd chn) beg)))
+ (data (make-float-vector (* size (ceiling (/ len size))))))
+ (let ((reader (make-sampler beg snd chn))
+ (mn 0.0)
+ (mx 0.0)
+ (vals (make-float-vector size)))
+ (do ((i 0 (+ i size)))
+ ((>= i len))
+ (do ((k 0 (+ k 1)))
+ ((= k size))
+ (float-vector-set! vals k (next-sample reader)))
+ (set! mn (float-vector-min vals))
+ (set! mx (float-vector-max vals))
+ (do ((k 0 (+ k 1)))
+ ((= k size))
+ (if (negative? (float-vector-ref vals k))
+ (float-vector-set! data (+ i k) mn)
+ (float-vector-set! data (+ i k) mx))))
+ (float-vector->channel data beg len snd chn current-edit-position (format #f "adsat ~A ~A ~A" size beg dur)))))))
;;; -------- spike
;;;
;;; makes sound more spikey -- sometimes a nice effect
-(define* (spike snd chn)
- "(spike) multiplies successive samples together to make a sound more spikey"
- (map-channel (let ((x1 0.0)
- (x2 0.0)
- (amp (maxamp snd chn))) ; keep resultant peak at maxamp
- (lambda (x0)
- (let ((res (* (/ x0 (* amp amp))
- (abs x2)
- (abs x1))))
- (set! x2 x1)
- (set! x1 x0)
- res)))
- 0 #f snd chn #f "spike"))
+#|
+(define spike
+ (let ((documentation "(spike snd chn) multiplies successive samples together to make a sound more spikey"))
+ (lambda* (snd chn)
+ (let* ((len (framples snd chn))
+ (data (make-float-vector len))
+ (amp (maxamp snd chn))) ; keep resultant peak at maxamp
+ (let ((reader (make-sampler 0 snd chn))
+ (x1 0.0)
+ (x2 0.0)
+ (amp1 (/ 1.0 (* amp amp))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((x0 (next-sample reader)))
+ (float-vector-set! data i (* x0 x1 x2))
+ (set! x2 x1)
+ (set! x1 (abs x0))))
+ (float-vector->channel (float-vector-scale! data amp1) 0 len snd chn current-edit-position "spike"))))))
+|#
+(define spike
+ (let ((documentation "(spike snd chn) multiplies successive samples together to make a sound more spikey"))
+ (lambda* (snd chn)
+ (let* ((len (framples snd chn))
+ (data (channel->float-vector 0 (+ len 2) snd chn))
+ (amp (maxamp snd chn))) ; keep resultant peak at maxamp
+ ;; multiply x[0]*x[1]*x[2]
+ (let ((data1 (make-float-vector (+ len 1))))
+ (copy data data1 1)
+ (float-vector-abs! (float-vector-multiply! data1 data))
+ (float-vector-multiply! data (make-shared-vector data1 (list len) 1))
+ (let ((amp1 (/ amp (float-vector-peak data))))
+ (float-vector->channel (float-vector-scale! data amp1) 0 len snd chn current-edit-position "spike")))))))
;;; the more successive samples we include in the product, the more we
;;; limit the output to pulses placed at (just after) wave peaks
@@ -294,24 +352,20 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
;;; -------- easily-fooled autocorrelation-based pitch tracker
(define spot-freq
- (lambda args
- "(spot-freq samp snd chn) tries to determine the current pitch: (spot-freq (left-sample))"
- (let* ((s0 (car args))
- (snd (if (> (length args) 1) (args 1) #f))
- (chn (if (> (length args) 2) (args 2) #f))
- (pow2 (ceiling (/ (log (/ (srate snd) 20.0)) (log 2))))
- (fftlen (floor (expt 2 pow2)))
- (data (autocorrelate (channel->vct s0 fftlen snd chn)))
- (cor-peak (vct-peak data)))
- (if (= cor-peak 0.0)
- 0.0
- (call-with-exit
- (lambda (return)
- (do ((i 1 (+ i 1)))
- ((= i (- fftlen 2)) 0)
- (if (and (< (data i) (data (+ i 1)))
- (> (data (+ i 1)) (data (+ i 2))))
- (begin
+ (let ((documentation "(spot-freq samp snd chn) tries to determine the current pitch: (spot-freq (left-sample))"))
+ (lambda* (s0 snd chn)
+ (let* ((pow2 (ceiling (log (/ (srate snd) 20.0) 2)))
+ (fftlen (floor (expt 2 pow2)))
+ (data (autocorrelate (channel->float-vector s0 fftlen snd chn)))
+ (cor-peak (float-vector-peak data)))
+ (if (= cor-peak 0.0)
+ 0.0
+ (call-with-exit
+ (lambda (return)
+ (do ((i 1 (+ i 1)))
+ ((= i (- fftlen 2)) 0)
+ (if (and (< (data i) (data (+ i 1)))
+ (> (data (+ i 1)) (data (+ i 2))))
(let* ((logla (log10 (/ (+ cor-peak (data i)) (* 2 cor-peak))))
(logca (log10 (/ (+ cor-peak (data (+ i 1))) (* 2 cor-peak))))
(logra (log10 (/ (+ cor-peak (data (+ i 2))) (* 2 cor-peak))))
@@ -320,9 +374,9 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(return (/ (srate snd)
(* 2 (+ i 1 offset))))))))))))))
-;(hook-push graph-hook
-; (lambda (snd chn y0 y1)
-; (report-in-minibuffer (format #f "~A" (spot-freq (left-sample))))))
+ ;(hook-push graph-hook
+ ; (lambda (hook)
+ ; (status-report (format #f "~A" (spot-freq (left-sample))))))
@@ -332,28 +386,29 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define chorus-amount 20.0)
(define chorus-speed 10.0)
-(define (chorus)
- "(chorus) tries to produce the chorus sound effect"
- (define (make-flanger)
- (let* ((ri (make-rand-interp :frequency chorus-speed :amplitude chorus-amount))
- (len (floor (random (* 3.0 chorus-time (srate)))))
- (gen (make-delay len :max-size (+ len chorus-amount 1))))
- (list gen ri)))
- (define (flanger dly inval)
- (+ inval
- (delay (car dly)
- inval
- (rand-interp (cadr dly)))))
- (let ((dlys (make-vector chorus-size)))
- (do ((i 0 (+ i 1)))
- ((= i chorus-size))
- (set! (dlys i) (make-flanger)))
- (lambda (inval)
- (do ((sum 0.0)
- (i 0 (+ i 1)))
- ((= i chorus-size)
- (* .25 sum))
- (set! sum (+ sum (flanger (dlys i) inval)))))))
+(define chorus
+ (let ((documentation "(chorus) tries to produce the chorus sound effect"))
+ (lambda ()
+ (define (make-flanger)
+ (let* ((ri (make-rand-interp :frequency chorus-speed :amplitude chorus-amount))
+ (len (floor (random (* 3.0 chorus-time (srate)))))
+ (gen (make-delay len :max-size (+ len chorus-amount 1))))
+ (list gen ri)))
+ (define (flanger dly inval)
+ (+ inval
+ (delay (car dly)
+ inval
+ (rand-interp (cadr dly)))))
+ (let ((dlys (make-vector chorus-size)))
+ (do ((i 0 (+ i 1)))
+ ((= i chorus-size))
+ (set! (dlys i) (make-flanger)))
+ (lambda (inval)
+ (do ((sum 0.0)
+ (i 0 (+ i 1)))
+ ((= i chorus-size)
+ (* .25 sum))
+ (set! sum (+ sum (flanger (dlys i) inval)))))))))
;;; -------- chordalize (comb filters to make a chord using chordalize-amount and chordalize-base)
@@ -361,74 +416,78 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define chordalize-base 100)
(define chordalize-chord '(1 3/4 5/4))
-(define (chordalize)
- "(chordalize) uses harmonically-related comb-filters to bring out a chord in a sound"
- ;; chord is a list of members of chord such as '(1 5/4 3/2)
- (let ((combs (map (lambda (interval)
- (make-comb chordalize-amount (floor (* chordalize-base interval))))
- chordalize-chord))
- (scaler (/ 0.5 (length chordalize-chord)))) ; just a guess -- maybe this should rescale to old maxamp
- (lambda (x)
- (* scaler (apply + (map (lambda (c) (comb c x)) combs))))))
+(define chordalize
+ (let ((documentation "(chordalize) uses harmonically-related comb-filters to bring out a chord in a sound"))
+ (lambda ()
+ ;; chord is a list of members of chord such as '(1 5/4 3/2)
+ (let ((combs (make-comb-bank (apply vector (map (lambda (interval)
+ (make-comb chordalize-amount (floor (* chordalize-base interval))))
+ chordalize-chord))))
+ (scaler (/ 0.5 (length chordalize-chord)))) ; just a guess -- maybe this should rescale to old maxamp
+ (lambda (x)
+ (* scaler (comb-bank combs x)))))))
;;; -------- zero-phase, rotate-phase
;;; fft games (from the "phazor" package of Scott McNab)
-(define* (zero-phase snd chn)
- "(zero-phase) calls fft, sets all phases to 0, and un-ffts"
- (let* ((len (frames snd chn))
- (pow2 (ceiling (/ (log len) (log 2))))
- (fftlen (floor (expt 2 pow2)))
- (fftscale (/ 1.0 fftlen))
- (rl (channel->vct 0 fftlen snd chn))
- (old-pk (vct-peak rl))
- (im (make-vct fftlen)))
- (if (> old-pk 0.0)
- (begin
- (fft rl im 1)
- (rectangular->magnitudes rl im)
- (vct-scale! rl fftscale)
- (vct-scale! im 0.0)
- (fft rl im -1)
- (let ((pk (vct-peak rl)))
- (vct->channel (vct-scale! rl (/ old-pk pk)) 0 len snd chn #f "zero-phase"))))))
-
-(define* (rotate-phase func snd chn)
- "(rotate-phase func) calls fft, applies func to each phase, then un-ffts"
- (let* ((len (frames snd chn))
- (pow2 (ceiling (/ (log len) (log 2))))
- (fftlen (floor (expt 2 pow2)))
- (fftlen2 (floor (/ fftlen 2)))
- (fftscale (/ 1.0 fftlen))
- (rl (channel->vct 0 fftlen snd chn))
- (old-pk (vct-peak rl))
- (im (make-vct fftlen)))
- (if (> old-pk 0.0)
- (begin
- (fft rl im 1)
- (rectangular->magnitudes rl im)
- (vct-scale! rl fftscale)
- (set! (im 0) 0.0)
- (do ((i 1 (+ i 1))
- (j (- fftlen 1) (- j 1)))
- ((= i fftlen2))
- ;; rotate the fft vector by func, keeping imaginary part complex conjgate of real
- (set! (im i) (func (im i)))
- (set! (im j) (- (im i))))
- (polar->rectangular rl im)
- (fft rl im -1)
- (let ((pk (vct-peak rl)))
- (vct->channel (vct-scale! rl (/ old-pk pk)) 0 len snd chn #f
- (format #f "rotate-phase ~A" (procedure-source func))))))))
-
-;(rotate-phase (lambda (x) 0.0)) is the same as (zero-phase)
-;(rotate-phase (lambda (x) (random pi))) randomizes phases
-;(rotate-phase (lambda (x) x)) returns original
-;(rotate-phase (lambda (x) (- x))) reverses original (might want to write fftlen samps here)
-;(rotate-phase (lambda (x) (* x 2))) reverb-effect (best with voice)
-;(rotate-phase (lambda (x) (* x 12)) "bruise blood" effect
+(define zero-phase
+ (let ((documentation "(zero-phase snd chn) calls fft, sets all phases to 0, and un-ffts"))
+ (lambda* (snd chn)
+ (let* ((len (framples snd chn))
+ (pow2 (ceiling (log len 2)))
+ (fftlen (floor (expt 2 pow2)))
+ (fftscale (/ 1.0 fftlen))
+ (rl (channel->float-vector 0 fftlen snd chn))
+ (old-pk (float-vector-peak rl))
+ (im (make-float-vector fftlen)))
+ (if (> old-pk 0.0)
+ (begin
+ (fft rl im 1)
+ (rectangular->magnitudes rl im)
+ (float-vector-scale! rl fftscale)
+ (float-vector-scale! im 0.0)
+ (fft rl im -1)
+ (let ((pk (float-vector-peak rl)))
+ (float-vector->channel (float-vector-scale! rl (/ old-pk pk)) 0 len snd chn #f "zero-phase"))))))))
+
+(define rotate-phase
+ (let ((documentation "(rotate-phase func snd chn) calls fft, applies func to each phase, then un-ffts"))
+ (lambda* (func snd chn)
+ (let* ((len (framples snd chn))
+ (pow2 (ceiling (log len 2)))
+ (fftlen (floor (expt 2 pow2)))
+ (fftlen2 (floor (/ fftlen 2)))
+ (fftscale (/ 1.0 fftlen))
+ (rl (channel->float-vector 0 fftlen snd chn))
+ (old-pk (float-vector-peak rl))
+ (im (make-float-vector fftlen)))
+ (if (> old-pk 0.0)
+ (begin
+ (fft rl im 1)
+ (rectangular->magnitudes rl im)
+ (float-vector-scale! rl fftscale)
+ (set! (im 0) 0.0)
+ (do ((i 1 (+ i 1))
+ (j (- fftlen 1) (- j 1)))
+ ((= i fftlen2))
+ ;; rotate the fft vector by func, keeping imaginary part complex conjgate of real
+ (set! (im i) (func (im i)))
+ (set! (im j) (- (im i))))
+ (polar->rectangular rl im)
+ (fft rl im -1)
+ (let ((pk (float-vector-peak rl)))
+ (float-vector->channel (float-vector-scale! rl (/ old-pk pk)) 0 len snd chn #f
+ (format #f "rotate-phase ~A" (procedure-source func))))))))))
+#|
+(rotate-phase (lambda (x) 0.0)) is the same as (zero-phase)
+(rotate-phase (lambda (x) (random pi))) randomizes phases
+(rotate-phase (lambda (x) x)) returns original
+(rotate-phase (lambda (x) (- x))) reverses original (might want to write fftlen samps here)
+(rotate-phase (lambda (x) (* x 2))) reverb-effect (best with voice)
+(rotate-phase (lambda (x) (* x 12)) "bruise blood" effect
+|#
(define (signum n)
;; in CL this returns 1.0 if n is float
@@ -439,22 +498,33 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
;;; -------- brighten-slightly
-(define* (brighten-slightly amount snd chn)
- "(brighten-slightly amount) is a form of contrast-enhancement ('amount' between ca .1 and 1)"
- (let* ((mx (maxamp))
- (brt (/ (* 2 pi amount) mx)))
- (map-channel (lambda (y)
- (* mx (sin (* y brt))))
- 0 #f snd chn #f (format #f "brighten-slightly ~A" amount))))
-
-(define (brighten-slightly-1 coeffs)
- "(brighten-slightly-1 coeffs) is a form of contrast-enhancement: (brighten-slightly-1 '(1 .5 3 1))"
- (let ((pcoeffs (partials->polynomial coeffs))
- (mx (maxamp)))
- (map-channel
- (lambda (y)
- (* mx (polynomial pcoeffs (/ y mx)))))))
-;; I think this could be a virtual op (ptree)
+(define brighten-slightly
+ (let ((documentation "(brighten-slightly amount snd chn) is a form of contrast-enhancement ('amount' between ca .1 and 1)"))
+ (lambda* (amount snd chn)
+ (let* ((mx (maxamp))
+ (brt (* 2 pi amount))
+ (len (framples snd chn))
+ (data (make-float-vector len))
+ (reader (make-sampler 0 snd chn)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! data i (sin (* (next-sample reader) brt))))
+ (float-vector->channel
+ (float-vector-scale! data (/ mx (float-vector-peak data))) 0 len snd chn current-edit-position (format #f "brighten-slightly ~A" amount))))))
+
+(define brighten-slightly-1
+ (let ((documentation "(brighten-slightly-1 coeffs) is a form of contrast-enhancement: (brighten-slightly-1 '(1 .5 3 1))"))
+ (lambda (coeffs)
+ (let ((pcoeffs (partials->polynomial coeffs))
+ (mx (maxamp))
+ (len (framples)))
+ (let ((data (make-float-vector len))
+ (reader (make-sampler 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! data i (polynomial pcoeffs (next-sample reader))))
+ (float-vector->channel (float-vector-scale! data (/ mx (float-vector-peak data)))))))))
+
@@ -462,75 +532,78 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
;;; Snd's (very simple) spectrum->coefficients procedure is:
-(define (spectrum->coeffs order spectr)
- "(spectrum->coeffs order spectr) returns FIR filter coefficients given the filter order and desired spectral envelope (a vct)"
- (let* ((coeffs (make-vct order))
- (n order)
- (m (floor (/ (+ n 1) 2)))
- (am (* 0.5 (+ n 1)))
- (q (/ (* pi 2.0) n)))
- (do ((j 0 (+ 1 j))
- (jj (- n 1) (- jj 1)))
- ((= j m) coeffs)
- (let ((xt (* 0.5 (spectr 0))))
- (do ((i 1 (+ i 1)))
- ((= i m))
- (set! xt (+ xt (* (spectr i) (cos (* q i (- am j 1)))))))
- (let ((coeff (* 2.0 (/ xt n))))
- (set! (coeffs j) coeff)
- (set! (coeffs jj) coeff))))))
+(define spectrum->coeffs
+ (let ((documentation "(spectrum->coeffs order spectr) returns FIR filter coefficients given the filter order and desired spectral envelope (a float-vector)"))
+ (lambda (order spectr)
+ (let* ((coeffs (make-float-vector order))
+ (n order)
+ (m (floor (/ (+ n 1) 2)))
+ (am (* 0.5 (+ n 1)))
+ (q (/ (* pi 2.0) n)))
+ (if (not (float-vector? spectr))
+ (error "spectrum->coeffs spectrum argument should be a float-vector"))
+ (do ((j 0 (+ j 1))
+ (jj (- n 1) (- jj 1)))
+ ((= j m) coeffs)
+ (let ((xt (* 0.5 (spectr 0))))
+ (do ((i 1 (+ i 1)))
+ ((= i m))
+ (set! xt (+ xt (* (spectr i) (cos (* q i (- am j 1)))))))
+ (let ((coeff (* 2.0 (/ xt n))))
+ (set! (coeffs j) coeff)
+ (set! (coeffs jj) coeff))))))))
;; (filter-channel et al reflect around the midpoint, so to match exactly you need to take
;; the env passed and flip it backwards for the back portion -- that is to say, this function
;; needs a wrapper to make it act like anyone would expect)
-(define (fltit-1 order spectr)
- "(fltit-1 order spectrum) creates an FIR filter from spectrum and order and returns a closure that calls it:
-(map-channel (fltit-1 10 (vct 0 1.0 0 0 0 0 0 0 1.0 0)))"
- (let* ((flt (make-fir-filter order (spectrum->coeffs order spectr))))
- (lambda (x)
- (fir-filter flt x))))
+(define fltit-1
+ (let ((documentation "(fltit-1 order spectrum) creates an FIR filter from spectrum and order and returns a closure that calls it: \
+ (map-channel (fltit-1 10 (float-vector 0 1.0 0 0 0 0 0 0 1.0 0)))"))
+ (lambda (order spectr)
+ (let ((flt (make-fir-filter order (spectrum->coeffs order spectr))))
+ (lambda (x)
+ (fir-filter flt x))))))
-;(map-channel (fltit-1 10 (vct 0 1.0 0 0 0 0 0 0 1.0 0)))
-;
-;(let ((notched-spectr (make-vct 40)))
-; (set! (notched-spectr 2) 1.0)
-; (set! (notched-spectr 37) 1.0)
-; (map-channel (fltit-1 40 notched-spectr)))
-;
+ ;(map-channel (fltit-1 10 (float-vector 0 1.0 0 0 0 0 0 0 1.0 0)))
+ ;
+ ;(let ((notched-spectr (make-float-vector 40)))
+ ; (set! (notched-spectr 2) 1.0)
+ ; (set! (notched-spectr 37) 1.0)
+ ; (map-channel (fltit-1 40 notched-spectr)))
+ ;
;;; -------- Hilbert transform
-(define* (make-hilbert-transform (len 30))
- "(make-hilbert-transform (len 30) makes a Hilbert transform filter"
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-vct arrlen))
- (lim (if (even? len) len (+ 1 len))))
- (do ((i (- len) (+ i 1)))
- ((= i lim))
- (let* ((k (+ i len))
- (denom (* pi i))
- (num (- 1.0 (cos (* pi i)))))
- (if (or (= num 0.0)
- (= i 0))
- (set! (arr k) 0.0)
- ;; this is the "ideal" -- rectangular window -- version:
- ;; (set! (arr k) (/ num denom))
- ;; this is the Hamming window version:
- (set! (arr k) (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))) ; window
- )))
- (make-fir-filter arrlen arr)))
-
-(define (hilbert-transform f in)
- "(hilbert-transform f in) is the generator corresponding to make-hilbert-transform"
- (fir-filter f in))
+(define make-hilbert-transform
+ (let ((documentation "(make-hilbert-transform (len 30)) makes a Hilbert transform filter"))
+ (lambda* ((len 30))
+ (let* ((arrlen (+ 1 (* 2 len)))
+ (arr (make-float-vector arrlen))
+ (lim (if (even? len) len (+ 1 len))))
+ (do ((i (- len) (+ i 1)))
+ ((= i lim))
+ (let ((k (+ i len))
+ (denom (* pi i))
+ (num (- 1.0 (cos (* pi i)))))
+ (if (or (= num 0.0)
+ (= i 0))
+ (set! (arr k) 0.0)
+ ;; this is the "ideal" -- rectangular window -- version:
+ ;; (set! (arr k) (/ num denom))
+ ;; this is the Hamming window version:
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))) ; window
+ )))
+ (make-fir-filter arrlen arr)))))
+
+(define hilbert-transform fir-filter)
#|
- (let ((h (make-hilbert-transform 15)))
- (map-channel (lambda (y)
- (hilbert-transform h y))))
+(let ((h (make-hilbert-transform 15)))
+ (map-channel (lambda (y)
+ (hilbert-transform h y))))
;;; this comes from R Lyons:
(define* (sound->amp-env snd chn)
@@ -545,122 +618,121 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
(define* (hilbert-transform-via-fft snd chn)
;; same as FIR version but use FFT and change phases by hand
- (let* ((size (frames snd chn))
- (len (expt 2 (ceiling (/ (log size) (log 2.0)))))
- (rl (make-vct len))
- (im (make-vct len))
- (rd (make-sampler 0 snd chn)))
+ ;; see snd-test.scm test 18 for a faster version
+ (let* ((size (framples snd chn))
+ (len (expt 2 (ceiling (log size 2.0))))
+ (rl (make-float-vector len))
+ (im (make-float-vector len))
+ (rd (make-sampler 0 snd chn))
+ (pi2 (* 0.5 pi)))
(do ((i 0 (+ i 1)))
((= i size))
(set! (rl i) (rd)))
(mus-fft rl im len)
(do ((i 0 (+ i 1)))
((= i len))
- (let* ((c (make-rectangular (rl i) (im i)))
+ (let* ((c (complex (rl i) (im i)))
(ph (angle c))
(mag (magnitude c)))
(if (< i (/ len 2))
- (set! ph (+ ph (* 0.5 pi)))
- (set! ph (- ph (* 0.5 pi))))
+ (set! ph (+ ph pi2))
+ (set! ph (- ph pi2)))
(set! c (make-polar mag ph))
(set! (rl i) (real-part c))
(set! (im i) (imag-part c))))
(mus-fft rl im len -1)
- (vct-scale! rl (/ 1.0 len))
- (vct->channel rl 0 len snd chn #f "hilbert-transform-via-fft")))
+ (float-vector-scale! rl (/ 1.0 len))
+ (float-vector->channel rl 0 len snd chn #f "hilbert-transform-via-fft")))
|#
;;; -------- highpass filter
-(define* (make-highpass fc (len 30))
- "(make-highpass fc (len 30)) makes an FIR highpass filter"
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-vct arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
- (let* ((k (+ i len))
- (denom (* pi i))
- (num (- (sin (* fc i)))))
- (if (= i 0)
- (set! (arr k) (- 1.0 (/ fc pi)))
- (set! (arr k) (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))
-
-(define (highpass f in)
- "(highpass f in) is the generator corresponding to make-highpass"
- (fir-filter f in))
+(define make-highpass
+ (let ((documentation "(make-highpass fc (len 30)) makes an FIR highpass filter"))
+ (lambda* (fc (len 30))
+ (let* ((arrlen (+ 1 (* 2 len)))
+ (arr (make-float-vector arrlen)))
+ (do ((i (- len) (+ i 1)))
+ ((= i len))
+ (let ((k (+ i len))
+ (denom (* pi i))
+ (num (- (sin (* fc i)))))
+ (if (= i 0)
+ (set! (arr k) (- 1.0 (/ fc pi)))
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (make-fir-filter arrlen arr)))))
+
+(define highpass fir-filter)
#|
- (let ((hp (make-highpass (* .1 pi))))
- (map-channel (lambda (y)
- (highpass hp y))))
+(let ((hp (make-highpass (* .1 pi))))
+ (map-channel (lambda (y)
+ (highpass hp y))))
|#
;;; -------- lowpass filter
-(define* (make-lowpass fc (len 30))
- "(make-lowpass fc (len 30)) makes an FIR lowpass filter"
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-vct arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
- (let* ((k (+ i len))
- (denom (* pi i))
- (num (sin (* fc i))))
- (if (= i 0)
- (set! (arr k) (/ fc pi))
- (set! (arr k) (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))
-
-(define (lowpass f in)
- "(lowpass f in) is the generator corresponding to make-lowpass"
- (fir-filter f in))
+(define make-lowpass
+ (let ((documentation "(make-lowpass fc (len 30)) makes an FIR lowpass filter"))
+ (lambda* (fc (len 30))
+ (let* ((arrlen (+ 1 (* 2 len)))
+ (arr (make-float-vector arrlen)))
+ (do ((i (- len) (+ i 1)))
+ ((= i len))
+ (let ((k (+ i len))
+ (denom (* pi i))
+ (num (sin (* fc i))))
+ (if (= i 0)
+ (set! (arr k) (/ fc pi))
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (make-fir-filter arrlen arr)))))
+
+(define lowpass fir-filter)
#|
- (let ((hp (make-lowpass (* .2 pi))))
- (map-channel (lambda (y)
- (lowpass hp y))))
+(let ((hp (make-lowpass (* .2 pi))))
+ (map-channel (lambda (y)
+ (lowpass hp y))))
|#
;;; -------- bandpass filter
-(define* (make-bandpass flo fhi (len 30))
- "(make-bandpass flo fhi (len 30)) makes an FIR bandpass filter"
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-vct arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
- (let* ((k (+ i len))
- (denom (* pi i))
- (num (- (sin (* fhi i)) (sin (* flo i)))))
- (if (= i 0)
- (set! (arr k) (/ (- fhi flo) pi))
- (set! (arr k) (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))
-
-(define (bandpass f in)
- "(bandpass f in) is the generator corresponding to make-bandpass"
- (fir-filter f in))
+(define make-bandpass
+ (let ((documentation "(make-bandpass flo fhi (len 30)) makes an FIR bandpass filter"))
+ (lambda* (flo fhi (len 30))
+ (let* ((arrlen (+ 1 (* 2 len)))
+ (arr (make-float-vector arrlen)))
+ (do ((i (- len) (+ i 1)))
+ ((= i len))
+ (let ((k (+ i len))
+ (denom (* pi i))
+ (num (- (sin (* fhi i)) (sin (* flo i)))))
+ (if (= i 0)
+ (set! (arr k) (/ (- fhi flo) pi))
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (make-fir-filter arrlen arr)))))
+
+(define bandpass fir-filter)
#|
- (let ((hp (make-bandpass (* .1 pi) (* .2 pi))))
- (map-channel (lambda (y)
- (bandpass hp y))))
+(let ((hp (make-bandpass (* .1 pi) (* .2 pi))))
+ (map-channel (lambda (y)
+ (bandpass hp y))))
;; for more bands, you can add the coeffs:
(define* (make-bandpass-2 flo1 fhi1 flo2 fhi2 (len 30))
(let* ((f1 (make-bandpass flo1 fhi1 len))
(f2 (make-bandpass flo2 fhi2 len)))
- (vct-add! (mus-xcoeffs f1) (mus-xcoeffs f2))
+ (float-vector-add! (mus-xcoeffs f1) (mus-xcoeffs f2))
f1))
(let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) (- 1.0 (random 2.0))) 0 10000)
+ (map-channel (lambda (y) (mus-random 1.0)) 0 10000)
(let ((f2 (make-bandpass-2 (* .12 pi) (* .15 pi) (* .22 pi) (* .25 pi) 100)))
(map-channel (lambda (y) (fir-filter f2 y)))
))
@@ -669,54 +741,52 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
;;; -------- bandstop filter
-(define* (make-bandstop flo fhi (len 30))
- "(make-bandstop flo fhi (len 30)) makes an FIR bandstop (notch) filter"
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-vct arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
- (let* ((k (+ i len))
- (denom (* pi i))
- (num (- (sin (* flo i)) (sin (* fhi i)))))
- (if (= i 0)
- (set! (arr k) (- 1.0 (/ (- fhi flo) pi)))
- (set! (arr k) (* (/ num denom)
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))
-
-(define (bandstop f in)
- "(bandstop f in) is the generator corresponding to make-bandstop"
- (fir-filter f in))
+(define make-bandstop
+ (let ((documentation "(make-bandstop flo fhi (len 30)) makes an FIR bandstop (notch) filter"))
+ (lambda* (flo fhi (len 30))
+ (let* ((arrlen (+ 1 (* 2 len)))
+ (arr (make-float-vector arrlen)))
+ (do ((i (- len) (+ i 1)))
+ ((= i len))
+ (let ((k (+ i len))
+ (denom (* pi i))
+ (num (- (sin (* flo i)) (sin (* fhi i)))))
+ (if (= i 0)
+ (set! (arr k) (- 1.0 (/ (- fhi flo) pi)))
+ (set! (arr k) (* (/ num denom)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (make-fir-filter arrlen arr)))))
+
+(define bandstop fir-filter)
#|
- (let ((hp (make-bandstop (* .1 pi) (* .3 pi))))
- (map-channel (lambda (y)
- (bandstop hp y))))
+(let ((hp (make-bandstop (* .1 pi) (* .3 pi))))
+ (map-channel (lambda (y)
+ (bandstop hp y))))
|#
;;; -------- differentiator
-(define* (make-differentiator (len 30))
- "(make-differentiator (len 30)) makes an FIR differentiator (highpass) filter"
- (let* ((arrlen (+ 1 (* 2 len)))
- (arr (make-vct arrlen)))
- (do ((i (- len) (+ i 1)))
- ((= i len))
- (let* ((k (+ i len)))
- (if (= i 0)
- (set! (arr k) 0.0)
- (set! (arr k) (* (- (/ (cos (* pi i)) i) (/ (sin (* pi i)) (* pi i i)))
- (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
- (make-fir-filter arrlen arr)))
-
-(define (differentiator f in)
- "(differentiator f in) is the generator corresponding to make-differentiator"
- (fir-filter f in))
+(define make-differentiator
+ (let ((documentation "(make-differentiator (len 30)) makes an FIR differentiator (highpass) filter"))
+ (lambda* ((len 30))
+ (let* ((arrlen (+ 1 (* 2 len)))
+ (arr (make-float-vector arrlen)))
+ (do ((i (- len) (+ i 1)))
+ ((= i len))
+ (let ((k (+ i len)))
+ (if (= i 0)
+ (set! (arr k) 0.0)
+ (set! (arr k) (* (/ (cos (* pi i)) i)
+ (+ .54 (* .46 (cos (/ (* i pi) len)))))))))
+ (make-fir-filter arrlen arr)))))
+
+(define differentiator fir-filter)
#|
- (let ((hp (make-differentiator)))
- (map-channel (lambda (y)
- (differentiator hp y))))
+(let ((hp (make-differentiator)))
+ (map-channel (lambda (y)
+ (differentiator hp y))))
|#
@@ -732,63 +802,65 @@ squeezing in the frequency domain, then using the inverse DFT to get the time do
;; who based his work on formulas from
;; Charles Dodge, Computer music: synthesis, composition, and performance.
-(define (butter b sig) ; kinda pointless, but defined as a function here for run's sake (not (define butter filter))
- "(butter b sig) is the generator side for the various make-butter procedure"
- (filter b sig))
-
-(define (make-butter-high-pass fq)
- "(make-butter-high-pass freq) makes a Butterworth filter with high pass cutoff at 'freq'"
- ;; this is the same as iir-low-pass-2 below with 'din' set to (sqrt 2.0) -- similarly with the others
- (let* ((r (tan (/ (* pi fq) (srate))))
- (r2 (* r r))
- (c1 (/ 1.0 (+ 1.0 (* r (sqrt 2.0)) r2)))
- (c2 (* -2.0 c1))
- (c3 c1)
- (c4 (* 2.0 (- r2 1.0) c1))
- (c5 (* (+ (- 1.0 (* r (sqrt 2.0))) r2) c1)))
- (make-filter 3
- (vct c1 c2 c3)
- (vct 0.0 c4 c5))))
-
-(define (make-butter-low-pass fq)
- "(make-butter-low-pass freq) makes a Butterworth filter with low pass cutoff at 'freq'. The result
-can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'butter' generator"
- (let* ((r (/ 1.0 (tan (/ (* pi fq) (srate)))))
- (r2 (* r r))
- (c1 (/ 1.0 (+ 1.0 (* r (sqrt 2.0)) r2)))
- (c2 (* 2.0 c1))
- (c3 c1)
- (c4 (* 2.0 (- 1.0 r2) c1))
- (c5 (* (+ (- 1.0 (* r (sqrt 2.0))) r2) c1)))
- (make-filter 3
- (vct c1 c2 c3)
- (vct 0.0 c4 c5))))
-
-(define (make-butter-band-pass fq bw)
- "(make-butter-band-pass freq band) makes a bandpass Butterworth filter with low edge at 'freq' and width 'band'"
- (let* ((d (* 2.0 (cos (/ (* 2.0 pi fq) (srate)))))
- (c (/ 1.0 (tan (/ (* pi bw) (srate)))))
- (c1 (/ 1.0 (+ 1.0 c)))
- (c2 0.0)
- (c3 (- c1))
- (c4 (* (- c) d c1))
- (c5 (* (- c 1.0) c1)))
- (make-filter 3
- (vct c1 c2 c3)
- (vct 0.0 c4 c5))))
-
-(define (make-butter-band-reject fq bw)
- "(make-butter-band-reject freq band) makes a band-reject Butterworth filter with low edge at 'freq' and width 'band'"
- (let* ((d (* 2.0 (cos (/ (* 2.0 pi fq) (srate)))))
- (c (tan (/ (* pi bw) (srate))))
- (c1 (/ 1.0 (+ 1.0 c)))
- (c2 (* (- d) c1))
- (c3 c1)
- (c4 c2)
- (c5 (* (- 1.0 c) c1)))
- (make-filter 3
- (vct c1 c2 c3)
- (vct 0.0 c4 c5))))
+(define butter filter)
+
+(define make-butter-high-pass
+ (let ((documentation "(make-butter-high-pass freq) makes a Butterworth filter with high pass cutoff at 'freq'"))
+ (lambda (fq)
+ ;; this is the same as iir-low-pass-2 below with 'din' set to (sqrt 2.0) -- similarly with the others
+ (let* ((r (tan (/ (* pi fq) (srate))))
+ (r2 (* r r))
+ (c1 (/ 1.0 (+ 1.0 (* r (sqrt 2.0)) r2)))
+ (c2 (* -2.0 c1))
+ (c3 c1)
+ (c4 (* 2.0 (- r2 1.0) c1))
+ (c5 (* (+ (- 1.0 (* r (sqrt 2.0))) r2) c1)))
+ (make-filter 3
+ (float-vector c1 c2 c3)
+ (float-vector 0.0 c4 c5))))))
+
+(define make-butter-low-pass
+ (let ((documentation "(make-butter-low-pass freq) makes a Butterworth filter with low pass cutoff at 'freq'. The result \
+can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'butter' generator"))
+ (lambda (fq)
+ (let* ((r (/ 1.0 (tan (/ (* pi fq) (srate)))))
+ (r2 (* r r))
+ (c1 (/ 1.0 (+ 1.0 (* r (sqrt 2.0)) r2)))
+ (c2 (* 2.0 c1))
+ (c3 c1)
+ (c4 (* 2.0 (- 1.0 r2) c1))
+ (c5 (* (+ (- 1.0 (* r (sqrt 2.0))) r2) c1)))
+ (make-filter 3
+ (float-vector c1 c2 c3)
+ (float-vector 0.0 c4 c5))))))
+
+(define make-butter-band-pass
+ (let ((documentation "(make-butter-band-pass freq band) makes a bandpass Butterworth filter with low edge at 'freq' and width 'band'"))
+ (lambda (fq bw)
+ (let* ((d (* 2.0 (cos (/ (* 2.0 pi fq) (srate)))))
+ (c (/ 1.0 (tan (/ (* pi bw) (srate)))))
+ (c1 (/ 1.0 (+ 1.0 c)))
+ (c2 0.0)
+ (c3 (- c1))
+ (c4 (* (- c) d c1))
+ (c5 (* (- c 1.0) c1)))
+ (make-filter 3
+ (float-vector c1 c2 c3)
+ (float-vector 0.0 c4 c5))))))
+
+(define make-butter-band-reject
+ (let ((documentation "(make-butter-band-reject freq band) makes a band-reject Butterworth filter with low edge at 'freq' and width 'band'"))
+ (lambda (fq bw)
+ (let* ((d (* 2.0 (cos (/ (* 2.0 pi fq) (srate)))))
+ (c (tan (/ (* pi bw) (srate))))
+ (c1 (/ 1.0 (+ 1.0 c)))
+ (c2 (* (- d) c1))
+ (c3 c1)
+ (c4 c2)
+ (c5 (* (- 1.0 c) c1)))
+ (make-filter 3
+ (float-vector c1 c2 c3)
+ (float-vector 0.0 c4 c5))))))
;;; simplest use is (filter-sound (make-butter-low-pass 500.0))
;;; see also effects.scm
@@ -801,36 +873,37 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
;;; (filter gen 1.0)
;;; etc
-(define (make-biquad a0 a1 a2 b1 b2)
- "(make-biquad a0 a1 a2 b1 b2) returns a biquad filter (use with the CLM filter gen)"
- (make-filter 3
- (vct a0 a1 a2)
- (vct 0.0 b1 b2)))
+(define make-biquad
+ (let ((documentation "(make-biquad a0 a1 a2 b1 b2) returns a biquad filter (use with the CLM filter gen)"))
+ (lambda (a0 a1 a2 b1 b2)
+ (make-filter 3
+ (float-vector a0 a1 a2)
+ (float-vector 0.0 b1 b2)))))
(define* (make-iir-low-pass-2 fc din) ; din=(sqrt 2.0) for example (suggested range 0.2.. 10)
- (let* ((theta (/ (* 2 pi fc) (mus-srate)))
+ (let* ((theta (/ (* 2 pi fc) *clm-srate*))
(d (or din (sqrt 2.0)))
(beta (* 0.5 (/ (- 1.0 (* (/ d 2) (sin theta)))
(+ 1.0 (* (/ d 2) (sin theta))))))
(gamma (* (+ 0.5 beta) (cos theta)))
(alpha (* 0.5 (+ 0.5 beta (- gamma)))))
(make-filter 3
- (vct alpha (* 2.0 alpha) alpha)
- (vct 0.0 (* -2.0 gamma) (* 2.0 beta)))))
+ (float-vector alpha (* 2.0 alpha) alpha)
+ (float-vector 0.0 (* -2.0 gamma) (* 2.0 beta)))))
(define* (make-iir-high-pass-2 fc din)
- (let* ((theta (/ (* 2 pi fc) (mus-srate)))
+ (let* ((theta (/ (* 2 pi fc) *clm-srate*))
(d (or din (sqrt 2.0)))
(beta (* 0.5 (/ (- 1.0 (* (/ d 2) (sin theta)))
(+ 1.0 (* (/ d 2) (sin theta))))))
(gamma (* (+ 0.5 beta) (cos theta)))
(alpha (* 0.5 (+ 0.5 beta gamma))))
(make-filter 3
- (vct alpha (* -2.0 alpha) alpha)
- (vct 0.0 (* -2.0 gamma) (* 2.0 beta)))))
+ (float-vector alpha (* -2.0 alpha) alpha)
+ (float-vector 0.0 (* -2.0 gamma) (* 2.0 beta)))))
(define (make-iir-band-pass-2 f1 f2)
- (let* ((theta (/ (* 2 pi (sqrt (* f1 f2))) (mus-srate)))
+ (let* ((theta (/ (* 2 pi (sqrt (* f1 f2))) *clm-srate*))
(Q (/ (sqrt (* f1 f2)) (- f2 f1)))
(t2 (tan (/ theta (* 2 Q))))
(beta (* 0.5 (/ (- 1.0 t2)
@@ -838,11 +911,11 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(gamma (* (+ 0.5 beta) (cos theta)))
(alpha (- 0.5 beta)))
(make-filter 3
- (vct alpha 0.0 (- alpha))
- (vct 0.0 (* -2.0 gamma) (* 2.0 beta)))))
+ (float-vector alpha 0.0 (- alpha))
+ (float-vector 0.0 (* -2.0 gamma) (* 2.0 beta)))))
(define (make-iir-band-stop-2 f1 f2)
- (let* ((theta (/ (* 2 pi (sqrt (* f1 f2))) (mus-srate)))
+ (let* ((theta (/ (* 2 pi (sqrt (* f1 f2))) *clm-srate*))
(Q (/ (sqrt (* f1 f2)) (- f2 f1)))
(t2 (tan (/ theta (* 2 Q))))
(beta (* 0.5 (/ (- 1.0 t2)
@@ -850,10 +923,12 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(gamma (* (+ 0.5 beta) (cos theta)))
(alpha (+ 0.5 beta)))
(make-filter 3
- (vct alpha (* -2.0 gamma) alpha)
- (vct 0.0 (* -2.0 gamma) (* 2.0 beta)))))
+ (float-vector alpha (* -2.0 gamma) alpha)
+ (float-vector 0.0 (* -2.0 gamma) (* 2.0 beta)))))
-(define* (make-eliminate-hum (hum-freq 60.0) (hum-harmonics 5) (bandwidth 10))
+
+#|
+(define* (old-make-eliminate-hum (hum-freq 60.0) (hum-harmonics 5) (bandwidth 10))
(let ((gen (make-vector hum-harmonics)))
(do ((i 0 (+ i 1)))
((= i hum-harmonics))
@@ -862,19 +937,37 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(set! (gen i) (make-iir-band-stop-2 (- center b2) (+ center b2)))))
gen))
-(define (eliminate-hum gen x0)
- (let ((val x0))
- (do ((i 0 (+ i 1)))
- ((= i (length gen)))
- (set! val (filter (gen i) val))) ; "cascade" n filters
- val))
+(define (old-eliminate-hum gen x0)
+ (do ((i 0 (+ i 1)))
+ ((= i (length gen)) x0)
+ (set! x0 (filter (vector-ref gen i) x0)))) ; "cascade" n filters
+
+;;; (let ((hummer (old-make-eliminate-hum))) (map-channel (lambda (x) (old-eliminate-hum hummer x))))
+|#
+
+;;; the new form is creating a function/closure of the form:
+;;; (let ((g0 (make-iir-band-stop-2 c00 c01)) (g1 (make-iir-band-stop-2 c10 c11))) (lambda (y) (filter g1 (filter g0 y))))
+
+(define-macro* (make-eliminate-hum (hum-freq 60.0) (hum-harmonics 5) (bandwidth 10))
+ `(let ((body 'y)
+ (closure ()))
+ (do ((i 0 (+ i 1)))
+ ((= i ,hum-harmonics))
+ (let ((filt (string->symbol (format #f "g~D" i)))
+ (center (* (+ i 1.0) ,hum-freq))
+ (b2 (* 0.5 ,bandwidth)))
+ (set! body (list 'filter filt body))
+ (set! closure (cons (list filt (list 'make-iir-band-stop-2 (- center b2) (+ center b2))) closure))))
+ (apply let closure
+ `((lambda (y) ,body)))))
+
+;;; (map-channel (make-eliminate-hum))
-;;; (let ((hummer (make-eliminate-hum))) (map-channel (lambda (x) (eliminate-hum hummer x))))
(define (make-peaking-2 f1 f2 m)
;; bandpass, m is gain at center of peak
;; use map-channel with this one (not clm-channel or filter)
- (let* ((theta (/ (* 2 pi (sqrt (* f1 f2))) (mus-srate)))
+ (let* ((theta (/ (* 2 pi (sqrt (* f1 f2))) *clm-srate*))
(Q (/ (sqrt (* f1 f2)) (- f2 f1)))
(t2 (* (/ 4.0 (+ m 1)) (tan (/ theta (* 2 Q)))))
(beta (* 0.5 (/ (- 1.0 t2)
@@ -882,155 +975,161 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(gamma (* (+ 0.5 beta) (cos theta)))
(alpha (- 0.5 beta))
(flt (make-filter 3
- (vct alpha 0.0 (- alpha))
- (vct 0.0 (* -2.0 gamma) (* 2.0 beta)))))
- (lambda (x) (+ x (* (- m 1.0) (filter flt x))))))
-
-
-(define (cascade->canonical A)
- "(cascade->canonical A) converts a list of cascade coeffs (vcts with 3 entries) to canonical form"
- ;; from Orfanidis "Introduction to Signal Processing"
-
- (define (conv M h L x y)
- ;; x * h -> y
- (do ((n 0 (+ 1 n)))
- ((= n (+ L M)))
- (set! (y n) 0.0)
- (do ((m (max 0 (- n (+ 1 L))) (+ 1 m))) ; m always starts at 0 here since the other expression is always <= 0
- ((> m (min n M)))
- (set! (y n) (+ (y n) (* (h m) (x (- n m))))))))
-
- (let* ((K (length A))
- (d (make-vct (+ 1 (* 2 K))))
- (a1 (make-vct (+ 1 (* 2 K)))))
- (set! (a1 0) 1.0)
- (do ((i 0 (+ i 1)))
- ((= i K))
- (conv 2 (A i) (+ 1 (* 2 i)) a1 d)
- (do ((j 0 (+ 1 j)))
- ((= j (+ 3 (* 2 i))))
- (set! (a1 j) (d j))))
- a1))
-
-
-(define (make-butter-lp M fc)
- "(make-butter-lp M fc) returns a butterworth low-pass filter; its order is 'M' * 2, 'fc' is the cutoff frequency in Hz"
- (let* ((xcoeffs '())
- (ycoeffs '())
- (theta (/ (* 2 pi fc) (mus-srate)))
- (st (sin theta))
- (ct (cos theta)))
- (do ((k 1 (+ 1 k)))
- ((> k M))
- (let* ((d (* 2 (sin (/ (* pi (- (* 2 k) 1)) (* 4 M)))))
- (beta (* 0.5 (/ (- 1.0 (* 0.5 d st))
- (+ 1.0 (* 0.5 d st)))))
- (gamma (* ct (+ 0.5 beta)))
- (alpha (* 0.25 (+ 0.5 beta (- gamma)))))
- (set! xcoeffs (cons (vct (* 2 alpha) (* 4 alpha) (* 2 alpha)) xcoeffs))
- (set! ycoeffs (cons (vct 1.0 (* -2.0 gamma) (* 2.0 beta)) ycoeffs))))
- (make-filter (+ 1 (* 2 M))
- (cascade->canonical xcoeffs)
- (cascade->canonical ycoeffs))))
-
-(define (make-butter-hp M fc)
- "(make-butter-hp M fc) returns a butterworth high-pass filter; its order is 'M' * 2, 'fc' is the cutoff frequency in Hz"
- (let* ((xcoeffs '())
- (ycoeffs '())
- (theta (/ (* 2 pi fc) (mus-srate)))
- (st (sin theta))
- (ct (cos theta)))
- (do ((k 1 (+ 1 k)))
- ((> k M))
- (let* ((d (* 2 (sin (/ (* pi (- (* 2 k) 1)) (* 4 M)))))
- (beta (* 0.5 (/ (- 1.0 (* 0.5 d st))
- (+ 1.0 (* 0.5 d st)))))
- (gamma (* ct (+ 0.5 beta)))
- (alpha (* 0.25 (+ 0.5 beta gamma))))
- (set! xcoeffs (cons (vct (* 2 alpha) (* -4 alpha) (* 2 alpha)) xcoeffs))
- (set! ycoeffs (cons (vct 1.0 (* -2.0 gamma) (* 2.0 beta)) ycoeffs))))
- (make-filter (+ 1 (* 2 M))
- (cascade->canonical xcoeffs)
- (cascade->canonical ycoeffs))))
-
-(define (make-butter-bp M f1 f2)
- "(make-butter-bp M f1 f2) returns a butterworth band-pass filter; its order is 'M' * 2, 'f1' and 'f2' are the band edge frequencies in Hz"
- (let* ((xcoeffs '())
- (ycoeffs '())
- (f0 (sqrt (* f1 f2)))
- (Q (/ f0 (- f2 f1)))
- (theta0 (/ (* 2 pi f0) (mus-srate)))
- (de (/ (* 2 (tan (/ theta0 (* 2 Q)))) (sin theta0)))
- (de2 (/ de 2))
- (tn0 (tan (* theta0 0.5))))
- (do ((i 1 (+ i 1))
- (k 1)
- (j 1))
- ((> i M))
- (let* ((Dk (* 2 (sin (/ (* pi (- (* 2 k) 1)) (* 2 M)))))
- (Ak (/ (+ 1 (* de2 de2)) (* Dk de2)))
- (dk1 (sqrt (/ (* de Dk)
- (+ Ak (sqrt (- (* Ak Ak) 1))))))
- (Bk (* de2 (/ Dk dk1)))
- (Wk (real-part (+ Bk (sqrt (- (* Bk Bk) 1.0))))) ; fp inaccuracies causing tiny (presumably bogus) imaginary part here
- (thetajk (if (= j 1)
- (* 2 (atan (/ tn0 Wk)))
- (* 2 (atan (* tn0 Wk)))))
- (betajk (* 0.5 (/ (- 1.0 (* 0.5 dk1 (sin thetajk)))
- (+ 1.0 (* 0.5 dk1 (sin thetajk))))))
- (gammajk (* (+ 0.5 betajk) (cos thetajk)))
- (wk2 (/ (- Wk (/ 1.0 Wk)) dk1))
- (alphajk (* 0.5 (- 0.5 betajk) (sqrt (+ 1.0 (* wk2 wk2))))))
- (set! xcoeffs (cons (vct (* 2 alphajk) 0.0 (* -2 alphajk)) xcoeffs))
- (set! ycoeffs (cons (vct 1.0 (* -2.0 gammajk) (* 2.0 betajk)) ycoeffs))
- (if (= j 1)
- (set! j 2)
- (begin
- (set! k (+ 1 k))
- (set! j 1)))))
- (make-filter (+ 1 (* 2 M))
- (cascade->canonical xcoeffs)
- (cascade->canonical ycoeffs))))
-
-(define (make-butter-bs M f1 f2)
- "(make-butter-bs M f1 f2) returns a butterworth band-stop filter; its order is 'M' * 2, 'f1' and 'f2' are the band edge frequencies in Hz"
- (let* ((xcoeffs '())
- (ycoeffs '())
- (f0 (sqrt (* f1 f2)))
- (Q (/ f0 (- f2 f1)))
- (theta0 (/ (* 2 pi f0) (mus-srate)))
- (de (/ (* 2 (tan (/ theta0 (* 2 Q)))) (sin theta0)))
- (de2 (/ de 2))
- (ct (cos theta0))
- (tn0 (tan (* theta0 0.5))))
- (do ((i 1 (+ i 1))
- (k 1)
- (j 1))
- ((> i M))
- (let* ((Dk (* 2 (sin (/ (* pi (- (* 2 k) 1)) (* 2 M)))))
- (Ak (/ (+ 1 (* de2 de2)) (* Dk de2)))
- (dk1 (sqrt (/ (* de Dk)
- (+ Ak (sqrt (- (* Ak Ak) 1))))))
- (Bk (* de2 (/ Dk dk1)))
- (Wk (real-part (+ Bk (sqrt (- (* Bk Bk) 1.0)))))
- (thetajk (if (= j 1)
- (* 2 (atan (/ tn0 Wk)))
- (* 2 (atan (* tn0 Wk)))))
- (betajk (* 0.5 (/ (- 1.0 (* 0.5 dk1 (sin thetajk)))
- (+ 1.0 (* 0.5 dk1 (sin thetajk))))))
- (gammajk (* (+ 0.5 betajk) (cos thetajk)))
- (alphajk (* 0.5 (+ 0.5 betajk) (/ (- 1.0 (cos thetajk)) (- 1.0 ct)))))
- (set! xcoeffs (cons (vct (* 2 alphajk) (* -4 ct alphajk) (* 2 alphajk)) xcoeffs))
- (set! ycoeffs (cons (vct 1.0 (* -2.0 gammajk) (* 2.0 betajk)) ycoeffs))
- (if (= j 1)
- (set! j 2)
- (begin
- (set! k (+ 1 k))
- (set! j 1)))))
- (make-filter (+ 1 (* 2 M))
- (cascade->canonical xcoeffs)
- (cascade->canonical ycoeffs))))
-
+ (float-vector alpha 0.0 (- alpha))
+ (float-vector 0.0 (* -2.0 gamma) (* 2.0 beta))))
+ (m1 (- m 1.0)))
+ (lambda (x) (+ x (* m1 (filter flt x))))))
+
+
+(define cascade->canonical
+ (let ((documentation "(cascade->canonical A) converts a list of cascade coeffs (float-vectors with 3 entries) to canonical form"))
+ ;; from Orfanidis "Introduction to Signal Processing"
+ (lambda (A)
+ (define (conv M h L x y)
+ ;; x * h -> y
+ (do ((n 0 (+ n 1)))
+ ((= n (+ L M)))
+ (let ((sum 0.0)
+ (start (max 0 (- n (+ L 1))))
+ (end (min n M)))
+ (do ((m start (+ m 1)))
+ ((> m end))
+ (set! sum (+ sum (* (h m) (x (- n m))))))
+ (set! (y n) sum))))
+
+ (let* ((K (length A))
+ (d (make-float-vector (+ 1 (* 2 K))))
+ (a1 (make-float-vector (+ 1 (* 2 K)))))
+ (set! (a1 0) 1.0)
+ (do ((i 0 (+ i 1)))
+ ((= i K))
+ (conv 2 (A i) (+ 1 (* 2 i)) a1 d)
+ (copy d a1 0 (+ 3 (* 2 i))))
+ a1))))
+
+
+(define make-butter-lp
+ (let ((documentation "(make-butter-lp M fc) returns a butterworth low-pass filter; its order is 'M' * 2, 'fc' is the cutoff frequency in Hz"))
+ (lambda (M fc)
+ (let* ((xcoeffs ())
+ (ycoeffs ())
+ (theta (/ (* 2 pi fc) *clm-srate*))
+ (st (sin theta))
+ (ct (cos theta)))
+ (do ((k 1 (+ k 1)))
+ ((> k M))
+ (let* ((d (* 2 (sin (/ (* pi (- (* 2 k) 1)) (* 4 M)))))
+ (beta (* 0.5 (/ (- 1.0 (* 0.5 d st))
+ (+ 1.0 (* 0.5 d st)))))
+ (gamma (* ct (+ 0.5 beta)))
+ (alpha (* 0.25 (+ 0.5 beta (- gamma)))))
+ (set! xcoeffs (cons (float-vector (* 2 alpha) (* 4 alpha) (* 2 alpha)) xcoeffs))
+ (set! ycoeffs (cons (float-vector 1.0 (* -2.0 gamma) (* 2.0 beta)) ycoeffs))))
+ (make-filter (+ 1 (* 2 M))
+ (cascade->canonical xcoeffs)
+ (cascade->canonical ycoeffs))))))
+
+(define make-butter-hp
+ (let ((documentation "(make-butter-hp M fc) returns a butterworth high-pass filter; its order is 'M' * 2, 'fc' is the cutoff frequency in Hz"))
+ (lambda (M fc)
+ (let* ((xcoeffs ())
+ (ycoeffs ())
+ (theta (/ (* 2 pi fc) *clm-srate*))
+ (st (sin theta))
+ (ct (cos theta)))
+ (do ((k 1 (+ k 1)))
+ ((> k M))
+ (let* ((d (* 2 (sin (/ (* pi (- (* 2 k) 1)) (* 4 M)))))
+ (beta (* 0.5 (/ (- 1.0 (* 0.5 d st))
+ (+ 1.0 (* 0.5 d st)))))
+ (gamma (* ct (+ 0.5 beta)))
+ (alpha (* 0.25 (+ 0.5 beta gamma))))
+ (set! xcoeffs (cons (float-vector (* 2 alpha) (* -4 alpha) (* 2 alpha)) xcoeffs))
+ (set! ycoeffs (cons (float-vector 1.0 (* -2.0 gamma) (* 2.0 beta)) ycoeffs))))
+ (make-filter (+ 1 (* 2 M))
+ (cascade->canonical xcoeffs)
+ (cascade->canonical ycoeffs))))))
+
+(define make-butter-bp
+ (let ((documentation "(make-butter-bp M f1 f2) returns a butterworth band-pass filter; its order is 'M' * 2, 'f1' and 'f2' are the band edge frequencies in Hz"))
+ (lambda (M f1 f2)
+ (let* ((xcoeffs ())
+ (ycoeffs ())
+ (f0 (sqrt (* f1 f2)))
+ (Q (/ f0 (- f2 f1)))
+ (theta0 (/ (* 2 pi f0) *clm-srate*))
+ (de (/ (* 2 (tan (/ theta0 (* 2 Q)))) (sin theta0)))
+ (de2 (/ de 2))
+ (tn0 (tan (* theta0 0.5))))
+ (do ((i 1 (+ i 1))
+ (k 1)
+ (j 1))
+ ((> i M))
+ (let* ((Dk (* 2 (sin (/ (* pi (- (* 2 k) 1)) (* 2 M)))))
+ (Ak (/ (+ 1 (* de2 de2)) (* Dk de2)))
+ (dk1 (sqrt (/ (* de Dk)
+ (+ Ak (sqrt (- (* Ak Ak) 1))))))
+ (Bk (* de2 (/ Dk dk1)))
+ (Wk (real-part (+ Bk (sqrt (- (* Bk Bk) 1.0))))) ; fp inaccuracies causing tiny (presumably bogus) imaginary part here
+ (thetajk (if (= j 1)
+ (* 2 (atan tn0 Wk))
+ (* 2 (atan (* tn0 Wk)))))
+ (betajk (* 0.5 (/ (- 1.0 (* 0.5 dk1 (sin thetajk)))
+ (+ 1.0 (* 0.5 dk1 (sin thetajk))))))
+ (gammajk (* (+ 0.5 betajk) (cos thetajk)))
+ (wk2 (/ (- Wk (/ 1.0 Wk)) dk1))
+ (alphajk (* 0.5 (- 0.5 betajk) (sqrt (+ 1.0 (* wk2 wk2))))))
+ (set! xcoeffs (cons (float-vector (* 2 alphajk) 0.0 (* -2 alphajk)) xcoeffs))
+ (set! ycoeffs (cons (float-vector 1.0 (* -2.0 gammajk) (* 2.0 betajk)) ycoeffs))
+ (if (= j 1)
+ (set! j 2)
+ (begin
+ (set! k (+ k 1))
+ (set! j 1)))))
+ (make-filter (+ 1 (* 2 M))
+ (cascade->canonical xcoeffs)
+ (cascade->canonical ycoeffs))))))
+
+(define make-butter-bs
+ (let ((documentation "(make-butter-bs M f1 f2) returns a butterworth band-stop filter; its order is 'M' * 2, 'f1' and 'f2' are the band edge frequencies in Hz"))
+ (lambda (M f1 f2)
+ (let* ((xcoeffs ())
+ (ycoeffs ())
+ (f0 (sqrt (* f1 f2)))
+ (Q (/ f0 (- f2 f1)))
+ (theta0 (/ (* 2 pi f0) *clm-srate*))
+ (de (/ (* 2 (tan (/ theta0 (* 2 Q)))) (sin theta0)))
+ (de2 (/ de 2))
+ (ct (cos theta0))
+ (tn0 (tan (* theta0 0.5))))
+ (do ((i 1 (+ i 1))
+ (k 1)
+ (j 1))
+ ((> i M))
+ (let* ((Dk (* 2 (sin (/ (* pi (- (* 2 k) 1)) (* 2 M)))))
+ (Ak (/ (+ 1 (* de2 de2)) (* Dk de2)))
+ (dk1 (sqrt (/ (* de Dk)
+ (+ Ak (sqrt (- (* Ak Ak) 1))))))
+ (Bk (* de2 (/ Dk dk1)))
+ (Wk (real-part (+ Bk (sqrt (- (* Bk Bk) 1.0)))))
+ (thetajk (if (= j 1)
+ (* 2 (atan tn0 Wk))
+ (* 2 (atan (* tn0 Wk)))))
+ (betajk (* 0.5 (/ (- 1.0 (* 0.5 dk1 (sin thetajk)))
+ (+ 1.0 (* 0.5 dk1 (sin thetajk))))))
+ (gammajk (* (+ 0.5 betajk) (cos thetajk)))
+ (alphajk (* 0.5 (+ 0.5 betajk) (/ (- 1.0 (cos thetajk)) (- 1.0 ct)))))
+ (set! xcoeffs (cons (float-vector (* 2 alphajk) (* -4 ct alphajk) (* 2 alphajk)) xcoeffs))
+ (set! ycoeffs (cons (float-vector 1.0 (* -2.0 gammajk) (* 2.0 betajk)) ycoeffs))
+ (if (= j 1)
+ (set! j 2)
+ (begin
+ (set! k (+ k 1))
+ (set! j 1)))))
+ (make-filter (+ 1 (* 2 M))
+ (cascade->canonical xcoeffs)
+ (cascade->canonical ycoeffs))))))
+
;;; -------- notch filters
@@ -1038,146 +1137,171 @@ can be used directly: (filter-sound (make-butter-low-pass 500.0)), or via the 'b
(let ((freq-response (list 1.0 0.0)))
(for-each
(lambda (i)
- (set! freq-response (cons (/ (* 2 (- i notch-width)) cur-srate) freq-response)) ; left upper y hz
- (set! freq-response (cons 1.0 freq-response)) ; left upper y resp
- (set! freq-response (cons (/ (* 2 (- i (/ notch-width 2))) cur-srate) freq-response)) ; left bottom y hz
- (set! freq-response (cons 0.0 freq-response)) ; left bottom y resp
- (set! freq-response (cons (/ (* 2 (+ i (/ notch-width 2))) cur-srate) freq-response)) ; right bottom y hz
- (set! freq-response (cons 0.0 freq-response)) ; right bottom y resp
- (set! freq-response (cons (/ (* 2 (+ i notch-width)) cur-srate) freq-response)) ; right upper y hz
- (set! freq-response (cons 1.0 freq-response))) ; right upper y resp
+ (set! freq-response (cons (/ (* 2 (- i notch-width)) cur-srate) freq-response)) ; left upper y hz
+ (set! freq-response (cons 1.0 freq-response)) ; left upper y resp
+ (set! freq-response (cons (/ (* 2 (- i (/ notch-width 2))) cur-srate) freq-response)) ; left bottom y hz
+ (set! freq-response (cons 0.0 freq-response)) ; left bottom y resp
+ (set! freq-response (cons (/ (* 2 (+ i (/ notch-width 2))) cur-srate) freq-response)) ; right bottom y hz
+ (set! freq-response (cons 0.0 freq-response)) ; right bottom y resp
+ (set! freq-response (cons (/ (* 2 (+ i notch-width)) cur-srate) freq-response)) ; right upper y hz
+ (set! freq-response (cons 1.0 freq-response))) ; right upper y resp
freqs)
- (set! freq-response (cons 1.0 freq-response))
- (set! freq-response (cons 1.0 freq-response))
+ (set! freq-response (cons 1.0 (cons 1.0 freq-response)))
(reverse freq-response)))
-(define* (notch-channel freqs (filter-order #f) beg dur snd chn edpos (truncate #t) (notch-width 2))
- "(notch-channel freqs (filter-order #f) beg dur snd chn edpos (truncate #t) (notch-width 2)) -> notch filter removing freqs"
- (filter-channel (make-notch-frequency-response (* 1.0 (srate snd)) freqs notch-width)
- (or filter-order (expt 2 (ceiling (/ (log (/ (srate snd) notch-width)) (log 2.0)))))
- beg dur snd chn edpos truncate
- (format #f "notch-channel '~A ~A ~A ~A" freqs filter-order beg dur)))
-
-(define* (notch-sound freqs filter-order snd chn (notch-width 2))
- "(notch-sound freqs filter-order snd chn (notch-width 2)) -> notch filter removing freqs"
- (filter-sound (make-notch-frequency-response (* 1.0 (srate snd)) freqs notch-width)
- (or filter-order (expt 2 (ceiling (/ (log (/ (srate snd) notch-width)) (log 2.0)))))
- snd chn #f
- (format #f "notch-channel '~A ~A 0 #f" freqs filter-order)))
-
-(define* (notch-selection freqs filter-order (notch-width 2))
- "(notch-selection freqs filter-order (notch-width 2)) -> notch filter removing freqs"
- (if (selection?)
- (filter-selection (make-notch-frequency-response (* 1.0 (selection-srate)) freqs notch-width)
- (or filter-order (expt 2 (ceiling (/ (log (/ (selection-srate) notch-width)) (log 2.0))))))))
+(define notch-channel
+ (let ((documentation "(notch-channel freqs filter-order beg dur snd chn edpos (truncate #t) (notch-width 2)) -> notch filter removing freqs"))
+ (lambda* (freqs filter-order beg dur snd chn edpos (truncate #t) (notch-width 2))
+ (filter-channel (make-notch-frequency-response (* 1.0 (srate snd)) freqs notch-width)
+ (or filter-order (min (framples snd chn) (expt 2 (floor (log (/ (srate snd) notch-width) 2)))))
+ beg dur snd chn edpos truncate
+ (format #f "notch-channel '~A ~A ~A ~A" freqs filter-order beg dur)))))
+
+(define notch-sound
+ (let ((documentation "(notch-sound freqs filter-order snd chn (notch-width 2)) -> notch filter removing freqs"))
+ (lambda* (freqs filter-order snd chn (notch-width 2))
+ (filter-sound (make-notch-frequency-response (* 1.0 (srate snd)) freqs notch-width)
+ (or filter-order (min (framples snd chn) (expt 2 (floor (log (/ (srate snd) notch-width) 2)))))
+ snd chn #f
+ (format #f "notch-channel '~A ~A 0 #f" freqs filter-order)))))
+
+(define notch-selection
+ (let ((documentation "(notch-selection freqs filter-order (notch-width 2)) -> notch filter removing freqs"))
+ (lambda* (freqs filter-order (notch-width 2))
+ (if (selection?)
+ (filter-selection (make-notch-frequency-response (* 1.0 (selection-srate)) freqs notch-width)
+ (or filter-order (min (selection-framples) (expt 2 (floor (log (/ (selection-srate) notch-width) 2))))))))))
+;; apparently I'm using powers of 2 here so that mus_make_fir_coeffs, called from get_filter_coeffs, can use an fft
+;; the others use the fft internally for the fir filter, but not filter-selection
;;; -------- fractional Fourier Transform, z transform
;;;
;;; translated from the fxt package of Joerg Arndt
-(define (fractional-fourier-transform fr fi n v)
- "(fractional-fourier-transform real imaginary n angle) performs a fractional Fourier transform on data; if angle=1.0, you get a normal Fourier transform"
- ;; this is the slow (dft) form
- ;; v=1 -> normal fourier transform
- (let ((hr (make-vct n))
- (hi (make-vct n))
- (ph0 (/ (* v 2 pi) n)))
- (do ((w 0 (+ 1 w)))
- ((= w n))
- (let ((sr 0.0)
- (si 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (let* ((phase (* ph0 k w))
- (c (cos phase))
- (s (sin phase))
- (x (fr k))
- (y (fi k))
- (r (- (* x c) (* y s)))
- (i (+ (* y c) (* x s))))
- (set! sr (+ sr r))
- (set! si (+ si i))))
- (set! (hr w) sr)
- (set! (hi w) si)))
- (list hr hi)))
-
-(define (z-transform f n z)
- ;; using vector to allow complex sums (z=e^2*pi*i/n -> fourier transform)
- ;; (z-transform data n (exp (make-rectangular 0.0 (* (/ 2.0 n) pi))))
- "(z-transform data n z) performs a Z transform on data; if z=e^2*pi*j/n you get a Fourier transform; complex results in returned vector"
- (let ((res (make-vector n)))
- (do ((w 0 (+ 1 w)))
- ((= w n))
- (let ((sum 0.0)
- (t 1.0)
- (m (expt z w)))
- ;; -w?? there seems to be confusion here -- slowzt.cc in the fxt package uses +w
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! sum (+ sum (* (f k) t)))
- (set! t (* t m)))
- (set! (res w) sum)))
- res))
+(define fractional-fourier-transform
+ (let ((documentation "(fractional-fourier-transform real imaginary n angle) performs a fractional Fourier transform on data; if angle=1.0, you get a normal Fourier transform"))
+ (lambda (fr fi n v)
+ ;; this is the slow (dft) form
+ ;; v=1 -> normal fourier transform
+ (let ((hr (make-float-vector n))
+ (hi (make-float-vector n))
+ (ph0 (/ (* v 2 pi) n)))
+ (do ((w 0 (+ 1 w)))
+ ((= w n))
+ (let ((sr 0.0)
+ (si 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (let* ((phase (* ph0 k w))
+ (c (cos phase))
+ (s (sin phase))
+ (x (fr k))
+ (y (fi k))
+ (r (- (* x c) (* y s)))
+ (i (+ (* y c) (* x s))))
+ (set! sr (+ sr r))
+ (set! si (+ si i))))
+ (set! (hr w) sr)
+ (set! (hi w) si)))
+ (list hr hi)))))
+
+(define z-transform
+ (let ((documentation "(z-transform data n z) performs a Z transform on data; if z=e^2*pi*j/n you get a Fourier transform; complex results in returned vector"))
+ (lambda (f n z)
+ ;; using vector to allow complex sums (z=e^2*pi*i/n -> fourier transform)
+ ;; (z-transform data n (exp (complex 0.0 (* (/ 2.0 n) pi))))
+ (let ((res (if (float-vector? f) (make-float-vector n) (make-vector n))))
+ (do ((w 0 (+ 1 w)))
+ ((= w n))
+ (let ((sum 0.0)
+ (t 1.0)
+ (m (expt z w)))
+ ;; -w?? there seems to be confusion here -- slowzt.cc in the fxt package uses +w
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! sum (+ sum (* (f k) t)))
+ (set! t (* t m)))
+ (set! (res w) sum)))
+ res))))
;;; -------- slow Hartley transform
-(define (dht data)
- "(dht data) returns the Hartley transform of 'data'."
- ;; taken from Perry Cook's SignalProcessor.m (the slow version of the Hartley transform)
- (let* ((len (length data))
- (arr (make-vct len))
- (w (/ (* 2.0 pi) len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (do ((j 0 (+ 1 j)))
- ((= j len))
- (set! (arr i) (+ (arr i)
- (* (data j)
- (+ (cos (* i j w))
- (sin (* i j w))))))))
- arr))
-
-(define* (find-sine freq beg dur snd)
- "(find-sine freq beg dur snd) returns the amplitude and initial-phase (for sin) at freq"
- (let ((incr (/ (* freq 2 pi) (srate snd)))
- (sw 0.0)
- (cw 0.0)
- (reader (make-sampler beg snd)))
- (do ((i 0 (+ i 1))) ; this could also use edot-product
- ((= i dur))
- (let ((samp (next-sample reader)))
- (set! sw (+ sw (* samp (sin (* i incr)))))
- (set! cw (+ cw (* samp (cos (* i incr)))))))
- (list (* 2 (/ (sqrt (+ (* sw sw) (* cw cw))) dur))
- (atan cw sw))))
+(define dht
+ (let ((documentation "(dht data) returns the Hartley transform of 'data'."))
+ (lambda (data)
+ ;; taken from Perry Cook's SignalProcessor.m (the slow version of the Hartley transform)
+ (let* ((len (length data))
+ (arr (make-float-vector len))
+ (w (/ (* 2.0 pi) len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (do ((j 0 (+ j 1)))
+ ((= j len))
+ (set! (arr i) (+ (arr i)
+ (* (data j)
+ (+ (cos (* i j w))
+ (sin (* i j w))))))))
+ arr))))
+
+(define find-sine
+ (let ((documentation "(find-sine freq beg dur snd) returns the amplitude and initial-phase (for sin) at freq"))
+ (lambda* (freq beg dur snd)
+ (let ((incr (/ (* freq 2 pi) (srate snd)))
+ (sw 0.0)
+ (cw 0.0)
+ (reader (make-sampler beg snd))
+ (samp 0.0))
+ (do ((i 0 (+ i 1)) ; this could also use edot-product
+ (x 0.0 (+ x incr)))
+ ((= i dur))
+ (set! samp (next-sample reader))
+ (set! sw (+ sw (* samp (sin x))))
+ (set! cw (+ cw (* samp (cos x)))))
+ (list (* 2 (/ (sqrt (+ (* sw sw) (* cw cw))) dur))
+ (atan cw sw))))))
;;; this is a faster version of find-sine using the "Goertzel algorithm" taken from R Lyons "Understanding DSP" p 529
;;; it returns the same result as find-sine above if you take (* 2 (/ (goertzel...) dur)) -- see snd-test.scm examples
-(define* (goertzel freq beg dur snd)
- "(goertzel freq beg dur snd) returns the amplitude of the 'freq' spectral component"
- (let* ((sr (srate snd))
- (y2 0.0)
- (y1 0.0)
- (y0 0.0)
- (rfreq (/ (* 2.0 pi freq) sr))
- (cs (* 2.0 (cos rfreq))))
- (scan-channel (lambda (y)
- (set! y2 y1)
- (set! y1 y0)
- (set! y0 (+ (- (* y1 cs) y2) y))
- #f)
- (or beg 0) (or dur (frames snd)) snd)
- (magnitude (- y0 (* y1 (exp (make-rectangular 0.0 (- rfreq))))))))
-
-
-(define (make-spencer-filter)
- "(make-spencer-filter) is a version of make-fir-filter; it returns one of the standard smoothing filters from \
-the era when computers were human beings"
- (make-fir-filter 15 (apply vct (map (lambda (n) (/ n 320.0)) (list -3 -6 -5 3 21 46 67 74 67 46 21 3 -5 -6 -3)))))
+(define goertzel
+ (let ((documentation "(goertzel freq beg dur snd) returns the amplitude of the 'freq' spectral component"))
+ (lambda* (freq (beg 0) dur snd)
+ (let* ((sr (srate snd))
+ (rfreq (/ (* 2.0 pi freq) sr))
+ (cs (* 2.0 (cos rfreq))))
+ (let ((reader (make-sampler beg snd 0))
+ (len (- (if (number? dur) dur (- (framples snd 0) beg)) 2))
+ (flt (make-two-pole 1.0 (- cs) 1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (two-pole flt (next-sample reader)))
+ (let ((y1 (two-pole flt (next-sample reader)))
+ (y0 (two-pole flt (next-sample reader))))
+ (magnitude (- y0 (* y1 (exp (complex 0.0 (- rfreq))))))))))))
+
+#|
+;; old version:
+(let ((y2 0.0)
+ (y1 0.0)
+ (y0 0.0)
+ (reader (make-sampler beg snd 0))
+ (len (if (number? dur) dur (- (framples snd 0) beg))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! y2 y1)
+ (set! y1 y0)
+ (set! y0 (+ (- (* y1 cs) y2) (next-sample reader))))
+ |#
+
+
+(define make-spencer-filter
+ (let ((documentation "(make-spencer-filter) is a version of make-fir-filter; it returns one of the standard smoothing filters from \
+the era when computers were human beings"))
+ (lambda ()
+ (make-fir-filter 15 (apply float-vector (map (lambda (n) (/ n 320.0)) (list -3 -6 -5 3 21 46 67 74 67 46 21 3 -5 -6 -3)))))))
;;; -------- any-random
@@ -1200,51 +1324,46 @@ the era when computers were human beings"
(next-random)))))
(define (gaussian-distribution s)
- (let ((e '())
+ (let ((e ())
(den (* 2.0 s s)))
(do ((i 0 (+ i 1))
(x 0.0 (+ x .05))
(y -4.0 (+ y .4)))
((= i 21))
- (set! e (cons x e))
- (set! e (cons (exp (- (/ (* y y) den))) e)))
+ (set! e (cons (exp (- (/ (* y y) den))) (cons x e))))
(reverse e)))
(define (pareto-distribution a)
- (let ((e '())
+ (let ((e ())
(scl (/ (expt 1.0 (+ a 1.0)) a)))
(do ((i 0 (+ i 1))
(x 0.0 (+ x .05))
(y 1.0 (+ y .2)))
((= i 21))
- (set! e (cons x e))
- (set! e (cons (* scl (/ a (expt y (+ a 1.0)))) e)))
+ (set! e (cons (* scl (/ a (expt y (+ a 1.0)))) (cons x e))))
(reverse e)))
-;(map-channel (lambda (y) (any-random 1.0 '(0 1 1 1)))) ; uniform distribution
-;(map-channel (lambda (y) (any-random 1.0 '(0 0 0.95 0.1 1 1)))) ; mostly toward 1.0
-;(let ((g (gaussian-distribution 1.0))) (map-channel (lambda (y) (any-random 1.0 g))))
-;(let ((g (pareto-distribution 1.0))) (map-channel (lambda (y) (any-random 1.0 g))))
+ ;(map-channel (lambda (y) (any-random 1.0 '(0 1 1 1)))) ; uniform distribution
+ ;(map-channel (lambda (y) (any-random 1.0 '(0 0 0.95 0.1 1 1)))) ; mostly toward 1.0
+ ;(let ((g (gaussian-distribution 1.0))) (map-channel (lambda (y) (any-random 1.0 g))))
+ ;(let ((g (pareto-distribution 1.0))) (map-channel (lambda (y) (any-random 1.0 g))))
;;; this is the inverse integration function used by CLM to turn a distribution function into a weighting function
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
-
(define* (inverse-integrate dist (data-size 512) (e-size 50))
- (let* ((e '())
+ (let* ((e ())
(sum (cadr dist))
(first-sum sum)
- (data (make-vct data-size))
+ (data (make-float-vector data-size))
(x0 (car dist))
(x1 (dist (- (length dist) 2)))
(xincr (/ (- x1 x0) e-size)))
(do ((i 0 (+ i 1))
(x x0 (+ x xincr)))
((> i e-size))
- (set! e (cons sum e))
- (set! e (cons x e))
+ (set! e (cons x (cons sum e)))
(set! sum (+ sum (envelope-interp x dist))))
- (let* ((incr (/ (- (cadr e) first-sum) (- data-size 1))))
+ (let ((incr (/ (- (cadr e) first-sum) (- data-size 1))))
(set! e (reverse e))
(do ((i 0 (+ i 1))
(x first-sum (+ x incr)))
@@ -1253,14 +1372,13 @@ the era when computers were human beings"
data)))
(define (gaussian-envelope s)
- (let ((e '())
+ (let ((e ())
(den (* 2.0 s s)))
(do ((i 0 (+ i 1))
(x -1.0 (+ x .1))
(y -4.0 (+ y .4)))
((= i 21))
- (set! e (cons x e))
- (set! e (cons (exp (- (/ (* y y) den))) e)))
+ (set! e (cons (exp (- (/ (* y y) den))) (cons x e))))
(reverse e)))
;;; (make-rand :envelope (gaussian-envelope 1.0))
@@ -1271,262 +1389,257 @@ the era when computers were human beings"
;;;
;;; these are from "Mathematics of the DFT", W3K Pubs
-(define* (channel-mean snd chn) ; <f, 1> / n
- "(channel-mean snd chn) returns the average of the samples in the given channel: <f,1>/n"
- (let ((sum 0.0)
- (N (frames snd chn)))
- (scan-channel (lambda (y) (set! sum (+ sum y)) #f) 0 N snd chn)
- (/ sum N)))
-
-(define* (channel-total-energy snd chn) ; <f, f>
- "(channel-total-energy snd chn) returns the sum of the squares of all the samples in the given channel: <f,f>"
- (let ((sum 0.0))
- (scan-channel (lambda (y) (set! sum (+ sum (* y y))) #f) 0 (frames snd chn) snd chn)
- sum))
-
-(define* (channel-average-power snd chn) ; <f, f> / n
- "(channel-average-power snd chn) returns the average power in the given channel: <f,f>/n"
- (/ (channel-total-energy snd chn) (frames snd chn)))
-
-(define* (channel-rms snd chn) ; sqrt(<f, f> / n)
- "(channel-rms snd chn) returns the RMS value of the samples in the given channel: sqrt(<f,f>/n)"
- (sqrt (channel-average-power snd chn)))
+(define channel-mean ; <f, 1> / n
+ (let ((documentation "(channel-mean snd chn) returns the average of the samples in the given channel: <f,1>/n"))
+ (lambda* (snd chn)
+ (let ((N (framples snd chn))
+ (reader (make-sampler 0 snd chn))
+ (incr (make-one-pole 1.0 -1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (one-pole incr (next-sample reader)))
+ (/ (one-pole incr 0.0) N)))))
-(define* (channel-variance snd chn) ; "sample-variance" might be better, <f, f> - (<f, 1> / n) ^ 2 with quibbles
- "(channel-variance snd chn) returns the sample variance in the given channel: <f,f>-((<f,1>/ n)^2"
- (let* ((N (frames snd chn))
- (mu (* (/ N (- N 1)) (channel-mean snd chn))) ; avoid bias sez JOS
- (P (channel-total-energy snd chn)))
- (- P (* mu mu))))
+(define channel-total-energy ; <f, f>
+ (let ((documentation "(channel-total-energy snd chn) returns the sum of the squares of all the samples in the given channel: <f,f>"))
+ (lambda* (snd chn)
+ (let ((data (samples 0 (framples snd chn) snd chn)))
+ (dot-product data data)))))
-(define* (channel-norm snd chn) ; sqrt(<f, f>)
- "(channel-norm snd chn) returns the norm of the samples in the given channel: sqrt(<f,f>)"
- (sqrt (channel-total-energy snd chn)))
+#|
+(let ((sum 0.0)
+ (N (framples snd chn))
+ (reader (make-sampler 0 snd chn)))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (let ((y (next-sample reader)))
+ (set! sum (+ sum (* y y)))))
+ sum))
+|#
-(define* (channel-lp p snd chn)
- "(channel-lp p snd chn) returns the Lp norm of the samples in the given channel"
- (let ((sum 0.0)
- (N (frames snd chn)))
- (scan-channel (lambda (y) (set! sum (+ sum (expt (abs y) p))) #f) 0 N snd chn)
- (expt sum (/ 1.0 p))))
-
-(define* (channel-lp-inf snd chn)
- "(channel-lp-inf snd chn) returns the maxamp in the given channel (the name is just math jargon for maxamp)"
- (let ((mx 0.0)
- (N (frames snd chn)))
- (scan-channel (lambda (y) (set! mx (max mx (abs y))) #f) 0 N snd chn)
- mx))
-
-(define (channel2-inner-product s1 c1 s2 c2) ; <f, g>
- "(channel2-inner-product s1 c1 s2 c2) returns the inner-product of the two channels: <f,g>"
- (let ((N (frames s1 c1))
- (sum 0.0)
- (r1 (make-sampler 0 s1 c1))
- (r2 (make-sampler 0 s2 c2)))
- (do ((i 0 (+ i 1)))
- ((= i N))
- (set! sum (+ sum (* (r1) (r2)))))
- sum))
+(define channel-average-power ; <f, f> / n
+ (let ((documentation "(channel-average-power snd chn) returns the average power in the given channel: <f,f>/n"))
+ (lambda* (snd chn)
+ (/ (channel-total-energy snd chn) (framples snd chn)))))
+
+(define channel-rms ; sqrt(<f, f> / n)
+ (let ((documentation "(channel-rms snd chn) returns the RMS value of the samples in the given channel: sqrt(<f,f>/n)"))
+ (lambda* (snd chn)
+ (sqrt (channel-average-power snd chn)))))
+
+(define channel-variance ; "sample-variance" might be better, <f, f> - (<f, 1> / n) ^ 2 with quibbles
+ (let ((documentation "(channel-variance snd chn) returns the sample variance in the given channel: <f,f>-((<f,1>/ n)^2"))
+ (lambda* (snd chn)
+ (let* ((N (framples snd chn))
+ (mu (* (/ N (- N 1)) (channel-mean snd chn))) ; avoid bias sez JOS
+ (P (channel-total-energy snd chn)))
+ (- P (* mu mu))))))
+
+(define channel-norm ; sqrt(<f, f>)
+ (let ((documentation "(channel-norm snd chn) returns the norm of the samples in the given channel: sqrt(<f,f>)"))
+ (lambda* (snd chn)
+ (sqrt (channel-total-energy snd chn)))))
+
+(define channel-lp
+ (let ((documentation "(channel-lp p snd chn) returns the Lp norm of the samples in the given channel"))
+ (lambda* (p snd chn)
+ (let ((incr (make-one-pole 1.0 -1.0))
+ (N (framples snd chn))
+ (reader (make-sampler 0 snd chn)))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (one-pole incr (expt (abs (next-sample reader)) p)))
+ (expt (one-pole incr 0.0) (/ 1.0 p))))))
-(define (channel2-angle s1 c1 s2 c2) ; acos(<f, g> / (sqrt(<f, f>) * sqrt(<g, g>)))
- "(channel2-angle s1 c1 s2 c2) treats the two channels as vectors, returning the 'angle' between them: acos(<f,g>/(sqrt(<f,f>)*sqrt(<g,g>)))"
- (let ((inprod (channel2-inner-product s1 c1 s2 c2))
- (norm1 (channel-norm s1 c1))
- (norm2 (channel-norm s2 c2)))
- (acos (/ inprod (* norm1 norm2)))))
+(define channel-lp-inf maxamp)
+#|
+"(channel-lp-inf snd chn) returns the maxamp in the given channel (the name is just math jargon for maxamp)"
+(let ((mx 0.0)
+ (N (framples snd chn))
+ (reader (make-sampler 0 snd chn)))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (set! mx (max mx (abs (next-sample reader)))))
+ mx))
+|#
-(define (channel2-orthogonal? s1 c1 s2 c2) ; <f, g> == 0
- "(channel2-orthogonal? s1 c1 s2 c2) returns #t if the two channels' inner-product is 0: <f,g>==0"
- (= (channel2-inner-product s1 c1 s2 c2) 0.0))
+(define channel2-inner-product ; <f, g>
+ (let ((documentation "(channel2-inner-product s1 c1 s2 c2) returns the inner-product of the two channels: <f,g>"))
+ (lambda (s1 c1 s2 c2)
+ (dot-product (samples 0 (framples s1 c1) s1 c1) (samples 0 (framples s1 c1) s2 c2)))))
+#|
+(let ((N (framples s1 c1))
+ (sum 0.0)
+ (r1 (make-sampler 0 s1 c1))
+ (r2 (make-sampler 0 s2 c2)))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (set! sum (+ sum (* (r1) (r2)))))
+ sum))
+|#
-(define (channel2-coefficient-of-projection s1 c1 s2 c2) ; s1,c1 = x, s2,c2 = y, <f, g> / <f, f>
- "(channel2-coefficient-of-projection s1 c1 s2 c2) returns <f,g>/<f,f>"
- (/ (channel2-inner-product s1 c1 s2 c2)
- (channel-total-energy s1 c1)))
+(define channel2-angle ; acos(<f, g> / (sqrt(<f, f>) * sqrt(<g, g>)))
+ (let ((documentation "(channel2-angle s1 c1 s2 c2) treats the two channels as vectors, returning the 'angle' between them: acos(<f,g>/(sqrt(<f,f>)*sqrt(<g,g>)))"))
+ (lambda (s1 c1 s2 c2)
+ (let ((inprod (channel2-inner-product s1 c1 s2 c2))
+ (norm1 (channel-norm s1 c1))
+ (norm2 (channel-norm s2 c2)))
+ (acos (/ inprod (* norm1 norm2)))))))
+
+(define channel2-orthogonal? ; <f, g> == 0
+ (let ((documentation "(channel2-orthogonal? s1 c1 s2 c2) returns #t if the two channels' inner-product is 0: <f,g>==0"))
+ (lambda (s1 c1 s2 c2)
+ (= (channel2-inner-product s1 c1 s2 c2) 0.0))))
+
+(define channel2-coefficient-of-projection ; s1,c1 = x, s2,c2 = y, <f, g> / <f, f>
+ (let ((documentation "(channel2-coefficient-of-projection s1 c1 s2 c2) returns <f,g>/<f,f>"))
+ (lambda (s1 c1 s2 c2)
+ (/ (channel2-inner-product s1 c1 s2 c2)
+ (channel-total-energy s1 c1)))))
;;; -------- end of JOS stuff --------
-
-(define (channel-distance s1 c1 s2 c2) ; sqrt(<f - g, f - g>)
- "(channel-distance s1 c1 s2 c2) returns the euclidean distance between the two channels: sqrt(<f-g,f-g>)"
- (let* ((r1 (make-sampler 0 s1 c1))
- (r2 (make-sampler 0 s2 c2))
- (sum 0.0)
- (N (min (frames s1 c1) (frames s2 c2))))
- (do ((i 0 (+ i 1)))
- ((= i N))
- (let ((diff (- (r1) (r2))))
- (set! sum (+ sum (* diff diff)))))
- (sqrt sum)))
-
-
-(define (periodogram N)
- "(periodogram N) displays an 'N' point Bartlett periodogram of the samples in the current channel"
- (let* ((len (frames))
- (average-data (make-vct N))
- (rd (make-sampler 0))
- (N2 (* 2 N))
- (rl (make-vct N2))
- (im (make-vct N2)))
- (do ((i 0 (+ i N)))
- ((>= i len))
- (vct-scale! rl 0.0)
- (vct-scale! im 0.0)
- (do ((k 0 (+ 1 k)))
- ((= k N))
- (set! (rl k) (rd)))
- (mus-fft rl im)
- (do ((k 0 (+ 1 k)))
- ((= k N))
- (set! (average-data k) (+ (average-data k)
- (+ (* (rl k) (rl k))
- (* (im k) (im k)))))))
- (graph (vct-scale! average-data (/ 1.0 (ceiling (/ len N)))))))
+#|
+(define channel-distance-1 ; sqrt(<f - g, f - g>)
+ (let ((documentation "(channel-distance s1 c1 s2 c2) returns the euclidean distance between the two channels: sqrt(<f-g,f-g>)"))
+ (lambda* ((s1 0) (c1 0) (s2 1) (c2 0))
+ (let ((r1 (make-sampler 0 s1 c1))
+ (r2 (make-sampler 0 s2 c2))
+ (sum 0.0)
+ (N (min (framples s1 c1) (framples s2 c2)))
+ (diff 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (set! diff (- (r1) (r2)))
+ (set! sum (+ sum (* diff diff))))
+ (sqrt sum)))))
+|#
+(define channel-distance ; sqrt(<f - g, f - g>)
+ (let ((documentation "(channel-distance s1 c1 s2 c2) returns the euclidean distance between the two channels: sqrt(<f-g,f-g>)"))
+ (lambda* ((s1 0) (c1 0) (s2 1) (c2 0))
+ (let ((N (min (framples s1 c1) (framples s2 c2))))
+ (let ((data1 (samples 0 N s1 c1))
+ (data2 (samples 0 N s2 c2)))
+ (float-vector-subtract! data1 data2)
+ (sqrt (dot-product data1 data1)))))))
+
+
+(define periodogram
+ (let ((documentation "(periodogram N) displays an 'N' point Bartlett periodogram of the samples in the current channel"))
+ (lambda (N)
+ (let* ((len (framples))
+ (average-data (make-float-vector N))
+ (rd (make-sampler 0))
+ (N2 (* 2 N))
+ (rl (make-float-vector N2))
+ (im (make-float-vector N2)))
+ (do ((i 0 (+ i N)))
+ ((>= i len))
+ (float-vector-scale! rl 0.0)
+ (float-vector-scale! im 0.0)
+ (do ((k 0 (+ k 1)))
+ ((= k N))
+ (float-vector-set! rl k (read-sample rd)))
+ (mus-fft rl im)
+ (float-vector-multiply! rl rl)
+ (float-vector-multiply! im im)
+ (float-vector-add! average-data (float-vector-add! rl im)))
+ ;; or add snd-spectrum results
+ (graph (float-vector-scale! average-data (/ 1.0 (ceiling (/ len N)))))))))
;;; -------- ssb-am friends
-(define* (shift-channel-pitch freq (order 40) (beg 0) dur snd chn edpos)
- "(shift-channel-pitch freq (order 40) (beg 0) dur snd chn edpos) uses the ssb-am CLM generator to \
-shift the given channel in pitch without changing its length. The higher 'order', the better usually."
- ;; higher order = better cancellation
- (let* ((gen (make-ssb-am freq order)))
- (map-channel (lambda (y)
- (ssb-am gen y))
- beg dur snd chn edpos
- (format #f "shift-channel-pitch ~A ~A ~A ~A" freq order beg dur))))
-
-(define (hz->2pi freq)
- "(hz->2pi freq) is like hz->radians but uses the current sound's srate, not mus-srate"
- (/ (* 2 pi freq) (srate)))
+(define shift-channel-pitch
+ (let ((documentation "(shift-channel-pitch freq (order 40) (beg 0) dur snd chn edpos) uses the ssb-am CLM generator to \
+shift the given channel in pitch without changing its length. The higher 'order', the better usually."))
+ (lambda* (freq (order 40) (beg 0) dur snd chn edpos)
+ ;; higher order = better cancellation
+ (let ((gen (make-ssb-am freq order)))
+ (map-channel (lambda (y)
+ (ssb-am gen y))
+ beg dur snd chn edpos
+ (format #f "shift-channel-pitch ~A ~A ~A ~A" freq order beg dur))))))
+
+(define hz->2pi
+ (let ((documentation "(hz->2pi freq) is like hz->radians but uses the current sound's srate, not mus-srate"))
+ (lambda (freq)
+ (/ (* 2 pi freq) (srate)))))
(define* (ssb-bank old-freq new-freq pairs (order 40) (bw 50.0) (beg 0) dur snd chn edpos)
- (let* ((ssbs (make-vector pairs))
- (bands (make-vector pairs))
- (factor (/ (- new-freq old-freq) old-freq))
- (mx (maxamp)))
+ (let ((ssbs (make-vector pairs))
+ (bands (make-vector pairs))
+ (factor (/ (- new-freq old-freq) old-freq)))
(do ((i 1 (+ i 1)))
((> i pairs))
- (let* ((aff (* i old-freq))
- (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
+ (let ((aff (* i old-freq))
+ (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
(set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
(set! (bands (- i 1)) (make-bandpass (hz->2pi (- aff bwf))
- (hz->2pi (+ aff bwf))
- order))))
- (as-one-edit
- (lambda ()
- (let ((nmx 0.0))
- (map-channel
- (lambda (y)
- (let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i pairs))
- (set! sum (+ sum (ssb-am (ssbs i)
- (bandpass (bands i)
- y)))))
- (set! nmx (max nmx (abs sum)))
- sum))
- beg dur snd chn edpos)
- (scale-channel (/ mx nmx) beg dur snd chn))) ; not edpos here -- we're scaling the new stuff
- (format #f "ssb-bank ~A ~A ~A ~A ~A ~A ~A" old-freq new-freq pairs order bw beg dur))))
+ (hz->2pi (+ aff bwf))
+ order))))
+ (let ((data (channel->float-vector beg dur snd chn edpos)))
+ (let ((len (length data))
+ (mx (float-vector-peak data)))
+ (let ((summer (make-float-vector len 0.0)))
+ (set! *output* summer)
+ (do ((i 0 (+ i 1)))
+ ((= i pairs))
+ (let ((gen (vector-ref ssbs i))
+ (filt (vector-ref bands i)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (outa k (ssb-am gen (bandpass filt (ina k data))))))) ; outa adds, (ina i v) is the same as (float-vector-ref v i)
+ (set! *output* #f)
+ (float-vector-scale! summer (/ mx (float-vector-peak summer)))
+ (float-vector->channel summer beg len snd chn current-edit-position
+ (format #f "ssb-bank ~A ~A ~A ~A ~A ~A ~A" old-freq new-freq pairs order bw beg dur)))))))
+
+;;; (let ((ind (open-sound "oboe.snd"))) (ssb-bank 550.0 660.0 10))
+
(define* (ssb-bank-env old-freq new-freq freq-env pairs (order 40) (bw 50.0) (beg 0) dur snd chn edpos)
;; this version adds a frequency envelope
;; (ssb-bank-env 557 880 '(0 0 1 100.0) 7)
- (let* ((ssbs (make-vector pairs))
- (bands (make-vector pairs))
- (factor (/ (- new-freq old-freq) old-freq))
- (frenvs (make-vector pairs))
- (mx (maxamp)))
+ (let ((ssbs (make-vector pairs))
+ (bands (make-vector pairs))
+ (factor (/ (- new-freq old-freq) old-freq))
+ (frenvs (make-vector pairs)))
(do ((i 1 (+ i 1)))
((> i pairs))
- (let* ((aff (* i old-freq))
- (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
+ (let ((aff (* i old-freq))
+ (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
(set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
(set! (bands (- i 1)) (make-bandpass (hz->2pi (- aff bwf))
(hz->2pi (+ aff bwf))
order))
(set! (frenvs (- i 1)) (make-env freq-env
- :scaler (hz->radians (* 1.0 i))
- :length (frames)))))
- (as-one-edit
- (lambda ()
- (let ((nmx 0.0))
- (map-channel
- (lambda (y)
- (let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i pairs))
- (set! sum (+ sum (ssb-am (ssbs i)
- (bandpass (bands i)
- y)
- (env (frenvs i))))))
- (set! nmx (max nmx (abs sum)))
- sum))
- beg dur snd chn edpos)
- (scale-channel (/ mx nmx) beg dur snd chn)))
- (format #f "ssb-bank-env ~A ~A '~A ~A ~A ~A ~A ~A" old-freq new-freq freq-env pairs order bw beg dur))))
-
-#|
-(define* (repitch-sound old-freq new-freq)
- (ssb-bank old-freq new-freq 10))
-
-(define* (retime-sound new-time)
- (let* ((old-time (/ (frames) (srate)))
- (factor (/ new-time old-time)))
- (ssb-bank 557 (* 557 factor) 10)
- (src-sound (/ 1.0 factor))))
-
-
-;; echoes with each echo at a new pitch via ssb-am etc
-
-(define* (make-transposer old-freq new-freq pairs (order 40) (bw 50.0))
- (let* ((ssbs (make-vector pairs))
- (bands (make-vector pairs))
- (factor (/ (- new-freq old-freq) old-freq)))
- (do ((i 1 (+ i 1)))
- ((> i pairs))
- (let* ((aff (* i old-freq))
- (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
- (set! (bands (- i 1)) (make-bandpass (hz->radians (- aff bwf))
- (hz->radians (+ aff bwf))
- order))))
- (list ssbs bands)))
-
-(define (transpose transposer input)
- (let* ((sum 0.0)
- (ssbs (car transposer))
- (bands (cadr transposer))
- (pairs (length ssbs)))
- (do ((i 0 (+ i 1)))
- ((= i pairs) sum)
- (set! sum (+ sum (ssb-am (ssbs i)
- (bandpass (bands i)
- input)))))))
-
-(define (fdelay gen input)
- (gen input))
-
-(define (make-fdelay len pitch scaler)
- (let ((dly (make-delay len))
- (ssb (make-transposer 440.0 (* 440.0 pitch) 10)))
- (lambda (input)
- (delay dly (+ input (* scaler (transpose ssb (tap dly))))))))
-
-
-(define (transposed-echo pitch scaler secs)
- (let ((del (make-fdelay (round (* secs (srate)))) pitch scaler))
- (map-channel (lambda (y) (fdelay del y)))))
-
-|#
-
-
+ :scaler (hz->radians i)
+ :length (framples)))))
+ (let ((data (channel->float-vector beg dur snd chn edpos)))
+ (let ((len (length data))
+ (mx (float-vector-peak data)))
+ (let ((summer (make-float-vector len 0.0)))
+ (set! *output* summer)
+ (do ((i 0 (+ i 1)))
+ ((= i pairs))
+ (let ((gen (vector-ref ssbs i))
+ (filt (vector-ref bands i))
+ (e (vector-ref frenvs i)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (outa k (ssb-am gen (bandpass filt (ina k data)) (env e))))))
+ (set! *output* #f)
+ (float-vector-scale! summer (/ mx (float-vector-peak summer)))
+ (float-vector->channel summer beg len snd chn current-edit-position
+ (format #f "ssb-bank-env ~A ~A '~A ~A ~A ~A ~A ~A" old-freq new-freq freq-env pairs order bw beg dur)))))))
+
+;;; (let ((ind (open-sound "oboe.snd"))) (ssb-bank-env 550 600 '(0 1 1 2) 10))
#|
;;; a "bump function" (Stein and Shakarchi)
(define (bumpy)
(let* ((x 0.0)
- (xi (/ 1.0 (frames)))
+ (xi (/ 1.0 (framples)))
(start 0)
(end 1)
(scl (exp (/ 4.0 (- end start))))) ; normalize it
@@ -1541,60 +1654,62 @@ shift the given channel in pitch without changing its length. The higher 'order
|#
-;;; vct|channel|spectral-polynomial
+;;; float-vector|channel|spectral-polynomial
-(define (vct-polynomial v coeffs)
- ;; Horner's rule applied to entire vct
+(define (float-vector-polynomial v coeffs)
+ ;; Horner's rule applied to entire float-vector
(let* ((v-len (length v))
(num-coeffs (length coeffs))
- (new-v (make-vct v-len (coeffs (- num-coeffs 1)))))
+ (new-v (make-float-vector v-len (coeffs (- num-coeffs 1)))))
(do ((i (- num-coeffs 2) (- i 1)))
((< i 0))
- (vct-offset! (vct-multiply! new-v v) (coeffs i)))
+ (float-vector-offset! (float-vector-multiply! new-v v) (coeffs i)))
new-v))
+
(define* (channel-polynomial coeffs snd chn)
- (let ((len (frames snd chn)))
- (vct->channel
- (vct-polynomial
- (channel->vct 0 len snd chn)
+ (let ((len (framples snd chn)))
+ (float-vector->channel
+ (float-vector-polynomial
+ (channel->float-vector 0 len snd chn)
coeffs)
- 0 len snd chn #f (format #f "channel-polynomial ~A" (vct->string coeffs)))))
+ 0 len snd chn #f (format #f "channel-polynomial ~A" (float-vector->string coeffs)))))
-;;; (channel-polynomial (vct 0.0 .5)) = x*.5
-;;; (channel-polynomial (vct 0.0 1.0 1.0 1.0)) = x*x*x + x*x + x
+;;; (channel-polynomial (float-vector 0.0 .5)) = x*.5
+;;; (channel-polynomial (float-vector 0.0 1.0 1.0 1.0)) = x*x*x + x*x + x
;;; convolution -> * in freq
(define* (spectral-polynomial coeffs snd chn)
- (let* ((len (frames snd chn))
- (sound (channel->vct 0 len snd chn))
+ (let* ((len (framples snd chn))
+ (sound (channel->float-vector 0 len snd chn))
(num-coeffs (length coeffs))
(fft-len (if (< num-coeffs 2)
len
- (expt 2 (ceiling (/ (log (* (- num-coeffs 1) len)) (log 2))))))
- (rl1 (make-vct fft-len 0.0))
- (rl2 (make-vct fft-len 0.0))
- (new-sound (make-vct fft-len)))
+ (expt 2 (ceiling (log (* (- num-coeffs 1) len) 2)))))
+ (rl1 (make-float-vector fft-len 0.0))
+ (rl2 (make-float-vector fft-len 0.0))
+ (newv (make-float-vector fft-len)))
(if (> (coeffs 0) 0.0)
(let ((dither (coeffs 0)))
(do ((i 0 (+ i 1)))
((= i fft-len))
- (set! (new-sound i) (mus-random dither)))))
+ (float-vector-set! newv i (mus-random dither)))))
(if (> num-coeffs 1)
(begin
- (vct-add! new-sound (vct-scale! (vct-copy sound) (coeffs 1)))
+ (float-vector-add! newv (float-vector-scale! (copy sound) (coeffs 1)))
(if (> num-coeffs 2)
(let ((peak (maxamp snd chn)))
- (vct-add! (vct-scale! rl1 0.0) sound)
+ (copy sound rl1)
(do ((i 2 (+ i 1)))
((= i num-coeffs))
- (convolution rl1 (vct-add! (vct-scale! rl2 0.0) sound) fft-len)
- (let ((pk (vct-peak rl1)))
- (vct-add! new-sound (vct-scale! (vct-copy rl1) (/ (* (coeffs i) peak) pk)))))
- (let ((pk (vct-peak new-sound)))
- (vct-scale! new-sound (/ peak pk)))))))
- (vct->channel new-sound 0 (max len (* len (- num-coeffs 1))) snd chn #f (format #f "spectral-polynomial ~A" (vct->string coeffs)))))
+ (copy sound rl2)
+ (convolution rl1 rl2 fft-len)
+ (let ((pk (float-vector-peak rl1)))
+ (float-vector-add! newv (float-vector-scale! (copy rl1) (/ (* (coeffs i) peak) pk)))))
+ (let ((pk (float-vector-peak newv)))
+ (float-vector-scale! newv (/ peak pk)))))))
+ (float-vector->channel newv 0 (max len (* len (- num-coeffs 1))) snd chn #f (format #f "spectral-polynomial ~A" (float-vector->string coeffs)))))
;;; ----------------
@@ -1628,77 +1743,76 @@ shift the given channel in pitch without changing its length. The higher 'order
;;;
;;; FFTSIZE -- FFT window size. Must be a power of 2. 4096 is recommended.
-(define* (scentroid file (beg 0.0) dur (db-floor -40.0) (rfreq 100.0) (fftsize 4096))
- "(scentroid file (beg 0.0) dur (db-floor -40.0) (rfreq 100.0) (fftsize 4096)) returns the spectral centroid envelope of a sound; 'rfreq' is \
-the rendering frequency, the number of measurements per second; 'db-floor' is the level below which data will be ignored"
- (let* ((fsr (srate file))
- (incrsamps (floor (/ fsr rfreq)))
- (start (floor (* beg fsr)))
- (end (+ start (if dur (floor (* dur fsr)) (- (frames file) beg))))
- (fdr (make-vct fftsize))
- (fdi (make-vct fftsize))
- (windows (+ 1 (floor (/ (- end start) incrsamps))))
- (results (make-vct windows))
- (fft2 (floor (/ fftsize 2)))
- (binwidth (* 1.0 (/ fsr fftsize)))
- (rd (make-readin file)))
- (run
- (do ((i start (+ i incrsamps))
- (loc 0 (+ 1 loc)))
- ((>= i end))
- (set! (mus-location rd) i)
- (let ((sum-of-squares 0.0))
- (do ((j 0 (+ 1 j)))
- ((= j fftsize))
- (let ((val (readin rd)))
- (set! sum-of-squares (+ sum-of-squares (* val val)))
- (set! (fdr j) val)))
- (if (>= (linear->db (sqrt (/ sum-of-squares fftsize))) db-floor)
- (let ((numsum 0.0)
- (densum 0.0))
- (clear-array fdi)
- (mus-fft fdr fdi fftsize)
- (rectangular->magnitudes fdr fdi)
- (do ((k 0 (+ 1 k)))
- ((= k fft2))
- (set! numsum (+ numsum (* k binwidth (fdr k))))
- (set! densum (+ densum (fdr k))))
- (set! (results loc) (/ numsum densum)))))))
- results))
-
+(define scentroid
+ (let ((documentation "(scentroid file (beg 0.0) dur (db-floor -40.0) (rfreq 100.0) (fftsize 4096)) returns the spectral centroid envelope of a sound; 'rfreq' is \
+the rendering frequency, the number of measurements per second; 'db-floor' is the level below which data will be ignored"))
+ (lambda* (file (beg 0.0) dur (db-floor -40.0) (rfreq 100.0) (fftsize 4096))
+ (let* ((fsr (srate file))
+ (incrsamps (floor (/ fsr rfreq)))
+ (start (floor (* beg fsr)))
+ (end (+ start (if dur (floor (* dur fsr)) (- (framples file) beg))))
+ (fdr (make-float-vector fftsize))
+ (fdi (make-float-vector fftsize))
+ (scl (make-float-vector (/ fftsize 2)))
+ (ones (make-float-vector (/ fftsize 2) 1.0))
+ (windows (+ 1 (floor (/ (- end start) incrsamps))))
+ (results (make-float-vector windows))
+ (fft2 (floor (/ fftsize 2)))
+ (binwidth (* 1.0 (/ fsr fftsize)))
+ (rd (make-readin file)))
+ (do ((k 0 (+ k 1)))
+ ((= k fft2))
+ (float-vector-set! scl k (* k binwidth)))
+ (do ((i start (+ i incrsamps))
+ (loc 0 (+ 1 loc)))
+ ((>= i end))
+ (set! (mus-location rd) i)
+ (do ((j 0 (+ j 1)))
+ ((= j fftsize))
+ (float-vector-set! fdr j (readin rd)))
+ (if (>= (linear->db (sqrt (/ (dot-product fdr fdr) fftsize))) db-floor)
+ (begin
+ (fill! fdi 0.0)
+ (mus-fft fdr fdi fftsize)
+ (rectangular->magnitudes fdr fdi)
+ (set! (results loc) (/ (dot-product scl fdr fft2)
+ (dot-product ones fdr fft2))))))
+ results))))
+
;;; ----------------
;;;
;;; invert-filter inverts an FIR filter
;;;
-;;; say we previously filtered a sound via (filter-channel (vct .5 .25 .125))
+;;; say we previously filtered a sound via (filter-channel (float-vector .5 .25 .125))
;;; and we want to undo it without using (undo):
-;;; (filter-channel (invert-filter (vct .5 .25 .125)))
+;;; (filter-channel (invert-filter (float-vector .5 .25 .125)))
;;;
;;; there are a million gotchas here. The primary one is that the inverse filter
;;; can "explode" -- the coefficients can grow without bound. For example, any
;;; filter returned by spectrum->coeffs above will be a problem (it always returns
;;; a "linear phase" filter). Could this be used to remove reverb?
-(define (invert-filter fcoeffs)
- "(invert-filter coeffs) tries to return an inverse filter to undo the effect of the FIR filter coeffs."
- (let* ((flen (length fcoeffs))
- (coeffs (make-vct (+ 32 flen))) ; add room for coeffs to die away
- (order (length coeffs)))
- (do ((i 0 (+ i 1)))
- ((= i flen))
- (set! (coeffs i) (fcoeffs i)))
- (let ((nfilt (make-vct order)))
- (set! (nfilt 0) (/ 1.0 (coeffs 0)))
- (do ((i 1 (+ i 1)))
- ((= i order))
- (let ((sum 0.0))
- (do ((j 0 (+ 1 j))
- (k i (- k 1)))
- ((= j i))
- (set! sum (+ sum (* (nfilt j) (coeffs k)))))
- (set! (nfilt i) (/ sum (- (coeffs 0))))))
- nfilt)))
+(define invert-filter
+ (let ((documentation "(invert-filter coeffs) tries to return an inverse filter to undo the effect of the FIR filter coeffs."))
+ (lambda (fcoeffs)
+ (let* ((flen (length fcoeffs))
+ (coeffs (make-float-vector (+ 32 flen))) ; add room for coeffs to die away
+ (order (length coeffs)))
+ (do ((i 0 (+ i 1)))
+ ((= i flen))
+ (set! (coeffs i) (fcoeffs i)))
+ (let ((nfilt (make-float-vector order)))
+ (set! (nfilt 0) (/ 1.0 (coeffs 0)))
+ (do ((i 1 (+ i 1)))
+ ((= i order))
+ (let ((sum 0.0))
+ (do ((j 0 (+ j 1))
+ (k i (- k 1)))
+ ((= j i))
+ (set! sum (+ sum (* (nfilt j) (coeffs k)))))
+ (set! (nfilt i) (/ sum (- (coeffs 0))))))
+ nfilt)))))
;;; ----------------
@@ -1709,32 +1823,34 @@ the rendering frequency, the number of measurements per second; 'db-floor' is th
;;; this version is taken from Monson Hayes "Statistical DSP and Modeling"
;;; it is a slight specialization of the form mentioned by J O Smith and others
-(define (make-volterra-filter acoeffs bcoeffs)
- "(make-volterra-filter acoeffs bcoeffs) returns a list for use with volterra-filter, producing one of the standard non-linear filters"
- (list acoeffs
- bcoeffs
- (make-vct (max (length acoeffs) (length bcoeffs)))))
-
-(define (volterra-filter flt x)
- "(volterra-filter flt x) takes 'flt', a list returned by make-volterra-filter, and an input 'x', and returns the (non-linear filtered) result"
- (let* ((as (car flt))
- (bs (cadr flt))
- (xs (caddr flt))
- (xlen (length xs))
- (x1len (length as))
- (x2len (length bs))
- (sum 0.0))
- (vct-move! xs (- xlen 1) (- xlen 2) #t)
- (set! (xs 0) x)
- (set! sum (dot-product as xs x1len))
- (do ((i 0 (+ i 1)))
- ((= i x2len))
- (do ((j i (+ 1 j)))
- ((= j x2len))
- (set! sum (+ sum (* (bs j) (xs i) (xs j))))))
- sum))
+(define make-volterra-filter
+ (let ((documentation "(make-volterra-filter acoeffs bcoeffs) returns a list for use with volterra-filter, producing one of the standard non-linear filters"))
+ (lambda (acoeffs bcoeffs)
+ (list acoeffs
+ bcoeffs
+ (make-float-vector (max (length acoeffs) (length bcoeffs)))))))
+
+(define volterra-filter
+ (let ((documentation "(volterra-filter flt x) takes 'flt', a list returned by make-volterra-filter, and an input 'x', and returns the (non-linear filtered) result"))
+ (lambda (flt x)
+ (let* ((as (car flt))
+ (bs (cadr flt))
+ (xs (caddr flt))
+ (xlen (length xs))
+ (x1len (length as))
+ (x2len (length bs))
+ (sum 0.0))
+ (float-vector-move! xs (- xlen 1) (- xlen 2) #t)
+ (set! (xs 0) x)
+ (set! sum (dot-product as xs x1len))
+ (do ((i 0 (+ i 1)))
+ ((= i x2len))
+ (do ((j i (+ j 1)))
+ ((= j x2len))
+ (set! sum (+ sum (* (bs j) (xs i) (xs j))))))
+ sum))))
-;;; (define flt (make-volterra-filter (vct .5 .1) (vct .3 .2 .1)))
+;;; (define flt (make-volterra-filter (float-vector .5 .1) (float-vector .3 .2 .1)))
;;; (map-channel (lambda (x) (volterra-filter flt x)))
@@ -1744,93 +1860,110 @@ the rendering frequency, the number of measurements per second; 'db-floor' is th
;;; harmonicizer (each harmonic is split into a set of harmonics via Chebyshev polynomials)
;;; obviously very similar to ssb-bank above, but splits harmonics individually, rather than pitch-shifting them
-(define* (harmonicizer freq coeffs pairs (order 40) (bw 50.0) (beg 0) dur snd chn edpos)
- "(harmonicizer freq coeffs pairs (order 40) (bw 50.0) (beg 0) dur snd chn edpos) splits out each harmonic \
-and replaces it with the spectrum given in coeffs"
- (let* ((bands (make-vector pairs))
- (pcoeffs (partials->polynomial coeffs))
- (avgs (make-vector pairs))
- (peaks (make-vector pairs))
- (flt (make-filter 2 (vct 1 -1) (vct 0 -0.9)))
- (old-mx (maxamp))
- (new-mx 0.0)
- (ctr 40))
- (do ((i 1 (+ i 1)))
- ((> i pairs))
- (let* ((aff (* i freq))
- (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (set! (peaks (- i 1)) (make-moving-max 128))
- (set! (avgs (- i 1)) (make-moving-average 128))
- (set! (bands (- i 1)) (make-bandpass (hz->2pi (- aff bwf))
+(define harmonicizer
+ (let ((documentation "(harmonicizer freq coeffs pairs (order 40) (bw 50.0) (beg 0) dur snd chn edpos) splits out each harmonic \
+and replaces it with the spectrum given in coeffs"))
+ (lambda* (freq coeffs pairs (order 40) (bw 50.0) (beg 0) dur snd chn edpos)
+ (let ((bands (make-vector pairs))
+ (pcoeffs (partials->polynomial coeffs))
+ (peaks (make-vector pairs))
+ (peaks2 (make-vector pairs))
+ (flt (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.9)))
+ (old-mx (maxamp))
+ (startup 40)
+ (len (- (or dur (framples snd chn edpos)) beg)))
+ (let ((summer (make-float-vector len))
+ (indata (channel->float-vector beg len snd chn edpos)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i pairs))
+ (let ((aff (* (+ i 1) freq))
+ (bwf (* bw (+ 1.0 (/ (+ i 1) (* 2 pairs))))))
+ (set! (peaks i) (make-moving-max 128))
+ (set! (peaks2 i) (make-moving-norm 128))
+ (set! (bands i) (make-bandpass (hz->2pi (- aff bwf))
(hz->2pi (+ aff bwf))
order))))
- (as-one-edit
- (lambda ()
- (map-channel
- (lambda (y)
- (let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i pairs))
- (let* ((sig (bandpass (bands i) y))
- (mx (moving-max (peaks i) sig)))
- (let ((amp (moving-average (avgs i) (if (> mx 0.0) (min 100.0 (/ 1.0 mx)) 0.0))))
- (if (> amp 0.0)
- (set! sum (+ sum (* mx (polynomial pcoeffs (* amp sig)))))))))
- (let ((val (filter flt sum))) ; get rid of DC
- (set! new-mx (max new-mx (abs val)))
- (if (= ctr 0) ; flush filter initial junk
- val
- (begin
- (set! ctr (- ctr 1))
- 0.0)))))
- beg dur snd chn edpos)
- (if (> new-mx 0.0)
- (scale-channel (/ old-mx new-mx) beg dur snd chn))))))
+ ;; ignore startup
+ (do ((k 0 (+ k 1)))
+ ((= k startup))
+ (let ((sum 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i pairs))
+ (let ((sig (bandpass (vector-ref bands i) (float-vector-ref indata k))))
+ (set! sum (+ sum (* (moving-max (vector-ref peaks i) sig)
+ (polynomial pcoeffs (* sig (moving-norm (vector-ref peaks2 i) sig))))))))
+ (filter flt sum)))
+
+ (set! *output* summer)
+ (do ((pair 0 (+ pair 1)))
+ ((= pair pairs))
+ (let ((bp (vector-ref bands pair))
+ (pk (vector-ref peaks pair))
+ (pk2 (vector-ref peaks2 pair)))
+ (do ((k startup (+ k 1)))
+ ((= k len))
+ (let ((x (bandpass bp (float-vector-ref indata k))))
+ (outa k (* (moving-max pk x) (polynomial pcoeffs (* x (moving-norm pk2 x)))))))))
+
+ ;; we're normalizing the polynomial input so its waveshaping index is more-or-less 1.0
+ ;; this might work better with len=256, max .1 -- we're assuming a well-behaved signal
+
+ (set! *output* #f)
+ (do ((k startup (+ k 1)))
+ ((= k len))
+ (float-vector-set! summer k (filter flt (float-vector-ref summer k))))
+
+ (let ((nmx (float-vector-peak summer)))
+ (if (> nmx 0.0)
+ (float-vector-scale! summer (/ old-mx nmx))))
+ (float-vector->channel summer beg len snd chn))))))
+
+;;; (harmonicizer 550.0 (list 1 .5 2 .3 3 .2) 10)
+
;;; ----------------
;;;
;;; linear sampling rate conversion
-(define* (linear-src-channel sr snd chn)
- "(linear-src-channel sr snd chn performs sampling rate conversion using linear interpolation."
- (let* ((rd (make-sampler 0 snd chn))
- (last (rd))
- (next (rd))
- (intrp 0.0)
- (tempfile
- (with-sound (:output (snd-tempnam) :srate (srate snd) :to-snd #f)
- (run
- (do ((samp 0 (+ 1 samp)))
- ((sampler-at-end? rd))
- (out-any samp
+(define linear-src-channel
+ (let ((documentation "(linear-src-channel sr snd chn) performs sampling rate conversion using linear interpolation."))
+ (lambda* (sr snd chn)
+ (let* ((rd (make-sampler 0 snd chn))
+ (last (rd))
+ (next (rd))
+ (intrp 0.0)
+ (tempfile
+ (with-sound (:output (snd-tempnam) :srate (srate snd) :to-snd #f)
+ (do ((samp 0 (+ samp 1)))
+ ((sampler-at-end? rd))
+ (outa samp
(let ((pos intrp))
(if (>= pos 1.0)
(let ((num (floor pos)))
(do ((i 0 (+ i 1)))
((= i num))
(set! last next)
- (set! next (rd)))
+ (set! next (read-sample rd)))
(set! pos (- pos num))))
(set! intrp (+ pos sr))
(+ last (* pos (- next last))))
- 0)))))
- (len (frames tempfile)))
- (set-samples 0 (- len 1) tempfile snd chn #t "linear-src" 0 #f #t)
- ;; first #t=truncate to new length, #f=at current edpos, #t=auto delete temp file
- ))
+ ))))
+ (len (framples tempfile)))
+ (set-samples 0 (- len 1) tempfile snd chn #t "linear-src" 0 #f #t)
+ ;; first #t=truncate to new length, #f=at current edpos, #t=auto delete temp file
+ ))))
;;; -------- spectrum displayed in various frequency scales
(define display-bark-fft
;; click in lisp-graph to change the tick placement choice
-
+
(let ((snd-color-1 (lambda args
- (if (defined? 'snd-color)
- (apply snd-color args)
- #f)))) ; no-gui case I guess
-
+ (and (defined? 'snd-color)
+ (apply snd-color args)))))
(let ((bark-fft-size 0)
(bark-tick-function 0)
(color1 (snd-color-1 8)) ; selected-data-color
@@ -1847,72 +1980,73 @@ and replaces it with the spectrum given in coeffs"
(define (erb f)
(+ 43.0 (* 11.17 (log (/ (+ f 312) (+ f 14675))))))
- (define (display-bark-fft-1 snd chn)
- (let* ((ls (left-sample snd chn))
+ (define (display-bark-fft-1 hook)
+ (let* ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (ls (left-sample snd chn))
(rs (right-sample snd chn))
- (fftlen (floor (expt 2 (ceiling (/ (log (+ 1 (- rs ls))) (log 2)))))))
+ (fftlen (floor (expt 2 (ceiling (log (+ 1 (- rs ls)) 2))))))
(if (> fftlen 0)
- (let ((data (channel->vct ls fftlen snd chn))
+ (let ((data (channel->float-vector ls fftlen snd chn))
(normalized (not (= (transform-normalization snd chn) dont-normalize)))
(linear #t)) ; can't currently show lisp graph in dB
;; snd-axis make_axes: WITH_LOG_Y_AXIS, but LINEAR currently in snd-chn.c 3250
- (if (vct? data)
+ (if (float-vector? data)
(let ((fftdata (snd-spectrum data ; returns fftlen / 2 data points
(fft-window snd chn) fftlen linear
(fft-window-beta snd chn) #f normalized)))
- (if (vct? fftdata)
+ (if (float-vector? fftdata)
(let* ((sr (srate snd))
- (mx (vct-peak fftdata))
+ (mx (float-vector-peak fftdata))
(data-len (length fftdata))
;; bark settings
(bark-low (floor (bark 20.0)))
(bark-high (ceiling (bark (* 0.5 sr))))
(bark-frqscl (/ data-len (- bark-high bark-low)))
- (bark-data (make-vct data-len))
+ (bark-data (make-float-vector data-len))
;; mel settings
(mel-low (floor (mel 20.0)))
(mel-high (ceiling (mel (* 0.5 sr))))
(mel-frqscl (/ data-len (- mel-high mel-low)))
- (mel-data (make-vct data-len))
+ (mel-data (make-float-vector data-len))
;; erb settings
(erb-low (floor (erb 20.0)))
(erb-high (ceiling (erb (* 0.5 sr))))
(erb-frqscl (/ data-len (- erb-high erb-low)))
- (erb-data (make-vct data-len)))
+ (erb-data (make-float-vector data-len)))
(set! bark-fft-size fftlen)
- (run
- (do ((i 0 (+ i 1)))
- ((= i data-len))
- (let* ((val (fftdata i))
- (frq (* sr (/ i fftlen)))
- (bark-bin (round (* bark-frqscl (- (bark frq) bark-low))))
- (mel-bin (round (* mel-frqscl (- (mel frq) mel-low))))
- (erb-bin (round (* erb-frqscl (- (erb frq) erb-low)))))
- (if (and (>= bark-bin 0)
- (< bark-bin data-len))
- (set! (bark-data bark-bin) (+ val (bark-data bark-bin))))
- (if (and (>= mel-bin 0)
- (< mel-bin data-len))
- (set! (mel-data mel-bin) (+ val (mel-data mel-bin))))
- (if (and (>= erb-bin 0)
- (< erb-bin data-len))
- (set! (erb-data erb-bin) (+ val (erb-data erb-bin))))))
-
- (if normalized
- (let ((bmx (vct-peak bark-data))
- (mmx (vct-peak mel-data))
- (emx (vct-peak erb-data)))
- (if (> (abs (- mx bmx)) .01)
- (vct-scale! bark-data (/ mx bmx)))
- (if (> (abs (- mx mmx)) .01)
- (vct-scale! mel-data (/ mx mmx)))
- (if (> (abs (- mx emx)) .01)
- (vct-scale! erb-data (/ mx emx))))))
+ (do ((i 0 (+ i 1)))
+ ((= i data-len))
+ (let* ((val (fftdata i))
+ (frq (* sr (/ i fftlen)))
+ (bark-bin (round (* bark-frqscl (- (bark frq) bark-low))))
+ (mel-bin (round (* mel-frqscl (- (mel frq) mel-low))))
+ (erb-bin (round (* erb-frqscl (- (erb frq) erb-low)))))
+ (if (and (>= bark-bin 0)
+ (< bark-bin data-len))
+ (set! (bark-data bark-bin) (+ val (bark-data bark-bin))))
+ (if (and (>= mel-bin 0)
+ (< mel-bin data-len))
+ (set! (mel-data mel-bin) (+ val (mel-data mel-bin))))
+ (if (and (>= erb-bin 0)
+ (< erb-bin data-len))
+ (set! (erb-data erb-bin) (+ val (erb-data erb-bin))))))
+
+ (if normalized
+ (let ((bmx (float-vector-peak bark-data))
+ (mmx (float-vector-peak mel-data))
+ (emx (float-vector-peak erb-data)))
+ (if (> (abs (- mx bmx)) .01)
+ (float-vector-scale! bark-data (/ mx bmx)))
+ (if (> (abs (- mx mmx)) .01)
+ (float-vector-scale! mel-data (/ mx mmx)))
+ (if (> (abs (- mx emx)) .01)
+ (float-vector-scale! erb-data (/ mx emx)))))
(graph (list bark-data mel-data erb-data)
"ignored"
@@ -1923,10 +2057,11 @@ and replaces it with the spectrum given in coeffs"
(list color1 color2 color3))) ; tell lisp graph display what colors to use
- (define (make-bark-labels snd chn)
+ (define (make-bark-labels hook)
;; at this point the x axis has no markings, but there is room for labels and ticks
-
- (let ((old-foreground-color (foreground-color snd chn copy-context)))
+ (let* ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (old-foreground-color (foreground-color snd chn copy-context)))
(let* ((axinfo (axis-info snd chn lisp-graph))
(axis-x0 (axinfo 10))
@@ -1960,8 +2095,8 @@ and replaces it with the spectrum given in coeffs"
(if bark-numbers-font (set! (current-font snd chn copy-context) bark-numbers-font))
(draw-line axis-x0 tick-y0 axis-x0 major-y0 snd chn copy-context cr)
- (let* ((i1000 (scale-position bark-function 1000.0))
- (i10000 (scale-position bark-function 10000.0)))
+ (let ((i1000 (scale-position bark-function 1000.0))
+ (i10000 (scale-position bark-function 10000.0)))
(draw-line i1000 tick-y0 i1000 major-y0 snd chn copy-context cr)
(draw-line i10000 tick-y0 i10000 major-y0 snd chn copy-context cr)
@@ -1974,12 +2109,12 @@ and replaces it with the spectrum given in coeffs"
(do ((i 100 (+ i 100)))
((= i 1000))
- (let* ((i100 (scale-position bark-function i)))
+ (let ((i100 (scale-position bark-function i)))
(draw-line i100 tick-y0 i100 minor-y0 snd chn copy-context cr)))
(do ((i 2000 (+ i 1000)))
((= i 10000))
- (let* ((i1000 (scale-position bark-function i)))
+ (let ((i1000 (scale-position bark-function i)))
(draw-line i1000 tick-y0 i1000 minor-y0 snd chn copy-context cr)))))
;; bark label/ticks
@@ -2004,38 +2139,38 @@ and replaces it with the spectrum given in coeffs"
(set! (foreground-color snd chn copy-context) old-foreground-color)))
;; mouse click = move to next scale's ticks
- (define (choose-bark-ticks snd chn button state x y axis)
- (if (= axis lisp-graph)
+ (define (choose-bark-ticks hook)
+ (if (= (hook 'axis) lisp-graph)
(begin
- (set! bark-tick-function (+ 1 bark-tick-function))
+ (set! bark-tick-function (+ bark-tick-function 1))
(if (> bark-tick-function 2)
(set! bark-tick-function 0))
- (update-lisp-graph snd chn))))
+ (update-lisp-graph (hook 'snd) (hook 'chn)))))
;; user's view of display-bark-fft function
(lambda* (off col1 col2 col3)
- (if col1 (set! color1 col1))
- (if col2 (set! color2 col2))
- (if col3 (set! color3 col3))
- (if (not off)
- (begin
- (hook-push lisp-graph-hook display-bark-fft-1)
- (hook-push after-lisp-graph-hook make-bark-labels)
- (hook-push mouse-click-hook choose-bark-ticks)
- (for-each (lambda (snd)
- (do ((c 0 (+ 1 c)))
- ((= c (channels snd)))
- (update-lisp-graph snd c)))
- (sounds)))
- (begin
- (hook-remove lisp-graph-hook display-bark-fft-1)
- (hook-remove after-lisp-graph-hook make-bark-labels)
- (hook-remove mouse-click-hook choose-bark-ticks)
- (for-each (lambda (snd)
- (do ((c 0 (+ 1 c)))
- ((= c (channels snd)))
- (set! (lisp-graph? snd c) #f)))
- (sounds))))))))
+ (if col1 (set! color1 col1))
+ (if col2 (set! color2 col2))
+ (if col3 (set! color3 col3))
+ (if (not off)
+ (begin
+ (hook-push lisp-graph-hook display-bark-fft-1)
+ (hook-push after-lisp-graph-hook make-bark-labels)
+ (hook-push mouse-click-hook choose-bark-ticks)
+ (for-each (lambda (snd)
+ (do ((c 0 (+ 1 c)))
+ ((= c (channels snd)))
+ (update-lisp-graph snd c)))
+ (sounds)))
+ (begin
+ (hook-remove lisp-graph-hook display-bark-fft-1)
+ (hook-remove after-lisp-graph-hook make-bark-labels)
+ (hook-remove mouse-click-hook choose-bark-ticks)
+ (for-each (lambda (snd)
+ (do ((c 0 (+ 1 c)))
+ ((= c (channels snd)))
+ (set! (lisp-graph? snd c) #f)))
+ (sounds))))))))
(define (undisplay-bark-fft) (display-bark-fft #t))
@@ -2043,301 +2178,355 @@ and replaces it with the spectrum given in coeffs"
;;; -------- lpc-coeffs, lpc-predict
-(define (lpc-coeffs data n m)
- ;; translated and changed to use 0-based arrays from memcof of NRinC
- ;; not vcts except incoming data here because we need double precision
-
- "(lpc-coeffs data n m) returns 'm' LPC coeffients (in a vector) given 'n' data points in the vct 'data'"
-
- (letrec ((sqr (lambda (x) (* x x))))
- (let ((d (make-vector m 0.0))
- (wk1 (make-vector n 0.0))
- (wk2 (make-vector n 0.0))
- (wkm (make-vector n 0.0)))
- (set! (wk1 0) (data 0))
- (set! (wk2 (- n 2)) (data (- n 1)))
- (do ((j 1 (+ 1 j)))
- ((= j (- n 1)))
- (set! (wk1 j) (data j))
- (set! (wk2 (- j 1)) (data j)))
- (do ((k 0 (+ 1 k)))
- ((= k m) d)
- (let ((num 0.0)
- (denom 0.0))
- (do ((j 0 (+ 1 j)))
- ((= j (- n k 1)))
- (set! num (+ num (* (wk1 j) (wk2 j))))
- (set! denom (+ denom (sqr (wk1 j)) (sqr (wk2 j)))))
- (if (not (= denom 0.0))
- (set! (d k) (/ (* 2.0 num) denom)))
- (do ((i 0 (+ i 1)))
- ((= i k)) ; 1st time is skipped presumably
- (set! (d i) (- (wkm i) (* (d k) (wkm (- k i 1))))))
- (if (< k (- m 1))
- (begin
- (do ((i 0 (+ i 1)))
- ((= i (+ 1 k)))
- (set! (wkm i) (d i)))
- (do ((j 0 (+ 1 j)))
- ((= j (- n k 2)))
- (set! (wk1 j) (- (wk1 j) (* (wkm k) (wk2 j))))
- (set! (wk2 j) (- (wk2 (+ 1 j)) (* (wkm k) (wk1 (+ 1 j)))))))))))))
-
-
-(define* (lpc-predict data n coeffs m nf clipped)
+(define lpc-coeffs
+ (let ((documentation "(lpc-coeffs data n m) returns 'm' LPC coeffients (in a vector) given 'n' data points in the float-vector 'data'"))
+ (lambda (data n m)
+
+ ;; translated and changed to use 0-based arrays from memcof of NRinC
+ (let ((d (make-float-vector m 0.0))
+ (wk1 (make-float-vector n 0.0))
+ (wk2 (make-float-vector n 0.0))
+ (wkm (make-float-vector n 0.0)))
+ (copy data wk1)
+ (do ((j 1 (+ j 1))
+ (k 0 (+ k 1)))
+ ((= j n))
+ (float-vector-set! wk2 k (float-vector-ref data j)))
+ (do ((k 0 (+ k 1)))
+ ((= k m) d)
+ (let ((end (- n k 1)))
+ (let ((num (dot-product wk1 wk2 end))
+ (denom (+ (dot-product wk1 wk1 end) (dot-product wk2 wk2 end))))
+ (if (not (= denom 0.0))
+ (set! (d k) (/ (* 2.0 num) denom))))
+ (let ((d-k (d k)))
+ (do ((i 0 (+ i 1))
+ (k1 (- k 1) (- k1 1)))
+ ((= i k)) ; 1st time is skipped presumably
+ (float-vector-set! d i (- (float-vector-ref wkm i) (* d-k (float-vector-ref wkm k1))))))
+ (if (< k (- m 1))
+ (let ((end (- n k 2)))
+ (copy d wkm 0 (+ k 1))
+ (let ((wkm-k (float-vector-ref wkm k))
+ (old-wk1 (copy wk1)))
+ (do ((j 0 (+ j 1)))
+ ((= j end))
+ (float-vector-set! wk1 j (- (float-vector-ref wk1 j) (* wkm-k (float-vector-ref wk2 j)))))
+ (do ((j 0 (+ j 1))
+ (j1 1 (+ j1 1)))
+ ((= j end))
+ (float-vector-set! wk2 j (- (float-vector-ref wk2 j1) (* wkm-k (float-vector-ref old-wk1 j1))))))))))))))
+
+(define lpc-predict
;; translated and changed to use 0-based arrays from predic of NRinC
;; incoming coeffs are assumed to be in a vector (from lpc-coeffs)
-
- "(lpc-predict data n coeffs m nf clipped) takes the output of lpc-coeffs ('coeffs', a vector) and the length thereof ('m'), \
-'n' data points of 'data' (a vct), and produces 'nf' new data points (in a vct) as its prediction. If 'clipped' is #t, the new data \
-is assumed to be outside -1.0 to 1.0."
-
- (let ((future (make-vct nf 0.0))
- (reg (make-vct m 0.0)))
- (do ((i 0 (+ i 1))
- (j (- n 1) (- j 1)))
- ((= i m))
- (set! (reg i) (data j)))
- (do ((j 0 (+ 1 j)))
- ((= j nf) future)
- (let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k m))
- (set! sum (+ sum (* (coeffs k) (reg k)))))
- (do ((k (- m 1) (- k 1)))
- ((= k 0))
- (set! (reg k) (reg (- k 1))))
-
- ;; added this block
- (if clipped
- (if (> sum 0.0)
- (if (< sum 1.0)
- (set! sum 1.0))
- (if (> sum -1.0)
- (set! sum -1.0))))
-
- (set! (reg 0) sum)
- (set! (future j) sum)))))
-
+ (let ((documentation "(lpc-predict data n coeffs m nf clipped) takes the output of lpc-coeffs ('coeffs', a float-vector) and the length thereof ('m'), \
+'n' data points of 'data' (a float-vector), and produces 'nf' new data points (in a float-vector) as its prediction. If 'clipped' is #t, the new data \
+is assumed to be outside -1.0 to 1.0."))
+ (lambda* (data n coeffs m nf clipped)
+ (let ((future (make-float-vector nf 0.0))
+ (reg (make-float-vector m 0.0)))
+ (do ((i 0 (+ i 1))
+ (j (- n 1) (- j 1)))
+ ((= i m))
+ (set! (reg i) (data j)))
+ (do ((j 0 (+ j 1)))
+ ((= j nf) future)
+ (let ((sum (dot-product coeffs reg m)))
+ (do ((k (- m 1) (- k 1)))
+ ((= k 0))
+ (set! (reg k) (reg (- k 1))))
+
+ ;; added this block
+ (if clipped
+ (if (> sum 0.0)
+ (if (< sum 1.0)
+ (set! sum 1.0))
+ (if (> sum -1.0)
+ (set! sum -1.0))))
+ (set! (reg 0) sum)
+ (set! (future j) sum)))))))
;;; -------- unclip-channel
-(define* (unclip-channel snd chn)
- "(unclip-channel snd chn) looks for clipped portions and tries to reconstruct the original using LPC"
- (let* ((clips 0) ; number of clipped portions * 2
- (unclipped-max 0.0))
-
- ;; count clipped portions (this search split into two portions for the optimizer's benefit)
- (let ((in-clip #f))
- (scan-channel
- (lambda (y)
- (let ((absy (abs y)))
- (if (> absy .9999) ; this sample is clipped
- (if (not in-clip)
- (set! in-clip #t))
- (begin ; not clipped
- (set! unclipped-max (max unclipped-max absy))
- (if in-clip
- (begin
- (set! in-clip #f)
- (set! clips (+ clips 2))))))
- #f))
- 0 (frames snd chn) snd chn))
-
- (if (> clips 0) ; we did find clipped portions
- (let* ((clip-data (make-vector clips 0)) ; clipped portion begin and end points
- (clip-beg 0)
- (clip-end 0)
- (in-clip #f)
- (cur-clip 0)
- (samp 0))
- (scan-channel
- (lambda (y)
- (let ((absy (abs y)))
- (if (> absy .9999)
- (if (not in-clip)
- (begin
- (set! in-clip #t)
- (set! clip-beg samp)))
- (begin ; not clipped
- (if in-clip ; if we were in a clipped portion
- (begin ; save the bounds in clip-data
- (set! in-clip #f)
- (set! (clip-data cur-clip) clip-beg)
- (set! (clip-data (+ 1 cur-clip)) (- samp 1))
- (set! cur-clip (+ cur-clip 2))))))
- (set! samp (+ 1 samp))
- #f)))
-
- ;; try to restore clipped portions
-
- (let ((min-data-len 32)
- (max-diff 0.0)
- (max-len 0))
- (as-one-edit
- (lambda ()
- (do ((clip 0 (+ clip 2))) ; so go through all...
- ((>= clip clips))
- (let* ((clip-beg (clip-data clip)) ; clip-beg to clip-end inclusive are clipped
- (clip-end (clip-data (+ 1 clip)))
- (clip-len (+ 1 (- clip-end clip-beg)))
- (data-len (max min-data-len (* clip-len 4))))
-
- (if (> clip-len max-len)
- (set! max-len clip-len))
-
- (let ((forward-data-len data-len)
- (backward-data-len data-len)
- (previous-end (if (= clip 0) 0 (clip-data (- clip 1))))
- (next-beg (if (< clip (- clips 3)) (clip-data (+ clip 2)) (frames snd chn))))
-
- (if (< (- clip-beg data-len) previous-end) ; current beg - data collides with previous
- (begin
- ;; (format #t ";[~A] collision at ~A -> [~A : ~A]" clip previous-end clip-beg clip-end)
- (set! forward-data-len (max 4 (- clip-beg previous-end)))))
+(define unclip-channel
+ (let ((documentation "(unclip-channel snd chn) looks for clipped portions and tries to reconstruct the original using LPC"))
+ (lambda* (snd chn)
+ (let ((clips 0) ; number of clipped portions * 2
+ (unclipped-max 0.0)
+ (len (framples snd chn))
+ (data (channel->float-vector 0 #f snd chn))
+ (clip-size 1000)
+ (clip-data (make-vector 1000 0)))
+ ;; count clipped portions
+ (let ((in-clip #f)
+ (clip-beg 0))
+ (float-vector-abs! data)
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (if (> (float-vector-ref data i) .9999) ; this sample is clipped
+ (if (not in-clip)
+ (begin
+ (set! in-clip #t)
+ (set! clip-beg i)))
+ (begin ; not clipped
+ (set! unclipped-max (max unclipped-max (float-vector-ref data i))) ; this is not the same as (float-vector-peak ...)
+ (if in-clip
+ (begin
+ (set! in-clip #f)
+ (set! (clip-data clips) clip-beg)
+ (set! (clip-data (+ 1 clips)) (- i 1))
+ (set! clips (+ clips 2))
+ (if (> clips clip-size)
+ (let ((new-clip-data (make-vector (* 2 clip-size) 0)))
+ (copy clip-data new-clip-data)
+ (set! clip-data new-clip-data)
+ (set! clip-size (* 2 clip-size))))))))))
+
+ (if (> clips 0)
+ ;; try to restore clipped portions
+
+ (let ((min-data-len 32)
+ (max-len 0))
+ (as-one-edit
+ (lambda ()
+ (do ((clip 0 (+ clip 2))) ; so go through all...
+ ((>= clip clips))
+ (let* ((clip-beg (clip-data clip)) ; clip-beg to clip-end inclusive are clipped
+ (clip-end (clip-data (+ 1 clip)))
+ (clip-len (+ 1 (- clip-end clip-beg)))
+ (data-len (max min-data-len (* clip-len 4))))
- (if (> (+ clip-end data-len) next-beg) ; current end + data collides with next
- (begin
- ;; (format #t ";[~A] collision at [~A : ~A] -> ~A" clip clip-beg clip-end next-beg)
- (set! backward-data-len (max 4 (- next-beg clip-end)))))
+ (if (> clip-len max-len)
+ (set! max-len clip-len))
- (let ((forward-predict-len (min (max clip-len (floor (/ forward-data-len 2))) forward-data-len))
- (backward-predict-len (min (max clip-len (floor (/ backward-data-len 2))) backward-data-len)))
+ (let ((forward-data-len data-len)
+ (backward-data-len data-len)
+ (previous-end (if (= clip 0) 0 (clip-data (- clip 1))))
+ (next-beg (if (< clip (- clips 3)) (clip-data (+ clip 2)) (framples snd chn))))
- ;; use LPC to reconstruct going both forwards and backwards
+ (if (< (- clip-beg data-len) previous-end) ; current beg - data collides with previous
+ (set! forward-data-len (max 4 (- clip-beg previous-end))))
- (let* ((data (channel->vct (- clip-beg forward-data-len) forward-data-len snd chn))
- (future (lpc-predict
- data forward-data-len
- (lpc-coeffs data forward-data-len forward-predict-len)
- forward-predict-len
- clip-len #f))
-
- (rdata (vct-reverse! (channel->vct (+ 1 clip-end) backward-data-len snd chn)))
- (past (lpc-predict
- rdata backward-data-len
- (lpc-coeffs rdata backward-data-len backward-predict-len)
- backward-predict-len
- clip-len #f))
-
- (new-data (make-vct clip-len 0.0)))
+ (if (> (+ clip-end data-len) next-beg) ; current end + data collides with next
+ (set! backward-data-len (max 4 (- next-beg clip-end))))
+
+ (let ((forward-predict-len (min (max clip-len (floor (/ forward-data-len 2))) forward-data-len))
+ (backward-predict-len (min (max clip-len (floor (/ backward-data-len 2))) backward-data-len)))
- (if (> clip-len 1)
- (do ((i 0 (+ i 1))
- (j (- clip-len 1) (- j 1)))
- ((= i clip-len))
- (let* ((sn (* 0.5 (+ 1.0 (cos (* pi (/ i (- clip-len 1))))))))
- (set! (new-data i) (+ (* sn
- (future i))
- (* (- 1.0 sn)
- (past j))))))
-
- ;; todo perhaps move this mix dependent on data-lens?
- ;; todo perhaps special case for 2 samps (what if both 1.0 for example?)
- ;; todo perhaps if multichannel and channels are correlated and one is not clipped -- use
- ;; its data to help reconstruct clipped case?
-
- (set! (new-data 0) (if (> (future 0) 0.0)
- (max (future 0) (past 0))
- (min (future 0) (past 0)))))
+ ;; use LPC to reconstruct going both forwards and backwards
- ;; write reconstruction
- (vct->channel new-data clip-beg clip-len snd chn))))))))
+ (let* ((data (channel->float-vector (- clip-beg forward-data-len) forward-data-len snd chn))
+ (future (lpc-predict
+ data forward-data-len
+ (lpc-coeffs data forward-data-len forward-predict-len)
+ forward-predict-len
+ clip-len #f))
+
+ (rdata (reverse! (channel->float-vector (+ 1 clip-end) backward-data-len snd chn)))
+ (past (lpc-predict
+ rdata backward-data-len
+ (lpc-coeffs rdata backward-data-len backward-predict-len)
+ backward-predict-len
+ clip-len #f))
+
+ (new-data (make-float-vector clip-len 0.0)))
+
+ (if (> clip-len 1)
+ (do ((i 0 (+ i 1))
+ (j (- clip-len 1) (- j 1)))
+ ((= i clip-len))
+ (let ((sn (* 0.5 (+ 1.0 (cos (* pi (/ i (- clip-len 1))))))))
+ (set! (new-data i) (+ (* sn
+ (future i))
+ (* (- 1.0 sn)
+ (past j))))))
+
+ ;; todo perhaps move this mix dependent on data-lens?
+ ;; todo perhaps special case for 2 samps (what if both 1.0 for example?)
+ ;; todo perhaps if multichannel and channels are correlated and one is not clipped -- use
+ ;; its data to help reconstruct clipped case?
+
+ (set! (new-data 0) (if (> (future 0) 0.0)
+ (max (future 0) (past 0))
+ (min (future 0) (past 0)))))
+
+ ;; write reconstruction
+ (float-vector->channel new-data clip-beg clip-len snd chn))))))))
+
+ (if (> unclipped-max .95) (set! unclipped-max .999))
+ (scale-channel (/ unclipped-max (maxamp snd chn)) 0 (framples snd chn) snd chn)
+ (list 'max unclipped-max 'clips (/ clips 2) 'max-len max-len))
- (if (> unclipped-max .95) (set! unclipped-max .999))
- (scale-channel (/ unclipped-max (maxamp snd chn)) 0 (frames snd chn) snd chn)
- (list 'max unclipped-max 'clips (/ clips 2) 'max-len max-len)))
-
- 'no-clips)))
+ 'no-clips)))))
-(define* (unclip-sound snd)
- "(unclip-sound snd) applies unclip-channel to each channel of 'snd'."
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "unclip-sound" snd))
- (let ((chns (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (unclip-channel index chn))))))
+(define unclip-sound
+ (let ((documentation "(unclip-sound snd) applies unclip-channel to each channel of 'snd'."))
+ (lambda* (snd)
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (not (sound? index))
+ (error 'no-such-sound (list "unclip-sound" snd))
+ (let ((chns (channels index)))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn chns))
+ (unclip-channel index chn))))))))
(define* (kalman-filter-channel (Q 1.0e-5))
;; translated from http://www.scipy.org/Cookbook/KalmanFiltering by Andrew Straw (but "R" here is a signal)
- (let* ((size (frames))
- (mx (maxamp))
- (data (channel->vct 0))
- (xhat 0.0)
- (P 1.0) ; any non-zero value ok here
- (R 0.01) ; first guess
- (Pminus 0.0)
- (frm (make-formant :radius (- 1.0 (/ 2000.0 (srate))) :frequency 1000))
- (del (make-moving-average 256))
- (K 0.0))
-
- (run
- (do ((k 1 (+ 1 k)))
- ((= k size))
- (let ((datum (data k))
- (xhatminus xhat))
-
- (let* ((res (formant frm datum))
- (avg (moving-average del (abs res))))
- (set! R (/ .000001 (+ avg .001))))
- ;; K now goes between say .5 if avg large to almost 0 if avg 0 (R is inverse essentially)
- ;; so filter lp effect increases as apparent true signal decreases
- ;; "truth" here is based on vocal resonances
-
- (set! (data k) xhatminus) ; filter output
-
- (set! Pminus (+ P Q))
- (set! K (/ Pminus (+ Pminus R)))
- (set! xhat (+ xhatminus
- (* K (- datum xhatminus))))
- (set! P (* (- 1.0 K) Pminus)))))
+ (let ((size (framples))
+ (mx (maxamp))
+ (data (channel->float-vector 0))
+ (xhat 0.0)
+ (P 1.0) ; any non-zero value ok here
+ (R 0.01) ; first guess
+ (Pminus 0.0)
+ (frm (make-formant :radius (- 1.0 (/ 2000.0 (srate))) :frequency 1000))
+ (del (make-moving-average 256))
+ (K 0.0))
- (as-one-edit
- (lambda ()
- (vct->channel data)
- (scale-to mx)))))
-
+ (do ((k 1 (+ k 1)))
+ ((= k size))
+ (let ((datum (data k))
+ (xhatminus xhat))
+
+ (let* ((res (formant frm datum))
+ (avg (moving-average del (abs res))))
+ (set! R (/ .000001 (+ avg .001))))
+ ;; K now goes between say .5 if avg large to almost 0 if avg 0 (R is inverse essentially)
+ ;; so filter lp effect increases as apparent true signal decreases
+ ;; "truth" here is based on vocal resonances
+
+ (set! (data k) xhatminus) ; filter output
+
+ (set! Pminus (+ P Q))
+ (set! K (/ Pminus (+ Pminus R)))
+ (set! xhat (+ xhatminus
+ (* K (- datum xhatminus))))
+ (set! P (* (- 1.0 K) Pminus))))
+
+ (float-vector-scale! data (/ mx (float-vector-peak data)))
+ (float-vector->channel data)))
-;;; -------- Savitzky-Golay filter coefficients (FIR filter -- returns vct of coeffs centered at vct midpoint)
+;;; -------- Savitzky-Golay filter coefficients (FIR filter -- returns float-vector of coeffs centered at float-vector midpoint)
;;;
;;; based on Numerical Recipes in C p 652
-;;; needs mixer-solve in mixer.scm
+
+(define invert-matrix
+ (let ((documentation "(invert-matrix matrix b (zero 1.0e-7)) inverts 'matrix'"))
+ (lambda* (matrix b (zero 1.0e-7))
+ ;; translated from Numerical Recipes (gaussj)
+
+ ;(format #t "~%~%invert-matrix n: ~D, ~S, b: ~A, ~S~%" (length matrix) matrix (and b (length b)) b)
+ (call-with-exit
+ (lambda (return)
+ (let* ((n (car (vector-dimensions matrix)))
+ (cols (make-vector n 0))
+ (rows (make-vector n 0))
+ (pivots (make-vector n 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((biggest 0.0)
+ (col 0)
+ (row 0))
+ (do ((j 0 (+ j 1)))
+ ((= j n))
+ ;(format #t "j: ~A, n: ~A~%" j n)
+ (if (not (= (pivots j) 1))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (if (= (pivots k) 0)
+ (let ((val (abs (matrix j k))))
+ (if (> val biggest)
+ (begin
+ (set! col k)
+ (set! row j)
+ ;(format #t "k: ~A, row: ~D, col: ~A~%" k row col)
+ (set! biggest val))))
+ (if (> (pivots k) 1)
+ (return #f))))))
+ (if (< biggest zero) (return #f)) ; this can be fooled (floats...): (invert-matrix (make-share-vector (float-vector 1 2 3 3 2 1 4 5 6) (list 3 3)))
+ (set! (pivots col) (+ (pivots col) 1))
+ ;(format #t "i: ~D, row: ~D, col: ~A~%" i row col)
+ (if (not (= row col))
+ (let ((temp (if b (b row) 0.0)))
+ (if b
+ (begin
+ (set! (b row) (b col))
+ (set! (b col) temp)))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! temp (matrix row k))
+ (set! (matrix row k) (matrix col k))
+ (set! (matrix col k) temp))))
+ (set! (cols i) col)
+ (set! (rows i) row)
+ ;; round-off troubles here
+ (if (< (abs (matrix col col)) zero)
+ (return #f))
+ (let ((inverse-pivot (/ 1.0 (matrix col col))))
+ (set! (matrix col col) 1.0)
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! (matrix col k) (* inverse-pivot (matrix col k))))
+ (if b (set! (b col) (* inverse-pivot (b col)))))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (if (not (= k col))
+ (let ((scl (matrix k col)))
+ (set! (matrix k col) 0.0)
+ (do ((m 0 (+ 1 m)))
+ ((= m n))
+ (set! (matrix k m) (- (matrix k m) (* scl (matrix col m)))))
+ (if b (set! (b k) (- (b k) (* scl (b col))))))))))
+ (do ((i (- n 1) (- i 1)))
+ ((< i 0))
+ (if (not (= (rows i) (cols i)))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (let ((temp (matrix k (rows i))))
+ (set! (matrix k (rows i)) (matrix k (cols i)))
+ (set! (matrix k (cols i)) temp)))))
+ (list matrix b)))))))
+
+(define (matrix-solve A b)
+ (let ((val (invert-matrix A b)))
+ (and val (cadr val))))
(define* (make-savitzky-golay-filter size (order 2)) ;assuming symmetric filter (left = right)
(if (even? size)
- (set! size (+ 1 size)))
- (let* ((n (/ (- size 1) 2))
- (a (make-mixer (+ 1 order))))
+ (set! size (+ size 1)))
+ (let ((n (/ (- size 1) 2))
+ (a (make-float-vector (list (+ 1 order) (+ 1 order)) 0.0)))
(do ((i 0 (+ i 1)))
((> i (* order 2)))
(let ((sum (if (= i 0) 1.0 0.0)))
- (do ((k 1 (+ 1 k)))
- ((> k n))
- (set! sum (+ sum (expt k i) (expt (- k) i))))
+ (if (even? i)
+ (do ((k 1 (+ k 1)))
+ ((> k n))
+ ;(set! sum (+ sum (expt k i) (expt (- k) i))) ; kinda nuts
+ (set! sum (+ sum (* 2 (expt k i))))))
(let ((m i))
(if (> i (- (* 2 order) i))
(set! m (- (* 2 order) i)))
(do ((k (- m) (+ k 2)))
((> k m))
- (mixer-set! a (/ (+ i k) 2) (/ (- i k) 2) sum)))))
- (let ((b (mixer-solve a (let ((f (make-frame (+ order 1))))
- (frame-set! f 0 1.0) ; set others instead for derivative
- f)))
- (result (make-vct size)))
- (do ((k (- n) (+ 1 k))
+ (set! (a (/ (+ i k) 2) (/ (- i k) 2)) sum)))))
+ (let ((b (matrix-solve a (let ((f (make-float-vector (+ order 1) 0.0)))
+ (set! (f 0) 1.0) ; set others instead for derivative
+ f)))
+ (result (make-float-vector size 0.0)))
+ (do ((k (- n) (+ k 1))
(i 0 (+ i 1)))
((> k n))
- (let ((sum (frame-ref b 0))
+ (let ((sum (b 0))
(fac 1.0))
(do ((m 1 (+ 1 m)))
((> m order))
(set! fac (* fac k))
- (set! sum (+ sum (* (frame-ref b m) fac))))
+ (set! sum (+ sum (* (b m) fac))))
(set! (result i) sum)))
(make-fir-filter :order size :xcoeffs result))))
@@ -2370,42 +2559,45 @@ is assumed to be outside -1.0 to 1.0."
;;; -------- parallel FM spectrum calculator
-;(fm-parallel-component 200 2000.0 (list 2000.0 200.0) (list 0.5 1.0) '() '() #t)
-
-(define (fm-parallel-component freq-we-want wc wms inds ns bs using-sine)
- "(fm-parallel-component freq carrier modfreqs indices '() '() with-sines) returns the amplitude of \"freq\" in \
-the multi-modulator FM case described by the list of modulator frequencies and indices"
- (if (not (null? wms))
- (let* ((sum 0.0)
- (index (car inds))
- (mx (ceiling (* 7 index)))
- (wm (car wms)))
- (do ((k (- mx) (+ 1 k)))
- ((>= k mx) sum)
- (set! sum (+ sum (fm-parallel-component freq-we-want (+ wc (* k wm)) (cdr wms) (cdr inds)
- (append ns (list k)) (append bs (list index))
- using-sine)))))
- (if (< (abs (- freq-we-want (abs wc))) .1)
- (let ((bmult 1.0))
- (for-each
- (lambda (n index)
- (set! bmult (* bmult (bes-jn n index))))
- ns bs)
- (if (and using-sine (< wc 0.0)) (set! bmult (- bmult)))
- ;(format #t ";add ~A from ~A ~A" bmult ns bs)
- bmult)
- 0.0)))
+ ;(fm-parallel-component 200 2000.0 (list 2000.0 200.0) (list 0.5 1.0) () () #t)
+
+(define fm-parallel-component
+ (let ((documentation "(fm-parallel-component freq carrier modfreqs indices () () with-sines) returns the amplitude of \"freq\" in \
+the multi-modulator FM case described by the list of modulator frequencies and indices"))
+ (lambda (freq-we-want wc wms inds ns bs using-sine)
+ (if (pair? wms)
+ (let* ((sum 0.0)
+ (index (car inds))
+ (mx (ceiling (* 7 index)))
+ (wm (car wms)))
+ (do ((k (- mx) (+ k 1)))
+ ((>= k mx) sum)
+ (set! sum (+ sum (fm-parallel-component freq-we-want (+ wc (* k wm)) (cdr wms) (cdr inds)
+ (append ns (list k)) (append bs (list index))
+ using-sine)))))
+ (if (< (abs (- freq-we-want (abs wc))) .1)
+ (let ((bmult 1.0))
+ (for-each
+ (lambda (n index)
+ (set! bmult (* bmult (bes-jn n index))))
+ ns bs)
+ (if (and using-sine (< wc 0.0)) (set! bmult (- bmult)))
+ ;(format #t ";add ~A from ~A ~A" bmult ns bs)
+ bmult)
+ 0.0)))))
;;; this returns the component in FM with complex index (using-sine ignored for now)
+;;; this needs the Bessel functions (gsl or snd-test.scm)
(define (fm-complex-component freq-we-want wc wm a b interp using-sine)
- (let* ((sum 0.0)
- (mxa (ceiling (* 7 a)))
- (mxb (ceiling (* 7 b))))
- (do ((k (- mxa) (+ 1 k)))
+ (define (~,3f x) (format #f "~,3F" x))
+ (let ((sum 0.0)
+ (mxa (ceiling (* 7 a)))
+ (mxb (ceiling (* 7 b))))
+ (do ((k (- mxa) (+ k 1)))
((>= k mxa))
- (do ((j (- mxb) (+ 1 j)))
+ (do ((j (- mxb) (+ j 1)))
((>= j mxb))
(if (< (abs (- freq-we-want (+ wc (* k wm) (* j wm)))) 0.1)
(let ((curJI (* (bes-jn k a)
@@ -2413,7 +2605,7 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(expt 0.0+1.0i j))))
(set! sum (+ sum curJI))
(if (> (magnitude curJI) 0.001)
- (format #t ";fm-complex-component add ~A from J~D(~A) = ~A and I~D(~A) = ~A"
+ (format #t ";fm-complex-component add ~,3f from J~D(~A) = ~,3f and I~D(~A) = ~,3f~%"
curJI
k a (bes-jn k a)
j b (bes-in (abs j) b)))))))
@@ -2421,47 +2613,48 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(+ (* (- 1.0 interp) (real-part sum))
(* interp (imag-part sum))))))
-;(fm-complex-component 1200 1000 100 1.0 3.0 0.0 #f)
+ ;(fm-complex-component 1200 1000 100 1.0 3.0 0.0 #f)
+ ;(fm-complex-component 1200 1000 100 1.0 4.0 0.0 #f) hits the commentary
(define (fm-cascade-component freq-we-want wc wm1 a wm2 b)
- (let* ((sum 0.0)
- (mxa (ceiling (* 7 a)))
- (mxb (ceiling (* 7 b))))
- (do ((k (- mxa) (+ 1 k)))
+ (define (~,3f x) (format #f "~,3F" x))
+ (let ((sum 0.0)
+ (mxa (ceiling (* 7 a)))
+ (mxb (ceiling (* 7 b))))
+ (do ((k (- mxa) (+ k 1)))
((>= k mxa))
- (do ((j (- mxb) (+ 1 j)))
+ (do ((j (- mxb) (+ j 1)))
((>= j mxb))
(if (< (abs (- freq-we-want (+ wc (* k wm1) (* j wm2)))) 0.1)
(let ((curJJ (* (bes-jn k a)
(bes-jn j (* k b)))))
(set! sum (+ sum curJJ))
(if (> (magnitude curJJ) 0.001)
- (format #t ";fm-cascade-component add ~A from J~D(~A) = ~A and I~D(~A) = ~A"
+ (format #t ";fm-cascade-component add ~,3f from J~D(~A) = ~,3f and J~D(~A) = ~,3f~%"
curJJ
k a (bes-jn k a)
j b (bes-jn j (* k b))))))))
sum))
-
-;(fm-cascade-component 2000 2000 500 1.5 50 1.0)
+ ;(fm-cascade-component 2000 2000 500 1.5 50 1.0)
;;; waveshaping harmonic amplitude at a given index
(define (cheby-hka k a coeffs) ; (coeff 0 = DC)
- (let* ((sum 0.0)
- (n (length coeffs)))
- (do ((j 0 (+ 1 j)))
+ (let ((sum 0.0)
+ (n (length coeffs)))
+ (do ((j 0 (+ j 1)))
((= j n))
- (let* ((dsum 0.0)
- (p (+ k (* 2 j))))
+ (let ((dsum 0.0)
+ (p (+ k (* 2 j))))
(do ((i 0 (+ i 1)))
((>= (+ p (* 2 i)) n))
(set! dsum (+ dsum (* (expt -1 i)
- (* (coeffs (+ p (* 2 i)))
- (+ (binomial (+ p i) i)
- (binomial (+ p i -1) (- i 1))))))))
+ (coeffs (+ p (* 2 i)))
+ (+ (binomial (+ p i) i)
+ (binomial (+ p i -1) (- i 1)))))))
(set! sum (+ sum (* dsum
(expt a p)
(binomial p j))))))
@@ -2474,26 +2667,26 @@ the multi-modulator FM case described by the list of modulator frequencies and i
((= i 88200))
(outa i (* .5 (polyshape gen 0.25))))))
-(cheby-hka 1 0.25 (vct 0 .5 .25 .125 .125))
+(cheby-hka 1 0.25 (float-vector 0 .5 .25 .125 .125))
|#
;;; find not-so-spikey amps for waveshaping
(define* (flatten-partials any-partials (tries 32))
-
+
(define (cos-fft-to-max n cur-amps)
(let* ((size 1024)
- (fft-rl (make-vct size))
- (fft-im (make-vct size)))
+ (fft-rl (make-float-vector size))
+ (fft-im (make-float-vector size)))
(do ((i 0 (+ i 1))
(bin 2 (+ bin 2)))
((= i n))
(set! (fft-rl bin) (cur-amps i)))
- (vct-peak (mus-fft fft-rl fft-im size -1))))
-
+ (float-vector-peak (mus-fft fft-rl fft-im size -1))))
+
(let* ((partials (if (list? any-partials)
- (list->vct any-partials)
+ (apply float-vector any-partials)
any-partials))
(len (length partials))
(topk 0)
@@ -2509,34 +2702,33 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(set! topk (max topk hnum))
(set! sum (+ sum amp))))))))
(min-sum original-sum)
- (original-partials (let ((v (make-vct topk)))
+ (original-partials (let ((v (make-float-vector topk)))
(do ((i 0 (+ i 2)))
((>= i len) v)
(let ((hnum (partials i)))
(if (not (= hnum 0))
(set! (v (- hnum 1)) (partials (+ i 1))))))))
- (min-partials (vct-copy original-partials)))
-
- (if (<= topk (/ (log tries) (log 2)))
+ (min-partials (copy original-partials)))
+
+ (if (<= topk (log tries 2))
(set! tries (floor (expt 2 (- topk 1)))))
-
+
(do ((try 0 (+ 1 try)))
((= try tries))
- (let ((new-partials (vct-copy original-partials)))
- (do ((k 0 (+ 1 k)))
+ (let ((new-partials (copy original-partials)))
+ (do ((k 0 (+ k 1)))
((= k topk))
(if (> (random 1.0) 0.5)
(set! (new-partials k) (- (new-partials k)))))
(let ((new-sum (cos-fft-to-max topk new-partials)))
(if (< new-sum min-sum)
(begin
- (set! min-partials (vct-copy new-partials))
+ (set! min-partials (copy new-partials))
(set! min-sum new-sum))))))
-
- (let ((new-amps (vct-scale! min-partials (/ original-sum min-sum)))
- (new-partials (vct-copy partials)))
- (do ((i 0 (+ i 2))
- (k 0 (+ k 1)))
+
+ (let ((new-amps (float-vector-scale! min-partials (/ original-sum min-sum)))
+ (new-partials (copy partials)))
+ (do ((i 0 (+ i 2)))
((>= i len))
(let ((hnum (new-partials i)))
(if (= hnum 0)
@@ -2544,7 +2736,7 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(set! (new-partials (+ i 1)) (new-amps (- hnum 1))))))
new-partials)))
-
+
#|
(with-sound (:clipped #f :statistics #t :channels 2)
(let* ((amps (normalize-partials (list 1 .25 2 .5 3 .25)))
@@ -2562,15 +2754,15 @@ the multi-modulator FM case described by the list of modulator frequencies and i
;;; these are standard FFTs for s7
(define* (fft! rl im n (dir 1))
-
+
(if (not im)
(let ((clear (copy rl)))
(fill! clear 0.0)
(set! im clear)))
-
+
(if (not n)
(set! n (length rl)))
-
+
(do ((i 0 (+ i 1))
(j 0))
((= i n))
@@ -2608,8 +2800,8 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(let ((tempr (- (* wr (rl j)) (* wi (im j))))
(tempi (+ (* wr (im j)) (* wi (rl j)))))
(set! (rl j) (- (rl i) tempr))
- (set! (im j) (- (im i) tempi))
(set! (rl i) (+ (rl i) tempr))
+ (set! (im j) (- (im i) tempi))
(set! (im i) (+ (im i) tempi))))
(let ((wtemp wr))
(set! wr (- (* wr wpr) (* wi wpi)))
@@ -2619,9 +2811,9 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(define* (cfft! data n (dir 1))
-
+
(if (not n) (set! n (length data)))
-
+
(do ((i 0 (+ i 1))
(j 0))
((= i n))
@@ -2641,7 +2833,7 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(do ((lg 0 (+ lg 1))
(mmax 2 (* mmax 2))
(pow (/ n 2) (/ pow 2))
- (theta (make-rectangular 0.0 (* pi dir)) (* theta 0.5)))
+ (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
((= lg ipow))
(let ((wpc (exp theta))
(wc 1.0))
@@ -2656,7 +2848,7 @@ the multi-modulator FM case described by the list of modulator frequencies and i
(set! (data i) (+ (data i) tc))))
(set! wc (* wc wpc)))
(set! prev mmax))))
-
+
data)
@@ -2667,10 +2859,10 @@ the multi-modulator FM case described by the list of modulator frequencies and i
;;; #(1+1i -1+1i -1-1i 1-1i)
;;;
;;; ;; check against built-in FFT
-;;; > (let ((rl (vct 0.0 1.0 0.0 0.0))
-;;; (im (vct 0.0 1.0 0.0 0.0)))
+;;; > (let ((rl (float-vector 0.0 1.0 0.0 0.0))
+;;; (im (float-vector 0.0 1.0 0.0 0.0)))
;;; (mus-fft rl im)
-;;; (map make-rectangular (vct->list rl) (vct->list im)))
+;;; (map complex rl im))
;;; (1+1i -1+1i -1-1i 1-1i)
|#
diff --git a/edit-menu.scm b/edit-menu.scm
index 0b1b5ba..5f72c23 100644
--- a/edit-menu.scm
+++ b/edit-menu.scm
@@ -9,37 +9,38 @@
;;; -------- selection -> new file
-(define (selection->new)
- "(selection-<new) saves the selection in a new file, then opens that file"
- (if (selection?)
- (let ((new-file-name (snd-tempnam)))
- (save-selection new-file-name)
- (open-sound new-file-name))
- #f))
+(define selection->new
+ (let ((documentation "(selection-<new) saves the selection in a new file, then opens that file"))
+ (lambda ()
+ (and (selection?)
+ (let ((new-file-name (snd-tempnam)))
+ (save-selection new-file-name)
+ (open-sound new-file-name))))))
(add-to-menu edit-menu "Selection->new" selection->new 8) ;pos=8 puts this in the selection section in the Edit menu
;;; -------- cut selection -> new file
-(define (cut-selection->new)
- "(cut-selection->new) saves the selection, deletes it, then opens the saved file"
- (if (selection?)
- (let ((new-file-name (snd-tempnam)))
- (save-selection new-file-name)
- (delete-selection)
- (open-sound new-file-name))
- #f))
+(define cut-selection->new
+ (let ((documentation "(cut-selection->new) saves the selection, deletes it, then opens the saved file"))
+ (lambda ()
+ (and (selection?)
+ (let ((new-file-name (snd-tempnam)))
+ (save-selection new-file-name)
+ (delete-selection)
+ (open-sound new-file-name))))))
(add-to-menu edit-menu "Cut selection->new" cut-selection->new 9)
;;; -------- append selection
-(define (append-selection)
- "(append-selection) appends the current selection"
- (if (selection?)
- (insert-selection (frames))))
+(define append-selection
+ (let ((documentation "(append-selection) appends the current selection"))
+ (lambda ()
+ (if (selection?)
+ (insert-selection (framples))))))
(add-to-menu edit-menu "Append selection" append-selection 10)
@@ -48,7 +49,7 @@
(define (make-stereofile)
(let* ((ofile-name (file-name))
(old-sound (selected-sound))
- (nsnd (new-sound (string-append ofile-name ".stereo") (header-type) (data-format) (srate) 2)))
+ (nsnd (new-sound (string-append ofile-name ".stereo") 2 (srate) (sample-type) (header-type))))
(if (not nsnd)
(begin
(display "Could not make new sound.")(newline))
@@ -65,42 +66,44 @@
;;; -------- trim front and back (goes by first or last mark)
-(define (trim-front)
- "(trim-front) finds the first mark in each of the syncd channels and removes all samples before it"
- (let ((snc (sync)))
- (define (trim-front-one-channel snd chn)
- (if (< (length (marks snd chn)) 1)
- (report-in-minibuffer "trim-front needs a mark" snd)
- (delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (trim-front-one-channel snd chn)))
- (all-chans))
- (trim-front-one-channel
- (or (selected-sound) (car (sounds)))
- (or (selected-channel) 0)))))
+(define trim-front
+ (let ((documentation "(trim-front) finds the first mark in each of the syncd channels and removes all samples before it"))
+ (lambda ()
+ (let ((snc (sync)))
+ (define (trim-front-one-channel snd chn)
+ (if (< (length (marks snd chn)) 1)
+ (status-report "trim-front needs a mark" snd)
+ (delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)))
+ (if (> snc 0)
+ (apply map
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (trim-front-one-channel snd chn)))
+ (all-chans))
+ (trim-front-one-channel
+ (or (selected-sound) (car (sounds)))
+ (or (selected-channel) 0)))))))
(add-to-menu edit-menu "Trim front" trim-front)
-(define (trim-back)
- "(trim-back) finds the last mark in each of the syncd channels and removes all samples after it"
- (let ((snc (sync)))
- (define (trim-back-one-channel snd chn)
- (if (< (length (marks snd chn)) 1)
- (report-in-minibuffer "trim-back needs a mark" snd)
- (let ((endpt (mark-sample (car (reverse (marks snd chn))))))
- (delete-samples (+ endpt 1) (- (frames snd chn) endpt)))))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (trim-back-one-channel snd chn)))
- (all-chans))
- (trim-back-one-channel
- (or (selected-sound) (car (sounds)))
- (or (selected-channel) 0)))))
+(define trim-back
+ (let ((documentation "(trim-back) finds the last mark in each of the syncd channels and removes all samples after it"))
+ (lambda ()
+ (let ((snc (sync)))
+ (define (trim-back-one-channel snd chn)
+ (if (< (length (marks snd chn)) 1)
+ (status-report "trim-back needs a mark" snd)
+ (let ((endpt (mark-sample (car (reverse (marks snd chn))))))
+ (delete-samples (+ endpt 1) (- (framples snd chn) endpt)))))
+ (if (> snc 0)
+ (apply map
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (trim-back-one-channel snd chn)))
+ (all-chans))
+ (trim-back-one-channel
+ (or (selected-sound) (car (sounds)))
+ (or (selected-channel) 0)))))))
(add-to-menu edit-menu "Trim back" trim-back)
@@ -109,26 +112,27 @@
(define* (crop-one-channel snd chn)
(if (< (length (marks snd chn)) 2)
- (report-in-minibuffer "crop needs start and end marks" snd)
+ (status-report "crop needs start and end marks" snd)
(as-one-edit
(lambda ()
(delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)
(let ((endpt (mark-sample (car (reverse (marks snd chn))))))
- (delete-samples (+ endpt 1) (- (frames snd chn) endpt))))
+ (delete-samples (+ endpt 1) (- (framples snd chn) endpt))))
"crop-one-channel")))
-(define (crop)
- "(crop) finds the first and last marks in each of the syncd channels and removes all samples outside them"
- (let ((snc (sync)))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (crop-one-channel snd chn)))
- (all-chans))
- (crop-one-channel
- (or (selected-sound) (car (sounds)))
- (or (selected-channel) 0)))))
+(define crop
+ (let ((documentation "(crop) finds the first and last marks in each of the syncd channels and removes all samples outside them"))
+ (lambda ()
+ (let ((snc (sync)))
+ (if (> snc 0)
+ (apply map
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (crop-one-channel snd chn)))
+ (all-chans))
+ (crop-one-channel
+ (or (selected-sound) (car (sounds)))
+ (or (selected-channel) 0)))))))
(add-to-menu edit-menu "Crop" crop)
@@ -137,24 +141,33 @@
(if (and (not (provided? 'snd-gtk))
(provided? 'xm))
- (let* ((edit-cascade (list-ref (menu-widgets) 2))
- (edit-menu (cadr (XtGetValues edit-cascade (list XmNsubMenuId 0)))))
-
- (XtAddCallback edit-cascade XmNcascadingCallback
- (lambda (w c i)
- (for-each-child
- edit-menu
- (lambda (child)
- (if (or (string=? (XtName child) "Selection->new")
- (string=? (XtName child) "Cut selection->new")
- (string=? (XtName child) "Append selection"))
- (XtSetSensitive child (selection?))
- (if (string=? (XtName child) "Crop")
- (XtSetSensitive child (and (selected-sound)
- (> (length (marks (selected-sound) (selected-channel))) 1)))
- (if (or (string=? (XtName child) "Trim front")
- (string=? (XtName child) "Trim back"))
- (XtSetSensitive child (and (selected-sound)
- (>= (length (marks (selected-sound) (selected-channel))) 1))))))))))))
-
-
+ (with-let (sublet *motif*)
+ (let* ((edit-cascade (list-ref (menu-widgets) 2))
+ (edit-menu (cadr (XtGetValues edit-cascade (list XmNsubMenuId 0)))))
+
+ (define (for-each-child w func)
+ ;; (for-each-child w func) applies func to w and its descendents
+ (func w)
+ (if (XtIsComposite w)
+ (for-each
+ (lambda (n)
+ (for-each-child n func))
+ (cadr (XtGetValues w (list XmNchildren 0) 1)))))
+
+ (XtAddCallback edit-cascade XmNcascadingCallback
+ (lambda (w c i)
+ (for-each-child
+ edit-menu
+ (lambda (child)
+ (if (or (string=? (XtName child) "Selection->new")
+ (string=? (XtName child) "Cut selection->new")
+ (string=? (XtName child) "Append selection"))
+ (XtSetSensitive child (selection?))
+ (if (string=? (XtName child) "Crop")
+ (XtSetSensitive child (and (selected-sound)
+ (> (length (marks (selected-sound) (selected-channel))) 1)))
+ (if (or (string=? (XtName child) "Trim front")
+ (string=? (XtName child) "Trim back"))
+ (XtSetSensitive child (and (selected-sound)
+ (>= (length (marks (selected-sound) (selected-channel))) 1))))))))))))
+ )
diff --git a/edit123.scm b/edit123.scm
index 8aa7ac0..ff63e2f 100644
--- a/edit123.scm
+++ b/edit123.scm
@@ -24,6 +24,7 @@
;;; tom at tomroth.de
(provide 'snd-edit123.scm)
+(require snd-selection.scm)
(define status 0)
(define curpos 0)
@@ -37,16 +38,16 @@
(define (file-from-path curfile)
(let ((last-slash 0))
(do ((i 0 (+ 1 i)))
- ((= i (string-length curfile)))
- (if (char=? (string-ref curfile i) #\/)
+ ((= i (length curfile)))
+ (if (char=? (curfile i) #\/)
(set! last-slash i)))
(substring curfile (+ 1 last-slash))))
(define (directory-from-path curfile)
(let ((last-slash 0))
(do ((i 0 (+ 1 i)))
- ((= i (string-length curfile)))
- (if (char=? (string-ref curfile i) #\/)
+ ((= i (length curfile)))
+ (if (char=? (curfile i) #\/)
(set! last-slash i)))
(substring curfile 0 last-slash)))
@@ -54,7 +55,7 @@
;; find the next file in the sorted list, with wrap-around
(let ((choose-next (not (string? last-file-opened)))
(just-filename (file-from-path last-file-opened)))
- (call-with-current-continuation
+ (call-with-exit
(lambda (return)
(for-each
(lambda (file)
@@ -70,20 +71,20 @@
(set! current-directory dir)
(set! current-sorted-files (sort! (sound-files-in-directory dir) string<?)))
- (define (get-current-directory filename)
- (set! last-file-opened filename)
- (display last-file-opened)
- (let ((new-path (directory-from-path (mus-expand-filename filename))))
- (if (or (not (string? current-directory))
- (not (string=? current-directory new-path)))
- (get-current-files new-path)))
- #f)
+ (define (get-current-directory hook)
+ (let ((filename (hook 'name)))
+ (set! last-file-opened filename)
+ (display last-file-opened)
+ (let ((new-path (directory-from-path (mus-expand-filename filename))))
+ (if (or (not (string? current-directory))
+ (not (string=? current-directory new-path)))
+ (get-current-files new-path)))))
(lambda ()
(if (not (member get-current-files (hook-functions open-hook)))
(hook-push open-hook get-current-directory))
(if (and (not (string? last-file-opened))
- (not (null? (sounds))))
+ (pair? (sounds)))
(set! last-file-opened (file-name (or (selected-sound)
(car (sounds))))))
(if (not current-directory)
@@ -91,12 +92,12 @@
(get-current-files (getcwd))
(get-current-files (directory-from-path last-file-opened))))
(if (null? current-sorted-files)
- (throw 'no-such-file (list "open-next-file-in-directory" current-directory))
+ (error 'no-such-file (list "open-next-file-in-directory" current-directory))
(let ((next-file (find-next-file)))
(if (find-sound next-file)
- (throw 'file-already-open (list "open-next-file-in-directory" next-file))
+ (error 'file-already-open (list "open-next-file-in-directory" next-file))
(begin
- (if (not (null? (sounds)))
+ (if (pair? (sounds))
(close-sound (or (selected-sound) ; not sure this is what you want -- closes current file
(car (sounds)))))
(open-sound next-file)))))
@@ -104,31 +105,30 @@
(define (click-middle-button-to-open-next-file-in-directory)
(hook-push mouse-click-hook
- (lambda (snd chn button state x y axis)
- (if (= button 2)
- (open-next-file-in-directory)
- #f)))) ; else handle it normally
+ (lambda (hook)
+ (if (= (hook 'button) 2)
+ (set! (hook 'result) (open-next-file-in-directory))))))
;; or you could bind this (i.e. "(open-next-file-in-directory)") to some key.
(hook-push after-open-hook
- (lambda (snd)
+ (lambda (hook)
(set! status 0)
))
(hook-push start-playing-hook
- (lambda (snd)
+ (lambda (hook)
(set! is-playing 1)))
(hook-push stop-playing-hook
- (lambda (snd)
+ (lambda (hook)
(set! is-playing 0)))
(define (eos )
- (set! (cursor) (+ (selection-position) (selection-frames))))
+ (set! (cursor) (+ (selection-position) (selection-framples))))
(define (mark-named name)
(select-channel 0)
@@ -151,7 +151,7 @@
(make-selection pos1 pos2)
;(set! (x-bounds)
; (list (/ (selection-position) (srate))
- ; (/ (+ (selection-position) (selection-frames)) (srate))))
+ ; (/ (+ (selection-position) (selection-framples)) (srate))))
(play (selection)))
(define (test-mark-forw name length)
@@ -199,7 +199,7 @@
(make-selection (cursor) (+ (cursor) length))
;(set! (x-bounds)
; (list (/ (selection-position) (srate))
- ; (/ (+ (selection-position) (selection-frames)) (srate))))
+ ; (/ (+ (selection-position) (selection-framples)) (srate))))
(play (selection)))
@@ -215,35 +215,35 @@
(define (forward-selection)
(if (not (selection?)) (make-selection (cursor) (+ (cursor) 20000)))
- (if (< (selection-frames) 2000) (make-selection (- (cursor) 2000) (cursor)))
+ (if (< (selection-framples) 2000) (make-selection (- (cursor) 2000) (cursor)))
; is cursor inside of selection ?
- (if (or (< (cursor) (selection-position)) (> (cursor) (+ (selection-position) (selection-frames))))
+ (if (or (< (cursor) (selection-position)) (> (cursor) (+ (selection-position) (selection-framples))))
(begin
- (make-selection (cursor) (+ (cursor) (selection-frames)))
+ (make-selection (cursor) (+ (cursor) (selection-framples)))
(stop-playing)
(eos)))
- (if (and (>= (cursor) (selection-position)) (<= (cursor) (+ (selection-position) (selection-frames))))
+ (if (and (>= (cursor) (selection-position)) (<= (cursor) (+ (selection-position) (selection-framples))))
(begin
(stop-playing)
(eos)
- (make-selection (cursor) (+ (cursor) (selection-frames)))))
+ (make-selection (cursor) (+ (cursor) (selection-framples)))))
(play (selection)))
(define (backward-selection)
(if (not (selection?)) (make-selection (- (cursor) 20000) (cursor)))
- (if (< (selection-frames) 2000) (make-selection (- (cursor) 2000) (cursor)))
- (if (or (< (cursor) (selection-position)) (> (cursor) (+ (selection-position) (selection-frames))))
+ (if (< (selection-framples) 2000) (make-selection (- (cursor) 2000) (cursor)))
+ (if (or (< (cursor) (selection-position)) (> (cursor) (+ (selection-position) (selection-framples))))
(begin
- (make-selection (cursor) (- (cursor) (selection-frames)))
+ (make-selection (cursor) (- (cursor) (selection-framples)))
(stop-playing)
(set! (cursor) (selection-position))))
- (if (and (>= (cursor) (selection-position)) (<= (cursor) (+ (selection-position) (selection-frames))))
+ (if (and (>= (cursor) (selection-position)) (<= (cursor) (+ (selection-position) (selection-framples))))
(begin
(stop-playing)
(set! (cursor) (selection-position))))
- (make-selection (- (cursor) (selection-frames)) (cursor) )
+ (make-selection (- (cursor) (selection-framples)) (cursor) )
(play (selection)))
@@ -287,13 +287,9 @@
(let ((old-tracking (with-tracking-cursor)))
(set! (with-tracking-cursor) #t)
(hook-push stop-playing-hook
- (lambda (snd)
- (set! (with-tracking-cursor) old-tracking))))
-
- (let ((old-channel-style(channel-style (selected-sound))))
- (lambda (snd)
-
- (set! (channel-style snd) channels-superimposed)))
+ (lambda (hook)
+ (set! (with-tracking-cursor) old-tracking)
+ (set! (channel-style (hook 'snd)) channels-superimposed))))
(play (selected-sound) :start (cursor)))
(define (play-end)
@@ -314,14 +310,14 @@
;double-selection
(define (double-selection)
(set! (cursor) (selection-position))
- (make-selection (selection-position) (+ (selection-position)(* (selection-frames) 2)))
+ (make-selection (selection-position) (+ (selection-position)(* (selection-framples) 2)))
)
;half-selection
(define (half-selection)
(set! (cursor) (selection-position))
- (make-selection (selection-position) (+ (selection-position)(/ (selection-frames) 2)))
+ (make-selection (selection-position) (+ (selection-position)(/ (selection-framples) 2)))
)
;play-selection
@@ -354,24 +350,24 @@
(open-next-file-in-directory)
)
-(bind-key (char->integer #\d) 0 (lambda ()(delete-selection)))
-(bind-key (char->integer #\s) 0 (lambda () ( my_save)))
-(bind-key (char->integer #\c) 0 (lambda () (my_crop)))
-(bind-key (char->integer #\n) 0 (lambda () (open-next-file-in-directory)))
-(bind-key (char->integer #\ ) 8 (lambda () (stop-song)))
-(bind-key (char->integer #\c) 0 (lambda () (my_crop)))
-(bind-key (char->integer #\x) 0 (lambda () (half-selection)))
-(bind-key (char->integer #\X) 1 (lambda () (double-selection)))
-(bind-key (char->integer #\y) 0 (lambda () (double-selection)));german version
-(bind-key (char->integer #\z) 0 (lambda () (double-selection)));english version
+(bind-key (char->integer #\d) 0 delete-selection)
+(bind-key (char->integer #\s) 0 my_save)
+(bind-key (char->integer #\c) 0 my_crop)
+(bind-key (char->integer #\n) 0 open-next-file-in-directory)
+(bind-key (char->integer #\ ) 8 stop-song)
+(bind-key (char->integer #\c) 0 my_crop)
+(bind-key (char->integer #\x) 0 half-selection)
+(bind-key (char->integer #\X) 1 double-selection)
+(bind-key (char->integer #\y) 0 double-selection);german version
+(bind-key (char->integer #\z) 0 double-selection);english version
(bind-key (char->integer #\^) 0 (lambda () (my-play-selection-forw 50000 50000)))
(bind-key (char->integer #\^) 4 (lambda () (my-play-selection-backw 50000 50000)))
(bind-key (char->integer #\t) 8 (lambda () (play (selection))))
-(bind-key (char->integer #\p) 0 (lambda () (play-song)))
-(bind-key (char->integer #\P) 1 (lambda () (play-end)))
-(bind-key (char->integer #\p) 8 (lambda () (toggle-play)))
-(bind-key (char->integer #\3) 8 (lambda () (forward-selection)))
-(bind-key (char->integer #\2) 8 (lambda () (backward-selection)))
+(bind-key (char->integer #\p) 0 play-song)
+(bind-key (char->integer #\P) 1 play-end)
+(bind-key (char->integer #\p) 8 toggle-play)
+(bind-key (char->integer #\3) 8 forward-selection)
+(bind-key (char->integer #\2) 8 backward-selection)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; status
@@ -382,20 +378,18 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(bind-key #xFFBE 0 (lambda () (case status
- ((0) (mark-start 50000))
- ((1) (mark-start 50000))
- ((2) (mark-end 50000))
- ((3) (mark-end 40000))
+ ((0 1) (mark-start 50000))
+ ((2) (mark-end 50000))
+ ((3) (mark-end 40000))
(else (set! status 0))
)))
(bind-key (char->integer #\1) 0 (lambda () (case status
- ((0) (mark-start 50000))
- ((1) (mark-start 50000))
- ((2) (mark-end 50000))
- ((3) (mark-end 40000))
- (else (set! status 0))
+ ((0 1) (mark-start 50000))
+ ((2) (mark-end 50000))
+ ((3) (mark-end 40000))
+ (else (set! status 0))
)))
(bind-key (char->integer #\1) 4 (lambda () (case status
@@ -409,7 +403,6 @@
(bind-key (char->integer #\1) 8 (lambda () (case status
((0) (set! status 2))
((1) (set! status 3))
- ((2) (set! status 0))
((3) (set! status 1))
(else (set! status 0))
)))
@@ -446,9 +439,9 @@
(else (set! status 0))
)))
-(bind-key (char->integer #\p) 4 (lambda () (toggle-play)))
-(bind-key (char->integer #\p) 0 (lambda () (play-song)))
-(bind-key (char->integer #\P) 1 (lambda () (play-end)))
+(bind-key (char->integer #\p) 4 toggle-play)
+(bind-key (char->integer #\p) 0 play-song)
+(bind-key (char->integer #\P) 1 play-end)
; f fade in or out selection
(bind-key (char->integer #\f) 0 (lambda() (case status
@@ -465,7 +458,7 @@
((3) (goto-named-mark "end") (my-play-selection (- (cursor) 100000) (cursor)))
- ; (else (report-in-minibuffer "status:" (status) ) )
+ ; (else (status-report "status:" (status) ) )
)
)
)
@@ -476,13 +469,13 @@
; + zoom in
(bind-key (char->integer #\+) 0 (lambda () (set! (x-bounds)
(list (/ (selection-position) (srate))
- (/ (+ (selection-position) (selection-frames)) (srate))))
+ (/ (+ (selection-position) (selection-framples)) (srate))))
(cursor-on-left)
)
)
; - zoom out
-(bind-key (char->integer #\-) 0 (lambda () (let* ((curs (cursor)))
+(bind-key (char->integer #\-) 0 (lambda () (let ((curs (cursor)))
(set! (x-bounds) (list 0 5))
(set! (cursor) curs))
)
diff --git a/effects-utils.scm b/effects-utils.scm
index d526d8d..64e6ccb 100644
--- a/effects-utils.scm
+++ b/effects-utils.scm
@@ -1,269 +1,279 @@
(provide 'snd-effects-utils.scm)
-(if (not (provided? 'snd-motif)) (snd-error "effects-utils.scm is Motif-specific"))
-
-(if (not (provided? 'xm))
- (let ((hxm (dlopen "xm.so")))
- (if (string? hxm)
- (snd-error (format #f "new-effects.scm needs the xm module (either 'make xm' or build Snd with --with-static-xm): ~A" hxm))
- (dlinit hxm "Init_libxm"))))
-
-(define (raise-dialog w)
- "(raise-dialog w) tries to put 'w' on top of any widgets that are obscuring it"
- (if (and (Widget? w)
- (XtIsManaged w))
- (let ((parent (XtParent w)))
- (if (and (Widget? parent)
- (XtIsSubclass parent xmDialogShellWidgetClass))
- (XtPopup parent XtGrabNone)))))
-
-(define (activate-dialog dialog)
- "(activate-dialog dialog) makes 'dialog' active and brings it to the top of the currently displayed widgets"
- (if (not (XtIsManaged dialog))
- (XtManageChild dialog)
- (raise-dialog dialog)))
-
-(define (for-each-child w func)
- "(for-each-child w func) applies 'func' to 'w' and to its descendents"
- (func w)
- (if (XtIsComposite w)
- (for-each
- (lambda (n)
- (for-each-child n func))
- (cadr (XtGetValues w (list XmNchildren 0) 1)))))
-
-(define use-combo-box-for-fft-size #f) ; cross-synthesis fft size: radio-buttons or combo-box choice
-
-(define (current-screen)
- "(current-screen) returns the current X screen number of the current display"
- (DefaultScreenOfDisplay
- (XtDisplay (cadr (main-widgets)))))
-
-(if (not (defined? 'all-chans))
- (define (all-chans)
- "(all-chans) returns a list of all current sound objects and channel numbers"
- (let ((sndlist '())
- (chnlist '()))
- (for-each (lambda (snd)
- (do ((i (- (channels snd) 1) (- i 1)))
- ((< i 0))
- (set! sndlist (cons snd sndlist))
- (set! chnlist (cons i chnlist))))
- (sounds))
- (list sndlist chnlist))))
-
-(define (update-label effects)
- "(update-label effects) evaluates the elements of the list 'effects'"
- (if (not (null? effects))
- (begin
- ((car effects))
- (update-label (cdr effects)))))
-
-(define (effect-target-ok target)
- "(effect-target-ok target) returns #t if the current effect's chosen target is ready"
- (if (eq? target 'sound)
- (not (null? (sounds)))
- (if (eq? target 'selection)
- (selection?)
- (and (selected-sound)
- (>= (length (marks (selected-sound) (selected-channel))) 2)))))
-
-(define* (make-effect-dialog label ok-callback help-callback reset-callback target-ok-callback)
- "(make-effect-dialog label ok-callback help-callback reset-callback target-ok-callback) makes a standard effects dialog"
- ;; make a standard dialog
- (let* ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate label XmFONTLIST_DEFAULT_TAG))
- (new-dialog (XmCreateTemplateDialog
- (cadr (main-widgets)) label
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNokLabelString xok
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNtransient #f))))
- (for-each
- (lambda (button color)
- (XtVaSetValues
- (XmMessageBoxGetChild new-dialog button)
- (list XmNarmColor (selection-color)
- XmNbackground color)))
- (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
- (list (highlight-color) (highlight-color) (highlight-color)))
-
- (XtAddCallback new-dialog XmNcancelCallback (lambda (w c i) (XtUnmanageChild new-dialog)))
- (XtAddCallback new-dialog XmNhelpCallback help-callback) ; "Help"
- (XtAddCallback new-dialog XmNokCallback ok-callback) ; "DoIt"
-
- (if reset-callback
- ;; add a Reset button
- (let ((reset-button (XtCreateManagedWidget "Reset" xmPushButtonWidgetClass new-dialog
- (list XmNbackground (highlight-color)
- XmNforeground (BlackPixelOfScreen (current-screen))
- XmNarmColor (selection-color)))))
- (XtAddCallback reset-button XmNactivateCallback reset-callback)))
-
- (XmStringFree xhelp)
- (XmStringFree xok)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
-
- (if target-ok-callback
- (begin
- (XtSetSensitive (XmMessageBoxGetChild new-dialog XmDIALOG_OK_BUTTON) (target-ok-callback))
- (hook-push effects-hook
- (lambda ()
- (XtSetSensitive (XmMessageBoxGetChild new-dialog XmDIALOG_OK_BUTTON) (target-ok-callback)))))
- (begin
- (XtSetSensitive (XmMessageBoxGetChild new-dialog XmDIALOG_OK_BUTTON) (not (null? (sounds))))
- (hook-push effects-hook
- (lambda ()
- (XtSetSensitive (XmMessageBoxGetChild new-dialog XmDIALOG_OK_BUTTON) (not (null? (sounds))))))))
-
- new-dialog))
-
+(require snd-motif)
+(with-let *motif*
+
+ (define raise-dialog
+ (let ((documentation "(raise-dialog w) tries to put 'w' on top of any widgets that are obscuring it"))
+ (lambda (w)
+ (if (and (Widget? w)
+ (XtIsManaged w))
+ (let ((parent (XtParent w)))
+ (if (and (Widget? parent)
+ (XtIsSubclass parent xmDialogShellWidgetClass))
+ (XtPopup parent XtGrabNone)))))))
+
+ (define activate-dialog
+ (let ((documentation "(activate-dialog dialog) makes 'dialog' active and brings it to the top of the currently displayed widgets"))
+ (lambda (dialog)
+ (if (not (XtIsManaged dialog))
+ (XtManageChild dialog)
+ (raise-dialog dialog)))))
+
+ (define for-each-child
+ (let ((documentation "(for-each-child w func) applies 'func' to 'w' and to its descendents"))
+ (lambda (w func)
+ (func w)
+ (if (XtIsComposite w)
+ (for-each
+ (lambda (n)
+ (for-each-child n func))
+ (cadr (XtGetValues w (list XmNchildren 0) 1)))))))
+
+ (define use-combo-box-for-fft-size #f) ; cross-synthesis fft size: radio-buttons or combo-box choice
+
+ (define current-screen
+ (let ((documentation "(current-screen) returns the current X screen number of the current display"))
+ (lambda ()
+ (DefaultScreenOfDisplay
+ (XtDisplay (cadr (main-widgets)))))))
+
+ (if (not (defined? 'all-chans))
+ (define all-chans
+ (let ((documentation "(all-chans) returns a list of all current sound objects and channel numbers"))
+ (lambda ()
+ (let ((sndlist ())
+ (chnlist ()))
+ (for-each (lambda (snd)
+ (do ((i (- (channels snd) 1) (- i 1)))
+ ((< i 0))
+ (set! sndlist (cons snd sndlist))
+ (set! chnlist (cons i chnlist))))
+ (sounds))
+ (list sndlist chnlist))))))
+
+ (define update-label
+ (let ((documentation "(update-label effects) evaluates the elements of the list 'effects'"))
+ (lambda (effects)
+ (if (pair? effects)
+ (begin
+ ((car effects))
+ (update-label (cdr effects)))))))
+
+ (define effect-target-ok
+ (let ((documentation "(effect-target-ok target) returns #t if the current effect's chosen target is ready"))
+ (lambda (target)
+ (if (eq? target 'sound)
+ (pair? (sounds))
+ (if (eq? target 'selection)
+ (selection?)
+ (and (selected-sound)
+ (>= (length (marks (selected-sound) (selected-channel))) 2)))))))
+
+ (define make-effect-dialog
+ (let ((documentation "(make-effect-dialog label ok-callback help-callback reset-callback target-ok-callback) makes a standard effects dialog"))
+ (lambda* (label ok-callback help-callback reset-callback target-ok-callback)
+ ;; make a standard dialog
+ (let* ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate label XmFONTLIST_DEFAULT_TAG))
+ (new-dialog (XmCreateTemplateDialog
+ (cadr (main-widgets)) label
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNokLabelString xok
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground *basic-color*
+ XmNtransient #f))))
+ (for-each
+ (lambda (button color)
+ (XtVaSetValues
+ (XmMessageBoxGetChild new-dialog button)
+ (list XmNarmColor *selection-color*
+ XmNbackground color)))
+ (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
+ (list *highlight-color* *highlight-color* *highlight-color*))
+
+ (XtAddCallback new-dialog XmNcancelCallback (lambda (w c i) (XtUnmanageChild new-dialog)))
+ (XtAddCallback new-dialog XmNhelpCallback help-callback) ; "Help"
+ (XtAddCallback new-dialog XmNokCallback ok-callback) ; "DoIt"
+
+ (if reset-callback
+ ;; add a Reset button
+ (let ((reset-button (XtCreateManagedWidget "Reset" xmPushButtonWidgetClass new-dialog
+ (list XmNbackground *highlight-color*
+ XmNforeground (BlackPixelOfScreen (current-screen))
+ XmNarmColor *selection-color*))))
+ (XtAddCallback reset-button XmNactivateCallback reset-callback)))
+
+ (XmStringFree xhelp)
+ (XmStringFree xok)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+
+ (if target-ok-callback
+ (begin
+ (XtSetSensitive (XmMessageBoxGetChild new-dialog XmDIALOG_OK_BUTTON) (target-ok-callback))
+ (hook-push effects-hook
+ (lambda (hook)
+ (XtSetSensitive (XmMessageBoxGetChild new-dialog XmDIALOG_OK_BUTTON) (target-ok-callback)))))
+ (begin
+ (XtSetSensitive (XmMessageBoxGetChild new-dialog XmDIALOG_OK_BUTTON) (pair? (sounds)))
+ (hook-push effects-hook
+ (lambda (hook)
+ (XtSetSensitive (XmMessageBoxGetChild new-dialog XmDIALOG_OK_BUTTON) (pair? (sounds)))))))
+
+ new-dialog))))
+
+
;;; replacement for change-menu-label
-(define (change-label widget new-label)
- "(change-label widget new-label) changes the label of 'widget' to be 'new-label'"
- (if (provided? 'xg)
- (gtk_label_set_text (GTK_LABEL (gtk_bin_get_child (GTK_BIN widget))) new-label)
- (if (provided? 'xm)
- (let ((str (XmStringCreateLocalized new-label)))
- (XtSetValues widget (list XmNlabelString str))
- (XmStringFree str)))))
-
-
+ (define change-label
+ (let ((documentation "(change-label widget new-label) changes the label of 'widget' to be 'new-label'"))
+ (lambda (widget new-label)
+ (let ((str (XmStringCreateLocalized new-label)))
+ (XtSetValues widget (list XmNlabelString str))
+ (XmStringFree str)))))
+
+
;;; -------- log scaler widget
-
-(define log-scale-ticks 500) ; sets precision (to some extent) of slider
-
-(define (scale-log->linear lo val hi)
- "(scale-log->linear lo val hi) given user-relative low..val..hi returns val as scale-relative (0..log-scale-ticks)"
- (let* ((log2 (log 2.0)) ; using log 2 here to get equally spaced octaves
- (log-lo (/ (log (max lo 1.0)) log2))
- (log-hi (/ (log hi) log2))
- (log-val (/ (log val) log2)))
- (floor (* log-scale-ticks (/ (- log-val log-lo) (- log-hi log-lo))))))
-(define (scale-linear->log lo val hi)
- "(scale-linear->log lo val hi) given user-relative lo..hi and scale-relative val, returns the user-relative val"
- ;; since log-scale widget assumes 0..log-scale-ticks, val can be used as ratio (log-wise) between lo and hi
- (let* ((log2 (log 2.0))
- (log-lo (/ (log (max lo 1.0)) log2))
- (log-hi (/ (log hi) log2))
- (log-val (+ log-lo (* (/ val log-scale-ticks) (- log-hi log-lo)))))
- (expt 2.0 log-val)))
-
-(define (scale-log-label lo val hi)
- "(scale-log-label lo val hi) makes a log scale label"
- (format #f "~,2F" (scale-linear->log lo val hi)))
-
-(define (create-log-scale-widget parent title low initial high callback scale)
- "(create-log-scale-widget parent title low initial high callback scale) returns a log scale widget"
- (let* ((label (XtCreateManagedWidget (format #f "~,2F" initial) xmLabelWidgetClass parent
- (list XmNbackground (basic-color))))
- (scale (XtCreateManagedWidget "scale" xmScaleWidgetClass parent
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #f
- XmNminimum 0
- XmNmaximum log-scale-ticks
- XmNvalue (floor (scale-log->linear low initial high))
- XmNdecimalPoints 0
- XmNtitleString title
- XmNbackground (basic-color)))))
- (XtAddCallback scale XmNvalueChangedCallback
- (lambda (widget context info)
- (change-label label (scale-log-label low (.value info) high))))
- (XtAddCallback scale XmNdragCallback
- (lambda (widget context info)
- (change-label label (scale-log-label low (.value info) high))))
- scale))
-
-
+ (define log-scale-ticks 500) ; sets precision (to some extent) of slider
+
+ (define scale-log->linear
+ (let ((documentation "(scale-log->linear lo val hi) given user-relative low..val..hi returns val as scale-relative (0..log-scale-ticks)"))
+ (lambda (lo val hi)
+ (let ((log-lo (log (max lo 1.0) 2))
+ (log-hi (log hi 2))
+ (log-val (log val 2)))
+ (floor (* log-scale-ticks (/ (- log-val log-lo) (- log-hi log-lo))))))))
+
+ (define scale-linear->log
+ (let ((documentation "(scale-linear->log lo val hi) given user-relative lo..hi and scale-relative val, returns the user-relative val"))
+ (lambda (lo val hi)
+ ;; since log-scale widget assumes 0..log-scale-ticks, val can be used as ratio (log-wise) between lo and hi
+ (let* ((log-lo (log (max lo 1.0) 2))
+ (log-hi (log hi 2))
+ (log-val (+ log-lo (* (/ val log-scale-ticks) (- log-hi log-lo)))))
+ (expt 2.0 log-val)))))
+
+ (define scale-log-label
+ (let ((documentation "(scale-log-label lo val hi) makes a log scale label"))
+ (lambda (lo val hi)
+ (format #f "~,2F" (scale-linear->log lo val hi)))))
+
+ (define create-log-scale-widget
+ (let ((documentation "(create-log-scale-widget parent title low initial high callback scale) returns a log scale widget"))
+ (lambda (parent title low initial high callback scale)
+ (let ((label (XtCreateManagedWidget (format #f "~,2F" initial) xmLabelWidgetClass parent
+ (list XmNbackground *basic-color*)))
+ (scale (XtCreateManagedWidget "scale" xmScaleWidgetClass parent
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #f
+ XmNminimum 0
+ XmNmaximum log-scale-ticks
+ XmNvalue (floor (scale-log->linear low initial high))
+ XmNdecimalPoints 0
+ XmNtitleString title
+ XmNbackground *basic-color*))))
+ (XtAddCallback scale XmNvalueChangedCallback
+ (lambda (widget context info)
+ (change-label label (scale-log-label low (.value info) high))))
+ (XtAddCallback scale XmNdragCallback
+ (lambda (widget context info)
+ (change-label label (scale-log-label low (.value info) high))))
+ scale))))
+
+
;;; -------- semitone scaler widget
;;;
;;; set up like log scale (use 'semi in place of 'log),
;;; to get the ratio from the semitones, use (expt 2.0 (/ value 12.0)) -- semitones->ratio below
-
-(define semi-range 24) ; 2 octaves either way
-
-(define (semi-scale-label val)
- "(semi-scale-label val) makes a semitone label"
- (format #f "semitones: ~D" (- val semi-range)))
-
-(define (semitones->ratio val)
- "(semitones->ratio val) takes a semitone number 'val' and returns the corresponding float ratio"
- (expt 2.0 (/ val 12.0)))
-
-(define (ratio->semitones ratio)
- "(ratio->semitones ratio) takes a float ratio and returns the corresponding number of semitones"
- (round (* 12 (/ (log ratio) (log 2.0)))))
-
-(define (create-semi-scale-widget parent title initial callback)
- "(create-semi-scale-widget parent title initial callback) returns a semitone scale widget"
- (let* ((label (XtCreateManagedWidget (format #f "semitones: ~D" (ratio->semitones initial)) xmLabelWidgetClass parent
- (list XmNbackground (basic-color))))
- (scale (XtCreateManagedWidget "scale" xmScaleWidgetClass parent
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #f
- XmNminimum 0
- XmNmaximum (* 2 semi-range)
- XmNvalue (+ semi-range (ratio->semitones initial))
- XmNdecimalPoints 0
- XmNtitleString title
- XmNbackground (basic-color)))))
- (XtAddCallback scale XmNvalueChangedCallback
- (lambda (widget context info)
- (change-label label (semi-scale-label (.value info)))))
- (XtAddCallback scale XmNdragCallback
- (lambda (widget context info)
- (change-label label (semi-scale-label (.value info)))))
- scale))
-
-(define* (add-sliders dialog sliders)
- "(add-sliders dialog sliders) takes 'sliders', a list of lists, each inner list being (title low initial high callback scale ['log]) \
-and returns a list of widgets (for reset callbacks)"
- (let* ((mainfrm (XtCreateManagedWidget "formd" xmFormWidgetClass dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild dialog XmDIALOG_SEPARATOR)
- XmNbackground (highlight-color))))
- (mainform (XtCreateManagedWidget "formd" xmRowColumnWidgetClass mainfrm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNbackground (highlight-color)
- XmNorientation XmVERTICAL))))
- (map
- (lambda (slider-data)
- (let* ((title (XmStringCreate (list-ref slider-data 0) XmFONTLIST_DEFAULT_TAG))
- (low (list-ref slider-data 1))
- (initial (list-ref slider-data 2))
- (high (list-ref slider-data 3))
- (func (list-ref slider-data 4))
- (scale (list-ref slider-data 5))
- (new-slider (if (= (length slider-data) 7)
- (if (eq? (list-ref slider-data 6) 'log)
- (create-log-scale-widget mainform title low initial high func scale)
- (create-semi-scale-widget mainform title initial func))
- (XtCreateManagedWidget (car slider-data) xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNminimum (floor (* low scale))
- XmNmaximum (floor (* high scale))
- XmNvalue (floor (* initial scale))
- XmNdecimalPoints (if (= scale 10000) 4 (if (= scale 1000) 3 (if (= scale 100) 2 (if (= scale 10) 1 0))))
- XmNtitleString title
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNbackground (basic-color))))))
- (XmStringFree title)
- (XtAddCallback new-slider XmNvalueChangedCallback func)
- new-slider))
- sliders)))
-
+
+ (define semi-range 24) ; 2 octaves either way
+
+ (define semi-scale-label
+ (let ((documentation "(semi-scale-label val) makes a semitone label"))
+ (lambda (val)
+ (format #f "semitones: ~D" (- val semi-range)))))
+
+ (define semitones->ratio
+ (let ((documentation "(semitones->ratio val) takes a semitone number 'val' and returns the corresponding float ratio"))
+ (lambda (val)
+ (expt 2.0 (/ val 12.0)))))
+
+ (define ratio->semitones
+ (let ((documentation "(ratio->semitones ratio) takes a float ratio and returns the corresponding number of semitones"))
+ (lambda (ratio)
+ (round (* 12 (log ratio 2))))))
+
+ (define create-semi-scale-widget
+ (let ((documentation "(create-semi-scale-widget parent title initial callback) returns a semitone scale widget"))
+ (lambda (parent title initial callback)
+ (let ((label (XtCreateManagedWidget (format #f "semitones: ~D" (ratio->semitones initial)) xmLabelWidgetClass parent
+ (list XmNbackground *basic-color*)))
+ (scale (XtCreateManagedWidget "scale" xmScaleWidgetClass parent
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #f
+ XmNminimum 0
+ XmNmaximum (* 2 semi-range)
+ XmNvalue (+ semi-range (ratio->semitones initial))
+ XmNdecimalPoints 0
+ XmNtitleString title
+ XmNbackground *basic-color*))))
+ (XtAddCallback scale XmNvalueChangedCallback
+ (lambda (widget context info)
+ (change-label label (semi-scale-label (.value info)))))
+ (XtAddCallback scale XmNdragCallback
+ (lambda (widget context info)
+ (change-label label (semi-scale-label (.value info)))))
+ scale))))
+
+ (define add-sliders
+ (let ((documentation "(add-sliders dialog sliders) takes 'sliders', a list of lists, each inner list being (title low initial high callback scale ['log]) \
+and returns a list of widgets (for reset callbacks)"))
+ (lambda* (dialog sliders)
+ (let* ((mainfrm (XtCreateManagedWidget "formd" xmFormWidgetClass dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild dialog XmDIALOG_SEPARATOR)
+ XmNbackground *highlight-color*)))
+ (mainform (XtCreateManagedWidget "formd" xmRowColumnWidgetClass mainfrm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNbackground *highlight-color*
+ XmNorientation XmVERTICAL))))
+ (map
+ (lambda (slider-data)
+ (let* ((title (XmStringCreate (slider-data 0) XmFONTLIST_DEFAULT_TAG))
+ (low (slider-data 1))
+ (initial (slider-data 2))
+ (high (slider-data 3))
+ (func (slider-data 4))
+ (scale (slider-data 5))
+ (new-slider (if (= (length slider-data) 7)
+ (if (eq? (slider-data 6) 'log)
+ (create-log-scale-widget mainform title low initial high func scale)
+ (create-semi-scale-widget mainform title initial func))
+ (XtCreateManagedWidget (car slider-data) xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNminimum (floor (* low scale))
+ XmNmaximum (floor (* high scale))
+ XmNvalue (floor (* initial scale))
+ XmNdecimalPoints (if (= scale 10000) 4 (if (= scale 1000) 3 (if (= scale 100) 2 (if (= scale 10) 1 0))))
+ XmNtitleString title
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNbackground *basic-color*)))))
+ (XmStringFree title)
+ (XtAddCallback new-slider XmNvalueChangedCallback func)
+ new-slider))
+ sliders)))))
+
+ )
diff --git a/effects.fs b/effects.fs
index a2d617f..529fa93 100644
--- a/effects.fs
+++ b/effects.fs
@@ -1,92 +1,94 @@
\ effects.fs -- *effects*.scm -> effects.fs
\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Sun Oct 16 23:04:30 CEST 2005
-\ Changed: Sat Feb 19 17:25:18 CET 2011
-
-\ Commentary:
+\ Created: 05/10/16 23:04:30
+\ Changed: 14/04/28 03:52:17
\
+\ @(#)effects.fs 1.56 4/28/14
+
\ General (nogui/motif/gtk)
\
-\ effects-squelch-channel ( amount gate-size :optional snd chn -- )
-\ effects-echo ( in-samps delay-time echo-amount :optional beg dur snd chn -- )
-\ effects-flecho ( scaler secs input-samps :optional beg dur snd chn -- )
-\ effects-zecho ( scaler secs freq amp input-samps :optional beg dur snd chn -- )
-\ effects-bbp ( freq bw :optional beg dur snd chn -- res )
-\ effects-bbr ( freq bw :optional beg dur snd chn -- res )
-\ effects-bhp ( freq :optional beg dur snd chn -- res )
-\ effects-blp ( freq :optional beg dur snd chn -- res )
-\ effects-comb-filter ( scaler size :optional beg dur snd chn -- res )
-\ effects-comb-chord ( scaler size amp :optional beg dur snd chn -- res )
-\ effects-moog ( freq Q :optional beg dur snd chn -- res )
-\ moog ( freq Q -- prc; inval self -- res )
-\ effects-am ( freq en :optional beg dur snd chn -- res )
-\ effects-rm ( freq en :optional beg dur snd chn -- res )
-\ effects-jc-reverb ( samps volume -- prc; inval self -- res )
-\ effects-jc-reverb-1 ( volume :optional beg dur snd chn -- res )
-\ effects-cnv ( snd0 amp snd chn -- res )
-\ effects-position-sound ( mono-snd pos :optional snd chn -- res )
-\ effects-place-sound ( mono-snd stereo-snd pan-env -- res )
-\ effects-flange ( amount speed time :optional beg dur snd chn -- res )
-\ effects-cross-synthesis ( snd amp fftsize r -- prc; inval self -- res )
-\ effects-cross-synthesis-1 ( cross-snd amp fftsize r :optional beg dur snd chn -- res )
-\ effects-fp ( srf amp freq :optional beg dur snd chn -- vct )
-\ effects-hello-dentist ( freq amp :optional beg dur snd chn -- res )
-\ effects-remove-clicks ( :optional snd chn -- res )
-\ effects-remove-dc ( :optional snd chn -- res )
-\ effects-compand ( :optional snd chn -- res )
+\ effects-squelch-channel ( amount gate-size :optional snd chn -- )
+\ effects-echo ( is dtime eamt :optional beg dur snd chn -- )
+\ effects-flecho ( scl secs ismps :optional beg dur snd chn -- )
+\ effects-zecho ( scl secs freq amp ismps :optional ... -- )
+\ effects-bbp ( freq bw :optional beg dur snd chn -- res )
+\ effects-bbr ( freq bw :optional beg dur snd chn -- res )
+\ effects-bhp ( freq :optional beg dur snd chn -- res )
+\ effects-blp ( freq :optional beg dur snd chn -- res )
+\ effects-comb-filter ( scl size :optional beg dur snd chn -- res )
+\ effects-comb-chord ( scl si amp :optional beg dur snd chn -- res )
+\ effects-moog ( freq Q :optional beg dur snd chn -- res )
+\ moog ( freq Q -- prc; inval self -- res )
+\ effects-am ( freq en :optional beg dur snd chn -- res )
+\ effects-rm ( freq en :optional beg dur snd chn -- res )
+\ effects-jc-reverb ( samps volume -- prc; inval self -- res )
+\ effects-jc-reverb-1 ( volume :optional beg dur snd chn -- res )
+\ effects-cnv ( snd0 amp snd chn -- res )
+\ effects-position-sound ( mono-snd pos :optional snd chn -- res )
+\ effects-place-sound ( mono-snd stereo-snd pan-env -- res )
+\ effects-flange ( at spd ti :optional beg dur snd chn -- res )
+\ effects-cross-synthesis ( snd amp fftsize r -- prc; inval self -- res )
+\ effects-cross-synthesis-1 ( csnd amp fftsize r :optional beg dur ... -- )
+\ effects-fp ( sf amp frq :optional beg dur snd chn -- vct )
+\ effects-hello-dentist ( freq amp :optional beg dur snd chn -- res )
+\ effects-remove-clicks ( :optional snd chn -- res )
+\ effects-remove-dc ( :optional snd chn -- res )
+\ effects-compand ( :optional snd chn -- res )
\
\ Motif/Gtk specific
\
-\ Requires --with-motif|gtk and module libxm.so|libxg.so or --with-static-xm|xg!
+\ Requires --with-motif|gtk
\
-\ Tested with Snd 11.10, Motif 2.3.0, Gtk+ 2.20.1, Fth 1.2.x
+\ Tested with Snd 14.x
+\ Fth 1.3.x
+\ Motif 2.3.3 X11R6
\
-\ make-menu ( name parent -- gen )
-\ menu-entry ( gen prc disp-prc -- )
-\ make-main-menu ( name -- widget )
-\ add-to-effects-menu ( name prc -- )
+\ make-menu ( name parent -- gen )
+\ menu-entry ( gen prc disp-prc -- )
+\ make-main-menu ( name -- widget )
+\ add-to-effects-menu ( name prc -- )
\
-\ make-gain-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-normalize-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-gate-dialog ( name -- prc1 prc2; child self -- prc; self -- )
+\ make-gain-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-normalize-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-gate-dialog ( name -- pc1 pc2; child self -- prc; self -- )
\
-\ make-echo-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-flecho-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-zecho-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\
-\ make-band-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-notch-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-high-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-low-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-comb-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-comb-chord-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-moog-dialog ( name -- prc1 prc2; child self -- prc; self -- )
+\ make-echo-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-flecho-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-zecho-dialog ( name -- pc1 pc2; child self -- prc; self -- )
\
-\ make-adsat-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-src-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-expsrc-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-src-timevar-dialog ( name -- prc1 prc2; child self -- prc; self -- )
+\ make-band-pass-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-notch-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-high-pass-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-low-pass-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-comb-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-comb-chord-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-moog-dialog ( name -- pc1 pc2; child self -- prc; self -- )
\
-\ make-am-effect-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-rm-effect-dialog ( name -- prc1 prc2; child self -- prc; self -- )
+\ make-adsat-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-src-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-expsrc-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-src-timevar-dialog ( name -- pc1 pc2; child self -- prc; self -- )
\
-\ make-reverb-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-jc-reverb-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-convolve-dialog ( name -- prc1 prc2; child self -- prc; self -- )
+\ make-am-effect-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-rm-effect-dialog ( name -- pc1 pc2; child self -- prc; self -- )
\
-\ make-place-sound-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-silence-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-contrast-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-cross-synth-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-flange-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-random-phase-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-robotize-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-rubber-dialog ( name -- prc1 prc2; child self -- prc; self -- )
-\ make-wobble-dialog ( name -- prc1 prc2; child self -- prc; self -- )
+\ make-reverb-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-jc-reverb-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-convolve-dialog ( name -- pc1 pc2; child self -- prc; self -- )
\
-\ make-effects-menu ( -- )
+\ make-place-sound-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-silence-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-contrast-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-cross-synth-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-flange-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-random-phase-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-robotize-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-rubber-dialog ( name -- pc1 pc2; child self -- prc; self -- )
+\ make-wobble-dialog ( name -- pc1 pc2; child self -- prc; self -- )
\
+\ make-effects-menu ( -- )
+\ init-effects-menu ( -- )
require clm
require examp
@@ -96,579 +98,658 @@ require dsp
-1 value effects-menu \ for prefs
#f value use-combo-box-for-fft-size
-\ effects-squelch-channel ( amount gate-size :optional snd chn -- )
+\ effects-squelch-channel ( amount gate-size :optional snd chn -- )
hide
: squelch-cb { f0 f1 amount -- prc; y self -- val }
- 1 proc-create amount , f1 , f0 , ( prc )
- does> { y self -- val }
- self @ { amp }
- self 1 cells + @ { f1 }
- self 2 cells + @ { f0 }
- f1 f0 y y f* moving-average amp f< if 0.0 else 1.0 then moving-average y f*
+ 1 proc-create amount , f1 , f0 , ( prc )
+ does> { y self -- val }
+ self @ { amp }
+ self 1 cells + @ { f1 }
+ self 2 cells + @ { f0 }
+ f1 f0 y y f* moving-average amp f< if
+ 0.0
+ else
+ 1.0
+ then moving-average y f*
;
set-current
: effects-squelch-channel <{ amount gate-size :optional snd #f chn #f -- val }>
- :size gate-size make-moving-average { f0 }
- :size gate-size :initial-element 1.0 make-moving-average { f1 }
- $" %s %s %s" #( amount gate-size get-func-name ) string-format { origin }
- f0 f1 amount squelch-cb 0 #f snd chn #f origin map-channel
+ :size gate-size make-moving-average { f0 }
+ :size gate-size :initial-element 1.0 make-moving-average { f1 }
+ "%s %s %s" #( amount gate-size get-func-name ) string-format { origin }
+ f0 f1 amount squelch-cb 0 #f snd chn #f origin map-channel
;
previous
-\ effects-echo ( in-samps delay-time echo-amount :optional beg dur snd chn -- )
-\ effects-flecho ( scaler secs input-samps :optional beg dur snd chn -- )
-\ effects-zecho ( scaler secs freq amp input-samps :optional beg dur snd chn -- )
+\ effects-echo ( in-samps delay-time echo-amount :optional beg dur snd chn -- )
+\ effects-flecho ( scl secs input-samps :optional beg dur snd chn -- )
+\ effects-zecho ( scl secs freq amp input-samps :optional beg dur snd chn -- )
hide
: effects-echo-cb { samps amp del -- prc; inval self -- res }
- 1 proc-create 0 , del , amp , samps , ( prc )
- does> { inval self -- res }
- self @ 1+ dup self ! { samp }
- self cell+ @ { del }
- self 2 cells + @ { amp }
- self 3 cells + @ { samps }
- del dup 0.0 tap samp samps <= if inval f+ then amp f* 0.0 delay inval f+
+ 1 proc-create 0 , del , amp , samps , ( prc )
+ does> { inval self -- res }
+ self @ 1+ dup self ! { samp }
+ self cell+ @ { del }
+ self 2 cells + @ { amp }
+ self 3 cells + @ { samps }
+ del dup 0.0 tap samp samps <= if
+ inval f+
+ then amp f* 0.0 delay inval f+
;
: effects-flecho-cb ( amp samps flt del -- prc; inval self -- res )
- { amp samps flt del }
- 1 proc-create 0 , samps , flt , del , amp , ( prc )
- does> { inval self -- res }
- self @ 1+ dup self ! { samp }
- self cell+ @ { samps }
- self 2 cells + @ { flt }
- self 3 cells + @ { del }
- self 4 cells + @ { scl }
- del flt del 0.0 tap samp samps <= if inval f+ then scl f* fir-filter delay inval f+
+ { amp samps flt del }
+ 1 proc-create 0 , samps , flt , del , amp , ( prc )
+ does> { inval self -- res }
+ self @ 1+ dup self ! { samp }
+ self cell+ @ { samps }
+ self 2 cells + @ { flt }
+ self 3 cells + @ { del }
+ self 4 cells + @ { scl }
+ del flt del 0.0 tap samp samps <= if
+ inval f+
+ then scl f* fir-filter delay inval f+
;
: effects-zecho-cb ( scaler amp samps os del -- prc; inval self -- res )
- { scaler amp samps os del }
- 1 proc-create 0 , samps , os , del , scaler , amp , ( prc )
- does> { inval self -- res }
- self @ 1+ dup self ! { samp }
- self cell+ @ { samps }
- self 2 cells + @ { os }
- self 3 cells + @ { del }
- self 4 cells + @ { scl }
- self 5 cells + @ { amp }
- del
- del 0.0 tap samp samps <= if inval f+ then scl f*
- os 0.0 0.0 oscil amp f*
- delay inval f+
+ { scaler amp samps os del }
+ 1 proc-create 0 , samps , os , del , scaler , amp , ( prc )
+ does> { inval self -- res }
+ self @ 1+ dup self ! { samp }
+ self cell+ @ { samps }
+ self 2 cells + @ { os }
+ self 3 cells + @ { del }
+ self 4 cells + @ { scl }
+ self 5 cells + @ { amp }
+ del
+ del 0.0 tap samp samps <= if
+ inval f+
+ then scl f*
+ os 0.0 0.0 oscil amp f*
+ delay inval f+
;
set-current
-: effects-echo <{ input-samps del-time amp :optional beg 0 dur #f snd #f chn #f -- res }>
- del-time snd srate f* fround->s make-delay { del }
- input-samps number? if
- input-samps
- else
- dur number? if
- dur
- else
- snd chn undef frames
- then
- then { samps }
- $" %s %s %s %s %s %s" #( input-samps del-time amp beg dur get-func-name ) string-format { orig }
- samps amp del effects-echo-cb beg dur snd chn #f orig map-channel
-;
-
-: effects-flecho <{ amp secs input-samps :optional beg 0 dur #f snd #f chn #f -- res }>
- :order 4 :xcoeffs vct( 0.125 0.25 0.25 0.125 ) make-fir-filter { flt }
- secs snd srate f* fround->s make-delay { del }
- input-samps number? if
- input-samps
- else
- dur number? if
- dur
- else
- snd chn undef frames
- then
- then { samps }
- $" %s %s %s %s %s %s" #( amp secs input-samps beg dur get-func-name ) string-format { origin }
- amp samps flt del effects-flecho-cb beg dur snd chn #f origin map-channel
-;
-
-: effects-zecho <{ scaler secs freq amp input-samps :optional beg 0 dur #f snd #f chn #f -- res }>
- freq make-oscil { os }
- secs snd srate f* fround->s { len }
- :size len :max-size len amp f>s 1 + + make-delay { del }
- input-samps number? if
- input-samps
- else
- dur number? if
- dur
- else
- snd chn undef frames
- then
- then { samps }
- $" %s %s %s %s %s %s %s %s" #( scaler secs freq amp input-samps beg dur get-func-name )
- string-format { origin }
- scaler amp samps os del effects-zecho-cb beg dur snd chn #f origin map-channel
+: effects-echo
+ <{ input-samps del-time amp :optional beg 0 dur #f snd #f chn #f -- res }>
+ del-time snd srate f* fround->s make-delay { del }
+ input-samps number? if
+ input-samps
+ else
+ dur number? if
+ dur
+ else
+ snd chn undef framples
+ then
+ then { samps }
+ "%s %s %s %s %s %s" #( input-samps del-time amp beg dur get-func-name )
+ string-format { orig }
+ samps amp del effects-echo-cb beg dur snd chn #f orig map-channel
+;
+
+: effects-flecho
+ <{ amp secs input-samps :optional beg 0 dur #f snd #f chn #f -- res }>
+ :order 4 :xcoeffs vct( 0.125 0.25 0.25 0.125 ) make-fir-filter { flt }
+ secs snd srate f* fround->s make-delay { del }
+ input-samps number? if
+ input-samps
+ else
+ dur number? if
+ dur
+ else
+ snd chn undef framples
+ then
+ then { samps }
+ "%s %s %s %s %s %s" #( amp secs input-samps beg dur get-func-name )
+ string-format { origin }
+ amp samps flt del effects-flecho-cb beg dur snd chn #f origin
+ map-channel
+;
+
+: effects-zecho
+ <{ scl secs freq amp input-samps :optional beg 0 dur #f snd #f chn #f -- r }>
+ freq make-oscil { os }
+ secs snd srate f* fround->s { len }
+ :size len :max-size len amp f>s 1 + + make-delay { del }
+ input-samps number? if
+ input-samps
+ else
+ dur number? if
+ dur
+ else
+ snd chn undef framples
+ then
+ then { samps }
+ "%s %s %s %s %s %s %s %s"
+ #( scl secs freq amp input-samps beg dur get-func-name )
+ string-format { origin }
+ scl amp samps os del effects-zecho-cb beg dur snd chn #f origin
+ map-channel
;
previous
-\ effects-bbp ( freq bw :optional beg dur snd chn -- res )
-\ effects-bbr ( freq bw :optional beg dur snd chn -- res )
-\ effects-bhp ( freq :optional beg dur snd chn -- res )
-\ effects-blp ( freq :optional beg dur snd chn -- res )
-\ effects-comb-filter ( scaler size :optional beg dur snd chn -- res )
-\ effects-comb-chord ( scaler size amp :optional beg dur snd chn -- res )
+\ effects-bbp ( freq bw :optional beg dur snd chn -- res )
+\ effects-bbr ( freq bw :optional beg dur snd chn -- res )
+\ effects-bhp ( freq :optional beg dur snd chn -- res )
+\ effects-blp ( freq :optional beg dur snd chn -- res )
+\ effects-comb-filter ( scl size :optional beg dur snd chn -- res )
+\ effects-comb-chord ( scl size amp :optional beg dur snd chn -- res )
: effects-bbp <{ freq bw :optional beg 0 dur #f snd #f chn #f -- res }>
- $" %s %s %s %s %s" #( freq bw beg dur get-func-name ) string-format { origin }
- freq bw make-butter-band-pass beg dur snd chn #f #f origin clm-channel
+ "%s %s %s %s %s" #( freq bw beg dur get-func-name )
+ string-format { origin }
+ freq bw make-butter-band-pass beg dur snd chn #f #f origin clm-channel
;
: effects-bbr <{ freq bw :optional beg 0 dur #f snd #f chn #f -- res }>
- $" %s %s %s %s %s" #( freq bw beg dur get-func-name ) string-format { origin }
- freq bw make-butter-band-reject beg dur snd chn #f #f origin clm-channel
+ "%s %s %s %s %s" #( freq bw beg dur get-func-name )
+ string-format { origin }
+ freq bw make-butter-band-reject beg dur snd chn #f #f origin clm-channel
;
: effects-bhp <{ freq :optional beg 0 dur #f snd #f chn #f -- res }>
- $" %s %s %s %s" #( freq beg dur get-func-name ) string-format { origin }
- freq make-butter-high-pass beg dur snd chn #f #f origin clm-channel
+ "%s %s %s %s" #( freq beg dur get-func-name ) string-format { origin }
+ freq make-butter-high-pass beg dur snd chn #f #f origin clm-channel
;
: effects-blp <{ freq :optional beg 0 dur #f snd #f chn #f -- res }>
- $" %s %s %s %s" #( freq beg dur get-func-name ) string-format { origin }
- freq make-butter-low-pass beg dur snd chn #f #f origin clm-channel
+ "%s %s %s %s" #( freq beg dur get-func-name ) string-format { origin }
+ freq make-butter-low-pass beg dur snd chn #f #f origin clm-channel
;
-: effects-comb-filter <{ scaler size :optional beg 0 dur #f snd #f chn #f -- res }>
- $" %s %s %s %s %s" #( scaler size beg dur get-func-name ) string-format { origin }
- scaler size comb-filter beg dur snd chn #f origin map-channel
+: effects-comb-filter <{ scl size :optional beg 0 dur #f snd #f chn #f -- res }>
+ "%s %s %s %s %s" #( scl size beg dur get-func-name )
+ string-format { origin }
+ scl size comb-filter beg dur snd chn #f origin map-channel
;
-: effects-comb-chord <{ scaler size amp :optional beg 0 dur #f snd #f chn #f -- res }>
- $" %s %s %s %s %s %s" #( scaler size amp beg dur get-func-name ) string-format { origin }
- scaler size amp comb-chord beg dur snd chn #f origin map-channel
+: effects-comb-chord
+ <{ scl size amp :optional beg 0 dur #f snd #f chn #f -- res }>
+ "%s %s %s %s %s %s" #( scl size amp beg dur get-func-name )
+ string-format { origin }
+ scl size amp comb-chord beg dur snd chn #f origin map-channel
;
-\ effects-moog ( freq Q :optional beg dur snd chn -- res )
+\ effects-moog ( freq Q :optional beg dur snd chn -- res )
hide
: moog-cb ( gen -- prc; inval self -- res )
- 1 proc-create swap , ( prc )
- does> { inval self -- res }
- self @ ( gen ) inval moog-filter
+ 1 proc-create swap , ( prc )
+ does> { inval self -- res }
+ self @ ( gen ) inval moog-filter
;
set-current
: effects-moog <{ freq Q :optional beg 0 dur #f snd #f chn #f -- res }>
- $" %s %s %s %s %s" #( freq Q beg dur get-func-name ) string-format { origin }
- freq Q make-moog-filter moog-cb beg dur snd chn #f origin map-channel
+ "%s %s %s %s %s" #( freq Q beg dur get-func-name )
+ string-format { origin }
+ freq Q make-moog-filter moog-cb beg dur snd chn #f origin map-channel
;
previous
-\ moog ( freq Q -- prc; inval self -- res )
+\ moog ( freq Q -- prc; inval self -- res )
: moog ( freq Q -- prc; inval self -- res )
- make-moog-filter { gen }
- 1 proc-create gen , ( prc )
- does> { inval self -- res }
- self @ ( gen ) inval moog-filter
+ make-moog-filter { gen }
+ 1 proc-create gen , ( prc )
+ does> { inval self -- res }
+ self @ ( gen ) inval moog-filter
;
-\ effects-am ( freq en :optional beg dur snd chn -- res )
-\ effects-rm ( freq en :optional beg dur snd chn -- res )
+\ effects-am ( freq en :optional beg dur snd chn -- res )
+\ effects-rm ( freq en :optional beg dur snd chn -- res )
hide
: effects-am-env-cb { os e -- prc; x self -- res }
- 1 proc-create e , os , ( prc )
- does> { inval self -- res }
- self @ { e }
- self cell+ @ { os }
- 1.0 inval e env os 0.0 0.0 oscil f* amplitude-modulate
+ 1 proc-create e , os , ( prc )
+ does> { inval self -- res }
+ self @ { e }
+ self cell+ @ { os }
+ 1.0 inval e env os 0.0 0.0 oscil f* amplitude-modulate
;
: effects-am-cb ( os -- prc; x self -- res )
- 1 proc-create swap , ( prc )
- does> { inval self -- res }
- self @ { os }
- os 0.0 0.0 oscil inval f*
+ 1 proc-create swap , ( prc )
+ does> { inval self -- res }
+ self @ { os }
+ os 0.0 0.0 oscil inval f*
;
: effects-rm-env-cb { os e -- prc; x self -- res }
- 1 proc-create e , os , ( prc )
- does> { inval self -- res }
- self @ { e }
- self cell+ @ { os }
- os 0.0 0.0 oscil e env f* inval f*
+ 1 proc-create e , os , ( prc )
+ does> { inval self -- res }
+ self @ { e }
+ self cell+ @ { os }
+ os 0.0 0.0 oscil e env f* inval f*
;
: effects-rm-cb ( os -- prc; x self -- res )
- 1 proc-create swap , ( prc )
- does> { inval self -- res }
- self @ { os }
- 1.0 inval os 0.0 0.0 oscil amplitude-modulate
+ 1 proc-create swap , ( prc )
+ does> { inval self -- res }
+ self @ { os }
+ 1.0 inval os 0.0 0.0 oscil amplitude-modulate
;
set-current
: effects-am <{ freq en :optional beg 0 dur #f snd #f chn #f -- res }>
- freq make-oscil { os }
- en array? if :envelope en :length dur 1- make-env else #f then { e }
- $" %s %s %s %s %s" #( freq en beg dur get-func-name ) string-format { origin }
- e if os e effects-am-env-cb else os effects-am-cb then beg dur snd chn #f origin map-channel
+ freq make-oscil { os }
+ en array? if
+ :envelope en :length dur 1- make-env
+ else
+ #f
+ then { e }
+ "%s %s %s %s %s" #( freq en beg dur get-func-name )
+ string-format { origin }
+ e if
+ os e effects-am-env-cb
+ else
+ os effects-am-cb
+ then beg dur snd chn #f origin map-channel
;
: effects-rm <{ freq en :optional beg 0 dur #f snd #f chn #f -- res }>
- freq make-oscil { os }
- en array? if :envelope en :length dur 1- make-env else #f then { e }
- $" %s %s %s %s %s" #( freq en beg dur get-func-name ) string-format { origin }
- e if os e effects-rm-env-cb else os effects-rm-cb then beg dur snd chn #f origin map-channel
+ freq make-oscil { os }
+ en array? if
+ :envelope en :length dur 1- make-env
+ else
+ #f
+ then { e }
+ "%s %s %s %s %s" #( freq en beg dur get-func-name )
+ string-format { origin }
+ e if
+ os e effects-rm-env-cb
+ else
+ os effects-rm-cb
+ then beg dur snd chn #f origin map-channel
;
previous
-\ effects-jc-reverb ( samps volume -- prc; inval self -- res )
-\ effects-jc-reverb-1 ( volume :optional beg dur snd chn -- res )
+\ effects-jc-reverb ( samps volume -- prc; inval self -- res )
+\ effects-jc-reverb-1 ( volume :optional beg dur snd chn -- res )
: effects-jc-reverb ( samps volume -- prc; inval self -- res )
- { samps vol }
- -0.7 0.7 1051 make-all-pass { all1 }
- -0.7 0.7 337 make-all-pass { all2 }
- -0.7 0.7 113 make-all-pass { all3 }
- 0.742 4799 make-comb { c1 }
- 0.733 4999 make-comb { c2 }
- 0.715 5399 make-comb { c3 }
- 0.697 5801 make-comb { c4 }
- #f srate 0.013 f* fround->s make-delay { outdel }
- 1 proc-create
- 0 ( samp ),
- samps ,
- vol ,
- 0.0 ( comb-sum ) ,
- 0.0 ( comb-sum-1 ) ,
- 0.0 ( comb-sum-2 ) ,
- all1 , all2 , all3 ,
- c1 , c2 , c3 , c4 ,
- outdel , ( prc )
- does> { inval self -- res }
- self @ ( samp++ ) 1+ self !
- self @ { samp }
- self 1 cells + @ { samps }
- self 2 cells + @ { volume }
- self 3 cells + @ { comb-sum }
- self 4 cells + @ { comb-sum-1 }
- self 5 cells + @ { comb-sum-2 }
- self 6 cells + @ { allpass1 }
- self 7 cells + @ { allpass2 }
- self 8 cells + @ { allpass3 }
- self 9 cells + @ { comb1 }
- self 10 cells + @ { comb2 }
- self 11 cells + @ { comb3 }
- self 12 cells + @ { comb4 }
- self 13 cells + @ { outdel }
- allpass3 allpass2 allpass1
- samp samps <= if inval else 0.0 then 0.0 all-pass 0.0 all-pass 0.0 all-pass { allpass-sum }
- comb-sum-1 self 5 cells + ! ( comb-sum-2 )
- comb-sum self 4 cells + ! ( comb-sum-1 )
- comb1 allpass-sum 0.0 comb
- comb2 allpass-sum 0.0 comb f+
- comb3 allpass-sum 0.0 comb f+
- comb4 allpass-sum 0.0 comb f+ self 3 cells + ! ( comb-sum )
- outdel comb-sum 0.0 delay volume f* inval f+
+ { samps vol }
+ -0.7 0.7 1051 make-all-pass { all1 }
+ -0.7 0.7 337 make-all-pass { all2 }
+ -0.7 0.7 113 make-all-pass { all3 }
+ 0.742 4799 make-comb { c1 }
+ 0.733 4999 make-comb { c2 }
+ 0.715 5399 make-comb { c3 }
+ 0.697 5801 make-comb { c4 }
+ #f srate 0.013 f* fround->s make-delay { outdel }
+ 1 proc-create
+ 0 ( samp ),
+ samps ,
+ vol ,
+ 0.0 ( comb-sum ) ,
+ 0.0 ( comb-sum-1 ) ,
+ 0.0 ( comb-sum-2 ) ,
+ all1 , all2 , all3 ,
+ c1 , c2 , c3 , c4 ,
+ outdel , ( prc )
+ does> { inval self -- res }
+ self @ ( samp++ ) 1+ self !
+ self @ { samp }
+ self 1 cells + @ { samps }
+ self 2 cells + @ { volume }
+ self 3 cells + @ { comb-sum }
+ self 4 cells + @ { comb-sum-1 }
+ self 5 cells + @ { comb-sum-2 }
+ self 6 cells + @ { allpass1 }
+ self 7 cells + @ { allpass2 }
+ self 8 cells + @ { allpass3 }
+ self 9 cells + @ { comb1 }
+ self 10 cells + @ { comb2 }
+ self 11 cells + @ { comb3 }
+ self 12 cells + @ { comb4 }
+ self 13 cells + @ { outdel }
+ allpass3 allpass2 allpass1
+ samp samps <= if
+ inval
+ else
+ 0.0
+ then 0.0 all-pass 0.0 all-pass 0.0 all-pass { allpass-sum }
+ comb-sum-1 self 5 cells + ! ( comb-sum-2 )
+ comb-sum self 4 cells + ! ( comb-sum-1 )
+ comb1 allpass-sum 0.0 comb
+ comb2 allpass-sum 0.0 comb f+
+ comb3 allpass-sum 0.0 comb f+
+ comb4 allpass-sum 0.0 comb f+ self 3 cells + ! ( comb-sum )
+ outdel comb-sum 0.0 delay volume f* inval f+
;
: effects-jc-reverb-1 <{ vol :optional beg 0 dur #f snd #f chn #f -- res }>
- dur if dur else snd chn #f frames then { samps }
- $" %s %s %s %s" #( vol beg dur get-func-name ) string-format { origin }
- samps vol effects-jc-reverb beg dur snd chn #f origin map-channel
+ dur if
+ dur
+ else
+ snd chn #f framples
+ then { samps }
+ "%s %s %s %s" #( vol beg dur get-func-name ) string-format { origin }
+ samps vol effects-jc-reverb beg dur snd chn #f origin map-channel
;
-\ effects-cnv ( snd0 amp snd chn -- res )
+\ effects-cnv ( snd0 amp snd chn -- res )
hide
: cnv-cb ( sf -- prc; dir self -- res )
- 1 proc-create swap , ( prc )
- does> { dir self -- res }
- self @ ( sf ) next-sample
-;
-
-: cnv-vct-cb { cnv sf -- prc; self -- res }
- sf cnv-cb { func }
- 0 proc-create func , cnv , ( prc )
- does> { self -- res }
- self @ { func }
- self cell+ @ { cnv }
- cnv func convolve
+ 1 proc-create swap , ( prc )
+ does> { dir self -- res }
+ self @ ( sf ) next-sample
;
set-current
: effects-cnv <{ snd0 amp :optional snd #f chn #f -- res }>
- snd0 sound? unless sounds 0 array-ref to snd0 then
- snd0 #f #f frames { flt-len }
- snd chn #f frames flt-len + { total-len }
- :filter 0 flt-len snd0 #f #f channel->vct make-convolve { cnv }
- 0 snd chn 1 #f make-sampler { sf }
- total-len 0.0 make-vct { out-data }
- cnv sf cnv-vct-cb { func }
- out-data func vct-map! drop
- sf free-sampler drop
- out-data amp vct-scale! drop
- out-data vct-peak { max-samp }
- $" %s %s %s" #( snd0 amp get-func-name ) string-format { origin }
- out-data 0 total-len snd chn #f origin vct->channel drop
- max-samp 1.0 f> if #( max-samp fnegate max-samp ) snd chn set-y-bounds drop then
- max-samp
+ snd0 sound? unless
+ sounds 0 array-ref to snd0
+ then
+ snd0 #f #f framples { flt-len }
+ snd chn #f framples flt-len + { total-len }
+ :filter 0 flt-len snd0 #f #f channel->vct make-convolve { cnv }
+ 0 snd chn 1 #f make-sampler { sf }
+ sf cnv-cb { cnv-func }
+ total-len 0.0 make-vct map!
+ cnv cnv-func convolve
+ end-map { out-data }
+ sf free-sampler drop
+ out-data amp vct-scale! drop
+ out-data vct-peak { max-samp }
+ out-data 0 total-len snd chn #f
+ "%s %s %s" #( snd0 amp get-func-name ) string-format
+ vct->channel drop
+ max-samp 1.0 f> if
+ #( max-samp fnegate max-samp ) snd chn set-y-bounds drop
+ then
+ max-samp
;
previous
-\ effects-position-sound ( mono-snd pos :optional snd chn -- res )
-\ effects-place-sound ( mono-snd stereo-snd pan-env -- res )
+\ effects-position-sound ( mono-snd pos :optional snd chn -- res )
+\ effects-place-sound ( mono-snd stereo-snd pan-env -- res )
hide
: numb-cb { rd pos -- prc; y self -- res }
- 1 proc-create pos , rd , ( prc )
- does> { y self -- res }
- self cell+ @ ( rd ) read-sample self @ ( pos ) f* y f+
+ 1 proc-create pos , rd , ( prc )
+ does> { y self -- res }
+ self cell+ @ ( rd ) read-sample self @ ( pos ) f* y f+
;
: env-numb-cb { rd en -- prc; y self -- res }
- 1 proc-create en , rd , ( prc )
- does> { y self -- res }
- self cell+ @ ( rd ) read-sample self @ ( en ) env f* y f+
+ 1 proc-create en , rd , ( prc )
+ does> { y self -- res }
+ self cell+ @ ( rd ) read-sample self @ ( en ) env f* y f+
;
: env-cb { rd en -- prc; y self -- res }
- 1 proc-create en , rd , ( prc )
- does> { y self -- res }
- self cell+ @ ( rd ) read-sample 1.0 self @ ( en ) env f- f* y f+
+ 1 proc-create en , rd , ( prc )
+ does> { y self -- res }
+ self cell+ @ ( rd ) read-sample 1.0 self @ ( en ) env f- f* y f+
;
set-current
: effects-position-sound <{ mono pos :optional snd #f chn #f -- res }>
- mono #f #f frames { len }
- 0 mono #f 1 #f make-sampler { rd }
- $" %s %s %s" #( mono pos get-func-name ) string-format { origin }
- pos number? if
- rd pos numb-cb 0 len snd chn #f origin map-channel
- else
- :envelope pos :length len 1- make-env { e }
- chn integer?
- chn 1 = && if
- rd e env-numb-cb 0 len snd chn #f origin map-channel
- else
- rd e env-cb 0 len snd chn #f origin map-channel
- then
- then
+ mono #f #f framples { len }
+ 0 mono #f 1 #f make-sampler { rd }
+ "%s %s %s" #( mono pos get-func-name ) string-format { origin }
+ pos number? if
+ rd pos numb-cb 0 len snd chn #f origin map-channel
+ else
+ :envelope pos :length len 1- make-env { e }
+ chn integer?
+ chn 1 = && if
+ rd e env-numb-cb 0 len snd chn #f origin map-channel
+ else
+ rd e env-cb 0 len snd chn #f origin map-channel
+ then
+ then
;
: effects-place-sound ( mono stereo pan -- res )
- doc" Mixes a mono sound into a stereo sound, \
+ doc" Mixes a mono sound into a stereo sound, \
splitting it into two copies whose amplitudes depend on the envelope PAN-ENV. \
If PAN-ENV is a number, the sound is split such that 0 is all in channel 0 \
and 90 is all in channel 1."
- { mono stereo pan }
- pan number? if
- pan 90.0 f/ { pos }
- mono pos stereo 1 effects-position-sound drop
- mono 1.0 pos f- stereo 0 effects-position-sound
- else
- mono pan stereo 1 effects-position-sound drop
- mono pan stereo 0 effects-position-sound
- then
+ { mono stereo pan }
+ pan number? if
+ pan 90.0 f/ { pos }
+ mono pos stereo 1 effects-position-sound drop
+ mono 1.0 pos f- stereo 0 effects-position-sound
+ else
+ mono pan stereo 1 effects-position-sound drop
+ mono pan stereo 0 effects-position-sound
+ then
;
previous
-\ effects-flange ( amount speed time :optional beg dur snd chn -- res )
+\ effects-flange ( amount speed time :optional beg dur snd chn -- res )
hide
: flange-cb { ri del -- prc; inval self -- res }
- 1 proc-create del , ri , ( prc )
- does> { inval self -- res }
- self @ ( del ) inval self cell+ @ ( ri ) 0.0 rand-interp delay inval f+ 0.75 f*
+ 1 proc-create del , ri , ( prc )
+ does> { inval self -- res }
+ self @ ( del ) inval self cell+ @ ( ri ) 0.0 rand-interp
+ delay inval f+ 0.75 f*
;
set-current
-: effects-flange <{ amnt speed time :optional beg 0 dur #f snd #f chn #f -- res}>
- :frequency speed :amplitude amnt make-rand-interp { ri }
- time snd srate f* fround->s { len }
- :size len :max-size amnt f>s len 1 + + make-delay { del }
- $" %s %s %s %s %s %s"
- #( amnt speed time beg
- dur number? snd chn #f frames dur <> && if dur else #f then
- get-func-name ) string-format { origin }
- ri del flange-cb beg dur snd chn #f origin map-channel
+: effects-flange
+ <{ amnt speed time :optional beg 0 dur #f snd #f chn #f -- res}>
+ :frequency speed :amplitude amnt make-rand-interp { ri }
+ time snd srate f* fround->s { len }
+ :size len :max-size amnt f>s len 1 + + make-delay { del }
+ "%s %s %s %s %s %s"
+ #( amnt speed time beg
+ dur number?
+ snd chn #f framples dur <> && if
+ dur
+ else
+ #f
+ then get-func-name ) string-format { origin }
+ ri del flange-cb beg dur snd chn #f origin map-channel
;
previous
-\ effects-cross-synthesis ( snd amp fftsize r -- prc; inval self -- res )
-\ effects-cross-synthesis-1 ( cross-snd amp fftsize r :optional beg dur snd chn -- res )
+\ effects-cross-synthesis ( snd amp fftsize r -- prc; inval self -- res )
+\ effects-cross-synthesis-1 ( snd amp fft r :optional beg dur snd chn -- res )
: effects-cross-synthesis ( snd amp fftsize r -- prc; inval self -- res )
- { snd amp fftsize r }
- fftsize 2/ { freq-inc }
- fftsize 0.0 make-vct { fdr }
- fftsize 0.0 make-vct { fdi }
- freq-inc 0.0 make-vct { spectr }
- 1.0 r fftsize f/ f- { radius }
- #f srate fftsize / { bin }
- freq-inc make-array map! :radius radius :frequency bin i * make-formant end-map { formants }
- 1 proc-create ( inctr ) 0 , ( ctr ) freq-inc , fdr , fdi , spectr , formants , snd , amp ,
- ( prc )
- does> { inval self -- res }
- self @ { inctr }
- self 1 cells + @ { ctr }
- self 2 cells + @ { fdr }
- self 3 cells + @ { fdi }
- self 4 cells + @ { spectr }
- self 5 cells + @ { formants }
- self 6 cells + @ { snd }
- self 7 cells + @ { amp }
- fdr vct-length { fftsize }
- spectr vct-length { freq-inc }
- 0.0 { outval }
- ctr freq-inc = if
- inctr fftsize snd 0 #f channel->vct self 2 cells + ! ( fdr )
- inctr freq-inc + self ! ( inctr )
- fdr fdi #f 2 spectrum drop
- fdr spectr vct-subtract! drop
- fdr freq-inc 1/f vct-scale! drop
- 0 self 1 cells + ! ( ctr=0 )
- then
- ctr 1+ self 1 cells + ! ( ctr++ )
- spectr fdr 0 vct-add! drop
- spectr formants inval formant-bank amp f*
-;
-
-: effects-cross-synthesis-1 <{ csnd amp fftsize r :optional beg 0 dur #f snd #f chn #f -- res }>
- { csnd amp fftsize r beg dur snd chn }
- $" %s %s %s %s %s %s %s" #( csnd amp fftsize r beg dur get-func-name ) string-format { origin }
- csnd sound? unless sounds 0 array-ref to csnd then
- csnd amp fftsize r effects-cross-synthesis beg dur snd chn #f origin map-channel
-;
-
-\ effects-fp ( srf amp freq :optional beg dur snd chn -- vct )
+ { snd amp fftsize r }
+ fftsize 2/ { freq-inc }
+ fftsize 0.0 make-vct { fdr }
+ fftsize 0.0 make-vct { fdi }
+ freq-inc 0.0 make-vct { spectr }
+ 1.0 r fftsize f/ f- { radius }
+ #f srate fftsize / { bin }
+ freq-inc make-array map!
+ :radius radius :frequency bin i * make-formant
+ end-map spectr make-formant-bank { formants }
+ 1 proc-create ( inctr ) 0 , ( ctr ) freq-inc ,
+ fdr , fdi , spectr , formants , snd , amp , ( prc )
+ does> { inval self -- res }
+ self @ { inctr }
+ self 1 cells + @ { ctr }
+ self 2 cells + @ { fdr }
+ self 3 cells + @ { fdi }
+ self 4 cells + @ { spectr }
+ self 5 cells + @ { formants }
+ self 6 cells + @ { snd }
+ self 7 cells + @ { amp }
+ fdr vct-length { fftsize }
+ spectr vct-length { freq-inc }
+ 0.0 { outval }
+ ctr freq-inc = if
+ inctr fftsize snd 0 #f channel->vct self 2 cells + ! ( fdr )
+ inctr freq-inc + self ! ( inctr )
+ fdr fdi #f 2 spectrum drop
+ fdr spectr vct-subtract! drop
+ fdr freq-inc 1/f vct-scale! drop
+ 0 self 1 cells + ! ( ctr=0 )
+ then
+ ctr 1+ self 1 cells + ! ( ctr++ )
+ spectr fdr 0 vct-add! drop
+ formants inval formant-bank amp f*
+;
+
+: effects-cross-synthesis-1
+ <{ csnd amp fftsize r :optional beg 0 dur #f snd #f chn #f -- res }>
+ { csnd amp fftsize r beg dur snd chn }
+ "%s %s %s %s %s %s %s" #( csnd amp fftsize r beg dur get-func-name )
+ string-format { origin }
+ csnd sound? unless
+ sounds 0 array-ref to csnd
+ then
+ csnd amp fftsize r effects-cross-synthesis beg dur snd chn #f origin
+ map-channel
+;
+
+\ effects-fp ( srf amp freq :optional beg dur snd chn -- vct )
hide
: src-fp-read-cb ( sf -- prc; dir self -- samp )
- 1 proc-create swap , ( prc )
- does> { dir self -- samp }
- self @ ( sf ) dir 0> if next-sample else previous-sample then
-;
-
-: vct-fp-cb ( os sr sf amp -- prc; self -- res )
- { os sr sf amp }
- sf src-fp-read-cb { src-cb }
- 0 proc-create os , sr , amp , src-cb , ( prc )
- does> { self -- res }
- self cell+ @ ( sr )
- self @ ( os ) 0.0 0.0 oscil self 2 cells + @ ( amp ) f*
- self 3 cells + @ ( src-cb ) src
+ 1 proc-create swap , ( prc )
+ does> { dir self -- samp }
+ self @ ( sf ) dir 0> if
+ next-sample
+ else
+ previous-sample
+ then
;
set-current
: effects-fp <{ srf amp freq :optional beg 0 dur #f snd #f chn #f -- vct }>
- freq make-oscil { os }
- :srate srf make-src { sr }
- beg snd chn 1 #f make-sampler { sf }
- dur if dur else snd chn #f frames then { len }
- len 0.0 make-vct { out-data }
- out-data os sr sf amp vct-fp-cb vct-map! drop
- $" %s %s %s %s %s %s" #( srf amp freq beg dur get-func-name ) string-format { origin }
- out-data beg len snd chn #f origin vct->channel
+ freq make-oscil { os }
+ :srate srf make-src { sr }
+ beg snd chn 1 #f make-sampler { sf }
+ dur if
+ dur
+ else
+ snd chn #f framples
+ then { len }
+ sf src-fp-read-cb { src-cb }
+ len 0.0 make-vct map!
+ sr os 0.0 0.0 oscil amp f* src-cb src
+ end-map ( out-data ) beg len snd chn #f
+ "%s %s %s %s %s %s" #( srf amp freq beg dur get-func-name )
+ string-format vct->channel
;
previous
-\ effects-hello-dentist ( freq amp :optional beg dur snd chn -- res )
+\ effects-hello-dentist ( freq amp :optional beg dur snd chn -- res )
hide
: hello-src-cb { in-data idx -- prc; dir self -- samp }
- 1 proc-create idx , in-data , ( prc )
- does> { dir self -- samp }
- self @ { idx }
- self cell+ @ { in-data }
- in-data idx range? if in-data idx vct-ref else 0.0 then ( val )
- idx dir + self ! ( idx )
+ 1 proc-create idx , in-data , ( prc )
+ does> { dir self -- samp }
+ self @ { idx }
+ self cell+ @ { in-data }
+ in-data idx range? if
+ in-data idx vct-ref
+ else
+ 0.0
+ then ( val )
+ idx dir + self ! ( idx )
;
set-current
-: effects-hello-dentist <{ freq amp :optional beg 0 dur #f snd #f chn #f -- res }>
- :frequency freq :amplitude amp make-rand-interp { rn }
- 0 { idx }
- dur if dur else snd chn #f frames then { len }
- beg len snd chn #f channel->vct { in-data }
- amp f2* 1.0 f+ len f* fround->s ( out-len ) 0.0 make-vct { out-data }
- :srate 1.0 :input in-data idx hello-src-cb make-src { rd }
- out-data map!
- idx len = ?leave
- rd rn 0.0 rand-interp #f src
- end-map to out-data
- $" %s %s %s %s %s" #( freq amp beg dur get-func-name ) string-format { origin }
- out-data beg out-data vct-length snd chn #f origin vct->channel
+: effects-hello-dentist
+ <{ freq amp :optional beg 0 dur #f snd #f chn #f -- res }>
+ :frequency freq :amplitude amp make-rand-interp { rn }
+ 0 { idx }
+ dur if
+ dur
+ else
+ snd chn #f framples
+ then { len }
+ beg len snd chn #f channel->vct { in-data }
+ amp f2* 1.0 f+ len f* fround->s ( out-len ) 0.0 make-vct { out-data }
+ :srate 1.0 :input in-data idx hello-src-cb make-src { rd }
+ out-data map!
+ idx len = ?leave
+ rd rn 0.0 rand-interp #f src
+ end-map to out-data
+ "%s %s %s %s %s" #( freq amp beg dur get-func-name )
+ string-format { origin }
+ out-data beg out-data vct-length snd chn #f origin vct->channel
;
previous
-\ effects-remove-clicks ( :optional snd chn -- res )
-\ effects-remove-dc ( :optional snd chn -- res )
-\ effects-compand ( :optional snd chn -- res )
+\ effects-remove-clicks ( :optional snd chn -- res )
+\ effects-remove-dc ( :optional snd chn -- res )
+\ effects-compand ( :optional snd chn -- res )
hide
: find-click { loc snd chn -- pos|#f }
- loc snd chn 1 #f make-sampler { rd }
- 0.0 0.0 0.0 { samp0 samp1 samp2 }
- 10 0.0 make-vct { samps }
- #f \ flag
- snd chn #f frames loc ?do
- samp1 to samp0
- samp2 to samp1
- rd next-sample to samp2
- samps samp0 cycle-set!
- samps vct-peak 0.1 fmax { local-max }
- samp0 samp1 f- fabs local-max f>
- samp1 samp2 f- fabs local-max f> &&
- samp0 samp2 f- fabs local-max f2/ f< && if drop ( flag ) i leave then
- loop
+ loc snd chn 1 #f make-sampler { rd }
+ 0.0 0.0 0.0 { samp0 samp1 samp2 }
+ 10 0.0 make-vct { samps }
+ #f \ flag
+ snd chn #f framples loc ?do
+ samp1 to samp0
+ samp2 to samp1
+ rd next-sample to samp2
+ samps samp0 cycle-set!
+ samps vct-peak 0.1 fmax { local-max }
+ samp0 samp1 f- fabs local-max f>
+ samp1 samp2 f- fabs local-max f> &&
+ samp0 samp2 f- fabs local-max f2/ f< && if
+ drop ( flag ) i leave
+ then
+ loop
;
: remove-click { loc snd chn -- }
- loc snd chn find-click { click }
- click if
- click 2 - 4 snd chn smooth-sound drop
- click 2 + snd chn recurse
- then
+ loc snd chn find-click { click }
+ click if
+ click 2 - 4 snd chn smooth-sound drop
+ click 2 + snd chn recurse
+ then
;
: effects-remove-dc-cb ( -- prc; inval self -- res )
- 1 proc-create 0.0 ( lastx ) , 0.0 ( lasty ) , ( prc )
- does> { inval self -- res }
- self @ { lastx }
- self cell+ @ { lasty }
- 0.999 lasty f* lastx f- inval f+ self cell+ ! ( lasty )
- inval self ! ( lastx )
- self cell+ @ ( lasty )
+ 1 proc-create 0.0 ( lastx ) , 0.0 ( lasty ) , ( prc )
+ does> { inval self -- res }
+ self @ { lastx }
+ self cell+ @ { lasty }
+ 0.999 lasty f* lastx f- inval f+ self cell+ ! ( lasty )
+ inval self ! ( lastx )
+ self cell+ @ ( lasty )
;
: effects-compand-cb ( tbl -- prc; inval self -- res )
- 1 proc-create swap , ( prc )
- does> { inval self -- res }
- self @ { tbl }
- tbl inval 8.0 f* 8.0 f+ tbl length array-interp
+ 1 proc-create swap , ( prc )
+ does> { inval self -- res }
+ self @ { tbl }
+ tbl inval 8.0 f* 8.0 f+ tbl length array-interp
;
set-current
: effects-remove-clicks <{ :optional snd #f chn #f -- res }>
- 0 snd chn remove-click
- #f
+ 0 snd chn remove-click
+ #f
;
: effects-remove-dc <{ :optional snd #f chn #f -- res }>
- effects-remove-dc-cb 0 #f snd chn #f get-func-name map-channel
+ effects-remove-dc-cb 0 #f snd chn #f get-func-name map-channel
;
: effects-compand <{ :optional snd #f chn #f -- res }>
- vct( -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
- 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000 ) { tbl }
- tbl effects-compand-cb 0 #f snd chn #f get-func-name map-channel
+ vct( -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
+ 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000 ) { tbl }
+ tbl effects-compand-cb 0 #f snd chn #f get-func-name map-channel
;
previous
'snd-nogui provided? [if] skip-file [then]
+'snd-gtk provided? [if]
+ 'gtk3 provided? not [if]
+ .( snd-gtk: gtk3 required -- skipping effects.fs ) cr
+ skip-file
+ [then]
+[then]
+
require xm-enved
require snd-xm
require rubber
@@ -676,845 +757,980 @@ require rubber
\ === SND MENU ===
hide
-struct
- cell% field menu-parent
- cell% field menu-name
- cell% field menu-menu
- cell% field menu-cascade
- cell% field menu-children
- cell% field menu-display-cb
-end-struct snd-menu%
-
-struct
- cell% field effects-label
- cell% field effects-dialog
- cell% field effects-target
- cell% field effects-target-widget
- cell% field effects-truncate
- cell% field effects-sliders
- cell% field effects-scaler
- cell% field effects-freq
- cell% field effects-amp
- cell% field effects-delay
- cell% field effects-amount
- cell% field effects-envelope
- cell% field effects-size
-end-struct effects-base%
+#( "menu-children"
+ "menu-parent"
+ "menu-name"
+ "menu-menu"
+ "menu-cascade"
+ "menu-display-cb" ) create-struct make-snd-menu-struct
+
+: menu-display ( gen -- )
+ menu-display-cb@ #() run-proc drop
+;
+
+#( "eff_label"
+ "eff_dialog"
+ "eff_target"
+ "eff_target_widget"
+ "eff_trunc"
+ "eff_sliders"
+ "eff_scl"
+ "eff_freq"
+ "eff_amp"
+ "eff_delay"
+ "eff_amnt"
+ "eff_enved"
+ "eff_size"
+ "eff_omit_silence"
+ "eff_bp_bw"
+ "eff_notch_bw"
+ "eff_moog_reson"
+ "eff_time_scale"
+ "eff_hop_size"
+ "eff_ramp_scl"
+ "eff_pitch_scl"
+ "eff_seg_len"
+ "eff_rev_filter"
+ "eff_rev_fb"
+ "eff_rev_decay"
+ "eff_rev_vol"
+ "eff_conv_one"
+ "eff_conv_two"
+ "eff_m_snd"
+ "eff_s_snd"
+ "eff_pan_pos"
+ "eff_cs_snd"
+ "eff_cs_radius"
+ "eff_cs_wid"
+ "eff_fl_speed"
+ "eff_fl_time"
+ "eff_sr"
+ "eff_factor" ) create-struct make-effects-menu-struct
set-current
-: menu-parent@ ( gen -- wid ) menu-parent @ ;
-: menu-name@ ( gen -- name ) menu-name @ ;
-: menu-menu@ ( gen -- wid ) menu-menu @ ;
-: menu-cascade@ ( gen -- wid ) menu-cascade @ ;
-: menu-children@ ( gen -- ary ) menu-children @ ;
-: menu-display ( gen -- ) menu-display-cb @ #() run-proc drop ;
-
-: label@ ( gen -- lab ) effects-label @ ;
-: label! ( lab gen -- ) effects-label ! ;
-: dialog@ ( gen -- wid ) effects-dialog @ ;
-: dialog! ( wid gen -- ) effects-dialog ! ;
-: target@ ( gen -- tar ) effects-target @ ;
-: target! ( tar gen -- ) effects-target ! ;
-: target-widget@ ( gen -- wid ) effects-target-widget @ ;
-: target-widget! ( wid gen -- ) effects-target-widget ! ;
-: truncate@ ( gen -- tar ) effects-truncate @ ;
-: truncate! ( tar gen -- ) effects-truncate ! ;
-: sliders@ ( gen -- ary ) effects-sliders @ ;
-: sliders! ( ary gen -- ) effects-sliders ! ;
-: scaler@ ( gen -- scl ) effects-scaler @ ;
-: scaler! ( scl gen -- ) effects-scaler ! ;
-: frequency@ ( gen -- frq ) effects-freq @ ;
-: frequency! ( frq gen -- ) effects-freq ! ;
-: amplitude@ ( gen -- amp ) effects-amp @ ;
-: amplitude! ( amp gen -- ) effects-amp ! ;
-: delay-time@ ( gen -- del ) effects-delay @ ;
-: delay-time! ( del gen -- ) effects-delay ! ;
-: amount@ ( gen -- amt ) effects-amount @ ;
-: amount! ( amt gen -- ) effects-amount ! ;
-: envel@ ( gen -- env ) effects-envelope @ ;
-: envel! ( env gen -- ) effects-envelope ! ;
-: size@ ( gen -- siz ) effects-size @ f>s ;
-: size! ( siz gen -- ) effects-size ! ;
-
-: make-base-effects ( label gen -- gen )
- { label gen }
- label gen label!
- #f gen dialog!
- 'sound gen target!
- #t gen truncate!
- #() gen sliders!
- gen
+: make-base-effects { label -- gen }
+ make-effects-menu-struct { gen }
+ gen label eff_label!
+ gen #f eff_dialog!
+ gen 'sound eff_target!
+ gen #t eff_trunc!
+ gen #f eff_sliders!
+ gen
;
<'> noop 0 make-proc constant effects-noop
-$" Go Away" constant eff-dismiss-string
-"Help" constant eff-help-string
-"DoIt" constant eff-okay-string
-"Reset" constant eff-reset-string
+"Go Away" constant eff-dismiss-string
+"Help" constant eff-help-string
+"DoIt" constant eff-okay-string
+"Reset" constant eff-reset-string
\ log scaler widget
500.0 constant log-scale-ticks
: scale-log->linear ( lo val hi -- lin )
- { lo val hi }
- 2.0 flog { log2 }
- lo 1.0 fmax flog log2 f/ { log-lo }
- hi flog log2 f/ { log-hi }
- val flog log2 f/ log-lo f- log-hi log-lo f- f/ log-scale-ticks f* floor f>s
+ { lo val hi }
+ 2.0 flog { log2 }
+ lo 1.0 fmax flog log2 f/ { log-lo }
+ hi flog log2 f/ { log-hi }
+ val flog log2 f/ log-lo f- log-hi log-lo f- f/ log-scale-ticks
+ f* floor->s
;
: scale-linear->log ( lo val hi -- log )
- { lo val hi }
- 2.0 flog { log2 }
- lo 1.0 fmax flog log2 f/ { log-lo }
- hi flog log2 f/ { log-hi }
- 2.0 log-lo val log-scale-ticks f/ log-hi log-lo f- f* f+ f**
+ { lo val hi }
+ 2.0 flog { log2 }
+ lo 1.0 fmax flog log2 f/ { log-lo }
+ hi flog log2 f/ { log-hi }
+ 2.0 log-lo val log-scale-ticks f/ log-hi log-lo f- f* f+ f**
;
-: scale-log-label ( lo val hi -- str ) scale-linear->log "%.2f" swap 1 >array string-format ;
+: scale-log-label ( lo val hi -- str )
+ scale-linear->log "%.2f" swap 1 >array string-format
+;
\ semitone scaler widget
24 value semi-range
-: semi-scale-label ( val -- str ) $" semitones: %s" swap semi-range - 1 >array string-format ;
-: semitones->ratio ( val -- r ) 2.0 swap 12.0 f/ f** ;
-: ratio->semitones ( ratio -- n ) 12.0 swap flog 2.0 flog f/ f* fround->s ;
+: semi-scale-label ( val -- str )
+ "semitones: %s" swap semi-range - 1 >array string-format
+;
+
+: semitones->ratio ( val -- r )
+ 2.0 swap 12.0 f/ f**
+;
+
+: ratio->semitones ( ratio -- n )
+ 12.0 swap flog 2.0 flog f/ f* fround->s
+;
: marks-sort ( a b -- -1|0|1 )
- { a b }
- a b < if
- -1
- else
- a b = if
- 0
- else
- 1
- then
- then
+ { a b }
+ a b < if
+ -1
+ else
+ a b = if
+ 0
+ else
+ 1
+ then
+ then
;
\ returns a list of points
: plausible-mark-samples ( -- pts )
- selected-sound { snd }
- snd selected-channel { chn }
- #() { ms }
- snd chn #f marks each undef mark-sample ms swap array-push drop end-each
- ms length 2 < if
- #f
- else
- ms <'> marks-sort array-sort! drop
- ms length 2 = if
- ms array->array
- else
- snd chn left-sample { lw }
- snd chn right-sample { rw }
- snd chn undef cursor { cw }
- cw lw >=
- cw rw <= && if
- cw
- else
- lw rw + 2/
- then { favor }
- #( ms first-ref ms second-ref ) { res }
- ms each { p1 }
- i ms length 2 - = if
- #( p1 ms last-ref ) to res
- leave
- then
- ms i 1+ array-ref { p2 }
- ms i 2 + array-ref { p3 }
- p1 favor - abs p3 favor - abs < if
- #( p1 p2 ) to res
- leave
+ selected-sound { snd }
+ snd selected-channel { chn }
+ #() { ms }
+ snd chn #f marks each
+ undef mark-sample ms swap array-push drop
+ end-each
+ ms length 2 < if
+ #f
+ else
+ ms <'> marks-sort array-sort! drop
+ ms length 2 = if
+ ms array->array
+ else
+ snd chn left-sample { lw }
+ snd chn right-sample { rw }
+ snd chn undef cursor { cw }
+ cw lw >=
+ cw rw <= && if
+ cw
+ else
+ lw rw + 2/
+ then { favor }
+ #( ms first-ref ms second-ref ) { res }
+ ms each { p1 }
+ i ms length 2 - = if
+ #( p1 ms last-ref ) to res
+ leave
+ then
+ ms i 1+ array-ref { p2 }
+ ms i 2 + array-ref { p3 }
+ p1 favor - abs p3 favor - abs < if
+ #( p1 p2 ) to res
+ leave
+ then
+ end-each
+ res
+ then
then
- end-each
- res
- then
- then
;
: effect-frames { target -- frms }
- target 'sound = if
- #f #f #f frames 1-
- else
- target 'selection = if
- #f #f selection-frames
- else
- plausible-mark-samples { pts }
- pts if
- pts 0 array-ref pts 1 nil array-subarray each - end-each abs 1+
- else
- 0
- then
- then
- then
+ target 'sound = if
+ #f #f #f framples 1-
+ else
+ target 'selection = if
+ #f #f selection-framples
+ else
+ plausible-mark-samples { pts }
+ pts if
+ pts 0 array-ref pts 1 nil array-subarray each
+ -
+ end-each abs 1+
+ else
+ 0
+ then
+ then
+ then
;
: effect-target-ok <{ target -- f }>
- sounds empty? if
- #f
- else
- target 'sound = if
- #t
- else
- target 'selection = if
- undef selection?
- else
- target 'marks = if
- selected-sound dup selected-channel #f marks length 2 >=
+ sounds empty? if
+ #f
else
- #f
+ target 'sound = if
+ #t
+ else
+ target 'selection = if
+ undef selection?
+ else
+ target 'marks = if
+ selected-sound dup
+ selected-channel #f marks length 2 >=
+ else
+ #f
+ then
+ then
+ then
then
- then
- then
- then
;
: general-target-cb ( gen -- prc; self -- f )
- 0 proc-create swap , ( prc )
- does> { self -- f }
- self @ ( gen ) target@ effect-target-ok
+ 0 proc-create swap , ( prc )
+ does> { self -- f }
+ self @ ( gen ) eff_target@ effect-target-ok
;
: set-default-target-cb { okay-button -- prc; self -- }
- 0 proc-create okay-button , ( prc )
- does> { self -- }
- self @ ( okay-button ) sounds empty? not set-sensitive
+ 0 proc-create okay-button , ( prc )
+ does> { self -- }
+ self @ ( okay-button ) sounds empty? not set-sensitive
;
: set-target-cb { okay-button target-prc -- prc; self -- }
- 0 proc-create okay-button , target-prc , ( prc )
- does> { self -- }
- self @ ( okay-button ) self cell+ @ ( target-prc ) #() run-proc set-sensitive
+ 0 proc-create okay-button , target-prc , ( prc )
+ does> { self -- }
+ self @ ( okay ) self cell+ @ ( target ) #() run-proc set-sensitive
;
: help-cb { label message -- prc; w c i self -- x }
- 3 proc-create label , message , ( prc )
- does> { w c info self -- x }
- self @ ( label ) self cell+ @ ( message ) help-dialog
+ 3 proc-create label , message , ( prc )
+ does> { w c info self -- x }
+ self @ ( label ) self cell+ @ ( message ) help-dialog
;
: target-cb ( gen -- prc; target self -- )
- 1 proc-create swap , ( prc )
- does> { target self -- }
- self @ { gen }
- target gen target!
- gen target-widget@ target effect-target-ok set-sensitive
+ 1 proc-create swap , ( prc )
+ does> { target self -- }
+ self @ { gen }
+ gen target eff_target!
+ gen eff_target_widget@ target effect-target-ok set-sensitive
;
: truncate-cb ( gen -- prc; trunc self -- )
- 1 proc-create swap , ( prc )
- does> ( trunc self )
- @ ( gen ) truncate!
+ 1 proc-create swap , ( prc )
+ does> { trunc self }
+ self @ ( gen ) trunc eff_trunc!
;
: map-chan-over-target-with-sync { func target origin-func decay -- }
- sounds empty? if
- $" no sound" snd-warning drop
- else
- target 'selection =
- undef selection? not && if
- $" no selection" snd-warning drop
- else
- #f sync { snc }
- target 'marks = if
- plausible-mark-samples
- else
- #()
- then { pts }
- target 'sound = if
- 0
- else
- target 'selection = if
- #f #f selection-position
+ sounds empty? if
+ "no sound" undef status-report drop
else
- pts 0 array-ref
- then
- then { beg }
- decay number? if
- #f srate decay f* fround->s
- else
- 0
- then { overlap }
- snc 0> if
- all-chans
- else
- #( #( selected-sound dup selected-channel ) )
- then each { lst }
- lst 0 array-ref { snd }
- lst 1 array-ref { chn }
- snd sync snc = if
- target 'sound = if
- snd chn undef frames 1-
- else
- target 'selection = if
- #f #f selection-position #f #f selection-frames +
- else
- pts 1 array-ref
- then
- then { end }
- end beg - { dur }
- origin-func #( target dur ) run-proc { name-and-orig }
- $" %s %s %s %s"
- #( name-and-orig 0 array-ref
- beg
- target 'sound = if #f else dur 1+ then
- name-and-orig 1 array-ref ) string-format { origin }
- func dur run-proc beg end overlap + 1+ snd chn #f origin map-channel drop
+ target 'selection =
+ undef selection? not && if
+ "no selection" undef status-report drop
+ else
+ #f sync { snc }
+ target 'marks = if
+ plausible-mark-samples
+ else
+ #()
+ then { pts }
+ target 'sound = if
+ 0
+ else
+ target 'selection = if
+ #f #f selection-position
+ else
+ pts 0 array-ref
+ then
+ then { beg }
+ decay number? if
+ #f srate decay f* fround->s
+ else
+ 0
+ then { overlap }
+ snc 0> if
+ all-chans
+ else
+ #( #( selected-sound dup selected-channel ) )
+ then each { lst }
+ lst 0 array-ref { snd }
+ lst 1 array-ref { chn }
+ snd sync snc = if
+ target 'sound = if
+ snd chn undef framples 1-
+ else
+ target 'selection = if
+ #f #f selection-position
+ #f #f selection-framples
+ +
+ else
+ pts 1 array-ref
+ then
+ then { end }
+ end beg - { dur }
+ origin-func #( target dur )
+ run-proc { name-and-orig }
+ "%s %s %s %s"
+ #( name-and-orig 0 array-ref
+ beg
+ target 'sound = if
+ #f
+ else
+ dur 1+
+ then
+ name-and-orig 1 array-ref )
+ string-format { origin }
+ func dur run-proc beg end overlap + 1+
+ snd chn #f origin map-channel drop
+ then
+ end-each
+ then
then
- end-each
- then
- then
;
'snd-motif provided? [if]
- : cascade-cb <{ w c i -- }> c each #() run-proc drop end-each ;
-
- : make-menu { name parent -- gen }
- snd-menu% %alloc { mn }
- parent name #( FXmNbackground basic-color ) undef FXmCreatePulldownMenu { menu }
- #() { lst }
- name FxmCascadeButtonWidgetClass parent
- #( FXmNsubMenuId menu FXmNbackground basic-color ) undef FXtCreateManagedWidget { cascade }
- cascade FXmNcascadingCallback <'> cascade-cb lst FXtAddCallback drop
- parent mn menu-parent !
- name mn menu-name !
- menu mn menu-menu !
- cascade mn menu-cascade !
- lst mn menu-children !
- mn
- ;
-
- : menu-entry { gen prc disp-prc -- }
- gen menu-name@ FxmPushButtonWidgetClass gen menu-menu@
- #( FXmNbackground basic-color ) undef FXtCreateManagedWidget { child }
- child FXmNactivateCallback prc undef FXtAddCallback drop
- gen menu-children@ disp-prc #( child ) run-proc array-push drop
- ;
-
- : unmanage-cb <{ w c i -- f }> c FXtUnmanageChild ;
-
- [defined] F_XEditResCheckMessages not [if]
- : F_XEditResCheckMessages <{ w c i f -- x }> #f ;
- [then]
-
- : make-effect-dialog { label ok-prc help-prc reset-prc target-prc -- dialog }
- eff-dismiss-string FXmStringCreateLocalized { xdismiss }
- eff-help-string FXmStringCreateLocalized { xhelp }
- eff-okay-string FXmStringCreateLocalized { xok }
- label FXmStringCreateLocalized { titlestr }
- main-widgets 1 array-ref label
- #( FXmNcancelLabelString xdismiss
- FXmNhelpLabelString xhelp
- FXmNokLabelString xok
- FXmNautoUnmanage #f
- FXmNdialogTitle titlestr
- FXmNresizePolicy FXmRESIZE_GROW
- FXmNnoResize #f
- FXmNbackground basic-color
- FXmNtransient #f ) undef FXmCreateTemplateDialog { new-dialog }
- xhelp FXmStringFree drop
- xok FXmStringFree drop
- xdismiss FXmStringFree drop
- titlestr FXmStringFree drop
- new-dialog 0 #t <'> F_XEditResCheckMessages #f FXtAddEventHandler drop
- #( #( FXmDIALOG_HELP_BUTTON highlight-color )
- #( FXmDIALOG_CANCEL_BUTTON highlight-color )
- #( FXmDIALOG_OK_BUTTON highlight-color ) ) each { lst }
- lst 0 array-ref { button }
- lst 1 array-ref { color }
- new-dialog button FXmMessageBoxGetChild
- #( FXmNarmColor selection-color
- FXmNbackground color ) FXtVaSetValues drop
- end-each
- new-dialog FXmNcancelCallback <'> unmanage-cb new-dialog FXtAddCallback drop
- new-dialog FXmNhelpCallback help-prc undef FXtAddCallback drop
- new-dialog FXmNokCallback ok-prc undef FXtAddCallback drop
- reset-prc if
- eff-reset-string FxmPushButtonWidgetClass new-dialog
- #( FXmNbackground highlight-color
- FXmNforeground black-pixel
- FXmNarmColor selection-color ) undef FXtCreateManagedWidget ( reset-button )
- FXmNactivateCallback reset-prc undef FXtAddCallback drop
- then
- new-dialog FXmDIALOG_OK_BUTTON FXmMessageBoxGetChild { okay-button }
- effects-hook okay-button target-prc ?dup-if
- set-target-cb
- else
- set-default-target-cb
- then add-hook!
- new-dialog
- ;
-
- : scale-log-cb <{ w c info -- }>
- c 0 array-ref { label }
- c 1 array-ref { low }
- c 2 array-ref { high }
- label low info Fvalue high scale-log-label change-label
- ;
-
- : create-log-scale-widget { parent title low init high cb -- scale }
- "%.2f" #( init ) string-format FxmLabelWidgetClass parent
- #( FXmNbackground basic-color ) undef FXtCreateManagedWidget { label }
- "scale" FxmScaleWidgetClass parent
- #( FXmNorientation FXmHORIZONTAL
- FXmNshowValue #f
- FXmNminimum 0
- FXmNmaximum log-scale-ticks f>s
- FXmNvalue low init high scale-log->linear
- FXmNdecimalPoints 0
- FXmNtitleString title
- FXmNbackground basic-color ) undef FXtCreateManagedWidget { scale }
- #( label low high ) { data }
- scale FXmNvalueChangedCallback <'> scale-log-cb data FXtAddCallback drop
- scale FXmNvalueChangedCallback cb undef FXtAddCallback drop
- scale FXmNdragCallback <'> scale-log-cb data FXtAddCallback drop
- scale FXmNdragCallback cb undef FXtAddCallback drop
- scale
- ;
-
- : scale-semi-cb <{ w c info -- }> c info Fvalue semi-scale-label change-label ;
-
- : create-semi-scale-widget { parent title init cb -- scale }
- $" semitones: %s" #( init ratio->semitones ) string-format { str }
- str FxmLabelWidgetClass parent
- #( FXmNbackground basic-color ) undef FXtCreateManagedWidget { label }
- "scale" FxmScaleWidgetClass parent
- #( FXmNorientation FXmHORIZONTAL
- FXmNshowValue #f
- FXmNminimum 0
- FXmNmaximum semi-range 2*
- FXmNvalue semi-range init ratio->semitones +
- FXmNdecimalPoints 0
- FXmNtitleString title
- FXmNbackground basic-color ) undef FXtCreateManagedWidget { scale }
- scale FXmNvalueChangedCallback <'> scale-semi-cb label FXtAddCallback drop
- scale FXmNvalueChangedCallback cb undef FXtAddCallback drop
- scale FXmNdragCallback <'> scale-semi-cb label FXtAddCallback drop
- scale FXmNdragCallback cb undef FXtAddCallback drop
- scale
- ;
-
- \ sliders: #( #( label low init high func scale [log] ) ... )
- : add-sliders { dialog sliders -- sliders-array }
- "formd" FxmFormWidgetClass dialog
- #( FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNtopAttachment FXmATTACH_FORM
- FXmNbottomAttachment FXmATTACH_WIDGET
- FXmNbottomWidget dialog FXmDIALOG_SEPARATOR FXmMessageBoxGetChild
- FXmNbackground highlight-color ) undef FXtCreateManagedWidget { mainfrm }
- "rcd" FxmRowColumnWidgetClass mainfrm
- #( FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNbackground highlight-color
- FXmNorientation FXmVERTICAL ) undef FXtCreateManagedWidget { mainform }
- sliders map
- *key* 0 array-ref FXmStringCreateLocalized { title }
- *key* 1 array-ref { low }
- *key* 2 array-ref { init }
- *key* 3 array-ref { high }
- *key* 4 array-ref { func }
- *key* 5 array-ref { scale }
- *key* length 7 = if
- *key* 6 array-ref 'log = if
- mainform title low init high func create-log-scale-widget
- else
- mainform title init func create-semi-scale-widget
- then ( scale )
- else
- *key* 0 array-ref FxmScaleWidgetClass mainform
- #( FXmNorientation FXmHORIZONTAL
- FXmNshowValue #t
- FXmNminimum low scale f* fround->s
- FXmNmaximum high scale f* fround->s
- FXmNvalue init scale f* fround->s
- FXmNdecimalPoints
- scale 10000 = if
- 4
- else
- scale 1000 = if
- 3
- else
- scale 100 = if
- 2
- else
- scale 10 = if
- 1
- else
- 0
- then
- then
- then
- then
- FXmNtitleString title
- FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNbackground basic-color ) undef FXtCreateManagedWidget ( scale )
- then { new-slider }
- title FXmStringFree drop
- new-slider FXmNvalueChangedCallback func undef FXtAddCallback drop
- new-slider
- end-map
- ;
-
- : color->pixel ( color-str "name" --; self -- pixel )
- create #f , ,
- does> { self -- pixel }
- self @ unless
- main-widgets 1 array-ref { shell }
- shell FXtDisplay { dpy }
- dpy FDefaultScreen { scr }
- dpy scr FDefaultColormap { cmap }
- undef undef undef undef undef undef FXColor { col }
- dpy cmap self cell+ @ ( color-str ) col col FXAllocNamedColor 0= if
- $" can't allocate color!" snd-error drop
- else
- col Fpixel self !
- then
- then
- self @
- ;
-
- "yellow" color->pixel yellow-pixel
-
- \ c == #( prc type )
- : target-arm-cb <{ w c info -- f }> c 0 array-ref #( c 1 array-ref ) run-proc ;
- : target-truncate-cb <{ w c info -- f }> c #( info Fset ) run-proc ;
-
- : add-target-main { mainform target-prc truncate-prc -- rc-wid }
- "sep" FxmSeparatorWidgetClass mainform
- #( FXmNorientation FXmHORIZONTAL
- FXmNseparatorType FXmSHADOW_ETCHED_OUT
- FXmNbackground basic-color ) undef FXtCreateManagedWidget drop
- "rc" FxmRowColumnWidgetClass mainform
- #( FXmNorientation FXmHORIZONTAL
- FXmNbackground basic-color
- FXmNradioBehavior #t
- FXmNradioAlwaysOne #t
- FXmNbottomAttachment FXmATTACH_FORM
- FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNentryClass FxmToggleButtonWidgetClass
- FXmNisHomogeneous #t ) undef FXtCreateManagedWidget { rc }
- #( #( $" entire sound" 'sound #t )
- #( $" selection" 'selection #f )
- #( $" between marks" 'marks #f ) ) each { lst }
- lst 0 array-ref { name }
- lst 1 array-ref { typ }
- lst 2 array-ref { on }
- name FxmToggleButtonWidgetClass rc
- #( FXmNbackground basic-color
- FXmNselectColor yellow-pixel
- FXmNSet on
- FXmNindicatorType FXmONE_OF_MANY_ROUND
- FXmNarmCallback #( <'> target-arm-cb #( target-prc typ ) ) )
- undef FXtCreateManagedWidget drop
- end-each
- truncate-prc if
- "trsep" FxmSeparatorWidgetClass mainform
- #( FXmNorientation FXmHORIZONTAL ) undef FXtCreateManagedWidget drop
- $" truncate at end" FxmToggleButtonWidgetClass mainform
- #( FXmNbackground basic-color
- FXmNset #t
- FXmNselectColor yellow-pixel ) undef FXtCreateManagedWidget ( trbutton )
- FXmNvalueChangedCallback <'> target-truncate-cb truncate-prc FXtAddCallback drop
- then
- rc
- ;
-
- : add-target { gen truncate-prc -- }
- gen dialog@ FXmDIALOG_OK_BUTTON FXmMessageBoxGetChild gen target-widget!
- gen sliders@ 0 array-ref FXtParent { mainform }
- truncate-prc if gen truncate-prc to truncate-prc then
- mainform gen target-cb truncate-prc add-target-main drop
- ;
-
- : get-slider-value { w info corr -- val } info Fvalue corr f/ ;
- : set-slider-value { w val corr -- } w #( FXmNvalue val corr f* f>s ) FXtVaSetValues drop ;
-[else]
- : motif->gtk-cb ( prc-3-arg -- prc-2-arg; w d self -- x )
- 2 proc-create swap , ( prc )
- does> { w d self -- x }
- self @ ( prc ) #( w d #f ) run-proc
- ;
-
- \ We use existing motif callbacks.
- : wrap-motif-cb ( prc -- prc' ) dup proc-arity 0 array-ref 3 = if motif->gtk-cb then ;
- : cascade-cb <{ w d -- f }> d each #() run-proc drop end-each #f ;
-
- : make-menu { name parent -- gen }
- snd-menu% %alloc { mn }
- name Fgtk_menu_item_new_with_label { menu }
- #() { lst }
- Fgtk_menu_new { cascade }
- parent FGTK_MENU_ITEM Fgtk_menu_item_get_submenu FGTK_MENU_SHELL
- menu Fgtk_menu_shell_append drop
- menu Fgtk_widget_show drop
- menu FGTK_MENU_ITEM cascade Fgtk_menu_item_set_submenu drop
- menu "activate" <'> cascade-cb lst Fg_signal_connect drop
- parent mn menu-parent !
- name mn menu-name !
- menu mn menu-menu !
- cascade mn menu-cascade !
- lst mn menu-children !
- mn
- ;
-
- : menu-entry { gen prc disp-prc -- }
- gen menu-name@ Fgtk_menu_item_new_with_label { child }
- gen menu-cascade@ FGTK_MENU_SHELL child Fgtk_menu_shell_append drop
- child Fgtk_widget_show drop
- child "activate" prc wrap-motif-cb #f Fg_signal_connect drop
- gen menu-children@ disp-prc #( child ) run-proc array-push drop
- ;
-
- : unmanage-ev-cb <{ w ev d -- f }> d Fgtk_widget_hide drop #t ;
- : unmanage-cb <{ w d -- f }> d Fgtk_widget_hide ;
-
- : make-effect-dialog { label ok-prc help-prc reset-prc target-prc -- dialog }
- eff-dismiss-string Fgtk_button_new_with_label { dismiss-button }
- eff-help-string Fgtk_button_new_with_label { help-button }
- eff-okay-string Fgtk_button_new_with_label { okay-button }
- Fgtk_dialog_new { new-dialog }
- dismiss-button "quit_button" Fgtk_widget_set_name drop
- help-button "help_button" Fgtk_widget_set_name drop
- okay-button "doit_button" Fgtk_widget_set_name drop
- new-dialog FGTK_CONTAINER 10 Fgtk_container_set_border_width drop
- new-dialog FGTK_WINDOW { window }
- window label Fgtk_window_set_title drop
- window -1 -1 Fgtk_window_set_default_size drop
- window #t Fgtk_window_set_resizable drop
- new-dialog FGTK_DIALOG Fgtk_dialog_get_action_area FGTK_BOX { box }
- new-dialog "delete_event" <'> unmanage-ev-cb new-dialog Fg_signal_connect drop
- box dismiss-button #t #t 20 Fgtk_box_pack_start drop
- dismiss-button "clicked" <'> unmanage-cb new-dialog Fg_signal_connect drop
- dismiss-button Fgtk_widget_show drop
- box okay-button #t #t 20 Fgtk_box_pack_start drop
- okay-button "clicked" ok-prc wrap-motif-cb #f Fg_signal_connect drop
- okay-button Fgtk_widget_show drop
- reset-prc if
- eff-reset-string Fgtk_button_new_with_label { reset-button }
- reset-button "reset_button" Fgtk_widget_set_name drop
- box reset-button #t #t 20 Fgtk_box_pack_start drop
- reset-button "clicked" reset-prc wrap-motif-cb #f Fg_signal_connect drop
- reset-button Fgtk_widget_show drop
- then
- box help-button #t #t 20 Fgtk_box_pack_end drop
- help-button "clicked" help-prc wrap-motif-cb #f Fg_signal_connect drop
- help-button Fgtk_widget_show drop
- effects-hook okay-button target-prc ?dup-if
- set-target-cb
- else
- set-default-target-cb
- then add-hook!
- new-dialog FG_OBJECT "ok-button" okay-button FGPOINTER Fg_object_set_data drop
- new-dialog
- ;
-
- : scale-log-cb <{ w d -- f }>
- d 0 array-ref { label }
- d 1 array-ref { title }
- d 2 array-ref { low }
- d 3 array-ref { high }
- d 4 array-ref { func }
- func #( w d ) run-proc drop
- label
- title $" : " $+ low w FGTK_ADJUSTMENT Fgtk_adjustment_get_value high scale-log-label $+
- change-label
- #f
- ;
-
- \ sliders: #( #( label low init high func scale [log] ) ... )
- : add-sliders { dialog sliders -- sliders-array }
- #f 2 Fgtk_vbox_new { mainform }
- sliders length 1 = if
- #f #f
- else
- 2 sliders length #f Fgtk_table_new dup FGTK_TABLE
- then { table tabtab }
- 0 { slider }
- dialog FGTK_DIALOG Fgtk_dialog_get_content_area FGTK_BOX { box }
- box mainform #f #f 4 Fgtk_box_pack_start drop
- mainform Fgtk_widget_show drop
- table if
- mainform FGTK_BOX table #f #f 4 Fgtk_box_pack_start drop
- tabtab 4 Fgtk_table_set_row_spacings drop
- tabtab 4 Fgtk_table_set_col_spacings drop
- table Fgtk_widget_show drop
- then
- sliders map
- *key* 0 array-ref { title }
- *key* 1 array-ref { low }
- *key* 2 array-ref { init }
- *key* 3 array-ref { high }
- *key* 4 array-ref { func }
- *key* 5 array-ref { scaler }
- *key* length 7 = if
- *key* 6 array-ref 'log =
- else
- #f
- then { use-log }
- table if #f else #f 0 Fgtk_hbox_new then { hbox }
- table if
- use-log if
- $" %s (%.2f)" #( title init )
- else
- $" %s" #( title )
- then
- else
- use-log if
- $" %s: %.2f" #( title init )
- else
- $" %s:" #( title )
- then
- then string-format Fgtk_label_new { label }
- use-log if
- low init high scale-log->linear 0 log-scale-ticks f>s 1 10 1
- else
- init low high 0.0 0.0 0.0
- then Fgtk_adjustment_new dup { adj } FGTK_ADJUSTMENT Fgtk_hscale_new { scale }
- table if
- tabtab label 0 1 slider dup 1+ FGTK_FILL FGTK_SHRINK or dup 0 0 Fgtk_table_attach drop
- else
- mainform FGTK_BOX hbox #f #f 2 Fgtk_box_pack_start drop
- hbox Fgtk_widget_show drop
- hbox FGTK_BOX label #f #f 6 Fgtk_box_pack_start drop
- then
- label Fgtk_widget_show drop
- scale FGTK_SCALE { sclscl }
- sclscl FGTK_RANGE FGTK_UPDATE_CONTINUOUS Fgtk_range_set_update_policy drop
- sclscl use-log if
- 0
- else
- scaler 1000 = if
- 3
- else
- scaler 100 = if
- 2
- else
- scaler 10 = if
- 1
- else
- 0
- then
- then
- then
- then Fgtk_scale_set_digits drop
- sclscl use-log not Fgtk_scale_set_draw_value drop
- table if
- tabtab scale 1 2 slider dup 1+ FGTK_FILL FGTK_EXPAND or FGTK_SHRINK or dup 0 0
- Fgtk_table_attach drop
- slider 1+ to slider
- else
- hbox FGTK_BOX scale #t #t 0 Fgtk_box_pack_start drop
- then
- scale Fgtk_widget_show drop
- adj "value_changed"
- use-log if
- <'> scale-log-cb #( label title low high func wrap-motif-cb )
- else
- func wrap-motif-cb #f
- then Fg_signal_connect drop
- adj
- end-map
- ;
-
- \ d: #( func type )
- : target-arm-cb <{ w d -- f }>
- \ d 0 array-ref #( d 1 array-ref ) run-proc
- d 0 array-ref { func }
- d 1 array-ref { typ }
- func #( typ ) run-proc
- ;
-
- \ d: func
- : target-truncate-cb <{ w d -- f }>
- \ d #( w FGTK_TOGGLE_BUTTON Fgtk_toggle_button_get_active ) run-proc
- w FGTK_TOGGLE_BUTTON Fgtk_toggle_button_get_active { wid }
- d #( wid ) run-proc
- ;
-
- : add-target-main { mainform target-prc truncate-prc -- rc-wid }
- #f 0 Fgtk_hbox_new { rc }
- mainform FGTK_BOX rc #f #f 4 Fgtk_box_pack_start drop
- rc Fgtk_widget_show drop
- rc FGTK_BOX { rcbox }
- #f { group }
- #( #( $" entire sound" 'sound #t )
- #( $" selection" 'selection #f )
- #( $" between marks" 'marks #f ) ) each { lst }
- lst 0 array-ref { name }
- lst 1 array-ref { typ }
- lst 2 array-ref { on }
- group name Fgtk_radio_button_new_with_label { button }
- button FGTK_RADIO_BUTTON Fgtk_radio_button_get_group to group
- rcbox button #f #f 4 Fgtk_box_pack_start drop
- button FGTK_TOGGLE_BUTTON on Fgtk_toggle_button_set_active drop
- button Fgtk_widget_show drop
- button "clicked" <'> target-arm-cb #( target-prc typ ) Fg_signal_connect drop
- end-each
- truncate-prc if
- Fgtk_hseparator_new { sep }
- rcbox sep #t #t 4 Fgtk_box_pack_start drop
- sep Fgtk_widget_show drop
- $" truncate at end" Fgtk_check_button_new_with_label to button
- rcbox button #t #t 4 Fgtk_box_pack_start drop
- button FGTK_TOGGLE_BUTTON #t Fgtk_toggle_button_set_active drop
- button Fgtk_widget_show drop
- button "clicked" <'> target-truncate-cb truncate-prc Fg_signal_connect drop
- then
- rc
- ;
-
- : add-target { gen truncate-prc -- }
- gen dialog@ FG_OBJECT "ok-button" Fg_object_get_data FGTK_WIDGET gen target-widget!
- gen dialog@ FGTK_DIALOG Fgtk_dialog_get_content_area { mainform }
- truncate-prc if gen truncate-prc to truncate-prc then
- mainform gen target-cb truncate-prc add-target-main drop
- ;
-
- : get-slider-value { w info corr -- val } w FGTK_ADJUSTMENT Fgtk_adjustment_get_value ;
- : set-slider-value { w val corr -- } w FGTK_ADJUSTMENT val Fgtk_adjustment_set_value drop ;
-[then]
-
-: make-main-menu ( name -- wid ) effects-noop add-to-main-menu dup to effects-menu main-menu ;
-: add-to-effects-menu ( name prc -- ) effects-menu -rot undef add-to-menu drop ;
+ : cascade-cb <{ w c i -- }>
+ c each
+ #() run-proc drop
+ end-each
+ ;
+
+ : make-menu { name parent -- gen }
+ make-snd-menu-struct { gen }
+ parent name #( FXmNbackground basic-color ) undef
+ FXmCreatePulldownMenu { menu }
+ #() { lst }
+ name FxmCascadeButtonWidgetClass parent
+ #( FXmNsubMenuId menu FXmNbackground basic-color ) undef
+ FXtCreateManagedWidget { cas }
+ cas FXmNcascadingCallback <'> cascade-cb lst FXtAddCallback drop
+ gen parent menu-parent!
+ gen name menu-name!
+ gen menu menu-menu!
+ gen cas menu-cascade!
+ gen lst menu-children!
+ gen
+ ;
+
+ : menu-entry { gen prc disp-prc -- }
+ gen menu-children@ { lst }
+ lst array? lst 1 "an array" assert-type
+ gen menu-name@ FxmPushButtonWidgetClass gen menu-menu@
+ #( FXmNbackground basic-color ) undef
+ FXtCreateManagedWidget { child }
+ child FXmNactivateCallback prc undef FXtAddCallback drop
+ lst disp-prc #( child ) run-proc array-push drop
+ ;
+
+ : unmanage-cb <{ w c i -- f }>
+ c FXtUnmanageChild
+ ;
+
+ [undefined] F_XEditResCheckMessages [if]
+ : F_XEditResCheckMessages <{ w c i f -- x }> #f ;
+ [then]
+
+ : make-effect-dialog { label ok-prc help-prc reset-prc target-prc -- d }
+ eff-dismiss-string FXmStringCreateLocalized { xdismiss }
+ eff-help-string FXmStringCreateLocalized { xhelp }
+ eff-okay-string FXmStringCreateLocalized { xok }
+ label FXmStringCreateLocalized { titlestr }
+ main-widgets 1 array-ref label
+ #( FXmNcancelLabelString xdismiss
+ FXmNhelpLabelString xhelp
+ FXmNokLabelString xok
+ FXmNautoUnmanage #f
+ FXmNdialogTitle titlestr
+ FXmNresizePolicy FXmRESIZE_GROW
+ FXmNnoResize #f
+ FXmNbackground basic-color
+ FXmNtransient #f ) undef
+ FXmCreateTemplateDialog { d }
+ xhelp FXmStringFree drop
+ xok FXmStringFree drop
+ xdismiss FXmStringFree drop
+ titlestr FXmStringFree drop
+ d 0 #t <'> F_XEditResCheckMessages #f
+ FXtAddEventHandler drop
+ #( #( FXmDIALOG_HELP_BUTTON highlight-color )
+ #( FXmDIALOG_CANCEL_BUTTON highlight-color )
+ #( FXmDIALOG_OK_BUTTON highlight-color ) ) each { lst }
+ lst 0 array-ref { button }
+ lst 1 array-ref { color }
+ d button FXmMessageBoxGetChild
+ #( FXmNarmColor selection-color
+ FXmNbackground color ) FXtVaSetValues drop
+ end-each
+ d FXmNcancelCallback <'> unmanage-cb d FXtAddCallback drop
+ d FXmNhelpCallback help-prc undef FXtAddCallback drop
+ d FXmNokCallback ok-prc undef FXtAddCallback drop
+ reset-prc if
+ eff-reset-string FxmPushButtonWidgetClass d
+ #( FXmNbackground highlight-color
+ FXmNforeground black-pixel
+ FXmNarmColor selection-color ) undef
+ FXtCreateManagedWidget ( reset )
+ FXmNactivateCallback reset-prc undef FXtAddCallback drop
+ then
+ d FXmDIALOG_OK_BUTTON FXmMessageBoxGetChild { okay-button }
+ effects-hook okay-button target-prc ?dup-if
+ set-target-cb
+ else
+ set-default-target-cb
+ then add-hook!
+ d
+ ;
+
+ : scale-log-cb <{ w c info -- }>
+ c 0 array-ref { label }
+ c 1 array-ref { low }
+ c 2 array-ref { high }
+ label low info Fvalue high scale-log-label change-label
+ ;
+
+ : create-log-scale-widget { parent title low init high cb -- scale }
+ "%.2f" #( init ) string-format FxmLabelWidgetClass parent
+ #( FXmNbackground basic-color ) undef
+ FXtCreateManagedWidget { label }
+ "scale" FxmScaleWidgetClass parent
+ #( FXmNorientation FXmHORIZONTAL
+ FXmNshowValue #f
+ FXmNminimum 0
+ FXmNmaximum log-scale-ticks f>s
+ FXmNvalue low init high scale-log->linear
+ FXmNdecimalPoints 0
+ FXmNtitleString title
+ FXmNbackground basic-color ) undef
+ FXtCreateManagedWidget { scale }
+ #( label low high ) { data }
+ scale FXmNvalueChangedCallback <'> scale-log-cb data
+ FXtAddCallback drop
+ scale FXmNvalueChangedCallback cb undef FXtAddCallback drop
+ scale FXmNdragCallback <'> scale-log-cb data FXtAddCallback drop
+ scale FXmNdragCallback cb undef FXtAddCallback drop
+ scale
+ ;
+
+ : scale-semi-cb <{ w c info -- }>
+ c info Fvalue semi-scale-label change-label
+ ;
+
+ : create-semi-scale-widget { parent title init cb -- scale }
+ "semitones: %s" #( init ratio->semitones ) string-format { str }
+ str FxmLabelWidgetClass parent
+ #( FXmNbackground basic-color ) undef
+ FXtCreateManagedWidget { label }
+ "scale" FxmScaleWidgetClass parent
+ #( FXmNorientation FXmHORIZONTAL
+ FXmNshowValue #f
+ FXmNminimum 0
+ FXmNmaximum semi-range 2*
+ FXmNvalue semi-range init ratio->semitones +
+ FXmNdecimalPoints 0
+ FXmNtitleString title
+ FXmNbackground basic-color ) undef
+ FXtCreateManagedWidget { scale }
+ scale FXmNvalueChangedCallback <'> scale-semi-cb label
+ FXtAddCallback drop
+ scale FXmNvalueChangedCallback cb undef FXtAddCallback drop
+ scale FXmNdragCallback <'> scale-semi-cb label
+ FXtAddCallback drop
+ scale FXmNdragCallback cb undef FXtAddCallback drop
+ scale
+ ;
+
+ \ sliders: #( #( label low init high func scale [log] ) ... )
+ : add-sliders { dialog sliders -- sliders-array }
+ "formd" FxmFormWidgetClass dialog
+ #( FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNtopAttachment FXmATTACH_FORM
+ FXmNbottomAttachment FXmATTACH_WIDGET
+ FXmNbottomWidget
+ dialog FXmDIALOG_SEPARATOR FXmMessageBoxGetChild
+ FXmNbackground highlight-color ) undef
+ FXtCreateManagedWidget { mainfrm }
+ "rcd" FxmRowColumnWidgetClass mainfrm
+ #( FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNbackground highlight-color
+ FXmNorientation FXmVERTICAL ) undef
+ FXtCreateManagedWidget { mainform }
+ sliders map
+ *key* 0 array-ref FXmStringCreateLocalized { title }
+ *key* 1 array-ref { low }
+ *key* 2 array-ref { init }
+ *key* 3 array-ref { high }
+ *key* 4 array-ref { func }
+ *key* 5 array-ref { scale }
+ *key* length 7 = if
+ *key* 6 array-ref 'log = if
+ mainform title low init high func
+ create-log-scale-widget
+ else
+ mainform title init func
+ create-semi-scale-widget
+ then ( scale )
+ else
+ *key* 0 array-ref FxmScaleWidgetClass mainform
+ #( FXmNorientation FXmHORIZONTAL
+ FXmNshowValue #t
+ FXmNminimum low scale f* fround->s
+ FXmNmaximum high scale f* fround->s
+ FXmNvalue init scale f* fround->s
+ FXmNdecimalPoints
+ scale 10000 = if
+ 4
+ else
+ scale 1000 = if
+ 3
+ else
+ scale 100 = if
+ 2
+ else
+ scale 10 = if
+ 1
+ else
+ 0
+ then
+ then
+ then
+ then
+ FXmNtitleString title
+ FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNbackground basic-color ) undef
+ FXtCreateManagedWidget ( sc )
+ then { new-slider }
+ title FXmStringFree drop
+ new-slider FXmNvalueChangedCallback func undef
+ FXtAddCallback drop
+ new-slider
+ end-map
+ ;
+
+ : color->pixel ( color-str "name" --; self -- pixel )
+ { color-str }
+ create #f , color-str ,
+ does> { self -- pixel }
+ self @ ( color ) unless
+ main-widgets 1 array-ref { shell }
+ shell FXtDisplay { dpy }
+ dpy FDefaultScreen { scr }
+ dpy scr FDefaultColormap { cmap }
+ undef undef undef undef undef undef FXColor { col }
+ dpy cmap
+ self cell+ @ ( color-str )
+ col col FXAllocNamedColor 0= if
+ "can't allocate color!" snd-error drop
+ else
+ col Fpixel self !
+ then
+ then
+ self @ ( color )
+ ;
+
+ "yellow" color->pixel yellow-pixel
+
+ \ c == #( prc type )
+ : target-arm-cb <{ w c info -- f }>
+ c 0 array-ref #( c 1 array-ref ) run-proc
+ ;
+
+ : target-truncate-cb <{ w c info -- f }>
+ c #( info Fset ) run-proc
+ ;
+
+ : add-target-main { mainform target-prc truncate-prc -- rc-wid }
+ "sep" FxmSeparatorWidgetClass mainform
+ #( FXmNorientation FXmHORIZONTAL
+ FXmNseparatorType FXmSHADOW_ETCHED_OUT
+ FXmNbackground basic-color ) undef
+ FXtCreateManagedWidget drop
+ "rc" FxmRowColumnWidgetClass mainform
+ #( FXmNorientation FXmHORIZONTAL
+ FXmNbackground basic-color
+ FXmNradioBehavior #t
+ FXmNradioAlwaysOne #t
+ FXmNbottomAttachment FXmATTACH_FORM
+ FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNentryClass FxmToggleButtonWidgetClass
+ FXmNisHomogeneous #t ) undef
+ FXtCreateManagedWidget { rc }
+ #( #( "entire sound" 'sound #t )
+ #( "selection" 'selection #f )
+ #( "between marks" 'marks #f ) ) each { lst }
+ lst 0 array-ref { name }
+ lst 1 array-ref { typ }
+ lst 2 array-ref { on }
+ name FxmToggleButtonWidgetClass rc
+ #( FXmNbackground basic-color
+ FXmNselectColor yellow-pixel
+ FXmNSet on
+ FXmNindicatorType FXmONE_OF_MANY_ROUND
+ FXmNarmCallback
+ #( <'> target-arm-cb #( target-prc typ ) ) )
+ undef FXtCreateManagedWidget drop
+ end-each
+ truncate-prc if
+ "trsep" FxmSeparatorWidgetClass mainform
+ #( FXmNorientation FXmHORIZONTAL ) undef
+ FXtCreateManagedWidget drop
+ "truncate at end" FxmToggleButtonWidgetClass mainform
+ #( FXmNbackground basic-color
+ FXmNset #t
+ FXmNselectColor yellow-pixel ) undef
+ FXtCreateManagedWidget ( trbut )
+ FXmNvalueChangedCallback <'> target-truncate-cb
+ truncate-prc FXtAddCallback drop
+ then
+ rc
+ ;
+
+ : add-target { gen truncate-prc -- }
+ gen eff_dialog@ FXmDIALOG_OK_BUTTON FXmMessageBoxGetChild ( mb )
+ gen swap eff_target_widget!
+ gen eff_sliders@ 0 array-ref FXtParent { mainform }
+ truncate-prc if
+ gen truncate-prc to truncate-prc
+ then
+ mainform gen target-cb truncate-prc add-target-main drop
+ ;
+
+ : get-slider-value { w info corr -- val }
+ info Fvalue corr f/
+ ;
+
+ : set-slider-value { w val corr -- }
+ w #( FXmNvalue val corr f* f>s ) FXtVaSetValues drop
+ ;
+[else] \ !HAVE_MOTIF
+ : motif->gtk-cb ( prc-3-arg -- prc-2-arg; w d self -- x )
+ 2 proc-create swap , ( prc )
+ does> { w d self -- x }
+ self @ ( prc ) #( w d #f ) run-proc
+ ;
+
+ \ We use existing motif callbacks.
+ : wrap-motif-cb ( prc -- prc' )
+ dup proc-arity 0 array-ref 3 = if
+ motif->gtk-cb
+ then
+ ;
+
+ : cascade-cb <{ w d -- f }>
+ d each
+ #() run-proc drop
+ end-each
+ #f
+ ;
+
+ : make-menu { name parent -- gen }
+ make-snd-menu-struct { gen }
+ name Fgtk_menu_item_new_with_label { menu }
+ #() { lst }
+ Fgtk_menu_new { cas }
+ parent FGTK_MENU_ITEM Fgtk_menu_item_get_submenu FGTK_MENU_SHELL
+ menu Fgtk_menu_shell_append drop
+ menu Fgtk_widget_show drop
+ menu FGTK_MENU_ITEM cas Fgtk_menu_item_set_submenu drop
+ menu "activate" <'> cascade-cb lst Fg_signal_connect drop
+ gen parent menu-parent!
+ gen name menu-name!
+ gen menu menu-menu!
+ gen cas menu-cascade!
+ gen lst menu-children!
+ gen
+ ;
+
+ : menu-entry { gen prc disp-prc -- }
+ gen menu-children@ { lst }
+ lst array? lst 1 "an array" assert-type
+ gen menu-name@ Fgtk_menu_item_new_with_label { child }
+ gen menu-cascade@ FGTK_MENU_SHELL child
+ Fgtk_menu_shell_append drop
+ child Fgtk_widget_show drop
+ child "activate" prc wrap-motif-cb #f Fg_signal_connect drop
+ lst disp-prc #( child ) run-proc array-push drop
+ ;
+
+ : unmanage-ev-cb <{ w ev d -- f }>
+ d Fgtk_widget_hide drop #t
+ ;
+
+ : unmanage-cb <{ w d -- f }>
+ d Fgtk_widget_hide
+ ;
+
+ : make-effect-dialog { label ok-prc help-prc reset-prc target-prc -- d }
+ eff-dismiss-string Fgtk_button_new_with_label { dismiss-button }
+ eff-help-string Fgtk_button_new_with_label { help-button }
+ eff-okay-string Fgtk_button_new_with_label { okay-button }
+ Fgtk_dialog_new { d }
+ dismiss-button "quit_button" Fgtk_widget_set_name drop
+ help-button "help_button" Fgtk_widget_set_name drop
+ okay-button "doit_button" Fgtk_widget_set_name drop
+ d FGTK_CONTAINER 10 Fgtk_container_set_border_width drop
+ d FGTK_WINDOW { window }
+ window label Fgtk_window_set_title drop
+ window -1 -1 Fgtk_window_set_default_size drop
+ window #t Fgtk_window_set_resizable drop
+ d FGTK_DIALOG Fgtk_dialog_get_action_area FGTK_BOX { box }
+ d "delete_event" <'> unmanage-ev-cb d Fg_signal_connect drop
+ box dismiss-button #t #t 20 Fgtk_box_pack_start drop
+ dismiss-button "clicked" <'> unmanage-cb d
+ Fg_signal_connect drop
+ dismiss-button Fgtk_widget_show drop
+ box okay-button #t #t 20 Fgtk_box_pack_start drop
+ okay-button "clicked" ok-prc wrap-motif-cb #f
+ Fg_signal_connect drop
+ okay-button Fgtk_widget_show drop
+ reset-prc if
+ eff-reset-string Fgtk_button_new_with_label { reset }
+ reset "reset_button" Fgtk_widget_set_name drop
+ box reset #t #t 20 Fgtk_box_pack_start drop
+ reset "clicked" reset-prc wrap-motif-cb #f
+ Fg_signal_connect drop
+ reset Fgtk_widget_show drop
+ then
+ box help-button #t #t 20 Fgtk_box_pack_end drop
+ help-button "clicked" help-prc wrap-motif-cb #f
+ Fg_signal_connect drop
+ help-button Fgtk_widget_show drop
+ effects-hook okay-button target-prc ?dup-if
+ set-target-cb
+ else
+ set-default-target-cb
+ then add-hook!
+ d FG_OBJECT "ok-button" okay-button FGPOINTER
+ Fg_object_set_data drop
+ d
+ ;
+
+ : scale-log-cb <{ w d -- f }>
+ d 0 array-ref { label }
+ d 1 array-ref { title }
+ d 2 array-ref { low }
+ d 3 array-ref { high }
+ d 4 array-ref { func }
+ func #( w d ) run-proc drop
+ label title ": " $+ low
+ w FGTK_ADJUSTMENT Fgtk_adjustment_get_value
+ high scale-log-label $+ change-label
+ #f
+ ;
+
+ 'gtk3 provided? [if]
+ <'> noop alias effects-range-set-update-policy ( w -- f )
+ [else]
+ : effects-range-set-update-policy ( w -- f )
+ FGTK_RANGE FGTK_UPDATE_CONTINUOUS
+ Fgtk_range_set_update_policy
+ ;
+ [then]
+
+ \ sliders: #( #( label low init high func scale [log] ) ... )
+ : add-sliders { dialog sliders -- sliders-array }
+ FGTK_ORIENTATION_VERTICAL 2 Fgtk_box_new { mainform }
+ sliders length 1 = if
+ #f #f
+ else
+ Fgtk_grid_new dup FGTK_GRID
+ then { table tabtab }
+ 0 { slider }
+ dialog FGTK_DIALOG Fgtk_dialog_get_content_area FGTK_BOX { box }
+ box mainform #f #f 4 Fgtk_box_pack_start drop
+ mainform Fgtk_widget_show drop
+ table if
+ mainform FGTK_BOX table #f #f 4 Fgtk_box_pack_start drop
+ tabtab 4 Fgtk_grid_set_row_spacing drop
+ tabtab 4 Fgtk_grid_set_column_spacing drop
+ table Fgtk_widget_show drop
+ then
+ sliders map
+ *key* 0 array-ref { title }
+ *key* 1 array-ref { low }
+ *key* 2 array-ref { init }
+ *key* 3 array-ref { high }
+ *key* 4 array-ref { func }
+ *key* 5 array-ref { scaler }
+ *key* length 7 = if
+ *key* 6 array-ref 'log =
+ else
+ #f
+ then { use-log }
+ table if
+ #f
+ else
+ FGTK_ORIENTATION_HORIZONTAL 0 Fgtk_box_new
+ then { hbox }
+ table if
+ use-log if
+ "%s (%.2f)" #( title init )
+ else
+ "%s" #( title )
+ then
+ else
+ use-log if
+ "%s: %.2f" #( title init )
+ else
+ "%s:" #( title )
+ then
+ then string-format Fgtk_label_new { label }
+ use-log if
+ low init high scale-log->linear
+ 0 log-scale-ticks f>s 1 10 1
+ else
+ init low high 0.0 0.0 0.0
+ then Fgtk_adjustment_new { adj }
+ FGTK_ORIENTATION_HORIZONTAL adj FGTK_ADJUSTMENT
+ Fgtk_scale_new { scale }
+ table if
+ tabtab label 0 slider 1 1 Fgtk_grid_attach drop
+ else
+ mainform FGTK_BOX hbox #f #f 2
+ Fgtk_box_pack_start drop
+ hbox Fgtk_widget_show drop
+ hbox FGTK_BOX label #f #f 6
+ Fgtk_box_pack_start drop
+ then
+ label Fgtk_widget_show drop
+ scale FGTK_SCALE { sclscl }
+ sclscl effects-range-set-update-policy drop
+ sclscl use-log if
+ 0
+ else
+ scaler 1000 = if
+ 3
+ else
+ scaler 100 = if
+ 2
+ else
+ scaler 10 = if
+ 1
+ else
+ 0
+ then
+ then
+ then
+ then Fgtk_scale_set_digits drop
+ sclscl use-log not Fgtk_scale_set_draw_value drop
+ table if
+ scale FGTK_WIDGET #t
+ Fgtk_widget_set_hexpand drop
+ tabtab scale 1 slider 1 1 Fgtk_grid_attach drop
+ slider 1+ to slider
+ else
+ hbox FGTK_BOX scale #t #t 0
+ Fgtk_box_pack_start drop
+ then
+ scale Fgtk_widget_show drop
+ adj "value_changed"
+ use-log if
+ <'> scale-log-cb
+ #( label title low high func wrap-motif-cb )
+ else
+ func wrap-motif-cb #f
+ then Fg_signal_connect drop
+ adj
+ end-map
+ ;
+
+ \ d: #( func type )
+ : target-arm-cb <{ w d -- f }>
+ d 0 array-ref { func }
+ d 1 array-ref { typ }
+ func #( typ ) run-proc
+ ;
+
+ \ d: func
+ : target-truncate-cb <{ w d -- f }>
+ w FGTK_TOGGLE_BUTTON Fgtk_toggle_button_get_active { wid }
+ d #( wid ) run-proc
+ ;
+
+ : add-target-main { mainform target-prc truncate-prc -- rc-wid }
+ FGTK_ORIENTATION_HORIZONTAL 2 Fgtk_box_new { rc }
+ mainform FGTK_BOX rc #f #f 4 Fgtk_box_pack_start drop
+ rc Fgtk_widget_show drop
+ rc FGTK_BOX { rcbox }
+ #f { group }
+ #( #( "entire sound" 'sound #t )
+ #( "selection" 'selection #f )
+ #( "between marks" 'marks #f ) ) each { lst }
+ lst 0 array-ref { name }
+ lst 1 array-ref { typ }
+ lst 2 array-ref { on }
+ group name Fgtk_radio_button_new_with_label { button }
+ button FGTK_RADIO_BUTTON Fgtk_radio_button_get_group
+ to group
+ rcbox button #f #f 4 Fgtk_box_pack_start drop
+ button FGTK_TOGGLE_BUTTON on
+ Fgtk_toggle_button_set_active drop
+ button Fgtk_widget_show drop
+ button "clicked" <'> target-arm-cb
+ #( target-prc typ ) Fg_signal_connect drop
+ end-each
+ truncate-prc if
+ FGTK_ORIENTATION_HORIZONTAL Fgtk_separator_new { sep }
+ rcbox sep #t #t 4 Fgtk_box_pack_start drop
+ sep Fgtk_widget_show drop
+ "truncate at end" Fgtk_check_button_new_with_label
+ to button
+ rcbox button #t #t 4 Fgtk_box_pack_start drop
+ button FGTK_TOGGLE_BUTTON #t
+ Fgtk_toggle_button_set_active drop
+ button Fgtk_widget_show drop
+ button "clicked" <'> target-truncate-cb truncate-prc
+ Fg_signal_connect drop
+ then
+ rc
+ ;
+
+ : add-target { gen truncate-prc -- }
+ gen eff_dialog@ FG_OBJECT "ok-button"
+ Fg_object_get_data FGTK_WIDGET ( mb )
+ gen swap eff_target_widget!
+ gen eff_dialog@ FGTK_DIALOG Fgtk_dialog_get_content_area { d }
+ truncate-prc if
+ gen truncate-prc to truncate-prc
+ then
+ d gen target-cb truncate-prc add-target-main drop
+ ;
+
+ : get-slider-value { w info corr -- val }
+ w FGTK_ADJUSTMENT Fgtk_adjustment_get_value
+ ;
+
+ : set-slider-value { w val corr -- }
+ w FGTK_ADJUSTMENT val Fgtk_adjustment_set_value drop
+ ;
+[then] \ HAVE_MOTIF
+
+: make-main-menu ( name -- wid )
+ effects-noop add-to-main-menu dup to effects-menu main-menu
+;
+
+: add-to-effects-menu ( name prc -- )
+ effects-menu -rot undef add-to-menu drop
+;
previous
hide
\ reusable callbacks
: amplitude-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) amplitude!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_amp!
;
: frequency-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) frequency!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_freq!
;
: log-freq-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- 20.0 w info 1.0 get-slider-value 22050.0 scale-linear->log self @ ( gen ) frequency!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ 20.0 w info 1.0 get-slider-value 22050.0 scale-linear->log { val }
+ self @ ( gen ) val eff_freq!
;
: scaler-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) scaler!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_scl!
;
: size-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) size!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_size!
;
\ === Effects Entries ===
@@ -1524,133 +1740,141 @@ hide
\ === Gain (gain set by gain-amount) ===
'snd-motif provided? [if]
- : make-enved-widget { gen -- }
- gen dialog@ FXmDIALOG_OK_BUTTON FXmMessageBoxGetChild gen target-widget!
- gen sliders@ 0 array-ref FXtParent FXtParent { mainform }
- "fr" FxmFrameWidgetClass mainform
- #( FXmNheight 200
- FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNtopAttachment FXmATTACH_WIDGET
- FXmNtopWidget gen sliders@ last-ref
- FXmNshadowThickness 4
- FXmNshadowType FXmSHADOW_ETCHED_OUT ) undef FXtCreateManagedWidget { fr }
- mainform gen target-cb #f add-target-main { target-row }
- gen dialog@ activate-dialog
- gen label@ string-downcase
- fr
- :envelope #( 0.0 1.0 1.0 1.0 )
- :axis-bounds #( 0.0 1.0 0.0 1.0 )
- :args #( FXmNheight 200 ) make-xenved gen envel!
- fr
- #( FXmNbottomAttachment FXmATTACH_WIDGET
- FXmNbottomWidget target-row ) FXtVaSetValues drop
- ;
+ : make-enved-widget { gen -- }
+ gen eff_dialog@ FXmDIALOG_OK_BUTTON FXmMessageBoxGetChild ( mb )
+ gen swap eff_target_widget!
+ gen eff_sliders@ 0 array-ref FXtParent FXtParent { mainform }
+ "fr" FxmFrameWidgetClass mainform
+ #( FXmNheight 200
+ FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNtopAttachment FXmATTACH_WIDGET
+ FXmNtopWidget gen eff_sliders@ last-ref
+ FXmNshadowThickness 4
+ FXmNshadowType FXmSHADOW_ETCHED_OUT ) undef
+ FXtCreateManagedWidget { fr }
+ mainform gen target-cb #f add-target-main { target-row }
+ gen eff_dialog@ activate-dialog
+ gen eff_label@ string-downcase fr
+ :envelope #( 0.0 1.0 1.0 1.0 )
+ :axis-bounds #( 0.0 1.0 0.0 1.0 )
+ :args #( FXmNheight 200 ) make-xenved { en }
+ gen en eff_enved!
+ fr #( FXmNbottomAttachment FXmATTACH_WIDGET
+ FXmNbottomWidget target-row ) FXtVaSetValues drop
+ ;
[else]
- : make-enved-widget { gen -- }
- gen #f add-target
- gen dialog@ Fgtk_widget_show drop
- gen label@ string-downcase
- gen dialog@ FGTK_DIALOG Fgtk_dialog_get_content_area
- :envelope #( 0.0 1.0 1.0 1.0 )
- :axis-bounds #( 0.0 1.0 0.0 1.0 ) make-xenved gen envel!
- gen dialog@ activate-dialog
- ;
+ : make-enved-widget { gen -- }
+ gen #f add-target
+ gen eff_dialog@ Fgtk_widget_show drop
+ gen eff_label@ string-downcase
+ gen eff_dialog@ FGTK_DIALOG Fgtk_dialog_get_content_area
+ :envelope #( 0.0 1.0 1.0 1.0 )
+ :axis-bounds #( 0.0 1.0 0.0 1.0 ) make-xenved { en }
+ gen en eff_enved!
+ gen eff_dialog@ activate-dialog
+ ;
[then]
: gain-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- gen envel@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if
- #f
- else
- gen envel@ xe-envelope gen amount@ scale-envelope
- then { with-env }
- gen target@ 'sound = if
- with-env array? if
- with-env 0 undef 1.0 #f #f #f env-sound
- else
- gen amount@ #f #f scale-by
- then
- else
- gen target@ 'selection = if
- undef selection? if
- with-env array? if
- with-env 1.0 env-selection
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ gen eff_enved@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if
+ #f
else
- gen amount@ scale-selection-by
- then
- else
- $" no selection" snd-warning
- then
- else
- plausible-mark-samples { pts }
- pts if
- with-env array? if
- with-env
- pts 0 array-ref
- pts 1 array-ref
- pts 0 array-ref - 1.0 #f #f #f env-sound
+ gen eff_enved@ xe-envelope gen eff_amnt@ scale-envelope
+ then { with-env }
+ gen eff_target@ 'sound = if
+ with-env array? if
+ with-env 0 undef 1.0 #f #f #f env-sound
+ else
+ gen eff_amnt@ #f #f scale-by
+ then
else
- gen amount@
- pts 0 array-ref
- pts 1 array-ref
- pts 0 array-ref - #f #f #f normalize-channel
+ gen eff_target@ 'selection = if
+ undef selection? if
+ with-env array? if
+ with-env 1.0 env-selection
+ else
+ gen eff_amnt@ scale-selection-by
+ then
+ else
+ "no selection" undef status-report
+ then
+ else
+ plausible-mark-samples { pts }
+ pts if
+ with-env array? if
+ with-env
+ pts 0 array-ref
+ pts 1 array-ref
+ pts 0 array-ref -
+ 1.0 #f #f #f env-sound
+ else
+ gen eff_amnt@
+ pts 0 array-ref
+ pts 1 array-ref
+ pts 0 array-ref -
+ #f #f #f normalize-channel
+ then
+ else
+ "no marks" undef status-report
+ then
+ then
then
- else
- $" no marks" snd-warning
- then
- then
- then
;
: gain-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init ) gen amount!
- gen envel@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
- gen sliders@ 0 array-ref gen amount@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init }
+ gen init eff_amnt!
+ gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
+ gen eff_sliders@ 0 array-ref init 100.0 set-slider-value
;
: gain-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: post-gain-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen gain-ok-cb
- gen label@ $" Move the slider to change the gain scaling amount." help-cb
- gen gain-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( "gain" 0.0 gen amount@ 5.0 gen gain-slider-cb 100 )
- ) add-sliders gen sliders!
- gen make-enved-widget
- else
- gen dialog@ activate-dialog
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen gain-ok-cb
+ gen eff_label@ "\
+Move the slider to change the gain scaling amount." help-cb
+ gen gain-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "gain" 0.0 gen eff_amnt@ 5.0
+ gen gain-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen make-enved-widget
+ else
+ gen eff_dialog@ activate-dialog
+ then
;
set-current
: make-gain-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 1.0 gen amount!
- #f gen envel!
- gen post-gain-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen amount@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1.0 eff_amnt!
+ gen #f eff_enved!
+ gen post-gain-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_amnt@ ) string-format change-label
;
previous
@@ -1658,189 +1882,200 @@ previous
hide
: normalize-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen target@ 'sound = if
- gen amount@ #f #f scale-to drop
- else
- gen target@ 'selection = if
- undef selection? if
- gen amount@ scale-selection-to drop
- else
- $" no selection" snd-warning drop
- then
- else
- plausible-mark-samples { pts }
- pts if
- gen amount@
- pts 0 array-ref
- pts 1 array-ref
- pts 0 array-ref - #f #f #f normalize-channel drop
- else
- $" no marks" snd-warning drop
- then
- then
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_target@ 'sound = if
+ gen eff_amnt@ #f #f scale-to drop
+ else
+ gen eff_target@ 'selection = if
+ undef selection? if
+ gen eff_amnt@ scale-selection-to drop
+ else
+ "no selection" undef status-report drop
+ then
+ else
+ plausible-mark-samples { pts }
+ pts if
+ gen eff_amnt@
+ pts 0 array-ref
+ pts 1 array-ref
+ pts 0 array-ref -
+ #f #f #f normalize-channel drop
+ else
+ "no marks" undef status-report drop
+ then
+ then
+ then
;
: normalize-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init ) gen amount!
- gen sliders@ 0 array-ref gen amount@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init }
+ gen init eff_amnt!
+ gen eff_sliders@ 0 array-ref init 100.0 set-slider-value
;
: normalize-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: post-normalize-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen normalize-ok-cb
- gen label@ $" Normalize scales amplitude to the normalize amount. \
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen normalize-ok-cb
+ gen eff_label@ "\
+Normalize scales amplitude to the normalize amount. \
Move the slider to change the scaling amount." help-cb
- gen normalize-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( "normalize" 0.0 gen amount@ 1.0 gen normalize-slider-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ gen normalize-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "normalize" 0.0 gen eff_amnt@ 1.0
+ gen normalize-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-normalize-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 1.0 gen amount!
- gen post-normalize-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen amount@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1.0 eff_amnt!
+ gen post-normalize-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_amnt@ ) string-format change-label
;
previous
\ === Gate (gate set by gate-amount) ===
hide
-effects-base%
- cell% field omit-silence
-end-struct gate%
-
-: omit-silence@ ( gen -- f ) omit-silence @ ;
-: omit-silence! ( f gen -- ) omit-silence ! ;
-
: gate-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- selected-sound sync { snc }
- snc 0> if
- all-chans each { lst }
- lst 0 array-ref { snd }
- snd sync snc = if
- lst 1 array-ref { chn }
- gen amount@ dup f* gen size@ snd chn effects-squelch-channel drop
- then
- end-each
- else
- gen amount@ dup f* gen size@ #f #f effects-squelch-channel drop
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ selected-sound sync { snc }
+ snc 0> if
+ all-chans each { lst }
+ lst 0 array-ref { snd }
+ snd sync snc = if
+ lst 1 array-ref { chn }
+ gen eff_amnt@ dup f* gen eff_size@
+ snd chn effects-squelch-channel drop
+ then
+ end-each
+ else
+ gen eff_amnt@ dup f* gen eff_size@ #f #f
+ effects-squelch-channel drop
+ then
;
: gate-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init ) gen amount!
- gen sliders@ 0 array-ref gen amount@ 1000.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init }
+ gen init eff_amnt!
+ gen eff_sliders@ 0 array-ref init 1000.0 set-slider-value
;
: gate-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1000.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1000.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
'snd-motif provided? [if]
- : gate-omit-cb <{ w gen info -- }> info Fset gen omit-silence! ;
-
- : post-gate-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen gate-ok-cb
- gen label@ $" Move the slider to change the gate intensity. \
+ : gate-omit-cb <{ w gen info -- }>
+ gen info Fset eff_omit_silence!
+ ;
+
+ : post-gate-dialog ( gen -- prc; w c i self -- )
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen gate-ok-cb gen
+ eff_label@ "\
+Move the slider to change the gate intensity. \
Higher values gate more of the sound." help-cb
- gen gate-reset-cb #f make-effect-dialog gen dialog!
- gen dialog@ #(
- #( "gate" 0.0 gen amount@ 0.1 gen gate-slider-cb 1000 )
- ) add-sliders gen sliders!
- $" Omit silence" FXmStringCreateLocalized { s1 }
- $" Omit silence" FxmToggleButtonWidgetClass gen sliders@ 0 array-ref FXtParent
- #( FXmNbackground basic-color
- FXmNvalue gen omit-silence@ if 1 else 0 then
- FXmNlabelString s1 ) undef FXtCreateManagedWidget ( toggle )
- FXmNvalueChangedCallback <'> gate-omit-cb gen FXtAddCallback drop
- s1 FXmStringFree drop
- then
- gen dialog@ activate-dialog
- ;
+ gen gate-reset-cb #f make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "gate" 0.0 gen eff_amnt@ 0.1
+ gen gate-slider-cb 1000 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ "Omit silence" FXmStringCreateLocalized { s1 }
+ "Omit silence" FxmToggleButtonWidgetClass
+ gen eff_sliders@ 0 array-ref FXtParent
+ #( FXmNbackground basic-color
+ FXmNvalue gen eff_omit_silence@ if 1 else 0 then
+ FXmNlabelString s1 ) undef
+ FXtCreateManagedWidget ( toggle )
+ FXmNvalueChangedCallback <'> gate-omit-cb gen
+ FXtAddCallback drop
+ s1 FXmStringFree drop
+ then
+ gen eff_dialog@ activate-dialog
+ ;
[else]
- : gate-omit-cb <{ w gen -- }>
- w FGTK_TOGGLE_BUTTON Fgtk_toggle_button_get_active gen omit-silence!
- ;
-
- : post-gate-dialog ( gen -- prc; w d self -- )
- 2 proc-create swap , ( prc )
- does> { w d self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen gate-ok-cb
- gen label@ $" Move the slider to change the gate intensity. \
+ : gate-omit-cb <{ w gen -- }>
+ w FGTK_TOGGLE_BUTTON Fgtk_toggle_button_get_active ( sl )
+ gen swap eff_omit_silence!
+ ;
+
+ : post-gate-dialog ( gen -- prc; w d self -- )
+ 2 proc-create swap , ( prc )
+ does> { w d self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen gate-ok-cb gen eff_label@ "
+Move the slider to change the gate intensity. \
Higher values gate more of the sound." help-cb
- gen gate-reset-cb #f make-effect-dialog gen dialog!
- gen dialog@ #(
- #( "gate" 0.0 gen amount@ 0.1 gen gate-slider-cb 1000 )
- ) add-sliders gen sliders!
- $" Omit silence" Fgtk_check_button_new_with_label { toggle }
- gen dialog@ FGTK_DIALOG Fgtk_dialog_get_content_area FGTK_BOX
- toggle #f #f 4 Fgtk_box_pack_start drop
- toggle Fgtk_widget_show drop
- toggle "clicked" <'> gate-omit-cb gen Fg_signal_connect drop
- then
- gen dialog@ activate-dialog
- ;
+ gen gate-reset-cb #f make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "gate" 0.0 gen eff_amnt@ 0.1
+ gen gate-slider-cb 1000 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ "Omit silence" Fgtk_check_button_new_with_label { tog }
+ gen eff_dialog@ FGTK_DIALOG Fgtk_dialog_get_content_area
+ FGTK_BOX tog #f #f 4 Fgtk_box_pack_start drop
+ tog Fgtk_widget_show drop
+ tog "clicked" <'> gate-omit-cb gen
+ Fg_signal_connect drop
+ then
+ gen eff_dialog@ activate-dialog
+ ;
[then]
set-current
: make-gate-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) gate% %alloc make-base-effects { gen }
- 0.01 gen amount!
- 128 gen size!
- #f gen omit-silence!
- gen post-gate-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> ( child self -- prc; self -- )
- { child self }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.4f)" #( gen label@ gen amount@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0.01 eff_amnt!
+ gen 128 eff_size!
+ gen #f eff_omit_silence!
+ gen post-gate-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> ( child self -- prc; self -- )
+ { child self }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.4f)"
+ #( gen eff_label@ gen eff_amnt@ ) string-format change-label
;
previous
@@ -1850,91 +2085,105 @@ previous
hide
: echo-func-cb ( gen -- prc; samps self -- prc; inval self -- res )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- gen delay-time@ #f srate f* f>s make-delay { del }
- 1 proc-create 0 , samps , del , gen , ( prc )
- does> { inval self -- res }
- self @ 1+ dup self ! { samp }
- self 1 cells + @ { samps }
- self 2 cells + @ { del }
- self 3 cells + @ { gen }
- del dup 0.0 tap samp samps <= if inval f+ then gen amount@ f* 0.0 delay inval f+
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ gen eff_delay@ #f srate f* f>s make-delay { del }
+ 1 proc-create 0 , samps , del , gen , ( prc )
+ does> { inval self -- res }
+ self @ 1+ dup self ! { samp }
+ self 1 cells + @ { samps }
+ self 2 cells + @ { del }
+ self 3 cells + @ { gen }
+ del dup 0.0 tap samp samps <= if
+ inval f+
+ then gen eff_amnt@ f* 0.0 delay inval f+
;
: echo-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- "effects-echo"
- $" %s %s %s" #( target 'sound = if #f else samps then gen delay-time@ gen amount@ ) string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-echo"
+ "%s %s %s"
+ #( target 'sound = if
+ #f
+ else
+ samps
+ then gen eff_delay@ gen eff_amnt@ ) string-format
;
: echo-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen echo-func-cb
- gen target@
- gen echo-origin-cb
- gen truncate@ if #f else 4.0 gen delay-time@ f* then map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen echo-func-cb gen eff_target@ gen echo-origin-cb gen eff_trunc@ if
+ #f
+ else
+ 4.0 gen eff_delay@ f*
+ then map-chan-over-target-with-sync
;
: echo-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , gen delay-time@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-echo ) gen amount!
- self 2 cells + @ ( init-delay ) gen delay-time!
- gen sliders@ 0 array-ref gen delay-time@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen amount@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , gen eff_delay@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-echo }
+ self 2 cells + @ { init-delay }
+ gen init-echo eff_amnt!
+ gen init-delay eff_delay!
+ gen eff_sliders@ 0 array-ref init-delay 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-echo 100.0 set-slider-value
;
: echo-delay-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) delay-time!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_delay!
;
: echo-amount-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: post-echo-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen echo-ok-cb
- gen label@ $" The sliders change the delay time and echo amount." help-cb
- gen echo-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" delay time" 0.0 gen delay-time@ 2.0 gen echo-delay-slider-cb 100 )
- #( $" echo amount" 0.0 gen amount@ 1.0 gen echo-amount-slider-cb 100 )
- ) add-sliders gen sliders!
- gen <'> truncate-cb add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen echo-ok-cb gen eff_label@ "\
+The sliders change the delay time and echo amount." help-cb
+ gen echo-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "delay time" 0.0 gen eff_delay@ 2.0
+ gen echo-delay-slider-cb 100 )
+ #( "echo amount" 0.0 gen eff_amnt@ 1.0
+ gen echo-amount-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen <'> truncate-cb add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-echo-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 0.5 gen delay-time!
- 0.2 gen amount!
- gen post-echo-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f)" #( gen label@ gen delay-time@ gen amount@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0.5 eff_delay!
+ gen 0.2 eff_amnt!
+ gen post-echo-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f)"
+ #( gen eff_label@ gen eff_delay@ gen eff_amnt@ )
+ string-format change-label
;
previous
@@ -1942,81 +2191,97 @@ previous
hide
: flecho-func-cb ( gen -- prc; samps self -- prc; inval self -- res )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- :order 4 :xcoeffs vct( 0.125 0.25 0.25 0.125 ) make-fir-filter { flt }
- gen delay-time@ #f srate f* fround->s make-delay { del }
- 1 proc-create 0 , samps , flt , del , gen amount@ , ( prc )
- does> { inval self -- res }
- self @ 1+ dup self ! { samp }
- self 1 cells + @ { samps }
- self 2 cells + @ { flt }
- self 3 cells + @ { del }
- self 4 cells + @ { scl }
- del flt del 0.0 tap samp samps <= if inval f+ then scl f* fir-filter delay inval f+
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ :order 4 :xcoeffs vct( 0.125 0.25 0.25 0.125 ) make-fir-filter { flt }
+ gen eff_delay@ #f srate f* fround->s make-delay { del }
+ 1 proc-create 0 , samps , flt , del , gen eff_amnt@ , ( prc )
+ does> { inval self -- res }
+ self @ 1+ dup self ! { samp }
+ self 1 cells + @ { samps }
+ self 2 cells + @ { flt }
+ self 3 cells + @ { del }
+ self 4 cells + @ { scl }
+ del flt del 0.0 tap samp samps <= if
+ inval f+
+ then scl f* fir-filter delay inval f+
;
: flecho-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- $" effects-flecho"
- $" %s %s %s" #( gen amount@ gen delay-time@ target 'sound = if #f else samps then ) string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-flecho"
+ "%s %s %s"
+ #( gen eff_amnt@
+ gen eff_delay@
+ target 'sound = if
+ #f
+ else
+ samps
+ then ) string-format
;
: flecho-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen flecho-func-cb
- gen target@
- gen flecho-origin-cb
- gen truncate@ if #f else 4.0 gen delay-time@ f* then map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen flecho-func-cb gen eff_target@ gen flecho-origin-cb
+ gen eff_trunc@ if
+ #f
+ else
+ 4.0 gen eff_delay@ f*
+ then map-chan-over-target-with-sync
;
: flecho-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , gen delay-time@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-scaler ) gen amount!
- self 2 cells + @ ( init-delay ) gen delay-time!
- gen sliders@ 0 array-ref gen amount@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen delay-time@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , gen eff_delay@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-scaler }
+ self 2 cells + @ { init-delay }
+ gen init-scaler eff_amnt!
+ gen init-delay eff_delay!
+ gen eff_sliders@ 0 array-ref init-scaler 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-delay 100.0 set-slider-value
;
: post-flecho-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen flecho-ok-cb
- gen label@ $" Move the sliders to set the filter scaler and the delay time in seconds." help-cb
- gen flecho-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" filter scaler" 0.0 gen amount@ 1.0 gen echo-amount-slider-cb 100 )
- #( $" delay time (secs)" 0.0 gen delay-time@ 3.0 gen echo-delay-slider-cb 100 )
- ) add-sliders gen sliders!
- gen <'> truncate-cb add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen flecho-ok-cb gen eff_label@ "\
+Move the sliders to set the filter scaler \
+and the delay time in seconds." help-cb
+ gen flecho-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "filter scaler" 0.0 gen eff_amnt@ 1.0
+ gen echo-amount-slider-cb 100 )
+ #( "delay time (secs)" 0.0 gen eff_delay@ 3.0
+ gen echo-delay-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen <'> truncate-cb add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-flecho-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 0.9 gen delay-time!
- 0.5 gen amount!
- gen post-flecho-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f)" #( gen label@ gen amount@ gen delay-time@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0.9 eff_delay!
+ gen 0.5 eff_amnt!
+ gen post-flecho-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f)"
+ #( gen eff_label@ gen eff_amnt@ gen eff_delay@ )
+ string-format change-label
;
previous
@@ -2024,107 +2289,130 @@ previous
hide
: zecho-func-cb ( gen -- prc; samps self -- prc; inval self -- res )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- gen frequency@ make-oscil { os }
- gen delay-time@ #f srate f* fround->s { len }
- :size len :max-size len gen amplitude@ f>s 1+ + make-delay { del }
- 1 proc-create 0 , samps , os , del , gen scaler@ , gen amplitude@ , ( prc )
- does> { inval self -- res }
- self @ { samp }
- 1 self +! ( samp++ )
- self 1 cells + @ { samps }
- self 2 cells + @ { os }
- self 3 cells + @ { del }
- self 4 cells + @ { scl }
- self 5 cells + @ { amp }
- del ( del-gen )
- del 0.0 tap samp samps < if inval f+ then scl f* ( input )
- os 0.0 0.0 oscil amp f* ( pm )
- delay inval f+
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ gen eff_freq@ make-oscil { os }
+ gen eff_delay@ #f srate f* fround->s { len }
+ :size len :max-size len gen eff_amp@ f>s 1+ + make-delay { del }
+ 1 proc-create ( prc )
+ 0 , samps , os , del , gen eff_scl@ , gen eff_amp@ ,
+ does> { inval self -- res }
+ self @ { samp }
+ 1 self +! ( samp++ )
+ self 1 cells + @ { samps }
+ self 2 cells + @ { os }
+ self 3 cells + @ { del }
+ self 4 cells + @ { scl }
+ self 5 cells + @ { amp }
+ del ( del-gen ) del 0.0 tap samp samps < if
+ inval f+
+ then scl f* ( input ) os 0.0 0.0 oscil amp f* ( pm ) delay inval f+
;
: zecho-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- $" effects-zecho"
- $" %s %s %s %s %s" #( gen scaler@
- gen delay-time@
- gen frequency@
- gen amplitude@
- target 'sound = if #f else samps then ) string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-zecho"
+ "%s %s %s %s %s"
+ #( gen eff_scl@
+ gen eff_delay@
+ gen eff_freq@
+ gen eff_amp@
+ target 'sound = if
+ #f
+ else
+ samps
+ then ) string-format
;
: zecho-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen zecho-func-cb
- gen target@
- gen zecho-origin-cb
- gen truncate@ if #f else 4.0 gen delay-time@ f* then map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen zecho-func-cb gen eff_target@ gen zecho-origin-cb gen eff_trunc@ if
+ #f
+ else
+ 4.0 gen eff_delay@ f*
+ then map-chan-over-target-with-sync
;
: zecho-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen scaler@ , gen delay-time@ , gen frequency@ , gen amplitude@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-scaler ) gen scaler!
- self 2 cells + @ ( init-delay ) gen delay-time!
- self 3 cells + @ ( init-freq ) gen frequency!
- self 4 cells + @ ( init-amp ) gen amplitude!
- gen sliders@ 0 array-ref gen scaler@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen delay-time@ 100.0 set-slider-value
- gen sliders@ 2 array-ref gen frequency@ 100.0 set-slider-value
- gen sliders@ 3 array-ref gen amplitude@ 100.0 set-slider-value
+ 3 proc-create ( prc )
+ gen ,
+ gen eff_scl@ ,
+ gen eff_delay@ ,
+ gen eff_freq@ ,
+ gen eff_amp@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-scaler }
+ self 2 cells + @ { init-delay }
+ self 3 cells + @ { init-freq }
+ self 4 cells + @ { init-amp }
+ gen init-scaler eff_scl!
+ gen init-delay eff_delay!
+ gen init-freq eff_freq!
+ gen init-amp eff_amp!
+ gen eff_sliders@ 0 array-ref init-scaler 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-delay 100.0 set-slider-value
+ gen eff_sliders@ 2 array-ref init-freq 100.0 set-slider-value
+ gen eff_sliders@ 3 array-ref init-amp 100.0 set-slider-value
;
: zecho-del-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) delay-time!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value self { val }
+ @ ( gen ) val eff_delay!
;
: post-zecho-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen zecho-ok-cb
- gen label@ $" Move the sliders to set the echo scaler, \
-the delay time in seconds, the modulation frequency, and the echo amplitude." help-cb
- gen zecho-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" echo scaler" 0.0 gen scaler@ 1.0 gen scaler-slider-cb 100 )
- #( $" delay time (secs)" 0.0 gen delay-time@ 3.0 gen zecho-del-slider-cb 100 )
- #( $" modulatio frequency" 0.0 gen frequency@ 100.0 gen frequency-slider-cb 100 )
- #( $" modulatio amplitude" 0.0 gen amplitude@ 100.0 gen amplitude-slider-cb 100 )
- ) add-sliders gen sliders!
- gen <'> truncate-cb add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen zecho-ok-cb gen eff_label@ "
+Move the sliders to set the echo scaler, \
+the delay time in seconds, the modulation frequency, \
+and the echo amplitude." help-cb gen
+ zecho-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "echo scaler" 0.0 gen eff_scl@ 1.0
+ gen scaler-slider-cb 100 )
+ #( "delay time (secs)" 0.0 gen eff_delay@ 3.0
+ gen zecho-del-slider-cb 100 )
+ #( "modulatio frequency" 0.0 gen eff_freq@ 100.0
+ gen frequency-slider-cb 100 )
+ #( "modulatio amplitude" 0.0 gen eff_amp@ 100.0
+ gen amplitude-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen <'> truncate-cb add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-zecho-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 0.50 gen scaler!
- 0.75 gen delay-time!
- 6.00 gen frequency!
- 10.0 gen amplitude!
- gen post-zecho-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f %.2f %.2f)"
- #( gen label@ gen scaler@ gen delay-time@ gen frequency@ gen amplitude@ ) format change-label
+ ( name ) make-base-effects { gen }
+ gen 0.50 eff_scl!
+ gen 0.75 eff_delay!
+ gen 6.00 eff_freq!
+ gen 10.0 eff_amp!
+ gen post-zecho-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f %.2f %.2f)"
+ #( gen eff_label@
+ gen eff_scl@
+ gen eff_delay@
+ gen eff_freq@
+ gen eff_amp@ ) string-format change-label
;
previous
@@ -2133,168 +2421,172 @@ previous
\ === Butterworth band-pass filter ===
hide
-effects-base%
- cell% field band-pass-bw
-end-struct bp-filter%
-
-: band-pass-bw@ ( gen -- bw ) band-pass-bw @ f>s ;
-: band-pass-bw! ( bw gen -- ) band-pass-bw ! ;
-
: bp-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- gen frequency@ gen band-pass-bw@ make-butter-band-pass { flt }
- gen target@ 'sound = if
- $" %s %s 0 #f effects-bbp" #( gen frequency@ gen band-pass-bw@ ) string-format { origin }
- flt #f #f #f #f origin filter-sound
- else
- gen target@ 'selection = if
- flt #f #f filter-selection
- else
- plausible-mark-samples { pts }
- pts 0 array-ref { bg }
- pts 1 array-ref bg - 1+ { nd }
- $" %s %s %s %s effects-bbp" #( gen frequency@ gen band-pass-bw@ bg nd )
- string-format { origin }
- flt bg nd #f #f #f #f origin clm-channel
- then
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ gen eff_freq@ gen eff_bp_bw@ make-butter-band-pass { flt }
+ gen eff_target@ 'sound = if
+ "%s %s 0 #f effects-bbp"
+ #( gen eff_freq@ gen eff_bp_bw@ )
+ string-format { origin }
+ flt #f #f #f #f origin filter-sound
+ else
+ gen eff_target@ 'selection = if
+ flt #f #f filter-selection
+ else
+ plausible-mark-samples { pts }
+ pts 0 array-ref { bg }
+ pts 1 array-ref bg - 1+ { nd }
+ "%s %s %s %s effects-bbp"
+ #( gen eff_freq@ gen eff_bp_bw@ bg nd )
+ string-format { origin }
+ flt bg nd #f #f #f #f origin clm-channel
+ then
+ then
;
: bp-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen frequency@ , gen band-pass-bw@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-freq ) gen frequency!
- self 2 cells + @ ( init-bw ) gen band-pass-bw!
- gen sliders@ 0 array-ref 20.0 gen frequency@ 22050.0 scale-log->linear 1.0 set-slider-value
- gen sliders@ 1 array-ref gen band-pass-bw@ 1.0 set-slider-value
+ 3 proc-create gen , gen eff_freq@ , gen eff_bp_bw@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-freq }
+ self 2 cells + @ { init-bw }
+ gen init-freq eff_freq!
+ gen init-bw eff_bp_bw!
+ gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0
+ scale-log->linear 1.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-bw 1.0 set-slider-value
;
: bp-bw-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) band-pass-bw!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_bp_bw!
;
: post-band-pass-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> ( w c i self -- )
- { w c info self }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen bp-ok-cb
- gen label@ $" Butterworth band-pass filter. \
+ 3 proc-create swap , ( prc )
+ does> ( w c i self -- )
+ { w c info self }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen bp-ok-cb gen eff_label@ "\
+Butterworth band-pass filter. \
Move the sliders to change the center frequency and bandwidth." help-cb
- gen bp-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" center frequency" 20.0 gen frequency@ 22050.0 gen log-freq-slider-cb 1 'log )
- #( $" bandwidth" 0 gen band-pass-bw@ 1000 gen bp-bw-slider-cb 1 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ gen bp-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "center frequency" 20.0 gen eff_freq@ 22050.0
+ gen log-freq-slider-cb 1 'log )
+ #( "bandwidth" 0 gen eff_bp_bw@ 1000
+ gen bp-bw-slider-cb 1 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-band-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name) bp-filter% %alloc make-base-effects { gen }
- 1000.0 gen frequency!
- 100 gen band-pass-bw!
- gen post-band-pass-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %d)" #( gen label@ gen frequency@ gen band-pass-bw@ ) string-format change-label
+ ( name) make-base-effects { gen }
+ gen 1000.0 eff_freq!
+ gen 100 eff_bp_bw!
+ gen post-band-pass-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %d)"
+ #( gen eff_label@ gen eff_freq@ gen eff_bp_bw@ )
+ string-format change-label
;
previous
\ === Butterworth band-reject (notch) filter ===
hide
-effects-base%
- cell% field notch-bw
-end-struct notch%
-
-: notch-bw@ ( gen -- bw ) notch-bw @ f>s ;
-: notch-bw! ( bw gen -- ) notch-bw ! ;
-
: br-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- gen frequency@ gen notch-bw@ make-butter-band-reject { flt }
- gen target@ 'sound = if
- $" %s %s 0 #f effects-bbr" #( gen frequency@ gen notch-bw@ ) string-format { origin }
- flt #f #f #f #f origin filter-sound
- else
- gen target@ 'selection = if
- flt #f #f filter-selection
- else
- plausible-mark-samples { pts }
- pts 0 array-ref { bg }
- pts 1 array-ref bg - 1+ { nd }
- $" %s %s %s %s effects-bbp" #( gen frequency@ gen notch-bw@ bg nd ) string-format { orig }
- flt bg nd #f #f #f #f orig clm-channel
- then
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ gen eff_freq@ gen eff_notch_bw@ make-butter-band-reject { flt }
+ gen eff_target@ 'sound = if
+ "%s %s 0 #f effects-bbr" #( gen eff_freq@ gen eff_notch_bw@ )
+ string-format { origin }
+ flt #f #f #f #f origin filter-sound
+ else
+ gen eff_target@ 'selection = if
+ flt #f #f filter-selection
+ else
+ plausible-mark-samples { pts }
+ pts 0 array-ref { bg }
+ pts 1 array-ref bg - 1+ { nd }
+ "%s %s %s %s effects-bbp"
+ #( gen eff_freq@ gen eff_notch_bw@ bg nd )
+ string-format { orig }
+ flt bg nd #f #f #f #f orig clm-channel
+ then
+ then
;
: br-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen frequency@ , gen notch-bw@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-freq ) gen frequency!
- self 2 cells + @ ( init-bw ) gen notch-bw!
- gen sliders@ 0 array-ref 20.0 gen frequency@ 22050.0 scale-log->linear 1.0 set-slider-value
- gen sliders@ 1 array-ref gen notch-bw@ 1.0 set-slider-value
+ 3 proc-create gen , gen eff_freq@ , gen eff_notch_bw@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-freq }
+ self 2 cells + @ { init-bw }
+ gen init-freq eff_freq!
+ gen init-bw eff_notch_bw!
+ gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0
+ scale-log->linear 1.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-bw 1.0 set-slider-value
;
: br-bw-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) notch-bw!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_notch_bw!
;
: post-notch-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen br-ok-cb
- gen label@ $" Butterworth band-reject filter. \
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen br-ok-cb gen eff_label@ "\
+Butterworth band-reject filter. \
Move the sliders to change the center frequency and bandwidth." help-cb
- gen br-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" center frequency" 20.0 gen frequency@ 22050.0 gen log-freq-slider-cb 1 'log )
- #( $" bandwidth" 0 gen notch-bw@ 1000 gen br-bw-slider-cb 1 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ gen br-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "center frequency" 20.0 gen eff_freq@ 22050.0
+ gen log-freq-slider-cb 1 'log )
+ #( "bandwidth" 0 gen eff_notch_bw@ 1000
+ gen br-bw-slider-cb 1 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-notch-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) notch% %alloc make-base-effects { gen }
- 100.0 gen frequency!
- 100 gen notch-bw!
- gen post-notch-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %d)" #( gen label@ gen frequency@ gen notch-bw@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 100.0 eff_freq!
+ gen 100 eff_notch_bw!
+ gen post-notch-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %d)"
+ #( gen eff_label@ gen eff_freq@ gen eff_notch_bw@ )
+ string-format change-label
;
previous
@@ -2302,64 +2594,70 @@ previous
hide
: hp-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- gen frequency@ make-butter-high-pass { flt }
- gen target@ 'sound = if
- $" %s 0 #f effects-bhp" gen frequency@ string-format { origin }
- flt #f #f #f #f origin filter-sound
- else
- gen target@ 'selection = if
- flt #f #f filter-selection
- else
- plausible-mark-samples { pts }
- pts 0 array-ref { bg }
- pts 1 array-ref bg - 1+ { nd }
- $" %s %s %s effects-bhp" #( gen frequency@ bg nd ) string-format { origin }
- flt bg nd #f #f #f #f origin clm-channel
- then
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ gen eff_freq@ make-butter-high-pass { flt }
+ gen eff_target@ 'sound = if
+ "%s 0 #f effects-bhp"
+ #( gen eff_freq@ ) string-format { origin }
+ flt #f #f #f #f origin filter-sound
+ else
+ gen eff_target@ 'selection = if
+ flt #f #f filter-selection
+ else
+ plausible-mark-samples { pts }
+ pts 0 array-ref { bg }
+ pts 1 array-ref bg - 1+ { nd }
+ "%s %s %s effects-bhp"
+ #( gen eff_freq@ bg nd )
+ string-format { origin }
+ flt bg nd #f #f #f #f origin clm-channel
+ then
+ then
;
: hp-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen frequency@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init-freq ) gen frequency!
- gen sliders@ 0 array-ref 20.0 gen frequency@ 22050.0 scale-log->linear 1.0 set-slider-value
+ 3 proc-create gen , gen eff_freq@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init-freq }
+ gen init-freq eff_freq!
+ gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0
+ scale-log->linear 1.0 set-slider-value
;
: post-high-pass-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen hp-ok-cb
- gen label@ $" Butterworth high-pass filter. \
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen hp-ok-cb gen eff_label@ "\
+Butterworth high-pass filter. \
Move the slider to change the high-pass cutoff frequency." help-cb
- gen hp-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" high-pass cutoff frequency" 20.0 gen frequency@ 22050.0 gen log-freq-slider-cb 1 'log )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ gen hp-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "high-pass cutoff frequency" 20.0 gen eff_freq@ 22050.0
+ gen log-freq-slider-cb 1 'log ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-high-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 100.0 gen frequency!
- gen post-high-pass-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen frequency@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 100.0 eff_freq!
+ gen post-high-pass-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_freq@ ) string-format change-label
;
previous
@@ -2367,64 +2665,68 @@ previous
hide
: lp-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- gen frequency@ make-butter-low-pass { flt }
- gen target@ 'sound = if
- $" %s 0 #f effects-blp" gen frequency@ string-format { origin }
- flt #f #f #f #f origin filter-sound
- else
- gen target@ 'selection = if
- flt #f #f filter-selection
- else
- plausible-mark-samples { pts }
- pts 0 array-ref { bg }
- pts 1 array-ref bg - 1+ { nd }
- $" %s %s %s effects-blp" #( gen frequency@ bg nd ) string-format { origin }
- flt bg nd #f #f #f #f origin clm-channel
- then
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ gen eff_freq@ make-butter-low-pass { flt }
+ gen eff_target@ 'sound = if
+ "%s 0 #f effects-blp" gen eff_freq@ string-format { origin }
+ flt #f #f #f #f origin filter-sound
+ else
+ gen eff_target@ 'selection = if
+ flt #f #f filter-selection
+ else
+ plausible-mark-samples { pts }
+ pts 0 array-ref { bg }
+ pts 1 array-ref bg - 1+ { nd }
+ "%s %s %s effects-blp"
+ #( gen eff_freq@ bg nd ) string-format { origin }
+ flt bg nd #f #f #f #f origin clm-channel
+ then
+ then
;
: lp-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen frequency@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init-freq ) gen frequency!
- gen sliders@ 0 array-ref 20.0 gen frequency@ 22050.0 scale-log->linear 1.0 set-slider-value
+ 3 proc-create gen , gen eff_freq@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init-freq }
+ gen init-freq eff_freq!
+ gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0
+ scale-log->linear 1.0 set-slider-value
;
: post-low-pass-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen lp-ok-cb
- gen label@ $" Butterworth low-pass filter. \
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen lp-ok-cb gen eff_label@ "\
+Butterworth low-pass filter. \
Move the slider to change the low-pass cutoff frequency." help-cb
- gen lp-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" low-pass cutoff frequency" 20.0 gen frequency@ 22050.0 gen log-freq-slider-cb 1 'log )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ gen lp-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "low-pass cutoff frequency" 20.0 gen eff_freq@ 22050.0
+ gen log-freq-slider-cb 1 'log ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-low-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 1000.0 gen frequency!
- gen post-low-pass-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen frequency@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1000.0 eff_freq!
+ gen post-low-pass-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_freq@ ) string-format change-label
;
previous
@@ -2432,68 +2734,73 @@ previous
hide
: comb-func-cb ( gen -- prc; samps self -- prc )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- gen scaler@ gen size@ comb-filter
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ gen eff_scl@ gen eff_size@ comb-filter
;
: comb-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- $" effects-comb-filter" $" %s %s" #( gen scaler@ gen size@ ) string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-comb-filter"
+ "%s %s" #( gen eff_scl@ gen eff_size@ ) string-format
;
: comb-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen comb-func-cb gen target@ gen comb-origin-cb #f map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen comb-func-cb gen eff_target@ gen comb-origin-cb #f
+ map-chan-over-target-with-sync
;
: comb-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen scaler@ , gen size@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-scaler ) gen scaler!
- self 2 cells + @ ( init-size ) gen size!
- gen sliders@ 0 array-ref gen scaler@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen size@ 1.0 set-slider-value
+ 3 proc-create gen , gen eff_scl@ , gen eff_size@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-scaler }
+ self 2 cells + @ { init-size }
+ gen init-scaler eff_scl!
+ gen init-size eff_size!
+ gen eff_sliders@ 0 array-ref init-scaler 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-size 1.0 set-slider-value
;
: post-comb-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen comb-ok-cb
- gen label@ $" Move the slider to change the comb scaler and size." help-cb
- gen comb-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( "scaler" 0.0 gen scaler@ 1.0 gen scaler-slider-cb 100 )
- #( "size" 0 gen size@ 100 gen size-slider-cb 1 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen comb-ok-cb gen eff_label@ "\
+Move the slider to change the comb scaler and size." help-cb gen comb-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "scaler" 0.0 gen eff_scl@ 1.0
+ gen scaler-slider-cb 100 )
+ #( "size" 0 gen eff_size@ 100
+ gen size-slider-cb 1 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-comb-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 0.1 gen scaler!
- 50 gen size!
- gen post-comb-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %d)" #( gen label@ gen scaler@ gen size@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0.1 eff_scl!
+ gen 50 eff_size!
+ gen post-comb-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %d)"
+ #( gen eff_label@ gen eff_scl@ gen eff_size@ )
+ string-format change-label
;
previous
@@ -2501,163 +2808,166 @@ previous
hide
: cc-func-cb ( gen -- prc; samps self -- prc )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- gen scaler@ gen size@ gen amplitude@ comb-chord
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ gen eff_scl@ gen eff_size@ gen eff_amp@ comb-chord
;
: cc-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- $" effects-comb-chord"
- $" %s %s %s" #( gen scaler@ gen size@ gen amplitude@ ) string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-comb-chord"
+ "%s %s %s" #( gen eff_scl@ gen eff_size@ gen eff_amp@ ) string-format
;
: cc-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen cc-func-cb gen target@ gen cc-origin-cb #f map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen cc-func-cb gen eff_target@ gen cc-origin-cb #f
+ map-chan-over-target-with-sync
;
: cc-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen scaler@ , gen size@ , gen amplitude@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-scaler ) gen scaler!
- self 2 cells + @ ( init-size ) gen size!
- self 3 cells + @ ( init-amp ) gen amplitude!
- gen sliders@ 0 array-ref gen scaler@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen size@ 1.0 set-slider-value
- gen sliders@ 2 array-ref gen amplitude@ 100.0 set-slider-value
+ 3 proc-create ( prc )
+ gen , gen eff_scl@ , gen eff_size@ , gen eff_amp@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-scaler }
+ self 2 cells + @ { init-size }
+ self 3 cells + @ { init-amp }
+ gen init-scaler eff_scl!
+ gen init-size eff_size!
+ gen init-amp eff_amp!
+ gen eff_sliders@ 0 array-ref init-scaler 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-size 1.0 set-slider-value
+ gen eff_sliders@ 2 array-ref init-amp 100.0 set-slider-value
;
: post-cc-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen cc-ok-cb
- gen label@ $" Creates chords by using filters at harmonically related sizes. \
-Move the sliders to set the comb chord parameters." help-cb
- gen cc-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" chord scaler" 0.0 gen scaler@ 1.0 gen scaler-slider-cb 100 )
- #( $" chord size" 0 gen size@ 100 gen size-slider-cb 1 )
- #( $" amplitude" 0.0 gen amplitude@ 1.0 gen amplitude-slider-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen cc-ok-cb gen eff_label@ "\
+Creates chords by using filters at harmonically related sizes. \
+Move the sliders to set the comb chord parameters." help-cb gen cc-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "chord scaler" 0.0 gen eff_scl@ 1.0
+ gen scaler-slider-cb 100 )
+ #( "chord size" 0 gen eff_size@ 100
+ gen size-slider-cb 1 )
+ #( "amplitude" 0.0 gen eff_amp@ 1.0
+ gen amplitude-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-comb-chord-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 0.95 gen scaler!
- 60 gen size!
- 0.3 gen amplitude!
- gen post-cc-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %d %.2f)" #( gen label@ gen scaler@ gen size@ gen amplitude@ )
- string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0.95 eff_scl!
+ gen 60 eff_size!
+ gen 0.3 eff_amp!
+ gen post-cc-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %d %.2f)"
+ #( gen eff_label@ gen eff_scl@ gen eff_size@ gen eff_amp@ )
+ string-format change-label
;
previous
\ === Moog filter ===
hide
-effects-base%
- cell% field moog-resonance
-end-struct moog%
-
-: moog-resonance@ ( gen -- res ) moog-resonance @ ;
-: moog-resonance! ( res gen -- ) moog-resonance ! ;
-
: moog-func-cb ( gen -- prc; samps self -- prc )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- gen frequency@ gen moog-resonance@ moog
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ gen eff_freq@ gen eff_moog_reson@ moog
;
: moog-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- "effects-moog"
- $" %s %s" #( gen frequency@ gen moog-resonance@ ) string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-moog"
+ "%s %s" #( gen eff_freq@ gen eff_moog_reson@ ) string-format
;
: moog-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen moog-func-cb
- gen target@
- gen moog-origin-cb
- #f
- map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen moog-func-cb gen eff_target@ gen moog-origin-cb #f
+ map-chan-over-target-with-sync
;
: moog-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen frequency@ , gen moog-resonance@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-freq ) gen frequency!
- self 2 cells + @ ( init-res ) gen moog-resonance!
- gen sliders@ 0 array-ref 20.0 gen frequency@ 22050.0 scale-log->linear 1.0 set-slider-value
- gen sliders@ 1 array-ref gen moog-resonance@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_freq@ , gen eff_moog_reson@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-freq }
+ self 2 cells + @ { init-res }
+ gen init-freq eff_freq!
+ gen init-res eff_moog_reson!
+ gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0
+ scale-log->linear 1.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-res 100.0 set-slider-value
;
: moog-res-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) moog-resonance!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_moog_reson!
;
: post-moog-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen moog-ok-cb
- gen label@ $" Moog-style 4-pole lowpass filter with 24db/oct rolloff and variable resonance. \
-Move the sliders to set the filter cutoff frequency and resonance." help-cb
- gen moog-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" cutoff frequency" 20.0 gen frequency@ 22050.0 gen log-freq-slider-cb 1 'log )
- #( $" resonanze" 0.0 gen moog-resonance@ 1.0 gen moog-res-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen moog-ok-cb gen eff_label@ "\
+Moog-style 4-pole lowpass filter \
+with 24db/oct rolloff and variable resonance. \
+Move the sliders to set the filter \
+cutoff frequency and resonance." help-cb gen moog-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "cutoff frequency" 20.0 gen eff_freq@ 22050.0
+ gen log-freq-slider-cb 1 'log )
+ #( "resonanze" 0.0 gen eff_moog_reson@ 1.0
+ gen moog-res-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-moog-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) moog% %alloc make-base-effects { gen }
- 10000.0 gen frequency!
- 0.5 gen moog-resonance!
- gen post-moog-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f)" #( gen label@ gen frequency@ gen moog-resonance@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 10000.0 eff_freq!
+ gen 0.5 eff_moog_reson!
+ gen post-moog-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f)"
+ #( gen eff_label@ gen eff_freq@ gen eff_moog_reson@ )
+ string-format change-label
;
previous
@@ -2667,89 +2977,97 @@ previous
hide
: adsat-func-cb ( gen -- prc; samps self -- prc; val self -- res )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- 1 proc-create gen , gen size@ 0.0 make-vct , 0.0 , 0.0 , 0 , ( prc )
- does> { val self -- res }
- self @ { gen }
- self 1 cells + @ { vals }
- self 2 cells + @ { mn }
- self 3 cells + @ { mx }
- self 4 cells + @ { n }
- gen size@ n = if
- vals each { x }
- vals i x f0>= if mx else mn then vct-set! drop
- 0.0 self 2 cells + ! ( mn )
- 0.0 self 3 cells + ! ( mx )
- 0 self 4 cells + ! ( n )
- end-each
- vals
- else
- vals n val vct-set! drop
- val mx f> if val self 3 cells + ! ( mx ) then
- val mn f< if val self 2 cells + ! ( mn ) then
- n 1+ self 4 cells + ! ( n++ )
- #f
- then
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ 1 proc-create ( prc )
+ gen , gen eff_size@ 0.0 make-vct , 0.0 , 0.0 , 0 ,
+ does> { val self -- res }
+ self @ { gen }
+ self 1 cells + @ { vals }
+ self 2 cells + @ { mn }
+ self 3 cells + @ { mx }
+ self 4 cells + @ { n }
+ gen eff_size@ n = if
+ vals each { x }
+ vals i x f0>= if
+ mx
+ else
+ mn
+ then vct-set! drop
+ 0.0 self 2 cells + ! ( mn )
+ 0.0 self 3 cells + ! ( mx )
+ 0 self 4 cells + ! ( n )
+ end-each
+ vals
+ else
+ vals n val vct-set! drop
+ val mx f> if
+ val self 3 cells + ! ( mx )
+ then
+ val mn f< if
+ val self 2 cells + ! ( mn )
+ then
+ n 1+ self 4 cells + ! ( n++ )
+ #f
+ then
;
: adsat-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- "adsat"
- gen size@ number->string
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "adsat"
+ gen eff_size@ number->string
;
: adsat-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen adsat-func-cb
- gen target@
- gen adsat-origin-cb
- #f
- map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen adsat-func-cb gen eff_target@ gen adsat-origin-cb #f
+ map-chan-over-target-with-sync
;
: adsat-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen size@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init-size ) gen size!
- gen sliders@ 0 array-ref gen size@ 1.0 set-slider-value
+ 3 proc-create gen , gen eff_size@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init-size }
+ gen init-size eff_size!
+ gen eff_sliders@ 0 array-ref init-size 1.0 set-slider-value
;
: post-adsat-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen adsat-ok-cb
- gen label@ $" Move the slider to change the saturation scaling factor." help-cb
- gen adsat-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" adaptive saturation size" 0 gen size@ 10 gen size-slider-cb 1 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen adsat-ok-cb gen eff_label@ "\
+Move the slider to change the saturation scaling factor." help-cb
+ gen adsat-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "adaptive saturation size" 0 gen eff_size@ 10
+ gen size-slider-cb 1 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-adsat-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 4 gen size!
- gen post-adsat-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%d)" #( gen label@ gen size@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 4 eff_size!
+ gen post-adsat-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%d)"
+ #( gen eff_label@ gen eff_size@ ) string-format change-label
;
previous
@@ -2757,215 +3075,218 @@ previous
hide
: src-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- gen target@ 'sound = if
- gen amount@ 1.0 undef undef undef src-sound
- else
- gen target@ 'selection = if
- undef selection? if
- gen amount@ 1.0 src-selection
- else
- $" no selection" snd-warning
- then
- else
- $" can't apply src between marks yet" snd-warning
- then
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ gen eff_target@ 'sound = if
+ gen eff_amnt@ 1.0 undef undef undef src-sound
+ else
+ gen eff_target@ 'selection = if
+ undef selection? if
+ gen eff_amnt@ 1.0 src-selection
+ else
+ "no selection" undef status-report
+ then
+ else
+ "can't apply src between marks yet" undef status-report
+ then
+ then
;
: src-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init-amount ) gen amount!
- gen sliders@ 0 array-ref gen amount@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init-amount }
+ gen init-amount eff_amnt!
+ gen eff_sliders@ 0 array-ref init-amount 100.0 set-slider-value
;
: src-amount-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: post-src-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen src-ok-cb
- gen label@ $" Move the slider to change the sample rate. \
-Values greater than 1.0 speed up file play, negative values reverse it." help-cb
- gen src-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" sample rate" -2.0 gen amount@ 2.0 gen src-amount-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen src-ok-cb gen eff_label@ "\
+Move the slider to change the sample rate. \
+Values greater than 1.0 speed up file play, \
+negative values reverse it." help-cb gen src-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "sample rate" -2.0 gen eff_amnt@ 2.0
+ gen src-amount-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-src-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 0.0 gen amount!
- gen post-src-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen amount@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0.0 eff_amnt!
+ gen post-src-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_amnt@ ) string-format change-label
;
previous
-\ === Time and pitch scaling by granular synthesis and sampling rate conversion ===
+\ === Time and pitch scaling by granular synthesis and sampling rate conversion
hide
-effects-base%
- cell% field time-scale
- cell% field hop-size
- cell% field ramp-scale
- cell% field pitch-scale
- cell% field segment-length
-end-struct expsrc%
-
-: time-scale@ ( gen -- scl ) time-scale @ ;
-: time-scale! ( scl gen -- ) time-scale ! ;
-: hop-size@ ( gen -- siz ) hop-size @ ;
-: hop-size! ( siz gen -- ) hop-size ! ;
-: ramp-scale@ ( gen -- scl ) ramp-scale @ ;
-: ramp-scale! ( scl gen -- ) ramp-scale ! ;
-: pitch-scale@ ( gen -- scl ) pitch-scale @ ;
-: pitch-scale! ( scl gen -- ) pitch-scale ! ;
-: segment-length@ ( gen -- len ) segment-length @ ;
-: segment-length! ( len gen -- ) segment-length ! ;
-
: expsrc-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- selected-sound { snd }
- snd save-controls drop
- snd reset-controls drop
- gen pitch-scale@ snd set-speed-control drop
- gen pitch-scale@ gen time-scale@ f* { new-time }
- new-time 1.0 f<> if
- #t snd set-expand-control? drop
- new-time snd set-expand-control drop
- gen hop-size@ snd set-expand-control-hop drop
- gen segment-length@ snd set-expand-control-length drop
- gen ramp-scale@ snd set-expand-control-ramp drop
- then
- gen target@ 'marks = if
- plausible-mark-samples { pts }
- pts if
- snd 0
- pts 0 array-ref
- pts 1 array-ref
- pts 0 array-ref - 1+ apply-controls drop
- else
- $" no marks" snd-warning drop
- then
- else
- snd gen target@ 'sound = if 0 else 2 then undef undef apply-controls drop
- then
- snd restore-controls
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ selected-sound { snd }
+ snd save-controls drop
+ snd reset-controls drop
+ gen eff_pitch_scl@ snd set-speed-control drop
+ gen eff_pitch_scl@ gen eff_time_scale@ f* { new-time }
+ new-time 1.0 f<> if
+ #t snd set-expand-control? drop
+ new-time snd set-expand-control drop
+ gen eff_hop_size@ snd set-expand-control-hop drop
+ gen eff_seg_len@ snd set-expand-control-length drop
+ gen eff_ramp_scl@ snd set-expand-control-ramp drop
+ then
+ gen eff_target@ 'marks = if
+ plausible-mark-samples { pts }
+ pts if
+ snd 0
+ pts 0 array-ref
+ pts 1 array-ref
+ pts 0 array-ref - 1+ apply-controls
+ else
+ "no marks" undef status-report
+ then
+ else
+ snd gen eff_target@ 'sound = if
+ 0
+ else
+ 2
+ then undef undef apply-controls
+ then drop
+ snd restore-controls
;
: expsrc-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create
- gen ,
- gen time-scale@ ,
- gen hop-size@ ,
- gen segment-length@ ,
- gen ramp-scale@ ,
- gen pitch-scale@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-time-scale ) gen time-scale!
- self 2 cells + @ ( init-size ) gen hop-size!
- self 3 cells + @ ( init-seg-len ) gen segment-length!
- self 4 cells + @ ( init-ramp-scale ) gen ramp-scale!
- self 5 cells + @ ( init-pitch-scale ) gen pitch-scale!
- gen sliders@ 0 array-ref gen time-scale@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen hop-size@ 100.0 set-slider-value
- gen sliders@ 2 array-ref gen segment-length@ 100.0 set-slider-value
- gen sliders@ 3 array-ref gen ramp-scale@ 100.0 set-slider-value
- gen sliders@ 4 array-ref gen pitch-scale@ 100.0 set-slider-value
+ 3 proc-create ( prc )
+ gen ,
+ gen eff_time_scale@ ,
+ gen eff_hop_size@ ,
+ gen eff_seg_len@ ,
+ gen eff_ramp_scl@ ,
+ gen eff_pitch_scl@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-time-scale }
+ self 2 cells + @ { init-size }
+ self 3 cells + @ { init-seg-len }
+ self 4 cells + @ { init-ramp-scale }
+ self 5 cells + @ { init-pitch-scale }
+ gen init-time-scale eff_time_scale!
+ gen init-size eff_hop_size!
+ gen init-seg-len eff_seg_len!
+ gen init-ramp-scale eff_ramp_scl!
+ gen init-pitch-scale eff_pitch_scl!
+ gen eff_sliders@ 0 array-ref gen init-time-scale 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref gen init-size 100.0 set-slider-value
+ gen eff_sliders@ 2 array-ref gen init-seg-len 100.0 set-slider-value
+ gen eff_sliders@ 3 array-ref gen init-ramp-scale 100.0 set-slider-value
+ gen eff_sliders@ 4 array-ref gen init-pitch-scale 100.0 set-slider-value
;
: expsrc-ts-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) time-scale!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_time_scale!
;
: expsrc-hs-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) hop-size!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_hop_size!
;
: expsrc-sl-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) segment-length!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_seg_len!
;
: expsrc-rs-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) ramp-scale!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_ramp_scl!
;
: expsrc-ps-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) pitch-scale!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_pitch_scl!
;
: post-expsrc-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen expsrc-ok-cb
- gen label@ $" Move the slider to change the time/pitch scaling parameter." help-cb
- gen expsrc-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" time scale" 0.0 gen time-scale@ 5.0 gen expsrc-ts-cb 100 )
- #( $" hop size" 0.0 gen hop-size@ 1.0 gen expsrc-hs-cb 100 )
- #( $" segment-length" 0.0 gen segment-length@ 0.5 gen expsrc-sl-cb 100 )
- #( $" ramp scale" 0.0 gen ramp-scale@ 0.5 gen expsrc-rs-cb 100 )
- #( $" pitch scale" 0.0 gen pitch-scale@ 5.0 gen expsrc-ps-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen expsrc-ok-cb gen eff_label@ "\
+Move the slider to change the time/pitch scaling parameter." help-cb
+ gen expsrc-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "time scale" 0.0 gen eff_time_scale@ 5.0
+ gen expsrc-ts-cb 100 )
+ #( "hop size" 0.0 gen eff_hop_size@ 1.0
+ gen expsrc-hs-cb 100 )
+ #( "segment-length" 0.0 gen eff_seg_len@ 0.5
+ gen expsrc-sl-cb 100 )
+ #( "ramp scale" 0.0 gen eff_ramp_scl@ 0.5
+ gen expsrc-rs-cb 100 )
+ #( "pitch scale" 0.0 gen eff_pitch_scl@ 5.0
+ gen expsrc-ps-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-expsrc-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) expsrc% %alloc make-base-effects { gen }
- 1.00 gen time-scale!
- 0.05 gen hop-size!
- 0.15 gen segment-length!
- 0.50 gen ramp-scale!
- 1.00 gen pitch-scale!
- gen post-expsrc-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f)" #( gen label@ gen time-scale@ gen pitch-scale@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1.00 eff_time_scale!
+ gen 0.05 eff_hop_size!
+ gen 0.15 eff_seg_len!
+ gen 0.50 eff_ramp_scl!
+ gen 1.00 eff_pitch_scl!
+ gen post-expsrc-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f)"
+ #( gen eff_label@ gen eff_time_scale@ gen eff_pitch_scl@ )
+ string-format change-label
;
previous
@@ -2974,73 +3295,75 @@ previous
hide
: src-timevar-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen envel@ xe-envelope gen scaler@ scale-envelope { en }
- gen target@ 'sound = if
- en 1.0 #f #f #f src-sound drop
- else
- gen target@ 'selection = if
- selected-sound #f selection-member? if
- en 1.0 src-selection drop
- else
- $" no selection" snd-warning drop
- then
- else
- plausible-mark-samples { pts }
- pts if
- pts 0 array-ref { beg }
- pts 1 array-ref { end }
- end beg - { len }
- :envelope en :length len make-env beg len selected-sound #f #f src-channel drop
- else
- $" no marks" snd-warning drop
- then
- then
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_enved@ xe-envelope gen eff_scl@ scale-envelope { en }
+ gen eff_target@ 'sound = if
+ en 1.0 #f #f #f src-sound drop
+ else
+ gen eff_target@ 'selection = if
+ selected-sound #f selection-member? if
+ en 1.0 src-selection drop
+ else
+ "no selection" undef status-report drop
+ then
+ else
+ plausible-mark-samples { pts }
+ pts if
+ pts 0 array-ref { beg }
+ pts 1 array-ref { end }
+ end beg - { len }
+ :envelope en :length len make-env beg len
+ selected-sound #f #f src-channel drop
+ else
+ "no marks" undef status-report drop
+ then
+ then
+ then
;
: src-timevar-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen scaler@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init ) gen scaler!
- gen envel@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
- gen sliders@ 0 array-ref gen scaler@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_scl@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init }
+ gen init eff_scl!
+ gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
+ gen eff_sliders@ 0 array-ref init 100.0 set-slider-value
;
: post-src-timevar-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen src-timevar-ok-cb
- gen label@ $" Move the slider to change the src-timevar scaling amount." help-cb
- gen src-timevar-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" Resample factor" 0.0 gen scaler@ 10.0 gen scaler-slider-cb 100 )
- ) add-sliders gen sliders!
- gen make-enved-widget
- else
- gen dialog@ activate-dialog
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen src-timevar-ok-cb gen eff_label@ "\
+Move the slider to change the src-timevar scaling amount." help-cb
+ gen src-timevar-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "Resample factor" 0.0 gen eff_scl@ 10.0
+ gen scaler-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen make-enved-widget
+ else
+ gen eff_dialog@ activate-dialog
+ then
;
set-current
: make-src-timevar-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 1.0 gen scaler!
- #f gen envel!
- gen post-src-timevar-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" Time-varying sample rate scaling" change-label
+ ( name ) make-base-effects { gen }
+ gen 1.0 eff_scl!
+ gen #f eff_enved!
+ gen post-src-timevar-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "Time-varying sample rate scaling" change-label
;
previous
@@ -3050,85 +3373,94 @@ previous
hide
: am-func-cb ( gen -- prc; samps self -- prc )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- gen amount@ make-oscil { os }
- gen envel@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if
- #f
- else
- :envelope gen envel@ xe-envelope :length gen target@ effect-frames 1- make-env
- then { e }
- e if os e effects-am-env-cb else os effects-am-cb then
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ gen eff_amnt@ make-oscil { os }
+ gen eff_enved@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if
+ #f
+ else
+ :envelope gen eff_enved@ xe-envelope :length gen eff_target@
+ effect-frames 1- make-env
+ then { e }
+ e if
+ os e effects-am-env-cb
+ else
+ os effects-am-cb
+ then
;
: am-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- "effects-am"
- $" %s %s" #( gen amount@
- gen envel@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if #f else gen envel@ xe-envelope then )
- string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-am"
+ "%s %s"
+ #( gen eff_amnt@
+ gen eff_enved@
+ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if
+ #f
+ else
+ gen eff_enved@ xe-envelope
+ then ) string-format
;
: am-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen am-func-cb
- gen target@
- gen am-origin-cb
- #f
- map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen am-func-cb gen eff_target@ gen am-origin-cb #f
+ map-chan-over-target-with-sync
;
: am-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self cell+ @ ( init ) gen amount!
- gen envel@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
- gen sliders@ 0 array-ref gen amount@ 1.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self cell+ @ { init }
+ gen init eff_amnt!
+ gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
+ gen eff_sliders@ 0 array-ref init 1.0 set-slider-value
;
: am-slider-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: post-am-effect-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen am-ok-cb
- gen label@ $" Move the slider to change the modulation amount." help-cb
- gen am-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" amplitude modulation" 0.0 gen amount@ 1000.0 gen am-slider-cb 1 )
- ) add-sliders gen sliders!
- gen make-enved-widget
- else
- gen dialog@ activate-dialog
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen am-ok-cb gen eff_label@ "\
+Move the slider to change the modulation amount." help-cb gen am-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "amplitude modulation" 0.0 gen eff_amnt@ 1000.0
+ gen am-slider-cb 1 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen make-enved-widget
+ else
+ gen eff_dialog@ activate-dialog
+ then
;
set-current
: make-am-effect-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 100.0 gen amount!
- #f gen envel!
- gen post-am-effect-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen amount@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 100.0 eff_amnt!
+ gen #f eff_enved!
+ gen post-am-effect-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_amnt@ ) string-format change-label
;
previous
@@ -3136,96 +3468,108 @@ previous
hide
: rm-func-cb ( gen -- prc; samps self -- prc )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- gen frequency@ make-oscil { os }
- gen envel@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if
- #f
- else
- :envelope gen envel@ xe-envelope :length gen target@ effect-frames 1- make-env
- then { e }
- e if os e effects-rm-env-cb else os effects-rm-cb then
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ gen eff_freq@ make-oscil { os }
+ gen eff_enved@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if
+ #f
+ else
+ :envelope gen eff_enved@ xe-envelope
+ :length gen eff_target@ effect-frames 1- make-env
+ then { e }
+ e if
+ os e effects-rm-env-cb
+ else
+ os effects-rm-cb
+ then
;
: rm-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- "effects-rm"
- $" %s %s" #( gen frequency@
- gen envel@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if #f else gen envel@ xe-envelope then )
- string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-rm"
+ "%s %s"
+ #( gen eff_freq@
+ gen eff_enved@
+ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if
+ #f
+ else
+ gen eff_enved@ xe-envelope
+ then ) string-format
;
: rm-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen rm-func-cb
- gen target@
- gen rm-origin-cb
- #f
- map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen rm-func-cb gen eff_target@ gen rm-origin-cb #f
+ map-chan-over-target-with-sync
;
: rm-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen frequency@ , gen scaler@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-freq ) gen frequency!
- self 2 cells + @ ( init-radians ) gen scaler!
- gen envel@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
- gen sliders@ 0 array-ref gen frequency@ 1.0 set-slider-value
- gen sliders@ 1 array-ref gen scaler@ 1.0 set-slider-value
+ 3 proc-create gen , gen eff_freq@ , gen eff_scl@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-freq }
+ self 2 cells + @ { init-radians }
+ gen init-freq eff_freq!
+ gen init-radians eff_scl!
+ gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
+ gen eff_sliders@ 0 array-ref init-freq 1.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-radians 1.0 set-slider-value
;
: rm-freq-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) frequency!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_freq!
;
: rm-radians-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) scaler!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_scl!
;
: post-rm-effect-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen rm-ok-cb
- gen label@ $" Move the slider to change ring modulation parameters." help-cb
- gen rm-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" modulation frequency" 0 gen frequency@ 1000 gen rm-freq-cb 1 )
- #( $" modulation radians" 0 gen scaler@ 360 gen rm-radians-cb 1 )
- ) add-sliders gen sliders!
- gen make-enved-widget
- else
- gen dialog@ activate-dialog
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen rm-ok-cb gen eff_label@ "\
+Move the slider to change ring modulation parameters." help-cb gen rm-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "modulation frequency" 0 gen eff_freq@ 1000
+ gen rm-freq-cb 1 )
+ #( "modulation radians" 0 gen eff_scl@ 360
+ gen rm-radians-cb 1 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen make-enved-widget
+ else
+ gen eff_dialog@ activate-dialog
+ then
;
set-current
: make-rm-effect-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 100.0 gen frequency!
- 100.0 gen scaler!
- #f gen envel!
- gen post-rm-effect-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f)" #( gen label@ gen frequency@ gen scaler@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 100.0 eff_freq!
+ gen 100.0 eff_scl!
+ gen #f eff_enved!
+ gen post-rm-effect-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f)"
+ #( gen eff_label@ gen eff_freq@ gen eff_scl@ )
+ string-format change-label
;
previous
@@ -3234,272 +3578,269 @@ previous
\ === Reverb from Michael McNabb's Nrev ===
hide
-effects-base%
- cell% field reverb-filter
- cell% field reverb-feedback
-end-struct nrev-reverb%
-
-: reverb-filter@ ( gen -- val ) reverb-filter @ ;
-: reverb-filter! ( val gen -- ) reverb-filter ! ;
-: reverb-feedback@ ( gen -- val ) reverb-feedback @ ;
-: reverb-feedback! ( val gen -- ) reverb-feedback ! ;
-
: nrev-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- selected-sound { snd }
- snd save-controls drop
- snd reset-controls drop
- #t snd set-reverb-control? drop
- gen amount@ snd set-reverb-control-scale drop
- gen reverb-filter@ snd set-reverb-control-lowpass drop
- gen reverb-feedback@ snd set-reverb-control-feedback drop
- gen target@ 'marks = if
- plausible-mark-samples { pts }
- pts array? if
- snd 0
- pts 0 array-ref
- pts 1 array-ref
- pts 0 array-ref - 1+ apply-controls drop
- else
- $" no marks" snd-warning drop
- then
- else
- snd gen target@ 'sound = if 0 else 2 then undef undef apply-controls drop
- then
- snd restore-controls
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ selected-sound { snd }
+ snd save-controls drop
+ snd reset-controls drop
+ #t snd set-reverb-control? drop
+ gen eff_amnt@ snd set-reverb-control-scale drop
+ gen eff_rev_filter@ snd set-reverb-control-lowpass drop
+ gen eff_rev_fb@ snd set-reverb-control-feedback drop
+ gen eff_target@ 'marks = if
+ plausible-mark-samples { pts }
+ pts array? if
+ snd 0
+ pts 0 array-ref
+ pts 1 array-ref
+ pts 0 array-ref - 1+ apply-controls drop
+ else
+ "no marks" undef status-report drop
+ then
+ else
+ snd gen eff_target@ 'sound = if
+ 0
+ else
+ 2
+ then undef undef apply-controls drop
+ then
+ snd restore-controls
;
: nrev-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , gen reverb-filter@ , gen reverb-feedback@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-amount ) gen amount!
- self 2 cells + @ ( init-filter ) gen reverb-filter!
- self 3 cells + @ ( init-feedback ) gen reverb-feedback!
- gen sliders@ 0 array-ref gen amount@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen reverb-filter@ 100.0 set-slider-value
- gen sliders@ 2 array-ref gen reverb-feedback@ 100.0 set-slider-value
+ 3 proc-create ( prc )
+ gen , gen eff_amnt@ , gen eff_rev_filter@ , gen eff_rev_fb@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-amount }
+ self 2 cells + @ { init-filter }
+ self 3 cells + @ { init-feedback }
+ gen init-amount eff_amnt!
+ gen init-filter eff_rev_filter!
+ gen init-feedback eff_rev_fb!
+ gen eff_sliders@ 0 array-ref init-amount 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-filter 100.0 set-slider-value
+ gen eff_sliders@ 2 array-ref init-feedback 100.0 set-slider-value
;
: nrev-amount-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: nrev-filter-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) reverb-filter!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_rev_filter!
;
: nrev-feedback-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) reverb-feedback!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_rev_fb!
;
: post-reverb-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen nrev-ok-cb
- gen label@ $" Reverberator from Michael McNabb. \
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen nrev-ok-cb gen eff_label@ "\
+Reverberator from Michael McNabb. \
Adds reverberation scaled by reverb amount, lowpass filtering, and feedback. \
-Move the sliders to change the reverb parameters." help-cb
- gen nrev-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" reverb amount" 0.0 gen amount@ 1.00 gen nrev-amount-cb 100 )
- #( $" reverb filter" 0.0 gen reverb-filter@ 1.00 gen nrev-filter-cb 100 )
- #( $" reverb feedback" 0.0 gen reverb-feedback@ 1.25 gen nrev-feedback-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+Move the sliders to change the reverb parameters." help-cb gen nrev-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "reverb amount" 0.0 gen eff_amnt@ 1.00
+ gen nrev-amount-cb 100 )
+ #( "reverb filter" 0.0 gen eff_rev_filter@ 1.00
+ gen nrev-filter-cb 100 )
+ #( "reverb feedback" 0.0 gen eff_rev_fb@ 1.25
+ gen nrev-feedback-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-reverb-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) nrev-reverb% %alloc make-base-effects { gen }
- 0.10 gen amount!
- 0.50 gen reverb-filter!
- 1.09 gen reverb-feedback!
- gen post-reverb-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f %.2f)"
- #( gen label@ gen amount@ gen reverb-filter@ gen reverb-feedback@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0.10 eff_amnt!
+ gen 0.50 eff_rev_filter!
+ gen 1.09 eff_rev_fb!
+ gen post-reverb-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f %.2f)"
+ #( gen eff_label@
+ gen eff_amnt@
+ gen eff_rev_filter@
+ gen eff_rev_fb@ ) string-format change-label
;
previous
\ === Chowning reverb ===
hide
-effects-base%
- cell% field jc-reverb-decay
- cell% field jc-reverb-volume
-end-struct jc-reverb%
-
-: jc-reverb-decay@ ( gen -- val ) jc-reverb-decay @ ;
-: jc-reverb-decay! ( val gen -- ) jc-reverb-decay ! ;
-: jc-reverb-volume@ ( gen -- val ) jc-reverb-volume @ ;
-: jc-reverb-volume! ( val gen -- ) jc-reverb-volume ! ;
-
: jc-func-cb ( gen -- prc; samps self -- prc )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- samps gen jc-reverb-volume@ effects-jc-reverb
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ samps gen eff_rev_vol@ effects-jc-reverb
;
: jc-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- "effects-jc-reverb-1"
- gen jc-reverb-volume@ number->string
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-jc-reverb-1"
+ gen eff_rev_vol@ number->string
;
: jc-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen jc-func-cb
- gen target@
- gen jc-origin-cb
- gen truncate@ if #f else gen jc-reverb-decay@ then map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen jc-func-cb gen eff_target@ gen jc-origin-cb gen eff_trunc@ if
+ #f
+ else
+ gen eff_rev_decay@
+ then map-chan-over-target-with-sync
;
: jc-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen jc-reverb-decay@ , gen jc-reverb-volume@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-decay ) gen jc-reverb-decay!
- self 2 cells + @ ( init-volume ) gen jc-reverb-volume!
- gen sliders@ 0 array-ref gen jc-reverb-decay@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen jc-reverb-volume@ 100.0 set-slider-value
+ 3 proc-create ( prc )
+ gen , gen eff_rev_decay@ , gen eff_rev_vol@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-decay }
+ self 2 cells + @ { init-volume }
+ gen init-decay eff_rev_decay!
+ gen init-volume eff_rev_vol!
+ gen eff_sliders@ 0 array-ref init-decay 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-volume 100.0 set-slider-value
;
: jc-decay-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) jc-reverb-decay!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_rev_decay!
;
: jc-volume-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) jc-reverb-volume!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_rev_vol!
;
: post-jc-reverb-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen jc-ok-cb
- gen label@ $" Nice reverb from John Chowning. \
-Move the sliders to set the reverb parameters." help-cb
- gen jc-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" decay duration" 0.0 gen jc-reverb-decay@ 10.0 gen jc-decay-cb 100 )
- #( $" reverb volume" 0.0 gen jc-reverb-volume@ 1.00 gen jc-volume-cb 100 )
- ) add-sliders gen sliders!
- gen <'> truncate-cb add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen jc-ok-cb gen eff_label@ "\
+Nice reverb from John Chowning. \
+Move the sliders to set the reverb parameters." help-cb gen jc-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "decay duration" 0.0 gen eff_rev_decay@ 10.0
+ gen jc-decay-cb 100 )
+ #( "reverb volume" 0.0 gen eff_rev_vol@ 1.00
+ gen jc-volume-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen <'> truncate-cb add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-jc-reverb-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) jc-reverb% %alloc make-base-effects { gen }
- 2.0 gen jc-reverb-decay!
- 0.1 gen jc-reverb-volume!
- gen post-jc-reverb-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f)" #( gen label@ gen jc-reverb-decay@ gen jc-reverb-volume@ ) string-format
- change-label
+ ( name ) make-base-effects { gen }
+ gen 2.0 eff_rev_decay!
+ gen 0.1 eff_rev_vol!
+ gen post-jc-reverb-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f)"
+ #( gen eff_label@ gen eff_rev_decay@ gen eff_rev_vol@ )
+ string-format change-label
;
previous
\ === Convolution ===
hide
-effects-base%
- cell% field convolve-one
- cell% field convolve-two
-end-struct effects-convolve%
-
-: convolve-one@ ( gen -- snd ) convolve-one @ f>s ;
-: convolve-one! ( snd gen -- ) convolve-one ! ;
-: convolve-two@ ( gen -- snd ) convolve-two @ f>s ;
-: convolve-two! ( snd gen -- ) convolve-two ! ;
-
: cnv-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- gen convolve-one@ { snd1 }
- gen convolve-two@ { snd2 }
- snd1 sound? if
- snd2 sound? if
- snd1 gen amplitude@ snd2 #f effects-cnv
- else
- $" no such sound two: %S" #( snd2 ) string-format snd-warning
- then
- else
- $" no such sound one: %S" #( snd1 ) string-format snd-warning
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ gen eff_conv_one@ { snd1 }
+ gen eff_conv_two@ { snd2 }
+ snd1 sound? if
+ snd2 sound? if
+ snd1 gen eff_amp@ snd2 #f effects-cnv
+ else
+ "no such sound two: %S" #( snd2 )
+ string-format undef status-report
+ then
+ else
+ "no such sound one: %S"
+ #( snd1 ) string-format undef status-report
+ then
;
: cnv-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen convolve-one@ , gen convolve-two@ , gen amplitude@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-one ) gen convolve-one!
- self 2 cells + @ ( init-two ) gen convolve-two!
- self 3 cells + @ ( init-amp ) gen amplitude!
- gen sliders@ 0 array-ref gen convolve-one@ 1.0 set-slider-value
- gen sliders@ 1 array-ref gen convolve-two@ 1.0 set-slider-value
- gen sliders@ 2 array-ref gen amplitude@ 100.0 set-slider-value
+ 3 proc-create ( prc )
+ gen , gen eff_conv_one@ , gen eff_conv_two@ , gen eff_amp@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-one }
+ self 2 cells + @ { init-two }
+ self 3 cells + @ { init-amp }
+ gen init-one eff_conv_one!
+ gen init-two eff_conv_two!
+ gen init-amp eff_amp!
+ gen eff_sliders@ 0 array-ref init-one 1.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-two 1.0 set-slider-value
+ gen eff_sliders@ 2 array-ref init-amp 100.0 set-slider-value
;
: cnv-one-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) convolve-one!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_conv_one!
;
: cnv-two-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) convolve-two!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_conv_two!
;
: post-convolve-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen cnv-ok-cb
- gen label@ $" Very simple convolution. \
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen cnv-ok-cb gen eff_label@ "\
+Very simple convolution. \
Move the sliders to set the reverb parameters the numbers of the soundfiles \
to be convolved and the amount for the amplitude scaler. \
Output will be scaled to floating-point values, \
@@ -3508,32 +3849,35 @@ Use the Normalize amplitude effect to rescale the output. \
The convolution data file typically defines a natural reverberation source, \
and the output from this effect can provide very striking reverb effects. \
You can find convolution data files on sites listed at \
-http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data." help-cb
- gen cnv-reset-cb #f make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" impulse response file" 0 gen convolve-one@ 24 gen cnv-one-cb 1 )
- #( $" sound file" 0 gen convolve-two@ 24 gen cnv-two-cb 1 )
- #( $" amplitude" 0.0 gen amplitude@ 0.10 gen amplitude-slider-cb 100 )
- ) add-sliders gen sliders!
- then
- gen dialog@ activate-dialog
+http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data."
+ help-cb gen cnv-reset-cb #f make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "impulse response file" 0 gen eff_conv_one@ 24
+ gen cnv-one-cb 1 )
+ #( "sound file" 0 gen eff_conv_two@ 24
+ gen cnv-two-cb 1 )
+ #( "amplitude" 0.0 gen eff_amp@ 0.10
+ gen amplitude-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-convolve-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-convolve% %alloc make-base-effects { gen }
- 0 gen convolve-one!
- 1 gen convolve-two!
- 0.01 gen amplitude!
- gen post-convolve-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%d %d %.2f)"
- #( gen label@ gen convolve-one@ gen convolve-two@ gen amplitude@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0 eff_conv_one!
+ gen 1 eff_conv_two!
+ gen 0.01 eff_amp!
+ gen post-convolve-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%d %d %.2f)"
+ #( gen eff_label@ gen eff_conv_one@ gen eff_conv_two@ gen eff_amp@ )
+ string-format change-label
;
previous
@@ -3542,98 +3886,93 @@ previous
\ === Place sound ===
hide
-effects-base%
- cell% field mono-snd
- cell% field stereo-snd
- cell% field pan-pos
-end-struct effects-place-sound%
-
-: mono-snd@ ( gen -- snd ) mono-snd @ f>s ;
-: mono-snd! ( snd gen -- ) mono-snd ! ;
-: stereo-snd@ ( gen -- snd ) stereo-snd @ f>s ;
-: stereo-snd! ( snd gen -- ) stereo-snd ! ;
-: pan-pos@ ( gen -- pos ) pan-pos @ f>s ;
-: pan-pos! ( pos gen -- ) pan-pos ! ;
-
: ps-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- gen envel@ xe-envelope { e }
- e #( 0.0 1.0 1.0 1.0 ) equal? if
- gen mono-snd@ gen stereo-snd@ gen pan-pos@ effects-place-sound
- else
- gen mono-snd@ gen stereo-snd@ e effects-place-sound
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ gen eff_enved@ xe-envelope { e }
+ e #( 0.0 1.0 1.0 1.0 ) equal? if
+ gen eff_m_snd@ gen eff_s_snd@ gen eff_pan_pos@
+ else
+ gen eff_m_snd@ gen eff_s_snd@ e
+ then effects-place-sound
;
: ps-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen mono-snd@ , gen stereo-snd@ , gen pan-pos@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-mono ) gen mono-snd!
- self 2 cells + @ ( init-stereo ) gen stereo-snd!
- self 3 cells + @ ( init-pos ) gen pan-pos!
- gen envel@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
- gen sliders@ 0 array-ref gen mono-snd@ 1.0 set-slider-value
- gen sliders@ 1 array-ref gen stereo-snd@ 1.0 set-slider-value
- gen sliders@ 2 array-ref gen pan-pos@ 1.0 set-slider-value
+ 3 proc-create ( prc )
+ gen , gen eff_m_snd@ , gen eff_s_snd@ , gen eff_pan_pos@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-mono }
+ self 2 cells + @ { init-stereo }
+ self 3 cells + @ { init-pos }
+ gen init-mono eff_m_snd!
+ gen init-stereo eff_s_snd!
+ gen init-pos eff_pan_pos!
+ gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope
+ gen eff_sliders@ 0 array-ref init-mono 1.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-stereo 1.0 set-slider-value
+ gen eff_sliders@ 2 array-ref init-pos 1.0 set-slider-value
;
: ps-mono-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) mono-snd!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_m_snd!
;
: ps-stereo-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) stereo-snd!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_s_snd!
;
: ps-pos-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) pan-pos!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_pan_pos!
;
: post-place-sound-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen ps-ok-cb
- gen label@ $" Mixes mono sound into stereo sound field." help-cb
- gen ps-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" mono sound" 0 gen mono-snd@ 50 gen ps-mono-cb 1 )
- #( $" stereo sound" 0 gen stereo-snd@ 50 gen ps-stereo-cb 1 )
- #( $" pan position" 0 gen pan-pos@ 90 gen ps-pos-cb 1 )
- ) add-sliders gen sliders!
- gen make-enved-widget
- else
- gen dialog@ activate-dialog
- then
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen ps-ok-cb gen eff_label@ "\
+Mixes mono sound into stereo sound field." help-cb gen ps-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "mono sound" 0 gen eff_m_snd@ 50
+ gen ps-mono-cb 1 )
+ #( "stereo sound" 0 gen eff_s_snd@ 50
+ gen ps-stereo-cb 1 )
+ #( "pan position" 0 gen eff_pan_pos@ 90
+ gen ps-pos-cb 1 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen make-enved-widget
+ else
+ gen eff_dialog@ activate-dialog
+ then
;
set-current
: make-place-sound-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-place-sound% %alloc make-base-effects { gen }
- 0 gen mono-snd!
- 1 gen stereo-snd!
- 45 gen pan-pos!
- gen post-place-sound-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%d %d %d)"
- #( gen label@ gen mono-snd@ gen stereo-snd@ gen pan-pos@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 0 eff_m_snd!
+ gen 1 eff_s_snd!
+ gen 45 eff_pan_pos!
+ gen post-place-sound-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%d %d %d)"
+ #( gen eff_label@ gen eff_m_snd@ gen eff_s_snd@ gen eff_pan_pos@ )
+ string-format change-label
;
previous
@@ -3641,54 +3980,57 @@ previous
hide
: silence-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- #f #f #f cursor #f srate gen amount@ f* f>s #f #f insert-silence drop
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ #f #f #f cursor #f srate gen eff_amnt@ f* f>s #f #f insert-silence drop
;
: silence-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init ) gen amount!
- gen sliders@ 0 array-ref gen amount@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init }
+ gen init eff_amnt!
+ gen eff_sliders@ 0 array-ref init 100.0 set-slider-value
;
: silence-amount-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: post-silence-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen silence-ok-cb
- gen label@ $" Move the slider to change the number of seconds \
-of silence added at the cursor position." help-cb
- gen silence-reset-cb #f make-effect-dialog gen dialog!
- gen dialog@ #(
- #( "silence" 0.0 gen amount@ 5.0 gen silence-amount-cb 100 )
- ) add-sliders gen sliders!
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen silence-ok-cb gen eff_label@ "\
+Move the slider to change the number of seconds \
+of silence added at the cursor position." help-cb gen silence-reset-cb
+ #f make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "silence" 0.0 gen eff_amnt@ 5.0
+ gen silence-amount-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-silence-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 1.0 gen amount!
- gen post-silence-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen amount@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1.0 eff_amnt!
+ gen post-silence-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_amnt@ ) string-format change-label
;
previous
@@ -3696,396 +4038,421 @@ previous
hide
: contrast-ok-cb ( gen -- prc; w c i self -- x )
- 3 proc-create swap , ( prc )
- does> { w c info self -- x }
- self @ { gen }
- #f #f #f maxamp { peak }
- selected-sound { snd }
- snd save-controls drop
- snd reset-controls drop
- #t snd set-contrast-control? drop
- gen amount@ snd set-contrast-control drop
- peak 1/f snd set-contrast-control-amp drop
- peak snd #f set-amp-control drop
- gen target@ 'marks = if
- plausible-mark-samples { pts }
- pts if
- snd 0
- pts 0 array-ref
- pts 1 array-ref
- pts 0 array-ref - 1+ apply-controls drop
- else
- $" no marks" snd-warning drop
- then
- else
- snd gen target@ 'sound = if 0 else 2 then 0 undef apply-controls drop
- then
- snd restore-controls
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- x }
+ self @ { gen }
+ #f #f #f maxamp { peak }
+ selected-sound { snd }
+ snd save-controls drop
+ snd reset-controls drop
+ #t snd set-contrast-control? drop
+ gen eff_amnt@ snd set-contrast-control drop
+ peak 1/f snd set-contrast-control-amp drop
+ peak snd #f set-amp-control drop
+ gen eff_target@ 'marks = if
+ plausible-mark-samples { pts }
+ pts if
+ snd 0
+ pts 0 array-ref
+ pts 1 array-ref
+ pts 0 array-ref - 1+ apply-controls drop
+ else
+ "no marks" undef status-report drop
+ then
+ else
+ snd gen eff_target@ 'sound = if
+ 0
+ else
+ 2
+ then 0 undef apply-controls drop
+ then
+ snd restore-controls
;
: contrast-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen amount@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init ) gen amount!
- gen sliders@ 0 array-ref gen amount@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_amnt@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init }
+ gen init eff_amnt!
+ gen eff_sliders@ 0 array-ref init 100.0 set-slider-value
;
: contrast-amount-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: post-contrast-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen contrast-ok-cb
- gen label@ $" Move the slider to change the contrast intensity." help-cb
- gen contrast-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" contrast enhancement" 0.0 gen amount@ 10.0 gen contrast-amount-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen contrast-ok-cb gen eff_label@ "\
+Move the slider to change the contrast intensity." help-cb
+ gen contrast-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "contrast enhancement" 0.0 gen eff_amnt@ 10.0
+ gen contrast-amount-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-contrast-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 1.0 gen amount!
- gen post-contrast-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen amount@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1.0 eff_amnt!
+ gen post-contrast-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_amnt@ ) string-format change-label
;
previous
\ === Cross synthesis ===
hide
-effects-base%
- cell% field cross-synth-sound
- cell% field cross-synth-radius
- cell% field cross-synth-fft-widget
-end-struct effects-cross%
-
-: cs-sound@ ( gen -- snd ) cross-synth-sound @ f>s ;
-: cs-sound! ( snd gen -- ) cross-synth-sound ! ;
-: cs-radius@ ( gen -- rad ) cross-synth-radius @ ;
-: cs-radius! ( rad gen -- ) cross-synth-radius ! ;
-: cs-fft-widget@ ( gen -- wid ) cross-synth-fft-widget @ ;
-: cs-fft-widget! ( wid gen -- ) cross-synth-fft-widget ! ;
-
: cs-func-cb ( gen -- prc; samps self -- prc )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- gen cs-sound@ gen amplitude@ gen size@ gen cs-radius@ effects-cross-synthesis
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ gen eff_cs_snd@ gen eff_amp@ gen eff_size@ gen eff_cs_radius@
+ effects-cross-synthesis
;
: cs-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- "effects-cross-synthesis-1"
- $" %s %s %s %s" #( gen cs-sound@ gen amplitude@ gen size@ gen cs-radius@ ) string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-cross-synthesis-1"
+ "%s %s %s %s"
+ #( gen eff_cs_snd@ gen eff_amp@ gen eff_size@ gen eff_cs_radius@ )
+ string-format
;
: cs-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen cs-func-cb
- gen target@
- gen cs-origin-cb
- #f
- map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen cs-func-cb gen eff_target@ gen cs-origin-cb #f
+ map-chan-over-target-with-sync
;
'snd-motif provided? [if]
- : cs-set-state ( wid -- )
- use-combo-box-for-fft-size if
- #( FXmNselectedPosition 1 ) FXtVaSetValues
- else
- #t #t FXmToggleButtonSetState
- then drop
- ;
+ : cs-set-state ( wid -- )
+ use-combo-box-for-fft-size if
+ #( FXmNselectedPosition 1 ) FXtVaSetValues
+ else
+ #t #t FXmToggleButtonSetState
+ then drop
+ ;
[else]
- : cs-set-state ( wid -- ) drop ;
+ : cs-set-state ( wid -- ) drop ;
[then]
: cs-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen cs-sound@ , gen amplitude@ , gen size@ , gen cs-radius@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-snd ) gen cs-sound!
- self 2 cells + @ ( init-amp ) gen amplitude!
- self 3 cells + @ ( init-size ) gen size!
- self 4 cells + @ ( init-rad ) gen cs-radius!
- gen sliders@ 0 array-ref gen cs-sound@ 1.0 set-slider-value
- gen sliders@ 1 array-ref gen amplitude@ 100.0 set-slider-value
- gen sliders@ 2 array-ref gen cs-radius@ 100.0 set-slider-value
- gen cs-fft-widget@ cs-set-state
+ 3 proc-create ( prc )
+ gen , gen eff_cs_snd@ , gen eff_amp@ ,
+ gen eff_size@ , gen eff_cs_radius@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-snd }
+ self 2 cells + @ { init-amp }
+ self 3 cells + @ { init-size }
+ self 4 cells + @ { init-rad }
+ gen init-snd eff_cs_snd!
+ gen init-amp eff_amp!
+ gen init-size eff_size!
+ gen init-rad eff_cs_radius!
+ gen eff_sliders@ 0 array-ref init-snd 1.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-amp 100.0 set-slider-value
+ gen eff_sliders@ 2 array-ref init-rad 100.0 set-slider-value
+ gen eff_cs_wid@ cs-set-state
;
: cs-snd-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 1.0 get-slider-value self @ ( gen ) cs-sound!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 1.0 get-slider-value { val }
+ self @ ( gen ) val eff_cs_snd!
;
: cs-rad-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) cs-radius!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_cs_radius!
;
'snd-motif provided? [if]
- : cs-sel-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- info Fitem_or_text ( selected )
- #f FXmCHARSET_TEXT FXmCHARSET_TEXT #f 0 FXmOUTPUT_ALL FXmStringUnparse ( size-as-str )
- string->number self @ ( gen ) size!
- ;
-
- : cs-sel-changed-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w size info self -- }
- info Fset if size self @ ( gen ) size! then
- ;
-
- : cs-sel-create-sel { gen -- }
- #( 64 128 256 512 1024 4096 ) { sizes }
- $" FFT size" FXmStringCreateLocalized { s1 }
- "frame" FxmFrameWidgetClass gen sliders@ 0 array-ref FXtParent
- #( FXmNborderWidth 1
- FXmNshadowType FXmSHADOW_ETCHED_IN
- FXmNpositionIndex 2 ) undef FXtCreateManagedWidget { frame }
- "frm" FxmFormWidgetClass frame
- #( FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNtopAttachment FXmATTACH_FORM
- FXmNbottomAttachment FXmATTACH_FORM
- FXmNbackground basic-color ) undef FXtCreateManagedWidget { frm }
- use-combo-box-for-fft-size if
- $" FFT size" FxmLabelWidgetClass frm
- #( FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_NONE
- FXmNtopAttachment FXmATTACH_FORM
- FXmNbottomAttachment FXmATTACH_FORM
- FXmNlabelString s1
- FXmNbackground basic-color ) undef FXtCreateManagedWidget { lab }
- sizes map! *key* number->string FXmStringCreateLocalized end-map { fft-labels }
- "fftsize" FxmComboBoxWidgetClass frm
- #( FXmNleftAttachment FXmATTACH_WIDGET
- FXmNleftWidget lab
- FXmNrightAttachment FXmATTACH_FORM
- FXmNtopAttachment FXmATTACH_FORM
- FXmNbottomAttachment FXmATTACH_FORM
- FXmNitems fft-labels
- FXmNitemCount fft-labels length
- FXmNcomboBoxType FXmDROP_DOWN_COMBO_BOX
- FXmNbackground basic-color ) undef FXtCreateManagedWidget { combo }
- combo gen cs-fft-widget!
- fft-labels each FXmStringFree drop end-each
- combo #( FXmNselectedPosition 1 ) FXtVaSetValues drop
- combo FXmNselectionCallback gen cs-sel-cb undef FXtAddCallback drop
- else
- "rc" FxmRowColumnWidgetClass frm
- #( FXmNorientation FXmHORIZONTAL
- FXmNradioBehavior #t
- FXmNradioAlwaysOne #t
- FXmNentryClass FxmToggleButtonWidgetClass
- FXmNisHomogeneous #t
- FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNtopAttachment FXmATTACH_FORM
- FXmNbottomAttachment FXmATTACH_NONE
- FXmNbackground basic-color ) undef FXtCreateManagedWidget { rc }
- $" FFT size" FxmLabelWidgetClass frm
- #( FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNtopAttachment FXmATTACH_WIDGET
- FXmNtopWidget rc
- FXmNbottomAttachment FXmATTACH_FORM
- FXmNlabelString s1
- FXmNalignment FXmALIGNMENT_BEGINNING
- FXmNbackground basic-color ) undef FXtCreateManagedWidget { lab }
- sizes each { size }
- size number->string FxmToggleButtonWidgetClass rc
- #( FXmNbackground basic-color
- FXmNvalueChangedCallback #( gen cs-sel-changed-cb size )
- FXmNset size gen size@ = ) undef FXtCreateManagedWidget { button }
- size gen size@ = if button gen cs-fft-widget! then
- end-each
- then
- s1 FXmStringFree drop
- ;
+ : cs-sel-cb ( gen -- prc; w c i self -- )
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ info Fitem_or_text ( selected ) #f FXmCHARSET_TEXT
+ FXmCHARSET_TEXT #f 0 FXmOUTPUT_ALL
+ FXmStringUnparse ( size-as-str ) string->number { val }
+ self @ ( gen ) val eff_size!
+ ;
+
+ : cs-sel-changed-cb ( gen -- prc; w c i self -- )
+ 3 proc-create swap , ( prc )
+ does> { w size info self -- }
+ info Fset if
+ self @ ( gen ) size eff_size!
+ then
+ ;
+
+ : cs-sel-create-sel { gen -- }
+ #( 64 128 256 512 1024 4096 ) { sizes }
+ "FFT size" FXmStringCreateLocalized { s1 }
+ "frame" FxmFrameWidgetClass gen eff_sliders@ 0 array-ref
+ FXtParent
+ #( FXmNborderWidth 1 FXmNshadowType
+ FXmSHADOW_ETCHED_IN FXmNpositionIndex 2 )
+ undef FXtCreateManagedWidget { frame }
+ "frm" FxmFormWidgetClass frame
+ #( FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNtopAttachment FXmATTACH_FORM
+ FXmNbottomAttachment FXmATTACH_FORM
+ FXmNbackground basic-color )
+ undef FXtCreateManagedWidget { frm }
+ use-combo-box-for-fft-size if
+ "FFT size" FxmLabelWidgetClass frm
+ #( FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_NONE
+ FXmNtopAttachment FXmATTACH_FORM
+ FXmNbottomAttachment FXmATTACH_FORM
+ FXmNlabelString s1
+ FXmNbackground basic-color )
+ undef FXtCreateManagedWidget { lab }
+ sizes map!
+ *key* number->string FXmStringCreateLocalized
+ end-map { fft-labels }
+ "fftsize" FxmComboBoxWidgetClass frm
+ #( FXmNleftAttachment FXmATTACH_WIDGET
+ FXmNleftWidget lab
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNtopAttachment FXmATTACH_FORM
+ FXmNbottomAttachment FXmATTACH_FORM
+ FXmNitems fft-labels
+ FXmNitemCount fft-labels length
+ FXmNcomboBoxType FXmDROP_DOWN_COMBO_BOX
+ FXmNbackground basic-color )
+ undef FXtCreateManagedWidget { combo }
+ gen combo eff_cs_wid!
+ fft-labels each ( s )
+ FXmStringFree drop
+ end-each
+ combo #( FXmNselectedPosition 1 ) FXtVaSetValues drop
+ combo FXmNselectionCallback gen cs-sel-cb undef
+ FXtAddCallback drop
+ else
+ "rc" FxmRowColumnWidgetClass frm
+ #( FXmNorientation FXmHORIZONTAL
+ FXmNradioBehavior #t
+ FXmNradioAlwaysOne #t
+ FXmNentryClass FxmToggleButtonWidgetClass
+ FXmNisHomogeneous #t
+ FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNtopAttachment FXmATTACH_FORM
+ FXmNbottomAttachment FXmATTACH_NONE
+ FXmNbackground basic-color )
+ undef FXtCreateManagedWidget { rc }
+ "FFT size" FxmLabelWidgetClass frm
+ #( FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNtopAttachment FXmATTACH_WIDGET
+ FXmNtopWidget rc
+ FXmNbottomAttachment FXmATTACH_FORM
+ FXmNlabelString s1
+ FXmNalignment FXmALIGNMENT_BEGINNING
+ FXmNbackground basic-color )
+ undef FXtCreateManagedWidget { lab }
+ sizes each { size }
+ size number->string
+ FxmToggleButtonWidgetClass rc
+ #( FXmNbackground basic-color
+ FXmNvalueChangedCallback
+ #( gen cs-sel-changed-cb size )
+ FXmNset size gen eff_size@ = )
+ undef FXtCreateManagedWidget { button }
+ size gen eff_size@ = if
+ gen button eff_cs_wid!
+ then
+ end-each
+ then
+ s1 FXmStringFree drop
+ ;
[else]
- : cs-sel-create-sel { gen -- } ;
+ : cs-sel-create-sel ( gen -- ) drop ;
[then]
: post-cross-synth-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen cs-ok-cb
- gen label@ $" The sliders set the number of the soundfile to be cross-synthesized, \
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen cs-ok-cb gen eff_label@ "\
+The sliders set the number of the soundfile to be cross-synthesized, \
the synthesis amplitude, the FFT size, and the radius value." help-cb
- gen cs-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" input sound" 0 gen cs-sound@ 20 gen cs-snd-cb 1 )
- #( $" amplitude" 0.0 gen amplitude@ 1.0 gen amplitude-slider-cb 100 )
- #( $" radius" 0.0 gen cs-radius@ 360.0 gen cs-rad-cb 100 )
- ) add-sliders gen sliders!
- gen cs-sel-create-sel
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ gen cs-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "input sound" 0 gen eff_cs_snd@ 20
+ gen cs-snd-cb 1 )
+ #( "amplitude" 0.0 gen eff_amp@ 1.0
+ gen amplitude-slider-cb 100 )
+ #( "radius" 0.0 gen eff_cs_radius@ 360.0
+ gen cs-rad-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen cs-sel-create-sel
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-cross-synth-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-cross% %alloc make-base-effects { gen }
- 1 gen cs-sound!
- 0.5 gen amplitude!
- 128 gen size!
- 6.0 gen cs-radius!
- #f gen cs-fft-widget!
- gen post-cross-synth-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%d %.2f %d %.2f)" #( gen label@ gen cs-sound@ gen amplitude@ gen size@ gen cs-radius@ )
- string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1 eff_cs_snd!
+ gen 0.5 eff_amp!
+ gen 128 eff_size!
+ gen 6.0 eff_cs_radius!
+ gen #f eff_cs_wid!
+ gen post-cross-synth-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%d %.2f %d %.2f)"
+ #( gen eff_label@
+ gen eff_cs_snd@
+ gen eff_amp@
+ gen eff_size@
+ gen eff_cs_radius@ ) string-format change-label
;
previous
\ === Flange and phasing ===
hide
-effects-base%
- cell% field flange-speed
- cell% field flange-time
-end-struct effects-flange%
-
-: flange-speed@ ( gen -- val ) flange-speed @ ;
-: flange-speed! ( val gen -- ) flange-speed ! ;
-: flange-time@ ( gen -- val ) flange-time @ ;
-: flange-time! ( val gen -- ) flange-time ! ;
-
: flange-func-cb ( gen -- prc; samps self -- prc; self -- )
- 1 proc-create swap , ( prc )
- does> { samps self -- prc }
- self @ { gen }
- :frequency gen flange-speed@ :amplitude gen amount@ make-rand-interp { ri }
- gen flange-time@ #f srate f* fround->s { len }
- :size len :max-size gen amount@ 1.0 len f+ f+ f>s make-delay { del }
- 1 proc-create del , ri , ( prc )
- does> { inval self -- res }
- self @ ( del ) inval self cell+ @ ( ri ) 0.0 rand-interp delay inval f+ 0.75 f*
+ 1 proc-create swap , ( prc )
+ does> { samps self -- prc }
+ self @ { gen }
+ :frequency gen eff_fl_speed@
+ :amplitude gen eff_amnt@ make-rand-interp { ri }
+ gen eff_fl_time@ #f srate f* fround->s { len }
+ :size len :max-size gen eff_amnt@ 1.0 len f+ f+ f>s make-delay { del }
+ 1 proc-create del , ri , ( prc )
+ does> { inval self -- res }
+ self @ ( del ) inval self cell+ @ ( ri ) 0.0 rand-interp
+ delay inval f+ 0.75 f*
;
: flange-origin-cb ( gen -- prc; target samps self -- name origin )
- 2 proc-create swap , ( prc )
- does> { target samps self -- name origin }
- self @ { gen }
- "effects-flange"
- $" %s %s %s" #( gen amount@ gen flange-speed@ gen flange-time@ ) string-format
+ 2 proc-create swap , ( prc )
+ does> { target samps self -- name origin }
+ self @ { gen }
+ "effects-flange"
+ "%s %s %s"
+ #( gen eff_amnt@ gen eff_fl_speed@ gen eff_fl_time@ ) string-format
;
: flange-ok-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen flange-func-cb
- gen target@
- gen flange-origin-cb
- #f
- map-chan-over-target-with-sync
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen flange-func-cb gen eff_target@ gen flange-origin-cb #f
+ map-chan-over-target-with-sync
;
: flange-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen flange-speed@ , gen amount@ , gen flange-time@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-speed ) gen flange-speed!
- self 2 cells + @ ( init-amount ) gen amount!
- self 3 cells + @ ( init-time ) gen flange-time!
- gen sliders@ 0 array-ref gen flange-speed@ 10.0 set-slider-value
- gen sliders@ 1 array-ref gen amount@ 10.0 set-slider-value
- gen sliders@ 2 array-ref gen flange-time@ 100.0 set-slider-value
+ 3 proc-create ( prc )
+ gen , gen eff_fl_speed@ , gen eff_amnt@ , gen eff_fl_time@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-speed }
+ self 2 cells + @ { init-amount }
+ self 3 cells + @ { init-time }
+ gen init-speed eff_fl_speed!
+ gen init-amount eff_amnt!
+ gen init-time eff_fl_time!
+ gen eff_sliders@ 0 array-ref init-speed 10.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-amount 10.0 set-slider-value
+ gen eff_sliders@ 2 array-ref init-time 100.0 set-slider-value
;
: flange-speed-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 10.0 get-slider-value self @ ( gen ) flange-speed!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 10.0 get-slider-value { val }
+ self @ ( gen ) val eff_fl_speed!
;
: flange-amount-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 10.0 get-slider-value self @ ( gen ) amount!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 10.0 get-slider-value { val }
+ self @ ( gen ) val eff_amnt!
;
: flange-time-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) flange-time!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_fl_time!
;
: post-flange-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen flange-ok-cb
- gen label@ $" Move the slider to change the flange speed, amount, and time." help-cb
- gen flange-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" flange speed" 0.0 gen flange-speed@ 100.0 gen flange-speed-cb 10 )
- #( $" flange amount" 0.0 gen amount@ 100.0 gen flange-amount-cb 10 )
- #( $" flange time" 0.0 gen flange-time@ 1.0 gen flange-time-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen flange-ok-cb gen eff_label@ "\
+Move the slider to change the flange speed, amount, and time." help-cb
+ gen flange-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "flange speed" 0.0 gen eff_fl_speed@ 100.0
+ gen flange-speed-cb 10 )
+ #( "flange amount" 0.0 gen eff_amnt@ 100.0
+ gen flange-amount-cb 10 )
+ #( "flange time" 0.0 gen eff_fl_time@ 1.0
+ gen flange-time-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-flange-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-flange% %alloc make-base-effects { gen }
- 2.000 gen flange-speed!
- 5.000 gen amount!
- 0.001 gen flange-time!
- gen post-flange-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f %.2f)" #( gen label@ gen flange-speed@ gen amount@ gen flange-time@ )
- string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 2.000 eff_fl_speed!
+ gen 5.000 eff_amnt!
+ gen 0.001 eff_fl_time!
+ gen post-flange-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f %.2f)"
+ #( gen eff_label@ gen eff_fl_speed@ gen eff_amnt@ gen eff_fl_time@ )
+ string-format change-label
;
previous
@@ -4093,207 +4460,206 @@ previous
hide
: random-phase-cb ( scl -- prc; x self -- res )
- 1 proc-create swap , ( prc )
- does> { x self -- res }
- self @ ( scl ) random
+ 1 proc-create swap , ( prc )
+ does> { x self -- res }
+ self @ ( scl ) random
;
: rp-ok-cb ( gen -- prc; w c i self -- res )
- 3 proc-create swap , ( prc )
- does> { w c info self -- res }
- self @ { gen }
- gen scaler@ random-phase-cb { prc }
- \ edit-list->function needs a usable proc-source-string
- prc $" %s random-phase-cb" gen scaler@ string-format proc-source-set!
- prc #f #f rotate-phase
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- res }
+ self @ { gen }
+ gen eff_scl@ random-phase-cb { prc }
+ \ edit-list->function needs a usable proc-source-string
+ prc "%s random-phase-cb" gen eff_scl@ string-format proc-source-set!
+ prc #f #f rotate-phase
;
: rp-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen scaler@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init ) gen scaler!
- gen sliders@ 0 array-ref gen scaler@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_scl@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init }
+ gen init eff_scl!
+ gen eff_sliders@ 0 array-ref init 100.0 set-slider-value
;
: post-random-phase-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen rp-ok-cb
- gen label@ $" Move the slider to change the randomization amplitude scaler." help-cb
- gen rp-reset-cb #f make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" amplitude scaler" 0.0 gen scaler@ 100.0 gen scaler-slider-cb 100 )
- ) add-sliders gen sliders!
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen rp-ok-cb gen eff_label@ "\
+Move the slider to change the randomization amplitude scaler." help-cb
+ gen rp-reset-cb #f make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "amplitude scaler" 0.0 gen eff_scl@ 100.0
+ gen scaler-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-random-phase-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 3.14 gen scaler!
- gen post-random-phase-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen scaler@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 3.14 eff_scl!
+ gen post-random-phase-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_scl@ ) string-format change-label
;
previous
\ === Robotize ===
hide
-effects-base%
- cell% field robotize-samp-rate
-end-struct effects-robotize%
-
-: samp-rate@ ( gen -- sr ) robotize-samp-rate @ ;
-: samp-rate! ( sr gen -- ) robotize-samp-rate ! ;
-
: robotize-ok-cb ( gen -- prc; w c i self -- res )
- 3 proc-create swap , ( prc )
- does> { w c info self -- res }
- self @ { gen }
- gen samp-rate@ gen amplitude@ gen frequency@ \ beg dur follows
- gen target@ 'sound = if
- 0 #f #f #f frames
- else
- gen target@ 'selection = if
- #f #f selection-position #f #f selection-frames
- else
- plausible-mark-samples { pts }
- pts if
- pts 0 array-ref pts 1 array-ref pts 0 array-ref -
- else
- 'no-such-mark #( get-func-name pts ) fth-throw
- then
- then
- then #f #f effects-fp
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- res }
+ self @ { gen }
+ gen eff_sr@ gen eff_amp@ gen eff_freq@ \ beg dur follows
+ gen eff_target@ 'sound = if
+ 0 #f #f #f framples
+ else
+ gen eff_target@ 'selection = if
+ #f #f selection-position #f #f selection-framples
+ else
+ plausible-mark-samples { pts }
+ pts if
+ pts 0 array-ref
+ pts 1 array-ref
+ pts 0 array-ref -
+ else
+ 'no-such-mark
+ #( "%s: %s" get-func-name pts ) fth-throw
+ then
+ then
+ then #f #f effects-fp
;
: robotize-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen samp-rate@ , gen amplitude@ , gen frequency@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-sr ) gen samp-rate!
- self 2 cells + @ ( init-amp ) gen amplitude!
- self 3 cells + @ ( init-frq ) gen frequency!
- gen sliders@ 0 array-ref gen samp-rate@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen amplitude@ 100.0 set-slider-value
- gen sliders@ 2 array-ref gen frequency@ 100.0 set-slider-value
+ 3 proc-create ( prc )
+ gen , gen eff_sr@ , gen eff_amp@ , gen eff_freq@ ,
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-sr }
+ self 2 cells + @ { init-amp }
+ self 3 cells + @ { init-frq }
+ gen init-sr eff_sr!
+ gen init-amp eff_amp!
+ gen init-frq eff_freq!
+ gen eff_sliders@ 0 array-ref init-sr 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-amp 100.0 set-slider-value
+ gen eff_sliders@ 2 array-ref init-frq 100.0 set-slider-value
;
: robotize-sam-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) samp-rate!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_sr!
;
: post-robotize-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen robotize-ok-cb
- gen label@ $" Move the sliders to set the sample rate, \
-oscillator amplitude, and oscillator frequency." help-cb
- gen robotize-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" sample rate" 0.0 gen samp-rate@ 2.0 gen robotize-sam-cb 100 )
- #( $" oscillator amplitude" 0.0 gen amplitude@ 1.0 gen amplitude-slider-cb 100 )
- #( $" oscillator frequency" 0.0 gen frequency@ 60.0 gen frequency-slider-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen robotize-ok-cb gen eff_label@ "\
+Move the sliders to set the sample rate, \
+oscillator amplitude, and oscillator frequency." help-cb gen robotize-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "sample rate" 0.0 gen eff_sr@ 2.0
+ gen robotize-sam-cb 100 )
+ #( "oscillator amplitude" 0.0 gen eff_amp@ 1.0
+ gen amplitude-slider-cb 100 )
+ #( "oscillator frequency" 0.0 gen eff_freq@ 60.0
+ gen frequency-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-robotize-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-robotize% %alloc make-base-effects { gen }
- 1.0 gen samp-rate!
- 0.3 gen amplitude!
- 20.0 gen frequency!
- gen post-robotize-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child )
- $" %s (%.2f %.2f %.2f)" #( gen label@ gen samp-rate@ gen amplitude@ gen frequency@ )
- string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1.0 eff_sr!
+ gen 0.3 eff_amp!
+ gen 20.0 eff_freq!
+ gen post-robotize-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f %.2f)"
+ #( gen eff_label@ gen eff_sr@ gen eff_amp@ gen eff_freq@ )
+ string-format change-label
;
previous
\ === Rubber sound ===
hide
-effects-base%
- cell% field rubber-factor
-end-struct effects-rubber%
-
-: factor@ ( gen -- val ) rubber-factor @ ;
-: factor! ( val gen -- ) rubber-factor ! ;
-
: rubber-ok-cb ( gen -- prc; w c i self -- res )
- 3 proc-create swap , ( prc )
- does> { w c info self -- res }
- self @ ( gen ) factor@ #f #f rubber-sound
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- res }
+ self @ ( gen ) eff_factor@ #f #f rubber-sound
;
: rubber-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen factor@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init ) gen factor!
- gen sliders@ 0 array-ref gen factor@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_factor@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init }
+ gen init eff_factor!
+ gen eff_sliders@ 0 array-ref init 100.0 set-slider-value
;
: rubber-factor-cb ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- w info 100.0 get-slider-value self @ ( gen ) factor!
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ w info 100.0 get-slider-value { val }
+ self @ ( gen ) val eff_factor!
;
: post-rubber-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen rubber-ok-cb
- gen label@ $" Stretches or contracts the time of a sound. \
-Move the slider to change the stretch factor." help-cb
- gen rubber-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" stretch factor" 0.0 gen factor@ 5.0 gen rubber-factor-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen rubber-ok-cb gen eff_label@ "\
+Stretches or contracts the time of a sound. \
+Move the slider to change the stretch factor." help-cb gen rubber-reset-cb
+ gen general-target-cb make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "stretch factor" 0.0 gen eff_factor@ 5.0
+ gen rubber-factor-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-rubber-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-rubber% %alloc make-base-effects { gen }
- 1.0 gen factor!
- gen post-rubber-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f)" #( gen label@ gen factor@ ) string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 1.0 eff_factor!
+ gen post-rubber-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f)"
+ #( gen eff_label@ gen eff_factor@ ) string-format change-label
;
previous
@@ -4301,128 +4667,159 @@ previous
hide
: wobble-ok-cb ( gen -- prc; w c i self -- res )
- 3 proc-create swap , ( prc )
- does> { w c info self -- res }
- self @ { gen }
- gen frequency@ gen amplitude@ \ beg dur follows
- gen target@ 'sound = if
- 0 #f #f #f frames
- else
- gen target@ 'selection = if
- #f #f selection-position #f #f selection-frames
- else
- plausible-mark-samples { pts }
- pts if
- pts 0 array-ref pts 1 array-ref pts 0 array-ref -
- else
- 'no-such-mark #( get-func-name pts ) fth-throw
- then
- then
- then #f #f effects-hello-dentist
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- res }
+ self @ { gen }
+ gen eff_freq@ gen eff_amp@ \ beg dur follows
+ gen eff_target@ 'sound = if
+ 0 #f #f #f framples
+ else
+ gen eff_target@ 'selection = if
+ #f #f selection-position #f #f selection-framples
+ else
+ plausible-mark-samples { pts }
+ pts if
+ pts 0 array-ref
+ pts 1 array-ref
+ pts 0 array-ref -
+ else
+ 'no-such-mark
+ #( "%s: %s" get-func-name pts ) fth-throw
+ then
+ then
+ then #f #f effects-hello-dentist
;
: wobble-reset-cb { gen -- prc; w c i self -- }
- 3 proc-create gen , gen frequency@ , gen amplitude@ , ( prc )
- does> { w c info self -- }
- self @ { gen }
- self 1 cells + @ ( init-frq ) gen frequency!
- self 2 cells + @ ( init-amp ) gen amplitude!
- gen sliders@ 0 array-ref gen frequency@ 100.0 set-slider-value
- gen sliders@ 1 array-ref gen amplitude@ 100.0 set-slider-value
+ 3 proc-create gen , gen eff_freq@ , gen eff_amp@ , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ self 1 cells + @ { init-frq }
+ self 2 cells + @ { init-amp }
+ gen init-frq eff_freq!
+ gen init-amp eff_amp!
+ gen eff_sliders@ 0 array-ref init-frq 100.0 set-slider-value
+ gen eff_sliders@ 1 array-ref init-amp 100.0 set-slider-value
;
: post-wobble-dialog ( gen -- prc; w c i self -- )
- 3 proc-create swap , ( prc )
- does> { w c info self -- }
- self @ { gen }
- gen dialog@ widget? unless
- gen label@
- gen wobble-ok-cb
- gen label@ $" Move the sliders to set the wobble frequency and amplitude." help-cb
- gen wobble-reset-cb
- gen general-target-cb make-effect-dialog gen dialog!
- gen dialog@ #(
- #( $" wobble frequency" 0.0 gen frequency@ 100.0 gen frequency-slider-cb 100 )
- #( $" wobble amplitude" 0.0 gen amplitude@ 1.0 gen amplitude-slider-cb 100 )
- ) add-sliders gen sliders!
- gen #f add-target
- then
- gen dialog@ activate-dialog
+ 3 proc-create swap , ( prc )
+ does> { w c info self -- }
+ self @ { gen }
+ gen eff_dialog@ widget? unless
+ gen eff_label@ gen wobble-ok-cb gen eff_label@ "\
+Move the sliders to set the wobble frequency and amplitude." help-cb
+ gen wobble-reset-cb gen general-target-cb
+ make-effect-dialog { d }
+ gen d eff_dialog!
+ d #( #( "wobble frequency" 0.0 gen eff_freq@ 100.0
+ gen frequency-slider-cb 100 )
+ #( "wobble amplitude" 0.0 gen eff_amp@ 1.0
+ gen amplitude-slider-cb 100 ) ) add-sliders ( sl )
+ gen swap eff_sliders!
+ gen #f add-target
+ then
+ gen eff_dialog@ activate-dialog
;
set-current
: make-wobble-dialog ( name -- prc1 prc2; child self -- prc; self -- )
- ( name ) effects-base% %alloc make-base-effects { gen }
- 50.0 gen frequency!
- 0.5 gen amplitude!
- gen post-wobble-dialog ( prc1 )
- 1 proc-create gen , ( prc2 )
- does> { child self -- prc; self -- }
- 0 proc-create self @ ( gen ) , child , ( prc )
- does> { self -- }
- self @ { gen }
- self cell+ @ ( child ) $" %s (%.2f %.2f)" #( gen label@ gen frequency@ gen amplitude@ )
- string-format change-label
+ ( name ) make-base-effects { gen }
+ gen 50.0 eff_freq!
+ gen 0.5 eff_amp!
+ gen post-wobble-dialog ( prc1 )
+ 1 proc-create gen , ( prc2 )
+ does> { child self -- prc; self -- }
+ 0 proc-create self @ ( gen ) , child , ( prc )
+ does> { self -- }
+ self @ { gen }
+ self cell+ @ ( child ) "%s (%.2f %.2f)"
+ #( gen eff_label@ gen eff_freq@ gen eff_amp@ )
+ string-format change-label
;
previous
+: init-effects-menu ( name -- )
+ make-main-menu { main }
+ "Amplitude Effects" main make-menu { menu }
+ menu "Gain" make-gain-dialog menu-entry
+ menu "Normalize" make-normalize-dialog menu-entry
+ menu "Gate" make-gate-dialog menu-entry
+ "Delay Effects" main make-menu to menu
+ menu "Echo" make-echo-dialog menu-entry
+ menu "Filtered echo" make-flecho-dialog menu-entry
+ menu "Modulated echo" make-zecho-dialog menu-entry
+ "Filter Effects" main make-menu to menu
+ menu "Band-pass filter" make-band-pass-dialog menu-entry
+ menu "Band-reject filter" make-notch-dialog menu-entry
+ menu "High-pass filter" make-high-pass-dialog menu-entry
+ menu "Low-pass filter" make-low-pass-dialog menu-entry
+ menu "Comb filter" make-comb-dialog menu-entry
+ menu "Comb chord filter" make-comb-chord-dialog menu-entry
+ menu "Moog filter" make-moog-dialog menu-entry
+ "Frequency Effects" main make-menu to menu
+ menu "Adaptive saturation" make-adsat-dialog menu-entry
+ menu "Sample rate conversion" make-src-dialog menu-entry
+ menu "Time/pitch scaling" make-expsrc-dialog menu-entry
+ menu "Src-Timevar" make-src-timevar-dialog menu-entry
+ "Modulation Effects" main make-menu to menu
+ menu "Amplitude modulation" make-am-effect-dialog menu-entry
+ menu "Ring modulation" make-rm-effect-dialog menu-entry
+ "Reverbs" main make-menu to menu
+ menu "McNabb reverb" make-reverb-dialog menu-entry
+ menu "Chowning reverb" make-jc-reverb-dialog menu-entry
+ menu "Convolution" make-convolve-dialog menu-entry
+ "Various" main make-menu to menu
+ menu "Place sound" make-place-sound-dialog menu-entry
+ menu "Add silence" make-silence-dialog menu-entry
+ menu "Contrast enhancement" make-contrast-dialog menu-entry
+ menu "Cross synthesis" make-cross-synth-dialog menu-entry
+ menu "Flange" make-flange-dialog menu-entry
+ menu "Randomize phase" make-random-phase-dialog menu-entry
+ menu "Robotize" make-robotize-dialog menu-entry
+ menu "Rubber sound" make-rubber-dialog menu-entry
+ menu "Wobble" make-wobble-dialog menu-entry
+;
+
\ === Effects Menu ===
"Effects" value effects-menu-label
-[ifundef] effects-menu-exists?
- #t value effects-menu-exists?
-
- let: ( -- )
- effects-menu-label make-main-menu { main }
- $" Amplitude Effects" main make-menu { menu }
- menu $" Gain" make-gain-dialog menu-entry
- menu $" Normalize" make-normalize-dialog menu-entry
- menu $" Gate" make-gate-dialog menu-entry
- $" Delay Effects" main make-menu to menu
- menu $" Echo" make-echo-dialog menu-entry
- menu $" Filtered echo" make-flecho-dialog menu-entry
- menu $" Modulated echo" make-zecho-dialog menu-entry
- $" Filter Effects" main make-menu to menu
- menu $" Band-pass filter" make-band-pass-dialog menu-entry
- menu $" Band-reject filter" make-notch-dialog menu-entry
- menu $" High-pass filter" make-high-pass-dialog menu-entry
- menu $" Low-pass filter" make-low-pass-dialog menu-entry
- menu $" Comb filter" make-comb-dialog menu-entry
- menu $" Comb chord filter" make-comb-chord-dialog menu-entry
- menu $" Moog filter" make-moog-dialog menu-entry
- $" Frequency Effects" main make-menu to menu
- menu $" Adaptive saturation" make-adsat-dialog menu-entry
- menu $" Sample rate conversion" make-src-dialog menu-entry
- menu $" Time/pitch scaling" make-expsrc-dialog menu-entry
- menu $" Src-Timevar" make-src-timevar-dialog menu-entry
- $" Modulation Effects" main make-menu to menu
- menu $" Amplitude modulation" make-am-effect-dialog menu-entry
- menu $" Ring modulation" make-rm-effect-dialog menu-entry
- $" Reverbs" main make-menu to menu
- menu $" McNabb reverb" make-reverb-dialog menu-entry
- menu $" Chowning reverb" make-jc-reverb-dialog menu-entry
- menu $" Convolution" make-convolve-dialog menu-entry
- $" Various" main make-menu to menu
- menu $" Place sound" make-place-sound-dialog menu-entry
- menu $" Add silence" make-silence-dialog menu-entry
- menu $" Contrast enhancement" make-contrast-dialog menu-entry
- menu $" Cross synthesis" make-cross-synth-dialog menu-entry
- menu $" Flange" make-flange-dialog menu-entry
- menu $" Randomize phase" make-random-phase-dialog menu-entry
- menu $" Robotize" make-robotize-dialog menu-entry
- menu $" Rubber sound" make-rubber-dialog menu-entry
- menu $" Wobble" make-wobble-dialog menu-entry
- ;let
-
- #f effects-noop add-to-effects-menu \ separator
- $" Octave-down" lambda: <{ -- }> 2 #f #f down-oct ; add-to-effects-menu
- $" Remove clicks" lambda: <{ -- }> #f #f effects-remove-clicks ; add-to-effects-menu
- $" Remove DC" lambda: <{ -- }> #f #f effects-remove-dc ; add-to-effects-menu
- $" Spiker" lambda: <{ -- }> #f #f spike ; add-to-effects-menu
- $" Compand" lambda: <{ -- }> #f #f effects-compand ; add-to-effects-menu
- $" Invert" lambda: <{ -- }> -1 #f #f scale-by ; add-to-effects-menu
- $" Reverse" lambda: <{ -- }> #f #f #f reverse-sound ; add-to-effects-menu
- $" Null phase" lambda: <{ -- }> #f #f zero-phase ; add-to-effects-menu
+[undefined] effects-menu-exists? [if]
+ #t value effects-menu-exists?
+ effects-menu-label init-effects-menu
+ #f effects-noop add-to-effects-menu \ separator
+
+ "Octave-down" lambda: <{ -- }>
+ 2 #f #f down-oct
+ ; add-to-effects-menu
+
+ "Remove clicks" lambda: <{ -- }>
+ #f #f effects-remove-clicks
+ ; add-to-effects-menu
+
+ "Remove DC" lambda: <{ -- }>
+ #f #f effects-remove-dc
+ ; add-to-effects-menu
+
+ "Spiker" lambda: <{ -- }>
+ #f #f spike
+ ; add-to-effects-menu
+
+ "Compand" lambda: <{ -- }>
+ #f #f effects-compand
+ ; add-to-effects-menu
+
+ "Invert" lambda: <{ -- }>
+ -1 #f #f scale-by
+ ; add-to-effects-menu
+
+ "Reverse" lambda: <{ -- }>
+ #f #f #f reverse-sound
+ ; add-to-effects-menu
+
+ "Null phase" lambda: <{ -- }>
+ #f #f zero-phase
+ ; add-to-effects-menu
[then]
\ effects.fs ends here
diff --git a/effects.rb b/effects.rb
index 0ded32f..75ea883 100644
--- a/effects.rb
+++ b/effects.rb
@@ -1,19 +1,19 @@
-# effects.rb -- Guile -> Ruby translation
+# effects.rb -- Scheme -> Ruby translation
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Fri Feb 07 23:56:21 CET 2003
-# Changed: Sat Feb 19 17:17:19 CET 2011
+# Created: 03/02/07 23:56:21
+# Changed: 14/11/13 04:43:14
-# Commentary:
+# Requires --with-motif|gtk
#
-# Requires --with-motif|gtk and module libxm.so|libxg.so or --with-static-xm|xg!
-#
-# Tested with Snd 11, Motif 2.2.3, Gtk+ 2.20.1, Ruby 1.8.0/7, 1.9.2/3.
+# Tested with Snd 15.x
+# Ruby 2.x.x
+# Motif 2.3.3 X11R6
#
# module Effects (see new-effects.scm)
# plausible_mark_samples
# map_chan_over_target_with_sync(target, decay, origin_func) do |in| ... end
-# effect_frames(target)
+# effect_framples(target)
#
# effects_squelch_channel(amount, size, snd, chn)
# effects_echo(input_samps, delay_time, echo_amoung, beg, dur, snd, chn)
@@ -21,7 +21,7 @@
# effects_zecho_1(scaler, secs, frq, amp, input_samps, beg, dur, snd, chn)
#
# effects_comb_filter(scaler, size, beg, dur, snd, chn)
-# effects_comb_chord(scaler, size, amp, interval_one, interval_two, beg, dur, snd, chn)
+# effects_comb_chord(scaler, size, amp, interval_one, interval_two, b, d, s, c)
# effects_moog(freq, q, beg, dur, snd, chn)
#
# effects_bbp(freq, bw, beg, dur, snd, chn)
@@ -39,8 +39,6 @@
# effects_position_sound(mono_snd, pos, beg, dur, snd, chn)
# effects_flange(amount, speed, time, beg, dur, snd, chn)
# effects_cross_synthesis_1(cross_snd, amp, fftsize, r, beg, dur, snd, chn)
-#
-# Code:
require "clm"
require "env"
@@ -124,25 +122,26 @@ module Effects
sndlst, chnlst = (snc > 0 ? all_chans() : [[ssnd], [schn]])
sndlst.zip(chnlst) do |snd, chn|
dur = if target == :sound or target == :cursor
- frames(snd, chn) - 1
+ framples(snd, chn) - 1
elsif target == :selection and selection?
- selection_position + selection_frames
+ selection_position + selection_framples
else
ms[1]
end
if sync(snd) == snc
- map_chan(func.call(dur - beg), beg, dur + overlap, origin_func.call(dur - beg), snd, chn)
+ map_chan(func.call(dur - beg),
+ beg, dur + overlap, origin_func.call(dur - beg), snd, chn)
end
end
end
end
- def effect_frames(target)
+ def effect_framples(target)
case target
when :sound
- frames() - 1
+ framples() - 1
when :selection
- selection_frames
+ selection_framples
else
if ms = plausible_mark_samples
y = ms.shift
@@ -175,15 +174,17 @@ module Effects
f0 = make_moving_average(size)
f1 = make_moving_average(size, :initial_element, 1.0)
map_channel(lambda do |y|
- y * moving_average(f1, ((moving_average(f0, y * y) < amount) ? 0.0 : 1.0))
- end, 0, false, snd, chn, false, format("%s(%s, %s", get_func_name, amount, size))
+ y * moving_average(f1,
+ ((moving_average(f0, y * y) < amount) ? 0.0 : 1.0))
+ end, 0, false, snd, chn, false,
+ format("%s(%s, %s", get_func_name, amount, size))
end
def effects_echo(input_samps, delay_time, echo_amount,
beg = 0, dur = false, snd = false, chn = false)
del = make_delay((delay_time.to_f * srate(snd)).round)
samp = 0
- samps = (input_samps or dur or frames(snd, chn))
+ samps = (input_samps or dur or framples(snd, chn))
amp = echo_amount
map_channel_rb(beg, dur, snd, chn, false,
format("%s(%s, %s, %s, %s, %s",
@@ -196,16 +197,18 @@ module Effects
def effects_flecho_1(scaler, secs, input_samps,
beg = 0, dur = false, snd = false, chn = false)
- flt = make_fir_filter(:order, 4, :xcoeffs, [0.125, 0.25, 0.25, 0.125].to_vct)
+ flt = make_fir_filter(:order, 4, :xcoeffs, vct(0.125, 0.25, 0.25, 0.125))
del = make_delay((secs.to_f * srate(snd)).round)
samp = 0
- samps = (input_samps or dur or frames(snd, chn))
+ samps = (input_samps or dur or framples(snd, chn))
amp = scaler
map_channel_rb(beg, dur, snd, chn, false,
format("%s(%s, %s, %s, %s, %s",
- get_func_name, scaler, secs, input_samps, beg, dur)) do |inval|
+ get_func_name, scaler, secs,
+ input_samps, beg, dur)) do |inval|
samp += 1
- inval + delay(del, fir_filter(flt, amp * (tap(del) + ((samp <= samps) ? inval : 0.0))))
+ inval + delay(del, fir_filter(flt,
+ amp * (tap(del) + ((samp <= samps) ? inval : 0.0))))
end
end
@@ -215,21 +218,25 @@ module Effects
len = (secs.to_f * srate()).round
del = make_delay(len, :max_size, (len + amp + 1).to_i)
samp = 0
- samps = (input_samps or dur or frames(snd, chn))
+ samps = (input_samps or dur or framples(snd, chn))
map_channel_rb(beg, dur, snd, chn, false,
format("%s(%s, %s, %s, %s, %s, %s, %s",
get_func_name, scaler, secs, frq,
amp, input_samps, beg, dur)) do |inval|
samp += 1
- inval + delay(del, amp * (tap(del) + ((samp <= samps) ? inval : 0.0)), amp * oscil(os))
+ inval + delay(del,
+ amp * (tap(del) + ((samp <= samps) ? inval : 0.0)),
+ amp * oscil(os))
end
end
- def effects_comb_filter(scaler, size, beg = 0, dur = false, snd = false, chn = false)
+ def effects_comb_filter(scaler, size, beg = 0, dur = false,
+ snd = false, chn = false)
delay_line = Vct.new(size)
delay_loc = 0
map_channel_rb(beg, dur, snd, chn, false,
- format("%s(%s, %s, %s, %s", get_func_name, scaler, size, beg, dur)) do |inval|
+ format("%s(%s, %s, %s, %s",
+ get_func_name, scaler, size, beg, dur)) do |inval|
result = delay_line[delay_loc]
delay_line[delay_loc] = inval + scaler * result
delay_loc += 1
@@ -254,7 +261,8 @@ module Effects
def effects_moog(freq, q, beg = 0, dur = false, snd = false, chn = false)
gen = make_moog_filter(freq, q)
map_channel_rb(beg, dur, snd, chn, false,
- format("%s(%s, %s, %s, %s", get_func_name, freq, q, beg, dur)) do |inval|
+ format("%s(%s, %s, %s, %s",
+ get_func_name, freq, q, beg, dur)) do |inval|
moog_filter(gen, inval)
end
end
@@ -285,20 +293,27 @@ module Effects
def effects_am(freq, en, beg = 0, dur = false, snd = false, chn = false)
os = make_oscil(:frequency, freq)
- e = (en and make_env(:envelope, en, :length, (dur or frames(snd, chn))))
+ e = (en and make_env(:envelope, en, :length, (dur or framples(snd, chn))))
func = if e
- lambda do |inval| amplitude_modulate(1.0, inval, env(e) * oscil(os)) end
+ lambda do |inval|
+ amplitude_modulate(1.0, inval, env(e) * oscil(os))
+ end
else
- lambda do |inval| amplitude_modulate(1.0, inval, oscil(os)) end
+ lambda do |inval|
+ amplitude_modulate(1.0, inval, oscil(os))
+ end
end
map_channel(func, beg, dur, snd, chn, false,
format("%s(%s, %s, %s, %s",
- get_func_name, freq, (en ? en.inspect : "false"), beg, dur))
+ get_func_name, freq,
+ (en ? en.inspect : "false"), beg, dur))
end
- def effects_rm(freq, gliss_env, beg = 0, dur = false, snd = false, chn = false)
+ def effects_rm(freq, gliss_env, beg = 0, dur = false,
+ snd = false, chn = false)
os = make_oscil(:frequency, freq)
- e = (gliss_env and make_env(:envelope, gliss_env, :length, (dur or frames(snd, chn))))
+ e = (gliss_env and make_env(:envelope, gliss_env,
+ :length, (dur or framples(snd, chn))))
func = if e
lambda do |inval| inval * env(e) * oscil(os) end
else
@@ -306,13 +321,14 @@ module Effects
end
map_channel(func, beg, dur, snd, chn, false,
format("%s(%s, %s, %s, %s",
- get_func_name, freq, (gliss_env ? gliss_env.inspect : "false"), beg, dur))
+ get_func_name, freq,
+ (gliss_env ? gliss_env.inspect : "false"), beg, dur))
end
def effects_cnv(snd0, amp, snd = false, chn = false)
snd0 = Snd.snd
- flt_len = frames(snd0)
- total_len = flt_len + frames(snd, chn)
+ flt_len = framples(snd0)
+ total_len = flt_len + framples(snd, chn)
cnv = make_convolve(:filter, channel2vct, 0, flt_len, snd0)
sf = make_sampler(0, snd, chn)
out_data = Vct.new(total_len) do |i|
@@ -344,7 +360,9 @@ module Effects
allpass_sum = all_pass(allpass3,
all_pass(allpass2,
all_pass(allpass1,
- (samp < input_samps ? inval : 0.0))))
+ (samp < input_samps ?
+ inval :
+ 0.0))))
samp += 1
comb_sum_2 = comb_sum_1
comb_sum_1 = comb_sum
@@ -354,16 +372,18 @@ module Effects
end
end
- def effects_jc_reverb_1(volume, beg = 0, dur = false, snd = false, chn = false)
- map_channel(effects_jc_reverb((dur or frames(snd, chn)), volume),
+ def effects_jc_reverb_1(volume, beg = 0, dur = false,
+ snd = false, chn = false)
+ map_channel(effects_jc_reverb((dur or framples(snd, chn)), volume),
beg, dur, snd, chn, false,
format("%s(%s, %s, %s", get_func_name, volume, beg, dur))
end
- def effects_hello_dentist(frq, amp, beg = 0, dur = false, snd = false, chn = false)
+ def effects_hello_dentist(frq, amp, beg = 0, dur = false,
+ snd = false, chn = false)
rn = make_rand_interp(:frequency, frq, :amplitude, amp)
i = j = 0
- len = (dur or frames(snd, chn))
+ len = (dur or framples(snd, chn))
in_data = channel2vct(beg, len, snd, chn)
out_len = (len.to_f * (1.0 + 2.0 * amp)).round
out_data = make_vct(out_len)
@@ -378,14 +398,16 @@ module Effects
end
vct2channel(out_data, beg, j, snd, chn, false,
format("%s(%s, %s, %s, %s",
- get_func_name, frq, amp, beg, (len == frames(snd, chn) ? "false" : len)))
+ get_func_name, frq, amp, beg,
+ (len == framples(snd, chn) ? "false" : len)))
end
- def effects_fp(srf, osamp, osfrq, beg = 0, dur = false, snd = false, chn = false)
+ def effects_fp(srf, osamp, osfrq, beg = 0, dur = false,
+ snd = false, chn = false)
os = make_oscil(:frequency, osfrq)
sr = make_src(:srate, srf)
sf = make_sampler(beg)
- len = (dur or frames(snd, chn))
+ len = (dur or framples(snd, chn))
out_data = Vct.new(len) do |i|
src(sr, osamp * oscil(os),
lambda do |dir|
@@ -400,17 +422,20 @@ module Effects
vct2channel(out_data, beg, len, snd, chn, false,
format("%s(%s, %s, %s, %s, %s",
get_func_name, srf, osamp, osfrq, beg,
- (len == frames(snd, chn) ? "false" : len)))
+ (len == framples(snd, chn) ? "false" : len)))
end
- def effects_position_sound(mono_snd, pos, beg = 0, dur = false, snd = false, chn = false)
- assert_type((sound?(mono_snd) or mono_snd == false), mono_snd, 0, "a sound index")
+ def effects_position_sound(mono_snd, pos, beg = 0, dur = false,
+ snd = false, chn = false)
+ assert_type((sound?(mono_snd) or mono_snd == false),
+ mono_snd, 0, "a sound index")
assert_type((array?(pos) or number?(pos)), pos, 1, "an array or a number")
- len = frames(mono_snd)
+ len = framples(mono_snd)
reader1 = make_sampler(0, mono_snd)
if number?(pos)
map_channel_rb(0, len, snd, chn, false,
- format("%s(%s, %s", get_func_name, mono_snd, pos)) do |inval|
+ format("%s(%s, %s",
+ get_func_name, mono_snd, pos)) do |inval|
inval + pos * read_sample(reader1)
end
else
@@ -418,12 +443,14 @@ module Effects
e1 = make_env(:envelope, pos, :length, len)
if number?(chn) and chn == 1
map_channel(0, len, snd, chn, false,
- format("%s(%s, %s", get_func_name, mono_snd, pos.inspect)) do |inval|
+ format("%s(%s, %s",
+ get_func_name, mono_snd, pos.inspect)) do |inval|
inval + env(e1) * read_sample(reader1)
end
else
map_channel(0, len, snd, chn, false,
- format("%s(%s, %s", get_func_name, mono_snd, pos.inspect)) do |inval|
+ format("%s(%s, %s",
+ get_func_name, mono_snd, pos.inspect)) do |inval|
inval + (1.0 - env(e1)) * read_sample(reader1)
end
end
@@ -431,7 +458,8 @@ module Effects
end
end
- def effects_flange(amount, speed, time, beg = 0, dur = false, snd = false, chn = false)
+ def effects_flange(amount, speed, time, beg = 0, dur = false,
+ snd = false, chn = false)
ri = make_rand_interp(:frequency, speed, :amplitude, amount)
len = (time.to_f * srate(snd)).round
del = make_delay(:size, len, :max_size, (len + amount + 1).round)
@@ -439,7 +467,8 @@ module Effects
format("%s(%s, %s, %s, %s, %s",
get_func_name, amount, speed, time, beg,
(number?(dur) and
- (not dur == frames(snd, chn)) ? dur : "false"))) do |inval|
+ (not dur == framples(snd, chn)) ?
+ dur : "false"))) do |inval|
0.75 * (inval + delay(del, inval, rand_interp(ri)))
end
end
@@ -487,7 +516,9 @@ module X_Effects
frame = dlg.add_frame([RXmNheight, 200])
dlg.add_target() do |t| target_body.call(t) end
activate_dialog(dlg.dialog)
- make_xenved(name, frame, :envelope, [0.0, 1.0, 1.0, 1.0], :axis_bounds, [0.0, 1.0, 0.0, 1.0])
+ make_xenved(name, frame,
+ :envelope, [0.0, 1.0, 1.0, 1.0],
+ :axis_bounds, [0.0, 1.0, 0.0, 1.0])
end
def set_log_value(slider, minval, init, maxval)
@@ -503,7 +534,9 @@ module X_Effects
frame = dlg.parent
activate_dialog(dlg.dialog)
dlg.add_target() do |t| target_body.call(t) end
- make_xenved(name, frame, :envelope, [0.0, 1.0, 1.0, 1.0], :axis_bounds, [0.0, 1.0, 0.0, 1.0])
+ make_xenved(name, frame,
+ :envelope, [0.0, 1.0, 1.0, 1.0],
+ :axis_bounds, [0.0, 1.0, 0.0, 1.0])
end
def set_log_value(slider, minval, init, maxval)
@@ -511,7 +544,8 @@ module X_Effects
end
def get_log_value(wid, info, minval, maxval)
- scale_linear2log(minval, Rgtk_adjustment_get_value(RGTK_ADJUSTMENT(wid)), maxval)
+ scale_linear2log(minval,
+ Rgtk_adjustment_get_value(RGTK_ADJUSTMENT(wid)), maxval)
end
end
@@ -536,13 +570,14 @@ module X_Effects
init_amount = 1.0
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the gain scaling amount",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
- set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
- end) do |w, c, i|
- with_env = ((@envelope.envelope != [0.0, 1.0, 1.0, 1.0]) and @envelope.scale(@amount))
+ :info, "Move the slider to change the gain scaling amount",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
+ set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
+ end) do |w, c, i|
+ with_env = ((@envelope.envelope != [0.0, 1.0, 1.0, 1.0]) and
+ @envelope.scale(@amount))
case @target
when :sound
with_env ? env_sound(with_env) : scale_by(@amount)
@@ -561,15 +596,15 @@ module X_Effects
len = false
if selection?
pos = selection_position
- len = selection_frames
+ len = selection_framples
end
set_selection_member?(false)
set_selection_position(pts[0])
- set_selection_frames(pts[1] - pts[0])
+ set_selection_framples(pts[1] - pts[0])
scale_selection_by(@amount)
if integer?(pos)
set_selection_position(pos)
- set_selection_frames(len)
+ set_selection_framples(len)
else
set_selection_member?(false)
end
@@ -577,7 +612,8 @@ module X_Effects
end
end
end
- sliders[0] = @dlg.add_slider("gain", 0.0, init_amount, 5.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("gain",
+ 0.0, init_amount, 5.0, 100) do |w, c, i|
@amount = get_scale_value(w, i, 100.0)
end
@envelope = make_enved_widget(@label, @dlg) do |t|
@@ -606,42 +642,46 @@ module X_Effects
init_amount = 1.0
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Normalize scales amplitude to the normalize amount. \
+ :info, "Normalize scales amplitude to the normalize amount. \
Move the slider to change the scaling amount.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
+ end) do |w, c, i|
case @target
when :sound
scale_to(@amount)
when :selection
- selection? ? scale_selection_to(@amount) : snd_warning("no selection")
+ selection? ? scale_selection_to(@amount) :
+ snd_warning("no selection")
else
if pts = plausible_mark_samples
pos = false
len = false
if selection?
pos = selection_position
- len = selection_frames
+ len = selection_framples
end
set_selection_member?(false)
set_selection_position(pts[0])
- set_selection_frames(pts[1] - pts[0])
+ set_selection_framples(pts[1] - pts[0])
scale_selection_to(@amount)
if integer?(pos)
set_selection_position(pos)
- set_selection_frames(len)
+ set_selection_framples(len)
else
set_selection_member?(false)
end
end
end
end
- sliders[0] = @dlg.add_slider("normalize", 0.0, init_amount, 1.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("normalize",
+ 0.0, init_amount, 1.0, 100) do |w, c, i|
@amount = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -664,21 +704,25 @@ Move the slider to change the scaling amount.",
init_amount = 0.01
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the gate intensity. \
+ :info, "Move the slider to change the gate intensity. \
Higher values gate more of the sound.",
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @amount = init_amount, 1000.0)
- end) do |w, c, i|
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @amount = init_amount, 1000.0)
+ end) do |w, c, i|
if (snc = sync()) > 0
sndlst, chnlst = all_chans()
sndlst.zip(chnlst) do |snd, chn|
- effects_squelch_channel(@amount * @amount, @size, snd, chn) if sync(snd) == snc
+ if sync(snd) == snc
+ effects_squelch_channel(@amount * @amount, @size, snd, chn)
+ end
end
else
- effects_squelch_channel(@amount * @amount, @size, selected_sound, selected_channel)
+ effects_squelch_channel(@amount * @amount, @size,
+ selected_sound, selected_channel)
end
end
- sliders[0] = @dlg.add_slider("gate", 0.0, init_amount, 0.1, 1000) do |w, c, i|
+ sliders[0] = @dlg.add_slider("gate",
+ 0.0, init_amount, 0.1, 1000) do |w, c, i|
@amount = get_scale_value(w, i, 1000.0)
end
end
@@ -709,19 +753,21 @@ Higher values gate more of the sound.",
init_amount = 0.2
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "The sliders change the delay time and echo amount.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @delay_time = init_delay_time, 100.0)
- set_scale_value(sliders[1].scale, @amount = init_amount, 100.0)
- end) do |w, c, i|
+ :info, "The sliders change the delay time and echo amount.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @delay_time = init_delay_time,
+ 100.0)
+ set_scale_value(sliders[1].scale, @amount = init_amount, 100.0)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target,
(!@truncate and 4 * @delay_time),
- lambda { |s|
+ lambda do |s|
format("effects_echo(%s, %s, %s",
- (@target == :sound ? false : s),
+ (@target == :sound ?
+ false : s),
@delay_time, @amount)
- }) do |s|
+ end) do |s|
size = (@delay_time * srate()).round
d = make_delay(size)
samp = 0
@@ -736,13 +782,18 @@ Higher values gate more of the sound.",
end
end
end
- sliders[0] = @dlg.add_slider("delay time", 0.0, init_delay_time, 2.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("delay time",
+ 0.0, init_delay_time,
+ 2.0, 100) do |w, c, i|
@delay_time = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("echo amount", 0.0, init_amount, 1.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("echo amount",
+ 0.0, init_amount, 1.0, 100) do |w, c, i|
@amount = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
@dlg.add_toggle() do |t| @truncate = t end
end
activate_dialog(@dlg.dialog)
@@ -764,13 +815,16 @@ Higher values gate more of the sound.",
end
def flecho_1(scaler, secs, input_samps)
- flt = make_fir_filter(:order, 4, :xcoeffs, [0.125, 0.25, 0.25, 0.125].to_vct)
+ flt = make_fir_filter(:order, 4, :xcoeffs, vct(0.125, 0.25, 0.25, 0.125))
del = make_delay((secs.to_f * srate(snd)).round)
samp = 0
lambda do |inval|
samp += 1
inval + delay(del,
- fir_filter(flt, scaler * (tap(del) + (samp <= input_samps ? inval : 0.0))))
+ fir_filter(flt,
+ scaler *
+ (tap(del) +
+ (samp <= input_samps ? inval : 0.0))))
end
end
@@ -780,29 +834,37 @@ Higher values gate more of the sound.",
init_del = 0.9
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "Move the sliders to the filter scaler and the \
+ :info, "Move the sliders to the filter scaler and the \
delay time in seconds.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @scaler = init_scaler, 100.0)
- set_scale_value(sliders[1].scale, @delay = init_del, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @scaler = init_scaler, 100.0)
+ set_scale_value(sliders[1].scale, @delay = init_del, 100.0)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target,
(!@truncate and 4 * @delay),
- lambda { |s|
+ lambda do |s|
format("effects_flecho_1(%s, %s, %s",
- @scaler, @delay, (@target == :sound ? false : s))
- }) do |s|
+ @scaler, @delay,
+ (@target == :sound ?
+ false : s))
+ end) do |s|
flecho_1(@scaler, @delay, s)
end
end
- sliders[0] = @dlg.add_slider("filter scaler", 0.0, init_scaler, 1.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("filter scaler",
+ 0.0, init_scaler,
+ 1.0, 100) do |w, c, i|
@scaler = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("delay time (secs)", 0.0, init_del, 3.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("delay time (secs)",
+ 0.0, init_del,
+ 3.0, 100) do |w, c, i|
@delay = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
@dlg.add_toggle() do |t| @truncate = t end
end
activate_dialog(@dlg.dialog)
@@ -822,7 +884,8 @@ delay time in seconds.",
end
def inspect
- format("%s (%1.2f %1.2f %1.2f %1.2f)", @label, @scaler, @delay, @freq, @amp)
+ format("%s (%1.2f %1.2f %1.2f %1.2f)",
+ @label, @scaler, @delay, @freq, @amp)
end
def zecho_1(scaler, secs, frq, amp, input_samps)
@@ -833,7 +896,8 @@ delay time in seconds.",
lambda do |inval|
samp += 1
inval + delay(del,
- scaler * (tap(del) + (samp <= input_samps ? inval : 0.0)), amp * oscil(os))
+ scaler * (tap(del) + (samp <= input_samps ? inval : 0.0)),
+ amp * oscil(os))
end
end
@@ -845,30 +909,32 @@ delay time in seconds.",
init_amp = 10.0
sliders = Array.new(4)
@dlg = make_dialog(@label,
- :info, "Move the sliders to set the echo scaler, \
+ :info, "Move the sliders to set the echo scaler, \
the delay time in seconds, the modulation frequency, and the echo amplitude.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @scaler = init_scaler, 100.0)
- set_scale_value(sliders[1].scale, @delay = init_del, 100.0)
- set_scale_value(sliders[2].scale, @freq = init_freq, 100.0)
- set_scale_value(sliders[3].scale, @amp = init_amp, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @scaler = init_scaler, 100.0)
+ set_scale_value(sliders[1].scale, @delay = init_del, 100.0)
+ set_scale_value(sliders[2].scale, @freq = init_freq, 100.0)
+ set_scale_value(sliders[3].scale, @amp = init_amp, 100.0)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target,
(!@truncate and 4 * @delay),
- lambda { |s|
+ lambda do |s|
format("effects_zecho_1(%s, %s, %s, %s, %s",
@scaler, @delay, @freq, @amp,
- (@target == :sound ? false : s))
- }
- ) do |s|
+ (@target == :sound ?
+ false : s))
+ end) do |s|
zecho_1(@scaler, @delay, @freq, @amp, s)
end
end
- sliders[0] = @dlg.add_slider("echo scaler", 0.0, init_scaler, 1.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("echo scaler",
+ 0.0, init_scaler, 1.0, 100) do |w, c, i|
@scaler = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("delay time (secs)", 0.0, init_del, 3.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("delay time (secs)",
+ 0.0, init_del, 3.0, 100) do |w, c, i|
@delay = get_scale_value(w, i, 100.0)
end
sliders[2] = @dlg.add_slider("modulation frequency",
@@ -879,7 +945,9 @@ the delay time in seconds, the modulation frequency, and the echo amplitude.",
0.0, init_amp, 100.0, 100) do |w, c, i|
@amp = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
@dlg.add_toggle() do |t| @truncate = t end
end
activate_dialog(@dlg.dialog)
@@ -908,13 +976,13 @@ the delay time in seconds, the modulation frequency, and the echo amplitude.",
init_bw = 100
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "Butterworth band-pass filter. \
+ :info, "Butterworth band-pass filter. \
Move the slider to change the center frequency and bandwidth.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_log_value(sliders[0], 20, @freq = init_freq, 22050)
- set_scale_value(sliders[1].scale, @bw = init_bw)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_log_value(sliders[0], 20, @freq = init_freq, 22050)
+ set_scale_value(sliders[1].scale, @bw = init_bw)
+ end) do |w, c, i|
flt = make_butter_band_pass(@freq, @bw)
case @target
when :sound
@@ -927,11 +995,12 @@ Move the slider to change the center frequency and bandwidth.",
bg = ms[0]
nd = ms[1] - ms[0] + 1
clm_channel(flt, bg, nd, false, false, false, false,
- format("effects_bbp(%s, %s, %s, %s", @freq, @bw, bg, nd))
+ format("effects_bbp(%s, %s, %s, %s",
+ @freq, @bw, bg, nd))
end
end
- sliders[0] = @dlg.add_slider("center frequency", 20, init_freq, 22050, 1,
- :log) do |w, c, i|
+ sliders[0] = @dlg.add_slider("center frequency",
+ 20, init_freq, 22050, 1, :log) do |w, c, i|
@freq = get_log_value(w, i, 20, 22050)
end
sliders[1] = @dlg.add_slider("bandwidth", 0, init_bw, 1000) do |w, c, i|
@@ -965,13 +1034,13 @@ Move the slider to change the center frequency and bandwidth.",
init_bw = 100
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "Butterworth band-reject filter. \
+ :info, "Butterworth band-reject filter. \
Move the slider to change the center frequency and bandwidth.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_log_value(sliders[0], 20, @freq = init_freq, 22050)
- set_scale_value(sliders[1].scale, @bw = init_bw)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_log_value(sliders[0], 20, @freq = init_freq, 22050)
+ set_scale_value(sliders[1].scale, @bw = init_bw)
+ end) do |w, c, i|
flt = make_butter_band_reject(@freq, @bw)
case @target
when :sound
@@ -984,7 +1053,8 @@ Move the slider to change the center frequency and bandwidth.",
bg = ms[0]
nd = ms[1] - ms[0] + 1
clm_channel(flt, bg, nd, false, false, false, false,
- format("effects_bbr(%s, %s, %s, %s", @freq, @bw, bg, nd))
+ format("effects_bbr(%s, %s, %s, %s",
+ @freq, @bw, bg, nd))
end
end
sliders[0] = @dlg.add_slider("center frequency",
@@ -1020,12 +1090,12 @@ Move the slider to change the center frequency and bandwidth.",
init_freq = 100
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Butterworth high-pass filter. \
+ :info, "Butterworth high-pass filter. \
Move the slider to change the high-pass cutoff frequency.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_log_value(sliders[0], 20, @freq = init_freq, 22050)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_log_value(sliders[0], 20, @freq = init_freq, 22050)
+ end) do |w, c, i|
flt = make_butter_high_pass(@freq)
case @target
when :sound
@@ -1071,12 +1141,12 @@ Move the slider to change the high-pass cutoff frequency.",
init_freq = 1000
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Butterworth low-pass filter. \
+ :info, "Butterworth low-pass filter. \
Move the slider to change the low-pass cutoff frequency.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_log_value(sliders[0], 20, @freq = init_freq, 22050)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_log_value(sliders[0], 20, @freq = init_freq, 22050)
+ end) do |w, c, i|
flt = make_butter_low_pass(@freq)
case @target
when :sound
@@ -1124,26 +1194,30 @@ Move the slider to change the low-pass cutoff frequency.",
init_size = 50
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the comb scaler and size.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @scaler = init_scaler, 100.0)
- set_scale_value(sliders[1].scale, @size = init_size)
- end) do |w, c, i|
+ :info, "Move the slider to change the comb scaler and size.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @scaler = init_scaler, 100.0)
+ set_scale_value(sliders[1].scale, @size = init_size)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target, false,
- lambda { |s|
- format("effects_comb_filter(%s, %s", @scaler, @size)
- }) do |ignored|
+ lambda do |s|
+ format("effects_comb_filter(%s, %s",
+ @scaler, @size)
+ end) do |ignored|
comb_filter(@scaler, @size)
end
end
- sliders[0] = @dlg.add_slider("scaler", 0.0, init_scaler, 1.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("scaler",
+ 0.0, init_scaler, 1.0, 100) do |w, c, i|
@scaler = get_scale_value(w, i, 100.0)
end
sliders[1] = @dlg.add_slider("size", 1, init_size, 100) do |w, c, i|
@size = get_scale_value(w, i)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -1175,42 +1249,49 @@ Move the slider to change the low-pass cutoff frequency.",
init_two = 1.20
sliders = Array.new(5)
@dlg = make_dialog(@label,
- :info, "Comb chord filter:
+ :info, "Comb chord filter:
Creates chords by using filters at harmonically related sizes. \
Move the sliders to set the comb chord parameters.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @scaler = init_scaler, 100.0)
- set_scale_value(sliders[1].scale, @size = init_size)
- set_scale_value(sliders[2].scale, @amp = init_amp, 100.0)
- set_scale_value(sliders[3].scale, @interval_one = init_one, 100.0)
- set_scale_value(sliders[4].scale, @interval_two = init_two, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @scaler = init_scaler, 100.0)
+ set_scale_value(sliders[1].scale, @size = init_size)
+ set_scale_value(sliders[2].scale, @amp = init_amp, 100.0)
+ set_scale_value(sliders[3].scale, @interval_one = init_one, 100.0)
+ set_scale_value(sliders[4].scale, @interval_two = init_two, 100.0)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target, false,
- lambda { |s|
+ lambda do |s|
format("effects_comb_chord(%s, %s, %s, %s, %s",
@scaler, @size, @amp,
@interval_one, @interval_two)
- }) do |ignored|
+ end) do |ignored|
comb_chord(@scaler, @size, @amp, @interval_one, @interval_two)
end
end
- sliders[0] = @dlg.add_slider("chord scaler", 0.0, init_scaler, 1.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("chord scaler",
+ 0.0, init_scaler, 1.0, 100) do |w, c, i|
@scaler = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("chord size", 1, init_size, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("chord size",
+ 1, init_size, 100) do |w, c, i|
@size = get_scale_value(w, i)
end
- sliders[2] = @dlg.add_slider("amplitude", 0.0, init_amp, 1.0, 100) do |w, c, i|
+ sliders[2] = @dlg.add_slider("amplitude",
+ 0.0, init_amp, 1.0, 100) do |w, c, i|
@amp = get_scale_value(w, i, 100.0)
end
- sliders[3] = @dlg.add_slider("interval one", 0.0, init_one, 2.0, 100) do |w, c, i|
+ sliders[3] = @dlg.add_slider("interval one",
+ 0.0, init_one, 2.0, 100) do |w, c, i|
@interval_one = get_scale_value(w, i, 100.0)
end
- sliders[4] = @dlg.add_slider("interval two", 0.0, init_two, 2.0, 100) do |w, c, i|
+ sliders[4] = @dlg.add_slider("interval two",
+ 0.0, init_two, 2.0, 100) do |w, c, i|
@interval_two = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -1235,19 +1316,20 @@ Move the sliders to set the comb chord parameters.",
init_resonance = 0.5
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "Moog filter:
+ :info, "Moog filter:
Moog-style 4-pole lowpass filter with 24db/oct rolloff and variable resonance. \
Move the sliders to set the filter cutoff frequency and resonance.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_log_value(sliders[0], 20, @cutoff = init_freq, 22050)
- set_scale_value(sliders[1].scale, @resonance = init_resonance, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_log_value(sliders[0], 20, @cutoff = init_freq, 22050)
+ set_scale_value(sliders[1].scale,
+ @resonance = init_resonance, 100.0)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target, false,
- lambda { |s|
+ lambda do |s|
format("effects_moog(%s, %s",
@cutoff_freq, @resonance)
- }) do |ignored|
+ end) do |ignored|
moog(@cutoff_freq, @resonance)
end
end
@@ -1255,10 +1337,13 @@ Move the sliders to set the filter cutoff frequency and resonance.",
20, init_freq, 22050, 1, :log) do |w, c, i|
@cutoff_freq = get_log_value(w, i, 20, 22050)
end
- sliders[1] = @dlg.add_slider("resonance", 0.0, init_resonance, 1.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("resonance",
+ 0.0, init_resonance, 1.0, 100) do |w, c, i|
@resonance = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -1284,15 +1369,15 @@ Move the sliders to set the filter cutoff frequency and resonance.",
init_size = 4
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the saturation scaling factor.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @size = init_size)
- end) do |w, c, i|
+ :info, "Move the slider to change the saturation scaling factor.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @size = init_size)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target, false,
- lambda { |s|
+ lambda do |s|
format("adsat(%s", @size)
- }) do |ignored|
+ end) do |ignored|
mn = 0.0
mx = 0.0
n = 0
@@ -1318,10 +1403,13 @@ Move the sliders to set the filter cutoff frequency and resonance.",
end
end
end
- sliders[0] = @dlg.add_slider("adaptive saturation size", 0, init_size, 10) do |w, c, i|
+ sliders[0] = @dlg.add_slider("adaptive saturation size",
+ 0, init_size, 10) do |w, c, i|
@size = get_scale_value(w, i).round
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -1344,12 +1432,12 @@ Move the sliders to set the filter cutoff frequency and resonance.",
init_amount = 0.0
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the sample rate. \
+ :info, "Move the slider to change the sample rate. \
Values greater than 1.0 speed up file play, negative values reverse it.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
+ end) do |w, c, i|
case @target
when :sound
src_sound(@amount)
@@ -1357,7 +1445,8 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
selection? ? src_selection(@amount) : snd_warning("no selection")
end
end
- sliders[0] = @dlg.add_slider("sample rate", -2.0, init_amount, 2.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("sample rate",
+ -2.0, init_amount, 2.0, 100) do |w, c, i|
@amount = get_scale_value(w, i, 100.0)
end
@dlg.add_target([["entire sound", :sound, true],
@@ -1394,15 +1483,16 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
pitch_scale = 1.0
sliders = Array.new(5)
@dlg = make_dialog(@label,
- :info, "Move the sliders to change the time/pitch scaling parameters.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @time_scale = time_scale, 100.0)
- set_scale_value(sliders[1].scale, @hop_size = hop_size, 100.0)
- set_scale_value(sliders[2].scale, @segment_length = seg_length, 100.0)
- set_scale_value(sliders[3].scale, @ramp_scale = ramp_scale, 100.0)
- set_scale_value(sliders[4].scale, @pitch_scale = pitch_scale, 100.0)
- end) do |w, c, i|
+ :info, "Move the sliders to change the time/pitch scaling params.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @time_scale = time_scale, 100.0)
+ set_scale_value(sliders[1].scale, @hop_size = hop_size, 100.0)
+ set_scale_value(sliders[2].scale,
+ @segment_length = seg_length, 100.0)
+ set_scale_value(sliders[3].scale, @ramp_scale = ramp_scale, 100.0)
+ set_scale_value(sliders[4].scale, @pitch_scale = pitch_scale, 100.0)
+ end) do |w, c, i|
snd = selected_sound
save_controls(snd)
reset_controls(snd)
@@ -1424,22 +1514,29 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
end
restore_controls(snd)
end
- sliders[0] = @dlg.add_slider("time scale", 0.0, time_scale, 5.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("time scale",
+ 0.0, time_scale, 5.0, 100) do |w, c, i|
@time_scale = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("hop size", 0.0, hop_size, 1.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("hop size",
+ 0.0, hop_size, 1.0, 100) do |w, c, i|
@hop_size = get_scale_value(w, i, 100.0)
end
- sliders[2] = @dlg.add_slider("segment length", 0.0, seg_length, 0.5, 100) do |w, c, i|
+ sliders[2] = @dlg.add_slider("segment length",
+ 0.0, seg_length, 0.5, 100) do |w, c, i|
@segment_length = get_scale_value(w, i, 100.0)
end
- sliders[3] = @dlg.add_slider("ramp scale", 0.0, ramp_scale, 0.5, 1000) do |w, c, i|
+ sliders[3] = @dlg.add_slider("ramp scale",
+ 0.0, ramp_scale, 0.5, 1000) do |w, c, i|
@ramp_scale = get_scale_value(w, i, 100.0)
end
- sliders[4] = @dlg.add_slider("pitch scale", 0.0, pitch_scale, 5.0, 100) do |w, c, i|
+ sliders[4] = @dlg.add_slider("pitch scale",
+ 0.0, pitch_scale, 5.0, 100) do |w, c, i|
@pitch_scale = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -1464,12 +1561,12 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
init_scale = 1.0
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the src-timevar scaling amount.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
- set_scale_value(sliders[0].scale, @scale = init_scale, 100.0)
- end) do |w, c, i|
+ :info, "Move the slider to change the src-timevar scaling amount.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
+ set_scale_value(sliders[0].scale, @scale = init_scale, 100.0)
+ end) do |w, c, i|
env = @envelope.scale(@scale)
case @target
when :sound
@@ -1488,7 +1585,8 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
end
end
end
- sliders[0] = @dlg.add_slider("resample factor", 0.0, init_scale, 10.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("resample factor",
+ 0.0, init_scale, 10.0, 100) do |w, c, i|
@scale = get_scale_value(w, i, 100.0)
end
@envelope = make_enved_widget(@label, @dlg) do |t|
@@ -1521,22 +1619,25 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
init_amount = 100.0
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the modulation amount.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
- set_scale_value(sliders[0].scale, @amount = init_amount)
- end) do |w, c, i|
+ :info, "Move the slider to change the modulation amount.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
+ set_scale_value(sliders[0].scale, @amount = init_amount)
+ end) do |w, c, i|
need_env = (@envelope.envelope != [0.0, 1.0, 1.0, 1.0])
map_chan_over_target_with_sync(@target, false,
- lambda { |s|
+ lambda do |s|
format("effects_am(%s, %s",
@amount,
- ((need_env and @envelope.envelope) ?
- @envelope.envelope.inspect : "false"))
- }) do |ignored|
+ ((need_env and
+ @envelope.envelope) ?
+ @envelope.envelope.inspect :
+ "false"))
+ end) do |ignored|
os = make_oscil(@amount)
- e = (need_env and make_env(@envelope.envelope, :length, effect_frames(@target)))
+ e = (need_env and make_env(@envelope.envelope,
+ :length, effect_framples(@target)))
if need_env
lambda do |inval|
amplitude_modulate(1.0, inval, env(e) * oscil(os))
@@ -1548,7 +1649,8 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
end
end
end
- sliders[0] = @dlg.add_slider("amplitude modulation", 0.0, init_amount, 1000.0) do |w, c, i|
+ sliders[0] = @dlg.add_slider("amplitude modulation",
+ 0.0, init_amount, 1000.0) do |w, c, i|
@amount = get_scale_value(w, i)
end
@envelope = make_enved_widget(@label, @dlg) do |t|
@@ -1580,23 +1682,26 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
init_radians = 100
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "Move the sliders to change the modulation parameters.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
- set_scale_value(sliders[0].scale, @frequency = init_frequency)
- set_scale_value(sliders[1].scale, @radians = init_radians)
- end) do |w, c, i|
+ :info, "Move the sliders to change the modulation parameters.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
+ set_scale_value(sliders[0].scale, @frequency = init_frequency)
+ set_scale_value(sliders[1].scale, @radians = init_radians)
+ end) do |w, c, i|
need_env = (@envelope.envelope != [0.0, 1.0, 1.0, 1.0])
map_chan_over_target_with_sync(@target, false,
- lambda { |s|
+ lambda do |s|
format("effects_rm(%s, %s",
@frequency,
- ((need_env and @envelope.envelope) ?
- @envelope.envelope.inspect : "false"))
- }) do |ignored|
+ ((need_env and
+ @envelope.envelope) ?
+ @envelope.envelope.inspect :
+ "false"))
+ end) do |ignored|
os = make_oscil(@frequency)
- e = (need_env and make_env(@envelope.envelope, :length, effect_frames(@target)))
+ e = (need_env and make_env(@envelope.envelope,
+ :length, effect_framples(@target)))
if need_env
lambda do |inval| inval * (env(e) * oscil(os)) end
else
@@ -1604,10 +1709,12 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
end
end
end
- sliders[0] = @dlg.add_slider("modulation frequency", 0, init_frequency, 1000) do |w, c, i|
+ sliders[0] = @dlg.add_slider("modulation frequency",
+ 0, init_frequency, 1000) do |w, c, i|
@frequency = get_scale_value(w, i)
end
- sliders[1] = @dlg.add_slider("modulation radians", 0, init_radians, 360) do |w, c, i|
+ sliders[1] = @dlg.add_slider("modulation radians",
+ 0, init_radians, 360) do |w, c, i|
@radians = get_scale_value(w, i)
end
@envelope = make_enved_widget(@label, @dlg) do |t|
@@ -1643,15 +1750,15 @@ Values greater than 1.0 speed up file play, negative values reverse it.",
init_feedback = 1.09
sliders = Array.new(3)
@dlg = make_dialog(@label,
- :info, "Reverberator from Michael McNabb. \
+ :info, "Reverberator from Michael McNabb. \
Adds reverberation scaled by reverb amount, lowpass filtering, and feedback. \
Move the sliders to change the reverb parameters.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
- set_scale_value(sliders[1].scale, @filter = init_filter, 100.0)
- set_scale_value(sliders[2].scale, @feedback = init_feedback, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
+ set_scale_value(sliders[1].scale, @filter = init_filter, 100.0)
+ set_scale_value(sliders[2].scale, @feedback = init_feedback, 100.0)
+ end) do |w, c, i|
snd = selected_sound
save_controls(snd)
reset_controls(snd)
@@ -1668,16 +1775,21 @@ Move the sliders to change the reverb parameters.",
end
restore_controls(snd)
end
- sliders[0] = @dlg.add_slider("reverb amount", 0.0, init_amount, 1.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("reverb amount",
+ 0.0, init_amount, 1.0, 100) do |w, c, i|
@amount = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("reverb filter", 0.0, init_filter, 1.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("reverb filter",
+ 0.0, init_filter, 1.0, 100) do |w, c, i|
@filter = get_scale_value(w, i, 100.0)
end
- sliders[2] = @dlg.add_slider("reverb feedback", 0.0, init_feedback, 1.25, 100) do |w, c, i|
+ sliders[2] = @dlg.add_slider("reverb feedback",
+ 0.0, init_feedback, 1.25, 100) do |w, c, i|
@feedback = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -1703,27 +1815,32 @@ Move the sliders to change the reverb parameters.",
init_volume = 0.1
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "Nice reverb from John Chowning. \
+ :info, "Nice reverb from John Chowning. \
Move the sliders to change the reverb parameters.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @decay = init_decay, 100.0)
- set_scale_value(sliders[1].scale, @volume = init_volume, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @decay = init_decay, 100.0)
+ set_scale_value(sliders[1].scale, @volume = init_volume, 100.0)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target, (!@truncate and @decay),
- lambda { |s|
- format("effects_jc_reverb_1(%s, %s", s, @volume)
- }) do |s|
+ lambda do |s|
+ format("effects_jc_reverb_1(%s, %s",
+ s, @volume)
+ end) do |s|
effects_jc_reverb(s, @volume)
end
end
- sliders[0] = @dlg.add_slider("decay duration", 0.0, init_decay, 10.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("decay duration",
+ 0.0, init_decay, 10.0, 100) do |w, c, i|
@decay = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("reverb volume", 0.0, init_volume, 1.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("reverb volume",
+ 0.0, init_volume, 1.0, 100) do |w, c, i|
@volume = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
@dlg.add_toggle() do |t| @truncate = t end
end
activate_dialog(@dlg.dialog)
@@ -1750,7 +1867,7 @@ Move the sliders to change the reverb parameters.",
init_amp = 0.01
sliders = Array.new(3)
@dlg = make_dialog(@label,
- :info, "Very simple convolution. \
+ :info, "Very simple convolution. \
Move the sliders to set the numbers of the soundfiles to be convolved and the \
amount for the amplitude scaler.
@@ -1761,25 +1878,29 @@ The convolution data file typically defines a natural reverberation source, \
and the output from this effect can provide very striking reverb effects. \
You can find convolution data files on sites listed at \
http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data.",
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @sound_one = init_one)
- set_scale_value(sliders[1].scale, @sound_two = init_two)
- set_scale_value(sliders[2].scale, @amp = init_amp, 100.0)
- end) do |w, c, i|
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @sound_one = init_one)
+ set_scale_value(sliders[1].scale, @sound_two = init_two)
+ set_scale_value(sliders[2].scale, @amp = init_amp, 100.0)
+ end) do |w, c, i|
if sound?(@sound_one) and sound?(@sound_two)
effects_cnv(@sound_one, @sound_two, @amp)
else
snd_warning(format("sound-one: %s, sound-two: %s",
- sound?(@sound_one).to_s, sound?(@sound_two).to_s))
+ sound?(@sound_one).to_s,
+ sound?(@sound_two).to_s))
end
end
- sliders[0] = @dlg.add_slider("impulse response file", 0, init_one, 24) do |w, c, i|
+ sliders[0] = @dlg.add_slider("impulse response file",
+ 0, init_one, 24) do |w, c, i|
@sound_one = get_scale_value(w, i).round
end
- sliders[1] = @dlg.add_slider("sound file", 0, init_two, 24) do |w, c, i|
+ sliders[1] = @dlg.add_slider("sound file",
+ 0, init_two, 24) do |w, c, i|
@sound_two = get_scale_value(w, i).round
end
- sliders[2] = @dlg.add_slider("amplitude", 0.0, init_amp, 0.1, 100) do |w, c, i|
+ sliders[2] = @dlg.add_slider("amplitude",
+ 0.0, init_amp, 0.1, 100) do |w, c, i|
@amp = get_scale_value(w, i, 100.0)
end
end
@@ -1822,27 +1943,30 @@ http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data.",
init_pan_pos = 45
sliders = Array.new(3)
@dlg = make_dialog(@label,
- :info, "Mixes mono sound into stereo sound field.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
- set_scale_value(sliders[0].scale, @mono_snd = init_mono_snd)
- set_scale_value(sliders[1].scale, @stereo_snd = init_stereo_snd)
- set_scale_value(sliders[2].scale, @pan_pos = init_pan_pos)
- end) do |w, c, i|
+ :info, "Mixes mono sound into stereo sound field.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ @envelope.envelope = [0.0, 1.0, 1.0, 1.0]
+ set_scale_value(sliders[0].scale, @mono_snd = init_mono_snd)
+ set_scale_value(sliders[1].scale, @stereo_snd = init_stereo_snd)
+ set_scale_value(sliders[2].scale, @pan_pos = init_pan_pos)
+ end) do |w, c, i|
if (e = @envelope.envelope) != [0.0, 1.0, 1.0, 1.0]
place_sound(e)
else
place_sound(@pan_pos)
end
end
- sliders[0] = @dlg.add_slider("mono sound", 0, init_mono_snd, 50) do |w, c, i|
+ sliders[0] = @dlg.add_slider("mono sound",
+ 0, init_mono_snd, 50) do |w, c, i|
@mono_snd = get_scale_value(w, i).round
end
- sliders[1] = @dlg.add_slider("stereo sound", 0, init_stereo_snd, 50) do |w, c, i|
+ sliders[1] = @dlg.add_slider("stereo sound",
+ 0, init_stereo_snd, 50) do |w, c, i|
@stereo_snd = get_scale_value(w, i).round
end
- sliders[2] = @dlg.add_slider("pan position", 0, init_pan_pos, 90) do |w, c, i|
+ sliders[2] = @dlg.add_slider("pan position",
+ 0, init_pan_pos, 90) do |w, c, i|
@pan_pos = get_scale_value(w, i)
end
@envelope = make_enved_widget(@label, @dlg) do |t|
@@ -1870,14 +1994,15 @@ http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data.",
init_amount = 1.0
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the number of seconds \
+ :info, "Move the slider to change the number of seconds \
of silence added at the cursor position.",
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
- end) do |w, c, i|
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
+ end) do |w, c, i|
insert_silence(cursor(), (srate().to_f * @amount).round)
end
- sliders[0] = @dlg.add_slider("silence", 0.0, init_amount, 5.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("silence",
+ 0.0, init_amount, 5.0, 100) do |w, c, i|
@amount = get_scale_value(w, i, 100.0)
end
end
@@ -1902,10 +2027,10 @@ of silence added at the cursor position.",
init_amount = 1.0
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the contrast intensity.",
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
- end) do |w, c, i|
+ :info, "Move the slider to change the contrast intensity.",
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @amount = init_amount, 100.0)
+ end) do |w, c, i|
peak = maxamp()
save_controls
reset_controls
@@ -1926,7 +2051,9 @@ of silence added at the cursor position.",
0.0, init_amount, 10.0, 100) do |w, c, i|
@amount = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -1957,7 +2084,10 @@ of silence added at the cursor position.",
ctr = freq_inc
radius = 1.0 - r / fftsize.to_f
bin = srate() / fftsize.to_f
- formants = make_array(freq_inc) do |i| make_formant(i * bin, radius) end
+ fmts = make_array(freq_inc) do |i|
+ make_formant(i * bin, radius)
+ end
+ formants = make_formant_bank(fmts, spectr)
lambda do |inval|
if ctr == freq_inc
fdr = channel2vct(inctr, fftsize, cross_snd, 0)
@@ -1969,7 +2099,7 @@ of silence added at the cursor position.",
end
ctr += 1
spectr.add!(fdr)
- amp * formant_bank(spectr, formants, inval)
+ amp * formant_bank(formants, inval)
end
end
@@ -1981,37 +2111,41 @@ of silence added at the cursor position.",
init_radius = 6.0
sliders = Array.new(3)
@dlg = make_dialog(@label,
- :info, "The sliders set the number of the soundfile \
+ :info, "The sliders set the number of the soundfile \
to be cross_synthesized, the synthesis amplitude, the FFT size, and the radius value.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @sound = init_sound)
- set_scale_value(sliders[1].scale, @amp = init_amp, 100.0)
- @fft_size = init_fft_size
- if $with_motif
- RXmToggleButtonSetState(@default_fft_widget, true, true)
- end
- set_scale_value(sliders[2].scale, @radius = init_radius, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @sound = init_sound)
+ set_scale_value(sliders[1].scale, @amp = init_amp, 100.0)
+ @fft_size = init_fft_size
+ if $with_motif
+ RXmToggleButtonSetState(@default_fft_widget, true, true)
+ end
+ set_scale_value(sliders[2].scale, @radius = init_radius, 100.0)
+ end) do |w, c, i|
if sound?(@sound)
map_chan_over_target_with_sync(@target, false,
- lambda { |s|
+ lambda do |s|
format("effects_cross_synthesis_1(%s, %s, %s, %s",
- @sound, @amp, @fft_size, @radius)
- }) do |ignored|
+ @sound, @amp,
+ @fft_size, @radius)
+ end) do |ignored|
effects_cross_synthesis(@sound, @amp, @fft_size, @radius)
end
else
snd_warning(format("cross-snd: %s", sound?(@sound).to_s))
end
end
- sliders[0] = @dlg.add_slider("input sound", 0, init_sound, 20) do |w, c, i|
+ sliders[0] = @dlg.add_slider("input sound",
+ 0, init_sound, 20) do |w, c, i|
@sound = get_scale_value(w, i).round
end
- sliders[1] = @dlg.add_slider("amplitude", 0.0, init_amp, 1.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("amplitude",
+ 0.0, init_amp, 1.0, 100) do |w, c, i|
@amp = get_scale_value(w, i, 100.0)
end
- sliders[2] = @dlg.add_slider("radius", 0.0, init_radius, 360.0, 100) do |w, c, i|
+ sliders[2] = @dlg.add_slider("radius",
+ 0.0, init_radius, 360.0, 100) do |w, c, i|
@radius = get_scale_value(w, i, 100.0)
end
if $with_motif
@@ -2029,7 +2163,8 @@ to be cross_synthesized, the synthesis amplitude, the FFT size, and the radius v
[RXmNorientation, RXmHORIZONTAL,
RXmNradioBehavior, true,
RXmNradioAlwaysOne, true,
- RXmNentryClass, RxmToggleButtonWidgetClass,
+ RXmNentryClass,
+ RxmToggleButtonWidgetClass,
RXmNisHomogeneous, true,
RXmNleftAttachment, RXmATTACH_FORM,
RXmNrightAttachment, RXmATTACH_FORM,
@@ -2046,21 +2181,25 @@ to be cross_synthesized, the synthesis amplitude, the FFT size, and the radius v
RXmNalignment, RXmALIGNMENT_BEGINNING,
RXmNbackground, basic_color])
[64, 128, 256, 512, 1024, 4096].each do |s|
- button = RXtCreateManagedWidget(s.to_s, RxmToggleButtonWidgetClass, rc,
- [RXmNbackground, basic_color,
- RXmNvalueChangedCallback, [lambda do |w, c, i|
- if Rset(i)
- @fft_size = c
- end
- end, s],
- RXmNset, (s == @fft_size)])
+ button = RXtCreateManagedWidget(s.to_s,
+ RxmToggleButtonWidgetClass, rc,
+ [RXmNbackground, basic_color,
+ RXmNvalueChangedCallback,
+ [lambda do |w, c, i|
+ if Rset(i)
+ @fft_size = c
+ end
+ end, s],
+ RXmNset, (s == @fft_size)])
if s == @fft_size
@default_fft_widget = button
end
end
RXmStringFree(s1)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -2087,18 +2226,19 @@ to be cross_synthesized, the synthesis amplitude, the FFT size, and the radius v
init_time = 0.001
sliders = Array.new(3)
@dlg = make_dialog(@label,
- :info, "Move the sliders to change the flange speed, amount, and time.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @speed = init_speed, 10.0)
- set_scale_value(sliders[1].scale, @amount = init_amount, 10.0)
- set_scale_value(sliders[2].scale, @time = init_time, 100.0)
- end) do |w, c, i|
+ :info, "Move the sliders to change the flange \
+speed, amount, and time.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @speed = init_speed, 10.0)
+ set_scale_value(sliders[1].scale, @amount = init_amount, 10.0)
+ set_scale_value(sliders[2].scale, @time = init_time, 100.0)
+ end) do |w, c, i|
map_chan_over_target_with_sync(@target, false,
- lambda { |s|
+ lambda do |s|
format("effects_flange(%s, %s, %s",
@amount, @speed, @time)
- }) do |ignored|
+ end) do |ignored|
ri = make_rand_interp(:frequency, @speed, :amplitude, @amount)
len = (@time.to_f * srate()).round
del = make_delay(len, :max_size, (len + @amount + 1).to_i)
@@ -2107,16 +2247,21 @@ to be cross_synthesized, the synthesis amplitude, the FFT size, and the radius v
end
end
end
- sliders[0] = @dlg.add_slider("flange speed", 0.0, init_speed, 100.0, 10) do |w, c, i|
+ sliders[0] = @dlg.add_slider("flange speed",
+ 0.0, init_speed, 100.0, 10) do |w, c, i|
@speed = get_scale_value(w, i, 10.0)
end
- sliders[1] = @dlg.add_slider("flange amount", 0.0, init_amount, 100.0, 10) do |w, c, i|
+ sliders[1] = @dlg.add_slider("flange amount",
+ 0.0, init_amount, 100.0, 10) do |w, c, i|
@amount = get_scale_value(w, i, 10.0)
end
- sliders[2] = @dlg.add_slider("flange time", 0.0, init_time, 1.0, 100) do |w, c, i|
+ sliders[2] = @dlg.add_slider("flange time",
+ 0.0, init_time, 1.0, 100) do |w, c, i|
@time = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -2138,13 +2283,14 @@ to be cross_synthesized, the synthesis amplitude, the FFT size, and the radius v
init_scaler = 3.14
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Move the slider to change the randomization amplitude scaler.",
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @amp_scaler = init_scaler, 100.0)
- end) do |w, c, i|
+ :info, "Move the slider to change the randomization amp scaler.",
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @amp_scaler = init_scaler, 100.0)
+ end) do |w, c, i|
rotate_phase(lambda do |x| kernel_rand(@amp_scaler) end)
end
- sliders[0] = @dlg.add_slider("amplitude scaler", 0.0, init_scaler, 100.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("amplitude scaler",
+ 0.0, init_scaler, 100.0, 100) do |w, c, i|
@amp_scaler = get_scale_value(w, i, 100.0)
end
end
@@ -2173,14 +2319,14 @@ to be cross_synthesized, the synthesis amplitude, the FFT size, and the radius v
init_freq = 20
sliders = Array.new(3)
@dlg = make_dialog(@label,
- :info, "Move the sliders to set the sample rate, \
+ :info, "Move the sliders to set the sample rate, \
oscillator amplitude, and oscillator frequency.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @samp_rate = init_rate, 100.0)
- set_scale_value(sliders[1].scale, @osc_amp = init_amp, 100.0)
- set_scale_value(sliders[2].scale, @osc_freq = init_freq, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @samp_rate = init_rate, 100.0)
+ set_scale_value(sliders[1].scale, @osc_amp = init_amp, 100.0)
+ set_scale_value(sliders[2].scale, @osc_freq = init_freq, 100.0)
+ end) do |w, c, i|
ms = (@target == :marks and plausible_mark_samples)
effects_fp(@samp_rate, @osc_amp, @osc_freq,
case @target
@@ -2192,23 +2338,28 @@ oscillator amplitude, and oscillator frequency.",
ms[0]
end, case @target
when :sound
- frames
+ framples
when :selection
- selection_frames
+ selection_framples
else
ms[1] - ms[0]
end)
end
- sliders[0] = @dlg.add_slider("sample rate", 0.0, init_rate, 2.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("sample rate",
+ 0.0, init_rate, 2.0, 100) do |w, c, i|
@samp_rate = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("oscillator amplitude", 0.0, init_amp, 1.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("oscillator amplitude",
+ 0.0, init_amp, 1.0, 100) do |w, c, i|
@osc_amp = get_scale_value(w, i, 100.0)
end
- sliders[2] = @dlg.add_slider("oscillator frequency", 0.0, init_freq, 60, 100) do |w, c, i|
+ sliders[2] = @dlg.add_slider("oscillator frequency",
+ 0.0, init_freq, 60, 100) do |w, c, i|
@osc_freq = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -2231,18 +2382,21 @@ oscillator amplitude, and oscillator frequency.",
init_factor = 1.0
sliders = Array.new(1)
@dlg = make_dialog(@label,
- :info, "Stretches or contracts the time of a sound. \
+ :info, "Stretches or contracts the time of a sound. \
Move the slider to change the stretch factor.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @factor = init_factor, 100.0)
- end) do |w, c, i|
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @factor = init_factor, 100.0)
+ end) do |w, c, i|
rubber_sound(@factor)
end
- sliders[0] = @dlg.add_slider("stretch factor", 0.0, init_factor, 5.0, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("stretch factor",
+ 0.0, init_factor, 5.0, 100) do |w, c, i|
@factor = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -2267,12 +2421,12 @@ Move the slider to change the stretch factor.",
init_amp = 0.5
sliders = Array.new(2)
@dlg = make_dialog(@label,
- :info, "Move the sliders to set the wobble frequency and amplitude.",
- :target_cb, lambda do | | effect_target_ok(@target) end,
- :reset_cb, lambda do |w, c, i|
- set_scale_value(sliders[0].scale, @frequency = init_freq, 100.0)
- set_scale_value(sliders[1].scale, @amplitude = init_amp, 100.0)
- end) do |w, c, i|
+ :info, "Move the sliders to set the wobble frequency and amplitude.",
+ :target_cb, lambda do | | effect_target_ok(@target) end,
+ :reset_cb, lambda do |w, c, i|
+ set_scale_value(sliders[0].scale, @frequency = init_freq, 100.0)
+ set_scale_value(sliders[1].scale, @amplitude = init_amp, 100.0)
+ end) do |w, c, i|
ms = (@target == :marks and plausible_mark_samples)
effects_hello_dentist(@frequency, @amplitude,
case @target
@@ -2284,20 +2438,24 @@ Move the slider to change the stretch factor.",
ms[0]
end, case @target
when :sound
- frames
+ framples
when :selection
- selection_frames
+ selection_framples
else
ms[1] - ms[0]
end)
end
- sliders[0] = @dlg.add_slider("wobble frequency", 0, init_freq, 100, 100) do |w, c, i|
+ sliders[0] = @dlg.add_slider("wobble frequency",
+ 0, init_freq, 100, 100) do |w, c, i|
@frequency = get_scale_value(w, i, 100.0)
end
- sliders[1] = @dlg.add_slider("wobble amplitude", 0.0, init_amp, 1.0, 100) do |w, c, i|
+ sliders[1] = @dlg.add_slider("wobble amplitude",
+ 0.0, init_amp, 1.0, 100) do |w, c, i|
@amplitude = get_scale_value(w, i, 100.0)
end
- @dlg.add_target() do |t| set_sensitive(@dlg.okay_button, effect_target_ok(@target = t)) end
+ @dlg.add_target() do |t|
+ set_sensitive(@dlg.okay_button, effect_target_ok(@target = t))
+ end
end
activate_dialog(@dlg.dialog)
end
@@ -2365,7 +2523,7 @@ else
reader = make_sampler(loc)
samp0 = samp1 = samp2 = 0.0
samps = make_vct(10)
- len = frames()
+ len = framples()
samps_ctr = 0
ret = false
ctr = loc
diff --git a/env.fs b/env.fs
index 1c472f6..64251ac 100644
--- a/env.fs
+++ b/env.fs
@@ -1,203 +1,243 @@
-\ -*- snd-forth -*-
\ env.fs -- env.scm -> env.fs
\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Thu Oct 27 04:51:42 CEST 2005
-\ Changed: Wed Oct 14 00:11:58 CEST 2009
-
-\ Commentary:
+\ Created: 05/10/27 04:51:42
+\ Changed: 14/04/28 03:52:17
\
+\ @(#)env.fs 1.25 4/28/14
+
\ From env.scm|rb with original comments and doc strings from env.scm.
\
-\ envelope? ( obj -- f )
-\ envelope-copy ( env1 -- env2 )
+\ envelope? ( obj -- f )
+\ envelope-copy ( env1 -- env2 )
\
-\ envelope-interp ( x env :optional base -- r )
-\ interp ( x env -- r )
-\ window-envelope ( beg end en1 -- en2 )
-\ map-envelopes ( env1 env2 xt -- env3 )
-\ add-envelopes ( env1 env2 -- env3 ) alias envelopes+
-\ multiply-envelopes ( env1 env2 -- env3 ) alias envelopes*
-\ max-envelope ( env -- r )
-\ min-envelope ( env -- r )
-\ integrate-envelope ( en -- r )
-\ envelope-length ( env -- n )
-\ envelope-last-x ( env -- r )
-\ stretch-envelope ( env old-attack new-attack :optional old-decay new-decay -- new-env )
-\ scale-envelope ( env1 scl :offset offset -- env2 )
-\ reverse-envelope ( env1 -- env2 )
-\ envelope-concatenate ( en1 ... enn n -- ne )
-\ concatenate-envelopes ( en1 ... enn n -- ne )
-\ repeat-envelope ( ur-env repeats :optional reflected normalized -- en )
+\ envelope-interp ( x env :optional base -- r )
+\ interp ( x env -- r )
+\ window-envelope ( beg end en1 -- en2 )
+\ map-envelopes ( env1 env2 xt -- env3 )
+\ add-envelopes ( env1 env2 -- env3 ) alias envelopes+
+\ multiply-envelopes ( env1 env2 -- env3 ) alias envelopes*
+\ max-envelope ( env -- r )
+\ min-envelope ( env -- r )
+\ integrate-envelope ( en -- r )
+\ envelope-length ( env -- n )
+\ envelope-last-x ( env -- r )
+\ stretch-envelope ( env oa na :optional old-decay new-decay -- new-env )
+\ scale-envelope ( env1 scl :offset offset -- env2 )
+\ reverse-envelope ( env1 -- env2 )
+\ envelope-concatenate ( en1 ... enn n -- ne )
+\ concatenate-envelopes ( en1 ... enn n -- ne )
+\ repeat-envelope ( ur-env reps :optional reflected normalized -- en )
\
-\ make-power-env ( envelope :key scaler offset duration -- pe )
-\ power-env ( pe -- val )
-\ power-env-channel ( pe :optional beg dur snd chn edpos edname -- curbeg )
-\ powenv-channel ( envelope :optional beg dur snd chn edpos -- val )
-\ envelope-exp ( en1 :optional power xgrid -- en2 )
-\ rms-envelope ( file :key beg dur rfreq db -- en )
+\ make-power-env ( envelope :key scaler offset duration -- pe )
+\ power-env ( pe -- val )
+\ power-env-channel ( pe :optional beg dur snd chn edpos edname -- curb )
+\ powenv-channel ( envelope :optional beg dur snd chn edpos -- val )
+\ envelope-exp ( en1 :optional power xgrid -- en2 )
+\ rms-envelope ( file :key beg dur rfreq db -- en )
\
-\ normalize-envelope ( env1 -- env2 )
+\ normalize-envelope ( env1 -- env2 )
require clm
: envelope? ( obj -- f )
- doc" Returns #t if OBJ is a vct or an array with even length and length >= 2."
- ( obj ) length dup 2 mod 0= swap 2 >= &&
+ doc" Return #t if OBJ is a vct or an array \
+with even length and length >= 2."
+ ( obj ) length dup 2 mod 0= swap 2 >= &&
;
+
<'> object-copy alias envelope-copy
-<'> envelope-copy $" ( en1 -- en2 ) Copies EN1 which may be a vct, or an array." help-set!
+<'> envelope-copy
+"( en1 -- en2 ) Copy EN1, which may be a vct or an array." help-set!
\ ;;; -------- envelope-interp
: envelope-interp <{ x en :optional base 1.0 -- r }>
- doc" Returns value of ENV at X; BASE controls connecting segment type; \
+ doc" Return value of ENV at X; \
+BASE controls connecting segment type; \
ENV may be a vct, or an array:\n\
-0.3 #( 0.0 0.0 0.5 1.0 1.0 0.0 ) 1.0 envelope-interp => 0.6"
- en empty? if
- 0.0
- else
- en length { size }
- x en 0 object-ref f<= size 2 <= || if
- en 1 object-ref
- else
- en 2 object-ref x f> if
- en 1 object-ref en 3 object-ref f= base f0= || if
- en 1 object-ref
+0.3 #( 0.0 0.0 0.5 1.0 1.0 0.0 ) 1.0 envelope-interp => 0.6."
+ en empty? if
+ 0.0
else
- base 1.0 f= if
- en 1 object-ref
- x en 0 object-ref f-
- en 3 object-ref en 1 object-ref f- en 2 object-ref en 0 object-ref f- f/
- f* f+
- else
- en 1 object-ref
- en 3 object-ref en 1 object-ref f- base 1.0 f- f/
- base x en 0 object-ref f- en 2 object-ref en 0 object-ref f- f/ f** 1.0 f-
- f* f+
- then
+ en length { size }
+ x en 0 object-ref f<=
+ size 2 <= || if
+ en 1 object-ref
+ else
+ en 2 object-ref x f> if
+ en 1 object-ref en 3 object-ref f=
+ base f0= || if
+ en 1 object-ref
+ else
+ base 1.0 f= if
+ en 1 object-ref
+ x en 0 object-ref f-
+ en 3 object-ref
+ en 1 object-ref f-
+ en 2 object-ref
+ en 0 object-ref f- f/
+ f* f+
+ else
+ en 1 object-ref
+ en 3 object-ref
+ en 1 object-ref f-
+ base 1.0 f- f/ base x
+ en 0 object-ref f-
+ en 2 object-ref
+ en 0 object-ref f- f/
+ f** 1.0 f- f* f+
+ then
+ then
+ else
+ x size 2 ?do
+ en i object-ref
+ loop
+ size 2 - >array base recurse ( envelope-interp )
+ then
+ then
then
- else
- x size 2 ?do en i object-ref loop size 2 - >array base recurse ( envelope-interp )
- then
- then
- then
;
+
: interp ( x env -- r )
- doc" 0.3 #( 0.0 0.0 0.5 1.0 1.0 0.0 ) interp => 0.6"
- 1.0 envelope-interp
+ doc" 0.3 #( 0.0 0.0 0.5 1.0 1.0 0.0 ) interp => 0.6."
+ 1.0 envelope-interp
;
\ ;;; -------- window-envelope (a kinda brute-force translation from the CL version in env.lisp)
: window-envelope ( beg end en1 -- en2 )
- doc" Returns portion of EN1 lying between x axis values BEG and END:\n\
-1.0 3.0 #( 0.0 0.0 5.0 1.0 ) window-envelope => #( 1.0 0.2 3.0 0.6 )"
- { beg end en1 }
- #() { en2 }
- en1 length 1 > if en1 1 array-ref else 0.0 then { lasty }
- #f { return-early? }
- en1 length 0 ?do
- en1 i array-ref { x }
- en1 i 1+ array-ref { y }
- y to lasty
- en2 empty? if
- x beg f>= if
- en2 beg array-push beg en1 1.0 envelope-interp array-push to en2
- x beg f<> if
- x end f>= if
- en2 end array-push end en1 1.0 envelope-interp array-push to en2
- #t to return-early?
- leave
- else
- en2 #( x y ) array-push to en2
- then
- then
- then
- else
- x end f<= if
- en2 x array-push y array-push to en2
- x end f= if
- #t to return-early?
- leave
- then
- else
- x end f> if
- en2 end array-push end en1 1.0 envelope-interp array-push to en2
- #t to return-early?
- leave
+ doc" Return portion of EN1 lying between x axis values BEG and END:\n\
+1.0 3.0 #( 0.0 0.0 5.0 1.0 ) window-envelope => #( 1.0 0.2 3.0 0.6 )."
+ { beg end en1 }
+ #() { en2 }
+ en1 length 1 > if
+ en1 1 array-ref
+ else
+ 0.0
+ then { lasty }
+ #f { return-early? }
+ en1 length 0 ?do
+ en1 i array-ref { x }
+ en1 i 1+ array-ref { y }
+ y to lasty
+ en2 empty? if
+ x beg f>= if
+ en2 beg array-push
+ beg en1 1.0 envelope-interp
+ array-push to en2
+ x beg f<> if
+ x end f>= if
+ en2 end array-push
+ end en1 1.0
+ envelope-interp
+ array-push to en2
+ #t to return-early?
+ leave
+ else
+ en2 #( x y ) array-push to en2
+ then
+ then
+ then
+ else
+ x end f<= if
+ en2 x array-push y array-push to en2
+ x end f= if
+ #t to return-early?
+ leave
+ then
+ else
+ x end f> if
+ en2 end array-push
+ end en1 1.0 envelope-interp
+ array-push to en2
+ #t to return-early?
+ leave
+ then
+ then
+ then
+ 2 +loop
+ return-early? unless
+ en2 end array-push lasty array-push to en2
then
- then
- then
- 2 +loop
- return-early? unless en2 end array-push lasty array-push to en2 then
- en2
+ en2
;
\ ;;; -------- map-envelopes like map-across-envelopes in env.lisp
hide
: fnumb-cmp ( a b -- -1|0|1 )
- { a b }
- a b f< if
- -1
- else
- a b f= if
- 0
- else
- 1
- then
- then
+ { a b }
+ a b f< if
+ -1
+ else
+ a b f= if
+ 0
+ else
+ 1
+ then
+ then
;
+
: (at0) ( en xs-array -- en' )
- { en xs }
- en 0 object-ref { diff }
- en -2 object-ref { lastx }
- en length 0 ?do
- en i object-ref diff f- lastx f/ ( x ) xs over array-push drop en i rot object-set!
- 2 +loop
- en
+ { en xs }
+ en 0 object-ref { diff }
+ en -2 object-ref { lastx }
+ en length 0 ?do
+ en i object-ref diff f- lastx f/ ( x )
+ xs over array-push drop en i rot object-set!
+ 2 +loop
+ en
;
set-current
+
: map-envelopes ( en1 en2 xt -- en3 )
- doc" Maps XT over the breakpoints in EN1 and EN2 returning a new envelope."
- { en1 en2 xt }
- #() { xs }
- #() { en3 }
- en1 empty? if
- en2 xs (at0) to en3
- else
- en2 empty? if
- en1 xs (at0) to en3
- else
- en1 xs (at0) { ee1 }
- en2 xs (at0) { ee2 }
- xs array-uniq! <'> fnumb-cmp array-sort! drop
- xs length 2* :initial-element 0.0 make-array to en3
- xs each { x }
- en3 i 2* x array-set!
- x ee1 1.0 envelope-interp x ee2 1.0 envelope-interp xt execute en3 i 2* 1+ rot array-set!
- end-each
- then
- then
- en1 array? if
- en3
- else
- en1 vct? if en3 vector->vct then
- then
+ doc" Map XT over the breakpoints in EN1 and EN2 \
+returning a new envelope."
+ { en1 en2 xt }
+ #() { xs }
+ #() { en3 }
+ en1 empty? if
+ en2 xs (at0) to en3
+ else
+ en2 empty? if
+ en1 xs (at0) to en3
+ else
+ en1 xs (at0) { ee1 }
+ en2 xs (at0) { ee2 }
+ xs array-uniq! <'> fnumb-cmp array-sort! drop
+ xs length 2* :initial-element 0.0 make-array to en3
+ xs each { x }
+ en3 i 2* x array-set!
+ x ee1 1.0 envelope-interp
+ x ee2 1.0 envelope-interp
+ xt execute en3 i 2* 1+ rot array-set!
+ end-each
+ then
+ then
+ en1 array? if
+ en3
+ else
+ en1 vct? if
+ en3 vector->vct
+ then
+ then
;
previous
\ ;;; -------- multiply-envelopes, add-envelopes
: add-envelopes ( env1 env2 -- env3 )
- doc" Adds break-points of ENV1 and ENV2 returning a new envelope."
- <'> f+ map-envelopes
+ doc" Add break-points of ENV1 and ENV2 returning a new envelope."
+ <'> f+ map-envelopes
;
+
: multiply-envelopes ( env1 env2 -- env3 )
- doc" Multiplies break-points of ENV1 and ENV2 returning a new envelope:\n\
-#( 0 0 2 0.5 ) #( 0 0 1 2 2 1 ) multiply-envelopes => #( 0.0 0.0 0.5 0.5 1.0 0.5 )"
- <'> f* map-envelopes
+ doc" Multiply break-points of ENV1 and ENV2 \
+returning a new envelope:\n\
+#( 0 0 2 0.5 ) #( 0 0 1 2 2 1 ) multiply-envelopes\n\
+ => #( 0.0 0.0 0.5 0.5 1.0 0.5 )."
+ <'> f* map-envelopes
;
<'> add-envelopes alias envelopes+
<'> multiply-envelopes alias envelopes*
@@ -205,345 +245,386 @@ previous
\ ;;; -------- max-envelope
: max-envelope ( en -- r )
- doc" Returns max y value in EN."
- { en }
- en 1 object-ref en length 1 ?do en i object-ref fmax 2 +loop
+ doc" Return max y value in EN."
+ { en }
+ en 1 object-ref en length 1 ?do
+ en i object-ref fmax
+ 2 +loop
;
\ ;;; -------- min-envelope
: min-envelope ( en -- r )
- doc" Returns min y value in EN."
- { en }
- en 1 object-ref en length 1 ?do en i object-ref fmin 2 +loop
+ doc" Return min y value in EN."
+ { en }
+ en 1 object-ref en length 1 ?do
+ en i object-ref fmin
+ 2 +loop
;
\ ;;; -------- integrate-envelope
: integrate-envelope ( en -- r )
- doc" Area under env."
- { en }
- 0.0 ( sum ) en length 3 - 0 ?do
- en i 1+ object-ref en i 3 + object-ref f+ 0.5 f*
- en i 2+ object-ref en i object-ref f- f* f+ ( sum+=... )
- 2 +loop
- ( sum )
+ doc" Area under env."
+ { en }
+ 0.0 ( sum ) en length 3 - 0 ?do
+ en i 1+ object-ref en i 3 + object-ref f+ 0.5 f*
+ en i 2+ object-ref en i object-ref f- f* f+ ( sum+=... )
+ 2 +loop
+ ( sum )
;
+
: envelope-length ( en -- n )
- doc" Returns number of points in EN."
- length 2/
+ doc" Return number of points in EN."
+ length 2/
;
\ ;;; -------- envelope-last-x
: envelope-last-x ( en -- r )
- doc" Returns max x axis break point position"
- -2 object-ref
+ doc" Return max x axis break point position."
+ -2 object-ref
;
\ ;;; -------- stretch-envelope
-: stretch-envelope <{ fn old-attack new-attack :optional old-decay #f new-decay #f -- new-env }>
- doc" Takes ENV and returns a new envelope based on it \
+: stretch-envelope <{ fn old-attack new-attack
+ :optional old-decay #f new-decay #f -- new-env }>
+ doc" Take ENV and returns a new envelope based on it \
but with the attack and optionally decay portions stretched or squeezed; \
OLD-ATTACK is the original x axis attack end point, \
NEW-ATTACK is where that section should end in the new envelope. \
Similarly for OLD-DECAY and NEW-DECAY. \
-This mimics divseg in early versions of CLM and its antecedents in Sambox and Mus10 (linen). \
+This mimics divseg in early versions of CLM \
+and its antecedents in Sambox and Mus10 (linen). \
ENV may be a vct, or an array.\n\
#( 0 0 1 1 ) 0.1 0.2 stretch-envelope => #( 0 0 0.2 0.1 1 1 )\n\
-#( 0 0 1 1 2 0 ) 0.1 0.2 1.5 1.6 stretch-envelope => #( 0 0 0.2 0.1 1.1 1 1.6 0.5 2 0 )"
- old-decay new-decay not && if
- 'argument-error
- #( get-func-name $" old-decay, %s, but no new-decay, %s?" #( old-decay new-decay ) 5 )
- fth-throw
- then
- fn length { len }
- fn 0 object-ref dup { x0 new-x }
- fn 1 object-ref { y0 }
- fn -2 object-ref { last-x }
- #( x0 y0 ) { new-fn }
- new-attack x0 f- 0.0001 old-attack x0 f- fmax f/ { scl }
- old-decay if
- old-decay old-attack f= if old-decay 0.000001 last-x f* f+ to old-decay then
- then
- len 1- 2 ?do
- fn i object-ref { x1 }
- fn i 1+ object-ref { y1 }
- x0 old-attack f<
- x1 old-attack f>= && if
- x1 old-attack f= if
- y1
- else
- y0 y1 y0 f- old-attack x0 f- x1 x0 f- f/ f* f+
- then to y0
- old-attack to x0
- new-attack to new-x
- new-fn new-x array-push y0 array-push drop
- old-decay if
- new-decay new-attack f- old-decay old-attack f- f/
- else
- last-x new-attack f- last-x old-attack f- f/
- then to scl
- then
- old-decay if
- x0 old-decay f<
- x1 old-decay f>= && if
- x1 old-decay f= if
- y1
+#( 0 0 1 1 2 0 ) 0.1 0.2 1.5 1.6 stretch-envelope => #( 0 0 0.2 0.1 1.1 1 1.6 0.5 2 0 )."
+ old-decay
+ new-decay not && if
+ 'argument-error
+ #( "%s: old-decay, %s, but no new-decay, %s?"
+ get-func-name
+ old-decay
+ new-decay ) fth-throw
+ then
+ fn length { len }
+ fn 0 object-ref dup { x0 new-x }
+ fn 1 object-ref { y0 }
+ fn -2 object-ref { last-x }
+ #( x0 y0 ) { new-fn }
+ new-attack x0 f- 0.0001 old-attack x0 f- fmax f/ { scl }
+ old-decay if
+ old-decay old-attack f= if
+ old-decay 0.000001 last-x f* f+ to old-decay
+ then
+ then
+ len 1- 2 ?do
+ fn i object-ref { x1 }
+ fn i 1+ object-ref { y1 }
+ x0 old-attack f<
+ x1 old-attack f>= && if
+ x1 old-attack f= if
+ y1
+ else
+ y0 y1 y0 f- old-attack
+ x0 f- x1 x0 f- f/ f* f+
+ then to y0
+ old-attack to x0
+ new-attack to new-x
+ new-fn new-x array-push y0 array-push drop
+ old-decay if
+ new-decay new-attack f-
+ old-decay old-attack f- f/
+ else
+ last-x new-attack f-
+ last-x old-attack f- f/
+ then to scl
+ then
+ old-decay if
+ x0 old-decay f<
+ x1 old-decay f>= && if
+ x1 old-decay f= if
+ y1
+ else
+ y0 y1 y0 f- old-decay
+ x0 f- x1 x0 f- f/ f* f+
+ then to y0
+ old-decay to x0
+ new-decay to new-x
+ new-fn new-x array-push y0 array-push drop
+ last-x new-decay f-
+ last-x old-decay f- f/ to scl
+ then
+ then
+ x0 x1 f<> if
+ new-x scl x1 x0 f- f* f+ to new-x
+ new-fn new-x array-push y1 array-push drop
+ x1 to x0
+ y1 to y0
+ then
+ 2 +loop
+ fn array? if
+ new-fn
else
- y0 y1 y0 f- old-decay x0 f- x1 x0 f- f/ f* f+
- then to y0
- old-decay to x0
- new-decay to new-x
- new-fn new-x array-push y0 array-push drop
- last-x new-decay f- last-x old-decay f- f/ to scl
- then
- then
- x0 x1 f<> if
- new-x scl x1 x0 f- f* f+ to new-x
- new-fn new-x array-push y1 array-push drop
- x1 to x0
- y1 to y0
- then
- 2 +loop
- fn array? if
- new-fn
- else
- fn vct? if new-fn vector->vct then
- then
+ fn vct? if
+ new-fn vector->vct
+ then
+ then
;
\ ;;; -------- scale-envelope
: scale-envelope <{ en scl :optional offset 0 -- new-en }>
- doc" Scales y axis values by SCL and optionally adds OFFSET. \
+ doc" Scale y axis values by SCL and optionally adds OFFSET. \
EN may be a list, a vct, or an array."
- en map *key* i 2 mod if scl f* offset f+ then end-map ( new-en )
+ en map
+ *key* i 2 mod if
+ scl f* offset f+
+ then
+ end-map ( new-en )
;
\ ;;; -------- reverse-envelope
: reverse-envelope ( en1 -- en2 )
- doc" Reverses the breakpoints in EN1."
- { en1 }
- en1 length { size }
- en1 envelope-copy { en2 }
- size 2 - { idx }
- en1 -2 object-ref { xmax }
- en1 length 1- 0 ?do
- en2 idx xmax en1 i object-ref f- object-set!
- en2 idx 1+ en1 i 1+ object-ref object-set!
- idx 2 - to idx
- 2 +loop
- en2
+ doc" Reverse the breakpoints in EN1."
+ { en1 }
+ en1 length { size }
+ en1 envelope-copy { en2 }
+ size 2 - { idx }
+ en1 -2 object-ref { xmax }
+ en1 length 1- 0 ?do
+ en2 idx xmax en1 i object-ref f- object-set!
+ en2 idx 1+ en1 i 1+ object-ref object-set!
+ idx 2 - to idx
+ 2 +loop
+ en2
;
\ ;;; -------- envelope-concatenate from clm/env.lisp
: envelope-concatenate ( en1 ... enn n -- ne )
- doc" Concatenates N envelopes into a new envelope (from clm/env.lisp)."
- >array { envs }
- envs object-length 1 = if
- envs 0 array-ref
- else
- 0.0 { xoff }
- #() { rne }
- envs each { en }
- en first-ref { firstx }
- en object-length 0 ?do
- en i object-ref { x }
- en i 1+ object-ref { y }
- rne x firstx f- xoff f+ array-push y array-push to rne
- 2 +loop
- rne -2 array-ref 0.01 f+ to xoff
- end-each
- rne
- then
+ doc" Concatenate N envelopes into a new envelope (from clm/env.lisp)."
+ >array { envs }
+ envs object-length 1 = if
+ envs 0 array-ref
+ else
+ 0.0 { xoff }
+ #() { rne }
+ envs each { en }
+ en first-ref { firstx }
+ en object-length 0 ?do
+ en i object-ref { x }
+ en i 1+ object-ref { y }
+ rne x firstx f- xoff f+ array-push
+ y array-push to rne
+ 2 +loop
+ rne -2 array-ref 0.01 f+ to xoff
+ end-each
+ rne
+ then
;
\ ;;; -------- concatenate-envelopes from snd/env.scm
: concatenate-envelopes ( en1 ... enn n -- ne )
- doc" Concatenates N envelopes into a new envelope (from snd/env.scm)."
- >array { envs }
- envs object-length 1 = if
- envs 0 array-ref
- else
- 0.0 { xoff }
- #() { rne }
- envs each { en }
- en first-ref { firstx }
- rne object-length 0> if
- rne last-ref en second-ref f= if
- xoff 0.01 f- to xoff
- 2
+ doc" Concatenate N envelopes into a new envelope (from snd/env.scm)."
+ >array { envs }
+ envs object-length 1 = if
+ envs 0 array-ref
else
- 0
+ 0.0 { xoff }
+ #() { rne }
+ envs each { en }
+ en first-ref { firstx }
+ rne object-length 0> if
+ rne last-ref en second-ref f= if
+ xoff 0.01 f- to xoff
+ 2
+ else
+ 0
+ then
+ else
+ 0
+ then { beg }
+ en object-length beg ?do
+ en i object-ref { x }
+ en i 1+ object-ref { y }
+ rne x firstx f- xoff f+ array-push
+ y array-push to rne
+ 2 +loop
+ rne -2 object-ref 0.01 f+ to xoff
+ end-each
+ rne
then
- else
- 0
- then { beg }
- en object-length beg ?do
- en i object-ref { x }
- en i 1+ object-ref { y }
- rne x firstx f- xoff f+ array-push y array-push to rne
- 2 +loop
- rne -2 object-ref 0.01 f+ to xoff
- end-each
- rne
- then
;
\ ;;; -------- repeat-envelope
-: repeat-envelope <{ ur-env repeats :optional reflected #f normalized #f -- en }>
- doc" repeats UR-ENV REPEATS times.\n\
+: repeat-envelope <{ ur-env repeats
+ :optional reflected #f normalized #f -- en }>
+ doc" Repeat UR-ENV REPEATS times.\n\
#( 0 0 100 1 ) 2 repeat-envelope => #( 0 0 100 1 101 0 201 1 )\n\
If the final y value is different from the first y value, \
a quick ramp is inserted between repeats. \
NORMALIZED causes the new envelope's x axis to have the same extent as the original's. \
REFLECTED causes every other repetition to be in reverse."
- repeats reflected if f2/ fround->s then { times }
- reflected if
- ur-env envelope-last-x { lastx }
- ur-env array-copy { n-env }
- ur-env 0 -3 array-subarray array-reverse { r-env }
- r-env object-length 1- 0 ?do
- r-env i object-ref { xx }
- r-env i 1+ object-ref { yy }
- n-env #( lastx yy f- lastx f+ xx ) array-append to n-env
- 2 +loop
- n-env
- else
- ur-env
- then { e }
- e second-ref { first-y }
- e envelope-last-x { x-max }
- e first-ref { x }
- first-y e last-ref f= { first-y-is-last-y }
- #( x first-y ) { new-env }
- times 0 ?do
- e object-length 1- 2 ?do
- e i object-ref e i 2- object-ref f- x f+ to x
- new-env #( x e i 1+ object-ref ) array-append to new-env
- 2 +loop
- i times 1- < first-y-is-last-y not && if
- x-max 100.0 f/ x f+ to x
- new-env #( x first-y ) array-append to new-env
- then
- loop
- normalized if
- x-max x f/ { scl }
- new-env map! *key* i 2 mod 0= if scl f* then end-map ( new-env' )
- else
- new-env
- then
+ repeats reflected if
+ f2/ fround->s
+ then { times }
+ reflected if
+ ur-env envelope-last-x { lastx }
+ ur-env array-copy { n-env }
+ ur-env 0 -3 array-subarray array-reverse { r-env }
+ r-env object-length 1- 0 ?do
+ r-env i object-ref { xx }
+ r-env i 1+ object-ref { yy }
+ n-env #( lastx yy f- lastx f+ xx ) array-append to n-env
+ 2 +loop
+ n-env
+ else
+ ur-env
+ then { e }
+ e second-ref { first-y }
+ e envelope-last-x { x-max }
+ e first-ref { x }
+ first-y e last-ref f= { first-y-is-last-y }
+ #( x first-y ) { new-env }
+ times 0 ?do
+ e object-length 1- 2 ?do
+ e i object-ref e i 2- object-ref f- x f+ to x
+ new-env #( x e i 1+ object-ref ) array-append to new-env
+ 2 +loop
+ i times 1- < first-y-is-last-y not && if
+ x-max 100.0 f/ x f+ to x
+ new-env #( x first-y ) array-append to new-env
+ then
+ loop
+ normalized if
+ x-max x f/ { scl }
+ new-env map!
+ *key* i 2 mod 0= if
+ scl f*
+ then
+ end-map ( new-env' )
+ else
+ new-env
+ then
;
\ ;;; -------- power-env
: make-power-env <{ envelope :key scaler 1.0 offset 0.0 duration 1.0 -- pe }>
- envelope -3 object-ref envelope 0 object-ref f- { xext }
- 0 { jj }
- envelope length 3.0 f/ fround->s 1- ( len ) make-array map!
- envelope jj object-ref { x0 }
- envelope jj 3 + object-ref { x1 }
- envelope jj 1+ object-ref { y0 }
- envelope jj 4 + object-ref { y1 }
- envelope jj 2+ object-ref { base }
- 3 +to jj
- :envelope #( 0.0 y0 1.0 y1 )
- :base base
- :scaler scaler
- :offset offset
- :duration x1 x0 f- xext f/ duration f* make-env
- end-map { envs }
- #{ :envs envs
- :current-env 0
- :current-pass envs 0 array-ref mus-length }
+ envelope -3 object-ref envelope 0 object-ref f- { xext }
+ 0 { jj }
+ envelope length 3.0 f/ fround->s 1- ( len ) make-array map!
+ envelope jj object-ref { x0 }
+ envelope jj 3 + object-ref { x1 }
+ envelope jj 1+ object-ref { y0 }
+ envelope jj 4 + object-ref { y1 }
+ envelope jj 2+ object-ref { base }
+ 3 +to jj
+ :envelope #( 0.0 y0 1.0 y1 )
+ :base base
+ :scaler scaler
+ :offset offset
+ :duration x1 x0 f- xext f/ duration f* make-env
+ end-map { envs }
+ #{ :envs envs
+ :current-env 0
+ :current-pass envs 0 array-ref mus-length }
;
: power-env ( pe -- val )
- { pe }
- pe :envs hash-ref pe :current-env hash-ref array-ref env ( val )
- pe :current-pass hash-ref 1- { pass }
- pass 0= if
- pe :current-env pe :current-env hash-ref 1+ hash-set!
- ( pe ) :envs hash-ref pe :current-env hash-ref array-ref mus-length to pass
- then
- pe :current-pass pass hash-set! drop
- ( val )
+ { pe }
+ pe :envs hash-ref pe :current-env hash-ref array-ref env ( val )
+ pe :current-pass hash-ref 1- { pass }
+ pass 0= if
+ pe :current-env pe :current-env hash-ref 1+ hash-set!
+ ( pe ) :envs hash-ref pe :current-env hash-ref
+ array-ref mus-length to pass
+ then
+ pe :current-pass pass hash-set! drop
+ ( val )
;
[defined] env-channel [if]
- hide
- : pec-cb { pe beg snd chn edpos -- prc; self -- curbeg }
- 0 proc-create pe , beg , snd , chn , edpos , ( prc )
- does> { self -- curbeg }
- self @ { pe }
- self cell+ @ { beg }
- self 2 cells + @ { snd }
- self 3 cells + @ { chn }
- self 4 cells + @ { edpos }
- pe :envs hash-ref each { e }
- e mus-length 1+ { len }
- e beg len snd chn edpos env-channel drop
- len +to beg
- end-each
- beg
- ;
- set-current
- : power-env-channel <{ pe
- :optional beg 0 dur #f snd #f chn #f edpos #f edname "power-env-channel" -- curbeg }>
- pe beg snd chn edpos pec-cb edname as-one-edit
- ;
- previous
+ hide
+ : pec-cb { pe beg snd chn edpos -- prc; self -- curbeg }
+ 0 proc-create ( prc )
+ pe , beg , snd , chn , edpos ,
+ does> { self -- curbeg }
+ self @ { pe }
+ self cell+ @ { beg }
+ self 2 cells + @ { snd }
+ self 3 cells + @ { chn }
+ self 4 cells + @ { edpos }
+ pe :envs hash-ref each { e }
+ e mus-length 1+ { len }
+ e beg len snd chn edpos env-channel drop
+ len +to beg
+ end-each
+ beg
+ ;
+ set-current
+
+ : power-env-channel <{ pe :optional beg 0 dur #f snd #f chn #f edpos #f edname "power-env-channel" -- curbeg }>
+ pe beg snd chn edpos pec-cb edname as-one-edit
+ ;
+ previous
[then]
\ ;;; here's a simpler version that takes the breakpoint list, rather than the power-env structure:
[defined] xramp-channel [if]
- hide
- : powc-cb { en beg dur snd chn edpos -- prc; self -- base }
- dur snd chn #f frames || to dur
- 0 proc-create en , beg , dur , snd , chn , edpos , ( prc )
- does> { self -- base }
- self @ { en }
- self cell+ @ { curbeg }
- self 2 cells + @ { dur }
- self 3 cells + @ { snd }
- self 4 cells + @ { chn }
- self 5 cells + @ { edpos }
- en 0 array-ref { x1 }
- en -3 object-ref x1 f- { xrange }
- en 1 array-ref { y1 }
- en 2 array-ref { base }
- 0.0 0.0 { x0 y0 }
- en length 3 ?do
- x1 to x0
- y1 to y0
- en i object-ref to x1
- en i 1+ object-ref to y1
- x1 x0 f- xrange f/ dur f* fround->s { curdur }
- y0 y1 base curbeg curdur snd chn edpos xramp-channel drop
- curdur +to curbeg
- en i 2+ object-ref to base
- 3 +loop
- base
- ;
- set-current
- : powenv-channel <{ envelope :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- \ ;; envelope with a separate base for each segment:
- \ #( 0 0 0.325 1 1 32.0 2 0 32.0 ) powenv-channel
- envelope length 3 = if
- envelope 1 array-ref beg dur snd chn edpos scale-channel
- else
- $" %s %s %s %s" #( envelope beg dur get-func-name ) string-format { origin }
- envelope beg dur snd chn edpos powc-cb origin as-one-edit
- then
- ;
- previous
+ hide
+ : powc-cb { en beg dur snd chn edpos -- prc; self -- base }
+ dur snd chn #f framples || to dur
+ 0 proc-create ( prc )
+ en , beg , dur , snd , chn , edpos ,
+ does> { self -- base }
+ self @ { en }
+ self cell+ @ { curbeg }
+ self 2 cells + @ { dur }
+ self 3 cells + @ { snd }
+ self 4 cells + @ { chn }
+ self 5 cells + @ { edpos }
+ en 0 array-ref { x1 }
+ en -3 object-ref x1 f- { xrange }
+ en 1 array-ref { y1 }
+ en 2 array-ref { base }
+ 0.0 0.0 { x0 y0 }
+ en length 3 ?do
+ x1 to x0
+ y1 to y0
+ en i object-ref to x1
+ en i 1+ object-ref to y1
+ x1 x0 f- xrange f/ dur f* fround->s { curdur }
+ y0 y1 base curbeg curdur snd chn edpos
+ xramp-channel drop
+ curdur +to curbeg
+ en i 2+ object-ref to base
+ 3 +loop
+ base
+ ;
+ set-current
+
+ \ ;; envelope with a separate base for each segment:
+ \ #( 0 0 0.325 1 1 32.0 2 0 32.0 ) powenv-channel
+ : powenv-channel <{ envelope :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
+ envelope length 3 = if
+ envelope 1 array-ref beg dur snd chn edpos
+ scale-channel
+ else
+ "%s %s %s %s"
+ #( envelope beg dur get-func-name )
+ string-format { origin }
+ envelope beg dur snd chn edpos powc-cb
+ origin as-one-edit
+ then
+ ;
+ previous
[then]
\ ;;; by Anders Vinjar:
@@ -558,78 +639,86 @@ REFLECTED causes every other repetition to be in reverse."
\ ;;; xgrid is how fine a solution to sample our new envelope with.
: envelope-exp <{ en1 :optional power 1.0 xgrid 100 -- en2 }>
- en1 min-envelope { mn }
- en1 max-envelope mn f- { largest-diff }
- en1 first-ref { x-min }
- en1 envelope-last-x { x-max }
- x-max x-min f- xgrid f/ { x-incr }
- #() { en2 }
- x-min { x }
- 0.0 { y }
- largest-diff f0= if
- begin
- x en1 1.0 envelope-interp to y
- en2 #( x y ) array-append to en2
- x-incr x f+ to x
- x x-max f>=
- until
- else
- begin
- x en1 1.0 envelope-interp to y
- en2 #( x y mn f- largest-diff f/ power f** largest-diff f* mn f+ ) array-append to en2
- x-incr x f+ to x
- x x-max f>=
- until
- then
- en2
+ en1 min-envelope { mn }
+ en1 max-envelope mn f- { largest-diff }
+ en1 first-ref { x-min }
+ en1 envelope-last-x { x-max }
+ x-max x-min f- xgrid f/ { x-incr }
+ #() { en2 }
+ x-min { x }
+ 0.0 { y }
+ largest-diff f0= if
+ begin
+ x en1 1.0 envelope-interp to y
+ en2 #( x y ) array-append to en2
+ x-incr x f+ to x
+ x x-max f>=
+ until
+ else
+ begin
+ x en1 1.0 envelope-interp to y
+ en2 #( x
+ y mn f- largest-diff f/ power f**
+ largest-diff f* mn f+ ) array-append to en2
+
+ x-incr x f+ to x
+ x x-max f>=
+ until
+ then
+ en2
;
\ ;;; rms-envelope
[defined] make-sampler [if]
- : rms-envelope <{ file :key beg 0.0 dur #f rfreq 30.0 db #f -- en }>
- file find-file to file
- file false? if 'no-such-file #( get-func-name file ) fth-throw then
- #() { en }
- rfreq 1/f { incr }
- file mus-sound-srate { fsr }
- incr fsr f* fround->s { incrsamps }
- beg fsr f* fround->s { start }
- start file 0 1 #f make-sampler { reader }
- dur if
- fsr dur f* start f+ fround->s file mus-sound-frames min
- else
- file mus-sound-frames
- then { end }
- :size incrsamps make-moving-average { rms }
- end 0 ?do
- 0.0 { rms-val }
- incrsamps 0 ?do
- reader #() apply { val }
- rms val dup f* moving-average to rms-val
- loop
- en i fsr f/ array-push to en
- rms-val fsqrt to rms-val
- db if
- rms-val 0.00001 f< if
- -100.0
- else
- rms-val flog 10.0 flog f/ 20.0 f*
- then
- else
- rms-val
- then en swap array-push to en
- incrsamps +loop
- en array-reverse
- ;
+ : rms-envelope <{ file :key beg 0.0 dur #f rfreq 30.0 db #f -- en }>
+ file find-file to file
+ file unless
+ 'no-such-file #( "%s: %S" get-func-name file ) fth-throw
+ then
+ #() { en }
+ rfreq 1/f { incr }
+ file mus-sound-srate { fsr }
+ incr fsr f* fround->s { incrsamps }
+ beg fsr f* fround->s { start }
+ start file 0 1 #f make-sampler { reader }
+ dur if
+ fsr dur f* start f+ fround->s
+ file mus-sound-framples min
+ else
+ file mus-sound-framples
+ then { end }
+ :size incrsamps make-moving-average { rms }
+ end 0 ?do
+ 0.0 { rms-val }
+ incrsamps 0 ?do
+ reader #() apply { val }
+ rms val dup f* moving-average to rms-val
+ loop
+ en i fsr f/ array-push to en
+ rms-val fsqrt to rms-val
+ db if
+ rms-val 0.00001 f< if
+ -100.0
+ else
+ rms-val flog 10.0 flog f/ 20.0 f*
+ then
+ else
+ rms-val
+ then en swap array-push to en
+ incrsamps +loop
+ en array-reverse
+ ;
[then]
\ ;;; -------- normalize-envelope
: normalize-envelope <{ en1 :optional new-max 1.0 -- en2 }>
- doc" Scales envelope by NEW-MAX / max-envelope(EN1)."
- en1 second-ref en1 length 1 ?do en1 i object-ref fabs fmax 2 +loop { peak }
- en1 new-max peak f/ 0.0 scale-envelope
+ doc" Scale envelope by NEW-MAX / max-envelope(EN1)."
+ en1 second-ref en1 length 1 ?do
+ en1 i object-ref fabs fmax
+ 2 +loop { peak }
+ en1 new-max peak f/ 0.0 scale-envelope
;
\ env.fs ends here
diff --git a/env.rb b/env.rb
index 1541914..205c8cb 100644
--- a/env.rb
+++ b/env.rb
@@ -1,11 +1,9 @@
# env.rb -- snd/env.scm
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Sat Sep 20 23:24:17 CEST 2003
-# Changed: Mon Nov 22 13:20:28 CET 2010
+# Created: 03/09/20 23:24:17
+# Changed: 14/11/13 04:52:42
-# Commentary:
-#
# module Env (see env.scm)
# envelope_interp(x, en, base)
# window_envelope(beg, dur, en)
@@ -20,7 +18,7 @@
# scale_envelope(en, scale, offset)
# reverse_envelope(en) alias envelope_reverse
# concatenate_envelopes(*envs) alias envelope_concatenate
-# repeat_envelope(ur_env, repeats, reflect, x_normalized) alias envelope_repeat
+# repeat_envelope(ur_env, repeats, reflect, x_normalized) alias envelope_repeat
#
# class Power_env
# initialize(*rest)
@@ -39,7 +37,8 @@
# normalize_envelope(en, new_max)
# x_norm(en, xmax)
#
-# exp_envelope(env, *args) [by Fernando Lopez-Lezcano (nando at ccrma.stanford.edu)]
+# exp_envelope(env, *args)
+# [by Fernando Lopez-Lezcano (nando at ccrma.stanford.edu)]
# db_envelope(env, cutoff, error)
# make_db_env(env, *args)
# semitones_envelope(env, around, error)
@@ -47,17 +46,20 @@
# octaves_envelope(env, around, error)
# make_octaves_env(env, *args)
-# Code:
-
require "clm"
module Env
add_help(:envelope_interp,
"envelope_interp(*args)
-envelope_interp(x, env, base = 1.0) -> value of env at x; \
-base controls connecting segment type: envelope_interp(0.3, [0, 0, 0.5, 1, 1, 0]) -> 0.6")
+envelope_interp(x, env, base = 1.0) ==> value of env at x; \
+BASE controls connecting segment type: \
+envelope_interp(0.3, [0, 0, 0.5, 1, 1, 0]) ==> 0.6")
def envelope_interp(x, en, base = 1.0)
- en.map! do |y| y.to_f end unless en.empty?
+ unless en.empty?
+ en.map! do |y|
+ y.to_f
+ end
+ end
if en.empty?
0.0
else
@@ -86,11 +88,15 @@ base controls connecting segment type: envelope_interp(0.3, [0, 0, 0.5, 1, 1, 0]
end
add_help(:window_envelope,
- "window_envelope(beg, dur, env) \
-portion of env lying between x axis values beg and end: \
-window_envelope(1.0, 3.0, [0.0, 0.0, 5.0, 1.0]) -> [1.0, 0.2, 3.0, 0.6]")
+ "window_envelope(beg, dur, env) \
+Portion of ENV lying between x axis values BEG and DUR: \
+window_envelope(1.0, 3.0, [0.0, 0.0, 5.0, 1.0]) ==> [1.0, 0.2, 3.0, 0.6]")
def window_envelope(beg, dur, en)
- en.map! do |x| x.to_f end unless en.empty?
+ unless en.empty?
+ en.map! do |x|
+ x.to_f
+ end
+ end
nenv = []
lasty = en.empty? ? 0.0 : en[1]
len = en.length
@@ -124,10 +130,18 @@ window_envelope(1.0, 3.0, [0.0, 0.0, 5.0, 1.0]) -> [1.0, 0.2, 3.0, 0.6]")
add_help(:map_envelopes,
"map_envelopes(env1, env2, &func) \
-maps func over the breakpoints in env1 and env2 returning a new envelope")
+Maps FUNC over the breakpoints in ENV1 and ENV2 returning a new envelope.")
def map_envelopes(en1, en2, &func)
- en1.map! do |x| x.to_f end unless en1.empty?
- en2.map! do |x| x.to_f end if array?(en2) and (not en2.empty?)
+ unless en1.empty?
+ en1.map! do |x|
+ x.to_f
+ end
+ end
+ if array?(en2) and (not en2.empty?)
+ en2.map! do |x|
+ x.to_f
+ end
+ end
xs = []
at0 = lambda do |e|
diff = e.first
@@ -149,7 +163,8 @@ maps func over the breakpoints in env1 and env2 returning a new envelope")
ee2 = at0.call(en2)
newe = []
xs.uniq.sort.each do |x|
- newe.push(x, func.call(envelope_interp(x, ee1), envelope_interp(x, ee2)))
+ newe.push(x,
+ func.call(envelope_interp(x, ee1), envelope_interp(x, ee2)))
end
newe
end
@@ -158,33 +173,49 @@ maps func over the breakpoints in env1 and env2 returning a new envelope")
add_help(:multiply_envelopes,
"multiply_envelopes(env1, env2) \
-multiplies break-points of env1 and env2 returning a new envelope: \
-multiply_envelopes([0, 0, 2, 0.5], [0, 0, 1, 2, 2, 1]) -> [0.0, 0.0, 0.5, 0.5, 1.0, 0.5]")
+Multiplies break-points of ENV1 and ENV2 returning a new envelope: \
+multiply_envelopes([0, 0, 2, 0.5], [0, 0, 1, 2, 2, 1]) ==> \
+[0.0, 0.0, 0.5, 0.5, 1.0, 0.5]")
def multiply_envelopes(en1, en2)
- map_envelopes(en1, en2) do |x, y| x * y end
+ map_envelopes(en1, en2) do |x, y|
+ x * y
+ end
end
add_help(:add_envelopes,
- "add_envelopes(env1, env2) adds break-points of env1 and env2 returning a new envelope")
+ "add_envelopes(env1, env2) \
+Adds break-points of ENV1 and ENV2 returning a new envelope.")
def add_envelopes(en1, en2)
- map_envelopes(en1, en2) do |x, y| x + y end
+ map_envelopes(en1, en2) do |x, y|
+ x + y
+ end
end
- add_help(:max_envelope, "max_envelope(env) -> max y value in env")
+ add_help(:max_envelope,
+ "max_envelope(env) \
+Returns max y value in ENV.")
def max_envelope(en)
mx = en[1].to_f
- 1.step(en.length - 1, 2) do |i| mx = [mx, en[i]].max.to_f end
+ 1.step(en.length - 1, 2) do |i|
+ mx = [mx, en[i]].max.to_f
+ end
mx
end
- add_help(:min_envelope, "min_envelope(env) -> min y value in env")
+ add_help(:min_envelope,
+ "min_envelope(env) \
+Returns min y value in ENV.")
def min_envelope(en)
mn = en[1].to_f
- 1.step(en.length - 1, 2) do |i| mn = [mn, en[i]].min.to_f end
+ 1.step(en.length - 1, 2) do |i|
+ mn = [mn, en[i]].min.to_f
+ end
mn
end
- add_help(:integrate_envelope, "integrate_envelope(env) -> area under env")
+ add_help(:integrate_envelope,
+ "integrate_envelope(env) \
+Returns area under ENV.")
def integrate_envelope(en)
sum = 0.0
0.step(en.length - 3, 2) do |i|
@@ -193,36 +224,47 @@ multiply_envelopes([0, 0, 2, 0.5], [0, 0, 1, 2, 2, 1]) -> [0.0, 0.0, 0.5, 0.5, 1
sum
end
- add_help(:envelope_last_x, "envelope_last_x(env) -> max x axis break point position")
+ add_help(:envelope_last_x,
+ "envelope_last_x(env) \
+Returns max x axis break point position.")
def envelope_last_x(en)
en.empty? ? 0.0 : en[-2]
end
add_help(:stretch_envelope,
"stretch_envelope(fn, old_att, new_att, old_dec, new_dec) \
-takes FN and returns a new envelope based on it but with the attack \
+Takes FN and returns a new envelope based on it but with the attack \
and optionally decay portions stretched or squeezed; \
OLD_ATT is the original x axis attack end point, \
NEW_ATT is where that section should end in the new envelope. \
Similarly for OLD_DEC and NEW_DEC. \
-This mimics divseg in early versions of CLM and its antecedents in Sambox and Mus10 (linen).
-stretch_envelope([0, 0, 1, 1], 0.1, 0.2) -> [0, 0, 0.2, 0.1, 1.0, 1]
+This mimics divseg in early versions of CLM \
+and its antecedents in Sambox and Mus10 (linen).
+stretch_envelope([0, 0, 1, 1], 0.1, 0.2) ==> [0, 0, 0.2, 0.1, 1.0, 1]
stretch_envelope([0, 0, 1, 1, 2, 0], 0.1, 0.2, 1.5, 1.6)
- -> [0, 0, 0.2, 0.1, 1.1, 1, 1.6, 0.5, 2.0, 0]")
- def stretch_envelope(fn, old_att = false, new_att = false, old_dec = false, new_dec = false)
+==> [0, 0, 0.2, 0.1, 1.1, 1, 1.6, 0.5, 2.0, 0]")
+ def stretch_envelope(fn, old_att = false, new_att = false,
+ old_dec = false, new_dec = false)
unless array?(fn)
error("%s: need an envelope, %s", get_func_name, fn.inspect)
end
- fn.map! do |x| x.to_f end unless fn.empty?
+ unless fn.empty?
+ fn.map! do |x|
+ x.to_f
+ end
+ end
if old_att and (not new_att)
- Snd.raise(:wrong_number_of_args, old_att.inspect, "old_att but no new_att?")
+ Snd.raise(:wrong_number_of_args,
+ old_att.inspect,
+ "old_att but no new_att?")
else
if (not new_att)
fn
else
if old_dec and (not new_dec)
Snd.raise(:wrong_number_of_args,
- format("%s %s %s", old_att, new_att, old_dec), "old_dec but no new_dec?")
+ format("%s %s %s", old_att, new_att, old_dec),
+ "old_dec but no new_dec?")
else
new_x = x0 = fn[0]
last_x = fn[-2]
@@ -272,14 +314,18 @@ stretch_envelope([0, 0, 1, 1, 2, 0], 0.1, 0.2, 1.5, 1.6)
end
add_help(:scale_envelope,
- "scale_envelope(env, scale, offset = 0.0) \
-scales y axis values by SCALER and optionally adds OFFSET")
+ "scale_envelope(env, scale, offset = 0.0) \
+Scales y axis values by SCALER and optionally adds OFFSET.")
def scale_envelope(en, scale, offset = 0.0)
- 1.step(en.length - 1, 2) do |i| en[i] = en[i] * scale + offset end
+ 1.step(en.length - 1, 2) do |i|
+ en[i] = en[i] * scale + offset
+ end
en
end
- add_help(:reverse_envelope, "reverse_envelope(env) reverses the breakpoints in ENV")
+ add_help(:reverse_envelope,
+ "reverse_envelope(env) \
+Reverses the breakpoints in ENV.")
def reverse_envelope(en1)
len = en1.length
if len.zero? or len == 2
@@ -296,7 +342,8 @@ scales y axis values by SCALER and optionally adds OFFSET")
alias envelope_reverse reverse_envelope
add_help(:concatenate_envelopes,
- "concatenate_envelopes(*envs) concatenates its arguments into a new envelope")
+ "concatenate_envelopes(*envs) \
+Concatenates its arguments into a new envelope.")
def concatenate_envelopes(*envs)
if envs.length == 1
envs.first
@@ -304,13 +351,17 @@ scales y axis values by SCALER and optionally adds OFFSET")
xoff = 0.0
ren = []
envs.each do |en|
- (en or []).map! do |x| x.to_f end
+ (en or []).map! do |x|
+ x.to_f
+ end
firstx = en.first
if ren[-1] == en[1]
xoff -= 0.01
en = en[2..-1]
end
- 0.step(en.length - 1, 2) do |i| ren.push(xoff + (en[i] - firstx), en[i + 1]) end
+ 0.step(en.length - 1, 2) do |i|
+ ren.push(xoff + (en[i] - firstx), en[i + 1])
+ end
xoff += 0.01 + ren[-2]
end
ren
@@ -319,15 +370,19 @@ scales y axis values by SCALER and optionally adds OFFSET")
alias envelope_concatenate concatenate_envelopes
add_help(:repeat_envelope,
- "repeat_envelope(ur_env, repeats, reflected = false, x_normalized = false) \
-repeats ENV REPEATS times.
-repeat_envelope([0, 0, 100, 1] 2) -> [0, 0, 100, 1, 101, 0, 201, 1]
+ "repeat_envelope(ur_env, repeats, reflected = false, \
+x_normalized = false) \
+Repeats ENV REPEATS times.
+repeat_envelope([0, 0, 100, 1] 2) ==> [0, 0, 100, 1, 101, 0, 201, 1]
If the final y value is different from the first y value, \
a quick ramp is inserted between repeats. \
-X_NORMALIZED causes the new envelope's x axis to have the same extent as the original's. \
+X_NORMALIZED causes the new envelope's x axis \
+to have the same extent as the original's. \
REFLECTED causes every other repetition to be in reverse.")
def repeat_envelope(ur_env, repeats, reflected = false, x_normalized = false)
- (ur_env or []).map! do |x| x.to_f end
+ (ur_env or []).map! do |x|
+ x.to_f
+ end
tms = (reflected ? (repeats / 2).floor : repeats)
en = if reflected
lastx = ur_env[-2]
@@ -340,7 +395,9 @@ REFLECTED causes every other repetition to be in reverse.")
else
ur_env
end
- (en or []).map! do |x| x.to_f end
+ (en or []).map! do |x|
+ x.to_f
+ end
first_y = en[1]
x_max = en[-2]
x = en.first
@@ -359,7 +416,9 @@ REFLECTED causes every other repetition to be in reverse.")
end
if x_normalized
scl = x_max / x
- 0.step(new_env.length - 1, 2) do |i| new_env[i] *= scl end
+ 0.step(new_env.length - 1, 2) do |i|
+ new_env[i] *= scl
+ end
end
new_env
end
@@ -373,7 +432,9 @@ REFLECTED causes every other repetition to be in reverse.")
[:scaler, 1.0],
[:offset, 0.0],
[:duration, 0.0])
- envelope.map! do |val| Float(val) end
+ envelope.map! do |val|
+ Float(val)
+ end
xext = envelope[-3] - envelope.first
j = 0
@envs = make_array(envelope.length / 3 - 1) do |i|
@@ -424,13 +485,15 @@ REFLECTED causes every other repetition to be in reverse.")
pe.power_env
end
- def power_env_channel(pe, beg = 0, dur = false, snd = false, chn = false, edpos = false)
+ def power_env_channel(pe, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
pe.power_env_channel(beg, dur, snd, chn, edpos, get_func_name)
end
- def powenv_channel(envelope, beg = 0, dur = false, snd = false, chn = false, edpos = false)
+ def powenv_channel(envelope, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
curbeg = beg
- fulldur = (dur or frames(snd, chn, edpos))
+ fulldur = (dur or framples(snd, chn, edpos))
len = envelope.length
x1 = envelope[0]
xrange = envelope[len - 3] - x1
@@ -465,7 +528,11 @@ REFLECTED causes every other repetition to be in reverse.")
# xgrid is how fine a solution to sample our new envelope with.
def envelope_exp(en, power = 1.0, xgrid = 100)
- en.map! do |x| x.to_f end unless en.empty?
+ unless en.empty?
+ en.map! do |x|
+ x.to_f
+ end
+ end
mn = min_envelope(en)
largest_diff = max_envelope(en) - mn
x_min = en.first
@@ -474,9 +541,10 @@ REFLECTED causes every other repetition to be in reverse.")
new_en = []
x_min.step(x_max, x_incr) do |x|
y = envelope_interp(x, en)
- new_en.push(x, (largest_diff.zero? ?
- y :
- (mn + largest_diff * (((y - mn) / largest_diff) ** power))))
+ new_en.push(x,
+ (largest_diff.zero? ?
+ y :
+ (mn + largest_diff * (((y - mn) / largest_diff) ** power))))
end
new_en
end
@@ -494,7 +562,9 @@ REFLECTED causes every other repetition to be in reverse.")
incrsamps = (incr * sfr).round
start = (beg * fsr).round
reader = make_sampler(start, file)
- fin = dur ? [start + (fsr * dur).round, mus_sound_frames(file)].min : mus_sound_frames(file)
+ fin = dur ?
+ [start + (fsr * dur).round, mus_sound_framples(file)].min :
+ mus_sound_framples(file)
rms = make_moving_average(incrsamps)
0.step(fin, incrsamps) do |i|
rms_val = 0.0
@@ -522,18 +592,22 @@ REFLECTED causes every other repetition to be in reverse.")
def normalize_envelope(en, new_max = 1.0)
mx = en[1].abs.to_f
- 1.step(en.length - 1, 2) do |i| mx = [mx, en[i].abs].max.to_f end
+ 1.step(en.length - 1, 2) do |i|
+ mx = [mx, en[i].abs].max.to_f
+ end
scale_envelope(en, new_max / mx)
end
def x_norm(en, xmax)
scl = xmax / en[-2].to_f
- en.each_pair do |x, y| [x * scl, y.to_f] end.flatten
+ en.each_pair do |x, y|
+ [x * scl, y.to_f]
+ end.flatten
end
- # ;;;=============================================================================
+ # ;;;=======================================================================
# ;;; Exponential envelopes
- # ;;;=============================================================================
+ # ;;;=======================================================================
#
# ;;; Approximate an exponential envelope with a given base and error bound
# ;;; by Fernando Lopez-Lezcano (nando at ccrma.stanford.edu)
@@ -589,8 +663,10 @@ REFLECTED causes every other repetition to be in reverse.")
yscl = offset + y * scaler
nyscl = offset + ny * scaler
result.push(x)
- result.push((((not ycutoff) or base ** yscl >= ycutoff) ? (out_scaler * base ** yscl) : 0.0))
- xs, ys = exp_seg.call(x, base ** yscl, nx, base ** nyscl, yscl, nyscl, error)
+ result.push((((not ycutoff) or base ** yscl >= ycutoff) ?
+ (out_scaler * base ** yscl) : 0.0))
+ xs, ys = exp_seg.call(x, base ** yscl,
+ nx, base ** nyscl, yscl, nyscl, error)
unless xs.empty?
ys_scaled = vct_scale!(list2vct(ys), out_scaler)
xs.each_with_index do |xx, ii|
@@ -600,7 +676,8 @@ REFLECTED causes every other repetition to be in reverse.")
end
end
result.push(nx)
- result.push((((not ycutoff) or base ** nyscl >= ycutoff) ? (out_scaler * base ** nyscl) : 0.0))
+ result.push((((not ycutoff) or base ** nyscl >= ycutoff) ?
+ (out_scaler * base ** nyscl) : 0.0))
end
# ;;; Amplitude envelope in dBs
@@ -610,7 +687,8 @@ REFLECTED causes every other repetition to be in reverse.")
# ;;; where:
# ;;; vref=1.0 reference value = digital clipping
def db_envelope(env, cutoff = -70, error = 0.01)
- exp_envelope(env, :base, 10.0, :scaler, 1.0 / 20, :cutoff, cutoff, :error, error)
+ exp_envelope(env, :base, 10.0, :scaler, 1.0 / 20,
+ :cutoff, cutoff, :error, error)
end
def make_db_env(env, *args)
@@ -623,8 +701,8 @@ REFLECTED causes every other repetition to be in reverse.")
[:len, 0],
[:cutoff, -70],
[:error, 0.01])
- make_env(:envelope, db_envelope(env, cutoff, error), :scaler, scaler, :offset, offset,
- :base, base, :duration, dur, :length, len)
+ make_env(:envelope, db_envelope(env, cutoff, error), :scaler, scaler,
+ :offset, offset, :base, base, :duration, duration, :length, len)
end
# ;;; Pitch envelopes (y units are semitone and octave intervals)
@@ -642,7 +720,8 @@ REFLECTED causes every other repetition to be in reverse.")
[:duration, 0.0],
[:len, 0],
[:error, 0.01])
- make_env(:envelope, semitones_envelope(env, around, error), :scaler, scaler, :offset, offset,
+ make_env(:envelope, semitones_envelope(env, around, error),
+ :scaler, scaler, :offset, offset,
:base, base, :duration, dur, :length, len)
end
@@ -660,7 +739,8 @@ REFLECTED causes every other repetition to be in reverse.")
[:duration, 0.0],
[:len, 0],
[:error, 0.01])
- make_env(:envelope, octaves_envelope(env, around, error), :scaler, scaler, :offset, offset,
+ make_env(:envelope, octaves_envelope(env, around, error),
+ :scaler, scaler, :offset, offset,
:base, base, :duration, dur, :length, len)
end
end
@@ -678,9 +758,11 @@ def test_power_env(start, dur, en)
end
with_sound(:channels, 1, :play, 1) do | |
- test_power_env(0, 1, [0, 0, 0.325, 1, 1, 32, 2, 0, 0])
- test_power_env(1.2, 1, [0, 0, 0.325, 1, 1, 32, 2, 0.5, 1, 3, 1, 0.1234, 4, 0, 0])
- test_power_env(2.4, 1, [0, 0, 0, 1, 1, 1, 2, 0.5, 0.123, 3, 1, 321, 4, 0, 0])
+ test_power_env(0, 1, [0, 0, 0.325, 1, 1, 32, 2, 0, 0])
+ test_power_env(1.2, 1,
+ [0, 0, 0.325, 1, 1, 32, 2, 0.5, 1, 3, 1, 0.1234, 4, 0, 0])
+ test_power_env(2.4, 1,
+ [0, 0, 0, 1, 1, 1, 2, 0.5, 0.123, 3, 1, 321, 4, 0, 0])
end
=end
diff --git a/env.scm b/env.scm
index 4f89dcd..80496b4 100644
--- a/env.scm
+++ b/env.scm
@@ -1,6 +1,5 @@
;;; various envelope functions
;;;
-;;; envelope-interp (x env (base 1.0)) -> value of env at x (base controls connecting segment type)
;;; window-envelope (beg end env) -> portion of env lying between x axis values beg and end
;;; map-envelopes (func env1 env2) maps func over the breakpoints in env1 and env2 returning a new envelope
;;; multiply-envelopes (env1 env2) multiplies break-points of env1 and env2 returning a new envelope
@@ -21,361 +20,351 @@
(provide 'snd-env.scm)
-;;; -------- envelope-interp
-
-(define* (envelope-interp x env base) ;env is list of x y breakpoint pairs, interpolate at x returning y
- "(envelope-interp x env (base 1.0)) -> value of env at x; base controls connecting segment
-type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
- (cond ((null? env) 0.0) ;no data -- return 0.0
- ((or (<= x (car env)) ;we're sitting on x val (or if < we blew it)
- (null? (cddr env))) ;or we're at the end of the list
- (cadr env)) ;so return current y value
- ((> (caddr env) x) ;x <= next env x axis value
- (if (or (= (cadr env) (cadddr env))
- (and base (= base 0.0)))
- (cadr env) ;y1=y0, so just return y0 (avoid endless calculations below)
- (if (or (not base) (= base 1.0))
- (+ (cadr env) ;y0+(x-x0)*(y1-y0)/(x1-x0)
- (* (- x (car env))
- (/ (- (cadddr env) (cadr env))
- (- (caddr env) (car env)))))
- (+ (cadr env) ; this does not exactly match xramp-channel
- (* (/ (- (cadddr env) (cadr env))
- (- base 1.0))
- (- (expt base (/ (- x (car env))
- (- (caddr env) (car env))))
- 1.0))))))
- (else (envelope-interp x (cddr env) base)))) ;go on looking for x segment
-
;;; -------- window-envelope (a kinda brute-force translation from the CL version in env.lisp)
-(define (window-envelope beg end env)
- "(window-envelope beg end env) -> portion of env lying between x axis values beg and
-end: (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) -> '(1.0 0.2 3.0 0.6)"
- (let ((nenv '())
- (lasty (if env (cadr env) 0.0))
- (len (length env)))
- (call-with-exit
- (lambda (return-early)
- (do ((i 0 (+ i 2)))
- ((>= i len))
- (let ((x (list-ref env i))
- (y (list-ref env (+ i 1))))
- (set! lasty y)
- (if (null? nenv)
- (if (>= x beg)
- (begin
- (set! nenv (append nenv (list beg (envelope-interp beg env))))
- (if (not (= x beg))
- (if (>= x end)
- (return-early (append nenv (list end (envelope-interp end env))))
- (set! nenv (append nenv (list x y)))))))
- (if (<= x end)
- (begin
- (set! nenv (append nenv (list x y)))
- (if (= x end)
- (return-early nenv)))
- (if (> x end)
- (return-early (append nenv (list end (envelope-interp end env)))))))))
- (append nenv (list end lasty))))))
+(define window-envelope
+ (let ((documentation "(window-envelope beg end e) -> portion of e lying between x axis values beg and
+end: (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) -> '(1.0 0.2 3.0 0.6)"))
+ (lambda (beg end e)
+ (let ((nenv ())
+ (lasty (if e (cadr e) 0.0))
+ (len (length e)))
+ (call-with-exit
+ (lambda (return-early)
+ (do ((i 0 (+ i 2)))
+ ((>= i len))
+ (let ((x (e i))
+ (y (e (+ i 1))))
+ (set! lasty y)
+ (if (null? nenv)
+ (if (>= x beg)
+ (begin
+ (set! nenv (append nenv (list beg (envelope-interp beg e))))
+ (if (not (= x beg))
+ (if (>= x end)
+ (return-early (append nenv (list end (envelope-interp end e))))
+ (set! nenv (append nenv (list x y)))))))
+ (if (<= x end)
+ (begin
+ (set! nenv (append nenv (list x y)))
+ (if (= x end)
+ (return-early nenv)))
+ (if (> x end)
+ (return-early (append nenv (list end (envelope-interp end e)))))))))
+ (append nenv (list end lasty))))))))
;;; -------- map-envelopes like map-across-envelopes in env.lisp
-(define (map-envelopes op e1 e2)
- "(map-envelopes func env1 env2) maps func over the breakpoints in env1 and env2 returning a new envelope"
- (let ((xs '()))
- (letrec ((at0
- (lambda (e)
- (let* ((diff (car e))
- (len (length e))
- (lastx (list-ref e (- len 2)))
- (newe (copy e))) ; it is dangerous (and unclean...) to use list-set! on the original list
- (do ((i 0 (+ i 2)))
- ((>= i len) newe)
- (let ((x (/ (- (list-ref newe i) diff) lastx)))
- (set! xs (cons x xs))
- (list-set! newe i x))))))
- (remove-duplicates
- (lambda (lst)
- (letrec ((rem-dup
- (lambda (lst nlst)
- (cond ((null? lst) nlst)
- ((member (car lst) nlst) (rem-dup (cdr lst) nlst))
- (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
- (rem-dup lst '())))))
-
- (if (null? e1)
- (at0 e2)
- (if (null? e2)
- (at0 e1)
- (let ((ee1 (at0 e1))
- (ee2 (at0 e2))
- (newe '()))
- (set! xs (sort! (remove-duplicates xs) <))
- (let ((len (length xs)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let ((x (list-ref xs i)))
- (set! newe (append newe (list x (op (envelope-interp x ee1) (envelope-interp x ee2)))))))
- newe)))))))
+(define map-envelopes
+ (let ((documentation "(map-envelopes func env1 env2) maps func over the breakpoints in env1 and env2 returning a new envelope"))
+ (lambda (op e1 e2)
+ (let ((xs ()))
+ (letrec ((at0
+ (lambda (e)
+ (let* ((diff (car e))
+ (len (length e))
+ (lastx (e (- len 2)))
+ (newe (copy e)))
+ (do ((i 0 (+ i 2)))
+ ((>= i len) newe)
+ (let ((x (/ (- (newe i) diff) lastx)))
+ (set! xs (cons x xs))
+ (set! (newe i) x))))))
+ (remove-duplicates
+ (lambda (lst)
+ (letrec ((rem-dup
+ (lambda (lst nlst)
+ (cond ((null? lst) nlst)
+ ((member (car lst) nlst) (rem-dup (cdr lst) nlst))
+ (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+ (rem-dup lst ())))))
+
+ (if (null? e1)
+ (at0 e2)
+ (if (null? e2)
+ (at0 e1)
+ (let ((ee1 (at0 e1))
+ (ee2 (at0 e2))
+ (newe ()))
+ (set! xs (sort! (remove-duplicates xs) <))
+ (let ((len (length xs)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((x (xs i)))
+ (set! newe (append newe (list x (op (envelope-interp x ee1) (envelope-interp x ee2)))))))
+ newe)))))))))
;;; -------- multiply-envelopes, add-envelopes
-(define (multiply-envelopes e1 e2)
- "(multiply-envelopes env1 env2) multiplies break-points of env1 and env2 returning a new
-envelope: (multiply-envelopes '(0 0 2 .5) '(0 0 1 2 2 1)) -> '(0 0 0.5 0.5 1.0 0.5)"
- (map-envelopes * e1 e2))
+(define multiply-envelopes
+ (let ((documentation "(multiply-envelopes env1 env2) multiplies break-points of env1 and env2 returning a new
+envelope: (multiply-envelopes '(0 0 2 .5) '(0 0 1 2 2 1)) -> '(0 0 0.5 0.5 1.0 0.5)"))
+ (lambda (e1 e2)
+ (map-envelopes * e1 e2))))
-(define (add-envelopes e1 e2)
- "(add-envelopes env1 env2) adds break-points of env1 and env2 returning a new envelope"
- (map-envelopes + e1 e2))
+(define add-envelopes
+ (let ((documentation "(add-envelopes env1 env2) adds break-points of env1 and env2 returning a new envelope"))
+ (lambda (e1 e2)
+ (map-envelopes + e1 e2))))
;;; -------- max-envelope
-(define (max-envelope env)
- "(max-envelope env) -> max y value in env"
- (define (max-envelope-1 e mx)
- (if (null? e)
- mx
- (max-envelope-1 (cddr e) (max mx (cadr e)))))
- (max-envelope-1 (cddr env) (cadr env)))
+(define max-envelope
+ (let ((documentation "(max-envelope env) -> max y value in env"))
+ (lambda (env1)
+ (define (max-envelope-1 e mx)
+ (if (null? e)
+ mx
+ (max-envelope-1 (cddr e) (max mx (cadr e)))))
+ (max-envelope-1 (cddr env1) (cadr env1)))))
;;; -------- min-envelope
-(define (min-envelope env)
- "(min-envelope env) -> min y value in env"
- (define (min-envelope-1 e mx)
- (if (null? e)
- mx
- (min-envelope-1 (cddr e) (min mx (cadr e)))))
- (min-envelope-1 (cddr env) (cadr env)))
+(define min-envelope
+ (let ((documentation "(min-envelope env) -> min y value in env"))
+ (lambda (env1)
+ (define (min-envelope-1 e mx)
+ (if (null? e)
+ mx
+ (min-envelope-1 (cddr e) (min mx (cadr e)))))
+ (min-envelope-1 (cddr env1) (cadr env1)))))
;;; -------- integrate-envelope
-(define (integrate-envelope env)
- "(integrate-envelope env) -> area under env"
- (define (integrate-envelope-1 e sum)
- (if (or (null? e) (null? (cddr e)))
- sum
- (integrate-envelope-1 (cddr e) (+ sum (* (+ (cadr e) (cadddr e)) .5 (- (caddr e) (car e)))))))
- (integrate-envelope-1 env 0.0))
+(define integrate-envelope
+ (let ((documentation "(integrate-envelope env) -> area under env"))
+ (lambda (env1)
+ (define (integrate-envelope-1 e sum)
+ (if (or (null? e) (null? (cddr e)))
+ sum
+ (integrate-envelope-1 (cddr e) (+ sum (* (+ (cadr e) (cadddr e)) .5 (- (caddr e) (car e)))))))
+ (integrate-envelope-1 env1 0.0))))
;;; -------- envelope-last-x
-(define (envelope-last-x e)
- "(envelope-last-x env) -> max x axis break point position"
- (if (null? (cddr e))
- (car e)
- (envelope-last-x (cddr e))))
+(define envelope-last-x
+ (let ((documentation "(envelope-last-x env) -> max x axis break point position"))
+ (lambda (e)
+ (if (null? (cddr e))
+ (car e)
+ (envelope-last-x (cddr e))))))
;;; -------- stretch-envelope
-(define (stretch-envelope . args)
-
- "(stretch-envelope env old-attack new-attack old-decay new-decay) takes 'env' and
+(define stretch-envelope
+
+ (let ((documentation "(stretch-envelope env old-attack new-attack old-decay new-decay) takes 'env' and
returns a new envelope based on it but with the attack and optionally decay portions stretched
or squeezed; 'old-attack' is the original x axis attack end point, 'new-attack' is where that
section should end in the new envelope. Similarly for 'old-decay' and 'new-decay'. This mimics
divseg in early versions of CLM and its antecedents in Sambox and Mus10 (linen).
(stretch-envelope '(0 0 1 1) .1 .2) -> (0 0 0.2 0.1 1.0 1)
- (stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6) -> (0 0 0.2 0.1 1.1 1 1.6 0.5 2.0 0)"
-
- (let ((fn (list-ref args 0))
- (old-att (if (> (length args) 1) (list-ref args 1) #f))
- (new-att (if (> (length args) 2) (list-ref args 2) #f))
- (old-dec (if (> (length args) 3) (list-ref args 3) #f))
- (new-dec (if (> (length args) 4) (list-ref args 4) #f)))
- (if (and old-att
- (not new-att))
- (throw 'wrong-number-of-args (list "stretch-envelope"
- old-attack
- "old-attack but no new-attack?"))
- (if (not new-att)
- fn
- (if (and old-dec
- (not new-dec))
- (throw 'wrong-number-of-args (list "stretch-envelope"
- old-attack new-attack old-decay
- "old-decay but no new-decay?"))
- (let* ((x0 (car fn))
- (new-x x0)
- (last-x (list-ref fn (- (length fn) 2)))
- (y0 (cadr fn))
- (new-fn (list y0 x0))
- (scl (/ (- new-att x0) (max .0001 (- old-att x0)))))
- (define (stretch-envelope-1 new-fn old-fn)
- (if (null? old-fn)
- new-fn
- (let ((x1 (car old-fn))
- (y1 (cadr old-fn)))
- (if (and (< x0 old-att)
- (>= x1 old-att))
- (begin
- (if (= x1 old-att)
- (set! y0 y1)
- (set! y0 (+ y0 (* (- y1 y0) (/ (- old-att x0) (- x1 x0))))))
- (set! x0 old-att)
- (set! new-x new-att)
- (set! new-fn (cons new-x new-fn))
- (set! new-fn (cons y0 new-fn))
- (set! scl (if old-dec
- (/ (- new-dec new-att) (- old-dec old-att))
- (/ (- last-x new-att) (- last-x old-att))))))
- (if (and old-dec
- (< x0 old-dec)
- (>= x1 old-dec))
- (begin
- (if (= x1 old-dec)
- (set! y0 y1)
- (set! y0 (+ y0 (* (- y1 y0) (/ (- old-dec x0) (- x1 x0))))))
- (set! x0 old-dec)
- (set! new-x new-dec)
- (set! new-fn (cons new-x new-fn))
- (set! new-fn (cons y0 new-fn))
- (set! scl (/ (- last-x new-dec) (- last-x old-dec)))))
- (if (not (= x0 x1))
- (begin
- (set! new-x (+ new-x (* scl (- x1 x0))))
- (set! new-fn (cons new-x new-fn))
- (set! new-fn (cons y1 new-fn))
- (set! x0 x1)
- (set! y0 y1)))
- (stretch-envelope-1 new-fn (cddr old-fn)))))
-
- (if (and old-dec
- (= old-dec old-att))
- (set! old-dec (* .000001 last-x)))
- (reverse (stretch-envelope-1 new-fn (cddr fn)))))))))
+ (stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6) -> (0 0 0.2 0.1 1.1 1 1.6 0.5 2.0 0)"))
+ (lambda* (fn old-att new-att old-dec new-dec)
+
+ (if (and old-att
+ (not new-att))
+ (error 'wrong-number-of-args (list "stretch-envelope"
+ old-att
+ "old-attack but no new-attack?"))
+ (if (not new-att)
+ fn
+ (if (and old-dec
+ (not new-dec))
+ (error 'wrong-number-of-args (list "stretch-envelope"
+ old-att new-att old-dec
+ "old-decay but no new-decay?"))
+ (let* ((x0 (car fn))
+ (new-x x0)
+ (last-x (fn (- (length fn) 2)))
+ (y0 (cadr fn))
+ (new-fn (list y0 x0))
+ (scl (/ (- new-att x0) (max .0001 (- old-att x0)))))
+ (define (stretch-envelope-1 new-fn old-fn)
+ (if (null? old-fn)
+ new-fn
+ (let ((x1 (car old-fn))
+ (y1 (cadr old-fn)))
+ (if (and (< x0 old-att)
+ (>= x1 old-att))
+ (begin
+ (if (= x1 old-att)
+ (set! y0 y1)
+ (set! y0 (+ y0 (* (- y1 y0) (/ (- old-att x0) (- x1 x0))))))
+ (set! x0 old-att)
+ (set! new-x new-att)
+ (set! new-fn (cons y0 (cons new-x new-fn)))
+ (set! scl (if old-dec
+ (/ (- new-dec new-att) (- old-dec old-att))
+ (/ (- last-x new-att) (- last-x old-att))))))
+ (if (and old-dec
+ (< x0 old-dec)
+ (>= x1 old-dec))
+ (begin
+ (if (= x1 old-dec)
+ (set! y0 y1)
+ (set! y0 (+ y0 (* (- y1 y0) (/ (- old-dec x0) (- x1 x0))))))
+ (set! x0 old-dec)
+ (set! new-x new-dec)
+ (set! new-fn (cons y0 (cons new-x new-fn)))
+ (set! scl (/ (- last-x new-dec) (- last-x old-dec)))))
+ (if (not (= x0 x1))
+ (begin
+ (set! new-x (+ new-x (* scl (- x1 x0))))
+ (set! new-fn (cons y1 (cons new-x new-fn)))
+ (set! x0 x1)
+ (set! y0 y1)))
+ (stretch-envelope-1 new-fn (cddr old-fn)))))
+
+ (if (and old-dec
+ (= old-dec old-att))
+ (set! old-dec (* .000001 last-x)))
+ (reverse (stretch-envelope-1 new-fn (cddr fn))))))))))
+
-
;;; -------- scale-envelope
-(define* (scale-envelope e scl (offset 0))
- "(scale-envelope env scaler (offset 0)) scales y axis values by 'scaler' and optionally adds 'offset'"
- (if (null? e)
- '()
- (append (list (car e) (+ offset (* scl (cadr e))))
- (scale-envelope (cddr e) scl offset))))
+(define scale-envelope
+ (let ((documentation "(scale-envelope env scaler (offset 0)) scales y axis values by 'scaler' and optionally adds 'offset'"))
+ (lambda* (e scl (offset 0))
+ (if (null? e)
+ ()
+ (append (list (car e) (+ offset (* scl (cadr e))))
+ (scale-envelope (cddr e) scl offset))))))
;;; -------- reverse-envelope
-(define (reverse-envelope e)
- "(reverse-envelope env) reverses the breakpoints in 'env'"
- (define (reverse-env-1 e newe xd)
- (if (null? e)
- newe
- (reverse-env-1 (cddr e)
- (cons (- xd (car e))
- (cons (cadr e)
- newe))
- xd)))
- (let ((len (length e)))
- (if (or (= len 0) (= len 2))
- e
- (let ((xmax (list-ref e (- len 2))))
- (reverse-env-1 e '() xmax)))))
+(define reverse-envelope
+ (let ((documentation "(reverse-envelope env) reverses the breakpoints in 'env'"))
+ (lambda (e)
+ (define (reverse-env-1 e newe xd)
+ (if (null? e)
+ newe
+ (reverse-env-1 (cddr e)
+ (cons (- xd (car e))
+ (cons (cadr e)
+ newe))
+ xd)))
+ (let ((len (length e)))
+ (if (memv len '(0 2))
+ e
+ (let ((xmax (e (- len 2))))
+ (reverse-env-1 e () xmax)))))))
;;; -------- concatenate-envelopes
-(define (concatenate-envelopes . envs)
- "(concatenate-envelopes :rest envs) concatenates its arguments into a new envelope"
- (define (cat-1 e newe xoff x0)
- (if (null? e)
- newe
- (cat-1 (cddr e)
- (cons (cadr e)
- (cons (+ (- (car e) x0) xoff)
- newe))
- xoff
- x0)))
- (let ((ne '())
- (xoff 0.0))
- (for-each
- (lambda (e)
- (if (and (not (null? ne))
- (= (car ne) (cadr e)))
- (begin
- (set! xoff (- xoff .01))
- (set! ne (cat-1 (cddr e) ne xoff (car e))))
- (set! ne (cat-1 e ne xoff (car e))))
- (set! xoff (+ xoff .01 (cadr ne))))
- envs)
- (reverse ne)))
-
-
-(define* (repeat-envelope ur-env repeats (reflected #f) (normalized #f))
- "(repeat-envelope env repeats (reflected #f) (normalized #f)) repeats 'env' 'repeats'
+(define concatenate-envelopes
+ (let ((documentation "(concatenate-envelopes :rest envs) concatenates its arguments into a new envelope"))
+ (lambda envs
+ (define (cat-1 e newe xoff x0)
+ (if (null? e)
+ newe
+ (cat-1 (cddr e)
+ (cons (cadr e)
+ (cons (+ (- (car e) x0) xoff)
+ newe))
+ xoff
+ x0)))
+ (let ((ne ())
+ (xoff 0.0))
+ (for-each
+ (lambda (e)
+ (if (and (pair? ne)
+ (= (car ne) (cadr e)))
+ (begin
+ (set! xoff (- xoff .01))
+ (set! ne (cat-1 (cddr e) ne xoff (car e))))
+ (set! ne (cat-1 e ne xoff (car e))))
+ (set! xoff (+ xoff .01 (cadr ne))))
+ envs)
+ (reverse ne)))))
+
+
+(define repeat-envelope
+ (let ((documentation "(repeat-envelope env repeats (reflected #f) (normalized #f)) repeats 'env' 'repeats'
times. (repeat-envelope '(0 0 100 1) 2) -> (0 0 100 1 101 0 201 1).
If the final y value is different from the first y value, a quick ramp is
inserted between repeats. 'normalized' causes the new envelope's x axis
to have the same extent as the original's. 'reflected' causes every other
-repetition to be in reverse."
- (let* ((times (if reflected (floor (/ repeats 2)) repeats))
- (e (if reflected
- (let* ((lastx (list-ref ur-env (- (length ur-env) 2)))
- (rev-env (cddr (reverse ur-env)))
- (new-env (reverse ur-env)))
- (while (not (null? rev-env))
- (set! new-env (cons (+ lastx (- lastx (cadr rev-env))) new-env))
- (set! new-env (cons (car rev-env) new-env))
- (set! rev-env (cddr rev-env)))
- (reverse new-env))
- ur-env))
- (first-y (cadr e))
- (x-max (list-ref e (- (length e) 2)))
- (x (car e))
- (first-y-is-last-y (= first-y (list-ref e (- (length e) 1))))
- (new-env (list first-y x))
- (len (length e)))
- (do ((i 0 (+ 1 i)))
- ((= i times))
- (do ((j 2 (+ j 2)))
- ((>= j len))
- (set! x (+ x (- (list-ref e j) (list-ref e (- j 2)))))
- (set! new-env (cons x new-env))
- (set! new-env (cons (list-ref e (+ j 1)) new-env)))
- (if (and (< i (- times 1)) (not first-y-is-last-y))
- (begin
- (set! x (+ x (/ x-max 100.0)))
- (set! new-env (cons x new-env))
- (set! new-env (cons first-y new-env)))))
- (set! new-env (reverse new-env))
- (if normalized
- (let ((scl (/ x-max x))
- (new-len (length new-env)))
- (do ((i 0 (+ i 2)))
- ((>= i new-len))
- (list-set! new-env i (* scl (list-ref new-env i))))))
- new-env))
+repetition to be in reverse."))
+ (lambda* (ur-env repeats reflected normalized)
+ (let* ((times (if reflected (floor (/ repeats 2)) repeats))
+ (e (if reflected
+ (let ((lastx (ur-env (- (length ur-env) 2)))
+ (rev-env (cddr (reverse ur-env)))
+ (new-env (reverse ur-env)))
+ (while (pair? rev-env)
+ (set! new-env (cons (+ lastx (- lastx (cadr rev-env))) new-env))
+ (set! new-env (cons (car rev-env) new-env))
+ (set! rev-env (cddr rev-env)))
+ (reverse new-env))
+ ur-env))
+ (first-y (cadr e))
+ (x-max (e (- (length e) 2)))
+ (x (car e))
+ (first-y-is-last-y (= first-y (e (- (length e) 1))))
+ (new-env (list first-y x))
+ (len (length e)))
+ (do ((i 0 (+ i 1)))
+ ((= i times))
+ (do ((j 2 (+ j 2)))
+ ((>= j len))
+ (set! x (+ x (- (e j) (e (- j 2)))))
+ (set! new-env (cons (e (+ j 1)) (cons x new-env))))
+ (if (and (< i (- times 1)) (not first-y-is-last-y))
+ (begin
+ (set! x (+ x (/ x-max 100.0)))
+ (set! new-env (cons first-y (cons x new-env))))))
+ (set! new-env (reverse new-env))
+ (if normalized
+ (let ((scl (/ x-max x))
+ (new-len (length new-env)))
+ (do ((i 0 (+ i 2)))
+ ((>= i new-len))
+ (set! (new-env i) (* scl (new-env i))))))
+ new-env))))
;;; -------- power-env
;;;
;;; (this could also be done using multi-expt-env (based on env-any) in generators.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+
+;;; (define pe (make-power-env '(0 0 1 1 2 0) :duration 1.0))
+;;; :(power-env pe)
+;;; 0.0
+;;; :(power-env pe)
+;;; 4.5352502324316e-05
+;;; :(power-env pe)
+;;; 9.0705004648631e-05
+;;; :(power-env pe)
+;;; 0.00013605750697295
+
-(defgenerator penv (envs #f :type clm-vector) (total-envs 0 :type int) (current-env 0 :type int) (current-pass 0 :type int))
+(defgenerator penv (envs #f) (total-envs 0) (current-env 0) (current-pass 0))
(define (power-env pe)
- (let* ((val (env (vector-ref (penv-envs pe) (penv-current-env pe)))))
- (set! (penv-current-pass pe) (- (penv-current-pass pe) 1))
- (if (= (penv-current-pass pe) 0)
- (if (< (penv-current-env pe) (- (penv-total-envs pe) 1))
- (begin
- (set! (penv-current-env pe) (+ 1 (penv-current-env pe)))
- (set! (penv-current-pass pe) (- (length (vector-ref (penv-envs pe) (penv-current-env pe))) 1)))))
- val))
+ (with-let pe
+ (let ((val (env (vector-ref envs current-env))))
+ (set! current-pass (- current-pass 1))
+ (when (and (= current-pass 0)
+ (< current-env (- total-envs 1)))
+ (set! current-env (+ current-env 1))
+ (set! current-pass (- (length (vector-ref envs current-env)) 1)))
+ val)))
(define* (make-power-env envelope (scaler 1.0) (offset 0.0) duration)
(let* ((len (- (floor (/ (length envelope) 3)) 1))
@@ -383,29 +372,29 @@ repetition to be in reverse."
:total-envs len
:current-env 0
:current-pass 0))
- (xext (- (list-ref envelope (- (length envelope) 3)) (car envelope))))
- (do ((i 0 (+ 1 i))
+ (xext (- (envelope (- (length envelope) 3)) (car envelope))))
+ (do ((i 0 (+ i 1))
(j 0 (+ j 3)))
((= i len))
- (let ((x0 (list-ref envelope j))
- (x1 (list-ref envelope (+ j 3)))
- (y0 (list-ref envelope (+ j 1)))
- (y1 (list-ref envelope (+ j 4)))
- (base (list-ref envelope (+ j 2))))
- (vector-set! (penv-envs pe) i (make-env (list 0.0 y0 1.0 y1)
- :base base :scaler scaler :offset offset
- :duration (* duration (/ (- x1 x0) xext))))))
- (set! (penv-current-pass pe) (- (length (vector-ref (penv-envs pe) 0)) 1))
+ (let ((x0 (envelope j))
+ (x1 (envelope (+ j 3)))
+ (y0 (envelope (+ j 1)))
+ (y1 (envelope (+ j 4)))
+ (base (envelope (+ j 2))))
+ (vector-set! (pe 'envs) i (make-env (list 0.0 y0 1.0 y1)
+ :base base :scaler scaler :offset offset
+ :duration (* duration (/ (- x1 x0) xext))))))
+ (set! (pe 'current-pass) (- (length (vector-ref (pe 'envs) 0)) 1))
pe))
-(define* (power-env-channel pe (beg 0) dur snd chn edpos (edname "power-env-channel"))
+(define* (power-env-channel pe (beg 0) snd chn edpos (edname "power-env-channel"))
;; split into successive calls on env-channel
(let ((curbeg beg)) ; sample number
(as-one-edit
(lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i (penv-total-envs pe)))
- (let* ((e (vector-ref (penv-envs pe) i))
+ (do ((i 0 (+ i 1)))
+ ((= i (pe 'total-envs)))
+ (let* ((e (vector-ref (pe 'envs) i))
(len (length e)))
(env-channel e curbeg len snd chn edpos)
(set! curbeg (+ curbeg len)))))
@@ -414,32 +403,33 @@ repetition to be in reverse."
;;; here's a simpler version that takes the breakpoint list, rather than the power-env structure:
-(define* (powenv-channel envelope (beg 0) dur snd chn edpos)
- "(powenv-channel envelope (beg 0) dur snd chn edpos) returns an envelope with a separate base for \
-each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"
- (let* ((curbeg beg)
- (fulldur (or dur (frames snd chn edpos)))
- (len (length envelope))
- (x1 (car envelope))
- (xrange (- (list-ref envelope (- len 3)) x1))
- (y1 (cadr envelope))
- (base (caddr envelope))
- (x0 0.0)
- (y0 0.0))
- (if (= len 3)
- (scale-channel y1 beg dur snd chn edpos)
- (as-one-edit
- (lambda ()
- (do ((i 3 (+ i 3)))
- ((= i len))
- (set! x0 x1)
- (set! y0 y1)
- (set! x1 (list-ref envelope i))
- (set! y1 (list-ref envelope (+ i 1)))
- (let* ((curdur (round (* fulldur (/ (- x1 x0) xrange)))))
- (xramp-channel y0 y1 base curbeg curdur snd chn edpos)
- (set! curbeg (+ curbeg curdur)))
- (set! base (list-ref envelope (+ i 2)))))))))
+(define powenv-channel
+ (let ((documentation "(powenv-channel envelope (beg 0) dur snd chn edpos) returns an envelope with a separate base for \
+each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"))
+ (lambda* (envelope (beg 0) dur snd chn edpos)
+ (let* ((curbeg beg)
+ (fulldur (or dur (framples snd chn edpos)))
+ (len (length envelope))
+ (x1 (car envelope))
+ (xrange (- (envelope (- len 3)) x1))
+ (y1 (cadr envelope))
+ (base (caddr envelope))
+ (x0 0.0)
+ (y0 0.0))
+ (if (= len 3)
+ (scale-channel y1 beg dur snd chn edpos)
+ (as-one-edit
+ (lambda ()
+ (do ((i 3 (+ i 3)))
+ ((= i len))
+ (set! x0 x1)
+ (set! y0 y1)
+ (set! x1 (envelope i))
+ (set! y1 (envelope (+ i 1)))
+ (let ((curdur (round (* fulldur (/ (- x1 x0) xrange)))))
+ (xramp-channel y0 y1 base curbeg curdur snd chn edpos)
+ (set! curbeg (+ curbeg curdur)))
+ (set! base (envelope (+ i 2)))))))))))
;;; by Anders Vinjar:
@@ -453,144 +443,140 @@ each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"
;;; power applies to whole envelope,
;;; xgrid is how fine a solution to sample our new envelope with.
-(define* (envelope-exp e (power 1.0) (xgrid 100))
- "(envelope-exp e (power 1.0) (xgrid 100)) approximates an exponential curve connecting the breakpoints"
- (let* ((mn (min-envelope e))
- (largest-diff (* 1.0 (- (max-envelope e) mn)))
- (x-min (car e))
- (len (length e))
- (x-max (list-ref e (- len 2)))
- (x-incr (* 1.0 (/ (- x-max x-min) xgrid)))
- (new-e '()))
- (do ((x x-min (+ x x-incr)))
- ((>= x x-max))
- (let ((y (envelope-interp x e)))
- (set! new-e (cons x new-e))
- (set! new-e (cons (if (= largest-diff 0.0)
- y
- (+ mn
- (* largest-diff
- (expt (/ (- y mn) largest-diff) power))))
- new-e))))
- (reverse new-e)))
+(define envelope-exp
+ (let ((documentation "(envelope-exp e (power 1.0) (xgrid 100)) approximates an exponential curve connecting the breakpoints"))
+ (lambda* (e (power 1.0) (xgrid 100))
+ (let* ((mn (min-envelope e))
+ (largest-diff (* 1.0 (- (max-envelope e) mn)))
+ (x-min (car e))
+ (len (length e))
+ (x-max (e (- len 2)))
+ (x-incr (* 1.0 (/ (- x-max x-min) xgrid)))
+ (new-e ()))
+ (do ((x x-min (+ x x-incr)))
+ ((>= x x-max))
+ (let ((y (envelope-interp x e)))
+ (set! new-e (cons (if (= largest-diff 0.0)
+ y
+ (+ mn
+ (* largest-diff
+ (expt (/ (- y mn) largest-diff) power))))
+ (cons x new-e)))))
+ (reverse new-e)))))
;;; rms-envelope
-(define* (rms-envelope file (beg 0.0) (dur #f) (rfreq 30.0) (db #f))
- "(rms-envelope file (beg 0.0) (dur #f) (rfreq 30.0) (db #f)) returns an envelope of RMS values in 'file'"
- ;; based on rmsenv.ins by Bret Battey
- (let* ((e '())
- (incr (/ 1.0 rfreq))
- (fsr (srate file))
- (incrsamps (round (* incr fsr)))
- (start (round (* beg fsr)))
- (reader (make-sampler start file))
- (end (if dur (min (* 1.0 (+ start (round (* fsr dur))))
- (mus-sound-frames file))
- (mus-sound-frames file)))
- (rms (make-moving-average incrsamps))) ; this could use make-moving-rms from dsp.scm
- (do ((i 0 (+ i incrsamps)))
- ((>= i end)
- (reverse e))
- (let ((rms-val 0.0))
- (do ((j 0 (+ 1 j)))
- ((= j incrsamps))
- (let ((val (reader)))
- (set! rms-val (moving-average rms (* val val)))))
- (set! e (cons (* 1.0 (/ i fsr)) e))
- (set! rms-val (sqrt rms-val))
- (if db
- (if (< rms-val .00001)
- (set! e (cons -100.0 e))
- (set! e (cons (* 20.0 (/ (log rms-val) (log 10.0))) e)))
- (set! e (cons rms-val e)))))))
-
-
-(define* (normalize-envelope env (new-max 1.0))
+(define rms-envelope
+ (let ((documentation "(rms-envelope file (beg 0.0) (dur #f) (rfreq 30.0) (db #f)) returns an envelope of RMS values in 'file'"))
+ (lambda* (file (beg 0.0) dur (rfreq 30.0) db)
+ ;; based on rmsenv.ins by Bret Battey
+ (let* ((e ())
+ (incr (/ 1.0 rfreq))
+ (fsr (srate file))
+ (incrsamps (round (* incr fsr)))
+ (start (round (* beg fsr)))
+ (reader (make-sampler start file))
+ (end (if dur (min (* 1.0 (+ start (round (* fsr dur))))
+ (mus-sound-framples file))
+ (mus-sound-framples file)))
+ (rms (make-moving-average incrsamps)) ; this could use make-moving-rms from dsp.scm
+ (rms-val 0.0)
+ (jend 0))
+ (let* ((len (+ 1 (- end start)))
+ (data (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! data i (next-sample reader)))
+ (float-vector-multiply! data data)
+ (do ((i 0 (+ i incrsamps)))
+ ((>= i end)
+ (reverse e))
+ (set! jend (min end (+ i incrsamps)))
+ (do ((j i (+ j 1)))
+ ((= j jend))
+ (moving-average rms (float-vector-ref data j)))
+ (set! e (cons (* 1.0 (/ i fsr)) e))
+ (set! rms-val (sqrt (* (mus-scaler rms) (mus-increment rms))))
+ (if db
+ (if (< rms-val .00001)
+ (set! e (cons -100.0 e))
+ (set! e (cons (* 20.0 (log rms-val 10.0)) e)))
+ (set! e (cons rms-val e)))))))))
+
+
+(define* (normalize-envelope env1 (new-max 1.0))
(define (abs-max-envelope-1 e mx)
(if (null? e)
mx
(abs-max-envelope-1 (cddr e) (max mx (abs (cadr e))))))
- (let ((peak (abs-max-envelope-1 (cddr env) (abs (cadr env)))))
- (scale-envelope env (/ new-max peak))))
+ (let ((peak (abs-max-envelope-1 (cddr env1) (abs (cadr env1)))))
+ (scale-envelope env1 (/ new-max peak))))
;;; simplify-envelope
;;;
;;; this is not very good...
-(define* (simplify-envelope env (ygrid 10) (xgrid 100))
-
+(define* (simplify-envelope env1 (ygrid 10) (xgrid 100))
+
;; grid = how fine a fluctuation we will allow.
;; the smaller the grid, the less likely a given bump will get through
;; original x and y values are not changed, just sometimes omitted.
-
+
(define (point-on-line? px py qx qy tx ty)
-
+
;; is point tx ty on line defined by px py and qx qy --
;; #f if no, :before if on ray from p, :after if on ray from q, :within if between p and q
;; (these are looking at the "line" as a fat vector drawn on a grid)
;; taken from "Graphics Gems" by Glassner, code by A Paeth
-
+
(if (or (= py qy ty)
(= px qx tx))
:within
- (if (< (abs (- (* (- qy py) (- tx px))
- (* (- ty py) (- qx px))))
- (max (abs (- qx px))
- (abs (- qy py))))
- (if (or (and (< qx px) (< px tx))
- (and (< qy py) (< py ty)))
- :before
- (if (or (and (< tx px) (< px qx))
- (and (< ty py) (< py qy)))
- :before
- (if (or (and (< px qx) (< qx tx))
- (and (< py qy) (< qy ty)))
- :after
- (if (or (and (< tx qx) (< qx px))
- (and (< ty qy) (< qy py)))
- :after
- :within))))
- #f)))
-
- (if (and env
- (> (length env) 4))
- (let* ((new-env (list (cadr env) (car env)))
- (ymax (max-envelope env))
- (ymin (min-envelope env))
- (xmax (list-ref env (- (length env) 2)))
- (xmin (car env)))
+ (and (< (abs (- (* (- qy py) (- tx px))
+ (* (- ty py) (- qx px))))
+ (max (abs (- qx px))
+ (abs (- qy py))))
+ (if (or (< qx px tx) (< qy py ty) (< tx px qx) (< ty py qy))
+ :before
+ (if (or (< px qx tx) (< py qy ty) (< tx qx px) (< ty qy py))
+ :after
+ :within)))))
+ (if (and env1
+ (> (length env1) 4))
+ (let ((new-env (list (cadr env1) (car env1)))
+ (ymax (max-envelope env1))
+ (ymin (min-envelope env1))
+ (xmax (env1 (- (length env1) 2)))
+ (xmin (car env1)))
(if (= ymin ymax)
(list xmin ymin xmax ymax)
- (let* ((y-scl (/ ygrid (- ymax ymin)))
- (x-scl (/ (or xgrid ygrid) (- xmax xmin)))
- (px #f) (py #f)
- (qx #f) (qy #f)
- (tx #f) (ty #f)
- (qtx #f) (qty #f))
- (do ((i 0 (+ i 2)))
- ((>= i (length env)))
- (let ((ttx (list-ref env i))
- (tty (list-ref env (+ i 1))))
- (set! tx (round (* ttx x-scl)))
- (set! ty (round (* tty y-scl)))
- (if px
- (if (not (point-on-line? px py qx qy tx ty))
- (begin
- (set! new-env (cons qtx new-env))
- (set! new-env (cons qty new-env))
- (set! px qx)
- (set! py qy)))
- (begin
- (set! px qx)
- (set! py qy)))
- (set! qx tx)
- (set! qy ty)
- (set! qtx ttx)
- (set! qty tty)))
- (set! new-env (cons qtx new-env))
- (set! new-env (cons qty new-env))
- (reverse new-env))))
- env))
+ (let ((y-scl (/ ygrid (- ymax ymin)))
+ (x-scl (/ (or xgrid ygrid) (- xmax xmin)))
+ (px #f) (py #f)
+ (qx #f) (qy #f)
+ (tx #f) (ty #f)
+ (qtx #f) (qty #f))
+ (do ((i 0 (+ i 2)))
+ ((>= i (length env1)))
+ (let ((ttx (env1 i))
+ (tty (env1 (+ i 1))))
+ (set! tx (round (* ttx x-scl)))
+ (set! ty (round (* tty y-scl)))
+ (if px
+ (if (not (point-on-line? px py qx qy tx ty))
+ (begin
+ (set! new-env (cons qty (cons qtx new-env)))
+ (set! px qx)
+ (set! py qy)))
+ (begin
+ (set! px qx)
+ (set! py qy)))
+ (set! qx tx)
+ (set! qy ty)
+ (set! qtx ttx)
+ (set! qty tty)))
+ (set! new-env (cons qty (cons qtx new-env)))
+ (reverse new-env))))
+ env1))
diff --git a/enved.fs b/enved.fs
index b3b15b6..3fdd9f8 100644
--- a/enved.fs
+++ b/enved.fs
@@ -1,155 +1,426 @@
-\ -*- snd-forth -*-
\ enved.fs -- enved object type
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
\ Created: Sun Nov 13 13:59:42 CET 2005
-\ Changed: Tue Oct 19 23:01:15 CEST 2010
+\ Changed: Mon Nov 19 06:06:33 CET 2012
\ Commentary:
\ This is an example of an Object type written in Forth.
\
\ ENVED
-\ enved-inspect ( obj -- str )
-\ enved->string ( obj -- str )
-\ enved-dump ( obj -- str )
-\ enved->array ( obj -- ary )
-\ enved-copy ( obj1 -- obj2 )
-\ enved-ref ( obj index -- point )
-\ enved-set! ( obj index point -- )
-\ enved-equal? ( obj1 obj2 -- f )
-\ enved-length ( obj -- len )
-\ enved-free ( obj -- )
-\
-\ enved? ( obj -- f )
-\ make-enved ( lst -- enved )
-\ enved-index ( obj x -- index|-1 )
-\ enved-insert! ( obj index point -- )
-\ enved-delete! ( obj index -- )
+\
+\ enved? ( obj -- f )
+\ make-enved ( ary -- en )
+\
+\ enved-length ( en -- len|-1 )
+\ enved-ref ( en index -- point )
+\ enved-set! ( en index point -- )
+\ enved-index ( en x -- index|-1 )
+\ enved-insert! ( en index point -- )
+\ enved-delete! ( en index -- )
\ === ENVED OBJECT TYPE ===
+"enved" make-object-type constant fth-enved
+
+\
+\ ENVED?
+\
+fth-enved make-?obj enved?
+<'> enved? "( obj -- f ) test if OBJ is an enved\n\
+#( 0 1 1 0 ) make-enved enved? => #t\n\
+#( 0 1 1 0 ) enved? => #f\n\
+Return #t if OBJ is an enved object, otherwise #f." help-set!
+
hide
-\ The name enved-envelope is in use!
-struct
- cell% field enved-fs-envelope
-end-struct enved%
+\ Creates setter enved-envelope! and getter enved-envelope@ and
+\ make-enved-instance for use in make-en.
+#( "enved-envelope" ) create-instance-struct make-enved-instance
+
+: (enved-out-of-bounds) { pos arg name -- ex args }
+ 'out-of-range #( "%s arg %d: %d is out of bounds" name pos arg )
+;
+
+: enved-out-of-bounds ( pos arg -- )
+ postpone get-func-name
+ postpone (enved-out-of-bounds)
+ postpone fth-throw
+; immediate
+
+: make-en { ary -- en }
+ fth-enved make-enved-instance { en }
+ en ary enved-envelope!
+ en
+;
+
+: en-inspect { self -- str }
+ self enved-envelope@ { ary }
+ "#<%s[%d]: %s>"
+ #( self object-name
+ ary array-length 2/
+ ary ) string-format
+;
+
+: en->string ( self -- str ) enved-envelope@ object->string ;
+: en-dump ( self -- str ) en->string " make-enved" $+ ;
+: en->array ( self -- ary ) enved-envelope@ array->array ;
+: en-copy ( self -- en ) enved-envelope@ array-copy make-en ;
+: en-length ( self -- len ) enved-envelope@ array-length 2/ ;
+
+: en-ref { self index -- point }
+ self index object-range? if
+ index 2* to index
+ #( self enved-envelope@ index array-ref
+ self enved-envelope@ index 1+ array-ref )
+ else
+ 2 index enved-out-of-bounds
+ then
+;
+
+: en-set! { self index point -- }
+ self index object-range? if
+ index 2* to index
+ self enved-envelope@ index point 0 array-ref array-set!
+ self enved-envelope@ index 1+ point 1 array-ref array-set!
+ else
+ 2 index enved-out-of-bounds
+ then
+;
+
+: en-equal? { self obj -- f }
+ self obj = if
+ #t
+ else
+ self enved-envelope@ obj enved-envelope@ object-equal?
+ then
+;
+
+\ Init object type Enved.
+<'> en-inspect fth-enved set-object-inspect \ en .inspect
+<'> en->string fth-enved set-object->string \ en object->string
+<'> en-dump fth-enved set-object-dump \ en object-dump
+<'> en->array fth-enved set-object->array \ en object->array
+<'> en-copy fth-enved set-object-copy \ en object-copy
+<'> en-ref fth-enved set-object-value-ref \ en idx object-ref => #( x y )
+<'> en-set! fth-enved set-object-value-set \ en idx #( x y ) object-set!
+<'> en-equal? fth-enved set-object-equal-p \ obj1 obj2 object-equal?
+<'> en-length fth-enved set-object-length \ en object-length => (len/2)
+<'> en-ref fth-enved 1 set-object-apply \ en idx apply => #( x y )
set-current
-: envelope@ ( obj -- lst ) instance-gen-ref enved-fs-envelope @ ;
-: envelope! ( lst obj -- ) instance-gen-ref enved-fs-envelope ! ;
+\
+\ MAKE-ENVED
+\
+: make-enved ( ary -- en )
+ doc" create enved\n\
+#( 0 1 1 0 ) make-enved value en\n\
+Return new enved object from ARY \
+which must be an array of even length."
+ { ary }
+ ary array-length 2 mod 0= ary 1 "an array of even length" assert-type
+ ary make-en
+;
-"enved" make-object-type constant fth-enved
-fth-enved make-?obj enved?
+\
+\ ENVED-LENGTH
+\
+: enved-length ( obj -- len|-1 )
+ doc" return enved length\n\
+#( 0 1 1 0 ) make-enved enved-length => 2\n\
+#( 0 1 1 0 ) enved-length => -1\n\
+If OBJ is an enved object, return its length, otherwise -1."
+ { obj }
+ obj enved? if
+ obj en-length
+ else
+ -1
+ then
+;
-: make-enved ( envelope -- enved )
- { envelope }
- envelope array? envelope 1 $" an array" assert-type
- enved% %alloc { enved }
- enved unless 'system-error #( get-func-name $" cannot create enved" ) fth-throw then
- envelope enved enved-fs-envelope !
- enved fth-enved make-instance
-;
+\
+\ ENVED-REF
+\
+: enved-ref ( en index -- point )
+ doc" return point at INDEX\n\
+#( 0 1 1 0 ) make-enved value en\n\
+en 0 enved-ref => #( 0 1 )\n\
+en 1 enved-ref => #( 1 0 )\n\
+Return point at position INDEX. \
+Negative index counts from backward. \
+Raise OUT-OF-RANGE exception if INDEX is not in EN's range."
+ { en index }
+ en enved? en 1 "an enved" assert-type
+ index 0< if
+ en en-length index + to index
+ then
+ en index en-ref
+;
+
+\
+\ ENVED-SET!
+\
+: enved-set! ( en index point -- )
+ doc" set point at INDEX\n\
+#( 0 1 1 0 ) make-enved value en\n\
+en 0 #( 0 0.5 ) enved-set!\n\
+en .$ => #( 0 0.5 1 0 )\n\
+en 1 #( 1 0.5 ) enved-set!\n\
+en .$ => #( 0 0.5 1 0.5 )\n\
+Store POINT at position INDEX. \
+Negative index counts from backward. \
+Raise OUT-OF-RANGE exception if INDEX is not in EN's range."
+ { en index point }
+ en enved? en 1 "an enved" assert-type
+ index 0< if
+ en en-length index + to index
+ then
+ en index point en-set!
+;
+
+\
+\ ENVED-INDEX
+\
+: enved-index ( en x -- index|-1 )
+ doc" return index of X in EN\n\
+#( 1 3 2 3 ) make-enved value en\n\
+en 1 enved-index => 0\n\
+en 2 enved-index => 1\n\
+en 3 enved-index => -1\n\
+Return point-index where X is point's x value, or -1 if not found."
+ { en x }
+ en enved? en 1 "an enved" assert-type
+ -1 { idx }
+ en enved-envelope@ { ary }
+ ary array-length 0 ?do
+ ary i array-ref x f= if
+ i 2/ to idx leave
+ then
+ 2 +loop
+ idx
+;
+
+\
+\ ENVED-INSERT!
+\
+: enved-insert! ( en index point -- )
+ doc" insert POINT at INDEX\n\
+#( 1 1 2 2 ) make-enved value en\n\
+en 0 #( 0 0 ) enved-insert!\n\
+en .$ => #( 0 0 1 1 2 2 )\n\
+en 3 #( 3 3 ) enved-insert!\n\
+en .$ => #( 0 0 1 1 2 2 3 3 )\n\
+Insert POINT at INDEX into EN. \
+Negative index counts from backward. \
+Raise OUT-OF-RANGE exception if INDEX is not in EN's range."
+ { en index point }
+ en enved? en 1 "an enved" assert-type
+ point array-length 2 = point 3 "a point #( x y )" assert-type
+ index 0< if
+ en en-length index + to index
+ then
+ en index object-range? if
+ index 2* to index
+ en enved-envelope@ index point array-insert! drop
+ else
+ index en en-length = if
+ en enved-envelope@ ( ary )
+ point 0 array-ref array-push ( ary' )
+ point 1 array-ref array-push drop
+ else
+ 2 index enved-out-of-bounds
+ then
+ then
+;
+
+\
+\ ENVED-DELETE!
+\
+: enved-delete! ( en index -- )
+ doc" delete point at INDEX\n\
+#( 1 1 2 2 ) make-enved value en\n\
+en 1 enved-delete!\n\
+en .$ => #( 1 1 )\n\
+Delete point at INDEX from EN. \
+Negative index counts from backward. \
+Raise OUT-OF-RANGE exception if INDEX is not in EN's range."
+ { en index }
+ en enved? en 1 "an enved" assert-type
+ index 0< if
+ en en-length index + to index
+ then
+ en index object-range? if
+ index 2* to index
+ en enved-envelope@ index array-delete! drop
+ en enved-envelope@ index array-delete! drop
+ else
+ 2 index enved-out-of-bounds
+ then
+;
+
+\ XXX
+\ For backwards compatibility.
+: envelope@ { en -- ary }
+ en enved? en 1 "an enved" assert-type
+ en enved-envelope@
+;
+
+\ XXX
+\ For backwards compatibility with arguments swapped.
+: envelope! { ary en -- }
+ ary array? ary 1 "an array" assert-type
+ en enved? en 2 "an enved" assert-type
+ en ary enved-envelope!
+;
previous
-: enved-length ( obj -- len ) envelope@ array-length 2/ ;
-
-: enved-inspect { obj -- str }
- $" #<%s[%d]: %S>" #( obj object-name obj enved-length obj envelope@ ) string-format
-;
-
-: enved->string ( obj -- str ) envelope@ object->string ;
-: enved-dump ( obj -- str ) enved->string $" make-enved" $+ ;
-: enved->array ( obj -- ary ) envelope@ array->array ;
-: enved-copy ( obj -- obj2 ) envelope@ array-copy make-enved ;
-
-: enved-ref { obj index -- point }
- obj enved? obj 1 $" an enved object" assert-type
- index 0< if index obj enved-length + to index then
- obj index object-range? if
- index 2* to index
- #( obj envelope@ index array-ref obj envelope@ index 1+ array-ref )
- else
- 'out-of-range
- #( get-func-name $" index %s, enved length %s" #( index obj enved-length ) )
- fth-throw
- then
-;
-
-: enved-set! { obj index point -- }
- obj enved? obj 1 $" an enved object" assert-type
- index 0< if index obj enved-length + to index then
- obj index object-range? if
- index 2* to index
- obj envelope@ index point 0 array-ref array-set!
- obj envelope@ index 1+ point 1 array-ref array-set!
- else
- 'out-of-range
- #( get-func-name $" index %s, enved length %s" #( index obj enved-length ) )
- fth-throw
- then
-;
-
-: enved-equal? { obj1 obj2 -- f }
- obj1 enved? obj2 enved? && if
- obj1 envelope@ obj2 envelope@ object-equal?
- else
- #f
- then
-;
-
-\ frees %alloc-ed struct enved%
-: enved-free ( obj -- ) instance-gen-ref free throw ;
-
-\ Init enved
-<'> enved-inspect fth-enved set-object-inspect \ en .inspect
-<'> enved->string fth-enved set-object->string \ en object->string
-<'> enved-dump fth-enved set-object-dump \ en object-dump
-<'> enved->array fth-enved set-object->array \ en object->array
-<'> enved-copy fth-enved set-object-copy \ en object-copy
-<'> enved-ref fth-enved set-object-value-ref \ en index object-ref => #( x y )
-<'> enved-set! fth-enved set-object-value-set \ en index #( x y ) object-set!
-<'> enved-equal? fth-enved set-object-equal-p \ obj1 obj2 equal?
-<'> enved-length fth-enved set-object-length \ en object-length => number of points (lstlen/2)
-<'> enved-free fth-enved set-object-free \ for gc
-<'> enved-ref fth-enved 1 set-object-apply \ en index apply => #( x y )
-
-\ ENVED-INDEX, ENVED-INSERT!, ENVED-DELETE!
-: enved-index { obj x -- index|-1 }
- obj enved? obj 1 $" an enved object" assert-type
- -1 obj each 0 array-ref x f= if drop i leave then end-each
-;
-
-: enved-insert! { obj index point -- }
- obj enved? obj 1 $" an enved object" assert-type
- point array? point object-length 2 = && point 3 $" a point array #( x y )" assert-type
- obj enved-length 0= if
- point
- else
- index 0< if index obj enved-length + to index then
- index 0>= index obj enved-length <= || if
- index 2* to index
- obj envelope@ index point array-insert
- else
- 'out-of-range
- #( get-func-name $" index %s, enved length %s" #( index obj enved-length ) )
- fth-throw
- then
- then obj envelope!
-;
-
-: enved-delete! { obj index -- }
- obj enved? obj 1 $" an enved object" assert-type
- index 0< if index obj enved-length + to index then
- obj index object-range? if
- index 2* to index
- obj envelope@ index array-delete! drop
- obj envelope@ index array-delete! drop
- else
- 'out-of-range
- #( get-func-name $" index %s, enved length %s" #( index obj enved-length ) )
- fth-throw
- then
+hide
+: test-display { res req str -- }
+ res req object-equal? unless
+ "\\ %s: res %s, req %s\n" #( str res req ) fth-print
+ then
+;
+
+: test-catch { xt ex -- tag }
+ xt ex nil fth-catch { tag }
+ stack-reset
+ tag
;
+set-current
+
+: enved-test ( -- )
+ nil nil nil { en1 en2 tag }
+ \
+ \ make-enved
+ \
+ #( 0 1 1 0 ) make-enved to en1
+ #( 0 1 1 0 ) make-enved to en2
+ #( 0 1 2 ) <'> make-enved 'wrong-type-arg test-catch to tag
+ tag car 'wrong-type-arg "#( 0 1 2 ) make-enved" test-display
+ \
+ \ enved?
+ \
+ en1 enved? #t "en1 enved?" test-display
+ en2 enved? #t "en2 enved?" test-display
+ #( 0 1 1 0 ) enved? #f "#( 0 1 1 0 ) enved?" test-display
+ \
+ \ enved-length
+ \
+ en1 enved-length 2 "en1 enved-length" test-display
+ en2 enved-length 2 "en2 enved-length" test-display
+ #( 0 1 1 0 ) enved-length -1 "#( 0 1 1 0 ) enved-length" test-display
+ \
+ \ enved-ref
+ \
+ en1 0 enved-ref #( 0 1 ) "en1 0 enved-ref" test-display
+ en1 1 enved-ref #( 1 0 ) "en1 1 enved-ref" test-display
+ en1 2 <'> enved-ref 'out-of-range test-catch to tag
+ tag car 'out-of-range "en1 2 enved-ref" test-display
+ \
+ \ enved-set!
+ \
+ #( 0 1 1 0 ) make-enved to en1
+ en1 0 #( 0 0 ) enved-set!
+ #( 0 0 1 0 ) make-enved to en2
+ en1 en2 "en1 0 #( 0 0 ) enved-set!" test-display
+ #( 0 1 1 0 ) make-enved to en1
+ en1 1 #( 1 1 ) enved-set!
+ #( 0 1 1 1 ) make-enved to en2
+ en1 en2 "en1 1 #( 1 1 ) enved-set!" test-display
+ en1 2 #( 2 0 ) <'> enved-set! 'out-of-range test-catch to tag
+ tag car 'out-of-range "en1 2 enved-set!" test-display
+ \
+ \ enved-index
+ \
+ #( 0 1 2 0 ) make-enved to en1
+ en1 0 enved-index 0 "en1 0 enved-index" test-display
+ en1 2 enved-index 1 "en1 2 enved-index" test-display
+ en1 1 enved-index -1 "en1 1 enved-index" test-display
+ \
+ \ enved-insert!
+ \
+ #( 1 1 2 2 ) make-enved to en1
+ en1 0 #( 0 0 ) enved-insert!
+ #( 0 0 1 1 2 2 ) make-enved to en2
+ en1 en2 "en1 0 #( 0 0 ) enved-insert!" test-display
+ en1 3 #( 3 3 ) enved-insert!
+ #( 0 0 1 1 2 2 3 3 ) make-enved to en2
+ en1 en2 "en1 3 #( 3 3 ) enved-insert!" test-display
+ en1 5 #( 5 5 ) <'> enved-insert! 'out-of-range test-catch to tag
+ tag car 'out-of-range "en1 5 #( 5 5 ) enved-insert!" test-display
+ \
+ \ enved-delete!
+ \
+ #( 0 0 1 1 2 2 3 3 ) make-enved to en1
+ en1 0 enved-delete!
+ #( 1 1 2 2 3 3 ) make-enved to en2
+ en1 en2 "en1 0 enved-delete!" test-display
+ en1 2 enved-delete!
+ #( 1 1 2 2 ) make-enved to en2
+ en1 en2 "en1 2 enved-delete!" test-display
+ en1 3 <'> enved-delete! 'out-of-range test-catch to tag
+ tag car 'out-of-range "en1 3 enved-delete!" test-display
+ \
+ \ object-inspect
+ \
+ #( 0 1 1 0 ) make-enved to en1
+ en1 object-inspect "#<enved[2]: #( 0 1 1 0 )>"
+ "object-inspect" test-display
+ \
+ \ object->string
+ \
+ en1 object->string "#( 0 1 1 0 )" "object->string" test-display
+ \
+ \ object-dump
+ \
+ en1 object-dump "#( 0 1 1 0 ) make-enved" "object-dump" test-display
+ \
+ \ object->array
+ \
+ en1 object->array #( 0 1 1 0 ) "object->array" test-display
+ \
+ \ object-copy
+ \
+ en1 object-copy en1 "object-copy" test-display
+ \
+ \ object-ref
+ \
+ en1 0 object-ref #( 0 1 ) "en1 0 object-ref" test-display
+ en1 1 object-ref #( 1 0 ) "en1 1 object-ref" test-display
+ en1 2 <'> object-ref 'out-of-range test-catch to tag
+ tag car 'out-of-range "en1 2 object-ref" test-display
+ \
+ \ object-set!
+ \
+ #( 0 1 1 0 ) make-enved to en1
+ en1 0 #( 0 0 ) object-set!
+ #( 0 0 1 0 ) make-enved to en2
+ en1 en2 "en1 0 #( 0 0 ) object-set!" test-display
+ #( 0 1 1 0 ) make-enved to en1
+ en1 1 #( 1 1 ) object-set!
+ #( 0 1 1 1 ) make-enved to en2
+ en1 en2 "en1 1 #( 1 1 ) object-set!" test-display
+ en1 2 #( 2 0 ) <'> object-set! 'out-of-range test-catch to tag
+ tag car 'out-of-range "en1 2 object-set!" test-display
+ \
+ \ object-length
+ \
+ #( 0 1 1 0 ) make-enved to en1
+ #( 0 1 1 0 ) make-enved to en2
+ en1 object-length 2 "en1 object-length" test-display
+ en2 object-length 2 "en2 object-length" test-display
+ \
+ \ object-equal?
+ \
+ en1 en2 "object-equal?" test-display
+ \
+ \ object-apply
+ \
+ en1 0 object-apply #( 0 1 ) "en1 0 object-apply" test-display
+ en1 1 object-apply #( 1 0 ) "en1 1 object-apply" test-display
+ en1 2 <'> object-apply 'out-of-range test-catch to tag
+ tag car 'out-of-range "en1 2 object-apply" test-display
+;
+previous
\ enved.fs ends here
diff --git a/enved.scm b/enved.scm
index 98f8339..3281530 100644
--- a/enved.scm
+++ b/enved.scm
@@ -11,23 +11,22 @@
(provide 'snd-enved.scm)
(define channel-envelope
- (make-procedure-with-setter
-
- (lambda (snd chn)
- "(channel-envelope snd chn) returns the current enved envelope associated with snd's channel chn"
- (or (channel-property 'enved-envelope snd chn)
- '()))
-
+ (dilambda
+ (let ((documentation "(channel-envelope snd chn) returns the current enved envelope associated with snd's channel chn"))
+ (lambda (snd chn)
+ (or (channel-property 'enved-envelope snd chn)
+ ())))
(lambda (snd chn new-env)
(set! (channel-property 'enved-envelope snd chn) new-env)
(graph new-env "" 0.0 1.0 0.0 1.0 snd chn))))
-(define (create-initial-envelopes snd)
- (do ((i 0 (+ 1 i)))
- ((= i (channels snd)))
- (set! (dot-size snd i) 8)
- (set! (channel-envelope snd i) (list 0.0 1.0 1.0 1.0))))
+(define (create-initial-envelopes hook)
+ (let ((snd (hook 'snd)))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels snd)))
+ (set! (dot-size snd i) 8)
+ (set! (channel-envelope snd i) (list 0.0 1.0 1.0 1.0)))))
;;; if click on point, delete,
@@ -40,11 +39,15 @@
(define mouse-pos 0)
(define mouse-new #f)
-(define (mouse-press-envelope snd chn button state ux uy)
- (let ((mouse-radius .03))
-
+(define (mouse-press-envelope hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (ux (hook 'x))
+ (uy (hook 'y))
+ (mouse-radius .03))
+
(define (add-envelope-point x y cur-env)
- (let ((new-env '()))
+ (let ((new-env ()))
(define (search-point e)
(if (null? e)
(append new-env (list x y))
@@ -56,21 +59,21 @@
(set! new-env (append new-env (list (car e) (cadr e))))
(search-point (cddr e)))))))
(search-point cur-env)))
-
+
(define (envelope-position x cur-env)
(define (search-point e pos)
(if (= (car e) x)
pos
(search-point (cddr e) (+ pos 2))))
(search-point cur-env 0))
-
+
(define (on-dot? x y cur-env pos)
- (and (not (null? cur-env))
+ (and (pair? cur-env)
(or (and (< (abs (- (car cur-env) x)) mouse-radius)
(< (abs (- (cadr cur-env) y)) mouse-radius)
pos)
(on-dot? x y (cddr cur-env) (+ pos 2)))))
-
+
(let* ((x (max 0.0 (min ux 1.0)))
(y (max 0.0 (min uy 1.0)))
(cur-env (channel-envelope snd chn))
@@ -84,137 +87,147 @@
(set! mouse-pos (envelope-position new-x (channel-envelope snd chn))))
(set! mouse-pos pos)))))
-(define (mouse-drag-envelope snd chn button state x y)
- ;; point exists, needs to be edited with check for various bounds
-
- (define (edit-envelope-point pos x y cur-env)
- (let ((new-env '()))
- (define (search-point e npos)
- (if (= npos pos)
- (append new-env (list x y) (cddr e))
+(define (mouse-drag-envelope hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (x (hook 'x))
+ (y (hook 'y)))
+ ;; point exists, needs to be edited with check for various bounds
+
+ (define (edit-envelope-point pos x y cur-env)
+ (let ((new-env ()))
+ (define (search-point e npos)
+ (if (= npos pos)
+ (append new-env (list x y) (cddr e))
+ (begin
+ (set! new-env (append new-env (list (car e) (cadr e))))
+ (search-point (cddr e) (+ npos 2)))))
+ (search-point cur-env 0)))
+
+ (let* ((cur-env (channel-envelope snd chn))
+ (lx (if (= mouse-pos 0)
+ 0.0
+ (if (>= mouse-pos (- (length cur-env) 2))
+ 1.0
+ (max (+ (list-ref cur-env (- mouse-pos 2)) .001)
+ (min x
+ (- (list-ref cur-env (+ mouse-pos 2)) .001))))))
+ (ly (max 0.0 (min y 1.0))))
+ (set! (channel-envelope snd chn)
+ (edit-envelope-point mouse-pos lx ly cur-env))
+ (update-lisp-graph snd chn))))
+
+(define (mouse-release-envelope hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (axis (hook 'axis)))
+
+ (define (remove-envelope-point pos cur-env)
+ (let ((new-env ()))
+ (define (search-point e npos)
+ (if (null? e)
+ new-env
+ (if (= pos npos)
+ (append new-env (cddr e))
+ (begin
+ (set! new-env (append new-env (list (car e) (cadr e))))
+ (search-point (cddr e) (+ npos 2))))))
+ (search-point cur-env 0)))
+
+ (if (= axis lisp-graph)
+ (let ((cur-env (channel-envelope snd chn)))
+ (set! mouse-up (get-internal-real-time))
+ (if (and (not mouse-new)
+ (<= (- mouse-up mouse-down) click-time)
+ (not (= mouse-pos 0))
+ (< mouse-pos (- (length cur-env) 2)))
+ (set! (channel-envelope snd chn)
+ (remove-envelope-point mouse-pos cur-env)))
+ (update-lisp-graph snd chn)
+ (set! mouse-new #f)
+ (set! (hook 'result) #t)))))
+
+(define (enveloping-key-press hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (key (hook 'key))
+ (state (hook 'state)))
+
+ ;; C-g returns to original env
+ ;; C-. applies current env to amplitude
+ (if (and (= key (char->integer #\.))
+ (= state 4))
+ (begin
+ (env-channel (channel-envelope snd chn) 0 (framples snd chn) snd chn)
+ (set! (hook 'result) #t))
+ (if (and (= key (char->integer #\g))
+ (= state 4))
(begin
- (set! new-env (append new-env (list (car e) (cadr e))))
- (search-point (cddr e) (+ npos 2)))))
- (search-point cur-env 0)))
-
- (let* ((cur-env (channel-envelope snd chn))
- (lx (if (= mouse-pos 0)
- 0.0
- (if (>= mouse-pos (- (length cur-env) 2))
- 1.0
- (max (+ (list-ref cur-env (- mouse-pos 2)) .001)
- (min x
- (- (list-ref cur-env (+ mouse-pos 2)) .001))))))
- (ly (max 0.0 (min y 1.0))))
- (set! (channel-envelope snd chn)
- (edit-envelope-point mouse-pos lx ly cur-env))
- (update-lisp-graph snd chn)))
-
-(define (mouse-release-envelope snd chn button state ux uy axis)
-
- (define (remove-envelope-point pos cur-env)
- (let ((new-env '()))
- (define (search-point e npos)
- (if (null? e)
- new-env
- (if (= pos npos)
- (append new-env (cddr e))
- (begin
- (set! new-env (append new-env (list (car e) (cadr e))))
- (search-point (cddr e) (+ npos 2))))))
- (search-point cur-env 0)))
-
- (if (= axis lisp-graph)
- (let ((cur-env (channel-envelope snd chn)))
- (set! mouse-up (get-internal-real-time))
- (if (and (not mouse-new)
- (<= (- mouse-up mouse-down) click-time)
- (not (= mouse-pos 0))
- (not (>= mouse-pos (- (length cur-env) 2))))
- (set! (channel-envelope snd chn)
- (remove-envelope-point mouse-pos cur-env)))
- (update-lisp-graph snd chn)
- (set! mouse-new #f)
- #t)
- #f))
-
-(define (enveloping-key-press snd chn key state)
- ;; C-g returns to original env
- ;; C-. applies current env to amplitude
- (if (and (= key (char->integer #\.))
- (= state 4))
- (begin
- (env-channel (channel-envelope snd chn) 0 (frames snd chn) snd chn)
- #t)
- (if (and (= key (char->integer #\g))
- (= state 4))
- (begin
- (set! (channel-envelope snd chn) '(0.0 1.0 1.0 1.0))
- #t)
- #f)))
-
-(define (start-enveloping)
- "(start-enveloping) starts the enved processes, displaying an envelope editor in each channel"
- (hook-push after-open-hook create-initial-envelopes)
- (hook-push mouse-press-hook mouse-press-envelope)
- (hook-push mouse-drag-hook mouse-drag-envelope)
- (hook-push mouse-click-hook mouse-release-envelope)
- (hook-push key-press-hook enveloping-key-press))
-
-(define (stop-enveloping)
- "(stop-enveloping) turns off the enved channel-specific envelope editors"
- (hook-remove after-open-hook create-initial-envelopes)
- (hook-remove mouse-press-hook mouse-press-envelope)
- (hook-remove mouse-drag-hook mouse-drag-envelope)
- (hook-remove mouse-click-hook mouse-release-envelope)
- (hook-remove key-press-hook enveloping-key-press))
+ (set! (channel-envelope snd chn) '(0.0 1.0 1.0 1.0))
+ (set! (hook 'result) #t))))))
+
+(define start-enveloping
+ (let ((documentation "(start-enveloping) starts the enved processes, displaying an envelope editor in each channel"))
+ (lambda ()
+ (hook-push after-open-hook create-initial-envelopes)
+ (hook-push mouse-press-hook mouse-press-envelope)
+ (hook-push mouse-drag-hook mouse-drag-envelope)
+ (hook-push mouse-click-hook mouse-release-envelope)
+ (hook-push key-press-hook enveloping-key-press))))
+
+(define stop-enveloping
+ (let ((documentation "(stop-enveloping) turns off the enved channel-specific envelope editors"))
+ (lambda ()
+ (hook-remove after-open-hook create-initial-envelopes)
+ (hook-remove mouse-press-hook mouse-press-envelope)
+ (hook-remove mouse-drag-hook mouse-drag-envelope)
+ (hook-remove mouse-click-hook mouse-release-envelope)
+ (hook-remove key-press-hook enveloping-key-press))))
;;; --------------------------------------------------------------------------------
;;;
;;; some examples of using this envelope editor
-(define* (play-with-envs (sound #f))
- "(play-with-envs snd) sets channel amps during playback from the associated enved envelopes"
- (let ((chans (channels sound)))
- (do ((chan 0 (+ 1 chan)))
- ((= chan chans))
- (let ((player (make-player sound chan))
- (e (make-env (channel-envelope sound chan)
- :length (floor (/ (frames sound chan) (dac-size))))))
- (add-player player 0 -1 -1 (lambda (reason) (set! (hook-functions play-hook) '())))
- (hook-push play-hook (lambda (fr)
- ;; if fr (dac buffer size in frames) is not dac-size, we should do something debonair
- (set! (amp-control player) (env e))))))
- (start-playing chans (srate sound))))
-
-(define (play-panned sound)
- "(play-panned snd) pans a mono sound following its enved envelope into a stereo sound"
- (let* ((bufsize 256)
- (data (make-sound-data 2 bufsize))
- (bytes (* bufsize 4))
- (audio-fd (mus-audio-open-output mus-audio-default (srate sound) 2 mus-lshort bytes))
- (samp 0)
- (len (frames sound 0)))
- (snd-print (format #f "audio-fd: ~A " audio-fd))
- (if (not (= audio-fd -1))
- (let ((e (make-env (channel-envelope sound 0) :length (floor (/ len bufsize)))))
- (catch #t
- (lambda ()
- (do ((res #f (let* ((scaler (env e))
- (samps0 (channel->vct samp bufsize))
- (samps1 (vct-copy samps0)))
- (vct->sound-data (vct-scale! samps0 scaler) data 0)
- (vct->sound-data (vct-scale! samps1 (- 1.0 scaler)) data 1)
- (mus-audio-write audio-fd data bufsize)
- (set! samp (+ samp bufsize))
- (>= samp len))))
- (res)))
- (lambda args (display (format #f ";play-panned error: ~A" args))))
- (mus-audio-close audio-fd)))))
-
-
-;;; (start-enveloping)
-;;; (open-sound "oboe.snd")
-
-
+(define play-with-envs
+ (let ((documentation "(play-with-envs snd) sets channel amps during playback from the associated enved envelopes"))
+ (lambda* (sound)
+ (let ((chans (channels sound)))
+ (do ((chan 0 (+ 1 chan)))
+ ((= chan chans))
+ (let ((player (make-player sound chan))
+ (e (make-env (channel-envelope sound chan)
+ :length (floor (/ (framples sound chan) *dac-size*)))))
+ (add-player player 0 -1 -1 (lambda (reason) (set! (hook-functions play-hook) ())))
+ (hook-push play-hook (lambda (hook)
+ ;; if dac buffer size in framples is not dac-size, we should do something debonair
+ (set! (amp-control player) (env e))))))
+ (start-playing chans (srate sound))))))
+
+#|
+(define play-panned
+ (let ((documentation "(play-panned snd) pans a mono sound following its enved envelope into a stereo sound"))
+ (lambda (sound)
+ (let* ((bufsize 256)
+ (data (make-float-vector (list 2 bufsize) 0.0))
+ (bytes (* bufsize 4))
+ (audio-fd (mus-audio-open-output mus-audio-default (srate sound) 2 mus-lshort bytes))
+ (samp 0)
+ (len (framples sound 0)))
+ (snd-print (format #f "audio-fd: ~A " audio-fd))
+ (if (not (= audio-fd -1))
+ (let ((e (make-env (channel-envelope sound 0) :length (floor (/ len bufsize)))))
+ (catch #t
+ (lambda ()
+ (do ((res #f (let* ((scaler (env e))
+ (samps0 (channel->float-vector samp bufsize))
+ (samps1 (copy samps0)))
+ (copy (float-vector-scale! samps0 scaler) (data 0))
+ (copy (float-vector-scale! samps1 (- 1.0 scaler)) (data 1))
+ (mus-audio-write audio-fd data bufsize)
+ (set! samp (+ samp bufsize))
+ (>= samp len))))
+ (res)))
+ (lambda args (format #t ";play-panned error: ~A" args)))
+ (mus-audio-close audio-fd)))))))
+|#
diff --git a/examp.fs b/examp.fs
index 637f22e..1fbb1c4 100644
--- a/examp.fs
+++ b/examp.fs
@@ -1,235 +1,253 @@
\ examp.fs -- examples from examp.scm|rb
-\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Tue Jul 05 13:09:37 CEST 2005
-\ Changed: Sat Feb 19 17:25:03 CET 2011
-
-\ Commentary:
+\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
+\ Created: 05/07/05 13:09:37
+\ Changed: 15/01/29 23:39:32
\
+\ @(#)examp.fs 1.68 1/29/15
+
\ With original comments and doc strings from examp.scm.
\
-\ all-chans ( -- array-of-lists )
-\ close-sound-extend ( snd -- )
-\ snd-snd ( :optional snd -- snd )
-\ snd-chn ( :optional chn -- chn )
-\ toggle-read-eval-loop ( -- )
-\ make-read-eval-loop ( -- )
-\ remove-read-eval-loop ( -- )
+\ all-chans ( -- array-of-lists )
+\ close-sound-extend ( snd -- )
+\ snd-snd ( :optional snd -- snd )
+\ snd-chn ( :optional chn -- chn )
+\ make-read-eval-loop ( -- )
+\ remove-read-eval-loop ( -- )
+\ toggle-read-eval-loop ( -- )
\
\ from frame.scm
-\ insert-vct ( v :optional beg dur snd chn edpos -- samps )
+\ insert-vct ( v :optional beg dur snd chn edpos -- samps )
\
\ examp.(scm|rb)
-\ selection-rms ( -- val )
-\ region-rms ( :optional n -- val )
-\ window-samples ( :optional snd chn -- vct )
-\ display-energy ( snd chn -- val )
-\ display-db ( snd chn -- val )
-\ window-rms ( -- val )
-\ fft-peak ( snd chn scaler -- pk )
-\ finfo ( file -- str )
-\ display-correlate ( snd chn y0 y1 -- val )
-\ zoom-spectrum ( snd chn y0 y1 -- val )
-\ superimpose-ffts ( snd chn y0 y1 -- val )
-\ locate-zero ( limit -- samp )
-\ mpg ( mpgfile rawfile -- )
-\ auto-dot ( snd chn y0 y1 -- val )
+\ selection-rms ( -- val )
+\ region-rms ( :optional n -- val )
+\ window-samples ( :optional snd chn -- vct )
+\ display-energy ( snd chn -- val )
+\ display-db ( snd chn -- val )
+\ window-rms ( -- val )
+\ fft-peak ( snd chn scaler -- pk )
+\ finfo ( file -- str )
+\ display-correlate ( snd chn y0 y1 -- val )
+\ zoom-spectrum ( snd chn y0 y1 -- val )
+\ superimpose-ffts ( snd chn y0 y1 -- val )
+\ locate-zero ( limit -- samp )
+\ mpg ( mpgfile rawfile -- )
+\ auto-dot ( snd chn y0 y1 -- val )
\ first-mark-in-window-at-left ( -- )
-\ flash-selected-data ( millisecs -- )
-\ mark-loops ( -- )
+\ flash-selected-data ( millisecs -- )
+\ mark-loops ( -- )
\
-\ do-all-chans ( func :optional origin -- )
-\ update-graphs ( -- )
-\ do-chans ( func :optional origin -- )
-\ do-sound-chans ( func :optional origin -- )
-\ every-sample? ( func -- f )
-\ sort-samples ( nbins -- ary )
-\ place-sound ( mono stereo pan -- res )
-\ fft-edit ( bottom top :optional snd chn -- vct )
-\ fft-squelch ( squelch :optional snd chn -- scl )
-\ fft-cancel ( lo-freq hi-freq :optional snd chn -- vct )
-\ make-ramp ( :optional size -- gen )
-\ ramp ( gen up -- val )
-\ squelch-vowels ( :optional snd chn -- val )
-\ fft-env-data ( fft-env :optional snd chn -- vct )
-\ fft-env-edit ( fft-env :optional snd chn -- vct )
-\ fft-env-interp ( env1 env2 interp :optional snd chn -- vct )
-\ filter-fft ( flt :optional normalize snd chn -- val )
-\ fft-smoother ( cutoff start samps :optional snd chn -- val )
-\ comb-filter ( scaler size -- prc; x self -- res )
-\ comb-chord ( scaler size amp -- prc; x self -- res )
-\ zcomb ( scaler size pm -- prc; x self -- val )
-\ notch-filter ( scaler size -- prc; x self -- val )
-\ formant-filter ( radius frequency -- prc; x self -- val )
-\ formants ( r1 f1 r2 f2 r3 f3 -- prc; x self -- val )
-\ moving-formant ( radius move -- prc; x self -- val )
-\ osc-formants ( radius bases amounts freqs -- prc; x self -- val )
+\ do-all-chans ( func :optional origin -- )
+\ update-graphs ( -- )
+\ do-chans ( func :optional origin -- )
+\ do-sound-chans ( func :optional origin -- )
+\ every-sample? ( func -- f )
+\ sort-samples ( nbins -- ary )
+\ place-sound ( mono stereo pan -- res )
+\ fft-edit ( bottom top :optional snd chn -- vct )
+\ fft-squelch ( squelch :optional snd chn -- scl )
+\ fft-cancel ( lo-freq hi-freq :optional snd chn -- vct )
+\ make-ramp ( :optional size -- gen )
+\ ramp ( gen up -- val )
+\ squelch-vowels ( :optional snd chn -- val )
+\ fft-env-data ( fft-env :optional snd chn -- vct )
+\ fft-env-edit ( fft-env :optional snd chn -- vct )
+\ fft-env-interp ( env1 env2 interp :optional snd chn -- vct )
+\ filter-fft ( flt :optional normalize snd chn -- val )
+\ fft-smoother ( cutoff start samps :optional snd chn -- val )
+\ comb-filter ( scaler size -- prc; x self -- res )
+\ comb-chord ( scaler size amp -- prc; x self -- res )
+\ zcomb ( scaler size pm -- prc; x self -- val )
+\ notch-filter ( scaler size -- prc; x self -- val )
+\ formant-filter ( radius frequency -- prc; x self -- val )
+\ formants ( r1 f1 r2 f2 r3 f3 -- prc; x self -- val )
+\ moving-formant ( radius move -- prc; x self -- val )
+\ osc-formants ( radius bases amounts freqs -- prc; x self -- val )
\
-\ echo ( scaler secs -- prc; y self -- val )
-\ zecho ( scaler secs freq amp -- prc; y self -- val )
-\ flecho ( scaler secs -- prc; y self -- val )
-\ ring-mod ( freq gliss-env -- prc; y self -- val )
-\ am ( freq -- prc; y self -- val )
-\ vibro ( speed depth -- prc; y self -- val )
+\ echo ( scaler secs -- prc; y self -- val )
+\ zecho ( scaler secs freq amp -- prc; y self -- val )
+\ flecho ( scaler secs -- prc; y self -- val )
+\ ring-mod ( freq gliss-env -- prc; y self -- val )
+\ am ( freq -- prc; y self -- val )
+\ vibro ( speed depth -- prc; y self -- val )
\
-\ hello-dentist ( frq amp :optional snd chn -- vct )
-\ fp ( sr osamp osfrq :optional snd chn -- vct )
-\ compand ( -- prc; y self -- val )
-\ compand-channel ( :optional beg dur snd chn edpos -- val )
-\ compand-sound ( :optional beg dur snd -- )
-\ expsrc ( rate :optional snd chn -- val )
-\ expsnd ( gr-env :optional snd chn -- vct )
-\ cross-synthesis ( cross-snd amp fftsize r -- prc; y self -- val )
-\ voiced->unvoiced ( amp fftsize r tempo :optional snd chn -- vct )
-\ pulse-voice ( cosines :optional freq amp fftsize r snd chn -- vct )
-\ cnvtest ( snd0 snd1 amp -- mx )
-\ swap-selection-channels ( -- )
-\ make-sound-interp ( start :optional snd chn -- prc; loc self -- val )
-\ sound-interp ( func loc -- val )
-\ env-sound-interp ( envelope :optional time-scale snd chn -- file-name )
-\ granulated-sound-interp ( e :optional tscale grain-len grain-env out-hop snd chn -- file-name )
-\ filtered-env ( e :optional snd chn -- val )
+\ hello-dentist ( frq amp :optional snd chn -- vct )
+\ fp ( sr osamp osfrq :optional snd chn -- vct )
+\ compand ( -- prc; y self -- val )
+\ expsrc ( rate :optional snd chn -- val )
+\ expsnd ( gr-env :optional snd chn -- vct )
+\ cross-synthesis ( cross-snd amp fftsize r -- prc; y self -- val )
+\ voiced->unvoiced ( amp fftsize r tempo :optional snd chn -- vct )
+\ pulse-voice ( cos :optional freq amp fftsize r snd chn -- vct )
+\ cnvtest ( snd0 snd1 amp -- mx )
+\ swap-selection-channels ( -- )
+\ make-sound-interp ( start :optional snd chn -- prc; loc self -- val )
+\ sound-interp ( func loc -- val )
+\ env-sound-interp ( env :optional time-scale snd chn -- vct )
+\ granulated-sound-interp ( e :optional tscl glen genv ohop snd chn -- vct )
+\ filtered-env ( e :optional snd chn -- val )
\
-\ switch-to-buffer ( -- val )
-\ find-click ( loc -- pos )
-\ remove-clicks ( -- )
-\ search-for-click ( -- pos )
-\ zero+ ( -- prc; n self -- val )
-\ next-peak ( -- prc; n self -- val )
-\ find-pitch ( pitch -- prc; y self -- val )
-\ file->vct ( file -- vct )
-\ add-notes ( notes :optional snd chn -- #f )
-\ region-play-list ( data -- )
-\ region-play-sequence ( data -- )
-\ replace-with-selection ( -- )
-\ explode-sf2 ( -- )
+\ find-click ( loc -- pos )
+\ remove-clicks ( -- )
+\ search-for-click ( -- pos )
+\ zero+ ( -- prc; n self -- val )
+\ next-peak ( -- prc; n self -- val )
+\ find-pitch ( pitch -- prc; y self -- val )
+\ file->vct ( file -- vct )
+\ add-notes ( notes :optional snd chn -- #f )
+\ region-play-list ( data -- )
+\ region-play-sequence ( data -- )
+\ replace-with-selection ( -- )
+\ explode-sf2 ( -- )
\ open-next-file-in-directory ( -- f )
\ click-middle-button-to-open-next-file-in-directory ( -- )
-\ chain-dsps ( start dur :optional dsps -- )
+\ chain-dsps ( start dur :optional dsps -- )
\
-\ smooth-channel-via-ptree ( :optional beg dur snd chn edpos -- val )
-\ ring-modulate-channel ( freq :optional beg dur snd chn edpos -- val )
-\ scramble-channels ( new-order -- )
-\ scramble-channel ( silence -- )
-\ reverse-by-blocks ( block-len :optional snd chn -- val )
-\ reverse-within-blocks ( block-len :optional snd chn -- val )
-\ channel-clipped? ( :optional snd chn -- val )
-\ sync-everything ( -- )
+\ scramble-channels ( new-order -- )
+\ scramble-channel ( silence -- )
+\ reverse-by-blocks ( block-len :optional snd chn -- val )
+\ reverse-within-blocks ( block-len :optional snd chn -- val )
+\ channel-clipped? ( :optional snd chn -- val )
+\ sync-everything ( -- )
\
-\ make-moog-filter ( freq Q -- gen )
-\ moog-frequecy@ ( gen -- frq )
-\ moog-frequecy! ( frq gen -- )
-\ moog-filter ( gen sig -- A )
+\ make-moog-filter ( freq Q -- gen )
+\ moog-frequecy@ ( gen -- frq )
+\ moog-frequecy! ( frq gen -- )
+\ moog-filter ( gen sig -- A )
'snd-nogui provided? [if]
- <'> noop alias show-widget \ ( a -- b )
- <'> noop alias hide-widget \ ( a -- b )
- <'> noop alias widget-size \ ( a -- b )
- : set-widget-size ( a b -- c ) drop ;
- : window-property ( a b -- c ) drop ;
- : set-window-property ( a b c -- d ) 2drop ;
+ <'> noop alias show-widget ( a -- a )
+ <'> noop alias hide-widget ( a -- a )
+ <'> noop alias widget-size ( a -- a )
+ : set-widget-size ( a b -- a ) drop ;
+ : window-property ( a b -- a ) drop ;
+ : set-window-property ( a b c -- a ) 2drop ;
[then]
\ #( #( snd0 chn0 ) #( snd0 chn1 ) ... )
: all-chans ( -- array-of-lists )
- #() { ary }
- sounds each { snd }
- snd channels 0 ?do
- ary #( snd i ) array-push drop
- loop
- end-each
- ary
+ nil { snd }
+ #() ( ary )
+ sounds each to snd
+ snd channels 0 ?do
+ ( ary ) #( snd i ) array-push
+ loop
+ end-each
+ ( ary )
;
\ 5 == notebook widget
: close-sound-extend <{ snd -- }>
- main-widgets 5 object-ref if
- sounds snd object-index 0 max { idx }
- snd close-sound drop
- sounds empty? unless
- sounds
- idx sounds length < if idx else -1 then
- object-ref set-selected-sound drop
- then
- else
- snd close-sound drop
- then
+ main-widgets 5 object-ref if
+ sounds snd object-index 0 max { idx }
+ snd close-sound drop
+ sounds empty? unless
+ sounds
+ idx sounds length < if
+ idx
+ else
+ -1
+ then object-ref set-selected-sound drop
+ then
+ else
+ snd close-sound drop
+ then
;
: snd-snd <{ :optional snd #f -- snd }>
- snd integer? if
- snd
- else
- selected-sound integer? if
- selected-sound
- else
- sounds 0 array-ref
- then
- then
+ snd sound? if
+ snd
+ else
+ selected-sound to snd
+ snd sound? if
+ snd
+ else
+ sounds car
+ then
+ then
;
+
: snd-chn <{ :optional chn #f -- chn }>
- chn integer? if
- chn
- else
- #f selected-channel integer? if
- #f selected-channel
- else
- 0
- then
- then
+ chn integer? if
+ chn
+ else
+ #f selected-channel to chn
+ chn integer? if
+ chn
+ else
+ 0
+ then
+ then
;
\ === Traditional Forth Read-Eval-Loop for Snd's listener. ===
+
+"ok " constant read-eval-loop-prompt
+
hide
-#f value ficl-stack
-
-: read-eval-loop-cb <{ line -- result-string }>
- #f clear-minibuffer drop
- line empty? if
- "ok\n" snd-print drop
- else
- ficl-stack restore-stack
- $space snd-print drop
- line <'> string-eval #t nil fth-catch false? if
- save-stack to ficl-stack
- $" ok\n" snd-print drop
- else
- stack-reset
- $" %s in %s"
- #( *last-exception* exception-name *last-exception* exception-last-message-ref )
- string-format snd-warning drop
- *fth-verbose* if backtrace then
- then
- then
- reset-listener-cursor drop
- #t
-;
-: __toggle-read-eval-loop { key -- }
- key 'on equal?
- key #t equal? || if \ on
- read-hook <'> read-eval-loop-cb hook-member? unless
- read-hook <'> read-eval-loop-cb add-hook!
- then
- else
- key 'off equal?
- key #f equal? || if \ off
- read-hook <'> read-eval-loop-cb remove-hook!
- else \ toggle
- read-hook <'> read-eval-loop-cb hook-member? if
- read-hook <'> read-eval-loop-cb remove-hook!
- else
- read-hook <'> read-eval-loop-cb add-hook!
- then
- then
- then
- #f to ficl-stack
- stack-reset
- reset-listener-cursor drop
+#f value rel-ficl-stack
+#f value rel-old-listener-prompt
+#f value rel-old-hooks
+
+: rel-cb <{ text -- flag }>
+ rel-ficl-stack restore-stack
+ $space snd-print drop
+ text string-eval save-stack to rel-ficl-stack
+ $cr snd-print drop
+ read-eval-loop-prompt snd-print drop
+ \ reset-listener-cursor returns #f
+ reset-listener-cursor not
+;
+
+: rel-add ( -- )
+ listener-prompt to rel-old-listener-prompt
+ read-eval-loop-prompt set-listener-prompt drop
+ read-hook hook->array to rel-old-hooks
+ read-hook reset-hook!
+ read-hook <'> rel-cb add-hook!
+;
+
+: rel-remove ( -- )
+ read-hook <'> rel-cb remove-hook!
+ nil { prc }
+ rel-old-hooks empty? unless
+ rel-old-hooks each to prc
+ read-hook prc add-hook!
+ end-each
+ then
+ rel-old-listener-prompt set-listener-prompt drop
+;
+
+: rel-toggle ( key -- )
+ ( key ) case
+ 'on of
+ read-hook <'> rel-cb hook-member? unless
+ rel-add
+ then
+ endof
+ 'off of
+ rel-remove
+ endof
+ 'toggle of
+ read-hook <'> rel-cb hook-member? if
+ rel-remove
+ else
+ rel-add
+ then
+ endof
+ endcase
+ #f to rel-ficl-stack
+ stack-reset
+ reset-listener-cursor drop
;
set-current
-: toggle-read-eval-loop ( -- ) nil __toggle-read-eval-loop ;
-: make-read-eval-loop ( -- ) #t __toggle-read-eval-loop ;
-: remove-read-eval-loop ( -- ) #f __toggle-read-eval-loop ;
+
+<'> noop alias ok
+
+: make-read-eval-loop ( -- ) 'on rel-toggle ;
+: remove-read-eval-loop ( -- ) 'off rel-toggle ;
+: toggle-read-eval-loop ( -- ) 'toggle rel-toggle ;
previous
require clm
@@ -239,116 +257,138 @@ require rgb
\ === from frame.scm
\
: insert-vct <{ v :optional beg 0 dur #f snd #f chn #f edpos #f -- samps }>
- doc" Inserts vct V's data into sound SND at BEG."
- v vct? v 1 $" a vct" assert-type
- dur v vct-length || { len }
- beg len v snd chn edpos #f $" %S %s %s %s" #( v beg dur get-func-name ) format insert-samples
+ doc" Insert vct V's data into sound SND at BEG."
+ v vct? v 1 "a vct" assert-type
+ dur v vct-length || { len }
+ beg len v snd chn edpos #f "%S %s %s %s"
+ #( v beg dur get-func-name ) string-format insert-samples
;
\ === examp.scm|rb
\
\ this mainly involves keeping track of the current sound/channel
: selection-rms ( -- val )
- doc" Returns rms of selection data using sample readers."
- undef selection? if
- selection-position #f #f 1 #f make-sampler { rd }
- selection-frames { len }
- 0.0 ( sum ) len 0 ?do rd next-sample dup f* f+ ( sum += ... ) loop
- len f/ fsqrt
- else
- 'no-active-selection #( get-func-name ) fth-throw
- then
+ doc" Return rms of selection data using sample readers."
+ undef selection? unless
+ 'no-active-selection #( get-func-name ) fth-throw
+ then
+ selection-position #f #f 1 #f make-sampler { rd }
+ selection-framples { len }
+ 0.0 ( sum ) len 0 ?do
+ rd next-sample dup f* f+ ( sum += ... )
+ loop
+ len f/ fsqrt
;
: region-rms <{ :optional reg 0 -- val }>
- doc" Returns rms of region N's data (chan 0)."
- reg region? if
- reg 0 0 region->vct { data }
- data dup dot-product data length f/ fsqrt
- else
- 'no-such-region #( get-func-name reg ) fth-throw
- then
+ doc" Return rms of region N's data (chan 0)."
+ reg region? unless
+ 'no-such-region #( "%s: %s" get-func-name reg ) fth-throw
+ then
+ reg 0 0 region->vct { data }
+ data dup dot-product data length f/ fsqrt
;
: window-samples <{ :optional snd #f chn #f -- vct }>
- doc" Samples in SND channel CHN in current graph window."
-
- snd chn left-sample { wl }
- snd chn right-sample { wr }
- wl wr wl - 1+ snd chn #f channel->vct
+ doc" Sample in SND channel CHN in current graph window."
+ snd chn left-sample { wl }
+ snd chn right-sample { wr }
+ wl wr wl - 1+ snd chn #f channel->vct
;
: display-energy <{ snd chn -- v }>
- doc" A lisp-graph-hook function to display the time domain data as energy (squared).\n\
-list-graph-hook <'> display-energy add-hook!"
- snd chn undef undef undef make-graph-data dup array? if 1 array-ref then { data }
- data if
- snd chn left-sample { ls }
- snd chn right-sample { rs }
- snd srate { sr }
- snd chn y-zoom-slider { y-max }
- data dup vct-multiply! $" energy" ls sr f/ rs sr f/ 0.0 y-max dup f* snd chn #t graph
- else
- #f
- then
+ doc" A lisp-graph-hook function to display the time \
+domain data as energy (squared).\n\
+list-graph-hook <'> display-energy add-hook!."
+ snd chn undef undef undef make-graph-data dup array? if
+ 1 array-ref
+ then { data }
+ data if
+ snd chn left-sample { ls }
+ snd chn right-sample { rs }
+ snd srate { sr }
+ snd chn y-zoom-slider { y-max }
+ data data vct-multiply! "energy" ls sr f/ rs sr f/
+ 0.0 y-max dup f* snd chn #t undef graph
+ else
+ #f
+ then
;
\ lisp-graph-hook <'> display-energy add-hook!
hide
-: db-calc ( val -- r ) { val } val 0.001 f< if -60.0 else 20.0 val flog10 f* then ;
+: db-calc { val -- r }
+ val 0.001 f< if
+ -60.0
+ else
+ 20.0 val flog10 f*
+ then
+;
set-current
+
: display-db <{ snd chn -- v }>
- doc" A lisp-graph-hook function to display the time domain data in dB.\n\
-list-graph-hook <'> display-db add-hook!"
- snd chn undef undef undef make-graph-data dup array? if 1 array-ref then { data }
- data if
- snd chn left-sample { ls }
- snd chn right-sample { rs }
- snd srate { sr }
- data map
- *key* fabs db-calc 60.0 f+
- end-map $" dB" ls sr f/ rs sr f/ 0.0 60.0 snd chn #t graph
- else
- #f
- then
+ doc" A lisp-graph-hook function to display \
+the time domain data in dB.\n\
+list-graph-hook <'> display-db add-hook!."
+ snd chn undef undef undef make-graph-data dup array? if
+ 1 array-ref
+ then { data }
+ data if
+ snd chn left-sample { ls }
+ snd chn right-sample { rs }
+ snd srate { sr }
+ data map
+ *key* fabs db-calc 60.0 f+
+ end-map "dB" ls sr f/ rs sr f/ 0.0 60.0 snd chn #t undef graph
+ else
+ #f
+ then
;
previous
\ lisp-graph-hook <'> display-db add-hook!
: window-rms ( -- val )
- doc" Returns rms of data in currently selected graph window."
- #f #f left-sample { ls }
- #f #f right-sample { rs }
- ls rs ls - 1+ #f #f #f channel->vct { data }
- data vct-length { len }
- data data len dot-product len f/ fsqrt
+ doc" Return rms of data in currently selected graph window."
+ #f #f left-sample { ls }
+ #f #f right-sample { rs }
+ ls rs ls - 1+ #f #f #f channel->vct { data }
+ data vct-length { len }
+ data dup len dot-product len f/ fsqrt
;
: fft-peak <{ snd chn scaler -- pk }>
- doc" Returns the peak spectral magnitude"
- snd chn transform-graph?
- snd chn transform-graph-type graph-once = && if
- snd chn #f transform->vct vct-peak f2* snd chn transform-size f/
- object->string snd #f report-in-minibuffer
- else
- #f
- then
+ doc" print peak spectral magnitude\n\
+Returns the peak spectral magnitude. \
+It is intended for use with after-transform-hook."
+ snd chn transform-graph?
+ snd chn transform-graph-type graph-once = && if
+ snd chn #f transform->vct vct-peak f2*
+ snd chn transform-size f/ { pk }
+ pk number->string snd status-report drop
+ pk
+ else
+ #f
+ then
;
\ after-transform-hook <'> fft-peak add-hook!
\ ;;; -------- 'info' from extsnd.html using format --------
: finfo ( file -- str )
- doc" Returns description (as a string) of file."
- find-file { file }
- file false? if 'no-such-file #( get-func-name file ) fth-throw then
- $" %s: chans: %d, srate: %d, %s, %s, len: %1.3f"
- #( file
- file mus-sound-chans
- file mus-sound-srate
- file mus-sound-header-type mus-header-type-name
- file mus-sound-data-format mus-data-format-name
- file mus-sound-samples file mus-sound-chans file mus-sound-srate f* f/ ) string-format
+ doc" Return description (as a string) of file."
+ find-file { file }
+ file unless
+ 'no-such-file #( "%s: %S" get-func-name file ) fth-throw
+ then
+ "%s: chans: %d, srate: %d, %s, %s, len: %1.3f"
+ #( file
+ file mus-sound-chans
+ file mus-sound-srate
+ file mus-sound-header-type mus-header-type-name
+ file mus-sound-sample-type mus-sample-type-name
+ file mus-sound-samples
+ file mus-sound-chans
+ file mus-sound-srate f* f/ ) string-format
;
\ ;;; -------- Correlation --------
@@ -356,41 +396,43 @@ previous
\ ;;; correlation of channels in a stereo sound
: display-correlate <{ snd chn y0 y1 -- val }>
- doc" Returns the correlation of SND's 2 channels (intended for use with graph-hook). \
+ doc" Return the correlation of SND's 2 channels (intended \
+for use with graph-hook). \
y0 and y1 are ignored."
- snd channels 2 = if
- snd 0 #f frames 1 >
- snd 1 #f frames 1 > && if
- snd chn left-sample { ls }
- snd chn right-sample { rs }
- rs ls - 1+ { ilen }
- ilen flog 2.0 flog f/ fround->s { pow2 }
- 2.0 pow2 f** fround->s { fftlen }
- fftlen 2/ { fftlen2 }
- fftlen 1/f { fftscale }
- ls fftlen snd 0 #f channel->vct { rl1 }
- ls fftlen snd 1 #f channel->vct { rl2 }
- fftlen 0.0 make-vct { im1 }
- fftlen 0.0 make-vct { im2 }
- rl1 im1 1 fft drop
- rl2 im2 1 fft drop
- rl1 vct-copy { tmprl }
- im1 vct-copy { tmpim }
- fftlen2 0.0 make-vct { data3 }
- tmprl rl2 vct-multiply! drop
- tmpim im2 vct-multiply! drop
- im2 rl1 vct-multiply! drop
- rl2 im1 vct-multiply! drop
- tmprl tmpim vct-add! drop
- im2 rl2 vct-subtract! drop
- tmprl im2 -1 fft drop
- data3 tmprl vct-add! drop
- data3 fftscale vct-scale! drop
- data3 $" lag time" 0 fftlen2 undef undef snd chn undef undef graph
- then
- else
- $" %s wants stereo input" #( get-func-name ) string-format snd #f report-in-minibuffer
- then
+ snd channels 2 = if
+ snd 0 #f framples 1 >
+ snd 1 #f framples 1 > && if
+ snd chn left-sample { ls }
+ snd chn right-sample { rs }
+ rs ls - 1+ { ilen }
+ ilen flog 2.0 flog f/ fround->s { pow2 }
+ 2.0 pow2 f** fround->s { fftlen }
+ fftlen 2/ { fftlen2 }
+ fftlen 1/f { fftscale }
+ ls fftlen snd 0 #f channel->vct { rl1 }
+ ls fftlen snd 1 #f channel->vct { rl2 }
+ fftlen 0.0 make-vct { im1 }
+ fftlen 0.0 make-vct { im2 }
+ rl1 im1 1 fft drop
+ rl2 im2 1 fft drop
+ rl1 vct-copy { tmprl }
+ im1 vct-copy { tmpim }
+ fftlen2 0.0 make-vct { data3 }
+ tmprl rl2 vct-multiply! drop
+ tmpim im2 vct-multiply! drop
+ im2 rl1 vct-multiply! drop
+ rl2 im1 vct-multiply! drop
+ tmprl tmpim 0 vct-add! drop
+ im2 rl2 vct-subtract! drop
+ tmprl im2 -1 fft drop
+ data3 tmprl 0 vct-add! drop
+ data3 fftscale vct-scale! drop
+ data3 "lag time" 0 fftlen2
+ undef undef snd chn #t undef graph
+ then
+ else
+ get-func-name " wants stereo input" $+ snd status-report
+ then
;
\ graph-hook <'> display-correlate add-hook!
@@ -399,151 +441,206 @@ y0 and y1 are ignored."
\ ;;; also zoom spectrum based on y-axis zoom slider
: zoom-spectrum <{ snd chn y0 y1 -- val }>
- doc" Sets the transform size to correspond to the time-domain window size (use with graph-hook)."
- snd chn transform-graph?
- snd chn transform-graph-type graph-once = && if
- 2.0 snd chn right-sample snd chn left-sample f- flog 2.0 flog f/ fceil f** fround->s
- snd chn set-transform-size drop
- snd chn y-zoom-slider snd chn set-spectrum-end drop
- then
- #f
+ doc" Set the transform size to correspond to the \
+time-domain window size (use with graph-hook)."
+ snd chn transform-graph?
+ snd chn transform-graph-type graph-once = && if
+ 2.0 snd chn right-sample snd chn left-sample f-
+ flog 2.0 flog f/ fceil f** fround->s { val }
+ val 0> if
+ val snd chn set-transform-size drop
+ then
+ snd chn y-zoom-slider snd chn set-spectrum-end drop
+ then
+ #f
;
\ graph-hook <'> zoom-spectrum add-hook!
\ ;;; -------- superimpose spectra of sycn'd sounds
: superimpose-ffts <{ snd chn y0 y1 -- val }>
- doc" Superimposes ffts of multiple (syncd) sounds (use with graph-hook)."
- 0 sounds each ( snd ) sync max end-each { maxsync }
- 0 sounds each { n } n sync snd sync = if n else maxsync 1+ then min end-each { sndsync }
- snd sync 0> snd sndsync = && if
- snd chn left-sample { ls }
- snd chn right-sample { rs }
- rs ls f- flog 2.0 flog f/ fround->s { pow2 }
- 2.0 pow2 f** fround->s { fftlen }
- pow2 2 > if
- nil { ffts }
- sounds each { n }
- n sync snd sync = n channels chn > && if
- ls fftlen n chn #f channel->vct { fdr }
- fftlen 0.0 make-vct { fdi }
- fftlen 2/ 0.0 make-vct { spectr }
- ffts #( spectr fdr fdi #f 2 spectrum 0 vct-add! ) array-append to ffts
+ doc" Superimpose ffts of multiple (syncd) sounds (use with graph-hook)."
+ 0 ( maxsync )
+ sounds each ( snd )
+ sync max
+ end-each { maxsync }
+ 0 sounds each { n }
+ n sync snd sync = if
+ n
+ else
+ maxsync 1+
+ then min
+ end-each { sndsync }
+ snd chn left-sample { ls }
+ snd chn right-sample { rs }
+ snd sync 0>
+ rs ls > &&
+ snd sndsync = && if
+ rs ls f- 1.0 fmax 2.0 flog fceil->s { pow2 }
+ 2.0 pow2 f** floor->s { fftlen }
+ pow2 2 > if
+ #() { ffts }
+ sounds each { n }
+ n sync snd sync =
+ n channels chn > && if
+ ls fftlen n chn #f channel->vct { fdr }
+ fftlen 0.0 make-vct { fdi }
+ fftlen 2/ 0.0 make-vct ( spectr )
+ fdr fdi #f 2 spectrum
+ 0 vct-add! { val }
+ ffts #( val ) array-push drop
+ then
+ end-each
+ ffts "spectra" 0.0 0.5 y0 y1
+ snd chn #t undef graph drop
+ then
then
- end-each
- ffts "spectra" 0.0 0.5 undef undef snd chn undef undef graph drop
- then
- then
- #f
+ #f
;
\ graph-hook <'> superimpose-ffts add-hook!
\ ;;; -------- c-g? example (Anders Vinjar)
: locate-zero ( limit -- samp )
- doc" Looks for successive samples that sum to less than LIMIT, moving the cursor if successful."
- { limit }
- #f #f #f cursor { start }
- start #f #f 1 #f make-sampler { sf }
- sf next-sample fabs { val0 }
- sf next-sample fabs { val1 }
- begin
- sf sampler-at-end?
- \ c-g? ||
- val0 val1 f+ limit f< || not
- while
- start 1+ to start
- val1 to val0
- sf next-sample fabs to val1
- repeat
- sf free-sampler drop
- start #f #f #f set-cursor
+ doc" Look for successive samples that sum to less than LIMIT, \
+moving the cursor if successful."
+ { limit }
+ #f #f #f cursor { start }
+ start #f #f 1 #f make-sampler { sf }
+ sf next-sample fabs { val0 }
+ sf next-sample fabs { val1 }
+ begin
+ sf sampler-at-end?
+ val0 val1 f+ limit f< || not
+ while
+ start 1+ to start
+ val1 to val0
+ sf next-sample fabs to val1
+ repeat
+ sf free-sampler drop
+ start #f #f #f set-cursor
;
\ ;;; -------- translate mpeg input to 16-bit linear and read into Snd
\ ;;;
-\ ;;; mpg123 with the -s switch sends the 16-bit (mono or stereo) representation of
-\ ;;; an mpeg file to stdout. There's also apparently a switch to write 'wave' output.
+\ ;;; mpg123 with the -s switch sends the 16-bit (mono or stereo)
+\ ;;; representation of an mpeg file to stdout. There's also
+\ ;;; apparently a switch to write 'wave' output.
: mpg ( mpgfile rawfile -- )
- doc" Converts file from MPEG to raw 16-bit samples using mpg123."
- { mpgfile rawfile }
- mpgfile io-open-read { io }
- io io-getc { b0 }
- io io-getc { b1 }
- io io-getc { b2 }
- io io-getc { b3 }
- io io-close
- b0 255 <>
- b1 0b11100000 and 0b11100000 <> || if
- $" %s is not an MPEG file (first 11 bytes: %b %b)" #( mpgfile b0 b1 0b11100000 and ) clm-message
- else
- b1 0b11000 and 3 rshift { id }
- b1 0b110 and 1 rshift { layer }
- b2 0b1100 and 2 rshift { srate-index }
- b3 0b11000000 and 6 rshift { channel-mode }
- id 1 = if
- $" odd: %s is using a reserved Version ID" #( mpgfile ) clm-message
- then
- layer 0= if
- $" odd: %s is using a reserved layer description" #( mpgfile ) clm-message
- then
- channel-mode 3 = if 1 else 2 then { chans }
- id 0= if 4 else id 2 = if 2 else 1 then then { mpegnum }
- layer 3 = if 1 else layer 2 = if 2 else 3 then then { mpeg-layer }
- #( 44100 48000 32000 0 ) srate-index array-ref mpegnum / { srate }
- $" %s: %s Hz, %s, MPEG-%s"
- #( mpgfile srate chans 1 = if "mono" else "stereo" then mpeg-layer ) clm-message
- $" mpg123 -s %s > %s" #( mpgfile rawfile ) string-format file-system if
- rawfile chans srate little-endian? if mus-lshort else mus-bshort then open-raw-sound drop
- else
- $" system in %s: %s" #( get-func-name exit-status ) clm-message
- then
- then
+ doc" Convert file from MPEG to raw 16-bit samples using mpg123."
+ { mpgfile rawfile }
+ mpgfile io-open-read { io }
+ io io-getc { b0 }
+ io io-getc { b1 }
+ io io-getc { b2 }
+ io io-getc { b3 }
+ io io-close
+ b0 255 <>
+ b1 0b11100000 and 0b11100000 <> || if
+ "%s is not an MPEG file (first 11 bytes: %b %b)"
+ #( mpgfile b0 b1 0b11100000 and ) clm-print
+ exit
+ then
+ b1 0b11000 and 3 rshift { id }
+ b1 0b110 and 1 rshift { layer }
+ b2 0b1100 and 2 rshift { srate-index }
+ b3 0b11000000 and 6 rshift { channel-mode }
+ id 1 = if
+ "odd: %s is using a reserved Version ID"
+ #( mpgfile ) clm-print
+ then
+ layer 0= if
+ "odd: %s is using a reserved layer description"
+ #( mpgfile ) clm-print
+ then
+ channel-mode 3 = if
+ 1
+ else
+ 2
+ then { chans }
+ id 0= if
+ 4
+ else
+ id 2 = if
+ 2
+ else
+ 1
+ then
+ then { mpegnum }
+ layer 3 = if
+ 1
+ else
+ layer 2 = if
+ 2
+ else
+ 3
+ then
+ then { mpeg-layer }
+ #( 44100 48000 32000 0 ) srate-index array-ref mpegnum / { srate }
+ "%s: %s Hz, %s, MPEG-%s"
+ #( mpgfile
+ srate
+ chans 1 = if
+ "mono"
+ else
+ "stereo"
+ then mpeg-layer ) clm-print
+ "mpg123 -s %s > %s" #( mpgfile rawfile ) string-format file-system if
+ rawfile chans srate little-endian? if
+ mus-lshort
+ else
+ mus-bshort
+ then open-raw-sound drop
+ else
+ "system in %s: %s" #( get-func-name exit-status ) fth-throw
+ then
;
\ "mpeg.mpg" "mpeg.raw" mpg
\ ;;; -------- read ASCII files
\ ;;;
-\ ;;; these are used by Octave (WaveLab) -- each line has one integer, apparently a signed short.
+\ ;;; these are used by Octave (WaveLab) -- each line has one integer,
+\ ;;; apparently a signed short.
hide
: read-ascii-cb { fname snd -- prc; self -- }
- 0 proc-create fname , snd , ( thunk )
- does> { self -- }
- self @ ( fname ) readlines { in-buffer }
- self cell+ @ { snd }
- 512 { bufsize }
- bufsize 0.0 make-vct { data }
- 0 { loc }
- 0 { frame }
- 32768.0 1/f { short->float }
- nil { val }
- in-buffer each ( line ) nil string-split each ( str-val ) string->number ( val ) short->float f*
- data loc rot vct-set! drop
- loc 1+ to loc
- loc bufsize = if
- data frame bufsize snd 0 vct->channel drop
- frame bufsize d+ to frame
- 0 to loc
- then
- end-each
- end-each
- loc d0> if
- data frame loc snd 0 vct->channel drop
- then
+ 0 proc-create ( prc )
+ fname , snd ,
+ does> { self -- }
+ self @ ( fname ) readlines { in-buffer }
+ self cell+ @ { snd }
+ 512 { bufsize }
+ bufsize 0.0 make-vct { data }
+ 0 { loc }
+ 0 { frame }
+ 32768.0 1/f { short->float }
+ nil { val }
+ in-buffer each ( line )
+ nil string-split each ( str-val )
+ string->number ( val ) short->float f*
+ data loc rot vct-set! drop
+ loc 1+ to loc
+ loc bufsize = if
+ data frame bufsize snd 0 vct->channel drop
+ frame bufsize d+ to frame
+ 0 to loc
+ then
+ end-each
+ end-each
+ loc d0> if
+ data frame loc snd 0 vct->channel drop
+ then
;
set-current
-: read-ascii <{ in-filename :optional
- out-filename "test.snd"
- out-type mus-next
- out-format mus-bshort
- out-srate 44100 -- snd }>
- doc" tries to read an ASCII sound file"
- out-filename out-type out-format out-srate 1 $" created by read-ascii: " in-filename $+ new-sound { snd }
- in-filename snd read-ascii-cb as-one-edit drop
- snd
+: read-ascii
+ <{ fl :optional sf "test.snd" st mus-next ht mus-bshort sr 44100 -- snd }>
+ doc" Try to read an ASCII sound file."
+ "created by %s: %s" #( get-func-name fl ) string-format { com }
+ sf 1 sr ht st com new-sound { snd }
+ fl snd read-ascii-cb as-one-edit drop
+ snd
;
previous
@@ -553,22 +650,22 @@ previous
\ ;;; if many samples are displayed, etc
: auto-dot <{ snd chn y0 y1 -- val }>
- doc" Sets the dot size depending on the number of samples being displayed (use with graph-hook)."
- snd chn right-sample snd chn left-sample - { dots }
- dots 100 > if
- 1 snd chn set-dot-size drop
- else
- dots 50 > if
- 2 snd chn set-dot-size drop
- else
- dots 25 > if
- 3 snd chn set-dot-size drop
- else
- 5 snd chn set-dot-size drop
- then
- then
- then
- #f
+ doc" Set the dot size depending on the number of \
+samples being displayed (use with graph-hook)."
+ snd chn right-sample snd chn left-sample - { dots }
+ dots 100 > if
+ 1
+ else
+ dots 50 > if
+ 2
+ else
+ dots 25 > if
+ 3
+ else
+ 5
+ then
+ then
+ then snd chn set-dot-size
;
\ graph-hook <'> auto-dot add-hook!
@@ -579,154 +676,184 @@ previous
\ ;;; the desired left edge has a mark, and the 'm' key (without control)
\ ;;; will move the window left edge to that mark.
-: first-mark-in-window-at-left ( -- )
- doc" Moves the graph so that the leftmost visible mark is at the left edge."
- #f snd-snd { keysnd }
- #f snd-chn { keychn }
- keysnd keychn left-sample { current-left-sample }
- keysnd keychn #f marks { chan-marks }
- chan-marks length 0= if
- $" no marks" keysnd #f report-in-minibuffer drop
- else
- #f ( flag ) chan-marks map *key* undef mark-sample end-map each { samp }
- samp current-left-sample > if drop ( #f ) samp leave then
- end-each { leftmost }
- leftmost if
- leftmost keysnd keychn set-left-sample drop
- keyboard-no-action
- else
- $" no mark in window" keysnd #f report-in-minibuffer drop
- then
- then
-;
-\ "m" 0 lambda: <{ -- val }> first-mark-in-window-at-left ;
-\ #f "align window left edge with mark" "align window left edge with mark" bind-key drop
+: first-mark-in-window-at-left <{ -- val }>
+ doc" Move the graph so that the leftmost \
+visible mark is at the left edge."
+ #f snd-snd { keysnd }
+ #f snd-chn { keychn }
+ keysnd keychn left-sample { current-left-sample }
+ keysnd keychn #f marks { chan-marks }
+ chan-marks length 0= if
+ "no marks" status-report
+ else
+ #f ( flag )
+ chan-marks map
+ *key* undef mark-sample
+ end-map each { samp }
+ samp current-left-sample > if
+ drop \ drop #f
+ samp
+ leave
+ then
+ end-each { leftmost }
+ leftmost if
+ leftmost keysnd keychn set-left-sample
+ else
+ "no mark in window" status-report
+ then
+ then drop
+ keyboard-no-action
+;
+\ "m" 0 <'> first-mark-in-window-at-left
+\ #f "align window left edge with mark" dup bind-key drop
\ ;;; -------- flash selected data red and green
-defer flash-selected-data ( millisecs -- )
hide
-: fsd-cb { millisecs -- prc; self -- val }
- 0 proc-create millisecs , ( prc )
- does> { self -- val }
- self @ ( millisecs ) flash-selected-data
- #f
+: fsd-cb { ms xt -- prc; self -- val }
+ 0 proc-create ( prc )
+ ms , xt ,
+ does> { self -- val }
+ self @ ( ms ) self cell+ @ ( xt ) execute
+ #f
;
user data-red?
#t data-red? !
set-current
-lambda: ( millisecs -- )
- doc" Causes the selected data to flash red and green."
- { millisecs }
- selected-sound sound? if
- data-red? @ if green else red then set-selected-data-color drop
- data-red? @ not data-red? !
- millisecs dup fsd-cb in drop
- then
-; is flash-selected-data
+
+: flash-selected-data ( millisecs -- )
+ doc" Cause the selected data to flash red and green."
+ { ms }
+ selected-sound sound? if
+ data-red? @ if
+ green
+ else
+ red
+ then set-selected-data-color drop
+ data-red? @ not data-red? !
+ ms ms running-word fsd-cb in drop
+ then
+;
previous
\ ;;; -------- use loop info (if any) to set marks at loop points
: mark-loops ( -- )
- doc" Places marks at loop points found in the selected sound's header."
- #f snd-snd { snd }
- #f snd-chn { chn }
- snd sound-loop-info
- snd file-name mus-sound-loop-info || { loops }
- loops nil? if
- $" %s has no loop info" #( snd short-file-name ) clm-message
- else
- loops 0 array-ref 0<> loops 1 array-ref 0<> || if
- loops 0 array-ref snd chn undef undef add-mark drop
- loops 1 array-ref snd chn undef undef add-mark drop
- loops 2 array-ref 0<> loops 3 array-ref 0<> || if
- loops 2 array-ref snd chn undef undef add-mark drop
- loops 3 array-ref snd chn undef undef add-mark drop
- then
- then
- then
+ doc" Place marks at loop points found in the selected sound's header."
+ #f snd-snd { snd }
+ #f snd-chn { chn }
+ snd sound-loop-info
+ snd file-name mus-sound-loop-info || { loops }
+ loops empty? if
+ "%s has no loop info"
+ #( snd short-file-name ) string-format
+ snd status-report drop
+ exit
+ then
+ loops 0 array-ref 0<>
+ loops 1 array-ref 0<> || if
+ loops 0 array-ref snd chn undef undef add-mark drop
+ loops 1 array-ref snd chn undef undef add-mark drop
+ loops 2 array-ref 0<>
+ loops 3 array-ref 0<> || if
+ loops 2 array-ref snd chn undef undef add-mark drop
+ loops 3 array-ref snd chn undef undef add-mark drop
+ then
+ then
;
\ ;;; -------- mapping extensions
\ ;;; (map arbitrary single-channel function over various channel collections)
: do-all-chans <{ func :optional origin #f -- }>
- doc" Applies FUNC to all active channels, using ORIGIN as the edit history indication:\n\
-lambda: <{ val -- val*2 }> val f2* ; \"double all samples\" do-all-chans"
- all-chans each { lst }
- lst 0 array-ref { snd }
- lst 1 array-ref { chn }
- func 0 #f snd chn #f origin map-channel drop
- end-each
+ doc" Apply FUNC to all active channels, \
+using ORIGIN as the edit history indication:\n\
+lambda: <{ val -- val*2 }> val f2* ; \"double all samples\" do-all-chans."
+ all-chans each { lst }
+ lst 0 array-ref { snd }
+ lst 1 array-ref { chn }
+ func 0 #f snd chn #f origin map-channel drop
+ end-each
;
: update-graphs ( -- )
- doc" Updates (redraws) all graphs."
- all-chans each { lst }
- lst 0 array-ref { snd }
- lst 1 array-ref { chn }
- snd chn update-time-graph drop
- end-each
+ doc" Update (redraw) all graphs."
+ all-chans each { lst }
+ lst 0 array-ref { snd }
+ lst 1 array-ref { chn }
+ snd chn update-time-graph drop
+ end-each
;
: do-chans <{ func :optional origin #f -- }>
- doc" Applies FUNC to all sync'd channels using ORIGIN as the edit history indication."
- #f snd-snd sync { snc }
- snc 0> if
- all-chans each { lst }
- lst 0 array-ref { snd }
- lst 1 array-ref { chn }
- snd sync snc = if func 0 #f snd chn #f origin map-channel drop then
- end-each
- else
- $" sync not set" snd-warning drop
- then
+ doc" Apply FUNC to all sync'd channels \
+using ORIGIN as the edit history indication."
+ #f snd-snd sync { snc }
+ snc 0> if
+ all-chans each { lst }
+ lst 0 array-ref { snd }
+ lst 1 array-ref { chn }
+ snd sync snc = if
+ func 0 #f snd chn #f origin map-channel drop
+ then
+ end-each
+ else
+ "sync not set" snd status-report drop
+ then
;
: do-sound-chans <{ func :optional origin #f -- }>
- doc" applies FUNC to all selected channels using ORIGIN as the edit history indication."
- selected-sound { snd }
- snd sound? if
- snd channels 0 ?do func 0 #f snd i ( chn ) #f origin map-channel drop loop
- else
- $" no selected sound" snd-warning drop
- then
+ doc" Apply FUNC to all selected channels \
+using ORIGIN as the edit history indication."
+ selected-sound { snd }
+ snd sound? if
+ snd channels 0 ?do
+ func 0 #f snd i ( chn ) #f origin map-channel drop
+ loop
+ else
+ "no selected sound" snd status-report drop
+ then
;
hide
: everys-cb { func -- prc; y self -- f }
- 1 proc-create func , ( prc )
- does> { y self -- f }
- self @ ( func ) #( y ) run-proc not
+ 1 proc-create ( prc )
+ func ,
+ does> { y self -- f }
+ self @ ( func ) #( y ) run-proc not
;
set-current
+
: every-sample? ( func -- f )
- doc" Returns #t if FUNC is not #f for all samples in the current channel, \
- otherwise it moves the cursor to the first offending sample."
- { func }
- func everys-cb 0 #f #f #f #f scan-channel { baddy }
- baddy if baddy 1 array-ref #f #f #f set-cursor drop then
- baddy not
+ doc" Return #t if FUNC is not #f for all samples in the \
+current channel, otherwise it moves the cursor to the first offending sample."
+ { func }
+ func everys-cb 0 #f #f #f #f scan-channel { baddy }
+ baddy if
+ baddy 1 array-ref #f #f #f set-cursor drop
+ then
+ baddy not
;
previous
hide
: sorts-cb { bins -- prc; y self -- f }
- 1 proc-create bins , ( prc )
- does> { y self -- f }
- self @ { bins }
- y fabs bins length f* fround->s { bin }
- bins bin 1 object-set+!
- #f
+ 1 proc-create ( prc )
+ bins ,
+ does> { y self -- f }
+ self @ { bins }
+ y fabs bins length f* fround->s { bin }
+ bins bin 1 object-set+!
+ #f
;
set-current
+
: sort-samples ( nbins -- ary )
- doc" Provides a histogram in BINS bins."
- { nbins }
- nbins :initial-element 0 make-array { bins }
- bins sorts-cb 0 #f #f #f #f scan-channel drop
- bins
+ doc" Provide histogram in BINS bins."
+ { nbins }
+ nbins :initial-element 0 make-array { bins }
+ bins sorts-cb 0 #f #f #f #f scan-channel drop
+ bins
;
previous
@@ -734,294 +861,322 @@ previous
hide
: places1-cb { rd pos -- prc; y self -- val }
- 1 proc-create rd , pos , ( prc )
- does> { y self -- val }
- self @ { rd }
- self cell+ @ { pos }
- rd read-sample pos f* y f+
+ 1 proc-create ( prc )
+ rd , pos ,
+ does> { y self -- val }
+ self @ { rd }
+ self cell+ @ { pos }
+ rd read-sample pos f* y f+
;
+
: places0-cb { rd pos -- prc; y self -- val }
- 1 proc-create rd , pos , ( prc )
- does> { y self -- val }
- self @ { rd }
- self cell+ @ { pos }
- rd read-sample 1.0 pos f- f* y f+
+ 1 proc-create ( prc )
+ rd , pos ,
+ does> { y self -- val }
+ self @ { rd }
+ self cell+ @ { pos }
+ rd read-sample 1.0 pos f- f* y f+
;
+
: places3-cb { rd en -- prc; y self -- val }
- 1 proc-create rd , en , ( prc )
- does> { y self -- val }
- self @ { rd }
- self cell+ @ { en }
- rd read-sample en env f* y f+
+ 1 proc-create ( prc )
+ rd , en ,
+ does> { y self -- val }
+ self @ { rd }
+ self cell+ @ { en }
+ rd read-sample en env f* y f+
;
+
: places2-cb { rd en -- prc; y self -- val }
- 1 proc-create rd , en , ( prc )
- does> { y self -- val }
- self @ { rd }
- self cell+ @ { en }
- rd read-sample 1.0 en env f- f* y f+
+ 1 proc-create ( prc )
+ rd , en ,
+ does> { y self -- val }
+ self @ { rd }
+ self cell+ @ { en }
+ rd read-sample 1.0 en env f- f* y f+
;
set-current
+
: place-sound ( mono stereo pan -- res )
- doc" Mixes a mono sound into a stereo sound, \
+ doc" Mix a mono sound into a stereo sound, \
splitting it into two copies whose amplitudes depend on the envelope PAN-ENV. \
If PAN-ENV is a number, the sound is split such that 0 is all in channel 0 \
and 90 is all in channel 1."
- { mono stereo pan }
- mono #f #f #f frames { len }
- pan number? if
- pan 90.0 f/ { pos }
- 0 mono #f 1 #f make-sampler { reader0 }
- 0 mono #f 1 #f make-sampler { reader1 }
- reader1 pos places1-cb 0 len stereo 1 #f #f map-channel drop
- reader0 pos places0-cb 0 len stereo 0 #f #f map-channel drop
- else
- :envelope pan :length len make-env { e0 }
- :envelope pan :length len make-env { e1 }
- 0 mono #f 1 #f make-sampler { reader0 }
- 0 mono #f 1 #f make-sampler { reader1 }
- reader1 e1 places3-cb 0 len stereo 1 #f #f map-channel drop
- reader0 e0 places2-cb 0 len stereo 0 #f #f map-channel drop
- then
+ { mono stereo pan }
+ mono #f #f #f framples { len }
+ pan number? if
+ pan 90.0 f/ { pos }
+ 0 mono #f 1 #f make-sampler { reader0 }
+ 0 mono #f 1 #f make-sampler { reader1 }
+ reader1 pos places1-cb 0 len stereo 1 #f #f map-channel drop
+ reader0 pos places0-cb 0 len stereo 0 #f #f map-channel drop
+ else
+ :envelope pan :length len make-env { e0 }
+ :envelope pan :length len make-env { e1 }
+ 0 mono #f 1 #f make-sampler { reader0 }
+ 0 mono #f 1 #f make-sampler { reader1 }
+ reader1 e1 places3-cb 0 len stereo 1 #f #f map-channel drop
+ reader0 e0 places2-cb 0 len stereo 0 #f #f map-channel drop
+ then
;
previous
\ ;;; -------- FFT-based editing
: fft-edit <{ bottom top :optional snd #f chn #f -- vct }>
- doc" Ffts an entire sound, removes all energy below BOTTOM and all above TOP, then inverse ffts."
- snd srate { sr }
- snd chn #f frames { len }
- 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
- 0 fsize snd chn #f channel->vct { rdata }
- fsize 0.0 make-vct { idata }
- bottom sr fsize f/ f/ fround->s { lo }
- top sr fsize f/ f/ fround->s { hi }
- rdata idata 1 fft drop
- lo 0> if
- rdata 0 0.0 vct-set! drop
- idata 0 0.0 vct-set! drop
- fsize 1- { jj }
- lo 1 ?do
- rdata i 0.0 vct-set! drop
- rdata jj 0.0 vct-set! drop
- idata i 0.0 vct-set! drop
- idata jj 0.0 vct-set! drop
- jj 1- to jj
- loop
- then
- hi fsize 2/ < if
- fsize hi - { jj }
- fsize 2/ hi ?do
- rdata i 0.0 vct-set! drop
- rdata jj 0.0 vct-set! drop
- idata i 0.0 vct-set! drop
- idata jj 0.0 vct-set! drop
- jj 1- to jj
- loop
- then
- rdata idata -1 fft drop
- $" %s %s %s" #( bottom top get-func-name ) string-format { origin }
- rdata fsize 1/f vct-scale! ( rdata) 0 len 1- snd chn #f origin vct->channel
+ doc" Fft an entire sound, remove all energy \
+below BOTTOM and all above TOP, then inverse fft."
+ snd srate { sr }
+ snd chn #f framples { len }
+ 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
+ 0 fsize snd chn #f channel->vct { rdata }
+ fsize 0.0 make-vct { idata }
+ bottom sr fsize f/ f/ fround->s { lo }
+ top sr fsize f/ f/ fround->s { hi }
+ rdata idata 1 fft drop
+ lo 0> if
+ rdata 0 0.0 vct-set! drop
+ idata 0 0.0 vct-set! drop
+ fsize 1- { jj }
+ lo 1 ?do
+ rdata i 0.0 vct-set! drop
+ rdata jj 0.0 vct-set! drop
+ idata i 0.0 vct-set! drop
+ idata jj 0.0 vct-set! drop
+ jj 1- to jj
+ loop
+ then
+ hi fsize 2/ < if
+ fsize hi - { jj }
+ fsize 2/ hi ?do
+ rdata i 0.0 vct-set! drop
+ rdata jj 0.0 vct-set! drop
+ idata i 0.0 vct-set! drop
+ idata jj 0.0 vct-set! drop
+ jj 1- to jj
+ loop
+ then
+ rdata idata -1 fft drop
+ "%s %s %s" #( bottom top get-func-name ) string-format { origin }
+ rdata fsize 1/f vct-scale! 0 len 1- snd chn #f origin vct->channel
;
+
: fft-squelch <{ squelch :optional snd #f chn #f -- scl }>
- doc" Ffts an entire sound, sets all bins to 0.0 whose energy is below squelch, then inverse ffts."
- snd chn #f frames { len }
- 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
- 0 fsize snd chn #f channel->vct { rdata }
- fsize 0.0 make-vct { idata }
- fsize 2/ { fsize2 }
- rdata idata 1 fft drop
- rdata vct-copy { vr }
- idata vct-copy { vi }
- vr vi rectangular->polar drop
- vr vct-peak { scaler }
- squelch scaler f* { scl-squelch }
- rdata 0 vct-ref dup f* idata 0 vct-ref dup f* f+ fsqrt scl-squelch f< if
- rdata 0 0.0 vct-set! drop
- idata 0 0.0 vct-set! drop
- then
- fsize 1- { jj }
- fsize 1 ?do
- rdata i vct-ref dup f* idata i vct-ref dup f* f+ fsqrt scl-squelch f< if
- rdata i 0.0 vct-set! drop
- rdata jj 0.0 vct-set! drop
- idata i 0.0 vct-set! drop
- idata jj 0.0 vct-set! drop
- then
- jj 1- to jj
- loop
- rdata idata -1 fft drop
- $" %s %s" #( squelch get-func-name ) string-format { origin }
- rdata fsize 1/f vct-scale! ( rdata) 0 len 1- snd chn #f origin vct->channel drop
- scaler
+ doc" Fft an entire sound, set all bins \
+to 0.0 whose energy is below squelch, then inverse fft."
+ snd chn #f framples { len }
+ 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
+ 0 fsize snd chn #f channel->vct { rdata }
+ fsize 0.0 make-vct { idata }
+ fsize 2/ { fsize2 }
+ rdata idata 1 fft drop
+ rdata vct-copy { vr }
+ idata vct-copy { vi }
+ vr vi rectangular->polar drop
+ vr vct-peak { scaler }
+ squelch scaler f* { scl-squelch }
+ rdata 0 vct-ref dup f*
+ idata 0 vct-ref dup f* f+ fsqrt scl-squelch f< if
+ rdata 0 0.0 vct-set! drop
+ idata 0 0.0 vct-set! drop
+ then
+ fsize 1- { jj }
+ fsize 1 ?do
+ rdata i vct-ref dup f*
+ idata i vct-ref dup f* f+ fsqrt scl-squelch f< if
+ rdata i 0.0 vct-set! drop
+ rdata jj 0.0 vct-set! drop
+ idata i 0.0 vct-set! drop
+ idata jj 0.0 vct-set! drop
+ then
+ jj 1- to jj
+ loop
+ rdata idata -1 fft drop
+ "%s %s" #( squelch get-func-name ) string-format { origin }
+ rdata fsize 1/f vct-scale! 0 len 1- snd chn #f origin vct->channel drop
+ scaler
;
+
: fft-cancel <{ lo-freq hi-freq :optional snd #f chn #f -- vct }>
- doc" Ffts an entire sound, sets the bin(s) representing LO-FREQ to HI-FREQ to 0.0, \
-then inverse ffts"
- snd srate { sr }
- snd chn #f frames { len }
- 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
- 0 fsize snd chn #f channel->vct { rdata }
- fsize 0.0 make-vct { idata }
- rdata idata 1 fft drop
- sr fsize f/ { hz-bin }
- lo-freq hz-bin f/ fround->s { lo-bin }
- hi-freq hz-bin f/ fround->s { hi-bin }
- fsize lo-bin - { jj }
- hi-bin 1+ lo-bin ?do
- rdata i 0.0 vct-set! drop
- rdata jj 0.0 vct-set! drop
- idata i 0.0 vct-set! drop
- idata jj 0.0 vct-set! drop
- jj 1- to jj
- loop
- rdata idata -1 fft drop
- $" %s %s %s" #( lo-freq hi-freq get-func-name ) string-format { origin }
- rdata fsize 1/f vct-scale! ( rdata) 0 len 1- snd chn #f origin vct->channel
+ doc" Fft an entire sound, set the bin(s) \
+representing LO-FREQ to HI-FREQ to 0, then inverse fft."
+ snd srate { sr }
+ snd chn #f framples { len }
+ 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
+ 0 fsize snd chn #f channel->vct { rdata }
+ fsize 0.0 make-vct { idata }
+ rdata idata 1 fft drop
+ sr fsize f/ { hz-bin }
+ lo-freq hz-bin f/ fround->s { lo-bin }
+ hi-freq hz-bin f/ fround->s { hi-bin }
+ fsize lo-bin - { jj }
+ hi-bin 1+ lo-bin ?do
+ rdata i 0.0 vct-set! drop
+ rdata jj 0.0 vct-set! drop
+ idata i 0.0 vct-set! drop
+ idata jj 0.0 vct-set! drop
+ jj 1- to jj
+ loop
+ rdata idata -1 fft drop
+ "%s %s %s" #( lo-freq hi-freq get-func-name ) string-format { origin }
+ rdata fsize 1/f vct-scale! 0 len 1- snd chn #f origin vct->channel
;
: make-ramp <{ :optional size 128 -- gen }>
- doc" Returns a ramp generator."
- vct( 0.0 size )
+ doc" Return ramp generator."
+ vct( 0.0 size )
;
+
: ramp <{ gen up -- val }>
- doc" Is a kind of CLM generator that produces a ramp of a given length, \
-then sticks at 0.0 or 1.0 until the UP argument changes."
- gen 0 vct-ref { ctr }
- gen 1 vct-ref { size }
- ctr size f/ { val }
- gen 0 ctr up if 1 else -1 then f+ 0 fmax size fmin vct-set! drop
- val
+ doc" Is a kind of CLM generator that produces a ramp of a \
+given length, then sticks at 0.0 or 1.0 until the UP argument changes."
+ gen 0 vct-ref { ctr }
+ gen 1 vct-ref { size }
+ ctr size f/ { val }
+ gen 0 ctr up if
+ 1
+ else
+ -1
+ then f+ 0 fmax size fmin vct-set! drop
+ val
;
hide
: squelch-vowels-cb { snd chn -- prc; y self -- val }
- 32 { fft-size }
- 0 snd chn 1 #f make-sampler { read-ahead }
- 1 proc-create { prc }
- fft-size 0.0 make-vct map! read-ahead #() apply end-map ( rl ) ,
- fft-size 0.0 make-vct ( im ) ,
- 256 make-ramp ( ramper ) ,
- snd chn #f maxamp fft-size f2/ f/ ( peak ) ,
- read-ahead ,
- #f ( in-vowel ) ,
- prc
- does> { y self -- val }
- self @ { rl }
- self cell+ @ { im }
- self 2 cells + @ { ramper }
- self 3 cells + @ { peak }
- self 4 cells + @ { read-ahead }
- self 5 cells + @ { in-vowel }
- rl read-ahead #() apply cycle-set!
- rl cycle-start@ 0= if
- rl im 1 fft drop
- rl rl vct-multiply! drop
- im im vct-multiply! drop
- rl im vct-add! drop
- rl 0 vct-ref rl 1 vct-ref f+ rl 2 vct-ref f+ rl 3 vct-ref f+ peak f> to in-vowel
- in-vowel self 5 cells + !
- im 0.0 vct-fill! drop
- then
- 1.0 ramper in-vowel ramp f- ( rval ) y f*
+ 32 { fft-size }
+ 0 snd chn 1 #f make-sampler { read-ahead }
+ 1 proc-create { prc }
+ fft-size 0.0 make-vct map!
+ read-ahead #() apply
+ end-map ( rl ) ,
+ fft-size 0.0 make-vct ( im ) ,
+ 256 make-ramp ( ramper ) ,
+ snd chn #f maxamp fft-size f2/ f/ ( peak ) ,
+ read-ahead ,
+ #f ( in-vowel ) ,
+ prc
+ does> { y self -- val }
+ self @ { rl }
+ self cell+ @ { im }
+ self 2 cells + @ { ramper }
+ self 3 cells + @ { peak }
+ self 4 cells + @ { read-ahead }
+ self 5 cells + @ { in-vowel }
+ rl read-ahead #() apply cycle-set!
+ rl cycle-start@ 0= if
+ rl im 1 fft ( rl ) dup vct-multiply! drop
+ im im vct-multiply! drop
+ rl im 0 vct-add! drop
+ rl 0 vct-ref
+ rl 1 vct-ref f+
+ rl 2 vct-ref f+
+ rl 3 vct-ref f+ peak f> to in-vowel
+ in-vowel self 5 cells + ! ( in-vowel )
+ im 0.0 vct-fill! drop
+ then
+ 1.0 ramper in-vowel ramp f- ( rval ) y f*
;
set-current
+
: squelch-vowels <{ :optional snd #f chn #f -- val }>
- doc" Suppresses portions of a sound that look like steady-state."
- snd chn squelch-vowels-cb 0 #f snd chn #f get-func-name map-channel
+ doc" Suppress portions of a sound that look like steady-state."
+ snd chn squelch-vowels-cb 0 #f snd chn #f get-func-name map-channel
;
previous
: fft-env-data <{ fft-env :optional snd #f chn #f -- vct }>
- doc" Applies FFT-ENV as spectral env to current sound, returning vct of new data."
- snd chn #f frames { len }
- 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
- 0 fsize snd chn #f channel->vct { rdata }
- fsize 0.0 make-vct { idata }
- fsize 2/ { fsize2 }
- :envelope fft-env :length fsize2 make-env { e }
- rdata idata 1 fft drop
- e env { val }
- rdata 0 val object-set*!
- idata 0 val object-set*!
- fsize 1- { jj }
- fsize2 1 ?do
- e env to val
- rdata i val object-set*!
- rdata jj val object-set*!
- idata i val object-set*!
- idata jj val object-set*!
- jj 1- to jj
- loop
- rdata idata -1 fft drop
- rdata fsize 1/f vct-scale!
+ doc" Apply FFT-ENV as spectral env to current sound, \
+returning vct of new data."
+ snd chn #f framples { len }
+ 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
+ 0 fsize snd chn #f channel->vct { rdata }
+ fsize 0.0 make-vct { idata }
+ fsize 2/ { fsize2 }
+ :envelope fft-env :length fsize2 make-env { e }
+ rdata idata 1 fft drop
+ e env { val }
+ rdata 0 val object-set*!
+ idata 0 val object-set*!
+ fsize 1- { jj }
+ fsize2 1 ?do
+ e env to val
+ rdata i val object-set*!
+ rdata jj val object-set*!
+ idata i val object-set*!
+ idata jj val object-set*!
+ jj 1- to jj
+ loop
+ rdata idata -1 fft ( rdata ) fsize 1/f vct-scale!
;
: fft-env-edit <{ fft-env :optional snd #f chn #f -- vct }>
- doc" Edits (filters) current chan using FFT-ENV."
- $" %s %s" #( fft-env get-func-name ) string-format { origin }
- fft-env snd chn fft-env-data 0 snd chn #f frames 1- snd chn #f origin vct->channel
+ doc" Edit (filter) current chan using FFT-ENV."
+ "%s %s" #( fft-env get-func-name ) string-format { origin }
+ fft-env snd chn fft-env-data 0 snd chn #f framples 1-
+ snd chn #f origin vct->channel
;
: fft-env-interp <{ env1 env2 interp :optional snd #f chn #f -- vct }>
- doc" Interpolates between two fft-filtered versions (ENV1 and ENV2 are the spectral envelopes) \
+ doc" Interpolate between two fft-filtered \
+versions (ENV1 and ENV2 are the spectral envelopes) \
following interp (an env between 0 and 1)."
- env1 snd chn fft-env-data { data1 }
- env2 snd chn fft-env-data { data2 }
- snd chn #f frames { len }
- :envelope interp :length len make-env { e }
- $" %s %s %s %s" #( env1 env2 interp get-func-name ) string-format { origin }
- len 0.0 make-vct map!
- e env { pan }
- 1.0 pan f- data1 i vct-ref f* data2 i vct-ref pan f* f+
- end-map ( new-data ) 0 len 1- snd chn #f origin vct->channel
+ env1 snd chn fft-env-data { data1 }
+ env2 snd chn fft-env-data { data2 }
+ snd chn #f framples { len }
+ :envelope interp :length len make-env { e }
+ "%s %s %s %s" #( env1 env2 interp get-func-name )
+ string-format { origin }
+ len 0.0 make-vct map!
+ e env { pan }
+ 1.0 pan f- data1 i vct-ref f* data2 i vct-ref pan f* f+
+ end-map ( new-data ) 0 len 1- snd chn #f origin vct->channel
;
: filter-fft <{ flt :optional normalize #t snd #f chn #f -- val }>
- doc" Gets the spectrum of all the data in the given channel, \
-applies the function FLT to it, then inverse ffts. \
+ doc" Get the spectrum of all the data in the given channel, \
+apply the function FLT to it, then inverse fft. \
FLT should take one argument, the current spectrum value.\n\
lambda: <{ y -- val }> y 0.01 f< if 0.0 else y then ; filter-fft\n\
is like fft-squelch."
- snd chn #f frames { len }
- snd chn #f maxamp { mx }
- 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
- fsize 2/ { fsize2 }
- 0 fsize snd chn #f channel->vct { rdata }
- fsize 0.0 make-vct { idata }
- rdata rectangular-window fsize #t 1.0 #f ( in-place == #f ) normalize snd-spectrum { spect }
- rdata idata 1 fft drop
- flt #( spect 0 vct-ref ) run-proc drop
- fsize 1- { jj }
- fsize2 1 ?do
- spect i vct-ref { orig }
- flt #( orig ) run-proc { cur }
- orig fabs 0.000001 f> if
- cur orig f/ { scl }
- rdata i scl object-set*!
- idata i scl object-set*!
- rdata jj scl object-set*!
- idata jj scl object-set*!
- else
- cur fabs 0.000001 f> if
- cur 2.0 fsqrt f/ { scl }
- rdata i scl vct-set! drop
- idata i scl vct-set! drop
- rdata jj scl vct-set! drop
- idata jj scl fnegate vct-set! drop
- then
- then
- jj 1- to jj
- loop
- rdata idata -1 fft drop
- $" <'> %s %s" #( flt get-func-name ) string-format { origin }
- mx f0<> if
- rdata vct-peak { pk }
- rdata mx pk f/ vct-scale!
- else
- rdata
- then 0 len 1- snd chn #f origin vct->channel
+ snd chn #f framples { len }
+ snd chn #f maxamp { mx }
+ 2.0 len flog 2.0 flog f/ fceil f** fround->s { fsize }
+ fsize 2/ { fsize2 }
+ 0 fsize snd chn #f channel->vct { rdata }
+ fsize 0.0 make-vct { idata }
+ rdata rectangular-window fsize #t 1.0
+ #f ( in-place == #f ) normalize snd-spectrum { spect }
+ rdata idata 1 fft drop
+ flt #( spect 0 vct-ref ) run-proc drop
+ fsize 1- { jj }
+ fsize2 1 ?do
+ spect i vct-ref { orig }
+ flt #( orig ) run-proc { cur }
+ orig fabs 0.000001 f> if
+ cur orig f/ { scl }
+ rdata i scl object-set*!
+ idata i scl object-set*!
+ rdata jj scl object-set*!
+ idata jj scl object-set*!
+ else
+ cur fabs 0.000001 f> if
+ cur 2.0 fsqrt f/ { scl }
+ rdata i scl vct-set! drop
+ idata i scl vct-set! drop
+ rdata jj scl vct-set! drop
+ idata jj scl fnegate vct-set! drop
+ then
+ then
+ jj 1- to jj
+ loop
+ rdata idata -1 fft drop
+ "<'> %s %s" #( flt get-func-name ) string-format { origin }
+ mx f0<> if
+ rdata vct-peak { pk }
+ rdata mx pk f/ vct-scale!
+ else
+ rdata
+ then 0 len 1- snd chn #f origin vct->channel
;
\ 0.5 0.5 make-one-zero filter-fft
\ 0.05 0.05 make-one-pole filter-fft
@@ -1031,189 +1186,215 @@ is like fft-squelch."
\ lambda: <{ y -- val }> y y f* y f* ; filter-fft
: fft-smoother <{ cutoff start samps :optional snd #f chn #f -- val }>
- doc" Uses fft-filtering to smooth a section:\n\
+ doc" Use fft-filtering to smooth a section:\n\
#f #f #f cursor value curs
-0.1 curs 400 #f #f fft-smoother curs 400 #f #f #f undef vct->channel"
- 2.0 samps 1+ flog 2.0 flog f/ fceil f** fround->s { fftpts }
- start fftpts snd chn #f channel->vct { rl }
- fftpts 0.0 make-vct { im }
- fftpts cutoff f* fround->s { top }
- rl 0 vct-ref { old0 }
- rl samps 1- vct-ref { old1 }
- rl vct-peak { oldmax }
- rl im 1 fft drop
- fftpts top ?do
- rl i 0.0 vct-set! drop
- im i 0.0 vct-set! drop
- loop
- rl im -1 fft drop
- rl fftpts 1/f vct-scale! drop
- rl vct-peak { newmax }
- newmax f0<> if
- oldmax newmax f/ 1.5 f> if rl oldmax newmax f/ vct-scale! drop then
- rl 0 vct-ref { new0 }
- rl samps 1- vct-ref { new1 }
- old0 new0 f- { offset0 }
- old1 new1 f- { offset1 }
- offset1 offset0 f= if 0.0 else offset1 offset0 f- samps f/ then { incr }
- offset0 { trend }
- samps 0 ?do
- rl i trend object-set+!
- trend incr f+ to trend
- loop
- then
- rl
+0.1 curs 400 #f #f fft-smoother curs 400 #f #f #f undef vct->channel."
+ 2.0 samps 1+ flog 2.0 flog f/ fceil f** fround->s { fftpts }
+ start fftpts snd chn #f channel->vct { rl }
+ fftpts 0.0 make-vct { im }
+ fftpts cutoff f* fround->s { top }
+ rl 0 vct-ref { old0 }
+ rl samps 1- vct-ref { old1 }
+ rl vct-peak { oldmax }
+ rl im 1 fft drop
+ fftpts top ?do
+ rl i 0.0 vct-set! drop
+ im i 0.0 vct-set! drop
+ loop
+ rl im -1 fft ( rl ) fftpts 1/f vct-scale! drop
+ rl vct-peak { newmax }
+ newmax f0<> if
+ oldmax newmax f/ 1.5 f> if
+ rl oldmax newmax f/ vct-scale! drop
+ then
+ rl 0 vct-ref { new0 }
+ rl samps 1- vct-ref { new1 }
+ old0 new0 f- { offset0 }
+ old1 new1 f- { offset1 }
+ offset1 offset0 f= if
+ 0.0
+ else
+ offset1 offset0 f- samps f/
+ then { incr }
+ offset0 { trend }
+ samps 0 ?do
+ rl i trend object-set+!
+ trend incr f+ to trend
+ loop
+ then
+ rl
;
\ ;;; -------- comb-filter
-: comb-filter ( scaler size -- prc; x self -- res )
- doc" Returns a comb-filter ready for map-channel etc: 0.8 32 comb-filter map-channel. \
+: comb-filter ( scaler size -- prc; x self -- val )
+ doc" Return comb-filter ready for map-channel etc: \
+0.8 32 comb-filter map-channel. \
If you're in a hurry use: 0.8 32 make-comb clm-channel instead."
- { scaler size }
- scaler size make-comb { gen }
- 1 proc-create gen ,
- does> ( x self -- res )
- { x self }
- self @ ( cmb ) x 0.0 comb
-;
-
-\ by using filters at harmonically related sizes, we can get chords:
-
-: comb-chord ( scaler size amp -- prc; x self -- res )
- doc" Returns a set of harmonically-related comb filters: 0.95 100 0.3 comb-chord map-channel"
- { scaler size amp }
- scaler size make-comb { c1 }
- scaler size 0.75 f* f>s make-comb { c2 }
- scaler size 1.2 f* f>s make-comb { c3 }
- 1 proc-create amp , c1 , c2 , c3 ,
- does> ( x self -- res )
- { x self }
- self @ { amp }
- self 1 cells + @ { c1 }
- self 2 cells + @ { c2 }
- self 3 cells + @ { c3 }
- c1 x 0.0 comb c2 x 0.0 comb c3 x 0.0 comb f+ f+ amp f*
+ { scaler size }
+ scaler size make-comb { gen }
+ 1 proc-create ( prc )
+ gen ,
+ does> { x self -- val }
+ self @ ( cmb ) x 0.0 comb
+;
+
+\ ;;; by using filters at harmonically related sizes, we can get chords:
+
+: comb-chord ( scaler size amp -- prc; x self -- val )
+ doc" Return set of harmonically-related comb \
+filters: 0.95 100 0.3 comb-chord map-channel."
+ { scaler size amp }
+ scaler size make-comb { c1 }
+ scaler size 0.75 f* f>s make-comb { c2 }
+ scaler size 1.2 f* f>s make-comb { c3 }
+ 1 proc-create ( prc )
+ amp , c1 , c2 , c3 ,
+ does> ( x self -- val )
+ { x self }
+ self @ { amp }
+ self 1 cells + @ { c1 }
+ self 2 cells + @ { c2 }
+ self 3 cells + @ { c3 }
+ c1 x 0.0 comb c2 x 0.0 comb c3 x 0.0 comb f+ f+ amp f*
;
\ ;;; or change the comb length via an envelope:
: zcomb ( scaler size pm -- prc; x self -- val )
- doc" Returns a comb filter whose length varies according to an envelope:\n\
-0.8 32 #( 0 0 1 10 ) zcomb map-channel "
- { scaler size pm }
- :size size :max-size pm 0.0 max-envelope 1.0 f+ size f+ fround->s make-comb { cmb }
- :envelope pm :length #f #f #f frames make-env { penv }
- 1 proc-create cmb , penv ,
- does> { x self -- val }
- self @ ( cmb ) x self cell+ @ ( penv ) env comb
+ doc" Return comb filter whose length varies according to an envelope:\n\
+0.8 32 #( 0 0 1 10 ) zcomb map-channel."
+ { scaler size pm }
+ :size size
+ :max-size pm 0.0 max-envelope 1.0 f+ size f+ fround->s
+ make-comb { gen }
+ :envelope pm :length #f #f #f framples make-env { penv }
+ 1 proc-create ( prc )
+ gen , penv ,
+ does> { x self -- val }
+ self @ ( gen ) x self cell+ @ ( penv ) env comb
;
: notch-filter ( scaler size -- prc; x self -- val )
- doc" Returns a notch-filter: 0.8 32 notch-filter map-channel"
- make-notch { gen }
- 1 proc-create gen ,
- does> { x self -- val }
- self @ ( cmd ) x 0.0 notch
+ doc" Return notch-filter: 0.8 32 notch-filter map-channel."
+ make-notch { gen }
+ 1 proc-create ( prc )
+ gen ,
+ does> { x self -- val }
+ self @ ( gen ) x 0.0 notch
;
: formant-filter ( radius frequency -- prc; x self -- val )
- doc" Returns a formant generator: 2400 0.99 formant-filter map-channel. \
-Faster is: 2400 0.99 make-formant filter-sound"
- make-formant { gen }
- 1 proc-create gen ,
- does> { x self -- val }
- self @ ( frm ) x formant
+ doc" Return formant generator: 2400 0.99 formant-filter map-channel. \
+Faster is: 2400 0.99 make-formant filter-sound."
+ make-formant { gen }
+ 1 proc-create ( prc )
+ gen ,
+ does> { x self -- val }
+ self @ ( gen ) x formant
;
: formants ( r1 f1 r2 f2 r3 f3 -- prc; x self -- val )
- doc" Returns 3 formant filters in parallel: 0.99 900 0.98 1800 0.99 2700 formants map-channel"
- { r1 f1 r2 f2 r3 f3 }
- f1 r1 make-formant { fr1 }
- f2 r2 make-formant { fr2 }
- f3 r3 make-formant { fr3 }
- 1 proc-create fr1 , fr2 , fr3 ,
- does> { x self -- val }
- self @ x formant
- self 1 cells + @ x formant f+
- self 2 cells + @ x formant f+
+ doc" Return 3 formant filters in \
+parallel: 0.99 900 0.98 1800 0.99 2700 formants map-channel."
+ { r1 f1 r2 f2 r3 f3 }
+ f1 r1 make-formant { fr1 }
+ f2 r2 make-formant { fr2 }
+ f3 r3 make-formant { fr3 }
+ 1 proc-create ( prc )
+ fr1 , fr2 , fr3 ,
+ does> { x self -- val }
+ self @ ( fr1 ) x formant
+ self 1 cells + @ ( fr2 ) x formant f+
+ self 2 cells + @ ( fr3 ) x formant f+
;
: moving-formant ( radius move -- prc; x self -- val )
- doc" Returns a time-varying (in frequency) formant filter:\n\
-0.99 #( 0 1200 1 2400 ) moving-formant map-channel"
- { radius move }
- move 1 array-ref radius make-formant { frm }
- :envelope move :length #f #f #f frames make-env { menv }
- 1 proc-create frm , menv ,
- does> { x self -- val }
- self @ ( frm ) x formant ( ret )
- self @ ( frm ) self cell+ @ ( menv ) env set-mus-frequency drop
- ( ret )
+ doc" Return time-varying (in frequency) formant filter:\n\
+0.99 #( 0 1200 1 2400 ) moving-formant map-channel."
+ { radius move }
+ move 1 array-ref radius make-formant { frm }
+ :envelope move :length #f #f #f framples make-env { menv }
+ 1 proc-create ( prc )
+ frm , menv ,
+ does> { x self -- val }
+ self @ ( frm ) x formant ( val )
+ self @ ( frm ) self cell+ @ ( menv ) env set-mus-frequency drop
+ ( val )
;
: osc-formants ( radius bases amounts freqs -- prc; x self -- val )
- doc" Returns a time-varying (in frequency) formant filter:\n\
-0.99 #( 0 1200 1 2400 ) moving-formant map-channel"
- { radius bases amounts freqs }
- bases vct-length { len }
- len make-array map! bases i vct-ref radius make-formant end-map { frms }
- len make-array map! freqs i vct-ref make-oscil end-map { oscs }
- 1 proc-create frms , amounts , oscs , bases ,
- does> { x self -- val }
- self @ { frms }
- self 1 cells + @ { amounts }
- self 2 cells + @ { oscs }
- self 3 cells + @ { bases }
- 0.0 ( val )
- frms each { frm }
- frm x formant f+ ( val += ... )
- frm bases i vct-ref
- amounts i vct-ref oscs i array-ref 0.0 0.0 oscil f* f+
- set-mus-frequency drop
- end-each
- ( val )
+ doc" Return time-varying (in frequency) formant filter:\n\
+0.99 #( 0 1200 1 2400 ) moving-formant map-channel."
+ { radius bases amounts freqs }
+ bases vct-length { len }
+ len make-array map!
+ bases i vct-ref radius make-formant
+ end-map { frms }
+ len make-array map!
+ freqs i vct-ref make-oscil
+ end-map { oscs }
+ 1 proc-create ( prc )
+ frms , amounts , oscs , bases ,
+ does> { x self -- val }
+ self @ { frms }
+ self 1 cells + @ { amounts }
+ self 2 cells + @ { oscs }
+ self 3 cells + @ { bases }
+ 0.0 ( val )
+ frms each { frm }
+ frm x formant f+ ( val += ... )
+ frm bases i vct-ref
+ amounts i vct-ref
+ oscs i array-ref 0.0 0.0 oscil f* f+ set-mus-frequency drop
+ end-each
+ ( val )
;
\ ;;; -------- echo
: echo ( scaler secs -- prc; y self -- val )
- doc" Returns an echo maker: 0.5 0.5 echo 0 44100 map-channel"
- { scaler secs }
- secs #f srate f* fround->s make-delay { del }
- 1 proc-create del , scaler , ( prc )
- does> { y self -- val }
- self @ { del }
- self cell+ @ { scaler }
- del del 0.0 tap y f+ scaler f* 0.0 delay y f+
+ doc" Return echo maker: 0.5 0.5 echo 0 44100 map-channel."
+ { scaler secs }
+ secs #f srate f* fround->s make-delay { del }
+ 1 proc-create ( prc )
+ del , scaler ,
+ does> { y self -- val }
+ self @ { del }
+ self cell+ @ { scaler }
+ del del 0.0 tap y f+ scaler f* 0.0 delay y f+
;
: zecho ( scaler secs freq amp -- prc; y self -- val )
- doc" Returns a modulated echo maker: 0.5 0.75 6 10.0 zecho 0 65000 map-channel"
- { scaler secs freq amp }
- freq make-oscil { os }
- secs #f srate f* fround->s { len }
- :size len :max-size len amp f+ fround->s 1+ make-delay { del }
- 1 proc-create del , scaler , os , amp , ( prc )
- does> { y self -- val }
- self @ { del }
- self cell+ @ { scaler }
- self 2 cells + @ { os }
- self 3 cells + @ { amp }
- del del 0.0 tap y f+ scaler f* os 0.0 0.0 oscil amp f* delay y f+
+ doc" Return modulated echo maker: \
+0.5 0.75 6 10.0 zecho 0 65000 map-channel."
+ { scaler secs freq amp }
+ freq make-oscil { os }
+ secs #f srate f* fround->s { len }
+ :size len :max-size len amp f+ fround->s 1+ make-delay { del }
+ 1 proc-create ( prc )
+ del , scaler , os , amp ,
+ does> { y self -- val }
+ self @ { del }
+ self cell+ @ { scaler }
+ self 2 cells + @ { os }
+ self 3 cells + @ { amp }
+ del del 0.0 tap y f+ scaler f* os 0.0 0.0 oscil amp f* delay y f+
;
: flecho ( scaler secs -- prc; y self -- val )
- doc" Returns a low-pass filtered echo maker: 0.5 0.9 flecho 0 75000 map-channel"
- { scaler secs }
- :order 4 :xcoeffs vct( 0.125 0.25 0.25 0.125 ) make-fir-filter { flt }
- secs #f srate f* fround->s make-delay { del }
- 1 proc-create del , scaler , flt , ( prc )
- does> { y self -- val }
- self @ { del }
- self cell+ @ { scaler }
- self 2 cells + @ { flt }
- del flt del 0.0 tap y f+ scaler f* fir-filter 0.0 delay y f+
+ doc" Return low-pass filtered echo maker: \
+0.5 0.9 flecho 0 75000 map-channel."
+ { scaler secs }
+ :order 4 :xcoeffs vct( 0.125 0.25 0.25 0.125 ) make-fir-filter { flt }
+ secs #f srate f* fround->s make-delay { del }
+ 1 proc-create ( prc )
+ del , scaler , flt ,
+ does> { y self -- val }
+ self @ { del }
+ self cell+ @ { scaler }
+ self 2 cells + @ { flt }
+ del flt del 0.0 tap y f+ scaler f* fir-filter 0.0 delay y f+
;
\ ;;; -------- ring-mod and am
@@ -1221,38 +1402,41 @@ Faster is: 2400 0.99 make-formant filter-sound"
\ ;;; CLM instrument is ring-modulate.ins
: ring-mod ( freq gliss-env -- prc; y self -- val )
- doc" Returns a time-varying ring-modulation filter:\n\
-10 #( 0 0 1 100 hz->radians ) ring-mod map-channel"
- { freq gliss-env }
- :frequency freq make-oscil { os }
- :envelope gliss-env :length #f #f #f frames make-env { genv }
- 1 proc-create os , genv , ( prc )
- does> { y self -- val }
- self @ { os }
- self cell+ @ { genv }
- os genv env 0.0 oscil y f*
+ doc" Return time-varying ring-modulation filter:\n\
+10 #( 0 0 1 100 hz->radians ) ring-mod map-channel."
+ { freq gliss-env }
+ :frequency freq make-oscil { os }
+ :envelope gliss-env :length #f #f #f framples make-env { genv }
+ 1 proc-create ( prc )
+ os , genv ,
+ does> { y self -- val }
+ self @ { os }
+ self cell+ @ { genv }
+ os genv env 0.0 oscil y f*
;
: am ( freq -- prc; y self -- val )
- doc" Returns an amplitude-modulator: 440 am map-channel"
- make-oscil { os }
- 1 proc-create os , ( prc )
- does> { y self -- val }
- 1.0 y self @ ( os ) 0.0 0.0 oscil amplitude-modulate
+ doc" Return amplitude-modulator: 440 am map-channel."
+ make-oscil { os }
+ 1 proc-create ( prc )
+ os ,
+ does> { y self -- val }
+ 1.0 y self @ ( os ) 0.0 0.0 oscil amplitude-modulate
;
\ ;;; this taken from sox (vibro.c)
: vibro ( speed depth -- prc; y self -- val )
- { speed depth }
- speed make-oscil { sine }
- depth f2/ { scl }
- 1.0 scl f- { offset }
- 1 proc-create sine , scl , offset , ( prc )
- does> { y self -- val }
- self @ { sine }
- self cell+ @ { scl }
- self 2 cells + @ { offset }
- sine 0.0 0.0 oscil scl f* offset f+ y f*
+ { speed depth }
+ speed make-oscil { sine }
+ depth f2/ { scl }
+ 1.0 scl f- { offset }
+ 1 proc-create ( prc )
+ sine , scl , offset ,
+ does> { y self -- val }
+ self @ { sine }
+ self cell+ @ { scl }
+ self 2 cells + @ { offset }
+ sine 0.0 0.0 oscil scl f* offset f+ y f*
;
\ ;;; -------- hello-dentist
@@ -1261,29 +1445,32 @@ Faster is: 2400 0.99 make-formant filter-sound"
hide
: hd-input-cb { in-data -- prc; dir self -- val }
- 1 proc-create { prc }
- in-data ,
- 0 ( idx ) ,
- prc
- does> { dir self -- val }
- self @ { in-data }
- self cell+ @ { idx }
- in-data idx object-range? if in-data idx vct-ref else 0.0 then ( val )
- idx dir + self cell+ !
- ( val )
+ 1 proc-create ( prc )
+ in-data , 0 ( idx ) ,
+ does> { dir self -- val }
+ self @ { in-data }
+ self cell+ @ { idx }
+ in-data idx object-range? if
+ in-data idx vct-ref
+ else
+ 0.0
+ then ( val )
+ idx dir + self cell+ ! ( idx )
+ ( val )
;
set-current
+
: hello-dentist <{ frq amp :optional snd #f chn #f -- vct }>
- doc" Varies the sampling rate randomly, making a voice sound quavery:\n\
-40.0 0.1 #f #f hello-dentist drop"
- :frequency frq :amplitude amp make-rand-interp { rn }
- snd chn #f frames { len }
- 0 len snd chn #f channel->vct { in-data }
- :srate 1.0 :input in-data hd-input-cb make-src { rd }
- $" %s %s %s" #( frq amp get-func-name ) string-format { origin }
- amp f2* 1.0 f+ len f* fround->s 0.0 make-vct map!
- rd rn 0.0 rand-interp #f src
- end-map ( out-data ) 0 len snd chn #f origin vct->channel
+ doc" Vary the sampling rate randomly, making a voice sound quavery:\n\
+40.0 0.1 #f #f hello-dentist drop."
+ :frequency frq :amplitude amp make-rand-interp { rn }
+ snd chn #f framples { len }
+ 0 len snd chn #f channel->vct { in-data }
+ :srate 1.0 :input in-data hd-input-cb make-src { rd }
+ "%s %s %s" #( frq amp get-func-name ) string-format { origin }
+ amp f2* 1.0 f+ len f* fround->s 0.0 make-vct map!
+ rd rn 0.0 rand-interp #f src
+ end-map ( out-data ) 0 len snd chn #f origin vct->channel
;
previous
@@ -1292,121 +1479,122 @@ previous
hide
: fp-input-cb { sf -- prc; dir self -- val }
- 1 proc-create sf ,
- does> { dir self -- val }
- self @ ( sf ) dir 0> if next-sample else previous-sample then
+ 1 proc-create ( prc )
+ sf ,
+ does> { dir self -- val }
+ self @ ( sf ) dir 0> if
+ next-sample
+ else
+ previous-sample
+ then
;
set-current
+
: fp <{ sr osamp osfrq :optional snd #f chn #f -- vct }>
- doc" Varies the sampling rate via an oscil: 1.0 0.3 20 #f #f fp"
- osfrq make-oscil { os }
- 0 snd chn 1 #f make-sampler { sf }
- :srate sr :input sf fp-input-cb make-src { s }
- snd chn #f frames { len }
- $" %s %s %s %s" #( sr osamp osfrq get-func-name ) string-format { origin }
- len 0.0 make-vct map!
- s os 0.0 0.0 oscil osamp f* #f src
- end-map ( out-data ) 0 len snd chn #f origin vct->channel
- sf free-sampler drop
+ doc" Vary the sampling rate via an oscil: 1.0 0.3 20 #f #f fp."
+ osfrq make-oscil { os }
+ 0 snd chn 1 #f make-sampler { sf }
+ :srate sr :input sf fp-input-cb make-src { s }
+ snd chn #f framples { len }
+ "%s %s %s %s" #( sr osamp osfrq get-func-name ) string-format { origin }
+ len 0.0 make-vct map!
+ s os 0.0 0.0 oscil osamp f* #f src
+ end-map ( out-data ) 0 len snd chn #f origin vct->channel ( vct )
+ sf free-sampler drop
;
previous
-\ ;;; -------- compand, compand-channel
-
-: compand <{ -- prc; y self -- val }>
- doc" Returns a compander: compand map-channel"
- 1 proc-create { prc }
- vct( -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
- 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000 ) ,
- prc
- does> { inval self -- val }
- self @ ( tbl ) inval 8.0 f* 8.0 f+ ( index ) 17 array-interp
-;
-
-: compand-channel <{ :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Applies a standard compander to sound."
- compand beg dur snd chn edpos #t #f $" %s %s %s" #( beg dur get-func-name ) format ptree-channel
-;
+vct( -1.000 -0.960 -0.900 -0.820
+ -0.720 -0.600 -0.450 -0.250
+ 0.000 0.250 0.450 0.600
+ 0.720 0.820 0.900 0.960 1.000 ) constant compand-table
-: compand-sound <{ :optional beg 0 dur #f snd #f -- }>
- doc" Applies companding to every channel of SND."
- snd snd-snd to snd
- snd sound? if
- snd channels 0 ?do
- beg dur snd i ( chn ) #f compand-channel drop
- loop
- else
- 'no-such-sound #( get-func-name snd ) fth-throw
- then
+: compand ( -- prc; y self -- val )
+ doc" Return compander: compand map-channel."
+ 1 proc-create ( prc )
+ does> { y self -- val }
+ compand-table y 8.0 f* 8.0 f+ compand-table vct-length array-interp
;
\ ;;; -------- shift pitch keeping duration constant
\ ;;;
-\ ;;; both src and granulate take a function argument to get input whenever it is needed.
-\ ;;; in this case, src calls granulate which reads the currently selected file.
-\ ;;; CLM version is in expsrc.ins
+\ ;;; both src and granulate take a function argument to get input
+\ ;;; whenever it is needed.
+\ ;;; In this case, src calls granulate which reads the currently
+\ ;;; selected file. CLM version is in expsrc.ins
hide
: expgr-cb { v snd chn -- prc; dir self -- val }
- 1 proc-create v , snd , chn , 0 , ( prc )
- does> { dir self -- val }
- self @ { v }
- v cycle-ref ( val )
- v cycle-start@ 0= if
- self cell+ @ { snd }
- self 2 cells + @ { chn }
- self 3 cells + @ { vbeg }
- vbeg v vct-length + dup self 3 cells + ! ( vbeg += v-len )
- vbeg v vct-length snd chn #f channel->vct drop
- then
- ( val )
+ 1 proc-create ( prc )
+ v , snd , chn , 0 ,
+ does> { dir self -- val }
+ self @ { v }
+ v cycle-ref ( val )
+ v cycle-start@ 0= if
+ self cell+ @ { snd }
+ self 2 cells + @ { chn }
+ self 3 cells + @ { vbeg }
+ vbeg v vct-length + dup self 3 cells + ! ( vbeg += v-len )
+ vbeg v vct-length snd chn #f channel->vct drop
+ then
+ ( val )
;
+
: expsr-cb { gr -- prc; dir self -- val }
- 1 proc-create gr , ( prc )
- does> { dir self -- val }
- self @ ( gr ) #f #f granulate
+ 1 proc-create ( prc )
+ gr ,
+ does> { dir self -- val }
+ self @ ( gr ) #f #f granulate
;
set-current
+
: expsrc <{ rate :optional snd #f chn #f -- val }>
- doc" Uses sampling-rate conversion and granular synthesis to produce a sound \
-at a new pitch but at the original tempo. \
+ doc" Use sampling-rate conversion and granular synthesis to \
+produce a sound at a new pitch but at the original tempo. \
It returns a function for map-channel."
- 0 1024 snd chn #f channel->vct { v }
- :input v snd chn expgr-cb :expansion rate make-granulate { gr }
- :input gr expsr-cb :srate rate make-src { sr }
- 1 proc-create sr , ( prc )
- does> { y self -- val }
- self @ ( sr ) 0.0 #f src
+ 0 1024 snd chn #f channel->vct { v }
+ :input v snd chn expgr-cb :expansion rate make-granulate { gr }
+ :input gr expsr-cb :srate rate make-src { sr }
+ 1 proc-create ( prc )
+ sr ,
+ does> { y self -- val }
+ self @ ( sr ) 0.0 #f src
;
previous
-\ ;;; the next (expsnd) changes the tempo according to an envelope; the new duration
-\ ;;; will depend on the expansion envelope -- we integrate it to get
+\ ;;; the next (expsnd) changes the tempo according to an envelope; the new
+\ ;;; duration will depend on the expansion envelope -- we integrate it to get
\ ;;; the overall expansion, then use that to decide the new length.
hide
: es-input-cb { sf -- prc; dir self -- val }
- 1 proc-create sf ,
- does> { dir self -- val }
- self @ ( sf ) next-sample
+ 1 proc-create ( prc )
+ sf ,
+ does> { dir self -- val }
+ self @ ( sf ) next-sample
;
set-current
+
: expsnd <{ gr-env :optional snd #f chn #f -- vct }>
- doc" Uses the granulate generator to change tempo according to an envelope:\n\
-#( 0 0.5 2 2.0 ) #f #f expsnd"
- snd chn #f frames { len }
- len snd srate f/ gr-env integrate-envelope f* gr-env envelope-last-x f/ { dur }
- 0 snd chn 1 #f make-sampler { sf }
- :expansion gr-env 1 array-ref :jitter 0 :input sf es-input-cb make-granulate { gr }
- :envelope gr-env :duration dur make-env { ge }
- snd srate dur f* fround->s { sound-len }
- sound-len len max to len
- $" %s %s" #( gr-env get-func-name ) string-format { origin }
- len 0.0 make-vct map!
- gr #f granulate ( val )
- gr ge env set-mus-increment drop
- end-map ( out-data ) 0 len snd chn #f origin vct->channel
- sf free-sampler drop
+ doc" Use the granulate generator to change tempo \
+according to an envelope:\n\
+#( 0 0.5 2 2.0 ) #f #f expsnd."
+ snd chn #f framples { len }
+ len snd srate f/ gr-env integrate-envelope f*
+ gr-env envelope-last-x f/ { dur }
+ 0 snd chn 1 #f make-sampler { sf }
+ :expansion gr-env 1 array-ref
+ :jitter 0
+ :input sf es-input-cb make-granulate { gr }
+ :envelope gr-env :duration dur make-env { ge }
+ snd srate dur f* fround->s { sound-len }
+ sound-len len max to len
+ "%s %s" #( gr-env get-func-name ) string-format { origin }
+ len 0.0 make-vct map!
+ gr #f granulate ( val )
+ gr ge env set-mus-increment drop
+ end-map ( out-data ) 0 len snd chn #f origin vct->channel ( vct )
+ sf free-sampler drop
;
previous
@@ -1415,92 +1603,117 @@ previous
\ ;;; CLM version is in sndclm.html
: cross-synthesis ( cross-snd amp fftsize r -- prc; y self -- val )
- doc" Does cross-synthesis between CROSS-SND (a sound index) and the currently selected sound:\n\
-1 0.5 128 6.0 cross-synthesis map-channel"
- { cross-snd amp fftsize r }
- fftsize 2/ { freq-inc }
- fftsize 0.0 make-vct { fdr }
- fftsize 0.0 make-vct { fdi }
- freq-inc 0.0 make-vct { spectr }
- 1.0 r fftsize f/ f- { radius }
- #f srate fftsize / { bin }
- freq-inc make-array map! i bin * radius make-formant end-map { formants }
- 1 proc-create fdr , fdi , spectr , formants , amp , freq-inc , cross-snd , fftsize , 0 , ( prc )
- does> { y self -- val }
- self @ { fdr }
- self cell+ @ { fdi }
- self 2 cells + @ { spectr }
- self 3 cells + @ { formants }
- self 4 cells + @ { amp }
- self 5 cells + @ { ctr }
- ctr formants length = if
- self 6 cells + @ { cross-snd }
- self 7 cells + @ { fftsize }
- self 8 cells + @ { inctr }
- inctr fftsize cross-snd 0 #f channel->vct dup self ! to fdr
- inctr fftsize 2/ + self 8 cells + ! ( inctr += freq-inc )
- fdr fdi #f 2 spectrum ( fdr ) spectr vct-subtract! ( fdr ) fftsize 2/ 1/f vct-scale! drop
- 0 self 5 cells + ! ( ctr = 0 )
- then
- 1 self 5 cells + +! ( ctr++ )
- formants cycle-ref drop
- spectr fdr vct-add! ( spectr ) formants y formant-bank amp f*
+ doc" Do cross-synthesis between CROSS-SND (a sound index) \
+and the currently selected sound:\n\
+1 0.5 128 6.0 cross-synthesis map-channel."
+ { cross-snd amp fftsize r }
+ fftsize 2/ { freq-inc }
+ fftsize 0.0 make-vct { fdr }
+ fftsize 0.0 make-vct { fdi }
+ freq-inc 0.0 make-vct { spectr }
+ 1.0 r fftsize f/ f- { radius }
+ #f srate fftsize / { bin }
+ freq-inc make-array map!
+ i bin * radius make-formant
+ end-map spectr make-formant-bank { formants }
+ 1 proc-create ( prc )
+ fdr , fdi , spectr , formants ,
+ amp , freq-inc , cross-snd , fftsize , 0 ,
+ does> { y self -- val }
+ self @ { fdr }
+ self cell+ @ { fdi }
+ self 2 cells + @ { spectr }
+ self 3 cells + @ { formants }
+ self 4 cells + @ { amp }
+ self 5 cells + @ { ctr }
+ ctr formants length = if
+ self 6 cells + @ { cross-snd }
+ self 7 cells + @ { fftsize }
+ self 8 cells + @ { inctr }
+ inctr fftsize cross-snd 0 #f channel->vct dup self ! to fdr
+ inctr fftsize 2/ + self 8 cells + ! ( inctr += freq-inc )
+ fdr fdi #f 2 spectrum ( fdr )
+ spectr vct-subtract! ( fdr ) fftsize 2/ 1/f
+ vct-scale! drop
+ 0 self 5 cells + ! ( ctr = 0 )
+ then
+ 1 self 5 cells + +! ( ctr++ )
+ spectr fdr 0 vct-add! drop
+ formants y formant-bank amp f*
;
: voiced->unvoiced <{ amp fftsize r tempo :optional snd #f chn #f -- vct }>
- doc" Turns a vocal sound into whispering: 1.0 256 2.0 2.0 #f #f voiced->unvoiced"
- fftsize 2/ { freq-inc }
- nil { fdr }
- fftsize 0.0 make-vct { fdi }
- freq-inc 0.0 make-vct { spectr }
- snd srate 3.0 f/ make-rand { noi }
- 0 { inctr }
- 1.0 r fftsize f/ f- { radius }
- snd srate fftsize / { bin }
- snd chn #f frames { len }
- len tempo f/ fround->s len max { out-len }
- freq-inc tempo f* fround->s { hop }
- 0.0 0.0 { old-peak-amp new-peak-amp }
- $" %s %s %s %s %s" #( amp fftsize r tempo get-func-name ) string-format { origin }
- freq-inc make-array map! i bin * radius make-formant end-map { formants }
- out-len 0.0 make-vct map!
- i freq-inc mod 0= if
- inctr fftsize snd chn #f channel->vct to fdr
- fdr vct-peak old-peak-amp fmax to old-peak-amp
- fdr fdi #f 2 spectrum ( fdr ) spectr vct-subtract! ( fdr ) freq-inc 1/f vct-scale! drop
- hop inctr + to inctr
- then
- spectr fdr vct? if fdr vct-add! then formants noi 0.0 rand formant-bank ( outval )
- dup fabs new-peak-amp fmax to new-peak-amp
- ( outval )
- end-map old-peak-amp new-peak-amp f/ amp f* vct-scale! 0 out-len snd chn #f origin vct->channel
-;
-
-: pulse-voice <{ cosines :optional freq 440.0 amp 1.0 fftsize 256 r 2.0 snd #f chn #f -- vct }>
- doc" Uses sum-of-cosines to manipulate speech sounds."
- fftsize 2/ { freq-inc }
- fftsize 0.0 make-vct { fdr }
- fftsize 0.0 make-vct { fdi }
- freq-inc 0.0 make-vct { spectr }
- :cosines cosines :frequency freq make-sum-of-cosines { pulse }
- 0 { inctr }
- 1.0 r fftsize f/ f- { radius }
- snd srate fftsize / { bin }
- snd chn #f frames { len }
- 0.0 0.0 { old-peak-amp new-peak-amp }
- $" %s %s %s %s %s %s" #( cosines freq amp fftsize r get-func-name ) string-format { origin }
- freq-inc make-array map! i bin * radius make-formant end-map { formants }
- len 0.0 make-vct map!
- i freq-inc mod 0= if
- inctr fftsize snd chn #f channel->vct to fdr
- fdr vct-peak old-peak-amp fmax to old-peak-amp
- fdr fdi #f 2 spectrum ( fdr ) spectr vct-subtract! ( fdr ) freq-inc 1/f vct-scale! drop
- freq-inc inctr + to inctr
- then
- spectr fdr vct-add! ( spectr ) formants pulse 0.0 sum-of-cosines formant-bank ( outval )
- dup fabs new-peak-amp fmax to new-peak-amp
- ( outval )
- end-map old-peak-amp new-peak-amp f/ amp f* vct-scale! 0 len snd chn #f origin vct->channel
+ doc" Turn vocal sound into \
+whispering: 1.0 256 2.0 2.0 #f #f voiced->unvoiced."
+ fftsize 2/ { freq-inc }
+ nil { fdr }
+ fftsize 0.0 make-vct { fdi }
+ freq-inc 0.0 make-vct { spectr }
+ snd srate 3.0 f/ make-rand { noi }
+ 0 { inctr }
+ 1.0 r fftsize f/ f- { radius }
+ snd srate fftsize / { bin }
+ snd chn #f framples { len }
+ len tempo f/ fround->s len max { out-len }
+ freq-inc tempo f* fround->s { hop }
+ 0.0 0.0 { old-peak-amp new-peak-amp }
+ "%s %s %s %s %s"
+ #( amp fftsize r tempo get-func-name ) string-format { origin }
+ freq-inc make-array map!
+ i bin * radius make-formant
+ end-map ( formants ) spectr make-formant-bank { formants }
+ freq-inc 1/f { 1/freq-inc }
+
+ out-len 0.0 make-vct map!
+ i freq-inc mod 0= if
+ inctr fftsize snd chn #f channel->vct to fdr
+ fdr vct-peak old-peak-amp fmax to old-peak-amp
+ fdr fdi #f 2 spectrum ( fdr )
+ spectr vct-subtract! ( fdr )
+ 1/freq-inc vct-scale! drop
+ hop inctr + to inctr
+ then
+ spectr fdr 0 vct-add! drop
+ formants noi 0.0 rand formant-bank ( outval )
+ end-map { out-data }
+ out-data old-peak-amp out-data vct-peak f/ amp f* vct-scale! ( odata )
+ 0 out-len snd chn #f origin vct->channel ( odata )
+;
+
+: pulse-voice
+ <{ co :optional freq 440.0 amp 1.0 fftsize 256 r 2.0 snd #f chn #f -- vct }>
+ doc" Use sum-of-cosines to manipulate speech sounds."
+ fftsize 2/ { freq-inc }
+ fftsize 0.0 make-vct { fdr }
+ fftsize 0.0 make-vct { fdi }
+ freq-inc 0.0 make-vct { spectr }
+ :cosines co :frequency freq make-sum-of-cosines { pulse }
+ 0 { inctr }
+ 1.0 r fftsize f/ f- { radius }
+ snd srate fftsize / { bin }
+ snd chn #f framples { len }
+ 0.0 0.0 { old-peak-amp new-peak-amp }
+ "%s %s %s %s %s %s"
+ #( co freq amp fftsize r get-func-name ) string-format { origin }
+ freq-inc make-array map!
+ i bin * radius make-formant
+ end-map spectr make-formant-bank { formants }
+ len 0.0 make-vct map!
+ i freq-inc mod 0= if
+ inctr fftsize snd chn #f channel->vct to fdr
+ fdr vct-peak old-peak-amp fmax to old-peak-amp
+ fdr fdi #f 2 spectrum ( fdr )
+ spectr vct-subtract! ( fdr )
+ freq-inc 1/f vct-scale! drop
+ freq-inc inctr + to inctr
+ then
+ spectr fdr 0 vct-add! drop
+ formants pulse 0.0 sum-of-cosines formant-bank ( outval )
+ dup fabs new-peak-amp fmax to new-peak-amp
+ ( outval )
+ end-map
+ old-peak-amp new-peak-amp f/ amp f* vct-scale!
+ 0 len snd chn #f origin vct->channel ( vct )
;
\ 20.0 1.0 1024 0.01 pulse-voice
\ 120.0 1.0 1024 0.2 pulse-voice
@@ -1509,200 +1722,175 @@ previous
\ 1000.0 1.0 512 pulse-voice
'snd-nogui provided? [unless]
- \ ;;; -------- convolution example
-
- hide
- : cnv-cb { sf -- prc; dir self -- val }
- 1 proc-create sf , ( prc )
- does> { dir self -- val }
- self @ ( sf ) next-sample
- ;
- set-current
- : cnvtest ( snd0 snd1 amp -- mx )
- doc" Convolves SND0 and SND1, scaling by AMP, returns new max amp: 0 1 0.1 cnvtest"
- { snd0 snd1 amp }
- snd0 #f #f frames { flt-len }
- snd1 #f #f frames flt-len + { total-len }
- 0 snd1 0 1 #f make-sampler { sf }
- :input sf cnv-cb :filter 0 flt-len snd0 #f #f channel->vct make-convolve { cnv }
- total-len 0.0 make-vct map! cnv #f convolve end-map amp vct-scale! ( out-data )
- 0 total-len snd1 #f #f get-func-name vct->channel vct-peak { max-samp }
- sf free-sampler drop
- max-samp 1.0 f> if #( max-samp fnegate max-samp ) snd1 #f set-y-bounds drop then
- max-samp
- ;
- previous
+ \ ;;; -------- convolution example
+
+ hide
+ : cnv-cb { sf -- prc; dir self -- val }
+ 1 proc-create ( prc )
+ sf ,
+ does> { dir self -- val }
+ self @ ( sf ) next-sample
+ ;
+ set-current
+
+ : cnvtest ( snd0 snd1 amp -- mx )
+ doc" Convolve SND0 and SND1, scaling by AMP, \
+returns new max amp: 0 1 0.1 cnvtest."
+ { snd0 snd1 amp }
+ snd0 #f #f framples { flt-len }
+ snd1 #f #f framples flt-len + { total-len }
+ 0 snd1 0 1 #f make-sampler { sf }
+ :input sf cnv-cb :filter 0 flt-len
+ snd0 #f #f channel->vct make-convolve { cnv }
+ total-len 0.0 make-vct map!
+ cnv #f convolve
+ end-map amp vct-scale! ( out-data )
+ 0 total-len snd1 #f #f get-func-name
+ vct->channel vct-peak { max-samp }
+ sf free-sampler drop
+ max-samp 1.0 f> if
+ #( max-samp fnegate max-samp ) snd1 #f set-y-bounds drop
+ then
+ max-samp
+ ;
+ previous
[then]
\ ;;; -------- swap selection chans
: swap-selection-channels ( -- )
- doc" Swaps the currently selected data's channels."
- undef selection? if
- selection-chans 2 = if
- selection-position { beg }
- selection-frames { len }
- #f { snd-chn0 }
- #f { snd-chn1 }
- all-chans each { lst }
- lst 0 array-ref lst 1 array-ref selection-member? if
- snd-chn0 false? if
- lst to snd-chn0
- else
- snd-chn1 false? if
- lst to snd-chn1
- leave
- then
- then
+ doc" Swap the currently selected data's channels."
+ undef selection? unless
+ 'no-active-selection #( get-func-name ) fth-throw
+ then
+ selection-chans 2 = if
+ selection-position { beg }
+ selection-framples { len }
+ #f { snd-chn0 }
+ #f { snd-chn1 }
+ all-chans each { lst }
+ lst car lst cadr selection-member? if
+ snd-chn0 false? if
+ lst to snd-chn0
+ else
+ snd-chn1 false? if
+ lst to snd-chn1
+ leave
+ then
+ then
+ then
+ end-each
+ snd-chn1 if
+ snd-chn0 car snd-chn0 cadr snd-chn1 car snd-chn1 cadr
+ beg len #f #f swap-channels drop
+ else
+ 'wrong-number-of-channels
+ #( "%s: needs two channels to swap"
+ get-func-name ) fth-throw
+ then
+ else
+ 'wrong-number-of-channels
+ #( "%s: needs a stereo selection (not %s chans)"
+ get-func-name
+ selection-chans ) fth-throw
then
- end-each
- snd-chn1 if
- snd-chn0 0 array-ref
- snd-chn0 1 array-ref
- snd-chn1 0 array-ref
- snd-chn1 1 array-ref
- beg len #f #f swap-channels drop
- else
- 'wrong-number-of-channels #( get-func-name $" needs two channels to swap" ) fth-throw
- then
- else
- 'wrong-number-of-channels
- #( get-func-name $" needs a stereo selection (not %s chans)" selection-chans ) fth-throw
- then
- else
- 'no-active-selection #( get-func-name ) fth-throw
- then
;
\ ;;; -------- sound interp
\ ;;;
-\ ;;; make-sound-interp sets up a sound reader that reads a channel at an arbitary location,
-\ ;;; interpolating between samples if necessary, the corresponding "generator" is sound-interp
+\ ;;; make-sound-interp sets up a sound reader that reads a channel at an
+\ ;;; arbitary location, interpolating between samples if necessary,
+\ ;;; the corresponding "generator" is sound-interp
: make-sound-interp <{ start :optional snd #f chn #f -- prc; loc self -- val }>
- doc" Return an interpolating reader for SND's channel CHN."
- 2048 { bufsize }
- 1 proc-create { prc }
- start bufsize snd chn #f channel->vct ( data ) ,
- start ( curbeg ) ,
- start bufsize + ( curend ) ,
- snd ( snd ) ,
- chn ( chn ) ,
- prc
- does> { loc self -- val }
- self @ { data }
- self cell+ @ { curbeg }
- self 2 cells + @ { curend }
- self 3 cells + @ { snd }
- self 4 cells + @ { chn }
- 2048 { bufsize }
- 128 { buf4size }
- loc fround->s to loc
- loc curbeg < if
- \ get previous buffer
- loc bufsize - buf4size + 0 max to curbeg
- curbeg bufsize + to curend
- curbeg bufsize snd chn #f channel->vct to data
- else
- loc curend > if
- \ get next buffer
- loc buf4size - 0 max to curbeg
- curbeg bufsize + to curend
- curbeg bufsize snd chn #f channel->vct to data
- then
- then
- data self !
- curbeg self cell+ !
- curend self 2 cells + !
- data loc curbeg - bufsize array-interp
+ doc" Return an interpolating reader for SND's channel CHN."
+ 0 #f snd chn #f channel->vct { data }
+ 1 proc-create ( prc )
+ data , data vct-length ,
+ does> { loc self -- val }
+ self @ ( data ) loc self cell+ @ ( size ) array-interp
;
: sound-interp { func loc -- val }
- doc" Return sample at LOC (interpolated if necessary) from FUNC created by make-sound-interp."
- loc func execute
-;
-
-\ ;; env-sound-interp takes an envelope that goes between 0 and 1 (y-axis), and a time-scaler
-\ ;; (1.0 = original length) and returns a new version of the data in the specified channel
-\ ;; that follows that envelope (that is, when the envelope is 0 we get sample 0, when the
-\ ;; envelope is 1 we get the last sample, envelope = .5 we get the middle sample of the
-\ ;; sound and so on. (env-sound-interp #(0 0 1 1)) will return a copy of the
-\ ;; current sound; (env-sound-interp #(0 0 1 1 2 0) 2.0) will return a new sound
-\ ;; with the sound copied first in normal order, then reversed. src-sound with an
-\ ;; envelope could be used for this effect, but it is much more direct to apply the
-\ ;; envelope to sound sample positions.
-
-: env-sound-interp <{ envelope :optional time-scale 1.0 snd #f chn #f -- file-name }>
- doc" Reads SND's channel CHN according to ENVELOPE and TIME-SCALE."
- snd chn #f frames { len }
- time-scale len f* fround->s { newlen }
- 0 snd chn make-sound-interp { reader }
- :envelope envelope :length newlen :scaler len make-env { read-env }
- snd-tempnam { tempfilename }
- tempfilename snd srate 1 #f mus-next get-func-name mus-sound-open-output { fil }
- 8192 { bufsize }
- 1 bufsize make-sound-data { data }
- newlen 0 ?do
- bufsize 0 do data 0 i reader read-env env sound-interp sound-data-set! drop loop
- fil 0 bufsize 1- 1 data mus-sound-write drop
- bufsize +loop
- newlen bufsize mod ?dup-if fil 0 rot 1- 1 data mus-sound-write drop then
- fil newlen 4 * mus-sound-close-output drop
- $" %s %s %s" #( envelope time-scale get-func-name ) string-format { origin }
- 0 newlen tempfilename snd chn #t ( truncate ) origin set-samples ( file-name )
- tempfilename file-delete
-;
-
-: granulated-sound-interp <{ envelope
- :optional time-scale 1.0 grain-length 0.1 grain-envelope #( 0 0 1 1 2 1 3 0 ) output-hop 0.05
- snd #f chn #f -- file-name }>
- snd chn #f frames { len }
- time-scale len f* fround->s { newlen }
- :envelope envelope :length newlen :scaler len make-env { read-env }
- snd-tempnam { tempfilename }
- \ ;; #f as data-format -> format compatible with sndlib (so no data translation is needed)
- tempfilename snd srate 1 #f mus-next get-func-name mus-sound-open-output { fil }
- grain-length snd srate f* fround->s { grain-frames }
- output-hop snd srate f* fround->s { hop-frames }
- grain-length output-hop f/ fround->s 1+ { num-reader }
- num-reader make-array { readers }
- num-reader make-array map!
- :envelope grain-envelope :length grain-frames make-env
- end-map { grain-envs }
- 0 { next-reader-start-at }
- 8192 { bufsize }
- 1 bufsize make-sound-data { data }
- 0 { data-ctr }
- snd srate 0.005 f* { jitter }
- newlen 0 ?do
- bufsize 0 do
- read-env env { position-in-original }
- j next-reader-start-at >= if
- readers cycle-start@ { next-reader }
- readers
- position-in-original jitter mus-random f+ fround->s 0 max snd chn 1 #f make-sampler
- cycle-set!
- grain-envs next-reader array-ref mus-reset drop
- hop-frames next-reader-start-at + to next-reader-start-at
- then
- 0.0 ( sum )
- readers each { rd }
- rd sampler? if
- grain-envs i array-ref env rd next-sample f* f+ ( sum += ... )
+ doc" Return sample at LOC (interpolated if necessary) \
+from FUNC created by make-sound-interp."
+ loc func execute
+;
+
+\ ;; env-sound-interp takes an envelope that goes between 0 and 1
+\ ;; (y-axis), and a time-scaler (1.0 = original length) and returns a
+\ ;; new version of the data in the specified channel that follows that
+\ ;; envelope (that is, when the envelope is 0 we get sample 0, when the
+\ ;; envelope is 1 we get the last sample, envelope = .5 we get the middle
+\ ;; sample of the sound and so on. (env-sound-interp #(0 0 1 1)) will
+\ ;; return a copy of the current sound; (env-sound-interp #(0 0 1 1 2 0)
+\ ;; 2.0) will return a new sound with the sound copied first in normal
+\ ;; order, then reversed. src-sound with an envelope could be used
+\ ;; for this effect, but it is much more direct to apply the envelope
+\ ;; to sound sample positions.
+
+: env-sound-interp <{ en :optional time-scale 1.0 snd #f chn #f -- vct }>
+ doc" Read SND's channel CHN according to EN and TIME-SCALE."
+ snd chn #f framples { len }
+ time-scale len f* fround->s { newlen }
+ :envelope en :length newlen 1+ :scaler len make-env { read-env }
+ 0 #f snd chn #f channel->vct { data }
+ newlen 0.0 make-vct map!
+ data read-env env len array-interp
+ end-map { new-snd }
+ "%s %s %s" #( en time-scale get-func-name ) string-format { origin }
+ 0 newlen new-snd snd chn #t origin
+ 0 current-edit-position #t set-samples ( vct )
+;
+\ #( 0 0 1 1 2 0 ) 2.0 env-sound-interp
+
+: granulated-sound-interp
+ <{ en :optional tscl 1.0 grlen 0.1 gren #f ohop 0.05 snd #f chn #f -- vct }>
+ doc" Read the given channel following EN (as env-sound-interp), \
+using grains to create the re-tempo'd read."
+ gren empty? if
+ #( 0 0 1 1 2 1 3 0 ) to gren
then
- end-each { sum }
- data 0 i sum sound-data-set! drop
- loop
- fil 0 bufsize 1- 1 data mus-sound-write drop
- bufsize +loop
- newlen bufsize mod ?dup-if fil 0 rot 1- 1 data mus-sound-write drop then
- fil newlen 4 * mus-sound-close-output drop
- $" %s %s %s %s %s %s"
- #( envelope time-scale grain-length grain-envelope output-hop get-func-name )
- string-format { origin }
- 0 newlen tempfilename snd chn #t ( truncate ) origin set-samples ( file-name )
- tempfilename file-delete
+ snd chn #f framples { len }
+ tscl len f* fround->s { newlen }
+ :envelope en :length newlen :scaler len make-env { read-env }
+ snd srate { sr }
+ grlen sr f* fround->s { grain-framples }
+ ohop sr f* fround->s { hop-framples }
+ grlen ohop f/ fceil->s { num-readers }
+ 0 0 { cur-readers next-reader }
+ sr 0.005 f* { jitter }
+ num-readers make-array { readers }
+ num-readers make-array map!
+ :envelope gren :length grain-framples make-env
+ end-map { grain-envs }
+ newlen 0.0 make-vct { new-snd }
+ newlen 0 ?do
+ read-env i set-mus-location drop
+ read-env env { position-in-original }
+ position-in-original jitter mus-random f+ fround->s 0 max { mx }
+ mx snd chn 1 #f make-sampler { srd }
+ readers srd cycle-set!
+ grain-envs next-reader array-ref mus-reset drop
+ readers cycle-start@ to next-reader
+ cur-readers next-reader < if
+ next-reader to cur-readers
+ then
+ cur-readers 0 ?do
+ grain-envs i array-ref { e }
+ readers i array-ref { rd }
+ \ j is index from outer loop
+ newlen hop-framples j + min j ?do
+ new-snd i e env rd next-sample f* vct-set! drop
+ loop
+ loop
+ hop-framples +loop
+ "%s %s %s %s %s %s"
+ #( en tscl grlen gren ohop get-func-name ) string-format { origin }
+ 0 newlen new-snd snd chn #t origin
+ 0 current-edit-position #t set-samples ( vct )
;
+
\ #( 0 0 1 .1 2 1 ) 1.0 0.2 #( 0 0 1 1 2 0 ) granulated-sound-interp
\ #( 0 0 1 1 ) 2.0 granulated-sound-interp
\ #( 0 0 1 .1 2 1 ) 1.0 0.2 #( 0 0 1 1 2 0 ) 0.02 granulated-sound-interp
@@ -1711,387 +1899,341 @@ previous
hide
: fe-cb { flt amp-env -- prc; y self -- val }
- 1 proc-create flt , amp-env ,
- does> { y self -- val }
- self @ { flt }
- self cell+ @ ( amp-env ) env { env-val }
- flt 0 env-val set-mus-xcoeff drop
- flt 1 env-val 1.0 f- set-mus-xcoeff drop
- flt env-val y f* one-pole
+ 1 proc-create ( prc )
+ flt , amp-env ,
+ does> { y self -- val }
+ self @ { flt }
+ self cell+ @ ( amp-env ) env { env-val }
+ flt 0 env-val set-mus-xcoeff drop
+ flt 1 env-val 1.0 f- set-mus-xcoeff drop
+ flt env-val y f* one-pole
;
set-current
+
: filtered-env <{ e :optional snd #f chn #f -- val }>
- doc" It's a time-varying one-pole filter: \
-when env is at 1.0, no filtering, as env moves to 0.0, low-pass gets more intense; \
+ doc" It's a time-varying one-pole filter: \
+when env is at 1.0, no filtering, as env moves to 0.0, \
+low-pass gets more intense; \
amplitude and low-pass amount move together."
- 1.0 0.0 make-one-pole { flt }
- :envelope e :length snd chn #f frames make-env { amp-env }
- flt amp-env fe-cb 0 #f snd chn #f $" %s %s" #( e get-func-name ) string-format map-channel
+ 1.0 0.0 make-one-pole { flt }
+ :envelope e :length snd chn #f framples make-env { amp-env }
+ flt amp-env fe-cb 0 #f snd chn #f
+ "%s %s" #( e get-func-name ) string-format map-channel
;
previous
-\ ;;; -------- C-x b support: hide all but one of the current sounds (more like Emacs)
+\ ;;; -------- C-x b support: hide all but one of the current sounds
+\ ;;; (more like Emacs)
hide
#f value xb-last-buffer
#f value xb-current-buffer
0 value xb-last-width
0 value xb-last-height
+set-current
+
: open-current-buffer { width heigth -- }
- width to xb-last-width
- heigth to xb-last-height
- xb-current-buffer 0 array-ref sound-widgets 0 array-ref { sound-pane }
- sound-pane if
- sound-pane show-widget drop
- sound-pane #( width heigth ) set-widget-size drop
- xb-current-buffer 0 array-ref select-sound drop
- xb-current-buffer 1 array-ref select-channel drop
- then
-;
-: close-all-buffers ( -- ) sounds each ( s ) sound-widgets 0 array-ref hide-widget drop end-each ;
-: stb-cb <{ response -- f }>
- xb-current-buffer 0 array-ref
- sound-widgets 0 array-ref
- widget-size dup 0 array-ref
- swap 1 array-ref { width height }
- response string? not response empty? || if
- xb-current-buffer { temp }
- xb-last-buffer if
- xb-last-buffer to xb-current-buffer
- else
- :file undef
- :header-type undef
- :data-format undef
- :srate undef
- :channels undef
- :comment undef
- :size undef new-sound { index }
- #( index 0 ) to xb-current-buffer
- then
- temp to xb-last-buffer
- else
- response find-file dup false? if drop "" then 0 find-sound { index }
- index sound? if
- xb-current-buffer to xb-last-buffer
- #( index 0 ) to xb-current-buffer
- else
- $" can't find %s" #( response ) string-format #f #f report-in-minibuffer drop
- 1 sleep
- then
- then
- close-all-buffers
- "" #f #f report-in-minibuffer drop
- width height open-current-buffer
- #f
+ width to xb-last-width
+ heigth to xb-last-height
+ xb-current-buffer 0 array-ref sound-widgets 0 array-ref { sound-pane }
+ sound-pane if
+ sound-pane show-widget drop
+ sound-pane #( width heigth ) set-widget-size drop
+ xb-current-buffer 0 array-ref select-sound drop
+ xb-current-buffer 1 array-ref select-channel drop
+ then
;
-set-current
-: switch-to-buffer <{ -- val }>
- "" { default }
- xb-last-buffer array? if
- xb-last-buffer 0 array-ref short-file-name to default
- $" switch to buffer: "
- else
- $" (make new sound) "
- then { msg }
- default #f undef report-in-minibuffer drop
- msg <'> stb-cb #f #t prompt-in-minibuffer
-;
-: xb-close <{ snd -- val }>
- xb-current-buffer array?
- xb-current-buffer 0 array-ref snd = && if
- xb-current-buffer 0 array-ref { closer }
- close-all-buffers
- xb-last-buffer if
- xb-last-buffer
- else
- sounds if #f else #( sounds 0 array-ref 0 ) then
- then to xb-current-buffer
- #f sounds each { n }
- n closer =
- xb-current-buffer false?
- xb-current-buffer 0 array-ref n = || && if
- drop ( #f )
- #( n 0 )
- leave
- then
- end-each to xb-last-buffer
- xb-current-buffer if xb-last-width xb-last-height open-current-buffer then
- then
- #f
-;
-: xb-open <{ snd -- val }>
- close-all-buffers
- xb-current-buffer to xb-last-buffer
- #( snd 0 ) to xb-current-buffer
- xb-last-width 0= if window-width else xb-last-width then
- xb-last-height 0= if window-height 10 - else xb-last-height then open-current-buffer
+: close-all-buffers ( -- )
+ sounds each ( s )
+ sound-widgets 0 array-ref hide-widget drop
+ end-each
;
previous
-\ C-x b
-\ "b" 0 <'> switch-to-buffer #t "Switch to buffer" "switch-to-buffer" bind-key drop
-\ after-open-hook <'> xb-open add-hook!
-\ close-hook <'> xb-close add-hook!
-
\ ;;; -------- remove-clicks
: find-click ( loc -- pos )
- doc" Finds the next click starting at LOC."
- { loc }
- loc #f #f 1 #f make-sampler { rd }
- 0.0 0.0 0.0 { samp0 samp1 samp2 }
- 10 0.0 make-vct { samps }
- #f \ flag
- #f #f #f frames loc ?do
- samp1 to samp0
- samp2 to samp1
- rd next-sample to samp2
- samps samp0 cycle-set!
- samps vct-peak 0.1 fmax { local-max }
- samp0 samp1 f- fabs local-max f>
- samp1 samp2 f- fabs local-max f> &&
- samp0 samp2 f- fabs local-max f2/ f< && if drop ( flag ) i leave then
- loop
+ doc" Find the next click starting at LOC."
+ { loc }
+ loc #f #f 1 #f make-sampler { rd }
+ 0.0 0.0 0.0 { samp0 samp1 samp2 }
+ 10 0.0 make-vct { samps }
+ #f \ flag
+ #f #f #f framples loc ?do
+ samp1 to samp0
+ samp2 to samp1
+ rd next-sample to samp2
+ samps samp0 cycle-set!
+ samps vct-peak 0.1 fmax { local-max }
+ samp0 samp1 f- fabs local-max f>
+ samp1 samp2 f- fabs local-max f> &&
+ samp0 samp2 f- fabs local-max f2/ f< && if
+ drop ( flag )
+ i
+ leave
+ then
+ loop
;
: remove-clicks ( -- )
- doc" Tries to find and smooth-over clicks."
- -2 { click }
- begin
- click 2+ find-click to click
- click
- while
- click 2- 4 #f #f smooth-sound drop
- repeat
-;
-
-: search-for-click ( -- pos )
- doc" Looks for the next click (for use with C-s)"
- 1 proc-create 10 0.0 make-vct , 0.0 , 0.0 , 0.0 , ( prc )
- does> { val self -- f }
- self @ { samps }
- self cell+ @ { samp0 }
- self 2 cells + @ { samp1 }
- self 3 cells + @ { samp2 }
- samp1 to samp0
- samp2 to samp1
- val to samp2
- samp0 self cell+ !
- samp1 self 2 cells + !
- samp2 self 3 cells + !
- samps samp0 cycle-set!
- samps vct-peak 0.1 fmax { local-max }
- samp0 samp1 f- fabs local-max f>=
- samp1 samp2 f- fabs local-max f>= &&
- samp0 samp2 f- fabs local-max f2/ f<= && if
- -1
- else
- #f
- then
+ doc" Try to find and smooth-over clicks."
+ -2 { click }
+ begin
+ click 2+ find-click to click
+ click
+ while
+ click 2- 4 #f #f smooth-sound drop
+ repeat
+;
+
+: search-for-click ( -- prc; val self -- pos )
+ doc" Look for the next click (for use with C-s)."
+ 1 proc-create ( prc )
+ 10 0.0 make-vct , 0.0 , 0.0 , 0.0 ,
+ does> { val self -- pos }
+ self @ { samps }
+ self cell+ @ { samp0 }
+ self 2 cells + @ { samp1 }
+ self 3 cells + @ { samp2 }
+ samp1 to samp0
+ samp2 to samp1
+ val to samp2
+ samp0 self cell+ !
+ samp1 self 2 cells + !
+ samp2 self 3 cells + !
+ samps samp0 cycle-set!
+ samps vct-peak 0.1 fmax { local-max }
+ samp0 samp1 f- fabs local-max f>=
+ samp1 samp2 f- fabs local-max f>= &&
+ samp0 samp2 f- fabs local-max f2/ f<= && if
+ -1
+ else
+ #f
+ then
;
: zero+ ( -- prc; n self -- val )
- doc" Finds the next positive-going zero crossing (if searching forward) (for use with C-s)"
- 1 proc-create 0.0 ( lastn ) ,
- does> { n self -- val }
- self @ ( lastn ) f0< n f0>= && -1 && ( rtn )
- n self ! ( lastn = n )
- ( rtn )
+ doc" Find the next positive-going zero crossing (if \
+searching forward) (for use with C-s)."
+ 1 proc-create ( prc )
+ 0.0 ( lastn ) ,
+ does> { n self -- val }
+ self @ ( lastn ) f0< n f0>= && -1 && ( val )
+ n self ! ( lastn = n )
+ ( val )
;
: next-peak ( -- prc; n self -- val )
- doc" Finds the next max or min point in the time-domain waveform (for use with C-s)"
- 1 proc-create ( last0 ) #f , ( last1 ) #f ,
- does> { n self -- val }
- self @ { last0 }
- self cell+ @ { last1 }
- last0 number?
- last0 last1 f< last1 n f> &&
- last0 last1 f> last1 n f< && || &&
- -1 && ( rtn )
- last1 self ! ( last0 = last1 )
- n self cell+ ! ( last1 = n )
- ( rtn )
+ doc" Find the next max or min point in the \
+time-domain waveform (for use with C-s)."
+ 1 proc-create ( prc )
+ ( last0 ) #f , ( last1 ) #f ,
+ does> { n self -- val }
+ self @ { last0 }
+ self cell+ @ { last1 }
+ last0 number?
+ last0 last1 f< last1 n f> &&
+ last0 last1 f> last1 n f< && || &&
+ -1 && ( val )
+ last1 self ! ( last0 = last1 )
+ n self cell+ ! ( last1 = n )
+ ( val )
;
: find-pitch ( pitch -- prc; y self -- val )
- doc" Finds the point in the current sound where PITCH (in Hz) predominates:\n\
+ doc" Find the point in the current sound \
+where PITCH (in Hz) predominates:\n\
C-s 300 find-pitch\n\
-In most cases, this will be slightly offset from the true beginning of the note."
- { pitch }
- 1 proc-create #f #f transform-size 0.0 make-vct , pitch , ( prc )
- does> { n self -- val }
- self @ { data }
- self cell+ @ { pitch }
- data n cycle-set!
- data cycle-start@ 0= if
- data vct-peak 0.001 f> if
- data rectangular-window data length #t 0.0 undef #t snd-spectrum { spectr }
- 10.0 flog { log10 }
- 0.0 0 { pk pkloc }
- data length 2/ 0 ?do
- spectr i vct-ref dup pk f> if
- ( val ) to pk
- i to pkloc
+In most cases, this will be slightly offset from the true \
+beginning of the note."
+ { pitch }
+ 1 proc-create ( prc )
+ #f #f transform-size 0.0 make-vct , pitch ,
+ does> { y self -- val }
+ self @ { data }
+ self cell+ @ { pitch }
+ data y cycle-set!
+ data cycle-start@ 0= if
+ data vct-peak 0.001 f> if
+ data rectangular-window data length
+ #t 0.0 undef #t snd-spectrum { spectr }
+ 10.0 flog { log10 }
+ 0.0 0 { pk pkloc }
+ data length 2/ 0 ?do
+ spectr i vct-ref dup pk f> if
+ ( val ) to pk
+ i to pkloc
+ else
+ ( val ) drop
+ then
+ loop
+ pkloc 0> if
+ spectr pkloc 1- vct-ref { la }
+ spectr pkloc vct-ref { ca }
+ spectr pkloc 1+ vct-ref { ra }
+ la ca fmax ra fmax 0.001 f* { pk1 }
+ la 0.0000001 fmax pk1 f/ flog log10 f/ { logla }
+ ca 0.0000001 fmax pk1 f/ flog log10 f/ { logca }
+ ra 0.0000001 fmax pk1 f/ flog log10 f/ { logra }
+ logla logra f- f2/
+ logla logra f+ logca f2* f- f/
+ else
+ 0.0
+ then pkloc f+ #f srate f* data length f/ { pit }
+ pitch pit f- fabs #f srate data length f2* f/ f< if
+ data length 2/ negate
+ else
+ #f
+ then ( val )
+ then
+ data 0.0 vct-fill! drop
else
- ( val ) drop
+ #f
then
- loop
- pkloc 0> if
- spectr pkloc 1- vct-ref { la }
- spectr pkloc vct-ref { ca }
- spectr pkloc 1+ vct-ref { ra }
- la ca fmax ra fmax 0.001 f* { pk1 }
- la 0.0000001 fmax pk1 f/ flog log10 f/ { logla }
- ca 0.0000001 fmax pk1 f/ flog log10 f/ { logca }
- ra 0.0000001 fmax pk1 f/ flog log10 f/ { logra }
- logla logra f- f2/ logla logra f+ logca f2* f- f/
- else
- 0.0
- then pkloc f+ #f srate f* data length f/ { pit }
- pitch pit f- fabs #f srate data length f2* f/ f< if
- data length 2/ negate
- else
- #f
- then ( rtn )
- then
- data 0.0 vct-fill! drop
- else
- #f
- then
;
\ ;;; -------- file->vct and a sort of cue-list, I think
[ifundef] file->vct
- : file->vct ( file -- vct )
- doc" Returns a vct with FILE's data."
- { file }
- file find-file to file
- file false? if 'no-such-file #( get-func-name file ) fth-throw then
- 0 file undef 1 #f make-sampler { reader }
- file mus-sound-frames 0.0 make-vct map! reader next-sample end-map ( data )
- reader free-sampler drop
- ;
+ : file->vct ( file -- vct )
+ doc" Return a vct with FILE's data."
+ { file }
+ file find-file to file
+ file unless
+ 'no-such-file #( "%s: %S" get-func-name file ) fth-throw
+ then
+ 0 file undef 1 #f make-sampler { reader }
+ file mus-sound-framples 0.0 make-vct map!
+ reader next-sample
+ end-map ( data )
+ reader free-sampler drop
+ ;
[then]
hide
: an-cb ( notes snd chn -- prc; self -- #f )
- { notes snd chn }
- 0 proc-create { prc }
- notes ,
- snd ,
- chn ,
- prc
- does> { self -- #f }
- self @ { notes }
- self cell+ @ { snd }
- self 2 cells + @ { chn }
- snd chn #f cursor { start }
- notes each { note }
- note 0 array-ref find-file { file }
- file false? if 'no-such-file #( "add-notes" file ) fth-throw then
- note length 1 > if
- note 1 array-ref
- else
- 0.0
- then { offset }
- note length 2 > if
- note 2 array-ref
- else
- 1.0
- then { amp }
- snd srate offset f* fround->s start + { beg }
- amp 1.0 f<> if
- file file->vct amp vct-scale! beg snd chn #f "add-notes" mix-vct drop
- else
- file beg 0 snd chn #f undef mix drop
- then
- end-each
- #f
+ { notes snd chn }
+ 0 proc-create ( prc )
+ notes , snd , chn ,
+ does> { self -- #f }
+ self @ { notes }
+ self cell+ @ { snd }
+ self 2 cells + @ { chn }
+ snd chn #f cursor { start }
+ notes each { note }
+ note 0 array-ref find-file { file }
+ file unless
+ 'no-such-file #( "add-notes: %S" file ) fth-throw
+ then
+ note length 1 > if
+ note 1 array-ref
+ else
+ 0.0
+ then { offset }
+ note length 2 > if
+ note 2 array-ref
+ else
+ 1.0
+ then { amp }
+ snd srate offset f* fround->s start + { beg }
+ amp 1.0 f<> if
+ file file->vct amp vct-scale!
+ beg snd chn #f "add-notes" mix-vct
+ else
+ file beg 0 snd chn #f undef mix
+ then drop
+ end-each
+ #f
;
set-current
+
: add-notes <{ notes :optional snd #f chn #f -- #f }>
- doc" Adds (mixes) NOTES which is a list of lists of the form:\n\
+ doc" Add (mix) NOTES which is a list of lists of the form:\n\
file :optional offset 0.0 amp 1.0\n\
starting at the cursor in the currently selected channel:\n\
-#( #( \"oboe.snd\" ) #( \"pistol.snd\" 1.0 2.0 ) ) add-notes"
- notes snd chn an-cb $" %s %s" #( notes get-func-name ) string-format as-one-edit
+#( #( \"oboe.snd\" ) #( \"pistol.snd\" 1.0 2.0 ) ) add-notes."
+ notes snd chn an-cb
+ "%s %s" #( notes get-func-name ) string-format as-one-edit
;
previous
hide
: rpl-cb { reg -- prc; self -- val }
- 0 proc-create reg , ( prc )
- does> { self -- val }
- self @ ( reg ) play
+ 0 proc-create ( prc )
+ reg ,
+ does> { self -- val }
+ self @ ( reg ) play
;
set-current
+
: region-play-list ( data -- )
- doc" DATA is list of lists #( #( time reg ) ... ), TIME in secs, \
+ doc" DATA is list of lists #( #( time reg ) ... ), TIME in secs, \
setting up a sort of play list:\n\
-#( #( 0.0 0 ) #( 0.5 1 ) #( 1.0 2 ) #( 1.0 0 ) ) region-play-list"
- ( data ) each { tone }
- tone 0 array-ref 1000.0 f* fround->s { time }
- tone 1 array-ref { region }
- region region? if
- time region rpl-cb in drop
- then
- end-each
+#( #( 0.0 0 ) #( 0.5 1 ) #( 1.0 2 ) #( 1.0 0 ) ) region-play-list."
+ ( data ) each { tone }
+ tone 0 array-ref 1000.0 f* fround->s { time }
+ tone 1 array-ref { region }
+ region region? if
+ time region rpl-cb in drop
+ then
+ end-each
;
previous
: region-play-sequence ( data -- )
- doc" DATA is list of region ids which will be played one after the other:\n\
-#( 0 2 1 ) region-play-sequence"
- 0.0 { time }
- ( data ) map
- *key* { id }
- time { cur }
- id 0 region-frames id region-srate f/ time f+ to time
- #( cur id )
- end-map region-play-list
+ doc" DATA is list of region ids which will be played \
+one after the other:\n\
+#( 0 2 1 ) region-play-sequence."
+ 0.0 { time }
+ ( data ) map
+ *key* { id }
+ time { cur }
+ id 0 region-framples id region-srate f/ time f+ to time
+ #( cur id )
+ end-map region-play-list
;
\ ;;; -------- replace-with-selection
: replace-with-selection ( -- )
- doc" Replaces the samples from the cursor with the current selection."
- #f #f #f cursor { beg }
- #f #f selection-frames { len }
- beg #f #f insert-selection drop
- beg len + len #f #f #f delete-samples drop
+ doc" Replace the samples from the cursor with the current selection."
+ #f #f #f cursor { beg }
+ #f #f selection-framples { len }
+ beg #f #f insert-selection drop
+ beg len + len #f #f #f delete-samples drop
;
\ ;;; -------- explode-sf2
: explode-sf2 ( -- )
- doc" turns the currently selected soundfont file \
-into a bunch of files of the form sample-name.aif."
- #f soundfont-info { lst }
- lst length 1- { last }
- lst each { vals }
- \ #( name start loop-start loop-end )
- vals 0 array-ref { name }
- vals 1 array-ref { start }
- i last < if
- lst i 1+ array-ref 1 array-ref
- else
- #f #f #f frames
- then { end }
- vals 2 array-ref start d- { loop-start }
- vals 3 array-ref start d- { loop-end }
- name ".aif" $+ { filename }
- undef selection? if #f #t #f set-selection-member? drop then
- #t #f #f set-selection-member? drop
- start #f #f set-selection-position drop
- end start d- #f #f set-selection-frames drop
- :file filename :header-type mus-aifc save-selection drop
- filename open-sound { temp }
- temp #( loop-start loop-end ) set-sound-loop-info drop
- temp close-sound drop
- end-each
+ doc" Turn the currently selected soundfont file into \
+a bunch of files of the form sample-name.aif."
+ #f soundfont-info { lst }
+ lst length 1- { last }
+ lst each { vals }
+ \ #( name start loop-start loop-end )
+ vals 0 array-ref { name }
+ vals 1 array-ref { start }
+ i last < if
+ lst i 1+ array-ref 1 array-ref
+ else
+ #f #f #f framples
+ then { end }
+ vals 2 array-ref start d- { loop-start }
+ vals 3 array-ref start d- { loop-end }
+ name ".aif" $+ { filename }
+ undef selection? if
+ #f #t #f set-selection-member? drop
+ then
+ #t #f #f set-selection-member? drop
+ start #f #f set-selection-position drop
+ end start d- #f #f set-selection-framples drop
+ :file filename :header-type mus-aifc save-selection drop
+ filename open-sound { temp }
+ temp #( loop-start loop-end ) set-sound-loop-info drop
+ temp close-sound drop
+ end-each
;
\ ;;; -------- open-next-file-in-directory
@@ -2100,264 +2242,247 @@ hide
#f value nd-last-file-opened \ string
#f value nd-current-directory \ string
#f value nd-current-sorted-files \ array
+
: gcf-sort-cb <{ a b -- n }>
- a b string< if
- -1
- else
- a b string> if
- 1
- else
- 0
- then
- then
-;
-: get-current-files ( dir -- )
- { dir }
- dir to nd-current-directory
- dir sound-files-in-directory <'> gcf-sort-cb sort to nd-current-sorted-files
+ a b string< if
+ -1
+ else
+ a b string> if
+ 1
+ else
+ 0
+ then
+ then
;
+
+: get-current-files { dir -- }
+ dir to nd-current-directory
+ dir sound-files-in-directory
+ <'> gcf-sort-cb sort to nd-current-sorted-files
+;
+
: get-current-directory <{ filename -- filename }>
- filename to nd-last-file-opened
- filename mus-expand-filename file-dirname { new-path }
- nd-current-directory string? not
- nd-current-directory new-path string= not || if new-path get-current-files then
- filename
+ filename to nd-last-file-opened
+ filename mus-expand-filename file-dirname { new-path }
+ nd-current-directory new-path string<> if
+ new-path get-current-files
+ then
+ filename
;
set-current
+
: open-next-file-in-directory ( -- f )
- \ open-hook <'> get-current-directory hook-member? unless
- \ open-hook <'> get-current-directory add-hook!
- \ then
- nd-last-file-opened string? not
- sounds nil? not && if
- #f snd-snd file-name to nd-last-file-opened
- then
- nd-current-directory string? unless
- sounds nil? if file-pwd else nd-last-file-opened file-dirname then get-current-files
- then
- nd-current-sorted-files empty? if
- 'no-such-file #( get-func-name nd-current-directory ) fth-throw
- else
- nd-current-sorted-files cycle-ref { next-file }
- next-file 0 find-sound if
- 'file-already-open #( get-func-name next-file ) fth-throw
- else
- sounds nil? unless #f snd-snd close-sound drop then
- next-file find-file dup if open-sound then drop
- then
- then
- #t
+ \ open-hook <'> get-current-directory hook-member? unless
+ \ open-hook <'> get-current-directory add-hook!
+ \ then
+ nd-last-file-opened string? not
+ sounds nil? not && if
+ #f snd-snd file-name to nd-last-file-opened
+ then
+ nd-current-directory string? unless
+ sounds nil? if
+ file-pwd
+ else
+ nd-last-file-opened file-dirname
+ then get-current-files
+ then
+ nd-current-sorted-files empty? if
+ 'no-such-file
+ #( "%s: %s" get-func-name nd-current-directory ) fth-throw
+ else
+ nd-current-sorted-files cycle-ref { next-file }
+ next-file 0 find-sound if
+ 'file-already-open
+ #( "%s: %s" get-func-name next-file ) fth-throw
+ else
+ sounds nil? unless
+ #f snd-snd close-sound drop
+ then
+ next-file find-file dup if
+ open-sound
+ then drop
+ then
+ then
+ #t
;
previous
hide
: mouse-click-to-open-cb <{ snd chn button state x y axis -- f }>
- button 2 = if open-next-file-in-directory else #f then
+ button 2 = if
+ open-next-file-in-directory
+ else
+ #f
+ then
;
set-current
+
: click-middle-button-to-open-next-file-in-directory ( -- )
- mouse-click-hook <'> mouse-click-to-open-cb add-hook!
- open-hook <'> get-current-directory add-hook!
+ mouse-click-hook <'> mouse-click-to-open-cb add-hook!
+ open-hook <'> get-current-directory add-hook!
;
previous
\ ;;; -------- chain-dsps
instrument: chain-dsps <{ start dur :optional dsps #() -- }>
- dsps map
- *key* array? if
- :envelope *key* :duration dur make-env
- else
- *key*
- then
- end-map { dsp-chain }
- start dur nil run-instrument
- 0.0 { val }
- dsp-chain each { gen }
- gen env? if
- gen env val f*
- else
- gen readin? if
- gen readin val f+
- else
- gen mus-generator? if
- gen val 0.0 mus-apply
- else
- gen #( val ) run-proc
- then
- then
- then to val
- end-each
- val
- end-run
+ dsps map
+ *key* array? if
+ :envelope *key* :duration dur make-env
+ else
+ *key*
+ then
+ end-map { dsp-chain }
+ start dur nil run-instrument
+ 0.0 { val }
+ dsp-chain each { gen }
+ gen env? if
+ gen env val f*
+ else
+ gen readin? if
+ gen readin val f+
+ else
+ gen mus-generator? if
+ gen val 0.0 mus-apply
+ else
+ gen #( val ) run-proc
+ then
+ then
+ then to val
+ end-each
+ val
+ end-run
;instrument
hide
: cdsps-cb { os1 os2 -- prc; val self -- r }
- 1 proc-create os1 , os2 , ( prc )
- does> { val self -- r }
- self @ ( osc1 ) val 0.0 oscil
- self cell+ @ ( osc2 ) val f2* 0.0 oscil f+
+ 1 proc-create ( prc )
+ os1 , os2 ,
+ does> { val self -- r }
+ self @ ( osc1 ) val 0.0 oscil
+ self cell+ @ ( osc2 ) val f2* 0.0 oscil f+
;
set-current
+
0 [if]
-lambda: ( -- )
- 440.0 make-oscil { os1 }
- 0 1.0 #( #( 0 0 1 1 2 0 ) os1 ) chain-dsps
- 0.5 make-one-zero { oz }
- "oboe.snd" find-file make-readin { rd }
- 0 1.0 #( #( 0 0 1 1 2 0 ) oz rd ) chain-dsps
- 220 make-oscil { osc1 }
- 440 make-oscil { osc2 }
- osc1 osc2 cdsps-cb { cb }
- 0 1.0 #( #( 0 0 1 1 2 0 ) cb ) chain-dsps
-; with-sound
+ lambda: ( -- )
+ 440.0 make-oscil { os1 }
+ 0 1.0 #( #( 0 0 1 1 2 0 ) os1 ) chain-dsps
+ 0.5 make-one-zero { oz }
+ "oboe.snd" find-file make-readin { rd }
+ 0 1.0 #( #( 0 0 1 1 2 0 ) oz rd ) chain-dsps
+ 220 make-oscil { osc1 }
+ 440 make-oscil { osc2 }
+ osc1 osc2 cdsps-cb { cb }
+ 0 1.0 #( #( 0 0 1 1 2 0 ) cb ) chain-dsps
+ ; with-sound
[then]
previous
-\ ;;; -------- smooth-channel as virtual op
-
-hide
-: scvp3-cb <{ y data forward -- val }>
- data 0 vct-ref { angle }
- data 1 vct-ref { incr }
- data 3 vct-ref data 4 vct-ref data 2 vct-ref angle f+ fcos f* f+ ( val )
- data 0 angle incr forward if f+ else f- then vct-set! drop ( val )
-;
-: scvp1-cb { data -- prc1; frag-beg frag-dur self -- vct }
- 2 proc-create { prc } data , prc
- does> { frag-beg frag-dur self -- vct }
- self @ { data }
- pi frag-dur f/ { incr }
- data 1 incr vct-set! drop
- data 0 frag-beg incr f* vct-set! drop
- data
-;
-set-current
-: smooth-channel-via-ptree <{ :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- beg snd chn edpos sample { y0 }
- beg dur snd chn #f frames 1- || snd chn edpos sample { y1 }
- y1 y0 f> if pi else 0.0 then { init-angle }
- y0 y1 f+ f2/ { off }
- y1 y0 f- fabs f2/ { scale }
- vct( 0.0 0.0 init-angle off scale ) { data }
- $" %s %s %s" #( beg dur get-func-name ) string-format { origin }
- <'> scvp3-cb beg dur snd chn edpos #t data scvp1-cb origin ptree-channel
-;
-previous
-
-\ ;;; -------- ring-modulate-channel (ring-mod as virtual op)
-
-hide
-: rmc-cb3 <{ y data forward -- val }>
- data 0 vct-ref { angle }
- data 1 vct-ref { incr }
- angle fsin y f* ( val )
- data 0 angle incr forward if f+ else f- then vct-set! drop ( val )
-;
-: rmc-cb2 { freq snd -- prc; frag-beg frag-dur self -- vct }
- 2 proc-create { prc } freq , snd , prc
- does> { frag-beg frag-dur self -- vct }
- two-pi self @ ( freq ) f* self cell+ @ ( snd ) srate f/ { incr }
- vct( frag-beg incr f* two-pi fmod incr )
-;
-set-current
-: ring-modulate-channel <{ freq :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- $" %s %s %s %s" #( freq beg dur get-func-name ) string-format { origin }
- <'> rmc-cb3 beg dur snd chn edpos #f freq snd rmc-cb2 origin ptree-channel
-;
-previous
-
\ ;;; -------- re-order channels
: scramble-channels ( new-order -- )
- \ ;; (scramble-channels 3 2 0 1) means chan 3 goes to 0, etc
- { end-chans }
- end-chans length { len }
- len 1 > if
- end-chans map i end-map { cur-chans }
- end-chans each { end-chan }
- cur-chans i array-ref { cur-chan }
- end-chan cur-chan <> if
- #f cur-chans each { chn } chn end-chan = if drop ( #f ) i leave then end-each { end-loc }
- #f end-loc #f i 0 len #f swap-channels drop
- cur-chans end-loc cur-chan array-set!
- cur-chans i end-chan array-set!
- then
- end-each
- then
+ \ ;; (scramble-channels 3 2 0 1) means chan 3 goes to 0, etc
+ { end-chans }
+ end-chans length { len }
+ len 1 > if
+ end-chans map
+ i
+ end-map { cur-chans }
+ end-chans each { end-chan }
+ cur-chans i array-ref { cur-chan }
+ end-chan cur-chan <> if
+ #f cur-chans each { chn }
+ chn end-chan = if
+ drop ( #f )
+ i
+ leave
+ then
+ end-each { end-loc }
+ #f end-loc #f i 0 len #f swap-channels drop
+ cur-chans end-loc cur-chan array-set!
+ cur-chans i end-chan array-set!
+ then
+ end-each
+ then
;
hide
: sc-scan-cb { buffer silence in-silence edges samp -- prc; y self -- #f }
- 1 proc-create buffer , silence , in-silence , edges , samp , ( prc )
- does> { y self -- #f }
- self @ ( buffer ) y y f* moving-average { sum-of-squares }
- sum-of-squares self cell+ @ ( silence ) f< { now-silent }
- self 2 cells + @ ( in-silence ) now-silent equal? unless
- self 3 cells + @ ( edges ) self 4 cells + @ ( samp ) array-push drop
- then
- now-silent self 2 cells + ! ( in-silence = now-silent )
- 1 self 4 cells + +! ( samp++ )
- #f
+ 1 proc-create ( prc )
+ buffer , silence , in-silence , edges , samp ,
+ does> { y self -- #f }
+ self @ ( buffer ) y y f* moving-average { sum-of-squares }
+ sum-of-squares self cell+ @ ( silence ) f< { now-silent }
+ self 2 cells + @ ( in-silence ) now-silent equal? unless
+ self 3 cells + @ ( edges )
+ self 4 cells + @ ( samp ) array-push drop
+ then
+ now-silent self 2 cells + ! ( in-silence = now-silent )
+ 1 self 4 cells + +! ( samp++ )
+ #f
;
+
: sc-edit-cb { pieces -- prc; self -- val }
- 0 proc-create pieces , 0 ( start ) , ( prc )
- does> { self -- val }
- self @ { pieces }
- self cell+ @ { start }
- 0.0 { scale-by }
- pieces length { len }
- len 0 ?do
- len random fround->s { this }
- pieces this array-ref { reg }
- pieces this #f array-set!
- reg unless
- len this 1+ ?do
- pieces i array-ref dup if
- to reg
- pieces i #f array-set!
- leave
- then
- loop
- reg unless
- 0 this 1- ?do
- pieces i array-ref dup if
- to reg
- pieces i #f array-set!
- leave
- then
- -1 +loop
- then
- then
- reg start #f #f 0 mix-region drop
- reg 0 region-frames start + to start
- reg forget-region drop
- loop
- pieces
+ 0 proc-create ( prc )
+ pieces , 0 ( start ) ,
+ does> { self -- val }
+ self @ { pieces }
+ self cell+ @ { start }
+ 0.0 { scale-by }
+ pieces length { len }
+ len 0 ?do
+ len random fround->s { this }
+ pieces this array-ref { reg }
+ pieces this #f array-set!
+ reg unless
+ len this 1+ ?do
+ pieces i array-ref dup if
+ to reg
+ pieces i #f array-set!
+ leave
+ then
+ loop
+ reg unless
+ 0 this 1- ?do
+ pieces i array-ref dup if
+ to reg
+ pieces i #f array-set!
+ leave
+ then
+ -1 +loop
+ then
+ then
+ reg start #f #f 0 mix-region drop
+ reg 0 region-framples start + to start
+ reg forget-region drop
+ loop
+ pieces
;
set-current
+
: scramble-channel ( silence -- )
- \ ;; (scramble-channel .01)
- { silence }
- 128 make-moving-average { buffer }
- silence 128 f/ to silence
- #() { edges }
- 0 { samp }
- #t { in-silence }
- max-regions { old-max }
- with-mix-tags { old-tags }
- 1024 set-max-regions drop
- #f set-with-mix-tags drop
- buffer silence in-silence edges samp sc-scan-cb 0 #f #f #f #f scan-channel drop
- edges #f #f #f frames array-push drop
- 0 0 { start end }
- edges map
- start *key* #f #f make-region
- *key* to start
- end-map ( pieces ) sc-edit-cb get-func-name as-one-edit drop
- old-max set-max-regions drop
- old-tags set-with-mix-tags drop
+ \ ;; (scramble-channel .01)
+ { silence }
+ 128 make-moving-average { buffer }
+ silence 128 f/ to silence
+ #() { edges }
+ 0 { samp }
+ #t { in-silence }
+ max-regions { old-max }
+ with-mix-tags { old-tags }
+ 1024 set-max-regions drop
+ #f set-with-mix-tags drop
+ buffer silence in-silence edges samp sc-scan-cb
+ 0 #f #f #f #f scan-channel drop
+ edges #f #f #f framples array-push drop
+ 0 0 { start end }
+ edges map
+ start *key* #f #f make-region
+ *key* to start
+ end-map ( pieces ) sc-edit-cb get-func-name as-one-edit drop
+ old-max set-max-regions drop
+ old-tags set-with-mix-tags drop
;
previous
@@ -2365,77 +2490,86 @@ previous
hide
: rbb-cb { rd beg ctr actual-block-len len snd chn -- prc; y self -- val }
- 1 proc-create rd , beg , ctr , actual-block-len , len , snd , chn , ( prc )
- does> { y self -- val }
- self @ { rd }
- self cell+ @ { beg }
- self 2 cells + @ { ctr }
- self 3 cells + @ { actual-block-len }
- self 4 cells + @ { len }
- self 5 cells + @ { snd }
- self 6 cells + @ { chn }
- rd read-sample { val }
- beg 10 < if
- val beg f* 0.1 f* to val
- else
- beg actual-block-len 10 - > if
- val actual-block-len beg - f* 0.1 f* to val
- then
- then
- beg 1+ to beg
- beg actual-block-len = if
- 1 self 2 cells + +! ( ctr++ )
- 0 self 1 cells + ! ( beg = 0 )
- len self 2 cells + @ ( ctr ) actual-block-len * - 0 max snd chn 1 #f make-sampler self !
- then
- val
+ 1 proc-create ( prc )
+ rd , beg , ctr , actual-block-len , len , snd , chn ,
+ does> { y self -- val }
+ self @ { rd }
+ self cell+ @ { beg }
+ self 2 cells + @ { ctr }
+ self 3 cells + @ { actual-block-len }
+ self 4 cells + @ { len }
+ self 5 cells + @ { snd }
+ self 6 cells + @ { chn }
+ rd read-sample { val }
+ beg 10 < if
+ val beg f* 0.1 f* to val
+ else
+ beg actual-block-len 10 - > if
+ val actual-block-len beg - f* 0.1 f* to val
+ then
+ then
+ beg 1+ to beg
+ beg actual-block-len = if
+ 1 self 2 cells + +! ( ctr++ )
+ 0 self 1 cells + ! ( beg = 0 )
+ len self 2 cells + @ ( ctr ) actual-block-len * - 0 max
+ snd chn 1 #f make-sampler self !
+ then
+ val
;
set-current
+
: reverse-by-blocks <{ block-len :optional snd #f chn #f -- val }>
- doc" Divide sound into block-len blocks, recombine blocks in reverse order."
- snd chn #f frames { len }
- len snd srate block-len f* f/ fround->s { num-blocks }
- num-blocks 1 > if
- len num-blocks f/ fceil f>s { actual-block-len }
- len actual-block-len - snd chn 1 #f make-sampler { rd }
- 0 { beg }
- 1 { ctr }
- $" %s %s" #( block-len get-func-name ) string-format { origin }
- rd beg ctr actual-block-len len snd chn rbb-cb 0 #f snd chn #f origin map-channel
- else
- #f
- then
+ doc" Divide sound into block-len blocks, \
+recombine blocks in reverse order."
+ snd chn #f framples { len }
+ len snd srate block-len f* f/ fround->s { num-blocks }
+ num-blocks 1 > if
+ len num-blocks f/ fceil f>s { actual-block-len }
+ len actual-block-len - snd chn 1 #f make-sampler { rd }
+ 0 { beg }
+ 1 { ctr }
+ "%s %s" #( block-len get-func-name ) string-format { origin }
+ rd beg ctr actual-block-len len snd chn rbb-cb
+ 0 #f snd chn #f origin map-channel
+ else
+ #f
+ then
;
previous
hide
: rwb-cb { len actual-block-len no-clicks-env snd chn -- prc; self -- val }
- 0 proc-create len , actual-block-len , no-clicks-env , snd , chn , ( prc )
- does> { self -- val }
- self @ { len }
- self cell+ @ { actual-block-len }
- self 2 cells + @ { no-clicks-env }
- self 3 cells + @ { snd }
- self 4 cells + @ { chn }
- len 0 ?do
- i actual-block-len snd chn #f reverse-channel drop
- no-clicks-env i actual-block-len snd chn #f env-channel drop
- actual-block-len +loop
- #t
+ 0 proc-create ( prc )
+ len , actual-block-len , no-clicks-env , snd , chn ,
+ does> { self -- val }
+ self @ { len }
+ self cell+ @ { actual-block-len }
+ self 2 cells + @ { no-clicks-env }
+ self 3 cells + @ { snd }
+ self 4 cells + @ { chn }
+ len 0 ?do
+ i actual-block-len snd chn #f reverse-channel drop
+ no-clicks-env i actual-block-len snd chn #f env-channel drop
+ actual-block-len +loop
+ #t
;
set-current
+
: reverse-within-blocks <{ block-len :optional snd #f chn #f -- val }>
- doc" Divide sound into blocks, recombine in order, but each block internally reversed."
- snd chn #f frames { len }
- len snd srate block-len f* f/ fround->s { num-blocks }
- num-blocks 1 > if
- len num-blocks f/ fceil f>s { actual-block-len }
- #( 0.0 0.0 0.01 1.0 0.99 1.0 1.0 0.0 ) { no-clicks-env }
- $" %s %s" #( block-len get-func-name ) string-format { origin }
- len actual-block-len no-clicks-env snd chn rwb-cb origin as-one-edit
- else
- 0 #f snd chn #f reverse-channel
- then
+ doc" Divide sound into blocks, recombine in order, \
+but each block internally reversed."
+ snd chn #f framples { len }
+ len snd srate block-len f* f/ fround->s { num-blocks }
+ num-blocks 1 > if
+ len num-blocks f/ fceil f>s { actual-block-len }
+ #( 0.0 0.0 0.01 1.0 0.99 1.0 1.0 0.0 ) { no-clicks-env }
+ "%s %s" #( block-len get-func-name ) string-format { origin }
+ len actual-block-len no-clicks-env snd chn rwb-cb
+ origin as-one-edit
+ else
+ 0 #f snd chn #f reverse-channel
+ then
;
previous
@@ -2443,53 +2577,63 @@ previous
hide
: cc-cb ( -- prc; y self -- f )
- 1 proc-create 0.0 ( last-y ) , ( prc )
- does> { y self -- f }
- self @ { last-y }
- y fabs 0.9999 f>=
- last-y fabs 0.9999 f>= && ( result )
- y self ! ( last-y = y )
- ( result )
+ 1 proc-create ( prc )
+ 0.0 ( last-y ) ,
+ does> { y self -- f }
+ self @ { last-y }
+ y fabs 0.9999 f>=
+ last-y fabs 0.9999 f>= && ( flag )
+ y self ! ( last-y = y )
+ ( flag )
;
set-current
+
: channel-clipped? <{ :optional snd #f chn #f -- val }>
- doc" Returns #t and a sample number if it finds clipping."
- cc-cb 0 #f snd chn #f scan-channel
+ doc" Return #t and a sample number if it finds clipping."
+ cc-cb 0 #f snd chn #f scan-channel
;
previous
\ ;;; -------- sync-everything
: sync-everything ( -- )
- doc" Sets the sync fields of all currently open sounds to the same, unique value."
- sync-max 1+ { new-sync }
- sounds each ( snd ) new-sync swap set-sync drop end-each
+ doc" Set the sync fields of all currently open sounds \
+to the same, unique value."
+ sync-max 1+ { new-sync }
+ sounds each ( snd )
+ new-sync swap set-sync drop
+ end-each
;
\ === Moog Filter ===
hide
-vct( 0.999969 0.990082 0.980347 0.970764 0.961304 0.951996 0.94281 0.933777 0.924866 0.916077
- 0.90741 0.898865 0.890442 0.882141 0.873962 0.865906 0.857941 0.850067 0.842346 0.834686
- 0.827148 0.819733 0.812378 0.805145 0.798004 0.790955 0.783997 0.77713 0.770355 0.763672
- 0.75708 0.75058 0.744141 0.737793 0.731537 0.725342 0.719238 0.713196 0.707245 0.701355
- 0.695557 0.689819 0.684174 0.678558 0.673035 0.667572 0.66217 0.65686 0.651581 0.646393
- 0.641235 0.636169 0.631134 0.62619 0.621277 0.616425 0.611633 0.606903 0.602234 0.597626
- 0.593048 0.588531 0.584045 0.579651 0.575287 0.570953 0.566681 0.562469 0.558289 0.554169
- 0.550079 0.546051 0.542053 0.538116 0.53421 0.530334 0.52652 0.522736 0.518982 0.515289
- 0.511627 0.507996 0.504425 0.500885 0.497375 0.493896 0.490448 0.487061 0.483704 0.480377
- 0.477081 0.473816 0.470581 0.467377 0.464203 0.46109 0.457977 0.454926 0.451874 0.448883
- 0.445892 0.442932 0.440033 0.437134 0.434265 0.431427 0.428619 0.425842 0.423096 0.42038
- 0.417664 0.415009 0.412354 0.409729 0.407135 0.404572 0.402008 0.399506 0.397003 0.394501
- 0.392059 0.389618 0.387207 0.384827 0.382477 0.380127 0.377808 0.375488 0.37323 0.370972
- 0.368713 0.366516 0.364319 0.362122 0.359985 0.357849 0.355713 0.353607 0.351532 0.349457
- 0.347412 0.345398 0.343384 0.34137 0.339417 0.337463 0.33551 0.333588 0.331665 0.329773
- 0.327911 0.32605 0.324188 0.322357 0.320557 0.318756 0.316986 0.315216 0.313446 0.311707
- 0.309998 0.308289 0.30658 0.304901 0.303223 0.301575 0.299927 0.298309 0.296692 0.295074
- 0.293488 0.291931 0.290375 0.288818 0.287262 0.285736 0.284241 0.282715 0.28125 0.279755
- 0.27829 0.276825 0.275391 0.273956 0.272552 0.271118 0.269745 0.268341 0.266968 0.265594
- 0.264252 0.262909 0.261566 0.260223 0.258911 0.257599 0.256317
- 0.255035 0.25375 ) constant moog-gaintable
+vct( 0.999969 0.990082 0.980347 0.970764 0.961304 0.951996 0.94281 0.933777
+ 0.924866 0.916077 0.90741 0.898865 0.890442 0.882141 0.873962 0.865906
+ 0.857941 0.850067 0.842346 0.834686 0.827148 0.819733 0.812378 0.805145
+ 0.798004 0.790955 0.783997 0.77713 0.770355 0.763672 0.75708 0.75058
+ 0.744141 0.737793 0.731537 0.725342 0.719238 0.713196 0.707245 0.701355
+ 0.695557 0.689819 0.684174 0.678558 0.673035 0.667572 0.66217 0.65686
+ 0.651581 0.646393 0.641235 0.636169 0.631134 0.62619 0.621277 0.616425
+ 0.611633 0.606903 0.602234 0.597626 0.593048 0.588531 0.584045 0.579651
+ 0.575287 0.570953 0.566681 0.562469 0.558289 0.554169 0.550079 0.546051
+ 0.542053 0.538116 0.53421 0.530334 0.52652 0.522736 0.518982 0.515289
+ 0.511627 0.507996 0.504425 0.500885 0.497375 0.493896 0.490448 0.487061
+ 0.483704 0.480377 0.477081 0.473816 0.470581 0.467377 0.464203 0.46109
+ 0.457977 0.454926 0.451874 0.448883 0.445892 0.442932 0.440033 0.437134
+ 0.434265 0.431427 0.428619 0.425842 0.423096 0.42038 0.417664 0.415009
+ 0.412354 0.409729 0.407135 0.404572 0.402008 0.399506 0.397003 0.394501
+ 0.392059 0.389618 0.387207 0.384827 0.382477 0.380127 0.377808 0.375488
+ 0.37323 0.370972 0.368713 0.366516 0.364319 0.362122 0.359985 0.357849
+ 0.355713 0.353607 0.351532 0.349457 0.347412 0.345398 0.343384 0.34137
+ 0.339417 0.337463 0.33551 0.333588 0.331665 0.329773 0.327911 0.32605
+ 0.324188 0.322357 0.320557 0.318756 0.316986 0.315216 0.313446 0.311707
+ 0.309998 0.308289 0.30658 0.304901 0.303223 0.301575 0.299927 0.298309
+ 0.296692 0.295074 0.293488 0.291931 0.290375 0.288818 0.287262 0.285736
+ 0.284241 0.282715 0.28125 0.279755 0.27829 0.276825 0.275391 0.273956
+ 0.272552 0.271118 0.269745 0.268341 0.266968 0.265594 0.264252 0.262909
+ 0.261566 0.260223 0.258911 0.257599 0.256317 0.255035
+ 0.25375 ) constant moog-gaintable
#( 0.0 -1.0
0.03311111 -0.9
@@ -2515,55 +2659,53 @@ vct( 0.999969 0.990082 0.980347 0.970764 0.961304 0.951996 0.94281 0.933777 0.92
0.9933787 1.0
1.0 1.0 ) constant moog-freqtable
-struct
- cell% field moog-freq
- cell% field moog-Q
- cell% field moog-s
- cell% field moog-y
- cell% field moog-fc
-end-struct moog-filter%
+#( "moog-freq"
+ "moog-Q"
+ "moog-s"
+ "moog-y"
+ "moog-fc" ) create-struct make-moog-filter-struct
set-current
-: moog-frequecy@ ( gen -- frq ) moog-freq @ ;
-: moog-frequecy! ( frq gen -- )
- { frq gen }
- frq gen moog-freq !
- frq mus-srate f2/ f/ moog-freqtable 1.0 envelope-interp gen moog-fc !
+<'> moog-freq@ alias moog-frequecy@ ( gen -- frq )
+: moog-frequency! { gen frq -- }
+ gen frq moog-freq!
+ gen frq mus-srate f2/ f/ moog-freqtable 1.0 envelope-interp moog-fc!
;
: make-moog-filter ( freq Q -- gen )
- doc" Makes a new moog-filter generator. \
-FREQ is the cutoff in Hz, Q sets the resonance: 0 = no resonance, 1: oscillates at FREQUENCY."
- { freq Q }
- moog-filter% %alloc { gen }
- freq gen moog-freq !
- Q gen moog-Q !
- 4 0.0 make-vct gen moog-s !
- 0.0 gen moog-y !
- freq mus-srate f2/ f/ moog-freqtable 1.0 envelope-interp gen moog-fc !
- gen
+ doc" Make a new moog-filter generator. \
+FREQ is the cutoff in Hz, Q sets the resonance: \
+0 = no resonance, 1: oscillates at FREQUENCY."
+ { freq Q }
+ make-moog-filter-struct { gen }
+ gen freq moog-frequency!
+ gen Q moog-Q!
+ gen vct( 0.0 0.0 0.0 0.0 ) moog-s!
+ gen 0.0 moog-y!
+ gen
;
: moog-filter ( gen sig -- A )
- { gen sig }
- 0.25 sig gen moog-y @ f- f* { A }
- gen moog-s @ each { st }
- gen moog-fc @ A st f- f* A f+ -0.95 fmax 0.95 fmin to A
- gen moog-s @ i A vct-set! drop
- A st f+ -0.95 fmax 0.95 fmin to A
- end-each
- gen moog-fc @ 99.0 f* { ix }
- ix fround->s { ixint }
- ix ixint f- { ixfrac }
- A gen moog-Q @ f*
- 1.0 ixfrac f- moog-gaintable ixint 99 + vct-ref f*
- ixfrac moog-gaintable ixint 100 + vct-ref f* f+ f* gen moog-y !
- A
+ { gen sig }
+ 0.25 sig gen moog-y@ f- f* { A }
+ gen moog-s@ each { st }
+ gen moog-fc@ A st f- f* A f+ -0.95 fmax 0.95 fmin to A
+ gen moog-s@ i A vct-set! drop
+ A st f+ -0.95 fmax 0.95 fmin to A
+ end-each
+ gen moog-fc@ 99.0 f* { ix }
+ ix fround->s { ixint }
+ ix ixint f- { ixfrac }
+ A gen moog-Q@ f*
+ 1.0 ixfrac f- moog-gaintable ixint 99 + vct-ref
+ f* ixfrac moog-gaintable ixint 100 + vct-ref f* f+ f*
+ gen swap moog-y!
+ A
;
previous
\ 500.0 0.1 make-moog-filter value gen
-\ lambda: <{ y }> gen swap moog-filter ; map-channel
+\ lambda: <{ y -- val }> gen y moog-filter ; map-channel
\ gen 1.0 moog-filter
\ examp.fs ends here
diff --git a/examp.rb b/examp.rb
index 9405422..da707b6 100644
--- a/examp.rb
+++ b/examp.rb
@@ -1,8 +1,8 @@
-# examp.rb -- Guile -> Ruby translation
+# examp.rb -- something from examp.scm
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Wed Sep 04 18:34:00 CEST 2002
-# Changed: Sat Feb 19 17:17:27 CET 2011
+# Created: 02/09/04 18:34:00
+# Changed: 15/01/29 23:09:30
# module Examp (examp.scm)
# selection_rms
@@ -45,8 +45,14 @@
# fft_edit(bottom, top, snd, chn)
# fft_squelch(squelch, snd, chn)
# fft_cancel(lo_freq, hi_freq, snd, chn)
-# ramp(gen, up)
+#
+# class Ramp < Musgen
+# initialize(size)
+# run_func(up, dummy)
+# run(up)
+#
# make_ramp(size)
+# ramp(gen, up)
# squelch_vowels(snd, chn)
# fft_env_data(fft_env, snd, chn)
# fft_env_edit(fft_env, snd, chn)
@@ -69,8 +75,7 @@
# vibro(speed, depth)
# hello_dentist(freq, amp, snd, chn)
# fp(sr, osamp, osfreq, snd, chn)
-# compand(doc)
-# compand_channel(beg, dur, snd, chn, edpos)
+# compand()
# expsrc(rate, snd, chn)
# expsnd(gr_env, snd, chn)
# cross_synthesis(cross_snd, amp, fftsize, r)
@@ -83,7 +88,7 @@
# sound_interp(func, loc)
# sound_via_sound(snd1, snd2)
# env_sound_interp(envelope, time_scale, snd, chn)
-# granulated_sound_interp(envelope, time_scale, grain_length, grain_envelope, output_hop, snd, chn)
+# granulated_sound_interp(en, time_scale, grain_len, grain_env, out_hop, s, c)
# filtered_env(en, snd, chn)
#
# class Mouse
@@ -93,12 +98,6 @@
#
# files_popup_buffer(type, position, name)
#
-# class Snd_buffers
-# initialize
-# switch_to_buffer
-# open(snd)
-# close(snd)
-#
# find_click(loc)
# remove_clicks
# search_for_click
@@ -119,18 +118,6 @@
#
# chain_dsps(start, dur, *dsps)
#
-# module Cursor_follows_play
-# local_dac_func(data)
-# local_start_playing_func(snd)
-# local_stop_playing_func(snd)
-# current_cursor(snd, chn)
-# set_current_cursor(val, snd, chn)
-# original_cursor(snd, chn)
-# set_original_cursor(val, snd, chn)
-# if_cursor_follows_play_it_stays_where_play_stopped(enable)
-#
-# smooth_channel_via_ptree(beg, dur, snd, chn, edpos)
-# ring_modulate_channel(freq, beg, dur, snd, chn, edpos)
# scramble_channels(*new_order)
# scramble_channel(silence)
#
@@ -138,7 +125,8 @@
# reverse_within_blocks(block_len, snd, chn)
# sound2segment_data(main_dir, output_file)
# channel_clipped?(snd, chn)
-# scan_sound(func, beg, dur, snd) or scan_sound_rb(beg, dur, snd) do |y, chn| ... end
+# scan_sound(func, beg, dur, snd)
+# or scan_sound_rb(beg, dur, snd) do |y, chn| ... end
#
# class Moog_filter < Musgen (moog.scm)
# initialize(freq, q)
@@ -149,8 +137,6 @@
# make_moog_filter(freq, q)
# moog_filter(moog, insig)
# moog(freq, q)
-#
-# Code:
require "clm"
@@ -159,11 +145,13 @@ module Examp
#
# this mainly involves keeping track of the current sound/channel
- add_help(:selection_rms, "selection_rms() -> rms of selection data using samplers")
+ add_help(:selection_rms,
+ "selection_rms() \
+Returns rms of selection data using samplers.")
def selection_rms
if selection?
reader = make_sampler(selection_position, false, false)
- len = selection_frames
+ len = selection_framples()
sum = 0.0
len.times do
val = next_sample(reader)
@@ -176,7 +164,9 @@ module Examp
end
end
- add_help(:region_rms, "region_rms([n=0]) -> rms of region n's data (chan 0)")
+ add_help(:region_rms,
+ "region_rms(n=0) \
+Returns rms of region N's data (chan 0).")
def region_rms(n = 0)
if region?(n)
data = region2vct(n, 0, 0)
@@ -186,8 +176,9 @@ module Examp
end
end
- add_help(:window_samples, "window_samples([snd=false, [chn=false]]) \
--> samples in snd channel chn in current graph window")
+ add_help(:window_samples,
+ "window_samples(snd=false, chn=false) \
+Returns samples in snd channel chn in current graph window.")
def window_samples(snd = false, chn = false)
wl = left_sample(snd, chn)
wr = right_sample(snd, chn)
@@ -195,9 +186,11 @@ module Examp
end
add_help(:display_energy,
- "display_energy(snd, chn) \
-is a $lisp_graph_hook function to display the time domain data as energy (squared).
-$lisp_graph_hook.add_hook!(\"display-energy\", &method(:display_energy).to_proc)")
+ "display_energy(snd, chn) \
+Is a $lisp_graph_hook function to display the time domain \
+data as energy (squared):
+$lisp_graph_hook.add_hook!(\"display-energy\", \
+&method(:display_energy).to_proc)")
def display_energy(snd, chn)
ls = left_sample(snd, chn)
rs = right_sample(snd, chn)
@@ -212,8 +205,8 @@ $lisp_graph_hook.add_hook!(\"display-energy\", &method(:display_energy).to_proc)
end
add_help(:display_db,
- "display_db(snd, chn) \
-is a lisp-graph-hook function to display the time domain data in dB.
+ "display_db(snd, chn) \
+Is a $lisp_graph_hook function to display the time domain data in dB:
$lisp_graph_hook.add_hook!(\"display-db\", &method(:display_db).to_proc)")
def display_db(snd, chn)
if datal = make_graph_data(snd, chn)
@@ -233,7 +226,9 @@ $lisp_graph_hook.add_hook!(\"display-db\", &method(:display_db).to_proc)")
end
end
- add_help(:window_rms, "window_rms() -> rms of data in currently selected graph window")
+ add_help(:window_rms,
+ "window_rms() \
+Returns rms of data in currently selected graph window.")
def window_rms
ls = left_sample
rs = right_sample
@@ -242,13 +237,16 @@ $lisp_graph_hook.add_hook!(\"display-db\", &method(:display_db).to_proc)")
end
add_help(:fft_peak,
- "fft_peak(snd, chn, scale) returns the peak spectral magnitude
+ "fft_peak(snd, chn, scale) \
+Returns the peak spectral magnitude:
$after_transform_hook.add_hook!(\"fft-peak\") do |snd, chn, scale|
fft_peak(snd, chn, scale)
end")
def fft_peak(snd, chn, scale)
if transform_graph? and transform_graph_type == Graph_once
- report_in_minibuffer(((2.0 * vct_peak(transform2vct(snd, chn))) / transform_size).to_s, snd)
+ pk = (2.0 * vct_peak(transform2vct(snd, chn))) / transform_size
+ status_report(pk.to_s, snd)
+ pk
else
false
end
@@ -256,14 +254,16 @@ end")
# 'info' from extsnd.html using format
- add_help(:finfo, "finfo(file) -> description (as a string) of file")
+ add_help(:finfo,
+ "finfo(file) \
+Returns description (as a string) of FILE.")
def finfo(file)
chans = mus_sound_chans(file)
sr = mus_sound_srate(file)
format("%s: chans: %d, srate: %d, %s, %s, len: %1.3f",
file, chans, sr,
mus_header_type_name(mus_sound_header_type(file)),
- mus_data_format_name(mus_sound_data_format(file)),
+ mus_sample_type_name(mus_sound_sample_type(file)),
mus_sound_samples(file).to_f / (chans * sr.to_f))
end
@@ -272,14 +272,14 @@ end")
# correlation of channels in a stereo sound
add_help(:display_correlate,
- "display_correlate(snd, chn, y0, y1) \
-returns the correlation of snd's 2 channels (intended for use with $graph_hook)
+ "display_correlate(snd, chn, y0, y1) \
+Returns the correlation of SND's 2 channels (intended for use with $graph_hook):
$graph_hook.add_hook!(\"display_correlate\") do |snd, chn, y0, y1|
display_correlate(snd, chn, y0, y1)
end")
def display_correlate(snd, chn, y0, y1)
- if channels(snd) == 2 and frames(snd, 0) > 1 and frames(snd, 1) > 1
+ if channels(snd) == 2 and framples(snd, 0) > 1 and framples(snd, 1) > 1
ls = left_sample(snd, 0)
rs = right_sample(snd, 0)
ilen = 1 + (rs - ls)
@@ -307,7 +307,7 @@ end")
vct_scale!(data3, fftscale)
graph(data3, "lag time", 0, fftlen2)
else
- report_in_minibuffer("correlate wants stereo input")
+ snd_print("correlate wants stereo input")
end
end
@@ -316,25 +316,30 @@ end")
# also zoom spectrum based on y-axis zoom slider
add_help(:zoom_spectrum,
- "zoom_spectrum(snd, chn, y0, y1) \
-sets the transform size to correspond to the time-domain window size (use with $graph_hook)
+ "zoom_spectrum(snd, chn, y0, y1) \
+Sets the transform size to correspond to the \
+time-domain window size (use with $graph_hook):
$graph_hook.add_hook!(\"zoom-spectrum\") do |snd, chn, y0, y1|
zoom_spectrum(snd, chn, y0, y1)
end")
def zoom_spectrum(snd, chn, y0, y1)
- if transform_graph?(snd, chn) and transform_graph_type(snd, chn) == Graph_once
- set_transform_size((2 ** (log(right_sample(snd, chn)-left_sample(snd, chn))/log(2.0))).to_i,
- snd, chn)
+ if transform_graph?(snd, chn) and
+ transform_graph_type(snd, chn) == Graph_once
+ set_transform_size((2 **
+ (log(right_sample(snd, chn) -
+ left_sample(snd, chn))/log(2.0))).to_i, snd, chn)
set_spectrum_end(y_zoom_slider(snd, chn), snd, chn)
end
false
end
add_help(:zoom_fft,
- "zoom_fft(snd, chn, y0, y1) \
-sets the transform size if the time domain is not displayed (use with $graph_hook)
-It also sets the spectrum display start point based on the x position slider---\
-this can be confusing if fft normalization is on (the default)
+ "zoom_fft(snd, chn, y0, y1) \
+Sets the transform size if the time domain is \
+not displayed (use with $graph_hook). \
+It also sets the spectrum display start point \
+based on the x position slider---this can be confusing \
+if fft normalization is on (the default):
$graph_hook.add_hook!(\"zoom-fft\") do |snd, chn, y0, y1|
zoom_fft(snd, chn, y0, y1)
end")
@@ -342,8 +347,9 @@ end")
if transform_graph?(snd, chn) and
(not time_graph?(snd, chn)) and
transform_graph_type(snd, chn) == Graph_once
- set_transform_size(2 ** (log(right_sample(snd, chn) - left_sample(snd, chn)) / log(2.0)).ceil,
- snd, chn)
+ set_transform_size(2 **
+ (log(right_sample(snd, chn) -
+ left_sample(snd, chn)) / log(2.0)).ceil, snd, chn)
set_spectrum_start(x_position_slider(snd, chn), snd, chn)
set_spectrum_end(y_zoom_slider(snd, chn), snd, chn)
end
@@ -353,8 +359,8 @@ end")
# superimpose spectra of sycn'd sounds
add_help(:superimpose_ffts,
- "superimpose_ffts(snd, chn, y0, y1) \
-superimposes ffts of multiple (syncd) sounds (use with $graph_hook)
+ "superimpose_ffts(snd, chn, y0, y1) \
+Superimposes ffts of multiple (syncd) sounds (use with $graph_hook):
$graph_hook.add_hook!(\"superimpose-ffts\") do |snd, chn, y0, y1|
superimpose_ffts(snd, chn, y0, y1)
end")
@@ -387,8 +393,9 @@ end")
# c-g? example (Anders Vinjar)
add_help(:locate_zero,
- "locate_zero(limit) \
-looks for successive samples that sum to less than 'limit', moving the cursor if successful")
+ "locate_zero(limit) \
+Looks for successive samples that sum to less than LIMIT, \
+moving the cursor if successful.")
def locate_zero(limit)
start = cursor
sf = make_sampler(start, false, false)
@@ -409,8 +416,10 @@ looks for successive samples that sum to less than 'limit', moving the cursor if
# or to play a sound whenever a file is closed:
# $close-hook.add_hook!() do |snd| shell("sndplay wood16.wav"); false end
- add_help(:shell, "shell(cmd, *rest) \
-sends 'cmd' to a shell (executes it as a shell command) and returns the result string.")
+ add_help(:shell,
+ "shell(cmd, *rest) \
+Sends CMD to a shell (executes it as a shell command) \
+and returns the result string.")
def shell(cmd, *rest)
str = ""
unless cmd.null?
@@ -421,10 +430,13 @@ sends 'cmd' to a shell (executes it as a shell command) and returns the result s
# translate mpeg input to 16-bit linear and read into Snd
#
- # mpg123 with the -s switch sends the 16-bit (mono or stereo) representation of
- # an mpeg file to stdout. There's also apparently a switch to write 'wave' output.
+ # mpg123 with the -s switch sends the 16-bit (mono or stereo) representation
+ # of an mpeg file to stdout. There's also apparently a switch to write
+ # 'wave' output.
- add_help(:mpg, "mpg(file, tmpname) converts file from MPEG to raw 16-bit samples using mpg123
+ add_help(:mpg,
+ "mpg(file, tmpname) \
+Converts file from MPEG to raw 16-bit samples using mpg123: \
mpg(\"mpeg.mpg\", \"mpeg.raw\")")
def mpg(mpgfile, rawfile)
b0 = b1 = b2 = b3 = 0
@@ -443,26 +455,28 @@ mpg(\"mpeg.mpg\", \"mpeg.raw\")")
srate_index = (b2 & 0b1100) >> 2
channel_mode = (b3 & 0b11000000) >> 6
if id == 1
- Snd.display("odd: %s is using a reserved Version ID", mpgfile.inspect)
+ Snd.display("odd: %s is using a reserved Version ID", mpgfile)
end
if layer == 0
- Snd.display("odd: %s is using a reserved layer description", mpgfile.inspect)
+ Snd.display("odd: %s is using a reserved layer description", mpgfile)
end
chans = channel_mode == 3 ? 1 : 2
mpegnum = id.zero? ? 4 : (id == 2 ? 2 : 1)
mpeg_layer = layer == 3 ? 1 : (layer == 2 ? 2 : 3)
srate = [44100, 48000, 32000, 0][srate_index] / mpegnum
Snd.display("%s: %s Hz, %s, MPEG-%s",
- mpgfile.inspect, srate, chans == 1 ? "mono": "stereo", mpeg_layer)
+ mpgfile, srate, chans == 1 ? "mono": "stereo", mpeg_layer)
system(format("mpg123 -s %s > %s", mpgfile, rawfile))
- open_raw_sound(rawfile, chans, srate, little_endian? ? Mus_lshort : Mus_bshort)
+ open_raw_sound(rawfile, chans, srate,
+ little_endian? ? Mus_lshort : Mus_bshort)
end
end
# read and write OGG files
add_help(:read_ogg,
- "read_ogg(filename) read OGG files
+ "read_ogg(filename) \
+Read OGG files:
$open_hook.add_hook!(\"read-ogg\") do |filename|
if mus_sound_header_type(filename) == Mus_raw
read_ogg(filename)
@@ -473,11 +487,14 @@ end")
def read_ogg(filename)
flag = false
File.open(filename, "r") do |fd|
- flag = fd.readchar == ?O and fd.readchar == ?g and fd.readchar == ?g and fd.readchar == ?S
+ flag = fd.readchar == ?O and
+ fd.readchar == ?g and
+ fd.readchar == ?g and
+ fd.readchar == ?S
end
if flag
aufile = filename + ".au"
- File.unlink(aufile) if File.exists?(aufile)
+ File.unlink(aufile) if File.exist?(aufile)
system(format("ogg123 -d au -f %s %s", aufile, filename))
aufile
else
@@ -488,7 +505,7 @@ end")
def write_ogg(snd)
if edits(snd)[0] > 0 or header_type(snd) != Mus_riff
file = file_name(snd) + ".tmp"
- save_sound_as(file, snd, Mus_riff)
+ save_sound_as(file, snd, :header_type, Mus_riff)
system("oggenc " + file)
File.unlink(file)
else
@@ -500,7 +517,7 @@ end")
def read_speex(filename)
wavfile = filename + ".wav"
- File.unlink(wavfile) if File.exists?(wavfile)
+ File.unlink(wavfile) if File.exist?(wavfile)
system(format("speexdec %s %s", filename, wavfile))
wavfile
end
@@ -509,7 +526,7 @@ end")
if edits(snd)[0] > 0 or header_type(snd) != Mus_riff
file = file_name(snd) + ".wav"
spxfile = file_name(snd) + "spx"
- save_sound_as(file, snd, Mus_riff)
+ save_sound_as(file, snd, :header_type, Mus_riff)
system(format("speexenc %s %s", file, spxfile))
File.unlink(file)
else
@@ -526,7 +543,7 @@ end")
def write_flac(snd)
if edits(snd)[0] > 0 or header_type(snd) != Mus_riff
file = file_name(snd) + ".wav"
- save_sound_as(file, snd, Mus_riff)
+ save_sound_as(file, snd, :header_type, Mus_riff)
system(format("flac %s", file))
File.unlink(file)
else
@@ -545,8 +562,8 @@ end")
out_format = Mus_bshort,
out_srate = 44100)
in_buffer = IO.readlines(in_filename) # array of strings
- out_snd = new_sound(out_filename, out_type, out_format, out_srate, 1,
- format("created by %s: %s", get_func_name, in_filename))
+ com = format("created by %s: %s", get_func_name, in_filename)
+ out_snd = new_sound(out_filename, 1, out_srate, out_format, out_type, com)
bufsize = 512
data = make_vct(bufsize)
loc = 0
@@ -578,8 +595,9 @@ end")
# many samples are displayed, etc
add_help(:auto_dot,
- "auto_dot(snd, chn, y0, y1) \
-sets the dot size depending on the number of samples being displayed (use with $graph_hook)
+ "auto_dot(snd, chn, y0, y1) \
+Sets the dot size depending on the number \
+of samples being displayed (use with $graph_hook):
$graph_hook.add_hook!(\"auto-dot\") do |snd, chn, y0, y1|
auto_dot(snd, chn, y0, y1)
end")
@@ -606,8 +624,8 @@ end")
# control) will move the window left edge to that mark.
add_help(:first_mark_in_window_at_left,
- "first_mark_in_window_at_left() \
-moves the graph so that the leftmost visible mark is at the left edge
+ "first_mark_in_window_at_left() \
+Moves the graph so that the leftmost visible mark is at the left edge:
bind_key(?m, 0, lambda do | | first_mark_in_window_at_left end)")
def first_mark_in_window_at_left
keysnd = Snd.snd
@@ -615,11 +633,15 @@ bind_key(?m, 0, lambda do | | first_mark_in_window_at_left end)")
current_left_sample = left_sample(keysnd, keychn)
chan_marks = marks(keysnd, keychn)
if chan_marks.null?
- report_in_minibuffer("no marks!")
+ snd_print("no marks!")
else
- leftmost = chan_marks.map do |m| mark_sample(m) end.detect do |m| m > current_left_sample end
+ leftmost = chan_marks.map do |m|
+ mark_sample(m)
+ end.detect do |m|
+ m > current_left_sample
+ end
if leftmost.null?
- report_in_minibuffer("no mark in window")
+ snd_print("no mark in window")
else
set_left_sample(leftmost, keysnd, keychn)
Keyboard_no_action
@@ -630,7 +652,8 @@ bind_key(?m, 0, lambda do | | first_mark_in_window_at_left end)")
# flash selected data red and green
add_help(:flash_selected_data,
- "flash_selected_data(millisecs) causes the selected data to flash red and green")
+ "flash_selected_data(millisecs) \
+Causes the selected data to flash red and green.")
def flash_selected_data(interval)
if selected_sound
set_selected_data_color(selected_data_color == Red ? Green : Red)
@@ -641,7 +664,8 @@ bind_key(?m, 0, lambda do | | first_mark_in_window_at_left end)")
# use loop info (if any) to set marks at loop points
add_help(:mark_loops,
- "mark_loops() places marks at loop points found in the selected sound's header")
+ "mark_loops() \
+Places marks at loop points found in the selected sound's header.")
def mark_loops
loops = (sound_loop_info or mus_sound_loop_info(file_name))
if loops and !loops.empty?
@@ -663,7 +687,8 @@ bind_key(?m, 0, lambda do | | first_mark_in_window_at_left end)")
add_help(:do_all_chans,
"do_all_chans(edhist) do |y| ... end \
-applies func to all active channels, using edhist as the edit history indication:
+Applies func to all active channels, \
+using EDHIST as the edit history indication: \
do_all_chans(\"double all samples\", do |val| 2.0 * val end)")
def do_all_chans(origin, &func)
Snd.sounds.each do |snd|
@@ -673,7 +698,9 @@ do_all_chans(\"double all samples\", do |val| 2.0 * val end)")
end
end
- add_help(:update_graphs, "update_graphs() updates (redraws) all graphs")
+ add_help(:update_graphs,
+ "update_graphs() \
+Updates (redraws) all graphs.")
def update_graphs
Snd.sounds.each do |snd|
channels(snd).times do |chn|
@@ -684,14 +711,16 @@ do_all_chans(\"double all samples\", do |val| 2.0 * val end)")
add_help(:do_chans,
"do_chans(edhist) do |y| ... end \
-applies func to all sync'd channels using edhist as the edit history indication")
+Applies func to all sync'd channels using EDHIST \
+as the edit history indication.")
def do_chans(*origin, &func)
snc = sync
if snc > 0
Snd.sounds.each do |snd|
channels(snd).times do |chn|
if sync(snd) == snc
- map_channel(func, 0, false, snd, chn, false, (origin.empty? ? "" : format(*origin)))
+ map_channel(func, 0, false, snd, chn, false,
+ (origin.empty? ? "" : format(*origin)))
end
end
end
@@ -702,11 +731,13 @@ applies func to all sync'd channels using edhist as the edit history indication"
add_help(:do_sound_chans,
"do_sound_chans(edhist) do |y| ... end \
-applies func to all selected channels using edhist as the edit history indication")
+Applies func to all selected channels using EDHIST \
+as the edit history indication.")
def do_sound_chans(*origin, &func)
if snd = selected_sound
channels(snd).times do |chn|
- map_channel(func, 0, false, snd, chn, false, (origin.empty? ? "" : format(*origin)))
+ map_channel(func, 0, false, snd, chn, false,
+ (origin.empty? ? "" : format(*origin)))
end
else
snd_warning("no selected sound")
@@ -715,18 +746,22 @@ applies func to all selected channels using edhist as the edit history indicatio
add_help(:every_sample?,
"every_sample? do |y| ... end \
--> true if func is not false for all samples in the current channel, \
-otherwise it moves the cursor to the first offending sample")
+Returns true if func is not false for all samples in the current channel, \
+otherwise it moves the cursor to the first offending sample.")
def every_sample?(&func)
snd = Snd.snd
chn = Snd.chn
- if baddy = scan_channel(lambda do |y| (not func.call(y)) end, 0, frames(snd, chn), snd, chn)
+ if baddy = scan_channel(lambda do |y|
+ (not func.call(y))
+ end, 0, framples(snd, chn), snd, chn)
set_cursor(baddy[1])
end
(not baddy)
end
- add_help(:sort_samples, "sort_samples(bins) provides a histogram in 'bins' bins")
+ add_help(:sort_samples,
+ "sort_samples(bins) \
+Provides a histogram in BINS bins.")
def sort_samples(nbins)
bins = make_array(nbins, 0)
scan_channel(lambda do |y|
@@ -740,37 +775,43 @@ otherwise it moves the cursor to the first offending sample")
# mix mono sound into stereo sound panning according to env
add_help(:place_sound,
- "place_sound(mono_snd, stereo_snd, pan_env) \
-mixes a mono sound into a stereo sound, splitting it into two copies \
-whose amplitudes depend on the envelope 'pan-env'. \
-If 'pan-env' is a number, the sound is split such that 0 is all in channel 0 \
+ "place_sound(mono_snd, stereo_snd, pan_env) \
+Mixes a mono sound into a stereo sound, splitting it into two copies \
+whose amplitudes depend on the envelope PAN_ENV. \
+If PAN_ENV is a number, \
+the sound is split such that 0 is all in channel 0 \
and 90 is all in channel 1.")
def place_sound(mono_snd, stereo_snd, pan_env)
- len = frames(mono_snd)
+ len = framples(mono_snd)
if number?(pan_env)
pos = pan_env / 90.0
rd0 = make_sampler(0, mono_snd, false)
rd1 = make_sampler(0, mono_snd, false)
- map_channel(lambda do |y| y + pos * read_sample(rd1) end, 0, len, stereo_snd, 1)
- map_channel(lambda do |y| y + (1.0 - pos) * read_sample(rd0) end, 0, len, stereo_snd, 0)
+ map_channel(lambda do |y| y + pos * read_sample(rd1) end,
+ 0, len, stereo_snd, 1)
+ map_channel(lambda do |y| y + (1.0 - pos) * read_sample(rd0) end,
+ 0, len, stereo_snd, 0)
else
e0 = make_env(:envelope, pan_env, :length, len)
e1 = make_env(:envelope, pan_env, :length, len)
rd0 = make_sampler(0, mono_snd, false)
rd1 = make_sampler(0, mono_snd, false)
- map_channel(lambda do |y| y + env(e1) * read_sample(rd1) end, 0, len, stereo_snd, 1)
- map_channel(lambda do |y| y + (1.0 - env(e0)) * read_sample(rd0) end, 0, len, stereo_snd, 0)
+ map_channel(lambda do |y| y + env(e1) * read_sample(rd1) end,
+ 0, len, stereo_snd, 1)
+ map_channel(lambda do |y| y + (1.0 - env(e0)) * read_sample(rd0) end,
+ 0, len, stereo_snd, 0)
end
end
# FFT-based editing
add_help(:fft_edit,
- "fft_edit(low_Hz, high_Hz) \
-ffts an entire sound, removes all energy below low-Hz and all above high-Hz, then inverse ffts.")
+ "fft_edit(low_Hz, high_Hz) \
+Ffts an entire sound, removes all energy below low-Hz and all above high-Hz, \
+then inverse ffts.")
def fft_edit(bottom, top, snd = false, chn = false)
sr = srate(snd).to_f
- len = frames(snd, chn)
+ len = framples(snd, chn)
fsize = (2.0 ** (log(len) / log(2.0)).ceil).to_i
rdata = channel2vct(0, fsize, snd, chn)
idata = make_vct(fsize)
@@ -791,14 +832,16 @@ ffts an entire sound, removes all energy below low-Hz and all above high-Hz, the
end
fft(rdata, idata, -1)
vct_scale!(rdata, 1.0 / fsize)
- vct2channel(rdata, 0, len - 1, snd, chn, false, format("%s(%s, %s", get_func_name, bottom, top))
+ vct2channel(rdata, 0, len - 1, snd, chn, false,
+ format("%s(%s, %s", get_func_name, bottom, top))
end
add_help(:fft_squelch,
- "fft_squelch(squelch, [snd=false, [chn=false]]) \
-ffts an entire sound, sets all bins to 0.0 whose energy is below squelch, then inverse ffts")
+ "fft_squelch(squelch, snd=false, chn=false) \
+Ffts an entire sound, sets all bins to 0.0 whose energy is below squelch, \
+then inverse ffts.")
def fft_squelch(squelch, snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
fsize = (2.0 ** (log(len) / log(2.0)).ceil).to_i
rdata = channel2vct(0, fsize, snd, chn)
idata = make_vct(fsize)
@@ -819,16 +862,18 @@ ffts an entire sound, sets all bins to 0.0 whose energy is below squelch, then i
end
fft(rdata, idata, -1)
vct_scale!(rdata, 1.0 / fsize)
- vct2channel(rdata, 0, len - 1, snd, chn, false, format("%s(%s", get_func_name, squelch))
+ vct2channel(rdata, 0, len - 1, snd, chn, false,
+ format("%s(%s", get_func_name, squelch))
scaler
end
add_help(:fft_cancel,
- "fft_cancel(lo_freq, hi_freq, [snd=false, [chn=false]]) \
-ffts an entire sound, sets the bin(s) representing lo_freq to hi_freq to 0.0, then inverse ffts")
+ "fft_cancel(lo_freq, hi_freq, snd=false, chn=false) \
+Ffts an entire sound, sets the bin(s) representing lo_freq to hi_freq to 0.0, \
+then inverse ffts.")
def fft_cancel(lo_freq, hi_freq, snd = false, chn = false)
sr = srate(snd).to_f
- len = frames(snd, chn)
+ len = framples(snd, chn)
fsize = (2.0 ** (log(len) / log(2.0)).ceil).to_i
rdata = channel2vct(0, fsize, snd, chn)
idata = make_vct(fsize)
@@ -853,57 +898,88 @@ ffts an entire sound, sets the bin(s) representing lo_freq to hi_freq to 0.0, th
# same idea but used to distinguish vowels (steady-state) from consonants
- add_help(:ramp,
- "ramp(gen, up) \
-is a kind of CLM generator that produces a ramp of a given length, \
-then sticks at 0.0 or 1.0 until the 'up' argument changes")
- def ramp(gen, up)
- ctr, size = gen[0, 2]
- val = ctr / size
- gen[0] = [size, [0, ctr + (up ? 1 : -1)].max].min
- val
+ class Ramp < Musgen
+ def initialize(size = 128)
+ super()
+ @val = 0.0
+ @size = size
+ @incr = 1.0 / size
+ @up = true
+ end
+
+ def inspect
+ format("%s.new(%d)", self.class, @size)
+ end
+
+ def to_s
+ format("#<%s size: %d, val: %1.3f, incr: %1.3f, up: %s>",
+ self.class, @size, @val, @incr, @up)
+ end
+
+ def run_func(up = true, dummy = false)
+ @up = up
+ @val += (@up ? @incr : - at incr)
+ @val = [1.0, [0.0, @val].max].min
+ end
+
+ def run(up = true)
+ self.run_func(up, false)
+ end
end
- add_help(:make_ramp, "make_ramp([size=128]) returns a ramp generator")
+ add_help(:make_ramp,
+ "make_ramp(size=128) \
+Returns a ramp generator.")
def make_ramp(size = 128)
- [0, size]
+ Ramp.new(size)
+ end
+
+ add_help(:ramp,
+ "ramp(gen, up) \
+Is a kind of CLM generator that produces a ramp of a given length, \
+then sticks at 0.0 or 1.0 until the UP argument changes.")
+ def ramp(gen, up)
+ gen.run_func(up, false)
end
add_help(:squelch_vowels,
- "squelch_vowels([snd=false, [chn=false]]) \
-suppresses portions of a sound that look like steady-state")
+ "squelch_vowels(snd=false, chn=false) \
+Suppresses portions of a sound that look like steady-state.")
def squelch_vowels(snd = false, chn = false)
fft_size = 32
- fft_mid = fft_size / 2
- rl = make_vct(fft_size)
- im = make_vct(fft_size)
- ramper = make_ramp(256)
- peak = maxamp / fft_mid
+ fft_mid = (fft_size / 2.0).floor
+ ramper = Ramp.new(256)
+ peak = maxamp(snd, chn) / fft_mid
read_ahead = make_sampler(0, snd, chn)
+ rl = Vct.new(fft_size) do
+ read_sample(read_ahead)
+ end
+ im = Vct.new(fft_size, 0.0)
ctr = fft_size - 1
- ctr.times do |i| rl[i] = read_sample(read_ahead) end
in_vowel = false
map_channel(lambda do |y|
- rl[ctr] = read_sample(read_ahead)
ctr += 1
if ctr == fft_size
+ ctr = 0
fft(rl, im, 1)
- vct_multiply!(rl, rl)
- vct_multiply!(im, im)
- vct_add!(rl, im)
+ rl.multiply!(rl)
+ im.multiply!(im)
+ rl.add!(im)
+ im.fill(0.0)
in_vowel = (rl[0] + rl[1] + rl[2] + rl[3]) > peak
- vct_fill!(im, 0.0)
- ctr = 0
+ rl.map! do
+ read_sample(read_ahead)
+ end
end
- y * (1.0 - ramp(ramper, in_vowel))
+ y * (1.0 - ramper.run(in_vowel))
end, 0, false, snd, chn, false, "squelch_vowels(")
end
add_help(:fft_env_data,
- "fft_env_data(fft-env, [snd=false, [chn=false]]) \
-applies fft_env as spectral env to current sound, returning vct of new data")
+ "fft_env_data(fft-env, snd=false, chn=false) \
+Applies fft_env as spectral env to current sound, returning vct of new data.")
def fft_env_data(fft_env, snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
fsize = (2 ** (log(len) / log(2.0)).ceil).to_i
rdata = channel2vct(0, fsize, snd, chn)
idata = make_vct(fsize)
@@ -924,33 +1000,36 @@ applies fft_env as spectral env to current sound, returning vct of new data")
end
add_help(:fft_env_edit,
- "fft_env_edit(fft-env, [snd=false, [chn=false]]) \
-edits (filters) current chan using fft_env")
+ "fft_env_edit(fft-env, snd=false, chn=false) \
+Edits (filters) current chan using fft_env.")
def fft_env_edit(fft_env, snd = false, chn = false)
- vct2channel(fft_env_data(fft_env, snd, chn), 0, frames(snd, chn) - 1, snd, chn, false,
+ vct2channel(fft_env_data(fft_env, snd, chn), 0, framples(snd, chn) - 1,
+ snd, chn, false,
format("%s(%s", get_func_name, fft_env.inspect))
end
add_help(:fft_env_interp,
- "fft_env_interp(env1, env2, interp, [snd=false, [chn=false]]) \
-interpolates between two fft-filtered versions (env1 and env2 are the spectral envelopes) \
-following interp (an env between 0 and 1)")
+ "fft_env_interp(env1, env2, interp, snd=false, chn=false) \
+Interpolates between two fft-filtered \
+versions (env1 and env2 are the spectral envelopes) \
+following interp (an env between 0 and 1).")
def fft_env_interp(env1, env2, interp, snd = false, chn = false)
data1 = fft_env_data(env1, snd, chn)
data2 = fft_env_data(env2, snd, chn)
- len = frames(snd, chn)
+ len = framples(snd, chn)
en = make_env(:envelope, interp, :length, len)
new_data = make_vct!(len) do |i|
pan = env(en)
(1.0 - pan) * data1[i] + pan * data2[i]
end
vct2channel(new_data, 0, len - 1, snd, chn, false,
- format("%s(%s, %s, %s", get_func_name, env1.inspect, env2.inspect, interp.inspect))
+ format("%s(%s, %s, %s", get_func_name,
+ env1.inspect, env2.inspect, interp.inspect))
end
add_help(:fft_smoother,
- "fft_smoother(cutoff, start, samps, [snd=false, [chn=false]]) \
-uses fft-filtering to smooth a section:
+ "fft_smoother(cutoff, start, samps, snd=false, chn=false) \
+Uses fft-filtering to smooth a section: \
vct2channel(fft_smoother(0.1, cursor, 400, 0, 0), cursor, 400)")
def fft_smoother(cutoff, start, samps, snd = false, chn = false)
fftpts = (2 ** (log(samps + 1) / log(2.0)).ceil).to_i
@@ -987,9 +1066,10 @@ vct2channel(fft_smoother(0.1, cursor, 400, 0, 0), cursor, 400)")
# comb-filter
add_help(:comb_filter,
- "comb_filter(scaler, size) \
-returns a comb-filter ready for map_channel etc: map_channel(comb_filter(0.8, 32)). \
-If you're in a hurry use: clm_channel(make_comb(0.8, 32)) instead")
+ "comb_filter(scaler, size) \
+Returns a comb-filter ready for map_channel etc: \
+map_channel(comb_filter(0.8, 32)) \
+If you're in a hurry use: clm_channel(make_comb(0.8, 32)) instead.")
def comb_filter(scaler, size)
cmb = make_comb(scaler, size)
lambda do |inval| comb(cmb, inval) end
@@ -998,41 +1078,46 @@ If you're in a hurry use: clm_channel(make_comb(0.8, 32)) instead")
# by using filters at harmonically related sizes, we can get chords:
add_help(:comb_chord,
- "comb_chord(scaler, size, amp, [interval_one=0.75, [interval_two=1.2]]) \
-returns a set of harmonically-related comb filters: map_channel(comb_chord(0.95, 100, 0.3))")
+ "comb_chord(scl, size, amp, interval_one=0.75, interval_two=1.2) \
+Returns a set of harmonically-related comb filters: \
+map_channel(comb_chord(0.95, 100, 0.3))")
def comb_chord(scaler, size, amp, interval_one = 0.75, interval_two = 1.2)
c1 = make_comb(scaler, size.to_i)
c2 = make_comb(scaler, (interval_one * size).to_i)
c3 = make_comb(scaler, (interval_two * size).to_i)
- lambda do |inval| amp * (comb(c1, inval) + comb(c2, inval) + comb(c3, inval)) end
+ lambda do |inval|
+ amp * (comb(c1, inval) + comb(c2, inval) + comb(c3, inval))
+ end
end
# or change the comb length via an envelope:
add_help(:zcomb,
- "zcomb(scaler, size, pm) \
-returns a comb filter whose length varies according to an envelope: \
+ "zcomb(scaler, size, pm) \
+Returns a comb filter whose length varies according to an envelope: \
map_channel(zcomb(0.8, 32, [0, 0, 1, 10]))")
def zcomb(scaler, size, pm)
max_envelope_1 = lambda do |en, mx|
1.step(en.length - 1, 2) do |i| mx = [mx, en[i]].max.to_f end
mx
end
- cmb = make_comb(scaler, size, :max_size, (max_envelope_1.call(pm, 0.0) + size + 1).to_i)
- penv = make_env(:envelope, pm, :length, frames)
+ cmb = make_comb(scaler, size,
+ :max_size, (max_envelope_1.call(pm, 0.0) + size + 1).to_i)
+ penv = make_env(:envelope, pm, :length, framples())
lambda do |inval| comb(cmb, inval, env(penv)) end
end
add_help(:notch_filter,
- "notch_filter(scaler, size) returns a notch-filter: map_channel(notch_filter(0.8, 32))")
+ "notch_filter(scaler, size) \
+Returns a notch-filter: map_channel(notch_filter(0.8, 32))")
def notch_filter(scaler, size)
gen = make_notch(scaler, size)
lambda do |inval| notch(gen, inval) end
end
add_help(:formant_filter,
- "formant_filter(radius, frequency) \
-returns a formant generator: map_channel(formant_filter(0.99, 2400)). \
+ "formant_filter(radius, frequency) \
+Returns a formant generator: map_channel(formant_filter(0.99, 2400)) \
Faster is: filter_sound(make_formant(2400, 0.99))")
def formant_filter(radius, freq)
frm = make_formant(radius, freq)
@@ -1042,22 +1127,25 @@ Faster is: filter_sound(make_formant(2400, 0.99))")
# to impose several formants, just add them in parallel:
add_help(:formants,
- "formants(r1, f1, r2, f2, r3, f3) \
-returns 3 formant filters in parallel: map_channel(formants(0.99, 900, 0.98, 1800, 0.99 2700))")
+ "formants(r1, f1, r2, f2, r3, f3) \
+Returns 3 formant filters in parallel: \
+map_channel(formants(0.99, 900, 0.98, 1800, 0.99 2700))")
def formants(r1, f1, r2, f2, r3, f3)
fr1 = make_formant(f1, r1)
fr2 = make_formant(f2, r2)
fr3 = make_formant(f3, r3)
- lambda do |inval| formant(fr1, inval) + formant(fr2, inval) + formant(fr3, inval) end
+ lambda do |inval|
+ formant(fr1, inval) + formant(fr2, inval) + formant(fr3, inval)
+ end
end
add_help(:moving_formant,
- "moving_formant(radius, move) \
-returns a time-varying (in frequency) formant filter: \
+ "moving_formant(radius, move) \
+Returns a time-varying (in frequency) formant filter: \
map_channel(moving_formant(0.99, [0, 1200, 1, 2400]))")
def moving_formant(radius, move)
frm = make_formant(move[1], radius)
- menv = make_env(:envelope, move, :length, frames)
+ menv = make_env(:envelope, move, :length, framples())
lambda do |inval|
val = formant(frm, inval)
frm.frequency = env(menv)
@@ -1066,8 +1154,9 @@ map_channel(moving_formant(0.99, [0, 1200, 1, 2400]))")
end
add_help(:osc_formants,
- "osc_formants(radius, bases, amounts, freqs) \
-set up any number of independently oscillating formants, then calls map_channel: \
+ "osc_formants(radius, bases, amounts, freqs) \
+Set up any number of independently oscillating formants, \
+then calls map_channel: \
osc_formants(0.99, vct(400, 800, 1200), vct(400, 800, 1200), vct(4, 2, 3))")
def osc_formants(radius, bases, amounts, freqs)
len = bases.length
@@ -1085,7 +1174,9 @@ osc_formants(0.99, vct(400, 800, 1200), vct(400, 800, 1200), vct(4, 2, 3))")
# echo
- add_help(:echo, "echo(scaler, secs) returns an echo maker: map_channel(echo(0.5, 0.5), 0 44100)")
+ add_help(:echo,
+ "echo(scaler, secs) \
+Returns an echo maker: map_channel(echo(0.5, 0.5), 0 44100)")
def echo(scaler, secs)
del = make_delay((secs * srate()).round)
lambda do |inval|
@@ -1094,8 +1185,9 @@ osc_formants(0.99, vct(400, 800, 1200), vct(400, 800, 1200), vct(4, 2, 3))")
end
add_help(:zecho,
- "zecho(scaler, secs, freq, amp) \
-returns a modulated echo maker: map_channel(zecho(0.5, 0.75, 6, 10.0), 0, 65000)")
+ "zecho(scaler, secs, freq, amp) \
+Returns a modulated echo maker: \
+map_channel(zecho(0.5, 0.75, 6, 10.0), 0, 65000)")
def zecho(scaler, secs, freq, amp)
os = make_oscil(freq)
len = (secs * srate()).round
@@ -1106,8 +1198,9 @@ returns a modulated echo maker: map_channel(zecho(0.5, 0.75, 6, 10.0), 0, 65000)
end
add_help(:flecho,
- "flecho(scaler, secs]) \
-returns a low-pass filtered echo maker: map_channel(flecho(0.5, 0.9), 0, 75000)" )
+ "flecho(scaler, secs) \
+Returns a low-pass filtered echo maker: \
+map_channel(flecho(0.5, 0.9), 0, 75000)" )
def flecho(scaler, secs)
flt = make_fir_filter(:order, 4, :xcoeffs, vct(0.125, 0.25, 0.25, 0.125))
del = make_delay((secs * srate()).round)
@@ -1121,17 +1214,19 @@ returns a low-pass filtered echo maker: map_channel(flecho(0.5, 0.9), 0, 75000)"
# CLM instrument is ring-modulate.ins
add_help(:ring_mod,
- "ring_mod(freq, gliss_env) \
-returns a time-varying ring-modulation filter: \
+ "ring_mod(freq, gliss_env) \
+Returns a time-varying ring-modulation filter: \
map_channel(ring_mod(10, [0, 0, 1, hz2radians(100)]))")
def ring_mod(freq, gliss_env)
os = make_oscil(:frequency, freq)
- len = frames()
+ len = framples()
genv = make_env(:envelope, gliss_env, :length, len)
lambda do |inval| oscil(os, env(genv)) * inval end
end
- add_help(:am, "am(freq) returns an amplitude-modulator: map_channel(am(440))")
+ add_help(:am,
+ "am(freq) \
+returns an amplitude-modulator: map_channel(am(440))")
def am(freq)
os = make_oscil(freq)
lambda do |inval| amplitude_modulate(1.0, inval, oscil(os)) end
@@ -1149,12 +1244,13 @@ map_channel(ring_mod(10, [0, 0, 1, hz2radians(100)]))")
# CLM instrument version is in clm.html
add_help(:hello_dentist,
- "hello_dentist(frq, amp, [snd=false, [chn=false]]) \
-varies the sampling rate randomly, making a voice sound quavery: hello_dentist(40.0, 0.1)")
+ "hello_dentist(frq, amp, snd=false, chn=false) \
+Varies the sampling rate randomly, \
+making a voice sound quavery: hello_dentist(40.0, 0.1)")
def hello_dentist(freq, amp, snd = false, chn = false)
rn = make_rand_interp(:frequency, freq, :amplitude, amp)
i = 0
- len = frames()
+ len = framples()
in_data = channel2vct(0, len, snd, chn)
out_len = (len * (1.0 + 2.0 * amp)).to_i
out_data = make_vct(out_len)
@@ -1164,47 +1260,44 @@ varies the sampling rate randomly, making a voice sound quavery: hello_dentist(4
i += dir
val
end)
- vct2channel(vct_map!(out_data, lambda do | | src(rd, rand_interp(rn)) end),
- 0, len, snd, chn, false, format("%s(%s, %s", get_func_name, freq, amp))
+ vct2channel(out_data.map do |x| src(rd, rand_interp(rn)) end,
+ 0, len, snd, chn, false,
+ format("%s(%s, %s", get_func_name, freq, amp))
end
# a very similar function uses oscil instead of rand-interp, giving
# various "Forbidden Planet" sound effects:
add_help(:fp,
- "fp(sr, osamp, osfrq, [snd=false, [chn=false]]) \
-varies the sampling rate via an oscil: fp(1.0, 0.3, 20)")
+ "fp(sr, osamp, osfrq, snd=false, chn=false) \
+Varies the sampling rate via an oscil: fp(1.0, 0.3, 20)")
def fp(sr, osamp, osfreq, snd = false, chn = false)
os = make_oscil(:frequency, osfreq)
s = make_src(:srate, sr)
- len = frames(snd, chn)
+ len = framples(snd, chn)
sf = make_sampler(0, snd, chn)
out_data = make_vct!(len) do
- src(s, osamp * oscil(os), lambda do |dir| dir > 0 ? next_sample(sf) : previous_sample(sf) end)
+ src(s, osamp * oscil(os),
+ lambda do |dir|
+ dir > 0 ? next_sample(sf) : previous_sample(sf)
+ end)
end
free_sampler(sf)
vct2channel(out_data, 0, len, snd, chn, false,
format("%s(%s, %s, %s", get_func_name, sr, osamp, osfreq))
end
- # compand, compand-channel
+ # compand
- add_help(:compand, "compand() returns a compander: map_channel(compand())")
- def compand(doc = false)
- tbl = vct(-1.000, -0.960, -0.900, -0.820, -0.720, -0.600, -0.450, -0.250,
- 0.000, 0.250, 0.450, 0.600, 0.720, 0.820, 0.900, 0.960, 1.000)
- lambda do |inval| array_interp(tbl, 8.0 + 8.0 * inval, tbl.length) end
- end
-
- add_help(:compand_channel,
- "compand_channel([beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]) \
-applies a standard compander to sound")
- def compand_channel(beg = 0, dur = false, snd = false, chn = false, edpos = false)
- tbl = vct(-1.000, -0.960, -0.900, -0.820, -0.720, -0.600, -0.450, -0.250,
- 0.000, 0.250, 0.450, 0.600, 0.720, 0.820, 0.900, 0.960, 1.000)
- ptree_channel(lambda { |inval| array_interp(tbl, 8.0 + 8.0 * inval, tbl.length)},
- beg, dur, snd, chn, edpos, true, false,
- format("%s(%s, %s", get_func_name, beg, dur))
+ Compand_table = vct(-1.0, -0.96, -0.9, -0.82, -0.72, -0.6, -0.45, -0.25,
+ 0.0, 0.25, 0.45, 0.6, 0.72, 0.82, 0.9, 0.96, 1.0)
+ add_help(:compand,
+ "compand() \
+Returns a compander: map_channel(compand())")
+ def compand()
+ lambda do |inval|
+ array_interp(Compand_table, 8.0 + 8.0 * inval, Compand_table.length)
+ end
end
# shift pitch keeping duration constant
@@ -1214,9 +1307,10 @@ applies a standard compander to sound")
# reads the currently selected file. CLM version is in expsrc.ins
add_help(:expsrc,
- "expsrc(rate, [snd=false, [chn=false]]) \
-uses sampling-rate conversion and granular synthesis to produce a sound \
-at a new pitch but at the original tempo. It returns a function for map_chan.")
+ "expsrc(rate, snd=false, chn=false) \
+Uses sampling-rate conversion and granular synthesis to produce a sound \
+at a new pitch but at the original tempo. \
+It returns a function for map_chan.")
def expsrc(rate, snd = false, chn = false)
gr = make_granulate(:expansion, rate)
sr = make_src(:srate, rate)
@@ -1246,14 +1340,16 @@ at a new pitch but at the original tempo. It returns a function for map_chan.")
# length.
add_help(:expsnd,
- "expsnd(gr_env, [snd=false, [chn=false]]) \
-uses the granulate generator to change tempo according to an envelope: expsnd([0, 0.5, 2, 2.0])")
+ "expsnd(gr_env, snd=false, chn=false) \
+Uses the granulate generator to change tempo \
+according to an envelope: expsnd([0, 0.5, 2, 2.0])")
def expsnd(gr_env, snd = false, chn = false)
- dur = ((frames(snd, chn) / srate(snd)) * integrate_envelope(gr_env) / envelope_last_x(gr_env))
+ dur = ((framples(snd, chn) / srate(snd)) *
+ integrate_envelope(gr_env) / envelope_last_x(gr_env))
gr = make_granulate(:expansion, gr_env[1], :jitter, 0)
ge = make_env(:envelope, gr_env, :duration, dur)
sound_len = (srate(snd) * dur).to_i
- len = [sound_len, frames(snd, chn)].max
+ len = [sound_len, framples(snd, chn)].max
sf = make_sampler(0, snd, chn)
out_data = make_vct!(len) do
val = granulate(gr, lambda do |dir| next_sample(sf) end)
@@ -1261,7 +1357,8 @@ uses the granulate generator to change tempo according to an envelope: expsnd([0
val
end
free_sampler(sf)
- vct2channel(out_data, 0, len, snd, chn, false, format("%s(%s", get_func_name, gr_env.inspect))
+ vct2channel(out_data, 0, len, snd, chn, false,
+ format("%s(%s", get_func_name, gr_env.inspect))
end
# cross-synthesis
@@ -1269,8 +1366,9 @@ uses the granulate generator to change tempo according to an envelope: expsnd([0
# CLM version is in clm.html
add_help(:cross_synthesis,
- "cross_synthesis(cross_snd, amp, fftsize, r) \
-does cross-synthesis between 'cross-snd' (a sound index) and the currently selected sound: \
+ "cross_synthesis(cross_snd, amp, fftsize, r) \
+Does cross-synthesis between CROSS_SND (a sound index) \
+and the currently selected sound: \
map_channel(cross_synthesis(1, 0.5, 128, 6.0))")
def cross_synthesis(cross_snd, amp, fftsize, r)
freq_inc = fftsize / 2
@@ -1281,7 +1379,10 @@ map_channel(cross_synthesis(1, 0.5, 128, 6.0))")
ctr = freq_inc
radius = 1.0 - r / fftsize.to_f
bin = srate() / fftsize.to_f
- formants = make_array(freq_inc) do |i| make_formant(i * bin, radius) end
+ fmts = make_array(freq_inc) do |i|
+ make_formant(i * bin, radius)
+ end
+ formants = make_formant_bank(fmts, spectr)
lambda do |inval|
if ctr == freq_inc
fdr = channel2vct(inctr, fftsize, cross_snd, 0)
@@ -1293,15 +1394,15 @@ map_channel(cross_synthesis(1, 0.5, 128, 6.0))")
end
ctr += 1
vct_add!(spectr, fdr)
- amp * formant_bank(spectr, formants, inval)
+ amp * formant_bank(formants, inval)
end
end
# similar ideas can be used for spectral cross-fades, etc -- for example:
add_help(:voiced2unvoiced,
- "voiced2unvoiced(amp, fftsize, r, tempo, [snd=false, [chn=false]]) \
-turns a vocal sound into whispering: voiced2unvoiced(1.0, 256, 2.0, 2.0)")
+ "voiced2unvoiced(amp, fftsize, r, tempo, snd=false, chn=false) \
+Turns a vocal sound into whispering: voiced2unvoiced(1.0, 256, 2.0, 2.0)")
def voiced2unvoiced(amp, fftsize, r, tempo, snd = false, chn = false)
freq_inc = fftsize / 2
fdr = make_vct(fftsize)
@@ -1312,11 +1413,14 @@ turns a vocal sound into whispering: voiced2unvoiced(1.0, 256, 2.0, 2.0)")
ctr = freq_inc
radius = 1.0 - r.to_f / fftsize
bin = srate(snd).to_f / fftsize
- len = frames(snd, chn)
+ len = framples(snd, chn)
outlen = (len / tempo).floor
hop = (freq_inc * tempo).floor
out_data = make_vct([len, outlen].max)
- formants = make_array(freq_inc) do |i| make_formant(i * bin, radius) end
+ fmts = make_array(freq_inc) do |i|
+ make_formant(i * bin, radius)
+ end
+ formants = make_formant_bank(fmts, spectr)
old_peak_amp = new_peak_amp = 0.0
outlen.times do |i|
if ctr == freq_inc
@@ -1332,22 +1436,26 @@ turns a vocal sound into whispering: voiced2unvoiced(1.0, 256, 2.0, 2.0)")
end
ctr += 1
vct_add!(spectr, fdr)
- if (outval = formant_bank(spectr, formants, rand(noi))).abs > new_peak_amp
+ if (outval = formant_bank(formants, rand(noi))).abs > new_peak_amp
new_peak_amp = outval.abs
end
out_data[i] = outval
end
vct_scale!(out_data, amp * (old_peak_amp / new_peak_amp))
vct2channel(out_data, 0, [len, outlen].max, snd, chn, false,
- format("%s(%s, %s, %s, %s", get_func_name, amp, fftsize, r, tempo))
+ format("%s(%s, %s, %s, %s", get_func_name,
+ amp, fftsize, r, tempo))
end
- # very similar but use sum-of-cosines (glottal pulse train?) instead of white noise
+ # very similar but use sum-of-cosines (glottal pulse train?)
+ # instead of white noise
add_help(:pulse_voice,
- "pulse_voice(cosin, freq=440.0, amp=1.0, fftsize=256, r=2.0, snd=false, chn=false) \
-uses sum-of-cosines to manipulate speech sounds")
- def pulse_voice(cosin, freq = 440.0, amp = 1.0, fftsize = 256, r = 2.0, snd = false, chn = false)
+ "pulse_voice(cosin, freq=440.0, amp=1.0, fftsize=256, r=2.0, \
+snd=false, chn=false) \
+Uses sum-of-cosines to manipulate speech sounds.")
+ def pulse_voice(cosin, freq = 440.0, amp = 1.0,
+ fftsize = 256, r = 2.0, snd = false, chn = false)
freq_inc = fftsize / 2
fdr = make_vct(fftsize)
fdi = make_vct(fftsize)
@@ -1357,10 +1465,13 @@ uses sum-of-cosines to manipulate speech sounds")
ctr = freq_inc
radius = 1.0 - r / fftsize
bin = srate(snd) / fftsize
- len = frames(snd, chn)
+ len = framples(snd, chn)
out_data = make_vct(len)
old_peak_amp = new_peak_amp = 0.0
- formants = make_array(freq_inc) do |i| make_formant(i * bin, radius) end
+ fmts = make_array(freq_inc) do |i|
+ make_formant(i * bin, radius)
+ end
+ formants = make_formant_bank(fmts, spectr)
out_data.map do |i|
outval = 0.0
if ctr == freq_inc
@@ -1375,7 +1486,7 @@ uses sum-of-cosines to manipulate speech sounds")
end
ctr += 1
vct_add!(spectr, fdr)
- outval = formant_bank(spectr, formants, sum_of_cosines(pulse))
+ outval = formant_bank(formants, sum_of_cosines(pulse))
if outval.abs > new_peak_amp then new_peak_amp = outval.abs end
outval
end
@@ -1391,14 +1502,17 @@ uses sum-of-cosines to manipulate speech sounds")
# convolution example
add_help(:cnvtest,
- "cnvtest(snd0, snd1, amp) \
-convolves snd0 and snd1, scaling by amp, returns new max amp: cnvtest(0, 1, 0.1)")
+ "cnvtest(snd0, snd1, amp) \
+Convolves snd0 and snd1, scaling by amp, \
+returns new max amp: cnvtest(0, 1, 0.1)")
def cnvtest(snd0, snd1, amp)
- flt_len = frames(snd0)
- total_len = flt_len + frames(snd1)
+ flt_len = framples(snd0)
+ total_len = flt_len + framples(snd1)
cnv = make_convolve(:filter, channel2vct(0, flt_len, snd0))
sf = make_sampler(0, snd1, false)
- out_data = make_vct!(total_len) do convolve(cnv, lambda do |dir| next_sample(sf) end) end
+ out_data = make_vct!(total_len) do
+ convolve(cnv, lambda do |dir| next_sample(sf) end)
+ end
free_sampler(sf)
vct_scale!(out_data, amp)
max_samp = vct_peak(out_data)
@@ -1412,38 +1526,34 @@ convolves snd0 and snd1, scaling by amp, returns new max amp: cnvtest(0, 1, 0.1)
# swap selection chans
add_help(:swap_selection_channels,
- "swap_selection_channels) swaps the currently selected data's channels")
+ "swap_selection_channels() \
+Swaps the currently selected data's channels.")
def swap_selection_channels
- find_selection_sound = lambda do |not_this|
- callcc do |ret|
- Snd.sounds.each do |snd|
- channels(snd).times do |chn|
- if selection_member?(snd, chn) and
- (not_this.empty? or snd != not_this[0] or chn != not_this[1])
- ret.call([snd, chn])
- end
+ if (not selection?)
+ Snd.raise(:no_active_selection)
+ end
+ if selection_chans != 2
+ Snd.raise(:wrong_number_of_channels, "need a stereo selection")
+ end
+ beg = selection_position()
+ len = selection_framples()
+ snd_chn0 = snd_chn1 = nil
+ Snd.sounds.each do |snd|
+ channels(snd).times do |chn|
+ if selection_member?(snd, chn)
+ if snd_chn0.nil?
+ snd_chn0 = [snd, chn]
+ elsif snd_chn1.nil?
+ snd_chn1 = [snd, chn]
+ break
end
end
- false
end
end
- if selection?
- if selection_chans == 2
- beg = selection_position
- len = selection_frames
- snd_chn0 = find_selection_sound.call([])
- snd_chn1 = find_selection_sound.call(snd_chn0)
- if snd_chn1
- swap_channels(snd_chn0[0], snd_chn0[1], snd_chn1[0], snd_chn1[1], beg, len)
- else
- Snd.raise(:wrong_number_of_channels, "need two channels to swap")
- end
- else
- Snd.raise(:wrong_number_of_channels, "need a stereo selection")
- end
- else
- Snd.raise(:no_active_selection)
+ if snd_chn1.nil?
+ Snd.raise(:wrong_number_of_channels, "need two channels to swap")
end
+ swap_channels(snd_chn0[0], snd_chn0[1], snd_chn1[0], snd_chn1[1], beg, len)
end
# sound interp
@@ -1453,44 +1563,33 @@ convolves snd0 and snd1, scaling by amp, returns new max amp: cnvtest(0, 1, 0.1)
# the corresponding "generator" is sound-interp
add_help(:make_sound_interp,
- "make_sound_interp(start, [snd=false, [chn=false]]) \
-an interpolating reader for snd's channel chn")
+ "make_sound_interp(start, snd=false, chn=false) \
+An interpolating reader for SND's channel CHN.")
def make_sound_interp(start, snd = false, chn = false)
- bufsize = 2048
- buf4size = 128
- data = channel2vct(start, bufsize, snd, chn)
- curbeg = start
- curend = start + bufsize
+ data = channel2vct(0, false, snd, chn)
+ size = data.length
lambda do |loc|
- if loc < curbeg
- curbeg = [buf4size + (loc - bufsize), 0].max
- curend = curbeg + bufsize
- data = channel2vct(curbeg, bufsize, snd, chn)
- else
- if loc > curend
- curbeg = [loc - buf4size, 0].max
- curend = curbeg + bufsize
- data = channel2vct(curbeg, bufsize, snd, chn)
- end
- end
- array_interp(data, loc - curbeg, bufsize)
+ array_interp(data, loc, size)
end
end
add_help(:sound_interp,
- "sound_interp(func, loc) \
-sample at loc (interpolated if necessary) from func created by make_sound_interp")
+ "sound_interp(func, loc) \
+Sample at LOC (interpolated if necessary) from FUNC \
+created by make_sound_interp.")
def sound_interp(func, loc)
func.call(loc)
end
def sound_via_sound(snd1, snd2)
intrp = make_sound_interp(0, snd1, 0)
- len = frames(snd1, 0) - 1
+ len = framples(snd1, 0) - 1
rd = make_sampler(0, snd2, 0)
mx = maxamp(snd2, 0)
map_channel(lambda do |val|
- sound_interp(intrp, (len * 0.5 * (1.0 + (read_sample(rd) / mx))).floor)
+ sound_interp(intrp,
+ (len * 0.5 *
+ (1.0 + (read_sample(rd) / mx))).floor)
end)
end
@@ -1508,36 +1607,27 @@ sample at loc (interpolated if necessary) from func created by make_sound_interp
# positions.
add_help(:env_sound_interp,
- "env_sound_interp(env, [time_scale=1.0, [snd=false, [chn=false]]]) \
-reads snd's channel chn according to env and time-scale")
+ "env_sound_interp(env, time_scale=1.0, snd=false, chn=false) \
+Reads SND's channel CHN according to ENV and TIME_SCALE.")
def env_sound_interp(envelope, time_scale = 1.0, snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
newlen = (time_scale.to_f * len).floor
- rd = make_sound_interp(0, snd, chn)
- read_env = make_env(:envelope, envelope, :length, newlen, :scaler, len)
- tempfilename = snd_tempnam
- fil = mus_sound_open_output(tempfilename, srate(snd), 1, false, Mus_next,
- format("%s temp file", get_func_name))
- bufsize = 8192
- data = make_sound_data(1, bufsize)
- data_ctr = 0
- newlen.times do |i|
- data[0, data_ctr] = sound_interp(rd, env(read_env))
- data_ctr += 1
- if bufsize == data_ctr
- mus_sound_write(fil, 0, bufsize - 1, 1, data)
- data_ctr = 0
- end
- end
- if data_ctr > 0
- mus_sound_write(fil, 0, data_ctr - 1, 1, data)
- end
- mus_sound_close_output(fil, 4 * newlen)
- set_samples(0, newlen, tempfilename, snd, chn, false,
- format("%s(%s, %s", get_func_name, envelope.inspect, time_scale))
- File.unlink(tempfilename)
- end
-
+ read_env = make_env(:envelope, envelope, :length, newlen + 1, :scaler, len)
+ data = channel2vct(0, false, snd, chn)
+ new_snd = Vct.new(newlen) do
+ array_interp(data, env(read_env), len)
+ end
+ set_samples(0, newlen, new_snd, snd, chn, true,
+ format("%s(%p, %s", get_func_name, envelope, time_scale),
+ 0, Current_edit_position, true)
+ end
+ # env_sound_interp([0, 0, 1, 1, 2, 0], 2.0)
+
+ add_help(:granulated_sound_interp,
+ "granulated_sound_interp(env, time_scale=1.0, grain_len=0.1, \
+grain_env=[0, 0, 1, 1, 2, 1, 3, 0], out_hop=0.05, snd=false, chn=false) \
+Reads the given channel following ENV (as in env_sound_interp), \
+using grains to create the re-tempo'd read.")
def granulated_sound_interp(envelope,
time_scale = 1.0,
grain_length = 0.1,
@@ -1545,79 +1635,72 @@ reads snd's channel chn according to env and time-scale")
output_hop = 0.05,
snd = false,
chn = false)
- len = frames(snd, chn)
- newlen = (time_scale * len).floor
+ len = framples(snd, chn)
+ newlen = (time_scale.to_f * len).floor
read_env = make_env(envelope, :length, newlen, :scaler, len)
- tempfilename = snd_tempnam
- fil = mus_sound_open_output(tempfilename, srate(snd), 1, false, Mus_next,
- "granulated_sound_interp temp file")
- grain_frames = (grain_length * srate).round
- hop_frames = (output_hop * srate).round
- num_readers = (grain_length / output_hop).round + 1
- readers = make_array(num_readers, false)
- grain_envs = make_array(num_readers) do |i| make_env(grain_envelope, :length, grain_frames) end
- next_reader_starts_at = 0
+ sr = srate(snd).to_f
+ grain_frames = (grain_length * sr).to_i
+ hop_frames = (output_hop * sr).to_i
+ num_readers = (grain_length.to_f / output_hop).ceil
+ cur_readers = 0
next_reader = 0
- bufsize = 8192
- data = make_sound_data(1, bufsize)
- data_ctr = 0
- jitter = srate * 0.005
- newlen.times do |i|
+ jitter = sr * 0.005
+ readers = Array.new(num_readers, false)
+ grain_envs = Array.new(num_readers) do
+ make_env(grain_envelope, :length, grain_frames)
+ end
+ new_snd = Vct.new(newlen, 0.0)
+ 0.step(newlen, hop_frames) do |i|
+ stop = [newlen, hop_frames + i].min
+ read_env.location = i
position_in_original = env(read_env)
- if i >= next_reader_starts_at
- readers[next_reader] =
- make_sampler([0, (position_in_original + mus_random(jitter)).round].max, false)
- grain_envs[next_reader].reset
- next_reader += 1
- if next_reader >= num_readers then next_reader = 0 end
- next_reader_starts_at += hop_frames
+ mx = [0, (position_in_original + mus_random(jitter)).round].max
+ readers[next_reader] = make_sampler(mx, snd, chn)
+ grain_envs[next_reader].reset
+ next_reader += 1
+ next_reader %= num_readers
+ if cur_readers < next_reader
+ cur_readers = next_reader
end
- sum = 0.0
- readers.each_with_index do |rd, j|
- if sampler?(rd)
- sum = sum + env(grain_envs[j]) * next_sample(rd)
+ (0...cur_readers).each do |j|
+ en = grain_envs[j]
+ rd = readers[j]
+ (i...stop).each do |k|
+ new_snd[k] = env(en) * rd.call()
end
end
- sound_data_set!(data, 0, data_ctr, sum)
- data_ctr += 1
- if bufsize == data_ctr
- mus_sound_write(fil, 0, bufsize - 1, 1, data)
- data_ctr = 0
- end
end
- if data_ctr > 0
- mus_sound_write(fil, 0, data_ctr - 1, 1, data)
- end
- mus_sound_close_output(fil, 4 * newlen)
- set_samples(0, newlen, tempfilename, snd, chn, true,
- format("%s(%s, %s, %s, %s, %s",
+ set_samples(0, newlen, new_snd, snd, chn, true,
+ format("%s(%p, %s, %s, %p, %s",
get_func_name,
- envelope.inspect,
+ envelope,
time_scale,
grain_length,
- grain_envelope.inspect,
- output_hop))
- File.unlink(tempfilename)
+ grain_envelope,
+ output_hop), 0, Current_edit_position, true)
end
# granulated_sound_interp([0, 0, 1, 0.1, 2, 1], 1.0, 0.2, [0, 0, 1, 1, 2, 0])
# granulated_sound_interp([0, 0, 1, 1], 2.0)
- # granulated_sound_interp([0, 0, 1, 0.1, 2, 1], 1.0, 0.2, [0, 0, 1, 1, 2, 0], 0.02)
+ # granulated_sound_interp([0, 0, 1, 0.1, 2, 1], 1.0, 0.2, [0, 0, 1, 1, 2, 0],
+ # 0.02)
# filtered-env
add_help(:filtered_env,
- "filtered_env(env, [snd=false, [chn=false]]) \
-is a time-varying one-pole filter: when env is at 1.0, no filtering, \
-as env moves to 0.0, low-pass gets more intense; amplitude and low-pass amount move together")
+ "filtered_env(env, snd=false, chn=false) \
+Is a time-varying one-pole filter: when ENV is at 1.0, no filtering, \
+as ENV moves to 0.0, low-pass gets more intense; \
+amplitude and low-pass amount move together.")
def filtered_env(en, snd = false, chn = false)
flt = make_one_pole(1.0, 0.0)
- amp_env = make_env(:envelope, en, :length, frames)
+ amp_env = make_env(:envelope, en, :length, framples())
map_channel(lambda do |val|
env_val = env(amp_env)
set_mus_xcoeff(flt, 0, env_val)
set_mus_ycoeff(flt, 1, env_val - 1.0)
one_pole(flt, env_val * val)
- end, 0, false, snd, chn, false, format("%s(%s", get_func_name, en.inspect))
+ end, 0, false, snd, chn, false,
+ format("%s(%s", get_func_name, en.inspect))
end
# lisp graph with draggable x axis
@@ -1657,16 +1740,20 @@ as env moves to 0.0, low-pass gets more intense; amplitude and low-pass amount m
# $mouse_enter_graph_hook.add_hook!("focus") do |snd, chn|
# focus_widget(channel_widgets(snd, chn)[0])
# end
- # $mouse_enter_listener_hook.add_hook!("focus") do |widget| focus_widget(widget) end
- # $mouse_enter_text_hook.add_hook!("focus") do |widget| focus_widget(widget) end
+ # $mouse_enter_listener_hook.add_hook!("focus") do |widget|
+ # focus_widget(widget)
+ # end
+ # $mouse_enter_text_hook.add_hook!("focus") do |widget|
+ # focus_widget(widget)
+ # end
# View: Files dialog chooses which sound is displayed
#
# by Anders Vinjar
add_help(:files_popup_buffer,
- "files_popup_buffer(type, position, name) \
-hides all sounds but the one the mouse touched in the current files list. \
+ "files_popup_buffer(type, position, name) \
+Hides all sounds but the one the mouse touched in the current files list. \
Use with $mouse_enter_label_hook.
$mouse_enter_label_hook.add_hook!(\"files-popup\") do |type, position, name|
files_popup_buffer(type, position, name)
@@ -1683,120 +1770,16 @@ end")
end
end
- # C-x b support along the same lines
-
- class Snd_buffers
- def initialize
- @last_buffer = false
- @current_buffer = false
- @last_width = 0
- @last_heigth = 0
- end
-
- def switch_to_buffer
- prompt = if @last_buffer
- if @last_buffer[1] > 0
- format("switch to buf: (default \"%s\" chan %d) ",
- short_file_name(@last_buffer[0]), @last_buffer[1])
- else
- format("switch to buf: (default \"%s\") ",
- short_file_name(@last_buffer[0]))
- end
- else
- "switch to buf: (default: make new sound)"
- end
- prompt_in_minibuffer(prompt,
- lambda do |response|
- width, heigth = widget_size(sound_widgets(@current_buffer[0])[0])
- callcc do |give_up|
- if (not string?(response)) or response.empty?
- temp = @current_buffer
- if @last_buffer
- @current_buffer = @last_buffer
- else
- index = new_sound()
- @current_buffer = [index, 0]
- end
- @last_buffer = temp
- else
- if index = find_sound(response)
- @last_buffer, @current_buffer = @current_buffer, [index, 0]
- else
- give_up.call(report_in_minibuffer("can't find " + response))
- end
- end
- close_all_buffers
- report_in_minibuffer("")
- open_current_buffer(width, heigth)
- end
- end)
- end
-
- def open(snd)
- close_all_buffers
- @last_buffer = @current_buffer
- @current_buffer = [snd, 0]
- open_current_buffer((@last_width.zero? ? window_width : @last_width),
- (@last_heigth.zero? ? (window_height - 10) : @last_heigth))
- false
- end
-
- def close(snd)
- if @current_buffer and snd == @current_buffer[0]
- closer = @current_buffer[0]
- close_all_buffers
- @current_buffer = if @last_buffer
- @last_buffer
- else
- sounds ? [sounds[0], 0] : false
- end
- @last_buffer = Snd.sounds.detect do |s|
- s != closer and ((not @current_buffer) or s != @current_buffer[0])
- end
- if @last_buffer
- @last_buffer = [@last_buffer, 0]
- end
- if @current_buffer
- open_current_buffer(@last_width, @last_heigth)
- end
- end
- false
- end
-
- private
- def open_current_buffer(width, heigth)
- @last_width = width
- @last_heigth = heigth
- if sound_pane = sound_widgets(@current_buffer[0])[0]
- show_widget(sound_pane)
- set_widget_size(sound_pane, [width, heigth])
- select_sound(@current_buffer[0])
- select_channel(@current_buffer[1])
- end
- end
-
- def close_all_buffers
- Snd.sounds.each do |s| hide_widget(sound_widgets(s)[0]) end
- end
- end
-
-=begin
- let(Snd_buffers.new) do |bufs|
- # C-x b
- bind_key(?b, 0, lambda do | | bufs.switch_to_buffer end, true, "C-x b: switch to buffer")
- $close_hook.add_hook!("buffers") do |snd| bufs.close(snd) end
- $after_open_hook.add_hook!("buffers") do |snd| bufs.open(snd) end
- end
-=end
-
# remove-clicks
- add_help(:find_click, "find_click(loc) finds the next click starting at 'loc'")
+ add_help(:find_click,
+ "find_click(loc) \
+Finds the next click starting at LOC.")
def find_click(loc)
reader = make_sampler(loc, false, false)
samp0 = samp1 = samp2 = 0.0
samps = make_vct(10)
- len = frames()
+ len = framples()
samps_ctr = 0
(loc...len).each do |ctr|
samp0, samp1, samp2 = samp1, samp2, next_sample(reader)
@@ -1816,7 +1799,9 @@ end")
false
end
- add_help(:remove_clicks, "remove_clicks() tries to find and smooth-over clicks")
+ add_help(:remove_clicks,
+ "remove_clicks() \
+Tries to find and smooth-over clicks.")
def remove_clicks
loc = 0
while (click = find_click(loc))
@@ -1827,7 +1812,9 @@ end")
# searching examples (zero+, next-peak)
- add_help(:search_for_click, "search_for_click() looks for the next click (for use with C-s)")
+ add_help(:search_for_click,
+ "search_for_click() \
+Looks for the next click (for use with C-s).")
def search_for_click
samp0 = samp1 = samp2 = 0.0
samps = Vct.new(10)
@@ -1849,8 +1836,9 @@ end")
end
add_help(:zero_plus,
- "zero_plus() \
-finds the next positive-going zero crossing (if searching forward) (for use with C-s)")
+ "zero_plus() \
+Finds the next positive-going \
+zero crossing (if searching forward) (for use with C-s).")
def zero_plus
lastn = 0.0
lambda do |n|
@@ -1861,8 +1849,9 @@ finds the next positive-going zero crossing (if searching forward) (for use with
end
add_help(:next_peak,
- "next_peak() \
-finds the next max or min point in the time-domain waveform (for use with C-s)")
+ "next_peak() \
+Finds the next max or min point \
+in the time-domain waveform (for use with C-s).")
def next_peak
last0 = last1 = false
lambda do |n|
@@ -1874,9 +1863,11 @@ finds the next max or min point in the time-domain waveform (for use with C-s)")
end
add_help(:find_pitch,
- "find_pitch(pitch) \
-finds the point in the current sound where 'pitch' (in Hz) predominates -- C-s find_pitch(300) \
-In most cases, this will be slightly offset from the true beginning of the note")
+ "find_pitch(pitch) \
+Finds the point in the current sound where PITCH (in Hz) \
+predominates -- C-s find_pitch(300). \
+In most cases, \
+this will be slightly offset from the true beginning of the note.")
def find_pitch(pitch)
interpolated_peak_offset = lambda do |la, ca, ra|
pk = 0.001 + [la, ca, ra].max
@@ -1903,8 +1894,9 @@ In most cases, this will be slightly offset from the true beginning of the note"
pkloc = i
end
end
- pit = (pkloc + (pkloc > 0 ? interpolated_peak_offset.call(*spectr[pkloc - 1, 3]) : 0.0) *
- srate()) / transform_size
+ pit = (pkloc + (pkloc > 0 ?
+ interpolated_peak_offset.call(*spectr[pkloc - 1, 3]) :
+ 0.0) * srate()) / transform_size
if (pitch - pit).abs < srate / (2 * transform_size)
rtn = -(transform_size / 2)
end
@@ -1917,9 +1909,11 @@ In most cases, this will be slightly offset from the true beginning of the note"
# file2vct and a sort of cue-list, I think
- add_help(:file2vct, "file2vct(file) returns a vct with file's data")
+ add_help(:file2vct,
+ "file2vct(file) \
+Returns a vct with FILE's data.")
def file2vct(file)
- len = mus_sound_frames(file)
+ len = mus_sound_framples(file)
reader = make_sampler(0, file)
data = make_vct!(len) do next_sample(reader) end
free_sampler(reader)
@@ -1927,10 +1921,11 @@ In most cases, this will be slightly offset from the true beginning of the note"
end
add_help(:add_notes,
- "add_notes(notes, [snd=false, [chn=false]]) \
-adds (mixes) 'notes' which is a list of lists of the form: \
+ "add_notes(notes, snd=false, chn=false) \
+Adds (mixes) NOTES which is a list of lists of the form: \
[file, offset=0.0, amp=1.0] starting at the cursor in the \
-currently selected channel: add_notes([[\"oboe.snd\"], [\"pistol.snd\", 1.0, 2.0]])")
+currently selected channel: \
+add_notes([[\"oboe.snd\"], [\"pistol.snd\", 1.0, 2.0]])")
def add_notes(notes, snd = false, chn = false)
start = cursor(snd, chn)
as_one_edit_rb("%s(%s", get_func_name, notes.inspect) do
@@ -1948,8 +1943,9 @@ currently selected channel: add_notes([[\"oboe.snd\"], [\"pistol.snd\", 1.0, 2.0
end
add_help(:region_play_list,
- "region_play_list(data) \
-'data' is list of lists [[time, reg], ...], time in secs, \ setting up a sort of play list: \
+ "region_play_list(data) \
+DATA is list of lists [[time, reg], ...], time in secs, \
+setting up a sort of play list: \
region_play_list([[0.0, 0], [0.5, 1], [1.0, 2], [1.0, 0]])")
def region_play_list(data)
(data or []).each do |tm, rg|
@@ -1961,14 +1957,14 @@ region_play_list([[0.0, 0], [0.5, 1], [1.0, 2], [1.0, 0]])")
end
add_help(:region_play_sequence,
- "region_play_sequence(data) \
-'data' is list of region ids which will be played one after the other: \
+ "region_play_sequence(data) \
+DATA is list of region ids which will be played one after the other: \
region_play_sequence([0, 2, 1])")
def region_play_sequence(data)
time = 0.0
region_play_list(data.map do |id|
cur = time
- time = time + region_frames(id) / region_srate(id)
+ time = time + region_framples(id) / region_srate(id)
[cur, id]
end)
end
@@ -1976,11 +1972,11 @@ region_play_sequence([0, 2, 1])")
# replace-with-selection
add_help(:replace_with_selection,
- "replace_with_selection() \
-replaces the samples from the cursor with the current selection")
+ "replace_with_selection() \
+Replaces the samples from the cursor with the current selection.")
def replace_with_selection
beg = cursor
- len = selection_frames
+ len = selection_framples()
delete_samples(beg, len)
insert_selection(beg)
end
@@ -1988,8 +1984,9 @@ replaces the samples from the cursor with the current selection")
# explode-sf2
add_help(:explode_sf2,
- "explode_sf2() \
-turns the currently selected soundfont file into a bunch of files of the form sample-name.aif")
+ "explode_sf2() \
+Turns the currently selected soundfont file into \
+a bunch of files of the form sample-name.aif.")
def explode_sf2
(soundfont_info() or []).each do |name, start, loop_start, loop_end|
filename = name + ".aif"
@@ -1998,8 +1995,8 @@ turns the currently selected soundfont file into a bunch of files of the form sa
end
set_selection_member?(true)
set_selection_position(start)
- set_selection_frames(frames - start)
- save_selection(filename, Mus_aifc)
+ set_selection_framples(framples() - start)
+ save_selection(filename, selection_srate(), Mus_bshort, Mus_aifc)
temp = open_sound(filename)
set_sound_loop_info([loop_start, loop_end], temp)
close_sound(temp)
@@ -2078,7 +2075,7 @@ turns the currently selected soundfont file into a bunch of files of the form sa
def click_middle_button_to_open_next_file_in_directory
nf = Next_file.new
- $mouse_click_hook.add_hook!("next-file") do |snd, chn, button, state, x, y, axis|
+ $mouse_click_hook.add_hook!("next-file") do |s, c, button, st, x, y, ax|
if button == 2
nf.open_next_file_in_directory
end
@@ -2112,117 +2109,20 @@ turns the currently selected soundfont file into a bunch of files of the form sa
=begin
with_sound() do
- chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0], make_oscil(:frequency, 440))
- chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0], make_one_pole(0.5), make_readin("oboe.snd"))
- chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0], let(make_oscil(:frequency, 220),
- make_oscil(:frequency, 440)) do |osc1, osc2|
- lambda do |val| osc1.run(val) + osc2.run(2.0 * val) end
- end)
+ chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0],
+ make_oscil(:frequency, 440))
+ chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0],
+ make_one_pole(0.5), make_readin("oboe.snd"))
+ chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0],
+ let(make_oscil(:frequency, 220),
+ make_oscil(:frequency, 440)) do |osc1, osc2|
+ lambda do |val|
+ osc1.run(val) + osc2.run(2.0 * val)
+ end
+ end)
end
=end
- # cursor-follows-play and stays where it was when the play ended
-
- module Cursor_follows_play
- def local_dac_func(data)
- Snd.sounds.each do |snd|
- channels(snd).times do |chn|
- if cursor(snd, chn) != original_cursor(snd, chn)
- set_current_cursor(cursor(snd, chn), snd, chn)
- end
- end
- end
- end
-
- def local_start_playing_func(snd)
- channels(snd).times do |chn|
- set_original_cursor(cursor(snd, chn), snd, chn)
- set_current_cursor(cursor(snd, chn), snd, chn)
- end
- end
-
- def local_stop_playing_func(snd)
- set_cursor(current_cursor(snd, 0), snd, true)
- end
-
- def current_cursor(snd, chn)
- channel_property(:cursor, snd, chn)
- end
-
- def set_current_cursor(val, snd, chn)
- set_channel_property(:cursor, val, snd, chn)
- end
-
- def original_cursor(snd, chn)
- channel_property(:original_cursor, snd, chn)
- end
-
- def set_original_cursor(val, snd, chn)
- set_channel_property(:original_cursor, val, snd, chn)
- end
- end
-
- def if_cursor_follows_play_it_stays_where_play_stopped(enable = true)
- include Cursor_follows_play
- if enable
- $dac_hook.add_hook!("cursor") do |data| local_dac_func(data) end
- $start_playing_hook.add_hook!("cursor") do |snd| local_start_playing_func(snd) end
- $stop_playing_hook.add_hook!("cursor") do |snd| local_stop_playing_func(snd) end
- else
- $dac_hook.remove_hook!("cursor")
- $start_playing_hook.remove_hook!("cursor")
- $stop_playing_hook.remove_hook!("cursor")
- end
- end
-
- # smooth-channel as virtual op
-
- def smooth_channel_via_ptree(beg = 0, dur = false, snd = false, chn = false, edpos = false)
- y0 = sample(beg, snd, chn, edpos)
- y1 = sample(beg + (dur or frames(snd, chn) - 1), snd, chn, edpos)
- init_angle = y1 > y0 ? PI : 0.0
- off = 0.5 * (y0 + y1)
- scale = 0.5 * (y1 - y0).abs
- data1 = vct(0.0, 0.0, init_angle, off, scale)
- ptree_channel(lambda { |y, data, forward|
- angle = data[0]
- incr = data[1]
- val = data[3] + data[4] * cos(data[2] + angle)
- if forward
- data[0] = angle + incr
- else
- data[0] = angle - incr
- end
- val
- }, beg, dur, snd, chn, edpos, true,
- lambda { |frag_beg, frag_dur|
- incr = PI / frag_dur
- data1[1] = incr
- data1[0] = frag_beg * incr
- data1
- }, format("%s(%s, %s", get_func_name, beg, dur))
- end
-
- # ring-modulate-channel (ring-mod as virtual op)
-
- def ring_modulate_channel(freq, beg = 0, dur = false, snd = false, chn = false, edpos = false)
- ptree_channel(lambda { |y, data, forward|
- angle = data[0]
- incr = data[1]
- val = y * sin(angle)
- if forward
- data[0] = angle + incr
- else
- data[0] = angle - incr
- end
- val
- }, beg, dur, snd, chn, edpos, false,
- lambda { |frag_beg, frag_dur|
- incr = (TWO_PI * freq) / srate(snd)
- vct((frag_beg * incr).divmod(TWO_PI).last, incr)
- }, format("%s(%s, %s, %s", get_func_name, freq, beg, dur))
- end
-
# re-order channels
def scramble_channels(*new_order)
@@ -2245,58 +2145,73 @@ turns the currently selected soundfont file into a bunch of files of the form sa
buffer = make_moving_average(128)
silence = silence / 128.0
edges = []
- samp = 0
in_silence = true
old_max = max_regions
old_tags = with_mix_tags
set_max_regions(1024)
set_with_mix_tags(false)
- scan_channel(lambda do |y|
- if (now_silent = moving_average(buffer, y * y) < silence) != in_silence
- edges.push(samp)
- end
- in_silence = now_silent
- samp += 1
- false
- end)
- edges.push(frames)
+ rd = make_sampler()
+ framples().times do |i|
+ y = next_sample(rd)
+ sum_of_squares = moving_average(buffer, y * y)
+ now_silent = (sum_of_squares < silence)
+ if now_silent != in_silence
+ edges.push(i)
+ end
+ in_silence = now_silent
+ end
+ edges.push(framples())
len = edges.length
- pieces = make_array(len)
start = 0
- edges.each_with_index do |fin, i|
- pieces[i] = make_region(0, fin)
- start = fin
+ pieces = Array.new(len) do |i|
+ en = edges[i]
+ re = make_region(start, en)
+ start = en
+ re
end
start = 0
- as_one_edit(lambda do | |
- scale_by(0.0)
- len.times do
- this = random(len)
- reg, pieces[this] = pieces[this], false
- unless reg
- (this.round + 1).upto(len - 1) do |i|
- reg = pieces[i]
- reg and pieces[i] = false
- end
- end
- mix_region(reg, start)
- start += region_frames(reg)
- forget_region(reg)
- end
- end)
- rescue
- ensure
+ fnc = lambda do | |
+ scale_by(0.0)
+ len.times do |i|
+ this = random(len)
+ reg = pieces[this]
+ pieces[this] = false
+ unless reg
+ (this + 1).upto(len - 1) do |j|
+ reg = pieces[j]
+ if reg
+ pieces[j] = false
+ break
+ end
+ end
+ unless reg
+ (this - 1).downto(0) do |j|
+ reg = pieces[j]
+ if reg
+ pieces[j] = false
+ break
+ end
+ end
+ end
+ end
+ mix_region(reg, start)
+ start += framples(reg)
+ forget_region(reg)
+ end
+ end
+ as_one_edit(fnc)
set_max_regions(old_max)
set_with_mix_tags(old_tags)
end
+ # scramble_channel(0.01)
# reorder blocks within channel
add_help(:reverse_by_blocks,
- "reverse_by_blocks(block_len, snd=false, chn=false) \
-divide sound into block-len blocks, recombine blocks in reverse order.")
+ "reverse_by_blocks(block_len, snd=false, chn=false) \
+Divide sound into block-len blocks, recombine blocks in reverse order.")
def reverse_by_blocks(block_len, snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
num_blocks = (len / (srate(snd).to_f * block_len)).floor
if num_blocks > 1
actual_block_len = len / num_blocks
@@ -2316,19 +2231,21 @@ divide sound into block-len blocks, recombine blocks in reverse order.")
if beg == actual_block_len
ctr += 1
beg = 0
- rd = make_sampler([len - ctr * actual_block_len, 0].max, snd, chn)
+ rd = make_sampler([len - ctr * actual_block_len, 0].max,
+ snd, chn)
end
val
- end,
- 0, false, snd, chn, false, format("%s(%s", get_func_name, block_len))
+ end, 0, false,
+ snd, chn, false, format("%s(%s", get_func_name, block_len))
end
end
add_help(:reverse_within_blocks,
- "reverse_within_blocks(block_len, snd=false, chn=false) \
-divide sound into blocks, recombine in order, but each block internally reversed.")
+ "reverse_within_blocks(block_len, snd=false, chn=false) \
+Divide sound into blocks, recombine in order, \
+but each block internally reversed.")
def reverse_within_blocks(block_len, snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
num_blocks = (len / (srate(snd).to_f * block_len)).floor
if num_blocks > 1
actual_block_len = len / num_blocks
@@ -2336,10 +2253,10 @@ divide sound into blocks, recombine in order, but each block internally reversed
as_one_edit(lambda do | |
0.step(len, actual_block_len) do |beg|
reverse_channel(beg, actual_block_len, snd, chn)
- env_channel(no_clicks_env, beg, actual_block_len, snd, chn)
+ env_channel(no_clicks_env, beg, actual_block_len,
+ snd, chn)
end
- end,
- format("%s(%s", get_func_name, block_len))
+ end, format("%s(%s", get_func_name, block_len))
else
reverse_channel(0, false, snd, chn)
end
@@ -2354,7 +2271,7 @@ divide sound into blocks, recombine in order, but each block internally reversed
end
def segment_sound(name, high, low)
- len = mus_sound_frames(name)
+ len = mus_sound_framples(name)
reader = make_sampler(0, name)
avg = make_moving_average(:size, 128)
lavg = make_moving_average(:size, 2048)
@@ -2403,7 +2320,8 @@ divide sound into blocks, recombine in order, but each block internally reversed
0.step(segments, 2) do |bnd|
segbeg = boundaries[bnd].to_i
segbeg = boundaries[bnd + 1].to_i
- fd.printf("(%s %s %s)", segbeg, segdur, segment_maxamp(sound_name, segbeg, segdur))
+ fd.printf("(%s %s %s)", segbeg, segdur,
+ segment_maxamp(sound_name, segbeg, segdur))
fd.printf(")")
end
mus_sound_forget(sound_name)
@@ -2421,7 +2339,8 @@ divide sound into blocks, recombine in order, but each block internally reversed
fd.printf("\n\n# ---------------- %s ----------------", dir)
if dir == "Piano"
Dir[main_dir + dir].each do |inner_dir|
- do_one_directory(fd, main_dir + dir + "/" + inner_dir, ins_name, 0.001, 0.0001)
+ do_one_directory(fd, main_dir + dir + "/" + inner_dir,
+ ins_name, 0.001, 0.0001)
end
else
do_one_directory(fd, main_dir + dir, ins_name)
@@ -2434,7 +2353,7 @@ divide sound into blocks, recombine in order, but each block internally reversed
add_help(:channel_clipped?,
"channel_clipped?(snd=false, chn=false) \
-returns true and a sample number if it finds clipping.")
+Returns true and a sample number if it finds clipping.")
def channel_clipped?(snd = false, chn = false)
last_y = 0.0
scan_channel(lambda do |y|
@@ -2451,7 +2370,7 @@ returns true and a sample number if it finds clipping.")
if (chns = channels(index)) == 1
scan_channel(lambda do |y| func.call(y, 0) end, beg, dur, index, 0)
else
- len = frames(index)
+ len = framples(index)
fin = (dur ? [len, beg + dur].min : len)
readers = make_array(chns) do |chn| make_sampler(beg, index, chn) end
result = false
@@ -2513,7 +2432,8 @@ module Moog
0.287262, 0.285736, 0.284241, 0.282715, 0.28125, 0.279755,
0.27829, 0.276825, 0.275391, 0.273956, 0.272552, 0.271118,
0.269745, 0.268341, 0.266968, 0.265594, 0.264252, 0.262909,
- 0.261566, 0.260223, 0.258911, 0.257599, 0.256317, 0.255035, 0.25375)
+ 0.261566, 0.260223, 0.258911, 0.257599, 0.256317, 0.255035,
+ 0.25375)
Freqtable = [0, -1,
0.03311111, -0.9,
0.06457143, -0.8,
@@ -2576,7 +2496,9 @@ module Moog
ix = @freqtable * 99.0
ixint = ix.floor
ixfrac = ix - ixint
- @A = a * @Q * ((1.0 - ixfrac) * Gaintable[ixint + 99] + ixfrac * Gaintable[ixint + 100])
+ @A = a * @Q *
+ ((1.0 - ixfrac) * Gaintable[ixint + 99] +
+ ixfrac * Gaintable[ixint + 100])
a
end
@@ -2587,15 +2509,17 @@ module Moog
end
add_help(:make_moog_filter,
- "make_moog_filter([freq=440.0, [Q=0]]) makes a new moog_filter generator. \
-'frequency' is the cutoff in Hz, \
-'Q' sets the resonance: 0 = no resonance, 1: oscillates at 'frequency'")
+ "make_moog_filter(freq=440.0, Q=0) \
+Makes a new moog_filter generator. \
+FREQUENCY is the cutoff in Hz, \
+Q sets the resonance: 0 = no resonance, 1: oscillates at FREQUENCY.")
def make_moog_filter(freq = 440.0, q = 0)
Moog_filter.new(freq, q)
end
add_help(:moog_filter,
- "moog_filter(moog, [insig=0.0]) is the generator associated with make_moog_filter")
+ "moog_filter(moog, insig=0.0) \
+Is the generator associated with make_moog_filter.")
def moog_filter(mg, insig = 0.0)
mg.filter(insig)
end
diff --git a/examp.scm b/examp.scm
index 113a6eb..918e741 100644
--- a/examp.scm
+++ b/examp.scm
@@ -36,16 +36,12 @@
;;; lisp graph with draggable x axis
;;; pointer focus within Snd
;;; View: Files dialog chooses which sound is displayed
-;;; C-x b support along the same lines
;;; remove-clicks
;;; searching examples (zero+, next-peak, find-pitch)
-;;; file->vct and a sort of cue-list, I think, and region-play-list, region-play-sequence
+;;; file->floats and a sort of cue-list, I think, and region-play-list, region-play-sequence
;;; explode-sf2 -- turn soundfont file into a bunch of files of the form sample-name.aif
;;; open-next-file-in-directory -- middle button click closes current file and opens next
;;; chain-dsps
-;;; cursor-follows-play and stays where it was when the play ended
-;;; smooth-channel as virtual op
-;;; ring-modulate-channel (ring-mod as virtual op)
;;; scramble-channels -- reorder chans
;;; scramble-channel -- randomly reorder segments within a sound
;;; reverse-by-blocks and reverse-within-blocks -- reorder or reverse blocks within a channel
@@ -53,272 +49,223 @@
;;; sync-everything
(provide 'snd-examp.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(require snd-env.scm)
;;; -------- (ext)snd.html examples made harder to break --------
;;;
;;; this mainly involves keeping track of the current sound/channel
-(define (selection-rms-1)
- "(selection-rms-1) -> rms of selection data using samplers"
- (if (selection?)
- (let* ((reader (make-sampler (selection-position)))
- (len (selection-frames))
- (sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i len)
- (begin
- (free-sampler reader)
- (sqrt (/ sum len))))
- (let ((val (next-sample reader)))
- (set! sum (+ sum (* val val))))))
- (throw 'no-active-selection (list "selection-rms-1"))))
-
-
-;;; if you'd rather use recursion:
-(define (selection-rms)
- "(selection-rms) -> rms of selection data using samplers and recursion"
- ;; this is actually slightly faster than selection-rms-1
- ;; all the DO loops in this file could be re-written in this form, but I find loops easier to read
- (if (selection?)
- (let* ((reader (make-sampler (selection-position)))
- (len (selection-frames)))
- (define rsum
- (lambda (leng sum)
- (if (= leng 0)
- (sqrt (/ sum len))
- (let ((val (next-sample reader)))
- (rsum (- leng 1) (+ sum (* val val)))))))
- (let ((val (rsum len 0.0)))
- (free-sampler reader)
- val))
- (throw 'no-active-selection (list "selection-rms"))))
-
-
-(define (region-rms reg)
- "(region-rms n) -> rms of region n's data (chan 0)"
- (if (region? reg)
- (let* ((data (region->vct reg 0 0)))
- (sqrt (/ (dot-product data data) (length data))))
- (throw 'no-such-region (list "region-rms" reg))))
-
-
-(define* (window-samples snd chn)
- "(window-samples snd chn) -> samples in snd channel chn in current graph window"
- (let ((wl (left-sample snd chn))
- (wr (right-sample snd chn)))
- (channel->vct wl (+ 1 (- wr wl)) snd chn)))
-
-
-(define (display-energy snd chn)
- ;; in this version, the y-zoom-slider controls the graph amp
- "(display-energy snd chn) is a lisp-graph-hook function to display the time domain data as energy (squared)"
- (let* ((ls (left-sample snd chn))
- (rs (right-sample snd chn))
- (datal (make-graph-data snd chn))
- (data (if (vct? datal) datal (cadr datal)))
- (sr (srate snd))
- (y-max (y-zoom-slider snd chn)))
- (if (and data ls rs)
- (begin
- (vct-multiply! data data)
- (graph data "energy" (/ ls sr) (/ rs sr) 0.0 (* y-max y-max) snd chn #f)))))
-
-;(hook-push lisp-graph-hook display-energy)
-
-
-(define display-db
- (lambda (snd chn)
- "(display-db snd chn) is a lisp-graph-hook function to display the time domain data in dB"
- (let ((datal (make-graph-data snd chn)))
-
- (define (log10 a)
- (/ (log a) (log 10)))
-
- (if datal
- (let* ((data (if (vct? datal) datal (cadr datal)))
- (len (length data))
- (sr (srate snd)))
- (define (dB val)
- (if (< val .001)
- -60.0
- (* 20.0 (log10 val))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (data i) (+ 60.0 (dB (abs (data i))))))
- (graph data "dB"
- (/ (left-sample snd chn) sr) (/ (right-sample snd chn) sr)
- 0.0 60.0
- snd chn))))))
+(define selection-rms
+ (let ((documentation "(selection-rms) -> rms of selection data using samplers"))
+ (lambda ()
+ (if (selection?)
+ (let ((data (samples (selection-position) (selection-framples))))
+ (sqrt (/ (dot-product data data) (selection-framples))))
+ (error 'no-active-selection (list "selection-rms-1"))))))
+
+
+(define region-rms
+ (let ((documentation "(region-rms n) -> rms of region n's data (chan 0)"))
+ (lambda (reg)
+ (if (region? reg)
+ (let ((data (region->float-vector reg 0 0)))
+ (sqrt (/ (dot-product data data) (length data))))
+ (error 'no-such-region (list "region-rms" reg))))))
-;(hook-push lisp-graph-hook display-db)
+(define window-samples
+ (let ((documentation "(window-samples snd chn) -> samples in snd channel chn in current graph window"))
+ (lambda* (snd chn)
+ (let ((wl (left-sample snd chn))
+ (wr (right-sample snd chn)))
+ (channel->float-vector wl (+ 1 (- wr wl)) snd chn)))))
-(define (window-rms)
- "(window-rms) -> rms of data in currently selected graph window"
- (let* ((ls (left-sample))
- (rs (right-sample))
- (data (channel->vct ls (+ 1 (- rs ls))))
- (len (length data)))
- (sqrt (/ (dot-product data data) len))))
+(define display-energy
+ ;; in this version, the y-zoom-slider controls the graph amp
+ (let ((documentation "(display-energy hook) is a lisp-graph-hook function to display the time domain data as energy (squared)"))
+ (lambda (hook)
+ (let* ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (ls (left-sample snd chn))
+ (rs (right-sample snd chn))
+ (datal (make-graph-data snd chn))
+ (data (if (float-vector? datal) datal (cadr datal)))
+ (sr (srate snd))
+ (y-max (y-zoom-slider snd chn)))
+ (if (and data ls rs)
+ (begin
+ (float-vector-multiply! data data)
+ (graph data "energy" (/ ls sr) (/ rs sr) 0.0 (* y-max y-max) snd chn #f)))))))
+
+ ;(hook-push lisp-graph-hook display-energy)
+
+
+(define display-db
+ (let ((documentation "(display-db hook) is a lisp-graph-hook function to display the time domain data in dB"))
+ (lambda (hook)
+ (let* ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (datal (make-graph-data snd chn)))
+
+ (if datal
+ (let* ((data (if (float-vector? datal) datal (cadr datal)))
+ (len (length data))
+ (sr (srate snd)))
+ (define (dB val)
+ (if (< val .001)
+ -60.0
+ (* 20.0 (log val 10))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (data i) (+ 60.0 (dB (abs (data i))))))
+ (graph data "dB"
+ (/ (left-sample snd chn) sr) (/ (right-sample snd chn) sr)
+ 0.0 60.0
+ snd chn)))))))
+
+ ;(hook-push lisp-graph-hook display-db)
+
+
+(define window-rms
+ (let ((documentation "(window-rms) -> rms of data in currently selected graph window"))
+ (lambda ()
+ (let* ((ls (left-sample))
+ (rs (right-sample))
+ (data (channel->float-vector ls (+ 1 (- rs ls))))
+ (len (length data)))
+ (sqrt (/ (dot-product data data) len))))))
-(define (fft-peak snd chn scale)
- "(fft-peak) returns the peak spectral magnitude"
- (if (and (transform-graph?)
- (= (transform-graph-type) graph-once))
- (report-in-minibuffer
- (number->string (/ (* 2.0 (vct-peak (transform->vct snd chn)))
- (transform-size)))
- snd)
- #f))
-;(hook-push after-transform-hook fft-peak)
+(define fft-peak
+ (let ((documentation "(fft-peak hook) returns the peak spectral magnitude. It is intended for use with after-transform-hook."))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (if (and (transform-graph?)
+ (= *transform-graph-type* graph-once))
+ (status-report
+ (number->string (/ (* 2.0 (float-vector-peak (transform->float-vector snd chn)))
+ *transform-size*))
+ snd))))))
+
+ ;(hook-push after-transform-hook fft-peak)
;;; -------- 'info' from extsnd.html using format --------
-(define (finfo file)
- "(finfo file) -> description (as a string) of file"
- (format #f "~A: chans: ~D, srate: ~D, ~A, ~A, len: ~1,3F"
- file
- (channels file)
- (srate file)
- (mus-header-type-name (mus-sound-header-type file))
- (mus-data-format-name (mus-sound-data-format file))
- (/ (mus-sound-samples file)
- (* 1.0 (channels file) (srate file)))))
+(define finfo
+ (let ((documentation "(finfo file) -> description (as a string) of file"))
+ (lambda (file)
+ (format #f "~A: chans: ~D, srate: ~D, ~A, ~A, len: ~1,3F"
+ file
+ (channels file)
+ (srate file)
+ (mus-header-type-name (mus-sound-header-type file))
+ (mus-sample-type-name (mus-sound-sample-type file))
+ (/ (mus-sound-samples file)
+ (* 1.0 (channels file) (srate file)))))))
;;; -------- Correlation --------
;;;
;;; correlation of channels in a stereo sound
-(define (display-correlation snd chn y0 y1)
- "(display-correlation snd chn y0 y1) returns the correlation of snd's 2 channels (intended for use with graph-hook). y0 and y1 are ignored."
- (if (and (= (channels snd) 2)
- (> (frames snd 0) 1)
- (> (frames snd 1) 1))
- (let* ((ls (left-sample snd 0))
- (rs (right-sample snd 0))
- (ilen (+ 1 (- rs ls)))
- (pow2 (ceiling (/ (log ilen) (log 2))))
- (fftlen (floor (expt 2 pow2)))
- (fftscale (/ 1.0 fftlen))
- (rl1 (channel->vct ls fftlen snd 0))
- (rl2 (channel->vct ls fftlen snd 1))
- (im1 (make-vct fftlen))
- (im2 (make-vct fftlen)))
- (fft rl1 im1 1)
- (fft rl2 im2 1)
- (let* ((tmprl (vct-copy rl1))
- (tmpim (vct-copy im1))
- (data3 (make-vct fftlen)))
- (vct-multiply! tmprl rl2) ; (* tempr1 tempr2)
- (vct-multiply! tmpim im2) ; (* tempi1 tempi2)
- (vct-multiply! im2 rl1) ; (* tempr1 tempi2)
- (vct-multiply! rl2 im1) ; (* tempr2 tempi1)
- (vct-add! tmprl tmpim) ; add the first two
- (vct-subtract! im2 rl2) ; subtract the 4th from the 3rd
- (fft tmprl im2 -1)
- (vct-add! data3 tmprl) ; copy into data3
- (vct-scale! data3 fftscale) ; scale by fftscale
- (graph data3 "lag time" 0 fftlen)))
- (report-in-minibuffer "display-correlation wants stereo input")))
-
-;(hook-push graph-hook display-correlation)
-
-;;; The inner let body could also be:
-;;;
-;;; (graph
-;;; (vct-scale!
-;;; (vct-add! data3
-;;; (fft (vct-add! (vct-multiply! tmprl rl2) (vct-multiply! tmpim im2))
-;;; (vct-subtract! (vct-multiply! im2 rl1) (vct-multiply! rl2 im1))
-;;; -1))
-;;; fftscale) "lag time" 0 fftlen2)))
-
-
-
-;;; -------- Buffers Menu --------
-;;; patterned after the XEmacs Buffers menu
-;;; see new-effects.scm for a much fancier example
-
-;(define buffer-menu (add-to-main-menu "Buffers"))
-
-(define (open-buffer filename)
- "(open-buffer filename) adds a menu item that will select filename (use with open-hook)"
- (add-to-menu buffer-menu
- filename
- (lambda ()
- (let ((ind (find-sound filename)))
- (if (sound? ind)
- (select-sound ind)))))
- #f)
-
-(define (close-buffer snd)
- "(close-buffer snd) removes the menu item associated with snd (use with close-hook)"
- (remove-from-menu buffer-menu (file-name snd)))
-
-;;; here we're adding this menu handling code to whatever is already happening at open/close-hook time
-
-;(hook-push open-hook open-buffer)
-;(hook-push close-hook close-buffer)
-
+(define display-correlation
+ (let ((documentation "(display-correlation hook) returns the correlation of snd's 2 channels (intended for use with graph-hook). y0 and y1 are ignored."))
+ (lambda (hook)
+ (let ((snd (hook 'snd)))
+ (if (and (= (channels snd) 2)
+ (> (framples snd 0) 1)
+ (> (framples snd 1) 1))
+ (let* ((ls (left-sample snd 0))
+ (rs (right-sample snd 0))
+ (ilen (+ 1 (- rs ls)))
+ (pow2 (ceiling (log ilen 2)))
+ (fftlen (floor (expt 2 pow2)))
+ (fftscale (/ 1.0 fftlen))
+ (rl1 (channel->float-vector ls fftlen snd 0))
+ (rl2 (channel->float-vector ls fftlen snd 1))
+ (im1 (make-float-vector fftlen))
+ (im2 (make-float-vector fftlen)))
+ (fft rl1 im1 1)
+ (fft rl2 im2 1)
+ (let ((tmprl (copy rl1))
+ (tmpim (copy im1)))
+ (float-vector-multiply! tmprl rl2) ; (* tempr1 tempr2)
+ (float-vector-multiply! tmpim im2) ; (* tempi1 tempi2)
+ (float-vector-multiply! im2 rl1) ; (* tempr1 tempi2)
+ (float-vector-multiply! rl2 im1) ; (* tempr2 tempi1)
+ (float-vector-add! tmprl tmpim) ; add the first two
+ (float-vector-subtract! im2 rl2) ; subtract the 4th from the 3rd
+ (fft tmprl im2 -1)
+ (float-vector-scale! tmprl fftscale) ; scale by fftscale
+ (graph tmprl "lag time" 0 fftlen)))
+ (status-report "display-correlation wants stereo input"))))))
+
+ ;(hook-push graph-hook display-correlation)
;;; -------- set transform-size based on current time domain window size
;;;
;;; also zoom spectrum based on y-axis zoom slider
-(define (zoom-spectrum snd chn y0 y1)
- "(zoom-spectrum snd chn y0 y1) sets the transform size to correspond to the time-domain window size (use with graph-hook)"
- (if (and (transform-graph? snd chn)
- (= (transform-graph-type snd chn) graph-once))
- (begin
- (set! (transform-size snd chn)
- (expt 2 (ceiling
- (/ (log (- (right-sample snd chn) (left-sample snd chn)))
- (log 2.0)))))
- (set! (spectrum-end snd chn) (y-zoom-slider snd chn))))
- #f)
+(define zoom-spectrum
+ (let ((documentation "(zoom-spectrum hook) sets the transform size to correspond to the time-domain window size (use with graph-hook)"))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (if (and (transform-graph? snd chn)
+ (= (transform-graph-type snd chn) graph-once))
+ (begin
+ (set! (transform-size snd chn)
+ (expt 2 (ceiling (log (- (right-sample snd chn) (left-sample snd chn)) 2.0))))
+ (set! (spectrum-end snd chn) (y-zoom-slider snd chn))))))))
+
-;(hook-push graph-hook zoom-spectrum)
+ ;(hook-push graph-hook zoom-spectrum)
;;; -------- superimpose spectra of sycn'd sounds
-(define (superimpose-ffts snd chn y0 y1)
- "(superimpose-ffts snd chn y0 y1) superimposes ffts of multiple (syncd) sounds (use with graph-hook)"
- (let ((maxsync (apply max (map sync (sounds)))))
- (if (and (> (sync snd) 0)
- (> (right-sample snd chn) (left-sample snd chn))
- (equal? snd (integer->sound (apply min (map (lambda (n)
- (if (= (sync snd) (sync n))
- (sound->integer n)
- (+ 1 maxsync)))
- (sounds))))))
- (let* ((ls (left-sample snd chn))
- (rs (right-sample snd chn))
- (pow2 (ceiling (/ (log (max 1 (- rs ls))) (log 2))))
- (fftlen (floor (expt 2 pow2))))
- (if (> pow2 2)
- (let ((ffts '()))
- (for-each
- (lambda (n)
- (if (and (= (sync n) (sync snd))
- (> (channels n) chn))
- (set! ffts (append ffts (let* ((fdr (channel->vct ls fftlen n chn))
- (fdi (make-vct fftlen))
- (spectr (make-vct (/ fftlen 2))))
- (list (vct-add! spectr (spectrum fdr fdi #f 2))))))))
- (sounds))
- (graph ffts "spectra" 0.0 0.5 y0 y1 snd chn)))))
- #f))
-
-;(hook-push graph-hook superimpose-ffts)
+(define superimpose-ffts
+ (let ((documentation "(superimpose-ffts hook) superimposes ffts of multiple (syncd) sounds (use with graph-hook)"))
+ (lambda (hook)
+ (let ((maxsync (apply max (map sync (sounds))))
+ (snd (hook 'snd))
+ (chn (hook 'chn))
+ (y0 (hook 'y0))
+ (y1 (hook 'y1)))
+ (if (and (> (sync snd) 0)
+ (> (right-sample snd chn) (left-sample snd chn))
+ (equal? snd (integer->sound (apply min (map (lambda (n)
+ (if (= (sync snd) (sync n))
+ (sound->integer n)
+ (+ 1 maxsync)))
+ (sounds))))))
+ (let* ((ls (left-sample snd chn))
+ (rs (right-sample snd chn))
+ (pow2 (ceiling (log (max 1 (- rs ls)) 2)))
+ (fftlen (floor (expt 2 pow2))))
+ (if (> pow2 2)
+ (let ((ffts ()))
+ (for-each
+ (lambda (n)
+ (if (and (= (sync n) (sync snd))
+ (> (channels n) chn))
+ (set! ffts (append ffts (let ((fdr (channel->float-vector ls fftlen n chn))
+ (fdi (make-float-vector fftlen))
+ (spectr (make-float-vector (/ fftlen 2))))
+ (list (float-vector-add! spectr (spectrum fdr fdi #f 2))))))))
+ (sounds))
+ (graph ffts "spectra" 0.0 0.5 y0 y1 snd chn)))))))))
+
+;;(hook-push graph-hook superimpose-ffts)
;;; -------- translate mpeg input to 16-bit linear and read into Snd
@@ -326,161 +273,168 @@
;;; mpg123 with the -s switch sends the 16-bit (mono or stereo) representation of
;;; an mpeg file to stdout. There's also apparently a switch to write 'wave' output.
-(define (mpg mpgfile rawfile)
- "(mpg file tmpname) converts file from MPEG to raw 16-bit samples using mpg123"
- (let* ((fd (open-file mpgfile "r"))
- (b0 (char->integer (read-char fd)))
- (b1 (char->integer (read-char fd)))
- (b2 (char->integer (read-char fd)))
- (b3 (char->integer (read-char fd))))
- (close fd)
- (if (or (not (= b0 255))
- (not (= (logand b1 #b11100000) #b11100000)))
- (snd-print (format #f "~S is not an MPEG file (first 11 bytes: #b~B #b~B)" mpgfile b0 (logand b1 #b11100000)))
- (let ((id (ash (logand b1 #b11000) -3))
- (layer (ash (logand b1 #b110) -1))
- ;; (protection (logand b1 1))
- ;; (bitrate-index (ash (logand b2 #b11110000) -4))
- (srate-index (ash (logand b2 #b1100) -2))
- ;; (padding (ash (logand b2 #b10) -1))
- (channel-mode (ash (logand b3 #b11000000) -6))
- ;; (mode-extension (ash (logand b3 #b110000) -4))
- ;; (copyright (ash (logand b3 #b1000) -3))
- ;; (original (ash (logand b3 #b100) -2))
- ;; (emphasis (logand b3 #b11))
- )
- (if (= id 1)
- (snd-print (format #f "odd: ~S is using a reserved Version ID" mpgfile)))
- (if (= layer 0)
- (snd-print (format #f "odd: ~S is using a reserved layer description" mpgfile)))
- (let* ((chans (if (= channel-mode 3) 1 2))
- (mpegnum (if (= id 0) 4 (if (= id 2) 2 1)))
- (mpeg-layer (if (= layer 3) 1 (if (= layer 2) 2 3)))
- (srate (/ (list-ref (list 44100 48000 32000 0) srate-index) mpegnum)))
- (snd-print (format #f "~S: ~A Hz, ~A, MPEG-~A~%"
- mpgfile srate (if (= chans 1) "mono" "stereo") mpeg-layer))
- (system (format #f "mpg123 -s ~A > ~A" mpgfile rawfile))
- (open-raw-sound rawfile chans srate (if (little-endian?) mus-lshort mus-bshort)))))))
+(define mpg
+ (let ((documentation "(mpg file tmpname) converts file from MPEG to raw 16-bit samples using mpg123"))
+ (lambda (mpgfile rawfile)
+ (let* ((fd (open-input-file mpgfile "r"))
+ (b0 (char->integer (read-char fd)))
+ (b1 (char->integer (read-char fd)))
+ (b2 (char->integer (read-char fd)))
+ (b3 (char->integer (read-char fd))))
+ (close-input-port fd)
+ (if (or (not (= b0 255))
+ (not (= (logand b1 #b11100000) #b11100000)))
+ (snd-print (format #f "~S is not an MPEG file (first 11 bytes: #b~B #b~B)" mpgfile b0 (logand b1 #b11100000)))
+ (let ((id (ash (logand b1 #b11000) -3))
+ (layer (ash (logand b1 #b110) -1))
+ ;; (protection (logand b1 1))
+ ;; (bitrate-index (ash (logand b2 #b11110000) -4))
+ (srate-index (ash (logand b2 #b1100) -2))
+ ;; (padding (ash (logand b2 #b10) -1))
+ (channel-mode (ash (logand b3 #b11000000) -6))
+ ;; (mode-extension (ash (logand b3 #b110000) -4))
+ ;; (copyright (ash (logand b3 #b1000) -3))
+ ;; (original (ash (logand b3 #b100) -2))
+ ;; (emphasis (logand b3 #b11))
+ )
+ (if (= id 1)
+ (snd-print (format #f "odd: ~S is using a reserved Version ID" mpgfile)))
+ (if (= layer 0)
+ (snd-print (format #f "odd: ~S is using a reserved layer description" mpgfile)))
+ (let* ((chans (if (= channel-mode 3) 1 2))
+ (mpegnum (if (= id 0) 4 (if (= id 2) 2 1)))
+ (mpeg-layer (if (= layer 3) 1 (if (= layer 2) 2 3)))
+ (srate (/ (list-ref (list 44100 48000 32000 0) srate-index) mpegnum)))
+ (snd-print (format #f "~S: ~A Hz, ~A, MPEG-~A~%"
+ mpgfile srate (if (= chans 1) "mono" "stereo") mpeg-layer))
+ (system (format #f "mpg123 -s ~A > ~A" mpgfile rawfile))
+ (open-raw-sound rawfile chans srate (if (little-endian?) mus-lshort mus-bshort)))))))))
;;; (mpg "mpeg.mpg" "mpeg.raw")
;;; -------- read and write OGG files
-(define (read-ogg filename)
- "(read-ogg filename) tries to open an OGG file"
- ;; check for "OggS" first word, if found, translate to something Snd can read
- ;; (open-sound (read-ogg "/home/bil/sf1/oboe.ogg"))
- (if (call-with-input-file filename
- (lambda (fd)
- (and (char=? (read-char fd) #\O)
- (char=? (read-char fd) #\g)
- (char=? (read-char fd) #\g)
- (char=? (read-char fd) #\S))))
- (let ((aufile (string-append filename ".au")))
- (if (file-exists? aufile) (delete-file aufile))
- (system (format #f "ogg123 -d au -f ~A ~A" aufile filename))
- aufile)
- #f))
+(define read-ogg
+ (let ((documentation "(read-ogg filename) tries to open an OGG file"))
+ (lambda (filename)
+ ;; check for "OggS" first word, if found, translate to something Snd can read
+ ;; (open-sound (read-ogg "/home/bil/sf1/oboe.ogg"))
+ (and (call-with-input-file filename
+ (lambda (fd)
+ (and (char=? (read-char fd) #\O)
+ (char=? (read-char fd) #\g)
+ (char=? (read-char fd) #\g)
+ (char=? (read-char fd) #\S))))
+ (let ((aufile (string-append filename ".au")))
+ (if (file-exists? aufile) (delete-file aufile))
+ (system (format #f "ogg123 -d au -f ~A ~A" aufile filename))
+ aufile)))))
#|
(hook-push open-hook
- (lambda (filename)
- (if (= (mus-sound-header-type filename) mus-raw)
- (read-ogg filename)
- #f)))
+ (lambda (hook)
+ (let ((filename (hook 'name)))
+ (if (= (mus-sound-header-type filename) mus-raw)
+ (read-ogg filename)))))
+;; was returning #f?
|#
-(define (write-ogg snd)
- "(write-ogg snd) writes 'snd' in OGG format"
- (if (or (> (car (edits snd)) 0)
- (not (= (header-type snd) mus-riff)))
- (let ((file (string-append (file-name snd) ".tmp")))
- (save-sound-as file snd mus-riff)
- (system (format #f "oggenc ~A" file))
- (delete-file file))
- (system (format #f "oggenc ~A" (file-name snd)))))
+(define write-ogg
+ (let ((documentation "(write-ogg snd) writes 'snd' in OGG format"))
+ (lambda (snd)
+ (if (or (> (car (edits snd)) 0)
+ (not (= (header-type snd) mus-riff)))
+ (let ((file (string-append (file-name snd) ".tmp")))
+ (save-sound-as file snd :header-type mus-riff)
+ (system (format #f "oggenc ~A" file))
+ (delete-file file))
+ (system (format #f "oggenc ~A" (file-name snd)))))))
;;; -------- read and write Speex files
-(define (read-speex filename)
- "(read-speex filename) tries to open a SPEEX file"
- (let ((wavfile (string-append filename ".wav")))
- (if (file-exists? wavfile) (delete-file wavfile))
- (system (format #f "speexdec ~A ~A" filename wavfile))
- wavfile))
-
-(define (write-speex snd)
- "(write-speex snd) writes 'snd' in Speex format"
- ;; write snd data in Speex format
- (if (or (> (car (edits snd)) 0)
- (not (= (header-type snd) mus-riff)))
- (let ((file (string-append (file-name snd) ".wav"))
- (spxfile (string-append (file-name snd) ".spx")))
- (save-sound-as file snd mus-riff)
- (system (format #f "speexenc ~A ~A" file spxfile))
- (delete-file file))
- (system (format #f "speexenc ~A ~A" (file-name snd) spxfile))))
+(define read-speex
+ (let ((documentation "(read-speex filename) tries to open a SPEEX file"))
+ (lambda (filename)
+ (let ((wavfile (string-append filename ".wav")))
+ (if (file-exists? wavfile) (delete-file wavfile))
+ (system (format #f "speexdec ~A ~A" filename wavfile))
+ wavfile))))
+
+(define write-speex
+ (let ((documentation "(write-speex snd) writes 'snd' in Speex format"))
+ (lambda (snd)
+ ;; write snd data in Speex format
+ (if (or (> (car (edits snd)) 0)
+ (not (= (header-type snd) mus-riff)))
+ (let ((file (string-append (file-name snd) ".wav"))
+ (spxfile (string-append (file-name snd) ".spx")))
+ (save-sound-as file snd :header-type mus-riff)
+ (system (format #f "speexenc ~A ~A" file spxfile))
+ (delete-file file))
+ (system (format #f "speexenc ~A ~A" (file-name snd) (string-append (file-name snd) ".spx")))))))
;;; -------- read and write FLAC files
-(define (read-flac filename)
- "(read-flac filename) tries to read a FLAC file"
- (system (format #f "flac -d ~A" filename)))
+(define read-flac
+ (let ((documentation "(read-flac filename) tries to read a FLAC file"))
+ (lambda (filename)
+ (system (format #f "flac -d ~A" filename)))))
-(define (write-flac snd)
- "(write-flac snd) writes 'snd' in a FLAC file"
- ;; write snd data in FLAC format
- (if (or (> (car (edits snd)) 0)
- (not (= (header-type snd) mus-riff)))
- (let ((file (string-append (file-name snd) ".wav")))
- (save-sound-as file snd mus-riff)
- (system (format #f "flac ~A" file))
- (delete-file file))
- (system (format #f "flac ~A" (file-name snd)))))
+(define write-flac
+ (let ((documentation "(write-flac snd) writes 'snd' in a FLAC file"))
+ (lambda (snd)
+ ;; write snd data in FLAC format
+ (if (or (> (car (edits snd)) 0)
+ (not (= (header-type snd) mus-riff)))
+ (let ((file (string-append (file-name snd) ".wav")))
+ (save-sound-as file snd :header-type mus-riff)
+ (system (format #f "flac ~A" file))
+ (delete-file file))
+ (system (format #f "flac ~A" (file-name snd)))))))
;;; -------- play AC3 via a52dec
-(define (play-ac3 name)
- "(play-ac3 name) uses a52dec to play an AC3 sound"
- ;; to turn an AC3 file into something Snd can edit, /usr/local/bin/a52dec test.ac3 -o wav > test.wav
- (system (format #f "a52dec ~A" name)))
+(define play-ac3
+ (let ((documentation "(play-ac3 name) uses a52dec to play an AC3 sound"))
+ (lambda (name)
+ ;; to turn an AC3 file into something Snd can edit, /usr/local/bin/a52dec test.ac3 -o wav > test.wav
+ (system (format #f "a52dec ~A" name)))))
;;; -------- read ASCII files
;;;
;;; these are used by Octave (WaveLab) -- each line has one integer, apparently a signed short.
-(define* (read-ascii in-filename (out-filename "test.snd") (out-type mus-next) (out-format mus-bshort) (out-srate 44100))
- "(read-ascii in-filename (out-filename \"test.snd\") (out-type mus-next) (out-format mus-bshort) (out-srate 44100)) tries to \
-read an ASCII sound file"
- (let* ((in-fd (open-input-file in-filename))
- (out-fd (new-sound out-filename out-type out-format out-srate 1 (format #f "created by read-ascii: ~A" in-filename)))
- (bufsize 512)
- (data (make-vct bufsize))
- (loc 0)
- (frame 0)
- (short->float (/ 1.0 32768.0)))
- (as-one-edit
- (lambda ()
- (let loop ((val (read in-fd)))
- (or (eof-object? val)
- (begin
- (set! (data loc) (* val short->float))
- (set! loc (+ 1 loc))
- (if (= loc bufsize)
- (begin
- (vct->channel data frame bufsize out-fd 0)
- (set! frame (+ frame bufsize))
- (set! loc 0)))
- (loop (read in-fd)))))
- (if (> loc 0)
- (vct->channel data frame loc out-fd 0))))
- (close-input-port in-fd)
- out-fd))
+(define read-ascii
+ (let ((documentation "(read-ascii in-filename (out-filename \"test.snd\") (out-type mus-next) (out-format mus-bshort) (out-srate 44100)) tries to \
+read an ASCII sound file"))
+ (lambda* (in-filename (out-filename "test.snd") (out-type mus-next) (out-format mus-bshort) (out-srate 44100))
+ (let ((in-fd (open-input-file in-filename))
+ (out-fd (new-sound out-filename 1 out-srate out-format out-type (format #f "created by read-ascii: ~A" in-filename)))
+ (bufsize 8192)
+ (bufsize1 8191))
+ (as-one-edit
+ (lambda ()
+ (let ((data (make-float-vector bufsize))
+ (short->float (/ 1.0 32768.0)))
+ (do ((fr 0 (+ fr bufsize)))
+ ((eof-object? (peek-char in-fd)))
+ (do ((loc 0 (+ loc 1))
+ (val (read-line in-fd) (read-line in-fd)))
+ ((or (eof-object? val)
+ (= loc bufsize1)) ; bufsize-1 so that we don't throw away a sample at the buffer end
+ (if (number? val)
+ (begin
+ (float-vector-set! data loc (* (string->number val) short->float))
+ (float-vector->channel data fr (+ loc 1) out-fd 0))
+ (float-vector->channel data fr loc out-fd 0)))
+ (float-vector-set! data loc (* (string->number val) short->float)))))))
+ (close-input-port in-fd)
+ out-fd))))
@@ -488,20 +442,22 @@ read an ASCII sound file"
;;;
;;; this could be extended to set time-graph-style to graph-lines if many samples are displayed, etc
-(define (auto-dot snd chn y0 y1)
- "(auto-dot snd chn y0 y1) sets the dot size depending on the number of samples being displayed (use with graph-hook)"
- (let ((dots (- (right-sample snd chn)
- (left-sample snd chn))))
- (if (> dots 100)
- (set! (dot-size snd chn) 1)
- (if (> dots 50)
- (set! (dot-size snd chn) 2)
- (if (> dots 25)
- (set! (dot-size snd chn) 3)
- (set! (dot-size snd chn) 5))))
- #f))
-
-;(hook-push graph-hook auto-dot)
+(define auto-dot
+ (let ((documentation "(auto-dot hook) sets the dot size depending on the number of samples being displayed (use with graph-hook)"))
+ (lambda (hook)
+ (let* ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (dots (- (right-sample snd chn)
+ (left-sample snd chn))))
+ (if (> dots 100)
+ (set! (dot-size snd chn) 1)
+ (if (> dots 50)
+ (set! (dot-size snd chn) 2)
+ (if (> dots 25)
+ (set! (dot-size snd chn) 3)
+ (set! (dot-size snd chn) 5))))))))
+
+ ;(hook-push graph-hook auto-dot)
@@ -512,28 +468,28 @@ read an ASCII sound file"
;;; the desired left edge has a mark, and the 'm' key (without control)
;;; will move the window left edge to that mark.
-(define (first-mark-in-window-at-left)
- "(first-mark-in-window-at-left) moves the graph so that the leftmost visible mark is at the left edge"
- (let* ((keysnd (or (selected-sound) (car (sounds))))
- (keychn (or (selected-channel keysnd) 0))
- (current-left-sample (left-sample keysnd keychn))
- (chan-marks (marks keysnd keychn)))
- (define (find-leftmost-mark samples)
- (if (null? samples)
- #f
- (if (> (car samples) current-left-sample)
- (car samples)
- (find-leftmost-mark (cdr samples)))))
- (if (= (length chan-marks) 0)
- (report-in-minibuffer "no marks!")
- (let ((leftmost (find-leftmost-mark (map mark-sample chan-marks))))
- (if (number? leftmost)
- (begin
- (set! (left-sample keysnd keychn) leftmost)
- keyboard-no-action)
- (report-in-minibuffer "no mark in window"))))))
-
-;(bind-key #\m 0 (lambda () "align window left edge with mark" (first-mark-in-window-at-left)))
+(define first-mark-in-window-at-left
+ (let ((documentation "(first-mark-in-window-at-left) moves the graph so that the leftmost visible mark is at the left edge"))
+ (lambda ()
+ (let* ((keysnd (or (selected-sound) (car (sounds))))
+ (keychn (or (selected-channel keysnd) 0))
+ (current-left-sample (left-sample keysnd keychn))
+ (chan-marks (marks keysnd keychn)))
+ (define (find-leftmost-mark samps)
+ (and (pair? samps)
+ (if (> (car samps) current-left-sample)
+ (car samps)
+ (find-leftmost-mark (cdr samps)))))
+ (if (= (length chan-marks) 0)
+ (status-report "no marks!")
+ (let ((leftmost (find-leftmost-mark (map mark-sample chan-marks))))
+ (if (number? leftmost)
+ (begin
+ (set! (left-sample keysnd keychn) leftmost)
+ keyboard-no-action)
+ (status-report "no mark in window"))))))))
+
+ ;(bind-key #\m 0 (lambda () "align window left edge with mark" (first-mark-in-window-at-left)))
;;; -------- flash selected data red and green
@@ -541,372 +497,368 @@ read an ASCII sound file"
(define flash-selected-data
(let ((data-red? #t)
(red (make-color 1 0 0))
- (green (make-color 0 1 0)))
+ (green (make-color 0 1 0))
+ (documentation "(flash-selected-data millisecs) causes the selected data to flash red and green"))
(lambda (interval)
- "(flash-selected-data millisecs) causes the selected data to flash red and green"
(if (selected-sound)
(begin
- (set! (selected-data-color) (if data-red? green red))
+ (set! *selected-data-color* (if data-red? green red))
(set! data-red? (not data-red?))
(in interval (lambda () (flash-selected-data interval))))))))
;;; -------- use loop info (if any) to set marks at loop points
-(define (mark-loops)
- "(mark-loops) places marks at loop points found in the selected sound's header"
- (let ((loops (or (sound-loop-info)
- (mus-sound-loop-info (file-name)))))
- (if (not (null? loops))
- (begin
- (if (not (and (= (car loops) 0) (= (cadr loops) 0)))
- (begin
- (add-mark (car loops))
- (add-mark (cadr loops))
- (if (not (and (= (caddr loops) 0) (= (cadddr loops) 0)))
- (begin
- (add-mark (caddr loops))
- (add-mark (cadddr loops)))))))
- (snd-print (format #f "~S has no loop info" (short-file-name))))))
-
-
+(define mark-loops
+ (let ((documentation "(mark-loops) places marks at loop points found in the selected sound's header"))
+ (lambda ()
+ (let ((loops (or (sound-loop-info)
+ (mus-sound-loop-info (file-name)))))
+ (if (pair? loops)
+ (if (not (= (car loops) 0 (cadr loops)))
+ (begin
+ (add-mark (car loops))
+ (add-mark (cadr loops))
+ (if (not (= (caddr loops) 0 (cadddr loops)))
+ (begin
+ (add-mark (caddr loops))
+ (add-mark (cadddr loops))))))
+ (snd-print (format #f "~S has no loop info" (short-file-name))))))))
+
+
;;; -------- mapping extensions (map arbitrary single-channel function over various channel collections)
;;;
-(define (all-chans)
- "(all-chans) -> two parallel lists, the first sound objects, the second channel numbers. If we have
-two sounds open (indices 0 and 1 for example), and the second has two channels, (all-chans) returns '((#<sound 0> #<sound 1> #<sound 1>) (0 0 1))"
- (let ((sndlist '())
- (chnlist '()))
- (for-each (lambda (snd)
- (do ((i (- (channels snd) 1) (- i 1)))
- ((< i 0))
- (set! sndlist (cons snd sndlist))
- (set! chnlist (cons i chnlist))))
- (sounds))
- (list sndlist chnlist)))
-
-(define* (do-all-chans func origin)
- "(do-all-chans func edhist) applies func to all active channels, using edhist as the edit history
-indication: (do-all-chans (lambda (val) (* 2.0 val)) \"double all samples\")"
- (apply map (lambda (snd chn)
- (map-channel func 0 #f snd chn #f origin))
- (all-chans)))
-
-(define (update-graphs)
- "(update-graphs) updates (redraws) all graphs"
- (apply map (lambda (snd chn)
- (update-time-graph snd chn))
- (all-chans)))
-
-(define* (do-chans func origin)
- "(do-chans func edhist) applies func to all sync'd channels using edhist as the edit history indication"
- (let ((snc (sync)))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (map-channel func 0 #f snd chn #f origin)))
- (all-chans))
- (snd-warning "sync not set"))))
-
-(define* (do-sound-chans proc origin)
- "(do-sound-chans func args edhist) applies func to all selected channels using edhist as the edit history indication"
- (let ((snd (selected-sound)))
- (if snd
- (begin
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)) #f)
- (map-channel proc 0 #f snd chn #f origin)))
- (snd-warning "no selected sound"))))
-
-(define (every-sample? proc)
- "(every-sample func) -> #t if func is not #f for all samples in the current channel,
-otherwise it moves the cursor to the first offending sample"
- (let ((baddy (scan-channel
- (lambda (y)
- (not (proc y))))))
- (if baddy (set! (cursor) baddy))
- (not baddy)))
-
-(define (sort-samples nbins)
- "(sort-samples bins) provides a histogram in 'bins' bins"
- (let ((bins (make-vector nbins 0)))
- (scan-channel
- (lambda (y)
- (let ((bin (floor (* (abs y) nbins))))
- (set! (bins bin) (+ (bins bin) 1))
- #f)))
- bins))
-
+(define all-chans
+ (let ((documentation "(all-chans) -> two parallel lists, the first sound objects, the second channel numbers. If we have
+two sounds open (indices 0 and 1 for example), and the second has two channels, (all-chans) returns '((#<sound 0> #<sound 1> #<sound 1>) (0 0 1))"))
+ (lambda ()
+ (let ((sndlist ())
+ (chnlist ()))
+ (for-each (lambda (snd)
+ (let ((chntop (- (channels snd) 1)))
+ (do ((i chntop (- i 1)))
+ ((< i 0))
+ (set! sndlist (cons snd sndlist))
+ (set! chnlist (cons i chnlist)))))
+ (sounds))
+ (list sndlist chnlist)))))
+
+(define do-all-chans
+ (let ((documentation "(do-all-chans func edhist) applies func to all active channels, using edhist as the edit history
+indication: (do-all-chans (lambda (val) (* 2.0 val)) \"double all samples\")"))
+ (lambda* (func origin)
+ (apply for-each (lambda (snd chn)
+ (map-channel func 0 #f snd chn #f origin))
+ (all-chans)))))
+
+(define update-graphs
+ (let ((documentation "(update-graphs) updates (redraws) all graphs"))
+ (lambda ()
+ (apply for-each update-time-graph (all-chans)))))
+
+(define do-chans
+ (let ((documentation "(do-chans func edhist) applies func to all sync'd channels using edhist as the edit history indication"))
+ (lambda* (func origin)
+ (let ((snc (sync)))
+ (if (> snc 0)
+ (apply for-each
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (map-channel func 0 #f snd chn #f origin)))
+ (all-chans))
+ (snd-warning "sync not set"))))))
+
+(define do-sound-chans
+ (let ((documentation "(do-sound-chans func edhist) applies func to all selected channels using edhist as the edit history indication"))
+ (lambda* (proc origin)
+ (let ((snd (selected-sound)))
+ (if snd
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels snd)) #f)
+ (map-channel proc 0 #f snd chn #f origin))
+ (snd-warning "no selected sound"))))))
+
+(define every-sample?
+ (let ((documentation "(every-sample func) -> #t if func is not #f for all samples in the current channel,
+otherwise it moves the cursor to the first offending sample"))
+ (lambda (proc)
+ (let ((reader (make-sampler))
+ (len (framples)))
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 0 (+ i 1)))
+ ((= i len) #t)
+ (if (not (proc (next-sample reader)))
+ (begin
+ (set! (cursor) i)
+ (quit #f))))))))))
+
+(define sort-samples
+ (let ((documentation "(sort-samples bins) provides a histogram in 'bins' bins"))
+ (lambda (nbins)
+ (let ((bins (make-vector nbins 0))
+ (reader (make-sampler))
+ (len (framples))
+ (ops (make-vector nbins)))
+ (do ((i 0 (+ i 1)))
+ ((= i nbins))
+ (set! (ops i) (make-one-pole 1.0 -1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (one-pole (vector-ref ops (floor (* nbins (abs (next-sample reader))))) 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i nbins) bins)
+ (set! (bins i) (floor (one-pole (ops i) 0.0))))))))
;;; -------- mix mono sound into stereo sound panning according to env
-(define (place-sound mono-snd stereo-snd pan-env)
- "(place-sound mono-snd stereo-snd pan-env) mixes a mono sound into a stereo sound, splitting
+(define place-sound
+ (let ((documentation "(place-sound mono-snd stereo-snd pan-env) mixes a mono sound into a stereo sound, splitting
it into two copies whose amplitudes depend on the envelope 'pan-env'. If 'pan-env' is
-a number, the sound is split such that 0 is all in channel 0 and 90 is all in channel 1."
- (let ((len (frames mono-snd)))
- (if (number? pan-env)
- (let* ((pos (/ pan-env 90.0))
- (reader0 (make-sampler 0 mono-snd))
- (reader1 (make-sampler 0 mono-snd)))
- (map-channel (lambda (y)
- (+ y (* pos (read-sample reader1))))
- 0 len stereo-snd 1)
- (map-channel (lambda (y)
- (+ y (* (- 1.0 pos) (read-sample reader0))))
- 0 len stereo-snd 0))
- (let ((e0 (make-env pan-env :length len))
- (e1 (make-env pan-env :length len))
- (reader0 (make-sampler 0 mono-snd))
- (reader1 (make-sampler 0 mono-snd)))
- (map-channel (lambda (y)
- (+ y (* (env e1) (read-sample reader1))))
- 0 len stereo-snd 1)
- (map-channel (lambda (y)
- (+ y (* (- 1.0 (env e0)) (read-sample reader0))))
- 0 len stereo-snd 0)))))
+a number, the sound is split such that 0 is all in channel 0 and 90 is all in channel 1."))
+ (lambda (mono-snd stereo-snd pan-env)
+ (let ((len (framples mono-snd)))
+ (if (number? pan-env)
+ (let ((pos (/ pan-env 90.0))
+ (reader0 (make-sampler 0 mono-snd))
+ (reader1 (make-sampler 0 mono-snd)))
+ (map-channel (lambda (y)
+ (+ y (* pos (read-sample reader1))))
+ 0 len stereo-snd 1)
+ (map-channel (lambda (y)
+ (+ y (* (- 1.0 pos) (read-sample reader0))))
+ 0 len stereo-snd 0))
+ (let ((e0 (make-env pan-env :length len))
+ (e1 (make-env pan-env :length len))
+ (reader0 (make-sampler 0 mono-snd))
+ (reader1 (make-sampler 0 mono-snd)))
+ (map-channel (lambda (y)
+ (+ y (* (env e1) (read-sample reader1))))
+ 0 len stereo-snd 1)
+ (map-channel (lambda (y)
+ (+ y (* (- 1.0 (env e0)) (read-sample reader0))))
+ 0 len stereo-snd 0)))))))
;;; -------- FFT-based editing
;;;
-(define* (fft-edit bottom top snd chn)
- "(fft-edit low-Hz high-Hz) ffts an entire sound, removes all energy below low-Hz and all above high-Hz,
-then inverse ffts."
- (let* ((sr (srate snd))
- (len (frames snd chn))
- (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
- (rdata (channel->vct 0 fsize snd chn))
- (idata (make-vct fsize))
- (lo (round (/ bottom (/ sr fsize))))
- (hi (round (/ top (/ sr fsize)))))
- (fft rdata idata 1)
- (if (> lo 0)
- (begin
- (set! (rdata 0) 0.0)
- (set! (idata 0) 0.0)
- (do ((i 1 (+ i 1))
- (j (- fsize 1) (- j 1)))
- ((= i lo))
- (set! (rdata i) 0.0)
- (set! (rdata j) 0.0)
- (set! (idata i) 0.0)
- (set! (idata j) 0.0))))
- (if (< hi (/ fsize 2))
- (do ((i hi (+ i 1))
- (j (- fsize hi) (- j 1)))
- ((= i (/ fsize 2)))
- (set! (rdata i) 0.0)
- (set! (rdata j) 0.0)
- (set! (idata i) 0.0)
- (set! (idata j) 0.0)))
- (fft rdata idata -1)
- (vct-scale! rdata (/ 1.0 fsize))
- (vct->channel rdata 0 (- len 1) snd chn #f (format #f "fft-edit ~A ~A" bottom top))))
-
-
-(define* (fft-squelch squelch snd chn)
- "(fft-squelch squelch) ffts an entire sound, sets all bins to 0.0 whose energy is below squelch, then inverse ffts"
- (let* ((len (frames snd chn))
- (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
- (rdata (channel->vct 0 fsize snd chn))
- (idata (make-vct fsize))
- (fsize2 (/ fsize 2))
- (scaler 1.0))
- (fft rdata idata 1)
- (let ((vr (vct-copy rdata))
- (vi (vct-copy idata)))
- (rectangular->polar vr vi)
- (set! scaler (vct-peak vr)))
- (let ((scl-squelch (* squelch scaler)))
- (if (< (sqrt (+ (* (rdata 0) (rdata 0)) (* (idata 0) (idata 0)))) scl-squelch)
- (begin
- (set! (rdata 0) 0.0)
- (set! (idata 0) 0.0)))
- (do ((i 1 (+ i 1))
- (j (- fsize 1) (- j 1)))
- ((= i fsize2))
- (let ((magnitude (sqrt (+ (* (rdata i) (rdata i)) (* (idata i) (idata i))))))
- (if (< magnitude scl-squelch)
- (begin
- (set! (rdata i) 0.0)
- (set! (rdata j) 0.0)
- (set! (idata i) 0.0)
- (set! (idata j) 0.0)))))
- (fft rdata idata -1)
- (vct-scale! rdata (/ 1.0 fsize)))
- (vct->channel rdata 0 (- len 1) snd chn #f (format #f "fft-squelch ~A" squelch))
- scaler))
-
-
-(define* (fft-cancel lo-freq hi-freq snd chn)
- "(fft-cancel lo-freq hi-freq) ffts an entire sound, sets the bin(s) representing lo-freq to hi-freq to 0.0, then inverse ffts"
- (let* ((sr (srate snd))
- (len (frames snd chn))
- (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
- (rdata (channel->vct 0 fsize snd chn))
- (idata (make-vct fsize)))
- (fft rdata idata 1)
- (let* ((hz-bin (/ sr fsize))
- (lo-bin (round (/ lo-freq hz-bin)))
- (hi-bin (round (/ hi-freq hz-bin))))
- (do ((i lo-bin (+ i 1))
- (j (- fsize lo-bin) (- j 1)))
- ((> i hi-bin))
- (set! (rdata i) 0.0) ; ignoring window side lobes for now
- (set! (idata i) 0.0)
- (set! (rdata j) 0.0)
- (set! (idata j) 0.0)))
- (fft rdata idata -1)
- (vct-scale! rdata (/ 1.0 fsize))
- (vct->channel rdata 0 (- len 1) snd chn #f (format #f "fft-cancel ~A ~A" lo-freq hi-freq))))
-
+(define fft-edit
+ (let ((documentation "(fft-edit low-Hz high-Hz snd chn) ffts an entire sound, removes all energy below low-Hz and all above high-Hz,
+then inverse ffts."))
+ (lambda* (bottom top snd chn)
+ (let* ((sr (srate snd))
+ (len (framples snd chn))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (fsize2 (/ fsize 2))
+ (rdata (channel->float-vector 0 fsize snd chn))
+ (idata (make-float-vector fsize))
+ (lo (round (/ bottom (/ sr fsize))))
+ (hi (round (/ top (/ sr fsize)))))
+ (fft rdata idata 1)
+ (if (> lo 0)
+ (begin
+ (fill! rdata 0.0 0 lo)
+ (fill! idata 0.0 0 lo)
+ (fill! rdata (- fsize lo) fsize)
+ (fill! idata (- fsize lo) fsize)))
+ (if (< hi fsize2)
+ (begin
+ (fill! rdata 0.0 hi (- fsize hi))
+ (fill! idata 0.0 hi (- fsize hi))))
+ (fft rdata idata -1)
+ (float-vector-scale! rdata (/ 1.0 fsize))
+ (float-vector->channel rdata 0 (- len 1) snd chn #f (format #f "fft-edit ~A ~A" bottom top))))))
+
+
+(define fft-squelch
+ (let ((documentation "(fft-squelch squelch snd chn) ffts an entire sound, sets all bins to 0.0 whose energy is below squelch, then inverse ffts"))
+ (lambda* (squelch snd chn)
+ (let* ((len (framples snd chn))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (rdata (channel->float-vector 0 fsize snd chn))
+ (idata (make-float-vector fsize))
+ (scaler 1.0))
+ (fft rdata idata 1)
+ (let ((vr (copy rdata))
+ (vi (copy idata)))
+ (rectangular->polar vr vi)
+ (set! scaler (float-vector-peak vr)))
+ (let ((scl-squelch (* squelch scaler))
+ (rd (copy rdata))
+ (id (copy idata)))
+ (float-vector-multiply! rd rd)
+ (float-vector-multiply! id id)
+ (float-vector-add! rd id)
+ (do ((i 0 (+ i 1)))
+ ((= i fsize))
+ (if (< (sqrt (float-vector-ref rd i)) scl-squelch)
+ (begin
+ (set! (rdata i) 0.0)
+ (set! (idata i) 0.0))))
+ (fft rdata idata -1)
+ (float-vector-scale! rdata (/ 1.0 fsize)))
+ (float-vector->channel rdata 0 (- len 1) snd chn #f (format #f "fft-squelch ~A" squelch))
+ scaler))))
+
+
+(define fft-cancel
+ (let ((documentation "(fft-cancel lo-freq hi-freq snd chn) ffts an entire sound, sets the bin(s) representing lo-freq to hi-freq to 0.0, then inverse ffts"))
+ (lambda* (lo-freq hi-freq snd chn)
+ (let* ((sr (srate snd))
+ (len (framples snd chn))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (rdata (channel->float-vector 0 fsize snd chn))
+ (idata (make-float-vector fsize)))
+ (fft rdata idata 1)
+ (let* ((hz-bin (/ sr fsize))
+ (lo-bin (round (/ lo-freq hz-bin)))
+ (hi-bin (round (/ hi-freq hz-bin))))
+ (fill! rdata 0.0 lo-bin hi-bin)
+ (fill! idata 0.0 lo-bin hi-bin)
+ (fill! rdata 0.0 (- fsize hi-bin) (- fsize lo-bin)))
+ (fft rdata idata -1)
+ (float-vector-scale! rdata (/ 1.0 fsize))
+ (float-vector->channel rdata 0 (- len 1) snd chn #f (format #f "fft-cancel ~A ~A" lo-freq hi-freq))))))
+
;;; same idea but used to distinguish vowels (steady-state) from consonants
-(define (ramp gen up)
- "(ramp gen up) is a kind of CLM generator that produces a ramp of a given length, then sticks at 0.0 or 1.0 until the 'up' argument changes"
- ;; gen is list: ctr size
- ;; the idea here is that we want to ramp in or out a portion of a sound based on some
- ;; factor of the sound data -- the ramp gen produces a ramp up when 'up' is #t, sticking
- ;; at 1.0, and a ramp down when 'up' is #f, sticking at 0.0
- ;;
- ;; this could use the moving-average generator, though the resultant envelopes would be slightly less bumpy
- (let* ((ctr (gen 0))
- (size (gen 1))
- (val (/ ctr size)))
- (set! (gen 0) (min size (max 0 (+ ctr (if up 1 -1)))))
- val))
+(define ramp
+ (let ((documentation "(ramp gen up) is a kind of CLM generator that produces a ramp of a given length, then sticks at 0.0 or 1.0 until the 'up' argument changes"))
+ (lambda (gen up)
+ ;; gen is list: ctr size
+ ;; the idea here is that we want to ramp in or out a portion of a sound based on some
+ ;; factor of the sound data -- the ramp gen produces a ramp up when 'up' is #t, sticking
+ ;; at 1.0, and a ramp down when 'up' is #f, sticking at 0.0
+ ;;
+ ;; this could use the moving-average generator (or one-pole?)
+
+ (let-set! gen 'up up)
+ (with-let gen
+ (set! val (min 1.0 (max 0.0 (+ val (if up incr (- incr))))))))))
(define* (make-ramp (size 128))
- "(make-ramp (size 128)) returns a ramp generator"
- (vct 0.0 size))
-
-
-(define* (squelch-vowels snd chn)
- "(squelch-vowels) suppresses portions of a sound that look like steady-state"
- (let* ((fft-size 32)
- (fft-mid (floor (/ fft-size 2)))
- (rl (make-vct fft-size))
- (im (make-vct fft-size))
- (ramper (make-ramp 256)) ; 512 ok too
- (peak (/ (maxamp) fft-mid))
- (read-ahead (make-sampler 0 snd chn))
- (ctr 0)
- (in-vowel #f))
- (do ((i 0 (+ i 1)))
- ((= i (- fft-size 1)))
- (set! (rl i) (read-ahead)))
- (set! ctr (- fft-size 1))
- (map-channel (lambda (y)
- (set! (rl ctr) (read-ahead))
- (set! ctr (+ 1 ctr))
- (if (= ctr fft-size)
- (begin
- (fft rl im 1)
- (vct-multiply! rl rl)
- (vct-multiply! im im)
- (vct-add! rl im)
- (set! in-vowel (> (+ (rl 0) (rl 1) (rl 2) (rl 3)) peak))
- ;; fancier version checked here ratio of this sum and
- ;; sum of all rl vals, returned vowel if > 0.5
- (set! ctr 0)
- (vct-fill! im 0.0)))
- (let ((rval (- 1.0 (ramp ramper in-vowel))))
- ; squelch consonants if just ramp value (not 1.0-val)
- ;(and (> rval 0.0) ; if this is included, the vowel-portions are omitted
- (* y rval) ; squelch vowels
- ;(* y (+ (* 2 rval) .1)) ;accentuate consonants
- ))
- 0 #f snd chn #f "squelch-vowels")))
-
-
-(define* (fft-env-data fft-env snd chn)
- "(fft-env-data fft-env) applies fft-env as spectral env to current sound, returning vct of new data"
- (let* ((len (frames snd chn))
- (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
- (rdata (channel->vct 0 fsize snd chn))
- (idata (make-vct fsize))
- (fsize2 (/ fsize 2))
- (e (make-env fft-env :length fsize2)))
- (fft rdata idata 1)
- (let ((val (env e)))
- (set! (rdata 0) (* val (rdata 0)))
- (set! (idata 0) (* val (idata 0))))
- (do ((i 1 (+ i 1))
- (j (- fsize 1) (- j 1)))
- ((= i fsize2))
- (let ((val (env e)))
- (set! (rdata i) (* val (rdata i)))
- (set! (idata i) (* val (idata i)))
- (set! (rdata j) (* val (rdata j)))
- (set! (idata j) (* val (idata j)))))
- (fft rdata idata -1)
- (vct-scale! rdata (/ 1.0 fsize))))
-
-
-(define* (fft-env-edit fft-env snd chn)
- "(fft-env-edit fft-env) edits (filters) current chan using fft-env"
- (vct->channel (fft-env-data fft-env snd chn) 0 (- (frames) 1) snd chn #f (format #f "fft-env-edit '~A" fft-env)))
-
-
-(define* (fft-env-interp env1 env2 interp snd chn)
- "(fft-env-interp env1 env2 interp) interpolates between two fft-filtered versions (env1 and env2 are the
-spectral envelopes) following interp (an env between 0 and 1)"
- (let* ((data1 (fft-env-data env1 snd chn))
- (data2 (fft-env-data env2 snd chn))
- (len (frames snd chn))
- (new-data (make-vct len))
- (e (make-env interp :length len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((pan (env e)))
- (set! (new-data i)
- (+ (* (- 1.0 pan) (data1 i))
- (* pan (data2 i))))))
- (vct->channel new-data 0 (- len 1) snd chn #f (format #f "fft-env-interp '~A '~A '~A" env1 env2 interp))))
-
-
-(define* (filter-fft flt (normalize #t) snd chn)
- "(filter-fft flt normalize snd chn) gets the spectrum of all the data in the given channel, \
+ (inlet 'val 0.0 'incr (/ 1.0 size) 'up 1))
+
+;;; (let ((r (make-ramp))) (map-channel (lambda (y) (* y (ramp r (> (random 1.0) 0.5))))))
+
+(define squelch-vowels
+ (let ((documentation "(squelch-vowels snd chn) suppresses portions of a sound that look like steady-state"))
+ (lambda* (snd chn)
+ (let* ((fft-size 32)
+ (fft-mid (floor (/ fft-size 2)))
+ (rl (make-float-vector fft-size))
+ (im (make-float-vector fft-size))
+ (ramper (make-ramp 256)) ; 512 ok too
+ (peak (/ (maxamp) fft-mid))
+ (read-ahead (make-sampler 0 snd chn))
+ (ctr 0)
+ (in-vowel #f))
+ (do ((i 0 (+ i 1)))
+ ((= i fft-size))
+ (float-vector-set! rl i (read-sample read-ahead)))
+ (set! ctr (- fft-size 1))
+ (map-channel (lambda (y)
+ (set! ctr (+ ctr 1))
+ (if (= ctr fft-size)
+ (begin
+ (fft rl im 1)
+ (float-vector-multiply! rl rl)
+ (float-vector-multiply! im im)
+ (float-vector-add! rl im)
+ (set! in-vowel (> (+ (rl 0) (rl 1) (rl 2) (rl 3)) peak))
+ ;; fancier version checked here ratio of this sum and
+ ;; sum of all rl vals, returned vowel if > 0.5
+ (set! ctr 0)
+ (do ((i 0 (+ i 1)))
+ ((= i fft-size))
+ (float-vector-set! rl i (read-sample read-ahead)))
+ (fill! im 0.0)))
+ (let ((rval (- 1.0 (ramp ramper in-vowel))))
+ ; squelch consonants if just ramp value (not 1.0-val)
+ ;(and (> rval 0.0) ; if this is included, the vowel-portions are omitted
+ (* y rval) ; squelch vowels
+ ;(* y (+ (* 2 rval) .1)) ;accentuate consonants
+ ))
+ 0 #f snd chn #f "squelch-vowels")))))
+
+
+(define fft-env-data
+ (let ((documentation "(fft-env-data fft-env snd chn) applies fft-env as spectral env to current sound, returning float-vector of new data"))
+ (lambda* (fft-env snd chn)
+ (let* ((len (framples snd chn))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (rdata (channel->float-vector 0 fsize snd chn))
+ (idata (make-float-vector fsize))
+ (e (make-env (concatenate-envelopes fft-env (reverse-envelope fft-env)) :length fsize))
+ (ve (make-float-vector fsize)))
+ (fft rdata idata 1)
+ (do ((i 0 (+ i 1)))
+ ((= i fsize))
+ (float-vector-set! ve i (env e)))
+ (float-vector-multiply! rdata ve)
+ (float-vector-multiply! idata ve)
+ (fft rdata idata -1)
+ (float-vector-scale! rdata (/ 1.0 fsize))))))
+
+
+(define fft-env-edit
+ (let ((documentation "(fft-env-edit fft-env snd chn) edits (filters) current chan using fft-env"))
+ (lambda* (fft-env snd chn)
+ (float-vector->channel (fft-env-data fft-env snd chn) 0 (- (framples) 1) snd chn #f (format #f "fft-env-edit '~A" fft-env)))))
+
+
+(define fft-env-interp
+ (let ((documentation "(fft-env-interp env1 env2 interp snd chn) interpolates between two fft-filtered versions (env1 and env2 are the
+spectral envelopes) following interp (an env between 0 and 1)"))
+ (lambda* (env1 env2 interp snd chn)
+ (let* ((data1 (fft-env-data env1 snd chn))
+ (data2 (fft-env-data env2 snd chn))
+ (len (framples snd chn))
+ (new-data (make-float-vector len))
+ (e (make-env interp :length len))
+ (erev (make-env (scale-envelope interp -1.0 1.0) :length len))) ; 1.0 - e
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! new-data i
+ (+ (* (env erev) (float-vector-ref data1 i))
+ (* (env e) (float-vector-ref data2 i)))))
+ (float-vector->channel new-data 0 (- len 1) snd chn #f (format #f "fft-env-interp '~A '~A '~A" env1 env2 interp))))))
+
+
+(define filter-fft
+ (let ((documentation "(filter-fft flt normalize snd chn) gets the spectrum of all the data in the given channel, \
applies the function 'flt' to it, then inverse ffts. 'flt' should take one argument, the \
-current spectrum value. (filter-fft (lambda (y) (if (< y .01) 0.0 else y))) is like fft-squelch."
- (let* ((len (frames snd chn))
- (mx (maxamp snd chn))
- (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
- (fsize2 (/ fsize 2))
- (rdata (channel->vct 0 fsize snd chn))
- (idata (make-vct fsize))
- (spect (snd-spectrum rdata rectangular-window fsize #t 1.0 #f normalize))) ; not in-place!
- (fft rdata idata 1)
- (flt (spect 0))
- (do ((i 1 (+ i 1))
- (j (- fsize 1) (- j 1)))
- ((= i fsize2))
- (let* ((orig (spect i))
- (cur (flt orig)))
- (if (> (abs orig) .000001)
- (let ((scl (/ cur orig)))
- (set! (rdata i) (* scl (rdata i)))
- (set! (idata i) (* scl (idata i)))
- (set! (rdata j) (* scl (rdata j)))
- (set! (idata j) (* scl (idata j))))
- (if (> (abs cur) .000001)
- (let ((scl (/ cur (sqrt 2.0))))
- (set! (rdata i) scl)
- (set! (idata i) scl)
- (set! (rdata j) scl)
- (set! (idata j) (- scl)))))))
- (fft rdata idata -1)
- (if (not (= mx 0.0))
- (let ((pk (vct-peak rdata)))
- (vct->channel (vct-scale! rdata (/ mx pk)) 0 (- len 1) snd chn #f (format #f "filter-fft ~A" flt)))
- (vct->channel rdata 0 (- len 1) snd chn #f (format #f "filter-fft ~A" flt)))))
+current spectrum value. (filter-fft (lambda (y) (if (< y .01) 0.0 y))) is like fft-squelch."))
+ (lambda* (flt (normalize #t) snd chn)
+ (let* ((len (framples snd chn))
+ (mx (maxamp snd chn))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (fsize2 (/ fsize 2))
+ ;(orig 0.0) (cur 0.0)
+ (rdata (channel->float-vector 0 fsize snd chn))
+ (idata (make-float-vector fsize))
+ (spect (snd-spectrum rdata rectangular-window fsize #t 1.0 #f normalize)) ; not in-place!
+ (vf (make-float-vector fsize)))
+
+ (fft rdata idata 1)
+ (flt (spect 0))
+ (do ((i 1 (+ i 1))
+ (j (- fsize 1) (- j 1)))
+ ((= i fsize2))
+ (float-vector-set! vf j (float-vector-set! vf i (/ (flt (spect i)) (max (spect i) 1e-5)))))
+ (float-vector-multiply! rdata vf)
+ (float-vector-multiply! idata vf)
+ (fft rdata idata -1)
+ (if (not (= mx 0.0))
+ (let ((pk (float-vector-peak rdata)))
+ (float-vector->channel (float-vector-scale! rdata (/ mx pk)) 0 (- len 1) snd chn #f (format #f "filter-fft ~A" flt)))
+ (float-vector->channel rdata 0 (- len 1) snd chn #f (format #f "filter-fft ~A" flt)))))))
;; (let ((op (make-one-zero .5 .5))) (filter-fft op))
;; (let ((op (make-one-pole .05 .95))) (filter-fft op))
@@ -916,17 +868,16 @@ current spectrum value. (filter-fft (lambda (y) (if (< y .01) 0.0 else y))) is
;; (filter-fft (lambda (y) (* y y y))) ; extreme low pass
#|
-;;; save this example -- find a better use for it someday and add to docs
(let* ((ind (or (find-sound "now.snd")
(open-sound "now.snd")))
(mx (maxamp ind 0)))
(do ((i 1 (+ i 1))
(lo 0.0 (+ lo .1)))
((= i 8))
- (filter-fft (lambda (y) (contrast-enhancement y (+ 1.0 (* lo 30.0)))) #t ind 0 0))
+ (filter-fft (lambda (y) (contrast-enhancement y (+ 1.0 (* lo 30.0)))) #t ind 0))
(let ((mixers (make-vector 8)))
(do ((i 0 (+ i 1))
- (lo 0.0 (+ lo .12)))
+ (lo 0.001 (+ lo .12)))
((= i 8))
(env-sound (list 0 0 lo 1 1 0) 0 #f 32.0 ind 0 (+ i 1))
(set! (mixers i) (make-sampler 0 ind 0 1 (edit-position ind 0))))
@@ -936,296 +887,290 @@ current spectrum value. (filter-fft (lambda (y) (if (< y .01) 0.0 else y))) is
(let ((sum 0.0))
(do ((i 0 (+ i 1)))
((= i 8) sum)
- (set! sum (+ sum (read-sample (mixers i))))))))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (free-sampler (mixers i))))
+ (set! sum (+ sum (read-sample (mixers i)))))))))
(scale-to mx))
|#
-(define* (fft-smoother cutoff start samps snd chn)
- "(fft-smoother cutoff start samps snd chn) uses fft-filtering to smooth a
-section: (vct->channel (fft-smoother .1 (cursor) 400) (cursor) 400)"
- (let* ((fftpts (floor (expt 2 (ceiling (/ (log (+ 1 samps)) (log 2.0))))))
- (rl (channel->vct start fftpts snd chn))
- (im (make-vct fftpts))
- (top (floor (* fftpts cutoff))))
- (let* ((old0 (rl 0))
- (old1 (rl (- samps 1)))
- (oldmax (vct-peak rl)))
- (fft rl im 1)
- (do ((i top (+ i 1)))
- ((= i fftpts))
- (set! (rl i) 0.0)
- (set! (im i) 0.0))
- (fft rl im -1)
- (vct-scale! rl (/ 1.0 fftpts))
- (let ((newmax (vct-peak rl)))
- (if (= newmax 0.0)
- rl
- (begin
- (if (> (/ oldmax newmax) 1.5)
- (vct-scale! rl (/ oldmax newmax)))
- (let* ((new0 (rl 0))
- (new1 (rl (- samps 1)))
- (offset0 (- old0 new0))
- (offset1 (- old1 new1))
- (incr (if (= offset1 offset0) 0.0 (/ (- offset1 offset0) samps))))
- (do ((i 0 (+ i 1))
- (trend offset0 (+ trend incr)))
- ((= i samps))
- (set! (rl i) (+ (rl i) trend)))
- rl)))))))
+(define fft-smoother
+ (let ((documentation "(fft-smoother cutoff start samps snd chn) uses fft-filtering to smooth a
+section: (float-vector->channel (fft-smoother .1 (cursor) 400) (cursor) 400)"))
+ (lambda* (cutoff start samps snd chn)
+ (let* ((fftpts (floor (expt 2 (ceiling (log (+ 1 samps) 2)))))
+ (rl (channel->float-vector start fftpts snd chn))
+ (im (make-float-vector fftpts))
+ (top (floor (* fftpts cutoff))))
+ (let ((old0 (rl 0))
+ (old1 (rl (- samps 1)))
+ (oldmax (float-vector-peak rl)))
+ (fft rl im 1)
+ (do ((i top (+ i 1)))
+ ((= i fftpts))
+ (set! (rl i) 0.0)
+ (set! (im i) 0.0))
+ (fft rl im -1)
+ (float-vector-scale! rl (/ 1.0 fftpts))
+ (let ((newmax (float-vector-peak rl)))
+ (if (= newmax 0.0)
+ rl
+ (begin
+ (if (> (/ oldmax newmax) 1.5)
+ (float-vector-scale! rl (/ oldmax newmax)))
+ (let* ((new0 (rl 0))
+ (new1 (rl (- samps 1)))
+ (offset0 (- old0 new0))
+ (offset1 (- old1 new1))
+ (incr (if (= offset1 offset0) 0.0 (/ (- offset1 offset0) samps))))
+ (do ((i 0 (+ i 1))
+ (trend offset0 (+ trend incr)))
+ ((= i samps))
+ (set! (rl i) (+ (rl i) trend)))
+ rl)))))))))
;;; -------- comb-filter
-(define (comb-filter scaler size)
- "(comb-filter scaler size) returns a comb-filter ready for map-channel etc: (map-channel (comb-filter .8 32)). If you're
-in a hurry use: (clm-channel (make-comb .8 32)) instead"
- (let ((cmb (make-comb scaler size)))
- (lambda (x)
- (comb cmb x))))
+(define comb-filter
+ (let ((documentation "(comb-filter scaler size) returns a comb-filter ready for map-channel etc: (map-channel (comb-filter .8 32)). If you're
+in a hurry use: (clm-channel (make-comb .8 32)) instead"))
+ (lambda (scaler size)
+ (let ((cmb (make-comb scaler size)))
+ (lambda (x)
+ (comb cmb x))))))
;;; by using filters at harmonically related sizes, we can get chords:
-(define (comb-chord scaler size amp)
- "(comb-chord scaler size amp) returns a set of harmonically-related comb filters: (map-channel (comb-chord .95 100 .3))"
- (let ((c1 (make-comb scaler (floor size)))
- (c2 (make-comb scaler (floor (* size .75))))
- (c3 (make-comb scaler (floor (* size 1.2)))))
- (lambda (x)
- (* amp (+ (comb c1 x) (comb c2 x) (comb c3 x))))))
+(define comb-chord
+ (let ((documentation "(comb-chord scaler size amp) returns a set of harmonically-related comb filters: (map-channel (comb-chord .95 100 .3))"))
+ (lambda (scaler size amp)
+ (let ((cs (make-comb-bank (vector (make-comb scaler (floor size))
+ (make-comb scaler (floor (* size .75)))
+ (make-comb scaler (floor (* size 1.2)))))))
+ (lambda (x)
+ (* amp (comb-bank cs x)))))))
;;; or change the comb length via an envelope:
-(define (zcomb scaler size pm)
- "(zcomb scaler size pm) returns a comb filter whose length varies according to an
-envelope: (map-channel (zcomb .8 32 '(0 0 1 10)))"
- (define (max-envelope-1 e mx)
- (if (null? e)
- mx
- (max-envelope-1 (cddr e) (max mx (abs (cadr e))))))
-
- (let ((cmb (make-comb scaler size :max-size (floor (+ size 1 (max-envelope-1 pm 0.0)))))
- (penv (make-env pm :length (frames))))
- (lambda (x)
- (comb cmb x (env penv)))))
+(define zcomb
+ (let ((documentation "(zcomb scaler size pm) returns a comb filter whose length varies according to an
+envelope: (map-channel (zcomb .8 32 '(0 0 1 10)))"))
+ (lambda (scaler size pm)
+ (define (max-envelope-1 e mx)
+ (if (null? e)
+ mx
+ (max-envelope-1 (cddr e) (max mx (abs (cadr e))))))
+
+ (let ((cmb (make-comb scaler size :max-size (floor (+ size 1 (max-envelope-1 pm 0.0)))))
+ (penv (make-env pm :length (framples))))
+ (lambda (x)
+ (comb cmb x (env penv)))))))
-(define (notch-filter scaler size)
- "(notch-filter scaler size) returns a notch-filter: (map-channel (notch-filter .8 32))"
- (let ((cmb (make-notch scaler size)))
- (lambda (x)
- (notch cmb x))))
+(define notch-filter
+ (let ((documentation "(notch-filter scaler size) returns a notch-filter: (map-channel (notch-filter .8 32))"))
+ (lambda (scaler size)
+ (let ((cmb (make-notch scaler size)))
+ (lambda (x)
+ (notch cmb x))))))
-(define (formant-filter radius frequency)
- "(formant-filter radius frequency) returns a formant generator: (map-channel (formant-filter .99 2400)). Faster
-is: (filter-sound (make-formant 2400 .99))"
- (let ((frm (make-formant frequency radius)))
- (lambda (x)
- (formant frm x))))
+(define formant-filter
+ (let ((documentation "(formant-filter radius frequency) returns a formant generator: (map-channel (formant-filter .99 2400)). Faster
+is: (filter-sound (make-formant 2400 .99))"))
+ (lambda (radius frequency)
+ (let ((frm (make-formant frequency radius)))
+ (lambda (x)
+ (formant frm x))))))
;;; to impose several formants, just add them in parallel:
-(define (formants r1 f1 r2 f2 r3 f3)
- "(formants r1 f1 r2 f2 r3 f3) returns 3 formant filters in parallel: (map-channel (formants .99 900 .98 1800 .99 2700))"
- (let ((fr1 (make-formant f1 r1))
- (fr2 (make-formant f2 r2))
- (fr3 (make-formant f3 r3)))
- (lambda (x)
- (+ (formant fr1 x)
- (formant fr2 x)
- (formant fr3 x)))))
-
-
-(define (moving-formant radius move)
- "(moving-formant radius move) returns a time-varying (in frequency) formant filter: (map-channel (moving-formant .99 '(0 1200 1 2400)))"
- (let ((frm (make-formant (cadr move) radius))
- (menv (make-env move :length (frames))))
- (lambda (x)
- (let ((val (formant frm x)))
- (set! (mus-frequency frm) (env menv))
- val))))
-
-
-(define (osc-formants radius bases amounts freqs) ; changed to call map-channel itself, 21-Apr-05
- "(osc-formants radius bases amounts freqs) set up any number of independently oscillating
-formants, then calls map-channel: (osc-formants .99 (vct 400.0 800.0 1200.0) (vct 400.0 800.0 1200.0) (vct 4.0 2.0 3.0)))"
- (let* ((len (length bases))
- (frms (make-vector len))
- (oscs (make-vector len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (frms i) (make-formant (bases i) radius))
- (set! (oscs i) (make-oscil (freqs i))))
- (map-channel
- (lambda (x)
- (let ((val 0.0))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((frm (frms i)))
- (set! val (+ val (formant frm x)))
- (set! (mus-frequency frm)
- (+ (bases i)
- (* (amounts i)
- (oscil (oscs i)))))))
- val)))))
+(define formants
+ (let ((documentation "(formants r1 f1 r2 f2 r3 f3) returns 3 formant filters in parallel: (map-channel (formants .99 900 .98 1800 .99 2700))"))
+ (lambda (r1 f1 r2 f2 r3 f3)
+ (let ((fr1 (make-formant f1 r1))
+ (fr2 (make-formant f2 r2))
+ (fr3 (make-formant f3 r3)))
+ (lambda (x)
+ (+ (formant fr1 x)
+ (formant fr2 x)
+ (formant fr3 x)))))))
+
+
+(define moving-formant
+ (let ((documentation "(moving-formant radius move) returns a time-varying (in frequency) formant filter: (map-channel (moving-formant .99 '(0 1200 1 2400)))"))
+ (lambda (radius move)
+ (let ((frm (make-formant (cadr move) radius))
+ (menv (make-env move :length (framples))))
+ (lambda (x)
+ (let ((val (formant frm x)))
+ (mus-set-formant-frequency frm (env menv))
+ val))))))
+
+
+(define osc-formants
+ (let ((documentation "(osc-formants radius bases amounts freqs) set up any number of independently oscillating
+formants, then calls map-channel: (osc-formants .99 (float-vector 400.0 800.0 1200.0) (float-vector 400.0 800.0 1200.0) (float-vector 4.0 2.0 3.0))"))
+ (lambda (radius bases amounts freqs) ; changed to call map-channel itself, 21-Apr-05
+ (let ((len (length bases)))
+ (if (= len 3)
+ ;; this way is faster but verbose
+ (let ((fa1 (amounts 0))
+ (fa2 (amounts 1))
+ (fa3 (amounts 2))
+ (frq1 (bases 0))
+ (frq2 (bases 1))
+ (frq3 (bases 2))
+ (fr1 (make-formant (bases 0) radius))
+ (fr2 (make-formant (bases 1) radius))
+ (fr3 (make-formant (bases 2) radius))
+ (o1 (make-oscil (freqs 0)))
+ (o2 (make-oscil (freqs 1)))
+ (o3 (make-oscil (freqs 2))))
+ (map-channel
+ (lambda (y)
+ (+ (formant fr1 y (hz->radians (+ frq1 (* fa1 (oscil o1)))))
+ (formant fr2 y (hz->radians (+ frq2 (* fa2 (oscil o2)))))
+ (formant fr3 y (hz->radians (+ frq3 (* fa3 (oscil o3)))))))))
+
+ (let ((frms (make-vector len))
+ (oscs (make-vector len))
+ (amps (make-float-vector len 1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (frms i) (make-formant (bases i) radius))
+ (set! (oscs i) (make-oscil (freqs i))))
+ (let ((frms1 (make-formant-bank frms amps)))
+ (map-channel
+ (lambda (x)
+ (let ((val (formant-bank frms1 x)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (mus-set-formant-frequency (vector-ref frms i)
+ (+ (bases i)
+ (* (amounts i)
+ (oscil (oscs i))))))
+ val))))))))))
;;; -------- echo
-(define (echo scaler secs)
- "(echo scaler secs) returns an echo maker: (map-channel (echo .5 .5) 0 44100)"
- (let ((del (make-delay (round (* secs (srate))))))
- (lambda (inval)
- (+ inval (delay del (* scaler (+ (tap del) inval)))))))
-
-
-(define (zecho scaler secs frq amp)
- "(zecho scaler secs freq amp) returns a modulated echo maker: (map-channel (zecho .5 .75 6 10.0) 0 65000)"
- (let* ((os (make-oscil frq))
- (len (round (* secs (srate))))
- (del (make-delay len :max-size (floor (+ len amp 1)))))
- (lambda (inval)
- (+ inval
- (delay del
- (* scaler (+ (tap del) inval))
- (* amp (oscil os)))))))
-
-
-(define (flecho scaler secs)
- "(flecho scaler secs) returns a low-pass filtered echo maker: (map-channel (flecho .5 .9) 0 75000)"
- (let* ((flt (make-fir-filter :order 4 :xcoeffs (vct .125 .25 .25 .125)))
- (del (make-delay (round (* secs (srate))))))
- (lambda (inval)
- (+ inval
- (delay del
- (fir-filter flt (* scaler (+ (tap del) inval))))))))
+(define echo
+ (let ((documentation "(echo scaler secs) returns an echo maker: (map-channel (echo .5 .5) 0 44100)"))
+ (lambda (scaler secs)
+ (let ((del (make-delay (round (* secs (srate))))))
+ (lambda (inval)
+ (+ inval (delay del (* scaler (+ (tap del) inval)))))))))
+
+
+(define zecho
+ (let ((documentation "(zecho scaler secs freq amp) returns a modulated echo maker: (map-channel (zecho .5 .75 6 10.0) 0 65000)"))
+ (lambda (scaler secs frq amp)
+ (let* ((os (make-oscil frq))
+ (len (round (* secs (srate))))
+ (del (make-delay len :max-size (floor (+ len amp 1)))))
+ (lambda (inval)
+ (+ inval
+ (delay del
+ (* scaler (+ (tap del) inval))
+ (* amp (oscil os)))))))))
+
+
+(define flecho
+ (let ((documentation "(flecho scaler secs) returns a low-pass filtered echo maker: (map-channel (flecho .5 .9) 0 75000)"))
+ (lambda (scaler secs)
+ (let ((flt (make-fir-filter :order 4 :xcoeffs (float-vector .125 .25 .25 .125)))
+ (del (make-delay (round (* secs (srate))))))
+ (lambda (inval)
+ (+ inval
+ (delay del
+ (fir-filter flt (* scaler (+ (tap del) inval))))))))))
;;; -------- ring-mod and am
;;;
;;; CLM instrument is ring-modulate.ins
-(define (ring-mod freq gliss-env)
- "(ring-mod freq gliss-env) returns a time-varying ring-modulation filter: (map-channel (ring-mod 10 (list 0 0 1 (hz->radians 100))))"
- (let* ((os (make-oscil :frequency freq))
- (len (frames))
- (genv (make-env gliss-env :length len)))
- (lambda (inval)
- (* (oscil os (env genv)) inval))))
+(define ring-mod
+ (let ((documentation "(ring-mod freq gliss-env) returns a time-varying ring-modulation filter: (map-channel (ring-mod 10 (list 0 0 1 (hz->radians 100))))"))
+ (lambda (freq gliss-env)
+ (let* ((os (make-oscil :frequency freq))
+ (len (framples))
+ (genv (make-env gliss-env :length len)))
+ (lambda (inval)
+ (* (oscil os (env genv)) inval))))))
-(define (am freq)
- "(am freq)returns an amplitude-modulator: (map-channel (am 440))"
- (let ((os (make-oscil freq)))
- (lambda (inval)
- (amplitude-modulate 1.0 inval (oscil os)))))
+(define am
+ (let ((documentation "(am freq)returns an amplitude-modulator: (map-channel (am 440))"))
+ (lambda (freq)
+ (let ((os (make-oscil freq)))
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (oscil os)))))))
;;; this taken from sox (vibro.c)
-(define (vibro speed depth)
- "(vibro speed depth) adds vibrato or tremolo"
- (let* ((sine (make-oscil speed))
- (scl (* 0.5 depth))
- (offset (- 1.0 scl)))
- (lambda (y)
- (* y (+ offset (* scl (oscil sine)))))))
+(define vibro
+ (let ((documentation "(vibro speed depth) adds vibrato or tremolo"))
+ (lambda (speed depth)
+ (let* ((sine (make-oscil speed))
+ (scl (* 0.5 depth))
+ (offset (- 1.0 scl)))
+ (lambda (y)
+ (* y (+ offset (* scl (oscil sine)))))))))
;;; -------- hello-dentist
;;;
;;; CLM instrument version is in clm.html
-(define* (hello-dentist frq amp snd chn)
- "(hello-dentist frq amp) varies the sampling rate randomly, making a voice sound quavery: (hello-dentist 40.0 .1)"
- (let* ((rn (make-rand-interp :frequency frq :amplitude amp))
- (i 0)
- (len (frames))
- (in-data (channel->vct 0 len snd chn))
- (out-len (round (* len (+ 1.0 (* 2 amp)))))
- (out-data (make-vct out-len))
- (rd (make-src :srate 1.0
- :input (lambda (dir)
- (let ((val (if (and (>= i 0) (< i len))
- (in-data i)
- 0.0)))
- (set! i (+ i dir))
- val)))))
- (vct->channel
- (vct-map! out-data
- (lambda ()
- (src rd (rand-interp rn))))
- 0 len snd chn #f (format #f "hello-dentist ~A ~A" frq amp))))
+(define hello-dentist
+ (let ((documentation "(hello-dentist frq amp snd chn) varies the sampling rate randomly, making a voice sound quavery: (hello-dentist 40.0 .1)"))
+ (lambda* (frq amp snd chn)
+ (let* ((rn (make-rand-interp :frequency frq :amplitude amp))
+ (len (framples))
+ (rd (make-sampler 0 snd chn))
+ (sr (make-src :srate 1.0
+ :input (lambda (dir) (read-sample-with-direction rd dir)))))
+ (map-channel
+ (lambda (y)
+ (src sr (rand-interp rn)))
+ 0 len snd chn #f (format #f "hello-dentist ~A ~A" frq amp))))))
;;; a very similar function uses oscil instead of rand-interp, giving
;;; various "Forbidden Planet" sound effects:
-(define* (fp sr osamp osfrq snd chn)
- "(fp sr osamp osfrq) varies the sampling rate via an oscil: (fp 1.0 .3 20)"
- (let* ((os (make-oscil osfrq))
- (s (make-src :srate sr))
- (len (frames snd chn))
- (sf (make-sampler 0 snd chn))
- (out-data (make-vct len))
- (amp osamp))
- (vct-map! out-data
- (lambda ()
- (src s (* amp (oscil os))
- (lambda (dir)
- (if (> dir 0)
- (next-sample sf)
- (previous-sample sf))))))
- (free-sampler sf)
- (vct->channel out-data 0 len snd chn #f (format #f "fp ~A ~A ~A" sr osamp osfrq))))
-
+(define fp
+ (let ((documentation "(fp sr osamp osfrq snd chn) varies the sampling rate via an oscil: (fp 1.0 .3 20)"))
+ (lambda* (sr osamp osfrq snd chn)
+ (let* ((os (make-oscil osfrq))
+ (sf (make-sampler 0 snd chn))
+ (s (make-src :srate sr :input (lambda (dir) (read-sample-with-direction sf dir)))))
+ (map-channel
+ (lambda (y)
+ (src s (* osamp (oscil os))))
+ 0 #f snd chn #f (format #f "fp ~A ~A ~A" sr osamp osfrq))))))
-;;; -------- compand, compand-channel
-
-(define compand-table (vct -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
- 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000))
-;; (we're eye-balling the curve on p55 of Steiglitz's "a DSP Primer")
-
-(define (compand)
- "(compand) returns a compander: (map-channel (compand))"
- (lambda (inval)
- (let ((index (+ 8.0 (* 8.0 inval))))
- (array-interp compand-table index 17))))
-;;; here's the virtual op version:
-
-(define* (compand-channel (beg 0) dur snd chn edpos)
- "(compand-channel (beg 0) dur snd chn edpos) applies a standard compander to sound"
- ;; this is the "regularized version of the compander using ptree-channel
- (ptree-channel (lambda (inval)
- (let ((index (+ 8.0 (* 8.0 inval))))
- (array-interp compand-table index 17)))
- beg dur snd chn edpos #t #f
- (format #f "compand-channel ~A ~A" beg dur)))
-
+;;; -------- compand, compand-channel
-(define* (compand-sound (beg 0) dur snd)
- "(compand-sound beg dur snd) applies companding to every channel of 'snd'"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (sound? index)
- (let* ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (compand-channel beg dur index chn)))
- (throw 'no-such-sound (list "compand-sound" snd)))))
+(define compand-table (float-vector -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
+ 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000))
+;; (we're eye-balling the curve on p55 of Steiglitz's "a DSP Primer")
+(define compand
+ (let ((documentation "(compand) returns a compander: (map-channel (compand))"))
+ (lambda ()
+ (lambda (inval)
+ (array-interp compand-table (+ 8.0 (* 8.0 inval)) 17)))))
;;; -------- shift pitch keeping duration constant
@@ -1234,185 +1179,179 @@ formants, then calls map-channel: (osc-formants .99 (vct 400.0 800.0 1200.0) (vc
;;; in this case, src calls granulate which reads the currently selected file.
;;; CLM version is in expsrc.ins
-(define* (expsrc rate snd chn)
- "(expsrc rate snd chn) uses sampling-rate conversion and granular synthesis
-to produce a sound at a new pitch but at the original tempo. It returns a function for map-channel."
- (let* ((gr (make-granulate :expansion rate))
- ;; this can be improved by messing with make-granulate's hop and length args
- (sr (make-src :srate rate))
- (vsize 1024)
- (vbeg 0)
- (v (channel->vct 0 vsize))
- (inctr 0))
- (lambda (inval)
- (src sr 0.0
- (lambda (dir)
- (granulate gr
- (lambda (dir)
- (let ((val (v inctr)))
- (set! inctr (+ inctr dir))
- (if (>= inctr vsize)
- (begin
- (set! vbeg (+ vbeg inctr))
- (set! inctr 0)
- (set! v (channel->vct vbeg vsize snd chn))))
- val))))))))
+(define expsrc
+ (let ((documentation "(expsrc rate snd chn) uses sampling-rate conversion and granular synthesis
+to produce a sound at a new pitch but at the original tempo. It returns a function for map-channel."))
+ (lambda* (rate snd chn)
+ (let* ((gr (make-granulate :expansion rate
+ :input (make-sampler 0 snd chn)))
+ (sr (make-src :srate rate
+ :input (lambda (dir) (granulate gr)))))
+ (lambda (inval)
+ (src sr 0.0))))))
;;; the next (expsnd) changes the tempo according to an envelope; the new duration
;;; will depend on the expansion envelope -- we integrate it to get
;;; the overall expansion, then use that to decide the new length.
-(define* (expsnd gr-env snd chn)
- "(expsnd gr-env) uses the granulate generator to change tempo according to an envelope: (expsnd '(0 .5 2 2.0))"
- (let* ((dur (/ (* (/ (frames snd chn) (srate snd))
- (integrate-envelope gr-env)) ; in env.scm
- (envelope-last-x gr-env)))
- (gr (make-granulate :expansion (cadr gr-env) :jitter 0))
- (ge (make-env gr-env :duration dur))
- (sound-len (round (* (srate snd) dur)))
- (len (max sound-len (frames snd chn)))
- (out-data (make-vct len))
- (sf (make-sampler 0 snd chn)))
- (vct-map! out-data (lambda ()
- (let ((val (granulate gr (lambda (dir) (next-sample sf)))))
- (set! (mus-increment gr) (env ge))
- val)))
- (free-sampler sf)
- (vct->channel out-data 0 len snd chn #f (format #f "expsnd '~A" gr-env))))
+(define expsnd
+ (let ((documentation "(expsnd gr-env snd chn) uses the granulate generator to change tempo according to an envelope: (expsnd '(0 .5 2 2.0))"))
+ (lambda* (gr-env snd chn)
+ (let* ((dur (/ (* (/ (framples snd chn) (srate snd))
+ (integrate-envelope gr-env)) ; in env.scm
+ (envelope-last-x gr-env)))
+ (gr (make-granulate :expansion (cadr gr-env)
+ :jitter 0
+ :input (make-sampler 0 snd chn)))
+ (ge (make-env gr-env :duration dur))
+ (sound-len (round (* (srate snd) dur)))
+ (len (max sound-len (framples snd chn)))
+ (out-data (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! out-data i (granulate gr))
+ (set! (mus-increment gr) (env ge)))
+ (float-vector->channel out-data 0 len snd chn #f (format #f "expsnd '~A" gr-env))))))
;;; -------- cross-synthesis
;;;
;;; CLM version is in clm.html
-(define (cross-synthesis cross-snd amp fftsize r)
- "(cross-synthesis cross-snd amp fftsize r) does cross-synthesis between 'cross-snd' (a sound object) and the currently
-selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"
- (let* ((freq-inc (/ fftsize 2))
- (fdr (make-vct fftsize))
- (fdi (make-vct fftsize))
- (spectr (make-vct freq-inc))
- (inctr 0)
- (ctr freq-inc)
- (radius (- 1.0 (/ r fftsize)))
- (bin (/ (srate) fftsize))
- (formants (make-vector freq-inc))
- (old-srate (mus-srate)))
- (set! (mus-srate) (srate))
- ;; if mus-srate is 44.1k and srate is 48k, make-formant thinks we're trying to go past srate/2
- ;; and in any case it's setting its formants incorrectly for the actual output srate
- (do ((i 0 (+ i 1)))
- ((= i freq-inc))
- (set! (formants i) (make-formant (* i bin) radius)))
- (set! (mus-srate) old-srate)
- (lambda (inval)
- (if (= ctr freq-inc)
- (let ((fdtmp (channel->vct inctr fftsize cross-snd 0)))
- (set! inctr (+ inctr freq-inc))
- (spectrum fdtmp fdi #f 2)
- (vct-subtract! fdtmp spectr)
- (vct-scale! fdtmp (/ 1.0 freq-inc))
- (vct-scale! fdr 0.0)
- (vct-add! fdr fdtmp)
- (set! ctr 0)))
- (set! ctr (+ ctr 1))
- (vct-add! spectr fdr)
- (* amp (formant-bank spectr formants inval)))))
-
-
-;;; TODO: all the make-formants probably need mus-srate fixups
+(define cross-synthesis
+ (let ((documentation "(cross-synthesis cross-snd amp fftsize r) does cross-synthesis between 'cross-snd' (a sound object) and the currently
+selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"))
+ (lambda (cross-snd amp fftsize r)
+ (let* ((freq-inc (/ fftsize 2))
+ (fdr #f)
+ (fdi (make-float-vector fftsize))
+ (spectr (make-float-vector freq-inc))
+ (inctr 0)
+ (ctr freq-inc)
+ (radius (- 1.0 (/ r fftsize)))
+ (bin (/ (srate) fftsize))
+ (formants (make-vector freq-inc))
+ (old-srate *clm-srate*))
+ (set! *clm-srate* (srate))
+ ;; if mus-srate is 44.1k and srate is 48k, make-formant thinks we're trying to go past srate/2
+ ;; and in any case it's setting its formants incorrectly for the actual output srate
+
+ (do ((i 0 (+ i 1)))
+ ((= i freq-inc))
+ (set! (formants i) (make-formant (* i bin) radius)))
+ (set! formants (make-formant-bank formants spectr))
+ (set! *clm-srate* old-srate)
+
+ (lambda (inval)
+ (if (= ctr freq-inc)
+ (begin
+ (set! fdr (channel->float-vector inctr fftsize cross-snd 0))
+ (set! inctr (+ inctr freq-inc))
+ (spectrum fdr fdi #f 2)
+ (float-vector-subtract! fdr spectr)
+ (float-vector-scale! fdr (/ 1.0 freq-inc))
+ (set! ctr 0)))
+ (set! ctr (+ ctr 1))
+ (float-vector-add! spectr fdr)
+ (* amp (formant-bank formants inval)))))))
+
+
;;; similar ideas can be used for spectral cross-fades, etc -- for example:
-(define* (voiced->unvoiced amp fftsize r tempo snd chn)
- "(voiced->unvoiced amp fftsize r tempo) turns a vocal sound into whispering: (voiced->unvoiced 1.0 256 2.0 2.0)"
- (let* ((freq-inc (/ fftsize 2))
- (fdr (make-vct fftsize))
- (fdi (make-vct fftsize))
- (spectr (make-vct freq-inc))
- (noi (make-rand (/ (srate snd) 3)))
- (inctr 0)
- (ctr freq-inc)
- (radius (- 1.0 (/ r fftsize)))
- (bin (/ (srate snd) fftsize))
- (len (frames snd chn))
- (outlen (floor (/ len tempo)))
- (hop (floor (* freq-inc tempo)))
- (out-data (make-vct (max len outlen)))
- (formants (make-vector freq-inc))
- (old-peak-amp 0.0)
- (new-peak-amp 0.0))
- (do ((i 0 (+ i 1)))
- ((= i freq-inc))
- (set! (formants i) (make-formant (* i bin) radius)))
- (run
- (do ((k 0 (+ 1 k)))
- ((= k outlen))
- (let ((outval 0.0))
- (if (= ctr freq-inc)
- (let ((fdtmp (channel->vct inctr fftsize snd chn)))
- (let ((pk (vct-peak fdtmp)))
- (if (> pk old-peak-amp) (set! old-peak-amp pk)))
- (spectrum fdtmp fdi #f 2)
- (set! inctr (+ hop inctr))
- (vct-subtract! fdtmp spectr)
- (vct-scale! fdtmp (/ 1.0 freq-inc))
- (vct-scale! fdr 0.0)
- (vct-add! fdr fdtmp)
- (set! ctr 0)))
- (set! ctr (+ ctr 1))
- (vct-add! spectr fdr)
- (set! outval (formant-bank spectr formants (rand noi)))
- (if (> (abs outval) new-peak-amp) (set! new-peak-amp (abs outval)))
- (set! (out-data k) outval)))
- (vct-scale! out-data (* amp (/ old-peak-amp new-peak-amp)))
- (vct->channel out-data 0 (max len outlen) snd chn))))
+(define voiced->unvoiced
+ (let ((documentation "(voiced->unvoiced amp fftsize r tempo snd chn) turns a vocal sound into whispering: (voiced->unvoiced 1.0 256 2.0 2.0)"))
+ (lambda* (amp fftsize r tempo snd chn)
+ (let* ((freq-inc (/ fftsize 2))
+ (fdr #f)
+ (fdi (make-float-vector fftsize))
+ (spectr (make-float-vector freq-inc))
+ (noi (make-rand (/ (srate snd) 3)))
+ (inctr 0)
+ (ctr 0)
+ (radius (- 1.0 (/ r fftsize)))
+ (bin (/ (srate snd) fftsize))
+ (len (framples snd chn))
+ (outlen (floor (/ len tempo)))
+ (hop (floor (* freq-inc tempo)))
+ (out-data (make-float-vector (max len outlen)))
+ (formants (make-vector freq-inc))
+ (old-peak-amp 0.0))
+
+ (do ((i 0 (+ i 1)))
+ ((= i freq-inc))
+ (set! (formants i) (make-formant (* i bin) radius)))
+ (set! formants (make-formant-bank formants spectr))
+
+ (do ((i 0 (+ i freq-inc)))
+ ((>= i outlen))
+ (set! ctr (min (- outlen i) freq-inc))
+ (if (odd? ctr) (set! ctr (- ctr 1)))
+
+ (set! fdr (channel->float-vector inctr fftsize snd chn))
+ (let ((pk (float-vector-peak fdr)))
+ (if (> pk old-peak-amp) (set! old-peak-amp pk)))
+ (spectrum fdr fdi #f 2)
+ (float-vector-subtract! fdr spectr)
+ (float-vector-scale! fdr (/ 2.0 freq-inc))
+ (set! inctr (+ inctr hop))
+
+ (do ((k 0 (+ k 2))
+ (j i (+ j 2)))
+ ((= k ctr))
+ (float-vector-add! spectr fdr)
+ (float-vector-set! out-data j (formant-bank formants (rand noi)))
+ (float-vector-set! out-data (+ j 1) (formant-bank formants (rand noi)))))
+
+ (float-vector-scale! out-data (* amp (/ old-peak-amp (float-vector-peak out-data))))
+ (float-vector->channel out-data 0 (max len outlen) snd chn)))))
;;; very similar but use ncos (glottal pulse train?) instead of white noise
-(define* (pulse-voice cosines (freq 440.0) (amp 1.0) (fftsize 256) (r 2.0) snd chn)
- "(pulse-voice cosines (freq 440) (amp 1.0) (fftsize 256) (r 2.0) snd chn) uses ncos to manipulate speech sounds"
- (let* ((freq-inc (/ fftsize 2))
- (fdr (make-vct fftsize))
- (fdi (make-vct fftsize))
- (spectr (make-vct freq-inc))
- (pulse (make-ncos freq cosines))
- (inctr 0)
- (ctr freq-inc)
- (radius (- 1.0 (/ r fftsize)))
- (bin (/ (srate snd) fftsize))
- (len (frames snd chn))
- (out-data (make-vct len))
- (formants (make-vector freq-inc))
- (old-peak-amp 0.0)
- (new-peak-amp 0.0))
- (do ((i 0 (+ i 1)))
- ((= i freq-inc))
- (set! (formants i) (make-formant (* i bin) radius)))
- (run
- (do ((k 0 (+ 1 k)))
- ((= k len))
- (let ((outval 0.0))
- (if (= ctr freq-inc)
- (let ((fdtmp (channel->vct inctr fftsize snd chn)))
- (let ((pk (vct-peak fdtmp)))
- (if (> pk old-peak-amp) (set! old-peak-amp pk)))
- (spectrum fdtmp fdi #f 2)
- (set! inctr (+ freq-inc inctr))
- (vct-subtract! fdtmp spectr)
- (vct-scale! fdtmp (/ 1.0 freq-inc))
- (vct-scale! fdr 0.0)
- (vct-add! fdr fdtmp)
- (set! ctr 0)))
- (set! ctr (+ ctr 1))
- (vct-add! spectr fdr)
- (set! outval (formant-bank spectr formants (ncos pulse)))
- (if (> (abs outval) new-peak-amp) (set! new-peak-amp (abs outval)))
- (set! (out-data k) outval)))
- (vct-scale! out-data (* amp (/ old-peak-amp new-peak-amp)))
- (vct->channel out-data 0 (max len len) snd chn))))
+(define pulse-voice
+ (let ((documentation "(pulse-voice cosines (freq 440) (amp 1.0) (fftsize 256) (r 2.0) snd chn) uses ncos to manipulate speech sounds"))
+ (lambda* (cosines (freq 440.0) (amp 1.0) (fftsize 256) (r 2.0) snd chn)
+ (let* ((freq-inc (/ fftsize 2))
+ (fdr #f)
+ (fdi (make-float-vector fftsize))
+ (spectr (make-float-vector freq-inc))
+ (pulse (make-ncos freq cosines))
+ (inctr 0)
+ (ctr 0)
+ (radius (- 1.0 (/ r fftsize)))
+ (bin (/ (srate snd) fftsize))
+ (len (framples snd chn))
+ (out-data (make-float-vector len))
+ (formants (make-vector freq-inc))
+ (old-peak-amp 0.0))
+
+ (do ((i 0 (+ i 1)))
+ ((= i freq-inc))
+ (set! (formants i) (make-formant (* i bin) radius)))
+ (set! formants (make-formant-bank formants spectr))
+
+ (do ((i 0 (+ i freq-inc)))
+ ((>= i len))
+ (set! ctr (min (- len i) freq-inc))
+
+ (set! fdr (channel->float-vector inctr fftsize snd chn))
+ (let ((pk (float-vector-peak fdr)))
+ (if (> pk old-peak-amp) (set! old-peak-amp pk)))
+ (spectrum fdr fdi #f 2)
+ (float-vector-subtract! fdr spectr)
+ (float-vector-scale! fdr (/ 1.0 freq-inc))
+ (set! inctr (+ inctr freq-inc))
+
+ (do ((k 0 (+ k 1))
+ (j i (+ j 1)))
+ ((= k ctr))
+ (float-vector-add! spectr fdr)
+ (float-vector-set! out-data j (formant-bank formants (ncos pulse)))))
+
+ (float-vector-scale! out-data (* amp (/ old-peak-amp (float-vector-peak out-data))))
+ (float-vector->channel out-data 0 len snd chn)))))
;;; (pulse-voice 80 20.0 1.0 1024 0.01)
;;; (pulse-voice 80 120.0 1.0 1024 0.2)
@@ -1423,69 +1362,39 @@ selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"
;;; -------- convolution example
-(define (cnvtest snd0 snd1 amp)
- "(cnvtest snd0 snd1 amp) convolves snd0 and snd1, scaling by amp, returns new max amp: (cnvtest 0 1 .1)"
- (let* ((flt-len (frames snd0))
- (total-len (+ flt-len (frames snd1)))
- (cnv (make-convolve :filter (channel->vct 0 flt-len snd0)))
- (sf (make-sampler 0 snd1))
- (out-data (make-vct total-len)))
- (vct-map! out-data (lambda () (convolve cnv (lambda (dir) (next-sample sf)))))
- (free-sampler sf)
- (vct-scale! out-data amp)
- (let ((max-samp (vct-peak out-data)))
- (vct->channel out-data 0 total-len snd1)
- (if (> max-samp 1.0) (set! (y-bounds snd1) (list (- max-samp) max-samp)))
- max-samp)))
-
-#|
-;;; -------- time varying FIR filter (not very interesting...)
-
-(define (fltit)
- "(fltit) returns a time-varying filter: (map-channel (fltit))"
- (let* ((coeffs (list .1 .2 .3 .4 .4 .3 .2 .1))
- (flt (make-fir-filter 8 (list->vct coeffs)))
- (es (make-vector 8)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (set! (es i) (make-env (list 0 (list-ref coeffs i) 1 0) :length 100)))
- (set! (es 5) (make-env '(0 .4 1 1) :duration 1.0))
- (lambda (x)
- (let ((val (fir-filter flt x))
- (xcof (mus-xcoeffs flt)))
+(define cnvtest
+ (let ((documentation "(cnvtest snd0 snd1 amp) convolves snd0 and snd1, scaling by amp, returns new max amp: (cnvtest 0 1 .1)"))
+ (lambda (snd0 snd1 amp)
+ (let* ((flt-len (framples snd0))
+ (total-len (+ flt-len (framples snd1)))
+ (cnv (make-convolve :filter (channel->float-vector 0 flt-len snd0)
+ :input (make-sampler 0 snd1)))
+ (out-data (make-float-vector total-len)))
(do ((i 0 (+ i 1)))
- ((= i 8))
- (set! (xcof i) (env (es i))))
- val))))
-
-;;; for something this simple (like a notch filter), we can use a two-zero filter:
-;
-;(define flt (make-zpolar .99 550.0))
-;
-;;; this is a strong notch filter centered at 550 Hz
-;
-;(map-channel (lambda (x) (two-zero flt x)))
-;
-;;; similarly make-two-pole (or better, make-formant)
-;;; can be used for resonances.
-|#
+ ((= i total-len))
+ (float-vector-set! out-data i (convolve cnv)))
+ (float-vector-scale! out-data amp)
+ (let ((max-samp (float-vector-peak out-data)))
+ (float-vector->channel out-data 0 total-len snd1)
+ (if (> max-samp 1.0) (set! (y-bounds snd1) (list (- max-samp) max-samp)))
+ max-samp)))))
+
;;; -------- locate-zero (Anders Vinjar)
-(define (locate-zero limit)
- "(locate-zero limit) looks for successive samples that sum to less than 'limit', moving the cursor if successful"
- (let* ((start (cursor))
- (sf (make-sampler start)))
- (do ((n start (+ 1 n))
- (val0 (abs (next-sample sf)) val1)
- (val1 (abs (next-sample sf)) (abs (next-sample sf))))
- ((or (sampler-at-end? sf)
- (< (+ val0 val1) limit))
- (begin
- (free-sampler sf)
- (set! (cursor) n)
- n)))))
+(define locate-zero
+ (let ((documentation "(locate-zero limit) looks for successive samples that sum to less than 'limit', moving the cursor if successful"))
+ (lambda (limit)
+ (let* ((start (cursor))
+ (sf (make-sampler start)))
+ (do ((n start (+ 1 n))
+ (val0 (abs (next-sample sf)) val1)
+ (val1 (abs (next-sample sf)) (abs (next-sample sf))))
+ ((or (sampler-at-end? sf)
+ (< (+ val0 val1) limit))
+ (set! (cursor) n)
+ n))))))
;;; -------- sound interp
@@ -1493,17 +1402,18 @@ selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"
;;; make-sound-interp sets up a sound reader that reads a channel at an arbitary location,
;;; interpolating between samples if necessary, the corresponding "generator" is sound-interp
-(define* (make-sound-interp start snd chn)
- "(make-sound-interp start snd chn) -> an interpolating reader for snd's channel chn"
- (let* ((data (channel->vct 0 #f snd chn))
- (size (length data)))
- (lambda (loc)
- (array-interp data loc size))))
+(define make-sound-interp
+ (let ((documentation "(make-sound-interp start snd chn) -> an interpolating reader for snd's channel chn"))
+ (lambda* (start snd chn)
+ (let* ((data (channel->float-vector start #f snd chn))
+ (size (length data)))
+ (lambda (loc)
+ (array-interp data loc size))))))
-(define sound-interp ;make it look like a clm generator
- (lambda (func loc)
- "(sound-interp func loc) -> sample at loc (interpolated if necessary) from func created by make-sound-interp"
- (func loc)))
+(define sound-interp
+ (let ((documentation "(sound-interp func loc) -> sample at loc (interpolated if necessary) from func created by make-sound-interp"))
+ (lambda (func loc) ;make it look like a clm generator
+ (func loc))))
#|
(define test-interp
@@ -1511,7 +1421,7 @@ selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"
;; use a sine wave to lookup the current sound
(let ((osc (make-oscil :frequency freq :initial-phase (+ pi (/ pi 2))))
(reader (make-sound-interp 0 0 0))
- (len (- (frames 0 0) 1)))
+ (len (- (framples 0 0) 1)))
(map-channel (lambda (val)
(sound-interp reader (* len (+ 0.5 (* 0.5 (oscil osc))))))))))
@@ -1521,11 +1431,11 @@ selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"
(define (sound-via-sound snd1 snd2) ; "sound composition"??
(let* ((intrp (make-sound-interp 0 snd1 0))
- (len (- (frames snd1 0) 1))
+ (len (- (framples snd1 0) 1))
(rd (make-sampler 0 snd2 0))
(mx (maxamp snd2 0)))
- (map-channel (lambda (val)
- (sound-interp intrp (floor (* len (* 0.5 (+ 1.0 (/ (read-sample rd) mx))))))))))
+ (map-channel (lambda (val)
+ (sound-interp intrp (floor (* len (* 0.5 (+ 1.0 (/ (read-sample rd) mx))))))))))
|#
@@ -1539,97 +1449,80 @@ selected sound: (map-channel (cross-synthesis (integer->sound 0) .5 128 6.0))"
;; envelope could be used for this effect, but it is much more direct to apply the
;; envelope to sound sample positions.
-(define* (env-sound-interp envelope (time-scale 1.0) snd chn)
- "(env-sound-interp env (time-scale 1.0) snd chn) reads snd's channel chn according to env and time-scale"
- ;; since the old/new sounds can be any length, we'll write a temp file rather than trying to use map-channel or vct-map!
- (let* ((len (frames snd chn))
- (newlen (floor (* time-scale len)))
- (reader (make-sound-interp 0 snd chn))
- (read-env (make-env envelope :length (+ 1 newlen) :scaler len))
- (tempfilename (snd-tempnam))
- (fil (mus-sound-open-output tempfilename (srate snd) 1 #f mus-next "env-sound-interp temp file"))
- ;; #f as data-format -> format compatible with sndlib (so no data translation is needed)
- (bufsize 8192)
- (data (make-sound-data 1 bufsize))
- (data-ctr 0))
- (do ((i 0 (+ i 1)))
- ((= i newlen))
- (sound-data-set! data 0 data-ctr (reader (env read-env)))
- (set! data-ctr (+ 1 data-ctr))
- (if (= bufsize data-ctr)
- (begin
- (mus-sound-write fil 0 (- bufsize 1) 1 data)
- (set! data-ctr 0))))
- (if (> data-ctr 0)
- (mus-sound-write fil 0 (- data-ctr 1) 1 data))
- (mus-sound-close-output fil (* (mus-bytes-per-sample mus-out-format) newlen))
- ;; #t trunc arg to set samples shortens the sound as needed
- (set-samples 0 newlen tempfilename snd chn #t
- (format #f "env-sound-interp '~A ~A" envelope time-scale))
- (delete-file tempfilename)))
+(define env-sound-interp
+ (let ((documentation "(env-sound-interp env (time-scale 1.0) snd chn) reads snd's channel chn according to env and time-scale"))
+ (lambda* (envelope (time-scale 1.0) snd chn)
+ ;; since the old/new sounds can be any length, we'll write a temp file rather than trying to use map-channel
+
+ (let* ((len (framples snd chn))
+ (newlen (floor (* time-scale len))))
+ (let ((new-snd (with-sound ((snd-tempnam) :to-snd #f :srate (srate snd))
+ (let ((data (channel->float-vector 0 #f snd chn))
+ (read-env (make-env envelope :length (+ 1 newlen) :scaler len)))
+ (do ((i 0 (+ i 1)))
+ ((= i newlen))
+ (outa i (array-interp data (env read-env) len)))))))
+ (set-samples 0 newlen new-snd snd chn #t
+ (format #f "env-sound-interp '~A ~A" envelope time-scale)
+ 0 current-edit-position #t))))))
-;;; here's a very similar function that uses granular synthesis to move at a varying tempo through a sound
+;;; (env-sound-interp '(0 0 1 1 2 0) 2.0)
-(define* (granulated-sound-interp envelope (time-scale 1.0) (grain-length 0.10) (grain-envelope '(0 0 1 1 2 1 3 0)) (output-hop 0.05) snd chn)
- "(granulated-sound-interp envelope (time-scale 1.0) (grain-length 0.10) (grain-envelope '(0 0 1 1 2 1 3 0)) (output-hop 0.05) snd chn) reads \
-the given channel following 'envelope' (as in env-sound-interp), using grains to create the re-tempo'd read"
- (let* ((len (frames snd chn))
- (newlen (floor (* time-scale len)))
- (read-env (make-env envelope :length newlen :scaler len))
- (tempfilename (snd-tempnam))
- (fil (mus-sound-open-output tempfilename (srate snd) 1 #f mus-next "env-sound-interp temp file"))
- ;; #f as data-format -> format compatible with sndlib (so no data translation is needed)
- (grain-frames (round (* grain-length (srate snd))))
- (hop-frames (round (* output-hop (srate snd))))
- (num-readers (+ 1 (round (/ grain-length output-hop))))
- (readers (make-vector num-readers #f))
- (grain-envs (make-vector num-readers #f))
- (next-reader-starts-at 0)
- (next-reader 0)
- (bufsize 8192)
- (data (make-sound-data 1 bufsize))
- (data-ctr 0)
- (jitter (* (srate snd) .005)))
-
- (do ((i 0 (+ i 1)))
- ((= i num-readers))
- (set! (grain-envs i) (make-env grain-envelope :length grain-frames)))
-
- (do ((i 0 (+ i 1)))
- ((= i newlen))
- (let ((position-in-original (env read-env)))
-
- (if (>= i next-reader-starts-at)
- (begin
- (set! (readers next-reader)
- (make-sampler (max 0 (round (+ position-in-original (mus-random jitter)))) snd chn))
- (mus-reset (grain-envs next-reader)) ; restart grain env
- (set! next-reader (+ 1 next-reader))
- (if (>= next-reader num-readers) (set! next-reader 0))
- (set! next-reader-starts-at (+ next-reader-starts-at hop-frames))))
-
- (let ((sum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i num-readers))
- (if (sampler? (readers i))
- (set! sum (+ sum (* (env (grain-envs i)) (next-sample (readers i)))))))
- (sound-data-set! data 0 data-ctr sum))
- (set! data-ctr (+ 1 data-ctr))
- (if (= bufsize data-ctr)
- (begin
- (mus-sound-write fil 0 (- bufsize 1) 1 data)
- (set! data-ctr 0)))))
- (if (> data-ctr 0)
- (mus-sound-write fil 0 (- data-ctr 1) 1 data))
- (mus-sound-close-output fil (* (mus-bytes-per-sample mus-out-format) newlen))
- ;; #t trunc arg to set samples shortens the sound as needed
- (set-samples 0 newlen tempfilename snd chn #t
- (format #f "granulated-sound-interp '~A ~A ~A ~A ~A" envelope time-scale grain-length grain-envelope output-hop))
- (delete-file tempfilename)))
+;;; here's a very similar function that uses granular synthesis to move at a varying tempo through a sound
+(define granulated-sound-interp
+
+ (let ((documentation "(granulated-sound-interp envelope (time-scale 1.0) (grain-length 0.10) (grain-envelope '(0 0 1 1 2 1 3 0)) (output-hop 0.05) snd chn) reads \
+the given channel following 'envelope' (as in env-sound-interp), using grains to create the re-tempo'd read"))
+ (lambda* (envelope (time-scale 1.0) (grain-length 0.10) (grain-envelope '(0 0 1 1 2 1 3 0)) (output-hop 0.05) snd chn)
+
+ (let* ((len (framples snd chn))
+ (newlen (floor (* time-scale len))))
+ (let ((read-env (make-env envelope :length newlen :scaler len))
+ (grain-frames (round (* grain-length (srate snd))))
+ (hop-frames (round (* output-hop (srate snd))))
+ (num-readers (ceiling (/ grain-length output-hop)))
+ (cur-readers 0)
+ (next-reader 0)
+ (jitter (* (srate snd) .005)))
+
+ (let ((readers (make-vector num-readers #f))
+ (grain-envs (make-vector num-readers #f)))
+ (do ((i 0 (+ i 1)))
+ ((= i num-readers))
+ (set! (grain-envs i) (make-env grain-envelope :length grain-frames)))
+
+ (let ((new-snd (with-sound ((snd-tempnam) :to-snd #f :srate (srate snd))
+
+ (do ((i 0 (+ i hop-frames)))
+ ((>= i newlen))
+ (let ((start i)
+ (stop (min newlen (+ i hop-frames)))
+ (e #f)
+ (r #t))
+
+ (set! (mus-location read-env) i)
+ (let ((position-in-original (env read-env)))
+ (set! (readers next-reader)
+ (make-sampler (max 0 (round (+ position-in-original (mus-random jitter)))) snd chn))
+ (mus-reset (grain-envs next-reader)) ; restart grain env
+ (set! next-reader (modulo (+ next-reader 1) num-readers))
+ (if (< cur-readers next-reader) (set! cur-readers next-reader)))
+
+ (do ((k 0 (+ k 1)))
+ ((= k cur-readers))
+ (set! e (grain-envs k))
+ (set! r (readers k))
+ (do ((j start (+ j 1)))
+ ((= j stop))
+ (outa j (* (env e) (next-sample r))))))))))
+
+ (set-samples 0 newlen new-snd snd chn #t
+ (format #f "granulated-sound-interp '~A ~A ~A ~A ~A" envelope time-scale grain-length grain-envelope output-hop)
+ 0 current-edit-position #t))))))))
;;; (granulated-sound-interp '(0 0 1 .1 2 1) 1.0 0.2 '(0 0 1 1 2 0))
;;; (granulated-sound-interp '(0 0 1 1) 2.0)
@@ -1637,22 +1530,25 @@ the given channel following 'envelope' (as in env-sound-interp), using grains to
-
;;; -------- filtered-env
-(define* (filtered-env e snd chn)
- "(filtered-env env) is a time-varying one-pole filter: when env is at 1.0, no filtering,
-as env moves to 0.0, low-pass gets more intense; amplitude and low-pass amount move together"
- (let* ((samps (frames))
- (flt (make-one-pole 1.0 0.0))
- (amp-env (make-env e :length samps)))
- (map-channel
- (lambda (val)
- (let ((env-val (env amp-env)))
- (set! (mus-xcoeff flt 0) env-val)
- (set! (mus-ycoeff flt 1) (- env-val 1.0))
- (one-pole flt (* env-val val))))
- 0 #f snd chn #f (format #f "filtered-env '~A" e))))
+(define filtered-env
+ (let ((documentation "(filtered-env env snd chn) is a time-varying one-pole filter: when env is at 1.0, no filtering,
+as env moves to 0.0, low-pass gets more intense; amplitude and low-pass amount move together"))
+ (lambda* (e snd chn)
+ (let* ((samps (framples))
+ (flt (make-one-pole 1.0 0.0))
+ (xc (mus-xcoeffs flt))
+ (yc (mus-ycoeffs flt))
+ (amp-env (make-env e :length samps)))
+ (map-channel
+ (lambda (val)
+ (let ((env-val (env amp-env)))
+ (float-vector-set! xc 0 env-val)
+ (float-vector-set! yc 1 (- env-val 1.0))
+ (one-pole flt (* env-val val))))
+ 0 #f snd chn #f (format #f "filtered-env '~A" e))))))
+
;;; -------- multi-colored rxvt printout
@@ -1661,349 +1557,236 @@ as env moves to 0.0, low-pass gets more intense; amplitude and low-pass amount m
;;; for things like multi-colored text:
#|
-(define red-text (format #f "~C[31m" #\esc))
-(define normal-text (format #f "~C[0m" #\esc))
-;(display (format #f "~Athis is red!~Abut this is not" red-text normal-text))
+(define red-text (format #f "~C[31m" #\escape))
+(define normal-text (format #f "~C[0m" #\escape))
;;; there are a bunch of these:
-(define black-on-red-text (format #f "~C[30m~C[41m" #\esc #\esc))
+(define black-on-red-text (format #f "~C[30m~C[41m" #\escape #\escape))
;;; or perhaps more convenient:
-(define black-fg (format #f "~C[30m" #\esc)) (define black-bg (format #f "~C[40m" #\esc))
-(define red-fg (format #f "~C[31m" #\esc)) (define red-bg (format #f "~C[41m" #\esc))
-(define green-fg (format #f "~C[32m" #\esc)) (define green-bg (format #f "~C[42m" #\esc))
-(define yellow-fg (format #f "~C[33m" #\esc)) (define yellow-bg (format #f "~C[43m" #\esc))
-(define blue-fg (format #f "~C[34m" #\esc)) (define blue-bg (format #f "~C[44m" #\esc))
+(define black-fg (format #f "~C[30m" #\escape)) (define black-bg (format #f "~C[40m" #\escape))
+(define red-fg (format #f "~C[31m" #\escape)) (define red-bg (format #f "~C[41m" #\escape))
+(define green-fg (format #f "~C[32m" #\escape)) (define green-bg (format #f "~C[42m" #\escape))
+(define yellow-fg (format #f "~C[33m" #\escape)) (define yellow-bg (format #f "~C[43m" #\escape))
+(define blue-fg (format #f "~C[34m" #\escape)) (define blue-bg (format #f "~C[44m" #\escape))
;;; etc (magenta: 35 cyan: 36 white: 37 default: 39)
-(define bold-text (format #f "~C[1m" #\esc)) (define unbold-text (format #f "~C[22m" #\esc))
-(define underline-text (format #f "~C[4m" #\esc)) (define ununderline-text (format #f "~C[24m" #\esc))
-(define blink-text (format #f "~C[5m" #\esc)) (define unblink-text (format #f "~C[25m" #\esc))
-
-;(display (format #f "~A~Ahiho~Ahiho" yellow-bg red-fg normal-text))
+(define bold-text (format #f "~C[1m" #\escape)) (define unbold-text (format #f "~C[22m" #\escape))
+(define underline-text (format #f "~C[4m" #\escape)) (define ununderline-text (format #f "~C[24m" #\escape))
+(define blink-text (format #f "~C[5m" #\escape)) (define unblink-text (format #f "~C[25m" #\escape))
|#
-;;; -------- C-x b support: hide all but one of the current sounds (more like Emacs)
-;;;
-;;; this could also hide all but the current channel, but I can't decide if that's a good idea
-
-(define last-buffer #f)
-(define current-buffer #f)
-(define last-width 0)
-(define last-height 0)
-
-(define (open-current-buffer width height)
- "(open-current-buffer width height) makes sure the current buffer is displayed (part of the C-x b support)"
- (set! last-width width)
- (set! last-height height)
- (let ((sound-pane (car (sound-widgets (car current-buffer)))))
- (if sound-pane
- (begin
- (show-widget sound-pane)
- (set! (widget-size sound-pane) (list width height))
- (select-sound (car current-buffer))
- (select-channel (cadr current-buffer))))))
-
-(define (close-all-buffers)
- "(close-all-buffers) closes all buffers (for C-x b)"
- (for-each
- (lambda (n)
- (hide-widget (car (sound-widgets n))))
- (sounds)))
-
-(define (switch-to-buf)
- "(switch-to-buf) handles C-x b"
- (prompt-in-minibuffer
- (if last-buffer
- (if (> (cadr last-buffer) 0)
- (format #f "switch to buf: (default \"~A\" chan ~A) "
- (short-file-name (car last-buffer))
- (cadr last-buffer))
- (format #f "switch to buf: (default \"~A\") "
- (short-file-name (car last-buffer))))
- "switch to buf: (default: make new sound)")
- (lambda (response)
- (let* ((width (car (widget-size (car (sound-widgets (car current-buffer))))))
- (height (cadr (widget-size (car (sound-widgets (car current-buffer)))))))
- (call-with-exit
- (lambda (give-up)
- (if (or (not (string? response))
- (= (string-length response) 0))
- (let ((temp current-buffer))
- (if last-buffer
- (set! current-buffer last-buffer)
- (let ((index (new-sound)))
- (set! current-buffer (list index 0))))
- (set! last-buffer temp))
- (let ((index (find-sound response)))
- (if index
- (begin
- (set! last-buffer current-buffer)
- (set! current-buffer (list index 0)))
- (give-up (report-in-minibuffer (format #f "can't find ~A" response))))))
- (close-all-buffers)
- (report-in-minibuffer "")
- (open-current-buffer width height)))))))
-
-(define (xb-close snd)
- "(xb-close snd) is part of the C-x b support"
- (if (and current-buffer
- (= snd (car current-buffer)))
- (let ((closer (car current-buffer)))
- (close-all-buffers)
- (if last-buffer
- (set! current-buffer last-buffer)
- (if (sounds)
- (set! current-buffer (list (car (sounds)) 0))
- (set! current-buffer #f)))
- (set! last-buffer
- (call-with-exit
- (lambda (return)
- (for-each
- (lambda (n)
- (if (and (not (= n closer))
- (or (not current-buffer)
- (not (= n (car current-buffer)))))
- (return (list n 0))))
- (sounds))
- #f)))
- (if current-buffer
- (open-current-buffer last-width last-height)))))
-
-(define (xb-open snd)
- "(xb-open snd) is part of the C-x b support"
- (close-all-buffers)
- (set! last-buffer current-buffer)
- (set! current-buffer (list snd 0))
- (open-current-buffer (if (= last-width 0) (window-width) last-width)
- (if (= last-height 0) (- (window-height) 10) last-height))
- #f)
-
-;(bind-key #\b 0 switch-to-buf #t)
-;(hook-push close-hook xb-close)
-;(hook-push after-open-hook xb-open)
-
-
;;; -------- remove-clicks
-(define (find-click loc)
- "(find-click loc) finds the next click starting at 'loc'"
- (let ((reader (make-sampler loc))
- (samp0 0.0)
- (samp1 0.0)
- (samp2 0.0)
- (samps (make-vct 10))
- (samps-ctr 0)
- (len (frames)))
- (call-with-exit
- (lambda (return)
- (do ((ctr loc (+ 1 ctr)))
- ((= ctr len) #f)
- (set! samp0 samp1)
- (set! samp1 samp2)
- (set! samp2 (next-sample reader))
- (set! (samps samps-ctr) samp0)
- (if (< samps-ctr 9)
- (set! samps-ctr (+ samps-ctr 1))
- (set! samps-ctr 0))
- (let ((local-max (max .1 (vct-peak samps))))
- (if (and (> (abs (- samp0 samp1)) local-max)
- (> (abs (- samp1 samp2)) local-max)
- (< (abs (- samp0 samp2)) (/ local-max 2)))
- (return (- ctr 1)))))))))
-
-
-(define (remove-clicks)
- "(remove-clicks) tries to find and smooth-over clicks"
- ;; this is very conservative -- the click detection limits above could be set much tighter in many cases
- (define (remove-click loc)
- (let ((click (find-click loc)))
- (if click
- (begin
- (smooth-sound (- click 2) 4)
- (remove-click (+ click 2))))))
- (remove-click 0))
+(define find-click
+ (let ((documentation "(find-click loc) finds the next click starting at 'loc'"))
+ (lambda (loc)
+ (let ((reader (make-sampler loc))
+ (mmax (make-moving-max 10))
+ (samp0 0.0)
+ (samp1 0.0)
+ (samp2 0.0)
+ (len (framples)))
+ (call-with-exit
+ (lambda (return)
+ (do ((ctr loc (+ ctr 1)))
+ ((= ctr len) #f)
+ (set! samp0 samp1)
+ (set! samp1 samp2)
+ (set! samp2 (next-sample reader))
+ (let ((local-max (max .1 (moving-max mmax samp0))))
+ (if (and (> (abs (- samp0 samp1)) local-max)
+ (> (abs (- samp1 samp2)) local-max)
+ (< (abs (- samp0 samp2)) (/ local-max 2)))
+ (return (- ctr 1)))))))))))
+
+(define remove-clicks
+ (let ((documentation "(remove-clicks) tries to find and smooth-over clicks"))
+ (lambda ()
+ ;; this is very conservative -- the click detection limits above could be set much tighter in many cases
+ (define (remove-click loc)
+ (let ((click (find-click loc)))
+ (if click
+ (begin
+ (smooth-sound (- click 2) 4)
+ (remove-click (+ click 2))))))
+ (remove-click 0))))
;;; -------- searching examples (zero+, next-peak)
-(define (search-for-click)
- "(search-for-click) looks for the next click (for use with C-s)"
- (let ((samp0 0.0)
- (samp1 0.0)
- (samp2 0.0)
- (samps (make-vct 10))
- (sctr 0))
- (lambda (val)
- (set! samp0 samp1)
- (set! samp1 samp2)
- (set! samp2 val)
- (set! (samps sctr) val)
- (set! sctr (+ sctr 1))
- (if (>= sctr 10) (set! sctr 0))
- (let ((local-max (max .1 (vct-peak samps))))
- (and (>= (abs (- samp0 samp1)) local-max)
- (>= (abs (- samp1 samp2)) local-max)
- (<= (abs (- samp0 samp2)) (/ local-max 2)))))))
-
-
-(define (zero+)
- "(zero+) finds the next positive-going zero crossing (if searching forward) (for use with C-s)"
- (let ((lastn 0.0))
- (lambda (n)
- (let ((rtn (and (< lastn 0.0)
- (>= n 0.0))))
- (set! lastn n)
- rtn))))
-
-
-(define (next-peak)
- "(next-peak) finds the next max or min point in the time-domain waveform (for use with C-s)"
- (let ((last0 #f)
- (last1 #f))
- (lambda (n)
- (let ((rtn (and (number? last0)
- (or (and (< last0 last1) (> last1 n))
- (and (> last0 last1) (< last1 n))))))
- (set! last0 last1)
- (set! last1 n)
- rtn))))
-
-
-(define (find-pitch pitch)
- "(find-pitch pitch) finds the point in the current sound where 'pitch' (in Hz) predominates -- C-s (find-pitch 300)
-In most cases, this will be slightly offset from the true beginning of the note"
-
- (define (interpolated-peak-offset la pk ra)
- (let ((logla (/ (log (/ (max la .0000001) pk)) (log 10)))
- (logra (/ (log (/ (max ra .0000001) pk)) (log 10))))
- (/ (* 0.5 (- logla logra))
- (+ logla logra))))
-
- (let ((data (make-vct (transform-size)))
- (data-loc 0))
- (lambda (n)
- (set! (data data-loc) n)
- (set! data-loc (+ 1 data-loc))
- (let ((rtn #f))
- (if (= data-loc (transform-size))
- (begin
- (set! data-loc 0)
- (if (> (vct-peak data) .001) ;ignore noise sections??
- (let ((spectr (snd-spectrum data rectangular-window (transform-size)))
- (pk 0.0)
- (pkloc 0))
- (let ((pit
- (do ((i 0 (+ i 1)))
- ((= i (/ (transform-size) 2))
- (if (or (= pk 0.0)
- (= peak-loc 0))
- 0.0
- (/ (* (+ pkloc
- (interpolated-peak-offset (spectr (- pkloc 1))
- pk
- (spectr (+ 1 pkloc))))
- (srate))
- (transform-size))))
- (if (> (spectr i) pk)
- (begin
- (set! pk (spectr i))
- (set! pkloc i))))))
- (if (< (abs (- pitch pit)) (/ (srate) (* 2 (transform-size)))) ; uh... why not do it direct?
- (set! rtn #t)))))
- (vct-fill! data 0.0)))
- rtn))))
-
-
-;;; -------- file->vct and a sort of cue-list, I think
-
-(define (file->vct file)
- "(file->vct file) returns a vct with file's data"
- (let* ((len (frames file))
- (reader (make-sampler 0 file))
- (data (make-vct len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (data i) (next-sample reader)))
- (free-sampler reader)
- data))
-
-
-(define* (add-notes notes snd chn)
- "(add-notes notes) adds (mixes) 'notes' which is a list of lists of the form: file (offset 0.0) (amp 1.0)
-starting at the cursor in the currently selected channel: (add-notes '((\"oboe.snd\") (\"pistol.snd\" 1.0 2.0)))"
- (let* ((start (cursor snd chn)))
- (as-one-edit
- (lambda ()
- (for-each
- (lambda (note)
- (let* ((file (car note))
- (offset (if (> (length note) 1) (cadr note) 0.0))
- (amp (if (> (length note) 2) (caddr note) #f))
- (beg (+ start (floor (* (srate snd) offset)))))
- (if (and (number? amp)
- (not (= amp 1.0)))
- (mix-vct (vct-scale! (file->vct file) amp) beg snd chn #f "add-notes")
- (mix file beg 0 snd chn #f))))
- notes))
- (format #f "add-notes '~S" notes))))
-
-
-(define (region-play-list data)
- "(region-play-list data): 'data' is list of lists (list (list reg time)...), time in secs, setting up
-a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (list reg2 1.0) (list reg0 1.0)))"
- (for-each
- (lambda (tone)
- (let ((time (floor (* 1000 (cadr tone))))
- (region (car tone)))
- (if (region? region)
- (in time (lambda () (play region))))))
- data))
-
-
-(define (region-play-sequence data)
- "(region-play-sequence data): 'data' is list of regions which will be played one after the other: (region-play-sequence (list reg0 reg2 reg1))"
- (region-play-list
- (let ((time 0.0))
- (map
- (lambda (id)
- (let ((cur time))
- (set! time (+ time (/ (frames id) (srate id))))
- (list cur id)))
- data))))
+(define search-for-click
+ (let ((documentation "(search-for-click) looks for the next click (use with C-s)"))
+ (lambda ()
+ (let ((samp0 0.0)
+ (samp1 0.0)
+ (samp2 0.0)
+ (mmax (make-moving-max 10)))
+ (lambda (val)
+ (set! samp0 samp1)
+ (set! samp1 samp2)
+ (set! samp2 val)
+ (let ((local-max (max .1 (moving-max mmax samp0))))
+ (and (>= (abs (- samp0 samp1)) local-max)
+ (>= (abs (- samp1 samp2)) local-max)
+ (<= (abs (- samp0 samp2)) (/ local-max 2)))))))))
+
+
+(define zero+
+ (let ((documentation "(zero+) finds the next positive-going zero crossing (if searching forward) (for use with C-s)"))
+ (lambda ()
+ (let ((lastn 0.0))
+ (lambda (n)
+ (let ((rtn (and (< lastn 0.0)
+ (>= n 0.0))))
+ (set! lastn n)
+ rtn))))))
+
+
+(define next-peak
+ (let ((documentation "(next-peak) finds the next max or min point in the time-domain waveform (for use with C-s)"))
+ (lambda ()
+ (let ((last0 #f)
+ (last1 #f))
+ (lambda (n)
+ (let ((rtn (and (number? last0)
+ (or (and (< last0 last1) (> last1 n))
+ (and (> last0 last1) (< last1 n))))))
+ (set! last0 last1)
+ (set! last1 n)
+ rtn))))))
+
+
+(define find-pitch
+ (let ((documentation "(find-pitch pitch) finds the point in the current sound where 'pitch' (in Hz) predominates -- C-s (find-pitch 300)
+In most cases, this will be slightly offset from the true beginning of the note"))
+ (lambda (pitch)
+
+ (define (interpolated-peak-offset la pk ra)
+ (let ((logla (log (/ (max la .0000001) pk) 10))
+ (logra (log (/ (max ra .0000001) pk) 10)))
+ (/ (* 0.5 (- logla logra))
+ (+ logla logra))))
+
+ (let ((data (make-float-vector *transform-size*))
+ (data-loc 0))
+ (lambda (n)
+ (set! (data data-loc) n)
+ (set! data-loc (+ data-loc 1))
+ (let ((rtn #f))
+ (if (= data-loc *transform-size*)
+ (begin
+ (set! data-loc 0)
+ (if (> (float-vector-peak data) .001) ;ignore noise sections??
+ (let ((spectr (snd-spectrum data rectangular-window *transform-size*))
+ (pk 0.0)
+ (pkloc 0))
+ (let ((pit
+ (do ((i 0 (+ i 1)))
+ ((= i (/ *transform-size* 2))
+ (if (or (= pk 0.0)
+ (= pkloc 0))
+ 0.0
+ (/ (* (+ pkloc
+ (interpolated-peak-offset (spectr (- pkloc 1))
+ pk
+ (spectr (+ 1 pkloc))))
+ (srate))
+ *transform-size*)))
+ (if (> (spectr i) pk)
+ (begin
+ (set! pk (spectr i))
+ (set! pkloc i))))))
+ (if (< (abs (- pitch pit)) (/ (srate) (* 2 *transform-size*))) ; uh... why not do it direct?
+ (set! rtn #t)))))
+ (fill! data 0.0)))
+ rtn))))))
+
+
+;;; -------- file->floats and a sort of cue-list, I think
+
+(define (file->floats file) (samples 0 (framples file) file))
+
+
+(define add-notes
+ (let ((documentation "(add-notes notes snd chn) adds (mixes) 'notes' which is a list of lists of the form: file (offset 0.0) (amp 1.0)
+starting at the cursor in the currently selected channel: (add-notes '((\"oboe.snd\") (\"pistol.snd\" 1.0 2.0)))"))
+ (lambda* (notes snd chn)
+ (let ((start (cursor snd chn)))
+ (as-one-edit
+ (lambda ()
+ (for-each
+ (lambda (note)
+ (let* ((file (car note))
+ (offset (if (> (length note) 1) (cadr note) 0.0))
+ (amp (and (> (length note) 2) (caddr note)))
+ (beg (+ start (floor (* (srate snd) offset)))))
+ (if (and (number? amp)
+ (not (= amp 1.0)))
+ (mix-float-vector (float-vector-scale! (file->floats file) amp) beg snd chn #f "add-notes")
+ (mix file beg 0 snd chn #f))))
+ notes))
+ (format #f "add-notes '~S" notes))))))
+
+
+(define region-play-list
+ (let ((documentation "(region-play-list data): 'data' is list of lists (list (list reg time)...), time in secs, setting up
+a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (list reg2 1.0) (list reg0 1.0)))"))
+ (lambda (data)
+ (for-each
+ (lambda (tone)
+ (let ((time (floor (* 1000 (cadr tone))))
+ (region (car tone)))
+ (if (region? region)
+ (in time (lambda () (play region))))))
+ data))))
+
+
+(define region-play-sequence
+ (let ((documentation "(region-play-sequence data): 'data' is list of regions which will be played one after the other: (region-play-sequence (list reg0 reg2 reg1))"))
+ (lambda (data)
+ (region-play-list
+ (let ((time 0.0))
+ (map
+ (lambda (id)
+ (let ((cur time))
+ (set! time (+ time (/ (framples id) (srate id))))
+ (list cur id)))
+ data))))))
;;; -------- explode-sf2
-(define (explode-sf2)
- "(explode-sf2) turns the currently selected soundfont file into a bunch of files of the form sample-name.aif"
- (letrec ((sf2it
- (lambda (lst)
- (if (not (null? lst))
- (let* ((vals (car lst))
- ;; each inner list is: '(name start loop-start loop-end)
- (name (car vals))
- (start (cadr vals))
- (end (if (null? (cdr lst))
- (frames)
- (cadr (cadr lst))))
- (loop-start (- (caddr vals) start))
- (loop-end (- (cadddr vals) start))
- (filename (string-append name ".aif")))
- (if (selection?)
- (set! (selection-member? #t) #f)) ; clear entire current selection, if any
- (set! (selection-member?) #t)
- (set! (selection-position) start)
- (set! (selection-frames) (- end start))
- (save-selection filename mus-aifc)
- (let ((temp (open-sound filename)))
- (set! (sound-loop-info temp) (list loop-start loop-end))
- (close-sound temp))
- (sf2it (cdr lst)))))))
- (sf2it (soundfont-info))))
+(define explode-sf2
+ (let ((documentation "(explode-sf2) turns the currently selected soundfont file into a bunch of files of the form sample-name.aif"))
+ (lambda ()
+ (letrec ((sf2it
+ (lambda (lst)
+ (if (pair? lst)
+ (let* ((vals (car lst))
+ ;; each inner list is: '(name start loop-start loop-end)
+ (name (car vals))
+ (start (cadr vals))
+ (end (if (null? (cdr lst))
+ (framples)
+ (cadadr lst)))
+ (loop-start (- (caddr vals) start))
+ (loop-end (- (cadddr vals) start))
+ (filename (string-append name ".aif")))
+ (if (selection?)
+ (set! (selection-member? #t) #f)) ; clear entire current selection, if any
+ (set! (selection-member?) #t)
+ (set! (selection-position) start)
+ (set! (selection-framples) (- end start))
+ (save-selection filename (selection-srate) mus-bshort mus-aifc)
+ (let ((temp (open-sound filename)))
+ (set! (sound-loop-info temp) (list loop-start loop-end))
+ (close-sound temp))
+ (sf2it (cdr lst)))))))
+ (sf2it (soundfont-info))))))
;;; -------- open-next-file-in-directory
@@ -2012,23 +1795,23 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
(let ((last-file-opened #f)
(current-directory #f)
(current-sorted-files #f))
-
+
(define (file-from-path curfile)
(let ((last-slash 0))
(do ((i 0 (+ i 1)))
- ((= i (string-length curfile)))
- (if (char=? (string-ref curfile i) #\/)
+ ((= i (length curfile)))
+ (if (char=? (curfile i) #\/)
(set! last-slash i)))
(substring curfile (+ 1 last-slash))))
-
+
(define (directory-from-path curfile)
(let ((last-slash 0))
(do ((i 0 (+ i 1)))
- ((= i (string-length curfile)))
- (if (char=? (string-ref curfile i) #\/)
+ ((= i (length curfile)))
+ (if (char=? (curfile i) #\/)
(set! last-slash i)))
(substring curfile 0 last-slash)))
-
+
(define (find-next-file)
;; find the next file in the sorted list, with wrap-around
(let ((choose-next (not (string? last-file-opened)))
@@ -2044,11 +1827,11 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
current-sorted-files)
;; if we get here we wrapped around
(car current-sorted-files)))))
-
+
(define (get-current-files dir)
(set! current-directory dir)
- (set! current-sorted-files (sort! (sound-files-in-directory dir) string<?)))
-
+ (set! current-sorted-files (sort! (copy (sound-files-in-directory dir)) string<?)))
+
(define (get-current-directory filename)
(set! last-file-opened filename)
(display last-file-opened)
@@ -2057,12 +1840,12 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
(not (string=? current-directory new-path)))
(get-current-files new-path)))
#f)
-
+
(lambda ()
(if (not (member get-current-files (hook-functions open-hook)))
- (hook-push open-hook get-current-directory))
+ (hook-push open-hook (lambda (hook) (get-current-directory (hook 'name)))))
(if (and (not (string? last-file-opened))
- (not (null? (sounds))))
+ (pair? (sounds)))
(set! last-file-opened (file-name (or (selected-sound)
(car (sounds))))))
(if (not current-directory)
@@ -2070,574 +1853,280 @@ a sort of play list: (region-play-list (list (list reg0 0.0) (list reg1 0.5) (li
(get-current-files (getcwd))
(get-current-files (directory-from-path last-file-opened))))
(if (null? current-sorted-files)
- (throw 'no-such-file (list "open-next-file-in-directory" current-directory))
+ (error 'no-such-file (list "open-next-file-in-directory" current-directory))
(let ((next-file (find-next-file)))
(if (find-sound next-file)
- (throw 'file-already-open (list "open-next-file-in-directory" next-file))
+ (error 'file-already-open (list "open-next-file-in-directory" next-file))
(begin
- (if (not (null? (sounds)))
+ (if (pair? (sounds))
(close-sound (or (selected-sound)
(car (sounds)))))
(open-sound next-file)))))
#t)))
-(define (click-middle-button-to-open-next-file-in-directory)
- "(click-middle-button-to-open-next-file-in-directory) adds open-next-file-in-directory to the mouse-click-hook"
- (hook-push mouse-click-hook
- (lambda (snd chn button state x y axis)
- (if (= button 2)
- (open-next-file-in-directory)
- #f)))) ; else handle it normally
+(define click-middle-button-to-open-next-file-in-directory
+ (let ((documentation "(click-middle-button-to-open-next-file-in-directory) adds open-next-file-in-directory to the mouse-click-hook"))
+ (lambda ()
+ (hook-push mouse-click-hook
+ (lambda (hook)
+ (if (= (hook 'button) 2)
+ (set! (hook 'result) (open-next-file-in-directory))))))))
;;; -------- chain-dsps
-(define* (chain-dsps beg dur :rest dsps)
- "(chain-dsps beg dur :rest dsps) sets up a generator patch from its arguments"
- ;; I assume the dsps are already made,
- ;; the envs are present as break-point lists
- ;; the calls are ordered out->in (or last first)
- ;; this should use definstrument, not define*, but it's defined in ws.scm which I don't want to require here
- (let* ((dsp-chain (list->vector (reverse (map (lambda (gen)
- (if (list? gen)
- (make-env gen :duration dur)
- gen))
- dsps))))
- (start (seconds->samples beg))
- (samps (seconds->samples dur))
- (end (+ start samps))
- (len (length dsp-chain)))
- (run
- (do ((k start (+ 1 k)))
- ((= k end))
- (let ((val 0.0))
- ;; using do and vector here for the run macro's benefit
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let ((gen (dsp-chain i)))
- (if (env? gen)
- (set! val (* (gen) val))
- (if (readin? gen)
- (set! val (+ val (gen)))
- (set! val (gen val))))))
- (outa k val))))))
-
+(define chain-dsps
+ (let ((documentation "(chain-dsps beg dur :rest dsps) sets up a generator patch from its arguments"))
+ (lambda* (beg dur :rest dsps)
+
+ ;; assume the dsps are already made,
+ ;; the envs are present as break-point lists
+ ;; the calls are ordered out->in (or last first)
+ ;; we take this list and create and evaluate a new function
+
+ (let ((dsp-chain (apply vector (reverse (map (lambda (gen)
+ (if (pair? gen)
+ (make-env gen :duration dur)
+ gen))
+ dsps))))
+ (start (seconds->samples beg))
+ (samps (seconds->samples dur))
+ (body 0.0)
+ (closure ()))
+ (let ((end (+ start samps))
+ (len (length dsp-chain)))
+
+ ;; create the let variable list and lambda body of our new function
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((g (dsp-chain i))
+ (gname (string->symbol (format #f "g~D" i))))
+ (set! closure (cons `(,gname (dsp-chain ,i)) closure))
+ (if (env? g)
+ (set! body (if (eqv? body 0.0)
+ `(env ,gname)
+ `(* (env ,gname) ,body)))
+ (if (readin? g)
+ (set! body (if (eqv? body 0.0)
+ `(readin ,gname)
+ `(+ ,body (readin ,gname))))
+ (if (mus-generator? g)
+ (set! body (if (eqv? body 0.0)
+ (list (string->symbol (mus-name g)) gname)
+ (list (string->symbol (mus-name g)) gname body)))
+ (set! body (list gname body)))))))
+
+ ;; now patch the two together (the apply let below) and evaluate the resultant thunk
+
+ (apply define (list 'inner)
+ `((let ,closure
+ (do ((k ,start (+ k 1)))
+ ((= k ,end))
+ (outa k ,body)))))
+ (inner))))))
#|
(with-sound ()
- (chain-dsps 0 1.0 '(0 0 1 1 2 0) (make-oscil 440))
- (chain-dsps 0 1.0 '(0 0 1 1 2 0) (make-one-zero .5) (make-readin "oboe.snd"))
- ;; next call not currently optimizable
- (chain-dsps 0 1.0 '(0 0 1 1 2 0) (let ((osc1 (make-oscil 220))
- (osc2 (make-oscil 440)))
- (lambda (val) (+ (osc1 val)
- (osc2 (* 2 val)))))))
+ (chain-dsps 0 1.0 '(0 0 1 .5 2 0) (make-oscil 440))
+ (chain-dsps 1 1.0 '(0 0 1 4 2 0) (make-one-zero .5) (make-readin "oboe.snd"))
+ (chain-dsps 2 1.0 '(0 0 1 .5 2 0) (let ((osc1 (make-oscil 220))
+ (osc2 (make-oscil 440)))
+ (lambda (val) (+ (osc1 val)
+ (osc2 (* 2 val)))))))
|#
-;;; -------- cursor-follows-play and stays where it was when the play ended
-
-(if (not (provided? 'snd-hooks.scm)) (load "hooks.scm"))
-
-(define* (if-cursor-follows-play-it-stays-where-play-stopped (enable #t))
- ;; call with #t or no args to enable this, with #f to disable
-
- (let ()
- (define current-cursor
- (make-procedure-with-setter
- (lambda (snd chn) (channel-property 'cursor snd chn))
- (lambda (snd chn val) (set! (channel-property 'cursor snd chn) val))))
-
- (define original-cursor
- (make-procedure-with-setter
- (lambda (snd chn) (channel-property 'original-cursor snd chn))
- (lambda (snd chn val) (set! (channel-property 'original-cursor snd chn) val))))
-
- (define (local-dac-func data)
- (for-each
- (lambda (snd)
- (do ((i 0 (+ i 1)))
- ((= i (channels snd)))
- (if (not (= (cursor snd i) (original-cursor snd i)))
- (set! (current-cursor snd i) (cursor snd i)))))
- (sounds)))
-
- (define (local-start-playing-func snd)
- (do ((i 0 (+ i 1)))
- ((= i (channels snd)))
- (set! (original-cursor snd i) (cursor snd i))
- (set! (current-cursor snd i) (cursor snd i))))
-
- (define (local-stop-playing-func snd)
- (set! (cursor snd #t) (current-cursor snd 0)))
-
- (if enable
- (begin
- (hook-push dac-hook local-dac-func)
- (hook-push start-playing-hook local-start-playing-func)
- (hook-push stop-playing-hook local-stop-playing-func))
- (begin
- (hook-remove dac-hook local-dac-func)
- (hook-remove start-playing-hook local-start-playing-func)
- (hook-remove stop-playing-hook local-stop-playing-func)))))
-
-
-;;; -------- smooth-channel as virtual op
-
-(define* (smooth-channel-via-ptree (beg 0) dur snd chn edpos)
- "(smooth-channel-via-ptree (beg 0) dur snd chn edpos) is smooth-channel implemented as a virtual edit"
- (let* ((y0 (sample beg snd chn edpos))
- (y1 (sample (+ beg (or dur (- (frames) 1))) snd chn edpos))
- (init-angle (if (> y1 y0) pi 0.0))
- (off (* .5 (+ y0 y1)))
- (scale (* 0.5 (abs (- y1 y0))))
- (data (vct 0.0 0.0 init-angle off scale)))
- (ptree-channel
- (lambda (y data forward)
- (let* ((angle (data 0))
- (incr (data 1))
- (val (+ (data 3)
- (* (data 4)
- (cos (+ (data 2) angle))))))
- (if forward
- (set! (data 0) (+ angle incr))
- (set! (data 0) (- angle incr)))
- val))
- beg dur snd chn edpos #t
- (lambda (frag-beg frag-dur)
- (let ((incr (/ pi frag-dur)))
- (set! (data 1) incr)
- (set! (data 0) (* frag-beg incr))
- data))
- (format #f "smooth-channel-via-ptree ~A ~A" beg dur))))
-
-
-;;; -------- ring-modulate-channel (ring-mod as virtual op)
-
-(define* (ring-modulate-channel freq (beg 0) dur snd chn edpos)
- "(ring-modulate-channel freq (beg 0) dur snd chn edpos) ring-modulates the given channel"
- (ptree-channel
- (lambda (y data forward)
- (let* ((angle (data 0))
- (incr (data 1))
- (val (* y (sin angle))))
- (if forward
- (set! (data 0) (+ angle incr))
- (set! (data 0) (- angle incr)))
- val))
- beg dur snd chn edpos #f
- (lambda (frag-beg frag-dur)
- (let ((incr (/ (* 2 pi freq) (srate snd))))
- (vct (modulo (* frag-beg incr) (* 2 pi)) incr)))
- (format #f "ring-modulate-channel ~A ~A ~A" freq beg dur)))
;;; amplitude-modulate-channel could be (lambda (y data forward) (* y 0.5 (+ 1.0 (sin angle))) etc ...)
;;; -------- re-order channels
-(define (scramble-channels . new-order)
-
- "scramble-channels can arbitrarily re-order a sound's channels. The new channel order is \
-passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, and 1 in 3, (scramble-channels 3 2 0 1)"
+(define scramble-channels
- (define (find-chan chans chan len)
- (let ((pos #f))
- (do ((i 0 (+ i 1)))
- ((or pos (= i len)) pos)
- (if (= (chans i) chan)
- (set! pos i)))))
-
- (define (scramble-channels-1 cur-chans end-chans chans loc)
- (if (> chans loc)
- (let* ((end-chan (end-chans loc)) ; we want this channel at loc
- (cur-chan (cur-chans loc)) ; this (original) channel is currently at loc
- (end-loc (find-chan cur-chans end-chan chans))) ; where is end-chan currently?
- ;; end-chan goes in cur-chan's slot
- (if (not (= cur-chan end-chan))
- (begin
- (swap-channels #f end-loc #f loc)
- (set! (cur-chans end-loc) cur-chan)
- (set! (cur-chans loc) end-chan)))
- (scramble-channels-1 cur-chans end-chans chans (+ 1 loc)))))
-
- (let ((len (length new-order)))
- (if (> len 1)
- (let ((end-chans (list->vector new-order))
- (cur-chans (make-vector len)))
+ (let ((documentation "scramble-channels can arbitrarily re-order a sound's channels. The new channel order is \
+passed as the arguments so to end with channel 3 in channel 0, 2 in 1, 0 in 2, and 1 in 3, (scramble-channels 3 2 0 1)"))
+ (lambda new-order
+
+ (define (find-chan chans chan len)
+ (let ((pos #f))
(do ((i 0 (+ i 1)))
- ((= i len))
- (set! (cur-chans i) i))
- (scramble-channels-1 cur-chans end-chans len 0)))))
+ ((or pos (= i len)) pos)
+ (if (= (chans i) chan)
+ (set! pos i)))))
+
+ (define (scramble-channels-1 cur-chans end-chans chans loc)
+ (if (> chans loc)
+ (let* ((end-chan (end-chans loc)) ; we want this channel at loc
+ (cur-chan (cur-chans loc)) ; this (original) channel is currently at loc
+ (end-loc (find-chan cur-chans end-chan chans))) ; where is end-chan currently?
+ ;; end-chan goes in cur-chan's slot
+ (if (not (= cur-chan end-chan))
+ (begin
+ (swap-channels #f end-loc #f loc)
+ (set! (cur-chans end-loc) cur-chan)
+ (set! (cur-chans loc) end-chan)))
+ (scramble-channels-1 cur-chans end-chans chans (+ 1 loc)))))
+
+ (let ((len (length new-order)))
+ (if (> len 1)
+ (let ((end-chans (apply vector new-order))
+ (cur-chans (make-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (cur-chans i) i))
+ (scramble-channels-1 cur-chans end-chans len 0)))))))
(define (scramble-channel silence-1)
;; (scramble-channel .01)
(let ((buffer (make-moving-average 128))
(silence (/ silence-1 128))
- (edges '())
- (samp 0)
+ (edges ())
(in-silence #t)
- (old-max (max-regions))
- (old-tags (with-mix-tags)))
+ (old-max *max-regions*)
+ (old-tags *with-mix-tags*))
(dynamic-wind
- (lambda ()
- (set! (max-regions) 1024)
- (set! (with-mix-tags) #f))
- (lambda ()
- (scan-channel
- (lambda (y)
- (let* ((sum-of-squares (moving-average buffer (* y y)))
- (now-silent (< sum-of-squares silence)))
- (if (not (eq? in-silence now-silent))
- (set! edges (cons samp edges)))
- (set! in-silence now-silent)
- (set! samp (+ 1 samp))
- #f)))
- (set! edges (append (reverse edges) (list (frames))))
- (let* ((len (length edges))
- (pieces (make-vector len #f))
- (start 0)
- (ctr 0))
- (for-each
- (lambda (end)
- (set! (pieces ctr) (make-region start end))
- (set! ctr (+ 1 ctr))
- (set! start end))
- edges)
- (set! start 0)
- (as-one-edit
- (lambda()
- (scale-by 0.0)
+ (lambda ()
+ (set! *max-regions* 1024)
+ (set! *with-mix-tags* #f))
+ (lambda ()
+ (let ((len (framples))
+ (reader (make-sampler)))
(do ((i 0 (+ i 1)))
((= i len))
- (let* ((this (random len))
- (reg (pieces this)))
- (set! (pieces this) #f)
- (if (not reg)
- (begin
- (do ((j (+ 1 this) (+ 1 j)))
- ((or (= j len)
- reg))
- (set! reg (pieces j))
- (if reg (set! (pieces j) #f)))
- (if (not reg)
- (do ((j (- this 1) (- j 1)))
- ((or (< j 0)
- reg))
- (set! reg (pieces j))
- (if reg (set! (pieces j) #f))))))
- (mix-region reg start)
- (set! start (+ start (frames reg)))
- (forget-region reg)))))))
- (lambda ()
- (set! (with-mix-tags) old-tags)
- (set! (max-regions) old-max)))))
-
-
-;; -------- reorder blocks within channel
+ (let ((y (next-sample reader)))
+ (let* ((sum-of-squares (moving-average buffer (* y y)))
+ (now-silent (< sum-of-squares silence)))
+ (if (not (eq? in-silence now-silent))
+ (set! edges (cons i edges)))
+ (set! in-silence now-silent)))))
+ (set! edges (append (reverse edges) (list (framples))))
+ (let* ((len (length edges))
+ (pieces (make-vector len #f))
+ (start 0)
+ (ctr 0))
+ (for-each
+ (lambda (end)
+ (set! (pieces ctr) (make-region start end))
+ (set! ctr (+ ctr 1))
+ (set! start end))
+ edges)
+ (set! start 0)
+ (as-one-edit
+ (lambda()
+ (scale-by 0.0)
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let* ((this (random len))
+ (reg (pieces this)))
+ (set! (pieces this) #f)
+ (if (not reg)
+ (begin
+ (do ((j (+ 1 this) (+ j 1)))
+ ((or (= j len)
+ reg))
+ (set! reg (pieces j))
+ (if reg (set! (pieces j) #f)))
+ (if (not reg)
+ (do ((j (- this 1) (- j 1)))
+ ((or (< j 0)
+ reg))
+ (set! reg (pieces j))
+ (if reg (set! (pieces j) #f))))))
+ (mix-region reg start)
+ (set! start (+ start (framples reg)))
+ (forget-region reg)))))))
+ (lambda ()
+ (set! *with-mix-tags* old-tags)
+ (set! *max-regions* old-max)))))
-(define* (reverse-by-blocks block-len snd chn)
- "(reverse-by-blocks block-len snd chn): divide sound into block-len blocks, recombine blocks in reverse order"
- (let* ((len (frames snd chn))
- (num-blocks (floor (/ len (* (srate snd) block-len)))))
- (if (> num-blocks 1)
- (let* ((actual-block-len (ceiling (/ len num-blocks)))
- (rd (make-sampler (- len actual-block-len) snd chn))
- (beg 0)
- (ctr 1))
- (map-channel
- (lambda (y)
- (let ((val (read-sample rd)))
- (if (< beg 10) ; ramp start and end to avoid clicks (might want to mix with next section)
- (set! val (* val beg .1))
- (if (> beg (- actual-block-len 10))
- (set! val (* val (- actual-block-len beg) .1))))
- (set! beg (+ 1 beg))
- (if (= beg actual-block-len)
- (begin
- (set! ctr (+ 1 ctr))
- (set! beg 0)
- (set! rd (make-sampler (max 0 (- len (* ctr actual-block-len))) snd chn))))
- val))
- 0 #f snd chn #f (format #f "reverse-by-blocks ~A" block-len))))))
-
-
-(define* (reverse-within-blocks block-len snd chn)
- "(reverse-within-blocks block-len snd chn): divide sound into blocks, recombine in order, but each block internally reversed"
- (let* ((len (frames snd chn))
- (num-blocks (floor (/ len (* (srate snd) block-len)))))
- (if (> num-blocks 1)
- (let* ((actual-block-len (ceiling (/ len num-blocks)))
- (no-clicks-env (list 0.0 0.0 .01 1.0 .99 1.0 1.0 0.0)))
- (as-one-edit
- (lambda ()
- (do ((beg 0 (+ beg actual-block-len)))
- ((>= beg len))
- (reverse-channel beg actual-block-len snd chn)
- (env-channel no-clicks-env beg actual-block-len snd chn)))
- (format #f "reverse-within-blocks ~A" block-len)))
- (reverse-channel 0 #f snd chn))))
-
-;;; -------- sound segmentation
-;;;
-;;; this code was used to return note on and off points for the Iowa Musical Instrument Sound library
-;;; the main function takes the top level directory of the sounds, and returns (eventually) a text
-;;; file containing the start times (in samples) and durations of all the notes (each sound file in
-;;; this library can have about 12 notes). The results of this function need to be fixed up by hand
-;;; in some cases (violin notes in particular).
-
-(define* (sounds->segment-data main-dir (output-file "sounds.data"))
-
- (define (lower-case-and-no-spaces name)
- (let* ((new-name (string-downcase name))
- (len (string-length new-name)))
- (do ((i 0 (+ i 1)))
- ((= i len) new-name)
- (if (char=? (string-ref new-name i) #\space)
- (string-set! new-name i #\-)))))
-
- (define (directory->list dir)
- (let ((dport (opendir dir))
- (ctr 0)) ; try to avoid infinite loop in the broken cases
- (let loop ((entry (readdir dport))
- (files '()))
- (set! ctr (+ 1 ctr))
- (if (and (< ctr 2000)
- (not (eof-object? entry)))
- (loop (readdir dport) (cons entry files))
- (begin
- (closedir dport)
- (reverse! files))))))
-
- (define (segment-maxamp name beg dur)
- (let ((mx 0.0)
- (rd (make-sampler beg name)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i dur))
- (set! mx (max mx (abs (next-sample rd))))))
- (free-sampler rd)
- mx))
-
- (define (segment-sound name high low)
- (let* ((end (frames name))
- (reader (make-sampler 0 name)) ; no need to open the sound and display it
- (avg (make-moving-average :size 128))
- (lavg (make-moving-average :size 2048)) ; to distinguish between slow pulse train (low horn) and actual silence
- (segments (make-vct 100))
- (segctr 0)
- (possible-end 0)
- (in-sound #f))
- (run
- ;; this block is where 99% of the time goes
- (do ((i 0 (+ i 1)))
- ((= i end))
- (let* ((samp (abs (next-sample reader)))
- (val (moving-average avg samp))
- (lval (moving-average lavg samp)))
- (if in-sound
- (if (< val low)
- (begin
- (set! possible-end i)
- (if (< lval low)
- (begin
- (set! (segments segctr) (+ possible-end 128))
- (set! segctr (+ 1 segctr))
- (set! in-sound #f)))))
- (if (> val high)
- (begin
- (set! (segments segctr) (- i 128))
- (set! segctr (+ 1 segctr))
- (set! in-sound #t)))))))
- (free-sampler reader)
- (if in-sound
- (begin
- (set! (segments segctr) end)
- (list (+ 1 segctr) segments))
- (list segctr segments))))
-
- (define* (do-one-directory fd dir-name ins-name (high .01) (low .001))
- (snd-print (format #f ";~A~%" dir-name))
- (for-each
- (lambda (sound)
- (let* ((sound-name (string-append dir-name "/" sound))
- (boundary-data (segment-sound sound-name high low))
- (boundaries (cadr boundary-data))
- (segments (car boundary-data)))
- (format fd "~%~%;;; ~A" sound)
- (format fd "~%(~A ~S" ins-name (string-append dir-name "/" sound))
- (do ((bnd 0 (+ bnd 2)))
- ((>= bnd segments))
- (let* ((segbeg (floor (boundaries bnd)))
- (segdur (floor (- (boundaries (+ 1 bnd)) segbeg))))
- (format fd " (~A ~A ~A)" segbeg segdur (segment-maxamp sound-name segbeg segdur))))
- (format fd ")")
- (mus-sound-forget (string-append dir-name "/" sound))))
- (sound-files-in-directory dir-name)))
-
- (call-with-output-file
- output-file
- (lambda (fd)
- (let ((old-fam (with-file-monitor)))
- (set! (with-file-monitor) #f) ; no need to monitor these guys
- (format fd ";;; sound data from ~S" main-dir)
- (if (not (char=? (string-ref main-dir (- (string-length main-dir) 1)) #\/))
- (set! main-dir (string-append main-dir "/")))
- (for-each
- (lambda (dir)
- (if (not (char=? (string-ref dir 0) #\.))
- (let ((ins-name (lower-case-and-no-spaces dir)))
- (format fd "~%~%;;; ---------------- ~A ----------------" dir)
- (if (string=? dir "Piano")
- (for-each
- (lambda (inner-dir)
- (if (not (char=? (string-ref inner-dir 0) #\.))
- (do-one-directory fd (string-append main-dir dir "/" inner-dir) ins-name .001 .0001))) ; pp piano notes are .01 maxamp and short
- (directory->list (string-append main-dir dir)))
- (do-one-directory fd (string-append main-dir dir) ins-name)))))
- (directory->list main-dir))
- (set! (with-file-monitor) old-fam)))))
-
-;;; (sounds->segment-data "/home/bil/test/iowa/sounds/" "iowa.data")
+;; -------- reorder blocks within channel
+(define reverse-by-blocks
+ (let ((documentation "(reverse-by-blocks block-len snd chn): divide sound into block-len blocks, recombine blocks in reverse order"))
+ (lambda* (block-len snd chn)
+ (let* ((len (framples snd chn))
+ (num-blocks (floor (/ len (* (srate snd) block-len)))))
+ (if (> num-blocks 1)
+ (let* ((actual-block-len (ceiling (/ len num-blocks)))
+ (rd (make-sampler (- len actual-block-len) snd chn))
+ (beg 0)
+ (ctr 1))
+ (map-channel
+ (lambda (y)
+ (let ((val (read-sample rd)))
+ (if (< beg 10) ; ramp start and end to avoid clicks (might want to mix with next section)
+ (set! val (* val beg .1))
+ (if (> beg (- actual-block-len 10))
+ (set! val (* val (- actual-block-len beg) .1))))
+ (set! beg (+ beg 1))
+ (if (= beg actual-block-len)
+ (begin
+ (set! ctr (+ ctr 1))
+ (set! beg 0)
+ (set! rd (make-sampler (max 0 (- len (* ctr actual-block-len))) snd chn))))
+ val))
+ 0 #f snd chn #f (format #f "reverse-by-blocks ~A" block-len))))))))
+
+
+(define reverse-within-blocks
+ (let ((documentation "(reverse-within-blocks block-len snd chn): divide sound into blocks, recombine in order, but each block internally reversed"))
+ (lambda* (block-len snd chn)
+ (let* ((len (framples snd chn))
+ (num-blocks (floor (/ len (* (srate snd) block-len)))))
+ (if (> num-blocks 1)
+ (let ((actual-block-len (ceiling (/ len num-blocks)))
+ (no-clicks-env (list 0.0 0.0 .01 1.0 .99 1.0 1.0 0.0)))
+ (as-one-edit
+ (lambda ()
+ (do ((beg 0 (+ beg actual-block-len)))
+ ((>= beg len))
+ (reverse-channel beg actual-block-len snd chn)
+ (env-channel no-clicks-env beg actual-block-len snd chn)))
+ (format #f "reverse-within-blocks ~A" block-len)))
+ (reverse-channel 0 #f snd chn))))))
-;;; -------- channel-clipped?
-(define* (channel-clipped? snd chn)
- "(channel-clipped? snd chn) returns the sample number if it finds clipping"
- (let ((last-y 0.0))
- (scan-channel
- (lambda (y)
- (let ((result (and (>= (abs y) 0.9999)
- (>= (abs last-y) 0.9999))))
- (set! last-y y)
- result))
- 0 #f snd chn)))
+;;; -------- channel-clipped?
#|
-(define* (mark-clipping)
- "(mark-clipping) adds a mark at a clipped portion"
- (let ((snd (or (selected-sound)
- (and (not (null? (sounds)))
- (car (sounds))))))
- (if (sound? snd)
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (let ((last-y 0.0)
- (marked #f)
- (samp 0))
- (scan-channel
- (lambda (y)
- (let ((clipping (and (>= (abs y) 0.9999)
- (>= last-y 0.9999))))
- (set! last-y (abs y))
- (if (and clipping (not marked))
- (begin
- (add-mark (- samp 1) snd chn)
- (set! marked #t))
- (if marked
- (set! marked (or (> (abs y) 0.9999)
- (> last-y 0.9999)))))
- (set! samp (+ 1 samp))
- #f)))
- (update-time-graph snd chn))))))
-
-(add-to-menu 2 "Show Clipping" (lambda () (mark-clipping)))
+(define channel-clipped?
+ (let ((documentation "(channel-clipped? snd chn) returns the sample number if it finds clipping"))
+ (lambda* (snd chn)
+ (let ((last-y 0.0)
+ (len (framples snd chn))
+ (reader (make-sampler 0 snd chn)))
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 0 (+ i 1)))
+ ((= i len) #f)
+ (let ((y (next-sample reader)))
+ (if (and (>= (abs y) 0.9999)
+ (>= (abs last-y) 0.9999))
+ (quit i)
+ (set! last-y y))))))))))
|#
+;;; not pretty but faster:
+
+(define channel-clipped?
+ (let ((documentation "(channel-clipped? snd chn) returns the sample number if it finds clipping"))
+ (lambda* (snd chn)
+ (do ((pos (scan-channel (lambda (y) (>= (abs y) 0.9999)) 0 #f snd chn)
+ (scan-channel (lambda (y) (>= (abs y) 0.9999)) (+ pos 1) #f snd chn)))
+ ((or (not pos)
+ (>= (abs (sample (+ pos 1) snd chn)) 0.9999))
+ pos))))) ; or (and pos (+ pos 1)) to mimic the old version
;;; -------- sync-everything
-(define (sync-everything)
- "(sync-everything) sets the sync fields of all currently open sounds to the same, unique value"
- (let ((new-sync (+ 1 (sync-max))))
- (for-each
- (lambda (snd)
- (set! (sync snd) new-sync))
- (sounds))))
-
-
-
-;;; -------- fir filter as virtual edit
-
-(define (virtual-filter-channel coeffs beg dur snd chn edpos)
- (ptree-channel
-
- (lambda (y data forward)
- (let* ((sum 0.0)
- (order (floor (data 0)))
- (cur-loc (floor (data 1)))
- (init-time (> (data 2) 0.0))
- (last-forward (> (data 3) 0.0))
- (coeffs-0 4)
- (state-0 (+ coeffs-0 order)))
-
- (if (eq? last-forward forward)
- (if init-time
- (begin
- (set! (data 2) -1.0))
- (begin
- (if forward
- (begin
- (do ((i (- order 1) (- i 1)))
- ((= i 0))
- (set! (data (+ i state-0)) (data (+ i -1 state-0))))
- (set! (data state-0) y)
- (set! cur-loc (+ 1 cur-loc)))
-
- (let ((pos (max 0 (- cur-loc order))))
- (if (< pos 0)
- (set! y 0.0)
- (set! y (sample pos snd chn edpos)))
- (do ((i 0 (+ i 1)))
- ((= i (- order 1)))
- (set! (data (+ i state-0)) (data (+ i 1 state-0))))
- (set! (data (+ state-0 order -1)) y)
- (set! cur-loc (- cur-loc 1))))))
- )
-
- (do ((i 0 (+ i 1)))
- ((= i order))
- (set! sum (+ sum (* (data (+ coeffs-0 i))
- (data (+ state-0 i))))))
-
- (set! (data 1) cur-loc)
- (if forward (set! (data 3) 1.0) (set! (data 3) -1.0))
-
- sum))
-
- beg dur snd chn edpos #f
-
- (lambda (frag-beg frag-dur forward)
- (let* ((order (length coeffs))
- (coeffs-0 4)
- (state-0 (+ order coeffs-0))
- (d (make-vct (+ coeffs-0 (* 2 order)))))
- (set! (d 0) order)
- (set! (d 2) 1.0) ; first sample flag
- (if forward (set! (d 3) 1.0) (set! (d 3) -1.0))
-
- (do ((i 0 (+ i 1)))
- ((= i order))
- (set! (d (+ i coeffs-0)) (coeffs i)))
-
- (let ((start (- (+ 1 frag-beg beg) order))
- (i (- order 1)))
- (if (< start 0)
- (do ()
- ((= start 0))
- (set! (d (+ i state-0)) 0)
- (set! i (- i 1))
- (set! start (+ 1 start))))
- (if (>= i 0)
- (let ((rd (make-sampler start snd chn 1 edpos)))
- (do ()
- ((= i -1))
- (set! (d (+ i state-0)) (rd))
- (set! i (- i 1)))
- (free-sampler rd)))
- (set! (d 1) (+ frag-beg beg))
-
- d)))))
+(define sync-everything
+ (let ((documentation "(sync-everything) sets the sync fields of all currently open sounds to the same, unique value"))
+ (lambda ()
+ (let ((new-sync (+ 1 (sync-max))))
+ (for-each
+ (lambda (snd)
+ (set! (sync snd) new-sync))
+ (sounds))))))
diff --git a/expandn.scm b/expandn.scm
index 0e2bec3..b2d39a3 100644
--- a/expandn.scm
+++ b/expandn.scm
@@ -10,14 +10,15 @@
(provide 'snd-expandn.scm)
-(if (and (not (provided? 'snd-ws.scm))
- (not (provided? 'sndlib-ws.scm)))
- (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(require snd-env.scm)
(definstrument (expandn time duration filename amplitude
(expand 1.0)
- (matrix #f)
+ matrix
(ramp 0.4)
(seglen 0.15)
(srate 1.0)
@@ -25,287 +26,326 @@
(amp-env '(0 0 50 1 100 0))
(input-start 0.0)
(grain-amp 0.8)
- (reverb #f))
+ reverb)
(let ((fnam (file-name filename)))
(if (not (file-exists? fnam))
- (throw 'no-such-file (list 'expandn filename))
+ (error 'no-such-file (list 'expandn filename))
(let* ((beg (seconds->samples time))
(end (+ beg (seconds->samples duration)))
- (in-chans (channels fnam))
- (out-chans (channels *output*))
- (inframe (make-frame in-chans))
- (outframe (make-frame out-chans))
- (mx (if matrix
- (make-mixer (max in-chans out-chans))
- (make-scalar-mixer (max in-chans out-chans) 1.0)))
- (rev-chans (if *reverb* (channels *reverb*) 0))
- (rev-mx (if (and *reverb* reverb (> reverb 0.0))
- (let ((rmx (make-mixer (max out-chans rev-chans))))
- (do ((i 0 (+ i 1)))
- ((= i (max out-chans rev-chans)))
- (mixer-set! rmx (modulo i out-chans) (modulo i rev-chans) reverb))
- rmx)
- #f))
- (revframe (if rev-mx (make-frame (max out-chans rev-chans)) #f))
- (update-envs (or (list? expand)
- (list? seglen)
- (list? ramp)
- (list? hop)))
- (update-rate 100)
- (update-ctr 0)
- (expenv (make-env (if (list? expand) expand (list 0 expand 1 expand))
- :duration (/ duration update-rate)))
- (lenenv (make-env (if (list? seglen) seglen (list 0 seglen 1 seglen))
- :duration (/ duration update-rate)))
- (max-seg-len (if (list? seglen) (max-envelope seglen) seglen))
- (segment-scaler (if (> max-seg-len .15)
- (/ (* grain-amp .15) max-seg-len)
- grain-amp))
- (srenv (if (list? srate)
- (make-env srate :duration duration)
- (make-env (list 0 srate) :duration duration)))
- (rampdata (if (list? ramp) ramp (list 0 ramp 1 ramp)))
- (rampenv (make-env rampdata :duration (/ duration update-rate)))
- (minramp-bug (<= (min-envelope rampdata) 0.0))
- (maxramp-bug (>= (max-envelope rampdata) 0.5))
- (hopenv (make-env (if (list? hop) hop (list 0 hop 1 hop))
- :duration (/ duration update-rate)))
- (ampenv (make-env amp-env :duration duration :scaler amplitude))
- (ex-array (make-vector in-chans #f))
- (start (floor (* input-start (mus-sound-srate fnam))))
- (max-out-hop (if (list? hop) (max-envelope hop) hop))
- (min-exp-amt (if (list? expand) (min-envelope expand) expand))
- (max-in-hop (/ max-out-hop min-exp-amt))
- (max-len (ceiling (* (mus-srate)
- (+ (max max-out-hop max-in-hop)
- max-seg-len))))
- (ex-samp -1.0)
- ;; these vars used for resampling
- (next-samp 0.0))
+ (min-exp-amt (if (pair? expand) (min-envelope expand) expand))
+ (max-out-hop (if (pair? hop) (max-envelope hop) hop)))
- (if (or minramp-bug maxramp-bug)
- (throw 'out-of-range (list expand
- "ramp argument to expsnd must always be "
- (if (and minramp-bug maxramp-bug) "between 0.0 and 0.5"
- (if minramp-bug "greater than 0.0"
- "less than 0.5")))))
-
- ;; setup granulate generators
- (do ((i 0 (+ i 1)))
- ((= i in-chans))
- (vector-set! ex-array i (make-granulate :input (make-readin fnam :start start :channel i)
- :expansion (if (list? expand) (cadr expand) expand)
- :max-size max-len
- :ramp (if (list? ramp) (cadr ramp) ramp)
- :hop (if (list? hop) (cadr hop) hop)
- :length (if (list? seglen) (cadr seglen) seglen)
- :scaler segment-scaler)))
- (if matrix
- (begin
- (do ((inp 0 (+ 1 inp)))
- ((= inp in-chans))
- (let ((inlist (list-ref matrix inp)))
- (do ((outp 0 (+ 1 outp)))
- ((= outp out-chans))
- (let ((outn (list-ref inlist outp)))
- (mixer-set! mx inp outp outn)))))))
-
- ;; split out 1 and 2 chan input
- (if (= in-chans 1)
- (let ((ingen (vector-ref ex-array 0))
- (sample-0 0.0)
- (sample-1 0.0))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
-
- (let ((vol (env ampenv))
- (resa (env srenv)))
-
- (if update-envs
- (begin
- (set! update-ctr (+ update-ctr 1))
- (if (>= update-ctr update-rate)
- (let* ((expa (env expenv)) ;current expansion amount
- (segl (env lenenv)) ;current segment length
- (rmpl (env rampenv)) ;current ramp length (0 to .5)
- (hp (env hopenv)) ;current hop size
- (sl (floor (* segl (mus-srate))))
- (rl (floor (* rmpl sl))))
- (set! update-ctr 0)
- (set! (mus-length ingen) sl)
- (set! (mus-ramp ingen) rl)
- (set! (mus-frequency ingen) hp)
- (set! (mus-increment ingen) expa)))))
-
- (if (negative? ex-samp)
- (begin
- (set! sample-0 (* vol (granulate ingen)))
- (set! sample-1 (* vol (granulate ingen)))
- (set! ex-samp (+ 1 ex-samp))
- (set! next-samp ex-samp))
- (begin
- (set! next-samp (+ next-samp resa))
- (if (> next-samp (+ 1 ex-samp))
- (let ((samps (floor (- next-samp ex-samp))))
- (do ((k 0 (+ 1 k)))
- ((= k samps))
- (set! sample-0 sample-1)
- (set! sample-1 (* vol (granulate ingen)))
- (set! ex-samp (+ 1 ex-samp)))))))
-
- (if (= next-samp ex-samp)
- ;; output actual samples
- (frame-set! inframe 0 sample-0)
- ;; output interpolated samples
- (frame-set! inframe 0 (+ sample-0 (* (- next-samp ex-samp) (- sample-1 sample-0)))))
-
- ;; output mixed result
- (frame->file *output* i (frame->frame inframe mx outframe))
- ;; if reverb is turned on, output to the reverb streams
- (if rev-mx
- (frame->file *reverb* i (frame->frame outframe rev-mx revframe)))))))
+ (let ((in-chans (channels fnam))
+ (out-chans (channels *output*))
+ (rev-chans (if *reverb* (channels *reverb*) 0)))
+
+ (let ((update-rate 100)
+ (ochans (max in-chans out-chans))
+ (max-seg-len (if (pair? seglen) (max-envelope seglen) seglen))
+ (rampdata (if (pair? ramp) ramp (list 0 ramp 1 ramp)))
+ (start (floor (* input-start (mus-sound-srate fnam))))
+ (max-in-hop (/ max-out-hop min-exp-amt))
+ (rev-mx (and *reverb* reverb (> reverb 0.0)
+ (let* ((rchans (max out-chans rev-chans))
+ (rmx (make-float-vector (list rchans rchans) 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i rchans))
+ (set! (rmx i i) reverb))
+ rmx))))
- (if (= in-chans 2)
- (let ((sample-0-0 0.0)
- (sample-1-0 0.0)
- (sample-0-1 0.0)
- (sample-1-1 0.0)
- (ingen0 (vector-ref ex-array 0))
- (ingen1 (vector-ref ex-array 1)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
-
- (let ((vol (env ampenv))
- (resa (env srenv)))
-
- (if update-envs
- (begin
- (set! update-ctr (+ update-ctr 1))
- (if (>= update-ctr update-rate)
- (let* ((expa (env expenv)) ;current expansion amount
- (segl (env lenenv)) ;current segment length
- (rmpl (env rampenv)) ;current ramp length (0 to .5)
- (hp (env hopenv)) ;current hop size
- (sl (floor (* segl (mus-srate))))
- (rl (floor (* rmpl sl))))
- (set! update-ctr 0)
- (set! (mus-length ingen0) sl)
- (set! (mus-ramp ingen0) rl)
- (set! (mus-frequency ingen0) hp)
- (set! (mus-increment ingen0) expa)
- (set! (mus-length ingen1) sl)
- (set! (mus-ramp ingen1) rl)
- (set! (mus-frequency ingen1) hp)
- (set! (mus-increment ingen1) expa)))))
-
- (if (negative? ex-samp)
- (begin
- (set! sample-0-0 (* vol (granulate ingen0)))
- (set! sample-1-0 (* vol (granulate ingen0)))
- (set! sample-0-1 (* vol (granulate ingen1)))
- (set! sample-1-1 (* vol (granulate ingen1)))
- (set! ex-samp (+ 1 ex-samp))
- (set! next-samp ex-samp))
- (begin
- (set! next-samp (+ next-samp resa))
- (if (> next-samp (+ 1 ex-samp))
- (let ((samps (floor (- next-samp ex-samp))))
- (do ((k 0 (+ 1 k)))
- ((= k samps))
- (set! sample-0-0 sample-1-0)
- (set! sample-1-0 (* vol (granulate ingen0)))
- (set! sample-0-1 sample-1-1)
- (set! sample-1-1 (* vol (granulate ingen1)))
- (set! ex-samp (+ 1 ex-samp)))))))
-
- (if (= next-samp ex-samp)
- ;; output actual samples
- (begin
- (frame-set! inframe 0 sample-0-0)
- (frame-set! inframe 1 sample-0-1))
- (begin
- ;; output interpolated samples
- (frame-set! inframe 0 (+ sample-0-0 (* (- next-samp ex-samp) (- sample-1-0 sample-0-0))))
- (frame-set! inframe 1 (+ sample-0-1 (* (- next-samp ex-samp) (- sample-1-1 sample-0-1))))))
-
- ;; output mixed result
- (frame->file *output* i (frame->frame inframe mx outframe))
- ;; if reverb is turned on, output to the reverb streams
- (if rev-mx
- (frame->file *reverb* i (frame->frame outframe rev-mx revframe)))))))
+ (let ((mx (let ((v (make-float-vector (list ochans ochans) 0.0)))
+ (if (pair? matrix)
+ (let ((mat-in (min ochans (length matrix)))
+ (mat-out (min ochans (length (car matrix)))))
+ (do ((inp 0 (+ inp 1)))
+ ((= inp mat-in))
+ (do ((outp 0 (+ outp 1)))
+ ((= outp mat-out))
+ (set! (v inp outp) (matrix inp outp)))))
+ (do ((i 0 (+ i 1)))
+ ((= i ochans))
+ (set! (v i i) 1.0)))
+ v))
+
+ (revvals (and rev-mx (make-float-vector (max out-chans rev-chans) 0.0)))
+ (update-envs (or (pair? expand)
+ (pair? seglen)
+ (pair? ramp)
+ (pair? hop)))
+ (update-ctr 0)
+ (expenv (make-env (if (pair? expand) expand (list 0 expand 1 expand))
+ :duration (/ duration update-rate)))
+ (lenenv (make-env (if (pair? seglen) seglen (list 0 seglen 1 seglen))
+ :duration (/ duration update-rate)))
+ (segment-scaler (if (> max-seg-len .15)
+ (/ (* grain-amp .15) max-seg-len)
+ grain-amp))
+ (srenv (if (pair? srate)
+ (make-env srate :duration duration)
+ (make-env (list 0 srate) :duration duration)))
+ (rampenv (make-env rampdata :duration (/ duration update-rate)))
+ (minramp-bug (<= (min-envelope rampdata) 0.0))
+ (maxramp-bug (>= (max-envelope rampdata) 0.5))
+ (hopenv (make-env (if (pair? hop) hop (list 0 hop 1 hop))
+ :duration (/ duration update-rate)))
+ (ampenv (make-env amp-env :duration duration :scaler amplitude))
+ (ex-array (make-vector in-chans #f))
+ (ex-samp -1.0)
+ (next-samp 0.0)
+
+ (max-len (ceiling (* *clm-srate*
+ (+ (max max-out-hop max-in-hop)
+ max-seg-len))))
+ (invals (make-float-vector ochans 0.0))
+ (outvals (make-float-vector ochans 0.0)))
+
+ (if (or minramp-bug maxramp-bug)
+ (error 'out-of-range (list expand
+ "ramp argument to expandn must always be "
+ (if (and minramp-bug maxramp-bug) "between 0.0 and 0.5"
+ (if minramp-bug "greater than 0.0"
+ "less than 0.5")))))
+
+ ;; setup granulate generators
+ (do ((i 0 (+ i 1)))
+ ((= i in-chans))
+ (vector-set! ex-array i (make-granulate :input (make-readin fnam :start start :channel i)
+ :expansion (if (pair? expand) (cadr expand) expand)
+ :max-size max-len
+ :ramp (if (pair? ramp) (cadr ramp) ramp)
+ :hop (if (pair? hop) (cadr hop) hop)
+ :length (if (pair? seglen) (cadr seglen) seglen)
+ :scaler segment-scaler)))
+ ;; split out 1 and 2 chan input
+ (if (= in-chans 1)
+ (let ((ingen (vector-ref ex-array 0))
+ (sample-0 0.0)
+ (sample-1 0.0))
+ ;; these vars used for resampling
+
+ (if (and (not (pair? srate))
+ (not update-envs)
+ (= out-chans 1)
+ (not matrix)
+ (not rev-mx))
- (let ((samples-0 (make-vct in-chans))
- (samples-1 (make-vct in-chans)))
- ;; more than 2 chans in input file
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (declare (ex-array clm-vector))
-
- (let ((vol (env ampenv))
- (resa (env srenv)))
-
- (if update-envs
- (begin
- (set! update-ctr (+ update-ctr 1))
- (if (>= update-ctr update-rate)
- (let* ((expa (env expenv)) ;current expansion amount
- (segl (env lenenv)) ;current segment length
- (rmpl (env rampenv)) ;current ramp length (0 to .5)
- (hp (env hopenv)) ;current hop size
- (sl (floor (* segl (mus-srate))))
- (rl (floor (* rmpl sl))))
- (set! update-ctr 0)
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (let ((gen (vector-ref ex-array ix)))
- (set! (mus-length gen) sl)
- (set! (mus-ramp gen) rl)
- (set! (mus-frequency gen) hp)
- (set! (mus-increment gen) expa)))))))
-
- (if (negative? ex-samp)
- (begin
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (let ((gen (vector-ref ex-array ix)))
- (vct-set! samples-0 ix (* vol (granulate gen)))
- (vct-set! samples-1 ix (* vol (granulate gen)))))
- (set! ex-samp (+ 1 ex-samp))
- (set! next-samp ex-samp))
- (begin
- (set! next-samp (+ next-samp resa))
- (if (> next-samp (+ 1 ex-samp))
- (let ((samps (floor (- next-samp ex-samp))))
- (do ((k 0 (+ 1 k)))
- ((= k samps))
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (let ((gen (vector-ref ex-array ix)))
- (vct-set! samples-0 ix (vct-ref samples-1 ix))
- (vct-set! samples-1 ix (* vol (granulate gen)))))
- (set! ex-samp (+ 1 ex-samp)))))))
-
- (if (= next-samp ex-samp)
- ;; output actual samples
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (frame-set! inframe ix (vct-ref samples-0 ix)))
- ;; output interpolated samples
- (do ((ix 0 (+ 1 ix)))
- ((= ix in-chans))
- (let* ((v0 (vct-ref samples-0 ix))
- (v1 (vct-ref samples-1 ix)))
- (frame-set! inframe ix (+ v0 (* (- next-samp ex-samp)
- (- v1 v0)))))))
- ;; output mixed result
- (frame->file *output* i (frame->frame inframe mx outframe))
- ;; if reverb is turned on, output to the reverb streams
- (if rev-mx
- (frame->file *reverb* i (frame->frame outframe rev-mx revframe)))))))))))))
+ (let ((file-end (+ beg (seconds->samples (+ (* 2 seglen)
+ (* (mus-sound-duration fnam)
+ (/ (mus-sound-srate fnam) *clm-srate*)
+ (/ expand srate)))))))
+ (if (> end file-end)
+ (set! end file-end))
+
+ (do ((i beg (+ i 1)))
+ ((= i end))
+
+ (let ((vol (env ampenv)))
+ (if (negative? ex-samp)
+ (begin
+ (set! sample-0 (* vol (granulate ingen)))
+ (set! sample-1 (* vol (granulate ingen)))
+ (set! ex-samp (+ ex-samp 1))
+ (set! next-samp ex-samp)
+ (outa i sample-0))
+ (begin
+ (set! next-samp (+ next-samp srate))
+ (if (> next-samp (+ ex-samp 1))
+ (let ((samps (floor (- next-samp ex-samp))))
+ (if (= samps 2)
+ (begin
+ (set! sample-0 (* vol (granulate ingen)))
+ (set! sample-1 (* vol (granulate ingen))))
+ (do ((k 0 (+ k 1)))
+ ((= k samps))
+ (set! sample-0 sample-1)
+ (set! sample-1 (* vol (granulate ingen)))))
+ (set! ex-samp (+ ex-samp samps))))
+ (if (= next-samp ex-samp)
+ (outa i sample-0)
+ (outa i (+ sample-0 (* (- next-samp ex-samp) (- sample-1 sample-0))))))))))
+
+ (do ((i beg (+ i 1)))
+ ((= i end))
+
+ (let ((vol (env ampenv))
+ (resa (env srenv)))
+
+ (if update-envs
+ (begin
+ (set! update-ctr (+ update-ctr 1))
+ (if (>= update-ctr update-rate)
+ (let ((sl (floor (* (env lenenv) *clm-srate*))))
+ (set! update-ctr 0)
+ (set! (mus-length ingen) sl)
+ (set! (mus-ramp ingen) (floor (* sl (env rampenv))))
+ (set! (mus-frequency ingen) (env hopenv))
+ (set! (mus-increment ingen) (env expenv))))))
+
+ (if (negative? ex-samp)
+ (begin
+ (set! sample-0 (* vol (granulate ingen)))
+ (set! sample-1 (* vol (granulate ingen)))
+ (set! ex-samp (+ ex-samp 1))
+ (set! next-samp ex-samp))
+ (begin
+ (set! next-samp (+ next-samp resa))
+ (if (> next-samp (+ ex-samp 1))
+ (let ((samps (floor (- next-samp ex-samp))))
+ (if (= samps 2)
+ (begin
+ (set! sample-0 (* vol (granulate ingen)))
+ (set! sample-1 (* vol (granulate ingen))))
+ (do ((k 0 (+ k 1)))
+ ((= k samps))
+ (set! sample-0 sample-1)
+ (set! sample-1 (* vol (granulate ingen)))))
+ (set! ex-samp (+ ex-samp samps))))))
+
+ (if (= next-samp ex-samp)
+ ;; output actual samples
+ (set! (invals 0) sample-0)
+ ;; output interpolated samples
+ (set! (invals 0) (+ sample-0 (* (- next-samp ex-samp) (- sample-1 sample-0)))))
+
+ ;; output mixed result
+ (frample->file *output* i (frample->frample mx invals ochans outvals ochans))
+ ;; if reverb is turned on, output to the reverb streams
+ (if rev-mx
+ (frample->file *reverb* i (frample->frample rev-mx outvals ochans revvals rev-chans)))))))
+
+ (if (= in-chans 2)
+ (let ((sample-0-0 0.0)
+ (sample-1-0 0.0)
+ (sample-0-1 0.0)
+ (sample-1-1 0.0)
+ (ingen0 (vector-ref ex-array 0))
+ (ingen1 (vector-ref ex-array 1)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+
+ (let ((vol (env ampenv))
+ (resa (env srenv)))
+
+ (if update-envs
+ (begin
+ (set! update-ctr (+ update-ctr 1))
+ (if (>= update-ctr update-rate)
+ (let ((expa (env expenv)) ;current expansion amount
+ (segl (env lenenv)) ;current segment length
+ (rmpl (env rampenv)) ;current ramp length (0 to .5)
+ (hp (env hopenv))) ;current hop size
+ (let* ((sl (floor (* segl *clm-srate*)))
+ (rl (floor (* rmpl sl))))
+ (set! update-ctr 0)
+ (set! (mus-length ingen0) sl)
+ (set! (mus-ramp ingen0) rl)
+ (set! (mus-frequency ingen0) hp)
+ (set! (mus-increment ingen0) expa)
+ (set! (mus-length ingen1) sl)
+ (set! (mus-ramp ingen1) rl)
+ (set! (mus-frequency ingen1) hp)
+ (set! (mus-increment ingen1) expa))))))
+
+ (if (negative? ex-samp)
+ (begin
+ (set! sample-0-0 (* vol (granulate ingen0)))
+ (set! sample-1-0 (* vol (granulate ingen0)))
+ (set! sample-0-1 (* vol (granulate ingen1)))
+ (set! sample-1-1 (* vol (granulate ingen1)))
+ (set! ex-samp (+ ex-samp 1))
+ (set! next-samp ex-samp))
+ (begin
+ (set! next-samp (+ next-samp resa))
+ (if (> next-samp (+ ex-samp 1))
+ (let ((samps (floor (- next-samp ex-samp))))
+ (do ((k 0 (+ k 1)))
+ ((= k samps))
+ (set! sample-0-0 sample-1-0)
+ (set! sample-1-0 (* vol (granulate ingen0)))
+ (set! sample-0-1 sample-1-1)
+ (set! sample-1-1 (* vol (granulate ingen1))))
+ (set! ex-samp (+ ex-samp samps))))))
+
+ (if (= next-samp ex-samp)
+ ;; output actual samples
+ (begin
+ (set! (invals 0) sample-0-0)
+ (set! (invals 1) sample-0-1))
+ (begin
+ ;; output interpolated samples
+ (set! (invals 0) (+ sample-0-0 (* (- next-samp ex-samp) (- sample-1-0 sample-0-0))))
+ (set! (invals 1) (+ sample-0-1 (* (- next-samp ex-samp) (- sample-1-1 sample-0-1))))))
+
+ ;; output mixed result
+ (frample->file *output* i (frample->frample mx invals ochans outvals ochans))
+ ;; if reverb is turned on, output to the reverb streams
+ (if rev-mx
+ (frample->file *reverb* i (frample->frample rev-mx outvals ochans revvals rev-chans))))))
+
+ (let ((samples-0 (make-float-vector in-chans 0.0))
+ (samples-1 (make-float-vector in-chans 0.0)))
+ ;; more than 2 chans in input file
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((vol (env ampenv))
+ (resa (env srenv)))
+
+ (if update-envs
+ (begin
+ (set! update-ctr (+ update-ctr 1))
+ (if (>= update-ctr update-rate)
+ (let ((expa (env expenv)) ;current expansion amount
+ (segl (env lenenv)) ;current segment length
+ (rmpl (env rampenv)) ;current ramp length (0 to .5)
+ (hp (env hopenv))) ;current hop size
+ (let* ((sl (floor (* segl *clm-srate*)))
+ (rl (floor (* rmpl sl))))
+ (set! update-ctr 0)
+ (do ((ix 0 (+ ix 1)))
+ ((= ix in-chans))
+ (let ((gen (vector-ref ex-array ix)))
+ (set! (mus-length gen) sl)
+ (set! (mus-ramp gen) rl)
+ (set! (mus-frequency gen) hp)
+ (set! (mus-increment gen) expa))))))))
+
+ (if (negative? ex-samp)
+ (begin
+ (do ((ix 0 (+ ix 1)))
+ ((= ix in-chans))
+ (let ((gen (vector-ref ex-array ix)))
+ (float-vector-set! samples-0 ix (* vol (granulate gen)))
+ (float-vector-set! samples-1 ix (* vol (granulate gen)))))
+ (set! ex-samp (+ ex-samp 1))
+ (set! next-samp ex-samp))
+ (begin
+ (set! next-samp (+ next-samp resa))
+ (if (> next-samp (+ ex-samp 1))
+ (let ((samps (floor (- next-samp ex-samp))))
+ (do ((k 0 (+ k 1)))
+ ((= k samps))
+ (do ((ix 0 (+ ix 1)))
+ ((= ix in-chans))
+ (let ((gen (vector-ref ex-array ix)))
+ (float-vector-set! samples-0 ix (float-vector-ref samples-1 ix))
+ (float-vector-set! samples-1 ix (* vol (granulate gen))))))
+ (set! ex-samp (+ ex-samp samps))))))
+
+ (if (= next-samp ex-samp)
+ ;; output actual samples
+ (copy samples-0 invals 0 in-chans)
+ ;; output interpolated samples
+ (do ((ix 0 (+ ix 1)))
+ ((= ix in-chans))
+ (let ((v0 (float-vector-ref samples-0 ix))
+ (v1 (float-vector-ref samples-1 ix)))
+ (float-vector-set! invals ix (+ v0 (* (- next-samp ex-samp) (- v1 v0)))))))
+ ;; output mixed result
+ (frample->file *output* i (frample->frample mx invals ochans outvals ochans))
+ ;; if reverb is turned on, output to the reverb streams
+ (if rev-mx
+ (frample->file *reverb* i (frample->frample rev-mx outvals ochans revvals rev-chans)))))))))))))))
;;; (with-sound () (expandn 0 1 "oboe.snd" 1 :expand 4))
diff --git a/extensions.fs b/extensions.fs
index 6740a60..58e6451 100644
--- a/extensions.fs
+++ b/extensions.fs
@@ -1,427 +1,211 @@
\ extensions.fs -- extensions.scm -> extensions.fs
\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Sun Dec 18 19:21:00 CET 2005
-\ Changed: Thu Mar 03 15:29:03 CET 2011
-
-\ Commentary:
+\ Created: 05/12/18 19:21:00
+\ Changed: 14/12/03 17:15:55
\
+\ @(#)extensions.fs 1.50 12/3/14
+
\ With comments and doc strings from extensions.scm.
\
-\ Snd-7 compatibility
-\ color-map constants
-\ mus-a0, set-mus-a0, etc
-\ back-or-forth-graph ( count -- lst )
-\ forward-graph ( count -- lst )
-\ backward-graph ( count -- lst )
-\ back-or-forth-mix ( count snd chn -- mx )
-\ forward-mix ( count snd chn -- mx )
-\ backward-mix ( count snd chn -- mx )
-\ back-or-forth-mark ( count snd chn -- mk )
-\ forward-mark ( count snd chn -- mk )
-\ backward-mark ( count snd chn -- mk )
-\ mus-bank ( gens amps in1 in2 -- val )
-\ oscil-bank ( amps gens in1 in2 -- val )
-\ after-save-as-hook-replace-sound ( snd fname from-dialog -- )
-\ emacs-style-save-as ( -- f )
-\ set-emacs-style-save-as ( f -- )
-\
-\ Snd-8 compatibility
-\ samples->sound-data ( :optional beg len snd chn sd edpos sd-chan -- sd )
-\ open-sound-file ( :key ... -- fd )
-\ close-sound-file ( fd bytes -- n )
-\ vct->sound-file ( fd v samps -- n )
-\
-\ remove-sound-property ( key :optional snd -- alist )
-\ set-sound-property-save-state-ignore ( key snd -- alist )
-\ remove-channel-property ( key :optional snd chn -- alist )
-\ set-channel-property-save-state-ignore ( key snd chn -- alist )
-\ channel-sync ( snd chn -- val )
-\ set-channel-sync ( snd chn val -- )
+\ remove-sound-property ( key :optional snd -- props )
+\ set-sound-property-save-state-ignore ( key snd -- val )
+\ remove-channel-property ( key :optional snd chn -- props )
+\ set-channel-property-save-state-ignore ( key snd chn -- val )
+\ channel-sync ( snd chn -- val )
+\ set-channel-sync ( snd chn val -- )
\
-\ normalize-mix ( filename beg in-chn snd chn -- scl )
-\ enveloped-mix ( filename beg env -- )
-\ map-sound-files ( func :optional dir -- lst )
-\ for-each-sound-file ( func :optional dir -- )
-\ match-sound-files ( func :optional dir -- ary )
-\ selection-members ( -- array-of-arrays )
-\ make-selection ( :optional beg end snd chn -- )
-\ delete-selection-and-smooth ( -- )
-\ eval-over-selection ( func -- val )
+\ normalize-mix ( filename beg in-chn snd chn -- scl )
+\ enveloped-mix ( filename beg env -- )
+\ map-sound-files ( func :optional dir -- lst )
+\ for-each-sound-file ( func :optional dir -- )
+\ match-sound-files ( func :optional dir -- ary )
+\ selection-members ( -- array-of-arrays )
+\ make-selection ( :optional beg end snd chn -- )
\
-\ yes-or-no? ( question action-if-yes action-if-no snd -- )
-\
-\ mix-channel ( file-data :optional beg dur snd chn edpos -- val )
-\ insert-channel ( file-data :optional beg 0 dur snd chn edpos -- val )
-\ redo-channel ( :optional edits snd chn -- )
-\ undo-channel ( :optional edits snd chn -- )
-\ any-env-channel ( en func :optional beg dur snd chn edpos origin -- val )
-\ sine-ramp ( rmp0 rmp1 :optional beg dur snd chn edpos -- val )
-\ sine-env-channel ( en :optional beg dur snd chn edpos -- val )
-\ blackman4-ramp ( rmp0 rmp1 :optional beg dur snd chn edpos -- val )
-\ blackman4-env-channel ( en :optional beg dur snd chn edpos -- val )
-\ ramp-squared ( rmp0 rmp1 :optional symmetric beg dur snd chn edpos -- val )
-\ env-squared-channel ( en :optional symmetric beg dur snd chn edpos -- val )
-\ ramp-expt ( rmp0 rmp1 exponent ... )
-\ env-expt-channel ( en exponent ... )
-\ offset-channel ( amount :optional beg dur snd chn edpos -- val )
-\ offset-sound ( offset :optional beg dur snd -- )
-\ pad-sound ( beg dur :optional snd -- )
-\ dither-channel ( :optional amount beg dur snd chn edpos -- val )
-\ dither-sound ( :optional amount beg dur snd -- )
-\ contrast-channel ( index :optional beg dur snd chn edpos -- val )
-\ contrast-sound ( index :optional beg dur snd -- )
-\ scale-sound ( scl :optional beg dur snd -- )
-\ normalize-sound ( amp :optional beg dur snd -- )
+\ mix-channel ( fdata :optional beg dur s c edp -- val )
+\ insert-channel ( fdata :optional beg 0 dur s c edp -- val )
+\ redo-channel ( :optional edits snd chn -- )
+\ undo-channel ( :optional edits snd chn -- )
+\ any-env-channel ( en fc :optional beg dur s c edp or -- val )
+\ sine-ramp ( r0 r1 :optional beg dur s c edpos -- val )
+\ sine-env-channel ( en :optional beg dur s c edpos -- val )
+\ blackman4-ramp ( r0 r1 :optional beg dur s c ep -- val )
+\ blackman4-env-channel ( en :optional beg dur s c ep -- val )
+\ ramp-squared ( r0 r1 :optional sym beg dur s c ep -- val )
+\ env-squared-channel ( en :optional sym beg dur s c ep -- val )
+\ ramp-expt ( rmp0 rmp1 exponent ... )
+\ env-expt-channel ( en exponent ... )
+\ offset-channel ( amount :optional beg dur s c ep -- val )
+\ offset-sound ( offset :optional beg dur snd -- )
+\ pad-sound ( beg dur :optional snd -- )
+\ dither-channel ( :optional amount beg dur s c ep -- val )
+\ dither-sound ( :optional amount beg dur s -- )
+\ contrast-channel ( index :optional beg dur s c ep -- val )
+\ contrast-sound ( index :optional beg dur snd -- )
+\ scale-sound ( scl :optional beg dur snd -- )
+\ normalize-sound ( amp :optional beg dur snd -- )
\
-\ channels= ( snd1 chn1 snd2 chn2 :optional allowable-difference -- f )
-\ channels-equal? ( snd1 chn1 snd2 chn2 :optional allowable-difference -- f )
-\ mono->stereo ( new-name snd1 chn1 snd2 chn2 -- snd )
-\ mono-files->stereo ( new-name chan1-name chan2-name -- snd )
-\ stereo->mono ( orig-snd chan1-name chan2-name -- snd0 snd1 )
+\ channels= ( s1 c1 s2 c2 :optional allowable-diff -- f )
+\ channels-equal? ( s1 c1 s2 c2 :optional allowable-diff -- f )
+\ mono->stereo ( new-name snd1 chn1 snd2 chn2 -- snd )
+\ mono-files->stereo ( new-name chan1-name chan2-name -- snd )
+\ stereo->mono ( orig-s c1-name c2-name -- snd0 snd1 )
\
-\ with-reopen-menu ( -- )
-\ with-buffers-menu ( -- )
+\ with-reopen-menu ( -- )
+\ with-buffers-menu ( -- )
\
\ if-cursor-follows-play-it-stays-where-play-stopped ( :optional enable -- )
require clm
require examp
-\ === Snd-7 compatibility stuff (snd7.scm) ===
-: mus-a0 ( gen -- val ) 0 mus-xcoeff ;
-: set-mus-a0 ( gen val -- val ) 0 swap set-mus-xcoeff ;
-: mus-a1 ( gen -- val ) 1 mus-xcoeff ;
-: set-mus-a1 ( gen val -- val ) 1 swap set-mus-xcoeff ;
-: mus-a2 ( gen -- val ) 2 mus-xcoeff ;
-: set-mus-a2 ( gen val -- val ) 2 swap set-mus-xcoeff ;
-: mus-b1 ( gen -- val ) 1 mus-ycoeff ;
-: set-mus-b1 ( gen val -- val ) 1 swap set-mus-ycoeff ;
-: mus-b2 ( gen -- val ) 2 mus-ycoeff ;
-: set-mus-b2 ( gen val -- val ) 2 swap set-mus-ycoeff ;
-
-: back-or-forth-graph ( count -- lst )
- { count }
- sounds if
- #f snd-snd { cursnd }
- #f snd-chn { curchn }
- 0 { curpos }
- 0 { pos }
- #() { sndlst }
- sounds each { snd }
- snd channels 0 ?do
- cursnd snd =
- curchn i = && if pos to curpos then
- pos 1+ to pos
- sndlst #( snd i ) array-push drop
- loop
- end-each
- curpos count + sndlst object-length mod { newpos }
- sndlst newpos array-ref { vals }
- vals 0 array-ref set-selected-sound drop
- vals 1 array-ref #f set-selected-channel drop
- #( selected-sound #f selected-channel )
- else
- nil
- then
-;
-
-: forward-graph ( count -- lst ) back-or-forth-graph ;
-: backward-graph ( count -- lst ) negate back-or-forth-graph ;
-
-hide
-: sort-mix-pos ( a b -- n )
- { a b }
- a mix-position { am }
- b mix-position { bm }
- am bm < if
- 1
- else am bm > if
- -1
- else
- 0
- then
- then
-;
-set-current
-
-: back-or-forth-mix <{ count :optional snd #f chn #f -- mx|#f }>
- snd chn mixes { mx }
- count 0<> mx nil? not && if
- mx length 1 = if
- mx 0 array-ref mix-position snd chn #f set-cursor drop
- mx 0 array-ref \ retval
- else
- mx <'> sort-mix-pos object-sort { sorted-mx }
- snd chn #f cursor { pos }
- count 0> if -1 else 0 then { curpos }
- pos sorted-mx 0 array-ref mix-position >= if
- sorted-mx each { m }
- count 0>
- pos m mix-position < &&
- count 0<
- pos m mix-position <= && || if
- leave
- else
- curpos 1+ to curpos
- then
- end-each
- then
- curpos count + mx length mod to curpos
- sorted-mx curpos object-ref { val }
- val mix-position snd chn #f set-cursor drop
- val \ retval
- then
- else
- #f
- then
-;
-previous
-
-: forward-mix <{ count :optional snd #f chn #f -- mx|#f }>
- count snd snd-snd chn snd-chn back-or-forth-mix
-;
-
-: backward-mix <{ count :optional snd #f chn #f -- mx|#f }>
- count negate snd snd-snd chn snd-chn back-or-forth-mix
-;
-
-hide
-: sort-mark-sample ( a b -- n )
- { a b }
- a #f mark-sample { am }
- b #f mark-sample { bm }
- am bm < if
- 1
- else am bm > if
- -1
- else
- 0
- then
- then
-;
-set-current
-
-: back-or-forth-mark <{ count :optional snd #f chn #f -- mk|#f }>
- snd chn #f marks { mk }
- count 0<>
- mk empty? not && if
- mk length 1 = if
- mk 0 array-ref #f mark-sample snd chn #f set-cursor drop
- mk 0 array-ref \ retval
- else
- mk <'> sort-mark-sample object-sort { sorted-mk }
- snd chn #f cursor { pos }
- count 0> if -1 else 0 then { curpos }
- pos sorted-mk 0 array-ref #f mark-sample >= if
- sorted-mk each { m }
- count 0>
- pos m #f mark-sample < &&
- count 0<
- pos m #f mark-sample <= && || if
- leave
- else
- curpos 1+ to curpos
- then
- end-each
- then
- curpos count + mk length mod to curpos
- sorted-mk curpos object-ref { val }
- val mark-sample snd chn #f set-cursor
- val \ retval
- then
- else
- #f
- then
-;
-previous
-
-: forward-mark <{ count :optional snd #f chn #f -- mk|#f }>
- count snd snd-snd chn snd-chn back-or-forth-mark
-;
-
-: backward-mark <{ count :optional snd #f chn #f -- mk|#f }>
- count negate snd snd-snd chn snd-chn back-or-forth-mark
-;
-
-: mus-bank ( gens amps in1 in2 -- sum )
- { gens amps in1 in2 }
- 0.0 \ sum
- gens each ( gen ) in1 i object-ref in2 i object-ref mus-run amps i vct-ref f* ( sum ) f+ end-each
-;
-
-: oscil-bank ( amps gens in1 in2 -- sum )
- { amps gens in1 in2 }
- 0.0 \ sum
- gens each ( gen ) in1 i object-ref in2 i object-ref oscil amps i vct-ref f* ( sum ) f+ end-each
-;
-
-: after-save-as-hook-replace-sound ( snd fname from-dialog -- )
- { snd fname from-dialog }
- from-dialog if
- snd revert-sound drop
- snd close-sound drop
- fname open-sound drop
- then
-;
-
-: emacs-style-save-as ( -- f )
- after-save-as-hook <'> after-save-as-hook-replace-sound hook-member?
-;
-
-: set-emacs-style-save-as ( f -- )
- if
- emacs-style-save-as unless
- after-save-as-hook <'> after-save-as-hook-replace-sound add-hook!
- then
- else
- after-save-as-hook <'> after-save-as-hook-replace-sound remove-hook! drop
- then
-;
-\ #t set-emacs-style-save-as ==> installs
-\ #f set-emacs-style-save-as ==> deinstalls
-
-\ === Snd-8 compatibility stuff (snd8.scm) ===
-
-: samples->sound-data <{ :optional beg 0 len #f snd #f chn #f sd #f edpos #f sd-chan 0 -- sd }>
- beg len snd chn edpos channel->vct
- sd sound-data? if
- sd
- else
- 1
- len integer? if
- len
- else
- snd chn #f frames
- then
- make-sound-data
- then
- sd-chan
- vct->sound-data
-;
+\ ;;; -------- sound-property
-: open-sound-file <{ :key
- file "test.snd"
- channels 1
- srate 22050
- comment ""
- header-type mus-next -- fd }>
- file srate channels mus-lfloat header-type comment mus-sound-open-output
+: remove-sound-property <{ key :optional snd #f -- props }>
+ doc" Remove key-value pair in the given sound's \
+property list and return altered list."
+ snd sound-properties key array-assoc-remove!
;
-<'> mus-sound-close-output alias close-sound-file ( fd bytes -- n )
-
-: vct->sound-file <{ fd v samps -- n }>
- fd 0 samps 1- 1 v vct->sound-data mus-sound-write
+\ 'save-state-ignore key snd set-sound-property
+: set-sound-property-save-state-ignore <{ key :optional snd #f -- val }>
+ 'save-state-ignore snd sound-property { ign }
+ ign array? if
+ ign key array-push
+ else
+ #( 'save-state-ignore key )
+ then to ign
+ 'save-state-ignore ign snd set-sound-property
;
-\ === End of compatibility stuff ===
-
-\ ;;; -------- sound-property
+\ ;;; -------- channel-property
-: remove-sound-property <{ key :optional snd #f -- alist }>
- doc" Removes key-value pair in the given sound's property list. \
-Returns altered list."
- snd sound-properties key array-assoc-remove!
+: remove-channel-property <{ key :optional snd #f chn #f -- props }>
+ doc" Remove key-value pair in the given channel's \
+property list and return altered list."
+ snd chn channel-properties key array-assoc-remove!
;
-: set-sound-property-save-state-ignore <{ key :optional snd #f -- alist }>
- \ 'save-state-ignore key snd set-sound-property
- 'save-state-ignore snd sound-property { ign }
- ign array? if ign key array-push else #( 'save-state-ignore key ) then to ign
- 'save-state-ignore ign snd set-sound-property
+: set-channel-property-save-state-ignore
+ <{ key :optional snd #f chn #f -- val }>
+ 'save-state-ignore snd chn channel-property { ign }
+ ign array? if
+ ign key array-push
+ else
+ #( 'save-state-ignore key )
+ then to ign
+ 'save-state-ignore ign snd chn set-channel-property
;
-\ ;;; -------- channel-property
-
-: remove-channel-property <{ key :optional snd #f chn #f -- alist }>
- doc" Removes key-value pair in the given channel's property list. \
-Returns altered list."
- snd chn channel-properties key array-assoc-remove!
+: channel-sync { snd chn -- val }
+ 'sync snd chn channel-property
;
-: set-channel-property-save-state-ignore <{ key :optional snd #f chn #f -- alist }>
- 'save-state-ignore snd chn channel-property { ign }
- ign array? if ign key array-push else #( 'save-state-ignore key ) then to ign
- 'save-state-ignore ign snd chn set-channel-property
+: set-channel-sync { snd chn val -- }
+ 'sync val snd chn set-channel-property drop
;
-: channel-sync { snd chn -- val } 'sync snd chn channel-property ;
-: set-channel-sync { snd chn val -- } 'sync val snd chn set-channel-property ;
-
\ ;;; -------- mix with result at original peak amp
: normalize-mix ( filename beg in-chn snd chn -- scl )
- doc" It is like mix but the mix result has same peak amp as unmixed SND/CHN (returns scaler)."
- { filename beg in-chan snd chn }
- snd chn #f maxamp { original-maxamp }
- filename beg in-chan snd chn undef undef undef mix drop
- snd chn #f maxamp { new-maxamp }
- original-maxamp new-maxamp f<> if
- original-maxamp new-maxamp f/ { scaler }
- snd sync { old-sync }
- 0 snd set-sync drop
- scaler snd chn scale-by drop
- old-sync snd set-sync drop
- scaler
- else
- 1.0
- then
+ doc" It is like mix but the mix result has same peak \
+amp as unmixed SND/CHN (returns scaler)."
+ { filename beg in-chan snd chn }
+ snd chn #f maxamp { original-maxamp }
+ filename beg in-chan snd chn undef undef undef mix drop
+ snd chn #f maxamp { new-maxamp }
+ original-maxamp new-maxamp f<> if
+ original-maxamp new-maxamp f/ { scaler }
+ snd sync { old-sync }
+ 0 snd set-sync drop
+ scaler snd chn scale-by drop
+ old-sync snd set-sync drop
+ scaler
+ else
+ 1.0
+ then
;
\ ;;;-------- mix with envelope on mixed-in file
\ ;;;
-\ ;;; there are lots of ways to do this; this version uses functions from Snd, CLM, and Sndlib.
-
-: enveloped-mix ( filename beg env -- )
- doc" Mixes FILENAME starting at BEG with amplitude envelope ENV.\n\
-\"pistol.snd\" 0 #( 0 0 1 1 2 0 ) enveloped-mix"
- { filename beg env }
- filename mus-sound-frames { len }
- temp-dir empty? if "" else temp-dir then "tmp.snd" $+ { tmp-name }
- tmp-name 22050 1 mus-bshort mus-next "" mus-sound-open-output 0 mus-sound-close-output drop
- #( #( :envelope env :length len make-env ) ) { envs }
- 1 1.0 make-mixer { mx }
- tmp-name filename 0 len 0 mx envs mus-mix drop
- tmp-name beg undef undef undef undef undef undef mix drop
- tmp-name file-delete
+\ ;;; there are lots of ways to do this; this version uses functions
+\ ;;; from Snd, CLM, and Sndlib.
+
+hide
+: em-cb { amp-env rd -- prc; y self -- val }
+ 1 proc-create ( prc ) amp-env , rd ,
+ does> { y self -- val }
+ self @ { amp-env }
+ self cell+ @ { rd }
+ amp-env env rd readin f* y f+
;
+set-current
+
+: enveloped-mix ( filename beg en -- )
+ doc" Mix FILENAME starting at BEG with amplitude envelope EN.\n\
+\"pistol.snd\" 0 #( 0 0 1 1 2 0 ) enveloped-mix."
+ { filename beg en }
+ filename framples { len }
+ :envelope en :length len make-env { amp-env }
+ filename make-readin { rd }
+ amp-env rd em-cb beg len map-channel drop
+;
+previous
\ ;;; -------- map-sound-files, match-sound-files
\ ;;;
\ ;;; apply a function to each sound in dir
\ ;;;
-\ ;;; (map-sound-files (lambda (n) (if (> (mus-sound-duration n) 10.0) (snd-print n))))
+\ ;;; (map-sound-files (lambda (n) (if (> (mus-sound-duration n) 10.0)
+\ ;;; (snd-print n))))
: map-sound-files <{ func :optional dir "." -- lst }>
- doc" Applies FUNC to each sound file in DIR."
- dir sound-files-in-directory map func #( *key* ) run-proc end-map
-;
-\ lambda: <{ n -- str|#f }> n mus-sound-duration 10.0 f> if n snd-print cr then ; map-sound-files
+ doc" Apply FUNC to each sound file in DIR."
+ dir sound-files-in-directory map
+ func #( *key* ) run-proc
+ end-map
+;
+\ lambda: <{ n -- str|#f }>
+\ n mus-sound-duration 10.0 f> if
+\ n snd-print ( n remains on stack )
+\ cr
+\ else
+\ #f
+\ then
+\ ; map-sound-files
: for-each-sound-file <{ func :optional dir "." -- }>
- doc" Applies FUNC to each sound file in DIR."
- dir sound-files-in-directory each { f } func #( f ) run-proc drop end-each
+ doc" Apply FUNC to each sound file in DIR."
+ dir sound-files-in-directory each { f }
+ func #( f ) run-proc drop
+ end-each
;
0 [if]
-"/home/bil/sf" value loop-path
-lambda: <{ n -- }>
- loop-path "/" $+ n $+ <'> mus-sound-loop-info #t nil fth-catch if
- stack-reset
- exit
- then
- empty? unless n snd-print drop cr then
-; loop-path for-each-sound-file
+ "/home/bil/sf" value loop-path
+ lambda: <{ n -- }>
+ loop-path "/" $+ n $+
+ <'> mus-sound-loop-info #t nil fth-catch if
+ stack-reset
+ else
+ ( loop-list ) empty? unless
+ n snd-print drop
+ cr
+ then
+ then
+ ; loop-path for-each-sound-file
[then]
: match-sound-files <{ func :optional dir "." -- ary }>
- doc" Applies FUNC to each sound file in DIR and returns an array of files \
-for which FUNC does not return #f."
- #() { matches }
- dir sound-files-in-directory each { f }
- func #( f ) run-proc if matches f array-push drop then
- end-each
- matches
+ doc" Apply FUNC to each sound file in DIR and \
+returns an array of files for which FUNC does not return #f."
+ #() { matches }
+ dir sound-files-in-directory each { f }
+ func #( f ) run-proc if
+ matches f array-push drop
+ then
+ end-each
+ matches
;
\ lambda: <{ n -- f }> /\.(wav?|snd)$/ n regexp-match ; "." match-sound-files
@@ -430,137 +214,68 @@ for which FUNC does not return #f."
\ ;;; returns a list of lists of (snd chn): channels in current selection
: selection-members ( -- array-of-lists )
- doc" Returns an array of lists of #( snd chn ) indicating the channels \
-participating in the current selection."
- #() { sndlist }
- undef selection? if
- sounds each { snd }
- snd channels 0 ?do
- snd i selection-member? if sndlist #( snd i ) array-push drop then
- loop
- end-each
- then
- sndlist
+ doc" Return an array of lists of #( snd chn ) indicating \
+the channels participating in the current selection."
+ #() { sndlist }
+ undef selection? if
+ sounds each { snd }
+ snd channels 0 ?do
+ snd i selection-member? if
+ sndlist #( snd i ) array-push drop
+ then
+ loop
+ end-each
+ then
+ sndlist
;
\ ;;; -------- make-selection
\ ;;;
\ ;;; the regularized form of this would use dur not end
-: make-selection <{ :optional beg 0 end #f snd #f chn #f -- }>
- doc" Makes a selection like make-region but without creating a region. \
-It follows SND's sync field, and applies to all SND's channels if CHN is not specified. \
-END defaults to end of channel, BEG defaults to 0, SND defaults to the currently selected sound."
- snd snd-snd { current-sound }
- current-sound sound? unless 'no-such-sound #( get-func-name beg end snd chn ) fth-throw then
- current-sound sync { current-sync }
- undef selection? if
- sounds each { s }
- s channels 0 ?do
- s i selection-member? ( need-update )
- #f s i set-selection-member? drop
- ( need-update ) if s i update-time-graph drop then
- loop
- end-each
- chn integer? if
- end integer? if end 1+ else snd chn #f frames then beg - { len }
- #t snd chn set-selection-member? drop
- beg snd chn set-selection-position drop
- len snd chn set-selection-frames drop
- else
- sounds each { s }
- snd #t =
- s current-sound = ||
- current-sync 0= current-sync s sync = && || if
- s channels 0 ?do
- #t s i set-selection-member? drop
- beg s i set-selection-position drop
- len s i set-selection-frames drop
- loop
- then
- end-each
- then
- then
-;
-
-\ ;;; -------- delete selected portion and smooth the splice
-
-: delete-selection-and-smooth ( -- )
- doc" Deletes the current selection and smooths the splice."
- undef selection? if
- #f #f selection-position { beg }
- #f #f selection-frames { len }
- all-chans each { lst }
- lst 0 array-ref { snd }
- lst 1 array-ref { chn }
- snd chn selection-member? if
- beg len snd chn #f delete-samples drop
- beg 16 - 0 max 32 snd chn smooth-sound drop
- then
- end-each
- then
-;
-
-\ ;;; -------- eval over selection, replacing current samples,
-\ ;;; mapped to "C-x x" key using prompt-in-minibuffer
-\ ;;;
-\ ;;; when the user types C-x x (without modifiers) and there is a current selection,
-\ ;;; the minibuffer prompts "selection eval:". Eventually the user responds,
-\ ;;; hopefully with a function of one argument, the current selection sample
-\ ;;; the value returned by the function becomes the new selection value.
-
-: eval-over-selection <{ func -- val }>
- doc" Evaluates FUNC on each sample in the current selection."
- func word?
- undef selection? && if
- #f #f selection-position { beg }
- #f #f selection-frames { len }
- $" <'> %s %s" #( func get-func-name ) string-format { origin }
- all-chans each { lst }
- lst 0 array-ref { snd }
- lst 1 array-ref { chn }
- snd chn selection-member? if
- beg len snd chn #f channel->vct ( old-data ) map
- func #( *key* ) run-proc
- end-map ( new-data ) beg len snd chn #f origin vct->channel drop
- then
- end-each
- then
-;
-0 [if]
-"x" 0 lambda: <{ -- val }>
- undef selection? if
- $" selection-eval:" <'> eval-over-selection #f #f prompt-in-minibuffer
- else
- $" no selection" #f #f report-in-minibuffer
- then
-; #t $" eval over selection" $" eval over selection" bind-key
-[then]
-
hide
-: response-cb { snd action-if-yes action-if-no -- proc; response self -- val }
- 1 proc-create action-if-no , action-if-yes , snd ,
- does> { response self -- val }
- self @ { action-if-no }
- self cell+ @ { action-if-yes }
- self 2 cells + @ { snd }
- snd clear-minibuffer drop
- response 0 string-ref [char] y = if
- action-if-yes snd run-proc
- else
- action-if-no snd run-proc
- then
+: add-chan-to-selection { beg end snd chn -- }
+ beg integer? unless
+ 0 to beg
+ then
+ end integer? if
+ end 1+
+ else
+ snd chn #f framples
+ then beg - to end
+ #t snd chn set-selection-member? drop
+ beg snd chn set-selection-position drop
+ end snd chn set-selection-framples drop
;
set-current
-: yes-or-no? ( question action-if-yes action-if-no snd -- )
- { question action-if-yes action-if-no snd }
- snd clear-minibuffer drop
- question
- snd action-if-yes action-if-no response-cb
- snd
- #t
- prompt-in-minibuffer drop
+: make-selection <{ :optional beg 0 end #f snd #f chn #f -- }>
+ doc" Make a selection like make-region but without creating a region. \
+It follows SND's sync field, and applies to all SND's \
+channels if CHN is not specified. \
+END defaults to end of channel, BEG defaults to 0, \
+SND defaults to the currently selected sound."
+ snd snd-snd { current-sound }
+ current-sound sound? unless
+ 'no-such-sound
+ #( "%s: can't find sound %s" get-func-name snd ) fth-throw
+ then
+ current-sound sync { current-sync }
+ unselect-all drop
+ chn integer? if
+ beg end snd chn add-chan-to-selection
+ else
+ sounds each { s }
+ snd #t =
+ s current-sound = ||
+ current-sync 0<>
+ current-sync s sync = && || if
+ s channels 0 ?do
+ beg end s i add-chan-to-selection
+ loop
+ then
+ end-each
+ then
;
previous
@@ -568,310 +283,365 @@ previous
hide
: mc-cb { rd -- prc; y self -- val }
- 1 proc-create rd , ( prc )
- does> { y self -- val }
- self @ ( rd ) next-sample y f+
+ 1 proc-create ( prc )
+ rd ,
+ does> { y self -- val }
+ self @ ( rd ) next-sample y f+
;
set-current
-: mix-channel <{ file-data :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Mixes in FILE-DATA. \
-FILE-DATA can be the file name or a list #( file-name [beg [channel]] )"
- file-data string? if file-data else file-data 0 array-ref then { file-name }
- file-name find-file to file-name
- file-name false? if 'no-such-file #( get-func-name file-name ) fth-throw then
- file-data string? file-data length 2 < || if 0 else file-data 1 array-ref then { file-beg }
- file-data string? file-data length 3 < || if 0 else file-data 2 array-ref then { file-channel }
- dur file-name mus-sound-frames file-beg - || { len }
- beg 0< if 'no-such-sample #( get-func-name beg ) fth-throw then
- len 0> if
- file-beg file-name file-channel 1 #f make-sampler { reader }
- $" %S %s %s %s" #( file-data beg dur get-func-name ) string-format { origin }
- reader mc-cb beg len snd chn edpos origin map-channel
- else
- #f
- then
+: mix-channel <{ file :optional beg 0 dur #f snd #f chn #f edpos #f -- r }>
+ doc" Mix in FILE. \
+FILE can be the file name or a list #( file-name [beg [channel]] )."
+ file string? if
+ file
+ else
+ file 0 array-ref
+ then { file-name }
+ file-name find-file to file-name
+ file-name unless
+ 'no-such-file #( "%s: %S" get-func-name file-name ) fth-throw
+ then
+ file string?
+ file length 2 < || if
+ 0
+ else
+ file 1 array-ref
+ then { file-beg }
+ file string?
+ file length 3 < || if
+ 0
+ else
+ file 2 array-ref
+ then { file-channel }
+ dur file-name mus-sound-framples file-beg - || { len }
+ beg 0< if
+ 'no-such-sample #( "%s: %s" get-func-name beg ) fth-throw
+ then
+ len 0> if
+ file-beg file-name file-channel 1 #f make-sampler { reader }
+ "%S %s %s %s" #( file beg dur get-func-name )
+ string-format { origin }
+ reader mc-cb beg len snd chn edpos origin map-channel
+ else
+ #f
+ then
;
previous
-: insert-channel <{ file-data :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Inserts the FILE-DATA. \
-FILE-DATA can be the file name or a list #( file-name [beg [channel]] )"
- file-data string? if file-data else file-data 0 array-ref then { file-name }
- file-name find-file to file-name
- file-name false? if 'no-such-file #( get-func-name file-name ) fth-throw then
- file-data string? file-data length 2 < || if 0 else file-data 1 array-ref then { file-beg }
- file-data string? file-data length 3 < || if 0 else file-data 2 array-ref then { file-channel }
- dur file-name mus-sound-frames file-beg - || { len }
- beg 0< if 'no-such-sample #( get-func-name beg ) fth-throw then
- len 0> if
- file-beg file-name file-channel 1 #f make-sampler { reader }
- len 0.0 make-vct map! reader next-sample end-map { data }
- reader free-sampler drop
- $" %S %s %s %s" #( file-data beg dur get-func-name ) string-format { origin }
- beg len data snd chn edpos #f origin insert-samples
- else
- #f
- then
+: insert-channel <{ file :optional beg 0 dur #f snd #f chn #f edpos #f -- r }>
+ doc" Insert the FILE. \
+FILE can be the file name or a list #( file-name [beg [channel]] )."
+ file string? if
+ file
+ else
+ file 0 array-ref
+ then { file-name }
+ file-name find-file to file-name
+ file-name unless
+ 'no-such-file #( "%s: %S" get-func-name file-name ) fth-throw
+ then
+ file string?
+ file length 2 < || if
+ 0
+ else
+ file 1 array-ref
+ then { file-beg }
+ file string?
+ file length 3 < || if
+ 0
+ else
+ file 2 array-ref
+ then { file-channel }
+ dur file-name mus-sound-framples file-beg - || { len }
+ beg 0< if
+ 'no-such-sample #( "%s: %s" get-func-name beg ) fth-throw
+ then
+ len 0> if
+ file-beg file-name file-channel 1 #f make-sampler { reader }
+ len 0.0 make-vct map!
+ reader next-sample
+ end-map { data }
+ reader free-sampler drop
+ "%S %s %s %s" #( file beg dur get-func-name )
+ string-format { origin }
+ beg len data snd chn edpos #f origin insert-samples
+ else
+ #f
+ then
;
\ ;;; -------- redo-channel, undo-channel
: redo-channel <{ :optional edits 1 snd #f chn #f -- }>
- doc" It's the regularized version of redo."
- snd fixnum?
- snd sync 0<> &&
- chn fixnum? && if
- snd chn edit-position edits + snd chn set-edit-position drop
- else
- edits snd chn redo drop
- then
+ doc" It's the regularized version of redo."
+ snd fixnum?
+ snd sync 0<> &&
+ chn fixnum? && if
+ snd chn edit-position edits + snd chn set-edit-position drop
+ else
+ edits snd chn redo drop
+ then
;
: undo-channel <{ :optional edits 1 snd #f chn #f -- }>
- doc" It's the regularized version of undo."
- snd fixnum?
- snd sync 0<> &&
- chn fixnum? && if
- snd chn edit-position edits - 0 max snd chn set-edit-position drop
- else
- edits snd chn undo drop
- then
+ doc" It's the regularized version of undo."
+ snd fixnum?
+ snd sync 0<> &&
+ chn fixnum? && if
+ snd chn edit-position edits - 0 max
+ snd chn set-edit-position drop
+ else
+ edits snd chn undo drop
+ then
;
\ ;;; -------- any-env-channel
hide
: aec-cb { en func beg dur snd chn edpos -- prc; self -- val }
- 0 proc-create en , func , beg , dur , snd , chn , edpos , ( prc )
- does> { self -- val }
- self @ { en }
- self cell+ @ { func }
- self 2 cells + @ { beg }
- self 3 cells + @ { dur }
- self 4 cells + @ { snd }
- self 5 cells + @ { chn }
- self 6 cells + @ { edpos }
- 0.0 0.0 { x0 y0 }
- en 0 array-ref { x1 }
- en 1 array-ref { y1 }
- en envelope-last-x en 0 array-ref f- { xrange }
- beg { ramp-beg }
- 0 { ramp-dur }
- en length 1- 2 ?do
- x1 to x0
- y1 to y0
- en i array-ref to x1
- en i 1+ array-ref to y1
- x1 x0 f- xrange f/ dur f* fround->s to ramp-dur
- y0 y1 f= if
- y0 ramp-beg ramp-dur snd chn edpos scale-channel
- else
- func #( y0 y1 ramp-beg ramp-dur snd chn edpos ) run-proc
- then
- ramp-dur +to ramp-beg
- 2 +loop
+ 0 proc-create ( prc )
+ en , func , beg , dur , snd , chn , edpos ,
+ does> { self -- val }
+ self @ { en }
+ self cell+ @ { func }
+ self 2 cells + @ { beg }
+ self 3 cells + @ { dur }
+ self 4 cells + @ { snd }
+ self 5 cells + @ { chn }
+ self 6 cells + @ { edpos }
+ 0.0 0.0 { x0 y0 }
+ en 0 array-ref { x1 }
+ en 1 array-ref { y1 }
+ en envelope-last-x en 0 array-ref f- { xrange }
+ beg { ramp-beg }
+ 0 { ramp-dur }
+ en length 1- 2 ?do
+ x1 to x0
+ y1 to y0
+ en i array-ref to x1
+ en i 1+ array-ref to y1
+ x1 x0 f- xrange f/ dur f* fround->s to ramp-dur
+ y0 y1 f= if
+ y0 ramp-beg ramp-dur snd chn edpos scale-channel
+ else
+ func #( y0 y1 ramp-beg ramp-dur snd chn edpos ) run-proc
+ then
+ ramp-dur +to ramp-beg
+ 2 +loop
;
set-current
-: any-env-channel <{ en func :optional beg 0 dur #f snd #f chn #f edpos #f origin #f -- val }>
- en nil? if
- #f
- else
- en envelope-length ( pts ) 1 = if
- en 0 array-ref beg dur snd chn edpos scale-channel
- else
- dur integer? unless snd chn #f frames to dur then
- en func beg dur snd chn edpos aec-cb origin as-one-edit
- then
- then
+: any-env-channel
+ <{ en func :optional beg 0 dur #f snd #f chn #f edpos #f origin #f -- val }>
+ en nil? if
+ #f
+ exit
+ then
+ en envelope-length ( pts ) 1 = if
+ en 0 array-ref beg dur snd chn edpos scale-channel
+ else
+ dur integer? unless
+ snd chn #f framples to dur
+ then
+ en func beg dur snd chn edpos aec-cb origin as-one-edit
+ then
;
previous
\ ;;; -------- sine-ramp sine-env-channel
hide
-: sr3-cb <{ y data forward -- val }>
- data 0 vct-ref { angle }
- data 1 vct-ref { incr }
- angle fcos f2/ 0.5 f+ data 3 vct-ref f* data 2 vct-ref f+ y f* ( val )
- data 0 forward angle incr if f+ else f- then vct-set! drop
- ( val )
-;
-
-: sr2-cb { rmp0 rmp1 -- prc; frag-beg frag-dur self -- vct }
- 2 proc-create rmp0 , rmp1 ,
- does> { frag-beg frag-dur self -- vct }
- self @ { rmp0 }
- self cell+ @ { rmp1 }
- pi frag-dur f/ { incr }
- vct( pi fnegate frag-beg incr f* f+
- incr
- rmp0
- rmp1 rmp0 f- )
+: sine-ramp-cb { rmp0 rmpd incr -- prc; y self -- val }
+ 1 proc-create ( prc )
+ rmp0 , rmpd , pi fnegate ( angle ) , incr ,
+ does> { y self -- val }
+ self @ { rmp0 }
+ self 1 cells + @ { rmpd }
+ self 2 cells + @ { angle }
+ self 3 cells + @ { incr }
+ angle fcos 0.5 f* 0.5 f+ rmpd f* rmp0 f+ y f* ( val )
+ angle incr f+ self 2 cells + ! ( angle += incr )
+ ( val )
;
set-current
: sine-ramp <{ rmp0 rmp1 :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Produces a sinsusoidal connection from RMP0 to RMP1."
- \ ;; vct: angle incr off scl
- $" %s %s %s %s %s" #( rmp0 rmp1 beg dur get-func-name ) string-format { origin }
- <'> sr3-cb beg dur snd chn edpos #t rmp0 rmp1 sr2-cb origin ptree-channel
+ doc" Produce a sinsusoidal connection from RMP0 to RMP1."
+ "%s %s %s %s %s" #( rmp0 rmp1 beg dur get-func-name )
+ string-format { origin }
+ dur number? if
+ dur
+ else
+ snd chn edpos framples beg f-
+ then pi swap f/ { incr }
+ rmp0 rmp1 rmp0 f- incr sine-ramp-cb
+ beg dur snd chn edpos origin map-channel
;
previous
: sine-env-channel <{ en :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Connects ENV's dots with sinusoids."
- $" %s %s %s %s" #( en beg dur get-func-name ) string-format { origin }
- en <'> sine-ramp beg dur snd chn edpos origin any-env-channel
+ doc" Connect ENV's dots with sinusoids."
+ "%s %s %s %s" #( en beg dur get-func-name ) string-format { origin }
+ en <'> sine-ramp beg dur snd chn edpos origin any-env-channel
;
\ #( 0 0 1 1 2 -0.5 3 1 ) sine-env-channel
-\ ;;; an obvious extension of this idea is to use the blackman fft window formulas
-\ ;;; to get sharper sinusoids (i.e. use the sum of n cosines, rather than just 1)
+\ ;;; an obvious extension of this idea is to use the blackman fft
+\ ;;; window formulas to get sharper sinusoids (i.e. use the sum of n
+\ ;;; cosines, rather than just 1)
\
\ ;;; -------- blackman4-ramp, blackman4-env-channel
hide
-: b4r3-cb <{ y data forward -- val }>
- data 0 vct-ref { angle }
- data 1 vct-ref { incr }
- angle fcos { cx }
- cx 0.041194 f* -0.20762 f+ cx f* 0.375696 f+ cx f* -0.29145 f+ cx f* 0.084037 f+
- data 3 vct-ref f* data 2 vct-ref f+ y f* ( val )
- data 0 forward angle incr if f+ else f- then vct-set! drop
- ( val )
-;
-
-: b4r2-cb { rmp0 rmp1 -- prc; frag-beg frag-dur self -- vct }
- 2 proc-create rmp0 , rmp1 , ( prc )
- does> { frag-beg frag-dur self -- vct }
- self @ { rmp0 }
- self cell+ @ { rmp1 }
- pi frag-dur f/ { incr }
- vct( frag-beg incr f*
- incr
- rmp0
- rmp1 rmp0 f- )
+: b4r-cb { rmp0 rmpd incr -- prc; y self -- val }
+ 1 proc-create ( prc )
+ rmp0 , rmpd , 0.0 ( angle ) , incr ,
+ does> { y self -- val }
+ self @ { rmp0 }
+ self 1 cells + @ { rmpd }
+ self 2 cells + @ { angle }
+ self 3 cells + @ { incr }
+ angle fcos { cx }
+ cx 0.041194 f* -0.20762 f+
+ cx f* 0.375696 f+
+ cx f* -0.29145 f+
+ cx f* 0.084037 f+
+ rmpd f* rmp0 f+
+ y f* ( val )
+ angle incr f+ self 2 cells + ! ( angle += incr )
+ ( val )
;
set-current
-: blackman4-ramp <{ rmp0 rmp1 :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- $" %s %s %s %s %s" #( rmp0 rmp1 beg dur get-func-name ) string-format { origin }
- <'> b4r3-cb beg dur snd chn edpos #f rmp0 rmp1 b4r2-cb origin ptree-channel
+: blackman4-ramp <{ rm0 rm1 :optional beg 0 dur #f snd #f chn #f ep #f -- val }>
+ "%s %s %s %s %s" #( rm0 rm1 beg dur get-func-name )
+ string-format { origin }
+ dur number? if
+ dur
+ else
+ snd chn ep framples beg f-
+ then pi swap f/ { incr }
+ rm0 rm1 rm0 f- incr b4r-cb beg dur snd chn ep origin map-channel
;
previous
-: blackman4-env-channel <{ en :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- $" %s %s %s %s" #( en beg dur get-func-name ) string-format { origin }
- en <'> blackman4-ramp beg dur snd chn edpos origin any-env-channel
+: blackman4-env-channel <{ en :optional beg 0 dur #f snd #f chn #f ep #f -- r }>
+ "%s %s %s %s" #( en beg dur get-func-name ) string-format { origin }
+ en <'> blackman4-ramp beg dur snd chn ep origin any-env-channel
;
-\ ;;; any curve can be used as the connecting line between envelope breakpoints in the
-\ ;;; same manner -- set up each ramp to take the current position and increment,
-\ ;;; then return the value in ptree-channel. A simple one would have a table of
-\ ;;; values and use array-interp.
-\
\ ;;; -------- ramp-squared, env-squared-channel
hide
-: rsq3-cb <{ y data forward -- val }>
- data 0 vct-ref { angle }
- data 1 vct-ref { incr }
- angle dup f* data 3 vct-ref f* data 2 vct-ref f+ y f* ( val )
- data 0 forward angle incr if f+ else f- then vct-set! drop
- ( val )
-;
-
-: rsq2-cb { rmp0 rmp1 symmetric -- prc; frag-beg frag-dur self -- vct }
- 2 proc-create rmp0 , rmp1 , symmetric , ( prc )
- does> { frag-beg frag-dur self -- vct }
- self @ { rmp0 }
- self cell+ @ { rmp1 }
- self 2 cells + @ { symmetric }
- frag-dur 1/f { incr }
- symmetric rmp1 rmp0 f< && if
- vct( frag-dur frag-beg f- incr f* incr fnegate rmp1 rmp0 rmp1 f- )
- else
- vct( frag-beg incr f* incr rmp0 rmp1 rmp0 f- )
- then
+: rsq-cb { rmp0 rmpd incr -- prc; y self -- val }
+ 1 proc-create ( prc )
+ rmp0 , rmpd , 0.0 ( angle ) , incr ,
+ does> { y self -- val }
+ self @ { rmp0 }
+ self 1 cells + @ { rmpd }
+ self 2 cells + @ { angle }
+ self 3 cells + @ { incr }
+ angle dup f* rmpd f* rmp0 f+ y f* ( val )
+ angle incr f+ self 2 cells + ! ( angle += incr )
+ ( val )
;
set-current
-: ramp-squared <{ rmp0 rmp1 :optional symmetric #t beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Connects RMP0 and RMP1 with an x^2 curve."
- $" %s %s %s %s %s %s" #( rmp0 rmp1 symmetric beg dur get-func-name ) string-format { origin }
- <'> rsq3-cb beg dur snd chn edpos #t rmp0 rmp1 symmetric rsq2-cb origin ptree-channel
+: ramp-squared <{ r0 r1 :optional sy #t beg 0 dur #f snd #f chn #f ep #f -- r }>
+ doc" Connect R0 and R1 with an x^2 curve."
+ "%s %s %s %s %s %s" #( r0 r1 sy beg dur get-func-name )
+ string-format { origin }
+ dur number? if
+ dur
+ else
+ snd chn ep framples beg f-
+ then 1/f { incr }
+ r0 r1 r0 f- incr rsq-cb beg dur snd chn ep origin map-channel
;
previous
hide
: esqc-cb { symmetric -- prc; r0 r1 b d s c e self -- val }
- 7 proc-create symmetric , ( prc )
- does> { r0 r1 b d s c e self -- val }
- r0 r1 self @ ( symmetric ) b d s c e ramp-squared
+ 7 proc-create ( prc )
+ symmetric ,
+ does> { r0 r1 b d s c e self -- val }
+ r0 r1 self @ ( symmetric ) b d s c e ramp-squared
;
set-current
-: env-squared-channel <{ en :optional symmetric #t beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Connects ENV's dots with x^2 curves."
- $" %s %s %s %s %s" #( en symmetric beg dur get-func-name ) string-format { origin }
- en symmetric esqc-cb beg dur snd chn edpos origin any-env-channel
+: env-squared-channel <{ en :optional sy #t beg 0 dur #f s #f c #f ep #f -- r }>
+ doc" Connect ENV's dots with x^2 curves."
+ "%s %s %s %s %s" #( en sy beg dur get-func-name )
+ string-format { origin }
+ en sy esqc-cb beg dur s c ep origin any-env-channel
;
previous
\ #( 0 0 1 1 2 -0.5 3 1 ) env-squared-channel
\ ;;; -------- ramp-expt, env-expt-channel
-hide
-: rex3-cb <{ y data forward -- val }>
- data 0 vct-ref { angle }
- data 1 vct-ref { incr }
- data 4 vct-ref angle flog f* fexp data 3 vct-ref f* data 2 vct-ref f+ y f* ( val )
- data 0 forward angle incr if f+ else f- then vct-set! drop
- ( val )
-;
-
-: rex2-cb { rmp0 rmp1 symmetric exponent -- prc; frag-beg frag-dur self -- vct }
- 2 proc-create rmp0 , rmp1 , symmetric , exponent , ( prc )
- does> { frag-beg frag-dur self -- vct }
- self @ { rmp0 }
- self cell+ @ { rmp1 }
- self 2 cells + @ { symmetric }
- self 3 cells + @ { exponent }
- frag-dur 1/f { incr }
- symmetric rmp1 rmp0 f< && if
- vct( frag-dur frag-beg f- incr f* incr fnegate rmp1 rmp0 rmp1 f- exponent )
- else
- vct( frag-beg incr f* incr rmp0 rmp1 rmp0 f- exponent )
- then
-;
-set-current
-
-: ramp-expt <{ rmp0 rmp1 exponent
- :optional symmetric #t beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Connects RMP0 and RMP1 with an x^exponent curve."
- \ ;; vct: start incr off scl exponent
- \ ;; a^x = exp(x * log(a))
- $" %s %s %s %s %s %s %s"
- #( rmp0 rmp1 exponent symmetric beg dur get-func-name ) string-format { origin }
- <'> rex3-cb beg dur snd chn edpos #t rmp0 rmp1 symmetric exponent rex2-cb origin ptree-channel
+: ramp-expt
+ <{ rmp0 rmp1 expt :optional sym #t beg 0 dur #f snd #f chn #f ep #f -- r }>
+ doc" Connect RMP0 and RMP1 with an x^EXPT curve."
+ \ ;; a^x = exp(x * log(a))
+ "%s %s %s %s %s %s %s"
+ #( rmp0 rmp1 expt sym beg dur get-func-name )
+ string-format { origin }
+ dur number? if
+ dur
+ else
+ snd chn ep framples beg d-
+ then { len }
+ len 1/f { incr }
+ beg len snd chn ep samples { data }
+ rmp1 rmp0 f- { scl }
+ 0.0 { angle }
+ sym
+ rmp1 rmp0 f< && if
+ scl fnegate to scl
+ 1.0 to angle
+ len 0 ?do
+ data i
+ data i vct-ref
+ rmp1 scl angle expt f** f* f+
+ f*
+ vct-set! drop
+ angle incr f- to angle
+ loop
+ else
+ 0.0 to angle
+ len 0 ?do
+ data i
+ data i vct-ref
+ rmp0 scl angle expt f** f* f+
+ f*
+ vct-set! drop
+ angle incr f+ to angle
+ loop
+ then
+ data beg len snd chn current-edit-position origin vct->channel
;
-previous
hide
-: expc-cb { symmetric exponent -- prc; r0 r1 b d s c e self -- val }
- 7 proc-create symmetric , exponent , ( prc )
- does> { r0 r1 b d s c e self -- val }
- r0 r1 self cell+ @ ( exponent ) self @ ( symmetric ) b d s c e ramp-expt
+: expc-cb { sym expt -- prc; r0 r1 b d s c e self -- val }
+ 7 proc-create ( prc ) expt , sym ,
+ does> { r0 r1 b d s c e self -- val }
+ r0 r1 self @ ( expt ) self cell+ @ ( sym ) b d s c e ramp-expt
;
set-current
-: env-expt-channel <{ en exponent
- :optional symmetric #t beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Connects ENV's dots with x^exponent curves."
- $" %s %s %s %s %s %s" #( en exponent symmetric beg dur get-func-name ) string-format { origin }
- en symmetric exponent expc-cb beg dur snd chn edpos origin any-env-channel
+: env-expt-channel
+ <{ en ex :optional sym #t beg 0 dur #f snd #f chn #f ep #f -- r }>
+ doc" Connect ENV's dots with x^exponent curves."
+ ex 1.0 f= if
+ en beg dur snd chn ep env-channel
+ else
+ "%s %s %s %s %s %s" #( en ex sym beg dur get-func-name )
+ string-format { origin }
+ sym ex expc-cb { prc }
+ en prc beg dur snd chn ep origin any-env-channel
+ then
;
previous
@@ -879,214 +649,236 @@ previous
hide
: offc-cb { dc -- prc; y self -- val }
- 1 proc-create dc , ( prc )
- does> { y self -- val }
- self @ ( dc ) y f+
+ 1 proc-create ( prc )
+ dc ,
+ does> { y self -- val }
+ self @ ( dc ) y f+
;
set-current
-: offset-channel <{ amount :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Adds AMOUNT to each sample."
- $" %s %s %s %s" #( amount beg dur get-func-name ) string-format { origin }
- amount offc-cb beg dur snd chn edpos #t #f origin ptree-channel
+: offset-channel <{ amount :optional beg 0 dur #f snd #f chn #f edpos #f -- r }>
+ doc" Add AMOUNT to each sample."
+ "%s %s %s %s" #( amount beg dur get-func-name ) string-format { origin }
+ amount offc-cb beg dur snd chn edpos origin map-channel
;
previous
: offset-sound <{ offset :optional beg 0 dur #f snd #f -- }>
- doc" Adds OFFSET to every sample in SND."
- snd snd-snd to snd
- snd sound? if
- snd channels 0 ?do offset beg dur snd i ( chn ) #f offset-channel drop loop
- else
- 'no-such-sound #( get-func-name snd ) fth-throw
- then
+ doc" Add OFFSET to every sample in SND."
+ snd snd-snd to snd
+ snd sound? if
+ snd channels 0 ?do
+ offset beg dur snd i ( chn ) #f offset-channel drop
+ loop
+ else
+ 'no-such-sound #( "%s: %s" get-func-name snd ) fth-throw
+ then
;
\ ;;; -------- pad-sound
: pad-sound <{ beg dur :optional snd #f -- }>
- doc" Places a block of DUR zeros in every channel of SND starting at BEG."
- snd snd-snd to snd
- snd sound? if
- snd channels 0 ?do beg dur snd i ( chn ) #f pad-channel drop loop
- else
- 'no-such-sound #( get-func-name snd ) fth-throw
- then
+ doc" Place a block of DUR zeros in every \
+channel of SND starting at BEG."
+ snd snd-snd to snd
+ snd sound? if
+ snd channels 0 ?do
+ beg dur snd i ( chn ) #f pad-channel drop
+ loop
+ else
+ 'no-such-sound #( "%s: %s" get-func-name snd ) fth-throw
+ then
;
\ ;;; -------- dither-channel
hide
: dith-cb { dither -- prc; y self -- val }
- 1 proc-create dither , ( prc )
- does> { y self -- val }
- self @ ( dither ) dup mus-random swap mus-random f+ y f+
+ 1 proc-create ( prc )
+ dither ,
+ does> { y self -- val }
+ self @ ( dither ) dup mus-random swap mus-random f+ y f+
;
set-current
-: dither-channel <{ :optional amount 0.00006 beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Adds AMOUNT dither to each sample."
- $" %s %s %s %s" #( amount beg dur get-func-name ) string-format { origin }
- amount f2/ dith-cb beg dur snd chn edpos #t #f origin ptree-channel
+: dither-channel
+ <{ :optional amount 0.00006 beg 0 dur #f snd #f chn #f ep #f -- r }>
+ doc" Add AMOUNT dither to each sample."
+ "%s %s %s %s" #( amount beg dur get-func-name ) string-format { origin }
+ amount f2/ dith-cb beg dur snd chn ep origin map-channel
;
+previous
: dither-sound <{ :optional amount 0.00006 beg 0 dur #f snd #f -- }>
- doc" Adds dithering to every sample of SND."
- snd snd-snd to snd
- snd sound? if
- snd channels 0 ?do amount beg dur snd i ( chn ) #f dither-channel drop loop
- else
- 'no-such-sound #( get-func-name snd ) fth-throw
- then
+ doc" Add dithering to every sample of SND."
+ snd snd-snd to snd
+ snd sound? if
+ snd channels 0 ?do
+ amount beg dur snd i ( chn ) #f dither-channel drop
+ loop
+ else
+ 'no-such-sound #( "%s: %s" get-func-name snd ) fth-throw
+ then
;
\ ;;; -------- contrast-channel
hide
: cntr-cb { index -- prc; y self -- val }
- 1 proc-create index , ( prc )
- does> { y self -- val }
- y two-pi f* fsin self @ ( index ) f* y half-pi f* f+ fsin
+ 1 proc-create ( prc )
+ index ,
+ does> { y self -- val }
+ y two-pi f* fsin self @ ( index ) f* y half-pi f* f+ fsin
;
set-current
-: contrast-channel <{ index :optional beg 0 dur #f snd #f chn #f edpos #f -- val }>
- doc" Applies contrast enhancement to the sound."
- $" %s %s %s %s" #( index beg dur get-func-name ) string-format { origin }
- index cntr-cb beg dur snd chn edpos #f #f origin ptree-channel
+: contrast-channel <{ idx :optional beg 0 dur #f snd #f chn #f edpos #f -- r }>
+ doc" Apply contrast-enhancement to the sound."
+ "%s %s %s %s" #( idx beg dur get-func-name ) string-format { origin }
+ idx cntr-cb beg dur snd chn edpos origin map-channel
;
+previous
: contrast-sound <{ index :optional beg 0 dur #f snd #f -- }>
- doc" Applies contrast-enhancement to every channel of SND."
- snd snd-snd to snd
- snd sound? if
- snd channels 0 ?do index beg dur snd i ( chn ) #f contrast-channel drop loop
- else
- 'no-such-sound #( get-func-name snd ) fth-throw
- then
+ doc" Apply contrast-enhancement to every channel of SND."
+ snd snd-snd to snd
+ snd sound? if
+ snd channels 0 ?do
+ index beg dur snd i ( chn ) #f contrast-channel drop
+ loop
+ else
+ 'no-such-sound #( "%s: %s" get-func-name snd ) fth-throw
+ then
;
\ ;;; -------- scale-sound
: scale-sound <{ scl :optional beg 0 dur #f snd #f -- }>
- doc" Multiplies every sample in SND by SCL."
- snd snd-snd to snd
- snd sound? if
- snd channels 0 ?do scl beg dur snd i ( chn ) #f scale-channel drop loop
- else
- 'no-such-sound #( get-func-name snd ) fth-throw
- then
+ doc" Multiply every sample in SND by SCL."
+ snd snd-snd to snd
+ snd sound? if
+ snd channels 0 ?do
+ scl beg dur snd i ( chn ) #f scale-channel drop
+ loop
+ else
+ 'no-such-sound #( "%s: %s" get-func-name snd ) fth-throw
+ then
;
\ ;;; -------- normalize-sound
: normalize-sound <{ amp :optional beg 0 dur #f snd #f -- }>
- doc" Scales SND to peak amplitude AMP."
- snd snd-snd to snd
- snd sound? if
- amp 0.0 snd #t #f maxamp each fabs fmax end-each f/ { scl }
- snd channels 0 ?do scl beg dur snd i ( chn ) #f scale-channel drop loop
- else
- 'no-such-sound #( get-func-name snd ) fth-throw
- then
+ doc" Scale SND to peak amplitude AMP."
+ snd snd-snd to snd
+ snd sound? if
+ amp 0.0 snd #t #f maxamp each ( mx )
+ fabs fmax
+ end-each f/ { scl }
+ snd channels 0 ?do
+ scl beg dur snd i ( chn ) #f scale-channel drop
+ loop
+ else
+ 'no-such-sound #( "%s: %s" get-func-name snd ) fth-throw
+ then
;
\ ;;; -------- channels-equal
hide
: c-equal-cb { rd diff -- prc; y self -- f }
- 1 proc-create rd , diff , ( prc )
- does> { y self -- f }
- self @ ( rd ) read-sample y f- fabs self cell+ @ ( diff ) f>
+ 1 proc-create ( prc )
+ rd , diff ,
+ does> { y self -- f }
+ self @ ( rd ) read-sample y f- fabs self cell+ @ ( diff ) f>
;
set-current
: channels= <{ snd1 chn1 snd2 chn2 :optional allowable-difference 0.0 -- f }>
- doc" Returns #t if the two channels are the same (within diff) modulo trailing 0's."
- snd1 snd2 =
- chn1 chn2 = && if
- #t
- else
- snd1 chn1 #f maxamp { mx1 }
- snd2 chn2 #f maxamp { mx2 }
- mx1 mx2 f- fabs allowable-difference f> if
- #f
- else
- snd1 chn1 #f frames { len1 }
- snd2 chn2 #f frames { len2 }
- len1 len2 >= if
- len1
- snd1
- snd2
- chn1
- chn2
- else
- len2
- snd2
- snd1
- chn2
- chn1
- then { len s1 s2 c1 c2 }
- 0 s2 c2 1 #f make-sampler { read2 }
- read2 allowable-difference c-equal-cb 0 len s1 c1 #f #f scan-channel not
- then
- then
+ doc" Return #t if the two channels are the \
+same (within diff) modulo trailing 0's."
+ snd1 snd2 =
+ chn1 chn2 = && if
+ #t
+ else
+ snd1 chn1 #f maxamp { mx1 }
+ snd2 chn2 #f maxamp { mx2 }
+ mx1 mx2 f- fabs allowable-difference f> if
+ #f
+ else
+ snd1 chn1 #f framples { len1 }
+ snd2 chn2 #f framples { len2 }
+ len1 len2 >= if
+ len1 snd1 snd2 chn1 chn2
+ else
+ len2 snd2 snd1 chn2 chn1
+ then { len s1 s2 c1 c2 }
+ 0 s2 c2 1 #f make-sampler { read2 }
+ read2 allowable-difference c-equal-cb
+ 0 len s1 c1 #f #f scan-channel not
+ then
+ then
;
previous
-: channels-equal? <{ snd1 chn1 snd2 chn2 :optional allowable-difference 0.0 -- f }>
- doc" Returns #t if the two channels are the same (within diff)."
- snd1 chn1 #f frames snd2 chn2 #f frames <> if
- #f
- else
- snd1 chn1 snd2 chn2 allowable-difference channels=
- then
+: channels-equal? <{ s1 c1 s2 c2 :optional allowable-difference 0.0 -- f }>
+ doc" Return #t if the two channels are the same (within diff)."
+ s1 c1 #f framples s2 c2 #f framples <> if
+ #f
+ else
+ s1 c1 s2 c2 allowable-difference channels=
+ then
;
\ ;;; -------- mono->stereo, mono-files->stereo
: mono->stereo ( new-name snd1 chn1 snd2 chn2 -- snd )
- doc" Takes the two channels and combines them into a stereo sound NEW-NAME."
- { new-name snd1 chn1 snd2 chn2 }
- snd1 chn1 edit-position { old-ed1 }
- snd2 chn2 edit-position { old-ed2 }
- :file new-name :channels 2 :srate snd1 srate new-sound { ind }
- ind 0 snd1 chn1 0 #f #f swap-channels drop
- ind 1 snd2 chn2 0 #f #f swap-channels drop
- old-ed1 snd1 chn1 set-edit-position drop
- old-ed2 snd2 chn2 set-edit-position drop
- ind
+ doc" Take the two channels and combine \
+them into a stereo sound NEW-NAME."
+ { new-name snd1 chn1 snd2 chn2 }
+ snd1 chn1 edit-position { old-ed1 }
+ snd2 chn2 edit-position { old-ed2 }
+ :file new-name :channels 2 :srate snd1 srate new-sound { ind }
+ ind 0 snd1 chn1 0 #f #f swap-channels drop
+ ind 1 snd2 chn2 0 #f #f swap-channels drop
+ old-ed1 snd1 chn1 set-edit-position drop
+ old-ed2 snd2 chn2 set-edit-position drop
+ ind
;
\ "test.snd" 0 0 1 0 mono->stereo
: mono-files->stereo ( new-name chan1-name chan2-name -- snd )
- doc" Combines two mono files into the stereo file NEW-NAME."
- { new-name chan1-name chan2-name }
- chan1-name find-file to chan1-name
- chan1-name false? if 'no-such-file #( get-func-name chan1-name ) fth-throw then
- chan1-name open-sound { ind1 }
- chan2-name find-file to chan2-name
- chan2-name false? if 'no-such-file #( get-func-name chan2-name ) fth-throw then
- chan2-name open-sound { ind2 }
- new-name ind1 0 ind2 0 mono->stereo { ind3 }
- ind1 close-sound drop
- ind2 close-sound drop
- ind3
+ doc" Combine two mono files into the stereo file NEW-NAME."
+ { new-name chan1-name chan2-name }
+ chan1-name find-file to chan1-name
+ chan1-name unless
+ 'no-such-file #( "%s: %S" get-func-name chan1-name ) fth-throw
+ then
+ chan1-name open-sound { ind1 }
+ chan2-name find-file to chan2-name
+ chan2-name unless
+ 'no-such-file #( "%s: %S" get-func-name chan2-name ) fth-throw
+ then
+ chan2-name open-sound { ind2 }
+ new-name ind1 0 ind2 0 mono->stereo { ind3 }
+ ind1 close-sound drop
+ ind2 close-sound drop
+ ind3
;
\ "test.snd" "oboe.snd" "pistol.snd" mono-files->stereo
: stereo->mono ( orig-snd chan1-name chan2-name -- snd0 snd1 )
- doc" Splits a stereo sound into two mono sounds named CHAN1-NAME and CHAN2-NAME."
- { orig-snd chan1-name chan2-name }
- orig-snd 0 edit-position { old-ed0 }
- orig-snd 1 edit-position { old-ed1 }
- :file chan1-name :srate orig-snd srate new-sound { chan1 }
- :file chan2-name :srate orig-snd srate new-sound { chan2 }
- orig-snd 0 chan1 0 0 #f #f swap-channels drop
- orig-snd 1 chan2 0 0 #f #f swap-channels drop
- old-ed0 orig-snd 0 set-edit-position drop
- old-ed1 orig-snd 1 set-edit-position drop
- chan1 chan2
+ doc" Split a stereo sound into two mono sounds \
+named CHAN1-NAME and CHAN2-NAME."
+ { orig-snd chan1-name chan2-name }
+ orig-snd 0 edit-position { old-ed0 }
+ orig-snd 1 edit-position { old-ed1 }
+ :file chan1-name :srate orig-snd srate new-sound { chan1 }
+ :file chan2-name :srate orig-snd srate new-sound { chan2 }
+ orig-snd 0 chan1 0 0 #f #f swap-channels drop
+ orig-snd 1 chan2 0 0 #f #f swap-channels drop
+ old-ed0 orig-snd 0 set-edit-position drop
+ old-ed1 orig-snd 1 set-edit-position drop
+ chan1 chan2
;
\ 0 "hi1.snd" "hi2.snd" stereo->mono
@@ -1097,64 +889,74 @@ previous
hide
"empty" value reopen-empty
#() value reopen-names
-#f value reopen-menu
-16 value reopen-max-length
+#f value reopen-menu
+16 value reopen-max-length
<'> noop 0 make-proc constant extensions-noop
-: reopen-select-cb { brief-name long-name -- proc; self -- }
- 0 proc-create long-name , brief-name ,
- does> ( self -- )
- { self }
- self @ { long-name }
- self cell+ @ { brief-name }
- reopen-menu brief-name remove-from-menu drop
- long-name file-exists? if long-name open-sound drop then
+: reopen-select-cb { brief-name long-name -- prc; self -- }
+ 0 proc-create ( prc )
+ long-name , brief-name ,
+ does> ( self -- )
+ { self }
+ self @ { long-name }
+ self cell+ @ { brief-name }
+ reopen-menu brief-name remove-from-menu drop
+ long-name file-exists? if
+ long-name open-sound drop
+ then
;
: add-to-reopen-menu <{ snd -- #f }>
- snd short-file-name { brief-name }
- snd file-name { long-name }
- reopen-names brief-name array-member? unless
- reopen-names reopen-empty array-member? if
- reopen-menu reopen-empty remove-from-menu drop
- #() to reopen-names
- then
- reopen-menu brief-name brief-name long-name reopen-select-cb 0 add-to-menu drop
- reopen-names brief-name array-push to reopen-names
- reopen-names length reopen-max-length > if
- reopen-menu reopen-names array-shift remove-from-menu drop
- then
- then
- #f
+ snd short-file-name { brief-name }
+ snd file-name { long-name }
+ reopen-names brief-name array-member? if
+ #f
+ exit
+ then
+ reopen-names reopen-empty array-member? if
+ reopen-menu reopen-empty remove-from-menu drop
+ #() to reopen-names
+ then
+ reopen-menu brief-name brief-name long-name reopen-select-cb
+ 0 add-to-menu drop
+ reopen-names brief-name array-push to reopen-names
+ reopen-names length reopen-max-length > if
+ reopen-menu reopen-names array-shift remove-from-menu drop
+ then
+ #f
;
: check-reopen-menu <{ file -- }>
- file #f file-basename { brief-name }
- reopen-names brief-name array-member? if
- reopen-menu brief-name remove-from-menu drop
- reopen-names brief-name array-index { idx }
- idx 0>= if reopen-names idx array-delete! drop then
- then
- reopen-names empty? if
- reopen-menu reopen-empty extensions-noop undef add-to-menu drop
- reopen-names reopen-empty array-push to reopen-names
- then
+ file #f file-basename { brief-name }
+ reopen-names brief-name array-member? if
+ reopen-menu brief-name remove-from-menu drop
+ reopen-names brief-name array-index { idx }
+ idx 0>= if
+ reopen-names idx array-delete! drop
+ then
+ then
+ reopen-names empty? if
+ reopen-menu reopen-empty extensions-noop undef add-to-menu drop
+ reopen-names reopen-empty array-push to reopen-names
+ then
;
set-current
-#f value including-reopen-menu \ for prefs
+#f value including-reopen-menu \ for prefs
: with-reopen-menu ( -- )
- including-reopen-menu unless
- #() to reopen-names
- reopen-menu false? if "Reopen" extensions-noop add-to-main-menu to reopen-menu then
- reopen-menu reopen-empty extensions-noop 0 add-to-menu drop
- reopen-names reopen-empty array-push to reopen-names
- #t to including-reopen-menu
- close-hook <'> add-to-reopen-menu add-hook!
- open-hook <'> check-reopen-menu add-hook!
- then
+ including-reopen-menu unless
+ #() to reopen-names
+ reopen-menu false? if
+ "Reopen" extensions-noop add-to-main-menu to reopen-menu
+ then
+ reopen-menu reopen-empty extensions-noop 0 add-to-menu drop
+ reopen-names reopen-empty array-push to reopen-names
+ #t to including-reopen-menu
+ close-hook <'> add-to-reopen-menu add-hook!
+ open-hook <'> check-reopen-menu add-hook!
+ then
;
previous
@@ -1163,48 +965,55 @@ previous
hide
"empty" value buffer-empty
#() value buffer-names
-#f value buffer-menu
+#f value buffer-menu
-: buffer-select-cb ( file -- proc ; self -- )
- 0 proc-create swap ,
- does> ( self -- )
- { self }
- self @ ( file ) 0 find-sound dup sound? if select-sound then drop
+: buffer-select-cb { file -- prc ; self -- }
+ 0 proc-create ( prc )
+ file ,
+ does> { self -- }
+ self @ ( file ) 0 find-sound dup sound? if
+ select-sound
+ then drop
;
: open-buffer <{ file -- }>
- buffer-names buffer-empty array-member? if
- buffer-menu buffer-empty remove-from-menu drop
- #() to buffer-names
- then
- buffer-menu file file buffer-select-cb -1 add-to-menu drop
- buffer-names file array-push to buffer-names
+ buffer-names buffer-empty array-member? if
+ buffer-menu buffer-empty remove-from-menu drop
+ #() to buffer-names
+ then
+ buffer-menu file file buffer-select-cb -1 add-to-menu drop
+ buffer-names file array-push to buffer-names
;
: close-buffer <{ snd -- #f }>
- buffer-menu snd file-name remove-from-menu drop
- buffer-names snd file-name array-index { idx }
- idx 0>= if buffer-names idx array-delete! drop then
- buffer-names empty? if
- buffer-menu buffer-empty extensions-noop 0 add-to-menu drop
- buffer-names buffer-empty array-push to buffer-names
- then
- #f
+ buffer-menu snd file-name remove-from-menu drop
+ buffer-names snd file-name array-index { idx }
+ idx 0>= if
+ buffer-names idx array-delete! drop
+ then
+ buffer-names empty? if
+ buffer-menu buffer-empty extensions-noop 0 add-to-menu drop
+ buffer-names buffer-empty array-push to buffer-names
+ then
+ #f
;
set-current
-#f value including-buffers-menu \ for prefs
+#f value including-buffers-menu \ for prefs
: with-buffers-menu ( -- )
- including-buffers-menu unless
- #() to buffer-names
- buffer-menu false? if "Buffers" extensions-noop add-to-main-menu to buffer-menu then
- buffer-menu buffer-empty extensions-noop 0 add-to-menu drop
- buffer-names buffer-empty array-push to buffer-names
- #t to including-buffers-menu
- open-hook <'> open-buffer add-hook!
- close-hook <'> close-buffer add-hook!
- then
+ including-buffers-menu unless
+ #() to buffer-names
+ buffer-menu unless
+ "Buffers" extensions-noop
+ add-to-main-menu to buffer-menu
+ then
+ buffer-menu buffer-empty extensions-noop 0 add-to-menu drop
+ buffer-names buffer-empty array-push to buffer-names
+ #t to including-buffers-menu
+ open-hook <'> open-buffer add-hook!
+ close-hook <'> close-buffer add-hook!
+ then
;
previous
@@ -1212,46 +1021,45 @@ previous
\ moved from examp.fs to extensions.fs [ms]
hide
-: current-cursor { snd chn -- cur } 'cursor snd chn channel-property ;
-: set-current-cursor { snd chn val -- } 'cursor val snd chn set-channel-property ;
-: original-cursor { snd chn -- cur } 'original-cursor snd chn channel-property ;
-: set-original-cursor { snd chn val -- } 'original-cursor val snd chn set-channel-property ;
-
-: local-dac-func <{ data -- val }>
- sounds each { snd }
- snd channels 0 ?do
- snd i #f cursor snd i original-cursor <> if
- snd i snd i #f cursor set-current-cursor
- then
- loop
- end-each
- #f
+: current-cursor { snd chn -- cur }
+ 'cursor snd chn channel-property
+;
+
+: set-current-cursor { snd chn val -- }
+ 'cursor val snd chn set-channel-property
+;
+
+: original-cursor { snd chn -- cur }
+ 'original-cursor snd chn channel-property
+;
+
+: set-original-cursor { snd chn val -- }
+ 'original-cursor val snd chn set-channel-property
;
: local-start-playing-func <{ snd -- val }>
- snd channels 0 ?do
- snd i #f cursor { cur }
- snd i cur set-original-cursor
- snd i cur set-current-cursor
- loop
- #f
+ snd channels 0 ?do
+ snd i #f cursor { cur }
+ snd i cur set-original-cursor
+ snd i cur set-current-cursor
+ loop
+ #f
;
: local-stop-playing-func <{ snd -- val }>
- snd 0 current-cursor snd #t #f set-cursor
+ snd 0 current-cursor snd #t #f set-cursor
;
set-current
-: if-cursor-follows-play-it-stays-where-play-stopped <{ :optional enable #t -- }>
- enable if
- dac-hook <'> local-dac-func add-hook!
- start-playing-hook <'> local-start-playing-func add-hook!
- stop-playing-hook <'> local-stop-playing-func add-hook!
- else
- dac-hook <'> local-dac-func remove-hook! drop
- start-playing-hook <'> local-start-playing-func remove-hook! drop
- stop-playing-hook <'> local-stop-playing-func remove-hook! drop
- then
+: if-cursor-follows-play-it-stays-where-play-stopped <{ :optional enable #t }>
+ enable if
+ start-playing-hook <'> local-start-playing-func add-hook!
+ stop-playing-hook <'> local-stop-playing-func add-hook!
+ else
+ start-playing-hook <'> local-start-playing-func
+ remove-hook! drop
+ stop-playing-hook <'> local-stop-playing-func remove-hook! drop
+ then
;
previous
diff --git a/extensions.rb b/extensions.rb
index dd9b58c..8450bd8 100644
--- a/extensions.rb
+++ b/extensions.rb
@@ -1,11 +1,9 @@
# extensions.rb -- various generally useful Snd extensions (see extensions.scm)
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Sat Jan 03 17:30:23 CET 2004
-# Changed: Thu Mar 03 15:41:18 CET 2011
+# Created: 04/01/03 17:30:23
+# Changed: 14/12/03 17:13:44
-# Commentary:
-#
# module Compatibility
# scan_sound_chans(beg, end, snd, edpos) do |y| ... end
# map_sound_chans(beg, end, edname, snd, edpos) do |y| ... end
@@ -28,8 +26,6 @@
# forward_sample(count, snd, chn)
# backward_sample(count, snd, chn)
#
-# append_to_minibuffer(msg, snd = false)
-#
# back_or_forth_graph(count)
# forward_graph(count)
# backward_graph(count)
@@ -39,12 +35,10 @@
# back_or_forth_mark(count)
# forward_mark(count = 1, snd = false, chn = false)
# backward_mark(count = 1, snd = false, chn = false)
-# sound_data_channel2list(sd, chan)
-# sound_data2list(sd)
# vct_convolve!(r1, r2)
# old_map_channel(beg, dur, snd, chn, edpos, edname, &func)
# mus_bank(gens, amps, in1, in2)
-# oscil_bank(amps, gens, in1, in2)
+# old_oscil_bank(amps, gens, in1, in2)
# old_formant_bank(amps, gens, in1)
# vct2samples(samp, samps, data, snd, chn)
# samples2vct(samp, samps, snd, chn, nv, epos)
@@ -52,7 +46,6 @@
# scale_sound_to(norm, beg, dur, snd, chn)
# emacs_style_save_as
# set_emacs_style_save_as(val)
-# mixer_scale(mx, scl, nmx)
# make_iir_low_pass_1(fc)
# make_iir_high_pass_1(fc)
# sine_bank(amps, phases, size)
@@ -103,16 +96,13 @@
# clear_selection
# make_selection(beg, len, snd, chn)
# delete_selection_and_smooth()
-# eval_over_selection(&func)
#
-# yes_or_no?(question, action_if_yes, action_if_no, snd)
-#
# mix_channel(fdata, beg, dur, snd, chn, edpos)
# insert_channel(fdata, beg, dur, snd, chn, edpos)
# redo_channel(edits, snd, chn)
# undo_channel(edits, snd, chn)
#
-# any_env_channel(env, beg, dur, snd, chn, edpos, origin) do |r0, r1, b, d, s, c, e| ... end
+# any_env_channel(en, b, d, s, c, ep, ori) do |r0, r1, b, d, s, c, e| ... end
# sine_ramp(rmp0, rmp1, beg, dur, snd, chn, edpos)
# sine_env_channel(env, beg, dur, snd, chn, edpos)
# blackman4_ramp(rmp0, rmp1, beg, dur, snd, chn, edpos)
@@ -122,8 +112,12 @@
# ramp_expt(rmp0, rmp1, exponent, symmetric, beg, dur, snd, chn, edpos)
# env_expt_channel(env, exponent, symmetric, beg, dur, snd, chn, edpos)
# offset_channel(amount, beg, dur, snd, chn, edpos)
+# offset_sound(amount, beg, dur, snd)
+# pad_sound(beg, dur, snd)
# dither_channel(amnt, beg, dur, snd, chn, edpos)
+# dither_sound(amnt, beg, dur, snd)
# contrast_channel(index, beg, dur, snd, chn, edpos)
+# contrast_sound(index, beg, dur, snd)
# channels_eql?(snd1, chn1, snd2, chn2, allowable_difference)
# channels_equal?(snd1, chn1, snd2, chn2, allowable_difference)
# mono2stereo(new_name, snd1, chn1, snd2, chn2)
@@ -135,8 +129,6 @@
# Comments are mostly taken from extensions.scm.
-# Code:
-
require "hooks"
include Math
@@ -145,36 +137,44 @@ module Compatibility
# Snd-4 compatibility stuff
#
add_help(:scan_sound_chans,
- "scan_sound_chans([beg=0, [end=flase, [snd=false, [edpos=false]]]], &proc) \
-applies scan_chan with proc to each channel in a sound")
+ "scan_sound_chans(beg=0, end=flase, snd=false, edpos=false, &proc) \
+Applies scan_chan with PROC to each channel in a sound.")
def scan_sound_chans(beg = 0, fin = false, snd = false, edpos = false, &body)
# Proc#arity returns -1 instead of 1 on older versions
if body and body.arity.abs == 1
val = nil
- if c = (0...chans(snd)).detect do |chn| val = scan_chan(body, beg, fin, snd, chn, edpos) end
+ c = (0...chans(snd)).detect do |chn|
+ val = scan_chan(body, beg, fin, snd, chn, edpos)
+ end
+ if c
val += [Snd.snd(snd), c]
else
nil
end
else
- Snd.raise(:bad_arity, "scan_sound_chans([beg, [end, [snd, [edpos]]]]) do |y| ... end")
+ Snd.raise(:bad_arity,
+ "scan_sound_chans(beg, end, snd, edpos) do |y| ... end")
end
end
add_help(:map_sound_chans,
- "map_sound_chans([beg=0, [end=flase, [snd=false, [edpos=false]]]], &proc) \
-applies map_chan with proc to each channel in a sound")
- def map_sound_chans(beg = 0, fin = false, edname = false, snd = false, edpos = false, &body)
+ "map_sound_chans(beg=0, end=flase, snd=false, edpos=false, &proc) \
+Applies map_chan with PROC to each channel in a sound.")
+ def map_sound_chans(beg = 0, fin = false, edname = false,
+ snd = false, edpos = false, &body)
if body and body.arity.abs == 1
- channels(snd).times do |chn| map_chan(body, beg, fin, edname, snd, chn, edpos) end
+ channels(snd).times do |chn|
+ map_chan(body, beg, fin, edname, snd, chn, edpos)
+ end
else
- Snd.raise(:bad_arity, "map_sound_chans([beg, [end, [ename, [snd, [edpos]]]]]) do |y| ... end")
+ Snd.raise(:bad_arity,
+ "map_sound_chans(beg, end, ename, snd, edpos) do |y| ... end")
end
end
add_help(:scan_all_chans,
- "scan_all_chans([beg=0, [end=flase, [edpos=false]]], &proc) \
-applies scan_chan with proc to all channels (all sounds)")
+ "scan_all_chans(beg=0, end=flase, edpos=false, &proc) \
+Applies scan_chan with PROC to all channels (all sounds).")
def scan_all_chans(beg = 0, fin = false, edpos = false, &body)
if body and body.arity.abs == 1
catch(:done) do
@@ -188,13 +188,14 @@ applies scan_chan with proc to all channels (all sounds)")
false
end
else
- Snd.raise(:bad_arity, "scan_all_chans([beg, [end, [edpos]]]) do |y| ... end")
+ Snd.raise(:bad_arity,
+ "scan_all_chans(beg, end, edpos) do |y| ... end")
end
end
add_help(:map_all_chans,
- "map_all_chans([beg=0, [end=flase, [edpos=false]]], &proc) \
-applies map_chan with proc to all channels (all sounds)")
+ "map_all_chans(beg=0, end=flase, edpos=false, &proc) \
+Applies map_chan with proc to all channels (all sounds).")
def map_all_chans(beg = 0, fin = false, edname = false, edpos = false, &body)
if body and body.arity.abs == 1
Snd.sounds.each do |snd|
@@ -203,13 +204,14 @@ applies map_chan with proc to all channels (all sounds)")
end
end
else
- Snd.raise(:bad_arity, "map_all_chans([beg, [end, [ename, [edpos]]]]) do |y| ... end")
+ Snd.raise(:bad_arity,
+ "map_all_chans(beg, end, ename, edpos) do |y| ... end")
end
end
add_help(:scan_chan,
- "scan_chans([beg=0, [end=flase, [edpos=false]]], &proc) \
-applies scan_chan with proc to all channels sharing current sound's sync" )
+ "scan_chans(beg=0, end=flase, edpos=false, &proc) \
+Applies scan_chan with PROC to all channels sharing current sound's sync.")
def scan_chans(beg = 0, fin = false, edpos = false, &body)
if body and body.arity.abs == 1
current_sync = sync(selected_sound)
@@ -226,13 +228,14 @@ applies scan_chan with proc to all channels sharing current sound's sync" )
false
end
else
- Snd.raise(:bad_arity, "scan_chans([beg, [end, [edpos]]]) do |y| ... end")
+ Snd.raise(:bad_arity,
+ "scan_chans(beg, end, edpos) do |y| ... end")
end
end
add_help(:map_chan,
- "map_chans([beg=0, [end=false, [edpos=false]]], &proc) \
-applies map_chan with proc to all channels sharing current sound's sync" )
+ "map_chans(beg=0, end=false, edpos=false, &proc) \
+Applies map_chan with PROC to all channels sharing current sound's sync.")
def map_chans(beg = 0, fin = false, edname = false, edpos = false, &body)
if body and body.arity.abs == 1
current_sync = sync(selected_sound)
@@ -244,21 +247,24 @@ applies map_chan with proc to all channels sharing current sound's sync" )
end
end
else
- Snd.raise(:bad_arity, "map_chans([beg, [end, [ename, [edpos]]]]) do |y| ... end")
+ Snd.raise(:bad_arity,
+ "map_chans(beg, end, ename, edpos) do |y| ... end")
end
end
add_help(:scan_across_all_chans,
- "scan_across_all_chans([beg=0, [end=flase, [snd=false, [edpos=false]]]], &proc) \
-applies map_chan with proc to all channels in parallel" )
+ "scan_across_all_chans(beg=0, end=flase, \
+snd=false, edpos=false, &proc) \
+Applies map_chan with PROC to all channels in parallel.")
# body.call(data, chan_num)
- def scan_across_all_chans(beg = 0, fin = false, snd = false, edpos = false, &body)
+ def scan_across_all_chans(beg = 0, fin = false,
+ snd = false, edpos = false, &body)
chans = all_chans
chan_num = chans.first.length
maxlen = 0
Snd.sounds.each do |s|
channels(s).times do |chn|
- maxlen = [maxlen, frames(s, chn)].max
+ maxlen = [maxlen, framples(s, chn)].max
end
end
len = integer?(fin) ? ([fin, maxlen].min - beg) : (maxlen - beg)
@@ -268,7 +274,9 @@ applies map_chan with proc to all channels in parallel" )
end
catch(:done) do
len.times do |i|
- data.map_with_index! do |d, chn| next_sample(fds[chn]) end
+ data.map_with_index! do |d, chn|
+ next_sample(fds[chn])
+ end
if newdata = body.call(data, chan_num)
throw(:done, [newdata, i + beg])
end
@@ -277,16 +285,17 @@ applies map_chan with proc to all channels in parallel" )
end
add_help(:map_across_all_chans,
- "map_across_all_chans([beg=0, [end=flase, [edname=false, \
-[snd=false, [edpos=false]]]]], &proc) \
-applies map_chan with proc to all channels in parallel" )
- def map_across_all_chans(beg = 0, fin = false, edname = false, snd = false, edpos = false, &body)
+ "map_across_all_chans(beg=0, end=flase, edname=false, \
+snd=false, edpos=false, &proc) \
+Applies map_chan with PROC to all channels in parallel.")
+ def map_across_all_chans(beg = 0, fin = false, edname = false,
+ snd = false, edpos = false, &body)
snds, chans = all_chans
chan_num = snds.length
maxlen = 0
Snd.sounds.each do |sd|
channels(sd).times do |chn|
- maxlen = [maxlen, frames(sd, chn)].max
+ maxlen = [maxlen, framples(sd, chn)].max
end
end
len = integer?(fin) ? ([fin, maxlen].min - beg) : (maxlen - beg)
@@ -302,9 +311,13 @@ applies map_chan with proc to all channels in parallel" )
end
outsamp = 0
len.times do |i|
- data.map_with_index! do |d, chn| next_sample(fds[chn]) end
+ data.map_with_index! do |d, chn|
+ next_sample(fds[chn])
+ end
if (newdata = body.call(data, chan_num))
- newdata.each_with_index do |dat, chn| out_any(outsamp, dat, 0, outgs[chn]) end
+ newdata.each_with_index do |dat, chn|
+ out_any(outsamp, dat, 0, outgs[chn])
+ end
outsamp += 1
end
end
@@ -323,11 +336,11 @@ applies map_chan with proc to all channels in parallel" )
# Snd-4 external program support stuff
#
add_help(:selection_to_temp,
- "selection_to_temp([type=Mus_next, [format=Mus_out_format]]) \
-writes selection data as (multichannel) file (for external program)")
+ "selection_to_temp(type=Mus_next, format=Mus_out_format) \
+Writes selection data as (multichannel) file (for external program).")
def selection_to_temp(type = Mus_next, format = Mus_out_format)
data = [snd_tempnam]
- save_selection(data.first, type, format)
+ save_selection(data.first, 44100, format, type)
data
end
@@ -342,46 +355,52 @@ writes selection data as (multichannel) file (for external program)")
end
add_help(:sound_to_temp,
- "sound_to_temp([type=Mus_next, [format=Mus_out_format, [edpos=false]]]) \
-writes sound data as (multichannel) file (for external program)")
+ "sound_to_temp(type=Mus_next, format=Mus_out_format, edpos=false) \
+Writes sound data as (multichannel) file (for external program).")
def sound_to_temp(type = Mus_next, format = Mus_out_format, edpos = false)
cursnd = selected_sound
cursync = sync(cursnd)
if cursync.zero? or syncd_sounds(cursync) == 1
data = [snd_tempnam]
- save_sound_as(data.first, selected_sound, type, format, :edit_position, edpos)
+ save_sound_as(data.first, selected_sound, :header_type, type, :sample_type, format,
+ :edit_position, edpos)
data
else
- Snd.raise(:snd_error, "re-implemented sound-to-temp doesn't handle sync bit correctly yet.")
+ Snd.raise(:snd_error,
+ "re-implemented sound-to-temp doesn't \
+handle sync bit correctly yet.")
end
end
add_help(:selection_to_temps,
- "selection_to_temps([type=Mus_next, [format=Mus_out_format]]) \
-writes selection data as mono files (for external program)")
+ "selection_to_temps(type=Mus_next, format=Mus_out_format) \
+Writes selection data as mono files (for external program).")
def selection_to_temps(type = Mus_next, format = Mus_out_format)
data = make_array(selection_chans) do |chn|
outname = snd_tempnam
- save_selection(outname, type, format, :channel, chn)
+ save_selection(outname, 44100, format, type, :channel, chn)
outname
end
data
end
add_help(:sound_to_temps,
- "sound_to_temps([type=Mus_next, [format=Mus_out_format, [edpos=false]]]) \
-writes sound data as mono files (for external program)")
+ "sound_to_temps(type=Mus_next, format=Mus_out_format, edpos=false) \
+Writes sound data as mono files (for external program).")
def sound_to_temps(type = Mus_next, format = Mus_out_format, edpos = false)
cursnd = selected_sound
cursync = sync(cursnd)
if cursync.zero? or syncd_sounds(cursync) == 1
make_array(channels(cursnd)) do |chn|
outname = snd_tempnam
- save_sound_as(outname, selected_sound, type, format, :channel, chn, :edit_position, edpos)
+ save_sound_as(outname, selected_sound, :header_type, type, :sample_type, format,
+ :channel, chn, :edit_position, edpos)
outname
end
else
- Snd.raise(:snd_error, "re-implemented sound-to-temps doesn't handle sync bit correctly yet.")
+ Snd.raise(:snd_error,
+ "re-implemented sound-to-temps doesn't \
+handle sync bit correctly yet.")
end
end
@@ -390,13 +409,13 @@ writes sound data as mono files (for external program)")
case filenames
when String
(data or []).each do |temp_file|
- if File.exists?(temp_file) and temp_file != filenames
+ if File.exist?(temp_file) and temp_file != filenames
File.unlink(temp_file)
end
end
when Array
(data or []).each_with_index do |temp_file, i|
- if File.exists?(temp_file) and temp_file != filenames[i]
+ if File.exist?(temp_file) and temp_file != filenames[i]
File.unlink(temp_file)
end
end
@@ -404,39 +423,41 @@ writes sound data as mono files (for external program)")
end
add_help(:temp_to_sound,
- "temp_to_sound(data, filename, [origin=false]) \
-reads (multichannel) file as new sound data (from external program)")
+ "temp_to_sound(data, filename, origin=false) \
+Reads (multichannel) file as new sound data (from external program).")
def temp_to_sound(data, filename, origin = false)
cursnd = selected_sound
delete_temp_data_files(data, filename)
channels(cursnd).times do |chn|
- set_samples(0, mus_sound_frames(filename), filename, cursnd, chn, true, origin, chn)
+ set_samples(0, mus_sound_framples(filename), filename,
+ cursnd, chn, true, origin, chn)
end
end
add_help(:temps_to_sound,
- "temps_to_sound(data, filenames, [origin=false]) \
-reads mono files as new sound data (from external program)")
+ "temps_to_sound(data, filenames, origin=false) \
+Reads mono files as new sound data (from external program).")
def temps_to_sound(data, filenames, origin = false)
cursnd = selected_sound
delete_temp_data_files(data, filenames)
channels(cursnd).times do |chn|
- len = mus_sound_frames(filenames[chn])
+ len = mus_sound_framples(filenames[chn])
set_samples(0, len, filenames[chn], cursnd, chn, true, origin, chn)
end
end
add_help(:temp_to_selection,
- "temp_to_selection(data, filename, [origin=false]) \
-sets selection from (multichannel) file (from external program)")
+ "temp_to_selection(data, filename, origin=false) \
+Sets selection from (multichannel) file (from external program).")
def temp_to_selection(data, filename, origin = false)
delete_temp_data_files(data, filename)
chan = 0
- len = mus_sound_frames(filename)
+ len = mus_sound_framples(filename)
Snd.sounds.each do |snd|
channels(snd).times do |chn|
if selection_member?(snd, chn)
- set_samples(selection_position(snd, chn), len, filename, snd, chn, true, origin, chan)
+ set_samples(selection_position(snd, chn), len, filename,
+ snd, chn, true, origin, chan)
chan += 1
end
end
@@ -444,16 +465,17 @@ sets selection from (multichannel) file (from external program)")
end
add_help(:temps_to_selection,
- "temps_to_selection(data, filenames, [origin=false]) \
-sets selection from mono files (from external program)")
+ "temps_to_selection(data, filenames, origin=false) \
+Sets selection from mono files (from external program).")
def temps_to_selection(data, filenames, origin = false)
delete_temp_data_files(data, filenames)
chan = 0
Snd.sounds.each do |snd|
channels(snd).times do |chn|
if selection_member?(snd, chn)
- len = mus_sound_frames(filenames[chan])
- set_samples(selection_position(snd, chn), len, filenames[chan], snd, chn, true, origin)
+ len = mus_sound_framples(filenames[chan])
+ set_samples(selection_position(snd, chn), len, filenames[chan],
+ snd, chn, true, origin)
chan += 1
end
end
@@ -471,21 +493,6 @@ sets selection from mono files (from external program)")
end
#
- # Snd-6 compatibility stuff
- #
- def append_to_minibuffer(msg, snd = false)
- if sound?(snd) and (not provided? :snd_nogui)
- minibuffer = (sound_widgets(snd) and sound_widgets(snd)[3])
- text = (minibuffer and widget_text(minibuffer))
- if string?(text)
- set_widget_text(minibuffer, text + msg)
- else
- report_in_minibuffer(msg, snd)
- end
- end
- end
-
- #
# Snd-7 compatibility stuff
#
def back_or_forth_graph(count)
@@ -527,12 +534,16 @@ sets selection from mono files (from external program)")
set_cursor(mix_position(mx.first), snd, chn)
mx.first
else
- sorted_mx = mx.sort do |a, b| mix_position(a) <=> mix_position(b) end
+ sorted_mx = mx.sort do |a, b|
+ mix_position(a) <=> mix_position(b)
+ end
pos = cursor(snd, chn)
curpos = count > 0 ? -1 : 0
if pos >= mix_position(sorted_mx.first)
sorted_mx.each do |m|
- if (count > 0 and pos < mix_position(m)) or (count < 0 and pos <= mix_position(m))
+ if (count > 0 and
+ pos < mix_position(m)) or
+ (count < 0 and pos <= mix_position(m))
break
else
curpos += 1
@@ -563,12 +574,16 @@ sets selection from mono files (from external program)")
set_cursor(mark_sample(mk.first), snd, chn)
mk.first
else
- sorted_mk = mk.sort do |a, b| mark_sample(a) <=> mark_sample(b) end
+ sorted_mk = mk.sort do |a, b|
+ mark_sample(a) <=> mark_sample(b)
+ end
pos = cursor(snd, chn)
curpos = count > 0 ? -1 : 0
if pos >= mark_sample(sorted_mk.first)
sorted_mk.each do |m|
- if (count > 0 and pos < mark_sample(m)) or (count < 0 and pos <= mark_sample(m))
+ if (count > 0 and
+ pos < mark_sample(m)) or
+ (count < 0 and pos <= mark_sample(m))
break
else
curpos += 1
@@ -591,35 +606,21 @@ sets selection from mono files (from external program)")
def backward_mark(count = 1, snd = false, chn = false)
back_or_forth_mark(-count, Snd.snd(snd), Snd.chn(chn))
end
-
- def sound_data_channel2list(sd, chan)
- v = make_vct(sound_data_length(sd))
- sound_data2vct(sd, chan, v)
- vct2list(v)
- end
-
- add_help(:sound_data2list,
- "sound_data2list(sd) \
-turns a sound-data object's data into a list of lists (one for each channel)")
- def sound_data2list(sd)
- make_array(sound_data_chans(sd)) do |chn|
- sound_data_channel2list(sd, chn)
- end
- end
def vct_convolve!(r1, r2)
convolution(r1, r2, r1.length)
end
def old_map_channel(beg = 0, dur = false,
- snd = false, chn = false, edpos = false, edname = false, &func)
- map_channel(lambda { |y|
+ snd = false, chn = false,
+ edpos = false, edname = false, &func)
+ map_channel(lambda do |y|
if array?(val = func.call(y))
vector2vct(val)
else
val
end
- }, beg, dur, snd, chn, edpos, edname)
+ end, beg, dur, snd, chn, edpos, edname)
end
def mus_bank(gens, amps, in1 = false, in2 = false)
@@ -654,7 +655,7 @@ turns a sound-data object's data into a list of lists (one for each channel)")
sum
end
- def oscil_bank(amps, gens, in1 = false, in2 = false)
+ def old_oscil_bank(amps, gens, in1 = false, in2 = false)
amps = case amps
when Array
amps.to_vct
@@ -694,7 +695,8 @@ turns a sound-data object's data into a list of lists (one for each channel)")
vct2channel(data, samp, samps, snd, chn)
end
- def samples2vct(samp, samps, snd = false, chn = false, nv = false, epos = false)
+ def samples2vct(samp, samps, snd = false, chn = false,
+ nv = false, epos = false)
if nv
vct_subseq(channel2vct(samp, samps, snd, chn, epos), 0, samps, nv)
else
@@ -702,11 +704,14 @@ turns a sound-data object's data into a list of lists (one for each channel)")
end
end
- def scale_sound_by(scl, beg = false, dur = false, snd = false, chn = false, edpos = false)
+ def scale_sound_by(scl, beg = false, dur = false,
+ snd = false, chn = false, edpos = false)
if integer?(chn)
scale_channel(scl, beg, dur, snd, chn, edpos)
else
- channels(snd).times do |c| scale_channel(scl, beg, dur, snd, c) end
+ channels(snd).times do |c|
+ scale_channel(scl, beg, dur, snd, c)
+ end
end
end
@@ -719,18 +724,20 @@ turns a sound-data object's data into a list of lists (one for each channel)")
else
mx = maxamp(snd, true).max
if mx.nonzero? and mx != norm
- channels(snd).times do |c| scale_channel(norm / mx, beg, dur, snd, c) end
+ channels(snd).times do |c|
+ scale_channel(norm / mx, beg, dur, snd, c)
+ end
end
end
end
-
+ Emacs_hookname = "after-save-as-hook-replace-sound"
def emacs_style_save_as
- $after_save_as_hook.member?("after-save-as-hook-replace-sound")
+ $after_save_as_hook.member?(Emacs_hookname)
end
def set_emacs_style_save_as(val = true)
if val and (not emacs_style_save_as())
- $after_save_as_hook.add_hook!("after-save-as-hook-replace-sound") do |snd, fname, from_dialog|
+ $after_save_as_hook.add_hook!(Emacs_hookname) do |snd, fname, from_dialog|
if from_dialog
revert_sound(snd)
close_sound(snd)
@@ -738,11 +745,10 @@ turns a sound-data object's data into a list of lists (one for each channel)")
end
end
else
- $after_save_as_hook.remove_hook!("after-save-as-hook-replace-sound")
+ $after_save_as_hook.remove_hook!(Emacs_hookname)
end
end
- alias mixer_scale mixer_multiply
alias mus_error_to_string mus_error_type2string
def make_iir_low_pass_1(fc)
@@ -777,14 +783,18 @@ end
include Compatibility
module Extensions
- add_help(:remove_channel_property, "remove_channel_property(key, snd) deletes key-value pair")
+ add_help(:remove_channel_property,
+ "remove_channel_property(key, snd) \
+Deletes key-value pair.")
def remove_channel_property(key, snd = false, chn = false)
array?(props = channel_properties(snd, chn)) and
array?(item = props.assoc(key)) and
props.delete(item)
end
- add_help(:remove_sound_property, "remove_sound_property(key, snd) deletes key-value pair")
+ add_help(:remove_sound_property,
+ "remove_sound_property(key, snd) \
+Deletes key-value pair.")
def remove_sound_property(key, snd = false)
array?(props = sound_properties(snd)) and
array?(item = props.assoc(key)) and
@@ -852,37 +862,41 @@ module Extensions
end
# Used in remember_all_sound_properties and remember_sound_state
- $sound_funcs = [:sync, :with_tracking_cursor, :selected_channel, :show_controls, :read_only,
- :contrast_control?, :expand_control?, :reverb_control?, :filter_control?,
- :amp_control, :amp_control_bounds,
- :contrast_control, :contrast_control_amp, :contrast_control_bounds,
- :expand_control, :expand_control_bounds, :expand_control_hop,
- :expand_control_jitter, :expand_control_length, :expand_control_ramp,
- :filter_control_envelope, :filter_control_in_dB, :filter_control_in_hz,
- :filter_control_order,
- :reverb_control_decay, :reverb_control_feedback, :reverb_control_length,
- :reverb_control_length_bounds, :reverb_control_lowpass, :reverb_control_scale,
- :reverb_control_scale_bounds,
- :speed_control, :speed_control_bounds, :speed_control_style, :speed_control_tones]
- # transform_type: #<transform Xxx> transform2integer --> save/load --> integer2transform
- $channel_funcs = [:time_graph?, :transform_graph?, :lisp_graph?, :x_bounds, :y_bounds,
- :cursor, :cursor_size, :cursor_style, :show_marks, :show_y_zero, :show_grid,
- :wavo_hop, :wavo_trace, :max_transform_peaks, :show_transform_peaks,
- :fft_log_frequency, :fft_log_magnitude, :with_verbose_cursor, :zero_pad,
- :wavelet_type, :min_dB, :transform_size, :transform_graph_type,
- :time_graph_type, :fft_window, :transform_type, :transform_normalization,
- :time_graph_style, :show_mix_waveforms, :dot_size,
- :x_axis_style, :show_axes, :graphs_horizontal, :lisp_graph_style,
- :transform_graph_style, :grid_density, :tracking_cursor_style]
+ $sound_funcs = [:sync, :with_tracking_cursor, :selected_channel,
+ :show_controls, :read_only, :contrast_control?, :expand_control?,
+ :reverb_control?, :filter_control?, :amp_control, :amp_control_bounds,
+ :contrast_control, :contrast_control_amp, :contrast_control_bounds,
+ :expand_control, :expand_control_bounds, :expand_control_hop,
+ :expand_control_jitter, :expand_control_length, :expand_control_ramp,
+ :filter_control_envelope, :filter_control_in_dB, :filter_control_in_hz,
+ :filter_control_order, :reverb_control_decay, :reverb_control_feedback,
+ :reverb_control_length, :reverb_control_length_bounds,
+ :reverb_control_lowpass, :reverb_control_scale,
+ :reverb_control_scale_bounds, :speed_control, :speed_control_bounds,
+ :speed_control_style, :speed_control_tones]
+ # transform_type: #<transform Xxx> transform2integer -->
+ # save/load --> integer2transform
+ $channel_funcs = [:time_graph?, :transform_graph?, :lisp_graph?, :x_bounds,
+ :y_bounds, :cursor, :cursor_size, :cursor_style, :show_marks, :show_y_zero,
+ :show_grid, :wavo_hop, :wavo_trace, :max_transform_peaks,
+ :show_transform_peaks, :fft_log_frequency, :fft_log_magnitude,
+ :with_verbose_cursor, :zero_pad, :wavelet_type, :min_dB, :transform_size,
+ :transform_graph_type, :time_graph_type, :fft_window, :transform_type,
+ :transform_normalization, :time_graph_style, :show_mix_waveforms,
+ :dot_size, :x_axis_style, :show_axes, :graphs_horizontal,
+ :lisp_graph_style, :transform_graph_style, :grid_density,
+ :tracking_cursor_style]
# [ms] Based on the idea of remember_sound_state() below, here is
# another approach, using a database file.
#
# remember_all_sound_properties() in ~/.snd-ruby.rb installs the hooks
# default database is ~/.snd-properties.db
- # default tmp_snd_p is false (discarding `.*0000_00.snd' and `.*.rev.*' filenames)
+ # default tmp_snd_p is false
+ # (discarding `.*0000_00.snd' and `.*.rev.*' filenames)
- def remember_all_sound_properties(database = ENV['HOME'] + "/.snd-properties", tmp_snd_p = false)
+ def remember_all_sound_properties(database = ENV['HOME'] + "/.snd-properties",
+ tmp_snd_p = false)
rsp = Remember_sound_properties.new(database)
unless $after_open_hook.member?("save-property-hook")
$after_open_hook.add_hook!("save-property-hook") do |snd|
@@ -932,7 +946,8 @@ module Extensions
# end
# $close_hook.add_hook!(\"save-property-hook\") do |snd|
# # discarding `.*0000_00.snd' and `.*.rev.*' filenames
-# if tmp_snd_p or (not file_name(snd) =~ /(.+\\d+_\\d+\\.snd$)|(.*\\.rev.*$)/)
+# if tmp_snd_p or
+# (not file_name(snd) =~ /(.+\\d+_\\d+\\.snd$)|(.*\\.rev.*$)/)
# rsp.save(snd)
# end
# end
@@ -977,7 +992,9 @@ module Extensions
def load(snd)
snd_name = file_name(snd)
with_db do |db|
- Snd.catch do eval((db[snd_name] or "")) end
+ Snd.catch do
+ eval((db[snd_name] or ""))
+ end
end
if file_write_date(snd_name) == sound_property(:current_file_time, snd)
@sound_funcs.each do |prop|
@@ -1025,24 +1042,31 @@ module Extensions
end
props = (sound_properties(snd) or [])
if reject = sound_property(:save_state_ignore, snd)
- props.reject! do |k, v| reject.member?(k) end
+ props.reject! do |k, v|
+ reject.member?(k)
+ end
end
res = format("let(find_sound(%s)) do |snd_s|\n", snd_name.inspect)
res += format(" set_sound_properties(%s, snd_s)\n", props.inspect)
channels(snd).times do |chn|
@channel_funcs.each do |prop|
if prop == :transform_type
- set_channel_property(prop, transform2integer(snd_func(prop, snd, chn)), snd, chn)
+ set_channel_property(prop,
+ transform2integer(snd_func(prop, snd, chn)),
+ snd, chn)
else
set_channel_property(prop, snd_func(prop, snd, chn), snd, chn)
end
end
props = (channel_properties(snd, chn) or [])
if reject = channel_property(:save_state_ignore, snd, chn)
- props.reject! do |k, v| reject.member?(k) end
+ props.reject! do |k, v|
+ reject.member?(k)
+ end
end
res += format(" if channels(snd_s) > %d\n", chn)
- res += format(" set_channel_properties(%s, snd_s, %d)\n", props.inspect, chn)
+ res += format(" set_channel_properties(%s, snd_s, %d)\n",
+ props.inspect, chn)
res += " end\n"
end
res += "end\n"
@@ -1092,7 +1116,9 @@ module Extensions
end
def remove_comment(comm, snd = selected_sound(), chn = selected_channel())
- (channel_property(:comments, snd, chn) or []).delete_if do |samp, text| text == comm end
+ (channel_property(:comments, snd, chn) or []).delete_if do |samp, text|
+ text == comm
+ end
end
def show_comments(snd, chn)
@@ -1101,12 +1127,16 @@ module Extensions
if samp.between?(left_sample(snd, chn), right_sample(snd, chn))
xpos = x2position(samp / srate(snd).to_f, snd, chn)
ypos = y2position(sample(samp), snd, chn)
- draw_line(xpos, 35, xpos, ypos - 4, snd, chn)
- draw_string(text, xpos - width / 2, 18, snd, chn)
+ cr = make_cairo(channel_widgets(snd, chn)[0])
+ draw_line(xpos, 35, xpos, ypos - 4, snd, chn, Copy_context, cr)
+ draw_string(text, xpos - width / 2, 18, snd, chn, Copy_context, cr)
+ free_cairo(cr)
end
end
end
- # $after_graph_hook.add_hook!("show-comments") do |snd, chn| show_comments(snd, chn) end
+ # $after_graph_hook.add_hook!("show-comments") do |snd, chn|
+ # show_comments(snd, chn)
+ # end
# Have we marks? Similar to selections?().
def marks?(more_than_one = true)
@@ -1122,10 +1152,12 @@ module Extensions
end
add_help(:all_chans,
- "all_chans() \
--> two parallel lists, the first snd indices, the second channel numbers. \
-If we have two sounds open (indices 0 and 1 for example), and the second has two channels, \
-all_chans returns [[0, 1, 1], [0, 0, 1]]")
+ "all_chans() \
+Returns two parallel lists, the first snd indices, \
+the second channel numbers. \
+If we have two sounds open (indices 0 and 1 for example), \
+and the second has two channels, \
+all_chans returns [[0, 1, 1], [0, 0, 1]].")
def all_chans
sndlist = []
chnlist = []
@@ -1153,8 +1185,9 @@ all_chans returns [[0, 1, 1], [0, 0, 1]]")
end
add_help(:normalized_mix,
- "normalized_mix(filename, beg, in_chan, snd, chn) \
-is like mix but the mix result has same peak amp as unmixed snd/chn (returns scaler)")
+ "normalized_mix(filename, beg, in_chan, snd, chn) \
+Is like mix but the mix result has same peak amp \
+as unmixed snd/chn (returns scaler).")
def normalized_mix(fname, beg = 0, in_chan = 0, snd = false, chn = false)
orig_maxamp = maxamp(snd, chn)
mix(fname, beg, in_chan, snd, chn)
@@ -1172,60 +1205,63 @@ is like mix but the mix result has same peak amp as unmixed snd/chn (returns sca
end
add_help(:enveloped_mix,
- "enveloped_mix(filename, beg, env) \
-mixes filename starting at beg with amplitude envelope env. \
+ "enveloped_mix(filename, beg, env) \
+Mixes FILENAME starting at BEG with amplitude envelope ENV: \
enveloped_mix(\"pistol.snd\", 0, [0, 0, 1, 1, 2, 0])")
def enveloped_mix(fname, beg, env, del_tmp = true)
- len = mus_sound_frames(fname)
- if string?(tmp_name = temp_dir()) and tmp_name.length > 0
- tmp_name += "/tmp.snd"
- else
- tmp_name = "tmp.snd"
- end
- tmpfil = mus_sound_open_output(tmp_name, 22050, 1, Mus_lshort, Mus_next, "")
- mx = make_mixer(1, 1.0)
- mus_sound_close_output(tmpfil, 0)
- mus_mix(tmp_name, fname, 0, len, 0, mx, [[make_env(:envelope, env, :length, len)]])
- mix(tmp_name, beg)
- File.unlink(tmp_name) if del_tmp
+ len = framples(fname)
+ amp_env = make_env(env, :length, len)
+ rd = make_readin(fname)
+ map_channel(lambda do |y|
+ y + env(amp_env) * readin(rd)
+ end, beg, len)
end
# enveloped_mix("pistol.snd", 0, [0, 0, 1, 1, 2, 0])
add_help(:for_each_sound_file,
"for_each_sound_file(*dir_args) do |file| ... end \
-applies body to each sound file in dir")
+Applies body to each sound file in dir.")
add_help(:map_sound_files,
"map_sound_files(*dir_array) do |file| ... end \
-applies body to each sound file in dir")
+Applies body to each sound file in dir.")
add_help(:each_sound_file,
"each_sound_file(*dir_args) do |file| ... end \
-applies body to each sound file in dir")
+Applies body to each sound file in dir.")
def each_sound_file(*args, &func)
- if args.empty? then args.push(Dir.pwd) end
+ if args.empty?
+ args.push(Dir.pwd)
+ end
args.map do |dir|
- if File.exists?(dir)
- sound_files_in_directory(dir).each do |f| func.call(dir + "/" + f) end
+ if File.exist?(dir)
+ sound_files_in_directory(dir).each do |f|
+ func.call(dir + "/" + f)
+ end
end
end
end
alias for_each_sound_file each_sound_file
alias map_sound_files each_sound_file
- # each_sound_file(".", "/usr/opt/sound/SFiles") do |f| play(f, :wait, true) end
+ # each_sound_file(".", "/usr/opt/sound/SFiles") do |f|
+ # play(f, :wait, true)
+ # end
add_help(:match_sound_files,
"match_sound_files(*dir_args) do |file| ... end \
-applies func to each sound file in dir and returns a list of files \
-for which body does not return false")
+Applies func to each sound file in dir and returns a list of files \
+for which body does not return false.")
def match_sound_files(*args, &func)
res = []
- each_sound_file(*args) do |f| func.call(f) and res.push(f) end
+ each_sound_file(*args) do |f|
+ func.call(f) and res.push(f)
+ end
res
end
# match_sound_files() do |f| f =~ /\.(wav|snd)$/ end
add_help(:selection_members,
- "selection_members() \
--> list of lists of [snd, chn] indicating the channels participating in the current selection.")
+ "selection_members() \
+Returns list of lists of [snd, chn] indicating the channels \
+participating in the current selection.")
def selection_members
sndlist = []
if selection?
@@ -1238,40 +1274,48 @@ for which body does not return false")
sndlist
end
- add_help(:clear_selection, "clear_selection() \
-unselects any currently selected samples.")
+ add_help(:clear_selection,
+ "clear_selection() \
+Unselects any currently selected samples.")
def clear_selection()
if selection?
Snd.sounds.each do |snd|
channels(snd).times do |chn|
need_update = selection_member?(snd, chn)
set_selection_member?(false, snd, chn)
- if need_update then update_time_graph(snd, chn) end
+ if need_update
+ update_time_graph(snd, chn)
+ end
end
end
end
end
add_help(:make_selection,
- "make_selection([beg=0, [end=false, [snd=false, [chn=false]]]]) \
-makes a selection like make-region but without creating a region.
-make_selection follows snd's sync field, and applies to all snd's channels if chn is not \
-specified. end defaults to end of channel, beg defaults to 0, \
-snd defaults to the currently selected sound.")
+ "make_selection(beg=0, end=false, snd=false, chn=false) \
+Makes a selection like make-region but without creating a region. \
+make_selection follows SND's sync field, \
+and applies to all SND's channels if CHN is not specified. \
+END defaults to end of channel, BEG defaults to 0, \
+SND defaults to the currently selected sound.")
def make_selection(beg = 0, len = false, snd = false, chn = false)
add_chan_to_selection = lambda do |s0, s1, s, c|
- unless s0 then s0 = 0 end
+ unless s0
+ s0 = 0
+ end
set_selection_member?(true, s, c)
set_selection_position(s0, s, c)
val = if number?(s1)
s1 + 1
else
- frames(s, c)
+ framples(s, c)
end
- set_selection_frames(val - s0, s, c)
+ set_selection_framples(val - s0, s, c)
end
current_sound = (snd or selected_sound() or Snd.sounds[0])
- unless sound?(current_sound) then Snd.raise(:no_such_sound, beg, len, snd, chn) end
+ unless sound?(current_sound)
+ Snd.raise(:no_such_sound, beg, len, snd, chn)
+ end
current_sync = sync(current_sound)
clear_selection()
if number?(chn)
@@ -1289,75 +1333,18 @@ snd defaults to the currently selected sound.")
end
end
- add_help(:delete_selection_and_smooth,
- "delete_selection_and_smooth() deletes the current selection and smooths the splice")
- def delete_selection_and_smooth
- if selection?
- beg = selection_position
- len = selection_frames
- all_chans_zipped.map do |snd, chn|
- if selection_member?(snd, chn)
- smooth_beg = [0, beg - 16].max
- delete_samples(beg, len, snd, chn)
- smooth_sound(smooth_beg, 32, snd, chn)
- end
- end
- end
- end
-
- add_help(:eval_over_selection,
- "eval_over_selection(&func) evaluates func on each sample in the current selection")
- def eval_over_selection(func1 = nil, &func2)
- func = (block_given? ? func2 : func1)
- if proc?(func) and selection?
- beg = selection_position()
- len = selection_frames()
- all_chans_zipped.map do |snd, chn|
- if selection_member?(snd, chn)
- old_data = channel2vct(beg, len, snd, chn)
- new_data = Vct.new(len) do |i| func.call(old_data[i]) end
- vct2channel(new_data, beg, len, snd, chn)
- end
- end
- end
- end
-=begin
- # When the user types C-x x (without modifiers) and there is a current
- # selection, the minibuffer prompts "selection eval:". Eventually the
- # user responds, hopefully with a function of one argument, the
- # current selection sample the value returned by the function becomes
- # the new selection value.
-
- bind_key(?x, 0, lambda do | |
- if selection?
- prompt_in_minibuffer("selection eval:", &method(:eval_over_selection).to_proc)
- else
- report_in_minibuffer("no selection")
- end
- end, true, "C-x x: eval over selection")
-=end
-
- def yes_or_no?(question, action_if_yes, action_if_no, snd = false)
- clear_minibuffer(snd)
- prompt_in_minibuffer(question,
- lambda do |response|
- clear_minibuffer(snd)
- if response == "yes" or response == "y"
- action_if_yes.call(snd)
- else
- action_if_no.call(snd)
- end
- end,
- snd,
- true)
- end
-
add_help(:mix_channel,
- "mix_channel(file, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]) \
-mixes in file. file can be the file name or a list [file_name, beg = 0, chn = 0]")
- def mix_channel(fdata, beg = 0, dur = false, snd = false, chn = false, edpos = false)
- assert_type((string?(fdata) or array?(fdata)), fdata, 0, "a string or an array")
- unless number?(beg) then beg = 0 end
+ "mix_channel(file, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Mixes in FILE. \
+FILE can be the file name or a list [file_name, beg = 0, chn = 0].")
+ def mix_channel(fdata, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
+ assert_type((string?(fdata) or array?(fdata)), fdata, 0,
+ "a string or an array")
+ unless number?(beg)
+ beg = 0
+ end
fname = string?(fdata) ? fdata : fdata.first
fbeg = if string?(fdata) or fdata.length < 2
0
@@ -1369,23 +1356,29 @@ mixes in file. file can be the file name or a list [file_name, beg = 0, chn = 0]
else
fdata[2]
end
- len = (dur or (mus_sound_frames(fname) - fbeg))
+ len = (dur or (mus_sound_framples(fname) - fbeg))
Snd.raise(:no_such_sample) if beg < 0
if len > 0
reader = make_sampler(fbeg, fname, fchan)
map_channel(lambda do |val|
val + next_sample(reader)
end, beg, len, snd, chn, edpos,
- format("%s(%s, %s, %s", get_func_name, fdata.inspect, beg, dur))
+ format("%s(%p, %s, %s", get_func_name, fdata, beg, dur))
end
end
add_help(:insert_channel,
- "insert_channel(file, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]) \
-inserts the file. file can be the file name or a list [file_name, beg = 0, chn = 0]" )
- def insert_channel(fdata, beg = 0, dur = false, snd = false, chn = false, edpos = false)
- assert_type((string?(fdata) or array?(fdata)), fdata, 0, "a string or an array")
- unless number?(beg) then beg = 0 end
+ "insert_channel(file, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Inserts the FILE. \
+FILE can be the file name or a list [file_name, beg = 0, chn = 0].")
+ def insert_channel(fdata, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
+ assert_type((string?(fdata) or array?(fdata)), fdata, 0,
+ "a string or an array")
+ unless number?(beg)
+ beg = 0
+ end
fname = string?(fdata) ? fdata : fdata.first
fbeg = if string?(fdata) or fdata.length < 2
0
@@ -1397,17 +1390,21 @@ inserts the file. file can be the file name or a list [file_name, beg = 0, chn =
else
fdata[2]
end
- len = (dur or (mus_sound_frames(fname) - fbeg))
+ len = (dur or (mus_sound_framples(fname) - fbeg))
Snd.raise(:no_such_sample) if beg < 0
if len > 0
reader = make_sampler(fbeg, fname, fchan)
- insert_samples(beg, len, Vct.new(len) { |i| next_sample(reader) }, snd, chn, edpos, false,
- format("%s(%s, %s, %s", get_func_name, fdata.inspect, beg, dur))
+ insert_samples(beg, len,
+ Vct.new(len) do |i|
+ next_sample(reader)
+ end, snd, chn, edpos, false,
+ format("%s(%p, %s, %s", get_func_name, fdata, beg, dur))
end
end
add_help(:redo_channel,
- "redo_channel([edits=1, [snd=false, [chn=false]]]) is the regularized version of redo")
+ "redo_channel(edits=1, snd=false, chn=false) \
+Is the regularized version of redo.")
def redo_channel(edits = 1, snd = false, chn = false)
if snd and sync(snd).nonzero? and chn
set_edit_position(edit_position(snd, chn) + edits, snd, chn)
@@ -1417,7 +1414,8 @@ inserts the file. file can be the file name or a list [file_name, beg = 0, chn =
end
add_help(:undo_channel,
- "undo_channel([edits=1, [snd=false, [chn=false]]]) is the regularized version of undo")
+ "undo_channel(edits=1, snd=false, chn=false) \
+Is the regularized version of undo.")
def undo_channel(edits = 1, snd = false, chn = false)
if snd and sync(snd).nonzero? and chn
set_edit_position([edit_position(snd, chn) - edits, 0].max, snd, chn)
@@ -1439,7 +1437,9 @@ inserts the file. file can be the file name or a list [file_name, beg = 0, chn =
x1, y1 = env[0], env[1]
xrange = (env[-2] - env[0]).to_f
ramp_beg = beg
- dur = frames(snd, chn) unless number?(dur)
+ unless number?(dur)
+ dur = framples(snd, chn)
+ end
as_one_edit_rb(origin) do | |
2.step(env.length - 1, 2) do |i|
x0, y0, x1, y1 = x1, y1, env[i], env[i + 1]
@@ -1456,36 +1456,38 @@ inserts the file. file can be the file name or a list [file_name, beg = 0, chn =
end
end
- # vct: angle, incr, off, scl
add_help(:sine_ramp,
- "sine_ramp(rmp0, rmp1, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]) \
-produces a sinsusoidal connection from rmp0 to rmp1")
- def sine_ramp(rmp0, rmp1, beg = 0, dur = false, snd = false, chn = false, edpos = false)
- ptree_channel(lambda { |y, data, forward|
- angle = data[0]
- incr = data[1]
- if forward
- data[0] = angle + incr
- else
- data[0] = angle - incr
- end
- y * (data[2] + data[3] * (0.5 + 0.5 * cos(angle)))
- },
- beg, dur, snd, chn, edpos, true,
- lambda { |frag_beg, frag_dur|
- incr = PI / frag_dur
- vct(-PI + frag_beg * incr, incr, rmp0, rmp1 - rmp0)
- },
- format("%s(%s, %s, %s, %s", get_func_name, rmp0, rmp1, beg, dur))
+ "sine_ramp(rmp0, rmp1, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Produces a sinsusoidal connection from RMP0 to RMP1.")
+ def sine_ramp(rmp0, rmp1, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
+ angle = -PI
+ len = if number?(dur)
+ dur
+ else
+ framples(snd, chn) - beg
+ end
+ incr = PI / len
+ map_channel(lambda do |y|
+ result = y * (rmp0 + (rmp1 - rmp0) * (0.5 + 0.5 * cos(angle)))
+ angle += incr
+ result
+ end, beg, dur, snd, chn, edpos,
+ format("%s(%s, %s, %s, %s",
+ get_func_name, rmp0, rmp1, beg, dur))
end
add_help(:sine_env_channel,
- "sine_env_channel(env, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]) \
-connects env's dots with sinusoids")
- def sine_env_channel(env, beg = 0, dur = false, snd = false, chn = false, edpos = false)
+ "sine_env_channel(env, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Connects ENV's dots with sinusoids.")
+ def sine_env_channel(env, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
any_env_channel(env, beg, dur, snd, chn, edpos,
- format("%s(%s, %s, %s",
- get_func_name, env.inspect, beg, dur)) do |r0, r1, b, d, s, c, e|
+ format("%s(%p, %s, %s",
+ get_func_name,
+ env, beg, dur)) do |r0, r1, b, d, s, c, e|
sine_ramp(r0, r1, b, d, s, c, e)
end
end
@@ -1495,169 +1497,221 @@ connects env's dots with sinusoids")
# formulas to get sharper sinusoids (i.e. use the sum of n cosines,
# rather than just 1).
- # vct: angle, incr, off, scl
- def blackman4_ramp(rmp0, rmp1, beg = 0, dur = false, snd = false, chn = false, edpos = false)
- ptree_channel(lambda { |y, data, forward|
- angle = data[0]
- incr = data[1]
- if forward
- data[0] = angle + incr
- else
- data[0] = angle - incr
- end
- cx = cos(angle)
- y * (data[2] + data[3] *
- (0.084037 + cx *
- (-0.29145 + cx *
- (0.375696 + cx *
- (-0.20762 + cx * 0.041194)))))
- },
- beg, dur, snd, chn, edpos, true,
- lambda { |frag_beg, frag_dur|
- incr = PI / frag_dur
- vct(frag_beg * incr, incr, rmp0, rmp1 - rmp0)
- },
- format("%s(%s, %s, %s, %s", get_func_name, rmp0, rmp1, beg, dur))
+ def blackman4_ramp(rmp0, rmp1, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
+ angle = 0.0
+ len = if number?(dur)
+ dur
+ else
+ framples(snd, chn) - beg
+ end
+ incr = PI / len
+ map_channel(lambda do |y|
+ cx = cos(angle)
+ result = y * (rmp0 + (rmp1 - rmp0) *
+ (0.084037 + cx *
+ (-0.29145 + cx *
+ (0.375696 + cx *
+ (-0.20762 + cx * 0.041194)))))
+ angle += incr
+ result
+ end, beg, dur, snd, chn, edpos,
+ format("%s(%s, %s, %s, %s",
+ get_func_name, rmp0, rmp1, beg, dur))
end
- def blackman4_env_channel(env, beg = 0, dur = false, snd = false, chn = false, edpos = false)
+ def blackman4_env_channel(env, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
any_env_channel(env, beg, dur, snd, chn, edpos,
- format("%s(%s, %s, %s",
- get_func_name, env.inspect, beg, dur)) do |r0, r1, b, d, s, c, e|
+ format("%s(%p, %s, %s",
+ get_func_name, env,
+ beg, dur)) do |r0, r1, b, d, s, c, e|
blackman4_ramp(r0, r1, b, d, s, c, e)
end
end
- # Any curve can be used as the connecting line between envelope
- # breakpoints in the same manner -- set up each ramp to take the
- # current position and increment, then return the value in
- # ptree-channel. A simple one would have a table of values and use
- # array_interp.
-
- # vct: start, incr, off, scl
add_help(:ramp_squared,
- "ramp_squared(rmp0, rmp1, [symmetric=true, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]]) \
-connects rmp0 and rmp1 with an x^2 curve")
- def ramp_squared(rmp0, rmp1, symmetric = true,
- beg = 0, dur = false, snd = false, chn = false, edpos = false)
- ptree_channel(lambda { |y, data, forward|
- angle = data[0]
- incr = data[1]
- if forward
- data[0] = angle + incr
- else
- data[0] = angle - incr
- end
- y * (data[2] + angle * angle * data[3])
- },
- beg, dur, snd, chn, edpos, true,
- lambda { |frag_beg, frag_dur|
- incr = 1.0 / frag_dur
- if symmetric and rmp1 < rmp0
- vct((frag_dur - frag_beg) * incr, -incr, rmp1, rmp0 - rmp1)
- else
- vct(frag_beg * incr, incr, rmp0, rmp1 - rmp0)
- end
- },
- format("%s(%s, %s, %s, %s, %s", get_func_name, rmp0, rmp1, symmetric, beg, dur))
+ "ramp_squared(rmp0, rmp1, symmetric=true, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Connects RMP0 and RMP1 with an x^2 curve.")
+ def ramp_squared(rmp0, rmp1, symmetric = true, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
+ angle = 0.0
+ len = if number?(dur)
+ dur
+ else
+ framples(snd, chn) - beg
+ end
+ incr = 1.0 / len
+ map_channel(lambda do |y|
+ result = y * (rmp0 + angle * angle * (rmp1 - rmp0))
+ angle += incr
+ result
+ end, beg, dur, snd, chn, edpos,
+ format("%s(%s, %s, %s, %s, %s", get_func_name, rmp0, rmp1,
+ symmetric, beg, dur))
end
add_help(:env_squared_channel,
- "(env-squared-channel(env, [symmetric=true, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]]) \
-connects env's dots with x^2 curves")
- def env_squared_channel(env, symmetric = true,
- beg = 0, dur = false, snd = false, chn = false, edpos = false)
+ "env_squared_channel(env, symmetric=true, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Connects ENV's dots with x^2 curves.")
+ def env_squared_channel(env, symmetric = true, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
any_env_channel(env, beg, dur, snd, chn, edpos,
- format("%s(%s, %s, %s, %s",
+ format("%s(%p, %s, %s, %s",
get_func_name,
- env.inspect, symmetric, beg, dur)) do |r0, r1, b, d, s, c, e|
+ env, symmetric, beg, dur)) do |r0, r1, b, d, s, c, e|
ramp_squared(r0, r1, symmetric, b, d, s, c, e)
end
end
# env_squared_channel([0, 0, 1, 1, 2, -0.5, 3, 1])
- # vct: start, incr, off, scl, exponent
add_help(:ramp_expt,
- "ramp_expt(rmp0, rmp1, exponent, [symmetric=true, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]]) connects rmp0 and rmp1 with an x^exponent curve")
+ "ramp_expt(rmp0, rmp1, exponent, symmetric=true, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Connects RMP0 and RMP1 with an x^exponent curve.")
def ramp_expt(rmp0, rmp1, exponent, symmetric = true,
beg = 0, dur = false, snd = false, chn = false, edpos = false)
- rmp0 = rmp0.to_f
- rmp1 = rmp1.to_f
- exponent = exponent.to_f
- ptree_channel(lambda { |y, data, forward|
- angle = data[0]
- incr = data[1]
- if forward
- data[0] = angle + incr
- else
- data[0] = angle - incr
- end
- begin
- y * (data[2] + exp(log(angle) * data[4]) * data[3])
- rescue
- 0.0
- end
- }, beg, dur, snd, chn, edpos, true,
- lambda { |frag_beg, frag_dur|
- frag_beg = frag_beg.to_f
- frag_dur = frag_dur.to_f
- incr = 1.0 / frag_dur
- if symmetric and rmp1 < rmp0
- vct((frag_dur - frag_beg) * incr, -incr, rmp1, rmp0 - rmp1, exponent)
- else
- vct(frag_beg * incr, incr, rmp0, rmp1 - rmp0, exponent)
- end
- },
- format("%s(%s, %s, %s, %s, %s, %s",
- get_func_name, rmp0, rmp1, exponent, symmetric, beg, dur))
+ angle = 0.0
+ len = if number?(dur)
+ dur
+ else
+ framples(snd, chn) - beg
+ end
+ incr = 1.0 / len
+ map_channel(lambda do |y|
+ begin
+ result = y *
+ (rmp0 + exp(log(angle) * exponent) * (rmp1 - rmp0))
+ rescue
+ result = 0.0
+ end
+ angle += incr
+ result
+ end, beg, dur, snd, chn, edpos,
+ format("%s(%s, %s, %s, %s, %s, %s",
+ get_func_name, rmp0, rmp1,
+ exponent, symmetric, beg, dur))
end
add_help(:env_expt_channel,
- "env_expt_channel(env, exponent, [symmetric=true, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]]) connects env's dots with x^exponent curves")
- def env_expt_channel(env, exponent, symmetric = true,
- beg = 0, dur = false, snd = false, chn = false, edpos = false)
+ "env_expt_channel(env, exponent, symmetric=true, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Connects ENV's dots with x^exponent curves.")
+ def env_expt_channel(env, exponent, symmetric = true, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
if exponent == 1.0
env_channel(env, beg, dur, snd, chn, edpos)
else
any_env_channel(env, beg, dur, snd, chn, edpos,
- format("%s(%s, %s, %s, %s, %s",
+ format("%s(%p, %s, %s, %s, %s",
get_func_name,
- env.inspect, exponent, symmetric, beg, dur)) do |r0, r1, b, d, s, c, e|
+ env, exponent, symmetric,
+ beg, dur)) do |r0, r1, b, d, s, c, e|
ramp_expt(r0, r1, exponent, symmetric, b, d, s, c, e)
end
end
end
add_help(:offset_channel,
- "offset_channel(amount, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]) \
-adds amount to each sample")
- def offset_channel(amount, beg = 0, dur = false, snd = false, chn = false, edpos = false)
- ptree_channel(lambda { |y| y + amount }, beg, dur, snd, chn, edpos, true, false,
- format("%s(%s, %s, %s", get_func_name, amount, beg, dur))
+ "offset_channel(amount, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Adds AMOUNT to each sample.")
+ def offset_channel(amount, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
+ map_channel(lambda do |y|
+ y + amount
+ end, beg, dur, snd, chn, edpos,
+ format("%s(%s, %s, %s", get_func_name, amount, beg, dur))
+ end
+
+ add_help(:offset_sound,
+ "offset_sound(off, beg=0, dur=false, snd=false) \
+Adds OFF to every sample in SND.")
+ def offset_sound(off, beg = 0, dur = false, snd = false)
+ snd = Snd.snd(snd)
+ if sound?(snd)
+ channels(snd).times do |chn|
+ offset_channel(off, beg, dur, snd, chn)
+ end
+ else
+ Snd.raise(:no_such_sound, snd)
+ end
+ end
+
+ add_help(:pad_sound,
+ "pad_sound(beg, dur, snd=false) \
+Places a block of DUR zeros in every channel of SND starting at BEG.")
+ def pad_sound(beg, dur, snd = false)
+ snd = Snd.snd(snd)
+ if sound?(snd)
+ channels(snd).times do |chn|
+ pad_channel(beg, dur, snd, chn)
+ end
+ else
+ Snd.raise(:no_such_sound, snd)
+ end
end
add_help(:dither_channel,
- "dither_channel([amount, 0.00006, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]]) adds amount dither to each sample")
- def dither_channel(amnt = 0.00006, beg = 0, dur = false, snd = false, chn = false, edpos = false)
+ "dither_channel(amount=0.00006, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Adds AMOUNT dither to each sample.")
+ def dither_channel(amnt = 0.00006, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
dither = 0.5 * amnt
- ptree_channel(lambda { |y| mus_random(dither) + mus_random(dither) + y },
- beg, dur, snd, chn, edpos, true, false,
- format("%s(%s, %s, %s", get_func_name, amnt, beg, dur))
+ map_channel(lambda do |y|
+ mus_random(dither) + mus_random(dither) + y
+ end, beg, dur, snd, chn, edpos,
+ format("%s(%s, %s, %s", get_func_name, amnt, beg, dur))
+ end
+
+ add_help(:dither_sound,
+ "dither_sound(amount=0.00006, beg=0, dur=false, snd=false) \
+Adds dithering to every channel of SND.")
+ def dither_sound(amnt = 0.00006, beg = 0, dur = false, snd = false)
+ snd = Snd.snd(snd)
+ if sound?(snd)
+ channels(snd).times do |chn|
+ dither_channel(amnt, beg, dur, snd, chn)
+ end
+ else
+ Snd.raise(:no_such_sound, snd)
+ end
end
add_help(:contrast_channel,
- "contrast_channel(index, [beg=0, [dur=false, [snd=false, [chn=false, [edpos=false]]]]]) \
-applies contrast enhancement to the sound" )
- def contrast_channel(index, beg = 0, dur = false, snd = false, chn = false, edpos = false)
- ptree_channel(lambda { |y| sin(y * HALF_PI + index * sin(y * TWO_PI))},
- beg, dur, snd, chn, edpos, false, false,
- format("%s(%s, %s, %s", get_func_name, index, beg, dur))
+ "contrast_channel(index, beg=0, dur=false, \
+snd=false, chn=false, edpos=false) \
+Applies contrast-enhancement to the sound.")
+ def contrast_channel(index, beg = 0, dur = false,
+ snd = false, chn = false, edpos = false)
+ map_channel(lambda do |y|
+ sin(y * HALF_PI + index * sin(y * TWO_PI))
+ end, beg, dur, snd, chn, edpos,
+ format("%s(%s, %s, %s", get_func_name, index, beg, dur))
+ end
+
+ add_help(:contrast_sound,
+ "contrast_sound(index, beg=0, dur=false, snd=false) \
+Applies contrast-enhancement to every channel of SND.")
+ def contrast_sound(index, beg = 0, dur = false, snd = false)
+ snd = Snd.snd(snd)
+ if sound?(snd)
+ channels(snd).times do |chn|
+ contrast_channel(index, beg, dur, snd, chn)
+ end
+ else
+ Snd.raise(:no_such_sound, snd)
+ end
end
# channels-equal
add_help(:channels_eql?,
- "channels_eql?(s1, c1, s2, c2, [diff, 0.0]) \
--> true if the two channels are the same (within diff) modulo trailing 0's")
+ "channels_eql?(s1, c1, s2, c2, diff=0.0) \
+Returns true if the two channels \
+are the same (within diff) modulo trailing 0's.")
def channels_eql?(snd1, chn1, snd2, chn2, allowable_difference = 0.0)
if snd1.eql?(snd2) and chn1 == chn2
true
@@ -1667,8 +1721,8 @@ applies contrast enhancement to the sound" )
if (mx1 - mx2).abs > allowable_difference
false
else
- len1 = frames(snd1, chn1)
- len2 = frames(snd2, chn2)
+ len1 = framples(snd1, chn1)
+ len2 = framples(snd2, chn2)
first_longer = (len1 >= len2)
len = first_longer ? len1 : len2
s1 = first_longer ? snd1 : snd2
@@ -1676,20 +1730,20 @@ applies contrast enhancement to the sound" )
c1 = first_longer ? chn1 : chn2
c2 = first_longer ? chn2 : chn1
read2 = make_sampler(0, s2, c2)
- (not scan_channel(lambda { |y|
+ (not scan_channel(lambda do |y|
val = read_sample(read2)
(val - y).abs > allowable_difference
- }, 0, len, s1, c1))
+ end, 0, len, s1, c1))
end
end
end
add_help(:channels_equal?,
- "channels_equal?(s1, c1, s2, c2, [diff=0.0]) \
--> true if the two channels are the same (within diff)")
+ "channels_equal?(s1, c1, s2, c2, diff=0.0) \
+Returns true if the two channels are the same (within diff).")
def channels_equal?(snd1, chn1, snd2, chn2, allowable_difference = 0.0)
- len1 = frames(snd1, chn1)
- len2 = frames(snd2, chn2)
+ len1 = framples(snd1, chn1)
+ len2 = framples(snd2, chn2)
if len1 == len2
channels_eql?(snd1, chn1, snd2, chn2, allowable_difference)
else
@@ -1745,8 +1799,12 @@ applies contrast enhancement to the sound" )
unless $including_reopen_menu
menu = Reopen_menu.new("Reopen")
$including_reopen_menu = true
- $close_hook.add_hook!("prefs-add-to-reopen-menu") do |snd| menu.add_to_reopen_menu(snd) end
- $open_hook.add_hook!("prefs-check-reopen-menu") do |file| menu.check_reopen_menu(file) end
+ $close_hook.add_hook!("prefs-add-to-reopen-menu") do |snd|
+ menu.add_to_reopen_menu(snd)
+ end
+ $open_hook.add_hook!("prefs-check-reopen-menu") do |file|
+ menu.check_reopen_menu(file)
+ end
end
end
@@ -1767,13 +1825,13 @@ applies contrast enhancement to the sound" )
remove_from_menu(@reopen_menu, @reopen_empty)
@reopen_names = []
end
- add_to_menu(@reopen_menu,
- brief_name,
+ add_to_menu(@reopen_menu, brief_name,
lambda do | |
remove_from_menu(@reopen_menu, brief_name)
- if File.exists?(long_name) then open_sound(long_name) end
- end,
- 0)
+ if File.exist?(long_name)
+ open_sound(long_name)
+ end
+ end, 0)
@reopen_names.push(brief_name)
if @reopen_names.length > @reopen_max_length
remove_from_menu(@reopen_menu, @reopen_names.shift)
@@ -1803,8 +1861,12 @@ applies contrast enhancement to the sound" )
unless $include_buffers_menu
menu = Buffers_menu.new("Buffers")
$include_buffers_menu = true
- $open_hook.add_hook!("prefs-open-buffer") do |file| menu.open_buffer(file) end
- $close_hook.add_hook!("prefs-close-buffer") do |file| menu.close_buffer(file) end
+ $open_hook.add_hook!("prefs-open-buffer") do |file|
+ menu.open_buffer(file)
+ end
+ $close_hook.add_hook!("prefs-close-buffer") do |file|
+ menu.close_buffer(file)
+ end
end
end
@@ -1821,12 +1883,12 @@ applies contrast enhancement to the sound" )
remove_from_menu(@buffer_menu, @buffer_empty)
@buffer_names = []
end
- add_to_menu(@buffer_menu,
- file,
+ add_to_menu(@buffer_menu, file,
lambda do | |
- if sound?(ind = find_sound(file)) then select_sound(ind) end
- end,
- -1)
+ if sound?(ind = find_sound(file))
+ select_sound(ind)
+ end
+ end, -1)
@buffer_names.push(file)
end
diff --git a/extensions.scm b/extensions.scm
index 37221e8..28fe6af 100644
--- a/extensions.scm
+++ b/extensions.scm
@@ -15,74 +15,68 @@
(provide 'snd-extensions.scm)
-(define (remove-if pred l)
- "(remove-if func lst) removes any element from 'lst' that 'func' likes"
- (let loop ((l l) (result '()))
- (cond ((null? l) (reverse! result))
- ((pred (car l)) (loop (cdr l) result))
- (else (loop (cdr l) (cons (car l) result))))))
+(define remove-if
+ (let ((documentation "(remove-if func lst) removes any element from 'lst' that 'func' likes"))
+ (lambda (pred l)
+ (map (lambda (x) (if (pred x) (values) x)) l))))
+
(if (not (defined? 'all-chans))
- (define (all-chans)
- "(all-chans) -> two parallel lists, the first sound objects, the second channel numbers. If we have
-two sounds open (indices 0 and 1 for example), and the second has two channels, (all-chans) returns '((#<sound 0> #<sound 1> #<sound 1>) (0 0 1))"
- (let ((sndlist '())
- (chnlist '()))
- (for-each (lambda (snd)
- (do ((i (- (channels snd) 1) (- i 1)))
- ((< i 0))
- (set! sndlist (cons snd sndlist))
- (set! chnlist (cons i chnlist))))
- (sounds))
- (list sndlist chnlist))))
+ (define all-chans
+ (let ((documentation "(all-chans) -> two parallel lists, the first sound objects, the second channel numbers. If we have
+two sounds open (indices 0 and 1 for example), and the second has two channels, (all-chans) returns '((#<sound 0> #<sound 1> #<sound 1>) (0 0 1))"))
+ (lambda ()
+ (let ((sndlist ())
+ (chnlist ()))
+ (for-each (lambda (snd)
+ (do ((i (- (channels snd) 1) (- i 1)))
+ ((< i 0))
+ (set! sndlist (cons snd sndlist))
+ (set! chnlist (cons i chnlist))))
+ (sounds))
+ (list sndlist chnlist))))))
(define channel-sync
- (make-procedure-with-setter
- (lambda (snd chn) (channel-property 'sync snd chn))
- (lambda (snd chn val) (set! (channel-property 'sync snd chn) val))))
+ (dilambda
+ (let ((documentation "(channel-sync snd chn) returns the sync property of that channel (it is not actually used anywhere)"))
+ (lambda (snd chn)
+ (channel-property 'sync snd chn)))
+ (lambda (snd chn val)
+ (set! (channel-property 'sync snd chn) val))))
;;; -------- mix with result at original peak amp
-(define (normalized-mix filename beg in-chan snd chn)
- "(normalized-mix filename beg in-chan snd chn) is like mix but the mix result has same peak amp as unmixed snd/chn (returns scaler)"
- (let ((original-maxamp (maxamp snd chn)))
- (mix filename beg in-chan snd chn)
- (let ((new-maxamp (maxamp snd chn)))
- (if (not (= original-maxamp new-maxamp))
- (let ((scaler (/ original-maxamp new-maxamp))
- (old-sync (sync snd)))
- (set! (sync snd) 0)
- (scale-by scaler snd chn)
- (set! (sync snd) old-sync)
- scaler)
- 1.0))))
+(define normalized-mix
+ (let ((documentation "(normalized-mix filename beg in-chan snd chn) is like mix but the mix result has same peak amp as unmixed snd/chn (returns scaler)"))
+ (lambda* (filename beg in-chan snd chn)
+ (let ((original-maxamp (maxamp snd chn)))
+ (mix filename beg in-chan snd chn)
+ (let ((new-maxamp (maxamp snd chn)))
+ (if (not (= original-maxamp new-maxamp))
+ (let ((scaler (/ original-maxamp new-maxamp))
+ (old-sync (sync snd)))
+ (set! (sync snd) (+ (sync-max) 1))
+ (scale-by scaler snd chn)
+ (set! (sync snd) old-sync)
+ scaler)
+ 1.0))))))
;;;-------- mix with envelope on mixed-in file
-;;;
-;;; there are lots of ways to do this; this version uses functions from Snd, CLM, and Sndlib.
-
-(define (enveloped-mix filename beg env)
- "(enveloped-mix filename beg env) mixes filename starting at beg with amplitude envelope env. (enveloped-mix \"pistol.snd\" 0 '(0 0 1 1 2 0))"
- (let* ((len (frames filename))
- (tmp-name (string-append (if (and (string? (temp-dir))
- (> (string-length (temp-dir)) 0))
- (string-append (temp-dir) "/")
- "")
- "tmp.snd"))
- (tmpfil (mus-sound-open-output tmp-name 22050 1 mus-bshort mus-next ""))
- (mx (make-mixer 1 1.0))
- (envs (make-vector 1))
- (inenvs (make-vector 1)))
- (mus-sound-close-output tmpfil 0)
- (set! (inenvs 0) (make-env env :length len))
- (set! (envs 0) inenvs)
- (mus-mix tmp-name filename 0 len 0 mx envs)
- (mix tmp-name beg)
- (delete-file tmp-name)))
+
+(define enveloped-mix
+ (let ((documentation "(enveloped-mix filename beg e) mixes filename starting at beg with amplitude envelope e. (enveloped-mix \"pistol.snd\" 0 '(0 0 1 1 2 0))"))
+ (lambda (filename beg e)
+ (let* ((len (framples filename))
+ (amp-env (make-env e :length len))
+ (rd (make-readin filename)))
+ (map-channel
+ (lambda (y)
+ (+ y (* (env amp-env) (readin rd))))
+ beg len)))))
;;; -------- map-sound-files, match-sound-files
@@ -91,214 +85,213 @@ two sounds open (indices 0 and 1 for example), and the second has two channels,
;;;
;;; (map-sound-files (lambda (n) (if (> (mus-sound-duration n) 10.0) (snd-print n))))
-(define* (map-sound-files func dir)
- "(map-sound-files func dir) applies func to each sound file in dir"
- (map func (sound-files-in-directory (or dir "."))))
+(define map-sound-files
+ (let ((documentation "(map-sound-files func dir) applies func to each sound file in dir"))
+ (lambda* (func dir)
+ (map func (sound-files-in-directory (or dir "."))))))
-(define* (for-each-sound-file func dir)
- "(for-each-sound-file func dir) applies func to each sound file in dir"
- (for-each func (sound-files-in-directory (or dir "."))))
+(define for-each-sound-file
+ (let ((documentation "(for-each-sound-file func dir) applies func to each sound file in dir"))
+ (lambda* (func dir)
+ (for-each func (sound-files-in-directory (or dir "."))))))
#|
- (for-each-sound-file
- (lambda (n)
- (catch #t
- (lambda ()
- (if (not (null? (mus-sound-loop-info (string-append "/home/bil/sf/" n))))
- (snd-print (format #f "~%~A" n))))
- (lambda args #f)))
- "/home/bil/sf")
+(for-each-sound-file
+ (lambda (n)
+ (catch #t
+ (lambda ()
+ (if (pair? (mus-sound-loop-info (string-append "/home/bil/sf/" n)))
+ (snd-print (format #f "~%~A" n))))
+ (lambda args #f)))
+ "/home/bil/sf")
|#
-(define* (match-sound-files func dir)
- "(match-sound-files func dir) applies func to each sound file in dir and returns a list of files for which func does not return #f"
- (let* ((matches '()))
- (for-each
- (lambda (file)
- (if (func file)
- (set! matches (cons file matches))))
- (sound-files-in-directory (or dir ".")))
- matches))
-
+(define match-sound-files
+ (let ((documentation "(match-sound-files func dir) applies func to each sound file in dir and returns a list of files for which func does not return #f"))
+ (lambda* (func dir)
+ (let ((matches ()))
+ (for-each
+ (lambda (file)
+ (if (func file)
+ (set! matches (cons file matches))))
+ (sound-files-in-directory (or dir ".")))
+ matches))))
+
+
-
;;; -------- mix-channel, insert-channel, c-channel
-(define* (mix-channel input-data (beg 0) dur snd (chn 0) edpos with-tag)
-
- "(mix-channel file beg dur snd chn edpos with-tag) mixes in file. file can be the file name, a sound object, or \
-a list (file-name-or-sound-object [beg [channel]])."
-
- (define (channel->mix input-snd input-chn input-beg input-len output-snd output-chn output-beg)
- (if (< input-len 1000000)
- (mix-vct (channel->vct input-beg input-len input-snd input-chn) output-beg output-snd output-chn #t)
- (let* ((output-name (snd-tempnam))
- (output (new-sound output-name :size input-len))
- (reader (make-sampler input-beg input-snd input-chn)))
- (map-channel (lambda (val)
- (next-sample reader))
- 0 input-len output 0)
- (save-sound output)
- (close-sound output)
- (mix output-name output-beg 0 output-snd output-chn #t #t))))
-
- (let* ((input (if (not (list? input-data))
- input-data
- (car input-data)))
- (input-beg (if (or (not (list? input-data))
- (< (length input-data) 2))
- 0
- (cadr input-data)))
- (input-channel (if (or (not (list? input-data))
- (< (length input-data) 3))
+(define mix-channel
+
+ (let ((documentation "(mix-channel file beg dur snd chn edpos with-tag) mixes in file. file can be the file name, a sound object, or \
+a list (file-name-or-sound-object [beg [channel]])."))
+ (lambda* (input-data (beg 0) dur snd (chn 0) edpos with-tag)
+
+ (define (channel->mix input-snd input-chn input-beg input-len output-snd output-chn output-beg)
+ (if (< input-len 1000000)
+ (mix-float-vector (channel->float-vector input-beg input-len input-snd input-chn) output-beg output-snd output-chn #t)
+ (let* ((output-name (snd-tempnam))
+ (output (new-sound output-name :size input-len)))
+ (float-vector->channel (samples input-beg input-len input-snd input-chn) 0 input-len output 0)
+ (save-sound output)
+ (close-sound output)
+ (mix output-name output-beg 0 output-snd output-chn #t #t))))
+
+ (let* ((input (if (not (pair? input-data))
+ input-data
+ (car input-data)))
+ (input-beg (if (or (not (pair? input-data))
+ (< (length input-data) 2))
+ 0
+ (cadr input-data)))
+ (input-channel (if (or (not (pair? input-data))
+ (< (length input-data) 3))
+ 0
+ (caddr input-data)))
+ (len (or dur (- (if (string? input)
+ (framples input)
+ (framples input input-channel))
+ input-beg)))
+ (start (or beg 0)))
+ (if (< start 0)
+ (error 'no-such-sample "mix-channel: begin time < 0: ~A" beg)
+ (if (> len 0)
+ (if (not with-tag)
+
+ ;; not a virtual mix
+ (let ((d1 (samples input-beg len input input-channel))
+ (d2 (samples start len snd chn edpos)))
+ (float-vector-add! d1 d2)
+ (float-vector->channel d1 start len snd chn current-edit-position
+ (if (string? input-data)
+ (format #f "mix-channel ~S ~A ~A" input-data beg dur)
+ (format #f "mix-channel '~A ~A ~A" input-data beg dur))))
+
+ ;; a virtual mix -- use simplest method available
+ (if (sound? input)
+
+ ;; sound object case
+ (channel->mix input input-channel input-beg len snd chn start)
+
+ ;; file input
+ (if (and (= start 0)
+ (= len (framples input)))
+
+ ;; mixing entire file
+ (mix input start 0 snd chn #t #f) ; don't delete it!
+
+ ;; mixing part of file
+ (let* ((output-name (snd-tempnam))
+ (output (new-sound output-name :size len)))
+ (float-vector->channel (samples input-beg len input input-channel) 0 len output 0)
+ (save-sound output)
+ (close-sound output)
+ (mix output-name start 0 snd chn #t #t)))))))))))
+
+
+(define insert-channel
+ (let ((documentation "(insert-channel file beg dur snd chn edpos) inserts the file. file can be the file name or a list (file-name [beg [channel]])"))
+ (lambda* (file-data beg dur snd chn edpos)
+ (let* ((file-name (if (string? file-data) file-data (car file-data)))
+ (file-beg (if (or (string? file-data)
+ (< (length file-data) 2))
0
- (caddr input-data)))
- (len (or dur (- (if (string? input)
- (frames input)
- (frames input input-channel))
- input-beg)))
- (start (or beg 0)))
- (if (< start 0)
- (throw 'no-such-sample (list "mix-channel" beg))
+ (cadr file-data)))
+ (file-channel (if (or (string? file-data)
+ (< (length file-data) 3))
+ 0
+ (caddr file-data)))
+ (len (or dur (- (framples file-name) file-beg)))
+ (start (or beg 0)))
+ (if (< start 0) (error 'no-such-sample "insert-channel: begin time < 0: ~A" beg))
(if (> len 0)
- (if (not with-tag)
-
- ;; not a virtual mix
- (let ((reader (make-sampler input-beg input input-channel)))
- (map-channel (lambda (val)
- (+ val (next-sample reader)))
- start len snd chn edpos
- (if (string? input-data)
- (format #f "mix-channel ~S ~A ~A" input-data beg dur)
- (format #f "mix-channel '~A ~A ~A" input-data beg dur))))
-
- ;; a virtual mix -- use simplest method available
- (if (sound? input)
-
- ;; sound object case
- (channel->mix input input-channel input-beg len snd chn start)
-
- ;; file input
- (if (and (= start 0)
- (= len (frames input)))
-
- ;; mixing entire file
- (mix input start 0 snd chn #t #f) ; don't delete it!
-
- ;; mixing part of file
- (let* ((output-name (snd-tempnam))
- (output (new-sound output-name :size len))
- (reader (make-sampler input-beg input input-channel)))
- (map-channel (lambda (val) (next-sample reader)) 0 len output 0)
- (save-sound output)
- (close-sound output)
- (mix output-name start 0 snd chn #t #t)))))))))
-
-
-(define* (insert-channel file-data beg dur snd chn edpos)
- "(insert-channel file beg dur snd chn edpos) inserts the file. file can be the file name or a list (file-name [beg [channel]])"
- (let* ((file-name (if (string? file-data) file-data (car file-data)))
- (file-beg (if (or (string? file-data)
- (< (length file-data) 2))
- 0
- (cadr file-data)))
- (file-channel (if (or (string? file-data)
- (< (length file-data) 3))
- 0
- (caddr file-data)))
- (len (or dur (- (frames file-name) file-beg)))
- (start (or beg 0)))
- (if (< start 0) (throw 'no-such-sample (list "insert-channel" beg)))
- (if (> len 0)
- (let ((reader (make-sampler file-beg file-name file-channel))
- (data (make-vct len)))
- (vct-map! data (lambda () (next-sample reader)))
- (insert-samples start len data snd chn edpos #f
- (if (string? file-data)
- (format #f "insert-channel ~S ~A ~A" file-data beg dur)
- (format #f "insert-channel '~A ~A ~A" file-data beg dur)))))))
+ (insert-samples start len
+ (samples file-beg len file-name file-channel)
+ snd chn edpos #f
+ (if (string? file-data)
+ (format #f "insert-channel ~S ~A ~A" file-data beg dur)
+ (format #f "insert-channel '~A ~A ~A" file-data beg dur))))))))
;;; -------- redo-channel, undo-channel
-(define* (redo-channel (edits 1) snd chn)
- "(redo-channel (edits 1) snd chn) is the regularized version of redo"
- (if (and snd (not (= (sync snd) 0)) chn)
- (set! (edit-position snd chn) (+ (edit-position snd chn) edits))
- (redo edits snd)))
+(define redo-channel
+ (let ((documentation "(redo-channel (edits 1) snd chn) is the regularized version of redo"))
+ (lambda* ((edits 1) snd chn)
+ (if (and snd (not (= (sync snd) 0)) chn)
+ (set! (edit-position snd chn) (+ (edit-position snd chn) edits))
+ (redo edits snd)))))
-(define* (undo-channel (edits 1) snd chn)
- "(undo-channel (edits 1) snd chn) is the regularized version of undo"
- (if (and snd (not (= (sync snd) 0)) chn)
- (set! (edit-position snd chn) (max 0 (- (edit-position snd chn) edits)))
- (undo edits snd)))
+(define undo-channel
+ (let ((documentation "(undo-channel (edits 1) snd chn) is the regularized version of undo"))
+ (lambda* ((edits 1) snd chn)
+ (if (and snd (not (= (sync snd) 0)) chn)
+ (set! (edit-position snd chn) (max 0 (- (edit-position snd chn) edits)))
+ (undo edits snd)))))
;;; -------- any-env-channel
-(define* (any-env-channel env func (beg 0) dur snd chn edpos origin)
- "(any-env-channel env func (beg 0) dur snd chn edpos origin) takes breakpoints in 'env', \
-connects them with 'func', and applies the result as an amplitude envelope to the given channel"
- ;; handled as a sequence of funcs and scales
- (if (not (null? env))
- (let ((pts (/ (length env) 2)))
- (if (= pts 1)
- (scale-channel (car env) beg dur snd chn edpos)
- (let ((x0 0)
- (y0 0)
- (x1 (car env))
- (y1 (cadr env))
- (xrange (- (list-ref env (- (length env) 2)) (car env)))
- (ramp-beg beg)
- (ramp-dur 0))
- (if (not (number? dur)) (set! dur (frames snd chn)))
- (as-one-edit
- (lambda ()
- (do ((i 1 (+ 1 i))
- (j 2 (+ j 2)))
- ((= i pts))
- (set! x0 x1)
- (set! y0 y1)
- (set! x1 (list-ref env j))
- (set! y1 (list-ref env (+ 1 j)))
- (set! ramp-dur (round (* dur (/ (- x1 x0) xrange))))
- (if (= y0 y1)
- (scale-channel y0 ramp-beg ramp-dur snd chn edpos)
- (func y0 y1 ramp-beg ramp-dur snd chn edpos))
- (set! ramp-beg (+ ramp-beg ramp-dur))))
- origin))))))
+(define any-env-channel
+ (let ((documentation "(any-env-channel e func (beg 0) dur snd chn edpos origin) takes breakpoints in 'e', \
+connects them with 'func', and applies the result as an amplitude envelope to the given channel"))
+ (lambda* (e func (beg 0) dur snd chn edpos origin)
+ ;; handled as a sequence of funcs and scales
+ (if (pair? e)
+ (let ((pts (/ (length e) 2)))
+ (if (= pts 1)
+ (scale-channel (car e) beg dur snd chn edpos)
+ (let ((x0 0)
+ (y0 0)
+ (x1 (car e))
+ (y1 (cadr e))
+ (xrange (- (e (- (length e) 2)) (car e)))
+ (ramp-beg beg)
+ (ramp-dur 0))
+ (if (not (number? dur)) (set! dur (framples snd chn)))
+ (as-one-edit
+ (lambda ()
+ (do ((i 1 (+ 1 i))
+ (j 2 (+ j 2)))
+ ((= i pts))
+ (set! x0 x1)
+ (set! y0 y1)
+ (set! x1 (e j))
+ (set! y1 (e (+ 1 j)))
+ (set! ramp-dur (round (* dur (/ (- x1 x0) xrange))))
+ (if (= y0 y1)
+ (scale-channel y0 ramp-beg ramp-dur snd chn edpos)
+ (func y0 y1 ramp-beg ramp-dur snd chn edpos))
+ (set! ramp-beg (+ ramp-beg ramp-dur))))
+ origin))))))))
;;; -------- sine-ramp sine-env-channel
-(define* (sine-ramp rmp0 rmp1 (beg 0) dur snd chn edpos)
- "(sine-ramp rmp0 rmp1 (beg 0) dur snd chn edpos) produces a sinsusoidal connection from rmp0 to rmp1"
- ;; vct: angle incr off scl
- (ptree-channel
- (lambda (y data forward)
- (let* ((angle (data 0))
- (incr (data 1))
- (val (* y (+ (data 2) (* (data 3) (+ 0.5 (* 0.5 (cos angle))))))))
- ;; this could be optimized into offset=off+scl/2 and scl=scl/2, then (* y (+ off (* scl cos)))
- (if forward
- (set! (data 0) (+ angle incr))
- (set! (data 0) (- angle incr)))
- val))
- beg dur snd chn edpos #t
- (lambda (frag-beg frag-dur)
- (let ((incr (/ pi frag-dur)))
- (vct (+ (* -1.0 pi) (* frag-beg incr))
- incr
- rmp0
- (- rmp1 rmp0))))
- (format #f "sine-ramp ~A ~A ~A ~A" rmp0 rmp1 beg dur)))
-
-
-(define* (sine-env-channel env (beg 0) dur snd chn edpos)
- "(sine-env-channel env (beg 0) dur snd chn edpos) connects env's dots with sinusoids"
- (any-env-channel env sine-ramp beg dur snd chn edpos (format #f "sine-env-channel '~A ~A ~A" env beg dur)))
+(define sine-ramp
+ (let ((documentation "(sine-ramp rmp0 rmp1 (beg 0) dur snd chn edpos) produces a sinsusoidal connection from rmp0 to rmp1"))
+ (lambda* (rmp0 rmp1 (beg 0) dur snd chn edpos)
+ (let ((len (if (number? dur) dur (- (framples snd chn) beg))))
+ (let ((data (samples beg len snd chn edpos))
+ (incr (/ pi len))
+ (scl (* 0.5 (- rmp1 rmp0))))
+ (let ((off (+ rmp0 scl)))
+ (do ((i 0 (+ i 1))
+ (angle (- pi) (+ angle incr)))
+ ((= i len))
+ (float-vector-set! data i (* (float-vector-ref data i)
+ (+ off (* scl (cos angle)))))))
+ (float-vector->channel data
+ beg len snd chn current-edit-position
+ (format #f "sine-ramp ~A ~A ~A ~A" rmp0 rmp1 beg dur)))))))
+
+
+(define sine-env-channel
+ (let ((documentation "(sine-env-channel e (beg 0) dur snd chn edpos) connects e's dots with sinusoids"))
+ (lambda* (e (beg 0) dur snd chn edpos)
+ (any-env-channel e sine-ramp beg dur snd chn edpos (format #f "sine-env-channel '~A ~A ~A" e beg dur)))))
;;; (sine-env-channel '(0 0 1 1 2 -.5 3 1))
@@ -308,399 +301,304 @@ connects them with 'func', and applies the result as an amplitude envelope to th
;;; -------- blackman4-ramp, blackman4-env-channel
-(define* (blackman4-ramp rmp0 rmp1 (beg 0) dur snd chn edpos)
- "(blackman4-ramp rmp0 rmp1 (beg 0) dur snd chn edpos) produces a blackman4-shaped envelope"
- ;; vct: angle incr off scl
- (ptree-channel
- (lambda (y data forward)
- (let* ((angle (data 0))
- (incr (data 1))
- (cx (cos angle))
- (val (* y (+ (data 2)
- (* (data 3)
- (+ .084037 (* cx (+ -.29145 (* cx (+ .375696 (* cx (+ -.20762 (* cx .041194)))))))))))))
- ;; blackman2 would be: (+ .34401 (* cx (+ -.49755 (* cx .15844))))
- (if forward
- (set! (data 0) (+ angle incr))
- (set! (data 0) (- angle incr)))
- val))
- beg dur snd chn edpos #t
- (lambda (frag-beg frag-dur)
- (let ((incr (/ pi frag-dur)))
- (vct (* frag-beg incr)
- incr
- rmp0
- (- rmp1 rmp0))))
- (format #f "blackman4-ramp ~A ~A ~A ~A" rmp0 rmp1 beg dur)))
-
-
-(define* (blackman4-env-channel env (beg 0) dur snd chn edpos)
- "(blackman4-env-channel env (beg 0) dur snd chn edpos) uses the blackman4 window to connect the dots in 'env'"
- (any-env-channel env blackman4-ramp beg dur snd chn edpos (format #f "blackman4-env-channel '~A ~A ~A" env beg dur)))
-
-;;; any curve can be used as the connecting line between envelope breakpoints in the
-;;; same manner -- set up each ramp to take the current position and increment,
-;;; then return the value in ptree-channel. A simple one would have a table of
-;;; values and use array-interp.
+(define blackman4-ramp
+ (let ((documentation "(blackman4-ramp rmp0 rmp1 (beg 0) dur snd chn edpos) produces a blackman4-shaped envelope"))
+ (lambda* (rmp0 rmp1 (beg 0) dur snd chn edpos)
+ ;; float-vector: angle incr off scl
+ (let ((len (if (number? dur) dur (- (framples snd chn) beg))))
+ (let ((incr (/ pi len))
+ (data (samples beg len snd chn edpos))
+ (coeffs (float-vector-scale! (float-vector 0.084037 -.29145 .375696 -.20762 .041194) (- rmp1 rmp0))))
+ (float-vector-set! coeffs 0 (+ (float-vector-ref coeffs 0) rmp0))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle incr)))
+ ((= i len))
+ (float-vector-set! data i (* (float-vector-ref data i)
+ (polynomial coeffs (cos angle)))))
+ (float-vector->channel data beg len snd chn current-edit-position
+ (format #f "blackman4-ramp ~A ~A ~A ~A" rmp0 rmp1 beg dur)))))))
+
+
+(define blackman4-env-channel
+ (let ((documentation "(blackman4-env-channel e (beg 0) dur snd chn edpos) uses the blackman4 window to connect the dots in 'e'"))
+ (lambda* (e (beg 0) dur snd chn edpos)
+ (any-env-channel e blackman4-ramp beg dur snd chn edpos (format #f "blackman4-env-channel '~A ~A ~A" e beg dur)))))
+
;;; -------- ramp-squared, env-squared-channel
-(define* (ramp-squared rmp0 rmp1 (symmetric #t) (beg 0) dur snd chn edpos)
- "(ramp-squared rmp0 rmp1 (symmetric #t) (beg 0) dur snd chn edpos) connects rmp0 and rmp1 with an x^2 curve"
- ;; vct: start incr off scl
- (ptree-channel
- (lambda (y data forward)
- (let* ((angle (data 0))
- (incr (data 1))
- (val (* y (+ (data 2) (* angle angle (data 3))))))
- (if forward
- (set! (data 0) (+ angle incr))
- (set! (data 0) (- angle incr)))
- val))
- beg dur snd chn edpos #t
- (lambda (frag-beg frag-dur)
- (let ((incr (/ 1.0 frag-dur)))
- (if (and symmetric
- (< rmp1 rmp0))
- (vct (* (- frag-dur frag-beg) incr) (- incr) rmp1 (- rmp0 rmp1))
- (vct (* frag-beg incr) incr rmp0 (- rmp1 rmp0)))))
- (format #f "ramp-squared ~A ~A ~A ~A ~A" rmp0 rmp1 symmetric beg dur)))
-
-
-(define* (env-squared-channel env (symmetric #t) (beg 0) dur snd chn edpos)
- "(env-squared-channel env (symmetric #t) (beg 0) dur snd chn edpos) connects env's dots with x^2 curves"
- (any-env-channel env
- (lambda (r0 r1 b d s c e)
- (ramp-squared r0 r1 symmetric b d s c e))
- beg dur snd chn edpos
- (format #f "env-squared-channel '~A ~A ~A ~A" env symmetric beg dur)))
+(define ramp-squared
+ (let ((documentation "(ramp-squared rmp0 rmp1 (symmetric #t) (beg 0) dur snd chn edpos) connects rmp0 and rmp1 with an x^2 curve"))
+ (lambda* (rmp0 rmp1 (symmetric #t) (beg 0) dur snd chn edpos)
+ ;; float-vector: start incr off scl
+ (let ((len (if (number? dur) dur (- (framples snd chn) beg))))
+ (let ((incr (/ 1.0 len))
+ (data (samples beg len snd chn edpos))
+ (scl (- rmp1 rmp0)))
+ (if (and symmetric
+ (< rmp1 rmp0))
+ (begin
+ (set! scl (- scl))
+ (do ((i 0 (+ i 1))
+ (angle 1.0 (- angle incr)))
+ ((= i len))
+ (float-vector-set! data i (* (float-vector-ref data i)
+ (+ rmp1 (* scl angle angle))))))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle incr)))
+ ((= i len))
+ (float-vector-set! data i (* (float-vector-ref data i)
+ (+ rmp0 (* scl angle angle))))))
+ (float-vector->channel data beg len snd chn current-edit-position
+ (format #f "ramp-squared ~A ~A ~A ~A ~A" rmp0 rmp1 symmetric beg dur)))))))
+
+
+(define env-squared-channel
+ (let ((documentation "(env-squared-channel e (symmetric #t) (beg 0) dur snd chn edpos) connects e's dots with x^2 curves"))
+ (lambda* (e (symmetric #t) (beg 0) dur snd chn edpos)
+ (any-env-channel e
+ (lambda (r0 r1 b d s c e)
+ (ramp-squared r0 r1 symmetric b d s c e))
+ beg dur snd chn edpos
+ (format #f "env-squared-channel '~A ~A ~A ~A" e symmetric beg dur)))))
;;; (env-squared-channel '(0 0 1 1 2 -.5 3 1))
;;; -------- ramp-expt, env-expt-channel
-(define* (ramp-expt rmp0 rmp1 exponent (symmetric #t) (beg 0) dur snd chn edpos)
- "(ramp-expt rmp0 rmp1 exponent (symmetric #t) (beg 0) dur snd chn edpos) connects rmp0 and rmp1 with an x^exponent curve"
- ;; vct: start incr off scl exponent
- ;; a^x = exp(x * log(a))
- (ptree-channel
- (lambda (y data forward)
- (let* ((angle (data 0))
- (incr (data 1))
- (val (* y (+ (data 2) (* (exp (* (log angle) (data 4))) (data 3))))))
- (if forward
- (set! (data 0) (+ angle incr))
- (set! (data 0) (- angle incr)))
- val))
- beg dur snd chn edpos #t
- (lambda (frag-beg frag-dur)
- (let ((incr (/ 1.0 frag-dur)))
- (if (and symmetric
- (< rmp1 rmp0))
- (vct (* (- frag-dur frag-beg) incr) (- incr) rmp1 (- rmp0 rmp1) exponent)
- (vct (* frag-beg incr) incr rmp0 (- rmp1 rmp0) exponent))))
- (format #f "ramp-expt ~A ~A ~A ~A ~A ~A" rmp0 rmp1 exponent symmetric beg dur)))
-
-
-(define* (env-expt-channel env exponent (symmetric #t) (beg 0) dur snd chn edpos)
- "(env-expt-channel env exponent (symmetric #t) (beg 0) dur snd chn edpos) connects env's dots with x^exponent curves"
- (if (= exponent 1.0)
- (env-channel env beg dur snd chn edpos)
- (any-env-channel env
- (lambda (r0 r1 b d s c e)
- (ramp-expt r0 r1 exponent symmetric b d s c e))
- beg dur snd chn edpos
- (format #f "env-expt-channel '~A ~A ~A ~A ~A" env exponent symmetric beg dur))))
+(define ramp-expt
+ (let ((documentation "(ramp-expt rmp0 rmp1 exponent (symmetric #t) (beg 0) dur snd chn edpos) connects rmp0 and rmp1 with an x^exponent curve"))
+ (lambda* (rmp0 rmp1 exponent (symmetric #t) (beg 0) dur snd chn edpos)
+ ;; float-vector: start incr off scl exponent
+ ;; a^x = exp(x * log(a))
+ (let ((len (if (number? dur) dur (- (framples snd chn) beg))))
+ (let ((incr (/ 1.0 len))
+ (data (samples beg len snd chn edpos))
+ (scl (- rmp1 rmp0)))
+ (if (and symmetric
+ (< rmp1 rmp0))
+ (begin
+ (set! scl (- scl))
+ (do ((i 0 (+ i 1))
+ (angle 1.0 (- angle incr)))
+ ((= i len))
+ (float-vector-set! data i (* (float-vector-ref data i)
+ (+ rmp1 (* scl (expt angle exponent)))))))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle incr)))
+ ((= i len))
+ (float-vector-set! data i (* (float-vector-ref data i)
+ (+ rmp0 (* scl (expt angle exponent)))))))
+ (float-vector->channel data beg len snd chn current-edit-position
+ (format #f "ramp-expt ~A ~A ~A ~A ~A ~A" rmp0 rmp1 exponent symmetric beg dur)))))))
+
+
+(define env-expt-channel
+ (let ((documentation "(env-expt-channel e exponent (symmetric #t) (beg 0) dur snd chn edpos) connects e's dots with x^exponent curves"))
+ (lambda* (e exponent (symmetric #t) (beg 0) dur snd chn edpos)
+ (if (= exponent 1.0)
+ (env-channel e beg dur snd chn edpos)
+ (any-env-channel e
+ (lambda (r0 r1 b d s c e)
+ (ramp-expt r0 r1 exponent symmetric b d s c e))
+ beg dur snd chn edpos
+ (format #f "env-expt-channel '~A ~A ~A ~A ~A" e exponent symmetric beg dur))))))
;;; -------- offset-channel
-(define* (offset-channel dc (beg 0) dur snd chn edpos)
- "(offset-channel amount (beg 0) dur snd chn edpos) adds amount to each sample"
- (ptree-channel (lambda (y) (+ y dc)) beg dur snd chn edpos #t #f
- (format #f "offset-channel ~A ~A ~A" dc beg dur)))
+(define offset-channel
+ (let ((documentation "(offset-channel amount (beg 0) dur snd chn edpos) adds amount to each sample"))
+ (lambda* (dc (beg 0) dur snd chn edpos)
+ (let ((len (if (number? dur) dur (- (framples snd chn) beg))))
+ (float-vector->channel (float-vector-offset! (samples beg len snd chn edpos) dc)
+ beg len snd chn current-edit-position (format #f "offset-channel ~A ~A ~A" dc beg dur))))))
-(define* (offset-sound off (beg 0) dur snd)
- "(offset-sound off beg dur snd) adds 'off' to every sample in 'snd'"
- ;; the pretty but slow way:
- ;; (map-sound (lambda (fr) (frame+ fr off)) beg dur snd)
- ;;
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (sound? index)
- (let* ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (offset-channel off beg dur index chn)))
- (throw 'no-such-sound (list "offset-sound" snd)))))
+(define offset-sound
+ (let ((documentation "(offset-sound off beg dur snd) adds 'off' to every sample in 'snd'"))
+ (lambda* (off (beg 0) dur snd)
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (sound? index)
+ (let ((out-chans (channels index)))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (offset-channel off beg dur index chn)))
+ (error 'no-such-sound "offset-sound: no such sound: ~A" snd))))))
;;; -------- pad-sound
-(define* (pad-sound beg dur snd)
- "(pad-sound beg dur snd) places a block of 'dur' zeros in every channel of 'snd' starting at 'beg'"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (sound? index)
- (let* ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (pad-channel beg dur index chn)))
- (throw 'no-such-sound (list "pad-sound" snd)))))
+(define pad-sound
+ (let ((documentation "(pad-sound beg dur snd) places a block of 'dur' zeros in every channel of 'snd' starting at 'beg'"))
+ (lambda* (beg dur snd)
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (sound? index)
+ (let ((out-chans (channels index)))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (pad-channel beg dur index chn)))
+ (error 'no-such-sound "pad-sound: no such sound: ~A" snd))))))
;;; -------- dither-channel
-(define* (dither-channel (amount .00006) (beg 0) dur snd chn edpos)
- "(dither-channel (amount .00006) (beg 0) dur snd chn edpos) adds amount dither to each sample"
- (let ((dither (* .5 amount)))
- (ptree-channel (lambda (y) (+ y (mus-random dither) (mus-random dither))) beg dur snd chn edpos #t #f
- (format #f "dither-channel ~,8F ~A ~A" amount beg dur))))
-
-
-(define* (dither-sound (amount .00006) (beg 0) dur snd)
- "(dither-sound (amount .00006) beg dur snd) adds dithering to every channel of 'snd'"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (sound? index)
- (let* ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (dither-channel amount beg dur index chn)))
- (throw 'no-such-sound (list "dither-sound" snd)))))
+(define dither-channel
+ (let ((documentation "(dither-channel (amount .00006) (beg 0) dur snd chn edpos) adds amount dither to each sample"))
+ (lambda* ((amount .00006) (beg 0) dur snd chn edpos)
+ (let ((dither (* .5 amount)))
+ (let* ((len (if (number? dur) dur (- (framples snd chn) beg)))
+ (data (samples beg len snd chn edpos)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! data i (+ (float-vector-ref data i) (mus-random dither) (mus-random dither))))
+ (float-vector->channel data beg len snd chn current-edit-position
+ (format #f "dither-channel ~,8F ~A ~A" amount beg dur)))))))
+
+
+(define dither-sound
+ (let ((documentation "(dither-sound (amount .00006) beg dur snd) adds dithering to every channel of 'snd'"))
+ (lambda* ((amount .00006) (beg 0) dur snd)
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (sound? index)
+ (let ((out-chans (channels index)))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (dither-channel amount beg dur index chn)))
+ (error 'no-such-sound "dither-sound: no such sound: ~A" snd))))))
;;; -------- contrast-channel
-(define* (contrast-channel index (beg 0) dur snd chn edpos)
- "(contrast-channel index (beg 0) dur snd chn edpos) applies contrast enhancement to the sound"
- (ptree-channel
- (lambda (y)
- (sin (+ (* y 0.5 pi) (* index (sin (* y 2.0 pi))))))
- beg dur snd chn edpos #f #f
- (format #f "contrast-channel ~A ~A ~A" index beg dur)))
-
-
-(define* (contrast-sound index (beg 0) dur snd)
- "(contrast-sound index beg dur snd) applies contrast-enhancement to every channel of 'snd'"
- (let ((ind (or snd (selected-sound) (car (sounds)))))
- (if (sound? ind)
- (let* ((out-chans (channels ind)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (contrast-channel index beg dur ind chn)))
- (throw 'no-such-sound (list "contrast-sound" snd)))))
+(define contrast-channel
+ (let ((documentation "(contrast-channel index (beg 0) dur snd chn edpos) applies contrast enhancement to the sound"))
+ (lambda* (index (beg 0) dur snd chn edpos)
+ (let* ((len (if (number? dur) dur (- (framples snd chn) beg)))
+ (data (samples beg len snd chn edpos)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! data i (contrast-enhancement (float-vector-ref data i) index))) ; (sin (+ (* 0.5 pi y) (* index (sin (* 2.0 pi y))))))))
+ (float-vector->channel data beg len snd chn current-edit-position
+ (format #f "contrast-channel ~A ~A ~A" index beg dur))))))
+
+
+(define contrast-sound
+ (let ((documentation "(contrast-sound index beg dur snd) applies contrast-enhancement to every channel of 'snd'"))
+ (lambda* (index (beg 0) dur snd)
+ (let ((ind (or snd (selected-sound) (car (sounds)))))
+ (if (sound? ind)
+ (let ((out-chans (channels ind)))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (contrast-channel index beg dur ind chn)))
+ (error 'no-such-sound "contrast-sound: no such sound: ~A" snd))))))
;;; -------- scale-sound
-(define* (scale-sound scl (beg 0) dur snd)
- "(scale-sound scl beg dur snd) multiplies every sample in 'snd' by 'scl'"
- ;; the slow way:
- ;; (map-sound (lambda (fr) (frame* fr scl)) beg dur snd))
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (sound? index)
- (let* ((out-chans (channels index)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (scale-channel scl beg dur index chn)))
- (throw 'no-such-sound (list "scale-sound" snd)))))
+(define scale-sound
+ (let ((documentation "(scale-sound scl beg dur snd) multiplies every sample in 'snd' by 'scl'"))
+ (lambda* (scl (beg 0) dur snd)
+ ;; the slow way:
+ ;; (map-sound (lambda (fr) (frame* fr scl)) beg dur snd))
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (sound? index)
+ (let ((out-chans (channels index)))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (scale-channel scl beg dur index chn)))
+ (error 'no-such-sound "scale-sound: no such sound: ~A" snd))))))
;;; -------- normalize-sound
-(define* (normalize-sound amp (beg 0) dur snd)
- "(normalize-sound amp beg dur snd) scales 'snd' to peak amplitude 'amp'"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (sound? index)
- (let* ((out-chans (channels index))
- (mx (apply max (maxamp index #t))))
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (scale-channel (/ amp mx) beg dur index chn)))
- (throw 'no-such-sound (list "normalize-sound" snd)))))
+(define normalize-sound
+ (let ((documentation "(normalize-sound amp beg dur snd) scales 'snd' to peak amplitude 'amp'"))
+ (lambda* (amp (beg 0) dur snd)
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (sound? index)
+ (let ((out-chans (channels index))
+ (mx (apply max (maxamp index #t))))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn out-chans))
+ (scale-channel (/ amp mx) beg dur index chn)))
+ (error 'no-such-sound "normalize-sound: no such sound: ~A" snd))))))
-#|
-;;; -------- delay-channel
-;;;
-;;; this is ok going forward (I think), but not in reverse
-
-(define* (delay-channel dly (beg 0) dur snd chn edpos)
- "(delay-channel amount (beg 0) dur snd chn edpos) implements a delay using virtual edits"
- (let ((cur-edpos (if (or (not edpos)
- (= edpos current-edit-position))
- (edit-position snd chn)
- edpos)))
- (ptree-channel (lambda (y data dir)
- (let* ((pos (floor (data 0)))
- (len (floor (data 1)))
- (val (data (+ pos 2))))
- (set! (data (+ pos 2)) y)
- (set! pos (+ 1 pos))
- (if (>= pos len) (set! (data 0) 0) (set! (data 0) pos))
- val))
- beg dur snd chn edpos #f
- (lambda (fpos fdur)
- (let ((data (make-vct (+ dly 2))))
- (set! (data 0) 0.0)
- (set! (data 1) dly)
- (if (= fpos 0)
- data
- (let* ((reader (make-sampler (- fpos 1) snd chn -1 cur-edpos)))
- (do ((i (- dly 1) (- i 1)))
- ((< i 0))
- (set! (data (+ i 2)) (reader)))
- data)))))))
-|#
-
;;; -------- channels-equal
-(define* (channels=? snd1 chn1 snd2 chn2 (allowable-difference 0.0))
- "(channels=? s1 c1 s2 c2 (diff 0.0)) -> #t if the two channels are the same (within diff) modulo trailing 0's"
- (if (and (equal? snd1 snd2)
- (= chn1 chn2))
- #t
- (let ((mx1 (maxamp snd1 chn1))
- (mx2 (maxamp snd1 chn1)))
- (if (> (abs (- mx1 mx2)) allowable-difference)
- #f
- (let* ((len1 (frames snd1 chn1))
- (len2 (frames snd2 chn2))
- (first-longer (>= len1 len2))
- (len (if first-longer len1 len2))
- (s1 (if first-longer snd1 snd2))
- (s2 (if first-longer snd2 snd1))
- (c1 (if first-longer chn1 chn2))
- (c2 (if first-longer chn2 chn1))
- (read2 (make-sampler 0 s2 c2)))
- (not (scan-channel (lambda (y)
- (let ((val (read-sample read2)))
- (> (abs (- val y)) allowable-difference)))
- 0 len s1 c1)))))))
-
-
-(define* (channels-equal? snd1 chn1 snd2 chn2 (allowable-difference 0.0))
- "(channels-equal? s1 c1 s2 c2 (diff 0.0)) -> #t if the two channels are the same (within diff)"
- (let ((len1 (frames snd1 chn1))
- (len2 (frames snd2 chn2)))
- (if (not (= len1 len2))
- #f
- (channels=? snd1 chn1 snd2 chn2 allowable-difference))))
+(define channels=?
+ (let ((documentation "(channels=? s1 c1 s2 c2 (diff 0.0)) -> #t if the two channels are the same (within diff) modulo trailing 0's"))
+ (lambda* (snd1 (chn1 0) snd2 (chn2 0) (allowable-difference 0.0))
+ (or (and (equal? snd1 snd2)
+ (= chn1 chn2))
+ (let ((mx1 (maxamp snd1 chn1))
+ (mx2 (maxamp snd1 chn1)))
+ (and (<= (abs (- mx1 mx2)) allowable-difference)
+ (let* ((len1 (framples snd1 chn1))
+ (len2 (framples snd2 chn2))
+ (first-longer (>= len1 len2)))
+ (let ((len (if first-longer len1 len2))
+ (s1 (if first-longer snd1 snd2))
+ (s2 (if first-longer snd2 snd1))
+ (c1 (if first-longer chn1 chn2))
+ (c2 (if first-longer chn2 chn1)))
+ (let ((v0 (channel->float-vector 0 len s1 c1))
+ (v1 (channel->float-vector 0 len s2 c2)))
+ (<= (float-vector-peak (float-vector-subtract! v0 v1)) allowable-difference))))))))))
+
+
+(define channels-equal?
+ (let ((documentation "(channels-equal? s1 c1 s2 c2 (diff 0.0)) -> #t if the two channels are the same (within diff)"))
+ (lambda* (snd1 chn1 snd2 chn2 (allowable-difference 0.0))
+ (let ((len1 (framples snd1 chn1))
+ (len2 (framples snd2 chn2)))
+ (and (= len1 len2)
+ (channels=? snd1 chn1 snd2 chn2 allowable-difference))))))
;;; -------- mono->stereo, mono-files->stereo
-(define (mono->stereo new-name snd1 chn1 snd2 chn2)
- "(mono->stereo new-name snd1 chn1 snd2 chn2) takes the two channels and combines them into a stereo sound 'new-name'"
- ;; (mono->stereo "test.snd" 0 0 1 0)
- (let ((old-ed1 (edit-position snd1 chn1))
- (old-ed2 (edit-position snd2 chn2))
- (ind (new-sound new-name :channels 2 :srate (srate snd1))))
- (swap-channels ind 0 snd1 chn1)
- (swap-channels ind 1 snd2 chn2)
- (set! (edit-position snd1 chn1) old-ed1)
- (set! (edit-position snd2 chn2) old-ed2)
- ind))
-
-
-(define (mono-files->stereo new-name chan1-name chan2-name)
- "(mono-files->stereo new-name file1 file2) combines two mono files into the stereo file 'new-name'"
- ;; (mono-files->stereo "test.snd" "oboe.snd" "pistol.snd")
- (let* ((ind1 (open-sound chan1-name))
- (ind2 (open-sound chan2-name))
- (ind3 (mono->stereo new-name ind1 0 ind2 0)))
- (close-sound ind1)
- (close-sound ind2)
- ind3))
-
-
-(define (stereo->mono orig-snd chan1-name chan2-name)
- "(stereo->mono stereo-sound new-chan1 new-chan2) splits a stereo sound into two mono sounds named 'new-chan1' and 'new-chan2'"
- ;; (stereo->mono 0 "hi1.snd" "hi2.snd")
- (let ((old-ed0 (edit-position orig-snd 0))
- (old-ed1 (edit-position orig-snd 1))
- (chan1 (new-sound chan1-name :srate (srate orig-snd)))
- (chan2 (new-sound chan2-name :srate (srate orig-snd))))
- (swap-channels orig-snd 0 chan1 0)
- (swap-channels orig-snd 1 chan2 0)
- (set! (edit-position orig-snd 0) old-ed0)
- (set! (edit-position orig-snd 1) old-ed1)
- (list chan1 chan2)))
-
-
-
-
-;;; -------- with-threaded-channels
-;;;
-;;; experimental!
-
-(define (with-threaded-channels func)
- (let ((chns (chans)))
- (if (and (provided? 'snd-threads)
- (not (provided? 'gmp))
- (provided? 'snd-nogui))
-
- ;; use threads (s7 only)
- (let ((threads '()))
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (let ((lchn chn))
- (set! threads (cons (make-thread
- (lambda ()
- (func lchn)))
- threads))))
- (for-each
- (lambda (expr)
- (join-thread expr))
- threads))
-
- ;; else do it the normal way
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (func chn)))))
-
+(define mono->stereo
+ (let ((documentation "(mono->stereo new-name snd1 chn1 snd2 chn2) takes the two channels and combines them into a stereo sound 'new-name'"))
+ (lambda (new-name snd1 chn1 snd2 chn2)
+ ;; (mono->stereo "test.snd" 0 0 1 0)
+ (let ((old-ed1 (edit-position snd1 chn1))
+ (old-ed2 (edit-position snd2 chn2))
+ (ind (new-sound new-name :channels 2 :srate (srate snd1))))
+ (swap-channels ind 0 snd1 chn1)
+ (swap-channels ind 1 snd2 chn2)
+ (set! (edit-position snd1 chn1) old-ed1)
+ (set! (edit-position snd2 chn2) old-ed2)
+ ind))))
+
+
+(define mono-files->stereo
+ (let ((documentation "(mono-files->stereo new-name file1 file2) combines two mono files into the stereo file 'new-name'"))
+ (lambda (new-name chan1-name chan2-name)
+ ;; (mono-files->stereo "test.snd" "oboe.snd" "pistol.snd")
+ (let* ((ind1 (open-sound chan1-name))
+ (ind2 (open-sound chan2-name))
+ (ind3 (mono->stereo new-name ind1 0 ind2 0)))
+ (close-sound ind1)
+ (close-sound ind2)
+ ind3))))
+
+
+(define stereo->mono
+ (let ((documentation "(stereo->mono stereo-sound new-chan1 new-chan2) splits a stereo sound into two mono sounds named 'new-chan1' and 'new-chan2'"))
+ (lambda (orig-snd chan1-name chan2-name)
+ ;; (stereo->mono 0 "hi1.snd" "hi2.snd")
+ (let ((old-ed0 (edit-position orig-snd 0))
+ (old-ed1 (edit-position orig-snd 1))
+ (chan1 (new-sound chan1-name :srate (srate orig-snd)))
+ (chan2 (new-sound chan2-name :srate (srate orig-snd))))
+ (swap-channels orig-snd 0 chan1 0)
+ (swap-channels orig-snd 1 chan2 0)
+ (set! (edit-position orig-snd 0) old-ed0)
+ (set! (edit-position orig-snd 1) old-ed1)
+ (list chan1 chan2)))))
-;;; -------- profiling
-
-(define* (profile (file "sort.data"))
- ;; find all functions, write out each one's number of calls, sorted first by calls, then alphabetically
-
- (define (where-is func)
- (let* ((env (procedure-environment func))
- (cenv (and (pair? env)
- (car env)))
- (f (and (pair? cenv)
- (assoc '__func__ cenv)))
- (addr (and (pair? f)
- (cdr f))))
- (if (not (pair? addr))
- ""
- (format #f "~A[~D]" (cadr addr) (caddr addr)))))
-
- (if (provided? 'profiling)
- (let ((st (symbol-table))
- (calls (make-vector 50000 '(none (0 #f))))
- (call 0))
- (do ((i 0 (+ i 1)))
- ((= i (length st)))
- (let ((lst (st i)))
- (for-each
- (lambda (sym)
- (if (and (defined? sym)
- (procedure? (symbol->value sym)))
- (begin
- (set! (calls call) (list sym (symbol-calls sym)))
- (set! call (+ call 1)))))
- lst)))
-
- (set! calls (sort! calls (lambda (a b) (> (caadr a) (caadr b)))))
-
- (with-output-to-file file
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i call))
- (let ((c (calls i)))
- (if (not (eq? (car c) 'none))
- (format #t "~A:~40T~A~60T~A~%" (car c) (caadr c) (where-is (car c)))))))))))
diff --git a/extsnd.html b/extsnd.html
index 57fe4f5..2d46494 100644
--- a/extsnd.html
+++ b/extsnd.html
@@ -1,59 +1,177 @@
-<html>
+<!DOCTYPE html>
+
+<html lang="en">
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>Snd Customization and Extension</title>
<style type="text/css">
-<!--
EM.red {color:red; font-style: normal}
EM.error {color:chocolate; font-style: normal}
- EM.narg {color:sienna; font-style: normal}
- EM.typing {color:maroon; font-style: normal}
- EM.listener {color:darkblue; font-style: normal}
+
H1 {text-align: center}
UL {list-style-type: none}
EM.emdef {font-weight: bold; font-style: normal; padding-right: 0.2cm}
+ EM.noem {font-style: normal}
A {text-decoration:none}
A:hover {text-decoration:underline}
A.quiet {color:black; text-decoration:none}
A.quiet:hover {text-decoration:underline}
- A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black; padding-right: 0.2cm}
--->
+
+ EM.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black; padding-right: 0.2cm}
+
+ TD.green {background-color: lightgreen}
+ TD.bluish {background-color: #f2f4ff}
+ TD.beige {background-color: beige}
+ TD.greenish {background-color: #eefdee}
+
+ PRE.indented {padding-left: 1.0cm}
+ IMG.indented {padding-left: 1.0cm}
+ IMG.noborder {border: none}
+
+ DIV.center {text-align: center}
+ BODY.body {background-color: #ffffff; /* white */
+ margin-left: 0.5cm;
+ margin-right: 0.5cm;
+ }
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.header {margin-top: 50px;
+ margin-bottom: 10px;
+ font-size: 20px;
+ font-weight: bold;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ text-align: center;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.innerheader {margin-top: 60px;
+ margin-bottom: 30px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #eefdee; /* lightgreen */
+ padding-left: 30px;
+ width: 50%;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.innermostheader {margin-top: 30px;
+ margin-bottom: 10px;
+ border: 1px solid lightgray;
+ background-color: #f0f0f0;
+ padding-left: 30px;
+ width: 30%;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.related {text-align:center;
+ border: 1px solid lightgray;
+ margin-bottom: 1.0cm;
+ margin-top: 1.0cm;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ background-color: #f0f0f0;
+ }
+ TABLE.grayborder {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 1.0cm;
+ border: 8px solid gray;
+ padding-left: 0.1cm;
+ padding-right: 0.1cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TABLE.method {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 1.0cm;
+ border: 1px solid gray;
+ padding-left: 0.1cm;
+ padding-right: 0.1cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TH.title {background-color: lightgreen;
+ border: 1px solid gray;
+ padding-top: 0.2cm;
+ padding-bottom: 0.2cm;
+ text-align: center;
+ }
+ DIV.scheme {background-color: #f2f4ff;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.ruby {background-color: #fbfbf0;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.forth {background-color: #eefdee;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.scheme1 {background-color: #f2f4ff;
+ border: 1px solid lightgray;
+ padding-right: 0.1cm;
+ padding-left: 0.25cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.ruby1 {background-color: #fbfbf0;
+ border: 1px solid lightgray;
+ padding-right: 0.1cm;
+ padding-left: 0.25cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.forth1 {background-color: #eefdee;
+ border: 1px solid lightgray;
+ padding-right: 0.1cm;
+ padding-left: 0.25cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.spacer {margin-top: 1.0cm;
+ }
+ DIV.separator {margin-top: 40px;
+ margin-bottom: 15px;
+ border: 2px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ padding-top: 4px;
+ width: 30%;
+ border-radius: 4px;
+ -moz-border-radius: 4px;
+ -webkit-border-radius: 4px;
+ }
+ #contents_table tbody tr:nth-child(odd) { background-color: #f2f4ff; }
</style>
</head>
-<body bgcolor=white>
+<body class="body">
-<script language=JavaScript type="text/javascript" src="wz_tooltip.js"></script>
-<script language=JavaScript type="text/javascript" src="wz_data.js"></script>
-
-<!-- I'm using A NAME (i.e caps) where the entity should be ignored by the indexer (make-index.scm) -->
-
-<A NAME="extsndcontents"></a>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr>
-<td bgcolor="beige" align="center" valign="middle"><h1>Snd Customization and Extension</h1></td>
-</tr></table>
-</td></tr></table>
-<br>
+<div class="topheader" id="extsndcontents">Snd Customization and Extension</div>
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tips extension language')">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="fm.html">fm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
-<table border=0 cellpadding=10 vspace=10 hspace=20>
-<tr><th>this file:</th><th>grfsnd.html:</th></tr>
+<table>
+<tr><th>this file:</th><th>grfsnd.html:</th><th></th></tr>
<tr><td>
<ul>
<li><a href="#lisplistener">Introduction</a>
@@ -63,25 +181,24 @@
<ul>
<li><a href="#sndglobalvars">Global variables</a>
<li><a href="#sndgenericfuncs">Generic functions</a>
- <li><a href="#sndhooks" onmouseout="UnTip()" onmouseover="Tip('callbacks')">Hooks</a>
+ <li><a href="#sndhooks">Hooks</a>
</ul>
<li><a href="#sndobjects">Snd's objects</a>
<ul>
- <li><a href="#samplers" onmouseout="UnTip()" onmouseover="Tip('sound data iterators', WIDTH, 200)">Samplers</a>
- <li><a href="#Vcts" onmouseout="UnTip()" onmouseover="Tip('real arrays', WIDTH, 100)">Vcts</a>
- <li><a href="#sndsounddata" onmouseout="UnTip()" onmouseover="Tip('arrays of vcts for multichannel data')">Sound-data</a>
- <li><a href="#extsndlib" onmouseout="UnTip()" onmouseover="Tip('the underlying library that handles sound data and files')">Sndlib</a>
- <li><a href="#sndmarks" onmouseout="UnTip()" onmouseover="Tip('location markers in sound data')">Marks</a>
- <li><a href="#sndmixes" onmouseout="UnTip()" onmouseover="Tip('mixed sounds and groups of mixed sounds')">Mixes</a>
- <li><a href="#sndregions" onmouseout="UnTip()" onmouseover="Tip('selected or saved portions of sound data')">Regions and Selections</a>
- <li><a href="#sndsounds" onmouseout="UnTip()" onmouseover="Tip('editing functions, per-channel display decisions, etc')">Sounds and channels</a>
+ <li><a href="#samplers">Samplers</a>
+ <li><a href="#Vcts">Vcts, Float-vectors</a>
+ <li><a href="#extsndlib">Sndlib</a>
+ <li><a href="#sndmarks">Marks</a>
+ <li><a href="#sndmixes">Mixes</a>
+ <li><a href="#sndregions">Regions and Selections</a>
+ <li><a href="#sndsounds">Sounds and channels</a>
<ul>
- <li><a href="#customcontrols" onmouseout="UnTip()" onmouseover="Tip('a set of common sound effects below the main graph')">the control panel</a>
- <li><a href="#editlists" onmouseout="UnTip()" onmouseover="Tip('current edit sequence', WIDTH, 200)">edit lists</a>
+ <li><a href="#customcontrols">the control panel</a>
+ <li><a href="#editlists">edit lists</a>
</ul>
- <li><a href="#sndtransforms" onmouseout="UnTip()" onmouseover="Tip('Fourier transform, wavelets, autocorelation, etc')">Transforms</a>
- <li><a href="#snddialogs" onmouseout="UnTip()" onmouseover="Tip('customizing the built-in dialogs, etc')">Dialogs and Other Widgets</a>
- <li><a href="#sndmisc" onmouseout="UnTip()" onmouseover="Tip('bind-key, exit, etc')">Miscellaneous functions</a>
+ <li><a href="#sndtransforms">Transforms</a>
+ <li><a href="#snddialogs">Dialogs and Other Widgets</a>
+ <li><a href="#sndmisc">Miscellaneous functions</a>
<li><a href="#sndconstants">Constants</a>
<li><a href="#snderrors">Errors and Debugging</a>
</ul>
@@ -89,7 +206,7 @@
<ul>
<li><a href="#colors">Colors</a>
<li><a href="#fonts">Fonts</a>
- <li><a href="#graphics" onmouseout="UnTip()" onmouseover="Tip('write your own sound display functions or customize Snd\'s')">Graphics</a>
+ <li><a href="#graphics">Graphics</a>
</ul>
</ul>
</ul>
@@ -98,43 +215,41 @@
<ul>
<li><a href="grfsnd.html#startup">Snd Startup</a>
<ul>
- <li><a href="grfsnd.html#sndswitches" onmouseout="UnTip()" onmouseover="Tip('startup switches such as -l and -p')">Snd invocation flags</a>
- <li><a href="grfsnd.html#sndinitfile" onmouseout="UnTip()" onmouseover="Tip('~/.snd, ~/.snd_s7, ~/.snd_prefs_s7, etc')">The initialization file</a>
- <li><a href="grfsnd.html#sndconfigurationswitches" onmouseout="UnTip()" onmouseover="Tip('this refers to the configure script that prepares a makefile to build Snd from its sources')">Configuration choices</a>
- <li><a href="grfsnd.html#sndenvvars" onmouseout="UnTip()" onmouseover="Tip('mostly related to audio hardware choices')">Environment variables</a>
+ <li><a href="grfsnd.html#sndswitches">Snd invocation flags</a>
+ <li><a href="grfsnd.html#sndinitfile">The initialization file</a>
+ <li><a href="grfsnd.html#sndconfigurationswitches">Configuration choices</a>
+ <li><a href="grfsnd.html#sndenvvars">Environment variables</a>
</ul>
<li><a href="grfsnd.html#snddynamic">Runtime modules and external programs</a>
<ul>
- <li><a href="grfsnd.html#emacssnd" onmouseout="UnTip()" onmouseover="Tip('Use Emacs as the listener')">Snd as an Emacs subjob</a>
- <li><a href="grfsnd.html#dynamic" onmouseout="UnTip()" onmouseover="Tip('Load your own C code into Snd')">Dynamically loaded modules</a>
- <li><a href="grfsnd.html#sndaswidget" onmouseout="UnTip()" onmouseover="Tip('Embed Snd in some other program')">Snd as a Widget</a>
- <li><a href="grfsnd.html#sndwithclm" onmouseout="UnTip()" onmouseover="Tip('CLM is built into Snd')">Snd and CLM</a>
- <li><a href="grfsnd.html#sndwithcm" onmouseout="UnTip()" onmouseover="Tip('CM is Rick Taube\'s composition environment')">Snd and Common Music</a>
- <li><a href="grfsnd.html#sndwithmotif" onmouseout="UnTip()" onmouseover="Tip('Motif extensions from xm.c')">Snd and Motif</a>
- <li><a href="grfsnd.html#sndwithgtk" onmouseout="UnTip()" onmouseover="Tip('Gtk extensions from xg.c')">Snd and Gtk</a>
+ <li><a href="grfsnd.html#emacssnd">Snd as an Emacs subjob</a>
+ <li><a href="grfsnd.html#dynamic">Dynamically loaded modules</a>
+ <li><a href="grfsnd.html#sndwithclm">Snd and CLM</a>
+ <li><a href="grfsnd.html#sndwithcm">Snd and Common Music</a>
+ <li><a href="grfsnd.html#sndwithmotif">Snd and Motif</a>
+ <li><a href="grfsnd.html#sndwithgtk">Snd and Gtk</a>
<li><a href="grfsnd.html#sndwithnogui">Snd with no GUI</a>
- <li><a href="grfsnd.html#sndandruby" onmouseout="UnTip()" onmouseover="Tip('Ruby is a scripting/extension language somewhat like Python')">Snd with Ruby</a>
- <li><a href="grfsnd.html#sndandforth" onmouseout="UnTip()" onmouseover="Tip('Forth is a postfix extension language')">Snd with Forth</a>
- <li><a href="grfsnd.html#sndands7" onmouseout="UnTip()" onmouseover="Tip('s7 is yet-another Scheme extension language')">Snd with s7</a>
- <li><a href="grfsnd.html#sndandladspa" onmouseout="UnTip()" onmouseover="Tip('This is a Linux-based sound-effects plugin system')">Snd and LADSPA plugins</a>
- <li><a href="grfsnd.html#sndandalsa" onmouseout="UnTip()" onmouseover="Tip('This is the no-longer-very-new Linux audio library')">Snd and ALSA</a>
- <li><a href="grfsnd.html#sndandjack" onmouseout="UnTip()" onmouseover="Tip('This is the Jack audio library')">Snd and Jack</a>
- <li><a href="grfsnd.html#sndandgl" onmouseout="UnTip()" onmouseover="Tip('OpenGL (Mesa) extensions via gl.c')">Snd and OpenGL</a>
- <li><a href="grfsnd.html#sndandgsl" onmouseout="UnTip()" onmouseover="Tip('include some special functions from GSL')">Snd and GSL</a>
- <li><a href="grfsnd.html#sndandgmp" onmouseout="UnTip()" onmouseover="Tip('build s7 with gmp, mpfr, mpc')">multiprecision arithmetic</a>
+ <li><a href="grfsnd.html#sndandruby">Snd with Ruby</a>
+ <li><a href="grfsnd.html#sndandforth">Snd with Forth</a>
+ <li><a href="grfsnd.html#sndands7">Snd with s7</a>
+ <li><a href="grfsnd.html#sndandladspa">Snd and LADSPA plugins</a>
+ <li><a href="grfsnd.html#sndandalsa">Snd and ALSA</a>
+ <li><a href="grfsnd.html#sndandjack">Snd and Jack</a>
+ <li><a href="grfsnd.html#sndandgl">Snd and OpenGL</a>
+ <li><a href="grfsnd.html#sndandgsl">Snd and GSL</a>
+ <li><a href="grfsnd.html#sndandgmp">multiprecision arithmetic</a>
</ul>
+ <li><a href="grfsnd.html#otherstuff">Other stuff</a>
<li><a href="index.html">Index</a>
</ul>
-</td><td><img src="pix/rr2.png" alt="setting switches">
+</td><td>
+<img src="pix/rr2.png" alt="setting switches">
</td></tr></table>
-<br><br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>Introduction</h2></td></tr></table>
-</td></tr></table>
-<A NAME="lisplistener"></a>
+
+<div class="header" id="lisplistener">Introduction</div>
<p>Snd is a highly customizable, extensible program.
I've tried to bring out to the extension language nearly every portion
@@ -150,6 +265,7 @@ from any other program (CLM and Emacs in particular),
embedded in a keyboard macro, or typed in the
listener.
</p>
+
<p>
The syntax used throughout this documentation is Scheme (a form of lisp) as implemented by s7.
You can also use Ruby or Forth, but need to make various minor <a href="grfsnd.html#sndandruby">changes</a>.
@@ -161,210 +277,129 @@ The easiest way to get acquainted
with this aspect of Snd is to open the listener
(via the View:Open listener menu option), and type
experiments in its window. Its prompt is ">". So,
-say we've opened the listener (my typing is
-in <em class=typing>this color</em> and Snd's responses
-are in <em class=listener>this color</em>):
+say we've opened the listener.
</p>
-<table border=0 cellspacing=10>
-<tr><th bgcolor="#f2f4ff" align=left>Scheme</th><th></th><th bgcolor="beige" align=left>Ruby</th><th></th><th bgcolor="lightgreen" align=left>Forth</th></tr>
-
-<tr>
-<td bgcolor="#fbfbff"><pre>
-><em class=typing>(+ 1 2)</em>
-<em class=listener>3</em>
-</pre></td><td width=60></td>
-
-<td bgcolor="#FdFdf2"><pre>
-><em class=typing>1+2</em>
-<em class=listener>3</em>
-</pre></td><td width=60></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>1 2 +</em>
-<em class=listener>3</em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
-<tr>
-<td bgcolor="#fbfbff" onmouseout="UnTip()" onmouseover="Tip('this opens oboe.snd; the "0" returned is the new sound\'s \'index\'')"><pre>
-><em class=typing>(open-sound "oboe.snd")</em>
-<em class=listener>#<sound 0></em>
-</pre></td><td></td>
-
-<td bgcolor="#FdFdf2"><pre>
-><em class=typing>open_sound("oboe.snd")</em>
-<em class=listener>0</em>
-</pre></td><td></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>"oboe.snd" open-sound</em>
-<em class=listener>0</em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
-<tr>
-<td bgcolor="#fbfbff" onmouseout="UnTip()" onmouseover="Tip('#t = true, #f = false in Scheme and Forth')"><pre>
-><em class=typing>(auto-resize)</em>
-<em class=listener>#t</em>
-</pre></td><td></td>
-
-<td bgcolor="#FdFdf2"><pre>
-><em class=typing>auto_resize</em>
-<em class=listener>true</em>
-</pre></td><td></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>auto-resize</em>
-<em class=listener>#t</em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
-<tr>
-<td bgcolor="#fbfbff"><pre>
-><em class=typing>(set! (auto-resize) #f)</em>
-<em class=listener>#f</em>
-</pre></td><td></td>
-
-<td bgcolor="#FdFdf2"><pre>
-><em class=typing>set_auto_resize false</em>
-<em class=listener>false</em>
-</pre></td><td></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>#f set-auto-resize</em>
-<em class=listener>#f</em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
-<tr>
-<td bgcolor="#fbfbff"><pre>
-><em class=typing>(set! (x-bounds) '(0.0 1.0))</em>
-<em class=listener>(0.0 1.0)</em>
-</pre></td><td></td>
-
-<td bgcolor="#FdFdf2" onmouseout="UnTip()" onmouseover="Tip('Ruby runs array elements together in printout: "0.01.0" should be "0.0 1.0"')"><pre>
-><em class=typing>set_x_bounds([0.0, 1.0])</em>
-<em class=listener>0.01.0</em>
-</pre></td><td></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>'( 0.0 1.0 ) set-x-bounds</em>
-<em class=listener>'( 0.0 1.0 )</em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
-<tr>
-<td bgcolor="#fbfbff" onmouseout="UnTip()" onmouseover="Tip('this is Scheme\'s way of saying the previous evaluation returned no newsworthy result.')"><pre>
-><em class=typing>(load "bird.scm")</em>
-<em class=listener>make-birds</em>
-</pre></td><td></td>
-
-<td bgcolor="#FdFdf2"><pre>
-><em class=typing>load "bird.rb"</em>
-<em class=listener>true</em>
-</pre></td><td></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>"bird.fs" file-eval</em>
-<em class=listener>0</em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
-<tr>
-<td bgcolor="#fbfbff"><pre>
-><em class=typing>(map-channel (lambda (y) (* y 2)))</em>
-<em class=listener>0</em>
-</pre></td><td></td>
-
-<td bgcolor="#FdFdf2"><pre>
-><em class=typing>map_channel(lambda do |y| y * 2 end)</em>
-<em class=listener>-0.0015869140625</em>
-</pre></td><td></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>lambda: <{ y }> y 2.0 f* ; map-channel</em>
-<em class=listener>-0.00158691</em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
-<tr>
-<td bgcolor="#fbfbff"><pre>
-><em class=typing>(define (plus a b) (+ a b))</em>
-<em class=listener>plus</em>
-</pre></td><td></td>
-
-<td bgcolor="#FdFdf2"><pre>
-><em class=typing>def plus(a, b) a+b end</em>
-
-</pre></td><td></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>: plus ( a b -- sum ) { a b } a b + ;</em>
-<em class=listener>nil</em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
-<tr>
-<td bgcolor="#fbfbff"><pre>
-><em class=typing>(set! (basic-color) (make-color 1 0 0))</em>
-<em class=listener>(Pixel 16711680)</em>
-</pre></td><td></td>
-
-<td bgcolor="#FdFdf2"><pre>
-><em class=typing>set_basic_color make_color(1, 0, 0)</em>
-<em class=listener>[:Pixel, 16711680]</em>
-</pre></td><td></td>
-
-<td bgcolor="#EefdEe"><pre>
-><em class=typing>1 0 0 make-color set-basic-color</em>
-<em class=listener>#<XmRaw: Pixel 0x9d3b430></em>
-</pre></td>
-</tr>
-<!-- ------------ -->
-
+<table>
+<tr><th>Scheme</th><th>Ruby</th><th>Forth</th></tr>
+
+<tr><td><div class="scheme1"><pre>
+> (+ 1 2)
+3
+</pre></div></td><td><div class="ruby1"><pre>
+>1+2
+3
+</pre></div></td><td><div class="forth1"><pre>
+>1 2 +
+3
+</pre></div></td></tr>
+
+<tr><td><div class="scheme1"><pre>
+> (open-sound "oboe.snd")
+#<sound 0>
+</pre></div></td><td><div class="ruby1"><pre>
+>open_sound("oboe.snd")
+0
+</pre></div></td><td><div class="forth1"><pre>
+>"oboe.snd" open-sound
+0
+</pre></div></td></tr>
+
+<tr><td><div class="scheme1"><pre>
+> (auto-resize)
+#t
+</pre></div></td><td><div class="ruby1"><pre>
+>auto_resize
+true
+</pre></div></td><td><div class="forth1"><pre>
+>auto-resize
+#t
+</pre></div></td></tr>
+
+
+
+<tr><td><div class="scheme1"><pre>
+> (set! (auto-resize) #f)
+#f
+</pre></div></td><td><div class="ruby1"><pre>
+>set_auto_resize false
+false
+</pre></div></td><td><div class="forth1"><pre>
+>#f set-auto-resize
+#f
+</pre></div></td></tr>
+
+<tr><td><div class="scheme1"><pre>
+> (set! (x-bounds) '(0.0 1.0))
+(0.0 1.0)
+</pre></div></td><td><div class="ruby1"><pre>
+>set_x_bounds([0.0, 1.0])
+0.01.0
+</pre></div></td><td><div class="forth1"><pre>
+>'( 0.0 1.0 ) set-x-bounds
+'( 0.0 1.0 )
+</pre></div></td></tr>
+
+<tr><td><div class="scheme1"><pre>
+> (load "bird.scm")
+make-birds
+</pre></div></td><td><div class="ruby1"><pre>
+>load "bird.rb"
+true
+</pre></div></td><td><div class="forth1"><pre>
+>"bird.fs" file-eval
+0
+</pre></div></td></tr>
+
+<tr><td><div class="scheme1"><pre>
+> (map-channel (lambda (y) (* y 2)))
+0
+</pre></div></td><td><div class="ruby1"><pre>
+>map_channel(lambda do |y| y * 2 end)
+-0.0015869140625
+</pre></div></td><td><div class="forth1"><pre>
+>lambda: <{ y }> y 2.0 f* ; map-channel
+-0.00158691
+</pre></div></td></tr>
+
+<tr><td><div class="scheme1"><pre>
+> (define (plus a b) (+ a b))
+plus
+</pre></div></td><td><div class="ruby1"><pre>
+>def plus(a, b) a+b end
+
+</pre></div></td><td><div class="forth1"><pre>
+>: plus ( a b -- sum ) { a b } a b + ;
+nil
+</pre></div></td></tr>
+
+<tr><td><div class="scheme1"><pre>
+> (set! (basic-color) (make-color 1 0 0))
+(Pixel 16711680)
+</pre></div></td><td><div class="ruby1"><pre>
+>set_basic_color make_color(1, 0, 0)
+[:Pixel, 16711680]
+</pre></div></td><td><div class="forth1"><pre>
+>1 0 0 make-color set-basic-color
+#<XmRaw: Pixel 0x9d3b430>
+</pre></div></td></tr>
</table>
+
<p>Another quick way to check out the extension language is to go to the
Preferences dialog (in the Options menu), choose some items, then
save them. The saved file (~/.snd_prefs_s7 for example) is a text file, a program in the current
extension language, that initializes Snd to use whatever items you chose.
</p>
-<blockquote>
-<p><small>If the listener is active, and some sound
-is selected, any characters typed while in the sound
-graph which it can't handle are passed to the
-listener.
-If the listener appears to be hung, try C-g; normally
-in this situation,
-it's actually waiting for a close paren; if you put the
-cursor just past the close paren you're interested in
-and type return,
-Snd will flash the unbalanced open paren (if any) briefly.
-In any case, whenever the cursor is just past a close paren,
-the matching open paren is underlined.
-</small></p>
-</blockquote>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="etc">Snd Programming</a></h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="etc">Snd Programming</div>
<p>Snd is organized as a list of sounds, each with a list of channels,
each channel containing lists of edits, marks, mixes, etc.
-There are other objects such as colors, vcts (an optimization
-of vectors), and regions; the currently active region is
+There are other objects such as colors,
+and regions; the currently active region is
called the selection. I originally presented all the
functions and variables in an enormous alphabetical
list, but that finally became unmanageable. In the following
@@ -377,196 +412,185 @@ and <a href="sndscm.html#sndtestdoc">snd-test.scm</a>.
Extensions to Snd can be found in:
</p>
-
-<table border=8 bordercolor="lightsteelblue" cellpadding=6 hspace=20><tr><td>
-<table border=0 cellspacing=0 cellpadding=2>
-<tr><th colspan=2 bgcolor="beige">Contents</th></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#analogfilterdoc">analog-filter</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(analog_filter_doc_tip)">standard IIR filters</td></tr>
+<table class="grayborder"><tr><td>
+<table id="contents_table">
+<tbody>
+<tr><td><a href="sndscm.html#analogfilterdoc">analog-filter</a></td>
+ <td>standard IIR filters</td></tr>
<tr><td><a href="sndscm.html#animalsdoc">animals</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(animals_doc_tip)">a bunch of animals</td></tr>
+ <td>a bunch of animals</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#autosavedoc">autosave</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(autosave_doc_tip)">auto-save (edit backup) support</td></tr>
+<tr><td><a href="sndscm.html#autosavedoc">autosave</a></td>
+ <td>auto-save (edit backup) support</td></tr>
<tr><td><a href="sndscm.html#bessdoc">bess</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(bess_doc_tip)">FM demo</td></tr>
+ <td>FM demo</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#binaryiodoc">binary-io</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(binary_io_doc_tip)">binary files</td></tr>
+<tr><td><a href="sndscm.html#binaryiodoc">binary-io</a></td>
+ <td>binary files</td></tr>
<tr><td><a href="sndscm.html#birddoc">bird</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(bird_doc_tip)">North-American birds</td></tr>
+ <td>North-American birds</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#cleandoc">clean</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(clean_doc_tip)">noise reduction</td></tr>
+<tr><td><a href="sndscm.html#cleandoc">clean</a></td>
+ <td>noise reduction</td></tr>
<tr><td><a href="sndscm.html#clminsdoc">clm-ins, clm23</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(clm_ins_doc_tip)">various CLM instruments</td></tr>
+ <td>various CLM instruments</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#dlocsigdoc">dlocsig</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(dlocsig_doc_tip)">moving sounds (Michael Scholz)</td></tr>
+<tr><td><a href="sndscm.html#dlocsigdoc">dlocsig</a></td>
+ <td>moving sounds (Michael Scholz)</td></tr>
<tr><td><a href="sndscm.html#drawdoc">draw</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(draw_doc_tip)">graphics additions</td></tr>
+ <td>graphics additions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#dspdoc">dsp</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(dsp_doc_tip)">various DSP-related procedures</td></tr>
+<tr><td><a href="sndscm.html#dspdoc">dsp</a></td>
+ <td>various DSP-related procedures</td></tr>
<tr><td><a href="sndscm.html#envdoc">env</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(env_doc_tip)">envelope functions</td></tr>
+ <td>envelope functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#enveddoc">enved</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(enved_doc_tip)">envelope editor</td></tr>
+<tr><td><a href="sndscm.html#enveddoc">enved</a></td>
+ <td>envelope editor</td></tr>
<tr><td><a href="sndscm.html#exampdoc">examp</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(examp_doc_tip)">many examples</td></tr>
+ <td>many examples</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#extensionsdoc">extensions</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(extensions_doc_tip)">various generally useful Snd extensions</td></tr>
+<tr><td><a href="sndscm.html#extensionsdoc">extensions</a></td>
+ <td>various generally useful Snd extensions</td></tr>
<tr><td><a href="sndscm.html#fadedoc">fade</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(fade_doc_tip)">frequency-domain cross-fades</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#framedoc">frame</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(frame_doc_tip)">frames, vcts, sound-data objects</td></tr>
+ <td>frequency-domain cross-fades</td></tr>
<tr><td><a href="sndscm.html#freeverbdoc">freeverb</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(freeverb_doc_tip)">a reverb</td></tr>
+ <td>a reverb</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndclm.html#othergenerators">generators</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(generators_doc_tip)">a bunch of generators</td></tr>
+<tr><td><a href="sndclm.html#othergenerators">generators</a></td>
+ <td>a bunch of generators</td></tr>
<tr><td><a href="sndscm.html#granidoc">grani</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(grani_doc_tip)">CLM's grani (Fernando Lopez-Lezcano and Mike Scholz)</td></tr>
+ <td>CLM's grani (Fernando Lopez-Lezcano and Mike Scholz)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#heartdoc">heart</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(heart_doc_tip)">use Snd with non-sound (arbitrary range) data</td></tr>
+<tr><td><a href="sndscm.html#heartdoc">heart</a></td>
+ <td>use Snd with non-sound (arbitrary range) data</td></tr>
<tr><td><a href="sndscm.html#hooksdoc">hooks</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(hooks_doc_tip)">functions related to hooks</td></tr>
+ <td >functions related to hooks</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#indexdoc">index</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(index_doc_tip)">snd-help extension</td></tr>
+<tr><td><a href="sndscm.html#indexdoc">index</a></td>
+ <td>snd-help extension</td></tr>
<tr><td><a href="sndscm.html#dotemacs">inf-snd.el, DotEmacs</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(inf_snd_doc_tip)">Emacs subjob support (Michael Scholz, Fernando Lopez-Lezcano)</td></tr>
+ <td>Emacs subjob support (Michael Scholz, Fernando Lopez-Lezcano)</td></tr>
+
+<tr><td><a href="sndscm.html#jcrevdoc">jcrev</a></td>
+ <td>John Chowning's ancient reverb</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#jcrevdoc">jcrev</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(jcrev_doc_tip)">John Chowning's ancient reverb</td></tr>
+<tr><td><a href="sndscm.html#lintdoc">lint</a></td>
+ <td>a lint program for scheme</td></tr>
<tr><td><a href="sndscm.html#maracadoc">maraca</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(maraca_doc_tip)">Perry Cook's maraca physical model</td></tr>
+ <td>Perry Cook's maraca physical model</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#marksdoc">marks</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(marks_doc_tip)">functions related to marks</td></tr>
+<tr><td><a href="sndscm.html#marksdoc">marks</a></td>
+ <td>functions related to marks</td></tr>
<tr><td><a href="sndscm.html#maxfdoc">maxf</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(maxf_doc_tip)">Max Mathews resonator</td></tr>
+ <td>Max Mathews resonator</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#menusdoc">menus</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(menus_doc_tip)">additional menus</td></tr>
+<tr><td><a href="sndscm.html#menusdoc">menus</a></td>
+ <td>additional menus</td></tr>
<tr><td><a href="sndscm.html#mixdoc">mix</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(mix_doc_tip)">functions related to mixes</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#mixerdoc">mixer</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(mixer_doc_tip)">functions related to linear algebra</td></tr>
+ <td>functions related to mixes</td></tr>
<tr><td><a href="sndscm.html#moogdoc">moog</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(moog_doc_tip)">Moog filter</td></tr>
+ <td>Moog filter</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#musglyphs">musglyphs</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(musglyphs_doc_tip)">Music notation symbols (from CMN)</td></tr>
+<tr><td><a href="sndscm.html#musglyphs">musglyphs</a></td>
+ <td>Music notation symbols (from CMN)</td></tr>
<tr><td><a href="sndscm.html#nbdoc">nb</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(nb_doc_tip)">Popup File info etc</td></tr>
+ <td>Popup File info etc</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#noisedoc">noise</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(noise_doc_tip)">noise maker</td></tr>
+<tr><td><a href="sndscm.html#noisedoc">noise</a></td>
+ <td>noise maker</td></tr>
<tr><td><a href="sndscm.html#numericsdoc">numerics</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(numerics_doc_tip)">various numerical functions</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#oscopedoc">oscope</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(oscope_doc_tip)">an oscilloscope/spectrum analysis dialog</td></tr>
+ <td>various numerical functions</td></tr>
<tr><td><a href="sndscm.html#peakphasesdoc">peak-phases</a></td>
<td>phases for the unpulse-train</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#pianodoc">piano</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(piano_doc_tip)">piano physical model</td></tr>
+<tr><td><a href="sndscm.html#pianodoc">piano</a></td>
+ <td>piano physical model</td></tr>
<tr><td><a href="sndscm.html#playdoc">play</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(play_doc_tip)">play-related functions</td></tr>
+ <td>play-related functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#polydoc">poly</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(poly_doc_tip)">polynomial-related stuff</td></tr>
+<tr><td><a href="sndscm.html#polydoc">poly</a></td>
+ <td>polynomial-related stuff</td></tr>
<tr><td><a href="sndscm.html#prc95doc">prc95</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(prc95_doc_tip)">Perry Cook's physical model examples</td></tr>
+ <td>Perry Cook's physical model examples</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#pvocdoc">pvoc</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(pvoc_doc_tip)">phase-vocoder</td></tr>
+<tr><td><a href="sndscm.html#pvocdoc">pvoc</a></td>
+ <td>phase-vocoder</td></tr>
<tr><td><a href="sndscm.html#rgbdoc">rgb</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(rgb_doc_tip)">color names</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#rtiodoc">rtio</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(rtio_doc_tip)">real-time stuff</td></tr>
+ <td>color names</td></tr>
<tr><td><a href="sndscm.html#rubberdoc">rubber</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(rubber_doc_tip)">rubber-sound</td></tr>
+ <td>rubber-sound</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#selectiondoc">selection</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(selection_doc_tip)">functions acting on the current selection</td></tr>
+<tr><td><a href="sndscm.html#selectiondoc">selection</a></td>
+ <td>functions acting on the current selection</td></tr>
<tr><td><a href="sndscm.html#singerdoc">singer</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(singer_doc_tip)">Perry Cook's vocal-tract physical model</td></tr>
+ <td>Perry Cook's vocal-tract physical model</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#sndolddoc">snd9|10|11.scm</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(sndold_doc_tip)">Backwards compatibility</td></tr>
+<tr><td><a href="sndscm.html#sndolddoc">snd13|14|15.scm</a></td>
+ <td>Backwards compatibility</td></tr>
<tr><td><a href="sndscm.html#snddiffdoc">snddiff</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(snddiff_doc_tip)">sound difference detection</td></tr>
+ <td>sound difference detection</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#sndgldoc">snd-gl</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snd_gl_doc_tip)">OpenGL examples (gl.c)</td></tr>
+<tr><td><a href="sndscm.html#sndgldoc">snd-gl</a></td>
+ <td>OpenGL examples (gl.c)</td></tr>
<tr><td><a href="sndscm.html#sndmotifdoc">snd-motif, snd-gtk, snd-xm</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(snd_motif_doc_tip)">Motif/Gtk module (xm.c, xg.c)</td></tr>
+ <td>Motif/Gtk module (xm.c, xg.c)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#sndtestdoc">snd-test</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snd_test_doc_tip)">Snd regression tests</td></tr>
+<tr><td><a href="sndscm.html#sndtestdoc">snd-test</a></td>
+ <td>Snd regression tests</td></tr>
<tr><td><a href="sndscm.html#sndwarpdoc">sndwarp</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(sndwarp_doc_tip)">Bret Battey's sndwarp instrument</td></tr>
+ <td>Bret Battey's sndwarp instrument</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#spectrdoc">spectr</a></td>
- <td bgcolor="#f2f4ff">instrument steady state spectra</td></tr>
+<tr><td><a href="sndscm.html#spectrdoc">spectr</a></td>
+ <td>instrument steady state spectra</td></tr>
<tr><td><a href="sndscm.html#stochasticdoc">stochastic</a></td>
<td>Bill Sack's dynamic stochastic synthesis</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#straddoc">strad</a></td>
- <td bgcolor="#f2f4ff">string physical model (from CLM)</td></tr>
+<tr><td><a href="sndscm.html#straddoc">strad</a></td>
+ <td>string physical model (from CLM)</td></tr>
<tr><td><a href="sndscm.html#vdoc">v</a></td>
<td>fm-violin</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndscm.html#wsdoc">ws</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(ws_doc_tip)">with-sound</td></tr>
+<tr><td><a href="sndscm.html#wsdoc">ws</a></td>
+ <td>with-sound</td></tr>
<tr><td><a href="sndscm.html#zipdoc">zip</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(zip_doc_tip)">the zipper (the anti-cross-fader)</td></tr>
-
+ <td>the zipper (the anti-cross-fader)</td></tr>
+</tbody>
</table>
</td></tr></table>
-<br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="behavior">Customizing Snd's behavior</a></h3></td></tr></table>
+
+<div class="header" id="behavior">Customizing Snd's behavior</div>
<p>Most of Snd's behavior can be customized. For example,
when a sound is saved, some people want to be warned if
@@ -578,29 +602,30 @@ event happens. When Snd exits, for example, any functions found
on the <a href="#beforeexithook">before-exit-hook</a> list are evaluated; if any of them returns #t,
Snd does not exit.</p>
-<table border=0 cellpadding=5 hspace=20>
-<tr><td><pre>
-(define <A NAME="unsavededitsp">(unsaved-edits? lst)</A>
- (if (not (null? lst))
- (if (> (car (<a class=quiet href="#edits" onmouseout="UnTip()" onmouseover="Tip(extsnd_edits_tip)">edits</a> (car lst))) 0)
- (begin
- (<a class=quiet href="#reportinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_reportinminibuffer_tip)">report-in-minibuffer</a> "there are unsaved edits")
- #t)
- (unsaved-edits? (cdr lst)))
- #f))
+<pre class="indented">
+(define (unsaved-edits? lst)
+ (and (pair? lst)
+ (if (> (car (<a class=quiet href="#edits">edits</a> (car lst))) 0)
+ (begin
+ (<a class=quiet href="#statusreport">status-report</a> "there are unsaved edits")
+ #t)
+ (unsaved-edits? (cdr lst)))))
-(hook-push <em class=red>before-exit-hook</em> (lambda () (unsaved-edits? (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
-</pre></td></tr></table>
+(hook-push <em class=red>before-exit-hook</em>
+ (lambda (hook)
+ (set! (hook 'result) (unsaved-edits? (<a class=quiet href="#sounds">sounds</a>)))))
+</pre>
<p>Now when Snd is told to exit, it checks before-exit-hook, runs
unsaved-edits?, and if the latter returns #t, if prints
-a worried message in the minibuffer, and refuses to
+a worried message in the status area, and refuses to
exit. Similar hooks customize actions such as closing
a sound (<a href="#closehook">close-hook</a>), clicking a mark (<a href="#markclickhook">mark-click-hook</a>),
pressing a key (<a href="#keypresshook">key-press-hook</a>), and so on.</p>
-<br>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h4><A NAME="sndglobalvars">Global variables</a></h4></td></tr></table>
+
+
+<div class="header" id="sndglobalvars">Global variables</div>
<p>The global variables handle various customizations that aren't callback-oriented.
For example,
@@ -610,204 +635,241 @@ up to Snd). Many people find this distracting — they would rather that th
overall window stick to one size. The Snd variable associated
with this is "auto-resize"; it can be accessed as:
</p>
-<pre>
- Scheme: (auto-resize)
+<pre class="indented">
+ Scheme: *auto-resize* or (auto-resize)
Ruby: auto_resize()
Forth: auto-resize
</pre>
<p>and set via:</p>
-<pre>
- Scheme: (set! (auto-resize) #f)
+<pre class="indented">
+ Scheme: (set! *auto-resize* #f) or (set! (auto-resize) #f)
Ruby: set_auto_resize(false)
Forth: #f set-auto-resize
</pre>
<p>
-The variables are presented as a special kind of function, rather than as bare variables, mainly
-to ensure that Snd's response to the assignment is immediate.
-The statement <code>(set! (auto-resize) #f)</code> can be placed in your ~/.snd initialization file
+I originally wanted a variable like auto-resize to look like a variable in source files, but
+in those bygone days (1996), that was not possible: I had to use a dumb "procedure-with-setter" instead.
+So you'd sigh and access auto-resize by calling it as a function: <code>(set! (auto-resize) #t)</code>.
+Now in s7, the same thing is also named *auto-resize*, but it's finally a variable,
+so you can use <code>(set! *auto-resize* #t)</code>. The documentation of course
+is out of date, and mostly uses the old form. In any case,
+the statement (set! *auto-resize* #f) can be placed in your ~/.snd initialization file
to make it the default setting for your version of Snd, or placed
in a separate file of Scheme code and loaded at any time via the load
function. </p>
-<p>The variables affecting Snd's overall behavior are:
+<p>The functions affecting Snd's overall behavior are given below; in s7 there is
+also the variable of the same name, but with "*" around it: *auto-resize*.
</p>
-<!-- -------------------------------- GLOBAL VARIABLE TABLE -------------------------------- -->
-
-<table border=0 cellspacing=4 cellpadding=6>
-
-<tr><td width=30></td><td width=220></td><td></td></tr>
+<div class="spacer"></div>
<!-- ask-about-unsaved-edits -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="askaboutunsavededits">ask-about-unsaved-edits</a></code></td>
-<td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip('in this table, the default value of the given variable is listed after the variable name,<br>so ask-about-unsaved-edits defaults to false')"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-If ask-about-unsaved-edits is #t, Snd worries about unsaved edits when a sound is about to be closed.
+<pre class="indented">
+<em class=def id="askaboutunsavededits">ask-about-unsaved-edits</em> (default: #f)
+</pre>
+
+<p>If ask-about-unsaved-edits is #t, Snd worries about unsaved edits when a sound is about to be closed.
Otherwise Snd just closes the sound, flushing any unsaved edits.
<code>(set! (ask-about-unsaved-edits) #t)</code>
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- ask-before-overwrite -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="askbeforeoverwrite">ask-before-overwrite</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-ask-before-overwrite determines whether Snd asks before overwriting an existing file:
-<code>(set! (ask-before-overwrite) #t)</code>
-</td></tr><tr><td colspan=3 height=16></td></tr>
-
-
-<!-- audio-input-device -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="audioinputdevice">audio-input-device</a></code></td>
-<td bgcolor="#f2f4ff"><code>mus-audio-default</code></td></tr><tr><td></td><td colspan=2>
-This is the recorder's input device: <code>(set! (audio-input-device) mus-audio-microphone)</code>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
-
+<pre class="indented">
+<em class=def id="askbeforeoverwrite">ask-before-overwrite</em> (default: #f)
+</pre>
-<!-- audio-output-device -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="audiooutputdevice">audio-output-device</a></code></td>
-<td bgcolor="#f2f4ff"><code>mus-audio-default</code></td></tr><tr><td></td><td colspan=2>
-This is the audio output device for the play button.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<p>ask-before-overwrite determines whether Snd asks before overwriting an existing file:
+<code>(set! (ask-before-overwrite) #t)</code>
+</p>
+<div class="spacer"></div>
<!-- auto-resize -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="autoresize">auto-resize</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t in Motif, #f in Gtk</code></td></tr><tr><td></td><td colspan=2>
-auto-resize determines whether the Snd window should be resized
+<pre class="indented">
+<em class=def id="autoresize">auto-resize</em> (default: #t in Motif, #f in Gtk)
+</pre>
+
+<p>auto-resize determines whether the Snd window should be resized
when a sound is opened or closed.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- auto-update -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="autoupdate">auto-update</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-auto-update determines whether Snd should <a href="snd.html#updatefile">update</a> a file automatically
+<pre class="indented">
+<em class=def id="autoupdate">auto-update</em> (default: #f)
+</pre>
+
+<p>auto-update determines whether Snd should <a href="snd.html#updatefile">update</a> a file automatically
if it (the file) changes on disk due to some other process.
If Snd's view of a sound doesn't match the on-disk version of the sound,
-a bomb icon warns you that there are two conflicting versions of the sound.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+a warning is posted that there are two conflicting versions of the sound.
+</p>
+<div class="spacer"></div>
<!-- auto-update-interval -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="autoupdateinterval">auto-update-interval</a></code></td>
-<td bgcolor="#f2f4ff"><code>60</code></td></tr><tr><td></td><td colspan=2>
-This is the time (in seconds) between background checks for a changed file on
+<pre class="indented">
+<em class=def id="autoupdateinterval">auto-update-interval</em> (default: 60)
+</pre>
+
+<p>This is the time (in seconds) between background checks for a changed file on
disk (see <a href="#autoupdate">auto-update</a>). If auto-update-interval is 0.0, the auto-update background process
is turned off.
-If the file alternation monitor is running (the default if you have libfam or libgamin), auto-update-interval is ignored
-since in that case the check happens instantly.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- clipping -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="clipping">clipping</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-If clipping is #t, output values are clipped to fit the current sndlib sample
+<pre class="indented">
+<em class=def id="clipping">clipping</em> (default: #f)
+</pre>
+
+<p>If clipping is #t, output values are clipped to fit the current sndlib sample
representation's notion of -1.0 to just less than 1.0. The default (#f)
can cause wrap-around (if writing integer sound data) which makes the out-of-range values very obvious.
To control this action more closely, use <a href="#cliphook">clip-hook</a>.
To get completely confused, see <a href="#musclipping">mus-clipping</a> and <a href="#musfileclipping">mus-file-clipping</a>:
this has become as messed up as the sampling rate settings!
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- cursor-location-offset -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="cursorlocationoffset">cursor-location-offset</a></code></td>
-<td bgcolor="#f2f4ff"><code>0.05</code></td></tr><tr><td></td><td colspan=2>
-cursor-location-offset is the offset in samples between Snd's notion of the location of the tracking cursor
+<pre class="indented">
+<em class=def id="cursorlocationoffset">cursor-location-offset</em> (default: 0.05)
+</pre>
+
+<p>cursor-location-offset is the offset in samples between Snd's notion of the location of the tracking cursor
(<a href="#withtrackingcursor">with-tracking-cursor</a> in Snd jargon) and the actual (DAC-relative) location.
Since, in general, Snd can't tell how many samples of buffering there are between itself
and the speakers (audio cards have varying amounts), its notion of where to place the
tracking cursor can be wrong by an almost arbitrary amount. If you have some idea
of the buffering amount, you can correct this error via cursor-location-offset.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- cursor-update-interval -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="cursorupdateinterval">cursor-update-interval</a></code></td>
-<td bgcolor="#f2f4ff"><code>0.05</code></td></tr><tr><td></td><td colspan=2>
-This is the time in seconds between
+<pre class="indented">
+<em class=def id="cursorupdateinterval">cursor-update-interval</em> (default: 0.05)
+</pre>
+
+<p>This is the time in seconds between
cursor redisplays if playing a sound with <a href="#withtrackingcursor">with-tracking-cursor</a> #t.
If this number is too small, you may clicks during playback.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- dac-combines-channels -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="dacfolding">dac-combines-channels</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t</code></td></tr><tr><td></td><td colspan=2>
-If dac-combines-channels is #t, and the current sound has more channels than are
+<pre class="indented">
+<em class=def id="dacfolding">dac-combines-channels</em> (default: #t)
+</pre>
+
+<p>If dac-combines-channels is #t, and the current sound has more channels than are
supported by the available audio hardware, Snd mixes the extra channels into the available channels during audio output.
This provides a way to hear 4-channel sounds when you only have a stereo audio card.
If dac-combines-channels is #f, extra channels are not played.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- dac-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="dacsize">dac-size</a></code></td>
-<td bgcolor="#f2f4ff"><code>256</code></td></tr><tr><td></td><td colspan=2>
-dac-size is the audio output buffer size; it is not always meaningful. See <a href="sndscm.html#playwithenvs">play-with-envs</a> in enved.scm or
-<a href="sndscm.html#playsound">play-sound</a> in play.scm. When you change the control panel settings during playback, the snappiness of the
+<pre class="indented">
+<em class=def id="dacsize">dac-size</em> (default: 256)
+</pre>
+
+<p>dac-size is the audio output buffer size; it is not always meaningful. See <a href="sndscm.html#playwithenvs">play-with-envs</a> in enved.scm.
+When you change the control panel settings during playback, the snappiness of the
response is set, to some extent, by the dac-size. The default of 256 gives a stair-case effect in many
cases, whereas 2048 is smoother. This also affects the resampling smoothness of playback while dragging the
mark play triangle. Some audio choices, ALSA in particular, may ignore dac-size.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- default-output-chans -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="defaultoutputchans">default-output-chans</a></code></td>
-<td bgcolor="#f2f4ff"><code>1</code></td></tr><tr><td></td><td colspan=2>
-default-output-chans is the default number of channels when a new or temporary file is created,
+<pre class="indented">
+<em class=def id="defaultoutputchans">default-output-chans</em> (default: 1)
+</pre>
+
+<p>default-output-chans is the default number of channels when a new or temporary file is created,
or a save dialog is opened.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
-<!-- default-output-data-format -->
-<tr><td colspan=2 bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip('I originally intended the names to be "header-format" and "data-type"<br>but somehow things got bollixed up and I didn\'t notice the confusion until years later')"><code><a class=def name="defaultoutputdataformat">default-output-data-format</a></code></td>
-<td bgcolor="#f2f4ff"><code>mus-bfloat</code></td></tr><tr><td></td><td colspan=2>
-default-output-data-format is the default data format when a new or temporary file is created,
-or a save dialog is opened. (The default, <code>mus-bfloat</code>, is from sndlib, standing for 32-bit big-endian floating point data).
-Use <a href="#musoutformat">mus-out-format</a> for fastest IO.
-The available output data formats are (b=big-endian, l=little, u=unsigned, short=16 bits, byte=8 bits, int = 32 bits):
-<pre onmouseout="UnTip()" onmouseover="Tip('mus-bshort: big-endian (au-style) 16-bit ints, doubles are 64-bit floats,<br>alaw and mulaw are compression schemes, mus-b24int is a 3-byte (24-bit) format;<br>each header type has restrictions on the kinds of data it can accommodate.')">
- mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat
- mus-lfloat mus-bint mus-lint mus-b24int mus-l24int mus-bdouble mus-ldouble
- mus-ubshort mus-ulshort
+<!-- default-output-header-type -->
+<pre class="indented">
+<em class=def id="defaultoutputheadertype">default-output-header-type</em> (default: mus-next)
</pre>
-There are also "unscaled" versions of the floating point types, and "normalized" versions of the integers.
-</td></tr><tr><td colspan=3 height=16></td></tr>
-
-<!-- default-output-header-type -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="defaultoutputheadertype">default-output-header-type</a></code></td>
-<td bgcolor="#f2f4ff"><code>mus-next</code></td></tr><tr><td></td><td colspan=2>
-This is the default header type when a new file is created,
-or a save dialog is opened. (The default, <code>mus-next</code>, stands for the NeXT/Sun sound file header).
+<p>This is the default header type when a new file is created,
+or a save dialog is opened. (The default, mus-next, stands for the NeXT/Sun sound file header).
The available output header-types are:
-<pre onmouseout="UnTip()" onmouseover="Tip('mus-riff is our name for Microsoft wave,<br>mus-rf64 is the EBU 64-bit RIFF-replacement header,<br>mus-nist refers to NIST-SPHERE files,<br>mus-next and mus-sun are the same,<br>mus-aiff is the obsolete predecessor to mus-aifc,<br>mus-bicsf and mus-ircam are extensions of mus-next headers,<br>mus-raw means "headerless",<br>mus-soundfont refers to Emu\'s extension of mus-riff files,<br>mus-voc refers to Creative Voice File,<br>mus-svx refers to 8SVX headers.<br>Many other headers are supported read-only.')">
+</p>
+
+<pre>
mus-next mus-aifc mus-riff mus-rf64 mus-nist mus-raw mus-ircam mus-aiff
mus-soundfont mus-bicsf mus-voc mus-svx mus-caff
</pre>
-</td></tr><tr><td colspan=3 height=16></td></tr>
+
+<div class="spacer"></div>
+
+
+<!-- default-output-sample-type -->
+<pre class="indented">
+<em class=def id="defaultoutputsampletype">default-output-sample-type</em> (default: mus-bfloat)
+</pre>
+
+<p>default-output-sample-type is the default sample type when a new or temporary file is created,
+or a save dialog is opened. (The default, mus-bfloat, is from sndlib, standing for 32-bit big-endian floating point data).
+Use <a href="#musoutformat">mus-out-format</a> for fastest IO.
+The available output sample types are (b=big-endian, l=little, u=unsigned, short=16 bits, byte=8 bits, int = 32 bits):
+</p>
+
+<pre>
+ mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat
+ mus-lfloat mus-bint mus-lint mus-b24int mus-l24int mus-bdouble mus-ldouble
+ mus-ubshort mus-ulshort
+</pre>
+
+<p>There are also "unscaled" versions of the floating point types, and "normalized" versions of the integers.
+</p>
+<div class="spacer"></div>
<!-- default-output-srate -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="defaultoutputsrate">default-output-srate</a></code></td>
-<td bgcolor="#f2f4ff"><code>44100</code></td></tr><tr><td></td><td colspan=2>
-This is the default sampling rate when a new or temporary file is created,
+<pre class="indented">
+<em class=def id="defaultoutputsrate">default-output-srate</em> (default: 44100)
+</pre>
+
+<p>This is the default sampling rate when a new or temporary file is created,
or a save dialog is opened. It also sets the default CLM srate (*clm-srate* in ws.scm),
so all CLM generators use it outside with-sound.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- eps-bottom-margin -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="epsbottommargin">eps-bottom-margin</a></code></td>
-<td bgcolor="#f2f4ff"><code>0.0</code></td></tr><tr><td></td><td colspan=2>
-eps-bottom-margin is the bottom margin used in snd.eps, created by the File:Print dialog, or the <a href="#graphtops">graph->ps</a> function.
+<pre class="indented">
+<em class=def id="epsbottommargin">eps-bottom-margin</em> (default: 0.0)
+</pre>
+
+<p>eps-bottom-margin is the bottom margin used in snd.eps, created by the File:Print dialog, or the <a href="#graphtops">graph->ps</a> function.
PostScript units are 1/72 of an inch (a "point" in printer jargon);
an inch is 2.54 cm:
+</p>
-<table border=0 cellpadding=5 vspace=10 hspace=20><tr><td>
-
-<table border=0 cellpadding=5><tr><td><pre>
+<table>
+<tr>
+<td>
+<div class="scheme">
+<pre class="indented">
Scheme:
(define (inches-to-ps inches)
@@ -815,11 +877,12 @@ Scheme:
(define (cm-to-ps cm)
(* cm (/ 72.0 2.54)))
-</pre></td></tr></table>
-
-</td><td>
-
-<table border=0 cellpadding=5><tr><td bgcolor="Beige"><pre>
+</pre>
+</div>
+</td>
+<td>
+<div class="ruby">
+<pre class="indented">
Ruby:
def inches_to_ps(inches)
inches * 72
@@ -827,11 +890,12 @@ end
def cm_to_ps(cm)
cm * 72.0 / 2.54
end
-</pre></td></tr></table>
-
-</td><td>
-
-<table border=0 cellpadding=5><tr><td bgcolor="LightGreen"><pre>
+</pre>
+</div>
+</td>
+<td>
+<div class="forth">
+<pre class="indented">
Forth:
: inches-to-ps { inches }
inches 72 f*
@@ -839,495 +903,603 @@ Forth:
: cm-to-ps { cm }
cm 2.54 f/ 72 f*
;
-</pre></td></tr></table>
+</pre>
+</div>
</td></tr></table>
-In the resulting .eps file, you'll find a <code>concat</code> statement near the
+<p>In the resulting .eps file, you'll find a concat statement near the
top of the file; the first and fourth numbers are scale factors on
the entire graph, the fifth is the left margin, and the sixth is the
bottom margin.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- eps-file -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="epsfile">eps-file</a></code></td>
-<td bgcolor="#f2f4ff"><code>"snd.eps"</code></td></tr><tr><td></td><td colspan=2>
-This is the default name of the Postscript file produced by the File:Print dialog, or the <a href="#graphtops">graph->ps</a> function.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="epsfile">eps-file</em> (default: "snd.eps")
+</pre>
+
+<p>This is the default name of the Postscript file produced by the File:Print dialog, or the <a href="#graphtops">graph->ps</a> function.
+</p>
+<div class="spacer"></div>
<!-- eps-left-margin -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="epsleftmargin">eps-left-margin</a></code></td>
-<td bgcolor="#f2f4ff"><code>0.0</code></td></tr><tr><td></td><td colspan=2>
-eps-left-margin is the left margin used in snd.eps, created by the File:Print dialog, or the <a href="#graphtops">graph->ps</a> function.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="epsleftmargin">eps-left-margin</em> (default: 0.0)
+</pre>
+
+<p>eps-left-margin is the left margin used in snd.eps, created by the File:Print dialog, or the <a href="#graphtops">graph->ps</a> function.
+</p>
+<div class="spacer"></div>
<!-- eps-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="epssize">eps-size</a></code></td>
-<td bgcolor="#f2f4ff"><code>1.0</code></td></tr><tr><td></td><td colspan=2>
-eps-size is the scaler used to set the overall picture size in snd.eps,
+<pre class="indented">
+<em class=def id="epssize">eps-size</em> (default: 1.0)
+</pre>
+
+<p>eps-size is the scaler used to set the overall picture size in snd.eps,
created by the File:Print dialog, or the <a href="#graphtops">graph->ps</a> function,
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- graph-cursor -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="graphcursor">graph-cursor</a></code></td>
-<td bgcolor="#f2f4ff"><code>XC_crosshair (34)</code></td></tr><tr><td></td><td colspan=2>
-graph-cursor is the kind of cursor displayed following the mouse in the data graph.
+<pre class="indented">
+<em class=def id="graphcursor">graph-cursor</em> (default: XC_crosshair (34))
+</pre>
+
+<p>graph-cursor is the kind of cursor displayed following the mouse in the data graph.
It can be any of the cursors provided by X or Gtk+: <code>(set! (graph-cursor) 22)</code>.
The X/Motif cursors are declared in /usr/include/X11/cursorfont.h or some such file;
gtk versions are in gdkcursor.h. Some useful choices are:
+</p>
+
+<pre class="indented">
+ Motif Gtk+ value
+
+XC_center_ptr GDK_CENTER_PTR 22
+XC_cross GDK_CROSS 30
+XC_crosshair GDK_CROSSHAIR 34
+XC_left_ptr GDK_LEFT_PTR 68
+XC_plus GDK_PLUS 90
+XC_right_ptr GDK_RIGHT_PTR 94
+XC_tcross GDK_TCROSS 130
+XC_xterm GDK_XTERM 152
+</pre>
+
+<div class="spacer"></div>
-<table border=0 cellpadding=6 vspace=10><tr><td>
-<table border=0 cellspacing=4 cellpadding=4>
-<tr><th bgcolor="beige"><small>Motif</small></th><th bgcolor="beige"><small>Gtk+</small></th><th bgcolor="beige"><small>value</small></th></tr>
-<tr><td><small>XC_arrow</small></td><td><small>GDK_ARROW</small></td><td><small>2</small></td></tr>
-<tr><td><small>XC_center_ptr</small></td><td><small>GDK_CENTER_PTR</small></td><td><small>22</small></td></tr>
-<tr><td><small>XC_cross</small></td><td><small>GDK_CROSS</small></td><td><small>30</small></td></tr>
-<tr><td><small>XC_crosshair</small></td><td><small>GDK_CROSSHAIR</small></td><td><small>34</small></td></tr>
-<tr><td><small>XC_left_ptr</small></td><td><small>GDK_LEFT_PTR</small></td><td><small>68</small></td></tr>
-<tr><td><small>XC_plus</small></td><td><small>GDK_PLUS</small></td><td><small>90</small></td></tr>
-<tr><td><small>XC_right_ptr</small></td><td><small>GDK_RIGHT_PTR</small></td><td><small>94</small></td></tr>
-<tr><td><small>XC_tcross</small></td><td><small>GDK_TCROSS</small></td><td><small>130</small></td></tr>
-<tr><td><small>XC_xterm</small></td><td><small>GDK_XTERM</small></td><td><small>152</small></td></tr>
-</table>
-</td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
<!-- html-dir -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="htmldir">html-dir</a></code></td>
-<td bgcolor="#f2f4ff"><code>"."</code></td></tr><tr><td></td><td colspan=2>
-html-dir is the directory to search for documentation if an HTML reader is in use.
+<pre class="indented">
+<em class=def id="htmldir">html-dir</em> (default: ".")
+</pre>
+
+<p>html-dir is the directory to search for documentation if an HTML reader is in use.
See the function html in index.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- html-program -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="htmlprogram">html-program</a></code></td>
-<td bgcolor="#f2f4ff"><code>"firefox"</code></td></tr><tr><td></td><td colspan=2>
-This is the program to use to read HTML files.
+<pre class="indented">
+<em class=def id="htmlprogram">html-program</em> (default: "firefox")
+</pre>
+
+<p>This is the program to use to read HTML files.
On the Mac, you need to give the full path to the executable image: "/Applications/Safari.app/Contents/MacOS/Safari".
See the function html in index.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- initial-beg -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="initialbeg">initial-beg</a></code></td>
-<td bgcolor="#f2f4ff"><code>0.0</code></td></tr><tr><td></td><td colspan=2>
-initial-beg is the start point (in seconds) of the initial graph of a sound.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="initialbeg">initial-beg</em> (default: 0.0)
+</pre>
+
+<p>initial-beg is the start point (in seconds) of the initial graph of a sound.
+</p>
+<div class="spacer"></div>
<!-- initial-dur -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="initialdur">initial-dur</a></code></td>
-<td bgcolor="#f2f4ff"><code>0.1</code></td></tr><tr><td></td><td colspan=2>
-initial-dur is the duration (in seconds) of the initial graph of a sound.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="initialdur">initial-dur</em> (default: 0.1)
+</pre>
+
+<p>initial-dur is the duration (in seconds) of the initial graph of a sound.
+</p>
+<div class="spacer"></div>
<!-- just-sounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="justsounds">just-sounds</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t</code></td></tr><tr><td></td><td colspan=2>
-If just-sounds is #t,
+<pre class="indented">
+<em class=def id="justsounds">just-sounds</em> (default: #t)
+</pre>
+
+<p>If just-sounds is #t,
the file lists displayed by the file selection dialogs are filtered to show just
sound files (see <a href="#addsoundfileextension">add-sound-file-extension</a>).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- ladspa-dir -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="ladspadir">ladspa-dir</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-LADSPA is a way of managing plug-ins in Linux. I consider it very old-fashioned, but
+<pre class="indented">
+<em class=def id="ladspadir">ladspa-dir</em> (default: #f)
+</pre>
+
+<p>LADSPA is a way of managing plug-ins in Linux. I consider it very old-fashioned, but
there are a bunch of ladspa libraries, and they're easy to load. so...
ladspa-dir is the
name of the directory to search for LADSPA plugin libraries (it can override or replace LADSPA_PATH).
See <a href="grfsnd.html#sndandladspa">Snd and LADSPA</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- log-freq-start -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="logfreqstart">log-freq-start</a></code></td>
-<td bgcolor="#f2f4ff"><code>32.0</code></td></tr><tr><td></td><td colspan=2>
-log-freq-start is the start (lowest) frequency used in the log freq display (ffts). Since the log display emphasizes the lower
+<pre class="indented">
+<em class=def id="logfreqstart">log-freq-start</em> (default: 32.0)
+</pre>
+
+<p>log-freq-start is the start (lowest) frequency used in the log freq display (ffts). Since the log display emphasizes the lower
frequencies, but the lowest are all inaudible, it seemed more informative to squash the lowest 30Hz or so
into a single point (0 Hz) on the log freq graphs; otherwise the audible data starts about 1/4 of the way
down the x axis, wasting valuable screen space! But it also seemed a bother to have to set/reset the
<a href="#spectrumstart">spectrum-start</a> variable every time you wanted to flip between log and linear
displays. log-freq-start to the rescue? For other ideas along these lines, see <a href="sndscm.html#displaybarkfft">display-bark-fft</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- max-regions -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="maxregions">max-regions</a></code></td>
-<td bgcolor="#f2f4ff"><code>16</code></td></tr><tr><td></td><td colspan=2>
-This sets the maximum size of the region list, the number of regions that are accessible.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="maxregions">max-regions</em> (default: 16)
+</pre>
+<p>This sets the maximum size of the region list, the number of regions that are accessible.
+</p>
+<div class="spacer"></div>
-<!-- max-virtual-ptrees -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="maxvirtualptrees">max-virtual-ptrees</a></code></td>
-<td bgcolor="#f2f4ff"><code>32</code></td></tr><tr><td></td><td colspan=2>
-This sets the maximum number of parse-trees (see <a href="#ptreechannel">ptree-channel</a>) that the
-virtual editor will allow in any virtual edit (once the maximum is reached, the operation is handled
-locally, not via a virtual edit).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<!-- mus-max-malloc -->
+<pre class="indented">
+<em class=def id="musmaxmalloc">mus-max-malloc</em> (default: 67108864)
+</pre>
-<!-- minibuffer-history-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="minibufferhistorylength">minibuffer-history-length</a></code></td>
-<td bgcolor="#f2f4ff"><code>8</code></td></tr><tr><td></td><td colspan=2>
-This sets the maximum length of the minibuffer and listener M-p/M-n history lists.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<p>This sets the maximum memory allocation (in bytes).
+In s7, you can use the variable *mus-max-malloc* instead.
+</p>
+<div class="spacer"></div>
-<!-- mus-max-malloc -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musmaxmalloc">mus-max-malloc</a></code></td>
-<td bgcolor="#f2f4ff"><code>67108864</code></td></tr><tr><td></td><td colspan=2>
-This sets the maximum memory allocation (in bytes).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<!-- mus-max-table-size -->
+<pre class="indented">
+<em class=def id="musmaxtablesize">mus-max-table-size</em> (default: 20971520)
+</pre>
+<p>This sets the maximum table size (delay line length in samples, etc).
+In s7, you can use the variable *mus-max-table-size* instead.
+</p>
+<div class="spacer"></div>
-<!-- mus-max-table-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musmaxtablesize">mus-max-table-size</a></code></td>
-<td bgcolor="#f2f4ff"><code>20971520</code></td></tr><tr><td></td><td colspan=2>
-This sets the maximum table size (delay line length in samples, etc).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+
+<!-- mus-sound-path -->
+<pre class="indented">
+<em class=def id="mussoundpath">mus-sound-path</em> (default: ())
+</pre>
+
+<p>This is the list of directories searched for an incompletely specified sound file.
+The current directory is always searched first.
+</p>
+<div class="spacer"></div>
<!-- open-file-dialog-directory -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="openfiledialogdirectory">open-file-dialog-directory</a></code></td>
-<td bgcolor="#f2f4ff"><code>"."</code></td></tr><tr><td></td><td colspan=2>
-open-file-dialog-directory is the name of the initial open file dialog directory (normally ".").
-</td></tr><tr><td colspan=3 height=16></td></tr>
-
-
-<!-- optimization -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="optimization">optimization</a></code></td>
-<td bgcolor="#f2f4ff"><code>6</code></td></tr><tr><td></td><td colspan=2>
-optimization affects optimization levels in Scheme.
-If non-zero, it causes Snd to try to optimize simple lambda forms passed to the searches and so forth.
-This applies only to s7.
-The actual values of the optimization switch are:
-<pre>
- 0: no optimization (use the standard Scheme parser/evaluator)
- 1: optimize simple stuff (if complex result possible, give up)
- 2: assume nothing will return a complex number
- 3: if an undefined variable is encountered, try to guess its type
- 4: make questionable assumptions about variable types
- 5: make dangerous assumptions about variable locations (for set!)
- 6: try to splice in user-defined functions
-</pre>
-
-Currently, the optimizer is able to speed up Scheme code by factors between
-8 and 20; see run.c for what is implemented, what the major limitations are, and so on.
-If you set the optimization-hook to print out whatever its argument is, you can
-find out what the optimizer found confusing:
-<pre>
- (hook-push <a class=quiet href="#optimizationhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_optimizationhook_tip)">optimization-hook</a> (lambda (n) (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "opt: ~A~%" n))))
+<pre class="indented">
+<em class=def id="openfiledialogdirectory">open-file-dialog-directory</em> (default: ".")
</pre>
-See also <a href="#maxvirtualptrees">max-virtual-ptrees</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+
+<p>open-file-dialog-directory is the name of the initial open file dialog directory (normally ".").
+</p>
+<div class="spacer"></div>
<!-- peak-env-dir -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="peakenvdir">peak-env-dir</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-peak-env-dir is the directory to use for peak env files; if it is #f (the default), the peak-env machinery is turned off.
+<pre class="indented">
+<em class=def id="peakenvdir">peak-env-dir</em> (default: #f)
+</pre>
+
+<p>peak-env-dir is the directory to use for peak env files; if it is #f (the default), the peak-env machinery is turned off.
If the peak-env-dir is writable, Snd saves an overview of the sound data in that directory to speed up
the initial graph display the next time you open that sound.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- play-arrow-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="playarrowsize">play-arrow-size</a></code></td>
-<td bgcolor="#f2f4ff"><code>10</code></td></tr><tr><td></td><td colspan=2>
-This is the size of the triangular arrow that handles click-to-play duties for the cursor, marks, mixes, and the selection.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="playarrowsize">play-arrow-size</em> (default: 10)
+</pre>
+
+<p>This is the size of the triangular arrow that handles click-to-play duties for the cursor, marks, mixes, and the selection.
+</p>
+<div class="spacer"></div>
<!-- print-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="printlength">print-length</a></code></td>
-<td bgcolor="#f2f4ff"><code>12</code></td></tr><tr><td></td><td colspan=2>
-For objects such as vcts, print-length sets the number of elements printed.
-In S7, this also sets *vector-print-length*.
-<pre>
- <em class=listener>></em><em class=typing>(set! (print-length) 3)</em>
- <em class=listener>3</em>
- <em class=listener>></em><em class=typing>(make-vct 10 .1)</em>
- <em class=listener>#<vct[len=10]: 0.100 0.100 0.100 ...></em>
+<pre class="indented">
+<em class=def id="printlength">print-length</em> (default: 12)
+</pre>
+
+<p>For objects such as float-vectors, print-length sets the number of elements printed.
+In s7, this also sets (*s7* 'print-length).
+</p>
+
+<pre class="indented">
+> (set! (print-length) 3)
+3
+> (make-float-vector 10 .1)
+#(0.1 0.1 0.1 ...)
</pre>
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<div class="spacer"></div>
<!-- remember-sound-state -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="remembersoundstate">remember-sound-state</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-If remember-sound-state is #t, Snd saves most of a sound's display state when it is closed,
+<pre class="indented">
+<em class=def id="remembersoundstate">remember-sound-state</em> (default: #f)
+</pre>
+
+<p>If remember-sound-state is #t, Snd saves most of a sound's display state when it is closed,
and if that same sound is later re-opened, restores the previous state.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- save-dir -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="savedir">save-dir</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-save-dir is the name of the directory for saved-state files.
-<br><br>
+<pre class="indented">
+<em class=def id="savedir">save-dir</em> (default: #f)
+</pre>
+
+<p>save-dir is the name of the directory for saved-state files.
These files are written when you call <a href="#savestate">save-state</a> or
choose the Options:Save session menu item. If any of the current sounds has
an edit that requires saved data, it is written as a separate sound file, and
that file is reloaded automatically when you restart the saved session. To keep such
files safe, or at least separate from others, you can set up separate
directory for them.
-<span onmouseout="UnTip()" onmouseover="Tip('<pre>Ruby: set_save_dir("/tmp"), Forth: "/tmp" set-save-dir</pre>')"><code>(set! (<a class=quiet href="#savedir" onmouseout="UnTip()" onmouseover="Tip(extsnd_savedir_tip)">save-dir</a>) "/tmp")</code></span>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- save-state-file -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="savestatefile">save-state-file</a></code></td>
-<td bgcolor="#f2f4ff"><code>"saved-snd.scm"</code></td></tr><tr><td></td><td colspan=2>
-This is the <a href="snd.html#savedstate">saved state</a> file name.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="savestatefile">save-state-file</em> (default: "saved-snd.scm")
+</pre>
+
+<p>This is the <a href="snd.html#savedstate">saved state</a> file name.
+</p>
+<div class="spacer"></div>
+
+
+<!-- search-procedure -->
+<pre class="indented">
+<em class=def id="searchprocedure">search-procedure</em>
+</pre>
+
+<p>This is the search procedure used by the find dialog or C-s if none is otherwise specified.
+</p>
+
+<pre class="indented">
+(set! (<a class=quiet href="#searchprocedure">search-procedure</a>) (lambda (y) (> y .1)))
+</pre>
+<div class="spacer"></div>
<!-- selection-creates-region -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectioncreatesregion">selection-creates-region</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t</code></td></tr><tr><td></td><td colspan=2>
-If selection-creates-region is #t, a region is created whenever a selection is made. If you're editing very large sounds
+<pre class="indented">
+<em class=def id="selectioncreatesregion">selection-creates-region</em> (default: #t)
+</pre>
+
+<p>If selection-creates-region is #t, a region is created whenever a selection is made. If you're editing very large sounds
and using selections, the region temp files can use up a lot of disk space (and the time to write
them); if you're not using regions anyway, this switch can turn them off.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- show-full-duration -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="showfullduration">show-full-duration</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-If show-full-duration is #t, Snd displays the entire sound when it is first opened.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="showfullduration">show-full-duration</em> (default: #f)
+</pre>
+
+<p>If show-full-duration is #t, Snd displays the entire sound when it is first opened.
+</p>
+<div class="spacer"></div>
+
+
+<!-- show-full-range -->
+<pre class="indented">
+<em class=def id="showfullrange">show-full-range</em> (default: #f)
+</pre>
+
+<p>If show-full-range is #t, Snd makes sure the sound's graph y bounds can accommodate the
+entire range of sample values. This is especially useful when you're working with sounds
+that go beyond the normal -1.0 to 1.0 range.
+</p>
+<div class="spacer"></div>
<!-- show-indices -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="showindices">show-indices</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-If show-indices is #t, each sound's name is preceded by its index in the sound pane.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="showindices">show-indices</em> (default: #f)
+</pre>
+
+<p>If show-indices is #t, each sound's name is preceded by its index in the sound pane.
+</p>
+<div class="spacer"></div>
<!-- show-selection-transform -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="showselectiontransform">show-selection-transform</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-If show-selection-transform is #t, Snd displays the transform of the current active selection, if any.
+<pre class="indented">
+<em class=def id="showselectiontransform">show-selection-transform</em> (default: #f)
+</pre>
+
+<p>If show-selection-transform is #t, Snd displays the transform of the current active selection, if any.
The sonogram and spectrogram displays ignore this flag because they assume their time axis
matches that of the time domain graph.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- sinc-width -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sincwidth">sinc-width</a></code></td>
-<td bgcolor="#f2f4ff"><code>10</code></td></tr><tr><td></td><td colspan=2>
-sinc-width is the width in samples of the sampling rate conversion sinc interpolation.
-<br><br>
+<pre class="indented">
+<em class=def id="sincwidth">sinc-width</em> (default: 10)
+</pre>
+
+<p>sinc-width is the width in samples of the sampling rate conversion sinc interpolation.
The higher this number, the better the src low-pass filter, but the slower
src runs. If you use too low a setting, you can sometimes hear high
frequency whistles leaking through. To hear these on purpose, make
-a sine wave at (say) 55 Hz, then <code>(<a class=quiet href="#srcsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_srcsound_tip)">src-sound</a> '(0 3 1 1))</code> with sinc-width at 4.
-</td></tr><tr><td colspan=3 height=16></td></tr>
-
-
-<!-- snd-version -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sndversion">snd-version</a></code></td>
-<td bgcolor="#f2f4ff"><code>"Snd 11.7, 9-Aug-10"</code></td></tr><tr><td></td><td colspan=2>
-This is a string giving the current Snd version.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+a sine wave at (say) 55 Hz, then <code>(<a class=quiet href="#srcsound">src-sound</a> '(0 3 1 1))</code>
+with sinc-width at 4.
+</p>
+<div class="spacer"></div>
<!-- sync-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="syncstyle">sync-style</a></code></td>
-<td bgcolor="#f2f4ff"><code>sync-by-sound</code></td></tr><tr><td></td><td colspan=2>
-sync-style determines how sounds and their channels are sync'd together when they are
-opened. <code>sync-none</code> means that no sounds, and no channels are tied together;
-<code>sync-all</code> causes everything to be tied together; <code>sync-by-sound</code>, the default, causes individual sounds to
+<pre class="indented">
+<em class=def id="syncstyle">sync-style</em> (default: sync-by-sound)
+</pre>
+
+<p>sync-style determines how sounds and their channels are sync'd together when they are
+opened. sync-none means that no sounds, and no channels are tied together;
+sync-all causes everything to be tied together; sync-by-sound, the default, causes individual sounds to
be separate, but if they have more than one channel, all the channels are tied together.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- temp-dir -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="tempdir">temp-dir</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-temp-dir is the directory to use for temporary files; if it is #f, Snd uses whatever the system default is, usually "/tmp" or "/var/tmp".
+<pre class="indented">
+<em class=def id="tempdir">temp-dir</em> (default: #f)
+</pre>
+
+<p>temp-dir is the directory to use for temporary files; if it is #f, Snd uses whatever the system default is, usually "/tmp" or "/var/tmp".
See also <a href="#sndtempnam">snd-tempnam</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
-<!-- trap-segfault -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="trapsegfault">trap-segfault</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t</code></td></tr><tr><td></td><td colspan=2>
-If trap-segfault is #t, Snd tries to catch segfaults and continue anyway. This normally gives you
-a chance to save your current work, but please also send bil at ccrma.stanford.edu a bug report!
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<!-- window-height -->
+<pre class="indented">
+<em class=def id="windowheight">window-height</em> (default: 0)
+</pre>
+<p>window-height is the current Snd window height in pixels.
+This is the same as
+</p>
-<!-- window-height -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="windowheight">window-height</a></code></td>
-<td bgcolor="#f2f4ff"><code>0</code></td></tr><tr><td></td><td colspan=2>
-window-height is the current Snd window height in pixels.
-This is the same as <br>
-<pre>
- Scheme: (cadr (<a class=quiet href="#widgetsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_widgetsize_tip)">widget-size</a> (cadr (<a class=quiet href="#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>))))
-
- Ruby: widget_size(main_widgets.cadr).cadr
-
- Forth: main-widgets cadr widget-size cadr
+<pre class="indented">
+Scheme: (cadr (<a class=quiet href="#widgetsize">widget-size</a> (cadr (<a class=quiet href="#mainwidgets">main-widgets</a>))))
+Ruby: widget_size(main_widgets.cadr).cadr
+Forth: main-widgets cadr widget-size cadr
</pre>
-except at startup when the window-height function and friends defer the assignment until after the main widgets
+
+<p>except at startup when the window-height function and friends defer the assignment until after the main widgets
have been created. If Snd becomes confused about screen size, it can make its main window so large that
you can't get at any of the decorations for resizing the window; in this emergency you can
<code>(set! (window-height) 300)</code> or some such number.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- window-width -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="windowwidth">window-width</a></code></td>
-<td bgcolor="#f2f4ff"><code>0</code></td></tr><tr><td></td><td colspan=2>
-This is the current Snd window width in pixels.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="windowwidth">window-width</em> (default: 0)
+</pre>
+
+<p>This is the current Snd window width in pixels.
+</p>
+<div class="spacer"></div>
<!-- window-x -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="windowx">window-x</a></code></td>
-<td bgcolor="#f2f4ff"><code>-1</code></td></tr><tr><td></td><td colspan=2>
-This is the current Snd window left side position in pixels (-1 means unset).
-This is (usually) the same as
-<pre>
- (car (<a class=quiet href="#widgetposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_widgetposition_tip)">widget-position</a> (cadr (<a class=quiet href="#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>))))
+<pre class="indented">
+<em class=def id="windowx">window-x</em> (default: -1)
</pre>
-</td></tr><tr><td colspan=3 height=16></td></tr>
+
+<p>This is the current Snd window left side position in pixels (-1 means unset).
+This is (usually) the same as
+<code>(car (<a class=quiet href="#widgetposition">widget-position</a> (cadr (<a class=quiet href="#mainwidgets">main-widgets</a>))))</code>.
+</p>
+<div class="spacer"></div>
<!-- window-y -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="windowy">window-y</a></code></td>
-<td bgcolor="#f2f4ff"><code>-1</code></td></tr><tr><td></td><td colspan=2>
-This is the current Snd window upper side position in pixels (X numbering starts at 0 at the top, -1 means unset).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="windowy">window-y</em> (default: -1)
+</pre>
+
+<p>This is the current Snd window upper side position in pixels (X numbering starts at 0 at the top, -1 means unset).
+</p>
+<div class="spacer"></div>
<!-- with-background-processes -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withbackgroundprocesses">with-background-processes</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t</code></td></tr><tr><td></td><td colspan=2>
-with-background-processes determines whether Snd should use background (idle time) processes for ffts and so forth.
+<pre class="indented">
+<em class=def id="withbackgroundprocesses">with-background-processes</em> (default: #t)
+</pre>
+
+<p>with-background-processes determines whether Snd should use background (idle time) processes for ffts and so forth.
It is intended primarily for auto-testing.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- with-file-monitor -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withfilemonitor">with-file-monitor</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t</code></td></tr><tr><td></td><td colspan=2>
-If with-file-monitor is #t (the default), the file alteration monitor is active. There are still bugs
+<pre class="indented">
+<em class=def id="withfilemonitor">with-file-monitor</em> (default: #t)
+</pre>
+
+<p>If with-file-monitor is #t, the file alteration monitor is active. There are still bugs
in this library that can cause Snd to hang — I haven't tracked down what the problem is yet; in the meantime,
-set this switch to #f to disable the monitor. (One such bug was fixed in gamin 1.8.0).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+set this switch to #f to disable the monitor.
+</p>
+<div class="spacer"></div>
<!-- with-inset-graph -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withinsetgraph">with-inset-graph</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-If with-inset-graph is #t, a small graph is
+<pre class="indented">
+<em class=def id="withinsetgraph">with-inset-graph</em> (default: #f)
+</pre>
+
+<p>If with-inset-graph is #t, a small graph is
added to the upper right corner showing the overall current sound and where the current window fits in it.
This information is implicit in the x axis zoom and position sliders, but a redundant graph doesn't hurt. If you click in that graph,
the cursor is moved to the clicked point.
+</p>
-<img src="pix/uppergrf.png" alt="with-inset-graph" hspace=20 vspace=10>
-<br>
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<img class="indented" src="pix/uppergrf.png" alt="with-inset-graph">
+<div class="spacer"></div>
+
+
+<!-- with-interrupts -->
+<pre class="indented">
+<em class=def id="withinterrupts">with-interrupts</em> (default: #t)
+</pre>
+
+<p>If with-interrupts is true, the Snd listener (in Gtk/Motif) adds a check for GUI activity to each
+computation called from the listener. This makes it possible to stop an infinite loop, or use the
+user interface while some long computation is running, but it also slows down that computation.
+To get the maximum performance, set this flag to false (#f).
+</p>
+<div class="spacer"></div>
<!-- with-menu-icons -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withmenuicons">with-menu-icons</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-with-menu-icons determines whether some menus display icons beside the item labels (in Gtk only).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="withmenuicons">with-menu-icons</em> (default: #t)
+</pre>
+
+<p>with-menu-icons determines whether some menus display icons beside the item labels (in Gtk only).
+This sets both gtk-menu-images and gtk-button-images. There are a lot of these default settings
+in gtk (see GtkSettings.html). To set one from Scheme:
+</p>
+
+<pre class="indented">
+(with-let *gtk* (g_object_set (GPOINTER (gtk_settings_get_default)) "gtk-menu-images" #t))
+</pre>
+
+<p>To get the current value of one of these settings, you need to tell xg the expected return
+type. In the next example, we assume we're getting an integer:
+</p>
+
+<pre class="indented">
+> (with-let *gtk* (g_object_get (GPOINTER (gtk_settings_get_default)) "gtk-cursor-blink-time" #f))
+1200
+</pre>
+<div class="spacer"></div>
<!-- with-pointer-focus -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withpointerfocus">with-pointer-focus</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-If with-pointer-focus is #t, whatever text or graph widget is underneath the mouse cursor is activated
+<pre class="indented">
+<em class=def id="withpointerfocus">with-pointer-focus</em> (default: #f)
+</pre>
+
+<p>If with-pointer-focus is #t, whatever text or graph widget is underneath the mouse cursor is activated
(this is sometimes known as "point-to-focus" mode).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- with-relative-panes -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withrelativepanes">with-relative-panes</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t</code></td></tr><tr><td></td><td colspan=2>
-If with-relative-panes is #t in the Motif
+<pre class="indented">
+<em class=def id="withrelativepanes">with-relative-panes</em> (default: #t)
+</pre>
+
+<p>If with-relative-panes is #t in the Motif
version of Snd, a multichannel sound tries to retain the relative channel graph sizes
when the outer sash (the overall sound size sash) changes.
Mono sounds and the listener are not affected (perhaps they should be?).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- with-smpte-label -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withsmptelabel">with-smpte-label</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-with-smpte-label shows the current SMPTE frame number in a box
+<pre class="indented">
+<em class=def id="withsmptelabel">with-smpte-label</em> (default: #f)
+</pre>
+
+<p>with-smpte-label shows the current SMPTE frame number in a box
in the upper left corner of the graph (see the picture above under add-mark-pane).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- with-toolbar -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withtoolbar">with-toolbar</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t (gtk), #f (motif)</code></td></tr><tr><td></td><td colspan=2>
-with-toolbar places a toolbar at the top of the Snd window, just under the main menu.
-
-<img src="pix/toolbar.png" alt="with-toolbar picture" hspace=20 vspace=10 usemap="#toolbarmap" border=0>
-<map name="toolbarmap"
- <area shape=rect coords="3, 42, 31, 76" alt="new sound icon" onmouseout="UnTip()" onmouseover="Tip('new sound')">
- <area shape=rect coords="32, 42, 60, 76" alt="open sound icon" onmouseout="UnTip()" onmouseover="Tip('open sound')">
- <area shape=rect coords="61, 42, 89, 76" alt="save icon" onmouseout="UnTip()" onmouseover="Tip('save edits')">
- <area shape=rect coords="90, 42, 118, 76" alt="revert icon" onmouseout="UnTip()" onmouseover="Tip('revert to saved')">
- <area shape=rect coords="119, 42, 149, 76" alt="undo icon" onmouseout="UnTip()" onmouseover="Tip('undo edit')">
- <area shape=rect coords="148, 42, 176, 76" alt="redo icon" onmouseout="UnTip()" onmouseover="Tip('redo edit')">
- <area shape=rect coords="177, 42, 205, 76" alt="close icon" onmouseout="UnTip()" onmouseover="Tip('close sound')">
- <area shape=rect coords="206, 42, 234, 76" alt="play icon" onmouseout="UnTip()" onmouseover="Tip('play from the start')">
- <area shape=rect coords="235, 42, 263, 76" alt="play from cursor icon" onmouseout="UnTip()" onmouseover="Tip('play from the cursor')">
- <area shape=rect coords="264, 42, 292, 76" alt="stop playing icon" onmouseout="UnTip()" onmouseover="Tip('stop playing')">
- <area shape=rect coords="293, 42, 321, 76" alt="full sound icon" onmouseout="UnTip()" onmouseover="Tip('show full sound')">
- <area shape=rect coords="322, 42, 350, 76" alt="zoom out icon" onmouseout="UnTip()" onmouseover="Tip('zoom out')">
- <area shape=rect coords="351, 42, 379, 76" alt="zoom in icon" onmouseout="UnTip()" onmouseover="Tip('zoom in')">
- <area shape=rect coords="380, 42, 408, 76" alt="start icon" onmouseout="UnTip()" onmouseover="Tip('go to start of sound')">
- <area shape=rect coords="409, 42, 437, 76" alt="back icon" onmouseout="UnTip()" onmouseover="Tip('go back a window')">
- <area shape=rect coords="438, 42, 466, 76" alt="next icon" onmouseout="UnTip()" onmouseover="Tip('go forward a window')">
- <area shape=rect coords="467, 42, 495, 76" alt="end icon" onmouseout="UnTip()" onmouseover="Tip('go to end of sound')">
- <area shape=rect coords="496, 42, 524, 76" alt="select icon" onmouseout="UnTip()" onmouseover="Tip('select all of sound')">
- <area shape=rect coords="525, 42, 553, 76" alt="unselect icon" onmouseout="UnTip()" onmouseover="Tip('unselect everything')">
- <area shape=rect coords="554, 42, 582, 76" alt="cut icon" onmouseout="UnTip()" onmouseover="Tip('delete selection')">
- <area shape=rect coords="583, 42, 611, 76" alt="paste icon" onmouseout="UnTip()" onmouseover="Tip('insert selection at cursor')">
- <area shape=rect coords="612, 42, 640, 76" alt="prefs icon" onmouseout="UnTip()" onmouseover="Tip('start preferences dialog')">
- <area shape=rect coords="641, 42, 669, 76" alt="quit icon" onmouseout="UnTip()" onmouseover="Tip('stop everything')">
- <area shape=rect coords="670, 42, 700, 76" alt="exit icon" onmouseout="UnTip()" onmouseover="Tip('exit Snd')">
-</map>
-
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="withtoolbar">with-toolbar</em> (default: #t (gtk), #f (motif))
+</pre>
+
+<p>with-toolbar places a toolbar at the top of the Snd window, just under the main menu.
+</p>
+
+<img class="indented" src="pix/toolbar.png" alt="with-toolbar picture">
+<div class="spacer"></div>
<!-- with-tooltips -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withtooltips">with-tooltips</a></code></td>
-<td bgcolor="#f2f4ff"><code>#t</code></td></tr><tr><td></td><td colspan=2>
-Set with-tooltips to #f to turn off tooltips.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="withtooltips">with-tooltips</em> (default: #t)
+</pre>
+
+<p>Set with-tooltips to #f to turn off tooltips.
+</p>
+<div class="spacer"></div>
<!-- with-tracking-cursor -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="withtrackingcursor">with-tracking-cursor</a></code></td>
-<td bgcolor="#f2f4ff"><code>#f</code></td></tr><tr><td></td><td colspan=2>
-<p>This is #t if the cursor always follows along in the sound during playback. If it is #f,
+<pre class="indented">
+<em class=def id="withtrackingcursor">with-tracking-cursor</em> (default: #f)
+</pre>
+
+<p id="trackingcursors">This is #t if the cursor always follows along in the sound during playback. If it is #f,
you get the tracking cursor displayed only when you ask for it (via control-click of the
-play button, for example).
+play button, for example). At the end of the play, the default is to return to the original (starting)
+cursor position. If you want the cursor to stay where it is, set with-tracking-cursor to :track-and-stay
+(#t = :track-and-return).
</p>
+
<p>
The interval (in seconds) between cursor updates is set by <a href="#cursorupdateinterval">cursor-update-interval</a>
which defaults to 0.05. The accuracy of the cursor in reflecting the sound coming out the speakers
@@ -1338,46 +1510,53 @@ apparent progress (if playing forwards).
</p>
<!-- INDEX trackingcursors:Tracking cursors -->
-<A NAME="trackingcursors"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
+<TABLE class="method">
+<tr><th class="title">tracking cursor</th></tr>
+<tr><td>
<blockquote><small>
-<br>
play from the current cursor position with a tracking cursor: <a href="#pfc">pfc</a><br>
display tracking cursor as a full height vertical line: <a href="#trackingcursorstyle">tracking-cursor-style</a><br>
track play once: control-click 'play'. (You can add a mark at the current tracking cursor location during the play with C-m)<br>
-leave the cursor at the final position after tracking play: if-cursor-follows-play-it-stays-where-play-stopped in examp.scm<br>
+leave the cursor at the final position after tracking play: (set! *with-tracking-cursor* :track-and-stay)<br>
tracking cursor accuracy: <a href="#cursorlocationoffset">cursor-location-offset</a><br>
tracking cursor updating: <a href="#cursorupdateinterval">cursor-update-interval</a><br>
-<br>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=3 height=16></td></tr>
+
+<div class="spacer"></div>
+
<!-- zoom-focus-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="zoomfocusstyle">zoom-focus-style</a></code></td>
-<td bgcolor="#f2f4ff"><code>zoom-focus-active</code></td></tr><tr><td></td><td colspan=2>
-This determines what a zoom action focuses (centers) on. The choices are
-<code>zoom-focus-left</code>, <code>zoom-focus-right</code>, <code>zoom-focus-active</code>, <code>zoom-focus-middle</code>,
+<pre class="indented">
+<em class=def id="zoomfocusstyle">zoom-focus-style</em> (default: zoom-focus-active)
+</pre>
+
+<p>This determines what a zoom action focuses (centers) on. The choices are
+zoom-focus-left, zoom-focus-right, zoom-focus-active, zoom-focus-middle,
or a function of 6 arguments. The function should return the new window left edge as a float.
Its arguments are the current sound, channel number, zoom slider value (0.0 to 1.0), time domain window left and right
edges in seconds, and the current total x axis size (seconds) corresponding to a slider value
of 1.0.
-<pre>
- (set! (zoom-focus-style) (lambda (snd chn zx x0 x1 range) (- x1 (* zx range))))
+</p>
+
+<pre class="indented">
+(set! (zoom-focus-style) (lambda (snd chn zx x0 x1 range) (- x1 (* zx range))))
</pre>
-mimics zoom-focus-right. <code>zoom-focus-active</code> tries to focus on some object in the view: the cursor, a mix or mark, etc.
+
+<p>mimics zoom-focus-right. zoom-focus-active tries to focus on some object in the view: the cursor, a mix or mark, etc.
See also <a href="snd.html#zoomoption">Zoom options</a>.
-</td></tr>
-</table>
-<br><br>
+</p>
+
+
-<!-- ---------------------------------------- GENERIC FUNCTIONS ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h4><A NAME="sndgenericfuncs">Generic functions</a></h4></td></tr></table>
+<!-- GENERIC FUNCTIONS -->
+
+<div class="header" id="sndgenericfuncs">Generic functions</div>
<p>Several functions in Snd are "generic" in the sense that they can handle a wide
variety of objects. The length function, for example, applies to strings and vectors,
@@ -1385,1564 +1564,1672 @@ as well as lists. Objects specific to Snd include sounds, the selection, mixes,
samplers, regions, and players, all of which should be compared with equal?, not eq?.
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
+<div class="spacer"></div>
<!-- channels -->
<!-- INDEX genericchannels:channels (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>channels</a> obj</code>
-</td></tr><tr><td></td><td>
-<A NAME="genericchannels">channels</A> handles strings (<a href="#mussoundchans">mus-sound-chans</a>),
+<pre class="indented">
+<em class=def>channels</em> obj
+</pre>
+
+<p id="genericchannels">channels handles strings (<a href="#mussoundchans">mus-sound-chans</a>),
<a href="#regionchans">region-chans</a>,
the current selection (<a href="#selectionchans">selection-chans</a>),
-<a href="#sounddatachans">sound-data-chans</a>, <a href="sndclm.html#genericfunctions">mus-channels</a>,
+<a href="sndclm.html#genericfunctions">mus-channels</a>,
<a href="#sndmixes">mixes</a>, <a href="#Vcts">vcts</a>, and vectors (always 1 channel), and
<a href="#sndsounds">sounds</a> (as objects or as integers).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="spacer"></div>
<!-- copy -->
<!-- INDEX genericcopy:copy (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>copy</a> obj</code>
-</td></tr><tr><td></td><td>
-<A NAME="genericcopy">copy</A> returns a copy of its argument.
-It works with strings, lists, vectors, hash tables, vcts, sound-data objects, frames, mixers, sounds, the current selection, mixes, marks,
+<pre class="indented">
+<em class=def>copy</em> obj
+</pre>
+
+<p id="genericcopy">copy returns a copy of its argument.
+It works with strings, lists, vectors, hash tables, float-vectors, sounds, the current selection, mixes, marks,
bignums, and the non-gmp random state objects.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="spacer"></div>
<!-- file-name -->
<!-- INDEX genericfilename:file-name (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>file-name</a> obj</code>
-</td></tr><tr><td></td><td>
-<A NAME="genericfilename">filename</A> can replace <a href="#musexpandfilename">mus-expand-filename</a>,
+<pre class="indented">
+<em class=def>file-name</em> obj
+</pre>
+
+<p id="genericfilename">filename can replace <a href="#musexpandfilename">mus-expand-filename</a>,
<a href="sndclm.html#genericfunctions">mus-file-name</a>, and (s7 scheme's) port-filename,
as well as handling mixes, regions, samplers, and the regular sound-oriented <a href="#filename">file-name</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="spacer"></div>
<!-- fill! -->
<!-- INDEX genericfill:fill! (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>fill!</a> obj val</code>
-</td></tr><tr><td></td><td>
-<A NAME="genericfill">fill!</A> fills obj with val (s7 only).
-fill! works with strings, vectors, hash-tables, vcts, lists, sounds, the selection, sound-data objects,
-frames, and mixers.
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
-
-<!-- frames -->
-<!-- INDEX genericframes:frames (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>frames</a> obj <em class=narg>chn edpos</em></code>
-</td></tr><tr><td></td><td>
-<A NAME="genericframes">frames</A> returns the number of "frames" in an object, that is,
-the number of samples per channel. The frames function overlaps
-the <a href="#genericlength">length</a> function, but length of a string is string-length, whereas frames of a string
-treats the string as a sound file name and returns <a href="#mussoundframes">mus-sound-frames</a>. frames can replace
-<a href="#mussoundframes">mus-sound-frames</a>, <a href="sndclm.html#genericfunctions">mus-length</a>,
+<pre class="indented">
+<em class=def>fill!</em> obj val
+</pre>
+
+<p id="genericfill">fill! fills obj with val (s7 only).
+fill! works with strings, vectors, hash-tables, float-vectors, lists, sounds, and the selection.
+</p>
+<div class="spacer"></div>
+
+
+<!-- framples -->
+<!-- INDEX genericframples:framples (generic) -->
+<pre class="indented">
+<em class=def>framples</em> obj chn edpos
+</pre>
+
+<p id="genericframples">framples returns the number of "framples" in an object, that is,
+the number of samples per channel (a frample is a set of samples, representing
+each channel's value at a given sampling instant, a "sample frame" or a "frame of samples"
+in old time terminology).
+</p>
+<p>
+The framples function overlaps
+the <a href="#genericlength">length</a> function, but length of a string is string-length, whereas framples of a string
+treats the string as a sound file name and returns <a href="#mussoundframples">mus-sound-framples</a>. framples can replace
+<a href="#mussoundframples">mus-sound-framples</a>, <a href="sndclm.html#genericfunctions">mus-length</a>,
<a href="#mixlength">mix-length</a>,
-<a href="#regionframes">region-frames</a>, <a href="#selectionframes">selection-frames</a>,
-<a href="#vctlength">vct-length</a>, <a href="#sounddatalength">sound-data-length</a>,
-and the regular <a href="#frames">frames</a> function that handles sound objects and integers as sound indices.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<a href="#regionframples">region-framples</a>, <a href="#selectionframples">selection-framples</a>,
+and the regular <a href="#framples">framples</a> function that handles sound objects and integers as sound indices.
+</p>
+<div class="spacer"></div>
<!-- length -->
<!-- INDEX genericlength:length (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>length</a> obj</code>
-</td></tr><tr><td></td><td>
-<A NAME="genericlength">length</A> handles list length, string-length, vector-length, <a href="s7.html#s7doc">hash-table-size</a>,
-<a href="#vctlength">vct-length</a>, <a href="#frames">frames</a> (sound length), <a href="#colormapsize">colormap-size</a>,
-<a href="sndclm.html#genericfunctions">mus-length</a> (generators), <a href="#sounddatalength">sound-data-length</a>,
+<pre class="indented">
+<em class=def>length</em> obj
+</pre>
+
+<p id="genericlength">length handles list length, string-length, vector-length,
+<a href="#framples">framples</a> (sound length), <a href="#colormapsize">colormap-size</a>,
+<a href="sndclm.html#genericfunctions">mus-length</a> (generators),
<a href="#mixlength">mix-length</a>, <a href="#transformsize">transform-size</a>,
-<a href="#selectionframes">selection-frames</a>,
-and <a href="#regionframes">region-frames</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<a href="#selectionframples">selection-framples</a>,
+and <a href="#regionframples">region-framples</a>.
+</p>
+<div class="spacer"></div>
<!-- maxamp -->
<!-- INDEX genericmaxamp:maxamp (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>maxamp</a> obj <em class=narg>chn</em></code>
-</td></tr><tr><td></td><td>
-<A NAME="genericmaxamp">maxamp</A> can handle a sound (via the regular <a href="#maxamp">maxamp</a> function),
+<pre class="indented">
+<em class=def>maxamp</em> obj chn
+</pre>
+
+<p id="genericmaxamp">maxamp can handle a sound (via the regular <a href="#maxamp">maxamp</a> function),
string (treated as a sound file name, <a href="#mussoundmaxamp">mus-sound-maxamp</a>),
generator (maxamp of the mus-data vct, if any),
-sound-data (<a href="#sounddatamaxamp">sound-data-maxamp</a>),
-vct (<a href="#vctpeak">vct-peak</a>),
+float-vector,
region (<a href="#regionmaxamp">region-maxamp</a>),
the current selection (<a href="#selectionmaxamp">selection-maxamp</a>),
vector, list, or mix object.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="spacer"></div>
<!-- play -->
<!-- INDEX genericplay:play (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>play</a> <em class=narg>object :start :end :channel :edit-position :out-channel :with-sync :wait :stop :srate :channels</em></code>
-</td></tr><tr><td></td><td>
-<A NAME="genericplay">play</A> plays an object.
+<pre class="indented">
+<em class=def>play</em> object :start :end :channel :edit-position :out-channel :with-sync :wait :stop :srate :channels
+</pre>
+
+<p id="genericplay">play plays an object.
The object can be a string (sound filename), a sound object or index, a mix, a region, the selection object, #f, a procedure, or a player.
Not all the keyword arguments apply in all cases, though I hope to fill in the table of possibilities eventually.
The full documentation is currently under <a href="#play">play</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="spacer"></div>
<!-- srate -->
<!-- INDEX genericsrate:srate (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>srate</a> obj</code>
-</td></tr><tr><td></td><td>
-<A NAME="genericsrate">srate</A> handles strings (treated as file names: <a href="#mussoundsrate">mus-sound-srate</a>),
+<pre class="indented">
+<em class=def>srate</em> obj
+</pre>
+
+<p id="genericsrate">srate handles strings (treated as file names: <a href="#mussoundsrate">mus-sound-srate</a>),
regions (<a href="#regionsrate">region-srate</a>), the selection (<a href="#selectionsrate">selection-srate</a>),
and <a href="#sndsounds">sounds</a> (as objects or as integers).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="spacer"></div>
<!-- sync -->
<!-- INDEX genericsync:sync (generic) -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>sync</a> obj</code>
-</td></tr><tr><td></td><td>
-<A NAME="genericsync">sync</A> accesses the '<a href="#sync">sync</a>' field of a sound, mark, or mix.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def>sync</em> obj
+</pre>
-</table>
+<p id="genericsync">sync accesses the '<a href="#sync">sync</a>' field of a sound, mark, or mix.
+</p>
-<br><br>
-<!-- ---------------------------------------- HOOKS ---------------------------------------- -->
+<!-- HOOKS -->
<!-- INDEX sndhooks:Hooks -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h4><A NAME="sndhooks">Hooks</a></h4></td></tr></table>
+
+<div class="header" id="sndhooks">Hooks</div>
<p>When some user-interface action takes place, code is called that responds to that action;
these functions are sometimes called callbacks; the variable that holds a list of such
callbacks is known as a hook.
-For example, the hook that is checked when you click the sound's name in the minibuffer is
+For example, the hook that is checked when you click the sound's name in the status area is
name-click-hook. We can cause that action to print "hi":</p>
-<pre>
- Scheme: (hook-push <a class=quiet href="#nameclickhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_nameclickhook_tip)">name-click-hook</a> (lambda (snd) (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> "hi") #t))
-
- Ruby: $name_click_hook.add_hook!("print") do |snd| snd_print("hi"); true end
-
- Forth: name-click-hook lambda: <{ snd }> "hi" snd-print drop #t ; add-hook!
+<pre class="indented">
+Scheme: (hook-push <a class=quiet href="#nameclickhook">name-click-hook</a> (lambda (hook) (<a class=quiet href="#sndprint">snd-print</a> "hi") (set! (hook 'result) #t)))
+Ruby: $name_click_hook.add_hook!("print") do |snd| snd_print("hi"); true end
+Forth: name-click-hook lambda: <{ snd }> "hi" snd-print drop #t ; add-hook!
</pre>
-<p>
-If there is more than one function attached to a hook, some of the hooks
-"or" the functions together (marked <b>[or]</b> below); that is they
+<p>The Scheme hook function is slightly different from the Forth and Ruby cases. For about 15 years, Snd used Guile-style
+hooks which are essentially a list of functions, each called with the hook arguments ('snd' above). But now Scheme hooks
+are functions that have three internal lists of functions. The internal functions (the things we add to hook-functions, for example)
+take the hook's internal environment as their only argument ('hook' above), and then access the actual hook arguments
+via <code>(hook name)</code>. So, the examples are confusing because the situation is confused! To move between the
+versions, match the Forth/Ruby argument name to the Scheme hook variable, so the function argument 'snd in Forth/Ruby
+is <code>(hook 'snd)</code> in Scheme.
+</p>
+
+<p>In Ruby and Forth, but not in Scheme,
+if there is more than one function attached to a hook, some of the hooks
+"or" the functions together; that is they
run through the list of functions, and if any function returns something other than #f, the
hook invocation eventually returns the last such non-#f value. A few hooks are "cascade"
hooks; that is, each function gets the result of the previous function, and
the final function's value is returned.
-In the other
-cases ("progn", the name coming from Common Lisp), the result returned by the hook is the result of the last function in the list.
+In other
+cases the result returned by the hook is the result of the last function in the list.
Whatever the hook combination choice, all the functions on the hook list are run
-on each invocation. There are a variety of hook-related functions in hooks.scm.
+on each invocation.
+</p>
+
+<p>In Scheme, all functions are run, each takes one argument, the hook environment, and any return values are ignored. It is
+up to the individual functions to track <code>(hook 'result)</code> if intermediate results matter.
</p>
+
<p>There are several basic actions that involve a bunch of hooks. Here is a schematic view of
some of these sequences.
</p>
<pre>
Open filename
- bad header?: <a class=quiet href="#badheaderhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_badheaderhook_tip)">bad-header-hook</a> — can cancel request
- no header?: <a class=quiet href="#openrawsoundhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_openrawsoundhook_tip)">open-raw-sound-hook</a> — can cancel request
+ bad header?: <a class=quiet href="#badheaderhook">bad-header-hook</a> — can cancel request
+ no header?: <a class=quiet href="#openrawsoundhook">open-raw-sound-hook</a> — can cancel request
file ok:
- <a class=quiet href="#openhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_openhook_tip)">open-hook</a> — can change filename
+ <a class=quiet href="#openhook">open-hook</a> — can change filename
file opened (no data read yet)
- <a class=quiet href="#duringopenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_duringopenhook_tip)">during-open-hook</a> (can set prescaling etc)
+ <a class=quiet href="#duringopenhook">during-open-hook</a> (can set prescaling etc)
data read, no graphics yet
- <a class=quiet href="#afteropenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afteropenhook_tip)">after-open-hook</a>
- <a class=quiet href="#initialgraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_initialgraphhook_tip)">initial-graph-hook</a>
+ <a class=quiet href="#afteropenhook">after-open-hook</a>
+ <a class=quiet href="#initialgraphhook">initial-graph-hook</a>
Save current sound
- <a class=quiet href="#beforesaveashook" onmouseout="UnTip()" onmouseover="Tip(extsnd_beforesaveashook_tip)">before-save-as-hook</a> — can cancel the request or set its output parameters
- <a class=quiet href="#savehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_savehook_tip)">save-hook</a>
+ <a class=quiet href="#beforesaveashook">before-save-as-hook</a> — can cancel the request or set its output parameters
+ <a class=quiet href="#savehook">save-hook</a>
sound saved
- if any sample is clipped during save, <a class=quiet href="#cliphook" onmouseout="UnTip()" onmouseover="Tip(extsnd_cliphook_tip)">clip-hook</a>
- <a class=quiet href="#aftersaveashook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftersaveashook_tip)">after-save-as-hook</a>
+ if any sample is clipped during save, <a class=quiet href="#cliphook">clip-hook</a>
+ <a class=quiet href="#aftersaveashook">after-save-as-hook</a>
Play sound
- when a play request occurs: <a class=quiet href="#startplayinghook" onmouseout="UnTip()" onmouseover="Tip(extsnd_startplayinghook_tip)">start-playing-hook</a> — can cancel the request, also <a class=quiet href="#startplayingselectionhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_startplayingselectionhook_tip)">start-playing-selection-hook</a>
+ when a play request occurs: <a class=quiet href="#startplayinghook">start-playing-hook</a> — can cancel the request, also <a class=quiet href="#startplayingselectionhook">start-playing-selection-hook</a>
(any number of sounds can be playing at once)
- as each buffer is sent to the audio device: <a class=quiet href="#playhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_playhook_tip)">play-hook</a> and <a class=quiet href="#dachook" onmouseout="UnTip()" onmouseover="Tip(extsnd_dachook_tip)">dac-hook</a>
- as each sound ends: <a class=quiet href="#stopplayinghook" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopplayinghook_tip)">stop-playing-hook</a>, <a class=quiet href="#stopplayingselectionhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopplayingselectionhook_tip)">stop-playing-selection-hook</a>
- close audio device: <a class=quiet href="#stopdachook" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopdachook_tip)">stop-dac-hook</a>
+ as each sound ends: <a class=quiet href="#stopplayinghook">stop-playing-hook</a>, <a class=quiet href="#stopplayingselectionhook">stop-playing-selection-hook</a>
Close sound
- <a class=quiet href="#beforeclosehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_beforeclosehook_tip)">before-close-hook</a> — can cancel close
- <a class=quiet href="#closehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_closehook_tip)">close-hook</a> (sound is still open)
+ <a class=quiet href="#beforeclosehook">before-close-hook</a> — can cancel close
+ <a class=quiet href="#closehook">close-hook</a> (sound is still open)
sound closed
Save current Snd ("session") state
- <a class=quiet href="#savestatehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_savestatehook_tip)">save-state-hook</a> — can change output filename (crummy name is an historical artifact)
+ <a class=quiet href="#savestatehook">save-state-hook</a> — can change output filename (crummy name is an historical artifact)
output save-state file opened
- <a class=quiet href="#beforesavestatehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_beforesavestatehook_tip)">before-save-state-hook</a>
+ <a class=quiet href="#beforesavestatehook">before-save-state-hook</a>
Snd saves its state
- <a class=quiet href="#aftersavestatehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftersavestatehook_tip)">after-save-state-hook</a>
+ <a class=quiet href="#aftersavestatehook">after-save-state-hook</a>
output closed
Exit Snd
- <a class=quiet href="#beforeexithook" onmouseout="UnTip()" onmouseover="Tip(extsnd_beforeexithook_tip)">before-exit-hook</a> — can cancel exit request
- <a class=quiet href="#exithook" onmouseout="UnTip()" onmouseover="Tip(extsnd_exithook_tip)">exit-hook</a>
+ <a class=quiet href="#beforeexithook">before-exit-hook</a> — can cancel exit request
+ <a class=quiet href="#exithook">exit-hook</a>
Snd cleans up and exits
</pre>
-<p>
-You can find out what's on a given hook with the following (which is mostly adding carriage returns to the
-printout from hook-functions):
-</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define (describe-hook hook)
- (for-each
- (lambda (n)
- (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A~%" n)))
- (reverse (<em class=red>hook-functions</em> hook))))
-</pre></td></tr></table>
-
<p>Here's the Ruby version of some of the hook-related functions:
</p>
-<pre>
- $var_hook.remove_hook!("proc_name")
- $var_hook.reset_hook!
- $var_hook.run_hook do |prc| prc.call(1, 2, 3) end
- $var_hook.call(1, 2, 3) # calls all procedures
+
+<pre class="indented">
+$var_hook.remove_hook!("proc_name")
+$var_hook.reset_hook!
+$var_hook.run_hook do |prc| prc.call(1, 2, 3) end
+$var_hook.call(1, 2, 3) # calls all procedures
- require 'hooks'
- $var_hook.show # prints the code of the procedure(s)
- $va_hook.to_a
+require 'hooks'
+$var_hook.show # prints the code of the procedure(s)
+$va_hook.to_a
</pre>
<p>And some Forth examples, taken from Mike Scholz's documentation:
</p>
-<pre>
- open-hook ' open-buffer 1 make-proc add-hook!
- open-hook "open-buffer" remove-hook!
- open-hook reset-hook!
- open-hook hook->list
+
+<pre class="indented">
+open-hook ' open-buffer 1 make-proc add-hook!
+open-hook "open-buffer" remove-hook!
+open-hook reset-hook!
+open-hook hook->list
- 2 "A simple hook." create-hook my-new-hook
- my-new-hook ' + 2 make-proc add-hook!
- my-new-hook '( 2 3 ) run-hook
- help my-new-hook
+2 "A simple hook." create-hook my-new-hook
+my-new-hook ' + 2 make-proc add-hook!
+my-new-hook '( 2 3 ) run-hook
+help my-new-hook
</pre>
-
<p>These hooks are extremely easy to add; if there's some user-interface action
you'd like to specialize in some way, send me a note.
hooks.scm has snd-hooks and reset-all-hooks, as well as other
useful hook-related functions.
</p>
-<!-- -------------------------------- HOOK TABLE -------------------------------- -->
-
<p>
In the following list of hooks, the arguments after the hook name refer to the arguments to the functions invoked by
-the hook. That is, <code>after-apply-controls-hook (snd)</code> means that the functions on the
-<a class=quiet href="#afterapplycontrolshook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afterapplycontrolshook_tip)">after-apply-controls-hook</a> list each take one argument, a sound.
-If the argument list is followed by some
-indication such as "[or]", that means the various hook function values are or-d together.
+the hook (in Ruby and Forth). That is, after-apply-controls-hook (snd) means that the functions on the
+<a class=quiet href="#afterapplycontrolshook">after-apply-controls-hook</a> list each take one argument, a sound. In Scheme, they refer to the hook variables accessible in the hook environment via <code>(hook 'snd)</code>, for example.
</p>
+<div class="spacer"></div>
-<table border=0 cellspacing=4 cellpadding=6>
<!-- after-apply-controls-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="afterapplycontrolshook">after-apply-controls-hook</a> (snd)</code>
-</td></tr><tr><td width=30></td><td colspan=2>
-This hook is called when <a href="#applycontrols">apply-controls</a> finishes.
+<pre class="indented">
+<em class=def id="afterapplycontrolshook">after-apply-controls-hook</em> (snd)
+</pre>
+
+<p>This hook is called when <a href="#applycontrols">apply-controls</a> finishes.
<a href="sndscm.html#addampcontrols">add-amp-controls</a> in snd-motif.scm uses this hook to
reset any added amplitude sliders to 1.0.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- after-graph-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="aftergraphhook">after-graph-hook</a> (snd chn)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called after a graph is updated or redisplayed.
+<pre class="indented">
+<em class=def id="aftergraphhook">after-graph-hook</em> (snd chn)
+</pre>
+
+<p>This hook is called after a graph is updated or redisplayed.
Use it to add your own finishing touches to the display; if added earlier they risk
being erased by Snd as it redraws graphs.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- after-lisp-graph-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="afterlispgraphhook">after-lisp-graph-hook</a> (snd chn)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called after a "lisp" graph is updated or redisplayed. The <a href="#lispgraphhook">lisp-graph-hook</a> functions
+<pre class="indented">
+<em class=def id="afterlispgraphhook">after-lisp-graph-hook</em> (snd chn)
+</pre>
+
+<p>This hook is called after a "lisp" graph is updated or redisplayed. The <a href="#lispgraphhook">lisp-graph-hook</a> functions
are called before the actual graph is displayed, so if you want to add to a graph in some way, you need to
use after-lisp-graph-hook.
<a href="sndscm.html#displaybarkfft">display-bark-fft</a> in dsp.scm uses it to draw the x axis labels and
ticks for various frequency scales.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- after-open-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="afteropenhook">after-open-hook</a> (snd)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called just before a newly opened sound's window is displayed.
-This provides a way to set various sound-specific defaults.
+<pre class="indented">
+<em class=def id="afteropenhook">after-open-hook</em> (snd)
+</pre>
+
+<p>This hook is called just before a newly opened sound's window is displayed.
+It provides a way to set various sound-specific defaults.
For example, the following causes Snd to default to locally
sync'd channels (that is, each sound's channels are sync'd
together but are independent of any other sound), united channels (all chans in one graph),
and filled graphs (not line segments or dots, etc):
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>after-open-hook</em>
- (lambda (snd)
- (if (> (<a class=quiet href="#channels" onmouseout="UnTip()" onmouseover="Tip(extsnd_channels_tip)">channels</a> snd) 1)
- (begin
- (set! (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> snd) (+ 1 snd)) ; 0 = #f
- (set! (<a class=quiet href="#channelstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelstyle_tip)">channel-style</a> snd) <a class=quiet href="#channelstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelstyle_tip)">channels-combined</a>)
- (set! (<a class=quiet href="#graphstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphstyle_tip)">graph-style</a> snd) <a class=quiet href="#graphstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphstyle_tip)">graph-filled</a>)))))
-</pre></td></tr></table>
+ (lambda (hook)
+ (let ((snd (hook 'snd)))
+ (if (> (<a class=quiet href="#channels">channels</a> snd) 1)
+ (begin
+ (set! (<a class=quiet href="#sync">sync</a> snd) (+ 1 (sync-max)))
+ (set! (<a class=quiet href="#channelstyle">channel-style</a> snd) <a class=quiet href="#channelstyle">channels-combined</a>)
+ (set! (<a class=quiet href="#graphstyle">graph-style</a> snd) <a class=quiet href="#graphstyle">graph-filled</a>))))))
+</pre>
-See also <a href="sndscm.html#xbopen">C-x b</a> support in examp.scm,
+<p>See also
enved.scm, and various examples in snd-motif.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- after-save-as-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="aftersaveashook">after-save-as-hook</a> (index filename from-dialog)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called after File:Save as.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="aftersaveashook">after-save-as-hook</em> (snd name dialog)
+</pre>
+
+<p>This hook is called after File:Save as. ('snd = sound index, 'name = full filename, 'dialog = #t if called from a dialog).
+</p>
+<div class="spacer"></div>
+
<!-- after-save-state-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="aftersavestatehook">after-save-state-hook</a> (filename)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called after Snd has saved its state (<a href="#savestate">save-state</a>). 'filename' is the (otherwise complete) saved state
-program. See <a href="sndscm.html#wssavestate">ws-save-state</a> in ws.scm. It uses this sequence:
-<br>
-<pre>
-(lambda (filename)
- (let ((fd (open filename (logior O_RDWR O_APPEND)))) ; open to write at the end
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> fd "~%~%;;; save-state stuff here ~%")
- ...
- (close fd)))
+<pre class="indented">
+<em class=def id="aftersavestatehook">after-save-state-hook</em> (name)
+</pre>
+
+<p>This hook is called after Snd has saved its state (<a href="#savestate">save-state</a>). 'name is the (otherwise complete) saved state
+program (a filename). See <a href="sndscm.html#wssavestate">ws-save-state</a> in ws.scm. It uses this sequence:
+</p>
+
+<pre class="indented">
+(let ((fd (open-output-file filename "a"))) ; "a" = append
+ (format fd "~%~%;;; from ws.scm~%")
+ ...
+ (close-output-port fd))
</pre>
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<div class="spacer"></div>
<!-- after-transform-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="aftertransformhook">after-transform-hook</a> (snd chn scaler)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called just after an FFT (or spectrum) is calculated.
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (<A NAME="fftpeak">report-fft-peak</A> snd chn scale)
- (if (and (<a class=quiet href="#transformgraphp" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformgraphp_tip)">transform-graph?</a>)
- (= (<a class=quiet href="#transformgraphtype" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformgraphtype_tip)">transform-graph-type</a>) <a class=quiet href="#transformgraphtype" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformgraphtype_tip)">graph-once</a>))
- (<a class=quiet href="#reportinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_reportinminibuffer_tip)">report-in-minibuffer</a>
- (number->string (/ (* 2 (<a class=quiet href="#vctpeak" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctpeak_tip)">vct-peak</a> (<a class=quiet href="#transformtovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformtovct_tip)">transform->vct</a> snd chn)))
- (<a class=quiet href="#transformsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformsize_tip)">transform-size</a> snd chn))))))
-(hook-push <em class=red>after-transform-hook</em> report-fft-peak)
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="aftertransformhook">after-transform-hook</em> (snd chn scaler)
+</pre>
+
+<p id="fftpeak">This hook is called just after an FFT (or spectrum) is calculated.
+</p>
+
+<pre class="indented">
+(define (report-fft-peak snd chn)
+ (if (and (<a class=quiet href="#transformgraphp">transform-graph?</a>)
+ (= (<a class=quiet href="#transformgraphtype">transform-graph-type</a>) <a class=quiet href="#transformgraphtype">graph-once</a>))
+ (<a class=quiet href="#statusreport">status-report</a>
+ (number->string (/ (* 2 (maxamp (transform->float-vector snd chn)))
+ (<a class=quiet href="#transformsize">transform-size</a> snd chn))))))
+
+(hook-push <em class=red>after-transform-hook</em>
+ (lambda (hook)
+ (report-fft-peak (hook 'snd) (hook 'chn))))
+</pre>
+<div class="spacer"></div>
<!-- bad-header-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="badheaderhook">bad-header-hook</a> (filename)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called if a file has a bogus-looking header (that is,
+<pre class="indented">
+<em class=def id="badheaderhook">bad-header-hook</em> (name)
+</pre>
+
+<p>This hook is called if a file has a bogus-looking header (that is,
a header with what appear to be bad values such as a negative number of channels).
-If a hook function returns #t, Snd does not try to open the file.
-<pre>
- (hook-push bad-header-hook (lambda (n) #t)) ; don't open bogus-looking files
+If the hook returns #t, Snd does not try to open the file.
+</p>
+
+<pre class="indented">
+(hook-push bad-header-hook
+ (lambda (hook)
+ (set! (hook 'result) #t))) ; don't open bogus-looking files
</pre>
-If no header is found, <a href="#openrawsoundhook">open-raw-sound-hook</a> is invoked instead ("raw" = "headerless").
-</td></tr><tr><td colspan=3 height=16></td></tr>
+
+<p>If no header is found, <a href="#openrawsoundhook">open-raw-sound-hook</a> is invoked instead ("raw" = "headerless").
+</p>
+<div class="spacer"></div>
<!-- before-close-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="beforeclosehook">before-close-hook</a> (snd) </code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a file is about to be closed. If a hook function returns #t, the file is not closed.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="beforeclosehook">before-close-hook</em> (snd)
+</pre>
+
+<p>This hook is called when a file is about to be closed. If the hook returns #t, the file is not closed.
+</p>
+<div class="spacer"></div>
<!-- before-exit-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="beforeexithook">before-exit-hook</a> ()</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon a request to exit Snd.
-If a hook function returns #t, Snd does not exit.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="beforeexithook">before-exit-hook</em> ()
+</pre>
+
+<p>This hook is called upon a request to exit Snd.
+If the hook returns #t, Snd does not exit.
+</p>
+<div class="spacer"></div>
<!-- before-save-as-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="beforesaveashook">before-save-as-hook</a> (index filename selection srate header-type data-format comment)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called before <a href="#savesoundas">save-sound-as</a> or File:Save as.
-If a hook function returns something other than #f, the
+<pre class="indented">
+<em class=def id="beforesaveashook">before-save-as-hook</em> (snd name selection sampling-rate sample-type header-type comment)
+</pre>
+
+<p>This hook is called before <a href="#savesoundas">save-sound-as</a> or File:Save as.
+If the hook returns #t, the
save is not performed. This hook provides a way to do last minute fixups (srate conversion for example)
just before a sound is saved. The arguments to the hook function describe the requested attributes of the saved sound;
-'index' is the to-be-saved sound's index; 'filename' is the output file's name; 'selection' is #t if
+'snd' is the to-be-saved sound's index; 'name' is the output file's name; 'selection' is #t if
we're saving the selection.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>before-save-as-hook</em>
- (lambda (index filename selection sr type format comment)
- (if (not (= sr (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> index)))
- (let ((chns (<a class=quiet href="#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a> index)))
- (do ((i 0 (+ 1 i)))
- ((= i chns))
- (<a class=quiet href="#srcchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_srcchannel_tip)">src-channel</a> (exact->inexact (/ (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> index) sr)) 0 #f index i))
- (<a class=quiet href="#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a> filename index :header-type type :data-format format :srate sr :comment comment)
- ;; hook won't be invoked recursively
- (do ((i 0 (+ 1 i)))
- ((= i chns))
- (<a class=quiet href="#undo" onmouseout="UnTip()" onmouseover="Tip(extsnd_undo_tip)">undo</a> 1 index i))
- #t) ; tell Snd that the sound is already saved
- #f)))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ ((lambda (index filename sr dformat htype comment)
+ (if (not (= sr (<a class=quiet href="#srate">srate</a> index)))
+ (let ((chns (<a class=quiet href="#chans">channels</a> index)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (<a class=quiet href="#srcchannel">src-channel</a> (exact->inexact (/ (<a class=quiet href="#srate">srate</a> index) sr)) 0 #f index i))
+ (<a class=quiet href="#savesoundas">save-sound-as</a> filename index :header-type htype :sample-type dformat :srate sr :comment comment)
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (<a class=quiet href="#undo">undo</a> 1 index i))
+ (set! (hook 'result) #t)))) ; tell Snd that the sound is already saved
+ (hook 'snd) (hook 'name) (hook 'sampling-rate) (hook 'header-type) (hook 'sample-type) (hook 'comment))))
+
+</pre>
+<div class="spacer"></div>
<!-- before-save-state-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="beforesavestatehook">before-save-state-hook</a> (filename)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called before Snd saves its state (<a href="#savestate">save-state</a>). 'filename' is the saved state
-file. If the hook functions return #t, the save state file is opened in append mode (rather than create/truncate),
+<pre class="indented">
+<em class=def id="beforesavestatehook">before-save-state-hook</em> (name)
+</pre>
+
+<p>This hook is called before Snd saves its state (<a href="#savestate">save-state</a>). 'name' is the saved state
+file. If the hook returns #t, the save state file is opened in append mode (rather than create/truncate),
so you can write preliminary stuff via this hook, then instruct Snd not to clobber it during the save process.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>before-save-state-hook</em>
- (lambda (name)
- (<span onmouseout="UnTip()" onmouseover="Tip('io-open-write in Forth (see fs.fs); File.open in Ruby (I think — see extensions.rb)')">with-output-to-file name</span>
- (lambda ()
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f ";this comment will be at the top of the saved state file.~%~%"))
- #t))))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (call-with-output-file (hook 'name)
+ (lambda (p)
+ (<a class=quiet>format</a> p ";this comment will be at the top of the saved state file.~%~%")))
+ (set! (hook 'result) #t)))
+</pre>
+<div class="spacer"></div>
<!-- before-transform-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="beforetransformhook">before-transform-hook</a> (snd chn)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called just before an FFT (or spectrum) is calculated. If a hook function returns
+<pre class="indented">
+<em class=def id="beforetransformhook">before-transform-hook</em> (snd chn)
+</pre>
+
+<p>This hook is called just before an FFT (or spectrum) is calculated. If the hook returns
an integer, that value is used as the starting point (sample number) of the fft. Normally,
the fft starts from the left window edge. To have it start at mid-window:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>before-transform-hook</em>
- (lambda (snd chn) ; 0.5 * (left + right) = midpoint
- (round (* 0.5 (+ (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn) (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn))))))
-</pre></td></tr></table>
+ (lambda (hook) ; 0.5 * (left + right) = midpoint
+ (set! (hook 'result)
+ (round (* 0.5 (+ (<a class=quiet href="#rightsample">right-sample</a> (hook 'snd) (hook 'chn))
+ (<a class=quiet href="#leftsample">left-sample</a> (hook 'snd) (hook 'chn))))))))
+</pre>
-The following
+<p>The following
somewhat brute-force code shows a way to have the fft reflect the position
of a moving mark:
+</p>
+
+<pre class="indented">
+(let ((fft-position #f))
+ (hook-push <em class=red>before-transform-hook</em>
+ (lambda (hook)
+ (set! (hook 'result) fft-position)))
+ (hook-push <a class=quiet href="#markdraghook">mark-drag-hook</a>
+ (lambda (hook)
+ (set! fft-position (<a class=quiet href="#marksample">mark-sample</a> (hook 'id)))
+ (<a class=quiet href="#updatetransformgraph">update-transform-graph</a>))))
+</pre>
+<div class="spacer"></div>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define fft-position #f)
-(hook-push <em class=red>before-transform-hook</em> (lambda (snd chn) fft-position))
-(hook-push <a class=quiet href="#markdraghook" onmouseout="UnTip()" onmouseover="Tip(extsnd_markdraghook_tip)">mark-drag-hook</a> (lambda (id)
- (set! fft-position (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> id))
- (<a class=quiet href="#updatetransformgraph" onmouseout="UnTip()" onmouseover="Tip(extsnd_updatetransformgraph_tip)">update-transform-graph</a>)))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
<!-- clip-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="cliphook">clip-hook</a> (clipping-value) </code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called whenever a sample is about to be clipped while writing out a sound file.
-The hook function can return the new value.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="cliphook">clip-hook</em> (val)
+</pre>
+<p>This hook is called whenever a sample is about to be clipped while writing out a sound file.
+The hook can return the new value.
+</p>
+<div class="spacer"></div>
-<!-- close-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="closehook">close-hook</a> (snd)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a file is closed (before the actual close, so the index 'snd' is still valid).
-<table border=0><tr><td>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(hook-push <em class=red>close-hook</em>
- (lambda (snd)
- (system "sndplay wood16.wav")))
-</pre></td></tr></table>
-</td><td width=30></td><td>
+<!-- close-hook -->
+<pre class="indented">
+<em class=def id="closehook">close-hook</em> (snd)
+</pre>
-<table border=0 cellpadding=5 vspace=10><tr><td bgcolor="Beige"><pre>
-<em class=red>$close_hook</em>.add_hook!("play") do |snd|
- system("aplay wood16.wav")
-end
-</pre></td></tr></table>
+<p>This hook is called when a file is closed (before the actual close, so the index 'snd' is still valid).
+</p>
-</td></tr></table>
-close-hook is used in <a href="sndscm.html#autosavedoc">autosave.scm</a>,
-the <a href="sndscm.html#xbopen">C-x b</a> support in examp.scm,
-and many other places.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+(hook-push <em class=red>close-hook</em>
+ (lambda (hook)
+ (play "wood16.wav")))
+</pre>
+<div class="spacer"></div>
<!-- color-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="colorhook">color-hook</a> () </code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called whenever one of the variables associated with the color dialog changes.
-See <a href="sndscm.html#startwaterfall">start-waterfall</a> in snd-gl.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="colorhook">color-hook</em> ()
+</pre>
+<p>This hook is called whenever one of the variables associated with the color dialog changes.
+</p>
+<div class="spacer"></div>
-<!-- dac-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="dachook">dac-hook</a> (data) </code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called just before data is sent to DAC; 'data' is a <a href="#sndsounddata">sound-data</a> object.
-See <a href="sndscm.html#withlevelmeters">with-level-meters</a> in snd-motif.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
<!-- draw-mark-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="drawmarkhook">draw-mark-hook</a> (mark)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called before a mark is drawn. If the hook function returns #t, the mark is not drawn.
+<pre class="indented">
+<em class=def id="drawmarkhook">draw-mark-hook</em> (id)
+</pre>
+
+<p>This hook is called before a mark is drawn. If the hook returns #t, the mark is not drawn.
<a href="sndscm.html#marksynccolor">mark-sync-color</a>
in snd-motif.scm uses this hook to draw sync'd marks in some other color than the current <a href="#markcolor">mark-color</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- draw-mix-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="drawmixhook">draw-mix-hook</a> (mix old-x old-y x y)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called before a mix tag is drawn. If the hook function returns either #t or a list, the mix tag is not drawn by Snd (the
+<pre class="indented">
+<em class=def id="drawmixhook">draw-mix-hook</em> (id old-x old-y x y)
+</pre>
+
+<p>This hook is called before a mix tag is drawn. If the hook returns either #t or a list, the mix tag is not drawn by Snd (the
assumption is that the hook function drew something). old-x and old-y are the previous mix tag positions (in case
you're using draw-mix-hook to draw your own mix tag as in musglyphs.scm). x and y give the current position.
-If the hook function returns a list, its two elements (integers) are treated as the mix's tag x and y locations
+If the hook returns a list, its two elements (integers) are treated as the mix's tag x and y locations
for subsequent mouse click hit detection.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- drop-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="drophook">drop-hook</a> (filename) </code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time Snd receives a drag-and-drop event, passing the hook functions the dropped filename.
-If the hook functions return #t, the file is not opened by Snd. Normally if you drag a file icon to the menubar,
+<pre class="indented">
+<em class=def id="drophook">drop-hook</em> (name)
+</pre>
+
+<p>This hook is called each time Snd receives a drag-and-drop event, passing the hook functions the dropped filename.
+If the hook returns #t, the file is not opened by Snd. Normally if you drag a file icon to the menubar,
Snd opens it as if you had called <a href="#opensound">open-sound</a>. If you drag the icon to a particular channel,
Snd mixes it at the mouse location in that channel. To get Snd to
mix the dragged file even from the menubar:
-<pre>
- (hook-push <em class=red>drop-hook</em> (lambda (filename) (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> filename) #t)) ; return #t = we already dealt with the drop
+</p>
+
+<pre class="indented">
+(hook-push <em class=red>drop-hook</em>
+ (lambda (hook)
+ (<a class=quiet href="#mix">mix</a> (hook 'name))
+ (set! (hook 'result) #t))) ; return #t = we already dealt with the drop
</pre>
-snd-motif.scm has examples that add a drop callback to an arbitrary widget, or
-change an existing callback (to pass the sound and channel number to the drop callback function, bypassing drop-hook).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<div class="spacer"></div>
<!-- during-open-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="duringopenhook">during-open-hook</a> (fd name reason)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called after file is opened, but before data has been read.
-This provides an opportunity to set sndlib prescaling values:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(hook-push <em class=red>during-open-hook</em>
- (lambda (fd name reason)
- (if (= (<a class=quiet href="#mussoundheadertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundheadertype_tip)">mus-sound-header-type</a> name) <a class=quiet href="#headertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_musraw_tip)">mus-raw</a>)
- (set! (<a href="#musfileprescaler" onmouseout="UnTip()" onmouseover="Tip(extsnd_musfileprescaler_tip)">mus-file-prescaler</a> fd) 500.0))))
-</pre></td></tr></table>
-
-The prescaling affects only sound data made up of floats or doubles. 'reason' is an integer indicating why this file is being opened:
-<pre>
- 0: reopen a temporarily closed file (internal to Snd — normally invisible)
- 1: sound-open, File:open etc — the normal path to open a sound
- 2: copy reader — another internal case; this happens if a sound is played and edited at the same time
- 3: insert sound (File:Insert etc)
- 4: re-read after an edit (file changed, etc — an invisible editing case)
- 5: open temp file after an edit (another invisible editing case)
- 6: mix sound (File:Mix etc)
-</pre>
-So, to restrict the hook action to the normal case where Snd is opening a file for the first time,
+<pre class="indented">
+<em class=def id="duringopenhook">during-open-hook</em> (fd name reason)
+</pre>
+
+<p>This hook is called after a file is opened, but before its data has been read.
+'reason' is an integer indicating why this file is being opened:
+</p>
+<pre class="indented">
+0: reopen a temporarily closed file (internal to Snd — normally invisible)
+1: sound-open, File:open etc — the normal path to open a sound
+2: copy reader — another internal case; this happens if a sound is played and edited at the same time
+3: insert sound (File:Insert etc)
+4: re-read after an edit (file changed, etc — an invisible editing case)
+5: open temp file after an edit (another invisible editing case)
+6: mix sound (File:Mix etc)
+</pre>
+
+<p>So, to restrict the hook action to the normal case where Snd is opening a file for the first time,
check that 'reason' is 1, or perhaps 1, 3, or 6 (these read the external form of the data).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- effects-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="effectshook">effects-hook</a> ()</code>
-</td></tr><tr><td></td><td colspan=2>
-effects-hook is a convenience hook for the effects dialogs.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="effectshook">effects-hook</em> ()
+</pre>
+
+<p>effects-hook is a convenience hook for the effects dialogs.
+</p>
+<div class="spacer"></div>
<!-- enved-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="envedhook">enved-hook</a> (env pt new-x new-y reason)</code> [<b>cascade</b>]
-</td></tr><tr><td></td><td colspan=2>
-Each time a breakpoint is changed in the envelope editor, this hook
+<pre class="indented">
+<em class=def id="envedhook">enved-hook</em> (envelope point x y reason)
+</pre>
+
+<p>Each time a breakpoint is changed in the envelope editor, this hook
is called; if it returns a list, that list defines the new envelope,
otherwise the breakpoint is moved (but not beyond the neighboring
breakpoint), leaving other points untouched. The kind of change that triggered the hook callback
-is indicated by the argument 'reason'. It can be <code>enved-move-point</code>, <code>enved-delete-point</code>,
-or <code>enved-add-point</code>. This hook makes it possible to define attack
+is indicated by the argument 'reason'. It can be enved-move-point, enved-delete-point,
+or enved-add-point. This hook makes it possible to define attack
and decay portions in the envelope editor, or use functions such as
<a href="sndscm.html#stretchenvelope">stretch-envelope</a> from env.scm:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>enved-hook</em>
- (lambda (env pt x y reason)
- (if (= reason enved-move-point)
- (if (and (> x 0.0) (< x (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopelastx_tip)">envelope-last-x</a> env))) ; from env.scm
- (let* ((old-x (list-ref env (* pt 2)))
- (new-env (<em class=red>stretch-envelope</em> env old-x x)))
- (list-set! new-env (+ (* pt 2) 1) y)
- new-env)
- env)
- #f)))
-</pre></td></tr></table>
-
-If there are several functions on the hook, each gets the envelope
-result of the preceding function (if a function returns #f, the envelope
-is not changed). A math-type would call this a "function composition"
-method combination; a filter-type would say "cascade";
-</td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ ((lambda (env pt x y reason)
+ (if (and (= reason enved-move-point)
+ (> x 0.0)
+ (< x (<a class=quiet>envelope-last-x</a> env))) ; from env.scm
+ (let* ((old-x (env (* pt 2)))
+ (new-env (<em class=red>stretch-envelope</em> env old-x x)))
+ (set! (new-env (+ (* pt 2) 1)) y)
+ (set! (hook 'result) new-env))))
+ (hook 'envelope) (hook 'point) (hook 'x) (hook 'y) (hook 'reason))))
+</pre>
+
+<p>In Forth/Ruby, if there are several functions on the hook, each gets the envelope
+result of the preceding function.
+</p>
+<div class="spacer"></div>
<!-- exit-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="exithook">exit-hook</a> ()</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon exit.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="exithook">exit-hook</em> ()
+</pre>
+
+<p>This hook is called upon exit.
+</p>
+<div class="spacer"></div>
+
<!-- graph-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="graphhook">graph-hook</a> (snd chn y0 y1) </code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time a graph is updated or redisplayed.
-If its hook functions return #t, the display is not updated.
+<pre class="indented">
+<em class=def id="graphhook">graph-hook</em> (snd chn y0 y1)
+</pre>
+
+<p>This hook is called each time a graph is updated or redisplayed.
+If it returns #t, the display is not updated.
See examp.scm for many examples. If you want to add your own graphics to the display, use <a href="#aftergraphhook">after-graph-hook</a>.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>graph-hook</em>
- (lambda (snd chn y0 y1)
- "set the dot size depending on the number of samples being displayed"
- (let ((dots (- (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn) (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn))))
- (if (> dots 100)
- (set! (<a class=quiet href="#dotsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_dotsize_tip)">dot-size</a> snd chn) 1)
- (if (> dots 50)
- (set! (<a class=quiet href="#dotsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_dotsize_tip)">dot-size</a> snd chn) 2)
- (if (> dots 25)
- (set! (<a class=quiet href="#dotsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_dotsize_tip)">dot-size</a> snd chn) 3)
- (set! (<a class=quiet href="#dotsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_dotsize_tip)">dot-size</a> snd chn) 5))))
- #f)))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (let ((documentation "set the dot size depending on the number of samples being displayed"))
+ (lambda (hook)
+ (let* ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (dots (- (<a class=quiet href="#rightsample">right-sample</a> snd chn) (<a class=quiet href="#leftsample">left-sample</a> snd chn))))
+ (if (> dots 100)
+ (set! (<a class=quiet href="#dotsize">dot-size</a> snd chn) 1)
+ (if (> dots 50)
+ (set! (<a class=quiet href="#dotsize">dot-size</a> snd chn) 3)
+ (if (> dots 25)
+ (set! (<a class=quiet href="#dotsize">dot-size</a> snd chn) 5)
+ (set! (<a class=quiet href="#dotsize">dot-size</a> snd chn) 8))))))))
+</pre>
+<div class="spacer"></div>
+
<!-- help-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="helphook">help-hook</a> (subject help-string)</code> [<b>cascade</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called from <a href="#sndhelp">snd-help</a> with the current help subject and default help-string.
+<pre class="indented">
+<em class=def id="helphook">help-hook</em> (subject help-string)
+</pre>
+
+<p>This hook is called from <a href="#sndhelp">snd-help</a> with the current help subject and default help-string.
Say we want the index.scm
procedure <a href="sndscm.html#html">html</a> called any time snd-help is called (from C-? for example):
-<pre>
- (hook-push <em class=red>help-hook</em> (lambda (subject help) (<a class=quiet href="sndscm.html#html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_function_tip)">html</a> subject) #f))
+</p>
+
+<pre class="indented">
+(hook-push <em class=red>help-hook</em> (lambda (hook) (<a class=quiet href="sndscm.html#html">html</a> (hook 'subject))))
</pre>
-If there is more than one hook function, each function's result is passed as input to the next function.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<div class="spacer"></div>
<!-- initial-graph-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="initialgraphhook">initial-graph-hook</a> (snd chn dur) </code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called the first time a given channel is displayed (when the sound is first opened).
-If the hook function returns a list, the list's contents are interpreted as:
-<pre>
- (list x0 x1 y0 y1 label ymin ymax)
+<pre class="indented">
+<em class=def id="initialgraphhook">initial-graph-hook</em> (snd chn duration)
+</pre>
+
+<p>This hook is called the first time a given channel is displayed (when the sound is first opened).
+If the hook returns a list, the list's contents are interpreted as:
+</p>
+
+<pre class="indented">
+(list x0 x1 y0 y1 label ymin ymax)
</pre>
-(all trailing values are optional), where these numbers set the
+
+<p>(all trailing values are optional), where these numbers set the
initial x and y axis limits and the x axis label.
The default (an empty hook) is equivalent to:
-<pre>
- (hook-push <em class=red>initial-graph-hook</em> (lambda (snd chn dur) (list 0.0 0.1 -1.0 1.0 "time" -1.0 1.0)))
+</p>
+
+<pre class="indented">
+(hook-push <em class=red>initial-graph-hook</em>
+ (lambda (hook)
+ (set! (hook 'result) (list 0.0 0.1 -1.0 1.0 "time" -1.0 1.0))))
</pre>
-The 'dur' argument is the total length in seconds of the displayed portion of the channel, so to cause the
+
+<p>The 'duration' argument is the total length in seconds of the displayed portion of the channel, so to cause the
entire sound to be displayed initially:
-<pre>
- (hook-push <em class=red>initial-graph-hook</em> (lambda (snd chn dur) (list 0.0 dur)))
+</p>
+
+<pre class="indented">
+(hook-push <em class=red>initial-graph-hook</em>
+ (lambda (hook)
+ (set! (hook 'result) (list 0.0 (hook 'duration)))))
</pre>
-To get other the data limits (rather than the default y axis limits of -1.0 to 1.0), you can use <a href="#mussoundmaxamp">mus-sound-maxamp</a>,
+
+<p>To get other the data limits (rather than the default y axis limits of -1.0 to 1.0), you can use <a href="#mussoundmaxamp">mus-sound-maxamp</a>,
but if that sound's maxamp isn't already known, it can require a long process of reading the file. The following hook procedure
-uses the maxamp data if it is already available or the file is short:
+uses the maxamp data if it is already available or if the file is short:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>initial-graph-hook</em>
- (lambda (snd chn dur)
- (if (or (<a class=quiet href="#mussoundmaxampexists" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundmaxampexists_tip)">mus-sound-maxamp-exists?</a> (<a class=quiet href="#filename" onmouseout="UnTip()" onmouseover="Tip(extsnd_filename_tip)">file-name</a> snd))
- (< (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd chn) 10000000))
- (let* ((amp-vals (<a class=quiet href="#mussoundmaxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundmaxamp_tip)">mus-sound-maxamp</a> (<a class=quiet href="#filename" onmouseout="UnTip()" onmouseover="Tip(extsnd_filename_tip)">file-name</a> snd)))
- (max-val (max 1.0 (list-ref amp-vals (+ (* chn 2) 1)))))
- ;; max amp data is list: (sample value sample value ...)
- (list 0.0 dur (- max-val) max-val)) ; these are the new y-axis limits
- (list 0.0 dur -1.0 1.0)))) ; max amp unknown, so use defaults
-</pre></td></tr></table>
-</td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (dur (hook 'duration)))
+ (if (or (<a class=quiet href="#mussoundmaxampexists">mus-sound-maxamp-exists?</a> (<a class=quiet href="#filename">file-name</a> snd))
+ (< (<a class=quiet href="#framples">framples</a> snd chn) 10000000))
+ (let* ((amp-vals (<a class=quiet href="#mussoundmaxamp">mus-sound-maxamp</a> (<a class=quiet href="#filename">file-name</a> snd)))
+ (max-val (max 1.0 (amp-vals (+ (* chn 2) 1)))))
+ ;; max amp data is list: (sample value sample value ...)
+ (set! (hook 'result) (list 0.0 dur (- max-val) max-val))) ; these are the new y-axis limits
+ (set! (hook 'result) (list 0.0 dur -1.0 1.0)))))) ; max amp unknown, so use defaults
+</pre>
+<div class="spacer"></div>
+
<!-- key-press-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="keypresshook">key-press-hook</a> (snd chn key state)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon key press while the mouse is in the lisp graph (the third graph,
+<pre class="indented">
+<em class=def id="keypresshook">key-press-hook</em> (snd chn key state)
+</pre>
+
+<p>This hook is called upon key press while the mouse is in the lisp graph (the third graph,
to the right of the time and fft graphs).
-If its function returns #t, the key press is not passed to the main handler.
+If it returns #t, the key press is not passed to the main handler.
'state' refers to the control, meta, and shift keys.
<a href="sndscm.html#enveddoc">start-enveloping</a> in enved.scm uses this hook to add C-g and C-. support to the
channel-specific envelope editors.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- lisp-graph-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="lispgraphhook">lisp-graph-hook</a> (snd chn)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called just before the lisp graph is updated or redisplayed (see <a href="#displaydb">display-db</a>).
-If its function returns a list of pixels (xm style), these are used in order by the list of graphs (if any), rather than Snd's default set
-(this makes it possible to use different colors for the various graphs).
-If it returns a function (of no arguments), that function is called rather than the standard graph routine:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
+<em class=def id="lispgraphhook">lisp-graph-hook</em> (snd chn)
+</pre>
+
+<p>This hook is called just before the lisp graph is updated or redisplayed (see <a href="#displaydb">display-db</a>).
+If it returns a list of pixels (xm style), they are used in order by the list of graphs, rather than Snd's default colors.
+If it returns a thunk, that function is called rather than the standard graph routine:
+</p>
+
+<pre class="indented">
(hook-push <em class=red>lisp-graph-hook</em>
- (lambda (snd chn)
- (lambda ()
- (<a class=quiet href="#drawstring" onmouseout="UnTip()" onmouseover="Tip(extsnd_drawstring_tip)">draw-string</a> "hi"
- (<a class=quiet href="#xtoposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_xtoposition_tip)">x->position</a> 0.5 snd chn <a class=quiet href="#ytoposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_lispgraph_tip)">lisp-graph</a>)
- (<a class=quiet href="#ytoposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_ytoposition_tip)">y->position</a> 0.0 snd chn <a class=quiet href="#ytoposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_ytoposition_tip)">lisp-graph</a>)
- snd chn))))
-</pre></td></tr></table>
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (set! (hook 'result)
+ (lambda ()
+ (<a class=quiet href="#drawstring">draw-string</a> "hi"
+ (<a class=quiet href="#xtoposition">x->position</a> 0.5 snd chn <a class=quiet href="#ytoposition">lisp-graph</a>)
+ (<a class=quiet href="#ytoposition">y->position</a> 0.0 snd chn <a class=quiet href="#ytoposition">lisp-graph</a>)
+ snd chn))))))
+</pre>
+
+<p>For a fancy example, see <a href="sndscm.html#displaybarkfft">display-bark-fft</a> in dsp.scm.
+</p>
+<div class="spacer"></div>
+
-For a fancy example, see <a href="sndscm.html#displaybarkfft">display-bark-fft</a> in dsp.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
<!-- listener-click-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="listenerclickhook">listener-click-hook</a> (textpos)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a click occurs in the listener; the 'textpos' argument is the position in the text
+<pre class="indented">
+<em class=def id="listenerclickhook">listener-click-hook</em> (position)
+</pre>
+
+<p>This hook is called when a click occurs in the listener; the 'position' argument is the position in the text
(a character number) where the click occurred.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- mark-click-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="markclickhook">mark-click-hook</a> (mark)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a mark is clicked; return #t to squelch the default minibuffer mark identification. The following
-hook function is used in <a href="sndscm.html#withmarkedsound">with-marked-sound</a> in ws.scm to display arbitrary info about a mark.
+<pre class="indented">
+<em class=def id="markclickhook">mark-click-hook</em> (id)
+</pre>
+
+<p>This hook is called when a mark is clicked; return #t to squelch the default status area mark identification.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mark-click-hook</em>
- (lambda (n)
- (if (not (defined? 'mark-properties)) (load "marks.scm"))
- (<a class=quiet href="#infodialog" onmouseout="UnTip()" onmouseover="Tip(extsnd_infodialog_tip)">info-dialog</a> "Mark Help"
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "Mark ~A~A:~% sample: ~D = ~,3F secs~A~A"
- n
- (let ((name (<a class=quiet href="#markname" onmouseout="UnTip()" onmouseover="Tip(extsnd_markname_tip)">mark-name</a> n)))
- (if (> (string-length name) 0)
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f " (~S)" name)
- ""))
- (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> n)
- (/ (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> n) (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> (car (<a class=quiet href="#markhome" onmouseout="UnTip()" onmouseover="Tip(extsnd_markhome_tip)">mark-home</a> n))))
- (if (not (= (<a class=quiet href="#marksync" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksync_tip)">mark-sync</a> n) 0))
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~% sync: ~A" (<a class=quiet href="#marksync" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksync_tip)">mark-sync</a> n))
- "")
- (let ((props (<a class=quiet href="#markproperties" onmouseout="UnTip()" onmouseover="Tip(sndscm_markproperties_tip)">mark-properties</a> n)))
- (if (and (list? props)
- (not (null? props)))
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~% properties: '~A" props)
- ""))))
- #t))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (let ((n (hook 'id)))
+ (if (not (defined? 'mark-properties)) (load "marks.scm"))
+ (<a class=quiet href="#infodialog">info-dialog</a> "Mark Help"
+ (<a class=quiet>format</a> #f "Mark ~A~A:~% sample: ~D = ~,3F secs~A~A"
+ n
+ (let ((name (<a class=quiet href="#markname">mark-name</a> n)))
+ (if (> (string-length name) 0)
+ (<a class=quiet>format</a> #f " (~S)" name)
+ ""))
+ (<a class=quiet href="#marksample">mark-sample</a> n)
+ (* 1.0 (/ (<a class=quiet href="#marksample">mark-sample</a> n) (<a class=quiet href="#srate">srate</a> (car (<a class=quiet href="#markhome">mark-home</a> n)))))
+ (if (not (= (<a class=quiet href="#marksync">mark-sync</a> n) 0))
+ (<a class=quiet>format</a> #f "~% sync: ~A" (<a class=quiet href="#marksync">mark-sync</a> n))
+ "")
+ (let ((props (<a class=quiet href="#markproperties">mark-properties</a> n)))
+ (if (pair? props)
+ (<a class=quiet>format</a> #f "~% properties: '~A" props)
+ ""))))
+ (set! (hook 'result) #t))))
+</pre>
+<div class="spacer"></div>
<!-- mark-drag-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="markdraghook">mark-drag-hook</a> (mark)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a mark is dragged.
+<pre class="indented">
+<em class=def id="markdraghook">mark-drag-hook</em> (id)
+</pre>
+
+<p>This hook is called when a mark is dragged. If it returns #t, the mark position is not reflected in the status area.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (report-mark-location id)
- ;; print current mark location in minibuffer
- (let ((samp (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> id))
- (sndchn (<a class=quiet href="#markhome" onmouseout="UnTip()" onmouseover="Tip(extsnd_markhome_tip)">mark-home</a> id)))
- (<a class=quiet href="#reportinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_reportinminibuffer_tip)">report-in-minibuffer</a>
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "mark ~A: sample: ~D (~,3F) ~A[~D]: ~,3F"
+ ;; print current mark location in status area
+ (let ((samp (<a class=quiet href="#marksample">mark-sample</a> id))
+ (sndchn (<a class=quiet href="#markhome">mark-home</a> id)))
+ (<a class=quiet href="#statusreport">status-report</a>
+ (<a class=quiet>format</a> #f "mark ~A: sample: ~D (~,3F) ~A[~D]: ~,3F"
id samp
- (/ samp (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> (car sndchn)))
- (<a class=quiet href="#shortfilename" onmouseout="UnTip()" onmouseover="Tip(extsnd_shortfilename_tip)">short-file-name</a> (car sndchn))
+ (exact->inexact (/ samp (<a class=quiet href="#srate">srate</a> (car sndchn))))
+ (<a class=quiet href="#shortfilename">short-file-name</a> (car sndchn))
(cadr sndchn)
- (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> samp (car sndchn) (cadr sndchn))))))
+ (<a class=quiet href="#sample">sample</a> samp (car sndchn) (cadr sndchn))))))
+
+(hook-push <em class=red>mark-drag-hook</em>
+ (lambda (hook)
+ (report-mark-location (hook 'id))
+ (set! (hook 'result) #t)))
+</pre>
+<div class="spacer"></div>
-(hook-push <em class=red>mark-drag-hook</em> report-mark-location)
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
<!-- mark-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="markhook">mark-hook</a> (mark snd chn reason)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a mark is added, deleted, or moved (but not while moving).
+<pre class="indented">
+<em class=def id="markhook">mark-hook</em> (mark snd chn reason)
+</pre>
+
+<p id="snpmark">This hook is called when a mark is added, deleted, or moved (but not while moving).
'reason' can be 0: add, 1: delete, 2: move (via set! mark-sample), 3: delete all marks, 4: release (after drag).
In the "release" case, the hook is called upon button release before any edits (control-drag of mark) or sorting (simple drag),
and if the <a href="#marksync">mark-sync</a> is not 0, the hook is called on each syncd mark.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (<A NAME="snpmark">snap-mark-to-beat</a>)
+<pre class="indented">
+(define (snap-mark-to-beat)
;; when a mark is dragged, its end position is always on a beat
- (let ((mark-release 4))
- (hook-push <em class=red>mark-hook</em>
- (lambda (mrk snd chn reason)
- (if (= reason mark-release)
- (let* ((samp (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> mrk))
- (bps (/ (<a class=quiet href="#beatsperminute" onmouseout="UnTip()" onmouseover="Tip(extsnd_beatsperminute_tip)">beats-per-minute</a> snd chn) 60.0))
- (sr (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd))
- (beat (floor (/ (* samp bps) sr)))
- (lower (floor (/ (* beat sr) bps)))
- (higher (floor (/ (* (+ 1 beat) sr) bps))))
- (set! (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> mrk)
- (if (< (- samp lower) (- higher samp))
- lower
- higher))))))))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (hook-push <em class=red>mark-hook</em>
+ (lambda (hook)
+ ((lambda (mrk snd chn reason)
+ (let ((mark-release 4))
+ (if (= reason mark-release)
+ (let* ((samp (<a class=quiet href="#marksample">mark-sample</a> mrk))
+ (bps (/ (<a class=quiet href="#beatsperminute">beats-per-minute</a> snd chn) 60.0))
+ (sr (<a class=quiet href="#srate">srate</a> snd))
+ (beat (floor (/ (* samp bps) sr)))
+ (lower (floor (/ (* beat sr) bps)))
+ (higher (floor (/ (* (+ 1 beat) sr) bps))))
+ (set! (<a class=quiet href="#marksample">mark-sample</a> mrk) (if (< (- samp lower) (- higher samp)) lower higher))))))
+ (hook 'id) (hook 'snd) (hook 'chn) (hook 'reason)))))
+</pre>
+<div class="spacer"></div>
<!-- mix-click-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mixclickhook">mix-click-hook</a> (mix)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a mix tag is clicked; return #t to omit the default action which is to start the Mix dialog
+<pre class="indented">
+<em class=def id="mixclickhook">mix-click-hook</em> (id)
+</pre>
+
+<p>This hook is called when a mix tag is clicked (when the double-arrow is displayed over the tag);
+return #t to omit the default action which is to start the Mix dialog
with the clicked mix.
One example is <a href="sndscm.html#mixclickinfo">mix-click-info</a> in mix.scm.
Here's an example that sets a mix's amps to 0 if you click it (see <a href="sndscm.html#mixclicksetsamp">mix-click-sets-amp</a>
in mix.scm for a fancier version):
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mix-click-hook</em>
- (lambda (n)
- (set! (<a class=quiet href="#mixamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixamp_tip)">mix-amp</a> n) 0.0)
- #t))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (set! (<a class=quiet href="#mixamp">mix-amp</a> (hook 'id)) 0.0)
+ (set! (hook 'result) #t)))
+</pre>
+<div class="spacer"></div>
<!-- mix-drag-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mixdraghook">mix-drag-hook</a> (mix x y)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a mix is dragged.
+<pre class="indented">
+<em class=def id="mixdraghook">mix-drag-hook</em> (id x y)
+</pre>
+
+<p>This hook is called when a mix is dragged.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mix-drag-hook</em>
- (lambda (n x y)
- (<a class=quiet href="#reportinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_reportinminibuffer_tip)">report-in-minibuffer</a>
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "mix ~A at ~D: ~,3F"
- n (<a class=quiet href="#mixposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixposition_tip)">mix-position</a> n)
- (exact->inexact (/ (<a class=quiet href="#mixposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixposition_tip)">mix-position</a> n) (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>)))))))
-</pre></td></tr></table>
-
-A neat example is to set up an empty sound with a 1.0 in sample 0, mix in a vct containing one element of 0.5, then set
+ (lambda (hook)
+ (<a class=quiet href="#statusreport">status-report</a>
+ (<a class=quiet>format</a> #f "mix ~A at ~D: ~,3F"
+ (hook 'id)
+ (<a class=quiet href="#mixposition">mix-position</a> (hook 'id))
+ (exact->inexact (/ (<a class=quiet href="#mixposition">mix-position</a> (hook 'id)) (<a class=quiet href="#srate">srate</a>)))))))
+</pre>
+
+<p>A neat example is to set up an empty sound with a 1.0 in sample 0, mix in a float-vector containing one element of 0.5, then set
up this mix-drag-hook:
-<pre>
- (hook-push mix-drag-hook (lambda (id x y) (<a class=quiet href="#updatetransformgraph" onmouseout="UnTip()" onmouseover="Tip(extsnd_updatetransformgraph_tip)">update-transform-graph</a>)))
+</p>
+
+<pre class="indented">
+(hook-push mix-drag-hook
+ (lambda (hook)
+ (<a class=quiet href="#updatetransformgraph">update-transform-graph</a>)))
</pre>
-and turn on the FFT graph. As you drag the mix, you can see the spectral effect of that
+
+<p>and turn on the FFT graph. As you drag the mix, you can see the spectral effect of that
moving value as a comb filter.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- mix-release-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mixreleasehook">mix-release-hook</a> (mix samps)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called after a mix has been dragged by the mouse to a new position.
-'samps' is the number of samples moved during the drag. If its function returns #t, the final position
+<pre class="indented">
+<em class=def id="mixreleasehook">mix-release-hook</em> (id samples)
+</pre>
+
+<p>This hook is called after a mix has been dragged by the mouse to a new position.
+'samples' is the number of samples moved during the drag. If the hook returns #t, the final position
of the mix is
hook's responsibility. See <a href="sndscm.html#snapmarktobeat">snap-mix-to-beat</a> in mix.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- mouse-click-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mouseclickhook">mouse-click-hook</a> (snd chn button state x y axis) </code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon a mouse button release or click (with various exceptions). If its function returns #t, the click is ignored by Snd.
+<pre class="indented">
+<em class=def id="mouseclickhook">mouse-click-hook</em> (snd chn button state x y axis)
+</pre>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (click-to-center snd chn button state x y axis)
+<p>This hook is called upon a mouse button release or click (with various exceptions). If its function returns #t, the click is ignored by Snd.
+</p>
+
+<pre class="indented">
+(define (click-to-center snd chn x axis)
;; if mouse click in time domain graph, set cursor as normally, but also center the window
- (if (= axis <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_time_graph_tip)">time-graph</a>)
- (let ((samp (floor (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd) (<a class=quiet href="#positiontox" onmouseout="UnTip()" onmouseover="Tip(extsnd_positiontox_tip)">position->x</a> x snd chn)))))
- (set! (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a> snd chn) samp)
- (set! (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn)
- (- samp (floor (* .5 (- (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn) (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn))))))
- (<a class=quiet href="#updatetimegraph" onmouseout="UnTip()" onmouseover="Tip(extsnd_updatetimegraph_tip)">update-time-graph</a>)
- #t)
- #f))
-(hook-push <em class=red>mouse-click-hook</em> click-to-center)
+ (and (= axis <a class=quiet>time-graph</a>)
+ (let ((samp (floor (* (<a class=quiet href="#srate">srate</a> snd) (<a class=quiet href="#positiontox">position->x</a> x snd chn)))))
+ (set! (<a class=quiet href="#cursor">cursor</a> snd chn) samp)
+ (set! (<a class=quiet href="#rightsample">right-sample</a> snd chn)
+ (- samp (floor (* .5 (- (<a class=quiet href="#leftsample">left-sample</a> snd chn) (<a class=quiet href="#rightsample">right-sample</a> snd chn))))))
+ (<a class=quiet href="#updatetimegraph">update-time-graph</a>)
+ #t)))
+
+(hook-push <em class=red>mouse-click-hook</em>
+ (lambda (hook)
+ (set! (hook 'result) (click-to-center (hook 'snd) (hook 'chn) (hook 'x) (hook 'axis)))))
;;; this example disables button 2 -> insert selection
(hook-push <em class=red>mouse-click-hook</em>
- (lambda (snd chn button state x y axis)
- (and (= axis <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_time_graph_tip)">time-graph</a>) (= button 2))))
-</pre></td></tr></table>
+ (lambda (hook)
+ (set! (hook 'result)
+ (and (= (hook 'axis) <a class=quiet>time-graph</a>)
+ (= (hook 'button) 2)))))
+</pre>
-The mouse scroll wheel is sometimes reported as buttons 4 and 5; in the next example,
+<p>The mouse scroll wheel is sometimes reported as buttons 4 and 5; in the next example,
turning the wheel zooms the graph in or out:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mouse-click-hook</em>
- (lambda (snd chn button state x y axis)
- (if (and (= axis <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_time_graph_tip)">time-graph</a>)
- (or (= button 4) (= button 5))) ; mouse scroll wheel
- (let ((midpoint (* 0.5 (apply + (<a class=quiet href="#xbounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_xbounds_tip)">x-bounds</a>))))
- (dur (/ (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>)))
- (range (if (= button 4)
- (* -0.25 (apply - (<a class=quiet href="#xbounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_xbounds_tip)">x-bounds</a>))) ; zoom in
- (abs (apply - (<a class=quiet href="#xbounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_xbounds_tip)">x-bounds</a>)))))) ; zoom out
- (set! (<a class=quiet href="#xbounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_xbounds_tip)">x-bounds</a>) (list (max 0.0 (- midpoint range))
- (min dur (+ midpoint range))))))
- #f))
-</pre></td></tr></table>
-
-Here is a Forth example:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+ (lambda (hook)
+ (let ((button (hook 'button))
+ (axis (hook 'axis)))
+ (if (and (= axis <a class=quiet>time-graph</a>)
+ (memv button '(4 5))) ; mouse scroll wheel
+ (let ((midpoint (* 0.5 (apply + (<a class=quiet href="#xbounds">x-bounds</a>))))
+ (dur (/ (<a class=quiet href="#framples">framples</a>) (<a class=quiet href="#srate">srate</a>)))
+ (range (if (= button 4)
+ (* -0.25 (apply - (<a class=quiet href="#xbounds">x-bounds</a>))) ; zoom in
+ (abs (apply - (<a class=quiet href="#xbounds">x-bounds</a>)))))) ; zoom out
+ (set! (<a class=quiet href="#xbounds">x-bounds</a>) (list (max 0.0 (- midpoint range))
+ (min dur (+ midpoint range)))))))))
+
+</pre>
+
+<p>Here is a Forth example:
+</p>
+
+<pre class="indented">
mouse-click-hook lambda: <{ snd chn button state x y axis -- }>
axis time-graph = if
$" freq: %.3f" '( snd chn #f cursor snd chn spot-freq ) string-format
- snd #f report-in-minibuffer
+ snd #f status-report
else
#f
then
; add-hook!
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+</pre>
+<div class="spacer"></div>
<!-- mouse-drag-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mousedraghook">mouse-drag-hook</a> (snd chn button state x y)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse is dragged within the lisp graph (see enved.scm or rtio.scm).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mousedraghook">mouse-drag-hook</em> (snd chn button state x y)
+</pre>
+
+<p>This hook is called when the mouse is dragged within the lisp graph (see enved.scm).
+</p>
+<div class="spacer"></div>
<!-- mouse-enter-graph-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mouseentergraphhook">mouse-enter-graph-hook</a> (snd chn)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse enters a channel's drawing area (graph pane).
+<pre class="indented">
+<em class=def id="mouseentergraphhook">mouse-enter-graph-hook</em> (snd chn)
+</pre>
+
+<p>This hook is called when the mouse enters a channel's drawing area (graph pane).
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mouse-enter-graph-hook</em>
- (lambda (snd chn)
- (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A[~A]" (<a class=quiet href="#shortfilename" onmouseout="UnTip()" onmouseover="Tip(extsnd_shortfilename_tip)">short-file-name</a> snd) chn))))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (<a class=quiet href="#sndprint">snd-print</a> (<a class=quiet>format</a> #f "~A[~A]" (<a class=quiet href="#shortfilename">short-file-name</a> (hook 'snd)) (hook 'chn)))))
+</pre>
+<div class="spacer"></div>
<!-- mouse-enter-label-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mouseenterlabelhook">mouse-enter-label-hook</a> (type position label)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse enters a file viewer or region label.
+<pre class="indented">
+<em class=def id="mouseenterlabelhook">mouse-enter-label-hook</em> (type position label)
+</pre>
+
+<p>This hook is called when the mouse enters a file viewer or region label.
The 'type' is 1 for view files list, and 2 for regions.
The 'position' is the scrolled list position of the label.
The label itself is 'label'. We can use the <a href="sndscm.html#finfo">finfo</a> procedure in examp.scm
to popup file info as follows:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mouse-enter-label-hook</em>
- (lambda (type position name)
- (if (not (= type 2))
- (<a class=quiet href="#infodialog" onmouseout="UnTip()" onmouseover="Tip(extsnd_infodialog_tip)">info-dialog</a> name (finfo name)))))
-</pre></td></tr></table>
+ (lambda (hook)
+ (if (not (= (hook 'type) 2))
+ (<a class=quiet href="#infodialog">info-dialog</a> (hook 'label) (finfo (hook 'label))))))
+</pre>
-See also <a href="sndscm.html#nbdoc">files-popup-info</a> in nb.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<p>See also <a href="sndscm.html#nbdoc">files-popup-info</a> in nb.scm.
+</p>
+<div class="spacer"></div>
<!-- mouse-enter-listener-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mouseenterlistenerhook">mouse-enter-listener-hook</a> (widget)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse enters the listener pane. This hook, along with the parallel graph hook
+<pre class="indented">
+<em class=def id="mouseenterlistenerhook">mouse-enter-listener-hook</em> (widget)
+</pre>
+
+<p>This hook is called when the mouse enters the listener pane. This hook, along with the parallel graph hook
makes it possible to set up Snd to behave internally like a window manager with pointer focus. That is, to
ensure that the pane under the mouse is the one that receives keyboard input, we can define the following
hook procedures:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mouse-enter-graph-hook</em>
- (lambda (snd chn)
- (if (<a class=quiet href="#soundp" onmouseout="UnTip()" onmouseover="Tip(extsnd_soundp_tip)">sound?</a> snd) (<a class=quiet href="#focuswidget" onmouseout="UnTip()" onmouseover="Tip(extsnd_focuswidget_tip)">focus-widget</a> (car (<a class=quiet href="#channelwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelwidgets_tip)">channel-widgets</a> snd chn))))))
+ (lambda (hook)
+ (if (<a class=quiet href="#soundp">sound?</a> (hook 'snd))
+ (<a class=quiet href="#focuswidget">focus-widget</a> (car (<a class=quiet href="#channelwidgets">channel-widgets</a> (hook 'snd) (hook 'chn)))))))
(hook-push <em class=red>mouse-enter-listener-hook</em>
- (lambda (widget)
- (<a class=quiet href="#focuswidget" onmouseout="UnTip()" onmouseover="Tip(extsnd_focuswidget_tip)">focus-widget</a> widget)))
-</pre></td></tr></table>
+ (lambda (hook)
+ (<a class=quiet href="#focuswidget">focus-widget</a> (hook 'widget))))
+</pre>
+<div class="spacer"></div>
-I much prefer this style of operation.
-</td></tr><tr><td colspan=3 height=16></td></tr>
<!-- mouse-enter-text-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mouseentertexthook">mouse-enter-text-hook</a> (widget)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse enters a text widget (this is the third of the pointer focus hooks).
+<pre class="indented">
+<em class=def id="mouseentertexthook">mouse-enter-text-hook</em> (widget)
+</pre>
+
+<p>This hook is called when the mouse enters a text widget (this is the third of the pointer focus hooks).
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mouse-enter-text-hook</em>
- (lambda (w)
- (<a class=quiet href="#focuswidget" onmouseout="UnTip()" onmouseover="Tip(extsnd_focuswidget_tip)">focus-widget</a> w)))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (<a class=quiet href="#focuswidget">focus-widget</a> (hook 'widget))))
+</pre>
+<div class="spacer"></div>
<!-- mouse-leave-graph-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mouseleavegraphhook">mouse-leave-graph-hook</a> (snd chn)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse leaves a channel's drawing area (graph pane).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mouseleavegraphhook">mouse-leave-graph-hook</em> (snd chn)
+</pre>
+
+<p>This hook is called when the mouse leaves a channel's drawing area (graph pane).
+</p>
+<div class="spacer"></div>
<!-- mouse-leave-label-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mouseleavelabelhook">mouse-leave-label-hook</a> (type position name)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse exits one of the labels covered by <a href="#mouseenterlabelhook">mouse-enter-label-hook</a>.
+<pre class="indented">
+<em class=def id="mouseleavelabelhook">mouse-leave-label-hook</em> (type position name)
+</pre>
+
+<p>This hook is called when the mouse exits one of the labels covered by <a href="#mouseenterlabelhook">mouse-enter-label-hook</a>.
See <a href="sndscm.html#nbdoc">nb.scm</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mouse-leave-listener-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mousleavelistenerhook">mouse-leave-listener-hook</a> (widget)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse leaves the listener pane.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mousleavelistenerhook">mouse-leave-listener-hook</em> (widget)
+</pre>
+
+<p>This hook is called when the mouse leaves the listener pane.
+</p>
+<div class="spacer"></div>
<!-- mouse-leave-text-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mousleavetexthook">mouse-leave-text-hook</a> (widget)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the mouse leaves a text widget.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mousleavetexthook">mouse-leave-text-hook</em> (widget)
+</pre>
+
+<p>This hook is called when the mouse leaves a text widget.
+</p>
+<div class="spacer"></div>
<!-- mouse-press-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="mousepresshook">mouse-press-hook</a> (snd chn button state x y)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon a mouse button press within the lisp graph (see enved.scm). The 'x' and 'y' values are
+<pre class="indented">
+<em class=def id="mousepresshook">mouse-press-hook</em> (snd chn button state x y)
+</pre>
+
+<p>This hook is called upon a mouse button press within the lisp graph (see enved.scm). The 'x' and 'y' values are
relative to the lisp graph axis (as if the raw mouse pixel position was passed through
<a href="#positiontox">position->x</a> and <a href="#positiontoy">position->y</a>).
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-error-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="muserrorhook">mus-error-hook</a> (error-type error-message)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon mus-error.
-If its functions return #t, Snd ignores the error (it assumes you've handled it via the hook).
-This hook is used in <a href="sndscm.html#playsound">play-sound</a> in play.scm to flush an error message
-that the Snd ALSA support code generates (or used to generate).
+<pre class="indented">
+<em class=def id="muserrorhook">mus-error-hook</em> (type message)
+</pre>
+
+<p>This hook is called upon mus-error.
+If it returns #t, Snd ignores the error (it assumes you've handled it via the hook).
Both mus_error and mus_print run this hook; in the mus_print case, the 'type' is mus-no-error (0).
You can redirect mus_print output from stderr (the default) to stdout via:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>mus-error-hook</em>
- (lambda (typ msg)
- (and (= typ 0) ; it's mus_print, not mus_error
- (display msg)))) ; display returns some non-#f result, I assume
-</pre></td></tr></table>
+ (lambda (hook)
+ (if (= (hook 'type) 0)
+ (begin
+ (display (hook 'message))
+ (set! (hook 'result) #t)))))
+</pre>
-To decode the 'error-type' argument, see <a href="#muserrortypetostring">mus-error-type->string</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<p>To decode the 'type' argument, see <a href="#muserrortypetostring">mus-error-type->string</a>.
+</p>
+<div class="spacer"></div>
<!-- name-click-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="nameclickhook">name-click-hook</a> (snd)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the sound name is clicked (in the label in the minibuffer region of the sound's pane).
-If the function returns #t, the usual highly informative minibuffer babbling is squelched.
+<pre class="indented">
+<em class=def id="nameclickhook">name-click-hook</em> (snd)
+</pre>
+
+<p>This hook is called when the sound name is clicked (in the label in the status area region of the sound's pane).
+If the function returns #t, the usual highly informative status area babbling is squelched.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>name-click-hook</em>
- (lambda (snd) ; toggle read-only
- (set! (<a class=quiet href="#readonly" onmouseout="UnTip()" onmouseover="Tip(extsnd_readonly_tip)">read-only</a> snd) (not (<a class=quiet href="#readonly" onmouseout="UnTip()" onmouseover="Tip(extsnd_readonly_tip)">read-only</a> snd)))
- #t))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook) ; toggle read-only
+ (set! (<a class=quiet href="#readonly">read-only</a> (hook 'snd)) (not (<a class=quiet href="#readonly">read-only</a> (hook 'snd))))
+ (set! (hook 'result) #t)))
+</pre>
+<div class="spacer"></div>
<!-- new-sound-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="newsoundhook">new-sound-hook</a> (filename)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called whenever a new sound file is being created. <a href="sndscm.html#sound-let">sound-let</a> in ws.scm uses
+<pre class="indented">
+<em class=def id="newsoundhook">new-sound-hook</em> (name)
+</pre>
+
+<p>This hook is called whenever a new sound file is being created. <a href="sndscm.html#sound-let">sound-let</a> in ws.scm uses
this hook to keep track of newly created temporary sounds so that it can delete them once they are no longer needed.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- new-widget-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="newwidgethook">new-widget-hook</a> (widget)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time a dialog or a new set of channel or sound widgets is created.
+<pre class="indented">
+<em class=def id="newwidgethook">new-widget-hook</em> (widget)
+</pre>
+
+<p>This hook is called each time a dialog or a new set of channel or sound widgets is created.
This is used in misc.scm (paint-all) to
make sure all newly created widgets have the same background pixmaps.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- open-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="openhook">open-hook</a> (filename)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called before a sound file is opened.
+<pre class="indented">
+<em class=def id="openhook">open-hook</em> (name)
+</pre>
+
+<p>This hook is called before a sound file is opened.
If the function returns #t, or the sound is not readable (bad header, etc) the file is not opened
and any corresponding <a href="#afteropenhook">after-open-hook</a> functions are not called.
If it returns a string (a filename), that file is opened instead of the original one.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>open-hook</em>
- (lambda (filename)
- (if (= (<a class=quiet href="#mussoundheadertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundheadertype_tip)">mus-sound-header-type</a> filename) <a class=quiet href="#headertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_headertype_tip)">mus-raw</a>)
- ;; check for "OggS" first word, if found, translate to something Snd can read
- (if (call-with-input-file filename
- (lambda (fd)
- (and (char=? (read-char fd) #\O)
- (char=? (read-char fd) #\g)
- (char=? (read-char fd) #\g)
- (char=? (read-char fd) #\S))))
- (let ((aufile (string-append filename ".au")))
- (if (file-exists? aufile) (delete-file aufile))
- (system (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "ogg123 -d au -f ~A ~A" aufile filename))
- aufile) ; now open-sound will read the new .au file
- #f)
- #f)))
-</pre></td></tr></table>
-See also <a href="sndscm.html#openbuffer">open-buffer</a> in examp.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (let ((filename (hook 'name)))
+ (if (and (= (<a class=quiet href="#mussoundheadertype">mus-sound-header-type</a> filename) <a class=quiet href="#headertype">mus-raw</a>)
+ ;; check for "OggS" first word, if found, translate to something Snd can read
+ (call-with-input-file filename
+ (lambda (fd)
+ (and (char=? (read-char fd) #\O)
+ (char=? (read-char fd) #\g)
+ (char=? (read-char fd) #\g)
+ (char=? (read-char fd) #\S)))))
+ (let ((aufile (string-append filename ".au")))
+ (if (file-exists? aufile) (delete-file aufile))
+ (system (<a class=quiet>format</a> #f "ogg123 -d au -f ~A ~A" aufile filename))
+ (set! (hook 'result) aufile)))))) ; now open-sound will read the new .au file
+</pre>
+
+<div class="spacer"></div>
+
<!-- open-raw-sound-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="openrawsoundhook">open-raw-sound-hook</a> (filename current-choices)</code> [<b>cascade</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time <a href="#opensound">open-sound</a> encounters a headerless file.
+<pre class="indented">
+<em class=def id="openrawsoundhook">open-raw-sound-hook</em> (name state)
+</pre>
+
+<p>This hook is called each time <a href="#opensound">open-sound</a> encounters a headerless file.
Its result can be a list describing the raw file's attributes (thereby bypassing the Raw File Dialog and so on):
-<code>(list chans srate data-format data-location data-length)</code> where trailing elements can
+(list chans srate sample-type data-location data-length) where trailing elements can
be omitted ('data-location' defaults to 0, and 'data-length' defaults to the file length in bytes).
-If there is more than one function on the hook list, functions after the first get the
-on-going list result (if any) as the 'current-choices' argument (the empty list is the default).
-<pre>
- (hook-push <em class=red>open-raw-sound-hook</em> (lambda (file choices) (list 1 44100 <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_dataformat_tip)">mus-lshort</a>)))
+In Ruby and Forth, if there is more than one function on the hook list, functions after the first get the
+on-going list result as the 'state (the empty list is the default).
+</p>
+
+<pre class="indented">
+(hook-push <em class=red>open-raw-sound-hook</em>
+ (lambda (hook)
+ (set! (hook 'result) (list 1 44100 <a class=quiet href="#sampletype">mus-lshort</a>))))
</pre>
-Return '() to accept all the current raw header defaults; return #f to fallback on the Raw File Dialog.
+
+<p>Return () to accept all the current raw header defaults; return #f to fallback on the Raw File Dialog.
The raw header defaults are stereo, 44100 Hz, big endian short data; these values can be changed in the
Raw File Dialog, by calling <a href="#openrawsound">open-raw-sound</a> with explicit arguments,
or via <a href="#musheaderrawdefaults">mus-header-raw-defaults</a>.
-If the hook function returns #t, the <a href="#opensound">open-sound</a> returns without opening.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+If the hook returns #t, <a href="#opensound">open-sound</a> returns without opening the file.
+</p>
+<div class="spacer"></div>
-<!-- optimization-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="optimizationhook">optimization-hook</a> (message)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time the optimizer hits something it can't handle; 'message' tries to give some information about the situation.
-<pre>
- (hook-push <em class=red>optimization-hook</em> (lambda (n) (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A~%" n))))
+
+<!-- orientation-hook -->
+<pre class="indented">
+<em class=def id="orientationhook">orientation-hook</em> ()
</pre>
-Normally, if the optimizer fails for some reason, it falls back silently on the Scheme evaluator, so
-the code runs slower. This hook gives you a way to find out why the optimizer gave up.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<p>This hook is called whenever one of the variables associated with the orientation dialog changes.
+</p>
+<div class="spacer"></div>
-<!-- orientation-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="orientationhook">orientation-hook</a> () </code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called whenever one of the variables associated with the orientation dialog changes.
-See <a href="sndscm.html#startwaterfall">start-waterfall</a> in snd-gl.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
<!-- output-comment-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="outputcommenthook">output-comment-hook</a> (str)</code> [<b>cascade</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called in the Save-As dialog to set the default output comment value. 'str' is the current sound's comment.
+<pre class="indented">
+<em class=def id="outputcommenthook">output-comment-hook</em> (comment)
+</pre>
+
+<p>This hook is called in the Save-As dialog to set the default output comment value. 'str' is the current sound's comment.
If there is more than one hook function, each function's result is passed as input to the next function in the list.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td>
-<pre>
+<pre class="indented">
(hook-push <em class=red>output-comment-hook</em>
- (lambda (str) ; append a time-stamp
- (string-append str ": written " (strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time))))))
+ (lambda (hook) ; append a time-stamp
+ (set! (hook 'result)
+ (string-append (hook 'comment)
+ ": written "
+ (strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time)))))))
- ;; in Ruby: format("%s: written %s", str, Time.new.localtime.strftime("%d-%b %H:%M %Z"))
+;; in Ruby: format("%s: written %s", comment, Time.new.localtime.strftime("%d-%b %H:%M %Z"))
</pre>
-</td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
-
+<div class="spacer"></div>
-<!-- output-name-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="outputnamehook">output-name-hook</a> (current-name)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called in the New File dialog. If it returns a filename, that name is presented in the New File dialog,
-making it slightly easier to set default output names.
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(let ((file-ctr -1))
- (hook-push <em class=red>output-name-hook</em>
- (lambda (ignored-name)
- (set! file-ctr (+ file-ctr 1))
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A-~D.snd" ; make new file name based on date and file-ctr: "Jun-01-23.snd"
- (strftime "%b-%d" (localtime (current-time)))
- file-ctr))))
-</pre></td></tr></table></td></tr>
-<tr><td colspan=3 height=16></td></tr>
+<!-- play-hook -->
+<pre class="indented">
+<em class=def id="playhook">play-hook</em> (size)
+</pre>
+<p>This hook is called each time a buffer is about to be
+filled for the DAC. The buffer size is 'size'.
+See <a href="sndscm.html#enveddoc">enved.scm</a> and <a href="sndscm.html#marksdoc">marks.scm</a>.
+</p>
+<div class="spacer"></div>
-<!-- peak-env-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="peakenvhook">peak-env-hook</a> (snd chn)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon completion of a new peak envelope.
-</td></tr><tr><td colspan=3 height=16></td></tr>
-<!-- play-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="playhook">play-hook</a> (samps)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time a buffer is about to be
-filled for the DAC. The buffer size is 'samps'.
-See <a href="sndscm.html#enveddoc">enved.scm</a> and <a href="sndscm.html#marksdoc">marks.scm</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
-
-
-<!-- print-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="printhook">print-hook</a> (text)</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time some Snd-generated response ('text') is about to be appended to the listener.
-If the function returns some non-#f result, Snd assumes you've sent the text out yourself, as well as any needed prompt.
-The prompt is important! Snd uses it to find the current form to evaluate, so if your print hook function
-forgets to include it, you can end up with a comatose listener. To get out of this state, include
-the prompt by hand (i.e. type in the shell that Snd started in, ">(reset-hook! print-hook)").
-This is intended to make it possible to
-distinguish Snd responses from user-typing, or add arbitrarily fancy prompts, but both should be handled
-in some other way — I should rewrite this part of Snd.
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(hook-push <em class=red>print-hook</em>
- (lambda (msg)
- (if (char=? (string-ref msg 0) #\newline)
- (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> msg)
- (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A~%[~A]~%~A" ;need newline just before listener-prompt
- msg
- (strftime "%d-%b %H:%M %Z" (localtime (current-time)))
- (<a class=quiet href="#listenerprompt" onmouseout="UnTip()" onmouseover="Tip(extsnd_listenerprompt_tip)">listener-prompt</a>))))))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+<!-- read-hook -->
+<pre class="indented">
+<em class=def id="readhook">read-hook</em> (text)
+</pre>
+<p>This hook is called each time a line is typed into the listener (it is triggered by the carriage return).
+</p>
+<div class="spacer"></div>
-<!-- read-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="readhook">read-hook</a> (text)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time a line is typed into the listener (it is triggered by the carriage return).
-</td></tr><tr><td></td><td colspan=2></td></tr>
<!-- save-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="savehook">save-hook</a> (snd name)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time a sound ('snd') is about to be saved.
-If its function returns #t, the file is not saved. 'name' is #f unless
+<pre class="indented">
+<em class=def id="savehook">save-hook</em> (snd name)
+</pre>
+
+<p>This hook is called each time a sound ('snd') is about to be saved.
+If it returns #t, the file is not saved. 'name' is #f unless
the file is being saved under a new name (as in <a href="#savesoundas">save-sound-as</a>).
See <a href="sndscm.html#autosavedoc">autosave.scm</a>.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- save-state-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="savestatehook">save-state-hook</a> (temp-filename)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time the <a href="#savestate">save-state</a>
+<pre class="indented">
+<em class=def id="savestatehook">save-state-hook</em> (name)
+</pre>
+
+<p>This hook is called each time the <a href="#savestate">save-state</a>
mechanism is about to create a new temporary file to save some edit history sample data; that is,
each channel's edit history data is saved in a separate temporary file, and this hook provides
a way to specify the name of that file.
-'temp-filename' is the temporary file name that will be used unless
+'name' is the temporary file name that will be used unless
the hook function returns a different one (as a string). This hook provides a way to
keep track of which files are used in a given saved state batch, so
that later cleanup is easier to manage.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- select-channel-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="selectchannelhook">select-channel-hook</a> (snd chn)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a channel is selected (after the sound has been selected).
+<pre class="indented">
+<em class=def id="selectchannelhook">select-channel-hook</em> (snd chn)
+</pre>
+
+<p>This hook is called when a channel is selected (after the sound has been selected).
The function arguments are the sound's index and the channel number.
-select-channel-hook is used in <a href="sndscm.html#playbetweenmarks">play-between-marks</a>
-to keep the loop bounds up-to-date.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- select-sound-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="selectsoundhook">select-sound-hook</a> (snd)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a sound is selected. The argument is the about-to-be-selected sound.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="selectsoundhook">select-sound-hook</em> (snd)
+</pre>
+
+<p>This hook is called when a sound is selected. The argument is the about-to-be-selected sound.
+</p>
+<div class="spacer"></div>
+
<!-- snd-error-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="snderrorhook">snd-error-hook</a> (error-message)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon <a href="#snderror">snd-error</a>. If the listener is closed, it is also called upon any Scheme, Ruby, or Forth error.
+<pre class="indented">
+<em class=def id="snderrorhook">snd-error-hook</em> (message)
+</pre>
+
+<p>This hook is called upon <a href="#snderror">snd-error</a>. If the listener is closed, it is also called upon any Scheme, Ruby, or Forth error.
If it returns #t, Snd flushes the error (it assumes you've
dealt with it via the hook).
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>snd-error-hook</em>
- (lambda (msg)
- (<a class=quiet href="#play" onmouseout="UnTip()" onmouseover="Tip(extsnd_play_tip)">play</a> "bong.snd") ; or if xm is loaded, (XBell (XtDisplay (cadr (<a class=quiet href="#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>))) 10)
- #f))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (<a class=quiet href="#play">play</a> "bong.snd")))
+</pre>
+<div class="spacer"></div>
+
<!-- snd-warning-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="sndwarninghook">snd-warning-hook</a> (warning-message)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called upon <a href="#sndwarning">snd-warning</a>.
+<pre class="indented">
+<em class=def id="sndwarninghook">snd-warning-hook</em> (message)
+</pre>
+
+<p>This hook is called upon <a href="#sndwarning">snd-warning</a>.
If it returns #t, Snd flushes the warning (it assumes you've
reported it via the hook).
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define without-warnings
(lambda (thunk)
- (define no-warning (lambda (msg) #t))
+ (define no-warning (lambda (hook) (set! (hook 'result) #t)))
(hook-push <em class=red>snd-warning-hook</em> no-warning)
(thunk)
(hook-remove <em class=red>snd-warning-hook</em> no-warning)))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
-
-
-<!-- start-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="starthook">start-hook</a> (filename)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when Snd starts.
-If its function returns #t, Snd exits immediately.
-Say we are so annoyed with Snd's really very fine file browser that we want
-Snd to exit back to the shell if its file argument is not
-found (this code has to be in the ~/.snd init file):
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(hook-push <em class=red>start-hook</em>
- (lambda (file)
- (if (not (file-exists? file))
- (begin
- (display file) (display " does not exist")
- #t))))
-</pre></td></tr></table></td></tr><tr><td colspan=3 height=16></td></tr>
+</pre>
+<div class="spacer"></div>
<!-- start-playing-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="startplayinghook">start-playing-hook</a> (snd)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a sound is about to be played.
+<pre class="indented">
+<em class=def id="startplayinghook">start-playing-hook</em> (snd)
+</pre>
+
+<p>This hook is called when a sound is about to be played.
If its function returns #t, Snd does not play.
We can use this hook to replace "play" with "play selection" if the
selection is active:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>start-playing-hook</em>
- (lambda (snd)
- (if (and (<a class=quiet href="#selectionok" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionok_tip)">selection?</a>)
- (<a class=quiet href="#selectionmember" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionmember_tip)">selection-member?</a> snd))
+ (lambda (hook)
+ (if (and (<a class=quiet href="#selectionok">selection?</a>)
+ (<a class=quiet href="#selectionmember">selection-member?</a> (hook 'snd)))
(begin
(play (selection))
- #t) ; there's a selection so don't play the entire sound
- #f))) ; no selection, so go ahead and play it all
-</pre></td></tr></table>
+ (set! (hook 'result) #t))))) ; there's a selection so don't play the entire sound
+</pre>
+<div class="spacer"></div>
-See also <a href="sndscm.html#reportmarknames">report-mark-names</a> in marks.scm.
-</td></tr><tr><td colspan=3 height=16></td></tr>
<!-- start-playing-selection-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="startplayingselectionhook">start-playing-selection-hook</a> ()</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the selection is about to be played.
-If its function returns #t, Snd does not play the selection.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="startplayingselectionhook">start-playing-selection-hook</em> ()
+</pre>
+<p>This hook is called when the selection is about to be played.
+If its function returns #t, Snd does not play the selection.
+</p>
+<div class="spacer"></div>
-<!-- stop-dac-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="stopdachook">stop-dac-hook</a> ()</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when Snd stops playing and turns off the DAC, normally upon <a href="#musaudioclose">mus-audio-close</a>.
-It is used by <a href="sndscm.html#withlevelmeters">with-level-meters</a> to start draining away the red bubble in the VU meter.
-</td></tr><tr><td colspan=3 height=16></td></tr>
<!-- stop-playing-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="stopplayinghook">stop-playing-hook</a> (snd)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when a sound finishes playing. stop-playing-hook may be called more often than start-playing-hook.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="stopplayinghook">stop-playing-hook</em> (snd)
+</pre>
+
+<p>This hook is called when a sound finishes playing. stop-playing-hook may be called more often than start-playing-hook.
+</p>
+<div class="spacer"></div>
<!-- stop-playing-selection-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="stopplayingselectionhook">stop-playing-selection-hook</a> ()</code> [<b>progn</b>]
-</td></tr><tr><td></td><td colspan=2>
-This hook is called when the selection finishes playing.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="stopplayingselectionhook">stop-playing-selection-hook</em> ()
+</pre>
+
+<p>This hook is called when the selection finishes playing.
+</p>
+<div class="spacer"></div>
<!-- update-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="updatehook">update-hook</a> (snd)</code> [<b>or</b>]
-</td></tr><tr><td></td><td colspan=2>
-update-hook is called just before a sound is updated ("update" means the sound is re-read from the disk, flushing the current version; this
+<pre class="indented">
+<em class=def id="updatehook">update-hook</em> (snd)
+</pre>
+
+<p>update-hook is called just before a sound is updated ("update" means the sound is re-read from the disk, flushing the current version; this
is useful if you overwrite a sound file with some other program, while viewing it in Snd).
The update process can be triggered by a variety of situations, not just by <a href="#updatesound">update-sound</a>.
-The hook is passed the sound's index. If its function returns #t, the update is cancelled (this is not
+The hook is passed the sound's index. If it returns #t, the update is cancelled (this is not
recommended!); if it returns a procedure of one argument, that procedure is called upon
completion of the update operation; its argument is the (possibly different) sound.
Snd tries to maintain the index across the update, but if you change the number of channels
the newly updated sound may have a different index. <a href="sndscm.html#addmarkpane">add-mark-pane</a> in snd-motif.scm uses
the returned procedure to make sure the mark pane is reactivated right away when a sound is updated. The basic idea is:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>update-hook</em>
- (lambda (snd-about-to-be-updated)
- ;; this function called just before update
- (lambda (updated-snd)
- ;; this code executed when update is complete
- (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> "ok!"))))
-</pre></td></tr></table>
+ (lambda (hook)
+ (set! (hook 'result)
+ (lambda (updated-snd) ; this code executed when update is complete
+ (<a class=quiet href="#sndprint">snd-print</a> "ok!")))))
+</pre>
-I use update-hook to make sure the y axis bounds reflect the new maxamp, if it is greater than 1.0:
+<p>I use update-hook to make sure the y axis bounds reflect the new maxamp, if it is greater than 1.0:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(hook-push <em class=red>update-hook</em>
- (lambda (old-snd)
- (lambda (snd)
- (do ((i 0 (+ 1 i)))
- ((= i (<a class=quiet href="#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a> snd)))
- (let ((mx (<a class=quiet href="#maxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_maxamp_tip)">maxamp</a> snd i)))
- (if (> mx 1.0)
- (set! (<a class=quiet href="#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a> snd i) (list (- mx) mx))
- (if (and (> (cadr (<a class=quiet href="#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a> snd)) 1.0) ; previous (pre-update) version was > 1.0
- (<= mx 1.0)) ; but current is not, so reset axes
- (set! (<a class=quiet href="#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a> snd i) (list -1.0 1.0)))))))))
-</pre></td></tr></table>
-
-Say we're editing a sound in several different windows, and want to save and re-apply any
-edits we may have in the other windows when we save the sound from one window (all the others
-then get the exploding bomb icon because their underlying data has changed):
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(let ((eds #f))
- (hook-push <em class=red>update-hook</em>
- (lambda (cursnd) ; called before actual update -- save our edits
- (set! eds (<a href="#editlisttofunction">edit-list->function</a> cursnd 0))
- (lambda (newsnd) ; called after update -- reapply our edits
- (if eds (eds newsnd 0))))))
-</pre></td></tr></table>
-
-Actually this only works if there are just two windows on the same (mono) sound. I suppose for
-trickier cases, we could set up an association list with the old sound ("cursnd" above) and its edits,
-but it's probably better to bind some keystroke to a function that performs the same operations.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+ (lambda (hook)
+ (let ((old-snd (hook 'snd))) ; (hook 'snd) is the sound about to be updated
+ (set! (hook 'result)
+ (lambda (snd)
+ (do ((i 0 (+ i 1)))
+ ((= i (<a class=quiet href="#chans">channels</a> snd)))
+ (let ((mx (<a class=quiet href="#maxamp">maxamp</a> snd i)))
+ (if (> mx 1.0)
+ (set! (<a class=quiet href="#ybounds">y-bounds</a> snd i) (list (- mx) mx))
+ (if (and (> (cadr (<a class=quiet href="#ybounds">y-bounds</a> old-snd)) 1.0) ; previous (pre-update) version was > 1.0
+ (<= mx 1.0)) ; but current is not, so reset axes
+ (set! (<a class=quiet href="#ybounds">y-bounds</a> snd i) (list -1.0 1.0)))))))))))
+</pre>
+<div class="spacer"></div>
<!-- view-files-select-hook -->
-<tr><td colspan=3 bgcolor="#f2f4ff">
-<code><a class=def name="viewfilesselecthook">view-files-select-hook</a> (dialog filename)</code>
-</td></tr><tr><td></td><td colspan=2>
-This hook is called each time a file is selected in a View Files dialog's files list.
-</td></tr><tr><td colspan=3 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewfilesselecthook">view-files-select-hook</em> (dialog name) [Motif only]
+</pre>
-</table>
-<br><br>
+<p>This hook is called each time a file is selected in a View Files dialog's files list.
+</p>
+<div class="spacer"></div>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>Channel-specific hooks:</h4></td></tr></table>
-<pre>
- <a class=def name="edithook">edit-hook</a> (snd chn)
- <a class=def name="undohook">undo-hook</a> (snd chn)
- <a class=def name="afteredithook">after-edit-hook</a> (snd chn)
+<div class="innerheader">Channel-specific hooks:</div>
+
+<pre class="indented">
+<em class=def id="edithook">edit-hook</em> (snd chn)
+<em class=def id="undohook">undo-hook</em> (snd chn)
+<em class=def id="afteredithook">after-edit-hook</em> (snd chn)
</pre>
-<table border=0><tr><td width=30><br></td><td>
-These are functions that return the hooks in question associated with the specified channel.
-The functions on these hooks are thunks — they should take no arguments.
+<p>These are functions that return the hooks in question associated with the specified channel.
+In Ruby and Forth the functions on these hooks are thunks — they should take no arguments.
edit-hook is called just before any attempt to edit the channel's data; if it returns #t,
the edit is cancelled. So,
-</td></tr></table>
-<pre>
- Scheme: (hook-push (edit-hook snd chn) (lambda () #t))
- Ruby: edit_hook(snd, chn).add_hook!(\"stop-edit\") do | | true end
- Forth: snd chn edit-hook lambda: <{ }> #t ; add-hook!
+</p>
+
+<pre class="indented">
+Scheme: (hook-push (edit-hook hook) (lambda (hook) (set! (hook 'result) #t)))
+Ruby: edit_hook(snd, chn).add_hook!(\"stop-edit\") do | | true end
+Forth: snd chn edit-hook lambda: <{ }> #t ; add-hook!
</pre>
-<table border=0><tr><td width=30><br></td><td>
-halts any attempt to edit the data; this is even more restrictive than setting the read-only
+
+<p>halts any attempt to edit the data; this is even more restrictive than setting the read-only
flag because the latter only refuses to overwrite the current data. undo-hook is called
just after any undo, redo, or revert that affects the channel. after-edit-hook is called
after an edit, but before after-graph-hook (<a href="sndscm.html#addmarkpane">add-mark-pane</a> in snd-motif.scm
@@ -2950,43 +3237,42 @@ uses this hook to update a mark list after each edit
so that the displayed mark positions are correct).
You can use edit-hook to set
up protected portions of the edit history:
+</p>
-<table border=0 cellpadding=5 hspace=20 vspace=10><tr><td><pre>
+<pre class="indented">
(define* (protect snd chn)
- "(protect snd chn) disallows any edits before the current one"
- (let* ((edit-pos (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> snd chn))
- (hook (<em class=red>edit-hook</em> snd chn)))
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_reset_hook_tip)">reset-hook!</a> hook)
- (hook-push hook
- (lambda ()
- (let ((val (< (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> snd chn) edit-pos)))
- (if val (<a class=quiet href="#reportinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_reportinminibuffer_tip)">report-in-minibuffer</a> "protected"))
- val)))))
+ (let ((edit-pos (<a class=quiet href="#editposition">edit-position</a> snd chn))
+ (hook (<em class=red>edit-hook</em> snd chn)))
+ (set! (hook-functions hook)
+ (list
+ (lambda ()
+ (let ((val (< (<a class=quiet href="#editposition">edit-position</a> snd chn) edit-pos)))
+ (if val (<a class=quiet href="#statusreport">status-report</a> "protected"))
+ (set! (hook 'result) val)))))))
(define* (unprotect snd chn)
- "(unprotect snd chn) allows edits at any edit history position"
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_reset_hook_tip)">reset-hook!</a> (<em class=red>edit-hook</em> snd chn)))
-</pre></td></tr></table>
+ (set! (hook-functions (<em class=red>edit-hook</em> snd chn)) ()))
+</pre>
-<a href="sndscm.html#enveddoc">enved.scm</a> uses several of these hooks to implement an envelope editor in lisp.
+<p><a href="sndscm.html#enveddoc">enved.scm</a> uses several of these hooks to implement an envelope editor in lisp.
add-mark-pane in snd-motif.scm uses them to make sure the mark list reflects the current edit history location.
-See also autosave.scm. <small>It is possible for after-edit-hook to be called more often that edit-hook, or
+See also autosave.scm. It is possible for after-edit-hook to be called more often that edit-hook, or
vice-versa; edit-hook may be called more than once on a given attempt to edit; if a long computation is required
-Snd may check edit-hook ahead of time to avoid unnecessary work.</small>
+Snd may check edit-hook ahead of time to avoid unnecessary work.
+</p>
-</td></tr></table>
-<br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndobjects">Snd's objects</a></h3></td></tr></table>
+
+<div class="header" id="sndobjects">Snd's objects</div>
<p>Snd presents its various data structures as a list
of sounds, each with a list of channels, each with lists of edits,
marks, and mixes. The sound data itself is accessed through
a variety of structures and functions, each aimed at a particular
kind of use. The accessors from lowest level up are:
-samplers (one sample at a time iterators) and frame-readers (a "frame" is a multichannel sample),
-channel-at-a-time blocks (vcts, map-channel, etc), multichannel blocks (sound-data objects, map-sound, etc),
+samplers (one sample at a time iterators) and frample-readers (a "frample" is a multichannel sample),
+channel-at-a-time blocks (float-vectors, map-channel, etc), multichannel blocks (map-sound, etc),
a few historical leftovers that follow the "sync" field (scale-to, etc), and finally
the top-level operations such as save-sound-as (these are used in the File menu, etc).
In the following sections, I'll start with the lowest level and work upwards, more or less.
@@ -3009,15 +3295,13 @@ thing. If you want to refer to the currently selected sound explicitly, use
<p>In many cases, the 'snd', 'chn', and 'reg' arguments
can be #t which
means "all"; if 'snd' is #t, all sounds are included.
-<code>(<a class=quiet href="#expandcontrol" onmouseout="UnTip()" onmouseover="Tip(extsnd_expandcontrol_tip)">expand-control</a> #t)</code> returns a list of the current
+<code>(<a class=quiet href="#expandcontrol">expand-control</a> #t)</code>
+returns a list of the current
control panel expansion settings of all sounds, and
-<code>(set! (<a class=quiet href="#transformgraphp" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformgraphp_tip)">transform-graph?</a> #t #t) #t)</code>
+<code>(set! (<a class=quiet href="#transformgraphp">transform-graph?</a> #t #t) #t)</code>
turns on the fft display in all channels of all sounds.
</p>
-<p>In the function documentation here, optional arguments are brown, and optional keyword arguments are preceded by a colon.
-</p>
-
<p>When an error occurs, the function throws a tag such as 'no-such-sound,
'no-active-selection, etc.
All the functions that take sound and channel args ('snd chn' below) can return the errors
@@ -3026,13 +3310,14 @@ all the region-related functions can return 'no-such-region; all selection-orien
can return 'no-active-selection. To reduce clutter, I'll omit mention
of these below.
</p>
-<br>
+
<!-- INDEX samplers:samplers -->
-<!-- ---------------------------------------- SAMPLERS ---------------------------------------- -->
+<!-- SAMPLERS -->
+
+<div class="header" id="samplers">Samplers</div>
-<table width="50%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h3><A NAME="samplers">Samplers</a></h3></td></tr></table>
<p>
The simplest data access function is <a href="#sample">sample</a> which returns the sample at
a given position in a sound's channel. This simplicity, however, comes at
@@ -3042,1604 +3327,1475 @@ which can sometimes require that it open, read, and close a sound file.
The result is that sample can bring your code
to a grinding halt. There are two alternatives, leaving aside the scanning
and mapping functions mentioned below. One involves keeping the buffer of
-data around explicitly (<a class=quiet href="#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a>), and the other involves the
+data around explicitly (channel->float-vector), and the other involves the
use of a special object known as a sampler. The sampler
returns the next sample in its sound each time it is called; this kind
of access is sometimes called an "enumerator" (Ruby) or perhaps "iterator" (Gtk+).
-The buffer approach (<a class=quiet href="#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> in <a href="grfsnd.html#expsrc">expsrc</a>)
+The buffer approach (channel->float-vector in <a href="grfsnd.html#expsrc">expsrc</a>)
is better if you're jumping around in the data, the sample-by-sample approach if you're treating
the data as a sequence of samples.
To get a sampler,
-you create a reader (via <a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a>) giving it the start position, the sound and channel
-to read, and the initial read direction, then get data via <a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> (which remembers the
-read direction passed to <a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a>),
-or <a class=quiet href="#nextsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_nextsample_tip)">next-sample</a> (read forward) and
-<a class=quiet href="#previoussample" onmouseout="UnTip()" onmouseover="Tip(extsnd_previoussample_tip)">previous-sample</a> (read backward);
-when done, you can close the reader with <a class=quiet href="#freesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_freesampler_tip)">free-sampler</a>,
+you create a reader (via <a class=quiet href="#makesampler">make-sampler</a>) giving it the start position, the sound and channel
+to read, and the initial read direction, then get data via <a class=quiet href="#readsample">read-sample</a> (which remembers the
+read direction passed to <a class=quiet href="#makesampler">make-sampler</a>),
+or <a class=quiet href="#nextsample">next-sample</a> (read forward) and
+<a class=quiet href="#previoussample">previous-sample</a> (read backward);
+when done, you can close the reader with <a class=quiet href="#freesampler">free-sampler</a>,
but it's usually not necessary; the
garbage collector will take care of it if you forget (but, sigh, the GC can be dilatory at times).
</p>
<p>There is a similar set of functions giving access to the mix data.
-<a class=quiet href="#makemixsampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makemixsampler_tip)">make-mix-sampler</a> returns a mix reader for the desired mix,
-<a class=quiet href="#mixsamplerQ" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixsamplerQ_tip)">mix-sampler?</a> returns #t if its argument in a mix sampler,
-and <a class=quiet href="#readmixsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readmixsample_tip)">read-mix-sample</a> returns the next sample (before it is mixed into
+<a class=quiet href="#makemixsampler">make-mix-sampler</a> returns a mix reader for the desired mix,
+<a class=quiet href="#mixsamplerQ">mix-sampler?</a> returns #t if its argument in a mix sampler,
+and <a class=quiet href="#readmixsample">read-mix-sample</a> returns the next sample (before it is mixed into
the output).
</p>
-<p>Multichannel iterations can be handled via <a href="sndscm.html#framereaders">frame-readers</a>. These are currently
-implemented in frame.scm.
-</p>
-
-<!-- -------------------------------- SAMPLER TABLE -------------------------------- -->
+<!-- SAMPLER TABLE -->
+<div class="spacer"></div>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
<!-- copy-sampler -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="copysampler">copy-sampler</a> obj</code>
-</td></tr><tr><td width=30><br></td><td>
-copy-sampler returns a copy of 'obj' which can be any kind of sampler.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="copysampler">copy-sampler</em> obj
+</pre>
+
+<p>copy-sampler returns a copy of 'obj' which can be any kind of sampler.
+</p>
+<div class="spacer"></div>
<!-- free-sampler -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="freesampler">free-sampler</a> obj</code>
-</td></tr><tr><td></td><td>
-free-sampler
+<pre class="indented">
+<em class=def id="freesampler">free-sampler</em> obj
+</pre>
+
+<p>free-sampler
releases the sampler 'obj'. In most cases, you don't need to call this
function because the garbage collector handles the sampler object, but it doesn't hurt anything (but don't try to use a sampler
-after you've freed it!). If you're using zillions of samplers in an optimized (run-based) loop that
-doesn't trigger garbage collection, freeing the samplers explicitly can reduce
+after you've freed it!). If you're using zillions of samplers, sometimes freeing the samplers explicitly can reduce
demands on memory.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- make-mix-sampler -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="makemixsampler">make-mix-sampler</a> mix <em class=narg>(beg 0)</em></code>
-</td></tr><tr><td></td><td>
-make-mix-sampler creates a mix-sampler reading 'mix' starting (in the mix input) at 'beg'.
-See <a href="sndscm.html#mixtovct">mix->vct</a> in mix.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="makemixsampler">make-mix-sampler</em> mix (beg 0)
+</pre>
+
+<p>make-mix-sampler creates a mix-sampler reading 'mix' starting (in the mix input) at 'beg'.
+See <a href="sndscm.html#mixtovct">mix->float-vector</a> in mix.scm.
+</p>
+<div class="spacer"></div>
<!-- make-region-sampler -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="makeregionsampler">make-region-sampler</a> start <em class=narg>reg chn (dir 1)</em></code>
-</td></tr><tr><td></td><td>
-make-region-sampler creates a sampler reading channel 'chn' of the region 'reg' starting
+<pre class="indented">
+<em class=def id="makeregionsampler">make-region-sampler</em> start reg chn (dir 1)
+</pre>
+
+<p>make-region-sampler creates a sampler reading channel 'chn' of the region 'reg' starting
at sample 'start', and reading forward if 'dir' is 1, backwards if 'dir' is -1.
It is not safe to assume that this reader will return zeros beyond the region boundaries.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- make-sampler -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="makesampler">make-sampler</a> <em class=narg>start snd chn dir edpos</em></code>
-</td></tr><tr><td></td><td>
-make-sampler creates a sampler reading the given channel
+<pre class="indented">
+<em class=def id="makesampler">make-sampler</em> start snd chn dir edpos
+</pre>
+
+<p>make-sampler creates a sampler reading the given channel
starting at sample 'start' with initial read direction 'dir'
(1=forward, -1=backward). 'edpos' is the edit history position to read;
it defaults to the current edit.
-<pre>
- :<em class=typing>(open-sound "oboe.snd")</em>
- <em class=listener>#<sound 0></em>
- :<em class=typing>(define reader (make-sampler 1000))</em>
- <em class=listener>reader</em>
- :<em class=typing>reader</em>
- <em class=listener>#<sampler: oboe.snd[0: 0] from 1000, at 1000, forward></em>
- :<em class=typing>(read-sample reader)</em>
- <em class=listener>0.0328369140625</em>
- :<em class=typing>(sample 1000)</em>
- <em class=listener>0.0328369140625</em>
- :<em class=typing>(next-sample reader)</em>
- <em class=listener>0.0347900390625</em>
- :<em class=typing>(sample 1001)</em>
- <em class=listener>0.0347900390625</em>
- :<em class=typing>(sampler-home reader)</em>
- <em class=listener>(#<sound 0> 0)</em>
- :<em class=typing>(sampler-position reader)</em>
- <em class=listener>1002</em>
-</pre>
-One use of 'edpos' is to get the difference
+</p>
+
+<pre class="indented">
+> (open-sound "oboe.snd")
+#<sound 0>
+> (define reader (make-sampler 1000))
+reader
+> reader
+#<sampler: oboe.snd[0: 0] from 1000, at 1000, forward>
+> (read-sample reader)
+0.0328369140625
+> (sample 1000)
+0.0328369140625
+> (next-sample reader)
+0.0347900390625
+> (sample 1001)
+0.0347900390625
+> (sampler-home reader)
+(#<sound 0> 0)
+> (sampler-position reader)
+1002
+</pre>
+
+<p>One use of 'edpos' is to get the difference
between two edits:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define snd-diff
(lambda () ;assume mono, get diff between current state and previous
- (let* ((index (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>))
- (edit-pos (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> index))
+ (let* ((index (<a class=quiet href="#selectedsound">selected-sound</a>))
+ (edit-pos (<a class=quiet href="#editposition">edit-position</a> index))
(previous-edit (<em class=red>make-sampler</em> 0 0 index 1 (- edit-pos 1))))
(lambda (x)
- (- x (<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> previous-edit)) #f))))
+ (- x (<a class=quiet href="#readsample">read-sample</a> previous-edit)) #f))))
-(<a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (snd-diff))
-</pre></td></tr></table>
+(<a class=quiet href="#mapchannel">map-channel</a> (snd-diff))
+</pre>
-Once the reader has been set up to read at a given edit position, subsequent
+<p>Once the reader has been set up to read at a given edit position, subsequent
edits won't affect it. One sequence that takes advantage of this is: make-sampler, scale-by 0,
then run an overlap-add process on the data from before the scaling.
-<br><br>
-'snd' can be a filename (a string); in this way a sampler
+</p>
+
+<p>'snd' can be a filename (a string); in this way a sampler
can read external sounds without going to the trouble of loading them into Snd.
-<pre>
- (define reader (make-sampler 100 "oboe.snd"))
+</p>
+
+<pre class="indented">
+(define reader (make-sampler 100 "oboe.snd"))
</pre>
-'snd' also can be a mix or region.
+
+<p>'snd' also can be a mix or region.
make-sampler is probably the most useful function in Snd; there are lots of examples
in the Scheme, Ruby, and Forth files.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix-sampler? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixsamplerQ">mix-sampler?</a> obj</code>
-</td></tr><tr><td></td><td>
-mix-sampler? returns #t if 'obj' is a mix-sampler.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixsamplerQ">mix-sampler?</em> obj
+</pre>
+
+<p>mix-sampler? returns #t if 'obj' is a mix-sampler.
+</p>
+<div class="spacer"></div>
<!-- next-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="nextsample">next-sample</a> obj</code>
-</td></tr><tr><td></td><td>
-next-sample returns the next sample (reading forward) read by the sampler 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="nextsample">next-sample</em> obj
+</pre>
+
+<p>next-sample returns the next sample (reading forward) read by the sampler 'obj'.
+</p>
+<div class="spacer"></div>
<!-- previous-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="previoussample">previous-sample</a> obj</code>
-</td></tr><tr><td></td><td>
-previous-sample returns the previous sample in the stream read by the sampler 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="previoussample">previous-sample</em> obj
+</pre>
+
+<p>previous-sample returns the previous sample in the stream read by the sampler 'obj'.
+</p>
+<div class="spacer"></div>
<!-- read-mix-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="readmixsample">read-mix-sample</a> obj</code>
-</td></tr><tr><td></td><td>
-read-mix-sample returns the next sample read by the mix-sampler 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="readmixsample">read-mix-sample</em> obj
+</pre>
+<p>read-mix-sample returns the next sample read by the mix-sampler 'obj'.
+</p>
+<div class="spacer"></div>
-<!-- read-region-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="readregionsample">read-region-sample</a> obj</code>
-</td></tr><tr><td></td><td>
-read-region-sample returns the next sample read by the region-sampler 'obj'.
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (region->vct reg (chn 0))
- (if (<a class=quiet href="#regionok" onmouseout="UnTip()" onmouseover="Tip(extsnd_regionok_tip)">region?</a> reg)
+<!-- read-region-sample -->
+<pre class="indented">
+<em class=def id="readregionsample">read-region-sample</em> obj
+</pre>
+
+<p>read-region-sample returns the next sample read by the region-sampler 'obj'.
+</p>
+
+<pre class="indented">
+(define* (region->float-vector reg (chn 0))
+ (if (<a class=quiet href="#regionok">region?</a> reg)
(if (< chn (channels reg))
(let* ((reader (<em class=red>make-region-sampler</em> 0 reg chn))
- (len (<a class=quiet href="#regionframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_regionframes_tip)">region-frames</a> reg))
- (data (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> len)))
- (do ((i 0 (+ 1 i)))
+ (len (<a class=quiet href="#regionframples">region-framples</a> reg))
+ (data (make-float-vector len 0.0)))
+ (do ((i 0 (+ i 1)))
((= i len) data)
(set! (data i) (<em class=red>reader</em>))))
- (throw 'no-such-channel (list "region->vct" reg chn)))
- (throw 'no-such-region (list "region->vct" reg))))
-</pre></td></tr></table>
-
-</td></tr><tr><td colspan=2 height=16></td></tr>
+ (error 'no-such-channel (list "region->float-vector" reg chn)))
+ (error 'no-such-region (list "region->float-vector" reg))))
+</pre>
+<div class="spacer"></div>
<!-- read-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="readsample">read-sample</a> obj</code>
-</td></tr><tr><td></td><td>
-read-sample returns the next sample read by the sampler 'obj',
-reading in the direction set by <a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="readsample">read-sample</em> obj
+</pre>
+
+<p>read-sample returns the next sample read by the sampler 'obj',
+reading in the direction set by <a class=quiet href="#makesampler">make-sampler</a>.
+</p>
+<div class="spacer"></div>
+
+
+<!-- read-sample-with-direction -->
+<pre class="indented">
+<em class=def id="readsamplewithdirection">read-sample-with-direction</em> obj dir
+</pre>
+
+<p>read-sample-with-direction returns the next sample read by the sampler 'obj',
+reading in the direction set by 'dir' (1 = forward, -1 = backward). This
+combination of next-sample and previous-sample is intended mainly for src.
+</p>
+<div class="spacer"></div>
<!-- region-sampler? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionsamplerQ">region-sampler?</a> obj</code>
-</td></tr><tr><td></td><td>
-region-sampler? returns #t if 'obj' is a region sampler.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="regionsamplerQ">region-sampler?</em> obj
+</pre>
+
+<p>region-sampler? returns #t if 'obj' is a region sampler.
+</p>
+<div class="spacer"></div>
<!-- sampler-at-end? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sampleratendQ">sampler-at-end?</a> obj</code>
-</td></tr><tr><td></td><td>
-sampler-at-end? returns #t if the sampler 'obj' (any kind of reader) is at the end of the sound (or whatever it is reading),
+<pre class="indented">
+<em class=def id="sampleratendQ">sampler-at-end?</em> obj
+</pre>
+
+<p>sampler-at-end? returns #t if the sampler 'obj' (any kind of reader) is at the end of the sound (or whatever it is reading),
and hence is returning 0.0 each time it is called. When the last "real" sample is returned, the at-end? flag is still false; when it
becomes true, the sampler returns a 0.0 sample.
See <a href="sndscm.html#locatezero">locate-zero</a> in examp.scm, or <a href="sndscm.html#linearsrcchannel">linear-src-channel</a> in dsp.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- sampler-home -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="samplerhome">sampler-home</a> obj</code>
-</td></tr><tr><td></td><td>
-sampler-home returns information describing the source of the data the sampler 'obj' is reading.
+<pre class="indented">
+<em class=def id="samplerhome">sampler-home</em> obj
+</pre>
+
+<p>sampler-home returns information describing the source of the data the sampler 'obj' is reading.
if 'obj' is a sound sampler, it returns a list with the sound and channel number associated with 'obj'.
If 'obj' is a mix reader, it returns the mix.
Finally, if 'obj' is a region reader, it returns a list with the region.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- sampler-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="samplerposition">sampler-position</a> obj</code>
-</td></tr><tr><td></td><td>
-sampler-position returns the
+<pre class="indented">
+<em class=def id="samplerposition">sampler-position</em> obj
+</pre>
+
+<p>sampler-position returns the
current (sample-wise) location of the sampler 'obj' (any kind of reader).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- sampler? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="samplerQ">sampler?</a> obj</code>
-</td></tr><tr><td></td><td>
-sampler? returns #t if 'obj' is a sampler.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="samplerQ">sampler?</em> obj
+</pre>
-</table>
+<p>sampler? returns #t if 'obj' is a sampler.
+</p>
-<p>If your extension language supports it, the read-sample functions can be omitted: <code>(reader)</code> is the same as <code>(<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> reader)</code>.
+
+<p>If your extension language supports it, the read-sample functions can be omitted: <code>(reader)</code> is the same as <code>(<a class=quiet href="#readsample">read-sample</a> reader)</code>.
</p>
-<br>
-<table width="35%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>Snd->sample</h4></td></tr></table>
+
+
+<div class="innerheader">Snd->sample</div>
<p>There is a Snd-specific CLM-style generator that redirects CLM instrument input (via in-any, ina, etc)
to Snd data, snd->sample.
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
-
<!-- make-snd->sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="makesndtosample">make-snd->sample</a> <em class=narg>snd</em></code>
-</td></tr><tr><td width=30><br></td><td>
-make-snd->sample creates a Snd data reader for use with CLM's in-any, file->sample, etc.
-</td></tr>
-<tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="makesndtosample">make-snd->sample</em> snd
+</pre>
+
+<p>make-snd->sample creates a Snd data reader for use with CLM's in-any, file->sample, etc.
+</p>
+<div class="spacer"></div>
+
<!-- snd->sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sndtosample">snd->sample</a> gen frame <em class=narg>chan</em></code>
-</td></tr><tr><td><br></td><td>
-snd->sample gets the next sample from the data accessed by 'gen', similar to file->sample.
+<pre class="indented">
+<em class=def id="sndtosample">snd->sample</em> gen frample chan
+</pre>
+
+<p>snd->sample gets the next sample from the data accessed by 'gen', similar to file->sample.
If *reverb* is a snd->sample generator, for example,
-<a class=quiet href="sndclm.html#ina" onmouseout="UnTip()" onmouseover="Tip(sndclm_ina_tip)">ina</a> and <a class=quiet href="sndclm.html#filetosample" onmouseout="UnTip()" onmouseover="Tip(sndclm_filetosample_tip)">file->sample</a> actually call snd->sample.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<a class=quiet href="sndclm.html#ina">ina</a> and <a class=quiet href="sndclm.html#filetosample">file->sample</a> actually call snd->sample.
+</p>
+<div class="spacer"></div>
<!-- snd->sample? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sndtosamplep">snd->sample?</a> obj</code>
-</td></tr><tr><td><br></td><td>
-snd->sample? returns #t if 'obj' is a snd->sample generator.
-</td></tr>
+<pre class="indented">
+<em class=def id="sndtosamplep">snd->sample?</em> obj
+</pre>
+
+<p>snd->sample? returns #t if 'obj' is a snd->sample generator.
+</p>
+<div class="spacer"></div>
+
-</table>
-<br>
<!-- INDEX Vcts:Vcts -->
-<table width="50%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h3><A NAME="Vcts">Vcts</a></h3></td></tr></table>
-<p>
-Many of the Snd and CLM functions handle vectors (arrays) of data.
-By defining a new vector type, named vct, and providing a package
-of old-style array-processing calls upon that type, we can speed up many
-operations by a factor of 30 — enough of a difference to warrant
-the added complexity.
-<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> creates a new vct object. It is freed by the
-garbage collector when it can't be referenced any further. To get
-an element of a vct, use <a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a>; similarly <a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a>
-sets an element. (vct's are applicable objects, so vct-ref can always be omitted, and set! can replace vct-set!).
-Once created, a vct can be passed to a variety of built-in
-functions:</p>
-
-<table border=0><tr><td>
-
-<table border=0 cellpadding=5><tr><td><pre>
-Scheme:
- (define hi (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 100))
- (<a class=quiet href="#vctfill" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctfill_tip)">vct-fill!</a> hi 3.14)
- (<a class=quiet href="#vctscale" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctscale_tip)">vct-scale!</a> hi -1.0)
-</pre></td></tr></table>
-</td><td>
-<table border=0 cellpadding=5><tr><td bgcolor="Beige"><pre>
-Ruby:
- hi = make_vct(100)
- vct_fill!(hi, 3.14)
- vct_scale!(hi, -1.0)
-</pre></td></tr></table>
-</td><td>
+<div class="header" id="Vcts">Vcts or float-vectors</div>
-<table border=0 cellpadding=5><tr><td bgcolor="LightGreen"><pre>
-Forth: variable hi
- 100 0.0 make-vct hi !
- hi @ 3.14 vct-fill!
- hi @ -1.0 vct-scale!
-</pre></td></tr></table>
-</td></tr></table>
+<p>These are arrays of floats. In s7, use "float-vector", and in Forth and
+Ruby use "vct".
+</p>
-<p>Now our vct 'hi' has 100 -3.14's. </p>
+<!-- VCT TABLE -->
-<!-- -------------------------------- VCT TABLE -------------------------------- -->
+<div class="spacer"></div>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
<!-- list->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="listtovct">list->vct</a> lst</code>
-</td></tr><tr><td width=30></td><td>
-return a new vct with elements of list 'lst' (equivalent to the <a href="#vct">vct</a> function).
-<pre>
- :<em class=typing>(list->vct (list 0.1 0.2 0.3))</em>
- <em class=listener>#<vct[len=3]: 0.100 0.200 0.300></em>
- :<em class=typing>(vct 0.1 0.2 0.3)</em>
- <em class=listener>#<vct[len=3]: 0.100 0.200 0.300></em>
+<pre class="indented">
+<em class=def id="listtovct">list->vct</em> lst
+<em class=def id="listtofv">list->float-vector</em> lst
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>return a new float-vector with elements of list 'lst' (equivalent to the <a href="#vct">float-vector</a> function).
+</p>
+<div class="spacer"></div>
<!-- make-vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="makevct">make-vct</a> len <em class=narg>(initial-element 0.0)</em></code>
-</td></tr><tr><td></td><td>
-make-vct creates a vct of size 'len'.
-<pre>
- :<em class=typing>(make-vct 3 0.1)</em>
- <em class=listener>#<vct[len=3]: 0.100 0.100 0.100></em>
+<pre class="indented">
+<em class=def id="makevct">make-vct</em> len (initial-element 0.0)
+<em class=def id="makefv">make-float-vector</em> len (initial-element 0.0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- sound-date->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><em class=emdef>sound-data->vct</em> sdobj <em class=narg>(chan 0) (v #f)</em></code>
-</td></tr><tr><td></td><td>
-sound-data->vct places the sound-data data in a vct, returning 'v' (if given) or a new vct.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>make-float-vector creates a float-vector of size 'len'.
+</p>
+<div class="spacer"></div>
<!-- vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vct">vct</a> :rest args</code>
-</td></tr><tr><td></td><td>
-vct is equivalent to list->vct with 'args' as the list: <code>(vct 1 2 3)</code> is the same as <code>(<a class=quiet href="#listtovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_listtovct_tip)">list->vct</a> '(1 2 3))</code>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="vct">vct</em> :rest args
+<em class=def id="fv">float-vector</em> :rest args
+</pre>
+
+<p>float-vector is equivalent to list->float-vector with 'args' as the list: <code>(float-vector 0.0 0.1 0.2)</code>.
+</p>
+<div class="spacer"></div>
<!-- vct? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctp">vct?</a> v</code>
-</td></tr><tr><td></td><td>
-vct? returns #t if 'v' is a vct.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="vctp">vct?</em> v
+<em class=def id="fvp">float-vector?</em> v
+</pre>
+
+<p>float-vector? returns #t if 'v' is a float-vector.
+</p>
+<div class="spacer"></div>
+
+
+<!-- vct-abs! -->
+<pre class="indented">
+<em class=def id="vctabs">vct-abs!</em> v
+<em class=def id="fvabs">float-vector-abs!</em> v
+</pre>
+
+<p>float-vector-abs! replaces each element of 'v' with its absolute value.
+</p>
+<div class="spacer"></div>
<!-- vct-add! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctadd">vct-add!</a> v1 v2 <em class=narg>(off 0)</em></code>
-</td></tr><tr><td></td><td>
-vct-add! performs element-wise add: <code>v1[i + off] += v2[i]</code>, returning 'v1'. To protect the
-original vct, use vct-copy: <code>(vct-add! (vct-vopy v1) v2)</code>.
-<pre>
-:<em class=typing>(define v1 (vct .1 .2 .3))</em>
-<em class=listener>#<unspecified></em>
-:<em class=typing>(vct-add! v1 (vct .3 .2 .1))</em>
-<em class=listener>#<vct[len=3]: 0.400 0.400 0.400></em>
-:<em class=typing>v1</em>
-<em class=listener>#<vct[len=3]: 0.400 0.400 0.400></em>
+<pre class="indented">
+<em class=def id="vctadd">vct-add!</em> v1 v2 (off 0)
+<em class=def id="fvadd">float-vector-add!</em> v1 v2 (off 0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>float-vector-add! performs element-wise add: v1[i + off] += v2[i], returning 'v1'.
+</p>
+<div class="spacer"></div>
<!-- vct-copy -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctcopy">vct-copy</a> v</code>
-</td></tr><tr><td></td><td>
-vct-copy returns a copy of the vct 'v'.
+<pre class="indented">
+<em class=def id="vctcopy">vct-copy</em> v
+<em class=def id="fvcopy">float-vector-copy</em> v
+</pre>
+
+<p>float-vector-copy returns a copy of the float-vector 'v'.
+</p>
<!-- INDEX copying:Copying -->
-<A NAME="copying"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<blockquote><small>
-<br>
+<TABLE class="method">
+<tr><th class="title">Copying</th></tr>
+<tr><td>
+<blockquote id="copying"><small>
copy file: in Scheme: copy-file, in Ruby: File.copy or File.syscopy<br>
copy string: in Forth: string-copy<br>
copy list: in Forth: list-copy or copy-tree<br>
-copy vct: <a href="#vctcopy">vct-copy</a>, <a href="#vcttovector">vct->vector</a>, <a href="sndscm.html#vcttoframe">vct->frame</a><br>
-copy mix: <a href="sndscm.html#mixtovct">mix->vct</a><br>
+copy mix: <a href="sndscm.html#mixtovct">mix->float-vector</a><br>
copy sampler: <a href="#copysampler">copy-sampler</a><br>
copy (clone) current sound edit state: <a href="#clonesoundas">clone-sound-as</a><br>
-copy channel data: <a href="#channeltovct">channel->vct</a>, or <a href="#savesoundas">save-sound-as</a><br>
-copy selection data: <a href="#selection2vct">selection->vct</a> or <a href="#saveselection">save-selection</a><br>
-copy region data: <a href="#regiontovct">region->vct</a>, <a href="#regiontovct">region->vct</a>, <a href="#saveregion">save-region</a>, or <a href="sndscm.html#regiontosounddata">region->sound-data</a><br>
-copy transform data: <a href="#transformtovct">transform->vct</a><br>
-copy sound-data: <a href="#sounddatatovct">sound-data->vct</a><br>
-copy a frame: <a href="sndscm.html#framecopy">frame-copy</a>, <a href="sndscm.html#frametovct">frame->vct</a><br>
-copy vector: <a href="#vectortovct">vector->vct</a><br>
-<br>
+copy channel data: <a href="#channeltovct">channel->float-vector</a>, or <a href="#savesoundas">save-sound-as</a><br>
+copy selection data: <a href="#selection2vct">selection->float-vector</a> or <a href="#saveselection">save-selection</a><br>
+copy region data: <a href="#regiontovct">region->float-vector</a>, <a href="#saveregion">save-region</a><br>
+copy transform data: <a href="#transformtovct">transform->float-vector</a><br>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
-<!-- vct-fill! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctfill">vct-fill!</a> v val</code>
-</td></tr><tr><td></td><td>
-vct-fill! sets each element of 'v' to 'val': <code>v[i] = val</code>. It returns 'v'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct-equal? -->
+<pre class="indented">
+<em class=def id="vctequal">vct-equal?</em> v1 v2 diff
+<em class=def id="fvequal">float-vector-equal?</em> v1 v2 diff
+</pre>
+<p>float-vector-equal? is an element-wise relative difference check.
+If (abs(v1[i] - v2[i]) / (max (abs v1[i]) (abs v2[i]))) > diff, it returns false.
+Otherwise it returns the maximum relative difference encountered. If v1 and v2
+are of different lengths, the overlapping portion is checked.
+</p>
+<div class="spacer"></div>
-<!-- vct-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctlength">vct-length</a> v</code>
-</td></tr><tr><td></td><td>
-vct-length returns the length of 'v'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct-fill! -->
+<pre class="indented">
+<em class=def id="vctfill">vct-fill!</em> v val
+<em class=def id="fvfill">float-vector-fill!</em> v val
+</pre>
-<!-- vct-map! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctmap">vct-map!</a> v proc</code>
-</td></tr><tr><td></td><td>
-vct-map! sets each element of 'v' to the value returned by the thunk 'proc': <code>(vct-map! v (lambda () 3.0))</code>
-is the same as <code>(<a class=quiet href="#vctfill" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctfill_tip)">vct-fill!</a> v 3.0)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector-fill! sets each element of 'v' to 'val': v[i] = val. It returns 'v'.
+</p>
+<div class="spacer"></div>
-<!-- vct-move! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctmove">vct-move!</a> v new old <em class=narg>backwards</em></code>
-</td></tr><tr><td></td><td>
-vct-move moves a block of values within a vct: <code>v[new++] = v[old++]</code>, or
-if 'backwards' is #t: <code>v[new--] = v[old--]</code>. It returns 'v'.
-<pre>
-:<em class=typing>(define v1 (vct 1 2 3 4 5 6 7 8 9 10))</em>
-<em class=listener>#<unspecified></em>
-:<em class=typing>(vct-move! v1 0 5)</em>
-<em class=listener>#<vct[len=10]: 6.000 7.000 8.000 9.000 10.000 6.000 7.000 8.000 9.000 10.000></em>
+<!-- vct-length -->
+<pre class="indented">
+<em class=def id="vctlength">vct-length</em> v
+<em class=def id="fvlength">float-vector-length</em> v
</pre>
-We can use vct-move! to maintain a sliding window on a sound:
-
-<pre>
- (<a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
- (let* ((size 100)
- (samps (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size)))
- (lambda (y)
- (<em class=red>vct-move!</em> samps 0 1)
- (<a class=quiet href="#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> samps (- size 1) y)
- ...)))
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector-length returns the length of 'v'.
+</p>
+<div class="spacer"></div>
-<!-- vct-multiply! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctmultiply">vct-multiply!</a> v1 v2</code>
-</td></tr><tr><td></td><td>
-vct-multiply! performs element-wise multiply of two vcts: <code>v1[i] *= v2[i]</code>. It returns 'v1'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct-max -->
+<pre class="indented">
+<em class=def id="vctmax">vct-max</em> v
+<em class=def id="fvmax">float-vector-max</em> v
+</pre>
+<p>float-vector-max returns the maximum value of the elements of 'v'.
+</p>
+<div class="spacer"></div>
-<!-- vct-offset! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctoffset">vct-offset!</a> v val</code>
-</td></tr><tr><td></td><td>
-vct-offset! adds 'val' to each element of 'v': <code>v[i] += val</code>. It returns 'v'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct-min -->
+<pre class="indented">
+<em class=def id="vctmin">vct-min</em> v
+<em class=def id="fvmin">float-vector-min</em> v
+</pre>
-<!-- vct-peak -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctpeak">vct-peak</a> v</code>
-</td></tr><tr><td></td><td>
-vct-peak returns the maximum absolute value of the elements of 'v'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector-min returns the minimum value of the elements of 'v'.
+</p>
+<div class="spacer"></div>
-<!-- vct-ref -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctref">vct-ref</a> v pos</code>
-</td></tr><tr><td></td><td>
-vct-ref returns the element 'pos' in 'v': <code>v[pos]</code>.
-<pre>
-:<em class=typing>(vct-ref (vct .1 .2 .3) 1)</em>
-<em class=listener>0.200000002980232</em>
+<!-- vct-move! -->
+<pre class="indented">
+<em class=def id="vctmove">vct-move!</em> v new old backwards
+<em class=def id="fvmove">float-vector-move!</em> v new old backwards
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- vct-reverse! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctreverse">vct-reverse!</a> v <em class=narg>size</em></code>
-</td></tr><tr><td></td><td>
-vct-reverse! reverses the elements of 'v' (in-place), returning 'v'.
-If 'size' is given, the reversal centers around it.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector-move moves a block of values within a float-vector: v[new++] = v[old++], or
+if 'backwards' is #t: v[new--] = v[old--]. It returns 'v'.
+</p>
+<div class="spacer"></div>
-<!-- vct-scale! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctscale">vct-scale!</a> v scl</code>
-</td></tr><tr><td></td><td>
-vct-scale! multiplies each element of 'v' by 'scl': <code>v[i] *= scl</code>. It returns 'v'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct-multiply! -->
+<pre class="indented">
+<em class=def id="vctmultiply">vct-multiply!</em> v1 v2
+<em class=def id="fvmultiply">float-vector-multiply!</em> v1 v2
+</pre>
+<p>float-vector-multiply! performs element-wise multiply of two float-vectors: v1[i] *= v2[i]. It returns 'v1'.
+</p>
+<div class="spacer"></div>
-<!-- vct-set! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctset">vct-set!</a> v pos val</code>
-</td></tr><tr><td></td><td>
-vct-set! sets the vct 'v' element at 'pos' to 'val': <code>v[pos] = val</code>.
-In Scheme, this is the same as <code>(set! (<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> v pos) val)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct-offset! -->
+<pre class="indented">
+<em class=def id="vctoffset">vct-offset!</em> v val
+<em class=def id="fvoffset">float-vector-offset!</em> v val
+</pre>
-<!-- vct-subtract! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctsubtract">vct-subtract!</a> v1 v2</code>
-</td></tr><tr><td></td><td>
-vct-subtract! performs an element-wise subtract: <code>v1[i] -= v2[i]</code>. It returns 'v1'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector-offset! adds 'val' to each element of 'v': v[i] += val. It returns 'v'.
+</p>
+<div class="spacer"></div>
-<!-- vct-subseq -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctsubseq">vct-subseq</a> v start <em class=narg>(end len) nv</em></code>
-</td></tr><tr><td></td><td>
-vct-subseq returns a new vct (or 'nv' if given) with the elements of 'v' between 'start' and 'end' inclusive. 'end' defaults
-to the end of 'v'.
-<pre>
-:<em class=typing>(define v1 (vct 1 2 3 4 5 6 7 8 9 10))</em>
-<em class=listener>#<unspecified></em>
-:<em class=typing>(vct-subseq v1 3 6)</em>
-<em class=listener>#<vct[len=4]: 4.000 5.000 6.000 7.000></em>
+<!-- vct-peak -->
+<pre class="indented">
+<em class=def id="vctpeak">vct-peak</em> v
+<em class=def id="fvpeak">float-vector-peak</em> v
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- vct+ -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vctplus">vct+</a> obj1 obj2</code>
-</td></tr><tr><td></td><td>
-vct+ combines <a class=quiet href="#vctadd" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctadd_tip)">vct-add!</a> and <a class=quiet href="#vctoffset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctoffset_tip)">vct-offset!</a>,
-depending on the type of its arguments.
-<code>(vct+ v 1.0)</code> or <code>(vct+ 1.0 v)</code> is the same as
-<code>(vct-offset! v 1.0)</code>, and <code>(vct+ v1 v2)</code> is the same as <code>(vct-add! v1 v2)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector-peak returns the maximum absolute value of the elements of 'v'.
+</p>
+<div class="spacer"></div>
-<!-- vct* -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vcttimes">vct*</a> obj1 obj2</code>
-</td></tr><tr><td></td><td>
-vct* combines <a class=quiet href="#vctmultiply" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctmultiply_tip)">vct-multiply!</a> and <a class=quiet href="#vctscale" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctscale_tip)">vct-scale!</a>,
-depending on the type of its arguments.
-<code>(vct* v 2.0)</code> or <code>(vct* 2.0 v)</code> is the same as <code>(vct-scale! v 2.0)</code>, and
-<code>(vct* v1 v2)</code> is the same as <code>(vct-multiply! v1 v2)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct-ref -->
+<pre class="indented">
+<em class=def id="vctref">vct-ref</em> v pos
+<em class=def id="fvref">float-vector-ref</em> v pos
+</pre>
+<p>float-vector-ref returns the element 'pos' in 'v': v[pos].
+</p>
+<div class="spacer"></div>
-<!-- vct->channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vcttochannel">vct->channel</a> v <em class=narg>(beg 0) dur snd chn edpos origin</em></code>
-</td></tr><tr><td></td><td>
-vct->channel sets the samples from 'beg' to 'beg' + 'dur' from the values in 'v'.
-This changes (edits) the channel, so 'origin' provides a way to name the edit (for the edit history list and whatnot).
-Since with-sound can write its output to a vct, we can use it with vct->channel to paste in an fm-violin note as
-an edit:
-<pre>
- (vct->channel (<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:output (make-vct 44100)) (<a class=quiet href="sndscm.html#fmviolin" onmouseout="UnTip()" onmouseover="Tip(sndscm_fmviolin_tip)">fm-violin</a> 0 1 440 .1)))
+<!-- vct-reverse! -->
+<pre class="indented">
+<em class=def id="vctreverse">vct-reverse!</em> v size
+<em class=def id="fvreverse">float-vector-reverse!</em> v size
</pre>
-To add such a note to whatever is already present, use either <a href="#mixvct">mix-vct</a> or
-<a href="sndscm.html#mixsounddata">mix-sound-data</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- vct->list -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vcttolist">vct->list</a> v</code>
-</td></tr><tr><td></td><td>
-vct->list returns a list with elements of 'v'.
-<pre>
- ;; Scheme:
- :<em class=typing>(vct->list (list->vct (list 0.1 0.2 0.3)))</em>
- <em class=listener>(0.100000001490116 0.200000002980232 0.300000011920929)</em> ; (sigh...)
+<p>float-vector-reverse! reverses the elements of 'v' (in-place), returning 'v'.
+If 'size' is given, the reversal centers around it.
+</p>
+<div class="spacer"></div>
- ;; Ruby:
- :<em class=typing>vct2list(list2vct([0.1, 0.2, 0.3]))</em>
- <em class=listener>[0.100000001490116, 0.200000002980232, 0.300000011920929]</em>
- ;; Forth:
- <em class=listener>snd></em> <em class=typing>'( 0.1 0.2 0.3 ) list->vct vct->list</em>
- <em class=listener>'( 0.1 0.2 0.3 )</em>
+<!-- vct-scale! -->
+<pre class="indented">
+<em class=def id="vctscale">vct-scale!</em> v scl
+<em class=def id="fvscale">float-vector-scale!</em> v scl
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- vct->sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><em class=emdef>vct->sound-data</em> v <em class=narg>sd (chan 0)</em></code>
-</td></tr><tr><td></td><td>
-vct->sound-data places the data in vct 'v' in the sound-data object 'sd', returning sd.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector-scale! multiplies each element of 'v' by 'scl': v[i] *= scl. It returns 'v'.
+</p>
+<div class="spacer"></div>
-<!-- vct->string -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vcttostring">vct->string</a> v</code>
-</td></tr><tr><td></td>
-<td>
-vct->string returns a Scheme-readable string describing 'v'. The standard way of displaying a vct
-uses "#<vct...>" which is not useful if you want to read the string later as a piece of Scheme code.
-<pre>
- :<em class=typing>(define v1 (make-vct 3 0.1))</em>
- prints v1 as <em class=listener>#<vct[len=3]: 0.100 0.100 0.100></em>
- :<em class=typing>(vct->string v1)</em>
- <em class=listener>"(vct 0.100 0.100 0.100)"</em>
+<!-- vct-set! -->
+<pre class="indented">
+<em class=def id="vctset">vct-set!</em> v pos val
+<em class=def id="fvset">float-vector-set!</em> v pos val
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector-set! sets the float-vector 'v' element at 'pos' to 'val': v[pos] = val.
+In Scheme, this is the same as (set! (v pos) val).
+</p>
+<div class="spacer"></div>
-<!-- vct->vector -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vcttovector">vct->vector</a> v</code>
-</td></tr><tr><td></td><td>
-vct->vector returns a vector with the elements of 'v'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct-subtract! -->
+<pre class="indented">
+<em class=def id="vctsubtract">vct-subtract!</em> v1 v2
+<em class=def id="fvsubtract">float-vector-subtract!</em> v1 v2
+</pre>
-<!-- vector->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vectortovct">vector->vct</a> vect</code>
-</td></tr><tr><td></td><td>
-vector->vct returns a vct with elements of vector 'vect'.
-</td></tr>
+<p>float-vector-subtract! performs an element-wise subtract: v1[i] -= v2[i]. It returns 'v1'.
+</p>
+<div class="spacer"></div>
-</table>
-<br>
-<p>Many of the functions described below can take a vct as an argument;
-there are also several functions that create and fill vcts with data:</p>
-<pre>
- <a href="#regiontovct">region->vct</a> region samples to vct
- <a href="#transformtovct">transform->vct</a> fft data to vct
- <a href="#channeltovct">channel->vct</a> channel samples to vct
- <a href="sndscm.html#mixtovct">mix->vct</a> mix samples to vct
- <a href="#sounddatatovct">sound-data->vct</a> sound-data samples to vct
- <a href="#vectortovct">vector->vct</a> vector data to vct (assumed to be floats)
- <a href="#selection2vct">selection->vct</a> selected samples to vct
- <a href="sndscm.html#filetovct">file->vct</a> file data to vct
- <a href="sndscm.html#frametovct">frame->vct</a> frame data to vct
- <a href="sndscm.html#vcttoframe">vct->frame</a> vct data to frame
-</pre>
-
-<p>We could combine some of these vct functions to implement Horner's rule
-(the <a href="sndclm.html#polynomial">polynomial</a> generator) over an entire
-channel:
-</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define (vct-polynomial v coeffs)
- (let* ((v-len (<em class=red>length</em> v))
- (num-coeffs (<em class=red>length</em> coeffs))
- (new-v (<em class=red>make-vct</em> v-len (coeffs (- num-coeffs 1)))))
- (do ((i (- num-coeffs 2) (- i 1)))
- ((< i 0))
- (<em class=red>vct-offset!</em> (<em class=red>vct-multiply!</em> new-v v) (coeffs i)))
- new-v))
-
-(define* (channel-polynomial coeffs snd chn)
- (let ((len (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd chn)))
- (<em class=red>vct->channel</em> (vct-polynomial (<em class=red>channel->vct</em> 0 len snd chn) coeffs) 0 len snd chn)))
-
-;;; (channel-polynomial (<em class=red>vct</em> 0.0 .5)) = x*.5
-;;; (channel-polynomial (<em class=red>vct</em> 0.0 1.0 1.0 1.0)) = x*x*x + x*x + x
-</pre></td></tr></table>
-
-<p>There is one slightly
-unusual function in this family: vct-map!.
-This is a do-loop (or for-each) over a vct, calling some
-function to get the values to assign into the vct. For example</p>
-<pre>
- (<a class=quiet href="#vctmap" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctmap_tip)">vct-map!</a> out-data (lambda ()
- (<a class=quiet href="sndclm.html#convolve" onmouseout="UnTip()" onmouseover="Tip(sndclm_convolve_tip)">convolve</a> cnv (lambda (dir)
- (<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> sf)))))
+<!-- vct-subseq -->
+<pre class="indented">
+<em class=def id="vctsubseq">vct-subseq</em> v start (end len) nv
+<em class=def id="fvsubseq">float-vector-subseq</em> v start (end len) nv
</pre>
-<p>in the cnvtest function in <a href="sndscm.html#exampdoc">examp.scm</a> is calling the convolve generator and
-assigning the result to each successive member of the out-data vct.
-</p>
-<p>In some cases (s7, Ruby) it's possible to access a vct's
-elements with the syntax <code>(v index)</code>, equivalent to <code>(<a class=quiet href="#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> v index)</code>.
-In Ruby, vcts partake in the Enumerable and Comparable classes, and have a variety of
-additional methods: map, each, <=>, etc. See vct.c and the Ruby documentation for a complete list.
+<p>float-vector-subseq returns a new float-vector (or 'nv' if given) with the elements of 'v' between 'start' and 'end' inclusive. 'end' defaults
+to the end of 'v'.
</p>
-<pre>
- :<em class=typing>v1</em>
- <em class=listener>#<vct[len=10]: 0.100 0.100 0.100 3.000 0.100 0.100 0.100 0.100 0.100 0.100></em>
- :<em class=typing>v1.find_all {|x| x > 1.0 }</em>
- <em class=listener>[3.0, 4.0]</em>
- :<em class=typing>v1.max</em>
- <em class=listener>4.0</em>
- :<em class=typing>v2 = make_vct(10, 0.1)</em>
- <em class=listener>#<vct[len=10]: 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100></em>
- :<em class=typing>v2 < v1</em>
- <em class=listener>true</em>
+<div class="spacer"></div>
+
+
+<!-- vct+ -->
+<pre class="indented">
+<em class=def id="vctplus">vct+</em> obj1 obj2
+<em class=def id="fvplus">float-vector+</em> obj1 obj2
</pre>
-<br><br>
+<p>float-vector+ combines float-vector-add! and float-vector-offset!,
+depending on the type of its arguments.
+</p>
+<div class="spacer"></div>
-<!-- INDEX sndsounddata:sound-data -->
-<table width="50%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h3><A NAME="sndsounddata">Sound-data</a></h3></td></tr></table>
+<!-- vct* -->
+<pre class="indented">
+<em class=def id="vcttimes">vct*</em> obj1 obj2
+<em class=def id="fvtimes">float-vector*</em> obj1 obj2
+</pre>
-<p>Another Snd object containing sound samples is the sound-data object; it can be viewed either as an array of vcts,
-each vct representing one channel's data, or as an array of frames, each frame holding a sample from
-each channel at that position in the sound. <a href="sndscm.html#framedoc">frame.scm</a> has a number of useful functions that use
-sound-data objects.
-As with vcts, sound-data objects partake in the Enumerable and Comparable
-classes in Ruby.
+<p>float-vector* combines float-vector-multiply! and float-vector-scale!,
+depending on the type of its arguments.
</p>
+<div class="spacer"></div>
-<!-- -------------------------------- SOUND-DATA TABLE -------------------------------- -->
-
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
-<!-- make-sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="makesounddata">make-sound-data</a> chans frames</code>
-</td></tr><tr><td width=30><br></td><td>
-make-sound-data returns a new sound-data object with 'chans' arrays, each with 'frames' elements.
-<pre>
- :<em class=typing>(make-sound-data 2 5)</em>
- <em class=listener>#<sound-data[chans=2, length=5]:
- (0.000 0.000 0.000 0.000 0.000)
- (0.000 0.000 0.000 0.000 0.000)></em>
+<!-- vct->channel -->
+<pre class="indented">
+<em class=def id="vcttochannel">vct->channel</em> v (beg 0) dur snd chn edpos origin
+<em class=def id="fvtochannel">float-vector->channel</em> v (beg 0) dur snd chn edpos origin
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector->channel sets the samples from 'beg' to 'beg' + 'dur' from the values in 'v'.
+This changes (edits) the channel, so 'origin' provides a way to name the edit (for the edit history list and whatnot).
+</p>
+<div class="spacer"></div>
-<!-- sound-data-add! -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounddataadd">sound-data-add!</a> sd1 sd2</code>
-</td></tr><tr><td><br></td><td>
-sound-data-add! adds the contents of sd2 into sd1 and returns sd1.
-<pre>
- :<em class=typing>(define sd1 (make-sound-data 2 5))</em>
- <em class=listener>#<unspecified></em>
- :<em class=typing>(do ((chn 0 (+ 1 chn))) ((= chn 2))
- (do ((i 0 (+ 1 i))) ((= i 5))
- (sound-data-set! sd1 chn i (+ i (* 5 chn)))))</em>
- <em class=listener>#<unspecified></em>
- :<em class=typing>sd1</em>
- <em class=listener>#<sound-data[chans=2, length=5]:
- (0.000 1.000 2.000 3.000 4.000)
- (5.000 6.000 7.000 8.000 9.000)></em>
- :<em class=typing>(sound-data-add! (sound-data-fill! (make-sound-data 2 5) .25) sd1)</em>
- <em class=listener>#<sound-data[chans=2, length=5]:
- (0.250 1.250 2.250 3.250 4.250)
- (5.250 6.250 7.250 8.250 9.250)></em>
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-chans -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddatachans">sound-data-chans</a> sd</code>
-</td></tr><tr><td></td><td>
-sound-data-chans returns the number of channels in sd.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-copy -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounddatacopy">sound-data-copy</a> sd</code>
-</td></tr><tr><td></td><td>
-sound-data-copy returns a copy of the sound-data object sd.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-fill! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddatafill">sound-data-fill!</a> sd value</code>
-</td></tr><tr><td></td><td>
-sound-data-fill! sets each element of sound-data object sd to 'value'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddatalength">sound-data-length</a> sd</code>
-</td></tr><tr><td></td><td>
-sound-data-length returns the length (in samples) of each channel in the sound-data-object sd.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-maxamp -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddatamaxamp">sound-data-maxamp</a> sd</code>
-</td></tr><tr><td></td><td>
-sound-data-maxamp returns a list of maxamps (one for each channel) of the data in sd.
-<pre>
- :<em class=typing>sd1</em>
- <em class=listener>#<sound-data[chans=2, length=5]:
- (0.000 1.000 2.000 3.000 4.000)
- (5.000 6.000 7.000 8.000 9.000)></em>
- :<em class=typing>(sound-data-maxamp sd1)</em>
- <em class=listener>(4.0 9.0)</em>
- :<em class=typing>(sound-data-peak sd1)</em>
- <em class=listener>9.0</em>
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-multiply! -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounddatamultiply">sound-data-multiply!</a> sd1 sd2</code>
-</td></tr><tr><td></td><td>
-sound-data-multiply! multiplies each element of sd2 by the corresponding element of sd2 and returns sd1.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-offset! -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounddataoffset">sound-data-offset!</a> sd off</code>
-</td></tr><tr><td></td><td>
-sound-data-offset! adds the number 'off' to each element of sd and returns sd.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-peak -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounddatapeak">sound-data-peak</a> sd</code>
-</td></tr><tr><td></td><td>
-sound-data-peak returns the overall maximum element in sd.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-ref -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddataref">sound-data-ref</a> sd chan frame</code>
-</td></tr><tr><td></td><td>
-sound-data-ref returns (as a float) the sample in channel chan at location frame. In s7 you can omit the "sound-data-ref":
-<pre>
- <em class=listener>></em><em class=typing>(let ((sd (make-sound-data 1 1))) (sd 0 0))</em>
- <em class=listener>0.0</em>
+
+<!-- vct->list -->
+<pre class="indented">
+<em class=def id="vcttolist">vct->list</em> v
+<em class=def id="fvtolist">float-vector->list</em> v
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>float-vector->list returns a list with elements of 'v'.
+</p>
+<div class="spacer"></div>
-<!-- sound-data-reverse! -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounddatareverse">sound-data-reverse!</a> sd</code>
-</td></tr><tr><td></td><td>
-sound-data-reverse! reverses the elements of each channel of sd and returns sd.
-<pre>
- :<em class=typing>sd1</em>
- <em class=listener>#<sound-data[chans=2, length=5]:
- (0.000 1.000 2.000 3.000 4.000)
- (5.000 6.000 7.000 8.000 9.000)></em>
- :<em class=typing>(sound-data-reverse! sd1)</em>
- <em class=listener>#<sound-data[chans=2, length=5]:
- (4.000 3.000 2.000 1.000 0.000)
- (9.000 8.000 7.000 6.000 5.000)></em>
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-scale! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddatascale">sound-data-scale!</a> sd scaler</code>
-</td></tr><tr><td></td><td>
-sound-data-scale! multiplies each sample in sd by scaler.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data-set! -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddataset">sound-data-set!</a> sd chan frame val</code>
-</td></tr><tr><td></td><td>
-sound-data-set! sets sd's sample at 'frame' in channel 'chan' to val.
-In s7 you can use generalized set:
-<pre>
- <em class=listener>></em><em class=typing>(let ((sd (make-sound-data 1 1))) (set! (sd 0 0) 1.0) (sd 0 0))</em>
- <em class=listener>1.0</em>
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct->string -->
+<pre class="indented">
+<em class=def id="vcttostring">vct->string</em> v
+<em class=def id="fvtostring">float-vector->string</em> v
+</pre>
+<p>float-vector->string returns a string describing 'v'.
+</p>
+<div class="spacer"></div>
-<!-- sound-data+ -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounddata+">sound-data+</a> val1 val2</code>
-</td></tr><tr><td></td><td>
-sound-data+ adds val1 to val2 (either or both can be sound-data objects).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vct->vector -->
+<pre class="indented">
+<em class=def id="vcttovector">vct->vector</em> v
+</pre>
-<!-- sound-data* -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounddata*">sound-data*</a> val1 val2</code>
-</td></tr><tr><td></td><td>
-sound-data* multiplies val1 by val2 (either or both can be sound-data objects).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>vct->vector returns a vector with the elements of 'v'.
+</p>
+<div class="spacer"></div>
-<!-- sound-data? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddata?">sound-data?</a> obj</code>
-</td></tr><tr><td></td><td>
-sound-data? returns #t if obj is a sound-data object.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- vector->vct -->
+<pre class="indented">
+<em class=def id="vectortovct">vector->vct</em> vect
+</pre>
+<p>vector->vct returns a vct with elements of vector 'vect'.
+</p>
+<div class="spacer"></div>
-<!-- sound-data->sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddatatosounddata">sound-data->sound-data</a> sd-in sd-out beg dur cycle</code>
-</td></tr><tr><td></td><td>
-sound-data->sound-data copies sound-data sd-in's
-data from 0 for dur frames into sound-data sd-out starting at beg, wrapping around if sd-out's end is reached.
-This is an experimental function currently used in the oscilloscope (oscope.scm).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>
+In Ruby, vcts partake in the Enumerable and Comparable classes, and have a variety of
+additional methods: map, each, <=>, etc. See vct.c and the Ruby documentation for a complete list.
+</p>
-<!-- sound-data->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="sounddatatovct">sound-data->vct</a> sd <em class=narg>chan v</em></code>
-</td></tr><tr><td></td><td>
-sound-data->vct copies sound-data sd's channel 'chan' data into vct v.
-<pre>
- :<em class=typing>sd1</em>
- <em class=listener>#<sound-data[chans=2, length=5]:
- (4.000 3.000 2.000 1.000 0.000)
- (9.000 8.000 7.000 6.000 5.000)></em>
- :<em class=typing>(sound-data->vct sd1 1)</em>
- <em class=listener>#<vct[len=5]: 9.000 8.000 7.000 6.000 5.000></em>
+<pre class="indented">
+:v1
+#<vct[len=10]: 0.100 0.100 0.100 3.000 0.100 0.100 0.100 0.100 0.100 0.100>
+:v1.find_all {|x| x > 1.0 }
+[3.0, 4.0]
+:v1.max
+4.0
+:v2 = make_vct(10, 0.1)
+#<vct[len=10]: 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100>
+:v2 < v1
+true
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-<!-- vct->sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="vcttosounddata">vct->sound-data</a> v <em class=narg>sd chan</em></code>
-</td></tr><tr><td></td><td>
-vct->sound-data copies vct v's data into sound-data sd's channel chan.
-</td></tr>
-</table>
-<br>
-<table width="50%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h3><A NAME="extsndlib">Sndlib</a></h3></td></tr></table>
+<div class="header" id="extsndlib">Sndlib</div>
<p>All of the underlying sound library (<a href="sndlib.html">Sndlib</a>)
functions are available, as well as most of CLM (<a href="sndclm.html">sndclm.html</a>).
-For many eamples, see play.scm and rtio.scm. The most important Sndlib functions for Snd are:
+See play.scm. Much of the mus-audio interface is changing. In particular, I'm removing the
+input side of the audio code.
+The most important Sndlib functions for Snd are:
</p>
-<!-- -------------------------------- SNDLIB TABLE -------------------------------- -->
+<!-- SNDLIB TABLE -->
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
+<div class="spacer"></div>
<!-- mus-alsa-buffers -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musalsabuffers">mus-alsa-buffers</a></code>
-</td></tr><tr><td width=30><br></td><td>
-mus-alsa-buffers is the number of buffers ("periods") used in ALSA; you can also use the environment variable MUS_ALSA_BUFFERS.
+<pre class="indented">
+<em class=def id="musalsabuffers">mus-alsa-buffers</em>
+</pre>
+
+<p>mus-alsa-buffers is the number of buffers ("periods") used in ALSA; you can also use the environment variable MUS_ALSA_BUFFERS.
The default setting is 3.
These ALSA variables only matter if you built Snd with the configure switch --with-alsa.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-alsa-buffer-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musalsabuffersize">mus-alsa-buffer-size</a></code>
-</td></tr><tr><td><br></td><td>
-mus-alsa-buffer-size is the buffer size used in ALSA. You can also use the environment variable MUS_ALSA_BUFFER_SIZE.
+<pre class="indented">
+<em class=def id="musalsabuffersize">mus-alsa-buffer-size</em>
+</pre>
+
+<p>mus-alsa-buffer-size is the buffer size used in ALSA. You can also use the environment variable MUS_ALSA_BUFFER_SIZE.
The defaut setting is 1024.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-alsa-device -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musalsadevice">mus-alsa-device</a></code>
-</td></tr><tr><td><br></td><td>
-This is the ALSA audio device; it defaults to "default".
+<pre class="indented">
+<em class=def id="musalsadevice">mus-alsa-device</em>
+</pre>
+
+<p>This is the ALSA audio device; it defaults to "default".
The matching environment variable is MUS_ALSA_DEVICE. If the ALSA "default" device can't be found, we also look
for "plughw:0" and "hw:0". The "0" is apparently a card number or something. On my machine where the internal
sound card is worse than useless, I have an EMI 2|6 connected to a USB port. Its ALSA name seems to be "hw:1"
on a good day.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-alsa-capture-device -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musalsacapturedevice">mus-alsa-capture-device</a></code>
-</td></tr><tr><td><br></td><td>
-This is the ALSA capture (audio recording) device. The matching environment variable is MUS_ALSA_CAPTURE_DEVICE.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- mus-alsa-playback-device -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musalsaplaybackdevice">mus-alsa-playback-device</a></code>
-</td></tr><tr><td><br></td><td>
-This is the ALSA audio playback device. The matching environment variable is MUS_ALSA_PLAYBACK_DEVICE.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- mus-alsa-squelch-warning -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musalsasquelchwarning">mus-alsa-squelch-warning</a></code>
-</td></tr><tr><td><br></td><td>
-Set mus-alsa-squelch-warning to #t to squelch warnings from ALSA about srate mismatches.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- mus-audio-close -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musaudioclose">mus-audio-close</a> line</code>
-</td></tr><tr><td><br></td><td>
-mus-audio-close closes the audio port 'line' ('line' comes from either <a href="#musaudioopeninput">mus-audio-open-input</a>
-or <a href="#musaudioopenoutput">mus-audio-open-output</a>).
-
-<table border=0 cellpadding=5 vspace=10><tr><td>
-<pre>
-(let* ((audio-fd (<a class=quiet href="#musaudioopenoutput" onmouseout="UnTip()" onmouseover="Tip(extsnd_musaudioopenoutput_tip)">mus-audio-open-output</a> mus-audio-default 22050 1 <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_muslshort_tip)">mus-lshort</a> 1024))
- ;; open DAC at srate 22050, 1 channel, 1024 bytes per buffer
- (osc (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 440.0)) ; make a sine wave at 440 Hz
- (data (<a class=quiet href="#makesounddata" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesounddata_tip)">make-sound-data</a> 1 512))) ; output buffer (1 chan, 512 samples)
- (do ((beg 0 (+ beg 512))) ; fill a buffer at a time
- ((> beg 22050)) ; stop playing after 1 second
- (do ((i 0 (+ 1 i))) ; write each sample of the sinusoid
- ((= i 512)) ; until this buffer is full
- (<a class=quiet href="#sounddataset" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounddataset_tip)">sound-data-set!</a> data 0 i (* .1 (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc)))) ; .1 amp
- (<a class=quiet href="#musaudiowrite" onmouseout="UnTip()" onmouseover="Tip(extsnd_musaudiowrite_tip)">mus-audio-write</a> audio-fd data 512)) ; send a buffer to the DAC
- (<em class=red>mus-audio-close</em> audio-fd)) ; close the DAC
+<pre class="indented">
+<em class=def id="musalsacapturedevice">mus-alsa-capture-device</em>
</pre>
-</td></tr></table></td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This is the ALSA capture device. The matching environment variable is MUS_ALSA_CAPTURE_DEVICE.
+</p>
+<div class="spacer"></div>
-<!-- mus-audio-describe -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musaudiodescribe">mus-audio-describe</a></code>
-</td></tr><tr><td></td><td>
-mus-audio-describe returns a string describing the current audio hardware state.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- mus-alsa-playback-device -->
+<pre class="indented">
+<em class=def id="musalsaplaybackdevice">mus-alsa-playback-device</em>
+</pre>
-<!-- mus-audio-open-input -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musaudioopeninput">mus-audio-open-input</a> device srate chans format bufsize</code>
-</td></tr><tr><td></td><td>
-mus-audio-open-input opens the audio input (recording) port 'device'. It returns -1 if the open failed.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This is the ALSA audio playback device. The matching environment variable is MUS_ALSA_PLAYBACK_DEVICE.
+</p>
+<div class="spacer"></div>
-<!-- mus-audio-open-output -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musaudioopenoutput">mus-audio-open-output</a> device srate chans format bufsize</code>
-</td></tr><tr><td></td><td>
-mus-audio-open-output opens the audio output (playback) port 'device'. It returns -1 if the open failed.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- mus-alsa-squelch-warning -->
+<pre class="indented">
+<em class=def id="musalsasquelchwarning">mus-alsa-squelch-warning</em>
+</pre>
+<p>Set mus-alsa-squelch-warning to #t to squelch warnings from ALSA about srate mismatches.
+</p>
+<div class="spacer"></div>
-<!-- mus-audio-read -->
-<tr><td colspan=2 height=16><code><a class=def name="musaudioread">mus-audio-read</a> line sd frames</code>
-</td></tr><tr><td></td><td>
-mus-audio-read reads 'frames' frames of data into the sound-data object 'sd' from the audio input port 'line'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- mus-bytes-per-sample -->
+<pre class="indented">
+<em class=def id="musbytespersample">mus-bytes-per-sample</em> sample-type
+</pre>
-<!-- mus-audio-write -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musaudiowrite">mus-audio-write</a> line sd frames (start 0)</code>
-</td></tr><tr><td></td><td>
-<p>mus-audio-write writes 'frames' frames of data from the sound-data object 'sd' to the audio output port 'line'.
-If 'start' is given, it sets where to start reading in the sound-data buffers.
+<p>mus-bytes-per-sample returns the number of bytes that 'sample-type' uses to encode one sample of sound.
</p>
-<pre>
-(let ((sd (make-sound-data 1 44100)))
- (with-sound (:output sd)
- (fm-violin 0 1 440 .1)
- (fm-violin .5 .1 660 .1))
- (let* ((audio-fd (mus-audio-open-output mus-audio-default 44100 1 mus-lfloat (* 4 1024))))
- (do ((i 0 (+ i 1024)))
- ((>= i 44100))
- (mus-audio-write audio-fd sd 1024 i))
- (mus-audio-close audio-fd)))
+<pre class="indented">
+> (mus-bytes-per-sample mus-bdouble)
+8
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
-<!-- mus-bytes-per-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musbytespersample">mus-bytes-per-sample</a> data-format</code>
-</td></tr><tr><td></td><td>
-mus-bytes-per-sample returns the number of bytes that 'data-format' uses to encode one sample of sound.
-<pre>
- :<em class=typing>(mus-bytes-per-sample mus-bdouble)</em>
- <em class=listener>8</em>
+<!-- mus-clipping -->
+<pre class="indented">
+<em class=def id="musclipping">mus-clipping</em>
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- mus-clipping -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musclipping">mus-clipping</a></code>
-</td></tr><tr><td></td><td>
-mus-clipping is the default low-level clipping choice while accessing sound data.
+<p>mus-clipping is the default low-level clipping choice while accessing sound data.
Its default is #f which makes clipping very obvious (it will cause wrap-around).
If you're using the standard Snd file accessors, you probably want to use <a href="#clipping">clipping</a>, not this function.
This function refers to <a href="#mussoundopenoutput">mus-sound-open-output</a> and friends; the file-local version
is <a href="#musfileclipping">mus-file-clipping</a> — surely we could make this more confusing!
See also <a href="#cliphook">clip-hook</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- mus-data-format-name -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musdataformatname">mus-data-format-name</a> format</code>
-</td></tr><tr><td></td><td>
-mus-data-format-name converts 'format' from an integer to an explanatory string, e.g. "16-bit big endian linear".
-The sndlib data formats are:</td></tr>
-<tr><td></td><td>
-<pre>
- mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte
- mus-lfloat mus-bint mus-lint mus-b24int mus-l24int
- mus-ubshort mus-ulshort mus-ubyte mus-bfloat mus-bdouble
- mus-ldouble mus-unknown
-</pre>
-There are also "unscaled" versions of the floating point types, and "normalized" versions of the integers.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
-<!-- mus-data-format->string -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musdataformattostring">mus-data-format->string</a> format</code>
-</td></tr><tr><td></td><td>
-mus-data-format->string converts 'format' from an integer to a string, e.g. "mus-mulaw".
-<pre>
- :<em class=typing>(mus-data-format->string mus-bdouble)</em>
- <em class=listener>"mus-bdouble"</em>
+<!-- mus-error-type->string -->
+<pre class="indented">
+<em class=def id="muserrortypetostring">mus-error-type->string</em> error
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- mus-error-type->string -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="muserrortypetostring">mus-error-type->string</a> error</code>
-</td></tr><tr><td></td><td>
-mus-error-type->string returns a brief string description of 'error'
+<p>mus-error-type->string returns a brief string description of 'error'
(a mus-error return type). This is only useful in <a href="#muserrorhook">mus-error-hook</a>, and it's not very useful even there.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-expand-filename -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musexpandfilename">mus-expand-filename</a> name</code>
-</td></tr><tr><td></td><td>
-mus-expand-filename fills out the filename 'name' to include its 'absolute' pathname;
+<pre class="indented">
+<em class=def id="musexpandfilename">mus-expand-filename</em> name
+</pre>
+
+<p>mus-expand-filename fills out the filename 'name' to include its 'absolute' pathname;
that is, it replaces '~' with the current home directory,
and whatever else seems appropriate.
-<pre>
- :<em class=typing>(mus-expand-filename "oboe.snd")</em>
- <em class=listener>"/home/bil/cl/oboe.snd"</em>
+</p>
+
+<pre class="indented">
+> (mus-expand-filename "oboe.snd")
+"/home/bil/cl/oboe.snd"
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mus-file-clipping -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musfileclipping">mus-file-clipping</a> fd</code>
-</td></tr><tr><td></td><td>
-This is the clipping choice for the file referred to by 'fd'
+<pre class="indented">
+<em class=def id="musfileclipping">mus-file-clipping</em> fd
+</pre>
+
+<p>This is the clipping choice for the file referred to by 'fd'
(a file identifier as returned by <a href="#mussoundopeninput">mus-sound-open-input</a>).
The default is #f which makes clipping very obvious (it will cause wrap-around).
See also <a href="#cliphook">clip-hook</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- mus-file-prescaler -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musfileprescaler">mus-file-prescaler</a> fd</code>
-</td></tr><tr><td></td><td>
-This is the prescaling value for reading data from the sndlib file descriptor 'fd'.
-If you're reading float data that is extremely soft (i.e. peak amplitude
-below .001), the transfer to integer form in sndlib (if you're using an integer internal sample format) can cause bits
-to be lost, resulting in hiss. In this case set the prescaler for
-the file to 1000.0 or so to get the data into a more normal
-range. Since mus-file-prescaler must be set after opening
-the sound file, but before trying to read any data, you need to use it in the context of <a href="#duringopenhook">during-open-hook</a>.
-The default prescaler value is <a href="#musprescaler">mus-prescaler</a>, normally 1.0.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-header-raw-defaults -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musheaderrawdefaults">mus-header-raw-defaults</a></code>
-</td></tr><tr><td></td><td>
-mus-header-raw-defaults returns a list: '(srate chans data-format), the current raw header defaults. These can be
+<pre class="indented">
+<em class=def id="musheaderrawdefaults">mus-header-raw-defaults</em>
+</pre>
+
+<p>mus-header-raw-defaults returns a list: '(srate chans sample-type), the current raw header defaults. These can be
set:
-<pre>
- (set! (<em class=red>mus-header-raw-defaults</em>) (list 22050 4 mus-lint))
+</p>
+
+<pre class="indented">
+(set! (<em class=red>mus-header-raw-defaults</em>) (list 22050 4 mus-lint))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mus-header-type-name -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musheadertypename">mus-header-type-name</a> type</code>
-</td></tr><tr><td></td><td>
-mus-header-type-name converts 'type', an integer, to a string, e.g. "AIFF". Some of the sndlib header types are:
-</td></tr>
-<tr><td></td><td><pre>
+<pre class="indented">
+<em class=def id="musheadertypename">mus-header-type-name</em> type
+</pre>
+
+<p>mus-header-type-name converts 'type', an integer, to a string, e.g. "AIFF". Some of the sndlib header types are:
+</p>
- mus-next mus-aifc mus-riff mus-rf64 mus-nist mus-raw mus-ircam mus-aiff mus-caff
- mus-bicsf mus-soundfont mus-voc mus-svx mus-unsupported
+<pre class="indented">
+mus-next mus-aifc mus-riff mus-rf64 mus-nist mus-raw mus-ircam mus-aiff mus-caff
+mus-bicsf mus-soundfont mus-voc mus-svx mus-unsupported
</pre>
-This function doesn't set the header choices for output of recording; it just decodes a sndlib header type identifier.
-<pre>
- :<em class=typing>(mus-header-type-name (mus-sound-header-type "oboe.snd"))</em>
- <em class=listener>"Sun/Next"</em>
+
+<p>This function just decodes a sndlib header type identifier.
+</p>
+
+<pre class="indented">
+> (mus-header-type-name (mus-sound-header-type "oboe.snd"))
+"Sun/Next"
</pre>
-The default sound output header choice is <a href="#defaultoutputheadertype">default-output-header-type</a>,
+
+<p>The default sound output header choice is <a href="#defaultoutputheadertype">default-output-header-type</a>,
a sound file's
header type is <a href="#mussoundheadertype">mus-sound-header-type</a>, the CLM (<a href="sndscm.html#wsdoc">with-sound</a>) header default
is *clm-header-type*, and an opened sound's header type is <a href="#headertype">header-type</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
+</p>
+<div class="spacer"></div>
<!-- mus-header-type->string -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musheadertypetostring">mus-header-type->string</a> type</code>
-</td></tr><tr><td></td><td>
-mus-header-type->string converts 'type', an integer, to a string, e.g. "mus-aifc".
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="musheadertypetostring">mus-header-type->string</em> type
+</pre>
+
+<p>mus-header-type->string converts 'type', an integer, to a string, e.g. "mus-aifc".
+</p>
+<div class="spacer"></div>
<!-- mus-oss-set-buffers -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musosssetbuffers">mus-oss-set-buffers</a> num size</code>
-</td></tr><tr><td></td><td>
-In Linux (OSS), this sets the number and size of the OSS fragments.
+<pre class="indented">
+<em class=def id="musosssetbuffers">mus-oss-set-buffers</em> num size
+</pre>
+
+<p>In Linux (OSS), this sets the number and size of the OSS fragments.
The default (as of 21-May-01) is to accept whatever OSS chooses: I believe this is normally
-equivalent to <code>(mus-oss-set-buffers 16 12)</code>. This default makes the control panel controls very sluggish.
-Snd used to call <code>(mus-oss-set-buffers 4 12)</code> as its default,
+equivalent to (mus-oss-set-buffers 16 12). This default makes the control panel controls very sluggish.
+Snd used to call (mus-oss-set-buffers 4 12) as its default,
but this seems to cause trouble for a variety of new sound cards.
-My initialization file includes <code>(mus-oss-set-buffers 2 12)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+My initialization file includes (mus-oss-set-buffers 2 12).
+</p>
+<div class="spacer"></div>
+
+
+<!-- mus-sample-type-name -->
+<pre class="indented">
+<em class=def id="mussampletypename">mus-sample-type-name</em> format
+</pre>
+
+<p>mus-sample-type-name converts 'format' from an integer to an explanatory string, e.g. "16-bit big endian linear".
+</p>
+
+<pre class="indented">
+mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte
+mus-lfloat mus-bint mus-lint mus-b24int mus-l24int
+mus-ubshort mus-ulshort mus-ubyte mus-bfloat mus-bdouble
+mus-ldouble mus-unknown
+</pre>
+
+<p>There are also "unscaled" versions of the floating point types, and "normalized" versions of the integers.
+</p>
+<div class="spacer"></div>
+
+<!-- mus-sample-type->string -->
+<pre class="indented">
+<em class=def id="mussampletypetostring">mus-sample-type->string</em> format
+</pre>
-<!-- mus-prescaler -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="musprescaler">mus-prescaler</a></code>
-</td></tr><tr><td></td><td>
-mus-prescaler is the global default prescaling value for reading data from a file (see <a href="#musfileprescaler">mus-file-prescaler</a>).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>mus-sample-type->string converts 'format' from an integer to a string, e.g. "mus-mulaw".
+</p>
+
+<pre class="indented">
+> (mus-sample-type->string mus-bdouble)
+"mus-bdouble"
+</pre>
+<div class="spacer"></div>
<!-- mus-sound-chans -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundchans">mus-sound-chans</a> filename</code>
-</td></tr><tr><td></td><td>
-This is the number of channels in 'filename'. This value can be set (as can the others like it mentioned below);
+<pre class="indented">
+<em class=def id="mussoundchans">mus-sound-chans</em> filename
+</pre>
+
+<p>This is the number of channels in 'filename'. This value can be set (as can the others like it mentioned below);
the assignment refers to the table of sound file data maintained by sndlib. The file itself is not touched, but any
subsequent reference to it in Snd will assume the new value. In the mus-sound-chans case, say we have a sound file
whose header claims it has 43 channels, but we know it only has 2:
-<pre>
- (set! (<em class=red>mus-sound-chans</em> "43chans.snd") 2)
+</p>
+
+<pre class="indented">
+(set! (<em class=red>mus-sound-chans</em> "43chans.snd") 2)
</pre>
-tells Snd that it has 2 channels no matter what the header says.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>tells Snd that it has 2 channels no matter what the header says.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-close-input -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundcloseinput">mus-sound-close-input</a> fd</code>
-</td></tr><tr><td></td><td>
-This closes the sound file referred to by 'fd'; 'fd' is an integer returned by <a href="#mussoundopeninput">mus-sound-open-input</a>.
+<pre class="indented">
+<em class=def id="mussoundcloseinput">mus-sound-close-input</em> fd
+</pre>
+
+<p>This closes the sound file referred to by 'fd'; 'fd' is an integer returned by <a href="#mussoundopeninput">mus-sound-open-input</a>.
These mus-sound-* file functions refer to a direct path to read and write sound files. Any such operation is beneath the
notice, so to speak, of Snd.
-This function reads the first 32 samples of a file, returning the 30th in channel 0:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define read-sample-30
- (lambda (file)
- (let* ((fd (<a class=quiet href="#mussoundopeninput" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundopeninput_tip)">>mus-sound-open-input</a> file))
- (<a class=quiet href="#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a> (channels file))
- (data (<a class=quiet href="#makesounddata" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesounddata_tip)">make-sound-data</a> chans 32)))
- (<a class=quiet href="#mussoundread" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundread_tip)">mus-sound-read</a> fd 0 31 chans data)
- (let ((val (<a class=quiet href="#sounddataref" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounddataref_tip)">sound-data-ref</a> data 0 29)))
- (<em class=red>mus-sound-close-input</em> fd)
- val))))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-sound-close-output -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundcloseoutput">mus-sound-close-output</a> fd bytes</code>
-</td></tr><tr><td></td><td>
-This function closes the sound file 'fd', and updates its length indication, if any to be 'bytes' bytes.
-If you didn't specify a data-format to <a href="#mussoundopenoutput">mus-sound-open-output</a>,
-it defaulted to <code>mus-out-format</code>.
-<code>mus-out-format</code> can
+<pre class="indented">
+<em class=def id="mussoundcloseoutput">mus-sound-close-output</em> fd bytes
+</pre>
+
+<p>This function closes the sound file 'fd', and updates its length indication, if any to be 'bytes' bytes.
+If you didn't specify a sample-type to <a href="#mussoundopenoutput">mus-sound-open-output</a>,
+it defaulted to mus-out-format.
+mus-out-format can
currently be either ints, floats, or doubles, depending on how you've configured Snd, so it's safest
-to use <code>(<a href="#musbytespersample">mus-bytes-per-sample</a> mus-out-format)</code>
+to use (<a href="#musbytespersample">mus-bytes-per-sample</a> mus-out-format)
for the number of bytes per sample.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-sound-comment -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundcomment">mus-sound-comment</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-comment returns the comment in the header of the file 'filename'.
-<pre>
- :<em class=typing>(with-sound (:comment "this is a comment") (fm-violin 0 1 440 .1))</em>
- <em class=listener>"test.snd"</em>
- :<em class=typing>(mus-sound-comment "test.snd")</em>
- <em class=listener>"this is a comment"</em>
+<pre class="indented">
+<em class=def id="mussoundcomment">mus-sound-comment</em> filename
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>mus-sound-comment returns the comment in the header of the file 'filename'.
+</p>
-<!-- mus-sound-data-format -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussounddataformat">mus-sound-data-format</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-data-format returns the data format (e.g. <code>mus-bshort</code>) of the file 'filename'.
-<pre>
- :<em class=typing>(mus-data-format->string (mus-sound-data-format "oboe.snd"))</em>
- <em class=listener>"mus-bshort"</em>
+<pre class="indented">
+> (with-sound (:comment "this is a comment") (fm-violin 0 1 440 .1))
+"test.snd"
+> (mus-sound-comment "test.snd")
+"this is a comment"
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mus-sound-data-location -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussounddatalocation">mus-sound-data-location</a> filename</code>
-</td></tr><tr><td></td><td>
-This is the location in bytes of the first sample in the file 'filename'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussounddatalocation">mus-sound-data-location</em> filename
+</pre>
+
+<p>This is the location in bytes of the first sample in the file 'filename'.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-datum-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussounddatumsize">mus-sound-datum-size</a> filename</code>
-</td></tr><tr><td></td><td>
-This returns the size in bytes of each sample in 'filename'.
-It is equivalent to <code>(mus-bytes-per-sample (mus-sound-data-format filename))</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussounddatumsize">mus-sound-datum-size</em> filename
+</pre>
+
+<p>This returns the size in bytes of each sample in 'filename'.
+It is equivalent to (mus-bytes-per-sample (mus-sound-sample-type filename)).
+</p>
+<div class="spacer"></div>
<!-- mus-sound-duration -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundduration">mus-sound-duration</a> filename</code>
-</td></tr><tr><td></td><td>
-This returns the duration in seconds of the sound data in the file 'filename'.
-<pre>
- :<em class=typing>(mus-sound-duration "oboe.snd")</em>
- <em class=listener>2.30512475967407</em>
+<pre class="indented">
+<em class=def id="mussoundduration">mus-sound-duration</em> filename
+</pre>
+
+<p>This returns the duration in seconds of the sound data in the file 'filename'.
+</p>
+
+<pre class="indented">
+> (mus-sound-duration "oboe.snd")
+2.30512475967407
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mus-sound-forget -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundforget">mus-sound-forget</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-forget removes the file 'filename' from the sndlib sound cache.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundforget">mus-sound-forget</em> filename
+</pre>
+
+<p>mus-sound-forget removes the file 'filename' from the sndlib sound cache.
+</p>
+<div class="spacer"></div>
+
+<!-- mus-sound-framples -->
+<pre class="indented">
+<em class=def id="mussoundframples">mus-sound-framples</em> filename
+</pre>
-<!-- mus-sound-frames -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundframes">mus-sound-frames</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-frames returns the number of frames of sound data in the file 'filename' according to its header
+<p>mus-sound-framples returns the number of framples of sound data in the file 'filename' according to its header
(this number is occasionally incorrect in mus-next headers).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-sound-header-type -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundheadertype">mus-sound-header-type</a> filename</code>
-</td></tr><tr><td></td><td>
-This returns the header type (e.g. <code>mus-aifc</code>) of the file 'filename'.
-<pre>
- :<em class=typing>(mus-header-type->string (mus-sound-header-type "oboe.snd"))</em>
- <em class=listener>"mus-next"</em>
+<pre class="indented">
+<em class=def id="mussoundheadertype">mus-sound-header-type</em> filename
+</pre>
+
+<p>This returns the header type (e.g. mus-aifc) of the file 'filename'.
+</p>
+
+<pre class="indented">
+> (mus-header-type->string (mus-sound-header-type "oboe.snd"))
+"mus-next"
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mus-sound-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundlength">mus-sound-length</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-length returns the number of bytes of sound data in the file 'filename'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundlength">mus-sound-length</em> filename
+</pre>
+
+<p>mus-sound-length returns the number of bytes of sound data in the file 'filename'.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-loop-info -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundloopinfo">mus-sound-loop-info</a> filename</code>
-</td></tr><tr><td></td><td>
-This function refers to the "loop" info that is sometimes found in some headers (aifc, wav etc).
+<pre class="indented">
+<em class=def id="mussoundloopinfo">mus-sound-loop-info</em> filename
+</pre>
+
+<p>This function refers to the "loop" info that is sometimes found in some headers (aifc, wav etc).
<a href="sndscm.html#markloops">mark-loops</a> in examp.scm uses mus-sound-loop-info to place a mark at each loop point.
-<pre>
- :<em class=typing>(mus-sound-loop-info "~/sf1/forest.aiff")</em>
- <em class=listener>(24981 144332 0 0 60 0 1 0)</em>
+</p>
+
+<pre class="indented">
+> (mus-sound-loop-info "~/sf1/forest.aiff")
+(24981 144332 0 0 60 0 1 0)
</pre>
-The loop info is a list of
+
+<p>The loop info is a list of
up to 4 points, the first two (start, end = 24981 144332 above) refer to the sustain loop,
and the second two (0 0 above) refer to the release.
The 5th and 6th list entries are the base note and detune values (60 0 above).
For historical reasons, the 7th and 8th entries are the sustain and release modes (1 0 above).
The <a href="sndclm.html#table-lookup">looper</a> instrument uses this function to implement a sort of "freeze" function.
See also <a href="#soundloopinfo">sound-loop-info</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-sound-mark-info -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundmarkinfo">mus-sound-mark-info</a> filename</code>
-</td></tr><tr><td></td><td>
-This function refers to the "mark" info that is sometimes found in aifc and aiff headers.
+<pre class="indented">
+<em class=def id="mussoundmarkinfo">mus-sound-mark-info</em> filename
+</pre>
+
+<p>This function refers to the "mark" info that is sometimes found in aifc and aiff headers.
It returns a list of lists (or an empty list if there are no marks),
each inner list being (mark-id mark-position). The mark-id is a number that identifies it for
use with mus-sound-loop-info, and the mark-position is its sample number in the file.
Normally, this information is already included in the mus-sound-loop-info list:
-<pre>
- :<em class=typing>(mus-sound-mark-info "/home/bil/sf1/forest.aiff")</em>
- <em class=listener>((4 1) (3 0) (2 144332) (1 24981))</em>
- :<em class=typing>(mus-sound-loop-info "/home/bil/sf1/forest.aiff")</em>
- <em class=listener>(24981 144332 0 0 60 0 1 0)</em>
+</p>
+
+<pre class="indented">
+> (mus-sound-mark-info "/home/bil/sf1/forest.aiff")
+((4 1) (3 0) (2 144332) (1 24981))
+> (mus-sound-loop-info "/home/bil/sf1/forest.aiff")
+(24981 144332 0 0 60 0 1 0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mus-sound-maxamp -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundmaxamp">mus-sound-maxamp</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-maxamp returns a list of max amps and locations thereof. The corresponding set!
+<pre class="indented">
+<em class=def id="mussoundmaxamp">mus-sound-maxamp</em> filename
+</pre>
+
+<p>mus-sound-maxamp returns a list of max amps and locations thereof. The corresponding set!
affects only the sndlib table of sound file info, not the sound file itself, as in all such cases.
-<pre>
- :<em class=typing>(mus-sound-maxamp "oboe.snd")</em>
- <em class=listener>(24971 0.147247314453125)</em>
- ;; oboe's maxamp is .147 first encountered at sample 24971
- :<em class=typing>(mus-sound-maxamp "2a.snd")</em>
- <em class=listener>(933 0.0999755859375 2827 0.0999755859375)</em>
- ;; 2a's maxamps are 0.1 in each channel at sample 933 in chan 0, 2827 in chan 1
+</p>
+
+<pre class="indented">
+> (mus-sound-maxamp "oboe.snd")
+(24971 0.147247314453125)
+;; oboe's maxamp is .147 first encountered at sample 24971
+> (mus-sound-maxamp "2a.snd")
+(933 0.0999755859375 2827 0.0999755859375)
+;; 2a's maxamps are 0.1 in each channel at sample 933 in chan 0, 2827 in chan 1
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mus-sound-maxamp-exists? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundmaxampexists">mus-sound-maxamp-exists?</a> filename</code>
-</td></tr><tr><td></td><td>
-This function returns #t if the sound's maxamp data is available
+<pre class="indented">
+<em class=def id="mussoundmaxampexists">mus-sound-maxamp-exists?</em> filename
+</pre>
+
+<p>This function returns #t if the sound's maxamp data is available
in the sound cache; if it isn't, a call on mus-sound-maxamp has to open and read the data to get the maxamp.
-<pre>
- :<em class=typing>(mus-sound-maxamp-exists? "/home/bil/test/sound/away.snd")</em>
- <em class=listener>#f</em>
- :<em class=typing>(mus-sound-maxamp "/home/bil/test/sound/away.snd")</em>
- <em class=listener>(14562264 0.463623046875 14557044 0.404571533203125)</em>
- :<em class=typing>(mus-sound-maxamp-exists? "/home/bil/test/sound/away.snd")</em>
- <em class=listener>#t</em>
+</p>
+
+<pre class="indented">
+> (mus-sound-maxamp-exists? "/home/bil/test/sound/away.snd")
+#f
+> (mus-sound-maxamp "/home/bil/test/sound/away.snd")
+(14562264 0.463623046875 14557044 0.404571533203125)
+> (mus-sound-maxamp-exists? "/home/bil/test/sound/away.snd")
+#t
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mus-sound-open-input -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundopeninput">mus-sound-open-input</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-open-input opens the sound file 'filename' and returns an integer for use with
+<pre class="indented">
+<em class=def id="mussoundopeninput">mus-sound-open-input</em> filename
+</pre>
+
+<p>mus-sound-open-input opens the sound file 'filename' and returns an integer for use with
<a href="#mussoundread">mus-sound-read</a> and <a href="#mussoundcloseinput">mus-sound-close-input</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mus-sound-open-output -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundopenoutput">mus-sound-open-output</a> filename <em class=narg>(srate 44100) (chans 1) data-format header-type comment</em></code>
-</td></tr><tr><td></td><td>
-mus-sound-open-output creates a new sound file with the indicated attributes, and returns an integer
+<pre class="indented">
+<em class=def id="mussoundopenoutput">mus-sound-open-output</em> filename (srate 44100) (chans 1) sample-type header-type comment
+</pre>
+
+<p>mus-sound-open-output creates a new sound file with the indicated attributes, and returns an integer
for use with <a href="#mussoundwrite">mus-sound-write</a> and <a href="#mussoundcloseoutput">mus-sound-close-output</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
+
+<!-- mus-sound-preload -->
+<pre class="indented">
+<em class=def id="mussoundpreload">mus-sound-preload</em> filename
+</pre>
+
+<p>mus-sound-preload loads a sound file into memory, and uses that copy of it thereafter. If the sound data is
+stored in some odd format, and you use that file a lot, this can save some time.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-prune -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundprune">mus-sound-prune</a></code>
-</td></tr><tr><td></td><td>
-mus-sound-prune removes all defunct (non-existent) files from the sound cache. This is primarily intended for internal testing (snd-test.scm).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundprune">mus-sound-prune</em>
+</pre>
+
+<p>mus-sound-prune removes all defunct (non-existent) files from the sound cache. This is primarily intended for internal testing (snd-test.scm).
+</p>
+<div class="spacer"></div>
<!-- mus-sound-read -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundread">mus-sound-read</a> fd beg end chans sd</code>
-</td></tr><tr><td></td><td>
-mus-sound-read reads data from the sound file 'fd', loading the sound-data object 'sd' from 'beg'
-to 'end'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundread">mus-sound-read</em> fd beg-in-file num-to-read chans sd
+</pre>
+
+<p>mus-sound-read reads data from the sound file 'fd', starting at frample 'beg-in-file' (frample 0 is the first),
+loading num-to-read samples into the float-vector 'sd' starting from 0 in that vector.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-reopen-output -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundreopenoutput">mus-sound-reopen-output</a> filename <em class=narg>(chans 1) data-format header-type data-location</em></code>
-</td></tr><tr><td></td><td>
-mus-sound-reopen-output reopens the sound file 'filename', ready to continue writing output.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundreopenoutput">mus-sound-reopen-output</em> filename (chans 1) sample-type header-type data-location
+</pre>
+
+<p>mus-sound-reopen-output reopens the sound file 'filename', ready to continue writing output.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-report-cache -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundreportcache">mus-sound-report-cache</a> file</code>
-</td></tr><tr><td></td><td>
-This function prints the current sound header data table to the file given or stdout if none is specified.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundreportcache">mus-sound-report-cache</em> file
+</pre>
+
+<p>This function prints the current sound header data table to the file given or stdout if none is specified.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-samples -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundsamples">mus-sound-samples</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-samples returns the number of samples in the sound file 'filename' according to its header.
-<pre>
- :<em class=typing>(mus-sound-samples "oboe.snd")</em>
- <em class=listener>50828</em>
+<pre class="indented">
+<em class=def id="mussoundsamples">mus-sound-samples</em> filename
+</pre>
+
+<p>mus-sound-samples returns the number of samples in the sound file 'filename' according to its header.
+</p>
+
+<pre class="indented">
+> (mus-sound-samples "oboe.snd")
+50828
+</pre>
+<div class="spacer"></div>
+
+
+<!-- mus-sound-sample-type -->
+<pre class="indented">
+<em class=def id="mussoundsampletype">mus-sound-sample-type</em> filename
+</pre>
+
+<p>mus-sound-sample-type returns the sample type (e.g. mus-bshort) of the file 'filename'.
+</p>
+
+<pre class="indented">
+> (mus-sample-type->string (mus-sound-sample-type "oboe.snd"))
+"mus-bshort"
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
+
+<!-- mus-sound-seek-frample -->
+<pre class="indented">
+<em class=def id="mussoundseekframple">mus-sound-seek-frample</em> fd frample
+</pre>
-<!-- mus-sound-seek-frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundseekframe">mus-sound-seek-frame</a> fd frame</code>
-</td></tr><tr><td></td><td>
-mus-sound-seek-frame moves the input or output reading point to 'frame' in the sound file 'fd'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>mus-sound-seek-frample moves the input or output reading point to 'frample' in the sound file 'fd'.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-srate -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundsrate">mus-sound-srate</a> filename</code>
-</td></tr><tr><td></td><td>
-mus-sound-srate returns the sampling rate of 'filename'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundsrate">mus-sound-srate</em> filename
+</pre>
+
+<p>mus-sound-srate returns the sampling rate of 'filename'.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-type-specifier -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundtypespecifier">mus-sound-type-specifier</a> filename</code>
-</td></tr><tr><td></td><td>
-This is the original type indication of 'filename'. This is only useful in internal testing.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundtypespecifier">mus-sound-type-specifier</em> filename
+</pre>
+
+<p>This is the original type indication of 'filename'. This is only useful in internal testing.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-write -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundwrite">mus-sound-write</a> fd beg end chans sd</code>
-</td></tr><tr><td></td><td>
-mus-sound-write writes data from the sound-data object 'sd' to the sound file 'fd'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mussoundwrite">mus-sound-write</em> fd beg end chans sd
+</pre>
+
+<p>mus-sound-write writes data from the float-vector 'sd' to the sound file 'fd'.
+</p>
+<div class="spacer"></div>
<!-- mus-sound-write-date -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mussoundwritedate">mus-sound-write-date</a> filename</code>
-</td></tr><tr><td></td><td>
-This returns the sound's write date:
-</td></tr><tr><td></td><td>
-<pre>
- :<em class=typing>(strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "oboe.snd")))</em>
- <em class=listener>"18-Oct 06:56 PDT"</em>
+<pre class="indented">
+<em class=def id="mussoundwritedate">mus-sound-write-date</em> filename
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-</table>
+<p>This returns the sound's write date:
+</p>
+
+<pre class="indented">
+> (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "oboe.snd")))
+"18-Oct 06:56 PDT"
+</pre>
+<div class="spacer"></div>
+
<p>See <a href="sndlib.html">Sndlib</a> for more information on these functions. When called from Snd, these
throw 'mus-error upon encountering an error, rather than returning -1 like the underlying sndlib functions.
</p>
-<p>The following function uses the sndlib functions to mimic the 'info' popup menu option (see <a href="sndscm.html#exampdoc">examp.scm</a> for a version that uses format):</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-<A NAME="sndinfo"></a>(define info
+<p id="sndinfo">The following function uses the sndlib functions to mimic the 'info' popup menu option
+(see <a href="sndscm.html#exampdoc">examp.scm</a> for a version that uses format):
+</p>
+
+<pre class="indented">
+(define info
(lambda (file)
(string-append
file
": chans: " (number->string (channels file))
", srate: " (number->string (srate file))
- ", " (<a class=quiet href="#musheadertypename" onmouseout="UnTip()" onmouseover="Tip(extsnd_musheadertypename_tip)">mus-header-type-name</a> (<a class=quiet href="#mussoundheadertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundheadertype_tip)">mus-sound-header-type</a> file))
- ", " (<a class=quiet href="#musdataformatname" onmouseout="UnTip()" onmouseover="Tip(extsnd_musdataformatname_tip)">mus-data-format-name</a> (<a class=quiet href="#mussounddataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussounddataformat_tip)">mus-sound-data-format</a> file))
+ ", " (<a class=quiet href="#musheadertypename">mus-header-type-name</a> (<a class=quiet href="#mussoundheadertype">mus-sound-header-type</a> file))
+ ", " (<a class=quiet href="#mussampletypename">mus-sample-type-name</a> (<a class=quiet href="#mussoundsampletype">mus-sound-sample-type</a> file))
", len: " (number->string
- (/ (<a class=quiet href="#mussoundsamples" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundsamples_tip)">mus-sound-samples</a> file)
+ (/ (<a class=quiet href="#mussoundsamples">mus-sound-samples</a> file)
(* (channels file) (srate file)))))))
-</pre></td></tr></table>
-<br>
-<br>
-<br>
-<table width="50%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h3><A NAME="sndmarks">Marks</a></h3></td></tr></table>
+</pre>
+
+
+
-<A NAME="markstuff"></a>
+<div class="header" id="sndmarks">Marks</div>
-<p>A mark is an object that refers to a particular sample.
-Each mark has an associated sample number (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a>),
-name (<a class=quiet href="#markname" onmouseout="UnTip()" onmouseover="Tip(extsnd_markname_tip)">mark-name</a>), and sync value (<a class=quiet href="#marksync" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksync_tip)">mark-sync</a>).
+<p id="markstuff">A mark is an object that refers to a particular sample.
+Each mark has an associated sample number (<a class=quiet href="#marksample">mark-sample</a>),
+name (<a class=quiet href="#markname">mark-name</a>), and sync value (<a class=quiet href="#marksync">mark-sync</a>).
See <a href="snd.html#marks">Marks</a> in snd.html
for an overview and key bindings associated with marks.
See also the <a href="#sndhooks">hooks</a> section above for various mark-related hooks.
</p>
-<!-- -------------------------------- MARKS TABLE -------------------------------- -->
+<!-- MARKS TABLE -->
+<div class="spacer"></div>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
-
<!-- add-mark -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="addmark">add-mark</a> <em class=narg>sample snd chn name sync</em></code>
-</td></tr><tr><td width=30><br></td><td>
-add-mark adds a mark at the position 'sample', returning the new mark.
-<pre>
- :<em class=typing>(define m1 (add-mark 1234))</em>
- <em class=listener>m1</em>
- :<em class=typing>m1</em>
- <em class=listener>#<mark 0></em>
- :<em class=typing>(mark-sample m1)</em>
- <em class=listener>1234</em>
-</pre>
-The mark-name can be set via 'name', and the mark-sync field via 'sync'.
+<pre class="indented">
+<em class=def id="addmark">add-mark</em> sample snd chn name sync
+</pre>
+
+<p>add-mark adds a mark at the position 'sample', returning the new mark.
+</p>
+
+<pre class="indented">
+> (define m1 (add-mark 1234))
+m1
+> m1
+#<mark 0>
+> (mark-sample m1)
+1234
+</pre>
+
+<p>The mark-name can be set via 'name', and the mark-sync field via 'sync'.
If 'sample' is beyond the end of the data, add-mark throws 'no-such-sample.
There is also the form add-mark! which returns #f if the sample number is beyond the current last sample,
rather than throwing the 'no-such-sample error.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- delete-mark -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="deletemark">delete-mark</a> mark</code>
-</td></tr><tr><td></td><td>
-delete-mark deletes the mark. Mark additions and deletions follow the
+<pre class="indented">
+<em class=def id="deletemark">delete-mark</em> mark
+</pre>
+
+<p>delete-mark deletes the mark. Mark additions and deletions follow the
edit list, so if the deleted mark was present in an earlier edit, and you undo to that point,
the mark comes back to life.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- delete-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="deletemarks">delete-marks</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This function deletes all marks in the given channel. It could be defined in Scheme as:
-<pre>
- (for-each
- (lambda (m)
- (delete-mark m))
- (<a class=quiet href="#emarks" onmouseout="UnTip()" onmouseover="Tip(extsnd_emarks_tip)">marks</a> (or snd (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>)) (or chn (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>))))
+<pre class="indented">
+<em class=def id="deletemarks">delete-marks</em> snd chn
+</pre>
+
+<p>This function deletes all marks in the given channel. It could be defined in Scheme as:
+</p>
+
+<pre class="indented">
+(for-each delete-mark (<a class=quiet href="#emarks">marks</a> (or snd (<a class=quiet href="#selectedsound">selected-sound</a>)) (or chn (<a class=quiet href="#selectedchannel">selected-channel</a>))))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- find-mark -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="findmark">find-mark</a> samp <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-find-mark returns the mark at sample 'samp' or #f if none is found.
+<pre class="indented">
+<em class=def id="findmark">find-mark</em> samp snd chn edpos
+</pre>
+
+<p>find-mark returns the mark at sample 'samp' or #f if none is found.
If 'samp' is a string, rather than an integer, find-mark
looks for a mark of that name. <a href="sndscm.html#marknametoid">mark-name->id</a>
in marks.scm finds a named mark in any channel (a global version of find-mark).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- integer->mark -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="integertomark">integer->mark</a> i</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="integertomark">integer->mark</em> i
+</pre>
+
<p>In olden times, a mark was handled in Snd code as an integer; nowadays, it's an object.
Originally I said, "this function, and its companion <a href="#marktointeger">mark->integer</a>, exist mainly to convert
old code to the current style", but that was premature. The mark-as-integer approach was handy
@@ -4648,185 +4804,229 @@ make it possible to treat marks in the various generic functions, but that meant
that if you forget to save the mark object in some handy variable,
you end up typing "integer->mark" over and over.
One way out is to define
-a #-reader that sees something like "#m12" and expands that into <code>(integer->mark 12)</code>:
+a #-reader that sees something like "#m12" and expands that into (integer->mark 12):
</p>
-<pre>
-> <em class=typing>(set! <a href="s7.html#sharpreaders">*#readers*</a>
+
+<pre class="indented">
+> (set! <a href="s7.html#sharpreaders">*#readers*</a>
(cons (cons #\m (lambda (str)
(integer->mark (string->number (substring str 1)))))
- *#readers*))</em>
-<em class=listener>((#\m . #<closure>))</em>
-> <em class=typing>#m1</em>
-<em class=listener>#<mark 1></em>
-> <em class=typing>(mark-sample #m1)</em>
-<em class=listener>38694</em>
+ *#readers*))
+((#\m . #<lambda (str)>))
+> #m1
+#<mark 1>
+> (mark-sample #m1)
+38694
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mark->integer -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="marktointeger">mark->integer</a> mark</code>
-</td></tr><tr><td></td><td>
-This is the counterpart to <a href="#integertomark">integer->mark</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="marktointeger">mark->integer</em> mark
+</pre>
+
+<p>This is the counterpart to <a href="#integertomark">integer->mark</a>.
+</p>
+<div class="spacer"></div>
+
+<pre class="indented">
+<em class=emdef><a href="#markcolor">mark-color</a></em>
+</pre>
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><em class=emdef><a href="#markcolor">mark-color</a></em></code>
-</td></tr><tr><td></td><td>
-This sets the color of mark indicator; the default is red.
+<p>This sets the color of mark indicator; the default is red.
<a href="sndscm.html#marksynccolor">mark-sync-color</a> uses mark-color to
display all sync'd marks with some distinctive color.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><em class=emdef><a href="#markcontext">mark-context</a></em></code>
-</td></tr><tr><td></td><td>
-This is the graphics context to use to draw a mark (XOR mode).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef><a href="#markcontext">mark-context</a></em>
+</pre>
+
+<p>This is the graphics context to use to draw a mark (XOR mode).
+</p>
+<div class="spacer"></div>
<!-- mark-home -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="markhome">mark-home</a> mark</code>
-</td></tr><tr><td></td><td>
-mark-home is a list with the sound and channel that hold the mark.
-<pre>
- :<em class=typing>(marks 0 0)</em> ; what marks are in snd 0, chn 0?
- <em class=listener>(#<mark 0>)</em> ; just one
- :<em class=typing>(mark-home (car (marks 0 0)))</em> ; what is that mark's snd/chn?
- <em class=listener>(#<sound 0> 0)</em>
+<pre class="indented">
+<em class=def id="markhome">mark-home</em> mark
+</pre>
+
+<p>mark-home is a list with the sound and channel that hold the mark.
+</p>
+
+<pre class="indented">
+> (marks 0 0) ; what marks are in snd 0, chn 0?
+(#<mark 0>) ; just one
+> (mark-home (car (marks 0 0))) ; what is that mark's snd/chn?
+(#<sound 0> 0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mark-name -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="markname">mark-name</a> mark</code>
-</td></tr><tr><td></td><td>
-This is the name of the mark.
-<pre>
- :<em class=typing>(define m1 (add-mark 1234 0 0 "a name"))</em>
- <em class=listener>m1</em>
- :<em class=typing>(mark-name m1)</em>
- <em class=listener>"a name"</em>
- :<em class=typing>(set! (mark-name m1) "a new name")</em>
- <em class=listener>"a new name"</em>
- :<em class=typing>(mark-name m1)</em>
- <em class=listener>"a new name"</em>
+<pre class="indented">
+<em class=def id="markname">mark-name</em> mark
+</pre>
+
+<p>This is the name of the mark.
+</p>
+
+<pre class="indented">
+> (define m1 (add-mark 1234 0 0 "a name"))
+m1
+> (mark-name m1)
+"a name"
+> (set! (mark-name m1) "a new name")
+"a new name"
+> (mark-name m1)
+"a new name"
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mark-properties -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="markproperties">mark-properties</a> mark</code>
-</td></tr><tr><td></td><td>
-mark-properties is a property list associated with a mark.
+<pre class="indented">
+<em class=def id="markproperties">mark-properties</em> mark
+</pre>
+
+<p>mark-properties is a property list associated with a mark.
<a href="#markproperty">mark-property</a> reads and writes this list.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mark-property -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="markproperty">mark-property</a> key mark</code>
-</td></tr><tr><td></td><td>
-mark-property accesses the property 'key' in the property list associated with the mark.
-<pre>
- :<em class=typing>(set! (mark-property :weight m0) 2.5)</em> ; m0 is the mark
- <em class=listener>2.5</em>
- :<em class=typing>(mark-property :weight m0)</em>
- <em class=listener>2.5</em>
+<pre class="indented">
+<em class=def id="markproperty">mark-property</em> key mark
+</pre>
+
+<p>mark-property accesses the property 'key' in the property list associated with the mark.
+</p>
+
+<pre class="indented">
+> (set! (mark-property :weight m0) 2.5) ; m0 is the mark
+2.5
+> (mark-property :weight m0)
+2.5
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mark-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="marksample">mark-sample</a> mark <em class=narg>edpos</em></code>
-</td></tr><tr><td></td><td>
-mark-sample is the sample number (a location) marked by the mark at edit history position 'edpos'.
-<pre>
- :<em class=typing>(mark-sample m1)</em>
- <em class=listener>1234</em>
- :<em class=typing>(set! (mark-sample m1) 4321)</em>
- <em class=listener>4321</em>
- :<em class=typing>(mark-sample m1)</em>
- <em class=listener>4321</em>
-</pre>
-It might be more consistent with other Snd names to call this mark-position, but I wanted to emphasize
+<pre class="indented">
+<em class=def id="marksample">mark-sample</em> mark edpos
+</pre>
+
+<p>mark-sample is the sample number (a location) marked by the mark at edit history position 'edpos'.
+</p>
+
+<pre class="indented">
+> (mark-sample m1)
+1234
+> (set! (mark-sample m1) 4321)
+4321
+> (mark-sample m1)
+4321
+</pre>
+
+<p>It might be more consistent with other Snd names to call this mark-position, but I wanted to emphasize
that a mark follows its sample around as a sound is edited; that is, it marks a sample, not a position in the sound.
Say we have three named marks in a speech excerpt (see below), then delete the initial spoken word ("now");
each mark backs up with the deletion so that it
continues to point to its original sample:
-<br>
-
-<img src="pix/mark1.png" align=left vspace=20 hspace=20 alt="marks" onmouseout="UnTip()" onmouseover="Tip('This is a recording of a man saying "now the same piece is played".<br>The three marks are set at the start of three of the words.<br>To play from a mark, click the red triangle at the bottom.<br>To reposition a mark, drag the upper rectangle.')">
+</p>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<img class="indented" src="pix/mark1.png" alt="marks">
+<div class="spacer"></div>
<!-- mark-sync -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="marksync">mark-sync</a> mark</code>
-</td></tr><tr><td></td><td>
-This is the
+<pre class="indented">
+<em class=def id="marksync">mark-sync</em> mark
+</pre>
+
+<p>This is the
mark's sync field (the default is 0).
The sync value
provides a way to group marks for simultaneous
changes. Marks that share the same sync value (if not 0), move together when any one of them is
dragged, play together if clicked, etc. To find which marks share a given
sync value, use <a href="#syncdmarks">syncd-marks</a>; to find an unused sync value use <a href="#marksyncmax">mark-sync-max</a>.
-<br><br>
-Marks that are syncd together can be used for insertions, and deletions, and can
-set arbitrary groups of play points. But it's a bit tedious to type <code>(set! (mark-sync ...)...)</code>
+</p>
+
+<p>Marks that are syncd together can be used for insertions, and deletions, and can
+set arbitrary groups of play points. But it's a bit tedious to type (set! (mark-sync ...)...)
for each of the marks you want in the group. The following code example uses the <a href="#markclickhook">mark-click-hook</a>
-instead; you type <code>(start-sync)</code>, then click each of the marks that you want grouped together, then <code>(stop-sync)</code>.
+instead; you type (start-sync), then click each of the marks that you want grouped together, then (stop-sync).
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define mark-sync-number 0)
-(define (start-sync) (set! mark-sync-number (+ (<a class=quiet href="#marksyncmax" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksyncmax_tip)">mark-sync-max</a>) 1)))
+(define (start-sync) (set! mark-sync-number (+ (<a class=quiet href="#marksyncmax">mark-sync-max</a>) 1)))
(define (stop-sync) (set! mark-sync-number 0))
(define (click-to-sync id) (set! (<em class=red>mark-sync</em> id) mark-sync-number) #f)
-(hook-push <a class=quiet href="#markclickhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_markclickhook_tip)">mark-click-hook</a> click-to-sync)
-</pre></td></tr></table>
+(hook-push <a class=quiet href="#markclickhook">mark-click-hook</a> click-to-sync)
+</pre>
-Now control-click and drag one of them, and all of them move together deleting data, or
+<p>Now control-click and drag one of them, and all of them move together deleting data, or
inserting zeros; or click the "play" triangle, and all of them play together starting from
their respective samples.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mark-sync-max -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="marksyncmax">mark-sync-max</a></code>
-</td></tr><tr><td></td><td>
-This is the maximum mark sync value seen so far.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="marksyncmax">mark-sync-max</em>
+</pre>
+
+<p>This is the maximum mark sync value seen so far.
+</p>
+<div class="spacer"></div>
<!-- mark-tag-height -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="marktagheight">mark-tag-height</a></code>
-</td></tr><tr><td></td><td>
-When a mark is drawn, it has a horizontal rectangle at the top, then a vertical line, then a triangle.
+<pre class="indented">
+<em class=def id="marktagheight">mark-tag-height</em>
+</pre>
+
+<p>When a mark is drawn, it has a horizontal rectangle at the top, then a vertical line, then a triangle.
The line marks the marked sample, the triangle can be clicked to play from the mark, and the
rectangle can be clicked or dragged. The mark-tag-height refers to the vertical thickness of that tag
in pixels; its default is 4.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mark-tag-width -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="marktagwidth">mark-tag-width</a></code>
-</td></tr><tr><td></td><td>
-This is the
+<pre class="indented">
+<em class=def id="marktagwidth">mark-tag-width</em>
+</pre>
+
+<p>This is the
mark tag width in pixels; it defaults to 10.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="emarks">marks</a> <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This function returns a list of mark ids in the given channel at the edit history position 'edpos'.
+<pre class="indented">
+<em class=def id="emarks">marks</em> snd chn edpos
+</pre>
+
+<p>This function returns a list of mark ids in the given channel at the edit history position 'edpos'.
If 'chn' and 'edpos' are omitted, a list of lists is returned,
each inner list representing a channel of 'snd'. If 'snd' is
also omitted, a list of lists of lists is returned, representing
each sound and its channels.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (how-many-marks-in-channel snd chn)
(length (<em class=red>marks</em> snd chn)))
@@ -4834,64 +5034,77 @@ each sound and its channels.
(apply + (map length (<em class=red>marks</em> snd))))
(define (how-many-marks)
- (apply + (map how-many-marks-in-sound (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
-</pre></td></tr></table>
+ (apply + (map how-many-marks-in-sound (<a class=quiet href="#sounds">sounds</a>))))
+</pre>
-If the marks function is called
+<p>If the marks function is called
without any argument, or with just a sound, it returns a list of lists; each inner list is the list
of current marks active in that channel, ordered by sample number. If the channel argument is
specified, marks returns just the list of marks. If the edit history position is given,
the list of marks reflects the marks active at that point in the edit history. See <a href="sndscm.html#describemark">describe-mark</a> in marks.scm.
-<br><br>
-Say we have two sounds open, 2 marks in the first (a mono sound), and one
-in the 2nd channel of the 2nd (a stereo sound):
-<pre>
- :<em class=typing>(marks 0 0)</em>
- <em class=listener>(#<mark 1> #<mark 0>)</em> ; these are mark id's, as returned by the add-mark function for example
- :<em class=typing>(marks 1)</em>
- <em class=listener>(() (#<mark 2>))</em> ; no mark in channel 0, one in channel 1
- :<em class=typing>(marks)</em>
- <em class=listener>(((#<mark 1> #<mark 0>)) (() (#<mark 2>)))</em>
+</p>
+
+<p>Say we have two sounds open, 2 marks in the first (a mono sound), and one
+in the second channel of the second (a stereo sound):
+</p>
+<pre class="indented">
+> (marks 0 0)
+(#<mark 1> #<mark 0>) ; these are mark id's, as returned by the add-mark function for example
+> (marks 1)
+(() (#<mark 2>)) ; no mark in channel 0, one in channel 1
+> (marks)
+(((#<mark 1> #<mark 0>)) (() (#<mark 2>)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mark? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="markp">mark?</a> obj</code>
-</td></tr><tr><td></td><td>
-mark? returns #t if 'obj' is a mark and is active (that is, if it is present in a currently open channel).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="markp">mark?</em> obj
+</pre>
+
+<p>mark? returns #t if 'obj' is a mark and is active (that is, if it is present in a currently open channel).
+</p>
+<div class="spacer"></div>
<!-- save-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="savemarks">save-marks</a> <em class=narg>snd filename</em></code>
-</td></tr><tr><td></td><td>
-save-marks saves the given sound's marks, writing a Scheme, Ruby, or Forth source file named either 'filename' or
+<pre class="indented">
+<em class=def id="savemarks">save-marks</em> snd filename
+</pre>
+
+<p>save-marks saves the given sound's marks, writing a Scheme, Ruby, or Forth source file named either 'filename' or
<sound's file-name>.marks. It returns the file name or #f if there are no marks to save.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
+<pre class="indented">
+<em class=emdef><a href="#showmarks">show-marks</a></em>
+</pre>
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><em class=emdef><a href="#showmarks">show-marks</a></em></code>
-</td></tr><tr><td></td><td>
-show-marks is #t if marks are being displayed.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>show-marks is #t if marks are being displayed.
+</p>
+<div class="spacer"></div>
<!-- syncd-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="syncdmarks">syncd-marks</a> sync</code>
-</td></tr><tr><td></td><td>
-syncd-marks returns a list of marks that share the mark-sync value 'sync'.
+<pre class="indented">
+<em class=def id="syncdmarks">syncd-marks</em> sync
+</pre>
+
+<p>syncd-marks returns a list of marks that share the mark-sync value 'sync'.
+</p>
-<table border=0 cellpadding=5><tr><td><pre>
+<pre class="indented">
(define (move-syncd-marks sync diff)
(for-each
(lambda (m)
- (set! (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> m) (+ (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> m) diff)))
+ (set! (<a class=quiet href="#marksample">mark-sample</a> m) (+ (<a class=quiet href="#marksample">mark-sample</a> m) diff)))
(<em class=red>syncd-marks</em> sync)))
-</pre></td></tr></table>
-</td></tr>
+</pre>
+<div class="spacer"></div>
-</table>
<!-- INDEX markstuff:Marking -->
<p>
@@ -4899,35 +5112,34 @@ See <a href="sndscm.html#marksdoc">marks.scm</a> for
more examples including:
</p>
-<TABLE border=3 bordercolor="tan" hspace=20><tr><td width=500>
+<TABLE class="method">
+<tr><th class="title"><a class=quiet href="extsnd.html#sndmarks">Marks</a></th></tr><tr><td>
<blockquote><small>
-<br>
-global find-mark: <a href="sndscm.html#marknametoid">mark-name->id</a><br>
+find mark in any sound: <a href="sndscm.html#marknametoid">mark-name->id</a><br>
mark history: <a href="sndscm.html#describemark">describe-mark</a><br>
synchronize marks by inserting silences: <a href="sndscm.html#syncup">syncup</a><br>
squeeze selection between marks: <a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a><br>
insert silence before marks: <a href="sndscm.html#padmarks">pad-marks</a><br>
move syncd marks: <a href="sndscm.html#movesyncdmarks">move-syncd-marks</a><br>
play starting from syncd marks: <a href="sndscm.html#playsyncdmarks">play-syncd-marks</a><br>
-evaluate function between marks: <a href="sndscm.html#evalbetweenmarks">eval-between-marks</a><br>
place marks at selection start and end: <a href="sndscm.html#snapmarks">snap-marks</a><br>
define selection via marks: <a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a><br>
force dragged mark to land on a beat: <a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a><br>
-loop continuously between the two specified marks: <a href="sndscm.html#loopbetweenmarks">loop-between-marks</a><br>
split sound into separate files based on mark placement: <a href="sndscm.html#markexplode">mark-explode</a><br>
-mark property lists: <a href="#markproperty">mark-property</a><br>
+mark property lists: <a href="extsnd.html#markproperty">mark-property</a><br>
save mark properties in saved state file: <a href="sndscm.html#savemarkproperties">save-mark-properties</a><br>
show mark properties upon click: <a href="sndscm.html#markclickinfo">mark-click-info</a><br>
-<br>
</small></blockquote>
</td></tr></TABLE>
+
<p>Other examples can be found in Dave Phillips' marks-menu.scm, snd-motif.scm (add-mark-pane),
edit-menu.scm (trim from mark, etc), examp.scm (move window to correspond to mark, looping).
</p>
-<br>
-<br>
-<table width="50%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h3><A NAME="sndmixes">Mixes</a></h3></td></tr></table>
+
+
+
+<div class="header" id="sndmixes">Mixes</div>
<p>Mixing operations have a lot of extra support built into Snd. In nearly every mixing function, you
can request a "mix tag" (or set that request globally via <a href="#withmixtags">with-mix-tags</a>).
@@ -4935,90 +5147,102 @@ If the mix operation is tagged, you can then operate on that data through a numb
the Mix Dialog, various hooks, and various mouse-related actions.
</p>
-
-<table width="35%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>Mixes</h4></td></tr></table>
-
<p>A mix is an object that represents a channel (one channel in and one channel out) of a sound mix.
Various mixing functions create these objects (mix-vct for example). In the old days, mixes were identified
by integers, so for conversion you can use mix->integer and integer->mix.
Say we have a mix object stored in the variable "id":
</p>
-<pre>
- ><em class=listener>(set! (mix-amp id) .5)</em>
- <em class=typing>.5</em>
+
+<pre class="indented">
+> (set! (mix-amp id) .5)
+.5
</pre>
+
<p>This sets the mix's amplitude scaler to .5.
</p>
-<!-- -------------------------------- MIX FUNCTION TABLE -------------------------------- -->
+<!-- MIX FUNCTION TABLE -->
+
+<div class="spacer"></div>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
<!-- integer->mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="integertomix">integer->mix</a> i</code>
-</td></tr><tr><td></td><td>
-In olden times, a mix was handled in Snd code as an integer; nowadays, it's an object.
+<pre class="indented">
+<em class=def id="integertomix">integer->mix</em> i
+</pre>
+
+<p>In olden times, a mix was handled in Snd code as an integer; nowadays, it's an object.
This function, and its companion <a href="#mixtointeger">mix->integer</a>, exist mainly to convert
old code to the current style.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix->integer -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixtointeger">mix->integer</a> mix</code>
-</td></tr><tr><td></td><td>
-This is the counterpart to <a href="#integertomix">integer->mix</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixtointeger">mix->integer</em> mix
+</pre>
+
+<p>This is the counterpart to <a href="#integertomix">integer->mix</a>.
+</p>
+<div class="spacer"></div>
<!-- mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mix">mix</a> file <em class=narg>samp in-chan snd chn with-mix-tags auto-delete</em></code>
-</td></tr><tr><td width=30></td><td>
+<pre class="indented">
+<em class=def id="mix">mix</em> file samp in-chan snd chn with-mix-tags auto-delete
+</pre>
+
<p>mix is one of the basic mixing functions.
It mixes the 'in-chan' channel of the file 'file' into the given channel
starting at 'samp' in the output channel, and returns a list with the mix.
If 'in-chan' is #t, all input channels are mixed into successive output channels, and
mix returns a list of the mixes.
</p>
+
<p>If 'with-mix-tags' is #f (the default is #t), the data is
mixed without creating any mix objects.
</p>
-<pre>
- (mix "test.snd") ; add channel 0 of test.snd to the current sound at sample 0
- (mix "test.snd" 0 #t) ; same but add all channels of test.snd into successive output channels
- (mix "test.snd" 0 1) ; add channel 1 of test.snd to channel 0 of the current sound
- (mix "test.snd" 0 0 #f 1) ; add channel 0 of test.snd to channel 1 of the current sound
- (mix "test.snd" 0 3 #f 1 #f) ; add channel 3 of test.snd to channel 1 of the current sound, without a mix tag
+<pre class="indented">
+(mix "test.snd") ; add channel 0 of test.snd to the current sound at sample 0
+(mix "test.snd" 0 #t) ; same but add all channels of test.snd into successive output channels
+(mix "test.snd" 0 1) ; add channel 1 of test.snd to channel 0 of the current sound
+(mix "test.snd" 0 0 #f 1) ; add channel 0 of test.snd to channel 1 of the current sound
+(mix "test.snd" 0 3 #f 1 #f) ; add channel 3 of test.snd to channel 1 of the current sound, without a mix tag
</pre>
<p>
The input file ('file') is not deleted by Snd unless 'auto-delete' is #t (or 1 or 3).
auto-delete can be a boolean (#f = don't delete), or and integer: 0=don't delete, 1=delete, 3=delete but keep track of multichannel inputs.
</p>
+
<p>In the next example, we mix in two sounds:
</p>
-<img src="pix/mix1.png" alt="mixes" vspace=10 onmouseout="UnTip()" onmouseover="Tip('the mix tag is the red rectangle at the left end of the mix waveform.<br>The number under it is that mix\'s id.')">
-<br>
-Now we can drag either of the red tags to move the mixed sounds, call up the View:Mixes dialog to edit them,
+<img class="indented" src="pix/mix1.png" alt="mixes">
+
+<p>Now we can drag either of the red tags to move the mixed sounds, call up the View:Mixes dialog to edit them,
or use the functions in this section. For example, we'll set the amplitude of the first and the position of
the second:
-<br>
-<img src="pix/mix2.png" alt="mixes" vspace=10>
-<br>
-We can use <a href="sndscm.html#dlocsigdoc">dlocsig</a> in conjunction with mix to move the mixed-in sound:
+</p>
+
+<img class="indented" src="pix/mix2.png" alt="mixes">
+
+<p id="mixmovesound">We can use <a href="sndscm.html#dlocsigdoc">dlocsig</a> in conjunction with mix to move the mixed-in sound:
+</p>
-<table border=0 cellpadding=5 vspace=20><tr><td><pre>
+<pre class="indented">
(if (not (provided? 'snd-dlocsig.scm)) (load-from-path "dlocsig.scm"))
(if (not (provided? 'snd-ws.scm)) (load-from-path "ws.scm"))
-(define (<a name="mixmovesound">mix-move-sound</a> start-time file path)
+(define (mix-move-sound start-time file path)
"mix file at start-time in the currently selected sound following the given dlocsig path"
- (let* ((duration (<a class=quiet href="#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> file))
- (rd (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0 file))
- (start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start-time))
- (tmp-sound (<a class=quiet href="sndscm.html#sound-let" onmouseout="UnTip()" onmouseover="Tip(sndscm_sound_let_tip)">with-temp-sound</a> (:channels (<a class=quiet href="#channels" onmouseout="UnTip()" onmouseover="Tip(extsnd_channels_tip)">channels</a>) :srate (srate file))
+ (let* ((duration (<a class=quiet href="#mussoundduration">mus-sound-duration</a> file))
+ (rd (<a class=quiet href="#makesampler">make-sampler</a> 0 file))
+ (start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> start-time))
+ (tmp-sound (<a class=quiet href="sndscm.html#sound-let">with-temp-sound</a> (:channels (<a class=quiet href="#channels">channels</a>) :srate (srate file))
;; We use with-temp-sound here rather than sound-let because mix normally expects its input file to
;; be around until it decides it doesn't need it anymore, but sound-let deletes all its temp files.
@@ -5031,108 +5255,134 @@ We can use <a href="sndscm.html#dlocsigdoc">dlocsig</a> in conjunction with mix
(dloc (car vals))
(beg (cadr vals))
(end (caddr vals)))
- (run
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
- (<em class=red>dlocsig</em> dloc i (<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> rd))))))))
+ (<em class=red>dlocsig</em> dloc i (<a class=quiet href="#readsample">read-sample</a> rd)))))))
;; now tmp-sound is the name of a temp sound file that moves 'file' in a spiral
- (<em class=red>mix</em> tmp-sound start #t #f #f (<a class=quiet href="#withmixtags" onmouseout="UnTip()" onmouseover="Tip(extsnd_withmixtags_tip)">with-mix-tags</a>) #t)))
+ (<em class=red>mix</em> tmp-sound start #t #f #f (<a class=quiet href="#withmixtags">with-mix-tags</a>) #t)))
;;; (mix-move-sound 0 "oboe.snd" (make-spiral-path :turns 3))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2></td></tr>
+</pre>
+<div class="spacer"></div>
<!-- mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixes">mixes</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-mixes returns a list of the mix objects associated with the given channel.
+<pre class="indented">
+<em class=def id="mixes">mixes</em> snd chn
+</pre>
+
+<p>mixes returns a list of the mix objects associated with the given channel.
If the channel argument is omitted, you get a list of lists, each inner list referring to a single channel of that sound.
If the sound is also omitted, you get a list of lists of lists, the outer list referring to each sound, each
inner list to that sound's channels. Say we have two sounds open, 2 mixes in the first (a mono sound), and 1 mix
-in the 2nd channel of the 2nd (a stereo sound):
-<pre>
- :<em class=typing>(mixes 0 0)</em>
- <em class=listener>(#<mix 0> #<mix 2>)</em> ; these are mix objects, as returned by the mix function for example
- :<em class=typing>(mixes 1)</em>
- <em class=listener>(() (#<mix 1>))</em> ; no mix in channel 0, one in channel 1
- :<em class=typing>(mixes)</em>
- <em class=listener>(((#<mix 0> #<mix 2>)) (() (#<mix 1>)))</em>
+in the second channel of the second (a stereo sound):
+</p>
+
+<pre class="indented">
+> (mixes 0 0)
+(#<mix 0> #<mix 2>) ; these are mix objects, as returned by the mix function for example
+> (mixes 1)
+(() (#<mix 1>)) ; no mix in channel 0, one in channel 1
+> (mixes)
+(((#<mix 0> #<mix 2>)) (() (#<mix 1>)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-amp -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixamp">mix-amp</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-amp is the amplitude scaler applied to the mix. To make mix mx half as loud:
-<pre>
- (set! (mix-amp mx) .5)
+<pre class="indented">
+<em class=def id="mixamp">mix-amp</em> mix
+</pre>
+
+<p>mix-amp is the amplitude scaler applied to the mix. To make mix mx half as loud:
+</p>
+
+<pre class="indented">
+(set! (mix-amp mx) .5)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-amp-env -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixampenv">mix-amp-env</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-amp-env is the
+<pre class="indented">
+<em class=def id="mixampenv">mix-amp-env</em> mix
+</pre>
+
+<p>mix-amp-env is the
amplitude envelope applied to the mix (a list of breakpoints).
To reset this to its default (null) state, use #f.
-<pre>
- (set! (mix-amp-env mx) '(0 0 1 1))
+</p>
+
+<pre class="indented">
+(set! (mix-amp-env mx) '(0 0 1 1))
</pre>
-sets mix mx's envelope to a ramp.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>sets mix mx's envelope to a ramp.
+</p>
+<div class="spacer"></div>
<!-- mix-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixcolor">mix-color</a> mix</code>
-</td></tr><tr><td></td><td>
-This is the color of mix waveforms; it defaults to dark-gray.
+<pre class="indented">
+<em class=def id="mixcolor">mix-color</em> mix
+</pre>
+
+<p>This is the color of mix waveforms; it defaults to dark-gray.
If you
want to set just a particular mix's color, pass the mix object
-as the 'mix' argument: <code>(set! (mix-color) red)</code> sets all mix waveforms to
-red; but <code>(set! (mix-color mx) red)</code> sets only mix mx's waveform to red.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+as the 'mix' argument: (set! (mix-color) red) sets all mix waveforms to
+red; but (set! (mix-color mx) red) sets only mix mx's waveform to red.
+</p>
+<div class="spacer"></div>
<!-- mix-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixlength">mix-length</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-length returns the mix's length in samples.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixlength">mix-length</em> mix
+</pre>
+
+<p>mix-length returns the mix's length in samples.
+</p>
+<div class="spacer"></div>
<!-- mix-home-->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixhome">mix-home</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-home returns a list containing the mix's output sound and channel number, and the input original filename (if any), and input channel.
-<pre>
- :<em class=typing>(define mx (mix "pistol.snd" 1000))</em>
- <em class=listener>#<mix 0></em>
- :<em class=typing>(mix-home mx)</em>
- <em class=listener>(#<sound 0> 0 "/home/bil/cl/pistol.snd" 0)</em>
- ;; (list output-sound-index output-channel input-filename input-channel)
- :<em class=typing>(set! mx (mix-vct (make-vct 100 .1) 2000))</em>
- <em class=listener>#<mix 1></em>
- :<em class=typing>(mix-home mx)</em>
- <em class=listener>(#<sound 0> 0 #f 0)</em>
- ;; #f: no input file
+<pre class="indented">
+<em class=def id="mixhome">mix-home</em> mix
+</pre>
+
+<p>mix-home returns a list containing the mix's output sound and channel number, and the input original filename (if any), and input channel.
+</p>
+
+<pre class="indented">
+> (define mx (mix "pistol.snd" 1000))
+#<mix 0>
+> (mix-home mx)
+(#<sound 0> 0 "/home/bil/cl/pistol.snd" 0)
+;; (list output-sound-index output-channel input-filename input-channel)
+> (set! mx (mix-vct (make-vct 100 .1) 2000))
+#<mix 1>
+> (mix-home mx)
+(#<sound 0> 0 #f 0)
+;; #f: no input file
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-name -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixname">mix-name</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-name is the mix's name, if any. The mix name is displayed near the mix tag.
+<pre class="indented">
+<em class=def id="mixname">mix-name</em> mix
+</pre>
+
+<p>mix-name is the mix's name, if any. The mix name is displayed near the mix tag.
See also <a href="sndscm.html#mixnametoid">mix-name->id</a>.
Here's an example that uses the mix name and the tag location (mix-tag-y) to provide some pitch
feedback:
+</p>
-<table border=0 cellpadding=5 vspace=5><tr><td><pre>
+<pre class="indented">
(if (not (provided? 'snd-v.scm)) (load-from-path "v.scm"))
(if (not (provided? 'snd-ws.scm)) (load-from-path "ws.scm"))
@@ -5140,34 +5390,34 @@ feedback:
(round (* 100 (- 1.0 (/ (log (/ freq lo)) (* (log 2.0) octs))))))
(let ((violin-sync 1)
- (violin-color (<a class=quiet href="#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 0 1)) ; blue
+ (violin-color (<a class=quiet href="#makecolor">make-color</a> 0 0 1)) ; blue
(cello-sync 2)
- (cello-color (<a class=quiet href="#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 1 0)) ; green
- (index (<a class=quiet href="#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "test.snd" :channels 1 :size (* 44100 22))))
+ (cello-color (<a class=quiet href="#makecolor">make-color</a> 0 1 0)) ; green
+ (index (<a class=quiet href="#newsound">new-sound</a> "test.snd" :channels 1 :size (* 44100 22))))
(define (violin beg dur freq amp)
- (let ((id (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> (<a class=quiet href="sndscm.html#withtempsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_withtempsound_tip)">with-temp-sound</a> () ; write instrument output to temp sound
- (<a class=quiet href="sndscm.html#fmviolin" onmouseout="UnTip()" onmouseover="Tip(sndscm_fmviolin_tip)">fm-violin</a> 0 dur (<a class=quiet href="sndscm.html#tofrequency" onmouseout="UnTip()" onmouseover="Tip(sndscm_tofrequency_tip)">->frequency</a> freq #t) amp)) ; our favorite FM instrument
- (<a class=quiet href="sndscm.html#tosample" onmouseout="UnTip()" onmouseover="Tip(sndscm_tosample_tip)">->sample</a> beg) 0 index 0 ; mix start, file in-chan, sound, channel
+ (let ((id (<a class=quiet href="#mix">mix</a> (<a class=quiet href="sndscm.html#withtempsound">with-temp-sound</a> () ; write instrument output to temp sound
+ (<a class=quiet href="sndscm.html#fmviolin">fm-violin</a> 0 dur (<a class=quiet href="sndscm.html#tofrequency">->frequency</a> freq #t) amp)) ; our favorite FM instrument
+ (<a class=quiet href="sndscm.html#tosample">->sample</a> beg) 0 index 0 ; mix start, file in-chan, sound, channel
#t #t))) ; mix with tag and auto-delete
(if (symbol? freq)
(set! (<em class=red>mix-name</em> id) (symbol->string freq)))
- (set! (<a class=quiet href="#mixsync" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixsync_tip)">mix-sync</a> id) violin-sync)
- (set! (<a class=quiet href="#mixcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixcolor_tip)">mix-color</a> id) violin-color)
- (set! (<a class=quiet href="#mixtagy" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixtagy_tip)">mix-tag-y</a> id) (frequency->tag-y (<a class=quiet href="sndscm.html#tofrequency" onmouseout="UnTip()" onmouseover="Tip(sndscm_tofrequency_tip)">->frequency</a> freq #t) (<a class=quiet href="sndscm.html#tofrequency" onmouseout="UnTip()" onmouseover="Tip(sndscm_tofrequency_tip)">->frequency</a> 'c2) 3))))
+ (set! (<a class=quiet href="#mixsync">mix-sync</a> id) violin-sync)
+ (set! (<a class=quiet href="#mixcolor">mix-color</a> id) violin-color)
+ (set! (<a class=quiet href="#mixtagy">mix-tag-y</a> id) (frequency->tag-y (<a class=quiet href="sndscm.html#tofrequency">->frequency</a> freq #t) (<a class=quiet href="sndscm.html#tofrequency">->frequency</a> 'c2) 3))))
(define (cello beg dur freq amp)
- (let ((id (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> (<a class=quiet href="sndscm.html#withtempsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_withtempsound_tip)">with-temp-sound</a> ()
- (<a class=quiet href="sndscm.html#fmviolin" onmouseout="UnTip()" onmouseover="Tip(sndscm_fmviolin_tip)">fm-violin</a> 0 dur (<a class=quiet href="sndscm.html#tofrequency" onmouseout="UnTip()" onmouseover="Tip(sndscm_tofrequency_tip)">->frequency</a> freq #t) amp :fm-index 1.5))
- (<a class=quiet href="sndscm.html#tosample" onmouseout="UnTip()" onmouseover="Tip(sndscm_tosample_tip)">->sample</a> beg) 0 index 0
+ (let ((id (<a class=quiet href="#mix">mix</a> (<a class=quiet href="sndscm.html#withtempsound">with-temp-sound</a> ()
+ (<a class=quiet href="sndscm.html#fmviolin">fm-violin</a> 0 dur (<a class=quiet href="sndscm.html#tofrequency">->frequency</a> freq #t) amp :fm-index 1.5))
+ (<a class=quiet href="sndscm.html#tosample">->sample</a> beg) 0 index 0
#t #t)))
(if (symbol? freq)
(set! (<em class=red>mix-name</em> id) (symbol->string freq)))
- (set! (<a class=quiet href="#mixsync" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixsync_tip)">mix-sync</a> id) cello-sync)
- (set! (<a class=quiet href="#mixcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixcolor_tip)">mix-color</a> id) cello-color)
- (set! (<a class=quiet href="#mixtagy" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixtagy_tip)">mix-tag-y</a> id) (frequency->tag-y (<a class=quiet href="sndscm.html#tofrequency" onmouseout="UnTip()" onmouseover="Tip(sndscm_tofrequency_tip)">->frequency</a> freq #t) (<a class=quiet href="sndscm.html#tofrequency" onmouseout="UnTip()" onmouseover="Tip(sndscm_tofrequency_tip)">->frequency</a> 'c2) 3))))
+ (set! (<a class=quiet href="#mixsync">mix-sync</a> id) cello-sync)
+ (set! (<a class=quiet href="#mixcolor">mix-color</a> id) cello-color)
+ (set! (<a class=quiet href="#mixtagy">mix-tag-y</a> id) (frequency->tag-y (<a class=quiet href="sndscm.html#tofrequency">->frequency</a> freq #t) (<a class=quiet href="sndscm.html#tofrequency">->frequency</a> 'c2) 3))))
- (<a class=quiet href="#asoneedit" onmouseout="UnTip()" onmouseover="Tip(extsnd_asoneedit_tip)">as-one-edit</a>
+ (<a class=quiet href="#asoneedit">as-one-edit</a>
(lambda ()
(violin 0 1 'e4 .2) (violin 1 1.5 'g4 .2) (violin 2.5 .5 'g3 .2)
(cello 0 1 'c3 .2) (cello 1 1.5 'e3 .2) (cello 2.5 .5 'g2 .2)
@@ -5180,816 +5430,994 @@ feedback:
(violin 9 3 'd4 .2)
(cello 9 3 'b2 .2))))
-</pre></td></tr></table>
-<img src="pix/mixname.png" alt="mix name example" vspace=10>
-<p>
-But note names are a bother to read; musglyphs.scm has code to display notes using CMN glyphs.
-<A NAME="waltzexample">Here</a> we use the draw-mix-hook to display our notes as a score:
+</pre>
+
+<img class="indented" src="pix/mixname.png" alt="mix name example">
+
+<p id="waltzexample">But note names are a bother to read; musglyphs.scm has code to display notes using CMN glyphs.
+Here we use the draw-mix-hook to display our notes as a score:
</p>
-<img src="pix/mixcmn.png" alt="mix CMN example" vspace=10>
+
+<img class="indented" src="pix/mixcmn.png" alt="mix CMN example">
+
<p>
In more complex cases, using a mix per note fills the screen with mix tags; it's probably cleaner
to use multiple output files, collecting related notes in one file, then mixing these at the end:
</p>
-<table border=0 cellpadding=5 vspace=5><tr><td><pre>
+
+<pre class="indented">
;; open two output files, one for the violin notes, the other for the cellos
;; then mix them into "test.snd"
-(let ((violins (<a class=quiet href="sndclm.html#make-sampletofile" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_sampletofile_tip)">make-sample->file</a> "violins.snd" 1 <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_muslfloat_tip)">mus-lfloat</a> mus-next))
- (cellos (<a class=quiet href="sndclm.html#make-sampletofile" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_sampletofile_tip)">make-sample->file</a> "cellos.snd" 1 <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_muslfloat_tip)">mus-lfloat</a> mus-next)))
+(let ((violins (<a class=quiet href="sndclm.html#make-sampletofile">make-sample->file</a> "violins.snd" 1 <a class=quiet href="#sampletype">mus-lfloat</a> mus-next))
+ (cellos (<a class=quiet href="sndclm.html#make-sampletofile">make-sample->file</a> "cellos.snd" 1 <a class=quiet href="#sampletype">mus-lfloat</a> mus-next)))
(define (violin beg dur freq amp)
- (<a class=quiet href="sndscm.html#withtempsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_withtempsound_tip)">with-temp-sound</a> (:continue-old-file #t :output "violins.snd")
- (<a class=quiet href="sndscm.html#fmviolin" onmouseout="UnTip()" onmouseover="Tip(sndscm_fmviolin_tip)">fm-violin</a> beg dur (<a class=quiet href="sndscm.html#tofrequency" onmouseout="UnTip()" onmouseover="Tip(sndscm_tofrequency_tip)">->frequency</a> freq #t) amp)))
+ (<a class=quiet href="sndscm.html#withtempsound">with-temp-sound</a> (:continue-old-file #t :output "violins.snd")
+ (<a class=quiet href="sndscm.html#fmviolin">fm-violin</a> beg dur (<a class=quiet href="sndscm.html#tofrequency">->frequency</a> freq #t) amp)))
(define (cello beg dur freq amp)
- (<a class=quiet href="sndscm.html#withtempsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_withtempsound_tip)">with-temp-sound</a> (:continue-old-file #t :output "cellos.snd")
- (<a class=quiet href="sndscm.html#fmviolin" onmouseout="UnTip()" onmouseover="Tip(sndscm_fmviolin_tip)">fm-violin</a> beg dur (<a class=quiet href="sndscm.html#tofrequency" onmouseout="UnTip()" onmouseover="Tip(sndscm_tofrequency_tip)">->frequency</a> freq #t) amp :fm-index 1.5)))
+ (<a class=quiet href="sndscm.html#withtempsound">with-temp-sound</a> (:continue-old-file #t :output "cellos.snd")
+ (<a class=quiet href="sndscm.html#fmviolin">fm-violin</a> beg dur (<a class=quiet href="sndscm.html#tofrequency">->frequency</a> freq #t) amp :fm-index 1.5)))
(violin 0 1 'e4 .2) (violin 1 1.5 'g4 .2) (violin 2.5 .5 'g3 .2)
(cello 0 1 'c3 .2) (cello 1 1.5 'e3 .2) (cello 2.5 .5 'g2 .2)
;; etc
- (let ((index (<a class=quiet href="#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "test.snd" :channels 1))) ; our overall output file
- (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "violins.snd")
- (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "cellos.snd"))
-
- (<a class=quiet href="sndclm.html#mus-close" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_close_tip)">mus-close</a> violins)
- (<a class=quiet href="sndclm.html#mus-close" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_close_tip)">mus-close</a> cellos))
-</pre></td></tr></table>
+ (<a class=quiet href="#newsound">new-sound</a> "test.snd" :channels 1) ; our overall output file
+ (<a class=quiet href="#mix">mix</a> "violins.snd")
+ (<a class=quiet href="#mix">mix</a> "cellos.snd")
+ (<a class=quiet href="sndclm.html#mus-close">mus-close</a> violins)
+ (<a class=quiet href="sndclm.html#mus-close">mus-close</a> cellos))
+</pre>
<p>See also <a href="sndscm.html#withmixedsound">with-mixed-sound</a> in ws.scm.
</p>
-</td></tr><tr><td colspan=2 height=32></td></tr>
+<div class="spacer"></div>
<!-- mix-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixposition">mix-position</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-position is the current starting position (a sample number) of 'mix'. To move mix mx so that it starts at sample 200 in the output:
-<pre>
- (set! (mix-position mx) 200)
+<pre class="indented">
+<em class=def id="mixposition">mix-position</em> mix
+</pre>
+
+<p>mix-position is the current starting position (a sample number) of 'mix'. To move mix mx so that it starts at sample 200 in the output:
+</p>
+
+<pre class="indented">
+(set! (mix-position mx) 200)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-properties -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="mixproperties">mix-properties</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-properties is a property list associated with a mix.
+<pre class="indented">
+<em class=def id="mixproperties">mix-properties</em> mix
+</pre>
+
+<p>mix-properties is a property list associated with a mix.
<a href="#mixproperty">mix-property</a> reads and writes this list.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix-property -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="mixproperty">mix-property</a> key mix</code>
-</td></tr><tr><td></td><td>
-mix-property associates a property with a mix.
-<pre>
- :<em class=typing>(set! (mix-property :info mx) "this is a mix")</em>
- <em class=listener>"this is a mix"</em>
- :<em class=typing>(mix-property :info mx)</em>
- <em class=listener>"this is a mix"</em>
+<pre class="indented">
+<em class=def id="mixproperty">mix-property</em> key mix
+</pre>
+
+<p>mix-property associates a property with a mix.
+</p>
+
+<pre class="indented">
+> (set! (mix-property :info mx) "this is a mix")
+"this is a mix"
+> (mix-property :info mx)
+"this is a mix"
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-region -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixregion">mix-region</a> samp <em class=narg>reg snd chn reg-chan</em></code>
-</td></tr><tr><td></td><td>
-mix-region mixes region 'reg's' channel 'reg-chan' into the given channel starting at sample 'samp' ('samp' defaults to the cursor sample).
+<pre class="indented">
+<em class=def id="mixregion">mix-region</em> samp reg snd chn reg-chan
+</pre>
+
+<p>mix-region mixes region 'reg's' channel 'reg-chan' into the given channel starting at sample 'samp' ('samp' defaults to the cursor sample).
It returns a list of the new mixes.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><em class=emdef>mix-selection</em> <em class=narg>beg snd chn selection-chan</em></code>
-</td></tr><tr><td></td><td>
-mix-selection mixes the current selection's channel 'selection-cha' into the given channel starting at 'beg', returning a list of the new mixes.
-The Edit:Mix selection menu choice is essentially <code>(mix-selection (cursor))</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>mix-selection</em> beg snd chn selection-chan
+</pre>
+
+<p>mix-selection mixes the current selection's channel 'selection-cha' into the given channel starting at 'beg', returning a list of the new mixes.
+The Edit:Mix selection menu choice is essentially (mix-selection (cursor)).
+</p>
+<div class="spacer"></div>
<!-- mix-speed -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixspeed">mix-speed</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-speed is the speed (resampling ratio) of 'mix'; 1.0 (the default) means no resampling takes place;
+<pre class="indented">
+<em class=def id="mixspeed">mix-speed</em> mix
+</pre>
+
+<p>mix-speed is the speed (resampling ratio) of 'mix'; 1.0 (the default) means no resampling takes place;
2.0 causes the mix data to be read twice as fast.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix-sync -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixsync">mix-sync</a> mix</code>
-</td></tr><tr><td></td><td>
-mix-sync is an integer, like <a href="#sync">sync</a> that you can use to group mixes. See <a href="sndscm.html#mixdoc">mix.scm</a>
+<pre class="indented">
+<em class=def id="mixsync">mix-sync</em> mix
+</pre>
+
+<p>mix-sync is an integer, like <a href="#sync">sync</a> that you can use to group mixes. See <a href="sndscm.html#mixdoc">mix.scm</a>
for many examples. Mix objects that share a non-zero sync value drag together, and are edited together in the mix dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix-sync-max -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixsyncmax">mix-sync-max</a></code>
-</td></tr><tr><td></td><td>
-This is the maximum mix sync value seen so far.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixsyncmax">mix-sync-max</em>
+</pre>
+
+<p>This is the maximum mix sync value seen so far.
+</p>
+<div class="spacer"></div>
<!-- mix-tag-height -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixtagheight">mix-tag-height</a></code>
-</td></tr><tr><td></td><td>
-This is the mix tag height (the vertical extent of the tag rectangle) in pixels (the default is 14).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixtagheight">mix-tag-height</em>
+</pre>
+
+<p>This is the mix tag height (the vertical extent of the tag rectangle) in pixels (the default is 14).
+</p>
+<div class="spacer"></div>
<!-- mix-tag-width -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixtagwidth">mix-tag-width</a></code>
-</td></tr><tr><td></td><td>
-This is the mix tag width in pixels (the default is 6).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixtagwidth">mix-tag-width</em>
+</pre>
+
+<p>This is the mix tag width in pixels (the default is 6).
+</p>
+<div class="spacer"></div>
<!-- mix-tag-y -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixtagy">mix-tag-y</a> mix</code>
-</td></tr><tr><td></td><td>
-This is the mix tag y (vertical) offset; 0 (the default) is the top of the graph, so
+<pre class="indented">
+<em class=def id="mixtagy">mix-tag-y</em> mix
+</pre>
+
+<p>This is the mix tag y (vertical) offset; 0 (the default) is the top of the graph, so
higher tag-y values position the tag lower in the graph. For
example, if you know the frequency of the mix sound, you can reflect that in the tag height with:
-<pre>
- (set! (mix-tag-y mix-id)
- (round (* 100 (- 1.0 (/ (log (/ freq 40.0)) (* (log 2.0) 7))))))
+</p>
+
+<pre class="indented">
+(set! (mix-tag-y mix-id) (round (* 100 (- 1.0 (/ (log (/ freq 40.0)) (* (log 2.0) 7))))))
</pre>
-See, for example, check-mix-tags in sndscm.html.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>See, for example, check-mix-tags in sndscm.html.
+</p>
+<div class="spacer"></div>
<!-- mix-vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixvct">mix-vct</a> vct <em class=narg>beg snd chn with-mix-tags origin</em></code>
-</td></tr><tr><td></td><td>
-mix-vct is one of the basic mixing functions. It
+<pre class="indented">
+<em class=def id="mixvct">mix-vct</em> vct beg snd chn with-mix-tags origin
+</pre>
+
+<p>mix-vct is one of the basic mixing functions. It
mixes the contents of 'vct' into the given channel starting at sample 'beg'.
If 'with-mix-tags' is #f (the default is #t), the data is
mixed without creating any mix tags.
mix-vct returns the id of the new mix, or -1 (a simple mix, no tag).
-<pre>
- :<em class=typing>(channel->vct 1000 3)</em> ; what are these 3 samples before the mix?
- <em class=listener>#<vct[len=3]: -0.065 -0.059 -0.060></em>
- :<em class=typing>(define mx (mix-vct (vct .1 .2 .3) 1000))</em> ; add these 3 values
- <em class=listener>#<mix 3></em>
- :<em class=typing>(channel->vct 1000 3)</em> ; now we hope they were added...
- <em class=listener>#<vct[len=3]: 0.035 0.141 0.240></em>
- :<em class=typing>(mix-position mx)</em> ; and the new mix starts at 1000
- <em class=listener>1000</em>
- :<em class=typing>(length mx)</em> ; and its length is 3 samples
- <em class=listener>3</em>
- :<em class=typing>(mix-vct (with-sound (:output (make-vct 44100)) (fm-violin 0 1 440 .1)))</em>
- <em class=listener>#<mix 4></em>
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix-waveform-height -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixwaveformheight">mix-waveform-height</a></code>
-</td></tr><tr><td></td><td>
-This is the maximum height in pixels of mix waveforms. The default is 20 (see <a href="#showmixwaveforms">show-mix-waveforms</a>).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixwaveformheight">mix-waveform-height</em>
+</pre>
+
+<p>This is the maximum height in pixels of mix waveforms. The default is 20 (see <a href="#showmixwaveforms">show-mix-waveforms</a>).
+</p>
+<div class="spacer"></div>
<!-- mix? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixp">mix?</a> obj</code>
-</td></tr><tr><td></td><td>
-mix? returns #t if 'obj' is a mix object and it is accessible in a channel's edit list.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixp">mix?</em> obj
+</pre>
+
+<p>mix? returns #t if 'obj' is a mix object and it is accessible in a channel's edit list.
+</p>
+<div class="spacer"></div>
<!-- save-mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="savemix">save-mix</a> mix filename</code>
-</td></tr><tr><td></td><td>
-save-mix saves a given mix's data in the file 'filename'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="savemix">save-mix</em> mix filename
+</pre>
+
+<p>save-mix saves a given mix's data in the file 'filename'.
+</p>
+<div class="spacer"></div>
<!-- with-mix-tags -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="withmixtags">with-mix-tags</a></code>
-</td></tr><tr><td></td><td>
-If with-mix-tags is #f (the default is #t), newly mixed data does not have a mix id or tag associated with it.
-</td></tr>
+<pre class="indented">
+<em class=def id="withmixtags">with-mix-tags</em>
+</pre>
+
+<p>If with-mix-tags is #f (the default is #t), newly mixed data does not have a mix id or tag associated with it.
+</p>
-</table>
<!-- INDEX sndmixes:Mixing -->
-<br>
-<TABLE border=3 bordercolor="tan" hspace=20><tr><td>
+
+<TABLE class="method">
+<tr><th class="title"><a class=quiet href="extsnd.html#sndmixes">Mixing</a></th></tr><tr><td>
<blockquote><small>
-<br>
-mix sound file: <a href="#mix">mix</a> or drag-and-drop it where you want it mixed<br>
+mix sound file: <a href="extsnd.html#mix">mix</a> or drag-and-drop it where you want it mixed<br>
mix channel: see <a href="sndscm.html#mixchannel">mix-channel</a> in extensions.scm<br>
-mix region: <a href="#mixregion">mix-region</a><br>
-mix selection: <a href="#mixselection">mix-selection</a><br>
-mix vct: <a href="#mixvct">mix-vct</a><br>
-mix sound-data: <a href="sndscm.html#mixsounddata">mix-sound-data</a><br>
-mix a frame: <a href="sndscm.html#mixframe">mix-frame</a><br>
+mix region: <a href="extsnd.html#mixregion">mix-region</a><br>
+mix selection: <a href="extsnd.html#mixselection">mix-selection</a><br>
+mix vct: <a href="extsnd.html#mixvct">mix-vct</a><br>
enveloped mix: see <a href="sndscm.html#envelopedmix">enveloped-mix</a> in extensions.scm<br>
-read mix samples: <a href="#makemixsampler">make-mix-sampler</a><br>
+read mix samples: <a href="extsnd.html#makemixsampler">make-mix-sampler</a><br>
mix data maxamp: <a href="sndscm.html#mixmaxamp">mix-maxamp</a><br>
mix data to vct: <a href="sndscm.html#mixtovct">mix->vct</a><br>
-save mix data in file: <a href="#savemix">save-mix</a><br>
-mix property list: <a href="#mixproperty">mix-property</a><br>
+save mix data in file: <a href="extsnd.html#savemix">save-mix</a><br>
+mix property list: <a href="extsnd.html#mixproperty">mix-property</a> in mix.scm<br>
pan mono sound into stereo: see <a href="sndscm.html#placesound">place-sound</a> in examp.scm<br>
-move a mixed sound via dlocsig: <a href="#mixmovesound">mix-move-sound</a><br>
+move a mixed sound via dlocsig: <a href="extsnd.html#mixmovesound">mix-move-sound</a><br>
the mix dialog: <a href="snd.html#mixdialog">Mix Dialog</a><br>
cross-fade in frequency: cross-fade and dissolve-fade in <a href="sndscm.html#fadedoc">fade.scm</a><br>
zipper cross-fade: <a href="sndscm.html#zipdoc">zipper.scm</a><br>
snap mix to beat after drag: <a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a><br>
delete all mixes: <a href="sndscm.html#silenceallmixes">silence-all-mixes</a><br>
with-sound (a notelist) expanded into mixes: <a href="sndscm.html#withmixedsound">with-mixed-sound</a><br>
-<br>
</small></blockquote>
</td></tr></TABLE>
-<br><br>
-<table width="50%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h3><A NAME="sndregions">Regions and Selections</a></h3></td></tr></table>
-<br>
-<table width="35%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>Regions</h4></td></tr></table>
+<div class="header" id="sndregions">Regions and Selections</div>
-<p>A region is a saved portion of sound data. Use the View:Region browser to inspect, edit, and save regions.
+<p id="regionstuff">A region is a saved portion of sound data. Use the View:Region browser to inspect, edit, and save regions.
As regions are defined, the new ones are pushed on a stack, and if enough regions already
exist, old ones are pushed off (and deleted) to make room.
</p>
-<!-- -------------------------------- REGION TABLE -------------------------------- -->
+<!-- REGION TABLE -->
+
+<div class="spacer"></div>
-<A NAME="regionstuff"></a>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
<!-- forget-region -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="forgetregion">forget-region</a> reg</code>
-</td></tr><tr><td width=30><br></td><td>
-forget-region deletes region 'reg', removing it from the region stack. This does not affect any of the
+<pre class="indented">
+<em class=def id="forgetregion">forget-region</em> reg
+</pre>
+
+<p>forget-region deletes region 'reg', removing it from the region stack. This does not affect any of the
active sounds; it just tells Snd that you no longer need any access to one of the current regions.
To delete all regions,
-<pre>
- (for-each <em class=red>forget-region</em> (<a class=quiet href="#eregions" onmouseout="UnTip()" onmouseover="Tip(extsnd_eregions_tip)">regions</a>))
+</p>
+
+<pre class="indented">
+(for-each <em class=red>forget-region</em> (<a class=quiet href="#eregions">regions</a>))
</pre>
-I called this forget-region because delete-region seemed ambiguous, especially given delete-selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>I called this forget-region because delete-region seemed ambiguous, especially given delete-selection.
+</p>
+<div class="spacer"></div>
<!-- insert-region -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="insertregion">insert-region</a> reg beg <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-insert-region inserts region 'reg' at sample 'beg' in the given channel. The following
+<pre class="indented">
+<em class=def id="insertregion">insert-region</em> reg beg snd chn
+</pre>
+
+<p>insert-region inserts region 'reg' at sample 'beg' in the given channel. The following
function uses insert-region (and other region functions) to rotate the samples in a channel:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<a name="rotatechannel">rotate-channel</a> (samps 1) snd chn)
- (let* ((ind (or snd (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (car (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
- (chan (or chn (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>) 0)))
+<pre class="indented">
+(define* (rotate-channel (samps 1) snd chn)
+ (let ((ind (or snd (<a class=quiet href="#selectedsound">selected-sound</a>) (car (<a class=quiet href="#sounds">sounds</a>))))
+ (chan (or chn (<a class=quiet href="#selectedchannel">selected-channel</a>) 0)))
(let ((reg (<em class=red>make-region</em> 0 (- samps 1) ind chan)))
- (<a class=quiet href="#asoneedit" onmouseout="UnTip()" onmouseover="Tip(extsnd_asoneedit_tip)">as-one-edit</a>
+ (<a class=quiet href="#asoneedit">as-one-edit</a>
(lambda ()
- (<a class=quiet href="#deletesamples" onmouseout="UnTip()" onmouseover="Tip(extsnd_deletesamples_tip)">delete-samples</a> 0 samps ind chan)
- (<em class=red>insert-region</em> reg (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> ind chan))))
+ (<a class=quiet href="#deletesamples">delete-samples</a> 0 samps ind chan)
+ (<em class=red>insert-region</em> reg (<a class=quiet href="#framples">framples</a> ind chan))))
(<em class=red>forget-region</em> reg))))
-</pre></td></tr></table></td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+<div class="spacer"></div>
<!-- integer->region -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="integertoregion">integer->region</a> i</code>
-</td></tr><tr><td></td><td>
-In olden times, a region was handled in Snd code as an integer; nowadays, it's an object.
+<pre class="indented">
+<em class=def id="integertoregion">integer->region</em> i
+</pre>
+
+<p>In olden times, a region was handled in Snd code as an integer; nowadays, it's an object.
This function, and its companion <a href="#regiontointeger">region->integer</a>, exist mainly to convert
old code to the current style.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- make-region -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="makeregion">make-region</a> <em class=narg>beg end snd chn</em></code>
-</td></tr><tr><td></td><td>
-make-region creates a new region spanning the samples 'beg' to 'end' in the given channel.
+<pre class="indented">
+<em class=def id="makeregion">make-region</em> beg end snd chn
+</pre>
+
+<p>make-region creates a new region spanning the samples 'beg' to 'end' in the given channel.
It returns the new region. If no arguments are given, the
-current selection is used. If 'chn' is #t, all chans are included, taking the <a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> fields into account.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+current selection is used. If 'chn' is #t, all chans are included, taking the <a class=quiet href="#sync">sync</a> fields into account.
+</p>
+<div class="spacer"></div>
<!-- make-region-sampler -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a href="#makeregionsampler">make-region-sampler</a> reg <em class=narg>start chn (dir 1)</em></code>
-</td></tr><tr><td></td><td>
-This creates a <a href="#samplers">sampler</a> reading the region's channel 'chn' starting at sample 'start' within that region.
+<pre class="indented">
+<em class=emdef><a href="#makeregionsampler">make-region-sampler</a></em> reg start chn (dir 1)
+</pre>
+
+<p>This creates a <a href="#samplers">sampler</a> reading the region's channel 'chn' starting at sample 'start' within that region.
'dir' can be 1 (read forwards) or -1 (read backwards).
-</td></tr>
-<tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- mix-region -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><em class=emdef>mix-region</em> reg <em class=narg>samp snd chn</em></code>
-</td></tr><tr><td></td><td>
-mix-region mixes region 'reg' into the given channel starting at sample 'samp' (defaulting to the cursor location).
+<pre class="indented">
+<em class=emdef>mix-region</em> reg samp snd chn
+</pre>
+
+<p>mix-region mixes region 'reg' into the given channel starting at sample 'samp' (defaulting to the cursor location).
It returns a list of mixes, one for each channel mixed.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- region-chans -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionchans">region-chans</a> reg</code>
-</td></tr><tr><td></td><td>
-This returns the number of channels in the region 'reg'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="regionchans">region-chans</em> reg
+</pre>
+
+<p>This returns the number of channels in the region 'reg'.
+</p>
+<div class="spacer"></div>
-<!-- region-frames -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionframes">region-frames</a> reg <em class=narg>(chan 0)</em></code>
-</td></tr><tr><td></td><td>
-region-frames returns the number of frames in the region 'reg'.
-<pre>
- :<em class=typing>(make-region 100 200)</em>
- <em class=listener>#<region 1></em>
- :<em class=typing>(region-frames (integer->region 1))</em>
- <em class=listener>101</em>
+<!-- region-framples -->
+<pre class="indented">
+<em class=def id="regionframples">region-framples</em> reg (chan 0)
+</pre>
+
+<p>region-framples returns the number of framples in the region 'reg'.
+</p>
+
+<pre class="indented">
+> (make-region 100 200)
+#<region 1>
+> (region-framples (integer->region 1))
+101
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- region-graph-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regiongraphstyle">region-graph-style</a></code>
-</td></tr><tr><td></td><td>
-region-graph-style is the graph drawing choice for the region dialog's graph.
+<pre class="indented">
+<em class=def id="regiongraphstyle">region-graph-style</em>
+</pre>
+
+<p>region-graph-style is the graph drawing choice for the region dialog's graph.
The choices are:
-<pre>
- graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
+</p>
+
+<pre class="indented">
+graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
</pre>
-<code>graph-lines</code> is the default.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>graph-lines is the default.
+</p>
+<div class="spacer"></div>
<!-- region-home -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionhome">region-home</a> reg</code>
-</td></tr><tr><td></td><td>
-This returns a list with the name of the source file for the given region, its start time in the original
-data, and its length in frames.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="regionhome">region-home</em> reg
+</pre>
+
+<p>This returns a list with the name of the source file for the given region, its start time in the original
+data, and its length in framples.
+</p>
+<div class="spacer"></div>
<!-- region->integer -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regiontointeger">region->integer</a> region</code>
-</td></tr><tr><td></td><td>
-This is the counterpart to <a href="#integertoregion">integer->region</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="regiontointeger">region->integer</em> region
+</pre>
+
+<p>This is the counterpart to <a href="#integertoregion">integer->region</a>.
+</p>
+<div class="spacer"></div>
<!-- region-maxamp -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionmaxamp">region-maxamp</a> reg</code>
-</td></tr><tr><td></td><td>
-region-maxamp is the peak amplitude of the samples in the region 'reg'.
-<pre>
- :<em class=typing>(region-maxamp (integer->region 1))</em>
- <em class=listener>4.8828125e-4</em>
+<pre class="indented">
+<em class=def id="regionmaxamp">region-maxamp</em> reg
+</pre>
+
+<p>region-maxamp is the peak amplitude of the samples in the region 'reg'.
+</p>
+
+<pre class="indented">
+> (region-maxamp (integer->region 1))
+4.8828125e-4
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- region-maxamp-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionmaxampposition">region-maxamp-position</a> reg</code>
-</td></tr><tr><td></td><td>
-region-maxamp-position returns the location (a sample number) of the peak amplitude of the region 'reg'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="regionmaxampposition">region-maxamp-position</em> reg
+</pre>
+
+<p>region-maxamp-position returns the location (a sample number) of the peak amplitude of the region 'reg'.
+</p>
+<div class="spacer"></div>
<!-- region-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionposition">region-position</a> reg <em class=narg>chan</em></code>
-</td></tr><tr><td></td><td>
-region-position returns the begin time of the region's channel 'chan' in the original sound.
-<pre>
- :<em class=typing>(make-region 1000 2000)</em>
- <em class=listener>2</em>
- :<em class=typing>(region-position (integer->region 2))</em>
- <em class=listener>1000</em>
+<pre class="indented">
+<em class=def id="regionposition">region-position</em> reg chan
+</pre>
+
+<p>region-position returns the begin time of the region's channel 'chan' in the original sound.
+</p>
+
+<pre class="indented">
+> (make-region 1000 2000)
+2
+> (region-position (integer->region 2))
+1000
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- region-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionsample">region-sample</a> reg samp <em class=narg>chan</em></code>
-</td></tr><tr><td></td><td>
-region-sample returns the value of the sample 'samp' in channel 'chan' of the region 'reg'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="regionsample">region-sample</em> reg samp chan
+</pre>
+
+<p>region-sample returns the value of the sample 'samp' in channel 'chan' of the region 'reg'.
+</p>
+<div class="spacer"></div>
<!-- region->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regiontovct">region->vct</a> reg <em class=narg>samp samps chan v</em></code>
-</td></tr><tr><td></td><td>
-region->vct returns a vct containing 'samps' samples starting at 'samp' in channel 'chan' of the region 'reg'.
+<pre class="indented">
+<em class=def id="regiontovct">region->vct</em> reg samp samps chan v
+</pre>
+
+<p>region->vct returns a vct containing 'samps' samples starting at 'samp' in channel 'chan' of the region 'reg'.
If 'v' (a vct) is provided, it is filled,
rather than creating a new vct.
+</p>
-<table border=0 cellpadding=5><tr><td><pre>
+<pre class="indented">
(define (region-rms n)
(let* ((data (<em class=red>region->vct</em> (integer->region 0) 0 #f n))
(len (length data)))
- (sqrt (/ (<a class=quiet href="sndclm.html#dot-product" onmouseout="UnTip()" onmouseover="Tip(sndclm_dot_product_tip)">dot-product</a> data data len) len))))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+ (sqrt (/ (<a class=quiet href="sndclm.html#dot-product">dot-product</a> data data len) len))))
+</pre>
+<div class="spacer"></div>
<!-- region-srate -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionsrate">region-srate</a> reg</code>
-</td></tr><tr><td></td><td>
-region-srate returns the sampling rate of the data that makes up the region 'reg'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="regionsrate">region-srate</em> reg
+</pre>
+
+<p>region-srate returns the sampling rate of the data that makes up the region 'reg'.
+</p>
+<div class="spacer"></div>
<!-- regions -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="eregions">regions</a></code>
-</td></tr><tr><td></td><td>
-regions returns a list of active regions. The most recently created region is <code>(car (regions))</code>.
-<code>(map region-frames (regions))</code> returns a list of region lengths.
+<pre class="indented">
+<em class=def id="eregions">regions</em>
+</pre>
+
+<p>regions returns a list of active regions. The most recently created region is (car (regions)).
+(map region-framples (regions)) returns a list of region lengths.
The maximum length of this list is set by <a href="#maxregions">max-regions</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- region? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="regionok">region?</a> reg</code>
-</td></tr><tr><td></td><td>
-region? returns #t if the region 'reg' exists. There is a limit to how many regions Snd tries to
+<pre class="indented">
+<em class=def id="regionok">region?</em> reg
+</pre>
+
+<p>region? returns #t if the region 'reg' exists. There is a limit to how many regions Snd tries to
keep track of (<a href="#maxregions">max-regions</a>); when necessary, the least-recently created region is
deleted.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- save-region -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="saveregion">save-region</a> reg :file <em class=narg>:header-type :data-format :comment</em></code>
-</td></tr><tr><td></td><td>
-save-region saves the region 'reg' in 'file' in the given data format and header type.
+<pre class="indented">
+<em class=def id="saveregion">save-region</em> reg :file :sample-type :header-type :comment
+</pre>
+
+<p>save-region saves the region 'reg' in 'file' in the given sample type and header type.
It returns the output filename.
The following calls are equivalent:
-<pre>
- (save-region reg "reg0.snd")
- (save-region reg :file "reg0.snd" :header-type mus-next)
- (save-region reg "reg0.snd" mus-next <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_musbfloat_tip)">mus-bfloat</a> "a comment")
- (save-region reg :file "reg0.snd" :comment "a comment" :data-format <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_musbfloat_tip)">mus-bfloat</a>)
+</p>
+
+<pre class="indented">
+(save-region reg "reg0.snd")
+(save-region reg :file "reg0.snd" :header-type mus-next)
+(save-region reg "reg0.snd" <a class=quiet href="#sampletype">mus-bfloat</a> mus-next "a comment")
+(save-region reg :file "reg0.snd" :comment "a comment" :sample-type <a class=quiet href="#sampletype">mus-bfloat</a>)
</pre>
-</td></tr>
-</table>
-<br>
<!-- INDEX regionstuff:Regions -->
-<TABLE border=3 bordercolor="tan" hspace=20><tr><td>
-<small><blockquote>
-Max length of region list: <a href="#maxregions">max-regions</a><br>
-Whether selection creates a region: <a href="#selectioncreatesregion">selection-creates-region</a><br>
+
+<TABLE class="method">
+<tr><th class="title"><a class=quiet href="extsnd.html#sndregions">Regions</a></th></tr><tr><td>
+<blockquote><small>
+Max length of region list: <a href="extsnd.html#maxregions">max-regions</a><br>
+Whether selection creates a region: <a href="extsnd.html#selectioncreatesregion">selection-creates-region</a><br>
To play region repeatedly: <a href="sndscm.html#playregionforever">play-region-forever</a><br>
-Start region browser: <a href="#viewregionsdialog">view-regions-dialog</a><br>
+Start region browser from Scheme: <a href="extsnd.html#viewregionsdialog">view-regions-dialog</a><br>
All about regions: <a href="snd.html#regions">regions</a><br>
The region dialog: <a href="snd.html#regionbrowser">region browser</a><br>
Region rms amp: <a href="sndscm.html#regionrms">region-rms</a><br>
region-play-list and region-play-sequence in examp.scm<br>
-<a href="sndscm.html#regiontoframe">region->frame</a><br>
-<a href="sndscm.html#regiontosounddata">region->sound-data</a><br>
-<a href="sndscm.html#makeregionframereader">make-region-frame-reader</a><br>
-<br>
-</blockquote></small>
+</small></blockquote>
</td></tr></TABLE>
-<br><br>
-<table width="35%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>Selections</h4></td></tr></table>
+<!-- SELECTION TABLE -->
+<div class="spacer"></div>
-<!-- -------------------------------- SELECTION TABLE -------------------------------- -->
-<br>
-<A NAME="selectionstuff"></a>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
<!-- convolve-selection-with -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="convolveselectionwith">convolve-selection-with</a> file <em class=narg>amp</em></code>
-</td></tr><tr><td width=30><br></td><td>
-convolve-selection-with convolves the current selection with 'file', replacing the selection with the result.
+<pre class="indented">
+<em class=def id="convolveselectionwith">convolve-selection-with</em> file amp
+</pre>
+
+<p id="selectionstuff">convolve-selection-with convolves the current selection with 'file', replacing the selection with the result.
'amp' sets the maxamp of the result.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- delete-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="deleteselection">delete-selection</a></code>
-</td></tr><tr><td></td><td>
-delete-selection deletes the selection, equivalent to the Edit:Delete selection menu choice.
-</td></tr>
-<tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="deleteselection">delete-selection</em>
+</pre>
+
+<p>delete-selection deletes the selection, equivalent to the Edit:Delete selection menu choice.
+</p>
+<div class="spacer"></div>
<!-- delete-selection-and-smooth -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="deleteselectionandsmooth">delete-selection-and-smooth</a></code>
-</td></tr><tr><td></td><td>
-delete-selection-and-smooth deletes the selection, then tries to make the splice smooth.
-</td></tr>
-<tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="deleteselectionandsmooth">delete-selection-and-smooth</em>
+</pre>
+
+<p>delete-selection-and-smooth deletes the selection, then tries to make the splice smooth.
+</p>
+<div class="spacer"></div>
<!-- env-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envselection">env-selection</a> envelope <em class=narg>env-base</em></code>
-</td></tr><tr><td></td><td>
-env-selection applies 'envelope' to the selection. (as an amplitude envelope).
+<pre class="indented">
+<em class=def id="envselection">env-selection</em> envelope env-base
+</pre>
+
+<p>env-selection applies 'envelope' to the selection. (as an amplitude envelope).
'envelope' can also be a CLM env generator; in this case, 'env-base' is ignored.
These are equivalent:
-<pre>
- (env-selection '(0 0 1 1 2 0))
- (env-selection (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 0) :length (<a class=quiet href="#selectionframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionframes_tip)">selection-frames</a>)))
+</p>
+
+<pre class="indented">
+(env-selection '(0 0 1 1 2 0))
+(env-selection (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 0 1 1 2 0) :length (<a class=quiet href="#selectionframples">selection-framples</a>)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- filter-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="filterselection">filter-selection</a> env <em class=narg>order truncate</em></code>
-</td></tr><tr><td></td><td>
-filter-selection applies an FIR filter of order 'order' and frequency response 'env'
+<pre class="indented">
+<em class=def id="filterselection">filter-selection</em> env order truncate
+</pre>
+
+<p>filter-selection applies an FIR filter of order 'order' and frequency response 'env'
to the selection. 'env' can be the filter coefficients
themselves in a vct with at least 'order' elements, or
a CLM filtering generator (see <a href="#filtersound">filter-sound</a>).
If 'truncate' is #t (the default), the filter output is truncated at the selection
end. If 'truncate' is #f, the extra output ('order' samples worth) is mixed into the stuff following the selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- insert-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="insertselection">insert-selection</a> <em class=narg>beg snd chn</em></code>
-</td></tr><tr><td></td><td>
-insert-selection inserts a copy of the selection starting at 'beg' in the given channel (that is, it pastes in the selection
+<pre class="indented">
+<em class=def id="insertselection">insert-selection</em> beg snd chn
+</pre>
+
+<p>insert-selection inserts a copy of the selection starting at 'beg' in the given channel (that is, it pastes in the selection
as a block).
-The Edit:Insert selection menu choice is essentially <code>(insert-selection (cursor))</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+The Edit:Insert selection menu choice is essentially (insert-selection (cursor)).
+</p>
+<div class="spacer"></div>
<!-- mix-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixselection">mix-selection</a> <em class=narg>beg snd chn selection-channel</em></code>
-</td></tr><tr><td></td><td>
-mix-selection mixes (adds) a copy of the selection starting at 'beg' in the given channel, and returns a list of the new mixes.
-The Edit:Mix selection menu choice is <code>(mix-selection (cursor))</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixselection">mix-selection</em> beg snd chn selection-channel
+</pre>
+
+<p>mix-selection mixes (adds) a copy of the selection starting at 'beg' in the given channel, and returns a list of the new mixes.
+The Edit:Mix selection menu choice is (mix-selection (cursor)).
+</p>
+<div class="spacer"></div>
<!-- reverse-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="reverseselection">reverse-selection</a></code>
-</td></tr><tr><td></td><td>
-reverse-selection reverses the selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="reverseselection">reverse-selection</em>
+</pre>
+
+<p>reverse-selection reverses the selection.
+</p>
+<div class="spacer"></div>
<!-- save-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="saveselection">save-selection</a> <em class=narg>:file (:header-type mus-next) :data-format :srate :comment :channel</em></code>
-</td></tr><tr><td></td><td>
-save-selection saves the selection in 'file'. If 'channel' is given, it saves only that channel.
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (brksnd dur base)
- "(brksnd dur base) divides the current sound into dur-sized pieces,
- saving them in files named 'base'.n: (brksnd 1.0 \"sec\")"
- (let ((hop (floor (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) dur)))
- (len (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (old-sync (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a>)))
- (set! (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a>) 1) ; save all chans
- (do ((i 0 (+ i hop))
- (j 0 (+ 1 j)))
- ((>= i len))
- (<a class=quiet href="sndscm.html#makeselection" onmouseout="UnTip()" onmouseover="Tip(sndscm_makeselection_tip)">make-selection</a> i (+ i hop)) ; in extensions.scm
- (<em class=red>save-selection</em> (string-append base "." (number->string j))))
- (set! (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a>) old-sync)))
-</pre></td></tr></table>
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<a name="extractchannels">extract-channels</a> :rest chans)
+<pre class="indented">
+<em class=def id="saveselection">save-selection</em> :file :srate :sample-type (:header-type mus-next) :comment :channel
+</pre>
+
+<p id="extractchannels">save-selection saves the selection in 'file'. If 'channel' is given, it saves only that channel.
+</p>
+
+<pre class="indented">
+(define brksnd
+ (let ((documentation "(brksnd dur base) divides the current sound into dur-sized pieces,
+saving them in files named 'base'.n: (brksnd 1.0 \"sec\")"))
+ (lambda (dur base)
+ (let ((hop (floor (* (<a class=quiet href="#srate">srate</a>) dur)))
+ (len (<a class=quiet href="#framples">framples</a>))
+ (old-sync (<a class=quiet href="#sync">sync</a>)))
+ (set! (<a class=quiet href="#sync">sync</a>) 1) ; save all chans
+ (do ((i 0 (+ i hop))
+ (j 0 (+ j 1)))
+ ((>= i len))
+ (<a class=quiet href="sndscm.html#makeselection">make-selection</a> i (+ i hop)) ; in extensions.scm
+ (<em class=red>save-selection</em> (string-append base "." (number->string j))))
+ (set! (<a class=quiet href="#sync">sync</a>) old-sync)))))
+</pre>
+
+<pre class="indented">
+(define* (extract-channels :rest chans)
;; extract a list of channels from the current sound and save as test.snd: (extract-channels 0 2)
- (let ((snd (or (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (car (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>)))))
- (if (<a class=quiet href="#soundp" onmouseout="UnTip()" onmouseover="Tip(extsnd_soundp_tip)">sound?</a> snd)
+ (let ((snd (or (<a class=quiet href="#selectedsound">selected-sound</a>) (car (<a class=quiet href="#sounds">sounds</a>)))))
+ (if (<a class=quiet href="#soundp">sound?</a> snd)
(begin
(for-each
(lambda (chan)
- (set! (<a class=quiet href="#selectionmember" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionmember_tip)">selection-member?</a> snd chan) #t)
- (set! (<a class=quiet href="#selectionposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionposition_tip)">selection-position</a> snd chan) 0)
- (set! (<a class=quiet href="#selectionframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionframes_tip)">selection-frames</a> snd chan) (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd chan)))
+ (set! (<a class=quiet href="#selectionmember">selection-member?</a> snd chan) #t)
+ (set! (<a class=quiet href="#selectionposition">selection-position</a> snd chan) 0)
+ (set! (<a class=quiet href="#selectionframples">selection-framples</a> snd chan) (<a class=quiet href="#framples">framples</a> snd chan)))
chans)
(<em class=red>save-selection</em> "test.snd")))))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+<div class="spacer"></div>
<!-- scale-selection-by -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="scaleselectionby">scale-selection-by</a> scalers</code>
-</td></tr><tr><td></td><td>
-scale-selection-by scales (multiplies) the selection by 'scalers' which can be either a float,
+<pre class="indented">
+<em class=def id="scaleselectionby">scale-selection-by</em> scalers
+</pre>
+
+<p>scale-selection-by scales (multiplies) the selection by 'scalers' which can be either a float,
a list of floats, or a vct. In a multichannel selection, each member of the vct or list
-is applied to the next channel in the selection. <code>(scale-selection-by '(0.0 2.0))</code> scales
-the first channel by 0.0, the second (if any) by 2.0. <code>(scale-selection-by 2.0)</code> scales
+is applied to the next channel in the selection. (scale-selection-by '(0.0 2.0)) scales
+the first channel by 0.0, the second (if any) by 2.0. (scale-selection-by 2.0) scales
all channels by 2.0. Normally the order of channels follows the order of the sounds.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- scale-selection-to -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="scaleselectionto">scale-selection-to</a> <em class=narg>norms</em></code>
-</td></tr><tr><td></td><td>
-scale-selection-to normalizes the selection to peak amplitude 'norms' which can be either a float,
+<pre class="indented">
+<em class=def id="scaleselectionto">scale-selection-to</em> norms
+</pre>
+
+<p>scale-selection-to normalizes the selection to peak amplitude 'norms' which can be either a float,
a list of floats, or a vct.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- select-all -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectall">select-all</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This function selects all samples in the given channel.
+<pre class="indented">
+<em class=def id="selectall">select-all</em> snd chn
+</pre>
+
+<p>This function selects all samples in the given channel.
If a region is created, it returns the new region.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selection">selection</a></code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="selection">selection</em>
+</pre>
+
<p>selection returns an object representing the current selection, or #f if there is no active selection.
The object can be passed to the <a href="#sndgenericfuncs">generic functions</a> to refer to the
current selection:
</p>
-<pre>
- :<em class=typing>(define selobj (selection))</em>
- <em class=listener>selobj</em>
- :<em class=typing>selobj</em>
- <em class=listener>#<selection 1></em>
- :<em class=typing>(selection-chans)</em>
- <em class=listener>1</em>
- :<em class=typing>(channels selobj)</em>
- <em class=listener>1</em>
+
+<pre class="indented">
+> (define selobj (selection))
+selobj
+> selobj
+#<selection 1>
+> (selection-chans)
+1
+> (channels selobj)
+1
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- selection-chans -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectionchans">selection-chans</a></code>
-</td></tr><tr><td></td><td>
-selection-chans returns the number of channels in the current selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="selectionchans">selection-chans</em>
+</pre>
+
+<p>selection-chans returns the number of channels in the current selection.
+</p>
+<div class="spacer"></div>
-<!-- selection-frames -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectionframes">selection-frames</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-selection-frames returns the number of frames in the current selection (its length in samples).
+<!-- selection-framples -->
+<pre class="indented">
+<em class=def id="selectionframples">selection-framples</em> snd chn
+</pre>
+
+<p>selection-framples returns the number of framples in the current selection (its length in samples).
You can set this to move the selection end point:
-<pre>
- :<em class=typing>(select-all)</em> ; grab all of current channel
- <em class=listener>#<region 1></em>
- :<em class=typing>(selection-frames)</em>
- <em class=listener>55240</em>
- :<em class=typing>(set! (selection-frames) 10000)</em> ; unselect all but the starting 10000
- <em class=listener>10000</em>
- :<em class=typing>(selection-frames)</em>
- <em class=listener>10000</em>
- :<em class=typing>(set! (selection-frames) (* 2 (selection-frames)))</em> ; double the selection length
- <em class=listener>20000</em>
+</p>
+
+<pre class="indented">
+> (select-all) ; grab all of current channel
+#<region 1>
+> (selection-framples)
+55240
+> (set! (selection-framples) 10000) ; unselect all but the starting 10000
+10000
+> (selection-framples)
+10000
+> (set! (selection-framples) (* 2 (selection-framples))) ; double the selection length
+20000
</pre>
-See also <a href="sndscm.html#makeselection">make-selection</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>See also <a href="sndscm.html#makeselection">make-selection</a>.
+</p>
+<div class="spacer"></div>
<!-- selection-maxamp -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectionmaxamp">selection-maxamp</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-selection-maxamp returns the peak amplitude of the selection in the given channel.
+<pre class="indented">
+<em class=def id="selectionmaxamp">selection-maxamp</em> snd chn
+</pre>
+
+<p>selection-maxamp returns the peak amplitude of the selection in the given channel.
If no arguments are passed, selection-maxamp returns the overall selection maxamp.
I use this to provide a view of the selection amplitude envelope in the envelope editor. If you select
'selection' and 'wave' in that dialog, it displays a copy of whatever is in the main channel graph,
so to get a display that makes it easy to "connect the dots", I use C-x m:
-<pre>
- (<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\m 0
- (lambda ()
- (set! (<a class=quiet href="#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a> (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>)) (list 0 (<em class=red>selection-maxamp</em>))))
- #t)
+</p>
- (<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\m 4
- (lambda ()
- (set! (<a class=quiet href="#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a> (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>)) (list -1.0 1.0)))
- #t)
+<pre class="indented">
+(<a class=quiet href="#bindkey">bind-key</a> #\m 0
+ (lambda ()
+ (set! (<a class=quiet href="#ybounds">y-bounds</a> (<a class=quiet href="#selectedsound">selected-sound</a>) (<a class=quiet href="#selectedchannel">selected-channel</a>)) (list 0 (<em class=red>selection-maxamp</em>))))
+ #t)
+
+(<a class=quiet href="#bindkey">bind-key</a> #\m 4
+ (lambda ()
+ (set! (<a class=quiet href="#ybounds">y-bounds</a> (<a class=quiet href="#selectedsound">selected-sound</a>) (<a class=quiet href="#selectedchannel">selected-channel</a>)) (list -1.0 1.0)))
+ #t)
</pre>
-The second key binding (C-x C-m), undoes the previous C-x m. Another useful key binding in this regard is C-x v, the
+
+<p>The second key binding (C-x C-m), undoes the previous C-x m. Another useful key binding in this regard is C-x v, the
built-in command to fill the current window with the selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- selection-maxamp-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectionmaxampposition">selection-maxamp-position</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-selection-maxamp-position returns the location (a sample number) of the peak amplitude of the selection in the given channel.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="selectionmaxampposition">selection-maxamp-position</em> snd chn
+</pre>
+
+<p>selection-maxamp-position returns the location (a sample number) of the peak amplitude of the selection in the given channel.
+</p>
+<div class="spacer"></div>
<!-- selection-member? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectionmember">selection-member?</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-selection-member? returns #t if the given channel has data that is currently selected.
+<pre class="indented">
+<em class=def id="selectionmember">selection-member?</em> snd chn
+</pre>
+
+<p>selection-member? returns #t if the given channel has data that is currently selected.
This is mostly useful when adding a channel to the current selection; see
<a href="sndscm.html#makeselection">make-selection</a> in extensions.scm.
-If 'snd' is #t and the new value is #f, the entire selection is deactivated
-<pre>
- (set! (<em class=red>selection-member?</em> #t) #f)
+If 'snd' is #t and the new value is #f, the entire selection is deactivated.
+</p>
+
+<pre class="indented">
+(set! (<em class=red>selection-member?</em> #t) #f)
</pre>
-ie equivalent to unselect-all.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>i.e. equivalent to unselect-all.
+</p>
+<div class="spacer"></div>
<!-- selection->mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectiontomix">selection->mix</a></code>
-</td></tr><tr><td></td><td>
-selection->mix turns the current selection into a mix, or into several sync'd mixes if the selection
+<pre class="indented">
+<em class=def id="selectiontomix">selection->mix</em>
+</pre>
+
+<p>selection->mix turns the current selection into a mix, or into several sync'd mixes if the selection
has more than one channel.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- selection-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectionposition">selection-position</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-selection-position is the sample where selection begins.
+<pre class="indented">
+<em class=def id="selectionposition">selection-position</em> snd chn
+</pre>
+
+<p>selection-position is the sample where selection begins.
You can set this to move the selection's starting point to some arbitrary sample.
-If changed, the selection end point stays the same, while the length (<a class=quiet href="#selectionframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionframes_tip)">selection-frames</a>) changes to reflect the
+If changed, the selection end point stays the same, while the length (<a class=quiet href="#selectionframples">selection-framples</a>) changes to reflect the
moved origin.
See <a href="sndscm.html#makeselection">make-selection</a> in extensions.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- selection-srate -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectionsrate">selection-srate</a></code>
-</td></tr><tr><td></td><td>
-This function returns the selection srate. There's some arbitrariness in this if the sounds that make up the selection have different sampling rates.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="selectionsrate">selection-srate</em>
+</pre>
+
+<p>This function returns the selection srate. There's some arbitrariness in this if the sounds that make up the selection have different sampling rates.
+</p>
+<div class="spacer"></div>
<!-- selection? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="selectionok">selection?</a> obj</code>
-</td></tr><tr><td></td><td>
-selection? returns #t if there is a selection.
+<pre class="indented">
+<em class=def id="selectionok">selection?</em> obj
+</pre>
+
+<p>selection? returns #t if there is a selection.
If some 'obj' is passed, selection? returns #t is obj is a selection object, and there is a selection.
-<pre>
- :<em class=typing>(select-all)</em>
- <em class=listener>#<region 2></em>
- :<em class=typing>(selection?)</em>
- <em class=listener>#t</em>
- :<em class=typing>(set! (selection-member? #t) #f)</em>
- <em class=listener>#f</em>
- :<em class=typing>(selection?)</em>
- <em class=listener>#f</em>
+</p>
+
+<pre class="indented">
+> (select-all)
+#<region 2>
+> (selection?)
+#t
+> (set! (selection-member? #t) #f)
+#f
+> (selection?)
+#f
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- show-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="showselection">show-selection</a></code>
-</td></tr><tr><td></td><td>
-show-selection finds the bounds of the current selection (in all channels), and
+<pre class="indented">
+<em class=def id="showselection">show-selection</em>
+</pre>
+
+<p>show-selection finds the bounds of the current selection (in all channels), and
sets the time domain view to show it.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- smooth-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="smoothselection">smooth-selection</a></code>
-</td></tr><tr><td></td><td>
-smooth-selection applies a smoothing function to the selection, producing a sinusoid between
+<pre class="indented">
+<em class=def id="smoothselection">smooth-selection</em>
+</pre>
+
+<p>smooth-selection applies a smoothing function to the selection, producing a sinusoid between
the selection end points. In normal use, you'd bind this function to some key,
select a portion (say a few samples) of a sound around a click,
then smooth it by typing that key.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- src-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="srcsoundselection">src-selection</a> num-or-env <em class=narg>base</em></code>
-</td></tr><tr><td></td><td>
-src-selection applies sampling rate conversion to the selection;
+<pre class="indented">
+<em class=def id="srcsoundselection">src-selection</em> num-or-env base
+</pre>
+
+<p>src-selection applies sampling rate conversion to the selection;
this is the same as src-sound but as applied to the selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- unselect-all -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="unselectall">unselect-all</a></code>
-</td></tr><tr><td></td><td>
-If there is currently a selection, this deactivates (unselects) it.
-</td></tr>
+<pre class="indented">
+<em class=def id="unselectall">unselect-all</em>
+</pre>
+
+<p>If there is currently a selection, this deactivates (unselects) it.
+</p>
-</table>
-<br>
<!-- INDEX selectionstuff:Selections -->
-<TABLE border=3 bordercolor="tan" hspace=20><tr><td>
-<small><blockquote>
-show the current selection: <a href="#showselection">show-selection</a><br>
-color of selected portion: <a href="#selectioncolor">selection-color</a><br>
-set whether creating a selection creates a region: <a href="#selectioncreatesregion">selection-creates-region</a><br>
-fft graph refers to the selection: <a href="#showselectiontransform">show-selection-transform</a><br>
-hook called when selection stops playing: <a href="#stopplayingselectionhook">stop-playing-selection-hook</a><br>
+
+<TABLE class="method">
+<tr><th class="title"><a class=quiet href="extsnd.html#sndregions">Selections</a></th></tr><tr><td>
+<blockquote><small>
+show the current selection: <a href="extsnd.html#showselection">show-selection</a><br>
+color of selected portion: <a href="extsnd.html#selectioncolor">selection-color</a><br>
+set whether creating a selection creates a region: <a href="extsnd.html#selectioncreatesregion">selection-creates-region</a><br>
+fft graph refers to the selection: <a href="extsnd.html#showselectiontransform">show-selection-transform</a><br>
+hook called when selection stops playing: <a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a><br>
swap chans in selected portion: <a href="sndscm.html#swapselectionchannels">swap-selection-channels</a><br>
replace portion with selection: <a href="sndscm.html#replacewithselection">replace-with-selection</a><br>
select portion via function: <a href="sndscm.html#makeselection">make-selection</a><br>
-evaluate func on each sample of selection: <a href="sndscm.html#evaloverselection">eval-over-selection</a> (map-selection in effect)<br>
-selection members as list of lists of sounds and channels: <a href="sndscm.html#selectionmembers">selection-members</a><br>
+selection members as list of lists of sound indices and channels: <a href="sndscm.html#selectionmembers">selection-members</a><br>
rms of selection data: <a href="sndscm.html#selectionrms">selection-rms</a><br>
-delete selection and smooth the splice: <a href="#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
+delete selection and smooth the splice: <a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
select portion between two marks: <a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a><br>
place marks at selection start and end: <a href="sndscm.html#snapmarks">snap-marks</a><br>
squeeze selection between marks: <a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a><br>
@@ -5998,35 +6426,35 @@ append selection: <a href="sndscm.html#menusdoc">append-selection</a><br>
write selection to a file: <a href="sndscm.html#menusdoc">selection->new</a><br>
notch filter selection: <a href="sndscm.html#notchselection">notch-selection</a><br>
undo select-all.: <a href="sndscm.html#menusdoc">deselect-all</a><br>
-filter the selection: <a href="#filterselection">filter-selection</a>, <a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a><br>
-turn the selection into a mix: <a href="#selectiontomix">selection->mix</a><br>
-unselect everything: <a href="#unselectall">unselect-all</a><br>
-<br>
-</blockquote></small>
+filter the selection: <a href="extsnd.html#filterselection">filter-selection</a>, <a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a><br>
+turn the selection into a mix: <a href="extsnd.html#selectiontomix">selection->mix</a><br>
+unselect everything: <a href="extsnd.html#unselectall">unselect-all</a><br>
+</small></blockquote>
</td></tr></TABLE>
-<p>The selected portion can be chosen, independent of any region, by setting selection-position and selection-frames.
+<p>The selected portion can be chosen, independent of any region, by setting selection-position and selection-framples.
It's easy to extend the notion of a selection to an arbitrary list of sound portions:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+
+<pre class="indented">
(define (make-section . members)
;; each member is '(beg dur snd chn)
(append (list 'Section) members))
(define (section-for-each func section)
;; call func on each member of the section
- (<a class=quiet href="#asoneedit" onmouseout="UnTip()" onmouseover="Tip(extsnd_asoneedit_tip)">as-one-edit</a> (lambda () (for-each func (cdr section)))))
+ (<a class=quiet href="#asoneedit">as-one-edit</a> (lambda () (for-each func (cdr section)))))
;; an example that scales each member of the section by .5
(section-for-each
(lambda (sect)
- (apply <a class=quiet href="#scalechannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_scalechannel_tip)">scale-channel</a> (append (list .5) sect)))
+ (apply <a class=quiet href="#scalechannel">scale-channel</a> (append (list .5) sect)))
(make-section (list 0 10000 0 0) (list 30000 10000 0 0)))
-</pre></td></tr></table>
+</pre>
+
-<br><br><br>
-<table width="50%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h3><A NAME="sndsounds">Sounds and channels</a></h3></td></tr></table>
+<div class="header" id="sndsounds">Sounds and channels</div>
<p>This is the heart of Snd; we've waded through all the ancillary junk, and we've
finally reached the functions that actually edit sounds! Most of these functions
@@ -6034,37 +6462,29 @@ take both a sound and a channel number. When the function refers to a variable
that can be set locally on a sound (zero-pad, for example),
the 'snd' and 'chn' arguments can be #t, referring to all current sounds or all channels of a sound.
In cases where it makes sense, if the 'snd' argument is omitted, the
-reference is to the global default value. So, <code>(set! (amp-control-bounds) '(0.0 2.0))</code>
+reference is to the global default value. So, (set! (amp-control-bounds) '(0.0 2.0))
sets the global amp control (slider) bounds to be between 0.0 and 2.0, whereas
-<code>(set! (amp-control-bounds snd) '(0.0 2.0))</code> sets it only for the sound referred to by 'snd'.
+(set! (amp-control-bounds snd) '(0.0 2.0)) sets it only for the sound referred to by 'snd'.
</p>
-<p>Many of the procedures also have an 'edpos' argument (standing for "edit position").
+<p id="currenteditposition">Many of the procedures also have an 'edpos' argument (standing for "edit position").
It always defaults to the current edit history position. If specified, it can be either an edit history position (to which
-the operation is applied), the constant <a name="currenteditposition">current-edit-position</a> (the default), or a function
-of two arguments, the sound and the channel number. The function should return the
-desired edit history position. In most cases, you should only refer to edits in the past
-(that is, 'edpos' should be less than or equal to the current edit-position); in a few
-situations, you can make use of data in the "redo" section of the edit-history list, but
-nothing is guaranteed.
+the operation is applied), or the constant current-edit-position.
</p>
-<table border=1 hspace=100 cellpadding=10>
-<tr><td>
-<p>
-<A NAME="regularizedargs"></a>
+<p id="regularizedargs">
For not-very-good historical reasons (it took me awhile to decide how to organize things), some of the procedures here are unnecessarily inconsistent in
what arguments they accept, whether a channel of #t signals application to all channels or just the
-selected one, whether the <a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> field is followed, and so on. Rather than make a bunch of backwards
+selected one, whether the <a class=quiet href="#sync">sync</a> field is followed, and so on. Rather than make a bunch of backwards
incompatible changes, I decided to add a bunch of more-or-less synonymous functions that regularize
these calls. The replacements always take arguments in the order begin time, duration (not end sample),
sound, channel number, and edit position, possibly preceded by one argument, and sometimes followed by
-an edit history name or 'ring time' (overlap). The <a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> field is ignored, an unspecified sound argument applies only to the
+an edit history name or 'ring time' (overlap). The <a class=quiet href="#sync">sync</a> field is ignored, an unspecified sound argument applies only to the
current sound, and an unspecified channel argument applies only to the current channel.
The following substitutions can be made:
</p>
-<pre>
+<pre class="indented">
<a href="#convolvewith">convolve-with</a> file amp s c e <a href="#clmchannel">clm-channel</a> convolve-gen beg dur s c e
<a href="#envsound">env-sound</a> env beg dur base s c e <a href="#envchannel">env-channel</a> env beg dur s c e
<a href="#filtersound">filter-sound</a> env order s c e <a href="#filterchannel">filter-channel</a> env order beg dur s c e trunc
@@ -6073,8 +6493,8 @@ The following substitutions can be made:
<a href="#mix">mix</a> file beg filechn s c with-tags <a href="sndscm.html#mixchannel">mix-channel</a> filedat beg dur s c e
<a href="#redo">redo</a> edits s c <a href="#redochannel">redo-channel</a> edits s c
<a href="#reversesound">reverse-sound</a> s c e <a href="#reversechannel">reverse-channel</a> beg dur s c e
-<A href="#scaleby">scale-by</a> scls s c <a href="#scalechannel">scale-channel</a> scl beg dur s c e
-<A href="#scaleto">scale-to</a> scls s c <a href="#normalizechannel">normalize-channel</a> norm beg dur s c e
+<A href="#scaleby">scale-by</A> scls s c <a href="#scalechannel">scale-channel</a> scl beg dur s c e
+<A href="#scaleto">scale-to</A> scls s c <a href="#normalizechannel">normalize-channel</a> norm beg dur s c e
<a href="#setsamples">set-samples</a> beg dur data s c trunc origin fchan <a href="#vcttochannel">vct->channel</a> vct beg dur s c e
<a href="#smoothsound">smooth-sound</a> beg dur s c <a href="#smoothchannel">smooth-channel</a> beg dur s c e
<a href="#srcsound">src-sound</a> num base s c e <a href="#srcchannel">src-channel</a> ratio-or-env beg dur s c e
@@ -6082,36 +6502,36 @@ The following substitutions can be made:
<a href="grfsnd.html#applyladspa">apply-ladspa</a> reader dat dur origin snd chn <a href="grfsnd.html#ladspachannel">ladspa-channel</a> dat beg dur s c e
</pre>
-<p>Another case that might deserve "regularization" is <a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> which confusingly interpolates
+<p>Another case that might deserve "regularization" is <a class=quiet href="#makesampler">make-sampler</a> which confusingly interpolates
the direction argument between the channel and edit-position:
</p>
-<pre> (define* (read-channel (beg 0) snd chn edpos (direction 1))
- (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> beg snd chn direction edpos))
+
+<pre class="indented">
+(define* (read-channel (beg 0) snd chn edpos (direction 1))
+ (<a class=quiet href="#makesampler">make-sampler</a> beg snd chn direction edpos))
</pre>
<p>
The edit position argument can cause ambiguity in a few cases. What should Snd do with:
-<code>(pad-channel 100 0 snd chn 2)</code>?
+(pad-channel 100 0 snd chn 2)?
It currently treats any 0-length operation as a no-op, so the edit history is not changed by this function call.
However, in a similar situation (where the current edit counter is greater than 2, so this code is reaching
-back into the edit history list): <code>(scale-channel 1.0 0 #f snd chn 2)</code>
+back into the edit history list): (scale-channel 1.0 0 #f snd chn 2)
Snd essentially copies the state of the channel at that edit position, and puts it in the current edit position.
There's never any good reason to do this, so if it looks like a no-op, do it a different way.
</p>
-</td></tr></table>
-
-<br>
-<!-- -------------------------------- SOUND AND CHANNEL TABLE -------------------------------- -->
+<!-- SOUND AND CHANNEL TABLE -->
+<div class="separator"></div>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
<!-- add-player -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="addplayer">add-player</a> player <em class=narg>start end edpos stop-proc out-chan</em></code>
-</td></tr><tr><td width=30></td><td>
-add-player adds 'player' to the play-list (see <a href="#makeplayer">make-player</a>).
+<pre class="indented">
+<em class=def id="addplayer">add-player</em> player start end edpos stop-proc out-chan
+</pre>
+
+<p>add-player adds 'player' to the play-list (see <a href="#makeplayer">make-player</a>).
If 'edpos' is given, play at that edit position.
'stop-proc' can be a procedure of one argument; it is called when the play process stops and passed
the reason the play is stopping; it will be 0 if the play completed normally (the other possibilities
@@ -6120,23 +6540,27 @@ The 'out-chan' argument is the audio output channel to send the data to; it defa
the channel number of the player's channel in the containing sound (that is, the default is to
send channel 1 data to channel 1 of the DAC, and so on).
See play-with-envs in enved.scm, play-syncd-marks in marks.scm, or start-dac in play.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- axis-info -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="axisinfo">axis-info</a> <em class=narg>snd chn grf</em></code>
-</td></tr><tr><td><br></td><td>
-axis-info returns a list describing the specified axis:
-<pre>
- (list left-sample right-sample
- x0 y0 x1 y1 x-min y-min x-max y-max
- x0-position y0-position x1-position y1-position y-offset
- xlabel ylabel new-peaks)
+<pre class="indented">
+<em class=def id="axisinfo">axis-info</em> snd chn grf
+</pre>
+
+<p>axis-info returns a list describing the specified axis:
+</p>
+
+<pre class="indented">
+(list left-sample right-sample
+ x0 y0 x1 y1 x-min y-min x-max y-max
+ x0-position y0-position x1-position y1-position y-offset
+ xlabel ylabel new-peaks)
</pre>
-This can be
+<p>This can be
useful if you're drawing arbitrary figures in a graph. 'grf' defaults to
-<code>time-graph</code>; the other choices are <code>transform-graph</code> and <code>lisp-graph</code>.
+time-graph; the other choices are transform-graph and lisp-graph.
'x0' is the time in seconds corresponding to the left-sample (the left edge of the graph).
Similarly 'y0' is the lower y axis limit as a sample value (i.e. -1.0).
'x-max' is the sound's duration in seconds ('x-min' is always 0.0).
@@ -6146,108 +6570,92 @@ several channels share one drawing area. You can use it to translate mouse coor
to channel number in that situation.
For example, <a href="#xtoposition">x->position</a>
could be:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (x->position-1 x snd chn)
- (let* ((axinfo (<em class=red>axis-info</em> snd chn <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_time_graph_tip)">time-graph</a>))
- (x0 (list-ref axinfo 2))
- (x1 (list-ref axinfo 4))
- (axis-left (list-ref axinfo 10))
- (axis-right (list-ref axinfo 12)))
+ (let* ((axinfo (<em class=red>axis-info</em> snd chn <a class=quiet>time-graph</a>))
+ (x0 (axinfo 2))
+ (x1 (axinfo 4))
+ (axis-left (axinfo 10))
+ (axis-right (axinfo 12)))
(floor
(+ axis-left
(* (- x x0)
(/ (- axis-right axis-left)
(- x1 x0)))))))
-</pre></td></tr></table>
+</pre>
-Here's a key binding that uses axis-info to save every channel's graph position upon "Page Down",
+<p>Here's a key binding that uses axis-info to save every channel's graph position upon "Page Down",
then restore that state upon "Page Up":
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> "Page_Down" 0
+<pre class="indented">
+(<a class=quiet href="#bindkey">bind-key</a> "Page_Down" 0
(lambda ()
(let ((last-page-state
(map (lambda (snd)
- (let ((data (list snd (<a class=quiet href="#filename" onmouseout="UnTip()" onmouseover="Tip(extsnd_filename_tip)">file-name</a> snd))))
- (do ((i 0 (+ 1 i)))
- ((= i (<a class=quiet href="#channels" onmouseout="UnTip()" onmouseover="Tip(extsnd_channels_tip)">channels</a> snd)) data)
+ (let ((data (list snd (<a class=quiet href="#filename">file-name</a> snd))))
+ (do ((i 0 (+ i 1)))
+ ((= i (<a class=quiet href="#channels">channels</a> snd)) data)
(set! data (append data (list (cons i (<em class=red>axis-info</em> snd i))))))))
- (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
- (<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> "Page_Up" 0
+ (<a class=quiet href="#sounds">sounds</a>))))
+ (<a class=quiet href="#bindkey">bind-key</a> "Page_Up" 0
(lambda ()
(if last-page-state
(for-each
(lambda (lst)
- (let ((snd (list-ref lst 0))
- (name (list-ref lst 1)))
- (if (and (<a class=quiet href="#soundp" onmouseout="UnTip()" onmouseover="Tip(extsnd_soundp_tip)">sound?</a> snd)
- (string=? (<a class=quiet href="#filename" onmouseout="UnTip()" onmouseover="Tip(extsnd_filename_tip)">file-name</a> snd) name))
+ (let ((snd (lst 0))
+ (name (lst 1)))
+ (if (and (<a class=quiet href="#soundp">sound?</a> snd)
+ (string=? (<a class=quiet href="#filename">file-name</a> snd) name))
(for-each
(lambda (chan-data)
- (let ((chn (list-ref chan-data 0))
- (x0 (list-ref chan-data 3))
- (x1 (list-ref chan-data 5))
- (y0 (list-ref chan-data 4))
- (y1 (list-ref chan-data 6)))
- (set! (<a class=quiet href="#xbounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_xbounds_tip)">x-bounds</a> snd chn) (list x0 x1))
- (set! (<a class=quiet href="#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a> snd chn) (list y0 y1))))
+ (let ((chn (chan-data 0))
+ (x0 (chan-data 3))
+ (x1 (chan-data 5))
+ (y0 (chan-data 4))
+ (y1 (chan-data 6)))
+ (set! (<a class=quiet href="#xbounds">x-bounds</a> snd chn) (list x0 x1))
+ (set! (<a class=quiet href="#ybounds">y-bounds</a> snd chn) (list y0 y1))))
(cddr lst)))))
last-page-state)))))))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</pre>
+<div class="separator"></div>
<!-- beats-per-measure -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="beatspermeasure">beats-per-measure</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-The x axis labelling of the time domain waveform can be in measures
-(<a class=quiet href="#xaxisstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_xaxisstyle_tip)">x-axis-style</a> = <code>x-axis-in-measures</code>); this variable sets the number of beats per measure.
+<pre class="indented">
+<em class=def id="beatspermeasure">beats-per-measure</em> snd chn
+</pre>
+
+<p>The x axis labelling of the time domain waveform can be in measures
+(<a class=quiet href="#xaxisstyle">x-axis-style</a> = x-axis-in-measures); this variable sets the number of beats per measure.
The default is 4.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- beats-per-minute -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="beatsperminute">beats-per-minute</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-The x axis labelling of the time domain waveform can be in beats
-(<a class=quiet href="#xaxisstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_xaxisstyle_tip)">x-axis-style</a> = <code>x-axis-in-beats</code>) or in measures
-(<code>x-axis-in-measures</code>); this variable sets the number of beats per minute.
-The default is 60.0, making it the same as <code>x-axis-in-seconds</code>.
-See <a href="#snpmark">snap-mark-to-beat</a>, or <a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
-
-<!-- bomb -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="bomb">bomb</a> <em class=narg>snd on</em></code>
-</td></tr><tr><td></td><td>
-bomb displays an exploding bomb icon next to 'snd's' name (in the minibuffer area). Set 'on' to #f to erase the bomb. Each time bomb
-is called, the bomb icon moves to the next image in its sequence (showing the bomb's fuse burning down),
-restarting the sequence whenever it reaches the end. This icon is used when a sound and its underlying file
-get out of sync somehow (<a href="#autoupdate">auto-update</a>).
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define show-bomb
- (lambda (n speed)
- (if (> n 0)
- (begin
- (<em class=red>bomb</em>)
- (<a class=quiet href="#gin" onmouseout="UnTip()" onmouseover="Tip(extsnd_gin_tip)">in</a> speed (lambda () (show-bomb (- n 1) speed))))
- (<em class=red>bomb</em> 0 #f))))
+<pre class="indented">
+<em class=def id="beatsperminute">beats-per-minute</em> snd chn
+</pre>
-(show-bomb 15 200) ; there are 15 images in the sequence
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<p>The x axis labelling of the time domain waveform can be in beats
+(<a class=quiet href="#xaxisstyle">x-axis-style</a> = x-axis-in-beats) or in measures
+(x-axis-in-measures); this variable sets the number of beats per minute.
+The default is 60.0, making it the same as x-axis-in-seconds.
+See <a href="#snpmark">snap-mark-to-beat</a>, or <a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a>.
+</p>
+<div class="separator"></div>
<!-- channel-amp-envs -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="channelampenvs">channel-amp-envs</a> <em class=narg>file chan size peak-file-func work-proc-func</em></code>
-</td></tr><tr><td></td><td>
-channel-amp-envs returns two vcts of length 'size' containing the peak-amp envelopes of the channel 'chan' of file 'file'.
+<pre class="indented">
+<em class=def id="channelampenvs">channel-amp-envs</em> file chan size peak-file-func work-proc-func
+</pre>
+
+<p>channel-amp-envs returns two vcts of length 'size' containing the peak-amp envelopes of the channel 'chan' of file 'file'.
'peak-file-func' (if any) is used to get the name of the associated peak-env file if the file is very large.
'work-proc-func' is called when the amp envs are ready if the amp envs are gathered in the background.
If 'file' is a sound, 'size' is an edit-position, and the current amp envs (if any) are returned.
@@ -6255,304 +6663,339 @@ The arguments to 'peak-file-func' are the file and the channel. If it returns a
to read to get the peak info. The arguments to 'work-proc-func' are the filename, the channel and the current peak.
make-sound-icon in <a href="sndscm.html#makesoundbox">make-sound-box</a> in snd-motif.scm uses
this function to draw the little thumbnail graph for each sound icon.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- channel-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="channeldata">channel-data</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-channel-data provides very low-level access to the data currently in the given channel's sample buffers.
+<pre class="indented">
+<em class=def id="channeldata">channel-data</em> snd chn
+</pre>
+
+<p>channel-data provides very low-level access to the data currently in the given channel's sample buffers.
It is used by the <a href="sndscm.html#variabledisplay">variable-display</a> mechanism to show graphs
of variable values (normally in an instrument). channel-data only works with sounds returned
by make-variable-display, and only in a float-sample version of Snd (i.e. not one that was built with
the configure argument --without-float-samples). See make-variable-display in snd-motif.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- channel-properties -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="channelproperties">channel-properties</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-channel-properties is a property list associated with a channel. It is set to '() at the time a sound is opened, so
+<pre class="indented">
+<em class=def id="channelproperties">channel-properties</em> snd chn
+</pre>
+
+<p>channel-properties is a property list associated with a channel. It is set to () at the time a sound is opened, so
it provides a relatively simple way to save data about a channel which will automatically be erased when the channel is closed.
<a href="#channelproperty">channel-property</a> reads and writes this list.
-<br><br>
-Traditionally in Lisp, a property list has been treated as an association list. This is a list
+</p>
+
+<p>Traditionally in Lisp, a property list has been treated as an association list. This is a list
of pairs (made by cons), each inner pair having a key as its first element, and the associated value as the second element.
The function <b>assoc</b> can be used to search the list for a given key's value; a new key-value pair can be
added with:
-<pre>
- (cons (cons key value) a-list)
+</p>
+
+<pre class="indented">
+(cons (cons key value) a-list)
</pre>
-In Common Lisp, property lists have other properties, so to speak, but channel-properties (and
+
+<p>In Common Lisp, property lists have other properties, so to speak, but channel-properties (and
<a href="#soundproperties">sound-properties</a>) can be handled in any way you like.
See <a href="sndscm.html#channelsync">channel-sync</a> in extensions.scm for a brief example; more
elaborate examples are in enved.scm (enved-envelope), or draw.scm (colored-samples and insert-envelope).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- channel-property -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="channelproperty">channel-property</a> key snd chn</code>
-</td></tr><tr><td></td><td>
-channel-property returns the value associated with 'key' in the given channel's
+<pre class="indented">
+<em class=def id="channelproperty">channel-property</em> key snd chn
+</pre>
+
+<p>channel-property returns the value associated with 'key' in the given channel's
<a href="extsnd.html#channelproperties">property list</a>. To add or change a property, use set! with this procedure.
-<pre>
- Scheme:
- :<em class=typing>(set! (channel-property 'info 0 0) "this is sound 0, first channel")</em>
- <em class=listener>"this is sound 0, first channel"</em>
- :<em class=typing>(channel-property 'info 0 0)</em>
- <em class=listener>"this is sound 0, first channel"</em>
-
- Ruby:
- ><em class=typing>set_channel_property(:info, "this is info", 0, 0)</em>
- <em class=listener>this is info</em>
- ><em class=typing>channel_property(:info, 0, 0)</em>
- <em class=listener>this is info</em>
-
- Forth:
- ><em class=typing>'info "this is info" 0 0 set-channel-property</em>
- <em class=listener>'( '( 'info . this is info ) )</em>
- ><em class=typing>'info 0 0 channel-property</em>
- <em class=listener>this is info</em>
-</pre>
-The property list is convenient because the associated information goes away automatically
+</p>
+
+<pre class="indented">
+Scheme:
+> (set! (channel-property 'info 0 0) "this is sound 0, first channel")
+"this is sound 0, first channel"
+> (channel-property 'info 0 0)
+"this is sound 0, first channel"
+
+Ruby:
+>set_channel_property(:info, "this is info", 0, 0)
+this is info
+>channel_property(:info, 0, 0)
+this is info
+
+Forth:
+>'info "this is info" 0 0 set-channel-property
+'( '( 'info . this is info ) )
+>'info 0 0 channel-property
+this is info
+</pre>
+
+<p>The property list is convenient because the associated information goes away automatically
when the channel is closed, and the property lists are saved by <a href="extsnd.html#savestate">save-state</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- channel-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="channelstyle">channel-style</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-channel-style reflects the value of the '<a href="snd.html#unitebutton">unite</a>' button in multichannel files.
-Possible values are <code>channels-separate</code>, <code>channels-combined</code> (the default), and <code>channels-superimposed</code>.
+<pre class="indented">
+<em class=def id="channelstyle">channel-style</em> snd
+</pre>
+
+<p>channel-style reflects the value of the '<a href="snd.html#unitebutton">unite</a>' button in multichannel files.
+Possible values are channels-separate, channels-combined (the default), and channels-superimposed.
The following code sets the 'unite' button if the current sound has more than 4 channels:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(hook-push <a class=quiet href="#afteropenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afteropenhook_tip)">after-open-hook</a>
- (lambda (snd)
- (if (> (<a class=quiet href="#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a> snd) 4)
- (set! (<em class=red>channel-style</em> snd) <a class=quiet href="#channelstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelstyle_tip)">channels-combined</a>))))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+(hook-push <a class=quiet href="#afteropenhook">after-open-hook</a>
+ (lambda (hook)
+ (if (> (<a class=quiet href="#chans">channels</a> (hook 'snd)) 4)
+ (set! (<em class=red>channel-style</em> (hook 'snd)) <a class=quiet href="#channelstyle">channels-combined</a>))))
+</pre>
+<div class="separator"></div>
<!-- channel->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="channeltovct">channel->vct</a> <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-channel->vct returns a vct with the specified data. In Ruby, the "->" in a function name is translated to "2",
+<pre class="indented">
+<em class=def id="channeltovct">channel->vct</em> beg dur snd chn edpos
+</pre>
+
+<p id="selection2vct">channel->vct returns a vct with the specified data. In Ruby, the "->" in a function name is translated to "2",
so the function call is:
-<pre> v = channel2vct(0, 100)
+</p>
+
+<pre class="indented"> v = channel2vct(0, 100)
</pre>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-<A NAME="selection2vct"></a>(define* (selection->vct snd chn)
- (if (<a class=quiet href="#selectionmember" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionmember_tip)">selection-member?</a> snd chn)
- (<em class=red>channel->vct</em> (<a class=quiet href="#selectionposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionposition_tip)">selection-position</a> snd chn)
- (<a class=quiet href="#selectionframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionframes_tip)">selection-frames</a> snd chn)
+<pre class="indented">
+(define* (selection->vct snd chn)
+ (if (<a class=quiet href="#selectionmember">selection-member?</a> snd chn)
+ (<em class=red>channel->vct</em> (<a class=quiet href="#selectionposition">selection-position</a> snd chn)
+ (<a class=quiet href="#selectionframples">selection-framples</a> snd chn)
snd chn)
- (if (<a class=quiet href="#selectionok" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionok_tip)">selection?</a>)
- (throw 'no-such-channel
+ (if (<a class=quiet href="#selectionok">selection?</a>)
+ (error 'no-such-channel
(list "selection->vct"
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "snd ~A channel ~D is not a member of the selection" snd chn)))
- (throw 'no-active-selection (list "selection->vct")))))
-</pre></td></tr></table>
-See also mark-explode in marks.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+ (<a class=quiet>format</a> #f "snd ~A channel ~D is not a member of the selection" snd chn)))
+ (error 'no-active-selection (list "selection->vct")))))
+</pre>
+
+<p>See also mark-explode in marks.scm.
+</p>
+<div class="separator"></div>
<!-- channels -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="channels">channels</a> <em class=narg>snd</em></code>
-<br><code><a class=def name="chans">chans</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This function returns the number of channels in 'snd'. It can be set, but the result is a new
+<pre class="indented">
+<em class=def id="channels">channels</em> snd
+<em class=def id="chans">chans</em> snd
+</pre>
+
+<p>This function returns the number of channels in 'snd'. It can be set, but the result is a new
version of the underlying sound with the header changed to reflect the new number of channels.
That is, no new data is created, but the existing data is reapportioned to the new channels:
-<code>(set! (channels) 2)</code>; this is not undo-able (except by calling it again with the
+(set! (channels) 2); this is not undo-able (except by calling it again with the
original number of channels — the data is not touched).
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
-
-<!-- clear-minibuffer -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="clearminibuffer">clear-minibuffer</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This clears the sound's minibuffer area (both the text and the error message widgets).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- clm-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="clmchannel">clm-channel</a> clm-gen <em class=narg>beg dur snd chn edpos overlap origin</em></code>
-</td></tr><tr><td></td><td>
-clm-channel applies 'clm-gen' to the given channel starting
+<pre class="indented">
+<em class=def id="clmchannel">clm-channel</em> clm-gen beg dur snd chn edpos overlap origin
+</pre>
+
+<p>clm-channel applies 'clm-gen' to the given channel starting
at sample 'beg' for 'dur' samples, and 'overlap' samples of 'ring time'.
-This is used by some of the <a class=quiet href="#regularizedargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_regularizedargs_tip)">regularized</a> functions, but it can also be used directly:
+This is used by some of the <a class=quiet href="#regularizedargs">regularized</a> functions, but it can also be used directly:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define* (convolve-channel kernel nbeg ndur nsnd nchn nedpos)
(let* ((beg (or nbeg 0))
- (snd (or nsnd (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (car (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
- (chn (or nchn (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>)))
- (dur (or ndur (- (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd chn) beg)))
+ (snd (or nsnd (<a class=quiet href="#selectedsound">selected-sound</a>) (car (<a class=quiet href="#sounds">sounds</a>))))
+ (chn (or nchn (<a class=quiet href="#selectedchannel">selected-channel</a>)))
+ (dur (or ndur (- (<a class=quiet href="#framples">framples</a> snd chn) beg)))
(edpos (or nedpos current-edit-position))
- (reader (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> beg snd chn 1 edpos))
- (cgen (<a class=quiet href="sndclm.html#make-convolve" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_convolve_tip)">make-convolve</a> :filter kernel
+ (reader (<a class=quiet href="#makesampler">make-sampler</a> beg snd chn 1 edpos))
+ (cgen (<a class=quiet href="sndclm.html#make-convolve">make-convolve</a> :filter kernel
:input (lambda (dir)
- (<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> reader)))))
+ (<a class=quiet href="#readsample">read-sample</a> reader)))))
(<em class=red>clm-channel</em> cgen beg dur snd chn edpos)
- (<a class=quiet href="#freesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_freesampler_tip)">free-sampler</a> reader)))
+ (<a class=quiet href="#freesampler">free-sampler</a> reader)))
-(define (difference) (<em class=red>clm-channel</em> (<a class=quiet href="sndclm.html#make-two-zero" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_two_zero_tip)">make-two-zero</a> 1 -1)))
-(define (wobble) (<em class=red>clm-channel</em> (<a class=quiet href="sndclm.html#make-ncos" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_ncos_tip)">make-ncos</a> 50 3)))
-(define (hold-nose) (<em class=red>clm-channel</em> (<a class=quiet href="sndclm.html#make-ncos" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_ncos_tip)">make-ncos</a> 1 3)))
-(define (bad-reception) (<em class=red>clm-channel</em> (<a class=quiet href="sndclm.html#make-ncos" onmouseout="UnTip()" onmouseover="Tip(sndclm_ncos_tip)">make-ncos</a> 10 5)))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+(define (difference) (<em class=red>clm-channel</em> (<a class=quiet href="sndclm.html#make-two-zero">make-two-zero</a> 1 -1)))
+(define (wobble) (<em class=red>clm-channel</em> (<a class=quiet href="sndclm.html#make-ncos">make-ncos</a> 50 3)))
+(define (hold-nose) (<em class=red>clm-channel</em> (<a class=quiet href="sndclm.html#make-ncos">make-ncos</a> 1 3)))
+(define (bad-reception) (<em class=red>clm-channel</em> (<a class=quiet href="sndclm.html#make-ncos">make-ncos</a> 10 5)))
+</pre>
+<div class="separator"></div>
<!-- close-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="closesound">close-sound</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This closes 'snd' (the same as the File:Close menu item). To close all sounds:
-<pre>
- (close-sound #t)
- ;; equivalent to:
- (for-each close-sound (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))
+<pre class="indented">
+<em class=def id="closesound">close-sound</em> snd
+</pre>
+
+<p>This closes 'snd' (the same as the File:Close menu item). To close all sounds:
+</p>
+
+<pre class="indented">
+(close-sound #t)
+;; equivalent to:
+(for-each close-sound (<a class=quiet href="#sounds">sounds</a>))
</pre>
-Before the sound is actually closed, <a class=quiet href="#beforeclosehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_beforeclosehook_tip)">before-close-hook</a>
-is called, then <a class=quiet href="#closehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_closehook_tip)">close-hook</a>,
+
+<p>Before the sound is actually closed, <a class=quiet href="#beforeclosehook">before-close-hook</a>
+is called, then <a class=quiet href="#closehook">close-hook</a>,
then the sound is closed.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- comment -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="comment">comment</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This returns the sound's comment, if any; when a sound is opened, the comment is taken from the file's header
+<pre class="indented">
+<em class=def id="comment">comment</em> snd
+</pre>
+
+<p>This returns the sound's comment, if any; when a sound is opened, the comment is taken from the file's header
(the same as <a href="#mussoundcomment">mus-sound-comment</a>). If you set it, the header is not updated until the sound is saved.
If the new comment is the only change you want to make, you can save the new header via the Edit:Edit Header menu option.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- main-index |convolvewith:convolution reverb -->
<!-- convolve-with -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="convolvewith">convolve-with</a> file <em class=narg>amp snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This convolves the given channel (or the currently sync'd data)
+<pre class="indented">
+<em class=def id="convolvewith">convolve-with</em> file amp snd chn edpos
+</pre>
+
+<p>This convolves the given channel (or the currently sync'd data)
with the data in the sound file 'file'. 'amp' is the resultant
peak amplitude (leave 'amp' unset, or set it to #f to get the
unnormalized result).
Convolve-with in conjunction with mix can provide high-quality reverb:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define conrev
(lambda (impulse amp)
(<em class=red>convolve-with</em> impulse amp)
- (<a class=quiet href="#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a> "reverb.snd") ;let mix scalers set reverb amount
- (<a class=quiet href="#revertsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_revertsound_tip)">revert-sound</a>)
+ (<a class=quiet href="#savesoundas">save-sound-as</a> "reverb.snd") ;let mix scalers set reverb amount
+ (<a class=quiet href="#revertsound">revert-sound</a>)
(<em class=red>mix</em> "reverb.snd")))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</pre>
+<div class="separator"></div>
<!-- count-matches -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="countmatches">count-matches</a> proc <em class=narg>sample snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This returns how many samples satisfy the function 'proc'; 'proc' should
+<pre class="indented">
+<em class=def>count-matches</em> proc sample snd chn edpos
+</pre>
+
+<p>count-matches returns how many samples satisfy the function 'proc'; 'proc' should
take one argument (the current sample value), and return #t for a hit. 'sample'
determines where to start the search.
-<pre>
- Scheme: (count-matches (lambda (y) (> y .1)))
-
- Ruby: count_matches(lambda do |y| y > 0.1 end)
+</p>
- Forth: lambda: <{ y }> y 0.1 f- f0< ; count-matches
+<pre class="indented">
+Scheme: (count-matches (lambda (y) (> y .1)))
+Ruby: count_matches(lambda do |y| y > 0.1 end)
+Forth: lambda: <{ y }> y 0.1 f- f0< ; count-matches
</pre>
-count-matches is modelled after Emacs. It could be defined along these lines:
+<p>count-matches is obsolete; use a do loop and a sampler:
+</p>
+
+<pre class="indented">
+(define* (count-matches func (beg 0) snd chn edpos)
+ (let ((end (framples snd chn edpos))
+ (matches 0)
+ (reader (make-sampler beg snd chn 1 edpos)))
+ (do ((i beg (+ i 1)))
+ ((= i end) matches)
+ (if (func (next-sample reader))
+ (set! matches (+ matches 1))))))
+</pre>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (count-matches proc)
- (let ((count 0))
- (<a class=quiet href="#scanchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_scanchannel_tip)">scan-channel</a>
- (lambda (y)
- (if (proc y) (set! count (+ count 1)))
- #f))
- count))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- cursor -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="cursor">cursor</a> <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This returns the cursor location (as a sample number; the first sample is numbered 0) in channel 'chn' of 'snd'.
+<pre class="indented">
+<em class=def id="cursor">cursor</em> snd chn edpos
+</pre>
+
+<p id="cursorexamples">This returns the cursor location (as a sample number; the first sample is numbered 0) in channel 'chn' of 'snd'.
<code>(set! (cursor) 100)</code> moves the cursor to sample 100. The cursor is somewhat similar to a
-mark in that it moves if you delete or insert samples in front of it.
+mark in that it moves if you delete or insert samples in front of it. To turn the cursor off, set
+it to some negative number.
+</p>
<!-- INDEX cursorexamples:Cursors -->
-<A NAME="cursorexamples"></a>
-<br>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
+<TABLE class="method">
+<tr><th class="title">Cursor</th></tr>
+<tr><td>
<blockquote><small>
-<br>
-Tracking cursor: <a href="#withtrackingcursor">with-tracking-cursor</a> (cursor-follows-play was the old name)<br>
-Change cursor shape or size: <a href="#cursorstyle">cursor-style</a>, <a href="#cursorsize">cursor-size</a><br>
+Tracking cursor: <a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a><br>
+Change cursor shape or size: <a href="extsnd.html#cursorstyle">cursor-style</a>, <a href="extsnd.html#cursorsize">cursor-size</a><br>
Cursor moving keys: <a href="snd.html#movecursor">Moving the Cursor</a><br>
-Display data about sample under cursor: <a href="#withverbosecursor">with-verbose cursor</a><br>
-<br>
+Display data about sample under cursor: <a href="extsnd.html#withverbosecursor">with-verbose-cursor</a><br>
+play from the current cursor position with a tracking cursor: <a href="extsnd.html#pfc">pfc</a><br>
+display tracking cursor as a full height vertical line: <a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a><br>
+track play once: control-click 'play'. (You can add a mark at the current tracking cursor location during the play with C-m)<br>
+leave the cursor at the final position after tracking play: (set! *with-tracking-cursor* :track-and-stay)<br>
+tracking cursor accuracy: <a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a><br>
+tracking cursor updating: <a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a><br>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
+<div class="separator"></div>
-<!-- cursor-follows-play -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="cursorfollowsplay">cursor-follows-play</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This is #t if the cursor is following along in the sound as it plays. The new name of this variable
-is <a href="#withtrackingcursor">with-tracking-cursor</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
<!-- cursor-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="cursorposition">cursor-position</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This gives the current cursor position as a list (x y).
+<pre class="indented">
+<em class=def id="cursorposition">cursor-position</em> snd chn
+</pre>
+
+<p>This gives the current cursor position as a list (x y).
These graph-relative values can be turned into axis-relative values with
<a href="#positiontox">position->x</a> and <a href="#positiontoy">position->y</a>:
-<pre>
- (<a class=quiet href="#positiontox" onmouseout="UnTip()" onmouseover="Tip(extsnd_positiontox_tip)">position->x</a> (car (cursor-position)))
- ;; equals:
- (/ (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#positiontox">position->x</a> (car (cursor-position)))
+;; equals:
+(/ (<a class=quiet href="#cursor">cursor</a>) (<a class=quiet href="#srate">srate</a>))
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- cursor-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="cursorsize">cursor-size</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This gives the cursor size in pixels; it defaults to 15. <code>(set! (cursor-size) 30)</code> makes the cursor twice as big as usual.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="cursorsize">cursor-size</em> snd chn
+</pre>
+
+<p>This gives the cursor size in pixels; it defaults to 15. (set! (cursor-size) 30) makes the cursor twice as big as usual.
+</p>
+<div class="separator"></div>
<!-- cursor-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="cursorstyle">cursor-style</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-The cursor style is <code>cursor-cross</code>, <code>cursor-line</code>, or a cursor-drawing function.
+<pre class="indented">
+<em class=def id="cursorstyle">cursor-style</em> snd chn
+</pre>
+
+<p id="xcursor">The cursor style is cursor-cross, cursor-line, or a cursor-drawing function.
The default cursor shape is a "+" sign; the cursor-line is a vertical line.
As a function, cursor-style is a procedure of three arguments, the
sound, channel number, and a boolean that is true if the cursor is currently
@@ -6562,199 +7005,138 @@ should draw the cursor at the current cursor position using the
<a href="#cursorcontext">cursor-context</a>.
Here is a simpler one that
replaces the normal "+" cursor with an "x":
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (<A NAME="xcursor">x-cursor</a> snd chn ax)
+<pre class="indented">
+(define (x-cursor snd chn ax)
(let* ((point (<em class=red>cursor-position</em>))
(x (car point))
(y (cadr point))
(size (<em class=red>cursor-size</em>))
(cr (make-cairo (car (channel-widgets snd chn))))) ; needed in Gtk, ignored in Motif
- (<a class=quiet href="#drawline" onmouseout="UnTip()" onmouseover="Tip(extsnd_drawline_tip)">draw-line</a> (- x size) (- y size) (+ x size) (+ y size) snd chn <em class=red>cursor-context</em> cr)
- (<a class=quiet href="#drawline" onmouseout="UnTip()" onmouseover="Tip(extsnd_drawline_tip)">draw-line</a> (- x size) (+ y size) (+ x size) (- y size) snd chn <em class=red>cursor-context</em> cr)
+ (<a class=quiet href="#drawline">draw-line</a> (- x size) (- y size) (+ x size) (+ y size) snd chn <em class=red>cursor-context</em> cr)
+ (<a class=quiet href="#drawline">draw-line</a> (- x size) (+ y size) (+ x size) (- y size) snd chn <em class=red>cursor-context</em> cr)
(free-cairo cr)))
(set! (<em class=red>cursor-style</em>) x-cursor)
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
-
-<!-- data-format -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="dataformat">data-format</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This returns the sound's data format — the encoding used for the sound samples (e.g. mus-bshort).
-
-<br><br>
-The standard formats nowadays are <code>mus-bshort</code> (big-endian 16-bit integers), <code>mus-bfloat</code>
-(32-bit big-endian floats), and <code>mus-bint</code> (32-bit big-endian integers), and the
-corresponding little-endian versions: <code>mus-lshort</code>, <code>mus-lfloat</code>, and <code>mus-lint</code>.
-If you're using an Intel-style PC, you're using a little-endian machine;
-Old macs (PowerPC Macs) and Suns use big-endian (NeXT, SGI, and Atari also used it in the good old days). If you
-write a Next file and use little-endian data, some programs other than Snd
-may complain; similarly, RIFF wants little-endian and AIFC wants big-endian
-data (both can handle the other kind, but most sound-related programs don't know
-that). In the old days, when disk space was at a premium, 8-bit formats
-were used a lot: <code>mus-mulaw</code> and <code>mus-alaw</code> (kludges for a kind of 8-bit float),
-<code>mus-byte</code> and <code>mus-ubyte</code> (8-bit ints, unsigned in the latter case). A few
-DACs want a particular kind of data, but Snd handles that conversion internally.
-Anything less than 12 bits will sound bad — Perry Cook's book "Real Sound Synthesis"
-has examples.
-
-<br><br>
-If you encounter a file
-with an unknown format, or a header that has the wrong format,
-you can set this field to force Snd to interpret the data in any
-way you like. Similar remarks apply to the <a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>, <a class=quiet href="#datalocation" onmouseout="UnTip()" onmouseover="Tip(extsnd_datalocation_tip)">data-location</a>,
-<a class=quiet href="#headertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_headertype_tip)">header-type</a>, and <a class=quiet href="#channels" onmouseout="UnTip()" onmouseover="Tip(extsnd_channels_tip)">channels</a> fields. There are ambiguities in some header
-specifications, usually involving big/little endian or signed/unsigned data confusion.
-If you encounter a sound that is clipping crazily or is just a burst of noise, try changing these settings.
-Some NeXT/Sun (au) header files using byte-wide data
-assume the byte is unsigned, whereas most others assume it is signed. Sndlib
-treats it as signed by default, so to make one of the unsigned-byte files playable,
-<pre>
- (set! (data-format) <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_dataformat_tip)">mus-ubyte</a>)
</pre>
-mus_float_t data is another source of confusion;
-there is apparently no agreement on whether the data is between -1.0 and 1.0, or -32768.0 and 32767.0 or anything else.
-In this case, Snd assumes -1.0 to 1.0 (except in one special case involving IRCAM headers), and you may have to
-set <a class=quiet href="#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a> to see the actual data.
-Yet another gotcha: files with 32-bit integers. Some programs (Glame, apparently, and perhaps Ardour) assume the fraction is
-31 bits wide, others (Snd) use whatever its sample width is configured to be; there is no correct or standard
-placement of the fixed point, but not to worry! Your data is ok:
-<code>(set! (<a class=quiet href="#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a>) (list -256.0 256.0))</code>. There are several ways you can handle
-these files automatically in Snd. Perhaps the simplest is to use one of the open hooks:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(hook-push <a class=quiet href="#afteropenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afteropenhook_tip)">after-open-hook</a>
- (lambda (snd)
- ;; this could also (alternatively) set the y-bounds as above
- (if (= (<em class=red>data-format</em> snd) mus-lint)
- (set! (<em class=red>data-format</em> snd) mus-lintn))))
-</pre></td></tr></table>
-
-or (an alternative that sets the underlying database entry, rather than the current in-Snd choice):
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(hook-push <a class=quiet href="#openhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_openhook_tip)">open-hook</a>
- (lambda (name)
- (if (= (<a class=quiet href="#mussounddataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussounddataformat_tip)">mus-sound-data-format</a> name) mus-lint)
- (set! (<a class=quiet href="#mussounddataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussounddataformat_tip)">mus-sound-data-format</a> name) mus-lintn))
- #f))
-</pre></td></tr></table>
-
-If you set any of these fields, the sound's index may change (there can be an embedded <a class=quiet href="#updatesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_updatesound_tip)">update-sound</a>).
-To deal with MPEG, OGG, Flac, or Speex files, see examp.scm (<a class=quiet href="sndscm.html#mpg" onmouseout="UnTip()" onmouseover="Tip(sndscm_mpg_tip)">mpg</a>) or misc.scm (mpg123 and ogg123).
-Octave/WaveLab ASCII files can be translated by read-ascii (examp.scm).
-<br><br>
-To turn a data-format number into a string, use <a href="#musdataformatname">mus-data-format-name</a>. To get
-the data format of some sound file, use <a href="#mussounddataformat">mus-sound-data-format</a>.
-The default output (<a class=quiet href="#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a>, and
-<a class=quiet href="#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a>) data-format is <a href="#defaultoutputdataformat">default-output-data-format</a>.
-To change a sound file's data-format, use <a href="#savesoundas">save-sound-as</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- data-location -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="datalocation">data-location</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This gives the location (in bytes) of the sound samples in the file represented by 'snd'. In a raw (headerless) file,
+<pre class="indented">
+<em class=def id="datalocation">data-location</em> snd
+</pre>
+
+<p>This gives the location (in bytes) of the sound samples in the file represented by 'snd'. In a raw (headerless) file,
this is 0, but normally the data comes after some portion of the header.
To get the data-location of some sound file, use <a href="#mussounddatalocation">mus-sound-data-location</a>.
If you set this field (you don't want to do this — it is a law of nature that you will forget the original setting!), the underlying file is immediately rewritten.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- data-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="datasize">data-size</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This gives the size (in bytes) of the sound data in the file represented by 'snd'.
+<pre class="indented">
+<em class=def id="datasize">data-size</em> snd
+</pre>
+
+<p>This gives the size (in bytes) of the sound data in the file represented by 'snd'.
If you set this field, the underlying file is immediately rewritten (the header is changed; I don't
think the file is truncated, but no matter what happens, it is not my fault).
Next/Sun files treat the size field as purely "advisory", so an incorrect data size is often
ignored in that case.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- delete-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="deletesample">delete-sample</a> samp <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This deletes sample 'samp' in the given channel.
+<pre class="indented">
+<em class=def id="deletesample">delete-sample</em> samp snd chn edpos
+</pre>
+
+<p id="deletionexamples">This deletes sample 'samp' in the given channel.
+</p>
<!-- INDEX deletionexamples:Deletions -->
-<A NAME="deletionexamples"></a>
-<br><br>
-<TABLE border=3 bordercolor="tan" hspace=20><tr><td>
-<small><blockquote>
-delete a file: use the Scheme function delete-file, Ruby's File.delete, or Forth's file-delete<br>
-delete a region: <a href="#forgetregion">forget-region</a><br>
-delete the currently selected samples: <a href="#deleteselection">delete-selection</a><br>
-delete the selection and smooth the splice: <a href="#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
-delete a mark or all marks: <a href="#deletemark">delete-mark</a><br>
-delete a colormap: <a href="#deletecolormap">delete-colormap</a><br>
-delete samples: <a href="#deletesamples">delete-samples</a><br>
+<TABLE class="method">
+<tr><th class="title">Deletions</th></tr><tr><td>
+<blockquote><small>
+delete a file: in scheme delete-file or Ruby's File.delete<br>
+delete a region: <a href="extsnd.html#forgetregion">forget-region</a><br>
+delete the currently selected samples: <a href="extsnd.html#deleteselection">delete-selection</a><br>
+delete the selection and smooth the splice: <a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
+delete a mark or all marks: <a href="extsnd.html#deletemark">delete-mark</a><br>
+delete a colormap: <a href="extsnd.html#deletecolormap">delete-colormap</a><br>
+delete samples: <a href="extsnd.html#deletesamples">delete-samples</a><br>
delete samples and smooth over the splice: <a href="#deletesamplesandsmooth">delete-samples-and-smooth</a><br>
-remove a file from the sound cache: <a href="#mussoundforget">mus-sound-forget</a><br>
-remove a menu item: <a href="#removefrommenu">remove-from-menu</a> or remove-main-menu in snd-motif.scm<br>
+remove a file from the sound cache: <a href="extsnd.html#mussoundforget">mus-sound-forget</a><br>
+remove a menu item: <a href="extsnd.html#removefrommenu">remove-from-menu</a> or remove-main-menu in snd-motif.scm<br>
delete a mix or all mixes: <a href="sndscm.html#silenceallmixes">silence-mixes</a><br>
add a 'delete' option to the file selection dialog: <a href="sndscm.html#adddeleteoption">add-delete-option</a><br>
Scheme delete funcs: remove-if assoc-remove! hash-remove! delete-if! delete! string-delete<br>
-<br>
-</blockquote></small>
+</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
+
<!-- delete-samples -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="deletesamples">delete-samples</a> samp samps <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This deletes a block of samples. The deleted portion starts at sample 'samp' and runs for 'samps' samples.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="deletesamples">delete-samples</em> samp samps snd chn edpos
+</pre>
+
+<p>This deletes a block of samples. The deleted portion starts at sample 'samp' and runs for 'samps' samples.
+</p>
+<div class="separator"></div>
<!-- delete-samples-and-smooth -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="deletesamplesandsmooth">delete-samples-and-smooth</a> samp samps <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This deletes a block of samples, then tries to smooth over the splice. The deleted portion starts at sample 'samp' and runs for 'samps' samples.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="deletesamplesandsmooth">delete-samples-and-smooth</em> samp samps snd chn edpos
+</pre>
+
+<p>This deletes a block of samples, then tries to smooth over the splice. The deleted portion starts at sample 'samp' and runs for 'samps' samples.
+</p>
+<div class="separator"></div>
<!-- dot-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="dotsize">dot-size</a> <em class=narg>snd chn</em></code>
-</td></tr>
-<tr><td></td><td>
-This gives the size in pixels of dots when graphing with dots (default: 1); this affects <a href="#graphstyle">graph-styles</a> such as <code>graph-lollipops</code>. See <a href="#graphhook">graph-hook</a> or auto-dot in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="dotsize">dot-size</em> snd chn
+</pre>
+
+<p>This gives the size in pixels of dots when graphing with dots (default: 1); this affects <a href="#graphstyle">graph-styles</a> such as graph-lollipops. See <a href="#graphhook">graph-hook</a> or auto-dot in examp.scm.
+</p>
+<div class="separator"></div>
<!-- env-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="envchannel">env-channel</a> clm-env-gen <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-env-channel is the <a class=quiet href="#regularizedargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_regularizedargs_tip)">regularized</a> version of <a href="#envsound">env-sound</a>. 'clm-env-gen'
+<pre class="indented">
+<em class=def id="envchannel">env-channel</em> clm-env-gen beg dur snd chn edpos
+</pre>
+
+<p id="envexamples">env-channel is the <a class=quiet href="#regularizedargs">regularized</a> version of <a href="#envsound">env-sound</a>. 'clm-env-gen'
can be either a CLM envelope generator or an envelope (a list of breakpoints). <code>(env-channel '(0 0 1 1 2 0))</code>.
To get .1 seconds of attack and decay:
-<pre>
- (let ((dur (/ (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))))
- (<em class=red>env-channel</em> (list 0 0 .1 1 (- dur .1) 1 dur 0)))
+</p>
+
+<pre class="indented">
+(let ((dur (/ (<a class=quiet href="#framples">framples</a>) (<a class=quiet href="#srate">srate</a>))))
+ (<em class=red>env-channel</em> (list 0 0 .1 1 (- dur .1) 1 dur 0)))
</pre>
-<A NAME="envexamples"></a>
+<p>
An envelope in Snd is a list of breakpoints. It can be packaged as a CLM generator (an 'env') via <a href="sndclm.html#make-env">make-env</a>.
-It can be declared via define just like any other variable, or with <a href="#defvar">defvar</a> (for CLM/Snd intercompatibility),
-or with <a href="#defineenvelope">define-envelope</a>.
+It can be declared via define just like any other variable, or with <a href="#defineenvelope">define-envelope</a>.
+</p>
+
+
<!-- INDEX envexamples:Envelopes -->
-<br><br>
-<TABLE border=3 bordercolor="tan" hspace=20><tr><td>
+<TABLE class="method">
+<tr><th class="title">Envelopes</th></tr><tr><td>
<blockquote><small>
-<br>
-envelopes in Snd:<br>
envelope sound: <a href="#envchannel">env-channel</a>, <a href="#envsound">env-sound</a><br>
Other enveloping functions: <a href="#rampchannel">ramp-channel</a>, <a href="#xrampchannel">xramp-channel</a>, <a href="#smoothchannel">smooth-channel</a><br>
The CLM env generator: <a href="sndclm.html#make-env">env</a>, many examples in examp.scm, new-effects.scm, etc<br>
@@ -6764,55 +7146,60 @@ Panning: place-sound in examp.scm<br>
Envelope over mix: <a href="sndscm.html#envelopedmix">enveloped-mix</a><br>
Local envelope editor: <a href="sndscm.html#enveddoc">enved.scm</a>, xm-enved.scm<br>
Read sound indexed through envelope: <a href="sndscm.html#envsoundinterp">env-sound-interp</a><br>
-Cosine as envelope: <a href="#cosinechannel">cosine-channel</a>, <a href="#cosinechannelviaptree">cosine-channel-via-ptree</a>, <a href="sndclm.html#bellcurve">bell-curve</a><br>
+Cosine as envelope: <a href="#cosinechannel">cosine-channel</a>, <a href="sndclm.html#bellcurve">bell-curve</a><br>
envelope with sinusoidal connections between points: <a href="sndscm.html#sineenvchannel">sine-env-channel</a><br>
-envelope with separate base for each segment: <a href="#powenvchannel">powenv-channel</a><br>
+envelope with separate base for each segment: <a href="sndscm.html#powenvchannel">powenv-channel</a><br>
envelope with x^2 connections: <a href="sndscm.html#envsquaredchannel">env-squared-channel</a><br>
envelope with x^n connections: <a href="sndscm.html#envexptchannel">env-expt-channel</a><br>
envelope with <a href="sndclm.html#ncos">ncos</a> connections: <a href="sndscm.html#blackman4envchannel">blackman4-env-channel</a><br>
Customizing the envelope editor: <a href="#envedhook">enved-hook</a><br>
peak amp follower: <a href="sndclm.html#moving-max">moving-max</a><br>
-<br>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- env-channel-with-base -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="envchannelwithbase">env-channel-with-base</a> envelope-or-env-gen <em class=narg>base beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-env-channel-with-base is a slight variation on env-channel. There are times when it's a bother
+<pre class="indented">
+<em class=def id="envchannelwithbase">env-channel-with-base</em> envelope-or-env-gen base beg dur snd chn edpos
+</pre>
+
+<p>env-channel-with-base is a slight variation on env-channel. There are times when it's a bother
to call <a href="sndclm.html#make-env">make-env</a> just to get an exponential envelope.
-</td></tr>
-<tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
+
<!-- env-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="envsound">env-sound</a> envelope <em class=narg>samp samps env-base snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-env-sound applies the amplitude 'envelope' to the given channel starting
+<pre class="indented">
+<em class=def id="envsound">env-sound</em> envelope samp samps env-base snd chn edpos
+</pre>
+
+<p>env-sound applies the amplitude 'envelope' to the given channel starting
at sample 'samp' for 'samps' samples with connecting segments
based on 'env-base'. 'env-base' defaults to 1.0.
'samp' defaults to 0. 'samps' defaults to the full duration.
'envelope' is a list containing the breakpoint values
(as in CLM) or an env generator.
+</p>
-<table hspace=20 cellpadding=5><tr><td>
-<img src="pix/ampenv1.png" alt="ampenvs" vpsace=10>
-</td><td>
-<pre>
-(env-sound '(0 0 1 1 2 0))
-
-env_sound([0.0, 0.0, 1.0, 1.0, 2.0, 0.0])
-
-'( 0.0 0.0 1.0 1.0 2.0 0.0 ) env-sound
-</pre>
+<table class="method">
+<tr><td>
+<img src="pix/ampenv1.png" alt="ampenvs">
</td><td>
<img src="pix/ampenv2.png" alt="ampenvs">
+</td></tr>
+<tr><td colspan=2 class="center">
+<pre class="indented">
+Scheme: (env-sound '(0 0 1 1 2 0))
+Ruby: env_sound([0.0, 0.0, 1.0, 1.0, 2.0, 0.0])
+Forth: '( 0.0 0.0 1.0 1.0 2.0 0.0 ) env-sound
+</pre>
</td></tr></table>
-As mentioned in <a href="sndclm.html#make-env">sndclm.html</a>,
+
+<p>As mentioned in <a href="sndclm.html#make-env">sndclm.html</a>,
'env-base' determines how the break-points are connected. If it is 1.0 (the
default), you get straight line segments. 'env-base' = 0.0 gives a step
function (the envelope changes its value suddenly to the new one without any
@@ -6822,54 +7209,63 @@ out), and 'env-base' > 1.0 gives concave curves (i.e. sagging).
If you'd rather think in terms of e^-kt, set 'env-base' to (exp k).
See env.lisp for a CLM instrument that shows the relation between the connecting
curve's exponent and 'env-base'. Here's a brief restatement:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (compare-exp k)
- (let ((e (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (list 0 1 1 (exp (- k))) :base (exp k) :length 11)))
+ (let ((e (<a class=quiet href="sndclm.html#make-env">make-env</a> (list 0 1 1 (exp (- k))) :base (exp k) :length 11)))
(do ((i 0 (+ 1 i )))
((= i 10))
- (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A ~A~%" (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> e) (exp (* (- k) (/ i 10.0))))))))
-</pre></td></tr></table>
+ (<a class=quiet href="#sndprint">snd-print</a> (<a class=quiet>format</a> #f "~A ~A~%" (<a class=quiet href="sndclm.html#env">env</a> e) (exp (* (- k) (/ i 10.0))))))))
+</pre>
-If 'envelope' is a CLM env generator, 'env-base'
+<p>If 'envelope' is a CLM env generator, 'env-base'
is ignored.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- fft-log-frequency -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fftlogfrequency">fft-log-frequency</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns whether the spectrum frequency axis is logarithmic (#t) or linear (#f, the default). If logarithmic, the lower end
+<pre class="indented">
+<em class=def id="fftlogfrequency">fft-log-frequency</em> snd chn
+</pre>
+
+<p>This returns whether the spectrum frequency axis is logarithmic (#t) or linear (#f, the default). If logarithmic, the lower end
is set by <a href="#logfreqstart">log-freq-start</a> which defaults to 32Hz.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- fft-log-magnitude -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fftlogmagnitude">fft-log-magnitude</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns whether the spectrum magnitude axis is in decibels (#t) or linear (#f, the default). If in decibels, the
+<pre class="indented">
+<em class=def id="fftlogmagnitude">fft-log-magnitude</em> snd chn
+</pre>
+
+<p>This returns whether the spectrum magnitude axis is in decibels (#t) or linear (#f, the default). If in decibels, the
minimum displayed is set by <a href="#mindb">min-dB</a> which defaults to -60.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
+
+<!-- fft-window -->
+<pre class="indented">
+<em class=def id="fftwindow">fft-window</em> snd chn
+</pre>
+
+<p>This sets the choice of fft data window (default: blackman2-window)
+</p>
-<!-- fft-window -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fftwindow">fft-window</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This sets the choice of fft data window (default: <code>blackman2-window</code>)
-<pre>
- bartlett-hann-window bartlett-window blackman2-window blackman3-window
- blackman4-window bohman-window cauchy-window connes-window
- dolph-chebyshev-window exponential-window flat-top-window gaussian-window
- hamming-window hann-poisson-window hann-window kaiser-window
- parzen-window poisson-window rectangular-window riemann-window
- samaraki-window tukey-window ultraspherical-window welch-window
- blackman5-window blackman6-window blackman7-window blackman8-window
- blackman9-window blackman10-window rv2-window rv3-window
- rv4-window mlt-sine-window papoulis-window dpss-window
- sinc-window
+<pre class="indented">
+bartlett-hann-window bartlett-window blackman2-window blackman3-window
+blackman4-window bohman-window cauchy-window connes-window
+dolph-chebyshev-window exponential-window flat-top-window gaussian-window
+hamming-window hann-poisson-window hann-window kaiser-window
+parzen-window poisson-window rectangular-window riemann-window
+samaraki-window tukey-window ultraspherical-window welch-window
+blackman5-window blackman6-window blackman7-window blackman8-window
+blackman9-window blackman10-window rv2-window rv3-window
+rv4-window mlt-sine-window papoulis-window dpss-window
+sinc-window
</pre>
<p>The Hann window is sometimes called Hanning in the DSP literature, apparently
as an in-joke. For an extensive discussion of these windows, see
@@ -6877,101 +7273,113 @@ Fredric J. Harris, "On the Use of Windows for Harmonic Analysis with the Discret
IEEE, Vol. 66, No. 1, January 1978, with updates from: Albert H. Nuttall, "Some Windows with Very Good Sidelobe Behaviour", IEEE Transactions
of Acoustics, Speech, and Signal Processing, Vol. ASSP-29, 1, February 1981, and of course, Julius Smith's DSP web site.
</p>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- fft-window-alpha -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fftalpha">fft-window-alpha</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-The ultraspherical window has two "family" parameters; the one named "mu" is called "beta" here,
+<pre class="indented">
+<em class=def id="fftalpha">fft-window-alpha</em> snd chn
+</pre>
+
+<p>The ultraspherical window has two "family" parameters; the one named "mu" is called "beta" here,
to parallel its use in related windows; the other one, named "x<sub>mu</sub>" is named "alpha" here,
for no good reason. fft-window-alpha sets the shape of the side lobes; see
"Design of Ultraspherical Window Functions with Prescribed Spectral Characteristics", Bergen and Antoniou, EURASIP JASP 2004
(also available on-line) for details.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- fft-window-beta -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fftbeta">fft-window-beta</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-Some fft windows have a parameter, often named alpha or beta, that chooses one from a family of possible windows.
+<pre class="indented">
+<em class=def id="fftbeta">fft-window-beta</em> snd chn
+</pre>
+
+<p>Some fft windows have a parameter, often named alpha or beta, that chooses one from a family of possible windows.
The actual (underlying) beta values are dependent on the window choice, but
in Snd, fft-window-beta is scaled to fit the current window's range of values, so
its value here should fall between 0.0 and 1.0.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- fft-with-phases -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fftwithphases">fft-with-phases</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns whether the single FFT display includes phase information (the default is #f).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="fftwithphases">fft-with-phases</em> snd chn
+</pre>
+
+<p>This returns whether the single FFT display includes phase information (the default is #f).
+</p>
+<div class="separator"></div>
<!-- file-name -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filename">file-name</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This returns the sound's complete (or "absolute") file name; the directory is included; see <a href="#shortfilename">short-file-name</a>
+<pre class="indented">
+<em class=def id="filename">file-name</em> snd
+</pre>
+
+<p>This returns the sound's complete (or "absolute") file name; the directory is included; see <a href="#shortfilename">short-file-name</a>
if you don't want all the directory junk. See examp.scm for many examples.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- filter-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filterchannel">filter-channel</a> env <em class=narg>order beg dur snd chn edpos trunc origin</em></code>
-</td></tr><tr><td></td><td>
-The regularized version of filter-sound. If the end of the filtered portion is not the end of the sound,
+<pre class="indented">
+<em class=def id="filterchannel">filter-channel</em> env order beg dur snd chn edpos trunc origin
+</pre>
+
+<p>The regularized version of filter-sound. If the end of the filtered portion is not the end of the sound,
the 'trunc' argument determines whether the filtered sound is truncated at that point (the default: #t),
or mixed with the overlapping section, similar to the truncate argument to <a href="#filterselection">filter-selection</a>.
'env' can be either the frequency response envelope, or a vct containing the desired coefficients.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- filter-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filtersound">filter-sound</a> env <em class=narg>order snd chn edpos origin</em></code>
-</td></tr><tr><td></td><td>
-filter-sound applies an FIR filter of order 'order' (actually one more than the nominal order)
+<pre class="indented">
+<em class=def id="filtersound">filter-sound</em> env order snd chn edpos origin
+</pre>
+
+<p>filter-sound applies an FIR filter of order 'order' (actually one more than the nominal order)
and frequency response 'env'
to the given channel. 'env' can also be a vct containing the filter coefficients,
or any CLM filtering generator
(e.g. comb, formant, one-pole, iir-filter, etc). The generator
is called in C, not Scheme, so this is the fastest way to apply
CLM filtering to a sound. See also <a href="#clmchannel">clm-channel</a>.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>filter-sound</em> '(0 1 1 0) 1024) ; FIR filter given frequency response
-(<em class=red>filter-sound</em> (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> .1 .2 .3 .3 .2 .1) 6) ; FIR filter given actual coefficients
-(<em class=red>filter-sound</em> (<a class=quiet href="sndclm.html#make-fir-filter" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_fir_filter_tip)">make-fir-filter</a> 6 (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> .1 .2 .3 .3 .2 .1))) ; CLM FIR filter
-(<em class=red>filter-sound</em> (<a class=quiet href="sndclm.html#make-delay" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_delay_tip)">make-delay</a> 120)) ; CLM delay (same as insert-silence)
-(<em class=red>filter-sound</em> (<a class=quiet href="sndclm.html#make-formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_formant_tip)">make-formant</a> 1200 .99)) ; CLM formant
-(<em class=red>filter-sound</em> (<a class=quiet href="sndclm.html#make-filter" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_filter_tip)">make-filter</a> 2 (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 1 -1) (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 -0.99))) ; remove DC
-</pre></td></tr></table>
-
-If you want to use the cascade filter structure, rather than the canonical
+(<em class=red>filter-sound</em> (float-vector .1 .2 .3 .3 .2 .1) 6) ; FIR filter given actual coefficients
+(<em class=red>filter-sound</em> (<a class=quiet href="sndclm.html#make-fir-filter">make-fir-filter</a> 6 (float-vector .1 .2 .3 .3 .2 .1))) ; CLM FIR filter
+(<em class=red>filter-sound</em> (<a class=quiet href="sndclm.html#make-delay">make-delay</a> 120)) ; CLM delay (same as insert-silence)
+(<em class=red>filter-sound</em> (<a class=quiet href="sndclm.html#make-formant">make-formant</a> 1200 .99)) ; CLM formant
+(<em class=red>filter-sound</em> (<a class=quiet href="sndclm.html#make-filter">make-filter</a> 2 (float-vector 1 -1) (float-vector 0 -0.99))) ; remove DC
+</pre>
+
+<p>If you want to use the cascade filter structure, rather than the canonical
form of CLM's filter generator:
+</p>
-<pre>
- (define (<a class=quiet href="sndscm.html#makebiquad" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebiquad_tip)">make-biquad</a> a0 a1 a2 b1 b2)
- (<a class=quiet href="sndclm.html#make-filter" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_filter_tip)">make-filter</a> 3 (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> a0 a1 a2) (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0.0 b1 b2)))
+<pre class="indented">
+(define (<a class=quiet href="sndscm.html#makebiquad">make-biquad</a> a0 a1 a2 b1 b2)
+ (<a class=quiet href="sndclm.html#make-filter">make-filter</a> 3 (float-vector a0 a1 a2) (float-vector 0.0 b1 b2)))
</pre>
-If you have coefficients for the cascade form, but have no scruples about using
+<p>If you have coefficients for the cascade form, but have no scruples about using
some other form, see cascade->canonical in dsp.scm, and the examples that follow.
-<br><br>
+</p>
<!-- INDEX filtersinsnd:Filters -->
-<TABLE border=3 bordercolor="tan" hspace=20>
-<tr><td>
-<blockquote><small>
-<br>
-<A NAME="filtersinsnd">Filters</a> in Snd:<br>
-filter a sound: <a href="#filtersound">filter-sound</a>, <a href="#filterchannel">filter-channel</a>, and <a href="#clmchannel">clm-channel</a><br>
-filter the selection: <a href="#filterselection">filter-selection</a>, <a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a><br>
+
+<TABLE class="method">
+<tr><th class="title">Filters</th></tr><tr><td>
+<blockquote id="filtersinsnd"><small>
+filter a sound: <a href="extsnd.html#filtersound">filter-sound</a>, <a href="extsnd.html#filterchannel">filter-channel</a>, and <a href="extsnd.html#clmchannel">clm-channel</a><br>
+filter the selection: <a href="extsnd.html#filterselection">filter-selection</a>, <a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a><br>
CLM filter generators: <a href="sndclm.html#filterdoc">filter, one-pole, formant, comb, notch, all-pass, etc</a><br>
lowpass filter: <a href="sndscm.html#makelowpass">make-lowpass</a> in dsp.scm<br>
highpass filter: <a href="sndscm.html#makehighpass">make-highpass</a> in dsp.scm<br>
@@ -6982,7 +7390,7 @@ Butterworth filters: <a href="sndscm.html#makebutter">make-butter-high-pass</a>,
IIR filters of various orders/kinds: <a href="sndscm.html#IIRfilters">dsp.scm</a><br>
Hilbert transform: <a href="sndscm.html#makehilberttransform">make-hilbert-transform</a> in dsp.scm<br>
differentiator: <a href="sndscm.html#makedifferentiator">make-differentiator</a> in dsp.scm<br>
-block DC: see example above, dc-block in prc95.scm, clean-channel in clean.scm, or stereo-flute in clm-ins.scm<br>
+block DC: see example above, dc-block in prc95.scm, or stereo-flute in clm-ins.scm<br>
hum elimination: see <a href="sndscm.html#IIRfilters">eliminate-hum</a> and <a href="sndscm.html#notchchannel">notch-channel</a> in dsp.scm<br>
hiss elimination: <a href="sndscm.html#notchoutrumbleandhiss">notch-out-rumble-and-hiss</a><br>
smoothing filters: <a href="sndclm.html#moving-average">moving-average</a>, <a href="sndclm.html#weighted-moving-average">weighted-moving-average</a>, exponentially-weighted-moving-average<br>
@@ -6995,142 +7403,116 @@ draw frequency response: use <a href="snd.html#editenvelope">envelope editor</a>
Moog filter: <a href="sndscm.html#moogdoc">moog.scm</a><br>
Savitzky-Golay filter: <a href="sndscm.html#sgfilter">savitzky-golay-filter</a><br>
Click reduction: <a href="sndscm.html#removeclicks">remove-clicks</a>, <a href="sndscm.html#cleanchannel">clean-channel</a><br>
-FIR filter as virtual edit: <a href="sndscm.html#virtualfilterchannel">virtual-filter-channel</a><br>
Max Mathews resonator: <a href="sndclm.html#firmant">firmant</a>, <a href="sndscm.html#maxfdoc">maxf.scm, maxf.rb</a><br>
Spectral edit dialog: <a href="snd.html#editenvelope">Envelope Editor</a><br>
graphical equalizer filter bank: <a href="sndscm.html#clminsdoc">graphEq</a><br>
nonlinear (Volterra) filter: <a href="sndscm.html#volterrafilter">volterra-filter</a><br>
Kalman filter: <a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a><br>
see also convolution, physical modeling, reverb, and <a href="sndscm.html#ssffts">fft-based filtering</a><br>
-Scheme srfi-1 filter function: %filter.<br>
-<br>
</small></blockquote>
-</td></tr>
-</TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
-
-<!-- find-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="findchannel">find-channel</a> proc <em class=narg>sample snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This function finds the sample that satisfies the function 'proc'. 'sample'
-determines where to start the search.
-
-<pre>
-><em class=typing>(find-channel (lambda (y) (> y .1)))</em>
-<em class=listener>4423</em>
-
-><em class=typing>lambda: <{ y }> 0.1 y f< ; find-channel</em>
-<em class=listener>4423</em>
-</pre>
-
-I didn't bring out the search direction (find-channel is built on scan-channel which assumes it is
-scanning forwards), but it's not hard to write a function to find in reverse:
+</td></tr></TABLE>
+<div class="separator"></div>
-<pre>
-(define* (<A NAME="findchannelinreverse">find-channel-in-reverse</A> proc beg snd chn edpos)
- (let* ((sample (or beg (- (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd chn) 1))) ; or cursor?
- (reader (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> sample snd chn -1 edpos))
- (result #f))
- (do ((i sample (- i 1)))
- ((or result (< i 0))
- (and result
- (list result (+ 1 i))))
- (set! result (proc (reader))))))
-</pre>
<!-- INDEX searchexamples:Searching -->
-<A NAME="searchexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<blockquote><small>
-<br>
-find a mark: <a href="#findmark">find-mark</a><br>
+<TABLE class="method">
+<tr><th class="title">Searches</th></tr><tr><td>
+<blockquote id="searchexamples"><small>
+find a mark: <a href="extsnd.html#findmark">find-mark</a><br>
find a mix: <a href="sndscm.html#findmix">find-mix</a><br>
-find a sound: <a href="#findsound">find-sound</a><br>
+find a sound: <a href="extsnd.html#findsound">find-sound</a><br>
Example find procedures: <a href="sndscm.html#searchforclick">search-for-click, zero+, next-peak, find-pitch</a><br>
-Search via continuation: <a href="#scanagain">scan-again</a><br>
-Explicit access to search procedures: <a href="#searchprocedure">search-procedure</a><br>
-The Find dialog: <a href="snd.html#editoperations">Find</a> or <a href="#finddialog">find-dialog</a><br>
-find silence: <a href="#mapsilence">map-silence</a>, scramble-channel in examp.scm<br>
+Default search procedure: <a href="extsnd.html#searchprocedure">search-procedure</a><br>
+The Find dialog: <a href="snd.html#editoperations">Find</a> or <a href="extsnd.html#finddialog">find-dialog</a><br>
+find silence: <a href="extsnd.html#mapsilence">map-silence</a>, scramble-channel in examp.scm<br>
find any difference between two chans: <a href="sndscm.html#channelsequal">channels-equal</a><br>
-see also <a href="#countmatches">count-matches</a> and <a href="#scanchannel">scan-channel</a><br>
-search a multichannel sound: <a href="sndscm.html#scansound">scan-sound</a><br>
find a widget: find-child in snd-motif.scm<br>
add C-s and C-r to the listener key bindings: add-find-to-listener in snd-motif.scm<br>
Scheme find: find-if<br>
-<br>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- find-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="findsound">find-sound</a> filename <em class=narg>nth</em></code>
-</td></tr><tr><td></td><td>
-find-sound returns the sound object of 'filename' or
+<pre class="indented">
+<em class=def id="findsound">find-sound</em> filename nth
+</pre>
+
+<p>find-sound returns the sound object of 'filename' or
#f if no sound is found that matches 'filename'. If there is (or might be) more than one file
open with the given filename, the 'nth' parameter (which defaults to 0) chooses which to return.
Leaving aside the 'nth' parameter, find-sound could be defined as:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (find-sound name)
(call-with-current-continuation
(lambda (return)
(for-each
(lambda (snd)
- (if (or (string=? (<a class=quiet href="#shortfilename" onmouseout="UnTip()" onmouseover="Tip(extsnd_shortfilename_tip)">short-file-name</a> snd) name)
- (string=? (<a class=quiet href="#filename" onmouseout="UnTip()" onmouseover="Tip(extsnd_filename_tip)">file-name</a> snd) name))
+ (if (or (string=? (<a class=quiet href="#shortfilename">short-file-name</a> snd) name)
+ (string=? (<a class=quiet href="#filename">file-name</a> snd) name))
(return snd)))
- (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))
+ (<a class=quiet href="#sounds">sounds</a>))
#f)))
-</pre></td></tr></table>
+</pre>
-See files-popup-buffer, open-next-file-in-directory, and the "Buffer Menu" code in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<p>See files-popup-buffer, open-next-file-in-directory, and the "Buffer Menu" code in examp.scm.
+</p>
+<div class="separator"></div>
<!-- finish-progress-report -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="finishprogressreport">finish-progress-report</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This ends an on-going progress report (a visual indication of how far along some time-consuming process is).
+<pre class="indented">
+<em class=def id="finishprogressreport">finish-progress-report</em> snd chn
+</pre>
+
+<p>This ends an on-going progress report (a visual indication of how far along some time-consuming process is).
See <a href="#progressreport">progress-report</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
+
+<!-- framples -->
+<pre class="indented">
+<em class=def id="framples">framples</em> snd chn edpos
+</pre>
-<!-- frames -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="frames">frames</a> <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This returns current length in samples of the channel 'chn'. Used with set!, this either truncates
+<p>This returns current length in samples of the channel 'chn'. Used with set!, this either truncates
the sound or pads it with zeros at the end.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- free-player -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="freeplayer">free-player</a> player</code>
-</td></tr><tr><td></td><td>
-free-player frees all resources associated with 'player' and remove it from the play-list.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="freeplayer">free-player</em> player
+</pre>
+
+<p>free-player frees all resources associated with 'player' and remove it from the play-list.
+</p>
+<div class="separator"></div>
<!-- graph -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="graph">graph</a> data <em class=narg>xlabel x0 x1 y0 y1 snd chn force-display show-axes-choice</em></code>
-</td></tr><tr><td></td><td>
-This function displays a graph of 'data' in a separate display per channel. The x axis
+<pre class="indented">
+<em class=def id="graph">graph</em> data xlabel x0 x1 y0 y1 snd chn force-display show-axes-choice
+</pre>
+
+<p>This function displays a graph of 'data' in a separate display per channel. The x axis
is labelled 'xlabel', the x axis units go from 'x0' to 'x1' (the default is 0.0 to 1.0),
the y axis goes from 'y0' to 'y1' (the default fits the data), and the display is
associated with channel 'chn' in 'snd'.
-<pre>
- (graph (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 .1 .2 .3 .4 .3 .2 .1 0) "roof")
+</p>
+
+<pre class="indented">
+(graph (float-vector 0 .1 .2 .3 .4 .3 .2 .1 0) "roof")
</pre>
-The current slider values can be read from <a href="#xpositionslider">x-position-slider</a>,
+
+<p id="xdisplayenergy">The current slider values can be read from <a href="#xpositionslider">x-position-slider</a>,
<a href="#xzoomslider">x-zoom-slider</a>, etc. The 'data' argument can be a list of vcts; each is graphed at the same time, following the sequence of
colors used when channels are superimposed. If 'data'
is a list of numbers, it is assumed to be an envelope (a list of breakpoints).
@@ -7138,70 +7520,78 @@ If 'force-display' is #f (the default is #t), the graph is not
explicitly drawn; this is useful when you're calling graph from
the lisp-graph-hook, where the redisplay is automatic.
'show-axes-choice' sets the <a href="#showaxes">show-axes</a> choice for the lisp graph.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define <A NAME="xdisplayenergy">display-energy</A>
+<pre class="indented">
+(define display-energy
;; y-zoom-slider controls the graph amp
(lambda (snd chn)
- "display time domain data as energy"
- (let* ((ls (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>))
- (rs (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a>))
- (datal (<a class=quiet href="#makegraphdata" onmouseout="UnTip()" onmouseover="Tip(extsnd_makegraphdata_tip)">make-graph-data</a> snd chn))
- (data (if (<a class=quiet href="#vctp" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctp_tip)">vct?</a> datal) datal (cadr datal)))
- (len (length data))
- (sr (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd))
- (y-max (<a class=quiet href="#yzoomslider" onmouseout="UnTip()" onmouseover="Tip(extsnd_yzoomslider_tip)">y-zoom-slider</a> snd chn)))
- (<a class=quiet href="#vctmultiply" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctmultiply_tip)">vct-multiply!</a> data data)
+ (let* ((ls (<a class=quiet href="#leftsample">left-sample</a>))
+ (rs (<a class=quiet href="#rightsample">right-sample</a>))
+ (datal (<a class=quiet href="#makegraphdata">make-graph-data</a> snd chn))
+ (data (if (float-vector? datal) datal (cadr datal)))
+ (sr (<a class=quiet href="#srate">srate</a> snd))
+ (y-max (<a class=quiet href="#yzoomslider">y-zoom-slider</a> snd chn)))
+ (float-vector-multiply! data data)
(<em class=red>graph</em> data "energy" (/ ls sr) (/ rs sr) 0.0 (* y-max y-max) snd chn #f))))
-(hook-push <a href="#lispgraphhook">lisp-graph-hook</a> display-energy)
-</pre></td></tr></table>
-<img src="pix/energy.png" alt="picture of examp.scm in action">
-</td></tr><tr><td colspan=2 height=18></td></tr>
+(hook-push <a href="#lispgraphhook">lisp-graph-hook</a> (lambda (hook) (display-energy (hook 'snd) (hook 'chn))))
+</pre>
+<img class="indented" src="pix/energy.png" alt="picture of examp.scm in action">
+<div class="separator"></div>
<!-- graph-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="graphstyle">graph-style</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-graph-style determines how sound data is displayed (default: <code>graph-lines</code>).
+<pre class="indented">
+<em class=def id="graphstyle">graph-style</em> snd chn
+</pre>
+
+<p>graph-style determines how sound data is displayed (default: graph-lines).
The choices are:
-<pre>
- graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
+</p>
+
+<pre class="indented">
+graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
</pre>
-In the set! case, if no 'snd' is specified, all graph-styles are set to the
+
+<p>In the set! case, if no 'snd' is specified, all graph-styles are set to the
new value. If 'snd' is given, the three graph styles for that sound's channels (or channel 'chn') are
set. See <a href="#timegraphstyle">time-graph-style</a>, <a href="#lispgraphstyle">lisp-graph-style</a>, and
<a href="#transformgraphstyle">transform-graph-style</a> to override the default for a specific graph.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- graphs-horizontal -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="graphshorizontal">graphs-horizontal</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This determines whether channel graphs (the time domain, spectrum, and lisp graphs)
-are arranged
-<A class=quiet onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/bgd.png\' width=\'540\' height=\'360\'>', TITLE, '<code>(set! (graphs-horizontal) #f)</code>', ABOVE, true)">vertically</A>
+<pre class="indented">
+<em class=def id="graphshorizontal">graphs-horizontal</em> snd chn
+</pre>
+
+<p>This determines whether channel graphs (the time domain, spectrum, and lisp graphs)
+are arranged vertically
or horizontally (the latter is the default).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- grid-density -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="griddensity">grid-density</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This controls the spacing of axis ticks; the default is 1.0. If grid-density is less than 1.0, more ticks are squeezed
+<pre class="indented">
+<em class=def id="griddensity">grid-density</em> snd chn
+</pre>
+
+<p>This controls the spacing of axis ticks; the default is 1.0. If grid-density is less than 1.0, more ticks are squeezed
in; if greater than 1.0, fewer ticks are displayed. This mainly affects the grid display
(<a href="#showgrid">show-grid</a>).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- header-type -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="headertype">header-type</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This returns the header type (e.g. <code>mus-aiff</code>) of the file that underlies 'snd'.
+<pre class="indented">
+<em class=def id="headertype">header-type</em> snd
+</pre>
+
+<p>This returns the header type (e.g. mus-aiff) of the file that underlies 'snd'.
Snd can read about 60 header types, and write 7 or so.
"aiff" and "aifc" come from Apple, "riff" is the Microsoft "wave" header,
"rf64" is the European Broadcast Union's 64-bit RIFF replacement,
@@ -7211,178 +7601,203 @@ Snd can read about 60 header types, and write 7 or so.
and "raw"
means the sound file has no header. If you change the header type to "raw",
any existing header is removed.
-Each header type has its own peculiarities; if in doubt, use <code>mus-next</code> because it is simple,
-and can handle any data format that Snd can write (whereas each of the others is restricted in this regard).
-The writable header types are <code>mus-next</code>, <code>mus-nist</code>,
-<code>mus-aiff</code> (obsolete, rarely needed), <code>mus-aifc</code>, <code>mus-riff</code>, <code>mus-rf64</code>, <code>mus-caff</code>,
-<code>mus-ircam</code>, and <code>mus-raw</code> (no header). For technical descriptions of the headers,
+Each header type has its own peculiarities; if in doubt, use mus-next because it is simple,
+and can handle any sample type that Snd can write (whereas each of the others is restricted in this regard).
+The writable header types are mus-next, mus-nist,
+mus-aiff (obsolete, rarely needed), mus-aifc, mus-riff, mus-rf64, mus-caff,
+mus-ircam, and mus-raw (no header). For technical descriptions of the headers,
see headers.c; for actual sound files, see sf.tar.gz at ccrma-ftp.
-<br><br>
-To turn a header type number into a string, use <a href="#musheadertypename">mus-header-type-name</a>. To get
+</p>
+
+<p>To turn a header type number into a string, use <a href="#musheadertypename">mus-header-type-name</a>. To get
the header type of some sound file, use <a href="#mussoundheadertype">mus-sound-header-type</a>.
If you set the header-type, the sound file is rewritten with the new header. The default output
-(<a class=quiet href="#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a>, and
-<a class=quiet href="#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a>) header type is <a href="#defaultoutputheadertype">default-output-header-type</a>.
-<br><br>
-To read or write your own headers (or some header that isn't built-in),
+(<a class=quiet href="#newsound">new-sound</a>, and
+<a class=quiet href="#savesoundas">save-sound-as</a>) header type is <a href="#defaultoutputheadertype">default-output-header-type</a>.
+</p>
+
+<p>To read or write your own headers (or some header that isn't built-in),
I recommend using either <a href="#openhook">open-hook</a> or <a href="#openrawsoundhook">open-raw-sound-hook</a>:
in the latter case, when you open the file with the unsupported header,
Snd will throw up its hands and say "maybe it's a raw (headerless)
sound"; it will then look at open-raw-sound-hook before trying
other fallbacks (such as the Raw File Dialog).
See examp.scm or misc.scm (MPEG, OGG, etc).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- insert-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="insertsample">insert-sample</a> samp value <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This inserts sample 'value' at sample 'samp' in the given channel
+<pre class="indented">
+<em class=def id="insertsample">insert-sample</em> samp value snd chn edpos
+</pre>
+
+<p id="insertionexamples">This inserts sample 'value' at sample 'samp' in the given channel
+</p>
<!-- INDEX insertionexamples:Insertions -->
-<A NAME="insertionexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<small><blockquote>
+<TABLE class="method">
+<tr><th class="title">Insertions</th></tr><tr><td>
+<blockquote><small>
insert some portion of a channel: <a href="sndscm.html#insertchannel">insert-channel</a><br>
-insert a silence: <a href="#padchannel">pad-channel</a>, <a href="#insertsilence">insert-silence</a>, <a href="sndscm.html#padsound">pad-sound</a><br>
-insert a region: <a href="#insertregion">insert-region</a><br>
-insert the selection: <a href="#insertselection">insert-selection</a><br>
-insert a vct of samples: <a href="#insertsamples">insert-samples</a>, <a href="sndscm.html#insertvct">insert-vct</a><br>
-insert a sound: <a href="#insertsound">insert-sound</a> or <a href="#insertfiledialog">insert-file-dialog</a><br>
-append a sound and silence: <a href="#appendsound">append-sound</a><br>
-insert a frame: <a href="sndscm.html#insertframe">insert-frame</a><br>
-insert sound-data: <a href="sndscm.html#insertsounddata">insert-sound-data</a><br>
-</blockquote></small>
+insert a silence: <a href="extsnd.html#padchannel">pad-channel</a>, <a href="extsnd.html#insertsilence">insert-silence</a>, <a href="sndscm.html#padsound">pad-sound</a><br>
+insert a region: <a href="extsnd.html#insertregion">insert-region</a><br>
+insert the selection: <a href="extsnd.html#insertselection">insert-selection</a><br>
+insert a vct of samples: <a href="extsnd.html#insertsamples">insert-samples</a><br>
+insert a sound: <a href="extsnd.html#insertsound">insert-sound</a><br>
+append a sound and silence: <a href="extsnd.html#appendsound">append-sound</a><br>
+</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- insert-samples -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="insertsamples">insert-samples</a> samp samps data <em class=narg>snd chn edpos auto-delete origin</em></code>
-</td></tr><tr><td></td><td>
-This inserts 'samps' samples of 'data' (normally a vct) starting at sample 'samp' in the given channel.
+<pre class="indented">
+<em class=def id="insertsamples">insert-samples</em> samp samps data snd chn edpos auto-delete origin
+</pre>
+
+<p>This inserts 'samps' samples of 'data' (normally a vct) starting at sample 'samp' in the given channel.
'data' can be a filename.
-The regularized version of this is:<br>
-<pre>
- (define* (<a class=quiet href="sndscm.html#insertchannel" onmouseout="UnTip()" onmouseover="Tip(sndscm_insertchannel_tip)">insert-channel</a> data beg dur snd chn edpos)
- (insert-samples beg dur data snd chn edpos))
+The regularized version of this is:
+</p>
+
+<pre class="indented">
+(define* (<a class=quiet href="sndscm.html#insertchannel">insert-channel</a> data beg dur snd chn edpos)
+ (insert-samples beg dur data snd chn edpos))
</pre>
-To insert a block of samples of a given value: <code>(insert-samples beg dur (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> dur val))</code>
+
+<p>To insert a block of samples of a given value: (insert-samples beg dur (make-float-vector dur val))
If 'data' is a file, it is not deleted by Snd unless 'auto-delete' is #t.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- insert-silence -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="insertsilence">insert-silence</a> beg num <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This inserts 'num' zeros at 'beg' in the given channel. <a href="#padchannel">pad-channel</a> is the regularized version,
+<pre class="indented">
+<em class=def id="insertsilence">insert-silence</em> beg num snd chn
+</pre>
+
+<p>This inserts 'num' zeros at 'beg' in the given channel. <a href="#padchannel">pad-channel</a> is the regularized version,
with one small change: insert-silence forces 'beg' to be within the current sound, but pad-channel pads out to 'beg' if
-'beg' is past the end of the sound. (And, as usual in these cases, insert-silence follows the <a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a>
-field, whereas <a class=quiet href="#padchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_padchannel_tip)">pad-channel</a> ignores it).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+'beg' is past the end of the sound. (And, as usual in these cases, insert-silence follows the <a class=quiet href="#sync">sync</a>
+field, whereas <a class=quiet href="#padchannel">pad-channel</a> ignores it).
+</p>
+<div class="separator"></div>
<!-- insert-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="insertsound">insert-sound</a> file <em class=narg>beg in-chan snd chn edpos auto-delete</em></code>
-</td></tr><tr><td></td><td>
-This inserts channel 'in-chan' of 'file' at sample 'beg' in the given channel.
+<pre class="indented">
+<em class=def id="insertsound">insert-sound</em> file beg in-chan snd chn edpos auto-delete
+</pre>
+
+<p id="appendsound">This inserts channel 'in-chan' of 'file' at sample 'beg' in the given channel.
'beg' defaults to the cursor position; if 'in-chan' is not given, all
channels are inserted. To append one sound to another, padding at the end with some silence:
-<pre>
- (define* (<a name="appendsound">append-sound</a> file (silence 1.0))
- (<em class=red>insert-sound</em> file (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (<em class=red>insert-silence</em> (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) (round (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) silence))))
+</p>
+
+<pre class="indented">
+(define* (append-sound file (silence 1.0))
+ (<em class=red>insert-sound</em> file (<a class=quiet href="#framples">framples</a>))
+ (<em class=red>insert-silence</em> (<a class=quiet href="#framples">framples</a>) (round (* (<a class=quiet href="#srate">srate</a>) silence))))
</pre>
-'file' is not deleted by Snd unless 'auto-delete' is #t.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+
+<p>'file' is not deleted by Snd unless 'auto-delete' is #t.
+</p>
+<div class="separator"></div>
<!-- integer->sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="integertosound">integer->sound</a> i</code>
-</td></tr><tr><td></td><td>
-In olden times, a sound was handled in Snd code as an integer; nowadays, it's an object (although the integer approach still works).
+<pre class="indented">
+<em class=def id="integertosound">integer->sound</em> i
+</pre>
+
+<p>In olden times, a sound was handled in Snd code as an integer; nowadays, it's an object (although the integer approach still works).
This function, and its companion <a href="#soundtointeger">sound->integer</a>, exist mainly to convert
old code to the current style.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
<!-- left-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="leftsample">left-sample</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns the position in samples of the left edge of the time domain
+<pre class="indented">
+<em class=def id="leftsample">left-sample</em> snd chn
+</pre>
+
+<p>This returns the position in samples of the left edge of the time domain
waveform for the given channel.
To get the data currently displayed in the time domain window:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (<a class=quiet href="sndscm.html#windowsamples" onmouseout="UnTip()" onmouseover="Tip(sndscm_windowsamples_tip)">window-samples</a>)
+<pre class="indented">
+(define (<a class=quiet href="sndscm.html#windowsamples">window-samples</a>)
(let ((wl (<em class=red>left-sample</em>))
(wr (<a href="#rightsample">right-sample</a>)))
(<a href="#samples">samples</a> wl (+ 1 (- wr wl)))))
-</pre></td></tr></table>
+</pre>
-See also <a href="#moveonepixel">move-one-pixel</a>.
+<p id="movingwindows">See also <a href="#moveonepixel">move-one-pixel</a>.
+</p>
<!-- INDEX movingwindows:Window size and position -->
-<A NAME="movingwindows"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
+<TABLE class="method">
+<tr><th class="title">Time Domain Display</th></tr><tr><td>
<blockquote><small>
-<br>
-time domain window:<br>
Built-in keyboard commands: <a href="snd.html#movewindow">Moving the Window</a><br>
-Specialized keyboard commands: <a href="#bindkey">bind-key</a><br>
-Window size: <a href="#xzoomslider">x-zoom-slider</a>, <a href="#zoomonepixel">zoom-one-pixel</a>, <br>
-Window position: <a href="#xpositionslider">x-position-slider</a>, <a href="#moveonepixel">move-one-pixel</a><br>
-Window left edge: <a href="#leftsample">left-sample</a><br>
-Window right edge: <a href="#rightsample">right-sample</a><br>
+Specialized keyboard commands: <a href="extsnd.html#bindkey">bind-key</a><br>
+Window size: <a href="extsnd.html#xzoomslider">x-zoom-slider</a>, <a href="extsnd.html#zoomonepixel">zoom-one-pixel</a>, <br>
+Window position: <a href="extsnd.html#xpositionslider">x-position-slider</a>, <a href="extsnd.html#moveonepixel">move-one-pixel</a><br>
+Window left edge: <a href="extsnd.html#leftsample">left-sample</a><br>
+Window right edge: <a href="extsnd.html#rightsample">right-sample</a><br>
<br>
fft window:<br>
-window size: drag x axis, <a href="#spectrumend">spectrum-end</a><br>
-window start: <a href="#spectrumstart">spectrum-start</a><br>
-relation to time domain: <a href="#beforetransformhook">before-transform-hook</a><br>
-selection fft: <a href="#showselectiontransform">show-selection-transform</a><br>
+window size: drag x axis, <a href="extsnd.html#spectrumend">spectrum-end</a><br>
+window start: <a href="extsnd.html#spectrumstart">spectrum-start</a><br>
+relation to time domain: <a href="extsnd.html#beforetransformhook">before-transform-hook</a><br>
+selection fft: <a href="extsnd.html#showselectiontransform">show-selection-transform</a><br>
<br>
general info:<br>
-Axis description: <a href="#axisinfo">axis-info</a><br>
-<br>
+Axis description: <a href="extsnd.html#axisinfo">axis-info</a><br>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- lisp-graph? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="lispgraphp">lisp-graph?</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-lisp-graph? returns #t if the lisp-generated graph is currently displayed ("lisp" here means any extension language).
+<pre class="indented">
+<em class=def id="lispgraphp">lisp-graph?</em> snd chn
+</pre>
+
+<p>lisp-graph? returns #t if the lisp-generated graph is currently displayed ("lisp" here means any extension language).
The lisp graph section is also active if there's a drawing function
on the <a href="#lispgraphhook">lisp-graph-hook</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- lisp-graph-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="lispgraphstyle">lisp-graph-style</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This determines how lisp-generated data is displayed.
+<pre class="indented">
+<em class=def id="lispgraphstyle">lisp-graph-style</em> snd chn
+</pre>
+
+<p>This determines how lisp-generated data is displayed.
The choices are:
-<pre>
- graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
+</p>
+
+<pre class="indented">
+graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- make-player -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="makeplayer">make-player</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This function makes a new player associated with the given channel.
+<pre class="indented">
+<em class=def id="makeplayer">make-player</em> snd chn
+</pre>
+
+<p>This function makes a new player associated with the given channel.
A player is a sort of wrapper for a channel of a sound that supports
all the control-panel functions. Once created, you can set these
fields, then call <a href="#addplayer">add-player</a> to add this channel to the list of
@@ -7392,60 +7807,54 @@ the play with <a href="#startplaying">start-playing</a>, and stop it prematurely
<a href="#stopplayer">stop-player</a> or <a href="#stopplaying">stop-playing</a>. These functions make it possible
to build custom control panels. Here's an example that plays a
sound with individual amplitudes for the channels:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define play-with-amps
(lambda (sound . amps)
- (let ((chans (<a class=quiet href="#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a> sound)))
+ (let ((chans (<a class=quiet href="#chans">channels</a> sound)))
(do ((chan 0 (+ 1 chan)))
((= chan chans))
(let ((player (<em class=red>make-player</em> sound chan)))
- (set! (<a class=quiet href="#ampcontrol" onmouseout="UnTip()" onmouseover="Tip(extsnd_ampcontrol_tip)">amp-control</a> player) (list-ref amps chan))
+ (set! (<a class=quiet href="#ampcontrol">amp-control</a> player) (amps chan))
(<em class=red>add-player</em> player)))
- (<em class=red>start-playing</em> chans (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> sound)))))
+ (<em class=red>start-playing</em> chans (<a class=quiet href="#srate">srate</a> sound)))))
(play-with-amps 0 1.0 0.5) ;plays channel 2 of stereo sound at half amplitude
-</pre></td></tr></table>
-</td></tr>
+</pre>
-<tr><td></td><td>
-See play-with-envs in enved.scm,
+<p>See play-with-envs in enved.scm,
play-syncd-marks in marks.scm, start-dac in play.scm,
and add-amp-controls in <a href="sndscm.html#sndmotifdoc">snd-motif.scm</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- make-variable-graph -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="makevariablegraph">make-variable-graph</a> container <em class=narg>name length srate</em></code>
-</td></tr><tr><td></td><td>
-make-variable-graph is a part of the <a href="sndscm.html#variabledisplay" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/vardpy.png\' width=\'250\' height=\'250\'>', TITLE, 'make-variable-display in snd-motif', ABOVE, true)">variable-display</a> mechanism in snd-motif.scm. It creates the
-sound/channel pair that displays a graph or spectrum of the arbitrary data accessed via <a href="#channeldata">channel-data</a>.
-See oscope.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
+<pre class="indented">
+<em class=def id="makevariablegraph">make-variable-graph</em> container name length srate
+</pre>
-<!-- map-chan -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>map-chan</a> func <em class=narg>start end edname snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-map-chan applies 'func' to samples in the specified channel.
-It is the old ("irregular") version of <a href="#mapchannel">map-channel</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<p>make-variable-graph is a part of the <a href="sndscm.html#variabledisplay">variable-display</a> mechanism in snd-motif.scm. It creates the
+sound/channel pair that displays a graph or spectrum of the arbitrary data accessed via <a href="#channeldata">channel-data</a>.
+</p>
+<div class="separator"></div>
<!-- map-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="mapchannel">map-channel</a> func <em class=narg>beg dur snd chn edpos origin</em></code>
-</td></tr><tr><td></td><td>
-map-channel is one of the standard ways to change a sound. It applies 'func' to each sample
+<pre class="indented">
+<em class=def id="mapchannel">map-channel</em> func beg dur snd chn edpos origin
+</pre>
+
+<p>map-channel is one of the standard ways to change a sound. It applies 'func' to each sample
replacing the current value with whatever 'func' returns.
As usual, 'beg' defaults to 0, 'dur' defaults to the full length of the sound,
'snd' and 'chn' default to the currently selected sound, and 'edpos' to the
current edit history list position. 'origin' is the edit history name of the current
operation.
-<br><br>
-'func', a procedure of one argument (the current sample),
+</p>
+
+<p>'func', a procedure of one argument (the current sample),
can return #f, which means that the data passed in is
deleted (replaced by nothing), or a number which replaces the
current sample,
@@ -7458,20 +7867,20 @@ each sample and returns either #f (no corresponding output), a number
(the new output), or a bunch of numbers.
If every value returned for a given channel is #f, the data is not edited.
Here we add 0.2 to every sample in a channel:
-<br>
+</p>
-<pre>
+<pre class="indented">
Scheme:
- ><em class=typing>(map-channel (lambda (y) (+ y 0.2)))</em>
- <em class=listener>0</em>
+> (map-channel (lambda (y) (+ y 0.2)))
+0
Ruby:
- ><em class=typing>map_channel(lambda do |y| y + 0.2 end)</em>
- <em class=listener>-0.0015869140625</em>
+>map_channel(lambda do |y| y + 0.2 end)
+-0.0015869140625
Forth:
- ><em class=typing>lambda: <{ y }> y 0.2 f+ ; map-channel</em>
- <em class=listener>-0.00158691</em>
+>lambda: <{ y }> y 0.2 f+ ; map-channel
+-0.00158691
</pre>
<p>
@@ -7480,21 +7889,21 @@ samples (a high-pass effect), then undo that by adding them back together,
then check to see how close our reconstruction is to the original:
</p>
-<pre>
-<em class=listener>></em> <em class=typing>(let ((y0 0.0)) (map-channel (lambda (y) (let ((diff (- y y0))) (set! y0 y) diff))))</em>
-<em class=listener>0</em>
-<em class=listener>></em> <em class=typing>(let ((y0 0.0)) (map-channel (lambda (y) (let ((add (+ y y0))) (set! y0 add) add))))</em>
-<em class=listener>0</em>
-<em class=listener>></em> <em class=typing>(let ((rd (make-sampler 0 0 0 1 0))) (map-channel (lambda (y) (- y (rd)))))</em>
-<em class=listener>0</em> ; the sampler is reading the unedited form of the sound
-<em class=listener>></em> <em class=typing>(maxamp)</em> ; i.e. how big is the biggest difference
-<em class=listener>0.0</em>
-</pre>
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<A NAME="cosinechannel">cosine-channel</a> (beg 0) dur snd chn edpos)
+<pre class="indented">
+> (let ((y0 0.0)) (map-channel (lambda (y) (let ((diff (- y y0))) (set! y0 y) diff))))
+0
+> (let ((y0 0.0)) (map-channel (lambda (y) (let ((add (+ y y0))) (set! y0 add) add))))
+0
+> (let ((rd (make-sampler 0 0 0 1 0))) (map-channel (lambda (y) (- y (rd)))))
+0 ; the sampler is reading the unedited form of the sound
+> (maxamp) ; i.e. how big is the biggest difference
+0.0
+</pre>
+
+<pre class="indented">
+(define* (<em class="noem" id="cosinechannel">cosine-channel</em> (beg 0) dur snd chn edpos)
(<em class=red>map-channel</em>
- (let* ((samps (or dur (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd chn)))
+ (let* ((samps (or dur (<a class=quiet href="#framples">framples</a> snd chn)))
(incr (/ pi samps))
(angle (* -0.5 pi)))
(lambda (y)
@@ -7502,34 +7911,37 @@ then check to see how close our reconstruction is to the original:
(set! angle (+ angle incr))
val)))
beg dur snd chn edpos))
-</pre></td></tr></table>
+</pre>
-Here's a slightly more involved example;
+<p id="mapsilence">Here's a slightly more involved example;
we define a function that finds silent portions and replaces them with
something:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (<A NAME="mapsilence">map-silence</a> in-silence replacement)
- (let ((buffer (<a class=quiet href="sndclm.html#make-moving-average" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_moving_average_tip)">make-moving-average</a> 128))
+<pre class="indented">
+(define (map-silence in-silence replacement)
+ (let ((buffer (<a class=quiet href="sndclm.html#make-moving-average">make-moving-average</a> 128))
(silence (/ in-silence 128)))
(lambda (y)
- (let ((sum-of-squares (<a class=quiet href="sndclm.html#moving-average" onmouseout="UnTip()" onmouseover="Tip(sndclm_moving_average_tip)">moving-average</a> buffer (* y y))))
+ (let ((sum-of-squares (<a class=quiet href="sndclm.html#moving-average">moving-average</a> buffer (* y y))))
(if (> sum-of-squares silence) y replacement)))))
(<em class=red>map-channel</em> (map-silence .01 0.0)) ; squelch background noise
(<em class=red>map-channel</em> (map-silence .001 #f)) ; remove silences altogether
-</pre></td></tr></table>
+</pre>
-Here we're using 'buffer', a CLM <a href="sndclm.html#moving-average">moving-average</a> generator, to track the
+<p>Here we're using 'buffer', a CLM <a href="sndclm.html#moving-average">moving-average</a> generator, to track the
RMS value of the last 128 input samples.
When that falls below
the argument 'silence', we replace the current sample with 'replacement'.
It may be easier in complex cases to use with-sound rather than map-channel.
See <a href="#setsamples">step-src</a> for example.
-<br><br>
-It is possible to break out of a map, flushing any edits, via call-with-current-continuation:
+</p>
+
+<p>It is possible to break out of a map, flushing any edits, via call-with-current-continuation:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define ctr 0)
(call-with-current-continuation
(lambda (return)
@@ -7538,10 +7950,12 @@ It is possible to break out of a map, flushing any edits, via call-with-current-
(if (> ctr 100)
(return "quitting!")
val)))))
-</pre></td></tr></table>
+</pre>
-It is also possible to stop, then continue map-channel:
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<p>It is also possible to stop, then continue map-channel:
+</p>
+
+<pre class="indented">
(define go-on #f)
(<em class=red>map-channel</em> (lambda (y)
(call-with-current-continuation
@@ -7549,258 +7963,296 @@ It is also possible to stop, then continue map-channel:
(if (> y 1.0)
(begin
(set! go-on stop)
- (throw 'oops)))))
+ (error 'oops)))))
.2))
-</pre></td></tr></table>
+</pre>
-If this hits a sample > 1.0, it will print 'oops and put the continuation in the variable 'go-on'.
-<code>(go-on)</code> will continue where you left off. (I'm not sure how far this can be pushed, or
+<p>If this hits a sample > 1.0, it will print 'oops and put the continuation in the variable 'go-on'.
+(go-on) will continue where you left off. (I'm not sure how far this can be pushed, or
whether it's a good idea — you may end up with unclosed files and so on).
-<br><br>
-If the editing action is not mapping something over the current sound, it is
+</p>
+
+<p>If the editing action is not mapping something over the current sound, it is
safest to write a temp file with the new data, then pass that to set-samples
with the 'trunc' argument set to #t. This way you don't assume the new sound
-will fit in memory (as in using <a class=quiet href="#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> for example).
+will fit in memory (as in using float-vector->channel for example).
Use <a href="#sndtempnam">snd-tempnam</a> to get a temporary filename that reflects the current
temp-dir setting. The env-sound-interp function in <a href="sndscm.html#envsoundinterp">examp.scm</a>
is an example of this.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define* (map-sound-chans proc (beg 0) dur snd edpos origin)
- (do ((i 0 (+ 1 i)))
- ((= i (<a class=quiet href="#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a> snd)))
+ (do ((i 0 (+ i 1)))
+ ((= i (<a class=quiet href="#chans">channels</a> snd)))
(<em class=red>map-channel</em> proc beg dur snd i edpos origin)))
-</pre></td></tr></table>
+</pre>
-An esoteric aside: map-channel sets up the sampler before calling the procedure, so if that procedure edits
+<p>An esoteric aside: map-channel sets up the sampler before calling the procedure, so if that procedure edits
the sound itself (independent of map-channel), the result will be all such edits after the current edit, then the map-channel result
-applied to the original (not the newly edited) data. That is,<br><pre>
+applied to the original (not the newly edited) data. That is,
+</p>
+<br>
+<pre class="indented">
(let ((first #t))
(<em class=red>map-channel</em> (lambda (y)
- (if first (set! (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> 0) 1.0))
+ (if first (set! (<a class=quiet href="#sample">sample</a> 0) 1.0))
(set! first #f)
(* y 2))))
</pre>
-will return with two edits registered in the edit history list; the map-channel result will be the original data doubled;
-the preceding edit in the list will be the <code>(set! (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> 0) 1.0)</code> which the map-channel ignores.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+
+<p>will return with two edits registered in the edit history list; the map-channel result will be the original data doubled;
+the preceding edit in the list will be the <code>(set! (<a class=quiet href="#sample">sample</a> 0) 1.0)</code> which the map-channel ignores.
+</p>
+<div class="separator"></div>
<!-- maxamp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="maxamp">maxamp</a> <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This returns the max amp of the given channel, or the overall maxamp of snd if no channel argument is given.
-Used with set!, it is equivalent to <a class=quiet href="#scaleto" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleto_tip)">scale-to</a>.
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (maxamp-all)
- "(maxamp-all) returns the current maxamp of all currently open sounds"
- (apply max (map (lambda (snd) (apply max (<em class=red>maxamp</em> snd #t))) (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
-</pre></td></tr></table>
+<pre class="indented">
+<em class=def id="maxamp">maxamp</em> snd chn edpos
+</pre>
+
+<p>This returns the max amp of the given channel, or the overall maxamp of snd if no channel argument is given.
+Used with set!, it is equivalent to <a class=quiet href="#scaleto">scale-to</a>.
+</p>
+
+<pre class="indented">
+(define maxamp-all
+ (let ((documentation "(maxamp-all) returns the current maxamp of all currently open sounds"))
+ (lambda ()
+ (apply max (map (lambda (snd) (apply max (<em class=red>maxamp</em> snd #t))) (<a class=quiet href="#sounds">sounds</a>))))))
+</pre>
<!-- INDEX maxampexamples:Maxamps -->
-<A NAME="maxampexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<blockquote><small>
-<br>
-Sound file maxamp: <a href="#mussoundmaxamp">mus-sound-maxamp</a><br>
-Region maxamp: <a href="#regionmaxamp">region-maxamp</a><br>
-Selection maxamp: <a href="#selectionmaxamp">selection-maxamp</a><br>
-Sound data object maxamp: <a href="#sounddatamaxamp">sound-data-maxamp</a><br>
-Vct maxamp: <a href="#vctpeak">vct-peak</a><br>
-To set the y axis bounds to reflect the channel's maxamp: <a href="#ybounds">y-bounds</a><br>
+<TABLE class="method">
+<tr><th class="title">Maxamps</th></tr><tr><td>
+<blockquote id="maxampexamples"><small>
+Sound file maxamp: <a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a><br>
+Region maxamp: <a href="extsnd.html#regionmaxamp">region-maxamp</a><br>
+Selection maxamp: <a href="extsnd.html#selectionmaxamp">selection-maxamp</a><br>
+To set the y axis bounds to reflect the channel's maxamp: <a href="extsnd.html#ybounds">y-bounds</a><br>
Mix maxamp: <a href="sndscm.html#mixmaxamp">mix-maxamp</a><br>
-maxamp locations: <a href="#maxampposition">maxamp-position</a>, <a href="#regionmaxampposition">region-maxamp-position</a>, <a href="#selectionmaxampposition">selection-maxamp-position</a>
-<br><br>
+maxamp locations: <a href="extsnd.html#maxampposition">maxamp-position</a>, <a href="extsnd.html#regionmaxampposition">region-maxamp-position</a>, <a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- maxamp-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="maxampposition">maxamp-position</a> <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This gives the location (sample number) of the maximum sample in the given channel.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="maxampposition">maxamp-position</em> snd chn edpos
+</pre>
+
+<p>This gives the location (sample number) of the maximum sample in the given channel.
+</p>
+<div class="separator"></div>
<!-- max-transform-peaks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="maxfftpeaks">max-transform-peaks</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns the maximum number of transform peaks reported.
+<pre class="indented">
+<em class=def id="maxfftpeaks">max-transform-peaks</em> snd chn
+</pre>
+
+<p>This returns the maximum number of transform peaks reported.
The default is 100. max-transform-peaks affects both the fft display (if <a href="#showtransformpeaks">show-transform-peaks</a>)
and the <a href="#peaks">peaks</a> function.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- min-dB -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="mindb">min-dB</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This sets the minimum dB value displayed in various graphs (the default is -60.0).
+<pre class="indented">
+<em class=def id="mindb">min-dB</em> snd chn
+</pre>
+
+<p>This sets the minimum dB value displayed in various graphs (the default is -60.0).
Due to problems with arithmetic underflows in sqrt, the spectrum functions set the lowest
actual dB value calculated to -140.0 or -180.0 (depending on which function is called and so on).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- new-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="newsound">new-sound</a> <em class=narg>:file :header-type :data-format :srate :channels :comment :size</em></code>
-</td></tr><tr><td></td><td>
-new-sound creates a new sound named 'file'. The following function opens a new sound named "test.snd",
+<pre class="indented">
+<em class=def id="newsound">new-sound</em> :file :channels :srate :sample-type :header-type :comment :size
+</pre>
+
+<p>new-sound creates a new sound named 'file'. The following function opens a new sound named "test.snd",
extends it to 'dur' samples, and initializes all samples to 'val':
-<pre>
- (define (init-sound val dur)
- (let ((ind (<em class=red>new-sound</em> "test.snd" :size dur)))
- (<a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) val))
- ind))
+</p>
+
+<pre class="indented">
+(define (init-sound val dur)
+ (let ((ind (<em class=red>new-sound</em> "test.snd" :size dur)))
+ (<a class=quiet href="#mapchannel">map-channel</a> (lambda (y) val))
+ ind))
</pre>
-If the 'header-type' and other
+
+<p>If the 'header-type' and other
arguments are not specified, they
default to the current <a href="#defaultoutputheadertype">default-output-header-type</a> and
-related settings. Data formats are (b=big-endian, l=little, u=unsigned):
-<pre>
- mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat
- mus-lfloat mus-bint mus-lint mus-b24int mus-l24int mus-bdouble mus-ldouble
- mus-ubshort mus-ulshort
+related settings. sample types are (b=big-endian, l=little, u=unsigned):
+</p>
+
+<pre class="indented">
+mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat
+mus-lfloat mus-bint mus-lint mus-b24int mus-l24int mus-bdouble mus-ldouble
+mus-ubshort mus-ulshort
</pre>
-Header-types are:
-<pre>
- mus-next mus-aifc mus-riff mus-rf64 mus-nist mus-raw mus-ircam mus-aiff
- mus-soundfont mus-bicsf mus-voc mus-svx mus-caff
+
+<p>Header-types are:
+</p>
+
+<pre class="indented">
+mus-next mus-aifc mus-riff mus-rf64 mus-nist mus-raw mus-ircam mus-aiff
+mus-soundfont mus-bicsf mus-voc mus-svx mus-caff
</pre>
-To be informed whenever a new sound is created, use <a href="#newsoundhook">new-sound-hook</a> (see ws.scm).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+
+<p>To be informed whenever a new sound is created, use <a href="#newsoundhook">new-sound-hook</a> (see ws.scm).
+</p>
+<div class="separator"></div>
<!-- normalize-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="normalizechannel">normalize-channel</a> norm <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-normalize-channel
+<pre class="indented">
+<em class=def id="normalizechannel">normalize-channel</em> norm beg dur snd chn edpos
+</pre>
+
+<p>normalize-channel
scales (changes the amplitude) of a sound so that its new peak amplitude is 'norm'. This
is the "regularized" form of <a href="#scaleto">scale-to</a>.
The multichannel version is <a href="sndscm.html#normalizesound">normalize-sound</a> in extensions.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- open-raw-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="openrawsound">open-raw-sound</a> <em class=narg>:file :channels :srate :data-format</em></code>
-</td></tr><tr><td></td><td>
-This opens 'file' as a raw (no header) sound in the layout specified.
-If the file has a header, it is not ignored (use <code>(set! (<a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_dataformat_tip)">data-format</a> ...))</code>
+<pre class="indented">
+<em class=def id="openrawsound">open-raw-sound</em> :file :channels :srate :sample-type
+</pre>
+
+<p>This opens 'file' as a raw (no header) sound in the layout specified.
+If the file has a header, it is not ignored (use (set! (<a class=quiet href="#sampletype">sample-type</a> ...))
and friends to get around this). If the header is messed up, you can override its settings by
giving the correct values in the call to open-raw-sound.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define mpg
- (lambda (mpgfile rawfile chans)
- "(<a class=quiet href="sndscm.html#mpg" onmouseout="UnTip()" onmouseover="Tip(sndscm_mpg_tip)">mpg</a> file tmpname chans) converts file from MPEG-3 to raw 16-bit samples using mpg123"
- (system (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "mpg123 -s ~A > ~A" mpgfile rawfile))
- (<em class=red>open-raw-sound</em> rawfile 1 44100 (if (<a class=quiet onmouseout="UnTip()" onmouseover="Tip('little-endian? returns #t if the host uses that byte order')">little-endian?</a>) <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_muslshort_tip)">mus-lshort</a> <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_musbshort_tip)">mus-bshort</a>))))
-</pre></td></tr></table>
+ (let ((documentation "(<a class=quiet href="sndscm.html#mpg">mpg</a> file tmpname chans) converts file from MPEG-3 to raw 16-bit samples using mpg123"))
+ (lambda (mpgfile rawfile chans)
+ (system (<a class=quiet>format</a> #f "mpg123 -s ~A > ~A" mpgfile rawfile))
+ (<em class=red>open-raw-sound</em> rawfile 1 44100 (if (<a class=quiet>little-endian?</a>) <a class=quiet href="#sampletype">mus-lshort</a> <a class=quiet href="#sampletype">mus-bshort</a>)))))
+</pre>
+
+<p>There's a more elaborate version of this function in examp.scm. See also <a href="#openrawsoundhook">open-raw-sound-hook</a>.
+</p>
+<div class="separator"></div>
-There's a more elaborate version of this function in examp.scm. See also <a href="#openrawsoundhook">open-raw-sound-hook</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
<!-- open-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="opensound">open-sound</a> filename</code>
-</td></tr><tr><td></td><td>
-open-sound opens 'filename' and returns the sound object; this is equivalent to the File:Open option. <a href="#viewsound">view-sound</a>
-opens a sound read-only, or you can set <a class=quiet href="#readonly" onmouseout="UnTip()" onmouseover="Tip(extsnd_readonly_tip)">read-only</a> by hand. <a class=quiet href="#closesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_closesound_tip)">close-sound</a>
+<pre class="indented">
+<em class=def id="opensound">open-sound</em> filename
+</pre>
+
+<p>open-sound opens 'filename' and returns the sound object; this is equivalent to the File:Open option. <a href="#viewsound">view-sound</a>
+opens a sound read-only, or you can set <a class=quiet href="#readonly">read-only</a> by hand. <a class=quiet href="#closesound">close-sound</a>
closes a file opened by open-sound. There are a variety of hooks that are invoked during the sound opening process:
-<a class=quiet href="#duringopenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_duringopenhook_tip)">during-open-hook</a>, <a class=quiet href="#openhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_openhook_tip)">open-hook</a>,
-<a class=quiet href="#afteropenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afteropenhook_tip)">after-open-hook</a>,
-<a class=quiet href="#initialgraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_initialgraphhook_tip)">initial-graph-hook</a>, <a class=quiet href="#openrawsoundhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_openrawsoundhook_tip)">open-raw-sound-hook</a>.
+<a class=quiet href="#duringopenhook">during-open-hook</a>, <a class=quiet href="#openhook">open-hook</a>,
+<a class=quiet href="#afteropenhook">after-open-hook</a>,
+<a class=quiet href="#initialgraphhook">initial-graph-hook</a>, <a class=quiet href="#openrawsoundhook">open-raw-sound-hook</a>.
The sequence of actions is:
-<pre>
- bad header?: <a class=quiet href="#badheaderhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_badheaderhook_tip)">bad-header-hook</a> — can cancel request
- no header?: <a class=quiet href="#openrawsoundhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_openrawsoundhook_tip)">open-raw-sound-hook</a> — can cancel request
- file ok:
- <a class=quiet href="#openhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_openhook_tip)">open-hook</a> — can change filename
- file opened (no data read yet)
- <a class=quiet href="#duringopenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_duringopenhook_tip)">during-open-hook</a> (can set prescaling etc)
- data read, no graphics yet
- <a class=quiet href="#afteropenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afteropenhook_tip)">after-open-hook</a>
- <a class=quiet href="#initialgraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_initialgraphhook_tip)">initial-graph-hook</a>
-</pre>
-There are
-other ways to get at sound file data: <a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> can be given a filename,
+</p>
+
+<pre class="indented">
+bad header?: <a class=quiet href="#badheaderhook">bad-header-hook</a> — can cancel request
+no header?: <a class=quiet href="#openrawsoundhook">open-raw-sound-hook</a> — can cancel request
+file ok:
+ <a class=quiet href="#openhook">open-hook</a> — can change filename
+ file opened (no data read yet)
+ <a class=quiet href="#duringopenhook">during-open-hook</a> (can set prescaling etc)
+ data read, no graphics yet
+ <a class=quiet href="#afteropenhook">after-open-hook</a>
+ <a class=quiet href="#initialgraphhook">initial-graph-hook</a>
+</pre>
+
+<p>There are
+other ways to get at sound file data: <a class=quiet href="#makesampler">make-sampler</a> can be given a filename,
rather than a sound; file->vct in examp.scm;
-<a class=quiet href="#mussoundopeninput" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundopeninput_tip)">mus-sound-open-input</a> and
+<a class=quiet href="#mussoundopeninput">mus-sound-open-input</a> and
there are a variety of CLM-based functions such as
-<a class=quiet href="sndclm.html#filetosample" onmouseout="UnTip()" onmouseover="Tip(sndclm_filetosample_tip)">file->sample</a> and
-<a class=quiet href="sndclm.html#filetoarray" onmouseout="UnTip()" onmouseover="Tip(sndclm_filetoarray_tip)">file->array</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<a class=quiet href="sndclm.html#filetosample">file->sample</a> and
+<a class=quiet href="sndclm.html#filetoarray">file->array</a>.
+</p>
+<div class="separator"></div>
<!-- pad-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="padchannel">pad-channel</a> beg dur <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-pad-channel inserts 'dur' zeros at 'beg' in the given channel. This is the <a class=quiet href="#regularizedargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_regularizedargs_tip)">regularized</a>
+<pre class="indented">
+<em class=def id="padchannel">pad-channel</em> beg dur snd chn edpos
+</pre>
+
+<p>pad-channel inserts 'dur' zeros at 'beg' in the given channel. This is the <a class=quiet href="#regularizedargs">regularized</a>
version of <a href="#insertsilence">insert-silence</a>. To set a block of samples to zero, use
<a href="#scalechannel">scale-channel</a> with a scaler of 0.0.
To insert a block of arbitrary-valued samples:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<A NAME="blockchannel">block-channel</a> value (beg 0) dur snd chn edpos)
- (<em class=red>pad-channel</em> beg dur snd chn edpos) ; insert 'dur' samples, ptree-channel sets their values
- (<a class=quiet href="#ptreechannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_ptreechannel_tip)">ptree-channel</a> (lambda (y) value) beg dur snd chn))
-</pre></td></tr></table>
-
-We could also use map-channel here (rather than ptree-channel), but this version
-uses only virtual edits, so no matter how big the block of samples we insert,
-no disk space or memory is needed.
-The multichannel version is <a href="sndscm.html#padsound">pad-sound</a> in frame.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+(define* (<em class="noem">block-channel</em> value (beg 0) dur snd chn edpos)
+ (<em class=red>pad-channel</em> beg dur snd chn edpos) ; insert 'dur' samples
+ (map-channel (lambda (y) value) beg dur snd chn))
+</pre>
+<div class="separator"></div>
<!-- pausing -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="pausing">pausing</a></code>
-</td></tr><tr><td></td><td>
-pausing is #t if sound output is currently paused. You can unpause the sound by setting pausing to #f,
+<pre class="indented">
+<em class=def id="pausing">pausing</em>
+</pre>
+
+<p>pausing is #t if sound output is currently paused. You can unpause the sound by setting pausing to #f,
and pause it by setting pausing to #t. If you pause a sound (via C-click of the play button, for example),
then call <a href="#play">play</a> (via a key binding perhaps), the sound remains paused by default. To
cancel the current pause and restart with the new play command:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> (char->integer #\p) 0
+<pre class="indented">
+(<a class=quiet href="#bindkey">bind-key</a> (char->integer #\p) 0
(lambda ()
- (if (<em class=red>pausing</em>) (<a class=quiet href="#stopplaying" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopplaying_tip)">stop-playing</a>))
- (<a class=quiet href="#play" onmouseout="UnTip()" onmouseover="Tip(extsnd_play_tip)">play</a>)))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+ (if (<em class=red>pausing</em>) (<a class=quiet href="#stopplaying">stop-playing</a>))
+ (<a class=quiet href="#play">play</a>)))
+</pre>
+<div class="separator"></div>
<!-- peaks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="peaks">peaks</a> <em class=narg>file snd chn</em></code>
-</td></tr><tr><td></td><td>
-peaks displays fft peak information. If 'file' is not null, it writes
-the information to that file, otherwise it posts the data in a help window
-(where it can be selected and pasted elsewhere). The maximum number of peaks reported is set
+<pre class="indented">
+<em class=def id="peaks">peaks</em> file snd chn
+</pre>
+
+<p>peaks displays fft peak information. If 'file' is not null, it writes
+the information to that file, otherwise it posts the data in a help window.
+The maximum number of peaks reported is set
by <a href="#maxfftpeaks">max-transform-peaks</a>.
+</p>
-<pre>
-(hook-push <a class=quiet href="#aftertransformhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftertransformhook_tip)">after-transform-hook</a> (lambda (a b c)
- (<em class=red>peaks</em>))) ; post a detailed list of peaks after each FFT
+<pre class="indented">
+(hook-push <a class=quiet href="#aftertransformhook">after-transform-hook</a>
+ (lambda (hook)
+ (<em class=red>peaks</em>))) ; post a detailed list of peaks after each FFT
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- play -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="play">play</a> <em class=narg>object :start :end :channel :edit-position :out-channel :with-sync :wait :stop :srate :channels</em></code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="play">play</em> object :start :end :channel :edit-position :out-channel :with-sync :wait :stop :srate :channels
+</pre>
+
<p>
play plays 'object'. If no arguments are passed, it plays the currently selected sound.
'object' can be a string (sound filename), a sound object or index, a mix, a region, the selection object, #f, a procedure, or a player.
@@ -7816,70 +8268,80 @@ Not all the keyword arguments apply in all cases, though I hope to fill in the t
'srate' and 'channels' are for one special case, described below.
</p>
-<pre>
- (play) ; play current sound, all chans from start to end
- (play 0 :channel 1) ; play just the second channel of sound 0
- (play ((selected-sound) <a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>)) ; play starting from the cursor
- (play (integer->sound 1) (round (* 3.0 (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))) :channel 3) ; play snd 1, chan 3 (4th chan), start at 3.0 secs
- (play (selected-sound) 0 :with-sync #t) ; play sync'd sounds
- (play (selected-sound) 0 :end (round (* 3.0 (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>)))) ; play from start for 3.0 secs
- (play (selected-sound) 0 :edit-position 2) ; play the version at edit history position 2
- (play (integer->sound 0) 0 :channel 2 :out-channel 0) ; play chan 2, but send it to DAC chan 0
- (play (selected-sound) (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> (integer->mark 0)) :end (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> (integer->mark 1))); play between marks 0 and 1
- (play (selection)) ; play the selection
- (play #f :srate 44100 :channels 2) ; open DAC and run, stop with stop-playing
- (play "1a.snd") ; play 1a.snd
- (play "1a.snd" 1000 4000) ; play 1a.snd from sample 1000 to 4000
+<pre class="indented">
+(play) ; play current sound, all chans from start to end
+(play 0 :channel 1) ; play just the second channel of sound 0
+(play ((selected-sound) <a class=quiet href="#cursor">cursor</a>)) ; play starting from the cursor
+(play (integer->sound 1) (round (* 3.0 (<a class=quiet href="#srate">srate</a>))) :channel 3) ; play snd 1, chan 3 (4th chan), start at 3.0 secs
+(play (selected-sound) 0 :with-sync #t) ; play sync'd sounds
+(play (selected-sound) 0 :end (round (* 3.0 (<a class=quiet href="#srate">srate</a>)))) ; play from start for 3.0 secs
+(play (selected-sound) 0 :edit-position 2) ; play the version at edit history position 2
+(play (integer->sound 0) 0 :channel 2 :out-channel 0) ; play chan 2, but send it to DAC chan 0
+(play (selected-sound) (<a class=quiet href="#marksample">mark-sample</a> (integer->mark 0)) :end (<a class=quiet href="#marksample">mark-sample</a> (integer->mark 1))); play between marks 0 and 1
+(play (selection)) ; play the selection
+(play #f :srate 44100 :channels 2) ; open DAC and run, stop with stop-playing
+(play "1a.snd") ; play 1a.snd
+(play "1a.snd" 1000 4000) ; play 1a.snd from sample 1000 to 4000
</pre>
+
<p>
If 'stop' is a procedure of one argument, it is called when the play process stops.
The argument passed to the stop procedure provides the reason the play is stopping; it will be 0 if the play completed normally.
This is intended mainly for looping plays, as in <a href="sndscm.html#playoften">play-often</a>.
</p>
-<pre>
- (play (selected-sound) 0 :stop (lambda (reason) ; if interrupted, say so in the listener
- (if (not (= reason 0))
- (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> ";play interrupted"))))
+
+<pre class="indented">
+(play (selected-sound) 0 :stop (lambda (reason) ; if interrupted, say so in the listener
+ (if (not (= reason 0))
+ (<a class=quiet href="#sndprint">snd-print</a> ";play interrupted"))))
</pre>
+
<p>
The 'edit-position' argument makes it easier to try "A:B" comparisons; this plays the version before the latest edit:
</p>
-<pre>
- (play (selected-sound) :edit-position (- (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a>) 1))
+
+<pre class="indented">
+(play (selected-sound) :edit-position (- (<a class=quiet href="#editposition">edit-position</a>) 1))
</pre>
+
<p>
The following code binds the "p" key to play all channels of the current sound from the cursor, and
the "P" key to play the previous version of the current sound:
</p>
-<table border=0 cellpadding=5><tr><td><pre>
+
+<pre class="indented">
(define (play-from-cursor current)
- (<em class=red>play</em> (selected-sound) (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) :edit-position (if current #f (- (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a>) 1))))
+ (<em class=red>play</em> (selected-sound) (<a class=quiet href="#cursor">cursor</a>) :edit-position (and (not current) (- (<a class=quiet href="#editposition">edit-position</a>) 1))))
-(<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> (char->integer #\p) 0
- (lambda () "play from cursor" (play-from-cursor #t) <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_keyboard_no_action_tip)">keyboard-no-action</a>))
+(<a class=quiet href="#bindkey">bind-key</a> (char->integer #\p) 0
+ (lambda () "play from cursor" (play-from-cursor #t) <a class=quiet>keyboard-no-action</a>))
-(<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> (char->integer #\P) 0
- (lambda () "play previous version from cursor" (play-from-cursor #f) <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_keyboard_no_action_tip)">keyboard-no-action</a>))
-</pre></td></tr></table>
-<p>
+(<a class=quiet href="#bindkey">bind-key</a> (char->integer #\P) 0
+ (lambda () "play previous version from cursor" (play-from-cursor #f) <a class=quiet>keyboard-no-action</a>))
+</pre>
+
+<p id="pfc">
And here we play from the cursor with a moving ("tracking") cursor:
</p>
-<table border=0 cellpadding=5><tr><td><pre>
-(define (<A NAME="pfc">pfc</a>)
- (let ((old-tracking (<a class=quiet href="#withtrackingcursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_withtrackingcursor_tip)">with-tracking-cursor</a>)))
- (set! (<a class=quiet href="#withtrackingcursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_withtrackingcursor_tip)">with-tracking-cursor</a>) #t)
- (hook-push <a class=quiet href="#stopplayinghook" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopplayinghook_tip)">stop-playing-hook</a>
- (lambda (snd)
- (set! (<a class=quiet href="#withtrackingcursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_withtrackingcursor_tip)">with-tracking-cursor</a>) old-tracking)))
- (<em class=red>play</em> (selected-sound) (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>))))
-</pre></td></tr></table>
+
+<pre class="indented">
+(define (pfc)
+ (let ((old-tracking (<a class=quiet href="#withtrackingcursor">with-tracking-cursor</a>)))
+ (set! (<a class=quiet href="#withtrackingcursor">with-tracking-cursor</a>) #t)
+ (hook-push <a class=quiet href="#stopplayinghook">stop-playing-hook</a>
+ (lambda (hook)
+ (set! (<a class=quiet href="#withtrackingcursor">with-tracking-cursor</a>) old-tracking)))
+ (<em class=red>play</em> (selected-sound) (<a class=quiet href="#cursor">cursor</a>))))
+</pre>
+
<p>
If 'object' is #f, the :srate and :channels arguments set up the DAC.
The DAC then stays open until you call <a href="#stopplaying">stop-playing</a>. This is useful
when you're using bind-key and play to trigger sounds, but want the output to have more channels
than the various inputs.
</p>
-<table border=0 cellpadding=5><tr><td><pre>
+
+<pre class="indented">
(bind-key #\o 0
(lambda () ; send oboe.snd to chan 0
(play "oboe.snd" :out-channel 0)))
@@ -7895,28 +8357,31 @@ than the various inputs.
;;; this holds the DAC open indefinitely
;;; Now type o and p in the sound pane until you want to quit, then
-(stop-playing)
-</pre></td></tr></table>
+(stop-playing)
+</pre>
+
<p>
Finally, if 'object' is a function, it is called on every sample; if it returns a number, that number is
sent to the DAC; if it returns #f, it stops. <a href="sndscm.html#playmixes">play-mixes</a> uses this
function option to time the playing of each mix in a sequence of mixes. Another example is <a href="sndscm.html#playsine">play-sine</a>:
</p>
-<table border=0 cellpadding=5><tr><td><pre>
-(define (play-sine freq amp)
- "(play-sine freq amp) plays a 1 second sinewave at freq and amp"
- (let* ((len 22050)
- (osc (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq)))
- (<em class=red>play</em> (lambda ()
- (set! len (- len 1))
- (if (<= len 0) ; we've sent 22050 samples, so it's time to stop
- #f
- (* amp (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc)))))))
-</pre></td></tr></table>
+
+<pre class="indented">
+(define play-sine
+ (let ((documentation "(play-sine freq amp) plays a 1 second sinewave at freq and amp"))
+ (lambda (freq amp)
+ (let ((len 22050)
+ (osc (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> freq)))
+ (<em class=red>play</em> (lambda ()
+ (set! len (- len 1))
+ (and (positive? len) ; we've sent 22050 samples, so it's time to stop
+ (* amp (<a class=quiet href="sndclm.html#oscil">oscil</a> osc)))))))))
+</pre>
<p>Here's another example that plays a sound file, skipping any portion that looks like silence:
</p>
-<table border=0 cellpadding=5><tr><td><pre>
+
+<pre class="indented">
(define (play-skipping-silence file)
(let ((buffer (make-moving-average 128))
(silence (/ .001 128))
@@ -7927,139 +8392,141 @@ function option to time the playing of each mix in a sequence of mixes. Another
(let loop ()
(set! y (rd))
(set! sum-of-squares (moving-average buffer (* y y)))
- (if (sampler-at-end? rd)
- #f
- (if (> sum-of-squares silence)
- y
- (loop))))))))
-</pre></td></tr></table>
-
+ (and (not (sampler-at-end? rd))
+ (if (> sum-of-squares silence)
+ y
+ (loop))))))))
+</pre>
<!-- INDEX playexamples:Playing -->
-<A NAME="playexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<small><blockquote>
-play one channel: (play sound-object :channel n), play button in control panel or files dialog<br>
+<TABLE class="method">
+<tr><th class="title">Play</th></tr><tr><td>
+<blockquote id="playexamples"><small>
play from cursor: C-q and example above<br>
-play from cursor with tracking cursor: <a href="#pfc">pfc</a> above<br>
+play from cursor with tracking cursor: <a href="extsnd.html#pfc">pfc</a> above<br>
play the selection: (play (selection)), <a href="snd.html#cxp">C-x p</a><br>
play a region: (play region-object), <a href="snd.html#cxp">C-x p</a>, play button in Region dialog<br>
play a mix: (play mix-object), play button in Mix dialog<br>
play a sequence of mixes: <a href="sndscm.html#playmixes">play-mixes</a><br>
-play from mark: click triangle (control-click for all chans)<br>
-play continuously between two marks: <a href="sndscm.html#loopbetweenmarks">loop-it</a><br>
-stop playing: C-g, C-t, <a href="#stopplaying">stop-playing</a>, set <a href="#playing">playing</a> to #f<br>
-pause or resume playback: space, set <a href="#pausing">pausing</a><br>
+play from mark: click or drag triangle (control-click for all chans)<br>
+stop playing: C-g, C-t, <a href="extsnd.html#stopplaying">stop-playing</a>, set <a href="extsnd.html#playing">playing</a> to #f<br>
+pause or resume playback: space, set <a href="extsnd.html#pausing">pausing</a><br>
play repeatedly: <a href="sndscm.html#playoften">play-often</a><br>
play repeatedly until C-g: <a href="sndscm.html#playuntilcg">play-until-c-g</a><br>
play region repeatedly: <a href="sndscm.html#playregionforever">play-region-forever</a><br>
-play a file upon a keystroke: <a href="#extendedpiano">bind-key</a><br>
+play a file upon a keystroke: <a href="extsnd.html#extendedpiano">bind-key</a><br>
play using an external program: (system "sndplay wood16.wav")<br>
play a sine-wave or spectrum: <a href="sndscm.html#playsine">play-sine</a> and <a href="sndscm.html#playsines">play-sines</a><br>
-play arbitrary mixtures of things: <a href="#makeplayer">make-player</a> and related functions, <a href="sndscm.html#playsyncdmarks">play-syncd-marks</a><br>
-send arbitrary data to the DAC: <a href="#musaudiowrite">mus-audio-write</a>, <a href="sndscm.html#startdac">start-dac</a><br>
-play after sending the data through some function: <a href="sndscm.html#playsound">play-sound</a><br>
-play with applied amplitude envelope: <a href="sndscm.html#playwithenvs">play-with-envs</a>, <a href="sndscm.html#playpanned">play-panned</a><br>
+play arbitrary mixtures of things: <a href="extsnd.html#makeplayer">make-player</a> and related functions, <a href="sndscm.html#playsyncdmarks">play-syncd-marks</a><br>
+play with applied amplitude envelope: <a href="sndscm.html#playwithenvs">play-with-envs</a><br>
play an external file: (play "file")<br>
-<br>
-</blockquote></small>
+</small></blockquote>
</td></tr></TABLE>
-<A NAME="stopplayreasons"></a>
-
-<p>
+<p id="stopplayreasons">
The "reasons" that might be passed to the stop-procedure are:
</p>
-<pre>
- 0 play completed normally
- 1 file is being closed
- 2 play button unset
- 3 stop-playing function called
- 4 C-g
- 5 DAC error (no available channel)
- 6 play error (audio setup problem)
- 7 apply requested (control panel)
- 8 file edited
- 9 C-t
+
+<pre class="indented">
+0 play completed normally
+1 file is being closed
+2 play button unset
+3 stop-playing function called
+4 C-g
+5 DAC error (no available channel)
+6 play error (audio setup problem)
+7 apply requested (control panel)
+8 file edited
+9 C-t
</pre>
+
<p>
The hooks called during a play operation are:
</p>
-<pre>
- when a play request occurs: <a class=quiet href="#startplayinghook" onmouseout="UnTip()" onmouseover="Tip(extsnd_startplayinghook_tip)">start-playing-hook</a> — can cancel the request,
- also <a class=quiet href="#startplayingselectionhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_startplayingselectionhook_tip)">start-playing-selection-hook</a>
- (any number of sounds can be playing at once)
- as each buffer is sent to the audio device: <a class=quiet href="#playhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_playhook_tip)">play-hook</a> and <a class=quiet href="#dachook" onmouseout="UnTip()" onmouseover="Tip(extsnd_dachook_tip)">dac-hook</a>
- as each sound ends: <a class=quiet href="#stopplayinghook" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopplayinghook_tip)">stop-playing-hook</a>, <a class=quiet href="#stopplayingselectionhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopplayingselectionhook_tip)">stop-playing-selection-hook</a>
- close audio device: <a class=quiet href="#stopdachook" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopdachook_tip)">stop-dac-hook</a>
+
+<pre class="indented">
+when a play request occurs: <a class=quiet href="#startplayinghook">start-playing-hook</a> — can cancel the request,
+ also <a class=quiet href="#startplayingselectionhook">start-playing-selection-hook</a>
+ (any number of sounds can be playing at once)
+as each sound ends: <a class=quiet href="#stopplayinghook">stop-playing-hook</a>, <a class=quiet href="#stopplayingselectionhook">stop-playing-selection-hook</a>
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- player-home -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="playerhome">player-home</a> player</code>
-</td></tr><tr><td></td><td>
-This returns a list of the sound and channel number associated with <a href="#makeplayer">player</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="playerhome">player-home</em> player
+</pre>
+
+<p>This returns a list of the sound and channel number associated with <a href="#makeplayer">player</a>.
+</p>
+<div class="separator"></div>
<!-- playing -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="playing">playing</a></code>
-</td></tr><tr><td></td><td>
-This returns #t if sound output is currently in progress. You can also start playing by setting playing to #t (equivalent
+<pre class="indented">
+<em class=def id="playing">playing</em>
+</pre>
+
+<p>This returns #t if sound output is currently in progress. You can also start playing by setting playing to #t (equivalent
to calling <a href="#startplaying">start-playing</a> with default arguments), and stop by setting it to #f
(equivalent to <a href="#stopplaying">stop-playing</a>).
-playing only notices Snd-instigated "play" processes;
-<a href="#musaudioopenoutput">mus-audio-open-output</a> is invisible to it.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- players -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="players">players</a></code>
-</td></tr><tr><td></td><td>
-This returns a list of currently active <a href="#makeplayer">players</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="players">players</em>
+</pre>
+
+<p>This returns a list of currently active <a href="#makeplayer">players</a>.
+</p>
+<div class="separator"></div>
<!-- player? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="playerQ">player?</a> obj</code>
-</td></tr><tr><td></td><td>
-This returns #t if 'obj' is an active <a href="#makeplayer">player</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="playerQ">player?</em> obj
+</pre>
+
+<p>This returns #t if 'obj' is an active <a href="#makeplayer">player</a>.
+</p>
+<div class="separator"></div>
<!-- position->x -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="positiontox">position->x</a> xpos <em class=narg>snd chn axis</em></code>
-</td></tr><tr><td></td><td>
-This returns the x axis value that corresponds to the graph (screen pixel) position 'xpos'.
+<pre class="indented">
+<em class=def id="positiontox">position->x</em> xpos snd chn axis
+</pre>
+
+<p>This returns the x axis value that corresponds to the graph (screen pixel) position 'xpos'.
To find the sample that the mouse is pointing at, given the current mouse position,
-<pre>
- (round (* (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd) (position->x x snd chn)))
+</p>
+
+<pre class="indented">
+(round (* (<a class=quiet href="#srate">srate</a> snd) (position->x x snd chn)))
</pre>
-See gui.scm for examples.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- position->y -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="positiontoy">position->y</a> ypos <em class=narg>snd chn axis</em></code>
-</td></tr><tr><td></td><td>
-This returns the y axis value that corresponds to the graph (screen pixel) position 'ypos'.
-See gui.scm for examples.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="positiontoy">position->y</em> ypos snd chn axis
+</pre>
+
+<p>This returns the y axis value that corresponds to the graph (screen pixel) position 'ypos'.
+</p>
+<div class="separator"></div>
<!-- progress-report -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="progressreport">progress-report</a> pct <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-The functions <a href="#startprogressreport">start-progress-report</a>, progress-report, and
+<pre class="indented">
+<em class=def id="progressreport">progress-report</em> pct snd chn
+</pre>
+
+<p>The functions <a href="#startprogressreport">start-progress-report</a>, progress-report, and
<a href="#finishprogressreport">finish-progress-report</a> handle the animated hour-glass icon
that hopes to amuse the idle user while some long computation is in progress.
The 'pct' argument is a float between 0.0 and 1.0 which indicates how
@@ -8067,950 +8534,591 @@ far along we are in the computation; there are only 20 separate
icons, so there's no point in calling this more often than that.
<a href="#startprogressreport">start-progress-report</a> posts the initial icon, and <a href="#finishprogressreport">finish-progress-report</a>
removes it. If the icons are not available, a message is posted in
-the sound's minibuffer using 'name' to identify itself.
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
-
-<!-- prompt-in-minibuffer -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="promptinminibuffer">prompt-in-minibuffer</a> msg <em class=narg>callback snd raw</em></code>
-</td></tr><tr><td></td><td>
-This posts 'msg' in the sound's minibuffer and when you respond,
-it calls 'callback' with the response as the callback's argument.
-If 'callback' is specified it should be either #f or a function of
-one argument: the raw response if 'raw' is #t, otherwise the evaluated response.
-For example, the following fragment asks for
-a yes-or-no response, then takes some action:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
- (define* (yes-or-no question action-if-yes action-if-no snd)
- (<em class=red>prompt-in-minibuffer</em> question
- (lambda (response)
- (<a class=quiet href="#clearminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_clearminibuffer_tip)">clear-minibuffer</a>)
- (if (string=? response "yes")
- (action-if-yes snd)
- (action-if-no snd)))
- snd #t))
-</pre></td></tr></table>
-
-See eval-over-selection in <a href="sndscm.html#extensionsdoc">extensions.scm</a> for a more useful example.
-We could also use a continuation here:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (prompt msg default)
- (call-with-current-continuation
- (lambda (rsvp)
- (<em class=red>prompt-in-minibuffer</em> msg rsvp)
- default)))
-</pre></td></tr></table>
-
-The 'raw' argument is useful when we want to prompt for yes or no, without forcing the
-user to put the answer in double quotes. In the next example, we replace Snd's
-built-in C-x k action (which immediately closes the sound) with one that is
-more like Emacs (it prompts for confirmation first):
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> (char->integer #\k) 0
- (lambda ()
- "close sound"
- (<a class=quiet href="#clearminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_clearminibuffer_tip)">clear-minibuffer</a>)
- (<em class=red>prompt-in-minibuffer</em>
- (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "close ~S (cr=yes)?" (<a class=quiet href="#shortfilename" onmouseout="UnTip()" onmouseover="Tip(extsnd_shortfilename_tip)">short-file-name</a>))
- (lambda (response)
- (if (or (not (string? response))
- (= (string-length response) 0)
- (char=? (string-ref response 0) #\y))
- (<a class=quiet href="#closesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_closesound_tip)">close-sound</a>)))
- #f ; selected sound
- #t)) ; treat as string (i.e. don't require double quotes)
- #t) ; C-x ...
-</pre></td></tr></table></td></tr>
-<tr><td colspan=2 height=18></td></tr>
-
-
-<!-- INDEX ptreechannel:Virtual Edits -->
-<!-- ptree-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="ptreechannel">ptree-channel</a> proc <em class=narg>beg dur snd chn edpos env-too init-func origin</em></code>
-</td></tr><tr><td></td><td>
-ptree-channel
-applies the function 'proc' as a 'virtual edit'; that is, the effect of 'proc'
-comes about as an implicit change in the way the data is read.
-
-<br><br>
-To be less Orphic:
-all the data accesses in Snd go through the edit-history list. The currently
-active member of that list
-chooses a channel data accessor based on the type of edit. A multiply by 2, for
-example, does not multiply anything by 2 internally; it just chooses
-the accessor that multiplies by 2 on any read. Since every other data access goes through this reader, from any other
-point of view, the data has been multiplied. These accessors make it
-unnecessary to save any data in temp files or internal arrays, and editing the edit-history list is very
-fast — we just tack a new accessor choice onto the edit-history list, so the edit operation
-appears to be instantaneous and memory-less. Lots of other operations
-are already being done this way in Snd (deletions, scaling, most
-envelopes, some channel swaps, etc). ptree-channel extends the idea to (nearly) arbitrary
-functions. When you call
-<pre>
- (ptree-channel (lambda (y) (* y 2)))
-</pre>
-which has the same effect as
-<pre>
- (<a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (* y 2)))
-</pre>
-the
-optimizer makes the parse-tree that represents <code>(lambda (y) (* y 2))</code>, then the
-data accessor system uses that parse-tree every time the data is
-read.
-<br><br>
-
-If the argument 'env-too' is #t,
-the same function is applied to the peak env values to get the new version of the peak env data.
-The default is #f, and should be #t only if the old max and min values as processed through 'proc'
-will be the new max and min values.
-Snd uses the peak env values when the graph of the sound covers very large amounts of data.
-If 'env-too' is #f, a background process is launched reading all the sound data through
-'proc'; this can be time-consuming, so if you're viewing a half-hour of sound data,
-it can take awhile for the ptree-channel results to be displayed.
-<br><br>
-
-Here is an example that adds a constant to each sample in a file.
-<pre>
- (define* (offset-channel dc (beg 0) dur snd chn edpos)
- (<em class=red>ptree-channel</em> (lambda (y) (+ y dc)) beg dur snd chn edpos <em class=red>#t</em>))
-</pre>
-The actual edit that takes place is <code>(+ y dc)</code>; that is, 'dc' is added to
-every sample. As subsequent editing takes place, the entries representing the 'offset-channel'
-call can become thoroughly fragmented.
-If your editing operation has any state (i.e. needs to
-know where it is in the data), you need to add an 'init-func' (the 8th argument to ptree-channel).
-The 'init-func' takes two arguments, the begin time of the read operation, relative to
-the original start of the fragment, and the original fragment duration (both in samples).
-It should return
-the information the main function ('proc' above) needs to
-handle the current fragment correctly. Global variables are not guaranteed to
-be set within the body of 'proc', so use a vct for local values that change
-as the read operation progresses.
-<br><br>
-
-The other new argument to 'proc'
-is the read direction; the read operations can change direction at any
-time, and any ptree-channel function needs to know how to deal with that.
-So, in the complicated, 3 argument case,
-the sequence of operations is:
-a read is requested, 'init-func' is called with the read start point (relative to the
-original segment start),
-it returns any state that 'proc' may need
-to refer to, then each time a sample is needed from the current sample
-reader, 'proc' is called passing it the current underlying sample, the return value of 'init-func',
-and the read direction.
-Here is an example that mixes a sine wave into the current channel:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (sine-channel freq amp (beg 0) dur snd chn edpos)
- (<em class=red>ptree-channel</em>
- (lambda (y data forward)
- (let* ((angle (data 0))
- (incr (data 1))
- (val (+ y (* (data 2) (sin angle)))))
- (if forward
- (set! (data 0) (+ angle incr))
- (set! (data 0) (- angle incr)))
- val))
- beg dur snd chn edpos #f
- (lambda (frag-beg frag-dur)
- (let ((incr (/ (* 2 pi freq) (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))))
- (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip('fmod is mod with float arguments')">fmod</a> (* frag-beg incr) (* 2 pi)) incr amp))))) ; fmod from C
-</pre></td></tr></table>
-
-In the normal case,
-this function just mixes in a sine wave: <code>(+ y (* (data 2) (sin angle)))</code>
-where the amplitude scaler is stored in <code>(data 2)</code>. In subsequent
-reads, the init-func sets up a vct with the current phase (dependent on the frequency
-and the fragment begin sample), the phase increment (dependent on the frequency), and
-the amplitude (passed as an argument to sine-channel, but stored in the vct since
-the outer function's arguments won't be accessible in the main function ('proc')).
-See 'sine-ramp' in extensions.scm for another example.
-<br><br>
-
-In our 'sine-channel' function, we passed #f as the 'env-too' argument,
-to make sure Snd doesn't blithely apply the sine mix to the peak amplitude
-envelopes. When 'env-too' is #t,
-'proc' is evaluated over the peak env data, rather than the
-original data. This makes redisplay much faster whenever a lot of data
-is being displayed, but only works if the function's output at the peak
-env min and max values are still the min and max values in the actual
-data (this is the case in the sinusoidal envelope, sine-ramp, mentioned above).
-When 'proc' is being called to calculate the new peak env,
-the duration passed to the init-func is the envelope size.
-Here is a
-version of cosine-channel given under
-<a href="#mapchannel">map-channel</a> that can handle peak-envs:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<A NAME="cosinechannelviaptree">cosine-channel-via-ptree</a> (beg 0) dur snd chn edpos)
- ;; vct: angle increment
- (<em class=red>ptree-channel</em>
- (lambda (y data forward)
- (let* ((angle (data 0))
- (incr (data 1))
- (val (* y (cos angle))))
- (if forward
- (set! (data 0) (+ angle incr))
- (set! (data 0) (- angle incr)))
- val))
- beg dur snd chn edpos <em class=red>#t</em>
- (lambda (frag-beg frag-dur)
- (let ((incr (/ pi <em class=red>frag-dur</em>)))
- (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> (+ (* -0.5 pi) (* frag-beg incr))
- incr)))))
-</pre></td></tr></table>
-
-If the underlying data
-has too many previous ptree operations (more than <a href="#maxvirtualptrees">max-virtual-ptrees</a>), map-channel is called instead and the new
-data is saved in the normal manner.
-
-<br><br>
-
-If no 'init-func' is specified, the editing procedure ('proc') should not assume anything about
-the context in which it is called; in this case, there's no way for 'proc' to know where it starts, or when it is being restarted,
-or which direction it is running, so,
-the following call:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
- (let ((ctr 0))
- (<em class=red>ptree-channel</em> (lambda (y)
- (set! ctr (+ 1 ctr))
- (* ctr .0001))))
-</pre></td></tr></table>
-
-will never reset ctr to 0! Every time a portion of the data is read by Snd, the samples will be
-higher. But, the notion of an accessor that returns a different thing each time a sample
-is accessed is not foolish:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (dither-channel (amount .00006) beg dur snd chn edpos)
- (let ((dither (* .5 amount)))
- (<em class=red>ptree-channel</em>
- (lambda (y)
- (+ y (<a class=quiet href="sndclm.html#mus-random" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_random_tip)">mus-random</a> dither) (<a class=quiet href="sndclm.html#mus-random" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_random_tip)">mus-random</a> dither)))
- beg dur snd chn edpos #t)))
-</pre></td></tr></table>
-
-This gives a slightly different take on the sound each time you look at it or listen to it;
-the dithering is never exactly the same. But if the details of the noise don't
-matter (presumably the case with dithering), the difference is unproblematic. You're editing a sort
-of mobile in sound (analogous to mobile sculpture).
-<br><br>
-One major limitation of ptree-channel with an 'init-func' is that <a href="#savestate">save-state</a>
-currently doesn't know how to save the enclosing environment along with the init-func. So,
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
- (let ((outer 0.5))
- (<em class=red>ptree-channel</em> (lambda (y data forward)
- (<a class=quiet href="#declare" onmouseout="UnTip()" onmouseover="Tip(extsnd_declare_tip)">declare</a> (y real) (data float) (forward boolean))
- (* y data))
- 0 #f ind 0 #f #f
- (lambda (pos dur)
- outer)))
-</pre></td></tr></table>
-
-will not save the "outer" declaration in the saved state file.
-This is a general problem with save-state; there's no obvious way in Scheme to
-save the current closure as text.
-You can fix the saved state file by hand (it is just Scheme, Ruby, or Forth code, of course),
-but that's not a very elegant solution.
-<br><br>
-
-The real limitation in using ptree-channel, however, arises from the fact that the read direction
-can not only be backwards, but it can also change at any time. In conjunction with
-the fragmentation during editing, this makes it
-hard to use CLM generators, or anything that depends on previous samples.
-Since the run macro (on which ptree-channel depends) is currently limited in
-the kinds of vector or list elements it can decipher, you're pretty tightly
-constricted in this context.
-The read direction argument can be ignored if you know you're not going to read backwards.
-The only hidden reverse read is in the src generator where a negative increment can be
-generated in a variety of ways (for example, src driven by oscil). A one zero filter
-could in this case be:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
- (<em class=red>ptree-channel</em> (lambda (y data forward)
- (let ((val (* 0.5 (+ y (data 0)))))
- (set! (data 0) y)
- val))
- 0 (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) ind 0 #f #f ; "ind" is the sound
- (let ((edpos (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> ind 0)))
- (lambda (pos dur)
- (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> (if (= pos 0) 0.0
- (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> (- pos 1) ind 0 edpos))))))
-</pre></td></tr></table>
-
-See also virtual-filter-channel in snd-test.scm; it uses the optional third argument to the init function
-to set up the filter state correctly, and has code to run the filter backwards if necessary.
-Here are several more examples:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (ptree-scale scl (beg 0) dur snd chn edpos)
- "ptree-channel version of scale-channel"
- (<em class=red>ptree-channel</em>
- (lambda (y)
- (* scl y))
- beg dur snd chn edpos #t))
-
-(define* (ptree-xramp r0 r1 ubase (beg 0) dur snd chn edpos)
- "exponential version of ramp-channel"
- ;; this is essentially what CLM's exponential envelope generator is doing
- ;; to accommodate C, it uses (exp (* power (log base))) prescaling power by (log base)
- (let* ((base (if (> r0 r1) (/ 1.0 ubase) ubase)))
- (<em class=red>ptree-channel</em>
- (lambda (y data forward)
- (let* ((lr0 (data 0))
- (lbase (data 1))
- (incr (data 2))
- (scl (data 3))
- (power (data 4))
- (val (* y (+ lr0 (* scl (- (expt lbase power) 1.0))))))
- (if forward
- (set! (data 4) (+ power incr))
- (set! (data 4) (- power incr)))
- val))
- beg dur snd chn edpos #t
- (lambda (frag-beg frag-dur)
- ;; r0, base, incr, (/ (- r1 r0) (- base 1.0)), current power
- (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> r0
- base
- (/ 1.0 frag-dur)
- (/ (- r1 r0) (- base 1.0))
- (/ frag-beg frag-dur))))))
-
-(define* (virtual-mix file beg snd chn)
- (let ((len (<a class=quiet href="#mussoundframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundframes_tip)">mus-sound-frames</a> file)))
- (<em class=red>ptree-channel</em>
- (lambda (y state forward)
- (<a class=quiet href="#declare" onmouseout="UnTip()" onmouseover="Tip(extsnd_declare_tip)">declare</a> (y real) (state sampler) (forward boolean))
- (+ y (if forward (<a class=quiet href="#nextsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_nextsample_tip)">next-sample</a> state) (<a class=quiet href="#previoussample" onmouseout="UnTip()" onmouseover="Tip(extsnd_previoussample_tip)">previous-sample</a> state))))
- beg len snd chn -1 #f
- (lambda (frag-beg frag-dur)
- (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> frag-beg file)))))
-
-</pre></td></tr></table>
-
-To handle an envelope in a ptree-channel application, it's probably
-easiest to split it up into a sequence of ramps, each ramp keeping track
-of its local begin point and increment. This is how sine-env-channel
-works, not to mention the built-in linear and exponential envelopes.
-The underlying procedure is <a href="sndscm.html#anyenvchannel">any-env-channel</a>
-which needs only the segment connecting function, and handles the rest itself.
-Here is an implementation of Anders Vinjar's power-envelope (a list
-of breakpoints with an added base for each segment), that splits
-the envelope into a sequence of <a href="#xrampchannel">xramp-channel</a>
-calls. It also uses <a href="#asoneedit">as-one-edit</a> to make the
-result appear to be one operation in the edit history list.
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-<A NAME="powenvchannel"></a>(define* (powenv-channel envelope (beg 0) dur snd chn edpos)
- ;; envelope with a separate base for each segment:
- ;; (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))
- (let* ((curbeg beg)
- (fulldur (or dur (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd chn edpos)))
- (len (length envelope))
- (x1 (car envelope))
- (xrange (- (list-ref envelope (- len 3)) x1))
- (y1 (cadr envelope))
- (base (caddr envelope))
- (x0 0.0)
- (y0 0.0))
- (if (= len 3)
- (<a class=quiet href="#scalechannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_scalechannel_tip)">scale-channel</a> y1 beg dur snd chn edpos)
- (<em class=red>as-one-edit</em>
- (lambda ()
- (do ((i 3 (+ i 3)))
- ((= i len))
- (set! x0 x1)
- (set! y0 y1)
- (set! x1 (list-ref envelope i))
- (set! y1 (list-ref envelope (+ i 1)))
- (let* ((curdur (round (* fulldur (/ (- x1 x0) xrange)))))
- (<em class=red>xramp-channel</em> y0 y1 base curbeg curdur snd chn edpos)
- (set! curbeg (+ curbeg curdur)))
- (set! base (list-ref envelope (+ i 2)))))))))
-</pre></td></tr></table>
-
-If the init-func returns something other than a vct, you need to declare its type
-for the run macro. There are several examples in snd-test.scm.
-
-
-<table border=3 bordercolor="tan" hspace=20 vspace=20><tr><td>
-<blockquote><small>
-<br>
-more ptree-channel examples:<br>
-smoothing: smooth-channel-via-ptree (examp.scm)<br>
-compander: <a href="sndscm.html#compandchannel">compand-channel</a> (examp.scm)<br>
-insert a block of arbitrary-valued samples: <a href="#blockchannel">block-channel</a><br>
-sinusoidal ramp: <a href="sndscm.html#sineramp">sine-ramp</a> (extensions.scm)<br>
-sinusoidal envelope: <a href="sndscm.html#sineenvchannel">sine-env-channel</a> (extensions.scm)<br>
-CLM-style contrast-enhancement: <a href="sndscm.html#contrastchannel">contrast-channel</a> (extensions.scm)<br>
-add a constant to every sample: <a href="sndscm.html#offsetchannel">offset-channel</a> (extensions.scm)<br>
-ring modulation: ring-modulate-channel (examp.scm)<br>
-delay by n samples (an experiment!): delay-channel in extensions.scm<br>
-dithering: <a href="sndscm.html#ditherchannel">dither-channel</a> (extensions.scm)<br>
-FIR filter: <a href="sndscm.html#virtualfilterchannel">virtual-filter-channel</a> (examp.scm)<br>
-<br>
-</small></blockquote>
-</td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+the sound's status area using 'name' to identify itself.
+</p>
+<div class="separator"></div>
+
+
<!-- ramp-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="rampchannel">ramp-channel</a> rmp0 rmp1 <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-ramp-channel is a slight extension of scale-channel. It scales samples in the given sound/channel
+<pre class="indented">
+<em class=def id="rampchannel">ramp-channel</em> rmp0 rmp1 beg dur snd chn edpos
+</pre>
+
+<p>ramp-channel is a slight extension of scale-channel. It scales samples in the given sound/channel
between 'beg' and 'beg' + 'dur' by a (linear) ramp going from 'rmp0' to 'rmp1'.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- read-only -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="readonly">read-only</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This returns #t if 'snd' is read-only, #f otherwise. If you open
+<pre class="indented">
+<em class=def id="readonly">read-only</em> snd
+</pre>
+
+<p>This returns #t if 'snd' is read-only, #f otherwise. If you open
a file with <a href="#viewsound">view-sound</a>, read-only is set to #t.
read-only does not reflect (or affect) the write permission state of the underlying file; it is a way
to keep from accidentally clobbering an otherwise writable file.
If it is #t (or if the file is not writable), a lock icon is displayed beside the file name.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- redo -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="redo">redo</a> <em class=narg>edits snd chn</em></code>
-</td></tr><tr><td></td><td>
-This re-activates 'edits' edits (the default is 1) in the given channel.
-Redo follows the <a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> field if it
+<pre class="indented">
+<em class=def id="redo">redo</em> edits snd chn
+</pre>
+
+<p id="redochannel">This re-activates 'edits' edits (the default is 1) in the given channel.
+Redo follows the <a class=quiet href="#sync">sync</a> field if it
is not 0. The following might be a more reasonable redo function:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<a name="redochannel">redo-channel</a> (<a class=quiet href="#edits" onmouseout="UnTip()" onmouseover="Tip(extsnd_edits_tip)">edits</a> 1) snd chn)
- (if (and snd (not (= (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> snd) 0)) chn)
- (set! (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> snd chn) (+ (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> snd chn) edits))
+<pre class="indented">
+(define* (redo-channel (<a class=quiet href="#edits">edits</a> 1) snd chn)
+ (if (and snd (not (= (<a class=quiet href="#sync">sync</a> snd) 0)) chn)
+ (set! (<a class=quiet href="#editposition">edit-position</a> snd chn) (+ (<a class=quiet href="#editposition">edit-position</a> snd chn) edits))
(<em class=red>redo</em> edits snd)))
-</pre></td></tr></table>
+</pre>
-redo moves forward in the edit history list, whereas
+<p>redo moves forward in the edit history list, whereas
<a href="#undo">undo</a> backs up, and <a href="#revertsound">revert-sound</a> resets the current
edit position to the start of the list.
For more about the edit history list, see <a href="#editlists">Edit Lists</a>.
-<br><br>
-In Ruby, redo is a part of the loop handling, so Snd's redo is renamed redo_edit.
-<a name="redoedit">redo-edit</a> also exists in Scheme, for consistency.
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
+</p>
-<!-- report-in-minibuffer -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reportinminibuffer">report-in-minibuffer</a> msg <em class=narg>snd as-error</em></code>
-</td></tr><tr><td></td><td>
-This posts 'msg' in the sound's minibuffer. The 'minibuffer' is the text widget between the sound's filename and the buttons
-on the right, beneath the graph. It is intended to mimic Emacs' minibuffer, being useful mainly for short,
-temporary messages. C-g clears it, as does <a href="#clearminibuffer">clear-minibuffer</a>.
-If 'as-error' is #t, the message is placed in the minibuffer error label, rather than in the usual text area.
-See also <a href="#promptinminibuffer">prompt-in-minibuffer</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<p>In Ruby, redo is a part of the loop handling, so Snd's redo is renamed redo_edit.
+redo-edit also exists in Scheme, for consistency.
+</p>
+<div class="separator"></div>
<!-- reverse-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reversechannel">reverse-channel</a> <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-reverse-channel is the <a class=quiet href="#regularizedargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_regularizedargs_tip)">regularized</a> version of <a href="#reversesound">reverse-sound</a>.
+<pre class="indented">
+<em class=def id="reversechannel">reverse-channel</em> beg dur snd chn edpos
+</pre>
+
+<p id="reverseexamples">reverse-channel is the <a class=quiet href="#regularizedargs">regularized</a> version of <a href="#reversesound">reverse-sound</a>.
+</p>
<!-- INDEX reverseexamples:Reversing -->
-<A NAME="reverseexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
+<TABLE class="method">
+<tr><th class="title">Reversing</th></tr><tr><td>
<blockquote><small>
-<br>
-reverse selected portion: <a href="#reverseselection">reverse-selection</a><br>
-read samples in reverse: use <a href="#makesampler">make-sampler</a> with direction -1<br>
-reverse at new sampling rate: use <a href="#srcchannel">src-channel</a> with a negative ratio<br>
-Reverse in control panel: <a href="snd.html#speed">control panel</a> and <a href="#speedcontrol">speed-control</a> variable<br>
+reverse channel: <a href="extsnd.html#reversechannel">reverse-channel</a>, <a href="extsnd.html#reversesound">reverse-sound</a><br>
+reverse selected portion: <a href="extsnd.html#reverseselection">reverse-selection</a><br>
+read samples in reverse: use <a href="extsnd.html#makesampler">make-sampler</a> with direction -1<br>
+reverse at new sampling rate: use <a href="extsnd.html#srcchannel">src-channel</a> with a negative ratio<br>
+Reverse in control panel: <a href="snd.html#speed">control panel</a> and <a href="extsnd.html#speedcontrol">speed-control</a> variable<br>
reverse an envelope: <a href="sndscm.html#reverseenvelope">reverse-envelope</a><br>
reverse block-wise: <a href="sndscm.html#reversebyblocks">reverse-by-blocks and reverse-within-blocks</a><br>
-reverse via FFT: <a href="#sillyreverse">silly-reverse</a><br>
-reverse order of channels: <a href="#reversechannels">reverse-channels</a><br>
+reverse via FFT: <a href="extsnd.html#sillyreverse">silly-reverse</a><br>
+reverse order of channels: <a href="extsnd.html#reversechannels">reverse-channels</a><br>
reverse a list: reverse and reverse!<br>
-reverse a string: in Forth: string-reverse, in Ruby: reverse<br>
-reverse a vct: <a href="#vctreverse">vct-reverse!</a><br>
-reverse a frame: <a href="sndscm.html#framereverse">frame-reverse</a><br>
-<br>
+reverse a string: in Ruby: reverse<br>
+reverse vct: <a href="extsnd.html#vctreverse">vct-reverse!</a><br>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- reverse-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reversesound">reverse-sound</a> <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-reverse-sound reverses the sound data in the given channel. There are some interesting non-causal effects you can get with this:
+<pre class="indented">
+<em class=def id="reversesound">reverse-sound</em> snd chn edpos
+</pre>
+
+<p id="sillyreverse">reverse-sound reverses the sound data in the given channel. There are some interesting non-causal effects you can get with this:
take a voice sound, reverse it, reverberate it, reverse it again, and you get the original with
reversed reverb. As a hack, you can reverse a sound (modulo a one sample rotation) by doing two ffts
(DSP-ers call this a "flip"):
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<A NAME="sillyreverse">silly-reverse</a> snd)
- (let* ((len (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd 0))
- (fsize (expt 2 (ceiling (/ (log len) (log 2)))))
- (rl (<a class=quiet href="#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> 0 fsize snd 0))
- (im (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> fsize)))
- (<a class=quiet href="sndclm.html#fft" onmouseout="UnTip()" onmouseover="Tip(sndclm_fft_tip)">mus-fft</a> rl im fsize)
- (<a class=quiet href="sndclm.html#fft" onmouseout="UnTip()" onmouseover="Tip(sndclm_fft_tip)">mus-fft</a> rl im fsize)
- (<a class=quiet href="#vctscale" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctscale_tip)">vct-scale!</a> rl (/ 1.0 fsize))
- (<a class=quiet href="#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (<a class=quiet href="#vctsubseq" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctsubseq_tip)">vct-subseq</a> rl (- fsize len) fsize) 0 len snd 0)))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+(define* (silly-reverse snd)
+ (let* ((len (<a class=quiet href="#framples">framples</a> snd 0))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (rl (channel->float-vector 0 fsize snd 0))
+ (im (make-float-vector fsize 0.0)))
+ (<a class=quiet href="sndclm.html#fft">mus-fft</a> rl im fsize)
+ (<a class=quiet href="sndclm.html#fft">mus-fft</a> rl im fsize)
+ (float-vector-scale! rl (/ 1.0 fsize))
+ (float-vector->channel (float-vector-subseq rl (- fsize len) fsize) 0 len snd 0)))
+</pre>
+<div class="separator"></div>
<!-- revert-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="revertsound">revert-sound</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This reverts 'snd' to its saved (unedited) state. A channel-specific version:
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
+<em class=def id="revertsound">revert-sound</em> snd
+</pre>
+
+<p>This reverts 'snd' to its saved (unedited) state. A channel-specific version:
+</p>
+
+<pre class="indented">
(define* (revert-channel snd chn)
- (set! (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> snd chn) 0))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+ (set! (<a class=quiet href="#editposition">edit-position</a> snd chn) 0))
+</pre>
+<div class="separator"></div>
<!-- right-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="rightsample">right-sample</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns the position (in samples) of right edge of the time domain waveform. See <a href="#leftsample">left-sample</a>,
+<pre class="indented">
+<em class=def id="rightsample">right-sample</em> snd chn
+</pre>
+
+<p>This returns the position (in samples) of right edge of the time domain waveform. See <a href="#leftsample">left-sample</a>,
<a href="#moveonepixel">move-one-pixel</a>, and many examples in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
+
+<!-- sample -->
+<pre class="indented">
+<em class=def id="sample">sample</em> samp snd chn edpos
+</pre>
-<!-- run -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="run">run</a> thunk</code>
-</td></tr><tr><td></td><td>
-<p>run is the Snd equivalent of the CL/CLM run macro. You can wrap it around a numerically-intensive
-block of code, and the result will usually run 10 to 20 times faster. In the context of <a href="sndscm.html#wsdoc">with-sound</a>, run is used
-to speed up instrument bodies. My timing tests indicate that Snd+Run instruments are within a factor of two to four
-of the speed of CL+run+C in CLM. Currently, only s7 supports this optimization.
+<p>This function gives the value of sample 'samp' in the given channel.
</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (ws-sine freq)
- (let ((o (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq)))
- (<em class=red>run</em>
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> o))))))
+
+<pre class="indented">
+Scheme: (set! (sample 100) .5)
+Ruby: set_sample(100, 0.5)
+Forth: 100 0.5 set-sample
</pre>
-<p>In the past, the argument to run had to be a "thunk", a procedure of no arguments;
-this style of use is still supported.
+
+<p>'samp' defaults to the current cursor location. If 'chn' is #t, sample returns a list of all the
+samples at 'samp', so:
</p>
-</td></tr></table>
-<A NAME="declare"></A>
-Functions embedded within run may need to declare the type of their arguments; run assumes each variable has one type (integer by default) throughout its life.
-So, the following code
-displays "0", rather than "3.14":
+<pre class="indented">
+(define* (frample samp snd edpos)
+ (apply float-vector (sample samp snd #t edpos)))
+</pre>
+
+<div class="separator"></div>
-<pre>
- (run (let ((x 3.14)) (define (a b) (display b)) (a x)))
+
+<!-- samples -->
+<pre class="indented">
+<em class=def id="samples">samples</em> samp samps snd chn edpos
</pre>
-The "b" argument to "a" is assumed to be an integer, and passing in a float
-causes nothing but confusion. To get this code to work right:
+<p>This returns a vct of 'samps' samples starting at 'samp' in the given channel.
+'samp' defaults to 0. 'samps' defaults to framples - 'samp' (i.e. read to the end of the data).
+'pos' is the edit history position to read (it defaults to the current position).
+This is settable (as is <a href="#sample">sample</a>):
+</p>
-<pre>
- (run (let ((x 3.14)) (define (a b) (<em class=red>declare</em> (b real)) (display b)) (a x)))
+<pre class="indented">
+> (samples 1000 10)
+#<vct[len=10]: 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004>
+> (set! (samples 1000 10) (make-vct 10 .1))
+#<vct[len=10]: 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100>
</pre>
+<div class="separator"></div>
-The current declarable types include any <a href="sndclm.html#defgenerator">defgenerator</a> type and:
-<pre>
- int float boolean char string list symbol keyword vct sampler mix-sampler
- sound-data clm float-vector int-vector vct-vector list-vector clm-vector
+<!-- sample-type -->
+<pre class="indented">
+<em class=def id="sampletype">sample-type</em> snd
</pre>
-declare is modelled after Common Lisp's declare; it is specific to run.
-<br><br>
-The use of the run macro is hidden in many contexts: <a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>,
-<a class=quiet href="#findchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_findchannel_tip)">find-channel</a>, etc. Internally the Snd run macro
-uses 64-bit ints and doubles.
-See <a href="#optimization">optimization</a>
-for some timings. In Ruby, it's possible to use the <a href="http://www.zenspider.com/Languages/Ruby/">RubyInline</a> module instead.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<p>This returns the sound's sample type — the encoding used for the sound samples (e.g. mus-bshort).
+</p>
+<p>The standard formats nowadays are mus-bshort (big-endian 16-bit integers), mus-bfloat
+(32-bit big-endian floats), and mus-bint (32-bit big-endian integers), and the
+corresponding little-endian versions: mus-lshort, mus-lfloat, and mus-lint.
+If you're using an Intel-style PC, you're using a little-endian machine;
+Old macs (PowerPC Macs) and Suns use big-endian (NeXT, SGI, and Atari also used it in the good old days). If you
+write a Next file and use little-endian data, some programs other than Snd
+may complain; similarly, RIFF wants little-endian and AIFC wants big-endian
+data (both can handle the other kind, but most sound-related programs don't know
+that). In the old days, when disk space was at a premium, 8-bit formats
+were used a lot: mus-mulaw and mus-alaw (kludges for a kind of 8-bit float),
+mus-byte and mus-ubyte (8-bit ints, unsigned in the latter case). A few
+DACs want a particular kind of data, but Snd handles that conversion internally.
+Anything less than 12 bits will sound bad — Perry Cook's book "Real Sound Synthesis"
+has examples.
+</p>
-<!-- sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sample">sample</a> <em class=narg>samp snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This function gives the value of sample 'samp' in the given channel.
-<pre>
- Scheme: (set! (sample 100) .5)
+<p>If you encounter a file
+with an unknown format, or a header that has the wrong format,
+you can set this field to force Snd to interpret the data in any
+way you like. Similar remarks apply to the <a class=quiet href="#srate">srate</a>, <a class=quiet href="#datalocation">data-location</a>,
+<a class=quiet href="#headertype">header-type</a>, and <a class=quiet href="#channels">channels</a> fields. There are ambiguities in some header
+specifications, usually involving big/little endian or signed/unsigned data confusion.
+If you encounter a sound that is clipping crazily or is just a burst of noise, try changing these settings.
+Some NeXT/Sun (au) header files using byte-wide data
+assume the byte is unsigned, whereas most others assume it is signed. Sndlib
+treats it as signed by default, so to make one of the unsigned-byte files playable,
+</p>
- Ruby: set_sample(100, 0.5)
+<pre class="indented">
+(set! (sample-type) <a class=quiet href="#sampletype">mus-ubyte</a>)
+</pre>
+
+<p>mus_float_t data is another source of confusion;
+there is apparently no agreement on whether the data is between -1.0 and 1.0, or -32768.0 and 32767.0 or anything else.
+In this case, Snd assumes -1.0 to 1.0 (except in one special case involving IRCAM headers), and you may have to
+set <a class=quiet href="#ybounds">y-bounds</a> to see the actual data.
+Yet another gotcha: files with 32-bit integers. Some programs (Glame, apparently, and perhaps Ardour) assume the fraction is
+31 bits wide, others (Snd) use whatever its sample width is configured to be; there is no correct or standard
+placement of the fixed point, but not to worry! Your data is ok:
+<code>(set! (<a class=quiet href="#ybounds">y-bounds</a>) (list -256.0 256.0))</code>.
+There are several ways you can handle
+these files automatically in Snd. Perhaps the simplest is to use one of the open hooks:
+</p>
- Forth: 100 0.5 set-sample
+<pre class="indented">
+(hook-push <a class=quiet href="#afteropenhook">after-open-hook</a>
+ (lambda (hook)
+ ;; this could also (alternatively) set the y-bounds as above
+ (if (= (<em class=red>sample-type</em> (hook 'snd)) mus-lint)
+ (set! (<em class=red>sample-type</em> (hook 'snd)) mus-lintn))))
</pre>
-If the desired sample happens to fall outside the current buffer
-for the indicated channel, sample grinds to a halt — if you're
-running a loop through a bunch of samples, use the <a href="#samplers">samplers</a>
-or <a href="#channeltovct">channel->vct</a> instead. 'samp' defaults to the current cursor location.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<p>or (an alternative that sets the underlying database entry, rather than the current in-Snd choice):
+</p>
-<!-- samples -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="samples">samples</a> <em class=narg>samp samps snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This returns a vct of 'samps' samples starting at 'samp' in the given channel.
-'samp' defaults to 0. 'samps' defaults to frames - 'samp' (i.e. read to the end of the data).
-'pos' is the edit history position to read (it defaults to the current position).
-This is settable (as is <a href="#sample">sample</a>):
-<pre>
- <em class=listener>:</em><em class=typing>(samples 1000 10)</em>
- <em class=listener>#<vct[len=10]: 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004></em>
- <em class=listener>:</em><em class=typing>(set! (samples 1000 10) (make-vct 10 .1))</em>
- <em class=listener>#<vct[len=10]: 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100></em>
+<pre class="indented">
+(hook-push <a class=quiet href="#openhook">open-hook</a>
+ (lambda (hook)
+ (if (= (<a class=quiet href="#mussoundsampletype">mus-sound-sample-type</a> (hook 'name)) mus-lint)
+ (set! (<a class=quiet href="#mussoundsampletype">mus-sound-sample-type</a> (hook 'name)) mus-lintn))))
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+
+<p>If you set any of these fields, the sound's index may change (there can be an embedded <a class=quiet href="#updatesound">update-sound</a>).
+To deal with MPEG, OGG, Flac, or Speex files, see examp.scm (<a class=quiet href="sndscm.html#mpg">mpg</a>) or misc.scm (mpg123 and ogg123).
+Octave/WaveLab ASCII files can be translated by read-ascii (examp.scm).
+</p>
+
+<p>To turn a sample-type number into a string, use <a href="#mussampletypename">mus-sample-type-name</a>. To get
+the sample type of some sound file, use <a href="#mussoundsampletype">mus-sound-sample-type</a>.
+The default output (<a class=quiet href="#newsound">new-sound</a>, and
+<a class=quiet href="#savesoundas">save-sound-as</a>) sample-type is <a href="#defaultoutputsampletype">default-output-sample-type</a>.
+To change a sound file's sample-type, use <a href="#savesoundas">save-sound-as</a>.
+</p>
+<div class="separator"></div>
<!-- save-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="savesound">save-sound</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-save-sound saves 'snd', writing the current state of the sound to its underlying sound file, (like the File menu's Save option).
+<pre class="indented">
+<em class=def id="savesound">save-sound</em> snd
+</pre>
+
+<p id="saveexamples">save-sound saves 'snd', writing the current state of the sound to its underlying sound file, (like the File menu's Save option).
<a href="#savehook">save-hook</a> is invoked upon save-sound. After save-sound, the sound has no undoable edits in its edit history
(this is different from Emacs, but I find Emac's way of handling this very confusing, and it's never what I want).
+</p>
<!-- INDEX saveexamples:Saving -->
-<A NAME="saveexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<small><blockquote>
-save all sounds: <code>(for-each save-sound (sounds))</code><br>
-save a sound under a different name: <a href="#savesoundas">save-sound-as</a><br>
-extract one channel from a sound: <a href="#extractchannel">extract-channel</a><br>
-extract a set of channels from a sound: <a href="#extractchannels">extract-channels</a><br>
-save a sound in a different format or header: <a href="#savesoundas">save-sound-as</a><br>
-backup edits automatically: <a href="sndscm.html#autosave">autosave</a><br>
-check first for unsaved edits: <a href="#askaboutunsavededits">ask-about-unsaved-edits</a><br>
-save Snd's complete state (unsaved edits and all): <a href="#savestate">save-state</a>, <a href="#savedir">save-dir</a>, <a href="#savestatehook">save-state-hook</a>, <a href="#savestatefile">save-state-file</a><br>
-save the selection: <a href="#saveselection">save-selection</a><br>
-save a region: <a href="#saveregion">save-region</a><br>
-save a mix: <a href="#savemix">save-mix</a><br>
-save the control panel state: <a href="#savecontrols">save-controls</a><br>
-save currently defined envelopes (envelope editor): <a href="#saveenvelopes">save-envelopes</a><br>
-start the file save dialog: <a href="#savesounddialog">save-sound-dialog</a><br>
-start the selection save dialog: <a href="#saveselectiondialog">save-selection-dialog</a><br>
-start the region save dialog: <a href="#saveregiondialog">save-region-dialog</a><br>
-save the current listener text: <a href="#savelistener">save-listener</a><br>
-save keyboard macros: <a href="#savemacros">save-macros</a><br>
-save marks: <a href="#savemarks">save-marks</a><br>
-save just the edit history: <a href="#saveedithistory">save-edit-history</a><br>
+<TABLE class="method">
+<tr><th class="title">Saving</th></tr><tr><td>
+<blockquote><small>
+save sound: <a href="extsnd.html#savesound">save-sound</a><br>
+save all sounds: (for-each save-sound (sounds))<br>
+save a sound under a different name: <a href="extsnd.html#savesoundas">save-sound-as</a><br>
+extract one channel from a sound: <a href="extsnd.html#extractchannel">extract-channel</a><br>
+extract a set of channels from a sound: <a href="extsnd.html#extractchannels">extract-channels</a><br>
+save a sound in a different sample type or header: <a href="extsnd.html#savesoundas">save-sound-as</a><br>
+backup edits automatically: <a href="sndscm.html#autosavedoc">autosave</a><br>
+check first for unsaved edits: <a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a><br>
+save Snd's complete state (unsaved edits and all): <a href="extsnd.html#savestate">save-state</a>, <a href="extsnd.html#savedir">save-dir</a>, <a href="extsnd.html#savestatehook">save-state-hook</a>, <a href="extsnd.html#savestatefile">save-state-file</a><br>
+save the selection: <a href="extsnd.html#saveselection">save-selection</a><br>
+save a region: <a href="extsnd.html#saveregion">save-region</a><br>
+save a mix: <a href="extsnd.html#savemix">save-mix</a><br>
+save the control panel state: <a href="extsnd.html#savecontrols">save-controls</a><br>
+save currently defined envelopes (envelope editor): <a href="extsnd.html#saveenvelopes">save-envelopes</a><br>
+start the file save dialog: <a href="extsnd.html#savesounddialog">save-sound-dialog</a><br>
+start the selection save dialog: <a href="extsnd.html#saveselectiondialog">save-selection-dialog</a><br>
+start the region save dialog: <a href="extsnd.html#saveregiondialog">save-region-dialog</a><br>
+save the current listener text: <a href="extsnd.html#savelistener">save-listener</a><br>
+save marks: <a href="extsnd.html#savemarks">save-marks</a><br>
+save just the edit history: <a href="extsnd.html#saveedithistory">save-edit-history</a><br>
take some action upon a window manager save-yourself signal: <a href="sndscm.html#uponsaveyourself">upon-save-yourself</a><br>
-save the current sound setup for a later reopen: <a href="#remembersoundstate">remember-sound-state</a><br>
-save the current fft peak info: <a href="#peaks">peaks</a><br>
-</blockquote></small>
+save the current sound setup for a later reopen: <a href="extsnd.html#remembersoundstate">remember-sound-state</a><br>
+save the current fft peak info: <a href="extsnd.html#peaks">peaks</a><br>
+</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- save-sound-as -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="savesoundas">save-sound-as</a> <em class=narg>:file :sound :header-type :data-format :srate :channel :edit-position :comment</em></code>
-</td></tr><tr><td></td><td>
-This saves 'sound' as 'file' (like the 'File:Save as' menu option). If 'channel' is specified,
+<pre class="indented">
+<em class=def id="savesoundas">save-sound-as</em> :file :sound :srate :sample-type :header-type :channel :edit-position :comment
+</pre>
+
+<p>This saves 'sound' as 'file' (like the 'File:Save as' menu option). If 'channel' is specified,
only that channel is saved (it is extracted if necessary from the multichannel original).
'edit-position', if given, specifies which edit history position to save.
The :srate argument refers only to the new sound file's header's srate field;
the data is not resampled. If you want to resample the data as it is saved, see
-the example under <a href="#beforesaveashook">before-save-as-hook</a>. If :data-format
-is given, the sound file is written using that data format.
+the example under <a href="#beforesaveashook">before-save-as-hook</a>. If :sample-type
+is given, the sound file is written using that sample type.
Any omitted argument's value
is taken from the sound being saved. save-sound-as returns the new file name.
-<pre>
- (save-sound-as "test.snd" :data-format mus-bdouble :header-type mus-aifc)
+</p>
+
+<pre class="indented">
+(save-sound-as "test.snd" :sample-type mus-bdouble :header-type mus-aifc)
</pre>
-saves the currently selected sound as an AIFC file using big-endian doubles for the samples.
-<br><br>
-To start a parallel editing branch on a given file, you could:
-<pre>
- (save-sound-as "test.snd") (<a class=quiet href="#opensound" onmouseout="UnTip()" onmouseover="Tip(extsnd_opensound_tip)">open-sound</a> "test.snd")
+
+<p>saves the currently selected sound as an AIFC file using big-endian doubles for the samples.
+</p>
+
+<p>To start a parallel editing branch on a given file, you could:
+</p>
+
+<pre class="indented">
+(save-sound-as "test.snd") (<a class=quiet href="#opensound">open-sound</a> "test.snd")
</pre>
-To define an explicit channel extraction function:<br>
-<pre>
- Scheme:
- (define (<a name="extractchannel">extract-channel</a> filename snd chn) (<em class=red>save-sound-as</em> filename snd :channel chn))
+<p id="extractchannel">To define an explicit channel extraction function:
+</p><br>
+
+<pre class="indented">
+Scheme:
+(define (extract-channel filename snd chn) (<em class=red>save-sound-as</em> filename snd :channel chn))
- Ruby:
- def extract_channel(filename, snd, chn) save_sound_as(filename, snd, :channel, chn) end
+Ruby:
+def extract_channel(filename, snd, chn) save_sound_as(filename, snd, :channel, chn) end
- Forth:
- : extract-channel { filename snd chn } filename snd :channel chn save-sound-as ;
+Forth:
+: extract-channel { filename snd chn } filename snd :channel chn save-sound-as ;
</pre>
-The hooks called during a save operation are:
-<pre>
- <a class=quiet href="#beforesaveashook" onmouseout="UnTip()" onmouseover="Tip(extsnd_beforesaveashook_tip)">before-save-as-hook</a> — can cancel the request or set its output parameters
- <a class=quiet href="#savehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_savehook_tip)">save-hook</a>
- sound saved
- if any sample is clipped during save, <a class=quiet href="#cliphook" onmouseout="UnTip()" onmouseover="Tip(extsnd_cliphook_tip)">clip-hook</a>
- <a class=quiet href="#aftersaveashook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftersaveashook_tip)">after-save-as-hook</a>
+
+<p>The hooks called during a save operation are:
+</p>
+
+<pre class="indented">
+<a class=quiet href="#beforesaveashook">before-save-as-hook</a> — can cancel the request or set its output parameters
+<a class=quiet href="#savehook">save-hook</a>
+ sound saved
+ if any sample is clipped during save, <a class=quiet href="#cliphook">clip-hook</a>
+<a class=quiet href="#aftersaveashook">after-save-as-hook</a>
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- scale-by -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="scaleby">scale-by</a> scalers <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-scale-by <a href="snd.html#scaling">scales</a> the amplitude of 'snd' by 'scalers'. Unlike most of these functions,
+<pre class="indented">
+<em class=def id="scaleby">scale-by</em> scalers snd chn
+</pre>
+
+<p>scale-by <a href="snd.html#scaling">scales</a> the amplitude of 'snd' by 'scalers'. Unlike most of these functions,
scale-by follows the 'sync' buttons and affects all currently sync'd
channels. 'scalers' can be either a float, a list, or a vct.
In the latter case, the values are used one by one, applying each as
scale-by moves through the channels. If 'sync' is off, channel 'chn'
is scaled (it defaults to the currently selected channel). <code>(scale-by 2.0)</code> doubles all samples.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- scale-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="scalechannel">scale-channel</a> scl <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-scale-channel
+<pre class="indented">
+<em class=def id="scalechannel">scale-channel</em> scl beg dur snd chn edpos
+</pre>
+
+<p>scale-channel
scales (changes the amplitude) of a sound by 'scl'.
-The multichannel version is <a href="sndscm.html#scalesound">scale-sound</a> in frame.scm.
<a href="sndscm.html#channelpolynomial">channel-polynomial</a> is a generalization of the idea.
There are approximately a bazillion ways to scale samples in Snd; here's a potpourri of increasingly silly choices:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(scale-channel 2.0)
-(<a class=quiet href="#scaleby" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleby_tip)">scale-by</a> 2.0)
-(<a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (val) (* val 2.0)))
-(set! (<a class=quiet href="#maxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_maxamp_tip)">maxamp</a>) (* 2 (<a class=quiet href="#maxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_maxamp_tip)">maxamp</a>)))
-(<a class=quiet href="#envsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_envsound_tip)">env-sound</a> '(0 2 1 2))
-(<a class=quiet href="#envchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_envchannel_tip)">env-channel</a> (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 1 1 1) :scaler 2.0 :length (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>)))
-(<a class=quiet href="#clmchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_clmchannel_tip)">clm-channel</a> (<a class=quiet href="sndclm.html#make-one-zero" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_one_zero_tip)">make-one-zero</a> :a0 2.0 :a1 0.0))
-(<a class=quiet href="#filterchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_filterchannel_tip)">filter-channel</a> (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 2.0) 1)
-(<a class=quiet href="#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (<a class=quiet href="#vctscale" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctscale_tip)">vct-scale!</a> (<a class=quiet href="#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a>) 2.0) 0)
-(<a class=quiet href="sndscm.html#sounddatatosound" onmouseout="UnTip()" onmouseover="Tip(sndscm_sounddatatosound_tip)">sound-data->sound</a> (<a class=quiet href="#sounddata*" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounddata_times_tip)">sound-data*</a> (<a class=quiet href="sndscm.html#soundtosounddata" onmouseout="UnTip()" onmouseover="Tip(sndscm_soundtosounddata_tip)">sound->sound-data</a>) 2.0))
-(begin (<a class=quiet href="#selectall" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectall_tip)">select-all</a>) (<a class=quiet href="#mixselection" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixselection_tip)">mix-selection</a> 0))
-(begin (<a class=quiet href="#selectall" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectall_tip)">select-all</a>) (<a class=quiet href="#scaleselectionby" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleselectionby_tip)">scale-selection-by</a> 2.0))
-(begin (<a class=quiet href="#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a> "temp.snd") (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "temp.snd" 0) (delete-file "temp.snd"))
-
-(let ((flt (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 8)))
+(<a class=quiet href="#scaleby">scale-by</a> 2.0)
+(<a class=quiet href="#mapchannel">map-channel</a> (lambda (val) (* val 2.0)))
+(set! (<a class=quiet href="#maxamp">maxamp</a>) (* 2 (<a class=quiet href="#maxamp">maxamp</a>)))
+(<a class=quiet href="#envsound">env-sound</a> '(0 2 1 2))
+(<a class=quiet href="#envchannel">env-channel</a> (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 1 1 1) :scaler 2.0 :length (<a class=quiet href="#framples">framples</a>)))
+(<a class=quiet href="#clmchannel">clm-channel</a> (<a class=quiet href="sndclm.html#make-one-zero">make-one-zero</a> :a0 2.0 :a1 0.0))
+(<a class=quiet href="#filterchannel">filter-channel</a> (float-vector 2.0) 1)
+(float-vector->channel (float-vector-scale! (channel->float-vector) 2.0) 0)
+(begin (<a class=quiet href="#selectall">select-all</a>) (<a class=quiet href="#mixselection">mix-selection</a> 0))
+(begin (<a class=quiet href="#selectall">select-all</a>) (<a class=quiet href="#scaleselectionby">scale-selection-by</a> 2.0))
+(begin (<a class=quiet href="#savesoundas">save-sound-as</a> "temp.snd") (<a class=quiet href="#mix">mix</a> "temp.snd" 0) (delete-file "temp.snd"))
+
+(let ((flt (make-float-vector 8 0.0)))
(set! (flt 0) 2.0)
- (let ((cnv (<a class=quiet href="sndclm.html#make-convolve" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_convolve_tip)">make-convolve</a> :filter flt))
- (sf (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0)))
- (<a class=quiet href="#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
+ (let ((cnv (<a class=quiet href="sndclm.html#make-convolve">make-convolve</a> :filter flt))
+ (sf (<a class=quiet href="#makesampler">make-sampler</a> 0)))
+ (<a class=quiet href="#mapchannel">map-channel</a>
(lambda (val)
- (<a class=quiet href="sndclm.html#convolve" onmouseout="UnTip()" onmouseover="Tip(sndclm_convolve_tip)">convolve</a> cnv (lambda (dir)
- (<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> sf)))))))
+ (<a class=quiet href="sndclm.html#convolve">convolve</a> cnv (lambda (dir)
+ (<a class=quiet href="#readsample">read-sample</a> sf)))))))
-(<a class=quiet href="#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (<a class=quiet href="sndscm.html#polydoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_poly_times_tip)">poly*</a> (<a class=quiet href="#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> 0 (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>)) (<a class=quiet href="#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 2.0))) ; poly.scm (sound = polynomial coeffs)
+(float-vector->channel (<a class=quiet href="sndscm.html#polydoc">poly*</a> (channel->float-vector 0 (<a class=quiet href="#framples">framples</a>)) (float-vector 2.0))) ; poly.scm (sound = polynomial coeffs)
-(let* ((len (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
+(let* ((len (<a class=quiet href="#framples">framples</a>))
(fsize (expt 2 (ceiling (/ (log len) (log 2)))))
- (rl (<a class=quiet href="#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> 0 fsize))
- (im (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> fsize)))
- (<a class=quiet href="sndclm.html#fft" onmouseout="UnTip()" onmouseover="Tip(sndclm_fft_tip)">mus-fft</a> rl im fsize)
- (<a class=quiet href="sndclm.html#fft" onmouseout="UnTip()" onmouseover="Tip(sndclm_fft_tip)">mus-fft</a> rl im fsize)
- (<a class=quiet href="sndclm.html#fft" onmouseout="UnTip()" onmouseover="Tip(sndclm_fft_tip)">mus-fft</a> rl im fsize)
- (<a class=quiet href="sndclm.html#fft" onmouseout="UnTip()" onmouseover="Tip(sndclm_fft_tip)">mus-fft</a> rl im fsize)
- (<a class=quiet href="#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (<a class=quiet href="#vctscale" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctscale_tip)">vct-scale!</a> rl (/ 2.0 (* fsize fsize))) 0 len))
-
-(do ((i 0 (+ 1 i)))
- ((= i (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>)))
+ (rl (channel->float-vector 0 fsize))
+ (im (make-float-vector fsize 0.0)))
+ (<a class=quiet href="sndclm.html#fft">mus-fft</a> rl im fsize)
+ (<a class=quiet href="sndclm.html#fft">mus-fft</a> rl im fsize)
+ (<a class=quiet href="sndclm.html#fft">mus-fft</a> rl im fsize)
+ (<a class=quiet href="sndclm.html#fft">mus-fft</a> rl im fsize)
+ (float-vector->channel (float-vector-scale! rl (/ 2.0 (* fsize fsize))) 0 len))
+
+(do ((i 0 (+ i 1)))
+ ((= i (<a class=quiet href="#framples">framples</a>)))
;; don't actually do this! — it involves a separate edit on each sample
- (set! (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> i) (* 2 (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> i))))
+ (set! (<a class=quiet href="#sample">sample</a> i) (* 2 (<a class=quiet href="#sample">sample</a> i))))
(let ((make-scaler
(lambda (start end)
(letrec ((ctr start)
(us (lambda (them)
- (set! (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> ctr) (* 2.0 (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> ctr)))
+ (set! (<a class=quiet href="#sample">sample</a> ctr) (* 2.0 (<a class=quiet href="#sample">sample</a> ctr)))
(set! ctr (+ ctr 2))
(if (<= ctr end)
(them us)))))
us))))
- ((make-scaler 0 (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (make-scaler 1 (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))))
-</pre></td></tr></table>
-</td></tr>
+ ((make-scaler 0 (<a class=quiet href="#framples">framples</a>))
+ (make-scaler 1 (<a class=quiet href="#framples">framples</a>))))
+</pre>
+<div class="separator"></div>
<!-- another method that is a bit too verbose: array-interp with a ramp of slope 2
a similar table of ways to make a sine wave?
sin oscil Table-lookup polyshape ifft(spike) firmant(r=1.0), ssb-am+? formulas?
-->
-<tr><td colspan=2 height=18></td></tr>
+
<!-- scale-to -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="scaleto">scale-to</a> <em class=narg>norms snd chn</em></code>
-</td></tr><tr><td></td><td>
-scale-to <a href="snd.html#scaling">normalizes</a> 'snd' to 'norms' (following <a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> as in <a href="#scaleby">scale-by</a>).
-<code>(scale-to 0.5)</code> scales the current channel so that its maxamp is 0.5.
+<pre class="indented">
+<em class=def id="scaleto">scale-to</em> norms snd chn
+</pre>
+
+<p>scale-to <a href="snd.html#scaling">normalizes</a> 'snd' to 'norms' (following <a class=quiet href="#sync">sync</a> as in <a href="#scaleby">scale-by</a>).
+(scale-to 0.5) scales the current channel so that its maxamp is 0.5.
If all the sound's samples are 0.0, scale-to returns #f and does not perform any edit.
'norms' can be a number, a list of numbers, or a vct.
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
+</p>
+<div class="separator"></div>
-<!-- scan-chan -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def>scan-chan</a> func <em class=narg>start end snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-scan-chan applies 'func' to samples in the specified channel.
-It is the old ("irregular") version of <a href="#scanchannel">scan-channel</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
<!-- scan-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="scanchannel">scan-channel</a> func <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-scan-channel "scans" the data in the specified channel between the given sample numbers (the default
+<pre class="indented">
+<em class=def id="scanchannel">scan-channel</em> func beg dur snd chn edpos
+</pre>
+
+<p>scan-channel is obsolete; use a do loop with a sampler:
+</p>
+
+<pre class="indented">
+(define* (scan-channel func (beg 0) dur snd chn edpos)
+ (let ((end (if dur (min (+ beg dur) (framples snd chn)) (framples snd chn)))
+ (rd (make-sampler beg snd chn 1 edpos)))
+ (do ((pos beg (+ pos 1)))
+ ((or (>= pos end)
+ (func (next-sample rd)))
+ (and (< pos end)
+ pos)))))
+</pre>
+
+<p>scan-channel "scans" the data in the specified channel between the given sample numbers (the default
is the entire sound) by applying 'func' to each sample.
If 'func' returns something other than #f, the scan is halted,
and the current sample number is returned.
The following call scans the
-current channel from sample 0 to the end looking for any sample greater than
-.1:<br>
-<pre>
-><em class=typing>(scan-channel (lambda (y) (> y .1)))</em>
-<em class=listener>4423</em>
-</pre>
-In this case, we found such a sample at position 4423.<br>
-<pre>
-(define every-sample?
- (lambda (proc)
- (let ((baddy (<em class=red>scan-channel</em> (lambda (y)
- (not (proc y))))))
- (if baddy (set! (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) baddy))
- (not baddy))))
-
-><em class=typing>(every-sample? (lambda (y) (< y .5)))</em>
-<em class=listener>#t</em>
-</pre>
-To scan all the channels of a multichannel sound in parallel, see
-<a href="sndscm.html#scansound">scan-sound</a>.
-<br><br>
-In scan-channel, find, and count-matches (all the same underlying procedure), an attempt to jump back
-into a previous call will not work. That is,
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(let ((not-a-good-idea #f))
- (<em class=red>scan-channel</em> (lambda (y)
- (call-with-current-continuation
- (lambda (call)
- (set! not-a-good-idea call)))
- (> y .001)))
- (not-a-good-idea))
-</pre></td></tr></table>
-
-will die with a segfault (this is fixable, with much effort and grumbling). If you want a continuable search, use a sampler:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define reader #f)
-(define last-proc #f)
-(define (<A NAME="scanagain">scan-again</a>)
- (if (<a class=quiet href="#sampleratendQ" onmouseout="UnTip()" onmouseover="Tip(extsnd_sampleratendQ_tip)">sampler-at-end?</a> reader)
- #f
- (let ((val (last-proc (reader))))
- (if val
- (list val (- (<a class=quiet href="#samplerposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_samplerposition_tip)">sampler-position</a> reader) 1))
- (scan-again)))))
-(define (my-scan-chan proc)
- (set! last-proc proc)
- (set! reader (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0))
- (scan-again))
-</pre></td></tr></table>
-
-Now <code>(my-scan-chan (lambda (y) (> y .1)))</code> finds the first such sample, and
-subsequent <code>(scan-again)</code> calls continue the search where the last call left off.
-</td></tr><tr><td colspan=2 height=18></td></tr>
-
+current channel looking for any sample greater than .1:
+</p>
-<!-- search-procedure -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="searchprocedure">search-procedure</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This gives the current global or sound-local (if 'snd' is specified) search procedure.
-<pre>
- (set! (<a class=quiet href="#searchprocedure" onmouseout="UnTip()" onmouseover="Tip(extsnd_searchprocedure_tip)">search-procedure</a>) (lambda (y) (> y .1)))
+<pre class="indented">
+> (scan-channel (lambda (y) (> y .1)))
+4423
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+
+<div class="separator"></div>
<!-- selected-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="selectedchannel">selected-channel</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This gives the selected channel in 'snd'; you can set it to select a channel. It returns #f is no channel is selected in 'snd'.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="selectedchannel">selected-channel</em> snd
+</pre>
+
+<p>This gives the selected channel in 'snd'; you can set it to select a channel. It returns #f is no channel is selected in 'snd'.
+</p>
+<div class="separator"></div>
<!-- selected-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="selectedsound">selected-sound</a></code>
-</td></tr><tr><td></td><td>
-This returns the currently selected sound; you can set it to select a sound. It returns #f is there is no selected sound.
-<pre>
- (or (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>)
- (and (not (null? (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>)))
- (car (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
+<pre class="indented">
+<em class=def id="selectedsound">selected-sound</em>
+</pre>
+
+<p>This returns the currently selected sound; you can set it to select a sound. It returns #f is there is no selected sound.
+</p>
+
+<pre class="indented">
+(or (<a class=quiet href="#selectedsound">selected-sound</a>)
+ (and (pair? (<a class=quiet href="#sounds">sounds</a>))
+ (car (<a class=quiet href="#sounds">sounds</a>))))
</pre>
-returns the currently selected sound, if any, and failing that, any other sound that is currently open.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+
+<p>returns the currently selected sound, if any, and failing that, any other sound that is currently open.
+</p>
+<div class="separator"></div>
<!-- select-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="selectchannel">select-channel</a> <em class=narg>chn</em></code>
-</td></tr><tr><td></td><td>
-This selects channel 'chn' in the currently selected sound;
-equivalent to <code>(set! (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>) chn)</code>.
+<pre class="indented">
+<em class=def id="selectchannel">select-channel</em> chn
+</pre>
+
+<p>This selects channel 'chn' in the currently selected sound;
+equivalent to (set! (<a class=quiet href="#selectedchannel">selected-channel</a>) chn).
See also <a href="#selectchannelhook">select-channel-hook</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- select-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="selectsound">select-sound</a> snd</code>
-</td></tr><tr><td></td><td>
-This selects sound 'snd' (a sound object or an index); equivalent to <code>(set! (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) snd)</code>.
+<pre class="indented">
+<em class=def id="selectsound">select-sound</em> snd
+</pre>
+
+<p>This selects sound 'snd' (a sound object or an index); equivalent to (set! (<a class=quiet href="#selectedsound">selected-sound</a>) snd).
See also <a href="#selectsoundhook">select-sound-hook</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- set-samples -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="setsamples">set-samples</a> samp samps data <em class=narg>snd chn trunc edname infile-chan edpos auto-delete</em></code>
-</td></tr><tr><td></td><td>
-set-samples (and its related (set! (samples...)...) form) set the given channel's samples starting from
+<pre class="indented">
+<em class=def id="setsamples">set-samples</em> samp samps data snd chn trunc edname infile-chan edpos auto-delete
+</pre>
+
+<p>set-samples (and its equivalent form <code>(set! (samples...)...)</code>) set the given channel's samples starting from
sample 'samp' for 'samps' samples to the values in 'data'.
-<pre>
- (set! (samples 0 100) (make-vct 100 .1))
- (set-samples 0 100 (make-vct 100 .1))
+</p>
+<pre class="indented">
+(set! (samples 0 100) (make-vct 100 .1))
+(set-samples 0 100 (make-vct 100 .1))
</pre>
-both change all samples between 0 and 100 to be 0.1.
+
+<p>both change all samples between 0 and 100 to be 0.1.
If 'samp' is beyond the end of the file, the file is first zero-padded to reach it.
'data' can be a filename.
-<pre>
- (set-samples 10000 20000 "oboe.snd")
+</p>
+
+<pre class="indented">
+(set-samples 10000 20000 "oboe.snd")
</pre>
-replaces 10000 samples with data from oboe.snd.
+
+<p>replaces 10000 samples with data from oboe.snd.
If 'data' is a vct, set-samples is identical to <a href="#vcttochannel">vct->channel</a>.
If 'trunc' is #t and 'samp' is 0, the
sound is truncated (if necessary) to reflect the end of 'data'.
@@ -9019,70 +9127,74 @@ sets which input file to read. The in-coming data file is not deleted by Snd
unless 'auto-delete' is #t. (If you write a temporary sound
as an edit, it can be non-obvious when it is safe to delete that
file; 'auto-delete' set to #t asks Snd to handle cleanup).
-<br><br>
-The form (set! (<a class=quiet href="#samples" onmouseout="UnTip()" onmouseover="Tip(extsnd_samples_tip)">samples</a> samp samps 'snd chn trunc edname infile-chan edpos auto-delete') data) can also be used.
-'env-sound-interp' in examp.scm has an example of the file version, using
-sound-data objects and mus-sound-write to create a temporary file, but
-it's probably simpler to use <a href="sndscm.html#withsound">with-sound</a> (see also linear-src-channel in dsp.scm):
+</p>
+
+<p>The form (set! (<a class=quiet href="#samples">samples</a> samp samps 'snd chn trunc edname infile-chan edpos auto-delete') data) can also be used.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (step-src)
- (let* ((rd (<a class=quiet href="#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0))
- (o (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 2205.0))
- (s (<a class=quiet href="sndclm.html#make-src" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_src_tip)">make-src</a> :srate 0.0))
- (incr (+ 2.0 (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> o)))
- (tempfile (<em class=red>with-sound</em> (:output (<a class=quiet href="#sndtempnam" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndtempnam_tip)">snd-tempnam</a>) :srate (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) :to-snd #f)
- (<a class=quiet href="#run">run</a>
- (do ((samp 0 (+ 1 samp)))
- ((<a class=quiet href="#sampleratendQ" onmouseout="UnTip()" onmouseover="Tip(extsnd_sampleratendQ_tip)">sampler-at-end?</a> rd))
- (<a class=quiet href="sndclm.html#out-any" onmouseout="UnTip()" onmouseover="Tip(sndclm_out_any_tip)">out-any</a> samp (<a class=quiet href="sndclm.html#src" onmouseout="UnTip()" onmouseover="Tip(sndclm_src_tip)">src</a> s incr (lambda (dir) (<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> rd))) 0)
- (if (= (modulo samp 2205) 0)
- (set! incr (+ 2.0 (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> o))))))))
- (len (<a class=quiet href="#mussoundframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundframes_tip)">mus-sound-frames</a> tempfile)))
+ (let* ((rd (<a class=quiet href="#makesampler">make-sampler</a> 0))
+ (o (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> 2205.0))
+ (s (<a class=quiet href="sndclm.html#make-src">make-src</a> :srate 0.0))
+ (incr (+ 2.0 (<a class=quiet href="sndclm.html#oscil">oscil</a> o)))
+ (tempfile (<em class=red>with-sound</em> (:output (<a class=quiet href="#sndtempnam">snd-tempnam</a>) :srate (<a class=quiet href="#srate">srate</a>) :to-snd #f)
+ (do ((samp 0 (+ 1 samp)))
+ ((<a class=quiet href="#sampleratendQ">sampler-at-end?</a> rd))
+ (<a class=quiet href="sndclm.html#out-any">out-any</a> samp (<a class=quiet href="sndclm.html#src">src</a> s incr (lambda (dir) (<a class=quiet href="#readsample">read-sample</a> rd))) 0)
+ (if (= (modulo samp 2205) 0)
+ (set! incr (+ 2.0 (<a class=quiet href="sndclm.html#oscil">oscil</a> o)))))))
+ (len (<a class=quiet href="#mussoundframples">mus-sound-framples</a> tempfile)))
(<em class=red>set-samples</em> 0 (- len 1) tempfile #f #f #t "step-src" 0 #f #t)))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</pre>
+<div class="separator"></div>
<!-- short-file-name -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="shortfilename">short-file-name</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This returns the brief (no directory) form of the sound's filename.
+<pre class="indented">
+<em class=def id="shortfilename">short-file-name</em> snd
+</pre>
-<pre>
- ><em class=typing>(open-sound "oboe.snd")</em>
- <em class=listener>#<sound 0></em>
- ><em class=typing>(file-name (integer->sound 0))</em>
- <em class=listener>"/home/bil/cl/oboe.snd"</em>
- ><em class=typing>(short-file-name (integer->sound 0))</em>
- <em class=listener>"oboe.snd"</em>
+<p>This returns the brief (no directory) form of the sound's filename.
+</p>
+
+<pre class="indented">
+> (open-sound "oboe.snd")
+#<sound 0>
+> (file-name (integer->sound 0))
+"/home/bil/cl/oboe.snd"
+> (short-file-name (integer->sound 0))
+"oboe.snd"
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- show-axes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="showaxes">show-axes</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This determines what axes are displayed.
-If show-axes is <code>show-all-axes</code> (the default), both the x and y axes are displayed; if it is <code>show-x-axis</code>,
+<pre class="indented">
+<em class=def id="showaxes">show-axes</em> snd chn
+</pre>
+
+<p>This determines what axes are displayed.
+If show-axes is show-all-axes (the default), both the x and y axes are displayed; if it is show-x-axis,
just one (bottom) x axis is displayed, reducing screen clutter.
-<code>show-no-axes</code> omits both x and y axes. To remove the x axis label, use
-either <code>show-x-axis-unlabelled</code> or <code>show-all-axes-unlabelled</code>.
-To omit all the x axis labels and ticks (but include the y axis as usual) use <code>show-bare-x-axis</code>.
+show-no-axes omits both x and y axes. To remove the x axis label, use
+either show-x-axis-unlabelled or show-all-axes-unlabelled.
+To omit all the x axis labels and ticks (but include the y axis as usual) use show-bare-x-axis.
This is the View:Axes choice.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- show-grid -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="showgrid">show-grid</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If show-grid is #t (the default is #f), a background grid is displayed (default is #f). See also <a href="#griddensity">grid-density</a>.
-<br><br>
-<img src="pix/grid.png" alt="grid" onmouseout="UnTip()" onmouseover="Tip('<pre>snd -horizontal now.snd now.snd<br>(set! (show-grid) #t)<br>(set! (grid-density 1) 0.2)</pre>')">
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="showgrid">show-grid</em> snd chn
+</pre>
+
+<p>If show-grid is #t (the default is #f), a background grid is displayed (default is #f). See also <a href="#griddensity">grid-density</a>.
+</p>
+
+<img class="indented" src="pix/grid.png" alt="grid">
+<div class="separator"></div>
<!--
./snd -horizontal now.snd now.snd
@@ -9094,407 +9206,476 @@ If show-grid is #t (the default is #f), a background grid is displayed (default
-->
+
<!-- show-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="showmarks">show-marks</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If show-marks is #t (the default), marks are displayed. This is the '<a href="snd.html#marks">Show marks</a>' View menu option.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="showmarks">show-marks</em> snd chn
+</pre>
+
+<p>If show-marks is #t (the default), marks are displayed. This is the '<a href="snd.html#marks">Show marks</a>' View menu option.
+</p>
+<div class="separator"></div>
<!-- show-mix-waveforms -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="showmixwaveforms">show-mix-waveforms</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If show-mix-waveforms is #t (the default), a mixed sound is displayed as a separate waveform above the main data. The rectangular tag
+<pre class="indented">
+<em class=def id="showmixwaveforms">show-mix-waveforms</em> snd chn
+</pre>
+
+<p>If show-mix-waveforms is #t (the default), a mixed sound is displayed as a separate waveform above the main data. The rectangular tag
at the start of the waveform can be dragged to move the mix, or clicked to select it for the mix dialog.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- show-sonogram-cursor -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="showsonogramcursor">show-sonogram-cursor</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If show-sonogram-cursor is #t (the default is #f), the cursor is also displayed in the sonogram.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="showsonogramcursor">show-sonogram-cursor</em> snd chn
+</pre>
+
+<p>If show-sonogram-cursor is #t (the default is #f), the cursor is also displayed in the sonogram.
+</p>
+<div class="separator"></div>
<!-- show-transform-peaks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="showtransformpeaks">show-transform-peaks</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If show-transform-peaks is #t (the default is #f), transform peak information is included in the transform display.
+<pre class="indented">
+<em class=def id="showtransformpeaks">show-transform-peaks</em> snd chn
+</pre>
+
+<p>If show-transform-peaks is #t (the default is #f), transform peak information is included in the transform display.
This is the 'peaks' button in the <a href="snd.html#viewfft">Transform</a> options dialog.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- show-y-zero -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="showyzero">show-y-zero</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If show-y-zero is #t (the default is #f), the y=0 axis is displayed. This is the '<a href="snd.html#viewy0">Show Y=0</a>' View menu option.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="showyzero">show-y-zero</em> snd chn
+</pre>
+
+<p>If show-y-zero is #t (the default is #f), the y=0 axis is displayed. This is the '<a href="snd.html#viewy0">Show Y=0</a>' View menu option.
+</p>
+<div class="separator"></div>
<!-- smooth-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="smoothchannel">smooth-channel</a> <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-smooth-channel is the <a class=quiet href="#regularizedargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_regularizedargs_tip)">regularized</a> version of <a href="#smoothsound">smooth-sound</a>.
-smooth-channel-via-ptree in examp.scm is the virtual form.
+<pre class="indented">
+<em class=def id="smoothchannel">smooth-channel</em> beg dur snd chn edpos
+</pre>
+
+<p>smooth-channel is the <a class=quiet href="#regularizedargs">regularized</a> version of <a href="#smoothsound">smooth-sound</a>.
+</p>
<!-- INDEX smoothexamples:Smoothing -->
-<A NAME="smoothexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<small><blockquote>
-smooth all channels: <a href="#smoothsound">smooth-sound</a><br>
-smooth selection: <a href="#smoothselection">smooth-selection</a><br>
-delete the selection and smooth the splice: <a href="#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
-smoothing as virtual op: smooth-channel-via-ptree in examp.scm<br>
+<TABLE class="method">
+<tr><th class="title">Smoothing</th></tr><tr><td>
+<blockquote id="smoothexamples"><small>
+smooth channel: <a href="extsnd.html#smoothchannel">smooth-channel</a><br>
+smooth all channels: <a href="extsnd.html#smoothsound">smooth-sound</a><br>
+smooth selection: <a href="extsnd.html#smoothselection">smooth-selection</a><br>
+delete the selection and smooth the splice: <a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
smoothing via fft: <a href="sndscm.html#fftsmoother">fft-smoother</a><br>
-smooth via low-pass <a href="#filtersinsnd">filter</a><br>
+smooth via low-pass <a href="extsnd.html#filtersinsnd">filter</a><br>
smooth over click: <a href="sndscm.html#removeclicks">remove-clicks</a> in examp.scm<br>
-</blockquote></small>
+</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- smooth-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="smoothsound">smooth-sound</a> <em class=narg>beg num snd chn</em></code>
-</td></tr><tr><td></td><td>
-smooth-sound applies a smoothing function to the indicated data. This produces a sinusoid between
-the end points:
+<pre class="indented">
+<em class=def id="smoothsound">smooth-sound</em> beg num snd chn
+</pre>
+<p>smooth-sound applies a smoothing function to the indicated data. This produces a sinusoid between
+the end points:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (smoother y0 y1 num)
- "go sinusoidally from y0 to y1 over num samps"
- (let ((v (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> (+ 1 num)))
+ (let ((v (make-float-vector (+ 1 num) 0.0))
(angle (if (> y1 y0) pi 0.0))
(off (* .5 (+ y0 y1)))
(scale (* 0.5 (abs (- y1 y0)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i num) v)
(set! (v i) (+ off (* scale (cos (+ angle (* i (/ pi num))))))))))
-</pre></td></tr></table>
+</pre>
-<img src="pix/click.png" alt="smoother">
-<br>
-For a fancier version, see fft-smoother in examp.scm. See also <a href="sndscm.html#removeclicks">remove-clicks</a> in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<img class="indented" src="pix/click.png" alt="smoother">
+
+<p>For a fancier version, see fft-smoother in examp.scm. See also <a href="sndscm.html#removeclicks">remove-clicks</a> in examp.scm.
+</p>
+<div class="separator"></div>
<!-- sound? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="soundp">sound?</a> snd</code>
-</td></tr><tr><td></td><td>
-sound? returns #t if 'snd' refers to an open sound.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="soundp">sound?</em> snd
+</pre>
+
+<p>sound? returns #t if 'snd' refers to an open sound.
+</p>
+<div class="separator"></div>
<!-- soundfont-info -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="soundfontinfo">soundfont-info</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This returns a list of lists describing 'snd' as a soundfont. Each inner list
+<pre class="indented">
+<em class=def id="soundfontinfo">soundfont-info</em> snd
+</pre>
+
+<p>This returns a list of lists describing 'snd' as a soundfont. Each inner list
consists of the sound name, start point, loop start, and loop end.
-<pre>
- :<em class=typing>(soundfont-info)</em>
- <em class=listener>(("BrSteel_E4" 0 65390 65458) ("BrSteel_B2" 65490 131458 131637) ...)</em>
+</p>
+
+<pre class="indented">
+> (soundfont-info)
+(("BrSteel_E4" 0 65390 65458) ("BrSteel_B2" 65490 131458 131637) ...)
</pre>
-To set a named mark at the start of each sound with un-named marks
-at the loop points:
-<table border=0 cellpadding=10><tr><td>
-<table border=0><tr><td><pre>
+<p>To set a named mark at the start of each sound with un-named marks
+at the loop points:
+</p>
+<pre class="indented">
(define (mark-sf2)
(letrec
((sf2it
(lambda (lst)
- (if (not (null? lst))
+ (if (pair? lst)
(let* ((vals (car lst))
- (m1 (<a class=quiet href="#addmark" onmouseout="UnTip()" onmouseover="Tip(extsnd_addmark_tip)">add-mark</a> (cadr vals))))
- (set! (<a class=quiet href="#markname" onmouseout="UnTip()" onmouseover="Tip(extsnd_markname_tip)">mark-name</a> m1) (car vals)))
- (<a class=quiet href="#addmark" onmouseout="UnTip()" onmouseover="Tip(extsnd_addmark_tip)">add-mark</a> (caddr vals))
- (<a class=quiet href="#addmark" onmouseout="UnTip()" onmouseover="Tip(extsnd_addmark_tip)">add-mark</a> (cadddr vals))
- (sf2it (cdr lst))))))
+ (m1 (<a class=quiet href="#addmark">add-mark</a> (cadr vals))))
+ (set! (<a class=quiet href="#markname">mark-name</a> m1) (car vals))
+ (<a class=quiet href="#addmark">add-mark</a> (caddr vals))
+ (<a class=quiet href="#addmark">add-mark</a> (cadddr vals))
+ (sf2it (cdr lst)))))))
(sf2it (<em class=red>soundfont-info</em>))))
-</pre></td></tr></table>
-</td><td>
-<img src="pix/bongo.png" alt="soundfont marks">
-</td></tr></table>
+</pre>
-See also explode-sf2 in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<img class="indented" src="pix/bongo.png" alt="soundfont marks">
+
+<p>See also explode-sf2 in examp.scm.
+</p>
+<div class="separator"></div>
<!-- sound->integer -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="soundtointeger">sound->integer</a> sound</code>
-</td></tr><tr><td></td><td>
-This is the counterpart to <a href="#integertosound">integer->sound</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="soundtointeger">sound->integer</em> sound
+</pre>
+
+<p>This is the counterpart to <a href="#integertosound">integer->sound</a>.
+</p>
+<div class="separator"></div>
<!-- sound-loop-info -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="soundloopinfo">sound-loop-info</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This gives info about loop points from the sound's header. The loop info is a list of
+<pre class="indented">
+<em class=def id="soundloopinfo">sound-loop-info</em> snd
+</pre>
+
+<p>This gives info about loop points from the sound's header. The loop info is a list of
up to 4 points, the first two (start, end) refer to the sustain loop,
the second two to the release. The 5th and 6th list entries are the base note and detune values.
For historical reasons, the 7th and 8th entries are the sustain and release modes.
This is similar to <a href="#mussoundloopinfo">mus-sound-loop-info</a> (but it's settable). See explode-sf2 in examp.scm.
-<pre>
- :<em class=typing>(sound-loop-info)</em>
- <em class=listener>(24981 144332 0 0 60 0 1 0)</em>
+</p>
+
+<pre class="indented">
+> (sound-loop-info)
+(24981 144332 0 0 60 0 1 0)
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- sound-properties -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="soundproperties">sound-properties</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This is a property list associated with the given sound. It is set to '() at the time a sound is opened. The accessor
+<pre class="indented">
+<em class=def id="soundproperties">sound-properties</em> snd
+</pre>
+
+<p>This is a property list associated with the given sound. It is set to () at the time a sound is opened. The accessor
is <a href="#soundproperty">sound-property</a>. There are several
examples of using it in snd-motif.scm and autosave.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- sound-property -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="soundproperty">sound-property</a> key snd</code>
-</td></tr><tr><td></td><td>
-sound-property provides access to a sound's <a href="#soundproperties">property list</a>.
+<pre class="indented">
+<em class=def id="soundproperty">sound-property</em> key snd
+</pre>
+
+<p>sound-property provides access to a sound's <a href="#soundproperties">property list</a>.
These properties are saved when Snd's state is saved (via <a href="extsnd.html#savestate">save-state</a>
or the Options:Save session menu). To omit a given property at that time, add its name (a symbol) to
the property 'save-state-ignore (a list of symbols); see 'inset-envelope in extensions.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
<!-- sounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sounds">sounds</a></code>
-</td></tr><tr><td></td><td>
-sounds returns a list of currently active sounds.
+<pre class="indented">
+<em class=def id="sounds">sounds</em>
+</pre>
+
+<p>sounds returns a list of currently active sounds.
A common Snd trope is (map func (sounds)):
-<pre>
- (map maxamp (sounds))
+</p>
+
+<pre class="indented">
+(map maxamp (sounds))
</pre>
-Or, if
+
+<p>Or, if
the return value is not needed:
-<pre>
- (for-each (lambda (snd) (display (<a class=quiet href="#shortfilename" onmouseout="UnTip()" onmouseover="Tip(extsnd_shortfilename_tip)">short-file-name</a> snd))) (sounds))
+</p>
+
+<pre class="indented">
+(for-each (lambda (snd) (display (<a class=quiet href="#shortfilename">short-file-name</a> snd))) (sounds))
</pre>
-This can be
+
+<p>This can be
extended to provide a complete list of sounds and channels (since many Snd functions
take the "snd chn" arguments):
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (all-chans)
- (let ((sndlist '())
- (chnlist '()))
+ (let ((sndlist ())
+ (chnlist ()))
(for-each (lambda (snd)
- (do ((i (- (<a class=quiet href="#channels" onmouseout="UnTip()" onmouseover="Tip(extsnd_channels_tip)">channels</a> snd) 1) (- i 1)))
+ (do ((i (- (<a class=quiet href="#channels">channels</a> snd) 1) (- i 1)))
((< i 0))
(set! sndlist (cons snd sndlist))
(set! chnlist (cons i chnlist))))
(<em class=red>sounds</em>))
(list sndlist chnlist)))
-(apply map <a class=quiet href="#maxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_maxamp_tip)">maxamp</a> (all-chans))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+(apply map <a class=quiet href="#maxamp">maxamp</a> (all-chans))
+</pre>
+<div class="separator"></div>
<!-- spectrum-end -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectrumend">spectrum-end</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the amount of the frequency domain to include in the spectrum
+<pre class="indented">
+<em class=def id="spectrumend">spectrum-end</em> snd chn
+</pre>
+
+<p>This is the amount of the frequency domain to include in the spectrum
display (the default is 1.0 = all of it).
spectrum-end the slider labelled '% of spectrum' in the View
Orientation dialog. See zoom-fft in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- spectro-hop -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectrohop">spectro-hop</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the distance (in pixels) moved between successive spectrogram traces
+<pre class="indented">
+<em class=def id="spectrohop">spectro-hop</em> snd chn
+</pre>
+
+<p>This is the distance (in pixels) moved between successive spectrogram traces
(default is 4). spectro-hop is the 'hop' slider in the Color/Orientation dialog.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- spectrum-start -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectrumstart">spectrum-start</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the start point of the frequency domain in the spectrum
+<pre class="indented">
+<em class=def id="spectrumstart">spectrum-start</em> snd chn
+</pre>
+
+<p>This is the start point of the frequency domain in the spectrum
display (default is 0.0). See zoom-fft in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- spectro-x-angle -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectroxangle">spectro-x-angle</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the spectrogram x-axis viewing angle (the default is 90.0 except in GL where it is 300.0). See snd-gl.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="spectroxangle">spectro-x-angle</em> snd chn
+</pre>
+
+<p>This is the spectrogram x-axis viewing angle (the default is 90.0 except in GL where it is 300.0). See snd-gl.scm.
+</p>
+<div class="separator"></div>
<!-- spectro-x-scale -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectroxscale">spectro-x-scale</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the scaler (stretch amount) along the spectrogram x axis (the is default 1.0, in GL: 1.5).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="spectroxscale">spectro-x-scale</em> snd chn
+</pre>
+
+<p>This is the scaler (stretch amount) along the spectrogram x axis (the is default 1.0, in GL: 1.5).
+</p>
+<div class="separator"></div>
<!-- spectro-y-angle -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectroyangle">spectro-y-angle</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the spectrogram y axis viewing angle (the default is 0.0, in GL: 320.0).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="spectroyangle">spectro-y-angle</em> snd chn
+</pre>
+
+<p>This is the spectrogram y axis viewing angle (the default is 0.0, in GL: 320.0).
+</p>
+<div class="separator"></div>
<!-- spectro-y-scale -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectroyscale">spectro-y-scale</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the scaler (stretch amount) for the spectrogram y axis (the default is 1.0).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="spectroyscale">spectro-y-scale</em> snd chn
+</pre>
+
+<p>This is the scaler (stretch amount) for the spectrogram y axis (the default is 1.0).
+</p>
+<div class="separator"></div>
<!-- spectro-z-angle -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectrozangle">spectro-z-angle</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the spectrogram viewing angle for the z axis (the default is 358.0, in GL: 0.0).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="spectrozangle">spectro-z-angle</em> snd chn
+</pre>
+
+<p>This is the spectrogram viewing angle for the z axis (the default is 358.0, in GL: 0.0).
+</p>
+<div class="separator"></div>
<!-- spectro-z-scale -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="spectrozscale">spectro-z-scale</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the scaler (stretch amount) for the z axis (the default is 0.1, in GL: 1.0).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="spectrozscale">spectro-z-scale</em> snd chn
+</pre>
+
+<p>This is the scaler (stretch amount) for the z axis (the default is 0.1, in GL: 1.0).
+</p>
+<div class="separator"></div>
<!-- squelch-update -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="squelchupdate">squelch-update</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is #t if graphic updates are currently squelched (turned off). If you're doing a sequence of edits where intermediate
+<pre class="indented">
+<em class=def id="squelchupdate">squelch-update</em> snd chn
+</pre>
+
+<p>This is #t if graphic updates are currently squelched (turned off). If you're doing a sequence of edits where intermediate
states aren't of great interest, you can save time by turning off redisplays.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (without-graphics thunk)
(set! (<em class=red>squelch-update</em>) #t)
(let ((val (catch #t thunk (lambda args (car args)))))
(set! (<em class=red>squelch-update</em>) #f)
val))
-</pre></td></tr></table>
-</td></tr>
+</pre>
+<div class="separator"></div>
<!-- srate -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="srate">srate</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This is the sound's sampling rate. If you set this to a new value, update-sound is called to
+<pre class="indented">
+<em class=def id="srate">srate</em> snd
+</pre>
+
+<p>This is the sound's sampling rate. If you set this to a new value, update-sound is called to
reflect the new srate, but any current edits are flushed. This is consistent
-with the other header fields (data-format, etc), but it can be annoying.
-<br><br>
-There are several srates floating around in Snd.
+with the other header fields (sample-type, etc), but it can be annoying.
+</p>
+
+<p>There are several srates floating around in Snd.
<code>(srate snd)</code> returns the sampling rate of a particular (currently open) sound.
-<code>(<a class=quiet href="#mussoundsrate" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundsrate_tip)">mus-sound-srate</a> filename)</code> returns a sound file's sampling rate.
-<code>mus-srate</code> is associated with the CLM package (setting the implicit srate for oscil etc).
-<code>default-output-srate</code> is the default sampling rate used when opening new files.
-<code>enved-srate</code> is a constant that can be assigned to the envelope editor's <code>enved-target</code> (to apply an envelope to the sampling rate).
-<code>region-srate</code> is the sampling rate associated with a region.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<code>(<a class=quiet href="#mussoundsrate">mus-sound-srate</a> filename)</code>
+returns a sound file's sampling rate.
+*clm-srate* (also known as mus-srate) is associated with the CLM package (setting the implicit srate for oscil etc).
+default-output-srate is the default sampling rate used when opening new files.
+enved-srate is a constant that can be assigned to the envelope editor's enved-target (to apply an envelope to the sampling rate).
+region-srate is the sampling rate associated with a region.
+</p>
+<div class="separator"></div>
<!-- src-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="srcchannel">src-channel</a> num-or-env <em class=narg>beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-src-channel preforms sampling rate conversion using 'warped sinc interpolation'. The
+<pre class="indented">
+<em class=def id="srcchannel">src-channel</em> num-or-env beg dur snd chn edpos
+</pre>
+
+<p id="resampleexamples">src-channel preforms sampling rate conversion using 'warped sinc interpolation'. The
argument 'num-or-env' can be a number, an envelope, or a CLM env generator.
-<code>(src-channel 2.0)</code> makes the sound go twice as fast.
-This is the <a class=quiet href="#regularizedargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_regularizedargs_tip)">regularized</a> version of <a href="#srcsound">src-sound</a>.
-<pre>
- <em class=listener>:</em><em class=typing>(frames)</em> ; current duration
- <em class=listener>50828</em>
- <em class=listener>:</em><em class=typing>(src-channel 2.0)</em> ; make it half as long
- <em class=listener>2.0</em>
- <em class=listener>:</em><em class=typing>(frames)</em>
- <em class=listener>25415</em>
- <em class=listener>:</em><em class=typing>(src-channel '(0 .5 1 1))</em> ; start slow and speed up
- <em class=listener>(0 0.5 1 1)</em>
- <em class=listener>:</em><em class=typing>(frames)</em>
- <em class=listener>35235</em>
- <em class=listener>:</em><em class=typing>(src-channel (make-env '(0 .5 1 1) :length 20000))</em> ; stick at 1 after sample 20000
- <em class=listener>#<env linear, pass: 35236 (dur: 20000), index: 1, scaler: 1.0000, offset: 0.0000, ...></em>
- <em class=listener>:</em><em class=typing>(frames)</em>
- <em class=listener>42964</em>
+(src-channel 2.0) makes the sound go twice as fast.
+This is the <a class=quiet href="#regularizedargs">regularized</a> version of <a href="#srcsound">src-sound</a>.
+</p>
+
+<pre class="indented">
+> (framples) ; current duration
+50828
+> (src-channel 2.0) ; make it half as long
+2.0
+> (framples)
+25415
+> (src-channel '(0 .5 1 1)) ; start slow and speed up
+(0 0.5 1 1)
+> (framples)
+35235
+> (src-channel (make-env '(0 .5 1 1) :length 20000)) ; stick at 1 after sample 20000
+#<env linear, pass: 35236 (dur: 20000), index: 1, scaler: 1.0000, offset: 0.0000, ...>
+> (framples)
+42964
</pre>
<!-- INDEX resampleexamples:Resampling -->
-<A NAME="resampleexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<small><blockquote>
-resample all chans: <a href="#srcsound">src-sound</a><br>
-resample selection: <a href="#srcsoundselection">src-selection</a><br>
-resample mix: speed control in <a href="snd.html#mixdialog">Mix dialog</a> (also <a href="#applycontrols">apply-controls</a>)<br>
+<TABLE class="method">
+<tr><th class="title">Resampling</th></tr><tr><td>
+<blockquote><small>
+resample channel: <a href="extsnd.html#srcchannel">src-channel</a><br>
+resample all chans: <a href="extsnd.html#srcsound">src-sound</a><br>
+resample selection: <a href="extsnd.html#srcsoundselection">src-selection</a><br>
+resample mix: speed control in <a href="snd.html#mixdialog">Mix dialog</a> (also <a href="extsnd.html#applycontrols">apply-controls</a>)<br>
resample via drawn envelope: srate in <a href="snd.html#editenvelope">Envelope editor</a><br>
resample via CLM gen: <a href="sndclm.html#src">src</a><br>
resample with independent time control (ssb-am): <a href="sndscm.html#ssbbank">ssb-bank</a> in dsp.scm<br>
-resample with independent time control (granulate): expand in <a href="#customcontrols">control panel</a>, <a href="sndscm.html#expsrc">expsrc</a> and <a href="sndscm.html#expsnd">expsnd</a><br>
+resample with independent time control (granulate): expand in <a href="extsnd.html#customcontrols">control panel</a>, <a href="sndscm.html#expsrc">expsrc</a> and <a href="sndscm.html#expsnd">expsnd</a><br>
resample with independent time control (vocoder): <a href="sndclm.html#phase-vocoder">phase-vocoder</a> (this never works)<br>
another time stretcher (autocorrelation):<a href="sndscm.html#rubbersound">rubber-sound</a> (this takes forever and rarely works)<br>
-resampling-based sound effects: <a href="sndscm.html#hellodentist">hello-dentist</a>, <a href="sndscm.html#fp">fp</a> ("Forbidden Planet"), flange and chorus in dsp.scm and new-effects.scm<br>
+resampling-based sound effects: <a href="sndscm.html#hellodentist">hello-dentist</a>, <a href="sndscm.html#fp">fp</a>, flange and chorus in dsp.scm and new-effects.scm<br>
the digital zipper: <a href="sndscm.html#zipdoc">zipper</a><br>
resample via FFT: <a href="sndscm.html#downoct">down-oct</a><br>
resample through env: <a href="sndscm.html#soundinterp">sound-interp</a> and <a href="sndscm.html#envsoundinterp">env-sound-interp</a><br>
resample through list: <a href="sndscm.html#scratch">scratch</a><br>
-resample step-size through a function: <a href="#setsamples">step-src</a><br>
+resample step-size through a function: <a href="extsnd.html#setsamples">step-src</a><br>
predict duration of resampled sound: <a href="sndscm.html#srcduration">src-duration</a><br>
linear src: linear-src-channel in dsp.scm<br>
-<br>
-</blockquote></small>
+</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- src-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="srcsound">src-sound</a> num-or-env <em class=narg>base snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-src-sound performs sampling rate conversion using 'warped sinc interpolation'. The
+<pre class="indented">
+<em class=def id="srcsound">src-sound</em> num-or-env base snd chn edpos
+</pre>
+
+<p>src-sound performs sampling rate conversion using 'warped sinc interpolation'. The
argument 'num-or-env', which sets the ratio between the old and the new srate, can be either a number or an envelope.
In the latter case, 'base' sets the segment base (the default is 1.0 = linear).
A value greater than 1.0 causes the sound to be transposed up.
A value less than 0.0 causes the sound to be reversed.
-<code>(src-sound 2.0)</code> speeds the sound up by a factor
-of 2 (transposes it up an octave), whereas <code>(src-sound 0.5)</code>
+(src-sound 2.0) speeds the sound up by a factor
+of 2 (transposes it up an octave), whereas (src-sound 0.5)
slows it down by the same factor (transposes it down an octave).
-<code>(src-sound '(0 1 1 2))</code> starts at the original speed, then
+(src-sound '(0 1 1 2)) starts at the original speed, then
gradually increases until, at the end of the sound, it is going
twice as fast.
-<br><br>
-'num-or-env' can also be a CLM env generator (its duration should
+</p>
+
+<p>'num-or-env' can also be a CLM env generator (its duration should
be the same as the original sound, and its segments should not pass through 0.0). The following function can be used to predict
how long the resultant note will be given an src envelope:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
;;; find new duration of sound after using env as srate.
;;; the envelope gives the per-sample increment, so the "tempo"
;;; is the inverse of that. To get the total new duration,
@@ -9503,7 +9684,7 @@ how long the resultant note will be given an src envelope:
;;; tempo curve, so we use log(x) as integral of 1/x and
;;; take into account the local notion of "x".
-(define (<a class=quiet NAME="exsrcduration">src-duration</a> e)
+(define (<em class="noem">src-duration</em> e)
(let* ((len (length e))
(ex0 (e 0))
(ex1 (e (- len 2)))
@@ -9527,140 +9708,177 @@ how long the resultant note will be given an src envelope:
;;; (src-duration '(0 .5 .5 3 .6 1 .7 .1 .8 1.5 1 1)) -> 1.02474349685432
;;; here we're using this in the Snd listener:
-<em class=listener>></em><em class=typing>(frames)</em>
-<em class=listener>220501</em>
-<em class=listener>></em><em class=typing>(src-duration '(0 1 1 2))</em>
-<em class=listener>0.693147180559945</em>
-<em class=listener>></em><em class=typing>(src-sound '(0 1 1 2))</em> ; should be about .693 * 220500 frames
-<em class=listener>(0 1 1 2)</em>
-<em class=listener>></em><em class=typing>(frames)</em>
-<em class=listener>152842</em>
-<em class=listener>></em><em class=typing>(/ 152842.0 220501)</em>
-<em class=listener>0.693157854159392</em><em class=typing></em> ; tada!
-</pre></td></tr></table>
-
-The inverse, so to speak, of this is <a href="sndscm.html#srcfitenvelope">src-fit-envelope</a>:
-<pre>
+> (framples)
+220501
+> (src-duration '(0 1 1 2))
+0.693147180559945
+> (src-sound '(0 1 1 2)) ; should be about .693 * 220500 framples
+(0 1 1 2)
+> (framples)
+152842
+> (/ 152842.0 220501)
+0.693157854159392 ; tada!
+</pre>
+
+<p>The inverse, so to speak, of this is <a href="sndscm.html#srcfitenvelope">src-fit-envelope</a>:
+</p>
+
+<pre class="indented">
(define (src-fit-envelope e target-dur)
(scale-envelope e (/ (src-duration e) target-dur)))
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- start-playing -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="startplaying">start-playing</a> <em class=narg>chans srate background</em></code>
-</td></tr><tr><td></td><td>
-If a <a href="#makeplayer">play-list</a> is waiting, this starts it. 'chans' defaults to 1,
+<pre class="indented">
+<em class=def id="startplaying">start-playing</em> chans srate background
+</pre>
+
+<p>If a <a href="#makeplayer">play-list</a> is waiting, this starts it. 'chans' defaults to 1,
'srate' defaults to 44100, 'background' defaults to #t. See play.scm or marks.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- start-progress-report -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="startprogressreport">start-progress-report</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This starts a <a href="#progressreport">progress-report</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="startprogressreport">start-progress-report</em> snd chn
+</pre>
+
+<p>This starts a <a href="#progressreport">progress-report</a>.
+</p>
+<div class="separator"></div>
+
+
+<!-- status-report -->
+<pre class="indented">
+<em class=def id="statusreport">status-report</em> msg snd
+</pre>
+
+<p>This posts 'msg' in the sound's status area. The status area is the text widget between the sound's filename and the buttons
+on the right, beneath the graph.
+If 'snd' is not a currently open sound, the message is sent to the listener, if it is open.
+If there is no sound or listener, 'msg' is sent to stderr.
+</p>
+<div class="separator"></div>
<!-- stop-player -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="stopplayer">stop-player</a> player</code>
-</td></tr><tr><td></td><td>
-This removes 'player' from the current play-list (see <a href="#makeplayer">make-player</a>).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="stopplayer">stop-player</em> player
+</pre>
+
+<p>This removes 'player' from the current play-list (see <a href="#makeplayer">make-player</a>).
+</p>
+<div class="separator"></div>
<!-- stop-playing -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="stopplaying">stop-playing</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-If 'snd' is playing, this stops it.
+<pre class="indented">
+<em class=def id="stopplaying">stop-playing</em> snd
+</pre>
+
+<p>If 'snd' is playing, this stops it.
If no argument is given, it stops all playback. See play.scm,
<a href="#stopplayinghook">stop-playing-hook</a>, or <a href="#stopplayingselectionhook">stop-playing-selection-hook</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- swap-channels -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="swapchannels">swap-channels</a> <em class=narg>snd1 chn1 snd2 chn2 beg dur edpos0 edpos1</em></code>
-</td></tr><tr><td></td><td>
-This swaps the indicated channels, between 'beg' and 'beg' + 'dur'.
+<pre class="indented">
+<em class=def id="swapchannels">swap-channels</em> snd1 chn1 snd2 chn2 beg dur edpos0 edpos1
+</pre>
+
+<p id="reversechannels">This swaps the indicated channels, between 'beg' and 'beg' + 'dur'.
In simple cases, this is a virtual operation. swap-channels can be used to change channel order arbitrarily.
For example, the following function reverses the channel order:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<a name="reversechannels">reverse-channels</a> snd)
- (let* ((ind (or snd (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (car (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>))))
- (chns (<a class=quiet href="#channels" onmouseout="UnTip()" onmouseover="Tip(extsnd_channels_tip)">channels</a> ind)))
+<pre class="indented">
+(define* (reverse-channels snd)
+ (let* ((ind (or snd (<a class=quiet href="#selectedsound">selected-sound</a>) (car (<a class=quiet href="#sounds">sounds</a>))))
+ (chns (<a class=quiet href="#channels">channels</a> ind)))
(let ((swaps (floor (/ chns 2))))
- (<a class=quiet href="#asoneedit" onmouseout="UnTip()" onmouseover="Tip(extsnd_asoneedit_tip)">as-one-edit</a>
+ (<a class=quiet href="#asoneedit">as-one-edit</a>
(lambda ()
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(j (- chns 1) (- j 1)))
((= i swaps))
(<em class=red>swap-channels</em> ind i ind j)))))))
-</pre></td></tr></table>
+</pre>
-Channel rotation is similar, though slightly more work; see scramble-channels in examp.scm.
+<p>Channel rotation is similar, though slightly more work; see scramble-channels in examp.scm.
Since swap-channels is a virtual operation in many cases, it's worth using it even
where just a channel copy is desired; <a href="sndscm.html#monotostereo">mono->stereo</a>
in extensions.scm for an example.
Another example is swap-selection-channels in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- sync -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sync">sync</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-sync returns the sound's 'sync' value (an integer, 0 = not sync'd). Several functions (<a href="#scaleby">scale-by</a>, for example), apply to the
+<pre class="indented">
+<em class=def id="sync">sync</em> snd
+</pre>
+
+<p>sync returns the sound's 'sync' value (an integer, 0 = not sync'd). Several functions (<a href="#scaleby">scale-by</a>, for example), apply to the
currently selected sound and also to any other sounds that share its sync value. (I later decided that
this was a bad idea, hence the regularized replacements). Sounds that share a given sync value
move together when you drag an x-axis slider and so on.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- sync-max -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="syncmax">sync-max</a></code>
-</td></tr><tr><td></td><td>
-This is the maximum <a href="#sync">sync</a> setting seen so far — it provides a painless way to get a sync value that
+<pre class="indented">
+<em class=def id="syncmax">sync-max</em>
+</pre>
+
+<p>This is the maximum <a href="#sync">sync</a> setting seen so far — it provides a painless way to get a sync value that
is guaranteed to be unique. To sync all currently open sounds:
-<pre>
- (let ((new-sync (+ 1 (<em class=red>sync-max</em>))))
- (for-each (lambda (snd) (set! (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> snd) new-sync)) (<a class=quiet href="#sounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounds_tip)">sounds</a>)))
+</p>
+
+<pre class="indented">
+(let ((new-sync (+ 1 (<em class=red>sync-max</em>))))
+ (for-each (lambda (snd) (set! (<a class=quiet href="#sync">sync</a> snd) new-sync)) (<a class=quiet href="#sounds">sounds</a>)))
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- time-graph? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="timegraphp">time-graph?</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is #t if the time domain graph is being displayed (the 'w' button).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="timegraphp">time-graph?</em> snd chn
+</pre>
+
+<p>This is #t if the time domain graph is being displayed (the 'w' button).
+</p>
+<div class="separator"></div>
<!-- time-graph-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="timegraphstyle">time-graph-style</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This determines how time-domain data is displayed.
+<pre class="indented">
+<em class=def id="timegraphstyle">time-graph-style</em> snd chn
+</pre>
+
+<p>This determines how time-domain data is displayed.
The choices are:
-<pre>
- graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
+</p>
+
+<pre class="indented">
+graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
- (set! (time-graph-style 0 4) graph-lollipops)
+(set! (time-graph-style 0 4) graph-lollipops)
</pre>
-<img src="pix/graphstyle.png" alt="graph styles">
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<img class="indented" src="pix/graphstyle.png" alt="graph styles">
+
+<div class="separator"></div>
<!--
-(with-sound (:channels 5) (do ((i 0 (+ 1 i))) ((= i 5)) (fm-violin 0 .4 (* (+ 1 i) 100) .1 :degree (* i 72))))
-(do ((i 0 (+ 1 i))) ((= i 5)) (set! (time-graph-style 0 i) i))
+(with-sound (:channels 5) (do ((i 0 (+ i 1))) ((= i 5)) (fm-violin 0 .4 (* (+ i 1) 100) .1 :degree (* i 72))))
+(do ((i 0 (+ i 1))) ((= i 5)) (set! (time-graph-style 0 i) i))
(set! (dot-size) 4)
(set! (selected-graph-color) (make-color 1 1 1))
(set! (selected-data-color) (make-color 0 0 0))
@@ -9673,77 +9891,88 @@ The choices are:
<!-- time-graph-type -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="timegraphtype">time-graph-type</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If time-graph-type is <code>graph-as-wavogram</code>, the time domain waveform is displayed as a
-'<a href="snd.html#wavogram" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/wavo.png\' width=\'640\' height=\'250\'>', TITLE, 'graph-as-wavogram', ABOVE, true)">wavogram</a>'.
-The default is <code>graph-once</code>. See also <a href="#wavohop">wavo-hop</a> and <a href="#wavotrace">wavo-trace</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="timegraphtype">time-graph-type</em> snd chn
+</pre>
+
+<p>If time-graph-type is graph-as-wavogram, the time domain waveform is displayed as a
+'<a href="snd.html#wavogram">wavogram</a>'.
+The default is graph-once. See also <a href="#wavohop">wavo-hop</a> and <a href="#wavotrace">wavo-trace</a>.
+</p>
+<div class="separator"></div>
<!-- tracking-cursor-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="trackingcursorstyle">tracking-cursor-style</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the <a href="#cursorstyle">cursor-style</a> in effect when the cursor is tracking playback (<a href="#withtrackingcursor">with-tracking-cursor</a>).
-tracking-cursor-style can be <code>cursor-cross</code> or <code>cursor-line</code> (the default). If you want some other shape,
+<pre class="indented">
+<em class=def id="trackingcursorstyle">tracking-cursor-style</em> snd chn
+</pre>
+
+<p>This is the <a href="#cursorstyle">cursor-style</a> in effect when the cursor is tracking playback (<a href="#withtrackingcursor">with-tracking-cursor</a>).
+tracking-cursor-style can be cursor-cross or cursor-line (the default). If you want some other shape,
use the function choice for cursor-style (that function's third argument can tell you when you're tracking).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
+
+<!-- transform-framples -->
+<pre class="indented">
+<em class=def id="transformframples">transform-framples</em> snd chn
+</pre>
-<!-- transform-frames -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformframes">transform-frames</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns either 0 if there is no transform, <a href="#transformsize">transform-size</a> if
-<a href="#transformgraphtype">transform-graph-type</a> is <code>graph-once</code>,
+<p>This returns either 0 if there is no transform, <a href="#transformsize">transform-size</a> if
+<a href="#transformgraphtype">transform-graph-type</a> is graph-once,
or (list spectrum-end time-slices fft-bins) if either a sonogram or a spectrogram is being displayed.
+</p>
-<pre>
- <em class=listener>:</em><em class=typing>(set! (transform-graph?) #t)</em> ; turn on fft display
- <em class=listener>#t</em>
- <em class=listener>:</em><em class=typing>(transform-frames)</em>
- <em class=listener>512</em>
- <em class=listener>:</em><em class=typing>(set! (transform-graph-type) graph-as-sonogram)</em>
- <em class=listener>1</em> ; 1 = graph-as-sonogram
- <em class=listener>:</em><em class=typing>(transform-frames)</em>
- <em class=listener>(1.0 375 256)</em> ; 1.0 -> full spectrum displayed
- <em class=listener>:</em><em class=typing>(set! (transform-graph?) #f)</em> ; turn off fft display
- <em class=listener>#f</em>
- <em class=listener>:</em><em class=typing>(transform-frames)</em>
- <em class=listener>0</em>
+<pre class="indented">
+> (set! (transform-graph?) #t) ; turn on fft display
+#t
+> (transform-framples)
+512
+> (set! (transform-graph-type) graph-as-sonogram)
+1 ; 1 = graph-as-sonogram
+> (transform-framples)
+(1.0 375 256) ; 1.0 -> full spectrum displayed
+> (set! (transform-graph?) #f) ; turn off fft display
+#f
+> (transform-framples)
+0
</pre>
-
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- transform-graph? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformgraphp">transform-graph?</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is #t if the given channel is displaying a spectrum (the 'f' button).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="transformgraphp">transform-graph?</em> snd chn
+</pre>
+
+<p>This is #t if the given channel is displaying a spectrum (the 'f' button).
+</p>
+<div class="separator"></div>
<!-- transform-graph-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformgraphstyle">transform-graph-style</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This determines how frequency-domain data is displayed.
+<pre class="indented">
+<em class=def id="transformgraphstyle">transform-graph-style</em> snd chn
+</pre>
+
+<p>This determines how frequency-domain data is displayed.
The choices are:
-<pre>
- graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
+</p>
+
+<pre class="indented">
+graph-lines graph-dots graph-filled graph-lollipops graph-dots-and-lines
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- transform-graph-type -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformgraphtype">transform-graph-type</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This determines the choice of spectral display. The choices are (default) <code>graph-once</code> (a single FFT),
-<code>graph-as-sonogram</code>, and <code>graph-as-spectrogram</code>.
+<pre class="indented">
+<em class=def id="transformgraphtype">transform-graph-type</em> snd chn
+</pre>
+
+<p>This determines the choice of spectral display. The choices are (default) graph-once (a single FFT),
+graph-as-sonogram, and graph-as-spectrogram.
The sonogram is a set of FFTS taken at regular time intervals displayed as time vs frequency, using the
width or color of the spectral portion to indicate its amplitude. The spectrogram is similar, but uses
a 3D effect where the height of the line corresponds to its amplitude.
@@ -9751,370 +9980,433 @@ Currently, the <a href="#fftlogfrequency">fft-log-frequency</a> and <a href="#no
choices are ignored by the spectrogram display.
If you've included openGL in Snd, the spectrogram will use openGL if <a href="#withgl">with-gl</a> is #t (the
default).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- transform-normalization -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="normalizefft">transform-normalization</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the transform normalization choice (default: <code>normalize-by-channel</code>).
-If it is <code>normalize-by-channel</code> or <code>normalize-by-sound</code>, spectral data is
-normalized to 1.0 before display. If <code>dont-normalize</code>, you get the
+<pre class="indented">
+<em class=def id="normalizefft">transform-normalization</em> snd chn
+</pre>
+
+<p>This is the transform normalization choice (default: normalize-by-channel).
+If it is normalize-by-channel or normalize-by-sound, spectral data is
+normalized to 1.0 before display. If dont-normalize, you get the
raw data values, which can reflect amplitude changes — Snd tries to
choose a y axis limit that makes successive displays move smoothly.
-The other choice is <code>normalize-globally</code> (i.e. across all sounds).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+The other choice is normalize-globally (i.e. across all sounds).
+</p>
+<div class="separator"></div>
<!-- transform-sample -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformsample">transform-sample</a> <em class=narg>bin slice snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the current value of the transform (if any) in 'bin' and (if a
+<pre class="indented">
+<em class=def id="transformsample">transform-sample</em> bin slice snd chn
+</pre>
+
+<p>This is the current value of the transform (if any) in 'bin' and (if a
sonogram or spectrogram) 'slice' in the given channel.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- transform-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformsize">transform-size</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the fft size (the default size is 512). It should be a power of 2.
+<pre class="indented">
+<em class=def id="transformsize">transform-size</em> snd chn
+</pre>
+
+<p>This is the fft size (the default size is 512). It should be a power of 2.
If your version of Snd was built with FFTW, and you set transform-size
too large (on my machine, with 2 GBytes of memory,
-<code>(expt 2 26)</code> is apparently too large), FFTW exits Snd! There is currently
+(expt 2 26) is apparently too large), FFTW exits Snd! There is currently
no way to trap the error. Also, FFTW assumes the fft size is a (signed) int — 2^30 is probably
the transform-size limit.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- transform-type -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformtype">transform-type</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the spectrum transform type (the default is <code>fourier-transform</code>).
-<pre>
- fourier-transform wavelet-transform haar-transform
- autocorrelation walsh-transform cepstrum
+<pre class="indented">
+<em class=def id="transformtype">transform-type</em> snd chn
+</pre>
+
+<p>This is the spectrum transform type (the default is fourier-transform).
+</p>
+
+<pre class="indented">
+fourier-transform wavelet-transform haar-transform
+autocorrelation walsh-transform cepstrum
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- transform->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformtovct">transform->vct</a> <em class=narg>snd chn v</em></code>
-</td></tr><tr><td></td><td>
-This returns a vct with the transform data from the given channel.
+<pre class="indented">
+<em class=def id="transformtovct">transform->vct</em> snd chn v
+</pre>
+
+<p>This returns a vct with the transform data from the given channel.
If 'v' (a vct) is provided, it is filled, rather than creating a new vct.
See <a href="#fftpeak">fft-peak</a> for an example.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
+
+<!-- undo -->
+<pre class="indented">
+<em class=def id="undo">undo</em> edits snd chn
+</pre>
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="undo">undo</a> <em class=narg>edits snd chn</em></code>
-</td></tr><tr><td></td><td>
-This undoes 'edits' edits (the default is 1) in the given channel.
-Undo follows the <a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> field if it
+<p id="undochannel">This undoes 'edits' edits (the default is 1) in the given channel.
+Undo follows the <a class=quiet href="#sync">sync</a> field if it
is not 0. The following might be a more reasonable undo function:
-<br>
-<pre>
-(define* (<a name="undochannel">undo-channel</a> (<a class=quiet href="#edits" onmouseout="UnTip()" onmouseover="Tip(extsnd_edits_tip)">edits</a> 1) snd chn)
- (if (and snd (not (= (<a class=quiet href="#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> snd) 0)) chn)
- (set! (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> snd chn)
- (max 0 (- (<a class=quiet href="#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a> snd chn) edits)))
+</p>
+
+<pre class="indented">
+(define* (undo-channel (<a class=quiet href="#edits">edits</a> 1) snd chn)
+ (if (and snd (not (= (<a class=quiet href="#sync">sync</a> snd) 0)) chn)
+ (set! (<a class=quiet href="#editposition">edit-position</a> snd chn)
+ (max 0 (- (<a class=quiet href="#editposition">edit-position</a> snd chn) edits)))
(<em class=red>undo</em> edits snd)))
</pre>
-See also <a href="#undohook">undo-hook</a>.
+<p id="undoexamples">See also <a href="#undohook">undo-hook</a>.
Since redo collides with Ruby, forcing me to change its name to redo_edit,
-undo can also be accessed under the name undo_edit (in Scheme, <a name="undoedit">undo-edit</a>).
+undo can also be accessed under the name undo_edit (in Scheme, undo-edit).
+</p>
<!-- INDEX undoexamples:Undo and Redo -->
-<A NAME="undoexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<small><blockquote>
-undo all edits: <a href="#revertsound">revert-sound</a><br>
-specialize undo: <a href="#undohook">undo-hook</a><br>
-protect against undo: <a href="#edithook">edit-hook</a><br>
-redo edit: <a href="#redo">redo</a> and <a href="#redochannel">redo-channel</a><br>
-move around in edit list: <a href="#editposition">edit-position</a> and <a href="#currenteditposition">current-edit-position</a><br>
-About edit lists: <a href="#editlists">Edit lists</a><br><br>
-</blockquote></small>
-
+<TABLE class="method">
+<tr><th class="title">Undo</th></tr><tr><td>
+<blockquote><small>
+undo edit: <a href="extsnd.html#undo">undo</a> and <a href="extsnd.html#undochannel">undo-channel</a><br>
+undo all edits: <a href="extsnd.html#revertsound">revert-sound</a><br>
+specialize undo: <a href="extsnd.html#undohook">undo-hook</a><br>
+protect against undo: <a href="extsnd.html#edithook">edit-hook</a><br>
+redo edit: <a href="extsnd.html#redo">redo</a> and <a href="extsnd.html#redochannel">redo-channel</a><br>
+move around in edit list: <a href="extsnd.html#editposition">edit-position</a> and <a href="extsnd.html#currenteditposition">current-edit-position</a><br>
+About edit lists: <a href="extsnd.html#editlists">Edit lists</a>
+</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
+
<!-- update-lisp-graph -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="updatelispgraph">update-lisp-graph</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This forces Snd to redisplay 'chn's' lisp graph. See <a href="sndscm.html#enveddoc">enved.scm</a> which uses the lisp graph as a local envelope editor.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="updatelispgraph">update-lisp-graph</em> snd chn
+</pre>
+
+<p>This forces Snd to redisplay 'chn's' lisp graph. See <a href="sndscm.html#enveddoc">enved.scm</a> which uses the lisp graph as a local envelope editor.
+</p>
+<div class="separator"></div>
<!-- update-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="updatesound">update-sound</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This causes Snd to update 'snd' (it re-reads the data from disk, flushing any pending edits). In some cases (primarily involving
+<pre class="indented">
+<em class=def id="updatesound">update-sound</em> snd
+</pre>
+
+<p>This causes Snd to update 'snd' (it re-reads the data from disk, flushing any pending edits). In some cases (primarily involving
a change in the number of channels), update-sound can change the index of the sound referred to by 'snd'.
See <a href="#updatehook">update-hook</a> for a way to deal with the index confusion.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- update-time-graph -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="updatetimegraph">update-time-graph</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This forces Snd to redisplay 'chn's' time domain graph. See color-samples in draw.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="updatetimegraph">update-time-graph</em> snd chn
+</pre>
+
+<p>This forces Snd to redisplay 'chn's' time domain graph. See color-samples in draw.scm.
+</p>
+<div class="separator"></div>
<!-- update-transform-graph -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="updatetransformgraph">update-transform-graph</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This forces Snd to redisplay 'chn's' fft graph. For historical reasons, it also forces the current transform to completion.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="updatetransformgraph">update-transform-graph</em> snd chn
+</pre>
+
+<p>This forces Snd to redisplay 'chn's' fft graph. For historical reasons, it also forces the current transform to completion.
+</p>
+<div class="separator"></div>
<!-- variable-graph? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="variablegraphp">variable-graph?</a> index</code>
-</td></tr><tr><td></td><td>
-This returns #t if 'index' refers to a variable graph (see <a href="#makevariablegraph" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/vardpy.png\' width=\'250\' height=\'250\'>', TITLE, 'make-variable-display in snd-motif', ABOVE, true)">make-variable-graph</a>).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="variablegraphp">variable-graph?</em> index
+</pre>
+
+<p>This returns #t if 'index' refers to a variable graph (see <a href="#makevariablegraph">make-variable-graph</a>).
+</p>
+<div class="separator"></div>
<!-- view-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="viewsound">view-sound</a> filename</code>
-</td></tr><tr><td></td><td>
-This opens 'filename' read-only (you can edit the sound within Snd, but you can't overwrite the original sound).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="viewsound">view-sound</em> filename
+</pre>
+
+<p>This opens 'filename' read-only (you can edit the sound within Snd, but you can't overwrite the original sound).
+</p>
+<div class="separator"></div>
<!-- wavelet-type -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="wavelettype">wavelet-type</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If <a href="#transformtype">transform-type</a> is <code>wavelet-transform</code>, wavelet-type selects which
+<pre class="indented">
+<em class=def id="wavelettype">wavelet-type</em> snd chn
+</pre>
+
+<p>If <a href="#transformtype">transform-type</a> is wavelet-transform, wavelet-type selects which
wavelet is used. The list of available wavelets is in the Transform
Dialog. There are around 48 choices, so this variable goes from
0 to 47 (the default is 0).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- wavo-hop -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="wavohop">wavo-hop</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This sets the distance upward (in pixels) between wavogram traces; that is,
+<pre class="indented">
+<em class=def id="wavohop">wavo-hop</em> snd chn
+</pre>
+
+<p>This sets the distance upward (in pixels) between wavogram traces; that is,
the smaller this number, the more traces can be displayed (the default is 3). See <a href="#timegraphtype">time-graph-type</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- wavo-trace -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="wavotrace">wavo-trace</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This sets the length (in samples) of each wavogram trace (the default is 64). See <a href="#timegraphtype">time-graph-type</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="wavotrace">wavo-trace</em> snd chn
+</pre>
+
+<p>This sets the length (in samples) of each wavogram trace (the default is 64). See <a href="#timegraphtype">time-graph-type</a>.
+</p>
+<div class="separator"></div>
<!-- with-verbose-cursor -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="withverbosecursor">with-verbose-cursor</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-If with-verbose-cursor is #t, the cursor's position and other information is constantly
-displayed in the minibuffer. This is the View:Verbose cursor option
+<pre class="indented">
+<em class=def id="withverbosecursor">with-verbose-cursor</em> snd chn
+</pre>
+
+<p>If with-verbose-cursor is #t, the cursor's position and other information is constantly
+displayed in the status area. This is the View:Verbose cursor option
(default: #f).
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- x-axis-label -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="xaxislabel">x-axis-label</a> <em class=narg>snd chn context</em></code>
-</td></tr><tr><td></td><td>
-This is the current x axis label. 'context' is one of <code>time-graph</code> (the default), <code>lisp-graph</code>, or
-<code>transform-graph</code>.
-<pre>
- :<em class=typing>(x-axis-label)</em>
- <em class=listener>"time"</em>
- :<em class=typing>(set! (x-axis-label) "tempus")</em>
- <em class=listener>"tempus"</em>
+<pre class="indented">
+<em class=def id="xaxislabel">x-axis-label</em> snd chn context
+</pre>
+
+<p>This is the current x axis label. 'context' is one of time-graph (the default), lisp-graph, or
+transform-graph.
+</p>
+
+<pre class="indented">
+> (x-axis-label)
+"time"
+> (set! (x-axis-label) "tempus")
+"tempus"
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- x-axis-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="xaxisstyle">x-axis-style</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-x-axis-style is the View menu 'X-axis units' option (the default value is <code>x-axis-in-seconds</code>).
+<pre class="indented">
+<em class=def id="xaxisstyle">x-axis-style</em> snd chn
+</pre>
+
+<p>x-axis-style is the View menu 'X-axis units' option (the default value is x-axis-in-seconds).
The x axis labelling of the time domain waveform can be in seconds
-(<code>x-axis-in-seconds</code>), in samples (<code>x-axis-in-samples</code>), expressed
-as a percentage of the overall duration (<code>x-axis-as-percentage</code>, useful in envelope definitions), as a beat number (<code>x-axis-in-beats</code>),
-as a measure number (<code>x-axis-in-measures</code>), or in digital clock format (DD:HH:MM:SS.ddd) (<code>x-axis-as-clock</code>, useful in
+(x-axis-in-seconds), in samples (x-axis-in-samples), expressed
+as a percentage of the overall duration (x-axis-as-percentage, useful in envelope definitions), as a beat number (x-axis-in-beats),
+as a measure number (x-axis-in-measures), or in digital clock format (DD:HH:MM:SS.ddd) (x-axis-as-clock, useful in
very large files).
When the x axis labelling is in measures, the label has the form M(B)F or M(B) where M is the one-based
measure number (that is, the first measure, at time 0.0, is measure 1), B is the one-based beat number
within that measure, and F (if present) is the location within that beat on a scale of 0.0 to 1.0.
If a major tick marks a measure beginning, and there are non-measure minor ticks, then the measure
is distinguished from the beat by having a longer tick mark.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- x-bounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="xbounds">x-bounds</a> <em class=narg>snd chn axis</em></code>
-</td></tr><tr><td></td><td>
-This returns <code>(list x0 x1)</code>, the current x axis bounds in seconds. To display the entire sound:
-<pre>
- (set! (x-bounds) (/ (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>)))
+<pre class="indented">
+<em class=def id="xbounds">x-bounds</em> snd chn axis
+</pre>
+
+<p>This returns (list x0 x1), the current x axis bounds in seconds. To display the entire sound:
+</p>
+
+<pre class="indented">
+(set! (x-bounds) (/ (<a class=quiet href="#framples">framples</a>) (<a class=quiet href="#srate">srate</a>)))
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- x->position -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="xtoposition">x->position</a> x <em class=narg>snd chn axis</em></code>
-</td></tr><tr><td></td><td>
-This returns the graph (screen pixel) position that corresponds to the x axis value 'x'.
-'axis' is one of <code>time-graph</code> (the default), <code>lisp-graph</code>, or <code>transform-graph</code>.
+<pre class="indented">
+<em class=def id="xtoposition">x->position</em> x snd chn axis
+</pre>
+
+<p>This returns the graph (screen pixel) position that corresponds to the x axis value 'x'.
+'axis' is one of time-graph (the default), lisp-graph, or transform-graph.
See draw.scm for an example.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- x-position-slider -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="xpositionslider">x-position-slider</a> <em class=narg>snd chn</em></code>
-</td></tr>
-<tr><td></td><td>
+<pre class="indented">
+<em class=def id="xpositionslider">x-position-slider</em> snd chn
+</pre>
+
+<p>
This is the value of x axis position slider. See zoom-fft in examp.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- x-zoom-slider -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="xzoomslider">x-zoom-slider</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the value of x axis zoom slider. See <a href="#zoomonepixel">zoom-one-pixel</a>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="xzoomslider">x-zoom-slider</em> snd chn
+</pre>
+
+<p>This is the value of x axis zoom slider. See <a href="#zoomonepixel">zoom-one-pixel</a>.
+</p>
+<div class="separator"></div>
<!-- xramp-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="xrampchannel">xramp-channel</a> rmp0 rmp1 <em class=narg>base beg dur snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-xramp-channel is a slight extension of <a href="#rampchannel">ramp-channel</a>. It scales samples in the given sound/channel
+<pre class="indented">
+<em class=def id="xrampchannel">xramp-channel</em> rmp0 rmp1 base beg dur snd chn edpos
+</pre>
+
+<p>xramp-channel is a slight extension of <a href="#rampchannel">ramp-channel</a>. It scales samples in the given sound/channel
between 'beg' and 'beg' + 'dur' by an exponential ramp going from 'rmp0' to 'rmp1' with the connecting segment curvature
set by 'base'.
-<pre>
- (xramp-channel 0.0 1.0 32.0)
+</p>
+
+<pre class="indented">
+(xramp-channel 0.0 1.0 32.0)
</pre>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<div class="separator"></div>
<!-- y-axis-label -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="yaxislabel">y-axis-label</a> <em class=narg>snd chn context</em></code>
-</td></tr><tr><td></td><td>
-This is the current y axis label. 'context' is one of <code>time-graph</code> (the default), <code>lisp-graph</code>, or <code>transform-graph</code>.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="yaxislabel">y-axis-label</em> snd chn context
+</pre>
+
+<p>This is the current y axis label. 'context' is one of time-graph (the default), lisp-graph, or transform-graph.
+</p>
+<div class="separator"></div>
<!-- y-bounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="ybounds">y-bounds</a> <em class=narg>snd chn axis</em></code>
-</td></tr><tr><td></td><td>
-This returns <code>(list y0 y1)</code>, the current y axis bounds.
-To set the bounds to reflect the channel's maxamp, use <code>(set! (y-bounds) '())</code>.
+<pre class="indented">
+<em class=def id="ybounds">y-bounds</em> snd chn axis
+</pre>
+
+<p>This returns (list y0 y1), the current y axis bounds.
+To set the bounds to reflect the channel's maxamp, use (set! (y-bounds) ()).
To set all channels at once using the selected sound's maxamp:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(let ((maxval (apply max (<a class=quiet href="#maxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_maxamp_tip)">maxamp</a> #f #t))))
- (do ((i 0 (+ 1 i)))
- ((= i (<a class=quiet href="#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a>)))
+<pre class="indented">
+(let ((maxval (apply max (<a class=quiet href="#maxamp">maxamp</a> #f #t))))
+ (do ((i 0 (+ i 1)))
+ ((= i (<a class=quiet href="#chans">channels</a>)))
(set! (<em class=red>y-bounds</em> #f i) (list (- maxval) maxval))))
-</pre></td></tr></table>
+</pre>
-Or to set each channel to its own maxamp:
+<p>Or to set each channel to its own maxamp:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(do ((i 0 (+ 1 i)))
- ((= i (<a class=quiet href="#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a>)))
- (let ((maxval (<a class=quiet href="#maxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_maxamp_tip)">maxamp</a> #f i)))
+<pre class="indented">
+(do ((i 0 (+ i 1)))
+ ((= i (<a class=quiet href="#chans">channels</a>)))
+ (let ((maxval (<a class=quiet href="#maxamp">maxamp</a> #f i)))
(set! (<em class=red>y-bounds</em> #f i) (list (- maxval) maxval))))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</pre>
+<div class="separator"></div>
<!-- y->position -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="ytoposition">y->position</a> y <em class=narg>snd chn axis</em></code>
-</td></tr><tr><td></td><td>
-This returns the graph (screen pixel) position that corresponds to the y axis value 'y'.
-'axis' is one of <code>time-graph</code> (the default), <code>lisp-graph</code>, or <code>transform-graph</code>.
+<pre class="indented">
+<em class=def id="ytoposition">y->position</em> y snd chn axis
+</pre>
+
+<p>This returns the graph (screen pixel) position that corresponds to the y axis value 'y'.
+'axis' is one of time-graph (the default), lisp-graph, or transform-graph.
This is used in samples-via-colormap in draw.scm to draw the time domain samples in many colors.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+</p>
+<div class="separator"></div>
<!-- y-position-slider -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="ypositionslider">y-position-slider</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the value of y axis position slider. See zync in snd-motif.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="ypositionslider">y-position-slider</em> snd chn
+</pre>
+
+<p>This is the value of y axis position slider. See zync in snd-motif.scm.
+</p>
+<div class="separator"></div>
<!-- y-zoom-slider -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="yzoomslider">y-zoom-slider</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This is the value of y axis zoom slider. See <a href="#xdisplayenergy">display-energy</a>, or zync in snd-motif.scm.
-</td></tr><tr><td colspan=2 height=18></td></tr>
+<pre class="indented">
+<em class=def id="yzoomslider">y-zoom-slider</em> snd chn
+</pre>
+
+<p>This is the value of y axis zoom slider. See <a href="#xdisplayenergy">display-energy</a>, or zync in snd-motif.scm.
+</p>
+<div class="separator"></div>
<!-- zero-pad -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="zeropad">zero-pad</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-zero-pad is the fft zero pad size as a multiple of the fft size; <code>(set! (zero-pad) 1)</code>
+<pre class="indented">
+<em class=def id="zeropad">zero-pad</em> snd chn
+</pre>
+
+<p>zero-pad is the fft zero pad size as a multiple of the fft size; (set! (zero-pad) 1)
gives you half data, half zeros (the default value is 0). The data length is
determined by the nominal transform-size. Zero padding causes interpolation
of the fft points, making the display look smoother.
+</p>
-<table cellpadding=5><tr><td>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> (char->integer #\p) 0
+<pre class="indented">
+(<a class=quiet href="#bindkey">bind-key</a> (char->integer #\p) 0
(lambda ()
- "increase zero-pad"
(set! (zero-pad) (+ (<em class=red>zero-pad</em>) 1))
- (<a class=quiet href="#updatetransformgraph" onmouseout="UnTip()" onmouseover="Tip(extsnd_updatetransformgraph_tip)">update-transform-graph</a>)))
+ (<a class=quiet href="#updatetransformgraph">update-transform-graph</a>)))
-(<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> (char->integer #\m) 0
+(<a class=quiet href="#bindkey">bind-key</a> (char->integer #\m) 0
(lambda ()
- "decrease zero-pad"
(set! (zero-pad) (- (<em class=red>zero-pad</em>) 1))
- (<a class=quiet href="#updatetransformgraph" onmouseout="UnTip()" onmouseover="Tip(extsnd_updatetransformgraph_tip)">update-transform-graph</a>)))
-</pre></td></tr></table>
-</td><td>
-<img src="pix/pad1.png" alt="more pads"></td>
-</tr></table>
+ (<a class=quiet href="#updatetransformgraph">update-transform-graph</a>)))
+</pre>
-</td></tr>
+<img class="indented" src="pix/pad1.png" alt="more pads">
-</table><!-- end of main sound/channel table -->
-<br><br>
-<table width="35%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="customcontrols">the control panel</a></h4></td></tr></table>
+
+
+<div class="innerheader" id="customcontrols">the control panel</div>
+
<p>The control panel makes it easy to try out various sound effects without
editing anything. You can change volume ('amp'), pitch ('speed'), tempo
('expand'), reverb amount ('reverb'), simulated room size ('reverb len'),
@@ -10122,6 +10414,7 @@ brightness ('contrast'), and dullness ('filter'). To treat a current
setting as an edit operation, call <a href="#applycontrols">apply-controls</a>. For more on
the effects themselves (and a pretty picture!), see the discussion in <a href="snd.html#controls">snd.html</a>.
</p>
+
<p>
The control panel normally processes samples as follows: if the sampling
rate conversion is on (the 'Speed' control is not 1.0), it applies srate
@@ -10134,401 +10427,484 @@ passed to the reverb, if any, which adds its result to the sample;
the final result is sent to the speakers.
The control panel procedures are:
</p>
-<!-- -------------------------------- CONTROL PANEL -------------------------------- -->
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
+<div class="spacer"></div>
+<!-- CONTROL PANEL -->
<!-- amp-control -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="ampcontrol">amp-control</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td width=30><br></td><td>
-The current amp value.
+<pre class="indented">
+<em class=def id="ampcontrol">amp-control</em> snd chn
+</pre>
+
+<p>The current amp value.
It is possible to use these controls (in "real-time") in your own functions.
See amprt in <a href="sndscm.html#exampdoc">examp.scm</a> for an example,
or add-amp-control in snd-motif.scm.
As an experiment, I added the optional 'chn' argument; if it is specified, the
channel's local amp-control value is set instead of the sound's. This affects
-<a class=quiet href="#applycontrols" onmouseout="UnTip()" onmouseover="Tip(extsnd_applycontrols_tip)">apply-controls</a> and playback.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<a class=quiet href="#applycontrols">apply-controls</a> and playback.
+</p>
+<div class="spacer"></div>
<!-- amp-control-bounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="ampcontrolbounds">amp-control-bounds</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The amp-control min and max amounts as a list. The default is
+<pre class="indented">
+<em class=def id="ampcontrolbounds">amp-control-bounds</em> snd
+</pre>
+
+<p>The amp-control min and max amounts as a list. The default is
(list 0.0 8.0). The value 1.0 should be in the given range, since it is placed in the middle of the slider's range.
-If no 'snd' argument is given, this also affects the Mix, View:Files, and Record dialogs.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+If no 'snd' argument is given, this also affects the Mix and View:Files dialogs.
+</p>
+<div class="spacer"></div>
<!-- apply-controls -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="applycontrols">apply-controls</a> <em class=narg>snd target beg dur</em></code>
-</td></tr><tr><td></td><td>
-Apply the current control panel state as an edit.
+<pre class="indented">
+<em class=def id="applycontrols">apply-controls</em> snd target beg dur
+</pre>
+
+<p>Apply the current control panel state as an edit.
'target' can be 0=sound, 1=channel, 2=selection.
-'beg' sets where in samples the apply starts: <code>(apply-controls 0 0 (<a class=quiet href="#marksample" onmouseout="UnTip()" onmouseover="Tip(extsnd_marksample_tip)">mark-sample</a> m))</code> starts from the given mark.
+'beg' sets where in samples the apply starts: (apply-controls 0 0 (<a class=quiet href="#marksample">mark-sample</a> m)) starts from the given mark.
'dur', if given, sets how many samples to run through the apply process (the input duration).
apply-controls can be used in conjunction with the various control panel variables:
+</p>
-<table border=0 vspace=10><tr><td>
-<table border=0 cellpadding=5><tr><td><pre>
-(define expnd
- (lambda (amt)
- (set! (<a class=quiet href="#expandcontrolp" onmouseout="UnTip()" onmouseover="Tip(extsnd_expandcontrolp_tip)">expand-control?</a>) #t)
- (set! (<a class=quiet href="#expandcontrol" onmouseout="UnTip()" onmouseover="Tip(extsnd_expandcontrol_tip)">expand-control</a>) amt)
- (<em class=red>apply-controls</em>)))
-</pre></td></tr></table>
-
-</td><td width=20>
-</td><td>
-<table border=0 cellpadding=5><tr><td bgcolor="Beige"><pre>
+<table>
+<tr><td>
+<div class="scheme">
+<pre class="indented">
+(define (expnd amt)
+ (set! (<a class=quiet href="#expandcontrolp">expand-control?</a>) #t)
+ (set! (<a class=quiet href="#expandcontrol">expand-control</a>) amt)
+ (<em class=red>apply-controls</em>))
+</pre>
+</div>
+</td></tr>
+<tr><td>
+<div class="ruby">
+<pre class="indented">
def expnd(amt)
set_expand_control? true
set_expand_control amt
apply_controls
end
-</pre></td></tr></table>
-
-</td><td width=20>
-</td><td>
-<table border=0 cellpadding=5><tr><td bgcolor="LightGreen"><pre>
+</pre>
+</div>
+</td></tr>
+<tr><td>
+<div class="forth">
+<pre class="indented">
: expnd ( amt -- ) { amt }
#t set-expand-control? drop
amt set-expand-control drop
apply-controls
;
-</pre></td></tr></table>
+</pre>
+</div>
</td></tr></table>
-For many examples see new-effects.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>For many examples see new-effects.scm.
+</p>
+<div class="spacer"></div>
<!-- controls->channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="controlstochannel">controls->channel</a> <em class=narg>settings beg dur snd chn origin</em></code>
-</td></tr><tr><td></td><td>
-This sets up the sound's controls to reflect 'settings' (unspecified settings are not changed), then applies the controls as
+<pre class="indented">
+<em class=def id="controlstochannel">controls->channel</em> settings beg dur snd chn origin
+</pre>
+
+<p>This sets up the sound's controls to reflect 'settings' (unspecified settings are not changed), then applies the controls as
an edit of channel 'chn'. The 'settings' argument is a list where each entry can also be #f or an empty list:
-<pre>
- (list amp speed
- (list contrast contrast_amp)
- (list expand expand_length expand_ramp expand_hop expand_jitter)
- (list reverb_scale reverb_length reverb_feedback reverb_low_pass reverb_decay)
- (list filter_order filter_env))
+</p>
+
+<pre class="indented">
+(list amp speed
+ (list contrast contrast_amp)
+ (list expand expand_length expand_ramp expand_hop expand_jitter)
+ (list reverb_scale reverb_length reverb_feedback reverb_low_pass reverb_decay)
+ (list filter_order filter_env))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- contrast-control -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="contrastcontrol">contrast-control</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#contrast">contrast</a> amount.
+<pre class="indented">
+<em class=def id="contrastcontrol">contrast-control</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#contrast">contrast</a> amount.
The <a href="sndclm.html#contrast-enhancement">contrast-enhancement</a> algorithm treats this variable as a kind of modulation index (the higher, the brighter),
whereas contrast-control-amp below prescales the in-coming signal to be closer to -1.0 to 1.0
(the brightening effect works best if it has a full amplitude signal to work with).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- contrast-control-amp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="contrastcontrolamp">contrast-control-amp</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#contrast">contrast-control-amp</a> (a prescaler on the contrast-enhancement to get the
+<pre class="indented">
+<em class=def id="contrastcontrolamp">contrast-control-amp</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#contrast">contrast-control-amp</a> (a prescaler on the contrast-enhancement to get the
full effect of the compander).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- contrast-control-bounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="contrastcontrolbounds">contrast-control-bounds</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The contrast-control min and max amounts as a list. The default is
+<pre class="indented">
+<em class=def id="contrastcontrolbounds">contrast-control-bounds</em> snd
+</pre>
+
+<p>The contrast-control min and max amounts as a list. The default is
(list 0.0 10.0).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- contrast-control? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="contrastcontrolp">contrast-control?</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-#t if the <a class=quiet href="snd.html#contrast">contrast</a> button is set (i.e. the contrast compander is active).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="contrastcontrolp">contrast-control?</em> snd
+</pre>
+
+<p>#t if the <a class=quiet href="snd.html#contrast">contrast</a> button is set (i.e. the contrast compander is active).
+</p>
+<div class="spacer"></div>
<!-- expand-control -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="expandcontrol">expand-control</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#expand">expansion</a> amount. This sets the ratio between the
+<pre class="indented">
+<em class=def id="expandcontrol">expand-control</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#expand">expansion</a> amount. This sets the ratio between the
output and input grain spacing. If it is greater than 1.0, the result is longer.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- expand-control-bounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="expandcontrolbounds">expand-control-bounds</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The expand-control min and max amounts as a list. The default is
+<pre class="indented">
+<em class=def id="expandcontrolbounds">expand-control-bounds</em> snd
+</pre>
+
+<p>The expand-control min and max amounts as a list. The default is
(list 0.001 20.0).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- expand-control-hop -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="expandcontrolhop">expand-control-hop</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#expand">expansion</a> hop amount in seconds (the distance between successive grains).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="expandcontrolhop">expand-control-hop</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#expand">expansion</a> hop amount in seconds (the distance between successive grains).
+</p>
+<div class="spacer"></div>
<!-- expand-control-jitter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="expandcontroljitter">expand-control-jitter</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#expand">expansion</a> grain timing jitter. This defaults to .1; if you set it
+<pre class="indented">
+<em class=def id="expandcontroljitter">expand-control-jitter</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#expand">expansion</a> grain timing jitter. This defaults to .1; if you set it
to too small a number (0.0 for example), you'll probably notice (presumably unwanted) notch-filter effects.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- expand-control-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="expandcontrollength">expand-control-length</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#expand">expansion</a> segment (grain) length in seconds. The longer the grain,
+<pre class="indented">
+<em class=def id="expandcontrollength">expand-control-length</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#expand">expansion</a> segment (grain) length in seconds. The longer the grain,
the more reverberated or slurred the effect.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- expand-control-ramp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="expandcontrolramp">expand-control-ramp</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#expand">expansion</a> ramp amount (between 0 and .5).
+<pre class="indented">
+<em class=def id="expandcontrolramp">expand-control-ramp</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#expand">expansion</a> ramp amount (between 0 and .5).
This affects the smoothness of the grain overlaps — .001 gives a
rattling effect.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- expand-control? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="expandcontrolp">expand-control?</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-#t if the expand button is set (i.e. the expansion effect is active).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="expandcontrolp">expand-control?</em> snd
+</pre>
+
+<p>#t if the expand button is set (i.e. the expansion effect is active).
+</p>
+<div class="spacer"></div>
<!-- filter-control-coeffs -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filtercontrolcoeffs">filter-control-coeffs</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#filtercontrol">filter</a> coefficients (read-only currently). It is
+<pre class="indented">
+<em class=def id="filtercontrolcoeffs">filter-control-coeffs</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#filtercontrol">filter</a> coefficients (read-only currently). It is
a vct suitable for use with the <a href="sndclm.html#filter">filter generator</a> or with
<a href="#filtersound">filter-sound</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- filter-control-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filtercontrolenvelope">filter-control-envelope</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#filtercontrol">filter</a> (frequency reponse) envelope (a list of breakpoints).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="filtercontrolenvelope">filter-control-envelope</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#filtercontrol">filter</a> (frequency reponse) envelope (a list of breakpoints).
+</p>
+<div class="spacer"></div>
<!-- filter-control-in-dB -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filtercontrolindB">filter-control-in-dB</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#filtercontrol">filter</a> dB button. If #t, the filter (frequency) envelope
+<pre class="indented">
+<em class=def id="filtercontrolindB">filter-control-in-dB</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#filtercontrol">filter</a> dB button. If #t, the filter (frequency) envelope
graph is displayed in dB.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- filter-control-in-hz -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filtercontrolinhz">filter-control-in-hz</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-If #t, the filter frequency response envelope x axis is in Hz, otherwise 0 to 1.0 (where 1.0 corresponds to srate/2).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="filtercontrolinhz">filter-control-in-hz</em> snd
+</pre>
+
+<p>If #t, the filter frequency response envelope x axis is in Hz, otherwise 0 to 1.0 (where 1.0 corresponds to srate/2).
+</p>
+<div class="spacer"></div>
<!-- filter-control-order -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filtercontrolorder">filter-control-order</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#filtercontrol">filter</a> order. This affects how much computing
+<pre class="indented">
+<em class=def id="filtercontrolorder">filter-control-order</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#filtercontrol">filter</a> order. This affects how much computing
is needed to run the filter, and how close the filter can get to the desired frequency response envelope.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- filter-control-waveform-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filterwaveformcolor">filter-control-waveform-color</a></code>
-</td></tr><tr><td></td><td>
-The filter frequency response waveform color.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="filterwaveformcolor">filter-control-waveform-color</em>
+</pre>
+
+<p>The filter frequency response waveform color.
+</p>
+<div class="spacer"></div>
<!-- filter-control? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="filtercontrolp">filter-control?</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-#t if the filter button is set (i.e. the filter is active).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="filtercontrolp">filter-control?</em> snd
+</pre>
+
+<p>#t if the filter button is set (i.e. the filter is active).
+</p>
+<div class="spacer"></div>
<!-- reset-controls -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="resetcontrols">reset-controls</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-Set all the controls to their default state.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="resetcontrols">reset-controls</em> snd
+</pre>
+
+<p>Set all the controls to their default state.
+</p>
+<div class="spacer"></div>
<!-- restore-controls -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="restorecontrols">restore-controls</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-Set all the
+<pre class="indented">
+<em class=def id="restorecontrols">restore-controls</em> snd
+</pre>
+
+<p>Set all the
controls to the last saved state.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- reverb-control-decay -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reverbdecay">reverb-control-decay</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The length (in seconds) of the reverberation after the sound has
+<pre class="indented">
+<em class=def id="reverbdecay">reverb-control-decay</em> snd
+</pre>
+
+<p>The length (in seconds) of the reverberation after the sound has
finished (default: 1.0).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- reverb-control-feedback -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reverbcontrolfeedback">reverb-control-feedback</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The reverb feedback coefficient. The more feedback, the happier Elvis.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="reverbcontrolfeedback">reverb-control-feedback</em> snd
+</pre>
+
+<p>The reverb feedback coefficient. The more feedback, the happier Elvis.
+</p>
+<div class="spacer"></div>
<!-- reverb-control-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reverbcontrollength">reverb-control-length</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#reverb">reverb</a> delay line length scaler. Longer reverb simulates, to some
+<pre class="indented">
+<em class=def id="reverbcontrollength">reverb-control-length</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#reverb">reverb</a> delay line length scaler. Longer reverb simulates, to some
extent, a bigger hall.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- reverb-control-length-bounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reverbcontrollengthbounds">reverb-control-length-bounds</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The reverb-control-length min and max amounts as a list. The default is
+<pre class="indented">
+<em class=def id="reverbcontrollengthbounds">reverb-control-length-bounds</em> snd
+</pre>
+
+<p>The reverb-control-length min and max amounts as a list. The default is
(list 0.0 5.0).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- reverb-control-lowpass -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reverbcontrollowpass">reverb-control-lowpass</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The reverb low pass filter coefficient. (This filter is in the feedback loop).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="reverbcontrollowpass">reverb-control-lowpass</em> snd
+</pre>
+
+<p>The reverb low pass filter coefficient. (This filter is in the feedback loop).
+</p>
+<div class="spacer"></div>
<!-- reverb-control-scale -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reverbcontrolscale">reverb-control-scale</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The <a class=quiet href="snd.html#reverb">reverb</a> amount (the amount of the direct signal sent to the reverb).
+<pre class="indented">
+<em class=def id="reverbcontrolscale">reverb-control-scale</em> snd
+</pre>
+
+<p>The <a class=quiet href="snd.html#reverb">reverb</a> amount (the amount of the direct signal sent to the reverb).
You can never have enough reverb.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- reverb-control-scale-bounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reverbcontrolscalebounds">reverb-control-scale-bounds</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The reverb-control-scale min and max amounts as a list. The default is
+<pre class="indented">
+<em class=def id="reverbcontrolscalebounds">reverb-control-scale-bounds</em> snd
+</pre>
+
+<p>The reverb-control-scale min and max amounts as a list. The default is
(list 0.0 4.0).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- reverb-control? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="reverbcontrolp">reverb-control?</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-#t if the reverb button is set (i.e. the reverberator is active).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="reverbcontrolp">reverb-control?</em> snd
+</pre>
+
+<p>#t if the reverb button is set (i.e. the reverberator is active).
+</p>
+<div class="spacer"></div>
<!-- save-controls -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="savecontrols">save-controls</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This remembers the current control
-settings for a later <a class=quiet href="#restorecontrols" onmouseout="UnTip()" onmouseover="Tip(extsnd_restorecontrols_tip)">restore-controls</a>. In new-effects.scm, the effects that use the control panel
+<pre class="indented">
+<em class=def id="savecontrols">save-controls</em> snd
+</pre>
+
+<p>This remembers the current control
+settings for a later <a class=quiet href="#restorecontrols">restore-controls</a>. In new-effects.scm, the effects that use the control panel
internally (post-expsrc-dialog, for example) save and restore the current state via:
-<pre>
- (<em class=red>save-controls</em>)
- (reset-controls)
- ;;; now set the ones that are of interest for the current effect
- (apply-controls)
- (restore-controls)
+</p>
+
+<pre class="indented">
+(<em class=red>save-controls</em>)
+(reset-controls)
+;;; now set the ones that are of interest for the current effect
+(apply-controls)
+(restore-controls)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- show-controls -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="showcontrols">show-controls</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-#t if the sound's control panel is currently open.
+<pre class="indented">
+<em class=def id="showcontrols">show-controls</em> snd
+</pre>
+
+<p>#t if the sound's control panel is currently open.
If set to #t, the sound's control panel is opened, else it is closed.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- speed-control -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="speedcontrol">speed-control</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-current <a class=quiet href="snd.html#speed">speed</a> (sampling rate conversion factor). A speed of 2 plays the sound twice as fast.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="speedcontrol">speed-control</em> snd
+</pre>
+
+<p>current <a class=quiet href="snd.html#speed">speed</a> (sampling rate conversion factor). A speed of 2 plays the sound twice as fast.
+</p>
+<div class="spacer"></div>
<!-- speed-control-bounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="speedcontrolbounds">speed-control-bounds</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The speed-control min and max amounts as a list. The default is
+<pre class="indented">
+<em class=def id="speedcontrolbounds">speed-control-bounds</em> snd
+</pre>
+
+<p>The speed-control min and max amounts as a list. The default is
(list 0.05 20.0).
If no 'snd' argument is given, this also affects the Mix, and View:Files dialogs.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- speed-control-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="speedstyle">speed-control-style</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The speed control can be interpreted as a
-float, (<code>speed-control-as-float</code>, the default), as a ratio
-of relatively small integers (<code>speed-control-as-ratio</code>), or as a step in a
-microtonal scale (<code>speed-control-as-semitone</code>).
+<pre class="indented">
+<em class=def id="speedstyle">speed-control-style</em> snd
+</pre>
+
+<p>The speed control can be interpreted as a
+float, (speed-control-as-float, the default), as a ratio
+of relatively small integers (speed-control-as-ratio), or as a step in a
+microtonal scale (speed-control-as-semitone).
In the various speed controls, you can click the number to cycle through the speed style choices.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- speed-control-tones -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="speedtones">speed-control-tones</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-The number of tones per octave in the <code>speed-control-as-semitone</code> speed
+<pre class="indented">
+<em class=def id="speedtones">speed-control-tones</em> snd
+</pre>
+
+<p>The number of tones per octave in the speed-control-as-semitone speed
style (default: 12).
-</td></tr><tr><td colspan=2 height=16></td></tr>
-</table>
+</p>
+<div class="spacer"></div>
<p>
@@ -10536,19 +10912,21 @@ The Options:Controls menu option
starts a dialog to handle the controls that aren't handled by
the control panel (expand-control-hop, expand-control-length, expand-control-ramp,
contrast-control-amp, reverb-control-lowpass, and reverb-control-feedback).
-The control panel itself is accessible as <code>(list-ref (<a href="#soundwidgets">sound-widgets</a>) 2)</code>.
+The control panel itself is accessible as <code>((<a href="#soundwidgets">sound-widgets</a>) 2)</code>.
You can add or remove controls; <a href="sndscm.html#addampcontrols">add-amp-controls</a>
in snd-motif.scm sets up a separate amp slider for each channel in the current sound.
<a href="sndscm.html#disablecontrolpanel">disable-control-panel</a> disables (hides) the
entire panel.
</p>
-<br>
+
+
+
<!-- INDEX editlists:Edit lists -->
<!-- Edit Lists -->
-<br>
-<table width="35%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="editlists">Edit Lists</a></h4></td></tr></table>
+
+<div class="innerheader" id="editlists">Edit Lists</div>
<p>An edit list (in other editors this is called an "edit decision list", I guess because it sounds decisive)
describes the edit history of a channel. When, for example, you type C-d, nothing actually
@@ -10559,227 +10937,247 @@ pointer to the current edit history position); all the positions are accessible
one, and are exposed in many functions described above via the 'pos' or 'edpos' arguments.
The edit list functions are:
</p>
+<div class="spacer"></div>
-
-<!-- -------------------------------- EDIT-LIST TABLE -------------------------------- -->
-
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
+<!-- EDIT-LIST TABLE -->
<!-- as-one-edit -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="asoneedit">as-one-edit</a> func <em class=narg>origin</em></code>
-</td></tr><tr><td width=30></td><td>
-call 'func', a function of no arguments, treating it as
+<pre class="indented">
+<em class=def id="asoneedit">as-one-edit</em> func origin
+</pre>
+
+<p>call 'func', a function of no arguments, treating it as
one edit (in all channels) in the edit history mechanism. Graphics redisplays are squelched during as-one-edit.
as-one-edit returns the result of 'func'.
+</p>
-<table border=0 vspace=10><tr><td>
-<table border=0 cellpadding=5><tr><td>
-<pre>
+<table>
+<tr><td>
+<div class="scheme">
+<pre class="indented">
(<em class=red>as-one-edit</em>
(lambda ()
- (set! (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> 100) .1)
- (set! (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> 200) .2)))
+ (set! (<a class=quiet href="#sample">sample</a> 100) .1)
+ (set! (<a class=quiet href="#sample">sample</a> 200) .2)))
</pre>
-</td></tr></table>
-
-</td><td width=20>
-</td><td>
-<table border=0 cellpadding=5><tr><td bgcolor="beige">
-<pre>
+</div>
+</td></tr>
+<tr><td>
+<div class="ruby">
+<pre class="indented">
<em class=red>as_one_edit</em>(lambda do ||
set_sample(100, 0.1)
set_sample(200, 0.2)
end)
</pre>
-</td></tr></table>
-
-</td><td width=20>
-</td><td>
-<table border=0 cellpadding=5><tr><td bgcolor="lightgreen">
-<pre>
+</div>
+</td></tr>
+<tr><td>
+<div class="forth">
+<pre class="indented">
lambda:
100 .1 set-sample drop
200 .2 set-sample drop
; 0 make-proc <em class=red>as-one-edit</em>
</pre>
+</div>
</td></tr></table>
-</td></tr></table>
-
-</td></tr>
-<tr><td></td><td>
-See mix.scm for many examples. If you want to save and restore Snd's state after using as-one-edit, you need to
+<p>See mix.scm for many examples. If you want to save and restore Snd's state after using as-one-edit, you need to
set 'origin' to some string that can restore the effect of the as-one-edit; the default is
to copy the last edit history string and use its associated bounds — unlikely to be what you want.
-</td></tr><tr><td></td><td></td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- display-edits -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="displayedits">display-edits</a> <em class=narg>snd chn edpos with-source</em></code>
-</td></tr><tr><td></td><td>
-This returns the current edit list contents as a string. If 'edpos' is specified, only that position is described.
-'with-source' (default: #t) determines whether ptree source code is included in the output.
-<pre>
- :<em class=typing>(open-sound "oboe.snd")</em>
- <em class=listener>#<sound 0></em>
- :<em class=typing>(scale-channel 2.0)</em>
- <em class=listener>2.0</em>
- :<em class=typing>(pad-channel 100 200)</em>
- <em class=listener>100</em>
- :<em class=typing>(display-edits 0 0 1)</em> ; show just edit 1 (the scale-channel call)
- <em class=listener>"
- (scale 0 50828) ; scale-channel 2.000 0 #f [1:2]:
- (at 0, cp->sounds[0][0:50827, 2.000]) [file: /home/bil/cl/oboe.snd[0]]
- (at 50828, end_mark)
- "</em>
-</pre>
-</td></tr><tr><td></td><td></td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="displayedits">display-edits</em> snd chn edpos
+</pre>
+
+<p>This returns the current edit list contents as a string. If 'edpos' is specified, only that position is described.
+</p>
+
+<pre class="indented">
+> (open-sound "oboe.snd")
+#<sound 0>
+> (scale-channel 2.0)
+2.0
+> (pad-channel 100 200)
+100
+> (display-edits 0 0 1) ; show just edit 1 (the scale-channel call)
+"
+ (scale 0 50828) ; scale-channel 2.000 0 #f [1:2]:
+ (at 0, cp->sounds[0][0:50827, 2.000]) [file: /home/bil/cl/oboe.snd[0]]
+ (at 50828, end_mark)
+"
+</pre>
+<div class="spacer"></div>
<!-- edit-fragment -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="editfragment">edit-fragment</a> <em class=narg>edpos snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns a list similar to that displayed in the edit history window giving
+<pre class="indented">
+<em class=def id="editfragment">edit-fragment</em> edpos snd chn
+</pre>
+
+<p>This returns a list similar to that displayed in the edit history window giving
the origin of the specified edit, its type (delete, insert, etc), its
begin sample, and the number of samples
affected. If 'edpos' is omitted, edit-fragment returns the currently active
edit.
-<pre>
- :<em class=typing>(edit-fragment 2 0 0)</em> ; continuing example above
- <em class=listener>("pad-channel" "zero" 100 200)</em>
+</p>
+
+<pre class="indented">
+> (edit-fragment 2 0 0) ; continuing example above
+("pad-channel" "zero" 100 200)
</pre>
-</td></tr><tr><td></td><td></td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
+
<!-- edit-list->function -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="editlisttofunction">edit-list->function</a> <em class=narg>snd chn start end</em></code>
-</td></tr><tr><td></td><td>
-This returns a function encapsulating the current edit history list, providing a way to save an edit
+<pre class="indented">
+<em class=def id="editlisttofunction">edit-list->function</em> snd chn start end
+</pre>
+
+<p>This returns a function encapsulating the current edit history list, providing a way to save an edit
sequence and re-apply it in some other context. For example, you can back up to some earlier point,
save the edit list, make a change, then re-run the saved edit sequence.
The function returned takes 2 arguments, a sound and a channel number.
-<pre>
- :<em class=typing>(define our-edits (</em><em class=red>edit-list->function</em><em class=typing>))</em> ; same example as above
- <em class=listener>#<unspecified></em>
- :<em class=typing>our-edits</em>
- <em class=listener>#<procedure our-edits ((snd chn) (scale-channel 2.0 0 #f snd chn) (pad-channel 100 200 snd chn))></em>
- :<em class=typing>(undo 2)</em>
- <em class=listener>2</em>
- :<em class=typing>(our-edits 0 0)</em>
- <em class=listener>100</em>
+</p>
+
+<pre class="indented">
+> (define our-edits (<em class=red>edit-list->function</em>)) ; same example as above
+#<unspecified>
+> our-edits
+#<procedure our-edits ((snd chn) (scale-channel 2.0 0 #f snd chn) (pad-channel 100 200 snd chn))>
+> (undo 2)
+2
+> (our-edits 0 0)
+100
</pre>
-In Ruby:
-<pre>
- :<em class=typing>open_sound "oboe.snd"</em>
- <em class=listener>0</em>
- :<em class=typing>scale_channel 2.0</em>
- <em class=listener>2.0</em>
- :<em class=typing>pad_channel 100, 200</em>
- <em class=listener>100</em>
- :<em class=typing>our_edits = edit_list2function</em>
- <em class=listener>#<Proc:0x40c713ec@(eval):2></em>
- :<em class=typing>our_edits.source</em>
- <em class=listener>Proc.new {|snd, chn| scale_channel(2.000, 0, false, snd, chn); pad_channel(100, 200, snd, chn) }</em>
- :<em class=typing>undo 2</em>
- <em class=listener>2</em>
- :<em class=typing>our_edits.call(0, 0)</em>
- <em class=listener>100</em>
-</pre>
-
-In Forth:
-<pre>
- snd> <em class=typing>"oboe.snd" open-sound</em>
- <em class=listener>0</em>
- snd> <em class=typing>2.0 scale-channel</em>
- <em class=listener>2.0</em>
- snd> <em class=typing>100 200 pad-channel</em>
- <em class=listener>100</em>
- snd> <em class=typing>0 0 edit-list->function value our-edits</em>
- <em class=listener>nil</em>
- snd> <em class=typing>our-edits proc-source-ref</em>
- <em class=listener>lambda: { snd chn } 2.000 0 #f snd chn scale-channel drop 100 200 snd chn pad-channel drop ; 2 make-proc</em>
- snd> <em class=typing>2 undo</em>
- <em class=listener>2</em>
- snd> <em class=typing>our-edits '( 0 0 ) run-proc</em>
- <em class=listener>#f</em>
-</pre>
-</td></tr><tr><td></td><td></td></tr><tr><td colspan=2 height=16></td></tr>
+<p>In Ruby:
+</p>
+
+<pre class="indented">
+:open_sound "oboe.snd"
+0
+:scale_channel 2.0
+2.0
+:pad_channel 100, 200
+100
+:our_edits = edit_list2function
+#<Proc:0x40c713ec@(eval):2>
+:our_edits.source
+Proc.new {|snd, chn| scale_channel(2.000, 0, false, snd, chn); pad_channel(100, 200, snd, chn) }
+:undo 2
+2
+:our_edits.call(0, 0)
+100
+</pre>
+
+<p>In Forth:
+</p>
+
+<pre class="indented">
+snd> "oboe.snd" open-sound
+0
+snd> 2.0 scale-channel
+2.0
+snd> 100 200 pad-channel
+100
+snd> 0 0 edit-list->function value our-edits
+nil
+snd> our-edits proc-source-ref
+lambda: { snd chn } 2.000 0 #f snd chn scale-channel drop 100 200 snd chn pad-channel drop ; 2 make-proc
+snd> 2 undo
+2
+snd> our-edits '( 0 0 ) run-proc
+#f
+</pre>
+<div class="spacer"></div>
<!-- edit-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="editposition">edit-position</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-The current position in the edit history list; it can be set: <code>(set! (edit-position) 0)</code> is equivalent
-to <code>(<a class=quiet href="#revertsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_revertsound_tip)">revert-sound</a>)</code> in a mono sound.
+<pre class="indented">
+<em class=def id="editposition">edit-position</em> snd chn
+</pre>
+
+<p>The current position in the edit history list; it can be set: (set! (edit-position) 0) is equivalent
+to (<a class=quiet href="#revertsound">revert-sound</a>) in a mono sound.
See <a href="#makesampler">make-sampler</a>.
-</td></tr><tr><td></td><td></td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- edit-properties -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="editproperties">edit-properties</a> <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-Each entry in a channel's edit history list has a property list (similar to the
+<pre class="indented">
+<em class=def id="editproperties">edit-properties</em> snd chn edpos
+</pre>
+
+<p>Each entry in a channel's edit history list has a property list (similar to the
<a href="#channelproperties">channel-properties</a> list). If you have information that changes with the
edit lists, these property lists might simplify the access code.
-</td></tr><tr><td></td><td></td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- edit-property -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="editproperty">edit-property</a> key snd chn edpos</code>
-</td></tr><tr><td></td><td>
-edit-property returns the value associated with 'key' in the given channel's edit history list
+<pre class="indented">
+<em class=def id="editproperty">edit-property</em> key snd chn edpos
+</pre>
+
+<p>edit-property returns the value associated with 'key' in the given channel's edit history list
<a href="extsnd.html#editproperties">property list</a> at edit location 'edpos'. To add or change a property, use set! with this procedure
as in <a href="#channelproperty">channel-property</a>.
The edit list property list is convenient because the associated information goes away automatically
when the given edit is no longer accessible.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- edits -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="edits">edits</a> <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This returns a list with the number of undo-able edits and redo-able edits. That is, if we have 2 undo-able edits and
-no redo-able edits, <code>(edits)</code> returns <code>(list 2 0)</code>.
-</td></tr><tr><td></td><td></td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="edits">edits</em> snd chn
+</pre>
+
+<p>This returns a list with the number of undo-able edits and redo-able edits. That is, if we have 2 undo-able edits and
+no redo-able edits, (edits) returns (list 2 0).
+</p>
+<div class="spacer"></div>
<!-- edit-tree -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="edittree">edit-tree</a> <em class=narg>snd chn edpos</em></code>
-</td></tr><tr><td></td><td>
-This returns a list of lists completely describing current edit list.
+<pre class="indented">
+<em class=def id="edittree">edit-tree</em> snd chn edpos
+</pre>
+
+<p>This returns a list of lists completely describing current edit list.
Each inner list has the form
+</p>
-<pre>
- (list global-position data-number local-position local-end scaler ramp0 ramp1 type)
+<pre class="indented">
+(list global-position data-number local-position local-end scaler ramp0 ramp1 type)
</pre>
-If 'data-number' is -2, it marks the end of the list. In our example above (the scale-channel/pad-channel sequence):
+<p>If 'data-number' is -2, it marks the end of the list. In our example above (the scale-channel/pad-channel sequence):
+</p>
-<pre>
- :<em class=typing>(edit-tree)</em>
- <em class=listener>((0 0 0 99 2.0 0.0 0.0 0) (100 -1 0 199 0.0 0.0 0.0 1)
- (300 0 100 50827 2.0 0.0 0.0 0) (51028 -2 0 0 0.0 0.0 0.0 0))</em>
+<pre class="indented">
+> (edit-tree)
+ ((0 0 0 99 2.0 0.0 0.0 0) (100 -1 0 199 0.0 0.0 0.0 1)
+ (300 0 100 50827 2.0 0.0 0.0 0) (51028 -2 0 0 0.0 0.0 0.0 0))
</pre>
-
-</td></tr><tr><td></td><td></td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- save-edit-history -->
+<pre class="indented">
+<em class=def id="saveedithistory">save-edit-history</em> filename snd chn
+</pre>
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="saveedithistory">save-edit-history</a> filename <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This function saves the current edit lists in 'filename'.
+<p>This function saves the current edit lists in 'filename'.
If 'chn' is omitted, all of the sound's channels are saved; if 'snd' is omitted,
all edit lists are saved. If the underlying files are not subsequently
changed, you can load this file to restore the current edit list state.
@@ -10789,47 +11187,47 @@ exact copy of the state (edit lists and all) of the given sound,
providing a way to fork an edit path (geez, what jargon!). The idea here
is to copy the complete edit state into a new sound so that two or more
edit sequences can be compared.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define sfile 0)
-(define* (<a name="clonesoundas">clone-sound-as</a> new-name snd)
- (let* ((tmpf (<a class=quiet href="#sndtempnam" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndtempnam_tip)">snd-tempnam</a>))
+(define* (<em class="noem" id="clonesoundas">clone-sound-as</em> new-name snd)
+ (let* ((tmpf (<a class=quiet href="#sndtempnam">snd-tempnam</a>))
(scm (string-append (substring tmpf 0 (- (string-length tmpf) 3)) "scm"))
- (oldsnd (or snd (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>))))
- (if (not (string? (<a class=quiet href="#savedir" onmouseout="UnTip()" onmouseover="Tip(extsnd_savedir_tip)">save-dir</a>))) (set! (<a class=quiet href="#savedir" onmouseout="UnTip()" onmouseover="Tip(extsnd_savedir_tip)">save-dir</a>) "/tmp"))
+ (oldsnd (or snd (<a class=quiet href="#selectedsound">selected-sound</a>))))
+ (if (not (string? (<a class=quiet href="#savedir">save-dir</a>))) (set! (<a class=quiet href="#savedir">save-dir</a>) "/tmp"))
(<em class=red>save-edit-history</em> scm oldsnd)
- (copy-file (<a class=quiet href="#filename" onmouseout="UnTip()" onmouseover="Tip(extsnd_filename_tip)">file-name</a> oldsnd) new-name)
- (set! sfile (<a class=quiet href="#opensound" onmouseout="UnTip()" onmouseover="Tip(extsnd_opensound_tip)">open-sound</a> new-name))
+ (copy-file (<a class=quiet href="#filename">file-name</a> oldsnd) new-name)
+ (set! sfile (<a class=quiet href="#opensound">open-sound</a> new-name))
(load scm)
(delete-file scm)
sfile))
-</pre></td></tr></table>
+</pre>
-We can also use save-edit-history (with some trouble) to split a sound off
+<p>We can also use save-edit-history (with some trouble) to split a sound off
into an independent Snd process:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define* (separate-sound snd)
- (let* ((tmpf (<a class=quiet href="#sndtempnam" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndtempnam_tip)">snd-tempnam</a>))
+ (let* ((tmpf (<a class=quiet href="#sndtempnam">snd-tempnam</a>))
(scm (string-append (substring tmpf 0 (- (string-length tmpf) 3)) "scm"))
(scm1 (string-append (substring tmpf 0 (- (string-length tmpf) 4)) "-1.scm"))
- (oldsnd (or snd (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>)))
- (name (<a class=quiet href="#filename" onmouseout="UnTip()" onmouseover="Tip(extsnd_filename_tip)">file-name</a> oldsnd)))
- (if (not (string? (<a class=quiet href="#savedir" onmouseout="UnTip()" onmouseover="Tip(extsnd_savedir_tip)">save-dir</a>))) (set! (<a class=quiet href="#savedir" onmouseout="UnTip()" onmouseover="Tip(extsnd_savedir_tip)">save-dir</a>) "/tmp"))
+ (oldsnd (or snd (<a class=quiet href="#selectedsound">selected-sound</a>)))
+ (name (<a class=quiet href="#filename">file-name</a> oldsnd)))
+ (if (string=? (<a class=quiet href="#savedir">save-dir</a>) "") (set! (<a class=quiet href="#savedir">save-dir</a>) "/tmp"))
(<em class=red>save-edit-history</em> scm oldsnd)
- (<a class=quiet href="#closesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_closesound_tip)">close-sound</a> oldsnd)
+ (<a class=quiet href="#closesound">close-sound</a> oldsnd)
(with-output-to-file
scm1
(lambda ()
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "(define sfile (<a class=quiet href="#opensound" onmouseout="UnTip()" onmouseover="Tip(extsnd_opensound_tip)">open-sound</a> ~S))~%" name))
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "(load ~S)~%" scm))))
- (system (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "snd ~A &" scm1))))
-</pre></td></tr></table>
-
-</td></tr><tr><td></td><td></td></tr>
+ (<a class=quiet>format</a> #t "(define sfile (<a class=quiet href="#opensound">open-sound</a> ~S))~%" name)
+ (<a class=quiet>format</a> #t "(load ~S)~%" scm)))
+ (system (<a class=quiet>format</a> #f "snd ~A &" scm1))))
+</pre>
+<div class="separator"></div>
-</table>
<p>It is sometimes more convenient to edit the edit history lists
directly, than to run Snd and invoke the <a href="snd.html#savedstate">"Save session"</a> menu option.
@@ -10839,24 +11237,25 @@ scratch. Say we want to make a stereo file that consists
of four mono files mixed at various points; we know where they
should go, and we have religious objections to using a
graphical user interface. So we create myfile.scm, and
-put in it something like:</p>
+put in it something like:
+</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(let ((myfile (<a class=quiet href="#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "mysound.snd" mus-aifc-sound-file <a class=quiet href="#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_musbshort_tip)">mus-bshort</a> 44100 2 "this is my sound")))
+<pre class="indented">
+(let ((myfile (<a class=quiet href="#newsound">new-sound</a> "mysound.snd" 2 44100 mus-bshort mus-aifc "this is my sound")))
;; this is equivalent to the New file menu option
- (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "oboe.snd" 0 0 myfile 0)
+ (<a class=quiet href="#mix">mix</a> "oboe.snd" 0 0 myfile 0)
;; this mixes in the mono file oboe.snd at sample 0 in channel 0
- ;; use (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "oboe.snd" 0 0 myfile 0 #f) to forego the editable mix
- (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "pistol.snd" 0 0 myfile 1)
+ ;; use (<a class=quiet href="#mix">mix</a> "oboe.snd" 0 0 myfile 0 #f) to forego the editable mix
+ (<a class=quiet href="#mix">mix</a> "pistol.snd" 0 0 myfile 1)
;; now pistol.snd is at sample 0 in channel 1
- (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "fyow.snd" 10000 0 myfile 0)
+ (<a class=quiet href="#mix">mix</a> "fyow.snd" 10000 0 myfile 0)
;; add in fyow.snd at sample 10000 in the first channel
- (<a class=quiet href="#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> "cardinal.snd" 20000 0 myfile 1)
+ (<a class=quiet href="#mix">mix</a> "cardinal.snd" 20000 0 myfile 1)
;; etc
)
-</pre></td></tr></table>
+</pre>
-<p>Now start Snd: <code>snd -l myfile.scm</code> and voila!
+<p>Now start Snd: snd -l myfile.scm and voila!
Files like this can contain any arbitrary code, calling
anything in Snd or anywhere else for that matter; you
have a CLM-like notelist reader to describe sound file edits.
@@ -10869,21 +11268,21 @@ other such text.
<!-- Transforms -->
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndtransforms">Transforms</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndtransforms">Transforms</div>
<p>Most of the transform functions and variables have been treated above, so they are only mentioned here.
</p>
+<div class="spacer"></div>
-<!-- -------------------------------- TRANSFORM TABLE -------------------------------- -->
-
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
+<!-- TRANSFORM TABLE -->
<!-- add-transform -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="addtransform">add-transform</a> name xlabel lo hi transform</code>
-</td></tr><tr><td width=30></td><td>
-add-transform adds a transform to the transform choices (alongside fourier-transform, etc). 'name' is the name
+<pre class="indented">
+<em class=def id="addtransform">add-transform</em> name xlabel lo hi transform
+</pre>
+
+<p>add-transform adds a transform to the transform choices (alongside fourier-transform, etc). 'name' is the name
to use in the transform dialog. 'xlabel' is the x axis label
of the resultant graph. 'lo' and 'hi' set which portion of the returned data
to graph (normally 0.0 to 1.0). 'proc' is a function of two
@@ -10892,56 +11291,62 @@ can be used to get the current data. Do not free the sampler!
The function should return a vct containing the transform data.
add-transform returns the new transform's transform-type (an object).
Here's an example that displays a histogram of the current values in 16 bins:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>add-transform</em> "histogram" "bins" 0.0 1.0
(lambda (len fd)
- (let ((v (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> len))
+ (let ((v (make-float-vector len 0.0))
(steps (/ len 16))
(step (/ 1.0 len)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len) v)
- (let* ((val (<a class=quiet href="#readsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_readsample_tip)">read-sample</a> fd))
+ (let* ((val (<a class=quiet href="#readsample">read-sample</a> fd))
(bin (floor (* (abs val) 16.0))))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((= j steps))
(set! (v (+ j bin)) (+ step (v (+ j bin))))))))))
-</pre></td></tr></table>
+</pre>
-If GSL is included in Snd, the following code ties in the (slow) Hankel transform:
+<p>If GSL is included in Snd, the following code ties in the (slow) Hankel transform:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>add-transform</em> "Hankel" "Hankel" 0.0 1.0
(lambda (n rd)
- (let ((v (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> n)))
- (do ((i 0 (+ 1 i))) ((= i n)) (set! (v i) (rd)))
+ (let ((v (make-float-vector n 0.0)))
+ (do ((i 0 (+ i 1))) ((= i n)) (set! (v i) (rd)))
(gsl-dht n v 1.0 1.0)
v)))
-</pre></td></tr></table></td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+<div class="spacer"></div>
<!-- delete-transform -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="deletetransform">delete-transform</a> type</code>
-</td></tr><tr><td></td><td>
-This removes a transform that was added via <a class=quiet href="#addtransform" onmouseout="UnTip()" onmouseover="Tip(extsnd_addtransform_tip)">add-transform</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="deletetransform">delete-transform</em> type
+</pre>
+
+<p>This removes a transform that was added via <a class=quiet href="#addtransform">add-transform</a>.
+</p>
+<div class="spacer"></div>
<!-- fft -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fft">fft</a> rl im <em class=narg>sgn</em></code>
-</td></tr><tr><td></td><td>
-<p>
-This performs an FFT on vcts 'rl' and 'im' (the real and imaginary parts of the
+<pre class="indented">
+<em class=def id="fft">fft</em> rl im sgn
+</pre>
+
+<p>This performs an FFT on vcts 'rl' and 'im' (the real and imaginary parts of the
input data). 'sgn' is 1 for an FFT, -1 for an inverse FFT; (the default is 1).
-The CLM <a href="sndclm.html#fft">fft</a> function is called <a name="musfft">mus-fft</a> in Snd.
+The CLM <a href="sndclm.html#fft">fft</a> function is called mus-fft in Snd.
The only difference between the two is that Snd's fft determines the fft size from
the size of the vcts passed to it, whereas CLM's takes the size as an argument.
Here's an example that uses the fft to produce a sum of sinusoids each with arbitrary amplitude
and initial-phase:
</p>
-<pre>
+
+<pre class="indented">
(define (fft->sines amps phases)
(let* ((len (length phases))
(fft-size (expt 2 (+ 10 (ceiling (log len 2)))))
@@ -10956,69 +11361,84 @@ and initial-phase:
(<em class=red>fft</em> rl im -1)
rl))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
+
+<!-- integer->transform -->
+<pre class="indented">
+<em class=def id="integertotransform">integer->transform</em> i
+</pre>
-<!-- integer->transform -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="integertotransform">integer->transform</a> i</code>
-</td></tr><tr><td></td><td>
-This function returns the transform (type object) corresponding to a given integer.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This function returns the transform (type object) corresponding to a given integer.
+</p>
+<div class="spacer"></div>
<!-- snd-spectrum -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndspectrum">snd-spectrum</a> data <em class=narg>window length (linear #t) (beta 0.0) in-place (normalized #t)</em></code>
-</td></tr><tr><td></td><td>
-This returns the spectrum (as a vct) of 'data' (also a vct) using the fft window 'win'.
+<pre class="indented">
+<em class=def id="sndspectrum">snd-spectrum</em> data window length (linear #t) (beta 0.0) in-place (normalized #t)
+</pre>
+
+<p>This returns the spectrum (as a vct) of 'data' (also a vct) using the fft window 'win'.
'length' is the number of samples
of data.
-<pre>
- (let ((spectr (snd-spectrum data rectangular-window (<a class=quiet href="#transformsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformsize_tip)">transform-size</a>))))
- ...)
+</p>
+
+<pre class="indented">
+(let ((spectr (snd-spectrum data rectangular-window (<a class=quiet href="#transformsize">transform-size</a>))))
+ ...)
</pre>
-If 'linear' is #f (its default is #t), the spectrum is in dB.
+
+<p>If 'linear' is #f (its default is #t), the spectrum is in dB.
'beta' is the fft data window family parameter; it is scaled internally so here it should be between 0.0 and 1.0.
If 'in-place' is #t, the spectrum is in 'data', otherwise snd-spectrum returns a new vct.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- transform->integer -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="transformtointeger">transform->integer</a> transform-object</code>
-</td></tr><tr><td></td><td>
-This function returns the integer corresponding to a given transform type object (e.g. fourier-transform).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="transformtointeger">transform->integer</em> transform-object
+</pre>
+
+<p>This function returns the integer corresponding to a given transform type object (e.g. fourier-transform).
+</p>
+<div class="spacer"></div>
<!-- transform? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="transformp">transform?</a> object</code>
-</td></tr><tr><td></td><td>
-This returns #t if 'object' is a transform object.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="transformp">transform?</em> object
+</pre>
+
+<p>This returns #t if 'object' is a transform object.
+</p>
+<div class="spacer"></div>
-</table>
-<p>Other related variables and functions:</p>
-<table cellpadding=0 cellspacing=1 border=0 hspace=20>
-<tr><td width=200><a href="#transformgraphp"><small>transform-graph?</small></a></td><td width=200><a href="#showtransformpeaks"><small>show-transform-peaks</small></a></td><td><a href="#transformsample"><small>transform-sample</small></a></td></tr>
-<tr><td><a href="#fftbeta"><small>fft-window-beta</small></a></td><td><a href="#showselectiontransform"><small>show-selection-transform</small></a></td><td><a href="#transformtovct"><small>transform->vct</small></a></td></tr>
-<tr><td><a href="#aftertransformhook"><small>after-transform-hook</small></a></td><td><a href="#spectrumend"><small>spectrum-end</small></a></td><td><a href="#transformframes"><small>transform-frames</small></a></td></tr>
-<tr><td><a href="#fftlogfrequency"><small>fft-log-frequency</small></a></td><td><a href="#spectrohop"><small>spectro-hop</small></a></td><td><a href="#transformtype"><small>transform-type</small></a></td></tr>
-<tr><td><a href="#fftlogmagnitude"><small>fft-log-magnitude</small></a></td><td><a href="#spectrumstart"><small>spectrum-start</small></a></td><td><a href="#updatetransformgraph"><small>update-transform-graph</small></a></td></tr>
-<tr><td><a href="#transformsize"><small>transform-size</small></a></td><td><a href="#spectroxangle"><small>spectro-x-angle</small></a></td><td><a href="#normalizefft"><small>transform-normalization</small></a></td></tr>
-<tr><td><a href="#transformgraphtype"><small>transform-graph-type</small></a></td><td><a href="#spectroxscale"><small>spectro-x-scale</small></a></td><td><a href="#zeropad"><small>zero-pad</small></a></td></tr>
-<tr><td><a href="#fftwindow"><small>fft-window</small></a></td><td><a href="#spectroyangle"><small>spectro-y-angle</small></a></td><td><a href="#wavelettype"><small>wavelet-type</small></a></td></tr>
-<tr><td><a href="#maxfftpeaks"><small>max-transform-peaks</small></a></td><td><a href="#spectroyscale"><small>spectro-y-scale</small></a></td><td><a href="#spectrozscale"><small>spectro-z-scale</small></a></td></tr>
-<tr><td><a href="#mindb"><small>min-dB</small></a></td><td><a href="#spectrozangle"><small>spectro-z-angle</small></a></td><td></td></tr>
-</table>
-<p>Some FFT-based effects and editing functions:
+<p>Other related variables and functions:</p>
+<pre class="indented">
+<a href="#transformgraphp">transform-graph?</a> <a href="#showtransformpeaks">show-transform-peaks</a> <a href="#transformsample">transform-sample</a>
+<a href="#fftbeta">fft-window-beta</a> <a href="#showselectiontransform">show-selection-transform</a> <a href="#transformtovct">transform->vct</a>
+<a href="#aftertransformhook">after-transform-hook</a> <a href="#spectrumend">spectrum-end</a> <a href="#transformframples">transform-framples</a>
+<a href="#fftlogfrequency">fft-log-frequency</a> <a href="#spectrohop">spectro-hop</a> <a href="#transformtype">transform-type</a>
+<a href="#fftlogmagnitude">fft-log-magnitude</a> <a href="#spectrumstart">spectrum-start</a> <a href="#updatetransformgraph">update-transform-graph</a>
+<a href="#transformsize">transform-size</a> <a href="#spectroxangle">spectro-x-angle</a> <a href="#normalizefft">transform-normalization</a>
+<a href="#transformgraphtype">transform-graph-type</a> <a href="#spectroxscale">spectro-x-scale</a> <a href="#zeropad">zero-pad</a>
+<a href="#fftwindow">fft-window</a> <a href="#spectroyangle">spectro-y-angle</a> <a href="#wavelettype">wavelet-type</a>
+<a href="#maxfftpeaks">max-transform-peaks</a> <a href="#spectroyscale">spectro-y-scale</a> <a href="#spectrozscale">spectro-z-scale</a>
+<a href="#mindb">min-dB</a> <a href="#spectrozangle">spectro-z-angle</a>
+</pre>
+
+<p id="fftexamples">Some FFT-based effects and editing functions:
</p>
+
<!-- INDEX fftexamples:FFTs -->
-<A NAME="fftexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=20><tr><td>
-<small><blockquote>
+
+<TABLE class="method">
+<tr><th class="title">FFTs</th></tr><tr><td>
+<blockquote><small>
CLM fft function: <a href="sndclm.html#fft">mus-fft</a><br>
CLM spectrum: <a href="sndclm.html#spectrum">spectrum</a><br>
Snd spectrum: <a href="#sndspectrum">snd-spectrum</a><br>
@@ -11043,19 +11463,19 @@ spectral modeling: <a href="sndscm.html#clminsdoc">pins</a><br>
polynomial approach to spectral multiplies (convolution): <a href="sndscm.html#spectralpolynomial">spectral-polynomial</a><br>
<br>
Superimpose ffts: <a href="sndscm.html#superimposeffts">superimpose-ffts</a><br>
-Waterfall real-time spectrograph: <a href="sndscm.html#startwaterfall">start-waterfall</a><br>
-Simple rt spectrum: <a href="sndscm.html#showinputfft">show-input-fft</a>, <a href="sndscm.html#showdraggableinputfft">show-draggable-input-fft</a><br>
More transforms: <a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a>, <a href="sndscm.html#ztransform">z-transform</a> in dsp.scm<br>
3D (single) fft display: <a href="sndscm.html#complexify">complexify</a><br>
bark, mel, erb scale display: <a href="sndscm.html#displaybarkfft">display-bark-fft</a><br>
apply function to spectrum, inverse fft: <a href="sndscm.html#filterfft">filter-fft</a><br>
-</blockquote></small>
+</small></blockquote>
</td></tr></TABLE>
-<br>
+
+
+
<!-- Dialogs -->
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="snddialogs">Dialogs and Other Widgets</a></h3></td></tr></table>
+
+<div class="header" id="snddialogs">Dialogs and other widgets</div>
<p>The built-in dialogs, accessible from the main menu, provide the standard, but sometimes clumsy
ways to open and save sounds, edit envelopes and headers, and set various global variables.
@@ -11064,40 +11484,45 @@ The following
functions refer to the built-in dialogs. They were aimed originally at semi-internal needs like
saving the current Snd state, but might be useful elsewhere.
Functions such as color-orientation-dialog normally create and start the dialog in question; that is,
-<code>(color-orientation-dialog)</code> puts the color/orientation dialog on the screen. If you're trying instead to
+(color-orientation-dialog) puts the color/orientation dialog on the screen. If you're trying instead to
customize the dialog in some way (in your initialization file, for example), you want the
dialog to be created (so that the various widget children exist), but don't want it to pop
up on the screen ('managed' in X jargon). So, most of the dialog functions have a 'managed' argument
that defaults to #t. If #f, the dialog is created, if need be, but not started.
-install-searcher in snd-motif.scm, which adds customized file filtering code
-to the File:Open dialog, first makes sure the dialog exists with <code>(open-file-dialog #f)</code>.
+install-searcher-with-colors in snd-motif.scm, which adds customized file filtering code
+to the File:Open dialog, first makes sure the dialog exists with (open-file-dialog #f).
</p>
+<div class="spacer"></div>
+<!-- DIALOG TABLE -->
-<!-- -------------------------------- DIALOG TABLE -------------------------------- -->
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
<!-- add-directory-to-view-files-list -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="adddirectorytoviewfileslist">add-directory-to-view-files-list</a> dir <em class=narg>dialog</em></code>
-</td></tr><tr><td></td><td>
-This adds the sound files in directory 'dir' to the list of files in the View:Files dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="adddirectorytoviewfileslist">add-directory-to-view-files-list</em> dir dialog [Motif only]
+</pre>
+
+<p>This adds the sound files in directory 'dir' to the list of files in the View:Files dialog.
+</p>
+<div class="spacer"></div>
<!-- add-file-to-view-files-list -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="addfiletoviewfileslist">add-file-to-view-files-list</a> file <em class=narg>dialog</em></code>
-</td></tr><tr><td></td><td>
-This adds 'file' to the list of files in the View:Files dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="addfiletoviewfileslist">add-file-to-view-files-list</em> file dialog [Motif only]
+</pre>
+
+<p>This adds 'file' to the list of files in the View:Files dialog.
+</p>
+<div class="spacer"></div>
<!-- add-file-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="addfilefilter">add-file-filter</a> name func</code>
-</td></tr><tr><td></td><td>
-This adds 'func' to the file filter list under the name 'name'. The file filter list is a list
+<pre class="indented">
+<em class=def id="addfilefilter">add-file-filter</em> name func
+</pre>
+
+<p>This adds 'func' to the file filter list under the name 'name'. The file filter list is a list
of functions, accessed from drop-down menus in the various file-related dialogs. Each such function
filters the list of files displayed by the dialog, so that only some interesting subset is posted.
The built-in filter is <a href="#justsounds">just-sounds</a> which uses the sound file extension
@@ -11106,375 +11531,448 @@ You can add your own filters to this
menu with add-file-filter. The 'name' appears as the menu item label corresponding to the function.
The function should take one argument, a file name, and return #t to retain that file in the file list.
add-file-filter returns an integer to identify 'func' in other contexts.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>add-file-filter</em>
- "mono"
+ "mono files"
(lambda (a)
- "filter out all but mono sound files"
- (and (<a class=quiet href="#soundfilep" onmouseout="UnTip()" onmouseover="Tip(extsnd_soundfilep_tip)">sound-file?</a> a)
+ (and (<a class=quiet href="#soundfilep">sound-file?</a> a)
(= (channels a) 1))))
-</pre></td></tr></table></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+</pre>
+<div class="spacer"></div>
+
<!-- add-file-sorter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="addfilesorter">add-file-sorter</a> name func</code>
-</td></tr><tr><td></td><td>
-This adds 'func' to the file-sorter list under the name 'name'. Some dialog file lists include
+<pre class="indented">
+<em class=def id="addfilesorter">add-file-sorter</em> name func [Motif only]
+</pre>
+
+<p>This adds 'func' to the file-sorter list under the name 'name'. Some dialog file lists include
a "sort" menu to reorder the files in the file list. You can add your own sort functions to this
menu with add-file-sorter. The 'name' appears as the menu item label corresponding to the function.
The new sorter's index is returned; it is an integer for use with functions such as <a href="#viewfilessort">view-files-sort</a>.
The function should take two arguments, each a filename, and return a strcmp-like number describing
how to sort the pair. The following adds a sorter named "duration" that sorts files from shorter
to longer:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>add-file-sorter</em>
"duration"
(lambda (a b)
- "sort by duration from short to long"
- (let ((dur1 (<a class=quiet href="#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> a))
- (dur2 (<a class=quiet href="#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> b)))
+ (let ((dur1 (<a class=quiet href="#mussoundduration">mus-sound-duration</a> a))
+ (dur2 (<a class=quiet href="#mussoundduration">mus-sound-duration</a> b)))
(if (> dur1 dur2) 1
(if (< dur1 dur2) -1 0)))))
-</pre></td></tr></table></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+</pre>
+<div class="spacer"></div>
+
<!-- add-sound-file-extension -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="addsoundfileextension">add-sound-file-extension</a> ext</code>
-</td></tr><tr><td></td><td>
-This adds 'ext' to the list of (case sensitive) sound file extensions used by <a href="#soundfilesindirectory">sound-files-in-directory</a>.
+<pre class="indented">
+<em class=def id="addsoundfileextension">add-sound-file-extension</em> ext
+</pre>
+
+<p>This adds 'ext' to the list of (case sensitive) sound file extensions used by <a href="#soundfilesindirectory">sound-files-in-directory</a>.
The initial list is ("snd" "aiff" "aif" "wav" "au" "aifc" "voc" "wve" "WAV" "sf2" "rf64" "caf").
To add "ogg" as a recognized extension:
-<pre>
- (add-sound-file-extension "ogg")
+</p>
+
+<pre class="indented">
+ (add-sound-file-extension "ogg")
</pre>
-The list itself is <a href="#soundfileextensions">sound-file-extensions</a>.
+
+<p>The list itself is <a href="#soundfileextensions">sound-file-extensions</a>.
See also <a href="sndscm.html#matchsoundfiles">add-sound-file-extension-1</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- add-to-main-menu -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="addtomainmenu">add-to-main-menu</a> menu-label <em class=narg>update-callback</em></code>
-</td></tr><tr><td></td><td>
-This adds a new top-level menu named 'menu-label' and returns its menu index. The index
+<pre class="indented">
+<em class=def id="addtomainmenu">add-to-main-menu</em> menu-label update-callback
+</pre>
+
+<p>This adds a new top-level menu named 'menu-label' and returns its menu index. The index
identifies the menu for add-to-menu and others.
'update-callback' is a procedure of no arguments that is
called each time the menu is displayed.
-<pre>
- Scheme:
- (define new-menu (add-to-main-menu "New Menu"))
- (<a class=quiet href="#addtomenu" onmouseout="UnTip()" onmouseover="Tip(extsnd_addtomenu_tip)">add-to-menu</a> new-menu "First Item" (lambda () (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> ";item 1")))
- (<a class=quiet href="#addtomenu" onmouseout="UnTip()" onmouseover="Tip(extsnd_addtomenu_tip)">add-to-menu</a> new-menu "Second Item" (lambda () (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> ";item 2")))
+</p>
- Ruby:
- new_menu = add_to_main_menu("New Menu")
- add_to_menu(new_menu, "First Item", lambda do | | snd_print("item 1") end)
- add_to_menu(new_menu, "Second Item", lambda do | | snd_print("item 2") end)
+<pre class="indented">
+Scheme:
+(define new-menu (add-to-main-menu "New Menu"))
+(<a class=quiet href="#addtomenu">add-to-menu</a> new-menu "First Item" (lambda () (<a class=quiet href="#sndprint">snd-print</a> ";item 1")))
+(<a class=quiet href="#addtomenu">add-to-menu</a> new-menu "Second Item" (lambda () (<a class=quiet href="#sndprint">snd-print</a> ";item 2")))
+
+Ruby:
+new_menu = add_to_main_menu("New Menu")
+add_to_menu(new_menu, "First Item", lambda do | | snd_print("item 1") end)
+add_to_menu(new_menu, "Second Item", lambda do | | snd_print("item 2") end)
- Forth:
- "New Menu" add-to-main-menu constant new-menu drop
- new-menu "First Item" lambda: <{ }> "item1" snd-print ; undef add-to-menu drop
- new-menu "Second Item" lambda: <{ }> "item2" snd-print ; undef add-to-menu drop
+Forth:
+"New Menu" add-to-main-menu constant new-menu drop
+new-menu "First Item" lambda: <{ }> "item1" snd-print ; undef add-to-menu drop
+new-menu "Second Item" lambda: <{ }> "item2" snd-print ; undef add-to-menu drop
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- add-to-menu -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="addtomenu">add-to-menu</a> top-menu menu-label callback <em class=narg>position</em></code>
-</td></tr><tr><td></td><td>
-This adds the menu 'menu-label' to the top-level menu whose index is
+<pre class="indented">
+<em class=def id="addtomenu">add-to-menu</em> top-menu menu-label callback position
+</pre>
+
+<p>This adds the menu 'menu-label' to the top-level menu whose index is
'top-menu' with the callback function 'callback', then returns the new menu label widget.
The built-in
Snd menus are numbered from 0 ('File') to 4 ('Help'). If the label and callback are #f, a separator is added to the menu.
'position' sets the position of the new menu option; it defaults to the end of the menu. See new-effects.scm for many examples.
-<pre>
- (<em class=red>add-to-menu</em> 1 "Stop Playing"
- (lambda () (<a class=quiet href="#stopplaying" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopplaying_tip)">stop-playing</a>)))
+</p>
+
+<pre class="indented">
+ (<em class=red>add-to-menu</em> 1 "Stop Playing" <a class=quiet href="#stopplaying">stop-playing</a>)
(<em class=red>add-to-menu</em> 5 "Reduce height"
- (lambda () (set! (<a class=quiet href="#windowheight" onmouseout="UnTip()" onmouseover="Tip(extsnd_windowheight_tip)">window-height</a>) (/ (<a class=quiet href="#windowheight" onmouseout="UnTip()" onmouseover="Tip(extsnd_windowheight_tip)">window-height</a>) 2))))
-</pre></td></tr>
-<tr><td></td><td>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+ (lambda () (set! (<a class=quiet href="#windowheight">window-height</a>) (/ (<a class=quiet href="#windowheight">window-height</a>) 2))))
+</pre>
+<div class="spacer"></div>
+
<!-- channel-widgets -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="channelwidgets">channel-widgets</a></code>
-</td></tr><tr><td></td><td>
-channel-widgets returns a list of various widgets associated with a given channel:
-<pre>
- 0: graph ;drawing area for all 3 graphs (time, fft, lisp)
- 1: w-button
- 2: f-button
- 3: x-position slider
- 4: y-position slider
- 5: x-zoom slider
- 6: y-zoom slider
- 7: edit history list
- 8: right(united-chans) y-position slider
- 9: right y-zoom slider
- 10: main pane for channel
- ------ the rest only in Gtk+
- 11..16: adjustment widgets associated with the zoom and position sliders
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="channelwidgets">channel-widgets</em>
+</pre>
+
+<p>channel-widgets returns a list of various widgets associated with a given channel:
+</p>
+
+<pre class="indented">
+0: graph ;drawing area for all 3 graphs (time, fft, lisp)
+1: w-button
+2: f-button
+3: x-position slider
+4: y-position slider
+5: x-zoom slider
+6: y-zoom slider
+7: edit history list
+8: right(united-chans) y-position slider
+9: right y-zoom slider
+10: main pane for channel
+------ the rest only in Gtk+
+11..16: adjustment widgets associated with the zoom and position sliders
+</pre>
+<div class="spacer"></div>
<!-- clear-listener -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="clearlistener">clear-listener</a></code>
-</td></tr><tr><td width=30></td><td>
-This deletes all listener text from the beginning to the cursor position (C-M-g is bound to this function).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="clearlistener">clear-listener</em>
+</pre>
+
+<p>This deletes all listener text from the beginning to the cursor position (C-M-g is bound to this function).
+</p>
+<div class="spacer"></div>
<!-- color-orientation-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="colororientationdialog">color-orientation-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td width=30></td><td>
-This creates and (if 'managed' which defaults to #t) activates the Color/Orientation dialog; it returns the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="colororientationdialog">color-orientation-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t) activates the Color/Orientation dialog; it returns the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- define-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="defineenvelope">define-envelope</a> name data <em class=narg>(base 1.0)</em></code>
-</td></tr><tr><td></td><td>
-This adds an envelope to the envelope editor's list, under the name 'name', using the list of breakpoints
-'data', and the optional 'base'. If the 'base' is omitted, this is the same as <a href="#defvar">defvar</a>.
-<pre>
- Scheme: (define-envelope ramp '(0 0 1 1))
- Ruby: define_envelope("ramp", [0, 0, 1, 1])
- Forth: $" ramp" '( 0.0 0.0 1.0 1.0 ) 1.0 define-envelope
+<pre class="indented">
+<em class=def id="defineenvelope">define-envelope</em> name data (base 1.0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This adds an envelope to the envelope editor's list, under the name 'name', using the list of breakpoints
+'data', and the optional 'base'.
+</p>
-<!-- defvar -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="defvar">defvar</a> var val</code>
-</td></tr><tr><td></td><td>
-This is the same as <code>(define var val)</code> except that the envelope editor keeps track
-of 'var' thereafter and treats lists as envelopes.
-defvar exists in this context so that Snd and CLM can share envelope files.
-<pre>
- (defvar a-func '(0 0 1 1))
+<pre class="indented">
+Scheme: (define-envelope ramp '(0 0 1 1))
+Ruby: define_envelope("ramp", [0, 0, 1, 1])
+Forth: $" ramp" '( 0.0 0.0 1.0 1.0 ) 1.0 define-envelope
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- delete-file-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="deletefilefilter">delete-file-filter</a> index</code>
-</td></tr><tr><td></td><td>
-This removes the file filter function associated with 'index' from the file filter list.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="deletefilefilter">delete-file-filter</em> index
+</pre>
+
+<p>This removes the file filter function associated with 'index' from the file filter list.
+</p>
+<div class="spacer"></div>
<!-- delete-file-sorter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="deletefilesorter">delete-file-sorter</a> index</code>
-</td></tr><tr><td></td><td>
-This removes the file sorter function associated with 'index' from the file sorter list.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="deletefilesorter">delete-file-sorter</em> index [Motif only]
+</pre>
+
+<p>This removes the file sorter function associated with 'index' from the file sorter list.
+</p>
+<div class="spacer"></div>
<!-- dialog-widgets -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="dialogwidgets">dialog-widgets</a></code>
-</td></tr><tr><td></td><td>
-dialog-widgets returns a list of dialog widgets (or lists thereof, or #f if none yet):
-<pre>
- 0: View: Color/Orientation dialog
- 2: Edit: EnvelopeEditor dialog
- 3 and 4: unused
- 5: Options: Transform dialog
- 6: File: Open dialog
- 7: File: Save as dialog
- 8: View: Files dialog
- 9: raw data dialog (activated when raw sound opened, sometimes)
- 10: File: New sound dialog
- 11: File: Mix dialog
- 12: Edit: Edit header dialog
- 13: Edit: Find dialog
- 14: Help dialog
- 16: View: Mixes dialog
- 17: File: Print dialog
- 18: File: Recorder dialog
- 19: View: Regions dialog
- 20: info dialog (activated by info-dialog function)
- 21: more controls dialog
- 22: Edit: Selection Save as dialog
- 23: File: Insert file dialog
- 24: region save as dialog (from regions dialog save button)
- 25: Options: Preferences dialog
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="dialogwidgets">dialog-widgets</em>
+</pre>
+
+<p>dialog-widgets returns a list of dialog widgets (or lists thereof, or #f if none yet):
+</p>
+
+<pre class="indented">
+0: View: Color/Orientation dialog
+2: Edit: EnvelopeEditor dialog
+ 3 and 4: unused
+5: Options: Transform dialog
+6: File: Open dialog
+7: File: Save as dialog
+8: View: Files dialog
+9: raw data dialog (activated when raw sound opened, sometimes)
+10: File: New sound dialog
+11: File: Mix dialog
+12: Edit: Edit header dialog
+13: Edit: Find dialog
+14: Help dialog
+16: View: Mixes dialog
+17: File: Print dialog
+19: View: Regions dialog
+20: info dialog (activated by info-dialog function)
+21: more controls dialog
+22: Edit: Selection Save as dialog
+23: File: Insert file dialog
+24: region save as dialog (from regions dialog save button)
+25: Options: Preferences dialog
+</pre>
+<div class="spacer"></div>
<!-- edit-header-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="editheaderdialog">edit-header-dialog</a> <em class=narg>snd</em></code>
-</td></tr><tr><td></td><td>
-This starts the Edit Header dialog on 'snd', returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="editheaderdialog">edit-header-dialog</em> snd
+</pre>
+
+<p>This starts the Edit Header dialog on 'snd', returning the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- enved-base -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedbase">enved-base</a> </code>
-</td></tr><tr><td></td><td>
-This is the envelope editor exponential base value.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="envedbase">enved-base</em>
+</pre>
+
+<p>This is the envelope editor exponential base value.
+</p>
+<div class="spacer"></div>
<!-- enved-clip? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedclipping">enved-clip?</a></code>
-</td></tr><tr><td></td><td>
-This reflects the state of the envelope editor 'clip' button.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="envedclipping">enved-clip?</em>
+</pre>
+
+<p>This reflects the state of the envelope editor 'clip' button.
+</p>
+<div class="spacer"></div>
<!-- enved-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="enveddialog">enved-dialog</a></code>
-</td></tr><tr><td></td><td>
-This starts the envelope editor dialog, returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="enveddialog">enved-dialog</em>
+</pre>
+
+<p>This starts the envelope editor dialog, returning the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- enved-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedenvelope">enved-envelope</a></code>
-</td></tr><tr><td></td><td>
-This is the envelope (a list of breakpoints) in the envelope editor's graph window.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="envedenvelope">enved-envelope</em>
+</pre>
+
+<p>This is the envelope (a list of breakpoints) in the envelope editor's graph window.
+</p>
+<div class="spacer"></div>
<!-- enved-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="filterenv">enved-filter</a></code>
-</td></tr><tr><td></td><td>
-This reflects the type of the envelope editor's filter (the default #t means FIR; #f is FFT). To get the FFT display in the envelope editor
+<pre class="indented">
+<em class=def id="filterenv">enved-filter</em>
+</pre>
+
+<p>This reflects the type of the envelope editor's filter (the default #t means FIR; #f is FFT). To get the FFT display in the envelope editor
as the default:
-<pre>
+</p>
+
+<pre class="indented">
(set! (<em class=red>enved-filter)</em> #f)
- (set! (<a class=quiet href="#envedwaving" onmouseout="UnTip()" onmouseover="Tip(extsnd_envedwaving_tip)">enved-wave?</a>) #t)
- (set! (<a class=quiet href="#envedtarget" onmouseout="UnTip()" onmouseover="Tip(extsnd_envedtarget_tip)">enved-target</a>) <a class=quiet href="#envedtarget" onmouseout="UnTip()" onmouseover="Tip(extsnd_envedtarget_tip)">enved-spectrum</a>)
-</pre></td></tr>
+ (set! (<a class=quiet href="#envedwaving">enved-wave?</a>) #t)
+ (set! (<a class=quiet href="#envedtarget">enved-target</a>) <a class=quiet href="#envedtarget">enved-spectrum</a>)
+</pre>
+<div class="spacer"></div>
<!-- enved-filter-order -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="filterenvorder">enved-filter-order</a></code>
-</td></tr><tr><td></td><td>
-This is the order of the envelope editor's FIR filter (the default is 40).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="filterenvorder">enved-filter-order</em>
+</pre>
+
+<p>This is the order of the envelope editor's FIR filter (the default is 40).
+</p>
+<div class="spacer"></div>
<!-- enved-in-dB -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedin-dB">enved-in-dB</a></code>
-</td></tr><tr><td></td><td>
-This reflects the state of the envelope editor 'dB' button (it defaults to #f).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="envedin-dB">enved-in-dB</em>
+</pre>
+
+<p>This reflects the state of the envelope editor 'dB' button (it defaults to #f).
+</p>
+<div class="spacer"></div>
<!-- enved-power -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedpower">enved-power</a></code>
-</td></tr><tr><td></td><td>
-This is the envelope editor's base scale range (it defaults to 3.0).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="envedpower">enved-power</em>
+</pre>
+
+<p>This is the envelope editor's base scale range (it defaults to 3.0).
+</p>
+<div class="spacer"></div>
<!-- enved-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedstyle">enved-style</a></code>
-</td></tr><tr><td></td><td>
-This is the envelope editor choice for connecting breakpoints. It can be <code>envelope-linear</code> (the default), or
-<code>envelope-exponential</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="envedstyle">enved-style</em>
+</pre>
+
+<p>This is the envelope editor choice for connecting breakpoints. It can be envelope-linear (the default), or
+envelope-exponential.
+</p>
+<div class="spacer"></div>
<!-- enved-target -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedtarget">enved-target</a></code>
-</td></tr><tr><td></td><td>
-This determines how the envelope editor's current envelope is applied to the selected data.
-The choices are <code>enved-amplitude</code>, <code>enved-srate</code> and <code>enved-spectrum</code>.
+<pre class="indented">
+<em class=def id="envedtarget">enved-target</em>
+</pre>
+
+<p>This determines how the envelope editor's current envelope is applied to the selected data.
+The choices are enved-amplitude, enved-srate and enved-spectrum.
The first treats the envelope as an amplitude envelope, the second as an srate curve (changing speed),
and the last as a frequency response envelope for a filter.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- enved-waveform-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedwaveformcolor">enved-waveform-color</a></code>
-</td></tr><tr><td></td><td>
-This is the color of the waveform displayed in envelope editor (the default is blue).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="envedwaveformcolor">enved-waveform-color</em>
+</pre>
+
+<p>This is the color of the waveform displayed in envelope editor (the default is blue).
+</p>
+<div class="spacer"></div>
<!-- enved-wave? -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="envedwaving">enved-wave?</a></code>
-</td></tr><tr><td></td><td>
-This reflects the state of the envelope editor 'wave' button.
+<pre class="indented">
+<em class=def id="envedwaving">enved-wave?</em>
+</pre>
+
+<p>This reflects the state of the envelope editor 'wave' button.
The wave shown is the time domain display, even when filtering.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- find-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="finddialog">find-dialog</a> <em class=narg>managed text</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t) starts the Edit:Find dialog, returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="finddialog">find-dialog</em> managed text
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t) starts the Edit:Find dialog, returning the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- focus-widget -->
-<tr><td bgcolor="#f2f4ff" colspan=2>
-<code><a class=def name="focuswidget">focus-widget</a> widget</code>
-</td></tr><tr><td></td><td>
-This gives 'widget' "focus" — it becomes the active widget, receiving keystrokes and so on.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="focuswidget">focus-widget</em> widget
+</pre>
+
+<p>This gives 'widget' "focus" — it becomes the active widget, receiving keystrokes and so on.
+</p>
+<div class="spacer"></div>
<!-- gl-graph->ps -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="glgraphtops">gl-graph->ps</a> <em class=narg>file (type 0) snd chn</em></code>
-</td></tr><tr><td></td><td>
-This creates a Postscript picture of the current openGL display in snd's channel chn (a spectrogram).
+<pre class="indented">
+<em class=def id="glgraphtops">gl-graph->ps</em> file (type 0) snd chn
+</pre>
+
+<p>This creates a Postscript picture of the current openGL display in snd's channel chn (a spectrogram).
'file' defaults to <a href="#epsfile">eps-file</a>.
'type' can be 0: eps, 1: ps, 2: pdf, 3: tex, 4: svg, or 5: pgf.
This function is available only if OpenGL and gl2ps have been loaded (via the --with-gl and
--with-gl2ps configuration switches).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- goto-listener-end -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="gotolistenerend">goto-listener-end</a></code>
-</td></tr><tr><td></td><td>
-This moves the cursor to the end of the listener text, and scrolls the window so that it is visible.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="gotolistenerend">goto-listener-end</em>
+</pre>
+
+<p>This moves the cursor to the end of the listener text, and scrolls the window so that it is visible.
+</p>
+<div class="spacer"></div>
<!-- graph->ps -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="graphtops">graph->ps</a> file</code>
-</td></tr><tr><td></td><td>
-This creates a Postscript picture of the current display.
+<pre class="indented">
+<em class=def id="graphtops">graph->ps</em> file
+</pre>
+
+<p>This creates a Postscript picture of the current display.
'file' defaults to <a href="#epsfile">eps-file</a>.
See also <a href="#epsbottommargin">eps-bottom-margin</a>, <a href="#epsleftmargin">eps-left-margin</a>,
and <a href="#epssize">eps-size</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- help-dialog -->
-<tr><td colspan=2 valign=top><code><a class=def name="helpdialog">help-dialog</a> subject help-string <em class=narg>xrefs urls</em></code>
-</td></tr><tr><td></td><td>
-This starts the help dialog with the title 'subject' and help area text 'help', returning the dialog widget.
+<pre class="indented">
+<em class=def id="helpdialog">help-dialog</em> subject help-string xrefs urls
+</pre>
+
+<p>This starts the help dialog with the title 'subject' and help area text 'help', returning the dialog widget.
'xrefs' is an optional list of strings to post in the "related items" list. 'urls' is a corresponding
list of urls.
-<pre>
- (help-dialog "xyzzy" "are we having fUn?")
-</pre>
There are many examples in new-effects.scm.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td>
-<pre>
-(defmacro with-snd-help (form)
+<pre class="indented">
+(define-macro (with-snd-help form)
;; if an error occurs while evaluating form, try to start the help dialog with some relevant help
`(catch #t
(lambda ()
@@ -11484,745 +11982,899 @@ There are many examples in new-effects.scm.
(let* ((func (if (string=? "set!" (substring (cadr args) 0 4))
(substring (cadr args) 5)
(cadr args)))
- (help (<a class=quiet href="#sndhelp" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndhelp_tip)">snd-help</a> func)))
+ (help (<a class=quiet href="#sndhelp">snd-help</a> func)))
(if help (<em class=red>help-dialog</em> func help))))
args)))
</pre>
-</td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- hide-widget -->
-<tr><td bgcolor="#f2f4ff" colspan=2>
-<code><a class=def name="hidewidget">hide-widget</a> widget</code>
-</td></tr><tr><td></td><td>
-This hides (unmanages) 'widget'.
+<pre class="indented">
+<em class=def id="hidewidget">hide-widget</em> widget
+</pre>
+
+<p>This hides (unmanages) 'widget'.
To remove the y-position slider (which is only there
for looks):
-<pre>
- (<a class=quiet href="#hidewidget" onmouseout="UnTip()" onmouseover="Tip(extsnd_hidewidget_tip)">hide-widget</a> (list-ref (<a class=quiet href="#channelwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelwidgets_tip)">channel-widgets</a>) 4))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#hidewidget">hide-widget</a> ((<a class=quiet href="#channelwidgets">channel-widgets</a>) 4))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- info-dialog -->
-<tr><td colspan=2 valign=top><code><a class=def name="infodialog">info-dialog</a> subject info</code>
-</td></tr><tr><td></td><td>
-This starts the info dialog with the title 'subject' and body 'info' returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="infodialog">info-dialog</em> subject info
+</pre>
+
+<p>This starts the info dialog with the title 'subject' and body 'info' returning the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- insert-file-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="insertfiledialog">insert-file-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t) activates the File:Insert dialog, returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="insertfiledialog">insert-file-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t) activates the File:Insert dialog, returning the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- listener-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="listenercolor">listener-color</a></code>
-</td></tr><tr><td></td><td>
-This is the background color of listener.
-<pre>
- (set! (listener-color) (<a class=quiet href="#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 0 0))
+<pre class="indented">
+<em class=def id="listenercolor">listener-color</em>
+</pre>
+
+<p>This is the background color of listener.
+</p>
+
+<pre class="indented">
+(set! (listener-color) (<a class=quiet href="#makecolor">make-color</a> 0 0 0))
+</pre>
+<div class="spacer"></div>
+
+
+<!-- listener-colorized -->
+<pre class="indented">
+<em class=def id="listenercolorized">listener-colorized</em>
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>This determines whether the listener displays the code with syntax highlights in the Gtk version of Snd.
+The colors can be changed with colorizer-colors.
+</p>
+<div class="spacer"></div>
<!-- listener-font -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="listenerfont">listener-font</a></code>
-</td></tr><tr><td></td><td>
-This is the listener font.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="listenerfont">listener-font</em>
+</pre>
+
+<p>This is the listener font.
+</p>
+<div class="spacer"></div>
<!-- listener-prompt -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="listenerprompt">listener-prompt</a></code>
-</td></tr><tr><td></td><td>
-This is the listener prompt which defaults to ">". I like ":" better (as you can see in many of the examples in this file),
+<pre class="indented">
+<em class=def id="listenerprompt">listener-prompt</em>
+</pre>
+
+<p>This is the listener prompt which defaults to ">". I like ":" better (as you can see in many of the examples in this file),
so in ~/.snd_s7 I have this line:
-<pre>
- (set! (listener-prompt) ":")
+</p>
+
+<pre class="indented">
+(set! (listener-prompt) ":")
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- listener-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="listenerselection">listener-selection</a></code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="listenerselection">listener-selection</em>
+</pre>
-listener-selection returns the currently selected text in the listener, or #f if there isn't any. The following code
+<p>listener-selection returns the currently selected text in the listener, or #f if there isn't any. The following code
starts the help dialog with help related to the selection if "h" is typed in the graph:
-<pre>
- (<a class=quiet href="#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\h 0
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#bindkey">bind-key</a> #\h 0
+ (let ((documentation "start help dialog based on listener selected text"))
(lambda ()
- "start help dialog based on listener selected text"
(let ((subject (<em class=red>listener-selection</em>)))
- (if subject
- (<a class=quiet href="#helpdialog" onmouseout="UnTip()" onmouseover="Tip(extsnd_helpdialog_tip)">help-dialog</a> subject (<a class=quiet href="#sndhelp" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndhelp_tip)">snd-help</a> subject))))))
+ (if subject
+ (<a class=quiet href="#helpdialog">help-dialog</a> subject (<a class=quiet href="#sndhelp">snd-help</a> subject)))))))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- listener-text-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="listenertextcolor">listener-text-color</a></code>
-</td></tr><tr><td></td><td>
-This is the text color in the listener. For red text on a black background:
-<pre>
- (set! (listener-color) (make-color 0 0 0)) ; in Gtk, maybe a bad idea — the cursor remains black...
- (set! (listener-text-color) (make-color 1 0 0))
+<pre class="indented">
+<em class=def id="listenertextcolor">listener-text-color</em>
+</pre>
+
+<p>This is the text color in the listener. For red text on a black background:
+</p>
+
+<pre class="indented">
+(set! (listener-color) (make-color 0 0 0)) ; in Gtk, maybe a bad idea — the cursor remains black...
+(set! (listener-text-color) (make-color 1 0 0))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- main-menu -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mainmenu">main-menu</a> menu</code>
-</td></tr><tr><td></td><td>
-main-menu returns the top-level menu
+<pre class="indented">
+<em class=def id="mainmenu">main-menu</em> menu
+</pre>
+
+<p>main-menu returns the top-level menu
associated with its integer argument:
-<pre>
- 0: File menu
- 1: Edit menu
- 2: View menu
- 3: Options menu
- 4: Help menu
- and others as added by add-main-menu
+</p>
+
+<pre class="indented">
+0: File menu
+1: Edit menu
+2: View menu
+3: Options menu
+4: Help menu
+and others as added by add-main-menu
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- main-widgets -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mainwidgets">main-widgets</a></code>
-</td></tr><tr><td></td><td>
-main-widgets returns a list of the top-level widgets in Snd (#f if not created):
-<pre>
- 0: top-level-application ; XtAppContext in Motif, top level window in Gtk+
- 1: top-level-shell
- 2: main-pane ; outer paned window top window (holds sounds)
- 3: main-sound-pane
- 4: listener-pane ; outer paned window bottom window
- 5: notebook-outer-pane
+<pre class="indented">
+<em class=def id="mainwidgets">main-widgets</em>
</pre>
-For example, to get at Snd's main shell widget:
-<pre>
- Scheme: (cadr (main-widgets))
- Ruby: main_widgets.cadr
- Forth: main-widgets cadr
+<p>main-widgets returns a list of the top-level widgets in Snd (#f if not created):
+</p>
+
+<pre class="indented">
+0: top-level-application ; XtAppContext in Motif, top level window in Gtk+
+1: top-level-shell
+2: main-pane ; outer paned window top window (holds sounds)
+3: main-sound-pane
+4: listener-pane ; outer paned window bottom window
+5: notebook-outer-pane
+</pre>
+
+<p>For example, to get at Snd's main shell widget:
+</p>
+
+<pre class="indented">
+Scheme: (cadr (main-widgets))
+Ruby: main_widgets.cadr
+Forth: main-widgets cadr
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>In Gtk 3.1 or later, we can use this to fire up a modal font chooser dialog:
+</p>
+
+<pre class="indented">
+> (define (get-font)
+ (with-let *gtk*
+ (let ((fonts (gtk_font_chooser_dialog_new "fonts" (GTK_WINDOW (cadr (<em class=red>main-widgets</em>))))))
+ (let ((response (gtk_dialog_run (GTK_DIALOG fonts)))) ; don't return until a choice is made
+ (let ((name (if (= response GTK_RESPONSE_OK) ; (cancel = GTK_RESPONSE_CANCEL)
+ (gtk_font_chooser_get_font (GTK_FONT_CHOOSER fonts))
+ 'no-font-selected))) ; perhaps pass in the current value instead?
+ (gtk_widget_destroy (GTK_WIDGET fonts)) ; clean up after the dialog
+ name))))) ; return new font
+get-font
+
+> (set! (listener-font) (get-font))
+"Monospace Bold Italic 10"
+</pre>
+
+
+<div class="spacer"></div>
<!-- menu-widgets -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="menuwidgets">menu-widgets</a></code>
-</td></tr><tr><td></td><td>
-menu-widgets returns the top-level menu widgets (cascade menus in Motif or menu bars in Gtk+)
+<pre class="indented">
+<em class=def id="menuwidgets">menu-widgets</em>
+</pre>
+
+<p>menu-widgets returns the top-level menu widgets (cascade menus in Motif or menu bars in Gtk+)
as a list:
-<pre>
- 0: top-level-menu-bar
- 1: file-menu
- 2: edit-menu
- 3: view-menu
- 4: options-menu
- 5: help-menu
-</pre>
-See snd-motif.scm, snd-gtk.scm, kmenu.scm, and new-effects.scm for various examples.
+</p>
+
+<pre class="indented">
+0: top-level-menu-bar
+1: file-menu
+2: edit-menu
+3: view-menu
+4: options-menu
+5: help-menu
+</pre>
+
+<p>See snd-motif.scm, snd-gtk.scm, and new-effects.scm for various examples.
Manipulating menus can be tricky in both Motif and Gtk; if I were to try to explain
submenus and whatnot here, I'd only get tangled up in half-forgotten complications.
When I have to deal with this stuff, I always go to a working example.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix-dialog-mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixdialogmix">mix-dialog-mix</a></code>
-</td></tr><tr><td></td><td>
-This is the id (mix object) of the mix displayed by the mix dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="mixdialogmix">mix-dialog-mix</em>
+</pre>
+
+<p>This is the id (mix object) of the mix displayed by the mix dialog.
+</p>
+<div class="spacer"></div>
<!-- mix-file-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="mixfiledialog">mix-file-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t) activates the File:Mix dialog,
+<pre class="indented">
+<em class=def id="mixfiledialog">mix-file-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t) activates the File:Mix dialog,
returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- new-sound-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="newsounddialog">new-sound-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t)
+<pre class="indented">
+<em class=def id="newsounddialog">new-sound-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t)
starts the File:New sound dialog, returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- open-file-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="openfiledialog">open-file-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t) activates the File:Open dialog,
+<pre class="indented">
+<em class=def id="openfiledialog">open-file-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t) activates the File:Open dialog,
returning the dialog widget.
-If the xm module is loaded, we could add our own info via:
-
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
- (let* ((dialog (<em class=red>open-file-dialog</em> #f))
- (rc (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(sndscm_findchild_tip)">find-child</a> dialog "info-rc2")) ; holds the info labels if a sound file is selected
- (label (XtCreateManagedWidget "file-preview-info" xmLabelWidgetClass rc
- (list XmNbackground (<a class=quiet href="#highlightcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_highlightcolor_tip)">highlight-color</a>)))))
- (XtAddCallback (XmFileSelectionBoxGetChild dialog XmDIALOG_LIST)
- XmNbrowseSelectionCallback
- (lambda (widget context info)
- (let ((file (cadr (XmStringGetLtoR (.item info) XmFONTLIST_DEFAULT_TAG))))
- (XtVaSetValues label
- (list XmNlabelString
- (XmStringCreateLtoR (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A: no comment" file)
- XmFONTLIST_DEFAULT_TAG)))))
- #f))
-</pre></td></tr></table></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- preferences-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="preferencesdialog">preferences-dialog</a></code>
-</td></tr><tr><td></td><td>
-This activates the Options:Preferences dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="preferencesdialog">preferences-dialog</em>
+</pre>
+<p>This activates the Options:Preferences dialog.
+</p>
+<div class="spacer"></div>
-<!-- print-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="printdialog">print-dialog</a> <em class=narg>managed direct-to-printer</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t) activates the File:Print dialog, returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- print-dialog -->
+<pre class="indented">
+<em class=def id="printdialog">print-dialog</em> managed direct-to-printer
+</pre>
-<!-- recorder-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="recorderdialog">recorder-dialog</a></code>
-</td></tr><tr><td></td><td>
-This starts the <a href="snd.html#recordfile">recorder</a> window, returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This creates and (if 'managed' which defaults to #t) activates the File:Print dialog, returning the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- remove-from-menu -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="removefrommenu">remove-from-menu</a> top-menu menu-label</code>
-</td></tr><tr><td></td><td>
-This removes the menu 'menu-label' from the top top-level menu whose index is 'top-menu'. See examp.scm or snd-motif.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="removefrommenu">remove-from-menu</em> top-menu menu-label
+</pre>
+
+<p>This removes the menu 'menu-label' from the top top-level menu whose index is 'top-menu'. See examp.scm or snd-motif.scm.
+</p>
+<div class="spacer"></div>
<!-- reset-listener-cursor -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="resetlistenercursor">reset-listener-cursor</a></code>
-</td></tr><tr><td></td><td>
-This resets the listener cursor to the default pointer shape.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="resetlistenercursor">reset-listener-cursor</em>
+</pre>
+
+<p>This resets the listener cursor to the default pointer shape.
+</p>
+<div class="spacer"></div>
<!-- save-as-dialog-auto-comment -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="saveasdialogautocomment">save-as-dialog-auto-comment</a></code>
-</td></tr><tr><td></td><td>
-This is the 'auto' button in the Save-as dialogs. If set, a comment is automatically
+<pre class="indented">
+<em class=def id="saveasdialogautocomment">save-as-dialog-auto-comment</em>
+</pre>
+
+<p>This is the 'auto' button in the Save-as dialogs. If set, a comment is automatically
generated for the new file.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- save-as-dialog-src -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="saveasdialogsrc">save-as-dialog-src</a></code>
-</td></tr><tr><td></td><td>
-This is the 'src' button in the Save-as dialogs. If set, sampling rate conversion
+<pre class="indented">
+<em class=def id="saveasdialogsrc">save-as-dialog-src</em>
+</pre>
+
+<p>This is the 'src' button in the Save-as dialogs. If set, sampling rate conversion
is performed if the output srate does not match the original srate.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- save-envelopes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="saveenvelopes">save-envelopes</a> filename</code>
-</td></tr><tr><td></td><td>
-This saves the envelope editor envelopes in 'filename'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="saveenvelopes">save-envelopes</em> filename
+</pre>
+
+<p>This saves the envelope editor envelopes in 'filename'.
+</p>
+<div class="spacer"></div>
<!-- save-listener -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="savelistener">save-listener</a> filename</code>
-</td></tr><tr><td></td><td>
-This saves the listener contents in 'filename'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="savelistener">save-listener</em> filename
+</pre>
+
+<p>This saves the listener contents in 'filename'.
+</p>
+<div class="spacer"></div>
<!-- save-region-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="saveregiondialog">save-region-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t)
+<pre class="indented">
+<em class=def id="saveregiondialog">save-region-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t)
starts the Region Save-as dialog (to save the current Region browser region), returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- save-selection-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="saveselectiondialog">save-selection-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t)
+<pre class="indented">
+<em class=def id="saveselectiondialog">save-selection-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t)
starts the Edit:Save selection as dialog (to save the current selection), returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- save-sound-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="savesounddialog">save-sound-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t)
+<pre class="indented">
+<em class=def id="savesounddialog">save-sound-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t)
starts the File:Save as dialog (to save the currently selected sound), returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- show-listener -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="showlistener">show-listener</a></code>
-</td></tr><tr><td></td><td>
-If show-listener is set to #t, Snd opens the listener pane; otherwise it closes the listener.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="showlistener">show-listener</em>
+</pre>
+
+<p>If show-listener is set to #t, Snd opens the listener pane; otherwise it closes the listener.
+</p>
+<div class="spacer"></div>
<!-- show-widget -->
-<tr><td bgcolor="#f2f4ff" colspan=2>
-<code><a class=def name="showwidget">show-widget</a> widget</code>
-</td></tr><tr><td></td><td>
-This shows (manages) 'widget'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="showwidget">show-widget</em> widget
+</pre>
+
+<p>This shows (manages) 'widget'.
+</p>
+<div class="spacer"></div>
<!-- sound-file-extensions -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="soundfileextensions">sound-file-extensions</a></code>
-</td></tr><tr><td></td><td>
-This is the list of sound file extensions used by the "just-sounds" buttons and
+<pre class="indented">
+<em class=def id="soundfileextensions">sound-file-extensions</em>
+</pre>
+
+<p>This is the list of sound file extensions used by the "just-sounds" buttons and
<a href="#soundfilesindirectory">sound-files-in-directory</a> to try to recognize
sound files. It is settable: a list of extensions as strings:
-<pre>
- (set! (sound-file-extensions)
- (list "snd" "aiff" "aif" "wav" "au" "aifc" "voc" "wve" "WAV" "sf2" "rf64" "caf"))
+</p>
+
+<pre class="indented">
+(set! (sound-file-extensions)
+ (list "snd" "aiff" "aif" "wav" "au" "aifc" "voc" "wve" "WAV" "sf2" "rf64" "caf"))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- sound-file? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="soundfilep">sound-file?</a> filename</code>
-</td></tr><tr><td></td><td>
-This returns #t if 'filename' has an extension that matches one in the <a href="#soundfileextensions">sound-file-extensions</a> list.
-<pre>
- :<em class=typing>(sound-file? "oboe.snd")</em>
- <em class=listener>#t</em>
- :<em class=typing>(sound-file? "extsnd.html")</em>
- <em class=listener>#f</em>
+<pre class="indented">
+<em class=def id="soundfilep">sound-file?</em> filename
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>This returns #t if 'filename' has an extension that matches one in the <a href="#soundfileextensions">sound-file-extensions</a> list.
+</p>
+
+<pre class="indented">
+> (sound-file? "oboe.snd")
+#t
+> (sound-file? "extsnd.html")
+#f
+</pre>
+<div class="spacer"></div>
<!-- sound-files-in-directory -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="soundfilesindirectory">sound-files-in-directory</a> <em class=narg>dir</em></code>
-</td></tr><tr><td></td><td>
-This returns a list of the sound files found in 'dir'. A file is considered a sound if it has data and
+<pre class="indented">
+<em class=def id="soundfilesindirectory">sound-files-in-directory</em> dir
+</pre>
+
+<p>This returns a list of the sound files found in 'dir'. A file is considered a sound if it has data and
its extension is on the sound file extension list (see <a href="#addsoundfileextension">add-sound-file-extension</a>).
The directory name defaults to the current directory.
This is useful for batch processing of sounds. The following
prints the names of all the stereo AIFC files it finds:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(for-each
(lambda (filename)
- (if (and (= (<a class=quiet href="#mussoundheadertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundheadertype_tip)">mus-sound-header-type</a> filename) <a class=quiet href="#headertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_headertype_tip)">mus-aifc</a>)
+ (if (and (= (<a class=quiet href="#mussoundheadertype">mus-sound-header-type</a> filename) <a class=quiet href="#headertype">mus-aifc</a>)
(= (channels filename) 2))
- (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~%~A" filename))))
+ (<a class=quiet href="#sndprint">snd-print</a> (<a class=quiet>format</a> #f "~%~A" filename))))
(<em class=red>sound-files-in-directory</em>))
-</pre></td></tr></table>
+</pre>
-See also <a href="sndscm.html#mapsoundfiles">map-sound-files</a> in extensions.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>See also <a href="sndscm.html#mapsoundfiles">map-sound-files</a> in extensions.scm.
+</p>
+<div class="spacer"></div>
<!-- sound-widgets -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="soundwidgets">sound-widgets</a></code>
-</td></tr><tr><td></td><td>
-sound-widgets returns a list of various widgets specific to a given sound:
-<pre>
- 0: main-pane
- 1: name-label ; sound's file name
- 2: control-panel
- 3: minibuffer
- 4: play button
- 5: filter-graph ; control panel drawing area for filter envelope
- 6: unite button ; invisible in mono sounds
- 7: minibuffer-label ; prompt area for the minibuffer
- 8: name-icon ; hour-glass or whatever
- 9: sync button
-</pre>
-
-For example, we can read and write the minibuffer:
-<pre>
- Scheme:
- :<em class=typing>(report-in-minibuffer "this is a test")</em>
- <em class=listener>"this is a test"</em>
- :<em class=typing>(widget-text (list-ref (sound-widgets) 3))</em>
- <em class=listener>"this is a test"</em>
+<pre class="indented">
+<em class=def id="soundwidgets">sound-widgets</em>
+</pre>
+
+<p>sound-widgets returns a list of various widgets specific to a given sound:
+</p>
+
+<pre class="indented">
+0: main-pane
+1: name-label ; sound's file name
+2: control-panel
+3: status area
+4: play button
+5: filter-graph ; control panel drawing area for filter envelope
+6: unite button ; invisible in mono sounds
+8: name-icon ; hour-glass or whatever
+9: sync button
+</pre>
+
+<p>For example, we can read and write the status area:
+</p>
+
+<pre class="indented">
+Scheme:
+> (status-report "this is a test")
+"this is a test"
+> (widget-text ((sound-widgets) 3))
+"this is a test"
- Ruby:
- :<em class=typing>report_in_minibuffer("this is a test")</em>
- <em class=listener>this is a test</em>
- :<em class=typing>widget_text(sound_widgets()[3])</em>
- <em class=listener>this is a test</em>
+Ruby:
+:status_report("this is a test")
+this is a test
+:widget_text(sound_widgets()[3])
+this is a test
- Forth:
- <em class=listener>snd></em> <em class=typing>"this is a test" report-in-minibuffer</em>
- <em class=listener>this is a test</em>
- <em class=listener>snd></em> <em class=typing>0 sound-widgets 3 list-ref widget-text</em>
- <em class=listener>this is a test</em>
+Forth:
+snd> "this is a test" status-report
+this is a test
+snd> 0 sound-widgets 3 list-ref widget-text
+this is a test
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- transform-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="transformdialog">transform-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t) activates the Options:Transform dialog, returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="transformdialog">transform-dialog</em> managed
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t) activates the Options:Transform dialog, returning the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- view-files-amp -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewfilesamp">view-files-amp</a> dialog</code>
-</td></tr><tr><td></td><td>
-This is the value of the amplitude slider in the View:Files dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewfilesamp">view-files-amp</em> dialog [Motif only]
+</pre>
+
+<p>This is the value of the amplitude slider in the View:Files dialog.
+</p>
+<div class="spacer"></div>
<!-- view-files-amp-env -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewfilesampenv">view-files-amp-env</a> dialog</code>
-</td></tr><tr><td></td><td>
-This is the amplitude envelope displayed in the View:Files dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewfilesampenv">view-files-amp-env</em> dialog [Motif only]
+</pre>
+
+<p>This is the amplitude envelope displayed in the View:Files dialog.
+</p>
+<div class="spacer"></div>
<!-- view-files-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewfilesdialog">view-files-dialog</a> <em class=narg>managed</em></code>
-</td></tr><tr><td></td><td>
-This creates and (if 'managed' which defaults to #t) activates a
+<pre class="indented">
+<em class=def id="viewfilesdialog">view-files-dialog</em> managed [Motif only]
+</pre>
+
+<p>This creates and (if 'managed' which defaults to #t) activates a
View:Files <a href="snd.html#viewfiles">dialog</a> and returns the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- view-files-files -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewfilesfiles">view-files-files</a> dialog</code>
-</td></tr><tr><td></td><td>
-This is the file list (a list of strings) of a View:Files dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewfilesfiles">view-files-files</em> dialog [Motif only]
+</pre>
+
+<p>This is the file list (a list of strings) of a View:Files dialog.
+</p>
+<div class="spacer"></div>
<!-- view-files-selected-files -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewfilesselectedfiles">view-files-selected-files</a> dialog</code>
-</td></tr><tr><td></td><td>
-This is the list of selected files (a list of strings) in a View:Files dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewfilesselectedfiles">view-files-selected-files</em> dialog [Motif only]
+</pre>
+
+<p>This is the list of selected files (a list of strings) in a View:Files dialog.
+</p>
+<div class="spacer"></div>
<!-- view-files-sort -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewfilessort">view-files-sort</a> dialog</code>
-</td></tr><tr><td></td><td>
-This is the sort function choice in a View:Files dialog. Initially there are 6 sort choices: a..z, z..a (sort by file name),
+<pre class="indented">
+<em class=def id="viewfilessort">view-files-sort</em> dialog [Motif only]
+</pre>
+
+<p>This is the sort function choice in a View:Files dialog. Initially there are 6 sort choices: a..z, z..a (sort by file name),
new..old, old..new (sort by file write date), and small..big, big..small (sort by file size). The default is 0 (a..z).
If you set view-files-sort without giving the dialog argument, it just affects the startup state of subsequent new View:Files
dialogs. To set the sort choice in the current dialog:
-<pre>
- (set! (view-files-sort (list-ref (<a class=quiet href="#dialogwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_dialogwidgets_tip)">dialog-widgets</a>) 8)) 2) ; 2=new..old
+</p>
+
+<pre class="indented">
+ (set! (view-files-sort ((<a class=quiet href="#dialogwidgets">dialog-widgets</a>) 8)) 2) ; 2=new..old
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- view-files-speed -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewfilesspeed">view-files-speed</a> dialog</code>
-</td></tr><tr><td></td><td>
-This is the value of the speed slider in a View:Files dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewfilesspeed">view-files-speed</em> dialog [Motif only]
+</pre>
+
+<p>This is the value of the speed slider in a View:Files dialog.
+</p>
+<div class="spacer"></div>
<!-- view-files-speed-style -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewfilesspeedstyle">view-files-speed-style</a> dialog</code>
-</td></tr><tr><td></td><td>
-This is the speed style choice in a View:Files dialog. It is one of <code>speed-control-as-float</code> (the default),
-<code>speed-control-as-ratio</code>, or <code>speed-control-as-semitone</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewfilesspeedstyle">view-files-speed-style</em> dialog [Motif only]
+</pre>
+
+<p>This is the speed style choice in a View:Files dialog. It is one of speed-control-as-float (the default),
+speed-control-as-ratio, or speed-control-as-semitone.
+</p>
+<div class="spacer"></div>
<!-- view-mixes-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewmixesdialog">view-mixes-dialog</a></code>
-</td></tr><tr><td></td><td>
-This creates and activates the View:Mixes Dialog, returning the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewmixesdialog">view-mixes-dialog</em>
+</pre>
+
+<p>This creates and activates the View:Mixes Dialog, returning the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- view-regions-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="viewregionsdialog">view-regions-dialog</a></code>
-</td></tr><tr><td></td><td>
-This starts the <a href="snd.html#regionbrowser">region browser</a> (a no-op if there are no regions), and returns the dialog widget.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="viewregionsdialog">view-regions-dialog</em>
+</pre>
+
+<p>This starts the <a href="snd.html#regionbrowser">region browser</a> (a no-op if there are no regions), and returns the dialog widget.
+</p>
+<div class="spacer"></div>
<!-- widget-position -->
-<tr><td bgcolor="#f2f4ff" colspan=2>
-<code><a class=def name="widgetposition">widget-position</a> widget</code>
-</td></tr><tr><td></td><td>
-This returns a list giving the widget's x and y coordinates (in pixels). It can be set to reposition the widget.
+<pre class="indented">
+<em class=def id="widgetposition">widget-position</em> widget
+</pre>
+
+<p>This returns a list giving the widget's x and y coordinates (in pixels). It can be set to reposition the widget.
See nb.scm where it uses the current window position to try to find a convenient place for the help dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- widget-size -->
-<tr><td bgcolor="#f2f4ff" colspan=2>
-<code><a class=def name="widgetsize">widget-size</a> widget</code>
-</td></tr><tr><td></td><td>
-This returns a list giving the widget's width and height (in pixels). It can be set to resize the widget. See nb.scm and examp.scm.
-<pre>
- (set! (<a class=quiet href="#widgetposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_widgetposition_tip)">widget-position</a> (cadr (<a class=quiet href="#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>))) (list 300 100))
+<pre class="indented">
+<em class=def id="widgetsize">widget-size</em> widget
+</pre>
+
+<p>This returns a list giving the widget's width and height (in pixels). It can be set to resize the widget. See nb.scm and examp.scm.
+</p>
+
+<pre class="indented">
+(set! (<a class=quiet href="#widgetposition">widget-position</a> (cadr (<a class=quiet href="#mainwidgets">main-widgets</a>))) (list 300 100))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- widget-text -->
-<tr><td bgcolor="#f2f4ff" colspan=2>
-<code><a class=def name="widgettext">widget-text</a> widget</code>
-</td></tr><tr><td></td><td>
-This returns the text widget's text. It can be set.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="widgettext">widget-text</em> widget
+</pre>
+
+<p>This returns the text widget's text. It can be set.
+</p>
+<div class="spacer"></div>
-</table>
-<!-- end of dialog table -->
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndmisc">Miscellaneous functions</a></h3></td></tr></table>
-<p>These functions don't seem to fit anywhere else:</p>
+<div class="header" id="sndmisc">Miscellaneous functions</div>
-<!-- -------------------------------- MISCELLANEOUS TABLE -------------------------------- -->
+<!-- MISCELLANEOUS TABLE -->
+<div class="spacer"></div>
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
<!-- abort -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="abort">abort</a></code>
-</td></tr><tr><td width=30><br></td><td>
-This exits Snd via "abort", presumably to fall into the C debugger. To stop some on-going Snd operation,
+<pre class="indented">
+<em class=def id="abort">abort</em>
+</pre>
+
+<p>This exits Snd via "abort", presumably to fall into the C debugger. To stop some on-going Snd operation,
use <a href="#cgp">C-g</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- add-source-file-extension -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="addsourcefileextension">add-source-file-extension</a> ext</code>
-</td></tr><tr><td><br></td><td>
-add-source-file-extension adds 'ext' to the list of source file extensions.
-<pre>
- (add-source-file-extension "rbs")
+<pre class="indented">
+<em class=def id="addsourcefileextension">add-source-file-extension</em> ext
+</pre>
+
+<p>add-source-file-extension adds 'ext' to the list of source file extensions.
+</p>
+
+<pre class="indented">
+(add-source-file-extension "rbs")
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- bes-* -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><A class=def NAME="besj0">bes-j0</A> x</code><br>
-<code><em class=emdef>bes-j1</em> x</code><br>
-<code><em class=emdef>bes-jn</em> n x</code><br>
-<code><em class=emdef>bes-y0</em> x</code><br>
-<code><em class=emdef>bes-y1</em> x</code><br>
-<code><em class=emdef>bes-yn</em> n x</code><br>
-<code><em class=emdef>bes-i0</em> n x</code><br>
-<code><em class=emdef>bes-i1</em> n x</code> ; from GSL<br>
-<code><em class=emdef>bes-in</em> n x</code><br>
-<code><em class=emdef>bes-k0</em> x</code><br>
-<code><em class=emdef>bes-k1</em> x</code><br>
-<code><em class=emdef>bes-kn</em> n x</code><br>
-</td></tr><tr><td></td><td>
-If the Bessel functions are available from the math library (or GSL), these are J0 and friends.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="besj0">bes-j0</em> x
+<em class=emdef>bes-j1</em> x
+<em class=emdef>bes-jn</em> n x
+<em class=emdef>bes-y0</em> x
+<em class=emdef>bes-y1</em> x
+<em class=emdef>bes-yn</em> n x
+<em class=emdef>bes-i0</em> n x
+<em class=emdef>bes-i1</em> n x ; from GSL
+<em class=emdef>bes-in</em> n x
+<em class=emdef>bes-k0</em> x
+<em class=emdef>bes-k1</em> x
+<em class=emdef>bes-kn</em> n x
+</pre>
+
+<p>If the Bessel functions are available from the math library (or GSL), these are J0 and friends.
+</p>
+<div class="spacer"></div>
<!-- bind-key -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="bindkey">bind-key</a> key state func <em class=narg>extended origin</em></code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="bindkey">bind-key</em> key state func extended origin
+</pre>
+<p>
bind-key causes 'key' (an integer or a key name) with modifiers 'state' (and preceding C-x if 'extended') to evaluate 'func'
when the graph is receiving keysrokes. If bind-key seems to be a no-op, try clicking in the graph to
force it to take the focus.
If 'origin' is included, it is the name reported if an error occurs. The default is a description of the key.
-If you include a documentation string in the function, it is included in the Help menu's Key Bindings output.
-<br><br>
-The function ('func' above) should take zero or one arguments and
+</p>
+
+<p>The function ('func' above) should take zero or one arguments and
return one of the cursor choices telling Snd what
action (if any) to take after evaluating 'code'.
Possible return values are:
-<pre>
- cursor-in-view cursor-on-left cursor-on-right cursor-in-middle keyboard-no-action
+</p>
+
+<pre class="indented">
+cursor-in-view cursor-on-left cursor-on-right cursor-in-middle keyboard-no-action
</pre>
-If the function takes one argument,
+
+<p>If the function takes one argument,
that argument is the count (the C-u number prefixed to the keyboard command)
defaulting to 1 if no prefix is typed.
-<br><br>
-The modifier 'state' is a combination of control = 4 and meta = 8.
+</p>
+
+<p>The modifier 'state' is a combination of control = 4 and meta = 8.
If the key argument is a string (a key name) it has to match exactly one of the known key names.
In X, these can be found in <X11/xkeysymdef.h>, and in Gtk in gdk/gdkkeysyms.h; in both
cases, remove the XK_ or GDK_ prefix. So, for example, the key marked "Page Down" is named
"Page_Down" in both tables. Similarly "+" is "plus".
+</p>
-<pre>
- Scheme: (bind-key "End" 0 (lambda () "view full sound" (set! (<a class=quiet href="#xbounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_xbounds_tip)">x-bounds</a>) (list 0.0 (/ (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))))))
+<pre class="indented">
+ Scheme: (bind-key "End" 0 (lambda () "view full sound" (set! (<a class=quiet href="#xbounds">x-bounds</a>) (list 0.0 (/ (<a class=quiet href="#framples">framples</a>) (<a class=quiet href="#srate">srate</a>))))))
- Ruby: bind_key("End", 0, lambda do || set_x_bounds([0.0, frames.to_f / srate.to_f]) end)
+ Ruby: bind_key("End", 0, lambda do || set_x_bounds([0.0, framples.to_f / srate.to_f]) end)
- Forth: "End" 0 lambda: 0.0 #f #f #f frames #f srate f/ 2 >list set-x-bounds ; 0 make-proc bind-key
+ Forth: "End" 0 lambda: 0.0 #f #f #f framples #f srate f/ 2 >list set-x-bounds ; 0 make-proc bind-key
</pre>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>bind-key</em> "Home" 0
(lambda ()
- "move cursor and window to current edit"
- (let ((ed (<a class=quiet href="#editfragment" onmouseout="UnTip()" onmouseover="Tip(extsnd_editfragment_tip)">edit-fragment</a>)))
- (<a class=quiet href="#reportinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_reportinminibuffer_tip)">report-in-minibuffer</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A" ed))
- (set! (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) (caddr ed))
+ (let ((ed (<a class=quiet href="#editfragment">edit-fragment</a>)))
+ (<a class=quiet href="#statusreport">status-report</a> (<a class=quiet>format</a> #f "~A" ed))
+ (set! (<a class=quiet href="#cursor">cursor</a>) (caddr ed))
cursor-in-view)))
(<em class=red>bind-key</em> #\p 0
(lambda ()
- "move cursor to left edge of window"
cursor-on-left)
#f "#\\p->cursor-on-left")
(<em class=red>bind-key</em> #\v 4
(lambda ()
- "move ahead one window"
- (if (< (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a>) (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (set! (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a>)))
+ (if (< (<a class=quiet href="#rightsample">right-sample</a>) (<a class=quiet href="#framples">framples</a>))
+ (set! (<a class=quiet href="#leftsample">left-sample</a>) (<a class=quiet href="#rightsample">right-sample</a>)))
keyboard-no-action))
(<em class=red>bind-key</em> #\v 0
(lambda ()
- "remove click"
- (set! (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>)) (* 0.5 (+ (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> (- (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) 1)) (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> (+ 1 (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>))))))
+ (set! (<a class=quiet href="#sample">sample</a> (<a class=quiet href="#cursor">cursor</a>)) (* 0.5 (+ (<a class=quiet href="#sample">sample</a> (- (<a class=quiet href="#cursor">cursor</a>) 1)) (<a class=quiet href="#sample">sample</a> (+ 1 (<a class=quiet href="#cursor">cursor</a>))))))
cursor-in-view))
-</pre></td></tr></table>
+</pre>
-<A NAME="extendedpiano"></A>We can use bind-key to turn the keyboard into a sort of extended piano:
+<p id="extendedpiano">We can use bind-key to turn the keyboard into a sort of extended piano:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>bind-key</em> #\o 0
- (lambda () "play oboe.snd"
- (<a class=quiet href="#play" onmouseout="UnTip()" onmouseover="Tip(extsnd_play_tip)">play</a> "oboe.snd")
+ (lambda ()
+ (<a class=quiet href="#play">play</a> "oboe.snd")
keyboard-no-action))
(<em class=red>bind-key</em> #\p 0
- (lambda () "play pistol.snd"
- (<a class=quiet href="#play" onmouseout="UnTip()" onmouseover="Tip(extsnd_play_tip)">play</a> "pistol.snd")
+ (lambda ()
+ (<a class=quiet href="#play">play</a> "pistol.snd")
keyboard-no-action))
-</pre></td></tr></table>
+</pre>
-Now each time we hit "o", "oboe.snd" plays, etc. Or say we want to move
+<p>Now each time we hit "o", "oboe.snd" plays, etc. Or say we want to move
forward two samples in the graph each time we type "l":
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>bind-key</em> #\l 0
- (lambda () "move window forward 2 samples"
- (set! (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> 0 0) (+ 2 (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> 0 0)))
+ (lambda ()
+ (set! (<a class=quiet href="#leftsample">left-sample</a> 0 0) (+ 2 (<a class=quiet href="#leftsample">left-sample</a> 0 0)))
keyboard-no-action))
-</pre></td></tr></table>
+</pre>
-Or, more useful perhaps, have C-c set the cursor at a particular sample:
+<p>Or, more useful perhaps, have C-c set the cursor at a particular sample:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(<em class=red>bind-key</em> #\c 4
- (lambda (arg) "move cursor to arg"
- (set! (<a class=quiet href="#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) arg)
+ (lambda (arg)
+ (set! (<a class=quiet href="#cursor">cursor</a>) arg)
cursor-in-middle))
-</pre></td></tr></table>
+</pre>
-A similar set rebinds the arrow keys to give much more precise window position and size control:
+<p id="moveonepixel">A similar set rebinds the arrow keys to give much more precise window position and size control:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define (<a NAME="moveonepixel">move-one-pixel</a> s c right)
- (let* ((ax (<a class=quiet href="#axisinfo" onmouseout="UnTip()" onmouseover="Tip(extsnd_axisinfo_tip)">axis-info</a> s c <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_time_graph_tip)">time-graph</a>))
- (lo (list-ref ax 0))
- (hi (list-ref ax 1))
- (lo-pix (list-ref ax 10))
- (hi-pix (list-ref ax 12))
+<pre class="indented">
+(define (move-one-pixel s c right)
+ (let* ((ax (<a class=quiet href="#axisinfo">axis-info</a> s c <a class=quiet>time-graph</a>))
+ (lo (ax 0))
+ (hi (ax 1))
+ (lo-pix (ax 10))
+ (hi-pix (ax 12))
(samps-per-pixel (max 1 (round (/ (- hi lo) (- hi-pix lo-pix)))))
(change (if right
- (- (min (+ hi samps-per-pixel) (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> s c)) hi)
+ (- (min (+ hi samps-per-pixel) (<a class=quiet href="#framples">framples</a> s c)) hi)
(- (max 0 (- lo samps-per-pixel)) lo))))
- (set! (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) (+ lo change))
+ (set! (<a class=quiet href="#leftsample">left-sample</a>) (+ lo change))
keyboard-no-action))
(<em class=red>bind-key</em> "Left" 0 ;left arrow
(lambda ()
- "move back one pixel"
- (move-one-pixel (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>) #f)))
+ (move-one-pixel (<a class=quiet href="#selectedsound">selected-sound</a>) (<a class=quiet href="#selectedchannel">selected-channel</a>) #f)))
(<em class=red>bind-key</em> "Right" 0 ;right arrow
(lambda ()
- "move forward one pixel"
- (move-one-pixel (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>) #t)))
-
-
-(define (<a NAME="zoomonepixel">zoom-one-pixel</a> s c in)
- (let* ((ax (<a class=quiet href="#axisinfo" onmouseout="UnTip()" onmouseover="Tip(extsnd_axisinfo_tip)">axis-info</a> s c <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_time_graph_tip)">time-graph</a>))
- (lo (list-ref ax 0))
- (hi (list-ref ax 1))
- (lo-pix (list-ref ax 10))
- (hi-pix (list-ref ax 12))
+ (move-one-pixel (<a class=quiet href="#selectedsound">selected-sound</a>) (<a class=quiet href="#selectedchannel">selected-channel</a>) #t)))
+
+(define (<em class="noem" id="zoomonepixel">zoom-one-pixel</em> s c in)
+ (let* ((ax (<a class=quiet href="#axisinfo">axis-info</a> s c <a class=quiet>time-graph</a>))
+ (lo (ax 0))
+ (hi (ax 1))
+ (lo-pix (ax 10))
+ (hi-pix (ax 12))
(samps-per-pixel (max 1 (round (/ (- hi lo) (- hi-pix lo-pix)))))
- (len (<a class=quiet href="#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> s c)))
+ (len (<a class=quiet href="#framples">framples</a> s c)))
(if in
(if (> (- hi-pix lo-pix) samps-per-pixel)
(begin
- (set! (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) (+ lo samps-per-pixel))
- (set! (<a class=quiet href="#xzoomslider" onmouseout="UnTip()" onmouseover="Tip(extsnd_xzoomslider_tip)">x-zoom-slider</a>)
+ (set! (<a class=quiet href="#leftsample">left-sample</a>) (+ lo samps-per-pixel))
+ (set! (<a class=quiet href="#xzoomslider">x-zoom-slider</a>)
(* 1.0 (round (/ (max samps-per-pixel (- hi lo (* 2 samps-per-pixel))) len))))))
(begin
- (set! (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) (max 0 (- lo samps-per-pixel)))
- (set! (<a class=quiet href="#xzoomslider" onmouseout="UnTip()" onmouseover="Tip(extsnd_xzoomslider_tip)">x-zoom-slider</a>)
+ (set! (<a class=quiet href="#leftsample">left-sample</a>) (max 0 (- lo samps-per-pixel)))
+ (set! (<a class=quiet href="#xzoomslider">x-zoom-slider</a>)
(* 1.0 (round (/ (min len (+ (- hi lo) (* 2 samps-per-pixel))) len))))))
keyboard-no-action))
(<em class=red>bind-key</em> "Up" 0 ;up arrow
(lambda ()
- "zoom out one pixel"
- (zoom-one-pixel (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>) #f)))
+ (zoom-one-pixel (<a class=quiet href="#selectedsound">selected-sound</a>) (<a class=quiet href="#selectedchannel">selected-channel</a>) #f)))
(<em class=red>bind-key</em> "Down" 0 ;down arrow
(lambda ()
- "zoom in one pixel"
- (zoom-one-pixel (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>) #t)))
-</pre></td></tr></table>
+ (zoom-one-pixel (<a class=quiet href="#selectedsound">selected-sound</a>) (<a class=quiet href="#selectedchannel">selected-channel</a>) #t)))
+</pre>
-The key bindings set by bind-key are active only when the active widget is a graph; when the listener is receiving
+<p>The key bindings set by bind-key are active only when the active widget is a graph; when the listener is receiving
key strokes, the underlying text widget interprets them itself (using Emacs as a vague guide). You can change the listener's interpretation
in the following manner (this assumes you're using Motif and have the xm module loaded):
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(XtAppAddActions (car (<a class=quiet href="#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>)) (list (list "hiho" (lambda args (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> "hiho")))))
-(XtOverrideTranslations (list-ref (<a class=quiet href="#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>) 4) (XtParseTranslationTable "Ctrl <Key>i: hiho()\n"))
-</pre></td></tr></table>
+<pre class="indented">
+(XtAppAddActions (car (<a class=quiet href="#mainwidgets">main-widgets</a>)) (list (list "hiho" (lambda args (<a class=quiet href="#sndprint">snd-print</a> "hiho")))))
+(XtOverrideTranslations ((<a class=quiet href="#mainwidgets">main-widgets</a>) 4) (XtParseTranslationTable "Ctrl <Key>i: hiho()\n"))
+</pre>
-Since neither Motif nor Gtk explicitly support an Emacs-like extended mode, we have to go to
+<p>Since neither Motif nor Gtk explicitly support an Emacs-like extended mode, we have to go to
a bit of trouble to add an extended command to the listener. The following implements C-x C-f
in either Motif or Gtk:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-
+<pre class="indented">
;;; Motif version:
(define extended #f) ; our extended mode flag
-(XtAddEventHandler (list-ref (<a class=quiet href="#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>) 4) KeyPressMask #f
+(XtAddEventHandler ((<a class=quiet href="#mainwidgets">main-widgets</a>) 4) KeyPressMask #f
(lambda (w context event go)
(let* ((bits (.state event))
(keysym (XKeycodeToKeysym (XtDisplay w)
@@ -12236,7 +12888,7 @@ in either Motif or Gtk:
(begin
(if (and extended
(= (cadr keysym) 102)) ; C-x C-f
- (<a class=quiet href="#openfiledialog" onmouseout="UnTip()" onmouseover="Tip(extsnd_openfiledialog_tip)">open-file-dialog</a>))
+ (<a class=quiet href="#openfiledialog">open-file-dialog</a>))
(set! extended #f)))))))
@@ -12244,7 +12896,7 @@ in either Motif or Gtk:
(define extended #f) ; our extended mode flag
-(let ((listener (list-ref (<a class=quiet href="#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>) 4)))
+(let ((listener ((<a class=quiet href="#mainwidgets">main-widgets</a>) 4)))
(g_signal_connect_closure_by_id
(GPOINTER listener)
(g_signal_lookup "key_press_event" (G_OBJECT_TYPE (G_OBJECT listener)))
@@ -12260,20 +12912,20 @@ in either Motif or Gtk:
(begin
(if (and extended
(= key 102))
- (<a class=quiet href="#openfiledialog" onmouseout="UnTip()" onmouseover="Tip(extsnd_openfiledialog_tip)">open-file-dialog</a>))
+ (<a class=quiet href="#openfiledialog">open-file-dialog</a>))
(set! extended #f))))
#f))
#f #f)
#f))
-</pre></td></tr></table>
-
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+<div class="separator"></div>
<!-- break -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="break">break</a></code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="break">break</em>
+</pre>
+
<p>In s7, this places a breakpoint at the current code location.
If you hit the breakpoint, the listener prompt reflects the current
function name (if any), and any typing at that point is evaluated
@@ -12281,117 +12933,100 @@ in the local environment (so you have access to function arguments and
local variables). To continue from the breakpoint, (break-ok). To
exit back to the top level, (break-exit):
</p>
-<pre>
- <em class=typing>(define (outer arg1)
- (let ((y 123))
- (define (hiho arg)
- (let ((x 32)
- (y "a string")
- (z (vct .1 .2 .3)))
- (break)
- (display y)
- (+ x (string-length y) (z 1))))
- (hiho 1)
- (break)
- (* y 2)))</em>
-
- <em class=listener>></em> <em class=typing>(outer 456)</em>
- <em class=listener>hiho></em>
- <em class=listener>snd-top-level</em>
- <em class=listener>hiho></em> <em class=typing>x</em>
- <em class=listener>32</em>
- <em class=listener>hiho></em> <em class=typing>arg</em>
- <em class=listener>1</em>
- <em class=listener>hiho></em> <em class=typing>y</em>
- <em class=listener>"a string"</em>
- <em class=listener>hiho></em> <em class=typing>(break-ok)</em>
- <em class=listener>></em>
- <em class=listener>outer></em>
- <em class=listener>snd-top-level</em>
- <em class=listener>outer></em> <em class=typing>y</em>
- <em class=listener>123</em>
- <em class=listener>outer></em> <em class=typing>(break-ok)</em>
- <em class=listener>></em>
- <em class=listener>246</em>
-</pre>
-<p>To get a stack trace at the point of the break, <code>(stacktrace break-ok)</code>.
-</p>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
+<div class="spacer"></div>
<!-- c-g? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="cgp">c-g?</a></code>
-</td></tr><tr><td></td><td>
-This checks for C-g to interrupt an on-going computation, and lets other UI
+<pre class="indented">
+<em class=def id="cgp">c-g?</em>
+</pre>
+
+<p>This checks for C-g to interrupt an on-going computation, and lets other UI
events through. It is obsolete in s7.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- erf -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><em class=emdef>erf</em> x</code><br>
-<code><em class=emdef>erfc</em> n x</code><br>
-</td></tr><tr><td></td><td>
-These are the erf and erfc functions from the math library.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>erf</em> x
+<em class=emdef>erfc</em> n x
+</pre>
+
+<p>These are the erf and erfc functions from the math library.
+</p>
+<div class="spacer"></div>
<!-- exit -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="exit">exit</a> <em class=narg>exit-value</em></code>
-</td></tr><tr><td></td><td>
-This exits Snd. Scheme's exit function is renamed %exit. In Forth, this function is snd-exit.
+<pre class="indented">
+<em class=def id="exit">exit</em> exit-value
+</pre>
+
+<p>This exits Snd. Scheme's exit function is renamed %exit. In Forth, this function is snd-exit.
The hooks associated with this function are:
-<pre>
- <a class=quiet href="#beforeexithook" onmouseout="UnTip()" onmouseover="Tip(extsnd_beforeexithook_tip)">before-exit-hook</a> — can cancel exit request
- <a class=quiet href="#exithook" onmouseout="UnTip()" onmouseover="Tip(extsnd_exithook_tip)">exit-hook</a>
- Snd cleans up and exits
+</p>
+
+<pre class="indented">
+<a class=quiet href="#beforeexithook">before-exit-hook</a> — can cancel exit request
+<a class=quiet href="#exithook">exit-hook</a>
+Snd cleans up and exits
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- fmod -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><em class=emdef>fmod</em> x y</code>
-</td></tr><tr><td></td><td>
-fmod is mod with float arguments:
-<pre>
- ><em class=typing>(fmod 2.5 1.4)</em>
- <em class=listener>1.1</em>
+<pre class="indented">
+<em class=emdef>fmod</em> x y
+</pre>
+
+<p>fmod is mod with float arguments:
+</p>
+
+<pre class="indented">
+> (fmod 2.5 1.4)
+1.1
</pre>
-In Scheme, it is a synonym for modulo.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>In Scheme, fmod is a synonym for modulo.
+</p>
+<div class="spacer"></div>
<!-- gc-off -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="gcoff">gc-off</a></code>
-</td></tr><tr><td></td><td>
-gc-off turns garbage collection off, if possible.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="gcoff">gc-off</em>
+</pre>
+
+<p>gc-off turns garbage collection off, if possible.
+</p>
+<div class="spacer"></div>
<!-- gc-on -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="gcon">gc-on</a></code>
-</td></tr><tr><td></td><td>
-gc-on turns garbage collection on.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="gcon">gc-on</em>
+</pre>
+
+<p>gc-on turns garbage collection on.
+</p>
+<div class="spacer"></div>
<!-- in -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="gin">in</a> <em class=narg>ms thunk</em></code>
-</td></tr><tr><td></td><td>
-'ms' milliseconds from now, evaluate 'thunk', a function of no arguments. In Ruby, this
-is named "<a name="callin">call_in</a>".
-<pre>
- (<em class=red>in</em> 5000 (lambda () (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> "boo!")))
+<pre class="indented">
+<em class=def id="gin">in</em> ms thunk
+</pre>
+
+<p>'ms' milliseconds from now, evaluate 'thunk', a function of no arguments. In Ruby, this
+is named "call_in".
+</p>
+
+<pre class="indented">
+(<em class=red>in</em> 5000 (lambda () (<a class=quiet href="#sndprint">snd-print</a> "boo!")))
</pre>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (at hour minute func)
(let* ((cur-time (localtime (current-time)))
(cur-minute (cur-time 1))
@@ -12400,152 +13035,186 @@ is named "<a name="callin">call_in</a>".
(then (+ (* hour 60) minute)))
(<em class=red>in</em> (* 1000 60 (- then now)) func)))
-(at 15 11 (lambda () (<a class=quiet href="#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> "it's 3:11 pm!")))
-</pre></td></tr></table></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+(at 15 11 (lambda () (<a class=quiet href="#sndprint">snd-print</a> "it's 3:11 pm!")))
+</pre>
+<div class="spacer"></div>
+
<!-- key -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="key">key</a> key state <em class=narg>snd chn</em></code>
-</td></tr><tr><td></td><td>
-This executes the keyboard command 'key' with modifier keys 'state'.
+<pre class="indented">
+<em class=def id="key">key</em> key state snd chn
+</pre>
+
+<p>This executes the keyboard command 'key' with modifier keys 'state'.
'state' is a combination of control = 4 and meta = 8.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- key-binding -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="keybinding">key-binding</a> key <em class=narg>(state 0) extended</em></code>
-</td></tr><tr><td></td><td>
-This returns the user-defined (not built-in) procedure, if any, currently bound to 'key' with 'state' and 'extended' flags.
+<pre class="indented">
+<em class=def id="keybinding">key-binding</em> key (state 0) extended
+</pre>
+
+<p>This returns the user-defined (not built-in) procedure, if any, currently bound to 'key' with 'state' and 'extended' flags.
'state' is a combination of control = 4 and meta = 8. 'extended' is #t if the command
is preceded by C-x.
-<pre>
- :<em class=typing>(key-binding "Right" 0)</em>
- <em class=listener>#<procedure #f (() "move one pixel forward" (move-one-pixel (selected-sound) (selected-channel) #t))></em>
+</p>
+
+<pre class="indented">
+> (key-binding "Right" 0)
+#<procedure #f (() "move one pixel forward" (move-one-pixel (selected-sound) (selected-channel) #t))>
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- lgamma -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><em class=emdef>lgamma</em> x</code><br>
-</td></tr><tr><td></td><td>
-This is the lgamma function from the math library.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>lgamma</em> x<br>
+</pre>
+
+<p>This is the lgamma function from the math library.
+</p>
+<div class="spacer"></div>
<!-- little-endian? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="littleendianp">little-endian?</a></code>
-</td></tr><tr><td></td><td>
-This returns #t if underlying machine is little endian.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
+<pre class="indented">
+<em class=def id="littleendianp">little-endian?</em>
+</pre>
-<!-- save-macros -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="savemacros">save-macros</a> filename</code>
-</td></tr><tr><td></td><td>
-This saves all currently defined <a href="snd.html#kbdmacros">keyboard macros</a> in 'filename'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This returns #t if underlying machine is little endian.
+</p>
+<div class="spacer"></div>
<!-- save-state -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="savestate">save-state</a> filename</code>
-</td></tr><tr><td></td><td>
-This saves the current state of Snd in 'filename'. The saved-state file is a Scheme/Ruby/Forth program that when loaded
+<pre class="indented">
+<em class=def id="savestate">save-state</em> filename
+</pre>
+
+<p>This saves the current state of Snd in 'filename'. The saved-state file is a Scheme/Ruby/Forth program that when loaded
into Snd, recreates the state of Snd (as far as possible) at the point of the save.
<a href="#savestatehook">save-state-hook</a> is called during the saving process (once on each temp file),
and <a href="#aftersavestatehook">after-save-state-hook</a> is called afterwards.
'filename' defaults to <a href="#savestatefile">save-state-file</a> which itself defaults to "saved-snd.scm"
or some variant thereof.
-<br><br>
-There are a variety of
-limitations to this process; the worst is that save-state does not try to save hook values or global variable values —
-see also <a href="#ptreechannel">ptree-channel</a> in this regard.
+</p>
+
+<p>There are a variety of
+limitations to this process; the worst is that save-state does not try to save hook values or global variable values.
If you call save-state with active regions, and have the region browser running all the time, and subsequently
want to back up to the saved state, it's safer to delete all the regions first (via <a href="#forgetregion">forget-region</a>),
then load the saved-state file.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- script-arg -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="scriptarg">script-arg</a></code>
-</td></tr><tr><td></td><td>
-This is the current startup argument number (normally 1). See <a href="grfsnd.html#sndwithnogui">Snd as a script engine</a> and snd-test.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="scriptarg">script-arg</em>
+</pre>
+
+<p>This is the current startup argument number (normally 1). See <a href="grfsnd.html#sndwithnogui">Snd as a script engine</a> and snd-test.scm.
+</p>
+<div class="spacer"></div>
<!-- script-args -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="scriptargs">script-args</a></code>
-</td></tr><tr><td></td><td>
-This returns the startup arguments as a list of strings. See <a href="grfsnd.html#sndwithnogui">Snd as a script engine</a> and snd-test.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="scriptargs">script-args</em>
+</pre>
+
+<p>This returns the startup arguments as a list of strings. See <a href="grfsnd.html#sndwithnogui">Snd as a script engine</a> and snd-test.scm.
+</p>
+<div class="spacer"></div>
<!-- snd-error -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="snderror">snd-error</a> str</code>
-</td></tr><tr><td></td><td>
-This throws 'snd-error with the error message 'str'. It provides a way to dive directly into
+<pre class="indented">
+<em class=def id="snderror">snd-error</em> str
+</pre>
+
+<p>This throws 'snd-error with the error message 'str'. It provides a way to dive directly into
Snd's error handling mechanism.
See also <a href="#muserrorhook">mus-error-hook</a> and <a href="#snderrorhook">snd-error-hook</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- snd-help -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndhelp">snd-help</a> obj <em class=narg>(formatted #t)</em></code>
-</td></tr><tr><td></td><td>
-This returns the help text associated with 'obj':
-<pre>
- Scheme:
- :<em class=typing>(snd-help 'open-sound)</em> ; or "open-sound"
- <em class=listener>"(open-sound filename) opens filename (as if opened from File:Open menu option),
- and returns the new sound's index"</em>
+<pre class="indented">
+<em class=def id="sndhelp">snd-help</em> obj (formatted #t)
+</pre>
- Ruby:
- :<em class=typing>snd_help("close_sound")</em> ; or :open_sound
- <em class=listener>close_sound((snd false)): close snd</em>
+<p>This returns the help text associated with 'obj':
+</p>
+
+<pre class="indented">
+Scheme:
+> (snd-help 'open-sound) ; or "open-sound"
+"(open-sound filename) opens filename (as if opened from File:Open menu option),
+and returns the new sound's index"
+
+Ruby:
+:snd_help("close_sound") ; or :open_sound
+close_sound((snd false)): close snd
- Forth:
- snd> <em class=typing>"revert-sound" snd-help</em>
- <em class=listener>(revert-sound (snd #f)): revert snd to its unedited state (undo all)</em>
+Forth:
+snd> "revert-sound" snd-help
+(revert-sound (snd #f)): revert snd to its unedited state (undo all)
</pre>
-If no help string can be found, or if the name doesn't come close to any currently defined name,
+
+<p>If no help string can be found, or if the name doesn't come close to any currently defined name,
snd-help runs through the current load path searching *.scm (or *.rb) files for a definition
of that name. So, if you haven't loaded dsp.scm:
-<pre>
- :<em class=typing>(snd-help "volterra-filter")</em>
- <em class=listener>"volterra-filter is not defined; it appears to be defined in:
- /home/bil/cl/dsp.scm:1936:(define (volterra-filter flt x) <!-- ) -->
- and documented at sndscm.html#volterrafilter"</em>
+</p>
+
+<pre class="indented">
+> (snd-help "volterra-filter")
+"volterra-filter is not defined; it appears to be defined in:
+/home/bil/cl/dsp.scm:1936> (define (volterra-filter flt x) <!-- ) -->
+and documented at sndscm.html#volterrafilter"
</pre>
-snd-help tries to be smart about minor mispellings:
-<pre>
- :<em class=typing>(snd-help "close-soud")</em>
- <em class=listener>"(close-sound (snd #f)): close snd
- Other possibilities:
- close-sound is defined; it is documented at extsnd.html#closesound"</em>
+
+<p>snd-help tries to be smart about minor mispellings:
+</p>
+
+<pre class="indented">
+> (snd-help "close-soud")
+"(close-sound (snd #f)): close snd
+Other possibilities:
+close-sound is defined; it is documented at extsnd.html#closesound"
</pre>
-To go to the
+
+<p>To go to the
HTML documentation for a given object, load <a href="sndscm.html#indexdoc">index.scm</a> and use the html function.
-<br><br>
-Normally snd-help adds carriage-returns to fit the current size of the listener; to
+</p>
+
+<p>Normally snd-help adds carriage-returns to fit the current size of the listener; to
get the raw string instead, set the argument 'formatted' to #f (or use s7's help function).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
+<!-- snd-version -->
+<pre class="indented">
+<em class=def id="sndversion">snd-version</em>
+</pre>
+
+<p>This is a string giving the current Snd version.
+</p>
+<div class="spacer"></div>
+
+
<!-- *snd-opened-sound* -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndopenedsound">*snd-opened-sound*</a></code>
-</td></tr><tr><td></td><td>
-When a sound file is opened, Snd looks for a file with the same
+<pre class="indented">
+<em class=def id="sndopenedsound">*snd-opened-sound*</em>
+</pre>
+
+<p>When a sound file is opened, Snd looks for a file with the same
name but with an appended ".scm" extension. If such a file is found,
it is loaded automatically. The variable *snd-opened-sound* is set to
the newly opened sound (the object). This supports the snd-memo feature
@@ -12554,117 +13223,132 @@ or whatever that you want associated with a particular sound. Confusingly
enough, this is a variable, unlike all the others — that is, you
refer to it directly, not as a procedure call. Say we have a sound file "now.snd",
and we want it to use the grid-graph whenever it is viewed. We make "now.snd.scm"
-and put in it: <code>(set! (show-grid *snd-opened-sound*) #t)</code>. When "now.snd" is
+and put in it: (set! (show-grid *snd-opened-sound*) #t). When "now.snd" is
opened, "now.snd.scm" is loaded automatically with *snd-opened-sound* holding the sound object of "now.snd".
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- snd-print -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndprint">snd-print</a> str</code>
-</td></tr><tr><td></td><td>
-This displays 'str' in the listener, then returns 'str'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="sndprint">snd-print</em> str
+</pre>
+
+<p>This displays 'str' in the listener, then returns 'str'.
+</p>
+<div class="spacer"></div>
<!-- snd-tempnam -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndtempnam">snd-tempnam</a></code>
-</td></tr><tr><td></td><td>
-This returns a new temp file name using Snd's <a href="#tempdir">temp-dir</a>.
-<pre>
- <em class=listener>:</em><em class=typing>(temp-dir)</em>
- <em class=listener>"/home/bil/zap/tmp"</em>
- <em class=listener>:</em><em class=typing>(snd-tempnam)</em>
- <em class=listener>"/home/bil/zap/tmp/snd_7000_2.snd"</em>
+<pre class="indented">
+<em class=def id="sndtempnam">snd-tempnam</em>
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>This returns a new temp file name using Snd's <a href="#tempdir">temp-dir</a>.
+</p>
+
+<pre class="indented">
+> (temp-dir)
+"/home/bil/zap/tmp"
+> (snd-tempnam)
+"/home/bil/zap/tmp/snd_7000_2.snd"
+</pre>
+<div class="spacer"></div>
<!-- snd-url -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndurl">snd-url</a> name</code>
-</td></tr><tr><td></td><td>
-This is the url (in the Snd documentation) corresponding to 'name'; 'name' can be a string or a symbol.
-<pre>
- <em class=listener>:</em><em class=typing>(snd-url 'open-sound)</em>
- <em class=listener>"extsnd.html#opensound"</em>
+<pre class="indented">
+<em class=def id="sndurl">snd-url</em> name
+</pre>
+
+<p>This is the url (in the Snd documentation) corresponding to 'name'; 'name' can be a string or a symbol.
+</p>
+
+<pre class="indented">
+> (snd-url 'open-sound)
+"extsnd.html#opensound"
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- snd-urls -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndurls">snd-urls</a></code>
-</td></tr><tr><td></td><td>
-This returns a list of lists, each inner list containing a Snd function name (as a string) and its associated url in the Snd documentation.
-<pre>
- :<em class=typing>(assoc "open-sound" (snd-urls))</em>
- <em class=listener>: ("open-sound" . "extsnd.html#opensound")</em>
+<pre class="indented">
+<em class=def id="sndurls">snd-urls</em>
+</pre>
+
+<p>This returns a list of lists, each inner list containing a Snd function name (as a string) and its associated url in the Snd documentation.
+</p>
+
+<pre class="indented">
+> (assoc "open-sound" (snd-urls))
+("open-sound" . "extsnd.html#opensound")
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- snd-warning -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndwarning">snd-warning</a> str</code>
-</td></tr><tr><td></td><td>
-This posts a 'str' in the minibuffer and returns 'str'.
+<pre class="indented">
+<em class=def id="sndwarning">snd-warning</em> str
+</pre>
+
+<p>This posts a 'str' in the status area and returns 'str'.
See also <a href="#sndwarninghook">snd-warning-hook</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- unbind-key -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="unbindkey">unbind-key</a> key state <em class=narg>extended</em></code>
-</td></tr><tr><td></td><td>
-This causes 'key' with modifiers 'state' and 'extended' to revert to its built-in default.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="unbindkey">unbind-key</em> key state extended
+</pre>
+<p>This causes 'key' with modifiers 'state' and 'extended' to revert to its built-in default.
+</p>
+<div class="spacer"></div>
-</table>
-<br>
-<!-- ---------------------------------------- CONSTANTS ---------------------------------------- -->
+<!-- CONSTANTS -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndconstants">Constants</a></h3></td></tr></table>
+<div class="header" id="sndconstants">Constants</div>
-<p><b>Sndlib</b> (see <a href="sndlib.html#sndlibxen">sndlib.html</a> for a complete list):</p>
-<pre>
- mus-next mus-aifc mus-riff mus-rf64 mus-nist mus-raw mus-ircam mus-aiff
- mus-bicsf mus-soundfont mus-voc mus-svx mus-caff
+<p id="musoutformat"><b>Sndlib</b> (see <a href="sndlib.html#sndlibxen">sndlib.html</a> for a complete list):
+</p>
+
+<pre class="indented">
+mus-next mus-aifc mus-riff mus-rf64 mus-nist mus-raw mus-ircam mus-aiff
+mus-bicsf mus-soundfont mus-voc mus-svx mus-caff
- mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat
- mus-lfloat mus-bint mus-lint mus-b24int mus-l24int mus-bdouble mus-ldouble
- mus-ubshort mus-ulshort
+mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat
+mus-lfloat mus-bint mus-lint mus-b24int mus-l24int mus-bdouble mus-ldouble
+mus-ubshort mus-ulshort
- <a name="musoutformat">mus-out-format</a>
+mus-out-format
</pre>
<p><b>Time domain graph type</b> (<a href="#timegraphtype">time-graph-type</a>):</p>
-<pre>
- graph-once <a class=quiet href="snd.html#wavogram" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/wavo.png\' width=\'640\' height=\'250\'>', TITLE, 'graph-as-wavogram', ABOVE, true)">graph-as-wavogram</a>
+<pre class="indented">
+ graph-once <a class=quiet href="snd.html#wavogram">graph-as-wavogram</a>
</pre>
<p><b>Transform graph type</b> (the Transform Options Display choice, <a href="#transformgraphtype">transform-graph-type</a>):</p>
-<pre>
+<pre class="indented">
graph-once graph-as-sonogram graph-as-spectrogram
</pre>
<p><b>Transform type</b> (<a href="#transformtype">transform-type</a>):</p>
-<pre>
- <a name="fouriertransform">fourier-transform</a> wavelet-transform cepstrum haar-transform
+<pre class="indented">
+ fourier-transform wavelet-transform cepstrum haar-transform
autocorrelation walsh-transform
</pre>
<p><b>Transform normalization</b> (<a href="#normalizefft">transform-normalization</a>):</p>
-<pre>
+<pre class="indented">
dont-normalize normalize-by-channel normalize-by-sound normalize-globally
</pre>
<p><b>FFT Window</b> type (<a href="#fftwindow">fft-window</a>):</p>
-<pre>
+<pre class="indented">
rectangular-window hann(ing)-window welch-window parzen-window
bartlett-window hamming-window blackman2-window blackman3-window
blackman4-window exponential-window riemann-window kaiser-window
@@ -12678,63 +13362,63 @@ This causes 'key' with modifiers 'state' and 'extended' to revert to its built-i
</pre>
<p><b>Zoom Focus</b> style (<a href="#zoomfocusstyle">zoom-focus-style</a>):</p>
-<pre>
+<pre class="indented">
zoom-focus-left zoom-focus-right zoom-focus-active zoom-focus-middle
</pre>
<p><b>X-axis Label</b> (<a href="#xaxisstyle">x-axis-style</a>):</p>
-<pre>
+<pre class="indented">
x-axis-in-seconds x-axis-in-samples x-axis-as-percentage x-axis-in-beats x-axis-in-measures x-axis-as-clock
</pre>
<p><b>Speed Control</b> style (<a href="#speedstyle">speed-control-style</a>, <a href="#viewfilesspeedstyle">view-files-speed-style</a>):</p>
-<pre>
+<pre class="indented">
speed-control-as-float speed-control-as-ratio speed-control-as-semitone
</pre>
<p><b>Channel Combination</b> style (<a href="#channelstyle">channel-style</a>):</p>
-<pre>
- <a name="channelstyleconstants">channels-separate</a> channels-combined channels-superimposed
+<pre class="indented">
+ channels-separate channels-combined channels-superimposed
</pre>
<p><b>Envelope Editor</b> target (<a href="#envedtarget">enved-target</a>):</p>
-<pre>
+<pre class="indented">
enved-amplitude enved-spectrum enved-srate
</pre>
<p><b>Envelope Editor</b> ramp choice (<a href="#envedstyle">enved-style</a>):</p>
-<pre>
+<pre class="indented">
envelope-linear envelope-exponential
</pre>
<p><b>Graph Line</b> style (<a href="#graphstyle">graph-style</a>):</p>
-<pre>
- <a name="graphlines">graph-lines</a> graph-dots graph-filled graph-lollipops
+<pre class="indented">
+ graph-lines graph-dots graph-filled graph-lollipops
graph-dots-and-lines
</pre>
<p><b>Key binding</b> cursor action (<a href="#bindkey">bind-key</a>):</p>
-<pre>
- <a name="cursorchoices">cursor-in-view</a> cursor-on-left cursor-on-right cursor-in-middle keyboard-no-action
+<pre class="indented">
+ cursor-in-view cursor-on-left cursor-on-right cursor-in-middle keyboard-no-action
</pre>
<p><b>Cursor</b> style (<a href="#cursorstyle">cursor-style</a>):</p>
-<pre>
+<pre class="indented">
cursor-cross cursor-line
</pre>
<p><b>Axis placement</b> choice (<a href="#showaxes">show-axes</a>):</p>
-<pre>
+<pre class="indented">
show-all-axes show-no-axes show-x-axis show-all-axes-unlabelled show-x-axis-unlabelled show-bare-x-axis
</pre>
<p><b>Graph</b> id (for <a href="#ytoposition">y->position</a> etc):</p>
-<pre>
+<pre class="indented">
time-graph transform-graph lisp-graph
</pre>
<p><b>Colormap</b> choice (<a href="#colormap">colormap</a>):</p>
-<pre>
+<pre class="indented">
black-and-white-colormap gray-colormap hot-colormap cool-colormap
bone-colormap copper-colormap pink-colormap jet-colormap
prism-colormap autumn-colormap winter-colormap spring-colormap
@@ -12742,16 +13426,16 @@ This causes 'key' with modifiers 'state' and 'extended' to revert to its built-i
</pre>
<p><b>Graphics context</b> choice (<a href="#graphdata">graph-data</a>)</p>
-<pre>
+<pre class="indented">
copy-context cursor-context selection-context mark-context
</pre>
-<br>
-<!-- ---------------------------------------- ERRORS ---------------------------------------- -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="snderrors">Errors and Debugging</a></h3></td></tr></table>
+<!-- ERRORS -->
+
+<div class="header" id="snderrors">Errors and debugging</div>
<!-- INDEX snderrors:Debugging (Scheme) -->
<p>When something goes awry, the various functions can throw an error (a symbol)
@@ -12760,27 +13444,34 @@ but without the embarrassment). It prints out some message,
and sometimes appends a stack trace. So, as an example, selection-position
throws 'no-active-selection if there isn't a selection:
</p>
-<pre>
- ><em class=typing>(selection-position)</em>
- <em class=listener>selection-position: no-active-selection</em>
- ><em class=typing>asdf</em>
- <em class=listener>Unbound variable: asdf</em>
+
+<pre class="indented">
+> (selection-position)
+selection-position: no-active-selection
+> asdf
+Unbound variable: asdf
</pre>
+
<p>But there are cases where you'd rather handle an error (or all errors) specially.
-In the case of 'no-active-selection, we set up our own handler for that as follows:</p>
-<pre>
-><em class=typing>(catch 'no-active-selection
- (lambda ()
- (+ 1 (<a class=quiet href="#selectionposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionposition_tip)">selection-position</a>)))
- (lambda (tag val) 0))</em>
-<em class=listener>0</em>
+In the case of 'no-active-selection, we set up our own handler for that as follows:
+</p>
+
+<pre class="indented">
+> (catch 'no-active-selection
+ (lambda ()
+ (+ 1 (<a class=quiet href="#selectionposition">selection-position</a>)))
+ (lambda (tag val) 0))
+0
</pre>
+
<p>Here we've caught 'no-active-selection (if it occurs within the
first thunk's body), and return 0 if it occurs; otherwise we return
-<code>(+ 1 (<a class=quiet href="#selectionposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionposition_tip)">selection-position</a>))</code>. Scheme has a number
+(+ 1 (<a class=quiet href="#selectionposition">selection-position</a>)). Scheme has a number
of errors such as 'out-of-range, 'wrong-type-arg, 'numerical-overflow,
-etc. The Snd-specific errors are:</p>
-<pre>
+etc. The Snd-specific errors are:
+</p>
+
+<pre class="indented">
'no-such-channel 'no-such-sound 'no-such-mark 'no-such-mix
'no-such-menu 'no-such-file 'no-such-region 'no-such-sample
'no-such-edit 'cannot-save 'no-such-envelope 'no-active-selection
@@ -12790,55 +13481,61 @@ etc. The Snd-specific errors are:</p>
'gsl-error 'no-such-key 'no-such-direction 'cannot-parse
'no-such-colormap
</pre>
-<p><code>bad-arity</code> is jargon indicating that a procedure has been passed the
-wrong number of arguments. <code>gsl-error</code> indicates that the GSL
+
+<p>bad-arity is jargon indicating that a procedure has been passed the
+wrong number of arguments. gsl-error indicates that the GSL
library is the source of the error.
The symbol #t stands for all errors in this case, so we can
-run rough-shod over any error with:</p>
-<pre>
-(defmacro without-errors (func)
+run rough-shod over any error with:
+</p>
+
+<pre class="indented">
+(define-macro (without-errors func)
`(catch #t
(lambda ()
,func)
(lambda args
(car args))))
</pre>
+
<p>You can use these errors in your code, if you like, or add your own. The following
-throws the error 'no-such-file:</p>
-<pre>
+throws the error 'no-such-file:
+</p>
+
+<pre class="indented">
(define look-for-file
(lambda (file)
(or (file-exists? file)
- (throw 'no-such-file (list "look-for-file" file)))))
+ (error 'no-such-file (list "look-for-file" file)))))
</pre>
+
<p>There is one special catch: 'snd-top-level. This is used by the
debuggers to exit the current context, returning up a level in the
stack of listeners. Normally that means you jump out of a breakpoint
-or whatever and find yourself back at the top level. <code>(throw 'snd-top-level)</code>.
+or whatever and find yourself back at the top level. (throw 'snd-top-level).
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="EEFDEE" valign="middle"><h4>s7 debugging</h4></td></tr></table>
+
+<div class="innermostheader">s7 debugging</div>
<p>When s7 hits an error, it prints out a stacktrace as well as the error message.
-The variable *error-info* has additional info. You can also trace functions, and
+The <a href="s7.html#owlet">owlet</a> has additional info. You can also trace functions, and
place breakpoints. See <a href="s7.html">s7.html</a> for further details.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="EEFDEE" valign="middle"><h4>Forth debugging</h4></td></tr></table>
+<div class="innermostheader">Forth debugging</div>
<p>See the debugging section in the fth documentation.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="EEFDEE" valign="middle"><h4>Ruby debugging</h4></td></tr></table>
+
+<div class="innermostheader">Ruby debugging</div>
<p>
-<code>$DEBUG = true</code> turns on the Ruby debugger.
+$DEBUG = true turns on the Ruby debugger.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="EEFDEE" valign="middle"><h4><A NAME="cdebugging">C debugging</a></h4></td></tr></table>
+
+<div class="innermostheader" id="cdebugging">C debugging</div>
<!-- INDEX cdebugging:Debugging (C) -->
<p>If you hit a bug in Snd's C code, you'll need to use gdb
@@ -12846,33 +13543,38 @@ to track it down, or mail me the gory details;
if the error is a segfault, there is probably a file named "core" or "core.nnnn"
on the current directory:
</p>
-<pre>
- gdb snd core
- where
+
+<pre class="indented">
+gdb snd core
+where
</pre>
+
<p>The "where" command displays the stack at the point of the error.
"up", and "down" move around in the stack, and "info locals" prints out
the current frame's variables. If it's not a segfault, you can
</p>
-<pre>
- gdb snd
- run
+
+<pre class="indented">
+gdb snd
+run
</pre>
+
<p>Then get the error to happen, at which point you should fall into gdb
where you can type "where" and so on. If the problem involves X, you
may need to run -sync. If Gtk, run --g-fatal-errors. If Snd gets hung
-and you need to type C-C to get out,
+and you need to type C-C to get out (that is, C-g doesn't interrupt the loop),
</p>
-<pre>
- gdb snd
- break exit
- run
+
+<pre class="indented">
+gdb snd
+break exit
+run
</pre>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="appearance">Customizing Snd's appearance</a></h3></td></tr></table>
+
+<div class="header" id="appearance">Customizing Snd's appearance</div>
<p>Snd's overall appearance is controlled first by the startup <a href="grfsnd.html#sndswitches">switches</a> that
choose the outermost widget; normally this is a paned window with a sound
@@ -12884,167 +13586,115 @@ There are a variety of functions and variables related to widget colors and so f
</p>
-<!-- ---------------------------------------- COLORS ---------------------------------------- -->
+<!-- COLORS -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h4><A NAME="colors">Colors</a></h4></td></tr></table>
+<div class="header" id="colors">Colors</div>
<p>A color in Snd is an object with three fields representing the
rgb (red green blue) settings as numbers between 0.0 and 1.0. A color
-object is created via make-color:</p>
-<pre>
- ><em class=typing>(define blue (<a class=quiet href="#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 0 1))</em>
+object is created via make-color:
+</p>
+
+<pre class="indented">
+> (define blue (<a class=quiet href="#makecolor">make-color</a> 0 0 1))
</pre>
+
<p>This declares the Scheme variable "blue" and gives it the value
of the color whose rgb components include only blue in full force.
The X11 color names are defined in <a href="sndscm.html#rgbdoc">rgb.scm</a>. The overall
widget background color is basic-color.
</p>
-<pre>
- ><em class=typing>(set! (<a class=quiet href="#basiccolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_basiccolor_tip)">basic-color</a>) blue)</em>
+
+<pre class="indented">
+> (set! (<a class=quiet href="#basiccolor">basic-color</a>) blue)
</pre>
<p>The color variables
-are:</p>
-
-<table border=2 bordercolor="#f2f4ff" cellpadding=6 hspace=10><tr><td>
-<table border=0 cellpadding=0 cellspacing=0 hspace=20>
-
-<tr><td bgcolor="#f2f4ff"><code><a class=def name="axiscolor">axis-color</a></code></td><td width=20 bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>defaults to current data color</code></td><td width=20 bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">color of axes</td></tr>
-
-<tr><td><code><a class=def name="basiccolor">basic-color</a></code></td><td></td>
- <td><code>ivory2</code></td><td></td>
- <td>main Snd color.</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><a class=def name="combineddatacolor">combined-data-color</a></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>depends on channel number</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">color of channel data if channels-combined</td></tr>
-
-<tr><td><code><a class=def name="cursorcolor">cursor-color</a></code></td><td></td>
- <td><code>red</code></td><td></td>
- <td>graph cursor color.</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><a class=def name="datacolor">data-color</a></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>black</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">color of data in unselected graph.</td></tr>
-
-<tr><td><code><em class=emdef>enved-waveform-color</em></code></td><td></td>
- <td><code>blue</code></td><td></td>
- <td>color of waveform displayed in envelope editor.</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><em class=emdef>filter-control-waveform-color</em></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>blue</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">color of control panel filter waveform.</td></tr>
-
-<tr><td><code><a class=def name="graphcolor">graph-color</a></code></td><td></td>
- <td><code>white</code></td><td></td>
- <td>background color of unselected graph.</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><a class=def name="highlightcolor">highlight-color</a></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>ivory1</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">highlighting color.</td></tr>
-
-<tr><td><code><em class=emdef>listener-color</em></code></td><td></td>
- <td><code>aliceblue</code></td><td></td>
- <td>background color of listener.</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><em class=emdef>listener-text-color</em></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>black</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">text color in listener.</td></tr>
-
-<tr><td><code><a class=def name="markcolor">mark-color</a></code></td><td></td>
- <td><code>red</code></td><td></td>
- <td>color of mark indicator.</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><em class=emdef>mix-color</em></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>darkgray</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">color of mix waveforms.</td></tr>
-
-<tr><td><code><a class=def name="positioncolor">position-color</a></code></td><td></td>
- <td><code>ivory3</code></td><td></td>
- <td>position slider color</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><a class=def name="sashcolor">sash-color</a></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>lightgreen</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">color of paned window sashes.</td></tr>
-
-<tr><td><code><a class=def name="selecteddatacolor">selected-data-color</a></code></td><td></td>
- <td><code>black</code></td><td></td>
- <td>color of data in currently selected graph.</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><a class=def name="selectedgraphcolor">selected-graph-color</a></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>white</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">background color of currently selected graph.</td></tr>
-
-<tr><td><code><a class=def name="selectioncolor">selection-color</a></code></td><td></td>
- <td><code>lightsteelblue1</code></td><td></td>
- <td>color of selected portion of graph.</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><code><a class=def name="textfocuscolor">text-focus-color</a></code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff"><code>white</code></td><td bgcolor="#f2f4ff"></td>
- <td bgcolor="#f2f4ff">color of text field when it has focus.</td></tr>
-
-<tr><td><code><a class=def name="zoomcolor">zoom-color</a></code></td><td></td>
- <td><code>ivory4</code></td><td></td>
- <td>zoom slider color.</td></tr>
+are:
+</p>
-</table>
-</td></tr></table>
+<pre class="indented">
+<em class=def id="axiscolor">axis-color</em> black color of axes
+<em class=def id="basiccolor">basic-color</em> ivory2 main Snd color.
+<em class=def id="combineddatacolor">combined-data-color</em> black color of channel data if channels-combined
+<em class=def id="cursorcolor">cursor-color</em> red graph cursor color.
+<em class=def id="datacolor">data-color</em> black color of data in unselected graph.
+<em class=emdef>enved-waveform-color</em> blue color of waveform displayed in envelope editor.
+<em class=emdef>filter-control-waveform-color</em> blue color of control panel filter waveform.
+<em class=def id="graphcolor">graph-color</em> white background color of unselected graph.
+<em class=def id="highlightcolor">highlight-color</em> ivory1 highlighting color.
+<em class=emdef>listener-color</em> aliceblue background color of listener.
+<em class=emdef>listener-colorized</em> #f is syntax highlighting in effect.
+<em class=emdef>listener-text-color</em> black text color in listener.
+<em class=def id="markcolor">mark-color</em> red color of mark indicator.
+<em class=emdef>mix-color</em> darkgray color of mix waveforms.
+<em class=def id="positioncolor">position-color</em> ivory3 position slider color
+<em class=def id="sashcolor">sash-color</em> lightgreen color of paned window sashes.
+<em class=def id="selecteddatacolor">selected-data-color</em> black color of data in currently selected graph.
+<em class=def id="selectedgraphcolor">selected-graph-color</em> white background color of currently selected graph.
+<em class=def id="selectioncolor">selection-color</em> lightsteelblue1 color of selected portion of graph.
+<em class=def id="textfocuscolor">text-focus-color</em> white color of text field when it has focus.
+<em class=def id="zoomcolor">zoom-color</em> ivory4 zoom slider color.
+</pre>
<p>I have these lines in my ~/.snd_s7 file:
</p>
-<pre>
- (define beige (<a class=quiet href="#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0.96 0.96 0.86))
- (define blue (<a class=quiet href="#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 0 1))
- (set! (<a class=quiet href="#selectedgraphcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedgraphcolor_tip)">selected-graph-color</a>) beige)
- (set! (<a class=quiet href="#selecteddatacolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selecteddatacolor_tip)">selected-data-color</a>) blue)
+
+<pre class="indented">
+(define beige (<a class=quiet href="#makecolor">make-color</a> 0.96 0.96 0.86))
+(define blue (<a class=quiet href="#makecolor">make-color</a> 0 0 1))
+(set! *selected-graph-color* beige)
+(set! *selected-data-color* blue)
</pre>
+
<p>In Forth (~/.snd_forth) this is:
</p>
-<pre>
- 0.96 0.96 0.86 make-color ( beige ) set-selected-graph-color drop
- 0.00 0.00 1.00 make-color ( blue ) set-selected-data-color drop
+
+<pre class="indented">
+0.96 0.96 0.86 make-color ( beige ) set-selected-graph-color drop
+0.00 0.00 1.00 make-color ( blue ) set-selected-data-color drop
</pre>
+
<p>And in Ruby (~/.snd_ruby):
</p>
-<pre>
- beige = make_color 0.96, 0.96, 0.86
- blue = make_color 0, 0, 1
- set_selected_graph_color beige
- set_selected_data_color blue
+
+<pre class="indented">
+beige = make_color 0.96, 0.96, 0.86
+blue = make_color 0, 0, 1
+set_selected_graph_color beige
+set_selected_data_color blue
</pre>
<p>combined-data-color is slightly special. It takes two arguments, the sound and channel number, and applies to the
-channel's data only if the graphs are superimposed, when <a href="#channelstyle">channel-style</a> is <code>channels-combined</code>.
+channel's data only if the graphs are superimposed, when <a href="#channelstyle">channel-style</a> is channels-combined.
</p>
-
<!-- INDEX colors:Colors -->
-<TABLE border=3 bordercolor="tan" hspace=40 vspace=10><tr><td>
-<blockquote><small><br>
+<TABLE class="method">
+<tr><th class="title"><a class=quiet href="extsnd.html#colors">Colors</a></th></tr>
+<tr><td>
+<blockquote><small>
Other color-related stuff:<br>
Color names: <a href="sndscm.html#rgbdoc">rgb.scm, rgb.rb</a><br>
colors in the file dialogs: install-searcher-with-colors in snd-motif.scm<br>
-color-orientation-dialog: <a href="#colororientationdialog">color-orientation-dialog</a><br>
+color-orientation-dialog: <a href="extsnd.html#colororientationdialog">color-orientation-dialog</a><br>
colored samples: <a href="sndscm.html#drawdoc">display-colored-samples</a> and others in draw.scm<br>
colored edits: <a href="sndscm.html#drawdoc">display-previous-edits</a> in draw.scm<br>
colored marks: mark-sync-color in snd-motif.scm<br>
colors in rxvt: red-text et al in examp.scm<br>
flashing colors: flash-selected-data in examp.scm<br>
openGL: snd-gl.scm, <a href="grfsnd.html#sndandgl">Snd and OpenGL</a><br>
-fancy widget backgrounds: new-backgrounds.scm in the tutorial<br>
-color hook: <a href="#colorhook">color-hook</a><br>
-Snd graphics contexts: <a href="#sndgcs">snd-gcs</a><br>
-<br></small></blockquote>
+color hook: <a href="extsnd.html#colorhook">color-hook</a><br>
+Snd graphics contexts: <a href="extsnd.html#sndgcs">snd-gcs</a><br>
+</small></blockquote>
</td></tr></TABLE>
-<br><br>
-<!-- ---------------------------------------- FONTS ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h4><A NAME="fonts">Fonts</a></h4></td></tr></table>
+<!-- FONTS -->
+
+<div class="header" id="fonts">Fonts</div>
<p>Fonts in Snd are strings containing a description of the
desired font. These can be the abbreviated forms such as
@@ -13052,43 +13702,44 @@ desired font. These can be the abbreviated forms such as
In Gtk, the font names resemble "Monospace 10", etc.
The font variables are:
</p>
-<table cellpadding=0 cellspacing=0 hspace=20>
-<tr><td width=200><code><a class=def name="axislabelfont">axis-label-font</a></code></td><td>used in axis labels</td></tr>
-<tr><td><code><a class=def name="axisnumbersfont">axis-numbers-font</a></code></td><td>used in axis tick numbers</td></tr>
-<tr><td><code><a class=def name="boldpeaksfont">bold-peaks-font</a></code></td><td>used by fft peaks display</td></tr>
-<tr><td><code><a class=def name="peaksfont">peaks-font</a></code></td><td>used by fft peaks display</td></tr>
-<tr><td><code><em class=emdef>listener-font</em></code></td><td>listener font</td></tr>
-<tr><td><code><a class=def name="tinyfont">tiny-font</a></code></td><td>smallest font used</td></tr>
-</table>
-<br>
-<table border=0 cellpadding=5 hspace=20>
-<tr><td><pre>
-(set! (<a class=quiet href="#listenerfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_listenerfont_tip)">listener-font</a>) "9x15")
-(set! (<a class=quiet href="#axislabelfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_axislabelfont_tip)">axis-label-font</a>) "-*-times-medium-r-normal-*-18-*-*-*-*-*-*-*")
-(set! (<a class=quiet href="#axisnumbersfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_axisnumbersfont_tip)">axis-numbers-font</a>) "9x15")
-</pre></td></tr></table>
+
+<pre class="indented">
+<em class=def id="axislabelfont">axis-label-font</em> used in axis labels
+<em class=def id="axisnumbersfont">axis-numbers-font</em> used in axis tick numbers
+<em class=def id="boldpeaksfont">bold-peaks-font</em> used by fft peaks display
+<em class=def id="peaksfont">peaks-font</em> used by fft peaks display
+<em class=emdef>listener-font</em> listener font
+<em class=def id="tinyfont">tiny-font</em> smallest font used
+</pre>
+
+<pre class="indented">
+(set! (<a class=quiet href="#listenerfont">listener-font</a>) "9x15")
+(set! (<a class=quiet href="#axislabelfont">axis-label-font</a>) "-*-times-medium-r-normal-*-18-*-*-*-*-*-*-*")
+(set! (<a class=quiet href="#axisnumbersfont">axis-numbers-font</a>) "9x15")
+</pre>
<p>See also <a href="#currentfont">current-font</a> below.
If the requested font can't be loaded, the set! statement returns the old (unchanged) font name.
</p>
-<pre>
- ><em class=typing>(set! (axis-label-font) "8x14")</em>
- <em class=listener>"-*-times-medium-r-normal-*-18-*-*-*-*-*-*-*"</em>
+
+<pre class="indented">
+> (set! (axis-label-font) "8x14")
+"-*-times-medium-r-normal-*-18-*-*-*-*-*-*-*"
</pre>
-<br>
-<br>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><h4><A NAME="graphics">Graphics</a></h4></td></tr></table>
-<!-- -------------------------------- GRAPHICS -------------------------------- -->
-<table border=0 cellspacing=4 cellpadding=6 hspace=10>
+<div class="header" id="graphics">Graphics</div>
+
+<!-- GRAPHICS -->
+<div class="spacer"></div>
<!-- add-colormap -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="addcolormap">add-colormap</a> name func</code>
-</td></tr><tr><td></td><td>
-add-colormap adds a new colormap to the colormap table, returning the colormap object (for
+<pre class="indented">
+<em class=def id="addcolormap">add-colormap</em> name func
+</pre>
+
+<p>add-colormap adds a new colormap to the colormap table, returning the colormap object (for
use with <a href="#colormap">colormap</a> or <a href="#colormapref">colormap-ref</a>).
'name' is the name displayed in the Color/Orientation Dialog's list of colormaps.
'func' is a function of one argument, the desired colormap size; it will be
@@ -13098,316 +13749,371 @@ three vcts, each vct containing 'size' values representing respectively
the red, green, and blue values (each a number between 0.0 and 1.0).
In the following code, the fields are set from envelopes (this is a loose translation
of FractInt's royal colormap):
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(add-colormap "purple"
(lambda (size)
- (let ((r (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (g (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (b (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
+ (let ((r (make-float-vector size 0.0))
+ (g (make-float-vector size 0.0))
+ (b (make-float-vector size 0.0))
(incr (/ 256.0 size))
(er (list 0 60 60 116 128 252 192 252 256 60))
(eg (list 0 0 64 0 128 252 192 252 256 0))
(eb (list 0 80 128 252 192 0 256 80)))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x incr)))
((= i size))
- (set! (r i) (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x er) 256.0)) ; from env.scm
- (set! (g i) (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x eg) 256.0))
- (set! (b i) (/ (<a class=quiet href="sndscm.html#envelopeinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_envelopeinterp_tip)">envelope-interp</a> x eb) 256.0)))
+ (set! (r i) (/ (<a class=quiet href="sndscm.html#envelopeinterp">envelope-interp</a> x er) 256.0)) ; from env.scm
+ (set! (g i) (/ (<a class=quiet href="sndscm.html#envelopeinterp">envelope-interp</a> x eg) 256.0))
+ (set! (b i) (/ (<a class=quiet href="sndscm.html#envelopeinterp">envelope-interp</a> x eb) 256.0)))
(list r g b))))
;;; another amusing colormap from FractInt:
(add-colormap "cos"
(lambda (size)
- (let ((r (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (g (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (b (<a class=quiet href="#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
+ (let ((r (make-float-vector size 0.0))
+ (g (make-float-vector size 0.0))
+ (b (make-float-vector size 0.0))
(incr (/ 3.14159 size)))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x incr)))
((= i size))
(set! (r i) (abs (sin (* 1.5 x))))
(set! (g i) (abs (sin (* 3.5 x))))
(set! (b i) (abs (sin (* 2.5 x)))))
(list r g b))))
-</pre></td></tr></table>
+</pre>
<table><tr>
<td><img src="pix/coscolor.png" alt="colormaps"></td>
-<td><img src="pix/jetcolor.png" alt="colormaps"></td>
-<td><img src="pix/hotcolor.png" alt="colormaps"></td>
+<td><img class="indented" src="pix/jetcolor.png" alt="colormaps"></td>
+<td><img class="indented" src="pix/hotcolor.png" alt="colormaps"></td>
</tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- background-gradient -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="backgroundgradient">background-gradient</a></code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="backgroundgradient">background-gradient</em>
+</pre>
+
<p>In Gtk versions of Snd, this is the amount of background color gradient in the channel graphs (0.0, the default, means
no gradient).
</p>
-<img src="pix/bggrad.png" alt="graph with background gradient" vspace=10>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<img class="indented" src="pix/bggrad.png" alt="graph with background gradient">
+
+<div class="spacer"></div>
<!-- color? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colorp">color?</a> obj</code>
-</td></tr><tr><td></td><td>
-This returns #t if 'obj' is a color (a Pixel in xm jargon); see <a href="#makecolor">make-color</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="colorp">color?</em> obj
+</pre>
+
+<p>This returns #t if 'obj' is a color (a Pixel in xm jargon); see <a href="#makecolor">make-color</a>.
+</p>
+<div class="spacer"></div>
<!-- color->list -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colortolist">color->list</a> obj</code>
-</td></tr><tr><td></td><td>
-This returns the rgb color components of 'obj' in a list.
-<pre>
- <em class=listener>:</em><em class=typing>(color->list (make-color 1 0 0))</em>
- <em class=listener>(1.0 0.0 0.0)</em>
+<pre class="indented">
+<em class=def id="colortolist">color->list</em> obj
+</pre>
+
+<p>This returns the rgb color components of 'obj' in a list.
+</p>
+
+<pre class="indented">
+ > (color->list (make-color 1 0 0))
+ (1.0 0.0 0.0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- color-cutoff -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colorcutoff">color-cutoff</a></code>
-</td></tr><tr><td></td><td>
-In spectra, this sets the lowest data value that will be colored (the default is 0.003). Anything less than that
+<pre class="indented">
+<em class=def id="colorcutoff">color-cutoff</em>
+</pre>
+
+<p>In spectra, this sets the lowest data value that will be colored (the default is 0.003). Anything less than that
is rendered in the background color. This is the "data cutoff" slider in the View:Color/Orientation dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- color-inverted -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colorinverted">color-inverted</a></code>
-</td></tr><tr><td></td><td>
-This reflects the 'invert' button in the View:<a href="snd.html#colorbrowser">Color/Orientation</a> dialog.
+<pre class="indented">
+<em class=def id="colorinverted">color-inverted</em>
+</pre>
+
+<p>This reflects the 'invert' button in the View:<a href="snd.html#colorbrowser">Color/Orientation</a> dialog.
If the colormap is inverted, the order of colors is reversed.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- color-scale -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colorscale">color-scale</a></code>
-</td></tr><tr><td></td><td>
-color-scale reflects the darkness setting in the View:<a href="snd.html#colorbrowser">Color/Orientation</a> dialog.
+<pre class="indented">
+<em class=def id="colorscale">color-scale</em>
+</pre>
+
+<p>color-scale reflects the darkness setting in the View:<a href="snd.html#colorbrowser">Color/Orientation</a> dialog.
The mapping between the slider in the dialog and the color-scale value is not linear, and is
currently different in Gtk and Motif.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- colormap -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colormap">colormap</a></code>
-</td></tr><tr><td></td><td>
-This is the colormap choice for various displays, most prominently the transform sonogram and spectrogram,
+<pre class="indented">
+<em class=def id="colormap">colormap</em>
+</pre>
+
+<p>This is the colormap choice for various displays, most prominently the transform sonogram and spectrogram,
and the wavogram.
The built-in maps are:
black-and-white-colormap, gray-colormap, hot-colormap, cool-colormap, bone-colormap,
copper-colormap, pink-colormap, jet-colormap, prism-colormap, autumn-colormap, winter-colormap,
spring-colormap, summer-colormap, rainbow-colormap, flag-colormap, and phases-colormap.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- colormap-name -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colormapname">colormap-name</a> index</code>
-</td></tr><tr><td></td><td>
-colormap-name returns the specified colormap's name.
-<pre>
- <em class=listener>:</em><em class=typing>(colormap-name (colormap))</em>
- <em class=listener>"hot"</em>
+<pre class="indented">
+<em class=def id="colormapname">colormap-name</em> index
+</pre>
+
+<p>colormap-name returns the specified colormap's name.
+</p>
+
+<pre class="indented">
+> (colormap-name (colormap))
+"hot"
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- colormap-ref -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colormapref">colormap-ref</a> map pos</code>
-</td></tr><tr><td></td><td>
-colormap-ref returns the rgb values of the colormap 'map' at position 'pos',
+<pre class="indented">
+<em class=def id="colormapref">colormap-ref</em> map pos
+</pre>
+
+<p>colormap-ref returns the rgb values of the colormap 'map' at position 'pos',
suitable for use with make-color. 'pos' should be a float between
0.0 and 1.0.
See the example above, or samples-via-colormap in draw.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- colormap-size -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colormapsize">colormap-size</a></code>
-</td></tr><tr><td></td><td>
-colormap-size returns (or sets) the current number of colors in each colormap.
+<pre class="indented">
+<em class=def id="colormapsize">colormap-size</em>
+</pre>
+
+<p>colormap-size returns (or sets) the current number of colors in each colormap.
The default is 512.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- colormap->integer -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="colormaptointeger">colormap->integer</a> colormap-object</code>
-</td></tr><tr><td></td><td>
-This function returns the integer corresponding to a given colormap.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="colormaptointeger">colormap->integer</em> colormap-object
+</pre>
+
+<p>This function returns the integer corresponding to a given colormap.
+</p>
+<div class="spacer"></div>
<!-- colormap? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="colormapp">colormap?</a> object</code>
-</td></tr><tr><td></td><td>
-colormap? returns #t if 'object' is a usable colormap.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="colormapp">colormap?</em> object
+</pre>
+
+<p>colormap? returns #t if 'object' is a usable colormap.
+</p>
+<div class="spacer"></div>
<!-- copy-context -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><A class=def NAME="copycontext">copy-context</A></code>
-</td></tr><tr><td></td><td>
-This is the graphics mode (an integer in Snd, not a function) to use to draw over whatever is currently in a graph.
-The "contexts" refer to graphics contexts used throughout Snd; the <code>copy-context</code>
-copies into the current graph, whereas the <code>cursor-context</code> uses XOR.
+<pre class="indented">
+<em class=def id="copycontext">copy-context</em>
+</pre>
+
+<p>This is the graphics mode (an integer in Snd, not a function) to use to draw over whatever is currently in a graph.
+The "contexts" refer to graphics contexts used throughout Snd; the copy-context
+copies into the current graph, whereas the cursor-context uses XOR.
The error thrown for an unimplemented context is 'no-such-graphics-context.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- current-font -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="currentfont">current-font</a> <em class=narg>snd chn context</em></code>
-</td></tr><tr><td></td><td>
-This is the current font (a Font in Motif, a PangoFontDescription* in Gtk+).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="currentfont">current-font</em> snd chn context
+</pre>
+
+<p>This is the current font (a Font in Motif, a PangoFontDescription* in Gtk+).
+</p>
+<div class="spacer"></div>
<!-- cursor-context -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><A class=def NAME="cursorcontext">cursor-context</A></code>
-</td></tr><tr><td></td><td>
-This is the graphics mode (an integer in Snd, not a function) for XOR drawing in the cursor color (for cursors, normally).
+<pre class="indented">
+<em class=def id="cursorcontext">cursor-context</em>
+</pre>
+
+<p>This is the graphics mode (an integer in Snd, not a function) for XOR drawing in the cursor color (for cursors, normally).
See <a href="#xcursor">x-cursor</a> or
<a href="#foregroundcolor">foreground-color</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- delete-colormap -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="deletecolormap">delete-colormap</a> object</code>
-</td></tr><tr><td></td><td>
-delete-colormap deletes the memory associated with the given colormap.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="deletecolormap">delete-colormap</em> object
+</pre>
+
+<p>delete-colormap deletes the memory associated with the given colormap.
+</p>
+<div class="spacer"></div>
<!-- draw-axes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="drawaxes">draw-axes</a> wid gc label x0 x1 y0 y1 style axes cr</code>
-</td></tr><tr><td width=30></td><td>
-This draws axes in the widget 'wid', using the graphics context 'gc', with the x-axis label 'label'
+<pre class="indented">
+<em class=def id="drawaxes">draw-axes</em> wid gc label x0 x1 y0 y1 style axes cr
+</pre>
+
+<p>This draws axes in the widget 'wid', using the graphics context 'gc', with the x-axis label 'label'
going from 'x0' to 'x1' (floats) along the x axis, 'y0' to 'y1' along the y axis, with x-axis-style
-'style' (<code>x-axis-in-seconds</code> etc). Whether axes are actually displayed or just implied
-depends on 'axes', which defaults to <code>show-all-axes</code>. In Gtk, the cairo_t 'cr' argument is not optional;
+'style' (x-axis-in-seconds etc). Whether axes are actually displayed or just implied
+depends on 'axes', which defaults to show-all-axes. In Gtk, the cairo_t 'cr' argument is not optional;
it is ignored in Motif.
draw-axes returns a list of the actual (pixel) axis bounds.
See the scanned-synthesis display code in snd-motif.scm,
or the local envelope editor code in xm-enved.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- draw-dot -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="drawdot">draw-dot</a> x0 y0 dot-size snd chn context cr</code>
-</td></tr><tr><td width=30></td><td>
-This draws a dot at ('x0 y0') of diameter 'dot-size' pixels in the specified context. See musglyphs.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="drawdot">draw-dot</em> x0 y0 dot-size snd chn context cr
+</pre>
+
+<p>This draws a dot at ('x0 y0') of diameter 'dot-size' pixels in the specified context. See musglyphs.scm.
+</p>
+<div class="spacer"></div>
<!-- draw-dots -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="drawdots">draw-dots</a> positions dot-size snd chn context cr</code>
-</td></tr><tr><td></td><td>
-This draws dots of size 'dot-size' from the (x y) pairs in the vector 'positions' in the specified context.
+<pre class="indented">
+<em class=def id="drawdots">draw-dots</em> positions dot-size snd chn context cr
+</pre>
+
+<p>This draws dots of size 'dot-size' from the (x y) pairs in the vector 'positions' in the specified context.
draw-dots, draw-lines, and fill-polygon take vectors, rather than vcts (which would be more consistent
with the rest of Snd) because the values passed are supposed to be short ints.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- draw-line -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="drawline">draw-line</a> x0 y0 x1 y1 snd chn context cr</code>
-</td></tr><tr><td></td><td>
-This draws a line from ('x0 y0') to ('x1 y1') in the specified context.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="drawline">draw-line</em> x0 y0 x1 y1 snd chn context cr
+</pre>
+
+<p>This draws a line from ('x0 y0') to ('x1 y1') in the specified context.
+</p>
+<div class="spacer"></div>
<!-- draw-lines -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="drawlines">draw-lines</a> lines snd chn context cr</code>
-</td></tr><tr><td></td><td>
-This draws lines following the (x y) pairs in the vector 'lines' in the specified context.
+<pre class="indented">
+<em class=def id="drawlines">draw-lines</em> lines snd chn context cr
+</pre>
+
+<p>This draws lines following the (x y) pairs in the vector 'lines' in the specified context.
make-bezier-1 in <a href="sndscm.html#musglyphs">musglyphs.scm</a> can be used to draw Bezier curves.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- draw-string -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="drawstring">draw-string</a> text x0 y0 snd chn context cr</code>
-</td></tr><tr><td></td><td>
-This draws a string ('text') in the current font and foreground color starting at ('x0 y0') in the specified context.
+<pre class="indented">
+<em class=def id="drawstring">draw-string</em> text x0 y0 snd chn context cr
+</pre>
+
+<p>This draws a string ('text') in the current font and foreground color starting at ('x0 y0') in the specified context.
The next procedures use the channel-property list to maintain a list
of sample-oriented comments, displaying a given comment if its associated sample is
currently in the time-domain graph:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
-(define* (<a name="addcomment">add-comment</a> sample comment snd1 chn1)
- (let* ((snd (or snd1 (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>)))
- (chn (or chn1 (<a class=quiet href="#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>)))
- (old-comments (or (<a class=quiet href="#channelproperty" onmouseout="UnTip()" onmouseover="Tip(sndscm_channelproperty_tip)">channel-property</a> 'comments snd chn) '())))
- (set! (<a class=quiet href="#channelproperty" onmouseout="UnTip()" onmouseover="Tip(sndscm_channelproperty_tip)">channel-property</a> 'comments snd chn)
+<pre class="indented">
+(define* (add-comment sample comment snd1 chn1)
+ (let* ((snd (or snd1 (<a class=quiet href="#selectedsound">selected-sound</a>)))
+ (chn (or chn1 (<a class=quiet href="#selectedchannel">selected-channel</a>)))
+ (old-comments (or (<a class=quiet href="#channelproperty">channel-property</a> 'comments snd chn) ())))
+ (set! (<a class=quiet href="#channelproperty">channel-property</a> 'comments snd chn)
(cons (list sample comment)
old-comments))))
(define (show-comments snd chn)
- (let ((comments (or (<a class=quiet href="#channelproperty" onmouseout="UnTip()" onmouseover="Tip(sndscm_channelproperty_tip)">channel-property</a> 'comments snd chn) '())))
+ (let ((comments (or (<a class=quiet href="#channelproperty">channel-property</a> 'comments snd chn) ())))
(for-each
- (lambda (<a class=quiet href="#comment" onmouseout="UnTip()" onmouseover="Tip(extsnd_comment_tip)">comment</a>)
+ (lambda (<a class=quiet href="#comment">comment</a>)
(let* ((samp (car comment))
(text (cadr comment))
(text-width (* 6 (string-length text)))
- (ls (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn))
- (rs (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn)))
+ (ls (<a class=quiet href="#leftsample">left-sample</a> snd chn))
+ (rs (<a class=quiet href="#rightsample">right-sample</a> snd chn)))
(if (and (< ls samp)
(> rs samp))
- (let ((xpos (<a class=quiet href="#xtoposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_xtoposition_tip)">x->position</a> (/ samp (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))))
- (ypos (<a class=quiet href="#ytoposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_ytoposition_tip)">y->position</a> (<a class=quiet href="#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> samp)))
+ (let ((xpos (<a class=quiet href="#xtoposition">x->position</a> (/ samp (<a class=quiet href="#srate">srate</a>))))
+ (ypos (<a class=quiet href="#ytoposition">y->position</a> (<a class=quiet href="#sample">sample</a> samp)))
(cr (make-cairo (car (channel-widgets snd chn)))))
- (<a class=quiet href="#drawline" onmouseout="UnTip()" onmouseover="Tip(extsnd_drawline_tip)">draw-line</a> xpos 20 xpos (- ypos 4) snd chn time-graph cr)
+ (<a class=quiet href="#drawline">draw-line</a> xpos 20 xpos (- ypos 4) snd chn time-graph cr)
(<em class=red>draw-string</em> text (- xpos (/ text-width 2)) 18 snd chn time-graph cr)
(free-cairo cr)))))
comments)))
-(hook-push <a class=quiet href="#aftergraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftergraphhook_tip)">after-graph-hook</a> show-comments)
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+(hook-push <a class=quiet href="#aftergraphhook">after-graph-hook</a>
+ (lambda (hook)
+ (show-comments (hook 'snd) (hook 'chn))))
+</pre>
+<div class="spacer"></div>
<!-- fill-rectangle -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fillrectangle">fill-rectangle</a> x0 y0 width height snd chn context erase cr</code>
-</td></tr><tr><td></td><td>
-This draws a filled rectangle in the current foreground color from ('x0 y0') of size ('width height').
+<pre class="indented">
+<em class=def id="fillrectangle">fill-rectangle</em> x0 y0 width height snd chn context erase cr
+</pre>
+
+<p>This draws a filled rectangle in the current foreground color from ('x0 y0') of size ('width height').
If 'erase' is #t, this function erases the rectangular area.
See draw.scm and snd-motif.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- fill-polygon -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="fillpolygon">fill-polygon</a> points snd chn context cr</code>
-</td></tr><tr><td></td><td>
-This draws a filled polygon whose vertices are in the vector 'points'.
+<pre class="indented">
+<em class=def id="fillpolygon">fill-polygon</em> points snd chn context cr
+</pre>
+
+<p>This draws a filled polygon whose vertices are in the vector 'points'.
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td><pre>
+<pre class="indented">
(define (-> x0 y0 size snd chn cr)
- "draw an arrow pointing (from the left) at the point (x0 y0)"
+ ;; draw an arrow pointing (from the left) at the point (x0 y0)
(let ((points (make-vector 8)))
(define (point i x y)
(set! (points (* i 2)) x)
@@ -13419,45 +14125,50 @@ This draws a filled polygon whose vertices are in the vector 'points'.
(point 3 x y)
(<em class=red>fill-polygon</em> points snd chn time-graph cr))
(arrow-head x0 y0)
- (<a class=quiet href="#fillrectangle" onmouseout="UnTip()" onmouseover="Tip(extsnd_fillrectangle_tip)">fill-rectangle</a> (- x0 (* 4 size))
+ (<a class=quiet href="#fillrectangle">fill-rectangle</a> (- x0 (* 4 size))
(floor (- y0 (* .4 size)))
(* 2 size)
(floor (* .8 size))
snd chn time-graph #f cr)))
-</pre></td></tr></table>
+</pre>
-musglyphs.scm has some elaborate examples that use fill-polygon to draw music notation symbols.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>musglyphs.scm has some elaborate examples that use fill-polygon to draw music notation symbols.
+</p>
+<div class="spacer"></div>
<!-- foreground-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="foregroundcolor">foreground-color</a> <em class=narg>snd chn context</em></code>
-</td></tr><tr><td></td><td>
-This is the current foreground color.
+<pre class="indented">
+<em class=def id="foregroundcolor">foreground-color</em> snd chn context
+</pre>
+
+<p>This is the current foreground color.
The following gives us a green cursor:
-<pre>
- (set! (foreground-color 0 0 <a class=quiet href="#cursorcontext" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursorcontext_tip)">cursor-context</a>) (<a class=quiet href="#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 1 0 1))
+</p>
+
+<pre class="indented">
+ (set! (foreground-color 0 0 <a class=quiet href="#cursorcontext">cursor-context</a>) (<a class=quiet href="#makecolor">make-color</a> 1 0 1))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- glSpectrogram -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="glspectrogram">glSpectrogram</a> data gl-list cutoff use-dB min-dB scale br bg bb</code>
-</td></tr><tr><td></td><td>
-glSpectrogram takes spectrogram data and passes it to openGL.
-The <a href="sndscm.html#startwaterfall">waterfall</a> function in snd-gl.scm uses this function.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="glspectrogram">glSpectrogram</em> data gl-list cutoff use-dB min-dB scale br bg bb
+</pre>
+
+<p>glSpectrogram takes spectrogram data and passes it to openGL.
+</p>
+<div class="spacer"></div>
<!-- graph-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="graphdata">graph-data</a> data snd chn context low high graphics-style cr</code>
-</td></tr><tr><td></td><td>
-<p>
-graph-data displays 'data' in the time domain graph of the sound's channel
-'chn' using the graphics context 'context' (normally <code>copy-context</code>), placing the
+<pre class="indented">
+<em class=def id="graphdata">graph-data</em> data snd chn context low high graphics-style cr
+</pre>
+
+<p>graph-data displays 'data' in the time domain graph of the sound's channel
+'chn' using the graphics context 'context' (normally copy-context), placing the
data in the recipient's graph between points 'low' and 'high'
in the drawing mode 'graphics-style'.
With this function and make-graph-data, we can overlay sounds,
@@ -13465,38 +14176,46 @@ overlay different versions of the same sound, place a portion of a
sound over another at an arbitrary point, and so on (see draw.scm).
</p>
-<img src="pix/redsamps.png" alt="red samples" hspace=20>
-
-</td></tr><tr><td colspan=2 height=32></td></tr>
+<img class="indented" src="pix/redsamps.png" alt="red samples">
+<div class="spacer"></div>
<!-- integer->colormap -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><code><a class=def name="integertocolormap">integer->colormap</a> i</code>
-</td></tr><tr><td></td><td>
-This function returns the colormap corresponding to a given integer.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="integertocolormap">integer->colormap</em> i
+</pre>
+
+<p>This function returns the colormap corresponding to a given integer.
+</p>
+<div class="spacer"></div>
<!-- make-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="makecolor">make-color</a> red green blue (alpha 1.0)</code>
-</td></tr><tr><td></td><td>
-make-color returns a color object using the rgb values 'red', 'green', and 'blue'. Each argument
+<pre class="indented">
+<em class=def id="makecolor">make-color</em> red green blue (alpha 1.0)
+</pre>
+
+<p>make-color returns a color object using the rgb values 'red', 'green', and 'blue'. Each argument
is a float between 0.0 (none of that color) and 1.0 (full value for that color). So,
-<pre>
- (make-color 1 0 0)
+</p>
+
+<pre class="indented">
+(make-color 1 0 0)
</pre>
-returns a red color object.
+
+<p>returns a red color object.
Two colors are equal (i.e. equal? returns #t) if their rgb values are the same.
The 'alpha' argument only matters in Gtk.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- make-graph-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="makegraphdata">make-graph-data</a> <em class=narg>snd chn edit-position low-sample high-sample</em></code>
-</td></tr><tr><td></td><td>
-Use make-graph-data to get the currently displayed data (i.e. the waveform displayed
+<pre class="indented">
+<em class=def id="makegraphdata">make-graph-data</em> snd chn edit-position low-sample high-sample
+</pre>
+
+<p id="displaydb">Use make-graph-data to get the currently displayed data (i.e. the waveform displayed
in the graph, which can be based on an overall peak envelope rather than the
individual samples).
It returns either a vct (if the graph has one trace), or a
@@ -13505,167 +14224,182 @@ list of two vcts (the two sides of the peak envelope graph).
'low-sample' defaults to the current window left sample, and
'high-sample' defaults to the current rightmost sample.
The result can be used in the lisp graph:
+</p>
-<table border=0 cellpadding=5 vspace=10><tr><td>
-<pre>
-(define <A NAME="displaydb">display-db</A>
+<pre class="indented">
+(define display-db
(lambda (snd chn)
- "(display-db snd chn) is a lisp-graph-hook function to display the time domain data in dB"
(let ((datal (<em class=red>make-graph-data</em> snd chn)))
(if datal
- (let* ((data (if (<a class=quiet href="#vctp" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctp_tip)">vct?</a> datal) datal (cadr datal)))
+ (let* ((data (if (float-vector? datal) datal (cadr datal)))
(len (length data))
- (sr (<a class=quiet href="#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd)))
+ (sr (<a class=quiet href="#srate">srate</a> snd)))
(define (dB val)
(if (< val .001)
-60.0
(* 20.0 (log10 val))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
(set! (data i) (+ 60.0 (dB (abs (data i))))))
- (<a class=quiet href="#graph" onmouseout="UnTip()" onmouseover="Tip(extsnd_graph_tip)">graph</a> data "dB"
- (/ (<a class=quiet href="#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a> snd chn) sr) (/ (<a class=quiet href="#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a> snd chn) sr)
+ (<a class=quiet href="#graph">graph</a> data "dB"
+ (/ (<a class=quiet href="#leftsample">left-sample</a> snd chn) sr) (/ (<a class=quiet href="#rightsample">right-sample</a> snd chn) sr)
0.0 60.0
snd chn))))))
-(hook-push <a class=quiet href="#lispgraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_lispgraphhook_tip)">lisp-graph-hook</a> display-db)
+(hook-push <a class=quiet href="#lispgraphhook">lisp-graph-hook</a>
+ (lambda (hook)
+ (display-db (hook 'snd) (hook 'chn))))
</pre>
-</td></tr></table>
-Here we are taking whatever is displayed in the time domain, and
+<p>Here we are taking whatever is displayed in the time domain, and
presenting the same thing in dB in the lisp graph. <a href="sndscm.html#displayenergy">display-energy</a>
in draw.scm is another example. But the real power of this function
comes from its use with graph-data.
The latter takes its argument (either a vct or a list of two
vcts), and displays it in any channel's time domain graph using its current graph-style.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mark-context -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><A class=def NAME="markcontext">mark-context</A></code>
-</td></tr><tr><td></td><td>
-This is the graphics context used to draw a mark (XOR mode). (It is an integer, not a function).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="markcontext">mark-context</em>
+</pre>
+
+<p>This is the graphics context used to draw a mark (XOR mode). (It is an integer, not a function).
+</p>
+<div class="spacer"></div>
<!-- selection-context -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><A class=def NAME="selectioncontext">selection-context</A></code>
-</td></tr><tr><td></td><td>
-This is the graphics context for XOR drawing in the selection color. (An integer, not a function).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="selectioncontext">selection-context</em>
+</pre>
+
+<p>This is the graphics context for XOR drawing in the selection color. (An integer, not a function).
+</p>
+<div class="spacer"></div>
<!-- snd-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndcolor">snd-color</a> choice</code>
-</td></tr><tr><td></td><td>
-snd-color returns a Snd built-in color (as a Pixel/GdkPixel); it simplifies
+<pre class="indented">
+<em class=def id="sndcolor">snd-color</em> choice
+</pre>
+
+<p>snd-color returns a Snd built-in color (as a Pixel/GdkPixel); it simplifies
code that wants to follow whatever the current Snd color choices are. The choices are:
-<pre>
- 0: white 12: listener-color
- 1: black 13: listener-text-color 25: sash-color
- 2: red 14: basic-color
- 3: yellow 15: selection-color
- 4: green 16: zoom-color
- 5: light-blue 17: position-color
- 6: lighter-blue 18: highlight-color
- 7: data-color 19: enved-waveform-color 31: grid-color
- 8: selected-data-color 20: cursor-color 32: selected-grid-color
- 9: mark-color 21: text-focus-color 33: axis-color
- 10: graph-color 22: filter-control-waveform-color
- 11: selected-graph-color 23: mix-color
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+
+<pre class="indented">
+0: white 12: listener-color
+1: black 13: listener-text-color 25: sash-color
+2: red 14: basic-color
+3: yellow 15: selection-color
+4: green 16: zoom-color
+5: light-blue 17: position-color
+6: lighter-blue 18: highlight-color
+7: data-color 19: enved-waveform-color 31: grid-color
+8: selected-data-color 20: cursor-color 32: selected-grid-color
+9: mark-color 21: text-focus-color 33: axis-color
+10: graph-color 22: filter-control-waveform-color
+11: selected-graph-color 23: mix-color
+</pre>
+<div class="spacer"></div>
<!-- snd-font -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndfont">snd-font</a> choice</code>
-</td></tr><tr><td></td><td>
-snd-font returns a Snd built-in font (as a raw pointer, suitable for <a href="#currentfont">current-font</a> but not much else); it simplifies
+<pre class="indented">
+<em class=def id="sndfont">snd-font</em> choice
+</pre>
+
+<p>snd-font returns a Snd built-in font (as a raw pointer, suitable for <a href="#currentfont">current-font</a> but not much else); it simplifies
code that wants to follow whatever the current Snd font choices are, but is really aimed at code that wants to use
just built-in functions like <a href="#currentfont">current-font</a>, and not rely
on the <a href="grfsnd.html#sndwithmotif">xm</a> or <a href="grfsnd.html#sndwithgtk">xg</a> modules.
The choices are:
-<pre>
- 0: <a class=quiet href="#peaksfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_peaksfont_tip)">peaks-font</a>
- 1: <a class=quiet href="#boldpeaksfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_boldpeaksfont_tip)">bold-peaks-font</a>
- 2: <a class=quiet href="#tinyfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_tinyfont_tip)">tiny-font</a>
- 3: <a class=quiet href="#axislabelfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_axislabelfont_tip)">axis-label-font</a>
- 4: <a class=quiet href="#axisnumbersfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_axisnumbersfont_tip)">axis-numbers-font</a>
- 5: <a class=quiet href="#listenerfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_listenerfont_tip)">listener-font</a>
+</p>
+
+<pre class="indented">
+0: <a class=quiet href="#peaksfont">peaks-font</a>
+1: <a class=quiet href="#boldpeaksfont">bold-peaks-font</a>
+2: <a class=quiet href="#tinyfont">tiny-font</a>
+3: <a class=quiet href="#axislabelfont">axis-label-font</a>
+4: <a class=quiet href="#axisnumbersfont">axis-numbers-font</a>
+5: <a class=quiet href="#listenerfont">listener-font</a>
</pre>
-See <a href="sndscm.html#displaybarkfft">display-bark-fft</a> in dsp.scm for an example.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>See <a href="sndscm.html#displaybarkfft">display-bark-fft</a> in dsp.scm for an example.
+</p>
+<div class="spacer"></div>
<!-- snd-gcs -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="sndgcs">snd-gcs</a></code>
-</td></tr><tr><td></td><td>
-snd-gcs returns a list of Snd's graphics contexts:
-<pre>
- 0: bg=graph-color, fg=data-color
- 1: bg=selected-graph-color, fg=selected-data-color
- 2: bg=graph-color, fg=data-color, fg changes for superimposed graphs
+<pre class="indented">
+<em class=def id="sndgcs">snd-gcs</em>
+</pre>
- 3: bg=graph-color, fg=cursor-color, XOR (for cursor)
- 4: bg=selected-graph-color, fg=cursor-color, XOR (for cursor in selection)
+<p>snd-gcs returns a list of Snd's graphics contexts:
+</p>
+
+<pre class="indented">
+0: bg=graph-color, fg=data-color
+1: bg=selected-graph-color, fg=selected-data-color
+2: bg=graph-color, fg=data-color, fg changes for superimposed graphs
- 5: bg=graph-color, fg=selection-color, XOR (for selection highlighting)
- 6: bg=selected-graph-color, fg=selection-color, XOR (selection highlighting)
+3: bg=graph-color, fg=cursor-color, XOR (for cursor)
+4: bg=selected-graph-color, fg=cursor-color, XOR (for cursor in selection)
- 7: bg=data-color, fg=graph-color (to erase data)
- 8: bg=selected-data-color, fg=selected-graph-color (erase data in selected channel)
+5: bg=graph-color, fg=selection-color, XOR (for selection highlighting)
+6: bg=selected-graph-color, fg=selection-color, XOR (selection highlighting)
- 9: bg=graph-color, fg=mark-color, XOR (for marks)
- 10: bg=selected-graph-color, fg=mark-color, XOR (marks in selected channel)
+7: bg=data-color, fg=graph-color (to erase data)
+8: bg=selected-data-color, fg=selected-graph-color (erase data in selected channel)
- 11: bg=graph-color, fg=mix-color
- 12: bg=selected-graph-color, fg=mix-color
+9: bg=graph-color, fg=mark-color, XOR (for marks)
+0: bg=selected-graph-color, fg=mark-color, XOR (marks in selected channel)
- 13: bg=basic-color, fg=black
- 14: bg=basic-color, fg=filter-waveform-color
+1: bg=graph-color, fg=mix-color
+2: bg=selected-graph-color, fg=mix-color
+
+3: bg=basic-color, fg=black
+4: bg=basic-color, fg=filter-waveform-color
</pre>
-These graphics-contexts make it easier to fit in with whatever color scheme is currently in use. For example,
+
+<p>These graphics-contexts make it easier to fit in with whatever color scheme is currently in use. For example,
in to make sure the font color reflects whether we're in the selected channel:
-<pre>
- (XSetFont dpy
- (if (= chn (<a class=quiet href="#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-channel</a> snd))
- (cadr (snd-gcs))
- (car (snd-gcs)))
- (.fid fs))
+</p>
+
+<pre class="indented">
+ (XSetFont dpy
+ (if (= chn (<a class=quiet href="#selectedsound">selected-channel</a> snd))
+ (cadr (snd-gcs))
+ (car (snd-gcs)))
+ (.fid fs))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- with-gl -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<code><a class=def name="withgl">with-gl</a></code>
-</td></tr><tr><td></td><td>
-If with-gl is #t and GL is loaded, use GL where possible (the default is #t if HAVE_GL).
-You can find out at run-time whether GL is loaded via <code>(provided? 'gl)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="withgl">with-gl</em>
+</pre>
-</table>
+<p>If with-gl is #t and GL is loaded, use GL where possible (the default is #t if HAVE_GL).
+You can find out at run-time whether GL is loaded via (provided? 'gl).
+</p>
+<div class="spacer"></div>
-<br><br>
-
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="fm.html">fm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
+
</body></html>
diff --git a/fade.scm b/fade.scm
index acd5eb2..7786a90 100644
--- a/fade.scm
+++ b/fade.scm
@@ -6,179 +6,276 @@
;;;
;;; translated from fade.ins
+(provide 'snd-fade.scm)
+
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+
(definstrument (cross-fade beg dur amp file1 file2 ramp-beg ramp-dur ramp-type bank-dur fs fwidth)
;; ramp-type 0=sweep up, 1=sweep down, 2=split from middle
- (let* ((fil1 (make-sampler 0 file1))
- (fil2 (make-sampler 0 file2))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (ramp 0.0)
- (bank1 0.0)
- (bank2 1.0)
- (half-fs (/ fs 2))
- (ramp-samps (seconds->samples ramp-dur))
- (bank-samps (seconds->samples bank-dur))
- (ramp-incr (/ 1.0 ramp-samps))
- (ramp-start (+ start (seconds->samples ramp-beg)))
- (bank1-start (- ramp-start bank-samps))
- (bank-incr (/ 1.0 bank-samps))
- (ramp-end (+ ramp-start ramp-samps))
- (bank2-start ramp-end)
- (bank2-end (+ bank2-start bank-samps))
- (bin (/ (mus-srate) (* 2 fs)))
- (radius (- 1.0 (/ fwidth (* 2 fs))))
- (fs1 (make-vector fs))
- (val 0.0)
- (ifs (/ 1.0 fs)))
-
- (do ((k 0 (+ 1 k)))
- ((= k fs))
- (set! (fs1 k) (make-formant (* k bin) radius)))
-
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
-
- (if (< i bank1-start)
- ;; in first section -- just mix in file1
- (set! val (read-sample fil1))
-
- (if (> i bank2-end)
- ;; in last section -- just mix file2
- (set! val (read-sample fil2))
-
- (if (< i ramp-start)
- ;; in bank1 section -- fire up the resonators
- (let ((inval (read-sample fil1))
- (outval 0.0))
- (set! bank1 (+ bank1 bank-incr))
- (do ((k 0 (+ 1 k)))
- ((= k (- fs 1)))
- (set! outval (+ outval (formant (fs1 (+ 1 k)) inval))))
- (set! val (+ (* bank1 outval) (* (- 1.0 bank1) inval))))
-
- (if (> i ramp-end)
- ;; in bank2 section -- ramp out resonators
- (let ((inval (read-sample fil2))
- (outval 0.0))
- (set! bank2 (- bank2 bank-incr))
- (do ((k 0 (+ 1 k)))
- ((= k (- fs 1)))
- (set! outval (+ outval (formant (fs1 (+ 1 k)) inval))))
- (set! val (+ (* bank2 outval) (* (- 1.0 bank2) inval))))
-
- ;; in the fade section
- (let ((inval1 (read-sample fil1))
- (inval2 (read-sample fil2))
- (outval 0.0))
- ;; now the choice of spectral fade -- we should end with all bank1 0.0 and all bank2 1.0
- (set! ramp (+ ramp ramp-incr))
-
- (if (= ramp-type 0)
- (let ((r2 (* 2 ramp)))
- ;; sweep up so low freqs go first
- (do ((k 0 (+ 1 k)))
- ((= k (- fs 1)))
- (let ((rfs (max 0.0 (min 1.0 (- r2 (* k ifs))))))
- (set! outval (+ outval (formant (fs1 (+ 1 k))
- (+ (* rfs inval2) (* (- 1.0 rfs) inval1)))))))
- (set! val outval))
-
- (if (= ramp-type 1)
- (let ((r2 (* 2 ramp)))
- ;; sweep up so high freqs go first
- (do ((k 0 (+ 1 k)))
- ((= k (- fs 1)))
- (let ((rfs (max 0.0 (min 1.0 (- r2 (* (- fs k) ifs))))))
- (set! outval (+ outval (formant (fs1 (+ 1 k))
- (+ (* rfs inval2) (* (- 1.0 rfs) inval1)))))))
- (set! val outval))
-
- ;; sweep from midpoint out
- (let ((r2 (* 2 ramp)))
- (do ((k 0 (+ 1 k)))
- ((= k half-fs))
- (let ((rfs (max 0.0 (min 1.0 (- (+ r2 0.5) (* (- fs k) ifs))))))
- (set! outval (+ outval (formant (fs1 (+ 1 k))
- (+ (* rfs inval2) (* (- 1.0 rfs) inval1)))))))
- (do ((k 0 (+ 1 k)))
- ((= k (- half-fs 1)))
- (let ((rfs (max 0.0 (min 1.0 (- r2 (/ k half-fs))))))
- (set! outval (+ outval (formant (fs1 (+ k 1 half-fs))
- (+ (* rfs inval2) (* (- 1.0 rfs) inval1)))))))
- (set! val outval)))))))))
- (outa i (* amp val))))))
-
-
-;;; (vct->channel (with-sound (:output (make-vct 22050)) (cross-fade 0 .1 1 0 1 .01 .01 0 .1 256 2)))
-;;; (vct->channel (with-sound (:output (make-vct 44100)) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2)))
-;;;
+
+ (if (> (+ (max bank-dur ramp-beg) ramp-dur bank-dur) dur)
+ (begin
+ (set! ramp-beg (* 0.25 dur))
+ (set! ramp-dur (* dur 0.49))
+ (set! bank-dur (* dur 0.24))))
+
+ (let ((fil1 (make-sampler 0 file1))
+ (fil2 (make-sampler 0 file2))
+ (start (seconds->samples beg))
+ (ramp-samps (seconds->samples ramp-dur))
+ (bank-samps (seconds->samples bank-dur))
+ (fs1 (make-vector fs)))
+
+ (let ((bin (/ *clm-srate* (* 2 fs)))
+ (radius (- 1.0 (/ fwidth (* 2 fs)))))
+ (do ((k 0 (+ k 1)))
+ ((= k fs))
+ (set! (fs1 k) (make-formant (* k bin) radius))))
+ (set! fs1 (make-formant-bank fs1))
+
+ (let ((end (+ start (seconds->samples dur)))
+ (bank-incr (/ 1.0 bank-samps))
+ (ramp-incr (/ 1.0 ramp-samps))
+ (ramp-start (+ start (seconds->samples ramp-beg))))
+ (let ((bank1-start (- ramp-start bank-samps))
+ (ramp-end (+ ramp-start ramp-samps))
+ (bank2-start (+ ramp-start ramp-samps)))
+
+ (do ((i start (+ i 1)))
+ ((= i bank1-start))
+ ;; in first section -- just mix in file1
+ (outa i (* amp (read-sample fil1))))
+
+ (let ((bank2-end (+ bank2-start bank-samps))
+ (ramp 0.0)
+ (outval 0.0)
+ (inputs (make-float-vector fs 0.0))
+ (ifs (/ 1.0 fs))
+ (mid 0))
+
+ (do ((i bank1-start (+ i 1))
+ (bank1 0.0 (+ bank1 bank-incr)))
+ ((= i ramp-start))
+ ;; in bank1 section -- fire up the resonators
+ (let ((inval (read-sample fil1)))
+ (set! outval (formant-bank fs1 inval))
+ (outa i (* amp (+ (* bank1 outval) (* (- 1.0 bank1) inval))))))
+
+ ;; in the ramp
+ (case ramp-type
+ ((0)
+ (do ((i ramp-start (+ i 1)))
+ ((= i ramp-end))
+ (let ((inval1 (read-sample fil1))
+ (inval2 (read-sample fil2)))
+ ;; now the choice of spectral fade -- we should end with all bank1 0.0 and all bank2 1.0
+ (set! ramp (+ ramp ramp-incr))
+
+ ;; low freqs go first
+ (if (>= ramp 0.5)
+ (begin
+ (set! mid (floor (* (- (* 2.0 ramp) 1.0) fs)))
+ (fill! inputs inval2 0 mid)
+ (float-vector-interpolate inputs mid fs 1.0 (- ifs) inval2 inval1)
+ ;; (do ((k mid (+ k 1)) (ks 1.0 (- ks ifs))) ((>= k fs)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
+ )
+ (begin
+ (set! mid (min fs (floor (* 2.0 ramp fs))))
+ (fill! inputs inval1 mid)
+ (float-vector-interpolate inputs 0 mid (* 2.0 ramp) (- ifs) inval2 inval1)
+ ;; (do ((k 0 (+ k 1)) (ks (* 2.0 ramp) (- ks ifs))) ((= k mid)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
+ ))
+ (outa i (* amp (formant-bank fs1 inputs))))))
+
+ ((1)
+ (do ((i ramp-start (+ i 1)))
+ ((= i ramp-end))
+ (let ((inval1 (read-sample fil1))
+ (inval2 (read-sample fil2)))
+ (set! ramp (+ ramp ramp-incr))
+
+ ;; high freqs go first
+ (if (>= ramp 0.5)
+ (let ((r2 (- (* 2.0 ramp) 1.0)))
+ (set! mid (min fs (ceiling (* (- 1.0 r2) fs))))
+ (fill! inputs inval2 mid)
+ (float-vector-interpolate inputs 0 mid r2 ifs inval2 inval1)
+ ;; (do ((k 0 (+ k 1)) (ks r2 (+ ks ifs))) ((= k mid)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
+ )
+ (begin
+ (set! mid (ceiling (* (- 1.0 (* 2.0 ramp)) fs)))
+ (fill! inputs inval1 0 mid)
+ (float-vector-interpolate inputs mid fs 0.0 ifs inval2 inval1)
+ ;; (do ((k mid (+ k 1)) (ks 0.0 (+ ks ifs))) ((>= k fs)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
+ ))
+ (outa i (* amp (formant-bank fs1 inputs))))))
+
+ (else
+ (let ((half-fs (/ fs 2)))
+ (do ((i ramp-start (+ i 1)))
+ ((= i ramp-end))
+ (let ((inval1 (read-sample fil1))
+ (inval2 (read-sample fil2)))
+ ;; now the choice of spectral fade -- we should end with all bank1 0.0 and all bank2 1.0
+ (set! ramp (+ ramp ramp-incr))
+ ;; sweep from midpoint out
+ (fill! inputs inval1)
+ (set! mid (min half-fs (floor (* fs ramp))))
+ (do ((k (- half-fs mid) (+ k 1))
+ (hk (+ half-fs mid -1) (- hk 1))
+ (ks (max 0.0 (- (* 2.0 ramp) 1.0)) (+ ks ifs)))
+ ((= k half-fs))
+ (let ((rfs (min 1.0 ks)))
+ (set! (inputs k) (+ (* rfs inval2) (* (- 1.0 rfs) inval1)))
+ (set! (inputs hk) (inputs k))))
+ (outa i (* amp (formant-bank fs1 inputs))))))))
+
+ (do ((i ramp-end (+ i 1))
+ (bank2 1.0 (- bank2 bank-incr)))
+ ((= i bank2-end))
+ ;; in bank2 section -- ramp out resonators
+ (let ((inval (read-sample fil2)))
+ (set! outval (formant-bank fs1 inval))
+ (outa i (* amp (+ (* bank2 outval) (* (- 1.0 bank2) inval))))))
+
+ (do ((i bank2-end (+ i 1)))
+ ((= i end))
+ ;; in last section -- just mix file2
+ (outa i (* amp (read-sample fil2))))
+ )))))
+
+
+
+;;; (float-vector->channel (with-sound ((make-float-vector 22050)) (cross-fade 0 .1 1 0 1 .01 .01 0 .1 256 2)))
+;;; (float-vector->channel (with-sound ((make-float-vector 44100)) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2)))
+;;; (with-sound (:statistics #t) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2))
+;;; (with-sound () (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2))
;;; these fades seem more successful to me when done relatively quickly (the opposite of the dissolve below
;;; which is best if done as slowly as possible). I like the sweep up best -- a sort of "evaporation" effect.
(definstrument (dissolve-fade beg dur amp file1 file2 fsize r lo hi)
- (let* ((fil1 (make-sampler 0 file1))
- (fil2 (make-sampler 0 file2))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur)))
- (freq-inc (floor (/ fsize 2)))
- (bin (floor (/ (mus-srate) fsize)))
- (radius (- 1.0 (/ r fsize)))
- (spectr (make-vct freq-inc 1.0))
- (ramp-inc (/ 1.0 1024.0))
- (trigger (floor (/ (* dur (mus-srate)) freq-inc)))
- (fs (make-vector freq-inc))
- (ctr 0))
+ (let ((fil1 (make-sampler 0 file1))
+ (fil2 (make-sampler 0 file2))
+ (start (seconds->samples beg))
+ (freq-inc (floor (/ fsize 2)))
+ (ramp-inc (/ 1.0 1024.0)))
+ (let ((end (+ start (seconds->samples dur)))
+ (spectr (make-vector freq-inc #f))
+ (trigger (floor (/ (* dur *clm-srate*) freq-inc)))
+ (fs (make-vector freq-inc #f))
+ (amps (make-float-vector freq-inc amp))
+ (ctr 0)
+ (inputs (make-float-vector freq-inc 0.0))
+ (ramps (make-vector freq-inc -1))
+ (in2s (make-int-vector freq-inc 0))
+ (in2-ctr 0)
+ (ramp-ctr 0))
- (if (not (number? hi)) (set! hi freq-inc))
- (do ((k 0 (+ 1 k)))
- ((= k hi))
- (set! (fs k) (make-formant (* k bin) radius)))
-
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (let ((outval 0.0)
- (inval1 (read-sample fil1))
- (inval2 (read-sample fil2)))
- ;; once a ramp is set in motion, it takes care of itself -- we need only choose which to trigger
- (set! ctr (+ 1 ctr))
- (if (> ctr trigger)
- (begin
- ;; find next randomly chosen resonator to flip
- (let ((next (floor (random freq-inc))))
- (if (not (= (spectr next) 1.0))
- (call-with-exit
- (lambda (bbreak)
- (do ((j next (+ 1 j))
- (k next (- k 1)))
- (#t)
- (if (and (< j freq-inc)
- (= (spectr j) 1.0))
- (begin
- (set! next j)
- (bbreak)))
- (if (and (>= k 0)
- (= (spectr k) 1.0))
- (begin
- (set! next k)
- (bbreak)))))))
- (set! (spectr next) (- (spectr next) ramp-inc))
- (set! ctr 0))))
- (do ((k lo (+ 1 k)))
- ((= k hi))
- (let ((sp (spectr k)))
- (set! outval (+ outval (formant (fs k) (+ (* sp inval1) (* (- 1.0 sp) inval2)))))
- (if (> 1.0 sp 0.0)
- (set! (spectr k) (- (spectr k) ramp-inc)))))
- (outa i (* amp outval)))))))
-
-
-;;; (with-sound () (dissolve-fade 0 1 1.0 "oboe.snd" "trumpet.snd" 256 2 0 128))
-;;; (vct->channel (with-sound (:output (make-vct 44100)) (dissolve-fade 0 2 1 0 1 4096 2 2 #f)))
+ (if (not (number? hi)) (set! hi freq-inc))
+ (let ((bin (floor (/ *clm-srate* fsize)))
+ (radius (- 1.0 (/ r fsize))))
+ (do ((k lo (+ k 1)))
+ ((= k hi))
+ (set! (fs k) (make-formant (* k bin) radius))))
+ (set! fs (make-formant-bank fs amps)) ; wrap it up...
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+
+ ;; once a ramp is set in motion, it takes care of itself -- we need only choose which to trigger
+ (set! ctr (+ ctr 1))
+ (if (> ctr trigger)
+ (let ((next (floor (random freq-inc))))
+ ;; find next randomly chosen resonator to flip
+ (if (not (spectr next))
+ (set! (spectr next) (- 1.0 ramp-inc))
+ (call-with-exit
+ (lambda (bbreak)
+ (do ((j next (+ j 1))
+ (k next (- k 1)))
+ ()
+ (if (and (< j freq-inc)
+ (not (spectr j)))
+ (begin
+ (set! (spectr j) (- 1.0 ramp-inc))
+ (set! next j)
+ (bbreak)))
+ (if (and (>= k 0)
+ (not (spectr k)))
+ (begin
+ (set! (spectr k) (- 1.0 ramp-inc))
+ (set! next k)
+ (bbreak)))))))
+ (set! (ramps ramp-ctr) next)
+ (set! ramp-ctr (+ ramp-ctr 1))
+ (set! ctr 0)))
+
+ (let ((inval1 (read-sample fil1))
+ (inval2 (read-sample fil2)))
+ (fill! inputs inval1)
+ (float-vector-spatter inputs in2s in2-ctr inval2)
+ ;; (do ((k 0 (+ k 1))) ((= k in2-ctr)) (float-vector-set! inputs (int-vector-ref in2s k) inval2))
+
+ (if (> ramp-ctr 0)
+ (let ((rk 0)
+ (sp 0.0)
+ (fixup-ramps #f))
+ (do ((k 0 (+ k 1)))
+ ((= k ramp-ctr))
+ (set! rk (ramps k))
+ (set! sp (vector-ref spectr rk))
+ (float-vector-set! inputs k (+ (* sp inval1) (* (- 1.0 sp) inval2)))
+ (set! sp (- sp ramp-inc))
+ (if (> sp 0.0)
+ (vector-set! spectr rk sp)
+ (begin
+ (set! (in2s in2-ctr) rk)
+ (set! in2-ctr (+ in2-ctr 1))
+ (set! fixup-ramps #t)
+ (set! (ramps k) -1))))
+ (if fixup-ramps
+ (let ((j 0))
+ (do ((k 0 (+ k 1)))
+ ((= k ramp-ctr))
+ (if (>= (ramps k) 0)
+ (begin
+ (set! (ramps j) (ramps k))
+ (set! j (+ j 1)))))
+ (set! ramp-ctr j)))))
+
+ (outa i (formant-bank fs inputs)))))))
+
+
+;;; (with-sound (:statistics #t) (dissolve-fade 0 1 1.0 "oboe.snd" "trumpet.snd" 256 2 0 128))
+;;; (float-vector->channel (with-sound ((make-float-vector 44100)) (dissolve-fade 0 2 1 0 1 4096 2 2 #f)))
;;;
;;; another neat effect here is to simply let the random changes float along with no
;;; direction -- if the hit is 1.0 send it toward 0.0 and vice versa -- strange
;;; pitches emerge from noises etc
+
+
+#|
+;;; make it easy to see and hear:
+
+(with-sound ("p1.snd")
+ (let ((g (make-ncos 200 100)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (outa i (ncos g)))))
+
+(with-sound ("p2.snd")
+ (let ((g (make-ncos 123 100)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (outa i (ncos g)))))
+
+(with-sound (:statistics #t)
+ (cross-fade 0 2 1.0 "p1.snd" "p2.snd" 0.5 1.0 0 .1 256 2))
+
+(with-sound (:statistics #t)
+ (dissolve-fade 0 2 1.0 "p1.snd" "p2.snd" 256 2 0 128))
+|#
diff --git a/fft-menu.scm b/fft-menu.scm
index 3176cff..1504d11 100644
--- a/fft-menu.scm
+++ b/fft-menu.scm
@@ -1,21 +1,29 @@
-(if (provided? 'xm)
- (if (not (provided? 'snd-effects-utils.scm))
- (load "effects-utils.scm"))) ; make-effect-dialog
+(when (and (provided? 'xm)
+ (not (provided? 'snd-effects-utils.scm)))
+ (load "effects-utils.scm"))
-(if (provided? 'xg)
- (if (not (provided? 'snd-gtk-effects-utils.scm))
- (load "gtk-effects-utils.scm")))
+(if (and (provided? 'xg)
+ (not (provided? 'snd-gtk-effects-utils.scm)))
+ (load "gtk-effects-utils.scm"))
-(if (not (provided? 'snd-examp.scm)) (load "examp.scm")) ; squelch-vowels
+(define *e* (if (provided? 'snd-motif) *motif* *gtk*))
+(define update-label (*e* 'update-label))
+(define change-label (*e* 'change-label))
+(define make-effect-dialog (*e* 'make-effect-dialog))
+(define add-sliders (*e* 'add-sliders))
+(define activate-dialog (*e* 'activate-dialog))
+(define select-file (*e* 'select-file))
+
+(require snd-examp.scm)
(provide 'snd-fft-menu.scm)
-(define fft-list '()) ; menu labels are updated to show current default settings
+(define fft-list ()) ; menu labels are updated to show current default settings
(define fft-menu (add-to-main-menu "FFT Edits" (lambda ()
(define (update-label fft)
- (if (not (null? fft))
+ (if (pair? fft)
(begin
((car fft))
(update-label (cdr fft)))))
@@ -42,7 +50,7 @@
;; if fft-edit-dialog doesn't exist, create it
(let ((initial-fft-edit-low-frequency 100)
(initial-fft-edit-high-frequency 1000)
- (sliders '()))
+ (sliders ()))
(set! fft-edit-dialog
(make-effect-dialog
@@ -66,16 +74,14 @@ removes all energy below the low frequency and above the high frequency, then co
(lambda (w data)
(set! fft-edit-low-frequency initial-fft-edit-low-frequency)
(set! fft-edit-high-frequency initial-fft-edit-high-frequency)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) (floor fft-edit-low-frequency))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) (floor fft-edit-high-frequency))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (cadr sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (car sliders)) (floor fft-edit-low-frequency))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (cadr sliders)) (floor fft-edit-high-frequency))
)
(lambda (w c i)
(set! fft-edit-low-frequency initial-fft-edit-low-frequency)
(set! fft-edit-high-frequency initial-fft-edit-high-frequency)
- (XtSetValues (car sliders) (list XmNvalue (floor fft-edit-low-frequency)))
- (XtSetValues (cadr sliders) (list XmNvalue (floor fft-edit-high-frequency)))))))
+ ((*motif* 'XtSetValues) (car sliders) (list (*motif* 'XmNvalue) (floor fft-edit-low-frequency)))
+ ((*motif* 'XtSetValues) (cadr sliders) (list (*motif* 'XmNvalue) (floor fft-edit-high-frequency)))))))
(set! sliders
(add-sliders
@@ -83,18 +89,18 @@ removes all energy below the low frequency and above the high frequency, then co
(list (list "low frequency" 20 initial-fft-edit-low-frequency 22050
(if (provided? 'snd-gtk)
- (lambda (w data) (set! fft-edit-low-frequency (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- (lambda (w context info) (set! fft-edit-low-frequency (.value info))))
+ (lambda (w data) (set! fft-edit-low-frequency ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
+ (lambda (w context info) (set! fft-edit-low-frequency ((*motif* '.value) info))))
1)
(list "high frequency" 20 initial-fft-edit-high-frequency 22050
(if (provided? 'snd-gtk)
- (lambda (w data) (set! fft-edit-high-frequency (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- (lambda (w context info) (set! fft-edit-high-frequency (.value info))))
+ (lambda (w data) (set! fft-edit-high-frequency ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
+ (lambda (w context info) (set! fft-edit-high-frequency ((*motif* '.value) info))))
1))))))
(activate-dialog fft-edit-dialog))
- (set! fft-edit-menu-label (add-to-menu fft-menu "FFT notch filter" (lambda () (post-fft-edit-dialog)))))
+ (set! fft-edit-menu-label (add-to-menu fft-menu "FFT notch filter" post-fft-edit-dialog)))
(set! fft-edit-menu-label (add-to-menu fft-menu fft-edit-label cp-fft-edit)))
@@ -126,7 +132,7 @@ removes all energy below the low frequency and above the high frequency, then co
(if (not fft-squelch-dialog)
;; if fft-squelch-dialog doesn't exist, create it
(let ((initial-fft-squelch-amount 0.0)
- (sliders '()))
+ (sliders ()))
(set! fft-squelch-dialog
(make-effect-dialog
@@ -147,12 +153,11 @@ removes all energy below the low frequency and above the high frequency, then co
(if (provided? 'snd-gtk)
(lambda (w data)
(set! fft-squelch-amount initial-fft-squelch-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) (round (* fft-squelch-amount 100)))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (car sliders)) (round (* fft-squelch-amount 100)))
)
(lambda (w c i)
(set! fft-squelch-amount initial-fft-squelch-amount)
- (XtSetValues (list-ref sliders 0) (list XmNvalue (round (* fft-squelch-amount 100))))))))
+ ((*motif* 'XtSetValues) (list-ref sliders 0) (list (*motif* 'XmNvalue) (round (* fft-squelch-amount 100))))))))
(set! sliders
(add-sliders
@@ -160,14 +165,14 @@ removes all energy below the low frequency and above the high frequency, then co
(list (list "squelch amount" 0.0 initial-fft-squelch-amount 1.0
(if (provided? 'snd-gtk)
(lambda (w data)
- (set! fft-squelch-amount (/ (gtk_adjustment_get_value (GTK_ADJUSTMENT w)) 100)))
+ (set! fft-squelch-amount (/ ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w)) 100)))
(lambda (w context info)
- (set! fft-squelch-amount (/ (.value info) 100))))
+ (set! fft-squelch-amount (/ ((*motif* '.value) info) 100))))
100))))))
(activate-dialog fft-squelch-dialog))
- (set! fft-squelch-menu-label (add-to-menu fft-menu "FFT squelch" (lambda () (post-fft-squelch-dialog)))))
+ (set! fft-squelch-menu-label (add-to-menu fft-menu "FFT squelch" post-fft-squelch-dialog)))
(set! fft-squelch-menu-label (add-to-menu fft-menu fft-squelch-label cp-fft-squelch)))
@@ -179,4 +184,4 @@ removes all energy below the low frequency and above the high frequency, then co
(add-to-menu fft-menu #f #f)
-(add-to-menu fft-menu "Squelch vowels" (lambda () (squelch-vowels)))
+(add-to-menu fft-menu "Squelch vowels" squelch-vowels)
diff --git a/fm.html b/fm.html
index 64f2449..6d83285 100644
--- a/fm.html
+++ b/fm.html
@@ -1,17 +1,105 @@
-<html>
+<!DOCTYPE html>
+
+<html lang="en">
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>An Introduction to FM</title>
-</head>
-<body bgcolor=white>
+<style type="text/css">
+ EM.noem {font-style: normal}
+ PRE.indented {padding-left: 1.0cm;}
+ TD.greenish {background-color: #eefdee}
+ TD.bluish {background-color: #f6f8ff}
+ TD.beige {background-color: beige}
+ TD.center {text-align: center}
+ TD.spaced {
+ margin-left: 0.2cm;
+ }
+ TD.bluishcentered {background-color: #f2f4ff;
+ text-align: center;
+ }
+ TD.bluishb {background-color: #f2f4ff;
+ text-align: center;
+ border: 1px solid lightgray;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ IMG.indented {margin-left: 2.0cm}
+ DIV.spacer {margin-top: 1.0cm;
+ }
+ TABLE.spaced {margin-left: 1.0cm;
+ }
+ TABLE.bordered {border: 1px solid black;
+ padding-left: 0.1cm;
+ padding-right: 0.1cm;
+ }
+ TABLE.borderedm {border: 1px solid black;
+ padding-left: 0.2cm;
+ padding-right: 0.2cm;
+ margin-left: 1.0cm;
+ margin-top: 0.5cm;
+ margin-right: 1.0cm;
+ padding-top: 0.2cm;
+ padding-bottom: 0.2cm;
+ }
+
+ DIV.greenish {border: 1px solid gray;
+ background-color: #eefdee;
+ /* margin-left: 1.0cm; */
+ margin-right: 1.0cm;
+ margin-top: 0.5cm;
+ padding-left: 0.4cm;
+ padding-right: 0.4cm;
+ padding-top: 0.5cm;
+ padding-bottom: 0.5cm;
+ }
+
+ DIV.header {margin-top: 60px;
+ margin-bottom: 30px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #eefdee; /* lightgreen */
+ padding-left: 30px;
+ }
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.centered {text-align: center;
+ padding-bottom: 0.5cm;
+ }
+ DIV.centered1 {padding-left: 30%;
+ padding-bottom: 0.5cm;
+ }
+ DIV.bordered { background-color: #f2f4ff;
+ border: 1px solid gray;
+ padding-left: 0.4cm;
+ padding-right: 0.4cm;
+ padding-top: 0.5cm;
+ padding-bottom: 0.5cm;
+ margin-left: 2.0cm;
+ margin-right: 1.0cm;
+ }
+ BODY.body {background-color: #ffffff; /* white */
+ margin-left: 0.5cm;
+ margin-right: 0.5cm;
+ }
+</style>
+</head>
+<body class="body">
-<center><h2>An Introduction To FM</h2></center>
-
-<center>
+<div class="topheader" id="fmintro">An Introduction To FM</div>
+<div class="centered1">
<img src="pix/fmad1.png" alt="radio ad">
<img src="pix/fmad2.png" alt="intro">
+
<!--
- this Zenith brochure is probably from around 1952 --these 3 models were introduced
+ this Zenith brochure is probably from around 1952: these 3 models were introduced
between 1950 and 1952. Schematics are available online,
http://www.nostalgiaair.org/PagesByModel/573/M0025573.pdf
for example (the others are at the same site). There are
@@ -21,14 +109,8 @@
frequency band) were from ca 1940. There are good pictures at various websites,
http://userpages.bright.net/~geary/fm/index.html for example.
-->
-
-</center>
-<br>
-
-<center>Bill Schottstaedt</center>
-
-<br>
-
+</div>
+<div class="centered">Bill Schottstaedt</div>
<!-- the latex stuff is always embedded in:
@@ -42,7 +124,6 @@
-->
<!-- INDEX fmintro:Frequency Modulation -->
-<A NAME="fmintro"></A>
<p>In frequency modulation we modulate the frequency — "modulation" here is just a latinate word for
"change". Vibrato and glissando are frequency modulation. John Chowning tells me that he
@@ -53,9 +134,7 @@ can express this (the vibrato, not the neat story) as:
<!-- LATEX \[\cos \, (\omega_{c}t+f(t))\] -->
-<img src="pix/fmeq1.png" alt="cos(wt + f)" hspace=20>
-
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>FM and phase modulation</h5></center></td></tr></table>
+<img class="indented" src="pix/fmeq1.png" alt="cos(wt + f)">
<p>where the c subscript stands for "carrier" and f(t) means "some arbitrary function added to the
carrier". Since cos takes an angle as its argument, f(t) modulates (that is, changes) the angle
@@ -66,9 +145,9 @@ the argument to cos
our formula can viewed either way. Since the angle is being incremented by the carrier frequency in
either case, the difference is between:
</p>
-<pre>
- PM: cos((angle += incr) + change)
- FM: cos(angle += (incr + change))
+<pre class="indented">
+PM: cos((angle += incr) + change)
+FM: cos(angle += (incr + change))
</pre>
<p>
To make the difference clear, textbooks
@@ -82,7 +161,7 @@ fmeq3:
\cos \, (\omega_{c}t + \!\int_{0}^{t}\! f(t) \, \mathrm{d} t)
-->
-<img src="pix/fmeq3.png" alt="cos + integral" hspace=20>
+<img class="indented" src="pix/fmeq3.png" alt="cos + integral">
<p>In PM we change the phase, in FM we change the phase increment, and
@@ -93,7 +172,8 @@ what the modulating signal is. In sound synthesis, where we can do what we want
there is no essential difference between frequency and phase modulation.
</p>
-<table border=1 hspace=50 cellpadding=14><tr><td>
+
+<div class="bordered">
<p>I would call this issue a dead horse, but it is still causing confusion, even 40 years
down the road. So,
@@ -104,10 +184,8 @@ the same parameters. Also, to lay a different controversy to rest, it should be
functions that there is no difference in run-time computational expense or accuracy.
</p>
-</td></tr><tr><td bgcolor="#f6f8ff">
-
<!-- CLM CASE
-<pre>
+<pre class="indented">
(definstrument pm (beg end freq amp mc-ratio index) ; "mc-ratio" = modulator to carrier frequency ratio
(let ((carrier-phase 0.0) ; set to pi/2 if someone tells you PM can't generate energy at DC
(carrier-phase-incr (hz->radians freq))
@@ -150,13 +228,13 @@ functions that there is no difference in run-time computational expense or accur
-->
<!-- SND CASE -->
-<pre>
+<pre class="indented">
(define (pm beg end freq amp mc-ratio index) ; "mc-ratio" = modulator to carrier frequency ratio
(let ((carrier-phase 0.0) ; set to pi/2 if someone tells you PM can't produce energy at 0Hz
(carrier-phase-incr (hz->radians freq))
(modulator-phase 0.0)
(modulator-phase-incr (hz->radians (* mc-ratio freq))))
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
(let* ((modulation (* index (sin modulator-phase)))
(pm-val (* amp (sin (+ carrier-phase modulation)))))
@@ -173,7 +251,7 @@ functions that there is no difference in run-time computational expense or accur
;; (pi+incr)/2 to get (centered) sin after integration, to match pm case above
(fm-index (hz->radians (* mc-ratio freq index))))
;; fix up fm index (it's a frequency change)
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
(let ((modulation (* fm-index (sin modulator-phase)))
(fm-val (* amp (sin carrier-phase))))
@@ -191,7 +269,7 @@ functions that there is no difference in run-time computational expense or accur
</pre>
<!-- -->
-</td></tr></table>
+</div>
<!-- a check of these instruments:
@@ -202,8 +280,8 @@ functions that there is no difference in run-time computational expense or accur
(sum 0.0)
(mx 0.0)
(mxloc 0)
- (N (min (frames s1 c1) (frames s2 c2))))
- (do ((i 0 (+ 1 i)))
+ (N (min (framples s1 c1) (framples s2 c2))))
+ (do ((i 0 (+ i 1)))
((= i N))
(let ((diff (- (r1) (r2))))
(if (> (abs diff) mx)
@@ -254,54 +332,54 @@ functions that there is no difference in run-time computational expense or accur
(2.47456807755109 0.0168174412101507 99627)
;;; the difference is proportional to the inverse square of the sampling rate,
-;;; which I interpret as caused by the "centering" -- it is hard to say what
+;;; which I interpret as caused by the "centering"; it is hard to say what
;;; the "true" or effective FM modulator initial-phase is, so a naive comparison
;;; with the bessel functions makes FM look "inaccurate". We can turn the
;;; tables by using cos, and a PM modulator initial phase of
;;; (+ pi (* 0.5 (+ pi (hz->radians mfreq))))
;;; (to match outputs), then complain that PM is inaccurate. Just to add to
;;; the confusion, in the latter case, the difference seems to be directly
-;;; proportional to srate(?) -- enough...
+;;; proportional to srate(?); enough...
-->
-<br>
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>simple FM: sin(sin)</h5></center></td></tr></table>
+
+<div class="greenish">simple FM: sin(sin)</div>
<p>Given our formula for FM, let's assume, for starters, that f(t) is a sinusoid:
</p>
<!-- LATEX \[ \cos \, (\omega_{c}t+B\sin \omega_{m}t) \] -->
-<img src="pix/fmeq4.png" alt="cos(sin)" hspace=20>
+<img class="indented" src="pix/fmeq4.png" alt="cos(sin)">
<p>where the "m" stands for "modulator" and the "B" factor is usually called the modulation index.
The corresponding CLM code is:
</p>
-<pre>
- (oscil carrier (* B (oscil modulator)))
+<pre class="indented">
+(oscil carrier (* B (oscil modulator)))
</pre>
<p>where oscil is (essentially):
</p>
<!-- CLM CASE
-<pre>
- (defun oscil (oscillator &optional (fm-input 0.0) (pm-input 0.0))
- (prog1
- (sin (+ (mus-phase oscillator) pm-input))
- (incf (mus-phase oscillator) (+ (mus-frequency oscillator) fm-input))))
+<pre class="indented">
+(defun oscil (oscillator &optional (fm-input 0.0) (pm-input 0.0))
+ (prog1
+ (sin (+ (mus-phase oscillator) pm-input))
+ (incf (mus-phase oscillator) (+ (mus-frequency oscillator) fm-input))))
</pre>
-->
<!-- SND CASE -->
-<pre>
- (define* (oscil oscillator (fm-input 0.0) (pm-input 0.0))
- (let ((result (sin (+ oscillator-phase pm-input))))
- (set! oscillator-phase (+ oscillator-phase (+ oscillator-phase-increment fm-input)))
- result))
+<pre class="indented">
+(define* (oscil oscillator (fm-input 0.0) (pm-input 0.0))
+ (let ((result (sin (+ oscillator-phase pm-input))))
+ (set! oscillator-phase (+ oscillator-phase (+ oscillator-phase-increment fm-input)))
+ result))
</pre>
<!-- -->
@@ -314,32 +392,32 @@ By the trigonometric identity:
<!-- LATEX \[ \cos (a+b)=\cos a\cos b - \sin a \sin b \] -->
-<img src="pix/fmeq5.png" alt="cos a+b" hspace=20>
+<img class="indented" src="pix/fmeq5.png" alt="cos a+b">
<!-- LATEX \[B\sin \omega_{m}t \] -->
-<p>we can substitute <img src="pix/fmeq23.png" alt="wct" align=absmiddle> for "a" and
-<img src="pix/fmeq9.png" alt="bsin" align=absmiddle>
+<p>we can substitute <img src="pix/fmeq23.png" alt="wct"> for "a" and
+<img src="pix/fmeq9.png" alt="bsin">
for "b" and get:
</p>
<!-- LATEX \[ \cos (\omega_{c}t+B\sin \omega_{m}t)=\cos \omega_{c}t \, \cos (B \sin \omega_{m}t) - \sin \omega_{c}t \, \sin (B\sin \omega_{m}t) \] -->
-<img src="pix/fmeq6.png" alt="cos (sin) expanded" hspace=20>
+<img class="indented" src="pix/fmeq6.png" alt="cos (sin) expanded">
<p>If we can get a Fourier transform of the two inner portions:
-<img src="pix/fmeq41.png" alt="cos sin" align=absmiddle> and
-<img src="pix/fmeq40.png" alt="sin sin" align=absmiddle>, we can use:
+<img src="pix/fmeq41.png" alt="cos sin"> and
+<img src="pix/fmeq40.png" alt="sin sin">, we can use:
</p>
<!-- LATEX \[ \cos (B \sin \omega_{m}t) \textrm{ and } \sin (B\sin \omega_{m}t) \]: fmeq7 -->
<!-- LATEX \sin (B\sin \omega_{m}t): fmeq40 -->
<!-- LATEX \cos (B \sin \omega_{m}t): fmeq41 -->
-<!-- <img src="pix/fmeq7.png" alt="cos and sin" hspace=20> -->
+<!-- <img src="pix/fmeq7.png" alt="cos and sin"> -->
<!-- LATEX
@@ -350,15 +428,15 @@ for "b" and get:
\end{eqnarray*}
-->
-<img src="pix/fmeq8.png" alt="coscos and sinsin" hspace=20>
+<img class="indented" src="pix/fmeq8.png" alt="coscos and sinsin">
<!-- LATEX \omega_{c}t -->
<p>to get the final results. "A" here is
-<img src="pix/fmeq23.png" alt="wct" align=absmiddle>
+<img src="pix/fmeq23.png" alt="wct">
in the earlier formulas, and "B" is either
-<img src="pix/fmeq41.png" alt="cos sin" align=absmiddle> or
-<img src="pix/fmeq40.png" alt="sin sin" align=absmiddle>.
+<img src="pix/fmeq41.png" alt="cos sin"> or
+<img src="pix/fmeq40.png" alt="sin sin">.
The Fourier transform we want is not obvious to us (not to me, certainly!), so we go to Abramowitz and Stegun,
"Handbook of Mathematical Functions" and find (formulas 9.1.42 and 9.1.43):
</p>
@@ -366,18 +444,18 @@ The Fourier transform we want is not obvious to us (not to me, certainly!), so w
<!-- LATEX \cos(B\sin\omega_{m}t)=J_{0}(B)+2J_{2}(B)\cos 2\omega_{m}t + \,\cdots\, + 2J_{2n}(B)\cos 2n\omega_{m}t + \,\cdots -->
-<img src="pix/fmeq10.png" alt="cos B sin t" hspace=20 vspace=3>
+<img class="indented" src="pix/fmeq10.png" alt="cos B sin t">
<!-- LATEX \sin(B\sin\omega_{m}t)=2J_{1}(B)\sin\omega_{m}t+2J_{3}(B)\sin 3\omega_{m}t + \,\cdots\, + 2J_{2n-1}(B)\sin (2n-1)\omega_{m}t + \,\cdots -->
-<img src="pix/fmeq11.png" alt="sin B sin t" hspace=20 vspace=6>
+<img class="indented" src="pix/fmeq11.png" alt="sin B sin t">
-<table border=0><tr>
-<td>
+<table>
+<tr><td>
<p>Here the J's refer to the Bessel functions which we will return to later.
First, let's finish this
expansion; we take these two sums and
-<img src="pix/fmeq23.png" alt="wct" align=absmiddle>
+<img src="pix/fmeq23.png" alt="wct">
and plug them into our first expansion of the FM
formula, and out pops:
</p>
@@ -394,7 +472,7 @@ formula, and out pops:
\end{eqnarray*}
-->
-<img src="pix/fmeq12.png" alt="cos w+sin" hspace=20>
+<img class="indented" src="pix/fmeq12.png" alt="cos w+sin">
<p>or in a slightly more compact form:
@@ -402,35 +480,35 @@ formula, and out pops:
<!-- LATEX \sum_{n=-\infty}^{\infty} \! \! J_{n}(B)\cos(\omega_{c} + n\omega_{m})t -->
-<img src="pix/fmeq13.png" alt="sum J cos" hspace=20>
+<img class="indented" src="pix/fmeq13.png" alt="sum J cos">
<!-- LATEX J_{-n}(x) = (-1)^{n}J_{n}(x) -->
<p>Here we are using the fact that
-<img src="pix/fmeq14.png" alt="J - J" align=absmiddle>.
+<img src="pix/fmeq14.png" alt="J - J">.
We can change our point of view on the first part of the expansion given above, and ask for the
amplitude of a given sideband:
</p>
<!-- LATEX J_{n}(B) = \frac{2}{\pi} \int_{0}^{\frac{\pi}{2}} \sin(B\sin\omega) \sin n\omega \: \mathrm{d}\omega \qquad \textrm{(n odd)} -->
-<img src="pix/fmeq15.png" alt="J sin int" hspace=20><br>
+<img class="indented" src="pix/fmeq15.png" alt="J sin int"><br>
<!-- LATEX J_{n}(B) = \frac{2}{\pi} \int_{0}^{\frac{\pi}{2}} \cos(B\sin\omega) \cos n\omega \: \mathrm{d}\omega \qquad \textrm{(n even)} -->
-<img src="pix/fmeq16.png" alt="J cos int" hspace=20 vspace=6>
+<img class="indented" src="pix/fmeq16.png" alt="J cos int">
<!-- LATEX \omega_{m} : fmeq42 -->
<!-- LATEX \omega_{c} : fmeq43 -->
<p>We end up with a spectrum made up of a "carrier" at
-<img src="pix/fmeq43.png" alt="wc" align=absmiddle>
+<img src="pix/fmeq43.png" alt="wc">
and symmetrically placed sidebands
separated by
-<img src="pix/fmeq42.png" alt="wm" align=absmiddle>.
-The amplitudes follow the Bessel functions. I put carrier in quotes because in
+<img src="pix/fmeq42.png" alt="wm">.
+The amplitudes follow the Bessel functions. I put carrier in quotes because in
computer music we listen to the result of the modulation (this was Chowning's idea — see "The
Synthesis of Complex Audio Spectra by Means of Frequency Modulation"). The Bessel functions
are nearly 0 until the index (B) equals the order (n). Then they have a bump and tail off as
@@ -438,17 +516,17 @@ a sort of damped sinusoid:
</p>
</td><td>
-<table border=1 hspace=30 cellpadding=6>
+<table class="bordered">
<tr><td>
<img src="pix/jacobi.png" alt="page from Jacobi's works">
</td></tr>
<tr>
-<td bgcolor="#f6f8ff">
-<center>C G J Jacobi, Gesammelte Werke, VI 101</center>
+<td class="bluishb">
+C G J Jacobi, Gesammelte Werke, VI 101
</td></tr></table>
</td></tr></table>
-<img src="pix/bessel.png" alt="bessel functions" hspace=20>
+<img src="pix/bessel.png" alt="bessel functions">
<p>
As the index sweeps
@@ -458,12 +536,12 @@ The important thing to get from these Bessel functions is that the higher the in
more dispersed the spectral energy — normally a brighter sound.
</p>
-<table border=1 cellpadding=4 hspace=20 vspace=10>
+<table class="bordered">
<tr>
-<td bgcolor="#f6f8ff"><center>carrier=1000, mod=100, index=1.0</center></td>
-<td bgcolor="#f6f8ff"><center>carrier=1000, mod=100, index=2.0</center></td>
-<td bgcolor="#f6f8ff"><center>carrier=1000, mod=100, index=3.0</center></td>
+<td class="bluishb">carrier=1000, mod=100, index=1.0</td>
+<td class="bluishb">carrier=1000, mod=100, index=2.0</td>
+<td class="bluishb">carrier=1000, mod=100, index=3.0</td>
</tr>
<tr>
@@ -477,15 +555,14 @@ more dispersed the spectral energy — normally a brighter sound.
<pre>
J0(1.0) = 0.765 -> 1.0 (*)
J1(1.0) = 0.440 -> 0.575
- J2(1.0) = 0.115 -> 0.150
- J3(1.0) = 0.019 -> 0.025
+ J2(1.0) = 0.115 -> 0.150
+ J3(1.0) = 0.019 -> 0.025
J4(1.0) = 0.002 -> 0.003
-(* Jn values normalized to match
-the fft peak values given above)
+(* Jn values normalized to match
+the peak values given above)
</pre>
-</td>
-<td>
+</td><td>
<pre>
J0(2.0) = 0.224 -> 0.388 (*)
J1(2.0) = 0.577 -> 1.0
@@ -495,8 +572,8 @@ the fft peak values given above)
J5(2.0) = 0.007 -> 0.012
J6(2.0) = 0.001 -> 0.002
</pre>
-<small><center>(A larger FFT reduces the mismatch)</center></small>
-<!-- well, sort of -- almost exact: Dolph-Chebyshev window, B=0.9, (also Blackman10), size=2^22, srate=1000000, carfreq=1000 -->
+<small>(A larger FFT reduces the mismatch)</small>
+<!-- well, sort of; almost exact: Dolph-Chebyshev window, B=0.9, (also Blackman10), size=2^22, srate=1000000, carfreq=1000 -->
</td>
<td>
<pre>
@@ -512,14 +589,34 @@ the fft peak values given above)
</tr>
</table>
+<!-- in code:
+(let ((amps (make-vector 20 0.0))
+ (freq (hz->radians 100)))
+ (vector-set! amps 10 (bes-jn 0 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 5))
+ (vector-set! amps (- 10 i) (bes-jn (- i) 1.0))
+ (vector-set! amps (+ 10 i) (bes-jn i 1.0)))
+
+ (with-sound (:channels 2)
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x freq)))
+ ((= i 44100))
+ (let ((y 0.0))
+ (do ((j 5 (+ j 1)))
+ ((= j 16))
+ (set! y (+ y (* (amps j) (sin (* x j))))))
+ (outa i y)
+ (outb i (sin (+ (* x 10) (sin x))))))))
+-->
<p>There is a rule of thumb, Mr Carson's rule, about the overall bandwidth of the resultant spectrum (it
follows from our description of the Bessel functions): Roughly speaking, there are fm-index+1
significant sidebands on each side of the carrier, so our total bandwidth is more or less
</p>
-<pre>
- 2 * modulator-frequency * (fm-index + 1)
+<pre class="indented">
+2 * modulator-frequency * (fm-index + 1)
</pre>
<p>This is a good approximation — 99% of the signal power is within its limits. To turn that around, we can
@@ -534,24 +631,30 @@ produce the same magnitude spectrum as FM produces), we get a very different wav
FM version sound richer and, far more importantly, louder?
</p>
-<table border=0 hspace=100>
+<table class="borderedm">
<tr><td>
<img src="pix/fmtime.png" alt="time domain comparisons">
</td></tr>
-<tr><td bgcolor="#f6f8ff">
-<center>FM waveform (index: 3.0) vs sum of cosines with the same (relative) component amplitudes</center>
+<tr><td class="bluishcentered">
+FM waveform (index: 3.0) vs sum of cosines with the same (relative) component amplitudes
</td></tr>
</table>
-<p>I think FM gives the minimum peak amplitude that its
-components could have produced, given any set of initial phases. From one point of view (looking at FM as changing the phase passed to
+<p>
+From one point of view (looking at FM as changing the phase passed to
the sin function), it's obvious that the output waveform should be this well behaved, but looking at it from its components,
it strikes me as a minor miracle that there is a set of amplitudes (courtesy of the Bessel functions) that fits together so perfectly.
Here is an attempt to graph
the 15 main components, with their sum in black:
</p>
-<img src="pix/fmadd.png" alt="fm components" hspace=100>
+<!-- the min peak attribute is surprising because it means FM is a worst case;
+ yet searches so far have come up empty!
+ and oddly there seem to be bazillions of cases at 1.0: symmetry?
+ (accidentally deleted the data, but see t738.scm to recompute it)
+-->
+
+<img src="pix/fmadd.png" alt="fm components">
<br>
<!--
@@ -577,16 +680,15 @@ the 15 main components, with their sum in black:
(set! (cur-phases (+ j 2)) (/ pi 2)))
(let ((gen (make-polyoid freq cur-phases)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 88200))
- (outa i (polyoid gen 0.0))))))))
+ (outa i (polyoid gen 0.0)))))))
-(with-sound (:output "test1.snd")
+(with-sound ("test1.snd")
(let* ((cgen (make-oscil 1000))
(mgen (make-oscil 100))
(index (hz->radians (* 3 100))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (oscil cgen (* index (oscil mgen)))))))
@@ -617,9 +719,6 @@ the 15 main components, with their sum in black:
-->
-<br>
-
-
<!-- LATEX sceq42: \frac{1}{2i}(e^{ix} - e^{-ix}) -->
<!-- LATEX
@@ -638,13 +737,14 @@ fmeq17: e^{\frac{1}{2}(t - \frac{1}{t})}
\mathrm{and}\ \mathrm{let}\ t = e^{i\phi} \\
-->
-<table border=1 hspace=50 cellpadding=10 vspace=10><tr><td>
-<small>
+
+<table class="borderedm">
+<tr><td>
Then there's the perennial question "why Bessel functions?".
-Most explanations start with <img src="pix/fmeq45.png" alt="jacobi formula" align=absmiddle>: <i>obscurum per obscurius</i>!
-A different tack might be to start with <img src="pix/sceq42.png" alt="sin in terms of e" align=absmiddle>, a definition of sine,
+Most explanations start with <img src="pix/fmeq45.png" alt="jacobi formula">: <em>obscurum per obscurius</em>!
+A different tack might be to start with <img src="pix/sceq42.png" alt="sin in terms of e">, a definition of sine,
and call the "e^(ix)" terms "t",
-then cos(sin) involves terms like <img src="pix/fmeq17.png" alt="cos(sin) in e" align=absmiddle>,
+then cos(sin) involves terms like <img src="pix/fmeq17.png" alt="cos(sin) in e">,
which is one (convoluted) way to define Bessel functions.
Or perhaps most forthright, start with the formula for Jn(B) given above (the integral), and say "we want cos(sin) expanded as a sum of cosines, and we
define Jn to be the nth coefficient in that sum".
@@ -656,21 +756,21 @@ and Fourier (the motion of heat in a cylinder, 1822); Bessel studied them in the
about them in 1824.
For an explanation of the connection between planetary motion and FM, see Benson, "Music: A Mathematical Offering".
Just for completeness, here's a derivation following Gray and Mathews, "A Treatise on Bessel Functions":
-<img src="pix/fmeq59.png" alt="et again" vspace=5>
-</small>
+<img src="pix/fmeq59.png" alt="et again">
</td></tr></table>
+
<!-- should we do the expansion by hand? -->
-<br>
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>simple FM examples</h5></center></td></tr></table>
+
+<div class="greenish">simple FM examples</div>
<p>Here's a simple FM instrument:
</p>
-<table border=0 bgcolor="#f6f8ff" hspace=20><tr><td>
+
<!-- CLM CASE
-<pre>
+<pre class="indented">
(definstrument fm (beg dur freq amp mc-ratio index &optional (index-env '(0 1 100 1)))
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
@@ -688,7 +788,7 @@ Just for completeness, here's a derivation following Gray and Mathews, "A Treati
-->
<!-- SND CASE -->
-<pre>
+<pre class="indented">
(define* (fm beg dur freq amp mc-ratio index (index-env '(0 1 100 1)))
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
@@ -697,23 +797,22 @@ Just for completeness, here's a derivation following Gray and Mathews, "A Treati
(fm-index (hz->radians (* index mc-ratio freq)))
(ampf (make-env index-env :scaler amp :duration dur))
(indf (make-env index-env :scaler fm-index :duration dur)))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (outa i (* (env ampf) ; amplitude env
- (oscil cr (* (env indf) ; carrier + modulation env
- (oscil md))))))))) ; modulation
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* (env ampf) ; amplitude env
+ (oscil cr (* (env indf) ; carrier + modulation env
+ (oscil md)))))))) ; modulation
</pre>
<!-- -->
-</td></tr></table>
+
<p>I put an envelope on the fm-index ("indf" above) to try out dynamic spectra ("dynamic" means
"changing" here). For now, don't worry too much about the actual side band amplitudes. They
will not always match Chowning's description, but we'll get around to an explanation eventually.
</p>
-<pre>
- (with-sound () (fm 0 1.0 100 .5 1.0 4.0))
+<pre class="indented">
+(with-sound () (fm 0 1.0 100 .5 1.0 4.0))
</pre>
<p>is Chowning's first example. Sure enough, it's a complex spectrum (that is, it has lots of
@@ -722,51 +821,51 @@ frequency to carrier frequency ratio (mc-ratio above) is 1.0, we get sidebands a
carrier. If we use an mc-ratio of .25 and a carrier of 400:
</p>
-<pre>
- (with-sound () (fm 0 1.0 400 .5 0.25 4.0))
+<pre class="indented">
+(with-sound () (fm 0 1.0 400 .5 0.25 4.0))
</pre>
<p>we end up with the same perceived pitch because the sidebands are still at multiples of 100 Hz.
</p>
-<pre>
- (with-sound () (fm 0 1.0 400 .5 1.1414 4.0))
+<pre class="indented">
+(with-sound () (fm 0 1.0 400 .5 1.1414 4.0))
</pre>
<p>has inharmonic sidebands. Most real sounds seem to change over the course of a note, and it was at one time thought that most
of this change was spectral. To get a changing spectrum, we need only put an envelope on the fm-index:
</p>
-<pre>
- (with-sound () (fm 0 0.5 400 .5 1.0 5.0 '(0 0 20 1 40 .6 90 .5 100 0)))
+<pre class="indented">
+(with-sound () (fm 0 0.5 400 .5 1.0 5.0 '(0 0 20 1 40 .6 90 .5 100 0)))
</pre>
<p>making a brass-like sound. Similarly, Chowning suggests that
</p>
-<pre>
- (with-sound () (fm 0 1.0 900 .5 1/3 2.0 '(0 0 6 .5 10 1 90 1 100 0)))
+<pre class="indented">
+(with-sound () (fm 0 1.0 900 .5 1/3 2.0 '(0 0 6 .5 10 1 90 1 100 0)))
</pre>
<p>is a woodwind-like tone,
</p>
-<pre>
- (with-sound () (fm 0 1.0 500 .5 .2 1.5 '(0 0 6 .5 10 1 90 1 100 0)))
+<pre class="indented">
+(with-sound () (fm 0 1.0 500 .5 .2 1.5 '(0 0 6 .5 10 1 90 1 100 0)))
</pre>
<p>is bassoon-like, and finally
</p>
-<pre>
- (with-sound () (fm 0 1.0 900 .5 2/3 2 '(0 0 25 1 75 1 100 0)))
+<pre class="indented">
+(with-sound () (fm 0 1.0 900 .5 2/3 2 '(0 0 25 1 75 1 100 0)))
</pre>
<p>is clarinet-like. Now start at 2000 Hz, set the mc-ratio to .1, and
sweep the FM index from 0 to 10, and the spectrogram looks like this:
</p>
-<img src="pix/fmsweep.png" alt="sweep index" hspace=40>
+<img src="pix/fmsweep.png" alt="sweep index">
<p>
There is a lot of music in simple FM. You get a full spectrum at little computational expense, and
@@ -782,35 +881,37 @@ And since the number of significant components in the spectrum is nearly proport
<!-- LATEX fmeq55: & \sum i^{n} I_{n}(b)\cos(\omega_{c} + n\omega_{m})t -->
<!-- LATEX fmeq56: & \sum \sum i^{k} J_{n}(a) I_{k}(b)\cos(\omega_{c} + (n + k)\omega_{m})t -->
-<table border=1 hspace=50><tr><td>
-<table border=0 cellspacing=10><tr><td>
-<small>
-A slightly bizarre sidelight: there's no law against a modulating signal made up of complex numbers.
+
+
+<table class="borderedm">
+<tr><td>
+<p>A slightly bizarre sidelight: there's no law against a modulating signal made up of complex numbers.
In this case, cos is no longer bounded, so the output can peak at anything, but
-we still get FM-like spectra. <img src="pix/fmeq54.png" alt="J=I" align=absmiddle>, where "I" is
+we still get FM-like spectra. <img src="pix/fmeq54.png" alt="J=I">, where "I" is
the modified Bessel function,
so if our index is purely imaginary, we can expand cos(wc + bi sin wm)t as
-<br>
-<img src="pix/fmeq55.png" alt="i case" hspace=40 vspace=6>
-<br>
-If our index is a + bi, we get
-<br>
-<img src="pix/fmeq56.png" alt="a=bi case" hspace=40 vspace=6>
-<br>
-This looks similar to normal FM,
+</p>
+
+<img class="indented" src="pix/fmeq55.png" alt="i case">
+
+<p>If our index is a + bi, we get
+</p>
+
+<img class="indented" src="pix/fmeq56.png" alt="a=bi case">
+
+<p>This looks similar to normal FM,
but with normalization headaches. Perhaps we can take advantage of the split betweeen the
real and imaginary parts — unexplored territory!
-</small>
-</td></tr></table></td>
-
-<td>
-<table border=0>
+</p>
+</td></tr>
+<tr><td>
+<table>
<tr><td>
<img src="pix/fmc63.png" alt="complex index fm 6.0+3.0i 0.5 interp">
</td></tr>
-<tr><td bgcolor="#f6f8ff"><small><center>index: 6+3i</center></small></td></tr></table>
-</td></tr>
-</table>
+<tr><td class="bluishb">here the index is 6+3i
+</td></tr></table>
+</td></tr></table>
<!-- here's an instrument to test complex indices:
@@ -821,8 +922,8 @@ real and imaginary parts — unexplored territory!
(cr-incr (hz->radians freq))
(md-incr (hz->radians (* freq mc-ratio)))
(md 0.0) ; (* 0.5 (+ pi md-incr)))
- (fm-index (/ (* 2 pi index mc-ratio freq) (mus-srate)))) ; hz->radians with complex arg and result
- (do ((i start (+ 1 i)))
+ (fm-index (/ (* 2 pi index mc-ratio freq) *clm-srate*))) ; hz->radians with complex arg and result
+ (do ((i start (+ i 1)))
((= i end))
(outa i (* amp (real-part (sin cr)))) ; or magnitude in place of real-part
(set! cr (+ cr cr-incr (* fm-index (sin md))))
@@ -837,7 +938,7 @@ real and imaginary parts — unexplored territory!
(cr-incr (hz->radians freq))
(md-incr (hz->radians (* freq mc-ratio)))
(md 0.0))
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(outa i (* amp (real-part (sin (+ cr (* fm-index (sin md)))))))
(set! cr (+ cr cr-incr))
@@ -852,7 +953,7 @@ real and imaginary parts — unexplored territory!
(cr-incr (hz->radians freq))
(md-incr (hz->radians (* freq mc-ratio)))
(md 0.0))
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(let ((val (sin (+ cr (* fm-index (sin md))))))
(outa i (* amp (+ (* (- 1.0 interp) (real-part val))
@@ -877,8 +978,8 @@ real and imaginary parts — unexplored territory!
(/ (bes-in 5 3) (bes-in 0 3))
0.0186868169578955 [.018]
-;(with-sound (:clipped #f :statistics #t) (fpmc 0 2 1000.0 1.0 0.1 6.0+3.0i 0.5)) -- shows same cancellation as earlier 3+1 case
-;(with-sound (:clipped #f :statistics #t :srate (* 4 16384)) (fpmc 0 2 1000.0 1.0 0.1 6.0+3.0i 0.5)) -- need srate change to get freqs rounded correctly
+;(with-sound (:clipped #f :statistics #t) (fpmc 0 2 1000.0 1.0 0.1 6.0+3.0i 0.5)); shows same cancellation as earlier 3+1 case
+;(with-sound (:clipped #f :statistics #t :srate (* 4 16384)) (fpmc 0 2 1000.0 1.0 0.1 6.0+3.0i 0.5)); need srate change to get freqs rounded correctly
(fm-a+bi 1000 1000 100 6.0 3.0 0.5 #f)
;add -0.00533062568641282 from J-6(6.0) = 0.245836863364327 and I6(3.0) = 0.0216835897328909
@@ -928,7 +1029,7 @@ real and imaginary parts — unexplored territory!
;add 0.0800703403091294 from J6(6.0) = 0.245836863364327 and I-4(3.0) = 0.325705181937936
;add 0.0-0.0118191420664103i from J7(6.0) = 0.129586651841481 and I-5(3.0) = 0.0912064776615134
;add -0.00122581649816301 from J8(6.0) = 0.0565319909324618 and I-6(3.0) = 0.0216835897328909
-(-2.33443662315078-1.48617977275652i -1.91030819795365) [(/ 1.91 2.19) = .872 -- .874]
+(-2.33443662315078-1.48617977275652i -1.91030819795365) [(/ 1.91 2.19) = .872 == .874]
(fm-a+bi 1300 1000 100 6.0 3.0 0.5 #f)
;add -0.0-0.00159941567462897i from J-4(6.0) = 0.357641594780961 and I7(3.0) = 0.00447211872994957
@@ -944,7 +1045,7 @@ real and imaginary parts — unexplored territory!
;add -0.0+0.235942821877827i from J6(6.0) = 0.245836863364327 and I-3(3.0) = 0.959753629496008
;add 0.0422070440147574 from J7(6.0) = 0.129586651841481 and I-4(3.0) = 0.325705181937936
;add 0.0-0.00515608376814245i from J8(6.0) = 0.0565319909324618 and I-5(3.0) = 0.0912064776615134
-(0.502475925962626-2.31154049748365i -0.90453228576051) [(/ (/ 0.90 2.19) = 0.411 -- .413]
+(0.502475925962626-2.31154049748365i -0.90453228576051) [(/ (/ 0.90 2.19) = 0.411 == .413]
(fm-a+bi 1400 1000 100 6.0 3.0 0.5 #f)
;add 0.00526636304188694 from J-2(6.0) = -0.242873209960185 and I6(3.0) = 0.0216835897328909
@@ -959,15 +1060,14 @@ real and imaginary parts — unexplored territory!
;add -0.0+0.124371259439097i from J7(6.0) = 0.129586651841481 and I-3(3.0) = 0.959753629496008
;add 0.0184127623919712 from J8(6.0) = 0.0565319909324618 and I-4(3.0) = 0.325705181937936
;add 0.0-0.00193041464863622i from J9(6.0) = 0.0211653239784174 and I-5(3.0) = 0.0912064776615134
-(1.81180116486504-0.564042995574322i 0.623879084645359) [(/ 0.623 2.19) = 0.284 -- .287]
+(1.81180116486504-0.564042995574322i 0.623879084645359) [(/ 0.623 2.19) = 0.284 == .287]
-1500: [(/ 0.936 2.19) = 0.427 -- .428]
-1600: [(/ 0.496 2.19) = 0.226 -- .228]
-1700: [(/ 0.102 2.19) = 0.047 -- .047]
+1500: [(/ 0.936 2.19) = 0.427 == .428]
+1600: [(/ 0.496 2.19) = 0.226 == .228]
+1700: [(/ 0.102 2.19) = 0.047 == .047]
-->
-<br>
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>phase quibbles: cos(sin)</h5></center></td></tr></table>
+<div class="spacer"></div>
<p>
I am getting carried away —
@@ -979,11 +1079,11 @@ that:
<!-- LATEX \sin(a+b)=\sin a \cos b + \cos a \sin b -->
-<img src="pix/fmeq18.png" alt="sin split" hspace=20><br>
+<img class="indented" src="pix/fmeq18.png" alt="sin split"><br>
<!-- LATEX \sin(\omega_{c}t+B\sin \omega_{m}t) = \sin \omega_{c}t \cos(B \sin \omega_{m}t) + \cos \omega_{c}t \sin(B \sin \omega_{m}t) -->
-<img src="pix/fmeq19.png" alt="sin split" hspace=20 vspace=8>
+<img class="indented" src="pix/fmeq19.png" alt="sin split">
<p>and using our previous formulas for the expansion of the cos(sin) and sin(sin) terms, with the
identity:
@@ -991,7 +1091,7 @@ identity:
<!-- LATEX \sin a \cos b = \frac{1}{2} (\sin (a-b) + \sin (a+b)) -->
-<img src="pix/fmeq20.png" alt="sin cos again" hspace=20 vspace=8>
+<img class="indented" src="pix/fmeq20.png" alt="sin cos again">
<p>we see that we still have a spectrum symmetric around the carrier, and the amplitude and frequencies
@@ -1000,7 +1100,7 @@ are just as they were before, but the initial phases of the side bands have chan
<!-- LATEX fmeq21: \sin (\omega_{c}t+B\sin \omega_{m}t) = \! \! \sum_{n=-\infty}^{\infty} \! \! J_{n}(B)\sin(\omega_{c} + n\omega_{m})t -->
-<img src="pix/fmeq21.png" alt="sin sin case" hspace=20>
+<img class="indented" src="pix/fmeq21.png" alt="sin sin case">
<p>This is Chowning's version of the expansion.
In general:
@@ -1009,7 +1109,7 @@ In general:
<!-- Gagliardi 2.2.11 -->
<!-- LATEX \cos(\omega_{c}t+B\sin(\omega_{m}t + \theta_{m}) + \phi) = \sum_{k=-\infty}^{\infty}J_{k}(B)\cos((\omega_{c}+k\omega_{m})t + k\theta_{m} + \phi) -->
-<img src="pix/fmeq22.png" alt="big formula" hspace=20>
+<img class="indented" src="pix/fmeq22.png" alt="big formula">
<!-- LATEX:
@@ -1023,14 +1123,14 @@ In general:
-->
<!--
-<table border=1 hspace=40 vspace=20><tr><td>
-<table border=0 hspace=20>
+<table><tr><td>
+<table>
<tr><td colspan=3>
Or perhaps more readable:
</td></tr>
<td>
<img src="pix/fmeq49.png" alt="cos cos cases">
-</td><td width=20></td>
+</td><td></td>
<td>
<img src="pix/fmeq50.png" alt="cos cos cases">
</td>
@@ -1045,22 +1145,18 @@ Or perhaps more readable:
<p>Our first reaction is, "well so what if one's a sine and the other's a cosine — they'll sound the
same", but we are being hasty. What if (for example), the modulator has the same frequency as the
carrier, and its index (B) is high enough that some significant energy appears at
-<img src="pix/fmeq24.png" alt="w-m=-w" align=absmiddle>?
+<img src="pix/fmeq24.png" alt="w-m=-w">?
Where does energy at a negative frequency go? We once again fall back on
-trigonometry: <img src="pix/fmeq52.png" alt="sin(-x)=-sin(x)" align=absmiddle>,
-but <img src="pix/fmeq53.png" alt="cos(-x)=cos(x)" align=absmiddle>,
+trigonometry: <img src="pix/fmeq52.png" alt="sin(-x)=-sin(x)">,
+but <img src="pix/fmeq53.png" alt="cos(-x)=cos(x)">,
so the negative frequency component adds to the positive frequency component if it's a cosine, but
subtracts if it's a sine. We get a different
pattern of cancellations depending on the initial phases of the carrier and modulator. Take the CLM
instrument:
</p>
-<table border=1 cellpadding=6 hspace=20 vspace=10>
-<tr>
-<td bgcolor="#f6f8ff">
-
<!-- CLM CASE
-<pre>
+<pre class="indented">
(definstrument pm (beg end freq amp fm-index mod-phase)
(let ((cr (make-oscil freq))
(md (make-oscil freq mod-phase)))
@@ -1075,40 +1171,34 @@ instrument:
-->
<!-- SND CASE -->
-<pre>
+<pre class="indented">
(define (pm beg dur freq amp fm-index mod-phase)
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
(cr (make-oscil freq))
(md (make-oscil freq mod-phase)))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (outa i (* amp (oscil cr 0.0
- (* fm-index (oscil md)))))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil cr 0.0
+ (* fm-index (oscil md))))))))
(with-sound () (pm 0 1.0 100 .5 8 0))
(with-sound () (pm 0 1.0 100 .5 8 (* .5 pi)))
</pre>
-<!-- -->
-</td>
-<td>
- <table border=0><tr><td>
+
+
+<table class="borderedm">
+<tr><td>
<img src="pix/fmeq25.png" alt="mod phase 0">
- </td></tr>
- <tr><td><center>mod phase = 0.0</center>
- </td></tr></table>
-</td>
-<td>
- <table border=0><tr><td>
+</td><td>
<img src="pix/fmeq26.png" alt="mod phase pi/2">
</td></tr>
- <tr><td><center>mod phase = pi/2</center>
- </td></tr></table>
-</td>
+<tr><td class="bluishb">mod phase = 0.0
+</td><td class="bluishb">mod phase = pi/2
+</td></tr></table>
-</tr></table>
+<div class="spacer"></div>
<p>There is a slight difference! We're using phase-modulation for simplicity (the integration in FM
changes the effective initial phase).
@@ -1116,9 +1206,8 @@ By varying the relative phases, we can get a changing spectrum from these cancel
CLM instrument that shows this (subtle) effect:
</p>
-<table border=0 bgcolor="#f6f8ff" hspace=20><tr><td>
<!-- CLM CASE
-<pre>
+<pre class="indented">
(definstrument fm (beg end freq amp mc-ratio index car-phase mod-phase skew-func skew)
(let ((cr (make-oscil freq car-phase))
(md (make-oscil (* freq mc-ratio) mod-phase))
@@ -1133,25 +1222,19 @@ CLM instrument that shows this (subtle) effect:
-->
<!-- SND CASE -->
-<pre>
+<pre class="indented">
(define (fm beg dur freq amp mc-ratio index)
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
(cr (make-oscil freq))
(md (make-oscil (* freq mc-ratio)))
(skewf (make-env (list 0.0 0.0 1.0 pi) :duration dur)))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (outa i (* amp (oscil cr 0.0 (* index (oscil md 0.0 (env skewf))))))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil cr 0.0 (* index (oscil md 0.0 (env skewf)))))))))
(with-sound () (fm 0 2 100 0.5 1.0 30.0))
</pre>
-<!-- -->
-</td></tr></table>
-
-<br>
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>asymmetric spectra</h5></center></td></tr></table>
<p>The next question is "if we can get cancellations, can we fiddle with the phases and get
asymmetric FM spectra?". There are several approaches; an obvious one uses the
@@ -1161,8 +1244,7 @@ fact that:
<!-- LATEX see above -->
-<img src="pix/fmeq8.png" alt="coscos and sinsin" hspace=20>
-
+<img class="indented" src="pix/fmeq8.png" alt="coscos and sinsin">
<p>If we have a spectrum B made up entirely of sines (or entirely cosines), we can multiply it by
sin A (or cos A), add the two resulting spectra, and the (A + B) parts cancel.
@@ -1172,8 +1254,7 @@ but not anything we'd claim was single side-band.
<!-- CLM CASE
-<table border=0 bgcolor="#f6f8ff" hspace=20><tr><td>
-<pre>
+<pre class="indented">
(definstrument fm (beg end freq amp mc-ratio index cr0p cr1p md0p md1p)
(let ((cr0 (make-oscil 0 cr0p))
(cr1 (make-oscil 0 cr1p))
@@ -1189,15 +1270,12 @@ but not anything we'd claim was single side-band.
(with-sound () (fm 0 10000 1000 .25 .1 1.0 0 (* .5 pi) (* .5 pi) 0))
</pre>
-</td></tr></table>
-->
<!-- SND CASE -->
-<table border=1 hspace=10 cellpadding=6>
-<tr><td bgcolor="#f6f8ff">
-<pre>
+<pre class="indented">
(define (pm-cancellation beg dur carfreq modfreq amp index)
(let* ((cx 0.0)
(mx 0.0)
@@ -1205,7 +1283,7 @@ but not anything we'd claim was single side-band.
(mod-incr (hz->radians modfreq))
(start (seconds->samples beg))
(stop (+ start (seconds->samples dur))))
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i stop))
(outa i (* amp (- (* (cos cx) ; cos * sum-of-cos
(sin (* index (cos mx))))
@@ -1216,25 +1294,21 @@ but not anything we'd claim was single side-band.
(with-sound () (pm-cancellation 0 1 1000.0 100.0 0.3 9.0))
</pre>
-</td>
-<td>
- <table border=0>
+
+
+ <table class="borderedm">
<tr><td><img src="pix/fmeq27.png" alt="uncancelled"></td></tr>
- <tr><td bgcolor="#f6f8ff"><center>cos side by itself</center></td></tr>
+ <tr><td class="bluishb">cos side by itself</td></tr>
<tr><td><img src="pix/fmcancel.png" alt="fm cancellation"></td></tr>
- <tr><td bgcolor="#f6f8ff"><center>both sides (showing cancellations)</center></td></tr>
+ <tr><td class="bluishb">both sides (showing cancellations)</td></tr>
</table>
-</td>
-</tr></table>
-<!-- -->
+
<p>I really like the sounds you get from this cancellation; I can't resist adding the following
examples which come from a collection of "imaginary machines":
</p>
-<table border=1 hspace=10 cellpadding=6 vspace=10>
-<tr><td bgcolor="#f6f8ff">
-<pre>
+<pre class="indented">
(definstrument (machine1 beg dur cfreq mfreq amp index gliss)
(let* ((gen (make-fmssb cfreq mfreq :index 1.0)) ; defined in generators.scm
(start (seconds->samples beg))
@@ -1243,11 +1317,10 @@ examples which come from a collection of "imaginary machines":
(indf (make-env '(0 0 1 1 3 0) :duration dur :base 32 :scaler index))
(frqf (make-env (if (> gliss 0.0) '(0 0 1 1) '(0 1 1 0))
:duration dur :scaler (hz->radians (abs gliss)))))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i stop))
(set! (fmssb-index gen) (env indf))
- (outa i (* (env ampf) (fmssb gen (env frqf))))))))
+ (outa i (* (env ampf) (fmssb gen (env frqf)))))))
(with-sound (:play #t)
(do ((i 0.0 (+ i .2)))
@@ -1265,12 +1338,11 @@ examples which come from a collection of "imaginary machines":
(gen1 (make-rkoddssb 100.0 10.0 0.9))
(ampf (make-env '(0 0 1 1 11 1 12 0) :duration 11.0 :scaler .5))
(frqf (make-env '(0 0 1 1 2 0 10 0 11 1 12 0 20 0) :duration 11.0 :scaler (hz->radians 1.0))))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (* 12 44100)))
(outa i (* (env ampf)
(+ (rkoddssb gen1 (env frqf))
- (* .2 (sin (rkoddssb gen (rand noi))))))))))
+ (* .2 (sin (rkoddssb gen (rand noi)))))))))
(do ((i 0.0 (+ i 2)))
((>= i 10.0))
(machine1 i 3 100 700 0.5 4.0 0.0)
@@ -1280,40 +1352,38 @@ examples which come from a collection of "imaginary machines":
(machine1 i 3 1000 540 0.5 6.0 0.0)
(machine1 (+ i 1) 1 2000 540 0.5 1.0 0.0)))
</pre>
-</td></tr></table>
<!-- LATEX fmeq44: &\sum_{k=0}^{\infty} \frac{a^{k}}{k!} \cos(x + ky) = e^{a \cos y} \cos (x + a \sin y) \\ -->
-<table border=0><tr><td>
<p>A different approach, also using a form of amplitude modulation, is mentioned by Moorer in "Signal Processing Aspects of Computer Music":
</p>
-<img src="pix/fmeq44.png" alt="jam case" hspace=20>
+<img class="indented" src="pix/fmeq44.png" alt="jam case">
<p>This is the rxyk!cos generator in generators.scm. It produces beautiful single-sided spectra. We might grumble
that the sideband amplitudes don't leave us much room for maneuver, but the factorial in the denominator overwhelms
any exponential in the numerator, so we can get many interesting effects: moving formants, for example.
</p>
-</td>
-<td>
-<table hspace=3 border=1 cellpadding=3><tr><td>
+
+<table class="borderedm">
+<tr><td>
<img src="pix/jam.png" alt="jam pict">
</td></tr>
<tr>
-<td bgcolor="#f6f8ff"><center><small>a: 2, x:1000, y: 100</small></center>
-</td></tr></table>
+<td class="bluishb">a: 2, x:1000, y: 100
</td></tr></table>
<!--
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-rxyk!cos 1000 100 2)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rxyk!cos gen 0.0))))))
+ (outa i (rxyk!cos gen 0.0)))))
-->
+<div class="spacer"></div>
+
<p>
Palamin et al in "A Method of Generating and Controlling Musical Asymmetrical Spectra"
came up with a slightly more complicated version:
@@ -1321,7 +1391,7 @@ came up with a slightly more complicated version:
<!-- LATEX e^{(\frac{B}{2}(r-\frac{1}{r})\cos \omega_{m}t)}\sin(\omega_{c}t+\frac{B}{2}(r+\frac{1}{r})\sin \omega_{m}t)=\sum r^{n}J_{n}(B)\sin(\omega_{c}t+n\omega_{m}t) -->
-<img src="pix/fmeq29.png" alt="e sin" hspace=20>
+<img class="indented" src="pix/fmeq29.png" alt="e sin">
<p>But the peak amplitude of this formula is hard to predict; we'd rather have a sum of cosines:
@@ -1329,17 +1399,17 @@ came up with a slightly more complicated version:
<!--LATEX: e^{(\frac{B}{2}(r-\frac{1}{r})\cos \omega_{m}t)}\cos(\omega_{c}t+\frac{B}{2}(r+\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}J_{n}(B)\cos(\omega_{c}t+n\omega_{m}t) -->
-<img src="pix/fmeq47.png" alt="better asy" hspace=20>
+<img class="indented" src="pix/fmeq47.png" alt="better asy">
<!-- LATEX: e^{\frac{B}{2}\big(r-\frac{1}{r}\big)}=\sum_{n=-\infty}^{\infty} r^{n}J_{n}(B) -->
<p>so we can use</p>
-<img src="pix/fmeq48.png" alt="sum of Js" hspace=20>
+<img class="indented" src="pix/fmeq48.png" alt="sum of Js">
<p>to normalize the output to -1.0 to 1.0.
The spectrum produced for a given "r" is mirrored by -1/r (remembering that
-<img src="pix/fmeq14.png" alt="J - J" align=absmiddle>).
+<img src="pix/fmeq14.png" alt="J - J">).
</p>
<!-- LATEX:
@@ -1359,46 +1429,35 @@ The spectrum produced for a given "r" is mirrored by -1/r (remembering that
\end{document}
-->
-<table border=1 hspace=20 cellpadding=3>
-<tr><td bgcolor="#f6f8ff">
-<pre>
-Asymmetric FM with index=2.0, r=0.5:
-
-(using the asymmetric-fm generator in CLM)
-
-
+<pre class="indented">
(with-sound ()
- (let ((gen (make-asymmetric-fm 2000.0
- :ratio .2 :r 0.5)))
- (do ((i 0 (+ 1 i)))
+ (let ((gen (make-asymmetric-fm 2000.0 :ratio .2 :r 0.5)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
(outa i (asymmetric-fm gen 2.0)))))
</pre>
-</td>
-<td>
-<table border=0>
+<table class="borderedm">
<tr><td>
<img src="pix/asyfm1.png" alt="asy fm">
</td></tr>
<tr>
<td>
-<img src="pix/asyfm2.png" alt="peaks" hspace=10 vspace=10>
-</td></tr></table>
+<img src="pix/asyfm2.png" alt="peaks">
</td></tr></table>
+<div class="spacer"></div>
<p>We can put an envelope on either the index or "r"; the index
affects how broad the spectrum is, and "r" affects its placement relative to the carrier (giving the effect of
a moving formant). Here we sweep "r" from -1.0 to -20.0, with an index of 3, m/c ratio of .2, and carrier at 1000 Hz:
</p>
-<img src="pix/asyfm.png" alt="asy spectra">
+<img class="indented" src="pix/asyfm.png" alt="asy spectra">
-<br>
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>complex FM: sin(sin+sin)</h5></center></td></tr></table>
+<div class="greenish">complex FM: sin(sin+sin)</div>
<p>
So far we have been using just a sinusoid for the modulator; what if we make it a more complicated
@@ -1407,18 +1466,18 @@ signal? Here again trigonometry can be used to expand
<!-- LATEX \sin(\omega_{c}t + B_{1}\sin \omega_{m1}t + B_{2}\sin \omega_{m2}t) -->
-<img src="pix/fmeq30.png" alt="multiple sins" hspace=20>
+<img class="indented" src="pix/fmeq30.png" alt="multiple sins">
<!-- LATEX sceq41.png: x - \frac{x^{3}}{3!} + \frac{x^{5}}{5!} - \cdots -->
<p>The modulating signal is now made up of two sinusoids (don't despair; this is a terminating
-sequence). Since sine is not linear (it is <img src="pix/sceq41.png" alt="x-x^3/3!+x^5/5!..." align=absmiddle>), this is not the same thing as
+sequence). Since sine is not linear (it is <img src="pix/sceq41.png" alt="x-x^3/3!+x^5/5!...">), this is not the same thing as
</p>
<!-- LATEX \sin(\omega_{c}t + B_{1}\sin \omega_{m1}t) + \sin(B_{2}\sin \omega_{m2}t) -->
-<img src="pix/fmeq31.png" alt="bad sins" hspace=20>
+<img class="indented" src="pix/fmeq31.png" alt="bad sins">
<p>In the second case we just add together the two simple FM spectra, but in the first case
@@ -1436,7 +1495,7 @@ expressed:
<!-- LATEX fmeq32:
\sin(\omega_{c}t + B_{1}\sin \omega_{m1}t + B_{2}\sin \omega_{m2}t) = \sum_{i=-\infty}^{\infty} \sum_{k=-\infty}^{\infty} J_{i}(B_{1})J_{k}(B_{2})\sin(\omega_{c} + i\omega_{m1} + k\omega_{m2})t \\
-->
-<img src="pix/fmeq32.png" alt="2 sums" hspace=20>
+<img class="indented" src="pix/fmeq32.png" alt="2 sums">
<p>You can chew up any amount of free time calculating the resulting side band amplitudes — see the immortal classic:
Schottstaedt, "The Simulation of Natural Instrument Tones Using Frequency Modulation with a
@@ -1452,15 +1511,14 @@ In general:
\cos(\omega_{c}t+\Big(\sum_{i=1}^{k}B_{i}\sin(\omega_{i}t + \theta_{i})\Big) + \phi) = \sum_{k_{k}} \cdots \sum_{k_{1}}\Big(\prod_{i=1}^{k}J_{k_{i}}(B_{i})\Big)\cos(\omega_{c}t+\Big(\sum_{i=1}^{k}k_{i}(\omega_{i}t+\theta_{i})\Big)+\phi)
-->
-<img src="pix/fmeq33.png" alt="silly formula" hspace=20>
+<img class="indented" src="pix/fmeq33.png" alt="silly formula">
<p>A CLM instrument to produce this is:
</p>
-<table border=0 bgcolor="#f6f8ff" hspace=20 vspace=5><tr><td>
<!-- CLM CASE
-<pre>
+<pre class="indented">
(definstrument fm (beg end freq amp mc-ratios indexes carrier-phase mod-phases)
(let* ((cr (make-oscil freq carrier-phase))
(n (length mc-ratios))
@@ -1481,7 +1539,7 @@ In general:
-->
<!-- SND CASE -->
-<pre>
+<pre class="indented">
(define (fm beg dur freq amp mc-ratios indexes carrier-phase mod-phases)
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
@@ -1489,29 +1547,28 @@ In general:
(n (length mc-ratios))
(modulators (make-vector n))
(fm-indices (make-vct n)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i n))
- (set! (modulators i) (make-oscil (* freq (list-ref mc-ratios i)) (list-ref mod-phases i)))
- (set! (fm-indices i) (hz->radians (* freq (list-ref indexes i) (list-ref mc-ratios i)))))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! sum (+ sum (* (fm-indices k) (oscil (modulators k))))))
- (outa i (* amp (oscil cr sum))))))))
+ (set! (modulators i) (make-oscil (* freq (mc-ratios i)) (mod-phases i)))
+ (set! (fm-indices i) (hz->radians (* freq (indexes i) (mc-ratios i)))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let ((sum 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! sum (+ sum (* (fm-indices k) (oscil (modulators k))))))
+ (outa i (* amp (oscil cr sum)))))))
(with-sound () (fm 0 2.0 440 .3 '(1 3 4) '(1.0 0.5 0.1) 0.0 '(0.0 0.0 0.0)))
</pre>
<!-- -->
-</td></tr></table>
-<table border=1 hspace=40 vspace=20 cellpadding=5>
+
+<table class="borderedm">
<tr><td>
<img src="pix/multifm.png" alt="multi fm picture">
</td>
-<td>
+<td class="spaced">
<pre>
200Hz is -0.106 (i = -1, k = -1)
-0.106 (i = -1, k = 1)
@@ -1525,12 +1582,12 @@ In general:
-0.413 (i = 0, k = -1)
-0.426 -> 0.614 normalized
</pre>
-<pre>
+<pre class="indented">
i is the 2000 Hz part, k the 200 Hz,
red dots mark pure sum/difference tones
</pre>
</td></tr>
-<tr><td colspan=2 bgcolor="#f6f8ff"><center>(with-sound () (fm 0 2.0 2000 .5 '(1 .1) '(0.5 1.0) 0.0 '(1.855 1.599)))</center></td></tr>
+<tr><td colspan=2 class="bluishb">(with-sound () (fm 0 2.0 2000 .5 '(1 .1) '(0.5 1.0) 0.0 '(1.855 1.599)))</td></tr>
</table>
<!--
@@ -1539,15 +1596,15 @@ here's the code to get that info:
(with-sound ()
(fm 0 2.0 2000 .5 '(1 .1) '(0.5 1.0) 0.0 (list (* 0.5 (+ pi (hz->radians 2000))) (* 0.5 (+ pi (hz->radians 200))))))
-;(multifm-component 200 2000.0 (list 2000.0 200.0) (list 0.5 1.0) '() '() #t)
+;(multifm-component 200 2000.0 (list 2000.0 200.0) (list 0.5 1.0) () () #t)
(define (multifm-component freq-we-want wc wms inds ns bs using-sine)
- (if (not (null? wms))
+ (if (pair? wms)
(let* ((sum 0.0)
(index (car inds))
(mx (ceiling (* 5 index)))
(wm (car wms)))
- (do ((k (- mx) (+ 1 k)))
+ (do ((k (- mx) (+ k 1)))
((>= k mx) sum)
(set! sum (+ sum (multifm-component freq-we-want (+ wc (* k wm)) (cdr wms) (cdr inds)
(append ns (list k)) (append bs (list index))
@@ -1573,9 +1630,9 @@ is somewhat closer to that of a real violin.
A pared down version of the fm-violin is:
</p>
-<table border=0 bgcolor="#f6f8ff" hspace=20 vspace=10><tr><td>
+
<!-- CLM CASE
-<pre>
+<pre class="indented">
(definstrument violin (beg dur frequency amplitude fm-index)
(let* ((start (seconds->samples beg))
(stop (+ beg (seconds->samples dur)))
@@ -1610,7 +1667,7 @@ A pared down version of the fm-violin is:
-->
<!-- SND CASE -->
-<pre>
+<pre class="indented">
(define (violin beg dur frequency amplitude fm-index)
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
@@ -1629,8 +1686,7 @@ A pared down version of the fm-violin is:
(indf3 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index3 :duration dur))
(pervib (make-triangle-wave 5 :amplitude (* .0025 frq-scl)))
(ranvib (make-rand-interp 16 :amplitude (* .005 frq-scl))))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
(outa i (* (env ampf)
@@ -1638,12 +1694,12 @@ A pared down version of the fm-violin is:
(+ vib
(* (env indf1) (oscil fmosc1 vib))
(* (env indf2) (oscil fmosc2 (* 3.0 vib)))
- (* (env indf3) (oscil fmosc3 (* 4.0 vib))))))))))))
+ (* (env indf3) (oscil fmosc3 (* 4.0 vib)))))))))))
(with-sound () (violin 0 1.0 440 .1 1.0))
</pre>
<!-- -->
-</td></tr></table>
+
<p>There is one surprising aspect of the parallel FM equation. Since we can fiddle with the initial phases of the modulating signal's components,
we can get very different spectra from modulating signals with the same magnitude spectrum. In the next two graphs, both cases involve a
@@ -1651,10 +1707,7 @@ modulating signal made up of 6 equal amplitude harmonically related sinusoids, b
set of initial phases that minimizes the modulating signal's peak amplitude:
</p>
-<table hspace=40 border=1>
-<tr><td>
<img src="pix/fmpar6.png" alt="comparison of 2 6-sinusoid spectra">
-</td></tr></table>
<!--
@@ -1666,16 +1719,16 @@ set of initial phases that minimizes the modulating signal's peak amplitude:
(car1 (make-oscil freq))
(car2 (make-oscil freq))
(phases (if (= n 4)
- '#(0.0 9.429973765023149656627765580196864902973E-1 1.340090256365081833322960846999194473028E0 1.112605206055434337031329050660133361816E0)
+ #(0.0 9.429973765023149656627765580196864902973E-1 1.340090256365081833322960846999194473028E0 1.112605206055434337031329050660133361816E0)
(if (= n 6)
- '#(0.0 0.88722838124921 0.26020415169852 1.2966409163042 1.3233535939997 1.15281977798) ;'#(0 0 0 0 1 0)
+ #(0.0 0.88722838124921 0.26020415169852 1.2966409163042 1.3233535939997 1.15281977798) ;#(0 0 0 0 1 0)
(if (= n 8)
- '#(0.0 1.6766927120402 0.81654336999861 0.62403216688615 0.85406407763019 1.0608486873128 0.16723371585947 0.90568594225519)
+ #(0.0 1.6766927120402 0.81654336999861 0.62403216688615 0.85406407763019 1.0608486873128 0.16723371585947 0.90568594225519)
(if (= n 12)
- '#(0 1 1 0 0 1 0 1 0 0 0 0)
+ #(0 1 1 0 0 1 0 1 0 0 0 0)
(if (= n 24)
- '#(0 1 1 0 0 1 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0)
- '#(0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1)
+ #(0 1 1 0 0 1 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0)
+ #(0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1)
)))))))
(do ((i 0 (+ i 1)))
@@ -1683,7 +1736,6 @@ set of initial phases that minimizes the modulating signal's peak amplitude:
(set! (mods1 i) (make-oscil (* (+ i 1) freq) (/ pi 2)))
(set! (mods2 i) (make-oscil (* (+ i 1) freq) (* pi (phases i)))))
- (run
(do ((i 0 (+ i 1 )))
((= i 441000))
(let ((mod1 0.0)
@@ -1696,15 +1748,15 @@ set of initial phases that minimizes the modulating signal's peak amplitude:
(outb i (oscil car1 (/ mod1 (* n n))))
(outc i (/ mod2 n))
(outd i (oscil car2 (/ mod2 (* n n))))
- )))))
+ ))))
(set! (selected-graph-color) (make-color 1 1 1))
(set! (selected-data-color) (make-color 0 0 0))
-->
-<br><br>
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>cascade FM: sin(sin(sin))</h5></center></td></tr></table>
+
+<div class="greenish">cascade FM: sin(sin(sin))</div>
<p>We can, of course, use FM (or anything) to produce the modulating signal. When FM is used, it is
sometimes called "cascade FM":
@@ -1712,14 +1764,14 @@ sometimes called "cascade FM":
<!-- LATEX \sin(\omega_{c}t + B_{1}\sin(\omega_{m1}t + B_{2}\sin(\omega_{m2}t))) -->
-<img src="pix/fmeq35.png" alt="cascade fm" hspace=20>
+<img class="indented" src="pix/fmeq35.png" alt="cascade fm">
<p>In CLM:
</p>
-<pre>
- (* A (oscil carrier (* B (oscil modulator (* C (oscil cascade))))))
+<pre class="indented">
+(* A (oscil carrier (* B (oscil modulator (* C (oscil cascade))))))
</pre>
<p>Each component of the
@@ -1727,10 +1779,11 @@ lower pair of oscillators is surrounded by the spectrum produced by the upper pa
sort of like a set of formant regions.
</p>
-<table border=1 hspace=40 vspace=10><tr><td>
+<table class="borderedm">
+<tr><td>
<img src="pix/cascade.png" alt="cascade fm picture">
</td></tr>
-<tr><td bgcolor="#f6f8ff"><center>osc A: 2000 Hz, osc B: 500 Hz, index 1.5, osc C: 50 Hz, index 1.0</center></td></tr>
+<tr><td class="bluishb">osc A: 2000 Hz, osc B: 500 Hz, index 1.5, osc C: 50 Hz, index 1.0</td></tr>
</table>
<!--
@@ -1744,13 +1797,12 @@ cascade.png:
(ca (make-oscil casfreq caspha))
(fm-ind0 (hz->radians (* modind modfreq)))
(fm-ind1 (hz->radians (* casind casfreq))))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(outa i (* amp
(oscil cr (* fm-ind0
(oscil md (* fm-ind1
- (oscil ca)))))))))))
+ (oscil ca))))))))))
(with-sound ()
(cascade1 0 1.0 2000 .25 500 1.5 (* 0.5 (+ pi (hz->radians 500))) 50 1.0 (+ pi (* 0.5 (hz->radians 550)))))
@@ -1764,7 +1816,7 @@ cascade.png:
& \sin(\omega_{c}t + B_{1}\sin(\omega_{m1}t + B_{2}\sin(\omega_{m2}t))) = \sum_{n=-\infty}^{\infty} \sum_{k=-\infty}^{\infty} J_{n}(B_{1}) J_{k}(n B_{2}) \sin(\omega_{c} + n \omega_{m1} + k \omega_{m2})t \\
-->
-<img src="pix/fmeq57.png" alt="cascade FM" hspace=20>
+<img class="indented" src="pix/fmeq57.png" alt="cascade FM">
<p>
Unfortunately, FM and PM can produce energy
@@ -1772,7 +1824,7 @@ at 0Hz (when, for example, the carrier frequency equals the modulating frequency
phase increment (the "instantaneous frequency") of the outer or lowermost
carrier.
Our fundamental frequency no longer has any obvious relation to
-<img src="pix/fmeq43.png" alt="wc" align=absmiddle>!
+<img src="pix/fmeq43.png" alt="wc">!
That is, we
can expand our cascade formula (in the sin(x + cos(sin)) case) into:
</p>
@@ -1780,7 +1832,7 @@ can expand our cascade formula (in the sin(x + cos(sin)) case) into:
<!-- LATEX old version: \sin(\omega_{c}t + \sum J_{n}(B)\cos(\omega_{c}t + n\omega_{m_{n}}t)) -->
<!-- LATEX fmeq36.png: \sin \big(\omega_{c}t + \int_{0}^{t} \! \sum J_{n}(B)\cos(\omega_{m1} + n\omega_{m2})t \, \mathrm{d} t\big) -->
-<img src="pix/fmeq36.png" alt="more sins" hspace=20>
+<img class="indented" src="pix/fmeq36.png" alt="more sins">
<!-- LATEX old version (fmeq46.png): \omega_{c} = -n\omega_{m}\textrm{, we get }J_{n}(B)\cos(0) = J_{n}(B) -->
@@ -1788,8 +1840,8 @@ can expand our cascade formula (in the sin(x + cos(sin)) case) into:
<!-- LATEX fmeq51.png: J_{n}(B)\cos(0) = J_{n}(B) -->
<p>but now whenever the
-<img src="pix/fmeq46.png" alt="wc" align=absmiddle>, we get
-<img src="pix/fmeq51.png" alt="j0 case" align=absmiddle>,
+<img src="pix/fmeq46.png" alt="wc">, we get
+<img src="pix/fmeq51.png" alt="j0 case">,
and the carrier is offset by <code>(radians->hz (bes-jn B))</code>, that is, (Jn(B) * srate / (2 * pi)).
For example, if we have <code>(oscil gen 0.05)</code>, where we've omitted everything except
the constant (DC) term (0.05 in this case), this oscil produces a sine wave at its nominal frequency + (radians->hz 0.05),
@@ -1807,16 +1859,12 @@ phase by a constant (0.05), usually not a big deal.
</p>
-<table border=1 hspace=50 vspace=10 cellpadding=4><tr><td>
-
<p>The irascible reader may be grumbling about angels and pins, so here's an example of cascade FM
to show how strong this effect is:
</p>
-</td></tr><tr><td bgcolor="#f6f8ff">
-
<!-- CLM CASE
-<pre>
+<pre class="indented">
(definstrument cascade (beg end freq amp modrat modind casrat casind caspha)
(let ((cr (make-oscil freq))
(md (make-oscil (* freq modrat)))
@@ -1833,7 +1881,7 @@ to show how strong this effect is:
-->
<!-- SND CASE -->
-<pre>
+<pre class="indented">
(define (cascade beg dur freq amp modrat modind casrat casind caspha)
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
@@ -1842,13 +1890,12 @@ to show how strong this effect is:
(ca (make-oscil (* freq casrat) caspha))
(fm-ind0 (hz->radians (* modind modrat freq)))
(fm-ind1 (hz->radians (* casind casrat freq))))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(outa i (* amp
(oscil cr (* fm-ind0
(oscil md (* fm-ind1
- (oscil ca)))))))))))
+ (oscil ca))))))))))
(with-sound ()
(cascade 0 1.0 400 .25 1.0 1.0 1.0 1.0 0)
@@ -1859,7 +1906,8 @@ to show how strong this effect is:
(cascade 0 1.0 400 .25 1 1.0 1 1.0 (* 0.5 (+ pi (hz->radians 400)))))
</pre>
<!-- -->
-</td></tr></table>
+
+<div class="spacer"></div>
<p>Why stop at three sins? Here's an experiment that calls sin(sin(sin...)) k times;
it seems to be approaching a square wave as k heads into the stratosphere:
@@ -1869,17 +1917,17 @@ it seems to be approaching a square wave as k heads into the stratosphere:
(with-sound ()
(let ((angle 0.0)
(incr (hz->radians 100.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
(let* ((result (sin angle)))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 2))
(set! result (sin result)))
(set! angle (+ angle incr))
(outa i result)))))
-->
-<table border=0 hspace=40 vspace=10>
+<table class="borderedm">
<tr>
<td>
<img src="pix/sin3.png" alt="3 sins">
@@ -1892,34 +1940,48 @@ it seems to be approaching a square wave as k heads into the stratosphere:
</td>
</tr>
<tr>
-<td bgcolor="#f6f8ff"><center>k=3</center></td>
-<td bgcolor="#f6f8ff"><center>k=30</center></td>
-<td bgcolor="#f6f8ff"><center>k=300</center></td>
+<td class="bluishb">k=3</td>
+<td class="bluishb">k=30</td>
+<td class="bluishb">k=300</td>
</tr></table>
-<table border=1 hspace=100 cellpadding=4 vspace=10><tr><td>
-<small>
+<div class="spacer"></div>
+
+<p>
If we use "cos" here instead of "sin", we get a constant, as Bill Gosper has shown:
-<br><img src="pix/coscoscos.png" alt="nested cos equation" hspace=50 vspace=10>
-<br>
-As z increases above 1.27, we get a square wave, then period doubling, and finally (ca. 1.97) chaos.
+</p>
+
+<img class="indented" src="pix/coscoscos.png" alt="nested cos equation">
+
+<p>As z increases above 1.27, we get a square wave, then period doubling, and finally (ca. 1.97) chaos.
<!-- googling "cosine map" gets 1.974133 -->
-</small>
-</td></tr></table>
+</p>
<!--
(with-sound (:clipped #f :statistics #t)
(let ((angle 0.0)
(z 1.18)
(incr (hz->radians 100.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
(let* ((result (* z (cos angle))))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 100))
(set! result (* z (cos result))))
(set! angle (+ angle incr))
(outa i result)))))
+
+
+http://www.tweedledum.com/rwg/idents.htm
+
+A sum of Bessels wherein the
+argument and subscript both ramp with the index is called a Kapteyn series. The
+alternate text if you roll over the formula with IE is "Continued cosine, A036778"
+which is the sequence number (q.v.) of its expansion coefficients in Sloane's
+Encyclopedia, http://akpublic.research.att.com/~njas/sequences/ . I think the
+iterated cosine stops converging near z = 1.42, where it begins a period 2
+oscillation, presumably with Feigenbaum behavior thereafter. I guess these
+things are just called iterated functions or fixed-point equations.
-->
<!-- LATEX
@@ -1930,20 +1992,23 @@ As z increases above 1.27, we get a square wave, then period doubling, and final
-->
-
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>feedback FM: sin(x=sin(x))</h5></center></td></tr></table>
+<div class="spacer"></div>
+<div class="greenish">feedback FM: sin(x=sin(x))</div>
<p>A similar trick comes up in feedback FM used in some synthesizers. Here the output of the modulator
is fed back into its input:
+</p>
-<code>sin(y <= w + B sin y)</code>.
+<pre class="indented">
+sin(y <= w + B sin y)
+</pre>
-This is expanded by Tomisawa as:
+<p>This is expanded by Tomisawa as:
</p>
<!-- LATEX \sum_{n=1}^{\infty}\frac{2}{nB}J_{n}(nB)\sin n\omega_{c}t -->
-<img src="pix/fmeq37.png" alt="feedback fm" hspace=20>
+<img class="indented" src="pix/fmeq37.png" alt="feedback fm">
<p>As Tomisawa points out, this is very close to the other FM formulas, except that
the argument to the Bessel function depends on the order, we have only multiples of the carrier frequency
@@ -1968,41 +2033,40 @@ J_{2000}(2000) = .035
<!-- J100000(100000) = .0096
J1000000(1000000) = .0044
J10000000(10000000) = .002
- after that they are repeating -- factor of 10 -> factor of 2 in result -- probably an artifact
+ after that they are repeating; factor of 10 -> factor of 2 in result; probably an artifact
-->
-<img src="pix/fmeq28.png" alt="Jn vals" hspace=20>
-
+<img class="indented" src="pix/fmeq28.png" alt="Jn vals">
<p>Since the other part of the equation goes down as 1/n, we get essentially a sawtooth wave
out of this equation (its harmonics go down as 1/n). Tomisawa suggests that B should be between 0
and 1.5. Since we are dividing by B in the equation, we might worry that as B heads toward 0, all
hell breaks loose, but luckily
+</p>
<!-- LATEX fmeq38: \lim_{B \to 0}\frac{2}{B}J_{1}(B) = 1 -->
-<img src="pix/fmeq38.png" alt="lim1 case" align=absmiddle>
+<img class="indented" src="pix/fmeq38.png" alt="lim1 case">
-and for all the other components
+<p>and for all the other components
+</p>
<!-- LATEX fmeq39: \lim_{B \to 0}\frac{2}{nB}J_{n}(nB) = 0 -->
-<img src="pix/fmeq39.png" alt="all cases" align=absmiddle>
+<img class="indented" src="pix/fmeq39.png" alt="all cases">
-so, just as in normal FM, if the index is 0, we get a pure sine wave.
+<p>so, just as in normal FM, if the index is 0, we get a pure sine wave.
</p>
-<table border=1 hspace=20 vspace=10 cellpadding=3>
-<tr><td bgcolor="#f6f8ff">
-<pre>
+<pre class="indented">
(define (feedbk beg dur freq amp index)
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
(y 0.0)
(x-incr (hz->radians freq)))
- (do ((i start (+ 1 i))
+ (do ((i start (+ i 1))
(x 0.0 (+ x x-incr)))
((= i end))
(set! y (+ x (* index (sin y))))
@@ -2010,17 +2074,14 @@ so, just as in normal FM, if the index is 0, we get a pure sine wave.
(with-sound () (feedbk 0 1 100.0 1.0 1.0))
</pre>
-</td>
-<td>
-<table border=0>
+<table class="borderedm">
<tr><td>
<img src="pix/fdbk.png" alt="feedback fm">
</td></tr>
<tr>
<td>
<pre>
-
2/1 J1(1) = 0.880 -> 1.000 (normalized to match fft)
2/2 J2(2) = 0.353 -> 0.401
2/3 J3(3) = 0.206 -> 0.234
@@ -2030,7 +2091,6 @@ so, just as in normal FM, if the index is 0, we get a pure sine wave.
2/7 J7(7) = 0.066 -> 0.076
</pre>
</td></tr></table>
-</td></tr></table>
<p>Why does the FFT show a 0 Hz component?
@@ -2043,11 +2103,12 @@ Groan — it appears to be another "centering" problem, but I haven't found
the magic formula yet (a reasonable stab at it is: <code>-(phase-incr^(1-(B/3))</code>)).
</p>
-<table border=1 align=right hspace=20 vspace=20><tr><td>
-<img src="pix/blip.png">
+<table class="borderedm">
+<tr><td>
+<img src="pix/blip.png" alt="feedback noise">
</td></tr>
-<tr><td bgcolor="#f6f8ff">
-<center>Tomisawa's picture of the noise</center>
+<tr><td class="bluishb">
+Tomisawa's picture of the noise
</td></tr></table>
<p>Why does an index over 1.0 create bursts of noise?
@@ -2078,8 +2139,7 @@ The take-home message is: "keep the index below 1.0!".
(end (+ start (seconds->samples dur)))
(y 0.0)
(x-incr (hz->radians freq)))
- (run
- (do ((i start (+ 1 i))
+ (do ((i start (+ i 1))
(x 0.0 (+ x x-incr)))
((= i end))
(out-any i y 0) ;0: previous y (effective phase)
@@ -2088,12 +2148,12 @@ The take-home message is: "keep the index below 1.0!".
(out-any i (- (+ x md) y) 2) ;2: new y - old y
(set! y (+ x md))
(out-any i md 3) ;3: output (* amp (sin y))
- (out-any i y 4)))))) ;4: new y
+ (out-any i y 4))))) ;4: new y
-(with-sound (:srate 44100 :data-format mus-ldouble :channels 5 :statistics #t :clipped #f) (feedbk 0 2 100.0 1.0 1.22))
+(with-sound (:srate 44100 :sample-type mus-ldouble :channels 5 :statistics #t :clipped #f) (feedbk 0 2 100.0 1.0 1.22))
channel 2 (outc) is our actual per-sample phase increment; notice that at the trouble spot it
- is zigzagging itself, and after interspersed 0's, finally dips negative -- then the bounces start
- (at the bad spot y goes from -.57 to -.59 but the phase incr is .014 -- we back up).
+ is zigzagging itself, and after interspersed 0's, finally dips negative, then the bounces start
+ (at the bad spot y goes from -.57 to -.59 but the phase incr is .014, we back up).
:(samps 9096)
(129.160781860352 129.596038818359 2.01292452402413e-4 -0.435052901506424 129.160980224609)
@@ -2121,8 +2181,7 @@ we can use the phase to minimize the difference with the sum:
(end (+ start (seconds->samples dur)))
(y 0.0)
(x-incr (hz->radians freq)))
- (run
- (do ((i start (+ 1 i))
+ (do ((i start (+ i 1))
(x 0.0 (+ x x-incr)))
((or (c-g?)
(= i end)))
@@ -2130,7 +2189,7 @@ we can use the phase to minimize the difference with the sum:
(let ((result (* amp (sin y)))
(sum 0.0))
- (do ((n 1 (+ 1 n)))
+ (do ((n 1 (+ n 1)))
((= n iters))
(set! sum (+ sum (/ (* 2.0
(bes-jn n (* index n))
@@ -2138,14 +2197,16 @@ we can use the phase to minimize the difference with the sum:
(* n index)))))
(outb i (* amp sum))
(outc i (- sum (sin (+ y pha1))))
- (outa i (* amp (sin (+ y pha1)))))))))
+ (outa i (* amp (sin (+ y pha1))))))))
(with-sound (:channels 3 :statistics #t :clipped #f) (feedbk 0 1 100 1.0 0.5 100 0.01265)) ; .0005 0.1 100
the sum has DC! and the difference is a pulse train, but higher srate fixes that
-->
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>FM and noise: sin(sin(rand))</h5></center></td></tr></table>
+<div class="spacer"></div>
+
+<div class="greenish">FM and noise: sin(sin(rand))</div>
<p>
One way to make noise
@@ -2158,14 +2219,14 @@ random number frequency times its index — is this just Mr Carson again?):
</p>
-<table border=1 hspace=40 vspace=10 cellpadding=5>
-<tr><td bgcolor="f6f8ff" colspan=3>
-<pre>
+<table class="borderedm">
+<tr><td colspan=3>
+<pre class="indented">
(with-sound ()
(let ((gen (make-oscil 5000))
(noise (make-rand 1000 :envelope '(-1 1 0 0 1 1))) ; "eared"
(index (hz->radians 1000))) ; index=1.0 so bandwith=4 Khz (2 Khz on each side)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 50000))
(outa i (oscil gen (* index (rand noise)))))))
</pre>
@@ -2182,11 +2243,12 @@ random number frequency times its index — is this just Mr Carson again?):
</td>
</tr>
<tr>
-<td bgcolor="#f6f8ff"><center>flat</center></td>
-<td bgcolor="#f6f8ff"><center>gaussian (bell curve)</center></td>
-<td bgcolor="#f6f8ff"><center>eared</center></td>
+<td class="bluishb">flat</td>
+<td class="bluishb">gaussian (bell curve)</td>
+<td class="bluishb">eared</td>
</tr></table>
+<div class="spacer"></div>
<p>
Simple FM with noise gives both whooshing sounds (high index) and hissing or whistling sounds (low index),
@@ -2202,18 +2264,18 @@ these modulate the carrier. In CLM:
It is my belief that you get the normal spectrum with each component
smeared out by a copy of the noise band:
-<table border=1 hspace=20 vspace=10>
+<table>
<tr>
-<td colspan=3 bgcolor="#f6f8ff"><center>(with-sound () (fm-violin 0 1 400.0 .5 :fm-index 3.0 :noise-amount 0.007))</center></td></tr>
+<td colspan=3 class="bluish">(with-sound () (fm-violin 0 1 400.0 .5 :fm-index 3.0 :noise-amount 0.007))</td></tr>
<tr>
<td><img src="pix/fmvnoise0.png" alt="fmv no noise"></td>
<td><img src="pix/fmvnoise2.png" alt="fmv noise .002"></td>
<td><img src="pix/fmvnoise7.png" alt="fmv noise .007"></td>
</tr>
<tr>
-<td bgcolor="#f6f8ff"><center>noise-amount: 0.0</center></td>
-<td bgcolor="#f6f8ff"><center>noise-amount: 0.002</center></td>
-<td bgcolor="#f6f8ff"><center>noise-amount: 0.007</center></td>
+<td class="bluish">noise-amount: 0.0</td>
+<td class="bluish">noise-amount: 0.002</td>
+<td class="bluish">noise-amount: 0.007</td>
</tr></table>
<p>In CLM:
@@ -2221,8 +2283,8 @@ smeared out by a copy of the noise band:
-->
-<pre>
- (oscil carrier (* fm-index (oscil fm (* noise-index (rand noise)))))
+<pre class="indented">
+(oscil carrier (* fm-index (oscil fm (* noise-index (rand noise)))))
</pre>
<p>You may have noticed that this is one case where phase modulation is different from FM. Previously,
@@ -2232,9 +2294,11 @@ integrating the modulating signal:
FM(white-noise) = PM(brownian-noise). Similarly,
FM(square-wave) = PM(triangle-wave),
FM(nxy1sin) = PM(square-wave), and
-FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)" align=absmiddle>.
+FM(e^x) = PM(e^x). FM(square-wave) is:
</p>
+<img class="indented" src="pix/fmeq58.png" alt="fm(noise)">.
+
<!-- LATEX fmeq58: (Klapper p102)
&\sum_{n=-\infty}^{\infty} \frac{2B}{\pi(B^{2}-n^{2})} \sin(\frac{\pi}{2} (B-n)) \sin (\omega_{c}+n\omega_{m})t
-->
@@ -2252,8 +2316,7 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
(fm-index (hz->radians (* index freq mc-ratio)))
(ampf (make-env '(0 0 1 1 10 1 11 0) :scaler amp :duration dur))
(sqsum 0.0))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(let ((vol (env ampf))
(sq (* fm-index (- (square-wave fm-modulator) 1.0)))
@@ -2262,11 +2325,11 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
(outb i (* vol (oscil pm-carrier 0.0 tri)))
(outc i sqsum)
(outd i tri)
- (set! sqsum (+ sqsum sq)))))))
+ (set! sqsum (+ sqsum sq))))))
(with-sound (:clipped #f :statistics #t :channels 4) (fmpmsq 0 1 1000 .5 .1 1 (+ (* 0.5 pi) .005)))
-;; almost a match -- the pi/2 triangle amp is to take into account the square wave's internal table size (2 pi)
-;; there is a drift in sqsum that eventually turns around -- raise srate to 441000 and it goes away
+;; almost a match, the pi/2 triangle amp is to take into account the square wave's internal table size (2 pi)
+;; there is a drift in sqsum that eventually turns around, raise srate to 441000 and it goes away
;; FM(e^x)=PM(e^x):
@@ -2277,8 +2340,7 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
(pm-carrier (make-oscil freq))
(ampf (make-env '(0 0 1 1 10 1 11 0) :scaler amp :duration dur))
(sumex 0.0))
- (run
- (do ((i start (+ 1 i))
+ (do ((i start (+ i 1))
(x 0.0 (+ x .0001)))
((= i end))
(let ((vol (env ampf))
@@ -2287,7 +2349,7 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
(outb i (* vol (oscil pm-carrier 0.0 ex)))
(outc i ex)
(outd i sumex)
- (set! sumex (+ sumex (* .0001 ex))))))))
+ (set! sumex (+ sumex (* .0001 ex)))))))
(with-sound (:clipped #f :statistics #t :channels 4) (fmpmex 0 1 1000 .5))
@@ -2301,8 +2363,7 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
(ampf (make-env '(0 0 1 1 10 1 11 0) :scaler amp :duration dur))
(sumex 0.0)
(fm-index (hz->radians (* index freq))))
- (run
- (do ((i start (+ 1 i))
+ (do ((i start (+ i 1))
(x 0.0 (+ x .0001)))
((= i end))
(let ((vol (env ampf))
@@ -2311,7 +2372,7 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
(outb i (* vol (oscil pm-carrier 0.0 (* index sumex))))
(outc i ex)
(outd i sumex)
- (set! sumex (+ sumex (* fm-index ex))))))))
+ (set! sumex (+ sumex (* fm-index ex)))))))
(with-sound (:clipped #f :statistics #t :channels 4) (fmpmran 0 1 1000 .5 1))
@@ -2326,8 +2387,7 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
(fm-index (hz->radians (* index freq mc-ratio)))
(ampf (make-env '(0 0 1 1 10 1 11 0) :scaler amp :duration dur))
(sqsum 0.0))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(let ((vol (env ampf))
(pulse (* index (nxy1sin fm-modulator)))
@@ -2336,7 +2396,7 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
(outb i (* vol (oscil pm-carrier 0.0 sq)))
(outc i sqsum)
(outd i sq)
- (set! sqsum (+ sqsum pulse)))))))
+ (set! sqsum (+ sqsum pulse))))))
(with-sound (:clipped #f :statistics #t :channels 4) (fmpmodd 0 1 1000 .5 .1 1))
@@ -2347,8 +2407,8 @@ FM(e^x) = PM(e^x). FM(square-wave) is <img src="pix/fmeq58.png" alt="fm(noise)"
In the realm of "anything" as the modulating signal, consider
</p>
-<pre>
- (sin (+ sound-file (* index (sin (* 2 pi sound-file)))))
+<pre class="indented">
+(sin (+ sound-file (* index (sin (* 2 pi sound-file)))))
</pre>
<p>where "sound file" is any recorded sound. I call this "contrast-enhancement" in the CLM package. It
@@ -2356,7 +2416,9 @@ makes a sound crisper; "Wait for Me!" uses it whenever a sound needs to cut thro
mix.
</p>
-<table align=right border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>FM voice</h5></center></td></tr></table>
+
+<div class="spacer"></div>
+<div class="greenish">FM voice</div>
<p>We can use more than one sinusoidal component in our carrier, or multiple banks of carriers and
modulators, and depend upon vibrato and "spectral fusion" to make the result sound like one voice.
@@ -2370,9 +2432,9 @@ An elaborate multi-carrier FM instrument is the voice instrument written by Marc
used in "Colony" and other pieces:
</p>
-<table border=0 bgcolor="#f6f8ff" hspace=20 vspace=10><tr><td>
+
<!-- CLM CASE
-<pre>
+<pre class="indented">
(definstrument vox (beg end freq amp
&optional (indexes '(.005 .01 .02)) (formant-amps '(.86 .13 .01)))
(let* ((car-os (make-oscil 0))
@@ -2427,7 +2489,7 @@ used in "Colony" and other pieces:
-->
<!-- SND CASE -->
-<pre>
+<pre class="indented">
(define* (vox beg dur freq amp (indexes '(.005 .01 .02)) (formant-amps '(.86 .13 .01)))
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
@@ -2440,7 +2502,7 @@ used in "Colony" and other pieces:
(indices (apply vct indexes))
(per-vib (make-triangle-wave 6 :amplitude (* freq .03)))
(ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 3))
(set! (evens i) (make-oscil 0))
(set! (odds i) (make-oscil 0)))
@@ -2449,55 +2511,53 @@ used in "Colony" and other pieces:
(set! (frmfs 1) (make-env '(0 1190 100 1350) :duration dur))
(set! (frmfs 2) (make-env '(0 2390 100 1690) :duration dur))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (let* ((frq (+ freq (triangle-wave per-vib) (rand-interp ran-vib)))
- (car (oscil car-os (hz->radians frq)))
- (sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k 3))
- (let* ((frm (env (frmfs k)))
- (frm0 (/ frm frq))
- (frm-int (floor frm0))
- (even-amp 0.0) (odd-amp 0.0)
- (even-freq 0.0) (odd-freq 0.0))
- (if (even? frm-int)
- (begin
- (set! even-freq (hz->radians (* frm-int frq)))
- (set! odd-freq (hz->radians (* (+ frm-int 1) frq)))
- (set! odd-amp (- frm0 frm-int))
- (set! even-amp (- 1.0 odd-amp)))
- (begin
- (set! odd-freq (hz->radians (* frm-int frq)))
- (set! even-freq (hz->radians (* (+ frm-int 1) frq)))
- (set! even-amp (- frm0 frm-int))
- (set! odd-amp (- 1.0 even-amp))))
- (set! sum (+ sum (+ (* (amps k)
- (+ (* even-amp
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let* ((frq (+ freq (triangle-wave per-vib) (rand-interp ran-vib)))
+ (car (oscil car-os (hz->radians frq)))
+ (sum 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k 3))
+ (let* ((frm (env (frmfs k)))
+ (frm0 (/ frm frq))
+ (frm-int (floor frm0))
+ (even-amp 0.0) (odd-amp 0.0)
+ (even-freq 0.0) (odd-freq 0.0))
+ (if (even? frm-int)
+ (begin
+ (set! even-freq (hz->radians (* frm-int frq)))
+ (set! odd-freq (hz->radians (* (+ frm-int 1) frq)))
+ (set! odd-amp (- frm0 frm-int))
+ (set! even-amp (- 1.0 odd-amp)))
+ (begin
+ (set! odd-freq (hz->radians (* frm-int frq)))
+ (set! even-freq (hz->radians (* (+ frm-int 1) frq)))
+ (set! even-amp (- frm0 frm-int))
+ (set! odd-amp (- 1.0 even-amp))))
+ (set! sum (+ sum (+ (* (amps k)
+ (+ (* even-amp
(oscil (evens k)
(+ even-freq (* (indices k) car))))
- (* odd-amp
+ (* odd-amp
(oscil (odds k)
(+ odd-freq (* (indices k) car)))))))))))
- (outa i (* (env ampf) sum)))))))
+ (outa i (* (env ampf) sum))))))
(with-sound ()
(vox 0 1.0 220.0 0.5)
(vox 1.5 1.0 110 .5 '(0.02 0.01 0.02) '(.9 .09 .01)))
</pre>
<!-- -->
-</td></tr></table>
<p>which produces this spectrogram:
</p>
-<img src="pix/voxspectrum.png" alt="voice spectrum" hspace=20 vspace=10>
+<img src="pix/voxspectrum.png" alt="voice spectrum">
<h2>References</h2>
-<pre>
+<pre class="indented">
Abramowitz and Stegun, "Handbook of Mathematical Functions", Dover 1965.
Benson, "Music: A Mathematical Offering", Cambridge University Press, Nov 2006. Also available
@@ -2506,6 +2566,10 @@ Benson, "Music: A Mathematical Offering", Cambridge University Press, Nov 2006.
Chowning, "The Synthesis of Complex Audio Spectra by Means of Frequency Modulation", JAES 21:526-534, 1973
+Frost, "Early FM Radio", Johns Hopkins Univ Press, 2010
+ I am apparently unfair to Mr Carson; Armstrong quoted him out of context, and I did not dig up
+ the original paper.
+
Gagliardi, "Introduction to Communications Engineering", Wiley Interscience, 1978.
Gray and Mathews, "A Treatise on Bessel Functions and Their Applications to Physics", MacMillan and Co, 1895.
@@ -2514,7 +2578,9 @@ Klapper, "Selected Papers on Frequency Modulation", Dover 1970. (Out of print, b
via used book markets such as abebooks or amazon — usually about $25).
The Bessel function graph is from Corrington, "Variation of Bandwidth with Modulation Index in FM",
The picture below of an early radio is from Armstrong, "A Method of Reducing Disturbances in Radio
- Signaling by a System of FM".
+ Signaling by a System of FM". The Carson quote is also from that paper (originally published
+ in Proc. IRE, Vol 24, No 5, pp 689-740, May, 1936, with Carson's paper referred to as
+ "Notes on the theory of modulation", Proc. IRE, vol 10, pp 57-82, Feb 1922).
LeBrun, "A Derivation of the Spectrum of FM with a Complex Modulating Wave", CMJ vol1, no 4 1977 p51-52
@@ -2533,21 +2599,23 @@ Tomisawa, "Tone Production Method for an Electronic Musical Instrument" US Paten
Watson, "A Treatise on the Theory of Bessel Functions", Cambridge, 1922.
</pre>
-<table border=0 hspace=40><tr><td>
-<table border=1><tr><td>
+<table class="spaced">
+<tr><td>
+<table><tr><td>
<img src="pix/fmradio.png" alt="early FM radio">
-</td></tr><tr><td bgcolor="#f6f8ff">
-<center>FM (and AM) radio ca 1933</center>
+</td></tr>
+<tr><td class="bluishb">FM (and AM) radio ca 1934
</td></tr></table>
</td><td>
-<table border=1 cellpadding=10 hspace=40><tr><td bgcolor=beige>
-<img src="pix/m5fm1.png"><br>
-<img src="pix/m5fm2.png">
+<table class="spaced">
+<tr><td>
+<img src="pix/m5fm1.png" alt="music v source"><br>
+<img src="pix/m5fm2.png" alt="music v source">
</td></tr>
-<tr><td bgcolor="#f6f8ff"><center>Music 5 FM?</center>
+<tr><td class="bluishb">Music 5 FM?
</td></tr></table>
</td></tr></table>
@@ -2562,18 +2630,26 @@ fall at powers of that number. That is, 1 + 1.618
1.618^-1, and 1 + 2*1.618 (the second upper partial)
is 1.618^3. For the first partials to
match is to ask that x^2 = 1 + x, which has
-the golden mean as a solution. In the 2nd case,
+the golden mean as a solution. In the second case,
x^3 = 2*x + 1 also has the golden mean as a solution.
Sadly, this sequence does not continue. The golden
mean is obviously not unique in this regard;
if our ratio is 2+sqrt(3) then the wrap-around
-4th sideband is the ratio squared. A table of
+fourth sideband is the ratio squared. A table of
Pisot numbers gives many more such numbers.
1+sqrt(2) squared = 1 + 2* same
-->
+<!-- PM producing a frequency shift:
+(with-sound ()
+ (let ((o (make-oscil 200.0))
+ (e (make-env '(0 0 1 1) :scaler 300.0 :duration 1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 44100))
+ (outa i (oscil o 0.0 (env e))))))
+-->
</body>
</html>
diff --git a/fmv.scm b/fmv.scm
index 653a34b..17b8506 100644
--- a/fmv.scm
+++ b/fmv.scm
@@ -12,40 +12,16 @@
(provide 'snd-fmv.scm)
(define make-fm-violin
- (lambda* (frequency amplitude
- (fm-index 1.0)
- (amp-env #f)
- (periodic-vibrato-rate 5.0)
- (random-vibrato-rate 16.0)
- (periodic-vibrato-amplitude 0.0025)
- (random-vibrato-amplitude 0.005)
- (noise-amount 0.0)
- (noise-freq 1000.0)
- (ind-noise-freq 10.0)
- (ind-noise-amount 0.0)
- (amp-noise-freq 20.0)
- (amp-noise-amount 0.0)
- (gliss-env #f)
- (fm1-env #f)
- (fm2-env #f)
- (fm3-env #f)
- (fm1-rat 1.0)
- (fm2-rat 3.0)
- (fm3-rat 4.0)
- (fm1-index #f)
- (fm2-index #f)
- (fm3-index #f)
- (base 1.0))
-"(make-fm-violin frequency amplitude
- (fm-index 1.0) (amp-env #f) (periodic-vibrato-rate 5.0)
- (random-vibrato-rate 16.0) (periodic-vibrato-amplitude 0.0025)
- (random-vibrato-amplitude 0.005) (noise-amount 0.0)
- (noise-freq 1000.0) (ind-noise-freq 10.0) (ind-noise-amount 0.0)
- (amp-noise-freq 20.0) (amp-noise-amount 0.0) (gliss-env #f)
- (fm1-env #f) (fm2-env #f) (fm3-env #f) (fm1-rat 1.0)
- (fm2-rat 3.0) (fm3-rat 4.0) (fm1-index #f) (fm2-index #f)
- (fm3-index #f) (base 1.0))
+ (let ((documentation "(make-fm-violin frequency amplitude
+ (fm-index 1.0) (amp-env #f) (periodic-vibrato-rate 5.0)
+ (random-vibrato-rate 16.0) (periodic-vibrato-amplitude 0.0025)
+ (random-vibrato-amplitude 0.005) (noise-amount 0.0)
+ (noise-freq 1000.0) (ind-noise-freq 10.0) (ind-noise-amount 0.0)
+ (amp-noise-freq 20.0) (amp-noise-amount 0.0) (gliss-env #f)
+ (fm1-env #f) (fm2-env #f) (fm3-env #f) (fm1-rat 1.0)
+ (fm2-rat 3.0) (fm3-rat 4.0) (fm1-index #f) (fm2-index #f)
+ (fm3-index #f) (base 1.0))
makes a new fm-violin generator. It is the same as the v.scm version,
but does not assume it is running within with-sound. In terms of arguments
beg, dur, degree, reverb-amount, and distance are omitted,
@@ -58,66 +34,90 @@ fm-violin takes the value returned by make-fm-violin and returns a new sample ea
:amp-env (let ((e (make-env :envelope '(0 0 1 1 2 0)
:scaler amp :length dur)))
(lambda () (env e)))))
- (data (channel->vct beg dur)))
+ (data (channel->float-vector beg dur)))
(do ((i 0 (+ 1 i))) ((= i dur))
- (vct-set! data i (+ (vct-ref data i) (v))))
- (vct->channel data beg dur))))"
-
- (let* ((frq-scl (hz->radians frequency))
- (modulate (not (zero? fm-index)))
- (maxdev (* frq-scl fm-index))
- (logfreq (log frequency))
- (index1 (or fm1-index (min pi (* maxdev (/ 5.0 logfreq)))))
- (index2 (or fm2-index (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001)))))))
- (index3 (or fm3-index (min pi (* maxdev (/ 4.0 (sqrt frequency))))))
- (easy-case (and (zero? noise-amount)
- (or (not fm2-env) (equal? fm1-env fm2-env))
- (or (not fm3-env) (equal? fm1-env fm3-env))
- (= fm1-rat (floor fm1-rat))
- (= fm2-rat (floor fm2-rat))
- (= fm3-rat (floor fm3-rat))))
- (carrier (make-oscil frequency))
- (fmosc1 (and modulate (make-oscil (* fm1-rat frequency))))
- (fmosc2 (and modulate (or easy-case (make-oscil (* fm2-rat frequency)))))
- (fmosc3 (and modulate (or easy-case (make-oscil (* fm3-rat frequency)))))
- (coeffs (and easy-case modulate
- (partials->polynomial
- (list fm1-rat index1
- (floor (/ fm2-rat fm1-rat)) index2
- (floor (/ fm3-rat fm1-rat)) index3))))
- (ampf (or amp-env (lambda () amplitude)))
- (indf1 (or fm1-env (lambda () (or (and easy-case modulate 1.0) index1))))
- (indf2 (or fm2-env (lambda () index2)))
- (indf3 (or fm3-env (lambda () index3)))
- (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
- (ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
- (fm-noi (if (not (= 0.0 noise-amount))
- (make-rand noise-freq (* pi noise-amount))
- #f))
- (amp-noi (if (and (not (= 0.0 amp-noise-amount)) (not (= 0.0 amp-noise-freq)))
- (make-rand-interp amp-noise-freq amp-noise-amount)
- #f))
- (ind-noi (if (and (not (= 0.0 ind-noise-amount)) (not (= 0.0 ind-noise-freq)))
- (make-rand-interp ind-noise-freq ind-noise-amount)
- #f))
- (frqf (or gliss-env (lambda () 0.0))))
-
- (lambda ()
- (let ((vib (+ (frqf) (triangle-wave pervib) (rand-interp ranvib)))
- (fuzz (if fm-noi (rand fm-noi) 0.0)))
- (* (ampf)
- (if amp-noi (+ 1.0 (rand-interp amp-noi)) 1.0)
- (oscil carrier
- (+ vib
- (* (if ind-noi (+ 1.0 (rand-interp ind-noi)) 1.0)
- (if fmosc1
- (if coeffs
- (* (indf1)
- (polynomial coeffs (oscil fmosc1 vib)))
- (+ (* (indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
- (* (indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
- (* (indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))
- 0.0))))))))))
+ (set! (data i) (+ (data i) (v))))
+ (float-vector->channel data beg dur))))"))
+
+ (lambda* (frequency amplitude
+ (fm-index 1.0)
+ amp-env
+ (periodic-vibrato-rate 5.0)
+ (random-vibrato-rate 16.0)
+ (periodic-vibrato-amplitude 0.0025)
+ (random-vibrato-amplitude 0.005)
+ (noise-amount 0.0)
+ (noise-freq 1000.0)
+ (ind-noise-freq 10.0)
+ (ind-noise-amount 0.0)
+ (amp-noise-freq 20.0)
+ (amp-noise-amount 0.0)
+ gliss-env
+ fm1-env
+ fm2-env
+ fm3-env
+ (fm1-rat 1.0)
+ (fm2-rat 3.0)
+ (fm3-rat 4.0)
+ fm1-index
+ fm2-index
+ fm3-index
+ (base 1.0))
+
+ (let* ((frq-scl (hz->radians frequency))
+ (modulate (not (zero? fm-index)))
+ (maxdev (* frq-scl fm-index))
+ (logfreq (log frequency))
+ (index1 (or fm1-index (min pi (* maxdev (/ 5.0 logfreq)))))
+ (index2 (or fm2-index (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001)))))))
+ (index3 (or fm3-index (min pi (* maxdev (/ 4.0 (sqrt frequency))))))
+ (easy-case (and (zero? noise-amount)
+ (or (not fm2-env) (equal? fm1-env fm2-env))
+ (or (not fm3-env) (equal? fm1-env fm3-env))
+ (= fm1-rat (floor fm1-rat))
+ (= fm2-rat (floor fm2-rat))
+ (= fm3-rat (floor fm3-rat))))
+ (carrier (make-oscil frequency))
+ (fmosc1 (and modulate (make-oscil (* fm1-rat frequency))))
+ (fmosc2 (and modulate (or easy-case (make-oscil (* fm2-rat frequency)))))
+ (fmosc3 (and modulate (or easy-case (make-oscil (* fm3-rat frequency)))))
+ (coeffs (and easy-case modulate
+ (partials->polynomial
+ (list fm1-rat index1
+ (floor (/ fm2-rat fm1-rat)) index2
+ (floor (/ fm3-rat fm1-rat)) index3))))
+ (ampf (or amp-env (lambda () amplitude)))
+ (indf1 (or fm1-env (lambda () (or (and easy-case modulate 1.0) index1))))
+ (indf2 (or fm2-env (lambda () index2)))
+ (indf3 (or fm3-env (lambda () index3)))
+ (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
+ (ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
+ (fm-noi (and (not (= 0.0 noise-amount))
+ (make-rand noise-freq (* pi noise-amount))))
+ (amp-noi (and (not (= 0.0 amp-noise-amount))
+ (not (= 0.0 amp-noise-freq))
+ (make-rand-interp amp-noise-freq amp-noise-amount)))
+ (ind-noi (and (not (= 0.0 ind-noise-amount))
+ (not (= 0.0 ind-noise-freq))
+ (make-rand-interp ind-noise-freq ind-noise-amount)))
+ (frqf (or gliss-env (lambda () 0.0))))
+
+ (lambda ()
+ (let ((vib (+ (frqf) (triangle-wave pervib) (rand-interp ranvib)))
+ (fuzz (if fm-noi (rand fm-noi) 0.0)))
+ (* (ampf)
+ (if amp-noi (+ 1.0 (rand-interp amp-noi)) 1.0)
+ (oscil carrier
+ (+ vib
+ (* (if ind-noi (+ 1.0 (rand-interp ind-noi)) 1.0)
+ (if fmosc1
+ (if coeffs
+ (* (indf1)
+ (polynomial coeffs (oscil fmosc1 vib)))
+ (+ (* (indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
+ (* (indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
+ (* (indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))
+ 0.0)))))))))))
#|
(define test-v
@@ -128,12 +128,11 @@ fm-violin takes the value returned by make-fm-violin and returns a new sample ea
:scaler amp
:length dur)))
(lambda () (env e)))))
- (data (channel->vct beg dur)))
+ (data (channel->float-vector beg dur)))
(do ((i 0 (+ 1 i)))
((= i dur))
- (vct-set! data i (+ (vct-ref data i)
- (v))))
- (vct->channel data beg dur))))
+ (set! (data i) (+ (data i) (v))))
+ (float-vector->channel data beg dur))))
;;; (with-sound () (test-v 0 10000 440 .1 '(0 0 1 1 2 0)))
@@ -148,31 +147,31 @@ fm-violin takes the value returned by make-fm-violin and returns a new sample ea
(lambda () (env e)))
:fm1-env (let ((osc (make-oscil 100.0)))
(lambda () (oscil osc)))))
- (data (channel->vct beg dur)))
+ (data (channel->float-vector beg dur)))
(do ((i 0 (+ 1 i)))
((= i dur))
- (vct-set! data i (+ (vct-ref data i)
- (v))))
- (vct->channel data beg dur))))
+ (set! (data i) (+ (data i) (v))))
+ (float-vector->channel data beg dur))))
|#
+
+(define fm-violin-ins
+ (let ((documentation "(fm-violin-ins startime dur freq amp degree (reverb-amount 0.0) (distance 1.0) :rest args)
+calls the fm-violin with the given args and mixes the results into the current sound"))
+ (lambda* (startime dur freq amp degree (reverb-amount 0.0) (distance 1.0) :rest args)
+ (let* ((beg (floor (* startime (srate))))
+ (len (floor (* dur (srate))))
+ (loc (make-locsig :channels (channels) :degree (or degree (random 90.0)) :reverb reverb-amount :distance distance))
+ (out-data (make-float-vector len))
+ (v (apply make-fm-violin freq amp args)))
+ (do ((i 0 (+ 1 i)))
+ ((= i len))
+ (set! (out-data i) (v)))
+ (if (= (channels) 2)
+ (let ((bsamps (copy out-data)))
+ (mix-float-vector (float-vector-scale! bsamps (locsig-ref loc 1)) beg #f 1 #f)
+ (mix-float-vector (float-vector-scale! out-data (locsig-ref loc 0)) beg #f 0 #f))
+ (mix-float-vector out-data beg #f 0 #f))))))
-(define* (fm-violin-ins startime dur freq amp (degree #f) (reverb-amount 0.0) (distance 1.0) :rest args)
- "(fm-violin-ins startime dur freq amp (degree #f) (reverb-amount 0.0) (distance 1.0) :rest args)
-calls the fm-violin with the given args and mixes the results into the current sound"
- (let* ((beg (floor (* startime (srate))))
- (len (floor (* dur (srate))))
- (end (+ beg len))
- (loc (make-locsig :channels (channels) :degree (or degree (random 90.0)) :reverb reverb-amount :distance distance))
- (out-data (make-vct len))
- (v (apply make-fm-violin freq amp args)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! out-data i (v)))
- (if (= (channels) 2)
- (let ((bsamps (vct-copy out-data)))
- (mix-vct (vct-scale! bsamps (locsig-ref loc 1)) beg #f 1 #f)
- (mix-vct (vct-scale! out-data (locsig-ref loc 0)) beg #f 0 #f))
- (mix-vct out-data beg #f 0 #f))))
-
+
\ No newline at end of file
diff --git a/frame.scm b/frame.scm
deleted file mode 100644
index a6a1f2a..0000000
--- a/frame.scm
+++ /dev/null
@@ -1,566 +0,0 @@
-;;; various frame-related extensions
-
-;;; frame-reverse! frame-copy (from mixer.scm)
-;;; sound->frame frame->sound
-;;; region->frame
-;;;
-;;; make-frame-reader frame-reader? frame-reader-at-end frame-reader-position frame-reader-home free-frame-reader copy-frame-reader frame-reader-chans
-;;; next-frame previous-frame read-frame
-;;; make-region-frame-reader make-selection-frame-reader
-;;; make-sync-frame-reader
-;;;
-;;; frame->sound-data, sound-data->frame
-;;; sound->sound-data sound-data->sound
-;;; region->sound-data selection->sound-data
-;;; file->vct vct->file
-;;; frame->vct vct->frame
-;;; file->sound-data sound-data->file
-;;;
-;;; insert-sound-data insert-frame insert-vct
-;;; mix-sound-data mix-frame
-;;; scan-sound map-sound
-;;;
-;;; simultaneous-zero-crossing
-
-(provide 'snd-frame.scm)
-
-
-(define (frame-reverse! fr)
- "(frame-reverse fr) reverses the contents of frame fr"
- (if (not (frame? fr))
- (throw 'wrong-type-arg (list "frame-reverse" fr))
- (let ((len (channels fr)))
- (do ((i 0 (+ i 1))
- (j (- len 1) (- j 1)))
- ((>= i (/ len 2)))
- (let ((temp (frame-ref fr i)))
- (frame-set! fr i (frame-ref fr j))
- (frame-set! fr j temp)))
- fr)))
-
-(define (frame-copy fr)
- "(frame-copy fr) returns a copy of frame fr"
- (if (not (frame? fr))
- (throw 'wrong-type-arg (list "frame-copy" fr))
- (let* ((len (channels fr))
- (nfr (make-frame len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (frame-set! nfr i (frame-ref fr i)))
- nfr)))
-
-#|
-(define (frame-cross m1 m2)
- "(frame-cross fr1 fr2) returns the cross product (a frame) of frames fr1 and fr2"
- (if (or (not (= (channels m1) 3))
- (not (= (channels m2) 3)))
- (snd-print "cross product only in 3 dimensions")
- (make-frame 3
- (- (* (frame-ref m1 1) (frame-ref m2 2))
- (* (frame-ref m1 2) (frame-ref m2 1)))
- (- (* (frame-ref m1 2) (frame-ref m2 0))
- (* (frame-ref m1 0) (frame-ref m2 2)))
- (- (* (frame-ref m1 0) (frame-ref m2 1))
- (* (frame-ref m1 1) (frame-ref m2 0))))))
-
-;;; (frame-cross (make-frame 3 0 0 1) (make-frame 3 0 -1 0))
-;;; <frame[3]: [1.000 0.000 0.000]>
-
-(define (frame-normalize f)
- "(frame-normalize fr) scales the contents of frame fr so that its euclidean length is 1.0"
- (let ((mag (sqrt (dot-product (mus-data f) (mus-data f)))))
- (if (> mag 0.0)
- (frame* f (/ 1.0 mag))
- f)))
-
-;;; (frame-normalize (make-frame 3 4 3 0))
-;;; <frame[3]: [0.800 0.600 0.000]>
-|#
-
-(define* (frame->vct fr v)
- "(frame->vct fr v) copies frame fr into either vct v or a new vct, returning the vct"
- (if (not (frame? fr))
- (throw 'wrong-type-arg (list "frame->vct" fr))
- (let* ((flen (channels fr))
- (nv (or (and (vct? v) v)
- (make-vct flen)))
- (len (min flen (length nv))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (nv i) (frame-ref fr i)))
- nv)))
-
-(define* (vct->frame v fr)
- "(vct->frame v fr) copies vct v into either frame fr or a new frame, returning the frame"
- (if (not (vct? v))
- (throw 'wrong-type-arg (list "vct->frame" v))
- (let* ((vlen (length v))
- (nfr (or (and (frame? fr) fr)
- (make-frame vlen)))
- (len (min vlen (channels nfr))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (frame-set! nfr i (v i)))
- nfr)))
-
-
-(define* (frame->sound-data fr sd (pos 0))
- "(frame->sound-data fr sd pos) copies the contents of frame fr into the sound-data sd at position pos"
- (if (not (frame? fr))
- (throw 'wrong-type-arg (list "frame->sound-data" fr))
- (if (not (sound-data? sd))
- (throw 'wrong-type-arg (list "frame->sound-data" sd))
- (if (>= pos (length sd))
- (throw 'out-of-range (list "frame->sound-data" pos))
- (let ((len (min (channels fr)
- (channels sd))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (sound-data-set! sd i pos (frame-ref fr i)))
- sd)))))
-
-(define (sound-data->frame sd pos fr)
- "(sound-data->frame sd pos fr) copies sound-data sd's contents at position pos into frame fr"
- (if (not (frame? fr))
- (throw 'wrong-type-arg (list "sound-data->frame" fr))
- (if (not (sound-data? sd))
- (throw 'wrong-type-arg (list "sound-data->frame" sd))
- (if (>= pos (length sd))
- (throw 'out-of-range (list "sound-data->frame" pos))
- (let ((len (min (channels fr)
- (channels sd))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (frame-set! fr i (sound-data-ref sd i pos)))
- fr)))))
-
-
-(define* (sound->frame (pos 0) snd)
- "(sound->frame pos snd) returns a frame containing the contents of the sound snd at position pos"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "sound->frame" snd))
- (let ((fr (make-frame (channels index))))
- (do ((i 0 (+ i 1)))
- ((= i (channels index))
- fr)
- (frame-set! fr i (sample pos index i)))))))
-
-(define* (frame->sound fr (pos 0) snd)
- "(frame->sound fr pos snd) places the contents of frame fr into sound snd at position pos"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "frame->sound" snd))
- (do ((i 0 (+ i 1)))
- ((= i (channels index))
- fr)
- (set! (sample pos index i) (frame-ref fr i))))))
-
-
-(define (region->frame reg pos)
- "(region->frame pos reg) returns a frame with the contents of region reg at position pos"
- (if (not (region? reg))
- (throw 'no-such-region (list "region->frame" reg))
- (let ((fr (make-frame (channels reg))))
- (do ((i 0 (+ i 1)))
- ((= i (channels reg))
- fr)
- (frame-set! fr i (region-sample reg pos i))))))
-
-
-(define* (sound->sound-data (beg 0) dur snd)
- "(sound->sound-data beg dur snd) returns a sound-data object containing the samples in sound snd starting at position beg for dur frames"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "sound->sound-data" snd))
- (let* ((chns (channels index))
- (len (or dur (max 1 (- (frames index) beg))))
- (sd (make-sound-data chns len)))
- (do ((i 0 (+ i 1)))
- ((= i chns)
- sd)
- (vct->sound-data (channel->vct beg len index i) sd i))))))
-
-(define* (sound-data->sound sd (beg 0) dur snd)
- "(sound-data->sound sd beg dur snd) places the contents of sound-data sd into sound snd starting at position beg for dur frames"
- (if (not (sound-data? sd))
- (throw 'wrong-type-arg (list "sound-data->sound" sd))
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "sound->sound-data" snd))
- (let ((ndur (or dur (length sd))))
- (do ((i 0 (+ i 1)))
- ((= i (channels index))
- sd)
- (vct->channel (sound-data->vct sd i) beg ndur index i)))))))
-
-
-
-(define +frame-reader-tag+ 0)
-(define +frame-reader-snd+ 1)
-(define +frame-reader-channels+ 2)
-(define +frame-reader-frame+ 3)
-(define +frame-reader0+ 4)
-
-(define* (make-frame-reader (beg 0) snd dir edpos)
- "(make-frame-reader beg snd dir edpos) returns a frame reader, basically a sampler that reads all channels on each call"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (and (not (sound? index))
- (not (string? index))) ; filename is a possibility here
- (throw 'no-such-sound (list "make-frame-reader" snd))
- (let* ((chns (if (sound? index) (channels index) (channels index)))
- (fr (make-vector (+ chns +frame-reader0+))))
- (set! (fr +frame-reader-tag+) 'frame-reader)
- (set! (fr +frame-reader-snd+) index)
- (set! (fr +frame-reader-channels+) chns)
- (set! (fr +frame-reader-frame+) (make-frame chns))
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (set! (fr (+ i +frame-reader0+)) (make-sampler beg index i dir edpos)))
- fr))))
-
-(define (frame-reader? obj)
- "(frame-reader? obj) -> #t if obj is a frame-reader"
- (and (vector? obj)
- (eq? (obj +frame-reader-tag+) 'frame-reader)))
-
-(define (frame-reader-at-end? fr)
- "(frame-reader-at-end? fr) -> #t if the samplers in frame-reader fr have reached the end of their respective channels"
- (if (frame-reader? fr)
- (let ((at-end #t))
- (do ((i 0 (+ i 1)))
- ((or (not at-end)
- (= i (fr +frame-reader-channels+)))
- at-end)
- (set! at-end (sampler-at-end? (fr (+ i +frame-reader0+))))))
- (throw 'wrong-type-arg (list "frame-reader-at-end" fr))))
-
-(define (frame-reader-position fr)
- "(frame-reader-position fr) -> current read position of frame-reader fr"
- (if (frame-reader? fr)
- (sampler-position (fr +frame-reader0+))
- (throw 'wrong-type-arg (list "frame-reader-position" fr))))
-
-(define (frame-reader-home fr)
- "(frame-reader-home fr) -> sound object associated with frame-reader fr"
- (if (frame-reader? fr)
- (fr +frame-reader-snd+)
- (throw 'wrong-type-arg (list "frame-reader-home" fr))))
-
-(define (frame-reader-chans fr)
- "(frame-reader-chans fr) -> number of channels read by frame-reader fr"
- (if (frame-reader? fr)
- (fr +frame-reader-channels+)
- (throw 'wrong-type-arg (list "frame-reader-chans" fr))))
-
-(define (free-frame-reader fr)
- "(free-frame-reader fr) frees all readers associated with frame-reader fr"
- (if (frame-reader? fr)
- (do ((i 0 (+ i 1)))
- ((= i (fr +frame-reader-channels+)))
- (free-sampler (fr (+ i +frame-reader0+))))
- (throw 'wrong-type-arg (list "free-frame-reader" fr))))
-
-(define (copy-frame-reader fr)
- "(copy-frame-reader fr) returns a copy of frame-reader fr"
- (if (frame-reader? fr)
- (let* ((chns (fr +frame-reader-channels+))
- (nfr (make-vector (+ chns +frame-reader0+))))
- (set! (nfr +frame-reader-tag+) 'frame-reader)
- (set! (nfr +frame-reader-snd+) (fr 1))
- (set! (nfr +frame-reader-channels+) chns)
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (set! (nfr (+ i +frame-reader0+)) (copy-sampler (fr (+ i +frame-reader0+)))))
- nfr)
- (throw 'wrong-type-arg (list "copy-frame-reader" fr))))
-
-(define (next-frame fr)
- "(next-frame fr) returns the next frame as read by frame-reader fr"
- (let ((vals (fr +frame-reader-frame+)))
- (do ((i 0 (+ i 1)))
- ((= i (fr +frame-reader-channels+)))
- (frame-set! vals i (next-sample (fr (+ i +frame-reader0+)))))
- vals))
-
-(define (previous-frame fr)
- "(previous-frame fr) returns the previous frame as read by frame-reader fr"
- (let ((vals (fr +frame-reader-frame+)))
- (do ((i 0 (+ i 1)))
- ((= i (fr +frame-reader-channels+)))
- (frame-set! vals i (previous-sample (fr (+ i +frame-reader0+)))))
- vals))
-
-(define (read-frame fr)
- "(read-frame fr) returns the next frame read by frame-reader fr taking its current read direction into account"
- (let ((vals (fr +frame-reader-frame+)))
- (do ((i 0 (+ i 1)))
- ((= i (fr +frame-reader-channels+)))
- (frame-set! vals i (read-sample (fr (+ i +frame-reader0+)))))
- vals))
-
-
-(define* (make-region-frame-reader reg beg dir)
- "(make-region-frame-reader reg beg dir) returns a frame-reader reading the contents of region reg"
- (if (not (region? reg))
- (throw 'no-such-region (list "make-region-frame-reader" reg))
- (let* ((chns (channels reg))
- (fr (make-vector (+ chns +frame-reader0+))))
- (set! (fr +frame-reader-tag+) 'frame-reader)
- (set! (fr +frame-reader-snd+) reg)
- (set! (fr +frame-reader-channels+) chns)
- (set! (fr +frame-reader-frame+) (make-frame chns))
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (set! (fr (+ i +frame-reader0+)) (make-region-sampler reg beg i dir)))
- fr)))
-
-(define* (make-sync-frame-reader (beg 0) snd dir edpos)
- "(make-sync-frame-reader beg snd dir edpos) returns a frame reader that reads all channels sync'd to 'snd'"
- (let* ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "make-sync-frame-reader" snd))
- (let ((snc (sync index)))
- (if (= snc 0)
- (make-frame-reader beg snd dir edpos)
- (let ((chns 0))
- (for-each
- (lambda (s)
- (if (= (sync s) snc) ; sync field is always an int (0 = none)
- (set! chns (+ chns (channels s)))))
- (sounds))
- (let ((fr (make-vector (+ chns +frame-reader0+))))
- (set! (fr +frame-reader-tag+) 'frame-reader)
- (set! (fr +frame-reader-snd+) index)
- (set! (fr +frame-reader-channels+) chns)
- (set! (fr +frame-reader-frame+) (make-frame chns))
- (let ((ctr 0))
- (for-each
- (lambda (s)
- (if (= (sync s) snc)
- (begin
- (do ((i 0 (+ i 1)))
- ((= i (channels s)))
- (set! (fr (+ (+ i ctr) +frame-reader0+)) (make-sampler beg s i dir edpos)))
- (set! ctr (+ ctr (channels s))))))
- (sounds)))
- fr)))))))
-
-(define* (make-selection-frame-reader (beg 0))
- "(make-selection-frame-reader (beg 0)) returns a frame reader that reads all channels of the current selection"
- (if (not (selection?))
- (throw 'no-active-selection (list "make-selection-frame-reader" beg))
- (let* ((chns (selection-chans))
- (fr (make-vector (+ chns +frame-reader0+))))
- (set! (fr +frame-reader-tag+) 'frame-reader)
- (set! (fr +frame-reader-snd+) -1)
- (set! (fr +frame-reader-channels+) chns)
- (set! (fr +frame-reader-frame+) (make-frame chns))
- (let ((ctr 0))
- (for-each
- (lambda (snd)
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (if (selection-member? snd chn)
- (begin
- (set! (fr (+ ctr +frame-reader0+)) (make-sampler (+ beg (selection-position snd chn)) snd chn))
- (set! ctr (+ 1 ctr))))))
- (sounds)))
- fr)))
-
-
-(define (file->vct file)
- "(file->vct file) returns a vct with file's data (channel 0)"
- (let* ((len (frames file))
- (reader (make-sampler 0 file))
- (data (make-vct len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (data i) (next-sample reader)))
- (free-sampler reader)
- data))
-
-(define* (vct->file v file (srate 22050) (comment ""))
- "(vct->file v file srate comment) writes the data in vct v to the specified sound file"
- (if (vct? v)
- (let ((fd (mus-sound-open-output file srate 1 #f mus-riff comment)))
- (mus-sound-write fd 0 (- (length v) 1) 1 (vct->sound-data v))
- (mus-sound-close-output fd (* (mus-bytes-per-sample mus-out-format) (length v)))
- file)
- (throw 'wrong-type-arg (list "file->vct" v))))
-
-
-(define (file->sound-data file)
- "(file->sound-data file) returns a sound-data object with the contents of file"
- (let* ((len (frames file))
- (chns (channels file))
- (reader (make-frame-reader 0 file))
- (data (make-sound-data chns len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (frame->sound-data (read-frame reader) data i))
- (free-frame-reader reader)
- data))
-
-(define* (sound-data->file sd file (srate 22050) (comment ""))
- "(sound-data->file sd file srate comment) writes the contents of sound-data sd to file"
- (if (sound-data? sd)
- (let ((fd (mus-sound-open-output file srate (channels sd) #f mus-riff comment)))
- (mus-sound-write fd 0 (- (length sd) 1) (channels sd) sd)
- (mus-sound-close-output fd (* (mus-bytes-per-sample mus-out-format) (length sd) (channels sd)))
- file)
- (throw 'wrong-type-arg (list "sound-data->file" sd))))
-
-
-(define (region->sound-data reg)
- "(region->sound-data reg) returns a sound-data object with the contents of region reg"
- (if (region? reg)
- (let* ((reader (make-region-frame-reader reg 0))
- (len (region-frames reg))
- (chns (channels reg))
- (data (make-sound-data chns len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (frame->sound-data (read-frame reader) data i))
- (free-frame-reader reader)
- data)
- (throw 'no-such-region (list "region->sound-data" reg))))
-
-(define* (selection->sound-data (beg 0))
- "(selection->sound-data beg) returns a sound-data object with the contents of current selection"
- (if (selection?)
- (let* ((reader (make-selection-frame-reader beg))
- (len (- (selection-frames) beg))
- (chns (selection-chans))
- (sd (make-sound-data chns len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (frame->sound-data (read-frame reader) sd i))
- (free-frame-reader reader)
- sd)
- (throw 'no-active-selection (list "selection->sound-data"))))
-
-
-(define* (insert-vct v (beg 0) dur snd chn edpos)
- "(insert-vct v beg dur snd chn edpos) inserts vct v's data into sound snd at beg"
- (if (not (vct? v))
- (throw 'wrong-type-arg (list "insert-vct" v))
- (let ((len (or dur (length v))))
- (insert-samples beg len v snd chn edpos #f (format #f "insert-vct ~A ~A ~A" (vct->string v) beg dur)))))
-
-(define* (insert-frame fr (beg 0) snd edpos)
- "(insert-frame fr beg snd edpos) inserts frame fr's data into sound snd (one sample in each channel) at beg"
- (if (not (frame? fr))
- (throw 'wrong-type-arg (list "insert-frame" fr))
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "insert-frame" snd))
- (let ((chns (min (channels fr) (channels index))))
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (insert-sample beg (frame-ref fr chn) index chn edpos)))))))
-
-(define* (insert-sound-data sd (beg 0) dur snd edpos)
- "(insert-sound-data sd beg dur snd edpos) inserts sound-data sd's contents into sound snd at beg"
- ;; this should be built-into insert-samples
- (if (not (sound-data? sd))
- (throw 'wrong-type-arg (list "insert-sound-data" sd))
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "insert-sound-data" snd))
- (let* ((chns (min (channels sd) (channels index)))
- (len (or dur (length sd)))
- (v (make-vct len)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (insert-samples beg len (sound-data->vct sd chn v) index chn edpos #f "insert-sound-data")))))))
-
-
-(define* (mix-frame fr (beg 0) snd)
- "(mix-frame fr beg snd) mixes frame fr's data into sound snd (one sample in each channel) at beg"
- (if (not (frame? fr))
- (throw 'wrong-type-arg (list "mix-frame" fr))
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "mix-frame" snd))
- (let ((chns (min (channels fr) (channels index))))
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (set! (sample beg index chn) (+ (frame-ref fr chn) (sample beg index chn)))))))))
-
-(define* (mix-sound-data sd (beg 0) dur snd tagged)
- "(mix-sound-data sd beg dur snd tagged) mixes the contents of sound-data sd into sound snd at beg"
- (if (not (sound-data? sd))
- (throw 'wrong-type-arg (list "mix-sound-data" sd))
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (not (sound? index))
- (throw 'no-such-sound (list "mix-sound-data" snd))
- (let* ((chns (min (channels sd) (channels index)))
- (len (or dur (length sd)))
- (v (make-vct len))
- (mix-id #f))
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (let ((id (mix-vct (sound-data->vct sd chn v) beg index chn tagged "mix-sound-data")))
- (if (not mix-id) (set! mix-id id))))
- mix-id)))))
-
-
-(define* (scan-sound func (beg 0) dur snd with-sync)
- "(scan-sound func beg dur snd with-sync) is like scan-channel; it passes func a frame on each call, and stops when func returns true"
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (sound? index)
- (let* ((reader (if with-sync
- (make-sync-frame-reader beg index)
- (make-frame-reader beg index)))
- (result #f)
- (len (frames index))
- (end (if dur (min len (+ beg dur)) len)))
- (do ((i beg (+ i 1)))
- ((or result (= i end))
- (and result
- (list result (- i 1))))
- (set! result (func (read-frame reader)))))
- (throw 'no-such-sound (list "scan-sound" snd)))))
-
-(define +read-forward+ 1)
-
-(define* (map-sound func (beg 0) dur snd edpos)
- "(map-sound func beg dur snd edpos) is a version of map-channel that passes func a frame on each call, rather than a sample"
- ;; not sure map-sound with sync is a good idea -- even scale-by following sync seems bad
- (let ((index (or snd (selected-sound) (car (sounds)))))
- (if (sound? index)
- (let* ((out-chans (channels index))
- (reader (make-frame-reader beg index +read-forward+ edpos))
- (filename (snd-tempnam))
- (writer (make-frame->file filename out-chans))
- (len (frames index))
- (end (if dur (min len (+ beg dur)) len))
- (loc 0))
- (do ((i beg (+ i 1)))
- ((= i end))
- (let ((result (func (next-frame reader))))
- (if result
- (begin
- (frame->file writer loc result)
- (set! loc (+ 1 loc))))))
- (mus-close writer)
- (free-frame-reader reader)
- (do ((i 0 (+ i 1)))
- ((= i (channels index)))
- (set! (samples beg loc index i #f "map-sound" i #f (= i 0)) filename))) ; edpos = #f, auto-delete = chan=0
- (throw 'no-such-sound (list "map-sound" snd)))))
-
-
-(define* (simultaneous-zero-crossing (beg 0) dur snd)
- "(simultaneous-zero-crossing :option beg dur snd) looks through all channels of 'snd' for a simultaneous zero crossing."
- (let ((last-fr (make-frame (channels snd))))
- (scan-sound (lambda (fr)
- (let ((result #t))
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels fr)))
- (set! result (and result (< (* (frame-ref fr chn) (frame-ref last-fr chn)) 0.0)))
- (frame-set! last-fr chn (frame-ref fr chn)))
- result))
- beg dur snd)))
-
diff --git a/freeverb.rb b/freeverb.rb
index 4f85857..b99b952 100644
--- a/freeverb.rb
+++ b/freeverb.rb
@@ -1,8 +1,8 @@
# freeverb.rb -- CLM -> Snd/Ruby translation of freeverb.ins
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Tue Apr 08 03:53:20 CEST 2003
-# Changed: Thu Oct 15 00:14:35 CEST 2009
+# Created: 03/04/08 03:53:20
+# Changed: 14/11/13 15:47:00
# Original notes of Fernando Lopez-Lezcano
@@ -21,18 +21,15 @@
# ;; streams must match.
# ;; - the "wet" parameter has been eliminated as it does not apply to the model
# ;; that clm uses to generate reverberation
-# ;; - the "width" parameter name has been changed to :global. It now controls the
-# ;; coefficients of an NxN matrix that specifies how the output of the reverbs
-# ;; is mixed into the output stream.
+# ;; - the "width" parameter name has been changed to :global. It now controls
+# ;; the coefficients of an NxN matrix that specifies how the output of the
+# ;; reverbs is mixed into the output stream.
# ;; - predelays for the input channels have been added.
# ;; - damping can be controlled individually for each channel.
-# For more information see clm-2/freeverb/index.html.
-
-# Code:
+# For more information see clm-x/freeverb.html.
require "ws"
-with_silence(LoadError) do require "sndins" end
# Snd-Ruby's freeverb and fcomb (see sndins.so for a faster one).
@@ -50,8 +47,8 @@ unless provided? :sndins
end
def inspect
- format("#<%s: %s, %s, feedback: %0.3f>",
- self.class, @delay.inspect, @filter.inspect, @feedback)
+ format("#<%s: %p, %p, feedback: %0.3f>",
+ self.class, @delay, @filter, @feedback)
end
end
@@ -68,7 +65,8 @@ unless provided? :sndins
end
end
-add_help(:freeverb_rb, "freeverb_rb(*args)
+add_help(:freeverb,
+ "freeverb(*args)
:room_decay, 0.5,
:damping, 0.5,
:global, 0.3,
@@ -81,11 +79,12 @@ add_help(:freeverb_rb, "freeverb_rb(*args)
:allpasstuning, [556, 441, 341, 225],
:scale_damping, 0.4,
:stereo_spread, 23,
-with_sound(:reverb, :freeverb_rb) do fm_violin_rb(0, 1, 440, 0.3) end
+with_sound(:reverb, :freeverb) do fm_violin(0, 1, 440, 0.3) end
This is the Ruby version of freeverb. For a faster one see sndins.so.")
-def freeverb_rb(*args)
+def freeverb(*args)
room_decay, damping, global, predelay, output_gain, output_mixer = nil
- scale_room_decay, offset_room_decay, combtuning, allpasstuning, scale_damping, stereo_spread = nil
+ scale_room_decay, offset_room_decay, combtuning, allpasstuning = nil
+ scale_damping, stereo_spread = nil
optkey(args, binding,
[:room_decay, 0.5],
[:damping, 0.5],
@@ -99,112 +98,117 @@ def freeverb_rb(*args)
[:allpasstuning, [556, 441, 341, 225]],
[:scale_damping, 0.4],
[:stereo_spread, 23])
- out_mix = (mixer?(output_mixer) ? output_mixer : make_mixer(@channels))
- out_buf = make_frame(@channels)
- out_gain = output_gain
- f_out = make_frame(@channels)
- predelays = make_array(@reverb_channels)
- local_gain = (1.0 - global) * (1.0 - 1.0 / @channels) + 1.0 / @channels
- global_gain = (@channels - local_gain * @channels) / [(@channels * @channels - @channels), 1].max
- srate_scale = @srate / 44100.0
- room_decay_val = room_decay * scale_room_decay + offset_room_decay
- numcombs = combtuning.length
- numallpasses = allpasstuning.length
- combs = make_array(@channels) do make_array(numcombs) end
- allpasses = make_array(@channels) do make_array(numallpasses) end
if @reverb_channels > 1 and @reverb_channels != @channels
error("input must be mono or input channels must equal output channels")
end
- unless mixer?(output_mixer)
- if output_mixer.kind_of?(Array)
- @channels.times do |i|
- @channels.times do |j|
- mixer_set!(out_mix, i, j, output_mixer[i][j])
- end
- end
- else
- @channels.times do |i|
- @channels.times do |j|
- mixer_set!(out_mix, i, j, (out_gain * (i == j ? local_gain : global_gain)) / @channels)
- end
- end
+ out_gain = output_gain
+ local_gain = (1.0 - global) * (1.0 - 1.0 / @channels) + 1.0 / @channels
+ global_gain = (@channels - local_gain * @channels) /
+ [(@channels * @channels - @channels), 1].max
+ srate_scale = @srate / 44100.0
+ out_mix = output_mixer
+ unless vct?(output_mixer)
+ out_mix = Vct.new(@channels) do
+ (out_gain * global_gain) / @channels
end
end
- if predelay.kind_of?(Array)
- @reverb_channels.times do |c|
- predelays[c] = make_delay(:size, (@srate * predelay[c]).to_i)
- end
- else
- @reverb_channels.times do |c|
- predelays[c] = make_delay(:size, (@srate * predelay).to_i)
- end
+ predelays = make_array(@reverb_channels) do
+ make_delay(:size, (@srate * predelay).to_i)
end
- if damping.kind_of?(Array)
- @channels.times do |c|
- combtuning.each_with_index do |tuning, i|
- l = (srate_scale * tuning).round
- dmp = scale_damping * damping[i]
- l += (srate_scale * stereo_spread).round if c.odd?
- combs[c][i] = make_fcomb(room_decay_val, l, 1.0 - dmp, dmp)
+ room_decay_val = room_decay * scale_room_decay + offset_room_decay
+ combs = make_array(@channels) do |c|
+ combtuning.map do |tuning|
+ dmp = scale_damping * damping
+ sz = (srate_scale * tuning).to_i
+ if c.odd?
+ sz += (srate_scale * stereo_spread).to_i
end
+ make_fcomb(room_decay_val, sz, 1.0 - dmp, dmp)
end
- else
- @channels.times do |c|
- combtuning.each_with_index do |tuning, i|
- l = (srate_scale * tuning).round
- dmp = scale_damping * damping
- l += (srate_scale * stereo_spread).round if c.odd?
- combs[c][i] = make_fcomb(room_decay_val, l, 1.0 - dmp, dmp)
+ end
+ allpasses = make_array(@channels) do |c|
+ allpasstuning.map do |tuning|
+ sz = (srate_scale * tuning).to_i
+ if c.odd?
+ sz += (srate_scale * stereo_spread).to_i
end
+ make_all_pass(:size, sz, :feedforward, -1.0, :feedback, 0.5)
end
end
- @channels.times do |c|
- allpasstuning.each_with_index do |tuning, i|
- l = (srate_scale * tuning).round
- l += (srate_scale * stereo_spread).round if c.odd?
- allpasses[c][i] = make_all_pass(:size, l, :feedforward, -1, :feedback, 0.5)
- end
+ len = @ws_reverb.length + seconds2samples(@decay_time)
+ name = get_func_name()
+ # to satisfy with_sound-option :info and :notehook
+ with_sound_info(name, 0, samples2seconds(len))
+ if @verbose
+ Snd.message("%s on %d in and %d out channels",
+ name, @reverb_channels, @channels)
end
- run_reverb(:frames) do |f_in, i|
- if @reverb_channels > 1
- @channels.times do |c|
- frame_set!(f_in, c, delay(predelays[c], frame_ref(f_in, c)))
- frame_set!(f_out, c, 0.0)
- numcombs.times do |j|
- frame_set!(f_out, c, frame_ref(f_out, c) + fcomb(combs[c][j], frame_ref(f_in, c)))
+ f_in = Vct.new(@reverb_channels, 0.0)
+ f_out = Vct.new(@channels, 0.0)
+ out_buf = Vct.new(@channels, 0.0)
+ if @reverb_channels == 1
+ len.times do |i|
+ fin = delay(predelays[0], file2sample(@ws_reverb, i, 0))
+ combs.each_with_index do |fcbs, c|
+ f_out[c] = 0.0
+ fcbs.each do |fcb|
+ f_out[c] += fcomb(fcb, fin)
end
end
- else
- frame_set!(f_in, 0, delay(predelays[0], frame_ref(f_in, 0)))
- @channels.times do |c|
- frame_set!(f_out, c, 0.0)
- numcombs.times do |j|
- frame_set!(f_out, c, frame_ref(f_out, c) + fcomb(combs[c][j], frame_ref(f_in, 0)))
+ allpasses.each_with_index do |apss, c|
+ apss.each do |aps|
+ f_out[c] = all_pass(aps, f_out[c])
end
end
+ frample2file(@ws_output, i,
+ frample2frample(out_mix, f_out, @channels,
+ out_buf, @channels))
end
- @channels.times do |c|
- numallpasses.times do |j|
- frame_set!(f_out, c, all_pass(allpasses[c][j], frame_ref(f_out, c)))
+ else
+ len.times do |i|
+ fin = file2frample(@ws_reverb, i, f_in).map_with_index do |f, c|
+ delay(predelays[c], f)
+ end
+ combs.each_with_index do |fcbs, c|
+ f_out[c] = 0.0
+ fcbs.each do |fcb|
+ f_out[c] += fcomb(fcb, fin[c])
+ end
+ end
+ allpasses.each_with_index do |apss, c|
+ apss.each do |aps|
+ f_out[c] = all_pass(aps, f_out[c])
+ end
end
+ frample2file(@ws_output, i,
+ frample2frample(out_mix, f_out, @channels,
+ out_buf, @channels))
end
- frame2frame(f_out, out_mix, out_buf)
end
end
-class Snd_Instrument
- alias freeverb freeverb_rb
-end
-
=begin
-with_sound(:reverb, :freeverb_rb,
+with_sound(:reverb, :freeverb,
:reverb_data, [:room_decay, 0.9],
:channels, 2,
:reverb_channels, 1,
:output, "fvrb-test.snd",
:play, 1,
:statistics, true) do
- fm_violin_rb(0, 1, 440, 0.5)
+ fm_violin(0, 1, 440, 0.5)
+end
+with_sound(:statistics, true,
+ :reverb, :freeverb,
+ :reverb_data, [:output_gain, 3.0]) do
+ outa(0, 0.5, @ws_reverb)
+end
+with_sound(:channels, 2,
+ :reverb_channels, 2,
+ :statistics, true,
+ :reverb, :freeverb,
+ :reverb_data, [:output_gain, 3.0]) do
+ outa(0, 0.5, @ws_reverb)
+ outb(0, 0.1, @ws_reverb)
end
=end
diff --git a/freeverb.scm b/freeverb.scm
index 50b7c17..3f0dee6 100644
--- a/freeverb.scm
+++ b/freeverb.scm
@@ -31,144 +31,180 @@
;;; changed to accommodate run and mono output, bill 11-Jun-06
;;; use the filtered-comb gen, bill 29-Jun-06
+;;; optimized slightly, bill 17-Sep-12
+;;; changed to use float-vectors, not frames and mixers 11-Oct-13
;;; Code:
(provide 'snd-freeverb.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(definstrument (freeverb
- (room-decay 0.5)
- (damping 0.5)
- (global 0.3)
- (predelay 0.03)
- (output-gain 1.0)
- (output-mixer #f)
- (scale-room-decay 0.28)
- (offset-room-decay 0.7)
- (combtuning '(1116 1188 1277 1356 1422 1491 1557 1617))
- (allpasstuning '(556 441 341 225))
- (scale-damping 0.4)
- (stereo-spread 23)
- (verbose #f))
- (let* ((startime 0.0)
- (dur (+ 1.0 (mus-sound-duration (mus-file-name *reverb*))))
- (beg (seconds->samples startime))
- (end (cadr (times->samples startime dur)))
- (out-chans (channels *output*))
- (out-mix (if (mixer? output-mixer) output-mixer
- (make-mixer out-chans 0.0)))
- (out-buf (make-frame out-chans 0.0))
- (out-gain output-gain)
- (f-out (make-frame out-chans 0.0))
- (in-chans (channels *reverb*))
- (f-in (make-frame in-chans 0.0))
- (predelays (make-vector in-chans))
- (local-gain (if (= out-chans 1)
- global
- (+ (/ (- 1.0 global) (- 1 (/ 1.0 out-chans)))
- (/ 1.0 out-chans))))
- (global-gain (if (= out-chans 1)
- local-gain
- (/ (- out-chans (* local-gain out-chans))
- (- (* out-chans out-chans) out-chans))))
- (srate-scale (/ *clm-srate* 44100.0))
- (room-decay-val (+ (* room-decay scale-room-decay)
- offset-room-decay))
- (numcombs (length combtuning))
- (numallpasses (length allpasstuning))
- (fcombs (make-vector (* out-chans numcombs)))
- (allpasses (make-vector (* out-chans numallpasses))))
- (if verbose
- (format #t ";;; freeverb: ~d input channels, ~d output channels~%" in-chans out-chans))
- (if (and (> in-chans 1)
- (not (= in-chans out-chans)))
- (error "input must be mono or input channels must equal output channels"))
- (if (not (mixer? output-mixer))
- (if (vector? output-mixer)
- (do ((i 0 (+ 1 i)))
- ((= i out-chans))
- (do ((j 0 (+ 1 j)))
- ((= j out-chans))
- (set! (mixer-ref out-mix i j) (vector-ref output-mixer (+ (* i out-chans) j)))))
- (do ((i 0 (+ 1 i)))
- ((= i out-chans))
- (do ((j 0 (+ 1 j)))
- ((= j out-chans))
- (set! (mixer-ref out-mix i j)
- (/ (* out-gain (if (= i j)
- local-gain
- global-gain))
- out-chans))))))
- (do ((c 0 (+ 1 c)))
- ((= c in-chans))
- (vector-set! predelays
- c
- (make-delay :size (round (* *clm-srate*
- (if (vector? predelay)
- (vector-ref predelay c)
- (if (list? predelay)
- (list-ref predelay c)
- predelay)))))))
- (do ((c 0 (+ 1 c)))
- ((= c out-chans))
- (do ((i 0 (+ 1 i)))
- ((= i numcombs))
- (let* ((tuning (list-ref combtuning i))
- (len (floor (* srate-scale tuning)))
- (dmp (* scale-damping
- (if (vector? damping)
- (vector-ref damping i)
- (if (list? damping)
- (list-ref damping i)
- damping)))))
- (if (odd? c)
- (set! len (+ len (floor (* srate-scale stereo-spread)))))
- (vector-set! fcombs (+ (* c numcombs) i)
- (make-filtered-comb :size len
- :scaler room-decay-val
- :filter (make-one-zero :a0 (- 1.0 dmp) :a1 dmp))))))
- (do ((c 0 (+ 1 c)))
- ((= c out-chans))
- (do ((i 0 (+ 1 i)))
- ((= i numallpasses))
- (let* ((tuning (list-ref allpasstuning i))
- (len (floor (* srate-scale tuning))))
- (if (odd? c)
- (set! len (+ len (floor (* srate-scale stereo-spread)))))
- (vector-set! allpasses (+ (* c numallpasses) i)
- (make-all-pass :size len :feedforward -1 :feedback 0.5)))))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (declare (predelays clm-vector) (allpasses clm-vector) (fcombs clm-vector))
- (file->frame *reverb* i f-in)
- (if (> in-chans 1)
- (do ((c 0 (+ 1 c)))
- ((= c out-chans))
- (frame-set! f-in c (delay (vector-ref predelays c) (frame-ref f-in c)))
- (frame-set! f-out c 0.0)
- (do ((j 0 (+ 1 j)))
- ((= j numcombs))
- (let ((ctr (+ (* c numcombs) j)))
- (frame-set! f-out c (+ (frame-ref f-out c)
- (filtered-comb (vector-ref fcombs ctr) (frame-ref f-in 0)))))))
- (begin
- (frame-set! f-in 0 (delay (vector-ref predelays 0) (frame-ref f-in 0)))
- (do ((c 0 (+ 1 c)))
- ((= c out-chans))
- (frame-set! f-out c 0.0)
- (do ((j 0 (+ 1 j)))
- ((= j numcombs))
- (let ((ctr (+ (* c numcombs) j)))
- (frame-set! f-out c (+ (frame-ref f-out c)
- (filtered-comb (vector-ref fcombs ctr) (frame-ref f-in 0)))))))))
- (do ((c 0 (+ 1 c)))
- ((= c out-chans))
- (do ((j 0 (+ 1 j)))
- ((= j numallpasses))
- (frame-set! f-out c (all-pass (vector-ref allpasses (+ (* c numallpasses) j))
- (frame-ref f-out c)))))
- (frame->file *output* i (frame->frame f-out out-mix out-buf))))))
+ (room-decay 0.5)
+ (damping 0.5)
+ (global 0.3)
+ (predelay 0.03)
+ (output-gain 1.0)
+ output-mixer
+ (scale-room-decay 0.28)
+ (offset-room-decay 0.7)
+ (combtuning '(1116 1188 1277 1356 1422 1491 1557 1617))
+ (allpasstuning '(556 441 341 225))
+ (scale-damping 0.4)
+ (stereo-spread 23)
+ (decay-time 1.0)
+ verbose)
+ (let ((startime 0.0)
+ (dur (+ decay-time (mus-sound-duration (mus-file-name *reverb*))))
+ (out-chans (channels *output*))
+ (in-chans (channels *reverb*))
+ (srate-scale (/ *clm-srate* 44100.0))
+ (room-decay-val (+ (* room-decay scale-room-decay) offset-room-decay))
+ (numcombs (length combtuning))
+ (numallpasses (length allpasstuning)))
+ (let ((beg (seconds->samples startime))
+ (end (seconds->samples (+ startime dur)))
+ (out-buf (make-float-vector out-chans 0.0))
+ (f-out (make-float-vector out-chans 0.0))
+ (f-in (make-float-vector in-chans 0.0))
+ (predelays (make-vector in-chans))
+ (fcombs (make-vector (* out-chans numcombs)))
+ (allpasses (make-vector (* out-chans numallpasses)))
+ (local-gain (if (= out-chans 1)
+ global
+ (+ (/ (- 1.0 global) (- 1 (/ 1.0 out-chans)))
+ (/ 1.0 out-chans))))
+ (global-gain 0.0))
+
+ (set! global-gain (if (= out-chans 1)
+ local-gain
+ (/ (- out-chans (* local-gain out-chans))
+ (- (* out-chans out-chans) out-chans))))
+ (if verbose
+ (format #t ";;; freeverb: ~d input channels, ~d output channels~%" in-chans out-chans))
+ (if (and (> in-chans 1)
+ (not (= in-chans out-chans)))
+ (error "input must be mono or input channels must equal output channels"))
+
+ (let ((out-mix (or output-mixer
+ (let ((v (make-float-vector (list out-chans out-chans) 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i out-chans))
+ (do ((j 0 (+ j 1)))
+ ((= j out-chans))
+ (set! (v i j) (/ (* output-gain (if (= i j) local-gain global-gain)) out-chans))))
+ v))))
+
+ (do ((c 0 (+ 1 c)))
+ ((= c in-chans))
+ (set! (predelays c) (make-delay :size (round (* *clm-srate* (if (number? predelay) predelay (predelay c)))))))
+
+ (do ((c 0 (+ 1 c)))
+ ((= c out-chans))
+ (do ((i 0 (+ i 1)))
+ ((= i numcombs))
+ (let* ((tuning (combtuning i))
+ (len (floor (* srate-scale tuning)))
+ (dmp (* scale-damping (if (number? damping) damping (damping i)))))
+ (if (odd? c)
+ (set! len (+ len (floor (* srate-scale stereo-spread)))))
+ (set! (fcombs (+ (* c numcombs) i))
+ (make-filtered-comb :size len
+ :scaler room-decay-val
+ :filter (make-one-zero :a0 (- 1.0 dmp) :a1 dmp))))))
+ (do ((c 0 (+ 1 c)))
+ ((= c out-chans))
+ (do ((i 0 (+ i 1)))
+ ((= i numallpasses))
+ (let* ((tuning (allpasstuning i))
+ (len (floor (* srate-scale tuning))))
+ (if (odd? c)
+ (set! len (+ len (floor (* srate-scale stereo-spread)))))
+ (set! (allpasses (+ (* c numallpasses) i))
+ (make-all-pass :size len :feedforward -1 :feedback 0.5)))))
+
+ (if (= out-chans in-chans 1)
+
+ (let ((amp (out-mix 0 0))
+ (pdelay (predelays 0)))
+ (set! allpasses (make-all-pass-bank allpasses))
+ (set! fcombs (make-filtered-comb-bank fcombs))
+
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (all-pass-bank allpasses
+ (filtered-comb-bank fcombs
+ (delay pdelay (ina i *reverb*))))))))
+
+ (let ((allp-c (make-vector out-chans))
+ (fcmb-c (make-vector out-chans)))
+ (do ((c 0 (+ c 1)))
+ ((= c out-chans))
+ (set! (allp-c c) (make-vector numallpasses))
+ (set! (fcmb-c c) (make-vector numcombs)))
+ (do ((c 0 (+ c 1)))
+ ((= c out-chans))
+ (do ((j 0 (+ j 1)))
+ ((= j numcombs))
+ (set! ((fcmb-c c) j) (fcombs (+ j (* c numcombs)))))
+ (do ((j 0 (+ j 1)))
+ ((= j numallpasses))
+ (set! ((allp-c c) j) (allpasses (+ j (* c numallpasses)))))
+ (set! (allp-c c) (make-all-pass-bank (allp-c c)))
+ (set! (fcmb-c c) (make-filtered-comb-bank (fcmb-c c))))
+
+
+ (if (= in-chans out-chans 5)
+ (let ((allp0 (vector-ref allp-c 0))
+ (allp1 (vector-ref allp-c 1))
+ (allp2 (vector-ref allp-c 2))
+ (allp3 (vector-ref allp-c 3))
+ (allp4 (vector-ref allp-c 4))
+ (fcmb0 (vector-ref fcmb-c 0))
+ (fcmb1 (vector-ref fcmb-c 1))
+ (fcmb2 (vector-ref fcmb-c 2))
+ (fcmb3 (vector-ref fcmb-c 3))
+ (fcmb4 (vector-ref fcmb-c 4))
+ (dly0 (vector-ref predelays 0))
+ (dly1 (vector-ref predelays 1))
+ (dly2 (vector-ref predelays 2))
+ (dly3 (vector-ref predelays 3))
+ (dly4 (vector-ref predelays 4)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (file->frample *reverb* i f-in)
+ (float-vector-set! f-out 0 (all-pass-bank allp0 (filtered-comb-bank fcmb0 (delay dly0 (float-vector-ref f-in 0)))))
+ (float-vector-set! f-out 1 (all-pass-bank allp1 (filtered-comb-bank fcmb1 (delay dly1 (float-vector-ref f-in 1)))))
+ (float-vector-set! f-out 2 (all-pass-bank allp2 (filtered-comb-bank fcmb2 (delay dly2 (float-vector-ref f-in 2)))))
+ (float-vector-set! f-out 3 (all-pass-bank allp3 (filtered-comb-bank fcmb3 (delay dly3 (float-vector-ref f-in 3)))))
+ (float-vector-set! f-out 4 (all-pass-bank allp4 (filtered-comb-bank fcmb4 (delay dly4 (float-vector-ref f-in 4)))))
+ (frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans))))
+
+ (if (> in-chans 1)
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (file->frample *reverb* i f-in)
+ (do ((c 0 (+ c 1)))
+ ((= c out-chans))
+ (float-vector-set! f-out c (all-pass-bank (vector-ref allp-c c)
+ (filtered-comb-bank (vector-ref fcmb-c c)
+ (delay (vector-ref predelays c)
+ (float-vector-ref f-in c))))))
+ (frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans)))
+
+ (let ((pdelay (predelays 0)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((val (delay pdelay (ina i *reverb*))))
+ (do ((c 0 (+ c 1)))
+ ((= c out-chans))
+ (float-vector-set! f-out c (all-pass-bank (vector-ref allp-c c)
+ (filtered-comb-bank (vector-ref fcmb-c c)
+ val))))
+ (frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans)))))))))))))
+
+;;; (with-sound (:statistics #t :reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*))
+;;; (with-sound (:channels 2 :reverb-channels 2 :statistics #t :reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*) (outb 0 .1 *reverb*))
-;; freeverb.scm ends here
diff --git a/fullmix.scm b/fullmix.scm
index a956464..78a89e1 100644
--- a/fullmix.scm
+++ b/fullmix.scm
@@ -1,8 +1,8 @@
(provide 'snd-fullmix.scm)
-(if (and (not (provided? 'snd-ws.scm))
- (not (provided? 'sndlib-ws.scm)))
- (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(definstrument (fullmix in-file beg outdur inbeg matrix srate reverb-amount)
@@ -11,57 +11,60 @@
;; each element of the list can be a number, a list (turned into an env) or an env
;;
;; "srate" can be a negative number (read in reverse), or an envelope.
- (let* ((st (seconds->samples (or beg 0.0)))
- (dur (or outdur
- (/ (- (mus-sound-duration in-file) (or inbeg 0.0))
- (or (and srate (number? srate) (abs srate)) 1.0))))
- (samps (seconds->samples dur))
- (nd (+ st samps))
- (in-chans (channels in-file))
- (inloc (floor (* (or inbeg 0.0) (mus-sound-srate in-file))))
- (out-chans (channels *output*))
- (mx (if matrix
- (make-mixer (max in-chans out-chans))
- (make-scalar-mixer (max in-chans out-chans) 1.0)))
- (rev-mx (if (and *reverb* reverb-amount (> reverb-amount 0.0))
- (let ((rmx (make-mixer in-chans)))
- (do ((i 0 (+ i 1)))
- ((= i in-chans))
- (mixer-set! rmx i 0 reverb-amount)) ; 0->assume 1 chan reverb stream, I think
- rmx)
- #f))
- (revframe (if rev-mx (make-frame 1) #f))
- (reversed (or (and (number? srate) (negative? srate))
- (and (list? srate) (negative? (cadr srate)))))
- (file (if (or (not srate)
- (and (number? srate)
- (= srate 1.0)))
- (make-file->frame in-file)
- (let ((vect (make-vector in-chans #f)))
- (do ((i 0 (+ i 1)))
- ((= i in-chans))
- (vector-set! vect i (make-readin in-file i inloc :direction (if reversed -1 1))))
- vect)))
- (envs #f)
- (srcenv (if (list? srate)
- (make-env srate :duration dur :scaler (if reversed -1.0 1.0))
- #f)))
-
- (if matrix
- (begin
- (if (list? matrix) ; matrix is list of scalers, envelopes (lists), or env gens
- (do ((inp 0 (+ 1 inp))
+ (let ((st (seconds->samples (or beg 0.0)))
+ (dur (or outdur
+ (/ (- (mus-sound-duration in-file) (or inbeg 0.0))
+ (or (and srate (number? srate) (abs srate)) 1.0))))
+ (in-chans (channels in-file))
+ (out-chans (channels *output*))
+ (reversed (or (and (number? srate) (negative? srate))
+ (and (pair? srate) (negative? (cadr srate)))))
+
+ (inloc (floor (* (or inbeg 0.0) (mus-sound-srate in-file)))))
+
+ (let ((samps (seconds->samples dur))
+ (mx (let ((ochans (max in-chans out-chans)))
+ (if matrix
+ (make-float-vector (list ochans ochans) 0.0)
+ (let ((v (make-float-vector (list ochans ochans) 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i ochans))
+ (set! (v i i) 1.0))
+ v))))
+ (rev-mx (and *reverb* reverb-amount (> reverb-amount 0.0)
+ (let ((rmx (make-float-vector (list in-chans in-chans) 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i in-chans))
+ (set! (rmx i 0) reverb-amount)) ; 0->assume 1 chan reverb stream, I think
+ rmx)))
+
+ (file (if (or (not srate)
+ (and (number? srate)
+ (= srate 1.0)))
+ (make-file->frample in-file)
+ (let ((vect (make-vector in-chans #f)))
+ (do ((i 0 (+ i 1)))
+ ((= i in-chans))
+ (vector-set! vect i (make-readin in-file i inloc :direction (if reversed -1 1))))
+ vect)))
+ (envs #f)
+ (srcenv (and (pair? srate)
+ (make-env srate :duration dur :scaler (if reversed -1.0 1.0)))))
+
+ (if matrix
+ (if (pair? matrix) ; matrix is list of scalers, envelopes (lists), or env gens
+ (do ((inp 0 (+ inp 1))
(off 0 (+ off out-chans)))
((= inp in-chans))
(let ((inlist (list-ref matrix inp)))
- (do ((outp 0 (+ 1 outp)))
+ (do ((outp 0 (+ outp 1)))
((= outp out-chans))
(let ((outn (list-ref inlist outp)))
(if outn
(if (number? outn)
- (mixer-set! mx inp outp outn)
+ (set! (mx inp outp) outn)
(if (or (env? outn)
- (list? outn))
+ (pair? outn))
(begin
(if (not envs)
(set! envs (make-vector (* in-chans out-chans) #f)))
@@ -69,94 +72,36 @@
(vector-set! envs (+ off outp) outn)
(vector-set! envs (+ off outp) (make-env outn :duration dur))))
(format #t "unknown element in matrix: ~A" outn))))))))
- (do ((inp 0 (+ 1 inp))) ; matrix is a number in this case (a global scaler)
+ (do ((inp 0 (+ inp 1))) ; matrix is a number in this case (a global scaler)
((= inp in-chans))
(if (< inp out-chans)
- (mixer-set! mx inp inp matrix))))))
-
- (if (or (not srate)
- (and (number? srate)
- (= srate 1.0)))
- (begin
- ;; -------- no src
- (mus-mix *output* file st samps inloc mx (if envs
- (let ((v (make-vector in-chans)))
- (do ((i 0 (+ i 1))
- (off 0 (+ off out-chans)))
- ((= i in-chans))
- (let ((vo (make-vector out-chans #f)))
- (vector-set! v i vo)
- (do ((j 0 (+ j 1)))
- ((= j out-chans))
- (vector-set! vo j (vector-ref envs (+ off j))))))
- v)
- envs))
- (if rev-mx
- (mus-mix *reverb* file st samps inloc rev-mx #f)))
-
- ;; -------- with src
- ;; unroll the loops if 1 chan input
- (if (= in-chans 1)
- (let ((sr (make-src :input (vector-ref file 0) :srate (if (number? srate) (abs srate) 0.0)))
- (outframe (make-frame out-chans)))
- (if envs
- (run
- (declare (envs clm-vector))
- (do ((i st (+ i 1)))
- ((= i nd))
- (do ((outp 0 (+ 1 outp)))
- ((= outp out-chans))
- (if (env? (vector-ref envs outp))
- (mixer-set! mx 0 outp (env (vector-ref envs outp)))))
- (let ((inframe (src sr (if srcenv (env srcenv) 0.0))))
- (frame->file *output* i (sample->frame mx inframe outframe))
- (if rev-mx (frame->file *reverb* i (sample->frame rev-mx inframe revframe))))))
-
- ;; no envs
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (let ((inframe (src sr (if srcenv (env srcenv) 0.0))))
- (frame->file *output* i (sample->frame mx inframe outframe))
- (if rev-mx (frame->file *reverb* i (sample->frame rev-mx inframe revframe))))))))
-
- ;; more than 1 chan input
- (let* ((inframe (make-frame in-chans))
- (outframe (make-frame out-chans))
- (srcs (make-vector in-chans #f)))
- (do ((inp 0 (+ 1 inp)))
- ((= inp in-chans))
- (vector-set! srcs inp (make-src :input (vector-ref file inp) :srate (if (number? srate) (abs srate) 0.0))))
-
- (if envs
- (run
- (declare (envs clm-vector))
- (do ((i st (+ i 1)))
- ((= i nd))
- (do ((inp 0 (+ 1 inp))
- (off 0 (+ off out-chans)))
- ((= inp in-chans))
- (do ((outp 0 (+ 1 outp)))
- ((= outp out-chans))
- (if (env? (vector-ref envs (+ off outp)))
- (mixer-set! mx inp outp (env (vector-ref envs (+ off outp)))))))
- (let ((sr-val (if srcenv (env srcenv) 0.0)))
- (do ((inp 0 (+ 1 inp)))
- ((= inp in-chans))
- (frame-set! inframe inp (src (vector-ref srcs inp) sr-val)))
- (frame->file *output* i (frame->frame inframe mx outframe))
- (if rev-mx (frame->file *reverb* i (frame->frame inframe rev-mx revframe))))))
-
- ;; no envs
- (run
- (do ((i st (+ i 1)))
- ((= i nd))
- (let ((sr-val (if srcenv (env srcenv) 0.0)))
- (do ((inp 0 (+ 1 inp)))
- ((= inp in-chans))
- (frame-set! inframe inp (src (vector-ref srcs inp) sr-val)))
- (frame->file *output* i (frame->frame inframe mx outframe))
- (if rev-mx (frame->file *reverb* i (frame->frame inframe rev-mx revframe))))))))))))
+ (set! (mx inp inp) matrix)))))
+
+ (if (or (not srate)
+ (and (number? srate)
+ (= srate 1.0)))
+ (let ((mxe (and envs
+ (let ((v (make-vector in-chans)))
+ (do ((i 0 (+ i 1))
+ (off 0 (+ off out-chans)))
+ ((= i in-chans))
+ (let ((vo (make-vector out-chans #f)))
+ (vector-set! v i vo)
+ (do ((j 0 (+ j 1)))
+ ((= j out-chans))
+ (vector-set! vo j (vector-ref envs (+ off j))))))
+ v))))
+ ;; -------- no src
+ (mus-file-mix *output* file st samps inloc mx mxe)
+ (if rev-mx
+ (mus-file-mix *reverb* file st samps inloc rev-mx)))
+
+ (let ((srcs (make-vector in-chans #f)))
+ (do ((inp 0 (+ inp 1)))
+ ((= inp in-chans))
+ (vector-set! srcs inp (make-src :input (vector-ref file inp) :srate (if (number? srate) (abs srate) 0.0))))
+ (mus-file-mix-with-envs file st samps mx rev-mx envs srcs srcenv *output* *reverb*)
+ )))))
#|
(with-sound (:channels 2 :statistics #t)
diff --git a/funcs.scm b/funcs.scm
new file mode 100644
index 0000000..77e7174
--- /dev/null
+++ b/funcs.scm
@@ -0,0 +1,47 @@
+(define-envelope pna '(0 0 1 1 10 .6000 25 .3000 100 0 ))
+(define-envelope ind2 '(0 1 25 .4000 75 .6000 100 0 ))
+(define-envelope high_att_ind '(0 1 25 .2000 75 .4000 100 0 ))
+(define-envelope no_att_ind '(0 .6000 75 .6000 100 0 ))
+(define-envelope no_dec_ind '(0 1 25 .4000 75 .6000 100 .6000 ))
+(define-envelope no_att_or_dec_ind '(0 .6000 100 .6000 ))
+(define-envelope ampf '(0 0 25 1 60 .7000 75 1 100 0 ))
+(define-envelope rampf '(0 0 100 1 ))
+(define-envelope fast_up '(0 0 25 1 100 1 ))
+(define-envelope slow_up '(0 0 25 0 100 1 ))
+(define-envelope tapf '(0 0 1 1 99 1 100 0 ))
+(define-envelope skwfrq '(0 -1 5 .2500 10 0 100 .1000 ))
+(define-envelope oldpizzf '(0 0 1 1 5 .6000 10 .3000 25 .1000 100 0 ))
+(define-envelope newpizzf '(0 0 1 1 5 .6000 10 .3000 25 .1000 99 .0200 100 0 ))
+(define-envelope pizzf '(0 0 1 1 5 .6000 10 .3000 25 .1000 100 0 ))
+(define-envelope legatof '(0 0 30 1 90 1 100 0 ))
+(define-envelope marcatof '(0 0 3 1 10 .8000 95 1 100 0 ))
+(define-envelope onef '(0 1 100 1 ))
+(define-envelope mod_up '(0 0 25 0 75 1 100 1 ))
+(define-envelope mod_down '(0 1 25 1 75 0 100 0 ))
+(define-envelope one_to_zero '(0 1 75 1 100 0 ))
+(define-envelope zero_to_one '(0 0 75 0 100 1 ))
+(define-envelope down_flat '(0 1 25 0 75 .0500 100 0 ))
+(define-envelope down_down '(0 1 25 0 75 .0500 100 -1 ))
+(define-envelope down_up '(0 1 25 0 75 .0500 100 1 ))
+(define-envelope flat_down '(0 -.1000 10 .1000 25 0 75 .0500 100 -1 ))
+(define-envelope flat_up '(0 -.1000 10 .1000 25 0 75 0 100 1 ))
+(define-envelope up_flat '(0 -1 25 .0500 75 0 100 0 ))
+(define-envelope up_up '(0 -1 25 .0500 75 0 100 1 ))
+(define-envelope up_down '(0 -1 25 .0500 75 0 100 -1 ))
+(define-envelope swellf '(0 0 25 .8000 50 1 75 .8000 100 0 ))
+(define-envelope fpf '(0 0 25 1 50 .3000 75 .3000 100 0 ))
+(define-envelope indswell '(1 1 25 .4000 75 1 100 0 ))
+(define-envelope pyr '(0 1 25 .1000 95 .1000 100 0 ))
+(define-envelope fbell '(0 1 2 1.1000 25 .7500 75 .5000 100 .2000 ))
+(define-envelope lowbell '(0 1 5 1.2500 25 .8000 75 .5000 100 .2000 ))
+(define-envelope abell '(0 0 .1000 1 10 .6000 25 .3000 50 .1500 90 .1000 100 0 ))
+(define-envelope dwnup '(0 1 10 .4000 20 1 35 .3000 45 .8000 60 .2000 80 .6000 100 0 ))
+(define-envelope up50down '(0 0 50 1 100 0 ))
+(define-envelope metalamp '(0 0 .5000 1 5 1 10 .5000 15 .2500 35 .1000 100 0 ))
+(define-envelope slowupfastdown '(0 0 25 1 97 1 100 0 ))
+(define-envelope slowup '(0 0 50 .1000 95 1 100 0 ))
+(define-envelope indtoone '(0 1 25 .4000 100 .6500 ))
+
+(define-envelope whoosh '(0 0 75 .1000 90 .3000 97 .6000 100 1 ))
+(define-envelope mamp '(0 0 50 1 100 0 ))
+(define-envelope n_amp '(0 0 65 1 100 0 ))
diff --git a/generators.scm b/generators.scm
index fb5040c..c7d23d4 100644
--- a/generators.scm
+++ b/generators.scm
@@ -1,14 +1,21 @@
(provide 'snd-generators.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+;;; it is dangerous to use a method within a generator's definition of that method --
+;;; if the gen is used as the environment in with-let, the embedded call
+;;; becomes a recursive call on that method. You either need to check the type
+;;; of the method argument, or use #_method to override the name lookup, or use
+;;; the explicit call style: (((gen 'embedded-gen) 'shared-method) ...)
-;;; these try to mimic existing gens (mainly oscil), so "frequency" is placed first.
-;;; Where a factor is involved, I'll use "r".
-;;; Where the number of terms in the sum is settable, I'll use "n".
-;;; if you actually want to set the initial-phase, it is usually "angle" just after the documented arguments
+;;; if gen has embedded gen, mus-copy needs a special copy method (see adjustable-oscil)
+;;; a problem with a special copy method: if you change the generator, remember to change its copy method!
+;;; also, I think (inlet e) is a way to copy e without accidentally invoking any 'copy method in e
-(define nearly-zero 1.0e-12) ; 1.0e-14 in clm.c, but that is trouble here (noddcos)
+(define nearly-zero 1.0e-10) ; 1.0e-14 in clm.c, but that is trouble here (noddcos)
+(define two-pi (* 2.0 pi))
;;; --------------------------------------------------------------------------------
@@ -16,72 +23,72 @@
(defgenerator (nssb
:make-wrapper (lambda (g)
- (set! (nssb-frequency g) (hz->radians (nssb-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1 :type int) (angle 0.0))
-
-
-(define* (nssb gen (fm 0.0))
- " (make-nssb frequency (ratio 1.0) (n 1)) creates an nssb generator, similar to nxysin.\n\
- (nssb gen (fm 0.0)) returns n sinusoids from frequency spaced by frequency * ratio."
- (declare (gen nssb) (fm float))
- (let* ((n (nssb-n gen))
- (cx (nssb-angle gen))
- (mx (* cx (nssb-ratio gen)))
- (den (sin (* 0.5 mx))))
-
- (set! (nssb-angle gen) (+ fm cx (nssb-frequency gen)))
-
- (if (< (abs den) nearly-zero)
- -1.0
- (/ (- (* (sin cx)
- (sin (* mx (/ (+ n 1) 2)))
- (sin (/ (* n mx) 2)))
- (* (cos cx)
- 0.5 (+ den (sin (* mx (+ n 0.5))))))
- (* (+ n 1) den)))))
-
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0) fm)
+
+
+(define nssb
+
+ (let ((documentation "(make-nssb frequency (ratio 1.0) (n 1)) creates an nssb generator,
+similar to nxysin. (nssb gen (fm 0.0)) returns n sinusoids from frequency spaced by frequency * ratio."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio))
+ (den (sin (* 0.5 mx))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ -1.0
+ (/ (- (* (sin cx)
+ (sin (* mx (/ (+ n 1) 2)))
+ (sin (/ (* n mx) 2)))
+ (* (cos cx)
+ 0.5 (+ den (sin (* mx (+ n 0.5))))))
+ (* (+ n 1) den))))))))
+
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nssb 1000.0 0.1 3)))
- (run
(do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (nssb gen))))))
+ (outa i (nssb gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nssb 1000.0 0.1 3))
(vib (make-oscil 5.0))
(ampf (make-env '(0 0 1 1 2 1 3 0) :length 20000 :scaler 1.0)))
- (run
(do ((i 0 (+ i 1)))
((= i 20000))
(outa i (* (env ampf)
(nssb gen (* (hz->radians 100.0)
- (oscil vib)))))))))
+ (oscil vib))))))))
|#
+
;;; --------------------------------------------------------------------------------
-;;; G&R 1st col rows 1&2
+;;; G&R first col rows 1&2
(define (find-nxysin-max n ratio)
-
+
(define (ns x n)
(let* ((a2 (/ x 2))
(den (sin a2)))
(if (= den 0.0)
0.0
(/ (* (sin (* n a2)) (sin (* (+ 1 n) a2))) den))))
-
+
(define (nodds x n)
- (let* ((den (sin x))
- (num (sin (* n x))))
+ (let ((den (sin x))
+ (num (sin (* n x))))
(if (= den 0.0)
0.0
(/ (* num num) den))))
-
+
(define (find-mid-max n lo hi)
(let ((mid (/ (+ lo hi) 2)))
(let ((ylo (ns lo n))
@@ -91,7 +98,7 @@
(if (> ylo yhi)
(find-mid-max n lo mid)
(find-mid-max n mid hi))))))
-
+
(define (find-nodds-mid-max n lo hi)
(let ((mid (/ (+ lo hi) 2)))
(let ((ylo (nodds lo n))
@@ -101,7 +108,7 @@
(if (> ylo yhi)
(find-nodds-mid-max n lo mid)
(find-nodds-mid-max n mid hi))))))
-
+
(if (= ratio 1)
(find-mid-max n 0.0 (/ pi (+ n .5)))
(if (= ratio 2)
@@ -111,31 +118,31 @@
(defgenerator (nxysin
:make-wrapper (lambda (g)
- (set! (nxysin-frequency g) (hz->radians (nxysin-frequency g)))
- (set! (nxysin-norm g) (/ 1.0 (find-nxysin-max (nxysin-n g) (nxysin-ratio g))))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'norm) (/ 1.0 (find-nxysin-max (g 'n) (g 'ratio))))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1 :type int) (angle 0.0)
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0) fm
(norm 1.0))
-(define* (nxysin gen (fm 0.0))
- " (make-nxysin frequency (ratio 1.0) (n 1)) creates an nxysin generator.\n\
- (nxysin gen (fm 0.0)) returns n sines from frequency spaced by frequency * ratio."
- (declare (gen nxysin) (fm float))
- (let* ((x (nxysin-angle gen))
- (y (* x (nxysin-ratio gen)))
- (n (nxysin-n gen))
- (norm (nxysin-norm gen))
- (den (sin (* y 0.5))))
+(define nxysin
- (set! (nxysin-angle gen) (+ fm x (nxysin-frequency gen)))
+ (let ((documentation "(make-nxysin frequency (ratio 1.0) (n 1)) creates an nxysin
+generator. (nxysin gen (fm 0.0)) returns n sines from frequency spaced by frequency * ratio."))
- (if (< (abs den) nearly-zero)
- 0.0
- (/ (* (sin (+ x (* 0.5 (- n 1) y)))
- (sin (* 0.5 n y))
- norm)
- den))))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio))
+ (den (sin (* y 0.5))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ 0.0
+ (/ (* (sin (+ x (* 0.5 (- n 1) y)))
+ (sin (* 0.5 n y))
+ norm)
+ den)))))))
;;; if x (angle) is constant (an initial-phase offset for a sum of sines,
;;; the peak amp is nsin-max(n) + abs(sin(initial-phase))*(1 - nsin-max(n))
@@ -159,15 +166,13 @@
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nxysin 300 1/3 3)))
- (run
(do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (nxysin gen))))))
+ (outa i (nxysin gen)))))
;;; here's the varying initial-phase case:
(with-sound (:clipped #f)
- (run
(let ((x 0.0)
(ix (/ pi 1000))
(n 100))
@@ -187,90 +192,89 @@
(if (> sum pk)
(set! pk sum)))))
(set! y (+ y iy)))
- (outa i pk))))))
+ (outa i pk)))))
|#
(defgenerator (nxycos
:make-wrapper (lambda (g)
- (set! (nxycos-frequency g) (hz->radians (nxycos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1 :type int) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0) fm)
-(define* (nxycos gen (fm 0.0))
- " (make-nxycos frequency (ratio 1.0) (n 1)) creates an nxycos generator.\n\
- (nxycos gen (fm 0.0)) returns n cosines from frequency spaced by frequency * ratio."
- (declare (gen nxycos) (fm float))
- (let* ((x (nxycos-angle gen))
- (y (* x (nxycos-ratio gen)))
- (n (nxycos-n gen))
- (den (sin (* y 0.5))))
+(define nxycos
- (set! (nxycos-angle gen) (+ x fm (nxycos-frequency gen)))
+ (let ((documentation "(make-nxycos frequency (ratio 1.0) (n 1)) creates an nxycos generator. (nxycos gen (fm 0.0))
+returns n cosines from frequency spaced by frequency * ratio."))
- (if (< (abs den) nearly-zero)
- 1.0
- (/ (* (cos (+ x (* 0.5 (- n 1) y)))
- (sin (* 0.5 n y)))
- (* n den))))) ; n=normalization
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio))
+ (den (sin (* y 0.5))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ 1.0
+ (/ (* (cos (+ x (* 0.5 (- n 1) y)))
+ (sin (* 0.5 n y)))
+ (* n den)))))))) ; n=normalization
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nxycos 300 1/3 3)))
- (run
(do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (nxycos gen))))))
+ (outa i (* .5 (nxycos gen))))))
|#
;;; --------------------------------------------------------------------------------
;;;
-;;; G&R 1st col rows 3 4
+;;; G&R first col rows 3 4
(defgenerator (nxy1cos
:make-wrapper (lambda (g)
- (set! (nxy1cos-frequency g) (hz->radians (nxy1cos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1 :type int) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0) fm)
-(define* (nxy1cos gen (fm 0.0))
- " (make-nxy1cos frequency (ratio 1.0) (n 1)) creates an nxy1cos generator.\n\
- (nxy1cos gen (fm 0.0)) returns 2n cosines from frequency spaced by frequency * ratio with every other cosine multiplied by -1."
- (declare (gen nxy1cos) (fm float))
- (let* ((x (nxy1cos-angle gen))
- (y (* x (nxy1cos-ratio gen)))
- (n (nxy1cos-n gen))
- (den (cos (* y 0.5))))
+(define nxy1cos
- (set! (nxy1cos-angle gen) (+ x fm (nxy1cos-frequency gen)))
-
- (if (< (abs den) nearly-zero)
- -1.0
- (max -1.0
- (min 1.0
- (/ (* (sin (* n y))
- (sin (+ x (* (- n 0.5) y))))
- (* 2 n den)))))))
+ (let ((documentation "(make-nxy1cos frequency (ratio 1.0) (n 1)) creates an nxy1cos
+generator. (nxy1cos gen (fm 0.0)) returns 2n cosines from frequency spaced by frequency * ratio with every other cosine multiplied by -1."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio))
+ (den (cos (* y 0.5))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ -1.0
+ (max -1.0
+ (min 1.0
+ (/ (* (sin (* n y))
+ (sin (+ x (* (- n 0.5) y))))
+ (* 2 n den))))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nxy1cos 300 1/3 3)))
- (run
- (do ((i 0 (+ i 1)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (nxy1cos gen))))))
+ (outa i (nxy1cos gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nxy1cos 300 1/3 3))
(gen1 (make-nxycos 300 1/3 6)))
- (run
(do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (* 0.4 (+ (nxycos gen1 0.0) (nxy1cos gen))))))))
+ (outa i (* 0.4 (+ (nxycos gen1 0.0) (nxy1cos gen)))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nxy1cos (radians->hz (* .01 pi)) 1.0 3)))
@@ -282,33 +286,33 @@
(defgenerator (nxy1sin
:make-wrapper (lambda (g)
- (set! (nxy1sin-frequency g) (hz->radians (nxy1sin-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1 :type int) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0) fm)
-(define* (nxy1sin gen (fm 0.0))
- " (make-nxy1sin frequency (ratio 1.0) (n 1)) creates an nxy1sin generator.\n\
- (nxy1sin gen (fm 0.0)) returns n sines from frequency spaced by frequency * ratio with every other sine multiplied by -1."
- (declare (gen nxy1sin) (fm float))
- (let* ((x (nxy1sin-angle gen))
- (y (* x (nxy1sin-ratio gen)))
- (n (nxy1sin-n gen))
- (den (cos (* y 0.5))))
+(define nxy1sin
- (set! (nxy1sin-angle gen) (+ x fm (nxy1sin-frequency gen)))
-
- (/ (* (sin (+ x (* 0.5 (- n 1) (+ y pi))))
- (sin (* 0.5 n (+ y pi))))
- (* n den))))
+ (let ((documentation "(make-nxy1sin frequency (ratio 1.0) (n 1)) creates an nxy1sin generator. (nxy1sin gen (fm 0.0))
+returns n sines from frequency spaced by frequency * ratio with every other sine multiplied by -1."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio))
+ (den (cos (* y 0.5))))
+ (set! angle (+ angle fm frequency))
+ (/ (* (sin (+ x (* 0.5 (- n 1) (+ y pi))))
+ (sin (* 0.5 n (+ y pi))))
+ (* n den)))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nxy1sin 300 1/3 3)))
- (run
(do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (nxy1sin gen))))))
+ (outa i (nxy1sin gen)))))
|#
;;; we can get the sinusoidally varying maxamp by using e.g. (make-nxy1sin 1 1000 3)
@@ -321,17 +325,17 @@
;;; n odd sinusoids: noddsin, noddcos, noddssb
-;;; sndclm.html (G&R) 1st col 5th row (sum of odd sines)
+;;; sndclm.html (G&R) first col 5th row (sum of odd sines)
(define (find-noddsin-max n)
-
+
(define (nodds x n)
- (let* ((den (sin x))
- (num (sin (* n x))))
+ (let ((den (sin x))
+ (num (sin (* n x))))
(if (= den 0.0)
0.0
(/ (* num num) den))))
-
+
(define (find-mid-max n lo hi)
(let ((mid (/ (+ lo hi) 2)))
(let ((ylo (nodds lo n))
@@ -341,35 +345,39 @@
(if (> ylo yhi)
(find-mid-max n lo mid)
(find-mid-max n mid hi))))))
-
+
(find-mid-max n 0.0 (/ pi (+ (* 2 n) 0.5))))
+(define noddsin-maxes (make-float-vector 100))
(defgenerator (noddsin
:make-wrapper (lambda (g)
- (if (< (noddsin-n g) 1) (set! (noddsin-n g) 1))
- (set! (noddsin-frequency g) (hz->radians (noddsin-frequency g)))
- (set! (noddsin-norm g) (/ 1.0 (find-noddsin-max (noddsin-n g)))) ; these could be precomputed
+ (if (< (g 'n) 1) (set! (g 'n) 1))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (if (and (< (g 'n) 100)
+ (> (noddsin-maxes (g 'n)) 0.0))
+ (set! (g 'norm) (/ 1.0 (noddsin-maxes (g 'n))))
+ (begin
+ (set! (noddsin-maxes (g 'n)) (find-noddsin-max (g 'n)))
+ (set! (g 'norm) (/ 1.0 (noddsin-maxes (g 'n))))))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0) (norm 1.0))
-
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0) (norm 1.0) fm)
-(define* (noddsin gen (fm 0.0))
- " (make-noddsin frequency (n 1)) creates an noddsin generator.\n\
- (noddsin gen (fm 0.0)) returns n odd-numbered sines spaced by frequency."
- (declare (gen noddsin) (fm float))
- (let* ((x (noddsin-angle gen))
- (n (noddsin-n gen))
- (norm (noddsin-norm gen))
- (snx (sin (* n x)))
- (den (sin x)))
- (set! (noddsin-angle gen) (+ x fm (noddsin-frequency gen)))
+(define noddsin
- (if (< (abs den) nearly-zero)
- 0.0
- (/ (* norm snx snx) den))))
-
+ (let ((documentation "(make-noddsin frequency (n 1)) creates an noddsin generator. (noddsin gen (fm 0.0))
+returns n odd-numbered sines spaced by frequency."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((snx (sin (* n angle)))
+ (den (sin angle)))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ 0.0
+ (/ (* norm snx snx) den)))))))
;;; max is at about: 3*pi/(8*n) -- essentially half of the nsin peak
;;; and we end up with the same max amp as nsin!!
@@ -382,254 +390,257 @@
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-noddsin 300 :n 3))
(ampf (make-env '(0 0 1 1 2 1 3 0) :length 40000 :scaler .5)))
- (run
(do ((i 0 (+ i 1)))
((= i 40000))
- (outa i (* (env ampf) (noddsin gen)))))))
+ (outa i (* (env ampf) (noddsin gen))))))
|#
+
(defgenerator (noddcos
:make-wrapper (lambda (g)
- (set! (noddcos-frequency g) (hz->radians (noddcos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0))
-
-
-(define* (noddcos gen (fm 0.0))
- " (make-noddcos frequency (n 1)) creates an noddcos generator.\n\
- (noddcos gen (fm 0.0)) returns n odd-numbered cosines spaced by frequency."
- (declare (gen noddcos) (fm float))
- (let* ((angle (noddcos-angle gen))
- (n (noddcos-n gen))
- (den (* 2 n (sin angle)))) ; "n" here is normalization
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0) fm)
- (set! (noddcos-angle gen) (+ angle fm (noddcos-frequency gen)))
- (if (< (abs den) nearly-zero)
- (let ((fang (modulo (abs angle) (* 2 pi))))
- ;; hopefully this almost never happens...
- (if (or (< fang 0.001)
- (< (abs (- fang (* 2 pi))) 0.001))
- 1.0
- -1.0))
- (/ (sin (* 2 n angle)) den))))
+(define noddcos
+
+ (let ((documentation "(make-noddcos frequency (n 1)) creates an noddcos generator. (noddcos gen (fm 0.0))
+returns n odd-numbered cosines spaced by frequency."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((cx angle)
+ (den (* 2 n (sin angle)))) ; "n" here is normalization
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ (let ((fang (modulo (abs cx) (* 2 pi))))
+ ;; hopefully this almost never happens...
+ (if (or (< fang 0.001)
+ (< (abs (- fang (* 2 pi))) 0.001))
+ 1.0
+ -1.0))
+ (/ (sin (* 2 n cx)) den)))))))
;;; (Gradshteyn and Ryzhik 1.342)
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-noddcos 100 :n 10)))
- (run
(do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (noddcos gen))))))
+ (outa i (* .5 (noddcos gen))))))
|#
+
(defgenerator (noddssb
:make-wrapper (lambda (g)
- (set! (noddssb-frequency g) (hz->radians (noddssb-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1 :type int) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0) fm)
-(define* (noddssb gen (fm 0.0))
- " (make-noddssb frequency (ratio 1.0) (n 1)) creates an noddssb generator.\n\
- (noddssb gen (fm 0.0)) returns n sinusoids from frequency spaced by 2 * ratio * frequency."
- (declare (gen noddssb) (fm float))
- (let* ((cx (noddssb-angle gen))
- (mx (* cx (noddssb-ratio gen)))
- (x (- cx mx))
- (n (noddssb-n gen))
- (sinnx (sin (* n mx)))
- (den (* n (sin mx)))) ; "n" is normalization
+(define noddssb
- (set! (noddssb-angle gen) (+ cx fm (noddssb-frequency gen)))
-
- (if (< (abs den) nearly-zero)
- (if (< (modulo (abs mx) (* 2 pi)) .1)
- -1.0
- 1.0)
-
- (- (* (sin x)
- (/ (* sinnx sinnx) den))
- (* (cos x)
- (/ (sin (* 2 n mx))
- (* 2 den)))))))
+ (let ((documentation "(make-noddssb frequency (ratio 1.0) (n 1)) creates an noddssb generator. (noddssb gen (fm 0.0))
+returns n sinusoids from frequency spaced by 2 * ratio * frequency."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio))
+ (x (- cx mx))
+ (sinnx (sin (* n mx)))
+ (den (* n (sin mx)))) ; "n" is normalization
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ (if (< (modulo (abs mx) (* 2 pi)) .1)
+ -1.0
+ 1.0)
+ (- (* (sin x)
+ (/ (* sinnx sinnx) den))
+ (* (cos x)
+ (/ (sin (* 2 n mx))
+ (* 2 den))))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-noddssb 1000.0 0.1 5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (noddssb gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (noddssb gen))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-noddssb 1000.0 0.1 5))
(vib (make-oscil 5.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (noddssb gen (* (hz->radians 100.0) (oscil vib))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (noddssb gen (* (hz->radians 100.0) (oscil vib))))))))
|#
+
;;; --------------------------------------------------------------------------------
;;;
;;; various kernels: ncos2 = ncos squared (Fejer), ncos4 = ncos2 squared (Jackson), npcos = Poussin kernel
(defgenerator (ncos2
:make-wrapper (lambda (g)
- (set! (ncos2-frequency g) (hz->radians (ncos2-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0) fm)
-(define* (ncos2 gen (fm 0.0))
- " (make-ncos2 frequency (n 1)) creates an ncos2 (Fejer kernel) generator.\n\
- (ncos2 gen (fm 0.0)) returns n sinusoids spaced by frequency scaled by (n-k)/(n+1)"
- (declare (gen ncos2) (fm float))
- ;; from "Trigonometric Series" Zygmund p88 with changes suggested by Katznelson "Introduction to Harmonic Analysis" p12, and
- ;; scaling by an extra factor of 1/n+1 to make sure we always peak at 1.0 (I assume callers in this context are interested
- ;; in the pulse-train aspect and want easily predictable peak amp). Harmonics go as (n-i)/n+1.
+(define ncos2
- (let* ((x (ncos2-angle gen))
- (n (ncos2-n gen))
- (den (sin (* 0.5 x))))
-
- (set! (ncos2-angle gen) (+ x fm (ncos2-frequency gen)))
-
- (if (< (abs den) nearly-zero)
- 1.0
- (let ((val (/ (sin (* 0.5 (+ n 1) x))
- (* (+ n 1) den))))
- (* val val)))))
+ (let ((documentation "(make-ncos2 frequency (n 1)) creates an ncos2 (Fejer kernel) generator. (ncos2 gen (fm 0.0))
+returns n sinusoids spaced by frequency scaled by (n-k)/(n+1)"))
+
+ ;; from "Trigonometric Series" Zygmund p88 with changes suggested by Katznelson "Introduction to Harmonic Analysis" p12, and
+ ;; scaling by an extra factor of 1/n+1 to make sure we always peak at 1.0 (I assume callers in this context are interested
+ ;; in the pulse-train aspect and want easily predictable peak amp). Harmonics go as (n-i)/n+1.
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (den (sin (* 0.5 x))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ 1.0
+ (let ((val (/ (sin (* 0.5 (+ n 1) x))
+ (* (+ n 1) den))))
+ (* val val))))))))
;;; can't use two oscils here because the angles have to line up perfectly
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-ncos2 100.0 :n 10)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (ncos2 gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (* .5 (ncos2 gen))))))
|#
+
(define make-ncos4 make-ncos2)
-(define* (ncos4 gen (fm 0.0))
- " (make-ncos4 frequency (n 1)) creates an ncos4 (Jackson kernel) generator.\n\
- (ncos4 gen (fm 0.0)) returns n sinusoids spaced by frequency scaled by ((n-k)/(n+1))^2"
- ;; Katznelson p16
- (declare (gen ncos2) (fm float))
- (let ((val (ncos2 gen fm)))
- (* val val))) ; we already normalized this to 1.0
+;; Katznelson p16
+(define ncos4
+
+ (let ((documentation "(make-ncos4 frequency (n 1)) creates an ncos4 (Jackson kernel) generator. (ncos4 gen (fm 0.0))
+returns n sinusoids spaced by frequency scaled by ((n-k)/(n+1))^2"))
+
+ (lambda* (gen (fm 0.0))
+ (let ((val (ncos2 gen fm)))
+ (* val val))))) ; we already normalized this to 1.0
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-ncos4 100.0 :n 10)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (ncos4 gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (* .5 (ncos4 gen))))))
|#
+
(defgenerator (npcos
:make-wrapper (lambda (g)
- (set! (npcos-frequency g) (hz->radians (npcos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0))
-
-
-(define* (npcos gen (fm 0.0))
- " (make-npcos frequency (n 1)) creates an npcos (Poussin kernel) generator.\n\
- (npcos gen (fm 0.0)) returns n*2+1 sinusoids spaced by frequency with amplitudes in a sort of tent shape."
- (declare (gen npcos) (fm float))
- (let* ((angle (npcos-angle gen))
- (den (sin (* 0.5 angle)))
- (n (npcos-n gen))
- (result (if (< (abs den) nearly-zero)
- 1.0
- (let* ((n1 (+ n 1))
- (result1
- (let ((val (/ (sin (* 0.5 n1 angle))
- (* n1 den))))
- (* val val)))
- (p2n2 (+ (* 2 n) 2))
- (result2
- (let ((val (/ (sin (* 0.5 p2n2 angle))
- (* p2n2 den))))
- (* val val))))
- (- (* 2 result2) result1)))))
- (set! (npcos-angle gen) (+ fm angle (npcos-frequency gen)))
- result))
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0) fm)
+
+
+(define npcos
+
+ (let ((documentation "(make-npcos frequency (n 1)) creates an npcos (Poussin kernel) generator. (npcos gen (fm 0.0))
+returns n*2+1 sinusoids spaced by frequency with amplitudes in a sort of tent shape."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((den (sin (* 0.5 angle)))
+ (result (if (< (abs den) nearly-zero)
+ 1.0
+ (let* ((n1 (+ n 1))
+ (result1
+ (let ((val (/ (sin (* 0.5 n1 angle))
+ (* n1 den))))
+ (* val val)))
+ (p2n2 (+ (* 2 n) 2))
+ (result2
+ (let ((val (/ (sin (* 0.5 p2n2 angle))
+ (* p2n2 den))))
+ (* val val))))
+ (- (* 2 result2) result1)))))
+ (set! angle (+ angle fm frequency))
+ result)))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-npcos 100.0 :n 10)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (npcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (* .5 (npcos gen))))))
|#
#|
+
;;; ncos5 and nsin5 are minor variants of nsin and ncos -- the last component is at half amplitude
(defgenerator (ncos5
:make-wrapper (lambda (g)
- (set! (ncos5-frequency g) (hz->radians (ncos5-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0))
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0) fm)
-(define* (ncos5 gen (fm 0.0))
- " (make-ncos5 frequency (n 1)) creates an ncos5 generator.\n\
- (ncos5 gen (fm 0.0)) returns n cosines spaced by frequency. All are equal amplitude except the first and last at half amp."
- (declare (gen ncos5) (fm float))
+(define ncos5
- ;; from "Chebyshev Polynomials", Mason and Handscomb, p87
-
- (let* ((x (ncos5-angle gen))
- (n (ncos5-n gen))
- (den (tan (* 0.5 x))))
-
- (set! (ncos5-angle gen) (+ x fm (ncos5-frequency gen)))
-
- (if (< (abs den) nearly-zero)
- 1.0
- (/ (- (/ (sin (* n x))
- (* 2 den))
- 0.5)
- (- n 0.5)))))
+ (let ((documentation "(make-ncos5 frequency (n 1)) creates an ncos5 generator. (ncos5 gen (fm 0.0))
+returns n cosines spaced by frequency. All are equal amplitude except the first and last at half amp."))
+
+ ;; from "Chebyshev Polynomials", Mason and Handscomb, p87
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (den (tan (* 0.5 x))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ 1.0
+ (/ (- (/ (sin (* n x))
+ (* 2 den))
+ 0.5)
+ (- n 0.5))))))))
(with-sound (:clipped #f :statistics #t)
(let ((gen (make-ncos5 100.0 :n 10)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (ncos5 gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (* .5 (ncos5 gen))))))
(define (find-nsin5-max n)
-
+
(define (ns x n)
(let* ((den (tan (* 0.5 x))))
(if (< (abs den) nearly-zero)
0.0
(/ (- 1.0 (cos (* n x)))
den))))
-
+
(define (find-mid-max n lo hi)
(let ((mid (/ (+ lo hi) 2)))
(let ((ylo (ns lo n))
@@ -639,48 +650,47 @@
(if (> ylo yhi)
(find-mid-max n lo mid)
(find-mid-max n mid hi))))))
-
+
(find-mid-max n 0.0 (/ pi (+ n .5))))
(defgenerator (nsin5
:make-wrapper (lambda (g)
- (set! (nsin5-frequency g) (hz->radians (nsin5-frequency g)))
- (set! (nsin5-n g) (max 2 (nsin5-n g)))
- (set! (nsin5-norm g) (find-nsin5-max (nsin5-n g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'n) (max 2 (g 'n)))
+ (set! (g 'norm) (find-nsin5-max (g 'n)))
g))
- (frequency *clm-default-frequency*) (n 2 :type int) (angle 0.0) (norm 1.0))
-
+ (frequency *clm-default-frequency*) (n 2) (angle 0.0) (norm 1.0) fm)
-(define* (nsin5 gen (fm 0.0))
- " (make-nsin5 frequency (n 1)) creates an nsin5 generator.\n\
- (nsin5 gen (fm 0.0)) returns n sines spaced by frequency. All are equal amplitude except last at half amp."
- (declare (gen nsin5) (fm float))
-
- ;; from "Chebyshev Polynomials", Mason and Handscomb, p100
-
- (let* ((x (nsin5-angle gen))
- (n (nsin5-n gen))
- (norm (nsin5-norm gen))
- (den (tan (* 0.5 x))))
- (set! (nsin5-angle gen) (+ x fm (nsin5-frequency gen)))
-
- (if (< (abs den) nearly-zero)
- 0.0
- (/ (- 1.0 (cos (* n x)))
- (* den norm)))))
+(define nsin5
+ (let ((documentation "(make-nsin5 frequency (n 1)) creates an nsin5 generator. (nsin5 gen (fm 0.0))
+returns n sines spaced by frequency. All are equal amplitude except last at half amp."))
+
+ ;; from "Chebyshev Polynomials", Mason and Handscomb, p100
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (den (tan (* 0.5 x))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ 0.0
+ (/ (- 1.0 (cos (* n x)))
+ (* den norm))))))))
+
(define (find-nsin-max n)
-
+
(define (ns x n)
(let* ((a2 (/ x 2))
(den (sin a2)))
(if (= den 0.0)
0.0
(/ (* (sin (* n a2)) (sin (* (+ 1 n) a2))) den))))
-
+
(define (find-mid-max n lo hi)
(let ((mid (/ (+ lo hi) 2)))
(let ((ylo (ns lo n))
@@ -690,32 +700,29 @@
(if (> ylo yhi)
(find-mid-max n lo mid)
(find-mid-max n mid hi))))))
-
+
(find-mid-max n 0.0 (/ pi (+ n .5))))
(with-sound (:clipped #f :statistics #t)
(let ((gen (make-nsin5 100.0 :n 10)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (nsin5 gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (nsin5 gen)))))
(let ((norms (list 1.0 0.0)))
(do ((i 2 (+ i 1)))
((= i 40))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nsin5 100.0 :n i)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (nsin5 gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (nsin5 gen))))))
(snd (find-sound res)))
(format #t ";~D: ~A" i (maxamp snd 0))
(set! norms (cons (maxamp snd 0) norms))))
(reverse norms))
-
;;; from the same book p 110 is atan(x)/x, if x=cos we get:
(with-sound (:clipped #f :statistics #t)
@@ -733,15 +740,15 @@
(do ((s 1 (+ s 2)))
((>= s 100))
(set! sum (+ sum (* 4 (/ (expt (- (sqrt 2.0) 1.0) (+ (* 2 s) 1))
- (+ (* 2 s) 1))))))
+ (+ (* 2 s) 1))))))
sum) ; ~ 0.096
;;; the evens cancel, each of the odds gets through once
-
|#
+
(define generator-max-r 0.999999)
(define generator-min-r -0.999999)
(define (generator-clamp-r r)
@@ -752,120 +759,166 @@
;;;
;;; n sinusoids scaled by r: nrsin, nrcos, nrssb
+#|
+(define nrsin-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'gen)))
+ (lambda (g val) (set! (mus-frequency (g 'gen)) val))))
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (mus-scaler (g 'gen)))
+ (lambda (g val) (set! (mus-scaler (g 'gen)) val))))))
+
(defgenerator (nrsin
:make-wrapper (lambda (g)
- (set! (nrsin-r g) (generator-clamp-r (nrsin-r g)))
- (set! (nrsin-gen g) (make-nrxysin (nrsin-frequency g) 1.0 (nrsin-n g) (nrsin-r g)))
+ (set! (g 'r) (generator-clamp-r (g 'r)))
+ (set! (g 'gen) (make-nrxysin (g 'frequency) 1.0 (g 'n) (g 'r)))
g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (nrsin-gen g)))
- (lambda (g val) (set! (mus-frequency (nrsin-gen g)) val)))
- (list 'mus-scaler
- (lambda (g) (mus-scaler (nrsin-gen g)))
- (lambda (g val) (set! (mus-scaler (nrsin-gen g)) val)))))
- (frequency *clm-default-frequency*) (n 1 :type int) (r 0.5)
- (gen #f :type clm))
-
-
-(define* (nrsin gen (fm 0.0))
- " (make-nrsin frequency (n 1) (r 0.5)) creates an nrsin generator.\n\
- (nrsin gen (fm 0.0)) returns n sines spaced by frequency with amplitudes scaled by r^k."
- (declare (gen nrsin) (fm float))
- (nrxysin (nrsin-gen gen) fm))
+ :methods nrsin-methods)
+ (frequency *clm-default-frequency*) (n 1) (r 0.5)
+ (gen #f))
+|#
+
+(define make-nrsin make-nrxysin)
+(define nrsin nrxysin)
+(define nrsin? nrxysin?)
+
+;; "(make-nrsin frequency (n 1) (r 0.5)) creates an nrsin generator.\n\
+;; (nrsin gen (fm 0.0)) returns n sines spaced by frequency with amplitudes scaled by r^k."
+
+
+(define (nrcos-set-scaler g val)
+ (set! (g 'r) (min 0.999999 (max -0.999999 val)))
+ (with-let g
+ (let ((absr (abs r)))
+ (set! rr (* r r))
+ (set! r1 (+ 1.0 rr))
+ (set! norm (- (/ (- (expt absr n) 1) (- absr 1)) 1.0))
+ (set! trouble (or (= n 1)
+ (< absr 1.0e-12)))))
+ val)
+
+(define nrcos-methods
+ (list
+ (cons 'mus-order
+ (dilambda
+ (lambda (g) (- (g 'n) 1))
+ (lambda (g val)
+ (set! (g 'n) (+ 1 val))
+ (set! (g 'e1) (expt (g 'r) (g 'n)))
+ (set! (g 'e2) (expt (g 'r) (+ (g 'n) 1)))
+ (set! (g 'norm) (- (/ (- (expt (abs (g 'r)) (g 'n)) 1) (- (abs (g 'r)) 1)) 1.0))
+ (set! (g 'trouble) (or (= (g 'n) 1) (< (abs (g 'r)) nearly-zero)))
+ val)))
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (radians->hz (g 'frequency)))
+ (lambda (g val) (set! (g 'frequency) (hz->radians val)))))
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ nrcos-set-scaler))))
(defgenerator (nrcos
:make-wrapper (lambda (g)
- (set! (nrcos-frequency g) (hz->radians (nrcos-frequency g)))
- (set! (nrcos-n g) (+ 1 (nrcos-n g)))
- (set! (nrcos-r g) (generator-clamp-r (nrcos-r g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'n) (+ 1 (g 'n)))
+ (set! (g 'r) (generator-clamp-r (g 'r)))
+ (set! (g 'rr) (* (g 'r) (g 'r)))
+ (set! (g 'r1) (+ 1.0 (g 'rr)))
+ (set! (g 'e1) (expt (g 'r) (g 'n)))
+ (set! (g 'e2) (expt (g 'r) (+ (g 'n) 1)))
+ (set! (g 'norm) (- (/ (- (expt (abs (g 'r)) (g 'n)) 1) (- (abs (g 'r)) 1)) 1.0)) ; n+1??
+ (set! (g 'trouble) (or (= (g 'n) 1) (< (abs (g 'r)) nearly-zero)))
g)
- :methods (list
- (list 'mus-order
- (lambda (g) (- (nrcos-n g) 1))
- (lambda (g val) (set! (nrcos-n g) (+ 1 val)) val))
- (list 'mus-scaler
- (lambda (g) (nrcos-r g))
- (lambda (g val)
- (set! (nrcos-r g) (generator-clamp-r val))
- (nrcos-r g)))))
- (frequency *clm-default-frequency*) (n 1 :type int) (r 0.5) (angle 0.0))
-
-
-(define* (nrcos gen (fm 0.0))
- " (make-nrcos frequency (n 1) (r 0.5)) creates an nrcos generator.\n\
- (nrcos gen (fm 0.0)) returns n cosines spaced by frequency with amplitudes scaled by r^k."
- (declare (gen nrcos) (fm float))
- (let* ((x (nrcos-angle gen))
- (r (nrcos-r gen))
- (n (nrcos-n gen)))
-
- (set! (nrcos-angle gen) (+ fm x (nrcos-frequency gen)))
-
- (if (or (= n 1)
- (< (abs r) nearly-zero))
- 0.0
- (let* ((norm (- (/ (- (expt (abs r) n) 1) (- (abs r) 1)) 1.0))) ; n+1??
-
- (/ (+ (- (* r (cos x))
- (* (expt r n) (cos (* n x))) (* r r))
- (* (expt r (+ n 1)) (cos (* (- n 1) x))))
- (* norm (+ 1.0 (* -2.0 r (cos x)) (* r r))))))))
+ :methods nrcos-methods)
+ (frequency *clm-default-frequency*) (n 1) (r 0.5) (angle 0.0) fm rr r1 e1 e2 norm trouble)
+
+
+(define nrcos
+
+ (let ((documentation "(make-nrcos frequency (n 1) (r 0.5)) creates an nrcos generator. (nrcos gen (fm 0.0))
+returns n cosines spaced by frequency with amplitudes scaled by r^k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle)
+ (rcos (* r (cos angle))))
+ (set! angle (+ angle fm frequency))
+ (if trouble
+ 0.0
+ (/ (+ (- rcos (* e1 (cos (* n x))) rr)
+ (* e2 (cos (* (- n 1) x))))
+ (* norm (+ r1 (* -2.0 rcos))))))))))
+
+;; it's faster to use polywave here and nrcos->polywave for the partials list (animals.scm) if n is not enormous
;;; formula changed to start at k=1 and n increased so we get 1 to n
+;;; here is the preoptimization form:
+#|
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (if (or (= n 1)
+ (< (abs r) nearly-zero))
+ 0.0
+ (let ((norm (- (/ (- (expt (abs r) n) 1) (- (abs r) 1)) 1.0))) ; n+1??
+ (/ (+ (- (* r (cos x))
+ (* (expt r n) (cos (* n x))) (* r r))
+ (* (expt r (+ n 1)) (cos (* (- n 1) x))))
+ (* norm (+ 1.0 (* -2.0 r (cos x)) (* r r))))))))
+|#
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nrcos 400.0 :n 5 :r 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nrcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (nrcos gen))))))
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .1)
(let ((gen (make-nrcos 1200.0 :n 3 :r 0.99))
(mod (make-oscil 400.0)) ; multi-carrier fm
(index 0.01))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (nrcos gen (* index (oscil mod))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (nrcos gen (* index (oscil mod)))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nrcos 2000.0 :n 3 :r 0.5))
(mod (make-oscil 400.0)) ; multi-carrier fm
(index 0.02))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (nrcos gen (* index (oscil mod))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (* .5 (nrcos gen (* index (oscil mod))))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nrcos 2000.0 :n 3 :r 0.5))
(mod (make-oscil 400.0))
(index (make-env '(0 0 1 .1) :length 30000))) ; or '(0 .4 1 0)
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (nrcos gen (* (env index) (oscil mod))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (* .5 (nrcos gen (* (env index) (oscil mod))))))))
|#
(definstrument (lutish beg dur freq amp)
- (let* ((res1 (max 1 (round (/ 1000.0 (max 1.0 (min 1000.0 freq))))))
- (gen (make-nrcos (* freq res1) :n (max 1 (- res1 2))))
- (mod (make-oscil freq))
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (maxind (max .01 (min .3 (/ (- (log freq) 3.5) 8.0))))
- (index (make-env (list 0 maxind 1 (* maxind .25) (max dur 2.0) 0.0) :duration dur))
- (amplitude (make-env (list 0 0 .01 1 .2 1 .5 .5 1 .25 (max dur 2.0) 0.0) :duration dur :scaler amp)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((ind (env index)))
- (set! (nrcos-r gen) ind)
- (outa i (* (env amplitude)
- (nrcos gen (* ind (oscil mod))))))))))
+ (let ((res1 (max 1 (round (/ 1000.0 (max 1.0 (min 1000.0 freq))))))
+ (maxind (max .01 (min .3 (/ (- (log freq) 3.5) 8.0)))))
+ (let ((gen (make-nrcos (* freq res1) :n (max 1 (- res1 2))))
+ (mod (make-oscil freq))
+ (start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (index (make-env (list 0 maxind 1 (* maxind .25) (max dur 2.0) 0.0) :duration dur))
+ (amplitude (make-env (list 0 0 .01 1 .2 1 .5 .5 1 .25 (max dur 2.0) 0.0) :duration dur :scaler amp)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((ind (env index)))
+ (set! (gen 'r) ind)
+ (outa i (* (env amplitude)
+ (nrcos gen (* ind (oscil mod))))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
@@ -878,262 +931,266 @@
|#
-;;; G&R 2nd col 1st and 2nd rows
+
+;;; G&R second col first and second rows
(defgenerator (nrssb
:make-wrapper (lambda (g)
- (set! (nrssb-frequency g) (hz->radians (nrssb-frequency g)))
- (set! (nrssb-r g) (generator-clamp-r (nrssb-r g)))
- (if (< (nrssb-r g) 0.0)
- (set! (nrssb-r g) 0.0))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'r) (generator-clamp-r (g 'r)))
+ (if (< (g 'r) 0.0)
+ (set! (g 'r) 0.0))
+ (set! (g 'rn) (- (expt (g 'r) (g 'n))))
+ (set! (g 'rn1) (expt (g 'r) (+ (g 'n) 1)))
+ (set! (g 'norm) (/ (- (g 'rn) 1) (- (g 'r) 1)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1 :type int) (r 0.5) (angle 0.0))
-
-
-(define* (nrssb gen (fm 0.0))
- " (make-nrssb frequency (ratio 1.0) (n 1) (r 0.5)) creates an nrssb generator.\n\
- (nrssb gen (fm 0.0)) returns n sinusoids from frequency spaced by frequency * ratio with amplitudes scaled by r^k."
- (declare (gen nrssb) (fm float))
- (let* ((cx (nrssb-angle gen))
- (mx (* cx (nrssb-ratio gen)))
- (r (nrssb-r gen))
- (n (nrssb-n gen))
- (rn (- (expt r n)))
- (rn1 (expt r (+ n 1)))
- (nmx (* n mx))
- (n1mx (* (- n 1) mx))
- (norm (/ (- rn 1) (- r 1)))
- (den (* norm (+ 1.0 (* -2.0 r (cos mx)) (* r r)))))
-
- (set! (nrssb-angle gen) (+ cx fm (nrssb-frequency gen)))
-
- (/ (- (* (sin cx)
- (+ (* r (sin mx))
- (* rn (sin nmx))
- (* rn1 (sin n1mx))))
- (* (cos cx)
- (+ 1.0
- (* -1.0 r (cos mx))
- (* rn (cos nmx))
- (* rn1 (cos n1mx)))))
- den)))
-
-(define (nrssb-interp gen fm interp)
- " (make-nrssb frequency (ratio 1.0) (n 1) (r 0.5)) creates an nrssb generator for use with nrssb-interp.\n\
- (nrssb-interp gen fm interp) returns n sinusoids from frequency spaced by frequency * ratio with amplitudes scaled by r^k.\
- The 'interp' argument determines whether the sidebands are above (1.0) or below (-1.0) frequency."
- (declare (gen nrssb) (fm float))
- (let* ((cx (nrssb-angle gen))
- (mx (* cx (nrssb-ratio gen)))
- (r (nrssb-r gen))
- (n (nrssb-n gen))
- (rn (- (expt r n)))
- (rn1 (expt r (+ n 1)))
- (nmx (* n mx))
- (n1mx (* (- n 1) mx))
- (norm (/ (- rn 1) (- r 1)))
- (den (* norm (+ 1.0 (* -2.0 r (cos mx)) (* r r)))))
-
- (set! (nrssb-angle gen) (+ cx fm (nrssb-frequency gen)))
-
- (/ (- (* interp
- (sin cx)
- (+ (* r (sin mx))
- (* rn (sin nmx))
- (* rn1 (sin n1mx))))
- (* (cos cx)
- (+ 1.0
- (* -1.0 r (cos mx))
- (* rn (cos nmx))
- (* rn1 (cos n1mx)))))
- den)))
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r 0.5) (angle 0.0) fm interp rn rn1 norm)
+
+
+(define nrssb
+
+ (let ((documentation "(make-nrssb frequency (ratio 1.0) (n 1) (r 0.5)) creates an nrssb generator. (nrssb gen (fm 0.0))
+returns n sinusoids from frequency spaced by frequency * ratio with amplitudes scaled by r^k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio)))
+ (let ((nmx (* n mx))
+ (n1mx (* (- n 1) mx))
+ (den (* norm (+ 1.0 (* -2.0 r (cos mx)) (* r r)))))
+ (set! angle (+ angle fm frequency))
+ (/ (- (* (sin cx)
+ (+ (* r (sin mx))
+ (* rn (sin nmx))
+ (* rn1 (sin n1mx))))
+ (* (cos cx)
+ (+ 1.0
+ (* -1.0 r (cos mx))
+ (* rn (cos nmx))
+ (* rn1 (cos n1mx)))))
+ den)))))))
+
+
+(define nrssb-interp
+
+ (let ((documentation "(make-nrssb frequency (ratio 1.0) (n 1) (r 0.5)) creates an nrssb generator for use with
+nrssb-interp. (nrssb-interp gen fm interp) returns n sinusoids from frequency spaced by frequency * ratio with amplitudes
+scaled by r^k. The 'interp' argument determines whether the sidebands are above (1.0) or below (-1.0) frequency."))
+
+ (lambda (gen fm interp)
+ (let-set! gen 'fm fm)
+ (let-set! gen 'interp interp)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio)))
+ (let ((nmx (* n mx))
+ (n1mx (* (- n 1) mx))
+ (den (* norm (+ 1.0 (* -2.0 r (cos mx)) (* r r)))))
+ (set! angle (+ angle fm frequency))
+ (/ (- (* interp
+ (sin cx)
+ (+ (* r (sin mx))
+ (* rn (sin nmx))
+ (* rn1 (sin n1mx))))
+ (* (cos cx)
+ (+ 1.0
+ (* -1.0 r (cos mx))
+ (* rn (cos nmx))
+ (* rn1 (cos n1mx)))))
+ den)))))))
+
-
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nrssb 1000 0.1 5 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nrssb gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (nrssb gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nrssb 1000 0.1 5 0.5))
(vib (make-oscil 5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nrssb gen (* (hz->radians 100) (oscil vib))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (nrssb gen (* (hz->radians 100) (oscil vib)))))))
|#
(definstrument (oboish beg dur freq amp aenv)
- (let* ((res1 (max 1 (round (/ 1400.0 (max 1.0 (min 1400.0 freq))))))
- (gen (make-nrssb (* freq res1) (/ 1 res1) :n res1 :r 0.75))
- (mod (make-oscil 5.0))
+ (let ((res1 (max 1 (round (/ 1400.0 (max 1.0 (min 1400.0 freq))))))
+ (mod1 (make-oscil 5.0))
(res2 (max 1 (round (/ 2400.0 (max 1.0 (min 2400.0 freq))))))
- (gen2 (make-oscil (* freq res2)))
(gen3 (make-oscil freq))
(start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
(amplitude (make-env aenv :duration dur :base 4 :scaler amp))
(skenv (make-env (list 0.0 0.0 1 1 2.0 (mus-random 1.0) 3.0 0.0 (max 4.0 (* dur 20.0)) 0.0)
:duration dur :scaler (hz->radians (random (* freq .05)))))
(relamp (+ .85 (random .1)))
- (avib (make-rand-interp 5 .2)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((vol (* (+ .8 (rand-interp avib))
- (env amplitude)))
- (vib (+ (* (hz->radians (* freq 0.003))
- (oscil mod))
- (env skenv)))
- (vola (* 0.05 (/ vol amp)))
- (result (* vol
- (+ (* (- relamp vola)
- (nrssb-interp gen (* res1 vib) -1.0))
- (* (+ (- 1.0 relamp) vola)
- (oscil gen2 (+ (* vib res2)
- (* (hz->radians freq)
- (oscil gen3 vib)))))))))
- (outa i result)
- (if *reverb* (outa i (* .01 result) *reverb*)))))))
+ (avib (make-rand-interp 5 .2))
+ (hfreq (hz->radians freq))
+ (h3freq (hz->radians (* .003 freq)))
+ (scl (/ 0.05 amp)))
+ (let ((gen (make-nrssb (* freq res1) (/ res1) :n res1 :r 0.75))
+ (gen2 (make-oscil (* freq res2)))
+ (stop (+ start (seconds->samples dur))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let* ((vol (* (+ .8 (rand-interp avib))
+ (env amplitude)))
+ (vib (+ (* h3freq (oscil mod1))
+ (env skenv)))
+ (vola (* scl vol))
+ (result (* vol
+ (+ (* (- relamp vola)
+ (nrssb-interp gen (* res1 vib) -1.0))
+ (* (+ (- 1.0 relamp) vola)
+ (oscil gen2 (+ (* vib res2)
+ (* hfreq (oscil gen3 vib)))))))))
+ (outa i result)
+ (if *reverb* (outa i (* .01 result) *reverb*)))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
- (oboish 0 1 300 .1 '(0 0 1 1 2 0)))
+ (oboish 0 1 300 .1 '(0 0 1 1 2 0)))
(with-sound (:clipped #f :statistics #t :play #t)
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (oboish (* i .3) .4 (+ 100 (* 50 i)) .05 '(0 0 1 1 2 1 3 0))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (oboish (* i .3) .4 (+ 100 (* 50 i)) .05 '(0 0 1 1 2 1 3 0))))
(with-sound (:clipped #f :statistics #t :play #t)
- (let ((rats (vector 1 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2))
- (mode (vector 0 0 2 4 11 11 5 6 7 9 2 12 0)))
+ (let ((rats (vector 1 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2))
+ (mode (vector 0 0 2 4 11 11 5 6 7 9 2 12 0)))
(do ((i 0 (+ i 1)))
((= i 20))
(oboish (/ (random 32) 8)
- (/ (+ 3 (random 8)) 8)
- (* 16.351 16 (rats (mode (random 12))))
- (+ .25 (random .25))
- (let* ((pt1 (random 1.0))
- (pt2 (+ pt1 (random 1.0)))
- (pt3 (+ pt2 (random 1.0))))
- (list 0 0 pt1 1 pt2 .5 pt3 0))))))
+ (/ (+ 3 (random 8)) 8)
+ (* 16.351 16 (rats (mode (random 12))))
+ (+ .25 (random .25))
+ (let* ((pt1 (random 1.0))
+ (pt2 (+ pt1 (random 1.0)))
+ (pt3 (+ pt2 (random 1.0))))
+ (list 0 0 pt1 1 pt2 .5 pt3 0))))))
;;; .85 .15 (* 2 freq) 300, 2400 + 0.5*vib
|#
+
+
;;; --------------------------------------------------------------------------------
;;;
;;; n sinusoids scaled by k: nkssb
-;;; G&R 1st col ksinkx cases
+;;; G&R first col ksinkx cases
+
+(define nkssb-methods
+ (list
+ (cons 'mus-order
+ (dilambda
+ (lambda (g) (- (g 'n) 1))
+ (lambda (g val)
+ (set! (g 'n) (+ 1 val))
+ (set! (g 'norm) (/ (* 0.5 val (- val 1))))))))) ; nominal n is off by 1
(defgenerator (nkssb
:make-wrapper (lambda (g)
- (set! (nkssb-frequency g) (hz->radians (nkssb-frequency g)))
- (set! (nkssb-n g) (+ 1 (nkssb-n g))) ; sum goes 1 to n-1
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'n) (+ 1 (g 'n))) ; sum goes 1 to n-1
+ (set! (g 'norm) (/ (* 0.5 (g 'n) (- (g 'n) 1))))
g)
- :methods (list
- (list 'mus-order
- (lambda (g) (- (nkssb-n g) 1))
- (lambda (g val) (set! (nkssb-n g) (+ 1 val)) val))))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1 :type int) (angle 0.0))
-
-
-(define* (nkssb gen (fm 0.0))
- " (make-nkssb frequency (ratio 1.0) (n 1)) creates an nkssb generator.\n\
- (nkssb gen (fm 0.0)) returns n sinusoids from frequency spaced by frequency * ratio with amplitude k."
- (declare (gen nkssb) (fm float))
- (let* ((n (nkssb-n gen))
- (cx (nkssb-angle gen))
- (x (* cx (nkssb-ratio gen)))
- (cxx (- cx x))
- (sx2 (sin (* 0.5 x)))
- (sx22 (* 2 sx2))
- (sxsx (* 4 sx2 sx2))
- (nx (* n x))
- (nx2 (* 0.5 (- (* 2 n) 1) x)))
-
- (set! (nkssb-angle gen) (+ cx fm (nkssb-frequency gen)))
-
- (if (< (abs sx2) 1.0e-8)
- -1.0
- (let* ((s1 (- (/ (sin nx) sxsx)
- (/ (* n (cos nx2)) sx22)))
- (c1 (- (/ (* n (sin nx2)) sx22)
- (/ (- 1.0 (cos nx)) sxsx))))
- (/ (- (* (sin cxx) s1)
- (* (cos cxx) c1))
- (* 0.5 n (- n 1))))))) ; normalization, nominal n is off by 1
-
+ :methods nkssb-methods)
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0) fm interp norm)
-(define (nkssb-interp gen fm interp)
- " (make-nkssb frequency (ratio 1.0) (n 1)) creates an nkssb generator for nkssb-interp.\n\
- (nkssb-interp gen fm interp) returns n sinusoids from frequency spaced by frequency * ratio with amplitude k.\
- The 'interp' argument determines whether the sidebands are above (1.0) or below (-1.0) frequency."
- (declare (gen nkssb) (fm float) (interp float))
- (let* ((n (nkssb-n gen))
- (cx (nkssb-angle gen))
- (x (* cx (nkssb-ratio gen)))
- (cxx (- cx x))
- (sx2 (sin (* 0.5 x)))
- (sx22 (* 2 sx2))
- (sxsx (* 4 sx2 sx2))
- (nx (* n x))
- (nx2 (* 0.5 (- (* 2 n) 1) x)))
-
- (set! (nkssb-angle gen) (+ cx fm (nkssb-frequency gen)))
-
- (if (< (abs sx2) 1.0e-8)
- -1.0
- (let* ((s1 (- (/ (sin nx) sxsx)
- (/ (* n (cos nx2)) sx22)))
- (c1 (- (/ (* n (sin nx2)) sx22)
- (/ (- 1.0 (cos nx)) sxsx))))
- (/ (- (* (cos cxx) c1)
- (* interp (* (sin cxx) s1)))
- (* 0.5 n (- n 1))))))) ; normalization, nominal n is off by 1, peak seems to be solid right through the interpolation
-
+(define nkssb
+
+ (let ((documentation "(make-nkssb frequency (ratio 1.0) (n 1)) creates an nkssb generator. (nkssb gen (fm 0.0))
+returns n sinusoids from frequency spaced by frequency * ratio with amplitude k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x (* angle ratio)))
+ (let ((cxx (- angle x))
+ (sx2 (sin (* 0.5 x)))
+ (nx (* n x))
+ (nx2 (* 0.5 (- (* 2 n) 1) x)))
+ (let ((sx22 (* 2 sx2))
+ (sxsx (* 4 sx2 sx2)))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs sx2) 1.0e-8)
+ -1.0
+ (let ((s1 (- (/ (sin nx) sxsx)
+ (/ (* n (cos nx2)) sx22)))
+ (c1 (- (/ (* n (sin nx2)) sx22)
+ (/ (- 1.0 (cos nx)) sxsx))))
+ (* (- (* s1 (sin cxx))
+ (* c1 (cos cxx)))
+ norm))))))))))
+
+
+(define nkssb-interp
+
+ (let ((documentation " (make-nkssb-interp frequency (ratio 1.0) (n 1)) creates an nkssb generator for
+nkssb-interp. (nkssb-interp gen fm interp) returns n sinusoids from frequency spaced by frequency * ratio
+with amplitude k. The 'interp' argument determines whether the sidebands are above (1.0) or below (-1.0) frequency."))
+
+ (lambda (gen fm interp)
+ (let-set! gen 'fm fm)
+ (let-set! gen 'interp interp)
+ (with-let gen
+ (let ((x (* angle ratio)))
+ (let ((cxx (- angle x))
+ (sx2 (sin (* 0.5 x))))
+ (let ((sx22 (* 2 sx2))
+ (sxsx (* 4 sx2 sx2))
+ (nx (* n x))
+ (nx2 (* 0.5 (- (* 2 n) 1) x)))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs sx2) 1.0e-8)
+ 1.0
+ (let ((s1 (- (/ (sin nx) sxsx)
+ (/ (* n (cos nx2)) sx22)))
+ (c1 (- (/ (* n (sin nx2)) sx22)
+ (/ (- 1.0 (cos nx)) sxsx))))
+ (* (- (* c1 (cos cxx))
+ (* interp (sin cxx) s1))
+ norm)))))))))) ; peak seems to be solid right through the interpolation
+
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nkssb 1000.0 0.1 5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (nkssb gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (nkssb gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nkssb 1000.0 0.1 5))
(vib (make-oscil 5.0))
(vibamp (hz->radians 50.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (nkssb gen (* vibamp (oscil vib))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (nkssb gen (* vibamp (oscil vib)))))))
|#
(definstrument (nkssber beg dur freq mfreq n vibfreq amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
(gen (make-nkssb freq (/ mfreq freq) n))
(move (make-env '(0 1 1 -1) :duration dur))
- (vib (make-oscil vibfreq))
- (vibamp (hz->radians (* (/ freq mfreq) 5.0)))
+ (vib (make-polywave vibfreq (list 1 (hz->radians (* (/ freq mfreq) 5.0))) mus-chebyshev-second-kind))
(ampf (make-env '(0 0 1 1 5 1 6 0) :scaler amp :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (nkssb-interp gen
- (* vibamp (oscil vib))
- (env move))) ; interp env
- )))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (nkssb-interp gen
+ (polywave vib)
+ (env move))) ; interp env
+ ))))
+
#|
(with-sound (:play #t)
(nkssber 0 1 1000 100 5 5 0.5)
@@ -1148,74 +1205,68 @@
(move (make-env '(0 1 1 -1) :length 30000))
(vib (make-oscil 5.0))
(vibamp (hz->radians 50.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (* 0.5 (nkssb-interp gen
- (* vibamp (oscil vib))
- (env move))) ; interp env
- )))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (* 0.5 (nkssb-interp gen
+ (* vibamp (oscil vib))
+ (env move))) ; interp env
+ ))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nkssb 600.0 1/6 4))
(vib (make-oscil 1.0))
(vibamp (hz->radians 30.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 100000))
- (let ((intrp (oscil vib)))
- (outa i (* 0.5 (nkssb-interp gen
- (* vibamp intrp)
- intrp))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (let ((intrp (oscil vib)))
+ (outa i (* 0.5 (nkssb-interp gen
+ (* vibamp intrp)
+ intrp)))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nkssb 1000.0 (/ 540 1000) 3))
(vib (make-oscil 3.0)) ; 0.3 or 125 + 0.25 and 2 -> circling sound
(vibamp (hz->radians (* (/ 1000 540) 5.0))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 100000))
- (let ((intrp (oscil vib)))
- (outa i (* 0.5 (nkssb-interp gen
- (* vibamp intrp)
- intrp))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (let ((intrp (oscil vib)))
+ (outa i (* 0.5 (nkssb-interp gen
+ (* vibamp intrp)
+ intrp)))))))
(with-sound (:clipped #f :statistics #t :play #t)
- (let ((gen (make-nkssb 300.0 (/ 120 300) 2))
+ (let ((gen (make-nkssb 300.0 (/ 120 300) 2))
(vib (make-oscil 0.25))
(vibamp (hz->radians (* (/ 300 120) 5.0))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 300000))
- (let ((intrp (oscil vib)))
- (outa i (* 0.5 (nkssb-interp gen
- (* vibamp intrp)
- intrp))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 300000))
+ (let ((intrp (oscil vib)))
+ (outa i (* 0.5 (nkssb-interp gen
+ (* vibamp intrp)
+ intrp)))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nkssb 30.0 (/ 4 30) 40))
(vib (make-oscil 0.5))
(vibamp (hz->radians (* (/ 30 4) 5.0))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 300000))
- (let ((intrp (oscil vib)))
- (outa i (* 0.5 (nkssb-interp gen
- (* vibamp intrp)
- intrp))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 300000))
+ (let ((intrp (oscil vib)))
+ (outa i (* 0.5 (nkssb-interp gen
+ (* vibamp intrp)
+ intrp)))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nkssb 20.0 (/ 6 20) 80)) ; 120 8 80 (100), 6 400
(vib (make-oscil 0.5))
(vibamp (hz->radians (* (/ 20 6) 5.0))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 300000))
- (let ((intrp (oscil vib)))
- (outa i (* 0.5 (nkssb-interp gen
- (* vibamp intrp)
- intrp))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 300000))
+ (let ((intrp (oscil vib)))
+ (outa i (* 0.5 (nkssb-interp gen
+ (* vibamp intrp)
+ intrp)))))))
|#
@@ -1227,68 +1278,66 @@
(defgenerator (nsincos
:make-wrapper (lambda (g)
- (let ((n (nsincos-n g)))
- (set! (nsincos-frequency g) (hz->radians (nsincos-frequency g)))
- (set! (nsincos-n2 g) (/ (+ n 1) 2))
- (set! (nsincos-cosn g) (cos (/ pi (+ n 1))))
- (do ((k 1 (+ 1 k)))
+ (let ((n (g 'n)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'n2) (/ (+ n 1) 2))
+ (set! (g 'cosn) (cos (/ pi (+ n 1))))
+ (do ((k 1 (+ k 1)))
((> k n))
- (set! (nsincos-norm g) (+ (nsincos-norm g)
- (/ (sin (/ (* k pi) (+ n 1)))
- (sin (/ pi (+ n 1)))))))
+ (set! (g 'norm) (+ (g 'norm)
+ (/ (sin (/ (* k pi) (+ n 1)))
+ (sin (/ pi (+ n 1)))))))
g)))
- (frequency *clm-default-frequency*) (n 1 :type int)
- (angle 0.0) (n2 1.0) (cosn 1.0) (norm 0.0))
+ (frequency *clm-default-frequency*) (n 1)
+ (angle 0.0) (n2 1.0) (cosn 1.0) (norm 0.0) fm)
-(define* (nsincos gen (fm 0.0))
- " (make-nsincos frequency (n 1)) creates an nsincos generator.\n\
- (nsincos gen (fm 0.0)) returns n cosines spaced by frequency with amplitude sin(k*pi/(n+1))/sin(pi/(n+1))"
- (declare (gen nsincos) (fm float))
- (let* ((x (nsincos-angle gen))
- (n2 (nsincos-n2 gen))
- (cosn (nsincos-cosn gen))
- (num (cos (* n2 x))))
+(define nsincos
- (set! (nsincos-angle gen) (+ x fm (nsincos-frequency gen)))
+ (let ((documentation "(make-nsincos frequency (n 1)) creates an nsincos generator. (nsincos gen (fm 0.0))
+returns n cosines spaced by frequency with amplitude sin(k*pi/(n+1))/sin(pi/(n+1))"))
- (/ (* num num)
- (* (nsincos-norm gen)
- (- (cos x) cosn)))))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (num (cos (* n2 x))))
+ (set! angle (+ angle fm frequency))
+ (/ (* num num)
+ (* norm (- (cos x) cosn))))))))
#|
(with-sound (:clipped #f :statistics #t :play #f)
(let ((gen (make-nsincos 100.0 3)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (nsincos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (nsincos gen)))))
|#
+
+
;;; --------------------------------------------------------------------------------
;;;
;;; Ramanujan, "On certain Arithmetical Functions"
(defgenerator (n1cos
:make-wrapper (lambda (g)
- (set! (n1cos-frequency g) (hz->radians (n1cos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0))
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0) fm)
(define* (n1cos gen (fm 0.0))
- (declare (gen n1cos) (fm float))
- (let* ((n (n1cos-n gen))
- (x (n1cos-angle gen))
- (tn (tan (* 0.5 x))))
-
- (set! (n1cos-angle gen) (+ x fm (n1cos-frequency gen)))
-
- (if (< (abs tn) 1.0e-6)
- 1.0
- (/ (- 1.0 (cos (* n x)))
- (* tn tn
- n n 2))))) ; normalization -- this still has the very large DC term
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (tn (tan (* 0.5 x))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs tn) 1.0e-6)
+ 1.0
+ (/ (- 1.0 (cos (* n x)))
+ (* tn tn
+ n n 2)))))) ; normalization -- this still has the very large DC term
#|
(with-sound (:clipped #f)
@@ -1300,7 +1349,6 @@
-
#|
;;; --------------------------------------------------------------------------------
@@ -1310,136 +1358,164 @@
(defgenerator (npos1cos
:make-wrapper (lambda (g)
- (set! (npos1cos-frequency g) (hz->radians (npos1cos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0) fm)
-(define* (npos1cos gen (fm 0.0))
- " (make-npos1cos frequency (n 1)) creates an npos1cos generator.\n\
- (npos1cos gen (fm 0.0)) returns n cosines spaced by frequency."
- (declare (gen npos1cos) (fm float))
- (let* ((x (npos1cos-angle gen))
- (n (npos1cos-n gen))
- (num (- (* (+ n 2) (sin (/ (* n x) 2)))
- (* n (sin (/ (* (+ n 2) x) 2)))))
- (sx (sin (/ x 2)))
- (den (* 4 n (+ n 1) (+ n 2) sx sx sx sx)))
- (set! (npos1cos-angle gen) (+ x fm (npos1cos-frequency gen)))
+(define npos1cos
- (if (< (abs den) nearly-zero)
- 0.0
-
- (/ (* 3 num num)
- den))))
+ (let ((documentation "(make-npos1cos frequency (n 1)) creates an npos1cos generator. (npos1cos gen (fm 0.0))
+returns n cosines spaced by frequency."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (num (- (* (+ n 2) (sin (/ (* n x) 2)))
+ (* n (sin (/ (* (+ n 2) x) 2)))))
+ (sx (sin (/ x 2)))
+ (den (* 4 n (+ n 1) (+ n 2) sx sx sx sx)))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ 0.0
+ (/ (* 3 num num)
+ den)))))))
;;; needs normalization and no DC. side amps seem close
(with-sound (:clipped #f :statistics #t :play #f)
(let ((gen (make-npos1cos 100.0 3)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (npos1cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (npos1cos gen)))))
(defgenerator (npos3cos
:make-wrapper (lambda (g)
- (set! (npos3cos-frequency g) (hz->radians (npos3cos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0))
-
-
-(define* (npos3cos gen (fm 0.0))
- " (make-npos3cos frequency (n 1)) creates an npos3cos generator.\n\
- (npos3cos gen (fm 0.0)) returns n cosines spaced by frequency."
- (declare (gen npos3cos) (fm float))
- (let* ((x (npos3cos-angle gen))
- (n (npos3cos-n gen))
- (sx (sin (/ x 2)))
- (den (* (+ (* 4 n) 2) sx sx)))
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0) fm)
- (set! (npos3cos-angle gen) (+ x fm (npos3cos-frequency gen)))
- (if (< (abs den) nearly-zero)
- (* 1.0 n)
+(define npos3cos
- (/ (- 2 (cos (* n x)) (cos (* (+ n 1) x)))
- den))))
+ (let ((documentation "(make-npos3cos frequency (n 1)) creates an npos3cos generator. (npos3cos gen (fm 0.0))
+returns n cosines spaced by frequency."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (sx (sin (/ x 2)))
+ (den (* (+ (* 4 n) 2) sx sx)))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs den) nearly-zero)
+ (* 1.0 n)
+ (/ (- 2 (cos (* n x)) (cos (* (+ n 1) x)))
+ den)))))))
;;; needs normalization and no DC, peak at den=0 not right. side amps seem close
-
(with-sound (:clipped #f :statistics #t :play #f)
(let ((gen (make-npos3cos 100.0 3)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (npos3cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (npos3cos gen)))))
|#
+
;;; --------------------------------------------------------------------------------
;;;
;;; inf sinusoids scaled by r: rcos, rssb
+(define rcos-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'osc)))
+ (lambda (g val) (set! (mus-frequency (g 'osc)) val))))
+
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val)
+ (set! (g 'r) (generator-clamp-r val))
+ (set! (g 'rr) (* (g 'r) (g 'r)))
+ (set! (g 'rr+1) (+ 1.0 (g 'rr)))
+ (set! (g 'rr-1) (- 1.0 (g 'rr)))
+ (set! (g 'r2) (* 2.0 (g 'r)))
+ (let ((absr (abs (g 'r))))
+ (if (< absr nearly-zero)
+ (set! (g 'norm) 0.0)
+ (set! (g 'norm) (/ (- 1.0 absr) (* 2.0 absr)))))
+ val)))
+
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'osc)))
+ (lambda (g val) (set! (mus-phase (g 'osc)) val))))))
+
(defgenerator (rcos
:make-wrapper (lambda (g)
- (set! (rcos-osc g) (make-oscil (rcos-frequency g) (* 0.5 pi)))
- (set! (rcos-r g) (generator-clamp-r (rcos-r g)))
+ (set! (g 'osc) (make-oscil (g 'frequency) (* 0.5 pi)))
+ (set! (g 'r) (generator-clamp-r (g 'r)))
+ (set! (g 'rr) (* (g 'r) (g 'r)))
+ (set! (g 'rr+1) (+ 1.0 (g 'rr)))
+ (set! (g 'rr-1) (- 1.0 (g 'rr)))
+ (set! (g 'r2) (* 2.0 (g 'r)))
+ (let ((absr (abs (g 'r))))
+ (if (< absr nearly-zero)
+ (set! (g 'norm) 0.0)
+ (set! (g 'norm) (/ (- 1.0 absr) (* 2.0 absr)))))
g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (rcos-osc g)))
- (lambda (g val) (set! (mus-frequency (rcos-osc g)) val) val))
-
- (list 'mus-scaler
- (lambda (g) (rcos-r g))
- (lambda (g val)
- (set! (rcos-r g) (generator-clamp-r val))
- (rcos-r g)))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (rcos-osc g)))
- (lambda (g val) (set! (mus-phase (rcos-osc g)) val) val))))
- (frequency *clm-default-frequency*) (r 0.5)
- (osc #f :type clm))
+ :methods rcos-methods)
+ (frequency *clm-default-frequency*) (r 0.5) fm
+ (osc #f) rr norm rr+1 rr-1 r2)
+
+(define rcos
+
+ (let ((documentation "(make-rcos frequency (r 0.5)) creates an rcos generator. (rcos gen (fm 0.0))
+returns many cosines spaced by frequency with amplitude r^k."))
+
+ ;; from Andrews, Askey, Roy "Special Functions" 5.1.16, p243. r^k cos sum
+ ;; a variant of the G&R second col 4th row
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (* (- (/ rr-1 (- rr+1 (* r2 (oscil osc fm)))) 1.0) norm)))))
#|
-;;; G&R form:
-(define* (rcos gen (fm 0.0))
- (declare (gen rcos) (fm float))
- (let* ((r (rcos-r gen))
- (absr (abs r))
- (rcosx (* r (oscil (rcos-osc gen) fm))))
- (* (- (/ (- 1.0 rcosx)
- (+ 1.0
- (* r r)
- (* -2.0 rcosx)))
- 1.0)
- (/ (- 1.0 absr) absr)))) ; normalization
+ (with-let gen
+ (let ((absr (abs r))
+ (rr (* r r)))
+ (if (< absr nearly-zero)
+ 0.0 ; 1.0 from the formula, but we're subtracting out DC
+ (* (- (/ (- 1.0 rr)
+ (- (+ 1.0 rr)
+ (* 2.0 r (oscil osc fm))))
+ 1.0)
+ (/ (- 1.0 absr) (* 2.0 absr))))))) ; normalization
|#
+#|
+;;; G&R form:
(define* (rcos gen (fm 0.0))
- " (make-rcos frequency (r 0.5)) creates an rcos generator.\n\
- (rcos gen (fm 0.0)) returns many cosines spaced by frequency with amplitude r^k."
- ;; from Andrews, Askey, Roy "Special Functions" 5.1.16, p243. r^k cos sum
- ;; a variant of the G&R 2nd col 4th row
- (declare (gen rcos) (fm float))
- (let* ((r (rcos-r gen))
- (absr (abs r))
- (rr (* r r)))
-
- (if (< absr nearly-zero)
- 0.0 ; 1.0 from the formula, but we're subtracting out DC
- (* (- (/ (- 1.0 rr)
- (- (+ 1.0 rr)
- (* 2.0 r (oscil (rcos-osc gen) fm))))
- 1.0)
- (/ (- 1.0 absr) (* 2.0 absr)))))) ; normalization
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((absr (abs r))
+ (rcosx (* r (oscil osc fm))))
+ (* (- (/ (- 1.0 rcosx)
+ (+ 1.0
+ (* r r)
+ (* -2.0 rcosx)))
+ 1.0)
+ (/ (- 1.0 absr) absr))))) ; normalization
+|#
;;; if r>0 we get the spike at multiples of 2pi, since the k*pi case is flipping -1 1 -1 etc
;;; if r<0, we get the spike at multiples of (2k-1)pi since the r sign now counteracts the cos k*pi sign
@@ -1452,32 +1528,33 @@
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-rcos 100.0 :r 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (rcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (rcos gen)))))
|#
+;; this uses rkoddssb below
+
(definstrument (stringy beg dur freq amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (n (floor (/ (mus-srate) (* 3 freq))))
- (r (expt .001 (/ 1 n)))
- (carrier (make-rcos freq (* .5 r)))
- (clang (make-rkoddssb (* freq 2) (/ 1.618 2) r))
- (ampf (make-env '(0 0 1 1 2 .5 4 .25 10 0) :scaler amp :duration dur))
- (clangf (make-env (list 0 0 .1 1 .2 .1 .3 0) :scaler (* amp .5) :duration .1))
- (rf (make-env (list 0 1 1 0) :scaler (* 0.5 r) :duration dur))
- (crf (make-env (list 0 1 1 0) :scaler r :duration .1)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (set! (mus-scaler clang) (env crf))
- (set! (rcos-r carrier) (env rf))
- (outa i (+ (* (env clangf)
- (rkoddssb clang 0.0))
- (* (env ampf)
- (rcos carrier 0.0))))))))
+ (let ((n (floor (/ *clm-srate* (* 3 freq)))))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (r (expt .001 (/ n))))
+ (let ((carrier (make-rcos freq (* .5 r)))
+ (clang (make-rkoddssb (* freq 2) (/ 1.618 2) r))
+ (ampf (make-env '(0 0 1 1 2 .5 4 .25 10 0) :scaler amp :duration dur))
+ (clangf (make-env (list 0 0 .1 1 .2 .1 .3 0) :scaler (* amp .5) :duration .1))
+ (rf (make-env (list 0 1 1 0) :scaler (* 0.5 r) :duration dur))
+ (crf (make-env (list 0 1 1 0) :scaler r :duration .1)))
+ (let ((set-clang-scaler (procedure-setter (clang 'mus-scaler))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (set-clang-scaler clang (env crf)) ;(set! (mus-scaler clang) (env crf))
+ (set! (carrier 'r) (env rf))
+ (outa i (+ (* (env clangf)
+ (rkoddssb clang 0.0))
+ (* (env ampf)
+ (rcos carrier 0.0))))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
@@ -1490,100 +1567,102 @@
|#
+(define rssb-methods
+ (list
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val) (set! (g 'r) (generator-clamp-r val)))))))
+
(defgenerator (rssb
:make-wrapper (lambda (g)
- (set! (rssb-frequency g) (hz->radians (rssb-frequency g)))
- (set! (rssb-r g) (generator-clamp-r (rssb-r g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'r) (generator-clamp-r (g 'r)))
g)
+
+ :methods rssb-methods)
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm interp)
- :methods (list
- (list 'mus-scaler
- (lambda (g) (rssb-r g))
- (lambda (g val)
- (set! (rssb-r g) (generator-clamp-r val))
- (rssb-r g)))))
-
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
-
-
-(define* (rssb gen (fm 0.0))
- " (make-rssb frequency (ratio 1.0) (r 0.5)) creates an rssb generator.\n\
- (rssb gen (fm 0.0)) returns many cosines from frequency spaced by frequency * ratio with amplitude r^k."
- (declare (gen rssb) (fm float))
- (let* ((angle1 (rssb-angle gen))
- (angle2 (* angle1 (rssb-ratio gen)))
- (carsin (sin angle1))
- (canrcos (cos angle1))
- (r (rssb-r gen))
- (den (+ 1.0 (* r r) (* -2.0 r (cos angle2))))
- (sumsin (* r (sin angle2)))
- (sumcos (- 1.0 (* r (cos angle2)))))
-
- (set! (rssb-angle gen) (+ angle1 fm (rssb-frequency gen)))
-
- (/ (- (* carsin sumsin)
- (* canrcos sumcos))
- (* 2 den))))
-
-
-(define (rssb-interp gen fm interp)
- " (make-rssb frequency (ratio 1.0) (r 0.5)) creates an rssb generator for rssb-interp.\n\
- (rssb-interp gen fm interp) returns many cosines from frequency spaced by frequency * ratio with amplitude r^k.\
- The 'interp' argument determines whether the sidebands are above (1.0) or below (-1.0) frequency."
- (declare (gen rssb) (fm float))
- (let* ((angle1 (rssb-angle gen))
- (angle2 (* angle1 (rssb-ratio gen)))
- (carsin (sin angle1))
- (canrcos (cos angle1))
- (r (rssb-r gen))
- (den (+ 1.0 (* r r) (* -2.0 r (cos angle2))))
- (sumsin (* r (sin angle2)))
- (sumcos (- 1.0 (* r (cos angle2)))))
-
- (set! (rssb-angle gen) (+ angle1 fm (rssb-frequency gen)))
- (/ (- (* carsin sumsin)
- (* interp canrcos sumcos))
- (* 2 den))))
+(define rssb
+ (let ((documentation "(make-rssb frequency (ratio 1.0) (r 0.5)) creates an rssb generator. (rssb gen (fm 0.0))
+ returns many cosines from frequency spaced by frequency * ratio with amplitude r^k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((angle1 angle)
+ (angle2 (* angle1 ratio))
+ (carsin (sin angle1))
+ (canrcos (cos angle1))
+ (den (+ 1.0 (* r r) (* -2.0 r (cos angle2))))
+ (sumsin (* r (sin angle2)))
+ (sumcos (- 1.0 (* r (cos angle2)))))
+ (set! angle (+ angle1 fm frequency))
+ (/ (- (* carsin sumsin)
+ (* canrcos sumcos))
+ (* 2 den)))))))
+
+
+(define rssb-interp
+
+ (let ((documentation "(make-rssb frequency (ratio 1.0) (r 0.5)) creates an rssb generator for
+rssb-interp. (rssb-interp gen fm interp) returns many cosines from frequency spaced by frequency * ratio
+with amplitude r^k. The 'interp' argument determines whether the sidebands are above (1.0) or below (-1.0) frequency."))
+
+ (lambda (gen fm interp)
+ (let-set! gen 'fm fm)
+ (let-set! gen 'interp interp)
+ (with-let gen
+ (let* ((angle1 angle)
+ (angle2 (* angle1 ratio))
+ (carsin (sin angle1))
+ (canrcos (cos angle1))
+ (den (+ 1.0 (* r r) (* -2.0 r (cos angle2))))
+ (sumsin (* r (sin angle2)))
+ (sumcos (- 1.0 (* r (cos angle2)))))
+ (set! angle (+ angle1 fm frequency))
+ (/ (- (* carsin sumsin)
+ (* interp canrcos sumcos))
+ (* 2 den)))))))
(definstrument (bump beg dur freq amp f0 f1 f2)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (res0 (round (/ f0 freq)))
- (res1 (round (/ f1 freq)))
- (res2 (round (/ f2 freq)))
- (gen1 (make-rssb (* res0 freq) (/ 1 res0) .4))
- (gen2 (make-rssb (* res1 freq) (/ 1 res1) .5))
- (gen3 (make-rssb (* res2 freq) (/ 1 res2) .6))
- (ampf (make-env '(0 0 .1 1 2 .5 3 .1 4 1 5 .4 6 .1 80 0) :scaler amp :base 32 :duration dur)) ; or 50 at end
- ;; or '(0 0 .1 1 2 .5 3 .1 4 .3 5 .1 40 0)
- (pervib (make-triangle-wave 5.0 (hz->radians 3.0)))
- (ranvib (make-rand-interp 12.0 (hz->radians 2.0))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let ((vib (+ (rand-interp ranvib)
- (triangle-wave pervib))))
- (outa i (* (env ampf)
- (+ (* .85 (rssb-interp gen1 (* res0 vib) -1))
- (* .1 (rssb-interp gen2 (* res1 vib) 0))
- (* .05 (rssb-interp gen3 (* res2 vib) 1))))))))))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (res0 (round (/ f0 freq)))
+ (res1 (round (/ f1 freq)))
+ (res2 (round (/ f2 freq))))
+ (let ((gen1 (make-rssb (* res0 freq) (/ res0) .4))
+ (gen2 (make-rssb (* res1 freq) (/ res1) .5))
+ (gen3 (make-rssb (* res2 freq) (/ res2) .6))
+ (ampf (make-env '(0 0 .1 1 2 .5 3 .1 4 1 5 .4 6 .1 80 0) :scaler amp :base 32 :duration dur)) ; or 50 at end
+ ;; or '(0 0 .1 1 2 .5 3 .1 4 .3 5 .1 40 0)
+ (pervib (make-triangle-wave 5.0 (hz->radians 3.0)))
+ (ranvib (make-rand-interp 12.0 (hz->radians 2.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((vib (+ (rand-interp ranvib)
+ (triangle-wave pervib))))
+ (outa i (* (env ampf)
+ (+ (* .85 (rssb-interp gen1 (* res0 vib) -1))
+ (* .1 (rssb-interp gen2 (* res1 vib) 0))
+ (* .05 (rssb-interp gen3 (* res2 vib) 1))))))))))
#|
(with-sound (:play #t)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 10))
(bump (* 0.4 k) 1 (* 16.3 (expt 2.0 (+ 3 (/ k 12)))) .5 520 1190 2390))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 10))
(let* ((freq (* 16.3 (expt 2.0 (+ 3 (/ k 12)))))
(scl (sqrt (/ freq 120))))
(bump (+ 4 (* 0.4 k)) 1 freq .5 (* scl 520) (* scl 1190) (* scl 2390)))))
(with-sound (:clipped #f :statistics #t :play #t)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 10))
(let* ((freq (* 16.3 (expt 2.0 (+ 3 (/ k 12))))) ; if oct=5 (and env end at 100), sort of hammered string effect
(f0 520) ; "uh"
@@ -1594,25 +1673,24 @@
(res0 (round (/ f0 freq)))
(res1 (round (/ f1 freq)))
(res2 (round (/ f2 freq)))
- (gen1 (make-rssb (* res0 freq) (/ 1 res0) .4))
- (gen2 (make-rssb (* res1 freq) (/ 1 res1) .5))
- (gen3 (make-rssb (* res2 freq) (/ 1 res2) .6))
+ (gen1 (make-rssb (* res0 freq) (/ res0) .4))
+ (gen2 (make-rssb (* res1 freq) (/ res1) .5))
+ (gen3 (make-rssb (* res2 freq) (/ res2) .6))
(ampf (make-env '(0 0 .1 1 2 .5 3 .1 4 1 5 .4 6 .1 80 0) :scaler .5 :base 32 :length 60000)) ; or 50 at end
;; or '(0 0 .1 1 2 .5 3 .1 4 .3 5 .1 40 0)
(pervib (make-triangle-wave 5.0 (hz->radians 3.0)))
(ranvib (make-rand-interp 12.0 (hz->radians 2.0))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 60000))
- (let ((vib (+ (rand-interp ranvib)
- (triangle-wave pervib))))
- (outa (+ i (* k 30000)) (* (env ampf)
- (+ (* .85 (rssb-interp gen1 (* res0 vib) -1))
- (* .1 (rssb-interp gen2 (* res1 vib) 0))
- (* .05 (rssb-interp gen3 (* res2 vib) 1)))))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 60000))
+ (let ((vib (+ (rand-interp ranvib)
+ (triangle-wave pervib))))
+ (outa (+ i (* k 30000)) (* (env ampf)
+ (+ (* .85 (rssb-interp gen1 (* res0 vib) -1))
+ (* .1 (rssb-interp gen2 (* res1 vib) 0))
+ (* .05 (rssb-interp gen3 (* res2 vib) 1))))))))))
(with-sound (:clipped #f :statistics #t :play #t)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 10))
(let* ((freq (* 16.3 (expt 2.0 (+ 3 (/ k 12))))) ; froggy if oct=1 or 2 and "ah" (env end at 10 = cycling) ("er" is good too at oct=2)
(scl (sqrt (/ freq 120)))
@@ -1623,25 +1701,24 @@
(res0 (floor (/ f0 freq)))
(res1 (floor (/ f1 freq)))
(res2 (floor (/ f2 freq)))
- (gen1 (make-rk!ssb (* res0 freq) (/ 1 res0) 2.4))
- (gen2 (make-rssb (* res1 freq) (/ 1 res1) .5))
- (gen3 (make-rssb (* res2 freq) (/ 1 res2) .6))
+ (gen1 (make-rk!ssb (* res0 freq) (/ res0) 2.4))
+ (gen2 (make-rssb (* res1 freq) (/ res1) .5))
+ (gen3 (make-rssb (* res2 freq) (/ res2) .6))
(ampf (make-env '(0 0 .1 1 2 .5 3 .1 4 .3 5 .4 6 .1 40 0) :scaler .5 :base 32 :length 60000)) ; or 50 at end
;; or '(0 0 .1 1 2 .5 3 .1 4 .3 5 .1 40 0)
(pervib (make-triangle-wave 5.0 (hz->radians 3.0)))
(ranvib (make-rand-interp 12.0 (hz->radians 2.0))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 60000))
- (let ((vib (+ (rand-interp ranvib)
- (triangle-wave pervib))))
- (outa (+ i (* k 30000)) (* (env ampf)
- (+ (* .85 (rk!ssb gen1 (* res0 vib)))
- (* .1 (rssb-interp gen2 (* res1 vib) 0))
- (* .05 (rssb-interp gen3 (* res2 vib) 1)))))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 60000))
+ (let ((vib (+ (rand-interp ranvib)
+ (triangle-wave pervib))))
+ (outa (+ i (* k 30000)) (* (env ampf)
+ (+ (* .85 (rk!ssb gen1 (* res0 vib)))
+ (* .1 (rssb-interp gen2 (* res1 vib) 0))
+ (* .05 (rssb-interp gen3 (* res2 vib) 1))))))))))
(with-sound (:clipped #f :statistics #t :play #t)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 10))
(let* ((freq (* 16.3 (expt 2.0 (+ 3 (/ k 12)))))
(scl (sqrt (/ freq 120)))
@@ -1652,28 +1729,26 @@
(res0 (floor (/ f0 freq)))
(res1 (floor (/ f1 freq)))
(res2 (floor (/ f2 freq)))
- (gen1 (make-rk!ssb (* res0 freq) (/ 1 res0) 2))
- (gen2 (make-rk!ssb (* res1 freq) (/ 1 res1) 3))
- (gen3 (make-rk!ssb (* res2 freq) (/ 1 res2) 3))
+ (gen1 (make-rk!ssb (* res0 freq) (/ res0) 2))
+ (gen2 (make-rk!ssb (* res1 freq) (/ res1) 3))
+ (gen3 (make-rk!ssb (* res2 freq) (/ res2) 3))
(ampf (make-env '(0 0 .1 1 2 .5 3 .1 4 .3 5 .4 6 .1 40 0) :scaler .5 :base 32 :length 30000))
(pervib (make-triangle-wave 5.0 (hz->radians 3.0)))
(ranvib (make-rand-interp 12.0 (hz->radians 2.0))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (let ((vib (+ (rand-interp ranvib)
- (triangle-wave pervib))))
- (outa (+ i (* k 30000)) (* (env ampf)
- (+ (* .85 (rk!ssb gen1 (* res0 vib)))
- (* .1 (rk!ssb gen2 (* res1 vib)))
- (* .05 (rk!ssb gen3 (* res2 vib))))))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (let ((vib (+ (rand-interp ranvib)
+ (triangle-wave pervib))))
+ (outa (+ i (* k 30000)) (* (env ampf)
+ (+ (* .85 (rk!ssb gen1 (* res0 vib)))
+ (* .1 (rk!ssb gen2 (* res1 vib)))
+ (* .05 (rk!ssb gen3 (* res2 vib)))))))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-rssb 2000.0 (/ 103.0 2000) 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rssb gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (rssb gen)))))
|#
@@ -1681,87 +1756,98 @@
;;;
;;; rxysin
;;;
-;;; similar to rssb: (JO 1st)
-
+;;; similar to rssb: (JO first)
+
+(define rxysin-methods
+ (list
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val)
+ (set! (g 'r) (generator-clamp-r val))
+ (set! (g 'r2) (* -2.0 (g 'r)))
+ (set! (g 'rr) (+ 1.0 (* (g 'r) (g 'r)))))))))
+
(defgenerator (rxysin
:make-wrapper (lambda (g)
- (set! (rxysin-frequency g) (hz->radians (rxysin-frequency g)))
- (set! (rxysin-r g) (generator-clamp-r (rxysin-r g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'r) (generator-clamp-r (g 'r)))
+ (set! (g 'r2) (* -2.0 (g 'r)))
+ (set! (g 'rr) (+ 1.0 (* (g 'r) (g 'r))))
g)
- :methods (list
- (list 'mus-scaler
- (lambda (g) (rxysin-r g))
- (lambda (g val)
- (set! (rxysin-r g) (generator-clamp-r val))
- (rxysin-r g)))))
-
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
+ :methods rxysin-methods)
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm rr r2)
-(define* (rxysin gen (fm 0.0))
- " (make-rxysin frequency (ratio 1.0) (r 0.5)) creates an rxysin generator (similar to rssb).\n\
- (rxysin gen (fm 0.0)) returns many sines from frequency spaced by frequency * ratio with amplitude r^k."
- (declare (gen rxysin) (fm float))
- (let* ((x (rxysin-angle gen))
- (y (* x (rxysin-ratio gen)))
- (r (rxysin-r gen)))
-
- (set! (rxysin-angle gen) (+ x fm (rxysin-frequency gen)))
-
- (/ (- (sin x)
- (* r (sin (- x y))))
- (+ 1.0
- (* -2.0 r (cos y))
- (* r r)))))
+(define rxysin
+ (let ((documentation "(make-rxysin frequency (ratio 1.0) (r 0.5)) creates an rxysin generator (similar to rssb). (rxysin gen (fm 0.0))
+returns many sines from frequency spaced by frequency * ratio with amplitude r^k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio)))
+ (set! angle (+ angle fm frequency))
+ (/ (- (sin x)
+ (* r (sin (- x y))))
+ (+ rr (* r2 (cos y)))))))))
+
#|
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-rxysin 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rxysin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (rxysin gen)))))
|#
+(define rxycos-methods
+ (list
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val)
+ (set! (g 'r) (generator-clamp-r val))
+ (set! (g 'r2) (* -2.0 (g 'r)))
+ (set! (g 'rr) (+ 1.0 (* (g 'r) (g 'r))))
+ (set! (g 'norm) (- 1.0 (abs (g 'r)))))))))
+
(defgenerator (rxycos
:make-wrapper (lambda (g)
- (set! (rxycos-frequency g) (hz->radians (rxycos-frequency g)))
- (set! (rxycos-r g) (generator-clamp-r (rxycos-r g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'r) (generator-clamp-r (g 'r)))
+ (set! (g 'r2) (* -2.0 (g 'r)))
+ (set! (g 'rr) (+ 1.0 (* (g 'r) (g 'r))))
+ (set! (g 'norm) (- 1.0 (abs (g 'r)))) ; abs for negative r
g)
- :methods (list
- (list 'mus-scaler
- (lambda (g) (rxycos-r g))
- (lambda (g val)
- (set! (rxycos-r g) (generator-clamp-r val))
- (rxycos-r g)))))
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
-
-
-(define* (rxycos gen (fm 0.0))
- " (make-rxycos frequency (ratio 1.0) (r 0.5)) creates an rxycos generator.\n\
- (rxycos gen (fm 0.0)) returns many cosines from frequency spaced by frequency * ratio with amplitude r^k."
- (declare (gen rxycos) (fm float))
- (let* ((x (rxycos-angle gen))
- (y (* x (rxycos-ratio gen)))
- (r (rxycos-r gen)))
-
- (set! (rxycos-angle gen) (+ x fm (rxycos-frequency gen)))
-
- (* (/ (- (cos x)
- (* r (cos (- x y))))
- (+ 1.0
- (* -2.0 r (cos y))
- (* r r)))
- (- 1.0 (abs r))))) ; norm, abs for negative r
+ :methods rxycos-methods)
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm norm rr r2)
+
+
+(define rxycos
+
+ (let ((documentation "(make-rxycos frequency (ratio 1.0) (r 0.5)) creates an rxycos generator. (rxycos gen (fm 0.0))
+returns many cosines from frequency spaced by frequency * ratio with amplitude r^k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio)))
+ (set! angle (+ angle fm frequency))
+ (* (/ (- (cos x)
+ (* r (cos (- x y))))
+ (+ rr (* r2 (cos y))))
+ norm))))))
#|
(with-sound (:clipped #f :statistics #t)
(let ((gen (make-rxycos 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rxycos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (rxycos gen)))))
|#
@@ -1769,79 +1855,78 @@
;; in this case we need to track ratio, as well as r, since the
;; highest frequency goes as x+ky (y=ratio*x); we want the value of k when
;; we reach srate/3, then solve for the corresponding r.
-
- (declare (gen safe-rxycos) (fm float))
- (let* ((x (radians->hz (+ (safe-rxycos-frequency gen) fm)))
- (y (* x (safe-rxycos-ratio gen)))
- (r (safe-rxycos-r gen))
- (topk (floor (/ (- (/ (mus-srate) 3) x) y)))
- (maxr (expt (safe-rxycos-cutoff gen)
- (/ 1.0 topk))))
- (if (>= r 0.0)
- (min r maxr)
- (max r (- maxr)))))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((maxr (expt cutoff (/ (floor (- (/ two-pi (* 3 ratio (+ fm frequency))) (/ ratio)))))))
+ (if (>= r 0.0)
+ (min r maxr)
+ (max r (- maxr))))))
+
+(define safe-rxycos-methods
+ (list
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val)
+ (set! (g 'r) val)
+ (set! (g 'r) (clamp-rxycos-r g 0.0)))))
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (radians->hz (g 'frequency)))
+ (lambda (g val)
+ (set! (g 'frequency) (hz->radians val))
+ (set! (g 'r) (clamp-rxycos-r g 0.0))
+ val)))
+ (cons 'mus-offset ; ratio accessor in defgenerator
+ (dilambda
+ (lambda (g) (g 'ratio))
+ (lambda (g val)
+ (set! (g 'ratio) val)
+ (set! (g 'r) (clamp-rxycos-r g 0.0))
+ val)))))
(defgenerator (safe-rxycos
:make-wrapper (lambda (g)
- (set! (safe-rxycos-frequency g) (hz->radians (safe-rxycos-frequency g)))
- (set! (safe-rxycos-r g) (clamp-rxycos-r g 0.0))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'r) (clamp-rxycos-r g 0.0))
g)
+ :methods safe-rxycos-methods)
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) (cutoff 0.001) fm)
- :methods (list
- (list 'mus-scaler
- (lambda (g)
- (safe-rxycos-r g))
- (lambda (g val)
- (set! (safe-rxycor-r g) val)
- (set! (safe-rxycos-r g) (clamp-rxycos-r g 0.0))
- (safe-rxycos-r g)))
-
- (list 'mus-frequency
- (lambda (g)
- (radians->hz (rxycos-frequency g)))
- (lambda (g val)
- (set! (safe-rxycos-frequency g) (hz->radians val))
- (set! (safe-rxycos-r g) (clamp-rxycos-r g 0.0))
- val))
-
- (list 'mus-offset ; ratio accessor in defgenerator
- (lambda (g)
- (safe-rxycos-ratio g))
- (lambda (g val)
- (set! (safe-rxycos-ratio g) val)
- (set! (safe-rxycos-r g) (clamp-rxycos-r g 0.0))
- val))))
-
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) (cutoff 0.001))
-
-
-(define* (safe-rxycos gen (fm 0.0))
- " (make-safe-rxycos frequency (ratio 1.0) (r 0.5)) creates a safe-rxycos generator.\n\
- (safe-rxycos gen (fm 0.0)) returns many cosines from frequency spaced by frequency * ratio with amplitude r^k where 'r' is restricted to a safe value."
- (declare (gen safe-rxycos) (fm float))
- (let* ((x (safe-rxycos-angle gen))
- (y (* x (safe-rxycos-ratio gen)))
- (r (safe-rxycos-r gen)))
-
- (set! (safe-rxycos-angle gen) (+ x fm (safe-rxycos-frequency gen)))
- (if (not (= fm 0.0))
- (set! r (clamp-rxycos-r gen fm)))
-
- (* (/ (- (cos x)
- (* r (cos (- x y))))
- (+ 1.0
- (* -2.0 r (cos y))
- (* r r)))
- (- 1.0 (abs r))))) ; norm, abs for negative r
+
+(define safe-rxycos
+
+ (let ((documentation "(make-safe-rxycos frequency (ratio 1.0) (r 0.5)) creates a safe-rxycos generator. (safe-rxycos gen (fm 0.0))
+returns many cosines from frequency spaced by frequency * ratio with amplitude r^k where 'r' is restricted to a safe value."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle)
+ (y (* angle ratio)))
+ (set! angle (+ angle fm frequency))
+
+ (if (not (= fm 0.0)) ;(set! r (clamp-rxycos-r (curlet) fm))
+ (let ((maxr (expt cutoff (/ (floor (- (/ two-pi (* 3 ratio (+ fm frequency))) (/ ratio)))))))
+ (if (>= r 0.0)
+ (set! r (min r maxr))
+ (set! r (max r (- maxr))))))
+
+ (* (/ (- (cos x)
+ (* r (cos (- x y))))
+ (+ 1.0
+ (* -2.0 r (cos y))
+ (* r r)))
+ (- 1.0 (abs r)))))))) ; norm, abs for negative r
#|
(with-sound (:clipped #f :statistics #t)
(let ((gen (make-safe-rxycos 1000 0.1 0.99)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (safe-rxycos gen))))))
- |#
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (safe-rxycos gen)))))
+|#
+
@@ -1849,63 +1934,94 @@
;;; inf cosines scaled by e^-r (special case of rcos): ercos, erssb
-;;; sndclm.html G&R 2nd col last row (with normalization)
-
+;;; sndclm.html G&R second col last row (with normalization)
+
+(define ercos-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'osc)))
+ (lambda (g val) (set! (mus-frequency (g 'osc)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'osc)))
+ (lambda (g val) (set! (mus-phase (g 'osc)) val))))))
+
(defgenerator (ercos
:make-wrapper (lambda (g)
- (set! (ercos-osc g) (make-oscil (ercos-frequency g)))
- (if (<= (ercos-r g) 0.0) (set! (ercos-r g) 0.00001))
- (set! (ercos-cosh-t g) (cosh (ercos-r g)))
- (let ((exp-t (exp (- (ercos-r g)))))
- (set! (ercos-offset g) (/ (- 1.0 exp-t) (* 2.0 exp-t)))
- (set! (ercos-scaler g) (* (sinh (ercos-r g)) (ercos-offset g))))
+ (if (<= (g 'r) 0.0) (set! (g 'r) 0.00001))
+ (set! (g 'cosh-t) (cosh (g 'r)))
+ (set! (g 'osc) (make-polywave (g 'frequency) (list 0 (g 'cosh-t) 1 -1.0) mus-chebyshev-second-kind))
+ (let ((exp-t (exp (- (g 'r)))))
+ (set! (g 'offset) (/ (- 1.0 exp-t) (* 2.0 exp-t)))
+ (set! (g 'scaler) (* (sinh (g 'r)) (g 'offset))))
g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (ercos-osc g)))
- (lambda (g val) (set! (mus-frequency (ercos-osc g)) val) val))
+ :methods ercos-methods)
+ (frequency *clm-default-frequency*) (r 1.0) fm
+ (osc #f) scaler offset cosh-t)
- (list 'mus-phase
- (lambda (g) (mus-phase (ercos-osc g)))
- (lambda (g val) (set! (mus-phase (ercos-osc g)) val) val))))
- (frequency *clm-default-frequency*) (r 1.0)
- (osc #f :type clm) scaler offset cosh-t)
+(define ercos
-
-(define* (ercos gen (fm 0.0))
- " (make-ercos frequency (r 0.5)) creates an ercos generator (a special case of rcos).\n\
- (ercos gen (fm 0.0)) returns many cosines from frequency with amplitude e^(-kr)."
- (declare (gen ercos) (fm float))
- (- (/ (ercos-scaler gen)
- (- (ercos-cosh-t gen) (oscil (ercos-osc gen) fm)))
- (ercos-offset gen)))
+ (let ((documentation "(make-ercos frequency (r 0.5)) creates an ercos generator (a special case of rcos). (ercos gen (fm 0.0))
+returns many cosines from frequency with amplitude e^(-kr)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (- (/ scaler (polywave osc fm)) offset)))))
#|
+ (with-let gen
+ (- (/ scaler
+ (- cosh-t (oscil osc fm)))
+ offset)))
+
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-ercos 100 :r 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (ercos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (ercos gen)))))
|#
(definstrument (ercoser beg dur freq amp r)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (gen (make-ercos freq :r r))
- (t-env (make-env '(0 .1 1 2) :duration dur)))
- (run
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen (make-ercos freq :r r))
+ (t-env (make-env '(0 .1 1 2) :duration dur)))
+ (with-let
+ (varlet gen
+ (cons 'start start) (cons 'stop stop) (cons 'amp amp) (cons 't-env t-env) (cons 'gen gen))
(do ((i start (+ i 1)))
((= i stop))
- (set! (ercos-r gen) (env t-env))
- (set! (ercos-cosh-t gen) (cosh (ercos-r gen)))
- (let ((exp-t (exp (- (ercos-r gen)))))
- (set! (ercos-offset gen) (/ (- 1.0 exp-t) (* 2.0 exp-t)))
- (set! (ercos-scaler gen) (* (sinh (ercos-r gen)) (ercos-offset gen))))
+ (set! r (env t-env))
+ (set! cosh-t (cosh r))
+ (set! ((mus-data osc) 0) cosh-t)
+ (let ((exp-t (exp (- r))))
+ (set! offset (/ (- 1.0 exp-t) (* 2.0 exp-t)))
+ (set! scaler (* (sinh r) offset)))
(outa i (* amp (ercos gen)))))))
#|
+;;; same, but slightly slower
+(definstrument (ercoser beg dur freq amp r)
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (gen (make-ercos freq :r r))
+ (t-env (make-env '(0 .1 1 2) :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((r (env t-env)))
+ (set! (gen 'r) r)
+ (set! (gen 'cosh-t) (cosh r))
+ (set! ((mus-data (gen 'osc)) 0) (gen 'cosh-t))
+ (let ((exp-t (exp (- r))))
+ (set! (gen 'offset) (/ (- 1.0 exp-t) (* 2.0 exp-t)))
+ (set! (gen 'scaler) (* (sinh r) (gen 'offset))))
+ (outa i (* amp (ercos gen)))))))
+|#
+
+#|
;; change "t" during note -- smoothly changing sum-of-cosines spectra (damped "lute-stop" effect)
(with-sound (:play #t)
(ercoser 0 1 100 .5 0.1))
@@ -1914,223 +2030,233 @@
(defgenerator (erssb
:make-wrapper (lambda (g)
- (set! (erssb-frequency g) (hz->radians (erssb-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
-
-
-(define* (erssb gen (fm 0.0))
- " (make-erssb frequency (ratio 1.0) (r 0.5)) creates an erssb generator (a special case of rssb).\n\
- (erssb gen (fm 0.0)) returns many sinusoids from frequency spaced by frequency * ratio with amplitude e^(-kr)."
- (declare (gen erssb) (fm float))
- (let* ((cx (erssb-angle gen))
- (mx (* cx (erssb-ratio gen)))
- (cxx (- cx mx))
- (r (erssb-r gen))
- (ccmx (- (cosh r) (cos mx))))
-
- (set! (erssb-angle gen) (+ cx fm (erssb-frequency gen)))
-
- (if (< (abs ccmx) nearly-zero)
- 1.0
- (/ (- (* (cos cxx)
- (- (/ (sinh r) ccmx)
- 1.0))
- (* (sin cxx)
- (/ (sin mx) ccmx)))
- (* 2.0 (- (/ 1.0 (- 1.0 (exp (- r)))) 1.0)))))) ; normalization
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm)
+
+
+(define erssb
+
+ (let ((documentation "(make-erssb frequency (ratio 1.0) (r 0.5)) creates an erssb generator (a special case of rssb). (erssb gen (fm 0.0))
+returns many sinusoids from frequency spaced by frequency * ratio with amplitude e^(-kr)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio))
+ (cxx (- cx mx))
+ (ccmx (- (cosh r) (cos mx))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs ccmx) nearly-zero)
+ 1.0
+ (/ (- (* (cos cxx)
+ (- (/ (sinh r) ccmx)
+ 1.0))
+ (* (sin cxx)
+ (/ (sin mx) ccmx)))
+ (* 2.0 (- (/ 1.0 (- 1.0 (exp (- r)))) 1.0))))))))) ; normalization
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-erssb 1000.0 0.1 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (erssb gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (erssb gen)))))
|#
+
+
#|
;;; --------------------------------------------------------------------------------
;;; removed 8-May-08 -- not useful or different from (for example) rk!cos
;;; inf sinusoids scaled by r^2: r2cos, r2sin, r2ssb
-;;; Jolley 2nd col 2nd row (1st row is cos tweak of this)
+;;; Jolley second col second row (first row is cos tweak of this)
(defgenerator (r2sin
:make-wrapper (lambda (g)
- (set! (r2sin-frequency g) (hz->radians (r2sin-frequency g)))
- (if (>= (* (r2sin-r g) (r2sin-r g)) 1.0)
- (set! (r2sin-r g) 0.9999999))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (if (>= (* (g 'r) (g 'r)) 1.0)
+ (set! (g 'r) 0.9999999))
g))
- (frequency *clm-default-frequency*) (r 0.5) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (r 0.5) (angle 0.0) fm)
-(define* (r2sin gen (fm 0.0))
- " (make-r2sin frequency (r 0.5)) creates an r2sin generator.\n\
- (r2sin gen (fm 0.0)) returns many even-numbered sines from frequency with amplitude r^(2k)/(2k)!."
- (declare (gen r2sin) (fm float))
- (let* ((x (r2sin-angle gen))
- (r (r2sin-r gen)))
- (set! (r2sin-angle gen) (+ x fm (r2sin-frequency gen)))
+(define r2sin
- (* (sinh (* r (cos x)))
- (sin (* r (sin x))))))
+ (let ((documentation "(make-r2sin frequency (r 0.5)) creates an r2sin generator. (r2sin gen (fm 0.0))
+returns many even-numbered sines from frequency with amplitude r^(2k)/(2k)!."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle))
+ (set! angle (+ angle fm frequency))
+ (* (sinh (* r (cos x)))
+ (sin (* r (sin x)))))))))
;;; even harmonics, but we can't push the upper partials past the (2k)! range, so not very flexible
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-r2sin 100.0 :r 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (r2sin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (r2sin gen)))))
(defgenerator (r2cos
:make-wrapper (lambda (g)
- (set! (r2cos-frequency g) (hz->radians (r2cos-frequency g)))
- (if (>= (* (r2cos-r g) (r2sin-r g)) 1.0)
- (set! (r2cos-r g) 0.9999999))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (if (>= (* (g 'r) (g 'r)) 1.0)
+ (set! (g 'r) 0.9999999))
g))
- (frequency *clm-default-frequency*) (r 0.5) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (r 0.5) (angle 0.0) fm)
-(define* (r2cos gen (fm 0.0))
- " (make-r2cos frequency (r 0.5)) creates an r2cos generator.\n\
- (r2cos gen (fm 0.0)) returns many even-numbered cosines from frequency with amplitude r^(2k)/(2k)!."
- (declare (gen r2cos) (fm float))
- (let* ((x (r2cos-angle gen))
- (r (r2cos-r gen)))
- (set! (r2cos-angle gen) (+ x fm (r2cos-frequency gen)))
-
- (/ (- (* (cosh (* r (cos x)))
- (cos (* r (sin x))))
- 1.0) ; omit DC
- (- (cosh r) 1.0)))) ; normalize
+(define r2cos
+ (let ((documentation "(make-r2cos frequency (r 0.5)) creates an r2cos generator. (r2cos gen (fm 0.0))
+returns many even-numbered cosines from frequency with amplitude r^(2k)/(2k)!."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle))
+ (set! angle (+ angle fm frequency))
+ (/ (- (* (cosh (* r (cos x)))
+ (cos (* r (sin x))))
+ 1.0) ; omit DC
+ (- (cosh r) 1.0))))))) ; normalize
;;; odd harmonics, but we can't push the upper partials past the (2k)! range, so not very flexible
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-r2cos 100.0 :r 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (r2cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (r2cos gen)))))
(defgenerator (r2ssb
:make-wrapper (lambda (g)
- (set! (r2ssb-frequency g) (hz->radians (r2ssb-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm)
-(define* (r2ssb gen (fm 0.0))
- " (make-r2ssb frequency (ratio 1.0) (r 0.5)) creates an r2ssb generator.\n\
- (r2ssb gen (fm 0.0)) returns many even-numbered sinusoids from frequency spaced by frequency * ratio, if that makes any sense, with amplitude r^(2k)/(2k)!."
- (declare (gen r2ssb) (fm float))
- (let* ((cx (r2ssb-angle gen))
- (mx (* cx (r2ssb-ratio gen)))
- (a (r2ssb-r gen))
- (asinx (* a (sin mx)))
- (acosx (* a (cos mx))))
+(define r2ssb
- (set! (r2ssb-angle gen) (+ fm cx (r2ssb-frequency gen)))
-
- (/ (- (* (cos cx)
- (cosh acosx)
- (cos asinx))
- (* (sin cx)
- (sinh acosx)
- (sin asinx)))
- (cosh a)))) ; normalization
+ (let ((documentation "(make-r2ssb frequency (ratio 1.0) (r 0.5)) creates an r2ssb generator. (r2ssb gen (fm 0.0))
+returns many even-numbered sinusoids from frequency spaced by frequency * ratio, if that makes any sense, with amplitude r^(2k)/(2k)!."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio))
+ (a r)
+ (asinx (* a (sin mx)))
+ (acosx (* a (cos mx))))
+ (set! angle (+ angle fm frequency))
+ (/ (- (* (cos cx)
+ (cosh acosx)
+ (cos asinx))
+ (* (sin cx)
+ (sinh acosx)
+ (sin asinx)))
+ (cosh a))))))) ; normalization
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-r2ssb 1000.0 0.1 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (r2ssb gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (r2ssb gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-r2ssb 1000.0 0.1 0.5))
(vib (make-oscil 5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (r2ssb gen (* (hz->radians 100.0) (oscil vib))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (r2ssb gen (* (hz->radians 100.0) (oscil vib)))))))
|#
+
+
;;; --------------------------------------------------------------------------------
;;;
;;; inf odd cosines scaled by e^-r: eoddcos
-;;; Jolley 1st col 2nd row
+;;; Jolley first col second row
;;; heads toward a square wave as "r" -> 0.0 (odd harmonics, 1/k amp)
;;; this is the cos side of rkoddssb with r=e^-a
+(define eoddcos-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'osc)))
+ (lambda (g val) (set! (mus-frequency (g 'osc)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'osc)))
+ (lambda (g val) (set! (mus-phase (g 'osc)) val))))))
+
(defgenerator (eoddcos
:make-wrapper (lambda (g)
- (set! (eoddcos-osc g) (make-oscil (eoddcos-frequency g) (* 0.5 pi)))
+ (set! (g 'osc) (make-oscil (g 'frequency) (* 0.5 pi)))
g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (eoddcos-osc g)))
- (lambda (g val) (set! (mus-frequency (eoddcos-osc g)) val) val))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (eoddcos-osc g)))
- (lambda (g val) (set! (mus-phase (eoddcos-osc g)) val) val))))
- (frequency *clm-default-frequency*) (r 1.0)
- (osc #f :type clm))
-
-
-(define* (eoddcos gen (fm 0.0))
- " (make-eoddcos frequency (r 0.5)) creates an eoddcos generator.\n\
- (eoddcos gen (fm 0.0)) returns many cosines from spaced by frequency with amplitude e^(-r)."
- (declare (gen eoddcos) (fm float))
- (let* ((a (eoddcos-r gen))
- (sinha (sinh a)))
- (/ (atan (/ (oscil (eoddcos-osc gen) fm) sinha))
- (atan (/ 1.0 sinha))))) ; normalization
+ :methods eoddcos-methods)
+ (frequency *clm-default-frequency*) (r 1.0) fm
+ (osc #f))
+
+(define eoddcos
+
+ (let ((documentation "(make-eoddcos frequency (r 0.5)) creates an eoddcos generator. (eoddcos gen (fm 0.0))
+returns many cosines from spaced by frequency with amplitude e^(-r)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((a r)
+ (sinha (sinh a)))
+ (if (zero? sinha)
+ 0.0 ; just a guess
+ (/ (atan (oscil osc fm) sinha)
+ (atan 1.0 sinha)))))))) ; normalization
+
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-eoddcos 400.0 :r 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (eoddcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (eoddcos gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-eoddcos 400.0 :r 0.0))
(a-env (make-env '(0 0 1 1) :length 10000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (set! (eoddcos-r gen) (env a-env))
- (outa i (eoddcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (set! (gen 'r) (env a-env))
+ (outa i (eoddcos gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen1 (make-eoddcos 400.0 :r 0.0))
(gen2 (make-oscil 400.0))
(a-env (make-env '(0 0 1 1) :length 10000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (set! (eoddcos-r gen1) (env a-env))
- (outa i (* .5 (eoddcos gen1 (* .1 (oscil gen2)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (set! (gen 'r1) (env a-env))
+ (outa i (* .5 (eoddcos gen1 (* .1 (oscil gen2))))))))
|#
@@ -2140,27 +2266,26 @@
;;; inf odd cosines scaled by complicated mess: koddcos
-;;; Jolley 1st col 5th row
+;;; Jolley first col 5th row
(define make-koddcos make-oscil)
-(define* (koddcos gen (fm 0.0))
- " (make-koddcos frequency) creates a koddcos generator.\n\
- (koddcos gen (fm 0.0)) returns many cosines from spaced by frequency with amplitude too messy to write down, and the output looks wrong anyway."
- (declare (gen clm) (fm float))
- (let ((arg (* 2.0 (oscil gen fm))))
- (if (>= arg 0.0)
- (/ (acos (- 1.0 arg)) pi)
- (/ (acos (+ 1.0 arg)) (- pi)))))
+(define koddcos
+ (let ((documentation "(make-koddcos frequency) creates a koddcos generator. (koddcos gen (fm 0.0))
+returns many cosines from spaced by frequency with amplitude too messy to write down, and the output looks wrong anyway."))
+
+ (lambda* (gen (fm 0.0))
+ (let ((arg (* 2.0 (oscil gen fm))))
+ (if (>= arg 0.0)
+ (/ (acos (- 1.0 arg)) pi)
+ (/ (acos (+ 1.0 arg)) (- pi)))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-koddcos 400.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (* .3 (koddcos gen)))))))
-
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .3 (koddcos gen))))))
;;; as printed in J, this is not usable -- 1-2sin can be 3 so acos will be complex -- looks like we're missing: x < pi
;;; we get odd harmonics but wrong amps
@@ -2172,135 +2297,143 @@
;;; inf cosines scaled by r^k/k: rkcos, rksin, rkssb
-;;; G&R 2nd col 6th row, also J 536
+;;; G&R second col 6th row, also J 536
;;; r^k/k -- this sums to ln(1/(1-x)) if x<1 (J 118)
+(define rkcos-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'osc)))
+ (lambda (g val) (set! (mus-frequency (g 'osc)) val))))
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val) (set! (g 'r) (generator-clamp-r val)))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'osc)))
+ (lambda (g val) (set! (mus-phase (g 'osc)) val))))))
+
(defgenerator (rkcos
:make-wrapper (lambda (g)
- (set! (rkcos-osc g) (make-oscil (rkcos-frequency g) (* 0.5 pi)))
- (set! (rkcos-r g) (generator-clamp-r (rkcos-r g))) ; or clip at 0.0?
+ (set! (g 'osc) (make-oscil (g 'frequency) (* 0.5 pi)))
+ (set! (g 'r) (generator-clamp-r (g 'r))) ; or clip at 0.0?
+ (set! (g 'norm) (log (- 1.0 (abs (g 'r)))))
g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (rkcos-osc g)))
- (lambda (g val) (set! (mus-frequency (rkcos-osc g)) val) val))
-
- (list 'mus-scaler
- (lambda (g) (rkcos-r g))
- (lambda (g val)
- (set! (rkcos-r g) (generator-clamp-r val))
- (rkcos-r g)))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (rkcos-osc g)))
- (lambda (g val) (set! (mus-phase (rkcos-osc g)) val) val))))
- (frequency *clm-default-frequency*) (r 0.5)
- (osc #f :type clm))
+ :methods rkcos-methods)
+ (frequency *clm-default-frequency*) (r 0.5) norm fm
+ (osc #f))
;;; not very flexible, and very similar to others in the r^k mold
-(define* (rkcos gen (fm 0.0))
- " (make-rkcos frequency (r 0.5)) creates an rkcos generator.\n\
- (rkcos gen (fm 0.0)) returns many cosines from spaced by frequency with amplitude (r^k)/k."
- (declare (gen rkcos) (fm float))
- (let ((cs (oscil (rkcos-osc gen) fm))
- (r (rkcos-r gen)))
- (/ (* 0.5 (log (+ 1.0 (* -2.0 r cs) (* r r))))
- (log (- 1.0 (abs r)))))) ; norm
+(define rkcos
+
+ (let ((documentation "(make-rkcos frequency (r 0.5)) creates an rkcos generator. (rkcos gen (fm 0.0))
+returns many cosines from spaced by frequency with amplitude (r^k)/k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((cs (oscil osc fm)))
+ (/ (* 0.5 (log (+ 1.0 (* -2.0 r cs) (* r r))))
+ norm))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-rkcos 440.0 :r 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rkcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (rkcos gen)))))
|#
+(define rksin-methods
+ (list
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val) (set! (g 'r) (generator-clamp-r val)))))))
+
(defgenerator (rksin
:make-wrapper (lambda (g)
- (set! (rksin-frequency g) (hz->radians (rksin-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g)
- :methods (list
- (list 'mus-scaler
- (lambda (g) (rksin-r g))
- (lambda (g val)
- (set! (rksin-r g) (generator-clamp-r val))
- (rksin-r g)))))
-
- (frequency *clm-default-frequency*) (r 0.5) (angle 0.0))
+ :methods rksin-methods)
+ (frequency *clm-default-frequency*) (r 0.5) (angle 0.0) fm)
;;; normalization based on 0 of derivative of atan arg (for max) at cos x = r,
;;; so we get a maxamp here of (atan (/ (* r (sin (acos r))) (- 1.0 (* r r))))
+(define rksin
-(define* (rksin gen (fm 0.0))
- " (make-rksin frequency (r 0.5)) creates an rksin generator.\n\
- (rksin gen (fm 0.0)) returns many sines from spaced by frequency with amplitude (r^k)/k."
- (declare (gen rksin) (fm float))
- (let* ((x (rksin-angle gen))
- (r (rksin-r gen)))
-
- (set! (rksin-angle gen) (+ fm x (rksin-frequency gen)))
-
- (/ (atan (/ (* r (sin x))
- (- 1.0 (* r (cos x)))))
- (atan (/ (* r (sin (acos r))) ; normalization
- (- 1.0 (* r r)))))))
+ (let ((documentation "(make-rksin frequency (r 0.5)) creates an rksin generator. (rksin gen (fm 0.0))
+returns many sines from spaced by frequency with amplitude (r^k)/k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (/ (atan (* r (sin x))
+ (- 1.0 (* r (cos x))))
+ (atan (* r (sin (acos r))) ; normalization
+ (- 1.0 (* r r)))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-rksin 100.0 :r 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rksin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (rksin gen)))))
|#
+
+
+(define rkssb-methods
+ (list
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val) (set! (g 'r) (generator-clamp-r val)))))))
+
(defgenerator (rkssb
:make-wrapper (lambda (g)
- (set! (rkssb-frequency g) (hz->radians (rkssb-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g)
- :methods (list
- (list 'mus-scaler
- (lambda (g) (rkssb-r g))
- (lambda (g val)
- (set! (rkssb-r g) (generator-clamp-r val))
- (rkssb-r g)))))
-
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
-
-
-(define* (rkssb gen (fm 0.0))
- " (make-rkssb frequency (ratio 1.0) (r 0.5)) creates an rkssb generator.\n\
- (rkssb gen (fm 0.0)) returns many sinusoids from frequency from spaced by frequency * ratio with amplitude (r^k)/k."
- (declare (gen rkssb) (fm float))
- (let* ((cx (rkssb-angle gen))
- (mx (* cx (rkssb-ratio gen)))
- (cxx (* (- 1.0 (rkssb-ratio gen)) cx))
- (r (rkssb-r gen))
- (rcosmx (* r (cos mx))))
-
- (set! (rkssb-angle gen) (+ cx fm (rkssb-frequency gen)))
-
- (/ (- (* (cos cxx)
- -0.5 (log (+ 1.0 (* -2.0 rcosmx) (* r r))))
- (* (sin cxx)
- (atan (/ (* r (sin mx))
- (- 1.0 rcosmx)))))
- (- (log (- 1.0 (abs r))))))) ; normalization
+ :methods rkssb-methods)
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm)
+
+
+(define rkssb
+
+ (let ((documentation "(make-rkssb frequency (ratio 1.0) (r 0.5)) creates an rkssb generator. (rkssb gen (fm 0.0))
+returns many sinusoids from frequency from spaced by frequency * ratio with amplitude (r^k)/k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio))
+ (cxx (* (- 1.0 ratio) cx))
+ (rcosmx (* r (cos mx))))
+ (set! angle (+ angle fm frequency))
+ (/ (- (* (cos cxx)
+ -0.5 (log (+ 1.0 (* -2.0 rcosmx) (* r r))))
+ (* (sin cxx)
+ (atan (* r (sin mx))
+ (- 1.0 rcosmx))))
+ (- (log (- 1.0 (abs r)))))))))) ; normalization
#|
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-rkssb 1000.0 0.5 :r 0.75)) ; (make-rkssb 300.0 3.0 :r 0.5)
(ampf (make-env '(0 0 1 1 2 1 3 0) :length 20000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (* (env ampf)
- (rkssb gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (* (env ampf)
+ (rkssb gen))))))
|#
@@ -2309,36 +2442,45 @@
;;; inf cosines scaled by r^k/k!: rk!cos, rk!ssb
-;;; G&R 2nd col 3rd from last (simplified)
+;;; G&R second col third from last (simplified)
+
+(define rk!cos-methods
+ (list
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (g 'angle))
+ (lambda (g val) (set! (g 'angle) val))))))
(defgenerator (rk!cos
:make-wrapper (lambda (g)
- (set! (rk!cos-frequency g) (hz->radians (rk!cos-frequency g)))
- g))
- (frequency *clm-default-frequency*) (r 0.5) (angle 0.0))
-
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'norm) (/ 1.0 (- (exp (abs r)) 1.0)))
+ g)
+ :methods rk!cos-methods)
+ (frequency *clm-default-frequency*) (r 0.5) (angle 0.0) fm norm)
-(define* (rk!cos gen (fm 0.0))
- " (make-rk!cos frequency (r 0.5)) creates an rk!cos generator.\n\
- (rk!cos gen (fm 0.0)) returns many cosines spaced by frequency with amplitude (r^k)/k!."
- (declare (gen rk!cos) (fm float))
- (let* ((r (rk!cos-r gen))
- (x (rk!cos-angle gen)))
- (set! (rk!cos-angle gen) (+ fm x (rk!cos-frequency gen)))
+(define rk!cos
- (/ (- (* (exp (* r (cos x)))
- (cos (* r (sin x))))
- 1.0) ; omit DC
- (- (exp (abs r)) 1.0)))) ; normalization
+ (let ((documentation "(make-rk!cos frequency (r 0.5)) creates an rk!cos generator. (rk!cos gen (fm 0.0))
+returns many cosines spaced by frequency with amplitude (r^k)/k!."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (* (- (* (exp (* r (cos x)))
+ (cos (* r (sin x))))
+ 1.0) ; omit DC
+ norm))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-rk!cos 440.0 :r 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rk!cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (rk!cos gen))))))
|#
;;; the k! denominator dominates, so r * ratio = formant center approximately; (n!)^(1/n)
@@ -2349,129 +2491,125 @@
(let ((gen (make-rk!cos 100.0 :r 40.0))
(r 40.0)
(incr (/ -40.0 100000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 100000))
- (set! (rk!cos-r gen) r)
- (set! r (+ r incr))
- (outa i (rk!cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (set! (gen 'r) r)
+ (set! r (+ r incr))
+ (outa i (rk!cos gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-rk!cos 300.0 :r 10.0))
(ampf (make-env '(0 0 .1 1 .2 1 3 .5 5 .25 10 0) :scaler .5 :length 10000))
(r 10.0)
(incr (/ -10.0 10000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (set! (rk!cos-r gen) r)
- (set! r (+ r incr))
- (outa i (* (env ampf) (rk!cos gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (set! (gen 'r) r)
+ (set! r (+ r incr))
+ (outa i (* (env ampf) (rk!cos gen))))))
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-rk!cos 1000.0 :r 8.0))
(frqf (make-env '(0 1 1 0) :base 32 :scaler (hz->radians 1000) :length 10000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rk!cos gen (env frqf)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (rk!cos gen (env frqf))))))
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-rk!cos 3000.0 :r 1.0)) (ampf (make-env '(0 0 1 1 10 1 11 0) :length 10000))
(frqf (make-env '(0 1 1 0 2 .25 3 0) :base 3 :scaler (hz->radians 2000) :length 10000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (* (env ampf) (rk!cos gen (env frqf))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* (env ampf) (rk!cos gen (env frqf)))))))
(with-sound (:play #t :scaled-to .5)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 6))
(let ((gen (make-rk!cos 3000.0 :r 0.6)) (ampf (make-env '(0 0 1 1 2 1 3 0) :length 3000))
(frqf (make-env '(0 0 1 1) :base .1 :scaler (hz->radians 2000) :length 3000))) ; '(0 .5 1 1 2 0 3 0) '(0 1 1 0 2 1 6 -1)
- (run
- (do ((i 0 (+ i 1)))
- ((= i 3000))
- (outa (+ i (* k 4000))
- (* (env ampf)
- (rk!cos gen (env frqf)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (outa (+ i (* k 4000))
+ (* (env ampf)
+ (rk!cos gen (env frqf))))))))
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 6))
(let ((gen (make-rk!cos 1000.0 :r 1.0)) (ampf (make-env '(0 0 1 1 2 1 3 0) :length 3000))
(frqf (make-env '(0 .9 1 1 2 -1) :base .1 :scaler (hz->radians 500) :length 3000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 3000))
- (outa (+ i (* k 10000)) (* (env ampf) (rk!cos gen (env frqf)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (outa (+ i (* k 10000)) (* (env ampf) (rk!cos gen (env frqf))))))))
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 6))
(let ((gen (make-rk!cos 500.0 :r 1.5)) (ampf (make-env '(0 0 1 1 2 1 3 0) :length 3000))
(frqf (make-env '(0 1 1 1 2 -1) :base .5 :scaler (hz->radians 400) :length 3000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 3000))
- (outa (+ i (* k 10000)) (* (env ampf) (rk!cos gen (env frqf)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (outa (+ i (* k 10000)) (* (env ampf) (rk!cos gen (env frqf))))))))
|#
(defgenerator (rk!ssb
:make-wrapper (lambda (g)
- (set! (rk!ssb-frequency g) (hz->radians (rk!ssb-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (r 1.0) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 1.0) (angle 0.0) fm)
-(define* (rk!ssb gen (fm 0.0))
- " (make-rk!ssb frequency (ratio 1.0) (r 0.5)) creates an rk!ssb generator.\n\
- (rk!ssb gen (fm 0.0)) returns many sinusoids from frequency spaced by frequency * ratio with amplitude (r^k)/k!."
- (declare (gen rk!ssb) (fm float))
- (let* ((cx (rk!ssb-angle gen))
- (mx (* cx (rk!ssb-ratio gen)))
- (r (rk!ssb-r gen))
- (ercosmx (exp (* r (cos mx))))
- (rsinmx (* r (sin mx))))
+(define rk!ssb
- (set! (rk!ssb-angle gen) (+ fm cx (rk!ssb-frequency gen)))
+ (let ((documentation "(make-rk!ssb frequency (ratio 1.0) (r 0.5)) creates an rk!ssb generator. (rk!ssb gen (fm 0.0))
+returns many sinusoids from frequency spaced by frequency * ratio with amplitude (r^k)/k!."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio))
+ (ercosmx (exp (* r (cos mx))))
+ (rsinmx (* r (sin mx))))
+ (set! angle (+ angle fm frequency))
+ (/ (- (* (cos cx) ercosmx (cos rsinmx))
+ (* (sin cx) ercosmx (sin rsinmx)))
+ (exp (abs r)))))))) ; normalization (keeping DC term here to get "carrier")
- (/ (- (* (cos cx) ercosmx (cos rsinmx))
- (* (sin cx) ercosmx (sin rsinmx)))
- (exp (abs r))))) ; normalization (keeping DC term here to get "carrier")
-
#|
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-rk!ssb 1000.0 0.1 :r 0.5)) ; (make-rk!ssb 200.0 3.0 :r 2)
(ampf (make-env '(0 0 1 1 2 1 3 0) :length 20000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (* (env ampf) (rk!ssb gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (* (env ampf) (rk!ssb gen))))))
-; (make-rk!ssb 0.0 120.0 :r 15) gives a widely separated wave-train of pulses
-; so (make-rk!ssb 0.0 40.0 :r 70) is insecty (:r 100)
-; (make-rk!ssb 0.0 10.0 :r 100) -- some bird? (make-rk!ssb 0.0 15.0 :r 300)
-; (make-rk!ssb 1000.0 25.0 :r 10) (make-rk!ssb 3000.0 25.0 :r 100) -- another bird (5000)
+ ; (make-rk!ssb 0.0 120.0 :r 15) gives a widely separated wave-train of pulses
+ ; so (make-rk!ssb 0.0 40.0 :r 70) is insecty (:r 100)
+ ; (make-rk!ssb 0.0 10.0 :r 100) -- some bird? (make-rk!ssb 0.0 15.0 :r 300)
+ ; (make-rk!ssb 1000.0 25.0 :r 10) (make-rk!ssb 3000.0 25.0 :r 100) -- another bird (5000)
|#
(definstrument (bouncy beg dur freq amp (bounce-freq 5) (bounce-amp 20))
- (let* ((gen (make-rk!ssb (* freq 4) 1/4 :r 1.0))
- (gen1 (make-oscil bounce-freq))
- (bouncef (make-env '(0 1 1 0) :base 32 :scaler bounce-amp :duration 1.0))
- (rf (make-env (list 0 0 1 1 (max 2.0 dur) 0) :base 32 :scaler 3 :duration dur))
- (ampf (make-env (list 0 0 .01 1 .03 1 1 .15 (max 2 dur) 0.0) :base 32 :scaler amp :duration dur))
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (set! (rk!ssb-r gen) (+ (abs (* (env bouncef)
- (oscil gen1)))
- (env rf)))
- (outa i (* (env ampf)
- (rk!ssb gen)))))))
+ (let ((len (seconds->samples dur))
+ (start (seconds->samples beg)))
+ (let ((gen (make-rk!ssb (* freq 4) 1/4 :r 1.0))
+ (gen1 (make-oscil bounce-freq))
+ (bouncef (make-env '(0 1 1 0) :base 32 :scaler bounce-amp :duration 1.0))
+ (rf (make-env (list 0 0 1 1 (max 2.0 dur) 0) :base 32 :scaler 3 :duration dur))
+ (ampf (make-env (list 0 0 .01 1 .03 1 1 .15 (max 2 dur) 0.0) :base 32 :scaler amp :duration dur))
+ (stop (+ start len))
+ (fv (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! fv i (+ (env rf) (abs (* (env bouncef) (oscil gen1))))))
+ (do ((i start (+ i 1))
+ (j 0 (+ j 1)))
+ ((= i stop))
+ (set! (gen 'r) (float-vector-ref fv j))
+ (outa i (* (env ampf)
+ (rk!ssb gen)))))))
#|
(with-sound (:statistics #t :play #t :clipped #f)
@@ -2483,108 +2621,105 @@
+#|
;;; --------------------------------------------------------------------------------
;;; rxyk!cos
+;;; moved to clm.c 18-Apr-13)
(defgenerator (rxyk!sin
:make-wrapper (lambda (g)
- (set! (rxyk!sin-frequency g) (hz->radians (rxyk!sin-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm)
-(define* (rxyk!sin gen (fm 0.0))
- " (make-rxyk!sin frequency (ratio 1.0) (r 0.5)) creates an rxyk!sin generator.\n\
- (rxyk!sin gen (fm 0.0)) returns many sines from frequency spaced by frequency * ratio with amplitude r^k/k!."
- (declare (gen rxyk!sin) (fm float))
- (let* ((x (rxyk!sin-angle gen))
- (y (* x (rxyk!sin-ratio gen)))
- (r (rxyk!sin-r gen)))
- (set! (rxyk!sin-angle gen) (+ x fm (rxyk!sin-frequency gen)))
+(define rxyk!sin
+
+ (let ((documentation "(make-rxyk!sin frequency (ratio 1.0) (r 0.5)) creates an rxyk!sin generator. (rxyk!sin gen (fm 0.0))
+returns many sines from frequency spaced by frequency * ratio with amplitude r^k/k!."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio)))
+ (set! angle (+ angle fm frequency))
+ (/ (* (exp (* r (cos y)))
+ (sin (+ x (* r (sin y))))) ; was cos by mistake (18-Apr-13)
+ (exp (abs r))))))))
- (/ (* (exp (* r (cos y)))
- (cos (+ x (* r (sin y)))))
- (exp (abs r)))))
-#|
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-rxyk!sin 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rxyk!sin gen))))))
-|#
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (rxyk!sin gen)))))
+
(defgenerator (rxyk!cos
:make-wrapper (lambda (g)
- (set! (rxyk!cos-frequency g) (hz->radians (rxyk!cos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'ar) (/ 1.0 (exp (abs (g 'r)))))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm ar)
-(define* (rxyk!cos gen (fm 0.0))
- " (make-rxyk!cos frequency (ratio 1.0) (r 0.5)) creates an rxyk!cos generator.\n\
- (rxyk!cos gen (fm 0.0)) returns many cosines from frequency spaced by frequency * ratio with amplitude r^k/k!."
- (declare (gen rxyk!cos) (fm float))
- (let* ((x (rxyk!cos-angle gen))
- (y (* x (rxyk!cos-ratio gen)))
- (r (rxyk!cos-r gen)))
+(define rxyk!cos
- (set! (rxyk!cos-angle gen) (+ x fm (rxyk!cos-frequency gen)))
+ (let ((documentation "(make-rxyk!cos frequency (ratio 1.0) (r 0.5)) creates an rxyk!cos generator. (rxyk!cos gen (fm 0.0))
+returns many cosines from frequency spaced by frequency * ratio with amplitude r^k/k!."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio)))
+ (set! angle (+ angle fm frequency))
+ (* (exp (* r (cos y)))
+ (cos (+ x (* r (sin y))))
+ ar))))))
- (/ (* (exp (* r (cos y)))
- (cos (+ x (* r (sin y)))))
- (exp (abs r)))))
-#|
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-rxyk!cos 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rxyk!cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (rxyk!cos gen)))))
|#
+
(definstrument (brassy beg dur freq amp ampf freqf gliss)
- (let* ((base-freq freq)
- (gen (make-rxyk!cos base-freq :r 0.0))
- (start (seconds->samples beg))
- (samps (seconds->samples dur))
- (stop (+ start samps))
- (amp-env (make-env ampf :duration dur :scaler amp))
- (pitch-env (make-env freqf :scaler gliss :duration dur))
- (pitch-time .05)
- (slant (make-moving-average (seconds->samples pitch-time)))
- (amp-time .1)
- (vib (make-oscil 5))
- (vib-index (hz->radians 4.0))
- )
- (run
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (let* ((pitch (env pitch-env))
- (harmfrq (/ pitch base-freq))
- (harmonic (floor harmfrq))
- (dist (abs (- harmfrq harmonic)))
- (frq (* base-freq (moving-average slant harmonic))))
- (set! (rxyk!cos-r gen) (* (/ 1.0 amp-time)
- 2.0
- (if (< dist amp-time)
- dist
- (if (> dist (- 1.0 amp-time))
- (- 1.0 dist)
- amp-time))))
- (outa i (* (env amp-env)
- (rxyk!cos gen (+ (hz->radians frq)
- (* vib-index (oscil vib)))))))))))
+ (let ((pitch-time .05)
+ (amp-time .1))
+ (let ((gen (make-rxyk!cos freq :r 0.0))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (amp-env (make-env ampf :duration dur :scaler amp))
+ (pitch-env (make-env freqf :scaler (/ gliss freq) :duration dur))
+ (slant (make-moving-average (seconds->samples pitch-time)))
+ (vib (make-polywave 5 (list 1 (hz->radians 4.0)) mus-chebyshev-second-kind))
+ (harmfrq 0.0)
+ (harmonic 0)
+ (dist 0.0))
+ (set! (mus-increment slant) (* (hz->radians freq) (mus-increment slant)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (set! harmfrq (env pitch-env))
+ (set! harmonic (floor harmfrq))
+ (set! dist (abs (- harmfrq harmonic)))
+ (set! (mus-scaler gen) (* 20.0 (min amp-time dist (- 1.0 dist))))
+ (outa i (* (env amp-env)
+ (rxyk!cos gen (+ (moving-average slant harmonic)
+ (polywave vib)))))))))
#|
(with-sound (:statistics #t :play #t)
- (brassy 0 4 50 .5 '(0 0 1 1 10 1 11 0) '(0 1 1 0) 1000))
+ (brassy 0 4 50 .05 '(0 0 1 1 10 1 11 0) '(0 1 1 0) 1000))
|#
+
+
;;; --------------------------------------------------------------------------------
;;; inf cosines scaled by complicated mess: r2k!cos
@@ -2594,88 +2729,103 @@
;;; this gives a sum of cosines of decreasing amp where the "k" parameter determines
;;; the "index" (in FM nomenclature) -- higher k = more cosines
+(define r2k!cos-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'osc)))
+ (lambda (g val) (set! (mus-frequency (g 'osc)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'osc)))
+ (lambda (g val) (set! (mus-phase (g 'osc)) val))))
+ (cons 'mus-copy copy)))
+
(defgenerator (r2k!cos
:make-wrapper (lambda (g)
- (set! (r2k!cos-osc g) (make-oscil (r2k!cos-frequency g)))
+ (set! (g 'rr1) (+ 1.0 (* (g 'r) (g 'r))))
+ (set! (g 'r2) (* 2.0 (abs (g 'r))))
+ (set! (g 'norm) (expt (- (g 'rr1) (g 'r2)) (g 'k)))
+ (set! (g 'osc) (make-polywave (g 'frequency) (list 0 (g 'rr1) 1 (- (g 'r2))) mus-chebyshev-second-kind))
+ (set! (g 'k) (- (g 'k)))
g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (r2k!cos-osc g)))
- (lambda (g val) (set! (mus-frequency (r2k!cos-osc g)) val) val))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (r2k!cos-osc g)))
- (lambda (g val) (set! (mus-phase (r2k!cos-osc g)) val) val))))
- (frequency *clm-default-frequency*) (r 0.5) (k 0.0)
- (osc #f :type clm))
-
-
-(define* (r2k!cos gen (fm 0.0))
- " (make-2rk!cos frequency (r 0.5) (k 0.0)) creates an r2k!cos generator.\n\
- (r2k!cos gen (fm 0.0)) returns many cosines spaced by frequency with amplitude too messy to write down."
- (declare (gen r2k!cos) (fm float))
- (let* ((r (r2k!cos-r gen))
- (k (r2k!cos-k gen))
- (rr1 (+ 1.0 (* r r)))
- (r2 (* 2 (abs r)))) ; abs for negative r
- (* (expt (- rr1
- (* r2 (oscil (r2k!cos-osc gen) fm)))
- (- k))
- (expt (- rr1 r2) k)))) ; amplitude normalization
+ :methods r2k!cos-methods)
+ (frequency *clm-default-frequency*) (r 0.5) (k 0.0) rr1 r2 norm fm
+ (osc #f))
+
+
+(define r2k!cos
+
+ (let ((documentation "(make-2rk!cos frequency (r 0.5) (k 0.0)) creates an r2k!cos generator. (r2k!cos gen (fm 0.0))
+returns many cosines spaced by frequency with amplitude too messy to write down."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (* (expt (polywave osc fm) k) norm)))))
+
+#|
+ ;;; old form
+ (with-let gen
+ (let ((rr1 (+ 1.0 (* r r)))
+ (r2 (* 2 (abs r)))) ; abs for negative r
+ (* (expt (- rr1
+ (* r2 (oscil osc fm)))
+ (- k))
+ (expt (- rr1 r2) k))))) ; amplitude normalization
+|#
;;; there is still noticable DC offset if r != 0.5 -- could precompute it and subtract (and there's lots of DC anyway)
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-r2k!cos 440.0 :r 0.5 :k 3.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (r2k!cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (r2k!cos gen)))))
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-r2k!cos 440.0 :r 0.5 :k 3.0))
(indf (make-env '(0 1 1 0 10 0) :length 80000 :scaler 10.0 :offset 1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 80000))
- (set! (r2k!cos-k gen) (env indf))
- (outa i (r2k!cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 80000))
+ (set! (gen 'k) (env indf))
+ (outa i (r2k!cos gen)))))
|#
(definstrument (pianoy beg dur freq amp)
- (let* ((gen (make-r2k!cos freq :r 0.5 :k 3.0))
+ (let ((gen (make-r2k!cos freq :r 0.5 :k 3.0))
(ampf (make-env (list 0 0 .01 1 .03 1 1 .15 (max 2 dur) 0.0) :base 32 :scaler amp :duration dur))
(start (seconds->samples beg))
- (stop (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (outa i (* (env ampf)
- (r2k!cos gen)))))))
+ (stop (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (outa i (* (env ampf)
+ (r2k!cos gen))))))
-#|
-(with-sound (:statistics #t :play #t :clipped #f)
- (pianoy 0 3 100 .5))
+;;; (with-sound (:statistics #t :play #t :clipped #f) (pianoy 0 3 100 .5))
;;; this can be combined with bouncy-like changes to get an evolving sound
-|#
(definstrument (pianoy1 beg dur freq amp (bounce-freq 5) (bounce-amp 20))
- (let* ((gen (make-r2k!cos freq :r 0.5 :k 3.0))
- (gen1 (make-oscil bounce-freq))
- (bouncef (make-env '(0 1 1 0) :base 32 :scaler bounce-amp :duration 1.0))
- (rf (make-env (list 0 0 1 1 (max 2.0 dur) 0) :base 32 :scaler .1 :duration dur))
- (ampf (make-env (list 0 0 .01 1 .03 1 1 .15 (max 2 dur) 0.0) :base 32 :scaler amp :duration dur))
- (start (seconds->samples beg))
- (stop (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (set! (r2k!cos-r gen) (+ .25 (abs (* (env bouncef)
- (oscil gen1)))
- (env rf)))
- (outa i (* (env ampf)
- (r2k!cos gen)))))))
+ (let ((len (seconds->samples dur))
+ (start (seconds->samples beg)))
+ (let ((gen (make-r2k!cos freq :r 0.5 :k 3.0))
+ (gen1 (make-oscil bounce-freq))
+ (bouncef (make-env '(0 1 1 0) :base 32 :scaler bounce-amp :duration 1.0))
+ (rf (make-env (list 0 0 1 1 (max 2.0 dur) 0) :base 32 :scaler .1 :offset .25 :duration dur))
+ (ampf (make-env (list 0 0 .01 1 .03 1 1 .15 (max 2 dur) 0.0) :base 32 :scaler amp :duration dur))
+ (stop (+ start len))
+ (fv (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! fv i (+ (env rf) (abs (* (env bouncef) (oscil gen1))))))
+
+ (do ((i start (+ i 1))
+ (j 0 (+ j 1)))
+ ((= i stop))
+ (set! (gen 'r) (float-vector-ref fv j))
+ (outa i (* (env ampf)
+ (r2k!cos gen)))))))
#|
(with-sound (:statistics #t :play #t :clipped #f)
@@ -2683,21 +2833,20 @@
|#
(definstrument (pianoy2 beg dur freq amp)
- (let* ((gen (make-r2k!cos freq :r 0.5 :k 3.0))
+ (let ((gen (make-r2k!cos freq :r 0.5 :k 3.0))
(ampf (make-env (list 0 0 .01 1 .03 1 1 .15 (max 2 dur) 0.0) :base 32 :scaler amp :duration dur))
(knock (make-fmssb 10.0 20.0 :index 1.0))
(kmpf (make-env '(0 0 1 1 3 1 100 0) :base 3 :scaler .05 :length 30000))
(indf (make-env '(0 1 1 0) :length 30000 :base 3 :scaler 10))
(start (seconds->samples beg))
- (stop (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (set! (fmssb-index knock) (env indf))
- (outa i (+ (* (env ampf)
- (r2k!cos gen))
- (* (env kmpf)
- (fmssb knock 0.0))))))))
+ (stop (seconds->samples (+ beg dur))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (set! (knock 'index) (env indf))
+ (outa i (+ (* (env ampf)
+ (r2k!cos gen))
+ (* (env kmpf)
+ (fmssb knock 0.0)))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
@@ -2709,97 +2858,101 @@
;;; inf sines scaled by 1/2^k: k2sin
-;;; Jolley 1st col 1st row
+;;; Jolley first col first row
;;; not flexible -- very similar to several others
(defgenerator (k2sin
:make-wrapper (lambda (g)
- (set! (k2sin-frequency g) (hz->radians (k2sin-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (angle 0.0))
+ (frequency *clm-default-frequency*) (angle 0.0) fm)
-(define* (k2sin gen (fm 0.0))
- " (make-k2sin frequency) creates a k2sin generator.\n\
- (k2sin gen (fm 0.0)) returns many sines spaced by frequency with amplitude 1/(2^k)."
- (declare (gen k2sin) (fm float))
- (let ((x (k2sin-angle gen)))
+(define k2sin
- (set! (k2sin-angle gen) (+ x fm (k2sin-frequency gen)))
-
- (/ (* 3.0 (sin x)) ; 3 rather than 4 for normalization
- (- 5.0 (* 4.0 (cos x))))))
+ (let ((documentation "(make-k2sin frequency) creates a k2sin generator. (k2sin gen (fm 0.0))
+returns many sines spaced by frequency with amplitude 1/(2^k)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (/ (* 3.0 (sin x)) ; 3 rather than 4 for normalization
+ (- 5.0 (* 4.0 (cos x)))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-k2sin 440.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (k2sin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (k2sin gen)))))
|#
-;;; using the 2nd Sansone formula, we get the sum of cos case by using a=-5b/4 or 3/(4cosx-5)
+
+;;; using the second Sansone formula, we get the sum of cos case by using a=-5b/4 or 3/(4cosx-5)
(defgenerator (k2cos
:make-wrapper (lambda (g)
- (set! (k2cos-frequency g) (hz->radians (k2cos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (angle 0.0) fm)
-(define* (k2cos gen (fm 0.0))
- " (make-k2cos frequency) creates a k2cos generator.\n\
- (k2cos gen (fm 0.0)) returns many cosines spaced by frequency with amplitude 1/(2^k)."
- (declare (gen k2cos) (fm float))
- (let ((x (k2cos-angle gen)))
- (set! (k2cos-angle gen) (+ x fm (k2cos-frequency gen)))
+(define k2cos
- (* 0.5 (- (/ 3.0
- (- 5.0 (* 4.0 (cos x))))
- 1.0))))
+ (let ((documentation "(make-k2cos frequency) creates a k2cos generator. (k2cos gen (fm 0.0))
+returns many cosines spaced by frequency with amplitude 1/(2^k)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (* 0.5 (- (/ 3.0
+ (- 5.0 (* 4.0 (cos x))))
+ 1.0)))))))
#|
(with-sound (:clipped #f :statistics #t :play #t :scaled-to .5)
(let ((gen (make-k2cos 440.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (k2cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (k2cos gen)))))
|#
+
(defgenerator (k2ssb
:make-wrapper (lambda (g)
- (set! (k2ssb-frequency g) (hz->radians (k2ssb-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (angle 0.0) fm)
-(define* (k2ssb gen (fm 0.0))
- " (make-k2ssb frequency (ratio 1.0)) creates a k2ssb generator.\n\
- (k2ssb gen (fm 0.0)) returns many sinusoids from frequency spaced by frequency * ratio with amplitude 1/(2^k)."
- (declare (gen k2ssb) (fm float))
- (let* ((cx (k2ssb-angle gen))
- (mx (* cx (k2ssb-ratio gen))))
+(define k2ssb
- (set! (k2ssb-angle gen) (+ fm cx (k2ssb-frequency gen)))
-
- (/ (- (* 3 (cos cx))
- (* (sin cx)
- (* 4.0 (sin mx))))
- (* 3.0 (- 5.0 (* 4.0 (cos mx)))))))
+ (let ((documentation "(make-k2ssb frequency (ratio 1.0)) creates a k2ssb generator. (k2ssb gen (fm 0.0))
+returns many sinusoids from frequency spaced by frequency * ratio with amplitude 1/(2^k)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio)))
+ (set! angle (+ angle fm frequency))
+ (/ (- (* 3 (cos cx))
+ (* (sin cx) 4.0 (sin mx)))
+ (* 3.0 (- 5.0 (* 4.0 (cos mx))))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-k2ssb 1000.0 0.1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (k2ssb gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (k2ssb gen))))))
|#
@@ -2811,104 +2964,113 @@
;;; it produces sum r^k sin(2k-1)x
;;; (not normalized)
+(define dblsum-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (radians->hz (* 0.5 (g 'frequency))))
+ (lambda (g val) (set! (g 'frequency) (hz->radians (* 2 val))) val)))))
+
(defgenerator (dblsum
:make-wrapper (lambda (g)
- (set! (dblsum-frequency g) (hz->radians (* 2 (dblsum-frequency g))))
+ (set! (g 'frequency) (hz->radians (* 2 (g 'frequency))))
g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (radians->hz (* 0.5 (dblsum-frequency g))))
- (lambda (g val) (set! (dblsum-frequency g) (hz->radians (* 2 val))) val))))
- (frequency *clm-default-frequency*) (r 0.5) (angle 0.0))
-
-
-(define* (dblsum gen (fm 0.0))
- " (make-dblsum frequency (r 0.5)) creates a dblsum generator.\n\
- (dblsum gen (fm 0.0)) returns many sines from frequency spaced by frequency * (2k -1) with amplitude r^k (this is buggy)."
- (declare (gen dblsum) (fm float))
- (let* ((x (dblsum-angle gen))
- (r (dblsum-r gen)))
- (set! (dblsum-angle gen) (+ fm (dblsum-angle gen) (dblsum-frequency gen)))
- (/ (* (+ 1 r) (sin (* 0.5 x)))
- (* (- 1 r) (+ 1.0 (* -2.0 r (cos x)) (* r r))))))
+ :methods dblsum-methods)
+ (frequency *clm-default-frequency*) (r 0.5) (angle 0.0) fm)
+
+
+(define dblsum
+
+ (let ((documentation "(make-dblsum frequency (r 0.5)) creates a dblsum generator. (dblsum gen (fm 0.0))
+returns many sines from frequency spaced by frequency * (2k -1) with amplitude r^k (this is buggy)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (/ (* (+ 1 r) (sin (* 0.5 x)))
+ (* (- 1 r) (+ 1.0 (* -2.0 r (cos x)) (* r r)))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-dblsum 100 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (dblsum gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .25 (dblsum gen))))))
|#
+
+
;;; --------------------------------------------------------------------------------
;;; inf odd sinusoids scaled by r^odd-k/odd-k: rkoddssb
-;;; G&R 2nd col rows 7&8 (odd r^k/k)
+;;; G&R second col rows 7&8 (odd r^k/k)
+
+(define rkoddssb-methods
+ (list
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val)
+ (set! (g 'r) (generator-clamp-r val))
+ (set! (g 'rr1) (+ 1.0 (* (g 'r) (g 'r))))
+ (set! (g 'norm) (/ 1.0 (- (log (+ 1.0 (g 'r))) (log (- 1.0 (g 'r)))))))))))
(defgenerator (rkoddssb
:make-wrapper (lambda (g)
- (set! (rkoddssb-frequency g) (hz->radians (rkoddssb-frequency g)))
- (set! (rkoddssb-r g) (generator-clamp-r (rkoddssb-r g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'r) (generator-clamp-r (g 'r)))
+ (set! (g 'rr1) (+ 1.0 (* (g 'r) (g 'r))))
+ (set! (g 'norm) (/ 1.0 (- (log (+ 1.0 (g 'r))) (log (- 1.0 (g 'r))))))
g)
+ :methods rkoddssb-methods)
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm rr1 norm)
- :methods (list
- (list 'mus-scaler
- (lambda (g) (rkoddssb-r g))
- (lambda (g val)
- (set! (rkoddssb-r g) (generator-clamp-r val))
- (rkoddssb-r g)))))
-
- (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0))
-
-
-(define* (rkoddssb gen (fm 0.0))
- " (make-rkoddssb frequency (ratio 1.0) (r 0.5)) creates an rkoddssb generator.\n\
- (rkoddssb gen (fm 0.0)) returns many sinusoids from frequency spaced by frequency * 2 * ratio with amplitude (r^(2k-1))/(2k-1)."
- (declare (gen rkoddssb) (fm float))
- (let* ((r (rkoddssb-r gen))
- (cx (rkoddssb-angle gen))
- (mx (* cx (rkoddssb-ratio gen)))
- (cxx (- cx mx)))
-
- (set! (rkoddssb-angle gen) (+ fm cx (rkoddssb-frequency gen)))
- (/ (- (* (cos cxx)
- 0.5
- (log (/ (+ 1.0 (* 2.0 r (cos mx)) (* r r))
- (+ 1.0 (* -2.0 r (cos mx)) (* r r)))))
- (* (sin cxx)
- (atan (/ (* 2.0 r (sin mx))
- (- 1.0 (* r r))))))
-
- (- (log (+ 1 r)) ; normalization (r^k/k for odd k)
- (log (- 1 r))))))
+(define rkoddssb
+ (let ((documentation "(make-rkoddssb frequency (ratio 1.0) (r 0.5)) creates an rkoddssb generator. (rkoddssb gen (fm 0.0))
+returns many sinusoids from frequency spaced by frequency * 2 * ratio with amplitude (r^(2k-1))/(2k-1)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio))
+ (cxx (- cx mx))
+ (cmx (* 2.0 r (cos mx))))
+ (set! angle (+ angle fm frequency))
+ (* (- (* (cos cxx)
+ 0.5
+ (log (/ (+ rr1 cmx) (- rr1 cmx))))
+ (* (sin cxx)
+ (atan (* 2.0 r (sin mx))
+ (- 1.0 (* r r)))))
+ norm))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-rkoddssb 1000.0 0.1 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (rkoddssb gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (rkoddssb gen))))))
|#
(definstrument (glassy beg dur freq amp)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (n (floor (/ (mus-srate) (* 3 freq))))
- (r (expt .001 (/ 1 n)))
- (clang (make-rkoddssb (* freq 2) (/ 1.618 2) r))
- (clangf (make-env (list 0 0 .01 1 .1 1 .2 .4 (max .3 dur) 0) :scaler amp :duration dur))
- (crf (make-env (list 0 1 1 0) :scaler r :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (set! (rkoddssb-r clang) (env crf))
- (outa i (* (env clangf)
- (rkoddssb clang 0.0)))))))
+ (let* ((n (floor (/ *clm-srate* (* 3 freq))))
+ (r (expt .001 (/ n))))
+ (let ((start (seconds->samples beg))
+ (stop (seconds->samples (+ beg dur)))
+ (clang (make-rkoddssb (* freq 2) (/ 1.618 2) r))
+ (clangf (make-env (list 0 0 .01 1 .1 1 .2 .4 (max .3 dur) 0) :scaler amp :duration dur))
+ (crf (make-env (list 0 1 1 0) :scaler r :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (set! (clang 'r) (env crf))
+ (outa i (* (env clangf)
+ (rkoddssb clang 0.0)))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
@@ -2923,10 +3085,9 @@
(let ((gen (make-rkoddssb 5000.0 0.1 0.95))
(ampf (make-env '(0 0 9 1 10 0) :base 32 :length 10000))
(noi (make-rand 10000 .1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (* (env ampf) (sin (rkoddssb gen (rand noi)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* (env ampf) (sin (rkoddssb gen (rand noi))))))))
|#
@@ -2935,57 +3096,55 @@
;;; inf sinusoids scaled by kr^k: krksin
-;;; Zygmund 1st
+;;; Zygmund first
;;; this looks interesting, but how to normalize? sum of sines is bad enough, kr^k -> r/(1-r)^2 if x^2<1 (since n=inf)
;;; for low n, we could use the Tn roots stuff (clm.c)
;;; the formula must be assuming r<1.0 -- if greater than 1 it's acting like r2k! above
(defgenerator (krksin
:make-wrapper (lambda (g)
- (set! (krksin-frequency g) (hz->radians (krksin-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (r 0.5) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (r 0.5) (angle 0.0) fm)
-(define* (krksin gen (fm 0.0))
- " (make-krksin frequency (r 0.5)) creates a krksin generator.\n\
- (krksin gen (fm 0.0)) returns many sines spaced by frequency with amplitude kr^k."
- (declare (gen krksin) (fm float))
- (let* ((x (krksin-angle gen))
- (r (krksin-r gen))
- (r1 (- 1.0 r))
- (r2 (* r r))
- (r3 (if (> r .9) r1 1.0)) ; not right yet...
- (den (+ 1.0 (* -2.0 r (cos x)) r2)))
- (set! (krksin-angle gen) (+ fm (krksin-angle gen) (krksin-frequency gen)))
+(define krksin
- (/ (* r1 r1 r3 (sin x))
- (* den den))))
+ (let ((documentation "(make-krksin frequency (r 0.5)) creates a krksin generator. (krksin gen (fm 0.0))
+returns many sines spaced by frequency with amplitude kr^k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (r1 (- 1.0 r))
+ (r2 (* r r))
+ (r3 (if (> r .9) r1 1.0)) ; not right yet...
+ (den (+ 1.0 (* -2.0 r (cos x)) r2)))
+ (set! angle (+ angle fm frequency))
+ (/ (* r1 r1 r3 (sin x))
+ (* den den)))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-krksin 440.0 0.5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (krksin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (krksin gen)))))
(with-sound (:clipped #f :statistics #t :scaled-to .5 :play #t)
(let ((gen (make-krksin 6.0 0.965))) ; 60 .6 also
- (run
- (do ((i 0 (+ i 1)))
- ((= i 100000))
- (outa i (krksin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (outa i (krksin gen)))))
(do ((i 0 (+ i 1)))
((= i 10))
- (let ((mx (maxamp (with-sound (:clipped #f :output (make-vct 10000))
+ (let ((mx (maxamp (with-sound (:clipped #f :output (make-float-vector 10000))
(let ((gen (make-krksin 20.0 (* i 0.1))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (krksin gen)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (krksin gen))))))))
(format #t ";~A: ~A" (* 0.1 i) mx)))
;;; relation between 1/(1-x)^2 and peak amp:
@@ -2996,72 +3155,77 @@
(let ((val (/ 1.0 (expt (- 1 r) 2))))
(let ((pk 0.0))
(let ((gen (make-krksin 1.0 r)))
- (run
- (do ((k 0 (+ k 1)))
- ((= k 100000))
- (let ((x (abs (krksin gen))))
- (if (> x pk) (set! pk x))))))
+ (do ((k 0 (+ k 1)))
+ ((= k 100000))
+ (let ((x (abs (krksin gen))))
+ (if (> x pk) (set! pk x)))))
(outa i (/ pk val))))))
;;; r 0: 1.0 (sin(x) in this case)
;;; else min den is (1-2r+r^2) so peak should be around (/ (expt (+ 1 (* - 2 r) (* r r)) 2))
;;; but at that point sin(x)->0 as x
-
+
|#
+
+
#|
;;; --------------------------------------------------------------------------------
;;; absolute value of oscil: abssin
-;;; Zygmund 2nd -- not actually very useful, but shows cos 2nx of abs
+;;; Zygmund second -- not actually very useful, but shows cos 2nx of abs
+
+(define abssin-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'osc)))
+ (lambda (g val) (set! (mus-frequency (g 'osc)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'osc)))
+ (lambda (g val) (set! (mus-phase (g 'osc)) val))))))
(defgenerator (abssin
:make-wrapper (lambda (g)
- (set! (abssin-osc g) (make-oscil (abssin-frequency g)))
+ (set! (g 'osc) (make-oscil (g 'frequency)))
g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (abssin-osc g)))
- (lambda (g val) (set! (mus-frequency (abssin-osc g)) val) val))
+ :methods abssin-methods)
+ (frequency *clm-default-frequency*) fm
+ (osc #f))
- (list 'mus-phase
- (lambda (g) (mus-phase (abssin-osc g)))
- (lambda (g val) (set! (mus-phase (abssin-osc g)) val) val))))
- (frequency *clm-default-frequency*)
- (osc #f :type clm))
+(define abssin
-(define* (abssin gen (fm 0.0))
- " (make-abssin frequency) creates an abssin generator.\n\
- (abssin gen (fm 0.0)) returns (abs oscil)."
- (declare (gen abssin) (fm float))
- (/ (- (abs (oscil (abssin-osc gen) fm))
- (/ 2.0 pi))
- (/ 2.0 pi))) ; original went from 0 to 1.0, subtract 2/pi, and we get peak at -2/pi
+ (let ((documentation "(make-abssin frequency) creates an abssin generator. (abssin gen (fm 0.0)) returns (abs oscil)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (/ (- (abs (oscil osc fm))
+ (/ 2.0 pi))
+ (/ 2.0 pi)))))) ; original went from 0 to 1.0, subtract 2/pi, and we get peak at -2/pi
;; DC: sin^2 x = 1/2 - cos 2x,
;; so every term in the sum adds 1/(2(4k^2-1)) -> 1/4 (J 397 or 373)
;; so DC is 2/pi = 0.6366
-
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-abssin 440.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (abssin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (abssin gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((vib (make-abssin 100.0)) ; spacing will be 200, if FM you get index-proportional amount as constant offset
(gen (make-oscil 1000.0))
(ampf (make-env '(0 0 1 1 2 1 3 0) :scaler .5 :length 20000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i
- (* (env ampf)
- (oscil gen 0.0 (* 3 (abssin vib 0.0)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i
+ (* (env ampf)
+ (oscil gen 0.0 (* 3 (abssin vib 0.0))))))))
;;; pitch is 2*freq, 200 1, 400 .203, 600 .087, 800 .049, 1000 .031, 1200 .021
;;; 1 .2 .086 .048 .030 .021 -- (/ 3.0 (- (* 4 (* 6 6)) 1))
@@ -3077,120 +3241,118 @@
(defgenerator (abcos
:make-wrapper (lambda (g)
- (set! (abcos-frequency g) (hz->radians (abcos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'ab) (sqrt (- (* (g 'a) (g 'a)) (* (g 'b) (g 'b)))))
+ (set! (g 'norm) (/ 0.5 (- (/ 1.0 (- 1.0 (/ (abs (- (g 'ab) (g 'a))) (g 'b)))) 1.0)))
+ ;; i.e. 1/(1-r) -1 because we start at k=1, r=the complicated a/b business
g))
- (frequency *clm-default-frequency*) (a 0.5) (b 0.25) (angle 0.0))
+ (frequency *clm-default-frequency*) (a 0.5) (b 0.25) (angle 0.0) ab norm fm)
-(define* (abcos gen (fm 0.0))
- " (make-abcos frequency (a 0.5) (b 0.25)) creates an abcos generator.\n\
- (abcos gen (fm 0.0)) returns many cosines spaced by frequency with amplitude (-a+sqrt(a^2-b^2))^k/b^k."
- (declare (gen abcos) (fm float))
- (let* ((x (abcos-angle gen))
- (a (abcos-a gen))
- (b (abcos-b gen))
- (norm (/ 0.5 (- (/ 1.0
- (- 1.0 (/ (abs (- (sqrt (- (* a a) (* b b)))
- a))
- b)))
- 1.0)))) ;; i.e. 1/(1-r) -1 because we start at k=1, r=the complicated a/b business
+(define abcos
- (set! (abcos-angle gen) (+ fm x (abcos-frequency gen)))
-
- (* norm (- (/ (sqrt (- (* a a) (* b b)))
- (+ a (* b (cos x))))
- 1.0))))
+ (let ((documentation "(make-abcos frequency (a 0.5) (b 0.25)) creates an abcos generator. (abcos gen (fm 0.0))
+returns many cosines spaced by frequency with amplitude (-a+sqrt(a^2-b^2))^k/b^k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (* norm (- (/ ab (+ a (* b (cos x)))) 1.0)))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-abcos 100.0 0.5 0.25)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (abcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (abcos gen)))))
|#
+
(defgenerator (absin
:make-wrapper (lambda (g)
- (set! (absin-frequency g) (hz->radians (absin-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'ab) (sqrt (- (* (g 'a) (g 'a)) (* (g 'b) (g 'b)))))
g))
- (frequency *clm-default-frequency*) (a 0.5) (b 0.25) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (a 0.5) (b 0.25) (angle 0.0) ab fm)
-(define* (absin gen (fm 0.0))
- " (make-absin frequency (a 0.5) (b 0.25)) creates an absin generator.\n\
- (absin gen (fm 0.0)) returns many sines spaced by frequency with amplitude (-a+sqrt(a^2-b^2))^k/b^k."
- (declare (gen absin) (fm float))
- (let* ((x (absin-angle gen))
- (a (absin-a gen))
- (b (absin-b gen)))
- (set! (absin-angle gen) (+ fm x (absin-frequency gen)))
+(define absin
- (/ (* (sin x)
- (sqrt (- (* a a) (* b b))))
- (+ a (* b (cos x))))))
+ (let ((documentation "(make-absin frequency (a 0.5) (b 0.25)) creates an absin generator. (absin gen (fm 0.0))
+returns many sines spaced by frequency with amplitude (-a+sqrt(a^2-b^2))^k/b^k."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (/ (* ab (sin x) )
+ (+ a (* b (cos x)))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-absin 100.0 0.5 0.25)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (absin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (absin gen))))))
|#
+
+
;;; --------------------------------------------------------------------------------
;;; inf cosines scaled by 1/(r^2+k^2): r2k2cos
-;;; J 2nd col 3rd row
+;;; J second col third row
(defgenerator (r2k2cos
:make-wrapper (lambda (g)
- (set! (r2k2cos-frequency g) (hz->radians (r2k2cos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (r 1.0) (angle 0.0))
+ (frequency *clm-default-frequency*) (r 1.0) (angle 0.0) fm)
(define (r2k2cos-norm a)
- " (make-r2k2cos frequency (r 1.0)) creates an r2k2cos generator.\n\
- (r2k2cos gen (fm 0.0)) returns many cosines spaced by frequency with amplitude 1/(r^2+k^2)."
;; J 124
(- (* (/ pi (* 2 a))
(/ (cosh (* pi a))
(sinh (* pi a))))
(/ 1.0
- (* 2 a a))))
-
-(define* (r2k2cos gen (fm 0.0))
- (declare (gen r2k2cos) (fm float))
- (let* ((x (r2k2cos-angle gen))
- (a (r2k2cos-r gen)))
- (if (> x (* 2 pi))
- (set! x (modulo x (* 2 pi))))
-
- (set! (r2k2cos-angle gen) (+ x fm (r2k2cos-frequency gen)))
+ (* 2 a a))))
- (/ (- (* pi (/ (cosh (* a (- pi x)))
- (sinh (* a pi))))
- (/ 1.0 a))
- (* 2 a (r2k2cos-norm a)))))
+(define r2k2cos
+ (let ((documentation "(make-r2k2cos frequency (r 1.0)) creates an r2k2cos generator. (r2k2cos gen (fm 0.0))
+returns many cosines spaced by frequency with amplitude 1/(r^2+k^2)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle)
+ (a r))
+ (if (> x (* 2 pi))
+ (set! x (modulo x (* 2 pi))))
+ (set! angle (+ x fm frequency))
+ (/ (- (* pi (/ (cosh (* a (- pi x)))
+ (sinh (* a pi))))
+ (/ a))
+ (* 2 a (r2k2cos-norm a))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-r2k2cos 100.0 1.0))) ; 400 .25 -- this isn't very flexible
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (r2k2cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (r2k2cos gen))))))
|#
+
;;; --------------------------------------------------------------------------------
;;; coskx/k = -ln(2sin(x/2)) or 1/2ln(1/(2-2cosx))
@@ -3207,176 +3369,172 @@
(defgenerator (blsaw
:make-wrapper (lambda (g)
- (set! (blsaw-frequency g) (hz->radians (blsaw-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (r 0.5) (angle 0.0))
-
-
-(define* (blsaw gen (fm 0.0))
- " (make-blsaw frequency (n 1) (r 0.5)) creates a blsaw generator.\n\
- (blsaw gen (fm 0.0)) returns a band-limited sawtooth wave."
- (declare (gen blsaw) (fm float))
- (let* ((a (blsaw-r gen))
- (N (blsaw-n gen))
- (x (blsaw-angle gen))
- (incr (blsaw-frequency gen))
- (den (+ 1.0 (* -2.0 a (cos x)) (* a a))))
- (set! (blsaw-angle gen) (+ x fm incr))
- (if (< (abs den) nearly-zero)
- 0.0
- (let* ((s1 (* (expt a (- N 1.0)) (sin (+ (* (- N 1.0) x) incr))))
- (s2 (* (expt a N) (sin (+ (* N x) incr))))
- (s3 (* a (sin (+ x incr)))))
- (/ (+ (sin incr)
- (- s3)
- (- s2)
- s1)
- den)))))
+ (frequency *clm-default-frequency*) (n 1) (r 0.5) (angle 0.0) fm)
+
+
+(define blsaw
+ (let ((documentation "(make-blsaw frequency (n 1) (r 0.5)) creates a blsaw generator. (blsaw gen (fm 0.0)) returns a band-limited sawtooth wave."))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((a r)
+ (N n)
+ (x angle)
+ (incr frequency)
+ (den (+ 1.0 (* -2.0 a (cos x)) (* a a))))
+ (set! angle (+ angle fm incr))
+ (if (< (abs den) nearly-zero)
+ 0.0
+ (let* ((s1 (* (expt a (- N 1.0)) (sin (+ (* (- N 1.0) x) incr))))
+ (s2 (* (expt a N) (sin (+ (* N x) incr))))
+ (s3 (* a (sin (+ x incr)))))
+ (/ (+ (sin incr)
+ (- s3)
+ (- s2)
+ s1)
+ den))))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-blsaw 440.0 :r 0.5 :n 3)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (blsaw gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (blsaw gen)))))
|#
+
;;; --------------------------------------------------------------------------------
;;; asymmetric fm gens
(defgenerator (asyfm
- :make-wrapper (lambda (gen)
- (set! (asyfm-frequency gen) (hz->radians (asyfm-frequency gen)))
- gen))
- (frequency *clm-default-frequency*) (ratio 1.0) (r 1.0) (index 1.0) (phase 0.0))
-
-
-(define* (asyfm-J gen (input 0.0))
- "(asyfm-J gen input) is the same as the CLM asymmetric-fm generator (index=1.0), set r != 1.0 to get the asymmetric spectra"
- (declare (gen asyfm) (input float))
- (let* ((phase (asyfm-phase gen))
- (r (asyfm-r gen))
- (r1 (/ 1.0 r))
- (index (asyfm-index gen))
- (one (if (or (> r 1.0)
- (and (< r 0.0)
- (> r -1.0)))
- -1.0 1.0))
- (modphase (* (asyfm-ratio gen) phase))
- (result (* (exp (* 0.5 index (- r r1) (+ one (cos modphase))))
- (cos (+ phase (* 0.5 index (+ r r1) (sin modphase))))))) ; use cos, not sin, to get predictable amp
- (set! (asyfm-phase gen) (+ phase input (asyfm-frequency gen)))
- result))
+ :make-wrapper (lambda (g)
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ g))
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 1.0) (index 1.0) (phase 0.0) fm)
+
+
+(define asyfm-J
+ (let ((documentation "(asyfm-J gen fm) is the same as the CLM asymmetric-fm generator (index=1.0), set r != 1.0 to get the asymmetric spectra"))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((r1 (/ r))
+ (one (if (or (> r 1.0)
+ (< -1.0 r 0.0))
+ -1.0 1.0))
+ (modphase (* ratio phase))
+ (result (* (exp (* 0.5 index (- r r1) (+ one (cos modphase))))
+ (cos (+ phase (* 0.5 index (+ r r1) (sin modphase))))))) ; use cos, not sin, to get predictable amp
+ (set! phase (+ phase fm frequency))
+ result)))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-asyfm 2000.0 :ratio .1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (asyfm-J gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (asyfm-J gen))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-asyfm 2000.0 :ratio .1 :index 1))
(r-env (make-env '(0 -4 1 -1) :length 20000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (set! (asyfm-r gen) (env r-env))
- (outa i (asyfm-J gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (set! (gen 'r) (env r-env))
+ (outa i (asyfm-J gen)))))
(define (val index r)
(let ((sum 0.0))
(do ((i -20 (+ i 1)))
((= i 21))
(set! sum (+ sum (* (expt r i) (bes-jn i index)))))
- (let ((norm (exp (* 0.5 index (- r (/ 1.0 r))))))
+ (let ((norm (exp (* 0.5 index (- r (/ r))))))
(list sum norm))))
(for-each
(lambda (index)
(for-each
(lambda (r)
- (let ((peak (maxamp (with-sound (:clipped #f :output (make-vct 1000))
+ (let ((peak (maxamp (with-sound (:clipped #f :output (make-float-vector 1000))
(let ((gen (make-asymmetric-fm 2000.0 :ratio .1 :r r)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (asymmetric-fm gen index)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (outa i (asymmetric-fm gen index))))))))
(if (> (abs (- peak 1.0)) .1)
(format #t ";asymmetric-fm peak: ~A, index: ~A, r: ~A" peak index r))))
(list -10.0 -1.5 -0.5 0.5 1.0 1.5 10.0)))
(list 1.0 3.0 10.0))
|#
-(define* (asyfm-I gen (input 0.0))
- "(dsp-asyfm-I gen input) is the I0 case of the asymmetric-fm generator (dsp.scm)"
- (declare (gen asyfm) (input float))
- (let* ((phase (asyfm-phase gen))
- (r (asyfm-r gen))
- (r1 (/ 1.0 r))
- (index (asyfm-index gen))
- (modphase (* (asyfm-ratio gen) phase))
- (result (* (exp (* 0.5 index (+ r r1) (- (cos modphase) 1.0)))
- (cos (+ phase (* 0.5 index (- r r1) (sin modphase)))))))
- (set! (asyfm-phase gen) (+ phase input (asyfm-frequency gen)))
- result))
+(define asyfm-I
+ (let ((documentation "(asyfm-I gen fm) is the I0 case of the asymmetric-fm generator"))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((r1 (/ r))
+ (modphase (* ratio phase))
+ (result (* (exp (* 0.5 index (+ r r1) (- (cos modphase) 1.0)))
+ (cos (+ phase (* 0.5 index (- r r1) (sin modphase)))))))
+ (set! phase (+ phase fm frequency))
+ result)))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-asyfm 2000.0 :ratio .1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (asyfm-I gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (asyfm-I gen))))))
|#
+
+
;;; --------------------------------------------------------------------------------
;;; bess (returns bes-jn, like oscil returns sin) normalized to peak at 1.0
;;; frequency here is the frequency in Hz of the damped sinusoid part of the bessel function
-(define bessel-peaks (vct 1.000 0.582 0.487 0.435 0.400 0.375 0.355 0.338 0.325 0.313 0.303 0.294 0.286 0.279 0.273 0.267 0.262 0.257 0.252 0.248))
+(define bessel-peaks (vector 1.000 0.582 0.487 0.435 0.400 0.375 0.355 0.338 0.325 0.313 0.303 0.294 0.286 0.279 0.273 0.267 0.262 0.257 0.252 0.248))
(defgenerator (bess
:make-wrapper (lambda (g)
- (set! (bess-frequency g) (hz->radians (bess-frequency g)))
- (if (>= (bess-n g) (length bessel-peaks))
- (set! (bess-norm g) (/ 0.67 (expt (bess-n g) 1/3)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (if (>= (g 'n) (length bessel-peaks))
+ (set! (g 'norm) (/ 0.67 (expt (g 'n) 1/3)))
;; this formula comes from V P Krainov, "Selected Mathetical Methods in Theoretical Physics"
- (set! (bess-norm g) (vct-ref bessel-peaks (bess-n g))))
+ (set! (g 'norm) (bessel-peaks (g 'n))))
g))
- (frequency *clm-default-frequency*) (n 0 :type int) (angle 0.0) (norm 1.0))
-
-(define* (bess gen (fm 0.0))
- " (make-bess frequency (n 0)) creates a bessel function (Jn) generator.\n\
- (bess gen (fm 0.0)) returns Jn."
- (declare (gen bess) (fm float))
- (let ((result (/ (bes-jn (bess-n gen) (bess-angle gen))
- (bess-norm gen))))
- (set! (bess-angle gen) (+ (bess-angle gen) (bess-frequency gen) fm))
- result))
+ (frequency *clm-default-frequency*) (n 0) (angle 0.0) (norm 1.0) fm)
+
+
+(define bess
+ (let ((documentation "(make-bess frequency (n 0)) creates a bessel function (Jn) generator. (bess gen (fm 0.0)) returns Jn."))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((result (/ (bes-jn n angle) norm)))
+ (set! angle (+ angle frequency fm))
+ result)))))
+
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-bess 100.0 :n 0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (outa i (bess gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (outa i (bess gen)))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen1 (make-bess 400.0 :n 1))
(gen2 (make-bess 400.0 :n 1))
(vol (make-env '(0 0 1 1 9 1 10 0) :scaler 2.0 :length 20000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (bess gen1 (* (env vol) (bess gen2 0.0))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (bess gen1 (* (env vol) (bess gen2 0.0)))))))
;;; max amps:
(do ((i 1 (+ i 1)))
@@ -3393,15 +3551,16 @@
(let ((gen1 (make-bess 400.0 :n 1))
(gen2 (make-oscil 400.0))
(vol (make-env '(0 1 1 0) :scaler 1.0 :length 20000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (bess gen1 (* (env vol) (oscil gen2 0.0))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (bess gen1 (* (env vol) (oscil gen2 0.0)))))))
;;; also gen2 800, env scl 0.2
|#
+
+
;;; --------------------------------------------------------------------------------
;;; Watson "Bessel Functions" p358 127 128 (J0(k sqrt(r^2+a^2- 2ar cos x)) = sum em Jm(ka)Jm(kr) cos mx
@@ -3409,51 +3568,49 @@
(defgenerator (jjcos
:make-wrapper (lambda (g)
- (set! (jjcos-frequency g) (hz->radians (jjcos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (r 0.5) (a 1.0) (k 1.0) (angle 0.0))
-
-
-(define* (jjcos gen (fm 0.0))
- " (make-jjcos frequency (r 0.5) (a 1.0) (k 1)) creates a jjcos generator.\n\
- (jjcos gen (fm 0.0)) returns a sum of cosines scaled by a product of Bessel functions."
- (declare (gen jjcos) (fm float))
- (let* ((x (jjcos-angle gen))
- (a (jjcos-a gen))
- (r (jjcos-r gen))
- (k (jjcos-k gen))
- (dc (* (bes-j0 (* k a)) (bes-j0 (* k r))))
- (norm (- (bes-j0 (* k (sqrt (+ (* a a) (* r r) (* -2 a r))))) dc)))
-
- ;; this norm only works if the a/r/k values all small enough that the initial J0 bump dominates
- ;; if they're large (k=10 for example), later maxes come into play.
- ;; we need a formula for a sum of JJ's
- ;;
- ;; the resultant spectra are similar to FM (we can get sharper bumps, or low-passed bumps, etc)
-
- (set! (jjcos-angle gen) (+ x fm (jjcos-frequency gen)))
-
- (/ (- (bes-j0 (* k (sqrt (+ (* r r)
- (* a a)
- (* a r -2.0 (cos x))))))
- dc) ; get rid of DC component
- norm)))
+ (frequency *clm-default-frequency*) (r 0.5) (a 1.0) (k 1.0) (angle 0.0) fm)
+
+
+(define jjcos
+
+ (let ((documentation "(make-jjcos frequency (r 0.5) (a 1.0) (k 1)) creates a jjcos generator. (jjcos gen (fm 0.0))
+returns a sum of cosines scaled by a product of Bessel functions."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (dc (* (bes-j0 (* k a)) (bes-j0 (* k r))))
+ (norm (- (bes-j0 (* k (sqrt (+ (* a a) (* r r) (* -2 a r))))) dc)))
+
+ ;; this norm only works if the a/r/k values all small enough that the initial J0 bump dominates
+ ;; if they're large (k=10 for example), later maxes come into play.
+ ;; we need a formula for a sum of JJ's
+ ;;
+ ;; the resultant spectra are similar to FM (we can get sharper bumps, or low-passed bumps, etc)
+
+ (set! angle (+ angle fm frequency))
+ (/ (- (bes-j0 (* k (sqrt (+ (* r r)
+ (* a a)
+ (* a (* -2.0 r (cos x)))))))
+ dc) ; get rid of DC component
+ norm))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-jjcos 100.0 :a 1.0 :r 1.0 :k 1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (jjcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (jjcos gen))))))
;;; example:
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-jjcos 100.0 :a 2.0 :r 1.0 :k 1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (jjcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (jjcos gen)))))
:(* (bes-jn 1 1) (bes-jn 1 2))
0.253788089467046
@@ -3499,49 +3656,40 @@ set k=10
which again matches
-
(define* (jjsin gen (fm 0.0))
- (declare (gen jjcos) (fm float))
- (let* ((x (jjcos-angle gen))
- (a (jjcos-a gen))
- (r (jjcos-r gen))
- (k (jjcos-k gen)))
-
- (set! (jjcos-angle gen) (+ x fm (jjcos-frequency gen)))
-
- (* (sin x)
- (bes-j0 (* k (sqrt (+ (* r r)
- (* a a)
- (* a r -2.0 (cos x)))))))))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (* (sin x)
+ (bes-j0 (* k (sqrt (+ (* r r)
+ (* a a)
+ (* a (* -2.0 r (cos x)))))))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-jjcos 100.0 :a 1.0 :r 1.0 :k 1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (jjsin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (jjsin gen)))))
(define* (jjesin gen (fm 0.0))
- (declare (gen jjcos) (fm float))
- (let* ((x (jjcos-angle gen))
- (r (jjcos-r gen)))
-
- (set! (jjcos-angle gen) (+ x fm (jjcos-frequency gen)))
-
- (* (exp (* r (- (cos x) 1.0))) ; -1 for norm , but there's huge DC offset
- (bes-j0 (* r (sin x))))))
-
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (* (exp (* r (- (cos x) 1.0))) ; -1 for norm , but there's huge DC offset
+ (bes-j0 (* r (sin x)))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-jjcos 100.0 :a 1.0 :r 1.0 :k 1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (jjesin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (jjesin gen)))))
|#
+
;;; --------------------------------------------------------------------------------
;;; check J0(zsinx) formula
@@ -3549,35 +3697,36 @@ which again matches
(defgenerator (j0evencos
:make-wrapper (lambda (g)
- (set! (j0evencos-frequency g) (hz->radians (j0evencos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (index 1.0) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (index 1.0) (angle 0.0) fm)
-(define* (j0evencos gen (fm 0.0))
- " (make-j0evencos frequency (index 1.0)) creates a j0evencos generator.\n\
- (j0evencos gen (fm 0.0)) returns a sum of cosines scaled Jk^2(index/2)."
- (declare (gen j0evencos) (fm float))
- (let* ((x (j0evencos-angle gen))
- (z (j0evencos-index gen))
- (j0 (bes-j0 (* 0.5 z)))
- (dc (* j0 j0)))
- (set! (j0evencos-angle gen) (+ x fm (j0evencos-frequency gen)))
+(define j0evencos
- (if (= dc 1.0)
- 1.0
- (/ (- (bes-j0 (* z (sin x)))
- dc) ; get rid of DC component
- (- 1.0 dc))))) ; normalize
+ (let ((documentation "(make-j0evencos frequency (index 1.0)) creates a j0evencos generator. (j0evencos gen (fm 0.0))
+returns a sum of cosines scaled Jk^2(index/2)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (z index)
+ (j0 (bes-j0 (* 0.5 z)))
+ (dc (* j0 j0)))
+ (set! angle (+ angle fm frequency))
+ (if (= dc 1.0)
+ 1.0
+ (/ (- (bes-j0 (* z (sin x)))
+ dc) ; get rid of DC component
+ (- 1.0 dc)))))))) ; normalize
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-j0evencos 100.0 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (j0evencos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (* .5 (j0evencos gen))))))
index 10 (so 10/2 is the bes-jn arg):
@@ -3585,35 +3734,33 @@ index 10 (so 10/2 is the bes-jn arg):
(do ((i 1 (+ i 1)))
((= i 11))
(format #t ";~A: ~A ~A" i (* (bes-jn i 5.0) (bes-jn i 5.0)) (/ (* (bes-jn i 5.0) (bes-jn i 5.0)) base))))
-;1: 0.107308091385168 0.701072497819036
-;2: 0.00216831005396058 0.0141661502497507
-;3: 0.133101826831083 0.86958987897572
-;4: 0.153062759870046 1.0
-;5: 0.0681943848279407 0.445532178342005
-;6: 0.0171737701015899 0.112200839160164
-;7: 0.00284904116112987 0.0186135488707298
-;8: 3.38752000110201e-4 0.00221315753353599
-;9: 3.04735259399795e-5 1.99091705688911e-4
-;10: 2.15444461145164e-6 1.4075563600714e-5
+ ;1: 0.107308091385168 0.701072497819036
+ ;2: 0.00216831005396058 0.0141661502497507
+ ;3: 0.133101826831083 0.86958987897572
+ ;4: 0.153062759870046 1.0
+ ;5: 0.0681943848279407 0.445532178342005
+ ;6: 0.0171737701015899 0.112200839160164
+ ;7: 0.00284904116112987 0.0186135488707298
+ ;8: 3.38752000110201e-4 0.00221315753353599
+ ;9: 3.04735259399795e-5 1.99091705688911e-4
+ ;10: 2.15444461145164e-6 1.4075563600714e-5
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-j0evencos 100.0 0.0))
(indf (make-env '(0 0 1 20) :length 30000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (j0evencos-index gen) (env indf))
- (outa i (* 0.5 (j0evencos gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'index) (env indf))
+ (outa i (* 0.5 (j0evencos gen))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-j0evencos 100.0 0.0))
(indf (make-env '(0 0 1 20) :length 30000))
(carrier (make-oscil 2000.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (j0evencos-index gen) (env indf))
- (outa i (* 0.5 (oscil carrier) (j0evencos gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'index) (env indf))
+ (outa i (* 0.5 (oscil carrier) (j0evencos gen))))))
;;; why no "carrier"? I subtracted DC out above -- to make this look right, I need to use the bes(sin) without any fixup.
@@ -3621,21 +3768,19 @@ index 10 (so 10/2 is the bes-jn arg):
(let ((gen (make-j0evencos 100.0 0.0))
(indf (make-env '(0 20 1 0) :length 30000))
(carrier (make-oscil 2000.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (j0evencos-index gen) (env indf))
- (outa i (* 0.5 (j0evencos gen (oscil carrier))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'index) (env indf))
+ (outa i (* 0.5 (j0evencos gen (oscil carrier)))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-j0evencos 100.0 0.0)) ; also 20 800, 20 200 (less index mvt), or 200 50
(indf (make-env '(0 10 1 0) :length 30000))
(carrier (make-oscil 2000.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (j0evencos-index gen) (env indf))
- (outa i (* 0.5 (j0evencos gen (* .1 (oscil carrier)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'index) (env indf))
+ (outa i (* 0.5 (j0evencos gen (* .1 (oscil carrier))))))))
(define (j0even beg dur freq amp mc-ratio index)
(let* ((gen (make-j0evencos (* mc-ratio freq) 0.0))
@@ -3643,16 +3788,15 @@ index 10 (so 10/2 is the bes-jn arg):
(carrier (make-oscil freq))
(start (seconds->samples beg))
(end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (set! (j0evencos-index gen) (env indf))
- (outa i (* 0.5 (j0evencos gen (* index (oscil carrier)))))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (set! (gen 'index) (env indf))
+ (outa i (* 0.5 (j0evencos gen (* index (oscil carrier))))))))
(with-sound (:clipped #f :statistics #t :play #t)
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (j0even i 1.0 2000.0 0.5 (+ .1 (* .05 i)) 0.1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (j0even i 1.0 2000.0 0.5 (+ .1 (* .05 i)) 0.1)))
(define* (jfm beg dur freq amp mc-ratio index (index-env '(0 1 1 1 2 0)))
(let* ((start (seconds->samples beg))
@@ -3663,16 +3807,15 @@ index 10 (so 10/2 is the bes-jn arg):
(vibamp (hz->radians (* freq .01)))
(ampf (make-env '(0 0 1 1 20 1 21 0) :scaler amp :duration dur))
(indf (make-env index-env :scaler index :duration dur)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (let ((vb (* vibamp (oscil vib))))
- (set! (j0evencos-index md) (env indf))
- (outa i (* (env ampf)
- (oscil cr vb)
- (j0evencos md (* vb mc-ratio)))))))))
-
-(with-sound (:output "test1.snd" :play #t) (jfm 0 3.0 400.0 0.5 .5 4.0 '(0 1 1 2 2 .5)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let ((vb (* vibamp (oscil vib))))
+ (set! (md 'index) (env indf))
+ (outa i (* (env ampf)
+ (oscil cr vb)
+ (j0evencos md (* vb mc-ratio))))))))
+
+(with-sound ("test1.snd" :play #t) (jfm 0 3.0 400.0 0.5 .5 4.0 '(0 1 1 2 2 .5)))
|#
@@ -3680,27 +3823,27 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (j2cos
:make-wrapper (lambda (g)
- (set! (j2cos-frequency g) (hz->radians (j2cos-frequency g)))
- (if (< (j2cos-n g) 1) (set! (j2cos-n g) 1))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (if (< (g 'n) 1) (set! (g 'n) 1))
g))
- (frequency *clm-default-frequency*) (r 0.5) (n 1 :type int) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (r 0.5) (n 1) (angle 0.0) fm)
-(define* (j2cos gen (fm 0.0))
- " (make-j2cos frequency (r 0.5) (n 1)) creates a j2cos generator.\n\
- (j2cos gen (fm 0.0)) returns a sum of cosines scaled in a very complicated way."
- (declare (gen j2cos) (fm float))
- (let* ((x (j2cos-angle gen))
- (r (j2cos-r gen))
- (rsinx2 (* 2.0 r (sin (* 0.5 x))))
- (n (j2cos-n gen)))
- (set! (j2cos-angle gen) (+ x fm (j2cos-frequency gen)))
+(define j2cos
- (if (< (abs rsinx2) nearly-zero)
- 1.0
- (/ (bes-jn n rsinx2)
- rsinx2))))
+ (let ((documentation "(make-j2cos frequency (r 0.5) (n 1)) creates a j2cos generator. (j2cos gen (fm 0.0))
+returns a sum of cosines scaled in a very complicated way."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (rsinx2 (* 2.0 r (sin (* 0.5 x)))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs rsinx2) nearly-zero)
+ 1.0
+ (/ (bes-jn n rsinx2)
+ rsinx2)))))))
;;; this goes berserk if n=0, needs normalization, dc omission, doc/test
;;; if n=1, sample 0 = 1, the rest are in the .5 range!
@@ -3709,56 +3852,55 @@ index 10 (so 10/2 is the bes-jn arg):
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-j2cos 100.0 :r 1.0 :n 0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (j2cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .5 (j2cos gen))))))
|#
+
+
;;; --------------------------------------------------------------------------------
(defgenerator (jpcos
:make-wrapper (lambda (g)
- (set! (jpcos-frequency g) (hz->radians (jpcos-frequency g)))
- (if (= (jpcos-r g) (jpcos-a g))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (if (= (g 'r) (g 'a))
(begin
- (snd-warning (format #f ";jpcos r and a can't be equal (~A)" (jpcos-r g)))
- (set! (jpcos-r g) (+ (jpcos-a g) .01))))
+ (snd-warning (format #f ";jpcos r and a can't be equal (~A)" (g 'r)))
+ (set! (g 'r) (+ (g 'a) .01))))
g))
- (frequency *clm-default-frequency*) (r 0.5) (a 0.0) (k 1.0) (angle 0.0))
-
-
-(define* (jpcos gen (fm 0.0))
- " (make-jpcos frequency (r 0.5) (a 0.0) (k 1)) creates a jpcos generator.\n\
- (jpcos gen (fm 0.0)) returns a sum of cosines scaled in a very complicated way."
- (declare (gen jpcos) (fm float))
- (let* ((x (jpcos-angle gen))
- (a (jpcos-a gen))
- (r (jpcos-r gen))
- (k (jpcos-k gen))
- ;; (dc (/ (* (sin (* k a)) (sin (* k r))) (* k a r)))
- ;; from P0(x)=1, J[1/2](x)=sqrt(2/(pi x))sin(x), omitting original 1/pi
- ;; G&R 914 (8.464), 974 (8.912), but it's missing some remaining (small) component
- ;; also omitting the original divide by (* pi (sqrt arg)) -- it's just an amplitude scaler
- ;; and in this context, we get -1..1 peak amps from the sin anyway.
- (arg (+ (* r r)
- (* a a)
- (* a r -2.0 (cos x)))))
-
- (set! (jpcos-angle gen) (+ x fm (jpcos-frequency gen)))
-
- (if (< (abs arg) nearly-zero) ; r = a, darn it! This will produce a spike, but at least it's not a NaN
- 1.0
- (sin (* k (sqrt arg))))))
+ (frequency *clm-default-frequency*) (r 0.5) (a 0.0) (k 1.0) (angle 0.0) fm)
+
+
+(define jpcos
+
+ (let ((documentation "(make-jpcos frequency (r 0.5) (a 0.0) (k 1)) creates a jpcos generator. (jpcos gen (fm 0.0))
+returns a sum of cosines scaled in a very complicated way."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ ;; (dc (/ (* (sin (* k a)) (sin (* k r))) (* k a r)))
+ ;; from P0(x)=1, J[1/2](x)=sqrt(2/(pi x))sin(x), omitting original 1/pi
+ ;; G&R 914 (8.464), 974 (8.912), but it's missing some remaining (small) component
+ ;; also omitting the original divide by (* pi (sqrt arg)) -- it's just an amplitude scaler
+ ;; and in this context, we get -1..1 peak amps from the sin anyway.
+ (arg (+ (* r r)
+ (* a a)
+ (* a (* -2.0 r (cos x))))))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs arg) nearly-zero) ; r = a, darn it! This will produce a spike, but at least it's not a NaN
+ 1.0
+ (sin (* k (sqrt arg)))))))))
#|
(with-sound (:clipped #f :statistics #t)
(let ((gen (make-jpcos 100.0 :a 1.0 :r 0.5 :k 1)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 210000))
- (outa i (jpcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 210000))
+ (outa i (jpcos gen)))))
(with-sound (:clipped #f :statistics #t)
(let* ((gen (make-jpcos 400.0 :a 1.0 :r 0.5 :k 10))
@@ -3766,12 +3908,11 @@ index 10 (so 10/2 is the bes-jn arg):
(samps (seconds->samples dur))
(ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler 0.5))
(indf (make-env '(0 0 1 1) :duration dur :scaler 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (set! (jpcos-r gen) (env indf))
- (outa i (* (env ampf)
- (jpcos gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (set! (gen 'r) (env indf))
+ (outa i (* (env ampf)
+ (jpcos gen))))))
;;; -.725, 1/.275
(with-sound (:clipped #f :scaled-to .5)
@@ -3794,11 +3935,10 @@ index 10 (so 10/2 is the bes-jn arg):
(let ((gen (make-rkcos 440.0 :r 0.6))
(gen1 (make-oscil 440.0))
(indf (make-env '(0 .1 1 .8) :length 50000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 50000))
- (set! (rkcos-r gen) (env indf))
- (outa i (oscil gen1 (* (rkcos-r gen) (rkcos gen))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 50000))
+ (set! (gen 'r) (env indf))
+ (outa i (oscil gen1 (* (gen 'r) (rkcos gen)))))))
|#
@@ -3806,37 +3946,33 @@ index 10 (so 10/2 is the bes-jn arg):
;;; --------------------------------------------------------------------------------
(defgenerator (jncos :make-wrapper (lambda (g)
- (set! (jncos-frequency g) (hz->radians (jncos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'ra) (+ (* (g 'a) (g 'a)) (* (g 'r) (g 'r))))
g))
- (frequency *clm-default-frequency*) (r 0.5) (a 1.0) (n 0 :type int) (angle 0.0))
-
-
-(define* (jncos gen (fm 0.0))
- " (make-jncos frequency (r 0.5) (a 1.0) (n 0)) creates a jncos generator.\n\
- (jncos gen (fm 0.0)) returns a sum of cosines scaled in a very complicated way."
- (declare (gen jncos) (fm float))
- (let* ((x (jncos-angle gen))
- (a (jncos-a gen))
- (r (jncos-r gen))
- (n (jncos-n gen))
- (arg (sqrt (+ (* r r)
- (* a a)
- (* a r -2.0 (cos x))))))
+ (frequency *clm-default-frequency*) (r 0.5) (a 1.0) (n 0) (angle 0.0) ra fm)
+
- (set! (jncos-angle gen) (+ x fm (jncos-frequency gen)))
+(define jncos
- (if (< arg nearly-zero)
- 1.0
- (/ (bes-jn n arg)
- (expt arg n)))))
+ (let ((documentation "(make-jncos frequency (r 0.5) (a 1.0) (n 0)) creates a jncos generator. (jncos gen (fm 0.0))
+returns a sum of cosines scaled in a very complicated way."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((arg (sqrt (+ ra (* a (* -2.0 r (cos angle)))))))
+ (set! angle (+ angle fm frequency))
+ (if (< arg nearly-zero)
+ 1.0
+ (/ (bes-jn n arg)
+ (expt arg n))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-jncos 100.0 :a 0.5 :r 1.0 :n 0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 41000))
- (outa i (jncos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 41000))
+ (outa i (jncos gen)))))
|#
@@ -3847,31 +3983,33 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (j0j1cos
:make-wrapper (lambda (g)
- (set! (j0j1cos-frequency g) (hz->radians (j0j1cos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (index 1.0) (angle 0.0))
+ (frequency *clm-default-frequency*) (index 1.0) (angle 0.0) fm)
-(define* (j0j1cos gen (fm 0.0))
- " (make-j0j1cos frequency (index 1.0)) creates a j0j1cos generator.\n\
- (j0j1cos gen (fm 0.0)) returns a sum of cosines scaled in a very complicated way."
- (declare (gen j0j1cos) (fm float))
- (let* ((x (j0j1cos-angle gen))
- (z (j0j1cos-index gen))
- (j0 (bes-j0 (* 0.5 z)))
- (dc (* j0 j0))
- (arg (* z (cos x))))
+(define j0j1cos
- (set! (j0j1cos-angle gen) (+ x fm (j0j1cos-frequency gen)))
-
- (/ (- (+ (bes-j0 arg)
- (bes-j1 arg))
- dc) ; get rid of DC component
- 1.215))) ; not the best...
-
-; need to normalize j0j1cos -- min depends on index, so peak depends on max and min and dc
-; (max (- 1.2154 dc)
-; (- -0.5530 dc)
+ (let ((documentation "(make-j0j1cos frequency (index 1.0)) creates a j0j1cos generator. (j0j1cos gen (fm 0.0))
+returns a sum of cosines scaled in a very complicated way."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (z index)
+ (j0 (bes-j0 (* 0.5 z)))
+ (dc (* j0 j0))
+ (arg (* z (cos x))))
+ (set! angle (+ angle fm frequency))
+ (/ (- (+ (bes-j0 arg)
+ (bes-j1 arg))
+ dc) ; get rid of DC component
+ 1.215)))))) ; not the best...
+
+ ; need to normalize j0j1cos -- min depends on index, so peak depends on max and min and dc
+ ; (max (- 1.2154 dc)
+ ; (- -0.5530 dc)
#|
(let ((mx 0.0) (x 0.0) (saved-x 0.0))
@@ -3895,74 +4033,75 @@ index 10 (so 10/2 is the bes-jn arg):
(do ((i 0 (+ i 1)))
((= i 10))
(let ((pk (maxamp
- (with-sound (:output (make-vct 10000))
+ (with-sound ((make-float-vector 10000))
(let ((gen (make-j0j1cos 100.0 i)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (j0j1cos gen)))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (j0j1cos gen))))))))
(format #t ";~A: ~A" i pk)))
-;0: 0.0
-;1: 0.555559098720551
-;2: 0.938335597515106
-;3: 0.953315675258636
-;4: 1.16509592533112
-;5: 1.21275520324707
-;6: 1.14727067947388
-;7: 1.07083106040955
-;8: 1.05760526657104
-;9: 1.11238932609558
-;10: 1.1824289560318
-;11: 1.21528387069702
-;12: 1.19094204902649
-;13: 1.14720714092255
-;14: 1.12512302398682
-
+ ;0: 0.0
+ ;1: 0.555559098720551
+ ;2: 0.938335597515106
+ ;3: 0.953315675258636
+ ;4: 1.16509592533112
+ ;5: 1.21275520324707
+ ;6: 1.14727067947388
+ ;7: 1.07083106040955
+ ;8: 1.05760526657104
+ ;9: 1.11238932609558
+ ;10: 1.1824289560318
+ ;11: 1.21528387069702
+ ;12: 1.19094204902649
+ ;13: 1.14720714092255
+ ;14: 1.12512302398682
+
|#
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-j0j1cos 100.0 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (j0j1cos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (j0j1cos gen)))))
|#
-;;; --------------------------------------------------------------------------------
+;;; --------------------------------------------------------------------------------
+
(defgenerator (jycos
:make-wrapper (lambda (g)
- (set! (jycos-frequency g) (hz->radians (jycos-frequency g)))
- (set! (jycos-r g) (max .0001 (jycos-r g))) ; 0->inf in bes-y0
- (let ((a (jycos-a g)) ; "c"
- (r (jycos-r g))); "b"
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'r) (max .0001 (g 'r))) ; 0->inf in bes-y0
+ (let ((a (g 'a)) ; "c"
+ (r (g 'r))); "b"
(if (<= r a)
(format #t ";jycos a: ~A must be < r: ~A" a r))
(if (<= (+ (* a a) (* r r)) (* 2 a r))
(format #t ";jycos a: ~A, r: ~A will cause bes-y0 to return -inf!" a r)))
g))
(frequency *clm-default-frequency*) (r 1.0) (a 0.5) ; "b" and "c" in the docs
- (angle 0.0))
+ (angle 0.0) fm)
-(define* (jycos gen (fm 0.0))
- " (make-jycos frequency (r 1.0) (a 0.5)) creates a jycos generator.\n\
- (jycos gen (fm 0.0)) returns a sum of cosines scaled by Yn(r)*Jn(r)."
- (declare (gen jycos) (fm float))
- (let* ((x (jycos-angle gen))
- (b (jycos-r gen))
- (c (jycos-a gen))
- (b2c2 (+ (* b b) (* c c)))
- (dc (* (bes-y0 b) (bes-j0 c)))
- (norm (abs (- (bes-y0 (sqrt (+ b2c2 (* -2 b c)))) dc))))
+(define jycos
- (set! (jycos-angle gen) (+ x fm (jycos-frequency gen)))
-
- (/ (- (bes-y0 (sqrt (+ b2c2 (* -2.0 b c (cos x)))))
- dc)
- norm)))
+ (let ((documentation "(make-jycos frequency (r 1.0) (a 0.5)) creates a jycos generator. (jycos gen (fm 0.0))
+returns a sum of cosines scaled by Yn(r)*Jn(r)."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (b r)
+ (c a)
+ (b2c2 (+ (* b b) (* c c)))
+ (dc (* (bes-y0 b) (bes-j0 c)))
+ (norm (abs (- (bes-y0 (sqrt (+ b2c2 (* -2 b c)))) dc))))
+ (set! angle (+ angle fm frequency))
+ (/ (- (bes-y0 (sqrt (+ b2c2 (* -2.0 b c (cos x)))))
+ dc)
+ norm))))))
;;; oops -- bes-y0(0) is -inf!
;;; norm only works for "reasonable" a and r
@@ -3973,13 +4112,12 @@ index 10 (so 10/2 is the bes-jn arg):
(af (make-env '(0 0 1 1) :length 30000))
(rf (make-env '(0 3 1 3) :length 30000))
(ampf (make-env '(0 0 1 1 10 1 11 0) :scaler 0.5 :length 30000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (jycos-a gen) (env af))
- (set! (jycos-r gen) (env rf))
- (outa i (* (env ampf)
- (jycos gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'a) (env af))
+ (set! (gen 'r) (env rf))
+ (outa i (* (env ampf)
+ (jycos gen))))))
:(* (bes-yn 1 1.5) (bes-jn 1 1.0))
-0.181436652807559
@@ -3994,70 +4132,72 @@ index 10 (so 10/2 is the bes-jn arg):
0.220994475138122 [0.228]
|#
+
+
;;; --------------------------------------------------------------------------------
#|
(defgenerator (jcos
:make-wrapper (lambda (g)
- (set! (jcos-frequency g) (hz->radians (jcos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 0 :type int) (r 1.0) (a 0.5) ; "b" and "c" in the docs
- (angle 0.0))
+ (frequency *clm-default-frequency*) (n 0) (r 1.0) (a 0.5) ; "b" and "c" in the docs
+ (angle 0.0) fm)
-(define* (jcos gen (fm 0.0))
- " (make-jcos frequency (n 0) (r 1.0) (a 0.5)) creates a jcos generator.\n\
- (jcos gen (fm 0.0)) returns a sum of cosines scaled in some complex manner."
- (declare (gen jcos) (fm float))
- (let* ((x (jcos-angle gen))
- (b (jcos-r gen))
- (c (jcos-a gen))
- (n (jcos-n gen))
- (dc (* (bes-j0 b) (bes-j0 c))))
+(define jcos
- (set! (jcos-angle gen) (+ x fm (jcos-frequency gen)))
-
- (- (bes-jn n (* (+ n 1) (sqrt (+ (* b b) (* c c) (* -2.0 b c (cos x))))))
- dc)))
+ (let ((documentation "(make-jcos frequency (n 0) (r 1.0) (a 0.5)) creates a jcos generator. (jcos gen (fm 0.0))
+returns a sum of cosines scaled in some complex manner."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (b r)
+ (c a)
+ (dc (* (bes-j0 b) (bes-j0 c))))
+ (set! angle (+ angle fm frequency))
+ (- (bes-jn n (* (+ n 1) (sqrt (+ (* b b) (* c c) (* -2.0 b c (cos x))))))
+ dc))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-jcos 100.0 0 1.0 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (jcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (jcos gen)))))
|#
+
;;; --------------------------------------------------------------------------------
#|
(defgenerator (sin2n
:make-wrapper (lambda (g)
- (set! (sin2n-frequency g) (hz->radians (sin2n-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (n 1 :type int) (r 1.0) (angle 0.0))
-
+ (frequency *clm-default-frequency*) (n 1) (r 1.0) (angle 0.0) fm)
-(define* (sin2n gen (fm 0.0))
- " (make-sin2n frequency (n 0) (r 1.0)) creates a sin2n generator.\n\
- (sin2n gen (fm 0.0)) returns (r*sin)^(2n)"
- (declare (gen sin2n) (fm float))
- (let* ((x (sin2n-angle gen))
- (n (sin2n-n gen))
- (r (sin2n-r gen)))
- (set! (sin2n-angle gen) (+ x fm (sin2n-frequency gen)))
- (expt (* r (sin x)) (* 2 n))))
+(define sin2n
+ (let ((documentation "(make-sin2n frequency (n 0) (r 1.0)) creates a sin2n generator. (sin2n gen (fm 0.0)) returns (r*sin)^(2n)"))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle))
+ (set! angle (+ angle fm frequency))
+ (expt (* r (sin x)) (* 2 n)))))))
+
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-sin2n 100.0 2 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (sin2n gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (sin2n gen)))))
|#
+
;;; --------------------------------------------------------------------------------
#|
@@ -4088,53 +4228,82 @@ index 10 (so 10/2 is the bes-jn arg):
;;; blackman as a waveform -- all the other fft windows could be implemented
;;; perhaps most useful as an amplitude envelope
+#|
(defgenerator (blackman
:make-wrapper (lambda (g)
- (let ((n (blackman-n g)))
+ (let ((n (g 'n)))
(set! n (min (max n 1) 10))
- (set! (blackman-frequency g) (hz->radians (blackman-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
(case n
- ((1) (set! (blackman-coeffs g) (vct 0.54 -0.46)))
- ((2) (set! (blackman-coeffs g) (vct 0.34401 -0.49755 0.15844)))
- ((3) (set! (blackman-coeffs g) (vct 0.21747 -0.45325 0.28256 -0.04672)))
- ((4) (set! (blackman-coeffs g) (vct 0.084037 -0.29145 0.375696 -0.20762 0.041194)))
- ((5) (set! (blackman-coeffs g) (vct 0.097167 -0.3088448 0.3626224 -0.1889530 0.04020952 -0.0022008)))
- ((6) (set! (blackman-coeffs g) (vct 0.063964353 -0.239938736 0.3501594961 -0.247740954 0.0854382589
- -0.012320203 0.0004377882)))
- ((7) (set! (blackman-coeffs g) (vct 0.04210723 -0.18207621 0.3177137375 -0.284437984 0.1367622316
- -0.033403806 0.0034167722 -0.000081965)))
- ((8) (set! (blackman-coeffs g) (vct 0.027614462 -0.135382235 0.2752871215 -0.298843294 0.1853193194
- -0.064888448 0.0117641902 -0.000885987 0.0000148711)))
- ((9) (set! (blackman-coeffs g) (vct 0.01799071953 -0.098795950 0.2298837751 -0.294112951 0.2243389785
- -0.103248745 0.0275674108 -0.003839580 0.0002189716 -0.000002630)))
- ((10) (set! (blackman-coeffs g) (vct 0.0118717384 -0.071953468 0.1878870875 -0.275808066 0.2489042133
- -0.141729787 0.0502002984 -0.010458985 0.0011361511 -0.000049617
- 0.0000004343))))
+ ((1) (set! (g 'coeffs) (float-vector 0.54 -0.46)))
+ ((2) (set! (g 'coeffs) (float-vector 0.34401 -0.49755 0.15844)))
+ ((3) (set! (g 'coeffs) (float-vector 0.21747 -0.45325 0.28256 -0.04672)))
+ ((4) (set! (g 'coeffs) (float-vector 0.084037 -0.29145 0.375696 -0.20762 0.041194)))
+ ((5) (set! (g 'coeffs) (float-vector 0.097167 -0.3088448 0.3626224 -0.1889530 0.04020952 -0.0022008)))
+ ((6) (set! (g 'coeffs) (float-vector 0.063964353 -0.239938736 0.3501594961 -0.247740954 0.0854382589
+ -0.012320203 0.0004377882)))
+ ((7) (set! (g 'coeffs) (float-vector 0.04210723 -0.18207621 0.3177137375 -0.284437984 0.1367622316
+ -0.033403806 0.0034167722 -0.000081965)))
+ ((8) (set! (g 'coeffs) (float-vector 0.027614462 -0.135382235 0.2752871215 -0.298843294 0.1853193194
+ -0.064888448 0.0117641902 -0.000885987 0.0000148711)))
+ ((9) (set! (g 'coeffs) (float-vector 0.01799071953 -0.098795950 0.2298837751 -0.294112951 0.2243389785
+ -0.103248745 0.0275674108 -0.003839580 0.0002189716 -0.000002630)))
+ ((10) (set! (g 'coeffs) (float-vector 0.0118717384 -0.071953468 0.1878870875 -0.275808066 0.2489042133
+ -0.141729787 0.0502002984 -0.010458985 0.0011361511 -0.000049617
+ 0.0000004343))))
g))
- :methods (list
- (list 'mus-reset
- (lambda (g)
- (set! (blackman-angle g) 0.0)))))
- (frequency *clm-default-frequency*) (n 4 :type int) (coeffs #f :type vct) (angle 0.0))
+ :methods (list
+ (cons 'mus-reset
+ (lambda (g)
+ (set! (g 'angle) 0.0)))))
+ (frequency *clm-default-frequency*) (n 4) (coeffs #f) (angle 0.0) fm)
+
+(define blackman
-(define* (blackman gen (fm 0.0))
- " (make-blackman frequency (n 4)) creates a blackman generator.\n\
- (blackman gen (fm 0.0)) returns the nth Blackman-Harris fft data window as a periodic waveform. (n <= 10)"
- (declare (gen blackman) (fm float))
- (let ((x (blackman-angle gen)))
- (set! (blackman-angle gen) (+ x fm (blackman-frequency gen)))
- (polynomial (blackman-coeffs gen) (cos x))))
+ (let ((documentation "(make-blackman frequency (n 4)) creates a blackman generator. (blackman gen (fm 0.0))
+returns the nth Blackman-Harris fft data window as a periodic waveform. (n <= 10)"))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (polynomial coeffs (cos x)))))))
+|#
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((black4 (make-blackman 440.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (blackman black4 0.0))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (blackman black4 0.0)))))
|#
+;;; but that is the same as polyshape/polywave!
+
+(define blackman polywave)
+(define blackman? polywave?)
+
+(define* (make-blackman (frequency 440.0) (n 4))
+ (make-polywave frequency
+ (case n
+ ;; this data is from clm.c
+ ((0) (list 0 0))
+ ((1) (list 0 0.54 1 -0.46))
+ ((2) (list 0 0.42323 1 -0.49755 2 0.078279))
+ ((3) (list 0 0.35875 1 0.48829 2 0.14128 3 -0.01168))
+ ((4) (list 0 0.287333 1 -0.44716 2 0.20844 3 -0.05190 4 0.005149))
+ ((5) (list 0 .293557 1 -.451935 2 .201416 3 -.047926 4 .00502619 5 -.000137555))
+ ((6) (list 0 .2712203 1 -.4334446 2 .2180041 3 -.0657853 4 .010761867 5 -.0007700127 6 .00001368088))
+ ((7) (list 0 .2533176 1 -.4163269 2 .2288396 3 -.08157508 4 .017735924 5 -.0020967027 6 .00010677413 7 -.0000012807))
+ ((8) (list 0 .2384331 1 -.4005545 2 .2358242 3 -.09527918 4 .025373955 5 -.0041524329 6 .00036856041 7 -.00001384355 8 .0000001161808))
+ ((9) (list 0 .2257345 1 -.3860122 2 .2401294 3 -.1070542 4 .03325916 5 -.00687337
+ 6 .0008751673 7 -.0000600859 8 .000001710716 9 -.00000001027272))
+ ((10) (list 0 .2151527 1 -.3731348 2 .2424243 3 -.1166907 4 .04077422 5 -.01000904
+ 6 .0016398069 7 -.0001651660 8 .000008884663 9 -.000000193817 10 .00000000084824)))))
+
+
;;; --------------------------------------------------------------------------------
@@ -4147,25 +4316,23 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (fmssb
:make-wrapper (lambda (g)
- (set! (fmssb-frequency g) (hz->radians (fmssb-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (index 1.0) (angle 0.0))
-
-
-(define* (fmssb gen (fm 0.0))
- " (make-fmssb frequency (ratio 1.0) (index 1.0)) creates an fmssb generator.\n\
- (fmssb gen (fm 0.0)) returns single-sideband FM."
- (declare (gen fmssb) (fm float))
- (let* ((cx (fmssb-angle gen))
- (mx (* cx (fmssb-ratio gen)))
- (B (fmssb-index gen)))
-
- (set! (fmssb-angle gen) (+ fm cx (fmssb-frequency gen)))
-
- (- (* (cos cx)
- (sin (* B (cos mx))))
- (* (sin cx)
- (* (sin (* B (sin mx)))))))) ; use -B for the other side
+ (frequency *clm-default-frequency*) (ratio 1.0) (index 1.0) (angle 0.0) fm)
+
+
+(define fmssb
+ (let ((documentation "(make-fmssb frequency (ratio 1.0) (index 1.0)) creates an fmssb generator. (fmssb gen (fm 0.0)) returns single-sideband FM."))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((cx angle)
+ (mx (* cx ratio)))
+ (set! angle (+ angle fm frequency))
+ (- (* (cos cx)
+ (sin (* index (cos mx))))
+ (* (sin cx)
+ (sin (* index (sin mx)))))))))) ; use -index for the other side
;;; FM with complex index
(define* (fpmc beg dur freq amp mc-ratio fm-index interp)
@@ -4186,30 +4353,27 @@ index 10 (so 10/2 is the bes-jn arg):
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-fmssb 1000.0 0.1 :index 8.0))) ; 1 3 7 11 ... -- interesting effect
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (outa i (* .3 (fmssb gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (* .3 (fmssb gen))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-fmssb 1000.0 0.1 :index 8.0))
(ampf (make-env '(0 0 1 1 100 0) :base 32 :scaler .3 :length 30000))
(indf (make-env '(0 1 1 0) :length 30000 :scaler 8)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (fmssb-index gen) (env indf))
- (outa i (* (env ampf) (fmssb gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'index) (env indf))
+ (outa i (* (env ampf) (fmssb gen))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-fmssb 1000.0 0.05 :index 1.0))
(ampf (make-env '(0 0 1 1 100 0) :base 32 :scaler .3 :length 30000))
(indf (make-env '(0 1 1 0) :length 30000 :base 32 :scaler 10)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (fmssb-index gen) (env indf))
- (outa i (* (env ampf) (fmssb gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'index) (env indf))
+ (outa i (* (env ampf) (fmssb gen))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-fmssb 100.0 5.4 :index 1.0)) ; also 100 700
@@ -4217,54 +4381,49 @@ index 10 (so 10/2 is the bes-jn arg):
;; '(0 0 1 .75 2 1 3 .95 4 .5 10 0) -> bowed effect, '(0 0 1 .75 2 1 3 .125 4 .25 5 1 6 .8 20 0)
;; '(0 0 1 .75 2 1 3 .1 4 .7 5 1 6 .8 100 0) -> clickier attack (300 too)
(indf (make-env '(0 1 1 0) :length 30000 :base 32 :scaler 10)))
- ;; '(0 0 1 1 3 0)
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (fmssb-index gen) (env indf))
- (outa i (* (env ampf) (fmssb gen)))))))
+ ;; '(0 0 1 1 3 0)
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'index) (env indf))
+ (outa i (* (env ampf) (fmssb gen))))))
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-fmssb 10.0 2.0 :index 1.0))
(ampf (make-env '(0 0 1 1 3 1 100 0) :base 32 :scaler .3 :length 30000))
(indf (make-env '(0 1 1 0) :length 30000 :base 32 :scaler 10)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (fmssb-index gen) (env indf))
- (outa i (* (env ampf) (fmssb gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (gen 'index) (env indf))
+ (outa i (* (env ampf) (fmssb gen))))))
(with-sound (:statistics #t :scaled-to .5 :play #t)
(let ((gen1 (make-fmssb 500 1))
(gen2 (make-fmssb 1000 .2))
(ampf (make-env '(0 0 1 1 100 0) :base 32 :length 30000))
(indf (make-env '(0 1 1 1 10 0) :scaler 5.0 :base 32 :length 30000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (let ((ind (env indf)))
- (set! (fmssb-index gen1) ind)
- (set! (fmssb-index gen2) ind)
- (outa i (* (env ampf)
- (+ (fmssb gen1 0.0)
- (fmssb gen2 0.0)))))))))
-
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (let ((ind (env indf)))
+ (set! (gen1 'index) ind)
+ (set! (gen2 'index) ind)
+ (outa i (* (env ampf)
+ (+ (fmssb gen1 0.0)
+ (fmssb gen2 0.0))))))))
;;; imaginary machines (also imaginary beasts)
|#
(definstrument (machine1 beg dur cfreq mfreq amp index gliss)
- (let* ((gen (make-fmssb cfreq (/ mfreq cfreq) :index 1.0))
+ (let ((gen (make-fmssb cfreq (/ mfreq cfreq) :index 1.0))
(start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
+ (stop (seconds->samples (+ beg dur)))
(ampf (make-env '(0 0 1 .75 2 1 3 .1 4 .7 5 1 6 .8 100 0) :base 32 :scaler amp :duration dur))
(indf (make-env '(0 0 1 1 3 0) :duration dur :base 32 :scaler index))
(frqf (make-env (if (> gliss 0.0) '(0 0 1 1) '(0 1 1 0)) :duration dur :scaler (hz->radians (* (/ cfreq mfreq) (abs gliss))))))
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (set! (fmssb-index gen) (env indf))
- (outa i (* (env ampf) (fmssb gen (env frqf))))))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (set! (gen 'index) (env indf))
+ (outa i (* (env ampf) (fmssb gen (env frqf)))))))
#|
(with-sound (:statistics #t :play #t)
@@ -4298,13 +4457,12 @@ index 10 (so 10/2 is the bes-jn arg):
(gen1 (make-rkoddssb 100.0 0.1 0.9))
(ampf (make-env '(0 0 1 1 11 1 12 0) :duration 11.0 :scaler .5))
(frqf (make-env '(0 0 1 1 2 0 10 0 11 1 12 0 20 0) :duration 11.0 :scaler (hz->radians 10.0))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i (* 12 44100)))
- (outa i (* (env ampf)
- (+ (rkoddssb gen1 (env frqf))
- (* .2 (sin (rkoddssb gen (rand noi))))))))))
-
+ (do ((i 0 (+ i 1)))
+ ((= i (* 12 44100)))
+ (outa i (* (env ampf)
+ (+ (rkoddssb gen1 (env frqf))
+ (* .2 (sin (rkoddssb gen (rand noi)))))))))
+
(do ((i 0.0 (+ i 2)))
((>= i 10.0))
(machine1 i 3 100 700 0.5 4.0 0.0)
@@ -4339,7 +4497,6 @@ index 10 (so 10/2 is the bes-jn arg):
))
|#
-
(define (fm-cancellation beg dur frequency ratio amp index)
(let* ((cx 0.0)
(mx 0.0)
@@ -4352,111 +4509,114 @@ index 10 (so 10/2 is the bes-jn arg):
(outa i (* amp (- (* (cos cx)
(sin (* index (cos mx))))
(* (sin cx)
- (* (sin (* index (sin mx)))))))
- ;; use -index for reflection
- )
+ (sin (* index (sin mx))))))
+ ;; use -index for reflection
+ )
(set! cx (+ cx car-frequency))
(set! mx (+ mx mod-frequency)))))
-;(with-sound () (fm-cancellation 0 1 1000.0 100.0 0.3 9.0))
+ ;(with-sound () (fm-cancellation 0 1 1000.0 100.0 0.3 9.0))
+
+
;;; --------------------------------------------------------------------------------
;;; k3sin
-;;; mostly useful as a test of a vct field
+(define k3sin-methods
+ (list
+ (cons 'mus-reset
+ (lambda (g)
+ (set! (g 'frequency) 0.0)
+ (set! (g 'angle) 0.0)))))
(defgenerator (k3sin
:make-wrapper (lambda (g)
- (set! (k3sin-frequency g) (hz->radians (k3sin-frequency g)))
- (set! (k3sin-coeffs g) (vct 0.0
- (/ (* pi pi) 6.0)
- (/ pi -4.0)
- (/ 1.0 12.0)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'coeffs) (float-vector 0.0
+ (/ (* pi pi) 6.0)
+ (/ pi -4.0)
+ (/ 12.0)))
g)
- :methods (list
- (list 'mus-reset
- (lambda (g)
- (set! (k3sin-frequency g) 0.0)
- (set! (k3sin-angle g) 0.0)))))
- (frequency *clm-default-frequency*) (angle 0.0) (coeffs #f :type vct))
-
-
-(define* (k3sin gen (fm 0.0))
- " (make-k3sin frequency) creates a k3sin generator.\n\
- (k3sin gen (fm 0.0)) returns a sum of sines scaled by k^3."
- (declare (gen k3sin) (fm float))
- (let ((x (k3sin-angle gen)))
- (set! (k3sin-angle gen) (modulo (+ x fm (k3sin-frequency gen)) (* 2 pi)))
- (polynomial (k3sin-coeffs gen) x)))
+ :methods k3sin-methods)
+ (frequency *clm-default-frequency*) (angle 0.0) (coeffs #f) fm)
+
+
+(define k3sin
+ (let ((documentation "(make-k3sin frequency) creates a k3sin generator. (k3sin gen (fm 0.0)) returns a sum of sines scaled by k^3."))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (if (not (<= 0.0 x two-pi))
+ (set! x (modulo x two-pi)))
+ (set! angle (+ x fm frequency))
+ (polynomial coeffs x))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-k3sin 100.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (k3sin gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (k3sin gen)))))
|#
+
;;; --------------------------------------------------------------------------------
;;; I(z) case A&S
+(define izcos-methods
+ (list
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'r))
+ (lambda (g val)
+ (set! (g 'r) val)
+ (set! (g 'dc) (bes-i0 val))
+ (set! (g 'norm) (- (exp val) (g 'dc)))
+ (set! (g 'inorm) (/ (g 'norm)))
+ val)))))
+
(defgenerator (izcos
:make-wrapper (lambda (g)
- (set! (izcos-frequency g) (hz->radians (izcos-frequency g)))
- (set! (izcos-dc g) (bes-i0 (izcos-r g)))
- (set! (izcos-norm g) (- (exp (izcos-r g)) (izcos-dc g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'dc) (bes-i0 (g 'r)))
+ (set! (g 'norm) (- (exp (g 'r)) (g 'dc)))
+ (set! (g 'inorm) (/ (g 'norm)))
g)
- :methods (list
- (list 'mus-scaler
- (lambda (g)
- (izcos-r g))
- (lambda (g val)
- (set! (izcos-r g) val)
- (set! (izcos-dc g) (bes-i0 val))
- (set! (izcos-norm g) (- (exp val) (izcos-dc g)))
- val))))
+ :methods izcos-methods)
(frequency *clm-default-frequency*) (r 1.0) (angle 0.0)
- (dc 0.0) (norm 1.0))
-
-
-(define* (izcos gen (fm 0.0))
- " (make-izcos frequency (r 1.0)) creates an izcos generator.\n\
- (izcos gen (fm 0.0)) returns a sum of sines scaled by In(r)."
- (declare (gen izcos) (fm float))
- (let* ((x (izcos-angle gen))
- (z (izcos-r gen))
- (dc (izcos-dc gen))
- (norm (izcos-norm gen)))
+ (dc 0.0) (norm 1.0) inorm fm)
- (set! (izcos-angle gen) (+ x fm (izcos-frequency gen)))
- (if (< (abs norm) nearly-zero)
- 1.0
- (/ (- (exp (* z (cos x)))
- dc)
- norm))))
+(define izcos
+ (let ((documentation "(make-izcos frequency (r 1.0)) creates an izcos generator. (izcos gen (fm 0.0)) returns a sum of sines scaled by In(r)."))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (if (< (abs norm) nearly-zero)
+ 1.0
+ (* (- (exp (* r (cos x))) dc) inorm)))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-izcos 100.0 1.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (izcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (* .5 (izcos gen))))))
(with-sound (:clipped #f :statistics #t)
(let ((gen (make-izcos 100.0 1.0))
(indf (make-env '(0 0 1 3) :length 30000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (set! (mus-scaler gen) (env indf))
- (outa i (izcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (set! (mus-scaler gen) (env indf))
+ (outa i (izcos gen)))))
|#
@@ -4466,51 +4626,48 @@ index 10 (so 10/2 is the bes-jn arg):
(definstrument (organish beg dur freq amp fm-index amp-env)
;; this has an organ-style chiff (better than fm index sweep)
- (let* ((start (seconds->samples beg))
- (stop (+ start (seconds->samples dur)))
- (carriers (make-vector 3 #f))
- (fmoscs (make-vector 3 #f))
- (ampfs (make-vector 3 #f))
- (pervib (make-triangle-wave 5 (hz->radians (* freq .003))))
- (ranvib (make-rand-interp 6 (hz->radians (* freq .002))))
- (resc (make-nrssb 340.0 1.0 5 .5))
- (resf (make-env (list 0 0 .05 1 .1 0 dur 0) :scaler (* amp .05) :duration dur)))
-
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (let* ((frq (* freq (expt 2 i)))
- (index1 (hz->radians (* fm-index frq (/ 5.0 (log frq)))))
- (index2 (hz->radians (* fm-index frq 3.0 (/ (- 8.5 (log frq)) (+ 3.0 (* frq .001))))))
- (index3 (hz->radians (* fm-index frq (/ 4.0 (sqrt frq))))))
- (set! (carriers i) (make-oscil frq))
- (set! (fmoscs i) (make-polyshape :frequency frq
- :coeffs (partials->polynomial
- (list 1 index1
- 3 index2
- 4 index3))))))
-
- (set! (ampfs 0) (make-env (or amp-env '(0 0 1 1 2 1 3 0)) :scaler amp :duration dur))
- (set! (ampfs 1) (make-env (list 0 0 .04 1 .075 0 dur 0) :scaler (* amp .0125) :duration dur))
- (set! (ampfs 2) (make-env (list 0 0 .02 1 .05 0 dur 0) :scaler (* amp .025) :duration dur))
-
- ;; also good:
- ;(set! (ampfs 1) (make-env (list 0 0 .02 1 .05 0 (- dur .1) 0 (- dur .05) 1 dur 0) :scaler (* amp .025) :duration dur))
- ;(set! (ampfs 2) (make-env (list 0 0 .01 1 .025 0 (- dur .15) 0 (- dur .1) 1 dur 0) :scaler (* amp .05) :duration dur))
-
- (run
- (do ((i start (+ i 1)))
- ((= i stop))
- (let* ((vib (+ (triangle-wave pervib) (rand-interp ranvib)))
- (sum (* (env resf)
- (nrssb resc 0.0))))
- (do ((k 0 (+ 1 k))
- (n 1 (* n 2)))
- ((= k 3))
- (set! sum (+ sum (* (env (ampfs k))
- (oscil (carriers k)
- (+ (* n vib)
- (polyshape (fmoscs k) 1.0 (* n vib))))))))
- (outa i sum))))))
+ (let ((start (seconds->samples beg))
+ (carriers (make-vector 3 #f))
+ (fmoscs (make-vector 3 #f))
+ (ampfs (make-vector 3 #f))
+ (pervib (make-triangle-wave 5 (hz->radians (* freq .003))))
+ (ranvib (make-rand-interp 6 (hz->radians (* freq .002))))
+ (resc (make-nrssb 340.0 1.0 5 .5))
+ (resf (make-env (list 0 0 .05 1 .1 0 dur 0) :scaler (* amp .05) :duration dur)))
+ (let ((stop (+ start (seconds->samples dur))))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (let* ((frq (* freq (expt 2 i)))
+ (index1 (hz->radians (* fm-index frq (/ 5.0 (log frq)))))
+ (index2 (hz->radians (* fm-index frq 3.0 (/ (- 8.5 (log frq)) (+ 3.0 (* frq .001))))))
+ (index3 (hz->radians (* fm-index frq (/ 4.0 (sqrt frq))))))
+ (set! (carriers i) (make-oscil frq))
+ (set! (fmoscs i) (make-polywave frq
+ :partials (list 1 index1
+ 3 index2
+ 4 index3)))))
+
+ (set! (ampfs 0) (make-env (or amp-env '(0 0 1 1 2 1 3 0)) :scaler amp :duration dur))
+ (set! (ampfs 1) (make-env (list 0 0 .04 1 .075 0 dur 0) :scaler (* amp .0125) :duration dur))
+ (set! (ampfs 2) (make-env (list 0 0 .02 1 .05 0 dur 0) :scaler (* amp .025) :duration dur))
+
+ ;; also good:
+ ;; (set! (ampfs 1) (make-env (list 0 0 .02 1 .05 0 (- dur .1) 0 (- dur .05) 1 dur 0) :scaler (* amp .025) :duration dur))
+ ;; (set! (ampfs 2) (make-env (list 0 0 .01 1 .025 0 (- dur .15) 0 (- dur .1) 1 dur 0) :scaler (* amp .05) :duration dur))
+
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
+ (outa i (+ (* (env resf) (nrssb resc 0.0))
+ (* (env (vector-ref ampfs 0))
+ (oscil (vector-ref carriers 0)
+ (+ vib (polywave (vector-ref fmoscs 0) vib))))
+ (* (env (vector-ref ampfs 1))
+ (oscil (vector-ref carriers 1)
+ (+ (* 2 vib) (polywave (vector-ref fmoscs 1) (* 2 vib)))))
+ (* (env (vector-ref ampfs 2))
+ (oscil (vector-ref carriers 2)
+ (+ (* 4 vib) (polywave (vector-ref fmoscs 2) (* 4 vib))))))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
@@ -4528,277 +4685,294 @@ index 10 (so 10/2 is the bes-jn arg):
;;; --------------------------------------------------------------------------------
-(defgenerator plsenv (pulse #f :type clm) (ampf #f :type clm))
-
-(define* (make-pulsed-env envelope duration frequency)
- (make-plsenv (make-pulse-train frequency)
- (make-env envelope :duration duration)))
-
-(define* (pulsed-env gen (fm 0.0))
- (if (> (pulse-train (plsenv-pulse gen) fm) 0.1)
- (mus-reset (plsenv-ampf gen)))
- (env (plsenv-ampf gen)))
-
-(define pulsed-env? plsenv?)
-
-
-;;; --------------------------------------------------------------------------------
+(define adjustable-square-wave-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'p1)))
+ (lambda (g val) (set! (mus-frequency (g 'p1)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'p1)))
+ (lambda (g val) (set! (mus-phase (g 'p1)) val))))
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'duty-factor))
+ (lambda (g val)
+ (set! (g 'duty-factor) val)
+ (set! (mus-phase (g 'p2)) (* two-pi (- 1.0 (g 'duty-factor))))
+ val)))))
(defgenerator (adjustable-square-wave
:make-wrapper
(lambda (g)
- (set! (adjustable-square-wave-p1 g) (make-pulse-train
- (adjustable-square-wave-frequency g)
- (adjustable-square-wave-amplitude g)))
- (set! (adjustable-square-wave-p2 g) (make-pulse-train
- (adjustable-square-wave-frequency g)
- (- (adjustable-square-wave-amplitude g))
- (* 2.0 pi (- 1.0 (adjustable-square-wave-duty-factor g)))))
+ (set! (g 'p1) (make-pulse-train
+ (g 'frequency)
+ (g 'amplitude)))
+ (set! (g 'p2) (make-pulse-train
+ (g 'frequency)
+ (- (g 'amplitude))
+ (* two-pi (- 1.0 (g 'duty-factor)))))
g)
-
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (adjustable-square-wave-p1 g)))
- (lambda (g val) (set! (mus-frequency (adjustable-square-wave-p1 g)) val) val))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (adjustable-square-wave-p1 g)))
- (lambda (g val) (set! (mus-phase (adjustable-square-wave-p1 g)) val) val))
-
- (list 'mus-scaler
- (lambda (g)
- (adjustable-square-wave-duty-factor g))
- (lambda (g val)
- (set! (adjustable-square-wave-duty-factor g) val)
- (set! (mus-phase (adjustable-square-wave-p2 g)) (* 2.0 pi (- 1.0 (adjustable-square-wave-duty-factor g))))
- val))))
-
+ :methods adjustable-square-wave-methods)
(frequency *clm-default-frequency*) (duty-factor 0.5) (amplitude 1.0)
- (sum 0.0) (p1 #f :type clm) (p2 #f :type clm))
+ (sum 0.0) (p1 #f) (p2 #f) fm)
-(define* (adjustable-square-wave gen (fm 0.0))
- " (make-adjustable-square-wave frequency (duty-factor 0.5) (amplitude 1.0)) creates an adjustable-square-wave generator.\n\
- (adjustable-square-wave gen (fm 0.0)) returns a square-wave where the duty-factor sets the ratio of pulse duration to pulse period."
- (declare (gen adjustable-square-wave) (fm float))
- (set! (adjustable-square-wave-sum gen) (+ (adjustable-square-wave-sum gen)
- (pulse-train (adjustable-square-wave-p1 gen) fm)
- (pulse-train (adjustable-square-wave-p2 gen) fm)))
- (adjustable-square-wave-sum gen))
+(define adjustable-square-wave
+
+ (let ((documentation "(make-adjustable-square-wave frequency (duty-factor 0.5) (amplitude 1.0))
+creates an adjustable-square-wave generator. (adjustable-square-wave gen (fm 0.0)) returns a square-wave
+where the duty-factor sets the ratio of pulse duration to pulse period."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (set! sum (+ sum
+ (pulse-train p1 fm)
+ (pulse-train p2 fm)))))))
#|
(with-sound ()
(let ((gen (make-adjustable-square-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 22050))
- (outa i (adjustable-square-wave gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 22050))
+ (outa i (adjustable-square-wave gen)))))
|#
+(define adjustable-triangle-wave-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'gen)))
+ (lambda (g val) (set! (mus-frequency (g 'gen)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'gen)))
+ (lambda (g val) (set! (mus-phase (g 'gen)) val))))
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'duty-factor))
+ (lambda (g val)
+ (set! (g 'duty-factor) val)
+ (set! (g 'top) (- 1.0 val))
+ (if (not (= val 0.0))
+ (set! (g 'scl) (/ (g 'amplitude) val)))
+ val)))))
+
(defgenerator (adjustable-triangle-wave
:make-wrapper
(lambda (g)
- (let ((df (adjustable-triangle-wave-duty-factor g)))
- (set! (adjustable-triangle-wave-gen g) (make-triangle-wave (adjustable-triangle-wave-frequency g)))
- (set! (adjustable-triangle-wave-top g) (- 1.0 df))
+ (let ((df (g 'duty-factor)))
+ (set! (g 'gen) (make-triangle-wave (g 'frequency)))
+ (set! (g 'top) (- 1.0 df))
+ (set! (g 'mtop) (- (g 'top)))
(if (not (= df 0.0))
- (set! (adjustable-triangle-wave-scl g) (/ (adjustable-triangle-wave-amplitude g) df)))
+ (set! (g 'scl) (/ (g 'amplitude) df)))
g))
-
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (adjustable-triangle-wave-gen g)))
- (lambda (g val) (set! (mus-frequency (adjustable-triangle-wave-gen g)) val) val))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (adjustable-triangle-wave-gen g)))
- (lambda (g val) (set! (mus-phase (adjustable-triangle-wave-gen g)) val) val))
-
- (list 'mus-scaler
- (lambda (g)
- (adjustable-triangle-wave-duty-factor g))
- (lambda (g val)
- (set! (adjustable-triangle-wave-duty-factor g) val)
- (set! (adjustable-triangle-wave-top g) (- 1.0 val))
- (if (not (= val 0.0))
- (set! (adjustable-triangle-wave-scl g) (/ (adjustable-triangle-wave-amplitude g) val)))
- val))))
-
+ :methods adjustable-triangle-wave-methods)
(frequency *clm-default-frequency*) (duty-factor 0.5) (amplitude 1.0)
- (gen #f :type clm) (top 0.0) (scl 0.0))
+ (gen #f) (top 0.0) (mtop 0.0) (scl 0.0) val fm)
+
+(define adjustable-triangle-wave
-(define* (adjustable-triangle-wave gen (fm 0.0))
- " (make-adjustable-triangle-wave frequency (duty-factor 0.5) (amplitude 1.0)) creates an adjustable-triangle-wave generator.\n\
- (adjustable-triangle-wave gen (fm 0.0)) returns a triangle-wave where the duty-factor sets the ratio of pulse duration to pulse period."
- (declare (gen adjustable-triangle-wave) (fm float))
- (let* ((val (triangle-wave (adjustable-triangle-wave-gen gen) fm))
- (top (adjustable-triangle-wave-top gen))
- (scl (adjustable-triangle-wave-scl gen)))
- (* scl (- val (max (- top) (min top val))))))
+ (let ((documentation "(make-adjustable-triangle-wave frequency (duty-factor 0.5) (amplitude 1.0)) creates an
+adjustable-triangle-wave generator. (adjustable-triangle-wave gen (fm 0.0)) returns a triangle-wave where the
+duty-factor sets the ratio of pulse duration to pulse period."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (set! val (triangle-wave gen fm))
+ (* scl (- val (max mtop (min top val))))))))
#|
(with-sound ()
(let ((gen (make-adjustable-triangle-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 22050))
- (outa i (adjustable-triangle-wave gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 22050))
+ (outa i (adjustable-triangle-wave gen)))))
|#
+(define adjustable-sawtooth-wave-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'gen)))
+ (lambda (g val) (set! (mus-frequency (g 'gen)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'gen)))
+ (lambda (g val) (set! (mus-phase (g 'gen)) val))))
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'duty-factor))
+ (lambda (g val)
+ (set! (g 'duty-factor) val)
+ (set! (g 'top) (- 1.0 val))
+ (set! (g 'mtop) (- val 1.0))
+ (if (not (= val 0.0))
+ (set! (g 'scl) (/ (g 'amplitude) val)))
+ val)))))
+
(defgenerator (adjustable-sawtooth-wave
:make-wrapper
(lambda (g)
- (let ((df (adjustable-sawtooth-wave-duty-factor g)))
- (set! (adjustable-sawtooth-wave-gen g) (make-sawtooth-wave (adjustable-sawtooth-wave-frequency g)))
- (set! (adjustable-sawtooth-wave-top g) (- 1.0 df))
+ (let ((df (g 'duty-factor)))
+ (set! (g 'gen) (make-sawtooth-wave (g 'frequency)))
+ (set! (g 'top) (- 1.0 df))
+ (set! (g 'mtop) (- df 1.0))
(if (not (= df 0.0))
- (set! (adjustable-sawtooth-wave-scl g) (/ (adjustable-sawtooth-wave-amplitude g) df)))
+ (set! (g 'scl) (/ (g 'amplitude) df)))
g))
+ :methods adjustable-sawtooth-wave-methods)
+ (frequency *clm-default-frequency*) (duty-factor 0.5) (amplitude 1.0)
+ (gen #f) (top 0.0) (mtop 0.0) (scl 0.0) val fm)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (adjustable-sawtooth-wave-gen g)))
- (lambda (g val) (set! (mus-frequency (adjustable-sawtooth-wave-gen g)) val) val))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (adjustable-sawtooth-wave-gen g)))
- (lambda (g val) (set! (mus-phase (adjustable-sawtooth-wave-gen g)) val) val))
-
- (list 'mus-scaler
- (lambda (g)
- (adjustable-sawtooth-wave-duty-factor g))
- (lambda (g val)
- (set! (adjustable-sawtooth-wave-duty-factor g) val)
- (set! (adjustable-sawtooth-wave-top g) (- 1.0 val))
- (if (not (= val 0.0))
- (set! (adjustable-sawtooth-wave-scl g) (/ (adjustable-sawtooth-wave-amplitude g) val)))
- val))))
- (frequency *clm-default-frequency*) (duty-factor 0.5) (amplitude 1.0)
- (gen #f :type clm) (top 0.0) (scl 0.0))
+(define adjustable-sawtooth-wave
+ (let ((documentation "(make-adjustable-sawtooth-wave frequency (duty-factor 0.5) (amplitude 1.0)) creates
+an adjustable-sawtooth-wave generator. (adjustable-sawtooth-wave gen (fm 0.0)) returns a sawtooth-wave where
+the duty-factor sets the ratio of pulse duration to pulse period."))
-(define* (adjustable-sawtooth-wave gen (fm 0.0))
- " (make-adjustable-sawtooth-wave frequency (duty-factor 0.5) (amplitude 1.0)) creates an adjustable-sawtooth-wave generator.\n\
- (adjustable-sawtooth-wave gen (fm 0.0)) returns a sawtooth-wave where the duty-factor sets the ratio of pulse duration to pulse period."
- (declare (gen adjustable-sawtooth-wave) (fm float))
- (let* ((val (sawtooth-wave (adjustable-sawtooth-wave-gen gen) fm))
- (top (adjustable-sawtooth-wave-top gen))
- (scl (adjustable-sawtooth-wave-scl gen)))
- (* scl (- val (max (- top) (min top val))))))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (set! val (sawtooth-wave gen fm))
+ (* scl (- val (max mtop (min top val))))))))
#|
(with-sound ()
(let ((gen (make-adjustable-sawtooth-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 22050))
- (outa i (adjustable-sawtooth-wave gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 22050))
+ (outa i (adjustable-sawtooth-wave gen)))))
|#
;;; and just for laughs... (almost anything would fit in this hack)
+(define adjustable-oscil-methods
+ (let ((copy-func (lambda (g)
+ (let ((e (inlet g))) ; (copy g) without invoking (g 'copy)
+ (let-set! e 'gen (mus-copy (g 'gen)))
+ e))))
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'gen)))
+ (lambda (g val) (set! (mus-frequency (g 'gen)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'gen)))
+ (lambda (g val) (set! (mus-phase (g 'gen)) val))))
+ (cons 'mus-scaler
+ (dilambda
+ (lambda (g) (g 'duty-factor))
+ (lambda (g val)
+ (set! (g 'duty-factor) val)
+ (set! (g 'top) (- 1.0 val))
+ (set! (g 'mtop) (- val 1.0))
+ (if (not (= val 0.0))
+ (set! (g 'scl) (/ val)))
+ val)))
+ (cons 'copy copy-func)
+ (cons 'mus-copy copy-func))))
+
+
(defgenerator (adjustable-oscil
:make-wrapper (lambda (g)
- (let ((df (adjustable-oscil-duty-factor g)))
- (set! (adjustable-oscil-gen g) (make-oscil (adjustable-oscil-frequency g)))
- (set! (adjustable-oscil-top g) (- 1.0 df))
+ (let ((df (g 'duty-factor)))
+ (set! (g 'gen) (make-oscil (g 'frequency)))
+ (set! (g 'top) (- 1.0 df))
+ (set! (g 'mtop) (- df 1.0))
(if (not (= df 0.0))
- (set! (adjustable-oscil-scl g) (/ 1.0 df)))
+ (set! (g 'scl) (/ df)))
g))
-
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (adjustable-oscil-gen g)))
- (lambda (g val) (set! (mus-frequency (adjustable-oscil-gen g)) val) val))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (adjustable-oscil-gen g)))
- (lambda (g val) (set! (mus-phase (adjustable-oscil-gen g)) val) val))
-
- (list 'mus-scaler
- (lambda (g)
- (adjustable-oscil-duty-factor g))
- (lambda (g val)
- (set! (adjustable-oscil-duty-factor g) val)
- (set! (adjustable-oscil-top g) (- 1.0 val))
- (if (not (= val 0.0))
- (set! (adjustable-oscil-scl g) (/ 1.0 val)))
- val))))
-
+ :methods adjustable-oscil-methods)
(frequency *clm-default-frequency*) (duty-factor 0.5)
- (gen #f :type clm) (top 0.0) (scl 0.0))
+ (gen #f) (top 0.0) (mtop 0.0) (scl 0.0) val fm)
-(define* (adjustable-oscil gen (fm 0.0))
- " (make-adjustable-oscil frequency (duty-factor 0.5)) creates an adjustable-oscil generator.\n\
- (adjustable-oscil gen (fm 0.0)) returns a sinusoid where the duty-factor sets the ratio of pulse duration to pulse period."
- (declare (gen adjustable-oscil) (fm float))
- (let* ((val (oscil (adjustable-oscil-gen gen) fm))
- (top (adjustable-oscil-top gen))
- (scl (adjustable-oscil-scl gen)))
- (* scl (- val (max (- top) (min top val))))))
+(define adjustable-oscil
+
+ (let ((documentation "(make-adjustable-oscil frequency (duty-factor 0.5)) creates an adjustable-oscil
+generator. (adjustable-oscil gen (fm 0.0)) returns a sinusoid where the duty-factor sets the ratio of pulse duration to pulse period."))
+
+ (lambda* (g (fm 0.0))
+ (let-set! g 'fm fm)
+ (with-let g
+ (set! val (oscil gen fm))
+ (* scl (- val (max mtop (min top val))))))))
#|
-(with-sound ()
+(with-sound (:statistics #t)
(let ((gen (make-adjustable-oscil 100 .2)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 22050))
- (outa i (adjustable-oscil gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 22050))
+ (outa i (adjustable-oscil gen)))))
|#
+
+
+
;;;--------------------------------------------------------------------------------
(define* (make-table-lookup-with-env frequency pulse-env size)
- (let* ((len (or size (clm-table-size)))
- (ve (make-vct len))
+ (let* ((len (or size *clm-table-size*))
+ (ve (make-float-vector len))
(e (make-env pulse-env :length len)))
(do ((i 0 (+ i 1)))
((= i len))
- (vct-set! ve i (env e)))
+ (float-vector-set! ve i (env e)))
(make-table-lookup frequency 0.0 ve len)))
(define* (make-wave-train-with-env frequency pulse-env size)
- (let* ((len (or size (clm-table-size)))
- (ve (make-vct len))
+ (let* ((len (or size *clm-table-size*))
+ (ve (make-float-vector len))
(e (make-env pulse-env :length len)))
(do ((i 0 (+ i 1)))
((= i len))
- (vct-set! ve i (env e)))
+ (float-vector-set! ve i (env e)))
(make-wave-train frequency 0.0 ve len)))
;;; --------------------------------------------------------------------------------
-(defgenerator (round-interp
- :make-wrapper (lambda (g)
- (set! (round-interp-rnd g) (make-rand-interp (round-interp-frequency g) (round-interp-amplitude g)))
- (set! (round-interp-flt g) (make-moving-average (round-interp-n g)))
- g)
-
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (round-interp-rnd g)))
- (lambda (g val) (set! (mus-frequency (round-interp-rnd g)) val) val))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (round-interp-rnd g)))
- (lambda (g val) (set! (mus-phase (round-interp-rnd g)) val) val))))
+(define round-interp-methods
+ (list
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (mus-frequency (g 'rnd)))
+ (lambda (g val) (set! (mus-frequency (g 'rnd)) val))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (mus-phase (g 'rnd)))
+ (lambda (g val) (set! (mus-phase (g 'rnd)) val))))))
+(defgenerator (round-interp
+ :make-wrapper (lambda (g)
+ (set! (g 'rnd) (make-rand-interp (g 'frequency) (g 'amplitude)))
+ (set! (g 'flt) (make-moving-average (g 'n)))
+ g)
+ :methods round-interp-methods)
(frequency *clm-default-frequency*) (n 1) (amplitude 1.0)
- (rnd #f :type clm) (flt #f :type clm))
+ (rnd #f) (flt #f) fm)
-(define* (round-interp gen (fm 0.0))
- " (make-round-interp frequency (n 1) (amplitude 1.0)) creates a round-interp generator.\n\
- (round-interp gen (fm 0.0)) returns a rand-interp sequence low-pass filtered by a moving-average generator of length n."
- (declare (gen round-interp) (fm float))
- (moving-average (round-interp-flt gen) (rand-interp (round-interp-rnd gen) fm)))
+(define round-interp
+
+ (let ((documentation "(make-round-interp frequency (n 1) (amplitude 1.0)) creates a round-interp
+generator. (round-interp gen (fm 0.0)) returns a rand-interp sequence low-pass filtered by a moving-average generator of length n."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (moving-average flt (rand-interp rnd fm))))))
#|
(with-sound (:channels 5)
@@ -4807,17 +4981,17 @@ index 10 (so 10/2 is the bes-jn arg):
(gen2 (make-round-interp 100 100))
(gen3 (make-round-interp 100 1000))
(gen4 (make-round-interp 100 10000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 100000))
- (out-any i (round-interp gen0 0.0) 0)
- (out-any i (round-interp gen1 0.0) 1)
- (out-any i (round-interp gen2 0.0) 2)
- (out-any i (round-interp gen3 0.0) 3)
- (out-any i (round-interp gen4 0.0) 4)))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (out-any i (round-interp gen0 0.0) 0)
+ (out-any i (round-interp gen1 0.0) 1)
+ (out-any i (round-interp gen2 0.0) 2)
+ (out-any i (round-interp gen3 0.0) 3)
+ (out-any i (round-interp gen4 0.0) 4))))
|#
+
;;; --------------------------------------------------------------------------------
;;;
;;; env-any functions
@@ -4839,10 +5013,11 @@ index 10 (so 10/2 is the bes-jn arg):
(define (multi-expt-env e expts)
(env-any e (lambda (y)
- (let ((b (vct-ref expts (modulo (channels e) (length expts)))))
+ (let ((b (expts (modulo (channels e) (length expts)))))
(/ (- (expt b y) 1.0) (- b 1.0))))))
+
;;; --------------------------------------------------------------------------------
;;;
;;; pm with any generator that has mus-phase and mus-run:
@@ -4858,7 +5033,7 @@ index 10 (so 10/2 is the bes-jn arg):
(gen2 (make-oscil 440.0)))
(do ((i 0 (+ i 1)))
((= i 1000))
- (let* ((pm (- 1.0 (random 2.0)))
+ (let* ((pm (mus-random 1.0))
(val1 (oscil gen1 0.0 pm))
(val2 (run-with-fm-and-pm gen2 0.0 pm)))
(if (fneq val1 val2)
@@ -4866,36 +5041,38 @@ index 10 (so 10/2 is the bes-jn arg):
|#
+
;;; --------------------------------------------------------------------------------
;;; cos^n J 121
(defgenerator (nchoosekcos
:make-wrapper (lambda (g)
- (set! (nchoosekcos-frequency g) (hz->radians (nchoosekcos-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0))
+ (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (angle 0.0) fm)
+
-(define* (nchoosekcos gen (fm 0.0))
- " (make-nchoosekcos frequency (ratio 1.0) (n 1)) creates an nchoosekcos generator.\n\
- (nchoosekcos gen (fm 0.0)) returns a sum of cosines scaled by the binomial coeffcients."
- (declare (gen nchoosekcos) (fm float))
- (let* ((x (nchoosekcos-angle gen))
- (y (* x (nchoosekcos-ratio gen)))
- (n (nchoosekcos-n gen)))
+(define nchoosekcos
- (set! (nchoosekcos-angle gen) (+ x fm (nchoosekcos-frequency gen)))
+ (let ((documentation "(make-nchoosekcos frequency (ratio 1.0) (n 1)) creates an nchoosekcos generator. (nchoosekcos gen (fm 0.0))
+returns a sum of cosines scaled by the binomial coeffcients."))
- (* (cos x)
- (expt (cos y) n))))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio)))
+ (set! angle (+ angle fm frequency))
+ (real-part (* (cos x)
+ (expt (cos y) n))))))))
#|
(with-sound (:clipped #f :statistics #t :play #t)
(let ((gen (make-nchoosekcos 2000.0 0.05 10)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (outa i (nchoosekcos gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (* .5 (nchoosekcos gen))))))
|#
@@ -4904,182 +5081,253 @@ index 10 (so 10/2 is the bes-jn arg):
;;;
;;; sinc-train
+(define sinc-train-methods
+ (list
+ (cons 'mus-order
+ (dilambda
+ (lambda (g) (g 'original-n))
+ (lambda (g val)
+ (if (<= val 0)
+ (begin
+ (set! (g 'original-n) 1)
+ (set! (g 'n) 3))
+ (begin
+ (set! (g 'original-n) val)
+ (set! (g 'n) (+ 1 (* 2 val)))))
+ (set! (g 'frequency) (* 0.5 (g 'n) (hz->radians (g 'original-frequency))))
+ (g 'original-n))))
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (g 'original-frequency))
+ (lambda (g val)
+ (set! (g 'original-frequency) val)
+ (set! (g 'frequency) (* 0.5 (g 'n) (hz->radians val)))
+ val)))))
+
(defgenerator (sinc-train
:make-wrapper (lambda (g)
- (if (<= (sinc-train-n g) 0)
+ (if (<= (g 'n) 0)
(begin
- (set! (sinc-train-original-n g) 1)
- (set! (sinc-train-n g) 3))
+ (set! (g 'original-n) 1)
+ (set! (g 'n) 3))
(begin
- (set! (sinc-train-original-n g) (sinc-train-n g))
- (set! (sinc-train-n g) (+ 1 (* 2 (sinc-train-n g)))))) ; mimic ncos
- (set! (sinc-train-original-frequency g) (sinc-train-frequency g))
- (set! (sinc-train-frequency g) (* 0.5 (sinc-train-n g) (hz->radians (sinc-train-frequency g))))
- g)
-
- :methods (list
- (list 'mus-order
- (lambda (g) (sinc-train-original-n g))
- (lambda (g val)
- (if (<= val 0)
- (begin
- (set! (sinc-train-original-n g) 1)
- (set! (sinc-train-n g) 3))
- (begin
- (set! (sinc-train-original-n g) val)
- (set! (sinc-train-n g) (+ 1 (* 2 val)))))
- (set! (sinc-train-frequency g) (* 0.5 (sinc-train-n g) (hz->radians (sinc-train-original-frequency g))))
- (sinc-train-original-n g)))
-
- (list 'mus-frequency
- (lambda (g) (sinc-train-original-frequency g))
- (lambda (g val)
- (set! (sinc-train-original-frequency g) val)
- (set! (sinc-train-frequency g) (* 0.5 (sinc-train-n g) (hz->radians val)))
- val))))
-
- (frequency *clm-default-frequency*) (n 1 :type int) (angle 0.0)
- (original-n 1 :type int) (original-frequency 0.0))
-
-
-(define* (sinc-train gen (fm 0.0))
- " (make-sinc-train frequency (n 1)) creates a sinc-train generator with n components.\n\
- (sinc-train gen (fm 0.0)) returns a sinc-train"
- (declare (gen sinc-train) (fm float))
- (let* ((x (sinc-train-angle gen))
- (n (sinc-train-n gen))
- (max-angle (* pi 0.5 n))
- (new-angle (+ x fm (sinc-train-frequency gen)))
- (DC (/ 1.0 n))
- (norm (/ n (- n 1))))
-
- (if (> new-angle max-angle)
- (set! new-angle (- new-angle (* pi n))))
-
- (set! (sinc-train-angle gen) new-angle)
-
- (if (< (abs x) nearly-zero)
- 1.0
- (* norm (- (/ (sin x) x) DC)))))
-
+ (set! (g 'original-n) (g 'n))
+ (set! (g 'n) (+ 1 (* 2 (g 'n)))))) ; mimic ncos
+ (set! (g 'original-frequency) (g 'frequency))
+ (set! (g 'frequency) (* 0.5 (g 'n) (hz->radians (g 'frequency))))
+ g)
+ :methods sinc-train-methods)
+ (frequency *clm-default-frequency*) (n 1) (angle 0.0)
+ (original-n 1) (original-frequency 0.0) fm)
+
+
+(define sinc-train
+ (let ((documentation "(make-sinc-train frequency (n 1)) creates a sinc-train generator with n components. (sinc-train gen (fm 0.0)) returns a sinc-train"))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x angle)
+ (max-angle (* pi 0.5 n))
+ (new-angle (+ x fm frequency))
+ (DC (/ 1.0 n))
+ (norm (/ n (- n 1))))
+ (if (> new-angle max-angle)
+ (set! new-angle (- new-angle (* pi n))))
+ (set! angle new-angle)
+ (if (< (abs x) nearly-zero)
+ 1.0
+ (* norm (- (/ (sin x) x) DC))))))))
#|
(with-sound (:clipped #f :statistics #t)
(let* ((g (make-sinc-train 100.0 40)))
(do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (sinc-train g 0.0)))))
+ (outa i (* .5 (sinc-train g 0.0))))))
|#
+
;;; --------------------------------------------------------------------------------
;;;
;;; pink-noise (based on rand-bank idea of Orfanidis)
+#|
(defgenerator (pink-noise
:make-wrapper (lambda (g)
- (if (<= (pink-noise-n g) 0) (set! (pink-noise-n g) 1))
- (let ((n (pink-noise-n g)))
- (set! (pink-noise-rands g) (make-vector n))
+ (if (<= (g 'n) 0) (set! (g 'n) 1))
+ (let ((n (g 'n)))
+ (set! (g 'rands) (make-vector n))
(do ((i 0 (+ i 1)))
((= i n))
- (set! ((pink-noise-rands g) i) (make-rand :frequency (/ (mus-srate) (expt 2 i))))
- (set! (mus-phase ((pink-noise-rands g) i)) (random pi))))
+ (set! ((g 'rands) i) (make-rand :frequency (/ *clm-srate* (expt 2 i))))
+ (set! (mus-phase ((g 'rands) i)) (random pi))))
g))
- (n 1) (rands #f :type clm-vector))
+ (n 1) (rands #f))
-(define (pink-noise gen)
- " (make-pink-noise (n 1)) creates a pink-noise generator with n octaves of rand (12 is recommended).\n\
- (pink-noise gen) returns the next random value in the 1/f stream produced by gen."
- (declare (gen pink-noise))
- (let ((val 0.0)
- (rands (pink-noise-rands gen))
- (n (pink-noise-n gen)))
- (do ((i 0 (+ i 1)))
- ((= i n))
- (set! val (+ val (rand (rands i)))))
- (/ val (* 2.5 (sqrt n))))) ; this normalization is not quite right
+(define pink-noise
+
+ (let ((documentation "(make-pink-noise (n 1)) creates a pink-noise generator with n octaves of rand (12 is recommended). (pink-noise gen)
+returns the next random value in the 1/f stream produced by gen."))
+
+ (lambda (gen)
+ (with-let gen
+ (/ (rand-bank rands) (* 2.5 (sqrt n))))))) ; this normalization is not quite right
+|#
+(define* (make-pink-noise (n 1))
+ (let ((v (make-float-vector (* n 2)))
+ (amp (/ (* 2.5 (sqrt n)))))
+ (set! (v 0) amp)
+ (do ((i 2 (+ i 2)))
+ ((= i (* 2 n)))
+ (set! (v i) (mus-random amp))
+ (set! (v (+ i 1)) (random 1.0)))
+ v))
+
+(define pink-noise? float-vector?)
+
+;;; pink-noise func is in clm2xen.c
+
+#|
+(define (pink-noise v)
+ (let ((amp (v 0))
+ (sum 0.0)
+ (p 0.0)
+ (len (length v)))
+ (do ((i 2 (+ i 2))
+ (x 0.5 (* x 0.5)))
+ ((= i len)
+ (+ sum (mus-random amp)))
+ (set! sum (+ sum (v i)))
+ (set! p (- (v (+ i 1)) x))
+ (if (negative? p)
+ (begin
+ (set! (v (+ i 1)) (+ p 1.0))
+ (set! (v i) (mus-random amp)))
+ (set! (v (+ i 1)) p)))))
+|#
#|
(with-sound (:clipped #f :statistics #t)
- (let* ((gen (make-pink-noise 12)))
+ (let ((gen (make-pink-noise 12)))
(do ((i 0 (+ i 1)))
((= i 44100))
(outa i (pink-noise gen)))))
+
+(with-sound (:statistics #t) (let ((gen (make-pink-noise 12))) (do ((i 0 (+ i 1))) ((= i 441000)) (outa i (pink-noise gen)))))
|#
+
;;; --------------------------------------------------------------------------------
;;;
;;; brown-noise
+
(defgenerator (brown-noise
:make-wrapper (lambda (g)
- (set! (brown-noise-frequency g) (hz->radians (brown-noise-frequency g)))
- (set! (brown-noise-sum g) (mus-random (brown-noise-amplitude g)))
+ (set! (g 'gr) (make-rand (g 'frequency) (g 'amplitude)))
g))
- (frequency *clm-default-frequency*) (amplitude 1.0) (angle 0.0) (sum 0.0))
+ (frequency *clm-default-frequency*) (amplitude 1.0) fm gr (sum 0.0) (prev 0.0))
-(define* (brown-noise gen (fm 0.0))
- " (make-brown-noise frequency (amplitude 1.0)) returns a generator that produces brownian noise.\n\
- (brown-noise gen (fm 0.0)) returns the next brownian noise sample."
- (declare (gen brown-noise) (fm float))
- (let ((x (brown-noise-angle gen))
- (two-pi (* 2 pi)))
- (if (or (>= x two-pi)
- (< x 0.0))
- (begin
- (set! x (modulo x two-pi))
- (if (< x 0.0) (set! x (+ x two-pi)))
- (set! (brown-noise-sum gen) (+ (brown-noise-sum gen) (mus-random (brown-noise-amplitude gen))))))
- (set! (brown-noise-angle gen) (+ x fm (brown-noise-frequency gen)))
- (brown-noise-sum gen)))
+(define brown-noise
+
+ (let ((documentation "(make-brown-noise frequency (amplitude 1.0)) returns a generator that produces
+brownian noise. (brown-noise gen (fm 0.0)) returns the next brownian noise sample."))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((val (rand gr fm)))
+ (if (not (= val prev))
+ (begin
+ (set! prev val)
+ (set! sum (+ sum val))))
+ sum)))))
+
#|
+;; this is slightly faster, but ugly
+(define* (make-brown-noise (frequency 440.0) (amplitude 1.0))
+ (vector 0.0 0.0 (make-rand frequency amplitude)))
+
+(define (brown-noise? g)
+ (and (vector? g)
+ (= (length g) 3)
+ (rand? (g 2))))
+
+(define* (brown-noise g (fm 0.0))
+ (let ((val (rand (vector-ref g 2) fm)))
+ (if (not (= val (vector-ref g 1)))
+ (begin
+ (vector-set! g 1 val)
+ (vector-set! g 0 (+ (vector-ref g 0) val))))
+ (vector-ref g 0)))
+
(with-sound (:clipped #f :statistics #t)
(let* ((gen (make-brown-noise 1000)))
(do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (brown-noise gen)))))
+ (outa i (* .01 (brown-noise gen))))))
|#
+
;;; --------------------------------------------------------------------------------
;;;
;;; green-noise
(defgenerator (green-noise
:make-wrapper (lambda (g)
- (set! (green-noise-frequency g) (hz->radians (green-noise-frequency g)))
+ (set! (g 'gr) (make-rand (g 'frequency) (g 'amplitude)))
+ (set! (g 'sum) (* 0.5 (+ (g 'low) (g 'high))))
g))
(frequency *clm-default-frequency*) (amplitude 1.0) (low -1.0) (high 1.0)
- (angle 0.0) (sum 0.0))
+ fm gr (sum 0.0) (prev 0.0))
-(define* (green-noise gen (fm 0.0))
- "(make-green-noise frequency (amplitude 1.0) (low -1.0) (high 1.0)) returns a new green-noise (bounded brownian noise) generator.\n\
- (green-noise gen (fm 0.0)) returns the next sample in a sequence of bounded brownian noise samples."
- (declare (gen green-noise) (fm float))
- (let* ((x (green-noise-angle gen))
- (two-pi (* 2 pi)))
- (if (or (>= x two-pi)
- (< x 0.0))
- (begin
- (set! x (modulo x two-pi))
- (if (< x 0.0) (set! x (+ x two-pi)))
- (let ((val (mus-random (green-noise-amplitude gen))))
- (set! (green-noise-sum gen) (+ (green-noise-sum gen) val))
- (if (not (<= (green-noise-low gen) (green-noise-sum gen) (green-noise-high gen)))
- (set! (green-noise-sum gen) (- (green-noise-sum gen) (* 2 val)))))))
- (set! (green-noise-angle gen) (+ x fm (green-noise-frequency gen)))
- (green-noise-sum gen)))
+(define green-noise
+
+ (let ((documentation "(make-green-noise frequency (amplitude 1.0) (low -1.0) (high 1.0)) returns a new
+green-noise (bounded brownian noise) generator. (green-noise gen (fm 0.0)) returns the next sample in a
+sequence of bounded brownian noise samples."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((val (rand gr fm)))
+ (if (not (= val prev))
+ (begin
+ (set! prev val)
+ (set! sum (+ sum val))
+ (if (not (<= low sum high))
+ (set! sum (- sum (* 2 val))))))
+ sum)))))
+
#|
+(define* (make-green-noise (frequency 440.0) (amplitude 1.0) (low -1.0) (high 1.0))
+ (vector 0.0 0.0 low high (make-rand frequency amplitude)))
+
+(define (green-noise? g)
+ (and (vector? g)
+ (= (length g) 5)
+ (rand? (g 4))))
+
+(define* (green-noise g (fm 0.0))
+ (let ((val (rand (g 4) fm)))
+ (if (not (= val (g 1)))
+ (begin
+ (set! (g 1) val)
+ (set! (g 0) (+ (g 0) val))
+ (if (not (<= (g 2) (g 0) (g 3)))
+ (set! (g 0) (- (g 0) (* 2.0 val))))))
+ (g 0)))
+
(with-sound (:clipped #f :statistics #t)
(let* ((gen (make-green-noise 1000)))
(do ((i 0 (+ i 1)))
@@ -5096,35 +5344,35 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (green-noise-interp
:make-wrapper (lambda (g)
- (set! (green-noise-interp-frequency g) (hz->radians (green-noise-interp-frequency g)))
- (set! (green-noise-interp-incr g) (/ (* (mus-random (green-noise-interp-amplitude g))
- (green-noise-interp-frequency g))
- (* 2 pi)))
+ (set! (g 'sum) (* 0.5 (+ (g 'low) (g 'high))))
+ (set! (g 'dv) (/ 1.0 (ceiling (/ *clm-srate* (max 1.0 (g 'frequency))))))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'incr) (* (mus-random (g 'amplitude)) dv))
g))
(frequency *clm-default-frequency*) (amplitude 1.0) (low -1.0) (high 1.0)
- (angle 0.0) (sum 0.0) (incr 0.0))
+ (angle 0.0) (sum 0.0) (incr 0.0) fm dv)
-(define* (green-noise-interp gen (fm 0.0))
- "(make-green-noise-interp frequency (amplitude 1.0) (low -1.0) (high 1.0)) returns a new interpolating green noise (bounded brownian noise) generator.\n\
- (green-noise-interp gen (fm 0.0)) returns the next sample in a sequence of interpolated bounded brownian noise samples."
- (declare (gen green-noise-interp) (fm float))
- (let* ((x (green-noise-interp-angle gen))
- (two-pi (* 2 pi)))
- (if (or (>= x two-pi)
- (< x 0.0))
- (begin
- (set! x (modulo x two-pi))
- (if (< x 0.0) (set! x (+ x two-pi)))
- (let* ((val (mus-random (green-noise-interp-amplitude gen)))
- (end (+ (green-noise-interp-sum gen) val)))
- (if (not (<= (green-noise-interp-low gen) end (green-noise-interp-high gen)))
- (set! val (* -2 val)))
- (set! (green-noise-interp-incr gen) (/ (* val (green-noise-interp-frequency gen))
- (* 2 pi))))))
- (set! (green-noise-interp-angle gen) (+ x fm (green-noise-interp-frequency gen)))
- (set! (green-noise-interp-sum gen) (+ (green-noise-interp-sum gen) (green-noise-interp-incr gen)))
- (green-noise-interp-sum gen)))
+(define green-noise-interp
+
+ (let ((documentation "(make-green-noise-interp frequency (amplitude 1.0) (low -1.0) (high 1.0)) returns a new
+interpolating green noise (bounded brownian noise) generator. (green-noise-interp gen (fm 0.0)) returns the next
+sample in a sequence of interpolated bounded brownian noise samples."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (if (not (<= 0.0 angle two-pi))
+ (let ((val (mus-random amplitude)))
+ (set! angle (modulo angle two-pi))
+ (if (< angle 0.0) (set! angle (+ angle two-pi)))
+ (if (not (<= low (+ sum val) high))
+ (set! val (min (- high sum)
+ (max (- low sum)
+ (- val))))) ; at least bounce
+ (set! incr (* dv val))))
+ (set! angle (+ angle fm frequency))
+ (set! sum (+ sum incr))))))
#|
(with-sound (:clipped #f :statistics #t)
@@ -5136,90 +5384,54 @@ index 10 (so 10/2 is the bes-jn arg):
(definstrument (green1 beg end freq amp lo hi)
(let ((grn (make-green-noise :frequency freq :amplitude amp :high hi :low lo)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (green-noise grn 0.0))))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (green-noise grn 0.0)))))
(definstrument (green2 beg end freq amp lo hi)
(let ((grn (make-green-noise-interp :frequency freq :amplitude amp :high hi :low lo)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (green-noise-interp grn 0.0))))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (green-noise-interp grn 0.0)))))
(with-sound () (green1 0 10000 1000 0.1 -0.5 0.5) (green2 10000 20000 1000 0.1 -0.5 0.5))
(definstrument (green3 start dur freq amp amp-env noise-freq noise-width noise-max-step)
;; brownian noise on amp env
- (let* ((grn (make-green-noise-interp :frequency noise-freq :amplitude noise-max-step :high (* 0.5 noise-width) :low (* -0.5 noise-width)))
+ (let ((grn (make-green-noise-interp :frequency noise-freq :amplitude noise-max-step :high (* 0.5 noise-width) :low (* -0.5 noise-width)))
(osc (make-oscil freq))
(e (make-env amp-env :scaler amp :duration dur))
(beg (seconds->samples start))
- (end (+ beg (seconds->samples dur))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* (env e)
- (+ 1.0 (green-noise-interp grn 0.0))
- (oscil osc)))))))
+ (end (seconds->samples (+ start dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* (env e)
+ (+ 1.0 (green-noise-interp grn 0.0))
+ (oscil osc))))))
(with-sound () (green3 0 2.0 440 .5 '(0 0 1 1 2 1 3 0) 100 .2 .02))
(definstrument (green4 start dur freq amp freq-env gliss noise-freq noise-width noise-max-step)
;; same but on freq env
- (let* ((grn (make-green-noise-interp :frequency noise-freq :amplitude noise-max-step :high (* 0.5 noise-width) :low (* -0.5 noise-width)))
+ (let ((grn (make-green-noise-interp :frequency noise-freq
+ :amplitude (hz->radians noise-max-step)
+ :high (hz->radians (* 0.5 noise-width))
+ :low (hz->radians (* -0.5 noise-width))))
(osc (make-oscil freq))
- (e (make-env freq-env :scaler gliss :duration dur))
+ (e (make-env freq-env :scaler (hz->radians gliss) :duration dur))
(beg (seconds->samples start))
- (end (+ beg (seconds->samples dur))))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (* amp (oscil osc (hz->radians (+ (env e) (green-noise-interp grn 0.0))))))))))
+ (end (seconds->samples (+ start dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil osc (+ (env e) (green-noise-interp grn 0.0))))))))
-(with-sound () (green4 0 2.0 440 .5 '(0 0 1 1 2 1 3 0) 440 100 100 10))
+(with-sound (:statistics #t) (green4 0 2.0 440 .5 '(0 0 1 1 2 1 3 0) 440 100 100 10))
|#
-;;; --------------------------------------------------------------------------------
-;;;
-;;; moving-max
-
-(defgenerator (moving-max
- :make-wrapper (lambda (g)
- (let ((dly (make-delay (moving-max-n g))))
- (set! (moving-max-gen g) dly)
- (set! (mus-scaler dly) 0.0)
- g))
- :methods (list
- (list 'mus-data
- (lambda (g) (mus-data (moving-max-gen g))))
- (list 'mus-scaler
- (lambda (g) (mus-scaler (moving-max-gen g)))
- (lambda (g val)
- (set! (mus-scaler (moving-max-gen g)) val)
- val))))
- (n 128 :type int) (gen #f :type clm))
-
-
-(define (moving-max gen y)
- "(make-moving-max (n 128) returns a moving-max generator.\n\
- (moving-max gen input) returns the maxamp over the last n inputs."
- (declare (gen moving-max) (y float))
- (let* ((absy (abs y))
- (dly (moving-max-gen gen))
- (mx (delay dly absy)))
- (if (>= absy (mus-scaler dly))
- (set! (mus-scaler dly) absy)
- (if (>= mx (mus-scaler dly))
- (set! (mus-scaler dly) (vct-peak (mus-data dly)))))
- (mus-scaler dly)))
-
-
;;; --------------------------------------------------------------------------------
;;;
@@ -5227,19 +5439,25 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (moving-sum
:make-wrapper (lambda (g)
- (let ((dly (make-moving-average (moving-sum-n g))))
- (set! (moving-sum-gen g) dly)
+ (let ((dly (make-moving-average (g 'n))))
+ (set! (g 'gen) dly)
(set! (mus-increment dly) 1.0) ; this is 1/n by default
g)))
- (n 128 :type int) (gen #f :type clm))
+ (n 128) (gen #f))
+
+(define moving-sum
+
+ (let ((documentation "(make-moving-sum (n 128)) returns a moving-sum generator. (moving-sum gen input)
+returns the sum of the absolute values in a moving window over the last n inputs."))
+
+ (lambda (gen y)
+ (moving-average (gen 'gen) (abs y)))))
+
+
+(define (make-unmoving-sum) (make-one-pole 1.0 -1.0))
+(define unmoving-sum one-pole)
-(define (moving-sum gen y)
- " (make-moving-sum (n 128) returns a moving-sum generator.\n\
- (moving-sum gen input) returns the sum of the absolute values in a moving window over the last n inputs."
- (declare (gen moving-sum) (y float))
- (moving-average (moving-sum-gen gen) (abs y)))
-
;;; --------------------------------------------------------------------------------
@@ -5250,28 +5468,29 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (moving-variance
:make-wrapper (lambda (g)
- (let ((g1 (make-moving-average (moving-variance-n g)))
- (g2 (make-moving-average (moving-variance-n g))))
- (set! (moving-variance-gen1 g) g1)
+ (let ((g1 (make-moving-average (g 'n)))
+ (g2 (make-moving-average (g 'n))))
+ (set! (g 'gen1) g1)
(set! (mus-increment g1) 1.0)
- (set! (moving-variance-gen2 g) g2)
+ (set! (g 'gen2) g2)
(set! (mus-increment g2) 1.0)
g)))
- (n 128 :type int) (gen1 #f :type clm) (gen2 #f :type clm))
+ (n 128) (gen1 #f) (gen2 #f) y)
(define (moving-variance gen y)
- (declare (gen moving-variance) (y float))
- (let* ((x1 (moving-average (moving-variance-gen1 gen) y))
- (x2 (moving-average (moving-variance-gen2 gen) (* y y)))
- (n (moving-variance-n gen)))
- (/ (- (* n x2)
- (* x1 x1))
- (* n (- n 1)))))
+ (let-set! gen 'y y)
+ (with-let gen
+ (let ((x1 (moving-average gen1 y))
+ (x2 (moving-average gen2 (* y y))))
+ (/ (- (* n x2)
+ (* x1 x1))
+ (* n (- n 1))))))
+
#|
(with-sound (:clipped #f)
- (let* ((gen (make-moving-variance 128)))
+ (let ((gen (make-moving-variance 128)))
(do ((i 0 (+ i 1)))
((= i 10000))
(outa i (moving-variance gen (random 1.0))))))
@@ -5289,20 +5508,25 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (moving-rms
:make-wrapper (lambda (g)
- (set! (moving-rms-gen g) (make-moving-average (moving-rms-n g)))
+ (set! (g 'gen) (make-moving-average (g 'n)))
g))
- (n 128 :type int) (gen #f :type clm))
+ (n 128) (gen #f) y)
+
+
+(define moving-rms
+
+ (let ((documentation "(make-moving-rms (n 128) returns a moving-rms generator. (moving-rms gen input) returns
+the rms of the values in a window over the last n inputs."))
+ (lambda (gen y)
+ (let-set! gen 'y y)
+ (with-let gen
+ (sqrt (max 0.0
+ ;; this is tricky -- due to floating point inaccuracy, we can get negative output
+ ;; from moving-rms even if all the inputs are positive! The sqrt then returns
+ ;; a complex number and all hell breaks loose
+ (moving-average gen (* y y))))))))
-(define (moving-rms gen y)
- " (make-moving-rms (n 128) returns a moving-rms generator.\n\
- (moving-rms gen input) returns the rms of the values in a window over the last n inputs."
- (declare (gen moving-rms) (y float))
- (sqrt (max 0.0 ;; this is tricky -- due to floating point inaccuracy, we can get negative output
- ;; from moving-rms even if all the inputs are positive! The sqrt then returns
- ;; a complex number and all hell breaks loose (in run, you'll get a complaint
- ;; about an integer > 32 bits).
- (moving-average (moving-rms-gen gen) (* y y)))))
@@ -5312,19 +5536,32 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (moving-length
:make-wrapper (lambda (g)
- (let ((dly (make-moving-average (moving-length-n g))))
- (set! (moving-length-gen g) dly)
+ (let ((dly (make-moving-average (g 'n))))
+ (set! (g 'gen) dly)
(set! (mus-increment dly) 1.0)
g)))
- (n 128 :type int) (gen #f :type clm))
+ (n 128) (gen #f) y)
-(define (moving-length gen y)
- " (make-moving-length (n 128) returns a moving-length generator.\n\
- (moving-length gen input) returns the length of the values in a window over the last few inputs."
- (declare (gen moving-length) (y float))
- (sqrt (max 0.0 (moving-average (moving-length-gen gen) (* y y)))))
+(define moving-length
+ (let ((documentation "(make-moving-length (n 128) returns a moving-length generator. (moving-length gen input)
+returns the length of the values in a window over the last few inputs."))
+
+ (lambda (gen y)
+ (let-set! gen 'y y)
+ (with-let gen
+ (sqrt (max 0.0 (moving-average gen (* y y))))))))
+
+
+#|
+(let ((ml (make-moving-length 128))
+ (rd (make-readin "oboe.snd")))
+ (with-sound ()
+ (do ((i 0 (+ i 1)))
+ ((= i 50828))
+ (outa i (moving-length ml (readin rd))))))
+|#
#|
;; perhaps also use moving-rms gen to avoid amplifying noise-sections (or even squlech them)
@@ -5352,28 +5589,26 @@ index 10 (so 10/2 is the bes-jn arg):
(defgenerator (weighted-moving-average
:make-wrapper (lambda (g)
- (let ((dly (make-moving-average (weighted-moving-average-n g))))
- (set! (mus-increment dly) 1.0)
- (set! (weighted-moving-average-gen g) dly)
- g)))
- (n 128 :type int) (gen #f :type clm) (num 0.0) (sum 0.0))
+ (let ((n (g 'n)))
+ (let ((dly (make-moving-average n)))
+ (set! (mus-increment dly) 1.0)
+ (set! (g 'dly) dly)
+ (set! (g 'den) (* 0.5 (+ n 1) n))
+ g))))
+ (n 128) (dly #f) (num 0.0) (sum 0.0) y den)
-(define (weighted-moving-average gen y)
- " (make-weighted-moving-average (n 128) returns a weighted-moving-average generator.\n\
- (weighted-moving-average gen y) returns the sum of the last n inputs weighted by 1/n"
- (declare (gen weighted-moving-average) (y float))
- (let* ((dly (weighted-moving-average-gen gen))
- (n (mus-order dly))
- (den (/ (* (+ 1 n) n) 2))
- (num (weighted-moving-average-num gen))
- (sum (weighted-moving-average-sum gen)))
- (set! num (- (+ num (* n y)) sum))
- (set! sum (moving-average dly y))
- (set! (weighted-moving-average-num gen) num)
- (set! (weighted-moving-average-sum gen) sum)
- (/ num den)))
-
+(define weighted-moving-average
+
+ (let ((documentation "(make-weighted-moving-average (n 128)) returns a weighted-moving-average
+generator. (weighted-moving-average gen y) returns the sum of the last n inputs weighted by 1/n"))
+
+ (lambda (gen y)
+ (let-set! gen 'y y)
+ (with-let gen
+ (set! num (- (+ num (* n y)) sum))
+ (set! sum (moving-average dly y))
+ (/ num den)))))
@@ -5383,20 +5618,29 @@ index 10 (so 10/2 is the bes-jn arg):
;;;
;;; geometric (r^n) weights
+#|
(defgenerator (exponentially-weighted-moving-average
:make-wrapper (lambda (g)
- (let* ((n (exponentially-weighted-moving-average-n g))
+ (let* ((n (g 'n))
(flt (make-one-pole (/ 1.0 n) (/ (- n) (+ 1.0 n)))))
- (set! (exponentially-weighted-moving-average-gen g) flt)
+ (set! (g 'gen) flt)
g)))
- (n 128 :type int) (gen #f :type clm))
+ (n 128) (gen #f))
-(define (exponentially-weighted-moving-average gen y)
- " (make-exponentially-weighted-moving-average (n 128) returns an exponentially-weighted-moving-average generator.\n\
- (exponentially-weighted-moving-average gen y) returns the sum of the last n inputs weighted by (-n/(n+1))^k"
- (declare (gen exponentially-weighted-moving-average) (y float))
- (one-pole (exponentially-weighted-moving-average-gen gen) y))
+(define exponentially-weighted-moving-average
+
+ (let ((documentation "(make-exponentially-weighted-moving-average (n 128) returns an
+exponentially-weighted-moving-average generator. (exponentially-weighted-moving-average gen y)
+returns the sum of the last n inputs weighted by (-n/(n+1))^k"))
+
+ (lambda (gen y)
+ (one-pole (gen 'gen) y))))
+|#
+
+(define* (make-exponentially-weighted-moving-average (n 128)) (make-one-pole (/ 1.0 n) (/ (- n) (+ 1.0 n))))
+(define exponentially-weighted-moving-average? one-pole?)
+(define exponentially-weighted-moving-average one-pole)
@@ -5404,91 +5648,109 @@ index 10 (so 10/2 is the bes-jn arg):
;;;
;;; polyoid -- Tn + Un to get arbitrary initial-phases
+#|
+;;; old form, now replaced by built-in code (clm.c)
+
(defgenerator (polyoid
:make-wrapper (lambda (g)
- (let* ((lst (polyoid-partial-amps-and-phases g))
+ (let* ((lst (g 'partial-amps-and-phases))
(len (length lst))
(topk (let ((n 0))
(do ((i 0 (+ i 3)))
((>= i len))
- (set! n (max n (floor (vct-ref lst i)))))
+ (set! n (max n (floor (lst i)))))
n))
- (sin-amps (make-vct (+ topk 1)))
- (cos-amps (make-vct (+ topk 1))))
- (do ((j 0 (+ j 3))
- (i 0 (+ i 1)))
+ (sin-amps (make-float-vector (+ topk 1) 0.0))
+ (cos-amps (make-float-vector (+ topk 1) 0.0)))
+ (do ((j 0 (+ j 3)))
((>= j len))
- (let ((n (floor (vct-ref lst j)))
- (amp (vct-ref lst (+ j 1)))
- (phase (vct-ref lst (+ j 2))))
+ (let ((n (floor (lst j)))
+ (amp (lst (+ j 1)))
+ (phase (lst (+ j 2))))
(if (> n 0) ; constant only applies to cos side
- (vct-set! sin-amps n (* amp (cos phase))))
- (vct-set! cos-amps n (* amp (sin phase)))))
- (set! (polyoid-tn g) cos-amps)
- (set! (polyoid-un g) sin-amps)
- (set! (polyoid-frequency g) (hz->radians (polyoid-frequency g)))
+ (set! (sin-amps n) (* amp (cos phase))))
+ (set! (cos-amps n) (* amp (sin phase)))))
+ (set! (g 'tn) cos-amps)
+ (set! (g 'un) sin-amps)
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
-
+
:methods (list
- (list 'mus-data
- (lambda (g)
- (polyoid-tn g)))
- (list 'mus-xcoeffs
- (lambda (g)
- (polyoid-tn g)))
- (list 'mus-ycoeffs
- (lambda (g)
- (polyoid-un g)))
- (list 'mus-xcoeff
- (lambda (g ind)
- (vct-ref (polyoid-tn g) ind))
- (lambda (g ind val)
- (vct-set! (polyoid-tn g) ind val)))
- (list 'mus-ycoeff
- (lambda (g ind)
- (vct-ref (polyoid-un g) ind))
- (lambda (g ind val)
- (vct-set! (polyoid-un g) ind val)))))
-
- (frequency *clm-default-frequency*) (partial-amps-and-phases #f :type vct) (angle 0.0)
- (tn #f :type vct) (un #f :type vct))
+ (cons 'mus-data
+ (lambda (g) (g 'tn)))
+ (cons 'mus-xcoeffs
+ (lambda (g) (g 'tn)))
+ (cons 'mus-ycoeffs
+ (lambda (g) (g 'un)))
+ (cons 'mus-xcoeff
+ (dilambda
+ (lambda (g ind) ((g 'tn) ind))
+ (lambda (g ind val) (float-vector-set! (g 'tn) ind val))))
+ (cons 'mus-ycoeff
+ (dilambda
+ (lambda (g ind) ((g 'un) ind))
+ (lambda (g ind val) (float-vector-set! (g 'un) ind val))))))
+
+ (frequency *clm-default-frequency*) (partial-amps-and-phases #f) (angle 0.0)
+ (tn #f) (un #f) fm)
(define* (polyoid gen (fm 0.0))
- (declare (gen polyoid) (fm float))
- (let ((result (mus-chebyshev-tu-sum (polyoid-angle gen)
- (polyoid-tn gen)
- (polyoid-un gen))))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let ((x angle))
+ (set! angle (+ angle fm frequency))
+ (mus-chebyshev-tu-sum x tn un))))
+|#
- (set! (polyoid-angle gen) (+ (polyoid-angle gen) fm (polyoid-frequency gen)))
- result))
+(define polyoid polywave)
+(define (polyoid? g) (and (polywave? g) (= (mus-channel g) mus-chebyshev-both-kinds)))
+(define polyoid-tn mus-xcoeffs)
+(define polyoid-un mus-ycoeffs)
+
+(define* (make-polyoid (frequency *clm-default-frequency*) partial-amps-and-phases)
+ (let* ((lst partial-amps-and-phases)
+ (len (length lst))
+ (topk (let ((n 0))
+ (do ((i 0 (+ i 3)))
+ ((>= i len))
+ (set! n (max n (floor (lst i)))))
+ n))
+ (sin-amps (make-float-vector (+ topk 1) 0.0))
+ (cos-amps (make-float-vector (+ topk 1) 0.0)))
+ (do ((j 0 (+ j 3)))
+ ((>= j len))
+ (let ((n (floor (lst j)))
+ (amp (lst (+ j 1)))
+ (phase (lst (+ j 2))))
+ (if (> n 0) ; constant only applies to cos side
+ (set! (sin-amps n) (* amp (cos phase))))
+ (set! (cos-amps n) (* amp (sin phase)))))
+ (make-polywave frequency :xcoeffs cos-amps :ycoeffs sin-amps)))
(define (polyoid-env gen fm amps phases)
- (declare (gen polyoid) (fm float) (amps clm-vector) (phases clm-vector))
;; amps and phases are the envelopes, one for each harmonic, setting the sample-wise amp and phase
- (let* ((tn (polyoid-tn gen))
- (un (polyoid-un gen))
- (original-data (polyoid-partial-amps-and-phases gen))
+ (let* ((original-data (polyoid-partial-amps-and-phases gen))
(data-len (length original-data))
- (amps-len (length amps)))
+ (amps-len (length amps))
+ (tn (polyoid-tn gen))
+ (un (polyoid-un gen)))
(do ((i 0 (+ i 3))
(j 0 (+ j 1)))
((or (= j amps-len)
(= i data-len)))
- (let* ((hn (floor (vct-ref original-data i)))
- (amp (env (amps j)))
- (phase (env (phases j))))
- (vct-set! tn hn (* amp (sin phase)))
- (vct-set! un hn (* amp (cos phase)))))
+ (let ((hn (floor (original-data i)))
+ (amp (env (amps j)))
+ (phase (env (phases j))))
+ (set! (tn hn) (* amp (sin phase)))
+ (set! (un hn) (* amp (cos phase)))))
(polyoid gen fm)))
-
-
#|
(with-sound (:clipped #f)
(let ((samps 44100)
- (gen (make-polyoid 100.0 (vct 1 1 0.0))))
+ (gen (make-polyoid 100.0 (vector 1 1 0.0))))
(do ((i 0 (+ i 1)))
((= i samps))
(outa i (polyoid gen)))))
@@ -5504,96 +5766,68 @@ index 10 (so 10/2 is the bes-jn arg):
(with-sound (:clipped #f :statistics #t)
(let ((samps 44100)
- (gen (make-polyoid 100.0 (vct 1 0.5 0.0 51 0.25 0.0 64 .25 (/ pi 2)))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (outa i (polyoid gen))))))
+ (gen (make-polyoid 100.0 (vector 1 0.5 0.0 51 0.25 0.0 64 .25 (/ pi 2)))))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (polyoid gen)))))
(define (test-polyoid n)
(let* ((res (with-sound (:channels 2 :clipped #f)
- (let ((angle 0.0)
- (incr (hz->radians 1.0))
- (cur-phases (make-vct (* 3 n))))
+ (let ((freqs (make-float-vector n))
+ (phases (make-float-vector n)) ; for oscil-bank
+ (cur-phases (make-float-vector (* 3 n))) ; for polyoid
+ (amp (/ 1.0 n)))
(do ((i 0 (+ i 1))
(j 0 (+ j 3)))
((= i n))
- (vct-set! cur-phases j (+ i 1))
- (vct-set! cur-phases (+ j 1) (/ 1.0 n))
- (vct-set! cur-phases (+ j 2) (random (* 2 pi))))
- (let ((gen (make-polyoid 1.0 cur-phases)))
+ (set! (cur-phases j) (+ i 1))
+ (set! (cur-phases (+ j 1)) (/ 1.0 n))
+ (set! (cur-phases (+ j 2)) (random (* 2 pi)))
+
+ (set! (freqs i) (hz->radians (+ i 1.0)))
+ (set! (phases i) (cur-phases (+ j 2))))
+
+ (let ((gen (make-polyoid 1.0 cur-phases))
+ (obank (make-oscil-bank freqs phases (make-float-vector n 1.0) #t)))
(do ((i 0 (+ i 1)))
((= i 88200))
- (let ((poly-sum 0.0)
- (sin-sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! sin-sum (+ sin-sum (sin (+ (* (+ k 1) angle) (vct-ref cur-phases (+ (* 3 k) 2)))))))
- (set! poly-sum (polyoid gen))
- (set! angle (+ angle incr))
- (outa i (/ sin-sum n))
- (outb i poly-sum)))))))
- (snd (find-sound res)))
- (channel-distance snd 0 snd 1)))
-
-(define (test-polyoid-run n)
- (let* ((res (with-sound (:channels 2 :clipped #f)
- (let ((angle 0.0)
- (incr (hz->radians 1.0))
- (cur-phases (make-vct (* 3 n))))
- (do ((i 0 (+ i 1))
- (j 0 (+ j 3)))
- ((= i n))
- (vct-set! cur-phases j (+ i 1))
- (vct-set! cur-phases (+ j 1) (/ 1.0 n))
- (vct-set! cur-phases (+ j 2) (random (* 2 pi))))
- (let ((gen (make-polyoid 1.0 cur-phases)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 88200))
- (let ((poly-sum 0.0)
- (sin-sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! sin-sum (+ sin-sum (sin (+ (* (+ k 1) angle) (vct-ref cur-phases (+ (* 3 k) 2)))))))
- (set! poly-sum (polyoid gen))
- (set! angle (+ angle incr))
- (outa i (/ sin-sum n))
- (outb i poly-sum))))))))
+ (outa i (* amp (oscil-bank obank))))
+ (do ((i 0 (+ i 1)))
+ ((= i 88200))
+ (outb i (polyoid gen 0.0)))))))
(snd (find-sound res)))
- (channel-distance snd 0 snd 1)))
+ (channel-distance snd 0 snd 1)))
;;; 0 diff up to 4096 so far (unopt and opt) -- 1.0e-12 at 4096, opt is more than 20 times as fast
(with-sound (:clipped #f :channels 2 :statistics #t)
(let* ((samps 44100)
- (gen1 (make-polyoid 100.0 (vct 1 0.5 0.0 3 0.25 0.0 4 .25 0.0)))
- (gen2 (make-polyoid 100.0 (vct 1 0.5 0.0 3 0.25 0.0 4 .25 0.0)))
+ (gen1 (make-polyoid 100.0 (vector 1 0.5 0.0 3 0.25 0.0 4 .25 0.0)))
+ (gen2 (make-polyoid 100.0 (vector 1 0.5 0.0 3 0.25 0.0 4 .25 0.0)))
(amps1 (vector (make-env '(0 0 1 1 2 0) :end samps :scaler 0.5)
- (make-env '(0 1 1 0 2 1) :end samps :scaler 0.25)
- (make-env '(0 1 1 0) :end samps :scaler 0.25)))
+ (make-env '(0 1 1 0 2 1) :end samps :scaler 0.25)
+ (make-env '(0 1 1 0) :end samps :scaler 0.25)))
(phases1 (vector (make-env '(0 0 1 1) :end samps :scaler (/ pi 2))
- (make-env '(0 0 1 1) :end samps :scaler (/ pi 2))
- (make-env '(0 1 1 0) :end samps :scaler (/ pi 2))))
+ (make-env '(0 0 1 1) :end samps :scaler (/ pi 2))
+ (make-env '(0 1 1 0) :end samps :scaler (/ pi 2))))
(amps2 (vector (make-env '(0 0 1 1 2 0) :end samps :scaler 0.5)
- (make-env '(0 1 1 0 2 1) :end samps :scaler 0.25)
- (make-env '(0 1 1 0) :end samps :scaler 0.25)))
+ (make-env '(0 1 1 0 2 1) :end samps :scaler 0.25)
+ (make-env '(0 1 1 0) :end samps :scaler 0.25)))
(phases2 (vector (make-env '(0 0 1 0) :end samps)
- (make-env '(0 0 1 0) :end samps)
- (make-env '(0 0 1 0) :end samps))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (outa i (polyoid-env gen1 0.0 amps1 phases1))
- (outb i (polyoid-env gen2 0.0 amps2 phases2))))))
+ (make-env '(0 0 1 0) :end samps)
+ (make-env '(0 0 1 0) :end samps))))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (polyoid-env gen1 0.0 amps1 phases1))
+ (outb i (polyoid-env gen2 0.0 amps2 phases2)))))
(with-sound (:clipped #f :channels 2 :channels 3 :statistics #t)
(let* ((samps 44100)
- (gen1 (make-polyoid 100.0 (vct 1 1 0 2 1 0 3 1 0)))
- (gen2 (make-polyoid 100.0 (vct 1 1 0 2 1 0 3 1 0)))
- (gen3 (make-polyoid 100.0 (vct 1 1 (/ pi 2) 2 1 (/ pi 2) 3 1 (/ pi 2))))
+ (gen1 (make-polyoid 100.0 (vector 1 1 0 2 1 0 3 1 0)))
+ (gen2 (make-polyoid 100.0 (vector 1 1 0 2 1 0 3 1 0)))
+ (gen3 (make-polyoid 100.0 (vector 1 1 (/ pi 2) 2 1 (/ pi 2) 3 1 (/ pi 2))))
(amps1 (vector (make-env '(0 1 1 1) :end samps) (make-env '(0 1 1 1) :end samps) (make-env '(0 1 1 1) :end samps)))
(amps2 (vector (make-env '(0 1 1 1) :end samps) (make-env '(0 1 1 1) :end samps) (make-env '(0 1 1 1) :end samps)))
(amps3 (vector (make-env '(0 1 1 1) :end samps) (make-env '(0 1 1 1) :end samps) (make-env '(0 1 1 1) :end samps)))
@@ -5604,12 +5838,11 @@ index 10 (so 10/2 is the bes-jn arg):
(phases3 (vector (make-env '(0 1 1 1) :end samps :scaler (/ pi 2))
(make-env '(0 1 1 1) :end samps :scaler (/ pi 2))
(make-env '(0 1 1 1) :end samps :scaler (/ pi 2)))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (outa i (* .1 (polyoid-env gen1 0.0 amps1 phases1)))
- (outb i (* .1 (polyoid-env gen2 0.0 amps2 phases2)))
- (outc i (* .1 (polyoid-env gen3 0.0 amps3 phases3)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (* .1 (polyoid-env gen1 0.0 amps1 phases1)))
+ (outb i (* .1 (polyoid-env gen2 0.0 amps2 phases2)))
+ (outc i (* .1 (polyoid-env gen3 0.0 amps3 phases3))))))
|#
@@ -5619,35 +5852,35 @@ index 10 (so 10/2 is the bes-jn arg):
;;;
;;; noid -- sum of n sinusoids at arbitrary (default=random) initial phases
;;;
-;;; for max peak (all cos), set phases arg to (make-vct n (/ pi 2))
+;;; for max peak (all cos), set phases arg to (make-vector n (/ pi 2))
;;; for min peak, use one of the sets in peak-phases.scm (multiplied through by pi)
;;;
;;; since initial phases are 0 or pi in peak-phases.scm if n>20, this code could be optimized
-(define* (make-noid (frequency 0.0) (n 1) (phases #f) (choice 'all))
+(define* (make-noid (frequency 0.0) (n 1) phases (choice 'all))
(make-polyoid frequency
- (let ((amps (make-vct (* 3 n))))
+ (let ((amps (make-vector (* 3 n) 0.0)))
(do ((i 1 (+ i 1))
(j 0 (+ j 3)))
((> i n))
-
+
(case choice
- ((all) (vct-set! amps j i))
- ((odd) (vct-set! amps j (- (* 2 i) 1)))
- ((prime) (vct-set! amps j (some-primes (- i 1)))) ; defined below up to 1024th or so -- probably should use low-primes.scm
- ((even) (vct-set! amps j (max 1 (* 2 (- i 1))))))
+ ((all) (set! (amps j) i))
+ ((odd) (set! (amps j) (- (* 2 i) 1)))
+ ((prime) (set! (amps j) (some-primes (- i 1)))) ; defined below up to 1024th or so -- probably should use low-primes.scm
+ ((even) (set! (amps j) (max 1 (* 2 (- i 1))))))
- (vct-set! amps (+ j 1) (/ 1.0 n))
-
- (if (vct? phases)
- (vct-set! amps (+ j 2) (vct-ref phases (- i 1)))
+ (set! (amps (+ j 1)) (/ 1.0 n))
+
+ (if (vector? phases)
+ (set! (amps (+ j 2)) (phases (- i 1)))
(if (not phases)
- (vct-set! amps (+ j 2) (random (* 2 pi)))
+ (set! (amps (+ j 2)) (random (* 2 pi)))
(if (eq? phases 'max-peak)
- (vct-set! amps (+ j 2) (/ pi 2))
+ (set! (amps (+ j 2)) (/ pi 2))
;; else min-peak, handled below
))))
-
+
(if (eq? phases 'min-peak)
(let ((vector-find-if (lambda (func vect)
(let ((len (length vect))
@@ -5657,10 +5890,10 @@ index 10 (so 10/2 is the bes-jn arg):
result)
result)
(set! result (func (vect i))))))))
-
+
(if (not (defined? 'noid-min-peak-phases))
(load "peak-phases.scm"))
-
+
(let ((min-dat (vector-find-if
(lambda (val)
(and val
@@ -5669,7 +5902,7 @@ index 10 (so 10/2 is the bes-jn arg):
(let* ((a-val (val 1))
(a-len (length val))
(a-data (list a-val (val 2))))
- (do ((k 2 (+ 1 k)))
+ (do ((k 2 (+ k 1)))
((= k a-len))
(if (and (number? (val k))
(< (val k) a-val))
@@ -5683,14 +5916,14 @@ index 10 (so 10/2 is the bes-jn arg):
((prime) primoid-min-peak-phases)
((even) neven-min-peak-phases)))))
(if min-dat
- (let ((norm (car min-dat))
+ (let (;(norm (car min-dat))
(rats (cadr min-dat)))
(do ((i 1 (+ i 1))
(j 0 (+ j 3)))
((> i n))
- (vct-set! amps (+ j 1) (/ 1.0 n)) ;(/ 0.999 norm)) -- can't decide about this -- I guess it should be consistent with the #f case
- (vct-set! amps (+ j 2) (* pi (rats (- i 1))))))))))
-
+ (set! (amps (+ j 1)) (/ 1.0 n)) ;(/ 0.999 norm)) -- can't decide about this -- I guess it should be consistent with the #f case
+ (set! (amps (+ j 2)) (* pi (rats (- i 1))))))))))
+
amps)))
(define noid polyoid)
@@ -5698,63 +5931,63 @@ index 10 (so 10/2 is the bes-jn arg):
(define some-primes (vector 1
- 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61
- 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151
- 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251
- 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359
- 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463
- 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593
- 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701
- 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827
- 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953
- 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069
- 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213
- 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321
- 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481
- 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601
- 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733
- 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
- 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017
- 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143
- 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297
- 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423
- 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593
- 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713
- 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851
- 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011
- 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181
- 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323
- 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467
- 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607
- 3613 3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739
- 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907
- 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013 4019 4021 4027 4049
- 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211
- 4217 4219 4229 4231 4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349
- 4357 4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 4513
- 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 4643 4649 4651 4657
- 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813
- 4817 4831 4861 4871 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
- 4987 4993 4999 5003 5009 5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113
- 5119 5147 5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 5297
- 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 5431 5437 5441 5443
- 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 5531 5557 5563 5569 5573 5581 5591
- 5623 5639 5641 5647 5651 5653 5657 5659 5669 5683 5689 5693 5701 5711 5717 5737 5741 5743
- 5749 5779 5783 5791 5801 5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879
- 5881 5897 5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 6073
- 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 6203 6211 6217 6221
- 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 6317 6323 6329 6337 6343 6353 6359
- 6361 6367 6373 6379 6389 6397 6421 6427 6449 6451 6469 6473 6481 6491 6521 6529 6547 6551
- 6553 6563 6569 6571 6577 6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701
- 6703 6709 6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 6857
- 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 6977 6983 6991 6997
- 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 7121 7127 7129 7151 7159 7177 7187
- 7193 7207 7211 7213 7219 7229 7237 7243 7247 7253 7283 7297 7307 7309 7321 7331 7333 7349
- 7351 7369 7393 7411 7417 7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529
- 7537 7541 7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 7669
- 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 7793 7817 7823 7829
- 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 7927 7933 7937 7949 7951 7963 7993 8009
- 8011 8017 8039 8053 8059 8069 8081 8087 8089 8093 8101 8111 8117 8123 8147 8161 8167 8171))
+ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61
+ 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151
+ 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251
+ 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359
+ 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463
+ 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593
+ 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701
+ 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827
+ 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953
+ 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069
+ 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213
+ 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321
+ 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481
+ 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601
+ 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733
+ 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
+ 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017
+ 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143
+ 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297
+ 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423
+ 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593
+ 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713
+ 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851
+ 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011
+ 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181
+ 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323
+ 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467
+ 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607
+ 3613 3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739
+ 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907
+ 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013 4019 4021 4027 4049
+ 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211
+ 4217 4219 4229 4231 4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349
+ 4357 4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 4513
+ 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 4643 4649 4651 4657
+ 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813
+ 4817 4831 4861 4871 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
+ 4987 4993 4999 5003 5009 5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113
+ 5119 5147 5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 5297
+ 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 5431 5437 5441 5443
+ 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 5531 5557 5563 5569 5573 5581 5591
+ 5623 5639 5641 5647 5651 5653 5657 5659 5669 5683 5689 5693 5701 5711 5717 5737 5741 5743
+ 5749 5779 5783 5791 5801 5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879
+ 5881 5897 5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 6073
+ 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 6203 6211 6217 6221
+ 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 6317 6323 6329 6337 6343 6353 6359
+ 6361 6367 6373 6379 6389 6397 6421 6427 6449 6451 6469 6473 6481 6491 6521 6529 6547 6551
+ 6553 6563 6569 6571 6577 6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701
+ 6703 6709 6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 6857
+ 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 6977 6983 6991 6997
+ 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 7121 7127 7129 7151 7159 7177 7187
+ 7193 7207 7211 7213 7219 7229 7237 7243 7247 7253 7283 7297 7307 7309 7321 7331 7333 7349
+ 7351 7369 7393 7411 7417 7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529
+ 7537 7541 7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 7669
+ 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 7793 7817 7823 7829
+ 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 7927 7933 7937 7949 7951 7963 7993 8009
+ 8011 8017 8039 8053 8059 8069 8081 8087 8089 8093 8101 8111 8117 8123 8147 8161 8167 8171))
#|
@@ -5769,7 +6002,7 @@ index 10 (so 10/2 is the bes-jn arg):
(let* ((samps 44100)
(n 10)
(gen (make-noid 1.0 n 'min-peak))
- (gen2 (make-oscil n (vct-ref (polyoid-partial-amps-and-phases gen) (- (length (polyoid-partial-amps-and-phases gen)) 1)))))
+ (gen2 (make-oscil n ((polyoid-partial-amps-and-phases gen) (- (length (polyoid-partial-amps-and-phases gen)) 1)))))
(do ((i 0 (+ i 1)))
((= i samps))
(outa i (noid gen))
@@ -5792,7 +6025,7 @@ index 10 (so 10/2 is the bes-jn arg):
(with-sound (:clipped #f :channels 4)
(let ((samps 44100)
(gen1 (make-noid 100.0 32 'max-peak))
- (gen2 (make-noid 100.0 32 (make-vct 32 0.0)))
+ (gen2 (make-noid 100.0 32 (make-vector 32 0.0)))
(gen3 (make-noid 100.0 32))
(gen4 (make-noid 100.0 32 'min-peak)))
(do ((i 0 (+ i 1)))
@@ -5803,17 +6036,17 @@ index 10 (so 10/2 is the bes-jn arg):
(outd i (noid gen4 0.0)))))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (with-sound (:clipped #f :output (string-append "test-noid-" (number->string i) ".snd"))
- (let ((samps 44100)
- (gen (make-noid 100.0 32 (if (= i 0) 'max-peak
- (if (= i 1) (make-vct 32 0.0)
- (if (= i 2) #f
- 'min-peak))))))
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (outa i (noid gen))))))
+(do ((i 0 (+ i 1)))
+ ((= i 4))
+ (with-sound (:clipped #f :output (string-append "test-noid-" (number->string i) ".snd"))
+ (let ((samps 44100)
+ (gen (make-noid 100.0 32 (if (= i 0) 'max-peak
+ (if (= i 1) (make-vector 32 0.0)
+ (if (= i 2) #f
+ 'min-peak))))))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (noid gen))))))
(define (knoid n)
(with-sound (:channels 4 :statistics #t)
@@ -5822,17 +6055,16 @@ index 10 (so 10/2 is the bes-jn arg):
(gen2 (make-noid 10.0 n 'min-peak 'odd))
(gen3 (make-noid 10.0 n 'min-peak 'even))
(gen4 (make-noid 10.0 n 'min-peak 'prime)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (outa i (* 0.5 (noid gen1 0.0)))
- (outb i (* 0.5 (noid gen2 0.0)))
- (outc i (* 0.5 (noid gen3 0.0)))
- (outd i (* 0.5 (noid gen4 0.0))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (* 0.5 (noid gen1 0.0)))
+ (outb i (* 0.5 (noid gen2 0.0)))
+ (outc i (* 0.5 (noid gen3 0.0)))
+ (outd i (* 0.5 (noid gen4 0.0)))))))
(with-sound (:clipped #f)
(let ((samps 44100)
- (gen (make-noid 100.0 19 (apply vct (map (lambda (n) (* pi n)) (list 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1) )))))
+ (gen (make-noid 100.0 19 (apply vector (map (lambda (n) (* pi n)) (list 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1) )))))
(do ((i 0 (+ i 1)))
((= i samps))
(outa i (noid gen)))))
@@ -5845,23 +6077,23 @@ index 10 (so 10/2 is the bes-jn arg):
(define* (make-roid (frequency 0.0) (n 1) (r 1.0) (phases #f))
(make-polyoid frequency
- (let ((amps (make-vct (* 3 n)))
+ (let ((amps (make-vector (* 3 n) 0.0))
(rn (/ 1.0 n)))
(do ((i 1 (+ i 1))
(j 0 (+ j 3)))
((> i n))
- (vct-set! amps j i)
- (vct-set! amps (+ j 1) rn)
+ (set! (amps j) i)
+ (set! (amps (+ j 1)) rn)
(set! rn (* rn r))
- (if (vct? phases)
- (vct-set! amps (+ j 2) (vct-ref phases (- i 1)))
+ (if (vector? phases)
+ (set! (amps (+ j 2)) (phases (- i 1)))
(if (not phases)
- (vct-set! amps (+ j 2) (random (* 2 pi)))
+ (set! (amps (+ j 2)) (random (* 2 pi)))
(if (eq? phases 'max-peak)
- (vct-set! amps (+ j 2) (/ pi 2))
+ (set! (amps (+ j 2)) (/ pi 2))
;; else min-peak, handled separately
))))
-
+
(if (eq? phases 'min-peak)
(let ((vector-find-if (lambda (func vect)
(let ((len (length vect))
@@ -5871,10 +6103,10 @@ index 10 (so 10/2 is the bes-jn arg):
result)
result)
(set! result (func (vect i))))))))
-
+
(if (not (defined? 'roid-min-peak-phases))
(load "peak-phases.scm"))
-
+
(let ((min-dat (vector-find-if
(lambda (val)
(and val
@@ -5883,7 +6115,7 @@ index 10 (so 10/2 is the bes-jn arg):
(let* ((a-val (val 1))
(a-len (length val))
(a-data (list a-val (val 2))))
- (do ((k 2 (+ 1 k)))
+ (do ((k 2 (+ k 1)))
((= k a-len))
(if (and (number? (val k))
(< (val k) a-val))
@@ -5899,10 +6131,10 @@ index 10 (so 10/2 is the bes-jn arg):
(do ((i 1 (+ i 1))
(j 0 (+ j 3)))
((> i n))
- (vct-set! amps (+ j 1) rn)
+ (set! (amps (+ j 1)) rn)
(set! rn (* rn r))
- (vct-set! amps (+ j 2) (* pi (rats (- i 1))))))))))
-
+ (set! (amps (+ j 2)) (* pi (rats (- i 1))))))))))
+
amps)))
(define roid polyoid)
@@ -5919,6 +6151,7 @@ index 10 (so 10/2 is the bes-jn arg):
|#
+
;;; ---------------- old waveshape generator ----------------
(define waveshape? polyshape?)
@@ -5927,7 +6160,7 @@ index 10 (so 10/2 is the bes-jn arg):
(define* (make-waveshape (frequency *clm-default-frequency*)
(partials '(1 1))
wave
- (size *clm-table-size*))
+ (size *clm-table-size*)) ; size arg is for backwards compatibility
(if (not wave)
(make-polyshape frequency :partials partials)
(make-polyshape frequency :coeffs wave)))
@@ -5935,109 +6168,107 @@ index 10 (so 10/2 is the bes-jn arg):
(define* (partials->waveshape partials
(size *clm-table-size*))
(partials->polynomial partials))
-
+
+
;;; ---------------- tanh(sin(x)) ----------------
(defgenerator (tanhsin
:make-wrapper (lambda (g)
- (set! (tanhsin-osc g) (make-oscil (tanhsin-frequency g) (tanhsin-initial-phase g)))
- (set! (tanhsin-frequency g) (hz->radians (tanhsin-frequency g))) ; so that mus-frequency works at least read side
+ (set! (g 'osc) (make-oscil (g 'frequency) (g 'initial-phase)))
+ (set! (g 'frequency) (hz->radians (g 'frequency))) ; so that mus-frequency works at least read side
g))
(frequency *clm-default-frequency*) (r 1.0) (initial-phase 0.0)
- (osc #f :type clm))
+ (osc #f) fm)
-(define* (tanhsin gen (fm 0.0))
- "(make-tanhsin (frequency 0.0) (r 1.0) (initial-phase 0.0) returns a tanhsin generator.\n\
-(tanhsin gen (fm 0.0)) produces tanh(r*sin) which approaches a square wave as r increases."
- (declare (gen tanhsin) (fm float))
- (tanh (* (tanhsin-r gen)
- (oscil (tanhsin-osc gen) fm))))
+(define tanhsin
+
+ (let ((documentation "(make-tanhsin (frequency 0.0) (r 1.0) (initial-phase 0.0) returns a tanhsin
+generator. (tanhsin gen (fm 0.0)) produces tanh(r*sin) which approaches a square wave as r increases."))
+
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (tanh (* r (oscil osc fm)))))))
;;; ---------------- moving-fft ----------------
+(define last-moving-fft-window #f)
+
+(define moving-fft-methods
+ (list
+ (cons 'mus-data (lambda (g) (g 'data)))
+ (cons 'mus-xcoeffs (lambda (g) (g 'rl)))
+ (cons 'mus-ycoeffs (lambda (g) (g 'im)))
+ (cons 'mus-run (lambda (g arg1 arg2) (moving-fft g)))))
+
(defgenerator (moving-fft
:make-wrapper (lambda (g)
- (let ((n (moving-fft-n g)))
- (set! (moving-fft-rl g) (make-vct n))
- (set! (moving-fft-im g) (make-vct n))
- (set! (moving-fft-data g) (make-vct n))
- (set! (moving-fft-window g) (make-fft-window hamming-window n))
- (vct-scale! (moving-fft-window g) (/ 2.0 (* 0.54 n)))
- (set! (moving-fft-outctr g) (+ n 1)) ; first time fill flag
+ (let ((n (g 'n)))
+ (set! (g 'rl) (make-float-vector n))
+ (set! (g 'im) (make-float-vector n))
+ (set! (g 'data) (make-float-vector n))
+ (set! (g 'window)
+ (if (and last-moving-fft-window
+ (= n (length last-moving-fft-window)))
+ last-moving-fft-window
+ (set! last-moving-fft-window (make-fft-window hamming-window n))))
+ (float-vector-scale! (g 'window) (/ 2.0 (* 0.54 n)))
+ (set! (g 'outctr) (+ n 1)) ; first time fill flag
g))
- :methods (list
- (list 'mus-data
- (lambda (g) (moving-fft-data g)))
- (list 'mus-xcoeffs
- (lambda (g) (moving-fft-rl g)))
- (list 'mus-ycoeffs
- (lambda (g) (moving-fft-im g)))
- (list 'mus-run
- (lambda (g arg1 arg2) (moving-fft g)))))
- (input #f :type clm) (n 512 :type int) (hop 128 :type int) (outctr 0 :type int)
- (rl #f :type vct) (im #f :type vct) (data #f :type vct)
- (window #f :type vct))
-
-
-(define (moving-fft gen)
-
- "(make-moving-fft reader (size 512) (hop 128)) returns a moving-fft generator. \n\
- (moving-fft gen) produces an FFT (polar form) of 'size' samples every 'hop' samples, \n\
-taking input from the readin generator 'reader'. The magnitudes are available as mus-xcoeffs, \n\
-the phases as mus-ycoeffs, and the current input data as mus-data."
-
- (declare (gen moving-fft))
- (let* ((n (moving-fft-n gen))
- (n2 (/ n 2))
- (rl (moving-fft-rl gen))
- (im (moving-fft-im gen))
- (data (moving-fft-data gen))
- (hop (moving-fft-hop gen))
- (outctr (moving-fft-outctr gen))
- (new-data #f))
- (if (>= outctr hop)
- (let* ((fft-window (moving-fft-window gen)))
- (if (> outctr n) ; must be first time through -- fill data array
- (begin
- (do ((i 0 (+ i 1)))
- ((= i n))
- (vct-set! data i (readin (moving-fft-input gen)))))
- (begin
- (do ((i 0 (+ i 1))
- (j hop (+ 1 j)))
- ((= j n))
- (vct-set! data i (vct-ref data j)))
- (do ((i (- n hop) (+ i 1)))
- ((= i n))
- (vct-set! data i (readin (moving-fft-input gen))))))
- (set! outctr 0)
- (set! new-data #t)
- (clear-array im)
- (do ((i 0 (+ i 1)))
- ((= i n))
- (vct-set! rl i (* (vct-ref fft-window i) (vct-ref data i))))
- (mus-fft rl im n 1)
- (rectangular->polar rl im)))
- (set! (moving-fft-outctr gen) (+ outctr 1))
- new-data))
+ :methods moving-fft-methods)
+ (input #f) (n 512) (hop 128) (outctr 0)
+ (rl #f) (im #f) (data #f)
+ (window #f))
+
+
+(define moving-fft
+
+ (let ((documentation "(make-moving-fft reader (size 512) (hop 128)) returns a moving-fft generator. (moving-fft gen)
+produces an FFT (polar form) of 'size' samples every 'hop' samples, taking input from the readin generator 'reader'.
+The magnitudes are available as mus-xcoeffs, the phases as mus-ycoeffs, and the current input data as mus-data."))
+
+ (lambda (gen)
+ (with-let gen
+ (let ((new-data #f))
+ (if (>= outctr hop)
+ (let ((fft-window window))
+ (if (> outctr n) ; must be first time through -- fill data array
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (float-vector-set! data i (readin input)))
+ (let ((mid (- n hop)))
+ (float-vector-move! data 0 hop)
+ (do ((i mid (+ i 1)))
+ ((= i n))
+ (float-vector-set! data i (readin input)))))
+ (set! outctr 0)
+ (set! new-data #t)
+ (fill! im 0.0)
+ (float-vector-subseq data 0 n rl)
+ (float-vector-multiply! rl fft-window)
+ (mus-fft rl im n 1)
+ (rectangular->polar rl im)))
+ (set! outctr (+ outctr 1))
+ new-data)))))
+
-
#|
(let* ((snd (new-sound))
(rd (make-readin "oboe.snd"))
(ft (make-moving-fft rd))
- (data (make-vct 256)))
+ (data (make-float-vector 256)))
(set! (lisp-graph?) #t)
(do ((i 0 (+ i 1)))
((= i 10000))
- (moving-fft ft)
- (vct-subseq (mus-xcoeffs ft) 0 255 data)
- (graph data "fft" 0.0 11025.0 0.0 0.1 0 0 #t))
+ (if (moving-fft ft)
+ (begin
+ (float-vector-subseq (mus-xcoeffs ft) 0 255 data)
+ (graph data "fft" 0.0 11025.0 0.0 0.1 snd 0 #t))))
(close-sound snd))
|#
@@ -6047,139 +6278,145 @@ the phases as mus-ycoeffs, and the current input data as mus-data."
(defgenerator (moving-spectrum
:make-wrapper (lambda (g)
- (let ((n (moving-spectrum-n g)))
- (set! (moving-spectrum-amps g) (make-vct n))
- (set! (moving-spectrum-phases g) (make-vct n))
- (set! (moving-spectrum-amp-incs g) (make-vct n))
- (set! (moving-spectrum-freqs g) (make-vct n))
- (set! (moving-spectrum-freq-incs g) (make-vct n))
- (set! (moving-spectrum-new-freq-incs g) (make-vct n))
- (set! (moving-spectrum-data g) (make-vct n))
- (set! (moving-spectrum-fft-window g) (make-fft-window hamming-window n))
- (vct-scale! (moving-spectrum-fft-window g) (/ 2.0 (* 0.54 n)))
- (set! (moving-spectrum-outctr g) (+ n 1)) ; first time fill flag
+ (let ((n (g 'n)))
+ (set! (g 'amps) (make-float-vector n))
+ (set! (g 'phases) (make-float-vector n))
+ (set! (g 'amp-incs) (make-float-vector n))
+ (set! (g 'freqs) (make-float-vector n))
+ (set! (g 'freq-incs) (make-float-vector n))
+ (set! (g 'new-freq-incs) (make-float-vector n))
+ (set! (g 'data) (make-float-vector n))
+ (set! (g 'fft-window) (make-fft-window hamming-window n))
+ (float-vector-scale! (g 'fft-window) (/ 2.0 (* 0.54 n)))
+ (set! (g 'outctr) (+ n 1)) ; first time fill flag
g)))
- (input #f :type clm) (n 512) (hop 128)
- (outctr 0 :type int)
- (amps #f :type vct) (phases #f :type vct)
- (amp-incs #f :type vct) (freqs #f :type vct) (freq-incs #f :type vct) (new-freq-incs #f :type vct)
- (fft-window #f :type vct)
- (data #f :type vct) (dataloc 0 :type int))
+ (input #f) (n 512) (hop 128)
+ (outctr 0)
+ (amps #f) (phases #f)
+ (amp-incs #f) (freqs #f) (freq-incs #f) (new-freq-incs #f)
+ (fft-window #f)
+ (data #f) (dataloc 0))
(define (moving-spectrum gen)
- (declare (gen moving-spectrum))
-
- (let* ((n (moving-spectrum-n gen))
- (n2 (/ n 2))
- (amps (moving-spectrum-amps gen)) ; un-normalized
- (phases (moving-spectrum-phases gen))
- (amp-incs (moving-spectrum-amp-incs gen))
- (freqs (moving-spectrum-freqs gen)) ; in radians
- (new-freq-incs (moving-spectrum-new-freq-incs gen))
- (hop (moving-spectrum-hop gen))
- (outctr (moving-spectrum-outctr gen)))
- (if (>= outctr hop)
- (let* ((data (moving-spectrum-data gen))
- (dataloc (moving-spectrum-dataloc gen))
- (fft-window (moving-spectrum-fft-window gen))
- (freq-incs (moving-spectrum-freq-incs gen)))
-
- (if (> outctr n) ; must be first time through -- fill data array
- (begin
+ (with-let gen
+ (let ((n2 (/ n 2)))
+ (if (>= outctr hop)
+ (begin
+ (if (> outctr n) ; must be first time through -- fill data array
(do ((i 0 (+ i 1)))
((= i n))
- (vct-set! data i (readin (moving-spectrum-input gen)))))
- (begin
- (do ((i 0 (+ i 1))
- (j hop (+ 1 j)))
- ((= j n))
- (vct-set! data i (vct-ref data j)))
- (do ((i (- n hop) (+ i 1)))
- ((= i n))
- (vct-set! data i (readin (moving-spectrum-input gen))))))
-
- (set! outctr 0) ; -1??
- (set! dataloc (modulo dataloc n))
-
- (clear-array new-freq-incs)
- (do ((i 0 (+ i 1))
- (j dataloc (+ 1 j)))
- ((= i n))
- (if (= j n) (set! j 0))
- (vct-set! amp-incs j (* (vct-ref fft-window i)
- (vct-ref data i))))
-
- (set! (moving-spectrum-dataloc gen) (+ dataloc hop))
-
- (mus-fft amp-incs new-freq-incs n 1)
- (rectangular->polar amp-incs new-freq-incs)
-
- (let ((scl (/ 1.0 hop))
- (kscl (/ (* 2 pi) n)))
- (vct-subtract! amp-incs amps)
- (vct-scale! amp-incs scl)
-
+ (float-vector-set! data i (readin input)))
+ (begin
+ (float-vector-move! data 0 hop)
+ (do ((i (- n hop) (+ i 1)))
+ ((= i n))
+ (float-vector-set! data i (readin input)))))
+
+ (set! outctr 0) ; -1??
+ (set! dataloc (modulo dataloc n))
+
+ (fill! new-freq-incs 0.0)
(do ((i 0 (+ i 1))
- (ks 0.0 (+ ks kscl)))
- ((= i n2))
- (let ((diff (modulo (- (vct-ref new-freq-incs i) (vct-ref freq-incs i)) (* 2 pi))))
- (vct-set! freq-incs i (vct-ref new-freq-incs i))
- (if (> diff pi) (set! diff (- diff (* 2 pi))))
- (if (< diff (- pi)) (set! diff (+ diff (* 2 pi))))
- (vct-set! new-freq-incs i (+ (* diff scl) ks))))
-
- (vct-subtract! new-freq-incs freqs)
- (vct-scale! new-freq-incs scl))))
-
- (set! (moving-spectrum-outctr gen) (+ outctr 1))
-
- (vct-add! amps amp-incs)
- (vct-add! freqs new-freq-incs)
- (vct-add! phases freqs)))
+ (j dataloc (+ j 1)))
+ ((= j n))
+ (float-vector-set! amp-incs j (* (float-vector-ref fft-window i) (float-vector-ref data i))))
+
+ (if (> dataloc 0)
+ (do ((i (- n dataloc) (+ i 1))
+ (j 0 (+ j 1)))
+ ((= j dataloc))
+ (float-vector-set! amp-incs j (* (float-vector-ref fft-window i) (float-vector-ref data i)))))
+
+ (set! dataloc (+ dataloc hop))
+
+ (mus-fft amp-incs new-freq-incs n 1)
+ (rectangular->polar amp-incs new-freq-incs)
+
+ (let ((scl (/ 1.0 hop))
+ (kscl (/ two-pi n)))
+ (float-vector-subtract! amp-incs amps)
+ (float-vector-scale! amp-incs scl)
+
+ (do ((i 0 (+ i 1))
+ (ks 0.0 (+ ks kscl)))
+ ((= i n2))
+ (let ((diff (modulo (- (new-freq-incs i) (freq-incs i)) two-pi)))
+ (set! (freq-incs i) (new-freq-incs i))
+ (if (> diff pi) (set! diff (- diff (* 2 pi))))
+ (if (< diff (- pi)) (set! diff (+ diff (* 2 pi))))
+ (set! (new-freq-incs i) (+ (* diff scl) ks))))
+
+ (float-vector-subtract! new-freq-incs freqs)
+ (float-vector-scale! new-freq-incs scl))))
+
+ (set! outctr (+ outctr 1))
+
+ (float-vector-add! amps amp-incs)
+ (float-vector-add! freqs new-freq-incs)
+ (float-vector-add! phases freqs))))
(define (test-sv)
;; sv-amps = pv-amps (but len is diff)
;; sv-phases = pv-phases
;; sv-freqs = pv-phase-increments
-
+
(let ((pv (make-phase-vocoder (make-readin "oboe.snd") ))
(sv (make-moving-spectrum (make-readin "oboe.snd"))))
- (run
- (do ((k 0 (+ 1 k)))
- ((= k 20))
- (do ((i 0 (+ i 1)))
- ((= i 2000))
- (phase-vocoder pv)
- (moving-spectrum sv))
- (do ((i 0 (+ i 1)))
- ((= i 256))
- (if (fneq (vct-ref (moving-spectrum-amps sv) i) (vct-ref (phase-vocoder-amps pv) i))
- (format #t ";~D amps: ~A ~A" i (vct-ref (moving-spectrum-amps sv) i) (vct-ref (phase-vocoder-amps pv) i)))
- (if (fneq (vct-ref (moving-spectrum-freqs sv) i) (vct-ref (phase-vocoder-phase-increments pv) i))
- (format #t ";~D freqs: ~A ~A" i (vct-ref (moving-spectrum-freqs sv) i) (vct-ref (phase-vocoder-phase-increments pv) i))))))))
-
+ (let ((pv-amps (phase-vocoder-amps pv))
+ (pv-incrs (phase-vocoder-phase-increments pv))
+ (sv-amps (sv 'amps))
+ (sv-freqs (sv 'freqs)))
+ (call-with-exit
+ (lambda (quit)
+ (do ((k 0 (+ k 1)))
+ ((= k 20))
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (phase-vocoder pv))
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (moving-spectrum sv))
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (if (fneq (sv-amps i) (pv-amps i))
+ (begin
+ (format *stderr* ";test-sv (generators) ~D amps: ~A ~A" i (sv-amps i) (pv-amps i))
+ (quit)))
+ (if (> (abs (- (sv-freqs i) (pv-incrs i))) .25)
+ (begin
+ (format *stderr* ";test-sv (generators) ~D freqs: ~A ~A" i (sv-freqs i) (pv-incrs i))
+ (quit))))))))))
+
#|
+(define* (sine-bank amps phases size)
+ (let ((len (or size (length amps)))
+ (sum 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! sum (+ sum (* (amps i)
+ (sin (phases i))))))
+ sum))
+
(with-sound (:channels 2)
(let* ((gen (make-moving-spectrum (make-readin "oboe.snd")))
(pv (make-phase-vocoder (make-readin "oboe.snd")))
- (samps (frames "oboe.snd")))
- (run
- (do ((i 0 (+ i 1)))
- ((= i samps))
- (moving-spectrum gen)
- (outa i (sine-bank (moving-spectrum-amps gen) (moving-spectrum-phases gen) 256)) ; size = n/2 as in pv, sine-bank is in snd9.scm
- (outb i (phase-vocoder pv))))))
+ (samps (framples "oboe.snd")))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (moving-spectrum gen)
+ (outa i (sine-bank (gen 'amps) (gen 'phases) 256)) ; size = n/2 as in pv
+ (outb i (phase-vocoder pv)))))
-; :(channel-distance 0 0 0 1)
-; 7.902601100022e-9
+ ; :(channel-distance 0 0 0 1)
+ ; 7.902601100022e-9
|#
-;;; TODO: moving spectrum returns freqs in radians, and does not try to find the interpolated peak,
-;;; so we need another version that returns current freq/amp pairs that can be used directly in oscil
-;;; cutoff, peaks, freqs, amps -- moving-peaks?
-;;; This is the main portion of the "pins" instrument (also find-pitch in examp.scm)
+;;; moving spectrum returns freqs in radians, and does not try to find the interpolated peak,
+;;; so we need another version that returns current freq/amp pairs that can be used directly in oscil
+;;; This is the main portion of the "pins" instrument (also find-pitch in examp.scm)
+
@@ -6187,187 +6424,179 @@ the phases as mus-ycoeffs, and the current input data as mus-data."
(defgenerator (moving-scentroid
:make-wrapper (lambda (g)
- (let ((n (moving-scentroid-size g)))
- (set! (moving-scentroid-rl g) (make-vct n))
- (set! (moving-scentroid-im g) (make-vct n))
- (set! (moving-scentroid-dly g) (make-delay n))
- (set! (moving-scentroid-rms g) (make-moving-rms n))
- (set! (moving-scentroid-hop g) (floor (/ (mus-srate) (moving-scentroid-rfreq g))))
- (set! (moving-scentroid-binwidth g) (/ (mus-srate) n))
+ (let ((n (g 'size)))
+ (set! (g 'rl) (make-float-vector n))
+ (set! (g 'im) (make-float-vector n))
+ (set! (g 'dly) (make-delay n))
+ (set! (g 'rms) (make-moving-rms n))
+ (set! (g 'hop) (floor (/ *clm-srate* (g 'rfreq))))
+ (set! (g 'binwidth) (/ *clm-srate* n))
g)))
(dbfloor -40.0) (rfreq 100.0)
- (size 4096 :type int) (hop 1024 :type int) (outctr 0 :type int)
+ (size 4096) (hop 1024) (outctr 0)
(curval 0.0) (binwidth 1.0)
- (rl #f :type vct) (im #f :type vct)
- (dly #f :type clm) (rms #f :type clm))
+ (rl #f) (im #f)
+ (dly #f) (rms #f) x)
(define* (moving-scentroid gen (x 0.0))
- (declare (gen moving-scentroid) (x float))
- (let ((outctr (moving-scentroid-outctr gen)))
- (let ((rms (moving-rms (moving-scentroid-rms gen) x)))
- (if (>= (moving-scentroid-outctr gen) (moving-scentroid-hop gen))
+ (let-set! gen 'x x)
+ (with-let gen
+
+ (let ((rms (moving-rms rms x)))
+ (if (>= outctr hop)
(begin
(set! outctr 0)
- (if (< (linear->db rms) (moving-scentroid-dbfloor gen))
- (set! (moving-scentroid-curval gen) 0.0)
- (let* ((rl (moving-scentroid-rl gen))
- (im (moving-scentroid-im gen))
- (data (mus-data (moving-scentroid-dly gen)))
- (n (moving-scentroid-size gen))
+ (if (< (linear->db rms) dbfloor)
+ (set! curval 0.0)
+ (let* ((data (mus-data dly))
+ (n size)
(fft2 (/ n 2))
(numsum 0.0)
(densum 0.0))
- (clear-array im)
- (vct-subseq data 0 (- n 1) rl)
+ (fill! im 0.0)
+ (float-vector-subseq data 0 (- n 1) rl)
(mus-fft rl im n 1) ; we can use the delay line contents un-reordered because phases are ignored here
(rectangular->magnitudes rl im)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k fft2))
- (set! numsum (+ numsum (* k (vct-ref rl k))))
- (set! densum (+ densum (vct-ref rl k))))
- (set! (moving-scentroid-curval gen) (/ (* (moving-scentroid-binwidth gen) numsum) densum)))))))
- (delay (moving-scentroid-dly gen) x) ; our "sliding window" on the input data
- (set! (moving-scentroid-outctr gen) (+ outctr 1))
- (moving-scentroid-curval gen)))
+ (set! numsum (+ numsum (* k (rl k))))
+ (set! densum (+ densum (rl k))))
+ (set! curval (/ (* binwidth numsum) densum)))))))
+ (delay dly x) ; our "sliding window" on the input data
+ (set! outctr (+ outctr 1))
+ curval))
#|
(let* ((snd (open-sound "oboe.snd"))
(cur-srate (srate snd))
- (old-srate (mus-srate)))
- (set! (mus-srate) cur-srate)
-
+ (old-srate *clm-srate*))
+ (set! *clm-srate* cur-srate)
+
(let ((scn (make-moving-scentroid -40.0 100.0 128))
(vals (scentroid "oboe.snd" 0.0 1.1 -40.0 100.0 128))
(k 0))
-
- (let ((data (channel->vct 0 22050 snd 0)))
+
+ (let ((data (channel->float-vector 0 22050 snd 0)))
(close-sound snd)
(do ((i 0 (+ i 1)))
- ((= i (moving-scentroid-size scn)))
- (moving-scentroid scn (vct-ref data i)))
- (set! (moving-scentroid-outctr scn) (moving-scentroid-hop scn))
-
- (do ((i (moving-scentroid-size scn) (+ i 1))
+ ((= i (scn 'size)))
+ (moving-scentroid scn (data i)))
+ (set! (scn 'outctr) (scn 'hop))
+
+ (do ((i (scn 'size) (+ i 1))
(j 0 (+ j 1)))
((= i 22050))
- (let ((val (moving-scentroid scn (vct-ref data i))))
- (if (= (modulo j (moving-scentroid-hop scn)) 0)
+ (let ((val (moving-scentroid scn (data i))))
+ (if (= (modulo j (scn 'hop)) 0)
(begin
- (format #t "[~A ~A]~%" val (vct-ref vals k))
+ (format #t "[~A ~A]~%" val (vals k))
(set! k (+ k 1)))))))
- (set! (mus-srate) old-srate)))
+ (set! *clm-srate* old-srate)))
|#
;;; ---------------- moving-autocorrelation ----------------
+(define moving-autocorrelation-methods
+ (list
+ (cons 'mus-run (lambda (g arg1 arg2) (moving-autocorrelation g)))
+ (cons 'mus-data (lambda (g) (g 'rl)))))
+
(defgenerator (moving-autocorrelation
:make-wrapper (lambda (g)
- (let ((n (moving-autocorrelation-n g)))
- (set! (moving-autocorrelation-rl g) (make-vct n))
- (set! (moving-autocorrelation-im g) (make-vct n))
- (set! (moving-autocorrelation-data g) (make-vct n))
- (set! (moving-autocorrelation-outctr g) (+ n 1)) ; first time fill flag
+ (let ((n (g 'n)))
+ (set! (g 'rl) (make-float-vector n))
+ (set! (g 'im) (make-float-vector n))
+ (set! (g 'data) (make-float-vector n))
+ (set! (g 'outctr) (+ n 1)) ; first time fill flag
g))
- :methods (list
- (list 'mus-run
- (lambda (g arg1 arg2) (moving-autocorrelation g)))
- (list 'mus-data
- (lambda (g) (moving-autocorrelation-rl g)))))
- (input #f :type clm) (n 512 :type int) (hop 128 :type int) (outctr 0 :type int)
- (rl #f :type vct) (im #f :type vct) (data #f :type vct))
-
-
-(define (moving-autocorrelation gen)
-
- "(make-moving-autocorrelation reader (size 512) (hop 128)) returns a moving-autocorrelation generator. \n\
- (moving-autocorrelation gen) produces the autocorrelation of 'size' samples every 'hop' samples, \n\
-taking input from the readin generator 'reader'. The output data is available via mus-data."
-
- (declare (gen moving-autocorrelation))
- (let* ((n (moving-autocorrelation-n gen))
- (n2 (/ n 2))
- (rl (moving-autocorrelation-rl gen))
- (im (moving-autocorrelation-im gen))
- (data (moving-autocorrelation-data gen))
- (hop (moving-autocorrelation-hop gen))
- (outctr (moving-autocorrelation-outctr gen))
- (new-data #f))
- (if (>= outctr hop)
- (begin
- (if (> outctr n) ; must be first time through -- fill data array
- (begin
- (do ((i 0 (+ i 1)))
- ((= i n))
- (vct-set! data i (readin (moving-autocorrelation-input gen)))))
+ :methods moving-autocorrelation-methods)
+ (input #f) (n 512) (hop 128) (outctr 0)
+ (rl #f) (im #f) (data #f))
+
+
+(define moving-autocorrelation
+
+ (let ((documentation "(make-moving-autocorrelation reader (size 512) (hop 128)) returns a moving-autocorrelation
+generator. (moving-autocorrelation gen) produces the autocorrelation of 'size' samples every 'hop' samples, taking
+input from the readin generator 'reader'. The output data is available via mus-data."))
+
+ (lambda (gen)
+ (with-let gen
+ (let ((new-data #f))
+ (if (>= outctr hop)
(begin
- (do ((i 0 (+ i 1))
- (j hop (+ 1 j)))
- ((= j n))
- (vct-set! data i (vct-ref data j)))
- (do ((i (- n hop) (+ i 1)))
- ((= i n))
- (vct-set! data i (readin (moving-autocorrelation-input gen))))))
- (set! outctr 0)
- (set! new-data #t)
- (clear-array im)
- (vct-subseq data 0 (- n 1) rl)
- (autocorrelate rl)))
- (set! (moving-autocorrelation-outctr gen) (+ outctr 1))
- new-data))
+ (if (> outctr n) ; must be first time through -- fill data array
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (float-vector-set! data i (readin input)))
+ (begin
+ (float-vector-move! data 0 hop)
+ (do ((i (- n hop) (+ i 1)))
+ ((= i n))
+ (float-vector-set! data i (readin input)))))
+ (set! outctr 0)
+ (set! new-data #t)
+ (fill! im 0.0)
+ (float-vector-subseq data 0 (- n 1) rl)
+ (autocorrelate rl)))
+ (set! outctr (+ outctr 1))
+ new-data)))))
+
;;; ---------------- moving-pitch ----------------
+(define moving-pitch-methods
+ (list
+ (cons 'mus-run (lambda (g arg1 arg2) (moving-pitch g)))))
+
(defgenerator (moving-pitch
:make-wrapper (lambda (g)
- (set! (moving-pitch-ac g) (make-moving-autocorrelation
- (moving-pitch-input g)
- (moving-pitch-n g)
- (moving-pitch-hop g)))
+ (set! (g 'ac) (make-moving-autocorrelation
+ (g 'input)
+ (g 'n)
+ (g 'hop)))
g)
- :methods (list
- (list 'mus-run
- (lambda (g arg1 arg2) (moving-pitch g)))))
-
- (input #f :type clm) (n 512 :type int) (hop 128 :type int)
- (ac #f :type clm) (val 0.0))
+ :methods moving-pitch-methods)
+ (input #f) (n 512) (hop 128)
+ (ac #f) (val 0.0))
(define (moving-pitch gen)
- (declare (gen moving-pitch))
- (if (moving-autocorrelation (moving-pitch-ac gen))
- (let* ((data (mus-data (moving-pitch-ac gen)))
- (peak 0.0)
- (peak-loc 0)
- (len (length data)))
- (do ((i 8 (+ i 1))) ; assume we're not in the top few octaves
- ((= i len))
- (let ((apk (abs (vct-ref data i))))
- (if (> apk peak)
- (begin
- (set! peak apk)
- (set! peak-loc i)))))
- (if (or (= peak 0.0)
- (= peak-loc 0))
- (set! (moving-pitch-val gen) 0.0)
- (let* ((la (vct-ref data (- peak-loc 1)))
- (ra (vct-ref data (+ peak-loc 1)))
- (logla (log (/ (max la .0000001) peak) 10))
- (logra (log (/ (max ra .0000001) peak) 10)))
- (set! (moving-pitch-val gen)
- (/ (mus-srate)
- (+ peak-loc (/ (* 0.5 (- logla logra))
- (+ logla logra)))))))))
- (moving-pitch-val gen))
+ (with-let gen
+ (if (moving-autocorrelation ac)
+ (let* ((data (mus-data ac))
+ (peak 0.0)
+ (peak-loc 0)
+ (len (length data)))
+ (do ((i 8 (+ i 1))) ; assume we're not in the top few octaves
+ ((= i len))
+ (let ((apk (abs (data i))))
+ (if (> apk peak)
+ (begin
+ (set! peak apk)
+ (set! peak-loc i)))))
+ (if (or (= peak 0.0)
+ (= peak-loc 0))
+ (set! val 0.0)
+ (let* ((la (data (- peak-loc 1)))
+ (ra (data (+ peak-loc 1)))
+ (logla (log (/ (max la .0000001) peak) 10)) ; (positive la)?
+ (logra (log (/ (max ra .0000001) peak) 10)))
+ (set! val
+ (/ *clm-srate*
+ (+ peak-loc (/ (* 0.5 (- logla logra))
+ (+ logla logra)))))))))
+ val))
#|
(let* ((rd (make-readin "oboe.snd"))
(cur-srate (srate "oboe.snd"))
- (old-srate (mus-srate)))
- (set! (mus-srate) cur-srate)
+ (old-srate *clm-srate*))
+ (set! *clm-srate* cur-srate)
(let* ((scn (make-moving-pitch rd))
(last-pitch 0.0)
(pitch 0.0))
@@ -6377,7 +6606,7 @@ taking input from the readin generator 'reader'. The output data is available v
(set! pitch (moving-pitch scn))
(if (not (= last-pitch pitch))
(format #t "~A: ~A~%" (* 1.0 (/ i cur-srate)) pitch))))
- (set! (mus-srate) old-srate))
+ (set! *clm-srate* old-srate))
|#
@@ -6386,38 +6615,36 @@ taking input from the readin generator 'reader'. The output data is available v
(define (abel k)
;; sum i from 1 to k (-1)^(i + 1) * (sin i) / i
(with-sound (:clipped #f :statistics #t)
- (let ((harmonics (make-vct (* 2 k))))
- (do ((i 1 (+ 1 i))
+ (let ((harmonics (make-float-vector (* 2 k))))
+ (do ((i 1 (+ i 1))
(j 0 (+ j 2))
(n -1 (- n)))
((= i k))
- (vct-set! harmonics j i)
- (vct-set! harmonics (+ j 1) (/ n i)))
+ (set! (harmonics j) i)
+ (set! (harmonics (+ j 1)) (/ n i)))
(let ((gen (make-polywave 100.0 :partials (normalize-partials harmonics))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 100000))
- (outa i (polywave gen))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (outa i (polywave gen)))))))
(define* (adds num freq e amp v (type mus-chebyshev-first-kind))
(with-sound (:clipped #f :statistics #t :play #t)
- (let ((harmonics (make-vct (* 2 num)))
+ (let ((harmonics (make-float-vector (* 2 num)))
(freqe (make-env e :length num)))
- (do ((i 1 (+ 1 i))
+ (do ((i 1 (+ i 1))
(j 0 (+ j 2)))
((= i num))
- (vct-set! harmonics j i)
- (vct-set! harmonics (+ j 1) (env freqe)))
+ (set! (harmonics j) i)
+ (set! (harmonics (+ j 1)) (env freqe)))
(let ((gen (make-polywave freq :partials (normalize-partials harmonics) :type type))
(vib (make-oscil 5)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 100000))
- (outa i (* amp (polywave gen (* (hz->radians v) (oscil vib)))))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100000))
+ (outa i (* amp (polywave gen (* (hz->radians v) (oscil vib))))))))))
-;(adds 200 20 '(0 0 10 1 12 0 20 0 24 .2 35 0 46 0 57 .1 68 0) .5 2)
-;(adds 300 15 '(0 0 10 1 12 0 20 0 24 .2 35 0 46 0 57 .1 68 0) .5 3)
+ ;(adds 200 20 '(0 0 10 1 12 0 20 0 24 .2 35 0 46 0 57 .1 68 0) .5 2)
+ ;(adds 300 15 '(0 0 10 1 12 0 20 0 24 .2 35 0 46 0 57 .1 68 0) .5 3)
|#
@@ -6425,28 +6652,28 @@ taking input from the readin generator 'reader'. The output data is available v
#|
(defgenerator (circler
:make-wrapper (lambda (g)
- (set! (circler-frequency g) (hz->radians (circler-frequency g)))
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
g))
- (frequency *clm-default-frequency*) (angle 0.0))
-
-(define* (circler gen (fm 0.0))
- "(make-circler (frequency 0.0) returns a circler generator.\n\
-(circler gen (fm 0.0)) produces a waveform made up of half circles"
- (declare (gen circler) (fm float))
- (let* ((x (modulo (circler-angle gen) (* 2 pi)))
- (xx (/ (* 4 x) (* 2 pi)))
- (y (if (< xx 2)
- (sqrt (- 1 (* (- 1 xx) (- 1 xx))))
- (- (sqrt (- 1 (* (- 3 xx) (- 3 xx))))))))
- (set! (circler-angle gen) (+ (circler-angle gen) fm (circler-frequency gen)))
- y))
+ (frequency *clm-default-frequency*) (angle 0.0) fm)
+
+(define circler
+ (let ((documentation "(make-circler (frequency 0.0) returns a circler generator. (circler gen (fm 0.0)) produces a waveform made up of half circles"))
+ (lambda* (gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (let* ((x (modulo angle (* 2 pi)))
+ (xx (/ (* 4 x) (* 2 pi)))
+ (y (if (< xx 2)
+ (sqrt (- 1 (* (- 1 xx) (- 1 xx))))
+ (- (sqrt (- 1 (* (- 3 xx) (- 3 xx))))))))
+ (set! angle (+ x fm frequency))
+ y)))))
(with-sound (:clipped #f :statistics #t)
(let ((gen (make-circler 10.0)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 20000))
- (outa i (circler gen))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (outa i (circler gen)))))
;;; odd harmonics: 1, .18 .081 .048 .033 .024, .019
|#
@@ -6459,15 +6686,14 @@ taking input from the readin generator 'reader'. The output data is available v
(with-sound ()
(let ((tan-scl (tan (/ pi (* 2 (+ N 1)))))
(incr (hz->radians freq)))
- (run
- (do ((k 1 (+ k 1)))
- ((= k N))
- (let ((cos-coeff (* tan-scl (sin (/ (* k pi) (+ N 1)))))
- (kincr (* k incr)))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x kincr)))
- ((= i 40000))
- (outa i (* cos-coeff (cos x))))))))))
+ (do ((k 1 (+ k 1)))
+ ((= k N))
+ (let ((cos-coeff (* tan-scl (sin (/ (* k pi) (+ N 1)))))
+ (kincr (* k incr)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x kincr)))
+ ((= i 40000))
+ (outa i (* cos-coeff (cos x)))))))))
|#
@@ -6477,133 +6703,150 @@ taking input from the readin generator 'reader'. The output data is available v
(defgenerator (flocsig
;; assume stereo out/rev
:make-wrapper (lambda (g)
- (set! (flocsig-maxd g) (ceiling amplitude))
- (set! (flocsig-out1 g) (make-vct (flocsig-maxd g)))
- (set! (flocsig-out2 g) (make-vct (flocsig-maxd g)))
- (set! (flocsig-ri g) (make-rand-interp
- :frequency (flocsig-frequency g)
- :amplitude (- (flocsig-amplitude g) 1.0)))
- (if (not (flocsig-offset g))
- (set! (flocsig-offset g) (mus-random (* 0.3 (flocsig-amplitude g)))))
+ (set! (g 'maxd) (ceiling (g 'amplitude))) ; was amplitude?
+ (set! (g 'out1) (make-float-vector (g 'maxd)))
+ (set! (g 'out2) (make-float-vector (g 'maxd)))
+ (set! (g 'ri) (make-rand-interp
+ :frequency (g 'frequency)
+ :amplitude (- (g 'amplitude) 1.0)))
+ (if (not (g 'offset))
+ (set! (g 'offset) (mus-random (* 0.3 (g 'amplitude)))))
g))
(reverb-amount 0.0) (frequency 1.0) (amplitude 2.0) offset
(maxd 0)
- (out1 #f :type vct) (out2 #f :type vct) (outloc 0)
- (ri #f :type clm))
+ (out1 #f) (out2 #f) (outloc 0)
+ (ri #f) samp input)
+
+(define 1/sqrt2 (/ 1.0 (sqrt 2.0)))
(define (flocsig gen samp input)
;; signal position and per-channel-delay depends on rand-interp
- (declare (gen flocsig) (samp int) (input float))
- (let* ((rpos (rand-interp (flocsig-ri gen)))
- (pos (min (max (+ rpos (flocsig-offset gen)) (- (flocsig-amplitude gen))) (flocsig-amplitude gen)))
- (amp1 (if (<= pos -1.0) 1.0
- (if (>= pos 1.0) 0.0
- (/ (sqrt (- 1.0 pos)) (sqrt 2.0)))))
- (amp2 (if (<= pos -1.0) 0.0
- (if (>= pos 1.0) 1.0
- (/ (sqrt (+ 1.0 pos)) (sqrt 2.0)))))
- (dly1 (abs (min 0.0 pos)))
- (frac1 (- dly1 (floor dly1)))
- (dly2 (max 0.0 pos))
- (frac2 (- dly2 (floor dly2)))
- (out1 (flocsig-out1 gen))
- (loc (flocsig-outloc gen))
- (out2 (flocsig-out2 gen))
- (size (flocsig-maxd gen))
- (loc10 (modulo (+ loc (floor dly1)) size))
- (loc11 (modulo (+ loc 1 (floor dly1)) size))
- (loc20 (modulo (+ loc (floor dly2)) size))
- (loc21 (modulo (+ loc 1 (floor dly2)) size))
- (rev (flocsig-reverb-amount gen)))
-
- (vct-set! out1 loc10 (+ (vct-ref out1 loc10) (* amp1 input (- 1.0 frac1))))
- (vct-set! out1 loc11 (+ (vct-ref out1 loc11) (* amp1 input frac1)))
- (vct-set! out2 loc20 (+ (vct-ref out2 loc20) (* amp2 input (- 1.0 frac2))))
- (vct-set! out2 loc21 (+ (vct-ref out2 loc21) (* amp2 input frac2)))
-
- (let* ((val1 (vct-ref out1 loc))
- (val2 (vct-ref out2 loc)))
- (vct-set! out1 loc 0.0)
- (vct-set! out2 loc 0.0)
- (set! loc (+ loc 1))
- (if (= loc size) (set! loc 0))
- (outa samp val1)
- (outb samp val2)
- (if (> rev 0.0)
- (begin
- (outa samp (* rev val1) *reverb*)
- (outb samp (* rev val2) *reverb*)))
- (set! (flocsig-outloc gen) loc))))
+ (let-set! gen 'samp samp)
+ (let-set! gen 'input input)
+ (with-let gen
+ (let* ((rpos (rand-interp ri))
+ (pos (min (max (+ rpos offset) (- amplitude)) amplitude))
+ (amp1 (if (<= pos -1.0) 1.0
+ (if (>= pos 1.0) 0.0
+ (* (sqrt (- 1.0 pos)) 1/sqrt2))))
+ (amp2 (if (<= pos -1.0) 0.0
+ (if (>= pos 1.0) 1.0
+ (* (sqrt (+ 1.0 pos)) 1/sqrt2))))
+ (dly1 (abs (min 0.0 pos)))
+ (frac1 (- dly1 (floor dly1)))
+ (dly2 (max 0.0 pos))
+ (frac2 (- dly2 (floor dly2)))
+ (loc outloc)
+ (size maxd)
+ (loc10 (modulo (+ loc (floor dly1)) size))
+ (loc11 (modulo (+ loc 1 (floor dly1)) size))
+ (loc20 (modulo (+ loc (floor dly2)) size))
+ (loc21 (modulo (+ loc 1 (floor dly2)) size))
+ (rev reverb-amount))
+
+ (set! (out1 loc10) (+ (out1 loc10) (* amp1 input (- 1.0 frac1))))
+ (set! (out1 loc11) (+ (out1 loc11) (* amp1 input frac1)))
+ (set! (out2 loc20) (+ (out2 loc20) (* amp2 input (- 1.0 frac2))))
+ (set! (out2 loc21) (+ (out2 loc21) (* amp2 input frac2)))
+
+ (let ((val1 (out1 loc))
+ (val2 (out2 loc)))
+ (set! (out1 loc) 0.0)
+ (set! (out2 loc) 0.0)
+ (set! loc (+ loc 1))
+ (if (= loc size) (set! loc 0))
+ (outa samp val1)
+ (outb samp val2)
+ (if (> rev 0.0)
+ (begin
+ (outa samp (* rev val1) *reverb*)
+ (outb samp (* rev val2) *reverb*)))
+ (set! outloc loc)))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; old version of one-pole-all-pass
#|
-(definstrument (jcrev2)
- (let* (
- (allpass11 (make-all-pass -0.700 0.700 1051))
- (allpass21 (make-all-pass -0.700 0.700 337))
- (allpass31 (make-all-pass -0.700 0.700 113))
- (comb11 (make-comb 0.742 4799))
- (comb21 (make-comb 0.733 4999))
- (comb31 (make-comb 0.715 5399))
- (comb41 (make-comb 0.697 5801))
- (outdel11 (make-delay (seconds->samples .01)))
-
- (allpass12 (make-all-pass -0.700 0.700 1051))
- (allpass22 (make-all-pass -0.700 0.700 337))
- (allpass32 (make-all-pass -0.700 0.700 113))
- (comb12 (make-comb 0.742 4799))
- (comb22 (make-comb 0.733 4999))
- (comb32 (make-comb 0.715 5399))
- (comb42 (make-comb 0.697 5801))
- (outdel12 (make-delay (seconds->samples .01)))
-
- (file-dur (frames *reverb*))
- (decay-dur (mus-srate))
- (len (floor (+ decay-dur file-dur))))
-
- (run
- (do ((i 0 (+ 1 i)))
- ((= i len))
-
- (let* ((allpass-sum (all-pass allpass31
- (all-pass allpass21
- (all-pass allpass11
- (ina i *reverb*)))))
- (comb-sum (+ (comb comb11 allpass-sum)
- (comb comb21 allpass-sum)
- (comb comb31 allpass-sum)
- (comb comb41 allpass-sum))))
- (outa i (delay outdel11 comb-sum)))
-
- (let* ((allpass-sum (all-pass allpass32
- (all-pass allpass22
- (all-pass allpass12
- (inb i *reverb*)))))
- (comb-sum (+ (comb comb12 allpass-sum)
- (comb comb22 allpass-sum)
- (comb comb32 allpass-sum)
- (comb comb42 allpass-sum))))
- (outb i (delay outdel12 comb-sum)))
- ))))
-
-
-(definstrument (simp beg dur (amp 0.5) (freq 440.0) (ramp 2.0) (rfreq 1.0) offset)
- (let* ((os (make-pulse-train freq))
- (floc (make-flocsig :reverb-amount 0.1
- :frequency rfreq
- :amplitude ramp
- :offset offset))
- (start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (flocsig floc i (* amp (pulse-train os)))))))
+(defgenerator one-pole-allpass coeff input x1 y1)
-(with-sound (:channels 2 :reverb-channels 2 :reverb jcrev2) (simp 0 1))
-|#
+(define (one-pole-allpass gen input)
+ (let-set! gen 'input input)
+ (with-let gen
+ (set! y1 (+ x1 (* coeff (- input y1))))
+ (set! x1 input)
+ y1))
+
+(defgenerator one-pole-allpass-bank coeff input x1 y1 x2 y2 x3 y3 x4 y4 x5 y5 x6 y6 x7 y7 x8 y8)
+
+(define (one-pole-allpass-bank gen input)
+ (let-set! gen 'input input)
+ (with-let gen
+ (set! y1 (+ x1 (* coeff (- input y1))))
+ (set! x1 input)
+
+ (set! y2 (+ x2 (* coeff (- y1 y2))))
+ (set! x2 y1)
+
+ (set! y3 (+ x3 (* coeff (- y2 y3))))
+ (set! x3 y2)
+ (set! y4 (+ x4 (* coeff (- y3 y4))))
+ (set! x4 y3)
+
+ (set! y5 (+ x5 (* coeff (- y4 y5))))
+ (set! x5 y4)
+
+ (set! y6 (+ x6 (* coeff (- y5 y6))))
+ (set! x6 y5)
+
+ (set! y7 (+ x7 (* coeff (- y6 y7))))
+ (set! x7 y6)
+
+ (set! y8 (+ x8 (* coeff (- y7 y8))))
+ (set! x8 y7)
+ y8))
+
+
+(defgenerator expseg currentValue targetValue r)
+
+(define (expseg gen r)
+ (let-set! gen 'r r)
+ (with-let gen
+ (set! currentValue (+ (* r targetValue) (* (- 1.0 r) currentValue)))))
+ ;(set! currentValue (+ currentValue (* r (- targetValue currentValue))))))
+ ;; (bil) this is slightly different (getting clicks)
+
+
+(define (make-one-pole-swept)
+ (vector 0.0))
+
+(define (one-pole-swept gen input coef)
+ ;; signal controlled one-pole lowpass filter
+ (set! (gen 0) (- (* (+ 1.0 coef) input) (* coef (gen 0)))))
+
+(define (make-pnoise)
+ (vector 16383))
+
+(define (pnoise gen x)
+ ;; very special noise generator
+ (set! (gen 0) (logand (floor (+ (* (gen 0) 1103515245) 12345)) #xffffffff))
+ ;; (bil) added the logand -- otherwise we get an overflow somewhere
+ (* x (- (* (modulo (floor (/ (gen 0) 65536.0)) 65536) 0.0000305185) 1.0)))
+ ;; this looks nutty to me -- was it originally running in 32 bits?
+
+
+(define pn-gen 16383)
+(define (pnoise x)
+ ;; very special noise generator
+ (set! pn-gen (logand (+ (* pn-gen 1103515245) 12345) #xffffffff))
+ ;; (bil) added the logand -- otherwise we get an overflow somewhere, also removed floor
+ (* x (- (* pn-gen 4.6566128730774e-10) 1.0)))
+
+|#
+
diff --git a/gl.c b/gl.c
index ae851ed..8cc8f7e 100644
--- a/gl.c
+++ b/gl.c
@@ -7,6 +7,8 @@
* 'gl is added to *features*
*
* HISTORY:
+ *
+ * 16-Apr-14: changed max-args to 8.
* --------
* 16-Dec-09: removed Guile support.
* --------
@@ -27,7 +29,7 @@
* 20-May-02: initial version.
*/
-#include <mus-config.h>
+#include "mus-config.h"
#if HAVE_EXTENSION_LANGUAGE
#include <GL/gl.h>
@@ -65,27 +67,27 @@
#define XL_POST ""
#endif
-#define WRAP_FOR_XEN(Name, Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(Name), XEN_WRAP_C_POINTER(Value))
-#define WRAP_P(Name, Value) (XEN_LIST_P(Value) && \
- (XEN_LIST_LENGTH(Value) >= 2) && \
- (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp(Name, XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
+#define wrap_for_Xen(Name, Value) Xen_list_2(C_string_to_Xen_symbol(Name), Xen_wrap_C_pointer(Value))
+#define is_wrapped(Name, Value) (Xen_is_list(Value) && \
+ (Xen_list_length(Value) >= 2) && \
+ (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp(Name, Xen_symbol_to_C_string(Xen_car(Value))) == 0))
#define XL_TYPE(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(#Name), C_TO_XEN_ULONG(val)));} \
- static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \
- static int XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
+ static Xen C_to_Xen_ ## Name (XType val) {return(Xen_list_2(C_string_to_Xen_symbol(#Name), C_ulong_to_Xen_ulong(val)));} \
+ static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));}
#define XL_TYPE_1(Name, XType) \
- static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \
- static int XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
+ static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));}
#define XL_TYPE_PTR(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static int XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} /* if NULL ok, should be explicit */
+ static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(#Name, val)); return(Xen_false);} \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} /* if NULL ok, should be explicit */
#define XL_TYPE_PTR_1(Name, XType) \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static int XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} /* if NULL ok, should be explicit */
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} /* if NULL ok, should be explicit */
/* ---------------------------------------- types ---------------------------------------- */
@@ -93,74 +95,81 @@
#if USE_MOTIF
XL_TYPE_PTR(XVisualInfo, XVisualInfo*)
XL_TYPE_PTR(Display, Display*)
-#define C_TO_XEN_int(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_int(Arg) (int)(XEN_TO_C_INT(Arg))
-#define XEN_int_P(Arg) XEN_INTEGER_P(Arg)
+#define C_to_Xen_int(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_int(Arg) (int)(Xen_integer_to_C_int(Arg))
+#define Xen_is_int(Arg) Xen_is_integer(Arg)
XL_TYPE_PTR_1(int_, int*)
XL_TYPE_PTR(GLXContext, GLXContext)
-#define XEN_TO_C_unsigned_long(Arg) (unsigned_long)(XEN_TO_C_ULONG(Arg))
-#define XEN_unsigned_long_P(Arg) XEN_ULONG_P(Arg)
-#define C_TO_XEN_Bool(Arg) C_TO_XEN_BOOLEAN(Arg)
-#define XEN_TO_C_Bool(Arg) (Bool)(XEN_TO_C_BOOLEAN(Arg))
-#define XEN_Bool_P(Arg) XEN_BOOLEAN_P(Arg)
+#define Xen_to_C_unsigned_long(Arg) (unsigned_long)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_unsigned_long(Arg) Xen_is_ulong(Arg)
+#define C_to_Xen_Bool(Arg) C_bool_to_Xen_boolean(Arg)
+#define Xen_to_C_Bool(Arg) (Bool)(Xen_boolean_to_C_bool(Arg))
+#define Xen_is_Bool(Arg) Xen_is_boolean(Arg)
XL_TYPE(GLXPixmap, GLXPixmap)
XL_TYPE_1(Pixmap, Pixmap)
XL_TYPE(Window, Window)
XL_TYPE_1(Font, Font)
-#define C_TO_XEN_char_(Arg) C_TO_XEN_STRING(Arg)
-#define XEN_TO_C_char_(Arg) (char*)(XEN_TO_C_STRING(Arg))
-#define XEN_char__P(Arg) XEN_STRING_P(Arg)
+#define C_to_Xen_char_(Arg) C_string_to_Xen_string(Arg)
+#define Xen_to_C_char_(Arg) (char*)(Xen_string_to_C_string(Arg))
+#define Xen_is_char_(Arg) Xen_is_string(Arg)
#endif
-#define C_TO_XEN_GLfloat(Arg) C_TO_XEN_DOUBLE(Arg)
-#define XEN_TO_C_GLfloat(Arg) (GLfloat)(XEN_TO_C_DOUBLE(Arg))
-#define XEN_GLfloat_P(Arg) XEN_NUMBER_P(Arg)
-#define XEN_TO_C_GLclampf(Arg) (GLclampf)(XEN_TO_C_DOUBLE(Arg))
-#define XEN_GLclampf_P(Arg) XEN_NUMBER_P(Arg)
-#define XEN_TO_C_GLbitfield(Arg) (GLbitfield)(XEN_TO_C_ULONG(Arg))
-#define XEN_GLbitfield_P(Arg) XEN_ULONG_P(Arg)
-#define C_TO_XEN_GLuint(Arg) C_TO_XEN_ULONG(Arg)
-#define XEN_TO_C_GLuint(Arg) (GLuint)(XEN_TO_C_ULONG(Arg))
-#define XEN_GLuint_P(Arg) XEN_ULONG_P(Arg)
-#define C_TO_XEN_GLboolean(Arg) C_TO_XEN_BOOLEAN(Arg)
-#define XEN_TO_C_GLboolean(Arg) (GLboolean)(XEN_TO_C_BOOLEAN(Arg))
-#define XEN_GLboolean_P(Arg) XEN_BOOLEAN_P(Arg)
-#define C_TO_XEN_GLenum(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GLenum(Arg) (GLenum)(XEN_TO_C_INT(Arg))
-#define XEN_GLenum_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GLint(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GLint(Arg) (GLint)(XEN_TO_C_INT(Arg))
-#define XEN_GLint_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GLushort(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GLushort(Arg) (GLushort)(XEN_TO_C_INT(Arg))
-#define XEN_GLushort_P(Arg) XEN_INTEGER_P(Arg)
+#define C_to_Xen_GLfloat(Arg) C_double_to_Xen_real(Arg)
+#define Xen_to_C_GLfloat(Arg) (GLfloat)(Xen_real_to_C_double(Arg))
+#define Xen_is_GLfloat(Arg) Xen_is_number(Arg)
+#define Xen_to_C_GLclampf(Arg) (GLclampf)(Xen_real_to_C_double(Arg))
+#define Xen_is_GLclampf(Arg) Xen_is_number(Arg)
+#define Xen_to_C_GLbitfield(Arg) (GLbitfield)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_GLbitfield(Arg) Xen_is_ulong(Arg)
+#define C_to_Xen_GLuint(Arg) C_ulong_to_Xen_ulong(Arg)
+#define Xen_to_C_GLuint(Arg) (GLuint)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_GLuint(Arg) Xen_is_ulong(Arg)
+#define C_to_Xen_GLboolean(Arg) C_bool_to_Xen_boolean(Arg)
+#define Xen_to_C_GLboolean(Arg) (GLboolean)(Xen_boolean_to_C_bool(Arg))
+#define Xen_is_GLboolean(Arg) Xen_is_boolean(Arg)
+#define C_to_Xen_GLenum(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GLenum(Arg) (GLenum)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GLenum(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GLint(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GLint(Arg) (GLint)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GLint(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GLushort(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GLushort(Arg) (GLushort)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GLushort(Arg) Xen_is_integer(Arg)
XL_TYPE_PTR_1(GLubyte_, GLubyte*)
-#define XEN_TO_C_GLsizei(Arg) (GLsizei)(XEN_TO_C_INT(Arg))
-#define XEN_GLsizei_P(Arg) XEN_INTEGER_P(Arg)
+#define Xen_to_C_GLsizei(Arg) (GLsizei)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GLsizei(Arg) Xen_is_integer(Arg)
XL_TYPE_PTR_1(GLdouble_, GLdouble*)
-#define C_TO_XEN_GLdouble(Arg) C_TO_XEN_DOUBLE(Arg)
-#define XEN_TO_C_GLdouble(Arg) (GLdouble)(XEN_TO_C_DOUBLE(Arg))
-#define XEN_GLdouble_P(Arg) XEN_NUMBER_P(Arg)
-#define C_TO_XEN_constchar_(Arg) C_TO_XEN_STRING((char *)(Arg))
-#define XEN_TO_C_GLclampd(Arg) (GLclampd)(XEN_TO_C_DOUBLE(Arg))
-#define XEN_GLclampd_P(Arg) XEN_NUMBER_P(Arg)
+#define C_to_Xen_GLdouble(Arg) C_double_to_Xen_real(Arg)
+#define Xen_to_C_GLdouble(Arg) (GLdouble)(Xen_real_to_C_double(Arg))
+#define Xen_is_GLdouble(Arg) Xen_is_number(Arg)
+#define C_to_Xen_constchar_(Arg) C_string_to_Xen_string((char *)(Arg))
+#define Xen_to_C_GLclampd(Arg) (GLclampd)(Xen_real_to_C_double(Arg))
+#define Xen_is_GLclampd(Arg) Xen_is_number(Arg)
XL_TYPE_PTR_1(GLfloat_, GLfloat*)
XL_TYPE_PTR_1(GLvoid_, GLvoid*)
-#define XEN_TO_C_GLshort(Arg) (GLshort)(XEN_TO_C_INT(Arg))
-#define XEN_GLshort_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_GLbyte(Arg) (GLbyte)(XEN_TO_C_INT(Arg))
-#define XEN_GLbyte_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_GLubyte(Arg) (GLubyte)(XEN_TO_C_INT(Arg))
-#define XEN_GLubyte_P(Arg) XEN_INTEGER_P(Arg)
+#define Xen_to_C_GLshort(Arg) (GLshort)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GLshort(Arg) Xen_is_integer(Arg)
+#define Xen_to_C_GLbyte(Arg) (GLbyte)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GLbyte(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GLubyte(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GLubyte(Arg) (GLubyte)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GLubyte(Arg) Xen_is_integer(Arg)
XL_TYPE_PTR(void_, void*)
XL_TYPE_PTR_1(GLuint_, GLuint*)
XL_TYPE_PTR_1(GLboolean_, GLboolean*)
+#if HAVE_GLU
XL_TYPE_PTR(GLUnurbs_, GLUnurbs*)
+#endif
#ifdef GLU_VERSION_1_2
XL_TYPE_PTR(GLUtesselator_, GLUtesselator*)
#endif
+#if HAVE_GLU
XL_TYPE_PTR(GLUquadric_, GLUquadric*)
+#endif
XL_TYPE_PTR_1(GLint_, GLint*)
+#if HAVE_GLU
XL_TYPE(_GLUfuncptr, _GLUfuncptr)
+#endif
/* ---------------------------------------- state readback confusion ---------------------------------------- */
@@ -208,3716 +217,3826 @@ static int how_many_vals(GLenum gl)
/* ---------------------------------------- functions ---------------------------------------- */
#if USE_MOTIF
-static XEN gxg_glXChooseVisual(XEN dpy, XEN screen, XEN attribList)
+static Xen gxg_glXChooseVisual(Xen dpy, Xen screen, Xen attribList)
{
#define H_glXChooseVisual "XVisualInfo* glXChooseVisual(Display* dpy, int screen, int* attribList)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXChooseVisual", "Display*");
- XEN_ASSERT_TYPE(XEN_int_P(screen), screen, 2, "glXChooseVisual", "int");
- XEN_ASSERT_TYPE(XEN_int__P(attribList), attribList, 3, "glXChooseVisual", "int*");
- return(C_TO_XEN_XVisualInfo(glXChooseVisual(XEN_TO_C_Display(dpy), XEN_TO_C_int(screen), XEN_TO_C_int_(attribList))));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXChooseVisual", "Display*");
+ Xen_check_type(Xen_is_int(screen), screen, 2, "glXChooseVisual", "int");
+ Xen_check_type(Xen_is_int_(attribList), attribList, 3, "glXChooseVisual", "int*");
+ return(C_to_Xen_XVisualInfo(glXChooseVisual(Xen_to_C_Display(dpy), Xen_to_C_int(screen), Xen_to_C_int_(attribList))));
}
-static XEN gxg_glXCopyContext(XEN dpy, XEN src, XEN dst, XEN mask)
+static Xen gxg_glXCopyContext(Xen dpy, Xen src, Xen dst, Xen mask)
{
#define H_glXCopyContext "void glXCopyContext(Display* dpy, GLXContext src, GLXContext dst, unsigned_long mask)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXCopyContext", "Display*");
- XEN_ASSERT_TYPE(XEN_GLXContext_P(src), src, 2, "glXCopyContext", "GLXContext");
- XEN_ASSERT_TYPE(XEN_GLXContext_P(dst), dst, 3, "glXCopyContext", "GLXContext");
- XEN_ASSERT_TYPE(XEN_unsigned_long_P(mask), mask, 4, "glXCopyContext", "unsigned_long");
- glXCopyContext(XEN_TO_C_Display(dpy), XEN_TO_C_GLXContext(src), XEN_TO_C_GLXContext(dst), XEN_TO_C_unsigned_long(mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXCopyContext", "Display*");
+ Xen_check_type(Xen_is_GLXContext(src), src, 2, "glXCopyContext", "GLXContext");
+ Xen_check_type(Xen_is_GLXContext(dst), dst, 3, "glXCopyContext", "GLXContext");
+ Xen_check_type(Xen_is_unsigned_long(mask), mask, 4, "glXCopyContext", "unsigned_long");
+ glXCopyContext(Xen_to_C_Display(dpy), Xen_to_C_GLXContext(src), Xen_to_C_GLXContext(dst), Xen_to_C_unsigned_long(mask));
+ return(Xen_false);
}
-static XEN gxg_glXCreateContext(XEN dpy, XEN vis, XEN shareList, XEN direct)
+static Xen gxg_glXCreateContext(Xen dpy, Xen vis, Xen shareList, Xen direct)
{
#define H_glXCreateContext "GLXContext glXCreateContext(Display* dpy, XVisualInfo* vis, GLXContext shareList, \
Bool direct)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXCreateContext", "Display*");
- XEN_ASSERT_TYPE(XEN_XVisualInfo_P(vis), vis, 2, "glXCreateContext", "XVisualInfo*");
- XEN_ASSERT_TYPE(XEN_GLXContext_P(shareList), shareList, 3, "glXCreateContext", "GLXContext");
- XEN_ASSERT_TYPE(XEN_Bool_P(direct), direct, 4, "glXCreateContext", "Bool");
- return(C_TO_XEN_GLXContext(glXCreateContext(XEN_TO_C_Display(dpy), XEN_TO_C_XVisualInfo(vis), XEN_TO_C_GLXContext(shareList),
- XEN_TO_C_Bool(direct))));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXCreateContext", "Display*");
+ Xen_check_type(Xen_is_XVisualInfo(vis), vis, 2, "glXCreateContext", "XVisualInfo*");
+ Xen_check_type(Xen_is_GLXContext(shareList), shareList, 3, "glXCreateContext", "GLXContext");
+ Xen_check_type(Xen_is_Bool(direct), direct, 4, "glXCreateContext", "Bool");
+ return(C_to_Xen_GLXContext(glXCreateContext(Xen_to_C_Display(dpy), Xen_to_C_XVisualInfo(vis), Xen_to_C_GLXContext(shareList),
+ Xen_to_C_Bool(direct))));
}
-static XEN gxg_glXCreateGLXPixmap(XEN dpy, XEN vis, XEN pixmap)
+static Xen gxg_glXCreateGLXPixmap(Xen dpy, Xen vis, Xen pixmap)
{
#define H_glXCreateGLXPixmap "GLXPixmap glXCreateGLXPixmap(Display* dpy, XVisualInfo* vis, Pixmap pixmap)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXCreateGLXPixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_XVisualInfo_P(vis), vis, 2, "glXCreateGLXPixmap", "XVisualInfo*");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(pixmap), pixmap, 3, "glXCreateGLXPixmap", "Pixmap");
- return(C_TO_XEN_GLXPixmap(glXCreateGLXPixmap(XEN_TO_C_Display(dpy), XEN_TO_C_XVisualInfo(vis), XEN_TO_C_Pixmap(pixmap))));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXCreateGLXPixmap", "Display*");
+ Xen_check_type(Xen_is_XVisualInfo(vis), vis, 2, "glXCreateGLXPixmap", "XVisualInfo*");
+ Xen_check_type(Xen_is_Pixmap(pixmap), pixmap, 3, "glXCreateGLXPixmap", "Pixmap");
+ return(C_to_Xen_GLXPixmap(glXCreateGLXPixmap(Xen_to_C_Display(dpy), Xen_to_C_XVisualInfo(vis), Xen_to_C_Pixmap(pixmap))));
}
-static XEN gxg_glXDestroyContext(XEN dpy, XEN ctx)
+static Xen gxg_glXDestroyContext(Xen dpy, Xen ctx)
{
#define H_glXDestroyContext "void glXDestroyContext(Display* dpy, GLXContext ctx)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXDestroyContext", "Display*");
- XEN_ASSERT_TYPE(XEN_GLXContext_P(ctx), ctx, 2, "glXDestroyContext", "GLXContext");
- glXDestroyContext(XEN_TO_C_Display(dpy), XEN_TO_C_GLXContext(ctx));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXDestroyContext", "Display*");
+ Xen_check_type(Xen_is_GLXContext(ctx), ctx, 2, "glXDestroyContext", "GLXContext");
+ glXDestroyContext(Xen_to_C_Display(dpy), Xen_to_C_GLXContext(ctx));
+ return(Xen_false);
}
-static XEN gxg_glXDestroyGLXPixmap(XEN dpy, XEN pix)
+static Xen gxg_glXDestroyGLXPixmap(Xen dpy, Xen pix)
{
#define H_glXDestroyGLXPixmap "void glXDestroyGLXPixmap(Display* dpy, GLXPixmap pix)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXDestroyGLXPixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_GLXPixmap_P(pix), pix, 2, "glXDestroyGLXPixmap", "GLXPixmap");
- glXDestroyGLXPixmap(XEN_TO_C_Display(dpy), XEN_TO_C_GLXPixmap(pix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXDestroyGLXPixmap", "Display*");
+ Xen_check_type(Xen_is_GLXPixmap(pix), pix, 2, "glXDestroyGLXPixmap", "GLXPixmap");
+ glXDestroyGLXPixmap(Xen_to_C_Display(dpy), Xen_to_C_GLXPixmap(pix));
+ return(Xen_false);
}
-static XEN gxg_glXGetConfig(XEN dpy, XEN vis, XEN attrib, XEN value)
+static Xen gxg_glXGetConfig(Xen dpy, Xen vis, Xen attrib, Xen value)
{
#define H_glXGetConfig "int glXGetConfig(Display* dpy, XVisualInfo* vis, int attrib, int* [value])"
int ref_value[1];
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXGetConfig", "Display*");
- XEN_ASSERT_TYPE(XEN_XVisualInfo_P(vis), vis, 2, "glXGetConfig", "XVisualInfo*");
- XEN_ASSERT_TYPE(XEN_int_P(attrib), attrib, 3, "glXGetConfig", "int");
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXGetConfig", "Display*");
+ Xen_check_type(Xen_is_XVisualInfo(vis), vis, 2, "glXGetConfig", "XVisualInfo*");
+ Xen_check_type(Xen_is_int(attrib), attrib, 3, "glXGetConfig", "int");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_int(glXGetConfig(XEN_TO_C_Display(dpy), XEN_TO_C_XVisualInfo(vis), XEN_TO_C_int(attrib), ref_value));
- return(XEN_LIST_2(result, C_TO_XEN_int(ref_value[0])));
+ Xen result;
+ result = C_to_Xen_int(glXGetConfig(Xen_to_C_Display(dpy), Xen_to_C_XVisualInfo(vis), Xen_to_C_int(attrib), ref_value));
+ return(Xen_list_2(result, C_to_Xen_int(ref_value[0])));
}
}
-static XEN gxg_glXGetCurrentContext(void)
+static Xen gxg_glXGetCurrentContext(void)
{
#define H_glXGetCurrentContext "GLXContext glXGetCurrentContext( void)"
- return(C_TO_XEN_GLXContext(glXGetCurrentContext()));
+ return(C_to_Xen_GLXContext(glXGetCurrentContext()));
}
-static XEN gxg_glXGetCurrentDrawable(void)
+static Xen gxg_glXGetCurrentDrawable(void)
{
#define H_glXGetCurrentDrawable "Window glXGetCurrentDrawable( void)"
- return(C_TO_XEN_Window(glXGetCurrentDrawable()));
+ return(C_to_Xen_Window(glXGetCurrentDrawable()));
}
-static XEN gxg_glXIsDirect(XEN dpy, XEN ctx)
+static Xen gxg_glXIsDirect(Xen dpy, Xen ctx)
{
#define H_glXIsDirect "Bool glXIsDirect(Display* dpy, GLXContext ctx)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXIsDirect", "Display*");
- XEN_ASSERT_TYPE(XEN_GLXContext_P(ctx), ctx, 2, "glXIsDirect", "GLXContext");
- return(C_TO_XEN_Bool(glXIsDirect(XEN_TO_C_Display(dpy), XEN_TO_C_GLXContext(ctx))));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXIsDirect", "Display*");
+ Xen_check_type(Xen_is_GLXContext(ctx), ctx, 2, "glXIsDirect", "GLXContext");
+ return(C_to_Xen_Bool(glXIsDirect(Xen_to_C_Display(dpy), Xen_to_C_GLXContext(ctx))));
}
-static XEN gxg_glXMakeCurrent(XEN dpy, XEN drawable, XEN ctx)
+static Xen gxg_glXMakeCurrent(Xen dpy, Xen drawable, Xen ctx)
{
#define H_glXMakeCurrent "Bool glXMakeCurrent(Display* dpy, Window drawable, GLXContext ctx)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXMakeCurrent", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(drawable), drawable, 2, "glXMakeCurrent", "Window");
- XEN_ASSERT_TYPE(XEN_GLXContext_P(ctx), ctx, 3, "glXMakeCurrent", "GLXContext");
- return(C_TO_XEN_Bool(glXMakeCurrent(XEN_TO_C_Display(dpy), XEN_TO_C_Window(drawable), XEN_TO_C_GLXContext(ctx))));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXMakeCurrent", "Display*");
+ Xen_check_type(Xen_is_Window(drawable), drawable, 2, "glXMakeCurrent", "Window");
+ Xen_check_type(Xen_is_GLXContext(ctx), ctx, 3, "glXMakeCurrent", "GLXContext");
+ return(C_to_Xen_Bool(glXMakeCurrent(Xen_to_C_Display(dpy), Xen_to_C_Window(drawable), Xen_to_C_GLXContext(ctx))));
}
-static XEN gxg_glXQueryExtension(XEN dpy, XEN errorBase, XEN eventBase)
+static Xen gxg_glXQueryExtension(Xen dpy, Xen errorBase, Xen eventBase)
{
#define H_glXQueryExtension "Bool glXQueryExtension(Display* dpy, int* [errorBase], int* [eventBase])"
int ref_errorBase[1];
int ref_eventBase[1];
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXQueryExtension", "Display*");
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXQueryExtension", "Display*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_Bool(glXQueryExtension(XEN_TO_C_Display(dpy), ref_errorBase, ref_eventBase));
- return(XEN_LIST_3(result, C_TO_XEN_int(ref_errorBase[0]), C_TO_XEN_int(ref_eventBase[0])));
+ Xen result;
+ result = C_to_Xen_Bool(glXQueryExtension(Xen_to_C_Display(dpy), ref_errorBase, ref_eventBase));
+ return(Xen_list_3(result, C_to_Xen_int(ref_errorBase[0]), C_to_Xen_int(ref_eventBase[0])));
}
}
-static XEN gxg_glXQueryVersion(XEN dpy, XEN major, XEN minor)
+static Xen gxg_glXQueryVersion(Xen dpy, Xen major, Xen minor)
{
#define H_glXQueryVersion "Bool glXQueryVersion(Display* dpy, int* [major], int* [minor])"
int ref_major[1];
int ref_minor[1];
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXQueryVersion", "Display*");
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXQueryVersion", "Display*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_Bool(glXQueryVersion(XEN_TO_C_Display(dpy), ref_major, ref_minor));
- return(XEN_LIST_3(result, C_TO_XEN_int(ref_major[0]), C_TO_XEN_int(ref_minor[0])));
+ Xen result;
+ result = C_to_Xen_Bool(glXQueryVersion(Xen_to_C_Display(dpy), ref_major, ref_minor));
+ return(Xen_list_3(result, C_to_Xen_int(ref_major[0]), C_to_Xen_int(ref_minor[0])));
}
}
-static XEN gxg_glXSwapBuffers(XEN dpy, XEN drawable)
+static Xen gxg_glXSwapBuffers(Xen dpy, Xen drawable)
{
#define H_glXSwapBuffers "void glXSwapBuffers(Display* dpy, Window drawable)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXSwapBuffers", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(drawable), drawable, 2, "glXSwapBuffers", "Window");
- glXSwapBuffers(XEN_TO_C_Display(dpy), XEN_TO_C_Window(drawable));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXSwapBuffers", "Display*");
+ Xen_check_type(Xen_is_Window(drawable), drawable, 2, "glXSwapBuffers", "Window");
+ glXSwapBuffers(Xen_to_C_Display(dpy), Xen_to_C_Window(drawable));
+ return(Xen_false);
}
-static XEN gxg_glXUseXFont(XEN font, XEN first, XEN count, XEN listBase)
+static Xen gxg_glXUseXFont(Xen font, Xen first, Xen count, Xen listBase)
{
#define H_glXUseXFont "void glXUseXFont(Font font, int first, int count, int listBase)"
- XEN_ASSERT_TYPE(XEN_Font_P(font), font, 1, "glXUseXFont", "Font");
- XEN_ASSERT_TYPE(XEN_int_P(first), first, 2, "glXUseXFont", "int");
- XEN_ASSERT_TYPE(XEN_int_P(count), count, 3, "glXUseXFont", "int");
- XEN_ASSERT_TYPE(XEN_int_P(listBase), listBase, 4, "glXUseXFont", "int");
- glXUseXFont(XEN_TO_C_Font(font), XEN_TO_C_int(first), XEN_TO_C_int(count), XEN_TO_C_int(listBase));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Font(font), font, 1, "glXUseXFont", "Font");
+ Xen_check_type(Xen_is_int(first), first, 2, "glXUseXFont", "int");
+ Xen_check_type(Xen_is_int(count), count, 3, "glXUseXFont", "int");
+ Xen_check_type(Xen_is_int(listBase), listBase, 4, "glXUseXFont", "int");
+ glXUseXFont(Xen_to_C_Font(font), Xen_to_C_int(first), Xen_to_C_int(count), Xen_to_C_int(listBase));
+ return(Xen_false);
}
-static XEN gxg_glXWaitGL(void)
+static Xen gxg_glXWaitGL(void)
{
#define H_glXWaitGL "void glXWaitGL( void)"
glXWaitGL();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glXWaitX(void)
+static Xen gxg_glXWaitX(void)
{
#define H_glXWaitX "void glXWaitX( void)"
glXWaitX();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glXGetClientString(XEN dpy, XEN name)
+static Xen gxg_glXGetClientString(Xen dpy, Xen name)
{
#define H_glXGetClientString "char* glXGetClientString(Display* dpy, int name)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXGetClientString", "Display*");
- XEN_ASSERT_TYPE(XEN_int_P(name), name, 2, "glXGetClientString", "int");
- return(C_TO_XEN_char_(glXGetClientString(XEN_TO_C_Display(dpy), XEN_TO_C_int(name))));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXGetClientString", "Display*");
+ Xen_check_type(Xen_is_int(name), name, 2, "glXGetClientString", "int");
+ return(C_to_Xen_char_(glXGetClientString(Xen_to_C_Display(dpy), Xen_to_C_int(name))));
}
-static XEN gxg_glXQueryServerString(XEN dpy, XEN screen, XEN name)
+static Xen gxg_glXQueryServerString(Xen dpy, Xen screen, Xen name)
{
#define H_glXQueryServerString "char* glXQueryServerString(Display* dpy, int screen, int name)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXQueryServerString", "Display*");
- XEN_ASSERT_TYPE(XEN_int_P(screen), screen, 2, "glXQueryServerString", "int");
- XEN_ASSERT_TYPE(XEN_int_P(name), name, 3, "glXQueryServerString", "int");
- return(C_TO_XEN_char_(glXQueryServerString(XEN_TO_C_Display(dpy), XEN_TO_C_int(screen), XEN_TO_C_int(name))));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXQueryServerString", "Display*");
+ Xen_check_type(Xen_is_int(screen), screen, 2, "glXQueryServerString", "int");
+ Xen_check_type(Xen_is_int(name), name, 3, "glXQueryServerString", "int");
+ return(C_to_Xen_char_(glXQueryServerString(Xen_to_C_Display(dpy), Xen_to_C_int(screen), Xen_to_C_int(name))));
}
-static XEN gxg_glXQueryExtensionsString(XEN dpy, XEN screen)
+static Xen gxg_glXQueryExtensionsString(Xen dpy, Xen screen)
{
#define H_glXQueryExtensionsString "char* glXQueryExtensionsString(Display* dpy, int screen)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, 1, "glXQueryExtensionsString", "Display*");
- XEN_ASSERT_TYPE(XEN_int_P(screen), screen, 2, "glXQueryExtensionsString", "int");
- return(C_TO_XEN_char_(glXQueryExtensionsString(XEN_TO_C_Display(dpy), XEN_TO_C_int(screen))));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "glXQueryExtensionsString", "Display*");
+ Xen_check_type(Xen_is_int(screen), screen, 2, "glXQueryExtensionsString", "int");
+ return(C_to_Xen_char_(glXQueryExtensionsString(Xen_to_C_Display(dpy), Xen_to_C_int(screen))));
}
#endif
-static XEN gxg_glClearIndex(XEN c)
+static Xen gxg_glClearIndex(Xen c)
{
#define H_glClearIndex "void glClearIndex(GLfloat c)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(c), c, 1, "glClearIndex", "GLfloat");
- glClearIndex(XEN_TO_C_GLfloat(c));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(c), c, 1, "glClearIndex", "GLfloat");
+ glClearIndex(Xen_to_C_GLfloat(c));
+ return(Xen_false);
}
-static XEN gxg_glClearColor(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glClearColor(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glClearColor "void glClearColor(GLclampf red, GLclampf green, GLclampf blue, GLclampf alpha)"
- XEN_ASSERT_TYPE(XEN_GLclampf_P(red), red, 1, "glClearColor", "GLclampf");
- XEN_ASSERT_TYPE(XEN_GLclampf_P(green), green, 2, "glClearColor", "GLclampf");
- XEN_ASSERT_TYPE(XEN_GLclampf_P(blue), blue, 3, "glClearColor", "GLclampf");
- XEN_ASSERT_TYPE(XEN_GLclampf_P(alpha), alpha, 4, "glClearColor", "GLclampf");
- glClearColor(XEN_TO_C_GLclampf(red), XEN_TO_C_GLclampf(green), XEN_TO_C_GLclampf(blue), XEN_TO_C_GLclampf(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLclampf(red), red, 1, "glClearColor", "GLclampf");
+ Xen_check_type(Xen_is_GLclampf(green), green, 2, "glClearColor", "GLclampf");
+ Xen_check_type(Xen_is_GLclampf(blue), blue, 3, "glClearColor", "GLclampf");
+ Xen_check_type(Xen_is_GLclampf(alpha), alpha, 4, "glClearColor", "GLclampf");
+ glClearColor(Xen_to_C_GLclampf(red), Xen_to_C_GLclampf(green), Xen_to_C_GLclampf(blue), Xen_to_C_GLclampf(alpha));
+ return(Xen_false);
}
-static XEN gxg_glClear(XEN mask)
+static Xen gxg_glClear(Xen mask)
{
#define H_glClear "void glClear(GLbitfield mask)"
- XEN_ASSERT_TYPE(XEN_GLbitfield_P(mask), mask, 1, "glClear", "GLbitfield");
- glClear(XEN_TO_C_GLbitfield(mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLbitfield(mask), mask, 1, "glClear", "GLbitfield");
+ glClear(Xen_to_C_GLbitfield(mask));
+ return(Xen_false);
}
-static XEN gxg_glIndexMask(XEN mask)
+static Xen gxg_glIndexMask(Xen mask)
{
#define H_glIndexMask "void glIndexMask(GLuint mask)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(mask), mask, 1, "glIndexMask", "GLuint");
- glIndexMask(XEN_TO_C_GLuint(mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(mask), mask, 1, "glIndexMask", "GLuint");
+ glIndexMask(Xen_to_C_GLuint(mask));
+ return(Xen_false);
}
-static XEN gxg_glColorMask(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColorMask(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColorMask "void glColorMask(GLboolean red, GLboolean green, GLboolean blue, GLboolean alpha)"
- XEN_ASSERT_TYPE(XEN_GLboolean_P(red), red, 1, "glColorMask", "GLboolean");
- XEN_ASSERT_TYPE(XEN_GLboolean_P(green), green, 2, "glColorMask", "GLboolean");
- XEN_ASSERT_TYPE(XEN_GLboolean_P(blue), blue, 3, "glColorMask", "GLboolean");
- XEN_ASSERT_TYPE(XEN_GLboolean_P(alpha), alpha, 4, "glColorMask", "GLboolean");
- glColorMask(XEN_TO_C_GLboolean(red), XEN_TO_C_GLboolean(green), XEN_TO_C_GLboolean(blue), XEN_TO_C_GLboolean(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLboolean(red), red, 1, "glColorMask", "GLboolean");
+ Xen_check_type(Xen_is_GLboolean(green), green, 2, "glColorMask", "GLboolean");
+ Xen_check_type(Xen_is_GLboolean(blue), blue, 3, "glColorMask", "GLboolean");
+ Xen_check_type(Xen_is_GLboolean(alpha), alpha, 4, "glColorMask", "GLboolean");
+ glColorMask(Xen_to_C_GLboolean(red), Xen_to_C_GLboolean(green), Xen_to_C_GLboolean(blue), Xen_to_C_GLboolean(alpha));
+ return(Xen_false);
}
-static XEN gxg_glAlphaFunc(XEN func, XEN ref)
+static Xen gxg_glAlphaFunc(Xen func, Xen ref)
{
#define H_glAlphaFunc "void glAlphaFunc(GLenum func, GLclampf ref)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(func), func, 1, "glAlphaFunc", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLclampf_P(ref), ref, 2, "glAlphaFunc", "GLclampf");
- glAlphaFunc(XEN_TO_C_GLenum(func), XEN_TO_C_GLclampf(ref));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(func), func, 1, "glAlphaFunc", "GLenum");
+ Xen_check_type(Xen_is_GLclampf(ref), ref, 2, "glAlphaFunc", "GLclampf");
+ glAlphaFunc(Xen_to_C_GLenum(func), Xen_to_C_GLclampf(ref));
+ return(Xen_false);
}
-static XEN gxg_glBlendFunc(XEN sfactor, XEN dfactor)
+static Xen gxg_glBlendFunc(Xen sfactor, Xen dfactor)
{
#define H_glBlendFunc "void glBlendFunc(GLenum sfactor, GLenum dfactor)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(sfactor), sfactor, 1, "glBlendFunc", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(dfactor), dfactor, 2, "glBlendFunc", "GLenum");
- glBlendFunc(XEN_TO_C_GLenum(sfactor), XEN_TO_C_GLenum(dfactor));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(sfactor), sfactor, 1, "glBlendFunc", "GLenum");
+ Xen_check_type(Xen_is_GLenum(dfactor), dfactor, 2, "glBlendFunc", "GLenum");
+ glBlendFunc(Xen_to_C_GLenum(sfactor), Xen_to_C_GLenum(dfactor));
+ return(Xen_false);
}
-static XEN gxg_glLogicOp(XEN opcode)
+static Xen gxg_glLogicOp(Xen opcode)
{
#define H_glLogicOp "void glLogicOp(GLenum opcode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(opcode), opcode, 1, "glLogicOp", "GLenum");
- glLogicOp(XEN_TO_C_GLenum(opcode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(opcode), opcode, 1, "glLogicOp", "GLenum");
+ glLogicOp(Xen_to_C_GLenum(opcode));
+ return(Xen_false);
}
-static XEN gxg_glCullFace(XEN mode)
+static Xen gxg_glCullFace(Xen mode)
{
#define H_glCullFace "void glCullFace(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glCullFace", "GLenum");
- glCullFace(XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glCullFace", "GLenum");
+ glCullFace(Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glFrontFace(XEN mode)
+static Xen gxg_glFrontFace(Xen mode)
{
#define H_glFrontFace "void glFrontFace(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glFrontFace", "GLenum");
- glFrontFace(XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glFrontFace", "GLenum");
+ glFrontFace(Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glPointSize(XEN size)
+static Xen gxg_glPointSize(Xen size)
{
#define H_glPointSize "void glPointSize(GLfloat size)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(size), size, 1, "glPointSize", "GLfloat");
- glPointSize(XEN_TO_C_GLfloat(size));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(size), size, 1, "glPointSize", "GLfloat");
+ glPointSize(Xen_to_C_GLfloat(size));
+ return(Xen_false);
}
-static XEN gxg_glLineWidth(XEN width)
+static Xen gxg_glLineWidth(Xen width)
{
#define H_glLineWidth "void glLineWidth(GLfloat width)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(width), width, 1, "glLineWidth", "GLfloat");
- glLineWidth(XEN_TO_C_GLfloat(width));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(width), width, 1, "glLineWidth", "GLfloat");
+ glLineWidth(Xen_to_C_GLfloat(width));
+ return(Xen_false);
}
-static XEN gxg_glLineStipple(XEN factor, XEN pattern)
+static Xen gxg_glLineStipple(Xen factor, Xen pattern)
{
#define H_glLineStipple "void glLineStipple(GLint factor, GLushort pattern)"
- XEN_ASSERT_TYPE(XEN_GLint_P(factor), factor, 1, "glLineStipple", "GLint");
- XEN_ASSERT_TYPE(XEN_GLushort_P(pattern), pattern, 2, "glLineStipple", "GLushort");
- glLineStipple(XEN_TO_C_GLint(factor), XEN_TO_C_GLushort(pattern));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(factor), factor, 1, "glLineStipple", "GLint");
+ Xen_check_type(Xen_is_GLushort(pattern), pattern, 2, "glLineStipple", "GLushort");
+ glLineStipple(Xen_to_C_GLint(factor), Xen_to_C_GLushort(pattern));
+ return(Xen_false);
}
-static XEN gxg_glPolygonMode(XEN face, XEN mode)
+static Xen gxg_glPolygonMode(Xen face, Xen mode)
{
#define H_glPolygonMode "void glPolygonMode(GLenum face, GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(face), face, 1, "glPolygonMode", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 2, "glPolygonMode", "GLenum");
- glPolygonMode(XEN_TO_C_GLenum(face), XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(face), face, 1, "glPolygonMode", "GLenum");
+ Xen_check_type(Xen_is_GLenum(mode), mode, 2, "glPolygonMode", "GLenum");
+ glPolygonMode(Xen_to_C_GLenum(face), Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glPolygonOffset(XEN factor, XEN units)
+static Xen gxg_glPolygonOffset(Xen factor, Xen units)
{
#define H_glPolygonOffset "void glPolygonOffset(GLfloat factor, GLfloat units)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(factor), factor, 1, "glPolygonOffset", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(units), units, 2, "glPolygonOffset", "GLfloat");
- glPolygonOffset(XEN_TO_C_GLfloat(factor), XEN_TO_C_GLfloat(units));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(factor), factor, 1, "glPolygonOffset", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(units), units, 2, "glPolygonOffset", "GLfloat");
+ glPolygonOffset(Xen_to_C_GLfloat(factor), Xen_to_C_GLfloat(units));
+ return(Xen_false);
}
-static XEN gxg_glPolygonStipple(XEN mask)
+static Xen gxg_glPolygonStipple(Xen mask)
{
#define H_glPolygonStipple "void glPolygonStipple(GLubyte* mask)"
- XEN_ASSERT_TYPE(XEN_GLubyte__P(mask), mask, 1, "glPolygonStipple", "GLubyte*");
- glPolygonStipple(XEN_TO_C_GLubyte_(mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLubyte_(mask), mask, 1, "glPolygonStipple", "GLubyte*");
+ glPolygonStipple(Xen_to_C_GLubyte_(mask));
+ return(Xen_false);
}
-static XEN gxg_glEdgeFlag(XEN flag)
+static Xen gxg_glEdgeFlag(Xen flag)
{
#define H_glEdgeFlag "void glEdgeFlag(GLboolean flag)"
- XEN_ASSERT_TYPE(XEN_GLboolean_P(flag), flag, 1, "glEdgeFlag", "GLboolean");
- glEdgeFlag(XEN_TO_C_GLboolean(flag));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLboolean(flag), flag, 1, "glEdgeFlag", "GLboolean");
+ glEdgeFlag(Xen_to_C_GLboolean(flag));
+ return(Xen_false);
}
-static XEN gxg_glScissor(XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_glScissor(Xen x, Xen y, Xen width, Xen height)
{
#define H_glScissor "void glScissor(GLint x, GLint y, GLsizei width, GLsizei height)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glScissor", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glScissor", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "glScissor", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "glScissor", "GLsizei");
- glScissor(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glScissor", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glScissor", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "glScissor", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "glScissor", "GLsizei");
+ glScissor(Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height));
+ return(Xen_false);
}
-static XEN gxg_glClipPlane(XEN plane, XEN equation)
+static Xen gxg_glClipPlane(Xen plane, Xen equation)
{
#define H_glClipPlane "void glClipPlane(GLenum plane, GLdouble* equation)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(plane), plane, 1, "glClipPlane", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(equation), equation, 2, "glClipPlane", "GLdouble*");
- glClipPlane(XEN_TO_C_GLenum(plane), XEN_TO_C_GLdouble_(equation));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(plane), plane, 1, "glClipPlane", "GLenum");
+ Xen_check_type(Xen_is_GLdouble_(equation), equation, 2, "glClipPlane", "GLdouble*");
+ glClipPlane(Xen_to_C_GLenum(plane), Xen_to_C_GLdouble_(equation));
+ return(Xen_false);
}
-static XEN gxg_glGetClipPlane(XEN plane, XEN equation)
+static Xen gxg_glGetClipPlane(Xen plane, Xen equation)
{
#define H_glGetClipPlane "void glGetClipPlane(GLenum plane, GLdouble* [equation])"
GLdouble ref_equation[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(plane), plane, 1, "glGetClipPlane", "GLenum");
- glGetClipPlane(XEN_TO_C_GLenum(plane), ref_equation);
- return(XEN_LIST_1(C_TO_XEN_GLdouble(ref_equation[0])));
+ Xen_check_type(Xen_is_GLenum(plane), plane, 1, "glGetClipPlane", "GLenum");
+ glGetClipPlane(Xen_to_C_GLenum(plane), ref_equation);
+ return(Xen_list_1(C_to_Xen_GLdouble(ref_equation[0])));
}
-static XEN gxg_glDrawBuffer(XEN mode)
+static Xen gxg_glDrawBuffer(Xen mode)
{
#define H_glDrawBuffer "void glDrawBuffer(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glDrawBuffer", "GLenum");
- glDrawBuffer(XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glDrawBuffer", "GLenum");
+ glDrawBuffer(Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glReadBuffer(XEN mode)
+static Xen gxg_glReadBuffer(Xen mode)
{
#define H_glReadBuffer "void glReadBuffer(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glReadBuffer", "GLenum");
- glReadBuffer(XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glReadBuffer", "GLenum");
+ glReadBuffer(Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glEnable(XEN cap)
+static Xen gxg_glEnable(Xen cap)
{
#define H_glEnable "void glEnable(GLenum cap)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(cap), cap, 1, "glEnable", "GLenum");
- glEnable(XEN_TO_C_GLenum(cap));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(cap), cap, 1, "glEnable", "GLenum");
+ glEnable(Xen_to_C_GLenum(cap));
+ return(Xen_false);
}
-static XEN gxg_glDisable(XEN cap)
+static Xen gxg_glDisable(Xen cap)
{
#define H_glDisable "void glDisable(GLenum cap)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(cap), cap, 1, "glDisable", "GLenum");
- glDisable(XEN_TO_C_GLenum(cap));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(cap), cap, 1, "glDisable", "GLenum");
+ glDisable(Xen_to_C_GLenum(cap));
+ return(Xen_false);
}
-static XEN gxg_glIsEnabled(XEN cap)
+static Xen gxg_glIsEnabled(Xen cap)
{
#define H_glIsEnabled "GLboolean glIsEnabled(GLenum cap)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(cap), cap, 1, "glIsEnabled", "GLenum");
- return(C_TO_XEN_GLboolean(glIsEnabled(XEN_TO_C_GLenum(cap))));
+ Xen_check_type(Xen_is_GLenum(cap), cap, 1, "glIsEnabled", "GLenum");
+ return(C_to_Xen_GLboolean(glIsEnabled(Xen_to_C_GLenum(cap))));
}
-static XEN gxg_glEnableClientState(XEN cap)
+static Xen gxg_glEnableClientState(Xen cap)
{
#define H_glEnableClientState "void glEnableClientState(GLenum cap)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(cap), cap, 1, "glEnableClientState", "GLenum");
- glEnableClientState(XEN_TO_C_GLenum(cap));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(cap), cap, 1, "glEnableClientState", "GLenum");
+ glEnableClientState(Xen_to_C_GLenum(cap));
+ return(Xen_false);
}
-static XEN gxg_glDisableClientState(XEN cap)
+static Xen gxg_glDisableClientState(Xen cap)
{
#define H_glDisableClientState "void glDisableClientState(GLenum cap)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(cap), cap, 1, "glDisableClientState", "GLenum");
- glDisableClientState(XEN_TO_C_GLenum(cap));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(cap), cap, 1, "glDisableClientState", "GLenum");
+ glDisableClientState(Xen_to_C_GLenum(cap));
+ return(Xen_false);
}
-static XEN gxg_glGetBooleanv(XEN pname, XEN params)
+static Xen gxg_glGetBooleanv(Xen pname, Xen params)
{
#define H_glGetBooleanv "void glGetBooleanv(GLenum pname, GLboolean* [params])"
GLboolean ref_params[16];
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glGetBooleanv", "GLenum");
- glGetBooleanv(XEN_TO_C_GLenum(pname), ref_params);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glGetBooleanv", "GLenum");
+ glGetBooleanv(Xen_to_C_GLenum(pname), ref_params);
{
- XEN result;
+ Xen result;
int i, vals;
- vals = how_many_vals(XEN_TO_C_GLenum(pname));
- result = XEN_EMPTY_LIST;
+ vals = how_many_vals(Xen_to_C_GLenum(pname));
+ result = Xen_empty_list;
for (i = 0; i < vals; i++)
- result = XEN_CONS(C_TO_XEN_GLboolean(ref_params[i]), result);
+ result = Xen_cons(C_to_Xen_GLboolean(ref_params[i]), result);
return(result);
}
}
-static XEN gxg_glGetDoublev(XEN pname, XEN params)
+static Xen gxg_glGetDoublev(Xen pname, Xen params)
{
#define H_glGetDoublev "void glGetDoublev(GLenum pname, GLdouble* [params])"
GLdouble ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glGetDoublev", "GLenum");
- glGetDoublev(XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLdouble(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glGetDoublev", "GLenum");
+ glGetDoublev(Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLdouble(ref_params[0])));
}
-static XEN gxg_glGetFloatv(XEN pname, XEN params)
+static Xen gxg_glGetFloatv(Xen pname, Xen params)
{
#define H_glGetFloatv "void glGetFloatv(GLenum pname, GLfloat* [params])"
GLfloat ref_params[16];
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glGetFloatv", "GLenum");
- glGetFloatv(XEN_TO_C_GLenum(pname), ref_params);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glGetFloatv", "GLenum");
+ glGetFloatv(Xen_to_C_GLenum(pname), ref_params);
{
- XEN result;
+ Xen result;
int i, vals;
- vals = how_many_vals(XEN_TO_C_GLenum(pname));
- result = XEN_EMPTY_LIST;
+ vals = how_many_vals(Xen_to_C_GLenum(pname));
+ result = Xen_empty_list;
for (i = 0; i < vals; i++)
- result = XEN_CONS(C_TO_XEN_GLfloat(ref_params[i]), result);
+ result = Xen_cons(C_to_Xen_GLfloat(ref_params[i]), result);
return(result);
}
}
-static XEN gxg_glGetIntegerv(XEN pname, XEN params)
+static Xen gxg_glGetIntegerv(Xen pname, Xen params)
{
#define H_glGetIntegerv "void glGetIntegerv(GLenum pname, GLint* [params])"
GLint ref_params[16];
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glGetIntegerv", "GLenum");
- glGetIntegerv(XEN_TO_C_GLenum(pname), ref_params);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glGetIntegerv", "GLenum");
+ glGetIntegerv(Xen_to_C_GLenum(pname), ref_params);
{
- XEN result;
+ Xen result;
int i, vals;
- vals = how_many_vals(XEN_TO_C_GLenum(pname));
- result = XEN_EMPTY_LIST;
+ vals = how_many_vals(Xen_to_C_GLenum(pname));
+ result = Xen_empty_list;
for (i = 0; i < vals; i++)
- result = XEN_CONS(C_TO_XEN_GLint(ref_params[i]), result);
+ result = Xen_cons(C_to_Xen_GLint(ref_params[i]), result);
return(result);
}
}
-static XEN gxg_glPushAttrib(XEN mask)
+static Xen gxg_glPushAttrib(Xen mask)
{
#define H_glPushAttrib "void glPushAttrib(GLbitfield mask)"
- XEN_ASSERT_TYPE(XEN_GLbitfield_P(mask), mask, 1, "glPushAttrib", "GLbitfield");
- glPushAttrib(XEN_TO_C_GLbitfield(mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLbitfield(mask), mask, 1, "glPushAttrib", "GLbitfield");
+ glPushAttrib(Xen_to_C_GLbitfield(mask));
+ return(Xen_false);
}
-static XEN gxg_glPopAttrib(void)
+static Xen gxg_glPopAttrib(void)
{
#define H_glPopAttrib "void glPopAttrib( void)"
glPopAttrib();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glPushClientAttrib(XEN mask)
+static Xen gxg_glPushClientAttrib(Xen mask)
{
#define H_glPushClientAttrib "void glPushClientAttrib(GLbitfield mask)"
- XEN_ASSERT_TYPE(XEN_GLbitfield_P(mask), mask, 1, "glPushClientAttrib", "GLbitfield");
- glPushClientAttrib(XEN_TO_C_GLbitfield(mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLbitfield(mask), mask, 1, "glPushClientAttrib", "GLbitfield");
+ glPushClientAttrib(Xen_to_C_GLbitfield(mask));
+ return(Xen_false);
}
-static XEN gxg_glPopClientAttrib(void)
+static Xen gxg_glPopClientAttrib(void)
{
#define H_glPopClientAttrib "void glPopClientAttrib( void)"
glPopClientAttrib();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glRenderMode(XEN mode)
+static Xen gxg_glRenderMode(Xen mode)
{
#define H_glRenderMode "GLint glRenderMode(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glRenderMode", "GLenum");
- return(C_TO_XEN_GLint(glRenderMode(XEN_TO_C_GLenum(mode))));
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glRenderMode", "GLenum");
+ return(C_to_Xen_GLint(glRenderMode(Xen_to_C_GLenum(mode))));
}
-static XEN gxg_glGetError(void)
+static Xen gxg_glGetError(void)
{
#define H_glGetError "GLenum glGetError( void)"
- return(C_TO_XEN_GLenum(glGetError()));
+ return(C_to_Xen_GLenum(glGetError()));
}
-static XEN gxg_glGetString(XEN name)
+static Xen gxg_glGetString(Xen name)
{
#define H_glGetString "constchar* glGetString(GLenum name)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(name), name, 1, "glGetString", "GLenum");
- return(C_TO_XEN_constchar_(glGetString(XEN_TO_C_GLenum(name))));
+ Xen_check_type(Xen_is_GLenum(name), name, 1, "glGetString", "GLenum");
+ return(C_to_Xen_constchar_(glGetString(Xen_to_C_GLenum(name))));
}
-static XEN gxg_glFinish(void)
+static Xen gxg_glFinish(void)
{
#define H_glFinish "void glFinish( void)"
glFinish();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glFlush(void)
+static Xen gxg_glFlush(void)
{
#define H_glFlush "void glFlush( void)"
glFlush();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glHint(XEN target, XEN mode)
+static Xen gxg_glHint(Xen target, Xen mode)
{
#define H_glHint "void glHint(GLenum target, GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glHint", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 2, "glHint", "GLenum");
- glHint(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glHint", "GLenum");
+ Xen_check_type(Xen_is_GLenum(mode), mode, 2, "glHint", "GLenum");
+ glHint(Xen_to_C_GLenum(target), Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glClearDepth(XEN depth)
+static Xen gxg_glClearDepth(Xen depth)
{
#define H_glClearDepth "void glClearDepth(GLclampd depth)"
- XEN_ASSERT_TYPE(XEN_GLclampd_P(depth), depth, 1, "glClearDepth", "GLclampd");
- glClearDepth(XEN_TO_C_GLclampd(depth));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLclampd(depth), depth, 1, "glClearDepth", "GLclampd");
+ glClearDepth(Xen_to_C_GLclampd(depth));
+ return(Xen_false);
}
-static XEN gxg_glDepthFunc(XEN func)
+static Xen gxg_glDepthFunc(Xen func)
{
#define H_glDepthFunc "void glDepthFunc(GLenum func)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(func), func, 1, "glDepthFunc", "GLenum");
- glDepthFunc(XEN_TO_C_GLenum(func));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(func), func, 1, "glDepthFunc", "GLenum");
+ glDepthFunc(Xen_to_C_GLenum(func));
+ return(Xen_false);
}
-static XEN gxg_glDepthMask(XEN flag)
+static Xen gxg_glDepthMask(Xen flag)
{
#define H_glDepthMask "void glDepthMask(GLboolean flag)"
- XEN_ASSERT_TYPE(XEN_GLboolean_P(flag), flag, 1, "glDepthMask", "GLboolean");
- glDepthMask(XEN_TO_C_GLboolean(flag));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLboolean(flag), flag, 1, "glDepthMask", "GLboolean");
+ glDepthMask(Xen_to_C_GLboolean(flag));
+ return(Xen_false);
}
-static XEN gxg_glDepthRange(XEN near_val, XEN far_val)
+static Xen gxg_glDepthRange(Xen near_val, Xen far_val)
{
#define H_glDepthRange "void glDepthRange(GLclampd near_val, GLclampd far_val)"
- XEN_ASSERT_TYPE(XEN_GLclampd_P(near_val), near_val, 1, "glDepthRange", "GLclampd");
- XEN_ASSERT_TYPE(XEN_GLclampd_P(far_val), far_val, 2, "glDepthRange", "GLclampd");
- glDepthRange(XEN_TO_C_GLclampd(near_val), XEN_TO_C_GLclampd(far_val));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLclampd(near_val), near_val, 1, "glDepthRange", "GLclampd");
+ Xen_check_type(Xen_is_GLclampd(far_val), far_val, 2, "glDepthRange", "GLclampd");
+ glDepthRange(Xen_to_C_GLclampd(near_val), Xen_to_C_GLclampd(far_val));
+ return(Xen_false);
}
-static XEN gxg_glClearAccum(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glClearAccum(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glClearAccum "void glClearAccum(GLfloat red, GLfloat green, GLfloat blue, GLfloat alpha)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(red), red, 1, "glClearAccum", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(green), green, 2, "glClearAccum", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(blue), blue, 3, "glClearAccum", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(alpha), alpha, 4, "glClearAccum", "GLfloat");
- glClearAccum(XEN_TO_C_GLfloat(red), XEN_TO_C_GLfloat(green), XEN_TO_C_GLfloat(blue), XEN_TO_C_GLfloat(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(red), red, 1, "glClearAccum", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(green), green, 2, "glClearAccum", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(blue), blue, 3, "glClearAccum", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(alpha), alpha, 4, "glClearAccum", "GLfloat");
+ glClearAccum(Xen_to_C_GLfloat(red), Xen_to_C_GLfloat(green), Xen_to_C_GLfloat(blue), Xen_to_C_GLfloat(alpha));
+ return(Xen_false);
}
-static XEN gxg_glAccum(XEN op, XEN value)
+static Xen gxg_glAccum(Xen op, Xen value)
{
#define H_glAccum "void glAccum(GLenum op, GLfloat value)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(op), op, 1, "glAccum", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(value), value, 2, "glAccum", "GLfloat");
- glAccum(XEN_TO_C_GLenum(op), XEN_TO_C_GLfloat(value));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(op), op, 1, "glAccum", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(value), value, 2, "glAccum", "GLfloat");
+ glAccum(Xen_to_C_GLenum(op), Xen_to_C_GLfloat(value));
+ return(Xen_false);
}
-static XEN gxg_glMatrixMode(XEN mode)
+static Xen gxg_glMatrixMode(Xen mode)
{
#define H_glMatrixMode "void glMatrixMode(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glMatrixMode", "GLenum");
- glMatrixMode(XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glMatrixMode", "GLenum");
+ glMatrixMode(Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glOrtho(XEN left, XEN right, XEN bottom, XEN top, XEN near_val, XEN far_val)
+static Xen gxg_glOrtho(Xen left, Xen right, Xen bottom, Xen top, Xen near_val, Xen far_val)
{
#define H_glOrtho "void glOrtho(GLdouble left, GLdouble right, GLdouble bottom, GLdouble top, GLdouble near_val, \
GLdouble far_val)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(left), left, 1, "glOrtho", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(right), right, 2, "glOrtho", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(bottom), bottom, 3, "glOrtho", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(top), top, 4, "glOrtho", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(near_val), near_val, 5, "glOrtho", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(far_val), far_val, 6, "glOrtho", "GLdouble");
- glOrtho(XEN_TO_C_GLdouble(left), XEN_TO_C_GLdouble(right), XEN_TO_C_GLdouble(bottom), XEN_TO_C_GLdouble(top), XEN_TO_C_GLdouble(near_val),
- XEN_TO_C_GLdouble(far_val));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(left), left, 1, "glOrtho", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(right), right, 2, "glOrtho", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(bottom), bottom, 3, "glOrtho", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(top), top, 4, "glOrtho", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(near_val), near_val, 5, "glOrtho", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(far_val), far_val, 6, "glOrtho", "GLdouble");
+ glOrtho(Xen_to_C_GLdouble(left), Xen_to_C_GLdouble(right), Xen_to_C_GLdouble(bottom), Xen_to_C_GLdouble(top), Xen_to_C_GLdouble(near_val),
+ Xen_to_C_GLdouble(far_val));
+ return(Xen_false);
}
-static XEN gxg_glFrustum(XEN left, XEN right, XEN bottom, XEN top, XEN near_val, XEN far_val)
+static Xen gxg_glFrustum(Xen left, Xen right, Xen bottom, Xen top, Xen near_val, Xen far_val)
{
#define H_glFrustum "void glFrustum(GLdouble left, GLdouble right, GLdouble bottom, GLdouble top, GLdouble near_val, \
GLdouble far_val)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(left), left, 1, "glFrustum", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(right), right, 2, "glFrustum", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(bottom), bottom, 3, "glFrustum", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(top), top, 4, "glFrustum", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(near_val), near_val, 5, "glFrustum", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(far_val), far_val, 6, "glFrustum", "GLdouble");
- glFrustum(XEN_TO_C_GLdouble(left), XEN_TO_C_GLdouble(right), XEN_TO_C_GLdouble(bottom), XEN_TO_C_GLdouble(top), XEN_TO_C_GLdouble(near_val),
- XEN_TO_C_GLdouble(far_val));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(left), left, 1, "glFrustum", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(right), right, 2, "glFrustum", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(bottom), bottom, 3, "glFrustum", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(top), top, 4, "glFrustum", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(near_val), near_val, 5, "glFrustum", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(far_val), far_val, 6, "glFrustum", "GLdouble");
+ glFrustum(Xen_to_C_GLdouble(left), Xen_to_C_GLdouble(right), Xen_to_C_GLdouble(bottom), Xen_to_C_GLdouble(top), Xen_to_C_GLdouble(near_val),
+ Xen_to_C_GLdouble(far_val));
+ return(Xen_false);
}
-static XEN gxg_glViewport(XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_glViewport(Xen x, Xen y, Xen width, Xen height)
{
#define H_glViewport "void glViewport(GLint x, GLint y, GLsizei width, GLsizei height)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glViewport", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glViewport", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "glViewport", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "glViewport", "GLsizei");
- glViewport(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glViewport", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glViewport", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "glViewport", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "glViewport", "GLsizei");
+ glViewport(Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height));
+ return(Xen_false);
}
-static XEN gxg_glPushMatrix(void)
+static Xen gxg_glPushMatrix(void)
{
#define H_glPushMatrix "void glPushMatrix( void)"
glPushMatrix();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glPopMatrix(void)
+static Xen gxg_glPopMatrix(void)
{
#define H_glPopMatrix "void glPopMatrix( void)"
glPopMatrix();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glLoadIdentity(void)
+static Xen gxg_glLoadIdentity(void)
{
#define H_glLoadIdentity "void glLoadIdentity( void)"
glLoadIdentity();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glLoadMatrixd(XEN m)
+static Xen gxg_glLoadMatrixd(Xen m)
{
#define H_glLoadMatrixd "void glLoadMatrixd(GLdouble* m)"
- XEN_ASSERT_TYPE(XEN_GLdouble__P(m), m, 1, "glLoadMatrixd", "GLdouble*");
- glLoadMatrixd(XEN_TO_C_GLdouble_(m));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble_(m), m, 1, "glLoadMatrixd", "GLdouble*");
+ glLoadMatrixd(Xen_to_C_GLdouble_(m));
+ return(Xen_false);
}
-static XEN gxg_glLoadMatrixf(XEN m)
+static Xen gxg_glLoadMatrixf(Xen m)
{
#define H_glLoadMatrixf "void glLoadMatrixf(GLfloat* m)"
- XEN_ASSERT_TYPE(XEN_GLfloat__P(m), m, 1, "glLoadMatrixf", "GLfloat*");
- glLoadMatrixf(XEN_TO_C_GLfloat_(m));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat_(m), m, 1, "glLoadMatrixf", "GLfloat*");
+ glLoadMatrixf(Xen_to_C_GLfloat_(m));
+ return(Xen_false);
}
-static XEN gxg_glMultMatrixd(XEN m)
+static Xen gxg_glMultMatrixd(Xen m)
{
#define H_glMultMatrixd "void glMultMatrixd(GLdouble* m)"
- XEN_ASSERT_TYPE(XEN_GLdouble__P(m), m, 1, "glMultMatrixd", "GLdouble*");
- glMultMatrixd(XEN_TO_C_GLdouble_(m));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble_(m), m, 1, "glMultMatrixd", "GLdouble*");
+ glMultMatrixd(Xen_to_C_GLdouble_(m));
+ return(Xen_false);
}
-static XEN gxg_glMultMatrixf(XEN m)
+static Xen gxg_glMultMatrixf(Xen m)
{
#define H_glMultMatrixf "void glMultMatrixf(GLfloat* m)"
- XEN_ASSERT_TYPE(XEN_GLfloat__P(m), m, 1, "glMultMatrixf", "GLfloat*");
- glMultMatrixf(XEN_TO_C_GLfloat_(m));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat_(m), m, 1, "glMultMatrixf", "GLfloat*");
+ glMultMatrixf(Xen_to_C_GLfloat_(m));
+ return(Xen_false);
}
-static XEN gxg_glRotated(XEN angle, XEN x, XEN y, XEN z)
+static Xen gxg_glRotated(Xen angle, Xen x, Xen y, Xen z)
{
#define H_glRotated "void glRotated(GLdouble angle, GLdouble x, GLdouble y, GLdouble z)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(angle), angle, 1, "glRotated", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 2, "glRotated", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 3, "glRotated", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(z), z, 4, "glRotated", "GLdouble");
- glRotated(XEN_TO_C_GLdouble(angle), XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y), XEN_TO_C_GLdouble(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(angle), angle, 1, "glRotated", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(x), x, 2, "glRotated", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 3, "glRotated", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(z), z, 4, "glRotated", "GLdouble");
+ glRotated(Xen_to_C_GLdouble(angle), Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y), Xen_to_C_GLdouble(z));
+ return(Xen_false);
}
-static XEN gxg_glRotatef(XEN angle, XEN x, XEN y, XEN z)
+static Xen gxg_glRotatef(Xen angle, Xen x, Xen y, Xen z)
{
#define H_glRotatef "void glRotatef(GLfloat angle, GLfloat x, GLfloat y, GLfloat z)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(angle), angle, 1, "glRotatef", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 2, "glRotatef", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 3, "glRotatef", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(z), z, 4, "glRotatef", "GLfloat");
- glRotatef(XEN_TO_C_GLfloat(angle), XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y), XEN_TO_C_GLfloat(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(angle), angle, 1, "glRotatef", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(x), x, 2, "glRotatef", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 3, "glRotatef", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(z), z, 4, "glRotatef", "GLfloat");
+ glRotatef(Xen_to_C_GLfloat(angle), Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y), Xen_to_C_GLfloat(z));
+ return(Xen_false);
}
-static XEN gxg_glScaled(XEN x, XEN y, XEN z)
+static Xen gxg_glScaled(Xen x, Xen y, Xen z)
{
#define H_glScaled "void glScaled(GLdouble x, GLdouble y, GLdouble z)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "glScaled", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "glScaled", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(z), z, 3, "glScaled", "GLdouble");
- glScaled(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y), XEN_TO_C_GLdouble(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "glScaled", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "glScaled", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(z), z, 3, "glScaled", "GLdouble");
+ glScaled(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y), Xen_to_C_GLdouble(z));
+ return(Xen_false);
}
-static XEN gxg_glScalef(XEN x, XEN y, XEN z)
+static Xen gxg_glScalef(Xen x, Xen y, Xen z)
{
#define H_glScalef "void glScalef(GLfloat x, GLfloat y, GLfloat z)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 1, "glScalef", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 2, "glScalef", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(z), z, 3, "glScalef", "GLfloat");
- glScalef(XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y), XEN_TO_C_GLfloat(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x), x, 1, "glScalef", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 2, "glScalef", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(z), z, 3, "glScalef", "GLfloat");
+ glScalef(Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y), Xen_to_C_GLfloat(z));
+ return(Xen_false);
}
-static XEN gxg_glTranslated(XEN x, XEN y, XEN z)
+static Xen gxg_glTranslated(Xen x, Xen y, Xen z)
{
#define H_glTranslated "void glTranslated(GLdouble x, GLdouble y, GLdouble z)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "glTranslated", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "glTranslated", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(z), z, 3, "glTranslated", "GLdouble");
- glTranslated(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y), XEN_TO_C_GLdouble(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "glTranslated", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "glTranslated", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(z), z, 3, "glTranslated", "GLdouble");
+ glTranslated(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y), Xen_to_C_GLdouble(z));
+ return(Xen_false);
}
-static XEN gxg_glTranslatef(XEN x, XEN y, XEN z)
+static Xen gxg_glTranslatef(Xen x, Xen y, Xen z)
{
#define H_glTranslatef "void glTranslatef(GLfloat x, GLfloat y, GLfloat z)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 1, "glTranslatef", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 2, "glTranslatef", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(z), z, 3, "glTranslatef", "GLfloat");
- glTranslatef(XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y), XEN_TO_C_GLfloat(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x), x, 1, "glTranslatef", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 2, "glTranslatef", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(z), z, 3, "glTranslatef", "GLfloat");
+ glTranslatef(Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y), Xen_to_C_GLfloat(z));
+ return(Xen_false);
}
-static XEN gxg_glIsList(XEN list)
+static Xen gxg_glIsList(Xen list)
{
#define H_glIsList "GLboolean glIsList(GLuint list)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(list), list, 1, "glIsList", "GLuint");
- return(C_TO_XEN_GLboolean(glIsList(XEN_TO_C_GLuint(list))));
+ Xen_check_type(Xen_is_GLuint(list), list, 1, "glIsList", "GLuint");
+ return(C_to_Xen_GLboolean(glIsList(Xen_to_C_GLuint(list))));
}
-static XEN gxg_glDeleteLists(XEN list, XEN range)
+static Xen gxg_glDeleteLists(Xen list, Xen range)
{
#define H_glDeleteLists "void glDeleteLists(GLuint list, GLsizei range)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(list), list, 1, "glDeleteLists", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(range), range, 2, "glDeleteLists", "GLsizei");
- glDeleteLists(XEN_TO_C_GLuint(list), XEN_TO_C_GLsizei(range));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(list), list, 1, "glDeleteLists", "GLuint");
+ Xen_check_type(Xen_is_GLsizei(range), range, 2, "glDeleteLists", "GLsizei");
+ glDeleteLists(Xen_to_C_GLuint(list), Xen_to_C_GLsizei(range));
+ return(Xen_false);
}
-static XEN gxg_glGenLists(XEN range)
+static Xen gxg_glGenLists(Xen range)
{
#define H_glGenLists "GLuint glGenLists(GLsizei range)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(range), range, 1, "glGenLists", "GLsizei");
- return(C_TO_XEN_GLuint(glGenLists(XEN_TO_C_GLsizei(range))));
+ Xen_check_type(Xen_is_GLsizei(range), range, 1, "glGenLists", "GLsizei");
+ return(C_to_Xen_GLuint(glGenLists(Xen_to_C_GLsizei(range))));
}
-static XEN gxg_glNewList(XEN list, XEN mode)
+static Xen gxg_glNewList(Xen list, Xen mode)
{
#define H_glNewList "void glNewList(GLuint list, GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(list), list, 1, "glNewList", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 2, "glNewList", "GLenum");
- glNewList(XEN_TO_C_GLuint(list), XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(list), list, 1, "glNewList", "GLuint");
+ Xen_check_type(Xen_is_GLenum(mode), mode, 2, "glNewList", "GLenum");
+ glNewList(Xen_to_C_GLuint(list), Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glEndList(void)
+static Xen gxg_glEndList(void)
{
#define H_glEndList "void glEndList( void)"
glEndList();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glCallList(XEN list)
+static Xen gxg_glCallList(Xen list)
{
#define H_glCallList "void glCallList(GLuint list)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(list), list, 1, "glCallList", "GLuint");
- glCallList(XEN_TO_C_GLuint(list));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(list), list, 1, "glCallList", "GLuint");
+ glCallList(Xen_to_C_GLuint(list));
+ return(Xen_false);
}
-static XEN gxg_glCallLists(XEN n, XEN type, XEN lists)
+static Xen gxg_glCallLists(Xen n, Xen type, Xen lists)
{
#define H_glCallLists "void glCallLists(GLsizei n, GLenum type, GLvoid* lists)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(n), n, 1, "glCallLists", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 2, "glCallLists", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(lists), lists, 3, "glCallLists", "GLvoid*");
- glCallLists(XEN_TO_C_GLsizei(n), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(lists));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLsizei(n), n, 1, "glCallLists", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(type), type, 2, "glCallLists", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(lists), lists, 3, "glCallLists", "GLvoid*");
+ glCallLists(Xen_to_C_GLsizei(n), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(lists));
+ return(Xen_false);
}
-static XEN gxg_glListBase(XEN base)
+static Xen gxg_glListBase(Xen base)
{
#define H_glListBase "void glListBase(GLuint base)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(base), base, 1, "glListBase", "GLuint");
- glListBase(XEN_TO_C_GLuint(base));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(base), base, 1, "glListBase", "GLuint");
+ glListBase(Xen_to_C_GLuint(base));
+ return(Xen_false);
}
-static XEN gxg_glBegin(XEN mode)
+static Xen gxg_glBegin(Xen mode)
{
#define H_glBegin "void glBegin(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glBegin", "GLenum");
- glBegin(XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glBegin", "GLenum");
+ glBegin(Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glEnd(void)
+static Xen gxg_glEnd(void)
{
#define H_glEnd "void glEnd( void)"
glEnd();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glVertex2d(XEN x, XEN y)
+static Xen gxg_glVertex2d(Xen x, Xen y)
{
#define H_glVertex2d "void glVertex2d(GLdouble x, GLdouble y)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "glVertex2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "glVertex2d", "GLdouble");
- glVertex2d(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "glVertex2d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "glVertex2d", "GLdouble");
+ glVertex2d(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y));
+ return(Xen_false);
}
-static XEN gxg_glVertex2f(XEN x, XEN y)
+static Xen gxg_glVertex2f(Xen x, Xen y)
{
#define H_glVertex2f "void glVertex2f(GLfloat x, GLfloat y)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 1, "glVertex2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 2, "glVertex2f", "GLfloat");
- glVertex2f(XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x), x, 1, "glVertex2f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 2, "glVertex2f", "GLfloat");
+ glVertex2f(Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y));
+ return(Xen_false);
}
-static XEN gxg_glVertex2i(XEN x, XEN y)
+static Xen gxg_glVertex2i(Xen x, Xen y)
{
#define H_glVertex2i "void glVertex2i(GLint x, GLint y)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glVertex2i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glVertex2i", "GLint");
- glVertex2i(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glVertex2i", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glVertex2i", "GLint");
+ glVertex2i(Xen_to_C_GLint(x), Xen_to_C_GLint(y));
+ return(Xen_false);
}
-static XEN gxg_glVertex2s(XEN x, XEN y)
+static Xen gxg_glVertex2s(Xen x, Xen y)
{
#define H_glVertex2s "void glVertex2s(GLshort x, GLshort y)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(x), x, 1, "glVertex2s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(y), y, 2, "glVertex2s", "GLshort");
- glVertex2s(XEN_TO_C_GLshort(x), XEN_TO_C_GLshort(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(x), x, 1, "glVertex2s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(y), y, 2, "glVertex2s", "GLshort");
+ glVertex2s(Xen_to_C_GLshort(x), Xen_to_C_GLshort(y));
+ return(Xen_false);
}
-static XEN gxg_glVertex3d(XEN x, XEN y, XEN z)
+static Xen gxg_glVertex3d(Xen x, Xen y, Xen z)
{
#define H_glVertex3d "void glVertex3d(GLdouble x, GLdouble y, GLdouble z)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "glVertex3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "glVertex3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(z), z, 3, "glVertex3d", "GLdouble");
- glVertex3d(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y), XEN_TO_C_GLdouble(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "glVertex3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "glVertex3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(z), z, 3, "glVertex3d", "GLdouble");
+ glVertex3d(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y), Xen_to_C_GLdouble(z));
+ return(Xen_false);
}
-static XEN gxg_glVertex3f(XEN x, XEN y, XEN z)
+static Xen gxg_glVertex3f(Xen x, Xen y, Xen z)
{
#define H_glVertex3f "void glVertex3f(GLfloat x, GLfloat y, GLfloat z)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 1, "glVertex3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 2, "glVertex3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(z), z, 3, "glVertex3f", "GLfloat");
- glVertex3f(XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y), XEN_TO_C_GLfloat(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x), x, 1, "glVertex3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 2, "glVertex3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(z), z, 3, "glVertex3f", "GLfloat");
+ glVertex3f(Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y), Xen_to_C_GLfloat(z));
+ return(Xen_false);
}
-static XEN gxg_glVertex3i(XEN x, XEN y, XEN z)
+static Xen gxg_glVertex3i(Xen x, Xen y, Xen z)
{
#define H_glVertex3i "void glVertex3i(GLint x, GLint y, GLint z)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glVertex3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glVertex3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(z), z, 3, "glVertex3i", "GLint");
- glVertex3i(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLint(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glVertex3i", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glVertex3i", "GLint");
+ Xen_check_type(Xen_is_GLint(z), z, 3, "glVertex3i", "GLint");
+ glVertex3i(Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLint(z));
+ return(Xen_false);
}
-static XEN gxg_glVertex3s(XEN x, XEN y, XEN z)
+static Xen gxg_glVertex3s(Xen x, Xen y, Xen z)
{
#define H_glVertex3s "void glVertex3s(GLshort x, GLshort y, GLshort z)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(x), x, 1, "glVertex3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(y), y, 2, "glVertex3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(z), z, 3, "glVertex3s", "GLshort");
- glVertex3s(XEN_TO_C_GLshort(x), XEN_TO_C_GLshort(y), XEN_TO_C_GLshort(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(x), x, 1, "glVertex3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(y), y, 2, "glVertex3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(z), z, 3, "glVertex3s", "GLshort");
+ glVertex3s(Xen_to_C_GLshort(x), Xen_to_C_GLshort(y), Xen_to_C_GLshort(z));
+ return(Xen_false);
}
-static XEN gxg_glVertex4d(XEN x, XEN y, XEN z, XEN w)
+static Xen gxg_glVertex4d(Xen x, Xen y, Xen z, Xen w)
{
#define H_glVertex4d "void glVertex4d(GLdouble x, GLdouble y, GLdouble z, GLdouble w)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "glVertex4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "glVertex4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(z), z, 3, "glVertex4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(w), w, 4, "glVertex4d", "GLdouble");
- glVertex4d(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y), XEN_TO_C_GLdouble(z), XEN_TO_C_GLdouble(w));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "glVertex4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "glVertex4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(z), z, 3, "glVertex4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(w), w, 4, "glVertex4d", "GLdouble");
+ glVertex4d(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y), Xen_to_C_GLdouble(z), Xen_to_C_GLdouble(w));
+ return(Xen_false);
}
-static XEN gxg_glVertex4f(XEN x, XEN y, XEN z, XEN w)
+static Xen gxg_glVertex4f(Xen x, Xen y, Xen z, Xen w)
{
#define H_glVertex4f "void glVertex4f(GLfloat x, GLfloat y, GLfloat z, GLfloat w)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 1, "glVertex4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 2, "glVertex4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(z), z, 3, "glVertex4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(w), w, 4, "glVertex4f", "GLfloat");
- glVertex4f(XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y), XEN_TO_C_GLfloat(z), XEN_TO_C_GLfloat(w));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x), x, 1, "glVertex4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 2, "glVertex4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(z), z, 3, "glVertex4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(w), w, 4, "glVertex4f", "GLfloat");
+ glVertex4f(Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y), Xen_to_C_GLfloat(z), Xen_to_C_GLfloat(w));
+ return(Xen_false);
}
-static XEN gxg_glVertex4i(XEN x, XEN y, XEN z, XEN w)
+static Xen gxg_glVertex4i(Xen x, Xen y, Xen z, Xen w)
{
#define H_glVertex4i "void glVertex4i(GLint x, GLint y, GLint z, GLint w)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glVertex4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glVertex4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(z), z, 3, "glVertex4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(w), w, 4, "glVertex4i", "GLint");
- glVertex4i(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLint(z), XEN_TO_C_GLint(w));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glVertex4i", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glVertex4i", "GLint");
+ Xen_check_type(Xen_is_GLint(z), z, 3, "glVertex4i", "GLint");
+ Xen_check_type(Xen_is_GLint(w), w, 4, "glVertex4i", "GLint");
+ glVertex4i(Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLint(z), Xen_to_C_GLint(w));
+ return(Xen_false);
}
-static XEN gxg_glVertex4s(XEN x, XEN y, XEN z, XEN w)
+static Xen gxg_glVertex4s(Xen x, Xen y, Xen z, Xen w)
{
#define H_glVertex4s "void glVertex4s(GLshort x, GLshort y, GLshort z, GLshort w)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(x), x, 1, "glVertex4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(y), y, 2, "glVertex4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(z), z, 3, "glVertex4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(w), w, 4, "glVertex4s", "GLshort");
- glVertex4s(XEN_TO_C_GLshort(x), XEN_TO_C_GLshort(y), XEN_TO_C_GLshort(z), XEN_TO_C_GLshort(w));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(x), x, 1, "glVertex4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(y), y, 2, "glVertex4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(z), z, 3, "glVertex4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(w), w, 4, "glVertex4s", "GLshort");
+ glVertex4s(Xen_to_C_GLshort(x), Xen_to_C_GLshort(y), Xen_to_C_GLshort(z), Xen_to_C_GLshort(w));
+ return(Xen_false);
}
-static XEN gxg_glNormal3b(XEN nx, XEN ny, XEN nz)
+static Xen gxg_glNormal3b(Xen nx, Xen ny, Xen nz)
{
#define H_glNormal3b "void glNormal3b(GLbyte nx, GLbyte ny, GLbyte nz)"
- XEN_ASSERT_TYPE(XEN_GLbyte_P(nx), nx, 1, "glNormal3b", "GLbyte");
- XEN_ASSERT_TYPE(XEN_GLbyte_P(ny), ny, 2, "glNormal3b", "GLbyte");
- XEN_ASSERT_TYPE(XEN_GLbyte_P(nz), nz, 3, "glNormal3b", "GLbyte");
- glNormal3b(XEN_TO_C_GLbyte(nx), XEN_TO_C_GLbyte(ny), XEN_TO_C_GLbyte(nz));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLbyte(nx), nx, 1, "glNormal3b", "GLbyte");
+ Xen_check_type(Xen_is_GLbyte(ny), ny, 2, "glNormal3b", "GLbyte");
+ Xen_check_type(Xen_is_GLbyte(nz), nz, 3, "glNormal3b", "GLbyte");
+ glNormal3b(Xen_to_C_GLbyte(nx), Xen_to_C_GLbyte(ny), Xen_to_C_GLbyte(nz));
+ return(Xen_false);
}
-static XEN gxg_glNormal3d(XEN nx, XEN ny, XEN nz)
+static Xen gxg_glNormal3d(Xen nx, Xen ny, Xen nz)
{
#define H_glNormal3d "void glNormal3d(GLdouble nx, GLdouble ny, GLdouble nz)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(nx), nx, 1, "glNormal3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(ny), ny, 2, "glNormal3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(nz), nz, 3, "glNormal3d", "GLdouble");
- glNormal3d(XEN_TO_C_GLdouble(nx), XEN_TO_C_GLdouble(ny), XEN_TO_C_GLdouble(nz));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(nx), nx, 1, "glNormal3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(ny), ny, 2, "glNormal3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(nz), nz, 3, "glNormal3d", "GLdouble");
+ glNormal3d(Xen_to_C_GLdouble(nx), Xen_to_C_GLdouble(ny), Xen_to_C_GLdouble(nz));
+ return(Xen_false);
}
-static XEN gxg_glNormal3f(XEN nx, XEN ny, XEN nz)
+static Xen gxg_glNormal3f(Xen nx, Xen ny, Xen nz)
{
#define H_glNormal3f "void glNormal3f(GLfloat nx, GLfloat ny, GLfloat nz)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(nx), nx, 1, "glNormal3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(ny), ny, 2, "glNormal3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(nz), nz, 3, "glNormal3f", "GLfloat");
- glNormal3f(XEN_TO_C_GLfloat(nx), XEN_TO_C_GLfloat(ny), XEN_TO_C_GLfloat(nz));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(nx), nx, 1, "glNormal3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(ny), ny, 2, "glNormal3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(nz), nz, 3, "glNormal3f", "GLfloat");
+ glNormal3f(Xen_to_C_GLfloat(nx), Xen_to_C_GLfloat(ny), Xen_to_C_GLfloat(nz));
+ return(Xen_false);
}
-static XEN gxg_glNormal3i(XEN nx, XEN ny, XEN nz)
+static Xen gxg_glNormal3i(Xen nx, Xen ny, Xen nz)
{
#define H_glNormal3i "void glNormal3i(GLint nx, GLint ny, GLint nz)"
- XEN_ASSERT_TYPE(XEN_GLint_P(nx), nx, 1, "glNormal3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(ny), ny, 2, "glNormal3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(nz), nz, 3, "glNormal3i", "GLint");
- glNormal3i(XEN_TO_C_GLint(nx), XEN_TO_C_GLint(ny), XEN_TO_C_GLint(nz));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(nx), nx, 1, "glNormal3i", "GLint");
+ Xen_check_type(Xen_is_GLint(ny), ny, 2, "glNormal3i", "GLint");
+ Xen_check_type(Xen_is_GLint(nz), nz, 3, "glNormal3i", "GLint");
+ glNormal3i(Xen_to_C_GLint(nx), Xen_to_C_GLint(ny), Xen_to_C_GLint(nz));
+ return(Xen_false);
}
-static XEN gxg_glNormal3s(XEN nx, XEN ny, XEN nz)
+static Xen gxg_glNormal3s(Xen nx, Xen ny, Xen nz)
{
#define H_glNormal3s "void glNormal3s(GLshort nx, GLshort ny, GLshort nz)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(nx), nx, 1, "glNormal3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(ny), ny, 2, "glNormal3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(nz), nz, 3, "glNormal3s", "GLshort");
- glNormal3s(XEN_TO_C_GLshort(nx), XEN_TO_C_GLshort(ny), XEN_TO_C_GLshort(nz));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(nx), nx, 1, "glNormal3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(ny), ny, 2, "glNormal3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(nz), nz, 3, "glNormal3s", "GLshort");
+ glNormal3s(Xen_to_C_GLshort(nx), Xen_to_C_GLshort(ny), Xen_to_C_GLshort(nz));
+ return(Xen_false);
}
-static XEN gxg_glIndexd(XEN c)
+static Xen gxg_glIndexd(Xen c)
{
#define H_glIndexd "void glIndexd(GLdouble c)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(c), c, 1, "glIndexd", "GLdouble");
- glIndexd(XEN_TO_C_GLdouble(c));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(c), c, 1, "glIndexd", "GLdouble");
+ glIndexd(Xen_to_C_GLdouble(c));
+ return(Xen_false);
}
-static XEN gxg_glIndexf(XEN c)
+static Xen gxg_glIndexf(Xen c)
{
#define H_glIndexf "void glIndexf(GLfloat c)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(c), c, 1, "glIndexf", "GLfloat");
- glIndexf(XEN_TO_C_GLfloat(c));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(c), c, 1, "glIndexf", "GLfloat");
+ glIndexf(Xen_to_C_GLfloat(c));
+ return(Xen_false);
}
-static XEN gxg_glIndexi(XEN c)
+static Xen gxg_glIndexi(Xen c)
{
#define H_glIndexi "void glIndexi(GLint c)"
- XEN_ASSERT_TYPE(XEN_GLint_P(c), c, 1, "glIndexi", "GLint");
- glIndexi(XEN_TO_C_GLint(c));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(c), c, 1, "glIndexi", "GLint");
+ glIndexi(Xen_to_C_GLint(c));
+ return(Xen_false);
}
-static XEN gxg_glIndexs(XEN c)
+static Xen gxg_glIndexs(Xen c)
{
#define H_glIndexs "void glIndexs(GLshort c)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(c), c, 1, "glIndexs", "GLshort");
- glIndexs(XEN_TO_C_GLshort(c));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(c), c, 1, "glIndexs", "GLshort");
+ glIndexs(Xen_to_C_GLshort(c));
+ return(Xen_false);
}
-static XEN gxg_glIndexub(XEN c)
+static Xen gxg_glIndexub(Xen c)
{
#define H_glIndexub "void glIndexub(GLubyte c)"
- XEN_ASSERT_TYPE(XEN_GLubyte_P(c), c, 1, "glIndexub", "GLubyte");
- glIndexub(XEN_TO_C_GLubyte(c));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLubyte(c), c, 1, "glIndexub", "GLubyte");
+ glIndexub(Xen_to_C_GLubyte(c));
+ return(Xen_false);
}
-static XEN gxg_glColor3b(XEN red, XEN green, XEN blue)
+static Xen gxg_glColor3b(Xen red, Xen green, Xen blue)
{
#define H_glColor3b "void glColor3b(GLbyte red, GLbyte green, GLbyte blue)"
- XEN_ASSERT_TYPE(XEN_GLbyte_P(red), red, 1, "glColor3b", "GLbyte");
- XEN_ASSERT_TYPE(XEN_GLbyte_P(green), green, 2, "glColor3b", "GLbyte");
- XEN_ASSERT_TYPE(XEN_GLbyte_P(blue), blue, 3, "glColor3b", "GLbyte");
- glColor3b(XEN_TO_C_GLbyte(red), XEN_TO_C_GLbyte(green), XEN_TO_C_GLbyte(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLbyte(red), red, 1, "glColor3b", "GLbyte");
+ Xen_check_type(Xen_is_GLbyte(green), green, 2, "glColor3b", "GLbyte");
+ Xen_check_type(Xen_is_GLbyte(blue), blue, 3, "glColor3b", "GLbyte");
+ glColor3b(Xen_to_C_GLbyte(red), Xen_to_C_GLbyte(green), Xen_to_C_GLbyte(blue));
+ return(Xen_false);
}
-static XEN gxg_glColor3d(XEN red, XEN green, XEN blue)
+static Xen gxg_glColor3d(Xen red, Xen green, Xen blue)
{
#define H_glColor3d "void glColor3d(GLdouble red, GLdouble green, GLdouble blue)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(red), red, 1, "glColor3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(green), green, 2, "glColor3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(blue), blue, 3, "glColor3d", "GLdouble");
- glColor3d(XEN_TO_C_GLdouble(red), XEN_TO_C_GLdouble(green), XEN_TO_C_GLdouble(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(red), red, 1, "glColor3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(green), green, 2, "glColor3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(blue), blue, 3, "glColor3d", "GLdouble");
+ glColor3d(Xen_to_C_GLdouble(red), Xen_to_C_GLdouble(green), Xen_to_C_GLdouble(blue));
+ return(Xen_false);
}
-static XEN gxg_glColor3f(XEN red, XEN green, XEN blue)
+static Xen gxg_glColor3f(Xen red, Xen green, Xen blue)
{
#define H_glColor3f "void glColor3f(GLfloat red, GLfloat green, GLfloat blue)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(red), red, 1, "glColor3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(green), green, 2, "glColor3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(blue), blue, 3, "glColor3f", "GLfloat");
- glColor3f(XEN_TO_C_GLfloat(red), XEN_TO_C_GLfloat(green), XEN_TO_C_GLfloat(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(red), red, 1, "glColor3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(green), green, 2, "glColor3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(blue), blue, 3, "glColor3f", "GLfloat");
+ glColor3f(Xen_to_C_GLfloat(red), Xen_to_C_GLfloat(green), Xen_to_C_GLfloat(blue));
+ return(Xen_false);
}
-static XEN gxg_glColor3i(XEN red, XEN green, XEN blue)
+static Xen gxg_glColor3i(Xen red, Xen green, Xen blue)
{
#define H_glColor3i "void glColor3i(GLint red, GLint green, GLint blue)"
- XEN_ASSERT_TYPE(XEN_GLint_P(red), red, 1, "glColor3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(green), green, 2, "glColor3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(blue), blue, 3, "glColor3i", "GLint");
- glColor3i(XEN_TO_C_GLint(red), XEN_TO_C_GLint(green), XEN_TO_C_GLint(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(red), red, 1, "glColor3i", "GLint");
+ Xen_check_type(Xen_is_GLint(green), green, 2, "glColor3i", "GLint");
+ Xen_check_type(Xen_is_GLint(blue), blue, 3, "glColor3i", "GLint");
+ glColor3i(Xen_to_C_GLint(red), Xen_to_C_GLint(green), Xen_to_C_GLint(blue));
+ return(Xen_false);
}
-static XEN gxg_glColor3s(XEN red, XEN green, XEN blue)
+static Xen gxg_glColor3s(Xen red, Xen green, Xen blue)
{
#define H_glColor3s "void glColor3s(GLshort red, GLshort green, GLshort blue)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(red), red, 1, "glColor3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(green), green, 2, "glColor3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(blue), blue, 3, "glColor3s", "GLshort");
- glColor3s(XEN_TO_C_GLshort(red), XEN_TO_C_GLshort(green), XEN_TO_C_GLshort(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(red), red, 1, "glColor3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(green), green, 2, "glColor3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(blue), blue, 3, "glColor3s", "GLshort");
+ glColor3s(Xen_to_C_GLshort(red), Xen_to_C_GLshort(green), Xen_to_C_GLshort(blue));
+ return(Xen_false);
}
-static XEN gxg_glColor3ub(XEN red, XEN green, XEN blue)
+static Xen gxg_glColor3ub(Xen red, Xen green, Xen blue)
{
#define H_glColor3ub "void glColor3ub(GLubyte red, GLubyte green, GLubyte blue)"
- XEN_ASSERT_TYPE(XEN_GLubyte_P(red), red, 1, "glColor3ub", "GLubyte");
- XEN_ASSERT_TYPE(XEN_GLubyte_P(green), green, 2, "glColor3ub", "GLubyte");
- XEN_ASSERT_TYPE(XEN_GLubyte_P(blue), blue, 3, "glColor3ub", "GLubyte");
- glColor3ub(XEN_TO_C_GLubyte(red), XEN_TO_C_GLubyte(green), XEN_TO_C_GLubyte(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLubyte(red), red, 1, "glColor3ub", "GLubyte");
+ Xen_check_type(Xen_is_GLubyte(green), green, 2, "glColor3ub", "GLubyte");
+ Xen_check_type(Xen_is_GLubyte(blue), blue, 3, "glColor3ub", "GLubyte");
+ glColor3ub(Xen_to_C_GLubyte(red), Xen_to_C_GLubyte(green), Xen_to_C_GLubyte(blue));
+ return(Xen_false);
}
-static XEN gxg_glColor3ui(XEN red, XEN green, XEN blue)
+static Xen gxg_glColor3ui(Xen red, Xen green, Xen blue)
{
#define H_glColor3ui "void glColor3ui(GLuint red, GLuint green, GLuint blue)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(red), red, 1, "glColor3ui", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLuint_P(green), green, 2, "glColor3ui", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLuint_P(blue), blue, 3, "glColor3ui", "GLuint");
- glColor3ui(XEN_TO_C_GLuint(red), XEN_TO_C_GLuint(green), XEN_TO_C_GLuint(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(red), red, 1, "glColor3ui", "GLuint");
+ Xen_check_type(Xen_is_GLuint(green), green, 2, "glColor3ui", "GLuint");
+ Xen_check_type(Xen_is_GLuint(blue), blue, 3, "glColor3ui", "GLuint");
+ glColor3ui(Xen_to_C_GLuint(red), Xen_to_C_GLuint(green), Xen_to_C_GLuint(blue));
+ return(Xen_false);
}
-static XEN gxg_glColor3us(XEN red, XEN green, XEN blue)
+static Xen gxg_glColor3us(Xen red, Xen green, Xen blue)
{
#define H_glColor3us "void glColor3us(GLushort red, GLushort green, GLushort blue)"
- XEN_ASSERT_TYPE(XEN_GLushort_P(red), red, 1, "glColor3us", "GLushort");
- XEN_ASSERT_TYPE(XEN_GLushort_P(green), green, 2, "glColor3us", "GLushort");
- XEN_ASSERT_TYPE(XEN_GLushort_P(blue), blue, 3, "glColor3us", "GLushort");
- glColor3us(XEN_TO_C_GLushort(red), XEN_TO_C_GLushort(green), XEN_TO_C_GLushort(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLushort(red), red, 1, "glColor3us", "GLushort");
+ Xen_check_type(Xen_is_GLushort(green), green, 2, "glColor3us", "GLushort");
+ Xen_check_type(Xen_is_GLushort(blue), blue, 3, "glColor3us", "GLushort");
+ glColor3us(Xen_to_C_GLushort(red), Xen_to_C_GLushort(green), Xen_to_C_GLushort(blue));
+ return(Xen_false);
}
-static XEN gxg_glColor4b(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColor4b(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColor4b "void glColor4b(GLbyte red, GLbyte green, GLbyte blue, GLbyte alpha)"
- XEN_ASSERT_TYPE(XEN_GLbyte_P(red), red, 1, "glColor4b", "GLbyte");
- XEN_ASSERT_TYPE(XEN_GLbyte_P(green), green, 2, "glColor4b", "GLbyte");
- XEN_ASSERT_TYPE(XEN_GLbyte_P(blue), blue, 3, "glColor4b", "GLbyte");
- XEN_ASSERT_TYPE(XEN_GLbyte_P(alpha), alpha, 4, "glColor4b", "GLbyte");
- glColor4b(XEN_TO_C_GLbyte(red), XEN_TO_C_GLbyte(green), XEN_TO_C_GLbyte(blue), XEN_TO_C_GLbyte(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLbyte(red), red, 1, "glColor4b", "GLbyte");
+ Xen_check_type(Xen_is_GLbyte(green), green, 2, "glColor4b", "GLbyte");
+ Xen_check_type(Xen_is_GLbyte(blue), blue, 3, "glColor4b", "GLbyte");
+ Xen_check_type(Xen_is_GLbyte(alpha), alpha, 4, "glColor4b", "GLbyte");
+ glColor4b(Xen_to_C_GLbyte(red), Xen_to_C_GLbyte(green), Xen_to_C_GLbyte(blue), Xen_to_C_GLbyte(alpha));
+ return(Xen_false);
}
-static XEN gxg_glColor4d(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColor4d(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColor4d "void glColor4d(GLdouble red, GLdouble green, GLdouble blue, GLdouble alpha)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(red), red, 1, "glColor4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(green), green, 2, "glColor4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(blue), blue, 3, "glColor4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(alpha), alpha, 4, "glColor4d", "GLdouble");
- glColor4d(XEN_TO_C_GLdouble(red), XEN_TO_C_GLdouble(green), XEN_TO_C_GLdouble(blue), XEN_TO_C_GLdouble(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(red), red, 1, "glColor4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(green), green, 2, "glColor4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(blue), blue, 3, "glColor4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(alpha), alpha, 4, "glColor4d", "GLdouble");
+ glColor4d(Xen_to_C_GLdouble(red), Xen_to_C_GLdouble(green), Xen_to_C_GLdouble(blue), Xen_to_C_GLdouble(alpha));
+ return(Xen_false);
}
-static XEN gxg_glColor4f(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColor4f(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColor4f "void glColor4f(GLfloat red, GLfloat green, GLfloat blue, GLfloat alpha)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(red), red, 1, "glColor4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(green), green, 2, "glColor4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(blue), blue, 3, "glColor4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(alpha), alpha, 4, "glColor4f", "GLfloat");
- glColor4f(XEN_TO_C_GLfloat(red), XEN_TO_C_GLfloat(green), XEN_TO_C_GLfloat(blue), XEN_TO_C_GLfloat(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(red), red, 1, "glColor4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(green), green, 2, "glColor4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(blue), blue, 3, "glColor4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(alpha), alpha, 4, "glColor4f", "GLfloat");
+ glColor4f(Xen_to_C_GLfloat(red), Xen_to_C_GLfloat(green), Xen_to_C_GLfloat(blue), Xen_to_C_GLfloat(alpha));
+ return(Xen_false);
}
-static XEN gxg_glColor4i(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColor4i(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColor4i "void glColor4i(GLint red, GLint green, GLint blue, GLint alpha)"
- XEN_ASSERT_TYPE(XEN_GLint_P(red), red, 1, "glColor4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(green), green, 2, "glColor4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(blue), blue, 3, "glColor4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(alpha), alpha, 4, "glColor4i", "GLint");
- glColor4i(XEN_TO_C_GLint(red), XEN_TO_C_GLint(green), XEN_TO_C_GLint(blue), XEN_TO_C_GLint(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(red), red, 1, "glColor4i", "GLint");
+ Xen_check_type(Xen_is_GLint(green), green, 2, "glColor4i", "GLint");
+ Xen_check_type(Xen_is_GLint(blue), blue, 3, "glColor4i", "GLint");
+ Xen_check_type(Xen_is_GLint(alpha), alpha, 4, "glColor4i", "GLint");
+ glColor4i(Xen_to_C_GLint(red), Xen_to_C_GLint(green), Xen_to_C_GLint(blue), Xen_to_C_GLint(alpha));
+ return(Xen_false);
}
-static XEN gxg_glColor4s(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColor4s(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColor4s "void glColor4s(GLshort red, GLshort green, GLshort blue, GLshort alpha)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(red), red, 1, "glColor4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(green), green, 2, "glColor4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(blue), blue, 3, "glColor4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(alpha), alpha, 4, "glColor4s", "GLshort");
- glColor4s(XEN_TO_C_GLshort(red), XEN_TO_C_GLshort(green), XEN_TO_C_GLshort(blue), XEN_TO_C_GLshort(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(red), red, 1, "glColor4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(green), green, 2, "glColor4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(blue), blue, 3, "glColor4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(alpha), alpha, 4, "glColor4s", "GLshort");
+ glColor4s(Xen_to_C_GLshort(red), Xen_to_C_GLshort(green), Xen_to_C_GLshort(blue), Xen_to_C_GLshort(alpha));
+ return(Xen_false);
}
-static XEN gxg_glColor4ub(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColor4ub(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColor4ub "void glColor4ub(GLubyte red, GLubyte green, GLubyte blue, GLubyte alpha)"
- XEN_ASSERT_TYPE(XEN_GLubyte_P(red), red, 1, "glColor4ub", "GLubyte");
- XEN_ASSERT_TYPE(XEN_GLubyte_P(green), green, 2, "glColor4ub", "GLubyte");
- XEN_ASSERT_TYPE(XEN_GLubyte_P(blue), blue, 3, "glColor4ub", "GLubyte");
- XEN_ASSERT_TYPE(XEN_GLubyte_P(alpha), alpha, 4, "glColor4ub", "GLubyte");
- glColor4ub(XEN_TO_C_GLubyte(red), XEN_TO_C_GLubyte(green), XEN_TO_C_GLubyte(blue), XEN_TO_C_GLubyte(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLubyte(red), red, 1, "glColor4ub", "GLubyte");
+ Xen_check_type(Xen_is_GLubyte(green), green, 2, "glColor4ub", "GLubyte");
+ Xen_check_type(Xen_is_GLubyte(blue), blue, 3, "glColor4ub", "GLubyte");
+ Xen_check_type(Xen_is_GLubyte(alpha), alpha, 4, "glColor4ub", "GLubyte");
+ glColor4ub(Xen_to_C_GLubyte(red), Xen_to_C_GLubyte(green), Xen_to_C_GLubyte(blue), Xen_to_C_GLubyte(alpha));
+ return(Xen_false);
}
-static XEN gxg_glColor4ui(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColor4ui(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColor4ui "void glColor4ui(GLuint red, GLuint green, GLuint blue, GLuint alpha)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(red), red, 1, "glColor4ui", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLuint_P(green), green, 2, "glColor4ui", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLuint_P(blue), blue, 3, "glColor4ui", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLuint_P(alpha), alpha, 4, "glColor4ui", "GLuint");
- glColor4ui(XEN_TO_C_GLuint(red), XEN_TO_C_GLuint(green), XEN_TO_C_GLuint(blue), XEN_TO_C_GLuint(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(red), red, 1, "glColor4ui", "GLuint");
+ Xen_check_type(Xen_is_GLuint(green), green, 2, "glColor4ui", "GLuint");
+ Xen_check_type(Xen_is_GLuint(blue), blue, 3, "glColor4ui", "GLuint");
+ Xen_check_type(Xen_is_GLuint(alpha), alpha, 4, "glColor4ui", "GLuint");
+ glColor4ui(Xen_to_C_GLuint(red), Xen_to_C_GLuint(green), Xen_to_C_GLuint(blue), Xen_to_C_GLuint(alpha));
+ return(Xen_false);
}
-static XEN gxg_glColor4us(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glColor4us(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glColor4us "void glColor4us(GLushort red, GLushort green, GLushort blue, GLushort alpha)"
- XEN_ASSERT_TYPE(XEN_GLushort_P(red), red, 1, "glColor4us", "GLushort");
- XEN_ASSERT_TYPE(XEN_GLushort_P(green), green, 2, "glColor4us", "GLushort");
- XEN_ASSERT_TYPE(XEN_GLushort_P(blue), blue, 3, "glColor4us", "GLushort");
- XEN_ASSERT_TYPE(XEN_GLushort_P(alpha), alpha, 4, "glColor4us", "GLushort");
- glColor4us(XEN_TO_C_GLushort(red), XEN_TO_C_GLushort(green), XEN_TO_C_GLushort(blue), XEN_TO_C_GLushort(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLushort(red), red, 1, "glColor4us", "GLushort");
+ Xen_check_type(Xen_is_GLushort(green), green, 2, "glColor4us", "GLushort");
+ Xen_check_type(Xen_is_GLushort(blue), blue, 3, "glColor4us", "GLushort");
+ Xen_check_type(Xen_is_GLushort(alpha), alpha, 4, "glColor4us", "GLushort");
+ glColor4us(Xen_to_C_GLushort(red), Xen_to_C_GLushort(green), Xen_to_C_GLushort(blue), Xen_to_C_GLushort(alpha));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord1d(XEN s)
+static Xen gxg_glTexCoord1d(Xen s)
{
#define H_glTexCoord1d "void glTexCoord1d(GLdouble s)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(s), s, 1, "glTexCoord1d", "GLdouble");
- glTexCoord1d(XEN_TO_C_GLdouble(s));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(s), s, 1, "glTexCoord1d", "GLdouble");
+ glTexCoord1d(Xen_to_C_GLdouble(s));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord1f(XEN s)
+static Xen gxg_glTexCoord1f(Xen s)
{
#define H_glTexCoord1f "void glTexCoord1f(GLfloat s)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(s), s, 1, "glTexCoord1f", "GLfloat");
- glTexCoord1f(XEN_TO_C_GLfloat(s));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(s), s, 1, "glTexCoord1f", "GLfloat");
+ glTexCoord1f(Xen_to_C_GLfloat(s));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord1i(XEN s)
+static Xen gxg_glTexCoord1i(Xen s)
{
#define H_glTexCoord1i "void glTexCoord1i(GLint s)"
- XEN_ASSERT_TYPE(XEN_GLint_P(s), s, 1, "glTexCoord1i", "GLint");
- glTexCoord1i(XEN_TO_C_GLint(s));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(s), s, 1, "glTexCoord1i", "GLint");
+ glTexCoord1i(Xen_to_C_GLint(s));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord1s(XEN s)
+static Xen gxg_glTexCoord1s(Xen s)
{
#define H_glTexCoord1s "void glTexCoord1s(GLshort s)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(s), s, 1, "glTexCoord1s", "GLshort");
- glTexCoord1s(XEN_TO_C_GLshort(s));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(s), s, 1, "glTexCoord1s", "GLshort");
+ glTexCoord1s(Xen_to_C_GLshort(s));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord2d(XEN s, XEN t)
+static Xen gxg_glTexCoord2d(Xen s, Xen t)
{
#define H_glTexCoord2d "void glTexCoord2d(GLdouble s, GLdouble t)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(s), s, 1, "glTexCoord2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(t), t, 2, "glTexCoord2d", "GLdouble");
- glTexCoord2d(XEN_TO_C_GLdouble(s), XEN_TO_C_GLdouble(t));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(s), s, 1, "glTexCoord2d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(t), t, 2, "glTexCoord2d", "GLdouble");
+ glTexCoord2d(Xen_to_C_GLdouble(s), Xen_to_C_GLdouble(t));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord2f(XEN s, XEN t)
+static Xen gxg_glTexCoord2f(Xen s, Xen t)
{
#define H_glTexCoord2f "void glTexCoord2f(GLfloat s, GLfloat t)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(s), s, 1, "glTexCoord2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(t), t, 2, "glTexCoord2f", "GLfloat");
- glTexCoord2f(XEN_TO_C_GLfloat(s), XEN_TO_C_GLfloat(t));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(s), s, 1, "glTexCoord2f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(t), t, 2, "glTexCoord2f", "GLfloat");
+ glTexCoord2f(Xen_to_C_GLfloat(s), Xen_to_C_GLfloat(t));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord2i(XEN s, XEN t)
+static Xen gxg_glTexCoord2i(Xen s, Xen t)
{
#define H_glTexCoord2i "void glTexCoord2i(GLint s, GLint t)"
- XEN_ASSERT_TYPE(XEN_GLint_P(s), s, 1, "glTexCoord2i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(t), t, 2, "glTexCoord2i", "GLint");
- glTexCoord2i(XEN_TO_C_GLint(s), XEN_TO_C_GLint(t));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(s), s, 1, "glTexCoord2i", "GLint");
+ Xen_check_type(Xen_is_GLint(t), t, 2, "glTexCoord2i", "GLint");
+ glTexCoord2i(Xen_to_C_GLint(s), Xen_to_C_GLint(t));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord2s(XEN s, XEN t)
+static Xen gxg_glTexCoord2s(Xen s, Xen t)
{
#define H_glTexCoord2s "void glTexCoord2s(GLshort s, GLshort t)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(s), s, 1, "glTexCoord2s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(t), t, 2, "glTexCoord2s", "GLshort");
- glTexCoord2s(XEN_TO_C_GLshort(s), XEN_TO_C_GLshort(t));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(s), s, 1, "glTexCoord2s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(t), t, 2, "glTexCoord2s", "GLshort");
+ glTexCoord2s(Xen_to_C_GLshort(s), Xen_to_C_GLshort(t));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord3d(XEN s, XEN t, XEN r)
+static Xen gxg_glTexCoord3d(Xen s, Xen t, Xen r)
{
#define H_glTexCoord3d "void glTexCoord3d(GLdouble s, GLdouble t, GLdouble r)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(s), s, 1, "glTexCoord3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(t), t, 2, "glTexCoord3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(r), r, 3, "glTexCoord3d", "GLdouble");
- glTexCoord3d(XEN_TO_C_GLdouble(s), XEN_TO_C_GLdouble(t), XEN_TO_C_GLdouble(r));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(s), s, 1, "glTexCoord3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(t), t, 2, "glTexCoord3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(r), r, 3, "glTexCoord3d", "GLdouble");
+ glTexCoord3d(Xen_to_C_GLdouble(s), Xen_to_C_GLdouble(t), Xen_to_C_GLdouble(r));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord3f(XEN s, XEN t, XEN r)
+static Xen gxg_glTexCoord3f(Xen s, Xen t, Xen r)
{
#define H_glTexCoord3f "void glTexCoord3f(GLfloat s, GLfloat t, GLfloat r)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(s), s, 1, "glTexCoord3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(t), t, 2, "glTexCoord3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(r), r, 3, "glTexCoord3f", "GLfloat");
- glTexCoord3f(XEN_TO_C_GLfloat(s), XEN_TO_C_GLfloat(t), XEN_TO_C_GLfloat(r));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(s), s, 1, "glTexCoord3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(t), t, 2, "glTexCoord3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(r), r, 3, "glTexCoord3f", "GLfloat");
+ glTexCoord3f(Xen_to_C_GLfloat(s), Xen_to_C_GLfloat(t), Xen_to_C_GLfloat(r));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord3i(XEN s, XEN t, XEN r)
+static Xen gxg_glTexCoord3i(Xen s, Xen t, Xen r)
{
#define H_glTexCoord3i "void glTexCoord3i(GLint s, GLint t, GLint r)"
- XEN_ASSERT_TYPE(XEN_GLint_P(s), s, 1, "glTexCoord3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(t), t, 2, "glTexCoord3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(r), r, 3, "glTexCoord3i", "GLint");
- glTexCoord3i(XEN_TO_C_GLint(s), XEN_TO_C_GLint(t), XEN_TO_C_GLint(r));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(s), s, 1, "glTexCoord3i", "GLint");
+ Xen_check_type(Xen_is_GLint(t), t, 2, "glTexCoord3i", "GLint");
+ Xen_check_type(Xen_is_GLint(r), r, 3, "glTexCoord3i", "GLint");
+ glTexCoord3i(Xen_to_C_GLint(s), Xen_to_C_GLint(t), Xen_to_C_GLint(r));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord3s(XEN s, XEN t, XEN r)
+static Xen gxg_glTexCoord3s(Xen s, Xen t, Xen r)
{
#define H_glTexCoord3s "void glTexCoord3s(GLshort s, GLshort t, GLshort r)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(s), s, 1, "glTexCoord3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(t), t, 2, "glTexCoord3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(r), r, 3, "glTexCoord3s", "GLshort");
- glTexCoord3s(XEN_TO_C_GLshort(s), XEN_TO_C_GLshort(t), XEN_TO_C_GLshort(r));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(s), s, 1, "glTexCoord3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(t), t, 2, "glTexCoord3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(r), r, 3, "glTexCoord3s", "GLshort");
+ glTexCoord3s(Xen_to_C_GLshort(s), Xen_to_C_GLshort(t), Xen_to_C_GLshort(r));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord4d(XEN s, XEN t, XEN r, XEN q)
+static Xen gxg_glTexCoord4d(Xen s, Xen t, Xen r, Xen q)
{
#define H_glTexCoord4d "void glTexCoord4d(GLdouble s, GLdouble t, GLdouble r, GLdouble q)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(s), s, 1, "glTexCoord4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(t), t, 2, "glTexCoord4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(r), r, 3, "glTexCoord4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(q), q, 4, "glTexCoord4d", "GLdouble");
- glTexCoord4d(XEN_TO_C_GLdouble(s), XEN_TO_C_GLdouble(t), XEN_TO_C_GLdouble(r), XEN_TO_C_GLdouble(q));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(s), s, 1, "glTexCoord4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(t), t, 2, "glTexCoord4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(r), r, 3, "glTexCoord4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(q), q, 4, "glTexCoord4d", "GLdouble");
+ glTexCoord4d(Xen_to_C_GLdouble(s), Xen_to_C_GLdouble(t), Xen_to_C_GLdouble(r), Xen_to_C_GLdouble(q));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord4f(XEN s, XEN t, XEN r, XEN q)
+static Xen gxg_glTexCoord4f(Xen s, Xen t, Xen r, Xen q)
{
#define H_glTexCoord4f "void glTexCoord4f(GLfloat s, GLfloat t, GLfloat r, GLfloat q)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(s), s, 1, "glTexCoord4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(t), t, 2, "glTexCoord4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(r), r, 3, "glTexCoord4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(q), q, 4, "glTexCoord4f", "GLfloat");
- glTexCoord4f(XEN_TO_C_GLfloat(s), XEN_TO_C_GLfloat(t), XEN_TO_C_GLfloat(r), XEN_TO_C_GLfloat(q));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(s), s, 1, "glTexCoord4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(t), t, 2, "glTexCoord4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(r), r, 3, "glTexCoord4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(q), q, 4, "glTexCoord4f", "GLfloat");
+ glTexCoord4f(Xen_to_C_GLfloat(s), Xen_to_C_GLfloat(t), Xen_to_C_GLfloat(r), Xen_to_C_GLfloat(q));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord4i(XEN s, XEN t, XEN r, XEN q)
+static Xen gxg_glTexCoord4i(Xen s, Xen t, Xen r, Xen q)
{
#define H_glTexCoord4i "void glTexCoord4i(GLint s, GLint t, GLint r, GLint q)"
- XEN_ASSERT_TYPE(XEN_GLint_P(s), s, 1, "glTexCoord4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(t), t, 2, "glTexCoord4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(r), r, 3, "glTexCoord4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(q), q, 4, "glTexCoord4i", "GLint");
- glTexCoord4i(XEN_TO_C_GLint(s), XEN_TO_C_GLint(t), XEN_TO_C_GLint(r), XEN_TO_C_GLint(q));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(s), s, 1, "glTexCoord4i", "GLint");
+ Xen_check_type(Xen_is_GLint(t), t, 2, "glTexCoord4i", "GLint");
+ Xen_check_type(Xen_is_GLint(r), r, 3, "glTexCoord4i", "GLint");
+ Xen_check_type(Xen_is_GLint(q), q, 4, "glTexCoord4i", "GLint");
+ glTexCoord4i(Xen_to_C_GLint(s), Xen_to_C_GLint(t), Xen_to_C_GLint(r), Xen_to_C_GLint(q));
+ return(Xen_false);
}
-static XEN gxg_glTexCoord4s(XEN s, XEN t, XEN r, XEN q)
+static Xen gxg_glTexCoord4s(Xen s, Xen t, Xen r, Xen q)
{
#define H_glTexCoord4s "void glTexCoord4s(GLshort s, GLshort t, GLshort r, GLshort q)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(s), s, 1, "glTexCoord4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(t), t, 2, "glTexCoord4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(r), r, 3, "glTexCoord4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(q), q, 4, "glTexCoord4s", "GLshort");
- glTexCoord4s(XEN_TO_C_GLshort(s), XEN_TO_C_GLshort(t), XEN_TO_C_GLshort(r), XEN_TO_C_GLshort(q));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(s), s, 1, "glTexCoord4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(t), t, 2, "glTexCoord4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(r), r, 3, "glTexCoord4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(q), q, 4, "glTexCoord4s", "GLshort");
+ glTexCoord4s(Xen_to_C_GLshort(s), Xen_to_C_GLshort(t), Xen_to_C_GLshort(r), Xen_to_C_GLshort(q));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos2d(XEN x, XEN y)
+static Xen gxg_glRasterPos2d(Xen x, Xen y)
{
#define H_glRasterPos2d "void glRasterPos2d(GLdouble x, GLdouble y)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "glRasterPos2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "glRasterPos2d", "GLdouble");
- glRasterPos2d(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "glRasterPos2d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "glRasterPos2d", "GLdouble");
+ glRasterPos2d(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos2f(XEN x, XEN y)
+static Xen gxg_glRasterPos2f(Xen x, Xen y)
{
#define H_glRasterPos2f "void glRasterPos2f(GLfloat x, GLfloat y)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 1, "glRasterPos2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 2, "glRasterPos2f", "GLfloat");
- glRasterPos2f(XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x), x, 1, "glRasterPos2f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 2, "glRasterPos2f", "GLfloat");
+ glRasterPos2f(Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos2i(XEN x, XEN y)
+static Xen gxg_glRasterPos2i(Xen x, Xen y)
{
#define H_glRasterPos2i "void glRasterPos2i(GLint x, GLint y)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glRasterPos2i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glRasterPos2i", "GLint");
- glRasterPos2i(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glRasterPos2i", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glRasterPos2i", "GLint");
+ glRasterPos2i(Xen_to_C_GLint(x), Xen_to_C_GLint(y));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos2s(XEN x, XEN y)
+static Xen gxg_glRasterPos2s(Xen x, Xen y)
{
#define H_glRasterPos2s "void glRasterPos2s(GLshort x, GLshort y)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(x), x, 1, "glRasterPos2s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(y), y, 2, "glRasterPos2s", "GLshort");
- glRasterPos2s(XEN_TO_C_GLshort(x), XEN_TO_C_GLshort(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(x), x, 1, "glRasterPos2s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(y), y, 2, "glRasterPos2s", "GLshort");
+ glRasterPos2s(Xen_to_C_GLshort(x), Xen_to_C_GLshort(y));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos3d(XEN x, XEN y, XEN z)
+static Xen gxg_glRasterPos3d(Xen x, Xen y, Xen z)
{
#define H_glRasterPos3d "void glRasterPos3d(GLdouble x, GLdouble y, GLdouble z)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "glRasterPos3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "glRasterPos3d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(z), z, 3, "glRasterPos3d", "GLdouble");
- glRasterPos3d(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y), XEN_TO_C_GLdouble(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "glRasterPos3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "glRasterPos3d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(z), z, 3, "glRasterPos3d", "GLdouble");
+ glRasterPos3d(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y), Xen_to_C_GLdouble(z));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos3f(XEN x, XEN y, XEN z)
+static Xen gxg_glRasterPos3f(Xen x, Xen y, Xen z)
{
#define H_glRasterPos3f "void glRasterPos3f(GLfloat x, GLfloat y, GLfloat z)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 1, "glRasterPos3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 2, "glRasterPos3f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(z), z, 3, "glRasterPos3f", "GLfloat");
- glRasterPos3f(XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y), XEN_TO_C_GLfloat(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x), x, 1, "glRasterPos3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 2, "glRasterPos3f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(z), z, 3, "glRasterPos3f", "GLfloat");
+ glRasterPos3f(Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y), Xen_to_C_GLfloat(z));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos3i(XEN x, XEN y, XEN z)
+static Xen gxg_glRasterPos3i(Xen x, Xen y, Xen z)
{
#define H_glRasterPos3i "void glRasterPos3i(GLint x, GLint y, GLint z)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glRasterPos3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glRasterPos3i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(z), z, 3, "glRasterPos3i", "GLint");
- glRasterPos3i(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLint(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glRasterPos3i", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glRasterPos3i", "GLint");
+ Xen_check_type(Xen_is_GLint(z), z, 3, "glRasterPos3i", "GLint");
+ glRasterPos3i(Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLint(z));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos3s(XEN x, XEN y, XEN z)
+static Xen gxg_glRasterPos3s(Xen x, Xen y, Xen z)
{
#define H_glRasterPos3s "void glRasterPos3s(GLshort x, GLshort y, GLshort z)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(x), x, 1, "glRasterPos3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(y), y, 2, "glRasterPos3s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(z), z, 3, "glRasterPos3s", "GLshort");
- glRasterPos3s(XEN_TO_C_GLshort(x), XEN_TO_C_GLshort(y), XEN_TO_C_GLshort(z));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(x), x, 1, "glRasterPos3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(y), y, 2, "glRasterPos3s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(z), z, 3, "glRasterPos3s", "GLshort");
+ glRasterPos3s(Xen_to_C_GLshort(x), Xen_to_C_GLshort(y), Xen_to_C_GLshort(z));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos4d(XEN x, XEN y, XEN z, XEN w)
+static Xen gxg_glRasterPos4d(Xen x, Xen y, Xen z, Xen w)
{
#define H_glRasterPos4d "void glRasterPos4d(GLdouble x, GLdouble y, GLdouble z, GLdouble w)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "glRasterPos4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "glRasterPos4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(z), z, 3, "glRasterPos4d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(w), w, 4, "glRasterPos4d", "GLdouble");
- glRasterPos4d(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y), XEN_TO_C_GLdouble(z), XEN_TO_C_GLdouble(w));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "glRasterPos4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "glRasterPos4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(z), z, 3, "glRasterPos4d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(w), w, 4, "glRasterPos4d", "GLdouble");
+ glRasterPos4d(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y), Xen_to_C_GLdouble(z), Xen_to_C_GLdouble(w));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos4f(XEN x, XEN y, XEN z, XEN w)
+static Xen gxg_glRasterPos4f(Xen x, Xen y, Xen z, Xen w)
{
#define H_glRasterPos4f "void glRasterPos4f(GLfloat x, GLfloat y, GLfloat z, GLfloat w)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x), x, 1, "glRasterPos4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y), y, 2, "glRasterPos4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(z), z, 3, "glRasterPos4f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(w), w, 4, "glRasterPos4f", "GLfloat");
- glRasterPos4f(XEN_TO_C_GLfloat(x), XEN_TO_C_GLfloat(y), XEN_TO_C_GLfloat(z), XEN_TO_C_GLfloat(w));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x), x, 1, "glRasterPos4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y), y, 2, "glRasterPos4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(z), z, 3, "glRasterPos4f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(w), w, 4, "glRasterPos4f", "GLfloat");
+ glRasterPos4f(Xen_to_C_GLfloat(x), Xen_to_C_GLfloat(y), Xen_to_C_GLfloat(z), Xen_to_C_GLfloat(w));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos4i(XEN x, XEN y, XEN z, XEN w)
+static Xen gxg_glRasterPos4i(Xen x, Xen y, Xen z, Xen w)
{
#define H_glRasterPos4i "void glRasterPos4i(GLint x, GLint y, GLint z, GLint w)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glRasterPos4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glRasterPos4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(z), z, 3, "glRasterPos4i", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(w), w, 4, "glRasterPos4i", "GLint");
- glRasterPos4i(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLint(z), XEN_TO_C_GLint(w));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glRasterPos4i", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glRasterPos4i", "GLint");
+ Xen_check_type(Xen_is_GLint(z), z, 3, "glRasterPos4i", "GLint");
+ Xen_check_type(Xen_is_GLint(w), w, 4, "glRasterPos4i", "GLint");
+ glRasterPos4i(Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLint(z), Xen_to_C_GLint(w));
+ return(Xen_false);
}
-static XEN gxg_glRasterPos4s(XEN x, XEN y, XEN z, XEN w)
+static Xen gxg_glRasterPos4s(Xen x, Xen y, Xen z, Xen w)
{
#define H_glRasterPos4s "void glRasterPos4s(GLshort x, GLshort y, GLshort z, GLshort w)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(x), x, 1, "glRasterPos4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(y), y, 2, "glRasterPos4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(z), z, 3, "glRasterPos4s", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(w), w, 4, "glRasterPos4s", "GLshort");
- glRasterPos4s(XEN_TO_C_GLshort(x), XEN_TO_C_GLshort(y), XEN_TO_C_GLshort(z), XEN_TO_C_GLshort(w));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(x), x, 1, "glRasterPos4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(y), y, 2, "glRasterPos4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(z), z, 3, "glRasterPos4s", "GLshort");
+ Xen_check_type(Xen_is_GLshort(w), w, 4, "glRasterPos4s", "GLshort");
+ glRasterPos4s(Xen_to_C_GLshort(x), Xen_to_C_GLshort(y), Xen_to_C_GLshort(z), Xen_to_C_GLshort(w));
+ return(Xen_false);
}
-static XEN gxg_glRectd(XEN x1, XEN y1, XEN x2, XEN y2)
+static Xen gxg_glRectd(Xen x1, Xen y1, Xen x2, Xen y2)
{
#define H_glRectd "void glRectd(GLdouble x1, GLdouble y1, GLdouble x2, GLdouble y2)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x1), x1, 1, "glRectd", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y1), y1, 2, "glRectd", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x2), x2, 3, "glRectd", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y2), y2, 4, "glRectd", "GLdouble");
- glRectd(XEN_TO_C_GLdouble(x1), XEN_TO_C_GLdouble(y1), XEN_TO_C_GLdouble(x2), XEN_TO_C_GLdouble(y2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x1), x1, 1, "glRectd", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y1), y1, 2, "glRectd", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(x2), x2, 3, "glRectd", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y2), y2, 4, "glRectd", "GLdouble");
+ glRectd(Xen_to_C_GLdouble(x1), Xen_to_C_GLdouble(y1), Xen_to_C_GLdouble(x2), Xen_to_C_GLdouble(y2));
+ return(Xen_false);
}
-static XEN gxg_glRectf(XEN x1, XEN y1, XEN x2, XEN y2)
+static Xen gxg_glRectf(Xen x1, Xen y1, Xen x2, Xen y2)
{
#define H_glRectf "void glRectf(GLfloat x1, GLfloat y1, GLfloat x2, GLfloat y2)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x1), x1, 1, "glRectf", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y1), y1, 2, "glRectf", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(x2), x2, 3, "glRectf", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(y2), y2, 4, "glRectf", "GLfloat");
- glRectf(XEN_TO_C_GLfloat(x1), XEN_TO_C_GLfloat(y1), XEN_TO_C_GLfloat(x2), XEN_TO_C_GLfloat(y2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(x1), x1, 1, "glRectf", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y1), y1, 2, "glRectf", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(x2), x2, 3, "glRectf", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(y2), y2, 4, "glRectf", "GLfloat");
+ glRectf(Xen_to_C_GLfloat(x1), Xen_to_C_GLfloat(y1), Xen_to_C_GLfloat(x2), Xen_to_C_GLfloat(y2));
+ return(Xen_false);
}
-static XEN gxg_glRecti(XEN x1, XEN y1, XEN x2, XEN y2)
+static Xen gxg_glRecti(Xen x1, Xen y1, Xen x2, Xen y2)
{
#define H_glRecti "void glRecti(GLint x1, GLint y1, GLint x2, GLint y2)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x1), x1, 1, "glRecti", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y1), y1, 2, "glRecti", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(x2), x2, 3, "glRecti", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y2), y2, 4, "glRecti", "GLint");
- glRecti(XEN_TO_C_GLint(x1), XEN_TO_C_GLint(y1), XEN_TO_C_GLint(x2), XEN_TO_C_GLint(y2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x1), x1, 1, "glRecti", "GLint");
+ Xen_check_type(Xen_is_GLint(y1), y1, 2, "glRecti", "GLint");
+ Xen_check_type(Xen_is_GLint(x2), x2, 3, "glRecti", "GLint");
+ Xen_check_type(Xen_is_GLint(y2), y2, 4, "glRecti", "GLint");
+ glRecti(Xen_to_C_GLint(x1), Xen_to_C_GLint(y1), Xen_to_C_GLint(x2), Xen_to_C_GLint(y2));
+ return(Xen_false);
}
-static XEN gxg_glRects(XEN x1, XEN y1, XEN x2, XEN y2)
+static Xen gxg_glRects(Xen x1, Xen y1, Xen x2, Xen y2)
{
#define H_glRects "void glRects(GLshort x1, GLshort y1, GLshort x2, GLshort y2)"
- XEN_ASSERT_TYPE(XEN_GLshort_P(x1), x1, 1, "glRects", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(y1), y1, 2, "glRects", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(x2), x2, 3, "glRects", "GLshort");
- XEN_ASSERT_TYPE(XEN_GLshort_P(y2), y2, 4, "glRects", "GLshort");
- glRects(XEN_TO_C_GLshort(x1), XEN_TO_C_GLshort(y1), XEN_TO_C_GLshort(x2), XEN_TO_C_GLshort(y2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLshort(x1), x1, 1, "glRects", "GLshort");
+ Xen_check_type(Xen_is_GLshort(y1), y1, 2, "glRects", "GLshort");
+ Xen_check_type(Xen_is_GLshort(x2), x2, 3, "glRects", "GLshort");
+ Xen_check_type(Xen_is_GLshort(y2), y2, 4, "glRects", "GLshort");
+ glRects(Xen_to_C_GLshort(x1), Xen_to_C_GLshort(y1), Xen_to_C_GLshort(x2), Xen_to_C_GLshort(y2));
+ return(Xen_false);
}
-static XEN gxg_glVertexPointer(XEN size, XEN type, XEN stride, XEN ptr)
+static Xen gxg_glVertexPointer(Xen size, Xen type, Xen stride, Xen ptr)
{
#define H_glVertexPointer "void glVertexPointer(GLint size, GLenum type, GLsizei stride, GLvoid* ptr)"
- XEN_ASSERT_TYPE(XEN_GLint_P(size), size, 1, "glVertexPointer", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 2, "glVertexPointer", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(stride), stride, 3, "glVertexPointer", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(ptr), ptr, 4, "glVertexPointer", "GLvoid*");
- glVertexPointer(XEN_TO_C_GLint(size), XEN_TO_C_GLenum(type), XEN_TO_C_GLsizei(stride), XEN_TO_C_GLvoid_(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(size), size, 1, "glVertexPointer", "GLint");
+ Xen_check_type(Xen_is_GLenum(type), type, 2, "glVertexPointer", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(stride), stride, 3, "glVertexPointer", "GLsizei");
+ Xen_check_type(Xen_is_GLvoid_(ptr), ptr, 4, "glVertexPointer", "GLvoid*");
+ glVertexPointer(Xen_to_C_GLint(size), Xen_to_C_GLenum(type), Xen_to_C_GLsizei(stride), Xen_to_C_GLvoid_(ptr));
+ return(Xen_false);
}
-static XEN gxg_glNormalPointer(XEN type, XEN stride, XEN ptr)
+static Xen gxg_glNormalPointer(Xen type, Xen stride, Xen ptr)
{
#define H_glNormalPointer "void glNormalPointer(GLenum type, GLsizei stride, GLvoid* ptr)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 1, "glNormalPointer", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(stride), stride, 2, "glNormalPointer", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(ptr), ptr, 3, "glNormalPointer", "GLvoid*");
- glNormalPointer(XEN_TO_C_GLenum(type), XEN_TO_C_GLsizei(stride), XEN_TO_C_GLvoid_(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(type), type, 1, "glNormalPointer", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(stride), stride, 2, "glNormalPointer", "GLsizei");
+ Xen_check_type(Xen_is_GLvoid_(ptr), ptr, 3, "glNormalPointer", "GLvoid*");
+ glNormalPointer(Xen_to_C_GLenum(type), Xen_to_C_GLsizei(stride), Xen_to_C_GLvoid_(ptr));
+ return(Xen_false);
}
-static XEN gxg_glColorPointer(XEN size, XEN type, XEN stride, XEN ptr)
+static Xen gxg_glColorPointer(Xen size, Xen type, Xen stride, Xen ptr)
{
#define H_glColorPointer "void glColorPointer(GLint size, GLenum type, GLsizei stride, GLvoid* ptr)"
- XEN_ASSERT_TYPE(XEN_GLint_P(size), size, 1, "glColorPointer", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 2, "glColorPointer", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(stride), stride, 3, "glColorPointer", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(ptr), ptr, 4, "glColorPointer", "GLvoid*");
- glColorPointer(XEN_TO_C_GLint(size), XEN_TO_C_GLenum(type), XEN_TO_C_GLsizei(stride), XEN_TO_C_GLvoid_(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(size), size, 1, "glColorPointer", "GLint");
+ Xen_check_type(Xen_is_GLenum(type), type, 2, "glColorPointer", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(stride), stride, 3, "glColorPointer", "GLsizei");
+ Xen_check_type(Xen_is_GLvoid_(ptr), ptr, 4, "glColorPointer", "GLvoid*");
+ glColorPointer(Xen_to_C_GLint(size), Xen_to_C_GLenum(type), Xen_to_C_GLsizei(stride), Xen_to_C_GLvoid_(ptr));
+ return(Xen_false);
}
-static XEN gxg_glIndexPointer(XEN type, XEN stride, XEN ptr)
+static Xen gxg_glIndexPointer(Xen type, Xen stride, Xen ptr)
{
#define H_glIndexPointer "void glIndexPointer(GLenum type, GLsizei stride, GLvoid* ptr)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 1, "glIndexPointer", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(stride), stride, 2, "glIndexPointer", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(ptr), ptr, 3, "glIndexPointer", "GLvoid*");
- glIndexPointer(XEN_TO_C_GLenum(type), XEN_TO_C_GLsizei(stride), XEN_TO_C_GLvoid_(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(type), type, 1, "glIndexPointer", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(stride), stride, 2, "glIndexPointer", "GLsizei");
+ Xen_check_type(Xen_is_GLvoid_(ptr), ptr, 3, "glIndexPointer", "GLvoid*");
+ glIndexPointer(Xen_to_C_GLenum(type), Xen_to_C_GLsizei(stride), Xen_to_C_GLvoid_(ptr));
+ return(Xen_false);
}
-static XEN gxg_glTexCoordPointer(XEN size, XEN type, XEN stride, XEN ptr)
+static Xen gxg_glTexCoordPointer(Xen size, Xen type, Xen stride, Xen ptr)
{
#define H_glTexCoordPointer "void glTexCoordPointer(GLint size, GLenum type, GLsizei stride, GLvoid* ptr)"
- XEN_ASSERT_TYPE(XEN_GLint_P(size), size, 1, "glTexCoordPointer", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 2, "glTexCoordPointer", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(stride), stride, 3, "glTexCoordPointer", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(ptr), ptr, 4, "glTexCoordPointer", "GLvoid*");
- glTexCoordPointer(XEN_TO_C_GLint(size), XEN_TO_C_GLenum(type), XEN_TO_C_GLsizei(stride), XEN_TO_C_GLvoid_(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(size), size, 1, "glTexCoordPointer", "GLint");
+ Xen_check_type(Xen_is_GLenum(type), type, 2, "glTexCoordPointer", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(stride), stride, 3, "glTexCoordPointer", "GLsizei");
+ Xen_check_type(Xen_is_GLvoid_(ptr), ptr, 4, "glTexCoordPointer", "GLvoid*");
+ glTexCoordPointer(Xen_to_C_GLint(size), Xen_to_C_GLenum(type), Xen_to_C_GLsizei(stride), Xen_to_C_GLvoid_(ptr));
+ return(Xen_false);
}
-static XEN gxg_glEdgeFlagPointer(XEN stride, XEN ptr)
+static Xen gxg_glEdgeFlagPointer(Xen stride, Xen ptr)
{
#define H_glEdgeFlagPointer "void glEdgeFlagPointer(GLsizei stride, GLvoid* ptr)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(stride), stride, 1, "glEdgeFlagPointer", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(ptr), ptr, 2, "glEdgeFlagPointer", "GLvoid*");
- glEdgeFlagPointer(XEN_TO_C_GLsizei(stride), XEN_TO_C_GLvoid_(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLsizei(stride), stride, 1, "glEdgeFlagPointer", "GLsizei");
+ Xen_check_type(Xen_is_GLvoid_(ptr), ptr, 2, "glEdgeFlagPointer", "GLvoid*");
+ glEdgeFlagPointer(Xen_to_C_GLsizei(stride), Xen_to_C_GLvoid_(ptr));
+ return(Xen_false);
}
-static XEN gxg_glGetPointerv(XEN pname, XEN params)
+static Xen gxg_glGetPointerv(Xen pname, Xen params)
{
#define H_glGetPointerv "void glGetPointerv(GLenum pname, void** [params])"
void* ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glGetPointerv", "GLenum");
- glGetPointerv(XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_void_(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glGetPointerv", "GLenum");
+ glGetPointerv(Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_void_(ref_params[0])));
}
-static XEN gxg_glArrayElement(XEN i)
+static Xen gxg_glArrayElement(Xen i)
{
#define H_glArrayElement "void glArrayElement(GLint i)"
- XEN_ASSERT_TYPE(XEN_GLint_P(i), i, 1, "glArrayElement", "GLint");
- glArrayElement(XEN_TO_C_GLint(i));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(i), i, 1, "glArrayElement", "GLint");
+ glArrayElement(Xen_to_C_GLint(i));
+ return(Xen_false);
}
-static XEN gxg_glDrawArrays(XEN mode, XEN first, XEN count)
+static Xen gxg_glDrawArrays(Xen mode, Xen first, Xen count)
{
#define H_glDrawArrays "void glDrawArrays(GLenum mode, GLint first, GLsizei count)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glDrawArrays", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(first), first, 2, "glDrawArrays", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(count), count, 3, "glDrawArrays", "GLsizei");
- glDrawArrays(XEN_TO_C_GLenum(mode), XEN_TO_C_GLint(first), XEN_TO_C_GLsizei(count));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glDrawArrays", "GLenum");
+ Xen_check_type(Xen_is_GLint(first), first, 2, "glDrawArrays", "GLint");
+ Xen_check_type(Xen_is_GLsizei(count), count, 3, "glDrawArrays", "GLsizei");
+ glDrawArrays(Xen_to_C_GLenum(mode), Xen_to_C_GLint(first), Xen_to_C_GLsizei(count));
+ return(Xen_false);
}
-static XEN gxg_glDrawElements(XEN mode, XEN count, XEN type, XEN indices)
+static Xen gxg_glDrawElements(Xen mode, Xen count, Xen type, Xen indices)
{
#define H_glDrawElements "void glDrawElements(GLenum mode, GLsizei count, GLenum type, GLvoid* indices)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glDrawElements", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(count), count, 2, "glDrawElements", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 3, "glDrawElements", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(indices), indices, 4, "glDrawElements", "GLvoid*");
- glDrawElements(XEN_TO_C_GLenum(mode), XEN_TO_C_GLsizei(count), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(indices));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glDrawElements", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(count), count, 2, "glDrawElements", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(type), type, 3, "glDrawElements", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(indices), indices, 4, "glDrawElements", "GLvoid*");
+ glDrawElements(Xen_to_C_GLenum(mode), Xen_to_C_GLsizei(count), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(indices));
+ return(Xen_false);
}
-static XEN gxg_glInterleavedArrays(XEN format, XEN stride, XEN pointer)
+static Xen gxg_glInterleavedArrays(Xen format, Xen stride, Xen pointer)
{
#define H_glInterleavedArrays "void glInterleavedArrays(GLenum format, GLsizei stride, GLvoid* pointer)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 1, "glInterleavedArrays", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(stride), stride, 2, "glInterleavedArrays", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pointer), pointer, 3, "glInterleavedArrays", "GLvoid*");
- glInterleavedArrays(XEN_TO_C_GLenum(format), XEN_TO_C_GLsizei(stride), XEN_TO_C_GLvoid_(pointer));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(format), format, 1, "glInterleavedArrays", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(stride), stride, 2, "glInterleavedArrays", "GLsizei");
+ Xen_check_type(Xen_is_GLvoid_(pointer), pointer, 3, "glInterleavedArrays", "GLvoid*");
+ glInterleavedArrays(Xen_to_C_GLenum(format), Xen_to_C_GLsizei(stride), Xen_to_C_GLvoid_(pointer));
+ return(Xen_false);
}
-static XEN gxg_glShadeModel(XEN mode)
+static Xen gxg_glShadeModel(Xen mode)
{
#define H_glShadeModel "void glShadeModel(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glShadeModel", "GLenum");
- glShadeModel(XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glShadeModel", "GLenum");
+ glShadeModel(Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glLightf(XEN light, XEN pname, XEN param)
+static Xen gxg_glLightf(Xen light, Xen pname, Xen param)
{
#define H_glLightf "void glLightf(GLenum light, GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(light), light, 1, "glLightf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glLightf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 3, "glLightf", "GLfloat");
- glLightf(XEN_TO_C_GLenum(light), XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(light), light, 1, "glLightf", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glLightf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 3, "glLightf", "GLfloat");
+ glLightf(Xen_to_C_GLenum(light), Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glLighti(XEN light, XEN pname, XEN param)
+static Xen gxg_glLighti(Xen light, Xen pname, Xen param)
{
#define H_glLighti "void glLighti(GLenum light, GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(light), light, 1, "glLighti", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glLighti", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 3, "glLighti", "GLint");
- glLighti(XEN_TO_C_GLenum(light), XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(light), light, 1, "glLighti", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glLighti", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 3, "glLighti", "GLint");
+ glLighti(Xen_to_C_GLenum(light), Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glGetLightfv(XEN light, XEN pname, XEN params)
+static Xen gxg_glGetLightfv(Xen light, Xen pname, Xen params)
{
#define H_glGetLightfv "void glGetLightfv(GLenum light, GLenum pname, GLfloat* [params])"
GLfloat ref_params[16];
- XEN_ASSERT_TYPE(XEN_GLenum_P(light), light, 1, "glGetLightfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetLightfv", "GLenum");
- glGetLightfv(XEN_TO_C_GLenum(light), XEN_TO_C_GLenum(pname), ref_params);
+ Xen_check_type(Xen_is_GLenum(light), light, 1, "glGetLightfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetLightfv", "GLenum");
+ glGetLightfv(Xen_to_C_GLenum(light), Xen_to_C_GLenum(pname), ref_params);
{
- XEN result;
+ Xen result;
int i, vals;
- vals = how_many_vals(XEN_TO_C_GLenum(pname));
- result = XEN_EMPTY_LIST;
+ vals = how_many_vals(Xen_to_C_GLenum(pname));
+ result = Xen_empty_list;
for (i = 0; i < vals; i++)
- result = XEN_CONS(C_TO_XEN_GLfloat(ref_params[i]), result);
+ result = Xen_cons(C_to_Xen_GLfloat(ref_params[i]), result);
return(result);
}
}
-static XEN gxg_glGetLightiv(XEN light, XEN pname, XEN params)
+static Xen gxg_glGetLightiv(Xen light, Xen pname, Xen params)
{
#define H_glGetLightiv "void glGetLightiv(GLenum light, GLenum pname, GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(light), light, 1, "glGetLightiv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetLightiv", "GLenum");
- glGetLightiv(XEN_TO_C_GLenum(light), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(light), light, 1, "glGetLightiv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetLightiv", "GLenum");
+ glGetLightiv(Xen_to_C_GLenum(light), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glLightModelf(XEN pname, XEN param)
+static Xen gxg_glLightModelf(Xen pname, Xen param)
{
#define H_glLightModelf "void glLightModelf(GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glLightModelf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 2, "glLightModelf", "GLfloat");
- glLightModelf(XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glLightModelf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 2, "glLightModelf", "GLfloat");
+ glLightModelf(Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glLightModeli(XEN pname, XEN param)
+static Xen gxg_glLightModeli(Xen pname, Xen param)
{
#define H_glLightModeli "void glLightModeli(GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glLightModeli", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 2, "glLightModeli", "GLint");
- glLightModeli(XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glLightModeli", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 2, "glLightModeli", "GLint");
+ glLightModeli(Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glMaterialf(XEN face, XEN pname, XEN param)
+static Xen gxg_glMaterialf(Xen face, Xen pname, Xen param)
{
#define H_glMaterialf "void glMaterialf(GLenum face, GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(face), face, 1, "glMaterialf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glMaterialf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 3, "glMaterialf", "GLfloat");
- glMaterialf(XEN_TO_C_GLenum(face), XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(face), face, 1, "glMaterialf", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glMaterialf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 3, "glMaterialf", "GLfloat");
+ glMaterialf(Xen_to_C_GLenum(face), Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glMateriali(XEN face, XEN pname, XEN param)
+static Xen gxg_glMateriali(Xen face, Xen pname, Xen param)
{
#define H_glMateriali "void glMateriali(GLenum face, GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(face), face, 1, "glMateriali", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glMateriali", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 3, "glMateriali", "GLint");
- glMateriali(XEN_TO_C_GLenum(face), XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(face), face, 1, "glMateriali", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glMateriali", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 3, "glMateriali", "GLint");
+ glMateriali(Xen_to_C_GLenum(face), Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glGetMaterialfv(XEN face, XEN pname, XEN params)
+static Xen gxg_glGetMaterialfv(Xen face, Xen pname, Xen params)
{
#define H_glGetMaterialfv "void glGetMaterialfv(GLenum face, GLenum pname, GLfloat* [params])"
GLfloat ref_params[16];
- XEN_ASSERT_TYPE(XEN_GLenum_P(face), face, 1, "glGetMaterialfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetMaterialfv", "GLenum");
- glGetMaterialfv(XEN_TO_C_GLenum(face), XEN_TO_C_GLenum(pname), ref_params);
+ Xen_check_type(Xen_is_GLenum(face), face, 1, "glGetMaterialfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetMaterialfv", "GLenum");
+ glGetMaterialfv(Xen_to_C_GLenum(face), Xen_to_C_GLenum(pname), ref_params);
{
- XEN result;
+ Xen result;
int i, vals;
- vals = how_many_vals(XEN_TO_C_GLenum(pname));
- result = XEN_EMPTY_LIST;
+ vals = how_many_vals(Xen_to_C_GLenum(pname));
+ result = Xen_empty_list;
for (i = 0; i < vals; i++)
- result = XEN_CONS(C_TO_XEN_GLfloat(ref_params[i]), result);
+ result = Xen_cons(C_to_Xen_GLfloat(ref_params[i]), result);
return(result);
}
}
-static XEN gxg_glGetMaterialiv(XEN face, XEN pname, XEN params)
+static Xen gxg_glGetMaterialiv(Xen face, Xen pname, Xen params)
{
#define H_glGetMaterialiv "void glGetMaterialiv(GLenum face, GLenum pname, GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(face), face, 1, "glGetMaterialiv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetMaterialiv", "GLenum");
- glGetMaterialiv(XEN_TO_C_GLenum(face), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(face), face, 1, "glGetMaterialiv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetMaterialiv", "GLenum");
+ glGetMaterialiv(Xen_to_C_GLenum(face), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glColorMaterial(XEN face, XEN mode)
+static Xen gxg_glColorMaterial(Xen face, Xen mode)
{
#define H_glColorMaterial "void glColorMaterial(GLenum face, GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(face), face, 1, "glColorMaterial", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 2, "glColorMaterial", "GLenum");
- glColorMaterial(XEN_TO_C_GLenum(face), XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(face), face, 1, "glColorMaterial", "GLenum");
+ Xen_check_type(Xen_is_GLenum(mode), mode, 2, "glColorMaterial", "GLenum");
+ glColorMaterial(Xen_to_C_GLenum(face), Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glPixelZoom(XEN xfactor, XEN yfactor)
+static Xen gxg_glPixelZoom(Xen xfactor, Xen yfactor)
{
#define H_glPixelZoom "void glPixelZoom(GLfloat xfactor, GLfloat yfactor)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(xfactor), xfactor, 1, "glPixelZoom", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(yfactor), yfactor, 2, "glPixelZoom", "GLfloat");
- glPixelZoom(XEN_TO_C_GLfloat(xfactor), XEN_TO_C_GLfloat(yfactor));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(xfactor), xfactor, 1, "glPixelZoom", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(yfactor), yfactor, 2, "glPixelZoom", "GLfloat");
+ glPixelZoom(Xen_to_C_GLfloat(xfactor), Xen_to_C_GLfloat(yfactor));
+ return(Xen_false);
}
-static XEN gxg_glPixelStoref(XEN pname, XEN param)
+static Xen gxg_glPixelStoref(Xen pname, Xen param)
{
#define H_glPixelStoref "void glPixelStoref(GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glPixelStoref", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 2, "glPixelStoref", "GLfloat");
- glPixelStoref(XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glPixelStoref", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 2, "glPixelStoref", "GLfloat");
+ glPixelStoref(Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glPixelStorei(XEN pname, XEN param)
+static Xen gxg_glPixelStorei(Xen pname, Xen param)
{
#define H_glPixelStorei "void glPixelStorei(GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glPixelStorei", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 2, "glPixelStorei", "GLint");
- glPixelStorei(XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glPixelStorei", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 2, "glPixelStorei", "GLint");
+ glPixelStorei(Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glPixelTransferf(XEN pname, XEN param)
+static Xen gxg_glPixelTransferf(Xen pname, Xen param)
{
#define H_glPixelTransferf "void glPixelTransferf(GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glPixelTransferf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 2, "glPixelTransferf", "GLfloat");
- glPixelTransferf(XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glPixelTransferf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 2, "glPixelTransferf", "GLfloat");
+ glPixelTransferf(Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glPixelTransferi(XEN pname, XEN param)
+static Xen gxg_glPixelTransferi(Xen pname, Xen param)
{
#define H_glPixelTransferi "void glPixelTransferi(GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glPixelTransferi", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 2, "glPixelTransferi", "GLint");
- glPixelTransferi(XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glPixelTransferi", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 2, "glPixelTransferi", "GLint");
+ glPixelTransferi(Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glGetPixelMapfv(XEN map, XEN values)
+static Xen gxg_glGetPixelMapfv(Xen map, Xen values)
{
#define H_glGetPixelMapfv "void glGetPixelMapfv(GLenum map, GLfloat* [values])"
GLfloat ref_values[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(map), map, 1, "glGetPixelMapfv", "GLenum");
- glGetPixelMapfv(XEN_TO_C_GLenum(map), ref_values);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_values[0])));
+ Xen_check_type(Xen_is_GLenum(map), map, 1, "glGetPixelMapfv", "GLenum");
+ glGetPixelMapfv(Xen_to_C_GLenum(map), ref_values);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_values[0])));
}
-static XEN gxg_glGetPixelMapuiv(XEN map, XEN values)
+static Xen gxg_glGetPixelMapuiv(Xen map, Xen values)
{
#define H_glGetPixelMapuiv "void glGetPixelMapuiv(GLenum map, GLuint* [values])"
GLuint ref_values[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(map), map, 1, "glGetPixelMapuiv", "GLenum");
- glGetPixelMapuiv(XEN_TO_C_GLenum(map), ref_values);
- return(XEN_LIST_1(C_TO_XEN_GLuint(ref_values[0])));
+ Xen_check_type(Xen_is_GLenum(map), map, 1, "glGetPixelMapuiv", "GLenum");
+ glGetPixelMapuiv(Xen_to_C_GLenum(map), ref_values);
+ return(Xen_list_1(C_to_Xen_GLuint(ref_values[0])));
}
-static XEN gxg_glGetPixelMapusv(XEN map, XEN values)
+static Xen gxg_glGetPixelMapusv(Xen map, Xen values)
{
#define H_glGetPixelMapusv "void glGetPixelMapusv(GLenum map, GLushort* [values])"
GLushort ref_values[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(map), map, 1, "glGetPixelMapusv", "GLenum");
- glGetPixelMapusv(XEN_TO_C_GLenum(map), ref_values);
- return(XEN_LIST_1(C_TO_XEN_GLushort(ref_values[0])));
+ Xen_check_type(Xen_is_GLenum(map), map, 1, "glGetPixelMapusv", "GLenum");
+ glGetPixelMapusv(Xen_to_C_GLenum(map), ref_values);
+ return(Xen_list_1(C_to_Xen_GLushort(ref_values[0])));
}
-static XEN gxg_glBitmap(XEN width, XEN height, XEN xorig, XEN yorig, XEN xmove, XEN ymove, XEN bitmap)
+static Xen gxg_glBitmap(Xen width, Xen height, Xen xorig, Xen yorig, Xen xmove, Xen ymove, Xen bitmap)
{
#define H_glBitmap "void glBitmap(GLsizei width, GLsizei height, GLfloat xorig, GLfloat yorig, GLfloat xmove, \
GLfloat ymove, GLubyte* bitmap)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 1, "glBitmap", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 2, "glBitmap", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(xorig), xorig, 3, "glBitmap", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(yorig), yorig, 4, "glBitmap", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(xmove), xmove, 5, "glBitmap", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(ymove), ymove, 6, "glBitmap", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLubyte__P(bitmap), bitmap, 7, "glBitmap", "GLubyte*");
- glBitmap(XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height), XEN_TO_C_GLfloat(xorig), XEN_TO_C_GLfloat(yorig), XEN_TO_C_GLfloat(xmove),
- XEN_TO_C_GLfloat(ymove), XEN_TO_C_GLubyte_(bitmap));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLsizei(width), width, 1, "glBitmap", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 2, "glBitmap", "GLsizei");
+ Xen_check_type(Xen_is_GLfloat(xorig), xorig, 3, "glBitmap", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(yorig), yorig, 4, "glBitmap", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(xmove), xmove, 5, "glBitmap", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(ymove), ymove, 6, "glBitmap", "GLfloat");
+ Xen_check_type(Xen_is_GLubyte_(bitmap), bitmap, 7, "glBitmap", "GLubyte*");
+ glBitmap(Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height), Xen_to_C_GLfloat(xorig), Xen_to_C_GLfloat(yorig), Xen_to_C_GLfloat(xmove),
+ Xen_to_C_GLfloat(ymove), Xen_to_C_GLubyte_(bitmap));
+ return(Xen_false);
}
-static XEN gxg_glReadPixels(XEN x, XEN y, XEN width, XEN height, XEN format, XEN type, XEN pixels)
+static Xen gxg_glReadPixels(Xen x, Xen y, Xen width, Xen height, Xen format, Xen type, Xen pixels)
{
#define H_glReadPixels "void glReadPixels(GLint x, GLint y, GLsizei width, GLsizei height, GLenum format, \
GLenum type, GLvoid* pixels)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glReadPixels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glReadPixels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "glReadPixels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "glReadPixels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 5, "glReadPixels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 6, "glReadPixels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pixels), pixels, 7, "glReadPixels", "GLvoid*");
- glReadPixels(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height), XEN_TO_C_GLenum(format),
- XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(pixels));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glReadPixels", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glReadPixels", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "glReadPixels", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "glReadPixels", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 5, "glReadPixels", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 6, "glReadPixels", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(pixels), pixels, 7, "glReadPixels", "GLvoid*");
+ glReadPixels(Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height), Xen_to_C_GLenum(format),
+ Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(pixels));
+ return(Xen_false);
}
-static XEN gxg_glDrawPixels(XEN width, XEN height, XEN format, XEN type, XEN pixels)
+static Xen gxg_glDrawPixels(Xen width, Xen height, Xen format, Xen type, Xen pixels)
{
#define H_glDrawPixels "void glDrawPixels(GLsizei width, GLsizei height, GLenum format, GLenum type, \
GLvoid* pixels)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 1, "glDrawPixels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 2, "glDrawPixels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 3, "glDrawPixels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 4, "glDrawPixels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pixels), pixels, 5, "glDrawPixels", "GLvoid*");
- glDrawPixels(XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(pixels));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLsizei(width), width, 1, "glDrawPixels", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 2, "glDrawPixels", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 3, "glDrawPixels", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 4, "glDrawPixels", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(pixels), pixels, 5, "glDrawPixels", "GLvoid*");
+ glDrawPixels(Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(pixels));
+ return(Xen_false);
}
-static XEN gxg_glCopyPixels(XEN x, XEN y, XEN width, XEN height, XEN type)
+static Xen gxg_glCopyPixels(Xen x, Xen y, Xen width, Xen height, Xen type)
{
#define H_glCopyPixels "void glCopyPixels(GLint x, GLint y, GLsizei width, GLsizei height, GLenum type)"
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 1, "glCopyPixels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 2, "glCopyPixels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "glCopyPixels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "glCopyPixels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 5, "glCopyPixels", "GLenum");
- glCopyPixels(XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height), XEN_TO_C_GLenum(type));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(x), x, 1, "glCopyPixels", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 2, "glCopyPixels", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "glCopyPixels", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "glCopyPixels", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(type), type, 5, "glCopyPixels", "GLenum");
+ glCopyPixels(Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height), Xen_to_C_GLenum(type));
+ return(Xen_false);
}
-static XEN gxg_glStencilFunc(XEN func, XEN ref, XEN mask)
+static Xen gxg_glStencilFunc(Xen func, Xen ref, Xen mask)
{
#define H_glStencilFunc "void glStencilFunc(GLenum func, GLint ref, GLuint mask)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(func), func, 1, "glStencilFunc", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(ref), ref, 2, "glStencilFunc", "GLint");
- XEN_ASSERT_TYPE(XEN_GLuint_P(mask), mask, 3, "glStencilFunc", "GLuint");
- glStencilFunc(XEN_TO_C_GLenum(func), XEN_TO_C_GLint(ref), XEN_TO_C_GLuint(mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(func), func, 1, "glStencilFunc", "GLenum");
+ Xen_check_type(Xen_is_GLint(ref), ref, 2, "glStencilFunc", "GLint");
+ Xen_check_type(Xen_is_GLuint(mask), mask, 3, "glStencilFunc", "GLuint");
+ glStencilFunc(Xen_to_C_GLenum(func), Xen_to_C_GLint(ref), Xen_to_C_GLuint(mask));
+ return(Xen_false);
}
-static XEN gxg_glStencilMask(XEN mask)
+static Xen gxg_glStencilMask(Xen mask)
{
#define H_glStencilMask "void glStencilMask(GLuint mask)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(mask), mask, 1, "glStencilMask", "GLuint");
- glStencilMask(XEN_TO_C_GLuint(mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(mask), mask, 1, "glStencilMask", "GLuint");
+ glStencilMask(Xen_to_C_GLuint(mask));
+ return(Xen_false);
}
-static XEN gxg_glStencilOp(XEN fail, XEN zfail, XEN zpass)
+static Xen gxg_glStencilOp(Xen fail, Xen zfail, Xen zpass)
{
#define H_glStencilOp "void glStencilOp(GLenum fail, GLenum zfail, GLenum zpass)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(fail), fail, 1, "glStencilOp", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(zfail), zfail, 2, "glStencilOp", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(zpass), zpass, 3, "glStencilOp", "GLenum");
- glStencilOp(XEN_TO_C_GLenum(fail), XEN_TO_C_GLenum(zfail), XEN_TO_C_GLenum(zpass));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(fail), fail, 1, "glStencilOp", "GLenum");
+ Xen_check_type(Xen_is_GLenum(zfail), zfail, 2, "glStencilOp", "GLenum");
+ Xen_check_type(Xen_is_GLenum(zpass), zpass, 3, "glStencilOp", "GLenum");
+ glStencilOp(Xen_to_C_GLenum(fail), Xen_to_C_GLenum(zfail), Xen_to_C_GLenum(zpass));
+ return(Xen_false);
}
-static XEN gxg_glClearStencil(XEN s)
+static Xen gxg_glClearStencil(Xen s)
{
#define H_glClearStencil "void glClearStencil(GLint s)"
- XEN_ASSERT_TYPE(XEN_GLint_P(s), s, 1, "glClearStencil", "GLint");
- glClearStencil(XEN_TO_C_GLint(s));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(s), s, 1, "glClearStencil", "GLint");
+ glClearStencil(Xen_to_C_GLint(s));
+ return(Xen_false);
}
-static XEN gxg_glTexGend(XEN coord, XEN pname, XEN param)
+static Xen gxg_glTexGend(Xen coord, Xen pname, Xen param)
{
#define H_glTexGend "void glTexGend(GLenum coord, GLenum pname, GLdouble param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(coord), coord, 1, "glTexGend", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glTexGend", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(param), param, 3, "glTexGend", "GLdouble");
- glTexGend(XEN_TO_C_GLenum(coord), XEN_TO_C_GLenum(pname), XEN_TO_C_GLdouble(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(coord), coord, 1, "glTexGend", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glTexGend", "GLenum");
+ Xen_check_type(Xen_is_GLdouble(param), param, 3, "glTexGend", "GLdouble");
+ glTexGend(Xen_to_C_GLenum(coord), Xen_to_C_GLenum(pname), Xen_to_C_GLdouble(param));
+ return(Xen_false);
}
-static XEN gxg_glTexGenf(XEN coord, XEN pname, XEN param)
+static Xen gxg_glTexGenf(Xen coord, Xen pname, Xen param)
{
#define H_glTexGenf "void glTexGenf(GLenum coord, GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(coord), coord, 1, "glTexGenf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glTexGenf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 3, "glTexGenf", "GLfloat");
- glTexGenf(XEN_TO_C_GLenum(coord), XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(coord), coord, 1, "glTexGenf", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glTexGenf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 3, "glTexGenf", "GLfloat");
+ glTexGenf(Xen_to_C_GLenum(coord), Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glTexGeni(XEN coord, XEN pname, XEN param)
+static Xen gxg_glTexGeni(Xen coord, Xen pname, Xen param)
{
#define H_glTexGeni "void glTexGeni(GLenum coord, GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(coord), coord, 1, "glTexGeni", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glTexGeni", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 3, "glTexGeni", "GLint");
- glTexGeni(XEN_TO_C_GLenum(coord), XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(coord), coord, 1, "glTexGeni", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glTexGeni", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 3, "glTexGeni", "GLint");
+ glTexGeni(Xen_to_C_GLenum(coord), Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glGetTexGendv(XEN coord, XEN pname, XEN params)
+static Xen gxg_glGetTexGendv(Xen coord, Xen pname, Xen params)
{
#define H_glGetTexGendv "void glGetTexGendv(GLenum coord, GLenum pname, GLdouble* [params])"
GLdouble ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(coord), coord, 1, "glGetTexGendv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetTexGendv", "GLenum");
- glGetTexGendv(XEN_TO_C_GLenum(coord), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLdouble(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(coord), coord, 1, "glGetTexGendv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetTexGendv", "GLenum");
+ glGetTexGendv(Xen_to_C_GLenum(coord), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLdouble(ref_params[0])));
}
-static XEN gxg_glGetTexGenfv(XEN coord, XEN pname, XEN params)
+static Xen gxg_glGetTexGenfv(Xen coord, Xen pname, Xen params)
{
#define H_glGetTexGenfv "void glGetTexGenfv(GLenum coord, GLenum pname, GLfloat* [params])"
GLfloat ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(coord), coord, 1, "glGetTexGenfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetTexGenfv", "GLenum");
- glGetTexGenfv(XEN_TO_C_GLenum(coord), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(coord), coord, 1, "glGetTexGenfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetTexGenfv", "GLenum");
+ glGetTexGenfv(Xen_to_C_GLenum(coord), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_params[0])));
}
-static XEN gxg_glGetTexGeniv(XEN coord, XEN pname, XEN params)
+static Xen gxg_glGetTexGeniv(Xen coord, Xen pname, Xen params)
{
#define H_glGetTexGeniv "void glGetTexGeniv(GLenum coord, GLenum pname, GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(coord), coord, 1, "glGetTexGeniv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetTexGeniv", "GLenum");
- glGetTexGeniv(XEN_TO_C_GLenum(coord), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(coord), coord, 1, "glGetTexGeniv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetTexGeniv", "GLenum");
+ glGetTexGeniv(Xen_to_C_GLenum(coord), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glTexEnvf(XEN target, XEN pname, XEN param)
+static Xen gxg_glTexEnvf(Xen target, Xen pname, Xen param)
{
#define H_glTexEnvf "void glTexEnvf(GLenum target, GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexEnvf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glTexEnvf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 3, "glTexEnvf", "GLfloat");
- glTexEnvf(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexEnvf", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glTexEnvf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 3, "glTexEnvf", "GLfloat");
+ glTexEnvf(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glTexEnvi(XEN target, XEN pname, XEN param)
+static Xen gxg_glTexEnvi(Xen target, Xen pname, Xen param)
{
#define H_glTexEnvi "void glTexEnvi(GLenum target, GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexEnvi", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glTexEnvi", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 3, "glTexEnvi", "GLint");
- glTexEnvi(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexEnvi", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glTexEnvi", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 3, "glTexEnvi", "GLint");
+ glTexEnvi(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glGetTexEnvfv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetTexEnvfv(Xen target, Xen pname, Xen params)
{
#define H_glGetTexEnvfv "void glGetTexEnvfv(GLenum target, GLenum pname, GLfloat* [params])"
GLfloat ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetTexEnvfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetTexEnvfv", "GLenum");
- glGetTexEnvfv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetTexEnvfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetTexEnvfv", "GLenum");
+ glGetTexEnvfv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_params[0])));
}
-static XEN gxg_glGetTexEnviv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetTexEnviv(Xen target, Xen pname, Xen params)
{
#define H_glGetTexEnviv "void glGetTexEnviv(GLenum target, GLenum pname, GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetTexEnviv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetTexEnviv", "GLenum");
- glGetTexEnviv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetTexEnviv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetTexEnviv", "GLenum");
+ glGetTexEnviv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glTexParameterf(XEN target, XEN pname, XEN param)
+static Xen gxg_glTexParameterf(Xen target, Xen pname, Xen param)
{
#define H_glTexParameterf "void glTexParameterf(GLenum target, GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexParameterf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glTexParameterf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 3, "glTexParameterf", "GLfloat");
- glTexParameterf(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexParameterf", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glTexParameterf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 3, "glTexParameterf", "GLfloat");
+ glTexParameterf(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glTexParameteri(XEN target, XEN pname, XEN param)
+static Xen gxg_glTexParameteri(Xen target, Xen pname, Xen param)
{
#define H_glTexParameteri "void glTexParameteri(GLenum target, GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexParameteri", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glTexParameteri", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 3, "glTexParameteri", "GLint");
- glTexParameteri(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexParameteri", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glTexParameteri", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 3, "glTexParameteri", "GLint");
+ glTexParameteri(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glGetTexParameterfv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetTexParameterfv(Xen target, Xen pname, Xen params)
{
#define H_glGetTexParameterfv "void glGetTexParameterfv(GLenum target, GLenum pname, GLfloat* [params])"
GLfloat ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetTexParameterfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetTexParameterfv", "GLenum");
- glGetTexParameterfv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetTexParameterfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetTexParameterfv", "GLenum");
+ glGetTexParameterfv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_params[0])));
}
-static XEN gxg_glGetTexParameteriv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetTexParameteriv(Xen target, Xen pname, Xen params)
{
#define H_glGetTexParameteriv "void glGetTexParameteriv(GLenum target, GLenum pname, GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetTexParameteriv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetTexParameteriv", "GLenum");
- glGetTexParameteriv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetTexParameteriv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetTexParameteriv", "GLenum");
+ glGetTexParameteriv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glGetTexLevelParameterfv(XEN target, XEN level, XEN pname, XEN params)
+static Xen gxg_glGetTexLevelParameterfv(Xen target, Xen level, Xen pname, Xen params)
{
#define H_glGetTexLevelParameterfv "void glGetTexLevelParameterfv(GLenum target, GLint level, GLenum pname, \
GLfloat* [params])"
GLfloat ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetTexLevelParameterfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glGetTexLevelParameterfv", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 3, "glGetTexLevelParameterfv", "GLenum");
- glGetTexLevelParameterfv(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetTexLevelParameterfv", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glGetTexLevelParameterfv", "GLint");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 3, "glGetTexLevelParameterfv", "GLenum");
+ glGetTexLevelParameterfv(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_params[0])));
}
-static XEN gxg_glGetTexLevelParameteriv(XEN target, XEN level, XEN pname, XEN params)
+static Xen gxg_glGetTexLevelParameteriv(Xen target, Xen level, Xen pname, Xen params)
{
#define H_glGetTexLevelParameteriv "void glGetTexLevelParameteriv(GLenum target, GLint level, GLenum pname, \
GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetTexLevelParameteriv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glGetTexLevelParameteriv", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 3, "glGetTexLevelParameteriv", "GLenum");
- glGetTexLevelParameteriv(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetTexLevelParameteriv", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glGetTexLevelParameteriv", "GLint");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 3, "glGetTexLevelParameteriv", "GLenum");
+ glGetTexLevelParameteriv(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glTexImage1D(XEN target, XEN level, XEN internalFormat, XEN width, XEN border, XEN format, XEN type, XEN pixels)
+static Xen gxg_glTexImage1D(Xen arglist)
{
#define H_glTexImage1D "void glTexImage1D(GLenum target, GLint level, GLint internalFormat, GLsizei width, \
GLint border, GLenum format, GLenum type, GLvoid* pixels)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glTexImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 3, "glTexImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 4, "glTexImage1D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLint_P(border), border, 5, "glTexImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 6, "glTexImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 7, "glTexImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pixels), pixels, 8, "glTexImage1D", "GLvoid*");
- glTexImage1D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width), XEN_TO_C_GLint(border),
- XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(pixels));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glTexImage2D(XEN target, XEN level, XEN internalFormat, XEN width, XEN height, XEN border, XEN format, XEN type, XEN pixels)
+ Xen target, level, internalFormat, width, border, format, type, pixels;
+ target = Xen_list_ref(arglist, 0);
+ level = Xen_list_ref(arglist, 1);
+ internalFormat = Xen_list_ref(arglist, 2);
+ width = Xen_list_ref(arglist, 3);
+ border = Xen_list_ref(arglist, 4);
+ format = Xen_list_ref(arglist, 5);
+ type = Xen_list_ref(arglist, 6);
+ pixels = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glTexImage1D", "GLint");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 3, "glTexImage1D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 4, "glTexImage1D", "GLsizei");
+ Xen_check_type(Xen_is_GLint(border), border, 5, "glTexImage1D", "GLint");
+ Xen_check_type(Xen_is_GLenum(format), format, 6, "glTexImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 7, "glTexImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(pixels), pixels, 8, "glTexImage1D", "GLvoid*");
+ glTexImage1D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width), Xen_to_C_GLint(border),
+ Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(pixels));
+ return(Xen_false);
+}
+
+static Xen gxg_glTexImage2D(Xen arglist)
{
#define H_glTexImage2D "void glTexImage2D(GLenum target, GLint level, GLint internalFormat, GLsizei width, \
GLsizei height, GLint border, GLenum format, GLenum type, GLvoid* pixels)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glTexImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 3, "glTexImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 4, "glTexImage2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 5, "glTexImage2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLint_P(border), border, 6, "glTexImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 7, "glTexImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 8, "glTexImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pixels), pixels, 9, "glTexImage2D", "GLvoid*");
- glTexImage2D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height),
- XEN_TO_C_GLint(border), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(pixels));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glGenTextures(XEN n, XEN textures)
+ Xen target, level, internalFormat, width, height, border, format, type, pixels;
+ target = Xen_list_ref(arglist, 0);
+ level = Xen_list_ref(arglist, 1);
+ internalFormat = Xen_list_ref(arglist, 2);
+ width = Xen_list_ref(arglist, 3);
+ height = Xen_list_ref(arglist, 4);
+ border = Xen_list_ref(arglist, 5);
+ format = Xen_list_ref(arglist, 6);
+ type = Xen_list_ref(arglist, 7);
+ pixels = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glTexImage2D", "GLint");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 3, "glTexImage2D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 4, "glTexImage2D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 5, "glTexImage2D", "GLsizei");
+ Xen_check_type(Xen_is_GLint(border), border, 6, "glTexImage2D", "GLint");
+ Xen_check_type(Xen_is_GLenum(format), format, 7, "glTexImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 8, "glTexImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(pixels), pixels, 9, "glTexImage2D", "GLvoid*");
+ glTexImage2D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height),
+ Xen_to_C_GLint(border), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(pixels));
+ return(Xen_false);
+}
+
+static Xen gxg_glGenTextures(Xen n, Xen textures)
{
#define H_glGenTextures "void glGenTextures(GLsizei n, GLuint* textures)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(n), n, 1, "glGenTextures", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLuint__P(textures), textures, 2, "glGenTextures", "GLuint*");
- glGenTextures(XEN_TO_C_GLsizei(n), XEN_TO_C_GLuint_(textures));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLsizei(n), n, 1, "glGenTextures", "GLsizei");
+ Xen_check_type(Xen_is_GLuint_(textures), textures, 2, "glGenTextures", "GLuint*");
+ glGenTextures(Xen_to_C_GLsizei(n), Xen_to_C_GLuint_(textures));
+ return(Xen_false);
}
-static XEN gxg_glDeleteTextures(XEN n, XEN textures)
+static Xen gxg_glDeleteTextures(Xen n, Xen textures)
{
#define H_glDeleteTextures "void glDeleteTextures(GLsizei n, GLuint* textures)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(n), n, 1, "glDeleteTextures", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLuint__P(textures), textures, 2, "glDeleteTextures", "GLuint*");
- glDeleteTextures(XEN_TO_C_GLsizei(n), XEN_TO_C_GLuint_(textures));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLsizei(n), n, 1, "glDeleteTextures", "GLsizei");
+ Xen_check_type(Xen_is_GLuint_(textures), textures, 2, "glDeleteTextures", "GLuint*");
+ glDeleteTextures(Xen_to_C_GLsizei(n), Xen_to_C_GLuint_(textures));
+ return(Xen_false);
}
-static XEN gxg_glBindTexture(XEN target, XEN texture)
+static Xen gxg_glBindTexture(Xen target, Xen texture)
{
#define H_glBindTexture "void glBindTexture(GLenum target, GLuint texture)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glBindTexture", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLuint_P(texture), texture, 2, "glBindTexture", "GLuint");
- glBindTexture(XEN_TO_C_GLenum(target), XEN_TO_C_GLuint(texture));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glBindTexture", "GLenum");
+ Xen_check_type(Xen_is_GLuint(texture), texture, 2, "glBindTexture", "GLuint");
+ glBindTexture(Xen_to_C_GLenum(target), Xen_to_C_GLuint(texture));
+ return(Xen_false);
}
-static XEN gxg_glAreTexturesResident(XEN n, XEN textures, XEN residences)
+static Xen gxg_glAreTexturesResident(Xen n, Xen textures, Xen residences)
{
#define H_glAreTexturesResident "GLboolean glAreTexturesResident(GLsizei n, GLuint* textures, GLboolean* residences)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(n), n, 1, "glAreTexturesResident", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLuint__P(textures), textures, 2, "glAreTexturesResident", "GLuint*");
- XEN_ASSERT_TYPE(XEN_GLboolean__P(residences), residences, 3, "glAreTexturesResident", "GLboolean*");
- return(C_TO_XEN_GLboolean(glAreTexturesResident(XEN_TO_C_GLsizei(n), XEN_TO_C_GLuint_(textures), XEN_TO_C_GLboolean_(residences))));
+ Xen_check_type(Xen_is_GLsizei(n), n, 1, "glAreTexturesResident", "GLsizei");
+ Xen_check_type(Xen_is_GLuint_(textures), textures, 2, "glAreTexturesResident", "GLuint*");
+ Xen_check_type(Xen_is_GLboolean_(residences), residences, 3, "glAreTexturesResident", "GLboolean*");
+ return(C_to_Xen_GLboolean(glAreTexturesResident(Xen_to_C_GLsizei(n), Xen_to_C_GLuint_(textures), Xen_to_C_GLboolean_(residences))));
}
-static XEN gxg_glIsTexture(XEN texture)
+static Xen gxg_glIsTexture(Xen texture)
{
#define H_glIsTexture "GLboolean glIsTexture(GLuint texture)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(texture), texture, 1, "glIsTexture", "GLuint");
- return(C_TO_XEN_GLboolean(glIsTexture(XEN_TO_C_GLuint(texture))));
+ Xen_check_type(Xen_is_GLuint(texture), texture, 1, "glIsTexture", "GLuint");
+ return(C_to_Xen_GLboolean(glIsTexture(Xen_to_C_GLuint(texture))));
}
-static XEN gxg_glTexSubImage1D(XEN target, XEN level, XEN xoffset, XEN width, XEN format, XEN type, XEN pixels)
+static Xen gxg_glTexSubImage1D(Xen target, Xen level, Xen xoffset, Xen width, Xen format, Xen type, Xen pixels)
{
#define H_glTexSubImage1D "void glTexSubImage1D(GLenum target, GLint level, GLint xoffset, GLsizei width, \
GLenum format, GLenum type, GLvoid* pixels)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexSubImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glTexSubImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(xoffset), xoffset, 3, "glTexSubImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 4, "glTexSubImage1D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 5, "glTexSubImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 6, "glTexSubImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pixels), pixels, 7, "glTexSubImage1D", "GLvoid*");
- glTexSubImage1D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(xoffset), XEN_TO_C_GLsizei(width), XEN_TO_C_GLenum(format),
- XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(pixels));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexSubImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glTexSubImage1D", "GLint");
+ Xen_check_type(Xen_is_GLint(xoffset), xoffset, 3, "glTexSubImage1D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 4, "glTexSubImage1D", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 5, "glTexSubImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 6, "glTexSubImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(pixels), pixels, 7, "glTexSubImage1D", "GLvoid*");
+ glTexSubImage1D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(xoffset), Xen_to_C_GLsizei(width), Xen_to_C_GLenum(format),
+ Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(pixels));
+ return(Xen_false);
}
-static XEN gxg_glTexSubImage2D(XEN target, XEN level, XEN xoffset, XEN yoffset, XEN width, XEN height, XEN format, XEN type, XEN pixels)
+static Xen gxg_glTexSubImage2D(Xen arglist)
{
#define H_glTexSubImage2D "void glTexSubImage2D(GLenum target, GLint level, GLint xoffset, GLint yoffset, \
GLsizei width, GLsizei height, GLenum format, GLenum type, GLvoid* pixels)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexSubImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glTexSubImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(xoffset), xoffset, 3, "glTexSubImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(yoffset), yoffset, 4, "glTexSubImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 5, "glTexSubImage2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 6, "glTexSubImage2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 7, "glTexSubImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 8, "glTexSubImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pixels), pixels, 9, "glTexSubImage2D", "GLvoid*");
- glTexSubImage2D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(xoffset), XEN_TO_C_GLint(yoffset), XEN_TO_C_GLsizei(width),
- XEN_TO_C_GLsizei(height), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(pixels));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glCopyTexImage1D(XEN target, XEN level, XEN internalformat, XEN x, XEN y, XEN width, XEN border)
+ Xen target, level, xoffset, yoffset, width, height, format, type, pixels;
+ target = Xen_list_ref(arglist, 0);
+ level = Xen_list_ref(arglist, 1);
+ xoffset = Xen_list_ref(arglist, 2);
+ yoffset = Xen_list_ref(arglist, 3);
+ width = Xen_list_ref(arglist, 4);
+ height = Xen_list_ref(arglist, 5);
+ format = Xen_list_ref(arglist, 6);
+ type = Xen_list_ref(arglist, 7);
+ pixels = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexSubImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glTexSubImage2D", "GLint");
+ Xen_check_type(Xen_is_GLint(xoffset), xoffset, 3, "glTexSubImage2D", "GLint");
+ Xen_check_type(Xen_is_GLint(yoffset), yoffset, 4, "glTexSubImage2D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 5, "glTexSubImage2D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 6, "glTexSubImage2D", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 7, "glTexSubImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 8, "glTexSubImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(pixels), pixels, 9, "glTexSubImage2D", "GLvoid*");
+ glTexSubImage2D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(xoffset), Xen_to_C_GLint(yoffset), Xen_to_C_GLsizei(width),
+ Xen_to_C_GLsizei(height), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(pixels));
+ return(Xen_false);
+}
+
+static Xen gxg_glCopyTexImage1D(Xen target, Xen level, Xen internalformat, Xen x, Xen y, Xen width, Xen border)
{
#define H_glCopyTexImage1D "void glCopyTexImage1D(GLenum target, GLint level, GLenum internalformat, \
GLint x, GLint y, GLsizei width, GLint border)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyTexImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glCopyTexImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 3, "glCopyTexImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 4, "glCopyTexImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 5, "glCopyTexImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 6, "glCopyTexImage1D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLint_P(border), border, 7, "glCopyTexImage1D", "GLint");
- glCopyTexImage1D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLint(x), XEN_TO_C_GLint(y),
- XEN_TO_C_GLsizei(width), XEN_TO_C_GLint(border));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyTexImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glCopyTexImage1D", "GLint");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 3, "glCopyTexImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLint(x), x, 4, "glCopyTexImage1D", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 5, "glCopyTexImage1D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 6, "glCopyTexImage1D", "GLsizei");
+ Xen_check_type(Xen_is_GLint(border), border, 7, "glCopyTexImage1D", "GLint");
+ glCopyTexImage1D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLenum(internalformat), Xen_to_C_GLint(x), Xen_to_C_GLint(y),
+ Xen_to_C_GLsizei(width), Xen_to_C_GLint(border));
+ return(Xen_false);
}
-static XEN gxg_glCopyTexImage2D(XEN target, XEN level, XEN internalformat, XEN x, XEN y, XEN width, XEN height, XEN border)
+static Xen gxg_glCopyTexImage2D(Xen arglist)
{
#define H_glCopyTexImage2D "void glCopyTexImage2D(GLenum target, GLint level, GLenum internalformat, \
GLint x, GLint y, GLsizei width, GLsizei height, GLint border)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyTexImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glCopyTexImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 3, "glCopyTexImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 4, "glCopyTexImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 5, "glCopyTexImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 6, "glCopyTexImage2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 7, "glCopyTexImage2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLint_P(border), border, 8, "glCopyTexImage2D", "GLint");
- glCopyTexImage2D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLint(x), XEN_TO_C_GLint(y),
- XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height), XEN_TO_C_GLint(border));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glCopyTexSubImage1D(XEN target, XEN level, XEN xoffset, XEN x, XEN y, XEN width)
+ Xen target, level, internalformat, x, y, width, height, border;
+ target = Xen_list_ref(arglist, 0);
+ level = Xen_list_ref(arglist, 1);
+ internalformat = Xen_list_ref(arglist, 2);
+ x = Xen_list_ref(arglist, 3);
+ y = Xen_list_ref(arglist, 4);
+ width = Xen_list_ref(arglist, 5);
+ height = Xen_list_ref(arglist, 6);
+ border = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyTexImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glCopyTexImage2D", "GLint");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 3, "glCopyTexImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLint(x), x, 4, "glCopyTexImage2D", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 5, "glCopyTexImage2D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 6, "glCopyTexImage2D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 7, "glCopyTexImage2D", "GLsizei");
+ Xen_check_type(Xen_is_GLint(border), border, 8, "glCopyTexImage2D", "GLint");
+ glCopyTexImage2D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLenum(internalformat), Xen_to_C_GLint(x), Xen_to_C_GLint(y),
+ Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height), Xen_to_C_GLint(border));
+ return(Xen_false);
+}
+
+static Xen gxg_glCopyTexSubImage1D(Xen target, Xen level, Xen xoffset, Xen x, Xen y, Xen width)
{
#define H_glCopyTexSubImage1D "void glCopyTexSubImage1D(GLenum target, GLint level, GLint xoffset, \
GLint x, GLint y, GLsizei width)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyTexSubImage1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glCopyTexSubImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(xoffset), xoffset, 3, "glCopyTexSubImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 4, "glCopyTexSubImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 5, "glCopyTexSubImage1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 6, "glCopyTexSubImage1D", "GLsizei");
- glCopyTexSubImage1D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(xoffset), XEN_TO_C_GLint(x), XEN_TO_C_GLint(y),
- XEN_TO_C_GLsizei(width));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyTexSubImage1D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glCopyTexSubImage1D", "GLint");
+ Xen_check_type(Xen_is_GLint(xoffset), xoffset, 3, "glCopyTexSubImage1D", "GLint");
+ Xen_check_type(Xen_is_GLint(x), x, 4, "glCopyTexSubImage1D", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 5, "glCopyTexSubImage1D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 6, "glCopyTexSubImage1D", "GLsizei");
+ glCopyTexSubImage1D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(xoffset), Xen_to_C_GLint(x), Xen_to_C_GLint(y),
+ Xen_to_C_GLsizei(width));
+ return(Xen_false);
}
-static XEN gxg_glCopyTexSubImage2D(XEN target, XEN level, XEN xoffset, XEN yoffset, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_glCopyTexSubImage2D(Xen arglist)
{
#define H_glCopyTexSubImage2D "void glCopyTexSubImage2D(GLenum target, GLint level, GLint xoffset, \
GLint yoffset, GLint x, GLint y, GLsizei width, GLsizei height)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyTexSubImage2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glCopyTexSubImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(xoffset), xoffset, 3, "glCopyTexSubImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(yoffset), yoffset, 4, "glCopyTexSubImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 5, "glCopyTexSubImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 6, "glCopyTexSubImage2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 7, "glCopyTexSubImage2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 8, "glCopyTexSubImage2D", "GLsizei");
- glCopyTexSubImage2D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(xoffset), XEN_TO_C_GLint(yoffset), XEN_TO_C_GLint(x),
- XEN_TO_C_GLint(y), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glMap1d(XEN target, XEN u1, XEN u2, XEN stride, XEN order, XEN points)
+ Xen target, level, xoffset, yoffset, x, y, width, height;
+ target = Xen_list_ref(arglist, 0);
+ level = Xen_list_ref(arglist, 1);
+ xoffset = Xen_list_ref(arglist, 2);
+ yoffset = Xen_list_ref(arglist, 3);
+ x = Xen_list_ref(arglist, 4);
+ y = Xen_list_ref(arglist, 5);
+ width = Xen_list_ref(arglist, 6);
+ height = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyTexSubImage2D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glCopyTexSubImage2D", "GLint");
+ Xen_check_type(Xen_is_GLint(xoffset), xoffset, 3, "glCopyTexSubImage2D", "GLint");
+ Xen_check_type(Xen_is_GLint(yoffset), yoffset, 4, "glCopyTexSubImage2D", "GLint");
+ Xen_check_type(Xen_is_GLint(x), x, 5, "glCopyTexSubImage2D", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 6, "glCopyTexSubImage2D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 7, "glCopyTexSubImage2D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 8, "glCopyTexSubImage2D", "GLsizei");
+ glCopyTexSubImage2D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(xoffset), Xen_to_C_GLint(yoffset), Xen_to_C_GLint(x),
+ Xen_to_C_GLint(y), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height));
+ return(Xen_false);
+}
+
+static Xen gxg_glMap1d(Xen target, Xen u1, Xen u2, Xen stride, Xen order, Xen points)
{
#define H_glMap1d "void glMap1d(GLenum target, GLdouble u1, GLdouble u2, GLint stride, GLint order, \
GLdouble* points)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glMap1d", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u1), u1, 2, "glMap1d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u2), u2, 3, "glMap1d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint_P(stride), stride, 4, "glMap1d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(order), order, 5, "glMap1d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(points), points, 6, "glMap1d", "GLdouble*");
- glMap1d(XEN_TO_C_GLenum(target), XEN_TO_C_GLdouble(u1), XEN_TO_C_GLdouble(u2), XEN_TO_C_GLint(stride), XEN_TO_C_GLint(order),
- XEN_TO_C_GLdouble_(points));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glMap1d", "GLenum");
+ Xen_check_type(Xen_is_GLdouble(u1), u1, 2, "glMap1d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(u2), u2, 3, "glMap1d", "GLdouble");
+ Xen_check_type(Xen_is_GLint(stride), stride, 4, "glMap1d", "GLint");
+ Xen_check_type(Xen_is_GLint(order), order, 5, "glMap1d", "GLint");
+ Xen_check_type(Xen_is_GLdouble_(points), points, 6, "glMap1d", "GLdouble*");
+ glMap1d(Xen_to_C_GLenum(target), Xen_to_C_GLdouble(u1), Xen_to_C_GLdouble(u2), Xen_to_C_GLint(stride), Xen_to_C_GLint(order),
+ Xen_to_C_GLdouble_(points));
+ return(Xen_false);
}
-static XEN gxg_glMap1f(XEN target, XEN u1, XEN u2, XEN stride, XEN order, XEN points)
+static Xen gxg_glMap1f(Xen target, Xen u1, Xen u2, Xen stride, Xen order, Xen points)
{
#define H_glMap1f "void glMap1f(GLenum target, GLfloat u1, GLfloat u2, GLint stride, GLint order, GLfloat* points)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glMap1f", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u1), u1, 2, "glMap1f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u2), u2, 3, "glMap1f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLint_P(stride), stride, 4, "glMap1f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(order), order, 5, "glMap1f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(points), points, 6, "glMap1f", "GLfloat*");
- glMap1f(XEN_TO_C_GLenum(target), XEN_TO_C_GLfloat(u1), XEN_TO_C_GLfloat(u2), XEN_TO_C_GLint(stride), XEN_TO_C_GLint(order),
- XEN_TO_C_GLfloat_(points));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glMap1f", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(u1), u1, 2, "glMap1f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(u2), u2, 3, "glMap1f", "GLfloat");
+ Xen_check_type(Xen_is_GLint(stride), stride, 4, "glMap1f", "GLint");
+ Xen_check_type(Xen_is_GLint(order), order, 5, "glMap1f", "GLint");
+ Xen_check_type(Xen_is_GLfloat_(points), points, 6, "glMap1f", "GLfloat*");
+ glMap1f(Xen_to_C_GLenum(target), Xen_to_C_GLfloat(u1), Xen_to_C_GLfloat(u2), Xen_to_C_GLint(stride), Xen_to_C_GLint(order),
+ Xen_to_C_GLfloat_(points));
+ return(Xen_false);
}
-static XEN gxg_glMap2d(XEN arglist)
+static Xen gxg_glMap2d(Xen arglist)
{
#define H_glMap2d "void glMap2d(GLenum target, GLdouble u1, GLdouble u2, GLint ustride, GLint uorder, \
GLdouble v1, GLdouble v2, GLint vstride, GLint vorder, GLdouble* points)"
- XEN target, u1, u2, ustride, uorder, v1, v2, vstride, vorder, points;
- target = XEN_LIST_REF(arglist, 0);
- u1 = XEN_LIST_REF(arglist, 1);
- u2 = XEN_LIST_REF(arglist, 2);
- ustride = XEN_LIST_REF(arglist, 3);
- uorder = XEN_LIST_REF(arglist, 4);
- v1 = XEN_LIST_REF(arglist, 5);
- v2 = XEN_LIST_REF(arglist, 6);
- vstride = XEN_LIST_REF(arglist, 7);
- vorder = XEN_LIST_REF(arglist, 8);
- points = XEN_LIST_REF(arglist, 9);
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glMap2d", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u1), u1, 2, "glMap2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u2), u2, 3, "glMap2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint_P(ustride), ustride, 4, "glMap2d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(uorder), uorder, 5, "glMap2d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(v1), v1, 6, "glMap2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(v2), v2, 7, "glMap2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint_P(vstride), vstride, 8, "glMap2d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(vorder), vorder, 9, "glMap2d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(points), points, 10, "glMap2d", "GLdouble*");
- glMap2d(XEN_TO_C_GLenum(target), XEN_TO_C_GLdouble(u1), XEN_TO_C_GLdouble(u2), XEN_TO_C_GLint(ustride), XEN_TO_C_GLint(uorder),
- XEN_TO_C_GLdouble(v1), XEN_TO_C_GLdouble(v2), XEN_TO_C_GLint(vstride), XEN_TO_C_GLint(vorder), XEN_TO_C_GLdouble_(points));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glMap2f(XEN arglist)
+ Xen target, u1, u2, ustride, uorder, v1, v2, vstride, vorder, points;
+ target = Xen_list_ref(arglist, 0);
+ u1 = Xen_list_ref(arglist, 1);
+ u2 = Xen_list_ref(arglist, 2);
+ ustride = Xen_list_ref(arglist, 3);
+ uorder = Xen_list_ref(arglist, 4);
+ v1 = Xen_list_ref(arglist, 5);
+ v2 = Xen_list_ref(arglist, 6);
+ vstride = Xen_list_ref(arglist, 7);
+ vorder = Xen_list_ref(arglist, 8);
+ points = Xen_list_ref(arglist, 9);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glMap2d", "GLenum");
+ Xen_check_type(Xen_is_GLdouble(u1), u1, 2, "glMap2d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(u2), u2, 3, "glMap2d", "GLdouble");
+ Xen_check_type(Xen_is_GLint(ustride), ustride, 4, "glMap2d", "GLint");
+ Xen_check_type(Xen_is_GLint(uorder), uorder, 5, "glMap2d", "GLint");
+ Xen_check_type(Xen_is_GLdouble(v1), v1, 6, "glMap2d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(v2), v2, 7, "glMap2d", "GLdouble");
+ Xen_check_type(Xen_is_GLint(vstride), vstride, 8, "glMap2d", "GLint");
+ Xen_check_type(Xen_is_GLint(vorder), vorder, 9, "glMap2d", "GLint");
+ Xen_check_type(Xen_is_GLdouble_(points), points, 10, "glMap2d", "GLdouble*");
+ glMap2d(Xen_to_C_GLenum(target), Xen_to_C_GLdouble(u1), Xen_to_C_GLdouble(u2), Xen_to_C_GLint(ustride), Xen_to_C_GLint(uorder),
+ Xen_to_C_GLdouble(v1), Xen_to_C_GLdouble(v2), Xen_to_C_GLint(vstride), Xen_to_C_GLint(vorder), Xen_to_C_GLdouble_(points));
+ return(Xen_false);
+}
+
+static Xen gxg_glMap2f(Xen arglist)
{
#define H_glMap2f "void glMap2f(GLenum target, GLfloat u1, GLfloat u2, GLint ustride, GLint uorder, \
GLfloat v1, GLfloat v2, GLint vstride, GLint vorder, GLfloat* points)"
- XEN target, u1, u2, ustride, uorder, v1, v2, vstride, vorder, points;
- target = XEN_LIST_REF(arglist, 0);
- u1 = XEN_LIST_REF(arglist, 1);
- u2 = XEN_LIST_REF(arglist, 2);
- ustride = XEN_LIST_REF(arglist, 3);
- uorder = XEN_LIST_REF(arglist, 4);
- v1 = XEN_LIST_REF(arglist, 5);
- v2 = XEN_LIST_REF(arglist, 6);
- vstride = XEN_LIST_REF(arglist, 7);
- vorder = XEN_LIST_REF(arglist, 8);
- points = XEN_LIST_REF(arglist, 9);
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glMap2f", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u1), u1, 2, "glMap2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u2), u2, 3, "glMap2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLint_P(ustride), ustride, 4, "glMap2f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(uorder), uorder, 5, "glMap2f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(v1), v1, 6, "glMap2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(v2), v2, 7, "glMap2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLint_P(vstride), vstride, 8, "glMap2f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(vorder), vorder, 9, "glMap2f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(points), points, 10, "glMap2f", "GLfloat*");
- glMap2f(XEN_TO_C_GLenum(target), XEN_TO_C_GLfloat(u1), XEN_TO_C_GLfloat(u2), XEN_TO_C_GLint(ustride), XEN_TO_C_GLint(uorder),
- XEN_TO_C_GLfloat(v1), XEN_TO_C_GLfloat(v2), XEN_TO_C_GLint(vstride), XEN_TO_C_GLint(vorder), XEN_TO_C_GLfloat_(points));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glGetMapdv(XEN target, XEN query, XEN v)
+ Xen target, u1, u2, ustride, uorder, v1, v2, vstride, vorder, points;
+ target = Xen_list_ref(arglist, 0);
+ u1 = Xen_list_ref(arglist, 1);
+ u2 = Xen_list_ref(arglist, 2);
+ ustride = Xen_list_ref(arglist, 3);
+ uorder = Xen_list_ref(arglist, 4);
+ v1 = Xen_list_ref(arglist, 5);
+ v2 = Xen_list_ref(arglist, 6);
+ vstride = Xen_list_ref(arglist, 7);
+ vorder = Xen_list_ref(arglist, 8);
+ points = Xen_list_ref(arglist, 9);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glMap2f", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(u1), u1, 2, "glMap2f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(u2), u2, 3, "glMap2f", "GLfloat");
+ Xen_check_type(Xen_is_GLint(ustride), ustride, 4, "glMap2f", "GLint");
+ Xen_check_type(Xen_is_GLint(uorder), uorder, 5, "glMap2f", "GLint");
+ Xen_check_type(Xen_is_GLfloat(v1), v1, 6, "glMap2f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(v2), v2, 7, "glMap2f", "GLfloat");
+ Xen_check_type(Xen_is_GLint(vstride), vstride, 8, "glMap2f", "GLint");
+ Xen_check_type(Xen_is_GLint(vorder), vorder, 9, "glMap2f", "GLint");
+ Xen_check_type(Xen_is_GLfloat_(points), points, 10, "glMap2f", "GLfloat*");
+ glMap2f(Xen_to_C_GLenum(target), Xen_to_C_GLfloat(u1), Xen_to_C_GLfloat(u2), Xen_to_C_GLint(ustride), Xen_to_C_GLint(uorder),
+ Xen_to_C_GLfloat(v1), Xen_to_C_GLfloat(v2), Xen_to_C_GLint(vstride), Xen_to_C_GLint(vorder), Xen_to_C_GLfloat_(points));
+ return(Xen_false);
+}
+
+static Xen gxg_glGetMapdv(Xen target, Xen query, Xen v)
{
#define H_glGetMapdv "void glGetMapdv(GLenum target, GLenum query, GLdouble* [v])"
GLdouble ref_v[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetMapdv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(query), query, 2, "glGetMapdv", "GLenum");
- glGetMapdv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(query), ref_v);
- return(XEN_LIST_1(C_TO_XEN_GLdouble(ref_v[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetMapdv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(query), query, 2, "glGetMapdv", "GLenum");
+ glGetMapdv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(query), ref_v);
+ return(Xen_list_1(C_to_Xen_GLdouble(ref_v[0])));
}
-static XEN gxg_glGetMapfv(XEN target, XEN query, XEN v)
+static Xen gxg_glGetMapfv(Xen target, Xen query, Xen v)
{
#define H_glGetMapfv "void glGetMapfv(GLenum target, GLenum query, GLfloat* [v])"
GLfloat ref_v[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetMapfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(query), query, 2, "glGetMapfv", "GLenum");
- glGetMapfv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(query), ref_v);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_v[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetMapfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(query), query, 2, "glGetMapfv", "GLenum");
+ glGetMapfv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(query), ref_v);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_v[0])));
}
-static XEN gxg_glGetMapiv(XEN target, XEN query, XEN v)
+static Xen gxg_glGetMapiv(Xen target, Xen query, Xen v)
{
#define H_glGetMapiv "void glGetMapiv(GLenum target, GLenum query, GLint* [v])"
GLint ref_v[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetMapiv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(query), query, 2, "glGetMapiv", "GLenum");
- glGetMapiv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(query), ref_v);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_v[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetMapiv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(query), query, 2, "glGetMapiv", "GLenum");
+ glGetMapiv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(query), ref_v);
+ return(Xen_list_1(C_to_Xen_GLint(ref_v[0])));
}
-static XEN gxg_glEvalCoord1d(XEN u)
+static Xen gxg_glEvalCoord1d(Xen u)
{
#define H_glEvalCoord1d "void glEvalCoord1d(GLdouble u)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u), u, 1, "glEvalCoord1d", "GLdouble");
- glEvalCoord1d(XEN_TO_C_GLdouble(u));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(u), u, 1, "glEvalCoord1d", "GLdouble");
+ glEvalCoord1d(Xen_to_C_GLdouble(u));
+ return(Xen_false);
}
-static XEN gxg_glEvalCoord1f(XEN u)
+static Xen gxg_glEvalCoord1f(Xen u)
{
#define H_glEvalCoord1f "void glEvalCoord1f(GLfloat u)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u), u, 1, "glEvalCoord1f", "GLfloat");
- glEvalCoord1f(XEN_TO_C_GLfloat(u));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(u), u, 1, "glEvalCoord1f", "GLfloat");
+ glEvalCoord1f(Xen_to_C_GLfloat(u));
+ return(Xen_false);
}
-static XEN gxg_glEvalCoord2d(XEN u, XEN v)
+static Xen gxg_glEvalCoord2d(Xen u, Xen v)
{
#define H_glEvalCoord2d "void glEvalCoord2d(GLdouble u, GLdouble v)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u), u, 1, "glEvalCoord2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(v), v, 2, "glEvalCoord2d", "GLdouble");
- glEvalCoord2d(XEN_TO_C_GLdouble(u), XEN_TO_C_GLdouble(v));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(u), u, 1, "glEvalCoord2d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(v), v, 2, "glEvalCoord2d", "GLdouble");
+ glEvalCoord2d(Xen_to_C_GLdouble(u), Xen_to_C_GLdouble(v));
+ return(Xen_false);
}
-static XEN gxg_glEvalCoord2f(XEN u, XEN v)
+static Xen gxg_glEvalCoord2f(Xen u, Xen v)
{
#define H_glEvalCoord2f "void glEvalCoord2f(GLfloat u, GLfloat v)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u), u, 1, "glEvalCoord2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(v), v, 2, "glEvalCoord2f", "GLfloat");
- glEvalCoord2f(XEN_TO_C_GLfloat(u), XEN_TO_C_GLfloat(v));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(u), u, 1, "glEvalCoord2f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(v), v, 2, "glEvalCoord2f", "GLfloat");
+ glEvalCoord2f(Xen_to_C_GLfloat(u), Xen_to_C_GLfloat(v));
+ return(Xen_false);
}
-static XEN gxg_glMapGrid1d(XEN un, XEN u1, XEN u2)
+static Xen gxg_glMapGrid1d(Xen un, Xen u1, Xen u2)
{
#define H_glMapGrid1d "void glMapGrid1d(GLint un, GLdouble u1, GLdouble u2)"
- XEN_ASSERT_TYPE(XEN_GLint_P(un), un, 1, "glMapGrid1d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u1), u1, 2, "glMapGrid1d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u2), u2, 3, "glMapGrid1d", "GLdouble");
- glMapGrid1d(XEN_TO_C_GLint(un), XEN_TO_C_GLdouble(u1), XEN_TO_C_GLdouble(u2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(un), un, 1, "glMapGrid1d", "GLint");
+ Xen_check_type(Xen_is_GLdouble(u1), u1, 2, "glMapGrid1d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(u2), u2, 3, "glMapGrid1d", "GLdouble");
+ glMapGrid1d(Xen_to_C_GLint(un), Xen_to_C_GLdouble(u1), Xen_to_C_GLdouble(u2));
+ return(Xen_false);
}
-static XEN gxg_glMapGrid1f(XEN un, XEN u1, XEN u2)
+static Xen gxg_glMapGrid1f(Xen un, Xen u1, Xen u2)
{
#define H_glMapGrid1f "void glMapGrid1f(GLint un, GLfloat u1, GLfloat u2)"
- XEN_ASSERT_TYPE(XEN_GLint_P(un), un, 1, "glMapGrid1f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u1), u1, 2, "glMapGrid1f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u2), u2, 3, "glMapGrid1f", "GLfloat");
- glMapGrid1f(XEN_TO_C_GLint(un), XEN_TO_C_GLfloat(u1), XEN_TO_C_GLfloat(u2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(un), un, 1, "glMapGrid1f", "GLint");
+ Xen_check_type(Xen_is_GLfloat(u1), u1, 2, "glMapGrid1f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(u2), u2, 3, "glMapGrid1f", "GLfloat");
+ glMapGrid1f(Xen_to_C_GLint(un), Xen_to_C_GLfloat(u1), Xen_to_C_GLfloat(u2));
+ return(Xen_false);
}
-static XEN gxg_glMapGrid2d(XEN un, XEN u1, XEN u2, XEN vn, XEN v1, XEN v2)
+static Xen gxg_glMapGrid2d(Xen un, Xen u1, Xen u2, Xen vn, Xen v1, Xen v2)
{
#define H_glMapGrid2d "void glMapGrid2d(GLint un, GLdouble u1, GLdouble u2, GLint vn, GLdouble v1, \
GLdouble v2)"
- XEN_ASSERT_TYPE(XEN_GLint_P(un), un, 1, "glMapGrid2d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u1), u1, 2, "glMapGrid2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(u2), u2, 3, "glMapGrid2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint_P(vn), vn, 4, "glMapGrid2d", "GLint");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(v1), v1, 5, "glMapGrid2d", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(v2), v2, 6, "glMapGrid2d", "GLdouble");
- glMapGrid2d(XEN_TO_C_GLint(un), XEN_TO_C_GLdouble(u1), XEN_TO_C_GLdouble(u2), XEN_TO_C_GLint(vn), XEN_TO_C_GLdouble(v1),
- XEN_TO_C_GLdouble(v2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(un), un, 1, "glMapGrid2d", "GLint");
+ Xen_check_type(Xen_is_GLdouble(u1), u1, 2, "glMapGrid2d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(u2), u2, 3, "glMapGrid2d", "GLdouble");
+ Xen_check_type(Xen_is_GLint(vn), vn, 4, "glMapGrid2d", "GLint");
+ Xen_check_type(Xen_is_GLdouble(v1), v1, 5, "glMapGrid2d", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(v2), v2, 6, "glMapGrid2d", "GLdouble");
+ glMapGrid2d(Xen_to_C_GLint(un), Xen_to_C_GLdouble(u1), Xen_to_C_GLdouble(u2), Xen_to_C_GLint(vn), Xen_to_C_GLdouble(v1),
+ Xen_to_C_GLdouble(v2));
+ return(Xen_false);
}
-static XEN gxg_glMapGrid2f(XEN un, XEN u1, XEN u2, XEN vn, XEN v1, XEN v2)
+static Xen gxg_glMapGrid2f(Xen un, Xen u1, Xen u2, Xen vn, Xen v1, Xen v2)
{
#define H_glMapGrid2f "void glMapGrid2f(GLint un, GLfloat u1, GLfloat u2, GLint vn, GLfloat v1, GLfloat v2)"
- XEN_ASSERT_TYPE(XEN_GLint_P(un), un, 1, "glMapGrid2f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u1), u1, 2, "glMapGrid2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(u2), u2, 3, "glMapGrid2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLint_P(vn), vn, 4, "glMapGrid2f", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(v1), v1, 5, "glMapGrid2f", "GLfloat");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(v2), v2, 6, "glMapGrid2f", "GLfloat");
- glMapGrid2f(XEN_TO_C_GLint(un), XEN_TO_C_GLfloat(u1), XEN_TO_C_GLfloat(u2), XEN_TO_C_GLint(vn), XEN_TO_C_GLfloat(v1), XEN_TO_C_GLfloat(v2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(un), un, 1, "glMapGrid2f", "GLint");
+ Xen_check_type(Xen_is_GLfloat(u1), u1, 2, "glMapGrid2f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(u2), u2, 3, "glMapGrid2f", "GLfloat");
+ Xen_check_type(Xen_is_GLint(vn), vn, 4, "glMapGrid2f", "GLint");
+ Xen_check_type(Xen_is_GLfloat(v1), v1, 5, "glMapGrid2f", "GLfloat");
+ Xen_check_type(Xen_is_GLfloat(v2), v2, 6, "glMapGrid2f", "GLfloat");
+ glMapGrid2f(Xen_to_C_GLint(un), Xen_to_C_GLfloat(u1), Xen_to_C_GLfloat(u2), Xen_to_C_GLint(vn), Xen_to_C_GLfloat(v1), Xen_to_C_GLfloat(v2));
+ return(Xen_false);
}
-static XEN gxg_glEvalPoint1(XEN i)
+static Xen gxg_glEvalPoint1(Xen i)
{
#define H_glEvalPoint1 "void glEvalPoint1(GLint i)"
- XEN_ASSERT_TYPE(XEN_GLint_P(i), i, 1, "glEvalPoint1", "GLint");
- glEvalPoint1(XEN_TO_C_GLint(i));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(i), i, 1, "glEvalPoint1", "GLint");
+ glEvalPoint1(Xen_to_C_GLint(i));
+ return(Xen_false);
}
-static XEN gxg_glEvalPoint2(XEN i, XEN j)
+static Xen gxg_glEvalPoint2(Xen i, Xen j)
{
#define H_glEvalPoint2 "void glEvalPoint2(GLint i, GLint j)"
- XEN_ASSERT_TYPE(XEN_GLint_P(i), i, 1, "glEvalPoint2", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(j), j, 2, "glEvalPoint2", "GLint");
- glEvalPoint2(XEN_TO_C_GLint(i), XEN_TO_C_GLint(j));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLint(i), i, 1, "glEvalPoint2", "GLint");
+ Xen_check_type(Xen_is_GLint(j), j, 2, "glEvalPoint2", "GLint");
+ glEvalPoint2(Xen_to_C_GLint(i), Xen_to_C_GLint(j));
+ return(Xen_false);
}
-static XEN gxg_glEvalMesh1(XEN mode, XEN i1, XEN i2)
+static Xen gxg_glEvalMesh1(Xen mode, Xen i1, Xen i2)
{
#define H_glEvalMesh1 "void glEvalMesh1(GLenum mode, GLint i1, GLint i2)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glEvalMesh1", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(i1), i1, 2, "glEvalMesh1", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(i2), i2, 3, "glEvalMesh1", "GLint");
- glEvalMesh1(XEN_TO_C_GLenum(mode), XEN_TO_C_GLint(i1), XEN_TO_C_GLint(i2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glEvalMesh1", "GLenum");
+ Xen_check_type(Xen_is_GLint(i1), i1, 2, "glEvalMesh1", "GLint");
+ Xen_check_type(Xen_is_GLint(i2), i2, 3, "glEvalMesh1", "GLint");
+ glEvalMesh1(Xen_to_C_GLenum(mode), Xen_to_C_GLint(i1), Xen_to_C_GLint(i2));
+ return(Xen_false);
}
-static XEN gxg_glEvalMesh2(XEN mode, XEN i1, XEN i2, XEN j1, XEN j2)
+static Xen gxg_glEvalMesh2(Xen mode, Xen i1, Xen i2, Xen j1, Xen j2)
{
#define H_glEvalMesh2 "void glEvalMesh2(GLenum mode, GLint i1, GLint i2, GLint j1, GLint j2)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glEvalMesh2", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(i1), i1, 2, "glEvalMesh2", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(i2), i2, 3, "glEvalMesh2", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(j1), j1, 4, "glEvalMesh2", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(j2), j2, 5, "glEvalMesh2", "GLint");
- glEvalMesh2(XEN_TO_C_GLenum(mode), XEN_TO_C_GLint(i1), XEN_TO_C_GLint(i2), XEN_TO_C_GLint(j1), XEN_TO_C_GLint(j2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glEvalMesh2", "GLenum");
+ Xen_check_type(Xen_is_GLint(i1), i1, 2, "glEvalMesh2", "GLint");
+ Xen_check_type(Xen_is_GLint(i2), i2, 3, "glEvalMesh2", "GLint");
+ Xen_check_type(Xen_is_GLint(j1), j1, 4, "glEvalMesh2", "GLint");
+ Xen_check_type(Xen_is_GLint(j2), j2, 5, "glEvalMesh2", "GLint");
+ glEvalMesh2(Xen_to_C_GLenum(mode), Xen_to_C_GLint(i1), Xen_to_C_GLint(i2), Xen_to_C_GLint(j1), Xen_to_C_GLint(j2));
+ return(Xen_false);
}
-static XEN gxg_glFogf(XEN pname, XEN param)
+static Xen gxg_glFogf(Xen pname, Xen param)
{
#define H_glFogf "void glFogf(GLenum pname, GLfloat param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glFogf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(param), param, 2, "glFogf", "GLfloat");
- glFogf(XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glFogf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(param), param, 2, "glFogf", "GLfloat");
+ glFogf(Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(param));
+ return(Xen_false);
}
-static XEN gxg_glFogi(XEN pname, XEN param)
+static Xen gxg_glFogi(Xen pname, Xen param)
{
#define H_glFogi "void glFogi(GLenum pname, GLint param)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 1, "glFogi", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(param), param, 2, "glFogi", "GLint");
- glFogi(XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(param));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(pname), pname, 1, "glFogi", "GLenum");
+ Xen_check_type(Xen_is_GLint(param), param, 2, "glFogi", "GLint");
+ glFogi(Xen_to_C_GLenum(pname), Xen_to_C_GLint(param));
+ return(Xen_false);
}
-static XEN gxg_glFeedbackBuffer(XEN size, XEN type, XEN buffer)
+static Xen gxg_glFeedbackBuffer(Xen size, Xen type, Xen buffer)
{
#define H_glFeedbackBuffer "void glFeedbackBuffer(GLsizei size, GLenum type, GLfloat* buffer)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(size), size, 1, "glFeedbackBuffer", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 2, "glFeedbackBuffer", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(buffer), buffer, 3, "glFeedbackBuffer", "GLfloat*");
- glFeedbackBuffer(XEN_TO_C_GLsizei(size), XEN_TO_C_GLenum(type), XEN_TO_C_GLfloat_(buffer));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLsizei(size), size, 1, "glFeedbackBuffer", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(type), type, 2, "glFeedbackBuffer", "GLenum");
+ Xen_check_type(Xen_is_GLfloat_(buffer), buffer, 3, "glFeedbackBuffer", "GLfloat*");
+ glFeedbackBuffer(Xen_to_C_GLsizei(size), Xen_to_C_GLenum(type), Xen_to_C_GLfloat_(buffer));
+ return(Xen_false);
}
-static XEN gxg_glPassThrough(XEN token)
+static Xen gxg_glPassThrough(Xen token)
{
#define H_glPassThrough "void glPassThrough(GLfloat token)"
- XEN_ASSERT_TYPE(XEN_GLfloat_P(token), token, 1, "glPassThrough", "GLfloat");
- glPassThrough(XEN_TO_C_GLfloat(token));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLfloat(token), token, 1, "glPassThrough", "GLfloat");
+ glPassThrough(Xen_to_C_GLfloat(token));
+ return(Xen_false);
}
-static XEN gxg_glSelectBuffer(XEN size, XEN buffer)
+static Xen gxg_glSelectBuffer(Xen size, Xen buffer)
{
#define H_glSelectBuffer "void glSelectBuffer(GLsizei size, GLuint* buffer)"
- XEN_ASSERT_TYPE(XEN_GLsizei_P(size), size, 1, "glSelectBuffer", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLuint__P(buffer), buffer, 2, "glSelectBuffer", "GLuint*");
- glSelectBuffer(XEN_TO_C_GLsizei(size), XEN_TO_C_GLuint_(buffer));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLsizei(size), size, 1, "glSelectBuffer", "GLsizei");
+ Xen_check_type(Xen_is_GLuint_(buffer), buffer, 2, "glSelectBuffer", "GLuint*");
+ glSelectBuffer(Xen_to_C_GLsizei(size), Xen_to_C_GLuint_(buffer));
+ return(Xen_false);
}
-static XEN gxg_glInitNames(void)
+static Xen gxg_glInitNames(void)
{
#define H_glInitNames "void glInitNames( void)"
glInitNames();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glLoadName(XEN name)
+static Xen gxg_glLoadName(Xen name)
{
#define H_glLoadName "void glLoadName(GLuint name)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(name), name, 1, "glLoadName", "GLuint");
- glLoadName(XEN_TO_C_GLuint(name));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(name), name, 1, "glLoadName", "GLuint");
+ glLoadName(Xen_to_C_GLuint(name));
+ return(Xen_false);
}
-static XEN gxg_glPushName(XEN name)
+static Xen gxg_glPushName(Xen name)
{
#define H_glPushName "void glPushName(GLuint name)"
- XEN_ASSERT_TYPE(XEN_GLuint_P(name), name, 1, "glPushName", "GLuint");
- glPushName(XEN_TO_C_GLuint(name));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLuint(name), name, 1, "glPushName", "GLuint");
+ glPushName(Xen_to_C_GLuint(name));
+ return(Xen_false);
}
-static XEN gxg_glPopName(void)
+static Xen gxg_glPopName(void)
{
#define H_glPopName "void glPopName( void)"
glPopName();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_glDrawRangeElements(XEN mode, XEN start, XEN end, XEN count, XEN type, XEN indices)
+static Xen gxg_glDrawRangeElements(Xen mode, Xen start, Xen end, Xen count, Xen type, Xen indices)
{
#define H_glDrawRangeElements "void glDrawRangeElements(GLenum mode, GLuint start, GLuint end, GLsizei count, \
GLenum type, GLvoid* indices)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glDrawRangeElements", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLuint_P(start), start, 2, "glDrawRangeElements", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLuint_P(end), end, 3, "glDrawRangeElements", "GLuint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(count), count, 4, "glDrawRangeElements", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 5, "glDrawRangeElements", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(indices), indices, 6, "glDrawRangeElements", "GLvoid*");
- glDrawRangeElements(XEN_TO_C_GLenum(mode), XEN_TO_C_GLuint(start), XEN_TO_C_GLuint(end), XEN_TO_C_GLsizei(count), XEN_TO_C_GLenum(type),
- XEN_TO_C_GLvoid_(indices));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glDrawRangeElements", "GLenum");
+ Xen_check_type(Xen_is_GLuint(start), start, 2, "glDrawRangeElements", "GLuint");
+ Xen_check_type(Xen_is_GLuint(end), end, 3, "glDrawRangeElements", "GLuint");
+ Xen_check_type(Xen_is_GLsizei(count), count, 4, "glDrawRangeElements", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(type), type, 5, "glDrawRangeElements", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(indices), indices, 6, "glDrawRangeElements", "GLvoid*");
+ glDrawRangeElements(Xen_to_C_GLenum(mode), Xen_to_C_GLuint(start), Xen_to_C_GLuint(end), Xen_to_C_GLsizei(count), Xen_to_C_GLenum(type),
+ Xen_to_C_GLvoid_(indices));
+ return(Xen_false);
}
-static XEN gxg_glTexImage3D(XEN arglist)
+static Xen gxg_glTexImage3D(Xen arglist)
{
#define H_glTexImage3D "void glTexImage3D(GLenum target, GLint level, GLint internalFormat, GLsizei width, \
GLsizei height, GLsizei depth, GLint border, GLenum format, GLenum type, GLvoid* pixels)"
- XEN target, level, internalFormat, width, height, depth, border, format, type, pixels;
- target = XEN_LIST_REF(arglist, 0);
- level = XEN_LIST_REF(arglist, 1);
- internalFormat = XEN_LIST_REF(arglist, 2);
- width = XEN_LIST_REF(arglist, 3);
- height = XEN_LIST_REF(arglist, 4);
- depth = XEN_LIST_REF(arglist, 5);
- border = XEN_LIST_REF(arglist, 6);
- format = XEN_LIST_REF(arglist, 7);
- type = XEN_LIST_REF(arglist, 8);
- pixels = XEN_LIST_REF(arglist, 9);
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexImage3D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glTexImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 3, "glTexImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 4, "glTexImage3D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 5, "glTexImage3D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(depth), depth, 6, "glTexImage3D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLint_P(border), border, 7, "glTexImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 8, "glTexImage3D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 9, "glTexImage3D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pixels), pixels, 10, "glTexImage3D", "GLvoid*");
- glTexImage3D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height),
- XEN_TO_C_GLsizei(depth), XEN_TO_C_GLint(border), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(pixels));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glTexSubImage3D(XEN arglist)
+ Xen target, level, internalFormat, width, height, depth, border, format, type, pixels;
+ target = Xen_list_ref(arglist, 0);
+ level = Xen_list_ref(arglist, 1);
+ internalFormat = Xen_list_ref(arglist, 2);
+ width = Xen_list_ref(arglist, 3);
+ height = Xen_list_ref(arglist, 4);
+ depth = Xen_list_ref(arglist, 5);
+ border = Xen_list_ref(arglist, 6);
+ format = Xen_list_ref(arglist, 7);
+ type = Xen_list_ref(arglist, 8);
+ pixels = Xen_list_ref(arglist, 9);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexImage3D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glTexImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 3, "glTexImage3D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 4, "glTexImage3D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 5, "glTexImage3D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(depth), depth, 6, "glTexImage3D", "GLsizei");
+ Xen_check_type(Xen_is_GLint(border), border, 7, "glTexImage3D", "GLint");
+ Xen_check_type(Xen_is_GLenum(format), format, 8, "glTexImage3D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 9, "glTexImage3D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(pixels), pixels, 10, "glTexImage3D", "GLvoid*");
+ glTexImage3D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height),
+ Xen_to_C_GLsizei(depth), Xen_to_C_GLint(border), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(pixels));
+ return(Xen_false);
+}
+
+static Xen gxg_glTexSubImage3D(Xen arglist)
{
#define H_glTexSubImage3D "void glTexSubImage3D(GLenum target, GLint level, GLint xoffset, GLint yoffset, \
GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLvoid* pixels)"
- XEN target, level, xoffset, yoffset, zoffset, width, height, depth, format, type, pixels;
- target = XEN_LIST_REF(arglist, 0);
- level = XEN_LIST_REF(arglist, 1);
- xoffset = XEN_LIST_REF(arglist, 2);
- yoffset = XEN_LIST_REF(arglist, 3);
- zoffset = XEN_LIST_REF(arglist, 4);
- width = XEN_LIST_REF(arglist, 5);
- height = XEN_LIST_REF(arglist, 6);
- depth = XEN_LIST_REF(arglist, 7);
- format = XEN_LIST_REF(arglist, 8);
- type = XEN_LIST_REF(arglist, 9);
- pixels = XEN_LIST_REF(arglist, 10);
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glTexSubImage3D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(xoffset), xoffset, 3, "glTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(yoffset), yoffset, 4, "glTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(zoffset), zoffset, 5, "glTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 6, "glTexSubImage3D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 7, "glTexSubImage3D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(depth), depth, 8, "glTexSubImage3D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 9, "glTexSubImage3D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 10, "glTexSubImage3D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(pixels), pixels, 11, "glTexSubImage3D", "GLvoid*");
- glTexSubImage3D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(xoffset), XEN_TO_C_GLint(yoffset), XEN_TO_C_GLint(zoffset),
- XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height), XEN_TO_C_GLsizei(depth), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type),
- XEN_TO_C_GLvoid_(pixels));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glCopyTexSubImage3D(XEN target, XEN level, XEN xoffset, XEN yoffset, XEN zoffset, XEN x, XEN y, XEN width, XEN height)
+ Xen target, level, xoffset, yoffset, zoffset, width, height, depth, format, type, pixels;
+ target = Xen_list_ref(arglist, 0);
+ level = Xen_list_ref(arglist, 1);
+ xoffset = Xen_list_ref(arglist, 2);
+ yoffset = Xen_list_ref(arglist, 3);
+ zoffset = Xen_list_ref(arglist, 4);
+ width = Xen_list_ref(arglist, 5);
+ height = Xen_list_ref(arglist, 6);
+ depth = Xen_list_ref(arglist, 7);
+ format = Xen_list_ref(arglist, 8);
+ type = Xen_list_ref(arglist, 9);
+ pixels = Xen_list_ref(arglist, 10);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glTexSubImage3D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(xoffset), xoffset, 3, "glTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(yoffset), yoffset, 4, "glTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(zoffset), zoffset, 5, "glTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 6, "glTexSubImage3D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 7, "glTexSubImage3D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(depth), depth, 8, "glTexSubImage3D", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 9, "glTexSubImage3D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 10, "glTexSubImage3D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(pixels), pixels, 11, "glTexSubImage3D", "GLvoid*");
+ glTexSubImage3D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(xoffset), Xen_to_C_GLint(yoffset), Xen_to_C_GLint(zoffset),
+ Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height), Xen_to_C_GLsizei(depth), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type),
+ Xen_to_C_GLvoid_(pixels));
+ return(Xen_false);
+}
+
+static Xen gxg_glCopyTexSubImage3D(Xen arglist)
{
#define H_glCopyTexSubImage3D "void glCopyTexSubImage3D(GLenum target, GLint level, GLint xoffset, \
GLint yoffset, GLint zoffset, GLint x, GLint y, GLsizei width, GLsizei height)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyTexSubImage3D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 2, "glCopyTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(xoffset), xoffset, 3, "glCopyTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(yoffset), yoffset, 4, "glCopyTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(zoffset), zoffset, 5, "glCopyTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 6, "glCopyTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 7, "glCopyTexSubImage3D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 8, "glCopyTexSubImage3D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 9, "glCopyTexSubImage3D", "GLsizei");
- glCopyTexSubImage3D(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(level), XEN_TO_C_GLint(xoffset), XEN_TO_C_GLint(yoffset), XEN_TO_C_GLint(zoffset),
- XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height));
- return(XEN_FALSE);
-}
-
-static XEN gxg_glColorTable(XEN target, XEN internalformat, XEN width, XEN format, XEN type, XEN table)
+ Xen target, level, xoffset, yoffset, zoffset, x, y, width, height;
+ target = Xen_list_ref(arglist, 0);
+ level = Xen_list_ref(arglist, 1);
+ xoffset = Xen_list_ref(arglist, 2);
+ yoffset = Xen_list_ref(arglist, 3);
+ zoffset = Xen_list_ref(arglist, 4);
+ x = Xen_list_ref(arglist, 5);
+ y = Xen_list_ref(arglist, 6);
+ width = Xen_list_ref(arglist, 7);
+ height = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyTexSubImage3D", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 2, "glCopyTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(xoffset), xoffset, 3, "glCopyTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(yoffset), yoffset, 4, "glCopyTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(zoffset), zoffset, 5, "glCopyTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(x), x, 6, "glCopyTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 7, "glCopyTexSubImage3D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 8, "glCopyTexSubImage3D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 9, "glCopyTexSubImage3D", "GLsizei");
+ glCopyTexSubImage3D(Xen_to_C_GLenum(target), Xen_to_C_GLint(level), Xen_to_C_GLint(xoffset), Xen_to_C_GLint(yoffset), Xen_to_C_GLint(zoffset),
+ Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height));
+ return(Xen_false);
+}
+
+static Xen gxg_glColorTable(Xen target, Xen internalformat, Xen width, Xen format, Xen type, Xen table)
{
#define H_glColorTable "void glColorTable(GLenum target, GLenum internalformat, GLsizei width, GLenum format, \
GLenum type, GLvoid* table)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glColorTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 2, "glColorTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "glColorTable", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 4, "glColorTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 5, "glColorTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(table), table, 6, "glColorTable", "GLvoid*");
- glColorTable(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLsizei(width), XEN_TO_C_GLenum(format),
- XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(table));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glColorTable", "GLenum");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 2, "glColorTable", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "glColorTable", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 4, "glColorTable", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 5, "glColorTable", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(table), table, 6, "glColorTable", "GLvoid*");
+ glColorTable(Xen_to_C_GLenum(target), Xen_to_C_GLenum(internalformat), Xen_to_C_GLsizei(width), Xen_to_C_GLenum(format),
+ Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(table));
+ return(Xen_false);
}
-static XEN gxg_glColorSubTable(XEN target, XEN start, XEN count, XEN format, XEN type, XEN data)
+static Xen gxg_glColorSubTable(Xen target, Xen start, Xen count, Xen format, Xen type, Xen data)
{
#define H_glColorSubTable "void glColorSubTable(GLenum target, GLsizei start, GLsizei count, GLenum format, \
GLenum type, GLvoid* data)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glColorSubTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(start), start, 2, "glColorSubTable", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(count), count, 3, "glColorSubTable", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 4, "glColorSubTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 5, "glColorSubTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(data), data, 6, "glColorSubTable", "GLvoid*");
- glColorSubTable(XEN_TO_C_GLenum(target), XEN_TO_C_GLsizei(start), XEN_TO_C_GLsizei(count), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type),
- XEN_TO_C_GLvoid_(data));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glColorSubTable", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(start), start, 2, "glColorSubTable", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(count), count, 3, "glColorSubTable", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 4, "glColorSubTable", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 5, "glColorSubTable", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(data), data, 6, "glColorSubTable", "GLvoid*");
+ glColorSubTable(Xen_to_C_GLenum(target), Xen_to_C_GLsizei(start), Xen_to_C_GLsizei(count), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type),
+ Xen_to_C_GLvoid_(data));
+ return(Xen_false);
}
-static XEN gxg_glCopyColorSubTable(XEN target, XEN start, XEN x, XEN y, XEN width)
+static Xen gxg_glCopyColorSubTable(Xen target, Xen start, Xen x, Xen y, Xen width)
{
#define H_glCopyColorSubTable "void glCopyColorSubTable(GLenum target, GLsizei start, GLint x, GLint y, \
GLsizei width)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyColorSubTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(start), start, 2, "glCopyColorSubTable", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 3, "glCopyColorSubTable", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 4, "glCopyColorSubTable", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 5, "glCopyColorSubTable", "GLsizei");
- glCopyColorSubTable(XEN_TO_C_GLenum(target), XEN_TO_C_GLsizei(start), XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLsizei(width));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyColorSubTable", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(start), start, 2, "glCopyColorSubTable", "GLsizei");
+ Xen_check_type(Xen_is_GLint(x), x, 3, "glCopyColorSubTable", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 4, "glCopyColorSubTable", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 5, "glCopyColorSubTable", "GLsizei");
+ glCopyColorSubTable(Xen_to_C_GLenum(target), Xen_to_C_GLsizei(start), Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLsizei(width));
+ return(Xen_false);
}
-static XEN gxg_glCopyColorTable(XEN target, XEN internalformat, XEN x, XEN y, XEN width)
+static Xen gxg_glCopyColorTable(Xen target, Xen internalformat, Xen x, Xen y, Xen width)
{
#define H_glCopyColorTable "void glCopyColorTable(GLenum target, GLenum internalformat, GLint x, GLint y, \
GLsizei width)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyColorTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 2, "glCopyColorTable", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 3, "glCopyColorTable", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 4, "glCopyColorTable", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 5, "glCopyColorTable", "GLsizei");
- glCopyColorTable(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLint(x), XEN_TO_C_GLint(y), XEN_TO_C_GLsizei(width));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyColorTable", "GLenum");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 2, "glCopyColorTable", "GLenum");
+ Xen_check_type(Xen_is_GLint(x), x, 3, "glCopyColorTable", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 4, "glCopyColorTable", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 5, "glCopyColorTable", "GLsizei");
+ glCopyColorTable(Xen_to_C_GLenum(target), Xen_to_C_GLenum(internalformat), Xen_to_C_GLint(x), Xen_to_C_GLint(y), Xen_to_C_GLsizei(width));
+ return(Xen_false);
}
-static XEN gxg_glGetColorTableParameterfv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetColorTableParameterfv(Xen target, Xen pname, Xen params)
{
#define H_glGetColorTableParameterfv "void glGetColorTableParameterfv(GLenum target, GLenum pname, \
GLfloat* [params])"
GLfloat ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetColorTableParameterfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetColorTableParameterfv", "GLenum");
- glGetColorTableParameterfv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetColorTableParameterfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetColorTableParameterfv", "GLenum");
+ glGetColorTableParameterfv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_params[0])));
}
-static XEN gxg_glGetColorTableParameteriv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetColorTableParameteriv(Xen target, Xen pname, Xen params)
{
#define H_glGetColorTableParameteriv "void glGetColorTableParameteriv(GLenum target, GLenum pname, \
GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetColorTableParameteriv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetColorTableParameteriv", "GLenum");
- glGetColorTableParameteriv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetColorTableParameteriv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetColorTableParameteriv", "GLenum");
+ glGetColorTableParameteriv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glBlendEquation(XEN mode)
+static Xen gxg_glBlendEquation(Xen mode)
{
#define H_glBlendEquation "void glBlendEquation(GLenum mode)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(mode), mode, 1, "glBlendEquation", "GLenum");
- glBlendEquation(XEN_TO_C_GLenum(mode));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(mode), mode, 1, "glBlendEquation", "GLenum");
+ glBlendEquation(Xen_to_C_GLenum(mode));
+ return(Xen_false);
}
-static XEN gxg_glBlendColor(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_glBlendColor(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_glBlendColor "void glBlendColor(GLclampf red, GLclampf green, GLclampf blue, GLclampf alpha)"
- XEN_ASSERT_TYPE(XEN_GLclampf_P(red), red, 1, "glBlendColor", "GLclampf");
- XEN_ASSERT_TYPE(XEN_GLclampf_P(green), green, 2, "glBlendColor", "GLclampf");
- XEN_ASSERT_TYPE(XEN_GLclampf_P(blue), blue, 3, "glBlendColor", "GLclampf");
- XEN_ASSERT_TYPE(XEN_GLclampf_P(alpha), alpha, 4, "glBlendColor", "GLclampf");
- glBlendColor(XEN_TO_C_GLclampf(red), XEN_TO_C_GLclampf(green), XEN_TO_C_GLclampf(blue), XEN_TO_C_GLclampf(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLclampf(red), red, 1, "glBlendColor", "GLclampf");
+ Xen_check_type(Xen_is_GLclampf(green), green, 2, "glBlendColor", "GLclampf");
+ Xen_check_type(Xen_is_GLclampf(blue), blue, 3, "glBlendColor", "GLclampf");
+ Xen_check_type(Xen_is_GLclampf(alpha), alpha, 4, "glBlendColor", "GLclampf");
+ glBlendColor(Xen_to_C_GLclampf(red), Xen_to_C_GLclampf(green), Xen_to_C_GLclampf(blue), Xen_to_C_GLclampf(alpha));
+ return(Xen_false);
}
-static XEN gxg_glHistogram(XEN target, XEN width, XEN internalformat, XEN sink)
+static Xen gxg_glHistogram(Xen target, Xen width, Xen internalformat, Xen sink)
{
#define H_glHistogram "void glHistogram(GLenum target, GLsizei width, GLenum internalformat, GLboolean sink)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glHistogram", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 2, "glHistogram", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 3, "glHistogram", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLboolean_P(sink), sink, 4, "glHistogram", "GLboolean");
- glHistogram(XEN_TO_C_GLenum(target), XEN_TO_C_GLsizei(width), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLboolean(sink));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glHistogram", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(width), width, 2, "glHistogram", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 3, "glHistogram", "GLenum");
+ Xen_check_type(Xen_is_GLboolean(sink), sink, 4, "glHistogram", "GLboolean");
+ glHistogram(Xen_to_C_GLenum(target), Xen_to_C_GLsizei(width), Xen_to_C_GLenum(internalformat), Xen_to_C_GLboolean(sink));
+ return(Xen_false);
}
-static XEN gxg_glResetHistogram(XEN target)
+static Xen gxg_glResetHistogram(Xen target)
{
#define H_glResetHistogram "void glResetHistogram(GLenum target)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glResetHistogram", "GLenum");
- glResetHistogram(XEN_TO_C_GLenum(target));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glResetHistogram", "GLenum");
+ glResetHistogram(Xen_to_C_GLenum(target));
+ return(Xen_false);
}
-static XEN gxg_glGetHistogram(XEN target, XEN reset, XEN format, XEN type, XEN values)
+static Xen gxg_glGetHistogram(Xen target, Xen reset, Xen format, Xen type, Xen values)
{
#define H_glGetHistogram "void glGetHistogram(GLenum target, GLboolean reset, GLenum format, GLenum type, \
GLvoid* values)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetHistogram", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLboolean_P(reset), reset, 2, "glGetHistogram", "GLboolean");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 3, "glGetHistogram", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 4, "glGetHistogram", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(values), values, 5, "glGetHistogram", "GLvoid*");
- glGetHistogram(XEN_TO_C_GLenum(target), XEN_TO_C_GLboolean(reset), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(values));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetHistogram", "GLenum");
+ Xen_check_type(Xen_is_GLboolean(reset), reset, 2, "glGetHistogram", "GLboolean");
+ Xen_check_type(Xen_is_GLenum(format), format, 3, "glGetHistogram", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 4, "glGetHistogram", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(values), values, 5, "glGetHistogram", "GLvoid*");
+ glGetHistogram(Xen_to_C_GLenum(target), Xen_to_C_GLboolean(reset), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(values));
+ return(Xen_false);
}
-static XEN gxg_glGetHistogramParameterfv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetHistogramParameterfv(Xen target, Xen pname, Xen params)
{
#define H_glGetHistogramParameterfv "void glGetHistogramParameterfv(GLenum target, GLenum pname, GLfloat* [params])"
GLfloat ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetHistogramParameterfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetHistogramParameterfv", "GLenum");
- glGetHistogramParameterfv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetHistogramParameterfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetHistogramParameterfv", "GLenum");
+ glGetHistogramParameterfv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_params[0])));
}
-static XEN gxg_glGetHistogramParameteriv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetHistogramParameteriv(Xen target, Xen pname, Xen params)
{
#define H_glGetHistogramParameteriv "void glGetHistogramParameteriv(GLenum target, GLenum pname, GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetHistogramParameteriv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetHistogramParameteriv", "GLenum");
- glGetHistogramParameteriv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetHistogramParameteriv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetHistogramParameteriv", "GLenum");
+ glGetHistogramParameteriv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glMinmax(XEN target, XEN internalformat, XEN sink)
+static Xen gxg_glMinmax(Xen target, Xen internalformat, Xen sink)
{
#define H_glMinmax "void glMinmax(GLenum target, GLenum internalformat, GLboolean sink)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glMinmax", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 2, "glMinmax", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLboolean_P(sink), sink, 3, "glMinmax", "GLboolean");
- glMinmax(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLboolean(sink));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glMinmax", "GLenum");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 2, "glMinmax", "GLenum");
+ Xen_check_type(Xen_is_GLboolean(sink), sink, 3, "glMinmax", "GLboolean");
+ glMinmax(Xen_to_C_GLenum(target), Xen_to_C_GLenum(internalformat), Xen_to_C_GLboolean(sink));
+ return(Xen_false);
}
-static XEN gxg_glResetMinmax(XEN target)
+static Xen gxg_glResetMinmax(Xen target)
{
#define H_glResetMinmax "void glResetMinmax(GLenum target)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glResetMinmax", "GLenum");
- glResetMinmax(XEN_TO_C_GLenum(target));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glResetMinmax", "GLenum");
+ glResetMinmax(Xen_to_C_GLenum(target));
+ return(Xen_false);
}
-static XEN gxg_glGetMinmax(XEN target, XEN reset, XEN format, XEN types, XEN values)
+static Xen gxg_glGetMinmax(Xen target, Xen reset, Xen format, Xen types, Xen values)
{
#define H_glGetMinmax "void glGetMinmax(GLenum target, GLboolean reset, GLenum format, GLenum types, \
GLvoid* values)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetMinmax", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLboolean_P(reset), reset, 2, "glGetMinmax", "GLboolean");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 3, "glGetMinmax", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(types), types, 4, "glGetMinmax", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(values), values, 5, "glGetMinmax", "GLvoid*");
- glGetMinmax(XEN_TO_C_GLenum(target), XEN_TO_C_GLboolean(reset), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(types), XEN_TO_C_GLvoid_(values));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetMinmax", "GLenum");
+ Xen_check_type(Xen_is_GLboolean(reset), reset, 2, "glGetMinmax", "GLboolean");
+ Xen_check_type(Xen_is_GLenum(format), format, 3, "glGetMinmax", "GLenum");
+ Xen_check_type(Xen_is_GLenum(types), types, 4, "glGetMinmax", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(values), values, 5, "glGetMinmax", "GLvoid*");
+ glGetMinmax(Xen_to_C_GLenum(target), Xen_to_C_GLboolean(reset), Xen_to_C_GLenum(format), Xen_to_C_GLenum(types), Xen_to_C_GLvoid_(values));
+ return(Xen_false);
}
-static XEN gxg_glGetMinmaxParameterfv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetMinmaxParameterfv(Xen target, Xen pname, Xen params)
{
#define H_glGetMinmaxParameterfv "void glGetMinmaxParameterfv(GLenum target, GLenum pname, GLfloat* [params])"
GLfloat ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetMinmaxParameterfv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetMinmaxParameterfv", "GLenum");
- glGetMinmaxParameterfv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLfloat(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetMinmaxParameterfv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetMinmaxParameterfv", "GLenum");
+ glGetMinmaxParameterfv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLfloat(ref_params[0])));
}
-static XEN gxg_glGetMinmaxParameteriv(XEN target, XEN pname, XEN params)
+static Xen gxg_glGetMinmaxParameteriv(Xen target, Xen pname, Xen params)
{
#define H_glGetMinmaxParameteriv "void glGetMinmaxParameteriv(GLenum target, GLenum pname, GLint* [params])"
GLint ref_params[1];
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glGetMinmaxParameteriv", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glGetMinmaxParameteriv", "GLenum");
- glGetMinmaxParameteriv(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), ref_params);
- return(XEN_LIST_1(C_TO_XEN_GLint(ref_params[0])));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glGetMinmaxParameteriv", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glGetMinmaxParameteriv", "GLenum");
+ glGetMinmaxParameteriv(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), ref_params);
+ return(Xen_list_1(C_to_Xen_GLint(ref_params[0])));
}
-static XEN gxg_glConvolutionFilter1D(XEN target, XEN internalformat, XEN width, XEN format, XEN type, XEN image)
+static Xen gxg_glConvolutionFilter1D(Xen target, Xen internalformat, Xen width, Xen format, Xen type, Xen image)
{
#define H_glConvolutionFilter1D "void glConvolutionFilter1D(GLenum target, GLenum internalformat, GLsizei width, \
GLenum format, GLenum type, GLvoid* image)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glConvolutionFilter1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 2, "glConvolutionFilter1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "glConvolutionFilter1D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 4, "glConvolutionFilter1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 5, "glConvolutionFilter1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(image), image, 6, "glConvolutionFilter1D", "GLvoid*");
- glConvolutionFilter1D(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLsizei(width), XEN_TO_C_GLenum(format),
- XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(image));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glConvolutionFilter1D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 2, "glConvolutionFilter1D", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "glConvolutionFilter1D", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 4, "glConvolutionFilter1D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 5, "glConvolutionFilter1D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(image), image, 6, "glConvolutionFilter1D", "GLvoid*");
+ glConvolutionFilter1D(Xen_to_C_GLenum(target), Xen_to_C_GLenum(internalformat), Xen_to_C_GLsizei(width), Xen_to_C_GLenum(format),
+ Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(image));
+ return(Xen_false);
}
-static XEN gxg_glConvolutionFilter2D(XEN target, XEN internalformat, XEN width, XEN height, XEN format, XEN type, XEN image)
+static Xen gxg_glConvolutionFilter2D(Xen target, Xen internalformat, Xen width, Xen height, Xen format, Xen type, Xen image)
{
#define H_glConvolutionFilter2D "void glConvolutionFilter2D(GLenum target, GLenum internalformat, GLsizei width, \
GLsizei height, GLenum format, GLenum type, GLvoid* image)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glConvolutionFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 2, "glConvolutionFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "glConvolutionFilter2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "glConvolutionFilter2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 5, "glConvolutionFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 6, "glConvolutionFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(image), image, 7, "glConvolutionFilter2D", "GLvoid*");
- glConvolutionFilter2D(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height),
- XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(image));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glConvolutionFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 2, "glConvolutionFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "glConvolutionFilter2D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "glConvolutionFilter2D", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 5, "glConvolutionFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 6, "glConvolutionFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(image), image, 7, "glConvolutionFilter2D", "GLvoid*");
+ glConvolutionFilter2D(Xen_to_C_GLenum(target), Xen_to_C_GLenum(internalformat), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height),
+ Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(image));
+ return(Xen_false);
}
-static XEN gxg_glConvolutionParameterf(XEN target, XEN pname, XEN params)
+static Xen gxg_glConvolutionParameterf(Xen target, Xen pname, Xen params)
{
#define H_glConvolutionParameterf "void glConvolutionParameterf(GLenum target, GLenum pname, GLfloat params)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glConvolutionParameterf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glConvolutionParameterf", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(params), params, 3, "glConvolutionParameterf", "GLfloat");
- glConvolutionParameterf(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), XEN_TO_C_GLfloat(params));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glConvolutionParameterf", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glConvolutionParameterf", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(params), params, 3, "glConvolutionParameterf", "GLfloat");
+ glConvolutionParameterf(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), Xen_to_C_GLfloat(params));
+ return(Xen_false);
}
-static XEN gxg_glConvolutionParameteri(XEN target, XEN pname, XEN params)
+static Xen gxg_glConvolutionParameteri(Xen target, Xen pname, Xen params)
{
#define H_glConvolutionParameteri "void glConvolutionParameteri(GLenum target, GLenum pname, GLint params)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glConvolutionParameteri", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(pname), pname, 2, "glConvolutionParameteri", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(params), params, 3, "glConvolutionParameteri", "GLint");
- glConvolutionParameteri(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(pname), XEN_TO_C_GLint(params));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glConvolutionParameteri", "GLenum");
+ Xen_check_type(Xen_is_GLenum(pname), pname, 2, "glConvolutionParameteri", "GLenum");
+ Xen_check_type(Xen_is_GLint(params), params, 3, "glConvolutionParameteri", "GLint");
+ glConvolutionParameteri(Xen_to_C_GLenum(target), Xen_to_C_GLenum(pname), Xen_to_C_GLint(params));
+ return(Xen_false);
}
-static XEN gxg_glCopyConvolutionFilter1D(XEN target, XEN internalformat, XEN x, XEN y, XEN width)
+static Xen gxg_glCopyConvolutionFilter1D(Xen target, Xen internalformat, Xen x, Xen y, Xen width)
{
#define H_glCopyConvolutionFilter1D "void glCopyConvolutionFilter1D(GLenum target, GLenum internalformat, \
GLint x, GLint y, GLsizei width)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyConvolutionFilter1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 2, "glCopyConvolutionFilter1D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 3, "glCopyConvolutionFilter1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 4, "glCopyConvolutionFilter1D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 5, "glCopyConvolutionFilter1D", "GLsizei");
- glCopyConvolutionFilter1D(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLint(x), XEN_TO_C_GLint(y),
- XEN_TO_C_GLsizei(width));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyConvolutionFilter1D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 2, "glCopyConvolutionFilter1D", "GLenum");
+ Xen_check_type(Xen_is_GLint(x), x, 3, "glCopyConvolutionFilter1D", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 4, "glCopyConvolutionFilter1D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 5, "glCopyConvolutionFilter1D", "GLsizei");
+ glCopyConvolutionFilter1D(Xen_to_C_GLenum(target), Xen_to_C_GLenum(internalformat), Xen_to_C_GLint(x), Xen_to_C_GLint(y),
+ Xen_to_C_GLsizei(width));
+ return(Xen_false);
}
-static XEN gxg_glCopyConvolutionFilter2D(XEN target, XEN internalformat, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_glCopyConvolutionFilter2D(Xen target, Xen internalformat, Xen x, Xen y, Xen width, Xen height)
{
#define H_glCopyConvolutionFilter2D "void glCopyConvolutionFilter2D(GLenum target, GLenum internalformat, \
GLint x, GLint y, GLsizei width, GLsizei height)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glCopyConvolutionFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 2, "glCopyConvolutionFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(x), x, 3, "glCopyConvolutionFilter2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(y), y, 4, "glCopyConvolutionFilter2D", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 5, "glCopyConvolutionFilter2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 6, "glCopyConvolutionFilter2D", "GLsizei");
- glCopyConvolutionFilter2D(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLint(x), XEN_TO_C_GLint(y),
- XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glCopyConvolutionFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 2, "glCopyConvolutionFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLint(x), x, 3, "glCopyConvolutionFilter2D", "GLint");
+ Xen_check_type(Xen_is_GLint(y), y, 4, "glCopyConvolutionFilter2D", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 5, "glCopyConvolutionFilter2D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 6, "glCopyConvolutionFilter2D", "GLsizei");
+ glCopyConvolutionFilter2D(Xen_to_C_GLenum(target), Xen_to_C_GLenum(internalformat), Xen_to_C_GLint(x), Xen_to_C_GLint(y),
+ Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height));
+ return(Xen_false);
}
-static XEN gxg_glSeparableFilter2D(XEN target, XEN internalformat, XEN width, XEN height, XEN format, XEN type, XEN row, XEN column)
+static Xen gxg_glSeparableFilter2D(Xen arglist)
{
#define H_glSeparableFilter2D "void glSeparableFilter2D(GLenum target, GLenum internalformat, GLsizei width, \
GLsizei height, GLenum format, GLenum type, GLvoid* row, GLvoid* column)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "glSeparableFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(internalformat), internalformat, 2, "glSeparableFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "glSeparableFilter2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "glSeparableFilter2D", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 5, "glSeparableFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 6, "glSeparableFilter2D", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(row), row, 7, "glSeparableFilter2D", "GLvoid*");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(column), column, 8, "glSeparableFilter2D", "GLvoid*");
- glSeparableFilter2D(XEN_TO_C_GLenum(target), XEN_TO_C_GLenum(internalformat), XEN_TO_C_GLsizei(width), XEN_TO_C_GLsizei(height),
- XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLvoid_(row), XEN_TO_C_GLvoid_(column));
- return(XEN_FALSE);
+ Xen target, internalformat, width, height, format, type, row, column;
+ target = Xen_list_ref(arglist, 0);
+ internalformat = Xen_list_ref(arglist, 1);
+ width = Xen_list_ref(arglist, 2);
+ height = Xen_list_ref(arglist, 3);
+ format = Xen_list_ref(arglist, 4);
+ type = Xen_list_ref(arglist, 5);
+ row = Xen_list_ref(arglist, 6);
+ column = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "glSeparableFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(internalformat), internalformat, 2, "glSeparableFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "glSeparableFilter2D", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "glSeparableFilter2D", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 5, "glSeparableFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 6, "glSeparableFilter2D", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(row), row, 7, "glSeparableFilter2D", "GLvoid*");
+ Xen_check_type(Xen_is_GLvoid_(column), column, 8, "glSeparableFilter2D", "GLvoid*");
+ glSeparableFilter2D(Xen_to_C_GLenum(target), Xen_to_C_GLenum(internalformat), Xen_to_C_GLsizei(width), Xen_to_C_GLsizei(height),
+ Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLvoid_(row), Xen_to_C_GLvoid_(column));
+ return(Xen_false);
}
#if HAVE_GLU
-static XEN gxg_gluBeginCurve(XEN nurb)
+static Xen gxg_gluBeginCurve(Xen nurb)
{
#define H_gluBeginCurve "void gluBeginCurve(GLUnurbs* nurb)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluBeginCurve", "GLUnurbs*");
- gluBeginCurve(XEN_TO_C_GLUnurbs_(nurb));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluBeginCurve", "GLUnurbs*");
+ gluBeginCurve(Xen_to_C_GLUnurbs_(nurb));
+ return(Xen_false);
}
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluBeginPolygon(XEN tess)
+static Xen gxg_gluBeginPolygon(Xen tess)
{
#define H_gluBeginPolygon "void gluBeginPolygon(GLUtesselator* tess)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluBeginPolygon", "GLUtesselator*");
- gluBeginPolygon(XEN_TO_C_GLUtesselator_(tess));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluBeginPolygon", "GLUtesselator*");
+ gluBeginPolygon(Xen_to_C_GLUtesselator_(tess));
+ return(Xen_false);
}
#endif
-static XEN gxg_gluBeginSurface(XEN nurb)
+static Xen gxg_gluBeginSurface(Xen nurb)
{
#define H_gluBeginSurface "void gluBeginSurface(GLUnurbs* nurb)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluBeginSurface", "GLUnurbs*");
- gluBeginSurface(XEN_TO_C_GLUnurbs_(nurb));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluBeginSurface", "GLUnurbs*");
+ gluBeginSurface(Xen_to_C_GLUnurbs_(nurb));
+ return(Xen_false);
}
-static XEN gxg_gluBeginTrim(XEN nurb)
+static Xen gxg_gluBeginTrim(Xen nurb)
{
#define H_gluBeginTrim "void gluBeginTrim(GLUnurbs* nurb)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluBeginTrim", "GLUnurbs*");
- gluBeginTrim(XEN_TO_C_GLUnurbs_(nurb));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluBeginTrim", "GLUnurbs*");
+ gluBeginTrim(Xen_to_C_GLUnurbs_(nurb));
+ return(Xen_false);
}
-static XEN gxg_gluBuild1DMipmapLevels(XEN target, XEN internalFormat, XEN width, XEN format, XEN type, XEN level, XEN base, XEN max, XEN data)
+static Xen gxg_gluBuild1DMipmapLevels(Xen arglist)
{
#define H_gluBuild1DMipmapLevels "GLint gluBuild1DMipmapLevels(GLenum target, GLint internalFormat, \
GLsizei width, GLenum format, GLenum type, GLint level, GLint base, GLint max, void* data)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "gluBuild1DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 2, "gluBuild1DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "gluBuild1DMipmapLevels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 4, "gluBuild1DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 5, "gluBuild1DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 6, "gluBuild1DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(base), base, 7, "gluBuild1DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(max), max, 8, "gluBuild1DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_void__P(data), data, 9, "gluBuild1DMipmapLevels", "void*");
- return(C_TO_XEN_GLint(gluBuild1DMipmapLevels(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width),
- XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_GLint(level), XEN_TO_C_GLint(base),
- XEN_TO_C_GLint(max), XEN_TO_C_void_(data))));
-}
-
-static XEN gxg_gluBuild1DMipmaps(XEN target, XEN internalFormat, XEN width, XEN format, XEN type, XEN data)
+ Xen target, internalFormat, width, format, type, level, base, max, data;
+ target = Xen_list_ref(arglist, 0);
+ internalFormat = Xen_list_ref(arglist, 1);
+ width = Xen_list_ref(arglist, 2);
+ format = Xen_list_ref(arglist, 3);
+ type = Xen_list_ref(arglist, 4);
+ level = Xen_list_ref(arglist, 5);
+ base = Xen_list_ref(arglist, 6);
+ max = Xen_list_ref(arglist, 7);
+ data = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "gluBuild1DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 2, "gluBuild1DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "gluBuild1DMipmapLevels", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 4, "gluBuild1DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 5, "gluBuild1DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 6, "gluBuild1DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLint(base), base, 7, "gluBuild1DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLint(max), max, 8, "gluBuild1DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_void_(data), data, 9, "gluBuild1DMipmapLevels", "void*");
+ return(C_to_Xen_GLint(gluBuild1DMipmapLevels(Xen_to_C_GLenum(target), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width),
+ Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_GLint(level), Xen_to_C_GLint(base),
+ Xen_to_C_GLint(max), Xen_to_C_void_(data))));
+}
+
+static Xen gxg_gluBuild1DMipmaps(Xen target, Xen internalFormat, Xen width, Xen format, Xen type, Xen data)
{
#define H_gluBuild1DMipmaps "GLint gluBuild1DMipmaps(GLenum target, GLint internalFormat, GLsizei width, \
GLenum format, GLenum type, void* data)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "gluBuild1DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 2, "gluBuild1DMipmaps", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "gluBuild1DMipmaps", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 4, "gluBuild1DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 5, "gluBuild1DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_void__P(data), data, 6, "gluBuild1DMipmaps", "void*");
- return(C_TO_XEN_GLint(gluBuild1DMipmaps(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width),
- XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_void_(data))));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "gluBuild1DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 2, "gluBuild1DMipmaps", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "gluBuild1DMipmaps", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 4, "gluBuild1DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 5, "gluBuild1DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_void_(data), data, 6, "gluBuild1DMipmaps", "void*");
+ return(C_to_Xen_GLint(gluBuild1DMipmaps(Xen_to_C_GLenum(target), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width),
+ Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_void_(data))));
}
-static XEN gxg_gluBuild2DMipmapLevels(XEN arglist)
+static Xen gxg_gluBuild2DMipmapLevels(Xen arglist)
{
#define H_gluBuild2DMipmapLevels "GLint gluBuild2DMipmapLevels(GLenum target, GLint internalFormat, \
GLsizei width, GLsizei height, GLenum format, GLenum type, GLint level, GLint base, GLint max, void* data)"
- XEN target, internalFormat, width, height, format, type, level, base, max, data;
- target = XEN_LIST_REF(arglist, 0);
- internalFormat = XEN_LIST_REF(arglist, 1);
- width = XEN_LIST_REF(arglist, 2);
- height = XEN_LIST_REF(arglist, 3);
- format = XEN_LIST_REF(arglist, 4);
- type = XEN_LIST_REF(arglist, 5);
- level = XEN_LIST_REF(arglist, 6);
- base = XEN_LIST_REF(arglist, 7);
- max = XEN_LIST_REF(arglist, 8);
- data = XEN_LIST_REF(arglist, 9);
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "gluBuild2DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 2, "gluBuild2DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "gluBuild2DMipmapLevels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "gluBuild2DMipmapLevels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 5, "gluBuild2DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 6, "gluBuild2DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 7, "gluBuild2DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(base), base, 8, "gluBuild2DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(max), max, 9, "gluBuild2DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_void__P(data), data, 10, "gluBuild2DMipmapLevels", "void*");
- return(C_TO_XEN_GLint(gluBuild2DMipmapLevels(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width),
- XEN_TO_C_GLsizei(height), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type),
- XEN_TO_C_GLint(level), XEN_TO_C_GLint(base), XEN_TO_C_GLint(max), XEN_TO_C_void_(data))));
-}
-
-static XEN gxg_gluBuild2DMipmaps(XEN target, XEN internalFormat, XEN width, XEN height, XEN format, XEN type, XEN data)
+ Xen target, internalFormat, width, height, format, type, level, base, max, data;
+ target = Xen_list_ref(arglist, 0);
+ internalFormat = Xen_list_ref(arglist, 1);
+ width = Xen_list_ref(arglist, 2);
+ height = Xen_list_ref(arglist, 3);
+ format = Xen_list_ref(arglist, 4);
+ type = Xen_list_ref(arglist, 5);
+ level = Xen_list_ref(arglist, 6);
+ base = Xen_list_ref(arglist, 7);
+ max = Xen_list_ref(arglist, 8);
+ data = Xen_list_ref(arglist, 9);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "gluBuild2DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 2, "gluBuild2DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "gluBuild2DMipmapLevels", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "gluBuild2DMipmapLevels", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 5, "gluBuild2DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 6, "gluBuild2DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 7, "gluBuild2DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLint(base), base, 8, "gluBuild2DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLint(max), max, 9, "gluBuild2DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_void_(data), data, 10, "gluBuild2DMipmapLevels", "void*");
+ return(C_to_Xen_GLint(gluBuild2DMipmapLevels(Xen_to_C_GLenum(target), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width),
+ Xen_to_C_GLsizei(height), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type),
+ Xen_to_C_GLint(level), Xen_to_C_GLint(base), Xen_to_C_GLint(max), Xen_to_C_void_(data))));
+}
+
+static Xen gxg_gluBuild2DMipmaps(Xen target, Xen internalFormat, Xen width, Xen height, Xen format, Xen type, Xen data)
{
#define H_gluBuild2DMipmaps "GLint gluBuild2DMipmaps(GLenum target, GLint internalFormat, GLsizei width, \
GLsizei height, GLenum format, GLenum type, void* data)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "gluBuild2DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 2, "gluBuild2DMipmaps", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "gluBuild2DMipmaps", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "gluBuild2DMipmaps", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 5, "gluBuild2DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 6, "gluBuild2DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_void__P(data), data, 7, "gluBuild2DMipmaps", "void*");
- return(C_TO_XEN_GLint(gluBuild2DMipmaps(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width),
- XEN_TO_C_GLsizei(height), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type), XEN_TO_C_void_(data))));
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "gluBuild2DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 2, "gluBuild2DMipmaps", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "gluBuild2DMipmaps", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "gluBuild2DMipmaps", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 5, "gluBuild2DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 6, "gluBuild2DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_void_(data), data, 7, "gluBuild2DMipmaps", "void*");
+ return(C_to_Xen_GLint(gluBuild2DMipmaps(Xen_to_C_GLenum(target), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width),
+ Xen_to_C_GLsizei(height), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type), Xen_to_C_void_(data))));
}
-static XEN gxg_gluBuild3DMipmapLevels(XEN arglist)
+static Xen gxg_gluBuild3DMipmapLevels(Xen arglist)
{
#define H_gluBuild3DMipmapLevels "GLint gluBuild3DMipmapLevels(GLenum target, GLint internalFormat, \
GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLint level, GLint base, GLint max, \
void* data)"
- XEN target, internalFormat, width, height, depth, format, type, level, base, max, data;
- target = XEN_LIST_REF(arglist, 0);
- internalFormat = XEN_LIST_REF(arglist, 1);
- width = XEN_LIST_REF(arglist, 2);
- height = XEN_LIST_REF(arglist, 3);
- depth = XEN_LIST_REF(arglist, 4);
- format = XEN_LIST_REF(arglist, 5);
- type = XEN_LIST_REF(arglist, 6);
- level = XEN_LIST_REF(arglist, 7);
- base = XEN_LIST_REF(arglist, 8);
- max = XEN_LIST_REF(arglist, 9);
- data = XEN_LIST_REF(arglist, 10);
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "gluBuild3DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 2, "gluBuild3DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "gluBuild3DMipmapLevels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "gluBuild3DMipmapLevels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(depth), depth, 5, "gluBuild3DMipmapLevels", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 6, "gluBuild3DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 7, "gluBuild3DMipmapLevels", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(level), level, 8, "gluBuild3DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(base), base, 9, "gluBuild3DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(max), max, 10, "gluBuild3DMipmapLevels", "GLint");
- XEN_ASSERT_TYPE(XEN_void__P(data), data, 11, "gluBuild3DMipmapLevels", "void*");
- return(C_TO_XEN_GLint(gluBuild3DMipmapLevels(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width),
- XEN_TO_C_GLsizei(height), XEN_TO_C_GLsizei(depth), XEN_TO_C_GLenum(format),
- XEN_TO_C_GLenum(type), XEN_TO_C_GLint(level), XEN_TO_C_GLint(base), XEN_TO_C_GLint(max),
- XEN_TO_C_void_(data))));
-}
-
-static XEN gxg_gluBuild3DMipmaps(XEN target, XEN internalFormat, XEN width, XEN height, XEN depth, XEN format, XEN type, XEN data)
+ Xen target, internalFormat, width, height, depth, format, type, level, base, max, data;
+ target = Xen_list_ref(arglist, 0);
+ internalFormat = Xen_list_ref(arglist, 1);
+ width = Xen_list_ref(arglist, 2);
+ height = Xen_list_ref(arglist, 3);
+ depth = Xen_list_ref(arglist, 4);
+ format = Xen_list_ref(arglist, 5);
+ type = Xen_list_ref(arglist, 6);
+ level = Xen_list_ref(arglist, 7);
+ base = Xen_list_ref(arglist, 8);
+ max = Xen_list_ref(arglist, 9);
+ data = Xen_list_ref(arglist, 10);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "gluBuild3DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 2, "gluBuild3DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "gluBuild3DMipmapLevels", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "gluBuild3DMipmapLevels", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(depth), depth, 5, "gluBuild3DMipmapLevels", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 6, "gluBuild3DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 7, "gluBuild3DMipmapLevels", "GLenum");
+ Xen_check_type(Xen_is_GLint(level), level, 8, "gluBuild3DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLint(base), base, 9, "gluBuild3DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_GLint(max), max, 10, "gluBuild3DMipmapLevels", "GLint");
+ Xen_check_type(Xen_is_void_(data), data, 11, "gluBuild3DMipmapLevels", "void*");
+ return(C_to_Xen_GLint(gluBuild3DMipmapLevels(Xen_to_C_GLenum(target), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width),
+ Xen_to_C_GLsizei(height), Xen_to_C_GLsizei(depth), Xen_to_C_GLenum(format),
+ Xen_to_C_GLenum(type), Xen_to_C_GLint(level), Xen_to_C_GLint(base), Xen_to_C_GLint(max),
+ Xen_to_C_void_(data))));
+}
+
+static Xen gxg_gluBuild3DMipmaps(Xen arglist)
{
#define H_gluBuild3DMipmaps "GLint gluBuild3DMipmaps(GLenum target, GLint internalFormat, GLsizei width, \
GLsizei height, GLsizei depth, GLenum format, GLenum type, void* data)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(target), target, 1, "gluBuild3DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLint_P(internalFormat), internalFormat, 2, "gluBuild3DMipmaps", "GLint");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(width), width, 3, "gluBuild3DMipmaps", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(height), height, 4, "gluBuild3DMipmaps", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(depth), depth, 5, "gluBuild3DMipmaps", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 6, "gluBuild3DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 7, "gluBuild3DMipmaps", "GLenum");
- XEN_ASSERT_TYPE(XEN_void__P(data), data, 8, "gluBuild3DMipmaps", "void*");
- return(C_TO_XEN_GLint(gluBuild3DMipmaps(XEN_TO_C_GLenum(target), XEN_TO_C_GLint(internalFormat), XEN_TO_C_GLsizei(width),
- XEN_TO_C_GLsizei(height), XEN_TO_C_GLsizei(depth), XEN_TO_C_GLenum(format), XEN_TO_C_GLenum(type),
- XEN_TO_C_void_(data))));
-}
-
-static XEN gxg_gluCheckExtension(XEN extName, XEN extString)
+ Xen target, internalFormat, width, height, depth, format, type, data;
+ target = Xen_list_ref(arglist, 0);
+ internalFormat = Xen_list_ref(arglist, 1);
+ width = Xen_list_ref(arglist, 2);
+ height = Xen_list_ref(arglist, 3);
+ depth = Xen_list_ref(arglist, 4);
+ format = Xen_list_ref(arglist, 5);
+ type = Xen_list_ref(arglist, 6);
+ data = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_GLenum(target), target, 1, "gluBuild3DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_GLint(internalFormat), internalFormat, 2, "gluBuild3DMipmaps", "GLint");
+ Xen_check_type(Xen_is_GLsizei(width), width, 3, "gluBuild3DMipmaps", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(height), height, 4, "gluBuild3DMipmaps", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(depth), depth, 5, "gluBuild3DMipmaps", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(format), format, 6, "gluBuild3DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_GLenum(type), type, 7, "gluBuild3DMipmaps", "GLenum");
+ Xen_check_type(Xen_is_void_(data), data, 8, "gluBuild3DMipmaps", "void*");
+ return(C_to_Xen_GLint(gluBuild3DMipmaps(Xen_to_C_GLenum(target), Xen_to_C_GLint(internalFormat), Xen_to_C_GLsizei(width),
+ Xen_to_C_GLsizei(height), Xen_to_C_GLsizei(depth), Xen_to_C_GLenum(format), Xen_to_C_GLenum(type),
+ Xen_to_C_void_(data))));
+}
+
+static Xen gxg_gluCheckExtension(Xen extName, Xen extString)
{
#define H_gluCheckExtension "GLboolean gluCheckExtension(GLubyte* extName, GLubyte* extString)"
- XEN_ASSERT_TYPE(XEN_GLubyte__P(extName), extName, 1, "gluCheckExtension", "GLubyte*");
- XEN_ASSERT_TYPE(XEN_GLubyte__P(extString), extString, 2, "gluCheckExtension", "GLubyte*");
- return(C_TO_XEN_GLboolean(gluCheckExtension(XEN_TO_C_GLubyte_(extName), XEN_TO_C_GLubyte_(extString))));
+ Xen_check_type(Xen_is_GLubyte_(extName), extName, 1, "gluCheckExtension", "GLubyte*");
+ Xen_check_type(Xen_is_GLubyte_(extString), extString, 2, "gluCheckExtension", "GLubyte*");
+ return(C_to_Xen_GLboolean(gluCheckExtension(Xen_to_C_GLubyte_(extName), Xen_to_C_GLubyte_(extString))));
}
-static XEN gxg_gluCylinder(XEN quad, XEN base, XEN top, XEN height, XEN slices, XEN stacks)
+static Xen gxg_gluCylinder(Xen quad, Xen base, Xen top, Xen height, Xen slices, Xen stacks)
{
#define H_gluCylinder "void gluCylinder(GLUquadric* quad, GLdouble base, GLdouble top, GLdouble height, \
GLint slices, GLint stacks)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluCylinder", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(base), base, 2, "gluCylinder", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(top), top, 3, "gluCylinder", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(height), height, 4, "gluCylinder", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint_P(slices), slices, 5, "gluCylinder", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(stacks), stacks, 6, "gluCylinder", "GLint");
- gluCylinder(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLdouble(base), XEN_TO_C_GLdouble(top), XEN_TO_C_GLdouble(height), XEN_TO_C_GLint(slices),
- XEN_TO_C_GLint(stacks));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluCylinder", "GLUquadric*");
+ Xen_check_type(Xen_is_GLdouble(base), base, 2, "gluCylinder", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(top), top, 3, "gluCylinder", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(height), height, 4, "gluCylinder", "GLdouble");
+ Xen_check_type(Xen_is_GLint(slices), slices, 5, "gluCylinder", "GLint");
+ Xen_check_type(Xen_is_GLint(stacks), stacks, 6, "gluCylinder", "GLint");
+ gluCylinder(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLdouble(base), Xen_to_C_GLdouble(top), Xen_to_C_GLdouble(height), Xen_to_C_GLint(slices),
+ Xen_to_C_GLint(stacks));
+ return(Xen_false);
}
-static XEN gxg_gluDeleteNurbsRenderer(XEN nurb)
+static Xen gxg_gluDeleteNurbsRenderer(Xen nurb)
{
#define H_gluDeleteNurbsRenderer "void gluDeleteNurbsRenderer(GLUnurbs* nurb)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluDeleteNurbsRenderer", "GLUnurbs*");
- gluDeleteNurbsRenderer(XEN_TO_C_GLUnurbs_(nurb));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluDeleteNurbsRenderer", "GLUnurbs*");
+ gluDeleteNurbsRenderer(Xen_to_C_GLUnurbs_(nurb));
+ return(Xen_false);
}
-static XEN gxg_gluDeleteQuadric(XEN quad)
+static Xen gxg_gluDeleteQuadric(Xen quad)
{
#define H_gluDeleteQuadric "void gluDeleteQuadric(GLUquadric* quad)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluDeleteQuadric", "GLUquadric*");
- gluDeleteQuadric(XEN_TO_C_GLUquadric_(quad));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluDeleteQuadric", "GLUquadric*");
+ gluDeleteQuadric(Xen_to_C_GLUquadric_(quad));
+ return(Xen_false);
}
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluDeleteTess(XEN tess)
+static Xen gxg_gluDeleteTess(Xen tess)
{
#define H_gluDeleteTess "void gluDeleteTess(GLUtesselator* tess)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluDeleteTess", "GLUtesselator*");
- gluDeleteTess(XEN_TO_C_GLUtesselator_(tess));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluDeleteTess", "GLUtesselator*");
+ gluDeleteTess(Xen_to_C_GLUtesselator_(tess));
+ return(Xen_false);
}
#endif
-static XEN gxg_gluDisk(XEN quad, XEN inner, XEN outer, XEN slices, XEN loops)
+static Xen gxg_gluDisk(Xen quad, Xen inner, Xen outer, Xen slices, Xen loops)
{
#define H_gluDisk "void gluDisk(GLUquadric* quad, GLdouble inner, GLdouble outer, GLint slices, GLint loops)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluDisk", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(inner), inner, 2, "gluDisk", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(outer), outer, 3, "gluDisk", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint_P(slices), slices, 4, "gluDisk", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(loops), loops, 5, "gluDisk", "GLint");
- gluDisk(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLdouble(inner), XEN_TO_C_GLdouble(outer), XEN_TO_C_GLint(slices), XEN_TO_C_GLint(loops));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluDisk", "GLUquadric*");
+ Xen_check_type(Xen_is_GLdouble(inner), inner, 2, "gluDisk", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(outer), outer, 3, "gluDisk", "GLdouble");
+ Xen_check_type(Xen_is_GLint(slices), slices, 4, "gluDisk", "GLint");
+ Xen_check_type(Xen_is_GLint(loops), loops, 5, "gluDisk", "GLint");
+ gluDisk(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLdouble(inner), Xen_to_C_GLdouble(outer), Xen_to_C_GLint(slices), Xen_to_C_GLint(loops));
+ return(Xen_false);
}
-static XEN gxg_gluEndCurve(XEN nurb)
+static Xen gxg_gluEndCurve(Xen nurb)
{
#define H_gluEndCurve "void gluEndCurve(GLUnurbs* nurb)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluEndCurve", "GLUnurbs*");
- gluEndCurve(XEN_TO_C_GLUnurbs_(nurb));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluEndCurve", "GLUnurbs*");
+ gluEndCurve(Xen_to_C_GLUnurbs_(nurb));
+ return(Xen_false);
}
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluEndPolygon(XEN tess)
+static Xen gxg_gluEndPolygon(Xen tess)
{
#define H_gluEndPolygon "void gluEndPolygon(GLUtesselator* tess)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluEndPolygon", "GLUtesselator*");
- gluEndPolygon(XEN_TO_C_GLUtesselator_(tess));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluEndPolygon", "GLUtesselator*");
+ gluEndPolygon(Xen_to_C_GLUtesselator_(tess));
+ return(Xen_false);
}
#endif
-static XEN gxg_gluEndSurface(XEN nurb)
+static Xen gxg_gluEndSurface(Xen nurb)
{
#define H_gluEndSurface "void gluEndSurface(GLUnurbs* nurb)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluEndSurface", "GLUnurbs*");
- gluEndSurface(XEN_TO_C_GLUnurbs_(nurb));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluEndSurface", "GLUnurbs*");
+ gluEndSurface(Xen_to_C_GLUnurbs_(nurb));
+ return(Xen_false);
}
-static XEN gxg_gluEndTrim(XEN nurb)
+static Xen gxg_gluEndTrim(Xen nurb)
{
#define H_gluEndTrim "void gluEndTrim(GLUnurbs* nurb)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluEndTrim", "GLUnurbs*");
- gluEndTrim(XEN_TO_C_GLUnurbs_(nurb));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluEndTrim", "GLUnurbs*");
+ gluEndTrim(Xen_to_C_GLUnurbs_(nurb));
+ return(Xen_false);
}
-static XEN gxg_gluErrorString(XEN error)
+static Xen gxg_gluErrorString(Xen error)
{
#define H_gluErrorString "constchar* gluErrorString(GLenum error)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(error), error, 1, "gluErrorString", "GLenum");
- return(C_TO_XEN_constchar_(gluErrorString(XEN_TO_C_GLenum(error))));
+ Xen_check_type(Xen_is_GLenum(error), error, 1, "gluErrorString", "GLenum");
+ return(C_to_Xen_constchar_(gluErrorString(Xen_to_C_GLenum(error))));
}
-static XEN gxg_gluGetNurbsProperty(XEN nurb, XEN property, XEN data)
+static Xen gxg_gluGetNurbsProperty(Xen nurb, Xen property, Xen data)
{
#define H_gluGetNurbsProperty "void gluGetNurbsProperty(GLUnurbs* nurb, GLenum property, GLfloat* data)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluGetNurbsProperty", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(property), property, 2, "gluGetNurbsProperty", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(data), data, 3, "gluGetNurbsProperty", "GLfloat*");
- gluGetNurbsProperty(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLenum(property), XEN_TO_C_GLfloat_(data));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluGetNurbsProperty", "GLUnurbs*");
+ Xen_check_type(Xen_is_GLenum(property), property, 2, "gluGetNurbsProperty", "GLenum");
+ Xen_check_type(Xen_is_GLfloat_(data), data, 3, "gluGetNurbsProperty", "GLfloat*");
+ gluGetNurbsProperty(Xen_to_C_GLUnurbs_(nurb), Xen_to_C_GLenum(property), Xen_to_C_GLfloat_(data));
+ return(Xen_false);
}
-static XEN gxg_gluGetString(XEN name)
+static Xen gxg_gluGetString(Xen name)
{
#define H_gluGetString "constchar* gluGetString(GLenum name)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(name), name, 1, "gluGetString", "GLenum");
- return(C_TO_XEN_constchar_(gluGetString(XEN_TO_C_GLenum(name))));
+ Xen_check_type(Xen_is_GLenum(name), name, 1, "gluGetString", "GLenum");
+ return(C_to_Xen_constchar_(gluGetString(Xen_to_C_GLenum(name))));
}
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluGetTessProperty(XEN tess, XEN which, XEN data)
+static Xen gxg_gluGetTessProperty(Xen tess, Xen which, Xen data)
{
#define H_gluGetTessProperty "void gluGetTessProperty(GLUtesselator* tess, GLenum which, GLdouble* data)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluGetTessProperty", "GLUtesselator*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(which), which, 2, "gluGetTessProperty", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(data), data, 3, "gluGetTessProperty", "GLdouble*");
- gluGetTessProperty(XEN_TO_C_GLUtesselator_(tess), XEN_TO_C_GLenum(which), XEN_TO_C_GLdouble_(data));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluGetTessProperty", "GLUtesselator*");
+ Xen_check_type(Xen_is_GLenum(which), which, 2, "gluGetTessProperty", "GLenum");
+ Xen_check_type(Xen_is_GLdouble_(data), data, 3, "gluGetTessProperty", "GLdouble*");
+ gluGetTessProperty(Xen_to_C_GLUtesselator_(tess), Xen_to_C_GLenum(which), Xen_to_C_GLdouble_(data));
+ return(Xen_false);
}
#endif
-static XEN gxg_gluLoadSamplingMatrices(XEN nurb, XEN model, XEN perspective, XEN view)
+static Xen gxg_gluLoadSamplingMatrices(Xen nurb, Xen model, Xen perspective, Xen view)
{
#define H_gluLoadSamplingMatrices "void gluLoadSamplingMatrices(GLUnurbs* nurb, GLfloat* model, GLfloat* perspective, \
GLint* view)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluLoadSamplingMatrices", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(model), model, 2, "gluLoadSamplingMatrices", "GLfloat*");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(perspective), perspective, 3, "gluLoadSamplingMatrices", "GLfloat*");
- XEN_ASSERT_TYPE(XEN_GLint__P(view), view, 4, "gluLoadSamplingMatrices", "GLint*");
- gluLoadSamplingMatrices(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLfloat_(model), XEN_TO_C_GLfloat_(perspective), XEN_TO_C_GLint_(view));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluLoadSamplingMatrices", "GLUnurbs*");
+ Xen_check_type(Xen_is_GLfloat_(model), model, 2, "gluLoadSamplingMatrices", "GLfloat*");
+ Xen_check_type(Xen_is_GLfloat_(perspective), perspective, 3, "gluLoadSamplingMatrices", "GLfloat*");
+ Xen_check_type(Xen_is_GLint_(view), view, 4, "gluLoadSamplingMatrices", "GLint*");
+ gluLoadSamplingMatrices(Xen_to_C_GLUnurbs_(nurb), Xen_to_C_GLfloat_(model), Xen_to_C_GLfloat_(perspective), Xen_to_C_GLint_(view));
+ return(Xen_false);
}
-static XEN gxg_gluLookAt(XEN eyeX, XEN eyeY, XEN eyeZ, XEN centerX, XEN centerY, XEN centerZ, XEN upX, XEN upY, XEN upZ)
+static Xen gxg_gluLookAt(Xen arglist)
{
#define H_gluLookAt "void gluLookAt(GLdouble eyeX, GLdouble eyeY, GLdouble eyeZ, GLdouble centerX, \
GLdouble centerY, GLdouble centerZ, GLdouble upX, GLdouble upY, GLdouble upZ)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(eyeX), eyeX, 1, "gluLookAt", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(eyeY), eyeY, 2, "gluLookAt", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(eyeZ), eyeZ, 3, "gluLookAt", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(centerX), centerX, 4, "gluLookAt", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(centerY), centerY, 5, "gluLookAt", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(centerZ), centerZ, 6, "gluLookAt", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(upX), upX, 7, "gluLookAt", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(upY), upY, 8, "gluLookAt", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(upZ), upZ, 9, "gluLookAt", "GLdouble");
- gluLookAt(XEN_TO_C_GLdouble(eyeX), XEN_TO_C_GLdouble(eyeY), XEN_TO_C_GLdouble(eyeZ), XEN_TO_C_GLdouble(centerX), XEN_TO_C_GLdouble(centerY),
- XEN_TO_C_GLdouble(centerZ), XEN_TO_C_GLdouble(upX), XEN_TO_C_GLdouble(upY), XEN_TO_C_GLdouble(upZ));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gluNewNurbsRenderer(void)
+ Xen eyeX, eyeY, eyeZ, centerX, centerY, centerZ, upX, upY, upZ;
+ eyeX = Xen_list_ref(arglist, 0);
+ eyeY = Xen_list_ref(arglist, 1);
+ eyeZ = Xen_list_ref(arglist, 2);
+ centerX = Xen_list_ref(arglist, 3);
+ centerY = Xen_list_ref(arglist, 4);
+ centerZ = Xen_list_ref(arglist, 5);
+ upX = Xen_list_ref(arglist, 6);
+ upY = Xen_list_ref(arglist, 7);
+ upZ = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_GLdouble(eyeX), eyeX, 1, "gluLookAt", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(eyeY), eyeY, 2, "gluLookAt", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(eyeZ), eyeZ, 3, "gluLookAt", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(centerX), centerX, 4, "gluLookAt", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(centerY), centerY, 5, "gluLookAt", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(centerZ), centerZ, 6, "gluLookAt", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(upX), upX, 7, "gluLookAt", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(upY), upY, 8, "gluLookAt", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(upZ), upZ, 9, "gluLookAt", "GLdouble");
+ gluLookAt(Xen_to_C_GLdouble(eyeX), Xen_to_C_GLdouble(eyeY), Xen_to_C_GLdouble(eyeZ), Xen_to_C_GLdouble(centerX), Xen_to_C_GLdouble(centerY),
+ Xen_to_C_GLdouble(centerZ), Xen_to_C_GLdouble(upX), Xen_to_C_GLdouble(upY), Xen_to_C_GLdouble(upZ));
+ return(Xen_false);
+}
+
+static Xen gxg_gluNewNurbsRenderer(void)
{
#define H_gluNewNurbsRenderer "GLUnurbs* gluNewNurbsRenderer( void)"
- return(C_TO_XEN_GLUnurbs_(gluNewNurbsRenderer()));
+ return(C_to_Xen_GLUnurbs_(gluNewNurbsRenderer()));
}
-static XEN gxg_gluNewQuadric(void)
+static Xen gxg_gluNewQuadric(void)
{
#define H_gluNewQuadric "GLUquadric* gluNewQuadric( void)"
- return(C_TO_XEN_GLUquadric_(gluNewQuadric()));
+ return(C_to_Xen_GLUquadric_(gluNewQuadric()));
}
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluNewTess(void)
+static Xen gxg_gluNewTess(void)
{
#define H_gluNewTess "GLUtesselator* gluNewTess( void)"
- return(C_TO_XEN_GLUtesselator_(gluNewTess()));
+ return(C_to_Xen_GLUtesselator_(gluNewTess()));
}
#endif
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluNextContour(XEN tess, XEN type)
+static Xen gxg_gluNextContour(Xen tess, Xen type)
{
#define H_gluNextContour "void gluNextContour(GLUtesselator* tess, GLenum type)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluNextContour", "GLUtesselator*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 2, "gluNextContour", "GLenum");
- gluNextContour(XEN_TO_C_GLUtesselator_(tess), XEN_TO_C_GLenum(type));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluNextContour", "GLUtesselator*");
+ Xen_check_type(Xen_is_GLenum(type), type, 2, "gluNextContour", "GLenum");
+ gluNextContour(Xen_to_C_GLUtesselator_(tess), Xen_to_C_GLenum(type));
+ return(Xen_false);
}
#endif
-static XEN gxg_gluNurbsCallback(XEN nurb, XEN which, XEN CallBackFunc)
+static Xen gxg_gluNurbsCallback(Xen nurb, Xen which, Xen CallBackFunc)
{
#define H_gluNurbsCallback "void gluNurbsCallback(GLUnurbs* nurb, GLenum which, _GLUfuncptr CallBackFunc)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluNurbsCallback", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(which), which, 2, "gluNurbsCallback", "GLenum");
- XEN_ASSERT_TYPE(XEN__GLUfuncptr_P(CallBackFunc), CallBackFunc, 3, "gluNurbsCallback", "_GLUfuncptr");
- gluNurbsCallback(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLenum(which), XEN_TO_C__GLUfuncptr(CallBackFunc));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluNurbsCallback", "GLUnurbs*");
+ Xen_check_type(Xen_is_GLenum(which), which, 2, "gluNurbsCallback", "GLenum");
+ Xen_check_type(Xen_is__GLUfuncptr(CallBackFunc), CallBackFunc, 3, "gluNurbsCallback", "_GLUfuncptr");
+ gluNurbsCallback(Xen_to_C_GLUnurbs_(nurb), Xen_to_C_GLenum(which), Xen_to_C__GLUfuncptr(CallBackFunc));
+ return(Xen_false);
}
-static XEN gxg_gluNurbsCallbackData(XEN nurb, XEN userData)
+static Xen gxg_gluNurbsCallbackData(Xen nurb, Xen userData)
{
#define H_gluNurbsCallbackData "void gluNurbsCallbackData(GLUnurbs* nurb, GLvoid* userData)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluNurbsCallbackData", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(userData), userData, 2, "gluNurbsCallbackData", "GLvoid*");
- gluNurbsCallbackData(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLvoid_(userData));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluNurbsCallbackData", "GLUnurbs*");
+ Xen_check_type(Xen_is_GLvoid_(userData), userData, 2, "gluNurbsCallbackData", "GLvoid*");
+ gluNurbsCallbackData(Xen_to_C_GLUnurbs_(nurb), Xen_to_C_GLvoid_(userData));
+ return(Xen_false);
}
-static XEN gxg_gluNurbsCallbackDataEXT(XEN nurb, XEN userData)
-{
- #define H_gluNurbsCallbackDataEXT "void gluNurbsCallbackDataEXT(GLUnurbs* nurb, GLvoid* userData)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluNurbsCallbackDataEXT", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(userData), userData, 2, "gluNurbsCallbackDataEXT", "GLvoid*");
- gluNurbsCallbackDataEXT(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLvoid_(userData));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gluNurbsCurve(XEN nurb, XEN knotCount, XEN knots, XEN stride, XEN control, XEN order, XEN type)
+static Xen gxg_gluNurbsCurve(Xen nurb, Xen knotCount, Xen knots, Xen stride, Xen control, Xen order, Xen type)
{
#define H_gluNurbsCurve "void gluNurbsCurve(GLUnurbs* nurb, GLint knotCount, GLfloat* knots, GLint stride, \
GLfloat* control, GLint order, GLenum type)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluNurbsCurve", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLint_P(knotCount), knotCount, 2, "gluNurbsCurve", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(knots), knots, 3, "gluNurbsCurve", "GLfloat*");
- XEN_ASSERT_TYPE(XEN_GLint_P(stride), stride, 4, "gluNurbsCurve", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(control), control, 5, "gluNurbsCurve", "GLfloat*");
- XEN_ASSERT_TYPE(XEN_GLint_P(order), order, 6, "gluNurbsCurve", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 7, "gluNurbsCurve", "GLenum");
- gluNurbsCurve(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLint(knotCount), XEN_TO_C_GLfloat_(knots), XEN_TO_C_GLint(stride), XEN_TO_C_GLfloat_(control),
- XEN_TO_C_GLint(order), XEN_TO_C_GLenum(type));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluNurbsCurve", "GLUnurbs*");
+ Xen_check_type(Xen_is_GLint(knotCount), knotCount, 2, "gluNurbsCurve", "GLint");
+ Xen_check_type(Xen_is_GLfloat_(knots), knots, 3, "gluNurbsCurve", "GLfloat*");
+ Xen_check_type(Xen_is_GLint(stride), stride, 4, "gluNurbsCurve", "GLint");
+ Xen_check_type(Xen_is_GLfloat_(control), control, 5, "gluNurbsCurve", "GLfloat*");
+ Xen_check_type(Xen_is_GLint(order), order, 6, "gluNurbsCurve", "GLint");
+ Xen_check_type(Xen_is_GLenum(type), type, 7, "gluNurbsCurve", "GLenum");
+ gluNurbsCurve(Xen_to_C_GLUnurbs_(nurb), Xen_to_C_GLint(knotCount), Xen_to_C_GLfloat_(knots), Xen_to_C_GLint(stride), Xen_to_C_GLfloat_(control),
+ Xen_to_C_GLint(order), Xen_to_C_GLenum(type));
+ return(Xen_false);
}
-static XEN gxg_gluNurbsProperty(XEN nurb, XEN property, XEN value)
+static Xen gxg_gluNurbsProperty(Xen nurb, Xen property, Xen value)
{
#define H_gluNurbsProperty "void gluNurbsProperty(GLUnurbs* nurb, GLenum property, GLfloat value)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluNurbsProperty", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(property), property, 2, "gluNurbsProperty", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLfloat_P(value), value, 3, "gluNurbsProperty", "GLfloat");
- gluNurbsProperty(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLenum(property), XEN_TO_C_GLfloat(value));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluNurbsProperty", "GLUnurbs*");
+ Xen_check_type(Xen_is_GLenum(property), property, 2, "gluNurbsProperty", "GLenum");
+ Xen_check_type(Xen_is_GLfloat(value), value, 3, "gluNurbsProperty", "GLfloat");
+ gluNurbsProperty(Xen_to_C_GLUnurbs_(nurb), Xen_to_C_GLenum(property), Xen_to_C_GLfloat(value));
+ return(Xen_false);
}
-static XEN gxg_gluNurbsSurface(XEN arglist)
+static Xen gxg_gluNurbsSurface(Xen arglist)
{
#define H_gluNurbsSurface "void gluNurbsSurface(GLUnurbs* nurb, GLint sKnotCount, GLfloat* sKnots, \
GLint tKnotCount, GLfloat* tKnots, GLint sStride, GLint tStride, GLfloat* control, GLint sOrder, GLint tOrder, \
GLenum type)"
- XEN nurb, sKnotCount, sKnots, tKnotCount, tKnots, sStride, tStride, control, sOrder, tOrder, type;
- nurb = XEN_LIST_REF(arglist, 0);
- sKnotCount = XEN_LIST_REF(arglist, 1);
- sKnots = XEN_LIST_REF(arglist, 2);
- tKnotCount = XEN_LIST_REF(arglist, 3);
- tKnots = XEN_LIST_REF(arglist, 4);
- sStride = XEN_LIST_REF(arglist, 5);
- tStride = XEN_LIST_REF(arglist, 6);
- control = XEN_LIST_REF(arglist, 7);
- sOrder = XEN_LIST_REF(arglist, 8);
- tOrder = XEN_LIST_REF(arglist, 9);
- type = XEN_LIST_REF(arglist, 10);
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluNurbsSurface", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLint_P(sKnotCount), sKnotCount, 2, "gluNurbsSurface", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(sKnots), sKnots, 3, "gluNurbsSurface", "GLfloat*");
- XEN_ASSERT_TYPE(XEN_GLint_P(tKnotCount), tKnotCount, 4, "gluNurbsSurface", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(tKnots), tKnots, 5, "gluNurbsSurface", "GLfloat*");
- XEN_ASSERT_TYPE(XEN_GLint_P(sStride), sStride, 6, "gluNurbsSurface", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(tStride), tStride, 7, "gluNurbsSurface", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(control), control, 8, "gluNurbsSurface", "GLfloat*");
- XEN_ASSERT_TYPE(XEN_GLint_P(sOrder), sOrder, 9, "gluNurbsSurface", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(tOrder), tOrder, 10, "gluNurbsSurface", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 11, "gluNurbsSurface", "GLenum");
- gluNurbsSurface(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLint(sKnotCount), XEN_TO_C_GLfloat_(sKnots), XEN_TO_C_GLint(tKnotCount),
- XEN_TO_C_GLfloat_(tKnots), XEN_TO_C_GLint(sStride), XEN_TO_C_GLint(tStride), XEN_TO_C_GLfloat_(control),
- XEN_TO_C_GLint(sOrder), XEN_TO_C_GLint(tOrder), XEN_TO_C_GLenum(type));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gluOrtho2D(XEN left, XEN right, XEN bottom, XEN top)
+ Xen nurb, sKnotCount, sKnots, tKnotCount, tKnots, sStride, tStride, control, sOrder, tOrder, type;
+ nurb = Xen_list_ref(arglist, 0);
+ sKnotCount = Xen_list_ref(arglist, 1);
+ sKnots = Xen_list_ref(arglist, 2);
+ tKnotCount = Xen_list_ref(arglist, 3);
+ tKnots = Xen_list_ref(arglist, 4);
+ sStride = Xen_list_ref(arglist, 5);
+ tStride = Xen_list_ref(arglist, 6);
+ control = Xen_list_ref(arglist, 7);
+ sOrder = Xen_list_ref(arglist, 8);
+ tOrder = Xen_list_ref(arglist, 9);
+ type = Xen_list_ref(arglist, 10);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluNurbsSurface", "GLUnurbs*");
+ Xen_check_type(Xen_is_GLint(sKnotCount), sKnotCount, 2, "gluNurbsSurface", "GLint");
+ Xen_check_type(Xen_is_GLfloat_(sKnots), sKnots, 3, "gluNurbsSurface", "GLfloat*");
+ Xen_check_type(Xen_is_GLint(tKnotCount), tKnotCount, 4, "gluNurbsSurface", "GLint");
+ Xen_check_type(Xen_is_GLfloat_(tKnots), tKnots, 5, "gluNurbsSurface", "GLfloat*");
+ Xen_check_type(Xen_is_GLint(sStride), sStride, 6, "gluNurbsSurface", "GLint");
+ Xen_check_type(Xen_is_GLint(tStride), tStride, 7, "gluNurbsSurface", "GLint");
+ Xen_check_type(Xen_is_GLfloat_(control), control, 8, "gluNurbsSurface", "GLfloat*");
+ Xen_check_type(Xen_is_GLint(sOrder), sOrder, 9, "gluNurbsSurface", "GLint");
+ Xen_check_type(Xen_is_GLint(tOrder), tOrder, 10, "gluNurbsSurface", "GLint");
+ Xen_check_type(Xen_is_GLenum(type), type, 11, "gluNurbsSurface", "GLenum");
+ gluNurbsSurface(Xen_to_C_GLUnurbs_(nurb), Xen_to_C_GLint(sKnotCount), Xen_to_C_GLfloat_(sKnots), Xen_to_C_GLint(tKnotCount),
+ Xen_to_C_GLfloat_(tKnots), Xen_to_C_GLint(sStride), Xen_to_C_GLint(tStride), Xen_to_C_GLfloat_(control),
+ Xen_to_C_GLint(sOrder), Xen_to_C_GLint(tOrder), Xen_to_C_GLenum(type));
+ return(Xen_false);
+}
+
+static Xen gxg_gluOrtho2D(Xen left, Xen right, Xen bottom, Xen top)
{
#define H_gluOrtho2D "void gluOrtho2D(GLdouble left, GLdouble right, GLdouble bottom, GLdouble top)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(left), left, 1, "gluOrtho2D", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(right), right, 2, "gluOrtho2D", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(bottom), bottom, 3, "gluOrtho2D", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(top), top, 4, "gluOrtho2D", "GLdouble");
- gluOrtho2D(XEN_TO_C_GLdouble(left), XEN_TO_C_GLdouble(right), XEN_TO_C_GLdouble(bottom), XEN_TO_C_GLdouble(top));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(left), left, 1, "gluOrtho2D", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(right), right, 2, "gluOrtho2D", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(bottom), bottom, 3, "gluOrtho2D", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(top), top, 4, "gluOrtho2D", "GLdouble");
+ gluOrtho2D(Xen_to_C_GLdouble(left), Xen_to_C_GLdouble(right), Xen_to_C_GLdouble(bottom), Xen_to_C_GLdouble(top));
+ return(Xen_false);
}
-static XEN gxg_gluPartialDisk(XEN quad, XEN inner, XEN outer, XEN slices, XEN loops, XEN start, XEN sweep)
+static Xen gxg_gluPartialDisk(Xen quad, Xen inner, Xen outer, Xen slices, Xen loops, Xen start, Xen sweep)
{
#define H_gluPartialDisk "void gluPartialDisk(GLUquadric* quad, GLdouble inner, GLdouble outer, GLint slices, \
GLint loops, GLdouble start, GLdouble sweep)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluPartialDisk", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(inner), inner, 2, "gluPartialDisk", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(outer), outer, 3, "gluPartialDisk", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint_P(slices), slices, 4, "gluPartialDisk", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(loops), loops, 5, "gluPartialDisk", "GLint");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(start), start, 6, "gluPartialDisk", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(sweep), sweep, 7, "gluPartialDisk", "GLdouble");
- gluPartialDisk(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLdouble(inner), XEN_TO_C_GLdouble(outer), XEN_TO_C_GLint(slices),
- XEN_TO_C_GLint(loops), XEN_TO_C_GLdouble(start), XEN_TO_C_GLdouble(sweep));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluPartialDisk", "GLUquadric*");
+ Xen_check_type(Xen_is_GLdouble(inner), inner, 2, "gluPartialDisk", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(outer), outer, 3, "gluPartialDisk", "GLdouble");
+ Xen_check_type(Xen_is_GLint(slices), slices, 4, "gluPartialDisk", "GLint");
+ Xen_check_type(Xen_is_GLint(loops), loops, 5, "gluPartialDisk", "GLint");
+ Xen_check_type(Xen_is_GLdouble(start), start, 6, "gluPartialDisk", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(sweep), sweep, 7, "gluPartialDisk", "GLdouble");
+ gluPartialDisk(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLdouble(inner), Xen_to_C_GLdouble(outer), Xen_to_C_GLint(slices),
+ Xen_to_C_GLint(loops), Xen_to_C_GLdouble(start), Xen_to_C_GLdouble(sweep));
+ return(Xen_false);
}
-static XEN gxg_gluPerspective(XEN fovy, XEN aspect, XEN zNear, XEN zFar)
+static Xen gxg_gluPerspective(Xen fovy, Xen aspect, Xen zNear, Xen zFar)
{
#define H_gluPerspective "void gluPerspective(GLdouble fovy, GLdouble aspect, GLdouble zNear, GLdouble zFar)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(fovy), fovy, 1, "gluPerspective", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(aspect), aspect, 2, "gluPerspective", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(zNear), zNear, 3, "gluPerspective", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(zFar), zFar, 4, "gluPerspective", "GLdouble");
- gluPerspective(XEN_TO_C_GLdouble(fovy), XEN_TO_C_GLdouble(aspect), XEN_TO_C_GLdouble(zNear), XEN_TO_C_GLdouble(zFar));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(fovy), fovy, 1, "gluPerspective", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(aspect), aspect, 2, "gluPerspective", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(zNear), zNear, 3, "gluPerspective", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(zFar), zFar, 4, "gluPerspective", "GLdouble");
+ gluPerspective(Xen_to_C_GLdouble(fovy), Xen_to_C_GLdouble(aspect), Xen_to_C_GLdouble(zNear), Xen_to_C_GLdouble(zFar));
+ return(Xen_false);
}
-static XEN gxg_gluPickMatrix(XEN x, XEN y, XEN delX, XEN delY, XEN viewport)
+static Xen gxg_gluPickMatrix(Xen x, Xen y, Xen delX, Xen delY, Xen viewport)
{
#define H_gluPickMatrix "void gluPickMatrix(GLdouble x, GLdouble y, GLdouble delX, GLdouble delY, GLint* viewport)"
- XEN_ASSERT_TYPE(XEN_GLdouble_P(x), x, 1, "gluPickMatrix", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(y), y, 2, "gluPickMatrix", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(delX), delX, 3, "gluPickMatrix", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(delY), delY, 4, "gluPickMatrix", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint__P(viewport), viewport, 5, "gluPickMatrix", "GLint*");
- gluPickMatrix(XEN_TO_C_GLdouble(x), XEN_TO_C_GLdouble(y), XEN_TO_C_GLdouble(delX), XEN_TO_C_GLdouble(delY), XEN_TO_C_GLint_(viewport));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLdouble(x), x, 1, "gluPickMatrix", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(y), y, 2, "gluPickMatrix", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(delX), delX, 3, "gluPickMatrix", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(delY), delY, 4, "gluPickMatrix", "GLdouble");
+ Xen_check_type(Xen_is_GLint_(viewport), viewport, 5, "gluPickMatrix", "GLint*");
+ gluPickMatrix(Xen_to_C_GLdouble(x), Xen_to_C_GLdouble(y), Xen_to_C_GLdouble(delX), Xen_to_C_GLdouble(delY), Xen_to_C_GLint_(viewport));
+ return(Xen_false);
}
-static XEN gxg_gluProject(XEN objX, XEN objY, XEN objZ, XEN model, XEN proj, XEN view, XEN winX, XEN winY, XEN winZ)
+static Xen gxg_gluProject(Xen arglist)
{
#define H_gluProject "GLint gluProject(GLdouble objX, GLdouble objY, GLdouble objZ, GLdouble* model, \
GLdouble* proj, GLint* view, GLdouble* [winX], GLdouble* [winY], GLdouble* [winZ])"
GLdouble ref_winX[1];
GLdouble ref_winY[1];
GLdouble ref_winZ[1];
- XEN_ASSERT_TYPE(XEN_GLdouble_P(objX), objX, 1, "gluProject", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(objY), objY, 2, "gluProject", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(objZ), objZ, 3, "gluProject", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(model), model, 4, "gluProject", "GLdouble*");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(proj), proj, 5, "gluProject", "GLdouble*");
- XEN_ASSERT_TYPE(XEN_GLint__P(view), view, 6, "gluProject", "GLint*");
+ Xen objX, objY, objZ, model, proj, view;
+ objX = Xen_list_ref(arglist, 0);
+ objY = Xen_list_ref(arglist, 1);
+ objZ = Xen_list_ref(arglist, 2);
+ model = Xen_list_ref(arglist, 3);
+ proj = Xen_list_ref(arglist, 4);
+ view = Xen_list_ref(arglist, 5);
+ Xen_check_type(Xen_is_GLdouble(objX), objX, 1, "gluProject", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(objY), objY, 2, "gluProject", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(objZ), objZ, 3, "gluProject", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble_(model), model, 4, "gluProject", "GLdouble*");
+ Xen_check_type(Xen_is_GLdouble_(proj), proj, 5, "gluProject", "GLdouble*");
+ Xen_check_type(Xen_is_GLint_(view), view, 6, "gluProject", "GLint*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GLint(gluProject(XEN_TO_C_GLdouble(objX), XEN_TO_C_GLdouble(objY), XEN_TO_C_GLdouble(objZ), XEN_TO_C_GLdouble_(model),
- XEN_TO_C_GLdouble_(proj), XEN_TO_C_GLint_(view), ref_winX, ref_winY, ref_winZ));
- return(XEN_LIST_4(result, C_TO_XEN_GLdouble(ref_winX[0]), C_TO_XEN_GLdouble(ref_winY[0]), C_TO_XEN_GLdouble(ref_winZ[0])));
+ Xen result;
+ result = C_to_Xen_GLint(gluProject(Xen_to_C_GLdouble(objX), Xen_to_C_GLdouble(objY), Xen_to_C_GLdouble(objZ), Xen_to_C_GLdouble_(model),
+ Xen_to_C_GLdouble_(proj), Xen_to_C_GLint_(view), ref_winX, ref_winY, ref_winZ));
+ return(Xen_list_4(result, C_to_Xen_GLdouble(ref_winX[0]), C_to_Xen_GLdouble(ref_winY[0]), C_to_Xen_GLdouble(ref_winZ[0])));
}
}
-static XEN gxg_gluPwlCurve(XEN nurb, XEN count, XEN data, XEN stride, XEN type)
+static Xen gxg_gluPwlCurve(Xen nurb, Xen count, Xen data, Xen stride, Xen type)
{
#define H_gluPwlCurve "void gluPwlCurve(GLUnurbs* nurb, GLint count, GLfloat* data, GLint stride, GLenum type)"
- XEN_ASSERT_TYPE(XEN_GLUnurbs__P(nurb), nurb, 1, "gluPwlCurve", "GLUnurbs*");
- XEN_ASSERT_TYPE(XEN_GLint_P(count), count, 2, "gluPwlCurve", "GLint");
- XEN_ASSERT_TYPE(XEN_GLfloat__P(data), data, 3, "gluPwlCurve", "GLfloat*");
- XEN_ASSERT_TYPE(XEN_GLint_P(stride), stride, 4, "gluPwlCurve", "GLint");
- XEN_ASSERT_TYPE(XEN_GLenum_P(type), type, 5, "gluPwlCurve", "GLenum");
- gluPwlCurve(XEN_TO_C_GLUnurbs_(nurb), XEN_TO_C_GLint(count), XEN_TO_C_GLfloat_(data), XEN_TO_C_GLint(stride), XEN_TO_C_GLenum(type));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUnurbs_(nurb), nurb, 1, "gluPwlCurve", "GLUnurbs*");
+ Xen_check_type(Xen_is_GLint(count), count, 2, "gluPwlCurve", "GLint");
+ Xen_check_type(Xen_is_GLfloat_(data), data, 3, "gluPwlCurve", "GLfloat*");
+ Xen_check_type(Xen_is_GLint(stride), stride, 4, "gluPwlCurve", "GLint");
+ Xen_check_type(Xen_is_GLenum(type), type, 5, "gluPwlCurve", "GLenum");
+ gluPwlCurve(Xen_to_C_GLUnurbs_(nurb), Xen_to_C_GLint(count), Xen_to_C_GLfloat_(data), Xen_to_C_GLint(stride), Xen_to_C_GLenum(type));
+ return(Xen_false);
}
-static XEN gxg_gluQuadricCallback(XEN quad, XEN which, XEN CallBackFunc)
+static Xen gxg_gluQuadricCallback(Xen quad, Xen which, Xen CallBackFunc)
{
#define H_gluQuadricCallback "void gluQuadricCallback(GLUquadric* quad, GLenum which, _GLUfuncptr CallBackFunc)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluQuadricCallback", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(which), which, 2, "gluQuadricCallback", "GLenum");
- XEN_ASSERT_TYPE(XEN__GLUfuncptr_P(CallBackFunc), CallBackFunc, 3, "gluQuadricCallback", "_GLUfuncptr");
- gluQuadricCallback(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLenum(which), XEN_TO_C__GLUfuncptr(CallBackFunc));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluQuadricCallback", "GLUquadric*");
+ Xen_check_type(Xen_is_GLenum(which), which, 2, "gluQuadricCallback", "GLenum");
+ Xen_check_type(Xen_is__GLUfuncptr(CallBackFunc), CallBackFunc, 3, "gluQuadricCallback", "_GLUfuncptr");
+ gluQuadricCallback(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLenum(which), Xen_to_C__GLUfuncptr(CallBackFunc));
+ return(Xen_false);
}
-static XEN gxg_gluQuadricDrawStyle(XEN quad, XEN draw)
+static Xen gxg_gluQuadricDrawStyle(Xen quad, Xen draw)
{
#define H_gluQuadricDrawStyle "void gluQuadricDrawStyle(GLUquadric* quad, GLenum draw)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluQuadricDrawStyle", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(draw), draw, 2, "gluQuadricDrawStyle", "GLenum");
- gluQuadricDrawStyle(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLenum(draw));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluQuadricDrawStyle", "GLUquadric*");
+ Xen_check_type(Xen_is_GLenum(draw), draw, 2, "gluQuadricDrawStyle", "GLenum");
+ gluQuadricDrawStyle(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLenum(draw));
+ return(Xen_false);
}
-static XEN gxg_gluQuadricNormals(XEN quad, XEN normal)
+static Xen gxg_gluQuadricNormals(Xen quad, Xen normal)
{
#define H_gluQuadricNormals "void gluQuadricNormals(GLUquadric* quad, GLenum normal)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluQuadricNormals", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(normal), normal, 2, "gluQuadricNormals", "GLenum");
- gluQuadricNormals(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLenum(normal));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluQuadricNormals", "GLUquadric*");
+ Xen_check_type(Xen_is_GLenum(normal), normal, 2, "gluQuadricNormals", "GLenum");
+ gluQuadricNormals(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLenum(normal));
+ return(Xen_false);
}
-static XEN gxg_gluQuadricOrientation(XEN quad, XEN orientation)
+static Xen gxg_gluQuadricOrientation(Xen quad, Xen orientation)
{
#define H_gluQuadricOrientation "void gluQuadricOrientation(GLUquadric* quad, GLenum orientation)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluQuadricOrientation", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(orientation), orientation, 2, "gluQuadricOrientation", "GLenum");
- gluQuadricOrientation(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLenum(orientation));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluQuadricOrientation", "GLUquadric*");
+ Xen_check_type(Xen_is_GLenum(orientation), orientation, 2, "gluQuadricOrientation", "GLenum");
+ gluQuadricOrientation(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLenum(orientation));
+ return(Xen_false);
}
-static XEN gxg_gluQuadricTexture(XEN quad, XEN texture)
+static Xen gxg_gluQuadricTexture(Xen quad, Xen texture)
{
#define H_gluQuadricTexture "void gluQuadricTexture(GLUquadric* quad, GLboolean texture)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluQuadricTexture", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLboolean_P(texture), texture, 2, "gluQuadricTexture", "GLboolean");
- gluQuadricTexture(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLboolean(texture));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluQuadricTexture", "GLUquadric*");
+ Xen_check_type(Xen_is_GLboolean(texture), texture, 2, "gluQuadricTexture", "GLboolean");
+ gluQuadricTexture(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLboolean(texture));
+ return(Xen_false);
}
-static XEN gxg_gluScaleImage(XEN format, XEN wIn, XEN hIn, XEN typeIn, XEN dataIn, XEN wOut, XEN hOut, XEN typeOut, XEN dataOut)
+static Xen gxg_gluScaleImage(Xen arglist)
{
#define H_gluScaleImage "GLint gluScaleImage(GLenum format, GLsizei wIn, GLsizei hIn, GLenum typeIn, \
void* dataIn, GLsizei wOut, GLsizei hOut, GLenum typeOut, GLvoid* dataOut)"
- XEN_ASSERT_TYPE(XEN_GLenum_P(format), format, 1, "gluScaleImage", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(wIn), wIn, 2, "gluScaleImage", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(hIn), hIn, 3, "gluScaleImage", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(typeIn), typeIn, 4, "gluScaleImage", "GLenum");
- XEN_ASSERT_TYPE(XEN_void__P(dataIn), dataIn, 5, "gluScaleImage", "void*");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(wOut), wOut, 6, "gluScaleImage", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLsizei_P(hOut), hOut, 7, "gluScaleImage", "GLsizei");
- XEN_ASSERT_TYPE(XEN_GLenum_P(typeOut), typeOut, 8, "gluScaleImage", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(dataOut), dataOut, 9, "gluScaleImage", "GLvoid*");
- return(C_TO_XEN_GLint(gluScaleImage(XEN_TO_C_GLenum(format), XEN_TO_C_GLsizei(wIn), XEN_TO_C_GLsizei(hIn), XEN_TO_C_GLenum(typeIn),
- XEN_TO_C_void_(dataIn), XEN_TO_C_GLsizei(wOut), XEN_TO_C_GLsizei(hOut), XEN_TO_C_GLenum(typeOut),
- XEN_TO_C_GLvoid_(dataOut))));
-}
-
-static XEN gxg_gluSphere(XEN quad, XEN radius, XEN slices, XEN stacks)
+ Xen format, wIn, hIn, typeIn, dataIn, wOut, hOut, typeOut, dataOut;
+ format = Xen_list_ref(arglist, 0);
+ wIn = Xen_list_ref(arglist, 1);
+ hIn = Xen_list_ref(arglist, 2);
+ typeIn = Xen_list_ref(arglist, 3);
+ dataIn = Xen_list_ref(arglist, 4);
+ wOut = Xen_list_ref(arglist, 5);
+ hOut = Xen_list_ref(arglist, 6);
+ typeOut = Xen_list_ref(arglist, 7);
+ dataOut = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_GLenum(format), format, 1, "gluScaleImage", "GLenum");
+ Xen_check_type(Xen_is_GLsizei(wIn), wIn, 2, "gluScaleImage", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(hIn), hIn, 3, "gluScaleImage", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(typeIn), typeIn, 4, "gluScaleImage", "GLenum");
+ Xen_check_type(Xen_is_void_(dataIn), dataIn, 5, "gluScaleImage", "void*");
+ Xen_check_type(Xen_is_GLsizei(wOut), wOut, 6, "gluScaleImage", "GLsizei");
+ Xen_check_type(Xen_is_GLsizei(hOut), hOut, 7, "gluScaleImage", "GLsizei");
+ Xen_check_type(Xen_is_GLenum(typeOut), typeOut, 8, "gluScaleImage", "GLenum");
+ Xen_check_type(Xen_is_GLvoid_(dataOut), dataOut, 9, "gluScaleImage", "GLvoid*");
+ return(C_to_Xen_GLint(gluScaleImage(Xen_to_C_GLenum(format), Xen_to_C_GLsizei(wIn), Xen_to_C_GLsizei(hIn), Xen_to_C_GLenum(typeIn),
+ Xen_to_C_void_(dataIn), Xen_to_C_GLsizei(wOut), Xen_to_C_GLsizei(hOut), Xen_to_C_GLenum(typeOut),
+ Xen_to_C_GLvoid_(dataOut))));
+}
+
+static Xen gxg_gluSphere(Xen quad, Xen radius, Xen slices, Xen stacks)
{
#define H_gluSphere "void gluSphere(GLUquadric* quad, GLdouble radius, GLint slices, GLint stacks)"
- XEN_ASSERT_TYPE(XEN_GLUquadric__P(quad), quad, 1, "gluSphere", "GLUquadric*");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(radius), radius, 2, "gluSphere", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLint_P(slices), slices, 3, "gluSphere", "GLint");
- XEN_ASSERT_TYPE(XEN_GLint_P(stacks), stacks, 4, "gluSphere", "GLint");
- gluSphere(XEN_TO_C_GLUquadric_(quad), XEN_TO_C_GLdouble(radius), XEN_TO_C_GLint(slices), XEN_TO_C_GLint(stacks));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUquadric_(quad), quad, 1, "gluSphere", "GLUquadric*");
+ Xen_check_type(Xen_is_GLdouble(radius), radius, 2, "gluSphere", "GLdouble");
+ Xen_check_type(Xen_is_GLint(slices), slices, 3, "gluSphere", "GLint");
+ Xen_check_type(Xen_is_GLint(stacks), stacks, 4, "gluSphere", "GLint");
+ gluSphere(Xen_to_C_GLUquadric_(quad), Xen_to_C_GLdouble(radius), Xen_to_C_GLint(slices), Xen_to_C_GLint(stacks));
+ return(Xen_false);
}
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluTessBeginContour(XEN tess)
+static Xen gxg_gluTessBeginContour(Xen tess)
{
#define H_gluTessBeginContour "void gluTessBeginContour(GLUtesselator* tess)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluTessBeginContour", "GLUtesselator*");
- gluTessBeginContour(XEN_TO_C_GLUtesselator_(tess));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluTessBeginContour", "GLUtesselator*");
+ gluTessBeginContour(Xen_to_C_GLUtesselator_(tess));
+ return(Xen_false);
}
#endif
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluTessBeginPolygon(XEN tess, XEN data)
+static Xen gxg_gluTessBeginPolygon(Xen tess, Xen data)
{
#define H_gluTessBeginPolygon "void gluTessBeginPolygon(GLUtesselator* tess, GLvoid* data)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluTessBeginPolygon", "GLUtesselator*");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(data), data, 2, "gluTessBeginPolygon", "GLvoid*");
- gluTessBeginPolygon(XEN_TO_C_GLUtesselator_(tess), XEN_TO_C_GLvoid_(data));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluTessBeginPolygon", "GLUtesselator*");
+ Xen_check_type(Xen_is_GLvoid_(data), data, 2, "gluTessBeginPolygon", "GLvoid*");
+ gluTessBeginPolygon(Xen_to_C_GLUtesselator_(tess), Xen_to_C_GLvoid_(data));
+ return(Xen_false);
}
#endif
-static XEN gxg_gluTessCallback(XEN tess, XEN which, XEN CallBackFunc)
+static Xen gxg_gluTessCallback(Xen tess, Xen which, Xen CallBackFunc)
{
#define H_gluTessCallback "void gluTessCallback(GLUtesselator* tess, GLenum which, _GLUfuncptr CallBackFunc)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluTessCallback", "GLUtesselator*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(which), which, 2, "gluTessCallback", "GLenum");
- XEN_ASSERT_TYPE(XEN__GLUfuncptr_P(CallBackFunc), CallBackFunc, 3, "gluTessCallback", "_GLUfuncptr");
- gluTessCallback(XEN_TO_C_GLUtesselator_(tess), XEN_TO_C_GLenum(which), XEN_TO_C__GLUfuncptr(CallBackFunc));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluTessCallback", "GLUtesselator*");
+ Xen_check_type(Xen_is_GLenum(which), which, 2, "gluTessCallback", "GLenum");
+ Xen_check_type(Xen_is__GLUfuncptr(CallBackFunc), CallBackFunc, 3, "gluTessCallback", "_GLUfuncptr");
+ gluTessCallback(Xen_to_C_GLUtesselator_(tess), Xen_to_C_GLenum(which), Xen_to_C__GLUfuncptr(CallBackFunc));
+ return(Xen_false);
}
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluTessEndContour(XEN tess)
+static Xen gxg_gluTessEndContour(Xen tess)
{
#define H_gluTessEndContour "void gluTessEndContour(GLUtesselator* tess)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluTessEndContour", "GLUtesselator*");
- gluTessEndContour(XEN_TO_C_GLUtesselator_(tess));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluTessEndContour", "GLUtesselator*");
+ gluTessEndContour(Xen_to_C_GLUtesselator_(tess));
+ return(Xen_false);
}
#endif
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluTessEndPolygon(XEN tess)
+static Xen gxg_gluTessEndPolygon(Xen tess)
{
#define H_gluTessEndPolygon "void gluTessEndPolygon(GLUtesselator* tess)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluTessEndPolygon", "GLUtesselator*");
- gluTessEndPolygon(XEN_TO_C_GLUtesselator_(tess));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluTessEndPolygon", "GLUtesselator*");
+ gluTessEndPolygon(Xen_to_C_GLUtesselator_(tess));
+ return(Xen_false);
}
#endif
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluTessNormal(XEN tess, XEN valueX, XEN valueY, XEN valueZ)
+static Xen gxg_gluTessNormal(Xen tess, Xen valueX, Xen valueY, Xen valueZ)
{
#define H_gluTessNormal "void gluTessNormal(GLUtesselator* tess, GLdouble valueX, GLdouble valueY, \
GLdouble valueZ)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluTessNormal", "GLUtesselator*");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(valueX), valueX, 2, "gluTessNormal", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(valueY), valueY, 3, "gluTessNormal", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(valueZ), valueZ, 4, "gluTessNormal", "GLdouble");
- gluTessNormal(XEN_TO_C_GLUtesselator_(tess), XEN_TO_C_GLdouble(valueX), XEN_TO_C_GLdouble(valueY), XEN_TO_C_GLdouble(valueZ));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluTessNormal", "GLUtesselator*");
+ Xen_check_type(Xen_is_GLdouble(valueX), valueX, 2, "gluTessNormal", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(valueY), valueY, 3, "gluTessNormal", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(valueZ), valueZ, 4, "gluTessNormal", "GLdouble");
+ gluTessNormal(Xen_to_C_GLUtesselator_(tess), Xen_to_C_GLdouble(valueX), Xen_to_C_GLdouble(valueY), Xen_to_C_GLdouble(valueZ));
+ return(Xen_false);
}
#endif
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluTessProperty(XEN tess, XEN which, XEN data)
+static Xen gxg_gluTessProperty(Xen tess, Xen which, Xen data)
{
#define H_gluTessProperty "void gluTessProperty(GLUtesselator* tess, GLenum which, GLdouble data)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluTessProperty", "GLUtesselator*");
- XEN_ASSERT_TYPE(XEN_GLenum_P(which), which, 2, "gluTessProperty", "GLenum");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(data), data, 3, "gluTessProperty", "GLdouble");
- gluTessProperty(XEN_TO_C_GLUtesselator_(tess), XEN_TO_C_GLenum(which), XEN_TO_C_GLdouble(data));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluTessProperty", "GLUtesselator*");
+ Xen_check_type(Xen_is_GLenum(which), which, 2, "gluTessProperty", "GLenum");
+ Xen_check_type(Xen_is_GLdouble(data), data, 3, "gluTessProperty", "GLdouble");
+ gluTessProperty(Xen_to_C_GLUtesselator_(tess), Xen_to_C_GLenum(which), Xen_to_C_GLdouble(data));
+ return(Xen_false);
}
#endif
#ifdef GLU_VERSION_1_2
-static XEN gxg_gluTessVertex(XEN tess, XEN location, XEN data)
+static Xen gxg_gluTessVertex(Xen tess, Xen location, Xen data)
{
#define H_gluTessVertex "void gluTessVertex(GLUtesselator* tess, GLdouble* location, GLvoid* data)"
- XEN_ASSERT_TYPE(XEN_GLUtesselator__P(tess), tess, 1, "gluTessVertex", "GLUtesselator*");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(location), location, 2, "gluTessVertex", "GLdouble*");
- XEN_ASSERT_TYPE(XEN_GLvoid__P(data), data, 3, "gluTessVertex", "GLvoid*");
- gluTessVertex(XEN_TO_C_GLUtesselator_(tess), XEN_TO_C_GLdouble_(location), XEN_TO_C_GLvoid_(data));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GLUtesselator_(tess), tess, 1, "gluTessVertex", "GLUtesselator*");
+ Xen_check_type(Xen_is_GLdouble_(location), location, 2, "gluTessVertex", "GLdouble*");
+ Xen_check_type(Xen_is_GLvoid_(data), data, 3, "gluTessVertex", "GLvoid*");
+ gluTessVertex(Xen_to_C_GLUtesselator_(tess), Xen_to_C_GLdouble_(location), Xen_to_C_GLvoid_(data));
+ return(Xen_false);
}
#endif
-static XEN gxg_gluUnProject(XEN winX, XEN winY, XEN winZ, XEN model, XEN proj, XEN view, XEN objX, XEN objY, XEN objZ)
+static Xen gxg_gluUnProject(Xen arglist)
{
#define H_gluUnProject "GLint gluUnProject(GLdouble winX, GLdouble winY, GLdouble winZ, GLdouble* model, \
GLdouble* proj, GLint* view, GLdouble* [objX], GLdouble* [objY], GLdouble* [objZ])"
GLdouble ref_objX[1];
GLdouble ref_objY[1];
GLdouble ref_objZ[1];
- XEN_ASSERT_TYPE(XEN_GLdouble_P(winX), winX, 1, "gluUnProject", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(winY), winY, 2, "gluUnProject", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(winZ), winZ, 3, "gluUnProject", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(model), model, 4, "gluUnProject", "GLdouble*");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(proj), proj, 5, "gluUnProject", "GLdouble*");
- XEN_ASSERT_TYPE(XEN_GLint__P(view), view, 6, "gluUnProject", "GLint*");
+ Xen winX, winY, winZ, model, proj, view;
+ winX = Xen_list_ref(arglist, 0);
+ winY = Xen_list_ref(arglist, 1);
+ winZ = Xen_list_ref(arglist, 2);
+ model = Xen_list_ref(arglist, 3);
+ proj = Xen_list_ref(arglist, 4);
+ view = Xen_list_ref(arglist, 5);
+ Xen_check_type(Xen_is_GLdouble(winX), winX, 1, "gluUnProject", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(winY), winY, 2, "gluUnProject", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(winZ), winZ, 3, "gluUnProject", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble_(model), model, 4, "gluUnProject", "GLdouble*");
+ Xen_check_type(Xen_is_GLdouble_(proj), proj, 5, "gluUnProject", "GLdouble*");
+ Xen_check_type(Xen_is_GLint_(view), view, 6, "gluUnProject", "GLint*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GLint(gluUnProject(XEN_TO_C_GLdouble(winX), XEN_TO_C_GLdouble(winY), XEN_TO_C_GLdouble(winZ), XEN_TO_C_GLdouble_(model),
- XEN_TO_C_GLdouble_(proj), XEN_TO_C_GLint_(view), ref_objX, ref_objY, ref_objZ));
- return(XEN_LIST_4(result, C_TO_XEN_GLdouble(ref_objX[0]), C_TO_XEN_GLdouble(ref_objY[0]), C_TO_XEN_GLdouble(ref_objZ[0])));
+ Xen result;
+ result = C_to_Xen_GLint(gluUnProject(Xen_to_C_GLdouble(winX), Xen_to_C_GLdouble(winY), Xen_to_C_GLdouble(winZ), Xen_to_C_GLdouble_(model),
+ Xen_to_C_GLdouble_(proj), Xen_to_C_GLint_(view), ref_objX, ref_objY, ref_objZ));
+ return(Xen_list_4(result, C_to_Xen_GLdouble(ref_objX[0]), C_to_Xen_GLdouble(ref_objY[0]), C_to_Xen_GLdouble(ref_objZ[0])));
}
}
-static XEN gxg_gluUnProject4(XEN arglist)
+static Xen gxg_gluUnProject4(Xen arglist)
{
#define H_gluUnProject4 "GLint gluUnProject4(GLdouble winX, GLdouble winY, GLdouble winZ, GLdouble clipW, \
GLdouble* model, GLdouble* proj, GLint* view, GLdouble near, GLdouble far, GLdouble* [objX], GLdouble* [objY], \
@@ -3926,1176 +4045,859 @@ GLdouble* [objZ], GLdouble* [objW])"
GLdouble ref_objY[1];
GLdouble ref_objZ[1];
GLdouble ref_objW[1];
- XEN winX, winY, winZ, clipW, model, proj, view, near, far;
- winX = XEN_LIST_REF(arglist, 0);
- winY = XEN_LIST_REF(arglist, 1);
- winZ = XEN_LIST_REF(arglist, 2);
- clipW = XEN_LIST_REF(arglist, 3);
- model = XEN_LIST_REF(arglist, 4);
- proj = XEN_LIST_REF(arglist, 5);
- view = XEN_LIST_REF(arglist, 6);
- near = XEN_LIST_REF(arglist, 7);
- far = XEN_LIST_REF(arglist, 8);
- XEN_ASSERT_TYPE(XEN_GLdouble_P(winX), winX, 1, "gluUnProject4", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(winY), winY, 2, "gluUnProject4", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(winZ), winZ, 3, "gluUnProject4", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(clipW), clipW, 4, "gluUnProject4", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(model), model, 5, "gluUnProject4", "GLdouble*");
- XEN_ASSERT_TYPE(XEN_GLdouble__P(proj), proj, 6, "gluUnProject4", "GLdouble*");
- XEN_ASSERT_TYPE(XEN_GLint__P(view), view, 7, "gluUnProject4", "GLint*");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(near), near, 8, "gluUnProject4", "GLdouble");
- XEN_ASSERT_TYPE(XEN_GLdouble_P(far), far, 9, "gluUnProject4", "GLdouble");
+ Xen winX, winY, winZ, clipW, model, proj, view, near, far;
+ winX = Xen_list_ref(arglist, 0);
+ winY = Xen_list_ref(arglist, 1);
+ winZ = Xen_list_ref(arglist, 2);
+ clipW = Xen_list_ref(arglist, 3);
+ model = Xen_list_ref(arglist, 4);
+ proj = Xen_list_ref(arglist, 5);
+ view = Xen_list_ref(arglist, 6);
+ near = Xen_list_ref(arglist, 7);
+ far = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_GLdouble(winX), winX, 1, "gluUnProject4", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(winY), winY, 2, "gluUnProject4", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(winZ), winZ, 3, "gluUnProject4", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(clipW), clipW, 4, "gluUnProject4", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble_(model), model, 5, "gluUnProject4", "GLdouble*");
+ Xen_check_type(Xen_is_GLdouble_(proj), proj, 6, "gluUnProject4", "GLdouble*");
+ Xen_check_type(Xen_is_GLint_(view), view, 7, "gluUnProject4", "GLint*");
+ Xen_check_type(Xen_is_GLdouble(near), near, 8, "gluUnProject4", "GLdouble");
+ Xen_check_type(Xen_is_GLdouble(far), far, 9, "gluUnProject4", "GLdouble");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GLint(gluUnProject4(XEN_TO_C_GLdouble(winX), XEN_TO_C_GLdouble(winY), XEN_TO_C_GLdouble(winZ), XEN_TO_C_GLdouble(clipW),
- XEN_TO_C_GLdouble_(model), XEN_TO_C_GLdouble_(proj), XEN_TO_C_GLint_(view), XEN_TO_C_GLdouble(near),
- XEN_TO_C_GLdouble(far), ref_objX, ref_objY, ref_objZ, ref_objW));
- return(XEN_LIST_5(result, C_TO_XEN_GLdouble(ref_objX[0]), C_TO_XEN_GLdouble(ref_objY[0]), C_TO_XEN_GLdouble(ref_objZ[0]), C_TO_XEN_GLdouble(ref_objW[0])));
+ Xen result;
+ result = C_to_Xen_GLint(gluUnProject4(Xen_to_C_GLdouble(winX), Xen_to_C_GLdouble(winY), Xen_to_C_GLdouble(winZ), Xen_to_C_GLdouble(clipW),
+ Xen_to_C_GLdouble_(model), Xen_to_C_GLdouble_(proj), Xen_to_C_GLint_(view), Xen_to_C_GLdouble(near),
+ Xen_to_C_GLdouble(far), ref_objX, ref_objY, ref_objZ, ref_objW));
+ return(Xen_list_5(result, C_to_Xen_GLdouble(ref_objX[0]), C_to_Xen_GLdouble(ref_objY[0]), C_to_Xen_GLdouble(ref_objZ[0]), C_to_Xen_GLdouble(ref_objW[0])));
}
}
#endif
-#ifdef XEN_ARGIFY_1
#if USE_MOTIF
-XEN_NARGIFY_3(gxg_glXChooseVisual_w, gxg_glXChooseVisual)
-XEN_NARGIFY_4(gxg_glXCopyContext_w, gxg_glXCopyContext)
-XEN_NARGIFY_4(gxg_glXCreateContext_w, gxg_glXCreateContext)
-XEN_NARGIFY_3(gxg_glXCreateGLXPixmap_w, gxg_glXCreateGLXPixmap)
-XEN_NARGIFY_2(gxg_glXDestroyContext_w, gxg_glXDestroyContext)
-XEN_NARGIFY_2(gxg_glXDestroyGLXPixmap_w, gxg_glXDestroyGLXPixmap)
-XEN_ARGIFY_4(gxg_glXGetConfig_w, gxg_glXGetConfig)
-XEN_NARGIFY_0(gxg_glXGetCurrentContext_w, gxg_glXGetCurrentContext)
-XEN_NARGIFY_0(gxg_glXGetCurrentDrawable_w, gxg_glXGetCurrentDrawable)
-XEN_NARGIFY_2(gxg_glXIsDirect_w, gxg_glXIsDirect)
-XEN_NARGIFY_3(gxg_glXMakeCurrent_w, gxg_glXMakeCurrent)
-XEN_ARGIFY_3(gxg_glXQueryExtension_w, gxg_glXQueryExtension)
-XEN_ARGIFY_3(gxg_glXQueryVersion_w, gxg_glXQueryVersion)
-XEN_NARGIFY_2(gxg_glXSwapBuffers_w, gxg_glXSwapBuffers)
-XEN_NARGIFY_4(gxg_glXUseXFont_w, gxg_glXUseXFont)
-XEN_NARGIFY_0(gxg_glXWaitGL_w, gxg_glXWaitGL)
-XEN_NARGIFY_0(gxg_glXWaitX_w, gxg_glXWaitX)
-XEN_NARGIFY_2(gxg_glXGetClientString_w, gxg_glXGetClientString)
-XEN_NARGIFY_3(gxg_glXQueryServerString_w, gxg_glXQueryServerString)
-XEN_NARGIFY_2(gxg_glXQueryExtensionsString_w, gxg_glXQueryExtensionsString)
+Xen_wrap_3_args(gxg_glXChooseVisual_w, gxg_glXChooseVisual)
+Xen_wrap_4_args(gxg_glXCopyContext_w, gxg_glXCopyContext)
+Xen_wrap_4_args(gxg_glXCreateContext_w, gxg_glXCreateContext)
+Xen_wrap_3_args(gxg_glXCreateGLXPixmap_w, gxg_glXCreateGLXPixmap)
+Xen_wrap_2_args(gxg_glXDestroyContext_w, gxg_glXDestroyContext)
+Xen_wrap_2_args(gxg_glXDestroyGLXPixmap_w, gxg_glXDestroyGLXPixmap)
+Xen_wrap_4_optional_args(gxg_glXGetConfig_w, gxg_glXGetConfig)
+Xen_wrap_no_args(gxg_glXGetCurrentContext_w, gxg_glXGetCurrentContext)
+Xen_wrap_no_args(gxg_glXGetCurrentDrawable_w, gxg_glXGetCurrentDrawable)
+Xen_wrap_2_args(gxg_glXIsDirect_w, gxg_glXIsDirect)
+Xen_wrap_3_args(gxg_glXMakeCurrent_w, gxg_glXMakeCurrent)
+Xen_wrap_3_optional_args(gxg_glXQueryExtension_w, gxg_glXQueryExtension)
+Xen_wrap_3_optional_args(gxg_glXQueryVersion_w, gxg_glXQueryVersion)
+Xen_wrap_2_args(gxg_glXSwapBuffers_w, gxg_glXSwapBuffers)
+Xen_wrap_4_args(gxg_glXUseXFont_w, gxg_glXUseXFont)
+Xen_wrap_no_args(gxg_glXWaitGL_w, gxg_glXWaitGL)
+Xen_wrap_no_args(gxg_glXWaitX_w, gxg_glXWaitX)
+Xen_wrap_2_args(gxg_glXGetClientString_w, gxg_glXGetClientString)
+Xen_wrap_3_args(gxg_glXQueryServerString_w, gxg_glXQueryServerString)
+Xen_wrap_2_args(gxg_glXQueryExtensionsString_w, gxg_glXQueryExtensionsString)
#endif
-XEN_NARGIFY_1(gxg_glClearIndex_w, gxg_glClearIndex)
-XEN_NARGIFY_4(gxg_glClearColor_w, gxg_glClearColor)
-XEN_NARGIFY_1(gxg_glClear_w, gxg_glClear)
-XEN_NARGIFY_1(gxg_glIndexMask_w, gxg_glIndexMask)
-XEN_NARGIFY_4(gxg_glColorMask_w, gxg_glColorMask)
-XEN_NARGIFY_2(gxg_glAlphaFunc_w, gxg_glAlphaFunc)
-XEN_NARGIFY_2(gxg_glBlendFunc_w, gxg_glBlendFunc)
-XEN_NARGIFY_1(gxg_glLogicOp_w, gxg_glLogicOp)
-XEN_NARGIFY_1(gxg_glCullFace_w, gxg_glCullFace)
-XEN_NARGIFY_1(gxg_glFrontFace_w, gxg_glFrontFace)
-XEN_NARGIFY_1(gxg_glPointSize_w, gxg_glPointSize)
-XEN_NARGIFY_1(gxg_glLineWidth_w, gxg_glLineWidth)
-XEN_NARGIFY_2(gxg_glLineStipple_w, gxg_glLineStipple)
-XEN_NARGIFY_2(gxg_glPolygonMode_w, gxg_glPolygonMode)
-XEN_NARGIFY_2(gxg_glPolygonOffset_w, gxg_glPolygonOffset)
-XEN_NARGIFY_1(gxg_glPolygonStipple_w, gxg_glPolygonStipple)
-XEN_NARGIFY_1(gxg_glEdgeFlag_w, gxg_glEdgeFlag)
-XEN_NARGIFY_4(gxg_glScissor_w, gxg_glScissor)
-XEN_NARGIFY_2(gxg_glClipPlane_w, gxg_glClipPlane)
-XEN_ARGIFY_2(gxg_glGetClipPlane_w, gxg_glGetClipPlane)
-XEN_NARGIFY_1(gxg_glDrawBuffer_w, gxg_glDrawBuffer)
-XEN_NARGIFY_1(gxg_glReadBuffer_w, gxg_glReadBuffer)
-XEN_NARGIFY_1(gxg_glEnable_w, gxg_glEnable)
-XEN_NARGIFY_1(gxg_glDisable_w, gxg_glDisable)
-XEN_NARGIFY_1(gxg_glIsEnabled_w, gxg_glIsEnabled)
-XEN_NARGIFY_1(gxg_glEnableClientState_w, gxg_glEnableClientState)
-XEN_NARGIFY_1(gxg_glDisableClientState_w, gxg_glDisableClientState)
-XEN_ARGIFY_2(gxg_glGetBooleanv_w, gxg_glGetBooleanv)
-XEN_ARGIFY_2(gxg_glGetDoublev_w, gxg_glGetDoublev)
-XEN_ARGIFY_2(gxg_glGetFloatv_w, gxg_glGetFloatv)
-XEN_ARGIFY_2(gxg_glGetIntegerv_w, gxg_glGetIntegerv)
-XEN_NARGIFY_1(gxg_glPushAttrib_w, gxg_glPushAttrib)
-XEN_NARGIFY_0(gxg_glPopAttrib_w, gxg_glPopAttrib)
-XEN_NARGIFY_1(gxg_glPushClientAttrib_w, gxg_glPushClientAttrib)
-XEN_NARGIFY_0(gxg_glPopClientAttrib_w, gxg_glPopClientAttrib)
-XEN_NARGIFY_1(gxg_glRenderMode_w, gxg_glRenderMode)
-XEN_NARGIFY_0(gxg_glGetError_w, gxg_glGetError)
-XEN_NARGIFY_1(gxg_glGetString_w, gxg_glGetString)
-XEN_NARGIFY_0(gxg_glFinish_w, gxg_glFinish)
-XEN_NARGIFY_0(gxg_glFlush_w, gxg_glFlush)
-XEN_NARGIFY_2(gxg_glHint_w, gxg_glHint)
-XEN_NARGIFY_1(gxg_glClearDepth_w, gxg_glClearDepth)
-XEN_NARGIFY_1(gxg_glDepthFunc_w, gxg_glDepthFunc)
-XEN_NARGIFY_1(gxg_glDepthMask_w, gxg_glDepthMask)
-XEN_NARGIFY_2(gxg_glDepthRange_w, gxg_glDepthRange)
-XEN_NARGIFY_4(gxg_glClearAccum_w, gxg_glClearAccum)
-XEN_NARGIFY_2(gxg_glAccum_w, gxg_glAccum)
-XEN_NARGIFY_1(gxg_glMatrixMode_w, gxg_glMatrixMode)
-XEN_NARGIFY_6(gxg_glOrtho_w, gxg_glOrtho)
-XEN_NARGIFY_6(gxg_glFrustum_w, gxg_glFrustum)
-XEN_NARGIFY_4(gxg_glViewport_w, gxg_glViewport)
-XEN_NARGIFY_0(gxg_glPushMatrix_w, gxg_glPushMatrix)
-XEN_NARGIFY_0(gxg_glPopMatrix_w, gxg_glPopMatrix)
-XEN_NARGIFY_0(gxg_glLoadIdentity_w, gxg_glLoadIdentity)
-XEN_NARGIFY_1(gxg_glLoadMatrixd_w, gxg_glLoadMatrixd)
-XEN_NARGIFY_1(gxg_glLoadMatrixf_w, gxg_glLoadMatrixf)
-XEN_NARGIFY_1(gxg_glMultMatrixd_w, gxg_glMultMatrixd)
-XEN_NARGIFY_1(gxg_glMultMatrixf_w, gxg_glMultMatrixf)
-XEN_NARGIFY_4(gxg_glRotated_w, gxg_glRotated)
-XEN_NARGIFY_4(gxg_glRotatef_w, gxg_glRotatef)
-XEN_NARGIFY_3(gxg_glScaled_w, gxg_glScaled)
-XEN_NARGIFY_3(gxg_glScalef_w, gxg_glScalef)
-XEN_NARGIFY_3(gxg_glTranslated_w, gxg_glTranslated)
-XEN_NARGIFY_3(gxg_glTranslatef_w, gxg_glTranslatef)
-XEN_NARGIFY_1(gxg_glIsList_w, gxg_glIsList)
-XEN_NARGIFY_2(gxg_glDeleteLists_w, gxg_glDeleteLists)
-XEN_NARGIFY_1(gxg_glGenLists_w, gxg_glGenLists)
-XEN_NARGIFY_2(gxg_glNewList_w, gxg_glNewList)
-XEN_NARGIFY_0(gxg_glEndList_w, gxg_glEndList)
-XEN_NARGIFY_1(gxg_glCallList_w, gxg_glCallList)
-XEN_NARGIFY_3(gxg_glCallLists_w, gxg_glCallLists)
-XEN_NARGIFY_1(gxg_glListBase_w, gxg_glListBase)
-XEN_NARGIFY_1(gxg_glBegin_w, gxg_glBegin)
-XEN_NARGIFY_0(gxg_glEnd_w, gxg_glEnd)
-XEN_NARGIFY_2(gxg_glVertex2d_w, gxg_glVertex2d)
-XEN_NARGIFY_2(gxg_glVertex2f_w, gxg_glVertex2f)
-XEN_NARGIFY_2(gxg_glVertex2i_w, gxg_glVertex2i)
-XEN_NARGIFY_2(gxg_glVertex2s_w, gxg_glVertex2s)
-XEN_NARGIFY_3(gxg_glVertex3d_w, gxg_glVertex3d)
-XEN_NARGIFY_3(gxg_glVertex3f_w, gxg_glVertex3f)
-XEN_NARGIFY_3(gxg_glVertex3i_w, gxg_glVertex3i)
-XEN_NARGIFY_3(gxg_glVertex3s_w, gxg_glVertex3s)
-XEN_NARGIFY_4(gxg_glVertex4d_w, gxg_glVertex4d)
-XEN_NARGIFY_4(gxg_glVertex4f_w, gxg_glVertex4f)
-XEN_NARGIFY_4(gxg_glVertex4i_w, gxg_glVertex4i)
-XEN_NARGIFY_4(gxg_glVertex4s_w, gxg_glVertex4s)
-XEN_NARGIFY_3(gxg_glNormal3b_w, gxg_glNormal3b)
-XEN_NARGIFY_3(gxg_glNormal3d_w, gxg_glNormal3d)
-XEN_NARGIFY_3(gxg_glNormal3f_w, gxg_glNormal3f)
-XEN_NARGIFY_3(gxg_glNormal3i_w, gxg_glNormal3i)
-XEN_NARGIFY_3(gxg_glNormal3s_w, gxg_glNormal3s)
-XEN_NARGIFY_1(gxg_glIndexd_w, gxg_glIndexd)
-XEN_NARGIFY_1(gxg_glIndexf_w, gxg_glIndexf)
-XEN_NARGIFY_1(gxg_glIndexi_w, gxg_glIndexi)
-XEN_NARGIFY_1(gxg_glIndexs_w, gxg_glIndexs)
-XEN_NARGIFY_1(gxg_glIndexub_w, gxg_glIndexub)
-XEN_NARGIFY_3(gxg_glColor3b_w, gxg_glColor3b)
-XEN_NARGIFY_3(gxg_glColor3d_w, gxg_glColor3d)
-XEN_NARGIFY_3(gxg_glColor3f_w, gxg_glColor3f)
-XEN_NARGIFY_3(gxg_glColor3i_w, gxg_glColor3i)
-XEN_NARGIFY_3(gxg_glColor3s_w, gxg_glColor3s)
-XEN_NARGIFY_3(gxg_glColor3ub_w, gxg_glColor3ub)
-XEN_NARGIFY_3(gxg_glColor3ui_w, gxg_glColor3ui)
-XEN_NARGIFY_3(gxg_glColor3us_w, gxg_glColor3us)
-XEN_NARGIFY_4(gxg_glColor4b_w, gxg_glColor4b)
-XEN_NARGIFY_4(gxg_glColor4d_w, gxg_glColor4d)
-XEN_NARGIFY_4(gxg_glColor4f_w, gxg_glColor4f)
-XEN_NARGIFY_4(gxg_glColor4i_w, gxg_glColor4i)
-XEN_NARGIFY_4(gxg_glColor4s_w, gxg_glColor4s)
-XEN_NARGIFY_4(gxg_glColor4ub_w, gxg_glColor4ub)
-XEN_NARGIFY_4(gxg_glColor4ui_w, gxg_glColor4ui)
-XEN_NARGIFY_4(gxg_glColor4us_w, gxg_glColor4us)
-XEN_NARGIFY_1(gxg_glTexCoord1d_w, gxg_glTexCoord1d)
-XEN_NARGIFY_1(gxg_glTexCoord1f_w, gxg_glTexCoord1f)
-XEN_NARGIFY_1(gxg_glTexCoord1i_w, gxg_glTexCoord1i)
-XEN_NARGIFY_1(gxg_glTexCoord1s_w, gxg_glTexCoord1s)
-XEN_NARGIFY_2(gxg_glTexCoord2d_w, gxg_glTexCoord2d)
-XEN_NARGIFY_2(gxg_glTexCoord2f_w, gxg_glTexCoord2f)
-XEN_NARGIFY_2(gxg_glTexCoord2i_w, gxg_glTexCoord2i)
-XEN_NARGIFY_2(gxg_glTexCoord2s_w, gxg_glTexCoord2s)
-XEN_NARGIFY_3(gxg_glTexCoord3d_w, gxg_glTexCoord3d)
-XEN_NARGIFY_3(gxg_glTexCoord3f_w, gxg_glTexCoord3f)
-XEN_NARGIFY_3(gxg_glTexCoord3i_w, gxg_glTexCoord3i)
-XEN_NARGIFY_3(gxg_glTexCoord3s_w, gxg_glTexCoord3s)
-XEN_NARGIFY_4(gxg_glTexCoord4d_w, gxg_glTexCoord4d)
-XEN_NARGIFY_4(gxg_glTexCoord4f_w, gxg_glTexCoord4f)
-XEN_NARGIFY_4(gxg_glTexCoord4i_w, gxg_glTexCoord4i)
-XEN_NARGIFY_4(gxg_glTexCoord4s_w, gxg_glTexCoord4s)
-XEN_NARGIFY_2(gxg_glRasterPos2d_w, gxg_glRasterPos2d)
-XEN_NARGIFY_2(gxg_glRasterPos2f_w, gxg_glRasterPos2f)
-XEN_NARGIFY_2(gxg_glRasterPos2i_w, gxg_glRasterPos2i)
-XEN_NARGIFY_2(gxg_glRasterPos2s_w, gxg_glRasterPos2s)
-XEN_NARGIFY_3(gxg_glRasterPos3d_w, gxg_glRasterPos3d)
-XEN_NARGIFY_3(gxg_glRasterPos3f_w, gxg_glRasterPos3f)
-XEN_NARGIFY_3(gxg_glRasterPos3i_w, gxg_glRasterPos3i)
-XEN_NARGIFY_3(gxg_glRasterPos3s_w, gxg_glRasterPos3s)
-XEN_NARGIFY_4(gxg_glRasterPos4d_w, gxg_glRasterPos4d)
-XEN_NARGIFY_4(gxg_glRasterPos4f_w, gxg_glRasterPos4f)
-XEN_NARGIFY_4(gxg_glRasterPos4i_w, gxg_glRasterPos4i)
-XEN_NARGIFY_4(gxg_glRasterPos4s_w, gxg_glRasterPos4s)
-XEN_NARGIFY_4(gxg_glRectd_w, gxg_glRectd)
-XEN_NARGIFY_4(gxg_glRectf_w, gxg_glRectf)
-XEN_NARGIFY_4(gxg_glRecti_w, gxg_glRecti)
-XEN_NARGIFY_4(gxg_glRects_w, gxg_glRects)
-XEN_NARGIFY_4(gxg_glVertexPointer_w, gxg_glVertexPointer)
-XEN_NARGIFY_3(gxg_glNormalPointer_w, gxg_glNormalPointer)
-XEN_NARGIFY_4(gxg_glColorPointer_w, gxg_glColorPointer)
-XEN_NARGIFY_3(gxg_glIndexPointer_w, gxg_glIndexPointer)
-XEN_NARGIFY_4(gxg_glTexCoordPointer_w, gxg_glTexCoordPointer)
-XEN_NARGIFY_2(gxg_glEdgeFlagPointer_w, gxg_glEdgeFlagPointer)
-XEN_ARGIFY_2(gxg_glGetPointerv_w, gxg_glGetPointerv)
-XEN_NARGIFY_1(gxg_glArrayElement_w, gxg_glArrayElement)
-XEN_NARGIFY_3(gxg_glDrawArrays_w, gxg_glDrawArrays)
-XEN_NARGIFY_4(gxg_glDrawElements_w, gxg_glDrawElements)
-XEN_NARGIFY_3(gxg_glInterleavedArrays_w, gxg_glInterleavedArrays)
-XEN_NARGIFY_1(gxg_glShadeModel_w, gxg_glShadeModel)
-XEN_NARGIFY_3(gxg_glLightf_w, gxg_glLightf)
-XEN_NARGIFY_3(gxg_glLighti_w, gxg_glLighti)
-XEN_ARGIFY_3(gxg_glGetLightfv_w, gxg_glGetLightfv)
-XEN_ARGIFY_3(gxg_glGetLightiv_w, gxg_glGetLightiv)
-XEN_NARGIFY_2(gxg_glLightModelf_w, gxg_glLightModelf)
-XEN_NARGIFY_2(gxg_glLightModeli_w, gxg_glLightModeli)
-XEN_NARGIFY_3(gxg_glMaterialf_w, gxg_glMaterialf)
-XEN_NARGIFY_3(gxg_glMateriali_w, gxg_glMateriali)
-XEN_ARGIFY_3(gxg_glGetMaterialfv_w, gxg_glGetMaterialfv)
-XEN_ARGIFY_3(gxg_glGetMaterialiv_w, gxg_glGetMaterialiv)
-XEN_NARGIFY_2(gxg_glColorMaterial_w, gxg_glColorMaterial)
-XEN_NARGIFY_2(gxg_glPixelZoom_w, gxg_glPixelZoom)
-XEN_NARGIFY_2(gxg_glPixelStoref_w, gxg_glPixelStoref)
-XEN_NARGIFY_2(gxg_glPixelStorei_w, gxg_glPixelStorei)
-XEN_NARGIFY_2(gxg_glPixelTransferf_w, gxg_glPixelTransferf)
-XEN_NARGIFY_2(gxg_glPixelTransferi_w, gxg_glPixelTransferi)
-XEN_ARGIFY_2(gxg_glGetPixelMapfv_w, gxg_glGetPixelMapfv)
-XEN_ARGIFY_2(gxg_glGetPixelMapuiv_w, gxg_glGetPixelMapuiv)
-XEN_ARGIFY_2(gxg_glGetPixelMapusv_w, gxg_glGetPixelMapusv)
-XEN_NARGIFY_7(gxg_glBitmap_w, gxg_glBitmap)
-XEN_NARGIFY_7(gxg_glReadPixels_w, gxg_glReadPixels)
-XEN_NARGIFY_5(gxg_glDrawPixels_w, gxg_glDrawPixels)
-XEN_NARGIFY_5(gxg_glCopyPixels_w, gxg_glCopyPixels)
-XEN_NARGIFY_3(gxg_glStencilFunc_w, gxg_glStencilFunc)
-XEN_NARGIFY_1(gxg_glStencilMask_w, gxg_glStencilMask)
-XEN_NARGIFY_3(gxg_glStencilOp_w, gxg_glStencilOp)
-XEN_NARGIFY_1(gxg_glClearStencil_w, gxg_glClearStencil)
-XEN_NARGIFY_3(gxg_glTexGend_w, gxg_glTexGend)
-XEN_NARGIFY_3(gxg_glTexGenf_w, gxg_glTexGenf)
-XEN_NARGIFY_3(gxg_glTexGeni_w, gxg_glTexGeni)
-XEN_ARGIFY_3(gxg_glGetTexGendv_w, gxg_glGetTexGendv)
-XEN_ARGIFY_3(gxg_glGetTexGenfv_w, gxg_glGetTexGenfv)
-XEN_ARGIFY_3(gxg_glGetTexGeniv_w, gxg_glGetTexGeniv)
-XEN_NARGIFY_3(gxg_glTexEnvf_w, gxg_glTexEnvf)
-XEN_NARGIFY_3(gxg_glTexEnvi_w, gxg_glTexEnvi)
-XEN_ARGIFY_3(gxg_glGetTexEnvfv_w, gxg_glGetTexEnvfv)
-XEN_ARGIFY_3(gxg_glGetTexEnviv_w, gxg_glGetTexEnviv)
-XEN_NARGIFY_3(gxg_glTexParameterf_w, gxg_glTexParameterf)
-XEN_NARGIFY_3(gxg_glTexParameteri_w, gxg_glTexParameteri)
-XEN_ARGIFY_3(gxg_glGetTexParameterfv_w, gxg_glGetTexParameterfv)
-XEN_ARGIFY_3(gxg_glGetTexParameteriv_w, gxg_glGetTexParameteriv)
-XEN_ARGIFY_4(gxg_glGetTexLevelParameterfv_w, gxg_glGetTexLevelParameterfv)
-XEN_ARGIFY_4(gxg_glGetTexLevelParameteriv_w, gxg_glGetTexLevelParameteriv)
-XEN_NARGIFY_8(gxg_glTexImage1D_w, gxg_glTexImage1D)
-XEN_NARGIFY_9(gxg_glTexImage2D_w, gxg_glTexImage2D)
-XEN_NARGIFY_2(gxg_glGenTextures_w, gxg_glGenTextures)
-XEN_NARGIFY_2(gxg_glDeleteTextures_w, gxg_glDeleteTextures)
-XEN_NARGIFY_2(gxg_glBindTexture_w, gxg_glBindTexture)
-XEN_NARGIFY_3(gxg_glAreTexturesResident_w, gxg_glAreTexturesResident)
-XEN_NARGIFY_1(gxg_glIsTexture_w, gxg_glIsTexture)
-XEN_NARGIFY_7(gxg_glTexSubImage1D_w, gxg_glTexSubImage1D)
-XEN_NARGIFY_9(gxg_glTexSubImage2D_w, gxg_glTexSubImage2D)
-XEN_NARGIFY_7(gxg_glCopyTexImage1D_w, gxg_glCopyTexImage1D)
-XEN_NARGIFY_8(gxg_glCopyTexImage2D_w, gxg_glCopyTexImage2D)
-XEN_NARGIFY_6(gxg_glCopyTexSubImage1D_w, gxg_glCopyTexSubImage1D)
-XEN_NARGIFY_8(gxg_glCopyTexSubImage2D_w, gxg_glCopyTexSubImage2D)
-XEN_NARGIFY_6(gxg_glMap1d_w, gxg_glMap1d)
-XEN_NARGIFY_6(gxg_glMap1f_w, gxg_glMap1f)
-XEN_VARGIFY(gxg_glMap2d_w, gxg_glMap2d)
-XEN_VARGIFY(gxg_glMap2f_w, gxg_glMap2f)
-XEN_ARGIFY_3(gxg_glGetMapdv_w, gxg_glGetMapdv)
-XEN_ARGIFY_3(gxg_glGetMapfv_w, gxg_glGetMapfv)
-XEN_ARGIFY_3(gxg_glGetMapiv_w, gxg_glGetMapiv)
-XEN_NARGIFY_1(gxg_glEvalCoord1d_w, gxg_glEvalCoord1d)
-XEN_NARGIFY_1(gxg_glEvalCoord1f_w, gxg_glEvalCoord1f)
-XEN_NARGIFY_2(gxg_glEvalCoord2d_w, gxg_glEvalCoord2d)
-XEN_NARGIFY_2(gxg_glEvalCoord2f_w, gxg_glEvalCoord2f)
-XEN_NARGIFY_3(gxg_glMapGrid1d_w, gxg_glMapGrid1d)
-XEN_NARGIFY_3(gxg_glMapGrid1f_w, gxg_glMapGrid1f)
-XEN_NARGIFY_6(gxg_glMapGrid2d_w, gxg_glMapGrid2d)
-XEN_NARGIFY_6(gxg_glMapGrid2f_w, gxg_glMapGrid2f)
-XEN_NARGIFY_1(gxg_glEvalPoint1_w, gxg_glEvalPoint1)
-XEN_NARGIFY_2(gxg_glEvalPoint2_w, gxg_glEvalPoint2)
-XEN_NARGIFY_3(gxg_glEvalMesh1_w, gxg_glEvalMesh1)
-XEN_NARGIFY_5(gxg_glEvalMesh2_w, gxg_glEvalMesh2)
-XEN_NARGIFY_2(gxg_glFogf_w, gxg_glFogf)
-XEN_NARGIFY_2(gxg_glFogi_w, gxg_glFogi)
-XEN_NARGIFY_3(gxg_glFeedbackBuffer_w, gxg_glFeedbackBuffer)
-XEN_NARGIFY_1(gxg_glPassThrough_w, gxg_glPassThrough)
-XEN_NARGIFY_2(gxg_glSelectBuffer_w, gxg_glSelectBuffer)
-XEN_NARGIFY_0(gxg_glInitNames_w, gxg_glInitNames)
-XEN_NARGIFY_1(gxg_glLoadName_w, gxg_glLoadName)
-XEN_NARGIFY_1(gxg_glPushName_w, gxg_glPushName)
-XEN_NARGIFY_0(gxg_glPopName_w, gxg_glPopName)
-XEN_NARGIFY_6(gxg_glDrawRangeElements_w, gxg_glDrawRangeElements)
-XEN_VARGIFY(gxg_glTexImage3D_w, gxg_glTexImage3D)
-XEN_VARGIFY(gxg_glTexSubImage3D_w, gxg_glTexSubImage3D)
-XEN_NARGIFY_9(gxg_glCopyTexSubImage3D_w, gxg_glCopyTexSubImage3D)
-XEN_NARGIFY_6(gxg_glColorTable_w, gxg_glColorTable)
-XEN_NARGIFY_6(gxg_glColorSubTable_w, gxg_glColorSubTable)
-XEN_NARGIFY_5(gxg_glCopyColorSubTable_w, gxg_glCopyColorSubTable)
-XEN_NARGIFY_5(gxg_glCopyColorTable_w, gxg_glCopyColorTable)
-XEN_ARGIFY_3(gxg_glGetColorTableParameterfv_w, gxg_glGetColorTableParameterfv)
-XEN_ARGIFY_3(gxg_glGetColorTableParameteriv_w, gxg_glGetColorTableParameteriv)
-XEN_NARGIFY_1(gxg_glBlendEquation_w, gxg_glBlendEquation)
-XEN_NARGIFY_4(gxg_glBlendColor_w, gxg_glBlendColor)
-XEN_NARGIFY_4(gxg_glHistogram_w, gxg_glHistogram)
-XEN_NARGIFY_1(gxg_glResetHistogram_w, gxg_glResetHistogram)
-XEN_NARGIFY_5(gxg_glGetHistogram_w, gxg_glGetHistogram)
-XEN_ARGIFY_3(gxg_glGetHistogramParameterfv_w, gxg_glGetHistogramParameterfv)
-XEN_ARGIFY_3(gxg_glGetHistogramParameteriv_w, gxg_glGetHistogramParameteriv)
-XEN_NARGIFY_3(gxg_glMinmax_w, gxg_glMinmax)
-XEN_NARGIFY_1(gxg_glResetMinmax_w, gxg_glResetMinmax)
-XEN_NARGIFY_5(gxg_glGetMinmax_w, gxg_glGetMinmax)
-XEN_ARGIFY_3(gxg_glGetMinmaxParameterfv_w, gxg_glGetMinmaxParameterfv)
-XEN_ARGIFY_3(gxg_glGetMinmaxParameteriv_w, gxg_glGetMinmaxParameteriv)
-XEN_NARGIFY_6(gxg_glConvolutionFilter1D_w, gxg_glConvolutionFilter1D)
-XEN_NARGIFY_7(gxg_glConvolutionFilter2D_w, gxg_glConvolutionFilter2D)
-XEN_NARGIFY_3(gxg_glConvolutionParameterf_w, gxg_glConvolutionParameterf)
-XEN_NARGIFY_3(gxg_glConvolutionParameteri_w, gxg_glConvolutionParameteri)
-XEN_NARGIFY_5(gxg_glCopyConvolutionFilter1D_w, gxg_glCopyConvolutionFilter1D)
-XEN_NARGIFY_6(gxg_glCopyConvolutionFilter2D_w, gxg_glCopyConvolutionFilter2D)
-XEN_NARGIFY_8(gxg_glSeparableFilter2D_w, gxg_glSeparableFilter2D)
+Xen_wrap_1_arg(gxg_glClearIndex_w, gxg_glClearIndex)
+Xen_wrap_4_args(gxg_glClearColor_w, gxg_glClearColor)
+Xen_wrap_1_arg(gxg_glClear_w, gxg_glClear)
+Xen_wrap_1_arg(gxg_glIndexMask_w, gxg_glIndexMask)
+Xen_wrap_4_args(gxg_glColorMask_w, gxg_glColorMask)
+Xen_wrap_2_args(gxg_glAlphaFunc_w, gxg_glAlphaFunc)
+Xen_wrap_2_args(gxg_glBlendFunc_w, gxg_glBlendFunc)
+Xen_wrap_1_arg(gxg_glLogicOp_w, gxg_glLogicOp)
+Xen_wrap_1_arg(gxg_glCullFace_w, gxg_glCullFace)
+Xen_wrap_1_arg(gxg_glFrontFace_w, gxg_glFrontFace)
+Xen_wrap_1_arg(gxg_glPointSize_w, gxg_glPointSize)
+Xen_wrap_1_arg(gxg_glLineWidth_w, gxg_glLineWidth)
+Xen_wrap_2_args(gxg_glLineStipple_w, gxg_glLineStipple)
+Xen_wrap_2_args(gxg_glPolygonMode_w, gxg_glPolygonMode)
+Xen_wrap_2_args(gxg_glPolygonOffset_w, gxg_glPolygonOffset)
+Xen_wrap_1_arg(gxg_glPolygonStipple_w, gxg_glPolygonStipple)
+Xen_wrap_1_arg(gxg_glEdgeFlag_w, gxg_glEdgeFlag)
+Xen_wrap_4_args(gxg_glScissor_w, gxg_glScissor)
+Xen_wrap_2_args(gxg_glClipPlane_w, gxg_glClipPlane)
+Xen_wrap_2_optional_args(gxg_glGetClipPlane_w, gxg_glGetClipPlane)
+Xen_wrap_1_arg(gxg_glDrawBuffer_w, gxg_glDrawBuffer)
+Xen_wrap_1_arg(gxg_glReadBuffer_w, gxg_glReadBuffer)
+Xen_wrap_1_arg(gxg_glEnable_w, gxg_glEnable)
+Xen_wrap_1_arg(gxg_glDisable_w, gxg_glDisable)
+Xen_wrap_1_arg(gxg_glIsEnabled_w, gxg_glIsEnabled)
+Xen_wrap_1_arg(gxg_glEnableClientState_w, gxg_glEnableClientState)
+Xen_wrap_1_arg(gxg_glDisableClientState_w, gxg_glDisableClientState)
+Xen_wrap_2_optional_args(gxg_glGetBooleanv_w, gxg_glGetBooleanv)
+Xen_wrap_2_optional_args(gxg_glGetDoublev_w, gxg_glGetDoublev)
+Xen_wrap_2_optional_args(gxg_glGetFloatv_w, gxg_glGetFloatv)
+Xen_wrap_2_optional_args(gxg_glGetIntegerv_w, gxg_glGetIntegerv)
+Xen_wrap_1_arg(gxg_glPushAttrib_w, gxg_glPushAttrib)
+Xen_wrap_no_args(gxg_glPopAttrib_w, gxg_glPopAttrib)
+Xen_wrap_1_arg(gxg_glPushClientAttrib_w, gxg_glPushClientAttrib)
+Xen_wrap_no_args(gxg_glPopClientAttrib_w, gxg_glPopClientAttrib)
+Xen_wrap_1_arg(gxg_glRenderMode_w, gxg_glRenderMode)
+Xen_wrap_no_args(gxg_glGetError_w, gxg_glGetError)
+Xen_wrap_1_arg(gxg_glGetString_w, gxg_glGetString)
+Xen_wrap_no_args(gxg_glFinish_w, gxg_glFinish)
+Xen_wrap_no_args(gxg_glFlush_w, gxg_glFlush)
+Xen_wrap_2_args(gxg_glHint_w, gxg_glHint)
+Xen_wrap_1_arg(gxg_glClearDepth_w, gxg_glClearDepth)
+Xen_wrap_1_arg(gxg_glDepthFunc_w, gxg_glDepthFunc)
+Xen_wrap_1_arg(gxg_glDepthMask_w, gxg_glDepthMask)
+Xen_wrap_2_args(gxg_glDepthRange_w, gxg_glDepthRange)
+Xen_wrap_4_args(gxg_glClearAccum_w, gxg_glClearAccum)
+Xen_wrap_2_args(gxg_glAccum_w, gxg_glAccum)
+Xen_wrap_1_arg(gxg_glMatrixMode_w, gxg_glMatrixMode)
+Xen_wrap_6_args(gxg_glOrtho_w, gxg_glOrtho)
+Xen_wrap_6_args(gxg_glFrustum_w, gxg_glFrustum)
+Xen_wrap_4_args(gxg_glViewport_w, gxg_glViewport)
+Xen_wrap_no_args(gxg_glPushMatrix_w, gxg_glPushMatrix)
+Xen_wrap_no_args(gxg_glPopMatrix_w, gxg_glPopMatrix)
+Xen_wrap_no_args(gxg_glLoadIdentity_w, gxg_glLoadIdentity)
+Xen_wrap_1_arg(gxg_glLoadMatrixd_w, gxg_glLoadMatrixd)
+Xen_wrap_1_arg(gxg_glLoadMatrixf_w, gxg_glLoadMatrixf)
+Xen_wrap_1_arg(gxg_glMultMatrixd_w, gxg_glMultMatrixd)
+Xen_wrap_1_arg(gxg_glMultMatrixf_w, gxg_glMultMatrixf)
+Xen_wrap_4_args(gxg_glRotated_w, gxg_glRotated)
+Xen_wrap_4_args(gxg_glRotatef_w, gxg_glRotatef)
+Xen_wrap_3_args(gxg_glScaled_w, gxg_glScaled)
+Xen_wrap_3_args(gxg_glScalef_w, gxg_glScalef)
+Xen_wrap_3_args(gxg_glTranslated_w, gxg_glTranslated)
+Xen_wrap_3_args(gxg_glTranslatef_w, gxg_glTranslatef)
+Xen_wrap_1_arg(gxg_glIsList_w, gxg_glIsList)
+Xen_wrap_2_args(gxg_glDeleteLists_w, gxg_glDeleteLists)
+Xen_wrap_1_arg(gxg_glGenLists_w, gxg_glGenLists)
+Xen_wrap_2_args(gxg_glNewList_w, gxg_glNewList)
+Xen_wrap_no_args(gxg_glEndList_w, gxg_glEndList)
+Xen_wrap_1_arg(gxg_glCallList_w, gxg_glCallList)
+Xen_wrap_3_args(gxg_glCallLists_w, gxg_glCallLists)
+Xen_wrap_1_arg(gxg_glListBase_w, gxg_glListBase)
+Xen_wrap_1_arg(gxg_glBegin_w, gxg_glBegin)
+Xen_wrap_no_args(gxg_glEnd_w, gxg_glEnd)
+Xen_wrap_2_args(gxg_glVertex2d_w, gxg_glVertex2d)
+Xen_wrap_2_args(gxg_glVertex2f_w, gxg_glVertex2f)
+Xen_wrap_2_args(gxg_glVertex2i_w, gxg_glVertex2i)
+Xen_wrap_2_args(gxg_glVertex2s_w, gxg_glVertex2s)
+Xen_wrap_3_args(gxg_glVertex3d_w, gxg_glVertex3d)
+Xen_wrap_3_args(gxg_glVertex3f_w, gxg_glVertex3f)
+Xen_wrap_3_args(gxg_glVertex3i_w, gxg_glVertex3i)
+Xen_wrap_3_args(gxg_glVertex3s_w, gxg_glVertex3s)
+Xen_wrap_4_args(gxg_glVertex4d_w, gxg_glVertex4d)
+Xen_wrap_4_args(gxg_glVertex4f_w, gxg_glVertex4f)
+Xen_wrap_4_args(gxg_glVertex4i_w, gxg_glVertex4i)
+Xen_wrap_4_args(gxg_glVertex4s_w, gxg_glVertex4s)
+Xen_wrap_3_args(gxg_glNormal3b_w, gxg_glNormal3b)
+Xen_wrap_3_args(gxg_glNormal3d_w, gxg_glNormal3d)
+Xen_wrap_3_args(gxg_glNormal3f_w, gxg_glNormal3f)
+Xen_wrap_3_args(gxg_glNormal3i_w, gxg_glNormal3i)
+Xen_wrap_3_args(gxg_glNormal3s_w, gxg_glNormal3s)
+Xen_wrap_1_arg(gxg_glIndexd_w, gxg_glIndexd)
+Xen_wrap_1_arg(gxg_glIndexf_w, gxg_glIndexf)
+Xen_wrap_1_arg(gxg_glIndexi_w, gxg_glIndexi)
+Xen_wrap_1_arg(gxg_glIndexs_w, gxg_glIndexs)
+Xen_wrap_1_arg(gxg_glIndexub_w, gxg_glIndexub)
+Xen_wrap_3_args(gxg_glColor3b_w, gxg_glColor3b)
+Xen_wrap_3_args(gxg_glColor3d_w, gxg_glColor3d)
+Xen_wrap_3_args(gxg_glColor3f_w, gxg_glColor3f)
+Xen_wrap_3_args(gxg_glColor3i_w, gxg_glColor3i)
+Xen_wrap_3_args(gxg_glColor3s_w, gxg_glColor3s)
+Xen_wrap_3_args(gxg_glColor3ub_w, gxg_glColor3ub)
+Xen_wrap_3_args(gxg_glColor3ui_w, gxg_glColor3ui)
+Xen_wrap_3_args(gxg_glColor3us_w, gxg_glColor3us)
+Xen_wrap_4_args(gxg_glColor4b_w, gxg_glColor4b)
+Xen_wrap_4_args(gxg_glColor4d_w, gxg_glColor4d)
+Xen_wrap_4_args(gxg_glColor4f_w, gxg_glColor4f)
+Xen_wrap_4_args(gxg_glColor4i_w, gxg_glColor4i)
+Xen_wrap_4_args(gxg_glColor4s_w, gxg_glColor4s)
+Xen_wrap_4_args(gxg_glColor4ub_w, gxg_glColor4ub)
+Xen_wrap_4_args(gxg_glColor4ui_w, gxg_glColor4ui)
+Xen_wrap_4_args(gxg_glColor4us_w, gxg_glColor4us)
+Xen_wrap_1_arg(gxg_glTexCoord1d_w, gxg_glTexCoord1d)
+Xen_wrap_1_arg(gxg_glTexCoord1f_w, gxg_glTexCoord1f)
+Xen_wrap_1_arg(gxg_glTexCoord1i_w, gxg_glTexCoord1i)
+Xen_wrap_1_arg(gxg_glTexCoord1s_w, gxg_glTexCoord1s)
+Xen_wrap_2_args(gxg_glTexCoord2d_w, gxg_glTexCoord2d)
+Xen_wrap_2_args(gxg_glTexCoord2f_w, gxg_glTexCoord2f)
+Xen_wrap_2_args(gxg_glTexCoord2i_w, gxg_glTexCoord2i)
+Xen_wrap_2_args(gxg_glTexCoord2s_w, gxg_glTexCoord2s)
+Xen_wrap_3_args(gxg_glTexCoord3d_w, gxg_glTexCoord3d)
+Xen_wrap_3_args(gxg_glTexCoord3f_w, gxg_glTexCoord3f)
+Xen_wrap_3_args(gxg_glTexCoord3i_w, gxg_glTexCoord3i)
+Xen_wrap_3_args(gxg_glTexCoord3s_w, gxg_glTexCoord3s)
+Xen_wrap_4_args(gxg_glTexCoord4d_w, gxg_glTexCoord4d)
+Xen_wrap_4_args(gxg_glTexCoord4f_w, gxg_glTexCoord4f)
+Xen_wrap_4_args(gxg_glTexCoord4i_w, gxg_glTexCoord4i)
+Xen_wrap_4_args(gxg_glTexCoord4s_w, gxg_glTexCoord4s)
+Xen_wrap_2_args(gxg_glRasterPos2d_w, gxg_glRasterPos2d)
+Xen_wrap_2_args(gxg_glRasterPos2f_w, gxg_glRasterPos2f)
+Xen_wrap_2_args(gxg_glRasterPos2i_w, gxg_glRasterPos2i)
+Xen_wrap_2_args(gxg_glRasterPos2s_w, gxg_glRasterPos2s)
+Xen_wrap_3_args(gxg_glRasterPos3d_w, gxg_glRasterPos3d)
+Xen_wrap_3_args(gxg_glRasterPos3f_w, gxg_glRasterPos3f)
+Xen_wrap_3_args(gxg_glRasterPos3i_w, gxg_glRasterPos3i)
+Xen_wrap_3_args(gxg_glRasterPos3s_w, gxg_glRasterPos3s)
+Xen_wrap_4_args(gxg_glRasterPos4d_w, gxg_glRasterPos4d)
+Xen_wrap_4_args(gxg_glRasterPos4f_w, gxg_glRasterPos4f)
+Xen_wrap_4_args(gxg_glRasterPos4i_w, gxg_glRasterPos4i)
+Xen_wrap_4_args(gxg_glRasterPos4s_w, gxg_glRasterPos4s)
+Xen_wrap_4_args(gxg_glRectd_w, gxg_glRectd)
+Xen_wrap_4_args(gxg_glRectf_w, gxg_glRectf)
+Xen_wrap_4_args(gxg_glRecti_w, gxg_glRecti)
+Xen_wrap_4_args(gxg_glRects_w, gxg_glRects)
+Xen_wrap_4_args(gxg_glVertexPointer_w, gxg_glVertexPointer)
+Xen_wrap_3_args(gxg_glNormalPointer_w, gxg_glNormalPointer)
+Xen_wrap_4_args(gxg_glColorPointer_w, gxg_glColorPointer)
+Xen_wrap_3_args(gxg_glIndexPointer_w, gxg_glIndexPointer)
+Xen_wrap_4_args(gxg_glTexCoordPointer_w, gxg_glTexCoordPointer)
+Xen_wrap_2_args(gxg_glEdgeFlagPointer_w, gxg_glEdgeFlagPointer)
+Xen_wrap_2_optional_args(gxg_glGetPointerv_w, gxg_glGetPointerv)
+Xen_wrap_1_arg(gxg_glArrayElement_w, gxg_glArrayElement)
+Xen_wrap_3_args(gxg_glDrawArrays_w, gxg_glDrawArrays)
+Xen_wrap_4_args(gxg_glDrawElements_w, gxg_glDrawElements)
+Xen_wrap_3_args(gxg_glInterleavedArrays_w, gxg_glInterleavedArrays)
+Xen_wrap_1_arg(gxg_glShadeModel_w, gxg_glShadeModel)
+Xen_wrap_3_args(gxg_glLightf_w, gxg_glLightf)
+Xen_wrap_3_args(gxg_glLighti_w, gxg_glLighti)
+Xen_wrap_3_optional_args(gxg_glGetLightfv_w, gxg_glGetLightfv)
+Xen_wrap_3_optional_args(gxg_glGetLightiv_w, gxg_glGetLightiv)
+Xen_wrap_2_args(gxg_glLightModelf_w, gxg_glLightModelf)
+Xen_wrap_2_args(gxg_glLightModeli_w, gxg_glLightModeli)
+Xen_wrap_3_args(gxg_glMaterialf_w, gxg_glMaterialf)
+Xen_wrap_3_args(gxg_glMateriali_w, gxg_glMateriali)
+Xen_wrap_3_optional_args(gxg_glGetMaterialfv_w, gxg_glGetMaterialfv)
+Xen_wrap_3_optional_args(gxg_glGetMaterialiv_w, gxg_glGetMaterialiv)
+Xen_wrap_2_args(gxg_glColorMaterial_w, gxg_glColorMaterial)
+Xen_wrap_2_args(gxg_glPixelZoom_w, gxg_glPixelZoom)
+Xen_wrap_2_args(gxg_glPixelStoref_w, gxg_glPixelStoref)
+Xen_wrap_2_args(gxg_glPixelStorei_w, gxg_glPixelStorei)
+Xen_wrap_2_args(gxg_glPixelTransferf_w, gxg_glPixelTransferf)
+Xen_wrap_2_args(gxg_glPixelTransferi_w, gxg_glPixelTransferi)
+Xen_wrap_2_optional_args(gxg_glGetPixelMapfv_w, gxg_glGetPixelMapfv)
+Xen_wrap_2_optional_args(gxg_glGetPixelMapuiv_w, gxg_glGetPixelMapuiv)
+Xen_wrap_2_optional_args(gxg_glGetPixelMapusv_w, gxg_glGetPixelMapusv)
+Xen_wrap_7_args(gxg_glBitmap_w, gxg_glBitmap)
+Xen_wrap_7_args(gxg_glReadPixels_w, gxg_glReadPixels)
+Xen_wrap_5_args(gxg_glDrawPixels_w, gxg_glDrawPixels)
+Xen_wrap_5_args(gxg_glCopyPixels_w, gxg_glCopyPixels)
+Xen_wrap_3_args(gxg_glStencilFunc_w, gxg_glStencilFunc)
+Xen_wrap_1_arg(gxg_glStencilMask_w, gxg_glStencilMask)
+Xen_wrap_3_args(gxg_glStencilOp_w, gxg_glStencilOp)
+Xen_wrap_1_arg(gxg_glClearStencil_w, gxg_glClearStencil)
+Xen_wrap_3_args(gxg_glTexGend_w, gxg_glTexGend)
+Xen_wrap_3_args(gxg_glTexGenf_w, gxg_glTexGenf)
+Xen_wrap_3_args(gxg_glTexGeni_w, gxg_glTexGeni)
+Xen_wrap_3_optional_args(gxg_glGetTexGendv_w, gxg_glGetTexGendv)
+Xen_wrap_3_optional_args(gxg_glGetTexGenfv_w, gxg_glGetTexGenfv)
+Xen_wrap_3_optional_args(gxg_glGetTexGeniv_w, gxg_glGetTexGeniv)
+Xen_wrap_3_args(gxg_glTexEnvf_w, gxg_glTexEnvf)
+Xen_wrap_3_args(gxg_glTexEnvi_w, gxg_glTexEnvi)
+Xen_wrap_3_optional_args(gxg_glGetTexEnvfv_w, gxg_glGetTexEnvfv)
+Xen_wrap_3_optional_args(gxg_glGetTexEnviv_w, gxg_glGetTexEnviv)
+Xen_wrap_3_args(gxg_glTexParameterf_w, gxg_glTexParameterf)
+Xen_wrap_3_args(gxg_glTexParameteri_w, gxg_glTexParameteri)
+Xen_wrap_3_optional_args(gxg_glGetTexParameterfv_w, gxg_glGetTexParameterfv)
+Xen_wrap_3_optional_args(gxg_glGetTexParameteriv_w, gxg_glGetTexParameteriv)
+Xen_wrap_4_optional_args(gxg_glGetTexLevelParameterfv_w, gxg_glGetTexLevelParameterfv)
+Xen_wrap_4_optional_args(gxg_glGetTexLevelParameteriv_w, gxg_glGetTexLevelParameteriv)
+Xen_wrap_any_args(gxg_glTexImage1D_w, gxg_glTexImage1D)
+Xen_wrap_any_args(gxg_glTexImage2D_w, gxg_glTexImage2D)
+Xen_wrap_2_args(gxg_glGenTextures_w, gxg_glGenTextures)
+Xen_wrap_2_args(gxg_glDeleteTextures_w, gxg_glDeleteTextures)
+Xen_wrap_2_args(gxg_glBindTexture_w, gxg_glBindTexture)
+Xen_wrap_3_args(gxg_glAreTexturesResident_w, gxg_glAreTexturesResident)
+Xen_wrap_1_arg(gxg_glIsTexture_w, gxg_glIsTexture)
+Xen_wrap_7_args(gxg_glTexSubImage1D_w, gxg_glTexSubImage1D)
+Xen_wrap_any_args(gxg_glTexSubImage2D_w, gxg_glTexSubImage2D)
+Xen_wrap_7_args(gxg_glCopyTexImage1D_w, gxg_glCopyTexImage1D)
+Xen_wrap_any_args(gxg_glCopyTexImage2D_w, gxg_glCopyTexImage2D)
+Xen_wrap_6_args(gxg_glCopyTexSubImage1D_w, gxg_glCopyTexSubImage1D)
+Xen_wrap_any_args(gxg_glCopyTexSubImage2D_w, gxg_glCopyTexSubImage2D)
+Xen_wrap_6_args(gxg_glMap1d_w, gxg_glMap1d)
+Xen_wrap_6_args(gxg_glMap1f_w, gxg_glMap1f)
+Xen_wrap_any_args(gxg_glMap2d_w, gxg_glMap2d)
+Xen_wrap_any_args(gxg_glMap2f_w, gxg_glMap2f)
+Xen_wrap_3_optional_args(gxg_glGetMapdv_w, gxg_glGetMapdv)
+Xen_wrap_3_optional_args(gxg_glGetMapfv_w, gxg_glGetMapfv)
+Xen_wrap_3_optional_args(gxg_glGetMapiv_w, gxg_glGetMapiv)
+Xen_wrap_1_arg(gxg_glEvalCoord1d_w, gxg_glEvalCoord1d)
+Xen_wrap_1_arg(gxg_glEvalCoord1f_w, gxg_glEvalCoord1f)
+Xen_wrap_2_args(gxg_glEvalCoord2d_w, gxg_glEvalCoord2d)
+Xen_wrap_2_args(gxg_glEvalCoord2f_w, gxg_glEvalCoord2f)
+Xen_wrap_3_args(gxg_glMapGrid1d_w, gxg_glMapGrid1d)
+Xen_wrap_3_args(gxg_glMapGrid1f_w, gxg_glMapGrid1f)
+Xen_wrap_6_args(gxg_glMapGrid2d_w, gxg_glMapGrid2d)
+Xen_wrap_6_args(gxg_glMapGrid2f_w, gxg_glMapGrid2f)
+Xen_wrap_1_arg(gxg_glEvalPoint1_w, gxg_glEvalPoint1)
+Xen_wrap_2_args(gxg_glEvalPoint2_w, gxg_glEvalPoint2)
+Xen_wrap_3_args(gxg_glEvalMesh1_w, gxg_glEvalMesh1)
+Xen_wrap_5_args(gxg_glEvalMesh2_w, gxg_glEvalMesh2)
+Xen_wrap_2_args(gxg_glFogf_w, gxg_glFogf)
+Xen_wrap_2_args(gxg_glFogi_w, gxg_glFogi)
+Xen_wrap_3_args(gxg_glFeedbackBuffer_w, gxg_glFeedbackBuffer)
+Xen_wrap_1_arg(gxg_glPassThrough_w, gxg_glPassThrough)
+Xen_wrap_2_args(gxg_glSelectBuffer_w, gxg_glSelectBuffer)
+Xen_wrap_no_args(gxg_glInitNames_w, gxg_glInitNames)
+Xen_wrap_1_arg(gxg_glLoadName_w, gxg_glLoadName)
+Xen_wrap_1_arg(gxg_glPushName_w, gxg_glPushName)
+Xen_wrap_no_args(gxg_glPopName_w, gxg_glPopName)
+Xen_wrap_6_args(gxg_glDrawRangeElements_w, gxg_glDrawRangeElements)
+Xen_wrap_any_args(gxg_glTexImage3D_w, gxg_glTexImage3D)
+Xen_wrap_any_args(gxg_glTexSubImage3D_w, gxg_glTexSubImage3D)
+Xen_wrap_any_args(gxg_glCopyTexSubImage3D_w, gxg_glCopyTexSubImage3D)
+Xen_wrap_6_args(gxg_glColorTable_w, gxg_glColorTable)
+Xen_wrap_6_args(gxg_glColorSubTable_w, gxg_glColorSubTable)
+Xen_wrap_5_args(gxg_glCopyColorSubTable_w, gxg_glCopyColorSubTable)
+Xen_wrap_5_args(gxg_glCopyColorTable_w, gxg_glCopyColorTable)
+Xen_wrap_3_optional_args(gxg_glGetColorTableParameterfv_w, gxg_glGetColorTableParameterfv)
+Xen_wrap_3_optional_args(gxg_glGetColorTableParameteriv_w, gxg_glGetColorTableParameteriv)
+Xen_wrap_1_arg(gxg_glBlendEquation_w, gxg_glBlendEquation)
+Xen_wrap_4_args(gxg_glBlendColor_w, gxg_glBlendColor)
+Xen_wrap_4_args(gxg_glHistogram_w, gxg_glHistogram)
+Xen_wrap_1_arg(gxg_glResetHistogram_w, gxg_glResetHistogram)
+Xen_wrap_5_args(gxg_glGetHistogram_w, gxg_glGetHistogram)
+Xen_wrap_3_optional_args(gxg_glGetHistogramParameterfv_w, gxg_glGetHistogramParameterfv)
+Xen_wrap_3_optional_args(gxg_glGetHistogramParameteriv_w, gxg_glGetHistogramParameteriv)
+Xen_wrap_3_args(gxg_glMinmax_w, gxg_glMinmax)
+Xen_wrap_1_arg(gxg_glResetMinmax_w, gxg_glResetMinmax)
+Xen_wrap_5_args(gxg_glGetMinmax_w, gxg_glGetMinmax)
+Xen_wrap_3_optional_args(gxg_glGetMinmaxParameterfv_w, gxg_glGetMinmaxParameterfv)
+Xen_wrap_3_optional_args(gxg_glGetMinmaxParameteriv_w, gxg_glGetMinmaxParameteriv)
+Xen_wrap_6_args(gxg_glConvolutionFilter1D_w, gxg_glConvolutionFilter1D)
+Xen_wrap_7_args(gxg_glConvolutionFilter2D_w, gxg_glConvolutionFilter2D)
+Xen_wrap_3_args(gxg_glConvolutionParameterf_w, gxg_glConvolutionParameterf)
+Xen_wrap_3_args(gxg_glConvolutionParameteri_w, gxg_glConvolutionParameteri)
+Xen_wrap_5_args(gxg_glCopyConvolutionFilter1D_w, gxg_glCopyConvolutionFilter1D)
+Xen_wrap_6_args(gxg_glCopyConvolutionFilter2D_w, gxg_glCopyConvolutionFilter2D)
+Xen_wrap_any_args(gxg_glSeparableFilter2D_w, gxg_glSeparableFilter2D)
#if HAVE_GLU
-XEN_NARGIFY_1(gxg_gluBeginCurve_w, gxg_gluBeginCurve)
+Xen_wrap_1_arg(gxg_gluBeginCurve_w, gxg_gluBeginCurve)
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_1(gxg_gluBeginPolygon_w, gxg_gluBeginPolygon)
+Xen_wrap_1_arg(gxg_gluBeginPolygon_w, gxg_gluBeginPolygon)
#endif
-XEN_NARGIFY_1(gxg_gluBeginSurface_w, gxg_gluBeginSurface)
-XEN_NARGIFY_1(gxg_gluBeginTrim_w, gxg_gluBeginTrim)
-XEN_NARGIFY_9(gxg_gluBuild1DMipmapLevels_w, gxg_gluBuild1DMipmapLevels)
-XEN_NARGIFY_6(gxg_gluBuild1DMipmaps_w, gxg_gluBuild1DMipmaps)
-XEN_VARGIFY(gxg_gluBuild2DMipmapLevels_w, gxg_gluBuild2DMipmapLevels)
-XEN_NARGIFY_7(gxg_gluBuild2DMipmaps_w, gxg_gluBuild2DMipmaps)
-XEN_VARGIFY(gxg_gluBuild3DMipmapLevels_w, gxg_gluBuild3DMipmapLevels)
-XEN_NARGIFY_8(gxg_gluBuild3DMipmaps_w, gxg_gluBuild3DMipmaps)
-XEN_NARGIFY_2(gxg_gluCheckExtension_w, gxg_gluCheckExtension)
-XEN_NARGIFY_6(gxg_gluCylinder_w, gxg_gluCylinder)
-XEN_NARGIFY_1(gxg_gluDeleteNurbsRenderer_w, gxg_gluDeleteNurbsRenderer)
-XEN_NARGIFY_1(gxg_gluDeleteQuadric_w, gxg_gluDeleteQuadric)
+Xen_wrap_1_arg(gxg_gluBeginSurface_w, gxg_gluBeginSurface)
+Xen_wrap_1_arg(gxg_gluBeginTrim_w, gxg_gluBeginTrim)
+Xen_wrap_any_args(gxg_gluBuild1DMipmapLevels_w, gxg_gluBuild1DMipmapLevels)
+Xen_wrap_6_args(gxg_gluBuild1DMipmaps_w, gxg_gluBuild1DMipmaps)
+Xen_wrap_any_args(gxg_gluBuild2DMipmapLevels_w, gxg_gluBuild2DMipmapLevels)
+Xen_wrap_7_args(gxg_gluBuild2DMipmaps_w, gxg_gluBuild2DMipmaps)
+Xen_wrap_any_args(gxg_gluBuild3DMipmapLevels_w, gxg_gluBuild3DMipmapLevels)
+Xen_wrap_any_args(gxg_gluBuild3DMipmaps_w, gxg_gluBuild3DMipmaps)
+Xen_wrap_2_args(gxg_gluCheckExtension_w, gxg_gluCheckExtension)
+Xen_wrap_6_args(gxg_gluCylinder_w, gxg_gluCylinder)
+Xen_wrap_1_arg(gxg_gluDeleteNurbsRenderer_w, gxg_gluDeleteNurbsRenderer)
+Xen_wrap_1_arg(gxg_gluDeleteQuadric_w, gxg_gluDeleteQuadric)
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_1(gxg_gluDeleteTess_w, gxg_gluDeleteTess)
+Xen_wrap_1_arg(gxg_gluDeleteTess_w, gxg_gluDeleteTess)
#endif
-XEN_NARGIFY_5(gxg_gluDisk_w, gxg_gluDisk)
-XEN_NARGIFY_1(gxg_gluEndCurve_w, gxg_gluEndCurve)
+Xen_wrap_5_args(gxg_gluDisk_w, gxg_gluDisk)
+Xen_wrap_1_arg(gxg_gluEndCurve_w, gxg_gluEndCurve)
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_1(gxg_gluEndPolygon_w, gxg_gluEndPolygon)
+Xen_wrap_1_arg(gxg_gluEndPolygon_w, gxg_gluEndPolygon)
#endif
-XEN_NARGIFY_1(gxg_gluEndSurface_w, gxg_gluEndSurface)
-XEN_NARGIFY_1(gxg_gluEndTrim_w, gxg_gluEndTrim)
-XEN_NARGIFY_1(gxg_gluErrorString_w, gxg_gluErrorString)
-XEN_NARGIFY_3(gxg_gluGetNurbsProperty_w, gxg_gluGetNurbsProperty)
-XEN_NARGIFY_1(gxg_gluGetString_w, gxg_gluGetString)
+Xen_wrap_1_arg(gxg_gluEndSurface_w, gxg_gluEndSurface)
+Xen_wrap_1_arg(gxg_gluEndTrim_w, gxg_gluEndTrim)
+Xen_wrap_1_arg(gxg_gluErrorString_w, gxg_gluErrorString)
+Xen_wrap_3_args(gxg_gluGetNurbsProperty_w, gxg_gluGetNurbsProperty)
+Xen_wrap_1_arg(gxg_gluGetString_w, gxg_gluGetString)
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_3(gxg_gluGetTessProperty_w, gxg_gluGetTessProperty)
+Xen_wrap_3_args(gxg_gluGetTessProperty_w, gxg_gluGetTessProperty)
#endif
-XEN_NARGIFY_4(gxg_gluLoadSamplingMatrices_w, gxg_gluLoadSamplingMatrices)
-XEN_NARGIFY_9(gxg_gluLookAt_w, gxg_gluLookAt)
-XEN_NARGIFY_0(gxg_gluNewNurbsRenderer_w, gxg_gluNewNurbsRenderer)
-XEN_NARGIFY_0(gxg_gluNewQuadric_w, gxg_gluNewQuadric)
+Xen_wrap_4_args(gxg_gluLoadSamplingMatrices_w, gxg_gluLoadSamplingMatrices)
+Xen_wrap_any_args(gxg_gluLookAt_w, gxg_gluLookAt)
+Xen_wrap_no_args(gxg_gluNewNurbsRenderer_w, gxg_gluNewNurbsRenderer)
+Xen_wrap_no_args(gxg_gluNewQuadric_w, gxg_gluNewQuadric)
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_0(gxg_gluNewTess_w, gxg_gluNewTess)
+Xen_wrap_no_args(gxg_gluNewTess_w, gxg_gluNewTess)
#endif
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_2(gxg_gluNextContour_w, gxg_gluNextContour)
+Xen_wrap_2_args(gxg_gluNextContour_w, gxg_gluNextContour)
#endif
-XEN_NARGIFY_3(gxg_gluNurbsCallback_w, gxg_gluNurbsCallback)
-XEN_NARGIFY_2(gxg_gluNurbsCallbackData_w, gxg_gluNurbsCallbackData)
-XEN_NARGIFY_2(gxg_gluNurbsCallbackDataEXT_w, gxg_gluNurbsCallbackDataEXT)
-XEN_NARGIFY_7(gxg_gluNurbsCurve_w, gxg_gluNurbsCurve)
-XEN_NARGIFY_3(gxg_gluNurbsProperty_w, gxg_gluNurbsProperty)
-XEN_VARGIFY(gxg_gluNurbsSurface_w, gxg_gluNurbsSurface)
-XEN_NARGIFY_4(gxg_gluOrtho2D_w, gxg_gluOrtho2D)
-XEN_NARGIFY_7(gxg_gluPartialDisk_w, gxg_gluPartialDisk)
-XEN_NARGIFY_4(gxg_gluPerspective_w, gxg_gluPerspective)
-XEN_NARGIFY_5(gxg_gluPickMatrix_w, gxg_gluPickMatrix)
-XEN_ARGIFY_9(gxg_gluProject_w, gxg_gluProject)
-XEN_NARGIFY_5(gxg_gluPwlCurve_w, gxg_gluPwlCurve)
-XEN_NARGIFY_3(gxg_gluQuadricCallback_w, gxg_gluQuadricCallback)
-XEN_NARGIFY_2(gxg_gluQuadricDrawStyle_w, gxg_gluQuadricDrawStyle)
-XEN_NARGIFY_2(gxg_gluQuadricNormals_w, gxg_gluQuadricNormals)
-XEN_NARGIFY_2(gxg_gluQuadricOrientation_w, gxg_gluQuadricOrientation)
-XEN_NARGIFY_2(gxg_gluQuadricTexture_w, gxg_gluQuadricTexture)
-XEN_NARGIFY_9(gxg_gluScaleImage_w, gxg_gluScaleImage)
-XEN_NARGIFY_4(gxg_gluSphere_w, gxg_gluSphere)
+Xen_wrap_3_args(gxg_gluNurbsCallback_w, gxg_gluNurbsCallback)
+Xen_wrap_2_args(gxg_gluNurbsCallbackData_w, gxg_gluNurbsCallbackData)
+Xen_wrap_7_args(gxg_gluNurbsCurve_w, gxg_gluNurbsCurve)
+Xen_wrap_3_args(gxg_gluNurbsProperty_w, gxg_gluNurbsProperty)
+Xen_wrap_any_args(gxg_gluNurbsSurface_w, gxg_gluNurbsSurface)
+Xen_wrap_4_args(gxg_gluOrtho2D_w, gxg_gluOrtho2D)
+Xen_wrap_7_args(gxg_gluPartialDisk_w, gxg_gluPartialDisk)
+Xen_wrap_4_args(gxg_gluPerspective_w, gxg_gluPerspective)
+Xen_wrap_5_args(gxg_gluPickMatrix_w, gxg_gluPickMatrix)
+Xen_wrap_any_args(gxg_gluProject_w, gxg_gluProject)
+Xen_wrap_5_args(gxg_gluPwlCurve_w, gxg_gluPwlCurve)
+Xen_wrap_3_args(gxg_gluQuadricCallback_w, gxg_gluQuadricCallback)
+Xen_wrap_2_args(gxg_gluQuadricDrawStyle_w, gxg_gluQuadricDrawStyle)
+Xen_wrap_2_args(gxg_gluQuadricNormals_w, gxg_gluQuadricNormals)
+Xen_wrap_2_args(gxg_gluQuadricOrientation_w, gxg_gluQuadricOrientation)
+Xen_wrap_2_args(gxg_gluQuadricTexture_w, gxg_gluQuadricTexture)
+Xen_wrap_any_args(gxg_gluScaleImage_w, gxg_gluScaleImage)
+Xen_wrap_4_args(gxg_gluSphere_w, gxg_gluSphere)
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_1(gxg_gluTessBeginContour_w, gxg_gluTessBeginContour)
+Xen_wrap_1_arg(gxg_gluTessBeginContour_w, gxg_gluTessBeginContour)
#endif
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_2(gxg_gluTessBeginPolygon_w, gxg_gluTessBeginPolygon)
+Xen_wrap_2_args(gxg_gluTessBeginPolygon_w, gxg_gluTessBeginPolygon)
#endif
-XEN_NARGIFY_3(gxg_gluTessCallback_w, gxg_gluTessCallback)
+Xen_wrap_3_args(gxg_gluTessCallback_w, gxg_gluTessCallback)
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_1(gxg_gluTessEndContour_w, gxg_gluTessEndContour)
+Xen_wrap_1_arg(gxg_gluTessEndContour_w, gxg_gluTessEndContour)
#endif
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_1(gxg_gluTessEndPolygon_w, gxg_gluTessEndPolygon)
+Xen_wrap_1_arg(gxg_gluTessEndPolygon_w, gxg_gluTessEndPolygon)
#endif
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_4(gxg_gluTessNormal_w, gxg_gluTessNormal)
+Xen_wrap_4_args(gxg_gluTessNormal_w, gxg_gluTessNormal)
#endif
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_3(gxg_gluTessProperty_w, gxg_gluTessProperty)
+Xen_wrap_3_args(gxg_gluTessProperty_w, gxg_gluTessProperty)
#endif
#ifdef GLU_VERSION_1_2
-XEN_NARGIFY_3(gxg_gluTessVertex_w, gxg_gluTessVertex)
+Xen_wrap_3_args(gxg_gluTessVertex_w, gxg_gluTessVertex)
+#endif
+Xen_wrap_any_args(gxg_gluUnProject_w, gxg_gluUnProject)
+Xen_wrap_any_args(gxg_gluUnProject4_w, gxg_gluUnProject4)
#endif
-XEN_ARGIFY_9(gxg_gluUnProject_w, gxg_gluUnProject)
-XEN_VARGIFY(gxg_gluUnProject4_w, gxg_gluUnProject4)
+static void define_functions(void)
+{
+#if HAVE_SCHEME
+static s7_pointer s_boolean, s_integer, s_real, s_any;
+static s7_pointer pl_tb, pl_t, pl_bt, pl_tttti, pl_ttttb, pl_ttri, pl_ttit, pl_ttr, pl_ttir, pl_ttb, pl_tti, pl_ttiti, pl_ttrriir, pl_ttititiiti, pl_ttititi, pl_ttrri, pl_ttrrri, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiit, pl_iiiiiiiiit, pl_irrrt, pl_irrrrtttrrt, pl_i, pl_bit, pl_bi, pl_ittit, pl_tiirrrrt, pl_tiiiit, pl_tiiit, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriit, pl_tirriirriit, pl_tirrir, pl_tir, pl_tit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiib, pl_ti, pl_tiiiiiit, pl_tiir, pl_tiiiiit, pl_tiit, pl_tibiit, pl_tiib, pl_trrrrt, pl_tr, pl_unused;
+ s_boolean = s7_make_symbol(s7, "boolean?");
+ s_integer = s7_make_symbol(s7, "integer?");
+ s_real = s7_make_symbol(s7, "real?");
+ s_any = s7_t(s7);
+
+ pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean);
+ pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
+ pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any);
+ pl_tttti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_any, s_any, s_integer);
+ pl_ttttb = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_any, s_any, s_boolean);
+ pl_ttri = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_real, s_integer);
+ pl_ttit = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_any);
+ pl_ttr = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_real);
+ pl_ttir = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_real);
+ pl_ttb = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_boolean);
+ pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer);
+ pl_ttiti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_integer, s_any, s_integer);
+ pl_ttrriir = s7_make_circular_signature(s7, 6, 7, s_any, s_any, s_real, s_real, s_integer, s_integer, s_real);
+ pl_ttititiiti = s7_make_circular_signature(s7, 9, 10, s_any, s_any, s_integer, s_any, s_integer, s_any, s_integer, s_integer, s_any, s_integer);
+ pl_ttititi = s7_make_circular_signature(s7, 6, 7, s_any, s_any, s_integer, s_any, s_integer, s_any, s_integer);
+ pl_ttrri = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_real, s_real, s_integer);
+ pl_ttrrri = s7_make_circular_signature(s7, 5, 6, s_any, s_any, s_real, s_real, s_real, s_integer);
+ pl_iiiiitiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_any, s_integer, s_integer, s_integer, s_any);
+ pl_iiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_iiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_iiiiiiit = s7_make_circular_signature(s7, 7, 8, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_iiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_iiiiiit = s7_make_circular_signature(s7, 6, 7, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_iiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_irrrt = s7_make_circular_signature(s7, 4, 5, s_integer, s_real, s_real, s_real, s_any);
+ pl_irrrrtttrrt = s7_make_circular_signature(s7, 10, 11, s_integer, s_real, s_real, s_real, s_real, s_any, s_any, s_any, s_real, s_real, s_any);
+ pl_i = s7_make_circular_signature(s7, 0, 1, s_integer);
+ pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any);
+ pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
+ pl_ittit = s7_make_circular_signature(s7, 4, 5, s_integer, s_any, s_any, s_integer, s_any);
+ pl_tiirrrrt = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_real, s_real, s_real, s_real, s_any);
+ pl_tiiiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_tiiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any);
+ pl_tiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_tiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_tirriit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_any);
+ pl_tirriirriit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_real, s_real, s_integer, s_integer, s_real, s_real, s_integer, s_integer, s_any);
+ pl_tirrir = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_real, s_real, s_integer, s_real);
+ pl_tir = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_real);
+ pl_tit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any);
+ pl_tiiiiiiiiit = s7_make_circular_signature(s7, 10, 11, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_tiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_tiiib = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_boolean);
+ pl_ti = s7_make_circular_signature(s7, 1, 2, s_any, s_integer);
+ pl_tiiiiiit = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_tiir = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_real);
+ pl_tiiiiit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_tiit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any);
+ pl_tibiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_boolean, s_integer, s_integer, s_any);
+ pl_tiib = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_boolean);
+ pl_trrrrt = s7_make_circular_signature(s7, 5, 6, s_any, s_real, s_real, s_real, s_real, s_any);
+ pl_tr = s7_make_circular_signature(s7, 1, 2, s_any, s_real);
+pl_unused = NULL;
#endif
+#if HAVE_SCHEME
+ #define gl_define_procedure(Name, Value, A1, A2, A3, Help, Sig) s7_define_typed_function(s7, XL_PRE #Name XL_POST, Value, A1, A2, A3, Help, Sig)
#else
-
-#if USE_MOTIF
-#define gxg_glXChooseVisual_w gxg_glXChooseVisual
-#define gxg_glXCopyContext_w gxg_glXCopyContext
-#define gxg_glXCreateContext_w gxg_glXCreateContext
-#define gxg_glXCreateGLXPixmap_w gxg_glXCreateGLXPixmap
-#define gxg_glXDestroyContext_w gxg_glXDestroyContext
-#define gxg_glXDestroyGLXPixmap_w gxg_glXDestroyGLXPixmap
-#define gxg_glXGetConfig_w gxg_glXGetConfig
-#define gxg_glXGetCurrentContext_w gxg_glXGetCurrentContext
-#define gxg_glXGetCurrentDrawable_w gxg_glXGetCurrentDrawable
-#define gxg_glXIsDirect_w gxg_glXIsDirect
-#define gxg_glXMakeCurrent_w gxg_glXMakeCurrent
-#define gxg_glXQueryExtension_w gxg_glXQueryExtension
-#define gxg_glXQueryVersion_w gxg_glXQueryVersion
-#define gxg_glXSwapBuffers_w gxg_glXSwapBuffers
-#define gxg_glXUseXFont_w gxg_glXUseXFont
-#define gxg_glXWaitGL_w gxg_glXWaitGL
-#define gxg_glXWaitX_w gxg_glXWaitX
-#define gxg_glXGetClientString_w gxg_glXGetClientString
-#define gxg_glXQueryServerString_w gxg_glXQueryServerString
-#define gxg_glXQueryExtensionsString_w gxg_glXQueryExtensionsString
-#endif
-#define gxg_glClearIndex_w gxg_glClearIndex
-#define gxg_glClearColor_w gxg_glClearColor
-#define gxg_glClear_w gxg_glClear
-#define gxg_glIndexMask_w gxg_glIndexMask
-#define gxg_glColorMask_w gxg_glColorMask
-#define gxg_glAlphaFunc_w gxg_glAlphaFunc
-#define gxg_glBlendFunc_w gxg_glBlendFunc
-#define gxg_glLogicOp_w gxg_glLogicOp
-#define gxg_glCullFace_w gxg_glCullFace
-#define gxg_glFrontFace_w gxg_glFrontFace
-#define gxg_glPointSize_w gxg_glPointSize
-#define gxg_glLineWidth_w gxg_glLineWidth
-#define gxg_glLineStipple_w gxg_glLineStipple
-#define gxg_glPolygonMode_w gxg_glPolygonMode
-#define gxg_glPolygonOffset_w gxg_glPolygonOffset
-#define gxg_glPolygonStipple_w gxg_glPolygonStipple
-#define gxg_glEdgeFlag_w gxg_glEdgeFlag
-#define gxg_glScissor_w gxg_glScissor
-#define gxg_glClipPlane_w gxg_glClipPlane
-#define gxg_glGetClipPlane_w gxg_glGetClipPlane
-#define gxg_glDrawBuffer_w gxg_glDrawBuffer
-#define gxg_glReadBuffer_w gxg_glReadBuffer
-#define gxg_glEnable_w gxg_glEnable
-#define gxg_glDisable_w gxg_glDisable
-#define gxg_glIsEnabled_w gxg_glIsEnabled
-#define gxg_glEnableClientState_w gxg_glEnableClientState
-#define gxg_glDisableClientState_w gxg_glDisableClientState
-#define gxg_glGetBooleanv_w gxg_glGetBooleanv
-#define gxg_glGetDoublev_w gxg_glGetDoublev
-#define gxg_glGetFloatv_w gxg_glGetFloatv
-#define gxg_glGetIntegerv_w gxg_glGetIntegerv
-#define gxg_glPushAttrib_w gxg_glPushAttrib
-#define gxg_glPopAttrib_w gxg_glPopAttrib
-#define gxg_glPushClientAttrib_w gxg_glPushClientAttrib
-#define gxg_glPopClientAttrib_w gxg_glPopClientAttrib
-#define gxg_glRenderMode_w gxg_glRenderMode
-#define gxg_glGetError_w gxg_glGetError
-#define gxg_glGetString_w gxg_glGetString
-#define gxg_glFinish_w gxg_glFinish
-#define gxg_glFlush_w gxg_glFlush
-#define gxg_glHint_w gxg_glHint
-#define gxg_glClearDepth_w gxg_glClearDepth
-#define gxg_glDepthFunc_w gxg_glDepthFunc
-#define gxg_glDepthMask_w gxg_glDepthMask
-#define gxg_glDepthRange_w gxg_glDepthRange
-#define gxg_glClearAccum_w gxg_glClearAccum
-#define gxg_glAccum_w gxg_glAccum
-#define gxg_glMatrixMode_w gxg_glMatrixMode
-#define gxg_glOrtho_w gxg_glOrtho
-#define gxg_glFrustum_w gxg_glFrustum
-#define gxg_glViewport_w gxg_glViewport
-#define gxg_glPushMatrix_w gxg_glPushMatrix
-#define gxg_glPopMatrix_w gxg_glPopMatrix
-#define gxg_glLoadIdentity_w gxg_glLoadIdentity
-#define gxg_glLoadMatrixd_w gxg_glLoadMatrixd
-#define gxg_glLoadMatrixf_w gxg_glLoadMatrixf
-#define gxg_glMultMatrixd_w gxg_glMultMatrixd
-#define gxg_glMultMatrixf_w gxg_glMultMatrixf
-#define gxg_glRotated_w gxg_glRotated
-#define gxg_glRotatef_w gxg_glRotatef
-#define gxg_glScaled_w gxg_glScaled
-#define gxg_glScalef_w gxg_glScalef
-#define gxg_glTranslated_w gxg_glTranslated
-#define gxg_glTranslatef_w gxg_glTranslatef
-#define gxg_glIsList_w gxg_glIsList
-#define gxg_glDeleteLists_w gxg_glDeleteLists
-#define gxg_glGenLists_w gxg_glGenLists
-#define gxg_glNewList_w gxg_glNewList
-#define gxg_glEndList_w gxg_glEndList
-#define gxg_glCallList_w gxg_glCallList
-#define gxg_glCallLists_w gxg_glCallLists
-#define gxg_glListBase_w gxg_glListBase
-#define gxg_glBegin_w gxg_glBegin
-#define gxg_glEnd_w gxg_glEnd
-#define gxg_glVertex2d_w gxg_glVertex2d
-#define gxg_glVertex2f_w gxg_glVertex2f
-#define gxg_glVertex2i_w gxg_glVertex2i
-#define gxg_glVertex2s_w gxg_glVertex2s
-#define gxg_glVertex3d_w gxg_glVertex3d
-#define gxg_glVertex3f_w gxg_glVertex3f
-#define gxg_glVertex3i_w gxg_glVertex3i
-#define gxg_glVertex3s_w gxg_glVertex3s
-#define gxg_glVertex4d_w gxg_glVertex4d
-#define gxg_glVertex4f_w gxg_glVertex4f
-#define gxg_glVertex4i_w gxg_glVertex4i
-#define gxg_glVertex4s_w gxg_glVertex4s
-#define gxg_glNormal3b_w gxg_glNormal3b
-#define gxg_glNormal3d_w gxg_glNormal3d
-#define gxg_glNormal3f_w gxg_glNormal3f
-#define gxg_glNormal3i_w gxg_glNormal3i
-#define gxg_glNormal3s_w gxg_glNormal3s
-#define gxg_glIndexd_w gxg_glIndexd
-#define gxg_glIndexf_w gxg_glIndexf
-#define gxg_glIndexi_w gxg_glIndexi
-#define gxg_glIndexs_w gxg_glIndexs
-#define gxg_glIndexub_w gxg_glIndexub
-#define gxg_glColor3b_w gxg_glColor3b
-#define gxg_glColor3d_w gxg_glColor3d
-#define gxg_glColor3f_w gxg_glColor3f
-#define gxg_glColor3i_w gxg_glColor3i
-#define gxg_glColor3s_w gxg_glColor3s
-#define gxg_glColor3ub_w gxg_glColor3ub
-#define gxg_glColor3ui_w gxg_glColor3ui
-#define gxg_glColor3us_w gxg_glColor3us
-#define gxg_glColor4b_w gxg_glColor4b
-#define gxg_glColor4d_w gxg_glColor4d
-#define gxg_glColor4f_w gxg_glColor4f
-#define gxg_glColor4i_w gxg_glColor4i
-#define gxg_glColor4s_w gxg_glColor4s
-#define gxg_glColor4ub_w gxg_glColor4ub
-#define gxg_glColor4ui_w gxg_glColor4ui
-#define gxg_glColor4us_w gxg_glColor4us
-#define gxg_glTexCoord1d_w gxg_glTexCoord1d
-#define gxg_glTexCoord1f_w gxg_glTexCoord1f
-#define gxg_glTexCoord1i_w gxg_glTexCoord1i
-#define gxg_glTexCoord1s_w gxg_glTexCoord1s
-#define gxg_glTexCoord2d_w gxg_glTexCoord2d
-#define gxg_glTexCoord2f_w gxg_glTexCoord2f
-#define gxg_glTexCoord2i_w gxg_glTexCoord2i
-#define gxg_glTexCoord2s_w gxg_glTexCoord2s
-#define gxg_glTexCoord3d_w gxg_glTexCoord3d
-#define gxg_glTexCoord3f_w gxg_glTexCoord3f
-#define gxg_glTexCoord3i_w gxg_glTexCoord3i
-#define gxg_glTexCoord3s_w gxg_glTexCoord3s
-#define gxg_glTexCoord4d_w gxg_glTexCoord4d
-#define gxg_glTexCoord4f_w gxg_glTexCoord4f
-#define gxg_glTexCoord4i_w gxg_glTexCoord4i
-#define gxg_glTexCoord4s_w gxg_glTexCoord4s
-#define gxg_glRasterPos2d_w gxg_glRasterPos2d
-#define gxg_glRasterPos2f_w gxg_glRasterPos2f
-#define gxg_glRasterPos2i_w gxg_glRasterPos2i
-#define gxg_glRasterPos2s_w gxg_glRasterPos2s
-#define gxg_glRasterPos3d_w gxg_glRasterPos3d
-#define gxg_glRasterPos3f_w gxg_glRasterPos3f
-#define gxg_glRasterPos3i_w gxg_glRasterPos3i
-#define gxg_glRasterPos3s_w gxg_glRasterPos3s
-#define gxg_glRasterPos4d_w gxg_glRasterPos4d
-#define gxg_glRasterPos4f_w gxg_glRasterPos4f
-#define gxg_glRasterPos4i_w gxg_glRasterPos4i
-#define gxg_glRasterPos4s_w gxg_glRasterPos4s
-#define gxg_glRectd_w gxg_glRectd
-#define gxg_glRectf_w gxg_glRectf
-#define gxg_glRecti_w gxg_glRecti
-#define gxg_glRects_w gxg_glRects
-#define gxg_glVertexPointer_w gxg_glVertexPointer
-#define gxg_glNormalPointer_w gxg_glNormalPointer
-#define gxg_glColorPointer_w gxg_glColorPointer
-#define gxg_glIndexPointer_w gxg_glIndexPointer
-#define gxg_glTexCoordPointer_w gxg_glTexCoordPointer
-#define gxg_glEdgeFlagPointer_w gxg_glEdgeFlagPointer
-#define gxg_glGetPointerv_w gxg_glGetPointerv
-#define gxg_glArrayElement_w gxg_glArrayElement
-#define gxg_glDrawArrays_w gxg_glDrawArrays
-#define gxg_glDrawElements_w gxg_glDrawElements
-#define gxg_glInterleavedArrays_w gxg_glInterleavedArrays
-#define gxg_glShadeModel_w gxg_glShadeModel
-#define gxg_glLightf_w gxg_glLightf
-#define gxg_glLighti_w gxg_glLighti
-#define gxg_glGetLightfv_w gxg_glGetLightfv
-#define gxg_glGetLightiv_w gxg_glGetLightiv
-#define gxg_glLightModelf_w gxg_glLightModelf
-#define gxg_glLightModeli_w gxg_glLightModeli
-#define gxg_glMaterialf_w gxg_glMaterialf
-#define gxg_glMateriali_w gxg_glMateriali
-#define gxg_glGetMaterialfv_w gxg_glGetMaterialfv
-#define gxg_glGetMaterialiv_w gxg_glGetMaterialiv
-#define gxg_glColorMaterial_w gxg_glColorMaterial
-#define gxg_glPixelZoom_w gxg_glPixelZoom
-#define gxg_glPixelStoref_w gxg_glPixelStoref
-#define gxg_glPixelStorei_w gxg_glPixelStorei
-#define gxg_glPixelTransferf_w gxg_glPixelTransferf
-#define gxg_glPixelTransferi_w gxg_glPixelTransferi
-#define gxg_glGetPixelMapfv_w gxg_glGetPixelMapfv
-#define gxg_glGetPixelMapuiv_w gxg_glGetPixelMapuiv
-#define gxg_glGetPixelMapusv_w gxg_glGetPixelMapusv
-#define gxg_glBitmap_w gxg_glBitmap
-#define gxg_glReadPixels_w gxg_glReadPixels
-#define gxg_glDrawPixels_w gxg_glDrawPixels
-#define gxg_glCopyPixels_w gxg_glCopyPixels
-#define gxg_glStencilFunc_w gxg_glStencilFunc
-#define gxg_glStencilMask_w gxg_glStencilMask
-#define gxg_glStencilOp_w gxg_glStencilOp
-#define gxg_glClearStencil_w gxg_glClearStencil
-#define gxg_glTexGend_w gxg_glTexGend
-#define gxg_glTexGenf_w gxg_glTexGenf
-#define gxg_glTexGeni_w gxg_glTexGeni
-#define gxg_glGetTexGendv_w gxg_glGetTexGendv
-#define gxg_glGetTexGenfv_w gxg_glGetTexGenfv
-#define gxg_glGetTexGeniv_w gxg_glGetTexGeniv
-#define gxg_glTexEnvf_w gxg_glTexEnvf
-#define gxg_glTexEnvi_w gxg_glTexEnvi
-#define gxg_glGetTexEnvfv_w gxg_glGetTexEnvfv
-#define gxg_glGetTexEnviv_w gxg_glGetTexEnviv
-#define gxg_glTexParameterf_w gxg_glTexParameterf
-#define gxg_glTexParameteri_w gxg_glTexParameteri
-#define gxg_glGetTexParameterfv_w gxg_glGetTexParameterfv
-#define gxg_glGetTexParameteriv_w gxg_glGetTexParameteriv
-#define gxg_glGetTexLevelParameterfv_w gxg_glGetTexLevelParameterfv
-#define gxg_glGetTexLevelParameteriv_w gxg_glGetTexLevelParameteriv
-#define gxg_glTexImage1D_w gxg_glTexImage1D
-#define gxg_glTexImage2D_w gxg_glTexImage2D
-#define gxg_glGenTextures_w gxg_glGenTextures
-#define gxg_glDeleteTextures_w gxg_glDeleteTextures
-#define gxg_glBindTexture_w gxg_glBindTexture
-#define gxg_glAreTexturesResident_w gxg_glAreTexturesResident
-#define gxg_glIsTexture_w gxg_glIsTexture
-#define gxg_glTexSubImage1D_w gxg_glTexSubImage1D
-#define gxg_glTexSubImage2D_w gxg_glTexSubImage2D
-#define gxg_glCopyTexImage1D_w gxg_glCopyTexImage1D
-#define gxg_glCopyTexImage2D_w gxg_glCopyTexImage2D
-#define gxg_glCopyTexSubImage1D_w gxg_glCopyTexSubImage1D
-#define gxg_glCopyTexSubImage2D_w gxg_glCopyTexSubImage2D
-#define gxg_glMap1d_w gxg_glMap1d
-#define gxg_glMap1f_w gxg_glMap1f
-#define gxg_glMap2d_w gxg_glMap2d
-#define gxg_glMap2f_w gxg_glMap2f
-#define gxg_glGetMapdv_w gxg_glGetMapdv
-#define gxg_glGetMapfv_w gxg_glGetMapfv
-#define gxg_glGetMapiv_w gxg_glGetMapiv
-#define gxg_glEvalCoord1d_w gxg_glEvalCoord1d
-#define gxg_glEvalCoord1f_w gxg_glEvalCoord1f
-#define gxg_glEvalCoord2d_w gxg_glEvalCoord2d
-#define gxg_glEvalCoord2f_w gxg_glEvalCoord2f
-#define gxg_glMapGrid1d_w gxg_glMapGrid1d
-#define gxg_glMapGrid1f_w gxg_glMapGrid1f
-#define gxg_glMapGrid2d_w gxg_glMapGrid2d
-#define gxg_glMapGrid2f_w gxg_glMapGrid2f
-#define gxg_glEvalPoint1_w gxg_glEvalPoint1
-#define gxg_glEvalPoint2_w gxg_glEvalPoint2
-#define gxg_glEvalMesh1_w gxg_glEvalMesh1
-#define gxg_glEvalMesh2_w gxg_glEvalMesh2
-#define gxg_glFogf_w gxg_glFogf
-#define gxg_glFogi_w gxg_glFogi
-#define gxg_glFeedbackBuffer_w gxg_glFeedbackBuffer
-#define gxg_glPassThrough_w gxg_glPassThrough
-#define gxg_glSelectBuffer_w gxg_glSelectBuffer
-#define gxg_glInitNames_w gxg_glInitNames
-#define gxg_glLoadName_w gxg_glLoadName
-#define gxg_glPushName_w gxg_glPushName
-#define gxg_glPopName_w gxg_glPopName
-#define gxg_glDrawRangeElements_w gxg_glDrawRangeElements
-#define gxg_glTexImage3D_w gxg_glTexImage3D
-#define gxg_glTexSubImage3D_w gxg_glTexSubImage3D
-#define gxg_glCopyTexSubImage3D_w gxg_glCopyTexSubImage3D
-#define gxg_glColorTable_w gxg_glColorTable
-#define gxg_glColorSubTable_w gxg_glColorSubTable
-#define gxg_glCopyColorSubTable_w gxg_glCopyColorSubTable
-#define gxg_glCopyColorTable_w gxg_glCopyColorTable
-#define gxg_glGetColorTableParameterfv_w gxg_glGetColorTableParameterfv
-#define gxg_glGetColorTableParameteriv_w gxg_glGetColorTableParameteriv
-#define gxg_glBlendEquation_w gxg_glBlendEquation
-#define gxg_glBlendColor_w gxg_glBlendColor
-#define gxg_glHistogram_w gxg_glHistogram
-#define gxg_glResetHistogram_w gxg_glResetHistogram
-#define gxg_glGetHistogram_w gxg_glGetHistogram
-#define gxg_glGetHistogramParameterfv_w gxg_glGetHistogramParameterfv
-#define gxg_glGetHistogramParameteriv_w gxg_glGetHistogramParameteriv
-#define gxg_glMinmax_w gxg_glMinmax
-#define gxg_glResetMinmax_w gxg_glResetMinmax
-#define gxg_glGetMinmax_w gxg_glGetMinmax
-#define gxg_glGetMinmaxParameterfv_w gxg_glGetMinmaxParameterfv
-#define gxg_glGetMinmaxParameteriv_w gxg_glGetMinmaxParameteriv
-#define gxg_glConvolutionFilter1D_w gxg_glConvolutionFilter1D
-#define gxg_glConvolutionFilter2D_w gxg_glConvolutionFilter2D
-#define gxg_glConvolutionParameterf_w gxg_glConvolutionParameterf
-#define gxg_glConvolutionParameteri_w gxg_glConvolutionParameteri
-#define gxg_glCopyConvolutionFilter1D_w gxg_glCopyConvolutionFilter1D
-#define gxg_glCopyConvolutionFilter2D_w gxg_glCopyConvolutionFilter2D
-#define gxg_glSeparableFilter2D_w gxg_glSeparableFilter2D
-#if HAVE_GLU
-#define gxg_gluBeginCurve_w gxg_gluBeginCurve
-#ifdef GLU_VERSION_1_2
-#define gxg_gluBeginPolygon_w gxg_gluBeginPolygon
-#endif
-#define gxg_gluBeginSurface_w gxg_gluBeginSurface
-#define gxg_gluBeginTrim_w gxg_gluBeginTrim
-#define gxg_gluBuild1DMipmapLevels_w gxg_gluBuild1DMipmapLevels
-#define gxg_gluBuild1DMipmaps_w gxg_gluBuild1DMipmaps
-#define gxg_gluBuild2DMipmapLevels_w gxg_gluBuild2DMipmapLevels
-#define gxg_gluBuild2DMipmaps_w gxg_gluBuild2DMipmaps
-#define gxg_gluBuild3DMipmapLevels_w gxg_gluBuild3DMipmapLevels
-#define gxg_gluBuild3DMipmaps_w gxg_gluBuild3DMipmaps
-#define gxg_gluCheckExtension_w gxg_gluCheckExtension
-#define gxg_gluCylinder_w gxg_gluCylinder
-#define gxg_gluDeleteNurbsRenderer_w gxg_gluDeleteNurbsRenderer
-#define gxg_gluDeleteQuadric_w gxg_gluDeleteQuadric
-#ifdef GLU_VERSION_1_2
-#define gxg_gluDeleteTess_w gxg_gluDeleteTess
+ #define gl_define_procedure(Name, Value, A1, A2, A3, Help, Sig) Xen_define_safe_procedure(XL_PRE #Name XL_POST, Value, A1, A2, A3, Help)
#endif
-#define gxg_gluDisk_w gxg_gluDisk
-#define gxg_gluEndCurve_w gxg_gluEndCurve
-#ifdef GLU_VERSION_1_2
-#define gxg_gluEndPolygon_w gxg_gluEndPolygon
-#endif
-#define gxg_gluEndSurface_w gxg_gluEndSurface
-#define gxg_gluEndTrim_w gxg_gluEndTrim
-#define gxg_gluErrorString_w gxg_gluErrorString
-#define gxg_gluGetNurbsProperty_w gxg_gluGetNurbsProperty
-#define gxg_gluGetString_w gxg_gluGetString
-#ifdef GLU_VERSION_1_2
-#define gxg_gluGetTessProperty_w gxg_gluGetTessProperty
-#endif
-#define gxg_gluLoadSamplingMatrices_w gxg_gluLoadSamplingMatrices
-#define gxg_gluLookAt_w gxg_gluLookAt
-#define gxg_gluNewNurbsRenderer_w gxg_gluNewNurbsRenderer
-#define gxg_gluNewQuadric_w gxg_gluNewQuadric
-#ifdef GLU_VERSION_1_2
-#define gxg_gluNewTess_w gxg_gluNewTess
-#endif
-#ifdef GLU_VERSION_1_2
-#define gxg_gluNextContour_w gxg_gluNextContour
-#endif
-#define gxg_gluNurbsCallback_w gxg_gluNurbsCallback
-#define gxg_gluNurbsCallbackData_w gxg_gluNurbsCallbackData
-#define gxg_gluNurbsCallbackDataEXT_w gxg_gluNurbsCallbackDataEXT
-#define gxg_gluNurbsCurve_w gxg_gluNurbsCurve
-#define gxg_gluNurbsProperty_w gxg_gluNurbsProperty
-#define gxg_gluNurbsSurface_w gxg_gluNurbsSurface
-#define gxg_gluOrtho2D_w gxg_gluOrtho2D
-#define gxg_gluPartialDisk_w gxg_gluPartialDisk
-#define gxg_gluPerspective_w gxg_gluPerspective
-#define gxg_gluPickMatrix_w gxg_gluPickMatrix
-#define gxg_gluProject_w gxg_gluProject
-#define gxg_gluPwlCurve_w gxg_gluPwlCurve
-#define gxg_gluQuadricCallback_w gxg_gluQuadricCallback
-#define gxg_gluQuadricDrawStyle_w gxg_gluQuadricDrawStyle
-#define gxg_gluQuadricNormals_w gxg_gluQuadricNormals
-#define gxg_gluQuadricOrientation_w gxg_gluQuadricOrientation
-#define gxg_gluQuadricTexture_w gxg_gluQuadricTexture
-#define gxg_gluScaleImage_w gxg_gluScaleImage
-#define gxg_gluSphere_w gxg_gluSphere
-#ifdef GLU_VERSION_1_2
-#define gxg_gluTessBeginContour_w gxg_gluTessBeginContour
-#endif
-#ifdef GLU_VERSION_1_2
-#define gxg_gluTessBeginPolygon_w gxg_gluTessBeginPolygon
-#endif
-#define gxg_gluTessCallback_w gxg_gluTessCallback
-#ifdef GLU_VERSION_1_2
-#define gxg_gluTessEndContour_w gxg_gluTessEndContour
-#endif
-#ifdef GLU_VERSION_1_2
-#define gxg_gluTessEndPolygon_w gxg_gluTessEndPolygon
-#endif
-#ifdef GLU_VERSION_1_2
-#define gxg_gluTessNormal_w gxg_gluTessNormal
-#endif
-#ifdef GLU_VERSION_1_2
-#define gxg_gluTessProperty_w gxg_gluTessProperty
-#endif
-#ifdef GLU_VERSION_1_2
-#define gxg_gluTessVertex_w gxg_gluTessVertex
-#endif
-#define gxg_gluUnProject_w gxg_gluUnProject
-#define gxg_gluUnProject4_w gxg_gluUnProject4
-#endif
-#endif
-static void define_functions(void)
-{
- #define GL_DEFINE_PROCEDURE(Name, Value, A1, A2, A3, Help) XEN_DEFINE_PROCEDURE(XL_PRE #Name XL_POST, Value, A1, A2, A3, Help)
+
#if USE_MOTIF
- GL_DEFINE_PROCEDURE(glXChooseVisual, gxg_glXChooseVisual_w, 3, 0, 0, H_glXChooseVisual);
- GL_DEFINE_PROCEDURE(glXCopyContext, gxg_glXCopyContext_w, 4, 0, 0, H_glXCopyContext);
- GL_DEFINE_PROCEDURE(glXCreateContext, gxg_glXCreateContext_w, 4, 0, 0, H_glXCreateContext);
- GL_DEFINE_PROCEDURE(glXCreateGLXPixmap, gxg_glXCreateGLXPixmap_w, 3, 0, 0, H_glXCreateGLXPixmap);
- GL_DEFINE_PROCEDURE(glXDestroyContext, gxg_glXDestroyContext_w, 2, 0, 0, H_glXDestroyContext);
- GL_DEFINE_PROCEDURE(glXDestroyGLXPixmap, gxg_glXDestroyGLXPixmap_w, 2, 0, 0, H_glXDestroyGLXPixmap);
- GL_DEFINE_PROCEDURE(glXGetConfig, gxg_glXGetConfig_w, 3, 1, 0, H_glXGetConfig);
- GL_DEFINE_PROCEDURE(glXGetCurrentContext, gxg_glXGetCurrentContext_w, 0, 0, 0, H_glXGetCurrentContext);
- GL_DEFINE_PROCEDURE(glXGetCurrentDrawable, gxg_glXGetCurrentDrawable_w, 0, 0, 0, H_glXGetCurrentDrawable);
- GL_DEFINE_PROCEDURE(glXIsDirect, gxg_glXIsDirect_w, 2, 0, 0, H_glXIsDirect);
- GL_DEFINE_PROCEDURE(glXMakeCurrent, gxg_glXMakeCurrent_w, 3, 0, 0, H_glXMakeCurrent);
- GL_DEFINE_PROCEDURE(glXQueryExtension, gxg_glXQueryExtension_w, 1, 2, 0, H_glXQueryExtension);
- GL_DEFINE_PROCEDURE(glXQueryVersion, gxg_glXQueryVersion_w, 1, 2, 0, H_glXQueryVersion);
- GL_DEFINE_PROCEDURE(glXSwapBuffers, gxg_glXSwapBuffers_w, 2, 0, 0, H_glXSwapBuffers);
- GL_DEFINE_PROCEDURE(glXUseXFont, gxg_glXUseXFont_w, 4, 0, 0, H_glXUseXFont);
- GL_DEFINE_PROCEDURE(glXWaitGL, gxg_glXWaitGL_w, 0, 0, 0, H_glXWaitGL);
- GL_DEFINE_PROCEDURE(glXWaitX, gxg_glXWaitX_w, 0, 0, 0, H_glXWaitX);
- GL_DEFINE_PROCEDURE(glXGetClientString, gxg_glXGetClientString_w, 2, 0, 0, H_glXGetClientString);
- GL_DEFINE_PROCEDURE(glXQueryServerString, gxg_glXQueryServerString_w, 3, 0, 0, H_glXQueryServerString);
- GL_DEFINE_PROCEDURE(glXQueryExtensionsString, gxg_glXQueryExtensionsString_w, 2, 0, 0, H_glXQueryExtensionsString);
+ gl_define_procedure(glXChooseVisual, gxg_glXChooseVisual_w, 3, 0, 0, H_glXChooseVisual, pl_ttit);
+ gl_define_procedure(glXCopyContext, gxg_glXCopyContext_w, 4, 0, 0, H_glXCopyContext, pl_tttti);
+ gl_define_procedure(glXCreateContext, gxg_glXCreateContext_w, 4, 0, 0, H_glXCreateContext, pl_ttttb);
+ gl_define_procedure(glXCreateGLXPixmap, gxg_glXCreateGLXPixmap_w, 3, 0, 0, H_glXCreateGLXPixmap, pl_t);
+ gl_define_procedure(glXDestroyContext, gxg_glXDestroyContext_w, 2, 0, 0, H_glXDestroyContext, pl_t);
+ gl_define_procedure(glXDestroyGLXPixmap, gxg_glXDestroyGLXPixmap_w, 2, 0, 0, H_glXDestroyGLXPixmap, pl_t);
+ gl_define_procedure(glXGetConfig, gxg_glXGetConfig_w, 3, 1, 0, H_glXGetConfig, pl_ittit);
+ gl_define_procedure(glXGetCurrentContext, gxg_glXGetCurrentContext_w, 0, 0, 0, H_glXGetCurrentContext, pl_t);
+ gl_define_procedure(glXGetCurrentDrawable, gxg_glXGetCurrentDrawable_w, 0, 0, 0, H_glXGetCurrentDrawable, pl_t);
+ gl_define_procedure(glXIsDirect, gxg_glXIsDirect_w, 2, 0, 0, H_glXIsDirect, pl_bt);
+ gl_define_procedure(glXMakeCurrent, gxg_glXMakeCurrent_w, 3, 0, 0, H_glXMakeCurrent, pl_bt);
+ gl_define_procedure(glXQueryExtension, gxg_glXQueryExtension_w, 1, 2, 0, H_glXQueryExtension, pl_bt);
+ gl_define_procedure(glXQueryVersion, gxg_glXQueryVersion_w, 1, 2, 0, H_glXQueryVersion, pl_bt);
+ gl_define_procedure(glXSwapBuffers, gxg_glXSwapBuffers_w, 2, 0, 0, H_glXSwapBuffers, pl_t);
+ gl_define_procedure(glXUseXFont, gxg_glXUseXFont_w, 4, 0, 0, H_glXUseXFont, pl_tti);
+ gl_define_procedure(glXWaitGL, gxg_glXWaitGL_w, 0, 0, 0, H_glXWaitGL, pl_t);
+ gl_define_procedure(glXWaitX, gxg_glXWaitX_w, 0, 0, 0, H_glXWaitX, pl_t);
+ gl_define_procedure(glXGetClientString, gxg_glXGetClientString_w, 2, 0, 0, H_glXGetClientString, pl_tti);
+ gl_define_procedure(glXQueryServerString, gxg_glXQueryServerString_w, 3, 0, 0, H_glXQueryServerString, pl_tti);
+ gl_define_procedure(glXQueryExtensionsString, gxg_glXQueryExtensionsString_w, 2, 0, 0, H_glXQueryExtensionsString, pl_tti);
#endif
- GL_DEFINE_PROCEDURE(glClearIndex, gxg_glClearIndex_w, 1, 0, 0, H_glClearIndex);
- GL_DEFINE_PROCEDURE(glClearColor, gxg_glClearColor_w, 4, 0, 0, H_glClearColor);
- GL_DEFINE_PROCEDURE(glClear, gxg_glClear_w, 1, 0, 0, H_glClear);
- GL_DEFINE_PROCEDURE(glIndexMask, gxg_glIndexMask_w, 1, 0, 0, H_glIndexMask);
- GL_DEFINE_PROCEDURE(glColorMask, gxg_glColorMask_w, 4, 0, 0, H_glColorMask);
- GL_DEFINE_PROCEDURE(glAlphaFunc, gxg_glAlphaFunc_w, 2, 0, 0, H_glAlphaFunc);
- GL_DEFINE_PROCEDURE(glBlendFunc, gxg_glBlendFunc_w, 2, 0, 0, H_glBlendFunc);
- GL_DEFINE_PROCEDURE(glLogicOp, gxg_glLogicOp_w, 1, 0, 0, H_glLogicOp);
- GL_DEFINE_PROCEDURE(glCullFace, gxg_glCullFace_w, 1, 0, 0, H_glCullFace);
- GL_DEFINE_PROCEDURE(glFrontFace, gxg_glFrontFace_w, 1, 0, 0, H_glFrontFace);
- GL_DEFINE_PROCEDURE(glPointSize, gxg_glPointSize_w, 1, 0, 0, H_glPointSize);
- GL_DEFINE_PROCEDURE(glLineWidth, gxg_glLineWidth_w, 1, 0, 0, H_glLineWidth);
- GL_DEFINE_PROCEDURE(glLineStipple, gxg_glLineStipple_w, 2, 0, 0, H_glLineStipple);
- GL_DEFINE_PROCEDURE(glPolygonMode, gxg_glPolygonMode_w, 2, 0, 0, H_glPolygonMode);
- GL_DEFINE_PROCEDURE(glPolygonOffset, gxg_glPolygonOffset_w, 2, 0, 0, H_glPolygonOffset);
- GL_DEFINE_PROCEDURE(glPolygonStipple, gxg_glPolygonStipple_w, 1, 0, 0, H_glPolygonStipple);
- GL_DEFINE_PROCEDURE(glEdgeFlag, gxg_glEdgeFlag_w, 1, 0, 0, H_glEdgeFlag);
- GL_DEFINE_PROCEDURE(glScissor, gxg_glScissor_w, 4, 0, 0, H_glScissor);
- GL_DEFINE_PROCEDURE(glClipPlane, gxg_glClipPlane_w, 2, 0, 0, H_glClipPlane);
- GL_DEFINE_PROCEDURE(glGetClipPlane, gxg_glGetClipPlane_w, 1, 1, 0, H_glGetClipPlane);
- GL_DEFINE_PROCEDURE(glDrawBuffer, gxg_glDrawBuffer_w, 1, 0, 0, H_glDrawBuffer);
- GL_DEFINE_PROCEDURE(glReadBuffer, gxg_glReadBuffer_w, 1, 0, 0, H_glReadBuffer);
- GL_DEFINE_PROCEDURE(glEnable, gxg_glEnable_w, 1, 0, 0, H_glEnable);
- GL_DEFINE_PROCEDURE(glDisable, gxg_glDisable_w, 1, 0, 0, H_glDisable);
- GL_DEFINE_PROCEDURE(glIsEnabled, gxg_glIsEnabled_w, 1, 0, 0, H_glIsEnabled);
- GL_DEFINE_PROCEDURE(glEnableClientState, gxg_glEnableClientState_w, 1, 0, 0, H_glEnableClientState);
- GL_DEFINE_PROCEDURE(glDisableClientState, gxg_glDisableClientState_w, 1, 0, 0, H_glDisableClientState);
- GL_DEFINE_PROCEDURE(glGetBooleanv, gxg_glGetBooleanv_w, 1, 1, 0, H_glGetBooleanv);
- GL_DEFINE_PROCEDURE(glGetDoublev, gxg_glGetDoublev_w, 1, 1, 0, H_glGetDoublev);
- GL_DEFINE_PROCEDURE(glGetFloatv, gxg_glGetFloatv_w, 1, 1, 0, H_glGetFloatv);
- GL_DEFINE_PROCEDURE(glGetIntegerv, gxg_glGetIntegerv_w, 1, 1, 0, H_glGetIntegerv);
- GL_DEFINE_PROCEDURE(glPushAttrib, gxg_glPushAttrib_w, 1, 0, 0, H_glPushAttrib);
- GL_DEFINE_PROCEDURE(glPopAttrib, gxg_glPopAttrib_w, 0, 0, 0, H_glPopAttrib);
- GL_DEFINE_PROCEDURE(glPushClientAttrib, gxg_glPushClientAttrib_w, 1, 0, 0, H_glPushClientAttrib);
- GL_DEFINE_PROCEDURE(glPopClientAttrib, gxg_glPopClientAttrib_w, 0, 0, 0, H_glPopClientAttrib);
- GL_DEFINE_PROCEDURE(glRenderMode, gxg_glRenderMode_w, 1, 0, 0, H_glRenderMode);
- GL_DEFINE_PROCEDURE(glGetError, gxg_glGetError_w, 0, 0, 0, H_glGetError);
- GL_DEFINE_PROCEDURE(glGetString, gxg_glGetString_w, 1, 0, 0, H_glGetString);
- GL_DEFINE_PROCEDURE(glFinish, gxg_glFinish_w, 0, 0, 0, H_glFinish);
- GL_DEFINE_PROCEDURE(glFlush, gxg_glFlush_w, 0, 0, 0, H_glFlush);
- GL_DEFINE_PROCEDURE(glHint, gxg_glHint_w, 2, 0, 0, H_glHint);
- GL_DEFINE_PROCEDURE(glClearDepth, gxg_glClearDepth_w, 1, 0, 0, H_glClearDepth);
- GL_DEFINE_PROCEDURE(glDepthFunc, gxg_glDepthFunc_w, 1, 0, 0, H_glDepthFunc);
- GL_DEFINE_PROCEDURE(glDepthMask, gxg_glDepthMask_w, 1, 0, 0, H_glDepthMask);
- GL_DEFINE_PROCEDURE(glDepthRange, gxg_glDepthRange_w, 2, 0, 0, H_glDepthRange);
- GL_DEFINE_PROCEDURE(glClearAccum, gxg_glClearAccum_w, 4, 0, 0, H_glClearAccum);
- GL_DEFINE_PROCEDURE(glAccum, gxg_glAccum_w, 2, 0, 0, H_glAccum);
- GL_DEFINE_PROCEDURE(glMatrixMode, gxg_glMatrixMode_w, 1, 0, 0, H_glMatrixMode);
- GL_DEFINE_PROCEDURE(glOrtho, gxg_glOrtho_w, 6, 0, 0, H_glOrtho);
- GL_DEFINE_PROCEDURE(glFrustum, gxg_glFrustum_w, 6, 0, 0, H_glFrustum);
- GL_DEFINE_PROCEDURE(glViewport, gxg_glViewport_w, 4, 0, 0, H_glViewport);
- GL_DEFINE_PROCEDURE(glPushMatrix, gxg_glPushMatrix_w, 0, 0, 0, H_glPushMatrix);
- GL_DEFINE_PROCEDURE(glPopMatrix, gxg_glPopMatrix_w, 0, 0, 0, H_glPopMatrix);
- GL_DEFINE_PROCEDURE(glLoadIdentity, gxg_glLoadIdentity_w, 0, 0, 0, H_glLoadIdentity);
- GL_DEFINE_PROCEDURE(glLoadMatrixd, gxg_glLoadMatrixd_w, 1, 0, 0, H_glLoadMatrixd);
- GL_DEFINE_PROCEDURE(glLoadMatrixf, gxg_glLoadMatrixf_w, 1, 0, 0, H_glLoadMatrixf);
- GL_DEFINE_PROCEDURE(glMultMatrixd, gxg_glMultMatrixd_w, 1, 0, 0, H_glMultMatrixd);
- GL_DEFINE_PROCEDURE(glMultMatrixf, gxg_glMultMatrixf_w, 1, 0, 0, H_glMultMatrixf);
- GL_DEFINE_PROCEDURE(glRotated, gxg_glRotated_w, 4, 0, 0, H_glRotated);
- GL_DEFINE_PROCEDURE(glRotatef, gxg_glRotatef_w, 4, 0, 0, H_glRotatef);
- GL_DEFINE_PROCEDURE(glScaled, gxg_glScaled_w, 3, 0, 0, H_glScaled);
- GL_DEFINE_PROCEDURE(glScalef, gxg_glScalef_w, 3, 0, 0, H_glScalef);
- GL_DEFINE_PROCEDURE(glTranslated, gxg_glTranslated_w, 3, 0, 0, H_glTranslated);
- GL_DEFINE_PROCEDURE(glTranslatef, gxg_glTranslatef_w, 3, 0, 0, H_glTranslatef);
- GL_DEFINE_PROCEDURE(glIsList, gxg_glIsList_w, 1, 0, 0, H_glIsList);
- GL_DEFINE_PROCEDURE(glDeleteLists, gxg_glDeleteLists_w, 2, 0, 0, H_glDeleteLists);
- GL_DEFINE_PROCEDURE(glGenLists, gxg_glGenLists_w, 1, 0, 0, H_glGenLists);
- GL_DEFINE_PROCEDURE(glNewList, gxg_glNewList_w, 2, 0, 0, H_glNewList);
- GL_DEFINE_PROCEDURE(glEndList, gxg_glEndList_w, 0, 0, 0, H_glEndList);
- GL_DEFINE_PROCEDURE(glCallList, gxg_glCallList_w, 1, 0, 0, H_glCallList);
- GL_DEFINE_PROCEDURE(glCallLists, gxg_glCallLists_w, 3, 0, 0, H_glCallLists);
- GL_DEFINE_PROCEDURE(glListBase, gxg_glListBase_w, 1, 0, 0, H_glListBase);
- GL_DEFINE_PROCEDURE(glBegin, gxg_glBegin_w, 1, 0, 0, H_glBegin);
- GL_DEFINE_PROCEDURE(glEnd, gxg_glEnd_w, 0, 0, 0, H_glEnd);
- GL_DEFINE_PROCEDURE(glVertex2d, gxg_glVertex2d_w, 2, 0, 0, H_glVertex2d);
- GL_DEFINE_PROCEDURE(glVertex2f, gxg_glVertex2f_w, 2, 0, 0, H_glVertex2f);
- GL_DEFINE_PROCEDURE(glVertex2i, gxg_glVertex2i_w, 2, 0, 0, H_glVertex2i);
- GL_DEFINE_PROCEDURE(glVertex2s, gxg_glVertex2s_w, 2, 0, 0, H_glVertex2s);
- GL_DEFINE_PROCEDURE(glVertex3d, gxg_glVertex3d_w, 3, 0, 0, H_glVertex3d);
- GL_DEFINE_PROCEDURE(glVertex3f, gxg_glVertex3f_w, 3, 0, 0, H_glVertex3f);
- GL_DEFINE_PROCEDURE(glVertex3i, gxg_glVertex3i_w, 3, 0, 0, H_glVertex3i);
- GL_DEFINE_PROCEDURE(glVertex3s, gxg_glVertex3s_w, 3, 0, 0, H_glVertex3s);
- GL_DEFINE_PROCEDURE(glVertex4d, gxg_glVertex4d_w, 4, 0, 0, H_glVertex4d);
- GL_DEFINE_PROCEDURE(glVertex4f, gxg_glVertex4f_w, 4, 0, 0, H_glVertex4f);
- GL_DEFINE_PROCEDURE(glVertex4i, gxg_glVertex4i_w, 4, 0, 0, H_glVertex4i);
- GL_DEFINE_PROCEDURE(glVertex4s, gxg_glVertex4s_w, 4, 0, 0, H_glVertex4s);
- GL_DEFINE_PROCEDURE(glNormal3b, gxg_glNormal3b_w, 3, 0, 0, H_glNormal3b);
- GL_DEFINE_PROCEDURE(glNormal3d, gxg_glNormal3d_w, 3, 0, 0, H_glNormal3d);
- GL_DEFINE_PROCEDURE(glNormal3f, gxg_glNormal3f_w, 3, 0, 0, H_glNormal3f);
- GL_DEFINE_PROCEDURE(glNormal3i, gxg_glNormal3i_w, 3, 0, 0, H_glNormal3i);
- GL_DEFINE_PROCEDURE(glNormal3s, gxg_glNormal3s_w, 3, 0, 0, H_glNormal3s);
- GL_DEFINE_PROCEDURE(glIndexd, gxg_glIndexd_w, 1, 0, 0, H_glIndexd);
- GL_DEFINE_PROCEDURE(glIndexf, gxg_glIndexf_w, 1, 0, 0, H_glIndexf);
- GL_DEFINE_PROCEDURE(glIndexi, gxg_glIndexi_w, 1, 0, 0, H_glIndexi);
- GL_DEFINE_PROCEDURE(glIndexs, gxg_glIndexs_w, 1, 0, 0, H_glIndexs);
- GL_DEFINE_PROCEDURE(glIndexub, gxg_glIndexub_w, 1, 0, 0, H_glIndexub);
- GL_DEFINE_PROCEDURE(glColor3b, gxg_glColor3b_w, 3, 0, 0, H_glColor3b);
- GL_DEFINE_PROCEDURE(glColor3d, gxg_glColor3d_w, 3, 0, 0, H_glColor3d);
- GL_DEFINE_PROCEDURE(glColor3f, gxg_glColor3f_w, 3, 0, 0, H_glColor3f);
- GL_DEFINE_PROCEDURE(glColor3i, gxg_glColor3i_w, 3, 0, 0, H_glColor3i);
- GL_DEFINE_PROCEDURE(glColor3s, gxg_glColor3s_w, 3, 0, 0, H_glColor3s);
- GL_DEFINE_PROCEDURE(glColor3ub, gxg_glColor3ub_w, 3, 0, 0, H_glColor3ub);
- GL_DEFINE_PROCEDURE(glColor3ui, gxg_glColor3ui_w, 3, 0, 0, H_glColor3ui);
- GL_DEFINE_PROCEDURE(glColor3us, gxg_glColor3us_w, 3, 0, 0, H_glColor3us);
- GL_DEFINE_PROCEDURE(glColor4b, gxg_glColor4b_w, 4, 0, 0, H_glColor4b);
- GL_DEFINE_PROCEDURE(glColor4d, gxg_glColor4d_w, 4, 0, 0, H_glColor4d);
- GL_DEFINE_PROCEDURE(glColor4f, gxg_glColor4f_w, 4, 0, 0, H_glColor4f);
- GL_DEFINE_PROCEDURE(glColor4i, gxg_glColor4i_w, 4, 0, 0, H_glColor4i);
- GL_DEFINE_PROCEDURE(glColor4s, gxg_glColor4s_w, 4, 0, 0, H_glColor4s);
- GL_DEFINE_PROCEDURE(glColor4ub, gxg_glColor4ub_w, 4, 0, 0, H_glColor4ub);
- GL_DEFINE_PROCEDURE(glColor4ui, gxg_glColor4ui_w, 4, 0, 0, H_glColor4ui);
- GL_DEFINE_PROCEDURE(glColor4us, gxg_glColor4us_w, 4, 0, 0, H_glColor4us);
- GL_DEFINE_PROCEDURE(glTexCoord1d, gxg_glTexCoord1d_w, 1, 0, 0, H_glTexCoord1d);
- GL_DEFINE_PROCEDURE(glTexCoord1f, gxg_glTexCoord1f_w, 1, 0, 0, H_glTexCoord1f);
- GL_DEFINE_PROCEDURE(glTexCoord1i, gxg_glTexCoord1i_w, 1, 0, 0, H_glTexCoord1i);
- GL_DEFINE_PROCEDURE(glTexCoord1s, gxg_glTexCoord1s_w, 1, 0, 0, H_glTexCoord1s);
- GL_DEFINE_PROCEDURE(glTexCoord2d, gxg_glTexCoord2d_w, 2, 0, 0, H_glTexCoord2d);
- GL_DEFINE_PROCEDURE(glTexCoord2f, gxg_glTexCoord2f_w, 2, 0, 0, H_glTexCoord2f);
- GL_DEFINE_PROCEDURE(glTexCoord2i, gxg_glTexCoord2i_w, 2, 0, 0, H_glTexCoord2i);
- GL_DEFINE_PROCEDURE(glTexCoord2s, gxg_glTexCoord2s_w, 2, 0, 0, H_glTexCoord2s);
- GL_DEFINE_PROCEDURE(glTexCoord3d, gxg_glTexCoord3d_w, 3, 0, 0, H_glTexCoord3d);
- GL_DEFINE_PROCEDURE(glTexCoord3f, gxg_glTexCoord3f_w, 3, 0, 0, H_glTexCoord3f);
- GL_DEFINE_PROCEDURE(glTexCoord3i, gxg_glTexCoord3i_w, 3, 0, 0, H_glTexCoord3i);
- GL_DEFINE_PROCEDURE(glTexCoord3s, gxg_glTexCoord3s_w, 3, 0, 0, H_glTexCoord3s);
- GL_DEFINE_PROCEDURE(glTexCoord4d, gxg_glTexCoord4d_w, 4, 0, 0, H_glTexCoord4d);
- GL_DEFINE_PROCEDURE(glTexCoord4f, gxg_glTexCoord4f_w, 4, 0, 0, H_glTexCoord4f);
- GL_DEFINE_PROCEDURE(glTexCoord4i, gxg_glTexCoord4i_w, 4, 0, 0, H_glTexCoord4i);
- GL_DEFINE_PROCEDURE(glTexCoord4s, gxg_glTexCoord4s_w, 4, 0, 0, H_glTexCoord4s);
- GL_DEFINE_PROCEDURE(glRasterPos2d, gxg_glRasterPos2d_w, 2, 0, 0, H_glRasterPos2d);
- GL_DEFINE_PROCEDURE(glRasterPos2f, gxg_glRasterPos2f_w, 2, 0, 0, H_glRasterPos2f);
- GL_DEFINE_PROCEDURE(glRasterPos2i, gxg_glRasterPos2i_w, 2, 0, 0, H_glRasterPos2i);
- GL_DEFINE_PROCEDURE(glRasterPos2s, gxg_glRasterPos2s_w, 2, 0, 0, H_glRasterPos2s);
- GL_DEFINE_PROCEDURE(glRasterPos3d, gxg_glRasterPos3d_w, 3, 0, 0, H_glRasterPos3d);
- GL_DEFINE_PROCEDURE(glRasterPos3f, gxg_glRasterPos3f_w, 3, 0, 0, H_glRasterPos3f);
- GL_DEFINE_PROCEDURE(glRasterPos3i, gxg_glRasterPos3i_w, 3, 0, 0, H_glRasterPos3i);
- GL_DEFINE_PROCEDURE(glRasterPos3s, gxg_glRasterPos3s_w, 3, 0, 0, H_glRasterPos3s);
- GL_DEFINE_PROCEDURE(glRasterPos4d, gxg_glRasterPos4d_w, 4, 0, 0, H_glRasterPos4d);
- GL_DEFINE_PROCEDURE(glRasterPos4f, gxg_glRasterPos4f_w, 4, 0, 0, H_glRasterPos4f);
- GL_DEFINE_PROCEDURE(glRasterPos4i, gxg_glRasterPos4i_w, 4, 0, 0, H_glRasterPos4i);
- GL_DEFINE_PROCEDURE(glRasterPos4s, gxg_glRasterPos4s_w, 4, 0, 0, H_glRasterPos4s);
- GL_DEFINE_PROCEDURE(glRectd, gxg_glRectd_w, 4, 0, 0, H_glRectd);
- GL_DEFINE_PROCEDURE(glRectf, gxg_glRectf_w, 4, 0, 0, H_glRectf);
- GL_DEFINE_PROCEDURE(glRecti, gxg_glRecti_w, 4, 0, 0, H_glRecti);
- GL_DEFINE_PROCEDURE(glRects, gxg_glRects_w, 4, 0, 0, H_glRects);
- GL_DEFINE_PROCEDURE(glVertexPointer, gxg_glVertexPointer_w, 4, 0, 0, H_glVertexPointer);
- GL_DEFINE_PROCEDURE(glNormalPointer, gxg_glNormalPointer_w, 3, 0, 0, H_glNormalPointer);
- GL_DEFINE_PROCEDURE(glColorPointer, gxg_glColorPointer_w, 4, 0, 0, H_glColorPointer);
- GL_DEFINE_PROCEDURE(glIndexPointer, gxg_glIndexPointer_w, 3, 0, 0, H_glIndexPointer);
- GL_DEFINE_PROCEDURE(glTexCoordPointer, gxg_glTexCoordPointer_w, 4, 0, 0, H_glTexCoordPointer);
- GL_DEFINE_PROCEDURE(glEdgeFlagPointer, gxg_glEdgeFlagPointer_w, 2, 0, 0, H_glEdgeFlagPointer);
- GL_DEFINE_PROCEDURE(glGetPointerv, gxg_glGetPointerv_w, 1, 1, 0, H_glGetPointerv);
- GL_DEFINE_PROCEDURE(glArrayElement, gxg_glArrayElement_w, 1, 0, 0, H_glArrayElement);
- GL_DEFINE_PROCEDURE(glDrawArrays, gxg_glDrawArrays_w, 3, 0, 0, H_glDrawArrays);
- GL_DEFINE_PROCEDURE(glDrawElements, gxg_glDrawElements_w, 4, 0, 0, H_glDrawElements);
- GL_DEFINE_PROCEDURE(glInterleavedArrays, gxg_glInterleavedArrays_w, 3, 0, 0, H_glInterleavedArrays);
- GL_DEFINE_PROCEDURE(glShadeModel, gxg_glShadeModel_w, 1, 0, 0, H_glShadeModel);
- GL_DEFINE_PROCEDURE(glLightf, gxg_glLightf_w, 3, 0, 0, H_glLightf);
- GL_DEFINE_PROCEDURE(glLighti, gxg_glLighti_w, 3, 0, 0, H_glLighti);
- GL_DEFINE_PROCEDURE(glGetLightfv, gxg_glGetLightfv_w, 2, 1, 0, H_glGetLightfv);
- GL_DEFINE_PROCEDURE(glGetLightiv, gxg_glGetLightiv_w, 2, 1, 0, H_glGetLightiv);
- GL_DEFINE_PROCEDURE(glLightModelf, gxg_glLightModelf_w, 2, 0, 0, H_glLightModelf);
- GL_DEFINE_PROCEDURE(glLightModeli, gxg_glLightModeli_w, 2, 0, 0, H_glLightModeli);
- GL_DEFINE_PROCEDURE(glMaterialf, gxg_glMaterialf_w, 3, 0, 0, H_glMaterialf);
- GL_DEFINE_PROCEDURE(glMateriali, gxg_glMateriali_w, 3, 0, 0, H_glMateriali);
- GL_DEFINE_PROCEDURE(glGetMaterialfv, gxg_glGetMaterialfv_w, 2, 1, 0, H_glGetMaterialfv);
- GL_DEFINE_PROCEDURE(glGetMaterialiv, gxg_glGetMaterialiv_w, 2, 1, 0, H_glGetMaterialiv);
- GL_DEFINE_PROCEDURE(glColorMaterial, gxg_glColorMaterial_w, 2, 0, 0, H_glColorMaterial);
- GL_DEFINE_PROCEDURE(glPixelZoom, gxg_glPixelZoom_w, 2, 0, 0, H_glPixelZoom);
- GL_DEFINE_PROCEDURE(glPixelStoref, gxg_glPixelStoref_w, 2, 0, 0, H_glPixelStoref);
- GL_DEFINE_PROCEDURE(glPixelStorei, gxg_glPixelStorei_w, 2, 0, 0, H_glPixelStorei);
- GL_DEFINE_PROCEDURE(glPixelTransferf, gxg_glPixelTransferf_w, 2, 0, 0, H_glPixelTransferf);
- GL_DEFINE_PROCEDURE(glPixelTransferi, gxg_glPixelTransferi_w, 2, 0, 0, H_glPixelTransferi);
- GL_DEFINE_PROCEDURE(glGetPixelMapfv, gxg_glGetPixelMapfv_w, 1, 1, 0, H_glGetPixelMapfv);
- GL_DEFINE_PROCEDURE(glGetPixelMapuiv, gxg_glGetPixelMapuiv_w, 1, 1, 0, H_glGetPixelMapuiv);
- GL_DEFINE_PROCEDURE(glGetPixelMapusv, gxg_glGetPixelMapusv_w, 1, 1, 0, H_glGetPixelMapusv);
- GL_DEFINE_PROCEDURE(glBitmap, gxg_glBitmap_w, 7, 0, 0, H_glBitmap);
- GL_DEFINE_PROCEDURE(glReadPixels, gxg_glReadPixels_w, 7, 0, 0, H_glReadPixels);
- GL_DEFINE_PROCEDURE(glDrawPixels, gxg_glDrawPixels_w, 5, 0, 0, H_glDrawPixels);
- GL_DEFINE_PROCEDURE(glCopyPixels, gxg_glCopyPixels_w, 5, 0, 0, H_glCopyPixels);
- GL_DEFINE_PROCEDURE(glStencilFunc, gxg_glStencilFunc_w, 3, 0, 0, H_glStencilFunc);
- GL_DEFINE_PROCEDURE(glStencilMask, gxg_glStencilMask_w, 1, 0, 0, H_glStencilMask);
- GL_DEFINE_PROCEDURE(glStencilOp, gxg_glStencilOp_w, 3, 0, 0, H_glStencilOp);
- GL_DEFINE_PROCEDURE(glClearStencil, gxg_glClearStencil_w, 1, 0, 0, H_glClearStencil);
- GL_DEFINE_PROCEDURE(glTexGend, gxg_glTexGend_w, 3, 0, 0, H_glTexGend);
- GL_DEFINE_PROCEDURE(glTexGenf, gxg_glTexGenf_w, 3, 0, 0, H_glTexGenf);
- GL_DEFINE_PROCEDURE(glTexGeni, gxg_glTexGeni_w, 3, 0, 0, H_glTexGeni);
- GL_DEFINE_PROCEDURE(glGetTexGendv, gxg_glGetTexGendv_w, 2, 1, 0, H_glGetTexGendv);
- GL_DEFINE_PROCEDURE(glGetTexGenfv, gxg_glGetTexGenfv_w, 2, 1, 0, H_glGetTexGenfv);
- GL_DEFINE_PROCEDURE(glGetTexGeniv, gxg_glGetTexGeniv_w, 2, 1, 0, H_glGetTexGeniv);
- GL_DEFINE_PROCEDURE(glTexEnvf, gxg_glTexEnvf_w, 3, 0, 0, H_glTexEnvf);
- GL_DEFINE_PROCEDURE(glTexEnvi, gxg_glTexEnvi_w, 3, 0, 0, H_glTexEnvi);
- GL_DEFINE_PROCEDURE(glGetTexEnvfv, gxg_glGetTexEnvfv_w, 2, 1, 0, H_glGetTexEnvfv);
- GL_DEFINE_PROCEDURE(glGetTexEnviv, gxg_glGetTexEnviv_w, 2, 1, 0, H_glGetTexEnviv);
- GL_DEFINE_PROCEDURE(glTexParameterf, gxg_glTexParameterf_w, 3, 0, 0, H_glTexParameterf);
- GL_DEFINE_PROCEDURE(glTexParameteri, gxg_glTexParameteri_w, 3, 0, 0, H_glTexParameteri);
- GL_DEFINE_PROCEDURE(glGetTexParameterfv, gxg_glGetTexParameterfv_w, 2, 1, 0, H_glGetTexParameterfv);
- GL_DEFINE_PROCEDURE(glGetTexParameteriv, gxg_glGetTexParameteriv_w, 2, 1, 0, H_glGetTexParameteriv);
- GL_DEFINE_PROCEDURE(glGetTexLevelParameterfv, gxg_glGetTexLevelParameterfv_w, 3, 1, 0, H_glGetTexLevelParameterfv);
- GL_DEFINE_PROCEDURE(glGetTexLevelParameteriv, gxg_glGetTexLevelParameteriv_w, 3, 1, 0, H_glGetTexLevelParameteriv);
- GL_DEFINE_PROCEDURE(glTexImage1D, gxg_glTexImage1D_w, 8, 0, 0, H_glTexImage1D);
- GL_DEFINE_PROCEDURE(glTexImage2D, gxg_glTexImage2D_w, 9, 0, 0, H_glTexImage2D);
- GL_DEFINE_PROCEDURE(glGenTextures, gxg_glGenTextures_w, 2, 0, 0, H_glGenTextures);
- GL_DEFINE_PROCEDURE(glDeleteTextures, gxg_glDeleteTextures_w, 2, 0, 0, H_glDeleteTextures);
- GL_DEFINE_PROCEDURE(glBindTexture, gxg_glBindTexture_w, 2, 0, 0, H_glBindTexture);
- GL_DEFINE_PROCEDURE(glAreTexturesResident, gxg_glAreTexturesResident_w, 3, 0, 0, H_glAreTexturesResident);
- GL_DEFINE_PROCEDURE(glIsTexture, gxg_glIsTexture_w, 1, 0, 0, H_glIsTexture);
- GL_DEFINE_PROCEDURE(glTexSubImage1D, gxg_glTexSubImage1D_w, 7, 0, 0, H_glTexSubImage1D);
- GL_DEFINE_PROCEDURE(glTexSubImage2D, gxg_glTexSubImage2D_w, 9, 0, 0, H_glTexSubImage2D);
- GL_DEFINE_PROCEDURE(glCopyTexImage1D, gxg_glCopyTexImage1D_w, 7, 0, 0, H_glCopyTexImage1D);
- GL_DEFINE_PROCEDURE(glCopyTexImage2D, gxg_glCopyTexImage2D_w, 8, 0, 0, H_glCopyTexImage2D);
- GL_DEFINE_PROCEDURE(glCopyTexSubImage1D, gxg_glCopyTexSubImage1D_w, 6, 0, 0, H_glCopyTexSubImage1D);
- GL_DEFINE_PROCEDURE(glCopyTexSubImage2D, gxg_glCopyTexSubImage2D_w, 8, 0, 0, H_glCopyTexSubImage2D);
- GL_DEFINE_PROCEDURE(glMap1d, gxg_glMap1d_w, 6, 0, 0, H_glMap1d);
- GL_DEFINE_PROCEDURE(glMap1f, gxg_glMap1f_w, 6, 0, 0, H_glMap1f);
- GL_DEFINE_PROCEDURE(glMap2d, gxg_glMap2d_w, 0, 0, 1, H_glMap2d);
- GL_DEFINE_PROCEDURE(glMap2f, gxg_glMap2f_w, 0, 0, 1, H_glMap2f);
- GL_DEFINE_PROCEDURE(glGetMapdv, gxg_glGetMapdv_w, 2, 1, 0, H_glGetMapdv);
- GL_DEFINE_PROCEDURE(glGetMapfv, gxg_glGetMapfv_w, 2, 1, 0, H_glGetMapfv);
- GL_DEFINE_PROCEDURE(glGetMapiv, gxg_glGetMapiv_w, 2, 1, 0, H_glGetMapiv);
- GL_DEFINE_PROCEDURE(glEvalCoord1d, gxg_glEvalCoord1d_w, 1, 0, 0, H_glEvalCoord1d);
- GL_DEFINE_PROCEDURE(glEvalCoord1f, gxg_glEvalCoord1f_w, 1, 0, 0, H_glEvalCoord1f);
- GL_DEFINE_PROCEDURE(glEvalCoord2d, gxg_glEvalCoord2d_w, 2, 0, 0, H_glEvalCoord2d);
- GL_DEFINE_PROCEDURE(glEvalCoord2f, gxg_glEvalCoord2f_w, 2, 0, 0, H_glEvalCoord2f);
- GL_DEFINE_PROCEDURE(glMapGrid1d, gxg_glMapGrid1d_w, 3, 0, 0, H_glMapGrid1d);
- GL_DEFINE_PROCEDURE(glMapGrid1f, gxg_glMapGrid1f_w, 3, 0, 0, H_glMapGrid1f);
- GL_DEFINE_PROCEDURE(glMapGrid2d, gxg_glMapGrid2d_w, 6, 0, 0, H_glMapGrid2d);
- GL_DEFINE_PROCEDURE(glMapGrid2f, gxg_glMapGrid2f_w, 6, 0, 0, H_glMapGrid2f);
- GL_DEFINE_PROCEDURE(glEvalPoint1, gxg_glEvalPoint1_w, 1, 0, 0, H_glEvalPoint1);
- GL_DEFINE_PROCEDURE(glEvalPoint2, gxg_glEvalPoint2_w, 2, 0, 0, H_glEvalPoint2);
- GL_DEFINE_PROCEDURE(glEvalMesh1, gxg_glEvalMesh1_w, 3, 0, 0, H_glEvalMesh1);
- GL_DEFINE_PROCEDURE(glEvalMesh2, gxg_glEvalMesh2_w, 5, 0, 0, H_glEvalMesh2);
- GL_DEFINE_PROCEDURE(glFogf, gxg_glFogf_w, 2, 0, 0, H_glFogf);
- GL_DEFINE_PROCEDURE(glFogi, gxg_glFogi_w, 2, 0, 0, H_glFogi);
- GL_DEFINE_PROCEDURE(glFeedbackBuffer, gxg_glFeedbackBuffer_w, 3, 0, 0, H_glFeedbackBuffer);
- GL_DEFINE_PROCEDURE(glPassThrough, gxg_glPassThrough_w, 1, 0, 0, H_glPassThrough);
- GL_DEFINE_PROCEDURE(glSelectBuffer, gxg_glSelectBuffer_w, 2, 0, 0, H_glSelectBuffer);
- GL_DEFINE_PROCEDURE(glInitNames, gxg_glInitNames_w, 0, 0, 0, H_glInitNames);
- GL_DEFINE_PROCEDURE(glLoadName, gxg_glLoadName_w, 1, 0, 0, H_glLoadName);
- GL_DEFINE_PROCEDURE(glPushName, gxg_glPushName_w, 1, 0, 0, H_glPushName);
- GL_DEFINE_PROCEDURE(glPopName, gxg_glPopName_w, 0, 0, 0, H_glPopName);
- GL_DEFINE_PROCEDURE(glDrawRangeElements, gxg_glDrawRangeElements_w, 6, 0, 0, H_glDrawRangeElements);
- GL_DEFINE_PROCEDURE(glTexImage3D, gxg_glTexImage3D_w, 0, 0, 1, H_glTexImage3D);
- GL_DEFINE_PROCEDURE(glTexSubImage3D, gxg_glTexSubImage3D_w, 0, 0, 1, H_glTexSubImage3D);
- GL_DEFINE_PROCEDURE(glCopyTexSubImage3D, gxg_glCopyTexSubImage3D_w, 9, 0, 0, H_glCopyTexSubImage3D);
- GL_DEFINE_PROCEDURE(glColorTable, gxg_glColorTable_w, 6, 0, 0, H_glColorTable);
- GL_DEFINE_PROCEDURE(glColorSubTable, gxg_glColorSubTable_w, 6, 0, 0, H_glColorSubTable);
- GL_DEFINE_PROCEDURE(glCopyColorSubTable, gxg_glCopyColorSubTable_w, 5, 0, 0, H_glCopyColorSubTable);
- GL_DEFINE_PROCEDURE(glCopyColorTable, gxg_glCopyColorTable_w, 5, 0, 0, H_glCopyColorTable);
- GL_DEFINE_PROCEDURE(glGetColorTableParameterfv, gxg_glGetColorTableParameterfv_w, 2, 1, 0, H_glGetColorTableParameterfv);
- GL_DEFINE_PROCEDURE(glGetColorTableParameteriv, gxg_glGetColorTableParameteriv_w, 2, 1, 0, H_glGetColorTableParameteriv);
- GL_DEFINE_PROCEDURE(glBlendEquation, gxg_glBlendEquation_w, 1, 0, 0, H_glBlendEquation);
- GL_DEFINE_PROCEDURE(glBlendColor, gxg_glBlendColor_w, 4, 0, 0, H_glBlendColor);
- GL_DEFINE_PROCEDURE(glHistogram, gxg_glHistogram_w, 4, 0, 0, H_glHistogram);
- GL_DEFINE_PROCEDURE(glResetHistogram, gxg_glResetHistogram_w, 1, 0, 0, H_glResetHistogram);
- GL_DEFINE_PROCEDURE(glGetHistogram, gxg_glGetHistogram_w, 5, 0, 0, H_glGetHistogram);
- GL_DEFINE_PROCEDURE(glGetHistogramParameterfv, gxg_glGetHistogramParameterfv_w, 2, 1, 0, H_glGetHistogramParameterfv);
- GL_DEFINE_PROCEDURE(glGetHistogramParameteriv, gxg_glGetHistogramParameteriv_w, 2, 1, 0, H_glGetHistogramParameteriv);
- GL_DEFINE_PROCEDURE(glMinmax, gxg_glMinmax_w, 3, 0, 0, H_glMinmax);
- GL_DEFINE_PROCEDURE(glResetMinmax, gxg_glResetMinmax_w, 1, 0, 0, H_glResetMinmax);
- GL_DEFINE_PROCEDURE(glGetMinmax, gxg_glGetMinmax_w, 5, 0, 0, H_glGetMinmax);
- GL_DEFINE_PROCEDURE(glGetMinmaxParameterfv, gxg_glGetMinmaxParameterfv_w, 2, 1, 0, H_glGetMinmaxParameterfv);
- GL_DEFINE_PROCEDURE(glGetMinmaxParameteriv, gxg_glGetMinmaxParameteriv_w, 2, 1, 0, H_glGetMinmaxParameteriv);
- GL_DEFINE_PROCEDURE(glConvolutionFilter1D, gxg_glConvolutionFilter1D_w, 6, 0, 0, H_glConvolutionFilter1D);
- GL_DEFINE_PROCEDURE(glConvolutionFilter2D, gxg_glConvolutionFilter2D_w, 7, 0, 0, H_glConvolutionFilter2D);
- GL_DEFINE_PROCEDURE(glConvolutionParameterf, gxg_glConvolutionParameterf_w, 3, 0, 0, H_glConvolutionParameterf);
- GL_DEFINE_PROCEDURE(glConvolutionParameteri, gxg_glConvolutionParameteri_w, 3, 0, 0, H_glConvolutionParameteri);
- GL_DEFINE_PROCEDURE(glCopyConvolutionFilter1D, gxg_glCopyConvolutionFilter1D_w, 5, 0, 0, H_glCopyConvolutionFilter1D);
- GL_DEFINE_PROCEDURE(glCopyConvolutionFilter2D, gxg_glCopyConvolutionFilter2D_w, 6, 0, 0, H_glCopyConvolutionFilter2D);
- GL_DEFINE_PROCEDURE(glSeparableFilter2D, gxg_glSeparableFilter2D_w, 8, 0, 0, H_glSeparableFilter2D);
+ gl_define_procedure(glClearIndex, gxg_glClearIndex_w, 1, 0, 0, H_glClearIndex, pl_tr);
+ gl_define_procedure(glClearColor, gxg_glClearColor_w, 4, 0, 0, H_glClearColor, pl_tr);
+ gl_define_procedure(glClear, gxg_glClear_w, 1, 0, 0, H_glClear, pl_ti);
+ gl_define_procedure(glIndexMask, gxg_glIndexMask_w, 1, 0, 0, H_glIndexMask, pl_ti);
+ gl_define_procedure(glColorMask, gxg_glColorMask_w, 4, 0, 0, H_glColorMask, pl_tb);
+ gl_define_procedure(glAlphaFunc, gxg_glAlphaFunc_w, 2, 0, 0, H_glAlphaFunc, pl_tir);
+ gl_define_procedure(glBlendFunc, gxg_glBlendFunc_w, 2, 0, 0, H_glBlendFunc, pl_ti);
+ gl_define_procedure(glLogicOp, gxg_glLogicOp_w, 1, 0, 0, H_glLogicOp, pl_ti);
+ gl_define_procedure(glCullFace, gxg_glCullFace_w, 1, 0, 0, H_glCullFace, pl_ti);
+ gl_define_procedure(glFrontFace, gxg_glFrontFace_w, 1, 0, 0, H_glFrontFace, pl_ti);
+ gl_define_procedure(glPointSize, gxg_glPointSize_w, 1, 0, 0, H_glPointSize, pl_tr);
+ gl_define_procedure(glLineWidth, gxg_glLineWidth_w, 1, 0, 0, H_glLineWidth, pl_tr);
+ gl_define_procedure(glLineStipple, gxg_glLineStipple_w, 2, 0, 0, H_glLineStipple, pl_ti);
+ gl_define_procedure(glPolygonMode, gxg_glPolygonMode_w, 2, 0, 0, H_glPolygonMode, pl_ti);
+ gl_define_procedure(glPolygonOffset, gxg_glPolygonOffset_w, 2, 0, 0, H_glPolygonOffset, pl_tr);
+ gl_define_procedure(glPolygonStipple, gxg_glPolygonStipple_w, 1, 0, 0, H_glPolygonStipple, pl_t);
+ gl_define_procedure(glEdgeFlag, gxg_glEdgeFlag_w, 1, 0, 0, H_glEdgeFlag, pl_tb);
+ gl_define_procedure(glScissor, gxg_glScissor_w, 4, 0, 0, H_glScissor, pl_ti);
+ gl_define_procedure(glClipPlane, gxg_glClipPlane_w, 2, 0, 0, H_glClipPlane, pl_tit);
+ gl_define_procedure(glGetClipPlane, gxg_glGetClipPlane_w, 1, 1, 0, H_glGetClipPlane, pl_tit);
+ gl_define_procedure(glDrawBuffer, gxg_glDrawBuffer_w, 1, 0, 0, H_glDrawBuffer, pl_ti);
+ gl_define_procedure(glReadBuffer, gxg_glReadBuffer_w, 1, 0, 0, H_glReadBuffer, pl_ti);
+ gl_define_procedure(glEnable, gxg_glEnable_w, 1, 0, 0, H_glEnable, pl_ti);
+ gl_define_procedure(glDisable, gxg_glDisable_w, 1, 0, 0, H_glDisable, pl_ti);
+ gl_define_procedure(glIsEnabled, gxg_glIsEnabled_w, 1, 0, 0, H_glIsEnabled, pl_bi);
+ gl_define_procedure(glEnableClientState, gxg_glEnableClientState_w, 1, 0, 0, H_glEnableClientState, pl_ti);
+ gl_define_procedure(glDisableClientState, gxg_glDisableClientState_w, 1, 0, 0, H_glDisableClientState, pl_ti);
+ gl_define_procedure(glGetBooleanv, gxg_glGetBooleanv_w, 1, 1, 0, H_glGetBooleanv, pl_tit);
+ gl_define_procedure(glGetDoublev, gxg_glGetDoublev_w, 1, 1, 0, H_glGetDoublev, pl_tit);
+ gl_define_procedure(glGetFloatv, gxg_glGetFloatv_w, 1, 1, 0, H_glGetFloatv, pl_tit);
+ gl_define_procedure(glGetIntegerv, gxg_glGetIntegerv_w, 1, 1, 0, H_glGetIntegerv, pl_tit);
+ gl_define_procedure(glPushAttrib, gxg_glPushAttrib_w, 1, 0, 0, H_glPushAttrib, pl_ti);
+ gl_define_procedure(glPopAttrib, gxg_glPopAttrib_w, 0, 0, 0, H_glPopAttrib, pl_t);
+ gl_define_procedure(glPushClientAttrib, gxg_glPushClientAttrib_w, 1, 0, 0, H_glPushClientAttrib, pl_ti);
+ gl_define_procedure(glPopClientAttrib, gxg_glPopClientAttrib_w, 0, 0, 0, H_glPopClientAttrib, pl_t);
+ gl_define_procedure(glRenderMode, gxg_glRenderMode_w, 1, 0, 0, H_glRenderMode, pl_i);
+ gl_define_procedure(glGetError, gxg_glGetError_w, 0, 0, 0, H_glGetError, pl_i);
+ gl_define_procedure(glGetString, gxg_glGetString_w, 1, 0, 0, H_glGetString, pl_ti);
+ gl_define_procedure(glFinish, gxg_glFinish_w, 0, 0, 0, H_glFinish, pl_t);
+ gl_define_procedure(glFlush, gxg_glFlush_w, 0, 0, 0, H_glFlush, pl_t);
+ gl_define_procedure(glHint, gxg_glHint_w, 2, 0, 0, H_glHint, pl_ti);
+ gl_define_procedure(glClearDepth, gxg_glClearDepth_w, 1, 0, 0, H_glClearDepth, pl_tr);
+ gl_define_procedure(glDepthFunc, gxg_glDepthFunc_w, 1, 0, 0, H_glDepthFunc, pl_ti);
+ gl_define_procedure(glDepthMask, gxg_glDepthMask_w, 1, 0, 0, H_glDepthMask, pl_tb);
+ gl_define_procedure(glDepthRange, gxg_glDepthRange_w, 2, 0, 0, H_glDepthRange, pl_tr);
+ gl_define_procedure(glClearAccum, gxg_glClearAccum_w, 4, 0, 0, H_glClearAccum, pl_tr);
+ gl_define_procedure(glAccum, gxg_glAccum_w, 2, 0, 0, H_glAccum, pl_tir);
+ gl_define_procedure(glMatrixMode, gxg_glMatrixMode_w, 1, 0, 0, H_glMatrixMode, pl_ti);
+ gl_define_procedure(glOrtho, gxg_glOrtho_w, 6, 0, 0, H_glOrtho, pl_tr);
+ gl_define_procedure(glFrustum, gxg_glFrustum_w, 6, 0, 0, H_glFrustum, pl_tr);
+ gl_define_procedure(glViewport, gxg_glViewport_w, 4, 0, 0, H_glViewport, pl_ti);
+ gl_define_procedure(glPushMatrix, gxg_glPushMatrix_w, 0, 0, 0, H_glPushMatrix, pl_t);
+ gl_define_procedure(glPopMatrix, gxg_glPopMatrix_w, 0, 0, 0, H_glPopMatrix, pl_t);
+ gl_define_procedure(glLoadIdentity, gxg_glLoadIdentity_w, 0, 0, 0, H_glLoadIdentity, pl_t);
+ gl_define_procedure(glLoadMatrixd, gxg_glLoadMatrixd_w, 1, 0, 0, H_glLoadMatrixd, pl_t);
+ gl_define_procedure(glLoadMatrixf, gxg_glLoadMatrixf_w, 1, 0, 0, H_glLoadMatrixf, pl_t);
+ gl_define_procedure(glMultMatrixd, gxg_glMultMatrixd_w, 1, 0, 0, H_glMultMatrixd, pl_t);
+ gl_define_procedure(glMultMatrixf, gxg_glMultMatrixf_w, 1, 0, 0, H_glMultMatrixf, pl_t);
+ gl_define_procedure(glRotated, gxg_glRotated_w, 4, 0, 0, H_glRotated, pl_tr);
+ gl_define_procedure(glRotatef, gxg_glRotatef_w, 4, 0, 0, H_glRotatef, pl_tr);
+ gl_define_procedure(glScaled, gxg_glScaled_w, 3, 0, 0, H_glScaled, pl_tr);
+ gl_define_procedure(glScalef, gxg_glScalef_w, 3, 0, 0, H_glScalef, pl_tr);
+ gl_define_procedure(glTranslated, gxg_glTranslated_w, 3, 0, 0, H_glTranslated, pl_tr);
+ gl_define_procedure(glTranslatef, gxg_glTranslatef_w, 3, 0, 0, H_glTranslatef, pl_tr);
+ gl_define_procedure(glIsList, gxg_glIsList_w, 1, 0, 0, H_glIsList, pl_bi);
+ gl_define_procedure(glDeleteLists, gxg_glDeleteLists_w, 2, 0, 0, H_glDeleteLists, pl_ti);
+ gl_define_procedure(glGenLists, gxg_glGenLists_w, 1, 0, 0, H_glGenLists, pl_i);
+ gl_define_procedure(glNewList, gxg_glNewList_w, 2, 0, 0, H_glNewList, pl_ti);
+ gl_define_procedure(glEndList, gxg_glEndList_w, 0, 0, 0, H_glEndList, pl_t);
+ gl_define_procedure(glCallList, gxg_glCallList_w, 1, 0, 0, H_glCallList, pl_ti);
+ gl_define_procedure(glCallLists, gxg_glCallLists_w, 3, 0, 0, H_glCallLists, pl_tiit);
+ gl_define_procedure(glListBase, gxg_glListBase_w, 1, 0, 0, H_glListBase, pl_ti);
+ gl_define_procedure(glBegin, gxg_glBegin_w, 1, 0, 0, H_glBegin, pl_ti);
+ gl_define_procedure(glEnd, gxg_glEnd_w, 0, 0, 0, H_glEnd, pl_t);
+ gl_define_procedure(glVertex2d, gxg_glVertex2d_w, 2, 0, 0, H_glVertex2d, pl_tr);
+ gl_define_procedure(glVertex2f, gxg_glVertex2f_w, 2, 0, 0, H_glVertex2f, pl_tr);
+ gl_define_procedure(glVertex2i, gxg_glVertex2i_w, 2, 0, 0, H_glVertex2i, pl_ti);
+ gl_define_procedure(glVertex2s, gxg_glVertex2s_w, 2, 0, 0, H_glVertex2s, pl_ti);
+ gl_define_procedure(glVertex3d, gxg_glVertex3d_w, 3, 0, 0, H_glVertex3d, pl_tr);
+ gl_define_procedure(glVertex3f, gxg_glVertex3f_w, 3, 0, 0, H_glVertex3f, pl_tr);
+ gl_define_procedure(glVertex3i, gxg_glVertex3i_w, 3, 0, 0, H_glVertex3i, pl_ti);
+ gl_define_procedure(glVertex3s, gxg_glVertex3s_w, 3, 0, 0, H_glVertex3s, pl_ti);
+ gl_define_procedure(glVertex4d, gxg_glVertex4d_w, 4, 0, 0, H_glVertex4d, pl_tr);
+ gl_define_procedure(glVertex4f, gxg_glVertex4f_w, 4, 0, 0, H_glVertex4f, pl_tr);
+ gl_define_procedure(glVertex4i, gxg_glVertex4i_w, 4, 0, 0, H_glVertex4i, pl_ti);
+ gl_define_procedure(glVertex4s, gxg_glVertex4s_w, 4, 0, 0, H_glVertex4s, pl_ti);
+ gl_define_procedure(glNormal3b, gxg_glNormal3b_w, 3, 0, 0, H_glNormal3b, pl_ti);
+ gl_define_procedure(glNormal3d, gxg_glNormal3d_w, 3, 0, 0, H_glNormal3d, pl_tr);
+ gl_define_procedure(glNormal3f, gxg_glNormal3f_w, 3, 0, 0, H_glNormal3f, pl_tr);
+ gl_define_procedure(glNormal3i, gxg_glNormal3i_w, 3, 0, 0, H_glNormal3i, pl_ti);
+ gl_define_procedure(glNormal3s, gxg_glNormal3s_w, 3, 0, 0, H_glNormal3s, pl_ti);
+ gl_define_procedure(glIndexd, gxg_glIndexd_w, 1, 0, 0, H_glIndexd, pl_tr);
+ gl_define_procedure(glIndexf, gxg_glIndexf_w, 1, 0, 0, H_glIndexf, pl_tr);
+ gl_define_procedure(glIndexi, gxg_glIndexi_w, 1, 0, 0, H_glIndexi, pl_ti);
+ gl_define_procedure(glIndexs, gxg_glIndexs_w, 1, 0, 0, H_glIndexs, pl_ti);
+ gl_define_procedure(glIndexub, gxg_glIndexub_w, 1, 0, 0, H_glIndexub, pl_ti);
+ gl_define_procedure(glColor3b, gxg_glColor3b_w, 3, 0, 0, H_glColor3b, pl_ti);
+ gl_define_procedure(glColor3d, gxg_glColor3d_w, 3, 0, 0, H_glColor3d, pl_tr);
+ gl_define_procedure(glColor3f, gxg_glColor3f_w, 3, 0, 0, H_glColor3f, pl_tr);
+ gl_define_procedure(glColor3i, gxg_glColor3i_w, 3, 0, 0, H_glColor3i, pl_ti);
+ gl_define_procedure(glColor3s, gxg_glColor3s_w, 3, 0, 0, H_glColor3s, pl_ti);
+ gl_define_procedure(glColor3ub, gxg_glColor3ub_w, 3, 0, 0, H_glColor3ub, pl_ti);
+ gl_define_procedure(glColor3ui, gxg_glColor3ui_w, 3, 0, 0, H_glColor3ui, pl_ti);
+ gl_define_procedure(glColor3us, gxg_glColor3us_w, 3, 0, 0, H_glColor3us, pl_ti);
+ gl_define_procedure(glColor4b, gxg_glColor4b_w, 4, 0, 0, H_glColor4b, pl_ti);
+ gl_define_procedure(glColor4d, gxg_glColor4d_w, 4, 0, 0, H_glColor4d, pl_tr);
+ gl_define_procedure(glColor4f, gxg_glColor4f_w, 4, 0, 0, H_glColor4f, pl_tr);
+ gl_define_procedure(glColor4i, gxg_glColor4i_w, 4, 0, 0, H_glColor4i, pl_ti);
+ gl_define_procedure(glColor4s, gxg_glColor4s_w, 4, 0, 0, H_glColor4s, pl_ti);
+ gl_define_procedure(glColor4ub, gxg_glColor4ub_w, 4, 0, 0, H_glColor4ub, pl_ti);
+ gl_define_procedure(glColor4ui, gxg_glColor4ui_w, 4, 0, 0, H_glColor4ui, pl_ti);
+ gl_define_procedure(glColor4us, gxg_glColor4us_w, 4, 0, 0, H_glColor4us, pl_ti);
+ gl_define_procedure(glTexCoord1d, gxg_glTexCoord1d_w, 1, 0, 0, H_glTexCoord1d, pl_tr);
+ gl_define_procedure(glTexCoord1f, gxg_glTexCoord1f_w, 1, 0, 0, H_glTexCoord1f, pl_tr);
+ gl_define_procedure(glTexCoord1i, gxg_glTexCoord1i_w, 1, 0, 0, H_glTexCoord1i, pl_ti);
+ gl_define_procedure(glTexCoord1s, gxg_glTexCoord1s_w, 1, 0, 0, H_glTexCoord1s, pl_ti);
+ gl_define_procedure(glTexCoord2d, gxg_glTexCoord2d_w, 2, 0, 0, H_glTexCoord2d, pl_tr);
+ gl_define_procedure(glTexCoord2f, gxg_glTexCoord2f_w, 2, 0, 0, H_glTexCoord2f, pl_tr);
+ gl_define_procedure(glTexCoord2i, gxg_glTexCoord2i_w, 2, 0, 0, H_glTexCoord2i, pl_ti);
+ gl_define_procedure(glTexCoord2s, gxg_glTexCoord2s_w, 2, 0, 0, H_glTexCoord2s, pl_ti);
+ gl_define_procedure(glTexCoord3d, gxg_glTexCoord3d_w, 3, 0, 0, H_glTexCoord3d, pl_tr);
+ gl_define_procedure(glTexCoord3f, gxg_glTexCoord3f_w, 3, 0, 0, H_glTexCoord3f, pl_tr);
+ gl_define_procedure(glTexCoord3i, gxg_glTexCoord3i_w, 3, 0, 0, H_glTexCoord3i, pl_ti);
+ gl_define_procedure(glTexCoord3s, gxg_glTexCoord3s_w, 3, 0, 0, H_glTexCoord3s, pl_ti);
+ gl_define_procedure(glTexCoord4d, gxg_glTexCoord4d_w, 4, 0, 0, H_glTexCoord4d, pl_tr);
+ gl_define_procedure(glTexCoord4f, gxg_glTexCoord4f_w, 4, 0, 0, H_glTexCoord4f, pl_tr);
+ gl_define_procedure(glTexCoord4i, gxg_glTexCoord4i_w, 4, 0, 0, H_glTexCoord4i, pl_ti);
+ gl_define_procedure(glTexCoord4s, gxg_glTexCoord4s_w, 4, 0, 0, H_glTexCoord4s, pl_ti);
+ gl_define_procedure(glRasterPos2d, gxg_glRasterPos2d_w, 2, 0, 0, H_glRasterPos2d, pl_tr);
+ gl_define_procedure(glRasterPos2f, gxg_glRasterPos2f_w, 2, 0, 0, H_glRasterPos2f, pl_tr);
+ gl_define_procedure(glRasterPos2i, gxg_glRasterPos2i_w, 2, 0, 0, H_glRasterPos2i, pl_ti);
+ gl_define_procedure(glRasterPos2s, gxg_glRasterPos2s_w, 2, 0, 0, H_glRasterPos2s, pl_ti);
+ gl_define_procedure(glRasterPos3d, gxg_glRasterPos3d_w, 3, 0, 0, H_glRasterPos3d, pl_tr);
+ gl_define_procedure(glRasterPos3f, gxg_glRasterPos3f_w, 3, 0, 0, H_glRasterPos3f, pl_tr);
+ gl_define_procedure(glRasterPos3i, gxg_glRasterPos3i_w, 3, 0, 0, H_glRasterPos3i, pl_ti);
+ gl_define_procedure(glRasterPos3s, gxg_glRasterPos3s_w, 3, 0, 0, H_glRasterPos3s, pl_ti);
+ gl_define_procedure(glRasterPos4d, gxg_glRasterPos4d_w, 4, 0, 0, H_glRasterPos4d, pl_tr);
+ gl_define_procedure(glRasterPos4f, gxg_glRasterPos4f_w, 4, 0, 0, H_glRasterPos4f, pl_tr);
+ gl_define_procedure(glRasterPos4i, gxg_glRasterPos4i_w, 4, 0, 0, H_glRasterPos4i, pl_ti);
+ gl_define_procedure(glRasterPos4s, gxg_glRasterPos4s_w, 4, 0, 0, H_glRasterPos4s, pl_ti);
+ gl_define_procedure(glRectd, gxg_glRectd_w, 4, 0, 0, H_glRectd, pl_tr);
+ gl_define_procedure(glRectf, gxg_glRectf_w, 4, 0, 0, H_glRectf, pl_tr);
+ gl_define_procedure(glRecti, gxg_glRecti_w, 4, 0, 0, H_glRecti, pl_ti);
+ gl_define_procedure(glRects, gxg_glRects_w, 4, 0, 0, H_glRects, pl_ti);
+ gl_define_procedure(glVertexPointer, gxg_glVertexPointer_w, 4, 0, 0, H_glVertexPointer, pl_tiiit);
+ gl_define_procedure(glNormalPointer, gxg_glNormalPointer_w, 3, 0, 0, H_glNormalPointer, pl_tiit);
+ gl_define_procedure(glColorPointer, gxg_glColorPointer_w, 4, 0, 0, H_glColorPointer, pl_tiiit);
+ gl_define_procedure(glIndexPointer, gxg_glIndexPointer_w, 3, 0, 0, H_glIndexPointer, pl_tiit);
+ gl_define_procedure(glTexCoordPointer, gxg_glTexCoordPointer_w, 4, 0, 0, H_glTexCoordPointer, pl_tiiit);
+ gl_define_procedure(glEdgeFlagPointer, gxg_glEdgeFlagPointer_w, 2, 0, 0, H_glEdgeFlagPointer, pl_tit);
+ gl_define_procedure(glGetPointerv, gxg_glGetPointerv_w, 1, 1, 0, H_glGetPointerv, pl_tit);
+ gl_define_procedure(glArrayElement, gxg_glArrayElement_w, 1, 0, 0, H_glArrayElement, pl_ti);
+ gl_define_procedure(glDrawArrays, gxg_glDrawArrays_w, 3, 0, 0, H_glDrawArrays, pl_ti);
+ gl_define_procedure(glDrawElements, gxg_glDrawElements_w, 4, 0, 0, H_glDrawElements, pl_tiiit);
+ gl_define_procedure(glInterleavedArrays, gxg_glInterleavedArrays_w, 3, 0, 0, H_glInterleavedArrays, pl_tiit);
+ gl_define_procedure(glShadeModel, gxg_glShadeModel_w, 1, 0, 0, H_glShadeModel, pl_ti);
+ gl_define_procedure(glLightf, gxg_glLightf_w, 3, 0, 0, H_glLightf, pl_tiir);
+ gl_define_procedure(glLighti, gxg_glLighti_w, 3, 0, 0, H_glLighti, pl_ti);
+ gl_define_procedure(glGetLightfv, gxg_glGetLightfv_w, 2, 1, 0, H_glGetLightfv, pl_tiit);
+ gl_define_procedure(glGetLightiv, gxg_glGetLightiv_w, 2, 1, 0, H_glGetLightiv, pl_tiit);
+ gl_define_procedure(glLightModelf, gxg_glLightModelf_w, 2, 0, 0, H_glLightModelf, pl_tir);
+ gl_define_procedure(glLightModeli, gxg_glLightModeli_w, 2, 0, 0, H_glLightModeli, pl_ti);
+ gl_define_procedure(glMaterialf, gxg_glMaterialf_w, 3, 0, 0, H_glMaterialf, pl_tiir);
+ gl_define_procedure(glMateriali, gxg_glMateriali_w, 3, 0, 0, H_glMateriali, pl_ti);
+ gl_define_procedure(glGetMaterialfv, gxg_glGetMaterialfv_w, 2, 1, 0, H_glGetMaterialfv, pl_tiit);
+ gl_define_procedure(glGetMaterialiv, gxg_glGetMaterialiv_w, 2, 1, 0, H_glGetMaterialiv, pl_tiit);
+ gl_define_procedure(glColorMaterial, gxg_glColorMaterial_w, 2, 0, 0, H_glColorMaterial, pl_ti);
+ gl_define_procedure(glPixelZoom, gxg_glPixelZoom_w, 2, 0, 0, H_glPixelZoom, pl_tr);
+ gl_define_procedure(glPixelStoref, gxg_glPixelStoref_w, 2, 0, 0, H_glPixelStoref, pl_tir);
+ gl_define_procedure(glPixelStorei, gxg_glPixelStorei_w, 2, 0, 0, H_glPixelStorei, pl_ti);
+ gl_define_procedure(glPixelTransferf, gxg_glPixelTransferf_w, 2, 0, 0, H_glPixelTransferf, pl_tir);
+ gl_define_procedure(glPixelTransferi, gxg_glPixelTransferi_w, 2, 0, 0, H_glPixelTransferi, pl_ti);
+ gl_define_procedure(glGetPixelMapfv, gxg_glGetPixelMapfv_w, 1, 1, 0, H_glGetPixelMapfv, pl_tit);
+ gl_define_procedure(glGetPixelMapuiv, gxg_glGetPixelMapuiv_w, 1, 1, 0, H_glGetPixelMapuiv, pl_tit);
+ gl_define_procedure(glGetPixelMapusv, gxg_glGetPixelMapusv_w, 1, 1, 0, H_glGetPixelMapusv, pl_tit);
+ gl_define_procedure(glBitmap, gxg_glBitmap_w, 7, 0, 0, H_glBitmap, pl_tiirrrrt);
+ gl_define_procedure(glReadPixels, gxg_glReadPixels_w, 7, 0, 0, H_glReadPixels, pl_tiiiiiit);
+ gl_define_procedure(glDrawPixels, gxg_glDrawPixels_w, 5, 0, 0, H_glDrawPixels, pl_tiiiit);
+ gl_define_procedure(glCopyPixels, gxg_glCopyPixels_w, 5, 0, 0, H_glCopyPixels, pl_ti);
+ gl_define_procedure(glStencilFunc, gxg_glStencilFunc_w, 3, 0, 0, H_glStencilFunc, pl_ti);
+ gl_define_procedure(glStencilMask, gxg_glStencilMask_w, 1, 0, 0, H_glStencilMask, pl_ti);
+ gl_define_procedure(glStencilOp, gxg_glStencilOp_w, 3, 0, 0, H_glStencilOp, pl_ti);
+ gl_define_procedure(glClearStencil, gxg_glClearStencil_w, 1, 0, 0, H_glClearStencil, pl_ti);
+ gl_define_procedure(glTexGend, gxg_glTexGend_w, 3, 0, 0, H_glTexGend, pl_tiir);
+ gl_define_procedure(glTexGenf, gxg_glTexGenf_w, 3, 0, 0, H_glTexGenf, pl_tiir);
+ gl_define_procedure(glTexGeni, gxg_glTexGeni_w, 3, 0, 0, H_glTexGeni, pl_ti);
+ gl_define_procedure(glGetTexGendv, gxg_glGetTexGendv_w, 2, 1, 0, H_glGetTexGendv, pl_tiit);
+ gl_define_procedure(glGetTexGenfv, gxg_glGetTexGenfv_w, 2, 1, 0, H_glGetTexGenfv, pl_tiit);
+ gl_define_procedure(glGetTexGeniv, gxg_glGetTexGeniv_w, 2, 1, 0, H_glGetTexGeniv, pl_tiit);
+ gl_define_procedure(glTexEnvf, gxg_glTexEnvf_w, 3, 0, 0, H_glTexEnvf, pl_tiir);
+ gl_define_procedure(glTexEnvi, gxg_glTexEnvi_w, 3, 0, 0, H_glTexEnvi, pl_ti);
+ gl_define_procedure(glGetTexEnvfv, gxg_glGetTexEnvfv_w, 2, 1, 0, H_glGetTexEnvfv, pl_tiit);
+ gl_define_procedure(glGetTexEnviv, gxg_glGetTexEnviv_w, 2, 1, 0, H_glGetTexEnviv, pl_tiit);
+ gl_define_procedure(glTexParameterf, gxg_glTexParameterf_w, 3, 0, 0, H_glTexParameterf, pl_tiir);
+ gl_define_procedure(glTexParameteri, gxg_glTexParameteri_w, 3, 0, 0, H_glTexParameteri, pl_ti);
+ gl_define_procedure(glGetTexParameterfv, gxg_glGetTexParameterfv_w, 2, 1, 0, H_glGetTexParameterfv, pl_tiit);
+ gl_define_procedure(glGetTexParameteriv, gxg_glGetTexParameteriv_w, 2, 1, 0, H_glGetTexParameteriv, pl_tiit);
+ gl_define_procedure(glGetTexLevelParameterfv, gxg_glGetTexLevelParameterfv_w, 3, 1, 0, H_glGetTexLevelParameterfv, pl_tiiit);
+ gl_define_procedure(glGetTexLevelParameteriv, gxg_glGetTexLevelParameteriv_w, 3, 1, 0, H_glGetTexLevelParameteriv, pl_tiiit);
+ gl_define_procedure(glTexImage1D, gxg_glTexImage1D_w, 0, 0, 1, H_glTexImage1D, pl_tiiiiiiit);
+ gl_define_procedure(glTexImage2D, gxg_glTexImage2D_w, 0, 0, 1, H_glTexImage2D, pl_tiiiiiiiit);
+ gl_define_procedure(glGenTextures, gxg_glGenTextures_w, 2, 0, 0, H_glGenTextures, pl_tit);
+ gl_define_procedure(glDeleteTextures, gxg_glDeleteTextures_w, 2, 0, 0, H_glDeleteTextures, pl_tit);
+ gl_define_procedure(glBindTexture, gxg_glBindTexture_w, 2, 0, 0, H_glBindTexture, pl_ti);
+ gl_define_procedure(glAreTexturesResident, gxg_glAreTexturesResident_w, 3, 0, 0, H_glAreTexturesResident, pl_bit);
+ gl_define_procedure(glIsTexture, gxg_glIsTexture_w, 1, 0, 0, H_glIsTexture, pl_bi);
+ gl_define_procedure(glTexSubImage1D, gxg_glTexSubImage1D_w, 7, 0, 0, H_glTexSubImage1D, pl_tiiiiiit);
+ gl_define_procedure(glTexSubImage2D, gxg_glTexSubImage2D_w, 0, 0, 1, H_glTexSubImage2D, pl_tiiiiiiiit);
+ gl_define_procedure(glCopyTexImage1D, gxg_glCopyTexImage1D_w, 7, 0, 0, H_glCopyTexImage1D, pl_ti);
+ gl_define_procedure(glCopyTexImage2D, gxg_glCopyTexImage2D_w, 0, 0, 1, H_glCopyTexImage2D, pl_ti);
+ gl_define_procedure(glCopyTexSubImage1D, gxg_glCopyTexSubImage1D_w, 6, 0, 0, H_glCopyTexSubImage1D, pl_ti);
+ gl_define_procedure(glCopyTexSubImage2D, gxg_glCopyTexSubImage2D_w, 0, 0, 1, H_glCopyTexSubImage2D, pl_ti);
+ gl_define_procedure(glMap1d, gxg_glMap1d_w, 6, 0, 0, H_glMap1d, pl_tirriit);
+ gl_define_procedure(glMap1f, gxg_glMap1f_w, 6, 0, 0, H_glMap1f, pl_tirriit);
+ gl_define_procedure(glMap2d, gxg_glMap2d_w, 0, 0, 1, H_glMap2d, pl_tirriirriit);
+ gl_define_procedure(glMap2f, gxg_glMap2f_w, 0, 0, 1, H_glMap2f, pl_tirriirriit);
+ gl_define_procedure(glGetMapdv, gxg_glGetMapdv_w, 2, 1, 0, H_glGetMapdv, pl_tiit);
+ gl_define_procedure(glGetMapfv, gxg_glGetMapfv_w, 2, 1, 0, H_glGetMapfv, pl_tiit);
+ gl_define_procedure(glGetMapiv, gxg_glGetMapiv_w, 2, 1, 0, H_glGetMapiv, pl_tiit);
+ gl_define_procedure(glEvalCoord1d, gxg_glEvalCoord1d_w, 1, 0, 0, H_glEvalCoord1d, pl_tr);
+ gl_define_procedure(glEvalCoord1f, gxg_glEvalCoord1f_w, 1, 0, 0, H_glEvalCoord1f, pl_tr);
+ gl_define_procedure(glEvalCoord2d, gxg_glEvalCoord2d_w, 2, 0, 0, H_glEvalCoord2d, pl_tr);
+ gl_define_procedure(glEvalCoord2f, gxg_glEvalCoord2f_w, 2, 0, 0, H_glEvalCoord2f, pl_tr);
+ gl_define_procedure(glMapGrid1d, gxg_glMapGrid1d_w, 3, 0, 0, H_glMapGrid1d, pl_tir);
+ gl_define_procedure(glMapGrid1f, gxg_glMapGrid1f_w, 3, 0, 0, H_glMapGrid1f, pl_tir);
+ gl_define_procedure(glMapGrid2d, gxg_glMapGrid2d_w, 6, 0, 0, H_glMapGrid2d, pl_tirrir);
+ gl_define_procedure(glMapGrid2f, gxg_glMapGrid2f_w, 6, 0, 0, H_glMapGrid2f, pl_tirrir);
+ gl_define_procedure(glEvalPoint1, gxg_glEvalPoint1_w, 1, 0, 0, H_glEvalPoint1, pl_ti);
+ gl_define_procedure(glEvalPoint2, gxg_glEvalPoint2_w, 2, 0, 0, H_glEvalPoint2, pl_ti);
+ gl_define_procedure(glEvalMesh1, gxg_glEvalMesh1_w, 3, 0, 0, H_glEvalMesh1, pl_ti);
+ gl_define_procedure(glEvalMesh2, gxg_glEvalMesh2_w, 5, 0, 0, H_glEvalMesh2, pl_ti);
+ gl_define_procedure(glFogf, gxg_glFogf_w, 2, 0, 0, H_glFogf, pl_tir);
+ gl_define_procedure(glFogi, gxg_glFogi_w, 2, 0, 0, H_glFogi, pl_ti);
+ gl_define_procedure(glFeedbackBuffer, gxg_glFeedbackBuffer_w, 3, 0, 0, H_glFeedbackBuffer, pl_tiit);
+ gl_define_procedure(glPassThrough, gxg_glPassThrough_w, 1, 0, 0, H_glPassThrough, pl_tr);
+ gl_define_procedure(glSelectBuffer, gxg_glSelectBuffer_w, 2, 0, 0, H_glSelectBuffer, pl_tit);
+ gl_define_procedure(glInitNames, gxg_glInitNames_w, 0, 0, 0, H_glInitNames, pl_t);
+ gl_define_procedure(glLoadName, gxg_glLoadName_w, 1, 0, 0, H_glLoadName, pl_ti);
+ gl_define_procedure(glPushName, gxg_glPushName_w, 1, 0, 0, H_glPushName, pl_ti);
+ gl_define_procedure(glPopName, gxg_glPopName_w, 0, 0, 0, H_glPopName, pl_t);
+ gl_define_procedure(glDrawRangeElements, gxg_glDrawRangeElements_w, 6, 0, 0, H_glDrawRangeElements, pl_tiiiiit);
+ gl_define_procedure(glTexImage3D, gxg_glTexImage3D_w, 0, 0, 1, H_glTexImage3D, pl_tiiiiiiiiit);
+ gl_define_procedure(glTexSubImage3D, gxg_glTexSubImage3D_w, 0, 0, 1, H_glTexSubImage3D, pl_tiiiiiiiiiit);
+ gl_define_procedure(glCopyTexSubImage3D, gxg_glCopyTexSubImage3D_w, 0, 0, 1, H_glCopyTexSubImage3D, pl_ti);
+ gl_define_procedure(glColorTable, gxg_glColorTable_w, 6, 0, 0, H_glColorTable, pl_tiiiiit);
+ gl_define_procedure(glColorSubTable, gxg_glColorSubTable_w, 6, 0, 0, H_glColorSubTable, pl_tiiiiit);
+ gl_define_procedure(glCopyColorSubTable, gxg_glCopyColorSubTable_w, 5, 0, 0, H_glCopyColorSubTable, pl_ti);
+ gl_define_procedure(glCopyColorTable, gxg_glCopyColorTable_w, 5, 0, 0, H_glCopyColorTable, pl_ti);
+ gl_define_procedure(glGetColorTableParameterfv, gxg_glGetColorTableParameterfv_w, 2, 1, 0, H_glGetColorTableParameterfv, pl_tiit);
+ gl_define_procedure(glGetColorTableParameteriv, gxg_glGetColorTableParameteriv_w, 2, 1, 0, H_glGetColorTableParameteriv, pl_tiit);
+ gl_define_procedure(glBlendEquation, gxg_glBlendEquation_w, 1, 0, 0, H_glBlendEquation, pl_ti);
+ gl_define_procedure(glBlendColor, gxg_glBlendColor_w, 4, 0, 0, H_glBlendColor, pl_tr);
+ gl_define_procedure(glHistogram, gxg_glHistogram_w, 4, 0, 0, H_glHistogram, pl_tiiib);
+ gl_define_procedure(glResetHistogram, gxg_glResetHistogram_w, 1, 0, 0, H_glResetHistogram, pl_ti);
+ gl_define_procedure(glGetHistogram, gxg_glGetHistogram_w, 5, 0, 0, H_glGetHistogram, pl_tibiit);
+ gl_define_procedure(glGetHistogramParameterfv, gxg_glGetHistogramParameterfv_w, 2, 1, 0, H_glGetHistogramParameterfv, pl_tiit);
+ gl_define_procedure(glGetHistogramParameteriv, gxg_glGetHistogramParameteriv_w, 2, 1, 0, H_glGetHistogramParameteriv, pl_tiit);
+ gl_define_procedure(glMinmax, gxg_glMinmax_w, 3, 0, 0, H_glMinmax, pl_tiib);
+ gl_define_procedure(glResetMinmax, gxg_glResetMinmax_w, 1, 0, 0, H_glResetMinmax, pl_ti);
+ gl_define_procedure(glGetMinmax, gxg_glGetMinmax_w, 5, 0, 0, H_glGetMinmax, pl_tibiit);
+ gl_define_procedure(glGetMinmaxParameterfv, gxg_glGetMinmaxParameterfv_w, 2, 1, 0, H_glGetMinmaxParameterfv, pl_tiit);
+ gl_define_procedure(glGetMinmaxParameteriv, gxg_glGetMinmaxParameteriv_w, 2, 1, 0, H_glGetMinmaxParameteriv, pl_tiit);
+ gl_define_procedure(glConvolutionFilter1D, gxg_glConvolutionFilter1D_w, 6, 0, 0, H_glConvolutionFilter1D, pl_tiiiiit);
+ gl_define_procedure(glConvolutionFilter2D, gxg_glConvolutionFilter2D_w, 7, 0, 0, H_glConvolutionFilter2D, pl_tiiiiiit);
+ gl_define_procedure(glConvolutionParameterf, gxg_glConvolutionParameterf_w, 3, 0, 0, H_glConvolutionParameterf, pl_tiir);
+ gl_define_procedure(glConvolutionParameteri, gxg_glConvolutionParameteri_w, 3, 0, 0, H_glConvolutionParameteri, pl_ti);
+ gl_define_procedure(glCopyConvolutionFilter1D, gxg_glCopyConvolutionFilter1D_w, 5, 0, 0, H_glCopyConvolutionFilter1D, pl_ti);
+ gl_define_procedure(glCopyConvolutionFilter2D, gxg_glCopyConvolutionFilter2D_w, 6, 0, 0, H_glCopyConvolutionFilter2D, pl_ti);
+ gl_define_procedure(glSeparableFilter2D, gxg_glSeparableFilter2D_w, 0, 0, 1, H_glSeparableFilter2D, pl_tiiiiiit);
#if HAVE_GLU
- GL_DEFINE_PROCEDURE(gluBeginCurve, gxg_gluBeginCurve_w, 1, 0, 0, H_gluBeginCurve);
+ gl_define_procedure(gluBeginCurve, gxg_gluBeginCurve_w, 1, 0, 0, H_gluBeginCurve, pl_t);
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluBeginPolygon, gxg_gluBeginPolygon_w, 1, 0, 0, H_gluBeginPolygon);
+ gl_define_procedure(gluBeginPolygon, gxg_gluBeginPolygon_w, 1, 0, 0, H_gluBeginPolygon, pl_t);
#endif
- GL_DEFINE_PROCEDURE(gluBeginSurface, gxg_gluBeginSurface_w, 1, 0, 0, H_gluBeginSurface);
- GL_DEFINE_PROCEDURE(gluBeginTrim, gxg_gluBeginTrim_w, 1, 0, 0, H_gluBeginTrim);
- GL_DEFINE_PROCEDURE(gluBuild1DMipmapLevels, gxg_gluBuild1DMipmapLevels_w, 9, 0, 0, H_gluBuild1DMipmapLevels);
- GL_DEFINE_PROCEDURE(gluBuild1DMipmaps, gxg_gluBuild1DMipmaps_w, 6, 0, 0, H_gluBuild1DMipmaps);
- GL_DEFINE_PROCEDURE(gluBuild2DMipmapLevels, gxg_gluBuild2DMipmapLevels_w, 0, 0, 1, H_gluBuild2DMipmapLevels);
- GL_DEFINE_PROCEDURE(gluBuild2DMipmaps, gxg_gluBuild2DMipmaps_w, 7, 0, 0, H_gluBuild2DMipmaps);
- GL_DEFINE_PROCEDURE(gluBuild3DMipmapLevels, gxg_gluBuild3DMipmapLevels_w, 0, 0, 1, H_gluBuild3DMipmapLevels);
- GL_DEFINE_PROCEDURE(gluBuild3DMipmaps, gxg_gluBuild3DMipmaps_w, 8, 0, 0, H_gluBuild3DMipmaps);
- GL_DEFINE_PROCEDURE(gluCheckExtension, gxg_gluCheckExtension_w, 2, 0, 0, H_gluCheckExtension);
- GL_DEFINE_PROCEDURE(gluCylinder, gxg_gluCylinder_w, 6, 0, 0, H_gluCylinder);
- GL_DEFINE_PROCEDURE(gluDeleteNurbsRenderer, gxg_gluDeleteNurbsRenderer_w, 1, 0, 0, H_gluDeleteNurbsRenderer);
- GL_DEFINE_PROCEDURE(gluDeleteQuadric, gxg_gluDeleteQuadric_w, 1, 0, 0, H_gluDeleteQuadric);
+ gl_define_procedure(gluBeginSurface, gxg_gluBeginSurface_w, 1, 0, 0, H_gluBeginSurface, pl_t);
+ gl_define_procedure(gluBeginTrim, gxg_gluBeginTrim_w, 1, 0, 0, H_gluBeginTrim, pl_t);
+ gl_define_procedure(gluBuild1DMipmapLevels, gxg_gluBuild1DMipmapLevels_w, 0, 0, 1, H_gluBuild1DMipmapLevels, pl_iiiiiiiiit);
+ gl_define_procedure(gluBuild1DMipmaps, gxg_gluBuild1DMipmaps_w, 6, 0, 0, H_gluBuild1DMipmaps, pl_iiiiiit);
+ gl_define_procedure(gluBuild2DMipmapLevels, gxg_gluBuild2DMipmapLevels_w, 0, 0, 1, H_gluBuild2DMipmapLevels, pl_iiiiiiiiiit);
+ gl_define_procedure(gluBuild2DMipmaps, gxg_gluBuild2DMipmaps_w, 7, 0, 0, H_gluBuild2DMipmaps, pl_iiiiiiit);
+ gl_define_procedure(gluBuild3DMipmapLevels, gxg_gluBuild3DMipmapLevels_w, 0, 0, 1, H_gluBuild3DMipmapLevels, pl_iiiiiiiiiiit);
+ gl_define_procedure(gluBuild3DMipmaps, gxg_gluBuild3DMipmaps_w, 0, 0, 1, H_gluBuild3DMipmaps, pl_iiiiiiiit);
+ gl_define_procedure(gluCheckExtension, gxg_gluCheckExtension_w, 2, 0, 0, H_gluCheckExtension, pl_bt);
+ gl_define_procedure(gluCylinder, gxg_gluCylinder_w, 6, 0, 0, H_gluCylinder, pl_ttrrri);
+ gl_define_procedure(gluDeleteNurbsRenderer, gxg_gluDeleteNurbsRenderer_w, 1, 0, 0, H_gluDeleteNurbsRenderer, pl_t);
+ gl_define_procedure(gluDeleteQuadric, gxg_gluDeleteQuadric_w, 1, 0, 0, H_gluDeleteQuadric, pl_t);
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluDeleteTess, gxg_gluDeleteTess_w, 1, 0, 0, H_gluDeleteTess);
+ gl_define_procedure(gluDeleteTess, gxg_gluDeleteTess_w, 1, 0, 0, H_gluDeleteTess, pl_t);
#endif
- GL_DEFINE_PROCEDURE(gluDisk, gxg_gluDisk_w, 5, 0, 0, H_gluDisk);
- GL_DEFINE_PROCEDURE(gluEndCurve, gxg_gluEndCurve_w, 1, 0, 0, H_gluEndCurve);
+ gl_define_procedure(gluDisk, gxg_gluDisk_w, 5, 0, 0, H_gluDisk, pl_ttrri);
+ gl_define_procedure(gluEndCurve, gxg_gluEndCurve_w, 1, 0, 0, H_gluEndCurve, pl_t);
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluEndPolygon, gxg_gluEndPolygon_w, 1, 0, 0, H_gluEndPolygon);
+ gl_define_procedure(gluEndPolygon, gxg_gluEndPolygon_w, 1, 0, 0, H_gluEndPolygon, pl_t);
#endif
- GL_DEFINE_PROCEDURE(gluEndSurface, gxg_gluEndSurface_w, 1, 0, 0, H_gluEndSurface);
- GL_DEFINE_PROCEDURE(gluEndTrim, gxg_gluEndTrim_w, 1, 0, 0, H_gluEndTrim);
- GL_DEFINE_PROCEDURE(gluErrorString, gxg_gluErrorString_w, 1, 0, 0, H_gluErrorString);
- GL_DEFINE_PROCEDURE(gluGetNurbsProperty, gxg_gluGetNurbsProperty_w, 3, 0, 0, H_gluGetNurbsProperty);
- GL_DEFINE_PROCEDURE(gluGetString, gxg_gluGetString_w, 1, 0, 0, H_gluGetString);
+ gl_define_procedure(gluEndSurface, gxg_gluEndSurface_w, 1, 0, 0, H_gluEndSurface, pl_t);
+ gl_define_procedure(gluEndTrim, gxg_gluEndTrim_w, 1, 0, 0, H_gluEndTrim, pl_t);
+ gl_define_procedure(gluErrorString, gxg_gluErrorString_w, 1, 0, 0, H_gluErrorString, pl_ti);
+ gl_define_procedure(gluGetNurbsProperty, gxg_gluGetNurbsProperty_w, 3, 0, 0, H_gluGetNurbsProperty, pl_ttit);
+ gl_define_procedure(gluGetString, gxg_gluGetString_w, 1, 0, 0, H_gluGetString, pl_ti);
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluGetTessProperty, gxg_gluGetTessProperty_w, 3, 0, 0, H_gluGetTessProperty);
+ gl_define_procedure(gluGetTessProperty, gxg_gluGetTessProperty_w, 3, 0, 0, H_gluGetTessProperty, pl_ttit);
#endif
- GL_DEFINE_PROCEDURE(gluLoadSamplingMatrices, gxg_gluLoadSamplingMatrices_w, 4, 0, 0, H_gluLoadSamplingMatrices);
- GL_DEFINE_PROCEDURE(gluLookAt, gxg_gluLookAt_w, 9, 0, 0, H_gluLookAt);
- GL_DEFINE_PROCEDURE(gluNewNurbsRenderer, gxg_gluNewNurbsRenderer_w, 0, 0, 0, H_gluNewNurbsRenderer);
- GL_DEFINE_PROCEDURE(gluNewQuadric, gxg_gluNewQuadric_w, 0, 0, 0, H_gluNewQuadric);
+ gl_define_procedure(gluLoadSamplingMatrices, gxg_gluLoadSamplingMatrices_w, 4, 0, 0, H_gluLoadSamplingMatrices, pl_t);
+ gl_define_procedure(gluLookAt, gxg_gluLookAt_w, 0, 0, 1, H_gluLookAt, pl_tr);
+ gl_define_procedure(gluNewNurbsRenderer, gxg_gluNewNurbsRenderer_w, 0, 0, 0, H_gluNewNurbsRenderer, pl_t);
+ gl_define_procedure(gluNewQuadric, gxg_gluNewQuadric_w, 0, 0, 0, H_gluNewQuadric, pl_t);
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluNewTess, gxg_gluNewTess_w, 0, 0, 0, H_gluNewTess);
+ gl_define_procedure(gluNewTess, gxg_gluNewTess_w, 0, 0, 0, H_gluNewTess, pl_t);
#endif
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluNextContour, gxg_gluNextContour_w, 2, 0, 0, H_gluNextContour);
+ gl_define_procedure(gluNextContour, gxg_gluNextContour_w, 2, 0, 0, H_gluNextContour, pl_tti);
#endif
- GL_DEFINE_PROCEDURE(gluNurbsCallback, gxg_gluNurbsCallback_w, 3, 0, 0, H_gluNurbsCallback);
- GL_DEFINE_PROCEDURE(gluNurbsCallbackData, gxg_gluNurbsCallbackData_w, 2, 0, 0, H_gluNurbsCallbackData);
- GL_DEFINE_PROCEDURE(gluNurbsCallbackDataEXT, gxg_gluNurbsCallbackDataEXT_w, 2, 0, 0, H_gluNurbsCallbackDataEXT);
- GL_DEFINE_PROCEDURE(gluNurbsCurve, gxg_gluNurbsCurve_w, 7, 0, 0, H_gluNurbsCurve);
- GL_DEFINE_PROCEDURE(gluNurbsProperty, gxg_gluNurbsProperty_w, 3, 0, 0, H_gluNurbsProperty);
- GL_DEFINE_PROCEDURE(gluNurbsSurface, gxg_gluNurbsSurface_w, 0, 0, 1, H_gluNurbsSurface);
- GL_DEFINE_PROCEDURE(gluOrtho2D, gxg_gluOrtho2D_w, 4, 0, 0, H_gluOrtho2D);
- GL_DEFINE_PROCEDURE(gluPartialDisk, gxg_gluPartialDisk_w, 7, 0, 0, H_gluPartialDisk);
- GL_DEFINE_PROCEDURE(gluPerspective, gxg_gluPerspective_w, 4, 0, 0, H_gluPerspective);
- GL_DEFINE_PROCEDURE(gluPickMatrix, gxg_gluPickMatrix_w, 5, 0, 0, H_gluPickMatrix);
- GL_DEFINE_PROCEDURE(gluProject, gxg_gluProject_w, 6, 3, 0, H_gluProject);
- GL_DEFINE_PROCEDURE(gluPwlCurve, gxg_gluPwlCurve_w, 5, 0, 0, H_gluPwlCurve);
- GL_DEFINE_PROCEDURE(gluQuadricCallback, gxg_gluQuadricCallback_w, 3, 0, 0, H_gluQuadricCallback);
- GL_DEFINE_PROCEDURE(gluQuadricDrawStyle, gxg_gluQuadricDrawStyle_w, 2, 0, 0, H_gluQuadricDrawStyle);
- GL_DEFINE_PROCEDURE(gluQuadricNormals, gxg_gluQuadricNormals_w, 2, 0, 0, H_gluQuadricNormals);
- GL_DEFINE_PROCEDURE(gluQuadricOrientation, gxg_gluQuadricOrientation_w, 2, 0, 0, H_gluQuadricOrientation);
- GL_DEFINE_PROCEDURE(gluQuadricTexture, gxg_gluQuadricTexture_w, 2, 0, 0, H_gluQuadricTexture);
- GL_DEFINE_PROCEDURE(gluScaleImage, gxg_gluScaleImage_w, 9, 0, 0, H_gluScaleImage);
- GL_DEFINE_PROCEDURE(gluSphere, gxg_gluSphere_w, 4, 0, 0, H_gluSphere);
+ gl_define_procedure(gluNurbsCallback, gxg_gluNurbsCallback_w, 3, 0, 0, H_gluNurbsCallback, pl_ttit);
+ gl_define_procedure(gluNurbsCallbackData, gxg_gluNurbsCallbackData_w, 2, 0, 0, H_gluNurbsCallbackData, pl_t);
+ gl_define_procedure(gluNurbsCurve, gxg_gluNurbsCurve_w, 7, 0, 0, H_gluNurbsCurve, pl_ttititi);
+ gl_define_procedure(gluNurbsProperty, gxg_gluNurbsProperty_w, 3, 0, 0, H_gluNurbsProperty, pl_ttir);
+ gl_define_procedure(gluNurbsSurface, gxg_gluNurbsSurface_w, 0, 0, 1, H_gluNurbsSurface, pl_ttititiiti);
+ gl_define_procedure(gluOrtho2D, gxg_gluOrtho2D_w, 4, 0, 0, H_gluOrtho2D, pl_tr);
+ gl_define_procedure(gluPartialDisk, gxg_gluPartialDisk_w, 7, 0, 0, H_gluPartialDisk, pl_ttrriir);
+ gl_define_procedure(gluPerspective, gxg_gluPerspective_w, 4, 0, 0, H_gluPerspective, pl_tr);
+ gl_define_procedure(gluPickMatrix, gxg_gluPickMatrix_w, 5, 0, 0, H_gluPickMatrix, pl_trrrrt);
+ gl_define_procedure(gluProject, gxg_gluProject_w, 0, 0, 1, H_gluProject, pl_irrrt);
+ gl_define_procedure(gluPwlCurve, gxg_gluPwlCurve_w, 5, 0, 0, H_gluPwlCurve, pl_ttiti);
+ gl_define_procedure(gluQuadricCallback, gxg_gluQuadricCallback_w, 3, 0, 0, H_gluQuadricCallback, pl_ttit);
+ gl_define_procedure(gluQuadricDrawStyle, gxg_gluQuadricDrawStyle_w, 2, 0, 0, H_gluQuadricDrawStyle, pl_tti);
+ gl_define_procedure(gluQuadricNormals, gxg_gluQuadricNormals_w, 2, 0, 0, H_gluQuadricNormals, pl_tti);
+ gl_define_procedure(gluQuadricOrientation, gxg_gluQuadricOrientation_w, 2, 0, 0, H_gluQuadricOrientation, pl_tti);
+ gl_define_procedure(gluQuadricTexture, gxg_gluQuadricTexture_w, 2, 0, 0, H_gluQuadricTexture, pl_ttb);
+ gl_define_procedure(gluScaleImage, gxg_gluScaleImage_w, 0, 0, 1, H_gluScaleImage, pl_iiiiitiiit);
+ gl_define_procedure(gluSphere, gxg_gluSphere_w, 4, 0, 0, H_gluSphere, pl_ttri);
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluTessBeginContour, gxg_gluTessBeginContour_w, 1, 0, 0, H_gluTessBeginContour);
+ gl_define_procedure(gluTessBeginContour, gxg_gluTessBeginContour_w, 1, 0, 0, H_gluTessBeginContour, pl_t);
#endif
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluTessBeginPolygon, gxg_gluTessBeginPolygon_w, 2, 0, 0, H_gluTessBeginPolygon);
+ gl_define_procedure(gluTessBeginPolygon, gxg_gluTessBeginPolygon_w, 2, 0, 0, H_gluTessBeginPolygon, pl_t);
#endif
- GL_DEFINE_PROCEDURE(gluTessCallback, gxg_gluTessCallback_w, 3, 0, 0, H_gluTessCallback);
+ gl_define_procedure(gluTessCallback, gxg_gluTessCallback_w, 3, 0, 0, H_gluTessCallback, pl_ttit);
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluTessEndContour, gxg_gluTessEndContour_w, 1, 0, 0, H_gluTessEndContour);
+ gl_define_procedure(gluTessEndContour, gxg_gluTessEndContour_w, 1, 0, 0, H_gluTessEndContour, pl_t);
#endif
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluTessEndPolygon, gxg_gluTessEndPolygon_w, 1, 0, 0, H_gluTessEndPolygon);
+ gl_define_procedure(gluTessEndPolygon, gxg_gluTessEndPolygon_w, 1, 0, 0, H_gluTessEndPolygon, pl_t);
#endif
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluTessNormal, gxg_gluTessNormal_w, 4, 0, 0, H_gluTessNormal);
+ gl_define_procedure(gluTessNormal, gxg_gluTessNormal_w, 4, 0, 0, H_gluTessNormal, pl_ttr);
#endif
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluTessProperty, gxg_gluTessProperty_w, 3, 0, 0, H_gluTessProperty);
+ gl_define_procedure(gluTessProperty, gxg_gluTessProperty_w, 3, 0, 0, H_gluTessProperty, pl_ttir);
#endif
#ifdef GLU_VERSION_1_2
- GL_DEFINE_PROCEDURE(gluTessVertex, gxg_gluTessVertex_w, 3, 0, 0, H_gluTessVertex);
+ gl_define_procedure(gluTessVertex, gxg_gluTessVertex_w, 3, 0, 0, H_gluTessVertex, pl_t);
#endif
- GL_DEFINE_PROCEDURE(gluUnProject, gxg_gluUnProject_w, 6, 3, 0, H_gluUnProject);
- GL_DEFINE_PROCEDURE(gluUnProject4, gxg_gluUnProject4_w, 0, 0, 1, H_gluUnProject4);
+ gl_define_procedure(gluUnProject, gxg_gluUnProject_w, 0, 0, 1, H_gluUnProject, pl_irrrt);
+ gl_define_procedure(gluUnProject4, gxg_gluUnProject4_w, 0, 0, 1, H_gluUnProject4, pl_irrrrtttrrt);
#endif
}
@@ -5104,11 +4906,7 @@ static void define_functions(void)
static void define_integers(void)
{
-#if HAVE_SCHEME
-#define DEFINE_INTEGER(Name) s7_define_constant(s7, XL_PRE #Name XL_POST, C_TO_XEN_INT(Name))
-#else
-#define DEFINE_INTEGER(Name) XEN_DEFINE(XL_PRE #Name XL_POST, C_TO_XEN_INT(Name))
-#endif
+#define DEFINE_INTEGER(Name) Xen_define(XL_PRE #Name XL_POST, C_int_to_Xen_integer(Name))
#if USE_MOTIF
DEFINE_INTEGER(GLX_USE_GL);
@@ -5790,29 +5588,17 @@ static void define_integers(void)
DEFINE_INTEGER(GLU_NURBS_ERROR);
DEFINE_INTEGER(GLU_ERROR);
DEFINE_INTEGER(GLU_NURBS_BEGIN);
- DEFINE_INTEGER(GLU_NURBS_BEGIN_EXT);
DEFINE_INTEGER(GLU_NURBS_VERTEX);
- DEFINE_INTEGER(GLU_NURBS_VERTEX_EXT);
DEFINE_INTEGER(GLU_NURBS_NORMAL);
- DEFINE_INTEGER(GLU_NURBS_NORMAL_EXT);
DEFINE_INTEGER(GLU_NURBS_COLOR);
- DEFINE_INTEGER(GLU_NURBS_COLOR_EXT);
DEFINE_INTEGER(GLU_NURBS_TEXTURE_COORD);
- DEFINE_INTEGER(GLU_NURBS_TEX_COORD_EXT);
DEFINE_INTEGER(GLU_NURBS_END);
- DEFINE_INTEGER(GLU_NURBS_END_EXT);
DEFINE_INTEGER(GLU_NURBS_BEGIN_DATA);
- DEFINE_INTEGER(GLU_NURBS_BEGIN_DATA_EXT);
DEFINE_INTEGER(GLU_NURBS_VERTEX_DATA);
- DEFINE_INTEGER(GLU_NURBS_VERTEX_DATA_EXT);
DEFINE_INTEGER(GLU_NURBS_NORMAL_DATA);
- DEFINE_INTEGER(GLU_NURBS_NORMAL_DATA_EXT);
DEFINE_INTEGER(GLU_NURBS_COLOR_DATA);
- DEFINE_INTEGER(GLU_NURBS_COLOR_DATA_EXT);
DEFINE_INTEGER(GLU_NURBS_TEXTURE_COORD_DATA);
- DEFINE_INTEGER(GLU_NURBS_TEX_COORD_DATA_EXT);
DEFINE_INTEGER(GLU_NURBS_END_DATA);
- DEFINE_INTEGER(GLU_NURBS_END_DATA_EXT);
DEFINE_INTEGER(GLU_NURBS_ERROR1);
DEFINE_INTEGER(GLU_NURBS_ERROR2);
DEFINE_INTEGER(GLU_NURBS_ERROR3);
@@ -5859,15 +5645,10 @@ static void define_integers(void)
DEFINE_INTEGER(GLU_U_STEP);
DEFINE_INTEGER(GLU_V_STEP);
DEFINE_INTEGER(GLU_NURBS_MODE);
- DEFINE_INTEGER(GLU_NURBS_MODE_EXT);
DEFINE_INTEGER(GLU_NURBS_TESSELLATOR);
- DEFINE_INTEGER(GLU_NURBS_TESSELLATOR_EXT);
DEFINE_INTEGER(GLU_NURBS_RENDERER);
- DEFINE_INTEGER(GLU_NURBS_RENDERER_EXT);
DEFINE_INTEGER(GLU_OBJECT_PARAMETRIC_ERROR);
- DEFINE_INTEGER(GLU_OBJECT_PARAMETRIC_ERROR_EXT);
DEFINE_INTEGER(GLU_OBJECT_PATH_LENGTH);
- DEFINE_INTEGER(GLU_OBJECT_PATH_LENGTH_EXT);
DEFINE_INTEGER(GLU_PATH_LENGTH);
DEFINE_INTEGER(GLU_PARAMETRIC_ERROR);
DEFINE_INTEGER(GLU_DOMAIN_DISTANCE);
@@ -5939,8 +5720,8 @@ void Init_libgl(void)
{
define_integers();
define_functions();
- XEN_YES_WE_HAVE("gl");
- XEN_DEFINE("gl-version", C_TO_XEN_STRING("06-Feb-10"));
+ Xen_provide_feature("gl");
+ Xen_define("gl-version", C_string_to_Xen_string("26-Nov-15"));
gl_already_inited = true;
}
}
diff --git a/gl2ps.c b/gl2ps.c
index 58ce349..0a22cf5 100644
--- a/gl2ps.c
+++ b/gl2ps.c
@@ -1,7 +1,6 @@
-/* $Id: gl2ps.c,v 1.239 2006/08/11 13:25:34 geuzaine Exp $ */
/*
* GL2PS, an OpenGL to PostScript Printing Library
- * Copyright (C) 1999-2006 Christophe Geuzaine <geuz at geuz.org>
+ * Copyright (C) 1999-2012 C. Geuzaine
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of either:
@@ -21,36 +20,16 @@
*
* You should have received a copy of the GNU Library General Public
* License along with this library in the file named "COPYING.LGPL";
- * if not, write to the Free Software Foundation, Inc., 675 Mass Ave,
- * Cambridge, MA 02139, USA.
+ * if not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* You should have received a copy of the GL2PS License with this
* library in the file named "COPYING.GL2PS"; if not, I will be glad
* to provide one.
*
- * Contributors:
- * Michael Sweet <mike at easysw.com>
- * Marc Ume <marc.ume at digitalgraphics.be>
- * Jean-Francois Remacle <remacle at gce.ucl.ac.be>
- * Bart Kaptein <B.L.Kaptein at lumc.nl>
- * Quy Nguyen-Dai <quy at nguyendai.org>
- * Sam Buss <sbuss at ucsd.edu>
- * Shane Hill <Shane.Hill at dsto.defence.gov.au>
- * Romain Boman <r_boman at yahoo.fr>
- * Rouben Rostamian <rostamian at umbc.edu>
- * Diego Santa Cruz <Diego.SantaCruz at epfl.ch>
- * Shahzad Muzaffar <Shahzad.Muzaffar at cern.ch>
- * Lassi Tuura <lassi.tuura at cern.ch>
- * Guy Barrand <barrand at lal.in2p3.fr>
- * Prabhu Ramachandran <prabhu at aero.iitm.ernet.in>
- * Micha Bieber <bieber at traits.de>
- * Olivier Couet <couet at mail.cern.ch>
- * Shai Ayal <shaiay at gmail.com>
- * Fabian Wenzel <wenzel at tu-harburg.de>
- * Ian D. Gay <gay at sfu.ca>
- * Cosmin Truta and Baiju Devani <cosmin at cs.toronto.edu>
+ * For the latest info about gl2ps and a full list of contributors,
+ * see http://www.geuz.org/gl2ps/.
*
- * For the latest info about gl2ps, see http://www.geuz.org/gl2ps/.
* Please report all bugs and problems to <gl2ps at geuz.org>.
*/
@@ -71,7 +50,7 @@
#include <png.h>
#endif
-/*********************************************************************
+/*********************************************************************
*
* Private definitions, data structures and prototypes
*
@@ -188,6 +167,7 @@ typedef struct {
written to the file or not, and 'format' indicates if it is
visible or not */
GLenum format, type;
+ GLfloat zoom_x, zoom_y;
GLfloat *pixels;
} GL2PSimage;
@@ -248,7 +228,7 @@ typedef struct {
GLboolean zerosurfacearea;
GL2PSbsptree2d *imagetree;
GL2PSprimitive *primitivetoadd;
-
+
/* PDF-specific */
int streamlength;
GL2PSlist *pdfprimlist, *pdfgrouplist;
@@ -286,7 +266,7 @@ static GL2PScontext *gl2ps = NULL;
static GLint gl2psPrintPrimitives(void);
-/*********************************************************************
+/*********************************************************************
*
* Utility routines
*
@@ -303,7 +283,7 @@ static void gl2psMsg(GLint level, const char *fmt, ...)
case GL2PS_ERROR : fprintf(stderr, "GL2PS error: "); break;
}
va_start(args, fmt);
- vfprintf(stderr, fmt, args);
+ vfprintf(stderr, fmt, args);
va_end(args);
fprintf(stderr, "\n");
}
@@ -314,24 +294,26 @@ static void *gl2psMalloc(size_t size)
{
void *ptr;
- if(!size) return(NULL);
+ if(!size) return NULL;
ptr = malloc(size);
if(!ptr){
gl2psMsg(GL2PS_ERROR, "Couldn't allocate requested memory");
- exit(1);
+ return NULL;
}
- return(ptr);
+ return ptr;
}
static void *gl2psRealloc(void *ptr, size_t size)
{
- if(!size) return(NULL);
- ptr = realloc(ptr, size);
+ void *orig = ptr;
+ if(!size) return NULL;
+ ptr = realloc(orig, size);
if(!ptr){
gl2psMsg(GL2PS_ERROR, "Couldn't reallocate requested memory");
- exit(1);
+ free(orig);
+ return NULL;
}
- return(ptr);
+ return ptr;
}
static void gl2psFree(void *ptr)
@@ -340,12 +322,12 @@ static void gl2psFree(void *ptr)
free(ptr);
}
-static size_t gl2psWriteBigEndian(unsigned long data, size_t bytes)
+static int gl2psWriteBigEndian(unsigned long data, int bytes)
{
- size_t i;
- size_t size = sizeof(unsigned long);
+ int i;
+ int size = sizeof(unsigned long);
for(i = 1; i <= bytes; ++i){
- fputc(0xff & (data >> (size-i) * 8), gl2ps->stream);
+ fputc(0xff & (data >> (size - i) * 8), gl2ps->stream);
}
return bytes;
}
@@ -380,16 +362,16 @@ static void gl2psFreeCompress(void)
static int gl2psAllocCompress(unsigned int srcsize)
{
gl2psFreeCompress();
-
+
if(!gl2ps->compress || !srcsize)
return GL2PS_ERROR;
-
+
gl2ps->compress->srcLen = srcsize;
gl2ps->compress->destLen = (int)ceil(1.001 * gl2ps->compress->srcLen + 12);
gl2ps->compress->src = (Bytef*)gl2psMalloc(gl2ps->compress->srcLen);
gl2ps->compress->start = gl2ps->compress->src;
gl2ps->compress->dest = (Bytef*)gl2psMalloc(gl2ps->compress->destLen);
-
+
return GL2PS_SUCCESS;
}
@@ -397,25 +379,25 @@ static void *gl2psReallocCompress(unsigned int srcsize)
{
if(!gl2ps->compress || !srcsize)
return NULL;
-
+
if(srcsize < gl2ps->compress->srcLen)
return gl2ps->compress->start;
-
+
gl2ps->compress->srcLen = srcsize;
gl2ps->compress->destLen = (int)ceil(1.001 * gl2ps->compress->srcLen + 12);
- gl2ps->compress->src = (Bytef*)gl2psRealloc(gl2ps->compress->src,
+ gl2ps->compress->src = (Bytef*)gl2psRealloc(gl2ps->compress->src,
gl2ps->compress->srcLen);
gl2ps->compress->start = gl2ps->compress->src;
- gl2ps->compress->dest = (Bytef*)gl2psRealloc(gl2ps->compress->dest,
+ gl2ps->compress->dest = (Bytef*)gl2psRealloc(gl2ps->compress->dest,
gl2ps->compress->destLen);
-
+
return gl2ps->compress->start;
}
-static size_t gl2psWriteBigEndianCompress(unsigned long data, size_t bytes)
+static int gl2psWriteBigEndianCompress(unsigned long data, int bytes)
{
- size_t i;
- size_t size = sizeof(unsigned long);
+ int i;
+ int size = sizeof(unsigned long);
for(i = 1; i <= bytes; ++i){
*gl2ps->compress->src = (Bytef)(0xff & (data >> (size-i) * 8));
++gl2ps->compress->src;
@@ -427,8 +409,8 @@ static int gl2psDeflate(void)
{
/* For compatibility with older zlib versions, we use compress(...)
instead of compress2(..., Z_BEST_COMPRESSION) */
- return compress(gl2ps->compress->dest, &gl2ps->compress->destLen,
- gl2ps->compress->start, gl2ps->compress->srcLen);
+ return compress(gl2ps->compress->dest, &gl2ps->compress->destLen,
+ gl2ps->compress->start, gl2ps->compress->srcLen);
}
#endif
@@ -439,15 +421,39 @@ static int gl2psPrintf(const char* fmt, ...)
va_list args;
#if defined(GL2PS_HAVE_ZLIB)
+ static char buf[1024];
+ char *bufptr = buf;
+ GLboolean freebuf = GL_FALSE;
unsigned int oldsize = 0;
- static char buf[1000];
+#if !defined(GL2PS_HAVE_NO_VSNPRINTF)
+ /* Try writing the string to a 1024 byte buffer. If it is too small to fit,
+ keep trying larger sizes until it does. */
+ size_t bufsize = sizeof(buf);
+#endif
if(gl2ps->options & GL2PS_COMPRESS){
va_start(args, fmt);
+#if defined(GL2PS_HAVE_NO_VSNPRINTF)
ret = vsprintf(buf, fmt, args);
+#else
+ ret = vsnprintf(bufptr, bufsize, fmt, args);
+#endif
va_end(args);
+#if !defined(GL2PS_HAVE_NO_VSNPRINTF)
+ while(ret >= (bufsize - 1) || ret < 0){
+ /* Too big. Allocate a new buffer. */
+ bufsize *= 2;
+ if(freebuf == GL_TRUE) gl2psFree(bufptr);
+ bufptr = (char *)gl2psMalloc(bufsize);
+ freebuf = GL_TRUE;
+ va_start(args, fmt);
+ ret = vsnprintf(bufptr, bufsize, fmt, args);
+ va_end(args);
+ }
+#endif
oldsize = gl2ps->compress->srcLen;
gl2ps->compress->start = (Bytef*)gl2psReallocCompress(oldsize + ret);
- memcpy(gl2ps->compress->start+oldsize, buf, ret);
+ memcpy(gl2ps->compress->start + oldsize, bufptr, ret);
+ if(freebuf == GL_TRUE) gl2psFree(bufptr);
ret = 0;
}
else{
@@ -461,7 +467,7 @@ static int gl2psPrintf(const char* fmt, ...)
return ret;
}
-static void gl2psPrintGzipHeader()
+static void gl2psPrintGzipHeader(void)
{
#if defined(GL2PS_HAVE_ZLIB)
char tmp[10] = {'\x1f', '\x8b', /* magic numbers: 0x1f, 0x8b */
@@ -476,10 +482,10 @@ static void gl2psPrintGzipHeader()
/* add the gzip file header */
fwrite(tmp, 10, 1, gl2ps->stream);
}
-#endif
+#endif
}
-static void gl2psPrintGzipFooter()
+static void gl2psPrintGzipFooter(void)
{
#if defined(GL2PS_HAVE_ZLIB)
int n;
@@ -497,7 +503,7 @@ static void gl2psPrintGzipFooter()
n += 4; /* DICTID */
}
/* write the data, without the zlib header and footer */
- fwrite(gl2ps->compress->dest+n, gl2ps->compress->destLen-(n+4),
+ fwrite(gl2ps->compress->dest+n, gl2ps->compress->destLen-(n+4),
1, gl2ps->stream);
/* add the gzip file footer */
crc = crc32(0L, gl2ps->compress->start, gl2ps->compress->srcLen);
@@ -516,7 +522,7 @@ static void gl2psPrintGzipFooter()
gl2psFree(gl2ps->compress);
gl2ps->compress = NULL;
}
-#endif
+#endif
}
/* The list handling routines */
@@ -554,7 +560,7 @@ static GL2PSlist *gl2psListCreate(GLint n, GLint incr, GLint size)
list->n = 0;
list->array = NULL;
gl2psListRealloc(list, n);
- return(list);
+ return list;
}
static void gl2psListReset(GL2PSlist *list)
@@ -565,7 +571,7 @@ static void gl2psListReset(GL2PSlist *list)
static void gl2psListDelete(GL2PSlist *list)
{
- if(!list) return;
+ if(!list) return;
gl2psFree(list->array);
gl2psFree(list);
}
@@ -585,20 +591,20 @@ static int gl2psListNbr(GL2PSlist *list)
{
if(!list)
return 0;
- return(list->n);
+ return list->n;
}
-static void *gl2psListPointer(GL2PSlist *list, GLint index)
+static void *gl2psListPointer(GL2PSlist *list, GLint idx)
{
if(!list){
gl2psMsg(GL2PS_ERROR, "Cannot point into unallocated list");
return NULL;
}
- if((index < 0) || (index >= list->n)){
+ if((idx < 0) || (idx >= list->n)){
gl2psMsg(GL2PS_ERROR, "Wrong list index in gl2psListPointer");
return NULL;
}
- return(&list->array[index * list->size]);
+ return &list->array[idx * list->size];
}
static void gl2psListSort(GL2PSlist *list,
@@ -638,7 +644,7 @@ static void gl2psListRead(GL2PSlist *list, int index, void *data)
static void gl2psEncodeBase64Block(unsigned char in[3], unsigned char out[4], int len)
{
- static const char cb64[] =
+ static const char cb64[] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
out[0] = cb64[ in[0] >> 2 ];
@@ -691,7 +697,7 @@ static GLboolean gl2psSameColor(GL2PSrgba rgba1, GL2PSrgba rgba2)
return GL_FALSE;
return GL_TRUE;
}
-
+
static GLboolean gl2psVertsSameColor(const GL2PSprimitive *prim)
{
int i;
@@ -710,20 +716,20 @@ static GLboolean gl2psSameColorThreshold(int n, GL2PSrgba rgba[],
int i;
if(n < 2) return GL_TRUE;
-
+
for(i = 1; i < n; i++){
if(fabs(rgba[0][0] - rgba[i][0]) > threshold[0] ||
fabs(rgba[0][1] - rgba[i][1]) > threshold[1] ||
fabs(rgba[0][2] - rgba[i][2]) > threshold[2])
return GL_FALSE;
}
-
+
return GL_TRUE;
}
static void gl2psSetLastColor(GL2PSrgba rgba)
{
- int i;
+ int i;
for(i = 0; i < 3; ++i){
gl2ps->lastrgba[i] = rgba[i];
}
@@ -732,13 +738,13 @@ static void gl2psSetLastColor(GL2PSrgba rgba)
static GLfloat gl2psGetRGB(GL2PSimage *im, GLuint x, GLuint y,
GLfloat *red, GLfloat *green, GLfloat *blue)
{
-
+
GLsizei width = im->width;
GLsizei height = im->height;
GLfloat *pixels = im->pixels;
GLfloat *pimag;
- /* OpenGL image is from down to up, PS image is up to down */
+ /* OpenGL image is from down to up, PS image is up to down */
switch(im->format){
case GL_RGBA:
pimag = pixels + 4 * (width * (height - 1 - y) + x);
@@ -761,11 +767,13 @@ static GL2PSimage *gl2psCopyPixmap(GL2PSimage *im)
{
int size;
GL2PSimage *image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage));
-
+
image->width = im->width;
image->height = im->height;
image->format = im->format;
image->type = im->type;
+ image->zoom_x = im->zoom_x;
+ image->zoom_y = im->zoom_y;
switch(image->format){
case GL_RGBA:
@@ -779,7 +787,7 @@ static GL2PSimage *gl2psCopyPixmap(GL2PSimage *im)
image->pixels = (GLfloat*)gl2psMalloc(size);
memcpy(image->pixels, im->pixels, size);
-
+
return image;
}
@@ -801,12 +809,13 @@ static void gl2psUserWritePNG(png_structp png_ptr, png_bytep data, png_size_t le
{
unsigned int i;
GL2PSlist *png = (GL2PSlist*)png_get_io_ptr(png_ptr);
- for(i = 0; i < length; i++)
+ for(i = 0; i < length; i++)
gl2psListAdd(png, &data[i]);
}
static void gl2psUserFlushPNG(png_structp png_ptr)
{
+ (void) png_ptr; /* not used */
}
static void gl2psConvertPixmapToPNG(GL2PSimage *pixmap, GL2PSlist *png)
@@ -819,21 +828,21 @@ static void gl2psConvertPixmapToPNG(GL2PSimage *pixmap, GL2PSlist *png)
if(!(png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING, NULL, NULL, NULL)))
return;
-
+
if(!(info_ptr = png_create_info_struct(png_ptr))){
png_destroy_write_struct(&png_ptr, NULL);
return;
}
-
+
if(setjmp(png_jmpbuf(png_ptr))) {
png_destroy_write_struct(&png_ptr, &info_ptr);
return;
}
-
+
png_set_write_fn(png_ptr, (void *)png, gl2psUserWritePNG, gl2psUserFlushPNG);
png_set_compression_level(png_ptr, Z_DEFAULT_COMPRESSION);
- png_set_IHDR(png_ptr, info_ptr, pixmap->width, pixmap->height, 8,
- PNG_COLOR_TYPE_RGB, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_BASE,
+ png_set_IHDR(png_ptr, info_ptr, pixmap->width, pixmap->height, 8,
+ PNG_COLOR_TYPE_RGB, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_BASE,
PNG_FILTER_TYPE_BASE);
png_write_info(png_ptr, info_ptr);
@@ -857,8 +866,9 @@ static void gl2psConvertPixmapToPNG(GL2PSimage *pixmap, GL2PSlist *png)
/* Helper routines for text strings */
-static GLint gl2psAddText(GLint type, const char *str, const char *fontname,
- GLshort fontsize, GLint alignment, GLfloat angle)
+static GLint gl2psAddText(GLint type, const char *str, const char *fontname,
+ GLshort fontsize, GLint alignment, GLfloat angle,
+ GL2PSrgba color)
{
GLfloat pos[4];
GL2PSprimitive *prim;
@@ -886,10 +896,13 @@ static GLint gl2psAddText(GLint type, const char *str, const char *fontname,
prim->pattern = 0;
prim->factor = 0;
prim->width = 1;
- glGetFloatv(GL_CURRENT_RASTER_COLOR, prim->verts[0].rgba);
+ if (color)
+ memcpy(prim->verts[0].rgba, color, 4 * sizeof(float));
+ else
+ glGetFloatv(GL_CURRENT_RASTER_COLOR, prim->verts[0].rgba);
prim->data.text = (GL2PSstring*)gl2psMalloc(sizeof(GL2PSstring));
prim->data.text->str = (char*)gl2psMalloc((strlen(str)+1)*sizeof(char));
- strcpy(prim->data.text->str, str);
+ strcpy(prim->data.text->str, str);
prim->data.text->fontname = (char*)gl2psMalloc((strlen(fontname)+1)*sizeof(char));
strcpy(prim->data.text->fontname, fontname);
prim->data.text->fontsize = fontsize;
@@ -898,7 +911,7 @@ static GLint gl2psAddText(GLint type, const char *str, const char *fontname,
gl2psListAdd(gl2ps->auxprimitives, &prim);
glPassThrough(GL2PS_TEXT_TOKEN);
-
+
return GL2PS_SUCCESS;
}
@@ -906,13 +919,13 @@ static GL2PSstring *gl2psCopyText(GL2PSstring *t)
{
GL2PSstring *text = (GL2PSstring*)gl2psMalloc(sizeof(GL2PSstring));
text->str = (char*)gl2psMalloc((strlen(t->str)+1)*sizeof(char));
- strcpy(text->str, t->str);
+ strcpy(text->str, t->str);
text->fontname = (char*)gl2psMalloc((strlen(t->fontname)+1)*sizeof(char));
strcpy(text->fontname, t->fontname);
text->fontsize = t->fontsize;
text->alignment = t->alignment;
text->angle = t->angle;
-
+
return text;
}
@@ -932,7 +945,7 @@ static GLboolean gl2psSupportedBlendMode(GLenum sfactor, GLenum dfactor)
/* returns TRUE if gl2ps supports the argument combination: only two
blending modes have been implemented so far */
- if( (sfactor == GL_SRC_ALPHA && dfactor == GL_ONE_MINUS_SRC_ALPHA) ||
+ if( (sfactor == GL_SRC_ALPHA && dfactor == GL_ONE_MINUS_SRC_ALPHA) ||
(sfactor == GL_ONE && dfactor == GL_ZERO) )
return GL_TRUE;
return GL_FALSE;
@@ -952,7 +965,7 @@ static void gl2psAdaptVertexForBlending(GL2PSvertex *v)
v->rgba[3] = 1.0F;
return;
}
-
+
switch(gl2ps->blendfunc[0]){
case GL_ONE:
v->rgba[3] = 1.0F;
@@ -973,9 +986,9 @@ static void gl2psAssignTriangleProperties(GL2PStriangle *t)
a remarkable amount of PDF handling code inside this file depends
on it if activated */
/*
- t->prop = T_CONST_COLOR;
+ t->prop = T_CONST_COLOR;
for(i = 0; i < 3; ++i){
- if(!GL2PS_ZERO(t->vertex[0].rgba[i] - t->vertex[1].rgba[i]) ||
+ if(!GL2PS_ZERO(t->vertex[0].rgba[i] - t->vertex[1].rgba[i]) ||
!GL2PS_ZERO(t->vertex[1].rgba[i] - t->vertex[2].rgba[i])){
t->prop = T_VAR_COLOR;
break;
@@ -983,7 +996,7 @@ static void gl2psAssignTriangleProperties(GL2PStriangle *t)
}
*/
- if(!GL2PS_ZERO(t->vertex[0].rgba[3] - t->vertex[1].rgba[3]) ||
+ if(!GL2PS_ZERO(t->vertex[0].rgba[3] - t->vertex[1].rgba[3]) ||
!GL2PS_ZERO(t->vertex[1].rgba[3] - t->vertex[2].rgba[3])){
t->prop |= T_VAR_ALPHA;
}
@@ -1026,7 +1039,7 @@ static GL2PSprimitive *gl2psCopyPrimitive(GL2PSprimitive *p)
}
prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive));
-
+
prim->type = p->type;
prim->numverts = p->numverts;
prim->boundary = p->boundary;
@@ -1062,23 +1075,23 @@ static GLboolean gl2psSamePosition(GL2PSxyz p1, GL2PSxyz p2)
return GL_TRUE;
}
-/*********************************************************************
+/*********************************************************************
*
- * 3D sorting routines
+ * 3D sorting routines
*
*********************************************************************/
static GLfloat gl2psComparePointPlane(GL2PSxyz point, GL2PSplane plane)
{
- return(plane[0] * point[0] +
- plane[1] * point[1] +
- plane[2] * point[2] +
- plane[3]);
+ return (plane[0] * point[0] +
+ plane[1] * point[1] +
+ plane[2] * point[2] +
+ plane[3]);
}
static GLfloat gl2psPsca(GLfloat *a, GLfloat *b)
{
- return(a[0]*b[0] + a[1]*b[1] + a[2]*b[2]);
+ return (a[0]*b[0] + a[1]*b[1] + a[2]*b[2]);
}
static void gl2psPvec(GLfloat *a, GLfloat *b, GLfloat *c)
@@ -1119,13 +1132,13 @@ static void gl2psGetPlane(GL2PSprimitive *prim, GL2PSplane plane)
switch(prim->type){
case GL2PS_TRIANGLE :
case GL2PS_QUADRANGLE :
- v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0];
- v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1];
- v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2];
- w[0] = prim->verts[2].xyz[0] - prim->verts[0].xyz[0];
- w[1] = prim->verts[2].xyz[1] - prim->verts[0].xyz[1];
- w[2] = prim->verts[2].xyz[2] - prim->verts[0].xyz[2];
- if((GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])) ||
+ v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0];
+ v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1];
+ v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2];
+ w[0] = prim->verts[2].xyz[0] - prim->verts[0].xyz[0];
+ w[1] = prim->verts[2].xyz[1] - prim->verts[0].xyz[1];
+ w[2] = prim->verts[2].xyz[2] - prim->verts[0].xyz[2];
+ if((GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])) ||
(GL2PS_ZERO(w[0]) && GL2PS_ZERO(w[1]) && GL2PS_ZERO(w[2]))){
plane[0] = plane[1] = 0.0F;
plane[2] = 1.0F;
@@ -1133,16 +1146,16 @@ static void gl2psGetPlane(GL2PSprimitive *prim, GL2PSplane plane)
}
else{
gl2psGetNormal(v, w, plane);
- plane[3] =
- - plane[0] * prim->verts[0].xyz[0]
- - plane[1] * prim->verts[0].xyz[1]
+ plane[3] =
+ - plane[0] * prim->verts[0].xyz[0]
+ - plane[1] * prim->verts[0].xyz[1]
- plane[2] * prim->verts[0].xyz[2];
}
break;
case GL2PS_LINE :
- v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0];
- v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1];
- v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2];
+ v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0];
+ v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1];
+ v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2];
if(GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])){
plane[0] = plane[1] = 0.0F;
plane[2] = 1.0F;
@@ -1153,9 +1166,9 @@ static void gl2psGetPlane(GL2PSprimitive *prim, GL2PSplane plane)
else if(GL2PS_ZERO(v[1])) w[1] = 1.0F;
else w[2] = 1.0F;
gl2psGetNormal(v, w, plane);
- plane[3] =
- - plane[0] * prim->verts[0].xyz[0]
- - plane[1] * prim->verts[0].xyz[1]
+ plane[3] =
+ - plane[0] * prim->verts[0].xyz[0]
+ - plane[1] * prim->verts[0].xyz[1]
- plane[2] * prim->verts[0].xyz[2];
}
break;
@@ -1180,18 +1193,21 @@ static void gl2psCutEdge(GL2PSvertex *a, GL2PSvertex *b, GL2PSplane plane,
GL2PSvertex *c)
{
GL2PSxyz v;
- GLfloat sect;
+ GLfloat sect, psca;
v[0] = b->xyz[0] - a->xyz[0];
v[1] = b->xyz[1] - a->xyz[1];
v[2] = b->xyz[2] - a->xyz[2];
- sect = - gl2psComparePointPlane(a->xyz, plane) / gl2psPsca(plane, v);
+ if(!GL2PS_ZERO(psca = gl2psPsca(plane, v)))
+ sect = -gl2psComparePointPlane(a->xyz, plane) / psca;
+ else
+ sect = 0.0F;
c->xyz[0] = a->xyz[0] + v[0] * sect;
c->xyz[1] = a->xyz[1] + v[1] * sect;
c->xyz[2] = a->xyz[2] + v[2] * sect;
-
+
c->rgba[0] = (1 - sect) * a->rgba[0] + sect * b->rgba[0];
c->rgba[1] = (1 - sect) * a->rgba[1] + sect * b->rgba[1];
c->rgba[2] = (1 - sect) * a->rgba[2] + sect * b->rgba[2];
@@ -1214,10 +1230,10 @@ static void gl2psCreateSplitPrimitive(GL2PSprimitive *parent, GL2PSplane plane,
numverts = 4;
}
switch(numverts){
- case 1 : child->type = GL2PS_POINT; break;
- case 2 : child->type = GL2PS_LINE; break;
- case 3 : child->type = GL2PS_TRIANGLE; break;
- case 4 : child->type = GL2PS_QUADRANGLE; break;
+ case 1 : child->type = GL2PS_POINT; break;
+ case 2 : child->type = GL2PS_LINE; break;
+ case 3 : child->type = GL2PS_TRIANGLE; break;
+ case 4 : child->type = GL2PS_QUADRANGLE; break;
default: child->type = GL2PS_NO_TYPE; break;
}
}
@@ -1236,13 +1252,13 @@ static void gl2psCreateSplitPrimitive(GL2PSprimitive *parent, GL2PSplane plane,
child->verts[i] = parent->verts[index0[i]];
}
else{
- gl2psCutEdge(&parent->verts[index0[i]], &parent->verts[index1[i]],
+ gl2psCutEdge(&parent->verts[index0[i]], &parent->verts[index1[i]],
plane, &child->verts[i]);
}
}
}
-static void gl2psAddIndex(GLshort *index0, GLshort *index1, GLshort *nb,
+static void gl2psAddIndex(GLshort *index0, GLshort *index1, GLshort *nb,
GLshort i, GLshort j)
{
GLint k;
@@ -1265,9 +1281,9 @@ static GLint gl2psTestSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane)
{
GLint type = GL2PS_COINCIDENT;
GLshort i, j;
- GLfloat d[5];
+ GLfloat d[5];
- for(i = 0; i < prim->numverts; i++){
+ for(i = 0; i < prim->numverts; i++){
d[i] = gl2psComparePointPlane(prim->verts[i].xyz, plane);
}
@@ -1279,11 +1295,11 @@ static GLint gl2psTestSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane)
j = gl2psGetIndex(i, prim->numverts);
if(d[j] > GL2PS_EPSILON){
if(type == GL2PS_COINCIDENT) type = GL2PS_IN_BACK_OF;
- else if(type != GL2PS_IN_BACK_OF) return 1;
+ else if(type != GL2PS_IN_BACK_OF) return 1;
if(d[i] < -GL2PS_EPSILON) return 1;
}
else if(d[j] < -GL2PS_EPSILON){
- if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF;
+ if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF;
else if(type != GL2PS_IN_FRONT_OF) return 1;
if(d[i] > GL2PS_EPSILON) return 1;
}
@@ -1292,16 +1308,16 @@ static GLint gl2psTestSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane)
return 0;
}
-static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane,
+static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane,
GL2PSprimitive **front, GL2PSprimitive **back)
{
GLshort i, j, in = 0, out = 0, in0[5], in1[5], out0[5], out1[5];
GLint type;
- GLfloat d[5];
+ GLfloat d[5];
type = GL2PS_COINCIDENT;
- for(i = 0; i < prim->numverts; i++){
+ for(i = 0; i < prim->numverts; i++){
d[i] = gl2psComparePointPlane(prim->verts[i].xyz, plane);
}
@@ -1316,7 +1332,7 @@ static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane,
j = gl2psGetIndex(i, prim->numverts);
if(d[j] > GL2PS_EPSILON){
if(type == GL2PS_COINCIDENT) type = GL2PS_IN_BACK_OF;
- else if(type != GL2PS_IN_BACK_OF) type = GL2PS_SPANNING;
+ else if(type != GL2PS_IN_BACK_OF) type = GL2PS_SPANNING;
if(d[i] < -GL2PS_EPSILON){
gl2psAddIndex(in0, in1, &in, i, j);
gl2psAddIndex(out0, out1, &out, i, j);
@@ -1325,7 +1341,7 @@ static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane,
gl2psAddIndex(out0, out1, &out, j, -1);
}
else if(d[j] < -GL2PS_EPSILON){
- if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF;
+ if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF;
else if(type != GL2PS_IN_FRONT_OF) type = GL2PS_SPANNING;
if(d[i] > GL2PS_EPSILON){
gl2psAddIndex(in0, in1, &in, i, j);
@@ -1352,7 +1368,7 @@ static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane,
return type;
}
-static void gl2psDivideQuad(GL2PSprimitive *quad,
+static void gl2psDivideQuad(GL2PSprimitive *quad,
GL2PSprimitive **t1, GL2PSprimitive **t2)
{
*t1 = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive));
@@ -1373,25 +1389,25 @@ static void gl2psDivideQuad(GL2PSprimitive *quad,
(*t2)->verts[0] = quad->verts[0];
(*t2)->verts[1] = quad->verts[2];
(*t2)->verts[2] = quad->verts[3];
- (*t1)->boundary = ((quad->boundary & 4) ? 2 : 0) | ((quad->boundary & 4) ? 2 : 0);
+ (*t2)->boundary = ((quad->boundary & 4) ? 2 : 0) | ((quad->boundary & 8) ? 4 : 0);
}
static int gl2psCompareDepth(const void *a, const void *b)
{
- GL2PSprimitive *q, *w;
+ const GL2PSprimitive *q, *w;
GLfloat dq = 0.0F, dw = 0.0F, diff;
int i;
-
- q = *(GL2PSprimitive**)a;
- w = *(GL2PSprimitive**)b;
+
+ q = *(const GL2PSprimitive* const*)a;
+ w = *(const GL2PSprimitive* const*)b;
for(i = 0; i < q->numverts; i++){
- dq += q->verts[i].xyz[2];
+ dq += q->verts[i].xyz[2];
}
dq /= (GLfloat)q->numverts;
for(i = 0; i < w->numverts; i++){
- dw += w->verts[i].xyz[2];
+ dw += w->verts[i].xyz[2];
}
dw /= (GLfloat)w->numverts;
@@ -1409,16 +1425,16 @@ static int gl2psCompareDepth(const void *a, const void *b)
static int gl2psTrianglesFirst(const void *a, const void *b)
{
- GL2PSprimitive *q, *w;
+ const GL2PSprimitive *q, *w;
- q = *(GL2PSprimitive**)a;
- w = *(GL2PSprimitive**)b;
- return(q->type < w->type ? 1 : -1);
+ q = *(const GL2PSprimitive* const*)a;
+ w = *(const GL2PSprimitive* const*)b;
+ return (q->type < w->type ? 1 : -1);
}
static GLint gl2psFindRoot(GL2PSlist *primitives, GL2PSprimitive **root)
{
- GLint i, j, count, best = 1000000, index = 0;
+ GLint i, j, count, best = 1000000, idx = 0;
GL2PSprimitive *prim1, *prim2;
GL2PSplane plane;
GLint maxp;
@@ -1442,26 +1458,27 @@ static GLint gl2psFindRoot(GL2PSlist *primitives, GL2PSprimitive **root)
for(j = 0; j < gl2psListNbr(primitives); j++){
if(j != i){
prim2 = *(GL2PSprimitive**)gl2psListPointer(primitives, j);
- count += gl2psTestSplitPrimitive(prim2, plane);
+ count += gl2psTestSplitPrimitive(prim2, plane);
}
if(count > best) break;
}
if(count < best){
best = count;
- index = i;
+ idx = i;
*root = prim1;
- if(!count) return index;
+ if(!count) return idx;
}
}
/* if(index) gl2psMsg(GL2PS_INFO, "GL2PS_BEST_ROOT was worth it: %d", index); */
- return index;
+ return idx;
}
else{
return 0;
}
}
-static void gl2psFreeImagemap(GL2PSimagemap *list){
+static void gl2psFreeImagemap(GL2PSimagemap *list)
+{
GL2PSimagemap *next;
while(list != NULL){
next = list->next;
@@ -1475,7 +1492,7 @@ static void gl2psFreeImagemap(GL2PSimagemap *list){
static void gl2psFreePrimitive(void *data)
{
GL2PSprimitive *q;
-
+
q = *(GL2PSprimitive**)data;
gl2psFree(q->verts);
if(q->type == GL2PS_TEXT || q->type == GL2PS_SPECIAL){
@@ -1500,7 +1517,7 @@ static void gl2psAddPrimitiveInList(GL2PSprimitive *prim, GL2PSlist *list)
gl2psListAdd(list, &t2);
gl2psFreePrimitive(&prim);
}
-
+
}
static void gl2psFreeBspTree(GL2PSbsptree **tree)
@@ -1533,12 +1550,12 @@ static void gl2psBuildBspTree(GL2PSbsptree *tree, GL2PSlist *primitives)
{
GL2PSprimitive *prim, *frontprim = NULL, *backprim = NULL;
GL2PSlist *frontlist, *backlist;
- GLint i, index;
+ GLint i, idx;
tree->front = NULL;
tree->back = NULL;
tree->primitives = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*));
- index = gl2psFindRoot(primitives, &prim);
+ idx = gl2psFindRoot(primitives, &prim);
gl2psGetPlane(prim, tree->plane);
gl2psAddPrimitiveInList(prim, tree->primitives);
@@ -1546,7 +1563,7 @@ static void gl2psBuildBspTree(GL2PSbsptree *tree, GL2PSlist *primitives)
backlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*));
for(i = 0; i < gl2psListNbr(primitives); i++){
- if(i != index){
+ if(i != idx){
prim = *(GL2PSprimitive**)gl2psListPointer(primitives,i);
switch(gl2psSplitPrimitive(prim, tree->plane, &frontprim, &backprim)){
case GL2PS_COINCIDENT:
@@ -1612,7 +1629,7 @@ static void gl2psTraverseBspTree(GL2PSbsptree *tree, GL2PSxyz eye, GLfloat epsil
}
gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse);
}
- else if(GL_TRUE == compare(-epsilon, result)){
+ else if(GL_TRUE == compare(-epsilon, result)){
gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse);
if(inverse){
gl2psListActionInverse(tree->primitives, action);
@@ -1628,7 +1645,7 @@ static void gl2psTraverseBspTree(GL2PSbsptree *tree, GL2PSxyz eye, GLfloat epsil
}
}
-static void gl2psRescaleAndOffset()
+static void gl2psRescaleAndOffset(void)
{
GL2PSprimitive *prim;
GLfloat minZ, maxZ, rangeZ, scaleZ;
@@ -1680,22 +1697,27 @@ static void gl2psRescaleAndOffset()
else if(prim->offset && (prim->type == GL2PS_TRIANGLE)){
factor = gl2ps->offset[0];
units = gl2ps->offset[1];
- area =
- (prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) *
- (prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) -
- (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) *
- (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]);
- dZdX =
- (prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) *
- (prim->verts[1].xyz[2] - prim->verts[0].xyz[2]) -
- (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]) *
- (prim->verts[2].xyz[2] - prim->verts[1].xyz[2]) / area;
- dZdY =
+ area =
(prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) *
- (prim->verts[2].xyz[2] - prim->verts[1].xyz[2]) -
+ (prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) -
(prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) *
- (prim->verts[1].xyz[2] - prim->verts[0].xyz[2]) / area;
- maxdZ = (GLfloat)sqrt(dZdX * dZdX + dZdY * dZdY);
+ (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]);
+ if(!GL2PS_ZERO(area)){
+ dZdX =
+ ((prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) *
+ (prim->verts[1].xyz[2] - prim->verts[0].xyz[2]) -
+ (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]) *
+ (prim->verts[2].xyz[2] - prim->verts[1].xyz[2])) / area;
+ dZdY =
+ ((prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) *
+ (prim->verts[2].xyz[2] - prim->verts[1].xyz[2]) -
+ (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) *
+ (prim->verts[1].xyz[2] - prim->verts[0].xyz[2])) / area;
+ maxdZ = (GLfloat)sqrt(dZdX * dZdX + dZdY * dZdY);
+ }
+ else{
+ maxdZ = 0.0F;
+ }
dZ = factor * maxdZ + units;
prim->verts[0].xyz[2] += dZ;
prim->verts[1].xyz[2] += dZ;
@@ -1704,15 +1726,15 @@ static void gl2psRescaleAndOffset()
}
}
-/*********************************************************************
+/*********************************************************************
*
- * 2D sorting routines (for occlusion culling)
+ * 2D sorting routines (for occlusion culling)
*
*********************************************************************/
static GLint gl2psGetPlaneFromPoints(GL2PSxyz a, GL2PSxyz b, GL2PSplane plane)
{
- GLfloat n;
+ GLfloat n;
plane[0] = b[1] - a[1];
plane[1] = a[0] - b[0];
@@ -1721,7 +1743,7 @@ static GLint gl2psGetPlaneFromPoints(GL2PSxyz a, GL2PSxyz b, GL2PSplane plane)
if(!GL2PS_ZERO(n)){
plane[0] /= n;
plane[1] /= n;
- plane[3] = -plane[0]*a[0]-plane[1]*a[1];
+ plane[3] = -plane[0]*a[0]-plane[1]*a[1];
return 1;
}
else{
@@ -1761,6 +1783,10 @@ static void gl2psAddPlanesInBspTreeImage(GL2PSprimitive *prim,
GL2PSbsptree2d *head = NULL, *cur = NULL;
if((*tree == NULL) && (prim->numverts > 2)){
+ /* don't cull if transparent
+ for(i = 0; i < prim->numverts - 1; i++)
+ if(prim->verts[i].rgba[3] < 1.0F) return;
+ */
head = (GL2PSbsptree2d*)gl2psMalloc(sizeof(GL2PSbsptree2d));
for(i = 0; i < prim->numverts-1; i++){
if(!gl2psGetPlaneFromPoints(prim->verts[i].xyz,
@@ -1902,8 +1928,8 @@ static GL2PSprimitive *gl2psCreateSplitPrimitive2D(GL2PSprimitive *parent,
}
static void gl2psSplitPrimitive2D(GL2PSprimitive *prim,
- GL2PSplane plane,
- GL2PSprimitive **front,
+ GL2PSplane plane,
+ GL2PSprimitive **front,
GL2PSprimitive **back)
{
/* cur will hold the position of the current vertex
@@ -1912,10 +1938,10 @@ static void gl2psSplitPrimitive2D(GL2PSprimitive *prim,
v1 and v2 represent the current and previous vertices, respectively
flag is set if the current vertex should be checked against the plane */
GLint cur = -1, prev = -1, i, v1 = 0, v2 = 0, flag = 1, prev0 = -1;
-
+
/* list of vertices that will go in front and back primitive */
GL2PSvertex *front_list = NULL, *back_list = NULL;
-
+
/* number of vertices in front and back list */
GLshort front_count = 0, back_count = 0;
@@ -1924,7 +1950,7 @@ static void gl2psSplitPrimitive2D(GL2PSprimitive *prim,
if(v1 == prim->numverts){
if(prim->numverts < 3) break;
v1 = 0;
- v2 = prim->numverts-1;
+ v2 = prim->numverts - 1;
cur = prev0;
}
else if(flag){
@@ -1932,7 +1958,7 @@ static void gl2psSplitPrimitive2D(GL2PSprimitive *prim,
if(i == 0){
prev0 = cur;
}
- }
+ }
if(((prev == -1) || (prev == cur) || (prev == 0) || (cur == 0)) &&
(i < prim->numverts)){
if(cur == GL2PS_POINT_INFRONT){
@@ -1967,10 +1993,8 @@ static void gl2psSplitPrimitive2D(GL2PSprimitive *prim,
front_count++;
front_list = (GL2PSvertex*)gl2psRealloc(front_list,
sizeof(GL2PSvertex)*front_count);
- gl2psCutEdge(&prim->verts[v2],
- &prim->verts[v1],
- plane,
- &front_list[front_count-1]);
+ gl2psCutEdge(&prim->verts[v2], &prim->verts[v1],
+ plane, &front_list[front_count-1]);
back_count++;
back_list = (GL2PSvertex*)gl2psRealloc(back_list,
sizeof(GL2PSvertex)*back_count);
@@ -1989,12 +2013,12 @@ static GLint gl2psAddInBspImageTree(GL2PSprimitive *prim, GL2PSbsptree2d **tree)
{
GLint ret = 0;
GL2PSprimitive *frontprim = NULL, *backprim = NULL;
-
+
/* FIXME: until we consider the actual extent of text strings and
pixmaps, never cull them. Otherwise the whole string/pixmap gets
culled as soon as the reference point is hidden */
- if(prim->type == GL2PS_PIXMAP ||
- prim->type == GL2PS_TEXT ||
+ if(prim->type == GL2PS_PIXMAP ||
+ prim->type == GL2PS_TEXT ||
prim->type == GL2PS_SPECIAL){
return 1;
}
@@ -2008,7 +2032,7 @@ static GLint gl2psAddInBspImageTree(GL2PSprimitive *prim, GL2PSbsptree2d **tree)
else{
switch(gl2psCheckPrimitive(prim, (*tree)->plane)){
case GL2PS_IN_BACK_OF: return gl2psAddInBspImageTree(prim, &(*tree)->back);
- case GL2PS_IN_FRONT_OF:
+ case GL2PS_IN_FRONT_OF:
if((*tree)->front != NULL) return gl2psAddInBspImageTree(prim, &(*tree)->front);
else return 0;
case GL2PS_SPANNING:
@@ -2143,14 +2167,14 @@ static void gl2psBuildPolygonBoundary(GL2PSbsptree *tree)
gl2psBuildPolygonBoundary(tree->front);
}
-/*********************************************************************
+/*********************************************************************
*
* Feedback buffer parser
*
*********************************************************************/
-static void gl2psAddPolyPrimitive(GLshort type, GLshort numverts,
- GL2PSvertex *verts, GLint offset,
+static void gl2psAddPolyPrimitive(GLshort type, GLshort numverts,
+ GL2PSvertex *verts, GLint offset,
GLushort pattern, GLint factor,
GLfloat width, char boundary)
{
@@ -2217,7 +2241,7 @@ static void gl2psParseFeedbackBuffer(GLint used)
while(used > 0){
if(GL_TRUE == boundary) gl2ps->boundary = GL_TRUE;
-
+
switch((GLint)*current){
case GL_POINT_TOKEN :
current ++;
@@ -2225,7 +2249,7 @@ static void gl2psParseFeedbackBuffer(GLint used)
i = gl2psGetVertex(&vertices[0], current);
current += i;
used -= i;
- gl2psAddPolyPrimitive(GL2PS_POINT, 1, vertices, 0,
+ gl2psAddPolyPrimitive(GL2PS_POINT, 1, vertices, 0,
pattern, factor, psize, 0);
break;
case GL_LINE_TOKEN :
@@ -2238,7 +2262,7 @@ static void gl2psParseFeedbackBuffer(GLint used)
i = gl2psGetVertex(&vertices[1], current);
current += i;
used -= i;
- gl2psAddPolyPrimitive(GL2PS_LINE, 2, vertices, 0,
+ gl2psAddPolyPrimitive(GL2PS_LINE, 2, vertices, 0,
pattern, factor, lwidth, 0);
break;
case GL_POLYGON_TOKEN :
@@ -2269,7 +2293,7 @@ static void gl2psParseFeedbackBuffer(GLint used)
else
v ++;
}
- break;
+ break;
case GL_BITMAP_TOKEN :
case GL_DRAW_PIXEL_TOKEN :
case GL_COPY_PIXEL_TOKEN :
@@ -2278,7 +2302,7 @@ static void gl2psParseFeedbackBuffer(GLint used)
i = gl2psGetVertex(&vertices[0], current);
current += i;
used -= i;
- break;
+ break;
case GL_PASS_THROUGH_TOKEN :
switch((GLint)current[1]){
case GL2PS_BEGIN_OFFSET_TOKEN : offset = 1; break;
@@ -2288,32 +2312,32 @@ static void gl2psParseFeedbackBuffer(GLint used)
case GL2PS_END_STIPPLE_TOKEN : pattern = factor = 0; break;
case GL2PS_BEGIN_BLEND_TOKEN : gl2ps->blending = GL_TRUE; break;
case GL2PS_END_BLEND_TOKEN : gl2ps->blending = GL_FALSE; break;
- case GL2PS_BEGIN_STIPPLE_TOKEN :
+ case GL2PS_BEGIN_STIPPLE_TOKEN :
current += 2;
- used -= 2;
- pattern = (GLushort)current[1];
+ used -= 2;
+ pattern = (GLushort)current[1];
current += 2;
- used -= 2;
- factor = (GLint)current[1];
+ used -= 2;
+ factor = (GLint)current[1];
break;
- case GL2PS_SRC_BLEND_TOKEN :
- current += 2;
- used -= 2;
+ case GL2PS_SRC_BLEND_TOKEN :
+ current += 2;
+ used -= 2;
gl2ps->blendfunc[0] = (GLint)current[1];
break;
- case GL2PS_DST_BLEND_TOKEN :
- current += 2;
- used -= 2;
+ case GL2PS_DST_BLEND_TOKEN :
+ current += 2;
+ used -= 2;
gl2ps->blendfunc[1] = (GLint)current[1];
break;
- case GL2PS_POINT_SIZE_TOKEN :
- current += 2;
- used -= 2;
+ case GL2PS_POINT_SIZE_TOKEN :
+ current += 2;
+ used -= 2;
psize = current[1];
break;
- case GL2PS_LINE_WIDTH_TOKEN :
- current += 2;
- used -= 2;
+ case GL2PS_LINE_WIDTH_TOKEN :
+ current += 2;
+ used -= 2;
lwidth = current[1];
break;
case GL2PS_IMAGEMAP_TOKEN :
@@ -2327,29 +2351,31 @@ static void gl2psParseFeedbackBuffer(GLint used)
prim->pattern = 0;
prim->factor = 0;
prim->width = 1;
-
+
node = (GL2PSimagemap*)gl2psMalloc(sizeof(GL2PSimagemap));
node->image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage));
node->image->type = 0;
node->image->format = 0;
+ node->image->zoom_x = 1.0F;
+ node->image->zoom_y = 1.0F;
node->next = NULL;
-
+
if(gl2ps->imagemap_head == NULL)
gl2ps->imagemap_head = node;
else
gl2ps->imagemap_tail->next = node;
gl2ps->imagemap_tail = node;
prim->data.image = node->image;
-
+
current += 2; used -= 2;
i = gl2psGetVertex(&prim->verts[0], ¤t[1]);
current += i; used -= i;
-
+
node->image->width = (GLint)current[2];
current += 2; used -= 2;
node->image->height = (GLint)current[2];
- prim->verts[0].xyz[0] = prim->verts[0].xyz[0] - (int)(node->image->width / 2) + 0.5;
- prim->verts[0].xyz[1] = prim->verts[0].xyz[1] - (int)(node->image->height / 2) + 0.5;
+ prim->verts[0].xyz[0] = prim->verts[0].xyz[0] - (int)(node->image->width / 2) + 0.5F;
+ prim->verts[0].xyz[1] = prim->verts[0].xyz[1] - (int)(node->image->height / 2) + 0.5F;
for(i = 1; i < 4; i++){
for(v = 0; v < 3; v++){
prim->verts[i].xyz[v] = prim->verts[0].xyz[v];
@@ -2364,12 +2390,12 @@ static void gl2psParseFeedbackBuffer(GLint used)
sizeoffloat = sizeof(GLfloat);
v = 2 * sizeoffloat;
- vtot = node->image->height + node->image->height *
- ((node->image->width-1)/8);
+ vtot = node->image->height + node->image->height *
+ ((node->image->width - 1) / 8);
node->image->pixels = (GLfloat*)gl2psMalloc(v + vtot);
node->image->pixels[0] = prim->verts[0].xyz[0];
node->image->pixels[1] = prim->verts[0].xyz[1];
-
+
for(i = 0; i < vtot; i += sizeoffloat){
current += 2; used -= 2;
if((vtot - i) >= 4)
@@ -2383,15 +2409,15 @@ static void gl2psParseFeedbackBuffer(GLint used)
case GL2PS_DRAW_PIXELS_TOKEN :
case GL2PS_TEXT_TOKEN :
if(auxindex < gl2psListNbr(gl2ps->auxprimitives))
- gl2psListAdd(gl2ps->primitives,
+ gl2psListAdd(gl2ps->primitives,
gl2psListPointer(gl2ps->auxprimitives, auxindex++));
else
gl2psMsg(GL2PS_ERROR, "Wrong number of auxiliary tokens in buffer");
break;
}
- current += 2;
- used -= 2;
- break;
+ current += 2;
+ used -= 2;
+ break;
default :
gl2psMsg(GL2PS_WARNING, "Unknown token in buffer");
current ++;
@@ -2403,7 +2429,7 @@ static void gl2psParseFeedbackBuffer(GLint used)
gl2psListReset(gl2ps->auxprimitives);
}
-/*********************************************************************
+/*********************************************************************
*
* PostScript routines
*
@@ -2433,31 +2459,31 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
if((width <= 0) || (height <= 0)) return;
gl2psPrintf("gsave\n");
- gl2psPrintf("%.2f %.2f translate\n", x, y);
- gl2psPrintf("%d %d scale\n", width, height);
+ gl2psPrintf("%.2f %.2f translate\n", x, y);
+ gl2psPrintf("%.2f %.2f scale\n", width * im->zoom_x, height * im->zoom_y);
if(greyscale){ /* greyscale */
- gl2psPrintf("/picstr %d string def\n", width);
- gl2psPrintf("%d %d %d\n", width, height, 8);
- gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height);
+ gl2psPrintf("/picstr %d string def\n", width);
+ gl2psPrintf("%d %d %d\n", width, height, 8);
+ gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height);
gl2psPrintf("{ currentfile picstr readhexstring pop }\n");
gl2psPrintf("image\n");
for(row = 0; row < height; row++){
- for(col = 0; col < width; col++){
+ for(col = 0; col < width; col++){
gl2psGetRGB(im, col, row, &dr, &dg, &db);
- fgrey = (0.30 * dr + 0.59 * dg + 0.11 * db);
+ fgrey = (0.30F * dr + 0.59F * dg + 0.11F * db);
grey = (unsigned char)(255. * fgrey);
gl2psWriteByte(grey);
}
gl2psPrintf("\n");
}
- nbhex = width * height * 2;
- gl2psPrintf("%%%% nbhex digit :%d\n", nbhex);
+ nbhex = width * height * 2;
+ gl2psPrintf("%%%% nbhex digit :%d\n", nbhex);
}
else if(nbit == 2){ /* color, 2 bits for r and g and b; rgbs following each other */
nrgb = width * 3;
nbits = nrgb * nbit;
- nbyte = nbits/8;
+ nbyte = nbits / 8;
if((nbyte * 8) != nbits) nbyte++;
gl2psPrintf("/rgbstr %d string def\n", nbyte);
gl2psPrintf("%d %d %d\n", width, height, nbit);
@@ -2473,7 +2499,7 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
if(icase == 1) {
if(col < width) {
gl2psGetRGB(im, col, row, &dr, &dg, &db);
- }
+ }
else {
dr = dg = db = 0;
}
@@ -2486,7 +2512,7 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
b = (b<<2) + blue;
if(col < width) {
gl2psGetRGB(im, col, row, &dr, &dg, &db);
- }
+ }
else {
dr = dg = db = 0;
}
@@ -2498,7 +2524,7 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
gl2psWriteByte(b);
b = 0;
icase++;
- }
+ }
else if(icase == 2) {
b = green;
b = (b<<2) + blue;
@@ -2517,7 +2543,7 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
gl2psWriteByte(b);
b = 0;
icase++;
- }
+ }
else if(icase == 3) {
b = blue;
if(col < width) {
@@ -2544,8 +2570,8 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
else if(nbit == 4){ /* color, 4 bits for r and g and b; rgbs following each other */
nrgb = width * 3;
nbits = nrgb * nbit;
- nbyte = nbits/8;
- if((nbyte * 8) != nbits) nbyte++;
+ nbyte = nbits / 8;
+ if((nbyte * 8) != nbits) nbyte++;
gl2psPrintf("/rgbstr %d string def\n", nbyte);
gl2psPrintf("%d %d %d\n", width, height, nbit);
gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height);
@@ -2559,7 +2585,7 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
if(icase == 1) {
if(col < width) {
gl2psGetRGB(im, col, row, &dr, &dg, &db);
- }
+ }
else {
dr = dg = db = 0;
}
@@ -2568,12 +2594,12 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
green = (unsigned char)(15. * dg);
gl2psPrintf("%x%x", red, green);
icase++;
- }
+ }
else if(icase == 2) {
blue = (unsigned char)(15. * db);
if(col < width) {
gl2psGetRGB(im, col, row, &dr, &dg, &db);
- }
+ }
else {
dr = dg = db = 0;
}
@@ -2596,7 +2622,7 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
nbyte = width * 3;
gl2psPrintf("/rgbstr %d string def\n", nbyte);
gl2psPrintf("%d %d %d\n", width, height, 8);
- gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height);
+ gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height);
gl2psPrintf("{ currentfile rgbstr readhexstring pop }\n");
gl2psPrintf("false 3\n");
gl2psPrintf("colorimage\n");
@@ -2613,7 +2639,7 @@ static void gl2psPrintPostScriptPixmap(GLfloat x, GLfloat y, GL2PSimage *im)
gl2psPrintf("\n");
}
}
-
+
gl2psPrintf("grestore\n");
}
@@ -2621,14 +2647,14 @@ static void gl2psPrintPostScriptImagemap(GLfloat x, GLfloat y,
GLsizei width, GLsizei height,
const unsigned char *imagemap){
int i, size;
-
+
if((width <= 0) || (height <= 0)) return;
-
- size = height + height * (width-1)/8;
-
+
+ size = height + height * (width - 1) / 8;
+
gl2psPrintf("gsave\n");
gl2psPrintf("%.2f %.2f translate\n", x, y);
- gl2psPrintf("%d %d scale\n%d %d\ntrue\n", width, height,width, height);
+ gl2psPrintf("%d %d scale\n%d %d\ntrue\n", width, height,width, height);
gl2psPrintf("[ %d 0 0 -%d 0 %d ] {<", width, height);
for(i = 0; i < size; i++){
gl2psWriteByte(*imagemap);
@@ -2662,7 +2688,7 @@ static void gl2psPrintPostScriptHeader(void)
"%%%%LanguageLevel: 3\n"
"%%%%DocumentData: Clean7Bit\n"
"%%%%Pages: 1\n",
- gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION,
+ gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION,
GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT,
gl2ps->producer, ctime(&now));
@@ -2671,18 +2697,18 @@ static void gl2psPrintPostScriptHeader(void)
"%%%%DocumentMedia: Default %d %d 0 () ()\n",
(gl2ps->options & GL2PS_LANDSCAPE) ? "Landscape" : "Portrait",
(gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] :
- (int)gl2ps->viewport[2],
- (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] :
+ (int)gl2ps->viewport[2],
+ (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] :
(int)gl2ps->viewport[3]);
}
gl2psPrintf("%%%%BoundingBox: %d %d %d %d\n"
"%%%%EndComments\n",
- (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[1] :
+ (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[1] :
(int)gl2ps->viewport[0],
(gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[0] :
(int)gl2ps->viewport[1],
- (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] :
+ (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] :
(int)gl2ps->viewport[2],
(gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] :
(int)gl2ps->viewport[3]);
@@ -2730,7 +2756,7 @@ static void gl2psPrintPostScriptHeader(void)
/* rotated text routines: same nameanem with R appended */
gl2psPrintf("/FCT { FC translate 0 0 } BD\n"
- "/SR { gsave FCT moveto rotate show grestore } BD\n"
+ "/SR { gsave FCT moveto rotate show grestore } BD\n"
"/SBCR{ gsave FCT moveto rotate SW -2 div 0 rmoveto show grestore } BD\n"
"/SBRR{ gsave FCT moveto rotate SW neg 0 rmoveto show grestore } BD\n"
"/SCLR{ gsave FCT moveto rotate 0 SH -2 div rmoveto show grestore} BD\n");
@@ -2745,7 +2771,7 @@ static void gl2psPrintPostScriptHeader(void)
"/L { lineto } BD\n"
"/LE { lineto stroke } BD\n"
"/T { newpath moveto lineto lineto closepath fill } BD\n");
-
+
/* Smooth-shaded triangle with PostScript level 3 shfill operator:
x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STshfill */
@@ -2799,11 +2825,11 @@ static void gl2psPrintPostScriptHeader(void)
" 4 index 10 index add 0.5 mul\n" /* g12 = (g1+g2)/2 */
" 4 index 10 index add 0.5 mul\n" /* b12 = (b1+b2)/2 */
" 5 copy 5 copy 40 5 roll 25 5 roll 15 5 roll 25 5 roll\n");
-
+
/* stack = (V3) (V13) (V23) (V13) (V12) (V23) (V13) (V1) (V12) (V23) (V12) (V2) */
gl2psPrintf(" STnoshfill STnoshfill STnoshfill STnoshfill } BD\n");
-
+
/* Gouraud shaded triangle using recursive subdivision until the difference
between corner colors does not exceed the thresholds:
x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STnoshfill */
@@ -2837,7 +2863,7 @@ static void gl2psPrintPostScriptHeader(void)
" ifelse }\n"
" ifelse }\n"
" ifelse } BD\n");
-
+
gl2psPrintf("tryPS3shading\n"
"{ /shfill where\n"
" { /ST { STshfill } BD }\n"
@@ -2854,7 +2880,7 @@ static void gl2psPrintPostScriptHeader(void)
"%%%%EndSetup\n"
"%%%%Page: 1 1\n"
"%%%%BeginPageSetup\n");
-
+
if(gl2ps->options & GL2PS_LANDSCAPE){
gl2psPrintf("%d 0 translate 90 rotate\n",
(int)gl2ps->viewport[3]);
@@ -2864,14 +2890,14 @@ static void gl2psPrintPostScriptHeader(void)
"mark\n"
"gsave\n"
"1.0 1.0 scale\n");
-
+
if(gl2ps->options & GL2PS_DRAW_BACKGROUND){
gl2psPrintf("%g %g %g C\n"
"newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n"
"closepath fill\n",
- gl2ps->bgcolor[0], gl2ps->bgcolor[1], gl2ps->bgcolor[2],
- (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2],
- (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3],
+ gl2ps->bgcolor[0], gl2ps->bgcolor[1], gl2ps->bgcolor[2],
+ (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2],
+ (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3],
(int)gl2ps->viewport[0], (int)gl2ps->viewport[3]);
}
}
@@ -2901,10 +2927,12 @@ static void gl2psEndPostScriptLine(void)
}
}
-static void gl2psParseStipplePattern(GLushort pattern, GLint factor,
+static void gl2psParseStipplePattern(GLushort pattern, GLint factor,
int *nb, int array[10])
{
- int i, n, on[5] = {0, 0, 0, 0, 0}, off[5] = {0, 0, 0, 0, 0};
+ int i, n;
+ int on[8] = {0, 0, 0, 0, 0, 0, 0, 0};
+ int off[8] = {0, 0, 0, 0, 0, 0, 0, 0};
char tmp[16];
/* extract the 16 bits from the OpenGL stipple pattern */
@@ -2912,35 +2940,37 @@ static void gl2psParseStipplePattern(GLushort pattern, GLint factor,
tmp[n] = (char)(pattern & 0x01);
pattern >>= 1;
}
- /* compute the on/off pixel sequence (since the PostScript
- specification allows for at most 11 elements in the on/off array,
- we limit ourselves to 5 couples of on/off states) */
+ /* compute the on/off pixel sequence */
n = 0;
- for(i = 0; i < 5; i++){
+ for(i = 0; i < 8; i++){
while(n < 16 && !tmp[n]){ off[i]++; n++; }
while(n < 16 && tmp[n]){ on[i]++; n++; }
- if(n >= 15) break;
+ if(n >= 15){ i++; break; }
}
+
/* store the on/off array from right to left, starting with off
- pixels (the longest possible array is: [on4 off4 on3 off3 on2
- off2 on1 off1 on0 off0]) */
+ pixels. The PostScript specification allows for at most 11
+ elements in the on/off array, so we limit ourselves to 5 on/off
+ couples (our longest possible array is thus [on4 off4 on3 off3
+ on2 off2 on1 off1 on0 off0]) */
*nb = 0;
- for(n = i; n >= 0; n--){
+ for(n = i - 1; n >= 0; n--){
array[(*nb)++] = factor * on[n];
array[(*nb)++] = factor * off[n];
+ if(*nb == 10) break;
}
}
-static int gl2psPrintPostScriptDash(GLushort pattern, GLint factor, char *str)
+static int gl2psPrintPostScriptDash(GLushort pattern, GLint factor, const char *str)
{
int len = 0, i, n, array[10];
if(pattern == gl2ps->lastpattern && factor == gl2ps->lastfactor)
return 0;
-
+
gl2ps->lastpattern = pattern;
gl2ps->lastfactor = factor;
-
+
if(!pattern || !factor){
/* solid line */
len += gl2psPrintf("[] 0 %s\n", str);
@@ -2954,7 +2984,7 @@ static int gl2psPrintPostScriptDash(GLushort pattern, GLint factor, char *str)
}
len += gl2psPrintf("] 0 %s\n", str);
}
-
+
return len;
}
@@ -2977,7 +3007,7 @@ static void gl2psPrintPostScriptPrimitive(void *data)
switch(prim->type){
case GL2PS_POINT :
gl2psPrintPostScriptColor(prim->verts[0].rgba);
- gl2psPrintf("%g %g %g P\n",
+ gl2psPrintf("%g %g %g P\n",
prim->verts[0].xyz[0], prim->verts[0].xyz[1], 0.5 * prim->width);
break;
case GL2PS_LINE :
@@ -3112,7 +3142,7 @@ static void gl2psPrintPostScriptFooter(void)
static void gl2psPrintPostScriptBeginViewport(GLint viewport[4])
{
- GLint index;
+ GLint idx;
GLfloat rgba[4];
int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3];
@@ -3131,23 +3161,23 @@ static void gl2psPrintPostScriptBeginViewport(GLint viewport[4])
glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba);
}
else{
- glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index);
- rgba[0] = gl2ps->colormap[index][0];
- rgba[1] = gl2ps->colormap[index][1];
- rgba[2] = gl2ps->colormap[index][2];
+ glGetIntegerv(GL_INDEX_CLEAR_VALUE, &idx);
+ rgba[0] = gl2ps->colormap[idx][0];
+ rgba[1] = gl2ps->colormap[idx][1];
+ rgba[2] = gl2ps->colormap[idx][2];
rgba[3] = 1.0F;
}
gl2psPrintf("%g %g %g C\n"
"newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n"
"closepath fill\n",
- rgba[0], rgba[1], rgba[2],
+ rgba[0], rgba[1], rgba[2],
x, y, x+w, y, x+w, y+h, x, y+h);
}
-
+
gl2psPrintf("newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n"
"closepath clip\n",
x, y, x+w, y, x+w, y+h, x, y+h);
-
+
}
static GLint gl2psPrintPostScriptEndViewport(void)
@@ -3189,7 +3219,7 @@ static GL2PSbackend gl2psEPS = {
"Encapsulated Postscript"
};
-/*********************************************************************
+/*********************************************************************
*
* LaTeX routines
*
@@ -3202,7 +3232,7 @@ static void gl2psPrintTeXHeader(void)
int i;
if(gl2ps->filename && strlen(gl2ps->filename) < 256){
- for(i = strlen(gl2ps->filename)-1; i >= 0; i--){
+ for(i = (int)strlen(gl2ps->filename) - 1; i >= 0; i--){
if(gl2ps->filename[i] == '.'){
strncpy(name, gl2ps->filename, i);
name[i] = '\0';
@@ -3217,7 +3247,7 @@ static void gl2psPrintTeXHeader(void)
time(&now);
- fprintf(gl2ps->stream,
+ fprintf(gl2ps->stream,
"%% Title: %s\n"
"%% Creator: GL2PS %d.%d.%d%s, %s\n"
"%% For: %s\n"
@@ -3226,7 +3256,7 @@ static void gl2psPrintTeXHeader(void)
GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT,
gl2ps->producer, ctime(&now));
- fprintf(gl2ps->stream,
+ fprintf(gl2ps->stream,
"\\setlength{\\unitlength}{1pt}\n"
"\\begin{picture}(0,0)\n"
"\\includegraphics{%s}\n"
@@ -3244,10 +3274,13 @@ static void gl2psPrintTeXPrimitive(void *data)
switch(prim->type){
case GL2PS_TEXT :
- fprintf(gl2ps->stream, "\\fontsize{%d}{0}\n\\selectfont",
+ fprintf(gl2ps->stream, "\\fontsize{%d}{0}\n\\selectfont",
prim->data.text->fontsize);
- fprintf(gl2ps->stream, "\\put(%g,%g){\\makebox(0,0)",
+ fprintf(gl2ps->stream, "\\put(%g,%g)",
prim->verts[0].xyz[0], prim->verts[0].xyz[1]);
+ if(prim->data.text->angle)
+ fprintf(gl2ps->stream, "{\\rotatebox{%g}", prim->data.text->angle);
+ fprintf(gl2ps->stream, "{\\makebox(0,0)");
switch(prim->data.text->alignment){
case GL2PS_TEXT_C:
fprintf(gl2ps->stream, "{");
@@ -3278,8 +3311,6 @@ static void gl2psPrintTeXPrimitive(void *data)
fprintf(gl2ps->stream, "[bl]{");
break;
}
- if(prim->data.text->angle)
- fprintf(gl2ps->stream, "\\rotatebox{%g}{", prim->data.text->angle);
fprintf(gl2ps->stream, "\\textcolor[rgb]{%g,%g,%g}{{%s}}",
prim->verts[0].rgba[0], prim->verts[0].rgba[1], prim->verts[0].rgba[2],
prim->data.text->str);
@@ -3306,8 +3337,9 @@ static void gl2psPrintTeXFooter(void)
static void gl2psPrintTeXBeginViewport(GLint viewport[4])
{
+ (void) viewport; /* not used */
glRenderMode(GL_FEEDBACK);
-
+
if(gl2ps->header){
gl2psPrintTeXHeader();
gl2ps->header = GL_FALSE;
@@ -3336,7 +3368,7 @@ static GL2PSbackend gl2psTEX = {
"LaTeX text"
};
-/*********************************************************************
+/*********************************************************************
*
* PDF routines
*
@@ -3372,7 +3404,7 @@ static int gl2psPrintPDFStrokeColor(GL2PSrgba rgba)
static int gl2psPrintPDFFillColor(GL2PSrgba rgba)
{
int i, offs = 0;
-
+
for(i = 0; i < 3; ++i){
if(GL2PS_ZERO(rgba[i]))
offs += gl2psPrintf("%.0f ", 0.);
@@ -3397,44 +3429,65 @@ static int gl2psPrintPDFLineWidth(GLfloat lw)
static void gl2psPutPDFText(GL2PSstring *text, int cnt, GLfloat x, GLfloat y)
{
- gl2ps->streamlength +=
- gl2psPrintf("BT\n"
- "/F%d %d Tf\n"
- "%f %f Td\n"
- "(%s) Tj\n"
- "ET\n",
- cnt, text->fontsize, x, y, text->str);
+ GLfloat rad, crad, srad;
+
+ if(text->angle == 0.0F){
+ gl2ps->streamlength += gl2psPrintf
+ ("BT\n"
+ "/F%d %d Tf\n"
+ "%f %f Td\n"
+ "(%s) Tj\n"
+ "ET\n",
+ cnt, text->fontsize, x, y, text->str);
+ }
+ else{
+ rad = (GLfloat)(3.141593F * text->angle / 180.0F);
+ srad = (GLfloat)sin(rad);
+ crad = (GLfloat)cos(rad);
+ gl2ps->streamlength += gl2psPrintf
+ ("BT\n"
+ "/F%d %d Tf\n"
+ "%f %f %f %f %f %f Tm\n"
+ "(%s) Tj\n"
+ "ET\n",
+ cnt, text->fontsize, crad, srad, -srad, crad, x, y, text->str);
+ }
+}
+
+static void gl2psPutPDFSpecial(GL2PSstring *text)
+{
+ gl2ps->streamlength += gl2psPrintf("%s\n", text->str);
}
static void gl2psPutPDFImage(GL2PSimage *image, int cnt, GLfloat x, GLfloat y)
{
- gl2ps->streamlength +=
- gl2psPrintf("q\n"
- "%d 0 0 %d %f %f cm\n"
- "/Im%d Do\n"
- "Q\n",
- (int)image->width, (int)image->height, x, y, cnt);
+ gl2ps->streamlength += gl2psPrintf
+ ("q\n"
+ "%d 0 0 %d %f %f cm\n"
+ "/Im%d Do\n"
+ "Q\n",
+ (int)image->width, (int)image->height, x, y, cnt);
}
static void gl2psPDFstacksInit(void)
{
- gl2ps->objects_stack = 7 /* FIXED_XREF_ENTRIES */ + 1;
- gl2ps->extgs_stack = 0;
- gl2ps->font_stack = 0;
- gl2ps->im_stack = 0;
- gl2ps->trgroupobjects_stack = 0;
- gl2ps->shader_stack = 0;
- gl2ps->mshader_stack = 0;
+ gl2ps->objects_stack = 7 /* FIXED_XREF_ENTRIES */ + 1;
+ gl2ps->extgs_stack = 0;
+ gl2ps->font_stack = 0;
+ gl2ps->im_stack = 0;
+ gl2ps->trgroupobjects_stack = 0;
+ gl2ps->shader_stack = 0;
+ gl2ps->mshader_stack = 0;
}
static void gl2psPDFgroupObjectInit(GL2PSpdfgroup *gro)
{
if(!gro)
return;
-
+
gro->ptrlist = NULL;
- gro->fontno = gro->gsno = gro->imno = gro->maskshno = gro->shno
- = gro->trgroupno = gro->fontobjno = gro->imobjno = gro->shobjno
+ gro->fontno = gro->gsno = gro->imno = gro->maskshno = gro->shno
+ = gro->trgroupno = gro->fontobjno = gro->imobjno = gro->shobjno
= gro->maskshobjno = gro->gsobjno = gro->trgroupobjno = -1;
}
@@ -3459,7 +3512,7 @@ static void gl2psPDFgroupListInit(void)
gl2ps->pdfgrouplist = gl2psListCreate(500, 500, sizeof(GL2PSpdfgroup));
gl2psInitTriangle(&lastt);
- for(i = 0; i < gl2psListNbr(gl2ps->pdfprimlist); ++i){
+ for(i = 0; i < gl2psListNbr(gl2ps->pdfprimlist); ++i){
p = *(GL2PSprimitive**)gl2psListPointer(gl2ps->pdfprimlist, i);
switch(p->type){
case GL2PS_PIXMAP:
@@ -3477,7 +3530,7 @@ static void gl2psPDFgroupListInit(void)
gl2psListAdd(gl2ps->pdfgrouplist, &gro);
break;
case GL2PS_LINE:
- if(lasttype != p->type || lastwidth != p->width ||
+ if(lasttype != p->type || lastwidth != p->width ||
lastpattern != p->pattern || lastfactor != p->factor ||
!gl2psSameColor(p->verts[0].rgba, lastrgba)){
gl2psPDFgroupObjectInit(&gro);
@@ -3496,7 +3549,7 @@ static void gl2psPDFgroupListInit(void)
lastrgba[2] = p->verts[0].rgba[2];
break;
case GL2PS_POINT:
- if(lasttype != p->type || lastwidth != p->width ||
+ if(lasttype != p->type || lastwidth != p->width ||
!gl2psSameColor(p->verts[0].rgba, lastrgba)){
gl2psPDFgroupObjectInit(&gro);
gro.ptrlist = gl2psListCreate(1,2,sizeof(GL2PSprimitive*));
@@ -3513,12 +3566,12 @@ static void gl2psPDFgroupListInit(void)
break;
case GL2PS_TRIANGLE:
gl2psFillTriangleFromPrimitive(&tmpt, p, GL_TRUE);
- lastTriangleWasNotSimpleWithSameColor =
+ lastTriangleWasNotSimpleWithSameColor =
!(tmpt.prop & T_CONST_COLOR && tmpt.prop & T_ALPHA_1) ||
!gl2psSameColor(tmpt.vertex[0].rgba, lastt.vertex[0].rgba);
- if(lasttype == p->type && tmpt.prop == lastt.prop &&
+ if(lasttype == p->type && tmpt.prop == lastt.prop &&
lastTriangleWasNotSimpleWithSameColor){
- /* TO-DO Check here for last alpha */
+ /* Check here for last alpha */
gl2psListAdd(gro.ptrlist, &p);
}
else{
@@ -3529,9 +3582,15 @@ static void gl2psPDFgroupListInit(void)
}
lastt = tmpt;
break;
+ case GL2PS_SPECIAL:
+ gl2psPDFgroupObjectInit(&gro);
+ gro.ptrlist = gl2psListCreate(1, 2, sizeof(GL2PSprimitive*));
+ gl2psListAdd(gro.ptrlist, &p);
+ gl2psListAdd(gl2ps->pdfgrouplist, &gro);
+ break;
default:
break;
- }
+ }
lasttype = p->type;
}
}
@@ -3540,7 +3599,7 @@ static void gl2psSortOutTrianglePDFgroup(GL2PSpdfgroup *gro)
{
GL2PStriangle t;
GL2PSprimitive *prim = NULL;
-
+
if(!gro)
return;
@@ -3553,35 +3612,35 @@ static void gl2psSortOutTrianglePDFgroup(GL2PSpdfgroup *gro)
return;
gl2psFillTriangleFromPrimitive(&t, prim, GL_TRUE);
-
- if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){
- gro->gsno = gl2ps->extgs_stack++;
+
+ if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){
+ gro->gsno = gl2ps->extgs_stack++;
gro->gsobjno = gl2ps->objects_stack ++;
}
- else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){
+ else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){
gro->gsno = gl2ps->extgs_stack++;
gro->gsobjno = gl2ps->objects_stack++;
- gro->trgroupno = gl2ps->trgroupobjects_stack++;
+ gro->trgroupno = gl2ps->trgroupobjects_stack++;
gro->trgroupobjno = gl2ps->objects_stack++;
gro->maskshno = gl2ps->mshader_stack++;
gro->maskshobjno = gl2ps->objects_stack++;
}
- else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){
+ else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){
gro->shno = gl2ps->shader_stack++;
gro->shobjno = gl2ps->objects_stack++;
}
- else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){
+ else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){
gro->gsno = gl2ps->extgs_stack++;
gro->gsobjno = gl2ps->objects_stack++;
- gro->shno = gl2ps->shader_stack++;
+ gro->shno = gl2ps->shader_stack++;
gro->shobjno = gl2ps->objects_stack++;
}
- else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){
+ else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){
gro->gsno = gl2ps->extgs_stack++;
gro->gsobjno = gl2ps->objects_stack++;
- gro->shno = gl2ps->shader_stack++;
+ gro->shno = gl2ps->shader_stack++;
gro->shobjno = gl2ps->objects_stack++;
- gro->trgroupno = gl2ps->trgroupobjects_stack++;
+ gro->trgroupno = gl2ps->trgroupobjects_stack++;
gro->trgroupobjno = gl2ps->objects_stack++;
gro->maskshno = gl2ps->mshader_stack++;
gro->maskshobjno = gl2ps->objects_stack++;
@@ -3614,14 +3673,14 @@ static void gl2psPDFgroupListWriteMainStream(void)
gl2ps->streamlength += gl2psPrintf("1 J\n");
gl2ps->streamlength += gl2psPrintPDFLineWidth(prim->width);
gl2ps->streamlength += gl2psPrintPDFStrokeColor(prim->verts[0].rgba);
- for(j = 0; j <= lastel; ++j){
+ for(j = 0; j <= lastel; ++j){
prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
gl2ps->streamlength +=
gl2psPrintf("%f %f m %f %f l\n",
prim->verts[0].xyz[0], prim->verts[0].xyz[1],
prim->verts[0].xyz[0], prim->verts[0].xyz[1]);
}
- gl2ps->streamlength += gl2psPrintf("S\n");
+ gl2ps->streamlength += gl2psPrintf("S\n");
gl2ps->streamlength += gl2psPrintf("0 J\n");
break;
case GL2PS_LINE:
@@ -3632,10 +3691,10 @@ static void gl2psPDFgroupListWriteMainStream(void)
gl2ps->streamlength += gl2psPrintPDFStrokeColor(prim->verts[0].rgba);
gl2ps->streamlength += gl2psPrintPostScriptDash(prim->pattern, prim->factor, "d");
/* start new path */
- gl2ps->streamlength +=
- gl2psPrintf("%f %f m\n",
+ gl2ps->streamlength +=
+ gl2psPrintf("%f %f m\n",
prim->verts[0].xyz[0], prim->verts[0].xyz[1]);
-
+
for(j = 1; j <= lastel; ++j){
prev = prim;
prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
@@ -3643,38 +3702,38 @@ static void gl2psPDFgroupListWriteMainStream(void)
/* the starting point of the new segment does not match the
end point of the previous line, so we end the current
path and start a new one */
- gl2ps->streamlength +=
- gl2psPrintf("%f %f l\n",
+ gl2ps->streamlength +=
+ gl2psPrintf("%f %f l\n",
prev->verts[1].xyz[0], prev->verts[1].xyz[1]);
- gl2ps->streamlength +=
- gl2psPrintf("%f %f m\n",
+ gl2ps->streamlength +=
+ gl2psPrintf("%f %f m\n",
prim->verts[0].xyz[0], prim->verts[0].xyz[1]);
}
else{
/* the two segements are connected, so we just append to the
current path */
- gl2ps->streamlength +=
+ gl2ps->streamlength +=
gl2psPrintf("%f %f l\n",
prim->verts[0].xyz[0], prim->verts[0].xyz[1]);
}
}
/* end last path */
- gl2ps->streamlength +=
- gl2psPrintf("%f %f l\n",
+ gl2ps->streamlength +=
+ gl2psPrintf("%f %f l\n",
prim->verts[1].xyz[0], prim->verts[1].xyz[1]);
gl2ps->streamlength += gl2psPrintf("S\n");
break;
case GL2PS_TRIANGLE:
gl2psFillTriangleFromPrimitive(&t, prim, GL_TRUE);
gl2psSortOutTrianglePDFgroup(gro);
-
+
/* No alpha and const color: Simple PDF draw orders */
- if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_1){
- gl2ps->streamlength += gl2psPrintPDFFillColor(t.vertex[0].rgba);
- for(j = 0; j <= lastel; ++j){
+ if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_1){
+ gl2ps->streamlength += gl2psPrintPDFFillColor(t.vertex[0].rgba);
+ for(j = 0; j <= lastel; ++j){
prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE);
- gl2ps->streamlength
+ gl2ps->streamlength
+= gl2psPrintf("%f %f m\n"
"%f %f l\n"
"%f %f l\n"
@@ -3684,17 +3743,17 @@ static void gl2psPDFgroupListWriteMainStream(void)
t.vertex[2].xyz[0], t.vertex[2].xyz[1]);
}
}
- /* Const alpha < 1 and const color: Simple PDF draw orders
+ /* Const alpha < 1 and const color: Simple PDF draw orders
and an extra extended Graphics State for the alpha const */
- else if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){
+ else if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){
gl2ps->streamlength += gl2psPrintf("q\n"
"/GS%d gs\n",
gro->gsno);
gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba);
- for(j = 0; j <= lastel; ++j){
+ for(j = 0; j <= lastel; ++j){
prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE);
- gl2ps->streamlength
+ gl2ps->streamlength
+= gl2psPrintf("%f %f m\n"
"%f %f l\n"
"%f %f l\n"
@@ -3705,19 +3764,19 @@ static void gl2psPDFgroupListWriteMainStream(void)
}
gl2ps->streamlength += gl2psPrintf("Q\n");
}
- /* Variable alpha and const color: Simple PDF draw orders
- and an extra extended Graphics State + Xobject + Shader
+ /* Variable alpha and const color: Simple PDF draw orders
+ and an extra extended Graphics State + Xobject + Shader
object for the alpha mask */
- else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){
+ else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){
gl2ps->streamlength += gl2psPrintf("q\n"
"/GS%d gs\n"
"/TrG%d Do\n",
gro->gsno, gro->trgroupno);
gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba);
- for(j = 0; j <= lastel; ++j){
+ for(j = 0; j <= lastel; ++j){
prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE);
- gl2ps->streamlength
+ gl2ps->streamlength
+= gl2psPrintf("%f %f m\n"
"%f %f l\n"
"%f %f l\n"
@@ -3730,23 +3789,23 @@ static void gl2psPDFgroupListWriteMainStream(void)
}
/* Variable color and no alpha: Shader Object for the colored
triangle(s) */
- else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){
+ else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){
gl2ps->streamlength += gl2psPrintf("/Sh%d sh\n", gro->shno);
}
- /* Variable color and const alpha < 1: Shader Object for the
- colored triangle(s) and an extra extended Graphics State
+ /* Variable color and const alpha < 1: Shader Object for the
+ colored triangle(s) and an extra extended Graphics State
for the alpha const */
- else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){
+ else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){
gl2ps->streamlength += gl2psPrintf("q\n"
"/GS%d gs\n"
"/Sh%d sh\n"
"Q\n",
gro->gsno, gro->shno);
}
- /* Variable alpha and color: Shader Object for the colored
- triangle(s) and an extra extended Graphics State
+ /* Variable alpha and color: Shader Object for the colored
+ triangle(s) and an extra extended Graphics State
+ Xobject + Shader object for the alpha mask */
- else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){
+ else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){
gl2ps->streamlength += gl2psPrintf("q\n"
"/GS%d gs\n"
"/TrG%d Do\n"
@@ -3758,21 +3817,26 @@ static void gl2psPDFgroupListWriteMainStream(void)
case GL2PS_PIXMAP:
for(j = 0; j <= lastel; ++j){
prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
- gl2psPutPDFImage(prim->data.image, gro->imno, prim->verts[0].xyz[0],
+ gl2psPutPDFImage(prim->data.image, gro->imno, prim->verts[0].xyz[0],
prim->verts[0].xyz[1]);
}
break;
case GL2PS_TEXT:
- for(j = 0; j <= lastel; ++j){
+ for(j = 0; j <= lastel; ++j){
prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba);
gl2psPutPDFText(prim->data.text, gro->fontno, prim->verts[0].xyz[0],
prim->verts[0].xyz[1]);
}
break;
+ case GL2PS_SPECIAL:
+ for(j = 0; j <= lastel; ++j){
+ prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
+ gl2psPutPDFSpecial(prim->data.text);
+ }
default:
break;
- }
+ }
}
}
@@ -3785,15 +3849,15 @@ static int gl2psPDFgroupListWriteGStateResources(void)
int i;
offs += fprintf(gl2ps->stream,
- "/ExtGState\n"
+ "/ExtGState\n"
"<<\n"
"/GSa 7 0 R\n");
- for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
- gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
+ for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
+ gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
if(gro->gsno >= 0)
offs += fprintf(gl2ps->stream, "/GS%d %d 0 R\n", gro->gsno, gro->gsobjno);
}
- offs += fprintf(gl2ps->stream, ">>\n");
+ offs += fprintf(gl2ps->stream, ">>\n");
return offs;
}
@@ -3808,14 +3872,14 @@ static int gl2psPDFgroupListWriteShaderResources(void)
offs += fprintf(gl2ps->stream,
"/Shading\n"
"<<\n");
- for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
- gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
+ for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
+ gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
if(gro->shno >= 0)
offs += fprintf(gl2ps->stream, "/Sh%d %d 0 R\n", gro->shno, gro->shobjno);
if(gro->maskshno >= 0)
offs += fprintf(gl2ps->stream, "/TrSh%d %d 0 R\n", gro->maskshno, gro->maskshobjno);
}
- offs += fprintf(gl2ps->stream,">>\n");
+ offs += fprintf(gl2ps->stream,">>\n");
return offs;
}
@@ -3832,8 +3896,8 @@ static int gl2psPDFgroupListWriteXObjectResources(void)
"/XObject\n"
"<<\n");
- for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
- gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
+ for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
+ gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
if(!gl2psListNbr(gro->ptrlist))
continue;
p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0);
@@ -3865,8 +3929,8 @@ static int gl2psPDFgroupListWriteFontResources(void)
offs += fprintf(gl2ps->stream, "/Font\n<<\n");
- for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
- gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
+ for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
+ gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
if(gro->fontno < 0)
continue;
gro->fontobjno = gl2ps->objects_stack++;
@@ -3881,11 +3945,11 @@ static void gl2psPDFgroupListDelete(void)
{
int i;
GL2PSpdfgroup *gro = NULL;
-
+
if(!gl2ps->pdfgrouplist)
return;
- for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
+ for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist,i);
gl2psListDelete(gro->ptrlist);
}
@@ -3901,10 +3965,10 @@ static int gl2psPrintPDFInfo(void)
int offs;
time_t now;
struct tm *newtime;
-
+
time(&now);
newtime = gmtime(&now);
-
+
offs = fprintf(gl2ps->stream,
"1 0 obj\n"
"<<\n"
@@ -3914,20 +3978,20 @@ static int gl2psPrintPDFInfo(void)
gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION,
GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT,
gl2ps->producer);
-
+
if(!newtime){
- offs += fprintf(gl2ps->stream,
+ offs += fprintf(gl2ps->stream,
">>\n"
"endobj\n");
return offs;
}
-
- offs += fprintf(gl2ps->stream,
+
+ offs += fprintf(gl2ps->stream,
"/CreationDate (D:%d%02d%02d%02d%02d%02d)\n"
">>\n"
"endobj\n",
- newtime->tm_year+1900,
- newtime->tm_mon+1,
+ newtime->tm_year+1900,
+ newtime->tm_mon+1,
newtime->tm_mday,
newtime->tm_hour,
newtime->tm_min,
@@ -3939,7 +4003,7 @@ static int gl2psPrintPDFInfo(void)
static int gl2psPrintPDFCatalog(void)
{
- return fprintf(gl2ps->stream,
+ return fprintf(gl2ps->stream,
"2 0 obj\n"
"<<\n"
"/Type /Catalog\n"
@@ -3950,9 +4014,9 @@ static int gl2psPrintPDFCatalog(void)
static int gl2psPrintPDFPages(void)
{
- return fprintf(gl2ps->stream,
+ return fprintf(gl2ps->stream,
"3 0 obj\n"
- "<<\n"
+ "<<\n"
"/Type /Pages\n"
"/Kids [6 0 R]\n"
"/Count 1\n"
@@ -3965,13 +4029,13 @@ static int gl2psPrintPDFPages(void)
static int gl2psOpenPDFDataStream(void)
{
int offs = 0;
-
- offs += fprintf(gl2ps->stream,
+
+ offs += fprintf(gl2ps->stream,
"4 0 obj\n"
- "<<\n"
+ "<<\n"
"/Length 5 0 R\n" );
offs += gl2psPrintPDFCompressorType();
- offs += fprintf(gl2ps->stream,
+ offs += fprintf(gl2ps->stream,
">>\n"
"stream\n");
return offs;
@@ -3984,13 +4048,13 @@ static int gl2psOpenPDFDataStreamWritePreface(void)
int offs;
offs = gl2psPrintf("/GSa gs\n");
-
+
if(gl2ps->options & GL2PS_DRAW_BACKGROUND){
offs += gl2psPrintPDFFillColor(gl2ps->bgcolor);
offs += gl2psPrintf("%d %d %d %d re\n",
(int)gl2ps->viewport[0], (int)gl2ps->viewport[1],
(int)gl2ps->viewport[2], (int)gl2ps->viewport[3]);
- offs += gl2psPrintf("f\n");
+ offs += gl2psPrintf("f\n");
}
return offs;
}
@@ -4003,26 +4067,26 @@ static void gl2psPrintPDFHeader(void)
gl2ps->pdfprimlist = gl2psListCreate(500, 500, sizeof(GL2PSprimitive*));
gl2psPDFstacksInit();
- gl2ps->xreflist = (int*)gl2psMalloc(sizeof(int) * gl2ps->objects_stack);
+ gl2ps->xreflist = (int*)gl2psMalloc(sizeof(int) * gl2ps->objects_stack);
#if defined(GL2PS_HAVE_ZLIB)
if(gl2ps->options & GL2PS_COMPRESS){
gl2psSetupCompress();
}
-#endif
+#endif
gl2ps->xreflist[0] = 0;
offs += fprintf(gl2ps->stream, "%%PDF-1.4\n");
gl2ps->xreflist[1] = offs;
-
+
offs += gl2psPrintPDFInfo();
gl2ps->xreflist[2] = offs;
-
+
offs += gl2psPrintPDFCatalog();
gl2ps->xreflist[3] = offs;
-
+
offs += gl2psPrintPDFPages();
gl2ps->xreflist[4] = offs;
-
+
offs += gl2psOpenPDFDataStream();
gl2ps->xreflist[5] = offs; /* finished in gl2psPrintPDFFooter */
gl2ps->streamlength = gl2psOpenPDFDataStreamWritePreface();
@@ -4034,7 +4098,7 @@ static void gl2psPrintPDFPrimitive(void *data)
{
GL2PSprimitive *prim = *(GL2PSprimitive**)data;
- if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled)
+ if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled)
return;
prim = gl2psCopyPrimitive(prim); /* deep copy */
@@ -4046,7 +4110,7 @@ static void gl2psPrintPDFPrimitive(void *data)
static int gl2psClosePDFDataStream(void)
{
int offs = 0;
-
+
#if defined(GL2PS_HAVE_ZLIB)
if(gl2ps->options & GL2PS_COMPRESS){
if(Z_OK != gl2psDeflate())
@@ -4054,13 +4118,13 @@ static int gl2psClosePDFDataStream(void)
else
fwrite(gl2ps->compress->dest, gl2ps->compress->destLen, 1, gl2ps->stream);
gl2ps->streamlength += gl2ps->compress->destLen;
-
+
offs += gl2ps->streamlength;
gl2psFreeCompress();
}
-#endif
-
- offs += fprintf(gl2ps->stream,
+#endif
+
+ offs += fprintf(gl2ps->stream,
"endstream\n"
"endobj\n");
return offs;
@@ -4081,27 +4145,27 @@ static int gl2psPrintPDFDataStreamLength(int val)
static int gl2psPrintPDFOpenPage(void)
{
int offs;
-
+
/* Write fixed part */
-
- offs = fprintf(gl2ps->stream,
+
+ offs = fprintf(gl2ps->stream,
"6 0 obj\n"
- "<<\n"
+ "<<\n"
"/Type /Page\n"
"/Parent 3 0 R\n"
"/MediaBox [%d %d %d %d]\n",
(int)gl2ps->viewport[0], (int)gl2ps->viewport[1],
(int)gl2ps->viewport[2], (int)gl2ps->viewport[3]);
-
+
if(gl2ps->options & GL2PS_LANDSCAPE)
offs += fprintf(gl2ps->stream, "/Rotate -90\n");
-
+
offs += fprintf(gl2ps->stream,
"/Contents 4 0 R\n"
- "/Resources\n"
- "<<\n"
+ "/Resources\n"
+ "<<\n"
"/ProcSet [/PDF /Text /ImageB /ImageC] %%/ImageI\n");
-
+
return offs;
/* End fixed part, proceeds in gl2psPDFgroupListWriteVariableResources() */
@@ -4110,19 +4174,19 @@ static int gl2psPrintPDFOpenPage(void)
static int gl2psPDFgroupListWriteVariableResources(void)
{
int offs = 0;
-
+
/* a) Graphics States for shader alpha masks*/
- offs += gl2psPDFgroupListWriteGStateResources();
-
- /* b) Shader and shader masks */
- offs += gl2psPDFgroupListWriteShaderResources();
-
+ offs += gl2psPDFgroupListWriteGStateResources();
+
+ /* b) Shader and shader masks */
+ offs += gl2psPDFgroupListWriteShaderResources();
+
/* c) XObjects (Images & Shader Masks) */
offs += gl2psPDFgroupListWriteXObjectResources();
-
+
/* d) Fonts */
offs += gl2psPDFgroupListWriteFontResources();
-
+
/* End resources and page */
offs += fprintf(gl2ps->stream,
">>\n"
@@ -4153,10 +4217,9 @@ static int gl2psPrintPDFGSObject(void)
/* Put vertex' edge flag (8bit) and coordinates (32bit) in shader stream */
-static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex,
- size_t (*action)(unsigned long data,
- size_t size),
- GLfloat dx, GLfloat dy,
+static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex,
+ int (*action)(unsigned long data, int size),
+ GLfloat dx, GLfloat dy,
GLfloat xmin, GLfloat ymin)
{
int offs = 0;
@@ -4172,8 +4235,8 @@ static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex,
/* The Shader stream in PDF requires to be in a 'big-endian'
order */
-
- if(GL2PS_ZERO(dx*dy)){
+
+ if(GL2PS_ZERO(dx * dy)){
offs += (*action)(0, 4);
offs += (*action)(0, 4);
}
@@ -4185,7 +4248,7 @@ static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex,
diff = 0.0F;
imap = (unsigned long)(diff * dmax);
offs += (*action)(imap, 4);
-
+
diff = (vertex->xyz[1] - ymin) / dy;
if(diff > 1)
diff = 1.0F;
@@ -4194,15 +4257,14 @@ static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex,
imap = (unsigned long)(diff * dmax);
offs += (*action)(imap, 4);
}
-
+
return offs;
}
/* Put vertex' rgb value (8bit for every component) in shader stream */
static int gl2psPrintPDFShaderStreamDataRGB(GL2PSvertex *vertex,
- size_t (*action)(unsigned long data,
- size_t size))
+ int (*action)(unsigned long data, int size))
{
int offs = 0;
unsigned long imap;
@@ -4213,21 +4275,20 @@ static int gl2psPrintPDFShaderStreamDataRGB(GL2PSvertex *vertex,
imap = (unsigned long)((vertex->rgba[0]) * dmax);
offs += (*action)(imap, 1);
-
+
imap = (unsigned long)((vertex->rgba[1]) * dmax);
offs += (*action)(imap, 1);
-
+
imap = (unsigned long)((vertex->rgba[2]) * dmax);
offs += (*action)(imap, 1);
-
+
return offs;
}
/* Put vertex' alpha (8/16bit) in shader stream */
-static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex,
- size_t (*action)(unsigned long data,
- size_t size),
+static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex,
+ int (*action)(unsigned long data, int size),
int sigbyte)
{
int offs = 0;
@@ -4239,48 +4300,47 @@ static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex,
if(sigbyte != 8 && sigbyte != 16)
sigbyte = 8;
-
+
sigbyte /= 8;
-
+
imap = (unsigned long)((vertex->rgba[3]) * dmax);
-
+
offs += (*action)(imap, sigbyte);
-
+
return offs;
}
/* Put a triangles raw data in shader stream */
-static int gl2psPrintPDFShaderStreamData(GL2PStriangle *triangle,
- GLfloat dx, GLfloat dy,
+static int gl2psPrintPDFShaderStreamData(GL2PStriangle *triangle,
+ GLfloat dx, GLfloat dy,
GLfloat xmin, GLfloat ymin,
- size_t (*action)(unsigned long data,
- size_t size),
+ int (*action)(unsigned long data, int size),
int gray)
{
int i, offs = 0;
GL2PSvertex v;
-
+
if(gray && gray != 8 && gray != 16)
gray = 8;
-
+
for(i = 0; i < 3; ++i){
offs += gl2psPrintPDFShaderStreamDataCoord(&triangle->vertex[i], action,
dx, dy, xmin, ymin);
- if(gray){
+ if(gray){
v = triangle->vertex[i];
- offs += gl2psPrintPDFShaderStreamDataAlpha(&v, action, gray);
+ offs += gl2psPrintPDFShaderStreamDataAlpha(&v, action, gray);
}
else{
offs += gl2psPrintPDFShaderStreamDataRGB(&triangle->vertex[i], action);
}
}
-
+
return offs;
}
-static void gl2psPDFRectHull(GLfloat *xmin, GLfloat *xmax,
- GLfloat *ymin, GLfloat *ymax,
+static void gl2psPDFRectHull(GLfloat *xmin, GLfloat *xmax,
+ GLfloat *ymin, GLfloat *ymax,
GL2PStriangle *triangles, int cnt)
{
int i, j;
@@ -4289,7 +4349,7 @@ static void gl2psPDFRectHull(GLfloat *xmin, GLfloat *xmax,
*xmax = triangles[0].vertex[0].xyz[0];
*ymin = triangles[0].vertex[0].xyz[1];
*ymax = triangles[0].vertex[0].xyz[1];
-
+
for(i = 0; i < cnt; ++i){
for(j = 0; j < 3; ++j){
if(*xmin > triangles[i].vertex[j].xyz[0])
@@ -4304,17 +4364,17 @@ static void gl2psPDFRectHull(GLfloat *xmin, GLfloat *xmax,
}
}
-/* Writes shaded triangle
+/* Writes shaded triangle
gray == 0 means write RGB triangles
gray == 8 8bit-grayscale (for alpha masks)
gray == 16 16bit-grayscale (for alpha masks) */
-static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles,
+static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles,
int size, int gray)
{
int i, offs = 0, vertexbytes, done = 0;
GLfloat xmin, xmax, ymin, ymax;
-
+
switch(gray){
case 0:
vertexbytes = 1+4+4+1+1+1;
@@ -4330,9 +4390,9 @@ static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles,
vertexbytes = 1+4+4+1;
break;
}
-
+
gl2psPDFRectHull(&xmin, &xmax, &ymin, &ymax, triangles, size);
-
+
offs += fprintf(gl2ps->stream,
"%d 0 obj\n"
"<< "
@@ -4343,18 +4403,18 @@ static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles,
"/BitsPerFlag 8 "
"/Decode [%f %f %f %f 0 1 %s] ",
obj,
- (gray) ? "/DeviceGray" : "/DeviceRGB",
+ (gray) ? "/DeviceGray" : "/DeviceRGB",
(gray) ? gray : 8,
xmin, xmax, ymin, ymax,
(gray) ? "" : "0 1 0 1");
-
+
#if defined(GL2PS_HAVE_ZLIB)
if(gl2ps->options & GL2PS_COMPRESS){
gl2psAllocCompress(vertexbytes * size * 3);
for(i = 0; i < size; ++i)
gl2psPrintPDFShaderStreamData(&triangles[i],
- xmax-xmin, ymax-ymin, xmin, ymin,
+ xmax-xmin, ymax-ymin, xmin, ymin,
gl2psWriteBigEndianCompress, gray);
if(Z_OK == gl2psDeflate() && 23 + gl2ps->compress->destLen < gl2ps->compress->srcLen){
@@ -4364,8 +4424,8 @@ static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles,
">>\n"
"stream\n",
(int)gl2ps->compress->destLen);
- offs += gl2ps->compress->destLen * fwrite(gl2ps->compress->dest,
- gl2ps->compress->destLen,
+ offs += gl2ps->compress->destLen * fwrite(gl2ps->compress->dest,
+ gl2ps->compress->destLen,
1, gl2ps->stream);
done = 1;
}
@@ -4386,11 +4446,11 @@ static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles,
xmax-xmin, ymax-ymin, xmin, ymin,
gl2psWriteBigEndian, gray);
}
-
+
offs += fprintf(gl2ps->stream,
"\nendstream\n"
"endobj\n");
-
+
return offs;
}
@@ -4399,7 +4459,7 @@ static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles,
static int gl2psPrintPDFShaderMask(int obj, int childobj)
{
int offs = 0, len;
-
+
offs += fprintf(gl2ps->stream,
"%d 0 obj\n"
"<<\n"
@@ -4411,11 +4471,11 @@ static int gl2psPrintPDFShaderMask(int obj, int childobj)
obj,
(int)gl2ps->viewport[0], (int)gl2ps->viewport[1],
(int)gl2ps->viewport[2], (int)gl2ps->viewport[3]);
-
- len = (childobj>0)
+
+ len = (childobj>0)
? strlen("/TrSh sh\n") + (int)log10((double)childobj)+1
- : strlen("/TrSh0 sh\n");
-
+ : strlen("/TrSh0 sh\n");
+
offs += fprintf(gl2ps->stream,
"/Length %d\n"
">>\n"
@@ -4427,7 +4487,7 @@ static int gl2psPrintPDFShaderMask(int obj, int childobj)
offs += fprintf(gl2ps->stream,
"endstream\n"
"endobj\n");
-
+
return offs;
}
@@ -4438,16 +4498,16 @@ static int gl2psPrintPDFShaderMask(int obj, int childobj)
static int gl2psPrintPDFShaderExtGS(int obj, int childobj)
{
int offs = 0;
-
+
offs += fprintf(gl2ps->stream,
"%d 0 obj\n"
"<<\n",
obj);
-
+
offs += fprintf(gl2ps->stream,
"/SMask << /S /Alpha /G %d 0 R >> ",
childobj);
-
+
offs += fprintf(gl2ps->stream,
">>\n"
"endobj\n");
@@ -4459,7 +4519,7 @@ static int gl2psPrintPDFShaderExtGS(int obj, int childobj)
static int gl2psPrintPDFShaderSimpleExtGS(int obj, GLfloat alpha)
{
int offs = 0;
-
+
offs += fprintf(gl2ps->stream,
"%d 0 obj\n"
"<<\n"
@@ -4473,31 +4533,32 @@ static int gl2psPrintPDFShaderSimpleExtGS(int obj, GLfloat alpha)
/* Similar groups of functions for pixmaps and text */
static int gl2psPrintPDFPixmapStreamData(GL2PSimage *im,
- size_t (*action)(unsigned long data,
- size_t size),
+ int (*action)(unsigned long data, int size),
int gray)
{
- int x, y;
+ int x, y, shift;
GLfloat r, g, b, a;
if(im->format != GL_RGBA && gray)
return 0;
- if(gray && gray !=8 && gray != 16)
+ if(gray && gray != 8 && gray != 16)
gray = 8;
gray /= 8;
-
+
+ shift = (sizeof(unsigned long) - 1) * 8;
+
for(y = 0; y < im->height; ++y){
for(x = 0; x < im->width; ++x){
a = gl2psGetRGB(im, x, y, &r, &g, &b);
if(im->format == GL_RGBA && gray){
- (*action)((unsigned long)(a*255) << 24, gray);
+ (*action)((unsigned long)(a * 255) << shift, gray);
}
else{
- (*action)((unsigned long)(r*255) << 24, 1);
- (*action)((unsigned long)(g*255) << 24, 1);
- (*action)((unsigned long)(b*255) << 24, 1);
+ (*action)((unsigned long)(r * 255) << shift, 1);
+ (*action)((unsigned long)(g * 255) << shift, 1);
+ (*action)((unsigned long)(b * 255) << shift, 1);
}
}
}
@@ -4516,10 +4577,10 @@ static int gl2psPrintPDFPixmap(int obj, int childobj, GL2PSimage *im, int gray)
if(gray && gray !=8 && gray != 16)
gray = 8;
-
+
if(gray)
- sigbytes = gray / 8;
-
+ sigbytes = gray / 8;
+
offs += fprintf(gl2ps->stream,
"%d 0 obj\n"
"<<\n"
@@ -4537,13 +4598,13 @@ static int gl2psPrintPDFPixmap(int obj, int childobj, GL2PSimage *im, int gray)
"/SMask %d 0 R\n",
childobj);
}
-
+
#if defined(GL2PS_HAVE_ZLIB)
if(gl2ps->options & GL2PS_COMPRESS){
gl2psAllocCompress((int)(im->width * im->height * sigbytes));
-
+
gl2psPrintPDFPixmapStreamData(im, gl2psWriteBigEndianCompress, gray);
-
+
if(Z_OK == gl2psDeflate() && 23 + gl2ps->compress->destLen < gl2ps->compress->srcLen){
offs += gl2psPrintPDFCompressorType();
offs += fprintf(gl2ps->stream,
@@ -4558,7 +4619,7 @@ static int gl2psPrintPDFPixmap(int obj, int childobj, GL2PSimage *im, int gray)
gl2psFreeCompress();
}
#endif
-
+
if(!done){
/* no compression, or too long after compression, or compress error
-> write non-compressed entry */
@@ -4569,18 +4630,18 @@ static int gl2psPrintPDFPixmap(int obj, int childobj, GL2PSimage *im, int gray)
(int)(im->width * im->height * sigbytes));
offs += gl2psPrintPDFPixmapStreamData(im, gl2psWriteBigEndian, gray);
}
-
+
offs += fprintf(gl2ps->stream,
"\nendstream\n"
"endobj\n");
-
+
return offs;
}
static int gl2psPrintPDFText(int obj, GL2PSstring *s, int fontnumber)
{
int offs = 0;
-
+
offs += fprintf(gl2ps->stream,
"%d 0 obj\n"
"<<\n"
@@ -4608,9 +4669,9 @@ static int gl2psPDFgroupListWriteObjects(int entryoffs)
if(!gl2ps->pdfgrouplist)
return offs;
-
- for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
- gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
+
+ for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){
+ gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i);
if(!gl2psListNbr(gro->ptrlist))
continue;
p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0);
@@ -4622,7 +4683,7 @@ static int gl2psPDFgroupListWriteObjects(int entryoffs)
case GL2PS_TRIANGLE:
size = gl2psListNbr(gro->ptrlist);
triangles = (GL2PStriangle*)gl2psMalloc(sizeof(GL2PStriangle) * size);
- for(j = 0; j < size; ++j){
+ for(j = 0; j < size; ++j){
p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j);
gl2psFillTriangleFromPrimitive(&triangles[j], p, GL_TRUE);
}
@@ -4664,7 +4725,7 @@ static int gl2psPDFgroupListWriteObjects(int entryoffs)
break;
default:
break;
- }
+ }
}
return offs;
}
@@ -4675,29 +4736,29 @@ static int gl2psPDFgroupListWriteObjects(int entryoffs)
static void gl2psPrintPDFFooter(void)
{
- int i, offs;
+ int i, offs;
gl2psPDFgroupListInit();
gl2psPDFgroupListWriteMainStream();
-
- offs = gl2ps->xreflist[5] + gl2ps->streamlength;
+
+ offs = gl2ps->xreflist[5] + gl2ps->streamlength;
offs += gl2psClosePDFDataStream();
gl2ps->xreflist[5] = offs;
-
+
offs += gl2psPrintPDFDataStreamLength(gl2ps->streamlength);
gl2ps->xreflist[6] = offs;
gl2ps->streamlength = 0;
-
+
offs += gl2psPrintPDFOpenPage();
offs += gl2psPDFgroupListWriteVariableResources();
gl2ps->xreflist = (int*)gl2psRealloc(gl2ps->xreflist,
sizeof(int) * (gl2ps->objects_stack + 1));
gl2ps->xreflist[7] = offs;
-
+
offs += gl2psPrintPDFGSObject();
gl2ps->xreflist[8] = offs;
-
- gl2ps->xreflist[gl2ps->objects_stack] =
+
+ gl2ps->xreflist[gl2ps->objects_stack] =
gl2psPDFgroupListWriteObjects(gl2ps->xreflist[8]);
/* Start cross reference table. The file has to been opened in
@@ -4706,13 +4767,13 @@ static void gl2psPrintPDFFooter(void)
"xref\n"
"0 %d\n"
"%010d 65535 f \n", gl2ps->objects_stack, 0);
-
+
for(i = 1; i < gl2ps->objects_stack; ++i)
fprintf(gl2ps->stream, "%010d 00000 n \n", gl2ps->xreflist[i]);
-
+
fprintf(gl2ps->stream,
"trailer\n"
- "<<\n"
+ "<<\n"
"/Size %d\n"
"/Info 1 0 R\n"
"/Root 2 0 R\n"
@@ -4720,12 +4781,13 @@ static void gl2psPrintPDFFooter(void)
"startxref\n%d\n"
"%%%%EOF\n",
gl2ps->objects_stack, gl2ps->xreflist[gl2ps->objects_stack]);
-
- /* Free auxiliary lists and arrays */
+
+ /* Free auxiliary lists and arrays */
gl2psFree(gl2ps->xreflist);
+ gl2psListAction(gl2ps->pdfprimlist, gl2psFreePrimitive);
gl2psListDelete(gl2ps->pdfprimlist);
gl2psPDFgroupListDelete();
-
+
#if defined(GL2PS_HAVE_ZLIB)
if(gl2ps->options & GL2PS_COMPRESS){
gl2psFreeCompress();
@@ -4740,28 +4802,28 @@ static void gl2psPrintPDFFooter(void)
static void gl2psPrintPDFBeginViewport(GLint viewport[4])
{
int offs = 0;
- GLint index;
+ GLint idx;
GLfloat rgba[4];
int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3];
-
+
glRenderMode(GL_FEEDBACK);
-
+
if(gl2ps->header){
gl2psPrintPDFHeader();
gl2ps->header = GL_FALSE;
}
offs += gl2psPrintf("q\n");
-
+
if(gl2ps->options & GL2PS_DRAW_BACKGROUND){
if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){
glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba);
}
else{
- glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index);
- rgba[0] = gl2ps->colormap[index][0];
- rgba[1] = gl2ps->colormap[index][1];
- rgba[2] = gl2ps->colormap[index][2];
+ glGetIntegerv(GL_INDEX_CLEAR_VALUE, &idx);
+ rgba[0] = gl2ps->colormap[idx][0];
+ rgba[1] = gl2ps->colormap[idx][1];
+ rgba[2] = gl2ps->colormap[idx][2];
rgba[3] = 1.0F;
}
offs += gl2psPrintPDFFillColor(rgba);
@@ -4772,18 +4834,18 @@ static void gl2psPrintPDFBeginViewport(GLint viewport[4])
}
else{
offs += gl2psPrintf("%d %d %d %d re\n"
- "W\n"
+ "W\n"
"n\n",
- x, y, w, h);
+ x, y, w, h);
}
-
+
gl2ps->streamlength += offs;
}
static GLint gl2psPrintPDFEndViewport(void)
{
GLint res;
-
+
res = gl2psPrintPrimitives();
gl2ps->streamlength += gl2psPrintf("Q\n");
return res;
@@ -4806,13 +4868,13 @@ static GL2PSbackend gl2psPDF = {
"Portable Document Format"
};
-/*********************************************************************
+/*********************************************************************
*
* SVG routines
*
*********************************************************************/
-static void gl2psSVGGetCoordsAndColors(int n, GL2PSvertex *verts,
+static void gl2psSVGGetCoordsAndColors(int n, GL2PSvertex *verts,
GL2PSxyz *xyz, GL2PSrgba *rgba)
{
int i, j;
@@ -4839,29 +4901,34 @@ static void gl2psSVGGetColorString(GL2PSrgba rgba, char str[32])
static void gl2psPrintSVGHeader(void)
{
+ int x, y, width, height;
char col[32];
time_t now;
+ time(&now);
+
+ if (gl2ps->options & GL2PS_LANDSCAPE){
+ x = (int)gl2ps->viewport[1];
+ y = (int)gl2ps->viewport[0];
+ width = (int)gl2ps->viewport[3];
+ height = (int)gl2ps->viewport[2];
+ }
+ else{
+ x = (int)gl2ps->viewport[0];
+ y = (int)gl2ps->viewport[1];
+ width = (int)gl2ps->viewport[2];
+ height = (int)gl2ps->viewport[3];
+ }
+
/* Compressed SVG files (.svgz) are simply gzipped SVG files */
gl2psPrintGzipHeader();
- time(&now);
-
gl2psPrintf("<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n");
gl2psPrintf("<svg xmlns=\"http://www.w3.org/2000/svg\"\n");
- gl2psPrintf(" xmlns:xlink=\"http://www.w3.org/1999/xlink\"\n");
- gl2psPrintf(" viewBox=\"%d %d %d %d\">\n",
- (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[1] :
- (int)gl2ps->viewport[0],
- (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[0] :
- (int)gl2ps->viewport[1],
- (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] :
- (int)gl2ps->viewport[2],
- (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] :
- (int)gl2ps->viewport[3]);
- gl2psPrintf("<title>\n");
- gl2psPrintf("%s\n", gl2ps->title);
- gl2psPrintf("</title>\n");
+ gl2psPrintf(" xmlns:xlink=\"http://www.w3.org/1999/xlink\"\n"
+ " width=\"%dpx\" height=\"%dpx\" viewBox=\"%d %d %d %d\">\n",
+ width, height, x, y, width, height);
+ gl2psPrintf("<title>%s</title>\n", gl2ps->title);
gl2psPrintf("<desc>\n");
gl2psPrintf("Creator: GL2PS %d.%d.%d%s, %s\n"
"For: %s\n"
@@ -4875,13 +4942,14 @@ static void gl2psPrintSVGHeader(void)
if(gl2ps->options & GL2PS_DRAW_BACKGROUND){
gl2psSVGGetColorString(gl2ps->bgcolor, col);
gl2psPrintf("<polygon fill=\"%s\" points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n", col,
- (int)gl2ps->viewport[0], (int)gl2ps->viewport[1],
- (int)gl2ps->viewport[2], (int)gl2ps->viewport[1],
- (int)gl2ps->viewport[2], (int)gl2ps->viewport[3],
+ (int)gl2ps->viewport[0], (int)gl2ps->viewport[1],
+ (int)gl2ps->viewport[2], (int)gl2ps->viewport[1],
+ (int)gl2ps->viewport[2], (int)gl2ps->viewport[3],
(int)gl2ps->viewport[0], (int)gl2ps->viewport[3]);
}
- gl2psPrintf("<g>\n");
+ /* group all the primitives and disable antialiasing */
+ gl2psPrintf("<g shape-rendering=\"crispEdges\">\n");
}
static void gl2psPrintSVGSmoothTriangle(GL2PSxyz xyz[3], GL2PSrgba rgba[3])
@@ -4899,53 +4967,53 @@ static void gl2psPrintSVGSmoothTriangle(GL2PSxyz xyz[3], GL2PSrgba rgba[3])
gl2psSVGGetColorString(rgba[0], col);
gl2psPrintf("<polygon fill=\"%s\" ", col);
if(rgba[0][3] < 1.0F) gl2psPrintf("fill-opacity=\"%g\" ", rgba[0][3]);
- gl2psPrintf("points=\"%g,%g %g,%g %g,%g\"/>\n", xyz[0][0], xyz[0][1],
+ gl2psPrintf("points=\"%g,%g %g,%g %g,%g\"/>\n", xyz[0][0], xyz[0][1],
xyz[1][0], xyz[1][1], xyz[2][0], xyz[2][1]);
}
else{
/* subdivide into 4 subtriangles */
for(i = 0; i < 3; i++){
- xyz2[0][i] = xyz[0][i];
- xyz2[1][i] = 0.5 * (xyz[0][i] + xyz[1][i]);
- xyz2[2][i] = 0.5 * (xyz[0][i] + xyz[2][i]);
+ xyz2[0][i] = xyz[0][i];
+ xyz2[1][i] = 0.5F * (xyz[0][i] + xyz[1][i]);
+ xyz2[2][i] = 0.5F * (xyz[0][i] + xyz[2][i]);
}
for(i = 0; i < 4; i++){
- rgba2[0][i] = rgba[0][i];
- rgba2[1][i] = 0.5 * (rgba[0][i] + rgba[1][i]);
- rgba2[2][i] = 0.5 * (rgba[0][i] + rgba[2][i]);
+ rgba2[0][i] = rgba[0][i];
+ rgba2[1][i] = 0.5F * (rgba[0][i] + rgba[1][i]);
+ rgba2[2][i] = 0.5F * (rgba[0][i] + rgba[2][i]);
}
gl2psPrintSVGSmoothTriangle(xyz2, rgba2);
for(i = 0; i < 3; i++){
- xyz2[0][i] = 0.5 * (xyz[0][i] + xyz[1][i]);
- xyz2[1][i] = xyz[1][i];
- xyz2[2][i] = 0.5 * (xyz[1][i] + xyz[2][i]);
+ xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[1][i]);
+ xyz2[1][i] = xyz[1][i];
+ xyz2[2][i] = 0.5F * (xyz[1][i] + xyz[2][i]);
}
for(i = 0; i < 4; i++){
- rgba2[0][i] = 0.5 * (rgba[0][i] + rgba[1][i]);
- rgba2[1][i] = rgba[1][i];
- rgba2[2][i] = 0.5 * (rgba[1][i] + rgba[2][i]);
+ rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[1][i]);
+ rgba2[1][i] = rgba[1][i];
+ rgba2[2][i] = 0.5F * (rgba[1][i] + rgba[2][i]);
}
gl2psPrintSVGSmoothTriangle(xyz2, rgba2);
for(i = 0; i < 3; i++){
- xyz2[0][i] = 0.5 * (xyz[0][i] + xyz[2][i]);
- xyz2[1][i] = xyz[2][i];
- xyz2[2][i] = 0.5 * (xyz[1][i] + xyz[2][i]);
+ xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[2][i]);
+ xyz2[1][i] = xyz[2][i];
+ xyz2[2][i] = 0.5F * (xyz[1][i] + xyz[2][i]);
}
for(i = 0; i < 4; i++){
- rgba2[0][i] = 0.5 * (rgba[0][i] + rgba[2][i]);
- rgba2[1][i] = rgba[2][i];
- rgba2[2][i] = 0.5 * (rgba[1][i] + rgba[2][i]);
+ rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[2][i]);
+ rgba2[1][i] = rgba[2][i];
+ rgba2[2][i] = 0.5F * (rgba[1][i] + rgba[2][i]);
}
gl2psPrintSVGSmoothTriangle(xyz2, rgba2);
for(i = 0; i < 3; i++){
- xyz2[0][i] = 0.5 * (xyz[0][i] + xyz[1][i]);
- xyz2[1][i] = 0.5 * (xyz[1][i] + xyz[2][i]);
- xyz2[2][i] = 0.5 * (xyz[0][i] + xyz[2][i]);
+ xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[1][i]);
+ xyz2[1][i] = 0.5F * (xyz[1][i] + xyz[2][i]);
+ xyz2[2][i] = 0.5F * (xyz[0][i] + xyz[2][i]);
}
for(i = 0; i < 4; i++){
- rgba2[0][i] = 0.5 * (rgba[0][i] + rgba[1][i]);
- rgba2[1][i] = 0.5 * (rgba[1][i] + rgba[2][i]);
- rgba2[2][i] = 0.5 * (rgba[0][i] + rgba[2][i]);
+ rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[1][i]);
+ rgba2[1][i] = 0.5F * (rgba[1][i] + rgba[2][i]);
+ rgba2[2][i] = 0.5F * (rgba[0][i] + rgba[2][i]);
}
gl2psPrintSVGSmoothTriangle(xyz2, rgba2);
}
@@ -4970,7 +5038,7 @@ static void gl2psEndSVGLine(void)
{
int i;
if(gl2ps->lastvertex.rgba[0] >= 0.){
- gl2psPrintf("%g,%g\"/>\n", gl2ps->lastvertex.xyz[0],
+ gl2psPrintf("%g,%g\"/>\n", gl2ps->lastvertex.xyz[0],
gl2ps->viewport[3] - gl2ps->lastvertex.xyz[1]);
for(i = 0; i < 3; i++)
gl2ps->lastvertex.xyz[i] = -1.;
@@ -4992,7 +5060,7 @@ static void gl2psPrintSVGPixmap(GLfloat x, GLfloat y, GL2PSimage *pixmap)
file), we need to encode the pixmap into PNG in memory, then
encode it into base64. */
- png = gl2psListCreate(pixmap->width * pixmap->height * 3, 1000,
+ png = gl2psListCreate(pixmap->width * pixmap->height * 3, 1000,
sizeof(unsigned char));
gl2psConvertPixmapToPNG(pixmap, png);
gl2psListEncodeBase64(png);
@@ -5006,7 +5074,8 @@ static void gl2psPrintSVGPixmap(GLfloat x, GLfloat y, GL2PSimage *pixmap)
gl2psPrintf("\"/>\n");
gl2psListDelete(png);
#else
- gl2psMsg(GL2PS_WARNING, "GL2PS has to be compiled with PNG support in "
+ (void) x; (void) y; (void) pixmap; /* not used */
+ gl2psMsg(GL2PS_WARNING, "GL2PS must be compiled with PNG support in "
"order to embed images in SVG streams");
#endif
}
@@ -5061,7 +5130,7 @@ static void gl2psPrintSVGPrimitive(void *data)
gl2ps->lastfactor = prim->factor;
if(newline){
gl2psSVGGetColorString(rgba[0], col);
- gl2psPrintf("<polyline fill=\"none\" stroke=\"%s\" stroke-width=\"%g\" ",
+ gl2psPrintf("<polyline fill=\"none\" stroke=\"%s\" stroke-width=\"%g\" ",
col, prim->width);
if(rgba[0][3] < 1.0F) gl2psPrintf("stroke-opacity=\"%g\" ", rgba[0][3]);
gl2psPrintSVGDash(prim->pattern, prim->factor);
@@ -5082,12 +5151,70 @@ static void gl2psPrintSVGPrimitive(void *data)
break;
case GL2PS_TEXT :
gl2psSVGGetColorString(prim->verts[0].rgba, col);
- gl2psPrintf("<text fill=\"%s\" x=\"%g\" y=\"%g\" "
- "font-size=\"%d\" font-family=\"%s\">%s</text>\n",
- col, xyz[0][0], xyz[0][1],
- prim->data.text->fontsize,
- prim->data.text->fontname,
- prim->data.text->str);
+ gl2psPrintf("<text fill=\"%s\" x=\"%g\" y=\"%g\" font-size=\"%d\" ",
+ col, xyz[0][0], xyz[0][1], prim->data.text->fontsize);
+ if(prim->data.text->angle)
+ gl2psPrintf("transform=\"rotate(%g, %g, %g)\" ",
+ -prim->data.text->angle, xyz[0][0], xyz[0][1]);
+ switch(prim->data.text->alignment){
+ case GL2PS_TEXT_C:
+ gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"%d\" ",
+ -prim->data.text->fontsize / 2);
+ break;
+ case GL2PS_TEXT_CL:
+ gl2psPrintf("text-anchor=\"start\" baseline-shift=\"%d\" ",
+ -prim->data.text->fontsize / 2);
+ break;
+ case GL2PS_TEXT_CR:
+ gl2psPrintf("text-anchor=\"end\" baseline-shift=\"%d\" ",
+ -prim->data.text->fontsize / 2);
+ break;
+ case GL2PS_TEXT_B:
+ gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"0\" ");
+ break;
+ case GL2PS_TEXT_BR:
+ gl2psPrintf("text-anchor=\"end\" baseline-shift=\"0\" ");
+ break;
+ case GL2PS_TEXT_T:
+ gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"%d\" ",
+ -prim->data.text->fontsize);
+ break;
+ case GL2PS_TEXT_TL:
+ gl2psPrintf("text-anchor=\"start\" baseline-shift=\"%d\" ",
+ -prim->data.text->fontsize);
+ break;
+ case GL2PS_TEXT_TR:
+ gl2psPrintf("text-anchor=\"end\" baseline-shift=\"%d\" ",
+ -prim->data.text->fontsize);
+ break;
+ case GL2PS_TEXT_BL:
+ default: /* same as GL2PS_TEXT_BL */
+ gl2psPrintf("text-anchor=\"start\" baseline-shift=\"0\" ");
+ break;
+ }
+ if(!strcmp(prim->data.text->fontname, "Times-Roman"))
+ gl2psPrintf("font-family=\"Times\">");
+ else if(!strcmp(prim->data.text->fontname, "Times-Bold"))
+ gl2psPrintf("font-family=\"Times\" font-weight=\"bold\">");
+ else if(!strcmp(prim->data.text->fontname, "Times-Italic"))
+ gl2psPrintf("font-family=\"Times\" font-style=\"italic\">");
+ else if(!strcmp(prim->data.text->fontname, "Times-BoldItalic"))
+ gl2psPrintf("font-family=\"Times\" font-style=\"italic\" font-weight=\"bold\">");
+ else if(!strcmp(prim->data.text->fontname, "Helvetica-Bold"))
+ gl2psPrintf("font-family=\"Helvetica\" font-weight=\"bold\">");
+ else if(!strcmp(prim->data.text->fontname, "Helvetica-Oblique"))
+ gl2psPrintf("font-family=\"Helvetica\" font-style=\"oblique\">");
+ else if(!strcmp(prim->data.text->fontname, "Helvetica-BoldOblique"))
+ gl2psPrintf("font-family=\"Helvetica\" font-style=\"oblique\" font-weight=\"bold\">");
+ else if(!strcmp(prim->data.text->fontname, "Courier-Bold"))
+ gl2psPrintf("font-family=\"Courier\" font-weight=\"bold\">");
+ else if(!strcmp(prim->data.text->fontname, "Courier-Oblique"))
+ gl2psPrintf("font-family=\"Courier\" font-style=\"oblique\">");
+ else if(!strcmp(prim->data.text->fontname, "Courier-BoldOblique"))
+ gl2psPrintf("font-family=\"Courier\" font-style=\"oblique\" font-weight=\"bold\">");
+ else
+ gl2psPrintf("font-family=\"%s\">", prim->data.text->fontname);
+ gl2psPrintf("%s</text>\n", prim->data.text->str);
break;
case GL2PS_SPECIAL :
/* alignment contains the format for which the special output text
@@ -5103,20 +5230,20 @@ static void gl2psPrintSVGPrimitive(void *data)
static void gl2psPrintSVGFooter(void)
{
gl2psPrintf("</g>\n");
- gl2psPrintf("</svg>\n");
-
+ gl2psPrintf("</svg>\n");
+
gl2psPrintGzipFooter();
}
static void gl2psPrintSVGBeginViewport(GLint viewport[4])
{
- GLint index;
+ GLint idx;
char col[32];
GLfloat rgba[4];
int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3];
glRenderMode(GL_FEEDBACK);
-
+
if(gl2ps->header){
gl2psPrintSVGHeader();
gl2ps->header = GL_FALSE;
@@ -5127,25 +5254,25 @@ static void gl2psPrintSVGBeginViewport(GLint viewport[4])
glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba);
}
else{
- glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index);
- rgba[0] = gl2ps->colormap[index][0];
- rgba[1] = gl2ps->colormap[index][1];
- rgba[2] = gl2ps->colormap[index][2];
+ glGetIntegerv(GL_INDEX_CLEAR_VALUE, &idx);
+ rgba[0] = gl2ps->colormap[idx][0];
+ rgba[1] = gl2ps->colormap[idx][1];
+ rgba[2] = gl2ps->colormap[idx][2];
rgba[3] = 1.0F;
}
gl2psSVGGetColorString(rgba, col);
- gl2psPrintf("<polygon fill=\"%s\" points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n", col,
- x, gl2ps->viewport[3] - y,
- x + w, gl2ps->viewport[3] - y,
- x + w, gl2ps->viewport[3] - (y + h),
+ gl2psPrintf("<polygon fill=\"%s\" points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n", col,
+ x, gl2ps->viewport[3] - y,
+ x + w, gl2ps->viewport[3] - y,
+ x + w, gl2ps->viewport[3] - (y + h),
x, gl2ps->viewport[3] - (y + h));
}
gl2psPrintf("<clipPath id=\"cp%d%d%d%d\">\n", x, y, w, h);
- gl2psPrintf(" <polygon points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n",
- x, gl2ps->viewport[3] - y,
- x + w, gl2ps->viewport[3] - y,
- x + w, gl2ps->viewport[3] - (y + h),
+ gl2psPrintf(" <polygon points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n",
+ x, gl2ps->viewport[3] - y,
+ x + w, gl2ps->viewport[3] - y,
+ x + w, gl2ps->viewport[3] - (y + h),
x, gl2ps->viewport[3] - (y + h));
gl2psPrintf("</clipPath>\n");
gl2psPrintf("<g clip-path=\"url(#cp%d%d%d%d)\">\n", x, y, w, h);
@@ -5199,7 +5326,7 @@ static void gl2psPrintPGFHeader(void)
time(&now);
- fprintf(gl2ps->stream,
+ fprintf(gl2ps->stream,
"%% Title: %s\n"
"%% Creator: GL2PS %d.%d.%d%s, %s\n"
"%% For: %s\n"
@@ -5253,7 +5380,7 @@ static const char *gl2psPGFTextAlignment(int align)
case GL2PS_TEXT_T : return "north";
case GL2PS_TEXT_TL : return "north west";
case GL2PS_TEXT_TR : return "north east";
- case GL2PS_TEXT_BL :
+ case GL2PS_TEXT_BL :
default : return "south west";
}
}
@@ -5268,7 +5395,7 @@ static void gl2psPrintPGFPrimitive(void *data)
case GL2PS_POINT :
/* Points in openGL are rectangular */
gl2psPrintPGFColor(prim->verts[0].rgba);
- fprintf(gl2ps->stream,
+ fprintf(gl2ps->stream,
"\\pgfpathrectangle{\\pgfpoint{%fpt}{%fpt}}"
"{\\pgfpoint{%fpt}{%fpt}}\n\\pgfusepath{fill}\n",
prim->verts[0].xyz[0]-0.5*prim->width,
@@ -5282,7 +5409,7 @@ static void gl2psPrintPGFPrimitive(void *data)
fprintf(gl2ps->stream, "\\pgfsetlinewidth{%fpt}\n", gl2ps->lastlinewidth);
}
gl2psPrintPGFDash(prim->pattern, prim->factor);
- fprintf(gl2ps->stream,
+ fprintf(gl2ps->stream,
"\\pgfpathmoveto{\\pgfpoint{%fpt}{%fpt}}\n"
"\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n"
"\\pgfusepath{stroke}\n",
@@ -5295,7 +5422,7 @@ static void gl2psPrintPGFPrimitive(void *data)
fprintf(gl2ps->stream, "\\pgfsetlinewidth{0.01pt}\n");
}
gl2psPrintPGFColor(prim->verts[0].rgba);
- fprintf(gl2ps->stream,
+ fprintf(gl2ps->stream,
"\\pgfpathmoveto{\\pgfpoint{%fpt}{%fpt}}\n"
"\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n"
"\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n"
@@ -5340,7 +5467,7 @@ static void gl2psPrintPGFFooter(void)
static void gl2psPrintPGFBeginViewport(GLint viewport[4])
{
- GLint index;
+ GLint idx;
GLfloat rgba[4];
int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3];
@@ -5357,21 +5484,21 @@ static void gl2psPrintPGFBeginViewport(GLint viewport[4])
glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba);
}
else{
- glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index);
- rgba[0] = gl2ps->colormap[index][0];
- rgba[1] = gl2ps->colormap[index][1];
- rgba[2] = gl2ps->colormap[index][2];
+ glGetIntegerv(GL_INDEX_CLEAR_VALUE, &idx);
+ rgba[0] = gl2ps->colormap[idx][0];
+ rgba[1] = gl2ps->colormap[idx][1];
+ rgba[2] = gl2ps->colormap[idx][2];
rgba[3] = 1.0F;
}
gl2psPrintPGFColor(rgba);
- fprintf(gl2ps->stream,
+ fprintf(gl2ps->stream,
"\\pgfpathrectangle{\\pgfpoint{%dpt}{%dpt}}"
"{\\pgfpoint{%dpt}{%dpt}}\n"
"\\pgfusepath{fill}\n",
x, y, w, h);
}
-
- fprintf(gl2ps->stream,
+
+ fprintf(gl2ps->stream,
"\\pgfpathrectangle{\\pgfpoint{%dpt}{%dpt}}"
"{\\pgfpoint{%dpt}{%dpt}}\n"
"\\pgfusepath{clip}\n",
@@ -5403,7 +5530,7 @@ static GL2PSbackend gl2psPGF = {
"PGF Latex Graphics"
};
-/*********************************************************************
+/*********************************************************************
*
* General primitive printing routine
*
@@ -5438,7 +5565,7 @@ static void gl2psComputeTightBoundingBox(void *data)
if(prim->verts[i].xyz[1] > gl2ps->viewport[3])
gl2ps->viewport[3] = (GLint)(prim->verts[i].xyz[1] + 0.5F);
}
-}
+}
static GLint gl2psPrintPrimitives(void)
{
@@ -5459,7 +5586,7 @@ static GLint gl2psPrintPrimitives(void)
gl2psRescaleAndOffset();
if(gl2ps->header){
- if(gl2psListNbr(gl2ps->primitives) &&
+ if(gl2psListNbr(gl2ps->primitives) &&
(gl2ps->options & GL2PS_TIGHT_BOUNDING_BOX)){
gl2ps->viewport[0] = gl2ps->viewport[1] = 100000;
gl2ps->viewport[2] = gl2ps->viewport[3] = -100000;
@@ -5501,7 +5628,7 @@ static GLint gl2psPrintPrimitives(void)
gl2psAddInImageTree, 1);
gl2psFreeBspImageTree(&gl2ps->imagetree);
}
- gl2psTraverseBspTree(root, eye, GL2PS_EPSILON, gl2psGreater,
+ gl2psTraverseBspTree(root, eye, GL2PS_EPSILON, gl2psGreater,
gl2psbackends[gl2ps->format]->printPrimitive, 0);
gl2psFreeBspTree(&root);
/* reallocate the primitive list (it's been deleted by
@@ -5514,20 +5641,20 @@ static GLint gl2psPrintPrimitives(void)
return GL2PS_SUCCESS;
}
-/*********************************************************************
+/*********************************************************************
*
* Public routines
*
*********************************************************************/
-GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
+GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
GLint viewport[4], GLint format, GLint sort,
GLint options, GLint colormode,
GLint colorsize, GL2PSrgba *colormap,
GLint nr, GLint ng, GLint nb, GLint buffersize,
FILE *stream, const char *filename)
{
- GLint index;
+ GLint idx;
int i;
if(gl2ps){
@@ -5537,7 +5664,7 @@ GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
gl2ps = (GL2PScontext*)gl2psMalloc(sizeof(GL2PScontext));
- if(format >= 0 && format < (GLint)(sizeof(gl2psbackends)/sizeof(gl2psbackends[0]))){
+ if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0]))){
gl2ps->format = format;
}
else {
@@ -5588,16 +5715,16 @@ GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
if(!gl2ps->viewport[2] || !gl2ps->viewport[3]){
gl2psMsg(GL2PS_ERROR, "Incorrect viewport (x=%d, y=%d, width=%d, height=%d)",
- gl2ps->viewport[0], gl2ps->viewport[1],
+ gl2ps->viewport[0], gl2ps->viewport[1],
gl2ps->viewport[2], gl2ps->viewport[3]);
gl2psFree(gl2ps);
gl2ps = NULL;
return GL2PS_ERROR;
}
- gl2ps->threshold[0] = nr ? 1.0F/(GLfloat)nr : 0.064F;
- gl2ps->threshold[1] = ng ? 1.0F/(GLfloat)ng : 0.034F;
- gl2ps->threshold[2] = nb ? 1.0F/(GLfloat)nb : 0.100F;
+ gl2ps->threshold[0] = nr ? 1.0F / (GLfloat)nr : 0.064F;
+ gl2ps->threshold[1] = ng ? 1.0F / (GLfloat)ng : 0.034F;
+ gl2ps->threshold[2] = nb ? 1.0F / (GLfloat)nb : 0.100F;
gl2ps->colormode = colormode;
gl2ps->buffersize = buffersize > 0 ? buffersize : 2048 * 2048;
for(i = 0; i < 3; i++){
@@ -5612,11 +5739,11 @@ GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
gl2ps->lastfactor = 0;
gl2ps->imagetree = NULL;
gl2ps->primitivetoadd = NULL;
- gl2ps->zerosurfacearea = GL_FALSE;
+ gl2ps->zerosurfacearea = GL_FALSE;
gl2ps->pdfprimlist = NULL;
gl2ps->pdfgrouplist = NULL;
gl2ps->xreflist = NULL;
-
+
/* get default blending mode from current OpenGL state (enabled by
default for SVG) */
gl2ps->blending = (gl2ps->format == GL2PS_SVG) ? GL_TRUE : glIsEnabled(GL_BLEND);
@@ -5638,10 +5765,10 @@ GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
gl2ps->colorsize = colorsize;
gl2ps->colormap = (GL2PSrgba*)gl2psMalloc(gl2ps->colorsize * sizeof(GL2PSrgba));
memcpy(gl2ps->colormap, colormap, gl2ps->colorsize * sizeof(GL2PSrgba));
- glGetIntegerv(GL_INDEX_CLEAR_VALUE, &index);
- gl2ps->bgcolor[0] = gl2ps->colormap[index][0];
- gl2ps->bgcolor[1] = gl2ps->colormap[index][1];
- gl2ps->bgcolor[2] = gl2ps->colormap[index][2];
+ glGetIntegerv(GL_INDEX_CLEAR_VALUE, &idx);
+ gl2ps->bgcolor[0] = gl2ps->colormap[idx][0];
+ gl2ps->bgcolor[1] = gl2ps->colormap[idx][1];
+ gl2ps->bgcolor[2] = gl2ps->colormap[idx][2];
gl2ps->bgcolor[3] = 1.0F;
}
else{
@@ -5659,7 +5786,7 @@ GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
gl2ps->title = (char*)gl2psMalloc((strlen(title)+1)*sizeof(char));
strcpy(gl2ps->title, title);
}
-
+
if(!producer){
gl2ps->producer = (char*)gl2psMalloc(sizeof(char));
gl2ps->producer[0] = '\0';
@@ -5668,7 +5795,7 @@ GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
gl2ps->producer = (char*)gl2psMalloc((strlen(producer)+1)*sizeof(char));
strcpy(gl2ps->producer, producer);
}
-
+
if(!filename){
gl2ps->filename = (char*)gl2psMalloc(sizeof(char));
gl2ps->filename[0] = '\0';
@@ -5682,7 +5809,7 @@ GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
gl2ps->auxprimitives = gl2psListCreate(100, 100, sizeof(GL2PSprimitive*));
gl2ps->feedback = (GLfloat*)gl2psMalloc(gl2ps->buffersize * sizeof(GLfloat));
glFeedbackBuffer(gl2ps->buffersize, GL_3D_COLOR, gl2ps->feedback);
- glRenderMode(GL_FEEDBACK);
+ glRenderMode(GL_FEEDBACK);
return GL2PS_SUCCESS;
}
@@ -5697,7 +5824,7 @@ GL2PSDLL_API GLint gl2psEndPage(void)
if(res != GL2PS_OVERFLOW)
(gl2psbackends[gl2ps->format]->printFooter)();
-
+
fflush(gl2ps->stream);
gl2psListDelete(gl2ps->primitives);
@@ -5719,7 +5846,7 @@ GL2PSDLL_API GLint gl2psBeginViewport(GLint viewport[4])
if(!gl2ps) return GL2PS_UNINITIALIZED;
(gl2psbackends[gl2ps->format]->beginViewport)(viewport);
-
+
return GL2PS_SUCCESS;
}
@@ -5731,32 +5858,45 @@ GL2PSDLL_API GLint gl2psEndViewport(void)
res = (gl2psbackends[gl2ps->format]->endViewport)();
+ /* reset last used colors, line widths */
+ gl2ps->lastlinewidth = -1.0F;
+
return res;
}
-GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname,
+GL2PSDLL_API GLint gl2psTextOptColor(const char *str, const char *fontname,
+ GLshort fontsize, GLint alignment, GLfloat angle,
+ GL2PSrgba color)
+{
+ return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, alignment, angle,
+ color);
+}
+
+GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname,
GLshort fontsize, GLint alignment, GLfloat angle)
{
- return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, alignment, angle);
+ return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, alignment, angle, NULL);
}
GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname, GLshort fontsize)
{
- return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, GL2PS_TEXT_BL, 0.0F);
+ return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, GL2PS_TEXT_BL, 0.0F,
+ NULL);
}
GL2PSDLL_API GLint gl2psSpecial(GLint format, const char *str)
{
- return gl2psAddText(GL2PS_SPECIAL, str, "", 0, format, 0.0F);
+ return gl2psAddText(GL2PS_SPECIAL, str, "", 0, format, 0.0F, NULL);
}
GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height,
GLint xorig, GLint yorig,
- GLenum format, GLenum type,
+ GLenum format, GLenum type,
const void *pixels)
{
int size, i;
- GLfloat pos[4], *piv;
+ const GLfloat *piv;
+ GLfloat pos[4], zoom_x, zoom_y;
GL2PSprimitive *prim;
GLboolean valid;
@@ -5776,6 +5916,8 @@ GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height,
if(GL_FALSE == valid) return GL2PS_SUCCESS; /* the primitive is culled */
glGetFloatv(GL_CURRENT_RASTER_POSITION, pos);
+ glGetFloatv(GL_ZOOM_X, &zoom_x);
+ glGetFloatv(GL_ZOOM_Y, &zoom_y);
prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive));
prim->type = GL2PS_PIXMAP;
@@ -5794,6 +5936,8 @@ GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height,
prim->data.image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage));
prim->data.image->width = width;
prim->data.image->height = height;
+ prim->data.image->zoom_x = zoom_x;
+ prim->data.image->zoom_y = zoom_y;
prim->data.image->format = format;
prim->data.image->type = type;
@@ -5804,12 +5948,12 @@ GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height,
prim->data.image->format = GL_RGB;
size = height * width * 3;
prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat));
- piv = (GLfloat*)pixels;
+ piv = (const GLfloat*)pixels;
for(i = 0; i < size; ++i, ++piv){
prim->data.image->pixels[i] = *piv;
- if(!((i+1)%3))
+ if(!((i + 1) % 3))
++piv;
- }
+ }
}
else{
size = height * width * 4;
@@ -5836,12 +5980,12 @@ GL2PSDLL_API GLint gl2psDrawImageMap(GLsizei width, GLsizei height,
const unsigned char *imagemap){
int size, i;
int sizeoffloat = sizeof(GLfloat);
-
+
if(!gl2ps || !imagemap) return GL2PS_UNINITIALIZED;
if((width <= 0) || (height <= 0)) return GL2PS_ERROR;
-
- size = height + height * ((width-1)/8);
+
+ size = height + height * ((width - 1) / 8);
glPassThrough(GL2PS_IMAGEMAP_TOKEN);
glBegin(GL_POINTS);
glVertex3f(position[0], position[1],position[2]);
@@ -5849,7 +5993,7 @@ GL2PSDLL_API GLint gl2psDrawImageMap(GLsizei width, GLsizei height,
glPassThrough((GLfloat)width);
glPassThrough((GLfloat)height);
for(i = 0; i < size; i += sizeoffloat){
- float *value = (float*)imagemap;
+ const float *value = (const float*)imagemap;
glPassThrough(*value);
imagemap += sizeoffloat;
}
@@ -5920,7 +6064,7 @@ GL2PSDLL_API GLint gl2psPointSize(GLfloat value)
glPassThrough(GL2PS_POINT_SIZE_TOKEN);
glPassThrough(value);
-
+
return GL2PS_SUCCESS;
}
@@ -5958,9 +6102,21 @@ GL2PSDLL_API GLint gl2psSetOptions(GLint options)
return GL2PS_SUCCESS;
}
+GL2PSDLL_API GLint gl2psGetOptions(GLint *options)
+{
+ if(!gl2ps) {
+ *options = 0;
+ return GL2PS_UNINITIALIZED;
+ }
+
+ *options = gl2ps->options;
+
+ return GL2PS_SUCCESS;
+}
+
GL2PSDLL_API const char *gl2psGetFileExtension(GLint format)
{
- if(format >= 0 && format < (GLint)(sizeof(gl2psbackends)/sizeof(gl2psbackends[0])))
+ if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0])))
return gl2psbackends[format]->file_extension;
else
return "Unknown format";
@@ -5968,8 +6124,13 @@ GL2PSDLL_API const char *gl2psGetFileExtension(GLint format)
GL2PSDLL_API const char *gl2psGetFormatDescription(GLint format)
{
- if(format >= 0 && format < (GLint)(sizeof(gl2psbackends)/sizeof(gl2psbackends[0])))
+ if(format >= 0 && format < (GLint)(sizeof(gl2psbackends) / sizeof(gl2psbackends[0])))
return gl2psbackends[format]->description;
else
return "Unknown format";
}
+
+GL2PSDLL_API GLint gl2psGetFileFormat()
+{
+ return gl2ps->format;
+}
diff --git a/gl2ps.h b/gl2ps.h
index ef99fae..978c2f1 100644
--- a/gl2ps.h
+++ b/gl2ps.h
@@ -1,7 +1,6 @@
-/* $Id: gl2ps.h,v 1.112 2006/08/11 13:29:45 geuzaine Exp $ */
/*
* GL2PS, an OpenGL to PostScript Printing Library
- * Copyright (C) 1999-2006 Christophe Geuzaine <geuz at geuz.org>
+ * Copyright (C) 1999-2012 C. Geuzaine
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of either:
@@ -21,14 +20,16 @@
*
* You should have received a copy of the GNU Library General Public
* License along with this library in the file named "COPYING.LGPL";
- * if not, write to the Free Software Foundation, Inc., 675 Mass Ave,
- * Cambridge, MA 02139, USA.
+ * if not, write to the Free Software Foundation, Inc., 51 Franklin
+ * Street, Fifth Floor, Boston, MA 02110-1301, USA.
*
* You should have received a copy of the GL2PS License with this
* library in the file named "COPYING.GL2PS"; if not, I will be glad
* to provide one.
*
- * For the latest info about gl2ps, see http://www.geuz.org/gl2ps/.
+ * For the latest info about gl2ps and a full list of contributors,
+ * see http://www.geuz.org/gl2ps/.
+ *
* Please report all bugs and problems to <gl2ps at geuz.org>.
*/
@@ -43,6 +44,7 @@
#if defined(WIN32) || defined(_WIN32) || defined(__WIN32__) || defined(__NT__)
# if defined(_MSC_VER)
# pragma warning(disable:4115)
+# pragma warning(disable:4996)
# endif
# include <windows.h>
# if defined(GL2PSDLL)
@@ -74,18 +76,22 @@
# endif
#endif
+#if defined(HAVE_NO_VSNPRINTF)
+# define GL2PS_HAVE_NO_VSNPRINTF
+#endif
+
/* Version number */
#define GL2PS_MAJOR_VERSION 1
#define GL2PS_MINOR_VERSION 3
-#define GL2PS_PATCH_VERSION 1
+#define GL2PS_PATCH_VERSION 8
#define GL2PS_EXTRA_VERSION ""
#define GL2PS_VERSION (GL2PS_MAJOR_VERSION + \
0.01 * GL2PS_MINOR_VERSION + \
0.0001 * GL2PS_PATCH_VERSION)
-#define GL2PS_COPYRIGHT "(C) 1999-2006 Christophe Geuzaine (geuz at geuz.org)"
+#define GL2PS_COPYRIGHT "(C) 1999-2012 C. Geuzaine"
/* Output file formats (the values and the ordering are important!) */
@@ -137,9 +143,9 @@
#define GL2PS_BLEND 4
/* Text alignment (o=raster position; default mode is BL):
- +---+ +---+ +---+ +---+ +---+ +---+ +-o-+ o---+ +---o
- | o | o | | o | | | | | | | | | | | |
- +---+ +---+ +---+ +-o-+ o---+ +---o +---+ +---+ +---+
+ +---+ +---+ +---+ +---+ +---+ +---+ +-o-+ o---+ +---o
+ | o | o | | o | | | | | | | | | | | |
+ +---+ +---+ +---+ +-o-+ o---+ +---o +---+ +---+ +---+
C CL CR B BL BR T TL TR */
#define GL2PS_TEXT_C 1
@@ -158,20 +164,24 @@ typedef GLfloat GL2PSrgba[4];
extern "C" {
#endif
-GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
+GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer,
GLint viewport[4], GLint format, GLint sort,
GLint options, GLint colormode,
- GLint colorsize, GL2PSrgba *colormap,
+ GLint colorsize, GL2PSrgba *colormap,
GLint nr, GLint ng, GLint nb, GLint buffersize,
FILE *stream, const char *filename);
GL2PSDLL_API GLint gl2psEndPage(void);
GL2PSDLL_API GLint gl2psSetOptions(GLint options);
+GL2PSDLL_API GLint gl2psGetOptions(GLint *options);
GL2PSDLL_API GLint gl2psBeginViewport(GLint viewport[4]);
GL2PSDLL_API GLint gl2psEndViewport(void);
-GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname,
+GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname,
GLshort fontsize);
-GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname,
+GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname,
GLshort fontsize, GLint align, GLfloat angle);
+GL2PSDLL_API GLint gl2psTextOptColor(const char *str, const char *fontname,
+ GLshort fontsize, GLint align, GLfloat angle,
+ GL2PSrgba color);
GL2PSDLL_API GLint gl2psSpecial(GLint format, const char *str);
GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height,
GLint xorig, GLint yorig,
@@ -188,6 +198,7 @@ GL2PSDLL_API GLint gl2psDrawImageMap(GLsizei width, GLsizei height,
const unsigned char *imagemap);
GL2PSDLL_API const char *gl2psGetFileExtension(GLint format);
GL2PSDLL_API const char *gl2psGetFormatDescription(GLint format);
+GL2PSDLL_API GLint gl2psGetFileFormat();
#if defined(__cplusplus)
}
diff --git a/glistener.c b/glistener.c
new file mode 100644
index 0000000..0b8e2d0
--- /dev/null
+++ b/glistener.c
@@ -0,0 +1,2886 @@
+#include "glistener.h"
+
+/* supplied by caller: help finder, evaluator, symbol table lookup
+ * see s7.html#glistener and glistener.h for examples and documentation.
+ */
+
+#define strcopy(Dest, Src, Len) memcpy((void *)(Dest), (void *)(Src), Len)
+
+struct glistener {
+ GtkWidget *text, *scroller, *status;
+ GtkTextBuffer *buffer;
+ bool is_schemish;
+
+ GtkTextTag *prompt_tag;
+ char *prompt;
+ int prompt_length;
+
+ char **strings;
+ int strings_size, strings_pos;
+ bool first_time;
+ char *status_message;
+
+ GtkTextTag *flash_tag;
+ int flashes;
+ int flash_paren_pos;
+ int flash_time;
+
+ GtkTextTag *highlight_tag;
+ int highlight_start, highlight_end;
+
+ int insertion_position;
+ GdkCursor *wait_cursor, *arrow_cursor;
+
+ const char *(*helper)(glistener *g, const char *text);
+ const char *(*checker)(glistener *g, const char *text);
+ void (*evaluator)(glistener *g, const char *text);
+ void (*completer)(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data);
+ void (*colorizer)(glistener *g, glistener_colorizer_t type, int start, int end);
+ bool (*keyer)(glistener *g, GtkWidget *w, GdkEventKey *e);
+};
+
+#if ((!GTK_CHECK_VERSION(3, 0, 0))) && (!defined(GDK_KEY_Return))
+ #define GDK_KEY_BackSpace GDK_BackSpace
+ #define GDK_KEY_Down GDK_Down
+ #define GDK_KEY_Left GDK_Left
+ #define GDK_KEY_Return GDK_Return
+ #define GDK_KEY_Right GDK_Right
+ #define GDK_KEY_Tab GDK_Tab
+ #define GDK_KEY_Up GDK_Up
+ #define GDK_KEY_a GDK_a
+ #define GDK_KEY_b GDK_b
+ #define GDK_KEY_c GDK_c
+ #define GDK_KEY_d GDK_d
+ #define GDK_KEY_e GDK_e
+ #define GDK_KEY_f GDK_f
+ #define GDK_KEY_greater GDK_greater
+ #define GDK_KEY_k GDK_k
+ #define GDK_KEY_l GDK_l
+ #define GDK_KEY_less GDK_less
+ #define GDK_KEY_n GDK_n
+ #define GDK_KEY_p GDK_p
+ #define GDK_KEY_t GDK_t
+ #define GDK_KEY_u GDK_u
+ #define GDK_KEY_v GDK_v
+ #define GDK_KEY_w GDK_w
+ #define GDK_KEY_y GDK_y
+#endif
+
+#define EVENT_KEYVAL(Ev) (Ev)->keyval
+
+#if (GTK_CHECK_VERSION(3, 0, 0) && defined(__GNUC__) && (!(defined(__cplusplus))))
+ #define EVENT_STATE(Ev) ({ GdkModifierType Type; gdk_event_get_state((GdkEvent *)Ev, &Type); Type; })
+#else
+ #define EVENT_STATE(Ev) (Ev)->state
+#endif
+
+#define ControlMask GDK_CONTROL_MASK
+#define MetaMask GDK_MOD1_MASK
+
+
+/* these are the functions we get from the caller:
+ * helper -- provide a brief string describing some entity (NULL = no help)
+ * checker -- check for obvious mistakes in an expression
+ * completer -- provide name completion (NULL = no completion)
+ * evaluator -- evaluate an expression (a C string) and normally print the result in the glistener window
+ */
+
+static const char *default_helper(glistener *g, const char *text)
+{
+ return(NULL);
+}
+
+void glistener_set_helper(glistener *g, const char *(*help)(glistener *g, const char *text))
+{
+ if (help)
+ g->helper = help;
+ else g->helper = default_helper;
+}
+
+
+static const char *default_checker(glistener *g, const char *text)
+{
+ return(NULL);
+}
+
+void glistener_set_checker(glistener *g, const char *(*check)(glistener *g, const char *text))
+{
+ if (check)
+ g->checker = check;
+ else g->checker = default_checker;
+}
+
+
+static void default_evaluator(glistener *g, const char *text)
+{
+ glistener_append_text(g, "\n?");
+ glistener_append_prompt(g);
+}
+
+void glistener_set_evaluator(glistener *g, void (*eval)(glistener *g, const char *text))
+{
+ if (eval)
+ g->evaluator = eval;
+ else g->evaluator = default_evaluator;
+}
+
+
+static void default_completer(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
+{
+}
+
+void glistener_set_completer(glistener *g, void (*completer)(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data))
+{
+ if (completer)
+ g->completer = completer;
+ else g->completer = default_completer;
+}
+
+
+static void default_colorizer(glistener *g, glistener_colorizer_t type, int start, int end)
+{
+}
+
+void glistener_set_colorizer(glistener *g, void (*colorizer)(glistener *g, glistener_colorizer_t type, int start, int end))
+{
+ if (colorizer)
+ g->colorizer = colorizer;
+ else g->colorizer = default_colorizer;
+}
+
+
+static bool default_keyer(glistener *g, GtkWidget *w, GdkEventKey *e)
+{
+ return(false);
+}
+
+void glistener_set_keyer(glistener *g, bool (*key)(glistener *g, GtkWidget *w, GdkEventKey *e))
+{
+ if (key)
+ g->keyer = key;
+ else g->keyer = default_keyer;
+ /* the keyer can itself block signal emission, so I think all bases are covered
+ * false -> built-in actions
+ * true -> skip built in
+ * block/true -> block, then skip
+ * the caller could simply add his signal to "key-press" in the widget, but then
+ * has less fine-tuned control of the built-in handler.
+ */
+}
+
+
+void glistener_is_schemish(glistener *g, bool is_schemish)
+{
+ g->is_schemish = is_schemish;
+}
+
+
+static PangoFontDescription *default_font = NULL;
+/* in case font is set before glistener is created -- this happens in Snd when the
+ * initialization script sets the listener font. At that point in the startup process,
+ * the listener window does not exist. Perhaps it would be safer to copy the value.
+ */
+
+void glistener_set_font(glistener *g, PangoFontDescription *font)
+{
+ if ((!g) || (!(g->text)))
+ {
+ default_font = font;
+ return;
+ }
+ else default_font = NULL;
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ gtk_widget_modify_font(GTK_WIDGET(g->text), font);
+#else
+#if (!GTK_CHECK_VERSION(3, 16, 0))
+ gtk_widget_override_font(GTK_WIDGET(g->text), font);
+#endif
+#endif
+}
+
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+static GdkColor *default_text_color = NULL;
+static GdkColor *default_background_color = NULL;
+
+void glistener_set_text_color(glistener *g, GdkColor *p)
+{
+ if ((g) && (g->text))
+ {
+ gtk_widget_modify_text(g->text, GTK_STATE_NORMAL, p);
+ default_text_color = NULL;
+ }
+ else default_text_color = p;
+}
+
+void glistener_set_background_color(glistener *g, GdkColor *p)
+{
+ if ((g) && (g->text))
+ {
+ gtk_widget_modify_base(g->text, GTK_STATE_NORMAL, p);
+ default_background_color = NULL;
+ }
+ else default_background_color = p;
+}
+
+#else
+static GdkRGBA *default_text_color = NULL;
+static GdkRGBA *default_background_color = NULL;
+
+void glistener_set_text_color(glistener *g, GdkRGBA *p)
+{
+ if ((g) && (g->text))
+ {
+#if (!GTK_CHECK_VERSION(3, 16, 0))
+ gtk_widget_override_color(g->text, GTK_STATE_FLAG_NORMAL, p);
+#endif
+ default_text_color = NULL;
+ }
+ else default_text_color = p;
+}
+
+void glistener_set_background_color(glistener *g, GdkRGBA *p)
+{
+ if ((g) && (g->text))
+ {
+#if (!GTK_CHECK_VERSION(3, 16, 0))
+ gtk_widget_override_background_color(g->text, GTK_STATE_FLAG_NORMAL, p);
+#endif
+ default_background_color = NULL;
+ }
+ else default_background_color = p;
+}
+#endif
+
+
+
+void glistener_post_status(glistener *g, const char *msg)
+{
+ if (g->status)
+ {
+ gtk_statusbar_pop(GTK_STATUSBAR(g->status), 1);
+ gtk_statusbar_push(GTK_STATUSBAR(g->status), 1, msg);
+ }
+}
+
+void glistener_clear_status(glistener *g)
+{
+ if (g->status)
+ {
+#if (GTK_CHECK_VERSION(3, 0, 0))
+ gtk_statusbar_remove_all(GTK_STATUSBAR(g->status), 1);
+#else
+ gtk_statusbar_pop(GTK_STATUSBAR(g->status), 1);
+#endif
+ if (g->status_message)
+ {
+ free(g->status_message);
+ g->status_message = NULL;
+ }
+ }
+}
+
+static void glistener_append_status(glistener *g, const char *msg)
+{
+ if ((g->status) && (msg))
+ {
+ int len;
+ len = strlen(msg);
+ if (g->status_message)
+ {
+ char *new_msg;
+ len += (strlen(g->status_message) + 3);
+ new_msg = (char *)calloc(len, sizeof(char));
+ snprintf(new_msg, len, "%s %s", msg, g->status_message);
+ free(g->status_message);
+ g->status_message = new_msg;
+ }
+ else
+ {
+ g->status_message = (char *)calloc(len + 1, sizeof(char));
+ strcopy(g->status_message, msg, len + 1);
+ }
+ gtk_statusbar_pop(GTK_STATUSBAR(g->status), 1);
+ gtk_statusbar_push(GTK_STATUSBAR(g->status), 1, g->status_message);
+ }
+}
+
+
+
+
+
+/* ---------------- cursor ---------------- */
+
+void glistener_set_cursor_position(glistener *g, int position)
+{
+ GtkTextIter pos;
+ /* -1 -> goto to end */
+ if (position == -1)
+ gtk_text_buffer_get_end_iter(g->buffer, &pos);
+ else gtk_text_buffer_get_iter_at_offset(g->buffer, &pos, position);
+ gtk_text_buffer_place_cursor(g->buffer, &pos);
+
+ gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(g->text), gtk_text_buffer_get_insert(g->buffer));
+}
+
+
+int glistener_cursor_position(glistener *g)
+{
+ GtkTextIter pos;
+ gtk_text_buffer_get_iter_at_mark(g->buffer, &pos, gtk_text_buffer_get_insert(g->buffer));
+ return(gtk_text_iter_get_offset(&pos));
+}
+
+
+static int glistener_cursor(glistener *g, GtkTextIter *cursor)
+{
+ gtk_text_buffer_get_iter_at_mark(g->buffer, cursor, gtk_text_buffer_get_insert(g->buffer));
+ return(gtk_text_iter_get_offset(cursor));
+}
+
+
+void glistener_set_cursor_shape(glistener *g, GdkCursor *cursor_shape)
+{
+ gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(g->text), GTK_TEXT_WINDOW_TEXT), cursor_shape);
+}
+
+
+
+/* ---------------- prompt ---------------- */
+
+static void prompt_insert(glistener *g, GtkTextIter *pos, bool at_top)
+{
+ if (at_top)
+ {
+ if (g->prompt_tag)
+ gtk_text_buffer_insert_with_tags(g->buffer, pos, (char *)(g->prompt + 1), -1, g->prompt_tag, NULL);
+ else gtk_text_buffer_insert(g->buffer, pos, (char *)(g->prompt + 1), -1);
+ }
+ else
+ {
+ if (g->prompt_tag)
+ gtk_text_buffer_insert_with_tags(g->buffer, pos, g->prompt, -1, g->prompt_tag, NULL);
+ else gtk_text_buffer_insert(g->buffer, pos, g->prompt, -1);
+ /* scroll fully to prompt and left so the new prompt is in view
+ */
+ gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(g->text), gtk_text_buffer_get_insert(g->buffer));
+ gtk_adjustment_set_value(GTK_ADJUSTMENT(gtk_scrolled_window_get_hadjustment(GTK_SCROLLED_WINDOW(g->scroller))), 0.0);
+ }
+}
+
+
+static GtkTextTag *default_prompt_tag = NULL;
+
+void glistener_set_prompt_tag(glistener *g, GtkTextTag *m)
+{
+ if (!g)
+ default_prompt_tag = m;
+ else
+ {
+ g->prompt_tag = m;
+ default_prompt_tag = NULL;
+ }
+ /* should this redisplay all the prompts? */
+}
+
+
+static char *default_prompt = NULL;
+
+void glistener_set_prompt(glistener *g, const char *str)
+{
+ /* the internal version includes a preceding <cr>, and its length is in unicode terms
+ * also, if we have prompts displayed in the listener, they need to change to match
+ * the new one.
+ *
+ * glistener_set_prompt(g, "s7>")
+ *
+ * from Snd, to get a prompt of lambda: in Greek font:
+ * (set! (listener-prompt) (string (integer->char #xce) (integer->char #xbb) #\:))
+ * (set! (listener-prompt) (byte-vector #xce #xbb (char->integer #\:)))
+ * currently (see GDK_SUPER_MASK below), to type Greek characters, hold down the windoze-key
+ */
+ char *old_prompt;
+ int old_prompt_length;
+
+ if (!str) return;
+ if (!g)
+ {
+ default_prompt = (char *)str;
+ return;
+ }
+ default_prompt = NULL;
+ old_prompt = g->prompt;
+ old_prompt_length = g->prompt_length;
+
+ g->prompt = (char *)calloc(strlen(str) + 2, sizeof(char));
+ g->prompt[0] = '\n';
+ strcat(g->prompt, str);
+ g->prompt_length = g_utf8_strlen(g->prompt, -1);
+
+ if (!g->text) return;
+
+ if (old_prompt)
+ {
+ /* nothing will work if the prompt is changed in midcareer unless we remake all the preceding prompts */
+ GtkTextIter scan, start, end;
+
+ /* the first prompt does not have a <cr> so we handle it directly */
+ gtk_text_buffer_get_start_iter(g->buffer, &start);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end, old_prompt_length - 1);
+ gtk_text_buffer_delete(g->buffer, &start, &end);
+ prompt_insert(g, &start, true);
+
+ gtk_text_buffer_get_start_iter(g->buffer, &scan);
+ gtk_text_buffer_create_mark(g->buffer, "prompt_pos", &scan, false); /* false -> "right gravity" */
+ while (gtk_text_iter_forward_search(&scan, old_prompt, (GtkTextSearchFlags)0, &start, &end, NULL))
+ {
+ gtk_text_buffer_move_mark_by_name(g->buffer, "prompt_pos", &end);
+ gtk_text_buffer_delete(g->buffer, &start, &end);
+ prompt_insert(g, &start, false);
+ gtk_text_buffer_get_iter_at_mark(g->buffer, &scan, gtk_text_buffer_get_mark(g->buffer, "prompt_pos"));
+ }
+ gtk_text_buffer_delete_mark_by_name(g->buffer, "prompt_pos");
+ free(old_prompt);
+ }
+}
+
+
+void glistener_append_prompt(glistener *g)
+{
+ if (g->text)
+ {
+ GtkTextIter end;
+ gtk_text_buffer_get_end_iter(g->buffer, &end);
+ prompt_insert(g, &end, false);
+ gtk_text_buffer_get_end_iter(g->buffer, &end);
+ gtk_text_view_scroll_to_iter(GTK_TEXT_VIEW(g->text), &end, 0.0, false, 0.0, 1.0);
+ }
+}
+
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+/* backward search is buggy in gtk 2.20 (it's ok in gtk3 I think), and we depend on it!
+ * this code is ridiculous, but it's the least stupid thing I can find that seems to work.
+ */
+static gboolean prompt_backward_search(glistener *g, const GtkTextIter *iter, GtkTextIter *start, GtkTextIter *end)
+{
+ int cur_pos;
+ GtkTextIter scan1, scan2, s1, s2;
+ bool found_it = false;
+
+ cur_pos = gtk_text_iter_get_offset(iter);
+ gtk_text_buffer_get_start_iter(g->buffer, &scan1);
+ gtk_text_buffer_get_start_iter(g->buffer, &scan2);
+
+ while (true)
+ {
+ if (!gtk_text_iter_forward_search(&scan1, g->prompt, (GtkTextSearchFlags)0, &s1, &s2, NULL))
+ return(found_it);
+ if (gtk_text_iter_get_offset(&s2) > cur_pos)
+ return(found_it);
+ found_it = true;
+ gtk_text_iter_forward_search(&scan2, g->prompt, (GtkTextSearchFlags)0, start, end, NULL);
+ scan1 = s2;
+ scan2 = s2;
+ }
+ return(false);
+}
+
+#else
+
+static gboolean prompt_backward_search(glistener *g, const GtkTextIter *iter, GtkTextIter *start, GtkTextIter *end)
+{
+ return(gtk_text_iter_backward_search(iter, g->prompt, (GtkTextSearchFlags)0, start, end, NULL));
+}
+#endif
+
+
+static int find_current_prompt(glistener *g)
+{
+ GtkTextIter it, start, end;
+ int pos;
+
+ pos = glistener_cursor_position(g);
+ if (pos < g->prompt_length - 1)
+ return(g->prompt_length - 1);
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &it, pos + g->prompt_length - 1);
+ if (!prompt_backward_search(g, &it, &start, &end))
+ return(g->prompt_length - 1);
+
+ return(gtk_text_iter_get_offset(&start) + g->prompt_length);
+}
+
+
+int glistener_prompt_position(glistener *g)
+{
+ return(find_current_prompt(g));
+}
+
+
+static int find_previous_prompt(glistener *g, int pos)
+{
+ GtkTextIter it, start, end;
+ int new_pos;
+
+ if (pos < g->prompt_length - 1)
+ return(g->prompt_length - 1);
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &it, pos);
+ if (!prompt_backward_search(g, &it, &start, &end))
+ return(g->prompt_length - 1);
+ new_pos = gtk_text_iter_get_offset(&end);
+ if (new_pos < pos)
+ return(new_pos);
+ it = start;
+ gtk_text_iter_backward_char(&it);
+ if (!prompt_backward_search(g, &it, &start, &end))
+ return(g->prompt_length - 1);
+ return(gtk_text_iter_get_offset(&end));
+}
+
+
+static int find_next_prompt(glistener *g)
+{
+ GtkTextIter it, start, end;
+ glistener_cursor(g, &it);
+ if (!gtk_text_iter_forward_search(&it, g->prompt, (GtkTextSearchFlags)0, &start, &end, NULL))
+ gtk_text_buffer_get_end_iter(g->buffer, &end);
+ return(gtk_text_iter_get_offset(&end) + 1);
+}
+
+
+static bool is_prompt_end(glistener *g, int end_pos)
+{
+ /* the prompt includes the preceding <cr> */
+ GtkTextIter start, end;
+ bool result = false;
+
+ if (end_pos < g->prompt_length)
+ return(true);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end, end_pos);
+ start = end;
+ if (gtk_text_iter_backward_chars(&start, g->prompt_length))
+ {
+ char *txt;
+ txt = gtk_text_iter_get_text(&start, &end);
+ if (txt)
+ {
+ result = (strcmp(txt, g->prompt) == 0);
+ g_free(txt);
+ }
+ }
+ return(result);
+}
+
+
+
+/* ---------------- listener text ---------------- */
+
+static void remember_listener_string(glistener *g, const char *str)
+{
+ int i, top, len;
+ if (!str) return;
+
+ if (g->strings_size == 0)
+ {
+ g->strings_size = 8;
+ g->strings = (char **)calloc(g->strings_size, sizeof(char *));
+ }
+
+ g->strings_pos = 0;
+ g->first_time = true;
+
+ /* if str matches current history top entry, ignore it (as in tcsh) */
+ if ((g->strings[0]) &&
+ (strcmp(str, g->strings[0]) == 0))
+ return;
+
+ top = g->strings_size - 1;
+ if (g->strings[top]) free(g->strings[top]);
+ for (i = top; i > 0; i--) g->strings[i] = g->strings[i - 1];
+
+ len = strlen(str) + 1;
+ g->strings[0] = (char *)calloc(len, sizeof(char));
+ strcopy(g->strings[0], str, len);
+}
+
+
+static void restore_listener_string(glistener *g, bool back)
+{
+ if (g->strings)
+ {
+ char *str;
+ if (!(g->first_time))
+ {
+ if (back)
+ g->strings_pos++;
+ else g->strings_pos--;
+ }
+ g->first_time = false;
+ if (g->strings_pos < 0) g->strings_pos = 0;
+ if (g->strings_pos > (g->strings_size - 1)) g->strings_pos = g->strings_size - 1;
+ str = g->strings[g->strings_pos];
+ if (str)
+ glistener_append_text(g, str);
+ }
+}
+
+void glistener_clear(glistener *g)
+{
+ if (g->text)
+ {
+ GtkTextIter start, end;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, g->prompt_length - 1);
+ gtk_text_buffer_get_end_iter(g->buffer, &end);
+ gtk_text_buffer_delete(g->buffer, &start, &end);
+ }
+}
+
+
+bool glistener_write(glistener *g, FILE *fp)
+{
+ char *str = NULL;
+ GtkTextIter start, end;
+
+ gtk_text_buffer_get_start_iter(g->buffer, &start);
+ gtk_text_buffer_get_end_iter(g->buffer, &end);
+ str = gtk_text_buffer_get_text(g->buffer, &start, &end, true);
+ if (str)
+ {
+ size_t bytes;
+ bytes = strlen(str);
+ if (bytes > 0)
+ {
+ if (fwrite((void *)str, sizeof(char), bytes, fp) != bytes)
+ {
+ g_free(str);
+ return(false);
+ }
+ g_free(str);
+ }
+ }
+ return(true);
+}
+
+
+void glistener_append_text(glistener *g, const char *msg)
+{
+ if (g->text)
+ {
+ GtkTextIter end;
+ gtk_text_buffer_get_end_iter(g->buffer, &end);
+ gtk_text_buffer_insert(g->buffer, &end, (char *)msg, -1);
+ gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(g->text), gtk_text_buffer_get_insert(g->buffer));
+ }
+}
+
+
+void glistener_insert_text(glistener *g, const char *text)
+{
+ if (g->text)
+ {
+ gtk_text_buffer_insert_at_cursor(g->buffer, text, -1);
+ gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(g->text), gtk_text_buffer_get_insert(g->buffer));
+ }
+}
+
+
+char *glistener_text(glistener *g, int start, int end)
+{
+ GtkTextIter s, e;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &s, start);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &e, end);
+ return(gtk_text_buffer_get_text(g->buffer, &s, &e, true));
+}
+
+
+void glistener_scroll_to_end(glistener *g)
+{
+ if (g->text)
+ {
+ GtkTextIter end;
+ gtk_text_buffer_get_end_iter(g->buffer, &end);
+ gtk_text_buffer_place_cursor(g->buffer, &end);
+ gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(g->text), gtk_text_buffer_get_insert(g->buffer));
+ gtk_adjustment_set_value(GTK_ADJUSTMENT(gtk_scrolled_window_get_hadjustment(GTK_SCROLLED_WINDOW(g->scroller))), 0.0);
+ }
+}
+/* there is apparently no way in gtk to make sure our prompt is still visible after
+ * a paned widget holding this listener changes its layout!
+ */
+
+
+
+/* ---------------- paren matching ---------------- */
+
+static gboolean is_gt(gunichar c, gpointer data)
+{
+ return(c == '>');
+}
+
+static gboolean is_not_whitespace(gunichar c, gpointer data)
+{
+ return(!g_unichar_isspace(c));
+}
+
+static bool find_not_whitespace(glistener *g, int pos, GtkTextIter *limit)
+{
+ GtkTextIter scan;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, pos);
+ return(gtk_text_iter_forward_find_char(&scan, is_not_whitespace, NULL, limit));
+}
+
+
+static gboolean is_unslashed_double_quote(gunichar c, gpointer data)
+{
+ int *slashes = (int *)data;
+ if (c == '\\')
+ (*slashes)++;
+ else
+ {
+ if ((c == '\"') &&
+ (*slashes & 1) == 0)
+ return(true);
+ *slashes = 0;
+ }
+ return(false);
+}
+
+
+static bool find_enclosing_string(glistener *g, int pos, int *d1, int *d2, GtkTextIter *start, GtkTextIter *end)
+{
+ GtkTextIter scan;
+ int p1 = -1, p2 = -1, slashes = 0;
+ gunichar c;
+ bool found_left_quote = false;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, pos - 1);
+
+ gtk_text_iter_backward_char(&scan);
+ while (gtk_text_iter_compare(start, &scan) < 0)
+ {
+ c = gtk_text_iter_get_char(&scan);
+ if (c == '\"')
+ {
+ found_left_quote = true;
+ p1 = gtk_text_iter_get_offset(&scan);
+ }
+ else
+ {
+ if (c == '\\')
+ {
+ if (found_left_quote)
+ slashes++;
+ }
+ else
+ {
+ if ((found_left_quote) &&
+ ((slashes & 1) == 0))
+ break;
+ found_left_quote = false;
+ p1 = -1;
+ slashes = 0;
+ }
+ }
+ gtk_text_iter_backward_char(&scan);
+ }
+
+ if (p1 != -1)
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, p1);
+
+ slashes = 0;
+ if (gtk_text_iter_forward_find_char(&scan, is_unslashed_double_quote, &slashes, end))
+ {
+ if (found_left_quote)
+ p2 = gtk_text_iter_get_offset(&scan);
+ else
+ {
+ p1 = gtk_text_iter_get_offset(&scan);
+ if (gtk_text_iter_forward_find_char(&scan, is_unslashed_double_quote, &slashes, end))
+ p2 = gtk_text_iter_get_offset(&scan);
+ }
+ }
+
+ if ((p1 == -1) || (p2 == -1))
+ return(false);
+
+ *d1 = p1;
+ *d2 = p2 + 1;
+ return(true);
+}
+
+
+static int find_string_end(glistener *g, int pos, GtkTextIter *limit)
+{
+ int d1, d2;
+ GtkTextIter e;
+ gtk_text_buffer_get_end_iter(g->buffer, &e);
+ if (find_enclosing_string(g, pos, &d1, &d2, limit, &e))
+ return(d2 - 1);
+ return(-1);
+}
+
+
+static gboolean is_block_comment(gunichar c, gpointer data)
+{
+ int *last_c = (int *)data;
+ if ((c == '#') &&
+ (*last_c == '|'))
+ return(true);
+ *last_c = c;
+ return(false);
+}
+
+
+static int find_open_block_comment(glistener *g, int pos, GtkTextIter *limit)
+{
+ GtkTextIter scan;
+ int last_cs = 0;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, pos);
+ gtk_text_iter_backward_find_char(&scan, is_block_comment, &last_cs, limit);
+ return(gtk_text_iter_get_offset(&scan));
+}
+
+
+static int find_close_block_comment(glistener *g, int pos, GtkTextIter *limit)
+{
+ GtkTextIter scan;
+ int last_cs = 0;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, pos);
+ gtk_text_iter_forward_find_char(&scan, is_block_comment, &last_cs, limit);
+ return(gtk_text_iter_get_offset(&scan));
+}
+
+
+static gboolean is_delimiter(gunichar c, gpointer data)
+{
+ return((g_unichar_isspace(c)) ||
+ (c == '(') ||
+ (c == ')') ||
+ (c == ';') ||
+ (c == '\"'));
+ /* in s7, single-quote can appear in a name */
+}
+
+
+static void find_surrounding_word(glistener *g, int pos,
+ gboolean (*checker)(gunichar c, gpointer data),
+ int *start_pos, int *end_pos,
+ GtkTextIter *start_limit, GtkTextIter *end_limit)
+{
+ GtkTextIter start, end;
+ int bpos, epos;
+
+ *start_pos = pos;
+ bpos = gtk_text_iter_get_offset(start_limit);
+ *end_pos = pos;
+ epos = gtk_text_iter_get_offset(end_limit);
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, pos);
+ /* gtk_text_buffer_get_iter_at_offset(g->buffer, &end, pos); */
+ end = start;
+
+ if (gtk_text_iter_compare(start_limit, &start) < 0)
+ {
+ if (gtk_text_iter_backward_find_char(&start, checker, NULL, start_limit))
+ *start_pos = gtk_text_iter_get_offset(&start) + 1;
+ else *start_pos = bpos;
+ }
+
+ if (gtk_text_iter_compare(&end, end_limit) < 0)
+ {
+ if (!is_delimiter(gtk_text_iter_get_char(&end), NULL))
+ {
+ if (gtk_text_iter_forward_find_char(&end, checker, NULL, end_limit))
+ *end_pos = gtk_text_iter_get_offset(&end);
+ else *end_pos = epos;
+ }
+ }
+}
+
+
+static char *get_preceding_text(glistener *g, int pos, bool *in_string)
+{
+ GtkTextIter s1, e1, elimit;
+ int start = 0, end = 0;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &s1, find_current_prompt(g));
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &e1, pos);
+ gtk_text_buffer_get_end_iter(g->buffer, &elimit);
+ *in_string = false;
+
+ if (gtk_text_iter_equal(&s1, &elimit)) /* s1 can't be beyond elimit=end iter */
+ return(NULL);
+
+ if ((gtk_text_iter_equal(&e1, &elimit)) ||
+ (g_unichar_isspace(gtk_text_iter_get_char(&e1))))
+ {
+ find_surrounding_word(g, pos, is_delimiter, &start, &end, &s1, &e1);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &elimit, start - 1);
+ *in_string = (gtk_text_iter_get_char(&elimit) == '\"');
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &s1, start);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &e1, end);
+ return(gtk_text_buffer_get_text(g->buffer, &s1, &e1, true));
+ }
+ return(NULL);
+}
+
+
+static bool at_character_constant(glistener *g, int end_pos)
+{
+ GtkTextIter start, end;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end, end_pos);
+ start = end;
+ if (gtk_text_iter_backward_chars(&start, 2))
+ {
+ char *txt;
+ bool result = false;
+ txt = gtk_text_iter_get_text(&start, &end);
+ if (txt)
+ {
+ result = (strcmp(txt, "#\\") == 0);
+ g_free(txt);
+ }
+ return(result);
+ }
+ return(false);
+}
+
+
+static bool find_open_paren(glistener *g, int parens, int pos, int *highlight_pos, GtkTextIter *limit)
+{
+ GtkTextIter scan;
+ int parens_at_line_end, ppos;
+ bool end_scan = false;
+ gunichar c = 0, last_c;
+
+ parens_at_line_end = parens;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, pos);
+ while (gtk_text_iter_compare(limit, &scan) < 0)
+ {
+ last_c = c;
+ c = gtk_text_iter_get_char(&scan);
+
+ if (!at_character_constant(g, gtk_text_iter_get_offset(&scan)))
+ {
+ if (c == (gunichar)'\"')
+ {
+ int d1, d2, qpos;
+ GtkTextIter e;
+ qpos = gtk_text_iter_get_offset(&scan);
+ gtk_text_buffer_get_end_iter(g->buffer, &e);
+ if (find_enclosing_string(g, qpos, &d1, &d2, limit, &e))
+ {
+ ppos = d1;
+ }
+ else
+ {
+ return(false); /* no matching double-quote so we're probably in a string */
+ }
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, ppos);
+ last_c = '\"';
+ }
+ else
+ {
+ if (c == '\n')
+ {
+ if (end_scan)
+ return(true);
+ parens_at_line_end = parens;
+ }
+ else
+ {
+ if (c == (gunichar)';')
+ {
+ parens = parens_at_line_end;
+ end_scan = false;
+ }
+ else
+ {
+ if ((c == (gunichar)'|') &&
+ (last_c == (gunichar)'#')) /* we're looking backwards here, so in the end marker |# we see the # first */
+ {
+ ppos = find_open_block_comment(g, gtk_text_iter_get_offset(&scan), limit);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, ppos);
+ last_c = '#';
+ }
+ else
+ {
+ if (!end_scan)
+ {
+ if (c == ')')
+ parens++;
+ else
+ {
+ if (c == '(')
+ {
+ parens--;
+ if (parens == 0)
+ {
+ (*highlight_pos) = gtk_text_iter_get_offset(&scan);
+ end_scan = true;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ gtk_text_iter_backward_char(&scan);
+ }
+
+ return(parens == 0);
+}
+
+
+static bool find_close_paren(glistener *g, int parens, int pos, int *highlight_pos, GtkTextIter *limit)
+{
+ GtkTextIter scan;
+ int ppos;
+ gunichar c = 0, prev_c = 0;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, pos);
+ while (gtk_text_iter_compare(&scan, limit) < 0)
+ {
+ prev_c = c;
+ c = gtk_text_iter_get_char(&scan);
+ if (!at_character_constant(g, gtk_text_iter_get_offset(&scan)))
+ {
+ if (c == (gunichar)'\"')
+ {
+ ppos = find_string_end(g, gtk_text_iter_get_offset(&scan), limit);
+ if (ppos != -1)
+ {
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, ppos);
+ }
+ prev_c = '\"';
+ }
+ else
+ {
+ if (c == (gunichar)';')
+ gtk_text_iter_forward_to_line_end(&scan);
+ else
+ {
+ if ((c == (gunichar)'|') &&
+ (prev_c == (gunichar)'#'))
+ {
+ ppos = find_close_block_comment(g, gtk_text_iter_get_offset(&scan), limit);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, ppos);
+ }
+ else
+ {
+ if (c == ')')
+ {
+ parens--;
+ if (parens == 0)
+ {
+ (*highlight_pos) = gtk_text_iter_get_offset(&scan);
+ return(true);
+ }
+ }
+ else
+ {
+ if (c == '(')
+ parens++;
+ }
+ }
+ }
+ }
+ }
+ gtk_text_iter_forward_char(&scan);
+ }
+ return(parens == 0);
+}
+
+
+static void add_inverse(glistener *g, int pos)
+{
+ GtkTextIter start, end;
+
+ if (g->flash_paren_pos == -1) g->flash_paren_pos = pos;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, pos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end, pos + 1);
+ if (!g->flash_tag) g->flash_tag = gtk_text_buffer_create_tag(g->buffer, NULL, "background", "red", NULL);
+ gtk_text_buffer_apply_tag(g->buffer, g->flash_tag, &start, &end);
+}
+
+
+static void remove_inverse(glistener *g, int pos)
+{
+ GtkTextIter start, end;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, pos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end, pos + 1);
+ if (!g->flash_tag) g->flash_tag = gtk_text_buffer_create_tag(g->buffer, NULL, "background", "red", NULL);
+ gtk_text_buffer_remove_tag(g->buffer, g->flash_tag, &start, &end);
+}
+
+
+static gint flash_unbalanced_paren(gpointer data)
+{
+ glistener *g = (glistener *)data;
+
+ g->flashes--;
+ if (g->flashes & 1)
+ remove_inverse(g, g->flash_paren_pos);
+ else add_inverse(g, g->flash_paren_pos);
+ if (g->flashes > 0)
+ g_timeout_add_full(0, (guint32)g->flash_time, flash_unbalanced_paren, data, NULL);
+ else
+ {
+ remove_inverse(g, g->flash_paren_pos);
+ g->flash_paren_pos = -1;
+ }
+ return(0);
+}
+
+
+static GtkTextTag *default_highlight_tag = NULL;
+
+void glistener_set_highlight_tag(glistener *g, GtkTextTag *m)
+{
+ if (!g)
+ default_highlight_tag = m;
+ else
+ {
+ g->highlight_tag = m;
+ default_highlight_tag = NULL;
+ }
+}
+
+
+static void add_highlight(glistener *g, int bpos, int epos)
+{
+ GtkTextIter start, end;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, bpos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end, epos);
+ if (!g->highlight_tag)
+ g->highlight_tag = gtk_text_buffer_create_tag(g->buffer, NULL, "weight", PANGO_WEIGHT_BOLD, "foreground", "red", NULL);
+ gtk_text_buffer_apply_tag(g->buffer, g->highlight_tag, &start, &end);
+ g->highlight_start = bpos;
+ g->highlight_end = epos;
+}
+
+
+static void remove_highlight(glistener *g)
+{
+ if ((g->highlight_tag) &&
+ (g->highlight_start != -1))
+ {
+ GtkTextIter start, end;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, g->highlight_start);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end, g->highlight_end);
+ gtk_text_buffer_remove_tag(g->buffer, g->highlight_tag, &start, &end);
+ g->highlight_start = -1;
+ g->highlight_end = -1;
+ }
+}
+
+
+static void check_for_offscreen_matching_paren(glistener *g, int pos)
+{
+ GtkTextIter p;
+ GdkRectangle r; /* actually cairo_rectangle_int_t */
+ int y, height;
+
+ gtk_text_view_get_visible_rect(GTK_TEXT_VIEW(g->text), &r);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &p, pos);
+ gtk_text_view_get_line_yrange(GTK_TEXT_VIEW(g->text), (const GtkTextIter *)(&p), &y, &height);
+
+ if (y < r.y)
+ {
+ GtkTextIter e1;
+ char *text;
+
+ /* p already points to (, so no need to mess with it */
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &e1, pos);
+ if (!gtk_text_iter_ends_line(&e1))
+ gtk_text_iter_forward_to_line_end(&e1);
+ text = gtk_text_buffer_get_text(g->buffer, &p, &e1, false);
+ if (text)
+ {
+ glistener_post_status(g, text);
+ g_free(text);
+ }
+ }
+}
+
+
+static void check_parens(glistener *g)
+{
+ int pos;
+ GtkTextIter scan, limit;
+ gunichar c;
+
+ remove_highlight(g);
+
+ pos = glistener_cursor_position(g);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan, pos - 1);
+
+ c = gtk_text_iter_get_char(&scan);
+ if ((c == ')') &&
+ (!at_character_constant(g, pos - 1)))
+ {
+ int opos = 0;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &limit, find_current_prompt(g) - 1);
+ if (find_open_paren(g, 1, pos - 2, &opos, &limit))
+ {
+ add_highlight(g, opos, opos + 1);
+ check_for_offscreen_matching_paren(g, opos);
+ if (g->checker != default_checker)
+ {
+ char *text;
+ text = glistener_text(g, pos, opos);
+ if (text)
+ {
+ const char *help;
+ help = g->checker(g, (const char *)text);
+ if (help)
+ glistener_post_status(g, help);
+ g_free(text);
+ }
+ }
+ }
+ }
+ else
+ {
+ gtk_text_iter_forward_char(&scan);
+ c = gtk_text_iter_get_char(&scan);
+ if ((c == '(') &&
+ (!at_character_constant(g, pos)))
+ {
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &limit, find_next_prompt(g));
+ if (find_close_paren(g, 1, pos + 1, &pos, &limit))
+ add_highlight(g, pos, pos + 1);
+ }
+ }
+}
+
+
+
+/* ---------------- text editing ---------------- */
+
+static void word_upper(glistener *g, bool capitalize, bool upcase)
+{
+ int pos;
+ GtkTextIter start, end;
+ char *text = NULL, *up_text = NULL, *down_text = NULL;
+
+ pos = glistener_cursor_position(g);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, pos);
+ end = start;
+ gtk_text_iter_forward_word_end(&end);
+
+ if (upcase)
+ {
+ text = gtk_text_buffer_get_text(g->buffer, &start, &end, true);
+ up_text = g_utf8_strup(text, -1);
+ }
+ else
+ {
+ if (!capitalize)
+ {
+ text = gtk_text_buffer_get_text(g->buffer, &start, &end, true);
+ down_text = g_utf8_strdown(text, -1);
+ }
+ else
+ {
+ GtkTextIter pstart;
+ char *text0;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &pstart, pos);
+ if (g_unichar_isspace(gtk_text_iter_get_char(&pstart)))
+ gtk_text_iter_forward_find_char(&pstart, is_not_whitespace, NULL, &end);
+ gtk_text_iter_forward_char(&pstart);
+
+ text0 = gtk_text_buffer_get_text(g->buffer, &start, &pstart, true);
+ text = gtk_text_buffer_get_text(g->buffer, &pstart, &end, true);
+
+ up_text = g_utf8_strup(text0, -1);
+ down_text = g_utf8_strdown(text, -1);
+ g_free(text0);
+ }
+ }
+
+ gtk_text_buffer_delete(g->buffer, &start, &end);
+ if (up_text)
+ gtk_text_buffer_insert(g->buffer, &start, up_text, -1);
+ if (down_text)
+ gtk_text_buffer_insert(g->buffer, &start, down_text, -1);
+
+ if (text) g_free(text);
+ if (up_text) g_free(up_text);
+ if (down_text) g_free(down_text);
+}
+
+
+static void text_transpose(glistener *g)
+{
+ int curpos;
+ GtkTextIter start, end;
+
+ curpos = glistener_cursor(g, &end);
+ if (!is_prompt_end(g, curpos))
+ {
+ char *text, *new_text;
+ start = end;
+ gtk_text_iter_backward_char(&start);
+ gtk_text_iter_forward_char(&end);
+ text = gtk_text_buffer_get_text(g->buffer, &start, &end, false);
+ new_text = g_utf8_strreverse(text, -1);
+ gtk_text_buffer_delete(g->buffer, &start, &end);
+ gtk_text_buffer_insert(g->buffer, &start, new_text, -1);
+ g_free(text);
+ g_free(new_text);
+ }
+}
+
+
+static void clear_back_to_prompt(glistener *g)
+{
+ int beg, end;
+ GtkTextIter start, last;
+
+ end = glistener_cursor_position(g);
+ beg = find_current_prompt(g);
+ if (end <= beg) return;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, beg);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &last, end);
+ gtk_text_buffer_delete(g->buffer, &start, &last);
+}
+
+
+
+/* ---------------- key bindings ---------------- */
+
+void glistener_key_bindings(glistener *g, gpointer cls)
+{
+ /* emacs key bindings for the most part
+ */
+ GtkBindingSet *set;
+ set = gtk_binding_set_by_class(cls);
+
+ /* C-a start of line */
+ gtk_binding_entry_remove(set, GDK_KEY_a, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_a, GDK_CONTROL_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINE_ENDS,
+ G_TYPE_INT, -1,
+ G_TYPE_BOOLEAN, false);
+
+ /* C-b back char */
+ gtk_binding_entry_remove(set, GDK_KEY_b, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_b, GDK_CONTROL_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_VISUAL_POSITIONS,
+ G_TYPE_INT, -1,
+ G_TYPE_BOOLEAN, false);
+
+ /* M-b back word */
+ gtk_binding_entry_remove(set, GDK_KEY_b, GDK_MOD1_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_b, GDK_MOD1_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_WORDS,
+ G_TYPE_INT, -1,
+ G_TYPE_BOOLEAN, false);
+
+ /* C-d delete at cursor */
+ gtk_binding_entry_remove(set, GDK_KEY_d, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_d, GDK_CONTROL_MASK,
+ "delete_from_cursor", 2,
+ G_TYPE_ENUM, GTK_DELETE_CHARS,
+ G_TYPE_INT, 1); /* -1 = delete to left of cursor */
+
+ /* C-e end of line */
+ gtk_binding_entry_remove(set, GDK_KEY_e, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_e, GDK_CONTROL_MASK, "move_cursor", 3, /* 3 = n_args */
+ G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINE_ENDS,
+ G_TYPE_INT, 1,
+ G_TYPE_BOOLEAN, false);
+
+ /* C-f forward char */
+ gtk_binding_entry_remove(set, GDK_KEY_f, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_f, GDK_CONTROL_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_VISUAL_POSITIONS,
+ G_TYPE_INT, 1,
+ G_TYPE_BOOLEAN, false);
+
+ /* M-f forward word */
+ gtk_binding_entry_remove(set, GDK_KEY_f, GDK_MOD1_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_f, GDK_MOD1_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_WORDS,
+ G_TYPE_INT, 1,
+ G_TYPE_BOOLEAN, false);
+
+ /* C-n down line */
+ gtk_binding_entry_remove(set, GDK_KEY_n, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_n, GDK_CONTROL_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINES,
+ G_TYPE_INT, 1,
+ G_TYPE_BOOLEAN, false);
+
+ /* C-p up line */
+ gtk_binding_entry_remove(set, GDK_KEY_p, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_p, GDK_CONTROL_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINES,
+ G_TYPE_INT, -1,
+ G_TYPE_BOOLEAN, false);
+
+ /* C-y yank <- clipboard */
+ gtk_binding_entry_remove(set, GDK_KEY_y, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_y, GDK_CONTROL_MASK,
+ "paste_clipboard", 0);
+
+ /* C-w delete region -> clipboard -- it's possible to clobber a prompt here */
+ gtk_binding_entry_remove(set, GDK_KEY_w, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_w, GDK_CONTROL_MASK,
+ "cut_clipboard", 0);
+
+ /* M-< start of file */
+ gtk_binding_entry_remove(set, GDK_KEY_less, GDK_MOD1_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_less, GDK_MOD1_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_BUFFER_ENDS,
+ G_TYPE_INT, -1,
+ G_TYPE_BOOLEAN, false);
+
+ /* M-> end of file */
+ gtk_binding_entry_remove(set, GDK_KEY_greater, GDK_MOD1_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_greater, GDK_MOD1_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_BUFFER_ENDS,
+ G_TYPE_INT, 1,
+ G_TYPE_BOOLEAN, false);
+
+ /* down-arrow end of file */
+ gtk_binding_entry_remove(set, GDK_KEY_Down, (GdkModifierType)0);
+ gtk_binding_entry_add_signal(set, GDK_KEY_Down, (GdkModifierType)0, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_BUFFER_ENDS,
+ G_TYPE_INT, 1,
+ G_TYPE_BOOLEAN, false);
+
+ /* up-arrow start of file */
+ gtk_binding_entry_remove(set, GDK_KEY_Up, (GdkModifierType)0);
+ gtk_binding_entry_add_signal(set, GDK_KEY_Up, (GdkModifierType)0, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_BUFFER_ENDS,
+ G_TYPE_INT, -1,
+ G_TYPE_BOOLEAN, false);
+
+ /* right-arrow end of line */
+ gtk_binding_entry_remove(set, GDK_KEY_Right, (GdkModifierType)0);
+ gtk_binding_entry_add_signal(set, GDK_KEY_Right, (GdkModifierType)0, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINE_ENDS,
+ G_TYPE_INT, 1,
+ G_TYPE_BOOLEAN, false);
+
+ /* left-arrow start of line */
+ gtk_binding_entry_remove(set, GDK_KEY_Left, (GdkModifierType)0);
+ gtk_binding_entry_add_signal(set, GDK_KEY_Left, (GdkModifierType)0, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINE_ENDS,
+ G_TYPE_INT, -1,
+ G_TYPE_BOOLEAN, false);
+
+ /* C-v move down a window */
+ gtk_binding_entry_remove(set, GDK_KEY_v, GDK_CONTROL_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_v, GDK_CONTROL_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_PAGES,
+ G_TYPE_INT, 1,
+ G_TYPE_BOOLEAN, false);
+
+ /* M-v for up window */
+ gtk_binding_entry_remove(set, GDK_KEY_v, GDK_MOD1_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_v, GDK_MOD1_MASK, "move_cursor", 3,
+ G_TYPE_ENUM, GTK_MOVEMENT_PAGES,
+ G_TYPE_INT, -1,
+ G_TYPE_BOOLEAN, false);
+
+ /* M-d delete word at cursor */
+ gtk_binding_entry_remove(set, GDK_KEY_d, GDK_MOD1_MASK);
+ gtk_binding_entry_add_signal(set, GDK_KEY_d, GDK_MOD1_MASK,
+ "delete_from_cursor", 2,
+ G_TYPE_ENUM, GTK_DELETE_WORD_ENDS,
+ G_TYPE_INT, 1);
+}
+
+
+
+static void glistener_return_callback(glistener *g);
+static void glistener_completion(glistener *g, int end);
+
+
+static gboolean glistener_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+{
+ glistener *g = (glistener *)data;
+
+ if ((g->keyer == default_keyer) ||
+ (!(g->keyer(g, w, event))))
+ {
+ guint key;
+ GdkModifierType state;
+
+ key = EVENT_KEYVAL(event);
+ state = (GdkModifierType)EVENT_STATE(event);
+
+ /* fprintf(stderr, "key: %d, state: %x\n", key, state); */
+
+#if 1
+ /* just a fun hack -- need to make a map to do this right
+ * could be 1..3 bytes long
+ * perhaps C->c4, M->c5, []->3, CM->c8?
+ */
+ if (state & GDK_SUPER_MASK)
+ {
+ char p[3];
+ p[0] = 0xce;
+ p[1] = key + (0xbb - GDK_KEY_l); /* works for lambda */
+ p[2] = 0;
+ glistener_insert_text(g, p);
+ g_signal_stop_emission((gpointer)w, g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
+ return(false);
+ }
+#endif
+
+ switch (key)
+ {
+ /* further processing (by gtk) of the keystroke is blocked if we fall through */
+ case GDK_KEY_a:
+ if (state & MetaMask)
+ glistener_set_cursor_position(g, find_previous_prompt(g, glistener_cursor_position(g)));
+ else return(false);
+ break;
+
+ case GDK_KEY_c:
+ if (state & MetaMask)
+ word_upper(g, true, false);
+ else return(false);
+ break;
+
+ case GDK_KEY_d:
+ if (state & ControlMask)
+ {
+ /* need to check for prompt just ahead */
+ if (!is_prompt_end(g, glistener_cursor_position(g) + g->prompt_length))
+ return(false);
+ /* else we're sitting at (just in front of) the prompt so drop through and block the signal */
+ }
+ else
+ {
+ if (state & MetaMask)
+ {
+ GtkTextIter p;
+ int i, pos, new_pos, cur;
+ bool hits_prompt = false;
+
+ pos = glistener_cursor(g, &p);
+ gtk_text_iter_forward_word_end(&p);
+ new_pos = gtk_text_iter_get_offset(&p);
+ cur = pos + g->prompt_length;
+
+ /* if there's a prompt somewhere between pos and new_pos, block this deletion */
+ for (i = 0; i < (new_pos - pos); i++)
+ {
+ hits_prompt = is_prompt_end(g, cur + i);
+ if (hits_prompt)
+ break;
+ }
+ if (!hits_prompt)
+ return(false);
+ }
+ else return(false);
+ }
+ break;
+
+ case GDK_KEY_e:
+ if (state & MetaMask)
+ glistener_set_cursor_position(g, find_next_prompt(g) - 1);
+ else return(false);
+ break;
+
+ case GDK_KEY_BackSpace:
+ /* need to check for prompt at cursor */
+ if (!is_prompt_end(g, glistener_cursor_position(g)))
+ return(false);
+ break;
+
+ case GDK_KEY_k:
+ if (state & ControlMask)
+ {
+ /* select to line end, copy to clipboard, delete */
+ GtkTextIter beg, end;
+
+ gtk_text_buffer_get_iter_at_mark(g->buffer, &beg, gtk_text_buffer_get_mark(g->buffer, "insert"));
+ end = beg;
+ gtk_text_iter_forward_to_line_end(&end); /* was forward_to_end! */
+ if (!gtk_text_iter_equal(&beg, &end))
+ {
+ gtk_text_buffer_select_range(g->buffer, &beg, &end);
+ gtk_text_buffer_cut_clipboard(g->buffer, gtk_widget_get_clipboard(w, GDK_SELECTION_CLIPBOARD), true);
+ }
+ }
+ else return(false);
+ break;
+
+ case GDK_KEY_l:
+ if (state & MetaMask)
+ word_upper(g, false, false);
+ else return(false);
+ break;
+
+ case GDK_KEY_n:
+ if (state & MetaMask)
+ {
+ clear_back_to_prompt(g);
+ restore_listener_string(g, false);
+ }
+ else return(false);
+ break;
+
+ case GDK_KEY_p:
+ if (state & MetaMask)
+ {
+ clear_back_to_prompt(g);
+ restore_listener_string(g, true);
+ }
+ else return(false);
+ break;
+
+ case GDK_KEY_t:
+ if (state & ControlMask)
+ {
+ int pos;
+ pos = glistener_cursor_position(g);
+ if ((!is_prompt_end(g, pos)) &&
+ (!is_prompt_end(g, pos + g->prompt_length)))
+ text_transpose(g);
+ else return(false);
+ }
+ else return(false);
+ break;
+
+ case GDK_KEY_u:
+ if (state & MetaMask)
+ word_upper(g, false, true);
+ else return(false);
+ break;
+
+ case GDK_KEY_w:
+ if (state & ControlMask)
+ {
+ GtkTextIter start, end;
+ bool has_selection;
+ has_selection = gtk_text_buffer_get_selection_bounds(g->buffer, &start, &end);
+ if (!has_selection)
+ return(false);
+ if (gtk_text_iter_get_offset(&start) >= g->prompt_length)
+ return(false);
+ }
+ else return(false);
+ break;
+
+ case GDK_KEY_Tab:
+ glistener_completion(g, glistener_cursor_position(g));
+ return(true);
+
+ case GDK_KEY_Return:
+ if (state & ControlMask) /* C-return -> insert return no matter what */
+ glistener_insert_text(g, "\n");
+ else glistener_return_callback(g);
+ break;
+
+ default:
+ return(false);
+ }
+ }
+
+ g_signal_stop_emission((gpointer)w, g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
+ return(false);
+}
+
+
+static void post_help(glistener *g, int pos)
+{
+ GtkTextIter s1, e1;
+ int start = 0, end = 0;
+ char *text;
+
+ if (g->helper == default_helper) return;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &s1, find_current_prompt(g));
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &e1, find_next_prompt(g));
+ find_surrounding_word(g, pos, is_delimiter, &start, &end, &s1, &e1);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &s1, start);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &e1, end);
+
+ text = gtk_text_buffer_get_text(g->buffer, &s1, &e1, true);
+ if (text)
+ {
+ const char *help;
+ help = g->helper(g, text);
+ if (help)
+ glistener_post_status(g, help);
+ g_free(text);
+ }
+}
+
+
+static void check_for_open_paren_help(glistener *g)
+{
+ int pos;
+ GtkTextIter limit;
+ pos = glistener_cursor_position(g);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &limit, find_current_prompt(g) - 1);
+ if (find_open_paren(g, 1, pos - 2, &pos, &limit))
+ post_help(g, pos + 1);
+}
+
+
+static gboolean glistener_key_release(GtkWidget *w, GdkEventKey *event, gpointer data)
+{
+ glistener *g = (glistener *)data;
+ int cpos;
+ GtkTextIter c;
+ /* before doing anything, make sure we're not in the prompt! */
+
+ cpos = glistener_cursor_position(g);
+ if (cpos < g->prompt_length)
+ glistener_set_cursor_position(g, g->prompt_length - 1);
+ else
+ {
+ int bpos;
+ bpos = find_current_prompt(g);
+ if (cpos < bpos)
+ glistener_set_cursor_position(g, bpos);
+ }
+
+ /* and mark matching paren, if any */
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &c, glistener_cursor_position(g) - 1);
+ if (gtk_text_iter_get_char(&c) != ')')
+ check_for_open_paren_help(g);
+ else glistener_clear_status(g);
+ check_parens(g);
+ return(false);
+}
+
+
+static void text_insert(GtkTextBuffer *textbuffer, GtkTextIter *location, gchar *text, gint len, gpointer data)
+{
+ /* insert-text signal */
+ glistener *g = (glistener *)data;
+ g->insertion_position = gtk_text_iter_get_offset(location);
+}
+
+
+static void check_for_empty_listener(GtkTextView *w, gpointer data)
+{
+ /* cut-clipboard signal */
+ glistener *g = (glistener *)data;
+ if (gtk_text_buffer_get_char_count(g->buffer) == 0)
+ {
+ /* put a prompt back in! */
+ GtkTextIter start;
+ gtk_text_buffer_get_start_iter(g->buffer, &start);
+ prompt_insert(g, &start, true);
+ }
+}
+
+
+static gboolean glistener_button_release(GtkWidget *w, GdkEventButton *ev, gpointer data)
+{
+ glistener *g = (glistener *)data;
+
+ if (EVENT_STATE(ev) & GDK_BUTTON2_MASK)
+ glistener_set_cursor_position(g, g->insertion_position);
+ else
+ {
+ int cpos;
+ /* before doing anything, make sure we're not in the prompt! */
+
+ cpos = glistener_cursor_position(g);
+ if (cpos < g->prompt_length)
+ glistener_set_cursor_position(g, g->prompt_length - 1);
+ else
+ {
+ int bpos;
+ bpos = find_current_prompt(g);
+ if (cpos < bpos)
+ glistener_set_cursor_position(g, bpos);
+ }
+ }
+ check_parens(g);
+ post_help(g, glistener_cursor_position(g));
+ return(false);
+}
+
+
+
+
+
+/* ---------------- <cr> evaluation ---------------- */
+
+static void eval_text(glistener *g, GtkTextIter *start, GtkTextIter *end)
+{
+ char *text;
+
+ text = gtk_text_buffer_get_text(g->buffer, start, end, false);
+ if (text)
+ {
+ GtkTextIter s, e, cursor_iter;
+ gtk_text_buffer_get_iter_at_mark(g->buffer, &cursor_iter, gtk_text_buffer_get_insert(g->buffer));
+ if (gtk_text_iter_forward_search(&cursor_iter, g->prompt, (GtkTextSearchFlags)0, &s, &e, NULL))
+ glistener_append_text(g, text);
+ glistener_set_cursor_shape(g, g->wait_cursor);
+ remember_listener_string(g, text);
+ g->evaluator(g, text);
+ glistener_set_cursor_shape(g, g->arrow_cursor);
+ glistener_set_cursor_position(g, gtk_text_buffer_get_char_count(g->buffer));
+ g_free(text);
+ }
+}
+
+
+static int find_expression_limits(glistener *g, int *bpos, int *epos)
+{
+ GtkTextIter cursor, start, end;
+ int pos;
+
+ pos = glistener_cursor_position(g);
+ if (pos < g->prompt_length - 1)
+ *bpos = g->prompt_length - 1;
+ else
+ {
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &cursor, pos + g->prompt_length - 1);
+ if (!prompt_backward_search(g, &cursor, &start, &end))
+ *bpos = g->prompt_length - 1;
+ else *bpos = gtk_text_iter_get_offset(&start) + g->prompt_length;
+ }
+
+ pos = glistener_cursor(g, &cursor);
+ if (!gtk_text_iter_forward_search(&cursor, g->prompt, (GtkTextSearchFlags)0, &start, &end, NULL))
+ {
+ gtk_text_buffer_get_end_iter(g->buffer, &end);
+ *epos = gtk_text_iter_get_offset(&end);
+ }
+ else *epos = gtk_text_iter_get_offset(&start);
+ /* now the expression is between bpos and epos */
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start, *bpos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end, *epos);
+
+ if (g_unichar_isspace(gtk_text_iter_get_char(&start)))
+ gtk_text_iter_forward_find_char(&start, is_not_whitespace, NULL, &end);
+ if (gtk_text_iter_compare(&start, &end) >= 0)
+ *bpos = *epos;
+ else
+ {
+ GtkTextIter e1;
+ e1 = end;
+ gtk_text_iter_backward_char(&e1);
+ if (g_unichar_isspace(gtk_text_iter_get_char(&e1)))
+ gtk_text_iter_backward_find_char(&end, is_not_whitespace, NULL, &start);
+
+ *bpos = gtk_text_iter_get_offset(&start);
+ *epos = gtk_text_iter_get_offset(&end) + 1;
+ }
+
+ if (gtk_text_iter_compare(&start, &cursor) > 0)
+ {
+ GtkTextIter e1;
+ e1 = cursor;
+ gtk_text_iter_backward_char(&e1);
+ if (g_unichar_isspace(gtk_text_iter_get_char(&e1)))
+ gtk_text_iter_backward_find_char(&cursor, is_not_whitespace, NULL, &start);
+ pos = gtk_text_iter_get_offset(&cursor);
+ }
+ return(pos);
+}
+
+
+static void glistener_return_callback(glistener *g)
+{
+ GtkTextIter scan_iter, end_iter, cursor_iter;
+ int cursor_pos, start_pos, end_pos, expr_start = -1, any_start = -1, open_parens = 0, prev_start = -1;
+
+ glistener_clear_status(g);
+
+ if (!g->is_schemish)
+ {
+ GtkTextIter a, b;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &a, find_current_prompt(g)); /* or perhaps line start if not on the prompt line? */
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &b, glistener_cursor_position(g));
+ if (!gtk_text_iter_ends_line(&b))
+ gtk_text_iter_forward_to_line_end(&b);
+ eval_text(g, &a, &b);
+ return;
+ }
+
+ remove_highlight(g);
+ cursor_pos = find_expression_limits(g, &start_pos, &end_pos);
+ if (start_pos >= end_pos) /* <cr> at end? */
+ {
+ glistener_append_text(g, "\n");
+ return;
+ }
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan_iter, start_pos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end_iter, end_pos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &cursor_iter, cursor_pos);
+
+ while (gtk_text_iter_compare(&scan_iter, &end_iter) < 0)
+ {
+ gunichar c;
+ c = gtk_text_iter_get_char(&scan_iter);
+
+ /* fprintf(stderr, "%c ", c); */
+ if (!g_unichar_isspace(c))
+ {
+ if (any_start == -1)
+ any_start = gtk_text_iter_get_offset(&scan_iter);
+
+ switch (c)
+ {
+ case '"':
+ {
+ int slashes = 0;
+ GtkTextIter str_iter;
+ str_iter = scan_iter;
+ if (!gtk_text_iter_forward_find_char(&scan_iter, is_unslashed_double_quote, &slashes, &end_iter))
+ {
+ /* we're in an unclosed string constant */
+ glistener_insert_text(g, "\n");
+ return;
+ }
+ gtk_text_iter_forward_char(&scan_iter); /* step over the close double-quote */
+
+ if (expr_start == -1)
+ {
+ if (gtk_text_iter_compare(&cursor_iter, &scan_iter) <= 0)
+ {
+ /* we're in a string with no surrounding context */
+ eval_text(g, &str_iter, &scan_iter);
+ return;
+ }
+ prev_start = gtk_text_iter_get_offset(&str_iter);
+ }
+ }
+ continue;
+ break;
+
+ case ';':
+ {
+ gtk_text_iter_forward_to_line_end(&scan_iter);
+ if ((expr_start == -1) &&
+ (gtk_text_iter_compare(&cursor_iter, &scan_iter) <= 0))
+ {
+ /* we're in a comment and there's no enclosing context, but there might be a preceding expression */
+ if (prev_start != -1)
+ {
+ GtkTextIter semi_iter;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &semi_iter, prev_start);
+ eval_text(g, &semi_iter, &scan_iter);
+ return;
+ }
+ glistener_insert_text(g, "\n");
+ return;
+ }
+ }
+ break;
+
+ case '#':
+ {
+ /* the special cases here involve block comments and character constants
+ * there's also #<...> if user types inside the brackets and there's whitespace to confuse it
+ */
+ GtkTextIter bc_iter, c_iter;
+ gunichar nc;
+
+ c_iter = scan_iter;
+ bc_iter = scan_iter;
+ gtk_text_iter_forward_char(&bc_iter);
+ nc = gtk_text_iter_get_char(&bc_iter);
+
+ if (nc == '|')
+ {
+ int last_cs = 0;
+ if (!gtk_text_iter_forward_find_char(&scan_iter, is_block_comment, &last_cs, &end_iter))
+ {
+ /* we're in a unclosed block comment */
+ glistener_insert_text(g, "\n");
+ return;
+ }
+ if ((expr_start == -1) &&
+ (gtk_text_iter_compare(&cursor_iter, &scan_iter) <= 0))
+ {
+ /* we're in a block comment and there's no enclosing context, but there might be a preceding expression */
+ if (prev_start != -1)
+ {
+ GtkTextIter semi_iter;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &semi_iter, prev_start);
+ eval_text(g, &semi_iter, &scan_iter);
+ return;
+ }
+ glistener_insert_text(g, "\n");
+ return;
+ }
+ }
+ else
+ {
+ if (nc == '\\')
+ {
+ gtk_text_iter_forward_chars(&scan_iter, 2);
+ if (gtk_text_iter_get_char(&scan_iter) == 'x')
+ {
+ gtk_text_iter_forward_char(&scan_iter);
+ while (g_unichar_isdigit(gtk_text_iter_get_char(&scan_iter)))
+ gtk_text_iter_forward_char(&scan_iter);
+ }
+ else gtk_text_iter_forward_char(&scan_iter);
+
+ if (expr_start == -1)
+ {
+ if (gtk_text_iter_compare(&cursor_iter, &scan_iter) <= 0)
+ {
+ /* we're in a character constant with no surrounding context */
+ eval_text(g, &c_iter, &scan_iter);
+ return;
+ }
+ prev_start = gtk_text_iter_get_offset(&c_iter);
+ }
+ continue;
+ }
+ else
+ {
+ /* a variable name can't start with '#', so I think we can assume #<... must have a closing > ?
+ * other retricted chars: ,:`'
+ */
+ if (nc == '<')
+ gtk_text_iter_forward_find_char(&scan_iter, is_gt, NULL, &end_iter);
+ }
+ }
+ }
+ break;
+
+ case '(':
+ if (open_parens == 0)
+ expr_start = gtk_text_iter_get_offset(&scan_iter);
+ open_parens++;
+ break;
+
+ case ')':
+ open_parens--;
+ if (open_parens == 0)
+ {
+ GtkTextIter c_iter;
+ /* see if the cursor is in the current expression */
+
+ if (expr_start == -1)
+ {
+ /* unmatched close-paren */
+ add_inverse(g, gtk_text_iter_get_offset(&scan_iter));
+ g->flashes = 4;
+ g_timeout_add_full(0, (guint32)g->flash_time, flash_unbalanced_paren, (gpointer)g, NULL);
+ glistener_post_status(g, "unmatched ')'");
+ return;
+ }
+
+ gtk_text_iter_forward_char(&scan_iter);
+ c_iter = scan_iter;
+ while (g_unichar_isspace(gtk_text_iter_get_char(&c_iter)))
+ gtk_text_iter_forward_char(&c_iter);
+
+ if (gtk_text_iter_compare(&cursor_iter, &c_iter) <= 0)
+ {
+ /* we're in an expression with no surrounding context */
+ GtkTextIter c_iter;
+ if (any_start != -1)
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &c_iter, any_start);
+ else gtk_text_buffer_get_iter_at_offset(g->buffer, &c_iter, expr_start);
+ eval_text(g, &c_iter, &scan_iter);
+ return;
+ }
+
+ if (any_start != -1) prev_start = any_start; else prev_start = expr_start;
+
+ expr_start = -1;
+ any_start = -1;
+ continue;
+ }
+ break;
+ }
+ }
+ else
+ {
+ if (expr_start == -1)
+ {
+ if (any_start != -1)
+ {
+ if (gtk_text_iter_compare(&cursor_iter, &scan_iter) <= 0)
+ {
+ GtkTextIter c_iter;
+ /* an atom with no context */
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &c_iter, any_start);
+ eval_text(g, &c_iter, &scan_iter);
+ return;
+ }
+ prev_start = any_start;
+ any_start = -1;
+ }
+ }
+ }
+
+ gtk_text_iter_forward_char(&scan_iter);
+ }
+ /* we fell off the end */
+
+ if (open_parens == 0)
+ {
+ GtkTextIter c_iter;
+ /* an atom with no context */
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &c_iter, any_start);
+ eval_text(g, &c_iter, &end_iter);
+ return;
+ }
+
+ /* find unmatched open-paren, etc */
+ if (open_parens > 1) /* if == 1, it's at expr_start */
+ {
+ GtkTextIter p_iter;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &p_iter, start_pos);
+ find_open_paren(g, open_parens - 1, end_pos, &expr_start, &p_iter);
+ }
+
+ add_inverse(g, expr_start);
+ g->flashes = 4;
+ g_timeout_add_full(0, (guint32)g->flash_time, flash_unbalanced_paren, (gpointer)g, NULL);
+ glistener_post_status(g, "unmatched '('");
+ glistener_insert_text(g, "\n");
+}
+
+
+
+
+/* ---------------- <tab> completion and indentation ---------------- */
+
+/* realpath eqv in glib? -- not available yet (many complaints ...)
+ */
+
+#ifndef _MSC_VER
+#include <sys/stat.h>
+#endif
+
+static bool is_directory(const char *filename)
+{
+#ifndef _MSC_VER
+ #ifdef S_ISDIR
+ struct stat statbuf;
+ return((stat(filename, &statbuf) >= 0) &&
+ (S_ISDIR(statbuf.st_mode)));
+ #endif
+#endif
+ return(false);
+}
+
+static char *filename_completion(glistener *g, const char *partial_name)
+{
+ char *file_name = NULL, *directory_name = NULL, *temp, *new_name = NULL, *slash, *current_match = NULL, *result = NULL;
+ int len = 0, flen, matches = 0;
+
+ if (partial_name[0] == '~')
+ {
+ const char *home;
+ home = g_getenv("HOME");
+ if (home)
+ {
+ new_name = (char *)calloc(strlen(partial_name) + strlen(home) + 1, sizeof(char));
+ strncpy(new_name, home, strlen(home));
+ strcat(new_name, (char *)(partial_name + 1));
+ }
+ }
+ if (!new_name)
+ {
+ int new_len;
+ new_len = strlen(partial_name) + 1;
+ new_name = (char *)calloc(new_len, sizeof(char));
+ strcopy(new_name, partial_name, new_len);
+ }
+
+ slash = g_utf8_strrchr(new_name, -1, (gunichar)'/');
+ if (slash)
+ {
+ len = slash - new_name + 1;
+ temp = (char *)malloc(len * sizeof(char));
+ file_name = (char *)(new_name + len);
+ strcopy(temp, new_name, len);
+ temp[len - 1] = '\0';
+ directory_name = realpath(temp, NULL);
+ free(temp);
+ }
+ else
+ {
+ file_name = (char *)partial_name;
+ directory_name = g_get_current_dir();
+ }
+ if (file_name)
+ flen = strlen(file_name);
+ else return(NULL);
+
+ glistener_clear_status(g);
+
+ if ((directory_name) && (file_name))
+ {
+ GDir *dir;
+ dir = g_dir_open(directory_name, 0, NULL);
+ while (true)
+ {
+ const char *rname;
+ rname = g_dir_read_name(dir);
+ if (!rname) break;
+ if (strncmp(rname, file_name, flen) == 0)
+ {
+ if (strcmp(rname, file_name) != 0)
+ glistener_append_status(g, rname);
+ if (current_match == NULL)
+ {
+ len = strlen(rname);
+ current_match = (char *)calloc(len + 2, sizeof(char));
+ strcopy(current_match, rname, len + 2);
+ }
+ else
+ {
+ int j;
+ matches++;
+ for (j = 0; j < len; j++)
+ if (current_match[j] != rname[j])
+ {
+ current_match[j] = '\0';
+ len = j;
+ if (len <= flen)
+ {
+ /* can't extend current name because of ambiguous matches, so give up */
+ g_dir_close(dir);
+ if (directory_name) free(directory_name);
+ if (new_name) free(new_name);
+ return(NULL);
+ }
+ break;
+ }
+ }
+ }
+ }
+ if (dir) g_dir_close(dir);
+ }
+
+ if (len == flen)
+ result = NULL;
+ else
+ {
+ result = current_match;
+ if ((slash) &&
+ (current_match))
+ {
+ /* attach matched portion to user's indication of dir */
+ result = (char *)calloc(strlen(partial_name) + strlen(current_match) + 3, sizeof(char));
+ temp = g_utf8_strrchr(partial_name, -1, (gunichar)'/');
+ strncpy(result, partial_name, temp - partial_name + 1);
+ strcat(result, current_match);
+ free(current_match);
+ }
+
+ if ((result) && (matches == 0))
+ {
+ if ((directory_name) && (result[0] == '~'))
+ {
+ char *str;
+ str = (char *)calloc(strlen(directory_name) + strlen(result) + 2, sizeof(char));
+ strcat(str, directory_name);
+ strcat(str, "/");
+ strcat(str, (char *)(result + 1));
+ if (is_directory(str))
+ strcat(result, "/");
+ else strcat(result, "\"");
+ free(str);
+ }
+ else
+ {
+ if (is_directory(result))
+ strcat(result, "/");
+ else strcat(result, "\"");
+ }
+ }
+ }
+ if (directory_name) free(directory_name);
+ if (new_name) free(new_name);
+ return(result);
+}
+
+
+typedef struct {
+ const char *text;
+ char *current_match;
+ int len, tlen;
+ glistener *g;
+} match_info;
+
+static bool compare_names(const char *symbol_name, void *data)
+{
+ match_info *m = (match_info *)data;
+ if (strncmp(m->text, symbol_name, m->tlen) == 0)
+ {
+ if (strcmp(m->text, symbol_name) != 0)
+ glistener_append_status(m->g, symbol_name);
+
+ if (m->current_match == NULL)
+ {
+ m->len = strlen(symbol_name);
+ m->current_match = (char *)calloc(m->len + 1, sizeof(char));
+ strcopy(m->current_match, symbol_name, m->len + 1);
+ }
+ else
+ {
+ int j;
+ for (j = 0; j < m->len; j++)
+ if (m->current_match[j] != symbol_name[j])
+ {
+ m->current_match[j] = '\0';
+ m->len = j;
+ break;
+ }
+ }
+ }
+ return((m->len > 0) && (m->len <= m->tlen));
+}
+
+
+static char *symbol_completion(glistener *g, const char *text)
+{
+ match_info *m;
+ char *result = NULL;
+
+ if (g->completer == default_completer) return(NULL);
+
+ m = (match_info *)calloc(1, sizeof(match_info));
+ m->text = text;
+ m->tlen = strlen(text);
+ m->len = 0;
+ m->current_match = NULL;
+ m->g = g;
+ glistener_clear_status(g);
+ g->completer(g, compare_names, (void *)m);
+ if (m->len > m->tlen)
+ result = m->current_match;
+ else
+ {
+ if (m->current_match)
+ free(m->current_match);
+ }
+ free(m);
+ return(result);
+}
+
+
+static void glistener_completion(glistener *g, int pos)
+{
+ /* <whitespace><tab><any> -> indent (no-op if on prompt line and at end?) [tmp has old indentation code]
+ * <text><tab><whitespace> -> try to complete
+ * <text><tab><text> -> ???
+ *
+ * in check_parens, if paren found, check expr for
+ * undefined vars, refedined globals, run lint for other errors
+ *
+ * when key release, also perhaps look for possible completions (with list if > 1)
+ */
+
+ char *text;
+ bool in_string = false;
+
+ text = get_preceding_text(g, pos, &in_string);
+ if ((text) && (*text))
+ {
+ char *new_name;
+ if (!in_string)
+ {
+ if ((g->is_schemish) &&
+ (text[0] == '\'')) /* quoted partial symbol name */
+ {
+ char *unq;
+ unq = symbol_completion(g, (char *)(text + 1));
+ if (unq)
+ {
+ int len;
+ len = strlen(unq);
+ new_name = (char *)malloc((len + 2) * sizeof(char));
+ new_name[0] = '\'';
+ memcpy((void *)(new_name + 1), (void *)unq, len);
+ new_name[len + 1] = '\0';
+ free(unq);
+ }
+ else new_name = NULL;
+ }
+ else new_name = symbol_completion(g, text);
+ }
+ else new_name = filename_completion(g, text);
+ if (new_name)
+ {
+ int old_len, new_len;
+ old_len = strlen(text);
+ new_len = strlen(new_name);
+ gtk_text_buffer_insert_at_cursor(g->buffer, (char *)(new_name + old_len), new_len - old_len);
+ free(new_name);
+ }
+ g_free(text);
+ }
+ else
+ {
+ /* here we're indenting. This code assumes we're using a true fixed width font -- "nimbus mono 10" is not one.
+ */
+ int pos, bpos, epos, bline, cline, linepos, linecol;
+ GtkTextIter cursor, curline, start_limit, end_limit;
+
+ pos = find_expression_limits(g, &bpos, &epos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start_limit, bpos - 1);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end_limit, epos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &cursor, pos);
+ bline = gtk_text_iter_get_line(&start_limit);
+ /* eline = gtk_text_iter_get_line(&end_limit); */
+ cline = gtk_text_iter_get_line(&cursor);
+ gtk_text_buffer_get_iter_at_line(g->buffer, &curline, cline);
+ linepos = gtk_text_iter_get_offset(&curline);
+ linecol = gtk_text_iter_get_line_offset(&cursor);
+
+ if ((bline == cline) ||
+ (find_not_whitespace(g, linepos, &cursor)))
+ glistener_insert_text(g, " ");
+ else
+ {
+ GtkTextIter paren;
+ int oparen_pos;
+ if (!find_open_paren(g, 1, pos, &oparen_pos, &start_limit))
+ glistener_insert_text(g, " ");
+ else
+ {
+ int oparen_col;
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &paren, oparen_pos);
+ oparen_col = gtk_text_iter_get_line_offset(&paren);
+ /* we're at linecol, it's at oparen_col
+ */
+ if (oparen_col > linecol)
+ {
+ int cols;
+ char *spaces;
+
+ cols = oparen_col - linecol + 2;
+ spaces = (char *)malloc((cols + 1) * sizeof(char));
+ memset((void *)spaces, 32, cols);
+ spaces[cols] = '\0';
+
+ /* now see what follows the unmatched ( */
+ gtk_text_iter_forward_char(&paren);
+
+ if (gtk_text_iter_get_char(&paren) == '(')
+ {
+ glistener_insert_text(g, (const char *)(spaces + 1));
+ free(spaces);
+ }
+ else
+ {
+ GtkTextIter s1, e1;
+ int start = 0, end = 0;
+ char *text;
+
+ glistener_insert_text(g, (const char *)spaces); /* default indentation */
+ free(spaces);
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &start_limit, oparen_pos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end_limit, epos);
+ find_surrounding_word(g, oparen_pos + 1, is_delimiter, &start, &end, &start_limit, &end_limit);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &s1, start);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &e1, end);
+ text = gtk_text_buffer_get_text(g->buffer, &s1, &e1, true);
+ if (text)
+ {
+ if (strcmp(text, "or") == 0)
+ glistener_insert_text(g, " ");
+ else
+ {
+ if (strcmp(text, "and") == 0)
+ glistener_insert_text(g, " ");
+ else
+ {
+ if (strcmp(text, "cond") == 0)
+ glistener_insert_text(g, " ");
+ else
+ {
+ if (strcmp(text, "if") == 0)
+ {
+ if (cline - bline == 1)
+ glistener_insert_text(g, " ");
+ }
+ }
+ }
+ }
+ g_free(text);
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
+
+
+/* ---------------- colorizing ----------------
+ */
+
+static void glistener_colorizer_callback(glistener *g)
+{
+ GtkTextIter scan_iter, end_iter;
+ int cur_pos, start_pos, end_pos, expr_start = -1, any_start = -1, open_parens = 0, end_space_pos = 0;
+ bool atom_awaits = false;
+
+ if ((g->colorizer == default_colorizer) ||
+ (!g->is_schemish))
+ return;
+
+ find_expression_limits(g, &start_pos, &end_pos);
+ if (start_pos >= end_pos) return;
+ cur_pos = start_pos;
+ end_space_pos = start_pos - 1;
+
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &scan_iter, start_pos);
+ gtk_text_buffer_get_iter_at_offset(g->buffer, &end_iter, end_pos);
+ gtk_text_buffer_remove_all_tags(g->buffer, &scan_iter, &end_iter);
+
+ while (gtk_text_iter_compare(&scan_iter, &end_iter) < 0)
+ {
+ gunichar c;
+
+ c = gtk_text_iter_get_char(&scan_iter);
+ cur_pos = gtk_text_iter_get_offset(&scan_iter);
+
+ if (!g_unichar_isspace(c))
+ {
+ if (any_start == -1)
+ any_start = cur_pos;
+
+ switch (c)
+ {
+ case '"':
+ {
+ int slashes = 0;
+ if (!gtk_text_iter_forward_find_char(&scan_iter, is_unslashed_double_quote, &slashes, &end_iter))
+ {
+ /* we're in an unclosed string constant */
+ g->colorizer(g, GLISTENER_STRING, any_start, end_pos);
+ return;
+ }
+
+ gtk_text_iter_forward_char(&scan_iter); /* step over the close double-quote */
+ g->colorizer(g, GLISTENER_STRING, cur_pos, gtk_text_iter_get_offset(&scan_iter));
+ }
+ continue;
+ break;
+
+ case ';':
+ {
+ gtk_text_iter_forward_to_line_end(&scan_iter);
+ g->colorizer(g, GLISTENER_COMMENT, cur_pos, gtk_text_iter_get_offset(&scan_iter));
+ }
+ break;
+
+ case '#':
+ {
+ /* the special cases here involve block comments and character constants
+ * there's also #<...> if user types inside the brackets and there's whitespace to confuse it
+ */
+ GtkTextIter bc_iter;
+ gunichar nc;
+
+ bc_iter = scan_iter;
+ gtk_text_iter_forward_char(&bc_iter);
+ nc = gtk_text_iter_get_char(&bc_iter);
+
+ if (nc == '|')
+ {
+ int last_cs = 0;
+ bool found_end;
+ found_end = gtk_text_iter_forward_find_char(&scan_iter, is_block_comment, &last_cs, &end_iter);
+ g->colorizer(g, GLISTENER_BLOCK_COMMENT, cur_pos, gtk_text_iter_get_offset(&scan_iter) + 1);
+ if ((!found_end) || (expr_start == -1)) /* we're in a unclosed block comment or there's no enclosing context */
+ return;
+ }
+ else
+ {
+ if (nc == '\\')
+ {
+ gtk_text_iter_forward_chars(&scan_iter, 2);
+ if (gtk_text_iter_get_char(&scan_iter) == 'x')
+ {
+ gtk_text_iter_forward_char(&scan_iter);
+ while (g_unichar_isdigit(gtk_text_iter_get_char(&scan_iter)))
+ gtk_text_iter_forward_char(&scan_iter);
+ }
+ else gtk_text_iter_forward_char(&scan_iter);
+ g->colorizer(g, GLISTENER_CHARACTER, cur_pos, gtk_text_iter_get_offset(&scan_iter));
+
+ if (expr_start == -1) /* we're in a character constant with no surrounding context */
+ return;
+ continue;
+ }
+ else
+ {
+ /* a variable name can't start with '#', so I think we can assume #<... must have a closing > ?
+ * other retricted chars: ,:`'
+ */
+ if (nc == '<')
+ {
+ gtk_text_iter_forward_find_char(&scan_iter, is_gt, NULL, &end_iter);
+ g->colorizer(g, GLISTENER_BRACKET, cur_pos, gtk_text_iter_get_offset(&scan_iter) + 1);
+ }
+ else atom_awaits = true; /* #t for example */
+ }
+ }
+ }
+ break;
+
+ case '(':
+ if (open_parens == 0)
+ expr_start = cur_pos;
+ open_parens++;
+ end_space_pos = cur_pos;
+ break;
+
+ case ')':
+ if (atom_awaits)
+ {
+ if (cur_pos > end_space_pos + 1)
+ g->colorizer(g, GLISTENER_ATOM, end_space_pos + 1, cur_pos);
+ atom_awaits = false;
+ }
+ end_space_pos = cur_pos;
+
+ open_parens--;
+ if (open_parens == 0)
+ {
+ /* if this is an unmatched ')' we have already reported that */
+ if (expr_start == -1) /* unmatched close-paren */
+ return;
+
+ gtk_text_iter_forward_char(&scan_iter);
+ g->colorizer(g, GLISTENER_LIST, any_start, cur_pos);
+
+ expr_start = -1;
+ any_start = -1;
+ continue;
+ }
+ break;
+
+ default:
+ atom_awaits = true;
+ break;
+ }
+ }
+ else
+ {
+ if (atom_awaits)
+ {
+ g->colorizer(g, GLISTENER_ATOM, end_space_pos + 1, cur_pos);
+ atom_awaits = false;
+ }
+ end_space_pos = cur_pos;
+ if (expr_start == -1)
+ any_start = -1;
+ }
+
+ gtk_text_iter_forward_char(&scan_iter);
+ }
+ if (atom_awaits)
+ g->colorizer(g, GLISTENER_ATOM, end_space_pos + 1, end_pos);
+}
+
+
+static void colorize_listener(GtkTextBuffer *buffer, void *data)
+{
+ glistener_colorizer_callback((glistener *)data);
+}
+
+
+
+
+/* ---------------- testing ----------------
+ *
+ * these functions are intended for regression test suites. They make it possible to mimic
+ * user <cr> and <tab> and see the resultant output.
+ */
+
+char *glistener_evaluate(glistener *g)
+{
+ int start, end;
+ glistener_return_callback(g);
+ start = find_previous_prompt(g, glistener_cursor_position(g));
+ end = find_current_prompt(g) - g->prompt_length;
+ return(glistener_text(g, start, end));
+}
+
+
+char *glistener_complete(glistener *g)
+{
+ int start, end;
+ glistener_completion(g, glistener_cursor_position(g));
+ start = find_previous_prompt(g, glistener_cursor_position(g));
+ end = find_current_prompt(g) - g->prompt_length;
+ return(glistener_text(g, start, end));
+}
+
+
+
+/* ---------------- new listener ---------------- */
+
+
+#define SIGNAL_CONNECT(Widget, Signal, Function, Data) g_signal_connect(G_OBJECT(Widget), Signal, G_CALLBACK(Function), (gpointer)Data)
+#define SIGNAL_CONNECT_AFTER(Widget, Signal, Function, Data) g_signal_connect_after(G_OBJECT(Widget), Signal, G_CALLBACK(Function), (gpointer)Data)
+
+glistener *glistener_new(GtkWidget *parent, void (*initializations)(glistener *g, GtkWidget *new_listener))
+{
+ glistener *g;
+ GtkWidget *vb;
+
+ /* make a new glistener, set defaults */
+ g = (glistener *)calloc(1, sizeof(glistener));
+ g->is_schemish = true;
+ g->helper = default_helper;
+ g->checker = default_checker;
+ g->completer = default_completer;
+ g->evaluator = default_evaluator;
+ g->colorizer = default_colorizer;
+ g->keyer = default_keyer;
+ g->prompt_tag = NULL;
+ g->prompt = NULL;
+ g->prompt_length = 0;
+ g->strings = NULL;
+ g->strings_size = 0;
+ g->strings_pos = 0;
+ g->first_time = true;
+ g->flash_tag = NULL;
+ g->flashes = 0;
+ g->flash_paren_pos = -1;
+ g->flash_time = 150;
+ g->highlight_tag = NULL;
+ g->highlight_start = -1;
+ g->highlight_end = -1;
+ g->insertion_position = 0;
+ g->wait_cursor = NULL;
+ g->arrow_cursor = NULL;
+ g->status_message = NULL;
+
+ /* make the listener widgets */
+ g->scroller = gtk_scrolled_window_new(NULL, NULL);
+ gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(g->scroller), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+
+ g->text = gtk_text_view_new();
+ g->buffer = gtk_text_buffer_new(NULL);
+
+ gtk_text_view_set_buffer(GTK_TEXT_VIEW(g->text), g->buffer);
+ gtk_text_view_set_editable(GTK_TEXT_VIEW(g->text), true);
+ gtk_text_view_set_wrap_mode(GTK_TEXT_VIEW(g->text), GTK_WRAP_NONE);
+ gtk_text_view_set_cursor_visible(GTK_TEXT_VIEW(g->text), true);
+ gtk_text_view_set_left_margin(GTK_TEXT_VIEW(g->text), 4);
+ gtk_container_add(GTK_CONTAINER(g->scroller), g->text);
+ gtk_widget_set_events(g->text, GDK_ALL_EVENTS_MASK);
+
+ if (default_font)
+ glistener_set_font(g, default_font);
+ else glistener_set_font(g, pango_font_description_from_string("Monospace 11"));
+ glistener_key_bindings(g, GTK_TEXT_VIEW_GET_CLASS(g->text));
+
+ if (default_text_color)
+ glistener_set_text_color(g, default_text_color);
+ if (default_background_color)
+ glistener_set_background_color(g, default_background_color);
+
+ if (initializations)
+ initializations(g, g->text);
+
+ SIGNAL_CONNECT(g->text, "key_press_event", glistener_key_press, (gpointer)g);
+ SIGNAL_CONNECT(g->text, "key_release_event", glistener_key_release, (gpointer)g);
+ SIGNAL_CONNECT(g->text, "button_release_event", glistener_button_release, (gpointer)g);
+
+ SIGNAL_CONNECT_AFTER(g->buffer, "insert-text", text_insert, (gpointer)g);
+ SIGNAL_CONNECT_AFTER(g->buffer, "changed", colorize_listener, (gpointer)g);
+ SIGNAL_CONNECT_AFTER(g->text, "cut-clipboard", check_for_empty_listener, (gpointer)g);
+
+ if (!g->prompt)
+ {
+ if (default_prompt)
+ glistener_set_prompt(g, default_prompt);
+ else
+ {
+ g->prompt = (char *)calloc(3, sizeof(char));
+ g->prompt[0] = '\n';
+ g->prompt[1] = '>';
+ g->prompt_length = g_utf8_strlen(g->prompt, -1);
+ }
+ }
+ if (default_prompt_tag)
+ glistener_set_prompt_tag(g, default_prompt_tag);
+ if (default_highlight_tag)
+ glistener_set_highlight_tag(g, default_highlight_tag);
+
+ /* put in the first prompt without the preceding <cr> */
+ {
+ GtkTextIter start;
+ gtk_text_buffer_get_start_iter(g->buffer, &start);
+ prompt_insert(g, &start, true);
+ }
+
+ if (!g->wait_cursor) g->wait_cursor = GDK_CURSOR_NEW(GDK_WATCH);
+ if (!g->arrow_cursor) g->arrow_cursor = GDK_CURSOR_NEW(GDK_LEFT_PTR);
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ vb = gtk_table_new(2, 1, false);
+ if (parent)
+ gtk_container_add(GTK_CONTAINER(parent), vb);
+ gtk_table_attach(GTK_TABLE(vb), g->scroller, 0, 1, 0, 1, /* left right top bottom */
+ (GtkAttachOptions)(GTK_FILL | GTK_EXPAND),
+ (GtkAttachOptions)(GTK_FILL | GTK_EXPAND | GTK_SHRINK),
+ 0, 0);
+
+ g->status = gtk_statusbar_new();
+ gtk_table_attach(GTK_TABLE(vb), g->status, 0, 1, 1, 2,
+ (GtkAttachOptions)(GTK_EXPAND | GTK_FILL),
+ (GtkAttachOptions)(GTK_FILL),
+ 0, 0);
+#else
+ vb = gtk_grid_new();
+ if (parent)
+ gtk_container_add(GTK_CONTAINER(parent), vb);
+ gtk_widget_set_halign(g->scroller, GTK_ALIGN_FILL);
+ gtk_widget_set_valign(g->scroller, GTK_ALIGN_FILL);
+ gtk_widget_set_hexpand(g->scroller, TRUE);
+ gtk_widget_set_vexpand(g->scroller, TRUE);
+ gtk_grid_attach(GTK_GRID(vb), g->scroller, 0, 0, 1, 1); /* left top w h */
+
+ g->status = gtk_statusbar_new();
+ gtk_widget_set_halign(g->status, GTK_ALIGN_FILL);
+ gtk_grid_attach(GTK_GRID(vb), g->status, 0, 1, 1, 1);
+#endif
+ gtk_widget_show(g->text);
+ gtk_widget_show(g->scroller);
+ gtk_widget_show(g->status);
+ gtk_widget_show(vb);
+
+ return(g);
+}
+
+/* changes:
+ * 19-Mar-15: changed strcopy macro.
+ * 7-June: added keyer function.
+ * 4-June: added colorizer function.
+ * 28-May: added checker function.
+ */
+
+/* C-s/r could prompt in the status area if it were a text entry, not a label widget -- is that possible?
+ * there's also gtk_overlay (see gtk-demo/overlay.c) in 3.9.8 -- but it says "static position".
+ */
diff --git a/glistener.h b/glistener.h
new file mode 100644
index 0000000..ac26333
--- /dev/null
+++ b/glistener.h
@@ -0,0 +1,394 @@
+#ifndef GLISTENER_H
+#define GLISTENER_H
+
+#include <ctype.h>
+#include <stddef.h>
+#include <math.h>
+#include <stdio.h>
+#include <unistd.h>
+#include <signal.h>
+#include <limits.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdarg.h>
+#include <sys/types.h>
+#include <stdbool.h>
+
+#include <gtk/gtk.h>
+
+#if (GTK_CHECK_VERSION(3, 0, 0))
+ #include <gdk/gdk.h>
+#else
+ #include <gdk/gdkkeysyms.h>
+#endif
+
+#if GTK_CHECK_VERSION(3, 16, 0)
+ #define GDK_CURSOR_NEW(Type) gdk_cursor_new_for_display(gdk_display_get_default(), Type)
+#else
+ #define GDK_CURSOR_NEW(Type) gdk_cursor_new(Type)
+#endif
+
+typedef struct glistener glistener;
+
+typedef enum {GLISTENER_STRING, GLISTENER_COMMENT, GLISTENER_BLOCK_COMMENT,
+ GLISTENER_ATOM, GLISTENER_LIST, GLISTENER_BRACKET, GLISTENER_CHARACTER
+ } glistener_colorizer_t;
+
+glistener *glistener_new(GtkWidget *parent, void (*initializations)(glistener *g, GtkWidget *new_listener));
+
+void glistener_append_text (glistener *g, const char *msg);
+void glistener_insert_text (glistener *g, const char *text);
+char *glistener_text (glistener *g, int start, int end);
+
+void glistener_append_prompt (glistener *g);
+void glistener_set_prompt (glistener *g, const char *str);
+void glistener_set_prompt_tag (glistener *g, GtkTextTag *m);
+int glistener_prompt_position (glistener *g);
+
+void glistener_set_cursor_shape (glistener *g, GdkCursor *cursor_shape);
+int glistener_cursor_position (glistener *g);
+void glistener_set_cursor_position (glistener *g, int position);
+void glistener_scroll_to_end (glistener *g);
+
+void glistener_post_status (glistener *g, const char *msg);
+void glistener_clear_status (glistener *g);
+
+void glistener_clear (glistener *g);
+bool glistener_write (glistener *g, FILE *fp);
+
+void glistener_set_highlight_tag (glistener *g, GtkTextTag *m);
+void glistener_set_font (glistener *g, PangoFontDescription *font);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+void glistener_set_text_color (glistener *g, GdkColor *p);
+void glistener_set_background_color(glistener *g, GdkColor *p);
+#else
+void glistener_set_text_color (glistener *g, GdkRGBA *p);
+void glistener_set_background_color(glistener *g, GdkRGBA *p);
+#endif
+
+void glistener_key_bindings (glistener *g, gpointer cls);
+void glistener_is_schemish (glistener *g, bool filtering);
+
+void glistener_set_completer (glistener *g, void (*completer)(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data));
+void glistener_set_helper (glistener *g, const char *(*help)(glistener *g, const char *text));
+void glistener_set_checker (glistener *g, const char *(*check)(glistener *g, const char *text));
+void glistener_set_evaluator (glistener *g, void (*eval)(glistener *g, const char *text));
+void glistener_set_colorizer (glistener *g, void (*colorizer)(glistener *g, glistener_colorizer_t type, int start, int end));
+void glistener_set_keyer (glistener *g, bool (*key)(glistener *g, GtkWidget *w, GdkEventKey *e));
+
+/* these are for regression testing */
+char *glistener_evaluate (glistener *g);
+char *glistener_complete (glistener *g);
+
+
+/* -------------------------------------------------------------------------------- */
+/* an annotated version of the same info:
+ *
+ * typedef struct glistener glistener;
+ *
+ * our opaque handle on the info for each listener. You can run any number of listeners
+ * at the same time. For a simple example, see s7.html#glistener. Another is snd-glistener.c
+ * in the Snd package, and tools/gcall.c.
+ *
+ *
+ * --------
+ * glistener *glistener_new(GtkWidget *parent, void (*initializations)(glistener *g, GtkWidget *new_listener));
+ *
+ * This creates a new listener. If parent is not NULL, the listener is added to it
+ * via gtk_container_add. The second argument is an optional function that will be called
+ * during the listener initialization, just before the signals are connected. It
+ * can add its own signal connections or set defaults. The "new_listener" argument
+ * passed to it is the new GtkTextView widget. Its parent is a GtkScrolledWindow,
+ * which is placed in a grid (or table in gtk-2) along with the listener's statusbar.
+ *
+ *
+ * --------
+ * void glistener_append_text(glistener *g, const char *msg);
+ *
+ * This appends "msg" to the end of the listener text.
+ *
+ *
+ * --------
+ * void glistener_insert_text(glistener *g, const char *text);
+ *
+ * This inserts "text" at the cursor.
+ *
+ *
+ * --------
+ * char *glistener_text(glistener *g, int start, int end);
+ *
+ * This returns the text in the listener between the offsets (unicode positions)
+ * "start" and "end".
+ *
+ *
+ * --------
+ * void glistener_append_prompt(glistener *g);
+ *
+ * This appends a prompt at the bottom of the listener text. Everything
+ * depends on the prompt, so you need to send one out at the end of each
+ * evaluation. The usual sequence is:
+ * user types in an expression followed by <cr> -> listener-text
+ * we_eval(listener-text) -> some string
+ * glistener_append_text(g, that string);
+ * glistener_append_prompt(g);
+ *
+ *
+ * --------
+ * void glistener_set_prompt(glistener *g, const char *str);
+ *
+ * This sets the text of the prompt. It defaults to ">" but can be anything.
+ * One way to get, for example, the unicode lower-case lambda followed by ">" as the prompt is:
+ * unsigned char prompt[4] = {0xce, 0xbb, '>', '\0'};
+ * glistener_set_prompt(g, prompt);
+ * UTF8 lambda is 0xce 0xbb.
+ *
+ *
+ * --------
+ * void glistener_set_prompt_tag(glistener *g, GtkTextTag *m);
+ *
+ * This sets the GtkTextTag for the prompt. It defaults to NULL, but it's nicer to
+ * set off the prompt in some way (like bold-face). Here's a tag that makes our prompt
+ * bold red:
+ * glistener_set_prompt_tag(g,
+ * gtk_text_buffer_create_tag(buffer, "glistener_prompt_tag", "weight", PANGO_WEIGHT_BOLD, "foreground", "red", NULL));
+ *
+ *
+ * --------
+ * int glistener_prompt_position(glistener *g);
+ *
+ * This returns the current (active) prompt offset in the listener text buffer.
+ *
+ *
+ * --------
+ * void glistener_set_cursor_shape(glistener *g, GdkCursor *cursor_shape);
+ *
+ * This sets the current cursor shape. It is normally an arrow, but changes to
+ * a watch or hour-glass during evaluation:
+ * gdk_cursor_new(GDK_WATCH) or gdk_cursor_new(GDK_LEFT_PTR)
+ *
+ *
+ * --------
+ * int glistener_cursor_position(glistener *g);
+ *
+ * This returns the cursor offset in the listener.
+ *
+ *
+ * --------
+ * void glistener_set_cursor_position(glistener *g, int position);
+ *
+ * This moves the listener's cursor to the offset "position".
+ *
+ *
+ * --------
+ * void glistener_scroll_to_end(glistener *g);
+ *
+ * This scrolls the view of the listener's text to the end of the text.
+ *
+ *
+ * --------
+ * void glistener_post_status(glistener *g, const char *msg);
+ *
+ * This places "msg" in the listener's statusbar. The previous text, if any
+ * is removed, so you don't need to worry about gtk_statusbar_pop.
+ *
+ *
+ * --------
+ * void glistener_clear_status(glistener *g);
+ *
+ * This removes all messages from the statusbar.
+ *
+ *
+ * --------
+ * void glistener_clear(glistener *g);
+ *
+ * This deletes all the text in the listener, leaving only the initial prompt.
+ *
+ *
+ * --------
+ * bool glistener_write(glistener *g, FILE *fp);
+ *
+ * This writes the current listener text contents to the file "fp".
+ *
+ *
+ * --------
+ * void glistener_set_highlight_tag(glistener *g, GtkTextTag *m);
+ *
+ * This sets the GtkTexTag for highlighted text, normally marking an unmatched
+ * open parenthesis. The default is bold face, red foreground, but I may change
+ * that to red backgound. See glistener_set_prompt_tag above for an example.
+ *
+ *
+ * --------
+ * void glistener_set_font(glistener *g, PangoFontDescription *font);
+ *
+ * This sets the listener text font. It defaults to "Monospace 11". Indentation
+ * code assumes fixed-width spacing, but that's not a big deal.
+ * glistener_set_font(g, pango_font_description_from_string("Monospace 10"));
+ *
+ *
+ * --------
+ * void glistener_set_text_color(glistener *g, GdkRGBA *p);
+ *
+ * This sets the text foreground color, normally black. In gtk 2, the color
+ * is GdkColor*. This snippet makes the text green:
+ * GdkRGBA color;
+ * color.red = 0.0; color.green = 0.97; color.blue = 0.0; color.alpha = 1.0;
+ * glistener_set_text_color(g1, &color);
+ *
+ *
+ * --------
+ * void glistener_set_background_color(glistener *g, GdkRGBA *p);
+ *
+ * This sets the listener background color, normally white. In gtk 2, use
+ * a GdkColor* instead. The following code gives the listener a light blue
+ * background:
+ * GdkRGBA color;
+ * color.red = 0.94; color.green = 0.97; color.blue = 1.0; color.alpha = 1.0;
+ * glistener_set_background_color(g1, &color);
+ *
+ *
+ * --------
+ * void glistener_key_bindings(glistener *g, gpointer cls);
+ *
+ * This establishes the listener's emacs-inspired keybindings in the gtk
+ * widget class "cls" (normally gtk_entry). In Snd I use this to make sure
+ * all the text-oriented widgets share the same basic set:
+ * glistener_key_bindings(g, GTK_ENTRY_GET_CLASS(GTK_ENTRY(text)));
+ *
+ *
+ * --------
+ * void glistener_is_schemish(glistener *g, bool filtering);
+ *
+ * This determines whether the listener tries to parse the text before sending it to
+ * the evaluator. It defaults to true, expecting more-or-less lispish syntax. In other
+ * languages (Ruby and Forth in Snd, for example), set this to false.
+ *
+ *
+ *
+ * --------
+ * void glistener_set_completer(glistener *g, void (*completer)(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data))
+ *
+ * The completer is called whenever the user types TAB after what appears to be a
+ * partial symbol name (in a string, the filename completer is called instead).
+ * To find a plausible completion, the listener needs access to the table of currently
+ * known symbols. In s7, s7_for_each_symbol_name runs through the symbol table,
+ * calling a function on each symbol, and stopping when the function returns true,
+ * so symbol completion in s7 is:
+ *
+ * s7_for_each_symbol_name(s7, symbol_func, data);
+ *
+ * The completer function in s7 is:
+ *
+ * static void completer(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
+ * {
+ * s7_for_each_symbol_name(s7, symbol_func, data);
+ * }
+ *
+ * and it is tied into the listener via:
+ *
+ * glistener_set_completer(g1, completer);
+ *
+ *
+ *
+ * --------
+ * void glistener_set_helper(glistener *g, const char *(*help)(glistener *g, const char *text))
+ *
+ * The helper is called whenever the listener thinks a help string is in order. It is passed
+ * a string ("text") about which it hopes to get help. If the helper returns NULL, nothing
+ * happens, but otherwise, the returned help is posted in the status area. In s7, it is:
+ *
+ * static const char *helper(glistener *g, const char *text)
+ * {
+ * s7_pointer sym;
+ * sym = s7_symbol_table_find_name(s7, text);
+ * if (sym)
+ * return(s7_help(s7, sym));
+ * glistener_clear_status(g);
+ * return(NULL);
+ * }
+ *
+ * and it is tied into the listener via:
+ *
+ * glistener_set_helper(g1, helper);
+ *
+ *
+ *
+ * --------
+ * void glistener_set_evaluator(glistener *g, void (*eval)(glistener *g, const char *text))
+ *
+ * This is the heart of the listener. It gets a string ("text") and
+ * does something debonair. In s7, it calls s7_eval_c_string, and then
+ * displays the result. Although error handling makes the code complicated,
+ * the basic idea is:
+ *
+ * static void evaluator(glistener *g, const char *text)
+ * {
+ * s7_pointer result;
+ * char *msg;
+ * result = s7_eval_c_string(s7, text);
+ * glistener_append_text(g, "\n");
+ * msg = s7_object_to_c_string(s7, result);
+ * glistener_append_text(g, msg);
+ * if (msg) free(msg);
+ * glistener_append_prompt(g);
+ * }
+ *
+ * tied into the listener via:
+ *
+ * glistener_set_evaluator(g1, evaluator);
+ *
+ *
+ *
+ * --------
+ * void glistener_set_checker(glistener *g, const char *(*check)(glistener *g, const char *text))
+ *
+ * The checker is called when close-paren is typed and the matching open-paren can be found.
+ * "text" in this case is the expression. If it notices something awry in the expression,
+ * it can squawk in the status area. The checker in snd-glistener.c calls s7_read on the text,
+ * then runs various checks on that code (function argument checks and so on).
+ *
+ *
+ *
+ * --------
+ * void glistener_set_colorizer(glistener *g, void (*colorizer)(glistener *g, glistener_colorizer_t type, int start, int end))
+ *
+ * The colorizer highlights portions of the code, normally using colors, but the GtkTextBuffer
+ * is at your disposal. This function is called whenever there is any change in the listener
+ * buffer's contents. The "start" and "end" ints are offsets into the buffer giving what the
+ * listener thinks are the current bounds where there is an entity of "type", one of the glistener_colorizer_t
+ * enums given above. See the colorizer function in snd-glistener.c.
+ *
+ *
+ *
+ * --------
+ * void glistener_set_keyer(glistener *g, bool (*key)(glistener *g, GtkWidget *w, GdkEventKey *e))
+ *
+ * The keyer is called upon key-press. It is passed the widget involved (the listener
+ * text-view widget), and the GdkEvent. The event has fields giving the key itself, and
+ * any auxiliary keys (control, shift, etc). If you don't want to handle that key, or
+ * want the built-in action to be called, return false. If keyer returns true, any
+ * further handling of the signal is blocked. The default keyer simply returns false.
+ *
+ * glistener rebinds some of the keys to mimic Emacs, then adds a few others:
+ * M-< go to start of text (also up-arrow)
+ * M-> go to end of text (also down-arrow)
+ * M-a go to previous prompt
+ * M-e go to next prompt
+ * M-n restore previous expression, moving back in the history
+ * M-p restore previous expression, moving forward in the history
+ * Tab complete preceding name, if any, else look for indentation opportunity
+ * Return send current expression, if any, to evaluator, else insert return
+ *
+ *
+ *
+ * --------
+ * char *glistener_evaluate(glistener *g);
+ * char *glistener_complete(glistener *g);
+ *
+ * These two functions are intended for regression testing. glistener_evaluate
+ * simulates typing <cr>, and glistener_complete simulates <tab>.
+ */
+
+
+#endif
diff --git a/grani.rb b/grani.rb
index c515d59..d6b62bb 100644
--- a/grani.rb
+++ b/grani.rb
@@ -1,9 +1,9 @@
#!/usr/bin/env ruby -w
-# grani.rb -- grani.ins CL --> Ruby -*- snd-ruby -*-
+# grani.rb -- grani.ins CL --> Ruby
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Tue Feb 01 00:47:00 CET 2005
-# Last: Thu Oct 15 00:15:57 CEST 2009
+# Created: 05/02/01 00:47:00
+# Changed: 14/11/13 05:03:02
# Original header:
@@ -18,17 +18,19 @@
# ;;; Mar 22 1997: working with src envelope (grain wise) & src spread
# ;;; Jan 26 1998: started work on new version
# ;;; Nov 7 1998: input soundfile duration calculation wrong
-# ;;; Nov 10 1998: bug in in-samples (thanks to Kristopher D. Giesing for this one)
+# ;;; Nov 10 1998: bug in in-samples (thanks to Kristopher D. Giesing
+# ;;; for this one)
# ;;; Dec 20 1998: added standard locsig code
-# ;;; Feb 19 1999: added "nil" as default value of where to avoid warning (by bill)
-# ;;; Jan 10 2000: added input-channel to select which channel of the input file
-# ;;; to process.
-# ;;; added grain-start-in-seconds to be able to specify input file
-# ;;; locations in seconds for the grain-start envelope
-# ;;; May 06 2002: fixed array passing of where-bins in clisp (reported by Charles
-# ;;; Nichols and jennifer l doering
-# ;;; Mar 27 2003: added option for sending grains to all channels (requested by
-# ;;; Oded Ben-Tal)
+# ;;; Feb 19 1999: added "nil" as default value of where to avoid warning
+# ;;; (by bill)
+# ;;; Jan 10 2000: added input-channel to select which channel of the input
+# ;;; file to process.
+# ;;; added grain-start-in-seconds to be able to specify input
+# ;;; file locations in seconds for the grain-start envelope
+# ;;; May 06 2002: fixed array passing of where-bins in clisp
+# ;;; (reported by Charles Nichols and jennifer l doering)
+# ;;; Mar 27 2003: added option for sending grains to all channels
+# ;;; (requested by Oded Ben-Tal)
require "ws"
require "env"
@@ -55,7 +57,9 @@ end
# ;;; create a vct from an envelope
def make_gr_env(env, length = 512)
length_1 = (length - 1).to_f
- make_vct!(length) do |i| envelope_interp(i / length_1, env) end
+ make_vct!(length) do |i|
+ envelope_interp(i / length_1, env)
+ end
end
# ;;; Grain envelopes
@@ -78,9 +82,9 @@ def raised_cosine(*args)
end
end
-# ;;;=============================================================================
+# ;;;=========================================================================
# ;;; Granular synthesis instrument
-# ;;;=============================================================================
+# ;;;=========================================================================
#
# ;;; input-channel:
# ;;; from which channel in the input file are samples read
@@ -93,7 +97,8 @@ end
# ;;; grain-envelope-trasition. If "grain-envelope-end" is nil interpolation
# ;;; is turned off and only grain-envelope is applied to the grains.
# ;;; grain-envelope-trasition:
-# ;;; an enveloper that controls the interpolation between the two grain envelopes
+# ;;; an enveloper that controls the interpolation between the two
+# ;;; grain envelopes
# ;;; 0 -> selects "grain-envelope"
# ;;; 1 -> selects "grain-envelope-end"
# ;;; grain-envelope-array-size
@@ -121,10 +126,12 @@ end
# ;;; grain-start-spread:
# ;;; random spread around the value of "grain-start"
# ;;; grain-start-in-seconds:
-# ;;; nil -> grain-start y envelope expressed in percent of the duration of the input file
+# ;;; nil -> grain-start y envelope expressed in percent of the duration
+# ;;; of the input file
# ;;; t -> grain-start y envelope expressed in seconds
# ;;; grain-density:
-# ;;; envelope that controls the number of grains per second generated in the output file
+# ;;; envelope that controls the number of grains per second generated
+# ;;; in the output file
# ;;; grain-density-spread:
@@ -138,10 +145,13 @@ Grani_to_grain_allchans = 5
def grani(start, dur, amp, file, *args)
input_channel = get_args(args, :input_channel, 0)
grains = get_args(args, :grains, 0)
- amp_envelope = get_args(args, :amp_envelope, [0, 0, 0.3, 1, 0.7, 1, 1, 0])
- grain_envelope = get_args(args, :grain_envelope, [0, 0, 0.3, 1, 0.7, 1, 1, 0])
+ amp_envelope = get_args(args, :amp_envelope,
+ [0, 0, 0.3, 1, 0.7, 1, 1, 0])
+ grain_envelope = get_args(args, :grain_envelope,
+ [0, 0, 0.3, 1, 0.7, 1, 1, 0])
grain_envelope_end = get_args(args, :grain_envelope_end, false)
- grain_envelope_transition = get_args(args, :grain_envelope_transition, [0, 0, 1, 1])
+ grain_envelope_transition = get_args(args, :grain_envelope_transition,
+ [0, 0, 1, 1])
grain_envelope_array_size = get_args(args, :grain_envelope_array_size, 512)
grain_duration = get_args(args, :grain_duration, 0.1)
grain_duration_spread = get_args(args, :grain_spread, 0.0)
@@ -167,51 +177,72 @@ def grani(start, dur, amp, file, *args)
beg, fin = times2samples(start, dur)
in_file_channels = mus_sound_chans(file)
in_file_sr = mus_sound_srate(file).to_f
- in_file_dur = mus_sound_frames(file) / in_file_sr
- in_file_reader = make_readin(:file, file, :channel, [input_channel, in_file_channels - 1].min)
+ in_file_dur = mus_sound_framples(file) / in_file_sr
+ in_file_reader = make_readin(:file, file,
+ :channel,
+ [input_channel, in_file_channels - 1].min)
last_in_sample = (in_file_dur * in_file_sr).round
srate_ratio = in_file_sr / mus_srate()
- sr_env = make_env(:envelope, if srate_linear
- envelope_or_number(srate)
- else
- exp_envelope(envelope_or_number(srate),
- :base, srate_base,
- :error, srate_error)
- end,
- :scaler, srate_ratio,
- :duration, dur)
- sr_spread_env = make_env(:envelope, envelope_or_number(srate_spread), :duration, dur)
+ sr_env = make_env(:envelope,
+ if srate_linear
+ envelope_or_number(srate)
+ else
+ exp_envelope(envelope_or_number(srate),
+ :base, srate_base,
+ :error, srate_error)
+ end,
+ :scaler, srate_ratio, :duration, dur)
+ sr_spread_env = make_env(:envelope, envelope_or_number(srate_spread),
+ :duration, dur)
amp_env = make_env(:envelope, amp_envelope, :scaler, amp, :duration, dur)
- gr_dur = make_env(:envelope, envelope_or_number(grain_duration), :duration, dur)
- gr_dur_spread = make_env(:envelope, envelope_or_number(grain_duration_spread), :duration, dur)
+ gr_dur = make_env(:envelope, envelope_or_number(grain_duration),
+ :duration, dur)
+ gr_dur_spread = make_env(:envelope, envelope_or_number(grain_duration_spread),
+ :duration, dur)
gr_start_scaler = (grain_start_in_seconds ? 1.0 : in_file_dur)
- gr_start = make_env(:envelope, envelope_or_number(grain_start), :duration, dur)
- gr_start_spread = make_env(:envelope, envelope_or_number(grain_start_spread), :duration, dur)
- gr_dens_env = make_env(:envelope, envelope_or_number(grain_density), :duration, dur)
- gr_dens_spread_env = make_env(:envelope, envelope_or_number(grain_density_spread), :duration, dur)
+ gr_start = make_env(:envelope, envelope_or_number(grain_start),
+ :duration, dur)
+ gr_start_spread = make_env(:envelope, envelope_or_number(grain_start_spread),
+ :duration, dur)
+ gr_dens_env = make_env(:envelope, envelope_or_number(grain_density),
+ :duration, dur)
+ gr_dens_spread_env = make_env(:envelope,
+ envelope_or_number(grain_density_spread),
+ :duration, dur)
gr_env = make_table_lookup(:frequency, 1.0, "initial-phase".intern, 0.0,
- :wave, if vct?(grain_envelope)
- grain_envelope
- else
- make_gr_env(grain_envelope, grain_envelope_array_size)
- end)
+ :wave,
+ if vct?(grain_envelope)
+ grain_envelope
+ else
+ make_gr_env(grain_envelope,
+ grain_envelope_array_size)
+ end)
gr_env_end = make_table_lookup(:frequency, 1.0, "initial-phase".intern, 0.0,
- :wave, if grain_envelope_end
- if vct?(grain_envelope_end)
- grain_envelope_end
- else
- make_gr_env(grain_envelope_end,
- grain_envelope_array_size)
- end
- else
- make_vct(512)
- end)
- gr_int_env = make_env(:envelope, envelope_or_number(grain_envelope_transition), :duration, dur)
+ :wave,
+ if grain_envelope_end
+ if vct?(grain_envelope_end)
+ grain_envelope_end
+ else
+ make_gr_env(grain_envelope_end,
+ grain_envelope_array_size)
+ end
+ else
+ make_vct(512)
+ end)
+ gr_int_env = make_env(:envelope,
+ envelope_or_number(grain_envelope_transition),
+ :duration, dur)
interp_gr_envs = grain_envelope_end
- gr_dist = make_env(:envelope, envelope_or_number(grain_distance), :duration, dur)
- gr_dist_spread = make_env(:envelope, envelope_or_number(grain_distance_spread), :duration, dur)
- gr_degree = make_env(:envelope, envelope_or_number(grain_degree), :duration, dur)
- gr_degree_spread = make_env(:envelope, envelope_or_number(grain_degree_spread), :duration, dur)
+ gr_dist = make_env(:envelope, envelope_or_number(grain_distance),
+ :duration, dur)
+ gr_dist_spread = make_env(:envelope,
+ envelope_or_number(grain_distance_spread),
+ :duration, dur)
+ gr_degree = make_env(:envelope, envelope_or_number(grain_degree),
+ :duration, dur)
+ gr_degree_spread = make_env(:envelope,
+ envelope_or_number(grain_degree_spread),
+ :duration, dur)
loc = make_locsig(:degree, 45.0,
:distance, 1.0,
:output, @ws_output,
@@ -230,11 +261,14 @@ def grani(start, dur, amp, file, *args)
if gr_offset < gr_samples
gr_where = env(gr_int_env) if interp_gr_envs
val = if interp_gr_envs
- (1 - gr_where) * table_lookup(gr_env) + gr_where * table_lookup(gr_env_end)
+ (1 - gr_where) * table_lookup(gr_env) +
+ gr_where * table_lookup(gr_env_end)
else
table_lookup(gr_env)
end
- locsig(loc, gr_start_sample + gr_offset, val * env(amp_env) * readin(in_file_reader))
+ locsig(loc,
+ gr_start_sample + gr_offset,
+ val * env(amp_env) * readin(in_file_reader))
gr_offset += 1
else
if first_grain
@@ -242,7 +276,8 @@ def grani(start, dur, amp, file, *args)
gr_start_sample = beg
else
gr_start_sample += seconds2samples(1.0 / (gr_dens + gr_dens_spread))
- if (gr_start_sample > fin) or (grains.nonzero? and (grain_counter >= grains))
+ if (gr_start_sample > fin) or
+ (grains.nonzero? and (grain_counter >= grains))
break
end
end
@@ -260,7 +295,8 @@ def grani(start, dur, amp, file, *args)
in_start_value = env(gr_start) * gr_start_scaler +
random_spread(env(gr_start_spread) * gr_start_scaler)
in_start = (in_start_value * in_file_sr).round
- gr_duration = [grain_duration_limit, env(gr_dur) + random_spread(env(gr_dur_spread))].max
+ gr_duration = [grain_duration_limit,
+ env(gr_dur) + random_spread(env(gr_dur_spread))].max
gr_samples = seconds2samples(gr_duration)
gr_srate = if srate_linear
env(sr_env) + random_spread(env(sr_spread_env))
@@ -292,11 +328,14 @@ def grani(start, dur, amp, file, *args)
if where.nonzero? and where_bins.length > 1
(where_bins.length - 1).times do |chn|
locsig_set!(loc, chn,
- ((where_bins[chn] < where and where < where_bins[chn + 1]) ? 1.0 : 0.0))
+ ((where_bins[chn] < where and
+ where < where_bins[chn + 1]) ? 1.0 : 0.0))
end
else
if where_to == Grani_to_grain_allchans
- @channels.times do |chn| locsig_set!(loc, chn, 1.0) end
+ @channels.times do |chn|
+ locsig_set!(loc, chn, 1.0)
+ end
else
set_mus_location(gr_dist, gr_from_beg)
set_mus_location(gr_dist_spread, gr_from_beg)
@@ -306,7 +345,8 @@ def grani(start, dur, amp, file, *args)
dist = env(gr_dist) + random_spread(env(gr_dist_spread))
dist_scl = 1.0 / [dist, 1.0].max
if @ws_reverb
- locsig_reverb_set!(loc, 0, reverb_amount * (1.0 / sqrt([dist, 1.0].max)))
+ locsig_reverb_set!(loc, 0,
+ reverb_amount * (1.0 / sqrt([dist, 1.0].max)))
end
if @channels == 1
locsig_set!(loc, 0, dist_scl)
@@ -317,43 +357,47 @@ def grani(start, dur, amp, file, *args)
locsig_set!(loc, 1, dist_scl * frac)
else
if @channels > 2
- locsig_set!(loc, 0, if 0 <= deg and deg <= 90
- dist_scl * ((90.0 - deg) / 90.0)
- else
- if 270 <= deg and deg <= 360
- dist_scl * ((deg - 270.0) / 90.0)
- else
- 0.0
- end
- end)
- locsig_set!(loc, 1, if 90 <= deg and deg <= 180
- dist_scl * (180.0 - deg) / 90.0
- else
- if 0 <= deg and deg <= 90
- dist_scl * (deg / 90.0)
- else
- 0.0
- end
- end)
- locsig_set!(loc, 2, if 180 <= deg and deg <= 270
- dist_scl * (270.0 - deg) / 90.0
- else
- if 90 <= deg and deg <= 180
- dist_scl * (deg - 90.0) / 90.0
- else
- 0.0
- end
- end)
+ locsig_set!(loc, 0,
+ if 0 <= deg and deg <= 90
+ dist_scl * ((90.0 - deg) / 90.0)
+ else
+ if 270 <= deg and deg <= 360
+ dist_scl * ((deg - 270.0) / 90.0)
+ else
+ 0.0
+ end
+ end)
+ locsig_set!(loc, 1,
+ if 90 <= deg and deg <= 180
+ dist_scl * (180.0 - deg) / 90.0
+ else
+ if 0 <= deg and deg <= 90
+ dist_scl * (deg / 90.0)
+ else
+ 0.0
+ end
+ end)
+ locsig_set!(loc, 2,
+ if 180 <= deg and deg <= 270
+ dist_scl * (270.0 - deg) / 90.0
+ else
+ if 90 <= deg and deg <= 180
+ dist_scl * (deg - 90.0) / 90.0
+ else
+ 0.0
+ end
+ end)
if @channels > 3
- locsig_set!(loc, 3, if 270 <= deg and deg <= 360
- dist_scl * (360.0 - deg) / 90.0
- else
- if 180 <= deg and deg <= 270
- dist_scl * (deg - 180.0) / 90.0
- else
- 0.0
- end
- end)
+ locsig_set!(loc, 3,
+ if 270 <= deg and deg <= 360
+ dist_scl * (360.0 - deg) / 90.0
+ else
+ if 180 <= deg and deg <= 270
+ dist_scl * (deg - 180.0) / 90.0
+ else
+ 0.0
+ end
+ end)
end
end
end
@@ -373,7 +417,7 @@ end
=begin
with_sound(:play, 1, :statistics, true, :channels, 1, :reverb, nil) do
- grani(0.0, 2.0, 5.0, "/usr/gnu/sound/SFiles/oboe.snd", :grain_envelope, raised_cosine())
+ grani(0.0, 2.0, 5.0, "oboe.snd", :grain_envelope, raised_cosine())
end
=end
diff --git a/grani.scm b/grani.scm
index bb30ebb..d69e106 100644
--- a/grani.scm
+++ b/grani.scm
@@ -2,6 +2,10 @@
;;; ENVELOPES (env.scm)
;;; *************************
+(when (provided? 'pure-s7)
+ (define-macro (call-with-values producer consumer) `(,consumer (,producer))))
+
+
;;;=============================================================================
;;; Exponential envelopes
;;;=============================================================================
@@ -25,25 +29,27 @@
(provide 'snd-grani.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(require snd-env.scm)
-(define grani-default-base (expt 2 (/ 12)))
+(define grani-default-base (expt 2 1/12))
-(define* (exp-envelope env
+(define* (exp-envelope env1
(base grani-default-base)
(error 0.01)
(scaler 1)
(offset 0)
- (cutoff #f)
+ cutoff
(out-scaler 1))
- (let* ((base (exact->inexact base))
- (error (exact->inexact error))
- (scaler (exact->inexact scaler))
- (offset (exact->inexact offset))
- (out-scaler (exact->inexact out-scaler))
+ (let* ((base (* 1.0 base))
+ (error (* 1.0 error))
+ (scaler (* 1.0 scaler))
+ (offset (* 1.0 offset))
+ (out-scaler (* 1.0 out-scaler))
(ycutoff (and cutoff (expt base (+ offset (* cutoff scaler)))))
- (result '()))
+ (result ()))
;; linear interpolation
(letrec ((interpolate (lambda (xl yl xh yh xi) (+ yl (* (- xi xl) (/ (- yh yl) (- xh xl))))))
;;
@@ -62,7 +68,7 @@
;; is the linear approximation accurate enough?
;; are we still over the cutoff limit?
(if (and (> (abs (- yexp yinte)) yerr)
- (if ycutoff (> yinte ycutoff) #t))
+ (or (not ycutoff) (> yinte ycutoff)))
;; no --> add a breakpoint and recurse right and left
(call-with-values
(lambda () (exp-seg xl yle xint yexp yl yint error))
@@ -73,13 +79,13 @@
(values (append xi (list xint) xj)
(append yi (list yexp) yj))))))
;; yes --> don't need to add nu'ting to the envelope
- (values '() '()))))))
+ (values () ()))))))
;; loop for each segment in the envelope
- (let segs ((en env))
+ (let segs ((en env1))
(let* ((x (car en))
- (y (exact->inexact (cadr en)))
+ (y (* 1.0 (cadr en)))
(nx (caddr en))
- (ny (exact->inexact (cadddr en)))
+ (ny (* 1.0 (cadddr en)))
(yscl (+ offset (* y scaler)))
(nyscl (+ offset (* ny scaler)))
(xy (list x (if (or (not ycutoff)
@@ -90,9 +96,10 @@
(call-with-values
(lambda () (exp-seg x (expt base yscl) nx (expt base nyscl) yscl nyscl error))
(lambda (xs ys)
- (if (not (null? ys))
- (let ((ys-scaled (vct->list (vct-scale! (list->vct ys) out-scaler))))
- (let vals ((xx xs) (yy ys-scaled))
+ (if (pair? ys)
+ (let ((ys-scaled (map (lambda (y) (* y out-scaler)) ys)))
+ (let vals ((xx xs)
+ (yy ys-scaled))
(let ((x (car xx))
(y (car yy)))
(set! result (append result (list x y)))
@@ -137,7 +144,7 @@
(define* (semitones-envelope envelope (around 1.0) (error 0.01))
(exp-envelope envelope
:error error
- :base (expt 2 (/ 12))
+ :base (expt 2 1/12)
:cutoff #f
:scaler 1
:offset 0
@@ -228,33 +235,32 @@
(list 0 in 1 in)
in))
-;;; create a vct from an envelope
+;;; create a float-vector from an envelope
-(define* (make-gr-env env (length 512))
- (let* ((env-vct (make-vct length))
- (length-1 (exact->inexact (- length 1))))
+(define* (make-gr-env env1 (len 512))
+ (let ((env-float-vector (make-float-vector len))
+ (length-1 (* 1.0 (- len 1))))
(do ((i 0 (+ 1 i)))
- ((= i length) env-vct)
- (vct-set! env-vct i (envelope-interp (/ i length-1) env)))))
+ ((= i len) env-float-vector)
+ (set! (env-float-vector i) (envelope-interp (/ i length-1) env1)))))
;;;-----------------------------------------------------------------------------
;;; Grain envelopes
-(define* (raised-cosine
- (duty-cycle 100)
- (length 128))
- (let* ((v (make-vct length))
- (active (* length duty-cycle 0.01))
+(define* (raised-cosine (duty-cycle 100)
+ (len 128))
+ (let* ((v (make-float-vector len))
+ (active (* len duty-cycle 0.01))
(incr (/ pi (- active 1)))
- (start (/ (- length active) 2))
- (end (/ (+ length active) 2))
+ (start (/ (- len active) 2))
+ (end (/ (+ len active) 2))
(s 0))
(do ((i 0 (+ 1 i)))
- ((= i length) v)
+ ((= i len) v)
(if (and (>= i start) (< i end))
(let ((sine (sin (* s incr))))
(set! s (+ 1 s))
- (vct-set! v i (* sine sine)))))))
+ (set! (v i) (* sine sine)))))))
;;;=============================================================================
;;; Granular synthesis instrument
@@ -318,7 +324,7 @@
(grains 0)
(amp-envelope '(0 0 0.3 1 0.7 1 1 0))
(grain-envelope '(0 0 0.3 1 0.7 1 1 0))
- (grain-envelope-end #f)
+ grain-envelope-end
(grain-envelope-transition '(0 0 1 1))
(grain-envelope-array-size 512)
(grain-duration 0.1)
@@ -326,314 +332,322 @@
(grain-duration-limit 0.002)
(srate 0.0)
(srate-spread 0.0)
- (srate-linear #f)
+ srate-linear
(srate-base grani-default-base)
(srate-error 0.01)
(grain-start '(0 0 1 1))
(grain-start-spread 0.0)
- (grain-start-in-seconds #f)
+ grain-start-in-seconds
(grain-density 10.0)
(grain-density-spread 0.0)
(reverb-amount 0.01)
- (reverse #f)
+ reversed ; change this from "reverse" 18-Nov-13
(where-to 0)
- (where-bins #f) ; a vct, not a list
+ where-bins ; a float-vector, not a list
(grain-distance 1.0)
(grain-distance-spread 0.0)
(grain-degree 45.0)
(grain-degree-spread 0.0)
(verbose #t))
- (let* ((ts (times->samples start-time duration))
- (beg (car ts))
- (end (cadr ts))
+ (let ((ts (times->samples start-time duration))
(in-file-channels (channels file))
- (in-file-sr (exact->inexact (mus-sound-srate file)))
- (in-file-dur (/ (frames file) in-file-sr))
- (last-in-sample (floor (* in-file-dur in-file-sr)))
- ;; ratio between input and output sampling rates
- (srate-ratio (/ in-file-sr (mus-srate)))
- ;; sample rate converter for input samples
- (rd (make-readin :file file :channel (min input-channel (- in-file-channels 1))))
- (in-file-reader (make-src :input rd :srate 1.0))
- ;; sample rate conversion envelope
- (sr-env (make-env (if srate-linear
- (envelope-or-number srate)
- (exp-envelope (envelope-or-number srate)
- :base srate-base
- :error srate-error))
- :scaler srate-ratio
- :duration duration))
- ;; sample rate conversion random spread
- (sr-spread-env (make-env (envelope-or-number srate-spread)
- :duration duration))
- ;; amplitude envelope for the note
- (amp-env (make-env amp-envelope
- :scaler amplitude
- :duration duration))
- ;; grain duration envelope
- (gr-dur (make-env (envelope-or-number grain-duration)
- :duration duration))
- (gr-dur-spread (make-env (envelope-or-number grain-duration-spread)
- :duration duration))
- ;; position in the input file where the grain starts
- (gr-start-scaler (if (not grain-start-in-seconds) in-file-dur 1.0))
- (gr-start (make-env (envelope-or-number grain-start)
- :duration duration))
- ;; random variation in the position in the input file
- (gr-start-spread (make-env (envelope-or-number grain-start-spread)
- :duration duration))
- ;; density envelope in grains per second
- (gr-dens-env (make-env (envelope-or-number grain-density)
- :duration duration))
- ;; density spread envelope in grains per second
- (gr-dens-spread-env (make-env (envelope-or-number grain-density-spread)
- :duration duration))
- ;; grain envelope
- (gr-env (make-table-lookup :frequency 1.0
- :initial-phase 0.0
- :wave (if (vct? grain-envelope)
- grain-envelope
- (make-gr-env grain-envelope
- grain-envelope-array-size))))
- ;; grain envelope
- (gr-env-end (make-table-lookup :frequency 1.0
- :initial-phase 0.0
- :wave (if grain-envelope-end
- (if (vct? grain-envelope-end)
- grain-envelope-end
- (make-gr-env grain-envelope-end
- grain-envelope-array-size))
- (make-vct 512))))
- ;; envelope for transition between grain envelopes
- (gr-int-env (make-env (envelope-or-number grain-envelope-transition)
+ (in-file-sr (* 1.0 (mus-sound-srate file))))
+
+ (let ((beg (car ts))
+ (end (cadr ts))
+ (in-file-dur (/ (framples file) in-file-sr))
+ (out-chans (channels *output*))
+ (gr-samples 0)
+
+ ;; ratio between input and output sampling rates
+ (srate-ratio (/ in-file-sr *clm-srate*))
+ ;; sample rate converter for input samples
+ (rd (make-readin :file file :channel (min input-channel (- in-file-channels 1)))))
+
+ (let ((last-in-sample (floor (* in-file-dur in-file-sr)))
+
+ (in-file-reader (make-src :input rd :srate 1.0))
+ ;; sample rate conversion envelope
+ (sr-env (make-env (if srate-linear
+ (envelope-or-number srate)
+ (exp-envelope (envelope-or-number srate)
+ :base srate-base
+ :error srate-error))
+ :scaler srate-ratio
+ :duration duration))
+ ;; sample rate conversion random spread
+ (sr-spread-env (make-env (envelope-or-number srate-spread)
+ :duration duration))
+ ;; amplitude envelope for the note
+ (amp-env (make-env amp-envelope
+ :scaler amplitude
:duration duration))
- (interp-gr-envs grain-envelope-end)
- ;; envelope for distance of grains (for using in locsig)
- (gr-dist (make-env (envelope-or-number grain-distance)
- :duration duration))
- (gr-dist-spread (make-env (envelope-or-number grain-distance-spread)
- :duration duration))
- ;; envelopes for angular location and spread of grain in the stereo field
- (gr-degree (make-env (envelope-or-number grain-degree)
+ ;; grain duration envelope
+ (gr-dur (make-env (envelope-or-number grain-duration)
:duration duration))
- (gr-degree-spread (make-env (envelope-or-number grain-degree-spread)
+ (gr-dur-spread (make-env (envelope-or-number grain-duration-spread)
:duration duration))
- (out-chans (channels *output*))
- ;; signal locator in the stereo image
- (loc (make-locsig :degree 45.0
- :distance 1.0
- :channels out-chans))
- ;; variables used and initialized inside the run loop
- (in-samples 0)
- (gr-start-sample beg)
- (gr-from-beg 0)
- (in-start 0)
- (in-start-value 0.0)
- (gr-duration 0.0)
- (gr-samples 0)
- (gr-offset (+ 1 gr-samples))
- (gr-dens 0.0)
- (gr-dens-spread 0.0)
- (gr-srate 0.0)
- (grain-counter 0)
- (samples 0)
- (first-grain #t)
- (gr-where 0.0)
- (where 0.0)
- (deg 0.0)
- (happy #t)
- (dist 0.0)
- (dist-scl 0.0)
- (dist-rscl 0.0)
- (where-bins-len (if (vct? where-bins) (length where-bins) 0)))
- (if reverse (set! (mus-increment in-file-reader) -1.0))
- (run
- (do () ((not happy))
- (if (< gr-offset gr-samples)
- ;;
- ;; send sample to output
- ;;
- (begin
- (if interp-gr-envs (set! gr-where (env gr-int-env)))
- (locsig loc (+ gr-start-sample gr-offset)
- (* (if interp-gr-envs
- (+ (* (- 1 gr-where) (table-lookup gr-env))
- (* gr-where (table-lookup gr-env-end)))
- (table-lookup gr-env))
- (env amp-env)
- (src in-file-reader)))
- ;; increment pointer in grain
- (set! gr-offset (+ 1 gr-offset)))
- (begin
- ;;
- ;; start of a new grain
- ;;
- (if first-grain
- ;; first grain always starts at 0
- (begin
- (set! first-grain #f)
- (set! gr-start-sample beg))
- (begin
- ;; start grain in output file using
- ;; increments from previous grain
- (set! gr-start-sample (+ gr-start-sample
- (floor
- (* (/ (+ gr-dens gr-dens-spread)) (mus-srate)))))
- ;; finish if start of grain falls outside of note
- ;; bounds or number of grains exceeded
- (if (or (> gr-start-sample end)
- (if (not (zero? grains))
- (>= grain-counter grains)
- #f))
- (set! happy #f))))
- (if happy
- (begin
- ;; back to the beginning of the grain
- (set! gr-offset 0)
- ;; start of grain in samples from beginning of note
- (set! gr-from-beg (floor (- gr-start-sample beg)))
- ;; reset out-time dependent envelopes to current time
- (set! (mus-location amp-env) gr-from-beg)
- (set! (mus-location gr-dur) gr-from-beg)
- (set! (mus-location gr-dur-spread) gr-from-beg)
- (set! (mus-location sr-env) gr-from-beg)
- (set! (mus-location sr-spread-env) gr-from-beg)
- (set! (mus-location gr-start) gr-from-beg)
- (set! (mus-location gr-start-spread) gr-from-beg)
- (set! (mus-location gr-dens-env) gr-from-beg)
- (set! (mus-location gr-dens-spread-env) gr-from-beg)
- ;; start of grain in input file
- (set! in-start-value (+ (* (env gr-start) gr-start-scaler)
- (mus-random (* 0.5 (env gr-start-spread)
- gr-start-scaler))))
- (set! in-start (floor (* in-start-value in-file-sr)))
- ;; duration in seconds of the grain
- (set! gr-duration (max grain-duration-limit
- (+ (env gr-dur)
- (mus-random (* 0.5 (env gr-dur-spread))))))
- ;; number of samples in the grain
- (set! gr-samples (floor (* gr-duration (mus-srate))))
- ;; new sample rate for grain
- (set! gr-srate (if srate-linear
- (+ (env sr-env)
- (mus-random (* 0.5 (env sr-spread-env))))
- (* (env sr-env)
- (expt srate-base
- (mus-random (* 0.5 (env sr-spread-env)))))))
- ;; set new sampling rate conversion factor
- (set! (mus-increment in-file-reader) gr-srate)
- ;; number of samples in input
- (set! in-samples (floor (/ gr-samples (/ 1 srate-ratio))))
- ;; restart grain envelopes
- (set! (mus-phase gr-env) 0.0)
- (set! (mus-phase gr-env-end) 0.0)
- ;; reset grain envelope durations
- (set! (mus-frequency gr-env) (/ 1 gr-duration))
- (set! (mus-frequency gr-env-end) (/ 1 gr-duration))
- ;;
- ;; move position in output file for next grain
- ;;
- (set! gr-dens (env gr-dens-env))
- ;; increment spread in output file for next grain
- (set! gr-dens-spread (mus-random (* 0.5 (env gr-dens-spread-env))))
- ;; gather some statistics
- (set! samples (+ samples gr-samples))
- (set! grain-counter (+ grain-counter 1))
- (set! where (cond (;; use duration of grains as delimiter
- (= where-to grani-to-grain-duration)
- gr-duration)
- (;; use start in input file as delimiter
- (= where-to grani-to-grain-start)
- in-start-value)
- (;; use sampling rate as delimiter
- (= where-to grani-to-grain-sample-rate)
- gr-srate)
- (;; use a random number as delimiter
- (= where-to grani-to-grain-random)
- (random 1.0))
- (else grani-to-locsig)))
- (if (and (not (zero? where))
- (vct? where-bins)
- (> where-bins-len 1))
- ;; set output scalers according to criteria
- (do ((chn 0 (+ 1 chn)))
- ((or (= chn out-chans)
- (= chn where-bins-len)))
- (locsig-set! loc chn (if (< (vct-ref where-bins chn)
- where
- (vct-ref where-bins (+ 1 chn)))
- 1.0
- 0.0)))
- ;; if not "where" see if the user wants to send to all channels
- (if (= where-to grani-to-grain-allchans)
- ;; send the grain to all channels
- (do ((chn 0 (+ 1 chn)))
- ((= chn out-chans))
- (locsig-set! loc chn 1.0))
- ;; "where" is zero or unknown: use normal n-channel locsig,
- ;; only understands mono reverb and 1, 2 or 4 channel output
- (begin
- (set! (mus-location gr-dist) gr-from-beg)
- (set! (mus-location gr-dist-spread) gr-from-beg)
- (set! (mus-location gr-degree) gr-from-beg)
- (set! (mus-location gr-degree-spread) gr-from-beg)
- ;; set locsig parameters, for now only understands stereo
- (set! deg (+ (env gr-degree)
- (mus-random (* 0.5 (env gr-degree-spread)))))
- (set! dist (+ (env gr-dist)
- (mus-random (* 0.5 (env gr-dist-spread)))))
- (set! dist-scl (/ 1.0 (max dist 1.0)))
- (set! dist-rscl (/ 1.0 (sqrt (max dist 1.0))))
- (if *reverb*
- (locsig-reverb-set! loc 0 (* reverb-amount dist-rscl)))
- (if (= out-chans 1)
- (locsig-set! loc 0 dist-scl)
- (if (= out-chans 2)
- (let ((frac (/ (min 90.0 (max 0.0 deg)) 90.0)))
- (locsig-set! loc 0 (* dist-scl (- 1.0 frac)))
- (locsig-set! loc 1 (* dist-scl frac)))
- (if (> out-chans 2)
- (begin
- (locsig-set! loc 0
- (if (<= 0 deg 90)
- (* dist-scl
- (/ (- 90 deg) 90.0))
- (if (<= 270 deg 360)
- (* dist-scl
- (/ (- deg 270) 90))
- 0.0)))
- (locsig-set! loc 1
- (if (<= 90 deg 180)
- (* dist-scl
- (/ (- 180 deg) 90.0))
- (if (<= 0 deg 90)
- (* dist-scl
- (/ deg 90))
- 0.0)))
- (locsig-set! loc 2
- (if (<= 180 deg 270)
- (* dist-scl
- (/ (- 270 deg) 90.0))
- (if (<= 90 deg 180)
- (* dist-scl
- (/ (- deg 90) 90))
- 0.0)))
- (if (> out-chans 3)
- (locsig-set! loc 3
- (if (<= 270 deg 360)
- (* dist-scl
- (/ (- 360 deg) 90.0))
- (if (<= 180 deg 270)
- (* dist-scl
- (/ (- deg 180) 90))
- 0.0)))))))))))))
- ;; check for out of bounds condition in in-file pointers
- (if (> (+ in-start in-samples) last-in-sample)
- (set! in-start (- last-in-sample in-samples))
- (if (< in-start 0)
- (set! in-start 0)))
- ;; reset position of input file reader
- (set! (mus-location rd) in-start)))))))
+ ;; position in the input file where the grain starts
+ (gr-start-scaler (if (not grain-start-in-seconds) in-file-dur 1.0))
+ (gr-start (make-env (envelope-or-number grain-start)
+ :duration duration))
+ ;; random variation in the position in the input file
+ (gr-start-spread (make-env (envelope-or-number grain-start-spread)
+ :duration duration))
+ ;; density envelope in grains per second
+ (gr-dens-env (make-env (envelope-or-number grain-density)
+ :duration duration))
+ ;; density spread envelope in grains per second
+ (gr-dens-spread-env (make-env (envelope-or-number grain-density-spread)
+ :duration duration))
+ ;; grain envelope
+ (gr-env (make-table-lookup :frequency 1.0
+ :initial-phase 0.0
+ :wave (if (float-vector? grain-envelope)
+ grain-envelope
+ (make-gr-env grain-envelope
+ grain-envelope-array-size))))
+ ;; grain envelope
+ (gr-env-end (make-table-lookup :frequency 1.0
+ :initial-phase 0.0
+ :wave (if grain-envelope-end
+ (if (float-vector? grain-envelope-end)
+ grain-envelope-end
+ (make-gr-env grain-envelope-end
+ grain-envelope-array-size))
+ (make-float-vector 512))))
+ ;; envelope for transition between grain envelopes
+ (gr-int-env (make-env (envelope-or-number grain-envelope-transition) :duration duration))
+ (gr-int-env-1 (make-env (envelope-or-number grain-envelope-transition) :duration duration :offset 1.0 :scaler -1.0))
+ (interp-gr-envs grain-envelope-end)
+ ;; envelope for distance of grains (for using in locsig)
+ (gr-dist (make-env (envelope-or-number grain-distance)
+ :duration duration))
+ (gr-dist-spread (make-env (envelope-or-number grain-distance-spread)
+ :duration duration))
+ ;; envelopes for angular location and spread of grain in the stereo field
+ (gr-degree (make-env (envelope-or-number grain-degree)
+ :duration duration))
+ (gr-degree-spread (make-env (envelope-or-number grain-degree-spread)
+ :duration duration))
+ ;; signal locator in the stereo image
+ (loc (make-locsig :degree 45.0
+ :distance 1.0
+ :channels out-chans))
+
+ (in-samples 0)
+ (gr-start-sample beg)
+ (gr-from-beg 0)
+ (in-start 0)
+ (in-start-value 0.0)
+ (gr-duration 0.0)
+ (gr-dens 0.0)
+ (gr-dens-spread 0.0)
+ (gr-srate 0.0)
+ (grain-counter 0)
+ (first-grain #t)
+ (where 0.0)
+ (happy #t)
+ (where-bins-len (if (float-vector? where-bins) (length where-bins) 0)))
+ (if (<= where-bins-len 1)
+ (set! where-bins #f))
+
+ (if reversed (set! (mus-increment in-file-reader) -1.0))
+ (do ()
+ ((not happy))
+ ;;
+ ;; start of a new grain
+ ;;
+ (if first-grain
+ ;; first grain always starts at 0
+ (begin
+ (set! first-grain #f)
+ (set! gr-start-sample beg))
+ (begin
+ ;; start grain in output file using
+ ;; increments from previous grain
+ (set! gr-start-sample (+ gr-start-sample
+ (floor
+ (* (/ (+ gr-dens gr-dens-spread)) *clm-srate*))))
+ ;; finish if start of grain falls outside of note
+ ;; bounds or number of grains exceeded
+ (if (or (> gr-start-sample end)
+ (and (not (zero? grains))
+ (>= grain-counter grains)))
+ (set! happy #f))))
+ (if happy
+ (begin
+ ;; back to the beginning of the grain
+ ;(set! gr-offset 0)
+ ;; start of grain in samples from beginning of note
+ (set! gr-from-beg (floor (- gr-start-sample beg)))
+ ;; reset out-time dependent envelopes to current time
+ (set! (mus-location amp-env) gr-from-beg)
+ (set! (mus-location gr-dur) gr-from-beg)
+ (set! (mus-location gr-dur-spread) gr-from-beg)
+ (set! (mus-location sr-env) gr-from-beg)
+ (set! (mus-location sr-spread-env) gr-from-beg)
+ (set! (mus-location gr-start) gr-from-beg)
+ (set! (mus-location gr-start-spread) gr-from-beg)
+ (set! (mus-location gr-dens-env) gr-from-beg)
+ (set! (mus-location gr-dens-spread-env) gr-from-beg)
+ ;; start of grain in input file
+ (set! in-start-value (+ (* (env gr-start) gr-start-scaler)
+ (mus-random (* 0.5 (env gr-start-spread)
+ gr-start-scaler))))
+ (set! in-start (floor (* in-start-value in-file-sr)))
+ ;; duration in seconds of the grain
+ (set! gr-duration (max grain-duration-limit
+ (+ (env gr-dur)
+ (mus-random (* 0.5 (env gr-dur-spread))))))
+ ;; number of samples in the grain
+ (set! gr-samples (floor (* gr-duration *clm-srate*)))
+ ;; new sample rate for grain
+ (set! gr-srate (if srate-linear
+ (+ (env sr-env)
+ (mus-random (* 0.5 (env sr-spread-env))))
+ (* (env sr-env)
+ (expt srate-base
+ (mus-random (* 0.5 (env sr-spread-env)))))))
+ ;; set new sampling rate conversion factor
+ (set! (mus-increment in-file-reader) gr-srate)
+ ;; number of samples in input
+ (set! in-samples (floor (* gr-samples srate-ratio)))
+
+ ;; check for out of bounds condition in in-file pointers
+ (if (> (+ in-start in-samples) last-in-sample)
+ (set! in-start (- last-in-sample in-samples))
+ (if (< in-start 0)
+ (set! in-start 0)))
+ ;; reset position of input file reader
+ (set! (mus-location rd) in-start)
+
+ ;; restart grain envelopes
+ (set! (mus-phase gr-env) 0.0)
+ (set! (mus-phase gr-env-end) 0.0)
+ ;; reset grain envelope durations
+ (set! (mus-frequency gr-env) (/ gr-duration))
+ (set! (mus-frequency gr-env-end) (/ gr-duration))
+ ;;
+ ;; move position in output file for next grain
+ ;;
+ (set! gr-dens (env gr-dens-env))
+ ;; increment spread in output file for next grain
+ (set! gr-dens-spread (mus-random (* 0.5 (env gr-dens-spread-env))))
+ (set! grain-counter (+ grain-counter 1))
+ (set! where (cond (;; use duration of grains as delimiter
+ (= where-to grani-to-grain-duration)
+ gr-duration)
+ (;; use start in input file as delimiter
+ (= where-to grani-to-grain-start)
+ in-start-value)
+ (;; use sampling rate as delimiter
+ (= where-to grani-to-grain-sample-rate)
+ gr-srate)
+ (;; use a random number as delimiter
+ (= where-to grani-to-grain-random)
+ (random 1.0))
+ (else grani-to-locsig)))
+ (if (and where-bins
+ (not (zero? where)))
+ ;; set output scalers according to criteria
+ (do ((chn 0 (+ chn 1)))
+ ((or (= chn out-chans)
+ (= chn where-bins-len)))
+ (locsig-set! loc chn (if (< (where-bins chn)
+ where
+ (where-bins (+ chn 1)))
+ 1.0
+ 0.0)))
+ ;; if not "where" see if the user wants to send to all channels
+ (if (= where-to grani-to-grain-allchans)
+ ;; send the grain to all channels
+ (do ((chn 0 (+ chn 1)))
+ ((= chn out-chans))
+ (locsig-set! loc chn 1.0))
+ ;; "where" is zero or unknown: use normal n-channel locsig,
+ ;; only understands mono reverb and 1, 2 or 4 channel output
+ (begin
+ (set! (mus-location gr-dist) gr-from-beg)
+ (set! (mus-location gr-dist-spread) gr-from-beg)
+ (set! (mus-location gr-degree) gr-from-beg)
+ (set! (mus-location gr-degree-spread) gr-from-beg)
+ ;; set locsig parameters, for now only understands stereo
+ (move-locsig loc
+ (+ (env gr-degree)
+ (mus-random (* 0.5 (env gr-degree-spread))))
+ (+ (env gr-dist)
+ (mus-random (* 0.5 (env gr-dist-spread))))))))
+
+ (let ((grend (+ gr-start-sample gr-samples)))
+ (if interp-gr-envs
+ (do ((gr-offset gr-start-sample (+ gr-offset 1)))
+ ((= gr-offset grend))
+ (locsig loc gr-offset (* (env amp-env)
+ (src in-file-reader)
+ (+ (* (env gr-int-env) (table-lookup gr-env-end))
+ (* (env gr-int-env-1) (table-lookup gr-env))))))
+
+ (do ((gr-offset gr-start-sample (+ gr-offset 1)))
+ ((= gr-offset grend))
+ (locsig loc gr-offset (* (env amp-env)
+ (table-lookup gr-env)
+ (src in-file-reader)))))))))))))
+
;; (with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1) (let ((file "oboe.snd")) (grani 0 2 5 file :grain-envelope (raised-cosine))))
;; (with-sound (:channels 2) (let ((file "oboe.snd")) (grani 0 2 5 file :grain-envelope (raised-cosine))))
+
+(define (test-grani)
+ (with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1 :statistics #t)
+ (grani 0 1 .5 "oboe.snd" :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0))
+ (grani 0 4 1 "oboe.snd")
+ (grani 0 4 1 "oboe.snd" :grains 10)
+ (grani 0 4 1 "oboe.snd"
+ :grain-start 0.11
+ :amp-envelope '(0 1 1 1) :grain-density 8
+ :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)
+ :grain-envelope-end '(0 0 0.01 1 0.99 1 1 0)
+ :grain-envelope-transition '(0 0 0.4 1 0.8 0 1 0))
+ (grani 0 3 1 "oboe.snd"
+ :grain-start 0.1
+ :amp-envelope '(0 1 1 1) :grain-density 20
+ :grain-duration '(0 0.003 0.2 0.01 1 0.3))
+ (grani 0 3 1 "oboe.snd"
+ :grain-start 0.1
+ :amp-envelope '(0 1 1 1) :grain-density 20
+ :grain-duration '(0 0.003 0.2 0.01 1 0.3)
+ :grain-duration-limit 0.02)
+ (grani 0 2 1 "oboe.snd"
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-start '(0 0.1 0.3 0.1 1 0.6))
+ (grani 0 2 1 "oboe.snd"
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-start '(0 0.1 0.3 0.1 1 0.6)
+ :grain-start-spread 0.01)
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate '(0 0 0.2 0 0.6 5 1 5))
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate-base 2
+ :srate '(0 0 0.2 0 0.6 -1 1 -1))
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate-linear #t
+ :srate (list 0 1 0.2 1 0.6 (expt 2 5/12) 1 (expt 2 5/12)))
+ (grani 0 2 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-duration '(0 0.02 1 0.1)
+ :grain-duration-spread '(0 0 0.5 0.1 1 0)
+ :where-to grani-to-grain-duration ; from grani.scm
+ :where-bins (float-vector 0 0.05 1))
+ (grani 0 2 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-degree '(0 0 1 90)
+ :grain-degree-spread 10)))
\ No newline at end of file
diff --git a/grfsnd.html b/grfsnd.html
index 75919bc..9db38a6 100644
--- a/grfsnd.html
+++ b/grfsnd.html
@@ -1,111 +1,195 @@
-<html>
+<!DOCTYPE html>
+
+<html lang="en">
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>Snd Customization and Extension</title>
<style type="text/css">
-<!--
EM.red {color:red; font-style:normal}
- EM.typing {color:maroon; font-style: normal}
- EM.listener {color:darkblue; font-style: normal}
EM.tab {font-style: normal; font-size: small; font-family: fixed}
EM.emdef {font-weight: bold; font-style: normal; padding-right: 0.2cm}
H1 {text-align: center}
UL {list-style-type: none}
+ EM.noem {font-style: normal}
+
+ PRE.indented {padding-left: 1.0cm;
+ }
+ PRE.file {padding-left: 1.0cm;
+ background-color: #f8f8f0;
+ }
A {text-decoration:none}
A:hover {text-decoration:underline}
A.quiet {color:black; text-decoration:none}
A.quiet:hover {text-decoration:underline}
A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black; padding-right: 0.2cm}
--->
+ EM.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black; padding-right: 0.2cm}
+
+ TH.scheme {background-color: #f2f4ff; text-align: left; padding-left: 0.5cm;}
+ TH.ruby {background-color: beige; text-align: left; padding-left: 0.5cm;}
+ TH.forth {background-color: lightgreen; text-align: left; padding-left: 0.5cm;}
+
+ TD.scheme {background-color: #fbfbff; padding-right: 0.5cm; border: 1px solid lightgray;}
+ TD.ruby {background-color: #fdfdf2; padding-right: 0.5cm; border: 1px solid lightgray;}
+ TD.forth {background-color: #eefdee; padding-right: 0.5cm; border: 1px solid lightgray;}
+
+ TABLE.spaced {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 0.5cm;
+ }
+
+ TABLE.bordered {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 2.0cm;
+ border: 2px solid gray;
+ border-radius: 20px;
+ -moz-border-radius: 20px;
+ -webkit-border-radius: 20px;
+ padding-top: 0.5cm;
+ padding-bottom: 0.25cm;
+ padding-left: 0.5cm;
+ padding-right: 0.5cm;
+ }
+
+ TD.inner {padding-right: 0.5cm;
+ padding-top: 0.1cm;
+ }
+
+ DIV.center {text-align: center}
+ DIV.bluish {background-color: #f2f4ff;
+ margin-left: 1.0cm;
+ margin-top: 1.0cm;
+ padding-left: 0.5cm;
+ }
+ BODY.body {background-color: #ffffff; /* white */
+ margin-left: 0.5cm;
+ }
+ DIV.centered1 {padding-left: 35%;
+ padding-bottom: 0.5cm;
+ }
+ DIV.indented {background-color: #F8F8F0;
+ padding-left: 0.5cm;
+ padding-right: 0.5cm;
+ padding-top: 0.5cm;
+ padding-bottom: 0.5cm;
+ margin-bottom: 0.5cm;
+ border: 1px solid gray;
+ border-radius: 20px;
+ -moz-border-radius: 20px;
+ -webkit-border-radius: 20px;
+ }
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.header {margin-top: 50px;
+ margin-bottom: 10px;
+ font-size: 20px;
+ font-weight: bold;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ text-align: center;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.innerheader {margin-top: 60px;
+ margin-bottom: 30px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #eefdee; /* lightgreen */
+ padding-left: 30px;
+ width: 50%;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.related {text-align:center;
+ border: 1px solid lightgray;
+ margin-bottom: 1.0cm;
+ margin-top: 1.0cm;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ background-color: #f0f0f0;
+ }
</style>
</head>
-<body bgcolor=white>
+<body class="body">
-<script language=JavaScript type="text/javascript" src="wz_tooltip.js"></script>
-<script language=JavaScript type="text/javascript" src="wz_data.js"></script>
+<div class="topheader" id="grfsndcontents">Snd Customization and Extension Part 2</div>
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="extsnd.html">extsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="fm.html">fm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
-<!-- I'm using A NAME (i.e caps) where the entity should be ignored by the indexer (make-index.scm) -->
-<A NAME="grfsndcontents"></a>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h1>Snd Customization and Extension Part 2</h1></td></tr></table>
-</td></tr></table>
-<br>
-
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
-
-
-<table border=0 cellpadding=5 vspace=10 hspace=20>
+<table class="spaced">
<tr><th>this file:</th><th>extsnd.html:</th></tr>
-<tr><td width="40%">
+<tr><td>
<ul>
<li><a href="#startup">Snd Startup</a>
<ul>
- <li><a href="#sndswitches" onmouseout="UnTip()" onmouseover="Tip('startup switches such as -l and -p')">Snd invocation flags</a>
- <li><a href="#sndinitfile" onmouseout="UnTip()" onmouseover="Tip('~/.snd, ~/.snd_s7, ~/.snd_prefs_s7, etc')">The initialization file</a>
- <li><a href="#sndconfigurationswitches" onmouseout="UnTip()" onmouseover="Tip('this refers to the configure script that prepares a makefile to build Snd from its sources')">Configuration choices</a>
- <li><a href="#sndenvvars" onmouseout="UnTip()" onmouseover="Tip('mostly related to audio hardware choices')">Environment variables</a>
+ <li><a href="#sndswitches">Snd invocation flags</a>
+ <li><a href="#sndinitfile">The initialization file</a>
+ <li><a href="#sndconfigurationswitches">Configuration choices</a>
+ <li><a href="#sndenvvars">Environment variables</a>
</ul>
<li><a href="#snddynamic">Runtime modules and external programs</a>
<ul>
- <li><a href="#emacssnd" onmouseout="UnTip()" onmouseover="Tip('Use Emacs as the listener')">Snd as an Emacs subjob</a>
- <li><a href="#dynamic" onmouseout="UnTip()" onmouseover="Tip('Load your own C code into Snd')">Dynamically loaded modules</a>
- <li><a href="#sndaswidget" onmouseout="UnTip()" onmouseover="Tip('Embed Snd in some other program')">Snd as a Widget</a>
- <li><a href="#sndwithclm" onmouseout="UnTip()" onmouseover="Tip('CLM is built into Snd')">Snd and CLM</a>
- <li><a href="#sndwithcm" onmouseout="UnTip()" onmouseover="Tip('CM is Rick Taube\'s composition environment')">Snd and Common Music</a>
- <li><a href="#sndwithmotif" onmouseout="UnTip()" onmouseover="Tip('Motif extensions from xm.c')">Snd and Motif</a>
- <li><a href="#sndwithgtk" onmouseout="UnTip()" onmouseover="Tip('Gtk extensions from xg.c')">Snd and Gtk</a>
+ <li><a href="#emacssnd">Snd as an Emacs subjob</a>
+ <li><a href="#dynamic">Dynamically loaded modules</a>
+ <li><a href="#sndwithclm">Snd and CLM</a>
+ <li><a href="#sndwithcm">Snd and Common Music</a>
+ <li><a href="#sndwithmotif">Snd and Motif</a>
+ <li><a href="#sndwithgtk">Snd and Gtk</a>
<li><a href="#sndwithnogui">Snd with no GUI and as scripting engine</a>
- <li><a href="#sndandruby" onmouseout="UnTip()" onmouseover="Tip('Ruby is a scripting/extension language somewhat like Python')">Snd with Ruby</a>
- <li><a href="#sndandforth" onmouseout="UnTip()" onmouseover="Tip('Forth is a postfix extension language')">Snd with Forth</a>
- <li><a href="#sndands7" onmouseout="UnTip()" onmouseover="Tip('s7 is yet another Scheme extension language')">Snd with s7</a>
- <li><a href="#sndandladspa" onmouseout="UnTip()" onmouseover="Tip('This is a Linux-based sound-effects plugin system')">Snd and LADSPA plugins</a>
- <li><a href="#sndandalsa" onmouseout="UnTip()" onmouseover="Tip('This is the no-longer-very-new Linux audio library')">Snd and ALSA</a>
- <li><a href="#sndandjack" onmouseout="UnTip()" onmouseover="Tip('This is the Jack audio library')">Snd and Jack</a>
- <li><a href="#sndandgl" onmouseout="UnTip()" onmouseover="Tip('OpenGL (Mesa) extensions via gl.c')">Snd and OpenGL</a>
- <li><a href="#sndandgsl" onmouseout="UnTip()" onmouseover="Tip('include some special functions from GSL')">Snd and GSL</a>
- <li><a href="#sndandgmp" onmouseout="UnTip()" onmouseover="Tip('include multiprecision arithmetic')">Snd and multiprecision arithmetic (gmp, mpfr, mpc)</a>
+ <li><a href="#sndandruby">Snd with Ruby</a>
+ <li><a href="#sndandforth">Snd with Forth</a>
+ <li><a href="#sndands7">Snd with s7</a>
+ <li><a href="#sndandladspa">Snd and LADSPA plugins</a>
+ <li><a href="#sndandalsa">Snd and ALSA</a>
+ <li><a href="#sndandjack">Snd and Jack</a>
+ <li><a href="#sndandgl">Snd and OpenGL</a>
+ <li><a href="#sndandgsl">Snd and GSL</a>
+ <li><a href="#sndandgmp">Snd and multiprecision arithmetic (gmp, mpfr, mpc)</a>
</ul>
+ <li><a href="#otherstuff">Other stuff</a>
</ul>
-</td><td width="40%">
+</td><td>
<ul>
<li><a href="extsnd.html#behavior">Customizing Snd's behavior</a>
<ul>
<li><a href="extsnd.html#sndglobalvars">Global variables</a>
<li><a href="extsnd.html#sndgenericfuncs">Generic functions</a>
- <li><a href="extsnd.html#sndhooks" onmouseout="UnTip()" onmouseover="Tip('callbacks')">Hooks</a>
+ <li><a href="extsnd.html#sndhooks">Hooks</a>
</ul>
<li><a href="extsnd.html#sndobjects">Snd's objects</a>
<ul>
- <li><a href="extsnd.html#samplers" onmouseout="UnTip()" onmouseover="Tip('sound data iterators', WIDTH, 200)">Samplers</a>
- <li><a href="extsnd.html#Vcts" onmouseout="UnTip()" onmouseover="Tip('real arrays', WIDTH, 100)">Vcts</a>
- <li><a href="extsnd.html#sndsounddata" onmouseout="UnTip()" onmouseover="Tip('arrays of vcts for multichannel data')">Sound-data</a>
- <li><a href="extsnd.html#extsndlib" onmouseout="UnTip()" onmouseover="Tip('the underlying library that handles sound data and files')">Sndlib</a>
- <li><a href="extsnd.html#sndmarks" onmouseout="UnTip()" onmouseover="Tip('location markers in sound data')">Marks</a>
- <li><a href="extsnd.html#sndmixes" onmouseout="UnTip()" onmouseover="Tip('mixed sounds and groups of mixed sounds')">Mixes</a>
- <li><a href="extsnd.html#sndregions" onmouseout="UnTip()" onmouseover="Tip('selected or saved portions of sound data')">Regions and Selections</a>
- <li><a href="extsnd.html#sndsounds" onmouseout="UnTip()" onmouseover="Tip('editing functions, per-channel display decisions, etc')">Sounds and channels</a>
+ <li><a href="extsnd.html#samplers">Samplers</a>
+ <li><a href="extsnd.html#Vcts">Vcts</a>
+ <li><a href="extsnd.html#extsndlib">Sndlib</a>
+ <li><a href="extsnd.html#sndmarks">Marks</a>
+ <li><a href="extsnd.html#sndmixes">Mixes</a>
+ <li><a href="extsnd.html#sndregions">Regions and Selections</a>
+ <li><a href="extsnd.html#sndsounds">Sounds and channels</a>
<ul>
- <li><a href="extsnd.html#customcontrols" onmouseout="UnTip()" onmouseover="Tip('a set of common sound effects below the main graph')">the control panel</a>
- <li><a href="extsnd.html#editlists" onmouseout="UnTip()" onmouseover="Tip('current edit sequence', WIDTH, 200)">edit lists</a>
+ <li><a href="extsnd.html#customcontrols">the control panel</a>
+ <li><a href="extsnd.html#editlists">edit lists</a>
</ul>
- <li><a href="extsnd.html#sndtransforms" onmouseout="UnTip()" onmouseover="Tip('Fourier transform, wavelets, autocorelation, etc')">Transforms</a>
- <li><a href="extsnd.html#snddialogs" onmouseout="UnTip()" onmouseover="Tip('customizing the built-in dialogs, etc')">Dialogs and Other Widgets</a>
- <li><a href="extsnd.html#sndmisc" onmouseout="UnTip()" onmouseover="Tip('bind-key, exit, etc')">Miscellaneous functions</a>
+ <li><a href="extsnd.html#sndtransforms">Transforms</a>
+ <li><a href="extsnd.html#snddialogs">Dialogs and Other Widgets</a>
+ <li><a href="extsnd.html#sndmisc">Miscellaneous functions</a>
<li><a href="extsnd.html#sndconstants">Constants</a>
<li><a href="extsnd.html#snderrors">Errors and Debugging</a>
</ul>
@@ -113,105 +197,105 @@
<ul>
<li><a href="extsnd.html#colors">Colors</a>
<li><a href="extsnd.html#fonts">Fonts</a>
- <li><a href="extsnd.html#graphics" onmouseout="UnTip()" onmouseover="Tip('write your own sound display functions or customize Snd\'s')">Graphics</a>
+ <li><a href="extsnd.html#graphics">Graphics</a>
</ul>
</ul>
</td></tr></table>
-<br>
+
<!-- INDEX sndandruby:Ruby -->
<!-- INDEX sndandforth:Forth -->
<!-- INDEX sndwithcm:Common Music -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="startup">Snd Startup</a></h2></td></tr></table>
-</td></tr></table>
-<br>
+
+<div class="header" id="startup">Snd startup</div>
+
<!-- INDEX sndswitches:Invocation flags -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndswitches">Snd invocation flags</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndswitches">Snd invocation flags</div>
<p>Snd recognizes the following switches in its command line:
</p>
-<table border=2 bordercolor="#f2f4ff" cellpadding=6 hspace=10><tr><td>
-<table cellspacing=0 cellpadding=0 hspace=20>
-<tr><td width=200 bgcolor="#f2f4ff"><code>-h -horizontal</code></td><td bgcolor="#f2f4ff">layout sounds as horizontal panes</td></tr>
-<tr><td><code>-v -vertical</code></td> <td>layout sounds vertically (the default)</td></tr>
-<tr><td bgcolor="#f2f4ff"><code>-notebook</code></td> <td bgcolor="#f2f4ff">layout sounds in a notebook widget (Motif 2.0 or later)</td></tr>
-<tr><td><code>-separate</code></td> <td>layout sounds each in a separate window (listener is in main window)</td></tr>
-<tr><td bgcolor="#f2f4ff"><code>--help</code></td> <td bgcolor="#f2f4ff">print some help, version info, and exit</td></tr>
-<tr><td><code>--version</code></td> <td>print version info</td></tr>
-<tr><td bgcolor="#f2f4ff"><code>-noglob</code></td> <td bgcolor="#f2f4ff">don't read /etc/snd.conf</td></tr>
-<tr><td><code>-noinit</code></td> <td>don't read ~/.snd</td></tr>
-<tr><td bgcolor="#f2f4ff"><code>-nostdin</code></td> <td bgcolor="#f2f4ff">don't watch for possible input from stdin</td></tr>
-<tr><td><code>-p -preload <dir></code></td> <td>add sound files in directory <dir> to the View:Files list (snd -p .)</td></tr>
-<tr><td bgcolor="#f2f4ff"><code>-l -load <file></code></td> <td bgcolor="#f2f4ff">load Scheme, Ruby, or Forth code in <file> (snd -l test.scm)</td></tr>
-<tr><td><code>-e -eval expr</code></td> <td>evaluate expr</td></tr>
-<tr><td bgcolor="#f2f4ff"><code>-b -batch <file></code></td> <td bgcolor="#f2f4ff">load Scheme, Ruby, or Forth code in <file> as a batch (no GUI) job</td></tr>
-<tr><td><code>-I <dir></code></td> <td>add <dir> to the load search list</td></tr>
-</table>
-</td></tr></table>
+<pre class="indented">
+-h -horizontal layout sounds as horizontal panes
+-v -vertical layout sounds vertically (the default)
+-notebook layout sounds in a notebook widget (Motif 2.0 or later)
+-separate layout sounds each in a separate window (listener is in main window)
+--help print some help, version info, and exit
+--version print version info
+-noglob don't read /etc/snd.conf
+-noinit don't read ~/.snd
+-nostdin don't watch for possible input from stdin
+-p -preload <dir> add sound files in directory <dir> to the View:Files list (snd -p .)
+-l -load <file> load Scheme, Ruby, or Forth code in <file> (snd -l test.scm)
+-e -eval expr evaluate expr
+-b -batch <file> load Scheme, Ruby, or Forth code in <file> as a batch (no GUI) job
+-I <dir> add <dir> to the load search list
+</pre>
+
+
+<table class="bordered">
+<tr><td>
+<img src="pix/note.png" alt="notebook">
-<table border=0 hspace=20 vspace=20>
-<tr>
-<td><img src="pix/note.png" alt="notebook"></td>
-<td width=40></td>
-<td>
<pre>
snd -notebook oboe.snd pistol.snd
-(set! (<a class=quiet href="extsnd.html#graphstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphstyle_tip)">graph-style</a>) graph-lollipops)
-(set! (<a class=quiet href="extsnd.html#dotsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_dotsize_tip)">dot-size</a>) 8)
+(set! (<a class=quiet href="extsnd.html#graphstyle">graph-style</a>) graph-lollipops)
+(set! (<a class=quiet href="extsnd.html#dotsize">dot-size</a>) 8)
</pre>
-</td>
-</tr>
-</table>
+
+</td></tr></table>
<p>
The -e switch evaluates its argument. The
initialization file, if any, is loaded first, then the arguments are processed
in order:</p>
-<pre>
- snd -e "(set! (<a class=quiet href="extsnd.html#datacolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_datacolor_tip)">data-color</a>) (<a class=quiet href="extsnd.html#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 1 0 0))" oboe.snd
+
+<pre class="indented">
+snd -e "(set! (<a class=quiet href="extsnd.html#datacolor">data-color</a>) (<a class=quiet href="extsnd.html#makecolor">make-color</a> 1 0 0))" oboe.snd
</pre>
+
<p>reads ~/.snd, if any, then sets the (unselected) data color to red, then opens oboe.snd.</p>
-<pre>
- snd -eval '(begin (display (+ 1 2)) (<a class=quiet href="extsnd.html#exit" onmouseout="UnTip()" onmouseover="Tip(extsnd_exit_tip)">exit</a>))'
+
+<pre class="indented">
+snd -eval '(begin (display (+ 1 2)) (<a class=quiet href="extsnd.html#exit">exit</a>))'
</pre>
+
<p>prints "3" and exits. The "-title" argument works in both versions of Snd.
The following adds "WAV" to the sound file extension table before adding all the sound files in the directory to the
View:Files dialog's list:
</p>
-<pre>
- snd -e '(<a class=quiet href="extsnd.html#addsoundfileextension" onmouseout="UnTip()" onmouseover="Tip(extsnd_addsoundfileextension_tip)">add-sound-file-extension</a> "WAV")' -p /home/bil/sounds
+
+<pre class="indented">
+snd -e '(<a class=quiet href="extsnd.html#addsoundfileextension">add-sound-file-extension</a> "WAV")' -p /home/bil/sounds
</pre>
+<table class="bordered">
+<tr><td>
+<img src="pix/bgd.png" alt="black background">
-<table border=0 hspace=20 vspace=10>
-<tr>
-<td><img src="pix/bgd.png" alt="black background"></td>
-<td width=20></td>
-<td>
<pre>
snd oboe.snd
-(set! (<a class=quiet href="extsnd.html#selecteddatacolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selecteddatacolor_tip)">selected-data-color</a>) (<a class=quiet href="extsnd.html#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 1 1 1))
-(set! (<a class=quiet href="extsnd.html#selectedgraphcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedgraphcolor_tip)">selected-graph-color</a>) (<a class=quiet href="extsnd.html#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 0 0))
-(set! (<a class=quiet href="extsnd.html#graphshorizontal" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphshorizontal_tip)">graphs-horizontal</a>) #f)
-(set! (<a class=quiet href="extsnd.html#transformgraphp" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformgraphp_tip)">transform-graph?</a>) #t)
-(set! (<a class=quiet href="extsnd.html#showtransformpeaks" onmouseout="UnTip()" onmouseover="Tip(extsnd_showtransformpeaks_tip)">show-transform-peaks</a>) #t)
+(set! *selected-data-color* (<a class=quiet href="extsnd.html#makecolor">make-color</a> 1 1 1))
+(set! *selected-graph-color* (<a class=quiet href="extsnd.html#makecolor">make-color</a> 0 0 0))
+(set! (<a class=quiet href="extsnd.html#graphshorizontal">graphs-horizontal</a>) #f)
+(set! (<a class=quiet href="extsnd.html#transformgraphp">transform-graph?</a>) #t)
+(set! (<a class=quiet href="extsnd.html#showtransformpeaks">show-transform-peaks</a>) #t)
</pre>
</td>
</tr>
</table>
-<br>
-<br>
<!-- INDEX sndinitfile:Initialization file -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndinitfile">The initialization file</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndinitfile">The initialization file</div>
+
<p>
When Snd starts, it looks for an initialization file, normally named "~/.snd".
This optional file is
@@ -220,12 +304,13 @@ extensions that you want loaded whenever Snd starts. Say we
want the Snd window to start out 800x500, want to predefine an envelope named
"env1", and want the file selection box to
show just sound files. We make ~/.snd and put in it:</p>
-<pre>
+
+<pre class="indented">
Scheme:
- (set! (<a class=quiet href="extsnd.html#windowwidth" onmouseout="UnTip()" onmouseover="Tip(extsnd_windowwidth_tip)">window-width</a>) 800)
- (set! (<a class=quiet href="extsnd.html#windowheight" onmouseout="UnTip()" onmouseover="Tip(extsnd_windowheight_tip)">window-height</a>) 500)
- (set! (<a class=quiet href="extsnd.html#justsounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_justsounds_tip)">just-sounds</a>) #t)
- (<a class=quiet href="extsnd.html#defineenvelope" onmouseout="UnTip()" onmouseover="Tip(extsnd_defineenvelope_tip)">define-envelope</a> env1 '(0 0 1 1 2 0))
+ (set! (<a class=quiet href="extsnd.html#windowwidth">window-width</a>) 800)
+ (set! (<a class=quiet href="extsnd.html#windowheight">window-height</a>) 500)
+ (set! *just-sounds* #t)
+ (<a class=quiet href="extsnd.html#defineenvelope">define-envelope</a> env1 '(0 0 1 1 2 0))
Ruby:
set_window_width(800)
@@ -240,6 +325,7 @@ Forth:
$" env1" '( 0.0 0.0 1.0 1.0 2.0 0.0 ) 1.0 define-envelope drop
</pre>
+
<p>
In more
complex situations, you may want an initialization file particular to a given extension language, machine, or
@@ -249,6 +335,7 @@ is read before your local file; both can, of course, be
absent. To override reading the global init file when Snd is invoked, include the switch -noglob.
To override the local init file, use -noinit.
</p>
+
<p>
The initialization files particular to a given extension language have names such as ~/.snd_s7
and ~/.snd_prefs_ruby. Currently the possibilities are:
@@ -261,61 +348,66 @@ The save-options (preferences dialog) process writes to
then .snd. If you're always using just one version of Snd, it's simplest to stick with
.snd. The actual load sequence is:
</p>
-<pre>
- /etc/snd_ruby|forth|s7.conf (these two canceled by -noglob)
- /etc/snd.conf
- ~/.snd_prefs_ruby|forth|s7 (the rest canceled by -noinit)
- ~/.snd_ruby|forth|s7
- ~/.snd (also SND_INIT_FILE_ENVRIONMENT_NAME)
+
+<pre class="indented">
+/etc/snd_ruby|forth|s7.conf (these two canceled by -noglob)
+/etc/snd.conf
+~/.snd_prefs_ruby|forth|s7 (the rest canceled by -noinit)
+~/.snd_ruby|forth|s7
+~/.snd (also SND_INIT_FILE_ENVRIONMENT_NAME)
</pre>
+
<p>
Here's a more elaborate initialization file (~/.snd_s7):
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(set! (<a class=quiet href="extsnd.html#windowwidth" onmouseout="UnTip()" onmouseover="Tip(extsnd_windowwidth_tip)">window-width</a>) 800) ;these set the initial window size
-(set! (<a class=quiet href="extsnd.html#windowheight" onmouseout="UnTip()" onmouseover="Tip(extsnd_windowheight_tip)">window-height</a>) 500)
+<pre class="file">
+(set! (<a class=quiet href="extsnd.html#windowwidth">window-width</a>) 800) ;these set the initial window size
+(set! (<a class=quiet href="extsnd.html#windowheight">window-height</a>) 500)
(if (provided? '<a class=quiet href="#sndmotiffeature">snd-motif</a>) ;Motif and Gtk use different font naming conventions
(begin
- (set! (<a class=quiet href="extsnd.html#listenerfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_listenerfont_tip)">listener-font</a>) "9x15")
- (set! (<a class=quiet href="extsnd.html#axislabelfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_axislabelfont_tip)">axis-label-font</a>) "-*-times-medium-r-normal-*-18-*-*-*-*-*-*-*")
- (set! (<a class=quiet href="extsnd.html#axisnumbersfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_axisnumbersfont_tip)">axis-numbers-font</a>) "9x15"))
+ (set! *listener-font* "9x15")
+ (set! *axis-label-font* "-*-times-medium-r-normal-*-18-*-*-*-*-*-*-*")
+ (set! *axis-numbers-font* "9x15"))
(begin
- (set! (<a class=quiet href="extsnd.html#listenerfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_listenerfont_tip)">listener-font</a>) "Sans 10")
- (set! (<a class=quiet href="extsnd.html#axislabelfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_axislabelfont_tip)">axis-label-font</a>) "Times Medium 14")
- (set! (<a class=quiet href="extsnd.html#axisnumbersfont" onmouseout="UnTip()" onmouseover="Tip(extsnd_axisnumbersfont_tip)">axis-numbers-font</a>) "Sans 10")))
+ (set! *listener-font* "Sans 10")
+ (set! *axis-label-font* "Times Medium 14")
+ (set! *axis-numbers-font* "Sans 10")))
-(set! (<a class=quiet href="extsnd.html#listenerprompt" onmouseout="UnTip()" onmouseover="Tip(extsnd_listenerprompt_tip)">listener-prompt</a>) ":") ;change listener prompt from the default ">" to ":"
-(set! (<a class=quiet href="extsnd.html#showlistener" onmouseout="UnTip()" onmouseover="Tip(extsnd_showlistener_tip)">show-listener</a>) #t) ;include the listener window initially
+(set! *listener-prompt* ":") ;change listener prompt from the default ">" to ":"
+(set! (<a class=quiet href="extsnd.html#showlistener">show-listener</a>) #t) ;include the listener window initially
-(define beige (<a class=quiet href="extsnd.html#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0.96 0.96 0.86))
-(define blue (<a class=quiet href="extsnd.html#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 0 1))
-(set! (<a class=quiet href="extsnd.html#selectedgraphcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedgraphcolor_tip)">selected-graph-color</a>) beige) ;selected graph background is beige
-(set! (<a class=quiet href="extsnd.html#selecteddatacolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selecteddatacolor_tip)">selected-data-color</a>) blue) ;selected graph data is blue
+(define beige (<a class=quiet href="extsnd.html#makecolor">make-color</a> 0.96 0.96 0.86))
+(define blue (<a class=quiet href="extsnd.html#makecolor">make-color</a> 0 0 1))
+(set! *selected-graph-color* beige) ;selected graph background is beige
+(set! *selected-data-color* blue) ;selected graph data is blue
-(set! (<a class=quiet href="extsnd.html#savedir" onmouseout="UnTip()" onmouseover="Tip(extsnd_savedir_tip)">save-dir</a>) "/zap/snd") ;save-state files are placed in /zap/snd
-(set! (<a class=quiet href="extsnd.html#tempdir" onmouseout="UnTip()" onmouseover="Tip(extsnd_tempdir_tip)">temp-dir</a>) "/zap/tmp") ;temp files are placed in /zap/tmp
-(set! (peak-env-dir) "~/peaks")
+(set! *save-dir* "/zap/snd") ;save-state files are placed in /zap/snd
+(set! *temp-dir* "/zap/tmp") ;temp files are placed in /zap/tmp
+(set! *peak-env-dir* "~/peaks")
(load "hooks.scm")
(load "extensions.scm")
-(set! (with-inset-graph) #t) ;display an overview of the current window in the upper right
-(set! (with-pointer-focus) #t) ;automatically focus on (activate) the widget under the mouse
+(set! *with-inset-graph* #t) ;display an overview of the current window in the upper right
+(set! *with-pointer-focus* #t) ;automatically focus on (activate) the widget under the mouse
-(hook-push <a class=quiet href="extsnd.html#afteropenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afteropenhook_tip)">after-open-hook</a> ;if sound has many chans, use just one pane for all
- (lambda (snd)
- (if (> (<a class=quiet href="extsnd.html#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a> snd) 4)
- (set! (<a class=quiet href="extsnd.html#channelstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelstyle_tip)">channel-style</a> snd) <a class=quiet href="extsnd.html#channelstyle" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelstyle_tip)">channels-combined</a>))))
+(hook-push <a class=quiet href="extsnd.html#afteropenhook">after-open-hook</a> ;if sound has many chans, use just one pane for all
+ (lambda (hook)
+ (let ((snd (hook 'snd)))
+ (if (> (<a class=quiet href="extsnd.html#chans">channels</a> snd) 4)
+ (set! (<a class=quiet href="extsnd.html#channelstyle">channel-style</a> snd) <a class=quiet href="extsnd.html#channelstyle">channels-combined</a>)))))
+
+(set! *selection-creates-region* #f) ;turn off automatic region creation
+</pre>
-(set! (<a class=quiet href="extsnd.html#selectioncreatesregion" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectioncreatesregion_tip)">selection-creates-region</a>) #f) ;turn off automatic region creation
-</pre></td></tr></table>
<p>A similar Ruby initialization file (~/.snd_ruby):
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+
+<pre class="file">
require "draw"
set_window_width 800
@@ -325,7 +417,6 @@ set_listener_font "9x15"
set_axis_numbers_font "9x15"
set_show_mix_waveforms true
-set_trap_segfault false
set_listener_prompt ":"
set_show_listener true
@@ -340,14 +431,14 @@ $mouse_enter_graph_hook.add_hook!("focus") do |snd, chn|
end
$mouse_enter_listener_hook.add_hook!("focus") do |widget| focus_widget(widget) end
$mouse_enter_text_hook.add_hook!("focus") do |widget| focus_widget(widget) end
-</pre></td></tr></table>
+</pre>
+
<p>And Forth (~/.snd_forth):
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td>
-<pre>
-\ .snd_forth -- start up file for Snd/Forth -*- snd-forth -*-
+<pre class="file">
+\ .snd_forth — start up file for Snd/Forth -*- snd-forth -*-
\ You can install the *.fs scripts with:
\
@@ -475,7 +566,6 @@ lambda: <{ ins beg dur -- }> $" %14s: %5.2f %5.2f" '( ins beg dur ) clm-me
*snd-home* "/sound" $+ set-open-file-dialog-directory drop
"/usr/gnu/cvs/snd" set-html-dir drop
"BROWSER" getenv "firefox" || set-html-program drop
-#t set-trap-segfault drop
#t set-show-listener drop
0.0 set-auto-update-interval drop
"rev" add-sound-file-extension drop
@@ -495,8 +585,6 @@ output-comment-hook lambda: <{ str -- s }>
'snd-nogui provided? [unless]
'snd-motif provided? [if]
- \ if not configured --with-static-xm
- 'xm provided? not [if] dl-load libxm Init_libxm [then]
require snd-xm
add-mark-pane
#t with-smpte-label
@@ -509,8 +597,6 @@ output-comment-hook lambda: <{ str -- s }>
[then]
'snd-gtk provided? [if]
- \ if not configured --with-static-xg
- 'xg provided? not [if] dl-load libxg Init_libxg [then]
$" Serif 10" set-axis-label-font drop
[then]
@@ -546,14 +632,14 @@ output-comment-hook lambda: <{ str -- s }>
require dsp
graph-hook lambda: <{ snd chn y0 y1 -- #f }>
$" freq: %.3f" #( snd chn left-sample snd chn spot-freq ) string-format
- snd #f report-in-minibuffer drop
+ snd status-report drop
#f
; add-hook!
mouse-click-hook lambda: <{ snd chn button state x y axis -- a }>
axis time-graph = if
$" freq: %.3f" #( snd chn #f cursor snd chn spot-freq ) string-format
- snd #f report-in-minibuffer
+ snd status-report
else
#f
then
@@ -577,7 +663,7 @@ output-comment-hook lambda: <{ str -- s }>
blue set-selected-data-color drop
#t set-show-indices drop
- #f set-verbose-cursor drop
+ #f set-with-verbose-cursor drop
#t set-with-inset-graph drop
#t set-with-pointer-focus drop
#t set-just-sounds drop
@@ -668,7 +754,7 @@ output-comment-hook lambda: <{ str -- s }>
undef selection? if
$" selection-eval:" <'> eval-over-selection #f #f prompt-in-minibuffer
else
- $" no selection" #f #f report-in-minibuffer
+ $" no selection" #f status-report
then drop
cursor-in-view
; #t $" eval over selection" "eval-over-selection" bind-key drop
@@ -687,15 +773,17 @@ $" Snd of %s (Fth %s)" #( snd-version fth-version ) clm-message
\ .snd_forth ends here
</pre>
-</td></tr></table>
+
<p>
If you loaded Snd with GSL, and have set the GSL_IEEE_MODE environment variable,
it will override Snd's default arithmetic mode settings. GSL recommends the setting:
</p>
-<pre>
- GSL_IEEE_MODE=double-precision,mask-underflow,mask-denormalized
+
+<pre class="indented">
+GSL_IEEE_MODE=double-precision,mask-underflow,mask-denormalized
</pre>
+
<p>For more complex initialization files, see snd_conffile.scm, snd_frg.scm, and edit123.scm.
</p>
@@ -705,163 +793,132 @@ For more temporary situations, you can use the environment variable SND_PATH.
It is a colon-separated list of directories that will be added to the load path when Snd starts.
</p>
-<br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndconfigurationswitches">Configuration choices</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndconfigurationswitches">Configuration choices</div>
+
<p>The configuration process is controlled by a set of switches, some specific to Snd. The
latter are (configure --help):
</p>
-<table cellspacing=0 cellpadding=0>
-<tr><td colspan=2></td><td width=20></td><td></td></tr>
-<tr><td colspan=2 bgcolor="#EEFDEE">Audio choices</td><td></td><td>(normally this is decided automatically)</td></tr>
-<tr><td width=50></td><td>--with-esd</td><td></td><td>use ESD (enlightened sound daemon)</td></tr>
-<tr><td></td><td>--with-alsa</td><td></td><td>use ALSA (the default in Linux)</td></tr>
-<tr><td></td><td>--with-oss</td><td></td><td>use OSS</td></tr>
-<tr><td></td><td>--with-static-alsa</td><td></td><td>use ALSA statically loaded</td></tr>
-<tr><td></td><td>--with-jack</td><td></td><td>use JACK (Linux audio stream sharing support, can be used with ALSA)</td></tr>
-<tr><td></td><td>--with-pulseaudio</td><td></td><td>use pulseaudio (may not work yet)</td></tr>
-<tr><td></td><td>--with-portaudio</td><td></td><td>use portaudio (may not work yet)</td></tr>
-<tr><td colspan=2></td><td></td><td></td></tr>
-
-<tr><td colspan=2 bgcolor="#EEFDEE">Graphics choices</td><td></td><td></td><td></td></tr>
-<tr><td></td><td>--with-gtk</td><td></td><td>use Gtk+ to build Snd (Gtk+ version 2.0 or later)</td></tr>
-<tr><td></td><td>--with-motif</td><td></td><td>use Motif (version 2.0 or later) to build Snd (the default), Lesstif is not supported</td></tr>
-<tr><td></td><td>--with-static-motif</td><td></td><td>use libXm.a to build Snd</td></tr>
-<tr><td></td><td>--with-motif-prefix=PFX</td><td></td><td>where Motif is installed (--with-motif-prefix=/usr/X11R6)</td></tr>
-<tr><td></td><td>--with-no-gui</td><td></td><td>make Snd without any graphics support</td></tr>
-<tr><td></td><td>--with-static-xm</td><td></td><td>include the xm module at build time; this is easier than trying to dynamically load xm.so</td></tr>
-<tr><td></td><td>--with-static-xg</td><td></td><td>include the xg module at build time; this is easier than trying to dynamically load xg.so</td></tr>
-<tr><td></td><td>--with-gl</td><td></td><td>include OpenGL support (spectrogram, etc, Motif only)</td></tr>
-<tr><td></td><td>--with-just-gl</td><td></td><td>include OpenGL support, but omit the GL/s7/Ruby/Forth bindings (Motif only)</td></tr>
-<tr><td></td><td>--with-gl2ps</td><td></td><td>include gl2ps (GL to Postscript code, Motif only)</td></tr>
-<tr><td></td><td>--with-editres</td><td></td><td>include editres in xm (default: no)</td></tr>
-<tr><td colspan=2></td><td></td><td></td></tr>
-
-<tr><td colspan=2 bgcolor="#EEFDEE">Language choices</td><td></td><td></td></tr>
-<tr><td></td><td>--with-forth</td><td></td><td>use Forth as the extension language</td></tr>
-<tr><td></td><td>--with-ruby</td><td></td><td>use Ruby as the extension language; version 1.6.4 or later</td></tr>
-<tr><td></td><td>--with-s7</td><td></td><td>use S7 as the extension language (default = yes)</td></tr>
-<tr><td></td><td>--with-ruby-prefix=PFX</td><td></td><td>where Ruby is installed</td></tr>
-<tr><td colspan=2></td><td></td><td></td></tr>
-
-<tr><td colspan=2 bgcolor="#EEFDEE">Numerical choices</td><td></td><td></td></tr>
-<tr><td></td><td>--with-doubles</td><td></td><td>use doubles throughout (default: yes)</td></tr>
-<tr><td></td><td>--with-float-samples</td><td></td><td>use floats or doubles as the internal sample representation (default: yes)</td></tr>
-<tr><td></td><td>--with-sample-width=N</td><td></td><td>if not float samples, use N bits for ints (default: 24, must be between 16 and 31)</td></tr>
-<tr><td colspan=2></td><td></td><td></td></tr>
-
-<tr><td colspan=2 bgcolor="#EEFDEE">Library choices</td><td></td><td></td></tr>
-<tr><td></td><td>--with-gsl</td><td></td><td>use GSL (for Chebyshev window), default: yes if local C does not support complex trig</td></tr>
-<tr><td></td><td>--with-fftw</td><td></td><td>use fftw, default: yes; fallback fft is built-in</td></tr>
-<tr><td></td><td>--with-gmp</td><td></td><td>use gmp, mpfr, and mpc to implement multiprecision arithmetic (default: no)</td></tr>
-<tr><td></td><td>--with-fam</td><td></td><td>use libfam (Gamin), default: yes; fallback is polling via <a href="extsnd.html#autoupdateinterval">auto-update-interval</a></td></tr>
-<tr><td></td><td>--with-ladspa</td><td></td><td>include support for LADSPA plugins (in Linux default: yes)</td></tr>
-<tr><td></td><td>--with-shared-sndlib</td><td></td><td>try to load libsndlib.so, rather than building it into Snd (default: no)</td></tr>
-<tr><td></td><td>--disable-deprecated</td><td></td><td>do not include any deprecated stuff from gtk, s7, sndlib, xen, clm, etc</td></tr>
-<tr><td></td><td>--enable-threads</td><td></td><td>include pthreads to take advantage of multiprocessor machines</td></tr>
-<tr><td></td><td>--with-threads</td><td></td><td>include pthreads, same as --enable-threads</td></tr>
-<tr><td colspan=2></td><td></td><td></td></tr>
-
-<tr><td colspan=2 bgcolor="#EEFDEE">Directory choices</td><td></td><td></td></tr>
-<tr><td></td><td>--with-temp-dir</td><td></td><td>directory to use for temp files (default: ".")</td></tr>
-<tr><td></td><td>--with-save-dir</td><td></td><td>directory to use for saved-state files (default: ".")</td></tr>
-<tr><td></td><td>--with-doc-dir</td><td></td><td>directory to search for documentation (html-dir, elaborate set of defaults)</td></tr>
-<tr><td colspan=2></td><td></td><td></td></tr>
-
-<tr><td colspan=2 bgcolor="#EEFDEE">Debugging etc</td><td></td><td></td></tr>
-<tr><td></td><td>--with-snd-as-widget</td><td></td><td>make Snd a loadable widget, not a standalone program</td></tr>
-<tr><td></td><td>--with-profiling</td><td></td><td>include profiling (branch counting) machinery, default: no (only for s7)</td></tr>
-<tr><td></td><td>--enable-snd-debug</td><td></td><td>include internal Snd debugging functions, default: no (not useful if not actually debugging!) </td></tr>
-<tr><td></td><td>--disable-largefile</td><td></td><td>omit support for large (64-bit byte address) files</td></tr>
-<tr><td colspan=2></td><td></td><td></td></tr>
-</table>
+<pre class="indented">
+Audio choices (normally this is decided automatically):
+ --with-alsa use ALSA (the default in Linux)
+ --with-oss use OSS
+ --with-jack use JACK (Linux audio stream sharing support, can be used with ALSA)
+ --with-pulseaudio use pulseaudio (may not work yet)
+ --with-portaudio use portaudio (may not work yet)
-<pre>
- ./configure
- make
- make install
+
+Graphics choices:
+ --with-gtk use Gtk+ to build Snd (Gtk+ version 2.0 or later)
+ --with-motif use Motif (version 2.0 or later) to build Snd (the default), Lesstif is not supported
+ --with-gui make Snd with graphics support (--without-gui is the intended use)
+ --with-gl include OpenGL support (spectrogram, etc, Motif only)
+ --with-gl2ps include gl2ps (GL to Postscript code, Motif only)
+ --with-editres include editres in xm (default: no)
+
+
+Language choices:
+ --with-forth use Forth as the extension language
+ --with-ruby use Ruby as the extension language; version 1.6.4 or later
+ --with-s7 use s7 as the extension language (default = yes)
+ --without-extension-language
+
+
+Library choices:
+ --with-gsl use GSL (for Chebyshev window), default: yes if local C does not support complex trig
+ --with-fftw use fftw, default: yes; fallback fft is built-in
+ --with-gmp use gmp, mpfr, and mpc to implement multiprecision arithmetic (default: no)
+ --with-ladspa include support for LADSPA plugins (in Linux default: yes)
+ --disable-deprecated do not include any deprecated stuff from gtk, s7, sndlib, xen, clm, etc
+
+
+Directory choices:
+ --with-temp-dir directory to use for temp files (default: ".")
+ --with-save-dir directory to use for saved-state files (default: ".")
+ --with-doc-dir directory to search for documentation (html-dir, elaborate set of defaults)
</pre>
+
+
+<div class="indented">
+<pre class="indented">
+./configure
+make
+make install
+</pre>
+
<p>tries to use s7, Motif, ALSA (if Linux), and a float sample representation, then
installs the snd executable in /usr/local/bin, with a brief blurb
in /usr/local/man/man1.
Here at CCRMA, we normally use:
</p>
-<pre>
- ./configure --with-alsa --with-temp-dir=/zap --with-static-xm --with-gl
+
+<pre class="indented">
+./configure --with-alsa --with-temp-dir=/zap
</pre>
+</div>
<p>
There are many more examples in tools/compsnd.
-Don't use the --enable-snd-debug switch unless you know what you are asking for!
Depending on how Snd is configured, any of the following symbols may be "provided"
(on the *features* list in Scheme):
</p>
-<table hspace=20 border=1>
-<tr><td>
-<table>
-<tr><td width=100>clm</td><td>clm module (always included — once upon a time it was optional)</td></tr>
-<tr><td bgcolor="#f2f4ff">gl</td><td bgcolor="#f2f4ff">OpenGL callable from Scheme/Ruby/Forth (--with-gl switch)</td></tr>
-<tr><td>snd-ladspa</td><td>LADSPA loaded (--with-ladspa, but also the default in Linux if ladspa.h can be found)</td></tr>
-<tr><td bgcolor="#f2f4ff">sndlib</td><td bgcolor="#f2f4ff">sndlib module (always included)</td></tr>
-<tr><td><A NAME="sndmotiffeature">snd-motif</a></td><td>Motif used as GUI toolkit (--with-motif, usually the default if Motif can be found)</td></tr>
-<tr><td bgcolor="#f2f4ff"><A NAME="sndgtkfeature">snd-gtk</a></td><td bgcolor="#f2f4ff">Gtk+ used as GUI toolkit (--with-gtk)</td></tr>
-<tr><td>snd-nogui</td><td>No GUI built-in (--with-no-gui, or neither Motif nor Gtk+ found)</td></tr>
-<tr><td>snd-ruby</td><td>Ruby as extension language (--with-ruby)</td></tr>
-<tr><td bgcolor="#f2f4ff">snd-forth</td><td bgcolor="#f2f4ff">Forth as extension language (--with-forth)</td></tr>
-<tr><td>snd-s7</td><td>S7 as extension language (--with-s7)</td></tr>
-<tr><td bgcolor="#f2f4ff">snd-debug</td><td bgcolor="#f2f4ff">internal debugging hooks included (--enable-snd-debug)</td></tr>
-<tr><td>snd</td><td>It's Snd, ferchrissake... (always included)</td></tr>
-<tr><td bgcolor="#f2f4ff">xg</td><td bgcolor="#f2f4ff">Gtk module (xg.c) included (--with-static-xg, or loaded dynamically)</td></tr>
-<tr><td bgcolor="#f2f4ff">xm</td><td bgcolor="#f2f4ff">Motif module (xm.c) included (--with-static-xm, or loaded dynamically)</td></tr>
-<tr><td>alsa</td><td>ALSA is in use, rather than OSS (--with-alsa)</td></tr>
-<tr><td bgcolor="#f2f4ff">gsl</td><td bgcolor="#f2f4ff">GSL is loaded (--with-gsl)</td></tr>
-<tr><td>gl2ps</td><td>gl2ps is included (--with-gl2ps)</td></tr>
-<tr><td>snd-threads</td><td>multithreading support is included (--enable-threads)</td></tr>
-</table>
-</td></tr>
-</table>
+
+
+<pre class="indented">
+clm clm module (always included — once upon a time it was optional)
+gl OpenGL callable from Scheme/Ruby/Forth (--with-gl switch)
+snd-ladspa LADSPA loaded (--with-ladspa)
+sndlib sndlib module (always included)
+<em class="noem" id="sndmotiffeature">snd-motif</em> Motif used as GUI toolkit (--with-motif)
+snd-gtk Gtk+ used as GUI toolkit (--with-gtk, now the default)
+snd-nogui No GUI built-in (--without-gui)
+snd-forth Forth as extension language (--with-forth)
+snd-ruby Ruby as extension language (--with-ruby)
+snd-s7 s7 as extension language (--with-s7)
+snd It's Snd, ferchrissake... (always included)
+gsl GSL is loaded (--with-gsl)
+alsa ALSA is in use, rather than OSS (--with-alsa)
+</pre>
<p>To check whether something is available in the current Snd, use:
</p>
-<pre>
- Scheme: (provided? 'snd-gtk)
- Ruby: provided? :snd-gtk
- Forth: "snd-gtk" defined?
+
+<pre class="indented">
+Scheme: (provided? 'snd-gtk)
+Ruby: provided? :snd-gtk
+Forth: "snd-gtk" defined?
</pre>
-<p>Multithreading support is problematic in both Motif and Gtk. See <a href="s7.html#s7inathread">s7 and threads</a> for
-a brief discussion. If you use s7 threads, make sure you never call anything that might affect the user interface.
-</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndenvvars">Environment variables</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndenvvars">Environment variables</div>
<p>There are several environment variables specific to Snd:
</p>
-<table hspace=20>
-<tr><td width=300>SND_PATH</td><td>Snd source load path list (a colon separated directory list)</td></tr>
-<tr><td bgcolor="#f2f4ff">SND_INIT_FILE_ENVIRONMENT_NAME</td><td bgcolor="#f2f4ff">init file name</td></tr>
-<tr><td>LADSPA_PATH</td><td>Ladspa modules directory</td></tr>
-<tr><td bgcolor="#f2f4ff">MUS_ALSA_PLAYBACK_DEVICE</td><td bgcolor="#f2f4ff">name of playback device (Alsa only)</td></tr>
-<tr><td>MUS_ALSA_CAPTURE_DEVICE</td><td>name of capture device (Alsa only)</td></tr>
-<tr><td bgcolor="#f2f4ff">MUS_ALSA_DEVICE</td><td bgcolor="#f2f4ff">name of the playback and capture device (Alsa only)</td></tr>
-<tr><td>MUS_ALSA_BUFFERS</td><td>number of "periods" used (Alsa only)</td></tr>
-<tr><td bgcolor="#f2f4ff">MUS_ALSA_BUFFER_SIZE</td><td bgcolor="#f2f4ff">number of samples per channel per buffer (Alsa only)</td></tr>
-<tr><td>AUDIODEV</td><td>audio device name (Sun and related drivers)</td></tr>
-</table>
-<br>
+<pre class="indented">
+SND_PATH Snd source load path list (a colon separated directory list)
+SND_INIT_FILE_ENVIRONMENT_NAME init file name
+LADSPA_PATH Ladspa modules directory
+MUS_ALSA_PLAYBACK_DEVICE name of playback device (Alsa only)
+MUS_ALSA_CAPTURE_DEVICE name of capture device (Alsa only)
+MUS_ALSA_DEVICE name of the playback and capture device (Alsa only)
+MUS_ALSA_BUFFERS number of "periods" used (Alsa only)
+MUS_ALSA_BUFFER_SIZE number of samples per channel per buffer (Alsa only)
+AUDIODEV audio device name (Sun and related drivers)
+</pre>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="snddynamic">Runtime modules and external programs</a></h2></td></tr></table>
-</td></tr></table>
-<br>
+
+
+<div class="header" id="snddynamic">Runtime modules and external programs</div>
<!-- INDEX emacssnd:Emacs and Snd -->
-<table width="100%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="emacssnd">Snd as an Emacs subjob</a></h3></td></tr></table>
+
+<div class="innerheader" id="emacssnd">Snd as an Emacs subjob</div>
<p>Snd watches stdin; any input received
is evaluated as if typed in Snd's listener; any subsequent output
@@ -870,47 +927,34 @@ Snd in this manner, but the real reason for this is to make it possible to run
The simplest way to enable that is to use <a href="sndscm.html#dotemacs">inf-snd.el</a> by Michael
Scholz. It starts with a long and detailed commentary.
</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="dynamic">Dynamically loaded modules</a></h3></td></tr></table>
-<p>You can import shared object files into Snd at any time.
-</p>
-<pre>
- (define lib (<em class=red>dynamic-link</em> "/home/bil/cl/cscm.so"))
- (<em class=red>dynamic-call</em> "init_hiho" lib)
-</pre>
+<div class="innerheader" id="dynamic">Dynamically loaded modules</div>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndaswidget">Snd as a Widget</a></h3></td></tr></table>
-
-<p>To include the entire Snd editor as a widget in some other program,
-first compile it with -DSND_AS_WIDGET. Then load it into your program,
-using the procedure <b>snd_as_widget</b> to fire it up. See
-saw.c included with Snd.
+<p>You can load shared object files into Snd at any time. In s7, load knows how to handle ".so" files:
</p>
-<pre>
- void snd_as_widget(int argc, char **argv, XtAppContext app, Widget parent, Arg *caller_args, int caller_argn)
+<pre class="indented">
+(<em class=red>load</em> "/home/bil/cl/cscm.so")
</pre>
-<p>starts up the Snd editor in the widget 'parent', passing the outer Snd
-form widget the arguments 'caller_args' and 'caller_argn'. The
-enclosing application context is 'app'. 'parent' needs to
-be realized at the time of the call, since Snd uses it to set up graphics
-contexts and so on. 'argc' and 'argv' can be passed to
-simulate a shell invocation of Snd. Remember that in this case, the
-first string argument is expected to be the application name, and is
-ignored by Snd.
-In Gtk, the arguments are different, but the basic idea is the same:
+<p>load assumes the library has a function that ties the library functions into s7 (via s7_define_function
+and so on). This function is named "init_func" in the load's current environment, so if our library
+calls it init_ex, we add it to the loader's environment as follows:
</p>
-<pre>
- GtkWidget *snd_as_widget(int argc, char **argv, GtkWidget *parent, void (*error_func)(const char *msg))
+
+<pre class=indented>
+(load so-file-name
+ (sublet (curlet)
+ (cons 'init_func 'init_ex)))
</pre>
+<p>See cload.scm for a much more friendly approach.
+</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndwithclm">Snd and CLM</a></h3></td></tr></table>
+
+
+<div class="innerheader" id="sndwithclm">Snd and CLM</div>
<p>The files clm.c, clm.h, and clm2xen.c implement <a href="sndclm.html#sndclmtop">CLM</a> (a Music V implementation),
always included in Snd.
@@ -919,40 +963,43 @@ listener, and using the graph and spectrum functions. Say we have
these declarations in ~/.snd:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define data-size 1024)
-(define data (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> data-size))
+(define data (make-float-vector data-size 0.0))
(define (run-gen func) ; func is a function of no arguments (a "thunk")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i data-size))
- (set! (data i) (func))) ; fill data vct with output of 'func'
- (<a class=quiet href="extsnd.html#graph" onmouseout="UnTip()" onmouseover="Tip(extsnd_graph_tip)">graph</a> data)) ; display data as a graph
+ (set! (data i) (func))) ; fill data float-vector with output of 'func'
+ (<a class=quiet href="extsnd.html#graph">graph</a> data)) ; display data as a graph
(define (run-fft func)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i data-size))
(set! (data i) (func)))
- (<a class=quiet href="extsnd.html#graph" onmouseout="UnTip()" onmouseover="Tip(extsnd_graph_tip)">graph</a> (<a class=quiet href="extsnd.html#sndspectrum" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndspectrum_tip)">snd-spectrum</a> data blackman2-window data-size #t)))
-</pre></td></tr></table>
+ (<a class=quiet href="extsnd.html#graph">graph</a> (<a class=quiet href="extsnd.html#sndspectrum">snd-spectrum</a> data blackman2-window data-size #t)))
+</pre>
+
<p>Now we can open the listener, and type:</p>
-<pre>
- (define hi (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a>))
- (run-gen (lambda () (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> hi)))
- (define ho (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a>))
- (run-fft (lambda () (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> hi (* .5 (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> ho)))))
+
+<pre class="indented">
+(define hi (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a>))
+(run-gen (lambda () (<a class=quiet href="sndclm.html#oscil">oscil</a> hi)))
+(define ho (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a>))
+(run-fft (lambda () (<a class=quiet href="sndclm.html#oscil">oscil</a> hi (* .5 (<a class=quiet href="sndclm.html#oscil">oscil</a> ho)))))
</pre>
+
<p>Any CLM instrument or function can be used in this way
to edit sounds. Say we want an echo effect:</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define echo
(lambda (scaler secs)
- (let ((del (<a class=quiet href="sndclm.html#make-delay" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_delay_tip)">make-delay</a> (round (* secs (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))))))
+ (let ((del (<a class=quiet href="sndclm.html#make-delay">make-delay</a> (round (* secs (<a class=quiet href="extsnd.html#srate">srate</a>))))))
(lambda (inval)
- (+ inval (<a class=quiet href="sndclm.html#delay" onmouseout="UnTip()" onmouseover="Tip(sndclm_delay_tip)">delay</a> del (* scaler (+ (<a class=quiet href="sndclm.html#tap" onmouseout="UnTip()" onmouseover="Tip(sndclm_tap_tip)">tap</a> del) inval))))))))
-</pre></td></tr></table>
+ (+ inval (<a class=quiet href="sndclm.html#delay">delay</a> del (* scaler (+ (<a class=quiet href="sndclm.html#tap">tap</a> del) inval))))))))
+</pre>
<p>
Here 'scaler' sets
@@ -966,10 +1013,12 @@ the returned function (the second lambda) takes
one argument ('inval') and returns the result of passing
that value to the delay with scaling. The upshot of all this is that
we can use:</p>
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (echo .5 .75) 0 44100)
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (echo .5 .75) 0 44100)
</pre>
+
<p>to take the current active channel and
return 44100 samples of echos, each echo half the amplitude
of the previous, and spaced by .75 seconds. map-channel's
@@ -978,66 +1027,71 @@ when we pass it <code>(echo ...)</code>, it evaluates the echo call,
which returns the function that actually runs the delay line,
producing the echo.
</p>
+
<p>If we want "pre-echoes" instead (echoes of the future):
</p>
-<pre>
- (<a class=quiet href="extsnd.html#reversesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_reversesound_tip)">reverse-sound</a>)
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (echo .5 .75) 0 44100)
- (<a class=quiet href="extsnd.html#reversesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_reversesound_tip)">reverse-sound</a>)
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#reversesound">reverse-sound</a>)
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (echo .5 .75) 0 44100)
+(<a class=quiet href="extsnd.html#reversesound">reverse-sound</a>)
</pre>
<p>Generators are "applicable" in most versions of Snd: the generator knows its type, so the
explicit "oscil" function (for example) isn't needed.
</p>
-<pre>
- ><em class=typing>(define hi (make-oscil 440.0))</em>
- <em class=listener>#<unspecified></em>
- ><em class=typing>(hi)</em>
- <em class=listener>0.0</em>
- ><em class=typing>(oscil hi)</em>
- <em class=listener>0.125050634145737</em>
+
+<pre class="indented">
+> (define hi (make-oscil 440.0))
+#<unspecified>
+> (hi)
+0.0
+> (oscil hi)
+0.125050634145737
</pre>
<p>
We can make a generator that is either
an oscil or a sawtooth-wave:
</p>
-<pre>
- ><em class=typing>(define sine-or-sawtooth
- (lambda (sine)
- (let ((gen ((if sine make-oscil make-sawtooth-wave) 440.0)))
- (lambda (fm)
- (gen fm)))))</em>
- <em class=listener>#<unspecified></em>
- ><em class=typing>(define osc (sine-or-sawtooth #t))</em>
- <em class=listener>#<unspecified></em>
- ><em class=typing>(osc 0.0)</em>
- <em class=listener>0.0</em>
- ><em class=typing>(osc 0.0)</em>
- <em class=listener>0.125050634145737</em>
+
+<pre class="indented">
+> (define sine-or-sawtooth
+ (lambda (sine)
+ (let ((gen ((if sine make-oscil make-sawtooth-wave) 440.0)))
+ (lambda (fm)
+ (gen fm)))))
+#<unspecified>
+> (define osc (sine-or-sawtooth #t))
+#<unspecified>
+> (osc 0.0)
+0.0
+> (osc 0.0)
+0.125050634145737
</pre>
<p>Here are a few more examples, taken from <a href="sndscm.html#exampdoc">examp.scm</a>.
</p>
-<pre>
+
+<pre class="indented">
(define comb-filter
(lambda (scaler size)
- (let ((cmb (<a class=quiet href="sndclm.html#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler size)))
- (lambda (x) (<a class=quiet href="sndclm.html#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> cmb x)))))
+ (let ((cmb (<a class=quiet href="sndclm.html#make-comb">make-comb</a> scaler size)))
+ (lambda (x) (<a class=quiet href="sndclm.html#comb">comb</a> cmb x)))))
-; (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (comb-filter .8 32))
+; (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (comb-filter .8 32))
;;; by using filters at harmonically related sizes, we can get chords:
(define comb-chord
(lambda (scaler size amp)
- (let ((c1 (<a class=quiet href="sndclm.html#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler size))
- (c2 (<a class=quiet href="sndclm.html#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler (* size .75)))
- (c3 (<a class=quiet href="sndclm.html#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler (* size 1.2))))
+ (let ((c1 (<a class=quiet href="sndclm.html#make-comb">make-comb</a> scaler size))
+ (c2 (<a class=quiet href="sndclm.html#make-comb">make-comb</a> scaler (* size .75)))
+ (c3 (<a class=quiet href="sndclm.html#make-comb">make-comb</a> scaler (* size 1.2))))
(lambda (x)
- (* amp (+ (<a class=quiet href="sndclm.html#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c1 x) (<a class=quiet href="sndclm.html#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c2 x) (<a class=quiet href="sndclm.html#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c3 x)))))))
+ (* amp (+ (<a class=quiet href="sndclm.html#comb">comb</a> c1 x) (<a class=quiet href="sndclm.html#comb">comb</a> c2 x) (<a class=quiet href="sndclm.html#comb">comb</a> c3 x)))))))
-; (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (comb-chord .95 60 .3))
+; (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (comb-chord .95 60 .3))
;;; or change the comb length via an envelope:
@@ -1045,63 +1099,42 @@ an oscil or a sawtooth-wave:
(lambda (e mx)
(if (null? e)
mx
- (<a class=quiet href="sndscm.html#maxenvelope" onmouseout="UnTip()" onmouseover="Tip(sndscm_maxenvelope_tip)">max-envelope</a> (cddr e) (max mx (abs (cadr e)))))))
+ (<a class=quiet href="sndscm.html#maxenvelope">max-envelope</a> (cddr e) (max mx (abs (cadr e)))))))
(define zcomb
(lambda (scaler size pm)
- (let ((cmb (<a class=quiet href="sndclm.html#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler size :max-size (+ size 1 (<a class=quiet href="sndscm.html#maxenvelope" onmouseout="UnTip()" onmouseover="Tip(sndscm_maxenvelope_tip)">max-envelope</a> pm 0))))
- (penv (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> pm :length (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))))
- (lambda (x) (<a class=quiet href="sndclm.html#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> cmb x (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> penv))))))
+ (let ((cmb (<a class=quiet href="sndclm.html#make-comb">make-comb</a> scaler size :max-size (+ size 1 (<a class=quiet href="sndscm.html#maxenvelope">max-envelope</a> pm 0))))
+ (penv (<a class=quiet href="sndclm.html#make-env">make-env</a> pm :length (<a class=quiet href="extsnd.html#framples">framples</a>))))
+ (lambda (x) (<a class=quiet href="sndclm.html#comb">comb</a> cmb x (<a class=quiet href="sndclm.html#env">env</a> penv))))))
-; (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (zcomb .8 32 '(0 0 1 10)))
+; (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (zcomb .8 32 '(0 0 1 10)))
;;; to impose several formants, just add them in parallel:
(define formants
(lambda (r1 f1 r2 f2 r3 f3)
- (let ((fr1 (<a class=quiet href="sndclm.html#make-formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_formant_tip)">make-formant</a> f1 r1))
- (fr2 (<a class=quiet href="sndclm.html#make-formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_formant_tip)">make-formant</a> f2 r2))
- (fr3 (<a class=quiet href="sndclm.html#make-formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_formant_tip)">make-formant</a> f3 r3)))
+ (let ((fr1 (<a class=quiet href="sndclm.html#make-formant">make-formant</a> f1 r1))
+ (fr2 (<a class=quiet href="sndclm.html#make-formant">make-formant</a> f2 r2))
+ (fr3 (<a class=quiet href="sndclm.html#make-formant">make-formant</a> f3 r3)))
(lambda (x)
- (+ (<a class=quiet href="sndclm.html#formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_formant_tip)">formant</a> fr1 x)
- (<a class=quiet href="sndclm.html#formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_formant_tip)">formant</a> fr2 x)
- (<a class=quiet href="sndclm.html#formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_formant_tip)">formant</a> fr3 x))))))
+ (+ (<a class=quiet href="sndclm.html#formant">formant</a> fr1 x)
+ (<a class=quiet href="sndclm.html#formant">formant</a> fr2 x)
+ (<a class=quiet href="sndclm.html#formant">formant</a> fr3 x))))))
-; (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (formants .01 900 .02 1800 .01 2700))
+; (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (formants .01 900 .02 1800 .01 2700))
;;; to get a moving formant:
(define moving-formant
(lambda (radius move)
- (let ((frm (<a class=quiet href="sndclm.html#make-formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_formant_tip)">make-formant</a> (cadr move) radius))
- (menv (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> move :length (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))))
+ (let ((frm (<a class=quiet href="sndclm.html#make-formant">make-formant</a> (cadr move) radius))
+ (menv (<a class=quiet href="sndclm.html#make-env">make-env</a> move :length (<a class=quiet href="extsnd.html#framples">framples</a>))))
(lambda (x)
- (let ((val (<a class=quiet href="sndclm.html#formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_formant_tip)">formant</a> frm x)))
- (set! (<a class=quiet href="sndclm.html#mus-frequency" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_frequency_tip)">mus-frequency</a> frm) (<a class=quiet href="sndclm.html#env" onmouseout="UnTip" onmouseover="Tip(sndclm_env_tip)">env</a> menv))
+ (let ((val (<a class=quiet href="sndclm.html#formant">formant</a> frm x)))
+ (set! (<a class=quiet href="sndclm.html#mus-frequency">mus-frequency</a> frm) (<a class=quiet href="sndclm.html#env">env</a> menv))
val)))))
-; (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (moving-formant .01 '(0 1200 1 2400)))
-
-;;; various "Forbidden Planet" sound effects:
-
-(define fp
- (lambda (sr osamp osfrq)
- (let* ((os (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> osfrq))
- (sr (<a class=quiet href="sndclm.html#make-src" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_src_tip)">make-src</a> :srate sr))
- (len (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (sf (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a>))
- (out-data (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> len)))
- (<a class=quiet href="extsnd.html#vctmap" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctmap_tip)">vct-map!</a> out-data
- (lambda ()
- (<a class=quiet href="sndclm.html#src" onmouseout="UnTip()" onmouseover="Tip(sndclm_src_tip)">src</a> sr (* osamp (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os))
- (lambda (dir)
- (if (> dir 0)
- (<a class=quiet href="extsnd.html#nextsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_nextsample_tip)">next-sample</a> sf)
- (<a class=quiet href="extsnd.html#previoussample" onmouseout="UnTip()" onmouseover="Tip(extsnd_previoussample_tip)">previous-sample</a> sf))))))
- (<a class=quiet href="extsnd.html#freesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_freesampler_tip)">free-sampler</a> sf)
- (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> out-data 0 len))))
-
-; (fp 1.0 .3 20)
+; (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (moving-formant .01 '(0 1200 1 2400)))
;;; -------- shift pitch keeping duration constant
@@ -1109,18 +1142,18 @@ an oscil or a sawtooth-wave:
;;; both src and granulate take a function argument to get input whenever it is needed.
;;; in this case, src calls granulate which reads the currently selected file.
-(define <A class=def NAME="expsrc">expsrc</a>
+(define <em class=emdef id="expsrc">expsrc</em>
(lambda (rate)
- (let* ((gr (<a class=quiet href="sndclm.html#make-granulate" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_granulate_tip)">make-granulate</a> :expansion rate))
- (sr (<a class=quiet href="sndclm.html#make-src" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_src_tip)">make-src</a> :srate rate))
+ (let* ((gr (<a class=quiet href="sndclm.html#make-granulate">make-granulate</a> :expansion rate))
+ (sr (<a class=quiet href="sndclm.html#make-src">make-src</a> :srate rate))
(vsize 1024)
(vbeg 0)
- (v (<a class=quiet href="extsnd.html#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> 0 vsize))
+ (v (channel->float-vector 0 vsize))
(inctr 0))
(lambda (inval)
- (<a class=quiet href="sndclm.html#src" onmouseout="UnTip()" onmouseover="Tip(sndclm_src_tip)">src</a> sr 0.0
+ (<a class=quiet href="sndclm.html#src">src</a> sr 0.0
(lambda (dir)
- (<a class=quiet href="sndclm.html#granulate" onmouseout="UnTip()" onmouseover="Tip(sndclm_granulate_tip)">granulate</a> gr
+ (<a class=quiet href="sndclm.html#granulate">granulate</a> gr
(lambda (dir)
(let ((val (v inctr)))
(set! inctr (+ inctr dir))
@@ -1128,155 +1161,153 @@ an oscil or a sawtooth-wave:
(begin
(set! vbeg (+ vbeg inctr))
(set! inctr 0)
- (<a class=quiet href="extsnd.html#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> vbeg vsize 0 0 v)))
+ (channel->float-vector vbeg vsize 0 0 v)))
val)))))))))
</pre>
+
<p>Geez, I haven't had this much fun in a long time! Check out <a href="sndscm.html#exampdoc">examp.scm</a> and <a href="sndscm.html#sndtestdoc">snd-test.scm</a> for more.
You can load Rick Taube's CM into Snd as Scheme code:
</p>
-<pre>
- snd -l /home/bil/test/cm-2.8.0/src/cm.scm
+
+<pre class="indented">
+snd -l /home/bil/test/cm-2.8.0/src/cm.scm
</pre>
+
<p>and all of CM is at your disposal! See also <a href="#sndwithcm">Snd and Common Music</a>.
</p>
<p>In most CLM instruments, including all those in clm-ins.scm, the assumption is that
you're reading and writing a temp file, calling the instruments within with-sound.
The special generator snd->sample provides a way to redirect
-the CLM input handlers (<a class=quiet href="sndclm.html#in-any" onmouseout="UnTip()" onmouseover="Tip(sndclm_in_any_tip)">in-any</a> in particular) to a Snd sound (via its index).
+the CLM input handlers (<a class=quiet href="sndclm.html#in-any">in-any</a> in particular) to a Snd sound (via its index).
</p>
-<br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndwithcm">Snd and Common Music</a></h3></td></tr></table>
+<div class="innerheader" id="sndwithcm">Snd and Common Music</div>
+
+<p>Under construction?
+</p>
+
+<!--
<p>You can load Common Music into Snd. The only real "gotcha" is that Snd's
ws.scm has to be loaded before cm's clm2.scm. I load ws.scm in my init file,
but in the following example, I'll start -noinit, and load it explicitly.
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-> <em class=typing>(load "ws.scm")</em>
-<em class=listener>#<unspecified></em>
-> <em class=typing>(load "/home/bil/test/cm/src/cm.scm")</em>
-<em class=listener>#<unspecified></em>
-> <em class=typing>(definstrument (simp beg dur freq amp)
+<pre class="indented">
+> (load "ws.scm")
+#<unspecified>
+> (load "/home/bil/test/cm/src/cm.scm")
+#<unspecified>
+> (definstrument (simp beg dur freq amp)
(let* ((o (make-oscil freq))
(st (seconds->samples beg))
(nd (+ st (seconds->samples dur))))
- (run
- (do ((i st (+ 1 i)))
- ((= i nd))
- (outa i (* amp (oscil o)))))))</em>
-<em class=listener>#<values ()></em>
-</pre></td></tr></table>
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (outa i (* amp (oscil o))))))
+#<values ()>
+</pre>
<p>
If the result of the definstrument call is <code>#<unspecified></code> then cm's definstrument-hook isn't loaded into Snd's definstrument;
if you go on anyway, you'll get some complaint that there is no class named "simp".
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-> <em class=typing>(define (random-fn n)
- (process repeat n output (new simp :beg (now) :dur .1 :freq (between 220 880) :amp .1) wait .25))</em>
-<em class=listener>#<unspecified></em>
-> <em class=typing>(events (random-fn 10) "test.clm" 0 :output "test.snd")</em>
-<em class=listener>"test.clm"</em>
-</pre></td></tr></table>
+<pre class="indented">
+> (define (random-fn n)
+ (process repeat n output (new simp :beg (now) :dur .1 :freq (between 220 880) :amp .1) wait .25))
+#<unspecified>
+> (events (random-fn 10) "test.clm" 0 :output "test.snd")
+"test.clm"
+</pre>
<p>and the result ("test.snd") is opened in Snd.
It's also possible to load sndlib into cm. Here's a note from Rick:
</p>
-<pre>
- a tarball of clm+cm in s7 scheme is available at
-
- http://camil.music.uiuc.edu/Software/grace/downloads/cm3.tar.gz
-
- the clm+cm app is fully relocatable and requires no runtime sources.
- to use the app in emacs do
-
- (setq scheme-program-name "/path/to/cm3/bin/cm")
- M-x run-scheme
-
- building is a snap:
-
- wget ftp://ccrma-ftp.stanford.edu/pub/Lisp/sndlib.tar.gz
- tar -zxf sndlib.tar.gz
- cd sndlib
- ./configure CC=g++
- make
- cd ..
-
- wget http://camil.music.uiuc.edu/Software/grace/downloads/cm3.tar.gz
- tar -zxf cm3.tar.gz
- cd cm3
- premake --verbose --target gnu --juce /path/to/juce --sndlib ../sndlib
- make
- bin/cm
-
- S7 Scheme 1.2, (c) 2008 William Schottstaedt
- SNDLIB 20.10, (c) 2008 William Schottstaedt
- /\\\
- ---\\\---------
- ----\\\--------
- ----/\\\------- Common Music 3.2.0
- ---/--\\\------
- --/----\\\-----
- / \\\/
- Type 'q' to quit.
- cm> (list 1 2 3)
- (1 2 3)
- cm> (load "/Users/hkt/Software/snd-12/v.scm")
- fm-violin
- cm> (with-sound () (fm-violin 0 1 440 .1))
- "test.aiff"
- cm> (define (foo n )
- (process for i below n
- do (display (list i (elapsed)))
- (newline)
- (wait .5)))
-
- foo
- cm> (sprout (foo 10))
- (0 0.0)
- (1 0.5000870000124)
- (2 1.0009470000267)
- (3 1.5018830000162)
- (4 2.0025049999952)
- (5 2.5038330000043)
- (6 3.0042760000229)
- (7 3.5051180000305)
- (8 4.006182000041)
- (9 4.5074370000362)
- cm> q
- Killing scheme thread...quitting Scheme
- Bye!
-</pre>
-
-
-
-<br><br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndwithmotif">Snd and Motif</a></h3></td></tr></table>
-
-<p>It is possible to add your own user-interface elements using the xm module
-included with Snd. 'make xm' should create
-a shared library named xm.so; you can load this at any time into Snd:
-</p>
-<pre>
- > <em class=typing>(define hxm (dlopen "/home/bil/snd-12/xm.so"))</em>
- <em class=listener>#<unspecified></em>
- > <em class=typing>(dlinit hxm "Init_libxm")</em>
- <em class=listener>#t</em>
+
+<pre class="indented">
+a tarball of clm+cm in s7 scheme is available at
+
+ http://camil.music.uiuc.edu/Software/grace/downloads/cm3.tar.gz
+
+the clm+cm app is fully relocatable and requires no runtime sources.
+to use the app in emacs do
+
+(setq scheme-program-name "/path/to/cm3/bin/cm")
+M-x run-scheme
+
+building is a snap:
+
+wget ftp://ccrma-ftp.stanford.edu/pub/Lisp/sndlib.tar.gz
+tar -zxf sndlib.tar.gz
+cd sndlib
+./configure CC=g++
+make
+cd ..
+
+wget http://camil.music.uiuc.edu/Software/grace/downloads/cm3.tar.gz
+tar -zxf cm3.tar.gz
+cd cm3
+premake --verbose --target gnu --juce /path/to/juce --sndlib ../sndlib
+make
+bin/cm
+
+S7 Scheme 1.2, (c) 2008 William Schottstaedt
+SNDLIB 20.10, (c) 2008 William Schottstaedt
+ /\\\
+---\\\---------
+----\\\--------
+----/\\\------- Common Music 3.2.0
+---/--\\\------
+--/----\\\-----
+ / \\\/
+Type 'q' to quit.
+cm> (list 1 2 3)
+(1 2 3)
+cm> (load "/Users/hkt/Software/snd-13/v.scm")
+fm-violin
+cm> (with-sound () (fm-violin 0 1 440 .1))
+"test.aiff"
+cm> (define (foo n )
+ (process for i below n
+ do (display (list i (elapsed)))
+ (newline)
+ (wait .5)))
+
+foo
+cm> (sprout (foo 10))
+(0 0.0)
+(1 0.5000870000124)
+(2 1.0009470000267)
+(3 1.5018830000162)
+(4 2.0025049999952)
+(5 2.5038330000043)
+(6 3.0042760000229)
+(7 3.5051180000305)
+(8 4.006182000041)
+(9 4.5074370000362)
+cm> q
+Killing scheme thread...quitting Scheme
+Bye!
</pre>
-<p>and now we have access to all of X and Motif. Alternatively, use the
-configure switch --with-static-xm, and the xm module will be included
-in the base Snd image.
-Here's a dialog window with a slider:</p>
+-->
+
+
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define scale-dialog #f)
-(define current-scaler 1.0)
+<div class="innerheader" id="sndwithmotif">Snd and Motif</div>
+
+<p>It is possible to add your own user-interface elements using the xm (for Motif) or xg (for Gtk) modules
+included with Snd. In the motif case, all the functions and constants are placed in the *motif* environment.
+Here's a dialog window with a slider:
+</p>
+
+<pre class="indented">
+(with-let *motif*
+ (define scale-dialog #f)
+ (define current-scaler 1.0)
(define (create-scale-dialog parent)
(if (not (Widget? scale-dialog))
@@ -1297,7 +1328,7 @@ Here's a dialog window with a slider:</p>
(XtUnmanageChild scale-dialog)))
(XtAddCallback scale-dialog
XmNhelpCallback (lambda (w context info)
- (<a class=quiet href="extsnd.html#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> "move the slider to affect the volume")))
+ (<a class=quiet href="extsnd.html#sndprint">snd-print</a> "move the slider to affect the volume")))
(XmStringFree xhelp)
(XmStringFree xdismiss)
(XmStringFree titlestr)
@@ -1323,17 +1354,17 @@ Here's a dialog window with a slider:</p>
(set! current-scaler (/ (.value info) 100.0)))))))
(XtManageChild scale-dialog))
-(create-scale-dialog (cadr (<a class=quiet href="extsnd.html#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>)))
-</pre></td></tr></table>
+(create-scale-dialog (cadr (<a class=quiet href="extsnd.html#mainwidgets">main-widgets</a>))))
+</pre>
<p>which creates a little dialog:
</p>
-<img src="pix/scldlog.png" alt="scale dialog" hspace=20 vspace=20>
+<img src="pix/scldlog.png" alt="scale dialog">
<p>
In Ruby, this is:</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
$scale_dialog = false
$current_scaler = 1.0
@@ -1380,62 +1411,28 @@ end
$Snd_widgets = main_widgets()
create_scale_dialog $Snd_widgets[1]
-</pre></td></tr></table>
+</pre>
<p>All of Snd is at your disposal once this module is loaded.
-The next function installs our own file filtering procedure into the File:Open dialog (it uses
-match-sound-files from extensions.scm):
-</p>
-
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define (install-searcher proc)
- (define (XmString->string str)
- (cadr (XmStringGetLtoR str XmFONTLIST_DEFAULT_TAG)))
- (define (XmStringTable->list st len)
- (XmStringTableUnparse st len #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
- (define (list->XmStringTable strs)
- (XmStringTableParseStringArray strs (length strs) #f XmCHARSET_TEXT #f 0 #f))
- (XtSetValues (let ((m (<a class=quiet href="extsnd.html#openfiledialog" onmouseout="UnTip()" onmouseover="Tip(extsnd_openfiledialog_tip)">open-file-dialog</a> #f)))
- ; make sure the dialog exists
- (list-ref (<a class=quiet href="extsnd.html#dialogwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_dialogwidgets_tip)">dialog-widgets</a>) 6))
- (list XmNfileSearchProc ; set dialog file search procedure
- (lambda (widget info)
- (let* ((dir (XmString->string (dir info))) ; directory string
- (files (<a class=quiet href="sndscm.html#matchsoundfiles" onmouseout="UnTip()" onmouseover="Tip(sndscm_matchsoundfiles_tip)">match-sound-files</a> proc dir)) ; list of matching files
- (fileTable (list->XmStringTable ; XmStringTable for XmNfileListItems
- (map (lambda (n) ; every file needs prepended dir
- (string-append dir n))
- files))))
- (XtSetValues widget ; change the list of files
- (list XmNfileListItems fileTable
- XmNfileListItemCount (length files)
- XmNlistUpdated #t)))))))
-
-;(install-searcher (lambda (file) (= (srate file) 44100)))
-;(install-searcher (lambda (file) (= (channels file) 4)))
-</pre></td></tr></table>
-
-<p>Now click the 'Filter' button to see only those files that fit the procedure in
-the dialog's files list. See snd-motif.scm.
-</p>
-<br>
-
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndwithgtk">Snd and Gtk+</a></h3></td></tr></table>
+</p>
+
+
+
+<div class="innerheader" id="sndwithgtk">Snd and Gtk+</div>
<p>There are tons of examples of using the gtk module. snd-gtk.scm is one
place to start. All of gtk and cairo, and much of pango and glib are accessible from the
-extension language if you loaded the xg module or built Snd with the configuration switch
---with-static-xg.
+extension language.
Here's the scale-dialog in xg/gtk:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define scale-dialog #f)
-(define current-scaler 1.0)
+<pre class="indented">
+(with-let *gtk*
+ (define scale-dialog #f)
+ (define current-scaler 1.0)
-(define (create-scale-dialog parent)
- (if (not scale-dialog)
- (begin
+ (define (create-scale-dialog parent)
+ (unless scale-dialog
(set! scale-dialog (gtk_dialog_new))
(g_signal_connect scale-dialog "delete-event"
(lambda (w ev info)
@@ -1444,131 +1441,96 @@ Here's the scale-dialog in xg/gtk:
(gtk_widget_realize scale-dialog)
(let ((dismiss (gtk_button_new_with_label "Dismiss"))
(help (gtk_button_new_with_label "Help")))
- (gtk_box_pack_start (GTK_BOX (.action_area (GTK_DIALOG scale-dialog))) dismiss #t #t 4)
- (gtk_box_pack_end (GTK_BOX (.action_area (GTK_DIALOG scale-dialog))) help #t #t 4)
+ (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG scale-dialog))) dismiss #t #t 4)
+ (gtk_box_pack_end (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG scale-dialog))) help #t #t 4)
(g_signal_connect dismiss "clicked"
(lambda (w info)
(gtk_widget_hide scale-dialog)))
(g_signal_connect help "clicked"
(lambda (w info)
- (<a class=quiet href="extsnd.html#helpdialog" onmouseout="UnTip()" onmouseover="Tip(extsnd_helpdialog_tip)">help-dialog</a> "Scaler Dialog" "move the slider to affect the volume")))
+ (<a class=quiet href="extsnd.html#helpdialog">help-dialog</a> "Scaler Dialog" "move the slider to affect the volume")))
(gtk_widget_show dismiss)
(gtk_widget_show help)
(let* ((adj (gtk_adjustment_new 0.0 0.0 1.01 0.01 0.01 .01))
- (scale (gtk_hscale_new (GTK_ADJUSTMENT adj))))
- (gtk_range_set_update_policy (GTK_RANGE (GTK_SCALE scale)) GTK_UPDATE_CONTINUOUS)
+ (scale (gtk_scale_new GTK_ORIENTATION_HORIZONTAL (GTK_ADJUSTMENT adj))))
(gtk_scale_set_draw_value (GTK_SCALE scale) #t)
(gtk_scale_set_digits (GTK_SCALE scale) 2)
(g_signal_connect adj "value_changed"
(lambda (wadj info)
- (set! current-scaler (.value (GTK_ADJUSTMENT wadj)))))
- (gtk_box_pack_start (GTK_BOX (.vbox (GTK_DIALOG scale-dialog))) scale #f #f 6)
- (gtk_widget_show scale)))))
- (gtk_widget_show scale-dialog))
+ (set! current-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT wadj)))))
+ (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG scale-dialog))) scale #f #f 6)
+ (gtk_widget_show scale))))
+ (gtk_widget_show scale-dialog))
-(create-scale-dialog (cadr (<a class=quiet href="extsnd.html#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>)))
-</pre></td></tr></table>
+(create-scale-dialog (cadr (<a class=quiet href="extsnd.html#mainwidgets">main-widgets</a>))))
+</pre>
<p>The only change from the C code is the addition of GTK_ADJUSTMENT in the scale value_changed
callback — currently the xg module assumes the first argument to the two-argument callback is
a GtkWidget, so we have to cast a GtkAdjustment back to its original type.
</p>
-<p>Here are a couple other examples of things that aren't covered by the gtk code in snd-gtk.scm and
-friends:
-</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-;; report on mouse scroll wheel changes when in the channel graph
-(g_signal_connect
- (car (<a class=quiet href="extsnd.html#channelwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelwidgets_tip)">channel-widgets</a>)) "scroll_event"
- (lambda (w e i)
- (<a class=quiet href="extsnd.html#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~%state: ~A, x: ~A, y: ~A, direction: ~A"
- (.state (GDK_EVENT_SCROLL e))
- (.x (GDK_EVENT_SCROLL e))
- (.y (GDK_EVENT_SCROLL e))
- (.direction (GDK_EVENT_SCROLL e))))
- #f))
-
-;; report which kind of click was received in the channel graph
-(g_signal_connect
- (car (<a class=quiet href="extsnd.html#channelwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelwidgets_tip)">channel-widgets</a>)) "button_press_event"
- (lambda (w e i)
- (<a class=quiet href="extsnd.html#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~%button: ~A, ~A click"
- (.type (GDK_EVENT_BUTTON e))
- (if (= (.type (GDK_EVENT_BUTTON e)) GDK_BUTTON_PRESS)
- "single"
- (if (= (.type (GDK_EVENT_BUTTON e)) GDK_2BUTTON_PRESS)
- "double"
- (if (= (.type (GDK_EVENT_BUTTON e)) GDK_3BUTTON_PRESS)
- "triple"
- "unknown")))))
- #f))
-
-;; a double click is reported as single/single/double
-
-;; double-click time in milliseconds(?)
-(define (double-click-time)
- (g_object_get (GPOINTER
- (gtk_settings_get_for_screen
- (gdk_display_get_default_screen
- (gdk_display_get_default))))
- "gtk-double-click-time" #f))
-</pre></td></tr></table>
-
-<br>
+
<!-- INDEX sndwithnogui:Scripting -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndwithnogui">Snd with no GUI and as scripting engine</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndwithnogui">Snd with no GUI and as scripting engine</div>
<p>If Snd is built without a graphical user interface (by specifying
---with-no-gui to configure),
+--without-gui to configure),
it runs the extension language's read-eval-print loop, with input from stdin. All
the non-interface related functions are available, so you can do things
like:
</p>
-<table border=0 cellspacing=10>
-<tr><th bgcolor="#f2f4ff" align=left>Scheme</th><th></th><th bgcolor="beige" align=left>Ruby</th><th></th><th bgcolor="lightgreen" align=left>Forth</th></tr>
+<table class="spaced">
+<tr><th class="scheme">Scheme</th><th class="ruby">Ruby</th><th class="forth">Forth</th></tr>
<tr>
-<td bgcolor="#fbfbff"><pre>
+<td class="scheme">
+<pre class="indented">
snd
-:<em class=typing>(new-sound "test.snd")</em>
-<em class=listener>#<sound 0></em>
-:<em class=typing>(mix "oboe.snd")</em>
-<em class=listener>(#<mix 0>)</em>
-:<em class=typing>(frames)</em>
-<em class=listener>50828</em>
-:<em class=typing>(play)</em>
-<em class=listener>#f</em>
-:<em class=typing>(exit)</em>
-</pre></td><td width=60></td>
-
-<td bgcolor="#FdFdf2"><pre>
+:(new-sound "test.snd")
+#<sound 0>
+:(mix "oboe.snd")
+(#<mix 0>)
+:(framples)
+50828
+:(play)
+#f
+:(exit)
+</pre>
+</td>
+
+<td class="ruby">
+<pre class="indented">
snd
-> <em class=typing>new_sound("test.snd")</em>
-<em class=listener>0</em>
-> <em class=typing>mix("oboe.snd")</em>
-<em class=listener>[#<mix 0>]</em>
-> <em class=typing>frames</em>
-<em class=listener>50828</em>
-> <em class=typing>play</em>
-<em class=listener>false</em>
-> <em class=typing>exit</em>
-</pre></td><td width=60></td>
-
-<td bgcolor="#EefdEe"><pre>
+> new_sound("test.snd")
+0
+> mix("oboe.snd")
+[#<mix 0>]
+> framples
+50828
+> play
+false
+> exit
+</pre>
+</td>
+
+<td class="forth">
+<pre class="indented">
snd
-<em class=typing>"test.snd" new-sound</em>
-<em class=listener>0 ok</em>
-<em class=typing>"oboe.snd" mix</em>
-<em class=listener>-1 ok</em>
-<em class=typing>frames</em>
-<em class=listener>50828 ok</em>
-<em class=typing>play</em>
-<em class=listener>#f ok</em>
-<em class=typing>snd-exit</em>
-</pre></td>
+"test.snd" new-sound
+0 ok
+"oboe.snd" mix
+-1 ok
+framples
+50828 ok
+play
+#f ok
+snd-exit
+</pre>
+</td>
</tr>
</table>
@@ -1579,61 +1541,68 @@ can treat this version of Snd as a scripting engine. For example,
if you have an executable file with:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td>
-<pre>
-#!/home/bil/test/snd-12/snd -l
+<pre class="indented">
+#!/home/bil/test/snd-16/snd -l
!#
(define a-test 32)
(display "hiho")
(newline)
-</pre></td></tr></table>
+</pre>
<p>it can be executed just like any such script.
</p>
-<pre>
- /home/bil/test/snd-12/ script
- hiho
- :a-test
- 32
- :(<a class=quiet href="extsnd.html#exit" onmouseout="UnTip()" onmouseover="Tip(extsnd_exit_tip)">exit</a>)
- /home/bil/test/snd-12/
+
+<pre class="indented">
+/home/bil/test/snd-16/ script
+hiho
+> a-test
+32
+> (<a class=quiet href="extsnd.html#exit">exit</a>)
+/home/bil/test/snd-16/
</pre>
+
<p>
As noted above, you can use the -e switch to use Snd as a pure
-command-line program, and, of course, (<a class=quiet href="extsnd.html#exit" onmouseout="UnTip()" onmouseover="Tip(extsnd_exit_tip)">exit</a>) to drop back to the shell.
+command-line program, and, of course, (<a class=quiet href="extsnd.html#exit">exit</a>) to drop back to the shell.
Here's a script that doubles every sample in "oboe.snd" and
writes the result as "test.snd":
</p>
-<table border=0 cellspacing=10>
-<tr><th bgcolor="#f2f4ff" align=left>Scheme</th><th></th><th bgcolor="beige" align=left>Ruby</th><th></th><th bgcolor="lightgreen" align=left>Forth</th></tr>
+<table class="spaced">
+<tr><th class="scheme">Scheme</th><th class="ruby">Ruby</th><th class="forth">Forth</th></tr>
<tr>
-<td bgcolor="#fbfbff"><pre>
-#!/home/bil/snd-12/snd -l
+<td class="scheme">
+<pre class="indented">
+#!/home/bil/snd-16/snd -l
!#
(open-sound "oboe.snd")
(scale-by 2.0)
(save-sound-as "test.snd")
(exit)
-</pre></td><td width=60></td>
+</pre>
+</td>
-<td bgcolor="#FdFdf2"><pre>
-#!/home/bil/snd-12/snd -batch
+<td class="ruby">
+<pre class="indented">
+#!/home/bil/snd-16/snd -batch
open_sound "oboe.snd"
scale_by 2.0
save_sound_as "test.snd"
exit
-</pre></td><td width=60></td>
+</pre>
+</td>
-<td bgcolor="#EefdEe"><pre>
+<td class="forth">
+<pre class="indented">
#! /usr/bin/env /home/bil/forth-snd/snd
"oboe.snd" open-sound drop
2.0 #f #f scale-by drop
"test.snd" save-sound-as
snd-exit
-</pre></td>
+</pre>
+</td>
</tr>
</table>
@@ -1642,61 +1611,69 @@ snd-exit
to access the script's arguments, and if necessary (if not exiting)
tell Snd to ignore arguments. script-args returns a list of strings
giving the arguments. The first two are always "-l" and the script
-file name. The current argument is (<a class=quiet href="extsnd.html#scriptarg" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptarg_tip)">script-arg</a>). If you set this to
+file name. The current argument is (<a class=quiet href="extsnd.html#scriptarg">script-arg</a>). If you set this to
a higher value, Snd will subsequently ignore the intervening arguments
as it scans the startup arguments (see snd-test.scm).
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-#!/home/bil/test/snd-12/snd -l
+<pre class="indented">
+#!/home/bil/test/snd-16/snd -l
!#
-(if (= (length (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>)) 2) ;i.e. ("-l" "script")
+(if (= (length (<a class=quiet href="extsnd.html#scriptargs">script-args</a>)) 2) ;i.e. ("-l" "script")
(display "usage: script file-name...")
(begin
- (<a class=quiet href="extsnd.html#opensound" onmouseout="UnTip()" onmouseover="Tip(extsnd_opensound_tip)">open-sound</a> (list-ref (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>) (+ (<a class=quiet href="extsnd.html#scriptarg" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptarg_tip)">script-arg</a>) 1)))
- (<a class=quiet href="extsnd.html#scaleby" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleby_tip)">scale-by</a> 2.0)
- (<a class=quiet href="extsnd.html#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a> "test.snd")))
-(<a class=quiet href="extsnd.html#exit" onmouseout="UnTip()" onmouseover="Tip(extsnd_exit_tip)">exit</a>)
-</pre></td></tr></table>
+ (<a class=quiet href="extsnd.html#opensound">open-sound</a> ((<a class=quiet href="extsnd.html#scriptargs">script-args</a>) (+ (<a class=quiet href="extsnd.html#scriptarg">script-arg</a>) 1)))
+ (<a class=quiet href="extsnd.html#scaleby">scale-by</a> 2.0)
+ (<a class=quiet href="extsnd.html#savesoundas">save-sound-as</a> "test.snd")))
+(<a class=quiet href="extsnd.html#exit">exit</a>)
+</pre>
<p>This either grumbles if no argument is given,
or scales its argument sound by 2.0:
</p>
-<pre>
- script pistol.snd
+
+<pre class="indented">
+script pistol.snd
</pre>
+
<p>And we can run through the entire argument list,
doubling all the sounds or whatever by using a do loop —
the following displays all the comments it finds:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
#!/home/bil/cl/snd -l
!#
-(if (= (length (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>)) 2) ;i.e. ("-l" "script")
+(if (= (length (<a class=quiet href="extsnd.html#scriptargs">script-args</a>)) 2) ;i.e. ("-l" "script")
(display "usage: script file-name...")
- (do ((arg (+ (<a class=quiet href="extsnd.html#scriptarg" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptarg_tip)">script-arg</a>) 1) (+ 1 arg)))
- ((= arg (length (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>))))
- (let ((name (list-ref (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>) arg)))
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A: ~A~%" name (<a class=quiet href="extsnd.html#mussoundcomment" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundcomment_tip)">mus-sound-comment</a> name))))))
-(<a class=quiet href="extsnd.html#exit" onmouseout="UnTip()" onmouseover="Tip(extsnd_exit_tip)">exit</a>)
-</pre></td></tr></table>
+ (do ((arg (+ (<a class=quiet href="extsnd.html#scriptarg">script-arg</a>) 1) (+ 1 arg)))
+ ((= arg (length (<a class=quiet href="extsnd.html#scriptargs">script-args</a>))))
+ (let ((name ((<a class=quiet href="extsnd.html#scriptargs">script-args</a>) arg)))
+ (display (<a class=quiet>format</a> #f "~A: ~A~%" name (<a class=quiet href="extsnd.html#mussoundcomment">mus-sound-comment</a> name))))))
+(<a class=quiet href="extsnd.html#exit">exit</a>)
+</pre>
<p>
Say we save this as the file "comments".</p>
-<pre>
- /home/bil/cl/comments *.snd
+
+<pre class="indented">
+/home/bil/cl/comments *.snd
</pre>
+
<p>If you like, you can use env:</p>
-<pre>
- #!/usr/bin/env snd
- !#
+
+<pre class="indented">
+#!/usr/bin/env snd
+!#
</pre>
+
<p>But if that works, so will:</p>
-<pre>
- #!snd -l
- !#
+
+<pre class="indented">
+#!snd -l
+!#
</pre>
+
<p>
This scripting mechanism actually will work in any version of Snd;
to keep the Snd window from popping up, use the -b (-batch) switch in
@@ -1705,61 +1682,61 @@ Here's another script; it looks for any sounds that are longer
than 40 seconds in duration, and truncates them to 40 seconds:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
#!/usr/local/bin/snd -l
!#
-(if (= (length (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>)) 2)
+(if (= (length (<a class=quiet href="extsnd.html#scriptargs">script-args</a>)) 2)
(display "usage: trunc.scm file-name...")
- (do ((arg (+ (<a class=quiet href="extsnd.html#scriptarg" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptarg_tip)">script-arg</a>) 1) (+ 1 arg)))
- ((= arg (length (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>))))
- (let* ((name (list-ref (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>) arg)))
- (if (> (<a class=quiet href="extsnd.html#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> name) 40.0)
- (let* ((ind (<a class=quiet href="extsnd.html#opensound" onmouseout="UnTip()" onmouseover="Tip(extsnd_opensound_tip)">open-sound</a> name)))
- (set! (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> ind) (* 40 (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> ind)))
- (<a class=quiet href="extsnd.html#savesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesound_tip)">save-sound</a> ind)
- (<a class=quiet href="extsnd.html#closesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_closesound_tip)">close-sound</a> ind))))))
-(<a class=quiet href="extsnd.html#exit" onmouseout="UnTip()" onmouseover="Tip(extsnd_exit_tip)">exit</a>)
-</pre></td></tr></table>
+ (do ((arg (+ (<a class=quiet href="extsnd.html#scriptarg">script-arg</a>) 1) (+ 1 arg)))
+ ((= arg (length (<a class=quiet href="extsnd.html#scriptargs">script-args</a>))))
+ (let* ((name ((<a class=quiet href="extsnd.html#scriptargs">script-args</a>) arg)))
+ (if (> (<a class=quiet href="extsnd.html#mussoundduration">mus-sound-duration</a> name) 40.0)
+ (let* ((ind (<a class=quiet href="extsnd.html#opensound">open-sound</a> name)))
+ (set! (<a class=quiet href="extsnd.html#framples">framples</a> ind) (* 40 (<a class=quiet href="extsnd.html#srate">srate</a> ind)))
+ (<a class=quiet href="extsnd.html#savesound">save-sound</a> ind)
+ (<a class=quiet href="extsnd.html#closesound">close-sound</a> ind))))))
+(<a class=quiet href="extsnd.html#exit">exit</a>)
+</pre>
<p>Here's a sndplay replacement script:</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
#!snd -b
!#
-(play (list-ref (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>) (+ (<a class=quiet href="extsnd.html#scriptarg" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptarg_tip)">script-arg</a>) 1)) :wait #t)
-(<a class=quiet href="extsnd.html#exit" onmouseout="UnTip()" onmouseover="Tip(extsnd_exit_tip)">exit</a>)
-</pre></td></tr></table>
+(play ((<a class=quiet href="extsnd.html#scriptargs">script-args</a>) (+ (<a class=quiet href="extsnd.html#scriptarg">script-arg</a>) 1)) :wait #t)
+(<a class=quiet href="extsnd.html#exit">exit</a>)
+</pre>
<p>And here's a script that splits a multichannel file
into a bunch of mono files:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
#!snd -b
!#
-(if (= (length (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>)) 2)
+(if (= (length (<a class=quiet href="extsnd.html#scriptargs">script-args</a>)) 2)
(display "usage: split.scm filename")
- (let* ((name (list-ref (<a class=quiet href="extsnd.html#scriptargs" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptargs_tip)">script-args</a>) (+ 1 (<a class=quiet href="extsnd.html#scriptarg" onmouseout="UnTip()" onmouseover="Tip(extsnd_scriptarg_tip)">script-arg</a>))))
+ (let* ((name ((<a class=quiet href="extsnd.html#scriptargs">script-args</a>) (+ 1 (<a class=quiet href="extsnd.html#scriptarg">script-arg</a>))))
(chns (channels name)))
(if (> chns 1)
- (let ((ind (<a class=quiet href="extsnd.html#opensound" onmouseout="UnTip()" onmouseover="Tip(extsnd_opensound_tip)">open-sound</a> name)))
- (do ((i 0 (+ 1 i)))
+ (let ((ind (<a class=quiet href="extsnd.html#opensound">open-sound</a> name)))
+ (do ((i 0 (+ i 1)))
((= i chns))
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A.~D " name i))
- (<a class=quiet href="extsnd.html#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A.~D" name i)
+ (display (<a class=quiet>format</a> #f "~A.~D " name i))
+ (<a class=quiet href="extsnd.html#savesoundas">save-sound-as</a> (<a class=quiet>format</a> #f "~A.~D" name i)
ind
- (<a class=quiet href="extsnd.html#headertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_headertype_tip)">header-type</a> ind)
- (<a class=quiet href="extsnd.html#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_dataformat_tip)">data-format</a> ind)
- (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> ind)
+ (<a class=quiet href="extsnd.html#srate">srate</a> ind)
+ (<a class=quiet href="extsnd.html#sampletype">sample-type</a> ind)
+ (<a class=quiet href="extsnd.html#headertype">header-type</a> ind)
i))
- (<a class=quiet href="extsnd.html#closesound" onmouseout="UnTip()" onmouseover="Tip(extsnd_closesound_tip)">close-sound</a> ind)))))
-(<a class=quiet href="extsnd.html#exit" onmouseout="UnTip()" onmouseover="Tip(extsnd_exit_tip)">exit</a>)
-</pre></td></tr></table>
+ (<a class=quiet href="extsnd.html#closesound">close-sound</a> ind)))))
+(<a class=quiet href="extsnd.html#exit">exit</a>)
+</pre>
+
-<br>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndandruby">Snd with Ruby</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndandruby">Snd with Ruby</div>
<p>Ruby is an extension language described as an "object-oriented Perl".
It provides a different syntax from that of Scheme; most of the *.scm (Scheme)
@@ -1773,14 +1750,14 @@ In Ruby, the following changes are made in the function names (as presented in S
(e.g. Autocorrelation). The generalized set! functions are replaced
by "set_" plus the base name (e.g. set_window_width), with arguments
reordered in some cases to place the optional values after the new value. That is,
-<code>(set! (<a class=quiet href="extsnd.html#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> snd) 1)</code> becomes <code>set_sync(1, snd)</code>.
+<code>(set! (<a class=quiet href="extsnd.html#sync">sync</a> snd) 1)</code> becomes <code>set_sync(1, snd)</code>.
Hooks in Ruby (which have little or nothing to do with Ruby's "hookable variables")
are just procedures or nil, not lists of procedures as in Scheme.
Here's a Ruby version of the init file given
above (named ~/.snd_ruby):
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
set_window_width 800
set_window_height 500
@@ -1788,7 +1765,6 @@ set_listener_font "9x15"
set_axis_numbers_font "9x15"
set_show_mix_waveforms true
-set_trap_segfault false
set_show_indices true
set_listener_prompt ":"
@@ -1798,54 +1774,60 @@ beige = make_color 0.96, 0.96, 0.86
blue = make_color 0, 0, 1
set_selected_graph_color beige
set_selected_data_color blue
-</pre></td></tr></table>
+</pre>
<p>Procedures are created via Proc.new, so to set the open-hook to print the
file name,
</p>
-<pre>
- ><em class=typing>$open_hook = Proc.new { |name| snd_print name }</em>
- <em class=listener>#<Proc:0x40221b84></em>
- ><em class=typing>open_sound "oboe.snd"</em>
- <em class=listener>/home/bil/cl/oboe.snd
- 0</em>
+
+<pre class="indented">
+>$open_hook = Proc.new { |name| snd_print name }
+#<Proc:0x40221b84>
+>open_sound "oboe.snd"
+/home/bil/cl/oboe.snd
+0
</pre>
+
<p>(The trailing "0" is the result of open_sound).
The Scheme hook list support procedures aren't included in Ruby —
simply set the variable to the procedure you want, or false to clear it.
</p>
-<p>Vcts and sound-data objects mixin "Comparable" and "Enumerable", and respond to various array-like methods:
+<p>Vcts mixin "Comparable" and "Enumerable", and respond to various array-like methods:
</p>
-<pre>
- ><em class=typing>v1 = make_vct 4</em>
- <em class=listener>#<vct[len=4]: 0.000 0.000 0.000 0.000></em>
- ><em class=typing>v1[3] = 1.0</em>
- <em class=listener>1.0</em>
- ><em class=typing>v1.sort</em>
- <em class=listener>0.00.00.01.0</em> # I don't know why it prints this way but ...
- ><em class=typing>v1</em>
- <em class=listener>#<vct[len=4]: 0.000 0.000 0.000 1.000></em>
- ><em class=typing>v1.max</em>
- <em class=listener>1.0</em>
+
+<pre class="indented">
+>v1 = make_vct 4
+#<vct[len=4]: 0.000 0.000 0.000 0.000>
+>v1[3] = 1.0
+1.0
+>v1.sort
+0.00.00.01.0 # I don't know why it prints this way but ...
+>v1
+#<vct[len=4]: 0.000 0.000 0.000 1.000>
+>v1.max
+1.0
</pre>
+
<p>
Keywords, CLM generic functions, and optional arguments work as in Scheme:
</p>
-<pre>
- ><em class=typing>osc = make_oscil(:frequency, 440)</em>
- <em class=listener>oscil freq: 440.000Hz, phase: 0.000</em>
- ><em class=typing>oscil osc</em>
- <em class=listener>0.0</em>
- ><em class=typing>oscil osc</em>
- <em class=listener>0.1250506192</em>
- ><em class=typing>osc.frequency</em>
- <em class=listener>440.0</em>
+
+<pre class="indented">
+>osc = make_oscil(:frequency, 440)
+oscil freq: 440.000Hz, phase: 0.000
+>oscil osc
+0.0
+>oscil osc
+0.1250506192
+>osc.frequency
+440.0
</pre>
+
<p>Lists (from the Scheme point of view) are arrays (vectors) in Ruby.
Here's one more example, a translation of display-energy in draw.scm:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
def display_energy(snd, chn)
ls = left_sample
rs = right_sample
@@ -1862,40 +1844,47 @@ def display_energy(snd, chn)
end
# $lisp_graph_hook = Proc.new {|snd, chn| display_energy(snd, chn)}
-</pre></td></tr></table>
+</pre>
<p>
In Ruby you make a symbol by prepending ":", so Scheme's
</p>
-<pre>
- (list 'KeySym (char->integer #\F))
-</pre>
+
+<pre class="indented">
+(list 'KeySym (char->integer #\F))
+</pre>
+
<p>becomes</p>
-<pre>
- [:KeySym, ?F]
+
+<pre class="indented">
+[:KeySym, ?F]
</pre>
+
<p>In the listener, everything is line-oriented (that is, I'm not trying to
catch incomplete expressions). And it appears that in Ruby, variables defined
within a file are considered local to that file(?).
For Ruby as an Emacs subjob, see inf-snd.el.
</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndandforth">Snd with Forth</a></h3></td></tr></table>
+
+
+<div class="innerheader" id="sndandforth">Snd with Forth</div>
<p>Snd can be built with Forth as its extension language. Forth is available at:
</p>
-<pre>
- http://sourceforge.net/projects/fth
+
+<pre class="indented">
+http://sourceforge.net/projects/fth
</pre>
+
<p>An example initialization file (~/.snd_forth) is given in the <a href="#sndinitfile">initialization</a> section.
Mike Scholz (creator of the Forth library we use) has provided a bunch of Forth files along the lines of the
Scheme and Ruby files described above — see *.fs. See also Mike's very fine documentation in the fth package.
Here's an example from his fth.texi file showing how to define an instrument and use it in with-sound:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
instrument: src-simp { start dur amp sr sr-env fname -- }
:file fname make-readin { f }
:input f input-fn :srate sr make-src { sr }
@@ -1911,12 +1900,11 @@ instrument: src-simp { start dur amp sr sr-env fname -- }
"/usr/gnu/sound/SFiles/fyow.snd" value fyow-snd
#( 0.0 0.0 50.0 1.0 100.0 0.0 ) value sr-env
0.0 1.5 0.5 0.2 sr-env array->list fyow-snd ' src-simp with-sound
-</pre></td></tr></table>
+</pre>
-<br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndands7">Snd with s7</a></h3></td></tr></table>
+<div class="innerheader" id="sndands7">Snd with s7</div>
<p>s7 is a Scheme implementation included in the Snd tarball and described in <a href="s7.html">s7.html</a>. It is now the Snd default extension language.
</p>
@@ -1924,32 +1912,37 @@ instrument: src-simp { start dur amp sr sr-env fname -- }
<p>
The s7 initialization file is ~/.snd_s7.
</p>
-<br><br>
+
+
<!-- INDEX sndandladspa:Plugins -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndandladspa">Snd and LADSPA Plugins</a></h3></td></tr></table>
-<pre>
- <a class=def name="initladspa">init-ladspa</a>
- <a class=def name="listladspa">list-ladspa</a>
- <a class=def name="analyseladspa">analyse-ladspa</a> library plugin [also <b>analyze-ladspa</b>]
- <a class=def name="ladspadescriptor">ladspa-descriptor</a> library plugin
- <a class=def name="applyladspa">apply-ladspa</a> reader data duration origin snd chn
-
- <em class=emdef>ladspa-instantiate</em> descriptor srate
- <em class=emdef>ladspa-activate</em> descriptor handle
- <em class=emdef>ladspa-deactivate</em> descriptor handle
- <em class=emdef>ladspa-cleanup</em> descriptor handle
- <em class=emdef>ladspa-connect-port</em> descriptor handle port vct
- <em class=emdef>ladspa-run</em> descriptor handle count
- <em class=emdef>ladspa-run-adding</em> descriptor handle count
- <em class=emdef>ladspa-set-run-adding-gain</em> descriptor handle gain
+<div class="innerheader" id="sndandladspa">Snd and LADSPA Plugins</div>
+
+
+<pre class="indented">
+<em class=def id="initladspa">init-ladspa</em>
+<em class=def id="listladspa">list-ladspa</em>
+<em class=def id="analyseladspa">analyse-ladspa</em> library plugin [also <b>analyze-ladspa</b>]
+<em class=def id="ladspadescriptor">ladspa-descriptor</em> library plugin
+<em class=def id="applyladspa">apply-ladspa</em> reader data duration origin snd chn
+
+<em class=emdef>ladspa-instantiate</em> descriptor srate
+<em class=emdef>ladspa-activate</em> descriptor handle
+<em class=emdef>ladspa-deactivate</em> descriptor handle
+<em class=emdef>ladspa-cleanup</em> descriptor handle
+<em class=emdef>ladspa-connect-port</em> descriptor handle port float-vector
+<em class=emdef>ladspa-run</em> descriptor handle count
+<em class=emdef>ladspa-run-adding</em> descriptor handle count
+<em class=emdef>ladspa-set-run-adding-gain</em> descriptor handle gain
</pre>
+
<p>Richard Furse has provided a module to support LADSPA plugins in Snd.
Here is his documentation:</p>
-<pre>
+
+<pre class="indented">
Supporting functions are:
(init-ladspa)
@@ -1976,13 +1969,16 @@ The main function is:
Applies a LADSPA plugin to a block of samples.
An example call to apply the low-pass-filter in the CMT plugin library is
-(apply-ladspa (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0) (list "cmt" "lpf" 1000) 10000 "origin").
+(apply-ladspa (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0) (list "cmt" "lpf" 1000) 10000 "origin").
</pre>
+
<p>Dave Phillips in <a href="http://www.oreillynet.com/pub/a/linux/2001/02/02/ladspa.html">Linux Audio Plug-Ins: A Look Into LADSPA</a> adds this:
</p>
-<pre>
- (apply-ladspa (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 57264) (list "cmt" "delay_5s" .3 .5) 32556 "ibm.wav")
+
+<pre class="indented">
+(apply-ladspa (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 57264) (list "cmt" "delay_5s" .3 .5) 32556 "ibm.wav")
</pre>
+
<p>
"This sequence tells Snd to read a block of 32556 samples from the ibm.wav file, starting at sample number 57264,
and apply the delay_5s LADSPA plug-in (Richard Furse's delay plug-in, also found in cmt.so) with a delay time of
@@ -1993,66 +1989,76 @@ to the directory.
If, for example,
cmt.so is in /usr/local/lib/ladspa, (and you're using tcsh), then
</p>
-<pre>
- setenv LADSPA_PATH /usr/local/lib/ladspa
+
+<pre class="indented">
+setenv LADSPA_PATH /usr/local/lib/ladspa
</pre>
+
<p>or</p>
-<pre>
- (set! (ladspa-dir) "/usr/local/lib/ladspa")
+
+<pre class="indented">
+(set! *ladspa-dir* "/usr/local/lib/ladspa")
</pre>
+
<p>Snd plugins may have any number of inputs and outputs; if more
than one input is required, the first argument to apply-ladspa should be a list of readers:
</p>
-<pre>
- (apply-ladspa (list (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0 0 0) ;chan 0
- (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0 0 1)) ;chan 1
+
+<pre class="indented">
+(apply-ladspa (list (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0 0 0) ;chan 0
+ (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0 0 1)) ;chan 1
(list "cmt" "freeverb3" 0 .5 .5 .5 .5 .5)
100000 "freeverb")
</pre>
-<p><a name="ladspachannel"></a>The "regularized" version of apply-ladspa could be defined:
+
+<p id="ladspachannel">The "regularized" version of apply-ladspa could be defined:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+
+<pre class="indented">
(define* (ladspa-channel ladspa-data (beg 0) ndur snd chn (edpos -1))
- (let* ((dur (or ndur (- (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd chn) beg)))
- (reader (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> beg snd chn 1 edpos)))
+ (let ((dur (or ndur (- (<a class=quiet href="extsnd.html#framples">framples</a> snd chn) beg)))
+ (reader (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> beg snd chn 1 edpos)))
(let ((result (<em class=red>apply-ladspa</em> reader ladspa-data dur "apply-ladspa" snd chn)))
- (<a class=quiet href="extsnd.html#freesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_freesampler_tip)">free-sampler</a> reader)
+ (<a class=quiet href="extsnd.html#freesampler">free-sampler</a> reader)
result)))
-</pre></td></tr></table>
+</pre>
<p>There are also functions to access the LADSPA descriptor directly:
</p>
-<pre>
- (define ptr (ladspa-descriptor "amp" "amp_mono"))
- (.Label ptr)
- "amp_mono"
- (.Name ptr)
- "Mono Amplifier"
- (.Copyright ptr)
- "None"
- (.Maker ptr)
- "Richard Furse (LADSPA example plugins)"
- (.Properties ptr)
- 4
- (.UniqueID ptr)
- 1048
- (.PortNames ptr)
- ("Gain" "Input" "Output")
- (.PortRangeHints ptr)
- ((593 0.0 0.0) (0 0.0 0.0) (0 0.0 0.0))
- (.PortCount ptr)
- 3
- (.PortDescriptors ptr)
- (5 9 10)
- (logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT)
- 1
+
+<pre class="indented">
+(define ptr (ladspa-descriptor "amp" "amp_mono"))
+(.Label ptr)
+ "amp_mono"
+(.Name ptr)
+ "Mono Amplifier"
+(.Copyright ptr)
+ "None"
+(.Maker ptr)
+ "Richard Furse (LADSPA example plugins)"
+(.Properties ptr)
+ 4
+(.UniqueID ptr)
+ 1048
+(.PortNames ptr)
+ ("Gain" "Input" "Output")
+(.PortRangeHints ptr)
+ ((593 0.0 0.0) (0 0.0 0.0) (0 0.0 0.0))
+(.PortCount ptr)
+ 3
+(.PortDescriptors ptr)
+ (5 9 10)
+(logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT)
+ 1
</pre>
+
<p>See ladspa.h for full details. We could replace analyse-ladspa using these functions:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+
+<pre class="indented">
(define (analyze-ladspa library label)
(let* ((descriptor (<em class=red>ladspa-descriptor</em> library label))
- (data '())
+ (data ())
(names (.PortNames descriptor))
(hints (.PortRangeHints descriptor))
(descriptors (.PortDescriptors descriptor))
@@ -2063,7 +2069,7 @@ than one input is required, the first argument to apply-ladspa should be a list
(lambda (port ranges port-name)
(if (and (not (= (logand port LADSPA_PORT_CONTROL) 0))
(not (= (logand port LADSPA_PORT_INPUT) 0)))
- (let ((ldata '())
+ (let ((ldata ())
(hint (car ranges))
(lo (cadr ranges))
(hi (caddr ranges)))
@@ -2072,156 +2078,101 @@ than one input is required, the first argument to apply-ladspa should be a list
(if (not (= (logand hint LADSPA_HINT_INTEGER) 0)) (set! ldata (cons "integer" ldata)))
(if (not (= (logand hint LADSPA_HINT_SAMPLE_RATE) 0)) (set! ldata (cons "sample_rate" ldata)))
(if (not (= (logand hint LADSPA_HINT_BOUNDED_ABOVE) 0))
- (begin
- (set! ldata (cons hi ldata))
- (set! ldata (cons "maximum" ldata))))
- (if (not (= (logand hint LADSPA_HINT_BOUNDED_BELOW) 0) )
- (begin
- (set! ldata (cons lo ldata))
- (set! ldata (cons "minimum" ldata))))
+ (set! ldata (cons "maximum" (cons hi ldata))))
+ (if (not (= (logand hint LADSPA_HINT_BOUNDED_BELOW) 0))
+ (set! ldata (cons "minimum" (cons lo ldata))))
(set! ldata (cons port-name ldata))
(set! data (cons ldata data)))))
descriptors hints names)
(append (list name maker copy) data)))
-</pre></td></tr></table>
-<p>Here's a function that processes a channel of data through a plugin, sending the
-data directly to the DAC:
-</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define* (ladspa-it library label :rest plugin-parameters)
- ;; (ladspa-it "cmt" "delay_5s" .3 .5)
- (init-ladspa)
- (let* ((descriptor (ladspa-descriptor library label))
- (handle (ladspa-instantiate descriptor (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>)))
- (block-size 256)
- (in-block (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> block-size))
- (out-block (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> block-size))
- (len (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (data (<a class=quiet href="extsnd.html#makesounddata" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesounddata_tip)">make-sound-data</a> 1 block-size))
- (audio-port (<a class=quiet href="extsnd.html#musaudioopenoutput" onmouseout="UnTip()" onmouseover="Tip(extsnd_musaudioopenoutput_tip)">mus-audio-open-output</a> mus-audio-default (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) 1 <a class=quiet href="extsnd.html#dataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_muslshort_tip)">mus-lshort</a> (* block-size 2))))
- (dynamic-wind
- (lambda ()
- (let ((count 0))
- (for-each
- (lambda (port)
- (if (not (= (logand port LADSPA_PORT_CONTROL) 0))
- (let ((parameter (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 1 (car plugin-parameters))))
- (set! plugin-parameters (cdr plugin-parameters))
- (ladspa-connect-port descriptor handle count parameter))
- (if (not (= (logand port LADSPA_PORT_INPUT) 0))
- (ladspa-connect-port descriptor handle count in-block)
- (ladspa-connect-port descriptor handle count out-block)))
- (set! count (+ 1 count)))
- (.PortDescriptors descriptor))))
- (lambda ()
- (ladspa-activate descriptor handle)
- (do ((i 0 (+ i block-size)))
- ((>= i len))
- (<a class=quiet href="extsnd.html#vctsubseq" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctsubseq_tip)">vct-subseq</a> (<a class=quiet href="extsnd.html#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> i block-size) 0 block-size in-block)
- (ladspa-run descriptor handle block-size)
- (<a class=quiet href="extsnd.html#vcttosounddata" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttosounddata_tip)">vct->sound-data</a> out-block data 0)
- (<a class=quiet href="extsnd.html#musaudiowrite" onmouseout="UnTip()" onmouseover="Tip(extsnd_musaudiowrite_tip)">mus-audio-write</a> audio-port data block-size)))
- (lambda ()
- (ladspa-deactivate descriptor handle)
- (<a class=quiet href="extsnd.html#musaudioclose" onmouseout="UnTip()" onmouseover="Tip(extsnd_musaudioclose_tip)">mus-audio-close</a> audio-port)
- (ladspa-cleanup descriptor handle)))))
-</pre></td></tr></table>
-<p>
-One slight "gotcha"
-in this area: the Snd configuration switch --with-doubles causes "vcts" to
-be arrays of doubles, but Ladspa plugins expect to see arrays of floats.
-This is a problem only if you're calling ladpsa-connect-port yourself.
-</p>
-<br>
+</pre>
+
+
<!-- INDEX sndandalsa:Alsa -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndandalsa">Snd and ALSA</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndandalsa">Snd and ALSA</div>
<p>
(This section is a lightly edited copy of some notes Fernando sent me).
The default ALSA device in Snd is "default". This virtual device tries to play sounds at any sampling rate,
-provide any number of input channels, handle data format conversions, and so on. Experts will probably
+provide any number of input channels, handle sample type conversions, and so on. Experts will probably
want to use the "hw:0" device instead (this is the first hardware device; "hw:1" is the second, and so on),
but in that case, ALSA provides only whatever sampling rates the hardware provides.
To change the device, or the internal buffering amounts, you can either set up environment
variables, or use the parallel Scheme/Ruby/Forth variables mus-alsa-*. The environment
variables are:
</p>
-<table hspace=20>
-<tr><td width=250>MUS_ALSA_PLAYBACK_DEVICE</td><td>name of playback device ("default")</td></tr>
-<tr><td>MUS_ALSA_CAPTURE_DEVICE</td><td>name of capture (recording) device ("default")</td></tr>
-<tr><td>MUS_ALSA_DEVICE</td><td>name of the playback and capture device ("sndlib")</td></tr>
-<tr><td>MUS_ALSA_BUFFERS</td><td>number of "periods" (buffers) used</td></tr>
-<tr><td>MUS_ALSA_BUFFER_SIZE</td><td>number of samples per channel per buffer</td></tr>
-</table>
+
+<pre class="indented">
+MUS_ALSA_PLAYBACK_DEVICE name of playback device ("default")
+MUS_ALSA_CAPTURE_DEVICE name of capture (recording) device ("default")
+MUS_ALSA_DEVICE name of the playback and capture device ("sndlib")
+MUS_ALSA_BUFFERS number of "periods" (buffers) used
+MUS_ALSA_BUFFER_SIZE number of samples per channel per buffer
+</pre>
+
<p>
These can be set either in your shell initialization file (~/.cshrc for tcsh), or in the
shell:
</p>
-<pre>
- setenv MUS_ALSA_DEVICE "hw:0" ; tcsh
- MUS_ALSA_DEVICE="hw:0" ; bash
+
+<pre class="indented">
+setenv MUS_ALSA_DEVICE "hw:0" ; tcsh
+MUS_ALSA_DEVICE="hw:0" ; bash
</pre>
+
<p>
or run Snd with a temporary setting:
</p>
-<pre>
- MUS_ALSA_DEVICE="plughw:0" snd somefile.wav
+
+<pre class="indented">
+MUS_ALSA_DEVICE="plughw:0" snd somefile.wav
</pre>
+
<p>
The parallel variables (for ~/.snd and friends, or at any time in the listener), are:
</p>
-<table hspace=20>
-<tr><td width=250>mus-alsa-playback-device</td><td>name of playback device ("default")</td></tr>
-<tr><td>mus-alsa-capture-device</td><td>name of capture (recording) device ("default")</td></tr>
-<tr><td>mus-alsa-device</td><td>name of the playback and capture device ("sndlib")</td></tr>
-<tr><td>mus-alsa-buffers</td><td>number of "periods" (buffers) used</td></tr>
-<tr><td>mus-alsa-buffer-size</td><td>number of samples per channel per buffer</td></tr>
-</table>
-<p>
-So, to use the "plughw" device, we could:
-</p>
-<pre>
- (set! (mus-alsa-device) "plughw:0")
-</pre>
-<p>
-Similarly, if you know which device you want to record from (say your arecord command is
-"arecord -D hw:0.2"), you can tell Snd's recorder to use that device via:
-</p>
-<pre>
- setenv MUS_ALSA_CAPTURE_DEVICE "hw:0.2"
+
+<pre class="indented">
+mus-alsa-playback-device name of playback device ("default")
+mus-alsa-capture-device name of capture (recording) device ("default")
+mus-alsa-device name of the playback and capture device ("sndlib")
+mus-alsa-buffers number of "periods" (buffers) used
+mus-alsa-buffer-size number of samples per channel per buffer
</pre>
+
<p>
-or
+So, to use the "plughw" device, we could:
</p>
-<pre>
- (set! (mus-alsa-capture-device) "hw:0.2")
+
+<pre class="indented">
+(set! (mus-alsa-device) "plughw:0")
</pre>
+
<p>It's also possible to define your own device, apparently, but that part
of ALSA is beyond my ken.
</p>
-<br>
+
+
<!-- INDEX sndandjack:Jack -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndandjack">Snd and Jack</a></h3></td></tr></table>
+
+<div class="innerheader" id="sndandjack">Snd and Jack</div>
<p>(This section is from Kjetil Matheussen).
</p>
-<table hspace=20>
-<tr><td width=300>
-SNDLIB_JACK_DONT_AUTOCONNECT</td><td>If set, snd won't autoconnect jack ports
-</td></tr>
-<tr><td>
-SNDLIB_NUM_JACK_CHANNELS</td><td>Number of in and out jack ports created by snd
-</td></tr>
-</table>
+<pre class="indented">
+SNDLIB_JACK_DONT_AUTOCONNECT If set, snd won't autoconnect jack ports
+SNDLIB_NUM_JACK_CHANNELS Number of in and out jack ports created by snd
+</pre>
+
-<br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndandgl">Snd and OpenGL</a></h3></td></tr></table>
+<div class="innerheader" id="sndandgl">Snd and OpenGL</div>
<p>Snd with Motif can be used in conjunction with OpenGL. If it is configured
with the switch --with-gl or --with-just-gl, the top level Snd shell
@@ -2231,7 +2182,9 @@ dialog or <a href="extsnd.html#colormap">colormap</a>, and the
various spectro-*
variables.
</p>
-<img src="pix/nowgl.png" alt="gl" hspace=20>
+
+<img src="pix/nowgl.png" alt="gl">
+
<p>
The GL-to-Scheme bindings are in gl.c, and follow the same name and type
conventions of the Motif bindings in xm.c.
@@ -2239,10 +2192,11 @@ Any of the Snd drawing area widgets (or your own) can receive GL graphics
commands. Here is a translation of the SGI/xjournal glxmotif
program:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+
+<pre class="indented">
(define (draw-it)
- (glXMakeCurrent (XtDisplay (cadr (<a class=quiet href="extsnd.html#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>)))
- (XtWindow (car (<a class=quiet href="extsnd.html#channelwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelwidgets_tip)">channel-widgets</a>)))
+ (glXMakeCurrent (XtDisplay (cadr (<a class=quiet href="extsnd.html#mainwidgets">main-widgets</a>)))
+ (XtWindow (car (<a class=quiet href="extsnd.html#channelwidgets">channel-widgets</a>)))
(snd-glx-context)) ; the GL context
(glEnable GL_DEPTH_TEST)
(glDepthFunc GL_LEQUAL)
@@ -2252,8 +2206,8 @@ program:
(gluPerspective 40.0 1.0 10.0 200.0)
(glTranslatef 0.0 0.0 -50.0)
(glRotatef -58.0 0.0 1.0 0.0)
- (let ((vals (XtVaGetValues (car (<a class=quiet href="extsnd.html#channelwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelwidgets_tip)">channel-widgets</a>)) (list XmNwidth 0 XmNheight 0))))
- (glViewport 0 0 (list-ref vals 1) (list-ref vals 3)))
+ (let ((vals (XtVaGetValues (car (<a class=quiet href="extsnd.html#channelwidgets">channel-widgets</a>)) (list XmNwidth 0 XmNheight 0))))
+ (glViewport 0 0 (vals 1) (vals 3)))
(glClear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
(glBegin GL_POLYGON)
(glColor3f 0.0 0.0 0.0) (glVertex3f -10.0 -10.0 0.0)
@@ -2271,229 +2225,196 @@ program:
(glColor3f 0.0 0.0 1.0) (glVertex3f 4.0 -9.0 -10.0)
(glColor3f 1.0 0.0 1.0) (glVertex3f 4.0 -6.0 -10.0)
(glEnd)
- (glXSwapBuffers (XtDisplay (cadr (<a class=quiet href="extsnd.html#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>)))
- (XtWindow (car (<a class=quiet href="extsnd.html#channelwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelwidgets_tip)">channel-widgets</a>))))
+ (glXSwapBuffers (XtDisplay (cadr (<a class=quiet href="extsnd.html#mainwidgets">main-widgets</a>)))
+ (XtWindow (car (<a class=quiet href="extsnd.html#channelwidgets">channel-widgets</a>))))
(glFlush))
-</pre></td></tr></table>
+</pre>
<p>See snd-gl.scm. To turn these graphs into Postscript files, include the --with-gl2ps switch
at configuration time, and use the <a href="extsnd.html#glgraphtops">gl-graph->ps</a> function.
</p>
-<br><br>
-<!-- ---------------------------------------- GSL ---------------------------------------- -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndandgsl">Snd and GSL</a></h3></td></tr></table>
+<div class="innerheader" id="sndandgsl">Snd and GSL</div>
<p>If the GSL library is available, the following functions are imported into Snd:
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
-
-<!-- gsl-dht -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>gsl-dht</em> <code>size data nu xmax</code>
-</td></tr><tr><td width=60></td><td>
-gsl-dht performs the Hankel transform of "data", a vct. See <a href="extsnd.html#addtransform">add-transform</a>
-for an example.
-</td></tr><tr><td colspan=2 height=16></td></tr>
<!-- gsl-eigenvectors -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>gsl-eigenvectors</em> <code>matrix</code>
-</td></tr><tr><td width=60></td><td>
-gsl-eigenvectors returns the eigenvalues and corresponding eigenvectors of "matrix", a mixer.
-
-<pre>
-><em class=typing>(gsl-eigenvectors (make-mixer 4 -1.0 1.0 -1.0 1.0
- -8.0 4.0 -2.0 1.0
- 27.0 9.0 3.0 1.0
- 64.0 16.0 4.0 1.0))</em>
-<em class=listener>(#(-6.41391102627093 5.54555349890946 5.54555349890946 2.32280402845201)
-#(#(-0.0998821746683654 -0.111251309674367 0.292500673281302 0.94450518972065)
- #(-0.0434869537653505 0.0642376994169207 -0.515252756143484 -0.840592191366022)
- #(-0.0434869537653505 0.0642376994169207 -0.515252756143484 -0.840592191366022)
- #(-0.144932944248023 0.356601443087312 0.91936884368837 0.0811836295983152)))</em>
-</pre>
-
+<div class="bluish"><em class=emdef>gsl-eigenvectors</em> <code>matrix</code></div>
+<p>
+gsl-eigenvectors returns the eigenvalues and corresponding eigenvectors of "matrix", a float-vector in s7, a vct otherwise.
The value returned is a list of two elements. The first is a vector containing
the eigenvalues, the second is a vector containing the corresponding eigenvectors (as vectors).
-See make-dpss-window in snd-test.scm (the corresponding C code is in clm.c).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
<!-- gsl-elliptk -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>gsl-ellipk</em> <code>k</code><br>
+<div class="bluish"><em class=emdef>gsl-ellipk</em> <code>k</code><br>
<em class=emdef>gsl-ellipj</em> <code>j u m</code>
-</td></tr><tr><td width=60></td><td>
+</div>
+<p>
These are calls on the functions gsl_sf_ellint_Kcomp and gsl_sf_elljac_e. See the elliptic filter code in
analog-filter.scm for an example.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+
<!-- gsl-roots -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>gsl-roots</em> <code>poly</code>
-</td></tr><tr><td width=60></td><td>
+<div class="bluish"><em class=emdef>gsl-roots</em> <code>poly</code></div>
+<p>
This returns the roots of the polynomial "poly" via gsl_poly_complex_solve. See analog-filter.scm for an example.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-</table>
+</p>
-<br><br>
-<!-- ---------------------------------------- GMP, MPFR, MPC ---------------------------------------- -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndandgmp">Snd and multiprecision arithmetic</a></h3></td></tr></table>
+<div class="innerheader" id="sndandgmp">Snd and multiprecision arithmetic</div>
<p>Multiprecision arithmetic for integer, ratio, real, and complex numbers is available
in Snd via the gmp, mpfr, and mpc libraries and s7. Use the --with-gmp configuration
switch. This version of s7 also supplies the functions:
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
<!-- bignum -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>bignum</em> <code>num</code>
-</td></tr><tr><td width=60></td><td>
+<div class="bluish"><em class=emdef>bignum</em> <code>num</code></div>
+
<p>bignum converts its argument (a string) into a big number. This is the most convenient
way to force a calculation to use big numbers.
</p>
-<pre>
- <em class=listener>:</em><em class=typing>(sqrt 2)</em>
- <em class=listener>1.4142135623731</em>
- <em class=listener>:</em><em class=typing>(sqrt (bignum "2"))</em>
- <em class=listener>1.414213562373095048801688724209698078569E0</em>
+
+<pre class="indented">
+> (sqrt 2)
+1.4142135623731
+> (sqrt (bignum "2"))
+1.414213562373095048801688724209698078569E0
</pre>
+
<p>
s7 uses normal C arithmetic unless something causes it to be suspicious.
Since a number like 1.2345e-14 does not trigger an underflow in C,
and is short (it's written with less than 20 characters), s7 trusts it even in a case
such as:
</p>
-<pre>
- :(+ 1.2345e-15 1.0 -1.0)
- 1.3322676295502e-15
+
+<pre class="indented">
+> (+ 1.2345e-15 1.0 -1.0)
+1.3322676295502e-15
</pre>
+
<p>In any case like this where C doubles are going to lose, you can force
big float arithmetic by making one of the operands a bignum:
</p>
-<pre>
- :(+ (bignum "1.2345e-15") 1.0 -1.0)
- 1.234500000000000042481989819014552503046E-15
+
+<pre class="indented">
+> (+ (bignum "1.2345e-15") 1.0 -1.0)
+1.234500000000000042481989819014552503046E-15
</pre>
+
<p>There are lots of similar cases:
</p>
-<pre>
- :(* 2e-170 3e-170 4e+170 5e+170)
- 0.0
- :(* (bignum "2e-170") 3e-170 4e+170 5e+170)
- 1.200000000000000019643628722298292475697E2
+
+<pre class="indented">
+> (* 2e-170 3e-170 4e+170 5e+170)
+0.0
+> (* (bignum "2e-170") 3e-170 4e+170 5e+170)
+1.200000000000000019643628722298292475697E2
</pre>
+
<p>but presumably you know when you're using these kinds
of numbers.
</p>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
<!-- bignum? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>bignum?</em> <code>num</code>
-</td></tr><tr><td width=60></td><td>
+<div class="bluish"><em class=emdef>bignum?</em> <code>num</code></div>
+
<p>bignum? returns #t if its argument is a big number.
</p>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
<!-- bignum-fft -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>bignum-fft</em> <code>rl im size <em class=narg>sign</em></code>
-</td></tr><tr><td width=60></td><td>
+<div class="bluish"><em class=emdef>bignum-fft</em> <code>rl im size <em class=narg>sign</em></code></div>
+<p>
bignum-fft performs an FFT using big floats; rl and im are vectors of big floats.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
<!-- bignum-precision -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>bignum-precision</em> <code></code>
-</td></tr><tr><td width=60></td><td>
+<div class="bluish"><em class=emdef>(*s7* 'bignum-precision)</em> <code></code></div>
+
<p>bignum-precision sets the number of bits used in floating-point big numbers (integer
bignums have whatever size it takes to represent them). The default is 128 which gives
about 40 decimal digits.
</p>
-<pre>
- <em class=listener>:</em><em class=typing>(* 2 pi)</em>
- <em class=listener>6.283185307179586476925286766559005768391E0</em>
- <em class=listener>:</em><em class=typing>(set! (bignum-precision) 256)</em>
- <em class=listener>256</em>
- <em class=listener>:</em><em class=typing>(* 2 pi)</em>
- <em class=listener>6.283185307179586476925286766559005768394338798750211641949889184615632812572396E0</em>
+
+<pre class="indented">
+> (* 2 pi)
+6.283185307179586476925286766559005768391E0
+> (set! (*s7* 'bignum-precision) 256)
+256
+> (* 2 pi)
+6.283185307179586476925286766559005768394338798750211641949889184615632812572396E0
</pre>
+
<p>If a big float is so large that the current bignum-precision has to approximate it,
you can get confusing results:
</p>
-<pre>
- :(rationalize 385817946978768113605842402465609185854927496022065152.5)
- 385817946978768113605842402465609185854927496022065152
- :(set! (bignum-precision) 512)
- 512
- :(rationalize 385817946978768113605842402465609185854927496022065152.5)
- 771635893957536227211684804931218371709854992044130305/2
+
+<pre class="indented">
+> (rationalize 385817946978768113605842402465609185854927496022065152.5)
+385817946978768113605842402465609185854927496022065152
+> (set! (*s7* 'bignum-precision) 512)
+512
+> (rationalize 385817946978768113605842402465609185854927496022065152.5)
+771635893957536227211684804931218371709854992044130305/2
</pre>
+
<p>Yet another source of confusion involves the conversion of the string representation
of a bigfloat:
</p>
-<pre>
- :(bignum "0.1")
- 1.000000000000000055511151231257827021182E-1
- :(/ (bignum "1.0") 10)
- 1.000000000000000000000000000000000000001E-1
+
+<pre class="indented">
+> (bignum "0.1")
+1.000000000000000055511151231257827021182E-1
+> (/ (bignum "1.0") 10)
+1.000000000000000000000000000000000000001E-1
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-</table>
-<p>I think I'll eventually add bignum versions of all the CLM generators. Here, for example,
-is a bigfloat oscil:
-</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(defgenerator (big-oscil
- :make-wrapper
- (lambda (g)
- (set! (big-oscil-frequency g) (/ (* (big-oscil-frequency g) 2.0 pi) (mus-srate)))
- g))
- (frequency *clm-default-frequency*) (angle 0.0))
-
-(define* (big-oscil gen (fm 0.0) (pm 0.0))
- (let ((x (big-oscil-angle gen)))
- (set! (big-oscil-angle gen) (+ fm x (big-oscil-frequency gen)))
- (sin (+ x pm))))
-</pre>
-</td></tr></table>
+<div class="header" id="otherstuff">Other stuff</div>
-<p>Ideally, the run macro would know how to handle bignums (and complex numbers).
-But, one thing at a time...
+<p>lint.scm is a lint program for s7 scheme.
</p>
-<br><br>
+<p>primes.scm is a list of primes for the <a href="sndscm.html#peakphasesdoc">peak phases</a> functions.
+</p>
+
+<p>The tools directory has several things that might be of interest. sam.c is a
+Samson box emulator. crossref.c is a cross-referencer for the Snd sources.
+xgdata.scm and makexg.scm create xg.c,
+the Gtk bindings. Similarly gldata.scm and makegl.scm create gl.c, the OpenGL bindings. make-index.scm
+creates index.html, the overall Snd index, and performs a lot of HTML error checks.
+snd.supp is the suppressions list for valgrind. table.scm creates the table of contents
+at the start of snd-test.scm. The other files in the tools directory are intended
+for semi-automatic regression testing.
+</p>
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="extsnd.html">extsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="fm.html">fm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
-</body></html>
+</body>
+</html>
diff --git a/gtk-effects-utils.scm b/gtk-effects-utils.scm
index 6e773b5..0fb0eb7 100644
--- a/gtk-effects-utils.scm
+++ b/gtk-effects-utils.scm
@@ -1,17 +1,13 @@
-(if (not (provided? 'xg))
- (let ((hxm (dlopen "xg.so")))
- (if (string? hxm)
- (snd-error (format #f "gtk-effects.scm needs the xg module (either 'make xg' or build Snd with --with-static-xg): ~A" hxm))
- (dlinit hxm "Init_libxg"))))
-
-(if (not (provided? 'snd-gtk)) (snd-error "gtk-effects-utils.scm is Gtk-specific"))
+(require snd-gtk)
(provide 'snd-gtk-effects-utils.scm)
+(with-let *gtk*
+
(if (not (defined? 'all-chans))
(define (all-chans)
- (let ((sndlist '())
- (chnlist '()))
+ (let ((sndlist ())
+ (chnlist ()))
(for-each (lambda (snd)
(do ((i (- (channels snd) 1) (- i 1)))
((< i 0))
@@ -21,14 +17,14 @@
(list sndlist chnlist))))
(define (update-label effects)
- (if (not (null? effects))
+ (if (pair? effects)
(begin
((car effects))
(update-label (cdr effects)))))
(define (effect-target-ok target)
(if (eq? target 'sound)
- (not (null? (sounds)))
+ (pair? (sounds))
(if (eq? target 'selection)
(selection?)
(and (selected-sound)
@@ -37,15 +33,12 @@
(define* (make-effect-dialog label ok-callback help-callback reset-callback target-ok-callback)
;; make a standard dialog
;; callbacks take 2 args: widget data
- (let* ((dismiss-button (gtk_button_new_with_label "Go Away"))
- (help-button (gtk_button_new_with_label "Help"))
- (ok-button (gtk_button_new_with_label "DoIt"))
- (reset-button (if reset-callback (gtk_button_new_with_label "Reset") #f))
- (new-dialog (gtk_dialog_new)))
- (gtk_widget_set_name dismiss-button "quit_button")
- (gtk_widget_set_name help-button "help_button")
- (gtk_widget_set_name ok-button "doit_button")
- (gtk_widget_set_name reset-button "reset_button")
+ (let ((new-dialog (gtk_dialog_new))
+ (dismiss-button #f)
+ (help-button #f)
+ (ok-button #f)
+ (reset-button #f))
+
(gtk_window_set_title (GTK_WINDOW new-dialog) label)
(gtk_container_set_border_width (GTK_CONTAINER new-dialog) 10)
(gtk_window_set_default_size (GTK_WINDOW new-dialog) -1 -1)
@@ -56,31 +49,39 @@
(gtk_widget_hide new-dialog)
#t) ; this is crucial -- thanks to Kjetil for catching it!
#f)
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG new-dialog))) dismiss-button #t #t 20)
+
+ (set! dismiss-button (gtk_dialog_add_button (GTK_DIALOG new-dialog) "Go Away" GTK_RESPONSE_NONE))
(g_signal_connect dismiss-button "clicked" (lambda (w data) (gtk_widget_hide new-dialog)) #f)
(gtk_widget_show dismiss-button)
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG new-dialog))) ok-button #t #t 20)
+
+ (set! ok-button (gtk_dialog_add_button (GTK_DIALOG new-dialog) "DoIt" GTK_RESPONSE_NONE))
(g_signal_connect ok-button "clicked" ok-callback #f)
(gtk_widget_show ok-button)
- (if reset-button
+
+ (if reset-callback
(begin
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG new-dialog))) reset-button #t #t 20)
+ (set! reset-button (gtk_dialog_add_button (GTK_DIALOG new-dialog) "Reset" GTK_RESPONSE_NONE))
(g_signal_connect reset-button "clicked" reset-callback #f)
+ (gtk_widget_set_name reset-button "reset_button")
(gtk_widget_show reset-button)))
- (gtk_box_pack_end (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG new-dialog))) help-button #t #t 20)
+
+ (set! help-button (gtk_dialog_add_button (GTK_DIALOG new-dialog) "Help" GTK_RESPONSE_NONE))
(g_signal_connect help-button "clicked" help-callback #f)
(gtk_widget_show help-button)
- ;; build rest in (gtk_dialog_get_content_area (GTK_DIALOG new-dialog))
+
+ (gtk_widget_set_name dismiss-button "quit_button")
+ (gtk_widget_set_name help-button "help_button")
+ (gtk_widget_set_name ok-button "doit_button")
(if target-ok-callback
(begin
(gtk_widget_set_sensitive ok-button (target-ok-callback))
(hook-push effects-hook
- (lambda () (gtk_widget_set_sensitive ok-button (target-ok-callback)))))
+ (lambda (hook) (gtk_widget_set_sensitive ok-button (target-ok-callback)))))
(begin
- (gtk_widget_set_sensitive ok-button (not (null? (sounds))))
+ (gtk_widget_set_sensitive ok-button (pair? (sounds)))
(hook-push effects-hook
- (lambda () (gtk_widget_set_sensitive ok-button (not (null? (sounds))))))))
+ (lambda (hook) (gtk_widget_set_sensitive ok-button (pair? (sounds)))))))
(g_object_set_data (G_OBJECT new-dialog) "ok-button" (GPOINTER ok-button))
new-dialog))
@@ -98,18 +99,17 @@
(define (scale-log->linear lo val hi)
;; given user-relative low..val..hi return val as scale-relative (0..log-scale-ticks)
- (let* ((log2 (log 2.0)) ; using log 2 here to get equally spaced octaves
- (log-lo (/ (log (max lo 1.0)) log2))
- (log-hi (/ (log hi) log2))
- (log-val (/ (log val) log2)))
+ (let (;; using log 2 here to get equally spaced octaves
+ (log-lo (log (max lo 1.0) 2))
+ (log-hi (log hi 2))
+ (log-val (log val 2)))
(floor (* log-scale-ticks (/ (- log-val log-lo) (- log-hi log-lo))))))
(define (scale-linear->log lo val hi)
;; given user-relative lo..hi and scale-relative val, return user-relative val
;; since log-scale widget assumes 0..log-scale-ticks, val can be used as ratio (log-wise) between lo and hi
- (let* ((log2 (log 2.0))
- (log-lo (/ (log (max lo 1.0)) log2))
- (log-hi (/ (log hi) log2))
+ (let* ((log-lo (log (max lo 1.0) 2))
+ (log-hi (log hi 2))
(log-val (+ log-lo (* (/ val log-scale-ticks) (- log-hi log-lo)))))
(expt 2.0 log-val)))
@@ -119,29 +119,29 @@
(define (add-sliders dialog sliders)
;; sliders is a list of lists, each inner list being (title low initial high callback scale ['log])
;; returns list of widgets (for reset callbacks)
- (let* ((mainform (gtk_vbox_new #f 2))
+ (let* ((mainform (gtk_box_new GTK_ORIENTATION_VERTICAL 2))
(use-hbox (= (length sliders) 1))
- (table (if (not use-hbox) (gtk_table_new 2 (length sliders) #f)))
+ (table (if (not use-hbox) (gtk_grid_new)))
(slider 0))
(gtk_box_pack_start (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG dialog))) mainform #f #f 4)
(gtk_widget_show mainform)
(if (not use-hbox)
(begin
(gtk_box_pack_start (GTK_BOX mainform) table #f #f 4)
- (gtk_table_set_row_spacings (GTK_TABLE table) 4)
- (gtk_table_set_col_spacings (GTK_TABLE table) 4)
+ (gtk_grid_set_row_spacing (GTK_GRID table) 4)
+ (gtk_grid_set_column_spacing (GTK_GRID table) 4)
(gtk_widget_show table)))
(map
(lambda (slider-data)
- (let* ((title (list-ref slider-data 0))
- (low (list-ref slider-data 1))
- (initial (list-ref slider-data 2))
- (high (list-ref slider-data 3))
- (func (list-ref slider-data 4))
- (scaler (list-ref slider-data 5))
+ (let* ((title (slider-data 0))
+ (low (slider-data 1))
+ (initial (slider-data 2))
+ (high (slider-data 3))
+ (func (slider-data 4))
+ (scaler (slider-data 5))
(use-log (and (= (length slider-data) 7)
- (eq? (list-ref slider-data 6) 'log)))
- (hbox (and use-hbox (gtk_hbox_new #f 0)))
+ (eq? (slider-data 6) 'log)))
+ (hbox (and use-hbox (gtk_box_new GTK_ORIENTATION_HORIZONTAL 0)))
(label (gtk_label_new
(if use-hbox
(if use-log
@@ -153,18 +153,15 @@
(adj (if use-log
(gtk_adjustment_new (scale-log->linear low initial high) 0 log-scale-ticks 1 10 1)
(gtk_adjustment_new initial low high 0.0 0.0 0.0)))
- (scale (gtk_hscale_new (GTK_ADJUSTMENT adj))))
+ (scale (gtk_scale_new GTK_ORIENTATION_HORIZONTAL (GTK_ADJUSTMENT adj))))
(if use-hbox
(begin
(gtk_box_pack_start (GTK_BOX mainform) hbox #f #f 2)
(gtk_widget_show hbox)
(gtk_box_pack_start (GTK_BOX hbox) label #f #f 6))
- (gtk_table_attach (GTK_TABLE table) label 0 1 slider (+ 1 slider)
- (logior GTK_FILL GTK_SHRINK)
- (logior GTK_FILL GTK_SHRINK)
- 0 0))
+ (gtk_grid_attach (GTK_GRID table) label 0 slider 1 1)
+ )
(gtk_widget_show label)
- (if (not (provided? 'gtk3)) (gtk_range_set_update_policy (GTK_RANGE (GTK_SCALE scale)) GTK_UPDATE_CONTINUOUS))
(gtk_scale_set_digits (GTK_SCALE scale)
(if use-log
0
@@ -173,10 +170,8 @@
(if use-hbox
(gtk_box_pack_start (GTK_BOX hbox) scale #t #t 0)
(begin
- (gtk_table_attach (GTK_TABLE table) scale 1 2 slider (+ 1 slider)
- (logior GTK_FILL GTK_EXPAND GTK_SHRINK)
- (logior GTK_FILL GTK_EXPAND GTK_SHRINK)
- 0 0)
+ (gtk_widget_set_hexpand (GTK_WIDGET scale) #t)
+ (gtk_grid_attach (GTK_GRID table) scale 1 slider 1 1)
(set! slider (+ 1 slider))))
(gtk_widget_show scale)
(if use-log
@@ -196,3 +191,4 @@
(gtk_widget_show w)
(gtk_window_present (GTK_WINDOW w)))
+)
diff --git a/gtk-effects.scm b/gtk-effects.scm
index 6e23152..e5cc927 100644
--- a/gtk-effects.scm
+++ b/gtk-effects.scm
@@ -1,2942 +1,2751 @@
;;; translation of new-effects.scm to gtk/xg
-(if (not (provided? 'xg))
- (let ((hxm (dlopen "xg.so")))
- (if (string? hxm)
- (snd-error (format #f "gtk-effects.scm needs the xg module (either 'make xg' or build Snd with --with-static-xg): ~A" hxm))
- (dlinit hxm "Init_libxg"))))
-
-(if (not (provided? 'snd-gtk)) (snd-error "gtk-effects.scm is Gtk-specific"))
-
(provide 'snd-gtk-effects.scm)
+(require snd-gtk snd-gtk-effects-utils.scm snd-xm-enved.scm snd-moog.scm snd-rubber.scm snd-dsp.scm)
-(if (not (provided? 'snd-gtk-effects-utils.scm)) (load "gtk-effects-utils.scm"))
-(if (not (provided? 'snd-xm-enved.scm)) (load "xm-enved.scm"))
-(if (not (provided? 'snd-moog.scm)) (load "moog.scm"))
-(if (not (provided? 'snd-rubber.scm)) (load "rubber.scm"))
-(if (not (provided? 'snd-dsp.scm)) (load "dsp.scm"))
-
-(define (plausible-mark-samples)
- ;; find two marks in the current channel (in or nearest to current window)
- (let* ((snd (selected-sound))
- (chn (selected-channel))
- (ms (sort! (map mark-sample (marks snd chn)) <)))
- (if (< (length ms) 2)
- (throw 'no-such-mark (list "mark-related action requires two marks"))
- (if (= (length ms) 2)
- ms
- (let* ((lw (left-sample snd chn))
- (rw (right-sample snd chn))
- (cw (cursor snd chn))
- (favor (if (and (>= cw lw)
- (<= cw rw))
- cw
- (* .5 (+ lw rw)))))
- ;; favor is the point we center the search on
- (define (centered-points points)
- (if (= (length points) 2)
- points
- (let ((p1 (car points))
- (p2 (cadr points))
- (p3 (caddr points)))
- (if (< (abs (- p1 favor)) (abs (- p3 favor)))
- (list p1 p2)
- (centered-points (cdr points))))))
- (centered-points ms))))))
-
-(define map-chan-over-target-with-sync
- ;; target: 'marks -> beg=closest marked sample, dur=samples to next mark
- ;; 'sound -> beg=0, dur=all samples in sound
- ;; 'selection -> beg=selection-position, dur=selection-frames
- ;; 'cursor -> beg=cursor, dur=samples to end of sound
- ;; decay is how long to run the effect past the end of the sound
- (lambda (func target origin decay)
- (if (and (eq? target 'selection)
- (not (selection?)))
- (snd-print ";no selection")
- (if (and (eq? target 'sound)
- (null? (sounds)))
- (snd-print ";no sound")
- (if (and (eq? target 'marks)
- (or (null? (sounds))
- (< (length (marks (selected-sound) (selected-channel))) 2)))
- (snd-print ";no marks")
- (let* ((snc (sync))
- (ms (and (eq? target 'marks)
- (plausible-mark-samples)))
- (beg (if (eq? target 'sound)
- 0
- (if (eq? target 'selection)
- (selection-position)
- (if (eq? target 'cursor)
- (cursor (selected-sound) (selected-channel))
- (car ms)))))
- (overlap (if decay
- (floor (* (srate) decay))
- 0)))
- (apply for-each
- (lambda (snd chn)
- (let ((end (if (or (eq? target 'sound)
- (eq? target 'cursor))
- (- (frames snd chn) 1)
- (if (eq? target 'selection)
- (+ (selection-position) (selection-frames))
- (cadr ms)))))
- (if (= (sync snd) snc)
- (map-channel (func (- end beg)) beg (+ end overlap 1) snd chn #f
- (format #f "~A ~A ~A"
- (origin target (- end beg))
- (if (eq? target 'sound) 0 beg)
- (if (eq? target 'sound) #f (+ 1 (- end beg))))))))
-
- (if (> snc 0)
- (all-chans)
- (list (list (selected-sound))
- (list (selected-channel)))))))))))
-
-
-(define (add-target mainform target-callback truncate-callback)
- ;; add a set of 3 radio buttons at the bottom of the main section for choice between sound, selection, between-marks
- ;; target-callback should take one arg, a symbol: 'sound, 'selection, 'marks, and apply the effect accordingly (upon "DoIt")
- ;; truncate-callback (if any) takes one arg: boolean representing toggle state (#t = on)
- (let (;(sep (gtk_hseparator_new))
- (rc (gtk_hbox_new #f 0)))
- (gtk_box_pack_start (GTK_BOX mainform) rc #f #f 4)
- ;(gtk_box_pack_start (GTK_BOX rc) sep #t #t 4)
- ;(gtk_widget_show sep)
- (gtk_widget_show rc)
-
- (let ((group #f))
- (for-each
- (lambda (name type on)
- (let ((button (gtk_radio_button_new_with_label group name)))
- (set! group (gtk_radio_button_get_group (GTK_RADIO_BUTTON button)))
- (gtk_box_pack_start (GTK_BOX rc) button #f #f 4)
- (gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON button) on)
- (gtk_widget_show button)
- (g_signal_connect button "clicked" (lambda (w d) (target-callback type)) #f)))
- (list "entire sound" "selection" "between marks")
- (list 'sound 'selection 'marks)
- (list #t #f #f)))
-
- (if truncate-callback
- (let ((sep (gtk_hseparator_new))
- (button (gtk_check_button_new_with_label "truncate at end")))
- (gtk_box_pack_start (GTK_BOX rc) sep #t #t 4)
- (gtk_widget_show sep)
- (gtk_box_pack_start (GTK_BOX rc) button #t #t 4)
- (gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON button) #t)
- (gtk_widget_show button)
- (g_signal_connect button "clicked" (lambda (w d) (truncate-callback (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON w)))) #f)))))
-
-(define (effect-frames target)
- (if (eq? target 'sound)
- (- (frames) 1)
- (if (eq? target 'selection)
- (selection-frames)
- (+ 1 (abs (apply - (plausible-mark-samples)))))))
-
-
+(with-let (sublet *gtk*)
+
+ (define (plausible-mark-samples)
+ ;; find two marks in the current channel (in or nearest to current window)
+ (let* ((snd (selected-sound))
+ (chn (selected-channel))
+ (ms (sort! (map mark-sample (marks snd chn)) <)))
+ (if (< (length ms) 2)
+ (error 'no-such-mark (list "mark-related action requires two marks"))
+ (if (= (length ms) 2)
+ ms
+ (let* ((lw (left-sample snd chn))
+ (rw (right-sample snd chn))
+ (cw (cursor snd chn))
+ (favor (if (>= rw cw lw)
+ cw
+ (* .5 (+ lw rw)))))
+ ;; favor is the point we center the search on
+ (define (centered-points points)
+ (if (= (length points) 2)
+ points
+ (let ((p1 (car points))
+ (p2 (cadr points))
+ (p3 (caddr points)))
+ (if (< (abs (- p1 favor)) (abs (- p3 favor)))
+ (list p1 p2)
+ (centered-points (cdr points))))))
+ (centered-points ms))))))
+
+ (define map-chan-over-target-with-sync
+ ;; target: 'marks -> beg=closest marked sample, dur=samples to next mark
+ ;; 'sound -> beg=0, dur=all samples in sound
+ ;; 'selection -> beg=selection-position, dur=selection-framples
+ ;; 'cursor -> beg=cursor, dur=samples to end of sound
+ ;; decay is how long to run the effect past the end of the sound
+ (lambda (func target origin decay)
+ (if (and (eq? target 'selection)
+ (not (selection?)))
+ (snd-print ";no selection")
+ (if (and (eq? target 'sound)
+ (null? (sounds)))
+ (snd-print ";no sound")
+ (if (and (eq? target 'marks)
+ (or (null? (sounds))
+ (< (length (marks (selected-sound) (selected-channel))) 2)))
+ (snd-print ";no marks")
+ (let* ((snc (sync))
+ (ms (and (eq? target 'marks)
+ (plausible-mark-samples)))
+ (beg (if (eq? target 'sound)
+ 0
+ (if (eq? target 'selection)
+ (selection-position)
+ (if (eq? target 'cursor)
+ (cursor (selected-sound) (selected-channel))
+ (car ms)))))
+ (overlap (if decay
+ (floor (* (srate) decay))
+ 0)))
+ (apply for-each
+ (lambda (snd chn)
+ (let ((end (if (memq target '(sound cursor))
+ (- (framples snd chn) 1)
+ (if (eq? target 'selection)
+ (+ (selection-position) (selection-framples))
+ (cadr ms)))))
+ (if (= (sync snd) snc)
+ (map-channel (func (- end beg)) beg (+ end overlap 1) snd chn #f
+ (format #f "~A ~A ~A"
+ (origin target (- end beg))
+ (if (eq? target 'sound) 0 beg)
+ (and (not (eq? target 'sound)) (+ 1 (- end beg))))))))
+
+ (if (> snc 0)
+ (all-chans)
+ (list (list (selected-sound))
+ (list (selected-channel)))))))))))
+
+
+ (define (add-target mainform target-callback truncate-callback)
+ ;; add a set of 3 radio buttons at the bottom of the main section for choice between sound, selection, between-marks
+ ;; target-callback should take one arg, a symbol: 'sound, 'selection, 'marks, and apply the effect accordingly (upon "DoIt")
+ ;; truncate-callback (if any) takes one arg: boolean representing toggle state (#t = on)
+ (let (;(sep (gtk_separator_new GTK_ORIENTATION_HORIZONTAL))
+ (rc (gtk_box_new GTK_ORIENTATION_HORIZONTAL 0)))
+ (gtk_box_pack_start (GTK_BOX mainform) rc #f #f 4)
+ ;(gtk_box_pack_start (GTK_BOX rc) sep #t #t 4)
+ ;(gtk_widget_show sep)
+ (gtk_widget_show rc)
+
+ (let ((group #f))
+ (for-each
+ (lambda (name type on)
+ (let ((button (gtk_radio_button_new_with_label group name)))
+ (set! group (gtk_radio_button_get_group (GTK_RADIO_BUTTON button)))
+ (gtk_box_pack_start (GTK_BOX rc) button #f #f 4)
+ (gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON button) on)
+ (gtk_widget_show button)
+ (g_signal_connect button "clicked" (lambda (w d) (target-callback type)) #f)))
+ (list "entire sound" "selection" "between marks")
+ (list 'sound 'selection 'marks)
+ (list #t #f #f)))
+
+ (if truncate-callback
+ (let ((sep (gtk_separator_new GTK_ORIENTATION_HORIZONTAL))
+ (button (gtk_check_button_new_with_label "truncate at end")))
+ (gtk_box_pack_start (GTK_BOX rc) sep #t #t 4)
+ (gtk_widget_show sep)
+ (gtk_box_pack_start (GTK_BOX rc) button #t #t 4)
+ (gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON button) #t)
+ (gtk_widget_show button)
+ (g_signal_connect button "clicked" (lambda (w d) (truncate-callback (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON w)))) #f)))))
+
+ (define (effect-framples target)
+ (if (eq? target 'sound)
+ (- (framples) 1)
+ (if (eq? target 'selection)
+ (selection-framples)
+ (+ 1 (abs (apply - (plausible-mark-samples)))))))
+
+
;;; *******************************
;;; **
;;; BEGIN PARAMETRIZED EFFECTS **
;;; **
;;; *******************************
-
+
;;; AMPLITUDE EFFECTS
;;;
-
-(define effects-list '()) ; menu labels are updated to show current settings
-
-(define effects-menu (add-to-main-menu "Effects" (lambda () (update-label effects-list))))
-
-(define* (effects-squelch-channel amp gate-size snd chn)
- (let ((f0 (make-moving-average gate-size))
- (f1 (make-moving-average gate-size :initial-element 1.0)))
- (map-channel (lambda (y)
- (* y (moving-average f1 (if (< (moving-average f0 (* y y)) amp) 0.0 1.0))))
- 0 #f snd chn #f
- (format #f "effects-squelch-channel ~A ~A" amp gate-size))))
-
-(let ((amp-menu-list '())
- (amp-menu (gtk_menu_item_new_with_label "Amplitude Effects"))
- (amp-cascade (gtk_menu_new)))
- (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) amp-menu)
- (gtk_widget_show amp-menu)
- (gtk_menu_item_set_submenu (GTK_MENU_ITEM amp-menu) amp-cascade)
- (g_signal_connect amp-menu "activate" (lambda (w d) (update-label amp-menu-list)) #f)
-
- ;; -------- Gain (gain set by gain-amount)
-
- (let ((child (gtk_menu_item_new_with_label "Gain"))
- (gain-amount 1.0)
- (gain-dialog #f)
- (gain-target 'sound)
- (gain-envelope #f))
+
+ (define effects-list ()) ; menu labels are updated to show current settings
+
+ (define effects-menu (add-to-main-menu "Effects" (lambda () (update-label effects-list))))
+
+ (define* (effects-squelch-channel amp gate-size snd chn no-silence)
+ (let ((f0 (make-moving-average gate-size))
+ (f1 (make-moving-average gate-size :initial-element 1.0)))
+ (if no-silence
+ (map-channel (lambda (y)
+ (let ((val (* y (moving-average f1 (ceiling (- (moving-average f0 (* y y)) amp))))))
+ (and (not (zero? val)) val)))
+ 0 #f snd chn #f (format #f "effects-squelch-channel ~A ~A" amp gate-size))
+ (map-channel (lambda (y)
+ (* y (moving-average f1 (ceiling (- (moving-average f0 (* y y)) amp)))))
+ 0 #f snd chn #f (format #f "effects-squelch-channel ~A ~A" amp gate-size)))))
+
+ (let ((amp-menu-list ())
+ (amp-menu (gtk_menu_item_new_with_label "Amplitude Effects"))
+ (amp-cascade (gtk_menu_new)))
+ (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) amp-menu)
+ (gtk_widget_show amp-menu)
+ (gtk_menu_item_set_submenu (GTK_MENU_ITEM amp-menu) amp-cascade)
+ (g_signal_connect amp-menu "activate" (lambda (w d) (update-label amp-menu-list)) #f)
- (define (scale-envelope e scl)
- (if (null? e)
- '()
- (append (list (car e) (* scl (cadr e)))
- (scale-envelope (cddr e) scl))))
+ ;; -------- Gain (gain set by gain-amount)
- (gtk_menu_shell_append (GTK_MENU_SHELL amp-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not gain-dialog)
- (let ((initial-gain-amount 1.0)
- (sliders '()))
- (set! gain-dialog
- (make-effect-dialog
- "Gain"
-
- (lambda (w data)
- "Gain scales amplitude by gain amount."
- (let ((with-env (and (not (equal? (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0)))
- (scale-envelope (xe-envelope gain-envelope) gain-amount))))
- (if (eq? gain-target 'sound)
- (if with-env
- (env-sound with-env)
- (scale-by gain-amount))
- (if (eq? gain-target 'selection)
+ (let ((child (gtk_menu_item_new_with_label "Gain"))
+ (gain-amount 1.0)
+ (gain-dialog #f)
+ (gain-target 'sound)
+ (gain-envelope #f))
+
+ (define (scale-envelope e scl)
+ (if (null? e)
+ ()
+ (append (list (car e) (* scl (cadr e)))
+ (scale-envelope (cddr e) scl))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL amp-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not gain-dialog)
+ (let ((initial-gain-amount 1.0)
+ (sliders ()))
+ (set! gain-dialog
+ (make-effect-dialog
+ "Gain"
+
+ (lambda (w data)
+ ;; Gain scales amplitude by gain amount.
+ (let ((with-env (and (not (equal? (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0)))
+ (scale-envelope (xe-envelope gain-envelope) gain-amount))))
+ (if (eq? gain-target 'sound)
+ (if with-env
+ (env-sound with-env)
+ (scale-by gain-amount))
+ (if (eq? gain-target 'selection)
+ (if (selection?)
+ (if with-env
+ (env-selection with-env)
+ (scale-selection-by gain-amount))
+ (snd-print "no selection"))
+ (let ((pts (plausible-mark-samples)))
+ (if pts
+ (if with-env
+ (env-sound with-env (car pts) (- (cadr pts) (car pts)))
+ (scale-by gain-amount (car pts) (- (cadr pts) (car pts))))))))))
+
+ (lambda (w data)
+ (help-dialog
+ "Gain"
+ "Move the slider to change the gain scaling amount."))
+
+ (lambda (w data)
+ (set! gain-amount initial-gain-amount)
+ (set! (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0))
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) gain-amount)
+ )
+
+ (lambda ()
+ (effect-target-ok gain-target))))
+
+ (set! sliders
+ (add-sliders gain-dialog
+ (list (list "gain" 0.0 initial-gain-amount 5.0
+ (lambda (w data)
+ (set! gain-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
+ 100))))
+ (gtk_widget_show gain-dialog)
+ (set! gain-envelope (xe-create-enved "gain"
+ (gtk_dialog_get_content_area (GTK_DIALOG gain-dialog))
+ #f
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG gain-dialog))
+ (lambda (target)
+ (set! gain-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT gain-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog gain-dialog))
+ #f)
+
+ (set! amp-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Gain (~1,2F)" gain-amount)))
+ (change-label child new-label)))
+ amp-menu-list)))
+
+ ;; -------- Normalize
+
+ (let ((child (gtk_menu_item_new_with_label "Normalize"))
+ (normalize-amount 1.0)
+ (normalize-dialog #f)
+ (normalize-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL amp-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not normalize-dialog)
+ (let ((initial-normalize-amount 1.0)
+ (sliders ()))
+ (set! normalize-dialog
+ (make-effect-dialog
+ "Normalize"
+
+ (lambda (w data)
+ (if (eq? normalize-target 'sound)
+ (scale-to normalize-amount)
+ (if (eq? normalize-target 'selection)
(if (selection?)
- (if with-env
- (env-selection with-env)
- (scale-selection-by gain-amount))
+ (scale-selection-to normalize-amount)
(snd-print "no selection"))
(let ((pts (plausible-mark-samples)))
(if pts
- (if with-env
- (env-sound with-env (car pts) (- (cadr pts) (car pts)))
- (scale-by gain-amount (car pts) (- (cadr pts) (car pts))))))))))
-
- (lambda (w data)
- (help-dialog
- "Gain"
- "Move the slider to change the gain scaling amount."))
-
- (lambda (w data)
- (set! gain-amount initial-gain-amount)
- (set! (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0))
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) gain-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- )
-
- (lambda ()
- (effect-target-ok gain-target))))
-
- (set! sliders
- (add-sliders gain-dialog
- (list (list "gain" 0.0 initial-gain-amount 5.0
- (lambda (w data)
- (set! gain-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- 100))))
- (gtk_widget_show gain-dialog)
- (set! gain-envelope (xe-create-enved "gain"
- (gtk_dialog_get_content_area (GTK_DIALOG gain-dialog))
- #f
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG gain-dialog))
- (lambda (target)
- (set! gain-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT gain-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog gain-dialog))
- #f)
-
- (set! amp-menu-list (cons (lambda ()
- (let ((new-label (format #f "Gain (~1,2F)" gain-amount)))
- (change-label child new-label)))
- amp-menu-list)))
+ (scale-to normalize-amount (car pts) (- (cadr pts) (car pts))))))))
+
+ (lambda (w data)
+ (help-dialog
+ "Normalize"
+ "Normalize scales amplitude to the normalize amount. Move the slider to change the scaling amount."))
+
+ (lambda (w data)
+ (set! normalize-amount initial-normalize-amount)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) normalize-amount)
+ )
+
+ (lambda ()
+ (effect-target-ok normalize-target))))
+
+ (set! sliders
+ (add-sliders normalize-dialog
+ (list (list "normalize" 0.0 initial-normalize-amount 1.1
+ (lambda (w data)
+ (set! normalize-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG normalize-dialog))
+ (lambda (target)
+ (set! normalize-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT normalize-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog normalize-dialog))
+ #f)
+ (set! amp-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Normalize (~1,2F)" normalize-amount)))
+ (change-label child new-label)))
+ amp-menu-list)))
+
+ ;; -------- Gate (gate set by gate-amount)
+
+ (let ((gate-amount 0.01)
+ (gate-dialog #f)
+ (gate-size 128)
+ (omit-silence #f))
+
+ (let ((child (gtk_menu_item_new_with_label "Gate")))
+ (gtk_menu_shell_append (GTK_MENU_SHELL amp-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not gate-dialog)
+ ;; if gate-dialog doesn't exist, create it
+ (let ((initial-gate-amount 0.01)
+ (sliders ()))
+ (set! gate-dialog
+ (make-effect-dialog
+ "Gate"
+
+ (lambda (w data)
+ (let ((snc (sync)))
+ (if (> snc 0)
+ (apply map
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (effects-squelch-channel (* gate-amount gate-amount) gate-size snd chn omit-silence)))
+ (all-chans))
+ (effects-squelch-channel (* gate-amount gate-amount) gate-size (selected-sound) (selected-channel) omit-silence))))
+
+ (lambda (w data)
+ (help-dialog "Gate"
+ "Move the slider to change the gate intensity. Higher values gate more of the sound."))
+
+ (lambda (w data)
+ (set! gate-amount initial-gate-amount)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) gate-amount)
+ )))
+
+ (set! sliders
+ (add-sliders gate-dialog
+ (list (list "gate" 0.0 initial-gate-amount 0.1
+ (lambda (w data)
+ (set! gate-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
+ 1000))))
+ ;; now add a toggle button setting omit-silence
+ (let ((toggle (gtk_check_button_new_with_label "Omit silence")))
+ (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG gate-dialog))) toggle #f #f 4)
+ (gtk_widget_show toggle)
+ (gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON toggle) omit-silence)
+ (g_signal_connect toggle "clicked" (lambda (w d) (set! omit-silence (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON toggle)))) #f))))
+ (activate-dialog gate-dialog))
+ #f)
+ (set! amp-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Gate (~1,3F)" gate-amount)))
+ (change-label child new-label)))
+ amp-menu-list)))))
- ;; -------- Normalize
+;;; DELAY EFFECTS
+;;;
- (let ((child (gtk_menu_item_new_with_label "Normalize"))
- (normalize-amount 1.0)
- (normalize-dialog #f)
- (normalize-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL amp-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not normalize-dialog)
- (let ((initial-normalize-amount 1.0)
- (sliders '()))
- (set! normalize-dialog
- (make-effect-dialog
- "Normalize"
-
- (lambda (w data)
- (if (eq? normalize-target 'sound)
- (scale-to normalize-amount)
- (if (eq? normalize-target 'selection)
- (if (selection?)
- (scale-selection-to normalize-amount)
- (snd-print "no selection"))
- (let ((pts (plausible-mark-samples)))
- (if pts
- (scale-to normalize-amount (car pts) (- (cadr pts) (car pts))))))))
-
- (lambda (w data)
- (help-dialog
- "Normalize"
- "Normalize scales amplitude to the normalize amount. Move the slider to change the scaling amount."))
-
- (lambda (w data)
- (set! normalize-amount initial-normalize-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) normalize-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- )
-
- (lambda ()
- (effect-target-ok normalize-target))))
-
- (set! sliders
- (add-sliders normalize-dialog
- (list (list "normalize" 0.0 initial-normalize-amount 1.1
- (lambda (w data)
- (set! normalize-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG normalize-dialog))
- (lambda (target)
- (set! normalize-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT normalize-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog normalize-dialog))
- #f)
- (set! amp-menu-list (cons (lambda ()
- (let ((new-label (format #f "Normalize (~1,2F)" normalize-amount)))
- (change-label child new-label)))
- amp-menu-list)))
+ (define effects-echo
+ (let ((documentation "(effects-echo input-samps-1 delay-time echo-amount beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (input-samps-1 delay-time echo-amount beg dur snd chn)
+ (let* ((del (make-delay (round (* delay-time (srate snd)))))
+ (len (or dur (framples snd chn)))
+ (input-samps (or input-samps-1 len)))
+ (as-one-edit
+ (lambda ()
+ (map-channel
+ (lambda (inval)
+ (+ inval
+ (delay del (* echo-amount (+ (tap del) inval)))))
+ beg input-samps snd chn)
+ (if (> len input-samps)
+ (map-channel
+ (lambda (inval)
+ (+ inval
+ (delay del (* echo-amount (tap del)))))
+ (+ beg input-samps) (- dur input-samps) snd chn)))
+ (format #f "effects-echo ~A ~A ~A ~A ~A" input-samps-1 delay-time echo-amount beg dur))))))
- ;; -------- Gate (gate set by gate-amount)
+ (define* (effects-flecho-1 scaler secs input-samps-1 beg dur snd chn)
+ (let ((flt (make-fir-filter :order 4 :xcoeffs (float-vector .125 .25 .25 .125)))
+ (del (make-delay (round (* secs (srate snd))))))
+ (if (and (not input-samps-1) (not dur))
+ (map-channel (lambda (inval)
+ (+ inval
+ (delay del
+ (fir-filter flt (* scaler (+ (tap del) inval))))))
+ beg #f snd chn #f
+ (format #f "effects-flecho-1 ~A ~A ~A ~A ~A" scaler secs input-samps-1 beg #f))
+ (let* ((cutoff (- (or input-samps-1 dur (framples snd chn)) 1))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (map-channel (lambda (inval)
+ (+ inval
+ (delay del
+ (fir-filter flt (* scaler (+ (tap del) (* (env genv) inval)))))))
+ beg dur snd chn #f
+ (format #f "effects-flecho-1 ~A ~A ~A ~A ~A" scaler secs input-samps-1 beg dur))))))
- (let ((gate-amount 0.01)
- (gate-dialog #f)
- (gate-size 128)
- (omit-silence #f))
-
- (let ((child (gtk_menu_item_new_with_label "Gate")))
- (gtk_menu_shell_append (GTK_MENU_SHELL amp-cascade) child)
+ (define* (effects-zecho-1 scaler secs frq amp input-samps-1 beg dur snd chn)
+ (let* ((os (make-oscil frq))
+ (len (round (* secs (srate snd))))
+ (del (make-delay len :max-size (round (+ len amp 1))))
+ (cutoff (- (or input-samps-1 dur (framples snd chn)) 1))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (map-channel (lambda (inval)
+ (+ inval
+ (delay del
+ (* scaler (+ (tap del) (* (env genv) inval)))
+ (* amp (oscil os)))))
+ beg dur snd chn #f
+ (format #f "effects-zecho-1 ~A ~A ~A ~A ~A ~A ~A" scaler secs frq amp input-samps-1 beg dur))))
+
+
+ (let ((delay-menu-list ())
+ (delay-menu (gtk_menu_item_new_with_label "Delay Effects"))
+ (delay-cascade (gtk_menu_new)))
+ (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) delay-menu)
+ (gtk_widget_show delay-menu)
+ (gtk_menu_item_set_submenu (GTK_MENU_ITEM delay-menu) delay-cascade)
+ (g_signal_connect delay-menu "activate" (lambda (w d) (update-label delay-menu-list)) #f)
+
+ ;; -------- Echo (controlled by delay-time and echo-amount)
+
+ (let ((child (gtk_menu_item_new_with_label "Echo"))
+ (delay-time .5) ; i.e. delay between echoes
+ (echo-amount .2)
+ (echo-dialog #f)
+ (echo-target 'sound)
+ (echo-truncate #t))
+ ;; echo-decay? -- using (* 4 delay-time) currently
+ (gtk_menu_shell_append (GTK_MENU_SHELL delay-cascade) child)
(gtk_widget_show child)
(g_signal_connect child "activate"
(lambda (w d)
- (if (not gate-dialog)
- ;; if gate-dialog doesn't exist, create it
- (let ((initial-gate-amount 0.01)
- (sliders '()))
- (set! gate-dialog
+ (if (not echo-dialog)
+ (let ((initial-delay-time 0.5)
+ (initial-echo-amount 0.2)
+ (sliders ()))
+ (set! echo-dialog
(make-effect-dialog
- "Gate"
-
+ "Echo"
+
(lambda (w data)
- (let ((snc (sync)))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (effects-squelch-channel (* gate-amount gate-amount) gate-size snd chn)))
- (all-chans))
- (effects-squelch-channel (* gate-amount gate-amount) gate-size (selected-sound) (selected-channel)))))
-
+ (map-chan-over-target-with-sync
+ (lambda (cutoff)
+ (let ((del (make-delay (round (* delay-time (srate)))))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (lambda (inval)
+ (+ inval
+ (delay del
+ (* echo-amount (+ (tap del) (* (env genv) inval))))))))
+ echo-target
+ (lambda (target input-samps)
+ (format #f "effects-echo ~A ~A ~A"
+ (and (not (eq? target 'sound)) input-samps)
+ delay-time echo-amount))
+ (and (not echo-truncate)
+ (* 4 delay-time))))
+
(lambda (w data)
- (help-dialog "Gate"
- "Move the slider to change the gate intensity. Higher values gate more of the sound."))
-
+ (help-dialog "Echo"
+ "The sliders change the delay time and echo amount."))
+
+ (lambda (w data)
+ (set! delay-time initial-delay-time)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) delay-time)
+ (set! echo-amount initial-echo-amount)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) echo-amount)
+ )
+
+ (lambda ()
+ (effect-target-ok echo-target))))
+
+ (set! sliders
+ (add-sliders echo-dialog
+ (list (list "delay time" 0.0 initial-delay-time 2.0
+ (lambda (w data)
+ (set! delay-time (gtk_adjustment_get_value (GTK_ADJUSTMENT (car sliders)))))
+ 100)
+ (list "echo amount" 0.0 initial-echo-amount 1.0
+ (lambda (w data)
+ (set! echo-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (cadr sliders)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG echo-dialog))
+ (lambda (target)
+ (set! echo-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT echo-dialog) "ok-button"))
+ (effect-target-ok target)))
+ (lambda (truncate)
+ (set! echo-truncate truncate)))))
+ (activate-dialog echo-dialog))
+ #f)
+ (set! delay-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Echo (~1,2F ~1,2F)"
+ delay-time echo-amount)))
+ (change-label child new-label)))
+ delay-menu-list)))
+
+ ;; -------- Filtered echo
+
+ (let ((child (gtk_menu_item_new_with_label "Filtered echo"))
+ (flecho-scaler 0.5)
+ (flecho-delay 0.9)
+ (flecho-dialog #f)
+ (flecho-target 'sound)
+ (flecho-truncate #t))
+
+ (define flecho-1
+ (lambda (scaler secs cutoff)
+ (let ((flt (make-fir-filter :order 4 :xcoeffs (float-vector .125 .25 .25 .125)))
+ (del (make-delay (round (* secs (srate)))))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (lambda (inval)
+ (+ inval
+ (delay del
+ (fir-filter flt (* scaler (+ (tap del) (* (env genv) inval))))))))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL delay-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not flecho-dialog)
+ (let ((initial-flecho-scaler 0.5)
+ (initial-flecho-delay 0.9)
+ (sliders ()))
+ (set! flecho-dialog
+ (make-effect-dialog
+ "Filtered echo"
+
(lambda (w data)
- (set! gate-amount initial-gate-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) gate-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- )))
-
+ (map-chan-over-target-with-sync
+ (lambda (input-samps)
+ (flecho-1 flecho-scaler flecho-delay input-samps))
+ flecho-target
+ (lambda (target input-samps)
+ (format #f "effects-flecho-1 ~A ~A ~A"
+ flecho-scaler flecho-delay
+ (and (not (eq? target 'sound)) input-samps)))
+ (and (not flecho-truncate)
+ (* 4 flecho-delay))))
+
+ (lambda (w data)
+ (help-dialog "Filtered echo"
+ "Move the sliders to set the filter scaler and the delay time in seconds."))
+
+ (lambda (w data)
+ (set! flecho-scaler initial-flecho-scaler)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) flecho-scaler)
+ (set! flecho-delay initial-flecho-delay)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) flecho-delay)
+ )
+
+ (lambda ()
+ (effect-target-ok flecho-target))))
+
(set! sliders
- (add-sliders gate-dialog
- (list (list "gate" 0.0 initial-gate-amount 0.1
+ (add-sliders flecho-dialog
+ (list (list "filter scaler" 0.0 initial-flecho-scaler 1.0
(lambda (w data)
- (set! gate-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- 1000))))
- ;; now add a toggle button setting omit-silence
- (let ((toggle (gtk_check_button_new_with_label "Omit silence")))
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG gate-dialog))) toggle #f #f 4)
- (gtk_widget_show toggle)
- (gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON toggle) omit-silence)
- (g_signal_connect toggle "clicked" (lambda (w d) (set! omit-silence (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON toggle)))) #f))))
- (activate-dialog gate-dialog))
+ (set! flecho-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (car sliders)))))
+ 100)
+ (list "delay time (secs)" 0.0 initial-flecho-delay 3.0
+ (lambda (w data)
+ (set! flecho-delay (gtk_adjustment_get_value (GTK_ADJUSTMENT (cadr sliders)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG flecho-dialog))
+ (lambda (target)
+ (set! flecho-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT flecho-dialog) "ok-button"))
+ (effect-target-ok target)))
+ (lambda (truncate)
+ (set! flecho-truncate truncate)))))
+ (activate-dialog flecho-dialog))
#f)
- (set! amp-menu-list (cons (lambda ()
- (let ((new-label (format #f "Gate (~1,3F)" gate-amount)))
- (change-label child new-label)))
- amp-menu-list)))))
-
-;;; DELAY EFFECTS
-;;;
-
-(define* (effects-echo input-samps-1 delay-time echo-amount beg dur snd chn)
- (let ((del (make-delay (round (* delay-time (srate snd)))))
- (samp 0)
- (input-samps (or input-samps-1 dur (frames snd chn))))
- (map-channel (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (* echo-amount (+ (tap del) (if (<= samp input-samps) inval 0.0))))))
- beg dur snd chn #f
- (format #f "effects-echo ~A ~A ~A ~A ~A" input-samps-1 delay-time echo-amount beg dur))))
-
-(define* (effects-flecho-1 scaler secs input-samps-1 beg dur snd chn)
- (let* ((flt (make-fir-filter :order 4 :xcoeffs (vct .125 .25 .25 .125)))
- (del (make-delay (round (* secs (srate snd)))))
- (samp 0)
- (input-samps (or input-samps-1 dur (frames snd chn))))
- (map-channel (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (fir-filter flt (* scaler (+ (tap del) (if (<= samp input-samps) inval 0.0)))))))
- beg dur snd chn #f
- (format #f "effects-flecho-1 ~A ~A ~A ~A ~A" scaler secs input-samps-1 beg dur))))
-
-(define* (effects-zecho-1 scaler secs frq amp input-samps-1 beg dur snd chn)
- (let* ((os (make-oscil frq))
- (len (round (* secs (srate snd))))
- (del (make-delay len :max-size (round (+ len amp 1))))
- (samp 0)
- (input-samps (or input-samps-1 dur (frames snd chn))))
- (map-channel (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (* scaler (+ (tap del) (if (<= samp input-samps) inval 0.0)))
- (* amp (oscil os)))))
- beg dur snd chn #f
- (format #f "effects-zecho-1 ~A ~A ~A ~A ~A ~A ~A" scaler secs frq amp input-samps-1 beg dur))))
-
-
-(let ((delay-menu-list '())
- (delay-menu (gtk_menu_item_new_with_label "Delay Effects"))
- (delay-cascade (gtk_menu_new)))
- (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) delay-menu)
- (gtk_widget_show delay-menu)
- (gtk_menu_item_set_submenu (GTK_MENU_ITEM delay-menu) delay-cascade)
- (g_signal_connect delay-menu "activate" (lambda (w d) (update-label delay-menu-list)) #f)
-
- ;; -------- Echo (controlled by delay-time and echo-amount)
-
- (let ((child (gtk_menu_item_new_with_label "Echo"))
- (delay-time .5) ; i.e. delay between echoes
- (echo-amount .2)
- (echo-dialog #f)
- (echo-target 'sound)
- (echo-truncate #t))
- ;; echo-decay? -- using (* 4 delay-time) currently
- (gtk_menu_shell_append (GTK_MENU_SHELL delay-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not echo-dialog)
- (let ((initial-delay-time 0.5)
- (initial-echo-amount 0.2)
- (sliders '()))
- (set! echo-dialog
- (make-effect-dialog
- "Echo"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (input-samps)
- (let ((del (make-delay (round (* delay-time (srate)))))
- (samp 0))
- (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (* echo-amount (+ (tap del) (if (<= samp input-samps) inval 0.0))))))))
- echo-target
- (lambda (target input-samps)
- (format #f "effects-echo ~A ~A ~A"
- (if (eq? target 'sound) #f input-samps)
- delay-time echo-amount))
- (and (not echo-truncate)
- (* 4 delay-time))))
-
- (lambda (w data)
- (help-dialog "Echo"
- "The sliders change the delay time and echo amount."))
-
- (lambda (w data)
- (set! delay-time initial-delay-time)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) delay-time)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- (set! echo-amount initial-echo-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) echo-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (cadr sliders)))
- )
-
- (lambda ()
- (effect-target-ok echo-target))))
-
- (set! sliders
- (add-sliders echo-dialog
- (list (list "delay time" 0.0 initial-delay-time 2.0
- (lambda (w data)
- (set! delay-time (gtk_adjustment_get_value (GTK_ADJUSTMENT (car sliders)))))
- 100)
- (list "echo amount" 0.0 initial-echo-amount 1.0
- (lambda (w data)
- (set! echo-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (cadr sliders)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG echo-dialog))
- (lambda (target)
- (set! echo-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT echo-dialog) "ok-button"))
- (effect-target-ok target)))
- (lambda (truncate)
- (set! echo-truncate truncate)))))
- (activate-dialog echo-dialog))
- #f)
- (set! delay-menu-list (cons (lambda ()
- (let ((new-label (format #f "Echo (~1,2F ~1,2F)"
- delay-time echo-amount)))
- (change-label child new-label)))
- delay-menu-list)))
-
- ;; -------- Filtered echo
-
- (let ((child (gtk_menu_item_new_with_label "Filtered echo"))
- (flecho-scaler 0.5)
- (flecho-delay 0.9)
- (flecho-dialog #f)
- (flecho-target 'sound)
- (flecho-truncate #t))
-
- (define flecho-1
- (lambda (scaler secs input-samps)
- (let* ((flt (make-fir-filter :order 4 :xcoeffs (vct .125 .25 .25 .125)))
- (del (make-delay (round (* secs (srate)))))
- (samp 0))
- (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (fir-filter flt (* scaler (+ (tap del) (if (<= samp input-samps) inval 0.0))))))))))
+ (set! delay-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Filtered echo (~1,2F ~1,2F)"
+ flecho-scaler flecho-delay)))
+ (change-label child new-label)))
+ delay-menu-list)))
- (gtk_menu_shell_append (GTK_MENU_SHELL delay-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not flecho-dialog)
- (let ((initial-flecho-scaler 0.5)
- (initial-flecho-delay 0.9)
- (sliders '()))
- (set! flecho-dialog
- (make-effect-dialog
- "Filtered echo"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (input-samps)
- (flecho-1 flecho-scaler flecho-delay input-samps))
- flecho-target
- (lambda (target input-samps)
- (format #f "effects-flecho-1 ~A ~A ~A"
- flecho-scaler flecho-delay
- (if (eq? target 'sound) #f input-samps)))
- (and (not flecho-truncate)
- (* 4 flecho-delay))))
-
- (lambda (w data)
- (help-dialog "Filtered echo"
- "Move the sliders to set the filter scaler and the delay time in seconds."))
-
- (lambda (w data)
- (set! flecho-scaler initial-flecho-scaler)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) flecho-scaler)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- (set! flecho-delay initial-flecho-delay)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) flecho-delay)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (cadr sliders)))
- )
-
- (lambda ()
- (effect-target-ok flecho-target))))
-
- (set! sliders
- (add-sliders flecho-dialog
- (list (list "filter scaler" 0.0 initial-flecho-scaler 1.0
- (lambda (w data)
- (set! flecho-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (car sliders)))))
- 100)
- (list "delay time (secs)" 0.0 initial-flecho-delay 3.0
- (lambda (w data)
- (set! flecho-delay (gtk_adjustment_get_value (GTK_ADJUSTMENT (cadr sliders)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG flecho-dialog))
- (lambda (target)
- (set! flecho-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT flecho-dialog) "ok-button"))
- (effect-target-ok target)))
- (lambda (truncate)
- (set! flecho-truncate truncate)))))
- (activate-dialog flecho-dialog))
- #f)
- (set! delay-menu-list (cons (lambda ()
- (let ((new-label (format #f "Filtered echo (~1,2F ~1,2F)"
- flecho-scaler flecho-delay)))
- (change-label child new-label)))
- delay-menu-list)))
-
- ;; -------- Modulated echo
-
- (let ((child (gtk_menu_item_new_with_label "Modulated echo"))
- (zecho-scaler 0.5)
- (zecho-delay 0.75)
- (zecho-freq 6)
- (zecho-amp 10.0)
- (zecho-dialog #f)
- (zecho-target 'sound)
- (zecho-truncate #t))
-
- (define zecho-1
- (lambda (scaler secs frq amp input-samps)
- (let* ((os (make-oscil frq))
- (len (round (* secs (srate))))
- (del (make-delay len :max-size (round (+ len amp 1))))
- (samp 0))
- (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (* scaler (+ (tap del) (if (<= samp input-samps) inval 0.0)))
- (* amp (oscil os))))))))
-
- (gtk_menu_shell_append (GTK_MENU_SHELL delay-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not zecho-dialog)
- (let ((initial-zecho-scaler 0.5)
- (initial-zecho-delay 0.75)
- (initial-zecho-freq 6)
- (initial-zecho-amp 10.0)
- (sliders '()))
- (set! zecho-dialog
- (make-effect-dialog
- "Modulated echo"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (input-samps)
- (zecho-1 zecho-scaler zecho-delay zecho-freq zecho-amp input-samps))
- zecho-target
- (lambda (target input-samps)
- (format #f "effects-zecho-1 ~A ~A ~A ~A ~A"
- zecho-scaler zecho-delay zecho-freq zecho-amp
- (if (eq? target 'sound) #f input-samps)))
- (and (not zecho-truncate)
- (* 4 zecho-delay))))
-
- (lambda (w data)
- (help-dialog "Modulated echo"
- "Move the sliders to set the echo scaler, the delay time in seconds,
+ ;; -------- Modulated echo
+
+ (let ((child (gtk_menu_item_new_with_label "Modulated echo"))
+ (zecho-scaler 0.5)
+ (zecho-delay 0.75)
+ (zecho-freq 6)
+ (zecho-amp 10.0)
+ (zecho-dialog #f)
+ (zecho-target 'sound)
+ (zecho-truncate #t))
+
+ (define zecho-1
+ (lambda (scaler secs frq amp cutoff)
+ (let* ((os (make-oscil frq))
+ (len (round (* secs (srate))))
+ (del (make-delay len :max-size (round (+ len amp 1))))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (lambda (inval)
+ (+ inval
+ (delay del
+ (* scaler (+ (tap del) (* (env genv) inval)))
+ (* amp (oscil os))))))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL delay-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not zecho-dialog)
+ (let ((initial-zecho-scaler 0.5)
+ (initial-zecho-delay 0.75)
+ (initial-zecho-freq 6)
+ (initial-zecho-amp 10.0)
+ (sliders ()))
+ (set! zecho-dialog
+ (make-effect-dialog
+ "Modulated echo"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (input-samps)
+ (zecho-1 zecho-scaler zecho-delay zecho-freq zecho-amp input-samps))
+ zecho-target
+ (lambda (target input-samps)
+ (format #f "effects-zecho-1 ~A ~A ~A ~A ~A"
+ zecho-scaler zecho-delay zecho-freq zecho-amp
+ (and (not (eq? target 'sound)) input-samps)))
+ (and (not zecho-truncate)
+ (* 4 zecho-delay))))
+
+ (lambda (w data)
+ (help-dialog "Modulated echo"
+ "Move the sliders to set the echo scaler, the delay time in seconds,
the modulation frequency, and the echo amplitude."))
-
- (lambda (w data)
- (set! zecho-scaler initial-zecho-scaler)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) zecho-scaler)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! zecho-delay initial-zecho-delay)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) zecho-delay)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! zecho-freq initial-zecho-freq)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 2)) zecho-freq)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- (set! zecho-amp initial-zecho-amp)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 3)) zecho-amp)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 3)))
- )
-
- (lambda ()
- (effect-target-ok zecho-target))))
-
- (set! sliders
- (add-sliders zecho-dialog
- (list (list "echo scaler" 0.0 initial-zecho-scaler 1.0
- (lambda (w data)
- (set! zecho-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100)
- (list "delay time (secs)" 0.0 initial-zecho-delay 3.0
- (lambda (w data)
- (set! zecho-delay (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 100)
- (list "modulation frequency" 0.0 initial-zecho-freq 100.0
- (lambda (w data)
- (set! zecho-freq (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 100)
- (list "modulation amplitude" 0.0 initial-zecho-amp 100.0
- (lambda (w data)
- (set! zecho-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 3)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG zecho-dialog))
- (lambda (target)
- (set! zecho-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT zecho-dialog) "ok-button"))
- (effect-target-ok target)))
- (lambda (truncate)
- (set! zecho-truncate truncate)))))
- (activate-dialog zecho-dialog))
- #f)
-
- (set! delay-menu-list (cons (lambda ()
- (let ((new-label (format #f "Modulated echo (~1,2F ~1,2F ~1,2F ~1,2F)"
- zecho-scaler zecho-delay zecho-freq zecho-amp)))
- (change-label child new-label)))
- delay-menu-list)))
+
+ (lambda (w data)
+ (set! zecho-scaler initial-zecho-scaler)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) zecho-scaler)
+ (set! zecho-delay initial-zecho-delay)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) zecho-delay)
+ (set! zecho-freq initial-zecho-freq)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 2)) zecho-freq)
+ (set! zecho-amp initial-zecho-amp)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 3)) zecho-amp)
+ )
+
+ (lambda ()
+ (effect-target-ok zecho-target))))
+
+ (set! sliders
+ (add-sliders zecho-dialog
+ (list (list "echo scaler" 0.0 initial-zecho-scaler 1.0
+ (lambda (w data)
+ (set! zecho-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100)
+ (list "delay time (secs)" 0.0 initial-zecho-delay 3.0
+ (lambda (w data)
+ (set! zecho-delay (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 100)
+ (list "modulation frequency" 0.0 initial-zecho-freq 100.0
+ (lambda (w data)
+ (set! zecho-freq (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 100)
+ (list "modulation amplitude" 0.0 initial-zecho-amp 100.0
+ (lambda (w data)
+ (set! zecho-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 3)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG zecho-dialog))
+ (lambda (target)
+ (set! zecho-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT zecho-dialog) "ok-button"))
+ (effect-target-ok target)))
+ (lambda (truncate)
+ (set! zecho-truncate truncate)))))
+ (activate-dialog zecho-dialog))
+ #f)
+
+ (set! delay-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Modulated echo (~1,2F ~1,2F ~1,2F ~1,2F)"
+ zecho-scaler zecho-delay zecho-freq zecho-amp)))
+ (change-label child new-label)))
+ delay-menu-list)))
)
-
-
+
+
;;; FILTERS
;;;
-
-(define* (effects-comb-filter scaler size beg dur snd chn)
- (let ((delay-line (make-vct size 0.0))
- (delay-loc 0))
- (lambda (x)
- (let ((result (vct-ref delay-line delay-loc)))
- (vct-set! delay-line delay-loc (+ x (* scaler result)))
- (set! delay-loc (+ 1 delay-loc))
- (if (= delay-loc size) (set! delay-loc 0))
- result))))
-
-(define* (effects-comb-chord scaler size amp interval-one interval-two beg dur snd chn)
- (let ((c1 (make-comb scaler size))
- (c2 (make-comb scaler (* size interval-one)))
- (c3 (make-comb scaler (* size interval-two))))
- (map-channel (lambda (x)
- (* amp (+ (comb c1 x) (comb c2 x) (comb c3 x))))
- beg dur snd chn #f
- (format #f "effects-comb-chord ~A ~A ~A ~A ~A ~A ~A" scaler size amp interval-one interval-two beg dur))))
-
-(define* (effects-moog freq Q beg dur snd chn)
- (let ((gen (make-moog-filter freq Q)))
- (map-channel (lambda (inval)
- (moog-filter gen inval))
- beg dur snd chn #f
- (format #f "effects-moog ~A ~A ~A ~A" freq Q beg dur))))
+
+ (define* (effects-comb-filter scaler size beg dur snd chn)
+ (let ((delay-line (make-float-vector size 0.0))
+ (delay-loc 0))
+ (lambda (x)
+ (let ((result (delay-line delay-loc)))
+ (set! (delay-line delay-loc) (+ x (* scaler result)))
+ (set! delay-loc (+ 1 delay-loc))
+ (if (= delay-loc size) (set! delay-loc 0))
+ result))))
+
+ (define effects-comb-chord
+ (let ((documentation "(effects-comb-chord scaler size amp interval-one interval-two beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (scaler size amp interval-one interval-two beg dur snd chn)
+ (let ((cs (make-comb-bank (vector (make-comb scaler size)
+ (make-comb scaler (* size interval-one))
+ (make-comb scaler (* size interval-two))))))
+ (map-channel (lambda (x)
+ (* amp (comb-bank cs x)))
+ beg dur snd chn #f
+ (format #f "effects-comb-chord ~A ~A ~A ~A ~A ~A ~A" scaler size amp interval-one interval-two beg dur))))))
+
+ (define* (effects-moog freq Q beg dur snd chn)
+ (let ((gen (make-moog-filter freq Q)))
+ (map-channel (lambda (inval)
+ (moog-filter gen inval))
+ beg dur snd chn #f
+ (format #f "effects-moog ~A ~A ~A ~A" freq Q beg dur))))
+
+ (define* (effects-bbp freq bw beg dur snd chn)
+ (let ((flt (make-butter-band-pass freq bw)))
+ (clm-channel flt beg dur snd chn #f #f
+ (format #f "effects-bbp ~A ~A ~A ~A" freq bw beg dur))))
+
+ (define* (effects-bbr freq bw beg dur snd chn)
+ (let ((flt (make-butter-band-reject freq bw)))
+ (clm-channel flt beg dur snd chn #f #f
+ (format #f "effects-bbr ~A ~A ~A ~A" freq bw beg dur))))
+
+ (define* (effects-bhp freq beg dur snd chn)
+ (let ((flt (make-butter-high-pass freq)))
+ (clm-channel flt beg dur snd chn #f #f
+ (format #f "effects-bhp ~A ~A ~A" freq beg dur))))
+
+ (define* (effects-blp freq beg dur snd chn)
+ (let ((flt (make-butter-low-pass freq)))
+ (clm-channel flt beg dur snd chn #f #f
+ (format #f "effects-blp ~A ~A ~A" freq beg dur))))
+
+ (let ((filter-menu-list ())
+ (filter-menu (gtk_menu_item_new_with_label "Filter Effects"))
+ (filter-cascade (gtk_menu_new)))
+ (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) filter-menu)
+ (gtk_widget_show filter-menu)
+ (gtk_menu_item_set_submenu (GTK_MENU_ITEM filter-menu) filter-cascade)
+ (g_signal_connect filter-menu "activate" (lambda (w d) (update-label filter-menu-list)) #f)
-(define* (effects-bbp freq bw beg dur snd chn)
- (let ((flt (make-butter-band-pass freq bw)))
- (clm-channel flt beg dur snd chn #f #f
- (format #f "effects-bbp ~A ~A ~A ~A" freq bw beg dur))))
-
-(define* (effects-bbr freq bw beg dur snd chn)
- (let ((flt (make-butter-band-reject freq bw)))
- (clm-channel flt beg dur snd chn #f #f
- (format #f "effects-bbr ~A ~A ~A ~A" freq bw beg dur))))
-
-(define* (effects-bhp freq beg dur snd chn)
- (let ((flt (make-butter-high-pass freq)))
- (clm-channel flt beg dur snd chn #f #f
- (format #f "effects-bhp ~A ~A ~A" freq beg dur))))
-
-(define* (effects-blp freq beg dur snd chn)
- (let ((flt (make-butter-low-pass freq)))
- (clm-channel flt beg dur snd chn #f #f
- (format #f "effects-blp ~A ~A ~A" freq beg dur))))
-
-(let ((filter-menu-list '())
- (filter-menu (gtk_menu_item_new_with_label "Filter Effects"))
- (filter-cascade (gtk_menu_new))
- (root-2 (sqrt 2.0)))
- (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) filter-menu)
- (gtk_widget_show filter-menu)
- (gtk_menu_item_set_submenu (GTK_MENU_ITEM filter-menu) filter-cascade)
- (g_signal_connect filter-menu "activate" (lambda (w d) (update-label filter-menu-list)) #f)
-
- ;; -------- Butterworth band-pass filter
-
- (let ((child (gtk_menu_item_new_with_label "Band-pass filter"))
- (band-pass-freq 1000)
- (band-pass-bw 100)
- (band-pass-dialog #f)
- (band-pass-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not band-pass-dialog)
- (let ((initial-band-pass-freq 1000)
- (initial-band-pass-bw 100)
- (sliders '()))
- (set! band-pass-dialog
- (make-effect-dialog
- "Band-pass filter"
-
- (lambda (w data)
- (let ((flt (make-butter-band-pass band-pass-freq band-pass-bw)))
- (if (eq? band-pass-target 'sound)
- (filter-sound flt #f #f #f #f (format #f "effects-bbp ~A ~A 0 #f" band-pass-freq band-pass-bw))
- (if (eq? band-pass-target 'selection)
- (filter-selection flt)
- (let* ((ms (plausible-mark-samples))
- (bg (car ms))
- (nd (+ 1 (- (cadr ms) (car ms)))))
- (clm-channel flt bg nd #f #f #f #f
- (format #f "effects-bbp ~A ~A ~A ~A" band-pass-freq band-pass-bw bg nd)))))))
-
- (lambda (w data)
- (help-dialog "Band-pass filter"
- "Butterworth band-pass filter. Move the sliders to change the center frequency and bandwidth."))
-
- (lambda (w data)
- (set! band-pass-freq initial-band-pass-freq)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) (scale-log->linear 20 band-pass-freq 22050))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! band-pass-bw initial-band-pass-bw)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) band-pass-bw)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- )
-
- (lambda ()
- (effect-target-ok band-pass-target))))
-
- (set! sliders
- (add-sliders band-pass-dialog
- (list (list "center frequency" 20 initial-band-pass-freq 22050
- (lambda (w data)
- (set! band-pass-freq (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (car sliders))) 22050)))
- 1 'log)
- (list "bandwidth" 0 initial-band-pass-bw 1000
- (lambda (w data)
- (set! band-pass-bw (gtk_adjustment_get_value (GTK_ADJUSTMENT (cadr sliders)))))
- 1))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG band-pass-dialog))
- (lambda (target)
- (set! band-pass-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT band-pass-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog band-pass-dialog))
- #f)
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Band-pass filter (~,2F ~D)"
- band-pass-freq band-pass-bw)))
- (change-label child new-label)))
- filter-menu-list)))
-
- ;; -------- Butterworth band-reject (notch) filter
-
- (let ((child (gtk_menu_item_new_with_label "Band-reject filter"))
- (notch-freq 100)
- (notch-bw 100)
- (notch-dialog #f)
- (notch-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not notch-dialog)
- (let ((initial-notch-freq 100)
- (initial-notch-bw 100)
- (sliders '()))
- (set! notch-dialog
- (make-effect-dialog
- "Band-reject filter"
-
- (lambda (w data)
- (let ((flt (make-butter-band-reject notch-freq notch-bw)))
- (if (eq? notch-target 'sound)
- (filter-sound flt #f #f #f #f (format #f "effects-bbr ~A ~A 0 #f" notch-freq notch-bw))
- (if (eq? notch-target 'selection)
- (filter-selection flt)
- (let* ((ms (plausible-mark-samples))
- (bg (car ms))
- (nd (+ 1 (- (cadr ms) (car ms)))))
- (clm-channel flt bg nd #f #f #f #f
- (format #f "effects-bbr ~A ~A ~A ~A" notch-freq notch-bw bg nd)))))))
-
- (lambda (w data)
- (help-dialog "Band-reject filter"
- "Butterworth band-reject filter. Move the sliders to change the center frequency and bandwidth."))
-
- (lambda (w data)
- (set! notch-freq initial-notch-freq)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) (scale-log->linear 20 notch-freq 22050))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! notch-bw initial-notch-bw)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) notch-bw)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- )
-
- (lambda ()
- (effect-target-ok notch-target))))
-
- (set! sliders
- (add-sliders notch-dialog
- (list (list "center frequency" 20 initial-notch-freq 22050
- (lambda (w data)
- (set! notch-freq (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (car sliders))) 22050)))
- 1 'log)
- (list "bandwidth" 0 initial-notch-bw 1000
- (lambda (w data)
- (set! notch-bw (gtk_adjustment_get_value (GTK_ADJUSTMENT (cadr sliders)))))
- 1))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG notch-dialog))
- (lambda (target)
- (set! notch-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT notch-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog notch-dialog))
- #f)
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Band-reject filter (~,2F ~D)" notch-freq notch-bw)))
- (change-label child new-label)))
- filter-menu-list)))
-
- ;; -------- Butterworth high-pass filter
-
- (let ((child (gtk_menu_item_new_with_label "High-pass filter"))
- (high-pass-freq 100)
- (high-pass-dialog #f)
- (high-pass-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not high-pass-dialog)
- (let ((initial-high-pass-freq 100)
- (sliders '()))
- (set! high-pass-dialog
- (make-effect-dialog
- "High-pass filter"
-
- (lambda (w data)
- (let ((flt (make-butter-high-pass high-pass-freq)))
- (if (eq? high-pass-target 'sound)
- (filter-sound flt #f #f #f #f (format #f "effects-bhp ~A 0 #f" high-pass-freq))
- (if (eq? high-pass-target 'selection)
- (filter-selection flt)
- (let* ((ms (plausible-mark-samples))
- (bg (car ms))
- (nd (+ 1 (- (cadr ms) (car ms)))))
- (clm-channel flt bg nd #f #f #f #f
- (format #f "effects-bhp ~A ~A ~A" high-pass-freq bg nd)))))))
-
- (lambda (w data)
- (help-dialog "High-pass filter"
- "Butterworth high-pass filter. Move the slider to change the high-pass cutoff frequency."))
-
- (lambda (w data)
- (set! high-pass-freq initial-high-pass-freq)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) (scale-log->linear 20 high-pass-freq 22050))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )
-
- (lambda ()
- (effect-target-ok high-pass-target))))
-
- (set! sliders
- (add-sliders high-pass-dialog
- (list (list "high-pass cutoff frequency" 20 initial-high-pass-freq 22050
- (lambda (w data)
- (set! high-pass-freq (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0))) 22050)))
- 1 'log))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG high-pass-dialog))
- (lambda (target)
- (set! high-pass-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT high-pass-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog high-pass-dialog))
- #f)
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "High-pass filter (~,2F)" high-pass-freq)))
- (change-label child new-label)))
- filter-menu-list)))
-
- ;; -------- Butterworth low-pass filter
-
- (let ((child (gtk_menu_item_new_with_label "Low-pass filter"))
- (low-pass-freq 1000)
- (low-pass-dialog #f)
- (low-pass-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not low-pass-dialog)
- (let ((initial-low-pass-freq 1000)
- (sliders '()))
- (set! low-pass-dialog
- (make-effect-dialog
- "Low-pass filter"
-
- (lambda (w data)
- (let ((flt (make-butter-low-pass low-pass-freq)))
- (if (eq? low-pass-target 'sound)
- (filter-sound flt #f #f #f #f (format #f "effects-blp ~A 0 #f" low-pass-freq))
- (if (eq? low-pass-target 'selection)
- (filter-selection flt)
- (let* ((ms (plausible-mark-samples))
- (bg (car ms))
- (nd (+ 1 (- (cadr ms) (car ms)))))
- (clm-channel flt bg nd #f #f #f #f
- (format #f "effects-blp ~A ~A ~A" low-pass-freq bg nd)))))))
-
- (lambda (w data)
- (help-dialog "Low-pass filter"
- "Butterworth low-pass filter. Move the slider to change the low-pass cutoff frequency."))
-
- (lambda (w data)
- (set! low-pass-freq initial-low-pass-freq)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) (scale-log->linear 20 low-pass-freq 22050))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )
-
- (lambda ()
- (effect-target-ok low-pass-target))))
-
- (set! sliders
- (add-sliders low-pass-dialog
- (list (list "low-pass cutoff frequency" 20 initial-low-pass-freq 22050
- (lambda (w data)
- (set! low-pass-freq (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0))) 22050)))
- 1 'log))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG low-pass-dialog))
- (lambda (target)
- (set! low-pass-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT low-pass-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog low-pass-dialog))
- #f)
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Low-pass filter (~,2F)" low-pass-freq)))
- (change-label child new-label)))
- filter-menu-list)))
-
- ;; -------- Comb filter
-
- (let ((child (gtk_menu_item_new_with_label "Comb filter"))
- (comb-scaler 0.1)
- (comb-size 50)
- (comb-dialog #f)
- (comb-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not comb-dialog)
- (let ((initial-comb-scaler 0.1)
- (initial-comb-size 50)
- (sliders '()))
- (set! comb-dialog
- (make-effect-dialog
- "Comb filter"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (effects-comb-filter comb-scaler comb-size))
- comb-target
- (lambda (target samps)
- (format #f "effects-comb-filter ~A ~A" comb-scaler comb-size))
- #f))
-
- (lambda (w data)
- (help-dialog "Comb filter"
- "Move the sliders to change the comb scaler and size."))
-
- (lambda (w data)
- (set! comb-scaler initial-comb-scaler)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) comb-scaler)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! comb-size initial-comb-size)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) comb-size)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- )
-
- (lambda ()
- (effect-target-ok comb-target))))
-
- (set! sliders
- (add-sliders comb-dialog
- (list (list "scaler" 0.0 initial-comb-scaler 1.0
- (lambda (w data)
- (set! comb-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100)
- (list "size" 0 initial-comb-size 100
- (lambda (w data)
- (set! comb-size (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 1))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG comb-dialog))
- (lambda (target)
- (set! comb-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT comb-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog comb-dialog))
- #f)
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Comb filter (~1,2F ~D)" comb-scaler comb-size)))
- (change-label child new-label)))
- filter-menu-list)))
-
- ;; -------- Comb-chord filter
-
- (let ((child (gtk_menu_item_new_with_label "Comb chord filter"))
- (new-comb-chord-scaler 0.95)
- (new-comb-chord-size 60)
- (new-comb-chord-amp 0.3)
- (new-comb-chord-interval-one 0.75)
- (new-comb-chord-interval-two 1.20)
- (new-comb-chord-dialog #f)
- (new-comb-chord-target 'sound))
-
- (define new-comb-chord
- (lambda (scaler size amp interval-one interval-two)
- "Comb chord filter: create chords by using filters at harmonically related sizes."
- (let ((c1 (make-comb scaler size))
- (c2 (make-comb scaler (* size interval-one)))
- (c3 (make-comb scaler (* size interval-two))))
- (lambda (x)
- (* amp (+ (comb c1 x) (comb c2 x) (comb c3 x)))))))
+ ;; -------- Butterworth band-pass filter
- (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not new-comb-chord-dialog)
- (let ((initial-new-comb-chord-scaler 0.95)
- (initial-new-comb-chord-size 60)
- (initial-new-comb-chord-amp 0.3)
- (initial-new-comb-chord-interval-one 0.75)
- (initial-new-comb-chord-interval-two 1.20)
- (sliders '()))
- (set! new-comb-chord-dialog
- (make-effect-dialog
- "Comb chord filter"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (new-comb-chord new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
- new-comb-chord-interval-one new-comb-chord-interval-two))
- new-comb-chord-target
- (lambda (target samps)
- (format #f "effects-comb-chord ~A ~A ~A ~A ~A"
- new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
- new-comb-chord-interval-one new-comb-chord-interval-two))
- #f))
-
- (lambda (w data)
- (help-dialog "Comb chord filter"
- "Creates chords by using filters at harmonically related sizes.
-Move the sliders to set the comb chord parameters."))
-
- (lambda (w data)
- (set! new-comb-chord-scaler initial-new-comb-chord-scaler)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) new-comb-chord-scaler)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! new-comb-chord-size initial-new-comb-chord-size)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) new-comb-chord-size)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! new-comb-chord-amp initial-new-comb-chord-amp)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 2)) new-comb-chord-amp)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- (set! new-comb-chord-interval-one initial-new-comb-chord-interval-one)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 3)) new-comb-chord-interval-one)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 3)))
- (set! new-comb-chord-interval-two initial-new-comb-chord-interval-two)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 4)) new-comb-chord-interval-two)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 4)))
- )
-
- (lambda ()
- (effect-target-ok new-comb-chord-target))))
-
- (set! sliders
- (add-sliders new-comb-chord-dialog
- (list (list "chord scaler" 0.0 initial-new-comb-chord-scaler 1.0
- (lambda (w data)
- (set! new-comb-chord-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100)
- (list "chord size" 0 initial-new-comb-chord-size 100
- (lambda (w data)
- (set! new-comb-chord-size (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 1)
- (list "amplitude" 0.0 initial-new-comb-chord-amp 1.0
- (lambda (w data)
- (set! new-comb-chord-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 100)
- (list "interval one" 0.0 initial-new-comb-chord-interval-one 2.0
- (lambda (w data)
- (set! new-comb-chord-interval-one (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 4)))))
- 100)
- (list "interval two" 0.0 initial-new-comb-chord-interval-two 2.0
- (lambda (w data)
- (set! new-comb-chord-interval-two (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 4)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG new-comb-chord-dialog))
- (lambda (target)
- (set! new-comb-chord-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT new-comb-chord-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog new-comb-chord-dialog))
- #f)
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Comb chord filter (~1,2F ~D ~1,2F ~1,2F ~1,2F)"
- new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
- new-comb-chord-interval-one new-comb-chord-interval-two)))
- (change-label child new-label)))
- filter-menu-list)))
-
- ;; -------- Moog filter
-
- (let ((child (gtk_menu_item_new_with_label "Moog filter"))
- (moog-cutoff-frequency 10000)
- (moog-resonance 0.5)
- (moog-dialog #f)
- (moog-target 'sound))
-
- (define (moog freq Q)
- (let ((gen (make-moog-filter freq Q)))
- (lambda (inval)
- (moog-filter gen inval))))
+ (let ((child (gtk_menu_item_new_with_label "Band-pass filter"))
+ (band-pass-freq 1000)
+ (band-pass-bw 100)
+ (band-pass-dialog #f)
+ (band-pass-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not band-pass-dialog)
+ (let ((initial-band-pass-freq 1000)
+ (initial-band-pass-bw 100)
+ (sliders ()))
+ (set! band-pass-dialog
+ (make-effect-dialog
+ "Band-pass filter"
+
+ (lambda (w data)
+ (let ((flt (make-butter-band-pass band-pass-freq band-pass-bw)))
+ (if (eq? band-pass-target 'sound)
+ (filter-sound flt #f #f #f #f (format #f "effects-bbp ~A ~A 0 #f" band-pass-freq band-pass-bw))
+ (if (eq? band-pass-target 'selection)
+ (filter-selection flt)
+ (let* ((ms (plausible-mark-samples))
+ (bg (car ms))
+ (nd (+ 1 (- (cadr ms) (car ms)))))
+ (clm-channel flt bg nd #f #f #f #f
+ (format #f "effects-bbp ~A ~A ~A ~A" band-pass-freq band-pass-bw bg nd)))))))
+
+ (lambda (w data)
+ (help-dialog "Band-pass filter"
+ "Butterworth band-pass filter. Move the sliders to change the center frequency and bandwidth."))
+
+ (lambda (w data)
+ (set! band-pass-freq initial-band-pass-freq)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) (scale-log->linear 20 band-pass-freq 22050))
+ (set! band-pass-bw initial-band-pass-bw)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) band-pass-bw)
+ )
+
+ (lambda ()
+ (effect-target-ok band-pass-target))))
+
+ (set! sliders
+ (add-sliders band-pass-dialog
+ (list (list "center frequency" 20 initial-band-pass-freq 22050
+ (lambda (w data)
+ (set! band-pass-freq (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (car sliders))) 22050)))
+ 1 'log)
+ (list "bandwidth" 0 initial-band-pass-bw 1000
+ (lambda (w data)
+ (set! band-pass-bw (gtk_adjustment_get_value (GTK_ADJUSTMENT (cadr sliders)))))
+ 1))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG band-pass-dialog))
+ (lambda (target)
+ (set! band-pass-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT band-pass-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog band-pass-dialog))
+ #f)
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Band-pass filter (~,2F ~D)"
+ band-pass-freq band-pass-bw)))
+ (change-label child new-label)))
+ filter-menu-list)))
- (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not moog-dialog)
- (let ((initial-moog-cutoff-frequency 10000)
- (initial-moog-resonance 0.5)
- (sliders '()))
- (set! moog-dialog
- (make-effect-dialog
- "Moog filter"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (ignored) (moog moog-cutoff-frequency moog-resonance))
- moog-target
- (lambda (target samps)
- (format #f "effects-moog-filter ~A ~A" moog-cutoff-frequency moog-resonance))
- #f))
-
- (lambda (w data)
- (help-dialog "Moog filter"
- "Moog-style 4-pole lowpass filter with 24db/oct rolloff and variable resonance.
-Move the sliders to set the filter cutoff frequency and resonance."))
-
- (lambda (w data)
- (set! moog-cutoff-frequency initial-moog-cutoff-frequency)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) (scale-log->linear 20 moog-cutoff-frequency 22050))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! moog-resonance initial-moog-resonance)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) moog-resonance)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- )
-
- (lambda ()
- (effect-target-ok moog-target))))
-
- (set! sliders
- (add-sliders moog-dialog
- (list (list "cutoff frequency" 20 initial-moog-cutoff-frequency 22050
- (lambda (w data)
- (set! moog-cutoff-frequency (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0))) 22050)))
- 1 'log)
- (list "resonance" 0.0 initial-moog-resonance 1.0
- (lambda (w data)
- (set! moog-resonance (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG moog-dialog))
- (lambda (target)
- (set! moog-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT moog-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog moog-dialog))
- #f)
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Moog filter (~,2F ~1,2F)" moog-cutoff-frequency moog-resonance)))
- (change-label child new-label)))
- filter-menu-list)))
- )
-
-
-;;; FREQUENCY EFFECTS
-
-(let ((freq-menu-list '())
- (freq-menu (gtk_menu_item_new_with_label "Frequency Effects"))
- (freq-cascade (gtk_menu_new)))
- (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) freq-menu)
- (gtk_widget_show freq-menu)
- (gtk_menu_item_set_submenu (GTK_MENU_ITEM freq-menu) freq-cascade)
- (g_signal_connect freq-menu "activate" (lambda (w d) (update-label freq-menu-list)) #f)
-
- ;; -------- Adaptive saturation
-
- (let ((child (gtk_menu_item_new_with_label "Adaptive saturation"))
- (adsat-size 4)
- (adsat-dialog #f)
- (adsat-target 'sound))
-
- (define (cp-adsat)
- "adsat does weird stuff by adsat size"
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (let ((mn 0.0)
- (mx 0.0)
- (n 0)
- (vals (make-vct adsat-size)))
- (lambda (val)
- (if (= n adsat-size)
- (begin
- (do ((i 0 (+ 1 i)))
- ((= i adsat-size))
- (if (>= (vct-ref vals i) 0.0)
- (vct-set! vals i mx)
- (vct-set! vals i mn)))
- (set! n 0)
- (set! mx 0.0)
- (set! mn 0.0)
- vals)
- (begin
- (vct-set! vals n val)
- (if (> val mx) (set! mx val))
- (if (< val mn) (set! mn val))
- (set! n (+ 1 n))
- #f)))))
- adsat-target
- (lambda (target samps)
- (format #f "adsat ~A" adsat-size))
- #f))
+ ;; -------- Butterworth band-reject (notch) filter
- (gtk_menu_shell_append (GTK_MENU_SHELL freq-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not adsat-dialog)
- (let ((initial-adsat-size 4)
- (sliders '()))
- (set! adsat-dialog
- (make-effect-dialog
- "Adaptive saturation"
-
- (lambda (w data)
- (cp-adsat))
-
- (lambda (w data)
- (help-dialog "Adaptive saturation"
- "Move the slider to change the saturation scaling factor."))
-
- (lambda (w data)
- (set! adsat-size initial-adsat-size)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) adsat-size)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )
-
- (lambda ()
- (effect-target-ok adsat-target))))
-
- (set! sliders
- (add-sliders adsat-dialog
- (list (list "adaptive saturation size" 0 initial-adsat-size 10
- (lambda (w data)
- (set! adsat-size (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 1))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG adsat-dialog))
- (lambda (target)
- (set! adsat-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT adsat-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog adsat-dialog))
- #f)
- (set! freq-menu-list (cons (lambda ()
- (let ((new-label (format #f "Adaptive saturation (~D)" adsat-size)))
- (change-label child new-label)))
- freq-menu-list)))
-
- ;; -------- Sample rate conversion (resample)
-
- (let ((child (gtk_menu_item_new_with_label "Sample rate conversion"))
- (src-amount 0.0)
- (src-dialog #f)
- (src-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL freq-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not src-dialog)
- (let ((initial-src-amount 0.0)
- (sliders '()))
- (set! src-dialog
- (make-effect-dialog
- "Sample rate conversion"
-
- (lambda (w data)
- (if (eq? src-target 'sound)
- (src-sound src-amount)
- (if (eq? src-target 'selection)
- (if (selection?)
- (src-selection src-amount)
- (snd-print "no selection"))
- (snd-print "can't apply src between marks yet"))))
-
- (lambda (w data)
- (help-dialog "Sample rate conversion"
- "Move the slider to change the sample rate.
+ (let ((child (gtk_menu_item_new_with_label "Band-reject filter"))
+ (notch-freq 100)
+ (notch-bw 100)
+ (notch-dialog #f)
+ (notch-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not notch-dialog)
+ (let ((initial-notch-freq 100)
+ (initial-notch-bw 100)
+ (sliders ()))
+ (set! notch-dialog
+ (make-effect-dialog
+ "Band-reject filter"
+
+ (lambda (w data)
+ (let ((flt (make-butter-band-reject notch-freq notch-bw)))
+ (if (eq? notch-target 'sound)
+ (filter-sound flt #f #f #f #f (format #f "effects-bbr ~A ~A 0 #f" notch-freq notch-bw))
+ (if (eq? notch-target 'selection)
+ (filter-selection flt)
+ (let* ((ms (plausible-mark-samples))
+ (bg (car ms))
+ (nd (+ 1 (- (cadr ms) (car ms)))))
+ (clm-channel flt bg nd #f #f #f #f
+ (format #f "effects-bbr ~A ~A ~A ~A" notch-freq notch-bw bg nd)))))))
+
+ (lambda (w data)
+ (help-dialog "Band-reject filter"
+ "Butterworth band-reject filter. Move the sliders to change the center frequency and bandwidth."))
+
+ (lambda (w data)
+ (set! notch-freq initial-notch-freq)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) (scale-log->linear 20 notch-freq 22050))
+ (set! notch-bw initial-notch-bw)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) notch-bw)
+ )
+
+ (lambda ()
+ (effect-target-ok notch-target))))
+
+ (set! sliders
+ (add-sliders notch-dialog
+ (list (list "center frequency" 20 initial-notch-freq 22050
+ (lambda (w data)
+ (set! notch-freq (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (car sliders))) 22050)))
+ 1 'log)
+ (list "bandwidth" 0 initial-notch-bw 1000
+ (lambda (w data)
+ (set! notch-bw (gtk_adjustment_get_value (GTK_ADJUSTMENT (cadr sliders)))))
+ 1))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG notch-dialog))
+ (lambda (target)
+ (set! notch-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT notch-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog notch-dialog))
+ #f)
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Band-reject filter (~,2F ~D)" notch-freq notch-bw)))
+ (change-label child new-label)))
+ filter-menu-list)))
+
+ ;; -------- Butterworth high-pass filter
+
+ (let ((child (gtk_menu_item_new_with_label "High-pass filter"))
+ (high-pass-freq 100)
+ (high-pass-dialog #f)
+ (high-pass-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not high-pass-dialog)
+ (let ((initial-high-pass-freq 100)
+ (sliders ()))
+ (set! high-pass-dialog
+ (make-effect-dialog
+ "High-pass filter"
+
+ (lambda (w data)
+ (let ((flt (make-butter-high-pass high-pass-freq)))
+ (if (eq? high-pass-target 'sound)
+ (filter-sound flt #f #f #f #f (format #f "effects-bhp ~A 0 #f" high-pass-freq))
+ (if (eq? high-pass-target 'selection)
+ (filter-selection flt)
+ (let* ((ms (plausible-mark-samples))
+ (bg (car ms))
+ (nd (+ 1 (- (cadr ms) (car ms)))))
+ (clm-channel flt bg nd #f #f #f #f
+ (format #f "effects-bhp ~A ~A ~A" high-pass-freq bg nd)))))))
+
+ (lambda (w data)
+ (help-dialog "High-pass filter"
+ "Butterworth high-pass filter. Move the slider to change the high-pass cutoff frequency."))
+
+ (lambda (w data)
+ (set! high-pass-freq initial-high-pass-freq)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) (scale-log->linear 20 high-pass-freq 22050))
+ )
+
+ (lambda ()
+ (effect-target-ok high-pass-target))))
+
+ (set! sliders
+ (add-sliders high-pass-dialog
+ (list (list "high-pass cutoff frequency" 20 initial-high-pass-freq 22050
+ (lambda (w data)
+ (set! high-pass-freq (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0))) 22050)))
+ 1 'log))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG high-pass-dialog))
+ (lambda (target)
+ (set! high-pass-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT high-pass-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog high-pass-dialog))
+ #f)
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "High-pass filter (~,2F)" high-pass-freq)))
+ (change-label child new-label)))
+ filter-menu-list)))
+
+ ;; -------- Butterworth low-pass filter
+
+ (let ((child (gtk_menu_item_new_with_label "Low-pass filter"))
+ (low-pass-freq 1000)
+ (low-pass-dialog #f)
+ (low-pass-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not low-pass-dialog)
+ (let ((initial-low-pass-freq 1000)
+ (sliders ()))
+ (set! low-pass-dialog
+ (make-effect-dialog
+ "Low-pass filter"
+
+ (lambda (w data)
+ (let ((flt (make-butter-low-pass low-pass-freq)))
+ (if (eq? low-pass-target 'sound)
+ (filter-sound flt #f #f #f #f (format #f "effects-blp ~A 0 #f" low-pass-freq))
+ (if (eq? low-pass-target 'selection)
+ (filter-selection flt)
+ (let* ((ms (plausible-mark-samples))
+ (bg (car ms))
+ (nd (+ 1 (- (cadr ms) (car ms)))))
+ (clm-channel flt bg nd #f #f #f #f
+ (format #f "effects-blp ~A ~A ~A" low-pass-freq bg nd)))))))
+
+ (lambda (w data)
+ (help-dialog "Low-pass filter"
+ "Butterworth low-pass filter. Move the slider to change the low-pass cutoff frequency."))
+
+ (lambda (w data)
+ (set! low-pass-freq initial-low-pass-freq)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) (scale-log->linear 20 low-pass-freq 22050))
+ )
+
+ (lambda ()
+ (effect-target-ok low-pass-target))))
+
+ (set! sliders
+ (add-sliders low-pass-dialog
+ (list (list "low-pass cutoff frequency" 20 initial-low-pass-freq 22050
+ (lambda (w data)
+ (set! low-pass-freq (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0))) 22050)))
+ 1 'log))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG low-pass-dialog))
+ (lambda (target)
+ (set! low-pass-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT low-pass-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog low-pass-dialog))
+ #f)
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Low-pass filter (~,2F)" low-pass-freq)))
+ (change-label child new-label)))
+ filter-menu-list)))
+
+ ;; -------- Comb filter
+
+ (let ((child (gtk_menu_item_new_with_label "Comb filter"))
+ (comb-scaler 0.1)
+ (comb-size 50)
+ (comb-dialog #f)
+ (comb-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not comb-dialog)
+ (let ((initial-comb-scaler 0.1)
+ (initial-comb-size 50)
+ (sliders ()))
+ (set! comb-dialog
+ (make-effect-dialog
+ "Comb filter"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (effects-comb-filter comb-scaler comb-size))
+ comb-target
+ (lambda (target samps)
+ (format #f "effects-comb-filter ~A ~A" comb-scaler comb-size))
+ #f))
+
+ (lambda (w data)
+ (help-dialog "Comb filter"
+ "Move the sliders to change the comb scaler and size."))
+
+ (lambda (w data)
+ (set! comb-scaler initial-comb-scaler)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) comb-scaler)
+ (set! comb-size initial-comb-size)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) comb-size)
+ )
+
+ (lambda ()
+ (effect-target-ok comb-target))))
+
+ (set! sliders
+ (add-sliders comb-dialog
+ (list (list "scaler" 0.0 initial-comb-scaler 1.0
+ (lambda (w data)
+ (set! comb-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100)
+ (list "size" 0 initial-comb-size 100
+ (lambda (w data)
+ (set! comb-size (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 1))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG comb-dialog))
+ (lambda (target)
+ (set! comb-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT comb-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog comb-dialog))
+ #f)
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Comb filter (~1,2F ~D)" comb-scaler comb-size)))
+ (change-label child new-label)))
+ filter-menu-list)))
+
+ ;; -------- Comb-chord filter
+
+ (let ((child (gtk_menu_item_new_with_label "Comb chord filter"))
+ (new-comb-chord-scaler 0.95)
+ (new-comb-chord-size 60)
+ (new-comb-chord-amp 0.3)
+ (new-comb-chord-interval-one 0.75)
+ (new-comb-chord-interval-two 1.20)
+ (new-comb-chord-dialog #f)
+ (new-comb-chord-target 'sound))
+
+ (define new-comb-chord
+ (lambda (scaler size amp interval-one interval-two)
+ ;; Comb chord filter: create chords by using filters at harmonically related sizes.
+ (let ((cs (make-comb-bank (vector (make-comb scaler size)
+ (make-comb scaler (* size interval-one))
+ (make-comb scaler (* size interval-two))))))
+ (lambda (x)
+ (* amp (comb-bank cs x))))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not new-comb-chord-dialog)
+ (let ((initial-new-comb-chord-scaler 0.95)
+ (initial-new-comb-chord-size 60)
+ (initial-new-comb-chord-amp 0.3)
+ (initial-new-comb-chord-interval-one 0.75)
+ (initial-new-comb-chord-interval-two 1.20)
+ (sliders ()))
+ (set! new-comb-chord-dialog
+ (make-effect-dialog
+ "Comb chord filter"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (new-comb-chord new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
+ new-comb-chord-interval-one new-comb-chord-interval-two))
+ new-comb-chord-target
+ (lambda (target samps)
+ (format #f "effects-comb-chord ~A ~A ~A ~A ~A"
+ new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
+ new-comb-chord-interval-one new-comb-chord-interval-two))
+ #f))
+
+ (lambda (w data)
+ (help-dialog "Comb chord filter"
+ "Creates chords by using filters at harmonically related sizes.
+Move the sliders to set the comb chord parameters."))
+
+ (lambda (w data)
+ (set! new-comb-chord-scaler initial-new-comb-chord-scaler)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) new-comb-chord-scaler)
+ (set! new-comb-chord-size initial-new-comb-chord-size)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) new-comb-chord-size)
+ (set! new-comb-chord-amp initial-new-comb-chord-amp)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 2)) new-comb-chord-amp)
+ (set! new-comb-chord-interval-one initial-new-comb-chord-interval-one)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 3)) new-comb-chord-interval-one)
+ (set! new-comb-chord-interval-two initial-new-comb-chord-interval-two)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 4)) new-comb-chord-interval-two)
+ )
+
+ (lambda ()
+ (effect-target-ok new-comb-chord-target))))
+
+ (set! sliders
+ (add-sliders new-comb-chord-dialog
+ (list (list "chord scaler" 0.0 initial-new-comb-chord-scaler 1.0
+ (lambda (w data)
+ (set! new-comb-chord-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100)
+ (list "chord size" 0 initial-new-comb-chord-size 100
+ (lambda (w data)
+ (set! new-comb-chord-size (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 1)
+ (list "amplitude" 0.0 initial-new-comb-chord-amp 1.0
+ (lambda (w data)
+ (set! new-comb-chord-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 100)
+ (list "interval one" 0.0 initial-new-comb-chord-interval-one 2.0
+ (lambda (w data)
+ (set! new-comb-chord-interval-one (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 4)))))
+ 100)
+ (list "interval two" 0.0 initial-new-comb-chord-interval-two 2.0
+ (lambda (w data)
+ (set! new-comb-chord-interval-two (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 4)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG new-comb-chord-dialog))
+ (lambda (target)
+ (set! new-comb-chord-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT new-comb-chord-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog new-comb-chord-dialog))
+ #f)
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Comb chord filter (~1,2F ~D ~1,2F ~1,2F ~1,2F)"
+ new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
+ new-comb-chord-interval-one new-comb-chord-interval-two)))
+ (change-label child new-label)))
+ filter-menu-list)))
+
+ ;; -------- Moog filter
+
+ (let ((child (gtk_menu_item_new_with_label "Moog filter"))
+ (moog-cutoff-frequency 10000)
+ (moog-resonance 0.5)
+ (moog-dialog #f)
+ (moog-target 'sound))
+
+ (define (moog freq Q)
+ (let ((gen (make-moog-filter freq Q)))
+ (lambda (inval)
+ (moog-filter gen inval))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL filter-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not moog-dialog)
+ (let ((initial-moog-cutoff-frequency 10000)
+ (initial-moog-resonance 0.5)
+ (sliders ()))
+ (set! moog-dialog
+ (make-effect-dialog
+ "Moog filter"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (ignored) (moog moog-cutoff-frequency moog-resonance))
+ moog-target
+ (lambda (target samps)
+ (format #f "effects-moog-filter ~A ~A" moog-cutoff-frequency moog-resonance))
+ #f))
+
+ (lambda (w data)
+ (help-dialog "Moog filter"
+ "Moog-style 4-pole lowpass filter with 24db/oct rolloff and variable resonance.
+Move the sliders to set the filter cutoff frequency and resonance."))
+
+ (lambda (w data)
+ (set! moog-cutoff-frequency initial-moog-cutoff-frequency)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) (scale-log->linear 20 moog-cutoff-frequency 22050))
+ (set! moog-resonance initial-moog-resonance)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) moog-resonance)
+ )
+
+ (lambda ()
+ (effect-target-ok moog-target))))
+
+ (set! sliders
+ (add-sliders moog-dialog
+ (list (list "cutoff frequency" 20 initial-moog-cutoff-frequency 22050
+ (lambda (w data)
+ (set! moog-cutoff-frequency (scale-linear->log 20 (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0))) 22050)))
+ 1 'log)
+ (list "resonance" 0.0 initial-moog-resonance 1.0
+ (lambda (w data)
+ (set! moog-resonance (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG moog-dialog))
+ (lambda (target)
+ (set! moog-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT moog-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog moog-dialog))
+ #f)
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Moog filter (~,2F ~1,2F)" moog-cutoff-frequency moog-resonance)))
+ (change-label child new-label)))
+ filter-menu-list)))
+ )
+
+
+;;; FREQUENCY EFFECTS
+
+ (let ((freq-menu-list ())
+ (freq-menu (gtk_menu_item_new_with_label "Frequency Effects"))
+ (freq-cascade (gtk_menu_new)))
+ (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) freq-menu)
+ (gtk_widget_show freq-menu)
+ (gtk_menu_item_set_submenu (GTK_MENU_ITEM freq-menu) freq-cascade)
+ (g_signal_connect freq-menu "activate" (lambda (w d) (update-label freq-menu-list)) #f)
+
+ ;; -------- Sample rate conversion (resample)
+
+ (let ((child (gtk_menu_item_new_with_label "Sample rate conversion"))
+ (src-amount 0.0)
+ (src-dialog #f)
+ (src-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL freq-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not src-dialog)
+ (let ((initial-src-amount 0.0)
+ (sliders ()))
+ (set! src-dialog
+ (make-effect-dialog
+ "Sample rate conversion"
+
+ (lambda (w data)
+ (if (eq? src-target 'sound)
+ (src-sound src-amount)
+ (if (eq? src-target 'selection)
+ (if (selection?)
+ (src-selection src-amount)
+ (snd-print "no selection"))
+ (snd-print "can't apply src between marks yet"))))
+
+ (lambda (w data)
+ (help-dialog "Sample rate conversion"
+ "Move the slider to change the sample rate.
Values greater than 1.0 speed up file play, negative values reverse it."))
-
- (lambda (w data)
- (set! src-amount initial-src-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) src-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )
-
- (lambda ()
- (effect-target-ok src-target))))
-
- (set! sliders
- (add-sliders src-dialog
- (list (list "sample rate" -2.0 initial-src-amount 2.0
- (lambda (w data)
- (set! src-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG src-dialog))
- (lambda (target)
- (set! src-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT src-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog src-dialog))
- #f)
- (set! freq-menu-list (cons (lambda ()
- (let ((new-label (format #f "Sample rate scaling (~1,2F)" src-amount)))
- (change-label child new-label)))
- freq-menu-list)))
-
- ;; -------- Time and pitch scaling by granular synthesis and sampling rate conversion
-
- (let ((child (gtk_menu_item_new_with_label "Time/pitch scaling"))
- (time-scale 1.0)
- (hop-size 0.05)
- (segment-length 0.15)
- (ramp-scale 0.5)
- (pitch-scale 1.0)
- (expsrc-dialog #f)
- (expsrc-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL freq-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not expsrc-dialog)
- (let ((initial-time-scale 1.0)
- (initial-hop-size 0.05)
- (initial-segment-length 0.15)
- (initial-ramp-scale 0.5)
- (initial-pitch-scale 1.0)
- (sliders '()))
- (set! expsrc-dialog
- (make-effect-dialog
- "Time/pitch scaling"
-
- (lambda (w data)
- (let ((snd (selected-sound)))
- (save-controls snd)
- (reset-controls snd)
- (set! (speed-control snd) pitch-scale)
- (let ((new-time (* pitch-scale time-scale)))
- (if (not (= new-time 1.0))
- (begin
- (set! (expand-control? snd) #t)
- (set! (expand-control snd) new-time)
- (set! (expand-control-hop snd) hop-size)
- (set! (expand-control-length snd) segment-length)
- (set! (expand-control-ramp snd) ramp-scale))))
- (if (eq? expsrc-target 'marks)
- (let ((ms (plausible-mark-samples)))
- (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
- (apply-controls snd (if (eq? expsrc-target 'sound) 0 2)))
- (restore-controls snd)))
-
- (lambda (w data)
- (help-dialog "Time/pitch scaling"
- "Move the sliders to change the time/pitch scaling parameters."))
-
- (lambda (w data)
- (set! time-scale initial-time-scale)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) time-scale)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! hop-size initial-hop-size)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) hop-size)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! segment-length initial-segment-length)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 2)) segment-length)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- (set! ramp-scale initial-ramp-scale)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 3)) ramp-scale)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 3)))
- (set! pitch-scale initial-pitch-scale)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 4)) pitch-scale)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 4)))
- )
-
- (lambda ()
- (effect-target-ok expsrc-target))))
-
- (set! sliders
- (add-sliders expsrc-dialog
- (list (list "time scale" 0.0 initial-time-scale 5.0
- (lambda (w data)
- (set! time-scale (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100)
- (list "hop size" 0.0 initial-hop-size 1.0
- (lambda (w data)
- (set! hop-size (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 100)
- (list "segment length" 0.0 initial-segment-length 0.5
- (lambda (w data)
- (set! segment-length (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 100)
- (list "ramp scale" 0.0 initial-ramp-scale 0.5
- (lambda (w data)
- (set! ramp-scale (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 3)))))
- 1000)
- (list "pitch scale" 0.0 initial-pitch-scale 5.0
- (lambda (w data)
- (set! pitch-scale (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 4)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG expsrc-dialog))
- (lambda (target)
- (set! expsrc-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT expsrc-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog expsrc-dialog))
- #f)
- (set! freq-menu-list (cons (lambda ()
- (let ((new-label (format #f "Time/pitch scaling (~1,2F ~1,2F)" time-scale pitch-scale)))
- (change-label child new-label)))
- freq-menu-list)))
-
+
+ (lambda (w data)
+ (set! src-amount initial-src-amount)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) src-amount)
+ )
+
+ (lambda ()
+ (effect-target-ok src-target))))
+
+ (set! sliders
+ (add-sliders src-dialog
+ (list (list "sample rate" -2.0 initial-src-amount 2.0
+ (lambda (w data)
+ (set! src-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG src-dialog))
+ (lambda (target)
+ (set! src-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT src-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog src-dialog))
+ #f)
+ (set! freq-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Sample rate scaling (~1,2F)" src-amount)))
+ (change-label child new-label)))
+ freq-menu-list)))
+
+ ;; -------- Time and pitch scaling by granular synthesis and sampling rate conversion
+
+ (let ((child (gtk_menu_item_new_with_label "Time/pitch scaling"))
+ (time-scale 1.0)
+ (hop-size 0.05)
+ (segment-length 0.15)
+ (ramp-scale 0.5)
+ (pitch-scale 1.0)
+ (expsrc-dialog #f)
+ (expsrc-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL freq-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not expsrc-dialog)
+ (let ((initial-time-scale 1.0)
+ (initial-hop-size 0.05)
+ (initial-segment-length 0.15)
+ (initial-ramp-scale 0.5)
+ (initial-pitch-scale 1.0)
+ (sliders ()))
+ (set! expsrc-dialog
+ (make-effect-dialog
+ "Time/pitch scaling"
+
+ (lambda (w data)
+ (let ((snd (selected-sound)))
+ (save-controls snd)
+ (reset-controls snd)
+ (set! (speed-control snd) pitch-scale)
+ (let ((new-time (* pitch-scale time-scale)))
+ (if (not (= new-time 1.0))
+ (begin
+ (set! (expand-control? snd) #t)
+ (set! (expand-control snd) new-time)
+ (set! (expand-control-hop snd) hop-size)
+ (set! (expand-control-length snd) segment-length)
+ (set! (expand-control-ramp snd) ramp-scale))))
+ (if (eq? expsrc-target 'marks)
+ (let ((ms (plausible-mark-samples)))
+ (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
+ (apply-controls snd (if (eq? expsrc-target 'sound) 0 2)))
+ (restore-controls snd)))
+
+ (lambda (w data)
+ (help-dialog "Time/pitch scaling"
+ "Move the sliders to change the time/pitch scaling parameters."))
+
+ (lambda (w data)
+ (set! time-scale initial-time-scale)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) time-scale)
+ (set! hop-size initial-hop-size)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) hop-size)
+ (set! segment-length initial-segment-length)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 2)) segment-length)
+ (set! ramp-scale initial-ramp-scale)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 3)) ramp-scale)
+ (set! pitch-scale initial-pitch-scale)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 4)) pitch-scale)
+ )
+
+ (lambda ()
+ (effect-target-ok expsrc-target))))
+
+ (set! sliders
+ (add-sliders expsrc-dialog
+ (list (list "time scale" 0.0 initial-time-scale 5.0
+ (lambda (w data)
+ (set! time-scale (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100)
+ (list "hop size" 0.0 initial-hop-size 1.0
+ (lambda (w data)
+ (set! hop-size (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 100)
+ (list "segment length" 0.0 initial-segment-length 0.5
+ (lambda (w data)
+ (set! segment-length (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 100)
+ (list "ramp scale" 0.0 initial-ramp-scale 0.5
+ (lambda (w data)
+ (set! ramp-scale (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 3)))))
+ 1000)
+ (list "pitch scale" 0.0 initial-pitch-scale 5.0
+ (lambda (w data)
+ (set! pitch-scale (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 4)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG expsrc-dialog))
+ (lambda (target)
+ (set! expsrc-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT expsrc-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog expsrc-dialog))
+ #f)
+ (set! freq-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Time/pitch scaling (~1,2F ~1,2F)" time-scale pitch-scale)))
+ (change-label child new-label)))
+ freq-menu-list)))
+
;;; -------- Time-varying sample rate conversion (resample)
;;; (KSM)
-
- (let ((child (gtk_menu_item_new_with_label "Src-timevar"))
- (src-timevar-scale 1.0)
- (src-timevar-dialog #f)
- (src-timevar-target 'sound)
- (src-timevar-envelope #f))
-
- (define (scale-envelope e scl)
- (if (null? e)
- '()
- (append (list (car e) (* scl (cadr e)))
- (scale-envelope (cddr e) scl))))
-
- (gtk_menu_shell_append (GTK_MENU_SHELL freq-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not src-timevar-dialog)
- (let ((initial-src-timevar-scale 1.0)
- (sliders '()))
- (set! src-timevar-dialog
- (make-effect-dialog
- "Src-Timevar"
-
- (lambda (w data)
- (let ((env (scale-envelope (xe-envelope src-timevar-envelope)
- src-timevar-scale)))
- (if (eq? src-timevar-target 'sound)
- (src-sound env)
- (if (eq? src-timevar-target 'selection)
- (if (selection-member? (selected-sound))
- (src-selection env)
- (display "no selection"))
- (let ((pts (plausible-mark-samples)))
- (if pts
- (let* ((beg (car pts))
- (end (cadr pts))
- (len (- end beg)))
- (src-channel (make-env env :length len) beg len (selected-sound)))))))))
-
- (lambda (w data)
- (help-dialog
- "Src-Timevar"
- "Move the slider to change the src-timevar scaling amount."))
-
- (lambda (w data)
- (set! src-timevar-amount initial-src-timevar-scale)
- (set! (xe-envelope src-timevar-envelope) (list 0.0 1.0 1.0 1.0))
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) src-timevar-scale)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- )
-
- (lambda ()
- (effect-target-ok src-timevar-target))))
-
- (set! sliders
- (add-sliders src-timevar-dialog
- (list (list "Resample factor" 0.0 initial-src-timevar-scale 10.0
- (lambda (w data)
- (set! src-timevar-scale (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- 100))))
- (gtk_widget_show src-timevar-dialog)
- (set! src-timevar-envelope (xe-create-enved "src-timevar"
- (gtk_dialog_get_content_area (GTK_DIALOG src-timevar-dialog))
- #f
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope src-timevar-envelope) (list 0.0 1.0 1.0 1.0))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG src-timevar-dialog))
- (lambda (target)
- (set! src-timevar-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT src-timevar-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog src-timevar-dialog))
- #f)
- (set! freq-menu-list (cons (lambda ()
- (let ((new-label (format #f "Src-Timevar")))
- (change-label child new-label)))
- freq-menu-list)))
+
+ (let ((child (gtk_menu_item_new_with_label "Src-timevar"))
+ (src-timevar-scale 1.0)
+ (src-timevar-dialog #f)
+ (src-timevar-target 'sound)
+ (src-timevar-envelope #f))
+
+ (define (scale-envelope e scl)
+ (if (null? e)
+ ()
+ (append (list (car e) (* scl (cadr e)))
+ (scale-envelope (cddr e) scl))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL freq-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not src-timevar-dialog)
+ (let ((initial-src-timevar-scale 1.0)
+ (sliders ()))
+ (set! src-timevar-dialog
+ (make-effect-dialog
+ "Src-Timevar"
+
+ (lambda (w data)
+ (let ((env (scale-envelope (xe-envelope src-timevar-envelope)
+ src-timevar-scale)))
+ (if (eq? src-timevar-target 'sound)
+ (src-sound env)
+ (if (eq? src-timevar-target 'selection)
+ (if (selection-member? (selected-sound))
+ (src-selection env)
+ (display "no selection"))
+ (let ((pts (plausible-mark-samples)))
+ (if pts
+ (let* ((beg (car pts))
+ (end (cadr pts))
+ (len (- end beg)))
+ (src-channel (make-env env :length len) beg len (selected-sound)))))))))
+
+ (lambda (w data)
+ (help-dialog
+ "Src-Timevar"
+ "Move the slider to change the src-timevar scaling amount."))
+
+ (lambda (w data)
+ (set! src-timevar-amount initial-src-timevar-scale)
+ (set! (xe-envelope src-timevar-envelope) (list 0.0 1.0 1.0 1.0))
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) src-timevar-scale)
+ )
+
+ (lambda ()
+ (effect-target-ok src-timevar-target))))
+
+ (set! sliders
+ (add-sliders src-timevar-dialog
+ (list (list "Resample factor" 0.0 initial-src-timevar-scale 10.0
+ (lambda (w data)
+ (set! src-timevar-scale (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
+ 100))))
+ (gtk_widget_show src-timevar-dialog)
+ (set! src-timevar-envelope (xe-create-enved "src-timevar"
+ (gtk_dialog_get_content_area (GTK_DIALOG src-timevar-dialog))
+ #f
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope src-timevar-envelope) (list 0.0 1.0 1.0 1.0))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG src-timevar-dialog))
+ (lambda (target)
+ (set! src-timevar-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT src-timevar-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog src-timevar-dialog))
+ #f)
+ (set! freq-menu-list (cons (lambda ()
+ (let ((new-label "Src-Timevar"))
+ (change-label child new-label)))
+ freq-menu-list)))
)
-
+
;;; MODULATION EFFECTS
-
-(define* (effects-am freq en beg dur snd chn)
- (let* ((os (make-oscil freq))
- (e (and en (make-env en :length dur))))
- (map-channel (if e
- (lambda (inval)
- (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
- (lambda (inval)
- (amplitude-modulate 1.0 inval (oscil os))))
- beg dur snd chn #f
- (format #f "effects-am ~A ~A ~A ~A" freq (if en (format #f "'~A" en) #f) beg dur))))
-
-(define* (effects-rm freq gliss-env beg dur snd chn)
- (let* ((os (make-oscil freq))
- (e (and gliss-env (make-env gliss-env :length dur))))
- (map-channel (if e
- (lambda (inval)
- (* inval (* (env e) (oscil os))))
- (lambda (inval)
- (* inval (oscil os))))
- beg dur snd chn #f
- (format #f "effects-rm ~A ~A ~A ~A" freq (if gliss-env (format #f "'~A" gliss-env) #f) beg dur))))
-
-(let ((mod-menu-list '())
- (mod-menu (gtk_menu_item_new_with_label "Modulation Effects"))
- (mod-cascade (gtk_menu_new)))
- (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) mod-menu)
- (gtk_widget_show mod-menu)
- (gtk_menu_item_set_submenu (GTK_MENU_ITEM mod-menu) mod-cascade)
- (g_signal_connect mod-menu "activate" (lambda (w d) (update-label mod-menu-list)) #f)
-
- ;; -------- Amplitude modulation
-
- (let ((child (gtk_menu_item_new_with_label "Amplitude modulation"))
- (am-effect-amount 100.0)
- (am-effect-dialog #f)
- (am-effect-target 'sound)
- (am-effect-envelope #f))
-
- (define am-effect
- (lambda (freq)
- (let* ((os (make-oscil freq))
- (need-env (not (equal? (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))))
- (e (and need-env (make-env (xe-envelope am-effect-envelope) :length (effect-frames am-effect-target)))))
- (if need-env
- (lambda (inval)
- (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
- (lambda (inval)
- (amplitude-modulate 1.0 inval (oscil os)))))))
+
+ (define* (effects-am freq en beg dur snd chn)
+ (let ((os (make-oscil freq))
+ (e (and en (make-env en :length dur))))
+ (map-channel (if e
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (oscil os))))
+ beg dur snd chn #f
+ (format #f "effects-am ~A ~A ~A ~A" freq (and en (format #f "'~A" en)) beg dur))))
+
+ (define* (effects-rm freq gliss-env beg dur snd chn)
+ (let ((os (make-oscil freq))
+ (e (and gliss-env (make-env gliss-env :length dur))))
+ (map-channel (if e
+ (lambda (inval)
+ (* inval (env e) (oscil os)))
+ (lambda (inval)
+ (* inval (oscil os))))
+ beg dur snd chn #f
+ (format #f "effects-rm ~A ~A ~A ~A" freq (and gliss-env (format #f "'~A" gliss-env)) beg dur))))
+
+ (let ((mod-menu-list ())
+ (mod-menu (gtk_menu_item_new_with_label "Modulation Effects"))
+ (mod-cascade (gtk_menu_new)))
+ (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) mod-menu)
+ (gtk_widget_show mod-menu)
+ (gtk_menu_item_set_submenu (GTK_MENU_ITEM mod-menu) mod-cascade)
+ (g_signal_connect mod-menu "activate" (lambda (w d) (update-label mod-menu-list)) #f)
- (gtk_menu_shell_append (GTK_MENU_SHELL mod-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not am-effect-dialog)
- (let ((initial-am-effect-amount 100.0)
- (sliders '()))
- (set! am-effect-dialog
- (make-effect-dialog
- "Amplitude modulation"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (am-effect am-effect-amount))
- am-effect-target
- (lambda (target samps)
- (format #f "effects-am ~A ~A" am-effect-amount
- (let* ((need-env (not (equal? (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))))
- (e (and need-env (xe-envelope am-effect-envelope))))
- (if e (format #f "'~A" e)
- #f))))
- #f))
-
- (lambda (w data)
- (help-dialog "Amplitude modulation"
- "Move the slider to change the modulation amount."))
-
- (lambda (w data)
- (set! am-effect-amount initial-am-effect-amount)
- (set! (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) am-effect-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )
-
- (lambda ()
- (effect-target-ok am-effect-target))))
-
- (set! sliders
- (add-sliders am-effect-dialog
- (list (list "amplitude modulation" 0.0 initial-am-effect-amount 1000.0
- (lambda (w data)
- (set! am-effect-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 1))))
- (gtk_widget_show am-effect-dialog)
- (set! am-effect-envelope (xe-create-enved "am"
- (gtk_dialog_get_content_area (GTK_DIALOG am-effect-dialog))
- #f
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG am-effect-dialog))
- (lambda (target)
- (set! am-effect-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT am-effect-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog am-effect-dialog))
- #f)
- (set! mod-menu-list (cons (lambda ()
- (let ((new-label (format #f "Amplitude modulation (~1,2F)" am-effect-amount)))
- (change-label child new-label)))
- mod-menu-list)))
-
- ;; -------- Ring modulation
+ ;; -------- Amplitude modulation
- (let ((child (gtk_menu_item_new_with_label "Ring modulation"))
- (rm-frequency 100)
- (rm-radians 100)
- (rm-dialog #f)
- (rm-target 'sound)
- (rm-envelope #f))
-
- (define rm-effect ; avoid collision with examp.scm
- (lambda (freq gliss-env)
- (let* ((os (make-oscil freq))
- (need-env (and rm-envelope (not (equal? (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0)))))
- (e (and need-env (make-env (xe-envelope rm-envelope) :length (effect-frames rm-target))))
- (len (frames))
- (genv (make-env :envelope gliss-env :length len)))
- (if need-env
- (lambda (inval)
- (* inval (* (env e) (oscil os (env genv)))))
- (lambda (inval)
- (* inval (oscil os (env genv))))))))
-
- (gtk_menu_shell_append (GTK_MENU_SHELL mod-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not rm-dialog)
- (let ((initial-rm-frequency 100)
- (initial-rm-radians 100)
- (sliders '()))
- (set! rm-dialog
- (make-effect-dialog
- "Ring modulation"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (rm-effect rm-frequency (list 0 0 1 (hz->radians rm-radians))))
- rm-target
- (lambda (target samps)
- (format #f "effects-rm ~A ~A" rm-frequency
- (let* ((need-env (not (equal? (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))))
- (e (and need-env (xe-envelope rm-envelope))))
- (if e (format #f "'~A" e)
- #f))))
- #f))
-
- (lambda (w data)
- (help-dialog "Ring modulation"
- "Move the slider to change the ring modulation parameters."))
-
- (lambda (w data)
- (set! rm-frequency initial-rm-frequency)
- (set! (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) rm-frequency)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! rm-radians initial-rm-radians)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) rm-radians)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- )
-
- (lambda ()
- (effect-target-ok rm-target))))
-
- (set! sliders
- (add-sliders rm-dialog
- (list
- (list "modulation frequency" 0 initial-rm-frequency 1000
- (lambda (w data)
- (set! rm-frequency (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 1)
- (list "modulation radians" 0 initial-rm-radians 360
- (lambda (w data)
- (set! rm-radians (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 1))))
- (gtk_widget_show rm-dialog)
- (set! rm-envelope (xe-create-enved "rm frequency"
- (gtk_dialog_get_content_area (GTK_DIALOG rm-dialog))
- #f
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG rm-dialog))
- (lambda (target)
- (set! rm-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT rm-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog rm-dialog))
- #f)
- (set! mod-menu-list (cons (lambda ()
- (let ((new-label (format #f "Ring modulation (~D ~D)"
- rm-frequency rm-radians)))
- (change-label child new-label)))
- mod-menu-list)))
- )
-
-
+ (let ((child (gtk_menu_item_new_with_label "Amplitude modulation"))
+ (am-effect-amount 100.0)
+ (am-effect-dialog #f)
+ (am-effect-target 'sound)
+ (am-effect-envelope #f))
+
+ (define am-effect
+ (lambda (freq)
+ (let* ((os (make-oscil freq))
+ (need-env (not (equal? (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))))
+ (e (and need-env (make-env (xe-envelope am-effect-envelope) :length (effect-framples am-effect-target)))))
+ (if need-env
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (oscil os)))))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL mod-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not am-effect-dialog)
+ (let ((initial-am-effect-amount 100.0)
+ (sliders ()))
+ (set! am-effect-dialog
+ (make-effect-dialog
+ "Amplitude modulation"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (am-effect am-effect-amount))
+ am-effect-target
+ (lambda (target samps)
+ (format #f "effects-am ~A ~A" am-effect-amount
+ (let* ((need-env (not (equal? (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))))
+ (e (and need-env (xe-envelope am-effect-envelope))))
+ (and e (format #f "'~A" e)))))
+ #f))
+
+ (lambda (w data)
+ (help-dialog "Amplitude modulation"
+ "Move the slider to change the modulation amount."))
+
+ (lambda (w data)
+ (set! am-effect-amount initial-am-effect-amount)
+ (set! (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) am-effect-amount)
+ )
+
+ (lambda ()
+ (effect-target-ok am-effect-target))))
+
+ (set! sliders
+ (add-sliders am-effect-dialog
+ (list (list "amplitude modulation" 0.0 initial-am-effect-amount 1000.0
+ (lambda (w data)
+ (set! am-effect-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 1))))
+ (gtk_widget_show am-effect-dialog)
+ (set! am-effect-envelope (xe-create-enved "am"
+ (gtk_dialog_get_content_area (GTK_DIALOG am-effect-dialog))
+ #f
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG am-effect-dialog))
+ (lambda (target)
+ (set! am-effect-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT am-effect-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog am-effect-dialog))
+ #f)
+ (set! mod-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Amplitude modulation (~1,2F)" am-effect-amount)))
+ (change-label child new-label)))
+ mod-menu-list)))
+
+ ;; -------- Ring modulation
+
+ (let ((child (gtk_menu_item_new_with_label "Ring modulation"))
+ (rm-frequency 100)
+ (rm-radians 100)
+ (rm-dialog #f)
+ (rm-target 'sound)
+ (rm-envelope #f))
+
+ (define rm-effect ; avoid collision with examp.scm
+ (lambda (freq gliss-env)
+ (let* ((os (make-oscil freq))
+ (need-env (and rm-envelope (not (equal? (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0)))))
+ (e (and need-env (make-env (xe-envelope rm-envelope) :length (effect-framples rm-target))))
+ (len (framples))
+ (genv (make-env :envelope gliss-env :length len)))
+ (if need-env
+ (lambda (inval)
+ (* inval (env e) (oscil os (env genv))))
+ (lambda (inval)
+ (* inval (oscil os (env genv))))))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL mod-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not rm-dialog)
+ (let ((initial-rm-frequency 100)
+ (initial-rm-radians 100)
+ (sliders ()))
+ (set! rm-dialog
+ (make-effect-dialog
+ "Ring modulation"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (rm-effect rm-frequency (list 0 0 1 (hz->radians rm-radians))))
+ rm-target
+ (lambda (target samps)
+ (format #f "effects-rm ~A ~A" rm-frequency
+ (let* ((need-env (not (equal? (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))))
+ (e (and need-env (xe-envelope rm-envelope))))
+ (and e (format #f "'~A" e)))))
+ #f))
+
+ (lambda (w data)
+ (help-dialog "Ring modulation"
+ "Move the slider to change the ring modulation parameters."))
+
+ (lambda (w data)
+ (set! rm-frequency initial-rm-frequency)
+ (set! (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) rm-frequency)
+ (set! rm-radians initial-rm-radians)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) rm-radians)
+ )
+
+ (lambda ()
+ (effect-target-ok rm-target))))
+
+ (set! sliders
+ (add-sliders rm-dialog
+ (list
+ (list "modulation frequency" 0 initial-rm-frequency 1000
+ (lambda (w data)
+ (set! rm-frequency (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 1)
+ (list "modulation radians" 0 initial-rm-radians 360
+ (lambda (w data)
+ (set! rm-radians (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 1))))
+ (gtk_widget_show rm-dialog)
+ (set! rm-envelope (xe-create-enved "rm frequency"
+ (gtk_dialog_get_content_area (GTK_DIALOG rm-dialog))
+ #f
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG rm-dialog))
+ (lambda (target)
+ (set! rm-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT rm-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog rm-dialog))
+ #f)
+ (set! mod-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Ring modulation (~D ~D)"
+ rm-frequency rm-radians)))
+ (change-label child new-label)))
+ mod-menu-list)))
+ )
+
+
;;; REVERBS
-
-(define* (effects-cnv snd0-1 amp snd chn)
- (let* ((snd0 (if (sound? snd0-1) snd0-1 (car (sounds))))
- (flt-len (frames snd0))
- (total-len (+ flt-len (frames snd chn)))
- (cnv (make-convolve :filter (channel->vct 0 flt-len snd0)))
- (sf (make-sampler 0 snd chn))
- (out-data (make-vct total-len)))
- (vct-map! out-data (lambda () (convolve cnv (lambda (dir) (next-sample sf)))))
- (free-sampler sf)
- (vct-scale! out-data amp)
- (let ((max-samp (vct-peak out-data)))
- (vct->channel out-data 0 total-len snd chn #f (format #f "effects-cnv ~A ~A" snd0 amp))
- (if (> max-samp 1.0) (set! (y-bounds snd chn) (list (- max-samp) max-samp)))
- max-samp)))
-
-(define (effects-jc-reverb input-samps volume)
- (let* ((allpass1 (make-all-pass -0.700 0.700 1051))
- (allpass2 (make-all-pass -0.700 0.700 337))
- (allpass3 (make-all-pass -0.700 0.700 113))
- (comb1 (make-comb 0.742 4799))
- (comb2 (make-comb 0.733 4999))
- (comb3 (make-comb 0.715 5399))
- (comb4 (make-comb 0.697 5801))
- (outdel1 (make-delay (round (* .013 (srate)))))
- (comb-sum 0.0)
- (comb-sum-1 0.0)
- (comb-sum-2 0.0)
- (samp 0))
- (lambda (inval)
- (let ((allpass-sum (all-pass allpass3
- (all-pass allpass2
- (all-pass allpass1
- (if (< samp input-samps) inval 0.0))))))
- (set! samp (+ 1 samp))
- (set! comb-sum-2 comb-sum-1)
- (set! comb-sum-1 comb-sum)
- (set! comb-sum
- (+ (comb comb1 allpass-sum)
- (comb comb2 allpass-sum)
- (comb comb3 allpass-sum)
- (comb comb4 allpass-sum)))
- (+ inval
- (* volume (delay outdel1 comb-sum)))))))
+
+ (define* (effects-cnv snd0-1 amp snd chn)
+ (let* ((snd0 (if (sound? snd0-1) snd0-1 (car (sounds))))
+ (flt-len (framples snd0))
+ (total-len (+ flt-len (framples snd chn)))
+ (cnv (make-convolve :filter (channel->float-vector 0 flt-len snd0)
+ :input (make-sampler 0 snd chn)))
+ (out-data (make-float-vector total-len)))
+ (do ((i 0 (+ i 1)))
+ ((= i total-len))
+ (set! (out-data i) (convolve cnv)))
+ (float-vector-scale! out-data amp)
+ (let ((max-samp (float-vector-peak out-data)))
+ (float-vector->channel out-data 0 total-len snd chn #f (format #f "effects-cnv ~A ~A" snd0 amp))
+ (if (> max-samp 1.0) (set! (y-bounds snd chn) (list (- max-samp) max-samp)))
+ max-samp)))
+
+ (define (effects-jc-reverb input-samps volume)
+ (let ((allpass1 (make-all-pass -0.700 0.700 1051))
+ (allpass2 (make-all-pass -0.700 0.700 337))
+ (allpass3 (make-all-pass -0.700 0.700 113))
+ (comb1 (make-comb 0.742 4799))
+ (comb2 (make-comb 0.733 4999))
+ (comb3 (make-comb 0.715 5399))
+ (comb4 (make-comb 0.697 5801))
+ (outdel1 (make-delay (round (* .013 (srate)))))
+ (e (make-env '(0 1 1 0) :scaler volume :base 0.0 :length input-samps)))
+ (let ((combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
+ (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
+ (lambda (inval)
+ (+ inval
+ (* volume (delay outdel1 (comb-bank combs (all-pass-bank allpasses (* (env e) inval))))))))))
+
+ (define* (effects-jc-reverb-1 volume beg dur snd chn)
+ (map-channel (effects-jc-reverb (or dur (framples snd chn)) volume)
+ beg dur snd chn #f
+ (format #f "effects-jc-reverb-1 ~A ~A ~A" volume beg dur)))
+
+ (let ((reverb-menu-list ())
+ (reverb-menu (gtk_menu_item_new_with_label "Reverberation"))
+ (reverb-cascade (gtk_menu_new)))
+ (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) reverb-menu)
+ (gtk_widget_show reverb-menu)
+ (gtk_menu_item_set_submenu (GTK_MENU_ITEM reverb-menu) reverb-cascade)
+ (g_signal_connect reverb-menu "activate" (lambda (w d) (update-label reverb-menu-list)) #f)
-(define* (effects-jc-reverb-1 volume beg dur snd chn)
- (map-channel (effects-jc-reverb (or dur (frames snd chn)) volume)
- beg dur snd chn #f
- (format #f "effects-jc-reverb-1 ~A ~A ~A" volume beg dur)))
-
-(let ((reverb-menu-list '())
- (reverb-menu (gtk_menu_item_new_with_label "Reverberation"))
- (reverb-cascade (gtk_menu_new)))
- (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) reverb-menu)
- (gtk_widget_show reverb-menu)
- (gtk_menu_item_set_submenu (GTK_MENU_ITEM reverb-menu) reverb-cascade)
- (g_signal_connect reverb-menu "activate" (lambda (w d) (update-label reverb-menu-list)) #f)
-
- ;; -------- Reverb from Michael McNabb's Nrev
-
- (let ((child (gtk_menu_item_new_with_label "McNabb reverb"))
- (reverb-amount 0.1)
- (reverb-filter 0.5)
- (reverb-feedback 1.09)
- (reverb-dialog #f)
- (reverb-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL reverb-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- ;; add reverb-control-decay (with ramp?) and reverb-truncate
- (if (not reverb-dialog)
- (let ((initial-reverb-amount 0.1)
- (initial-reverb-filter 0.5)
- (initial-reverb-feedback 1.09)
- (sliders '()))
- (set! reverb-dialog
- (make-effect-dialog
- "McNabb reverb"
-
- (lambda (w data)
- (let ((snd (selected-sound)))
- (save-controls snd)
- (reset-controls snd)
- (set! (reverb-control? snd) #t)
- (set! (reverb-control-scale snd) reverb-amount)
- (set! (reverb-control-lowpass snd) reverb-filter)
- (set! (reverb-control-feedback snd) reverb-feedback)
- (if (eq? reverb-target 'marks)
- (let ((ms (plausible-mark-samples)))
- (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
- (apply-controls snd (if (eq? reverb-target 'sound) 0 2)))
- (restore-controls snd)))
-
- (lambda (w data)
- (help-dialog "McNabb reverb"
- "Reverberator from Michael McNabb.
+ ;; -------- Reverb from Michael McNabb's Nrev
+
+ (let ((child (gtk_menu_item_new_with_label "McNabb reverb"))
+ (reverb-amount 0.1)
+ (reverb-filter 0.5)
+ (reverb-feedback 1.09)
+ (reverb-dialog #f)
+ (reverb-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL reverb-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ ;; add reverb-control-decay (with ramp?) and reverb-truncate
+ (if (not reverb-dialog)
+ (let ((initial-reverb-amount 0.1)
+ (initial-reverb-filter 0.5)
+ (initial-reverb-feedback 1.09)
+ (sliders ()))
+ (set! reverb-dialog
+ (make-effect-dialog
+ "McNabb reverb"
+
+ (lambda (w data)
+ (let ((snd (selected-sound)))
+ (save-controls snd)
+ (reset-controls snd)
+ (set! (reverb-control? snd) #t)
+ (set! (reverb-control-scale snd) reverb-amount)
+ (set! (reverb-control-lowpass snd) reverb-filter)
+ (set! (reverb-control-feedback snd) reverb-feedback)
+ (if (eq? reverb-target 'marks)
+ (let ((ms (plausible-mark-samples)))
+ (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
+ (apply-controls snd (if (eq? reverb-target 'sound) 0 2)))
+ (restore-controls snd)))
+
+ (lambda (w data)
+ (help-dialog "McNabb reverb"
+ "Reverberator from Michael McNabb.
Adds reverberation scaled by reverb amount, lowpass filtering, and feedback. Move the sliders to change the reverb parameters."))
-
- (lambda (w data)
- (set! reverb-amount initial-reverb-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) reverb-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! reverb-filter initial-reverb-filter)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) reverb-filter)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! reverb-feedback initial-reverb-feedback)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (caddr sliders)) reverb-feedback)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- )
-
- (lambda ()
- (effect-target-ok reverb-target))))
-
- (set! sliders
- (add-sliders reverb-dialog
- (list (list "reverb amount" 0.0 initial-reverb-amount 1.0
- (lambda (w data)
- (set! reverb-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100)
- (list "reverb filter" 0.0 initial-reverb-filter 1.0
- (lambda (w data)
- (set! reverb-filter (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 100)
- (list "reverb feedback" 0.0 initial-reverb-feedback 1.25
- (lambda (w data)
- (set! reverb-feedback (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG reverb-dialog))
- (lambda (target)
- (set! reverb-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT reverb-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog reverb-dialog))
- #f)
- (set! reverb-menu-list (cons (lambda ()
- (let ((new-label (format #f "McNabb reverb (~1,2F ~1,2F ~1,2F)" reverb-amount reverb-filter reverb-feedback)))
- (change-label child new-label)))
- reverb-menu-list)))
-
- ;; -------- Chowning reverb
-
- (let ((child (gtk_menu_item_new_with_label "Chowning reverb"))
- (jc-reverb-decay 2.0)
- (jc-reverb-volume 0.1)
- (jc-reverb-dialog #f)
- (jc-reverb-target 'sound)
- (jc-reverb-truncate #t))
-
- (gtk_menu_shell_append (GTK_MENU_SHELL reverb-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not jc-reverb-dialog)
- (let ((initial-jc-reverb-decay 2.0)
- (initial-jc-reverb-volume 0.1)
- (sliders '()))
- (set! jc-reverb-dialog
- (make-effect-dialog
- "Chowning reverb"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (samps) (effects-jc-reverb samps jc-reverb-volume))
- jc-reverb-target
- (lambda (target samps)
- (format #f "effects-jc-reverb-1 ~A" jc-reverb-volume))
- (and (not jc-reverb-truncate) jc-reverb-decay)))
-
- (lambda (w data)
- (help-dialog "Chowning reverb"
- "Nice reverb from John Chowning. Move the sliders to set the reverb parameters."))
-
- (lambda (w data)
- (set! jc-reverb-decay initial-jc-reverb-decay)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) jc-reverb-decay)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! jc-reverb-volume initial-jc-reverb-volume)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) jc-reverb-volume)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- )
-
- (lambda ()
- (effect-target-ok jc-reverb-target))))
-
- (set! sliders
- (add-sliders jc-reverb-dialog
- (list (list "decay duration" 0.0 initial-jc-reverb-decay 10.0
- (lambda (w data)
- (set! jc-reverb-decay (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100)
- (list "reverb volume" 0.0 initial-jc-reverb-volume 1.0
- (lambda (w data)
- (set! jc-reverb-volume (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG jc-reverb-dialog))
- (lambda (target)
- (set! jc-reverb-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT jc-reverb-dialog) "ok-button"))
- (effect-target-ok target)))
- (lambda (truncate)
- (set! jc-reverb-truncate truncate)))))
- (activate-dialog jc-reverb-dialog))
- #f)
- (set! reverb-menu-list (cons (lambda ()
- (let ((new-label (format #f "Chowning reverb (~1,2F ~1,2F)" jc-reverb-decay jc-reverb-volume)))
- (change-label child new-label)))
- reverb-menu-list)))
-
- ;; -------- Convolution
-
- (let ((child (gtk_menu_item_new_with_label "Convolution"))
- (convolve-sound-one 0)
- (convolve-sound-two 1)
- (convolve-amp 0.01)
- (convolve-dialog #f))
- (gtk_menu_shell_append (GTK_MENU_SHELL reverb-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not convolve-dialog)
- (let ((initial-convolve-sound-one 0)
- (initial-convolve-sound-two 1)
- (initial-convolve-amp 0.01)
- (sliders '()))
- (set! convolve-dialog
- (make-effect-dialog
- "Convolution"
-
- (lambda (w data)
- (effects-cnv convolve-sound-one convolve-amp convolve-sound-two))
-
- (lambda (w data)
- (help-dialog "Convolution"
- "Very simple convolution. Move the sliders to set the numbers of the soundfiles
+
+ (lambda (w data)
+ (set! reverb-amount initial-reverb-amount)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) reverb-amount)
+ (set! reverb-filter initial-reverb-filter)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) reverb-filter)
+ (set! reverb-feedback initial-reverb-feedback)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (caddr sliders)) reverb-feedback)
+ )
+
+ (lambda ()
+ (effect-target-ok reverb-target))))
+
+ (set! sliders
+ (add-sliders reverb-dialog
+ (list (list "reverb amount" 0.0 initial-reverb-amount 1.0
+ (lambda (w data)
+ (set! reverb-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100)
+ (list "reverb filter" 0.0 initial-reverb-filter 1.0
+ (lambda (w data)
+ (set! reverb-filter (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 100)
+ (list "reverb feedback" 0.0 initial-reverb-feedback 1.25
+ (lambda (w data)
+ (set! reverb-feedback (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG reverb-dialog))
+ (lambda (target)
+ (set! reverb-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT reverb-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog reverb-dialog))
+ #f)
+ (set! reverb-menu-list (cons (lambda ()
+ (let ((new-label (format #f "McNabb reverb (~1,2F ~1,2F ~1,2F)" reverb-amount reverb-filter reverb-feedback)))
+ (change-label child new-label)))
+ reverb-menu-list)))
+
+ ;; -------- Chowning reverb
+
+ (let ((child (gtk_menu_item_new_with_label "Chowning reverb"))
+ (jc-reverb-decay 2.0)
+ (jc-reverb-volume 0.1)
+ (jc-reverb-dialog #f)
+ (jc-reverb-target 'sound)
+ (jc-reverb-truncate #t))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL reverb-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not jc-reverb-dialog)
+ (let ((initial-jc-reverb-decay 2.0)
+ (initial-jc-reverb-volume 0.1)
+ (sliders ()))
+ (set! jc-reverb-dialog
+ (make-effect-dialog
+ "Chowning reverb"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (samps) (effects-jc-reverb samps jc-reverb-volume))
+ jc-reverb-target
+ (lambda (target samps)
+ (format #f "effects-jc-reverb-1 ~A" jc-reverb-volume))
+ (and (not jc-reverb-truncate) jc-reverb-decay)))
+
+ (lambda (w data)
+ (help-dialog "Chowning reverb"
+ "Nice reverb from John Chowning. Move the sliders to set the reverb parameters."))
+
+ (lambda (w data)
+ (set! jc-reverb-decay initial-jc-reverb-decay)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) jc-reverb-decay)
+ (set! jc-reverb-volume initial-jc-reverb-volume)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) jc-reverb-volume)
+ )
+
+ (lambda ()
+ (effect-target-ok jc-reverb-target))))
+
+ (set! sliders
+ (add-sliders jc-reverb-dialog
+ (list (list "decay duration" 0.0 initial-jc-reverb-decay 10.0
+ (lambda (w data)
+ (set! jc-reverb-decay (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100)
+ (list "reverb volume" 0.0 initial-jc-reverb-volume 1.0
+ (lambda (w data)
+ (set! jc-reverb-volume (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG jc-reverb-dialog))
+ (lambda (target)
+ (set! jc-reverb-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT jc-reverb-dialog) "ok-button"))
+ (effect-target-ok target)))
+ (lambda (truncate)
+ (set! jc-reverb-truncate truncate)))))
+ (activate-dialog jc-reverb-dialog))
+ #f)
+ (set! reverb-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Chowning reverb (~1,2F ~1,2F)" jc-reverb-decay jc-reverb-volume)))
+ (change-label child new-label)))
+ reverb-menu-list)))
+
+ ;; -------- Convolution
+
+ (let ((child (gtk_menu_item_new_with_label "Convolution"))
+ (convolve-sound-one 0)
+ (convolve-sound-two 1)
+ (convolve-amp 0.01)
+ (convolve-dialog #f))
+ (gtk_menu_shell_append (GTK_MENU_SHELL reverb-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not convolve-dialog)
+ (let ((initial-convolve-sound-one 0)
+ (initial-convolve-sound-two 1)
+ (initial-convolve-amp 0.01)
+ (sliders ()))
+ (set! convolve-dialog
+ (make-effect-dialog
+ "Convolution"
+
+ (lambda (w data)
+ (effects-cnv convolve-sound-one convolve-amp convolve-sound-two))
+
+ (lambda (w data)
+ (help-dialog "Convolution"
+ "Very simple convolution. Move the sliders to set the numbers of the soundfiles
to be convolved and the amount for the amplitude scaler. Output will be scaled to floating-point values, resulting
in very large (but not clipped) amplitudes. Use the Normalize amplitude effect to rescale the output.
The convolution data file typically defines a natural reverberation source, and the output from this effect
can provide very striking reverb effects. You can find convolution data files on sites listed at
http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data."))
- (lambda (w data)
- (set! convolve-sound-one initial-convolve-sound-one)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) convolve-sound-one)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! convolve-sound-two initial-convolve-sound-two)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) convolve-sound-two)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! convolve-amp initial-convolve-amp)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 2)) convolve-amp)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- )))
-
- (set! sliders
- (add-sliders convolve-dialog
- (list (list "impulse response file" 0 initial-convolve-sound-one 24
- (lambda (w data)
- (set! convolve-sound-one (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 1)
- (list "sound file" 0 initial-convolve-sound-two 24
- (lambda (w data)
- (set! convolve-sound-two (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 1)
- (list "amplitude" 0.0 initial-convolve-amp 0.10
- (lambda (w data)
- (set! convolve-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 1000))))))
- (activate-dialog convolve-dialog))
- #f)
- (set! reverb-menu-list (cons (lambda ()
- (let ((new-label (format #f "Convolution (~D ~D ~1,2F)" convolve-sound-one convolve-sound-two convolve-amp)))
- (change-label child new-label)))
- reverb-menu-list)))
- )
-
-
+ (lambda (w data)
+ (set! convolve-sound-one initial-convolve-sound-one)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) convolve-sound-one)
+ (set! convolve-sound-two initial-convolve-sound-two)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) convolve-sound-two)
+ (set! convolve-amp initial-convolve-amp)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 2)) convolve-amp)
+ )))
+
+ (set! sliders
+ (add-sliders convolve-dialog
+ (list (list "impulse response file" 0 initial-convolve-sound-one 24
+ (lambda (w data)
+ (set! convolve-sound-one (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 1)
+ (list "sound file" 0 initial-convolve-sound-two 24
+ (lambda (w data)
+ (set! convolve-sound-two (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 1)
+ (list "amplitude" 0.0 initial-convolve-amp 0.10
+ (lambda (w data)
+ (set! convolve-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 1000))))))
+ (activate-dialog convolve-dialog))
+ #f)
+ (set! reverb-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Convolution (~D ~D ~1,2F)" convolve-sound-one convolve-sound-two convolve-amp)))
+ (change-label child new-label)))
+ reverb-menu-list)))
+ )
+
+
;;; VARIOUS AND MISCELLANEOUS
-
-(define* (effects-hello-dentist frq amp beg dur snd chn)
- (let* ((rn (make-rand-interp :frequency frq :amplitude amp))
- (i 0)
- (j 0)
- (len (or dur (frames snd chn)))
- (in-data (channel->vct beg len snd chn))
- (out-len (round (* len (+ 1.0 (* 2 amp)))))
- (out-data (make-vct out-len))
- (rd (make-src :srate 1.0
- :input (lambda (dir)
- (let ((val (if (and (>= i 0) (< i len))
- (vct-ref in-data i)
- 0.0)))
- (set! i (+ i dir))
- val)))))
- (do ()
- ((or (= i len) (= j out-len)))
- (vct-set! out-data j (src rd (rand-interp rn)))
- (set! j (+ j 1)))
- (vct->channel out-data beg j snd chn #f
- (format #f "effects-hello-dentist ~A ~A ~A ~A" frq amp beg (if (= len (frames snd chn)) #f len)))))
-
-(define* (effects-fp srf osamp osfrq beg dur snd chn)
- (let* ((os (make-oscil osfrq))
- (sr (make-src :srate srf))
- (sf (make-sampler beg))
- (len (or dur (frames snd chn)))
- (out-data (make-vct len)))
- (vct-map! out-data
- (lambda ()
- (src sr (* osamp (oscil os))
- (lambda (dir)
- (if (> dir 0)
- (next-sample sf)
- (previous-sample sf))))))
- (free-sampler sf)
- (vct->channel out-data beg len snd chn #f
- (format #f "effects-fp ~A ~A ~A ~A ~A" srf osamp osfrq beg (if (= len (frames snd chn)) #f len)))))
-
-(define* (effects-position-sound mono-snd pos snd chn)
- (let ((len (frames mono-snd))
- (reader1 (make-sampler 0 mono-snd)))
- (if (number? pos)
- (map-channel (lambda (y)
- (+ y (* pos (read-sample reader1))))
- 0 len snd chn #f
- (format #f "effects-position-sound ~A ~A" mono-snd pos))
- (let ((e1 (make-env pos :length len)))
- (if (and (number? chn) (= chn 1))
- (map-channel (lambda (y)
- (+ y (* (env e1) (read-sample reader1))))
- 0 len snd chn #f
- (format #f "effects-position-sound ~A '~A" mono-snd pos))
- (map-channel (lambda (y)
- (+ y (* (- 1.0 (env e1)) (read-sample reader1))))
- 0 len snd chn #f
- (format #f "effects-position-sound ~A '~A" mono-snd pos)))))))
-
-(define* (effects-flange amount speed time beg dur snd chn)
- (let* ((ri (make-rand-interp :frequency speed :amplitude amount))
- (len (round (* time (srate snd))))
- (del (make-delay len :max-size (round (+ len amount 1)))))
- (map-channel (lambda (inval)
- (* .75 (+ inval
- (delay del
- inval
- (rand-interp ri)))))
- beg dur snd chn #f (format #f "effects-flange ~A ~A ~A ~A ~A"
- amount speed time beg (if (and (number? dur) (not (= dur (frames snd chn)))) dur #f)))))
-
-(define (effects-cross-synthesis cross-snd amp fftsize r)
- ;; cross-snd is the index of the other sound (as opposed to the map-channel sound)
- (let* ((freq-inc (/ fftsize 2))
- (fdr (make-vct fftsize))
- (fdi (make-vct fftsize))
- (spectr (make-vct freq-inc))
- (inctr 0)
- (ctr freq-inc)
- (radius (- 1.0 (/ r fftsize)))
- (bin (/ (srate) fftsize))
- (formants (make-vector freq-inc)))
- (do ((i 0 (+ 1 i)))
- ((= i freq-inc))
- (vector-set! formants i (make-formant (* i bin) radius)))
- (lambda (inval)
- (let ((outval 0.0))
+
+ (define effects-hello-dentist
+ (let ((documentation "(hello-dentist frq amp snd chn) varies the sampling rate randomly, making a voice sound quavery: (hello-dentist 40.0 .1)"))
+ (lambda* (frq amp beg dur snd chn)
+ (let* ((rn (make-rand-interp :frequency frq :amplitude amp))
+ (len (or dur (- (framples snd chn) beg)))
+ (sf (make-sampler beg snd chn))
+ (rd (make-src :srate 1.0
+ :input (lambda (dir) (read-sample-with-direction sf dir)))))
+ (map-channel
+ (lambda (y)
+ (src rd (rand-interp rn)))
+ beg len snd chn #f (format #f "effects-hello-dentist ~A ~A ~A ~A" frq amp beg (and (not (= len (framples snd chn))) len)))))))
+
+
+ (define* (effects-fp sr osamp osfrq beg dur snd chn)
+ (let* ((os (make-oscil osfrq))
+ (len (framples snd chn))
+ (sf (make-sampler beg snd chn))
+ (s (make-src :srate sr :input (lambda (dir) (read-sample-with-direction sf dir)))))
+ (map-channel
+ (lambda (y)
+ (src s (* osamp (oscil os))))
+ beg len snd chn #f (format #f "effects-fp ~A ~A ~A ~A ~A" sr osamp osfrq beg (and (not (= len (framples snd chn))) len)))))
+
+
+ (define* (effects-position-sound mono-snd pos snd chn)
+ (let ((len (framples mono-snd))
+ (reader1 (make-sampler 0 mono-snd)))
+ (if (number? pos)
+ (map-channel (lambda (y)
+ (+ y (* pos (read-sample reader1))))
+ 0 len snd chn #f
+ (format #f "effects-position-sound ~A ~A" mono-snd pos))
+ (let ((e1 (make-env pos :length len)))
+ (if (and (number? chn) (= chn 1))
+ (map-channel (lambda (y)
+ (+ y (* (env e1) (read-sample reader1))))
+ 0 len snd chn #f
+ (format #f "effects-position-sound ~A '~A" mono-snd pos))
+ (map-channel (lambda (y)
+ (+ y (* (- 1.0 (env e1)) (read-sample reader1))))
+ 0 len snd chn #f
+ (format #f "effects-position-sound ~A '~A" mono-snd pos)))))))
+
+ (define* (effects-flange amount speed time beg dur snd chn)
+ (let* ((ri (make-rand-interp :frequency speed :amplitude amount))
+ (len (round (* time (srate snd))))
+ (del (make-delay len :max-size (round (+ len amount 1)))))
+ (map-channel (lambda (inval)
+ (* .75 (+ inval
+ (delay del
+ inval
+ (rand-interp ri)))))
+ beg dur snd chn #f (format #f "effects-flange ~A ~A ~A ~A ~A"
+ amount speed time beg (and (number? dur) (not (= dur (framples snd chn))) dur)))))
+
+ (define (effects-cross-synthesis cross-snd amp fftsize r)
+ ;; cross-snd is the index of the other sound (as opposed to the map-channel sound)
+ (let* ((freq-inc (/ fftsize 2))
+ (fdr #f)
+ (fdi (make-float-vector fftsize))
+ (spectr (make-float-vector freq-inc))
+ (inctr 0)
+ (ctr freq-inc)
+ (radius (- 1.0 (/ r fftsize)))
+ (bin (/ (srate) fftsize))
+ (formants (make-vector freq-inc)))
+ (do ((i 0 (+ 1 i)))
+ ((= i freq-inc))
+ (set! (formants i) (make-formant (* i bin) radius)))
+ (set! formants (make-formant-bank formants spectr))
+ (lambda (inval)
(if (= ctr freq-inc)
(begin
- (set! fdr (channel->vct inctr fftsize cross-snd 0))
+ (set! fdr (channel->float-vector inctr fftsize cross-snd 0))
(set! inctr (+ inctr freq-inc))
(spectrum fdr fdi #f 2)
- (vct-subtract! fdr spectr)
- (vct-scale! fdr (/ 1.0 freq-inc))
+ (float-vector-subtract! fdr spectr)
+ (float-vector-scale! fdr (/ 1.0 freq-inc))
(set! ctr 0)))
(set! ctr (+ ctr 1))
- (vct-add! spectr fdr)
- (* amp (formant-bank spectr formants inval))))))
+ (float-vector-add! spectr fdr)
+ (* amp (formant-bank formants inval)))))
+
+ (define* (effects-cross-synthesis-1 cross-snd amp fftsize r beg dur snd chn)
+ (map-channel (effects-cross-synthesis (if (sound? cross-snd) cross-snd (car (sounds))) amp fftsize r)
+ beg dur snd chn #f
+ (format #f "effects-cross-synthesis-1 ~A ~A ~A ~A ~A ~A" cross-snd amp fftsize r beg dur)))
+
+ (let ((misc-menu-list ())
+ (misc-menu (gtk_menu_item_new_with_label "Various"))
+ (misc-cascade (gtk_menu_new)))
+ (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) misc-menu)
+ (gtk_widget_show misc-menu)
+ (gtk_menu_item_set_submenu (GTK_MENU_ITEM misc-menu) misc-cascade)
+ (g_signal_connect misc-menu "activate" (lambda (w d) (update-label misc-menu-list)) #f)
-(define* (effects-cross-synthesis-1 cross-snd amp fftsize r beg dur snd chn)
- (map-channel (effects-cross-synthesis (if (sound? cross-snd) cross-snd (car (sounds))) amp fftsize r)
- beg dur snd chn #f
- (format #f "effects-cross-synthesis-1 ~A ~A ~A ~A ~A ~A" cross-snd amp fftsize r beg dur)))
-
-(let ((misc-menu-list '())
- (misc-menu (gtk_menu_item_new_with_label "Various"))
- (misc-cascade (gtk_menu_new)))
- (gtk_menu_shell_append (GTK_MENU_SHELL (gtk_menu_item_get_submenu (GTK_MENU_ITEM (main-menu effects-menu)))) misc-menu)
- (gtk_widget_show misc-menu)
- (gtk_menu_item_set_submenu (GTK_MENU_ITEM misc-menu) misc-cascade)
- (g_signal_connect misc-menu "activate" (lambda (w d) (update-label misc-menu-list)) #f)
-
- ;; -------- Place sound
-
- (let ((child (gtk_menu_item_new_with_label "Place sound"))
- (mono-snd 0)
- (stereo-snd 1)
- (pan-pos 45)
- (place-sound-dialog #f)
- (place-sound-target 'sound)
- (place-sound-envelope #f))
-
- (define (place-sound mono-snd stereo-snd pan-env)
- "(place-sound mono-snd stereo-snd pan-env) mixes a mono sound into a stereo sound, splitting
-it into two copies whose amplitudes depend on the envelope 'pan-env'. If 'pan-env' is
-a number, the sound is split such that 0 is all in channel 0 and 90 is all in channel 1."
- (let ((len (frames mono-snd)))
+ ;; -------- Place sound
+
+ (let ((child (gtk_menu_item_new_with_label "Place sound"))
+ (mono-snd 0)
+ (stereo-snd 1)
+ (pan-pos 45)
+ (place-sound-dialog #f)
+ (place-sound-target 'sound)
+ (place-sound-envelope #f))
+
+ (define (place-sound mono-snd stereo-snd pan-env)
+ ;; (place-sound mono-snd stereo-snd pan-env) mixes a mono sound into a stereo sound, splitting
+ ;; it into two copies whose amplitudes depend on the envelope 'pan-env'. If 'pan-env' is
+ ;; a number, the sound is split such that 0 is all in channel 0 and 90 is all in channel 1.
(if (number? pan-env)
- (let* ((pos (/ pan-env 90.0)))
+ (let ((pos (/ pan-env 90.0)))
(effects-position-sound mono-snd pos stereo-snd 1)
(effects-position-sound mono-snd (- 1.0 pos) stereo-snd 0))
(begin
(effects-position-sound mono-snd pan-env stereo-snd 1)
- (effects-position-sound mono-snd pan-env stereo-snd 0)))))
+ (effects-position-sound mono-snd pan-env stereo-snd 0))))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not place-sound-dialog)
+ (let ((initial-mono-snd 0)
+ (initial-stereo-snd 1)
+ (initial-pan-pos 45)
+ (sliders ()))
+ (set! place-sound-dialog
+ (make-effect-dialog
+ "Place sound"
+
+ (lambda (w data)
+ (let ((e (xe-envelope place-sound-envelope)))
+ (if (not (equal? e (list 0.0 1.0 1.0 1.0)))
+ (place-sound mono-snd stereo-snd e)
+ (place-sound mono-snd stereo-snd pan-pos))))
+
+ (lambda (w data)
+ (help-dialog "Place sound"
+ "Mixes mono sound into stereo sound field."))
+
+ (lambda (w data)
+ (set! mono-snd initial-mono-snd)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) mono-snd)
+ (set! stereo-snd initial-stereo-snd)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) stereo-snd)
+ (set! pan-pos initial-pan-pos)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 2)) pan-pos)
+ )
+
+ (lambda ()
+ (effect-target-ok place-sound-target))))
+
+ (set! sliders
+ (add-sliders place-sound-dialog
+ (list (list "mono sound" 0 initial-mono-snd 50
+ (lambda (w data)
+ (set! mono-snd (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 1)
+ (list "stereo sound" 0 initial-stereo-snd 50
+ (lambda (w data)
+ (set! stereo-snd (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 1)
+ (list "pan position" 0 initial-pan-pos 90
+ (lambda (w data)
+ (set! pan-pos (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 1))))
+ (gtk_widget_show place-sound-dialog)
+ (set! place-sound-envelope (xe-create-enved "panning"
+ (gtk_dialog_get_content_area (GTK_DIALOG place-sound-dialog))
+ #f
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope place-sound-envelope) (list 0.0 1.0 1.0 1.0))))
+ (activate-dialog place-sound-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Place sound (~D ~D ~D)" mono-snd stereo-snd pan-pos)))
+ (change-label child new-label)))
+ misc-menu-list)))
+
+ ;; -------- Insert silence (at cursor, silence-amount in secs)
+
+ (let ((child (gtk_menu_item_new_with_label "Add silence"))
+ (silence-amount 1.0)
+ (silence-dialog #f))
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not silence-dialog)
+ (let ((initial-silence-amount 1.0)
+ (sliders ()))
+ (set! silence-dialog
+ (make-effect-dialog
+ "Add silence"
+
+ (lambda (w data)
+ (insert-silence (cursor) (floor (* (srate) silence-amount))))
+
+ (lambda (w data)
+ (help-dialog "Add silence"
+ "Move the slider to change the number of seconds of silence added at the cursor position."))
+
+ (lambda (w data)
+ (set! silence-amount initial-silence-amount)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) silence-amount)
+ )))
+
+ (set! sliders
+ (add-sliders silence-dialog
+ (list (list "silence" 0.0 initial-silence-amount 5.0
+ (lambda (w data)
+ (set! silence-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100))))))
+ (activate-dialog silence-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Add silence (~1,2F)" silence-amount)))
+ (change-label child new-label)))
+ misc-menu-list)))
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not place-sound-dialog)
- (let ((initial-mono-snd 0)
- (initial-stereo-snd 1)
- (initial-pan-pos 45)
- (sliders '()))
- (set! place-sound-dialog
- (make-effect-dialog
- "Place sound"
-
- (lambda (w data)
- (let ((e (xe-envelope place-sound-envelope)))
- (if (not (equal? e (list 0.0 1.0 1.0 1.0)))
- (place-sound mono-snd stereo-snd e)
- (place-sound mono-snd stereo-snd pan-pos))))
-
- (lambda (w data)
- (help-dialog "Place sound"
- "Mixes mono sound into stereo sound field."))
-
- (lambda (w data)
- (set! mono-snd initial-mono-snd)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) mono-snd)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! stereo-snd initial-stereo-snd)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) stereo-snd)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! pan-pos initial-pan-pos)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 2)) pan-pos)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- )
-
- (lambda ()
- (effect-target-ok place-sound-target))))
-
- (set! sliders
- (add-sliders place-sound-dialog
- (list (list "mono sound" 0 initial-mono-snd 50
- (lambda (w data)
- (set! mono-snd (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 1)
- (list "stereo sound" 0 initial-stereo-snd 50
- (lambda (w data)
- (set! stereo-snd (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 1)
- (list "pan position" 0 initial-pan-pos 90
- (lambda (w data)
- (set! pan-pos (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 1))))
- (gtk_widget_show place-sound-dialog)
- (set! place-sound-envelope (xe-create-enved "panning"
- (gtk_dialog_get_content_area (GTK_DIALOG place-sound-dialog))
- #f
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope place-sound-envelope) (list 0.0 1.0 1.0 1.0))))
- (activate-dialog place-sound-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Place sound (~D ~D ~D)" mono-snd stereo-snd pan-pos)))
- (change-label child new-label)))
- misc-menu-list)))
-
- ;; -------- Insert silence (at cursor, silence-amount in secs)
-
- (let ((child (gtk_menu_item_new_with_label "Add silence"))
- (silence-amount 1.0)
- (silence-dialog #f))
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not silence-dialog)
- (let ((initial-silence-amount 1.0)
- (sliders '()))
- (set! silence-dialog
- (make-effect-dialog
- "Add silence"
-
- (lambda (w data)
- (insert-silence (cursor) (floor (* (srate) silence-amount))))
-
- (lambda (w data)
- (help-dialog "Add silence"
- "Move the slider to change the number of seconds of silence added at the cursor position."))
-
- (lambda (w data)
- (set! silence-amount initial-silence-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) silence-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )))
-
- (set! sliders
- (add-sliders silence-dialog
- (list (list "silence" 0.0 initial-silence-amount 5.0
- (lambda (w data)
- (set! silence-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100))))))
- (activate-dialog silence-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Add silence (~1,2F)" silence-amount)))
- (change-label child new-label)))
- misc-menu-list)))
-
;;; -------- Contrast (brightness control)
;;;
-
- (let ((child (gtk_menu_item_new_with_label "Contrast enhancement"))
- (contrast-amount 1.0)
- (contrast-dialog #f)
- (contrast-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not contrast-dialog)
- (let ((initial-contrast-amount 1.0)
- (sliders '()))
- (set! contrast-dialog
- (make-effect-dialog
- "Contrast enhancement"
-
- (lambda (w data)
- (let ((peak (maxamp))
- (snd (selected-sound)))
- (save-controls snd)
- (reset-controls snd)
- (set! (contrast-control? snd) #t)
- (set! (contrast-control snd) contrast-amount)
- (set! (contrast-control-amp snd) (/ 1.0 peak))
- (set! (amp-control snd) peak)
- (if (eq? contrast-target 'marks)
- (let ((ms (plausible-mark-samples)))
- (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
- (apply-controls snd (if (eq? contrast-target 'sound) 0 2)))
- (restore-controls snd)))
-
- (lambda (w data)
- (help-dialog "Contrast enhancement"
- "Move the slider to change the contrast intensity."))
-
- (lambda (w data)
- (set! contrast-amount initial-contrast-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) contrast-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )
-
- (lambda ()
- (effect-target-ok contrast-target))))
-
- (set! sliders
- (add-sliders contrast-dialog
- (list (list "contrast enhancement" 0.0 initial-contrast-amount 10.0
- (lambda (w data)
- (set! contrast-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG contrast-dialog))
- (lambda (target)
- (set! contrast-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT contrast-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog contrast-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Contrast enhancement (~1,2F)" contrast-amount)))
- (change-label child new-label)))
- misc-menu-list)))
-
- ;; -------- Cross synthesis
-
- (let ((child (gtk_menu_item_new_with_label "Cross synthesis"))
- (cross-synth-sound 1)
- (cross-synth-amp .5)
- (cross-synth-fft-size 128)
- (cross-synth-radius 6.0)
- (cross-synth-dialog #f)
- (cross-synth-default-fft-widget #f)
- (cross-synth-target 'sound))
-
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not cross-synth-dialog)
- (let ((initial-cross-synth-sound 1)
- (initial-cross-synth-amp .5)
- (initial-cross-synth-fft-size 128)
- (initial-cross-synth-radius 6.0)
- (sliders '()))
- (set! cross-synth-dialog
- (make-effect-dialog
- "Cross synthesis"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (effects-cross-synthesis cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius))
- cross-synth-target
- (lambda (target samps)
- (format #f "effects-cross-synthesis-1 ~A ~A ~A ~A"
- cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius))
- #f))
-
- (lambda (w data)
- (help-dialog "Cross synthesis"
- "The sliders set the number of the soundfile to be cross-synthesized,
+
+ (let ((child (gtk_menu_item_new_with_label "Contrast enhancement"))
+ (contrast-amount 1.0)
+ (contrast-dialog #f)
+ (contrast-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not contrast-dialog)
+ (let ((initial-contrast-amount 1.0)
+ (sliders ()))
+ (set! contrast-dialog
+ (make-effect-dialog
+ "Contrast enhancement"
+
+ (lambda (w data)
+ (let ((peak (maxamp))
+ (snd (selected-sound)))
+ (save-controls snd)
+ (reset-controls snd)
+ (set! (contrast-control? snd) #t)
+ (set! (contrast-control snd) contrast-amount)
+ (set! (contrast-control-amp snd) (/ 1.0 peak))
+ (set! (amp-control snd) peak)
+ (if (eq? contrast-target 'marks)
+ (let ((ms (plausible-mark-samples)))
+ (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
+ (apply-controls snd (if (eq? contrast-target 'sound) 0 2)))
+ (restore-controls snd)))
+
+ (lambda (w data)
+ (help-dialog "Contrast enhancement"
+ "Move the slider to change the contrast intensity."))
+
+ (lambda (w data)
+ (set! contrast-amount initial-contrast-amount)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) contrast-amount)
+ )
+
+ (lambda ()
+ (effect-target-ok contrast-target))))
+
+ (set! sliders
+ (add-sliders contrast-dialog
+ (list (list "contrast enhancement" 0.0 initial-contrast-amount 10.0
+ (lambda (w data)
+ (set! contrast-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG contrast-dialog))
+ (lambda (target)
+ (set! contrast-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT contrast-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog contrast-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Contrast enhancement (~1,2F)" contrast-amount)))
+ (change-label child new-label)))
+ misc-menu-list)))
+
+ ;; -------- Cross synthesis
+
+ (let ((child (gtk_menu_item_new_with_label "Cross synthesis"))
+ (cross-synth-sound 1)
+ (cross-synth-amp .5)
+ (cross-synth-fft-size 128)
+ (cross-synth-radius 6.0)
+ (cross-synth-dialog #f)
+ (cross-synth-target 'sound))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not cross-synth-dialog)
+ (let ((initial-cross-synth-sound 1)
+ (initial-cross-synth-amp .5)
+ (initial-cross-synth-fft-size 128)
+ (initial-cross-synth-radius 6.0)
+ (sliders ()))
+ (set! cross-synth-dialog
+ (make-effect-dialog
+ "Cross synthesis"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (effects-cross-synthesis cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius))
+ cross-synth-target
+ (lambda (target samps)
+ (format #f "effects-cross-synthesis-1 ~A ~A ~A ~A"
+ cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius))
+ #f))
+
+ (lambda (w data)
+ (help-dialog "Cross synthesis"
+ "The sliders set the number of the soundfile to be cross-synthesized,
the synthesis amplitude, the FFT size, and the radius value."))
-
- (lambda (w data)
- (set! cross-synth-sound initial-cross-synth-sound)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 0)) cross-synth-sound)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! cross-synth-amp initial-cross-synth-amp)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 1)) cross-synth-amp)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! cross-synth-fft-size initial-cross-synth-fft-size)
- (set! cross-synth-radius initial-cross-synth-radius)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (list-ref sliders 2)) cross-synth-radius)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- )
-
- (lambda ()
- (effect-target-ok cross-synth-target))))
-
- (set! sliders
- (add-sliders cross-synth-dialog
- (list (list "input sound" 0 initial-cross-synth-sound 20
- (lambda (w data)
- (set! cross-synth-sound (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 1)
- (list "amplitude" 0.0 initial-cross-synth-amp 1.0
- (lambda (w data)
- (set! cross-synth-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 100)
- (list "radius" 0.0 initial-cross-synth-radius 360.0
- (lambda (w data)
- (set! cross-synth-radius (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG cross-synth-dialog))
- (lambda (target)
- (set! cross-synth-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT cross-synth-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog cross-synth-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Cross synthesis (~D ~1,2F ~D ~1,2F)"
- cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius)))
- (change-label child new-label)))
- misc-menu-list)))
-
- ;; -------- Flange and phasing
-
- (let ((child (gtk_menu_item_new_with_label "Flange"))
- (flange-speed 2.0)
- (flange-amount 5.0)
- (flange-time 0.001)
- (flange-dialog #f)
- (flange-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not flange-dialog)
- (let ((initial-flange-speed 2.0)
- (initial-flange-amount 5.0)
- (initial-flange-time 0.001)
- (sliders '()))
- (set! flange-dialog
- (make-effect-dialog
- "Flange"
-
- (lambda (w data)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (let* ((ri (make-rand-interp :frequency flange-speed :amplitude flange-amount))
- (len (round (* flange-time (srate))))
- (del (make-delay len :max-size (round (+ len flange-amount 1)))))
- (lambda (inval)
- (* .75 (+ inval
- (delay del
- inval
- (rand-interp ri)))))))
- flange-target
- (lambda (target samps)
- (format #f "effects-flange ~A ~A ~A" flange-amount flange-speed flange-time))
- #f))
-
- (lambda (w data)
- (help-dialog "Flange"
- "Move the sliders to change the flange speed, amount, and time"))
-
- (lambda (w data)
- (set! flange-speed initial-flange-speed)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) flange-speed)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! flange-amount initial-flange-amount)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) flange-amount)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! flange-time initial-flange-time)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (caddr sliders)) flange-time)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- )
-
- (lambda ()
- (effect-target-ok flange-target))))
-
- (set! sliders
- (add-sliders flange-dialog
- (list (list "flange speed" 0.0 initial-flange-speed 100.0
- (lambda (w data)
- (set! flange-speed (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 10)
- (list "flange amount" 0.0 initial-flange-amount 100.0
- (lambda (w data)
- (set! flange-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 10)
- ;; flange time ought to use a non-linear scale (similar to amp in control panel)
- (list "flange time" 0.0 initial-flange-time 1.0
- (lambda (w data)
- (set! flange-time (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG flange-dialog))
- (lambda (target)
- (set! flange-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT flange-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog flange-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Flange (~1,2F ~1,2F ~1,3F)" flange-speed flange-amount flange-time)))
- (change-label child new-label)))
- misc-menu-list)))
-
- ;; -------- Randomize phase
-
- (let ((child (gtk_menu_item_new_with_label "Randomize phase"))
- (random-phase-amp-scaler 3.14)
- (random-phase-dialog #f))
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not random-phase-dialog)
- (let ((initial-random-phase-amp-scaler 3.14)
- (sliders '()))
- (set! random-phase-dialog
- (make-effect-dialog
- "Randomize phase"
-
- (lambda (w data)
- (rotate-phase (lambda (x) (random random-phase-amp-scaler))))
-
- (lambda (w data)
- (help-dialog "Randomize phase"
- "Move the slider to change the randomization amplitude scaler."))
-
- (lambda (w data)
- (set! random-phase-amp-scaler initial-random-phase-amp-scaler)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) random-phase-amp-scaler)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )))
-
- (set! sliders
- (add-sliders random-phase-dialog
- (list (list "amplitude scaler" 0.0 initial-random-phase-amp-scaler 100.0
- (lambda (w data)
- (set! random-phase-amp-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100))))))
- (activate-dialog random-phase-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Randomize phase (~1,2F)" random-phase-amp-scaler)))
- (change-label child new-label)))
- misc-menu-list)))
-
- ;; -------- Robotize
-
- (let ((child (gtk_menu_item_new_with_label "Robotize"))
- (samp-rate 1.0)
- (osc-amp 0.3)
- (osc-freq 20)
- (robotize-dialog #f)
- (robotize-target 'sound))
-
- (define fp-1 ; fp from examp.scm with added beg end args
- (lambda (sr osamp osfrq beg end)
- (let* ((os (make-oscil osfrq))
- (sr (make-src :srate sr))
- (len (+ 1 (- end beg)))
- (sf (make-sampler beg))
- (out-data (make-vct len)))
- (vct-map! out-data
- (lambda ()
- (src sr (* osamp (oscil os))
- (lambda (dir)
- (if (> dir 0)
- (next-sample sf)
- (previous-sample sf))))))
- (free-sampler sf)
- (vct->channel out-data beg len))))
-
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not robotize-dialog)
- (let ((initial-samp-rate 1.0)
- (initial-osc-amp 0.3)
- (initial-osc-freq 20)
- (sliders '()))
- (set! robotize-dialog
- (make-effect-dialog
- "Robotize"
-
- (lambda (w data)
- (let ((ms (and (eq? robotize-target 'marks)
- (plausible-mark-samples))))
- (effects-fp samp-rate osc-amp osc-freq
- (if (eq? robotize-target 'sound)
- 0
- (if (eq? robotize-target 'selection)
- (selection-position)
- (car ms)))
- (if (eq? robotize-target 'sound)
- (frames)
- (if (eq? robotize-target 'selection)
- (selection-frames)
- (- (cadr ms) (car ms)))))))
-
- (lambda (w data)
- (help-dialog "Robotize"
- "Move the sliders to set the sample rate, oscillator amplitude, and oscillator frequency."))
-
- (lambda (w data)
- (set! samp-rate initial-samp-rate)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) samp-rate)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! osc-amp initial-osc-amp)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) osc-amp)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- (set! osc-freq initial-osc-freq)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (caddr sliders)) osc-freq)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 2)))
- )
-
- (lambda ()
- (effect-target-ok robotize-target))))
-
- (set! sliders
- (add-sliders robotize-dialog
- (list (list "sample rate" 0.0 initial-samp-rate 2.0
- (lambda (w data)
- (set! samp-rate (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100)
- (list "oscillator amplitude" 0.0 initial-osc-amp 1.0
- (lambda (w data)
- (set! osc-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 100)
- (list "oscillator frequency" 0.0 initial-osc-freq 60
- (lambda (w data)
- (set! osc-freq (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 2)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG robotize-dialog))
- (lambda (target)
- (set! robotize-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT robotize-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog robotize-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Robotize (~1,2F ~1,2F ~1,2F)" samp-rate osc-amp osc-freq)))
- (change-label child new-label)))
- misc-menu-list)))
-
- ;; -------- Rubber sound
-
- (let ((child (gtk_menu_item_new_with_label "Rubber sound"))
- (rubber-factor 1.0)
- (rubber-dialog #f)
- (rubber-target 'sound))
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not rubber-dialog)
- (let ((initial-rubber-factor 1.0)
- (sliders '()))
- (set! rubber-dialog
- (make-effect-dialog
- "Rubber sound"
-
- (lambda (w data)
- (rubber-sound rubber-factor))
-
- (lambda (w data)
- (help-dialog "Rubber sound"
- "Stretches or contracts the time of a sound. Move the slider to change the stretch factor."))
-
- (lambda (w data)
- (set! rubber-factor initial-rubber-factor)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) rubber-factor)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- )
-
- (lambda ()
- (effect-target-ok rubber-target))))
-
- (set! sliders
- (add-sliders rubber-dialog
- (list (list "stretch factor" 0.0 initial-rubber-factor 5.0
- (lambda (w data)
- (set! rubber-factor (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG rubber-dialog))
- (lambda (target)
- (set! rubber-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT rubber-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog rubber-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Rubber sound (~1,2F)" rubber-factor)))
- (change-label child new-label)))
- misc-menu-list)))
-
- ;; -------- Wobble
-
- (let ((child (gtk_menu_item_new_with_label "Wobble"))
- (wobble-frequency 50)
- (wobble-amplitude 0.5)
- (wobble-dialog #f)
- (wobble-target 'sound))
-
- (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
- (gtk_widget_show child)
- (g_signal_connect child "activate"
- (lambda (w d)
- (if (not wobble-dialog)
- (let ((initial-wobble-frequency 50)
- (initial-wobble-amplitude 0.5)
- (sliders '()))
- (set! wobble-dialog
- (make-effect-dialog
- "Wobble"
-
- (lambda (w data)
- (let ((ms (and (eq? wobble-target 'marks)
- (plausible-mark-samples))))
- (effects-hello-dentist
- wobble-frequency wobble-amplitude
- (if (eq? wobble-target 'sound)
- 0
- (if (eq? wobble-target 'selection)
- (selection-position)
- (car ms)))
- (if (eq? wobble-target 'sound)
- (frames)
- (if (eq? wobble-target 'selection)
- (selection-frames)
- (- (cadr ms) (car ms)))))))
-
- (lambda (w data)
- (help-dialog "Wobble"
- "Move the sliders to set the wobble frequency and amplitude."))
-
- (lambda (w data)
- (set! wobble-frequency initial-wobble-frequency)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) wobble-frequency)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 0)))
- (set! wobble-amplitude initial-wobble-amplitude)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) wobble-amplitude)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (list-ref sliders 1)))
- )
-
- (lambda ()
- (effect-target-ok wobble-target))))
-
- (set! sliders
- (add-sliders wobble-dialog
- (list (list "wobble frequency" 0 initial-wobble-frequency 100
- (lambda (w data)
- (set! wobble-frequency (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 0)))))
- 100)
- (list "wobble amplitude" 0.0 initial-wobble-amplitude 1.0
- (lambda (w data)
- (set! wobble-amplitude (gtk_adjustment_get_value (GTK_ADJUSTMENT (list-ref sliders 1)))))
- 100))))
- (add-target (gtk_dialog_get_content_area (GTK_DIALOG wobble-dialog))
- (lambda (target)
- (set! wobble-target target)
- (gtk_widget_set_sensitive
- (GTK_WIDGET (g_object_get_data (G_OBJECT wobble-dialog) "ok-button"))
- (effect-target-ok target)))
- #f)))
- (activate-dialog wobble-dialog))
- #f)
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Wobble (~1,2F ~1,2F)" wobble-frequency wobble-amplitude)))
- (change-label child new-label)))
- misc-menu-list)))
- )
-
+
+ (lambda (w data)
+ (set! cross-synth-sound initial-cross-synth-sound)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 0)) cross-synth-sound)
+ (set! cross-synth-amp initial-cross-synth-amp)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 1)) cross-synth-amp)
+ (set! cross-synth-fft-size initial-cross-synth-fft-size)
+ (set! cross-synth-radius initial-cross-synth-radius)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (sliders 2)) cross-synth-radius)
+ )
+
+ (lambda ()
+ (effect-target-ok cross-synth-target))))
+
+ (set! sliders
+ (add-sliders cross-synth-dialog
+ (list (list "input sound" 0 initial-cross-synth-sound 20
+ (lambda (w data)
+ (set! cross-synth-sound (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 1)
+ (list "amplitude" 0.0 initial-cross-synth-amp 1.0
+ (lambda (w data)
+ (set! cross-synth-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 100)
+ (list "radius" 0.0 initial-cross-synth-radius 360.0
+ (lambda (w data)
+ (set! cross-synth-radius (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG cross-synth-dialog))
+ (lambda (target)
+ (set! cross-synth-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT cross-synth-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog cross-synth-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Cross synthesis (~D ~1,2F ~D ~1,2F)"
+ cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius)))
+ (change-label child new-label)))
+ misc-menu-list)))
+
+ ;; -------- Flange and phasing
+
+ (let ((child (gtk_menu_item_new_with_label "Flange"))
+ (flange-speed 2.0)
+ (flange-amount 5.0)
+ (flange-time 0.001)
+ (flange-dialog #f)
+ (flange-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not flange-dialog)
+ (let ((initial-flange-speed 2.0)
+ (initial-flange-amount 5.0)
+ (initial-flange-time 0.001)
+ (sliders ()))
+ (set! flange-dialog
+ (make-effect-dialog
+ "Flange"
+
+ (lambda (w data)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (let* ((ri (make-rand-interp :frequency flange-speed :amplitude flange-amount))
+ (len (round (* flange-time (srate))))
+ (del (make-delay len :max-size (round (+ len flange-amount 1)))))
+ (lambda (inval)
+ (* .75 (+ inval
+ (delay del
+ inval
+ (rand-interp ri)))))))
+ flange-target
+ (lambda (target samps)
+ (format #f "effects-flange ~A ~A ~A" flange-amount flange-speed flange-time))
+ #f))
+
+ (lambda (w data)
+ (help-dialog "Flange"
+ "Move the sliders to change the flange speed, amount, and time"))
+
+ (lambda (w data)
+ (set! flange-speed initial-flange-speed)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) flange-speed)
+ (set! flange-amount initial-flange-amount)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) flange-amount)
+ (set! flange-time initial-flange-time)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (caddr sliders)) flange-time)
+ )
+
+ (lambda ()
+ (effect-target-ok flange-target))))
+
+ (set! sliders
+ (add-sliders flange-dialog
+ (list (list "flange speed" 0.0 initial-flange-speed 100.0
+ (lambda (w data)
+ (set! flange-speed (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 10)
+ (list "flange amount" 0.0 initial-flange-amount 100.0
+ (lambda (w data)
+ (set! flange-amount (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 10)
+ ;; flange time ought to use a non-linear scale (similar to amp in control panel)
+ (list "flange time" 0.0 initial-flange-time 1.0
+ (lambda (w data)
+ (set! flange-time (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG flange-dialog))
+ (lambda (target)
+ (set! flange-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT flange-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog flange-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Flange (~1,2F ~1,2F ~1,3F)" flange-speed flange-amount flange-time)))
+ (change-label child new-label)))
+ misc-menu-list)))
+
+ ;; -------- Randomize phase
+
+ (let ((child (gtk_menu_item_new_with_label "Randomize phase"))
+ (random-phase-amp-scaler 3.14)
+ (random-phase-dialog #f))
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not random-phase-dialog)
+ (let ((initial-random-phase-amp-scaler 3.14)
+ (sliders ()))
+ (set! random-phase-dialog
+ (make-effect-dialog
+ "Randomize phase"
+
+ (lambda (w data)
+ (rotate-phase (lambda (x) (random random-phase-amp-scaler))))
+
+ (lambda (w data)
+ (help-dialog "Randomize phase"
+ "Move the slider to change the randomization amplitude scaler."))
+
+ (lambda (w data)
+ (set! random-phase-amp-scaler initial-random-phase-amp-scaler)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) random-phase-amp-scaler)
+ )))
+
+ (set! sliders
+ (add-sliders random-phase-dialog
+ (list (list "amplitude scaler" 0.0 initial-random-phase-amp-scaler 100.0
+ (lambda (w data)
+ (set! random-phase-amp-scaler (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100))))))
+ (activate-dialog random-phase-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Randomize phase (~1,2F)" random-phase-amp-scaler)))
+ (change-label child new-label)))
+ misc-menu-list)))
+
+ ;; -------- Robotize
+
+ (let ((child (gtk_menu_item_new_with_label "Robotize"))
+ (samp-rate 1.0)
+ (osc-amp 0.3)
+ (osc-freq 20)
+ (robotize-dialog #f)
+ (robotize-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not robotize-dialog)
+ (let ((initial-samp-rate 1.0)
+ (initial-osc-amp 0.3)
+ (initial-osc-freq 20)
+ (sliders ()))
+ (set! robotize-dialog
+ (make-effect-dialog
+ "Robotize"
+
+ (lambda (w data)
+ (let ((ms (and (eq? robotize-target 'marks)
+ (plausible-mark-samples))))
+ (effects-fp samp-rate osc-amp osc-freq
+ (if (eq? robotize-target 'sound)
+ 0
+ (if (eq? robotize-target 'selection)
+ (selection-position)
+ (car ms)))
+ (if (eq? robotize-target 'sound)
+ (framples)
+ (if (eq? robotize-target 'selection)
+ (selection-framples)
+ (- (cadr ms) (car ms)))))))
+
+ (lambda (w data)
+ (help-dialog "Robotize"
+ "Move the sliders to set the sample rate, oscillator amplitude, and oscillator frequency."))
+
+ (lambda (w data)
+ (set! samp-rate initial-samp-rate)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) samp-rate)
+ (set! osc-amp initial-osc-amp)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) osc-amp)
+ (set! osc-freq initial-osc-freq)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (caddr sliders)) osc-freq)
+ )
+
+ (lambda ()
+ (effect-target-ok robotize-target))))
+
+ (set! sliders
+ (add-sliders robotize-dialog
+ (list (list "sample rate" 0.0 initial-samp-rate 2.0
+ (lambda (w data)
+ (set! samp-rate (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100)
+ (list "oscillator amplitude" 0.0 initial-osc-amp 1.0
+ (lambda (w data)
+ (set! osc-amp (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 100)
+ (list "oscillator frequency" 0.0 initial-osc-freq 60
+ (lambda (w data)
+ (set! osc-freq (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 2)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG robotize-dialog))
+ (lambda (target)
+ (set! robotize-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT robotize-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog robotize-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Robotize (~1,2F ~1,2F ~1,2F)" samp-rate osc-amp osc-freq)))
+ (change-label child new-label)))
+ misc-menu-list)))
+
+ ;; -------- Rubber sound
+
+ (let ((child (gtk_menu_item_new_with_label "Rubber sound"))
+ (rubber-factor 1.0)
+ (rubber-dialog #f)
+ (rubber-target 'sound))
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not rubber-dialog)
+ (let ((initial-rubber-factor 1.0)
+ (sliders ()))
+ (set! rubber-dialog
+ (make-effect-dialog
+ "Rubber sound"
+
+ (lambda (w data)
+ (rubber-sound rubber-factor))
+
+ (lambda (w data)
+ (help-dialog "Rubber sound"
+ "Stretches or contracts the time of a sound. Move the slider to change the stretch factor."))
+
+ (lambda (w data)
+ (set! rubber-factor initial-rubber-factor)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) rubber-factor)
+ )
+
+ (lambda ()
+ (effect-target-ok rubber-target))))
+
+ (set! sliders
+ (add-sliders rubber-dialog
+ (list (list "stretch factor" 0.0 initial-rubber-factor 5.0
+ (lambda (w data)
+ (set! rubber-factor (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG rubber-dialog))
+ (lambda (target)
+ (set! rubber-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT rubber-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog rubber-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Rubber sound (~1,2F)" rubber-factor)))
+ (change-label child new-label)))
+ misc-menu-list)))
+
+ ;; -------- Wobble
+
+ (let ((child (gtk_menu_item_new_with_label "Wobble"))
+ (wobble-frequency 50)
+ (wobble-amplitude 0.5)
+ (wobble-dialog #f)
+ (wobble-target 'sound))
+
+ (gtk_menu_shell_append (GTK_MENU_SHELL misc-cascade) child)
+ (gtk_widget_show child)
+ (g_signal_connect child "activate"
+ (lambda (w d)
+ (if (not wobble-dialog)
+ (let ((initial-wobble-frequency 50)
+ (initial-wobble-amplitude 0.5)
+ (sliders ()))
+ (set! wobble-dialog
+ (make-effect-dialog
+ "Wobble"
+
+ (lambda (w data)
+ (let ((ms (and (eq? wobble-target 'marks)
+ (plausible-mark-samples))))
+ (effects-hello-dentist
+ wobble-frequency wobble-amplitude
+ (if (eq? wobble-target 'sound)
+ 0
+ (if (eq? wobble-target 'selection)
+ (selection-position)
+ (car ms)))
+ (if (eq? wobble-target 'sound)
+ (framples)
+ (if (eq? wobble-target 'selection)
+ (selection-framples)
+ (- (cadr ms) (car ms)))))))
+
+ (lambda (w data)
+ (help-dialog "Wobble"
+ "Move the sliders to set the wobble frequency and amplitude."))
+
+ (lambda (w data)
+ (set! wobble-frequency initial-wobble-frequency)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) wobble-frequency)
+ (set! wobble-amplitude initial-wobble-amplitude)
+ (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) wobble-amplitude)
+ )
+
+ (lambda ()
+ (effect-target-ok wobble-target))))
+
+ (set! sliders
+ (add-sliders wobble-dialog
+ (list (list "wobble frequency" 0 initial-wobble-frequency 100
+ (lambda (w data)
+ (set! wobble-frequency (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 0)))))
+ 100)
+ (list "wobble amplitude" 0.0 initial-wobble-amplitude 1.0
+ (lambda (w data)
+ (set! wobble-amplitude (gtk_adjustment_get_value (GTK_ADJUSTMENT (sliders 1)))))
+ 100))))
+ (add-target (gtk_dialog_get_content_area (GTK_DIALOG wobble-dialog))
+ (lambda (target)
+ (set! wobble-target target)
+ (gtk_widget_set_sensitive
+ (GTK_WIDGET (g_object_get_data (G_OBJECT wobble-dialog) "ok-button"))
+ (effect-target-ok target)))
+ #f)))
+ (activate-dialog wobble-dialog))
+ #f)
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Wobble (~1,2F ~1,2F)" wobble-frequency wobble-amplitude)))
+ (change-label child new-label)))
+ misc-menu-list)))
+ )
+
;;;
;;; END PARAMETRIZED EFFECTS
;;;
-
-(add-to-menu effects-menu #f #f)
-(add-to-menu effects-menu "Octave-down" (lambda () (down-oct 2)))
-(add-to-menu effects-menu "Remove clicks"
- (lambda ()
- (define (find-click loc)
- (let ((reader (make-sampler loc))
- (samp0 0.0)
- (samp1 0.0)
- (samp2 0.0)
- (samps (make-vct 10))
- (samps-ctr 0)
- (diff 1.0)
- (len (frames)))
- (call-with-exit
- (lambda (return)
- (do ((ctr loc (+ 1 ctr)))
- ((= ctr len) #f)
- (set! samp0 samp1)
- (set! samp1 samp2)
- (set! samp2 (next-sample reader))
- (vct-set! samps samps-ctr samp0)
- (if (< samps-ctr 9)
- (set! samps-ctr (+ samps-ctr 1))
- (set! samps-ctr 0))
- (let ((local-max (max .1 (vct-peak samps))))
- (if (and (> (abs (- samp0 samp1)) local-max)
- (> (abs (- samp1 samp2)) local-max)
- (< (abs (- samp0 samp2)) (/ local-max 2)))
- (return (- ctr 1)))))))))
-
- (define (remove-click loc)
- (let ((click (find-click loc)))
- (if click
- (begin
- (smooth-sound (- click 2) 4)
- (remove-click (+ click 2))))))
- (remove-click 0)))
-
-(define* (effects-remove-dc snd chn)
- (map-channel
- (let ((lastx 0.0)
- (lasty 0.0))
- (lambda (inval)
- (set! lasty (+ inval (- (* 0.999 lasty) lastx)))
- (set! lastx inval)
- lasty))
- 0 #f snd chn #f "effects-remove-dc"))
-
-(add-to-menu effects-menu "Remove DC" (lambda () (effects-remove-dc)))
-(add-to-menu effects-menu "Spiker" (lambda () (spike)))
-
-(define* (effects-compand snd chn)
- (map-channel
- (let* ((tbl (vct -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
- 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000)))
- (lambda (inval)
- (let ((index (+ 8.0 (* 8.0 inval))))
- (array-interp tbl index 17))))
- 0 #f snd chn #f "effects-compand"))
-
-(add-to-menu effects-menu "Compand" (lambda () (effects-compand)))
-
-(add-to-menu effects-menu "Invert" (lambda () (scale-by -1)))
-(add-to-menu effects-menu "Reverse" (lambda () (reverse-sound)))
-(add-to-menu effects-menu "Null phase" (lambda () (zero-phase)))
+
+ (add-to-menu effects-menu #f #f)
+ (add-to-menu effects-menu "Octave-down" (lambda () (down-oct 2)))
+ (add-to-menu effects-menu "Remove clicks"
+ (lambda ()
+ (define (find-click loc)
+ (let ((reader (make-sampler loc))
+ (mmax (make-moving-max 10))
+ (samp0 0.0)
+ (samp1 0.0)
+ (samp2 0.0)
+ (len (framples)))
+ (call-with-exit
+ (lambda (return)
+ (do ((ctr loc (+ ctr 1)))
+ ((= ctr len) #f)
+ (set! samp0 samp1)
+ (set! samp1 samp2)
+ (set! samp2 (next-sample reader))
+ (let ((local-max (max .1 (moving-max mmax samp0))))
+ (if (and (> (abs (- samp0 samp1)) local-max)
+ (> (abs (- samp1 samp2)) local-max)
+ (< (abs (- samp0 samp2)) (/ local-max 2)))
+ (return (- ctr 1)))))))))
+ (define (remove-click loc)
+ (let ((click (find-click loc)))
+ (if click
+ (begin
+ (smooth-sound (- click 2) 4)
+ (remove-click (+ click 2))))))
+ (remove-click 0)))
+
+ (define* (effects-remove-dc snd chn)
+ (let* ((len (framples snd chn))
+ (data (make-float-vector len))
+ (reader (make-sampler 0 snd chn)))
+ (let ((lastx 0.0)
+ (lasty 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((inval (next-sample reader)))
+ (set! lasty (+ inval (- (* 0.999 lasty) lastx)))
+ (set! lastx inval)
+ (float-vector-set! data i lasty))))
+ (float-vector->channel data 0 len snd chn current-edit-position "effects-remove-dc")))
+
+ (add-to-menu effects-menu "Remove DC" effects-remove-dc)
+ (add-to-menu effects-menu "Spiker" spike)
+
+ (define* (effects-compand snd chn)
+ (let ((tbl (float-vector -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
+ 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000)))
+ (let ((len (framples snd chn)))
+ (let ((reader (make-sampler 0 snd chn))
+ (data (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! data i (array-interp tbl (+ 8.0 (* 8.0 (next-sample reader))) 17)))
+ (float-vector->channel data 0 len snd chn current-edit-position "effects-compand")))))
+
+ (add-to-menu effects-menu "Compand" effects-compand)
+
+ (add-to-menu effects-menu "Invert" (lambda () (scale-by -1)))
+ (add-to-menu effects-menu "Reverse" reverse-sound)
+ (add-to-menu effects-menu "Null phase" zero-phase)
+
+ ) ; *gtk*
\ No newline at end of file
diff --git a/headers.c b/headers.c
index b49f352..5b8a7ab 100644
--- a/headers.c
+++ b/headers.c
@@ -1,6 +1,6 @@
/* readers/writers for various sound file headers
*
- * Currently supported read/write (in standard data formats):
+ * Currently supported read/write (in standard sample types):
* NeXT/Sun/DEC/AFsp
* AIFF/AIFC
* RIFF (microsoft wave)
@@ -10,10 +10,10 @@
* CAFF
* no header
*
- * Currently supported read-only (in selected data formats):
+ * Currently supported read-only (in selected sample types):
* 8SVX (IFF), EBICSF, INRS, ESPS, SPPACK, ADC (OGI), AVR, VOC, CSL, snack "SMP", PVF,
* Sound Tools, Turtle Beach SMP, SoundFont 2.0, Sound Designer I, PSION alaw, MAUD,
- * Gravis Ultrasound, Comdisco SPW, Goldwave sample, OMF, NVF, quicktime, sox,
+ * Gravis Ultrasound, Comdisco SPW, Goldwave sample, OMF, quicktime, sox,
* Sonic Foundry (w64), SBStudio II, Delusion digital, Digiplayer ST3, Farandole Composer WaveSample,
* Ultratracker WaveSample, Sample Dump exchange, Yamaha SY85 and SY99 (buggy), Yamaha TX16W,
* Covox v8, AVI, Kurzweil 2000, Paris Ensoniq, Impulse tracker, Korg, Akai type 4, Maui,
@@ -34,7 +34,7 @@
* test cases (sample files): ccrma-ftp.stanford.edu:/pub/Lisp/sf.tar.gz
*/
-#include <mus-config.h>
+#include "mus-config.h"
#if USE_SND
#include "snd.h"
@@ -44,50 +44,18 @@
#include <stdio.h>
#include <errno.h>
#include <stdlib.h>
-#if HAVE_STRING_H
- #include <string.h>
-#endif
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
+#include <string.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
#else
- #if (!(defined(_MSC_VER)))
- #include <unistd.h>
- #endif
+ #include <io.h>
+ #pragma warning(disable: 4244)
#endif
#include "_sndlib.h"
#include "sndlib-strings.h"
-/* ---------------------------------------- */
-/* from io.c but not in _sndlib.h (these are now internal to sndlib, but I don't like the C-oid "_" prefix): */
-void mus_bint_to_char(unsigned char *j, int x);
-int mus_char_to_bint(const unsigned char *inp);
-void mus_lint_to_char(unsigned char *j, int x);
-int mus_char_to_lint(const unsigned char *inp);
-mus_long_t mus_char_to_llong(const unsigned char *inp);
-mus_long_t mus_char_to_blong(const unsigned char *inp);
-int mus_char_to_uninterpreted_int(const unsigned char *inp);
-void mus_bfloat_to_char(unsigned char *j, float x);
-float mus_char_to_bfloat(const unsigned char *inp);
-void mus_lfloat_to_char(unsigned char *j, float x);
-float mus_char_to_lfloat(const unsigned char *inp);
-void mus_bshort_to_char(unsigned char *j, short x);
-short mus_char_to_bshort(const unsigned char *inp);
-void mus_lshort_to_char(unsigned char *j, short x);
-short mus_char_to_lshort(const unsigned char *inp);
-unsigned short mus_char_to_ubshort(const unsigned char *inp);
-unsigned short mus_char_to_ulshort(const unsigned char *inp);
-double mus_char_to_ldouble(const unsigned char *inp);
-double mus_char_to_bdouble(const unsigned char *inp);
-void mus_bdouble_to_char(unsigned char *j, double x);
-void mus_blong_to_char(unsigned char *j, mus_long_t x);
-void mus_llong_to_char(unsigned char *j, mus_long_t x);
-unsigned int mus_char_to_ubint(const unsigned char *inp);
-unsigned int mus_char_to_ulint(const unsigned char *inp);
-/* ---------------------------------------- */
-
-
/* can't use LONG_MAX here because we want a 4-byte max even on 64-bit machines */
#define BIGGEST_4_BYTE_SIGNED_INT 2147483647L
#define BIGGEST_4_BYTE_UNSIGNED_INT 4294967295UL
@@ -159,7 +127,9 @@ static const unsigned char I_IMPS[4] = {'I','M','P','S'}; /* Impulse Tracker */
static const unsigned char I_SMP1[4] = {'S','M','P','1'}; /* Korg */
static const unsigned char I_Maui[4] = {'M','a','u','i'}; /* Turtle Beach */
static const unsigned char I_SDIF[4] = {'S','D','I','F'}; /* IRCAM sdif */
+#if G7XX
static const unsigned char I_NVF_[4] = {'N','V','F',' '}; /* Nomad II Creative NVF */
+#endif
static const unsigned char I_ajkg[4] = {'a','j','k','g'}; /* shorten */
static const unsigned char I_RF64[4] = {'R','F','6','4'}; /* EBU RF64 */
static const unsigned char I_ds64[4] = {'d','s','6','4'}; /* EBU RF64 */
@@ -218,7 +188,9 @@ int mus_header_initialize(void)
#define I_IRCAM_NEXT 0x0004a364
static mus_long_t data_location = 0;
-static int srate = 0, chans = 0, header_type = MUS_UNSUPPORTED, data_format = MUS_UNKNOWN, original_data_format = 0;
+static int srate = 0, chans = 0, original_sample_type = 0;
+static mus_sample_t sample_type = MUS_UNKNOWN_SAMPLE;
+static mus_header_t header_type = MUS_UNKNOWN_HEADER;
static int type_specifier = 0, bits_per_sample = 0, block_align = 0, fact_samples = 0;
static mus_long_t comment_start = 0, comment_end = 0;
static mus_long_t true_file_length = 0, data_size = 0;
@@ -229,8 +201,8 @@ mus_long_t mus_header_samples(void) {return(data_size);}
mus_long_t mus_header_data_location(void) {return(data_location);}
int mus_header_chans(void) {return(chans);}
int mus_header_srate(void) {return(srate);}
-int mus_header_type(void) {return(header_type);}
-int mus_header_format(void) {return(data_format);}
+mus_header_t mus_header_type(void) {return(header_type);}
+mus_sample_t mus_header_sample_type(void) {return(sample_type);}
mus_long_t mus_header_comment_start(void) {return(comment_start);}
mus_long_t mus_header_comment_end(void) {return(comment_end);}
mus_long_t mus_header_aux_comment_start(int n) {if (aux_comment_start) return(aux_comment_start[n]); else return(-1);}
@@ -240,7 +212,7 @@ int mus_header_bits_per_sample(void) {return(bits_per_sample);}
int mus_header_fact_samples(void) {return(fact_samples);}
int mus_header_block_align(void) {return(block_align);}
mus_long_t mus_header_true_length(void) {return(true_file_length);}
-int mus_header_original_format(void) {return(original_data_format);}
+int mus_header_original_sample_type(void) {return(original_sample_type);}
int mus_header_loop_mode(int which) {if (loop_modes) return(loop_modes[which]); else return(-1);}
int mus_header_loop_start(int which) {if (loop_starts) return(loop_starts[which]); else return(-1);}
int mus_header_loop_end(int which) {if (loop_ends) return(loop_ends[which]); else return(-1);}
@@ -256,9 +228,9 @@ int mus_header_mark_info(int **m_ids, int **m_positions)
}
-int mus_bytes_per_sample(int format)
+int mus_bytes_per_sample(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_BYTE: return(1); break;
case MUS_BSHORT: return(2); break;
@@ -287,15 +259,15 @@ int mus_bytes_per_sample(int format)
}
-mus_long_t mus_samples_to_bytes (int format, mus_long_t size)
+mus_long_t mus_samples_to_bytes (mus_sample_t samp_type, mus_long_t size)
{
- return(size * (mus_bytes_per_sample(format)));
+ return(size * (mus_bytes_per_sample(samp_type)));
}
-mus_long_t mus_bytes_to_samples (int format, mus_long_t size)
+mus_long_t mus_bytes_to_samples (mus_sample_t samp_type, mus_long_t size)
{
- return((mus_long_t)(size / (mus_bytes_per_sample(format))));
+ return((mus_long_t)(size / (mus_bytes_per_sample(samp_type))));
}
@@ -351,7 +323,7 @@ static void write_four_chars(unsigned char *head, const unsigned char *match)
}
-const char *mus_header_type_name(int type)
+const char *mus_header_type_name(mus_header_t type)
{
switch (type)
{
@@ -415,7 +387,9 @@ const char *mus_header_type_name(int type)
case MUS_SOUNDFORGE: return("SoundForge"); break;
case MUS_TWINVQ: return("TwinVQ"); break;
case MUS_SDIF: return("IRCAM sdif"); break;
+#if G7XX
case MUS_NVF: return("Creative NVF"); break;
+#endif
case MUS_OGG: return("Ogg Vorbis"); break;
case MUS_FLAC: return("Flac"); break;
case MUS_SPEEX: return("Speex"); break;
@@ -425,14 +399,14 @@ const char *mus_header_type_name(int type)
case MUS_WAVPACK: return("wavpack"); break;
case MUS_RF64: return("rf64"); break;
case MUS_CAFF: return("caff"); break;
- default: return("unsupported"); break;
+ default: return("unknown"); break;
}
}
-const char *mus_data_format_name(int format)
+const char *mus_sample_type_name(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_BSHORT: return("big endian short (16 bits)"); break;
case MUS_MULAW: return("mulaw (8 bits)"); break;
@@ -461,9 +435,9 @@ const char *mus_data_format_name(int format)
}
-const char *mus_data_format_short_name(int format)
+const char *mus_sample_type_short_name(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_BSHORT: return("short int"); break;
case MUS_MULAW: return("mulaw"); break;
@@ -499,7 +473,7 @@ const char *mus_data_format_short_name(int format)
#endif
-const char *mus_header_type_to_string(int type)
+const char *mus_header_type_to_string(mus_header_t type)
{
switch (type)
{
@@ -516,14 +490,15 @@ const char *mus_header_type_to_string(int type)
case MUS_SOUNDFONT: return(TO_LANG(S_mus_soundfont));
case MUS_RF64: return(TO_LANG(S_mus_rf64));
case MUS_CAFF: return(TO_LANG(S_mus_caff));
+ default: break;
}
return(NULL);
}
-const char *mus_data_format_to_string(int format)
+const char *mus_sample_type_to_string(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_BSHORT: return(TO_LANG(S_mus_bshort));
case MUS_LSHORT: return(TO_LANG(S_mus_lshort));
@@ -547,17 +522,17 @@ const char *mus_data_format_to_string(int format)
case MUS_LDOUBLE_UNSCALED: return(TO_LANG(S_mus_ldouble_unscaled));
case MUS_BFLOAT_UNSCALED: return(TO_LANG(S_mus_bfloat_unscaled));
case MUS_LFLOAT_UNSCALED: return(TO_LANG(S_mus_lfloat_unscaled));
+ default: break;
}
return(NULL);
}
-static const char *any_data_format_name(int sndlib_format)
+static const char *any_sample_type_name(mus_sample_t sndlib_samp_type)
{
- if (mus_data_format_p(sndlib_format))
- return(mus_data_format_name(sndlib_format));
- else return(mus_header_original_format_name(mus_header_original_format(),
- mus_header_type()));
+ if (mus_is_sample_type(sndlib_samp_type))
+ return(mus_sample_type_name(sndlib_samp_type));
+ else return(mus_header_original_sample_type_name(mus_header_original_sample_type(), mus_header_type()));
}
@@ -571,7 +546,7 @@ static int read_bicsf_header(const char *filename, int fd);
* 0: ".snd"
* 4: data_location (bytes) (not necessarily word aligned on Sun)
* 8: data_size (bytes) -- sometimes incorrect ("advisory")
- * 12: data format indicator -- see below
+ * 12: sample type indicator -- see below
* 16: srate (int)
* 20: chans
* 24: comment start
@@ -602,7 +577,7 @@ static int read_next_header(const char *filename, int fd)
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)hdrbuf);
data_location = mus_char_to_ubint((unsigned char *)(hdrbuf + 4));
- if (data_location < 24) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data location: " MUS_LD "?", filename, data_location));
+ if (data_location < 24) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data location: %lld?", filename, data_location));
data_size = mus_char_to_ubint((unsigned char *)(hdrbuf + 8)); /* changed to unsigned 11-Nov-06 */
/* can be bogus -- fixup if possible */
@@ -611,37 +586,37 @@ static int read_next_header(const char *filename, int fd)
data_size = (true_file_length - data_location);
else
{
- if (true_file_length > (mus_long_t)(1 << 31))
+ if (true_file_length > (mus_long_t)0x80000000) /* (1 << 31)) */
data_size = true_file_length - data_location; /* assume size field overflowed 32 bits */
}
- original_data_format = mus_char_to_bint((unsigned char *)(hdrbuf + 12));
- switch (original_data_format)
- {
- case 1: data_format = MUS_MULAW; break;
- case 2: data_format = MUS_BYTE; break; /* some sound files assume MUS_UBYTE here! (NAS from 1994 X11R6 contrib) */
- case 3: data_format = MUS_BSHORT; break;
- case 4: data_format = MUS_B24INT; break;
- case 5: data_format = MUS_BINT; break;
- case 6: data_format = MUS_BFLOAT; break;
- case 7: data_format = MUS_BDOUBLE; break;
- case 18: data_format = MUS_BSHORT; break; /* "emphasized": Xavier Serra's de-emphasis filter: y(n) = x(n) + .9 y(n-1) */
- case 27: data_format = MUS_ALAW; break;
- case 30: data_format = MUS_LINT; break; /* from here on, for Snd's internal benefit -- these are probably not used elsewhere */
- case 31: data_format = MUS_LFLOAT; break;
- case 32: data_format = MUS_BINTN; break;
- case 33: data_format = MUS_LINTN; break;
- case 34: data_format = MUS_LDOUBLE; break;
- case 35: data_format = MUS_ULSHORT; break;
- case 36: data_format = MUS_UBSHORT; break;
- case 37: data_format = MUS_LFLOAT_UNSCALED; break;
- case 38: data_format = MUS_BFLOAT_UNSCALED; break;
- case 39: data_format = MUS_LDOUBLE_UNSCALED; break;
- case 40: data_format = MUS_BDOUBLE_UNSCALED; break;
- case 41: data_format = MUS_LSHORT; break;
- case 42: data_format = MUS_L24INT; break;
- case 43: data_format = MUS_UBYTE; break;
- default: data_format = MUS_UNKNOWN; break;
+ original_sample_type = mus_char_to_bint((unsigned char *)(hdrbuf + 12));
+ switch (original_sample_type)
+ {
+ case 1: sample_type = MUS_MULAW; break;
+ case 2: sample_type = MUS_BYTE; break; /* some sound files assume MUS_UBYTE here! (NAS from 1994 X11R6 contrib) */
+ case 3: sample_type = MUS_BSHORT; break;
+ case 4: sample_type = MUS_B24INT; break;
+ case 5: sample_type = MUS_BINT; break;
+ case 6: sample_type = MUS_BFLOAT; break;
+ case 7: sample_type = MUS_BDOUBLE; break;
+ case 18: sample_type = MUS_BSHORT; break; /* "emphasized": Xavier Serra's de-emphasis filter: y(n) = x(n) + .9 y(n-1) */
+ case 27: sample_type = MUS_ALAW; break;
+ case 30: sample_type = MUS_LINT; break; /* from here on, for Snd's internal benefit -- these are probably not used elsewhere */
+ case 31: sample_type = MUS_LFLOAT; break;
+ case 32: sample_type = MUS_BINTN; break;
+ case 33: sample_type = MUS_LINTN; break;
+ case 34: sample_type = MUS_LDOUBLE; break;
+ case 35: sample_type = MUS_ULSHORT; break;
+ case 36: sample_type = MUS_UBSHORT; break;
+ case 37: sample_type = MUS_LFLOAT_UNSCALED; break;
+ case 38: sample_type = MUS_BFLOAT_UNSCALED; break;
+ case 39: sample_type = MUS_LDOUBLE_UNSCALED; break;
+ case 40: sample_type = MUS_BDOUBLE_UNSCALED; break;
+ case 41: sample_type = MUS_LSHORT; break;
+ case 42: sample_type = MUS_L24INT; break;
+ case 43: sample_type = MUS_UBYTE; break;
+ default: sample_type = MUS_UNKNOWN_SAMPLE; break;
}
srate = mus_char_to_bint((unsigned char *)(hdrbuf + 16));
@@ -666,14 +641,14 @@ static int read_next_header(const char *filename, int fd)
maybe_bicsf = mus_char_to_bint((unsigned char *)(hdrbuf + 28));
if (maybe_bicsf == 107364) err = read_bicsf_header(filename, fd);
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(err);
}
-static int sndlib_format_to_next(int format)
+static int sndlib_format_to_next(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_MULAW: return(1); break;
case MUS_BYTE: return(2); break;
@@ -698,9 +673,9 @@ static int sndlib_format_to_next(int format)
case MUS_L24INT: return(42); break;
case MUS_UBYTE: return(43); break;
default:
- return(mus_error(MUS_UNSUPPORTED_DATA_FORMAT, "Next header: can't write data format: %d (%s)",
- format,
- any_data_format_name(format)));
+ return(mus_error(MUS_UNSUPPORTED_SAMPLE_TYPE, "Next header: can't write sample type: %d (%s)",
+ samp_type,
+ any_sample_type_name(samp_type)));
break;
}
}
@@ -710,13 +685,13 @@ static int header_write(int fd, unsigned char *buf, int chars)
{
if (chars > 0)
{
- ssize_t bytes;
- bytes = write(fd, buf, chars);
+ long long int bytes;
+ bytes = (long long int)write(fd, buf, chars);
if (bytes != chars)
{
char *errstr = NULL;
errstr = STRERROR(errno);
- return(mus_error(MUS_WRITE_ERROR, "header_write: wrote " SSIZE_TD " of %d bytes, %s",
+ return(mus_error(MUS_WRITE_ERROR, "header_write: wrote %lld of %d bytes, %s",
bytes, chars, (errstr) ? errstr : "unknown error?"));
}
}
@@ -728,13 +703,13 @@ static int header_read(int fd, unsigned char *buf, int chars)
{
if (chars > 0)
{
- ssize_t bytes;
- bytes = read(fd, buf, chars);
+ long long int bytes;
+ bytes = (long long int)read(fd, buf, chars);
if (bytes != chars)
{
char *errstr = NULL;
errstr = STRERROR(errno);
- return(mus_error(MUS_READ_ERROR, "header_read: read " SSIZE_TD " of %d bytes, %s",
+ return(mus_error(MUS_READ_ERROR, "header_read: read %lld of %d bytes, %s",
bytes, chars, (errstr) ? errstr : "unknown error?"));
}
}
@@ -750,13 +725,13 @@ static void write_next_comment(int fd, const char *comment, int len, int loc)
if (len > 0)
{
unsigned char *combuf;
- combuf = (unsigned char *)calloc(len, sizeof(char));
+ combuf = (unsigned char *)calloc(len, sizeof(unsigned char));
header_write(fd, combuf, len);
free(combuf);
}
}
-static int mus_header_write_next_header(int fd, int wsrate, int wchans, int loc, int siz, int format, const char *comment, int len)
+static int mus_header_write_next_header(int fd, int wsrate, int wchans, int loc, int siz, mus_sample_t samp_type, const char *comment, int len)
{
int i, j;
write_four_chars((unsigned char *)hdrbuf, I_DSND); /* ".snd" */
@@ -765,7 +740,7 @@ static int mus_header_write_next_header(int fd, int wsrate, int wchans, int loc,
if (loc < j) loc = j;
mus_bint_to_char((unsigned char *)(hdrbuf + 4), loc);
mus_bint_to_char((unsigned char *)(hdrbuf + 8), siz);
- mus_bint_to_char((unsigned char *)(hdrbuf + 12), sndlib_format_to_next(format));
+ mus_bint_to_char((unsigned char *)(hdrbuf + 12), sndlib_format_to_next(samp_type));
mus_bint_to_char((unsigned char *)(hdrbuf + 16), wsrate);
mus_bint_to_char((unsigned char *)(hdrbuf + 20), wchans);
header_write(fd, hdrbuf, 24);
@@ -790,7 +765,7 @@ static int mus_header_write_next_header(int fd, int wsrate, int wchans, int loc,
* The chunks we want are "COMM", "SSND", and "APPL".
*
* COMM: 0: chans
- * 2: frames
+ * 2: framples
* 6: bits per sample
* 8: srate as 80-bit IEEE float
* then if AIFC (not AIFF), 4 bytes giving compression id ("NONE"=not compressed)
@@ -901,9 +876,9 @@ static void double_to_ieee_80(double val, unsigned char *p)
}
-static mus_long_t update_form_size, update_frames_location, update_ssnd_location, update_rf64_location;
+static mus_long_t update_form_size, update_framples_location, update_ssnd_location, update_rf64_location;
-static ssize_t seek_and_read(int fd, unsigned char *buf, mus_long_t offset, int nbytes)
+static long long int seek_and_read(int fd, unsigned char *buf, mus_long_t offset, int nbytes)
{
if (offset < 0) return(-1);
lseek(fd, offset, SEEK_SET);
@@ -987,8 +962,8 @@ static void read_aif_aux_comment(unsigned char *buf, mus_long_t offset, int chun
static void read_aif_appl_chunk(unsigned char *buf, mus_long_t offset, int chunksize)
{
- const unsigned char I_SU7M[4] = {'S','U','7','M'};
- const unsigned char I_SU7R[4] = {'S','U','7','R'};
+ static const unsigned char I_SU7M[4] = {'S','U','7','M'};
+ static const unsigned char I_SU7R[4] = {'S','U','7','R'};
if (match_four_chars((unsigned char *)(buf + 8), I_MUS_))
{
@@ -1017,7 +992,7 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
{
/* we know we have checked for FORM xxxx AIFF|AIFC when we arrive here */
/* as far as I can tell, the COMM block has the header data we seek, and the SSND block has the sound data */
- int chunksize, chunkloc, i, ssnd_bytes = 0;
+ int chunkloc, i, ssnd_bytes = 0;
bool happy = true, got_comm = false;
mus_long_t offset = 0;
@@ -1025,7 +1000,7 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
update_ssnd_location = 0;
chunkloc = 12 + overall_offset;
for (i = 0; i < AUX_COMMENTS; i++) aux_comment_start[i] = 0;
- data_format = MUS_BSHORT;
+ sample_type = MUS_BSHORT;
srate = 0;
chans = 0;
markers = 0;
@@ -1039,15 +1014,16 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
while (happy)
{
+ int chunksize;
offset += chunkloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
{
if ((got_comm) && (data_location > 0))
{
- mus_print("%s, aiff header: chunks confused at " MUS_LD "; will try to continue", filename, offset);
+ mus_print("%s, aiff header: chunks confused at %lld; will try to continue", filename, offset);
break;
}
- return(mus_error(MUS_HEADER_READ_FAILED, "%s, aiff header: chunks confused at " MUS_LD , filename, offset));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s, aiff header: chunks confused at %lld" , filename, offset));
}
chunksize = mus_char_to_bint((unsigned char *)(hdrbuf + 4));
@@ -1061,97 +1037,97 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
if (match_four_chars((unsigned char *)hdrbuf, I_COMM))
{
- int frames;
+ int framples;
got_comm = true;
chans = mus_char_to_bshort((unsigned char *)(hdrbuf + 8));
- frames = mus_char_to_ubint((unsigned char *)(hdrbuf + 10)); /* was bint 27-Jul-01 */
- update_frames_location = 10 + offset;
+ framples = mus_char_to_ubint((unsigned char *)(hdrbuf + 10)); /* was bint 27-Jul-01 */
+ update_framples_location = 10 + offset;
- original_data_format = mus_char_to_bshort((unsigned char *)(hdrbuf + 14));
- if ((original_data_format % 8) != 0)
+ original_sample_type = mus_char_to_bshort((unsigned char *)(hdrbuf + 14));
+ if ((original_sample_type % 8) != 0)
{
/* weird sizes are legal --
* these samples are left-justified (and zero padded on the right), so
* we can handle any bit size by rounding up to the nearest byte.
*/
- original_data_format = 8 * (1 + (original_data_format >> 3));
+ original_sample_type = 8 * (1 + (original_sample_type >> 3));
}
- if (original_data_format == 8) data_format = MUS_BYTE;
- else if (original_data_format == 16) data_format = MUS_BSHORT;
- else if (original_data_format == 24) data_format = MUS_B24INT;
- else if (original_data_format == 32) data_format = MUS_BINT;
- else if (original_data_format == 64) data_format = MUS_BDOUBLE;
+ if (original_sample_type == 8) sample_type = MUS_BYTE;
+ else if (original_sample_type == 16) sample_type = MUS_BSHORT;
+ else if (original_sample_type == 24) sample_type = MUS_B24INT;
+ else if (original_sample_type == 32) sample_type = MUS_BINT;
+ else if (original_sample_type == 64) sample_type = MUS_BDOUBLE;
else return(mus_error(MUS_HEADER_READ_FAILED, "%s: bits per sample: %d?", filename, mus_char_to_bshort((unsigned char *)(hdrbuf + 14))));
srate = (int)ieee_80_to_double((unsigned char *)(hdrbuf + 16));
- /* if AIFC, compression type over-rides (possibly bogus) original_data_format */
+ /* if AIFC, compression type over-rides (possibly bogus) original_sample_type */
if (type_specifier == mus_char_to_uninterpreted_int((unsigned const char *)I_AIFC))
{
- const unsigned char I_twos[4] = {'t','w','o','s'}; /* AIFC big endian? */
+ static const unsigned char I_twos[4] = {'t','w','o','s'}; /* AIFC big endian? */
/* some aifc files assume the compression field is a new and very weird chunk!! -- surely a bug? */
/* AIFF spec says COMM size is always 18, but this is amended in the newer AIFC spec */
if (chunksize == 18) chunksize += (5 + ((int)hdrbuf[30])); /* 5 = chunk header length in this case */
if ((!(match_four_chars((unsigned char *)(hdrbuf + 26), I_NONE))) &&
(!(match_four_chars((unsigned char *)(hdrbuf + 26), I_twos))))
{
- const unsigned char I_ALAW[4] = {'A','L','A','W'};
- original_data_format = mus_char_to_uninterpreted_int((unsigned char *)(hdrbuf + 26));
+ static const unsigned char I_ALAW[4] = {'A','L','A','W'};
+ original_sample_type = mus_char_to_uninterpreted_int((unsigned char *)(hdrbuf + 26));
if ((match_four_chars((unsigned char *)(hdrbuf + 26), I_ALAW)) ||
(match_four_chars((unsigned char *)(hdrbuf + 26), I_alaw)))
- data_format = MUS_ALAW;
+ sample_type = MUS_ALAW;
else
{
if ((match_four_chars((unsigned char *)(hdrbuf + 26), I_ULAW)) ||
(match_four_chars((unsigned char *)(hdrbuf + 26), I_ulaw)))
- data_format = MUS_MULAW;
+ sample_type = MUS_MULAW;
else
{
- const unsigned char I_ni23[4] = {'n','i','2','3'};
+ static const unsigned char I_ni23[4] = {'n','i','2','3'};
if ((match_four_chars((unsigned char *)(hdrbuf + 26), I_sowt)) ||
(match_four_chars((unsigned char *)(hdrbuf + 26), I_ni23)))
{
/* Sound.h sez sowt is just 16-bit format */
- if (data_format == MUS_BSHORT) data_format = MUS_LSHORT;
- else if (data_format == MUS_B24INT) data_format = MUS_L24INT;
- else if (data_format == MUS_BINT) data_format = MUS_LINT;
+ if (sample_type == MUS_BSHORT) sample_type = MUS_LSHORT;
+ else if (sample_type == MUS_B24INT) sample_type = MUS_L24INT;
+ else if (sample_type == MUS_BINT) sample_type = MUS_LINT;
}
else
{
if (match_four_chars((unsigned char *)(hdrbuf + 26), I_raw_))
{
- if (data_format == MUS_BYTE) data_format = MUS_UBYTE;
- else if (data_format == MUS_BSHORT) data_format = MUS_UBSHORT;
+ if (sample_type == MUS_BYTE) sample_type = MUS_UBYTE;
+ else if (sample_type == MUS_BSHORT) sample_type = MUS_UBSHORT;
}
else
{
unsigned char I_FL32[4] = {'F','L','3','2'}; /* 32-bit float (apparently used by CSound and SoundHack) */
if ((match_four_chars((unsigned char *)(hdrbuf + 26), I_fl32)) ||
(match_four_chars((unsigned char *)(hdrbuf + 26), I_FL32)))
- data_format = MUS_BFLOAT;
+ sample_type = MUS_BFLOAT;
else
{
if (match_four_chars((unsigned char *)(hdrbuf + 26), I_fl64))
- data_format = MUS_BDOUBLE;
+ sample_type = MUS_BDOUBLE;
else
{
- const unsigned char I_ima4[4] = {'i','m','a','4'}; /* AIFC IMA adpcm apparently */
+ static const unsigned char I_ima4[4] = {'i','m','a','4'}; /* AIFC IMA adpcm apparently */
if (match_four_chars((unsigned char *)(hdrbuf + 26), I_ima4))
{
block_align = 34;
- original_data_format = MUS_AIFF_IMA_ADPCM;
+ original_sample_type = MUS_AIFF_IMA_ADPCM;
}
else
{
- const unsigned char I_in32[4] = {'i','n','3','2'};
+ static const unsigned char I_in32[4] = {'i','n','3','2'};
if (match_four_chars((unsigned char *)(hdrbuf + 26), I_in32))
- data_format = MUS_BINT;
+ sample_type = MUS_BINT;
else
{
- const unsigned char I_in24[4] = {'i','n','2','4'};
+ static const unsigned char I_in24[4] = {'i','n','2','4'};
if (match_four_chars((unsigned char *)(hdrbuf + 26), I_in24))
- data_format = MUS_B24INT;
+ sample_type = MUS_B24INT;
else
{
/* others from Sound.h:
@@ -1171,7 +1147,7 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
openquicktime and ffmpeg have decoders for some of these; all too complex for my taste
on a Mac, we could apparently pick up decoders from coreaudio
*/
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
}
}
}
@@ -1183,7 +1159,7 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
}
}
}
- data_size = (frames * mus_bytes_per_sample(data_format) * chans);
+ data_size = (framples * mus_bytes_per_sample(sample_type) * chans);
}
else
{
@@ -1203,7 +1179,7 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
}
else
{
- const unsigned char I_AUTH[4] = {'A','U','T','H'};
+ static const unsigned char I_AUTH[4] = {'A','U','T','H'};
if ((match_four_chars((unsigned char *)hdrbuf, I_ANNO)) ||
(match_four_chars((unsigned char *)hdrbuf, I_COMT)) ||
(match_four_chars((unsigned char *)hdrbuf, I_NAME)) ||
@@ -1239,20 +1215,20 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- if ((data_size > ssnd_bytes) && (data_format != MUS_UNKNOWN))
+ if ((data_size > ssnd_bytes) && (sample_type != MUS_UNKNOWN_SAMPLE))
data_size = ssnd_bytes;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
-static int sndlib_format_to_aiff_bits(int format)
+static int sndlib_format_to_aiff_bits(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_BSHORT: case MUS_LSHORT: case MUS_UBSHORT: case MUS_ULSHORT: return(16); break;
case MUS_B24INT: case MUS_L24INT: return(24); break;
@@ -1260,17 +1236,17 @@ static int sndlib_format_to_aiff_bits(int format)
case MUS_BDOUBLE: case MUS_LDOUBLE: return(64); break;
case MUS_BYTE: case MUS_UBYTE: case MUS_MULAW: case MUS_ALAW: return(8); break;
default:
- return(mus_error(MUS_UNSUPPORTED_DATA_FORMAT, "aiff header: can't write data format: %d (%s)",
- format,
- any_data_format_name(format)));
+ return(mus_error(MUS_UNSUPPORTED_SAMPLE_TYPE, "aiff header: can't write sample type: %d (%s)",
+ samp_type,
+ any_sample_type_name(samp_type)));
break;
}
}
-static const char *sndlib_format_to_aifc_name(int format)
+static const char *sndlib_format_to_aifc_name(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_BSHORT: case MUS_B24INT: case MUS_BINT: case MUS_BYTE: return((const char *)I_NONE); break; /* use in24 and in32? */
case MUS_LSHORT: case MUS_L24INT: case MUS_LINT: return((const char *)I_sowt); break; /* should this use ni23? */
@@ -1284,14 +1260,13 @@ static const char *sndlib_format_to_aifc_name(int format)
}
-static int write_aif_header(int fd, int wsrate, int wchans, int siz, int format, const char *comment, int len, bool aifc_header)
+static int write_aif_header(int fd, int wsrate, int wchans, int siz, mus_sample_t samp_type, const char *comment, int len, bool aifc_header)
{
/* we write the simplest possible AIFC header: AIFC | COMM | APPL-MUS_ if needed | SSND eof. */
/* the assumption being that we're going to be appending sound data once the header is out */
/* INST and MARK chunks added Jul-95 for various programs that expect them (MixView). */
/* set aifc_header to false to get old-style AIFF header */
int i, j, lenhdr = 0, lenloop, curend = 0, extra = 0;
- char *str;
lenloop = 38;
if ((loop_modes[0] != 0) || (loop_modes[1] != 0)) lenloop = 42 + 28;
@@ -1331,14 +1306,15 @@ static int write_aif_header(int fd, int wsrate, int wchans, int siz, int format,
mus_bshort_to_char((unsigned char *)(hdrbuf + 20), (short)wchans);
if (wchans > 0)
- mus_bint_to_char((unsigned char *)(hdrbuf + 22), siz / (wchans * mus_bytes_per_sample(format)));
+ mus_bint_to_char((unsigned char *)(hdrbuf + 22), siz / (wchans * mus_bytes_per_sample(samp_type)));
- mus_bshort_to_char((unsigned char *)(hdrbuf + 26), sndlib_format_to_aiff_bits(format));
+ mus_bshort_to_char((unsigned char *)(hdrbuf + 26), sndlib_format_to_aiff_bits(samp_type));
double_to_ieee_80((double)wsrate, (unsigned char *)(hdrbuf + 28));
if (aifc_header)
{
- str = (char *)sndlib_format_to_aifc_name(format);
+ char *str;
+ str = (char *)sndlib_format_to_aifc_name(samp_type);
write_four_chars((unsigned char *)(hdrbuf + 38), (const unsigned char *)str);
(*(unsigned char *)(hdrbuf + 42)) = 4; /* final pad null not accounted-for */
write_four_chars((unsigned char *)(hdrbuf + 43), (const unsigned char *)str);
@@ -1474,12 +1450,13 @@ char *mus_header_aiff_aux_comment(const char *name, mus_long_t *starts, mus_long
sc_len = 0;
for (i = 0; i < AUX_COMMENTS; i++)
{
- mus_long_t start, end, len;
+ mus_long_t start, end;
start = starts[i];
end = ends[i];
if ((start > 0) && (start < end))
{
int j;
+ mus_long_t len;
len = end - start + 1;
lseek(fd, start, SEEK_SET);
header_read(fd, (unsigned char *)(sc + sc_len), len);
@@ -1514,8 +1491,8 @@ char *mus_header_aiff_aux_comment(const char *name, mus_long_t *starts, mus_long
* 28: format (int32)
* 32: format flags
* 36: bytes per "packet"
- * 40: frames per packet
- * 44: channels per frame
+ * 40: framples per packet
+ * 44: channels per frample
* 48: bits per channel
* audio data is in 'data' chunk
*/
@@ -1531,7 +1508,7 @@ static int read_caff_header(int fd)
#define data_is_big_endian (1L << 1)
/* misleading name -- flag is 1 if data is little endian */
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
srate = 0;
chans = 0;
data_size = 0;
@@ -1549,21 +1526,17 @@ static int read_caff_header(int fd)
/* 'desc' is always the first chunk, but easier to handle in the loop */
if (match_four_chars((unsigned char *)hdrbuf, I_desc))
{
- int format_flags, bytes_per_packet, frames_per_packet, channels_per_frame, bits_per_channel;
+ int format_flags, channels_per_frample, bits_per_channel;
srate = (int)mus_char_to_bdouble((unsigned char *)(hdrbuf + 12));
format_flags = mus_char_to_ubint((unsigned char *)(hdrbuf + 24));
- bytes_per_packet = mus_char_to_ubint((unsigned char *)(hdrbuf + 28));
- frames_per_packet = mus_char_to_ubint((unsigned char *)(hdrbuf + 32));
- channels_per_frame = mus_char_to_ubint((unsigned char *)(hdrbuf + 36));
+ /* bytes_per_packet = mus_char_to_ubint((unsigned char *)(hdrbuf + 28)); */
+ /* framples_per_packet = mus_char_to_ubint((unsigned char *)(hdrbuf + 32)); */
+ channels_per_frample = mus_char_to_ubint((unsigned char *)(hdrbuf + 36));
bits_per_channel = mus_char_to_ubint((unsigned char *)(hdrbuf + 40));
- chans = channels_per_frame;
-#if 0
- fprintf(stderr, "srate: %d, format: %c%c%c%c, %d, bytes: %d, frames: %d, chans: %d, bits: %d\n",
- srate, hdrbuf[20], hdrbuf[21], hdrbuf[22], hdrbuf[23],
- format_flags, bytes_per_packet, frames_per_packet, channels_per_frame, bits_per_channel);
-#endif
+ chans = channels_per_frample;
+
/* format id can be 'lpcm' 'alaw' 'ulaw' and a bunch of others we ignore */
- original_data_format = mus_char_to_bint((unsigned char *)(hdrbuf + 20));
+ original_sample_type = mus_char_to_bint((unsigned char *)(hdrbuf + 20));
if (match_four_chars((unsigned char *)(hdrbuf + 20), I_lpcm))
{
if (format_flags & data_is_float)
@@ -1571,23 +1544,23 @@ static int read_caff_header(int fd)
if (!(format_flags & data_is_big_endian))
{
if (bits_per_channel == 32)
- data_format = MUS_BFLOAT;
+ sample_type = MUS_BFLOAT;
else
{
if (bits_per_channel == 64)
- data_format = MUS_BDOUBLE;
- else err = MUS_UNSUPPORTED_DATA_FORMAT;
+ sample_type = MUS_BDOUBLE;
+ else err = MUS_UNSUPPORTED_SAMPLE_TYPE;
}
}
else
{
if (bits_per_channel == 32)
- data_format = MUS_LFLOAT;
+ sample_type = MUS_LFLOAT;
else
{
if (bits_per_channel == 64)
- data_format = MUS_LDOUBLE;
- else err = MUS_UNSUPPORTED_DATA_FORMAT;
+ sample_type = MUS_LDOUBLE;
+ else err = MUS_UNSUPPORTED_SAMPLE_TYPE;
}
}
}
@@ -1596,20 +1569,20 @@ static int read_caff_header(int fd)
if (!(format_flags & data_is_big_endian))
{
if (bits_per_channel == 32)
- data_format = MUS_BINTN;
+ sample_type = MUS_BINTN;
else
{
if (bits_per_channel == 24)
- data_format = MUS_B24INT;
+ sample_type = MUS_B24INT;
else
{
if (bits_per_channel == 16)
- data_format = MUS_BSHORT;
+ sample_type = MUS_BSHORT;
else
{
if (bits_per_channel == 8)
- data_format = MUS_BYTE;
- else err = MUS_UNSUPPORTED_DATA_FORMAT;
+ sample_type = MUS_BYTE;
+ else err = MUS_UNSUPPORTED_SAMPLE_TYPE;
}
}
}
@@ -1617,20 +1590,20 @@ static int read_caff_header(int fd)
else
{
if (bits_per_channel == 32)
- data_format = MUS_LINTN;
+ sample_type = MUS_LINTN;
else
{
if (bits_per_channel == 24)
- data_format = MUS_L24INT;
+ sample_type = MUS_L24INT;
else
{
if (bits_per_channel == 16)
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
else
{
if (bits_per_channel == 8)
- data_format = MUS_BYTE;
- else err = MUS_UNSUPPORTED_DATA_FORMAT;
+ sample_type = MUS_BYTE;
+ else err = MUS_UNSUPPORTED_SAMPLE_TYPE;
}
}
}
@@ -1641,15 +1614,15 @@ static int read_caff_header(int fd)
{
if (match_four_chars((unsigned char *)(hdrbuf + 20), I_alaw))
{
- data_format = MUS_ALAW;
+ sample_type = MUS_ALAW;
}
else
{
if (match_four_chars((unsigned char *)(hdrbuf + 20), I_ulaw))
{
- data_format = MUS_MULAW;
+ sample_type = MUS_MULAW;
}
- else err = MUS_UNSUPPORTED_DATA_FORMAT;
+ else err = MUS_UNSUPPORTED_SAMPLE_TYPE;
}
}
}
@@ -1659,7 +1632,7 @@ static int read_caff_header(int fd)
{
happy = true;
data_location = offset + 16; /* skip the 4 bytes for "edit count" */
- update_frames_location = offset + 4;
+ update_framples_location = offset + 4;
/* here chunksize can be -1! */
if (chunksize > 0)
@@ -1673,17 +1646,17 @@ static int read_caff_header(int fd)
}
if (err == MUS_NO_ERROR)
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(err);
}
-static int write_caff_header(int fd, int wsrate, int wchans, mus_long_t wsize, int format)
+static int write_caff_header(int fd, int wsrate, int wchans, mus_long_t wsize, mus_sample_t samp_type)
{
- int format_flags = 0, bytes_per_packet = 0, frames_per_packet = 1, bits_per_channel = 0;
+ int format_flags = 0, bytes_per_packet = 0, framples_per_packet = 1, bits_per_channel = 0;
- switch (format)
+ switch (samp_type)
{
case MUS_ALAW:
bytes_per_packet = 1;
@@ -1696,11 +1669,11 @@ static int write_caff_header(int fd, int wsrate, int wchans, mus_long_t wsize, i
break;
default:
- if ((format == MUS_LFLOAT) || (format == MUS_LDOUBLE) || (format == MUS_BFLOAT) || (format == MUS_BDOUBLE))
+ if ((samp_type == MUS_LFLOAT) || (samp_type == MUS_LDOUBLE) || (samp_type == MUS_BFLOAT) || (samp_type == MUS_BDOUBLE))
format_flags = 1;
- if ((format == MUS_LFLOAT) || (format == MUS_LDOUBLE) || (format == MUS_LINTN) || (format == MUS_L24INT) || (format == MUS_LSHORT))
+ if ((samp_type == MUS_LFLOAT) || (samp_type == MUS_LDOUBLE) || (samp_type == MUS_LINTN) || (samp_type == MUS_L24INT) || (samp_type == MUS_LSHORT))
format_flags |= 2;
- switch (format)
+ switch (samp_type)
{
case MUS_BYTE:
bytes_per_packet = 1;
@@ -1726,6 +1699,8 @@ static int write_caff_header(int fd, int wsrate, int wchans, mus_long_t wsize, i
bytes_per_packet = 8;
bits_per_channel = 64;
break;
+
+ default: break;
}
break;
}
@@ -1737,7 +1712,7 @@ static int write_caff_header(int fd, int wsrate, int wchans, mus_long_t wsize, i
write_four_chars((unsigned char *)(hdrbuf + 8), I_desc);
mus_blong_to_char((unsigned char *)(hdrbuf + 12), 32);
mus_bdouble_to_char((unsigned char *)(hdrbuf + 20), (double)wsrate);
- switch (format)
+ switch (samp_type)
{
case MUS_ALAW:
write_four_chars((unsigned char *)(hdrbuf + 28), I_alaw);
@@ -1753,12 +1728,12 @@ static int write_caff_header(int fd, int wsrate, int wchans, mus_long_t wsize, i
}
mus_bint_to_char((unsigned char *)(hdrbuf + 32), format_flags);
mus_bint_to_char((unsigned char *)(hdrbuf + 36), bytes_per_packet);
- mus_bint_to_char((unsigned char *)(hdrbuf + 40), frames_per_packet);
+ mus_bint_to_char((unsigned char *)(hdrbuf + 40), framples_per_packet);
mus_bint_to_char((unsigned char *)(hdrbuf + 44), wchans);
mus_bint_to_char((unsigned char *)(hdrbuf + 48), bits_per_channel);
write_four_chars((unsigned char *)(hdrbuf + 52), I_data);
mus_blong_to_char((unsigned char *)(hdrbuf + 56), wsize);
- update_frames_location = 56;
+ update_framples_location = 56;
mus_bint_to_char((unsigned char *)(hdrbuf + 64), 0);
data_location = 68;
header_write(fd, hdrbuf, 68);
@@ -1836,7 +1811,7 @@ static int write_caff_header(int fd, int wsrate, int wchans, mus_long_t wsize, i
* bext chunk has comments -- perhaps add these to the info/list list? I need an example! -- is the chunk id "bext"?
*/
-static int wave_to_sndlib_format(int osf, int bps, bool little)
+static mus_sample_t wave_to_sndlib_format(int osf, int bps, bool little)
{
switch (osf)
{
@@ -1870,11 +1845,11 @@ static int wave_to_sndlib_format(int osf, int bps, bool little)
case 0x101: return(MUS_MULAW); break;
case 0x102: return(MUS_ALAW); break;
}
- return(MUS_UNKNOWN);
+ return(MUS_UNKNOWN_SAMPLE);
}
-static void read_riff_fmt_chunk(unsigned char *hdrbuf, bool little)
+static void read_riff_fmt_chunk(unsigned char *hbuf, bool little)
{
/* fmt chunk (also used in RF64 below)
*
@@ -1895,75 +1870,75 @@ static void read_riff_fmt_chunk(unsigned char *hdrbuf, bool little)
* #x000551f8 = 348664 = size in bytes - 8
* #x00000fe4 = 4068 [fmt_ chunk size?]
*/
- original_data_format = big_or_little_endian_short((unsigned char *)(hdrbuf + 8), little);
- chans = big_or_little_endian_short((unsigned char *)(hdrbuf + 10), little);
- srate = big_or_little_endian_int((unsigned char *)(hdrbuf + 12), little);
- block_align = big_or_little_endian_short((unsigned char *)(hdrbuf + 20), little);
- bits_per_sample = big_or_little_endian_short((unsigned char *)(hdrbuf + 22), little);
- if (original_data_format == -2) /* 0xFFFE = "extensible" : short size=22, short bits, long chanmap, short format */
- original_data_format = big_or_little_endian_short((unsigned char *)(hdrbuf + 24 + 8), little);
- data_format = wave_to_sndlib_format(original_data_format, bits_per_sample, little);
+ original_sample_type = big_or_little_endian_short((unsigned char *)(hbuf + 8), little);
+ chans = big_or_little_endian_short((unsigned char *)(hbuf + 10), little);
+ srate = big_or_little_endian_int((unsigned char *)(hbuf + 12), little);
+ block_align = big_or_little_endian_short((unsigned char *)(hbuf + 20), little);
+ bits_per_sample = big_or_little_endian_short((unsigned char *)(hbuf + 22), little);
+ if (original_sample_type == -2) /* 0xFFFE = "extensible" : short size=22, short bits, long chanmap, short format */
+ original_sample_type = big_or_little_endian_short((unsigned char *)(hbuf + 24 + 8), little);
+ sample_type = wave_to_sndlib_format(original_sample_type, bits_per_sample, little);
}
-static int write_riff_fmt_chunk(int fd, unsigned char *hdrbuf, int format, int wsrate, int wchans)
+static int write_riff_fmt_chunk(int fd, unsigned char *hbuf, mus_sample_t samp_type, int wsrate, int wchans)
{
int err = MUS_NO_ERROR;
- write_four_chars((unsigned char *)hdrbuf, I_fmt_);
- mus_lint_to_char((unsigned char *)(hdrbuf + 4), 16);
- switch (format)
+ write_four_chars((unsigned char *)hbuf, I_fmt_);
+ mus_lint_to_char((unsigned char *)(hbuf + 4), 16);
+ switch (samp_type)
{
case MUS_MULAW:
- mus_lshort_to_char((unsigned char *)(hdrbuf + 8), 7);
- mus_lshort_to_char((unsigned char *)(hdrbuf + 22), 8);
+ mus_lshort_to_char((unsigned char *)(hbuf + 8), 7);
+ mus_lshort_to_char((unsigned char *)(hbuf + 22), 8);
break;
case MUS_ALAW:
- mus_lshort_to_char((unsigned char *)(hdrbuf + 8), 6);
- mus_lshort_to_char((unsigned char *)(hdrbuf + 22), 8);
+ mus_lshort_to_char((unsigned char *)(hbuf + 8), 6);
+ mus_lshort_to_char((unsigned char *)(hbuf + 22), 8);
break;
case MUS_UBYTE:
- mus_lshort_to_char((unsigned char *)(hdrbuf + 8), 1);
- mus_lshort_to_char((unsigned char *)(hdrbuf + 22), 8);
+ mus_lshort_to_char((unsigned char *)(hbuf + 8), 1);
+ mus_lshort_to_char((unsigned char *)(hbuf + 22), 8);
break;
case MUS_LSHORT:
- mus_lshort_to_char((unsigned char *)(hdrbuf + 8), 1);
- mus_lshort_to_char((unsigned char *)(hdrbuf + 22), 16);
+ mus_lshort_to_char((unsigned char *)(hbuf + 8), 1);
+ mus_lshort_to_char((unsigned char *)(hbuf + 22), 16);
break;
case MUS_L24INT:
- mus_lshort_to_char((unsigned char *)(hdrbuf + 8), 1);
- mus_lshort_to_char((unsigned char *)(hdrbuf + 22), 24);
+ mus_lshort_to_char((unsigned char *)(hbuf + 8), 1);
+ mus_lshort_to_char((unsigned char *)(hbuf + 22), 24);
break;
case MUS_LINT:
- mus_lshort_to_char((unsigned char *)(hdrbuf + 8), 1);
- mus_lshort_to_char((unsigned char *)(hdrbuf + 22), 32);
+ mus_lshort_to_char((unsigned char *)(hbuf + 8), 1);
+ mus_lshort_to_char((unsigned char *)(hbuf + 22), 32);
break;
case MUS_LFLOAT:
- mus_lshort_to_char((unsigned char *)(hdrbuf + 8), 3);
- mus_lshort_to_char((unsigned char *)(hdrbuf + 22), 32);
+ mus_lshort_to_char((unsigned char *)(hbuf + 8), 3);
+ mus_lshort_to_char((unsigned char *)(hbuf + 22), 32);
break;
case MUS_LDOUBLE:
- mus_lshort_to_char((unsigned char *)(hdrbuf + 8), 3);
- mus_lshort_to_char((unsigned char *)(hdrbuf + 22), 64);
+ mus_lshort_to_char((unsigned char *)(hbuf + 8), 3);
+ mus_lshort_to_char((unsigned char *)(hbuf + 22), 64);
break;
default:
/* don't call mus_error directly -- we need to close the file first in mus_header_write */
- err = MUS_UNSUPPORTED_DATA_FORMAT;
+ err = MUS_UNSUPPORTED_SAMPLE_TYPE;
break;
}
- mus_lshort_to_char((unsigned char *)(hdrbuf + 10), (short)wchans);
- mus_lint_to_char((unsigned char *)(hdrbuf + 12), wsrate);
- mus_lint_to_char((unsigned char *)(hdrbuf + 16), wsrate * wchans * mus_bytes_per_sample(format)); /* added chans 10-Mar-99 */
- mus_lshort_to_char((unsigned char *)(hdrbuf + 20), (short)(wchans * mus_bytes_per_sample(format)));
+ mus_lshort_to_char((unsigned char *)(hbuf + 10), (short)wchans);
+ mus_lint_to_char((unsigned char *)(hbuf + 12), wsrate);
+ mus_lint_to_char((unsigned char *)(hbuf + 16), wsrate * wchans * mus_bytes_per_sample(samp_type)); /* added chans 10-Mar-99 */
+ mus_lshort_to_char((unsigned char *)(hbuf + 20), (short)(wchans * mus_bytes_per_sample(samp_type)));
/* 22 short written above = bits/sample */
- header_write(fd, hdrbuf, 24);
+ header_write(fd, hbuf, 24);
return(err);
}
@@ -1973,14 +1948,14 @@ static const unsigned char I_JUNK[4] = {'J','U','N','K'};
static int read_riff_header(const char *filename, int fd)
{
/* we know we have checked for RIFF xxxx WAVE when we arrive here */
- int chunksize, chunkloc = 12, i;
+ int chunkloc = 12, i;
bool little = true, got_fmt = false;
mus_long_t offset = 0;
if (match_four_chars((unsigned char *)hdrbuf, I_RIFX)) little = false; /* big-endian data in this case, but I've never seen one */
little_endian = little;
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)(hdrbuf + 8));
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
srate = 0;
chans = 0;
fact_samples = 0;
@@ -1991,6 +1966,7 @@ static int read_riff_header(const char *filename, int fd)
while (true)
{
+ int chunksize;
offset += chunkloc;
if (offset >= true_file_length) break;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 64) <= 0) break;
@@ -2003,7 +1979,7 @@ static int read_riff_header(const char *filename, int fd)
if (match_four_chars((unsigned char *)hdrbuf, I_fmt_))
{
got_fmt = true;
- update_frames_location = 12 + offset;
+ update_framples_location = 12 + offset;
read_riff_fmt_chunk(hdrbuf, little);
}
else
@@ -2023,7 +1999,7 @@ static int read_riff_header(const char *filename, int fd)
}
else
{
- const unsigned char I_inst[4] = {'i','n','s','t'}; /* RIFF wants lower case, just to be different */
+ static const unsigned char I_inst[4] = {'i','n','s','t'}; /* RIFF wants lower case, just to be different */
if (match_four_chars((unsigned char *)hdrbuf, I_inst))
{
base_note = hdrbuf[8];
@@ -2065,9 +2041,9 @@ static int read_riff_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -2104,7 +2080,7 @@ static void write_riff_clm_comment(int fd, const char *comment, int len, int ext
}
-static int write_riff_header(int fd, int wsrate, int wchans, int siz, int format, const char *comment, int len)
+static int write_riff_header(int fd, int wsrate, int wchans, int siz, mus_sample_t samp_type, const char *comment, int len)
{
int j, extra = 0, err = MUS_NO_ERROR;
@@ -2116,7 +2092,7 @@ static int write_riff_header(int fd, int wsrate, int wchans, int siz, int format
data_location += (8 + len + extra);
}
/* 36 = "RIFF" + size(4) + "WAVE" + "fmt " + size(4) + 16 for data */
- /* 2nd 36 is for "JUNK" chunk, 8 is data chunk header */
+ /* second 36 is for "JUNK" chunk, 8 is data chunk header */
write_four_chars((unsigned char *)hdrbuf, I_RIFF);
mus_lint_to_char((unsigned char *)(hdrbuf + 4), data_location + siz - 8); /* added -8 25-June-07 */
@@ -2130,7 +2106,7 @@ static int write_riff_header(int fd, int wsrate, int wchans, int siz, int format
header_write(fd, hdrbuf, 36);
/* fmt chunk */
- err = write_riff_fmt_chunk(fd, hdrbuf, format, wsrate, wchans);
+ err = write_riff_fmt_chunk(fd, hdrbuf, samp_type, wsrate, wchans);
/* include possible clm (comment) chunk */
if (len > 0)
@@ -2149,7 +2125,7 @@ char *mus_header_riff_aux_comment(const char *name, mus_long_t *starts, mus_long
char *sc = NULL, *auxcom;
if ((starts) && (starts[0] != 0))
{
- int len, j, fd, k, m;
+ int j, fd, k, m;
mus_long_t i, end;
/* found a LIST+INFO chunk (and no other comment) */
fd = mus_file_open_read(name);
@@ -2166,6 +2142,7 @@ char *mus_header_riff_aux_comment(const char *name, mus_long_t *starts, mus_long
i += 4;
while (i < end)
{
+ int len;
for (m = 0; m < 4; m++) sc[j++] = auxcom[k++];
len = mus_char_to_lint((unsigned char *)(auxcom + k));
if ((len <= 0) || (len > end)) break;
@@ -2200,10 +2177,10 @@ static int read_soundforge_header(const char *filename, int fd)
{
/* like RIFF but lowercase and 64-bit vals */
int i, off;
- mus_long_t offset, chunksize, chunkloc;
+ mus_long_t offset, chunkloc;
chunkloc = 12 * 2 + 16;
offset = 0;
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
srate = 0;
chans = 0;
fact_samples = 0;
@@ -2213,6 +2190,7 @@ static int read_soundforge_header(const char *filename, int fd)
update_form_size = mus_char_to_llong((unsigned char *)(hdrbuf + 4 * 2));
while (true)
{
+ int chunksize;
offset += chunkloc;
if (offset >= true_file_length) break;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 64) <= 0) break;
@@ -2226,12 +2204,12 @@ static int read_soundforge_header(const char *filename, int fd)
if (match_four_chars((unsigned char *)hdrbuf, I_fmt_))
{
off = 16;
- original_data_format = mus_char_to_lshort((unsigned char *)(hdrbuf + 8 + off));
+ original_sample_type = mus_char_to_lshort((unsigned char *)(hdrbuf + 8 + off));
chans = mus_char_to_lshort((unsigned char *)(hdrbuf + 10 + off));
srate = mus_char_to_lint((unsigned char *)(hdrbuf + 12 + off));
block_align = mus_char_to_lshort((unsigned char *)(hdrbuf + 20 + off));
bits_per_sample = mus_char_to_lshort((unsigned char *)(hdrbuf + 22 + off));
- data_format = wave_to_sndlib_format(original_data_format, bits_per_sample, true);
+ sample_type = wave_to_sndlib_format(original_sample_type, bits_per_sample, true);
}
else
{
@@ -2262,9 +2240,9 @@ static int read_soundforge_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -2294,14 +2272,14 @@ static int read_rf64_header(const char *filename, int fd)
/* we've checked RF64 xxxx WAVE before getting here */
/* this is very similar (identical) to RIFF for the most part, but I decided it was cleanest to copy the code */
- mus_long_t chunksize, chunkloc;
+ mus_long_t chunkloc;
bool got_fmt = false, got_ds64 = false;
mus_long_t offset;
little_endian = true;
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)(hdrbuf + 8));
chunkloc = 12;
offset = 0;
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
srate = 0;
chans = 0;
fact_samples = 0;
@@ -2315,6 +2293,7 @@ static int read_rf64_header(const char *filename, int fd)
while (true)
{
+ mus_long_t chunksize;
offset += chunkloc;
if (offset >= true_file_length) break;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 64) <= 0) break;
@@ -2340,7 +2319,7 @@ static int read_rf64_header(const char *filename, int fd)
if (match_four_chars((unsigned char *)hdrbuf, I_fmt_))
{
got_fmt = true;
- update_frames_location = 12 + offset;
+ update_framples_location = 12 + offset;
read_riff_fmt_chunk(hdrbuf, true);
}
else
@@ -2388,15 +2367,15 @@ static int read_rf64_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
-static int write_rf64_header(int fd, int wsrate, int wchans, mus_long_t size, int format, const char *comment, int len)
+static int write_rf64_header(int fd, int wsrate, int wchans, mus_long_t size, mus_sample_t samp_type, const char *comment, int len)
{
int extra = 0, err = MUS_NO_ERROR;
data_location = 36 + 36 + 8;
@@ -2421,7 +2400,7 @@ static int write_rf64_header(int fd, int wsrate, int wchans, mus_long_t size, in
mus_lint_to_char((unsigned char *)(hdrbuf + 32), 0); /* "table size" */
header_write(fd, hdrbuf, 36);
- err = write_riff_fmt_chunk(fd, hdrbuf, format, wsrate, wchans);
+ err = write_riff_fmt_chunk(fd, hdrbuf, samp_type, wsrate, wchans);
if (len > 0)
write_riff_clm_comment(fd, comment, len, extra);
@@ -2490,25 +2469,26 @@ static int mus_header_convert_riff_to_rf64(const char *filename, mus_long_t size
static int read_avi_header(const char *filename, int fd)
{
- const unsigned char I_strf[4] = {'s','t','r','f'};
- const unsigned char I_movi[4] = {'m','o','v','i'};
+ static const unsigned char I_strf[4] = {'s','t','r','f'};
+ static const unsigned char I_movi[4] = {'m','o','v','i'};
/* we know we have checked for RIFF xxxx AVI when we arrive here */
- int chunksize, chunkloc, cksize, bits;
+ int chunkloc, cksize, bits;
bool happy = true;
mus_long_t ckoff, cktotal, offset;
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)(hdrbuf + 8));
chunkloc = 12;
offset = 0;
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
srate = 0;
chans = 1;
true_file_length = SEEK_FILE_LENGTH(fd);
while (happy)
{
+ int chunksize;
offset += chunkloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s avi header: chunks confused at " MUS_LD, filename, offset));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s avi header: chunks confused at %lld", filename, offset));
chunksize = mus_char_to_lint((unsigned char *)(hdrbuf + 4));
if ((chunksize == 0) && /* can be empty data chunk? */
(hdrbuf[0] == 0) && (hdrbuf[1] == 0) && (hdrbuf[2] == 0) && (hdrbuf[3] == 0))
@@ -2547,11 +2527,12 @@ static int read_avi_header(const char *filename, int fd)
cktotal += (8 + cksize);
if (match_four_chars((unsigned char *)hdrbuf, I_LIST))
{
- mus_long_t cksizer, ckoffr, cktotalr, rdsize;
+ mus_long_t ckoffr, cktotalr, rdsize;
ckoffr = ckoff + 12;
cktotalr = 12;
while (cktotalr < cksize)
{
+ mus_long_t cksizer;
lseek(fd, ckoffr, SEEK_SET);
header_read(fd, hdrbuf, 8);
cksizer = mus_char_to_lint((unsigned char *)(hdrbuf + 4));
@@ -2563,14 +2544,14 @@ static int read_avi_header(const char *filename, int fd)
rdsize = cksizer;
else rdsize = HDRBUFSIZ;
header_read(fd, hdrbuf, rdsize);
- original_data_format = mus_char_to_lshort((unsigned char *)hdrbuf);
+ original_sample_type = mus_char_to_lshort((unsigned char *)hdrbuf);
chans = mus_char_to_lshort((unsigned char *)(hdrbuf + 2));
srate = mus_char_to_lint((unsigned char *)(hdrbuf + 4));
/* block_align = mus_char_to_lshort((unsigned char *)(hdrbuf + 12)); */
bits = mus_char_to_lshort((unsigned char *)(hdrbuf + 14));
/* only 16 bit linear little endian for now */
- if ((bits == 16) && (original_data_format == 1))
- data_format = MUS_LSHORT;
+ if ((bits == 16) && (original_sample_type == 1))
+ sample_type = MUS_LSHORT;
if (data_location != 0) happy = false;
break;
}
@@ -2585,8 +2566,8 @@ static int read_avi_header(const char *filename, int fd)
if (data_location == 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s: no movi chunk?", filename));
if (data_location > true_file_length)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
- data_size = mus_bytes_to_samples(data_format, true_file_length - data_location);
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -2628,7 +2609,11 @@ static void soundfont_entry(const char *name, int start, int end, int loop_start
}
else
{
- soundfont_size += 8;
+ if (soundfont_size < 123123123)
+ soundfont_size += 8;
+ /* believe it or not, without the 123123123 shuffle, gcc complains at mus_header_read_1 [line 5519!]
+ * that we are making a naughty assumption about overflows.
+ */
soundfont_starts = (int *)realloc(soundfont_starts, soundfont_size * sizeof(int));
soundfont_ends = (int *)realloc(soundfont_ends, soundfont_size * sizeof(int));
soundfont_loop_starts = (int *)realloc(soundfont_loop_starts, soundfont_size * sizeof(int));
@@ -2657,28 +2642,31 @@ int mus_header_sf2_loop_end(int n) {return(soundfont_loop_ends[n]);}
static int read_soundfont_header(const char *filename, int fd)
{
- const unsigned char I_sdta[4] = {'s','d','t','a'};
- const unsigned char I_shdr[4] = {'s','h','d','r'};
- const unsigned char I_pdta[4] = {'p','d','t','a'};
+ static const unsigned char I_sdta[4] = {'s','d','t','a'};
+ static const unsigned char I_shdr[4] = {'s','h','d','r'};
+ static const unsigned char I_pdta[4] = {'p','d','t','a'};
/* we know we have checked for RIFF xxxx sfbk when we arrive here */
- int chunksize, chunkloc, type, cksize, i, this_end, last_end;
+ int chunkloc, type, cksize, i, this_end, last_end;
mus_long_t ckoff, offset;
bool happy = true;
+
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)(hdrbuf + 8));
chunkloc = 12;
offset = 0;
soundfont_entries = 0;
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
srate = 0;
chans = 1;
last_end = 0;
true_file_length = SEEK_FILE_LENGTH(fd);
+
while (happy)
{
+ int chunksize;
offset += chunkloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s soundfont header: chunks confused at " MUS_LD, filename, offset));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s soundfont header: chunks confused at %lld", filename, offset));
chunksize = mus_char_to_lint((unsigned char *)(hdrbuf + 4));
if ((chunksize == 0) && /* can be empty data chunk? */
(hdrbuf[0] == 0) && (hdrbuf[1] == 0) && (hdrbuf[2] == 0) && (hdrbuf[3] == 0))
@@ -2695,8 +2683,8 @@ static int read_soundfont_header(const char *filename, int fd)
lseek(fd, ckoff, SEEK_SET);
while (srate == 0)
{
- ssize_t bytes;
- bytes = read(fd, hdrbuf, 8);
+ long long int bytes;
+ bytes = (long long int)read(fd, hdrbuf, 8);
if (bytes == 0)
{
happy = false;
@@ -2831,7 +2819,7 @@ static int decode_nist_value(char *str, int base, int end)
value[j] = str[i];
value[j] = 0;
if (value[0] =='s') return(MUS_NIST_SHORTPACK);
- sscanf(value, "%d", &i);
+ sscanf(value, "%12d", &i);
/* what is the correct way to use mus_long_ts here for the sample count? */
return(i);
}
@@ -2851,7 +2839,7 @@ static int read_nist_header(const char *filename, int fd)
for (k = 8; k < 16; k++)
str[k - 8] = hdrbuf[k];
- sscanf(str, "%d", &idata_location); /* always "1024" */
+ sscanf(str, "%12d", &idata_location); /* always "1024" */
if (idata_location != 1024)
return(mus_error(MUS_HEADER_READ_FAILED, "%s NIST data location: %d?", filename, idata_location));
@@ -2888,7 +2876,7 @@ static int read_nist_header(const char *filename, int fd)
if (nm >= MAX_FIELD_LENGTH)
{
header_type = MUS_RAW;
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
return(mus_error(MUS_UNSUPPORTED_HEADER_TYPE, "%s nist header: unreadable field (length = %d)?", filename, nm));
}
name[nm] = 0;
@@ -2908,10 +2896,10 @@ static int read_nist_header(const char *filename, int fd)
n++;
if (n >= hend)
{
- ssize_t read_bytes;
+ long long int read_bytes;
curbase += hend;
n = 0;
- read_bytes = read(fd, hdrbuf, HDRBUFSIZ);
+ read_bytes = (long long int)read(fd, hdrbuf, HDRBUFSIZ);
if (read_bytes < HDRBUFSIZ)
return(mus_error(MUS_HEADER_READ_FAILED, "%s NIST header truncated?", filename));
hend = HDRBUFSIZ;
@@ -2921,62 +2909,62 @@ static int read_nist_header(const char *filename, int fd)
data_size = samples * bytes;
if (byte_format == MUS_NIST_SHORTPACK)
{
- data_format = MUS_UNKNOWN;
- original_data_format = MUS_NIST_SHORTPACK;
+ sample_type = MUS_UNKNOWN_SAMPLE;
+ original_sample_type = MUS_NIST_SHORTPACK;
}
else
{
switch (bytes)
{
case 1:
- data_format = MUS_MULAW;
+ sample_type = MUS_MULAW;
break;
case 2:
if (byte_format == 10)
- data_format = MUS_BSHORT;
- else data_format = MUS_LSHORT;
+ sample_type = MUS_BSHORT;
+ else sample_type = MUS_LSHORT;
break;
case 3:
if (byte_format == 10)
- data_format = MUS_B24INT;
- else data_format = MUS_L24INT;
+ sample_type = MUS_B24INT;
+ else sample_type = MUS_L24INT;
break;
case 4:
if (byte_format == 10)
- data_format = MUS_BINT;
- else data_format = MUS_LINT;
+ sample_type = MUS_BINT;
+ else sample_type = MUS_LINT;
break;
default:
- data_format = MUS_BYTE;
+ sample_type = MUS_BYTE;
break;
}
}
true_file_length = SEEK_FILE_LENGTH(fd);
- if ((data_size > true_file_length) && (original_data_format != MUS_NIST_SHORTPACK))
+ if ((data_size > true_file_length) && (original_sample_type != MUS_NIST_SHORTPACK))
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
-static int write_nist_header(int fd, int wsrate, int wchans, mus_long_t size, int format)
+static int write_nist_header(int fd, int wsrate, int wchans, mus_long_t size, mus_sample_t samp_type)
{
char *header;
int datum;
- datum = mus_bytes_per_sample(format);
+ datum = mus_bytes_per_sample(samp_type);
header = (char *)calloc(1024, sizeof(char));
- sprintf(header, "NIST_1A\n 1024\nchannel_count -i %d\nsample_rate -i %d\nsample_n_bytes -i %d\nsample_byte_format -s2 %s\nsample_sig_bits -i %d\nsample_count -i " MUS_LD "\nend_head\n",
+ snprintf(header, 1024, "NIST_1A\n 1024\nchannel_count -i %d\nsample_rate -i %d\nsample_n_bytes -i %d\nsample_byte_format -s2 %s\nsample_sig_bits -i %d\nsample_count -i %lld\nend_head\n",
wchans, wsrate, datum,
- ((format == MUS_BSHORT) || (format == MUS_B24INT) || (format == MUS_BINT)) ? "10" : "01",
+ ((samp_type == MUS_BSHORT) || (samp_type == MUS_B24INT) || (samp_type == MUS_BINT)) ? "10" : "01",
datum * 8,
size / datum);
header_write(fd, (unsigned char *)header, 1024);
@@ -2994,13 +2982,13 @@ static int write_nist_header(int fd, int wsrate, int wchans, mus_long_t size, in
* 28: bicsf magic number (107364 or trouble)
* 32: srate as a 32-bit float
* 36: chans
- * 40: data format indicator (2 = 16-bit linear, 4 = 32-bit float)
+ * 40: sample type indicator (2 = 16-bit linear, 4 = 32-bit float)
* 44: begin chunks, if any
*
* followed by AIFF-style chunked header info with chunks like:
*
* COMM size comment
- * MAXA size {max amps (up to 4)} (frame offsets) time-tag unix msec counter
+ * MAXA size {max amps (up to 4)} (frample offsets) time-tag unix msec counter
* CUE, PRNT, ENV etc
*
* except in Paul Lansky's "hybrid" headers, according to MixViews.
@@ -3018,12 +3006,12 @@ static int read_bicsf_header(const char *filename, int fd)
lseek(fd, 40, SEEK_SET);
header_read(fd, hdrbuf, HDRBUFSIZ);
- original_data_format = mus_char_to_bint((unsigned char *)hdrbuf);
- switch (original_data_format)
+ original_sample_type = mus_char_to_bint((unsigned char *)hdrbuf);
+ switch (original_sample_type)
{
- case 2: data_format = MUS_BSHORT; break;
- case 4: data_format = MUS_BFLOAT; break;
- case 8: data_format = MUS_BDOUBLE; break;
+ case 2: sample_type = MUS_BSHORT; break;
+ case 4: sample_type = MUS_BFLOAT; break;
+ case 8: sample_type = MUS_BDOUBLE; break;
default: break;
}
@@ -3075,7 +3063,7 @@ static int read_bicsf_header(const char *filename, int fd)
* ^ digit gives machine info, according to AFsp sources -- see IRCAM ints above
* 4: srate as a 32-bit float
* 8: chans
- * 12: data format indicator (2 = 16-bit linear, 4 = 32-bit float)
+ * 12: sample type indicator (2 = 16-bit linear, 4 = 32-bit float)
* according to new Sox (version 11), these packing modes are now bytes/sample in low short, code in high
* so 1 = char, 0x10001 = alaw, 0x20001 = mulaw, 2 = short, 3 = 24bit?, 0x40004 = long, 4 = float (AFsp sez 4 can also be double)
* 16: comment start -- how to tell if it's a real comment?
@@ -3091,7 +3079,7 @@ static int read_bicsf_header(const char *filename, int fd)
static int read_ircam_header(const char *filename, int fd)
{
- short bcode, bloc, bsize;
+ short bloc;
int offset;
bool little, happy = true;
@@ -3104,42 +3092,42 @@ static int read_ircam_header(const char *filename, int fd)
data_location = 1024;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - 1024);
- original_data_format = big_or_little_endian_int((unsigned char *)(hdrbuf + 12), little);
- data_format = MUS_UNKNOWN;
+ original_sample_type = big_or_little_endian_int((unsigned char *)(hdrbuf + 12), little);
+ sample_type = MUS_UNKNOWN_SAMPLE;
- if (original_data_format == 2)
+ if (original_sample_type == 2)
{
if (little)
- data_format = MUS_LSHORT;
- else data_format = MUS_BSHORT;
+ sample_type = MUS_LSHORT;
+ else sample_type = MUS_BSHORT;
}
- else if (original_data_format == 4)
+ else if (original_sample_type == 4)
{
if (little)
{
if (mus_char_to_lint((unsigned char *)hdrbuf) == I_IRCAM_VAX)
- data_format = MUS_LFLOAT_UNSCALED; /* Csound and MixViews */
- else data_format = MUS_LFLOAT;
+ sample_type = MUS_LFLOAT_UNSCALED; /* Csound and MixViews */
+ else sample_type = MUS_LFLOAT;
}
- else data_format = MUS_BFLOAT;
+ else sample_type = MUS_BFLOAT;
}
- else if (original_data_format == 0x40004)
+ else if (original_sample_type == 0x40004)
{
- if (little) data_format = MUS_LINT;
- else data_format = MUS_BINT;
+ if (little) sample_type = MUS_LINT;
+ else sample_type = MUS_BINT;
}
- else if (original_data_format == 0x10001) data_format = MUS_ALAW;
- else if (original_data_format == 0x20001) data_format = MUS_MULAW;
- else if (original_data_format == 1) data_format = MUS_BYTE;
- else if (original_data_format == 3)
+ else if (original_sample_type == 0x10001) sample_type = MUS_ALAW;
+ else if (original_sample_type == 0x20001) sample_type = MUS_MULAW;
+ else if (original_sample_type == 1) sample_type = MUS_BYTE;
+ else if (original_sample_type == 3)
{
- if (little) data_format = MUS_L24INT;
- else data_format = MUS_B24INT;
+ if (little) sample_type = MUS_L24INT;
+ else sample_type = MUS_B24INT;
}
- else if (original_data_format == 8)
+ else if (original_sample_type == 8)
{
- if (little) data_format = MUS_LDOUBLE;
- else data_format = MUS_BDOUBLE;
+ if (little) sample_type = MUS_LDOUBLE;
+ else sample_type = MUS_BDOUBLE;
}
srate = (int)big_or_little_endian_float((unsigned char *)(hdrbuf + 4), little);
@@ -3149,6 +3137,7 @@ static int read_ircam_header(const char *filename, int fd)
while (happy)
{
+ short bcode, bsize;
offset += bloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s ircam header: chunks confused at %d", filename, offset));
@@ -3166,14 +3155,14 @@ static int read_ircam_header(const char *filename, int fd)
if ((bsize <= 0) || (bcode <= 0) || ((offset + bloc) > 1023)) happy = false;
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
-static int sndlib_format_to_ircam(int format)
+static int sndlib_format_to_ircam(mus_sample_t samp_type)
{
- switch (format)
+ switch (samp_type)
{
case MUS_MULAW: return(0x20001); break;
case MUS_ALAW: return(0x10001); break;
@@ -3181,7 +3170,7 @@ static int sndlib_format_to_ircam(int format)
case MUS_BINT: return(0x40004); break;
case MUS_BFLOAT: return(4); break;
default:
- return(mus_error(MUS_UNSUPPORTED_DATA_FORMAT, "IRCAM header unsupported data format: %d (%s)", format, any_data_format_name(format)));
+ return(mus_error(MUS_UNSUPPORTED_SAMPLE_TYPE, "IRCAM header unsupported sample type: %d (%s)", samp_type, any_sample_type_name(samp_type)));
break;
}
}
@@ -3205,19 +3194,19 @@ static void write_ircam_comment(int fd, const char *comment, int len)
if (len > 0)
{
unsigned char *combuf;
- combuf = (unsigned char *)calloc(len, sizeof(char));
+ combuf = (unsigned char *)calloc(len, sizeof(unsigned char));
header_write(fd, combuf, len);
free(combuf);
}
}
-static int write_ircam_header(int fd, int wsrate, int wchans, int format, const char *comment, int len)
+static int write_ircam_header(int fd, int wsrate, int wchans, mus_sample_t samp_type, const char *comment, int len)
{
mus_bint_to_char((unsigned char *)hdrbuf, 0x2a364); /* SUN id */
mus_bfloat_to_char((unsigned char *)(hdrbuf + 4), (float)wsrate);
mus_bint_to_char((unsigned char *)(hdrbuf + 8), wchans);
- mus_bint_to_char((unsigned char *)(hdrbuf + 12), sndlib_format_to_ircam(format));
+ mus_bint_to_char((unsigned char *)(hdrbuf + 12), sndlib_format_to_ircam(samp_type));
header_write(fd, hdrbuf, 16);
data_location = 1024;
write_ircam_comment(fd, comment, len);
@@ -3240,16 +3229,16 @@ static int write_ircam_header(int fd, int wsrate, int wchans, int format, const
static int read_8svx_header(const char *filename, int fd, bool bytewise)
{
- const unsigned char I_BODY[4] = {'B','O','D','Y'};
- const unsigned char I_CHAN[4] = {'C','H','A','N'};
- const unsigned char I_VHDR[4] = {'V','H','D','R'};
- int chunksize, offset, chunkloc;
+ static const unsigned char I_BODY[4] = {'B','O','D','Y'};
+ static const unsigned char I_CHAN[4] = {'C','H','A','N'};
+ static const unsigned char I_VHDR[4] = {'V','H','D','R'};
+ int offset, chunkloc;
bool happy = true;
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)hdrbuf);
chunkloc = 12;
offset = 0;
- if (bytewise) data_format = MUS_BYTE; else data_format = MUS_BSHORT;
+ if (bytewise) sample_type = MUS_BYTE; else sample_type = MUS_BSHORT;
srate = 0;
chans = 1;
true_file_length = SEEK_FILE_LENGTH(fd);
@@ -3257,6 +3246,7 @@ static int read_8svx_header(const char *filename, int fd, bool bytewise)
while (happy)
{
+ int chunksize;
offset += chunkloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s 8svx header: chunks confused at %d", filename, offset));
@@ -3283,9 +3273,9 @@ static int read_8svx_header(const char *filename, int fd, bool bytewise)
{
/* num_samples (int) at hdrbuf + 8 */
srate = mus_char_to_ubshort((unsigned char *)(hdrbuf + 20));
- original_data_format = hdrbuf[23];
- if (original_data_format != 0)
- data_format = MUS_UNKNOWN;
+ original_sample_type = hdrbuf[23];
+ if (original_sample_type != 0)
+ sample_type = MUS_UNKNOWN_SAMPLE;
}
else
{
@@ -3316,9 +3306,9 @@ static int read_8svx_header(const char *filename, int fd, bool bytewise)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -3343,22 +3333,23 @@ static int read_8svx_header(const char *filename, int fd, bool bytewise)
static int read_voc_header(const char *filename, int fd)
{
mus_long_t curbase;
- int type, len, voc_extended, bits, code;
+ int voc_extended, bits, code;
bool happy = true;
- data_format = MUS_UBYTE;
+ sample_type = MUS_UBYTE;
chans = 1;
voc_extended = 0;
true_file_length = SEEK_FILE_LENGTH(fd);
curbase = mus_char_to_lshort((unsigned char *)(hdrbuf + 20));
if (true_file_length < curbase)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: block location " MUS_LD " > file length: " MUS_LD, filename, curbase, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: block location %lld > file length: %lld", filename, curbase, true_file_length));
lseek(fd, curbase, SEEK_SET);
header_read(fd, hdrbuf, HDRBUFSIZ);
while (happy)
{
+ int type, len;
type = (int)(hdrbuf[0]);
len = (((int)hdrbuf[3]) << 16) + (((int)hdrbuf[2]) << 8) + (((int)hdrbuf[1]));
if (type == 1) /* voc_data */
@@ -3368,10 +3359,10 @@ static int read_voc_header(const char *filename, int fd)
if (voc_extended == 0)
{
srate = (int)(1000000.0 / (256 - ((int)(hdrbuf[4] & 0xff))));
- original_data_format = hdrbuf[5];
+ original_sample_type = hdrbuf[5];
if (hdrbuf[5] == 0)
- data_format = MUS_UBYTE;
- else data_format = MUS_UNKNOWN;
+ sample_type = MUS_UBYTE;
+ else sample_type = MUS_UNKNOWN_SAMPLE;
}
happy = false;
}
@@ -3387,16 +3378,16 @@ static int read_voc_header(const char *filename, int fd)
{
code = mus_char_to_lshort((unsigned char *)(hdrbuf + 10));
if (code == 6)
- data_format = MUS_ALAW;
+ sample_type = MUS_ALAW;
else
if (code == 7)
- data_format = MUS_MULAW;
- else data_format = MUS_UBYTE;
+ sample_type = MUS_MULAW;
+ else sample_type = MUS_UBYTE;
}
else
if (bits == 16)
- data_format = MUS_LSHORT;
- else data_format = MUS_UNKNOWN;
+ sample_type = MUS_LSHORT;
+ else sample_type = MUS_UNKNOWN_SAMPLE;
chans = (int)hdrbuf[9];
if (chans == 0) chans = 1;
happy = false;
@@ -3414,9 +3405,10 @@ static int read_voc_header(const char *filename, int fd)
{
if (type == 8) /* voc_extended */
{
+ /* should voc_extended be set to 1 here? */
srate = (256000000 / (65536 - mus_char_to_lshort((unsigned char *)(hdrbuf + 4))));
if ((int)(hdrbuf[7]) == 0) chans = 1; else chans = 2;
- if ((int)(hdrbuf[6]) != 0) data_format = MUS_UNKNOWN;
+ if ((int)(hdrbuf[6]) != 0) sample_type = MUS_UNKNOWN_SAMPLE;
}
/* I'd add loop support here if I had any example sound files to test with */
}
@@ -3435,9 +3427,9 @@ static int read_voc_header(const char *filename, int fd)
if ((data_size > true_file_length) || (data_size < (mus_long_t)(true_file_length / 10))) /* some VOC files seem to have completely bogus lengths */
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -3465,17 +3457,17 @@ static int read_voc_header(const char *filename, int fd)
static int read_twinvq_header(const char *filename, int fd)
{
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
data_location = mus_char_to_bint((unsigned char *)(hdrbuf + 12)) + 16 + 8;
chans = 1 + mus_char_to_bint((unsigned char *)(hdrbuf + 24));
srate = mus_char_to_bint((unsigned char *)(hdrbuf + 32));
if (srate == 11) srate = 11025; else
if (srate == 22) srate = 22050; else
if (srate == 44) srate = 44100; else
- srate *= 1000;
+ srate = 48000;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
return(MUS_NO_ERROR);
}
@@ -3489,20 +3481,21 @@ static int read_twinvq_header(const char *filename, int fd)
static int read_sdif_header(const char *filename, int fd)
{
- const unsigned char I_1FQ0[4] = {'1','F','Q','0'};
- const unsigned char I_1STF[4] = {'1','S','T','F'};
- const unsigned char I_1PIC[4] = {'1','P','I','C'};
- const unsigned char I_1TRC[4] = {'1','T','R','C'};
- const unsigned char I_1HRM[4] = {'1','H','R','M'};
- const unsigned char I_1RES[4] = {'1','R','E','S'};
- const unsigned char I_1TDS[4] = {'1','T','D','S'}; /* samples -- all others are useless */
- const char *sdif_names[7] = {"fundamental frequency", "FFT", "spectral peak", "sinusoidal track", "harmonic track", "resonance", "unknown"};
+ static const unsigned char I_1FQ0[4] = {'1','F','Q','0'};
+ static const unsigned char I_1STF[4] = {'1','S','T','F'};
+ static const unsigned char I_1PIC[4] = {'1','P','I','C'};
+ static const unsigned char I_1TRC[4] = {'1','T','R','C'};
+ static const unsigned char I_1HRM[4] = {'1','H','R','M'};
+ static const unsigned char I_1RES[4] = {'1','R','E','S'};
+ static const unsigned char I_1TDS[4] = {'1','T','D','S'}; /* samples -- all others are useless */
+ static const char *sdif_names[7] = {"fundamental frequency", "FFT", "spectral peak", "sinusoidal track", "harmonic track", "resonance", "unknown"};
- int offset, size;
+ int offset;
bool happy = false;
offset = 16;
while (!happy)
{
+ int size;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s, sdif header: chunks confused at %d", filename, offset));
size = mus_char_to_bint((unsigned char *)(hdrbuf + 4)) + 8;
@@ -3530,16 +3523,17 @@ static int read_sdif_header(const char *filename, int fd)
offset += size;
}
- return(MUS_UNSUPPORTED);
+ return(MUS_HEADER_READ_FAILED);
}
+#if G7XX
/* ------------------------------------ NVF ------------------------------------
*/
static int read_nvf_header(const char *filename, int fd)
{
- const unsigned char I_VFMT[4] = {'V','F','M','T'}; /* Nomad II Creative NVF */
+ static const unsigned char I_VFMT[4] = {'V','F','M','T'}; /* Nomad II Creative NVF */
/* info from nvftools by Tom Mander: */
/*
@@ -3561,25 +3555,26 @@ static int read_nvf_header(const char *filename, int fd)
The rest of the data is G.721 data nibble packing big-endian, 4bits per
sample (nibble) single channel at 32kbit. When the Nomad records an NVF
- file it does it in 92 sample (46 byte) frames or 0.0115sec.
+ file it does it in 92 sample (46 byte) framples or 0.0115sec.
*/
if (mus_char_to_lint((unsigned char *)(hdrbuf + 4)) != 1) return(mus_error(MUS_HEADER_READ_FAILED, "%s: NVF[4] != 1", filename));
if (!(match_four_chars((unsigned char *)(hdrbuf + 12), I_VFMT))) return(mus_error(MUS_HEADER_READ_FAILED, "%s: no VFMT chunk", filename));
- data_format = MUS_UNKNOWN; /* g721 --translate elsewhere */
+ sample_type = MUS_UNKNOWN_SAMPLE; /* g721 --translate elsewhere */
chans = 1;
srate = 8000;
data_location = 44;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location) * 2; /* 4 bit samps? */
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
return(MUS_NO_ERROR);
}
+#endif
/* ------------------------------------ ADC ------------------------------------
* also known as OGI format
- * TIMIT format is identical except it omits the data format field (header size claims to be bytes)
+ * TIMIT format is identical except it omits the sample type field (header size claims to be bytes)
*
* from ad.h and other files, ogitools-v1.0.tar.gz
* we'll look for the big/little endian sequence (short) 8 1 1-or-2 given big/little decision
@@ -3589,7 +3584,7 @@ static int read_nvf_header(const char *filename, int fd)
* 4: chans
* 6: rate (srate = 4000000/rate)
* 8: samples (int) -- seems to be off by 2 -- are they counting ints here?
- * 12: data format (0 = big-endian)
+ * 12: sample type (0 = big-endian)
* 16: data start
*/
@@ -3598,7 +3593,7 @@ static int read_adc_header(const char *filename, int fd)
bool little;
little = (mus_char_to_uninterpreted_int((unsigned char *)(hdrbuf + 12)) != 0); /* 0 = big endian */
data_location = 16;
- if (little) data_format = MUS_LSHORT; else data_format = MUS_BSHORT;
+ if (little) sample_type = MUS_LSHORT; else sample_type = MUS_BSHORT;
chans = big_or_little_endian_short((unsigned char *)(hdrbuf + 4), little);
srate = 4000000 / big_or_little_endian_short((unsigned char *)(hdrbuf + 6), little);
data_size = 2 * big_or_little_endian_int((unsigned char *)(hdrbuf + 8), little);
@@ -3608,9 +3603,9 @@ static int read_adc_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -3622,7 +3617,7 @@ static int read_adc_header(const char *filename, int fd)
* 4: sample name (null padded ASCII)
* 12: chans (short) (0 = mono, -1 = stereo)
* 14: sample size (8 or 16 bit) (short) (value is 8, 12, or 16)
- * 16: sample format (signed or unsigned) (short) (0 = unsigned, -1 = signed)
+ * 16: sample type (signed or unsigned) (short) (0 = unsigned, -1 = signed)
* 18: loop (on/off), 20: midi (-1 = no MIDI)
* 22: srate
* avr.txt has:
@@ -3654,18 +3649,18 @@ static int read_avr_header(const char *filename, int fd)
if (dsize == 16)
{
if (dsigned == 0)
- data_format = MUS_UBSHORT;
- else data_format = MUS_BSHORT;
+ sample_type = MUS_UBSHORT;
+ else sample_type = MUS_BSHORT;
}
else
{
if (dsize == 8)
{
if (dsigned == 0)
- data_format = MUS_UBYTE;
- else data_format = MUS_BYTE;
+ sample_type = MUS_UBYTE;
+ else sample_type = MUS_BYTE;
}
- else return(mus_error(MUS_HEADER_READ_FAILED, "%s: unknown data format", filename));
+ else return(mus_error(MUS_HEADER_READ_FAILED, "%s: unknown sample type", filename));
}
if (seek_and_read(fd, (unsigned char *)hdrbuf, 64, 64) <= 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s avr header: ran off end of file", filename));
@@ -3677,9 +3672,9 @@ static int read_avr_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -3714,7 +3709,7 @@ static int read_avr_header(const char *filename, int fd)
static int read_sndt_header(const char *filename, int fd)
{
if (hdrbuf[4] != 'D') return(mus_error(MUS_HEADER_READ_FAILED, "%s: SNDT[4] != 'D'", filename));
- data_format = MUS_UBYTE;
+ sample_type = MUS_UBYTE;
chans = 1;
srate = mus_char_to_ulshort((unsigned char *)(hdrbuf + 20));
data_location = 126;
@@ -3725,7 +3720,7 @@ static int read_sndt_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
return(MUS_NO_ERROR);
}
@@ -3740,13 +3735,13 @@ static int read_sndt_header(const char *filename, int fd)
static int read_covox_header(const char *filename, int fd)
{
- data_format = MUS_UBYTE;
+ sample_type = MUS_UBYTE;
chans = 1;
data_location = 16;
srate = 8000;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
return(MUS_NO_ERROR);
}
@@ -3767,7 +3762,7 @@ static int read_covox_header(const char *filename, int fd)
static int read_smp_header(const char *filename, int fd)
{
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
chans = 1;
comment_start = 22;
comment_end = 81;
@@ -3775,13 +3770,13 @@ static int read_smp_header(const char *filename, int fd)
lseek(fd, 112, SEEK_SET);
if (read(fd, hdrbuf, 4) != 4) return(mus_error(MUS_HEADER_READ_FAILED, "%s: SMP header truncated?", filename));
data_size = (mus_char_to_lint((unsigned char *)hdrbuf));
- data_format = MUS_LSHORT; /* just a guess */
+ sample_type = MUS_LSHORT; /* just a guess */
srate = 8000; /* docs mention an srate floating around at the end of the file, but I can't find it in any example */
true_file_length = SEEK_FILE_LENGTH(fd);
if ((data_size * 2) > true_file_length)
{
data_size = (true_file_length - data_location) / 2;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
return(MUS_NO_ERROR);
}
@@ -3795,7 +3790,7 @@ static int read_smp_header(const char *filename, int fd)
* 0 160 char Text strings (2 * 80)
* 160 80 char Command line
* 240 2 int Domain (1-time, 2-freq, 3-qfreq)
- * 242 2 int Frame size
+ * 242 2 int Frample size
* 244 4 float Sampling frequency
* 252 2 int File identifier (i.e. #o100 #o303)
* 254 2 int Data type (0xfc0e = sampled data file)
@@ -3809,17 +3804,18 @@ static int read_smp_header(const char *filename, int fd)
static int read_sppack_header(const char *filename, int fd)
{
- int typ, bits;
+ int typ;
data_location = 512;
chans = 1;
lseek(fd, 240, SEEK_SET);
if (read(fd, hdrbuf, 22) != 22) return(mus_error(MUS_HEADER_READ_FAILED, "%s SPPACK header truncated?", filename));
typ = mus_char_to_bshort((unsigned char *)hdrbuf);
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
if (typ == 1)
{
if (((hdrbuf[254]) == 252) && ((hdrbuf[255]) == 14)) /* #xfc and #x0e */
{
+ int bits;
float sr;
typ = mus_char_to_bshort((unsigned char *)(hdrbuf + 18));
bits = mus_char_to_bshort((unsigned char *)(hdrbuf + 16));
@@ -3827,22 +3823,22 @@ static int read_sppack_header(const char *filename, int fd)
srate = (int)sr;
switch (typ)
{
- case 1: if (bits == 16) data_format = MUS_BSHORT; else data_format = MUS_BYTE; break;
- case 2: data_format = MUS_ALAW; break;
- case 3: data_format = MUS_MULAW; break;
- default: data_format = MUS_UNKNOWN; break;
+ case 1: if (bits == 16) sample_type = MUS_BSHORT; else sample_type = MUS_BYTE; break;
+ case 2: sample_type = MUS_ALAW; break;
+ case 3: sample_type = MUS_MULAW; break;
+ default: sample_type = MUS_UNKNOWN_SAMPLE; break;
}
data_size = SEEK_FILE_LENGTH(fd);
- data_size = mus_bytes_to_samples(data_format, data_size - 512);
+ data_size = mus_bytes_to_samples(sample_type, data_size - 512);
comment_start = 0;
comment_end = 0;
}
}
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
- if (data_size > mus_bytes_to_samples(data_format, true_file_length))
- data_size = mus_bytes_to_samples(data_format, true_file_length - data_location);
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ if (data_size > mus_bytes_to_samples(sample_type, true_file_length))
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -3875,7 +3871,7 @@ static int read_esps_header(const char *filename, int fd)
bool happy = true;
mus_long_t curbase, hend;
int k, j, n, chars, floats, shorts, doubles;
- ssize_t bytes;
+ long long int bytes;
bool little;
little = (hdrbuf[18] == 0);
if (little)
@@ -3883,7 +3879,7 @@ static int read_esps_header(const char *filename, int fd)
else data_location = mus_char_to_bint((unsigned char *)(hdrbuf + 8));
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = 8000;
chans = 1;
lseek(fd, 132, SEEK_SET);
@@ -3904,28 +3900,28 @@ static int read_esps_header(const char *filename, int fd)
}
if (shorts != 0)
{
- data_format = ((little) ? MUS_LSHORT : MUS_BSHORT);
+ sample_type = ((little) ? MUS_LSHORT : MUS_BSHORT);
chans = shorts;
}
else
{
if (doubles != 0)
{
- data_format = ((little) ? MUS_LDOUBLE_UNSCALED : MUS_BDOUBLE_UNSCALED);
+ sample_type = ((little) ? MUS_LDOUBLE_UNSCALED : MUS_BDOUBLE_UNSCALED);
chans = doubles;
}
else
{
if (floats != 0)
{
- data_format = ((little) ? MUS_LFLOAT_UNSCALED : MUS_BFLOAT_UNSCALED);
+ sample_type = ((little) ? MUS_LFLOAT_UNSCALED : MUS_BFLOAT_UNSCALED);
chans = floats;
}
else
{
if (chars != 0)
{
- data_format = MUS_BYTE; /* ?? */
+ sample_type = MUS_BYTE; /* ?? */
chans = chars;
}
}
@@ -3971,7 +3967,7 @@ static int read_esps_header(const char *filename, int fd)
}
}
if (srate == 0) srate = 8000;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -3996,14 +3992,14 @@ static int read_inrs_header(const char *filename, int fd, int loc)
true_file_length = SEEK_FILE_LENGTH(fd);
comment_start = 6;
comment_end = 25;
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
srate = loc;
chans = 1;
data_location = 512;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
- data_size = mus_bytes_to_samples(data_format, true_file_length - data_location);
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -4030,20 +4026,21 @@ static int read_inrs_header(const char *filename, int fd, int loc)
static int read_maud_header(const char *filename, int fd)
{
- const unsigned char I_MHDR[4] = {'M','H','D','R'};
- const unsigned char I_MDAT[4] = {'M','D','A','T'};
+ static const unsigned char I_MHDR[4] = {'M','H','D','R'};
+ static const unsigned char I_MDAT[4] = {'M','D','A','T'};
- int chunksize, offset, chunkloc;
+ int offset, chunkloc;
bool happy = true;
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)hdrbuf);
chunkloc = 12;
offset = 0;
- data_format = MUS_BYTE;
+ sample_type = MUS_BYTE;
srate = 0;
chans = 1;
update_form_size = mus_char_to_bint((unsigned char *)(hdrbuf + 4));
while (happy)
{
+ int chunksize;
offset += chunkloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s maud header: chunks confused at %d", filename, offset));
@@ -4067,13 +4064,13 @@ static int read_maud_header(const char *filename, int fd)
{
switch (den)
{
- case 0: data_format = MUS_UBYTE; break;
- case 2: data_format = MUS_ALAW; break;
- case 3: data_format = MUS_MULAW; break;
- default: data_format = MUS_UNKNOWN; break;
+ case 0: sample_type = MUS_UBYTE; break;
+ case 2: sample_type = MUS_ALAW; break;
+ case 3: sample_type = MUS_MULAW; break;
+ default: sample_type = MUS_UNKNOWN_SAMPLE; break;
}
}
- else data_format = MUS_BSHORT;
+ else sample_type = MUS_BSHORT;
num = mus_char_to_bshort((unsigned char *)(hdrbuf + 22));
if (num == 0) chans = 1; else chans = 2;
}
@@ -4102,9 +4099,9 @@ static int read_maud_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4128,24 +4125,25 @@ static int read_maud_header(const char *filename, int fd)
static int read_csl_header(const char *filename, int fd)
{
- const unsigned char I_HEDR[4] = {'H','E','D','R'};
- const unsigned char I_HDR8[4] = {'H','D','R','8'};
- const unsigned char I_SDA_[4] = {'S','D','A','_'};
- const unsigned char I_SDAB[4] = {'S','D','A','B'};
- const unsigned char I_SD_B[4] = {'S','D','_','B'};
- const unsigned char I_NOTE[4] = {'N','O','T','E'};
+ static const unsigned char I_HEDR[4] = {'H','E','D','R'};
+ static const unsigned char I_HDR8[4] = {'H','D','R','8'};
+ static const unsigned char I_SDA_[4] = {'S','D','A','_'};
+ static const unsigned char I_SDAB[4] = {'S','D','A','B'};
+ static const unsigned char I_SD_B[4] = {'S','D','_','B'};
+ static const unsigned char I_NOTE[4] = {'N','O','T','E'};
- int chunksize, offset, chunkloc;
+ int offset, chunkloc;
bool happy = true;
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)hdrbuf);
chunkloc = 12;
offset = 0;
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
srate = 0;
chans = 1;
update_form_size = mus_char_to_lint((unsigned char *)(hdrbuf + 8));
while (happy)
{
+ int chunksize;
offset += chunkloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 64) <= 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s csl header: chunks confused at %d", filename, offset));
@@ -4193,9 +4191,9 @@ static int read_csl_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4221,27 +4219,27 @@ static int read_file_samp_header(const char *filename, int fd)
data_location = 1024;
chans = 1;
srate = 8000;
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
lseek(fd, 10, SEEK_SET);
locbuf = (unsigned char *)calloc(1024, sizeof(unsigned char));
header_read(fd, locbuf, 1024);
while (i < 1024)
{
if (strncmp((char *)(locbuf + i), "sftot", 5) == 0)
- sscanf((const char *)(&locbuf[i + 6]), "%d", &srate);
+ sscanf((const char *)(&locbuf[i + 6]), "%12d", &srate);
if (strncmp((char *)(locbuf + i), "nchans", 6) == 0)
- sscanf((const char *)(&locbuf[i + 7]), "%d", &chans);
+ sscanf((const char *)(&locbuf[i + 7]), "%12d", &chans);
if (strncmp((char *)(locbuf + i), "msb", 3) == 0)
if (strncmp((char *)(locbuf + i + 4), "first", 5) == 0)
- data_format = MUS_BSHORT;
+ sample_type = MUS_BSHORT;
while ((i < 1024) && (locbuf[i] != 10) && (locbuf[i] != 0)) i++;
i++;
}
free(locbuf);
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
- data_size = mus_bytes_to_samples(data_format, true_file_length - data_location);
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -4273,12 +4271,12 @@ static int read_sd1_header(const char *filename, int fd)
srate = mus_char_to_bint((unsigned char *)hdrbuf);
n = mus_char_to_bshort((unsigned char *)(hdrbuf + 8));
if (n == 16)
- data_format = MUS_BSHORT;
- else data_format = MUS_BYTE;
+ sample_type = MUS_BSHORT;
+ else sample_type = MUS_BYTE;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
- data_size = mus_bytes_to_samples(data_format, true_file_length - data_location);
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
n = ((unsigned char)hdrbuf[44]);
if (n != 0)
{
@@ -4309,15 +4307,15 @@ static int read_psion_header(const char *filename, int fd)
chans = 1;
data_location = 32;
srate = 8000;
- data_format = MUS_ALAW;
+ sample_type = MUS_ALAW;
data_size = mus_char_to_lint((unsigned char *)(hdrbuf + 18)); /* always little-endian? */
true_file_length = SEEK_FILE_LENGTH(fd);
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4392,23 +4390,23 @@ static int read_gravis_header(const char *filename, int fd)
if (mode & 1)
{
if (mode & 2)
- data_format = MUS_ULSHORT;
- else data_format = MUS_LSHORT;
+ sample_type = MUS_ULSHORT;
+ else sample_type = MUS_LSHORT;
}
else
{
if (mode & 2)
- data_format = MUS_UBYTE;
- else data_format = MUS_BYTE;
+ sample_type = MUS_UBYTE;
+ else sample_type = MUS_BYTE;
}
data_location = 337;
true_file_length = SEEK_FILE_LENGTH(fd);
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4423,11 +4421,11 @@ static int read_goldwave_header(const char *filename, int fd)
{
chans = 1;
data_location = 28;
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
data_size = mus_char_to_lint((unsigned char *)(hdrbuf + 22));
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
if ((data_size <= 24) || (data_size > true_file_length))
data_size = (true_file_length - data_location) / 2;
else data_size /= 2;
@@ -4448,10 +4446,10 @@ static int read_srfs_header(const char *filename, int fd)
data_location = 32;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
data_size = (true_file_length - data_location) / 2;
srate = mus_char_to_lint((unsigned char *)(hdrbuf + 6));
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
return(MUS_NO_ERROR);
}
@@ -4469,9 +4467,9 @@ static int read_qt_header(const char *filename, int fd)
data_location = 12;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = 11025; /* ?? */
- data_format = MUS_UBYTE;
+ sample_type = MUS_UBYTE;
return(MUS_NO_ERROR);
}
@@ -4495,16 +4493,16 @@ static int read_qt_header(const char *filename, int fd)
static int read_sbstudio_header(const char *filename, int fd)
{
- const unsigned char I_SNIN[4] = {'S','N','I','N'};
- const unsigned char I_SNNA[4] = {'S','N','N','A'};
- const unsigned char I_SNDT[4] = {'S','N','D','T'};
+ static const unsigned char I_SNIN[4] = {'S','N','I','N'};
+ static const unsigned char I_SNNA[4] = {'S','N','N','A'};
+ static const unsigned char I_SNDT[4] = {'S','N','D','T'};
int i, tmp;
bool happy = true;
unsigned char *bp;
chans = 1;
srate = 8000; /* no sampling rate field in this header */
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
true_file_length = SEEK_FILE_LENGTH(fd);
i = 8;
bp = (unsigned char *)(hdrbuf + 8);
@@ -4522,12 +4520,12 @@ static int read_sbstudio_header(const char *filename, int fd)
{
tmp = mus_char_to_lshort((unsigned char *)(bp + 15));
if ((tmp & 1) == 0)
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
else
{
if ((tmp & 2) == 0)
- data_format = MUS_BYTE;
- else data_format = MUS_LSHORT;
+ sample_type = MUS_BYTE;
+ else sample_type = MUS_LSHORT;
}
i += 26;
bp += 26;
@@ -4549,20 +4547,20 @@ static int read_sbstudio_header(const char *filename, int fd)
}
if (i >= HDRBUFSIZ)
{
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
happy = false;
}
}
if (data_location == 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s: no SNDT chunk?", filename));
- if ((data_size == 0) || (data_format == MUS_UNKNOWN))
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data size or format bogus", filename));
+ if ((data_size == 0) || (sample_type == MUS_UNKNOWN_SAMPLE))
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data size or sample type bogus", filename));
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4586,10 +4584,10 @@ static int read_delusion_header(const char *filename, int fd)
data_location = 55;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = 8000;
- data_format = MUS_LSHORT;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_LSHORT;
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4616,12 +4614,12 @@ static int read_farandole_header(const char *filename, int fd)
data_location = 51;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = 8000;
if (hdrbuf[49] == 0)
- data_format = MUS_BYTE;
- else data_format = MUS_LSHORT;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_BYTE;
+ else sample_type = MUS_LSHORT;
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4651,7 +4649,7 @@ static int read_tx16w_header(const char *filename, int fd)
data_location = 32;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = 16000;
if (hdrbuf[23] == 1) srate = 33000;
else if (hdrbuf[23] == 2) srate = 50000;
@@ -4662,8 +4660,8 @@ static int read_tx16w_header(const char *filename, int fd)
else if ((hdrbuf[26] & 0xFE) == 0x10) srate = 50000;
else if ((hdrbuf[26] & 0xFE) == 0xf6) srate = 16000;
}
- original_data_format = MUS_UNKNOWN;
- data_format = MUS_UNKNOWN;
+ original_sample_type = MUS_UNKNOWN_SAMPLE;
+ sample_type = MUS_UNKNOWN_SAMPLE;
data_size = (mus_long_t)((double)data_size / 1.5);
if (hdrbuf[22] == 0x49)
{
@@ -4693,10 +4691,10 @@ static int read_sy85_header(const char *filename, int fd)
data_location = 1024;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = 8000; /* unknown */
- data_format = MUS_BSHORT; /* not right */
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_BSHORT; /* not right */
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4713,10 +4711,10 @@ static int read_kurzweil_2000_header(const char *filename, int fd)
data_location = mus_char_to_bint((unsigned char *)(hdrbuf + 4));
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = 44100; /* unknown */
- data_format = MUS_BSHORT;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_BSHORT;
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4732,10 +4730,10 @@ static int read_korg_header(const char *filename, int fd)
data_location = 70;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = mus_char_to_bint((unsigned char *)(hdrbuf + 48));
- data_format = MUS_BSHORT;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_BSHORT;
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4753,12 +4751,12 @@ static int read_maui_header(const char *filename, int fd)
data_location = 776;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
data_size = mus_char_to_lint((unsigned char *)(hdrbuf + 8));
if ((data_size * 2) > true_file_length)
data_size = (true_file_length - data_location) / 2;
srate = mus_char_to_lint((unsigned char *)(hdrbuf));
- data_format = MUS_LSHORT;
+ sample_type = MUS_LSHORT;
return(MUS_NO_ERROR);
}
@@ -4790,14 +4788,14 @@ static int read_maui_header(const char *filename, int fd)
static int read_impulsetracker_header(const char *filename, int fd)
{
if (hdrbuf[18] & 4) chans = 2; else chans = 1;
- if (hdrbuf[18] & 2) data_format = MUS_LSHORT; else data_format = MUS_BYTE;
+ if (hdrbuf[18] & 2) sample_type = MUS_LSHORT; else sample_type = MUS_BYTE;
data_location = mus_char_to_lint((unsigned char *)(hdrbuf + 72));
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
data_size = (true_file_length - data_location);
srate = mus_char_to_lint((unsigned char *)(hdrbuf + 60));
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4810,10 +4808,10 @@ static int read_akai3_header(const char *filename, int fd)
data_location = 192;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
if (hdrbuf[1] == 0) srate = 22050; else srate = 44100;
- data_format = MUS_LSHORT;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_LSHORT;
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
#endif
@@ -4830,10 +4828,10 @@ static int read_akai4_header(const char *filename, int fd)
data_location = 42;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = mus_char_to_ulshort((unsigned char *)(hdrbuf + 40));
- data_format = MUS_LSHORT;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_LSHORT;
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4858,7 +4856,7 @@ static int read_pvf_header(const char *filename, int fd)
if (hdrbuf[4] != '\n') return(mus_error(MUS_HEADER_READ_FAILED, "PVF header messed up"));
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)hdrbuf);
buf = (char *)(hdrbuf + 5);
- sscanf(buf, "%d %d %d", &chans, &srate, &bits);
+ sscanf(buf, "%12d %12d %12d", &chans, &srate, &bits);
if (chans < 1) chans = 1;
if (srate < 0) srate = 8000;
if (bits < 8) bits = 8;
@@ -4872,18 +4870,18 @@ static int read_pvf_header(const char *filename, int fd)
return(mus_error(MUS_HEADER_READ_FAILED, "%s PVF header bad data location", filename));
if (match_four_chars((unsigned char *)hdrbuf, I_PVF2))
{
- data_format = MUS_UNKNOWN; /* ascii text */
- return(mus_error(MUS_HEADER_READ_FAILED, "%s PVF header unknown data format", filename));
+ sample_type = MUS_UNKNOWN_SAMPLE; /* ascii text */
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s PVF header unknown sample type", filename));
}
/* big endian data -- they're using htonl etc */
if (bits == 8)
- data_format = MUS_BYTE;
+ sample_type = MUS_BYTE;
else
if (bits == 16)
- data_format = MUS_BSHORT;
- else data_format = MUS_BINT;
+ sample_type = MUS_BSHORT;
+ else sample_type = MUS_BINT;
true_file_length = SEEK_FILE_LENGTH(fd);
- data_size = mus_bytes_to_samples(data_format, true_file_length - data_location);
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -4907,11 +4905,11 @@ static int read_ultratracker_header(const char *filename, int fd)
data_location = 64;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
data_size = (true_file_length - data_location);
srate = 8000;
- data_format = MUS_LSHORT;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_LSHORT;
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -4927,7 +4925,7 @@ static int read_ultratracker_header(const char *filename, int fd)
* 0: packing (0 = pcm)
* 1: midi channel
* 2 + 256*[3]: sample number
- * 4: sample format (15: 16 bit unsigned(?), 8: 8bit unsigned(?)
+ * 4: sample type (15: 16 bit unsigned(?), 8: 8bit unsigned(?)
* 5: sample rate (big int?)
* 9: sample length
* 13: loop start
@@ -4961,11 +4959,11 @@ static int read_sample_dump_header(const char *filename, int fd)
data_location = i + 3 + len + 23;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
if (hdrbuf[0] == 0)
- data_format = MUS_ULSHORT;
- else data_format = MUS_UNKNOWN;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ sample_type = MUS_ULSHORT;
+ else sample_type = MUS_UNKNOWN_SAMPLE;
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -5002,17 +5000,17 @@ static int read_digiplayer_header(const char *filename, int fd)
data_location = 80;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
srate = 8000;
- data_format = MUS_ULSHORT;
+ sample_type = MUS_ULSHORT;
if (hdrbuf[30] & 2) chans = 2;
if (hdrbuf[30] & 1)
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
else
{
- if (hdrbuf[30] & 4) data_format = MUS_UBYTE; /* may be backwards -- using Convert 1.4 output here */
+ if (hdrbuf[30] & 4) sample_type = MUS_UBYTE; /* may be backwards -- using Convert 1.4 output here */
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -5048,18 +5046,18 @@ static int read_adf_header(const char *filename, int fd)
if ((bits == 16) || (bits == 12))
{
if (numsys == 0)
- data_format = MUS_LSHORT;
- else data_format = MUS_ULSHORT;
+ sample_type = MUS_LSHORT;
+ else sample_type = MUS_ULSHORT;
}
- else data_format = MUS_UNKNOWN;
+ else sample_type = MUS_UNKNOWN_SAMPLE;
srate = (int)(1000 * mus_char_to_lfloat((unsigned char *)(hdrbuf + 22)));
data_size = mus_char_to_lint((unsigned char *)(hdrbuf + 8));
data_location = 512;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
- if (data_size > mus_bytes_to_samples(data_format, true_file_length - data_location))
- data_size = mus_bytes_to_samples(data_format, true_file_length - data_location);
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ if (data_size > mus_bytes_to_samples(sample_type, true_file_length - data_location))
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -5096,23 +5094,23 @@ static int read_diamondware_header(const char *filename, int fd)
chans = hdrbuf[34];
if (hdrbuf[31] == 0)
{
- if (hdrbuf[35] == 8) data_format = MUS_BYTE;
- else data_format = MUS_LSHORT;
+ if (hdrbuf[35] == 8) sample_type = MUS_BYTE;
+ else sample_type = MUS_LSHORT;
}
else
{
- data_format = MUS_UNKNOWN;
- return(mus_error(MUS_HEADER_READ_FAILED, "%s unknown data format", filename));
+ sample_type = MUS_UNKNOWN_SAMPLE;
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s unknown sample type", filename));
}
srate = mus_char_to_ulshort((unsigned char *)(hdrbuf + 32));
data_size = mus_char_to_lint((unsigned char *)(hdrbuf + 38));
data_location = mus_char_to_lint((unsigned char *)(hdrbuf + 46));
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
if (data_size > true_file_length - data_location)
data_size = true_file_length - data_location;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -5134,30 +5132,30 @@ static int read_paf_header(const char *filename, int fd)
{
int form;
bool little = false;
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
if (mus_char_to_bint((unsigned char *)(hdrbuf + 8))) little = true;
if (little)
{
srate = mus_char_to_ulint((unsigned char *)(hdrbuf + 12));
form = mus_char_to_ulint((unsigned char *)(hdrbuf + 16));
- if (form == 0) data_format = MUS_LSHORT;
- if (form == 2) data_format = MUS_BYTE;
+ if (form == 0) sample_type = MUS_LSHORT;
+ if (form == 2) sample_type = MUS_BYTE;
chans = mus_char_to_ulint((unsigned char *)(hdrbuf + 20));
}
else
{
srate = mus_char_to_ubint((unsigned char *)(hdrbuf + 12));
form = mus_char_to_ubint((unsigned char *)(hdrbuf + 16));
- if (form == 0) data_format = MUS_BSHORT;
- if (form == 2) data_format = MUS_BYTE;
+ if (form == 0) sample_type = MUS_BSHORT;
+ if (form == 2) sample_type = MUS_BYTE;
chans = mus_char_to_ubint((unsigned char *)(hdrbuf + 20));
}
data_location = 2048;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location " MUS_LD " > file length: " MUS_LD, filename, data_location, true_file_length));
- if (data_format != MUS_UNKNOWN)
- data_size = mus_bytes_to_samples(data_format, true_file_length - 2048);
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ if (sample_type != MUS_UNKNOWN_SAMPLE)
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - 2048);
return(MUS_NO_ERROR);
}
@@ -5194,6 +5192,7 @@ static int read_comdisco_header(const char *filename, int fd)
char *line = NULL;
int i, j, k, m, n, curend, offset, len, type, d_size = 0;
bool happy = true, little, commenting;
+
k = 15;
line = (char *)calloc(256, sizeof(char));
little = false;
@@ -5261,29 +5260,28 @@ static int read_comdisco_header(const char *filename, int fd)
for (n = 0, m = j + 2; m < len; m++, n++)
value[n] = line[m];
value[n] ='\0';
- if (strcmp(portion, "Sampling") == 0) sscanf(value, "%d", &srate); else
- if (strcmp(portion, "Number o") == 0) sscanf(value, "%d", &d_size); else
+ if (strcmp(portion, "Sampling") == 0) sscanf(value, "%12d", &srate); else
+ if (strcmp(portion, "Number o") == 0) sscanf(value, "%12d", &d_size); else
if (strcmp(portion, "Signal T") == 0) {if (value[1] == 'o') type = 2; else if (value[1] == 'l') type = 1;} else
if (strcmp(portion, "Fixed Po") == 0) {if (value[1] == '8') type = 3;}
}
}
/* now clean up this mess */
- if (data_location == 0)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: no $DATA BINARY field?", filename));
- if (srate == 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: srate == 0", filename));
+ if (data_location == 0) {free(line); return(mus_error(MUS_HEADER_READ_FAILED, "%s: no $DATA BINARY field?", filename));}
+ if (srate == 0) {free(line); return(mus_error(MUS_HEADER_READ_FAILED, "%s: srate == 0", filename));}
chans = 1;
if (d_size != 0) data_size = (mus_long_t)d_size;
switch (type)
{
- case 0: if (little) data_format = MUS_LSHORT; else data_format = MUS_BSHORT; break;
- case 1: if (little) data_format = MUS_LFLOAT; else data_format = MUS_BFLOAT; break;
- case 2: if (little) data_format = MUS_LDOUBLE; else data_format = MUS_BDOUBLE; break;
- case 3: data_format = MUS_BYTE; break;
+ case 0: if (little) sample_type = MUS_LSHORT; else sample_type = MUS_BSHORT; break;
+ case 1: if (little) sample_type = MUS_LFLOAT; else sample_type = MUS_BFLOAT; break;
+ case 2: if (little) sample_type = MUS_LDOUBLE; else sample_type = MUS_BDOUBLE; break;
+ case 3: sample_type = MUS_BYTE; break;
}
true_file_length = SEEK_FILE_LENGTH(fd);
- if (data_size > mus_bytes_to_samples(data_format, true_file_length - data_location))
- data_size = mus_bytes_to_samples(data_format, true_file_length - data_location);
+ if (data_size > mus_bytes_to_samples(sample_type, true_file_length - data_location))
+ data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
free(line);
return(MUS_NO_ERROR);
}
@@ -5300,7 +5298,7 @@ static int read_comdisco_header(const char *filename, int fd)
static int read_asf_header(const char *filename, int fd)
{
- /* a chunked data format, so not really acceptable here or elsewhere -- needs to be unchunked */
+ /* a chunked sample type, so not really acceptable here or elsewhere -- needs to be unchunked */
int len, ilen = 0, i, j, bits = 0;
bool asf_huge = false, present;
/* apparently "huge" has some meaning in Windoze C */
@@ -5328,7 +5326,7 @@ static int read_asf_header(const char *filename, int fd)
srate = mus_char_to_lint((unsigned char *)(hdrbuf + j+11+36));
bits = mus_char_to_lint((unsigned char *)(hdrbuf + j+11+32));
chans = mus_char_to_ulshort((unsigned char *)(hdrbuf + j+65));
- original_data_format = mus_char_to_lint((unsigned char *)(hdrbuf + j+11));
+ original_sample_type = mus_char_to_lint((unsigned char *)(hdrbuf + j+11));
break;
default:
@@ -5341,7 +5339,7 @@ static int read_asf_header(const char *filename, int fd)
}
i = len;
seek_and_read(fd, (unsigned char *)hdrbuf, i, HDRBUFSIZ);
- data_format = MUS_UNKNOWN;
+ sample_type = MUS_UNKNOWN_SAMPLE;
if (((unsigned int)(hdrbuf[1]) == 0x29) && ((unsigned int)(hdrbuf[0]) == 0xd2))
{
int a_huge = 2;
@@ -5349,17 +5347,17 @@ static int read_asf_header(const char *filename, int fd)
if (asf_huge) a_huge = 4;
data_location = i + 20 + a_huge + 2+4+3+1;
if (bits == 0) bits = 8;
- data_format = wave_to_sndlib_format(original_data_format, bits, true);
+ sample_type = wave_to_sndlib_format(original_sample_type, bits, true);
}
- else return(mus_error(MUS_HEADER_READ_FAILED, "%s: unknown data format", filename));
+ else return(mus_error(MUS_HEADER_READ_FAILED, "%s: unknown sample type", filename));
data_size = ilen - data_location;
true_file_length = SEEK_FILE_LENGTH(fd);
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
}
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
@@ -5383,14 +5381,14 @@ static int read_sox_header(const char *filename, int fd)
if (match_four_chars((unsigned char *)(hdrbuf + 0), I_dSoX))
{
- data_format = MUS_LINTN;
+ sample_type = MUS_LINTN;
samps = mus_char_to_llong((unsigned char *)(hdrbuf + 8));
srate = (int)mus_char_to_ldouble((unsigned char *)(hdrbuf + 16));
little_endian = true;
}
else
{ /* untested */
- data_format = MUS_BINTN;
+ sample_type = MUS_BINTN;
samps = mus_char_to_blong((unsigned char *)(hdrbuf + 8));
srate = (int)mus_char_to_bdouble((unsigned char *)(hdrbuf + 16));
little_endian = false;
@@ -5406,8 +5404,8 @@ static int read_sox_header(const char *filename, int fd)
}
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = " MUS_LD "?", filename, data_size));
- data_size = mus_bytes_to_samples(data_format, data_size);
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ data_size = mus_bytes_to_samples(sample_type, data_size);
if (samps < data_size) data_size = samps;
return(MUS_NO_ERROR);
}
@@ -5434,8 +5432,8 @@ static int read_sox_header(const char *filename, int fd)
static int read_matlab_5_header(const char *filename, int fd)
{
- int i, type, chunksize, loc, size;
- bool swapped = false;
+ int i, type, loc, size;
+ /* bool swapped = false; */
comment_start = 0;
comment_end = 124;
@@ -5445,16 +5443,15 @@ static int read_matlab_5_header(const char *filename, int fd)
comment_end = i;
break;
}
-
- if (mus_char_to_lshort((unsigned char *)(hdrbuf + 126)) == 0x494d)
- swapped = true;
+
+ /* if (mus_char_to_lshort((unsigned char *)(hdrbuf + 126)) == 0x494d) swapped = true; */
/* byte swapping not handled yet */
type = mus_char_to_lint((unsigned char *)(hdrbuf + 128));
if (type != 14)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: unknown Matlab data format (%d)", filename, type));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: unknown Matlab sample type (%d)", filename, type));
- chunksize = mus_char_to_lint((unsigned char *)(hdrbuf + 132));
+ /* chunksize = mus_char_to_lint((unsigned char *)(hdrbuf + 132)); */
/* now grovel through the array header */
/* assume the "flags" are not interesting */
@@ -5472,8 +5469,8 @@ static int read_matlab_5_header(const char *filename, int fd)
type = mus_char_to_lint((unsigned char *)(hdrbuf + loc));
if (type == 9)
- data_format = MUS_LDOUBLE;
- else data_format = MUS_LFLOAT;
+ sample_type = MUS_LDOUBLE;
+ else sample_type = MUS_LFLOAT;
data_size = mus_char_to_lint((unsigned char *)(hdrbuf + loc + 4));
chans = 1;
@@ -5488,36 +5485,36 @@ static int read_matlab_5_header(const char *filename, int fd)
/* ------------------------------------ no header ------------------------------------- */
-static int header_raw_srate = 44100;
-static int header_raw_chans = 2;
-static int header_raw_format = MUS_BSHORT;
+static int raw_header_srate = 44100;
+static int raw_header_chans = 2;
+static mus_sample_t raw_header_sample_type = MUS_BSHORT;
static int read_no_header(int fd)
{
- srate = header_raw_srate;
- chans = header_raw_chans;
- data_format = header_raw_format;
+ srate = raw_header_srate;
+ chans = raw_header_chans;
+ sample_type = raw_header_sample_type;
data_location = 0;
data_size = SEEK_FILE_LENGTH(fd);
true_file_length = data_size;
- data_size = mus_bytes_to_samples(data_format, data_size);
+ data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
}
-void mus_header_set_raw_defaults(int sr, int chn, int frm)
+void mus_header_set_raw_defaults(int sr, int chn, mus_sample_t samp_type)
{
- if (sr > 0) header_raw_srate = sr;
- if (chn > 0) header_raw_chans = chn;
- if (mus_data_format_p(frm)) header_raw_format = frm;
+ if (sr > 0) raw_header_srate = sr;
+ if (chn > 0) raw_header_chans = chn;
+ if (mus_is_sample_type(samp_type)) raw_header_sample_type = samp_type;
}
-void mus_header_raw_defaults(int *sr, int *chn, int *frm)
+void mus_header_raw_defaults(int *sr, int *chn, mus_sample_t *samp_type)
{
- (*sr) = header_raw_srate;
- (*chn) = header_raw_chans;
- (*frm) = header_raw_format;
+ (*sr) = raw_header_srate;
+ (*chn) = raw_header_chans;
+ (*samp_type) = raw_header_sample_type;
}
@@ -5526,46 +5523,46 @@ void mus_header_raw_defaults(int *sr, int *chn, int *frm)
static int mus_header_read_1(const char *filename, int fd)
{
- const unsigned char I_HCOM[4] = {'H','C','O','M'};
- const unsigned char I_FSSD[4] = {'F','S','S','D'};
- const unsigned char I_8SVX[4] = {'8','S','V','X'};
- const unsigned char I_16SV[4] = {'1','6','S','V'};
- const unsigned char I_VOC1[4] = {'t','i','v','e'};
- const unsigned char I_Soun[4] = {'S','o','u','n'};
- const unsigned char I_MAUD[4] = {'M','A','U','D'};
- const unsigned char I_mdat[4] = {'m','d','a','t'}; /* quicktime */
- const unsigned char I_sfbk[4] = {'s','f','b','k'}; /* SoundFont 2.0 */
- const unsigned char I_ATCH[4] = {'A','T','C','H'};
- const unsigned char I_NAL_[4] = {'N','A','L','_'};
- const unsigned char I__WAV[4] = {' ','S','A','M'};
- const unsigned char I_ondW[4] = {'o','n','d','W'};
- const unsigned char I_SDXc[4] = {'S','D','X',':'}; /* Sample dump exchange format */
- const unsigned char I_AVI_[4] = {'A','V','I',' '}; /* RIFF AVI */
- const unsigned char I_ones[4] = {(unsigned char)'\377',(unsigned char)'\377',(unsigned char)'\377',(unsigned char)'\377'};
- const unsigned char I_zeros[4] = {'\0','\0','\0','\0'};
- const unsigned char I_asf0[4] = {(unsigned char)'\321','\051',(unsigned char)'\342',(unsigned char)'\326'};
- const unsigned char I_asf1[4] = {(unsigned char)'\332','\065',(unsigned char)'\321','\021'};
- const unsigned char I_asf2[4] = {(unsigned char)'\220','\064','\000',(unsigned char)'\240'};
- const unsigned char I_asf3[4] = {(unsigned char)'\311','\003','\111',(unsigned char)'\276'};
- const unsigned char I_DS16[4] = {'D','S','1','6'}; /* CSL */
- const unsigned char I__sam[4] = {'=','s','a','m'};
- const unsigned char I_OggS[4] = {'O','g','g','S'}; /* Ogg-related files, apparently -- ogg123 has "vorbis" instead of "Speex" */
- const unsigned char I_fLaC[4] = {'f','L','a','C'}; /* FLAC */
- const unsigned char I_TTA1[4] = {'T','T','A','1'}; /* ttaenc */
- const unsigned char I_wvpk[4] = {'w','v','p','k'}; /* wavpack */
- const unsigned char I_MATL[4] = {'M','A','T','L'}; /* matlab 5.0 */
- const unsigned char I_AB_5[4] = {'A','B',' ','5'};
+ static const unsigned char I_HCOM[4] = {'H','C','O','M'};
+ static const unsigned char I_FSSD[4] = {'F','S','S','D'};
+ static const unsigned char I_8SVX[4] = {'8','S','V','X'};
+ static const unsigned char I_16SV[4] = {'1','6','S','V'};
+ static const unsigned char I_VOC1[4] = {'t','i','v','e'};
+ static const unsigned char I_Soun[4] = {'S','o','u','n'};
+ static const unsigned char I_MAUD[4] = {'M','A','U','D'};
+ static const unsigned char I_mdat[4] = {'m','d','a','t'}; /* quicktime */
+ static const unsigned char I_sfbk[4] = {'s','f','b','k'}; /* SoundFont 2.0 */
+ static const unsigned char I_ATCH[4] = {'A','T','C','H'};
+ static const unsigned char I_NAL_[4] = {'N','A','L','_'};
+ static const unsigned char I__WAV[4] = {' ','S','A','M'};
+ static const unsigned char I_ondW[4] = {'o','n','d','W'};
+ static const unsigned char I_SDXc[4] = {'S','D','X',':'}; /* Sample dump exchange format */
+ static const unsigned char I_AVI_[4] = {'A','V','I',' '}; /* RIFF AVI */
+ static const unsigned char I_ones[4] = {(unsigned char)'\377',(unsigned char)'\377',(unsigned char)'\377',(unsigned char)'\377'};
+ static const unsigned char I_zeros[4] = {'\0','\0','\0','\0'};
+ static const unsigned char I_asf0[4] = {(unsigned char)'\321','\051',(unsigned char)'\342',(unsigned char)'\326'};
+ static const unsigned char I_asf1[4] = {(unsigned char)'\332','\065',(unsigned char)'\321','\021'};
+ static const unsigned char I_asf2[4] = {(unsigned char)'\220','\064','\000',(unsigned char)'\240'};
+ static const unsigned char I_asf3[4] = {(unsigned char)'\311','\003','\111',(unsigned char)'\276'};
+ static const unsigned char I_DS16[4] = {'D','S','1','6'}; /* CSL */
+ static const unsigned char I__sam[4] = {'=','s','a','m'};
+ static const unsigned char I_OggS[4] = {'O','g','g','S'}; /* Ogg-related files, apparently -- ogg123 has "vorbis" instead of "Speex" */
+ static const unsigned char I_fLaC[4] = {'f','L','a','C'}; /* FLAC */
+ static const unsigned char I_TTA1[4] = {'T','T','A','1'}; /* ttaenc */
+ static const unsigned char I_wvpk[4] = {'w','v','p','k'}; /* wavpack */
+ static const unsigned char I_MATL[4] = {'M','A','T','L'}; /* matlab 5.0 */
+ static const unsigned char I_AB_5[4] = {'A','B',' ','5'};
#define NINRS 7
- const unsigned int I_INRS[NINRS] = {0xcb460020, 0xd0465555, 0xfa460000, 0x1c470040, 0x3b470080, 0x7a470000, 0x9c470040};
- int inrs_srates[NINRS] = {6500, 6667, 8000, 10000, 12000, 16000, 20000};
+ static const unsigned int I_INRS[NINRS] = {0xcb460020, 0xd0465555, 0xfa460000, 0x1c470040, 0x3b470080, 0x7a470000, 0x9c470040};
+ static int inrs_srates[NINRS] = {6500, 6667, 8000, 10000, 12000, 16000, 20000};
/* returns 0 on success (at least to the extent that we can report the header type), -1 for error */
int i, loc = 0;
- ssize_t bytes;
+ long long int bytes;
- header_type = MUS_UNSUPPORTED;
- data_format = MUS_UNKNOWN;
+ header_type = MUS_UNKNOWN_HEADER;
+ sample_type = MUS_UNKNOWN_SAMPLE;
comment_start = 0;
comment_end = 0;
data_size = 0;
@@ -5577,7 +5574,7 @@ static int mus_header_read_1(const char *filename, int fd)
loop_modes[1] = 0;
}
- bytes = read(fd, hdrbuf, INITIAL_READ_SIZE);
+ bytes = (long long int)read(fd, hdrbuf, INITIAL_READ_SIZE);
/* if it's a 0 length file we need to get out */
if (bytes < 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s: %s", filename, (errno) ? STRERROR(errno) : "bytes read < 0?"));
@@ -5585,9 +5582,9 @@ static int mus_header_read_1(const char *filename, int fd)
if (bytes == 0)
{
header_type = MUS_RAW;
- srate = header_raw_srate;
- chans = header_raw_chans;
- data_format = header_raw_format;
+ srate = raw_header_srate;
+ chans = raw_header_chans;
+ sample_type = raw_header_sample_type;
data_location = 0;
true_file_length = 0;
return(MUS_NO_ERROR);
@@ -5603,7 +5600,7 @@ static int mus_header_read_1(const char *filename, int fd)
(match_four_chars((unsigned char *)hdrbuf, I_DECN)))
{
if (bytes < 24)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s NeXT header truncated? found only " SSIZE_TD " bytes", filename, bytes));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s NeXT header truncated? found only %lld bytes", filename, bytes));
header_type = MUS_NEXT;
return(read_next_header(filename, fd));
}
@@ -5612,7 +5609,7 @@ static int mus_header_read_1(const char *filename, int fd)
{
/* next 4 bytes are apparently the file size or something equally useless */
if (bytes < 12)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s AIFF header truncated? found only " SSIZE_TD " bytes", filename, bytes));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s AIFF header truncated? found only %lld bytes", filename, bytes));
if (match_four_chars((unsigned char *)(hdrbuf + 8), I_AIFF))
{
@@ -5658,7 +5655,7 @@ static int mus_header_read_1(const char *filename, int fd)
(match_four_chars((unsigned char *)hdrbuf, I_RIFX)))
{
if (bytes < 12)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s RIFF header truncated? found only " SSIZE_TD " bytes", filename, bytes));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s RIFF header truncated? found only %lld bytes", filename, bytes));
if (match_four_chars((unsigned char *)(hdrbuf + 8), I_WAVE))
{
@@ -5685,7 +5682,7 @@ static int mus_header_read_1(const char *filename, int fd)
{
header_type = MUS_RF64;
if (bytes < 28)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s RF64 header truncated? found only " SSIZE_TD " bytes", filename, bytes));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s RF64 header truncated? found only %lld bytes", filename, bytes));
if ((mus_char_to_lint((unsigned char *)(hdrbuf + 4)) != -1) ||
(!(match_four_chars((unsigned char *)(hdrbuf + 8), I_WAVE))))
return(mus_error(MUS_HEADER_READ_FAILED, "%s: messed up RF64 header", filename));
@@ -5698,7 +5695,7 @@ static int mus_header_read_1(const char *filename, int fd)
(equal_big_or_little_endian((unsigned char *)hdrbuf, I_IRCAM_NEXT)))
{
if (bytes < 24)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s IRCAM header truncated? found only " SSIZE_TD " bytes", filename, bytes));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s IRCAM header truncated? found only %lld bytes", filename, bytes));
header_type = MUS_IRCAM;
return(read_ircam_header(filename, fd));
}
@@ -5712,7 +5709,7 @@ static int mus_header_read_1(const char *filename, int fd)
if (match_four_chars((unsigned char *)hdrbuf, I_caff))
{
if (bytes < 32) /* INITIAL_READ_SIZE */
- return(mus_error(MUS_HEADER_READ_FAILED, "%s CAFF header truncated? found only " SSIZE_TD " bytes", filename, bytes));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s CAFF header truncated? found only %lld bytes", filename, bytes));
header_type = MUS_CAFF;
return(read_caff_header(fd));
}
@@ -5721,15 +5718,15 @@ static int mus_header_read_1(const char *filename, int fd)
(match_four_chars((unsigned char *)(hdrbuf + 4), I_AB_5)))
{
if (bytes < 128) /* INITIAL_READ_SIZE=256 */
- return(mus_error(MUS_HEADER_READ_FAILED, "%s Matlab header truncated? found only " SSIZE_TD " bytes", filename, bytes));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s Matlab header truncated? found only %lld bytes", filename, bytes));
header_type = MUS_MATLAB;
return(read_matlab_5_header(filename, fd));
}
if (match_four_chars((unsigned char *)hdrbuf, I_SOUN))
{
- const unsigned char I_D_SA[4] = {'D',' ','S','A'};
- const unsigned char I_MPLE[4] = {'M','P','L','E'};
+ static const unsigned char I_D_SA[4] = {'D',' ','S','A'};
+ static const unsigned char I_MPLE[4] = {'M','P','L','E'};
if ((match_four_chars((unsigned char *)(hdrbuf + 4), I_D_SA)) &&
(match_four_chars((unsigned char *)(hdrbuf + 8), I_MPLE)))
{
@@ -5754,7 +5751,7 @@ static int mus_header_read_1(const char *filename, int fd)
(match_four_chars((unsigned char *)(hdrbuf + 4), I_VOC1)))
{
if (bytes < 24)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s VOC header truncated? found only " SSIZE_TD " bytes", filename, bytes));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s VOC header truncated? found only %lld bytes", filename, bytes));
header_type = MUS_VOC;
return(read_voc_header(filename, fd));
}
@@ -6000,11 +5997,13 @@ static int mus_header_read_1(const char *filename, int fd)
return(read_sdif_header(filename, fd));
}
+#if G7XX
if (match_four_chars((unsigned char *)hdrbuf, I_NVF_))
{
header_type = MUS_NVF;
return(read_nvf_header(filename, fd));
}
+#endif
if (match_four_chars((unsigned char *)hdrbuf, I_TWIN))
{
@@ -6093,6 +6092,20 @@ static int mus_header_read_1(const char *filename, int fd)
}
/* SMS files start with 767 (4-byte int, apparently in native order) */
+
+ /* try to catch mpeg... */
+ {
+ int len;
+ len = strlen(filename);
+ if (len > 4)
+ {
+ if (strcmp((const char *)(filename + len - 4), ".mp3") == 0)
+ {
+ header_type = MUS_MPEG;
+ return(MUS_NO_ERROR);
+ }
+ }
+ }
header_type = MUS_RAW;
return(read_no_header(fd));
@@ -6141,7 +6154,8 @@ mus_header_write_hook_t *mus_header_write_set_hook(mus_header_write_hook_t *new_
}
-int mus_header_write(const char *name, int type, int in_srate, int in_chans, mus_long_t loc, mus_long_t size_in_samples, int format, const char *comment, int len)
+int mus_header_write(const char *name, mus_header_t type, int in_srate, int in_chans, mus_long_t loc,
+ mus_long_t size_in_samples, mus_sample_t samp_type, const char *comment, int len)
{
/* the "loc" arg is a mistake -- just always set it to 0 */
@@ -6155,7 +6169,7 @@ int mus_header_write(const char *name, int type, int in_srate, int in_chans, mus
if (mus_header_write_hook)
(*mus_header_write_hook)(name);
- siz = mus_samples_to_bytes(format, size_in_samples);
+ siz = mus_samples_to_bytes(samp_type, size_in_samples);
switch (type)
{
case MUS_RAW: case MUS_IRCAM: case MUS_NEXT: case MUS_RIFF: case MUS_RF64: case MUS_CAFF:
@@ -6172,34 +6186,34 @@ int mus_header_write(const char *name, int type, int in_srate, int in_chans, mus
switch (type)
{
- case MUS_NEXT: err = mus_header_write_next_header(fd, in_srate, in_chans, loc, siz, format, comment, len); break;
- case MUS_AIFC: err = write_aif_header(fd, in_srate, in_chans, siz, format, comment, len, true); break;
- case MUS_AIFF: err = write_aif_header(fd, in_srate, in_chans, siz, format, comment, len, false); break;
- case MUS_RF64: err = write_rf64_header(fd, in_srate, in_chans, siz, format, comment, len); break;
- case MUS_CAFF: err = write_caff_header(fd, in_srate, in_chans, siz, format); break;
- case MUS_IRCAM: err = write_ircam_header(fd, in_srate, in_chans, format, comment, len); break;
- case MUS_NIST: err = write_nist_header(fd, in_srate, in_chans, siz, format); break;
+ case MUS_NEXT: err = mus_header_write_next_header(fd, in_srate, in_chans, loc, siz, samp_type, comment, len); break;
+ case MUS_AIFC: err = write_aif_header(fd, in_srate, in_chans, siz, samp_type, comment, len, true); break;
+ case MUS_AIFF: err = write_aif_header(fd, in_srate, in_chans, siz, samp_type, comment, len, false); break;
+ case MUS_RF64: err = write_rf64_header(fd, in_srate, in_chans, siz, samp_type, comment, len); break;
+ case MUS_CAFF: err = write_caff_header(fd, in_srate, in_chans, siz, samp_type); break;
+ case MUS_IRCAM: err = write_ircam_header(fd, in_srate, in_chans, samp_type, comment, len); break;
+ case MUS_NIST: err = write_nist_header(fd, in_srate, in_chans, siz, samp_type); break;
case MUS_RIFF:
- err = write_riff_header(fd, in_srate, in_chans, siz, format, comment, len);
+ err = write_riff_header(fd, in_srate, in_chans, siz, samp_type, comment, len);
if (err != MUS_NO_ERROR)
{
CLOSE(fd, name);
- return(mus_error(err, "can't write %s header for %s (fd: %d, format: %s, srate: %d, chans: %d)",
+ return(mus_error(err, "can't write %s header for %s (fd: %d, sample type: %s, srate: %d, chans: %d)",
mus_header_type_name(type),
name, fd,
- mus_data_format_short_name(format),
+ mus_sample_type_short_name(samp_type),
in_srate, in_chans));
}
break;
case MUS_RAW:
data_location = 0;
- data_size = mus_bytes_to_samples(format, siz);
+ data_size = mus_bytes_to_samples(samp_type, siz);
srate = in_srate;
chans = in_chans;
header_type = MUS_RAW;
- data_format = format;
+ sample_type = samp_type;
break;
default:
@@ -6213,16 +6227,16 @@ int mus_header_write(const char *name, int type, int in_srate, int in_chans, mus
}
-int mus_write_header(const char *name, int type, int in_srate, int in_chans, mus_long_t size_in_samples, int format, const char *comment)
+int mus_write_header(const char *name, mus_header_t type, int in_srate, int in_chans, mus_long_t size_in_samples, mus_sample_t samp_type, const char *comment)
{
int len = 0;
if (comment)
len = strlen(comment);
- return(mus_header_write(name, type, in_srate, in_chans, 0, size_in_samples, format, comment, len));
+ return(mus_header_write(name, type, in_srate, in_chans, 0, size_in_samples, samp_type, comment, len));
}
-int mus_header_change_data_size(const char *filename, int type, mus_long_t size) /* in bytes */
+int mus_header_change_data_size(const char *filename, mus_header_t type, mus_long_t size) /* in bytes */
{
/* the read header at sample update (sound-close) time could be avoided if the
* ssnd_location (etc) were saved and passed in -- perhaps an added optimized
@@ -6251,7 +6265,7 @@ int mus_header_change_data_size(const char *filename, int type, mus_long_t size)
if (size < 0)
{
CLOSE(fd, filename);
- return(mus_error(MUS_BAD_SIZE, "%s: change size to " MUS_LD "?", filename, size));
+ return(mus_error(MUS_BAD_SIZE, "%s: change size to %lld?", filename, size));
}
switch (type)
@@ -6271,24 +6285,24 @@ int mus_header_change_data_size(const char *filename, int type, mus_long_t size)
case MUS_AIFF:
/* we apparently have to make sure the form size and the data size are correct
* assumed here that we'll only be updating our own AIFF files
- * There are 3 such locations -- the 2nd word of the file which is the overall form size,
- * the frames variable in the COMM chunk, and the chunk-size variable in the SSND chunk
+ * There are 3 such locations -- the second word of the file which is the overall form size,
+ * the framples variable in the COMM chunk, and the chunk-size variable in the SSND chunk
* an unexpected hassle for CLM is that we can open/close the output file many times if running mix,
* so we have to update the various size fields taking into account the old size
*/
- /* read sets current update_form_size, data_size, data_format, update_frames_location, update_ssnd_location */
+ /* read sets current update_form_size, data_size, sample_type, update_framples_location, update_ssnd_location */
if (size > BIGGEST_4_BYTE_SIGNED_INT)
{
err = MUS_BAD_SIZE;
- mus_print("%s size: " MUS_LD " is too large for %s headers", filename, size, mus_header_type_name(type));
+ mus_print("%s size: %lld is too large for %s headers", filename, size, mus_header_type_name(type));
size = BIGGEST_4_BYTE_SIGNED_INT;
}
lseek(fd, 4L, SEEK_SET);
- mus_bint_to_char((unsigned char *)hdrbuf, (int)size + update_form_size - mus_samples_to_bytes(data_format, data_size));
+ mus_bint_to_char((unsigned char *)hdrbuf, (int)size + update_form_size - mus_samples_to_bytes(sample_type, data_size));
/* cancel old data_size from previous possible write */
header_write(fd, hdrbuf, 4);
- lseek(fd, update_frames_location, SEEK_SET);
- mus_bint_to_char((unsigned char *)hdrbuf, (int)size / (chans * mus_bytes_per_sample(data_format)));
+ lseek(fd, update_framples_location, SEEK_SET);
+ mus_bint_to_char((unsigned char *)hdrbuf, (int)size / (chans * mus_bytes_per_sample(sample_type)));
header_write(fd, hdrbuf, 4);
lseek(fd, update_ssnd_location, SEEK_SET);
mus_bint_to_char((unsigned char *)hdrbuf, (int)size + 8);
@@ -6296,14 +6310,14 @@ int mus_header_change_data_size(const char *filename, int type, mus_long_t size)
break;
case MUS_RIFF:
- /* read sets current update_form_size, data_format, data_size, update_ssnd_location */
+ /* read sets current update_form_size, sample_type, data_size, update_ssnd_location */
if (size > BIGGEST_4_BYTE_SIGNED_INT)
{
CLOSE(fd, filename);
return(mus_header_convert_riff_to_rf64(filename, size));
}
lseek(fd, 4L, SEEK_SET);
- mus_lint_to_char((unsigned char *)hdrbuf, (int)size + update_form_size - mus_samples_to_bytes(data_format, data_size));
+ mus_lint_to_char((unsigned char *)hdrbuf, (int)size + update_form_size - mus_samples_to_bytes(sample_type, data_size));
header_write(fd, hdrbuf, 4);
lseek(fd, update_ssnd_location, SEEK_SET);
mus_lint_to_char((unsigned char *)hdrbuf, (int)size);
@@ -6311,7 +6325,7 @@ int mus_header_change_data_size(const char *filename, int type, mus_long_t size)
break;
case MUS_RF64:
- /* read sets current update_form_size, data_format, data_size, update_ssnd_location, update_rf64_location */
+ /* read sets current update_form_size, sample_type, data_size, update_ssnd_location, update_rf64_location */
/* assume here that this really is an rf64 file (i.e. -1 for form size and data chunk size */
lseek(fd, update_rf64_location, SEEK_SET);
mus_llong_to_char((unsigned char *)hdrbuf, data_location + size - 8); /* 25-June-07 */
@@ -6326,20 +6340,20 @@ int mus_header_change_data_size(const char *filename, int type, mus_long_t size)
break;
case MUS_NIST:
- /* read sets current srate, chans, data_format */
+ /* read sets current srate, chans, sample_type */
if (size > BIGGEST_4_BYTE_SIGNED_INT)
{
err = MUS_BAD_SIZE;
- mus_print("%s size: " MUS_LD " is too large for %s headers", filename, size, mus_header_type_name(type));
+ mus_print("%s size: %lld is too large for %s headers", filename, size, mus_header_type_name(type));
size = BIGGEST_4_BYTE_SIGNED_INT;
}
lseek(fd, 0L, SEEK_SET);
- write_nist_header(fd, mus_header_srate(), mus_header_chans(), size, mus_header_format());
+ write_nist_header(fd, mus_header_srate(), mus_header_chans(), size, mus_header_sample_type());
break;
case MUS_CAFF:
- if (update_frames_location < 56) update_frames_location = 56;
- lseek(fd, update_frames_location, SEEK_SET);
+ if (update_framples_location < 56) update_framples_location = 56;
+ lseek(fd, update_framples_location, SEEK_SET);
mus_blong_to_char((unsigned char *)(hdrbuf + 0), size);
header_write(fd, hdrbuf, 8);
break;
@@ -6355,10 +6369,10 @@ int mus_header_change_data_size(const char *filename, int type, mus_long_t size)
}
-int mus_header_change_chans(const char *filename, int type, int new_chans)
+int mus_header_change_chans(const char *filename, mus_header_t type, int new_chans)
{
int err = MUS_NO_ERROR, fd;
- mus_long_t new_frames;
+ mus_long_t new_framples;
switch (type)
{
case MUS_AIFF:
@@ -6393,21 +6407,21 @@ int mus_header_change_chans(const char *filename, int type, int new_chans)
case MUS_NIST:
lseek(fd, 0L, SEEK_SET);
- write_nist_header(fd, srate, new_chans, mus_bytes_per_sample(data_format) * data_size, data_format);
+ write_nist_header(fd, srate, new_chans, mus_bytes_per_sample(sample_type) * data_size, sample_type);
/* header size is always 1024, so this is safe */
break;
case MUS_AIFF: case MUS_AIFC:
- lseek(fd, update_frames_location - 2, SEEK_SET);
- new_frames = data_size / new_chans;
+ lseek(fd, update_framples_location - 2, SEEK_SET);
+ new_framples = data_size / new_chans;
mus_bshort_to_char((unsigned char *)hdrbuf, new_chans);
- mus_bint_to_char((unsigned char *)(hdrbuf + 2), new_frames);
+ mus_bint_to_char((unsigned char *)(hdrbuf + 2), new_framples);
header_write(fd, hdrbuf, 6);
break;
case MUS_RIFF:
case MUS_RF64:
- lseek(fd, update_frames_location - 2, SEEK_SET);
+ lseek(fd, update_framples_location - 2, SEEK_SET);
if (little_endian)
mus_lshort_to_char((unsigned char *)hdrbuf, new_chans);
else mus_bshort_to_char((unsigned char *)hdrbuf, new_chans);
@@ -6420,13 +6434,15 @@ int mus_header_change_chans(const char *filename, int type, int new_chans)
header_write(fd, hdrbuf, 4);
/* we should probably also change bytes_per_packet at 36, but... */
break;
+
+ default: break;
}
CLOSE(fd, filename);
return(err);
}
-int mus_header_change_srate(const char *filename, int type, int new_srate)
+int mus_header_change_srate(const char *filename, mus_header_t type, int new_srate)
{
int err = MUS_NO_ERROR, fd;
switch (type)
@@ -6463,19 +6479,19 @@ int mus_header_change_srate(const char *filename, int type, int new_srate)
case MUS_NIST:
lseek(fd, 0L, SEEK_SET);
- write_nist_header(fd, new_srate, chans, mus_bytes_per_sample(data_format) * data_size, data_format);
+ write_nist_header(fd, new_srate, chans, mus_bytes_per_sample(sample_type) * data_size, sample_type);
break;
case MUS_AIFF:
case MUS_AIFC:
- lseek(fd, update_frames_location + 6, SEEK_SET);
+ lseek(fd, update_framples_location + 6, SEEK_SET);
double_to_ieee_80((double)new_srate, (unsigned char *)hdrbuf);
header_write(fd, hdrbuf, 10);
break;
case MUS_RIFF:
case MUS_RF64:
- lseek(fd, update_frames_location, SEEK_SET);
+ lseek(fd, update_framples_location, SEEK_SET);
if (little_endian)
mus_lint_to_char((unsigned char *)hdrbuf, new_srate);
else mus_bint_to_char((unsigned char *)hdrbuf, new_srate);
@@ -6487,13 +6503,15 @@ int mus_header_change_srate(const char *filename, int type, int new_srate)
mus_bdouble_to_char((unsigned char *)hdrbuf, (double)new_srate);
header_write(fd, hdrbuf, 8);
break;
+
+ default: break;
}
CLOSE(fd, filename);
return(err);
}
-int mus_header_change_type(const char *filename, int new_type, int new_format)
+int mus_header_change_type(const char *filename, mus_header_t new_type, mus_sample_t new_format)
{
int err = MUS_NO_ERROR;
/* open temp, write header, copy data, replace original with temp */
@@ -6502,9 +6520,9 @@ int mus_header_change_type(const char *filename, int new_type, int new_format)
{
if (header_type != new_type)
{
- int ofd, ifd;
- ssize_t nbytes;
- mus_long_t loc, len = 0;
+ int ofd, ifd, len;
+ long long int nbytes;
+ mus_long_t loc;
unsigned char *buf = NULL;
char *new_file, *comment = NULL;
@@ -6512,21 +6530,23 @@ int mus_header_change_type(const char *filename, int new_type, int new_format)
(new_type == MUS_RF64))
return(mus_header_convert_riff_to_rf64(filename, data_size));
- new_file = (char *)calloc(strlen(filename) + 5, sizeof(char));
- sprintf(new_file, "%s.tmp", filename);
+ len = strlen(filename) + 5;
+ new_file = (char *)malloc(len * sizeof(char));
+ snprintf(new_file, len, "%s.tmp", filename);
loc = mus_header_data_location();
if (new_type != MUS_RAW)
{
if (comment_end > comment_start)
{
- len = comment_end - comment_start + 1;
- comment = (char *)calloc(len + 1, sizeof(char));
+ mus_long_t clen;
+ clen = comment_end - comment_start + 1;
+ comment = (char *)calloc(clen + 1, sizeof(char));
ifd = mus_file_open_read(filename);
lseek(ifd, comment_start, SEEK_SET);
- header_read(ifd, (unsigned char *)comment, len);
+ header_read(ifd, (unsigned char *)comment, clen);
CLOSE(ifd, filename);
}
- data_size = data_size * mus_bytes_per_sample(data_format) / mus_bytes_per_sample(new_format);
+ data_size = data_size * mus_bytes_per_sample(sample_type) / mus_bytes_per_sample(new_format);
mus_write_header(new_file, new_type, srate, chans, data_size, new_format, comment);
}
else mus_file_create(new_file);
@@ -6548,9 +6568,9 @@ int mus_header_change_type(const char *filename, int new_type, int new_format)
}
-int mus_header_change_format(const char *filename, int type, int new_format)
+int mus_header_change_sample_type(const char *filename, mus_header_t type, mus_sample_t new_format)
{
- int err = MUS_NO_ERROR, fd;
+ int err = MUS_NO_ERROR, fd, fr;
mus_long_t old_bytes;
switch (type)
{
@@ -6564,10 +6584,12 @@ int mus_header_change_format(const char *filename, int type, int new_format)
default:
break;
}
+
if (err == MUS_ERROR) return(err);
fd = mus_file_reopen_write(filename);
if (fd == -1)
- return(mus_error(MUS_CANT_OPEN_FILE, "mus_header_change_format for %s failed: %s", filename, STRERROR(errno)));
+ return(mus_error(MUS_CANT_OPEN_FILE, "mus_header_change_sample_type for %s failed: %s", filename, STRERROR(errno)));
+
switch (type)
{
case MUS_NEXT:
@@ -6584,13 +6606,13 @@ int mus_header_change_format(const char *filename, int type, int new_format)
case MUS_NIST:
lseek(fd, 0L, SEEK_SET);
- write_nist_header(fd, srate, chans, mus_bytes_per_sample(data_format) * data_size, new_format);
+ write_nist_header(fd, srate, chans, mus_bytes_per_sample(sample_type) * data_size, new_format);
break;
case MUS_AIFF:
case MUS_AIFC:
- old_bytes = data_size * mus_bytes_per_sample(data_format);
- lseek(fd, update_frames_location, SEEK_SET);
+ old_bytes = data_size * mus_bytes_per_sample(sample_type);
+ lseek(fd, update_framples_location, SEEK_SET);
mus_bint_to_char((unsigned char *)hdrbuf, old_bytes / (chans * mus_bytes_per_sample(new_format)));
mus_bshort_to_char((unsigned char *)(hdrbuf + 4), sndlib_format_to_aiff_bits(new_format));
header_write(fd, hdrbuf, 6);
@@ -6598,7 +6620,7 @@ int mus_header_change_format(const char *filename, int type, int new_format)
{
const char *str;
str = sndlib_format_to_aifc_name(new_format);
- lseek(fd, update_frames_location + 16, SEEK_SET);
+ lseek(fd, update_framples_location + 16, SEEK_SET);
write_four_chars((unsigned char *)(hdrbuf + 0), (const unsigned char *)str);
(*(unsigned char *)(hdrbuf + 4)) = 4; /* final pad null not accounted-for */
write_four_chars((unsigned char *)(hdrbuf + 5), (const unsigned char *)str);
@@ -6609,45 +6631,49 @@ int mus_header_change_format(const char *filename, int type, int new_format)
case MUS_RIFF:
case MUS_RF64:
- lseek(fd, update_frames_location + 24, SEEK_SET);
+ lseek(fd, update_framples_location + 24, SEEK_SET);
if (little_endian)
mus_lshort_to_char((unsigned char *)hdrbuf, sndlib_format_to_aiff_bits(new_format));
else mus_bshort_to_char((unsigned char *)hdrbuf, sndlib_format_to_aiff_bits(new_format));
header_write(fd, hdrbuf, 2);
- lseek(fd, update_frames_location + 10, SEEK_SET);
+ lseek(fd, update_framples_location + 10, SEEK_SET);
switch (new_format)
{
case MUS_MULAW:
- new_format = 7;
+ fr = 7;
break;
case MUS_ALAW:
- new_format = 6;
+ fr = 6;
break;
case MUS_UBYTE:
case MUS_LSHORT: case MUS_L24INT: case MUS_LINT:
case MUS_BSHORT: case MUS_B24INT: case MUS_BINT:
- new_format = 1;
+ fr = 1;
break;
case MUS_LFLOAT: case MUS_LDOUBLE:
case MUS_BFLOAT: case MUS_BDOUBLE:
- new_format = 3;
+ fr = 3;
break;
+
+ default: fr = 0; break;
}
if (little_endian)
- mus_lshort_to_char((unsigned char *)hdrbuf, new_format);
- else mus_bshort_to_char((unsigned char *)hdrbuf, new_format);
+ mus_lshort_to_char((unsigned char *)hdrbuf, fr);
+ else mus_bshort_to_char((unsigned char *)hdrbuf, fr);
header_write(fd, hdrbuf, 2);
break;
+
+ default: break;
}
CLOSE(fd, filename);
return(err);
}
-int mus_header_change_location(const char *filename, int type, mus_long_t new_location)
+int mus_header_change_location(const char *filename, mus_header_t type, mus_long_t new_location)
{
/* only Next/Sun changeable in this regard */
int err = MUS_NO_ERROR, fd;
@@ -6665,21 +6691,25 @@ int mus_header_change_location(const char *filename, int type, mus_long_t new_lo
}
-int mus_header_change_comment(const char *filename, int type, const char *new_comment)
+int mus_header_change_comment(const char *filename, mus_header_t type, const char *new_comment)
{
- int err = MUS_NO_ERROR, fd, len = 0;
- bool need_ripple = false;
+ int err = MUS_NO_ERROR;
err = mus_header_read(filename);
if (err == MUS_NO_ERROR)
{
+ int fd;
+ bool need_ripple = false;
switch (type)
{
case MUS_IRCAM:
- fd = mus_file_reopen_write(filename);
- lseek(fd, 16L, SEEK_SET);
- if (new_comment) len = strlen(new_comment);
- write_ircam_comment(fd, new_comment, len);
- CLOSE(fd, filename);
+ {
+ int len = 0;
+ fd = mus_file_reopen_write(filename);
+ lseek(fd, 16L, SEEK_SET);
+ if (new_comment) len = strlen(new_comment);
+ write_ircam_comment(fd, new_comment, len);
+ CLOSE(fd, filename);
+ }
break;
case MUS_NEXT:
@@ -6705,14 +6735,15 @@ int mus_header_change_comment(const char *filename, int type, const char *new_co
{
/* open temp, write header, copy data, replace original with temp */
char *new_file;
- int ofd, ifd;
+ int ofd, ifd, len;
mus_long_t loc;
- ssize_t nbytes;
+ long long int nbytes;
unsigned char *buf = NULL;
- new_file = (char *)calloc(strlen(filename) + 5, sizeof(char));
- sprintf(new_file, "%s.tmp", filename);
+ len = strlen(filename) + 5;
+ new_file = (char *)malloc(len * sizeof(char));
+ snprintf(new_file, len, "%s.tmp", filename);
loc = mus_header_data_location();
- mus_write_header(new_file, header_type, srate, chans, data_size, data_format, new_comment);
+ mus_write_header(new_file, header_type, srate, chans, data_size, sample_type, new_comment);
ifd = mus_file_open_read(filename);
lseek(ifd, loc, SEEK_SET);
ofd = mus_file_reopen_write(new_file);
@@ -6730,18 +6761,18 @@ int mus_header_change_comment(const char *filename, int type, const char *new_co
}
-bool mus_header_writable(int type, int format) /* -2 to ignore format for this call */
+bool mus_header_writable(mus_header_t type, mus_sample_t samp_type) /* MUS_IGNORE_SAMPLE to ignore sample type for this call */
{
switch (type)
{
case MUS_NEXT:
- if (format == MUS_UNKNOWN) return(false);
+ if (samp_type == MUS_UNKNOWN_SAMPLE) return(false);
return(true);
break;
case MUS_NIST:
- if (format == -2) return(true);
- switch (format)
+ if (samp_type == MUS_IGNORE_SAMPLE) return(true);
+ switch (samp_type)
{
case MUS_BYTE: case MUS_BSHORT: case MUS_B24INT: case MUS_BINT:
case MUS_LSHORT: case MUS_L24INT: case MUS_LINT:
@@ -6752,8 +6783,8 @@ bool mus_header_writable(int type, int format) /* -2 to ignore format for this c
break;
case MUS_AIFC:
- if (format == -2) return(true);
- switch (format)
+ if (samp_type == MUS_IGNORE_SAMPLE) return(true);
+ switch (samp_type)
{
case MUS_BSHORT: case MUS_B24INT: case MUS_BINT:
case MUS_BYTE: case MUS_MULAW: case MUS_ALAW:
@@ -6768,8 +6799,8 @@ bool mus_header_writable(int type, int format) /* -2 to ignore format for this c
break;
case MUS_AIFF:
- if (format == -2) return(true);
- switch (format)
+ if (samp_type == MUS_IGNORE_SAMPLE) return(true);
+ switch (samp_type)
{
case MUS_BSHORT: case MUS_B24INT: case MUS_BINT: case MUS_BYTE:
return(true);
@@ -6782,8 +6813,8 @@ bool mus_header_writable(int type, int format) /* -2 to ignore format for this c
case MUS_RIFF:
case MUS_RF64:
- if (format == -2) return(true);
- switch (format)
+ if (samp_type == MUS_IGNORE_SAMPLE) return(true);
+ switch (samp_type)
{
case MUS_MULAW: case MUS_ALAW: case MUS_UBYTE: case MUS_LFLOAT:
case MUS_LSHORT: case MUS_L24INT: case MUS_LINT: case MUS_LDOUBLE:
@@ -6796,8 +6827,8 @@ bool mus_header_writable(int type, int format) /* -2 to ignore format for this c
break;
case MUS_IRCAM:
- if (format == -2) return(true);
- switch (format)
+ if (samp_type == MUS_IGNORE_SAMPLE) return(true);
+ switch (samp_type)
{
case MUS_MULAW: case MUS_ALAW: case MUS_BSHORT: case MUS_BINT: case MUS_BFLOAT:
return(true);
@@ -6809,8 +6840,8 @@ bool mus_header_writable(int type, int format) /* -2 to ignore format for this c
break;
case MUS_CAFF:
- if (format == -2) return(true);
- switch (format)
+ if (samp_type == MUS_IGNORE_SAMPLE) return(true);
+ switch (samp_type)
{
case MUS_MULAW: case MUS_ALAW: case MUS_BYTE:
case MUS_LFLOAT: case MUS_LSHORT: case MUS_L24INT: case MUS_LINTN: case MUS_LDOUBLE:
@@ -6837,13 +6868,13 @@ bool mus_header_writable(int type, int format) /* -2 to ignore format for this c
static char aifc_format[5];
-/* try to give some info on data formats that aren't supported by sndlib */
-const char *mus_header_original_format_name(int format, int type)
+/* try to give some info on sample types that aren't supported by sndlib */
+const char *mus_header_original_sample_type_name(int samp_type, mus_header_t type)
{
switch (type)
{
case MUS_NEXT:
- switch (format)
+ switch (samp_type)
{
case 0: return("unspecified"); break; case 8: return("indirect"); break; case 9: return("nested"); break;
case 10: return("dsp_core"); break; case 11: return("dsp_data_8"); break; case 12: return("dsp_data_16"); break;
@@ -6859,9 +6890,9 @@ const char *mus_header_original_format_name(int format, int type)
case MUS_CAFF:
aifc_format[4] = 0;
#if MUS_LITTLE_ENDIAN
- sprintf(aifc_format, "%c%c%c%c", format & 0xff, (format >> 8) & 0xff, (format >> 16) & 0xff, (format >> 24) & 0xff);
+ snprintf(aifc_format, 5, "%c%c%c%c", samp_type & 0xff, (samp_type >> 8) & 0xff, (samp_type >> 16) & 0xff, (samp_type >> 24) & 0xff);
#else
- sprintf(aifc_format, "%c%c%c%c", (format >> 24) & 0xff, (format >> 16) & 0xff, (format >> 8) & 0xff, format & 0xff);
+ snprintf(aifc_format, 5, "%c%c%c%c", (samp_type >> 24) & 0xff, (samp_type >> 16) & 0xff, (samp_type >> 8) & 0xff, samp_type & 0xff);
#endif
return(aifc_format);
break;
@@ -6873,7 +6904,7 @@ const char *mus_header_original_format_name(int format, int type)
case MUS_RIFF:
case MUS_RF64:
- switch (format)
+ switch (samp_type)
{
case 2: return("ADPCM"); break; case 4: return("VSELP"); break; case 5: return("IBM_CVSD"); break;
case 0x10: return("OKI_ADPCM"); break; case 0x11: return("DVI_ADPCM"); break; case 0x12: return("MediaSpace_ADPCM"); break;
@@ -6912,6 +6943,8 @@ const char *mus_header_original_format_name(int format, int type)
case 0x1500: return("Soundspace musicompression"); break; case 0x2000: return("DVM"); break;
}
break;
+
+ default: break;
}
return("unknown"); /* NULL here isn't safe -- Sun segfaults */
}
@@ -6920,12 +6953,12 @@ const char *mus_header_original_format_name(int format, int type)
bool mus_header_no_header(const char *filename)
{
int fd;
- ssize_t bytes;
+ long long int bytes;
bool ok = false;
fd = mus_file_open_read(filename);
if (fd == -1)
return(mus_error(MUS_CANT_OPEN_FILE, "mus_header: can't open %s: %s", filename, STRERROR(errno)));
- bytes = read(fd, hdrbuf, INITIAL_READ_SIZE);
+ bytes = (long long int)read(fd, hdrbuf, INITIAL_READ_SIZE);
CLOSE(fd, filename);
if (bytes > 4)
ok = ((match_four_chars((unsigned char *)hdrbuf, I_DSND)) ||
@@ -6977,8 +7010,11 @@ bool mus_header_no_header(const char *filename)
(match_four_chars((unsigned char *)hdrbuf, I_SMP1)) ||
(match_four_chars((unsigned char *)hdrbuf, I_Maui)) ||
(match_four_chars((unsigned char *)hdrbuf, I_SDIF)) ||
- (match_four_chars((unsigned char *)hdrbuf, I_ajkg)) ||
- (match_four_chars((unsigned char *)hdrbuf, I_NVF_)));
+ (match_four_chars((unsigned char *)hdrbuf, I_ajkg))
+#if G7XX
+ || (match_four_chars((unsigned char *)hdrbuf, I_NVF_))
+#endif
+ );
return(!ok);
}
@@ -7005,7 +7041,7 @@ void mus_header_set_aiff_loop_info(int *data)
}
-bool mus_header_type_p(int n)
+bool mus_is_header_type(int n)
{
switch (n)
{
@@ -7019,9 +7055,12 @@ bool mus_header_type_p(int n)
case MUS_YAMAHA_SY85: case MUS_YAMAHA_TX16W: case MUS_DIGIPLAYER: case MUS_COVOX: case MUS_AVI:
case MUS_OMF: case MUS_QUICKTIME: case MUS_ASF: case MUS_YAMAHA_SY99: case MUS_KURZWEIL_2000:
case MUS_AIFF: case MUS_PAF: case MUS_CSL: case MUS_FILE_SAMP: case MUS_PVF: case MUS_SOUNDFORGE:
- case MUS_TWINVQ: case MUS_AKAI4: case MUS_IMPULSETRACKER: case MUS_KORG: case MUS_NVF: case MUS_CAFF:
+ case MUS_TWINVQ: case MUS_AKAI4: case MUS_IMPULSETRACKER: case MUS_KORG: case MUS_CAFF:
case MUS_MAUI: case MUS_SDIF: case MUS_OGG: case MUS_FLAC: case MUS_SPEEX: case MUS_MPEG:
case MUS_SHORTEN: case MUS_TTA: case MUS_WAVPACK:
+#if G7XX
+ case MUS_NVF:
+#endif
return(true);
break;
}
@@ -7029,7 +7068,7 @@ bool mus_header_type_p(int n)
}
-bool mus_data_format_p(int n)
+bool mus_is_sample_type(int n)
{
switch (n)
{
diff --git a/hooks.fs b/hooks.fs
index dc68d91..04b3d40 100644
--- a/hooks.fs
+++ b/hooks.fs
@@ -1,120 +1,128 @@
\ hooks.fs -- hooks.scm -> hooks.fs
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Tue Aug 08 23:27:50 CEST 2006
-\ Changed: Sat Feb 19 17:27:17 CET 2011
+\ Created: 06/08/08 23:27:50
+\ Changed: 15/02/27 22:24:42
+\
+\ @(#)hooks.fs 1.25 2/27/15
\ snd-hooks Array with all Snd hooks.
\ reset-all-hooks ( -- )
\ with-local-hook ( hook local-hook-procs thunk -- result )
+\ for all-chans
require examp
[defined] after-apply-controls-hook [if]
- #( after-apply-controls-hook
- after-graph-hook
- after-lisp-graph-hook
- after-open-hook
- after-save-as-hook
- after-save-state-hook
- after-transform-hook
- bad-header-hook
- before-close-hook
- before-exit-hook
- before-save-as-hook
- before-save-state-hook
- before-transform-hook
- clip-hook
- close-hook
- color-hook
- dac-hook
- draw-mark-hook
- draw-mix-hook
- drop-hook
- during-open-hook
- effects-hook
- enved-hook
- exit-hook
- graph-hook
- help-hook
- initial-graph-hook
- key-press-hook
- lisp-graph-hook
- listener-click-hook
- mark-click-hook
- mark-drag-hook
- mark-hook
- mix-click-hook
- mix-drag-hook
- mix-release-hook
- mouse-click-hook
- mouse-drag-hook
- mouse-enter-graph-hook
- mouse-enter-label-hook
- mouse-enter-listener-hook
- mouse-enter-text-hook
- mouse-leave-graph-hook
- mouse-leave-label-hook
- mouse-leave-listener-hook
- mouse-leave-text-hook
- mouse-press-hook
- mus-error-hook
- name-click-hook
- new-sound-hook
- new-widget-hook
- open-hook
- open-raw-sound-hook
- optimization-hook
- orientation-hook
- output-comment-hook
- output-name-hook
- peak-env-hook
- play-hook
- print-hook
- read-hook
- save-hook
- save-state-hook
- select-channel-hook
- select-sound-hook
- snd-error-hook
- snd-warning-hook
- start-hook
- start-playing-hook
- start-playing-selection-hook
- stop-dac-hook
- stop-playing-hook
- stop-playing-selection-hook
- update-hook
- view-files-select-hook )
+ #( after-apply-controls-hook
+ after-graph-hook
+ after-lisp-graph-hook
+ after-open-hook
+ after-save-as-hook
+ after-save-state-hook
+ after-transform-hook
+ bad-header-hook
+ before-close-hook
+ before-exit-hook
+ before-save-as-hook
+ before-save-state-hook
+ before-transform-hook
+ clip-hook
+ close-hook
+ color-hook
+ draw-mark-hook
+ draw-mix-hook
+ drop-hook
+ during-open-hook
+ effects-hook
+ enved-hook
+ exit-hook
+ graph-hook
+ help-hook
+ initial-graph-hook
+ key-press-hook
+ lisp-graph-hook
+ listener-click-hook
+ mark-click-hook
+ mark-drag-hook
+ mark-hook
+ mix-click-hook
+ mix-drag-hook
+ mix-release-hook
+ mouse-click-hook
+ mouse-drag-hook
+ mouse-enter-graph-hook
+ mouse-enter-label-hook
+ mouse-enter-listener-hook
+ mouse-enter-text-hook
+ mouse-leave-graph-hook
+ mouse-leave-label-hook
+ mouse-leave-listener-hook
+ mouse-leave-text-hook
+ mouse-press-hook
+ mus-error-hook
+ name-click-hook
+ new-sound-hook
+ new-widget-hook
+ open-hook
+ open-raw-sound-hook
+ orientation-hook
+ output-comment-hook
+ play-hook
+ read-hook
+ save-hook
+ save-state-hook
+ select-channel-hook
+ select-sound-hook
+ snd-error-hook
+ snd-warning-hook
+ start-playing-hook
+ start-playing-selection-hook
+ stop-playing-hook
+ stop-playing-selection-hook
+ update-hook )
[else]
- #()
+ #()
[then] constant snd-hooks
+: hooks-reset-hook { obj -- }
+ obj hook? if
+ obj reset-hook!
+ then
+;
+
: reset-all-hooks ( -- )
- doc" Removes all Snd hook functions."
- snd-hooks each ( hook ) dup hook? if reset-hook! else drop then end-each
- nil nil nil { lst snd chn }
- all-chans each to lst
- lst 0 array-ref to snd
- lst 1 array-ref to chn
- snd chn edit-hook dup hook? if reset-hook! else drop then
- snd chn after-edit-hook dup hook? if reset-hook! else drop then
- snd chn undo-hook dup hook? if reset-hook! else drop then
- end-each
+ doc" Remove all Snd hook functions."
+ snd-hooks each ( hook )
+ hooks-reset-hook
+ end-each
+ nil nil nil { lst snd chn }
+ all-chans each to lst
+ lst 0 array-ref to snd
+ lst 1 array-ref to chn
+ snd chn edit-hook hooks-reset-hook
+ snd chn after-edit-hook hooks-reset-hook
+ snd chn undo-hook hooks-reset-hook
+ end-each
;
: with-local-hook <{ hook local-hook-procs thunk -- }>
- doc" Evaluates THUNK (an xt) with HOOK set to LOCAL-HOOK-PROCS (an array of procs), \
+ doc" Evaluate THUNK (an xt) \
+with HOOK set to LOCAL-HOOK-PROCS (an array of procs), \
then restores HOOK to its previous state."
- hook hook? hook 1 $" a hook" assert-type
- local-hook-procs array? local-hook-procs 2 $" a array" assert-type
- thunk word? thunk 3 $" a proc or xt" assert-type
- hook hook->array { old-procs }
- hook reset-hook!
- local-hook-procs each ( proc ) hook swap add-hook! end-each
- thunk '() run-proc drop
- hook reset-hook!
- old-procs each ( proc ) hook swap add-hook! end-each
+ hook hook? hook 1 "a hook" assert-type
+ local-hook-procs array? local-hook-procs 2 "an array" assert-type
+ thunk word? thunk 3 "a proc or xt" assert-type
+ hook hook->array { old-procs }
+ hook reset-hook!
+ local-hook-procs each ( proc )
+ hook swap add-hook!
+ end-each
+ thunk '() run-proc drop
+ hook reset-hook!
+ old-procs each ( proc )
+ hook swap add-hook!
+ end-each
;
\ hooks.fs ends here
diff --git a/hooks.rb b/hooks.rb
index c22dd6c..22926eb 100644
--- a/hooks.rb
+++ b/hooks.rb
@@ -1,11 +1,9 @@
# hooks.rb -- hook-related functions
# Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Sun Dec 21 13:48:01 CET 2003
-# Changed: Fri Feb 25 17:04:50 CET 2011
+# Created: 03/12/21 13:48:01
+# Changed: 15/02/27 23:12:08
-# Commentary:
-#
# If class Hook isn't compiled in, here is the corresponding Ruby
# class and the initialization of all global hooks.
@@ -17,7 +15,7 @@ def protect(snd = false, chn = false)
hook = edit_hook(snd, chn)
hook.reset_hook!
hook.add_hook!("protect") do | |
- report_in_minibuffer("protected") if val = edit_position(snd, chn) < edit_pos
+ snd_print("protected") if val = edit_position(snd, chn) < edit_pos
val
end
end
@@ -27,8 +25,6 @@ def unprotect(snd = false, chn = false)
end
=end
-# Contents:
-#
# Snd_hooks an array containing all global hook variables
#
# $var_hook.member?("name of hook")
@@ -39,8 +35,6 @@ end
# with_local_hook(hook, *procs, &thunk)
# reset_all_hooks() clears all hook procedures
-# Code:
-
require "clm"
unless defined?(Hook)
@@ -51,7 +45,9 @@ unless defined?(Hook)
@name = name
@arity = arity
@procs = []
- if string?(help) and (not help.empty?) then add_help(name, help) end
+ if string?(help) and (not help.empty?)
+ add_help(name, help)
+ end
end
attr_reader :name, :arity
@@ -74,12 +70,16 @@ unless defined?(Hook)
def call(*args)
ret = nil
- self.run_hook do |prc| ret = prc.call(*args) end
+ self.run_hook do |prc|
+ ret = prc.call(*args)
+ end
ret
end
def to_a
- @procs.map do |ary| ary.last end
+ @procs.map do |ary|
+ ary.last
+ end
end
def length
@@ -97,25 +97,27 @@ unless defined?(Hook)
alias documentation describe
def names
- @procs.map do |ary| ary.first end
+ @procs.map do |ary|
+ ary.first
+ end
end
def inspect
- format("#<%s name: %s, arity: %d, procs[%d]: %s>",
- self.class, @name.inspect, @arity, self.length, self.names.inspect)
+ format("#<%s name: %p, arity: %d, procs[%d]: %p>",
+ self.class, @name, @arity, self.length, self.names)
end
end
def make_hook(name, arity = 0, help = "", hook_name = nil, &body)
- error_str = "make_hook(name, arity = 0, help = "", hook_name = nil, &body): \
-need a String or Symbol, not %s"
+ error_str = "make_hook(name, arity=0, help=\"\", hook_name=nil, &body): \
+need a String or Symbol, not %p"
var_sym = case name
when Symbol
name
when String
name.intern
else
- raise format(error_str, name.inspect)
+ raise format(error_str, name)
end
if var_sym.to_s.split(//).first != "$"
var_sym = format("$%s", var_sym.to_s).intern
@@ -188,13 +190,9 @@ need a String or Symbol, not %s"
$new_widget_hook = Hook.new("$new_widget_hook", 1)
$open_hook = Hook.new("$open_hook", 1)
$open_raw_sound_hook = Hook.new("$open_raw_sound_hook", 2)
- $optimization_hook = Hook.new("$optimization_hook", 1)
$orientation_hook = Hook.new("$orientation_hook", 0)
$output_comment_hook = Hook.new("$output_comment_hook", 1)
- $output_name_hook = Hook.new("$output_name_hook", 1)
- $peak_env_hook = Hook.new("$peak_env_hook", 2)
$play_hook = Hook.new("$play_hook", 1)
- $print_hook = Hook.new("$print_hook", 1)
$read_hook = Hook.new("$read_hook", 1)
$save_hook = Hook.new("$save_hook", 2)
$save_state_hook = Hook.new("$save_state_hook", 1)
@@ -202,22 +200,21 @@ need a String or Symbol, not %s"
$select_sound_hook = Hook.new("$select_sound_hook", 1)
$snd_error_hook = Hook.new("$snd_error_hook", 1)
$snd_warning_hook = Hook.new("$snd_warning_hook", 1)
- $start_hook = Hook.new("$start_hook", 1)
$start_playing_hook = Hook.new("$start_playing_hook", 1)
$start_playing_selection_hook = Hook.new("$start_playing_selection_hook", 0)
$stop_dac_hook = Hook.new("$stop_dac_hook", 0)
$stop_playing_hook = Hook.new("$stop_playing_hook", 1)
$stop_playing_selection_hook = Hook.new("$stop_playing_selection_hook", 0)
- $time_graph_hook = Hook.new("$time_graph_hook", 2)
$update_hook = Hook.new("$update_hook", 1)
- $view_files_select_hook = Hook.new("$view_files_select_hook", 2)
- # unless --with-no-gui
+ # unless --without-gui
$color_hook = Hook.new("$color_hook", 0)
end
class Hook
def to_names
- @procs.map do |ary| ary.first end
+ @procs.map do |ary|
+ ary.first
+ end
end
def member?(name)
@@ -238,7 +235,9 @@ class Hook
alias show to_str
def run_hook_by_name(name, *args)
- if prc = @procs.assoc(name) then prc.last.call(*args) end
+ if prc = @procs.assoc(name)
+ prc.last.call(*args)
+ end
end
end
@@ -248,18 +247,25 @@ end
add_help(:with_local_hook,
"with_local_hook(hook, *procs, &thunk) \
-evaluates thunk with hook set to procs, then restores hook to its previous state")
+Evaluates THUNK with HOOK set to PROCS, \
+then restores HOOK to its previous state.")
def with_local_hook(hook, *procs, &thunk)
old_procs = []
- hook.to_names.each do |name| old_procs.push(hook.remove_hook!(name)) end
+ hook.to_names.each do |name|
+ old_procs.push(hook.remove_hook!(name))
+ end
hook.reset_hook!
- procs.each do |prc| hook.add_hook!(prc.object_id.to_s, &prc) end
+ procs.each do |prc|
+ hook.add_hook!(prc.object_id.to_s, &prc)
+ end
thunk.call
rescue Interrupt, ScriptError, StandardError
Snd.display(verbose_message_string(true, nil, get_func_name))
ensure
hook.reset_hook!
- old_procs.each do |name, prc| hook.add_hook!(name, &prc) end
+ old_procs.each do |name, prc|
+ hook.add_hook!(name, &prc)
+ end
end
if defined? $after_graph_hook
@@ -278,7 +284,6 @@ if defined? $after_graph_hook
$before_transform_hook,
$clip_hook,
$close_hook,
- $dac_hook,
$draw_mark_hook,
$draw_mix_hook,
$drop_hook,
@@ -315,13 +320,9 @@ if defined? $after_graph_hook
$new_widget_hook,
$open_hook,
$open_raw_sound_hook,
- $optimization_hook,
$orientation_hook,
$output_comment_hook,
- $output_name_hook,
- $peak_env_hook,
$play_hook,
- $print_hook,
$read_hook,
$save_hook,
$save_state_hook,
@@ -329,22 +330,20 @@ if defined? $after_graph_hook
$select_sound_hook,
$snd_error_hook,
$snd_warning_hook,
- $start_hook,
$start_playing_hook,
$start_playing_selection_hook,
- $stop_dac_hook,
$stop_playing_hook,
$stop_playing_selection_hook,
- $time_graph_hook,
- $update_hook,
- $view_files_select_hook]
+ $update_hook]
unless provided? :snd_nogui
Snd_hooks.push($color_hook)
end
def reset_all_hooks
- Snd_hooks.each do |h| h.kind_of?(Hook) and h.reset_hook! end
+ Snd_hooks.each do |h|
+ h.kind_of?(Hook) and h.reset_hook!
+ end
Snd.sounds.each do |snd|
channels(snd).times do |chn|
(h = edit_hook(snd, chn)).kind_of?(Hook) and h.reset_hook!
diff --git a/hooks.scm b/hooks.scm
index 9d490f8..0512249 100644
--- a/hooks.scm
+++ b/hooks.scm
@@ -4,71 +4,66 @@
;;; -------- snd-hooks
-(define (snd-hooks)
- "(snd-hooks) -> list of all global (not channel-specific) hooks"
- (list after-graph-hook after-lisp-graph-hook lisp-graph-hook before-transform-hook mix-release-hook save-hook mus-error-hook
- mouse-enter-graph-hook mouse-leave-graph-hook open-raw-sound-hook select-channel-hook after-open-hook close-hook drop-hook update-hook
- mark-click-hook mark-drag-hook name-click-hook open-hook help-hook before-save-state-hook
- output-comment-hook play-hook snd-error-hook snd-warning-hook start-hook start-playing-hook stop-playing-hook
- mouse-enter-listener-hook mouse-leave-listener-hook select-sound-hook
- print-hook exit-hook output-name-hook during-open-hook after-transform-hook mouse-enter-label-hook mouse-leave-label-hook initial-graph-hook
- graph-hook key-press-hook mouse-drag-hook mouse-press-hook enved-hook read-hook mouse-click-hook new-widget-hook
- mark-hook view-files-select-hook dac-hook stop-dac-hook stop-playing-selection-hook after-apply-controls-hook draw-mark-hook
- bad-header-hook save-state-hook new-sound-hook color-hook orientation-hook listener-click-hook mix-click-hook after-save-state-hook
- mouse-enter-text-hook mouse-leave-text-hook optimization-hook mix-drag-hook
- start-playing-selection-hook after-save-as-hook before-save-as-hook peak-env-hook draw-mix-hook
- before-exit-hook before-close-hook clip-hook))
+(define snd-hooks
+ (let ((documentation "(snd-hooks) -> list of all global (not channel-specific) hooks"))
+ (lambda ()
+ (list after-graph-hook after-lisp-graph-hook lisp-graph-hook before-transform-hook mix-release-hook save-hook mus-error-hook
+ mouse-enter-graph-hook mouse-leave-graph-hook open-raw-sound-hook select-channel-hook after-open-hook close-hook drop-hook update-hook
+ mark-click-hook mark-drag-hook name-click-hook open-hook help-hook before-save-state-hook
+ output-comment-hook play-hook snd-error-hook snd-warning-hook start-playing-hook stop-playing-hook
+ mouse-enter-listener-hook mouse-leave-listener-hook select-sound-hook
+ exit-hook during-open-hook after-transform-hook mouse-enter-label-hook mouse-leave-label-hook initial-graph-hook
+ graph-hook key-press-hook mouse-drag-hook mouse-press-hook enved-hook mouse-click-hook new-widget-hook
+ mark-hook stop-playing-selection-hook after-apply-controls-hook draw-mark-hook
+ bad-header-hook save-state-hook new-sound-hook color-hook orientation-hook listener-click-hook mix-click-hook after-save-state-hook
+ mouse-enter-text-hook mouse-leave-text-hook mix-drag-hook
+ start-playing-selection-hook after-save-as-hook before-save-as-hook draw-mix-hook
+ before-exit-hook before-close-hook clip-hook))))
+
+(define reset-all-hooks
+ (let ((documentation "(reset-all-hooks) removes all Snd hook functions"))
+ (lambda ()
+ (for-each
+ (lambda (n)
+ (set! (hook-functions n) ()))
+ (snd-hooks))
+ (for-each
+ (lambda (snd)
+ (do ((chn 0 (+ chn 1)))
+ ((= chn (channels snd)))
+ (set! (hook-functions (edit-hook snd chn)) ())
+ (set! (hook-functions (after-edit-hook snd chn)) ())
+ (set! (hook-functions (undo-hook snd chn)) ())))
+ (sounds)))))
-(define (reset-all-hooks)
- "(reset-all-hooks) removes all Snd hook functions"
- (for-each
- (lambda (n)
- (set! (hook-functions n) '()))
- (snd-hooks))
- (for-each
- (lambda (snd)
- (do ((chn 0 (+ chn 1)))
- ((= chn (channels snd)))
- (set! (hook-functions (edit-hook snd chn)) '())
- (set! (hook-functions (after-edit-hook snd chn)) '())
- (set! (hook-functions (undo-hook snd chn)) '())))
- (sounds)))
;;; -------- describe-hook
-(define (describe-hook hook)
- "(describe-hook hook) -> description of functions on 'hook'"
- (for-each
- (lambda (n)
- (snd-print (format #f "~%~A" n)))
- (reverse (hook-functions hook))))
+(define describe-hook
+ (let ((documentation "(describe-hook hook) -> description of functions on 'hook'"))
+ (lambda (hook)
+ (for-each
+ (lambda (n)
+ (snd-print (format #f "~%~A" n)))
+ (reverse (hook-functions hook))))))
;;; -------- local hook
-(define (list->hook hook lst)
- "(list->hook hook lst) resets 'hook', then adds each function in 'lst' to it"
- (define (list->hook-1 hook l)
- (if (not (null? l))
- (begin
- (hook-push hook (car l))
- (list->hook-1 hook (cdr l)))))
- (set! (hook-functions hook) '())
- (list->hook-1 hook lst)
- hook)
-
-(define (with-local-hook hook local-hook-procs thunk)
- "(with-local-hook hook local-hook-procs thunk) evaluates thunk with hook set to local-hook-procs (a list), then restores hook to its previous state"
- (let ((old-hook-procs (hook-functions hook)))
- (list->hook hook local-hook-procs)
- (let ((result (thunk)))
- (list->hook hook old-hook-procs)
- result)))
+(define with-local-hook
+ (let ((documentation "(with-local-hook hook local-hook-procs thunk) evaluates thunk with hook set to local-hook-procs (a list), then restores hook to its previous state"))
+ (lambda (hook local-hook-procs thunk)
+ (let ((old-hook-procs (hook-functions hook)))
+ (set! (hook-functions hook) local-hook-procs)
+ (let ((result (thunk)))
+ (set! (hook-functions hook) old-hook-procs)
+ result)))))
;;; -------- hook-member --------
-(define (hook-member value hook)
- "(hook-member value hook) returns non-#f if 'value' is a member of the hook's function list"
- (member value (hook-functions hook)))
+(define hook-member
+ (let ((documentation "(hook-member value hook) returns non-#f if 'value' is a member of the hook's function list"))
+ (lambda (value hook)
+ (member value (hook-functions hook)))))
diff --git a/index.html b/index.html
index 19bbbb9..20fb562 100644
--- a/index.html
+++ b/index.html
@@ -1,8 +1,9 @@
-<html>
+<!DOCTYPE html>
+<html lang="en">
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>Snd Index</title>
<style type="text/css">
-<!--
EM.red {color:red; font-style:normal}
EM.typing {color:maroon; font-style: normal}
EM.listener {color:darkblue; font-style: normal}
@@ -10,330 +11,386 @@
EM.def {font-weight: bold; font-style: normal}
H1 {text-align: center}
UL {list-style-type: none}
+ DIV.centered {text-align: center}
A {text-decoration:none}
A:hover {text-decoration:underline}
A.quiet {color:black; text-decoration:none}
A.quiet:hover {text-decoration:underline}
--->
+
+ TD.green {background-color: lightgreen}
+ TD.beige {background-color: beige}
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ BODY.body {background-color: #ffffff; /* white */
+ /* margin-left: 0.5cm; */
+ }
</style>
</head>
-<body bgcolor=white>
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="beige" align="center" valign="middle"><h1>Index</h1></td></tr></table>
-</td></tr></table>
-
-<br>
-<!-- created 17-Mar-11 03:43 PDT -->
-<table cellspacing=0 cellpadding=1>
- <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td width=20></td><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td width=20></td><td><em class=tab><a href="sndclm.html#make-frametofile">make-frame->file</a></em></td><td width=20></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td width=20></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeframereader">make-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>A</center></td><td></td><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#abort">abort</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="s7.html#makehashtable">make-hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="s7.html#errorhook">*error-hook*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd->sample</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addcomment">add-comment</a></em></td><td></td><td><em class=tab><a href="s7.html#errorinfo">*error-info*</a></em></td><td></td><td><em class=tab><a href="s7.html#makehook">make-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#evalbetweenmarks">eval-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchoutrumbleandhiss">notch-out-rumble-and-hiss</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#evaloverselection">eval-over-selection</a></em></td><td></td><td><em class=tab><a href="s7.html#makelock">make-lock</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-mixer">make-mixer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-mixer!">make-mixer!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addsourcefileextension">add-source-file-extension</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtempnam">snd-tempnam</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td bgcolor="lightgreen"><center>O</center></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#extractchannel">extract-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ncos">make-ncos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#extractchannels">extract-channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noid">make-noid</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole">one-pole</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td bgcolor="lightgreen"><center>F</center></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxysin">make-nrxysin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound->amp-env</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftersaveashook">after-save-as-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsin">make-nsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoframe">sound->frame</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound->integer</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fft">fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtosounddata">sound->sound-data</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="snd.html#fftsize">fft sizes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndsounddata"><b>sound-data</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#all-pass?">all-pass?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata*">sound-data*</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata+">sound-data+</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatofile">sound-data->file</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#ampcontrolbounds">amp-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatoframe">sound-data->frame</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab><a href="extsnd.html#optimization">optimization</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sounddatatosound">sound-data->sound</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#optimizationhook">optimization-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatatosounddata">sound-data->sound-data</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#anyenvchannel">any-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatatovct">sound-data->vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#appendsound">append-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataadd">sound-data-add!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatachans">sound-data-chans</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="s7.html#makerandomstate">make-random-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#oscopedoc">oscilloscope dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatacopy">sound-data-copy</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#arraytofile">array->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatafill">sound-data-fill!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file->array</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatalength">sound-data-length</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframe">file->frame</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeregionframereader">make-region-frame-reader</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatamaxamp">sound-data-maxamp</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframe?">file->frame?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatamultiply">sound-data-multiply!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#askbeforeoverwrite">ask-before-overwrite</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputnamehook">output-name-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataoffset">sound-data-offset!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file->sample?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatapeak">sound-data-peak</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filetosounddata">file->sound-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataref">sound-data-ref</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#audioinputdevice">audio-input-device</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filetovct">file->vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-scalar-mixer">make-scalar-mixer</a></em></td><td></td><td bgcolor="lightgreen"><center>P</center></td><td></td><td><em class=tab><a href="extsnd.html#sounddatareverse">sound-data-reverse!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#audiooutputdevice">audio-output-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filename">file-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sounddatascale">sound-data-scale!</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#augmentenvironment">augment-environment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselectionframereader">make-selection-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddataset">sound-data-set!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoresize">auto-resize</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd->sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounddata?">sound-data?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesounddata">make-sound-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixvct">pan-mix-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials->polynomial</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#autoload"><b>autoload</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials->wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sound-let">sound-let</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesyncframereader">make-sync-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="s7.html#makethread">make-thread</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvhook">peak-env-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="s7.html#makethreadvariable">make-thread-variable</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>B</center></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="s7.html#maketype">make-type</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb">filtered-comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevct">make-vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersinsnd"><b>Filters</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findchannel">find-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsound">map-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finddialog">find-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playarrowsize">play-arrow-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findmark">find-mark</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#findmix">find-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark->integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findsound">find-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finishprogressreport">finish-progress-report</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bignum">bignum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bignumprecision">bignum-precision</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant">firmant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#bignump">bignum?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</A></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#bird">bird</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name->id</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#bomb">bomb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar->rectangular</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>C</center></td><td></td><td><em class=tab><a href="sndscm.html#reson">fm-voice</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#callwithexit">call-with-exit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#callin">call_in</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade->canonical</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixerdoc"><b>Matrices</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position->x</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#catch">catch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position->y</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channeltovct">channel->vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxvirtualptrees">max-virtual-ptrees</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="s7.html#format">format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#previousframe">previous-frame</a></em></td><td></td><td><em class=tab><a href="s7.html#stacktrace">stacktrace</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#starthook">start-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fouriertransform">fourier-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#printhook">print-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame1">frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame*">frame*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresource">procedure-source</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame+">frame+</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</a></em></td><td></td><td><em class=tab><a href="s7.html#procedurewithsetter">procedure-with-setter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#startwaterfall">start-waterfall</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametofile">frame->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#minibufferhistorylength">minibuffer-history-length</a></em></td><td></td><td><em class=tab><a href="sndscm.html#profile">profile</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo->mono</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametofile?">frame->file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopdachook">stop-dac-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametoframe">frame->frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix->integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#promptinminibuffer">prompt-in-minibuffer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametolist">frame->list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixtovct">mix->vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ptreechannel">ptree-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frametosample">frame->sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#channelstyleconstants">channels-separate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametosound">frame->sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#channels=">channels=?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametosounddata">frame->sound-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="sndscm.html#frametovct">frame->vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td bgcolor="lightgreen"><center>R</center></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framecopy">frame-copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderatendQ">frame-reader-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians->degrees</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderchans">frame-reader-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians->hz</a></em></td><td></td><td><em class=tab><a href="s7.html#symbolaccess">symbol-access</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderhome">frame-reader-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#clear-array">clear-array</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderposition">frame-reader-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixframe">mix-frame</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereaderQ">frame-reader?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-everything">sync-everything</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clearminibuffer">clear-minibuffer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame-ref">frame-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#framereverse">frame-reverse!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncstyle">sync-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame-set!">frame-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixmovesound">mix-move-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#random">random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frame?">frame?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#clmload">clm-load</a></em></td><td></td><td><em class=tab><a href="sndclm.html#framedoc"><b>frames</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name->id</a></em></td><td></td><td><em class=tab><a href="sndscm.html#readframe">read-frame</a></em></td><td></td><td bgcolor="lightgreen"><center>T</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#clonesoundas">clone-sound-as</a></em></td><td></td><td><em class=tab><a href="extsnd.html#frames">frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframes"><b>frames (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeframereader">free-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colortolist">color->list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#recorderdialog">recorder-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#mixsounddata">mix-sound-data</a></em></td><td></td><td><em class=tab><a href="snd.html#recordfile"><b>Recording</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td bgcolor="lightgreen"><center>G</center></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular->polar</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td><em class=tab><a href="s7.html#trace">trace</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap->integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redochannel">redo-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#tracehook">*trace-hook*</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redoedit">redo-edit</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regiontoframe">region->frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym">gensym</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixvct">mix-vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform->integer</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regiontosounddata">region->sound-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtovct">transform->vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="s7.html#globalenvironment">global-environment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontovct">region->vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer1">mixer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframes">transform-frames</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixerdoc">mixer as matrix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframes">region-frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#combineddatacolor">combined-data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixermultiply">mixer*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="s7.html#grablock">grab-lock</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixeradd">mixer+</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixercopy">mixer-copy</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#compandchannel">compand-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-determinant">mixer-determinant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#compandsound">compand-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-inverse">mixer-inverse</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-poly">mixer-poly</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#constantp">constant?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer-ref">mixer-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#continue-frametofile">continue-frame->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer-set!">mixer-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph->ps</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-solve">mixer-solve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trapsegfault">trap-segfault</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixer-transpose">mixer-transpose</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mixer?">mixer?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#framedoc"><b>mixers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="s7.html#releaselock">release-lock</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#contrastcontrolp">contrast-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphlines">graph-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono->stereo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reportinminibuffer">report-in-minibuffer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr>
- <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls->channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td bgcolor="lightgreen"><center>U</center></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#restorecontrols">restore-controls</a></em></td><td></td><td><em class=tab><a href="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td bgcolor="lightgreen"><center>H</center></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavelabelhook">mouse-leave-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undochannel">undo-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#hashtable">hash-table</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavetexthook">mouse-leave-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoedit">undo-edit</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#copyframereader">copy-frame-reader</a></em></td><td></td><td><em class=tab><a href="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and Data formats</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-locsig">move-locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unselectall">unselect-all</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#countmatches">count-matches</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#createssbdialog">create-ssb-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannels">reverse-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td><em class=tab><a href="s7.html#hook">hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#currenteditposition">current-edit-position</a></em></td><td></td><td><em class=tab><a href="s7.html#hookarity">hook-arity</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="s7.html#currentenvironment">current-environment</a></em></td><td></td><td><em class=tab><a href="s7.html#hookfunctions">hook-functions</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td bgcolor="lightgreen"><center>V</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rightsample">right-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</A></em></td><td></td><td><em class=tab><a href="sndclm.html#ring-modulate">ring-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorfollowsplay">cursor-follows-play</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</A></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vct">vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorchoices">cursor-in-view</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz->radians</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttimes">vct*</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</A></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctplus">vct+</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td bgcolor="lightgreen"><center>I</center></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</A></em></td><td></td><td><em class=tab><a href="extsnd.html#rotatechannel">rotate-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttochannel">vct->channel</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</A></em></td><td></td><td><em class=tab><a href="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vcttofile">vct->file</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</A></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#vcttoframe">vct->frame</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#run">run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttolist">vct->list</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#vcttosounddata">vct->sound-data</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="sndclm.html#multiply-arrays">multiply-arrays</a></em></td><td></td><td bgcolor="lightgreen"><center>S</center></td><td></td><td><em class=tab><a href="extsnd.html#vcttostring">vct->string</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>D</center></td><td></td><td><em class=tab><a href="sndclm.html#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#vcttovector">vct->vector</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctadd">vct-add!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctcopy">vct-copy</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dachook">dac-hook</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctfill">vct-fill!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialbeg">initial-beg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile?">sample->file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctlength">vct-length</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialdur">initial-dur</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletoframe">sample->frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmap">vct-map!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dataformat">data-format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampleratendQ">sampler-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmove">vct-move!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioclose">mus-audio-close</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmultiply">vct-multiply!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudiodescribe">mus-audio-describe</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerposition">sampler-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctoffset">vct-offset!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db->linear</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioopeninput">mus-audio-open-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctpeak">vct-peak</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertframe">insert-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioopenoutput">mus-audio-open-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#vctpolynomial">vct-polynomial</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudioread">mus-audio-read</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctref">vct-ref</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musaudiowrite">mus-audio-write</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples->seconds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctreverse">vct-reverse!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctscale">vct-scale!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputdataformat">default-output-data-format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctset">vct-set!</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsilence">insert-silence</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogsrc">save-as-dialog-src</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubseq">vct-subseq</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubtract">vct-subtract!</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertsounddata">insert-sound-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctp">vct?</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definestar">define*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertvct">insert-vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="extsnd.html#Vcts"><b>Vcts</b></a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#defineconstant">define-constant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertionexamples"><b>Insertions</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vectortovct">vector->vct</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#instruments">Instruments</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musdataformattostring">mus-data-format->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#vectorprintlength">*vector-print-length*</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definemacro">define-macro</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer->colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musdataformatname">mus-data-format-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr>
- <tr><td><em class=tab><a href="s7.html#definemacrostar">define-macro*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer->mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemacros">save-macros</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer->mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#definstrument">definstrument</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer->region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#defvar">defvar</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer->sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees->radians</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer->transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemixes">save-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfft">mus-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselection">save-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td bgcolor="lightgreen"><center>J</center></td><td></td><td><em class=tab><a href="extsnd.html#musfileclipping">mus-file-clipping</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselectiondialog">save-selection-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-file-name">mus-file-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesound">save-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfileprescaler">mus-file-prescaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesoundas">save-sound-as</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ptreechannel"><b>Virtual Edits</b></a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab><a href="s7.html#jointhread">join-thread</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestate">save-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatefile">save-state-file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td bgcolor="lightgreen"><center>K</center></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypetostring">mus-header-type->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletesamplesandsmooth">delete-samples-and-smooth</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td bgcolor="lightgreen"><center>W</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="extsnd.html#key">key</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td bgcolor="lightgreen"><center>L</center></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dialogwidgets">dialog-widgets</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="s7.html#lambdastar">lambda*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#musmix">mus-mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#displayscannedsynthesis">display-scanned-synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelevelmeter">level meters</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scansound">scan-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear->db</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musoutformat">mus-out-format</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#dlocsig">dlocsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowy">window-y</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musprescaler">mus-prescaler</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#withbackgroundprocesses">with-background-processes</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtovct">list->vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td><td></td><td><em class=tab><a href="s7.html#withenvironment">with-environment</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds->samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withgl">with-gl</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinsetgraph">with-inset-graph</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-safety">mus-safety</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmarkedsound">with-marked-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmenuicons">with-menu-icons</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseinput">mus-sound-close-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td><em class=tab><a href="extsnd.html#littleendianp">little-endian?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseoutput">mus-sound-close-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmixedsound">with-mixed-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#loadhook">*load-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcomment">mus-sound-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withmixedsoundtonotelist">with-mixed-sound->notelist</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#loadpath">*load-path*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddataformat">mus-sound-data-format</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatalocation">mus-sound-data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</a></em></td></tr>
- <tr><td bgcolor="lightgreen"><center>E</center></td><td></td><td><em class=tab><a href="sndclm.html#locsig-ref">locsig-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withsmptelabel">with-smpte-label</a></em></td></tr>
- <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-ref">locsig-reverb-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundduration">mus-sound-duration</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection->mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-set!">locsig-reverb-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectiontosounddata">selection->sound-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtempsound">with-temp-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundframes">mus-sound-frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundheadertype">mus-sound-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withthreadedchannels">with-threaded-channels</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edithook">edit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig?">locsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundlength">mus-sound-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withthreadedsound">with-threaded-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editlisttofunction">edit-list->function</a></em></td><td></td><td><em class=tab><a href="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframes">selection-frames</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtoolbar">with-toolbar</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editposition">edit-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#loopbetweenmarks">loop-between-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtooltips">with-tooltips</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editproperties">edit-properties</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxampexists">mus-sound-maxamp-exists?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopeninput">mus-sound-open-input</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#edits">edits</a></em></td><td></td><td bgcolor="lightgreen"><center>M</center></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopenoutput">mus-sound-open-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td><td></td><td bgcolor="lightgreen"><center>X</center></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#effectshook">effects-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#macrop">macro?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundread">mus-sound-read</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xtoposition">x->position</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="s7.html#macroexpand">macroexpand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreopenoutput">mus-sound-reopen-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxislabel">x-axis-label</a></em></td></tr>
- <tr><td><em class=tab><a href="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxisstyle">x-axis-style</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env">env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#shepardtone">shepard-tone</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xbounds">x-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundseekframe">mus-sound-seek-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xpositionslider">x-position-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envchannel">env-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwrite">mus-sound-write</a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebiquad">make-biquad</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullduration">show-full-duration</a></em></td><td></td><td bgcolor="lightgreen"><center>Y</center></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envmixes">env-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y->position</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr>
- <tr><td><em class=tab><a href="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr>
- <tr><td><em class=tab><a href="sndclm.html#env?">env?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedbase">enved-base</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselection">show-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td bgcolor="lightgreen"><center>N</center></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td><td></td><td bgcolor="lightgreen"><center>Z</center></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframe">make-file->frame</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td><td></td><td><em class=tab> </em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#filterenv">enved-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file->sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#filterenvorder">enved-filter-order</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-coeffs">make-fir-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr>
- <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td><td></td>
+<body class="body">
+<div class="topheader">Index</div>
+<!-- created 16-Oct-15 16:57 PDT -->
+<table>
+ <tr><td><em class=tab><a href="s7.html#sharpreaders">*#readers*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#epsleftmargin">eps-left-margin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandpass">make-bandpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeffs">mus-xcoeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#secondstosamples">seconds->samples</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#epssize">eps-size</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebandstop">make-bandstop</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeff">mus-ycoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectall">select-all</a></em></td></tr>
+ <tr><td class="green"><div class="centered">-</div></td><td></td><td><em class=tab><a href="sndclm.html#ercos">ercos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-bess">make-bess</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ycoeffs">mus-ycoeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannel">select-channel</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#ercos?">ercos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebiquad">make-biquad</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#selectchannelhook">select-channel-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#tobytevector">->byte-vector</a></em></td><td></td><td><em class=tab><a href="s7.html#errorhook">*error-hook*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makebirds">make-birds</a></em></td><td></td><td class="green"><div class="centered">N</div></td><td></td><td><em class=tab><a href="extsnd.html#selectsound">select-sound</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#erssb">erssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-blackman">make-blackman</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#selectsoundhook">select-sound-hook</a></em></td></tr>
+ <tr><td class="green"><div class="centered">A</div></td><td></td><td><em class=tab><a href="sndclm.html#erssb?">erssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-brown-noise">make-brown-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos">n1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedchannel">selected-channel</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#evenmultiple">even-multiple</a></em></td><td></td><td><em class=tab><a href="s7.html#makebytevector">make-byte-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#n1cos?">n1cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selecteddatacolor">selected-data-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#abcos">abcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#evenweight">even-weight</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedropsite">make-channel-drop-site</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nameclickhook">name-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedgraphcolor">selected-graph-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#abcos?">abcos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#everysample">every-sample?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makecolor">make-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos">nchoosekcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectedsound">selected-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#abort">abort</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exit">exit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-comb">make-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nchoosekcos?">nchoosekcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selection">selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#absin">absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#exithook">exit-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makecombbank">make-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos">ncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectiontomix">selection->mix</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#absin?">absin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrol">expand-control</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-convolve">make-convolve</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos2?">ncos2?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionchans">selection-chans</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addampcontrols">add-amp-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolbounds">expand-control-bounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-delay">make-delay</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos4?">ncos4?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncolor">selection-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addcolormap">add-colormap</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolhop">expand-control-hop</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makedifferentiator">make-differentiator</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ncos?">ncos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncontext">selection-context</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#adddeleteoption">add-delete-option</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontroljitter">expand-control-jitter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-env">make-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsound">new-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectioncreatesregion">selection-creates-region</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#adddirectorytoviewfileslist">add-directory-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrollength">expand-control-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-eoddcos">make-eoddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsounddialog">new-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionframples">selection-framples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfilefilter">add-file-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolramp">expand-control-ramp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ercos">make-ercos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newsoundhook">new-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxamp">selection-maxamp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfilesorter">add-file-sorter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#expandcontrolp">expand-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-erssb">make-erssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#newwidgethook">new-widget-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a></em></td><td></td><td><em class=tab><a href="sndscm.html#explodesf2">explode-sf2</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fft-window">make-fft-window</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionmember">selection-member?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addmark">add-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetoframple">make-file->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb">nkssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionmembers">selection-members</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addmarkpane">add-mark-pane</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsnd">expsnd</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filetosample">make-file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssbinterp">nkssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionposition">selection-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addplayer">add-player</a></em></td><td></td><td><em class=tab><a href="sndscm.html#expsrc">expsrc</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-filter">make-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nkssb?">nkssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#selectionrms">selection-rms</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addsoundfileextension">add-sound-file-extension</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-filtered-comb">make-filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos">noddcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionsrate">selection-srate</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addsourcefileextension">add-source-file-extension</a></em></td><td></td><td class="green"><div class="centered">F</div></td><td></td><td><em class=tab><a href="sndclm.html#makefilteredcombbank">make-filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddcos?">noddcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionok">selection?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtomainmenu">add-to-main-menu</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-coeffs">make-fir-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin">noddsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#selectionstuff"><b>Selections</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtomenu">add-to-menu</a></em></td><td></td><td><em class=tab><a href="s7.html#featureslist">*features*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fir-filter">make-fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddsin?">noddsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#setsamples">set-samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#addtooltip">add-tooltip</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cellon">feedback fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-firmant">make-firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb">noddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#shortfilename">short-file-name</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#addtransform">add-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fft">fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makefv">make-float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noddssb?">noddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showaxes">show-axes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#spectra">additive synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftcancel">fft-cancel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-flocsig">make-flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showcontrols">show-controls</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave">adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftedit">fft-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-fmssb">make-fmssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#cleandoc"><b>Noise Reduction</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#showdiskspace">show-disk-space</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvedit">fft-env-edit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizechannel">normalize-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullduration">show-full-duration</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave">adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftenvinterp">fft-env-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeformantbank">make-formant-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizeenvelope">normalize-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showfullrange">show-full-range</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-square-wave?">adjustable-square-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogfrequency">fft-log-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frampletofile">make-frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#normalizepartials">normalize-partials</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showgrid">show-grid</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave">adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftlogmagnitude">fft-log-magnitude</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-granulate">make-granulate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizesound">normalize-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showindices">show-indices</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#adjustable-triangle-wave?">adjustable-triangle-wave?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsmoother">fft-smoother</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makegraphdata">make-graph-data</a></em></td><td></td><td><em class=tab><a href="sndscm.html#normalizedmix">normalized-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showlistener">show-listener</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afterapplycontrolshook">after-apply-controls-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fftsquelch">fft-squelch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise">make-green-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch">notch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmarks">show-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afteredithook">after-edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwindow">fft-window</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-green-noise-interp">make-green-noise-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchchannel">notch-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showmixwaveforms">show-mix-waveforms</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftergraphhook">after-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftalpha">fft-window-alpha</a></em></td><td></td><td><em class=tab><a href="s7.html#makehashtable">make-hash-table</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchselection">notch-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselection">show-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afterlispgraphhook">after-lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftbeta">fft-window-beta</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehighpass">make-highpass</a></em></td><td></td><td><em class=tab><a href="sndscm.html#notchsound">notch-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showselectiontransform">show-selection-transform</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#afteropenhook">after-open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftwithphases">fft-with-phases</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makehilberttransform">make-hilbert-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#notch?">notch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showsonogramcursor">show-sonogram-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftersaveashook">after-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fftexamples"><b>FFTs</b></a></em></td><td></td><td><em class=tab><a href="s7.html#makehook">make-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#npcos?">npcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showtransformpeaks">show-transform-peaks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftersavestatehook">after-save-state-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nbdoc">file database</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-iir-filter">make-iir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos">nrcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showwidget">show-widget</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#aftertransformhook">after-transform-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoarray">file->array</a></em></td><td></td><td><em class=tab><a href="s7.html#makeintvector">make-int-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrcos?">nrcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#showyzero">show-y-zero</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#allchans">all-chans</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple">file->frample</a></em></td><td></td><td><em class=tab><a href="s7.html#makeiterator">make-iterator</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nrev">nrev</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silenceallmixes">silence-all-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#all-pass">all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetoframple?">file->frample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-izcos">make-izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin">nrsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#silencemixes">silence-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#allpassbank">all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample">file->sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0evencos">make-j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrsin?">nrsin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train">sinc-train</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#allpassbankp">all-pass-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filetosample?">file->sample?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j0j1cos">make-j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb">nrssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sinc-train?">sinc-train?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#all-pass?">all-pass?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filename">file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-j2cos">make-j2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssbinterp">nrssb-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sincwidth">sinc-width</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#sndandalsa"><b>Alsa</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfilename"><b>file-name (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jjcos">make-jjcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrssb?">nrssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineenvchannel">sine-env-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#ampcontrol">amp-control</a></em></td><td></td><td><em class=tab><a href="s7.html#fillb">fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jncos">make-jncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos">nrxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#ampcontrolbounds">amp-control-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericfill"><b>fill! (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jpcos">make-jpcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxycos?">nrxycos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#amplitude-modulate">amplitude-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillpolygon">fill-polygon</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-jycos">make-jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin">nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#analyseladspa">analyse-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fillrectangle">fill-rectangle</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2cos">make-k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nrxysin?">nrxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothselection">smooth-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anoi">anoi</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter">filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2sin">make-k2sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin">nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothsound">smooth-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anyenvchannel">any-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterchannel">filter-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k2ssb">make-k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsin?">nsin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothexamples"><b>Smoothing</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#anyrandom">any-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolcoeffs">filter-control-coeffs</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-k3sin">make-k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos">nsincos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">SMS synthesis</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#applycontrols">apply-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolenvelope">filter-control-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-krksin">make-krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nsincos?">nsincos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#applyladspa">apply-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolindB">filter-control-in-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig">make-locsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb">nssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmarks">snap-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#aritablep">aritable?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolinhz">filter-control-in-hz</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makelowpass">make-lowpass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nssb?">nssb?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#arity">arity</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolorder">filter-control-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makemixsampler">make-mix-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos">nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosample">snd->sample</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#arraytofile">array->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterwaveformcolor">filter-control-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-move-sound">make-move-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1cos?">nxy1cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtosamplep">snd->sample?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#array-interp">array-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtercontrolp">filter-control?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-autocorrelation">make-moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin">nxy1sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndcolor">snd-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#asoneedit">as-one-edit</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterfft">filter-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-average">make-moving-average</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxy1sin?">nxy1sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderror">snd-error</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filterselection">filter-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-fft">make-moving-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos">nxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#snderrorhook">snd-error-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#askbeforeoverwrite">ask-before-overwrite</a></em></td><td></td><td><em class=tab><a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-max">make-moving-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxycos?">nxycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndfont">snd-font</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asyfmI">asyfm-I</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersound">filter-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-norm">make-moving-norm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin">nxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndgcs">snd-gcs</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asyfmJ">asyfm-J</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filter?">filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-pitch">make-moving-pitch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#nxysin?">nxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhelp">snd-help</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asyfm?">asyfm?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb">filtered-comb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-scentroid">make-moving-scentroid</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#sndscmhooks">snd-hooks</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm">asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbank">filtered-comb-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-moving-spectrum">make-moving-spectrum</a></em></td><td></td><td class="green"><div class="centered">O</div></td><td></td><td><em class=tab><a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#asymmetric-fm?">asymmetric-fm?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filteredcombbankp">filtered-comb-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-n1cos">make-n1cos</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#sndprint">snd-print</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoresize">auto-resize</a></em></td><td></td><td><em class=tab><a href="sndclm.html#filtered-comb?">filtered-comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nchoosekcos">make-nchoosekcos</a></em></td><td></td><td><em class=tab><a href="s7.html#objecttostring">object->string</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndspectrum">snd-spectrum</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#autosavedoc">auto-save</a></em></td><td></td><td><em class=tab><a href="extsnd.html#filtersinsnd"><b>Filters</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ncos">make-ncos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddmultiple">odd-multiple</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndtempnam">snd-tempnam</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoupdate">auto-update</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finddialog">find-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nkssb">make-nkssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oddweight">odd-weight</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurl">snd-url</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#autoupdateinterval">auto-update-interval</a></em></td><td></td><td><em class=tab><a href="extsnd.html#findmark">find-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddcos">make-noddcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetchannel">offset-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndurls">snd-urls</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#autocorrelate">autocorrelate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#findmix">find-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddsin">make-noddsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#offsetsound">offset-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndversion">snd-version</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#autoload"><b>autoload</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#findsound">find-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noddssb">make-noddssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole">one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarning">snd-warning</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axiscolor">axis-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#finfo">finfo</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-noid">make-noid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass">one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndwarninghook">snd-warning-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axisinfo">axis-info</a></em></td><td></td><td><em class=tab><a href="extsnd.html#finishprogressreport">finish-progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-notch">make-notch</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole-all-pass?">one-pole-all-pass?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndwarp">sndwarp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axislabelfont">axis-label-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter">fir-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrcos">make-nrcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-pole?">one-pole?</a></em></td><td></td><td><em class=tab><a href="s7.html#sortb">sort!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#axisnumbersfont">axis-numbers-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fir-filter?">fir-filter?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrsin">make-nrsin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero">one-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-locsig"><b>Sound placement</b></a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#firmant">firmant</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrssb">make-nrssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#one-zero?">one-zero?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundtoamp_env">sound->amp-env</a></em></td></tr>
+ <tr><td class="green"><div class="centered">B</div></td><td></td><td><em class=tab><a href="sndclm.html#firmant?">firmant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxycos">make-nrxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialog">open-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundtointeger">sound->integer</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nrxysin">make-nrxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openfiledialogdirectory">open-file-dialog-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfileextensions">sound-file-extensions</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#backgroundgradient">background-gradient</a></em></td><td></td><td><em class=tab><a href="sndscm.html#flattenpartials">flatten-partials</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsin">make-nsin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openhook">open-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilep">sound-file?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#badheaderhook">bad-header-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fv">float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nsincos">make-nsincos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#opennextfileindirectory">open-next-file-in-directory</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bagpipe">bagpipe</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtimes">float-vector*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nssb">make-nssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsound">open-raw-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundinterp">sound-interp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#basiccolor">basic-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvplus">float-vector+</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1cos">make-nxy1cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#openrawsoundhook">open-raw-sound-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundloopinfo">sound-loop-info</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beatspermeasure">beats-per-measure</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtochannel">float-vector->channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxy1sin">make-nxy1sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#opensound">open-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperties">sound-properties</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beatsperminute">beats-per-minute</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtolist">float-vector->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxycos">make-nxycos</a></em></td><td></td><td><em class=tab><a href="s7.html#openlet">openlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundproperty">sound-property</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforeclosehook">before-close-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvtostring">float-vector->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-nxysin">make-nxysin</a></em></td><td></td><td><em class=tab><a href="s7.html#openletp">openlet?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundwidgets">sound-widgets</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforeexithook">before-exit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvabs">float-vector-abs!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole">make-one-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#orientationhook">orientation-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundp">sound?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforesaveashook">before-save-as-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvadd">float-vector-add!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-pole-all-pass">make-one-pole-all-pass</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil">oscil</a></em></td><td></td><td><em class=tab><a href="extsnd.html#soundfontinfo">soundfont-info</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforesavestatehook">before-save-state-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvcopy">float-vector-copy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-one-zero">make-one-zero</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank">oscil-bank</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sounds">sounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#beforetransformhook">before-transform-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvequal">float-vector-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil">make-oscil</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil-bank?">oscil-bank?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#soundstosegmentdata">sounds->segment-data</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#besj0">bes-j0</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvfill">float-vector-fill!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-oscil-bank">make-oscil-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#oscil?">oscil?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectra">spectra</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#bess">bess</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvlength">float-vector-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a></em></td><td></td><td><em class=tab><a href="sndclm.html#out-any">out-any</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">spectral interpolation</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#bess?">bess?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmax">float-vector-max</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pink-noise">make-pink-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outbank">out-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spectralpolynomial">spectral-polynomial</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">bessel filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmin">float-vector-min</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makepixmap">make-pixmap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#outa">outa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrohop">spectro-hop</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bigbird">bigbird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmove">float-vector-move!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeplayer">make-player</a></em></td><td></td><td><em class=tab><a href="s7.html#outlet">outlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxangle">spectro-x-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bignum">bignum</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvmultiply">float-vector-multiply!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyoid">make-polyoid</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*output*">*output*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroxscale">spectro-x-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bignump">bignum?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvoffset">float-vector-offset!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polyshape">make-polyshape</a></em></td><td></td><td><em class=tab><a href="extsnd.html#outputcommenthook">output-comment-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyangle">spectro-y-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#binaryiodoc">binary files</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvpeak">float-vector-peak</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-polywave">make-polywave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#overlayrmsenv">overlay-rms-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectroyscale">spectro-y-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#bindkey">bind-key</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vctpolynomial">float-vector-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulse-train">make-pulse-train</a></em></td><td></td><td><em class=tab><a href="s7.html#owlet">owlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozangle">spectro-z-angle</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bird">bird</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvref">float-vector-ref</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-pulsed-env">make-pulsed-env</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#spectrozscale">spectro-z-scale</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#blackman">blackman</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvreverse">float-vector-reverse!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k!cos">make-r2k!cos</a></em></td><td></td><td class="green"><div class="centered">P</div></td><td></td><td><em class=tab><a href="sndclm.html#spectrum">spectrum</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#blackman4envchannel">blackman4-env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvscale">float-vector-scale!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-r2k2cos">make-r2k2cos</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#blackman?">blackman?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvset">float-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeramp">make-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#padchannel">pad-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumend">spectrum-end</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#boldpeaksfont">bold-peaks-font</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubseq">float-vector-subseq</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand">make-rand</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padmarks">pad-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#spectrumstart">spectrum-start</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#break">break</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvsubtract">float-vector-subtract!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rand-interp">make-rand-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#padsound">pad-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrol">speed-control</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#brown-noise">brown-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#fvp">float-vector?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rcos">make-rcos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmix">pan-mix</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedcontrolbounds">speed-control-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#brown-noise?">brown-noise?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig">flocsig</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-readin">make-readin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#panmixvct">pan-mix-float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedstyle">speed-control-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">butterworth filters</a></em></td><td></td><td><em class=tab><a href="sndclm.html#flocsig?">flocsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregion">make-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstopolynomial">partials->polynomial</a></em></td><td></td><td><em class=tab><a href="extsnd.html#speedtones">speed-control-tones</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bytevector">byte-vector</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">flute model</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makeregionsampler">make-region-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#partialstowave">partials->wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#spotfreq">spot-freq</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#bytevectorp">byte-vector?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmbell">fm-bell</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!cos">make-rk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#pausing">pausing</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave">square-wave</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmdrum">fm-drum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rk!ssb">make-rk!ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peakenvdir">peak-env-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#square-wave?">square-wave?</a></em></td></tr>
+ <tr><td class="green"><div class="centered">C</div></td><td></td><td><em class=tab><a href="sndscm.html#fmnoise">fm-noise</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkcos">make-rkcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaks">peaks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#squelchupdate">squelch-update</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#fmparallelcomponent">fm-parallel-component</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkoddssb">make-rkoddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#peaksfont">peaks-font</a></em></td><td></td><td><em class=tab><a href="sndscm.html#squelchvowels">squelch-vowels</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definecfunction">c-define</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">fm-talker</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rksin">make-rksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-partialstowave">phase-partials->wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srate">srate</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cgp">c-g?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmtrumpet">fm-trumpet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rkssb">make-rkssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder">phase-vocoder</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsrate"><b>srate (generic)</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cobject">c-object?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#vdoc">fm-violin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-round-interp">make-round-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#phase-vocoder?">phase-vocoder?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src">src</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cpoint">c-pointer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvoice">fm-voice</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rssb">make-rssb</a></em></td><td></td><td><em class=tab><a href="sndscm.html#prc95doc"><b>Physical Models</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcchannel">src-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cpointer">c-pointer?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb">fmssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxycos">make-rxycos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pianodoc">piano model</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcduration">src-duration</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#callwithexit">call-with-exit</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fmssb?">fmssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!cos">make-rxyk!cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise">pink-noise</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcfitenvelope">src-fit-envelope</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#bagpipe">canter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#focuswidget">focus-widget</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxyk!sin">make-rxyk!sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pink-noise?">pink-noise?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#srcmixes">src-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cascadetocanonical">cascade->canonical</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">FOF synthesis</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-rxysin">make-rxysin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pins">pins</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsoundselection">src-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#catch">catch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fofins">fofins</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sampletofile">make-sample->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#placesound">place-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#srcsound">src-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cellon">cellon</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachchild">for-each-child</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesampler">make-sampler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#play">play</a></em></td><td></td><td><em class=tab><a href="sndclm.html#src?">src?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chaindsps">chain-dsps</a></em></td><td></td><td><em class=tab><a href="sndscm.html#foreachsoundfile">for-each-sound-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sawtooth-wave">make-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericplay"><b>play (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am">ssb-am</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channeltovct">channel->vct</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">Forbidden Planet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makeselection">make-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playarrowsize">play-arrow-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ssb-am?">ssb-am?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelampenvs">channel-amp-envs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#foregroundcolor">foreground-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-sinc-train">make-sinc-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playbetweenmarks">play-between-marks</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbank">ssb-bank</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channeldata">channel-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#forgetregion">forget-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makesndtosample">make-snd->sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playhook">play-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbbankenv">ssb-bank-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelenvelope">channel-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant">formant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makesoundbox">make-sound-box</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playmixes">play-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ssbfm">ssb-fm</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelpolynomial">channel-polynomial</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbank">formant-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makespencerfilter">make-spencer-filter</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playoften">play-often</a></em></td><td></td><td><em class=tab><a href="sndscm.html#startdac">start-dac</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelproperties">channel-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formantbankp">formant-bank?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-square-wave">make-square-wave</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playregionforever">play-region-forever</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplaying">start-playing</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelproperty">channel-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#formant?">formant?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-src">make-src</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsine">play-sine</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayinghook">start-playing-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelrms">channel-rms</a></em></td><td></td><td><em class=tab><a href="s7.html#format">format</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-ssb-am">make-ssb-am</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsines">play-sines</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startplayingselectionhook">start-playing-selection-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelstyle">channel-style</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandforth"><b>Forth</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup">make-table-lookup</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playsyncdmarks">play-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#startprogressreport">start-progress-report</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelsync">channel-sync</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fp">fp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-table-lookup-with-env">make-table-lookup-with-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playuntilcg">play-until-c-g</a></em></td><td></td><td><em class=tab><a href="extsnd.html#statusreport">status-report</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channelwidgets">channel-widgets</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-tanhsin">make-tanhsin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#playwithenvs">play-with-envs</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereotomono">stereo->mono</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#channels">channels</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile">frample->file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-triangle-wave">make-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerhome">player-home</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stereoflute">stereo-flute</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#genericchannels"><b>channels (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletofile?">frample->file?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-pole">make-two-pole</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playerQ">player?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayer">stop-player</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelsequal">channels-equal?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#frampletoframple">frample->frample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-two-zero">make-two-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#players">players</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplaying">stop-playing</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#channelseq">channels=?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#framples">framples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#makevariabledisplay">make-variable-display</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playexamples"><b>Playing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayinghook">stop-playing-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#chans">chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericframples"><b>framples (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevariablegraph">make-variable-graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#playing">playing</a></em></td><td></td><td><em class=tab><a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#charposition">char-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freeplayer">free-player</a></em></td><td></td><td><em class=tab><a href="extsnd.html#makevct">make-vct</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pluck">pluck</a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchenvelope">stretch-envelope</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chebyhka">cheby-hka</a></em></td><td></td><td><em class=tab><a href="extsnd.html#freesampler">free-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train">make-wave-train</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandladspa"><b>Plugins</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#stretchsoundviadft">stretch-sound-via-dft</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">chebyshev filters</a></em></td><td></td><td><em class=tab><a href="sndscm.html#freeverb">freeverb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-wave-train-with-env">make-wave-train-with-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polartorectangular">polar->rectangular</a></em></td><td></td><td><em class=tab><a href="s7.html#stringposition">string-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#checkmixtags">check-mix-tags</a></em></td><td></td><td><em class=tab><a href="fm.html#fmintro"><b>Frequency Modulation</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mapchannel">map-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polynomial">polynomial</a></em></td><td></td><td><em class=tab><a href="s7.html#sublet">sublet</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chordalize">chordalize</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fullmix">fullmix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mapsoundfiles">map-sound-files</a></em></td><td></td><td><em class=tab><a href="sndscm.html#polydoc">polynomial operations</a></em></td><td></td><td><em class=tab><a href="sndscm.html#superimposeffts">superimpose-ffts</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#chorus">chorus</a></em></td><td></td><td><em class=tab><a href="s7.html#funclet">funclet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maracadoc">maracas</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid">polyoid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#swapchannels">swap-channels</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cleanchannel">clean-channel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#marktointeger">mark->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoidenv">polyoid-env</a></em></td><td></td><td><em class=tab><a href="sndscm.html#swapselectionchannels">swap-selection-channels</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#cleansound">clean-sound</a></em></td><td></td><td class="green"><div class="centered">G</div></td><td></td><td><em class=tab><a href="extsnd.html#markclickhook">mark-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyoid?">polyoid?</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltodynamicvalue">symbol->dynamic-value</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clearlistener">clear-listener</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#markclickinfo">mark-click-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape">polyshape</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltovalue">symbol->value</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cliphook">clip-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#gaussiandistribution">gaussian-distribution</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcolor">mark-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polyshape?">polyshape?</a></em></td><td></td><td><em class=tab><a href="s7.html#symbolaccess">symbol-access</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clipping">clipping</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcoff">gc-off</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markcontext">mark-context</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave">polywave</a></em></td><td></td><td><em class=tab><a href="s7.html#symboltable">symbol-table</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#clmchannel">clm-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gcon">gc-on</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markdraghook">mark-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#polywave?">polywave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sync">sync</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#clmexpsrc">clm-expsrc</a></em></td><td></td><td><em class=tab><a href="sndclm.html#generators"><b>Generators</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#markexplode">mark-explode</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontox">position->x</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericsync"><b>sync (generic)</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#closehook">close-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym">gensym</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhome">mark-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positiontoy">position->y</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sync-everything">sync-everything</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#closesound">close-sound</a></em></td><td></td><td><em class=tab><a href="s7.html#gensym?">gensym?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markhook">mark-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#positioncolor">position-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncmax">sync-max</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colortolist">color->list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glgraphtops">gl-graph->ps</a></em></td><td></td><td><em class=tab><a href="sndscm.html#markloops">mark-loops</a></em></td><td></td><td><em class=tab><a href="sndscm.html#powerenv">power-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncstyle">sync-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorcutoff">color-cutoff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#glspectrogram">glSpectrogram</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markname">mark-name</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqw">pqw</a></em></td><td></td><td><em class=tab><a href="extsnd.html#syncdmarks">syncd-marks</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorhook">color-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#goertzel">goertzel</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marknametoid">mark-name->id</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">pqw-vox</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncdmixes">syncd-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorinverted">color-inverted</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gotolistenerend">goto-listener-end</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperties">mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#preferencesdialog">preferences-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#syncup">syncup</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#colormixes">color-mixes</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grani">grani</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markproperty">mark-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#previoussample">previous-sample</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colororientationdialog">color-orientation-dialog</a></em></td><td></td><td><em class=tab><a href="sndclm.html#grains"><b>Granular synthesis</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksample">mark-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printdialog">print-dialog</a></em></td><td></td><td class="green"><div class="centered">T</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorscale">color-scale</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate">granulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksync">mark-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#printlength">print-length</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colorp">color?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#granulate?">granulate?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#marksynccolor">mark-sync-color</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduredocumentation">procedure-documentation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup">table-lookup</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormap">colormap</a></em></td><td></td><td><em class=tab><a href="sndscm.html#granulatedsoundinterp">granulated-sound-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marksyncmax">mark-sync-max</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresetter">procedure-setter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#table-lookup?">table-lookup?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormaptointeger">colormap->integer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graph">graph</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagheight">mark-tag-height</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresignature">procedure-signature</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin">tanhsin</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapname">colormap-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphtops">graph->ps</a></em></td><td></td><td><em class=tab><a href="extsnd.html#marktagwidth">mark-tag-width</a></em></td><td></td><td><em class=tab><a href="s7.html#proceduresource">procedure-source</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tanhsin?">tanhsin?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapref">colormap-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcolor">graph-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markp">mark?</a></em></td><td></td><td><em class=tab><a href="s7.html#profile">profile</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap">tap</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapsize">colormap-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphcursor">graph-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#markstuff"><b>Marking</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#progressreport">progress-report</a></em></td><td></td><td><em class=tab><a href="sndclm.html#tap?">tap?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colormapp">colormap?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphdata">graph-data</a></em></td><td></td><td><em class=tab><a href="extsnd.html#emarks">marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train">pulse-train</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">telephone</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#colors"><b>Colors</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphhook">graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#matchsoundfiles">match-sound-files</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulse-train?">pulse-train?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tempdir">temp-dir</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#comb">comb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphstyle">graph-style</a></em></td><td></td><td><em class=tab><a href="sndscm.html#maxenvelope">max-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv">pulsed-env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#textfocuscolor">text-focus-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#combbank">comb-bank</a></em></td><td></td><td><em class=tab><a href="sndscm.html#grapheq">graphic equalizer</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxregions">max-regions</a></em></td><td></td><td><em class=tab><a href="sndclm.html#pulsedenv?">pulsed-env?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphstyle">time-graph-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#combbankp">comb-bank?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#graphshorizontal">graphs-horizontal</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxfftpeaks">max-transform-peaks</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#timegraphtype">time-graph-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#comb?">comb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise">green-noise</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxamp">maxamp</a></em></td><td></td><td class="green"><div class="centered">R</div></td><td></td><td><em class=tab><a href="extsnd.html#timegraphp">time-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#combineddatacolor">combined-data-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp">green-noise-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericmaxamp"><b>maxamp (generic)</b></a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#timestosamples">times->samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#comment">comment</a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise-interp?">green-noise-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampposition">maxamp-position</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos">r2k!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#tinyfont">tiny-font</a></em></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#sndwithcm"><b>Common Music</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#green-noise?">green-noise?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#maxampexamples"><b>Maxamps</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k!cos?">r2k!cos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#telephone">touch-tone</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#complexify">complexify</a></em></td><td></td><td><em class=tab><a href="extsnd.html#griddensity">grid-density</a></em></td><td></td><td><em class=tab><a href="extsnd.html#menuwidgets">menu-widgets</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos">r2k2cos</a></em></td><td></td><td><em class=tab><a href="s7.html#trace">trace</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#computeuniformcircularstring">compute-uniform-circular-string</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#menusdoc">menus, optional</a></em></td><td></td><td><em class=tab><a href="sndclm.html#r2k2cos?">r2k2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursors"><b>Tracking cursors</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#concatenateenvelopes">concatenate-envelopes</a></em></td><td></td><td class="green"><div class="centered">H</div></td><td></td><td><em class=tab><a href="extsnd.html#mindb">min-dB</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstodegrees">radians->degrees</a></em></td><td></td><td><em class=tab><a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#constantp">constant?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mix">mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#radianstohz">radians->hz</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtointeger">transform->integer</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#continuationp">continuation?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#harmonicizer">harmonicizer</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixtovct">mix->float-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rampchannel">ramp-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtovct">transform->vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#continue-frampletofile">continue-frample->file</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dht">Hartley transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtointeger">mix->integer</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand">rand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformdialog">transform-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#continue-sampletofile">continue-sample->file</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtable">hash-table</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixamp">mix-amp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp">rand-interp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformframples">transform-framples</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#contrastchannel">contrast-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablestar">hash-table*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixampenv">mix-amp-env</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand-interp?">rand-interp?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphstyle">transform-graph-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrol">contrast-control</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableentries">hash-table-entries</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixchannel">mix-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rand?">rand?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphtype">transform-graph-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolamp">contrast-control-amp</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableref">hash-table-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixclickhook">mix-click-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#random">random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformgraphp">transform-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolbounds">contrast-control-bounds</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtableset">hash-table-set!</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclickinfo">mix-click-info</a></em></td><td></td><td><em class=tab><a href="sndscm.html#allrandomnumbers"><b>Random Numbers</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#normalizefft">transform-normalization</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#contrastcontrolp">contrast-control?</a></em></td><td></td><td><em class=tab><a href="s7.html#hashtablep">hash-table?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixclicksetsamp">mix-click-sets-amp</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstate">random-state</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsample">transform-sample</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#contrast-enhancement">contrast-enhancement</a></em></td><td></td><td><em class=tab><a href="extsnd.html#headertype">header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixcolor">mix-color</a></em></td><td></td><td><em class=tab><a href="s7.html#randomstatep">random-state?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformsize">transform-size</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#contrastsound">contrast-sound</a></em></td><td></td><td><em class=tab><a href="snd.html#formats"><b>Headers and sample types</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdialogmix">mix-dialog-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos">rcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformtype">transform-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="snd.html#controls"><b>Control Panel</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#hellodentist">hello-dentist</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixdraghook">mix-drag-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rcos?">rcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#transformp">transform?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#controlstochannel">controls->channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helpdialog">help-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixfiledialog">mix-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readhook">read-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#transposemixes">transpose-mixes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolution">convolution</a></em></td><td></td><td><em class=tab><a href="extsnd.html#helphook">help-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixhome">mix-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readmixsample">read-mix-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave">triangle-wave</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolution reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#hidewidget">hide-widget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixlength">mix-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readonly">read-only</a></em></td><td></td><td><em class=tab><a href="sndclm.html#triangle-wave?">triangle-wave?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolve">convolve</a></em></td><td></td><td><em class=tab><a href="extsnd.html#highlightcolor">highlight-color</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixmaxamp">mix-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readregionsample">read-region-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubebell</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolvefiles">convolve-files</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hilberttransform">hilbert-transform</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixname">mix-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsample">read-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#tubebell">tubular bell</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolveselectionwith">convolve-selection-with</a></em></td><td></td><td><em class=tab><a href="s7.html#hookfunctions">hook-functions</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mixnametoid">mix-name->id</a></em></td><td></td><td><em class=tab><a href="extsnd.html#readsamplewithdirection">read-sample-with-direction</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole">two-pole</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#convolvewith">convolve-with</a></em></td><td></td><td><em class=tab><a href="sndscm.html#hookmember">hook-member</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixposition">mix-position</a></em></td><td></td><td><em class=tab><a href="s7.html#readercond">reader-cond</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-pole?">two-pole?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#convolve?">convolve?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndhooks"><b>Hooks</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperties">mix-properties</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin">readin</a></em></td><td></td><td><em class=tab><a href="sndscm.html#twotab">two-tab</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#s7copy">copy</a></em></td><td></td><td><em class=tab><a href="sndscm.html#html">html</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixproperty">mix-property</a></em></td><td></td><td><em class=tab><a href="sndclm.html#readin?">readin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero">two-zero</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#genericcopy"><b>copy (generic)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmldir">html-dir</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixregion">mix-region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartomagnitudes">rectangular->magnitudes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#two-zero?">two-zero?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copycontext">copy-context</a></em></td><td></td><td><em class=tab><a href="extsnd.html#htmlprogram">html-program</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixreleasehook">mix-release-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rectangulartopolar">rectangular->polar</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copysampler">copy-sampler</a></em></td><td></td><td><em class=tab><a href="sndclm.html#hztoradians">hz->radians</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsamplerQ">mix-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#redo">redo</a></em></td><td></td><td class="green"><div class="centered">U</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#copying"><b>Copying</b></a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixselection">mix-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontointeger">region->integer</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#correlate">correlate</a></em></td><td></td><td class="green"><div class="centered">I</div></td><td></td><td><em class=tab><a href="sndscm.html#mixsound">mix-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiontovct">region->vct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unbindkey">unbind-key</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#coverlet">coverlet</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mixspeed">mix-speed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionchans">region-chans</a></em></td><td></td><td><em class=tab><a href="s7.html#unboundvariablehook">*unbound-variable-hook*</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#mixdoc">cross-fade (amplitude)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter">iir-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsync">mix-sync</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionframples">region-framples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#unclipchannel">unclip-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#fadedoc">cross-fade (frequency domain)</a></em></td><td></td><td><em class=tab><a href="sndclm.html#iir-filter?">iir-filter?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixsyncmax">mix-sync-max</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regiongraphstyle">region-graph-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undo">undo</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#crosssynthesis">cross-synthesis</a></em></td><td></td><td><em class=tab><a href="extsnd.html#gin">in</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagheight">mix-tag-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionhome">region-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undoexamples"><b>Undo and Redo</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#curlet">curlet</a></em></td><td></td><td><em class=tab><a href="sndclm.html#in-any">in-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagwidth">mix-tag-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxamp">region-maxamp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#undohook">undo-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#currentfont">current-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ina">ina</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixtagy">mix-tag-y</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionmaxampposition">region-maxamp-position</a></em></td><td></td><td><em class=tab><a href="s7.html#unlet">unlet</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursor">cursor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#inb">inb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixvct">mix-vct</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionplaylist">region-play-list</a></em></td><td></td><td><em class=tab><a href="extsnd.html#unselectall">unselect-all</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorcolor">cursor-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#infodialog">info-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixwaveformheight">mix-waveform-height</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionposition">region-position</a></em></td><td></td><td><em class=tab><a href="sndscm.html#updategraphs">update-graphs</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorcontext">cursor-context</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#initladspa">init-ladspa</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixp">mix?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#regionrms">region-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatehook">update-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialbeg">initial-beg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mixes">mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsample">region-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatelispgraph">update-lisp-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorposition">cursor-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialdur">initial-dur</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sndmixes"><b>Mixing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsamplerQ">region-sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatesound">update-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorsize">cursor-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#initialgraphhook">initial-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#monotostereo">mono->stereo</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionsrate">region-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetimegraph">update-time-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorstyle">cursor-style</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndinitfile"><b>Initialization file</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#moogfilter">moog-filter</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionok">region?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#updatetransformgraph">update-transform-graph</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a></em></td><td></td><td><em class=tab><a href="s7.html#inlet">inlet</a></em></td><td></td><td><em class=tab><a href="s7.html#morallyequalp">morally-equal?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#eregions">regions</a></em></td><td></td><td><em class=tab><a href="sndscm.html#uponsaveyourself">upon-save-yourself</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cursorexamples"><b>Cursors</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#insertchannel">insert-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseclickhook">mouse-click-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#regionstuff"><b>Regions</b></a></em></td><td></td><td><em class=tab><a href="sndscm.html#sndmotifdoc">user interface extensions</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cutlet">cutlet</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertfiledialog">insert-file-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousedraghook">mouse-drag-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#remembersoundstate">remember-sound-state</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#cyclicsequences">cyclic-sequences</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertregion">insert-region</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentergraphhook">mouse-enter-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#removeclicks">remove-clicks</a></em></td><td></td><td class="green"><div class="centered">V</div></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#insertsample">insert-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlabelhook">mouse-enter-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#removefrommenu">remove-from-menu</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td class="green"><div class="centered">D</div></td><td></td><td><em class=tab><a href="extsnd.html#insertsamples">insert-samples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseenterlistenerhook">mouse-enter-listener-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#replacewithselection">replace-with-selection</a></em></td><td></td><td><em class=tab><a href="sndscm.html#variabledisplay">variable-display</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#insertselection">insert-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseentertexthook">mouse-enter-text-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reportmarknames">report-mark-names</a></em></td><td></td><td><em class=tab><a href="extsnd.html#variablegraphp">variable-graph?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dacfolding">dac-combines-channels</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsilence">insert-silence</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavegraphhook">mouse-leave-graph-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#requires7">require</a></em></td><td></td><td><em class=tab><a href="s7.html#varlet">varlet</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dacsize">dac-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertsound">insert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mouseleavelabelhook">mouse-leave-label-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resampleexamples"><b>Resampling</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vct">vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datacolor">data-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#insertionexamples"><b>Insertions</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavelistenerhook">mouse-leave-listener-hook</a></em></td><td></td><td><em class=tab><a href="sndscm.html#resetallhooks">reset-all-hooks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttimes">vct*</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datalocation">data-location</a></em></td><td></td><td><em class=tab><a href="s7.html#intvector">int-vector</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousleavetexthook">mouse-leave-text-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetcontrols">reset-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctplus">vct+</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#datasize">data-size</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorref">int-vector-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mousepresshook">mouse-press-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#resetlistenercursor">reset-listener-cursor</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttochannel">vct->channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#dbtolinear">db->linear</a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorset">int-vector-set!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-locsig">move-locsig</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reson">reson</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttolist">vct->list</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#cdebugging"><b>Debugging (C)</b></a></em></td><td></td><td><em class=tab><a href="s7.html#intvectorp">int-vector?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movemixes">move-mixes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#restorecontrols">restore-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttostring">vct->string</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#variabledisplay"><b>Debugging (instruments)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertocolormap">integer->colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound">move-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverbexamples"><b>Reverb</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vcttovector">vct->vector</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#snderrors"><b>Debugging (Scheme)</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomark">integer->mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#move-sound?">move-sound?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#*reverb*">*reverb*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctabs">vct-abs!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputchans">default-output-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertomix">integer->mix</a></em></td><td></td><td><em class=tab><a href="sndscm.html#movesyncdmarks">move-syncd-marks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbdecay">reverb-control-decay</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctadd">vct-add!</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertoregion">integer->region</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation">moving-autocorrelation</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolfeedback">reverb-control-feedback</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctcopy">vct-copy</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputsampletype">default-output-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertosound">integer->sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-autocorrelation?">moving-autocorrelation?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollength">reverb-control-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctequal">vct-equal?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defaultoutputsrate">default-output-srate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#integertotransform">integer->transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average">moving-average</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollengthbounds">reverb-control-length-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctfill">vct-fill!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#defgenerator">defgenerator</a></em></td><td></td><td><em class=tab><a href="sndscm.html#integrateenvelope">integrate-envelope</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-average?">moving-average?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrollowpass">reverb-control-lowpass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctlength">vct-length</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definestar">define*</a></em></td><td></td><td><em class=tab><a href="sndscm.html#invertfilter">invert-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft">moving-fft</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscale">reverb-control-scale</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmax">vct-max</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#defineconstant">define-constant</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndswitches"><b>Invocation flags</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-fft?">moving-fft?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolscalebounds">reverb-control-scale-bounds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmin">vct-min</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#defineenvelope">define-envelope</a></em></td><td></td><td><em class=tab><a href="s7.html#iterate">iterate</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-length">moving-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverbcontrolp">reverb-control?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmove">vct-move!</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#expansion">define-expansion</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratoratend">iterator-at-end?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max">moving-max</a></em></td><td></td><td><em class=tab><a href="s7.html#reverseb">reverse!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctmultiply">vct-multiply!</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definemacro">define-macro</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorsequence">iterator-sequence</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-max?">moving-max?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reversebyblocks">reverse-by-blocks</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctoffset">vct-offset!</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definemacrostar">define-macro*</a></em></td><td></td><td><em class=tab><a href="s7.html#iteratorp">iterator?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm">moving-norm</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversechannel">reverse-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctpeak">vct-peak</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos">izcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-norm?">moving-norm?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#reverseenvelope">reverse-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctref">vct-ref</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#definedp">defined?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#izcos?">izcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch">moving-pitch</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseselection">reverse-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctreverse">vct-reverse!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#degreestoradians">degrees->radians</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-pitch?">moving-pitch?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reversesound">reverse-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctscale">vct-scale!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delay">delay</a></em></td><td></td><td class="green"><div class="centered">J</div></td><td></td><td><em class=tab><a href="sndclm.html#moving-rms">moving-rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#reverseexamples"><b>Reversing</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctset">vct-set!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#delaychannelmixes">delay-channel-mixes</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid">moving-scentroid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#revertsound">revert-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubseq">vct-subseq</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delaytick">delay-tick</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos">j0evencos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-scentroid?">moving-scentroid?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#rightsample">right-sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctsubtract">vct-subtract!</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#delay?">delay?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0evencos?">j0evencos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum">moving-spectrum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#ring-modulate">ring-modulate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vctp">vct?</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletecolormap">delete-colormap</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos">j0j1cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-spectrum?">moving-spectrum?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos">rk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#Vcts"><b>Vcts</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletefilefilter">delete-file-filter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j0j1cos?">j0j1cos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#moving-sum">moving-sum</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!cos?">rk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#vectortovct">vector->vct</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletefilesorter">delete-file-sorter</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos">j2cos</a></em></td><td></td><td><em class=tab><a href="sndscm.html#mpg">mpg</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb">rk!ssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesamp">view-files-amp</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletemark">delete-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#j2cos?">j2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffersize">mus-alsa-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rk!ssb?">rk!ssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesampenv">view-files-amp-env</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletemarks">delete-marks</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandjack"><b>Jack</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsabuffers">mus-alsa-buffers</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos">rkcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesdialog">view-files-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesample">delete-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#jcreverb">jc-reverb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsacapturedevice">mus-alsa-capture-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkcos?">rkcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesfiles">view-files-files</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesamples">delete-samples</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos">jjcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsadevice">mus-alsa-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb">rkoddssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselecthook">view-files-select-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletesamplesandsmooth">delete-samples-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jjcos?">jjcos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsaplaybackdevice">mus-alsa-playback-device</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkoddssb?">rkoddssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesselectedfiles">view-files-selected-files</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deleteselection">delete-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos">jncos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musalsasquelchwarning">mus-alsa-squelch-warning</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin">rksin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilessort">view-files-sort</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jncos?">jncos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musarrayprintlength">mus-array-print-length</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rksin?">rksin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeed">view-files-speed</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletetransform">delete-transform</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos">jpcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musbytespersample">mus-bytes-per-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb">rkssb</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewfilesspeedstyle">view-files-speed-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#deletionexamples"><b>Deletions</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#jpcos?">jpcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channel">mus-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rkssb?">rkssb?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewmixesdialog">view-mixes-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#describehook">describe-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#justsounds">just-sounds</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-channels">mus-channels</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewregionsdialog">view-regions-dialog</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#describemark">describe-mark</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos">jycos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsgain">rms, gain, balance gens</a></em></td><td></td><td><em class=tab><a href="extsnd.html#viewsound">view-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dht">dht</a></em></td><td></td><td><em class=tab><a href="sndclm.html#jycos?">jycos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musclipping">mus-clipping</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rmsenvelope">rms-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">voice physical model</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dialogwidgets">dialog-widgets</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-close">mus-close</a></em></td><td></td><td><em class=tab><a href="s7.html#rootlet">rootlet</a></em></td><td></td><td><em class=tab><a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</a></em></td></tr>
+ <tr><td><em class=tab><a href="s7.html#dilambda">dilambda</a></em></td><td></td><td class="green"><div class="centered">K</div></td><td></td><td><em class=tab><a href="sndclm.html#mus-copy">mus-copy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp">round-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#volterrafilter">volterra-filter</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#disablecontrolpanel">disable-control-panel</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndclm.html#mus-data">mus-data</a></em></td><td></td><td><em class=tab><a href="sndclm.html#round-interp?">round-interp?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#fmvox">vox</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaybarkfft">display-bark-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos">k2cos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-describe">mus-describe</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb">rssb</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaycorrelation">display-correlation</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2cos?">k2cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrorhook">mus-error-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssbinterp">rssb-interp</a></em></td><td></td><td class="green"><div class="centered">W</div></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displaydb">display-db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin">k2sin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#muserrortypetostring">mus-error-type->string</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rssb?">rssb?</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#displayedits">display-edits</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2sin?">k2sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musexpandfilename">mus-expand-filename</a></em></td><td></td><td><em class=tab><a href="sndscm.html#rubbersound">rubber-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train">wave-train</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#displayenergy">display-energy</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb">k2ssb</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedback">mus-feedback</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndandruby"><b>Ruby</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#wave-train?">wave-train?</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dissolvefade">dissolve-fade</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k2ssb?">k2ssb?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-feedforward">mus-feedforward</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos">rxycos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavelettype">wavelet-type</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#ditherchannel">dither-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin">k3sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#fft">mus-fft</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxycos?">rxycos?</a></em></td><td></td><td><em class=tab><a href="sndscm.html#pqwvox">waveshaping voice</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dithersound">dither-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#k3sin?">k3sin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfilebuffersize">mus-file-buffer-size</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos">rxyk!cos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavohop">wavo-hop</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#dolph">dolph</a></em></td><td></td><td><em class=tab><a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musfileclipping">mus-file-clipping</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!cos?">rxyk!cos?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#wavotrace">wavo-trace</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#dot-product">dot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#key">key</a></em></td><td></td><td><em class=tab><a href="sndscm.html#musfilemix">mus-file-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin">rxyk!sin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#weighted-moving-average">weighted-moving-average</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#dotsize">dot-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keybinding">key-binding</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-file-name">mus-file-name</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxyk!sin?">rxyk!sin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetposition">widget-position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#downoct">down-oct</a></em></td><td></td><td><em class=tab><a href="extsnd.html#keypresshook">key-press-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musfloatequalfudgefactor">mus-float-equal-fudge-factor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin">rxysin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgetsize">widget-size</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawaxes">draw-axes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin">krksin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-frequency">mus-frequency</a></em></td><td></td><td><em class=tab><a href="sndclm.html#rxysin?">rxysin?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#widgettext">widget-text</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawdot">draw-dot</a></em></td><td></td><td><em class=tab><a href="sndclm.html#krksin?">krksin?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#musgeneratorp">mus-generator?</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#movingwindows"><b>Window size and position</b></a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawdots">draw-dots</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musheaderrawdefaults">mus-header-raw-defaults</a></em></td><td></td><td class="green"><div class="centered">S</div></td><td></td><td><em class=tab><a href="extsnd.html#windowheight">window-height</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawline">draw-line</a></em></td><td></td><td class="green"><div class="centered">L</div></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypetostring">mus-header-type->string</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="sndscm.html#windowsamples">window-samples</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawlines">draw-lines</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#musheadertypename">mus-header-type-name</a></em></td><td></td><td><em class=tab><a href="s7.html#s7doc"><b>s7 scheme</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowwidth">window-width</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawmarkhook">draw-mark-hook</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#ladspadescriptor">ladspa-descriptor</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-hop">mus-hop</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sample">sample</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowx">window-x</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawmixhook">draw-mix-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ladspadir">ladspa-dir</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-increment">mus-increment</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile">sample->file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#windowy">window-y</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drawstring">draw-string</a></em></td><td></td><td><em class=tab><a href="s7.html#lambdastar">lambda*</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-input?">mus-input?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sampletofile?">sample->file?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withbackgroundprocesses">with-background-processes</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#drone">drone</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lbjpiano">lbj-piano</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interp-type">mus-interp-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampletype">sample-type</a></em></td><td></td><td><em class=tab><a href="s7.html#withbaffle">with-baffle</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#makedropsite">drop sites</a></em></td><td></td><td><em class=tab><a href="extsnd.html#leftsample">left-sample</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-interpolate">mus-interpolate</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sampleratendQ">sampler-at-end?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withfilemonitor">with-file-monitor</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#drophook">drop-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#genericlength"><b>length (generic)</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-length">mus-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerhome">sampler-home</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withgl">with-gl</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#duringopenhook">during-open-hook</a></em></td><td></td><td><em class=tab><a href="s7.html#lettolist">let->list</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-location">mus-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerposition">sampler-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinsetgraph">with-inset-graph</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#letref">let-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxmalloc">mus-max-malloc</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplerQ">sampler?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withinterrupts">with-interrupts</a></em></td></tr>
+ <tr><td class="green"><div class="centered">E</div></td><td></td><td><em class=tab><a href="s7.html#letset">let-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musmaxtablesize">mus-max-table-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samplers"><b>samplers</b></a></em></td><td></td><td><em class=tab><a href="s7.html#with-let">with-let</a></em></td></tr>
+ <tr><td><em class=tab> </em></td><td></td><td><em class=tab><a href="s7.html#letp">let?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-name">mus-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#samples">samples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withlocalhook">with-local-hook</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editlists"><b>Edit lists</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#lineartodb">linear->db</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-offset">mus-offset</a></em></td><td></td><td><em class=tab><a href="sndclm.html#samplestoseconds">samples->seconds</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmenuicons">with-menu-icons</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editfragment">edit-fragment</a></em></td><td></td><td><em class=tab><a href="sndscm.html#linearsrcchannel">linear-src-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-order">mus-order</a></em></td><td></td><td><em class=tab><a href="extsnd.html#sashcolor">sash-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withmixtags">with-mix-tags</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editheaderdialog">edit-header-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lintdoc">lint for scheme</a></em></td><td></td><td><em class=tab><a href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogautocomment">save-as-dialog-auto-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withpointerfocus">with-pointer-focus</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edithook">edit-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphhook">lisp-graph-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-output?">mus-output?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveasdialogsrc">save-as-dialog-src</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withrelativepanes">with-relative-panes</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editlisttofunction">edit-list->function</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphstyle">lisp-graph-style</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-phase">mus-phase</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savecontrols">save-controls</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withsmptelabel">with-smpte-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editposition">edit-position</a></em></td><td></td><td><em class=tab><a href="extsnd.html#lispgraphp">lisp-graph?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-ramp">mus-ramp</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savedir">save-dir</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withsound">with-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editproperties">edit-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtofv">list->float-vector</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-rand-seed">mus-rand-seed</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveedithistory">save-edit-history</a></em></td><td></td><td><em class=tab><a href="sndscm.html#withtemporaryselection">with-temporary-selection</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#editproperty">edit-property</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listtovct">list->vct</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-random">mus-random</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveenvelopes">save-envelopes</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtoolbar">with-toolbar</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edittree">edit-tree</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#listladspa">list-ladspa</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-reset">mus-reset</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savehook">save-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtooltips">with-tooltips</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#edits">edits</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerclickhook">listener-click-hook</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-run">mus-run</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savelistener">save-listener</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#edot-product">edot-product</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolor">listener-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypetostring">mus-sample-type->string</a></em></td><td></td><td><em class=tab><a href="sndscm.html#savemarkproperties">save-mark-properties</a></em></td><td></td><td><em class=tab><a href="extsnd.html#withverbosecursor">with-verbose-cursor</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#effectshook">effects-hook</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenercolorized">listener-colorized</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussampletypename">mus-sample-type-name</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemarks">save-marks</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#analogfilterdoc">elliptic filters</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerfont">listener-font</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-scaler">mus-scaler</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savemix">save-mix</a></em></td><td></td><td class="green"><div class="centered">X</div></td></tr>
+ <tr><td><em class=tab><a href="grfsnd.html#emacssnd"><b>Emacs and Snd</b></a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerprompt">listener-prompt</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundchans">mus-sound-chans</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregion">save-region</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env">env</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenerselection">listener-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseinput">mus-sound-close-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveregiondialog">save-region-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xtoposition">x->position</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env-any">env-any</a></em></td><td></td><td><em class=tab><a href="extsnd.html#listenertextcolor">listener-text-color</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcloseoutput">mus-sound-close-output</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselection">save-selection</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxislabel">x-axis-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envchannel">env-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#littleendianp">little-endian?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundcomment">mus-sound-comment</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveselectiondialog">save-selection-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xaxisstyle">x-axis-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envchannelwithbase">env-channel-with-base</a></em></td><td></td><td><em class=tab><a href="s7.html#loadhook">*load-hook*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatalocation">mus-sound-data-location</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesound">save-sound</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xbounds">x-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envexptchannel">env-expt-channel</a></em></td><td></td><td><em class=tab><a href="s7.html#loadpath">*load-path*</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussounddatumsize">mus-sound-datum-size</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesoundas">save-sound-as</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xpositionslider">x-position-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env-interp">env-interp</a></em></td><td></td><td><em class=tab><a href="sndscm.html#locatezero">locate-zero</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundduration">mus-sound-duration</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savesounddialog">save-sound-dialog</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xzoomslider">x-zoom-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envmixes">env-mixes</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig">locsig</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundforget">mus-sound-forget</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestate">save-state</a></em></td><td></td><td><em class=tab><a href="sndscm.html#xbopen">xb-open</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envselection">env-selection</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-ref">locsig-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundframples">mus-sound-framples</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatefile">save-state-file</a></em></td><td></td><td><em class=tab><a href="extsnd.html#xrampchannel">xramp-channel</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envsound">env-sound</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-ref">locsig-reverb-ref</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundheadertype">mus-sound-header-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#savestatehook">save-state-hook</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envsoundinterp">env-sound-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-reverb-set!">locsig-reverb-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundlength">mus-sound-length</a></em></td><td></td><td><em class=tab><a href="extsnd.html#saveexamples"><b>Saving</b></a></em></td><td></td><td class="green"><div class="centered">Y</div></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envsquaredchannel">env-squared-channel</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-set!">locsig-set!</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sgfilter">savitzky-golay-filter</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#env?">env?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig-type">locsig-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmarkinfo">mus-sound-mark-info</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave">sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ytoposition">y->position</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedbase">enved-base</a></em></td><td></td><td><em class=tab><a href="sndclm.html#locsig?">locsig?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#sawtooth-wave?">sawtooth-wave?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yaxislabel">y-axis-label</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedclipping">enved-clip?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#logfreqstart">log-freq-start</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundmaxampexists">mus-sound-maxamp-exists?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleby">scale-by</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ybounds">y-bounds</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#enveddialog">enved-dialog</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpccoeffs">lpc-coeffs</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopeninput">mus-sound-open-input</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scalechannel">scale-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#ypositionslider">y-position-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedenvelope">enved-envelope</a></em></td><td></td><td><em class=tab><a href="sndscm.html#lpcpredict">lpc-predict</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundopenoutput">mus-sound-open-output</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaleenvelope">scale-envelope</a></em></td><td></td><td><em class=tab><a href="extsnd.html#yzoomslider">y-zoom-slider</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#filterenv">enved-filter</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpath">mus-sound-path</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalemixes">scale-mixes</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#filterenvorder">enved-filter-order</a></em></td><td></td><td class="green"><div class="centered">M</div></td><td></td><td><em class=tab><a href="extsnd.html#mussoundpreload">mus-sound-preload</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionby">scale-selection-by</a></em></td><td></td><td class="green"><div class="centered">Z</div></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedhook">enved-hook</a></em></td><td></td><td><em class=tab> </em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundprune">mus-sound-prune</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleselectionto">scale-selection-to</a></em></td><td></td><td><em class=tab> </em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedin-dB">enved-in-dB</a></em></td><td></td><td><em class=tab><a href="s7.html#macrop">macro?</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundread">mus-sound-read</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scalesound">scale-sound</a></em></td><td></td><td><em class=tab><a href="sndscm.html#ztransform">z-transform</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedpower">enved-power</a></em></td><td></td><td><em class=tab><a href="s7.html#macroexpand">macroexpand</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreopenoutput">mus-sound-reopen-output</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scaletempo">scale-tempo</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zecho">zecho</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedstyle">enved-style</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainmenu">main-menu</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundreportcache">mus-sound-report-cache</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scaleto">scale-to</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zeroplus">zero+</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedtarget">enved-target</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mainwidgets">main-widgets</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsampletype">mus-sound-sample-type</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scanchannel">scan-channel</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zeropad">zero-pad</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-abcos">make-abcos</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsamples">mus-sound-samples</a></em></td><td></td><td><em class=tab><a href="sndscm.html#dspdocscanned">scanned synthesis</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zerophase">zero-phase</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-absin">make-absin</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundseekframple">mus-sound-seek-frample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scentroid">scentroid</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipsound">zip-sound</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundsrate">mus-sound-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#scratch">scratch</a></em></td><td></td><td><em class=tab><a href="sndscm.html#zipper">zipper</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndscm.html#envelopedmix">enveloped-mix</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-square-wave">make-adjustable-square-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundtypespecifier">mus-sound-type-specifier</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptarg">script-arg</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomcolor">zoom-color</a></em></td></tr>
+ <tr><td><em class=tab><a href="extsnd.html#envexamples"><b>Envelopes</b></a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-adjustable-triangle-wave">make-adjustable-triangle-wave</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwrite">mus-sound-write</a></em></td><td></td><td><em class=tab><a href="extsnd.html#scriptargs">script-args</a></em></td><td></td><td><em class=tab><a href="extsnd.html#zoomfocusstyle">zoom-focus-style</a></em></td></tr>
+ <tr><td><em class=tab><a href="sndclm.html#eoddcos">eoddcos</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-all-pass">make-all-pass</a></em></td><td></td><td><em class=tab><a href="extsnd.html#mussoundwritedate">mus-sound-write-date</a></em></td><td></td><td><em class=tab><a href="grfsnd.html#sndwithnogui"><b>Scripting</b></a></em></td><td></td>
</tr>
- <tr><td><em class=tab><a href="extsnd.html#envedwaving">enved-wave?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-formant">make-formant</a></em></td><td></td><td><em class=tab><a href="sndscm.html#nextframe">next-frame</a></em></td><td></td><td><em class=tab><a href="sndscm.html#sineramp">sine-ramp</a></em></td><td></td>
+ <tr><td><em class=tab><a href="sndclm.html#eoddcos?">eoddcos?</a></em></td><td></td><td><em class=tab><a href="sndclm.html#makeallpassbank">make-all-pass-bank</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mussrate">mus-srate</a></em></td><td></td><td><em class=tab><a href="sndscm.html#searchforclick">search-for-click</a></em></td><td></td>
</tr>
- <tr><td><em class=tab><a href="extsnd.html#envedwaveformcolor">enved-waveform-color</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frame">make-frame</a></em></td><td></td><td><em class=tab><a href="extsnd.html#nextsample">next-sample</a></em></td><td></td><td><em class=tab><a href="sndscm.html#singerdoc">singer</a></em></td><td></td>
+ <tr><td><em class=tab><a href="extsnd.html#epsbottommargin">eps-bottom-margin</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asyfm">make-asyfm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-width">mus-width</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchprocedure">search-procedure</a></em></td><td></td>
</tr>
- <tr><td><em class=tab><a href="sndscm.html#envelopeinterp">envelope-interp</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-frame!">make-frame!</a></em></td><td></td><td><em class=tab><a href="sndclm.html#noid">noid</a></em></td><td></td><td><em class=tab><a href="extsnd.html#smoothchannel">smooth-channel</a></em></td><td></td>
+ <tr><td><em class=tab><a href="extsnd.html#epsfile">eps-file</a></em></td><td></td><td><em class=tab><a href="sndclm.html#make-asymmetric-fm">make-asymmetric-fm</a></em></td><td></td><td><em class=tab><a href="sndclm.html#mus-xcoeff">mus-xcoeff</a></em></td><td></td><td><em class=tab><a href="extsnd.html#searchexamples"><b>Searching</b></a></em></td><td></td>
</tr>
</table>
diff --git a/index.scm b/index.scm
index f9ca6bf..f0c3eb6 100644
--- a/index.scm
+++ b/index.scm
@@ -2,69 +2,48 @@
(provide 'snd-index.scm)
-(define (html obj)
- "(html arg) where arg can be a string, symbol, or procedure looks for a corresponding url
-and if one is found, and the Snd documentation can be found, calls (html-program) with that url"
- (letrec ((find-close-paren
- (lambda (str)
- (let loop ((pos 0)) ;from slib/strsrch.scm
- (cond
- ((>= pos (string-length str)) #f)
- ((char=? #\) (string-ref str pos)) pos)
- ((char=? #\space (string-ref str pos)) pos)
- (else (loop (+ 1 pos)))))))
-
- (goto-html
- (lambda (n)
- ;; look for doc on current dir, then html dir, then global dir
- ;; snd.html is what we'll search for
- (let ((dir (if (file-exists? "snd.html")
- (getcwd)
- (if (and (string? (html-dir))
- (file-exists? (string-append (html-dir) "/snd.html")))
- (html-dir)
- (if (file-exists? "/usr/share/doc/snd-12/snd.html")
- "/usr/share/doc/snd-12"
- (if (file-exists? "/usr/local/share/doc/snd-12/snd.html")
- "/usr/local/share/doc/snd-12"
- (if (file-exists? "/usr/doc/snd-12/snd.html")
- "/usr/doc/snd-12"
- (if (file-exists? "/usr/share/doc/snd-11/snd.html")
- "/usr/share/doc/snd-11"
- (if (file-exists? "/usr/local/share/doc/snd-11/snd.html")
- "/usr/local/share/doc/snd-11"
- (if (file-exists? "/usr/doc/snd-11/snd.html")
- "/usr/doc/snd-11"
- #f))))))))))
- (if dir
- (system (string-append (html-program) " file:" dir "/" n)))))))
-
- (let ((name (if (string? obj)
- obj
- (if (symbol? obj)
- (symbol->string obj)
- (let ((doc (if (procedure? obj)
- (or (procedure-property obj 'documentation)
- (procedure-documentation obj)
- (object-property obj 'documentation))
- (object-property obj 'documentation))))
- (if (and (string? doc)
- (char=? (string-ref doc 0) #\())
- (let ((pos (find-close-paren doc)))
- (if pos
- (substring doc 1 pos)
- #f))))))))
- (if (and name (string? name))
- (let ((url (snd-url name)))
- (if url
- (goto-html url)
- (snd-print (format #f "no url for ~A?" name))))
- (snd-print (format #f "no doc for ~A?" name))))))
-
-
-(define (? obj)
- "(? obj) prints out any help it can find for obj, and tries to find obj in the docs via firefox, netscape or mozilla"
- (let ((hlp (snd-help obj)))
- (if (string? hlp)
- (snd-print hlp))
- (html obj)))
+(define html
+ (let ((documentation "(html arg) where arg can be a string, symbol, or procedure looks for a corresponding url
+and if one is found, and the Snd documentation can be found, calls *html-program* with that url"))
+ (lambda (obj)
+ (let ((goto-html
+ (lambda (n)
+ ;; look for doc on current dir, then html dir, then global dir
+ ;; snd.html is what we'll search for
+ (let ((dir (if (file-exists? "snd.html")
+ (getcwd)
+ (if (and (string? *html-dir*)
+ (file-exists? (string-append *html-dir* "/snd.html")))
+ *html-dir*
+ (if (file-exists? "/usr/share/doc/snd-16/snd.html")
+ "/usr/share/doc/snd-16"
+ (if (file-exists? "/usr/local/share/doc/snd-16/snd.html")
+ "/usr/local/share/doc/snd-16"
+ (if (file-exists? "/usr/doc/snd-16/snd.html")
+ "/usr/doc/snd-16"
+ (if (file-exists? "/usr/share/doc/snd-15/snd.html")
+ "/usr/share/doc/snd-15"
+ (if (file-exists? "/usr/local/share/doc/snd-15/snd.html")
+ "/usr/local/share/doc/snd-15"
+ (and (file-exists? "/usr/doc/snd-15/snd.html")
+ "/usr/doc/snd-15"))))))))))
+ (if dir
+ (system (string-append *html-program* " file:" dir "/" n)))))))
+
+ (let ((name (if (string? obj)
+ obj
+ (if (symbol? obj)
+ (symbol->string obj)
+ (let ((doc (and (procedure? obj)
+ (procedure-documentation obj))))
+ (if (and (string? doc)
+ (char=? (doc 0) #\())
+ (let ((pos (char-position ") " doc)))
+ (and pos
+ (substring doc 1 pos)))))))))
+ (if (and name (string? name))
+ (let ((url (snd-url name)))
+ (if url
+ (goto-html url)
+ (snd-print (format #f "no url for ~A?" name))))
+ (snd-print (format #f "no doc for ~A?" name))))))))
diff --git a/io.c b/io.c
index c15faca..c078535 100644
--- a/io.c
+++ b/io.c
@@ -1,4 +1,4 @@
-#include <mus-config.h>
+#include "mus-config.h"
#if (defined(__GNUC__)) && (!(defined(__cplusplus)))
#define _GNU_SOURCE
@@ -11,29 +11,19 @@
#include <math.h>
#include <stdio.h>
-#if HAVE_FCNTL_H
- #include <fcntl.h>
-#endif
-#if HAVE_LIMITS_H
- #include <limits.h>
-#endif
+#include <fcntl.h>
+#include <limits.h>
#include <errno.h>
#include <stdlib.h>
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
#else
- #if (!(defined(_MSC_VER)))
- #include <unistd.h>
- #endif
-#endif
-#if HAVE_STRING_H
- #include <string.h>
+ #include <io.h>
+ #pragma warning(disable: 4244)
#endif
+#include <string.h>
#include <stdarg.h>
-#if HAVE_PTHREAD_H
- #include <pthread.h>
-#endif
#ifdef _MSC_VER
#include <direct.h>
@@ -43,36 +33,23 @@
#include "_sndlib.h"
-
-/* ---------------------------------------- */
-/* in io.c but not in _sndlib.h (these are now internal to sndlib, but I don't like the C-oid "_" prefix): */
-void mus_bint_to_char(unsigned char *j, int x);
-int mus_char_to_bint(const unsigned char *inp);
-void mus_lint_to_char(unsigned char *j, int x);
-int mus_char_to_lint(const unsigned char *inp);
-mus_long_t mus_char_to_llong(const unsigned char *inp);
-mus_long_t mus_char_to_blong(const unsigned char *inp);
-int mus_char_to_uninterpreted_int(const unsigned char *inp);
-void mus_bfloat_to_char(unsigned char *j, float x);
-float mus_char_to_bfloat(const unsigned char *inp);
-void mus_lfloat_to_char(unsigned char *j, float x);
-float mus_char_to_lfloat(const unsigned char *inp);
-void mus_bshort_to_char(unsigned char *j, short x);
-short mus_char_to_bshort(const unsigned char *inp);
-void mus_lshort_to_char(unsigned char *j, short x);
-short mus_char_to_lshort(const unsigned char *inp);
-unsigned short mus_char_to_ubshort(const unsigned char *inp);
-unsigned short mus_char_to_ulshort(const unsigned char *inp);
-double mus_char_to_ldouble(const unsigned char *inp);
-double mus_char_to_bdouble(const unsigned char *inp);
-void mus_bdouble_to_char(unsigned char *j, double x);
-void mus_blong_to_char(unsigned char *j, mus_long_t x);
-void mus_llong_to_char(unsigned char *j, mus_long_t x);
-unsigned int mus_char_to_ubint(const unsigned char *inp);
-unsigned int mus_char_to_ulint(const unsigned char *inp);
-/* ---------------------------------------- */
-
-
+#define HAVE_BYTESWAP_H __linux__
+
+#define MUS_BYTE_TO_SAMPLE(n) (((mus_float_t)(n) / (mus_float_t)(1 << 7)))
+#define MUS_SHORT_TO_SAMPLE(n) (((mus_float_t)(n) / (mus_float_t)(1 << 15)))
+#define MUS_INT_TO_SAMPLE(n) (((mus_float_t)(n) / (mus_float_t)(1 << 23)))
+#define MUS_INT24_TO_SAMPLE(n) (((mus_float_t)(n) / (mus_float_t)(1 << 23)))
+#define MUS_SAMPLE_TO_INT(n) ((int)((n) * (1 << 23)))
+#define MUS_SAMPLE_TO_INT24(n) ((int)((n) * (1 << 23)))
+#define MUS_SAMPLE_TO_SHORT(n) ((short)((n) * (1 << 15)))
+#define MUS_SAMPLE_TO_BYTE(n) ((char)((n) * (1 << 7)))
+#if defined(__x86_64__) || defined(__i386__)
+ #define BINT24_TO_SAMPLE(n) ((mus_float_t)(big_endian_int(jchar) >> 8) / (mus_float_t)(1 << 23))
+ #define INT24_TO_SAMPLE(n) ((mus_float_t)(little_endian_int(jchar) >> 8) / (mus_float_t)(1 << 23))
+#else
+ #define BINT24_TO_SAMPLE(n) ((mus_float_t)(mus_char_to_bint(jchar) >> 8) / (mus_float_t)(1 << 23))
+ #define INT24_TO_SAMPLE(n) ((mus_float_t)(mus_char_to_lint(jchar) >> 8) / (mus_float_t)(1 << 23))
+#endif
static mus_long_t mus_maximum_malloc = MUS_MAX_MALLOC_DEFAULT;
@@ -449,8 +426,20 @@ unsigned int mus_char_to_ulint(const unsigned char *inp)
#define big_endian_unsigned_short(n) (mus_char_to_ubshort(n))
#endif
- #define big_endian_float(n) (mus_char_to_bfloat(n))
- #define big_endian_double(n) (mus_char_to_bdouble(n))
+#if __GNUC__ && HAVE_BYTESWAP_H
+ /* these work, but newer versions of gcc complain about strict aliasing rules
+ * #define big_endian_float(n) ({unsigned int x; x = bswap_32((*((unsigned int *)n))); (*((float *)&x));})
+ * #define big_endian_double(n) ({unsigned long long int x; x = bswap_64((*((unsigned long long int *)n))); (*((double *)&x));})
+ */
+ typedef struct {union {unsigned int i; float f;} u;} uiflt;
+ typedef struct {union {unsigned long long int l; double d;} u;} uidbl;
+
+ #define big_endian_float(n) ({uiflt x; x.u.i = bswap_32((*((unsigned int *)n))); x.u.f;})
+ #define big_endian_double(n) ({uidbl x; x.u.l = bswap_64((*((unsigned long long int *)n))); x.u.d;})
+#else
+ #define big_endian_float(n) (mus_char_to_bfloat(n))
+ #define big_endian_double(n) (mus_char_to_bdouble(n))
+#endif
#define little_endian_short(n) (*((short *)n))
#define little_endian_int(n) (*((int *)n))
@@ -514,8 +503,14 @@ unsigned int mus_char_to_ulint(const unsigned char *inp)
#define little_endian_int(n) (mus_char_to_lint(n))
#define little_endian_unsigned_short(n) (mus_char_to_ulshort(n))
#endif
- #define little_endian_float(n) (mus_char_to_lfloat(n))
- #define little_endian_double(n) (mus_char_to_ldouble(n))
+
+#if __GNUC__ && HAVE_BYTESWAP_H
+ #define little_endian_float(n) ({unsigned int x; x = bswap_32((*((unsigned int *)n))); (*((float *)&x));})
+ #define little_endian_double(n) ({unsigned long long int x; x = bswap_64((*((unsigned long long int *)n))); (*((double *)&x));})
+#else
+ #define little_endian_float(n) (mus_char_to_lfloat(n))
+ #define little_endian_double(n) (mus_char_to_ldouble(n))
+#endif
#if HAVE_BYTESWAP_H
#define set_little_endian_short(n, x) (*((short *)n)) = ((short)(bswap_16(x)))
@@ -539,34 +534,47 @@ bool mus_clipping(void) {return(clipping_default);}
bool mus_set_clipping(bool new_value) {clipping_default = new_value; return(new_value);}
-static mus_float_t prescaler_default = 1.0;
-mus_float_t mus_prescaler(void) {return(prescaler_default);}
-mus_float_t mus_set_prescaler(mus_float_t new_value) {prescaler_default = new_value; return(new_value);}
-
-
typedef struct {
char *name;
- int data_format, bytes_per_sample, chans, header_type;
+ mus_sample_t sample_type;
+ mus_header_t header_type;
+ int bytes_per_sample, chans;
bool clipping;
mus_long_t data_location;
- mus_float_t prescaler;
+ bool saved;
+ mus_long_t framples;
+ mus_float_t **saved_data;
+ void *next;
} io_fd;
+static io_fd *io_fd_free_list = NULL;
+
+static io_fd *io_fd_alloc(void)
+{
+ if (io_fd_free_list)
+ {
+ io_fd *p;
+ p = io_fd_free_list;
+ io_fd_free_list = (io_fd *)(p->next);
+ return(p);
+ }
+ return((io_fd *)malloc(sizeof(io_fd)));
+}
+
+static void io_fd_free(io_fd *p)
+{
+ p->next = (void *)io_fd_free_list;
+ io_fd_free_list = p;
+}
+
static int io_fd_size = 0;
static io_fd **io_fds = NULL;
#define IO_FD_ALLOC_SIZE 8
-#if HAVE_PTHREADS
- static mus_lock_t io_table_lock = MUS_LOCK_INITIALIZER;
-#endif
-
-int mus_file_open_descriptors(int tfd, const char *name, int format, int size /* datum size */, mus_long_t location, int chans, int type)
+int mus_file_open_descriptors(int tfd, const char *name, mus_sample_t samp_type, int size /* datum size */, mus_long_t location, int chans, mus_header_t type)
{
int err = MUS_NO_ERROR;
-
- MUS_LOCK(&io_table_lock);
-
if (io_fd_size == 0)
{
io_fd_size = tfd + IO_FD_ALLOC_SIZE;
@@ -585,32 +593,58 @@ int mus_file_open_descriptors(int tfd, const char *name, int format, int size /*
}
if (io_fds[tfd] == NULL)
- io_fds[tfd] = (io_fd *)calloc(1, sizeof(io_fd));
+ io_fds[tfd] = io_fd_alloc();
if (io_fds[tfd])
{
io_fd *fd;
fd = io_fds[tfd];
- fd->data_format = format;
+ fd->framples = 0;
+ fd->sample_type = samp_type;
fd->bytes_per_sample = size;
fd->data_location = location;
fd->clipping = clipping_default;
- fd->prescaler = prescaler_default;
fd->header_type = type;
fd->chans = chans;
+ fd->saved = false;
+ fd->saved_data = NULL;
if (name)
{
- fd->name = (char *)calloc(strlen(name) + 1, sizeof(char));
+ int len;
+ len = strlen(name);
+ fd->name = (char *)malloc((len + 1) * sizeof(char));
strcpy(fd->name, name);
+ fd->name[len] = 0;
}
+ else fd->name = NULL;
}
else err = MUS_MEMORY_ALLOCATION_FAILED;
}
else err = MUS_MEMORY_ALLOCATION_FAILED;
+ return(err);
+}
- MUS_UNLOCK(&io_table_lock);
- return(err);
+void scan_io_fds_for_saved_data(mus_float_t **data);
+void scan_io_fds_for_saved_data(mus_float_t **data)
+{
+ if ((io_fds) &&
+ (io_fd_size > 0))
+ {
+ int i;
+ for (i = 0; i < io_fd_size; i++)
+ {
+ io_fd *fd;
+ fd = io_fds[i];
+ if ((fd) &&
+ (fd->saved) &&
+ (fd->saved_data == data))
+ {
+ fd->saved = false;
+ fd->saved_data = NULL;
+ }
+ }
+ }
}
@@ -633,7 +667,7 @@ int mus_file_set_clipping(int tfd, bool clipped)
}
-int mus_file_set_header_type(int tfd, int type)
+int mus_file_set_header_type(int tfd, mus_header_t type)
{
io_fd *fd;
if ((io_fds == NULL) || (tfd >= io_fd_size) || (tfd < 0) || (io_fds[tfd] == NULL)) return(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED);
@@ -643,34 +677,15 @@ int mus_file_set_header_type(int tfd, int type)
}
-int mus_file_header_type(int tfd)
+mus_header_t mus_file_header_type(int tfd)
{
io_fd *fd;
- if ((io_fds == NULL) || (tfd >= io_fd_size) || (tfd < 0) || (io_fds[tfd] == NULL)) return(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED);
+ if ((io_fds == NULL) || (tfd >= io_fd_size) || (tfd < 0) || (io_fds[tfd] == NULL)) return(MUS_UNKNOWN_HEADER);
fd = io_fds[tfd];
return(fd->header_type);
}
-mus_float_t mus_file_prescaler(int tfd)
-{
- io_fd *fd;
- if ((io_fds == NULL) || (tfd >= io_fd_size) || (tfd < 0) || (io_fds[tfd] == NULL)) return(0.0);
- fd = io_fds[tfd];
- return(fd->prescaler);
-}
-
-
-mus_float_t mus_file_set_prescaler(int tfd, mus_float_t val)
-{
- io_fd *fd;
- if ((io_fds == NULL) || (tfd >= io_fd_size) || (tfd < 0) || (io_fds[tfd] == NULL)) return(0.0);
- fd = io_fds[tfd];
- fd->prescaler = val;
- return(val);
-}
-
-
char *mus_file_fd_name(int tfd)
{
io_fd *fd;
@@ -690,12 +705,28 @@ int mus_file_set_chans(int tfd, int chans)
}
+void mus_file_save_data(int tfd, mus_long_t framples, mus_float_t **data)
+{
+ io_fd *fd;
+ fd = io_fds[tfd];
+ if (!fd->saved)
+ {
+ /* fprintf(stderr, "mus_file_save_data %d\n", tfd); */
+
+ fd->saved = true;
+ fd->framples = framples;
+ fd->saved_data = data;
+ }
+}
+
+
+
/* ---------------- open, creat, close ---------------- */
int mus_file_open_read(const char *arg)
{
int fd;
-#if HAVE_WINDOZE
+#if (defined(_MSC_VER) || __CYGWIN__)
fd = OPEN(arg, O_RDONLY | O_BINARY, 0);
#else
fd = OPEN(arg, O_RDONLY, 0);
@@ -706,7 +737,7 @@ int mus_file_open_read(const char *arg)
bool mus_file_probe(const char *arg)
{
-#if HAVE_ACCESS
+#ifndef _MSC_VER
if (!arg) return(false);
return(access(arg, F_OK) == 0);
#else
@@ -726,7 +757,7 @@ bool mus_file_probe(const char *arg)
int mus_file_open_write(const char *arg)
{
int fd;
-#if HAVE_WINDOZE
+#if (defined(_MSC_VER) || __CYGWIN__)
if ((fd = OPEN(arg, O_RDWR | O_BINARY, 0)) == -1)
fd = CREAT(arg, S_IREAD | S_IWRITE); /* 0x0100 | 0x0080 */
#else
@@ -740,7 +771,7 @@ int mus_file_open_write(const char *arg)
int mus_file_create(const char *arg)
{
-#if HAVE_WINDOZE
+#if (defined(_MSC_VER ) || __CYGWIN__)
return(CREAT(arg, S_IREAD | S_IWRITE));
#else
return(CREAT(arg, 0666));
@@ -751,7 +782,7 @@ int mus_file_create(const char *arg)
int mus_file_reopen_write(const char *arg)
{
int fd;
-#if HAVE_WINDOZE
+#if (defined(_MSC_VER) || __CYGWIN__)
fd = OPEN(arg, O_RDWR | O_BINARY, 0);
#else
fd = OPEN(arg, O_RDWR, 0);
@@ -763,12 +794,11 @@ int mus_file_reopen_write(const char *arg)
int mus_file_close(int fd)
{
io_fd *fdp;
+#if (!USE_SND)
int close_result = 0;
+#endif
if ((io_fds == NULL) || (fd >= io_fd_size) || (fd < 0) || (io_fds[fd] == NULL)) return(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED);
-
- MUS_LOCK(&io_table_lock);
-
fdp = io_fds[fd];
#if USE_SND
@@ -778,13 +808,13 @@ int mus_file_close(int fd)
#endif
if (fdp->name) {free(fdp->name); fdp->name = NULL;}
- free(fdp);
+ io_fd_free(fdp);
io_fds[fd] = NULL;
- MUS_UNLOCK(&io_table_lock);
-
+#if (!USE_SND)
if (close_result < 0)
return(MUS_CANT_CLOSE_FILE);
+#endif
return(MUS_NO_ERROR);
}
@@ -792,25 +822,25 @@ int mus_file_close(int fd)
/* ---------------- seek ---------------- */
-mus_long_t mus_file_seek_frame(int tfd, mus_long_t frame)
+mus_long_t mus_file_seek_frample(int tfd, mus_long_t frample)
{
io_fd *fd;
if (io_fds == NULL)
- return(mus_error(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, "mus_file_seek_frame: no file descriptors!"));
+ return(mus_error(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, "mus_file_seek_frample: no file descriptors!"));
if (tfd >= io_fd_size)
return(mus_error(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED,
- "mus_file_seek_frame: file descriptors not realloc'd? (tfd: %d, io_fd_size: %d)", tfd, io_fd_size));
+ "mus_file_seek_frample: file descriptors not realloc'd? (tfd: %d, io_fd_size: %d)", tfd, io_fd_size));
if ((tfd < 0) ||
(io_fds[tfd] == NULL))
- return(mus_error(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, "mus_file_seek_frame: file descriptor = %d?", tfd));
+ return(mus_error(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, "mus_file_seek_frample: file descriptor = %d?", tfd));
fd = io_fds[tfd];
- if (fd->data_format == MUS_UNKNOWN)
- return(mus_error(MUS_NOT_A_SOUND_FILE, "mus_file_seek_frame: invalid data format for %s", fd->name));
+ if (fd->sample_type == MUS_UNKNOWN_SAMPLE)
+ return(mus_error(MUS_NOT_A_SOUND_FILE, "mus_file_seek_frample: invalid sample type for %s", fd->name));
- return(lseek(tfd, fd->data_location + (fd->chans * frame * fd->bytes_per_sample), SEEK_SET));
+ return(lseek(tfd, fd->data_location + (fd->chans * frample * fd->bytes_per_sample), SEEK_SET));
}
@@ -851,7 +881,7 @@ static unsigned char to_alaw(int pcm_val)
}
#define A_(a) MUS_SHORT_TO_SAMPLE(a)
-static const mus_sample_t mus_alaw[256] = {
+static const mus_float_t mus_alaw[256] = {
A_(-5504), A_(-5248), A_(-6016), A_(-5760), A_(-4480), A_(-4224), A_(-4992), A_(-4736), A_(-7552), A_(-7296),
A_(-8064), A_(-7808), A_(-6528), A_(-6272), A_(-7040), A_(-6784), A_(-2752), A_(-2624), A_(-3008), A_(-2880),
A_(-2240), A_(-2112), A_(-2496), A_(-2368), A_(-3776), A_(-3648), A_(-4032), A_(-3904), A_(-3264), A_(-3136),
@@ -897,7 +927,7 @@ static unsigned char to_mulaw(int pcm_val)
}
#define MU_(a) MUS_SHORT_TO_SAMPLE(a)
-static const mus_sample_t mus_mulaw[256] = {
+static const mus_float_t mus_mulaw[256] = {
MU_(-32124), MU_(-31100), MU_(-30076), MU_(-29052), MU_(-28028), MU_(-27004), MU_(-25980), MU_(-24956), MU_(-23932), MU_(-22908),
MU_(-21884), MU_(-20860), MU_(-19836), MU_(-18812), MU_(-17788), MU_(-16764), MU_(-15996), MU_(-15484), MU_(-14972), MU_(-14460),
MU_(-13948), MU_(-13436), MU_(-12924), MU_(-12412), MU_(-11900), MU_(-11388), MU_(-10876), MU_(-10364), MU_(-9852), MU_(-9340),
@@ -925,7 +955,7 @@ static const mus_sample_t mus_mulaw[256] = {
#define B_(a) MUS_BYTE_TO_SAMPLE(a)
-static const mus_sample_t mus_byte[256] = {
+static const mus_float_t mus_byte[256] = {
B_(0), B_(1), B_(2), B_(3), B_(4), B_(5), B_(6), B_(7), B_(8), B_(9), B_(10), B_(11), B_(12), B_(13), B_(14), B_(15), B_(16),
B_(17), B_(18), B_(19), B_(20), B_(21), B_(22), B_(23), B_(24), B_(25), B_(26), B_(27), B_(28), B_(29), B_(30), B_(31), B_(32),
B_(33), B_(34), B_(35), B_(36), B_(37), B_(38), B_(39), B_(40), B_(41), B_(42), B_(43), B_(44), B_(45), B_(46), B_(47), B_(48),
@@ -948,7 +978,7 @@ static const mus_sample_t mus_byte[256] = {
#define UB_(a) MUS_BYTE_TO_SAMPLE(a)
-static const mus_sample_t mus_ubyte[256] = {
+static const mus_float_t mus_ubyte[256] = {
UB_(-128), UB_(-127), UB_(-126), UB_(-125), UB_(-124), UB_(-123), UB_(-122), UB_(-121), UB_(-120), UB_(-119), UB_(-118), UB_(-117),
UB_(-116), UB_(-115), UB_(-114), UB_(-113), UB_(-112), UB_(-111), UB_(-110), UB_(-109), UB_(-108), UB_(-107), UB_(-106), UB_(-105),
UB_(-104), UB_(-103), UB_(-102), UB_(-101), UB_(-100), UB_(-99), UB_(-98), UB_(-97), UB_(-96), UB_(-95), UB_(-94), UB_(-93), UB_(-92),
@@ -979,20 +1009,14 @@ static const mus_sample_t mus_ubyte[256] = {
#define UBYTE_ZERO 128
#define USHORT_ZERO 32768
-#if SNDLIB_USE_FLOATS
- #define MUS_SAMPLE_UNSCALED(n) ((n) / 32768.0)
- /* see note in _sndlib.h" values are "unscaled" from the DAC's point of view */
-#else
- #define MUS_SAMPLE_UNSCALED(n) ((n) * (1 << (MUS_SAMPLE_BITS - 16)))
-#endif
+#define MUS_SAMPLE_UNSCALED(n) ((n) / 32768.0)
+/* see note in _sndlib.h" values are "unscaled" from the DAC's point of view */
-
-#if SNDLIB_USE_FLOATS
-static float *swapped_shorts = NULL;
+static mus_float_t *swapped_shorts = NULL;
static void initialize_swapped_shorts(void)
{
int i;
- swapped_shorts = (float *)malloc(65536 * sizeof(float));
+ swapped_shorts = (mus_float_t *)malloc(65536 * sizeof(mus_float_t));
for (i = 0; i < 65536; i++)
{
signed short x;
@@ -1000,18 +1024,24 @@ static void initialize_swapped_shorts(void)
swapped_shorts[i] = MUS_SHORT_TO_SAMPLE(x);
}
}
-#endif
-static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs, mus_sample_t **cm, char *inbuf)
+static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs, mus_float_t **cm, char *inbuf)
{
- int format, siz, siz_chans;
- mus_long_t bytes, j, lim, leftover, total_read, k, loc, oldloc, buflim;
+ /* beg no longer means buffer-relative start point (that is assumed to be 0): changed 18-Dec-13
+ * beg is now the starting frample number in the file data (first frample = 0)
+ * so old form
+ * mus_read_any_1(f, 0, ...)
+ * is now
+ * mus_read_any_1(f, frample, ...)
+ */
+ mus_sample_t samp_type;
+ int siz, siz_chans;
+ mus_long_t bytes, lim, leftover, total_read, k, loc, buflim;
unsigned char *jchar;
static char *ur_charbuf = NULL;
char *charbuf = NULL;
- mus_sample_t *buffer;
- float prescaling;
+ mus_float_t *buffer;
if (nints <= 0) return(0);
@@ -1023,18 +1053,14 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
return(mus_error(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, "mus_read: no file descriptors!"));
fd = io_fds[tfd];
- if (fd->data_format == MUS_UNKNOWN)
- return(mus_error(MUS_FILE_CLOSED, "mus_read: invalid data format for %s", fd->name));
+ if (fd->sample_type == MUS_UNKNOWN_SAMPLE)
+ return(mus_error(MUS_FILE_CLOSED, "mus_read: invalid sample type for %s", fd->name));
- format = fd->data_format;
+ samp_type = fd->sample_type;
siz = fd->bytes_per_sample;
- if ((format == MUS_OUT_FORMAT) &&
- (chans == 1) &&
- (beg == 0)
-#if SNDLIB_USE_FLOATS
- && (fd->prescaler == 1.0)
-#endif
- )
+ if ((samp_type == MUS_OUT_SAMPLE_TYPE) &&
+ (chans == 1))
+ /* (beg == 0)) */
{
ssize_t total;
@@ -1046,17 +1072,51 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
memset((void *)(bufs[0]), 0, bytes);
else
{
- int i, last;
- last = beg + nints;
- for (i = total / siz; i < last; i++)
- bufs[0][i] = MUS_SAMPLE_0;
+ int i;
+ for (i = total / siz; i < nints; i++)
+ bufs[0][i] = 0.0;
}
}
return(total / siz);
}
- prescaling = (float)(fd->prescaler * MUS_FLOAT_TO_SAMPLE(1.0));
- /* not MUS_FLOAT_TO_SAMPLE(fd->prescaler) here because there's a possible cast to int which can overflow */
+ if (fd->saved)
+ {
+ /* fprintf(stderr, "mus_read_any_1 %d use saved data\n", tfd); */
+
+ lim = nints;
+ if (lim > fd->framples)
+ lim = fd->framples;
+ bytes = lim * sizeof(mus_float_t);
+ if (beg < 0) beg = 0;
+
+ if ((chans == 1) &&
+ ((!cm) || (cm[0])))
+ {
+ buffer = (mus_float_t *)(bufs[0]);
+ if (buffer)
+ {
+ memcpy((void *)buffer, (void *)(fd->saved_data[0] + beg), bytes);
+ if (lim < nints)
+ memset((void *)(buffer + lim), 0, (nints - lim) * sizeof(mus_float_t));
+ }
+ }
+ else
+ {
+ for (k = 0; k < chans; k++)
+ if ((cm == NULL) || (cm[k]))
+ {
+ buffer = (mus_float_t *)(bufs[k]);
+ if (buffer)
+ {
+ memcpy((void *)buffer, (void *)(fd->saved_data[k] + beg), bytes);
+ if (lim < nints)
+ memset((void *)(buffer + lim), 0, (nints - lim) * sizeof(mus_float_t));
+ }
+ }
+ }
+ return(lim);
+ }
if (ur_charbuf == NULL)
ur_charbuf = (char *)malloc(BUFLIM * sizeof(char));
@@ -1065,9 +1125,8 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
else
{
charbuf = inbuf;
- siz = mus_bytes_per_sample(tfd);
- prescaling = (float)(MUS_FLOAT_TO_SAMPLE(1.0));
- format = tfd;
+ siz = mus_bytes_per_sample((mus_sample_t)tfd);
+ samp_type = (mus_sample_t)tfd;
}
siz_chans = siz * chans;
@@ -1077,20 +1136,21 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
buflim = (BUFLIM) - k;
else buflim = BUFLIM;
total_read = 0;
- loc = beg;
+ loc = 0;
-#if SNDLIB_USE_FLOATS
#if MUS_LITTLE_ENDIAN
- if ((format == MUS_BSHORT) && (!swapped_shorts))
+ if ((samp_type == MUS_BSHORT) && (!swapped_shorts))
initialize_swapped_shorts();
#else
- if ((format == MUS_LSHORT) && (!swapped_shorts))
+ if ((samp_type == MUS_LSHORT) && (!swapped_shorts))
initialize_swapped_shorts();
#endif
-#endif
while (leftover > 0)
{
+ mus_long_t oldloc, loclim;
+ mus_float_t *bufnow, *bufend, *bufend4;
+
bytes = leftover;
if (bytes > buflim)
{
@@ -1107,16 +1167,13 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
{
/* zero out trailing section (some callers don't check the returned value) -- this added 9-May-99 */
- lim = beg + nints;
- if (loc < lim)
+ if (loc < nints)
for (k = 0; k < chans; k++)
if ((cm == NULL) || (cm[k]))
{
- if (loc == 0)
- memset((void *)(bufs[k]), 0, lim * sizeof(mus_sample_t));
- else
- for (j = loc; j < lim; j++)
- bufs[k][j] = MUS_SAMPLE_0;
+ mus_float_t *p;
+ p = bufs[k];
+ memset((void *)(p + loc), 0, (nints - loc) * sizeof(mus_float_t));
}
return(total_read);
}
@@ -1124,184 +1181,503 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
}
else
{
- lim = nints; /* frames in this case */
+ lim = nints; /* framples in this case */
leftover = 0;
}
total_read += lim;
oldloc = loc;
- for (k = 0; k < chans; k++)
+ if ((chans == 1) &&
+ ((!cm) || (cm[0])))
{
- if ((cm == NULL) || (cm[k]))
+ buffer = (mus_float_t *)(bufs[0]);
+ if (buffer)
{
- buffer = (mus_sample_t *)(bufs[k]);
- if (buffer)
+ loc = oldloc;
+ loclim = loc + lim;
+ bufnow = (mus_float_t *)(buffer + loc);
+ bufend = (mus_float_t *)(buffer + loclim - 1);
+ bufend4 = (mus_float_t *)(bufend - 4);
+
+ jchar = (unsigned char *)charbuf;
+ switch (samp_type)
{
- mus_long_t loclim;
- mus_sample_t *bufnow, *bufend;
-
- loc = oldloc;
- loclim = loc + lim;
- bufnow = (mus_sample_t *)(buffer + loc);
- bufend = (mus_sample_t *)(buffer + loclim - 1);
-
- jchar = (unsigned char *)charbuf;
- jchar += (k * siz);
- switch (format)
+ case MUS_BSHORT:
+#if MUS_LITTLE_ENDIAN
+ while (bufnow <= bufend4)
{
- case MUS_BSHORT:
-#if MUS_LITTLE_ENDIAN && SNDLIB_USE_FLOATS
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ jchar += 2;
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ jchar += 2;
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ jchar += 2;
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ jchar += 2;
+ }
+ for (; bufnow <= bufend; jchar += 2) /* unsigned short here as charbuf loc is slower */
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))]; /* bswap16 is much slower here because of the subsequent short->double conversion */
#else
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_SHORT_TO_SAMPLE(big_endian_short(jchar));
+ for (; bufnow <= bufend; jchar += 2)
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(big_endian_short(jchar));
#endif
- break;
-
- case MUS_LSHORT:
-#if (!MUS_LITTLE_ENDIAN) && SNDLIB_USE_FLOATS
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ break;
+
+ case MUS_LSHORT:
+#if (!MUS_LITTLE_ENDIAN)
+ for (; bufnow <= bufend; jchar += 2)
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
#else
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
-#endif
- break;
-
- case MUS_BINT:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_INT_TO_SAMPLE(big_endian_int(jchar));
- break;
-
- case MUS_LINT:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_INT_TO_SAMPLE(little_endian_int(jchar));
- break;
-
- case MUS_BINTN:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_INT_TO_SAMPLE((big_endian_int(jchar) >> (32 - MUS_SAMPLE_BITS)));
- break;
-
- case MUS_LINTN:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_INT_TO_SAMPLE((little_endian_int(jchar) >> (32 - MUS_SAMPLE_BITS)));
- break;
-
- case MUS_MULAW:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = mus_mulaw[*jchar];
- break;
-
- case MUS_ALAW:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = mus_alaw[*jchar];
- break;
-
- case MUS_BYTE:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = mus_byte[(unsigned char)(*jchar)];
- break;
-
- case MUS_UBYTE:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = mus_ubyte[(unsigned char)(*jchar)];
- break;
-
- case MUS_BFLOAT:
- if (prescaling == 1.0)
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+ jchar += 2;
+ }
+ for (; bufnow <= bufend; jchar += 2)
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+#endif
+ break;
+
+ case MUS_BINT:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = MUS_INT_TO_SAMPLE(big_endian_int(jchar));
+ jchar += 4;
+ (*bufnow++) = MUS_INT_TO_SAMPLE(big_endian_int(jchar));
+ jchar += 4;
+ (*bufnow++) = MUS_INT_TO_SAMPLE(big_endian_int(jchar));
+ jchar += 4;
+ (*bufnow++) = MUS_INT_TO_SAMPLE(big_endian_int(jchar));
+ jchar += 4;
+ }
+ for (; bufnow <= bufend; jchar += 4)
+ (*bufnow++) = MUS_INT_TO_SAMPLE(big_endian_int(jchar));
+ break;
+
+ case MUS_LINT:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = MUS_INT_TO_SAMPLE(little_endian_int(jchar));
+ jchar += 4;
+ (*bufnow++) = MUS_INT_TO_SAMPLE(little_endian_int(jchar));
+ jchar += 4;
+ (*bufnow++) = MUS_INT_TO_SAMPLE(little_endian_int(jchar));
+ jchar += 4;
+ (*bufnow++) = MUS_INT_TO_SAMPLE(little_endian_int(jchar));
+ jchar += 4;
+ }
+ for (; bufnow <= bufend; jchar += 4)
+ (*bufnow++) = MUS_INT_TO_SAMPLE(little_endian_int(jchar));
+ break;
+
+ case MUS_BINTN:
+ for (; bufnow <= bufend; jchar += 4)
+ (*bufnow++) = MUS_INT_TO_SAMPLE((big_endian_int(jchar) >> 8));
+ break;
+
+ case MUS_LINTN:
+ for (; bufnow <= bufend; jchar += 4)
+ (*bufnow++) = MUS_INT_TO_SAMPLE((little_endian_int(jchar) >> 8));
+ break;
+
+ case MUS_MULAW:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = mus_mulaw[*jchar++];
+ (*bufnow++) = mus_mulaw[*jchar++];
+ (*bufnow++) = mus_mulaw[*jchar++];
+ (*bufnow++) = mus_mulaw[*jchar++];
+ }
+ for (; bufnow <= bufend; jchar++)
+ (*bufnow++) = mus_mulaw[*jchar];
+ break;
+
+ case MUS_ALAW:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = mus_alaw[*jchar++];
+ (*bufnow++) = mus_alaw[*jchar++];
+ (*bufnow++) = mus_alaw[*jchar++];
+ (*bufnow++) = mus_alaw[*jchar++];
+ }
+ for (; bufnow <= bufend; jchar++)
+ (*bufnow++) = mus_alaw[*jchar];
+ break;
+
+ case MUS_BYTE:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = mus_byte[(unsigned char)(*jchar++)];
+ (*bufnow++) = mus_byte[(unsigned char)(*jchar++)];
+ (*bufnow++) = mus_byte[(unsigned char)(*jchar++)];
+ (*bufnow++) = mus_byte[(unsigned char)(*jchar++)];
+ }
+ for (; bufnow <= bufend; jchar++)
+ (*bufnow++) = mus_byte[(unsigned char)(*jchar)];
+ break;
+
+ case MUS_UBYTE:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = mus_ubyte[(unsigned char)(*jchar++)];
+ (*bufnow++) = mus_ubyte[(unsigned char)(*jchar++)];
+ (*bufnow++) = mus_ubyte[(unsigned char)(*jchar++)];
+ (*bufnow++) = mus_ubyte[(unsigned char)(*jchar++)];
+ }
+ for (; bufnow <= bufend; jchar++)
+ (*bufnow++) = mus_ubyte[(unsigned char)(*jchar)];
+ break;
+
+ case MUS_BFLOAT:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = (mus_float_t)(big_endian_float(jchar));
+ jchar += 4;
+ (*bufnow++) = (mus_float_t)(big_endian_float(jchar));
+ jchar += 4;
+ (*bufnow++) = (mus_float_t)(big_endian_float(jchar));
+ jchar += 4;
+ (*bufnow++) = (mus_float_t)(big_endian_float(jchar));
+ jchar += 4;
+ }
+ for (; bufnow <= bufend; jchar += 4)
+ (*bufnow++) = (mus_float_t)(big_endian_float(jchar));
+ break;
+
+ case MUS_BFLOAT_UNSCALED:
+ for (; bufnow <= bufend; jchar += 4)
+ (*bufnow++) = (mus_float_t)(MUS_SAMPLE_UNSCALED(big_endian_float(jchar)));
+ break;
+
+ case MUS_BDOUBLE:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = (mus_float_t)(big_endian_double(jchar));
+ jchar += 8;
+ (*bufnow++) = (mus_float_t)(big_endian_double(jchar));
+ jchar += 8;
+ (*bufnow++) = (mus_float_t)(big_endian_double(jchar));
+ jchar += 8;
+ (*bufnow++) = (mus_float_t)(big_endian_double(jchar));
+ jchar += 8;
+ }
+ for (; bufnow <= bufend; jchar += 8)
+ (*bufnow++) = (mus_float_t)(big_endian_double(jchar));
+ break;
+
+ case MUS_BDOUBLE_UNSCALED:
+ for (; bufnow <= bufend; jchar += 8)
+ (*bufnow++) = (mus_float_t)(MUS_SAMPLE_UNSCALED(big_endian_double(jchar)));
+ break;
+
+ case MUS_LFLOAT:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ jchar += 4;
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ jchar += 4;
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ jchar += 4;
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ jchar += 4;
+ }
+ for (; bufnow <= bufend; jchar += 4)
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ break;
+
+ case MUS_LFLOAT_UNSCALED:
+ for (; bufnow <= bufend; jchar += 4)
+ (*bufnow++) = (mus_float_t)(MUS_SAMPLE_UNSCALED(little_endian_float(jchar)));
+ break;
+
+ case MUS_LDOUBLE:
+ for (; bufnow <= bufend; jchar += 8)
+ (*bufnow++) = (mus_float_t)(little_endian_double(jchar));
+ break;
+
+ case MUS_LDOUBLE_UNSCALED:
+ for (; bufnow <= bufend; jchar += 8)
+ (*bufnow++) = (mus_float_t)(MUS_SAMPLE_UNSCALED(little_endian_double(jchar)));
+ break;
+
+ case MUS_UBSHORT:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(big_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(big_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(big_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(big_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ jchar += 2;
+ }
+ for (; bufnow <= bufend; jchar += 2)
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(big_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ break;
+
+ case MUS_ULSHORT:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(little_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(little_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(little_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ jchar += 2;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(little_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ jchar += 2;
+ }
+ for (; bufnow <= bufend; jchar += 2)
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(little_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ break;
+
+ case MUS_B24INT:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = BINT24_TO_SAMPLE(jchar);
+ jchar += 3;
+ (*bufnow++) = BINT24_TO_SAMPLE(jchar);
+ jchar += 3;
+ (*bufnow++) = BINT24_TO_SAMPLE(jchar);
+ jchar += 3;
+ (*bufnow++) = BINT24_TO_SAMPLE(jchar);
+ jchar += 3;
+ }
+ for (; bufnow <= bufend; jchar += 3)
+ (*bufnow++) = BINT24_TO_SAMPLE(jchar);
+ break;
+
+ case MUS_L24INT:
+ {
+ int val;
+ val = (jchar[2] << 16) + (jchar[1] << 8) + jchar[0];
+ if (val >= (1 << 23)) val -= (1 << 24);
+ (*bufnow++) = MUS_INT24_TO_SAMPLE(val);
+ jchar += 2;
+ }
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = INT24_TO_SAMPLE(jchar);
+ jchar += 3;
+ (*bufnow++) = INT24_TO_SAMPLE(jchar);
+ jchar += 3;
+ (*bufnow++) = INT24_TO_SAMPLE(jchar);
+ jchar += 3;
+ (*bufnow++) = INT24_TO_SAMPLE(jchar);
+ jchar += 3;
+ }
+ for (; bufnow <= bufend; jchar += 3)
+ (*bufnow++) = INT24_TO_SAMPLE(jchar);
+ break;
+
+ default: break;
+ }
+ loc = loclim;
+ }
+ }
+ else
+ {
+ for (k = 0; k < chans; k++)
+ {
+ if ((cm == NULL) || (cm[k]))
+ {
+ buffer = (mus_float_t *)(bufs[k]);
+ if (buffer)
+ {
+ loc = oldloc;
+ loclim = loc + lim;
+ bufnow = (mus_float_t *)(buffer + loc);
+ bufend = (mus_float_t *)(buffer + loclim - 1);
+ bufend4 = (mus_float_t *)(bufend - 4);
+
+ jchar = (unsigned char *)charbuf;
+ jchar += (k * siz);
+ switch (samp_type)
{
+ case MUS_BSHORT:
+#if MUS_LITTLE_ENDIAN
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ jchar += siz_chans;
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ jchar += siz_chans;
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ jchar += siz_chans;
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+ jchar += siz_chans;
+ }
for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(big_endian_float(jchar));
- }
- else
- {
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+#else
for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(prescaling * (big_endian_float(jchar)));
- }
- break;
-
- case MUS_BFLOAT_UNSCALED:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(MUS_SAMPLE_UNSCALED(big_endian_float(jchar)));
- break;
-
- case MUS_BDOUBLE:
- if (prescaling == 1.0)
- {
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(big_endian_short(jchar));
+#endif
+ break;
+
+ case MUS_LSHORT:
+#if (!MUS_LITTLE_ENDIAN)
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = swapped_shorts[(*((unsigned short *)jchar))];
+#else
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+ jchar += siz_chans;
+ }
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE(little_endian_short(jchar));
+#endif
+ break;
+
+ case MUS_BINT:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = MUS_INT_TO_SAMPLE(big_endian_int(jchar));
+ break;
+
+ case MUS_LINT:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = MUS_INT_TO_SAMPLE(little_endian_int(jchar));
+ break;
+
+ case MUS_BINTN:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = MUS_INT_TO_SAMPLE((big_endian_int(jchar) >> 8));
+ break;
+
+ case MUS_LINTN:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = MUS_INT_TO_SAMPLE((little_endian_int(jchar) >> 8));
+ break;
+
+ case MUS_MULAW:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = mus_mulaw[*jchar];
+ break;
+
+ case MUS_ALAW:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = mus_alaw[*jchar];
+ break;
+
+ case MUS_BYTE:
for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(big_endian_double(jchar));
- }
- else
- {
+ (*bufnow++) = mus_byte[(unsigned char)(*jchar)];
+ break;
+
+ case MUS_UBYTE:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = mus_ubyte[(unsigned char)(*jchar)];
+ break;
+
+ case MUS_BFLOAT:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = (mus_float_t)(big_endian_float(jchar));
+ break;
+
+ case MUS_BFLOAT_UNSCALED:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = (mus_float_t)(MUS_SAMPLE_UNSCALED(big_endian_float(jchar)));
+ break;
+
+ case MUS_BDOUBLE:
for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(prescaling * (big_endian_double(jchar)));
- }
- break;
-
- case MUS_BDOUBLE_UNSCALED:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(MUS_SAMPLE_UNSCALED(big_endian_double(jchar)));
- break;
-
- case MUS_LFLOAT:
- if (prescaling == 1.0)
- {
+ (*bufnow++) = (mus_float_t)(big_endian_double(jchar));
+ break;
+
+ case MUS_BDOUBLE_UNSCALED:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = (mus_float_t)(MUS_SAMPLE_UNSCALED(big_endian_double(jchar)));
+ break;
+
+ case MUS_LFLOAT:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ jchar += siz_chans;
+ }
for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(little_endian_float(jchar));
- }
- else
- {
+ (*bufnow++) = (mus_float_t)(little_endian_float(jchar));
+ break;
+
+ case MUS_LFLOAT_UNSCALED:
for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(prescaling * (little_endian_float(jchar)));
- }
- break;
-
- case MUS_LFLOAT_UNSCALED:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(MUS_SAMPLE_UNSCALED(little_endian_float(jchar)));
- break;
-
- case MUS_LDOUBLE:
- if (prescaling == 1.0)
- {
+ (*bufnow++) = (mus_float_t)(MUS_SAMPLE_UNSCALED(little_endian_float(jchar)));
+ break;
+
+ case MUS_LDOUBLE:
+ while (bufnow <= bufend4)
+ {
+ (*bufnow++) = (mus_float_t)(little_endian_double(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = (mus_float_t)(little_endian_double(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = (mus_float_t)(little_endian_double(jchar));
+ jchar += siz_chans;
+ (*bufnow++) = (mus_float_t)(little_endian_double(jchar));
+ jchar += siz_chans;
+ }
for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(little_endian_double(jchar));
- }
- else
- {
+ (*bufnow++) = (mus_float_t)(little_endian_double(jchar));
+ break;
+
+ case MUS_LDOUBLE_UNSCALED:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = (mus_float_t)(MUS_SAMPLE_UNSCALED(little_endian_double(jchar)));
+ break;
+
+ case MUS_UBSHORT:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(big_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ break;
+
+ case MUS_ULSHORT:
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(little_endian_unsigned_short(jchar)) - USHORT_ZERO);
+ break;
+
+ case MUS_B24INT:
for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(prescaling * (little_endian_double(jchar)));
+ (*bufnow++) = BINT24_TO_SAMPLE(jchar);
+ break;
+
+ case MUS_L24INT:
+ {
+ /*align for little_endian_int as above */
+ int val;
+ val = (jchar[2] << 16) + (jchar[1] << 8) + jchar[0];
+ if (val >= (1 << 23)) val -= (1 << 24);
+ (*bufnow++) = MUS_INT24_TO_SAMPLE(val);
+ jchar += siz_chans - 1;
+ }
+ for (; bufnow <= bufend; jchar += siz_chans)
+ (*bufnow++) = INT24_TO_SAMPLE(jchar);
+ break;
+
+ default: break;
}
- break;
-
- case MUS_LDOUBLE_UNSCALED:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = (mus_sample_t)(MUS_SAMPLE_UNSCALED(little_endian_double(jchar)));
- break;
-
- case MUS_UBSHORT:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(big_endian_unsigned_short(jchar)) - USHORT_ZERO);
- break;
-
- case MUS_ULSHORT:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_SHORT_TO_SAMPLE((int)(little_endian_unsigned_short(jchar)) - USHORT_ZERO);
- break;
-
- case MUS_B24INT:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_INT24_TO_SAMPLE((int)(((jchar[0] << 24) | (jchar[1] << 16) | (jchar[2] << 8)) >> 8));
- break;
-
- case MUS_L24INT:
- for (; bufnow <= bufend; jchar += siz_chans)
- (*bufnow++) = MUS_INT24_TO_SAMPLE((int)(((jchar[2] << 24) | (jchar[1] << 16) | (jchar[0] << 8)) >> 8));
- break;
+ loc = loclim;
}
- loc = loclim;
}
}
}
@@ -1310,51 +1686,60 @@ static mus_long_t mus_read_any_1(int tfd, mus_long_t beg, int chans, mus_long_t
}
-mus_long_t mus_file_read_any(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs, mus_sample_t **cm)
+mus_long_t mus_file_read_any(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs, mus_float_t **cm)
{
return(mus_read_any_1(tfd, beg, chans, nints, bufs, cm, NULL));
}
-mus_long_t mus_file_read_file(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs)
+mus_long_t mus_file_read_file(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs)
{
+ /* not currently used anywhere */
return(mus_read_any_1(tfd, beg, chans, nints, bufs, NULL, NULL));
}
-mus_long_t mus_file_read_buffer(int charbuf_data_format, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs, char *charbuf)
+mus_long_t mus_file_read_buffer(int charbuf_sample_type, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs, char *charbuf)
{
- return(mus_read_any_1(charbuf_data_format, beg, chans, nints, bufs, NULL, charbuf));
+ return(mus_read_any_1(charbuf_sample_type, beg, chans, nints, bufs, NULL, charbuf));
}
-mus_long_t mus_file_read(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs)
+/* the next two were changed 19-Dec-13 (sndlib.h version 23.1)
+ * "end" is now actually "dur" -- the number of samples to read, not the end point in the buffer
+ * "beg" is the frample number to start at in the data, not the buffer location
+ * so old form
+ * mus_file_read(f, 0, 99...)
+ * is now
+ * mus_file_read(f, frample, 100...)
+ */
+mus_long_t mus_file_read(int tfd, mus_long_t beg, mus_long_t num, int chans, mus_float_t **bufs)
{
- mus_long_t num, rtn, k;
- num = (end - beg + 1);
+ mus_long_t rtn;
rtn = mus_read_any_1(tfd, beg, chans, num, bufs, NULL, NULL);
if (rtn == MUS_ERROR) return(MUS_ERROR);
if (rtn < num)
- /* this zeroing can be fooled if the file is chunked and has trailing, non-data chunks */
- for (k = 0; k < chans; k++)
- {
- mus_long_t i;
- mus_sample_t *buffer;
- buffer = bufs[k];
- i = rtn + beg;
- /* this happens routinely in mus_outa + initial write (reads ahead in effect) */
- memset((void *)(buffer + i), 0, (end - i + 1) * sizeof(mus_sample_t));
- }
+ {
+ mus_long_t k;
+ /* this zeroing can be fooled if the file is chunked and has trailing, non-data chunks */
+ for (k = 0; k < chans; k++)
+ {
+ mus_float_t *buffer;
+ buffer = bufs[k];
+ /* this happens routinely in mus_outa + initial write (reads ahead in effect) */
+ /* fprintf(stderr, "clear from %lld for %lld\n", rtn, num-rtn); */
+ memset((void *)(buffer + rtn), 0, (num - rtn) * sizeof(mus_float_t));
+ }
+ }
return(num);
}
-mus_long_t mus_file_read_chans(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs, mus_sample_t **cm)
+mus_long_t mus_file_read_chans(int tfd, mus_long_t beg, mus_long_t num, int chans, mus_float_t **bufs, mus_float_t **cm)
{
/* an optimization of mus_file_read -- just reads the desired channels */
- mus_long_t num, rtn, k;
+ mus_long_t rtn, k;
- num = (end - beg + 1);
rtn = mus_read_any_1(tfd, beg, chans, num, bufs, cm, NULL);
if (rtn == MUS_ERROR) return(MUS_ERROR);
@@ -1362,11 +1747,9 @@ mus_long_t mus_file_read_chans(int tfd, mus_long_t beg, mus_long_t end, int chan
for (k = 0; k < chans; k++)
if ((cm == NULL) || (cm[k]))
{
- mus_long_t i;
- mus_sample_t *buffer;
+ mus_float_t *buffer;
buffer = bufs[k];
- i = rtn + beg;
- memset((void *)(buffer + i), 0, (end - i + 1) * sizeof(mus_sample_t));
+ memset((void *)(buffer + rtn), 0, (num - rtn) * sizeof(mus_float_t));
}
return(num);
@@ -1377,21 +1760,21 @@ mus_long_t mus_file_read_chans(int tfd, mus_long_t beg, mus_long_t end, int chan
static int checked_write(int tfd, char *buf, mus_long_t chars)
{
- ssize_t bytes;
- bytes = write(tfd, buf, chars);
+ long long int bytes;
+ bytes = (long long int)write(tfd, buf, chars);
if (bytes != chars)
{
io_fd *fd;
if ((io_fds == NULL) || (tfd >= io_fd_size) || (tfd < 0) || (io_fds[tfd] == NULL))
return(mus_error(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, "mus_write: no file descriptors!"));
fd = io_fds[tfd];
- if (fd->data_format == MUS_UNKNOWN)
+ if (fd->sample_type == MUS_UNKNOWN_SAMPLE)
return(mus_error(MUS_FILE_CLOSED,
"attempt to write closed file %s",
fd->name));
else
return(mus_error(MUS_WRITE_ERROR,
- "mus_write: write error for %s%s%s: only " SSIZE_TD " of " MUS_LD " bytes written",
+ "mus_write: write error for %s%s%s: only %lld of %lld" " bytes written",
fd->name, (errno) ? ": " : "", (errno) ? STRERROR(errno) : "",
bytes, chars));
}
@@ -1400,27 +1783,38 @@ static int checked_write(int tfd, char *buf, mus_long_t chars)
static mus_clip_handler_t *mus_clip_handler = NULL;
+static bool (*clip_checker)(void) = NULL;
+
+mus_clip_handler_t *mus_clip_set_handler(mus_clip_handler_t *new_clip_handler)
+{
+ mus_clip_handler_t *old_handler;
+ old_handler = mus_clip_handler;
+ mus_clip_handler = new_clip_handler;
+ return(old_handler);
+}
-mus_clip_handler_t *mus_clip_set_handler(mus_clip_handler_t *new_clip_handler)
+mus_clip_handler_t *mus_clip_set_handler_and_checker(mus_clip_handler_t *new_clip_handler, bool (*checker)(void))
{
mus_clip_handler_t *old_handler;
old_handler = mus_clip_handler;
mus_clip_handler = new_clip_handler;
+ clip_checker = checker;
return(old_handler);
}
-static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs, char *inbuf, bool clipped)
+static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs, char *inbuf, bool clipped)
{
- int err, siz, siz_chans, data_format, val;
- mus_long_t bytes, k, lim, leftover, loc, oldloc, buflim;
+ int err, siz, siz_chans, val;
+ mus_sample_t sample_type;
+ mus_long_t bytes, k, lim, leftover, loc, buflim;
bool clipping = false;
unsigned char *jchar;
static char *ur_charbuf = NULL;
char *charbuf = NULL;
- mus_sample_t *buffer;
+ mus_float_t *buffer;
- if (chans <= 0) return(0);
+ if (chans <= 0) return(MUS_NO_ERROR); /* ?? */
if (!inbuf)
{
@@ -1432,14 +1826,14 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
return(mus_error(MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, "mus_write: no file descriptors!"));
fd = io_fds[tfd];
- if (fd->data_format == MUS_UNKNOWN)
- return(mus_error(MUS_FILE_CLOSED, "mus_write: invalid data format for %s", fd->name));
+ if (fd->sample_type == MUS_UNKNOWN_SAMPLE)
+ return(mus_error(MUS_FILE_CLOSED, "mus_write: invalid sample type for %s", fd->name));
siz = fd->bytes_per_sample;
- data_format = fd->data_format;
+ sample_type = fd->sample_type;
clipping = fd->clipping;
- if ((data_format == MUS_OUT_FORMAT) &&
+ if ((sample_type == MUS_OUT_SAMPLE_TYPE) &&
(chans == 1) &&
(!clipping) &&
(beg == 0))
@@ -1450,8 +1844,8 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
}
else
{
- siz = mus_bytes_per_sample(tfd);
- data_format = tfd; /* in this case, tfd is the data format (see mus_file_write_buffer below) -- this should be changed! */
+ siz = mus_bytes_per_sample((mus_sample_t)tfd);
+ sample_type = (mus_sample_t)tfd; /* in this case, tfd is the sample type (see mus_file_write_buffer below) -- this should be changed! */
clipping = clipped;
}
@@ -1469,6 +1863,7 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
while (leftover > 0)
{
+ int oldloc;
bytes = leftover;
if (bytes > buflim)
{
@@ -1482,48 +1877,63 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
for (k = 0; k < chans; k++)
{
mus_long_t loclim;
- mus_sample_t *bufnow, *bufend;
+ mus_float_t *bufnow, *bufend, *bufend4;
if (bufs[k] == NULL) continue;
loc = oldloc;
- buffer = (mus_sample_t *)(bufs[k]);
+ buffer = (mus_float_t *)(bufs[k]);
if (clipping)
{
int clipend;
- mus_sample_t sample;
+ mus_float_t sample;
clipend = oldloc + lim;
- bufnow = (mus_sample_t *)(buffer + oldloc);
- bufend = (mus_sample_t *)(buffer + clipend - 1);
+ bufnow = (mus_float_t *)(buffer + oldloc);
+ bufend = (mus_float_t *)(buffer + clipend - 1);
+ bufend4 = (mus_float_t *)(bufend - 4);
+
+ if (clip_checker) clip_checker();
if (mus_clip_handler)
{
for (; bufnow <= bufend; bufnow++)
{
sample = (*bufnow);
- if ((sample > MUS_SAMPLE_MAX) ||
- (sample < MUS_SAMPLE_MIN))
- (*bufnow) = (*mus_clip_handler)(sample);
+ if ((sample >= 1.0) || (sample < -1.0)) (*bufnow) = (*mus_clip_handler)(sample);
}
}
else
{
+ while (bufnow <= bufend4)
+ {
+ sample = (*bufnow);
+ if (sample >= 1.0) (*bufnow) = 0.99999; else if (sample < -1.0) (*bufnow) = -1.0;
+ bufnow++;
+
+ sample = (*bufnow);
+ if (sample >= 1.0) (*bufnow) = 0.99999; else if (sample < -1.0) (*bufnow) = -1.0;
+ bufnow++;
+
+ sample = (*bufnow);
+ if (sample >= 1.0) (*bufnow) = 0.99999; else if (sample < -1.0) (*bufnow) = -1.0;
+ bufnow++;
+
+ sample = (*bufnow);
+ if (sample >= 1.0) (*bufnow) = 0.99999; else if (sample < -1.0) (*bufnow) = -1.0;
+ bufnow++;
+ }
for (; bufnow <= bufend; bufnow++)
{
sample = (*bufnow);
- if (sample > MUS_SAMPLE_MAX)
- (*bufnow) = MUS_SAMPLE_MAX;
- else
- if (sample < MUS_SAMPLE_MIN)
- (*bufnow) = MUS_SAMPLE_MIN;
+ if (sample >= 1.0) (*bufnow) = 0.99999; else if (sample < -1.0) (*bufnow) = -1.0;
}
}
}
- if ((data_format == MUS_OUT_FORMAT) &&
+ if ((sample_type == MUS_OUT_SAMPLE_TYPE) &&
(chans == 1) &&
(beg == 0) &&
- (!inbuf)) /* "tfd" can be data format */
+ (!inbuf)) /* "tfd" can be sample type */
{
bytes = (end + 1) * siz;
return(checked_write(tfd, (char *)(bufs[0]), bytes));
@@ -1541,14 +1951,26 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
charbuf = ur_charbuf;
}
- bufnow = (mus_sample_t *)(buffer + loc);
- bufend = (mus_sample_t *)(buffer + loclim - 1);
+ bufnow = (mus_float_t *)(buffer + loc);
+ bufend = (mus_float_t *)(buffer + loclim - 1);
+ bufend4 = (mus_float_t *)(bufend - 4);
jchar = (unsigned char *)charbuf; /* if to_buffer we should add the loop offset here, or never loop */
jchar += (k * siz);
- switch (data_format)
+ switch (sample_type)
{
case MUS_BSHORT:
+ while (bufnow <= bufend4)
+ {
+ set_big_endian_short(jchar, MUS_SAMPLE_TO_SHORT(*bufnow++));
+ jchar += siz_chans;
+ set_big_endian_short(jchar, MUS_SAMPLE_TO_SHORT(*bufnow++));
+ jchar += siz_chans;
+ set_big_endian_short(jchar, MUS_SAMPLE_TO_SHORT(*bufnow++));
+ jchar += siz_chans;
+ set_big_endian_short(jchar, MUS_SAMPLE_TO_SHORT(*bufnow++));
+ jchar += siz_chans;
+ }
for (; bufnow <= bufend; jchar += siz_chans)
set_big_endian_short(jchar, MUS_SAMPLE_TO_SHORT(*bufnow++));
break;
@@ -1570,12 +1992,12 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
case MUS_BINTN:
for (; bufnow <= bufend; jchar += siz_chans)
- set_big_endian_int(jchar, MUS_SAMPLE_TO_INT(*bufnow++) << (32 - MUS_SAMPLE_BITS));
+ set_big_endian_int(jchar, MUS_SAMPLE_TO_INT(*bufnow++) << 8);
break;
case MUS_LINTN:
for (; bufnow <= bufend; jchar += siz_chans)
- set_little_endian_int(jchar, MUS_SAMPLE_TO_INT(*bufnow++) << (32 - MUS_SAMPLE_BITS));
+ set_little_endian_int(jchar, MUS_SAMPLE_TO_INT(*bufnow++) << 8);
break;
case MUS_MULAW:
@@ -1600,42 +2022,64 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
case MUS_BFLOAT:
for (; bufnow <= bufend; jchar += siz_chans)
- set_big_endian_float(jchar, MUS_SAMPLE_TO_FLOAT(*bufnow++));
+ set_big_endian_float(jchar, *bufnow++);
break;
case MUS_LFLOAT:
+ while (bufnow <= bufend4)
+ {
+ set_little_endian_float(jchar, *bufnow++);
+ jchar += siz_chans;
+ set_little_endian_float(jchar, *bufnow++);
+ jchar += siz_chans;
+ set_little_endian_float(jchar, *bufnow++);
+ jchar += siz_chans;
+ set_little_endian_float(jchar, *bufnow++);
+ jchar += siz_chans;
+ }
for (; bufnow <= bufend; jchar += siz_chans)
- set_little_endian_float(jchar, MUS_SAMPLE_TO_FLOAT(*bufnow++));
+ set_little_endian_float(jchar, *bufnow++);
break;
case MUS_BDOUBLE:
for (; bufnow <= bufend; jchar += siz_chans)
- set_big_endian_double(jchar, MUS_SAMPLE_TO_DOUBLE(*bufnow++));
+ set_big_endian_double(jchar, *bufnow++);
break;
case MUS_LDOUBLE:
+ while (bufnow <= bufend4)
+ {
+ set_little_endian_double(jchar, *bufnow++);
+ jchar += siz_chans;
+ set_little_endian_double(jchar, *bufnow++);
+ jchar += siz_chans;
+ set_little_endian_double(jchar, *bufnow++);
+ jchar += siz_chans;
+ set_little_endian_double(jchar, *bufnow++);
+ jchar += siz_chans;
+ }
for (; bufnow <= bufend; jchar += siz_chans)
- set_little_endian_double(jchar, MUS_SAMPLE_TO_DOUBLE(*bufnow++));
+ set_little_endian_double(jchar, *bufnow++);
break;
case MUS_BFLOAT_UNSCALED:
for (; bufnow <= bufend; jchar += siz_chans)
- set_big_endian_float(jchar, 32768.0 * MUS_SAMPLE_TO_FLOAT(*bufnow++));
+ set_big_endian_float(jchar, 32768.0 * (*bufnow++));
break;
case MUS_LFLOAT_UNSCALED:
for (; bufnow <= bufend; jchar += siz_chans)
- set_little_endian_float(jchar, 32768.0 * MUS_SAMPLE_TO_FLOAT(*bufnow++));
+ set_little_endian_float(jchar, 32768.0 * (*bufnow++));
break;
case MUS_BDOUBLE_UNSCALED:
for (; bufnow <= bufend; jchar += siz_chans)
- set_big_endian_double(jchar, 32768.0 * MUS_SAMPLE_TO_DOUBLE(*bufnow++));
+ set_big_endian_double(jchar, 32768.0 * (*bufnow++));
break;
case MUS_LDOUBLE_UNSCALED:
for (; bufnow <= bufend; jchar += siz_chans)
- set_little_endian_double(jchar, 32768.0 * MUS_SAMPLE_TO_DOUBLE(*bufnow++));
+ set_little_endian_double(jchar, 32768.0 * (*bufnow++));
break;
case MUS_UBSHORT:
@@ -1679,6 +2123,8 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
}
}
break;
+
+ default: break;
}
loc = loclim;
}
@@ -1693,21 +2139,21 @@ static int mus_write_1(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_s
}
-int mus_file_write(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs)
+int mus_file_write(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs)
{
return(mus_write_1(tfd, beg, end, chans, bufs, NULL, false)); /* if inbuf is NULL (as here), clipped is ignored, so the "false" could be anything */
}
-int mus_file_write_file(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs)
+int mus_file_write_file(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs)
{
return(mus_write_1(tfd, beg, end, chans, bufs, NULL, false));
}
-int mus_file_write_buffer(int charbuf_data_format, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs, char *charbuf, bool clipped)
+int mus_file_write_buffer(int charbuf_sample_type, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs, char *charbuf, bool clipped)
{
- return(mus_write_1(charbuf_data_format, beg, end, chans, bufs, charbuf, clipped));
+ return(mus_write_1(charbuf_sample_type, beg, end, chans, bufs, charbuf, clipped));
}
@@ -1717,12 +2163,11 @@ void mus_reset_io_c(void)
io_fd_size = 0;
io_fds = NULL;
clipping_default = false;
- prescaler_default = 1.0;
mus_clip_set_handler(NULL);
}
-#if !(defined(HAVE_WINDOZE) && (!(defined(__CYGWIN__))))
+#if !(defined(_MSC_VER) && (!(defined(__CYGWIN__))))
static int sndlib_strlen(const char *str)
{
/* strlen(NULL) -> seg fault! */
@@ -1732,11 +2177,13 @@ static int sndlib_strlen(const char *str)
#endif
+static char *saved_cwd = NULL;
char *mus_getcwd(void)
{
int i, path_max = 0;
- char *pwd = NULL, *res = NULL;
-#if HAVE_PATHCONF
+ char *pwd = NULL;
+ if (saved_cwd) return(saved_cwd);
+#ifndef _MSC_VER
path_max = pathconf("/", _PC_PATH_MAX);
#endif
if (path_max < 1024)
@@ -1747,42 +2194,103 @@ char *mus_getcwd(void)
if (path_max < 1024)
path_max = 1024;
}
-#if HAVE_GETCWD
for (i = path_max;; i *= 2)
{
+ char *res;
if (pwd) free(pwd);
pwd = (char *)calloc(i, sizeof(char));
-#ifdef _MSC_VER
+#if (defined(_MSC_VER) || __CYGWIN__)
res = _getcwd(pwd, i);
#else
res = getcwd(pwd, i);
#endif
if (res) break; /* NULL is returned if failure, but what about success? should I check errno=ERANGE? */
}
-#endif
+ saved_cwd = pwd;
return(pwd);
}
+#if HAVE_EXTENSION_LANGUAGE
+#include "sndlib2xen.h"
+/* for g_mus_sound_path */
+#endif
char *mus_expand_filename(const char *filename)
{
/* fill out under-specified library pathnames etc */
-#if defined(HAVE_WINDOZE) && (!(defined(__CYGWIN__)))
+#if defined(_MSC_VER) && (!(defined(__CYGWIN__)))
return(mus_strdup(filename));
#else
- char *file_name_buf = NULL;
- char *tok = NULL, *orig = NULL;
- int i, j = 0, len = 0;
+
+ char *file_name_buf;
+ char *tok, *orig;
+ int i, j, len, orig_len;
+
+ /* realpath does not speed this up */
if ((filename) && (*filename))
len = strlen(filename);
else return(NULL);
- if (len == 0) return(NULL);
+
+ if ((len == 1) && (filename[0] == '.'))
+ {
+ orig = mus_getcwd();
+ orig_len = sndlib_strlen(orig);
+ file_name_buf = (char *)malloc((orig_len + 4) * sizeof(char));
+ strcpy(file_name_buf, orig);
+ file_name_buf[orig_len] = '/';
+ file_name_buf[orig_len + 1] = '\0';
+ /* fprintf(stderr, "%d: %s -> %s\n", __LINE__, filename, file_name_buf); */
+ return(file_name_buf);
+ }
+
+ tok = (char *)strchr(filename, (int)'/');
+ if (!tok)
+ {
+ orig = mus_getcwd();
+ orig_len = sndlib_strlen(orig);
+ file_name_buf = (char *)malloc((len + orig_len + 4) * sizeof(char));
+ strcpy(file_name_buf, orig);
+ file_name_buf[orig_len] = '/';
+ strncpy((char *)(file_name_buf + orig_len + 1), filename, len + 1);
+ /* fprintf(stderr, "%d: %s -> %s\n", __LINE__, filename, file_name_buf); */
+
+#if HAVE_EXTENSION_LANGUAGE
+ if (!mus_file_probe(file_name_buf))
+ {
+ Xen p;
+ for (p = g_mus_sound_path(); Xen_is_pair(p); p = Xen_cdr(p))
+ {
+ char *nfile;
+ const char *path;
+ int path_len;
+ path = Xen_string_to_C_string(Xen_car(p));
+ path_len = sndlib_strlen(path);
+ nfile = (char *)malloc((len + path_len + 4) * sizeof(char));
+ strcpy(nfile, path);
+ if (nfile[path_len - 1] != '/')
+ {
+ nfile[path_len] = '/';
+ strncpy((char *)(nfile + path_len + 1), filename, len + 1);
+ }
+ else strncpy((char *)(nfile + path_len), filename, len + 1);
+ /* fprintf(stderr, "%d: %s -> %s\n", __LINE__, filename, nfile); */
+ if (mus_file_probe(nfile))
+ {
+ free(file_name_buf);
+ return(nfile);
+ }
+ free(nfile);
+ }
+ }
+#endif
+ return(file_name_buf);
+ }
orig = mus_strdup(filename);
tok = orig;
/* get rid of "//" */
- for (i = 0; i < len - 1; i++)
+ for (i = 0, j = 0; i < len - 1; i++)
{
if ((tok[i] == '/') &&
(tok[i + 1] == '/'))
@@ -1800,7 +2308,7 @@ char *mus_expand_filename(const char *filename)
char *home = NULL;
if ((tok[0] == '~') && (home = getenv("HOME")))
{
- file_name_buf = (char *)calloc(len + sndlib_strlen(home) + 8, sizeof(char));
+ file_name_buf = (char *)malloc((len + sndlib_strlen(home) + 8) * sizeof(char));
strcpy(file_name_buf, home);
strcat(file_name_buf, ++tok);
}
@@ -1808,9 +2316,8 @@ char *mus_expand_filename(const char *filename)
{
char *pwd;
pwd = mus_getcwd();
- file_name_buf = (char *)calloc(len + sndlib_strlen(pwd) + 8, sizeof(char));
+ file_name_buf = (char *)malloc((len + sndlib_strlen(pwd) + 8) * sizeof(char));
strcpy(file_name_buf, pwd);
- free(pwd);
strcat(file_name_buf, "/");
if (tok[0])
strcat(file_name_buf, tok);
@@ -1818,7 +2325,7 @@ char *mus_expand_filename(const char *filename)
}
else
{
- file_name_buf = (char *)calloc(len + 8, sizeof(char));
+ file_name_buf = (char *)malloc((len + 8) * sizeof(char));
strcpy(file_name_buf, tok);
}
/* get rid of "/../" and "/./" also "/." at end */
@@ -1869,24 +2376,10 @@ char *mus_expand_filename(const char *filename)
}
-void mus_snprintf(char *buffer, int buffer_len, const char *format, ...)
-{
- int bytes_needed = 0;
- va_list ap;
- va_start(ap, format);
-#if HAVE_VSNPRINTF
- bytes_needed = vsnprintf(buffer, buffer_len, format, ap);
-#else
- bytes_needed = vsprintf(buffer, format, ap);
-#endif
- va_end(ap);
-}
-
-
char *mus_format(const char *format, ...)
{
/* caller should free result */
-#if HAVE_VASPRINTF
+#ifndef _MSC_VER
va_list ap;
int bytes;
char *result = NULL;
@@ -1898,24 +2391,14 @@ char *mus_format(const char *format, ...)
return(result);
#else
-#if HAVE_VSNPRINTF
#define MUS_FORMAT_BUFFER_SIZE 256
-#else
- #define MUS_FORMAT_BUFFER_SIZE 8192
-#endif
-
char *buf = NULL;
int needed_bytes = 0;
va_list ap;
buf = (char *)calloc(MUS_FORMAT_BUFFER_SIZE, sizeof(char));
- va_start(ap, format);
-#if HAVE_VSNPRINTF
+ va_start(ap, format);
needed_bytes = vsnprintf(buf, MUS_FORMAT_BUFFER_SIZE, format, ap);
-#else
- needed_bytes = vsprintf(buf, format, ap);
-#endif
-
va_end(ap);
if (needed_bytes >= MUS_FORMAT_BUFFER_SIZE) /* "=" here because we need room for the trailing 0 */
@@ -1923,11 +2406,7 @@ char *mus_format(const char *format, ...)
free(buf);
buf = (char *)calloc(needed_bytes + 1, sizeof(char));
va_start(ap, format);
-#if HAVE_VSNPRINTF
vsnprintf(buf, needed_bytes + 1, format, ap);
-#else
- vsprintf(buf, format, ap); /* argh -- we already clobbered memory, I presume */
-#endif
va_end(ap);
}
return(buf);
@@ -1978,9 +2457,9 @@ mus_long_t mus_oclamp(mus_long_t lo, mus_long_t val, mus_long_t hi)
static void min_max_shorts(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp)
{
- short cur_min, cur_max;
+ short cur_min, cur_max, tmp;
short *sbuf;
- int i, len;
+ int i, len, len2;
sbuf = (short *)data;
len = bytes / SHORT_BYTES;
@@ -1988,10 +2467,21 @@ static void min_max_shorts(unsigned char *data, int bytes, int chan, int chans,
cur_min = sbuf[chan];
cur_max = cur_min;
- for (i = (chans + chan); i < len; i += chans)
+ len2 = len - 2 * chans;
+ i = chan; /* we read the first sample above, but we're reading by twos below */
+ while (i <= len2)
+ {
+ tmp = sbuf[i];
+ if (tmp < cur_min) cur_min = tmp; else if (tmp > cur_max) cur_max = tmp;
+ i += chans;
+ tmp = sbuf[i];
+ if (tmp < cur_min) cur_min = tmp; else if (tmp > cur_max) cur_max = tmp;
+ i += chans;
+ }
+ if (i < len)
{
- if (sbuf[i] < cur_min) cur_min = sbuf[i];
- else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ tmp = sbuf[i];
+ if (tmp < cur_min) cur_min = tmp; else if (tmp > cur_max) cur_max = tmp;
}
(*min_samp) = (mus_float_t)cur_min / (mus_float_t)(1 << 15);
@@ -2002,12 +2492,13 @@ static void min_max_shorts(unsigned char *data, int bytes, int chan, int chans,
static void min_max_switch_shorts(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp)
{
short cur_min, cur_max;
- /* frame based */
- unsigned char *samp, *eod;
- int bytes_per_frame;
+ /* frample based */
+ unsigned char *samp, *eod, *eod2;
+ int bytes_per_frample;
- bytes_per_frame = chans * SHORT_BYTES;
+ bytes_per_frample = chans * SHORT_BYTES;
eod = (unsigned char *)(data + bytes);
+ eod2 = (unsigned char *)(eod - 2 * bytes_per_frample);
#if MUS_LITTLE_ENDIAN
cur_min = big_endian_short((unsigned char *)(data + (chan * SHORT_BYTES)));
@@ -2015,17 +2506,36 @@ static void min_max_switch_shorts(unsigned char *data, int bytes, int chan, int
cur_min = little_endian_short((unsigned char *)(data + (chan * SHORT_BYTES)));
#endif
cur_max = cur_min;
-
- for (samp = (unsigned char *)(data + (chan * SHORT_BYTES) + bytes_per_frame); samp < eod; samp += bytes_per_frame)
+ samp = (unsigned char *)(data + (chan * SHORT_BYTES));
+ while (samp <= eod2)
+ {
+ short val;
+#if MUS_LITTLE_ENDIAN
+ val = big_endian_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = big_endian_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+#else
+ val = little_endian_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = little_endian_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+#endif
+ }
+ if (samp < eod)
{
short val;
#if MUS_LITTLE_ENDIAN
val = big_endian_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
#else
val = little_endian_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
#endif
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
}
(*min_samp) = (mus_float_t)cur_min / (mus_float_t)(1 << 15);
@@ -2039,18 +2549,25 @@ static void min_max_ushorts(unsigned char *data, int bytes, int chan, int chans,
{
unsigned short cur_min, cur_max;
unsigned short *sbuf;
- int i, len;
+ int i, len, len2;
sbuf = (unsigned short *)data;
len = bytes / SHORT_BYTES;
+ len2 = len - 2 * chans;
cur_min = sbuf[chan];
cur_max = cur_min;
-
- for (i = (chans + chan); i < len; i += chans)
+ i = chan;
+ while (i <= len2)
{
- if (sbuf[i] < cur_min) cur_min = sbuf[i];
- else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
+ }
+ if (i < len)
+ {
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
}
(*min_samp) = (mus_float_t)(cur_min - USHORT_ZERO) / (mus_float_t)(1 << 15);
@@ -2061,12 +2578,13 @@ static void min_max_ushorts(unsigned char *data, int bytes, int chan, int chans,
static void min_max_switch_ushorts(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp)
{
unsigned short cur_min, cur_max;
- /* frame based */
- unsigned char *samp, *eod;
- int bytes_per_frame;
+ /* frample based */
+ unsigned char *samp, *eod, *eod2;
+ int bytes_per_frample;
- bytes_per_frame = chans * SHORT_BYTES;
+ bytes_per_frample = chans * SHORT_BYTES;
eod = (unsigned char *)(data + bytes);
+ eod2 = (unsigned char *)(eod - 2 * bytes_per_frample);
#if MUS_LITTLE_ENDIAN
cur_min = big_endian_unsigned_short((unsigned char *)(data + (chan * SHORT_BYTES)));
@@ -2075,16 +2593,35 @@ static void min_max_switch_ushorts(unsigned char *data, int bytes, int chan, int
#endif
cur_max = cur_min;
- for (samp = (unsigned char *)(data + (chan * SHORT_BYTES) + bytes_per_frame); samp < eod; samp += bytes_per_frame)
+ samp = (unsigned char *)(data + (chan * SHORT_BYTES));
+ while (samp <= eod2)
{
unsigned short val;
#if MUS_LITTLE_ENDIAN
val = big_endian_unsigned_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = big_endian_unsigned_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
#else
val = little_endian_unsigned_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = little_endian_unsigned_short(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
#endif
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
+ }
+ if (samp < eod)
+ {
+ unsigned short val;
+#if MUS_LITTLE_ENDIAN
+ val = big_endian_unsigned_short(samp);
+#else
+ val = little_endian_unsigned_short(samp);
+#endif
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
}
(*min_samp) = (mus_float_t)(cur_min - USHORT_ZERO) / (mus_float_t)(1 << 15);
@@ -2100,18 +2637,26 @@ static void min_max_ints(unsigned char *data, int bytes, int chan, int chans, mu
{
int cur_min, cur_max;
int *sbuf;
- int i, len;
+ int i, len, len2;
sbuf = (int *)data;
len = bytes / INT_BYTES;
+ len2 = len - 2 *chans;
cur_min = sbuf[chan];
cur_max = cur_min;
- for (i = (chans + chan); i < len; i += chans)
+ i = chan;
+ while (i <= len2)
+ {
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
+ }
+ if (i < len)
{
- if (sbuf[i] < cur_min) cur_min = sbuf[i];
- else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
}
(*min_samp) = (mus_float_t)cur_min / (mus_float_t)(1 << 23);
@@ -2124,18 +2669,19 @@ static void min_max_ints(unsigned char *data, int bytes, int chan, int chans, mu
}
}
-/* (with-sound (:data-format mus-lintn :statistics #t) (fm-violin 0 1 440 .1)) */
+/* (with-sound (:sample-type mus-lintn :statistics #t) (fm-violin 0 1 440 .1)) */
static void min_max_switch_ints(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp, bool standard)
{
int cur_min, cur_max;
- /* frame based */
- unsigned char *samp, *eod;
- int bytes_per_frame;
+ /* frample based */
+ unsigned char *samp, *eod, *eod2;
+ int bytes_per_frample;
- bytes_per_frame = chans * INT_BYTES;
+ bytes_per_frample = chans * INT_BYTES;
eod = (unsigned char *)(data + bytes);
+ eod2 = (unsigned char *)(eod - 2 * bytes_per_frample);
#if MUS_LITTLE_ENDIAN
cur_min = big_endian_int((unsigned char *)(data + (chan * INT_BYTES)));
@@ -2144,16 +2690,36 @@ static void min_max_switch_ints(unsigned char *data, int bytes, int chan, int ch
#endif
cur_max = cur_min;
- for (samp = (unsigned char *)(data + (chan * INT_BYTES) + bytes_per_frame); samp < eod; samp += bytes_per_frame)
+ samp = (unsigned char *)(data + (chan * INT_BYTES));
+ while (samp <= eod2)
{
int val;
#if MUS_LITTLE_ENDIAN
val = big_endian_int(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = big_endian_int(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
#else
val = little_endian_int(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = little_endian_int(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+#endif
+ }
+ if (samp < eod)
+ {
+ int val;
+#if MUS_LITTLE_ENDIAN
+ val = big_endian_int(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+#else
+ val = little_endian_int(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
#endif
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
}
(*min_samp) = (mus_float_t)cur_min / (mus_float_t)(1 << 23);
@@ -2176,18 +2742,27 @@ static void min_max_floats(unsigned char *data, int bytes, int chan, int chans,
{
float cur_min, cur_max;
float *sbuf;
- int i, len;
+ int i, len, len2;
sbuf = (float *)data;
len = bytes / FLOAT_BYTES;
+ len2 = len - 2 *chans;
cur_min = sbuf[chan];
cur_max = cur_min;
- for (i = (chans + chan); i < len; i += chans)
+ i = chan;
+ while (i < len2)
+ {
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
+ }
+ while (i < len)
{
- if (sbuf[i] < cur_min) cur_min = sbuf[i];
- else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
}
if (unscaled)
@@ -2206,12 +2781,13 @@ static void min_max_floats(unsigned char *data, int bytes, int chan, int chans,
static void min_max_switch_floats(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp, bool unscaled)
{
float cur_min, cur_max;
- /* frame based */
- unsigned char *samp, *eod;
- int bytes_per_frame;
+ /* frample based */
+ unsigned char *samp, *eod, *eod2;
+ int bytes_per_frample;
- bytes_per_frame = chans * FLOAT_BYTES;
+ bytes_per_frample = chans * FLOAT_BYTES;
eod = (unsigned char *)(data + bytes);
+ eod2 = (unsigned char *)(eod - 2 * bytes_per_frample);
#if MUS_LITTLE_ENDIAN
cur_min = big_endian_float((unsigned char *)(data + (chan * FLOAT_BYTES)));
@@ -2219,17 +2795,37 @@ static void min_max_switch_floats(unsigned char *data, int bytes, int chan, int
cur_min = little_endian_float((unsigned char *)(data + (chan * FLOAT_BYTES)));
#endif
cur_max = cur_min;
+ samp = (unsigned char *)(data + (chan * FLOAT_BYTES));
+ while (samp <= eod2)
+ {
+ float val;
+#if MUS_LITTLE_ENDIAN
+ val = big_endian_float(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = big_endian_float(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+#else
+ val = little_endian_float(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = little_endian_float(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+#endif
+ }
- for (samp = (unsigned char *)(data + (chan * FLOAT_BYTES) + bytes_per_frame); samp < eod; samp += bytes_per_frame)
+ if (samp < eod)
{
float val;
#if MUS_LITTLE_ENDIAN
val = big_endian_float(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
#else
val = little_endian_float(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
#endif
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
}
if (unscaled)
@@ -2254,18 +2850,25 @@ static void min_max_doubles(unsigned char *data, int bytes, int chan, int chans,
{
double cur_min, cur_max;
double *sbuf;
- int i, len;
+ int i, len, len2;
sbuf = (double *)data;
len = bytes / DOUBLE_BYTES;
+ len2 = len - 2 * chans;
cur_min = sbuf[chan];
cur_max = cur_min;
-
- for (i = (chans + chan); i < len; i += chans)
+ i = chan;
+ while (i <= len2)
{
- if (sbuf[i] < cur_min) cur_min = sbuf[i];
- else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
+ i += chans;
+ }
+ if (i < len)
+ {
+ if (sbuf[i] < cur_min) cur_min = sbuf[i]; else if (sbuf[i] > cur_max) cur_max = sbuf[i];
}
if (unscaled)
@@ -2284,12 +2887,13 @@ static void min_max_doubles(unsigned char *data, int bytes, int chan, int chans,
static void min_max_switch_doubles(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp, bool unscaled)
{
double cur_min, cur_max;
- /* frame based */
- unsigned char *samp, *eod;
- int bytes_per_frame;
+ /* frample based */
+ unsigned char *samp, *eod, *eod2;
+ int bytes_per_frample;
- bytes_per_frame = chans * DOUBLE_BYTES;
+ bytes_per_frample = chans * DOUBLE_BYTES;
eod = (unsigned char *)(data + bytes);
+ eod2 = (unsigned char *)(eod - 2 * bytes_per_frample);
#if MUS_LITTLE_ENDIAN
cur_min = big_endian_double((unsigned char *)(data + (chan * DOUBLE_BYTES)));
@@ -2297,17 +2901,36 @@ static void min_max_switch_doubles(unsigned char *data, int bytes, int chan, int
cur_min = little_endian_double((unsigned char *)(data + (chan * DOUBLE_BYTES)));
#endif
cur_max = cur_min;
-
- for (samp = (unsigned char *)(data + (chan * DOUBLE_BYTES) + bytes_per_frame); samp < eod; samp += bytes_per_frame)
+ samp = (unsigned char *)(data + (chan * DOUBLE_BYTES));
+ while (samp <= eod2)
{
double val;
#if MUS_LITTLE_ENDIAN
val = big_endian_double(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = big_endian_double(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+#else
+ val = little_endian_double(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+ val = little_endian_double(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ samp += bytes_per_frample;
+#endif
+ }
+ if (samp < eod)
+ {
+ double val;
+#if MUS_LITTLE_ENDIAN
+ val = big_endian_double(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
#else
val = little_endian_double(samp);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
#endif
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
}
if (unscaled)
@@ -2328,37 +2951,89 @@ static void min_max_switch_doubles(unsigned char *data, int bytes, int chan, int
#define THREE_BYTES 3
-static int three_bytes(unsigned char *data, int loc, bool big_endian)
+static int big_three(unsigned char *data, int loc)
{
- if (big_endian)
- return((int)(((data[loc + 0] << 24) +
- (data[loc + 1] << 16) +
- (data[loc + 2] << 8)) >> 8));
- return((int)(((data[loc + 2] << 24) +
- (data[loc + 1] << 16) +
- (data[loc + 0] << 8)) >> 8));
+ int val;
+ val = (data[loc + 0] << 16) + (data[loc + 1] << 8) + data[loc + 2];
+ if (val >= (1 << 23)) val -= (1 << 24);
+ return(val);
}
+static int little_three(unsigned char *data, int loc)
+{
+ int val;
+ val = (data[loc + 2] << 16) + (data[loc + 1] << 8) + data[loc + 0];
+ if (val >= (1 << 23)) val -= (1 << 24);
+ return(val);
+}
static void min_max_24s(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp, bool big_endian)
{
int cur_min, cur_max;
- int i, bytes_per_frame, len, offset;
+ int i, k, bytes_per_frample, len, len2, offset;
- bytes_per_frame = chans * THREE_BYTES;
- len = bytes / bytes_per_frame;
+ bytes_per_frample = chans * THREE_BYTES;
+ len = bytes / bytes_per_frample;
+ len2 = len - 2 * bytes_per_frample;
offset = chan * THREE_BYTES;
- cur_min = three_bytes(data, offset, big_endian);
- cur_max = cur_min;
+ k = offset;
- for (i = 1; i < len; i++)
+ if (big_endian)
{
- int val;
- val = three_bytes(data, i * bytes_per_frame + offset, big_endian);
+ cur_min = big_three(data, k);
+ cur_max = cur_min;
+ i = 0;
+ /* k += bytes_per_frample; */
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
+ while (i <= len2)
+ {
+ int val;
+ val = big_three(data, k);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i++;
+ k += bytes_per_frample;
+ val = big_three(data, k);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i++;
+ k += bytes_per_frample;
+ }
+ while (i < len)
+ {
+ int val;
+ val = big_three(data, k);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i++;
+ k += bytes_per_frample;
+ }
+ }
+ else
+ {
+ cur_min = little_three(data, k);
+ cur_max = cur_min;
+ i = 0;
+ /* k += bytes_per_frample; */
+
+ while (i <= len2)
+ {
+ int val;
+ val = little_three(data, k);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i++;
+ k += bytes_per_frample;
+ val = little_three(data, k);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i++;
+ k += bytes_per_frample;
+ }
+ while (i < len)
+ {
+ int val;
+ val = little_three(data, k);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i++;
+ k += bytes_per_frample;
+ }
}
(*min_samp) = (mus_float_t)cur_min / (mus_float_t)(1 << 23);
@@ -2371,60 +3046,93 @@ static void min_max_24s(unsigned char *data, int bytes, int chan, int chans, mus
static void min_max_mulaw(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp)
{
- mus_sample_t cur_min, cur_max;
- int i;
+ mus_float_t cur_min, cur_max;
+ int i, b2;
cur_min = mus_mulaw[(int)data[chan]];
cur_max = cur_min;
- for (i = (chans + chan); i < bytes; i += chans)
+ i = chan;
+ b2 = bytes - 2 * chans;
+ while (i <= b2)
{
- mus_sample_t val;
+ mus_float_t val;
val = mus_mulaw[(int)data[i]];
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i += chans;
+ val = mus_mulaw[(int)data[i]];
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i += chans;
+ }
+ if (i < bytes)
+ {
+ mus_float_t val;
+ val = mus_mulaw[(int)data[i]];
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
}
- (*min_samp) = MUS_SAMPLE_TO_FLOAT(cur_min);
- (*max_samp) = MUS_SAMPLE_TO_FLOAT(cur_max);
+ (*min_samp) = cur_min;
+ (*max_samp) = cur_max;
}
static void min_max_alaw(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp)
{
- mus_sample_t cur_min, cur_max;
- int i;
+ mus_float_t cur_min, cur_max;
+ int i, b2;
cur_min = mus_alaw[(int)data[chan]];
cur_max = cur_min;
- for (i = (chans + chan); i < bytes; i += chans)
+ i = chan;
+ b2 = bytes - 2 * chans;
+ while (i <= b2)
{
- mus_sample_t val;
+ mus_float_t val;
+ val = mus_alaw[(int)data[i]];
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i += chans;
val = mus_alaw[(int)data[i]];
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i += chans;
+ }
+ if (i < bytes)
+ {
+ mus_float_t val;
+ val = mus_alaw[(int)data[i]];
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
}
- (*min_samp) = MUS_SAMPLE_TO_FLOAT(cur_min);
- (*max_samp) = MUS_SAMPLE_TO_FLOAT(cur_max);
+ (*min_samp) = cur_min;
+ (*max_samp) = cur_max;
}
static void min_max_bytes(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp)
{
signed char cur_min, cur_max;
- int i;
+ int i, b2;
cur_min = (signed char)(data[chan]);
cur_max = cur_min;
- for (i = (chans + chan); i < bytes; i += chans)
+ i = chan;
+ b2 = bytes - 2 * chans;
+ while (i <= b2)
+ {
+ signed char val;
+ val = (signed char)(data[i]);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i += chans;
+ val = (signed char)(data[i]);
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
+ i += chans;
+ }
+ if (i < bytes)
{
signed char val;
val = (signed char)(data[i]);
- if (val < cur_min) cur_min = val;
- else if (val > cur_max) cur_max = val;
+ if (val < cur_min) cur_min = val; else if (val > cur_max) cur_max = val;
}
(*min_samp) = (mus_float_t)cur_min / (mus_float_t)(1 << 7);
@@ -2435,15 +3143,23 @@ static void min_max_bytes(unsigned char *data, int bytes, int chan, int chans, m
static void min_max_ubytes(unsigned char *data, int bytes, int chan, int chans, mus_float_t *min_samp, mus_float_t *max_samp)
{
unsigned char cur_min, cur_max;
- int i;
+ int i, b2;
cur_min = data[chan];
cur_max = cur_min;
- for (i = (chans + chan); i < bytes; i += chans)
+ i = chan;
+ b2 = bytes - 2 * chans;
+ while (i <= b2)
+ {
+ if (data[i] < cur_min) cur_min = data[i]; else if (data[i] > cur_max) cur_max = data[i];
+ i += chans;
+ if (data[i] < cur_min) cur_min = data[i]; else if (data[i] > cur_max) cur_max = data[i];
+ i += chans;
+ }
+ if (i < bytes)
{
- if (data[i] < cur_min) cur_min = data[i];
- else if (data[i] > cur_max) cur_max = data[i];
+ if (data[i] < cur_min) cur_min = data[i]; else if (data[i] > cur_max) cur_max = data[i];
}
(*min_samp) = (mus_float_t)(cur_min - UBYTE_ZERO) / (mus_float_t)(1 << 7);
@@ -2451,9 +3167,9 @@ static void min_max_ubytes(unsigned char *data, int bytes, int chan, int chans,
}
-int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, int format, mus_float_t *min_samp, mus_float_t *max_samp)
+int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, mus_sample_t samp_type, mus_float_t *min_samp, mus_float_t *max_samp)
{
- switch (format)
+ switch (samp_type)
{
case MUS_MULAW:
min_max_mulaw(data, bytes, chan, chans, min_samp, max_samp);
@@ -2499,33 +3215,32 @@ int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, int
case MUS_LINT:
case MUS_LINTN:
- min_max_ints(data, bytes, chan, chans, min_samp, max_samp, format == MUS_LINT);
+ min_max_ints(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_LINT);
break;
case MUS_BINT:
case MUS_BINTN:
- min_max_switch_ints(data, bytes, chan, chans, min_samp, max_samp, format == MUS_BINT);
+ min_max_switch_ints(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_BINT);
break;
case MUS_LFLOAT:
case MUS_LFLOAT_UNSCALED:
- /* prescaler is known to be 1.0 here */
- min_max_floats(data, bytes, chan, chans, min_samp, max_samp, format == MUS_LFLOAT_UNSCALED);
+ min_max_floats(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_LFLOAT_UNSCALED);
break;
case MUS_BFLOAT:
case MUS_BFLOAT_UNSCALED:
- min_max_switch_floats(data, bytes, chan, chans, min_samp, max_samp, format == MUS_BFLOAT_UNSCALED);
+ min_max_switch_floats(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_BFLOAT_UNSCALED);
break;
case MUS_LDOUBLE:
case MUS_LDOUBLE_UNSCALED:
- min_max_doubles(data, bytes, chan, chans, min_samp, max_samp, format == MUS_LDOUBLE_UNSCALED);
+ min_max_doubles(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_LDOUBLE_UNSCALED);
break;
case MUS_BDOUBLE:
case MUS_BDOUBLE_UNSCALED:
- min_max_switch_doubles(data, bytes, chan, chans, min_samp, max_samp, format == MUS_BDOUBLE_UNSCALED);
+ min_max_switch_doubles(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_BDOUBLE_UNSCALED);
break;
#else /* big endian */
@@ -2547,32 +3262,32 @@ int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, int
case MUS_LINT:
case MUS_LINTN:
- min_max_switch_ints(data, bytes, chan, chans, min_samp, max_samp, format == MUS_LINT);
+ min_max_switch_ints(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_LINT);
break;
case MUS_BINT:
case MUS_BINTN:
- min_max_ints(data, bytes, chan, chans, min_samp, max_samp, format == MUS_BINT);
+ min_max_ints(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_BINT);
break;
case MUS_LFLOAT:
case MUS_LFLOAT_UNSCALED:
- min_max_switch_floats(data, bytes, chan, chans, min_samp, max_samp, format == MUS_LFLOAT_UNSCALED);
+ min_max_switch_floats(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_LFLOAT_UNSCALED);
break;
case MUS_BFLOAT:
case MUS_BFLOAT_UNSCALED:
- min_max_floats(data, bytes, chan, chans, min_samp, max_samp, format == MUS_BFLOAT_UNSCALED);
+ min_max_floats(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_BFLOAT_UNSCALED);
break;
case MUS_LDOUBLE:
case MUS_LDOUBLE_UNSCALED:
- min_max_switch_doubles(data, bytes, chan, chans, min_samp, max_samp, format == MUS_LDOUBLE_UNSCALED);
+ min_max_switch_doubles(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_LDOUBLE_UNSCALED);
break;
case MUS_BDOUBLE:
case MUS_BDOUBLE_UNSCALED:
- min_max_doubles(data, bytes, chan, chans, min_samp, max_samp, format == MUS_BDOUBLE_UNSCALED);
+ min_max_doubles(data, bytes, chan, chans, min_samp, max_samp, samp_type == MUS_BDOUBLE_UNSCALED);
break;
#endif
@@ -2586,27 +3301,15 @@ int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, int
}
-int mus_samples_peak(unsigned char *data, int bytes, int chans, int format, mus_float_t *maxes)
-{
- int chan;
- for (chan = 0; chan < chans; chan++)
- {
- mus_float_t cur_min, cur_max;
- mus_samples_bounds(data, bytes, chan, chans, format, &cur_min, &cur_max);
- if (-cur_min > cur_max)
- maxes[chan] = -cur_min;
- else maxes[chan] = cur_max;
- }
- return(MUS_NO_ERROR);
-}
-
-
char *mus_strdup(const char *str)
{
char *newstr = NULL;
+ int len;
if ((!str) || (!(*str))) return(NULL);
- newstr = (char *)malloc(strlen(str) + 1);
- if (newstr) strcpy(newstr, str);
+ len = strlen(str);
+ newstr = (char *)malloc(len + 1);
+ strcpy(newstr, str);
+ newstr[len] = '\0';
return(newstr);
}
@@ -2619,11 +3322,24 @@ int mus_strlen(const char *str)
}
-bool mus_strcmp(const char *str1, const char *str2)
+bool mus_strcmp(const char *s1, const char *s2)
{
+ if ((!s1) || (!s2)) return(s1 == s2);
+
+ while (true)
+ {
+ unsigned char c1, c2;
+ c1 = (unsigned char) *s1++;
+ c2 = (unsigned char) *s2++;
+ if (c1 != c2) return(false);
+ if (c1 == '\0') break;
+ }
+ return(true);
+#if 0
return((str1 == str2) ||
((str1) && (str2) &&
(strcmp(str1, str2) == 0)));
+#endif
}
diff --git a/jcrev.scm b/jcrev.scm
index 7a8c5b0..cb00f32 100644
--- a/jcrev.scm
+++ b/jcrev.scm
@@ -1,62 +1,46 @@
(provide 'snd-jcrev.scm)
-(if (and (not (provided? 'snd-ws.scm))
- (not (provided? 'sndlib-ws.scm)))
- (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
-(definstrument (jc-reverb (low-pass #f) (volume 1.0) (amp-env #f))
+(definstrument (jc-reverb low-pass (volume 1.0) amp-env)
"(jc-reverb (low-pass #f) (volume 1.0) (amp-env #f)) -- Chowning reverb"
- (let* ((allpass1 (make-all-pass -0.700 0.700 1051))
- (allpass2 (make-all-pass -0.700 0.700 337))
- (allpass3 (make-all-pass -0.700 0.700 113))
- (comb1 (make-comb 0.742 4799))
- (comb2 (make-comb 0.733 4999))
- (comb3 (make-comb 0.715 5399))
- (comb4 (make-comb 0.697 5801))
- (chns (channels *output*))
- (outdel1 (make-delay (seconds->samples .013)))
- (outdel2 (if (> chns 1) (make-delay (seconds->samples .011)) #f))
- (comb-sum 0.0)
- (comb-sum-1 0.0)
- (comb-sum-2 0.0)
- (all-sums 0.0)
- (delA 0.0)
- (delB 0.0)
- (file-dur (frames *reverb*))
- (decay-dur (mus-srate))
- (len (floor (+ decay-dur file-dur)))
- (envA (if amp-env (make-env :envelope amp-env :scaler volume :duration (/ len (mus-srate))) #f))
- (scl volume))
- (if (or amp-env low-pass)
- (run
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let* ((inval (ina i *reverb*))
- (allpass-sum (all-pass allpass3 (all-pass allpass2 (all-pass allpass1 inval))))
- (amp (if envA (env envA) 1.0)))
- (set! comb-sum-2 comb-sum-1)
- (set! comb-sum-1 comb-sum)
- (set! comb-sum
- (+ (comb comb1 allpass-sum)
- (comb comb2 allpass-sum)
- (comb comb3 allpass-sum)
- (comb comb4 allpass-sum)))
- (if low-pass
- (set! all-sums (+ (* .25 (+ comb-sum comb-sum-2)) (* .5 comb-sum-1)))
- (set! all-sums comb-sum))
- (outa i (* amp (delay outdel1 all-sums)))
- (if (> chns 1) (outb i (* amp (delay outdel2 all-sums)))))))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let ((allpass-sum (all-pass allpass3 (all-pass allpass2 (all-pass allpass1 (ina i *reverb*))))))
- (set! comb-sum
- (+ (comb comb1 allpass-sum)
- (comb comb2 allpass-sum)
- (comb comb3 allpass-sum)
- (comb comb4 allpass-sum)))
- (outa i (* scl (delay outdel1 comb-sum)))
- (if (> chns 1) (outb i (* scl (delay outdel2 comb-sum))))))))))
+ (let ((allpass1 (make-all-pass -0.700 0.700 1051))
+ (allpass2 (make-all-pass -0.700 0.700 337))
+ (allpass3 (make-all-pass -0.700 0.700 113))
+ (comb1 (make-comb 0.742 4799))
+ (comb2 (make-comb 0.733 4999))
+ (comb3 (make-comb 0.715 5399))
+ (comb4 (make-comb 0.697 5801))
+ (decay-dur *clm-srate*)
+ (chns (channels *output*))
+ (file-dur (framples *reverb*)))
+ (let ((len (floor (+ decay-dur file-dur)))
+ (filts (if (= chns 1)
+ (vector (make-delay (seconds->samples .013)))
+ (vector (make-delay (seconds->samples .013))
+ (make-delay (seconds->samples .011)))))
+ (combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
+ (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
+
+ (if (or amp-env low-pass)
+ (let ((flt (and low-pass (make-fir-filter 3 (float-vector 0.25 0.5 0.25))))
+ (envA (make-env :envelope (or amp-env '(0 1 1 1)) :scaler volume :duration (/ len *clm-srate*))))
+ (if low-pass
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (out-bank filts i (* (env envA) (fir-filter flt (comb-bank combs (all-pass-bank allpasses (ina i *reverb*)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (out-bank filts i (* (env envA) (comb-bank combs (all-pass-bank allpasses (ina i *reverb*))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (out-bank filts i (* volume (comb-bank combs (all-pass-bank allpasses (ina i *reverb*))))))))))
+
;;; (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .3))
+;;; (with-sound (:reverb jc-reverb) (outa 0 .1) (outa 0 .5 *reverb*))
+;;; (with-sound (:reverb jc-reverb :reverb-data '((:low-pass #t))) (outa 0 .1) (outa 0 .5 *reverb*))
+;;; (with-sound (:statistics #t :reverb jc-reverb :reverb-data '((:low-pass #t))) (outa 0 .1) (outa 100000 .1) (outa 0 .5 *reverb*) (outa 100000 .5 *reverb*))
diff --git a/jcvoi.scm b/jcvoi.scm
index 261b68b..7271d69 100644
--- a/jcvoi.scm
+++ b/jcvoi.scm
@@ -1,7 +1,7 @@
;;; from VOIDAT.SAI[220,JDC] and GLSVOI.SAI[220,JDC], then (30 years later) jcvoi.ins
(provide 'snd-jcvoi.scm)
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
+(require snd-env.scm)
(define fnc #f) ;; fnc[sex,vowel,formant number,formant freq,amp or fm index]
(define vibfreqfun #f)
@@ -9,15 +9,14 @@
(define i3fun2 #f)
(define (flipxy data) ; SEG functions expected data in (y x) pairs.
- (let ((unseg '())
+ (let ((unseg ())
(len (length data)))
(do ((i 0 (+ i 2)))
- ((>= i len))
- (let ((x (list-ref data (+ 1 i)))
- (y (list-ref data i)))
- (set! unseg (cons x unseg))
- (set! unseg (cons y unseg))))
- (reverse unseg)))
+ ((>= i len)
+ (reverse unseg))
+ (let ((x (data (+ 1 i)))
+ (y (data i)))
+ (set! unseg (cons y (cons x unseg)))))))
(define (addenv env1 sc1 off1 env2 sc2 off2)
(add-envelopes (scale-envelope env1 sc1 off1)
@@ -40,10 +39,10 @@
(define (fillfnc)
(if (not fnc)
(begin
- (set! fnc (make-vector (* 3 6 4 4) '()))
- (set! vibfreqfun (make-vector 3 '()))
- (set! i3fun1 (make-vector 3 '()))
- (set! i3fun2 (make-vector 3 '()))
+ (set! fnc (make-vector (* 3 6 4 4) ()))
+ (set! vibfreqfun (make-vector 3 ()))
+ (set! i3fun1 (make-vector 3 ()))
+ (set! i3fun2 (make-vector 3 ()))
(setf-aref fnc 1 1 1 1 (flipxy '(350 130.8 524 261.6 392 392 523 523.2 784 784 1046 1064 1568 1568)))
(setf-aref fnc 1 1 1 2 (flipxy '(.3 130.8 .8 261.6 .9 392 .9 523.2 .7 784 .86 1064 .86 1568)))
@@ -157,122 +156,122 @@
(envelope-interp pitch ptr))
(definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
- dis pcrev deg vibscl pcran skewscl ranpower glissfun glissamt)
+ dis pcrev deg vibscl pcran skewscl glissfun glissamt)
(fillfnc)
- (let* ((c 261.62)
- (vowel (floor vowel-1))
- (sex (floor sex-1))
- (ampref (expt amp .8))
- (deg (- deg 45))
- (vibfreq (fncval (vibfreqfun sex) pitch))
- (vibpc (* .01 (/ (log pitch) (log 2)) (+ .15 (sqrt amp)) vibscl))
- (ranfreq 20)
- (ranpc (* .002 (/ (log pitch) (log 2)) (- 2 (expt amp .25)) pcran))
- (skewpc (if (= sex 1)
- (* (sqrt (+ .1 (* .05 ampref (- 1568 130.8)))) skewscl)
- (* (sqrt (+ .1 (* .05 ampref (- 130.8 16.5)))) skewscl)))
- (form1 (/ (fncval (aref fnc sex vowel 1 1) pitch) pitch))
- (form2 (/ (fncval (aref fnc sex vowel 2 1) pitch) pitch))
- (form3 (/ (fncval (aref fnc sex vowel 3 1) pitch) pitch))
- (fmntfreq1 (round form1))
- (fmntfreq2 (round form2))
- (fmntfreq3 (round form3))
- (fm2 3)
- (mscale 1)
- (mconst 0)
- (mfq (+ (* pitch mscale) mconst))
- (freqratios1 fm2)
- (freqratios2 mscale)
- (freqratios3 mscale)
- (freqratios4 mscale)
- (freqratios5 fmntfreq1)
- (freqratios6 fmntfreq2)
- (freqratios7 fmntfreq3)
- (amp1 (sqrt amp))
- (amp2 (expt amp 1.5))
- (amp3 (* amp amp))
- (formscl1 (abs (- form1 fmntfreq1)))
- (formscl2 (abs (- form2 fmntfreq2)))
- (formscl3 (abs (- form3 fmntfreq3)))
- (caramp1sc (* (fncval (aref fnc sex vowel 1 2) pitch) (- 1 formscl1) amp1))
- (caramp2sc (* (fncval (aref fnc sex vowel 2 2) pitch) (- 1 formscl2) amp2))
- (caramp3sc (* (fncval (aref fnc sex vowel 3 2) pitch) (- 1 formscl3) amp3))
- (scdev1 (fncval (aref fnc sex vowel 1 3) pitch))
- (scdev2 (fncval (aref fnc sex vowel 2 3) pitch))
- (scdev3 (fncval (aref fnc sex vowel 3 3) pitch))
- (indx0 (if (or (= vowel 3) (= vowel 4)) 0 1.5))
- (indx1 1)
- (i3 (if (< pitch (/ c 2))
- (fncval (i3fun1 sex) pitch)
- (fncval (i3fun2 sex) pitch)))
- (dev (hz->radians (* i3 mfq)))
- (dev0 (hz->radians (* indx0 mfq)))
- (dev1 (hz->radians (* (- indx1 indx0) mfq))))
- (let* ((gens1 (make-oscil 0))
- (gens2 (make-oscil 0 (/ pi 2.0)))
- (gens2ampenv (make-env indxfun :duration dur
- :scaler (* scdev1 dev1)
- :offset (* scdev1 dev0)))
- (gens3 (make-oscil 0 (/ pi 2.0)))
- (gens3ampenv (make-env indxfun :duration dur
- :scaler (* scdev2 dev1)
- :offset (* scdev2 dev0)))
- (gens4 (make-oscil 0 (/ pi 2.0)))
- (gens4ampenv (make-env indxfun :duration dur
- :scaler (* scdev3 dev1)
- :offset (* scdev3 dev0)))
- (gens5 (make-oscil 0))
- (gens5ampenv (make-env ampfun1 :duration dur
- :scaler (* amp caramp1sc .75)))
- (gens6 (make-oscil 0))
- (gens6ampenv (make-env ampfun2 :duration dur
- :scaler (* amp caramp2sc .75)))
- (gens7 (make-oscil 0))
- (gens7ampenv (make-env ampfun3 :duration dur
- :scaler (* amp caramp3sc .75)))
- (freqenv (make-env (addenv glissfun (* glissamt pitch) 0 skewfun (* skewpc pitch) pitch) :duration dur
- :scaler (hz->radians 1.0)))
- (pervenv (make-env vibfun :duration dur
- :scaler vibpc))
- (ranvenv (make-env :envelope ranfun :duration dur
- :scaler ranpc))
- (per-vib (make-triangle-wave :frequency vibfreq
- :amplitude (hz->radians pitch)))
- (ran-vib (make-rand-interp :frequency ranfreq
- :amplitude (hz->radians pitch)))
- (loc (make-locsig :degree deg :distance dis :reverb pcrev))
- (vib 0.0)
- (cascadeout 0.0)
- (start (floor (* (mus-srate) beg)))
- (end (+ start (floor (* (mus-srate) dur)))))
- (run
- (do ((i start (+ i 1)))
- ((> i end))
- (set! vib (+ (env freqenv)
- (* (env pervenv)
- (triangle-wave per-vib))
- (* (env ranvenv)
- (rand-interp ran-vib))))
- (set! cascadeout (* dev (oscil gens1 (* vib freqratios1))))
- (locsig loc i (+ (* (env gens5ampenv)
- (oscil gens5 (+ (* vib freqratios5)
- (* (env gens2ampenv)
- (oscil gens2 (+ cascadeout (* vib freqratios2)))))))
- (* (env gens6ampenv)
- (oscil gens6 (+ (* vib freqratios6)
- (* (env gens3ampenv)
- (oscil gens3 (+ cascadeout (* vib freqratios3)))))))
- (* (env gens7ampenv)
- (oscil gens7 (+ (* vib freqratios7)
- (* (env gens4ampenv)
- (oscil gens4 (+ cascadeout (* vib freqratios4))))))))))))))
-
+ (let ((c 261.62)
+ (vowel (floor vowel-1))
+ (sex (floor sex-1))
+ (ampref (expt amp .8))
+ (deg (- deg 45))
+ (ranfreq 20)
+ (fm2 3)
+ (mscale 1)
+ (mconst 0)
+ (indx1 1))
+ (let ((vibfreq (fncval (vibfreqfun sex) pitch))
+ (vibpc (* .01 (log pitch 2) (+ .15 (sqrt amp)) vibscl))
+ (ranpc (* .002 (log pitch 2) (- 2 (expt amp .25)) pcran))
+ (skewpc (if (= sex 1)
+ (* (sqrt (+ .1 (* .05 ampref (- 1568 130.8)))) skewscl)
+ (* (sqrt (+ .1 (* .05 ampref (- 130.8 16.5)))) skewscl)))
+ (form1 (/ (fncval (aref fnc sex vowel 1 1) pitch) pitch))
+ (form2 (/ (fncval (aref fnc sex vowel 2 1) pitch) pitch))
+ (form3 (/ (fncval (aref fnc sex vowel 3 1) pitch) pitch)))
+ (let ((fmntfreq1 (round form1))
+ (fmntfreq2 (round form2))
+ (fmntfreq3 (round form3))
+ (mfq (+ (* pitch mscale) mconst))
+ (freqratios1 fm2)
+ (freqratios2 mscale)
+ (freqratios3 mscale)
+ (freqratios4 mscale))
+ (let ((freqratios5 fmntfreq1)
+ (freqratios6 fmntfreq2)
+ (freqratios7 fmntfreq3)
+ (amp1 (sqrt amp))
+ (amp2 (expt amp 1.5))
+ (amp3 (* amp amp))
+ (formscl1 (abs (- form1 fmntfreq1)))
+ (formscl2 (abs (- form2 fmntfreq2)))
+ (formscl3 (abs (- form3 fmntfreq3)))
+ (i3 (if (< pitch (/ c 2))
+ (fncval (i3fun1 sex) pitch)
+ (fncval (i3fun2 sex) pitch)))
+ (indx0 (if (or (= vowel 3) (= vowel 4)) 0 1.5)))
+ (let ((caramp1sc (* (fncval (aref fnc sex vowel 1 2) pitch) (- 1 formscl1) amp1))
+ (caramp2sc (* (fncval (aref fnc sex vowel 2 2) pitch) (- 1 formscl2) amp2))
+ (caramp3sc (* (fncval (aref fnc sex vowel 3 2) pitch) (- 1 formscl3) amp3))
+ (scdev1 (fncval (aref fnc sex vowel 1 3) pitch))
+ (scdev2 (fncval (aref fnc sex vowel 2 3) pitch))
+ (scdev3 (fncval (aref fnc sex vowel 3 3) pitch))
+ (dev (hz->radians (* i3 mfq)))
+ (dev0 (hz->radians (* indx0 mfq)))
+ (dev1 (hz->radians (* (- indx1 indx0) mfq))))
+ (let ((gens1 (make-oscil 0))
+ (gens2 (make-oscil 0 (/ pi 2.0)))
+ (gens2ampenv (make-env indxfun :duration dur
+ :scaler (* scdev1 dev1)
+ :offset (* scdev1 dev0)))
+ (gens3 (make-oscil 0 (/ pi 2.0)))
+ (gens3ampenv (make-env indxfun :duration dur
+ :scaler (* scdev2 dev1)
+ :offset (* scdev2 dev0)))
+ (gens4 (make-oscil 0 (/ pi 2.0)))
+ (gens4ampenv (make-env indxfun :duration dur
+ :scaler (* scdev3 dev1)
+ :offset (* scdev3 dev0)))
+ (gens5 (make-oscil 0))
+ (gens5ampenv (make-env ampfun1 :duration dur
+ :scaler (* amp caramp1sc .75)))
+ (gens6 (make-oscil 0))
+ (gens6ampenv (make-env ampfun2 :duration dur
+ :scaler (* amp caramp2sc .75)))
+ (gens7 (make-oscil 0))
+ (gens7ampenv (make-env ampfun3 :duration dur
+ :scaler (* amp caramp3sc .75)))
+ (freqenv (make-env (addenv glissfun (* glissamt pitch) 0 skewfun (* skewpc pitch) pitch) :duration dur
+ :scaler (hz->radians 1.0)))
+ (pervenv (make-env vibfun :duration dur
+ :scaler vibpc))
+ (ranvenv (make-env :envelope ranfun :duration dur
+ :scaler ranpc))
+ (per-vib (make-triangle-wave :frequency vibfreq
+ :amplitude (hz->radians pitch)))
+ (ran-vib (make-rand-interp :frequency ranfreq
+ :amplitude (hz->radians pitch)))
+ (loc (make-locsig :degree deg :distance dis :reverb pcrev))
+ (start (floor (* *clm-srate* beg)))
+ (end (floor (* *clm-srate* (+ beg dur)))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let* ((vib (+ (env freqenv)
+ (* (env pervenv)
+ (triangle-wave per-vib))
+ (* (env ranvenv)
+ (rand-interp ran-vib))))
+ (cascadeout (* dev (oscil gens1 (* vib freqratios1)))))
+ (locsig loc i (+ (* (env gens5ampenv)
+ (oscil gens5 (+ (* vib freqratios5)
+ (* (env gens2ampenv)
+ (oscil gens2 (+ cascadeout (* vib freqratios2)))))))
+ (* (env gens6ampenv)
+ (oscil gens6 (+ (* vib freqratios6)
+ (* (env gens3ampenv)
+ (oscil gens3 (+ cascadeout (* vib freqratios3)))))))
+ (* (env gens7ampenv)
+ (oscil gens7 (+ (* vib freqratios7)
+ (* (env gens4ampenv)
+ (oscil gens4 (+ cascadeout (* vib freqratios4))))))))))))))
+ ))))
#|
(let ((ampf '(0 0 1 1 2 1 3 0)))
- (with-sound (:play #t) (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 1 .01 0 ampf .01)))
+ (with-sound (:play #t) (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 .01 0 ampf .01)))
+
+(definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
+ dis pcrev deg vibscl pcran skewscl glissfun glissamt)
-(defmacro voi (beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
- dis pcrev deg vibscl skewscl ranpower)
+(define-macro (voi beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
+ dis pcrev deg vibscl skewscl)
`(fm-voice ,beg ,dur ,pitch ,amp ,vowel-1 ,sex-1 ,ampfun1 ,ampfun2 ,ampfun3 ,indxfun ,skewfun ,vibfun ,ranfun
- ,dis ,pcrev ,deg ,vibscl 0 ,skewscl ,ranpower '(0 0 100 0)))
+ ,dis ,pcrev ,deg ,vibscl 0 ,skewscl '(0 0 100 0)))
|#
diff --git a/kmenu.scm b/kmenu.scm
deleted file mode 100644
index 81837b1..0000000
--- a/kmenu.scm
+++ /dev/null
@@ -1,182 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; add mnemonics to the main menu (gtk only)
-
-
-(define (string-index str chr)
- (let ((len (string-length str))
- (res #f))
- (and (char? chr)
- (do ((i 0 (+ i 1)))
- ((or res (= i len)) res)
- (set! res (char=? (string-ref str i) chr))))))
-
-(define (string-replace str rstr ind ignore)
- (string-set! str i (string-ref rstr 0)))
-
-(define (find thunk lst)
- (if (null? lst)
- #f
- (if (thunk (car lst))
- (car lst)
- (find thunk (cdr lst)))))
-
-
-(let ()
- ;; returns #f if there is no label (e.g. for tearoff menu item)
- (define (get-label widget)
- (cond ((gtk_bin_get_child (GTK_BIN widget))
- => (lambda (child)
- (gtk_label_get_text (GTK_LABEL child))))
- (else #f)))
-
- (define (get-mnemonic widget)
- (let ((child (gtk_bin_get_child (GTK_BIN widget))))
- (if (not child) #f
- (let ((symbol (gtk_label_get_mnemonic_keyval (GTK_LABEL child))))
- (if (equal? GDK_KEY_VoidSymbol symbol) #f
- symbol)))))
-
- (define (set-label widget text)
- (gtk_label_set_text_with_mnemonic
- (GTK_LABEL (gtk_bin_get_child (GTK_BIN widget)))
- text))
-
- ;; range(n) -> (0, 1, ..., n-1)
- (define (range n)
- (let rec ((i n)
- (res '()))
- (if (positive? i)
- (rec (- i 1) (cons (- i 1) res))
- res)))
-
- (define (g_list->list g)
- (map (lambda (i) (g_list_nth_data g i))
- (range (g_list_length g))))
-
- (define (root-menu)
- (GTK_MENU (list-ref (menu-widgets) 0)))
-
- (define (menu-items menu)
- (map GTK_MENU_ITEM
- (g_list->list (gtk_container_get_children (GTK_CONTAINER menu)))))
-
- ;; returns #f if there is no submenu
- (define (submenu menu-item)
- (gtk_menu_item_get_submenu (GTK_MENU_ITEM menu-item)))
-
- (define (mnemonizer)
- (define used-chars '())
- (define (test-char x)
- (let ((c (char-upcase x)))
- (if (member c used-chars)
- #f
- (begin
- (set! used-chars (cons c used-chars))
- #t))))
- (define (newname s)
- (let ((i (string-index s test-char)))
- (if i (string-replace s "_" i i) s)))
- newname)
-
- (define (mnemonize-menu m)
- (define mnemonize (mnemonizer))
- (define (op menu-item)
- (cond ((get-label menu-item)
- => (lambda (s)
- (if (not (string-index s #\_)) ;ignore labels with underscore
- (set-label menu-item (mnemonize s))))))
- (cond ((submenu menu-item)
- => (lambda (m) (mnemonize-menu m)))))
- (map op (menu-items m)))
-
-
-
- ;;add mqnemonics to all menu items recursively
- (mnemonize-menu (root-menu))
-
- (let ()
- (define (add-tearoff menu)
- (let ((tearoff (gtk_tearoff_menu_item_new)))
- (gtk_menu_shell_prepend (GTK_MENU_SHELL menu) tearoff)
- (gtk_widget_show tearoff)))
-
- ;;lookup top-level menu by name
- (define (find-menu name)
- (find (lambda (x) (equal? name (get-label x)))
- (menu-items (root-menu))))
-
- ;;lookup menu item by path
- ;;e.g. (find-menu-rec '("Options" "Zoom focus" "window right edge"))
- (define (find-menu-rec path)
- (let rec ((menu (root-menu)) (path path))
- (if (null? path) #f
- (let ((item (find (lambda (x) (equal? (car path) (get-label x)))
- (menu-items menu))))
- (if (not item) #f
- (if (null? (cdr path))
- item
- (rec (submenu item) (cdr path))))))))
-
- ;;add tearoffs to Ladspa menu submenus
- (cond ((find-menu "Ladspa")
- => (lambda (m)
- (add-tearoff (submenu m))
- (map add-tearoff
- (filter-map submenu (menu-items (submenu m)))))))
-
- ;;add tearoff to Effects menu
- (cond ((find-menu "Effects")
- => (lambda (m) (add-tearoff (submenu m)))))
-
-
- (let ()
- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; accellerators
-
- ;;(define (mksetaccel)
- (define setaccel!
- (let setaccel ()
- (define rootwin (GTK_WINDOW (list-ref (main-widgets) 1)))
- (define agroup (gtk_accel_group_new))
- (define (set-accel widget gdk_key gdk_mod)
- (if widget
- (begin
- (gtk_widget_add_accelerator (GTK_WIDGET widget) "activate" agroup
- gdk_key gdk_mod GTK_ACCEL_VISIBLE)
- (gtk_window_add_accel_group rootwin agroup))))
- set-accel))
-
- (if (not (procedure? (key-binding #\o 4)))
- (setaccel! (find-menu-rec '("File" "Open")) GDK_KEY_O GDK_CONTROL_MASK))
-
- (if (not (procedure? (key-binding #\w 4)))
- (setaccel! (find-menu-rec '("File" "Close")) GDK_KEY_W GDK_CONTROL_MASK))
- (if (not (procedure? (key-binding #\s 4)))
- (setaccel! (find-menu-rec '("File" "Save")) GDK_KEY_S GDK_CONTROL_MASK))
-
- ;;(setaccel! (find-menu-rec '("File" "Save as")) GDK_KEY_S (+ GDK_CONTROL_MASK GDK_SHIFT_MASK))
- (if (not (procedure? (key-binding #\n 4)))
- (setaccel! (find-menu-rec '("File" "New")) GDK_KEY_N GDK_CONTROL_MASK))
-
- (if (not (procedure? (key-binding #\z 4)))
- (setaccel! (find-menu-rec '("Edit" "Undo")) GDK_KEY_Z GDK_CONTROL_MASK))
-
- (if (not (procedure? (key-binding #\z 5)))
- (setaccel! (find-menu-rec '("Edit" "Redo")) GDK_KEY_Z (+ GDK_CONTROL_MASK GDK_SHIFT_MASK)))
-
- (if (not (procedure? (key-binding #\a 4)))
- (setaccel! (find-menu-rec '("Edit" "Select all")) GDK_KEY_A GDK_CONTROL_MASK))
- )
- )
-)
-
-
-
-
-
-
-
-
-
-
-
diff --git a/leslie.cms b/leslie.cms
new file mode 100644
index 0000000..c6d721b
--- /dev/null
+++ b/leslie.cms
@@ -0,0 +1,262 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; leslie.cms
+;;
+;; Time varying delay-lines
+;; ========================
+;; Doppler shift for Leslie
+;;
+;; Based on:
+;; Abel, Berners, Serafin, Smith J.O
+;; "Doppler Simulation and the Leslie",
+;; Proc. of DAFx-02, September, 2002
+;;
+;; Thanks to Patty Huang
+;;
+;;
+;; Syntax: CLM-4, S7
+;;
+;;
+;; juanig at ccrma
+;;
+;; First version March 20, 2004
+;; Last update September 12, 2014
+;;
+;; NOTES:
+;; Get Leslie effect on a pulse-train waveshape. Try acceleration with the vel-envelope.
+;; It can also be used to apply a Leslie effect to a soundfile. Just switch to the
+;; 'make-readin', readin ug.
+;;
+;; 06/20/2014 fixed delays and delay lines length
+;; 09/10/2014 added reflection delay lines
+;; 09/12/2014 added lowport baffle section using a lowpass butterworth
+;; 09/18/2014 S7 .cms version
+;;
+;;
+
+(define sspeed 345.12) ;; Velocity of sound
+(define twopi (* 2 pi))
+(define oneturn (* pi 2))
+
+
+
+;; We need a Lowpass filter for the lower part, low frequency (baffle)
+;; of the Leslie cabinet
+
+
+;; A butterworth Lowpass filter (as in dsp.scm).
+
+(define (make-butter-low-pass fq)
+ (let* ((r (/ 1.0 (tan (/ (* pi fq) *clm-srate*))))
+ (r2 (* r r))
+ (c1 (/ 1.0 (+ 1.0 (* r (sqrt 2.0)) r2)))
+ (c2 (* 2.0 c1))
+ (c3 c1)
+ (c4 (* 2.0 (- 1.0 r2) c1))
+ (c5 (* (+ (- 1.0 (* r (sqrt 2.0))) r2) c1))
+ (arra (make-float-vector 3 ))
+ (arrb (make-float-vector 3 )))
+ (set! (arra 0) c1)
+ (set! (arra 1) c2)
+ (set! (arra 2) c3)
+ (set! (arrb 0) 0.0)
+ (set! (arrb 1) c4)
+ (set! (arrb 2) c5)
+ (make-filter 3 arra arrb) ))
+
+
+;;; Macros to handle Lowpass filter
+;;
+
+(define (butter f sample0)
+ (filter f sample0))
+
+
+;; macro to sweep frequencies
+;;
+
+(define (sweep-butterfq b freq)
+ `(let* ((fq ,freq)
+ (r (/ 1.0 (tan (/ (* pi fq) *srate*))))
+ (r2 (* r r))
+ (c1 (/ 1.0 (+ 1.0 (* r (sqrt 2.0)) r2))))
+ (set! (mus-xcoeff ,b 0) c1)
+ (set! (mus-xcoeff ,b 1) (* 2.0 c1))
+ (set! (mus-xcoeff ,b 2) c1)
+ (set! (mus-ycoeff ,b 1) (* 2.0 (- 1.0 r2) c1))
+ (set! (mus-ycoeff ,b 2) (* (+ (- 1.0 (* r (sqrt 2.0))) r2) c1))
+ ))
+
+
+
+(definstrument (rotates start dur freq
+ (speedsl 3.33) ;; Speed source listener mts/sec
+ (velenv '(0 1 100 1)) ;; Velocity envelope
+ (gain 0.125) ;; scales output
+ ;; (onset 0.0) ;; onset values in case of reading a soundfile
+ (rev-amount 0.025)) ;; very short reverb
+
+ (let* ((beg (seconds->samples start))
+ (sig (make-pulse-train :frequency freq))
+ ;;; (rdA (make-readin :file file ;; just in case you want to read
+ ;;; :start (seconds->samples onset)) ;; a soundfile instead
+ ;;;
+ (maxddelayl (if (= *clm-srate* 44100) (values 96)
+ (values 104)))
+ (startddelay (if (= *clm-srate* 44100) (values 48)
+ (values 52)))
+ (m2samp (/ *clm-srate* sspeed))
+ (vel-env (make-env velenv :duration (* dur 0.5)))
+ ;;;
+ ;;; Doppler delay lines
+ ;;;
+ (dpdelays (make-vector 4))
+ (dshift (make-vector 4 startddelay))
+ ;;
+ ;;;
+ ;;; Reflection path delay arrays
+ ;;;
+ (refldelays (make-vector 4))
+ (reflectlen (make-vector 4))
+ (reflections (make-vector 4 0.0))
+ (hornout (make-vector 4 0.0))
+ ;;
+ ;; Lowpass (baffle) 'frequency shift' array
+ (fshift (make-vector 4))
+ (baffleout (make-vector 4))
+ ;;
+ (bfila (make-butter-low-pass 200))
+ (bfilb (make-butter-low-pass 200))
+ (bfilc (make-butter-low-pass 200))
+ (bfild (make-butter-low-pass 200))
+ ;;
+ (growf0 0.0)
+ (growf1 0.0)
+ (growfa 0.0)
+ (growfb 0.0)
+ ;;
+ (hornangvel 1.0)
+ (baffleangvel 1.0)
+ (hornangle 0.0)
+ (hornradius 0.18)
+ (baffleangle 0.0)
+ (baffleradius 0.19050)
+ ;;
+ (xdev 0.0)
+ (ydev 0.0)
+ (cabinetlen 0.71)
+ (cabinetwid 0.52)
+ ;;
+ (end (+ beg (seconds->samples dur)))
+ )
+ ;;
+ ;; Make delays
+ ;;
+ (do ((i 0 (1+ i)))
+ ((= i 4 ))
+ (set! (dpdelays i) (make-delay :size startddelay
+ :max-size maxddelayl
+ :type mus-interp-linear))
+ (set! (refldelays i) (make-delay )))
+ ;;
+ ;;
+ ;;;
+ ;;; main loop
+ ;;;
+ (do ((i beg (1+ i)))
+ ((= i end ))
+ ;;
+ (let ((sample (pulse-train sig))
+ ;;; (sample (readin rdA)) switch in case of reading a soundfile
+ (deltavel (env vel-env))
+ (sigouta 0.0) (sigoutb 0.0) ;; horn
+ (sigoutc 0.0) (sigoutd 0.0) ;; reflections
+ (woofera 0.0) (wooferb 0.0)) ;; low baffle output
+ ;;
+ ;; set acceleration of horn
+ (set! hornangvel (* speedsl deltavel))
+ (set! hornangle (+ hornangle (* twopi (/ hornangvel *clm-srate*))))
+ ;; baffle lower port
+ (set! baffleangvel (* 0.98 speedsl ))
+ (set! baffleangle (+ baffleangle (* twopi (/ baffleangvel *clm-srate*))))
+ ;;
+ (if (> hornangle twopi) (set! hornangle (- hornangle twopi)))
+ (if (> baffleangle twopi) (set! baffleangle (- baffleangle twopi)))
+ ;;
+ ;; calculate grow functions for delay line size (horn Doppler shifts)
+ (set! growf0 (/ (*(* (- twopi) hornradius) (* hornangvel (cos hornangle))) sspeed))
+ (set! growf1 (/ (*(* (- twopi) hornradius) (* hornangvel (sin hornangle))) sspeed))
+ ;;
+ (set! (dshift 0) (- (dshift 0) growf0))
+ (set! (dshift 1) (- (dshift 1) growf1))
+ (set! (dshift 2) (- (dshift 2) (- growf0)))
+ (set! (dshift 3) (- (dshift 3) (- growf1)))
+ ;;
+ (do ((j 0 (1+ j)))
+ ((= j 4))
+ (set! (hornout j ) (delay (dpdelays j) sample (dshift j)))
+ )
+ ;;
+ ;; Reflections
+ ;;
+ (set! xdev (* hornradius (cos hornangle)))
+ (set! ydev (* hornradius (sin hornangle)))
+ (set! (reflectlen 0) (* (+ (/ cabinetwid 2) ydev) m2samp))
+ (set! (reflectlen 1) (* (- cabinetlen xdev) m2samp))
+ (set! (reflectlen 2) (* 1.5 (- cabinetwid ydev) m2samp))
+ (set! (reflectlen 3) (* (+ cabinetlen xdev) m2samp))
+ ;;
+ ;; Need to add these reflections to *reverb*
+ (do ((j 0 (1+ j)))
+ ((= j 4))
+ (set! (reflections j) (delay (refldelays j)
+ (hornout j)
+ (reflectlen j))))
+ ;;
+ (set! sigouta (+ (hornout 0) (hornout 2)))
+ (set! sigoutb (+ (hornout 1) (hornout 3)))
+ (set! sigoutc (+ (reflections 0) (reflections 2)))
+ (set! sigoutd (+ (reflections 1) (reflections 3)))
+ ;;
+ ;; Grow functions baffle low port section
+ (set! growfa (* (- twopi) baffleradius baffleangvel (cos baffleangle)))
+ (set! growfb (* (- twopi) baffleradius baffleangvel (sin baffleangle)))
+ ;;
+ (set! (fshift 0) (+ 250 (* growfa 50)))
+ (set! (fshift 1) (+ 250 (* growfb 50)))
+ (set! (fshift 2) (+ 250 (* (- growfa) 50)))
+ (set! (fshift 3) (+ 250 (* (- growfb) 50)))
+ ;;
+ (sweep-butterfq bfila (fshift 0))
+ (sweep-butterfq bfilb (fshift 1))
+ (sweep-butterfq bfilc (fshift 2))
+ (sweep-butterfq bfild (fshift 3))
+ ;;
+ (set! (baffleout 0) (butter bfila sample))
+ (set! (baffleout 1) (butter bfilb sample))
+ (set! (baffleout 2) (butter bfilc sample))
+ (set! (baffleout 3) (butter bfild sample))
+ ;;
+ (set! woofera (+ (baffleout 0) (baffleout 2)))
+ (set! wooferb (+ (baffleout 1) (baffleout 3)))
+ ;;
+ (outa i (* gain (+ sigouta sigoutc woofera)))
+ (outb i (* gain (+ sigoutb sigoutd wooferb)))
+ ;;;
+ (if *reverb*
+ (progn
+ (outa i (* (* 0.5 gain) (+ sigoutc woofera) rev-amount) *reverb*)
+ (outb i (* (* 0.5 gain) (+ sigoutd wooferb) rev-amount) *reverb*) ))
+ ))
+ ))
+
+;;; (with-sound (:channels 2) (rotates 0 1 800))
+;;; (with-sound (:channels 2) (rotates 0 3 200))
+;;; (with-sound (:channels 2) (rotates 0 8 300 :speedsl 1.0))
+;;; (with-sound (:channels 2) (rotates 0 3 500 :speedsl 1.0))
+;;; (with-sound (:channels 2) (rotates 0 3 500 :velenv '(0 0 100 1)))
+;;; (with-sound (:channels 2) (rotates 0 3 500 :velenv '(0 1 100 0.25)))
+
+;;; (load "nrev.ins")
+
+;;; (with-sound (:channels 2 :reverb nrev :reverb-channels 2) (rotates 0 5 500 :velenv '(0 1 100 0.25)))
diff --git a/libc.scm b/libc.scm
new file mode 100644
index 0000000..9370102
--- /dev/null
+++ b/libc.scm
@@ -0,0 +1,1694 @@
+;;; libc.scm
+;;;
+;;; tie the C library into the *libc* environment
+
+(provide 'libc.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((current-file (port-filename (current-input-port))))
+ (let ((directory (and (or (char=? (current-file 0) #\/)
+ (char=? (current-file 0) #\~))
+ (substring current-file 0 (- (length current-file) 9)))))
+ (when (and directory (not (member directory *load-path*)))
+ (set! *load-path* (cons directory *load-path*)))
+ (with-let (rootlet)
+ (require cload.scm))
+ (when (and directory (not (string-position directory *cload-cflags*)))
+ (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*)))))
+
+(if (not (defined? '*libc*))
+ (define *libc*
+ (with-let (unlet)
+ (set! *libraries* (cons (cons "libc.scm" (curlet)) *libraries*))
+
+ ;; -------- stddef.h --------
+ (define NULL (c-pointer 0))
+ (define (c-null? p) (equal? p NULL))
+
+ ;; -------- stdbool.h --------
+ (define false #f)
+ (define true #t)
+
+ ;; -------- iso646.h --------
+ ;; spelled-out names for & = bitand et al
+
+ ;; -------- stdarg.h --------
+ ;; the varargs macros
+
+ ;; -------- assert.h --------
+ ;; assert macro
+#|
+ (define-expansion (assert assertion)
+ (reader-cond ((not (defined? 'NDEBUG))
+ `(if (not ,assertion)
+ (error 'assert-failure "~S[~D]: ~A failed~%"
+ (port-filename) (port-line-number) ',assertion)))
+ (#t (values))))
+ (define (hiho a) (assert (> a 2)) (+ a 1))
+
+ (define-expansion (comment . stuff)
+ (reader-cond (#t (values))))
+|#
+
+
+ ;; -------- setjmp.h --------
+ ;; longjmp etc
+
+ ;; -------- dlfn.h --------
+ ;; see libdl.scm, similarly for pthreads see libpthread.scm
+
+ ;; -------- sys/types.h inttypes.h getopt.h--------
+ ;; C type declarations
+
+ (c-define
+ '(;; -------- limits.h --------
+ (C-macro (int (SCHAR_MIN SCHAR_MAX UCHAR_MAX CHAR_BIT CHAR_MIN CHAR_MAX __WORDSIZE
+ SHRT_MIN SHRT_MAX USHRT_MAX INT_MIN INT_MAX UINT_MAX LONG_MIN LONG_MAX ULONG_MAX
+ LLONG_MIN LLONG_MAX ULLONG_MAX
+ _POSIX_AIO_LISTIO_MAX _POSIX_AIO_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX _POSIX_DELAYTIMER_MAX _POSIX_HOST_NAME_MAX
+ _POSIX_LINK_MAX _POSIX_LOGIN_NAME_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_MQ_OPEN_MAX _POSIX_MQ_PRIO_MAX
+ _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX _POSIX_FD_SETSIZE _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_RE_DUP_MAX
+ _POSIX_RTSIG_MAX _POSIX_SEM_NSEMS_MAX _POSIX_SEM_VALUE_MAX _POSIX_SIGQUEUE_MAX _POSIX_SSIZE_MAX _POSIX_STREAM_MAX
+ _POSIX_SYMLINK_MAX _POSIX_SYMLOOP_MAX _POSIX_TIMER_MAX _POSIX_TTY_NAME_MAX _POSIX_TZNAME_MAX _POSIX_QLIMIT
+ _POSIX_HIWAT _POSIX_UIO_MAXIOV _POSIX_CLOCKRES_MIN SSIZE_MAX NGROUPS_MAX _POSIX2_BC_BASE_MAX _POSIX2_BC_DIM_MAX
+ _POSIX2_BC_SCALE_MAX _POSIX2_BC_STRING_MAX _POSIX2_COLL_WEIGHTS_MAX _POSIX2_EXPR_NEST_MAX _POSIX2_LINE_MAX
+ _POSIX2_RE_DUP_MAX _POSIX2_CHARCLASS_NAME_MAX BC_BASE_MAX BC_DIM_MAX BC_SCALE_MAX BC_STRING_MAX COLL_WEIGHTS_MAX
+ EXPR_NEST_MAX LINE_MAX CHARCLASS_NAME_MAX RE_DUP_MAX)))
+
+
+ ;; -------- float.h --------
+ (C-macro (int (FLT_RADIX FLT_MANT_DIG DBL_MANT_DIG LDBL_MANT_DIG FLT_DIG DBL_DIG LDBL_DIG FLT_MIN_EXP DBL_MIN_EXP
+ LDBL_MIN_EXP FLT_MIN_10_EXP DBL_MIN_10_EXP LDBL_MIN_10_EXP FLT_MAX_EXP DBL_MAX_EXP LDBL_MAX_EXP
+ FLT_MAX_10_EXP DBL_MAX_10_EXP LDBL_MAX_10_EXP FLT_ROUNDS FLT_EVAL_METHOD)))
+ (C-macro (double (FLT_MAX DBL_MAX LDBL_MAX FLT_EPSILON DBL_EPSILON LDBL_EPSILON FLT_MIN DBL_MIN LDBL_MIN)))
+
+
+ ;; -------- stdint.h --------
+ (C-macro (int (INT8_MIN INT16_MIN INT32_MIN INT64_MIN INT8_MAX INT16_MAX INT32_MAX INT64_MAX UINT8_MAX UINT16_MAX
+ UINT32_MAX UINT64_MAX INT_LEAST8_MIN INT_LEAST16_MIN INT_LEAST32_MIN INT_LEAST64_MIN INT_LEAST8_MAX
+ INT_LEAST16_MAX INT_LEAST32_MAX INT_LEAST64_MAX UINT_LEAST8_MAX UINT_LEAST16_MAX UINT_LEAST32_MAX
+ UINT_LEAST64_MAX INT_FAST8_MIN INT_FAST16_MIN INT_FAST32_MIN INT_FAST64_MIN INT_FAST8_MAX INT_FAST16_MAX
+ INT_FAST32_MAX INT_FAST64_MAX UINT_FAST8_MAX UINT_FAST16_MAX UINT_FAST32_MAX UINT_FAST64_MAX INTPTR_MIN
+ INTPTR_MAX UINTPTR_MAX INTMAX_MIN INTMAX_MAX UINTMAX_MAX PTRDIFF_MIN PTRDIFF_MAX SIG_ATOMIC_MIN SIG_ATOMIC_MAX
+ SIZE_MAX WCHAR_MIN WCHAR_MAX WINT_MIN WINT_MAX )))
+
+ (c-pointer (stdin stdout stderr))
+
+ ;; -------- endian.h --------
+ ;; also has htobe16 etc
+ (C-macro (int (__BYTE_ORDER __BIG_ENDIAN __LITTLE_ENDIAN)))
+
+
+ (in-C "static s7_pointer g_c_pointer_to_string(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string_with_length(sc, (const char *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args))));}
+ static s7_pointer g_string_to_c_pointer(s7_scheme *sc, s7_pointer args)
+ {
+ if (s7_is_string(s7_car(args)))
+ return(s7_make_c_pointer(sc, (void *)s7_string(s7_car(args))));
+ return(s7_car(args));
+ }")
+
+ (C-function ("c-pointer->string" g_c_pointer_to_string "" 2))
+ (C-function ("string->c-pointer" g_string_to_c_pointer "" 1))
+
+ ;; -------- ctype.h --------
+ (int isalnum (int))
+ (int isalpha (int))
+ (int iscntrl (int))
+ (int isdigit (int))
+ (int islower (int))
+ (int isgraph (int))
+ (int isprint (int))
+ (int ispunct (int))
+ (int isspace (int))
+ (int isupper (int))
+ (int isxdigit (int))
+ (int tolower (int))
+ (int toupper (int))
+
+ ;; -------- fcntl.h --------
+ (C-macro (int (S_IFMT S_IFDIR S_IFCHR S_IFBLK S_IFREG S_IFIFO __S_IFLNK S_IFSOCK S_ISUID S_ISGID S_IRUSR
+ S_IWUSR S_IXUSR S_IRWXU S_IRGRP S_IWGRP S_IXGRP S_IRWXG S_IROTH S_IWOTH S_IXOTH S_IRWXO R_OK W_OK X_OK
+ F_OK SEEK_SET SEEK_CUR SEEK_END F_ULOCK F_LOCK F_TLOCK F_TEST O_ACCMODE O_RDONLY O_WRONLY O_RDWR O_CREAT
+ O_EXCL O_NOCTTY O_TRUNC O_APPEND O_NONBLOCK O_NDELAY O_SYNC O_FSYNC O_ASYNC O_DSYNC O_RSYNC O_LARGEFILE
+ F_DUPFD F_GETFD F_SETFD F_GETFL F_SETFL F_GETLK F_SETLK F_SETLKW F_GETLK64 F_SETLK64 F_SETLKW64
+ FD_CLOEXEC F_RDLCK F_WRLCK F_UNLCK POSIX_FADV_NORMAL POSIX_FADV_RANDOM POSIX_FADV_SEQUENTIAL
+ POSIX_FADV_WILLNEED POSIX_FADV_DONTNEED POSIX_FADV_NOREUSE)))
+ (int fcntl (int int))
+ (in-C "static s7_pointer g_c_open(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer arg;
+ char* name;
+ int flags, mode;
+ arg = args;
+ if (s7_is_string(s7_car(arg)))
+ name = (char*)s7_string(s7_car(arg));
+ else return(s7_wrong_type_arg_error(sc, \"open\", 1, s7_car(arg), \"string\"));
+ arg = s7_cdr(arg);
+ if (s7_is_integer(s7_car(arg)))
+ flags = (int)s7_integer(s7_car(arg));
+ else return(s7_wrong_type_arg_error(sc, \"open\", 2, s7_car(arg), \"integer\"));
+ if (s7_is_pair(s7_cdr(arg)))
+ {
+ arg = s7_cdr(arg);
+ if (s7_is_integer(s7_car(arg)))
+ mode = (int)s7_integer(s7_car(arg));
+ else return(s7_wrong_type_arg_error(sc, \"open\", 3, s7_car(arg), \"integer\"));
+ return(s7_make_integer(sc, (s7_int)open(name, flags, mode)));
+ }
+ return(s7_make_integer(sc, (s7_int)open(name, flags)));
+ }")
+ (C-function ("open" g_c_open "" 2 1))
+ (int creat (char* (mode_t int)))
+ (int lockf (int int int))
+ (reader-cond ((provided? 'linux)
+ (int posix_fadvise (int int int int))
+ (int posix_fallocate (int int int))))
+
+
+ ;; -------- fenv.h --------
+ (C-macro (int (FE_INEXACT FE_DIVBYZERO FE_UNDERFLOW FE_OVERFLOW FE_INVALID FE_ALL_EXCEPT
+ FE_TONEAREST FE_UPWARD FE_DOWNWARD FE_TOWARDZERO)))
+ (int feclearexcept (int))
+ (int fegetexceptflag (fexcept_t* int) )
+ (int feraiseexcept (int) )
+ (int fesetexceptflag (fexcept_t* int) )
+ (int fetestexcept (int) )
+ (int fegetround (void) )
+ (int fesetround (int) )
+ (int fegetenv (fenv_t*) )
+ (int feholdexcept (fenv_t*) )
+ (int fesetenv (fenv_t*) )
+ (int feupdateenv (fenv_t*) )
+
+
+ ;; -------- fnmatch.h --------
+ (C-macro (int (FNM_PATHNAME FNM_NOESCAPE FNM_PERIOD FNM_FILE_NAME FNM_LEADING_DIR FNM_CASEFOLD FNM_EXTMATCH FNM_NOMATCH)))
+ (int fnmatch (char* char* int))
+
+
+ ;; -------- string.h --------
+ (void* memcpy (void* void* size_t))
+ (void* memmove (void* void* size_t))
+ (void* memset (void* int size_t))
+ (int memcmp (void* void* size_t))
+ (void* memchr (void* int size_t))
+ (char* strcpy (char* char*))
+ (char* strncpy (char* char* size_t))
+ (char* strcat (char* char*))
+ (char* strncat (char* char* size_t))
+ (int strcmp (char* char*))
+ (int strncmp (char* char* size_t))
+ (int strcoll (char* char*))
+ (size_t strxfrm (char* char* size_t))
+ (char* strchr (char* int))
+ (char* strrchr (char* int))
+ (size_t strcspn (char* char*))
+ (size_t strspn (char* char*))
+ (char* strpbrk (char* char*))
+ (char* strstr (char* char*))
+ (char* strtok (char* char*))
+ (size_t strlen (char*))
+ (reader-cond ((not (provided? 'osx)) (size_t strnlen (char* size_t))))
+ ;; strnlen is in OSX 10.8, not 10.6
+ (char* strerror (int))
+ (int strcasecmp (char* char*))
+ (int strncasecmp (char* char* size_t))
+
+
+ ;; -------- stdio.h --------
+ (C-macro (int (_IOFBF _IOLBF _IONBF BUFSIZ EOF L_tmpnam TMP_MAX FILENAME_MAX L_ctermid L_cuserid FOPEN_MAX IOV_MAX)))
+ (C-macro (char* P_tmpdir))
+
+ (int remove (char*))
+ (int rename (char* char*))
+ (FILE* tmpfile (void))
+ (reader-cond ((not (provided? 'osx))
+ (char* tmpnam (char*))
+ (char* tempnam (char* char*))))
+ (int fclose (FILE*))
+ (int fflush (FILE*))
+ ;; (reader-cond ((provided? 'linux) (int fcloseall (void))))
+ (FILE* fopen (char* char*))
+ (FILE* freopen (char* char* FILE*))
+ (FILE* fdopen (int char*))
+ (void setbuf (FILE* char*))
+ (int setvbuf (FILE* char* int size_t))
+ (void setlinebuf (FILE*))
+ (int fgetc (FILE*))
+ (int getc (FILE*))
+ (int getchar (void))
+ (int fputc (int FILE*))
+ (int putc (int FILE*))
+ (int putchar (int))
+ (char* fgets (char* int FILE*))
+ (int fputs (char* FILE*))
+ (int puts (char*))
+ (int ungetc (int FILE*))
+ (size_t fread (void* size_t size_t FILE*))
+ (size_t fwrite (void* size_t size_t FILE*))
+ (int fseek (FILE* int int))
+ (int ftell (FILE*))
+ (void rewind (FILE*))
+ (int fgetpos (FILE* fpos_t*))
+ (int fsetpos (FILE* fpos_t*))
+ (void clearerr (FILE*))
+ (int feof (FILE*))
+ (int ferror (FILE*))
+ (void perror (char*))
+ (int fileno (FILE*))
+ (FILE* popen (char* char*))
+ (int pclose (FILE*))
+ (char* ctermid (char*))
+ ;; (reader-cond ((provided? 'linux) (char* cuserid (char*))))
+ (void flockfile (FILE*))
+ (int ftrylockfile (FILE*))
+ (void funlockfile (FILE*))
+ ;; int fprintf (FILE* char* ...)
+ ;; int printf (char* ...)
+ ;; int sprintf (char* char* ...)
+ ;; int vfprintf (FILE* char* va_list)
+ ;; int vprintf (char* va_list)
+ ;; int vsprintf (char* char* va_list)
+ ;; int snprintf (char* size_t char* ...)
+ ;; int vsnprintf (char* size_t char* va_list)
+ ;; int vasprintf (char** char* va_list)
+ ;; int asprintf (char** char* ...)
+ ;; int fscanf (FILE* char* ...)
+ ;; int scanf (char* ...)
+ ;; int sscanf (char* char* ...)
+ ;; int vfscanf (FILE* char* va_list)
+ ;; int vscanf (char* va_list)
+ ;; int vsscanf (char* char* va_list)
+
+
+ ;; -------- stdlib.h --------
+ (C-macro (int (RAND_MAX EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX)))
+ (double atof (char*))
+ (int atoi (char*))
+ (int atol (char*))
+ (int atoll (char*))
+ (int random (void))
+ (void srandom (int))
+ (char* initstate (int char* size_t))
+ (char* setstate (char*))
+ (int rand (void))
+ (void srand (int))
+ (void* malloc (size_t))
+ (void* calloc (size_t size_t))
+ (void* realloc (void* size_t))
+ (void free (void*))
+ (void abort (void))
+ (void exit (int))
+ (char* getenv (char*))
+ (int putenv (char*))
+ (int setenv (char* char* int))
+ (int unsetenv (char*))
+ (char* mktemp (char*))
+ (int mkstemp (char*))
+ (int system (char*))
+ (char* realpath (char* char*))
+ (int abs (int))
+ (int labs (int))
+
+ (in-C "static s7_pointer g_llabs(s7_scheme *sc, s7_pointer args)
+ {
+ #if ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 4))))
+ return(s7_make_integer(sc, labs(s7_integer(s7_car(args)))));
+ #else
+ return(s7_make_integer(sc, llabs(s7_integer(s7_car(args)))));
+ #endif
+ }
+ static s7_pointer g_strtod(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_real(sc, strtod(s7_string(s7_car(args)), NULL)));}
+ static s7_pointer g_strtof(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_real(sc, strtof(s7_string(s7_car(args)), NULL)));}
+ static s7_pointer g_strtol(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, strtol(s7_string(s7_car(args)), NULL, s7_integer(s7_cadr(args)))));}
+ static s7_pointer g_strtoll(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, strtoll(s7_string(s7_car(args)), NULL, s7_integer(s7_cadr(args)))));}
+ static s7_pointer g_div(s7_scheme *sc, s7_pointer args)
+ {
+ div_t d;
+ d = div(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)));
+ return(s7_list(sc, 2, s7_make_integer(sc, d.quot), s7_make_integer(sc, d.rem)));
+ }
+ static s7_pointer g_ldiv(s7_scheme *sc, s7_pointer args)
+ {
+ ldiv_t d;
+ d = ldiv(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)));
+ return(s7_list(sc, 2, s7_make_integer(sc, d.quot), s7_make_integer(sc, d.rem)));
+ }
+ ")
+ (C-function ("llabs" g_llabs "" 1))
+ (C-function ("strtod" g_strtod "" 1))
+ (C-function ("strtof" g_strtof "" 1))
+ (C-function ("strtol" g_strtol "" 2))
+ (C-function ("strtoll" g_strtoll "" 2))
+ (C-function ("div" g_div "" 1))
+ (C-function ("ldiv" g_ldiv "" 1))
+
+
+ ;; -------- errno.h --------
+ ;; pws for errno?
+ (C-macro (int (__GLIBC__ __GLIBC_MINOR__ ; features.h from errno.h
+ ECANCELED EOWNERDEAD ENOTRECOVERABLE ERFKILL EILSEQ
+ ;; asm-generic/errno-base.h
+ EPERM ENOENT ESRCH EINTR EIO ENXIO E2BIG ENOEXEC EBADF ECHILD EAGAIN ENOMEM EACCES EFAULT
+ ENOTBLK EBUSY EEXIST EXDEV ENODEV ENOTDIR EISDIR EINVAL ENFILE EMFILE ENOTTY ETXTBSY EFBIG
+ ENOSPC ESPIPE EROFS EMLINK EPIPE EDOM ERANGE
+ )))
+ (in-C "static s7_pointer g_errno(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, errno));}
+ static s7_pointer g_set_errno(s7_scheme *sc, s7_pointer args) {errno = (int)s7_integer(s7_car(args)); return(s7_car(args));}")
+ (C-function ("errno" g_errno "" 0))
+ (C-function ("set_errno" g_set_errno "" 1))
+
+
+ ;; -------- locale.h --------
+ (C-macro (int (LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_MESSAGES LC_ALL LC_PAPER LC_NAME
+ LC_ADDRESS LC_TELEPHONE LC_MEASUREMENT LC_IDENTIFICATION)))
+ (char* setlocale (int char*))
+ (in-C "
+ static s7_pointer g_localeconv(s7_scheme *sc, s7_pointer args)
+ {
+ struct lconv *lc;
+ lc = localeconv();
+ return(s7_inlet(sc, s7_list(sc, 36,
+ s7_make_symbol(sc, \"decimal_point\"), s7_make_string(sc, lc->decimal_point),
+ s7_make_symbol(sc, \"thousands_sep\"), s7_make_string(sc, lc->thousands_sep),
+ s7_make_symbol(sc, \"grouping\"), s7_make_string(sc, lc->grouping),
+ s7_make_symbol(sc, \"int_curr_symbol\"), s7_make_string(sc, lc->int_curr_symbol),
+ s7_make_symbol(sc, \"currency_symbol\"), s7_make_string(sc, lc->currency_symbol),
+ s7_make_symbol(sc, \"mon_decimal_point\"), s7_make_string(sc, lc->mon_decimal_point),
+ s7_make_symbol(sc, \"mon_thousands_sep\"), s7_make_string(sc, lc->mon_thousands_sep),
+ s7_make_symbol(sc, \"mon_grouping\"), s7_make_string(sc, lc->mon_grouping),
+ s7_make_symbol(sc, \"positive_sign\"), s7_make_string(sc, lc->positive_sign),
+ s7_make_symbol(sc, \"negative_sign\"), s7_make_string(sc, lc->negative_sign),
+
+ s7_make_symbol(sc, \"int_frac_digits\"), s7_make_integer(sc, lc->int_frac_digits),
+ s7_make_symbol(sc, \"frac_digits\"), s7_make_integer(sc, lc->frac_digits),
+ s7_make_symbol(sc, \"p_cs_precedes\"), s7_make_integer(sc, lc->p_cs_precedes),
+ s7_make_symbol(sc, \"p_sep_by_space\"), s7_make_integer(sc, lc->p_sep_by_space),
+ s7_make_symbol(sc, \"n_cs_precedes\"), s7_make_integer(sc, lc->n_cs_precedes),
+ s7_make_symbol(sc, \"n_sep_by_space\"), s7_make_integer(sc, lc->n_sep_by_space),
+ s7_make_symbol(sc, \"p_sign_posn\"), s7_make_integer(sc, lc->p_sign_posn),
+ s7_make_symbol(sc, \"n_sign_posn\"), s7_make_integer(sc, lc->n_sign_posn))));
+ }")
+ (C-function ("localeconv" g_localeconv "" 0))
+
+
+ ;; -------- sys/utsname.h --------
+ (in-C "
+ static s7_pointer g_uname(s7_scheme *sc, s7_pointer args)
+ {
+ struct utsname buf;
+ uname(&buf);
+ return(s7_list(sc, 5, s7_make_string(sc, buf.sysname),
+ s7_make_string(sc, buf.machine),
+ s7_make_string(sc, buf.nodename),
+ s7_make_string(sc, buf.version),
+ s7_make_string(sc, buf.release)));
+ }")
+ (C-function ("uname" g_uname "" 0))
+
+
+ ;; -------- unistd.h --------
+ (C-macro (int (_POSIX_VERSION _POSIX2_VERSION _POSIX_JOB_CONTROL _POSIX_SAVED_IDS _POSIX_PRIORITY_SCHEDULING _POSIX_SYNCHRONIZED_IO
+ _POSIX_FSYNC _POSIX_MAPPED_FILES _POSIX_MEMLOCK _POSIX_MEMLOCK_RANGE _POSIX_MEMORY_PROTECTION _POSIX_CHOWN_RESTRICTED
+ _POSIX_VDISABLE _POSIX_NO_TRUNC _POSIX_THREADS _POSIX_REENTRANT_FUNCTIONS _POSIX_THREAD_SAFE_FUNCTIONS
+ _POSIX_THREAD_PRIORITY_SCHEDULING _POSIX_THREAD_ATTR_STACKSIZE _POSIX_THREAD_ATTR_STACKADDR _POSIX_THREAD_PRIO_INHERIT
+ _POSIX_THREAD_PRIO_PROTECT _POSIX_SEMAPHORES _POSIX_REALTIME_SIGNALS _POSIX_ASYNCHRONOUS_IO _POSIX_ASYNC_IO
+ _POSIX_PRIORITIZED_IO _POSIX_SHARED_MEMORY_OBJECTS _POSIX_CPUTIME _POSIX_THREAD_CPUTIME _POSIX_REGEXP
+ _POSIX_READER_WRITER_LOCKS _POSIX_SHELL _POSIX_TIMEOUTS _POSIX_SPIN_LOCKS _POSIX_SPAWN _POSIX_TIMERS
+ _POSIX_BARRIERS _POSIX_MESSAGE_PASSING _POSIX_THREAD_PROCESS_SHARED _POSIX_MONOTONIC_CLOCK _POSIX_CLOCK_SELECTION
+ _POSIX_ADVISORY_INFO _POSIX_IPV6 _POSIX_RAW_SOCKETS _POSIX2_CHAR_TERM _POSIX_SPORADIC_SERVER _POSIX_THREAD_SPORADIC_SERVER
+ _POSIX_TRACE _POSIX_TRACE_EVENT_FILTER _POSIX_TRACE_INHERIT _POSIX_TRACE_LOG _POSIX_TYPED_MEMORY_OBJECTS
+ STDIN_FILENO STDOUT_FILENO STDERR_FILENO)))
+
+ (C-macro
+ (int (_PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_PATH_MAX _PC_PIPE_BUF _PC_CHOWN_RESTRICTED _PC_NO_TRUNC
+ _PC_VDISABLE _PC_SYNC_IO _PC_ASYNC_IO _PC_PRIO_IO _PC_SOCK_MAXBUF _PC_FILESIZEBITS _PC_REC_INCR_XFER_SIZE _PC_REC_MAX_XFER_SIZE
+ _PC_REC_MIN_XFER_SIZE _PC_REC_XFER_ALIGN _PC_ALLOC_SIZE_MIN _PC_SYMLINK_MAX _PC_2_SYMLINKS _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK
+ _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_STREAM_MAX _SC_TZNAME_MAX _SC_JOB_CONTROL _SC_SAVED_IDS _SC_REALTIME_SIGNALS _SC_PRIORITY_SCHEDULING
+ _SC_TIMERS _SC_ASYNCHRONOUS_IO _SC_PRIORITIZED_IO _SC_SYNCHRONIZED_IO _SC_FSYNC _SC_MAPPED_FILES _SC_MEMLOCK _SC_MEMLOCK_RANGE
+ _SC_MEMORY_PROTECTION _SC_MESSAGE_PASSING _SC_SEMAPHORES _SC_SHARED_MEMORY_OBJECTS _SC_AIO_LISTIO_MAX _SC_AIO_MAX _SC_AIO_PRIO_DELTA_MAX
+ _SC_DELAYTIMER_MAX _SC_MQ_OPEN_MAX _SC_MQ_PRIO_MAX _SC_VERSION _SC_PAGESIZE _SC_PAGE_SIZE _SC_RTSIG_MAX _SC_SEM_NSEMS_MAX _SC_SEM_VALUE_MAX
+ _SC_SIGQUEUE_MAX _SC_TIMER_MAX _SC_BC_BASE_MAX _SC_BC_DIM_MAX _SC_BC_SCALE_MAX _SC_BC_STRING_MAX _SC_COLL_WEIGHTS_MAX _SC_EQUIV_CLASS_MAX
+ _SC_EXPR_NEST_MAX _SC_LINE_MAX _SC_RE_DUP_MAX _SC_CHARCLASS_NAME_MAX _SC_2_VERSION _SC_2_C_BIND _SC_2_C_DEV _SC_2_FORT_DEV _SC_2_FORT_RUN
+ _SC_2_SW_DEV _SC_2_LOCALEDEF _SC_PII _SC_PII_XTI _SC_PII_SOCKET _SC_PII_INTERNET _SC_PII_OSI _SC_POLL _SC_SELECT _SC_UIO_MAXIOV
+ _SC_IOV_MAX _SC_PII_INTERNET_STREAM _SC_PII_INTERNET_DGRAM _SC_PII_OSI_COTS _SC_PII_OSI_CLTS _SC_PII_OSI_M _SC_T_IOV_MAX _SC_THREADS
+ _SC_THREAD_SAFE_FUNCTIONS _SC_GETGR_R_SIZE_MAX _SC_GETPW_R_SIZE_MAX _SC_LOGIN_NAME_MAX _SC_TTY_NAME_MAX _SC_THREAD_DESTRUCTOR_ITERATIONS
+ _SC_THREAD_KEYS_MAX _SC_THREAD_STACK_MIN _SC_THREAD_THREADS_MAX _SC_THREAD_ATTR_STACKADDR _SC_THREAD_ATTR_STACKSIZE
+ _SC_THREAD_PRIO_INHERIT _SC_THREAD_PRIO_PROTECT _SC_THREAD_PROCESS_SHARED _SC_NPROCESSORS_CONF _SC_NPROCESSORS_ONLN _SC_PHYS_PAGES
+ _SC_AVPHYS_PAGES _SC_ATEXIT_MAX _SC_PASS_MAX _SC_2_CHAR_TERM _SC_2_C_VERSION _SC_2_UPE _SC_CHAR_BIT _SC_CHAR_MAX _SC_CHAR_MIN _SC_INT_MAX
+ _SC_INT_MIN _SC_LONG_BIT _SC_WORD_BIT _SC_MB_LEN_MAX _SC_NZERO _SC_SSIZE_MAX _SC_SCHAR_MAX _SC_SCHAR_MIN _SC_SHRT_MAX _SC_SHRT_MIN
+ _SC_UCHAR_MAX _SC_UINT_MAX _SC_ULONG_MAX _SC_USHRT_MAX _SC_NL_ARGMAX _SC_NL_LANGMAX _SC_NL_MSGMAX _SC_NL_NMAX _SC_NL_SETMAX
+ _SC_NL_TEXTMAX _SC_ADVISORY_INFO _SC_BARRIERS _SC_BASE _SC_C_LANG_SUPPORT _SC_C_LANG_SUPPORT_R _SC_CLOCK_SELECTION _SC_CPUTIME
+ _SC_THREAD_CPUTIME _SC_DEVICE_IO _SC_DEVICE_SPECIFIC _SC_DEVICE_SPECIFIC_R _SC_FD_MGMT _SC_FIFO _SC_PIPE _SC_FILE_ATTRIBUTES
+ _SC_FILE_LOCKING _SC_FILE_SYSTEM _SC_MONOTONIC_CLOCK _SC_MULTI_PROCESS _SC_SINGLE_PROCESS _SC_NETWORKING _SC_READER_WRITER_LOCKS
+ _SC_SPIN_LOCKS _SC_REGEXP _SC_REGEX_VERSION _SC_SHELL _SC_SIGNALS _SC_SPAWN _SC_SPORADIC_SERVER _SC_THREAD_SPORADIC_SERVER
+ _SC_SYSTEM_DATABASE _SC_SYSTEM_DATABASE_R _SC_TIMEOUTS _SC_TYPED_MEMORY_OBJECTS _SC_USER_GROUPS _SC_USER_GROUPS_R
+ _SC_2_PBS _SC_2_PBS_ACCOUNTING _SC_2_PBS_LOCATE _SC_2_PBS_MESSAGE _SC_2_PBS_TRACK _SC_SYMLOOP_MAX _SC_STREAMS _SC_2_PBS_CHECKPOINT
+ _SC_HOST_NAME_MAX _SC_TRACE _SC_TRACE_EVENT_FILTER _SC_TRACE_INHERIT _SC_TRACE_LOG _SC_LEVEL1_ICACHE_SIZE _SC_LEVEL1_ICACHE_ASSOC
+ _SC_LEVEL1_ICACHE_LINESIZE _SC_LEVEL1_DCACHE_SIZE _SC_LEVEL1_DCACHE_ASSOC _SC_LEVEL1_DCACHE_LINESIZE _SC_LEVEL2_CACHE_SIZE
+ _SC_LEVEL2_CACHE_LINESIZE _SC_LEVEL3_CACHE_SIZE _SC_LEVEL3_CACHE_ASSOC _SC_LEVEL3_CACHE_LINESIZE _SC_LEVEL4_CACHE_SIZE
+ _SC_LEVEL4_CACHE_LINESIZE _SC_IPV6 _SC_RAW_SOCKETS _SC_SS_REPL_MAX _SC_TRACE_EVENT_NAME_MAX _SC_TRACE_NAME_MAX _SC_TRACE_SYS_MAX
+ _SC_TRACE_USER_EVENT_MAX _SC_THREAD_ROBUST_PRIO_INHERIT _SC_THREAD_ROBUST_PRIO_PROTECT _CS_PATH _CS_GNU_LIBC_VERSION
+ _SC_THREAD_PRIORITY_SCHEDULING _SC_LEVEL2_CACHE_ASSOC _SC_LEVEL4_CACHE_ASSOC _CS_GNU_LIBPTHREAD_VERSION)))
+
+ (int access (char* int))
+ (int lseek (int int int))
+ (int close (int))
+ (ssize_t read (int void* size_t))
+ (ssize_t write (int void* size_t))
+ (ssize_t pread (int void* size_t int))
+ (ssize_t pwrite (int void* size_t int))
+ (int pipe (int*))
+ (int alarm (int))
+ (int sleep (int))
+ (int pause (void))
+ (int chown (char* int int))
+ (int chdir (char*))
+ (char* getcwd (char* size_t))
+ ;; (deprecated) (char* getwd (char*))
+ (int dup (int))
+ (int dup2 (int int))
+ (void _exit (int))
+ (int pathconf (char* int))
+ (int fpathconf (int int))
+ (int sysconf (int))
+ (size_t confstr (int char* size_t))
+ (int getpid (void))
+ (int getppid (void))
+ (int getpgid (int))
+ (int setpgid (int int))
+ (int setsid (void))
+ (int getsid (int))
+ (int getuid (void))
+ (int geteuid (void))
+ (int getgid (void))
+ (int getegid (void))
+ (int setuid (int))
+ (int setgid (int))
+ (int fork (void))
+ (char* ttyname (int))
+ (int isatty (int))
+ (int link (char* char*))
+ (int unlink (char*))
+ (int rmdir (char*))
+ (int tcgetpgrp (int))
+ (int tcsetpgrp (int int))
+ (char* getlogin (void))
+ (int truncate (char* int))
+ (int ftruncate (int int))
+
+ (in-C "extern char **environ;
+ static s7_pointer getenvs(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer p;
+ int i;
+ p = s7_nil(sc);
+ for (i = 0; environ[i]; i++)
+ {
+ const char *eq;
+ s7_pointer name, value;
+ eq = strchr((const char *)environ[i], (int)'=');
+ name = s7_make_string_with_length(sc, environ[i], eq - environ[i]);
+ value = s7_make_string(sc, (char *)(eq + 1));
+ p = s7_cons(sc, s7_cons(sc, name, value), p);
+ }
+ return(p);
+ }
+ static s7_pointer g_getgroups(s7_scheme *sc, s7_pointer args)
+ {
+ gid_t *gds;
+ int i, size, res;
+ s7_pointer lst;
+ size = s7_integer(s7_car(args));
+ if (size == 0)
+ return(s7_make_integer(sc, getgroups(0, NULL)));
+ gds = (gid_t *)calloc(size, sizeof(gid_t));
+ res = getgroups(size, gds);
+ if (res != -1)
+ {
+ lst = s7_nil(sc);
+ for (i = 0; i < size; i++)
+ lst = s7_cons(sc, s7_make_integer(sc, gds[i]), lst);
+ }
+ else lst = s7_make_integer(sc, -1);
+ free(gds);
+ return(lst);
+ }
+ ")
+ (C-function ("getenvs" getenvs "(getenvs) returns all the environment variables in an alist" 0))
+ (C-function ("getgroups" g_getgroups "" 1))
+
+ ;; perhaps call these as (define* n (path ...) = args? and use execve for all?
+ ;; but are these useful in this context? How is fork used here?
+ ;; int execve (char* path char* argv[] char* envp[])
+ ;; int execv (char* path char* argv[])
+ ;; int execle (char* path char* arg ...)
+ ;; int execl (char* path char* arg ...)
+ ;; int execvp (char* file char* argv[])
+ ;; int execlp (char* file char* arg ...)
+
+
+ ;; -------- dirent.h --------
+ (DIR* opendir (char*))
+ (int closedir (DIR*))
+ (void rewinddir (DIR*))
+ (in-C "static char *read_dir(DIR *p)
+ {
+ struct dirent *dirp;
+ dirp = readdir(p);
+ if (!dirp) return(NULL);
+ else return(dirp->d_name);
+ }")
+ (char* read_dir (DIR*))
+ ;; int scandir (char* dirent*** func func)
+ ;; int alphasort (dirent** dirent**)
+
+
+ ;; -------- ftw.h --------
+ (C-macro (int (FTW_F FTW_D FTW_DNR FTW_NS)))
+ (in-C "static s7_scheme *internal_ftw_sc = NULL;
+ static s7_pointer internal_ftw_closure = NULL, internal_ftw_arglist = NULL;
+
+ static int internal_ftw_function(const char *fpath, const struct stat *sb, int typeflag)
+ {
+ s7_list_set(internal_ftw_sc, internal_ftw_arglist, 0, s7_make_string(internal_ftw_sc, fpath));
+ s7_list_set(internal_ftw_sc, internal_ftw_arglist, 1, s7_make_c_pointer(internal_ftw_sc, (void *)sb));
+ s7_list_set(internal_ftw_sc, internal_ftw_arglist, 2, s7_make_integer(internal_ftw_sc, typeflag));
+ return((int)s7_integer(s7_call(internal_ftw_sc, internal_ftw_closure, internal_ftw_arglist)));
+ }
+
+ static s7_pointer g_ftw(s7_scheme *sc, s7_pointer args)
+ {
+ if (!internal_ftw_sc)
+ {
+ internal_ftw_sc = sc;
+ internal_ftw_arglist = s7_list(sc, 3, s7_nil(sc), s7_nil(sc), s7_nil(sc));
+ s7_gc_protect(sc, internal_ftw_arglist);
+ }
+ internal_ftw_closure = s7_cadr(args);
+ return(s7_make_integer(sc, ftw(s7_string(s7_car(args)), internal_ftw_function, s7_integer(s7_caddr(args)))));
+ }")
+ (C-function ("ftw" g_ftw "" 3))
+
+
+ ;; -------- sys/stat.h --------
+ (C-macro (int S_IFLNK))
+
+ (in-C "static s7_pointer g_stat(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, stat(s7_string(s7_car(args)), (struct stat *)s7_c_pointer(s7_cadr(args)))));}
+ static s7_pointer g_fstat(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, fstat(s7_integer(s7_car(args)), (struct stat *)s7_c_pointer(s7_cadr(args)))));}
+ static s7_pointer g_lstat(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, lstat(s7_string(s7_car(args)), (struct stat *)s7_c_pointer(s7_cadr(args)))));}
+ ")
+ (C-function ("stat" g_stat "" 2))
+ (C-function ("fstat" g_fstat "" 2))
+ (C-function ("lstat" g_lstat "" 2))
+
+ (int chmod (char* int))
+ (int mkdir (char* int))
+ (int mknod (char* int int))
+ (int mkfifo (char* int))
+
+ (in-C "static s7_pointer g_isdir(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_boolean(sc, S_ISDIR(s7_integer(s7_car(args)))));}
+ static s7_pointer g_ischr(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_boolean(sc, S_ISCHR(s7_integer(s7_car(args)))));}
+ static s7_pointer g_isblk(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_boolean(sc, S_ISBLK(s7_integer(s7_car(args)))));}
+ static s7_pointer g_isreg(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_boolean(sc, S_ISREG(s7_integer(s7_car(args)))));}
+ static s7_pointer g_isfifo(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_boolean(sc, S_ISFIFO(s7_integer(s7_car(args)))));}
+ static s7_pointer g_islnk(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_boolean(sc, S_ISLNK(s7_integer(s7_car(args)))));}
+ static s7_pointer g_issock(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_boolean(sc, S_ISSOCK(s7_integer(s7_car(args)))));}
+ static s7_pointer g_st_dev(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_dev));}
+ static s7_pointer g_st_ino(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_ino));}
+ static s7_pointer g_st_mode(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_mode));}
+ static s7_pointer g_st_nlink(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_nlink));}
+ static s7_pointer g_st_uid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_uid));}
+ static s7_pointer g_st_gid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_gid));}
+ static s7_pointer g_st_rdev(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_rdev));}
+ static s7_pointer g_st_size(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_size));}
+ static s7_pointer g_st_blksize(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_blksize));}
+ static s7_pointer g_st_blocks(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_blocks));}
+ static s7_pointer g_st_atime(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_atime));}
+ static s7_pointer g_st_mtime(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_mtime));}
+ static s7_pointer g_st_ctime(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_ctime));}
+ static s7_pointer g_stat_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct stat))));}
+ ")
+
+ (C-function ("S_ISDIR" g_isdir "" 1))
+ (C-function ("S_ISCHR" g_ischr "" 1))
+ (C-function ("S_ISBLK" g_isblk "" 1))
+ (C-function ("S_ISREG" g_isreg "" 1))
+ (C-function ("S_ISFIFO" g_isfifo "" 1))
+ (C-function ("S_ISLNK" g_islnk "" 1))
+ (C-function ("S_ISSOCK" g_issock "" 1))
+
+ (C-function ("stat.st_dev" g_st_dev "" 1))
+ (C-function ("stat.st_ino" g_st_ino "" 1))
+ (C-function ("stat.st_mode" g_st_mode "" 1))
+ (C-function ("stat.st_nlink" g_st_nlink "" 1))
+ (C-function ("stat.st_uid" g_st_uid "" 1))
+ (C-function ("stat.st_gid" g_st_gid "" 1))
+ (C-function ("stat.st_rdev" g_st_rdev "" 1))
+ (C-function ("stat.st_size" g_st_size "" 1))
+ (C-function ("stat.st_blksize" g_st_blksize "" 1))
+ (C-function ("stat.st_blocks" g_st_blocks "" 1))
+ (C-function ("stat.st_atime" g_st_atime "" 1))
+ (C-function ("stat.st_mtime" g_st_mtime "" 1))
+ (C-function ("stat.st_ctime" g_st_ctime "" 1))
+ (C-function ("stat.make" g_stat_make "" 0))
+
+
+ ;; -------- time.h sys/time.h --------
+ (C-macro (int (CLOCKS_PER_SEC CLOCK_REALTIME CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID CLOCK_THREAD_CPUTIME_ID
+ CLOCK_MONOTONIC_RAW CLOCK_REALTIME_COARSE CLOCK_MONOTONIC_COARSE)))
+ (int clock (void))
+
+ (int time (time_t*))
+ (double difftime ((time_t integer) (time_t integer)))
+ (tm* gmtime (time_t*))
+ (char* ctime (time_t*))
+ (tm* localtime (time_t*))
+
+ (in-C "static s7_pointer g_mktime(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_integer(sc, (s7_int)mktime((struct tm *)s7_c_pointer(s7_car(args)))));
+ }
+ static s7_pointer g_time_make(s7_scheme *sc, s7_pointer args)
+ {
+ time_t *tm;
+ tm = (time_t *)calloc(1, sizeof(time_t));
+ (*tm) = (time_t)s7_integer(s7_car(args));
+ return(s7_make_c_pointer(sc, (void *)tm));
+ }
+ static s7_pointer g_strftime(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_integer(sc, (s7_int)strftime((char *)s7_string(s7_car(args)),
+ (size_t)s7_integer(s7_cadr(args)),
+ s7_string(s7_caddr(args)),
+ (const struct tm *)s7_c_pointer(s7_cadddr(args)))));
+ }
+ static s7_pointer g_asctime(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_string(sc, asctime((const struct tm *)s7_c_pointer(s7_car(args)))));
+ }
+ static s7_pointer g_gettimeofday(s7_scheme *sc, s7_pointer args)
+ {
+ struct timeval t0;
+ gettimeofday(&t0, NULL);
+ return(s7_list(sc, 2, s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_usec)));
+ }
+ static s7_pointer g_nanosleep(s7_scheme *sc, s7_pointer args)
+ {
+ struct timespec t0;
+ t0.tv_sec = (time_t)s7_integer(s7_car(args));
+ t0.tv_nsec = (long)s7_integer(s7_cadr(args));
+ return(s7_make_integer(sc, nanosleep(&t0, NULL)));
+ }
+ static s7_pointer g_clock_getres(s7_scheme *sc, s7_pointer args)
+ {
+ #if (!__APPLE__)
+ struct timespec t0;
+ int res;
+ res = clock_getres(s7_integer(s7_car(args)), &t0);
+ return(s7_list(sc, 3, s7_make_integer(sc, res), s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_nsec)));
+ #else
+ return(s7_make_integer(sc, -1));
+ #endif
+ }
+ static s7_pointer g_clock_gettime(s7_scheme *sc, s7_pointer args)
+ {
+ #if (!__APPLE__)
+ struct timespec t0;
+ int res;
+ res = clock_gettime(s7_integer(s7_car(args)), &t0);
+ return(s7_list(sc, 3, s7_make_integer(sc, res), s7_make_integer(sc, t0.tv_sec), s7_make_integer(sc, t0.tv_nsec)));
+ #else
+ return(s7_make_integer(sc, -1));
+ #endif
+ }
+ static s7_pointer g_clock_settime(s7_scheme *sc, s7_pointer args)
+ {
+ #if (!__APPLE__)
+ struct timespec t0;
+ t0.tv_sec = (time_t)s7_integer(s7_cadr(args));
+ t0.tv_nsec = (long)s7_integer(s7_caddr(args));
+ return(s7_make_integer(sc, clock_settime(s7_integer(s7_car(args)), &t0)));
+ #else
+ return(s7_make_integer(sc, -1));
+ #endif
+ }
+ static s7_pointer g_clock_getcpuclockid(s7_scheme *sc, s7_pointer args)
+ {
+ #if __linux__
+ clockid_t c = 0;
+ clock_getcpuclockid((pid_t)s7_integer(s7_car(args)), &c);
+ return(s7_make_integer(sc, (s7_int)c));
+ #else
+ return(s7_make_integer(sc, -1));
+ #endif
+ }
+ static s7_pointer g_clock_nanosleep(s7_scheme *sc, s7_pointer args)
+ {
+ #if __linux__
+ struct timespec t0;
+ t0.tv_sec = (time_t)s7_integer(s7_caddr(args));
+ t0.tv_nsec = (long)s7_integer(s7_cadddr(args));
+ return(s7_make_integer(sc, clock_nanosleep((clockid_t)s7_integer(s7_car(args)), (int)s7_integer(s7_cadr(args)), &t0, NULL)));
+ #else
+ return(s7_make_integer(sc, -1));
+ #endif
+ }
+ ")
+ (C-function ("time.make" g_time_make "" 1))
+ (C-function ("mktime" g_mktime "" 1))
+ (C-function ("asctime" g_asctime "" 1))
+ (C-function ("strftime" g_strftime "" 4))
+ (C-function ("gettimeofday" g_gettimeofday "" 0))
+ (C-function ("nanosleep" g_nanosleep "" 2))
+ (C-function ("clock_getres" g_clock_getres "" 1))
+ (C-function ("clock_gettime" g_clock_gettime "" 1)) ; these need -lrt
+ (C-function ("clock_settime" g_clock_settime "" 3))
+ (reader-cond ((not (provided? 'solaris)) (C-function ("clock_getcpuclockid" g_clock_getcpuclockid "" 1))))
+ (C-function ("clock_nanosleep" g_clock_nanosleep "" 4))
+
+
+ ;; -------- utime.h --------
+ (in-C "static s7_pointer g_utime(s7_scheme *sc, s7_pointer args)
+ {
+ struct utimbuf tb;
+ tb.actime = (time_t)s7_integer(s7_cadr(args));
+ tb.modtime = (time_t)s7_integer(s7_caddr(args));
+ return(s7_make_integer(sc, utime(s7_string(s7_car(args)), &tb)));
+ }")
+ (C-function ("utime" g_utime "" 3))
+
+
+ ;; -------- termios.h --------
+ (C-macro (int (VINTR VQUIT VERASE VKILL VEOF VTIME VMIN VSWTC VSTART VSTOP VSUSP VEOL VREPRINT
+ VDISCARD VWERASE VLNEXT VEOL2 IGNBRK BRKINT IGNPAR PARMRK INPCK ISTRIP INLCR
+ IGNCR ICRNL IUCLC IXON IXANY IXOFF IMAXBEL IUTF8 OPOST OLCUC ONLCR OCRNL ONOCR
+ ONLRET OFILL OFDEL ISIG ICANON ECHO ECHOE ECHOK ECHONL NOFLSH TOSTOP IEXTEN
+ TCOOFF TCOON TCIOFF TCION TCIFLUSH TCOFLUSH TCIOFLUSH TCSANOW TCSADRAIN TCSAFLUSH)))
+
+ (int tcsendbreak (int int))
+ (int tcdrain (int))
+ (int tcflush (int int))
+ (int tcflow (int int))
+
+ (in-C "static s7_pointer g_cfgetospeed(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_car(args));
+ return(s7_make_integer(sc, (s7_int)cfgetospeed(p)));
+ }
+ static s7_pointer g_cfgetispeed(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_car(args));
+ return(s7_make_integer(sc, (s7_int)cfgetispeed(p)));
+ }
+ static s7_pointer g_cfsetospeed(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_car(args));
+ return(s7_make_integer(sc, cfsetospeed(p, (speed_t)s7_integer(s7_cadr(args)))));
+ }
+ static s7_pointer g_cfsetispeed(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_car(args));
+ return(s7_make_integer(sc, cfsetispeed(p, (speed_t)s7_integer(s7_cadr(args)))));
+ }
+ static s7_pointer g_tcgetattr(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_cadr(args));
+ return(s7_make_integer(sc, tcgetattr(s7_integer(s7_car(args)), p)));
+ }
+ static s7_pointer g_tcsetattr(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_caddr(args));
+ return(s7_make_integer(sc, tcsetattr(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), p)));
+ }
+ static s7_pointer g_termios_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct termios))));}
+
+ static s7_pointer g_termios_c_lflag(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_car(args));
+ return(s7_make_integer(sc, (s7_int)(p->c_lflag)));
+ }
+ static s7_pointer g_termios_set_c_lflag(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_car(args));
+ p->c_lflag = (tcflag_t)s7_integer(s7_cadr(args));
+ return(s7_cadr(args));
+ }
+ static s7_pointer g_termios_set_c_cc(s7_scheme *sc, s7_pointer args)
+ {
+ struct termios *p;
+ p = (struct termios *)s7_c_pointer(s7_car(args));
+ p->c_cc[(int)s7_integer(s7_cadr(args))] = (cc_t)s7_integer(s7_caddr(args));
+ return(s7_caddr(args));
+ }
+ ")
+ ;; tcflag_t c_iflag, c_oflag, c_cflag; cc_t c_line;
+ ;; cc_t c_cc[NCCS];
+
+ (C-function ("cfgetospeed" g_cfgetospeed "" 1))
+ (C-function ("cfgetispeed" g_cfgetispeed "" 1))
+ (C-function ("cfsetospeed" g_cfsetospeed "" 2))
+ (C-function ("cfsetispeed" g_cfsetispeed "" 2))
+ (C-function ("tcgetattr" g_tcgetattr "" 2))
+ (C-function ("tcsetattr" g_tcsetattr "" 3))
+ (C-function ("termios.make" g_termios_make "" 0))
+ (C-function ("termios.c_lflag" g_termios_c_lflag "" 1))
+ (C-function ("termios.set_c_lflag" g_termios_set_c_lflag "" 2))
+ (C-function ("termios.set_c_cc" g_termios_set_c_cc "" 3))
+
+
+ ;; -------- grp.h --------
+ (void* getgrgid (int))
+ (void* getgrnam (char*))
+ (in-C "static s7_pointer g_group_gr_name(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct group *)s7_c_pointer(s7_car(args)))->gr_name));}
+ static s7_pointer g_group_gr_passwd(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct group *)s7_c_pointer(s7_car(args)))->gr_passwd));}
+ static s7_pointer g_group_gr_gid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, (s7_int)(((struct group *)s7_c_pointer(s7_car(args)))->gr_gid)));}
+ static s7_pointer g_group_gr_mem(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer p;
+ int i;
+ struct group *g;
+ g = (struct group *)s7_c_pointer(s7_car(args));
+ p = s7_nil(sc);
+ for (i = 0; g->gr_mem[i]; i++)
+ p = s7_cons(sc, s7_make_string(sc, g->gr_mem[i]), p);
+ return(p);
+ }
+ ")
+ (C-function ("group.gr_name" g_group_gr_name "" 1))
+ (C-function ("group.gr_passwd" g_group_gr_passwd "" 1))
+ (C-function ("group.gr_gid" g_group_gr_gid "" 1))
+ (C-function ("group.gr_mem" g_group_gr_mem "" 1))
+ ;; ((*libc* 'group.gr_name) ((*libc* 'getgrnam) "wheel")) -> "wheel"
+
+
+ ;; -------- pwd.h --------
+ (C-macro (int NSS_BUFLEN_PASSWD))
+ (void setpwent (void))
+ (void endpwent (void))
+ (void* getpwent (void))
+ (void* getpwuid (int))
+ (void* getpwnam (char*))
+ (in-C "static s7_pointer g_passwd_pw_name(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer(s7_car(args)))->pw_name));}
+ static s7_pointer g_passwd_pw_passwd(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer(s7_car(args)))->pw_passwd));}
+ static s7_pointer g_passwd_pw_uid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct passwd *)s7_c_pointer(s7_car(args)))->pw_uid));}
+ static s7_pointer g_passwd_pw_gid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct passwd *)s7_c_pointer(s7_car(args)))->pw_gid));}
+ static s7_pointer g_passwd_pw_gecos(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer(s7_car(args)))->pw_gecos));}
+ static s7_pointer g_passwd_pw_dir(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer(s7_car(args)))->pw_dir));}
+ static s7_pointer g_passwd_pw_shell(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct passwd *)s7_c_pointer(s7_car(args)))->pw_shell));}
+ ")
+ (C-function ("passwd.pw_name" g_passwd_pw_name "" 1))
+ (C-function ("passwd.pw_passwd" g_passwd_pw_passwd "" 1))
+ (C-function ("passwd.pw_uid" g_passwd_pw_uid "" 1))
+ (C-function ("passwd.pw_gid" g_passwd_pw_gid "" 1))
+ (C-function ("passwd.pw_gecos" g_passwd_pw_gecos "" 1))
+ (C-function ("passwd.pw_dir" g_passwd_pw_dir "" 1))
+ (C-function ("passwd.pw_shell" g_passwd_pw_shell "" 1))
+ ;; ((*libc* 'passwd.pw_name) ((*libc* 'getpwnam) "bil")) -> "bil"
+
+
+ ;; -------- wordexp.h --------
+ (reader-cond ((not (provided? 'openbsd))
+ (int (WRDE_DOOFFS WRDE_APPEND WRDE_NOCMD WRDE_REUSE WRDE_SHOWERR WRDE_UNDEF
+ WRDE_NOSPACE WRDE_BADCHAR WRDE_BADVAL WRDE_CMDSUB WRDE_SYNTAX))
+ (int wordexp (char* wordexp_t* int))
+ (void wordfree (wordexp_t*))
+ (in-C "static s7_pointer g_wordexp_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(wordexp_t))));}
+ static s7_pointer g_wordexp_we_wordc(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((wordexp_t *)s7_c_pointer(s7_car(args)))->we_wordc));}
+ static s7_pointer g_wordexp_we_wordv(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer p;
+ int i;
+ wordexp_t *g;
+ g = (wordexp_t *)s7_c_pointer(s7_car(args));
+ p = s7_nil(sc);
+ for (i = 0; i < g->we_wordc; i++)
+ p = s7_cons(sc, s7_make_string(sc, g->we_wordv[i]), p);
+ return(p);
+ }")
+ (C-function ("wordexp.make" g_wordexp_make "" 0))
+ (C-function ("wordexp.we_wordc" g_wordexp_we_wordc "" 1))
+ (C-function ("wordexp.we_wordv" g_wordexp_we_wordv "" 1))))
+ ;; (with-let (sublet *libc*) (let ((w (wordexp.make))) (wordexp "~/cl/snd-gdraw" w 0) (wordexp.we_wordv w))) -> ("/home/bil/cl/snd-gdraw")
+
+
+ ;; -------- glob.h --------
+ ;; does any of this work in openbsd?
+ (C-macro (int (GLOB_ERR GLOB_MARK GLOB_NOSORT GLOB_DOOFFS GLOB_NOCHECK GLOB_APPEND GLOB_NOESCAPE GLOB_PERIOD
+ GLOB_MAGCHAR GLOB_ALTDIRFUNC GLOB_BRACE GLOB_NOMAGIC GLOB_TILDE GLOB_ONLYDIR GLOB_TILDE_CHECK
+ GLOB_NOSPACE GLOB_ABORTED GLOB_NOMATCH GLOB_NOSYS)))
+ (void globfree (glob_t*))
+ (in-C "static s7_pointer g_glob_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(glob_t))));}
+ static s7_pointer g_glob_gl_pathc(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((glob_t *)s7_c_pointer(s7_car(args)))->gl_pathc));}
+ static s7_pointer g_glob(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, glob(s7_string(s7_car(args)), s7_integer(s7_cadr(args)), NULL, (glob_t *)s7_c_pointer(s7_caddr(args)))));}
+ static s7_pointer g_glob_gl_pathv(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer p;
+ int i;
+ glob_t *g;
+ g = (glob_t *)s7_c_pointer(s7_car(args));
+ p = s7_nil(sc);
+ for (i = 0; i < g->gl_pathc; i++)
+ p = s7_cons(sc, s7_make_string(sc, g->gl_pathv[i]), p);
+ return(p);
+ }")
+ (C-function ("glob.make" g_glob_make "" 0))
+ (C-function ("glob.gl_pathc" g_glob_gl_pathc "" 1))
+ (C-function ("glob.gl_pathv" g_glob_gl_pathv "" 1))
+ (C-function ("glob" g_glob "" 3))
+
+
+ ;; -------- signal.h sys/wait.h --------
+ (C-macro (int (SIGHUP SIGINT SIGQUIT SIGILL SIGTRAP SIGABRT SIGIOT SIGBUS SIGFPE
+ SIGKILL SIGUSR1 SIGSEGV SIGUSR2 SIGPIPE SIGALRM SIGTERM SIGSTKFLT
+ SIGCLD SIGCHLD SIGCONT SIGSTOP SIGTSTP SIGTTIN SIGTTOU SIGURG
+ SIGXCPU SIGXFSZ SIGVTALRM SIGPROF SIGWINCH SIGPOLL SIGIO SIGPWR SIGSYS
+ (reader-cond ((not (provided? 'osx)) SIGUNUSED))
+ WNOHANG WUNTRACED WSTOPPED WEXITED WCONTINUED WNOWAIT
+ RLIMIT_CPU RLIMIT_FSIZE RLIMIT_DATA RLIMIT_STACK RLIMIT_CORE RLIMIT_RSS
+ RLIMIT_NOFILE RLIMIT_OFILE RLIMIT_AS RLIMIT_NPROC RLIMIT_MEMLOCK RLIMIT_LOCKS
+ RLIMIT_SIGPENDING RLIMIT_MSGQUEUE RLIMIT_NICE RLIMIT_RTPRIO RLIMIT_NLIMITS
+ RLIM_NLIMITS RLIM_INFINITY RLIM_SAVED_MAX RLIM_SAVED_CUR RUSAGE_SELF
+ RUSAGE_CHILDREN RUSAGE_THREAD RUSAGE_LWP
+ PRIO_MIN PRIO_MAX PRIO_PROCESS PRIO_PGRP PRIO_USER
+ SA_NOCLDSTOP SA_NOCLDWAIT SA_SIGINFO SA_ONSTACK SA_RESTART SA_NODEFER SA_RESETHAND SA_NOMASK SA_ONESHOT SA_STACK
+ SIG_BLOCK SIG_UNBLOCK SIG_SETMASK
+ )))
+
+ ;; (let ((v (rusage.make))) (getrusage (*libc* 'RUSAGE_SELF) v) (let ((mem (rusage.ru_maxrss v))) (free v) mem))
+
+ (int kill (int int))
+ (int raise (int))
+ (int sigemptyset (sigset_t*))
+ (int sigfillset (sigset_t*))
+ (int sigaddset (sigset_t* int))
+ (int sigdelset (sigset_t* int))
+ (int sigismember (sigset_t* int))
+ (int sigprocmask (int sigset_t* sigset_t*))
+ (int sigsuspend (sigset_t*))
+ (int sigpending (sigset_t*))
+ (int getpriority (int int))
+ (int setpriority (int int int))
+
+ (in-C "static s7_pointer g_rlimit_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct rlimit))));}
+ static s7_pointer g_rlimit_rlim_cur(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rlimit *)s7_c_pointer(s7_car(args)))->rlim_cur));}
+ static s7_pointer g_rlimit_rlim_max(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rlimit *)s7_c_pointer(s7_car(args)))->rlim_max));}
+
+ static s7_pointer g_rusage_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct rusage))));}
+ static s7_pointer g_rusage_ru_maxrss(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer(s7_car(args)))->ru_maxrss));}
+ static s7_pointer g_rusage_ru_minflt(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer(s7_car(args)))->ru_minflt));}
+ static s7_pointer g_rusage_ru_majflt(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer(s7_car(args)))->ru_majflt));}
+ static s7_pointer g_rusage_ru_inblock(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer(s7_car(args)))->ru_inblock));}
+ static s7_pointer g_rusage_ru_oublock(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer(s7_car(args)))->ru_oublock));}
+ static s7_pointer g_rusage_ru_nvcsw(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer(s7_car(args)))->ru_nvcsw));}
+ static s7_pointer g_rusage_ru_nivcsw(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer(s7_car(args)))->ru_nivcsw));}
+ static s7_pointer g_rusage_ru_utime(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, &(((struct rusage *)s7_c_pointer(s7_car(args)))->ru_utime)));}
+ static s7_pointer g_rusage_ru_stime(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, &(((struct rusage *)s7_c_pointer(s7_car(args)))->ru_stime)));}
+
+ static s7_pointer g_sigset_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(sigset_t))));}
+
+ #if __linux__
+ static s7_pointer g_WEXITSTATUS(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, WEXITSTATUS(s7_integer(s7_car(args)))));}
+ static s7_pointer g_WTERMSIG(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, WTERMSIG(s7_integer(s7_car(args)))));}
+ static s7_pointer g_WSTOPSIG(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, WSTOPSIG(s7_integer(s7_car(args)))));}
+ static s7_pointer g_WIFEXITED(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, WIFEXITED(s7_integer(s7_car(args)))));}
+ static s7_pointer g_WIFSIGNALED(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, WIFSIGNALED(s7_integer(s7_car(args)))));}
+ static s7_pointer g_WIFSTOPPED(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, WIFSTOPPED(s7_integer(s7_car(args)))));}
+ #endif
+
+ static s7_pointer g_wait(s7_scheme *sc, s7_pointer args)
+ {
+ int status, result;
+ result = wait(&status);
+ return(s7_list(sc, 2, s7_make_integer(sc, result), s7_make_integer(sc, status)));
+ }
+ static s7_pointer g_waitpid(s7_scheme *sc, s7_pointer args)
+ {
+ int status, result;
+ result = waitpid((pid_t)s7_integer(s7_car(args)), &status, s7_integer(s7_cadr(args)));
+ return(s7_list(sc, 2, s7_make_integer(sc, result), s7_make_integer(sc, status)));
+ }
+ static s7_pointer g_sigqueue(s7_scheme *sc, s7_pointer args)
+ {
+ #if (__linux__)
+ union sigval val;
+ if (s7_is_integer(s7_caddr(args)))
+ val.sival_int = (int)s7_integer(s7_caddr(args));
+ else val.sival_ptr = (void *)s7_c_pointer(s7_caddr(args));
+ return(s7_make_integer(sc, sigqueue((pid_t)s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), val)));
+ #else
+ return(s7_f(sc));
+ #endif
+ }
+ static s7_pointer g_sigwait(s7_scheme *sc, s7_pointer args)
+ {
+ #if (!__sun)
+ int status, result;
+ result = sigwait((const sigset_t *)s7_c_pointer(s7_car(args)), &status);
+ return(s7_list(sc, 2, s7_make_integer(sc, result), s7_make_integer(sc, status)));
+ #else
+ return(s7_f(sc));
+ #endif
+ }
+ static s7_pointer g_sigtimedwait(s7_scheme *sc, s7_pointer args)
+ {
+ #if (__linux__)
+ return(s7_make_integer(sc, sigtimedwait((const sigset_t *)s7_c_pointer(s7_car(args)),
+ (siginfo_t *)s7_c_pointer(s7_cadr(args)),
+ (const struct timespec *)s7_c_pointer(s7_caddr(args)))));
+ #else
+ return(s7_f(sc));
+ #endif
+ }
+ #if __linux__
+ static s7_pointer g_siginfo_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(siginfo_t))));}
+ static s7_pointer g_siginfo_si_signo(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_signo));}
+ static s7_pointer g_siginfo_si_errno(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_errno));}
+ static s7_pointer g_siginfo_si_code(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_code));}
+ static s7_pointer g_siginfo_si_pid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_pid));}
+ static s7_pointer g_siginfo_si_uid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_uid));}
+ static s7_pointer g_siginfo_si_status(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_status));}
+ static s7_pointer g_siginfo_si_utime(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_utime));}
+ static s7_pointer g_siginfo_si_stime(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_stime));}
+ static s7_pointer g_siginfo_si_value(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, &(((siginfo_t *)s7_c_pointer(s7_car(args)))->si_value)));}
+ static s7_pointer g_siginfo_si_int(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_int));}
+ static s7_pointer g_siginfo_si_overrun(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_overrun));}
+ static s7_pointer g_siginfo_si_timerid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_timerid));}
+ static s7_pointer g_siginfo_si_band(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_band));}
+ static s7_pointer g_siginfo_si_fd(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_fd));}
+ static s7_pointer g_siginfo_si_ptr(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_ptr));}
+ static s7_pointer g_siginfo_si_addr(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_addr));}
+ #endif
+
+ static s7_pointer g_timespec_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct timespec))));}
+ static s7_pointer g_timespec_tv_sec(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct timespec *)s7_c_pointer(s7_car(args)))->tv_sec));}
+ static s7_pointer g_timespec_tv_nsec(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct timespec *)s7_c_pointer(s7_car(args)))->tv_nsec));}
+
+ static s7_pointer g_sigaction_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(sigaction))));}
+ static s7_pointer g_sigaction_sa_flags(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_flags));}
+ static s7_pointer g_sigaction_set_sa_flags(s7_scheme *sc, s7_pointer args)
+ {((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_flags = s7_integer(s7_cadr(args)); return(s7_cadr(args));}
+ static s7_pointer g_sigaction_sa_mask(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)(&(((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_mask))));}
+ static s7_pointer g_sigaction_sa_handler(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer(sc, (void *)(((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_handler)));}
+
+ static s7_pointer sighandlers = NULL;
+ static s7_scheme *sighandlers_s7 = NULL;
+ static void s7_signal_handler(int sig)
+ {
+ if (sighandlers)
+ {
+ s7_pointer handler;
+ handler = s7_vector_ref(sighandlers_s7, sighandlers, sig);
+ if (handler != s7_f(sighandlers_s7))
+ s7_call(sighandlers_s7, handler, s7_cons(sighandlers_s7, s7_make_integer(sighandlers_s7, sig), s7_nil(sighandlers_s7)));
+ }
+ }
+ #ifndef SIGUNUSED
+ #define SIGUNUSED 65
+ #endif
+ static s7_pointer g_sigaction_set_sa_handler(s7_scheme *sc, s7_pointer args)
+ {
+ /* (sigaction.set_sa_handler ptr handler) */
+ if (!sighandlers)
+ {
+ sighandlers_s7 = sc;
+ sighandlers = s7_make_and_fill_vector(sc, SIGUNUSED + 1, s7_f(sc));
+ s7_gc_protect(sc, sighandlers);
+ }
+ if (s7_c_pointer(s7_cadr(args)) == (void *)SIG_DFL)
+ ((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_handler = SIG_DFL;
+ else
+ {
+ if (s7_c_pointer(s7_cadr(args)) == (void *)SIG_IGN)
+ ((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_handler = SIG_IGN;
+ else
+ {
+ ((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_handler = s7_signal_handler;
+ s7_vector_set(sighandlers_s7, sighandlers, SIGUNUSED,
+ s7_cons(sc, s7_cons(sc, s7_car(args), s7_cadr(args)), s7_vector_ref(sighandlers_s7, sighandlers, SIGUNUSED)));
+ }
+ }
+ return(s7_cadr(args));
+ }
+ static s7_pointer g_sigaction(s7_scheme *sc, s7_pointer args)
+ {
+ int sig;
+ const struct sigaction *new_act;
+ struct sigaction *old_act;
+ s7_pointer handler;
+ sig = (int)s7_integer(s7_car(args));
+ new_act = (const struct sigaction *)s7_c_pointer(s7_cadr(args));
+ old_act = (struct sigaction *)s7_c_pointer(s7_caddr(args));
+ handler = s7_assq(sc, s7_cadr(args), s7_vector_ref(sighandlers_s7, sighandlers, SIGUNUSED));
+ if (s7_is_pair(handler))
+ s7_vector_set(sighandlers_s7, sighandlers, sig, s7_cdr(handler));
+ return(s7_make_integer(sc, sigaction(sig, new_act, old_act)));
+ }
+ static s7_pointer g_signal(s7_scheme *sc, s7_pointer args)
+ {
+ int sig;
+ if (!sighandlers)
+ {
+ sighandlers_s7 = sc;
+ sighandlers = s7_make_and_fill_vector(sc, SIGUNUSED + 1, s7_f(sc));
+ s7_gc_protect(sc, sighandlers);
+ }
+ sig = s7_integer(s7_car(args));
+ if (s7_is_c_pointer(s7_cadr(args)))
+ {
+ if (s7_c_pointer(s7_cadr(args)) == (void *)SIG_DFL)
+ return(s7_make_c_pointer(sc, signal(sig, SIG_DFL)));
+ if (s7_c_pointer(s7_cadr(args)) == (void *)SIG_IGN)
+ return(s7_make_c_pointer(sc, signal(sig, SIG_IGN)));
+ }
+ s7_vector_set(sc, sighandlers, sig, s7_cadr(args));
+ return(s7_make_c_pointer(sc, signal(sig, s7_signal_handler)));
+ }
+ ")
+
+ (C-function ("rlimit.make" g_rlimit_make "" 0))
+ (C-function ("rlimit.rlim_cur" g_rlimit_rlim_cur "" 1))
+ (C-function ("rlimit.rlim_max" g_rlimit_rlim_max "" 1))
+
+ (C-function ("rusage.make" g_rusage_make "" 0))
+ (C-function ("rusage.ru_maxrss" g_rusage_ru_maxrss "" 1))
+ (C-function ("rusage.ru_minflt" g_rusage_ru_minflt "" 1))
+ (C-function ("rusage.ru_majflt" g_rusage_ru_majflt "" 1))
+ (C-function ("rusage.ru_inblock" g_rusage_ru_inblock "" 1))
+ (C-function ("rusage.ru_oublock" g_rusage_ru_oublock "" 1))
+ (C-function ("rusage.ru_nvcsw" g_rusage_ru_nvcsw "" 1))
+ (C-function ("rusage.ru_nivcsw" g_rusage_ru_nivcsw "" 1))
+ (C-function ("rusage.ru_utime" g_rusage_ru_utime "" 1))
+ (C-function ("rusage.ru_stime" g_rusage_ru_stime "" 1))
+
+ (reader-cond ((provided? 'linux)
+ (C-function ("siginfo.make" g_siginfo_make "" 0))
+ (C-function ("siginfo.si_signo" g_siginfo_si_signo "" 1))
+ (C-function ("siginfo.si_errno" g_siginfo_si_errno "" 1))
+ (C-function ("siginfo.si_code" g_siginfo_si_code "" 1))
+ (C-function ("siginfo.si_pid" g_siginfo_si_pid "" 1))
+ (C-function ("siginfo.si_uid" g_siginfo_si_uid "" 1))
+ (C-function ("siginfo.si_status" g_siginfo_si_status "" 1))
+ (C-function ("siginfo.si_utime" g_siginfo_si_utime "" 1))
+ (C-function ("siginfo.si_stime" g_siginfo_si_stime "" 1))
+ (C-function ("siginfo.si_value" g_siginfo_si_value "" 1))
+ (C-function ("siginfo.si_int" g_siginfo_si_int "" 1))
+ (C-function ("siginfo.si_overrun" g_siginfo_si_overrun "" 1))
+ (C-function ("siginfo.si_timerid" g_siginfo_si_timerid "" 1))
+ (C-function ("siginfo.si_band" g_siginfo_si_band "" 1))
+ (C-function ("siginfo.si_fd" g_siginfo_si_fd "" 1))
+ (C-function ("siginfo.si_ptr" g_siginfo_si_ptr "" 1))
+ (C-function ("siginfo.si_addr" g_siginfo_si_addr "" 1))))
+
+ (C-function ("timespec.make" g_timespec_make "" 0))
+ (C-function ("timespec.tv_sec" g_timespec_tv_sec "" 1))
+ (C-function ("timespec.tv_nsec" g_timespec_tv_nsec "" 1))
+
+ (C-function ("sigaction.make" g_sigaction_make "" 0))
+ (C-function ("sigaction.sa_handler" g_sigaction_sa_handler "" 1))
+ (C-function ("sigaction.sa_flags" g_sigaction_sa_flags "" 1))
+ (C-function ("sigaction.sa_mask" g_sigaction_sa_mask "" 1))
+ (C-function ("sigaction.set_sa_handler" g_sigaction_set_sa_handler "" 2))
+ (C-function ("sigaction.set_sa_flags" g_sigaction_set_sa_flags "" 2))
+
+ ;; (define sa ((*libc* 'sigaction.make)))
+ ;; ((*libc* 'sigemptyset) ((*libc* 'sigaction.sa_mask) sa))
+ ;; ((*libc* 'sigaction.set_sa_flags) sa 0)
+ ;; ((*libc* 'sigaction.set_sa_handler) sa (lambda (i) (format *stderr* "i: ~A~%" i)))
+ ;; ((*libc* 'sigaction) (*libc* 'SIGINT) sa (*libc* 'NULL))
+ ;; now type C-C to snd and it prints "i: 2"!!
+
+ (reader-cond ((provided? 'linux)
+ (C-function ("WEXITSTATUS" g_WEXITSTATUS "" 1))
+ (C-function ("WTERMSIG" g_WTERMSIG "" 1))
+ (C-function ("WSTOPSIG" g_WSTOPSIG "" 1))
+ (C-function ("WIFEXITED" g_WIFEXITED "" 1))
+ (C-function ("WIFSIGNALED" g_WIFSIGNALED "" 1))
+ (C-function ("WIFSTOPPED" g_WIFSTOPPED "" 1))))
+
+ (C-function ("wait" g_wait "" 0))
+ (C-function ("waitpid" g_waitpid "" 2))
+ (C-function ("sigqueue" g_sigqueue "" 3))
+ (reader-cond ((not (provided? 'solaris)) (C-function ("sigwait" g_sigwait "" 1))))
+ (C-function ("sigaction" g_sigaction "" 3))
+ (C-function ("sigtimedwait" g_sigtimedwait "" 3))
+ (C-function ("sigset.make" g_sigset_make "" 0))
+
+ (C-function ("signal" g_signal "" 2))
+
+ (int getrlimit (int void*))
+ (int setrlimit (int void*))
+ (int getrusage (int void*))
+ (reader-cond ((provided? 'linux)
+ (int sigwaitinfo (sigset_t* siginfo_t*))
+ (int waitid (int int siginfo_t* int))))
+ (c-pointer (SIG_ERR SIG_DFL SIG_IGN))
+
+
+ ;; -------- netdb.h --------
+ (reader-cond ((provided? 'linux)
+ (int (IPPORT_ECHO IPPORT_DISCARD IPPORT_SYSTAT IPPORT_DAYTIME IPPORT_NETSTAT IPPORT_FTP IPPORT_TELNET IPPORT_SMTP
+ IPPORT_TIMESERVER IPPORT_NAMESERVER IPPORT_WHOIS IPPORT_MTP IPPORT_TFTP IPPORT_RJE IPPORT_FINGER IPPORT_TTYLINK
+ IPPORT_SUPDUP IPPORT_EXECSERVER IPPORT_LOGINSERVER IPPORT_CMDSERVER IPPORT_EFSSERVER IPPORT_BIFFUDP
+ IPPORT_WHOSERVER IPPORT_ROUTESERVER IPPORT_RESERVED IPPORT_USERRESERVED))))
+
+ (C-macro (int (AI_PASSIVE AI_CANONNAME AI_NUMERICHOST AI_V4MAPPED AI_ALL AI_ADDRCONFIG AI_NUMERICSERV
+ EAI_BADFLAGS EAI_NONAME EAI_AGAIN EAI_FAIL EAI_FAMILY EAI_SOCKTYPE EAI_SERVICE EAI_MEMORY EAI_SYSTEM EAI_OVERFLOW
+ NI_NUMERICHOST NI_NUMERICSERV NI_NOFQDN NI_NAMEREQD NI_DGRAM
+ SOCK_STREAM SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_DCCP SOCK_PACKET SOCK_CLOEXEC SOCK_NONBLOCK
+ _PATH_HEQUIV_PATH_HOSTS _PATH_NETWORKS _PATH_NSSWITCH_CONF _PATH_PROTOCOLS _PATH_SERVICES
+ PF_UNSPEC PF_LOCAL PF_UNIX PF_FILE PF_INET PF_AX25 PF_IPX PF_APPLETALK PF_NETROM PF_BRIDGE
+ PF_ATMPVC PF_X25 PF_INET6 PF_ROSE PF_DECnet PF_NETBEUI PF_SECURITY PF_KEY PF_NETLINK PF_ROUTE
+ PF_PACKET PF_ASH PF_ECONET PF_ATMSVC PF_RDS PF_SNA PF_IRDA PF_PPPOX PF_WANPIPE PF_LLC PF_CAN
+ PF_TIPC PF_BLUETOOTH PF_IUCV PF_RXRPC PF_ISDN PF_PHONET PF_IEEE802154 PF_MAX
+ AF_UNSPEC AF_LOCAL AF_UNIX AF_FILE AF_INET AF_AX25 AF_IPX AF_APPLETALK AF_NETROM AF_BRIDGE
+ AF_ATMPVC AF_X25 AF_INET6 AF_ROSE AF_DECnet AF_NETBEUI AF_SECURITY AF_KEY AF_NETLINK AF_ROUTE
+ AF_PACKET AF_ASH AF_ECONET AF_ATMSVC AF_RDS AF_SNA AF_IRDA AF_PPPOX AF_WANPIPE AF_LLC
+ AF_CAN AF_TIPC AF_BLUETOOTH AF_IUCV AF_RXRPC AF_ISDN AF_PHONET AF_IEEE802154 AF_MAX
+ MSG_OOB MSG_PEEK MSG_DONTROUTE MSG_CTRUNC MSG_PROXY MSG_TRUNC MSG_DONTWAIT MSG_EOR MSG_WAITFORONE
+ MSG_WAITALL MSG_FIN MSG_SYN MSG_CONFIRM MSG_RST MSG_ERRQUEUE MSG_NOSIGNAL MSG_MORE MSG_CMSG_CLOEXEC
+ IPPROTO_IP IPPROTO_HOPOPTS IPPROTO_ICMP IPPROTO_IGMP IPPROTO_IPIP IPPROTO_TCP IPPROTO_EGP IPPROTO_PUP
+ IPPROTO_UDP IPPROTO_IDP IPPROTO_TP IPPROTO_DCCP IPPROTO_IPV6 IPPROTO_ROUTING IPPROTO_FRAGMENT
+ IPPROTO_RSVP IPPROTO_GRE IPPROTO_ESP IPPROTO_AH IPPROTO_ICMPV6 IPPROTO_NONE IPPROTO_DSTOPTS
+ IPPROTO_MTP IPPROTO_ENCAP IPPROTO_PIM IPPROTO_COMP IPPROTO_SCTP IPPROTO_UDPLITE IPPROTO_RAW
+ SOL_RAW SOL_DECNET SOL_X25 SOL_PACKET SOL_ATM SOL_AAL SOL_IRDA
+ SHUT_RD SHUT_WR SHUT_RDWR)))
+
+ (void sethostent (int))
+ (void endhostent (void))
+ (void* gethostent (void))
+
+ (void setservent (int))
+ (void endservent (void))
+ (void* getservent (void))
+
+ (void setprotoent (int))
+ (void endprotoent (void))
+ (void* getprotoent (void))
+
+ (void setnetent (int))
+ (void endnetent (void))
+ (void* getnetent (void))
+
+ (int socket (int int int))
+ (int listen (int int))
+ (int shutdown (int int))
+
+ (void* gethostbyname (char*))
+ (void* gethostbyaddr (void* int int))
+ (void* getnetbyname (char*))
+ (void* getnetbyaddr (int int))
+ (void* getservbyname (char* char*))
+ (void* getservbyport (int char*))
+ (void* getprotobyname (char*))
+ (void* getprotobynumber (int))
+
+ (void freeaddrinfo (void*))
+ (char* gai_strerror (int))
+
+ (int bind (int void* int))
+ (int connect (int void* int))
+ (int send (int void* int int))
+ (int recv (int void* int int))
+ (int sendto (int void* int int void* int))
+ (int sendmsg (int void* int))
+ (int recvmsg (int void* int))
+
+ (in-C "static s7_pointer g_ntohl(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, ntohl(s7_integer(s7_car(args)))));}
+ static s7_pointer g_ntohs(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, ntohs(s7_integer(s7_car(args)))));}
+ static s7_pointer g_htonl(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, htonl(s7_integer(s7_car(args)))));}
+ static s7_pointer g_htons(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, htons(s7_integer(s7_car(args)))));}
+
+ static s7_pointer g_addrinfo_make(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct addrinfo))));
+ }
+
+ static s7_pointer g_addrinfo_ai_flags(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_integer(sc, ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_flags));
+ }
+ static s7_pointer g_addrinfo_set_ai_flags(s7_scheme *sc, s7_pointer args)
+ {
+ ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_flags = (int)s7_integer(s7_cadr(args));
+ return(s7_cadr(args));
+ }
+
+ static s7_pointer g_addrinfo_ai_family(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_integer(sc, ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_family));
+ }
+ static s7_pointer g_addrinfo_set_ai_family(s7_scheme *sc, s7_pointer args)
+ {
+ ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_family = (int)s7_integer(s7_cadr(args));
+ return(s7_cadr(args));
+ }
+
+ static s7_pointer g_addrinfo_ai_socktype(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_integer(sc, ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_socktype));
+ }
+ static s7_pointer g_addrinfo_set_ai_socktype(s7_scheme *sc, s7_pointer args)
+ {
+ ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_socktype = (int)s7_integer(s7_cadr(args));
+ return(s7_cadr(args));
+ }
+
+ static s7_pointer g_addrinfo_ai_protocol(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_integer(sc, ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_protocol));
+ }
+ static s7_pointer g_addrinfo_set_ai_protocol(s7_scheme *sc, s7_pointer args)
+ {
+ ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_protocol = (int)s7_integer(s7_cadr(args));
+ return(s7_cadr(args));
+ }
+ static s7_pointer g_addrinfo_ai_canonname(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_string(sc, ((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_canonname));
+ }
+ static s7_pointer g_addrinfo_ai_next(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_c_pointer(sc, (void *)(((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_next)));
+ }
+
+ static s7_pointer g_getaddrinfo(s7_scheme *sc, s7_pointer args)
+ {
+ struct addrinfo *result;
+ int err;
+ err = getaddrinfo(s7_string(s7_car(args)),
+ s7_string(s7_cadr(args)),
+ (const struct addrinfo *)s7_c_pointer(s7_caddr(args)),
+ &result);
+ return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_c_pointer(sc, (void *)result)));
+ }
+
+ static s7_pointer g_getnameinfo(s7_scheme *sc, s7_pointer args)
+ {
+ #ifndef NI_MAXHOST
+ #define NI_MAXHOST 1025
+ #endif
+ #ifndef NI_MAXSERV
+ #define NI_MAXSERV 32
+ #endif
+ char *host, *service;
+ int err;
+ host = (char *)calloc(NI_MAXHOST, sizeof(char));
+ service = (char *)calloc(NI_MAXSERV, sizeof(char));
+ err = getnameinfo((const struct sockaddr *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args)),
+ host, NI_MAXHOST,
+ service, NI_MAXSERV,
+ s7_integer(s7_caddr(args)));
+ return(s7_list(sc, 3, s7_make_integer(sc, err), s7_make_string(sc, host), s7_make_string(sc, service)));
+ }
+
+ static s7_pointer g_socketpair(s7_scheme *sc, s7_pointer args)
+ {
+ int fds[2];
+ int err;
+ err = socketpair(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)), fds);
+ return(s7_list(sc, 3, s7_make_integer(sc, err), s7_make_integer(sc, fds[0]), s7_make_integer(sc, fds[1])));
+ }
+
+ static s7_pointer g_getsockname(s7_scheme *sc, s7_pointer args)
+ {
+ int err;
+ socklen_t res;
+ res = s7_integer(s7_caddr(args));
+ err = getsockname(s7_integer(s7_car(args)), (struct sockaddr *)s7_c_pointer(s7_cadr(args)), &res);
+ return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, res)));
+ }
+ static s7_pointer g_getpeername(s7_scheme *sc, s7_pointer args)
+ {
+ int err;
+ socklen_t res;
+ res = s7_integer(s7_caddr(args));
+ err = getpeername(s7_integer(s7_car(args)), (struct sockaddr *)s7_c_pointer(s7_cadr(args)), &res);
+ return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, res)));
+ }
+ static s7_pointer g_accept(s7_scheme *sc, s7_pointer args)
+ {
+ int err;
+ socklen_t res;
+ res = s7_integer(s7_caddr(args));
+ err = accept(s7_integer(s7_car(args)), (struct sockaddr *)s7_c_pointer(s7_cadr(args)), &res);
+ return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, res)));
+ }
+ static s7_pointer g_getsockopt(s7_scheme *sc, s7_pointer args)
+ {
+ int err;
+ socklen_t res;
+ res = (socklen_t)s7_integer(s7_list_ref(sc, args, 4));
+ err = getsockopt(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)), s7_c_pointer(s7_cadddr(args)), &res);
+ return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, (s7_int)res)));
+ }
+ static s7_pointer g_setsockopt(s7_scheme *sc, s7_pointer args)
+ {
+ socklen_t res;
+ res = (socklen_t)s7_integer(s7_list_ref(sc, args, 4));
+ return(s7_make_integer(sc, setsockopt(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)),
+ s7_integer(s7_caddr(args)), s7_c_pointer(s7_cadddr(args)), res)));
+ }
+ static s7_pointer g_recvfrom(s7_scheme *sc, s7_pointer args)
+ {
+ int err;
+ socklen_t res;
+ res = (socklen_t)s7_integer(s7_list_ref(sc, args, 5));
+ err = recvfrom(s7_integer(s7_car(args)),
+ s7_c_pointer(s7_cadr(args)),
+ s7_integer(s7_caddr(args)),
+ s7_integer(s7_cadddr(args)),
+ (struct sockaddr *)s7_c_pointer(s7_list_ref(sc, args, 4)),
+ &res);
+ return(s7_list(sc, 2, s7_make_integer(sc, err), s7_make_integer(sc, (s7_int)res)));
+ }
+
+ static s7_pointer g_hostent_h_name(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct hostent *)s7_c_pointer(s7_car(args)))->h_name));}
+ static s7_pointer g_netent_n_name(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct netent *)s7_c_pointer(s7_car(args)))->n_name));}
+ static s7_pointer g_servent_s_name(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct servent *)s7_c_pointer(s7_car(args)))->s_name));}
+ static s7_pointer g_servent_s_proto(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct servent *)s7_c_pointer(s7_car(args)))->s_proto));}
+ static s7_pointer g_protoent_p_name(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_string(sc, ((struct protoent *)s7_c_pointer(s7_car(args)))->p_name));}
+
+ static s7_pointer g_hostent_h_addrtype(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct hostent *)s7_c_pointer(s7_car(args)))->h_addrtype));}
+ static s7_pointer g_hostent_h_length(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct hostent *)s7_c_pointer(s7_car(args)))->h_length));}
+ static s7_pointer g_netent_n_addrtype(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct netent *)s7_c_pointer(s7_car(args)))->n_addrtype));}
+ static s7_pointer g_netent_n_net(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct netent *)s7_c_pointer(s7_car(args)))->n_net));}
+ static s7_pointer g_servent_s_port(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct servent *)s7_c_pointer(s7_car(args)))->s_port));}
+ static s7_pointer g_protoent_p_proto(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, ((struct protoent *)s7_c_pointer(s7_car(args)))->p_proto));}
+
+ static s7_pointer g_hostent_h_aliases(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer p;
+ char **str;
+ struct hostent *h;
+ p = s7_nil(sc);
+ h = (struct hostent *)s7_c_pointer(s7_car(args));
+ for (str = h->h_aliases; (str) && (*str); str++)
+ p = s7_cons(sc, s7_make_string(sc, *str), p);
+ return(p);
+ }
+ static s7_pointer g_servent_s_aliases(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer p;
+ char **str;
+ struct servent *h;
+ p = s7_nil(sc);
+ h = (struct servent *)s7_c_pointer(s7_car(args));
+ for (str = h->s_aliases; (str) && (*str); str++)
+ p = s7_cons(sc, s7_make_string(sc, *str), p);
+ return(p);
+ }
+ static s7_pointer g_netent_n_aliases(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer p;
+ char **str;
+ struct netent *h;
+ p = s7_nil(sc);
+ h = (struct netent *)s7_c_pointer(s7_car(args));
+ for (str = h->n_aliases; (str) && (*str); str++)
+ p = s7_cons(sc, s7_make_string(sc, *str), p);
+ return(p);
+ }
+ static s7_pointer g_protoent_p_aliases(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer p;
+ char **str;
+ struct protoent *h;
+ p = s7_nil(sc);
+ h = (struct protoent *)s7_c_pointer(s7_car(args));
+ for (str = h->p_aliases; (str) && (*str); str++)
+ p = s7_cons(sc, s7_make_string(sc, *str), p);
+ return(p);
+ }
+ ")
+ (C-function ("htonl" g_htonl "" 1))
+ (C-function ("htons" g_htons "" 1))
+ (C-function ("ntohl" g_ntohl "" 1))
+ (C-function ("ntohs" g_ntohs "" 1))
+
+ (C-function ("getaddrinfo" g_getaddrinfo "" 3))
+ (C-function ("getnameinfo" g_getnameinfo "" 3))
+ (C-function ("addrinfo.make" g_addrinfo_make "" 0))
+ (C-function ("addrinfo.ai_flags" g_addrinfo_ai_flags "" 1))
+ (C-function ("addrinfo.set_ai_flags" g_addrinfo_set_ai_flags "" 2))
+ (C-function ("addrinfo.ai_family" g_addrinfo_ai_family "" 1))
+ (C-function ("addrinfo.set_ai_family" g_addrinfo_set_ai_family "" 2))
+ (C-function ("addrinfo.ai_socktype" g_addrinfo_ai_socktype "" 1))
+ (C-function ("addrinfo.set_ai_socktype" g_addrinfo_set_ai_socktype "" 2))
+ (C-function ("addrinfo.ai_protocol" g_addrinfo_ai_protocol "" 1))
+ (C-function ("addrinfo.set_ai_protocol" g_addrinfo_set_ai_protocol "" 2))
+ (C-function ("addrinfo.ai_canonname" g_addrinfo_ai_canonname "" 1))
+ (C-function ("addrinfo.ai_next" g_addrinfo_ai_next "" 1))
+
+ (C-function ("hostent.h_name" g_hostent_h_name "" 1))
+ (C-function ("netent.n_name" g_netent_n_name "" 1))
+ (C-function ("servent.s_name" g_servent_s_name "" 1))
+ (C-function ("servent.s_proto" g_servent_s_proto "" 1))
+ (C-function ("protoent.p_name" g_protoent_p_name "" 1))
+ (C-function ("hostent.h_addrtype" g_hostent_h_addrtype "" 1))
+ (C-function ("hostent.h_length" g_hostent_h_length "" 1))
+ (C-function ("netent.n_addrtype" g_netent_n_addrtype "" 1))
+ (C-function ("netent.n_net" g_netent_n_net "" 1))
+ (C-function ("servent.s_port" g_servent_s_port "" 1))
+ (C-function ("protoent.p_proto" g_protoent_p_proto "" 1))
+
+ (C-function ("hostent.h_aliases" g_hostent_h_aliases "" 1))
+ (C-function ("servent.s_aliases" g_servent_s_aliases "" 1))
+ (C-function ("netent.n_aliases" g_netent_n_aliases "" 1))
+ (C-function ("protoent.p_aliases" g_protoent_p_aliases "" 1))
+ ;; (define h (gethostbyname "fatty4"))
+ ;; ((*libc* 'hostent.h_aliases) h) -> ("localhost" "localhost.localdomain")
+
+ (C-function ("socketpair" g_socketpair "" 3))
+ (C-function ("getsockname" g_getsockname "" 3))
+ (C-function ("getpeername" g_getpeername "" 3))
+ (C-function ("accept" g_accept "" 3))
+ (C-function ("getsockopt" g_getsockopt "" 5))
+ (C-function ("setsockopt" g_setsockopt "" 5))
+ (C-function ("recvfrom" g_recvfrom "" 6))
+ )
+
+ ""
+ (list "limits.h" "ctype.h" "errno.h" "float.h" "stdint.h" "locale.h" "stdlib.h" "string.h" "fcntl.h"
+ "fenv.h" "stdio.h" "sys/utsname.h" "unistd.h" "dirent.h" "ftw.h" "sys/stat.h" "time.h" "sys/time.h"
+ "utime.h" "termios.h" "grp.h" "pwd.h" "fnmatch.h" "glob.h" "signal.h" "sys/wait.h" "netdb.h"
+ "sys/resource.h"
+ (reader-cond ((not (provided? 'openbsd)) "wordexp.h"))
+ (reader-cond ((provided? 'freebsd) "sys/socket.h" "netinet/in.h"))
+ )
+ ""
+ (if (provided? 'linux) "-lrt"
+ (if (provided? 'openbsd) "-pthread" ""))
+ "libc_s7")
+
+ (curlet))))
+
+*libc*
diff --git a/libdl.scm b/libdl.scm
new file mode 100644
index 0000000..b07207b
--- /dev/null
+++ b/libdl.scm
@@ -0,0 +1,34 @@
+;;; libdl.scm
+;;;
+;;; tie the dynamic loader library into the *libdl* environment
+
+(require cload.scm)
+(provide 'libdl.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((current-file (port-filename (current-input-port))))
+ (let ((directory (and (or (char=? (current-file 0) #\/)
+ (char=? (current-file 0) #\~))
+ (substring current-file 0 (- (length current-file) 9)))))
+ (when (and directory (not (member directory *load-path*)))
+ (set! *load-path* (cons directory *load-path*)))
+ (with-let (rootlet)
+ (require cload.scm))
+ (when (and directory (not (string-position directory *cload-cflags*)))
+ (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*)))))
+
+
+(if (not (defined? '*libdl*))
+ (define *libdl*
+ (with-let (unlet)
+ (set! *libraries* (cons (cons "libdl.scm" (curlet)) *libraries*))
+ (c-define '((void* dlopen (char* int))
+ (int dlclose (void*))
+ (void* dlsym (void* char*))
+ (char* dlerror (void))
+ (C-macro (int (RTLD_LAZY RTLD_NOW RTLD_BINDING_MASK RTLD_NOLOAD RTLD_DEEPBIND RTLD_GLOBAL RTLD_LOCAL RTLD_NODELETE))))
+ "" "dlfcn.h" "" "" "libdl_s7")
+ (curlet))))
+
+*libdl*
+;; the loader will return *libdl*
diff --git a/libgdbm.scm b/libgdbm.scm
new file mode 100644
index 0000000..5af85a6
--- /dev/null
+++ b/libgdbm.scm
@@ -0,0 +1,247 @@
+;;; libgdbm.scm
+;;;
+;;; tie libgdbm into s7
+
+(require cload.scm)
+(provide 'libgdbm.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((current-file (port-filename (current-input-port))))
+ (let ((directory (and (or (char=? (current-file 0) #\/)
+ (char=? (current-file 0) #\~))
+ (substring current-file 0 (- (length current-file) 9)))))
+ (when (and directory (not (member directory *load-path*)))
+ (set! *load-path* (cons directory *load-path*)))
+ (with-let (rootlet)
+ (require cload.scm))
+ (when (and directory (not (string-position directory *cload-cflags*)))
+ (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*)))))
+
+
+(if (not (defined? '*libgdbm*))
+ (define *libgdbm*
+ (with-let (unlet)
+ (set! *libraries* (cons (cons "libgdbm.scm" (curlet)) *libraries*))
+
+ (c-define '((C-macro (int (GDBM_READER GDBM_WRITER GDBM_WRCREAT GDBM_NEWDB GDBM_FAST GDBM_SYNC GDBM_NOLOCK
+ GDBM_INSERT GDBM_REPLACE GDBM_CACHESIZE GDBM_FASTMODE GDBM_SYNCMODE GDBM_CENTFREE
+ GDBM_COALESCEBLKS GDBM_OPENMASK GDBM_NOMMAP GDBM_CLOEXEC GDBM_SETCACHESIZE GDBM_SETSYNCMODE
+ GDBM_SETCENTFREE GDBM_SETCOALESCEBLKS GDBM_SETMAXMAPSIZE GDBM_SETMMAP GDBM_GETFLAGS GDBM_GETMMAP
+ GDBM_GETCACHESIZE GDBM_GETSYNCMODE GDBM_GETCENTFREE GDBM_GETCOALESCEBLKS GDBM_GETMAXMAPSIZE GDBM_GETDBNAME)))
+ (C-macro (int (GDBM_VERSION_MAJOR GDBM_VERSION_MINOR GDBM_VERSION_PATCH)))
+ (C-macro (int (GDBM_NO_ERROR GDBM_MALLOC_ERROR GDBM_BLOCK_SIZE_ERROR GDBM_FILE_OPEN_ERROR GDBM_FILE_WRITE_ERROR
+ GDBM_FILE_SEEK_ERROR GDBM_FILE_READ_ERROR GDBM_BAD_MAGIC_NUMBER GDBM_EMPTY_DATABASE GDBM_CANT_BE_READER
+ GDBM_CANT_BE_WRITER GDBM_READER_CANT_DELETE GDBM_READER_CANT_STORE GDBM_READER_CANT_REORGANIZE
+ GDBM_UNKNOWN_UPDATE GDBM_ITEM_NOT_FOUND GDBM_REORGANIZE_FAILED GDBM_CANNOT_REPLACE GDBM_ILLEGAL_DATA
+ GDBM_OPT_ALREADY_SET GDBM_OPT_ILLEGAL GDBM_BYTE_SWAPPED GDBM_BAD_FILE_OFFSET GDBM_BAD_OPEN_FLAGS
+ GDBM_FILE_STAT_ERROR GDBM_FILE_EOF)))
+
+ (in-C "static s7_pointer g_gdbm_version(s7_scheme *sc, s7_pointer args) {return(s7_make_string(sc, gdbm_version));}")
+ (C-function ("gdbm_version" g_gdbm_version "(gdbm_version) returns the current gbdm version" 0))
+ (in-C "static s7_pointer g_gdbm_errno(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, gdbm_errno));}")
+ (C-function ("gdbm_errno" g_gdbm_errno "(gdbm_errno) returns the current gdbm error number" 0))
+ (char* gdbm_strerror (int))
+
+ (int gdbm_fdesc ((GDBM_FILE c_pointer)))
+ (int gdbm_reorganize ((GDBM_FILE c_pointer)))
+ (void gdbm_close ((GDBM_FILE c_pointer)))
+ (void gdbm_sync ((GDBM_FILE c_pointer)))
+
+ ;(int gdbm_export ((GDBM_FILE c_pointer) char* int int))
+ ;(int gdbm_import ((GDBM_FILE c_pointer) char* int))
+
+ (in-C "
+static void *make_datum(datum key) {datum *p; p = (datum *)malloc(sizeof(datum)); p->dptr = key.dptr; p->dsize = key.dsize; return((void *)p);}
+static s7_pointer g_gdbm_firstkey(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_c_pointer(s7_car(args)))
+ {
+ datum key;
+ key = gdbm_firstkey((GDBM_FILE)s7_c_pointer(s7_car(args)));
+ if (key.dptr)
+ return(s7_cons(sc, s7_make_string_with_length(sc, key.dptr, key.dsize), s7_make_c_pointer(sc, make_datum(key))));
+ return(s7_eof_object(sc));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_firstkey\", 0, s7_car(args), \"a gdbm file\"));
+}
+
+static s7_pointer g_gdbm_nextkey(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_c_pointer(s7_car(args)))
+ {
+ if (s7_is_c_pointer(s7_cadr(args)))
+ {
+ datum *p;
+ datum key, rtn;
+ p = (datum *)s7_c_pointer(s7_cadr(args));
+ key.dptr = p->dptr;
+ key.dsize = p->dsize;
+ rtn = gdbm_nextkey((GDBM_FILE)s7_c_pointer(s7_car(args)), key);
+ free(key.dptr);
+ free(p);
+ if (rtn.dptr)
+ return(s7_cons(sc, s7_make_string_with_length(sc, rtn.dptr, rtn.dsize), s7_make_c_pointer(sc, make_datum(rtn))));
+ return(s7_eof_object(sc));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_nextkey\", 2, s7_cadr(args), \"a string\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_nextkey\", 1, s7_car(args), \"a gdbm file\"));
+}
+
+static s7_pointer g_gdbm_exists(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_c_pointer(s7_car(args)))
+ {
+ if (s7_is_string(s7_cadr(args)))
+ {
+ datum key;
+ key.dptr = (char *)s7_string(s7_cadr(args));
+ key.dsize = (int)s7_string_length(s7_cadr(args));
+ return(s7_make_integer(sc, gdbm_exists((GDBM_FILE)s7_c_pointer(s7_car(args)), key)));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_exists\", 2, s7_cadr(args), \"a string\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_exists\", 1, s7_car(args), \"a gdbm file\"));
+}
+
+static s7_pointer g_gdbm_delete(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_c_pointer(s7_car(args)))
+ {
+ if (s7_is_string(s7_cadr(args)))
+ {
+ datum key;
+ key.dptr = (char *)s7_string(s7_cadr(args));
+ key.dsize = (int)s7_string_length(s7_cadr(args));
+ return(s7_make_integer(sc, gdbm_delete((GDBM_FILE)s7_c_pointer(s7_car(args)), key))); } \n\
+ return(s7_wrong_type_arg_error(sc, \"gdbm_delete\", 2, s7_cadr(args), \"a string\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_delete\", 1, s7_car(args), \"a gdbm file\"));
+}
+
+static s7_pointer g_gdbm_fetch(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_c_pointer(s7_car(args)))
+ {
+ if (s7_is_string(s7_cadr(args)))
+ {
+ datum key, rtn;
+ key.dptr = (char *)s7_string(s7_cadr(args));
+ key.dsize = (int)s7_string_length(s7_cadr(args));
+ rtn = gdbm_fetch((GDBM_FILE)s7_c_pointer(s7_car(args)), key);
+ if (rtn.dptr)
+ {
+ s7_pointer result;
+ result = s7_make_string_with_length(sc, rtn.dptr, rtn.dsize - 1);
+ free(rtn.dptr);
+ return(result);
+ }
+ else return(s7_make_string_with_length(sc, \"#<undefined>\", 12));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_fetch\", 2, s7_cadr(args), \"a string\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_fetch\", 1, s7_car(args), \"a gdbm file\"));
+}
+
+static s7_pointer g_gdbm_store(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_c_pointer(s7_car(args)))
+ {
+ if (s7_is_string(s7_cadr(args)))
+ {
+ if (s7_is_string(s7_caddr(args)))
+ {
+ if (s7_is_integer(s7_cadddr(args)))
+ {
+ datum key, val;
+ key.dptr = (char *)s7_string(s7_cadr(args));
+ key.dsize = (int)s7_string_length(s7_cadr(args));
+ val.dptr = (char *)s7_string(s7_caddr(args));
+ val.dsize = (int)s7_string_length(s7_caddr(args)) + 1;
+ return(s7_make_integer(sc, gdbm_store((GDBM_FILE)s7_c_pointer(s7_car(args)), key, val, (int)s7_integer(s7_cadddr(args)))));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_fetch\", 4, s7_cadddr(args), \"an integer (flag)\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_fetch\", 3, s7_caddr(args), \"a string\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_fetch\", 2, s7_cadr(args), \"a string\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_fetch\", 1, s7_car(args), \"a gdbm file\"));
+}
+
+static s7_pointer open_error_func = NULL;
+static s7_scheme *open_error_s7 = NULL;
+static void gdbm_open_error(const char *name)
+{
+ if (open_error_func)
+ s7_apply_function(open_error_s7, open_error_func, s7_list(open_error_s7, 1, s7_make_string(open_error_s7, name)));
+}
+
+static s7_pointer g_gdbm_open(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_string(s7_car(args)))
+ {
+ char *name;
+ name = (char *)s7_string(s7_car(args));
+ args = s7_cdr(args);
+ if (s7_is_integer(s7_car(args)))
+ {
+ int block_size;
+ block_size = (int)s7_integer(s7_car(args));
+ args = s7_cdr(args);
+ if (s7_is_integer(s7_car(args)))
+ {
+ int flags;
+ flags = (int)s7_integer(s7_car(args));
+ args = s7_cdr(args);
+ if (s7_is_integer(s7_car(args)))
+ {
+ int mode;
+ mode = (int)s7_integer(s7_car(args));
+ if (s7_is_procedure(s7_cadr(args)))
+ {
+ open_error_func = s7_cadr(args);
+ open_error_s7 = sc;
+ }
+ else
+ {
+ open_error_func = NULL;
+ open_error_s7 = NULL;
+ }
+ return(s7_make_c_pointer(sc, (void *)gdbm_open(name, block_size, flags, mode, gdbm_open_error)));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_open\", 4, s7_car(args), \"an integer (mode)\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_open\", 3, s7_car(args), \"an integer (flags)\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_open\", 2, s7_car(args), \"an integer (block_size)\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"gdbm_open\", 1, s7_car(args), \"a string (file name)\"));
+}
+")
+ (C-function ("gdbm_firstkey" g_gdbm_firstkey "(gdbm_firstkey gdbm)" 1))
+ (C-function ("gdbm_exists" g_gdbm_exists "(gdbm_exists gdbm key)" 2))
+ (C-function ("gdbm_delete" g_gdbm_delete "(gdbm_delete gdbm key)" 2))
+ (C-function ("gdbm_nextkey" g_gdbm_nextkey "(gdbm_nextkey gdbm prev)" 2))
+ (C-function ("gdbm_fetch" g_gdbm_fetch "(gdbm_fetch gdbm key)" 2))
+ (C-function ("gdbm_store" g_gdbm_store "(gdbm_store gdbm key context flag)" 4))
+ (C-function ("gdbm_open" g_gdbm_open "(gdbm_open filename size flags mode func) opens a gdbm data base" 5))
+
+ )
+ "" "gdbm.h" "" "-lgdbm" "libgdbm_s7")
+
+ (curlet))))
+
+*libgdbm*
+
+
+
+;;; extern int gdbm_setopt (GDBM_FILE, int, void *, int)
+;;; this is a huge mess
+
+#|
+(define gfile ((*libgdbm* 'gdbm_open) "test.gdbm" 1024 (*libgdbm* 'GDBM_NEWDB) #o664 (lambda (str) (format *stderr* "str: ~S~%" str))))
+((*libgdbm* 'gdbm_store) gfile "1" "1234" (*libgdbm* 'GDBM_REPLACE))
+((*libgdbm* 'gdbm_fetch) gfile "1")
+((*libgdbm* 'gdbm_close) gfile)
+|#
diff --git a/libgsl.scm b/libgsl.scm
new file mode 100644
index 0000000..77a2b0e
--- /dev/null
+++ b/libgsl.scm
@@ -0,0 +1,3000 @@
+;;; libgsl.scm
+;;;
+;;; tie the gsl library into the *libgsl* environment
+
+(require cload.scm)
+(provide 'libgsl.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((current-file (port-filename (current-input-port))))
+ (let ((directory (and (or (char=? (current-file 0) #\/)
+ (char=? (current-file 0) #\~))
+ (substring current-file 0 (- (length current-file) 9)))))
+ (when (and directory (not (member directory *load-path*)))
+ (set! *load-path* (cons directory *load-path*)))
+ (with-let (rootlet)
+ (require cload.scm))
+ (when (and directory (not (string-position directory *cload-cflags*)))
+ (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*)))))
+
+
+(when (provided? 'pure-s7)
+ (define (make-polar mag ang)
+ (if (and (real? mag) (real? ang))
+ (complex (* mag (cos ang)) (* mag (sin ang)))
+ (error 'wrong-type-arg "make-polar args should be real"))))
+
+;; since we might be loading this locally, reader-cond (in that case) won't find gsl-version unless...
+(if (not (defined? '*libgsl*))
+ (with-let (rootlet)
+ (define gsl-version 0.0) ; define at top-level no matter where we are now
+ (when (and (provided? 'linux)
+ (defined? 'system))
+ (let ((version (system "pkg-config gsl --modversion" #t)))
+ (if (positive? (length version))
+ (set! gsl-version (with-input-from-string version read)))))))
+
+(if (not (defined? '*libgsl*))
+ (define *libgsl*
+ (with-let (unlet)
+ (set! *libraries* (cons (cons "libgsl.scm" (curlet)) *libraries*))
+
+ (define GSL_REAL real-part)
+ (define GSL_IMAG imag-part)
+ (define GSL_COMPLEX_EQ equal?)
+ (define GSL_COMPLEX_ONE 1.0)
+ (define GSL_COMPLEX_ZERO 0.0)
+ (define GSL_COMPLEX_NEGONE -1.0)
+ (define gsl_complex_polar make-polar)
+ (define gsl_complex_rect complex)
+ (define GSL_IS_ODD odd?)
+ (define GSL_IS_EVEN even?)
+ (define (GSL_IS_REAL n) (and (number? n) (not (nan? n)) (not (infinite? n))))
+ (define (GSL_SIGN x) (if (negative? x) -1 1))
+ (define GSL_MAX max)
+ (define GSL_MIN min)
+ (define GSL_MAX_INT max)
+ (define GSL_MIN_INT min)
+ (define GSL_MAX_DBL max)
+ (define GSL_MIN_DBL min)
+ (define gsl_max max)
+ (define gsl_min min)
+
+ (c-define
+ '((C-macro (double (GSL_CONST_CGS_SPEED_OF_LIGHT GSL_CONST_CGS_GRAVITATIONAL_CONSTANT GSL_CONST_CGS_PLANCKS_CONSTANT_H
+ GSL_CONST_CGS_PLANCKS_CONSTANT_HBAR GSL_CONST_CGS_ASTRONOMICAL_UNIT GSL_CONST_CGS_LIGHT_YEAR
+ GSL_CONST_CGS_PARSEC GSL_CONST_CGS_GRAV_ACCEL GSL_CONST_CGS_ELECTRON_VOLT GSL_CONST_CGS_MASS_ELECTRON
+ GSL_CONST_CGS_MASS_MUON GSL_CONST_CGS_MASS_PROTON GSL_CONST_CGS_MASS_NEUTRON GSL_CONST_CGS_RYDBERG
+ GSL_CONST_CGS_BOLTZMANN GSL_CONST_CGS_MOLAR_GAS GSL_CONST_CGS_STANDARD_GAS_VOLUME GSL_CONST_CGS_MINUTE
+ GSL_CONST_CGS_HOUR GSL_CONST_CGS_DAY GSL_CONST_CGS_WEEK GSL_CONST_CGS_INCH GSL_CONST_CGS_FOOT
+ GSL_CONST_CGS_YARD GSL_CONST_CGS_MILE GSL_CONST_CGS_NAUTICAL_MILE GSL_CONST_CGS_FATHOM GSL_CONST_CGS_MIL
+ GSL_CONST_CGS_POINT GSL_CONST_CGS_TEXPOINT GSL_CONST_CGS_MICRON GSL_CONST_CGS_ANGSTROM GSL_CONST_CGS_HECTARE
+ GSL_CONST_CGS_ACRE GSL_CONST_CGS_BARN GSL_CONST_CGS_LITER GSL_CONST_CGS_US_GALLON GSL_CONST_CGS_QUART
+ GSL_CONST_CGS_PINT GSL_CONST_CGS_CUP GSL_CONST_CGS_FLUID_OUNCE GSL_CONST_CGS_TABLESPOON GSL_CONST_CGS_TEASPOON
+ GSL_CONST_CGS_CANADIAN_GALLON GSL_CONST_CGS_UK_GALLON GSL_CONST_CGS_MILES_PER_HOUR GSL_CONST_CGS_KILOMETERS_PER_HOUR
+ GSL_CONST_CGS_KNOT GSL_CONST_CGS_POUND_MASS GSL_CONST_CGS_OUNCE_MASS GSL_CONST_CGS_TON GSL_CONST_CGS_METRIC_TON
+ GSL_CONST_CGS_UK_TON GSL_CONST_CGS_TROY_OUNCE GSL_CONST_CGS_CARAT GSL_CONST_CGS_UNIFIED_ATOMIC_MASS
+ GSL_CONST_CGS_GRAM_FORCE GSL_CONST_CGS_POUND_FORCE GSL_CONST_CGS_KILOPOUND_FORCE GSL_CONST_CGS_POUNDAL
+ GSL_CONST_CGS_CALORIE GSL_CONST_CGS_BTU GSL_CONST_CGS_THERM GSL_CONST_CGS_HORSEPOWER GSL_CONST_CGS_BAR
+ GSL_CONST_CGS_STD_ATMOSPHERE GSL_CONST_CGS_TORR GSL_CONST_CGS_METER_OF_MERCURY GSL_CONST_CGS_INCH_OF_MERCURY
+ GSL_CONST_CGS_INCH_OF_WATER GSL_CONST_CGS_PSI GSL_CONST_CGS_POISE GSL_CONST_CGS_STOKES GSL_CONST_CGS_STILB
+ GSL_CONST_CGS_LUMEN GSL_CONST_CGS_LUX GSL_CONST_CGS_PHOT GSL_CONST_CGS_FOOTCANDLE GSL_CONST_CGS_LAMBERT
+ GSL_CONST_CGS_FOOTLAMBERT GSL_CONST_CGS_CURIE GSL_CONST_CGS_ROENTGEN GSL_CONST_CGS_RAD GSL_CONST_CGS_SOLAR_MASS
+ GSL_CONST_CGS_BOHR_RADIUS GSL_CONST_CGS_NEWTON GSL_CONST_CGS_DYNE GSL_CONST_CGS_JOULE GSL_CONST_CGS_ERG
+ GSL_CONST_CGS_STEFAN_BOLTZMANN_CONSTANT GSL_CONST_CGS_THOMSON_CROSS_SECTION GSL_CONST_CGSM_SPEED_OF_LIGHT
+ GSL_CONST_CGSM_GRAVITATIONAL_CONSTANT GSL_CONST_CGSM_PLANCKS_CONSTANT_H GSL_CONST_CGSM_PLANCKS_CONSTANT_HBAR
+ GSL_CONST_CGSM_ASTRONOMICAL_UNIT GSL_CONST_CGSM_LIGHT_YEAR GSL_CONST_CGSM_PARSEC GSL_CONST_CGSM_GRAV_ACCEL
+ GSL_CONST_CGSM_ELECTRON_VOLT GSL_CONST_CGSM_MASS_ELECTRON GSL_CONST_CGSM_MASS_MUON GSL_CONST_CGSM_MASS_PROTON
+ GSL_CONST_CGSM_MASS_NEUTRON GSL_CONST_CGSM_RYDBERG GSL_CONST_CGSM_BOLTZMANN GSL_CONST_CGSM_MOLAR_GAS
+ GSL_CONST_CGSM_STANDARD_GAS_VOLUME GSL_CONST_CGSM_MINUTE GSL_CONST_CGSM_HOUR GSL_CONST_CGSM_DAY
+ GSL_CONST_CGSM_WEEK GSL_CONST_CGSM_INCH GSL_CONST_CGSM_FOOT GSL_CONST_CGSM_YARD GSL_CONST_CGSM_MILE
+ GSL_CONST_CGSM_NAUTICAL_MILE GSL_CONST_CGSM_FATHOM GSL_CONST_CGSM_MIL GSL_CONST_CGSM_POINT GSL_CONST_CGSM_TEXPOINT
+ GSL_CONST_CGSM_MICRON GSL_CONST_CGSM_ANGSTROM GSL_CONST_CGSM_HECTARE GSL_CONST_CGSM_ACRE GSL_CONST_CGSM_BARN
+ GSL_CONST_CGSM_LITER GSL_CONST_CGSM_US_GALLON GSL_CONST_CGSM_QUART GSL_CONST_CGSM_PINT GSL_CONST_CGSM_CUP
+ GSL_CONST_CGSM_FLUID_OUNCE GSL_CONST_CGSM_TABLESPOON GSL_CONST_CGSM_TEASPOON GSL_CONST_CGSM_CANADIAN_GALLON
+ GSL_CONST_CGSM_UK_GALLON GSL_CONST_CGSM_MILES_PER_HOUR GSL_CONST_CGSM_KILOMETERS_PER_HOUR GSL_CONST_CGSM_KNOT
+ GSL_CONST_CGSM_POUND_MASS GSL_CONST_CGSM_OUNCE_MASS GSL_CONST_CGSM_TON GSL_CONST_CGSM_METRIC_TON
+ GSL_CONST_CGSM_UK_TON GSL_CONST_CGSM_TROY_OUNCE GSL_CONST_CGSM_CARAT GSL_CONST_CGSM_UNIFIED_ATOMIC_MASS
+ GSL_CONST_CGSM_GRAM_FORCE GSL_CONST_CGSM_POUND_FORCE GSL_CONST_CGSM_KILOPOUND_FORCE GSL_CONST_CGSM_POUNDAL
+ GSL_CONST_CGSM_CALORIE GSL_CONST_CGSM_BTU GSL_CONST_CGSM_THERM GSL_CONST_CGSM_HORSEPOWER GSL_CONST_CGSM_BAR
+ GSL_CONST_CGSM_STD_ATMOSPHERE GSL_CONST_CGSM_TORR GSL_CONST_CGSM_METER_OF_MERCURY GSL_CONST_CGSM_INCH_OF_MERCURY
+ GSL_CONST_CGSM_INCH_OF_WATER GSL_CONST_CGSM_PSI GSL_CONST_CGSM_POISE GSL_CONST_CGSM_STOKES GSL_CONST_CGSM_STILB
+ GSL_CONST_CGSM_LUMEN GSL_CONST_CGSM_LUX GSL_CONST_CGSM_PHOT GSL_CONST_CGSM_FOOTCANDLE GSL_CONST_CGSM_LAMBERT
+ GSL_CONST_CGSM_FOOTLAMBERT GSL_CONST_CGSM_CURIE GSL_CONST_CGSM_ROENTGEN GSL_CONST_CGSM_RAD GSL_CONST_CGSM_SOLAR_MASS
+ GSL_CONST_CGSM_BOHR_RADIUS GSL_CONST_CGSM_NEWTON GSL_CONST_CGSM_DYNE GSL_CONST_CGSM_JOULE GSL_CONST_CGSM_ERG
+ GSL_CONST_CGSM_STEFAN_BOLTZMANN_CONSTANT GSL_CONST_CGSM_THOMSON_CROSS_SECTION GSL_CONST_CGSM_BOHR_MAGNETON
+ GSL_CONST_CGSM_NUCLEAR_MAGNETON GSL_CONST_CGSM_ELECTRON_MAGNETIC_MOMENT GSL_CONST_CGSM_PROTON_MAGNETIC_MOMENT
+ GSL_CONST_CGSM_FARADAY GSL_CONST_CGSM_ELECTRON_CHARGE GSL_CONST_MKS_SPEED_OF_LIGHT GSL_CONST_MKS_GRAVITATIONAL_CONSTANT
+ GSL_CONST_MKS_PLANCKS_CONSTANT_H GSL_CONST_MKS_PLANCKS_CONSTANT_HBAR GSL_CONST_MKS_ASTRONOMICAL_UNIT
+ GSL_CONST_MKS_LIGHT_YEAR GSL_CONST_MKS_PARSEC GSL_CONST_MKS_GRAV_ACCEL GSL_CONST_MKS_ELECTRON_VOLT
+ GSL_CONST_MKS_MASS_ELECTRON GSL_CONST_MKS_MASS_MUON GSL_CONST_MKS_MASS_PROTON GSL_CONST_MKS_MASS_NEUTRON
+ GSL_CONST_MKS_RYDBERG GSL_CONST_MKS_BOLTZMANN GSL_CONST_MKS_MOLAR_GAS GSL_CONST_MKS_STANDARD_GAS_VOLUME
+ GSL_CONST_MKS_MINUTE GSL_CONST_MKS_HOUR GSL_CONST_MKS_DAY GSL_CONST_MKS_WEEK GSL_CONST_MKS_INCH GSL_CONST_MKS_FOOT
+ GSL_CONST_MKS_YARD GSL_CONST_MKS_MILE GSL_CONST_MKS_NAUTICAL_MILE GSL_CONST_MKS_FATHOM GSL_CONST_MKS_MIL
+ GSL_CONST_MKS_POINT GSL_CONST_MKS_TEXPOINT GSL_CONST_MKS_MICRON GSL_CONST_MKS_ANGSTROM GSL_CONST_MKS_HECTARE
+ GSL_CONST_MKS_ACRE GSL_CONST_MKS_BARN GSL_CONST_MKS_LITER GSL_CONST_MKS_US_GALLON GSL_CONST_MKS_QUART
+ GSL_CONST_MKS_PINT GSL_CONST_MKS_CUP GSL_CONST_MKS_FLUID_OUNCE GSL_CONST_MKS_TABLESPOON GSL_CONST_MKS_TEASPOON
+ GSL_CONST_MKS_CANADIAN_GALLON GSL_CONST_MKS_UK_GALLON GSL_CONST_MKS_MILES_PER_HOUR GSL_CONST_MKS_KILOMETERS_PER_HOUR
+ GSL_CONST_MKS_KNOT GSL_CONST_MKS_POUND_MASS GSL_CONST_MKS_OUNCE_MASS GSL_CONST_MKS_TON GSL_CONST_MKS_METRIC_TON
+ GSL_CONST_MKS_UK_TON GSL_CONST_MKS_TROY_OUNCE GSL_CONST_MKS_CARAT GSL_CONST_MKS_UNIFIED_ATOMIC_MASS
+ GSL_CONST_MKS_GRAM_FORCE GSL_CONST_MKS_POUND_FORCE GSL_CONST_MKS_KILOPOUND_FORCE GSL_CONST_MKS_POUNDAL
+ GSL_CONST_MKS_CALORIE GSL_CONST_MKS_BTU GSL_CONST_MKS_THERM GSL_CONST_MKS_HORSEPOWER GSL_CONST_MKS_BAR
+ GSL_CONST_MKS_STD_ATMOSPHERE GSL_CONST_MKS_TORR GSL_CONST_MKS_METER_OF_MERCURY GSL_CONST_MKS_INCH_OF_MERCURY
+ GSL_CONST_MKS_INCH_OF_WATER GSL_CONST_MKS_PSI GSL_CONST_MKS_POISE GSL_CONST_MKS_STOKES GSL_CONST_MKS_STILB
+ GSL_CONST_MKS_LUMEN GSL_CONST_MKS_LUX GSL_CONST_MKS_PHOT GSL_CONST_MKS_FOOTCANDLE GSL_CONST_MKS_LAMBERT GSL_CONST_MKS_FOOTLAMBERT
+ GSL_CONST_MKS_CURIE GSL_CONST_MKS_ROENTGEN GSL_CONST_MKS_RAD GSL_CONST_MKS_SOLAR_MASS GSL_CONST_MKS_BOHR_RADIUS
+ GSL_CONST_MKS_NEWTON GSL_CONST_MKS_DYNE GSL_CONST_MKS_JOULE GSL_CONST_MKS_ERG GSL_CONST_MKS_STEFAN_BOLTZMANN_CONSTANT
+ GSL_CONST_MKS_THOMSON_CROSS_SECTION GSL_CONST_MKS_BOHR_MAGNETON GSL_CONST_MKS_NUCLEAR_MAGNETON
+ GSL_CONST_MKS_ELECTRON_MAGNETIC_MOMENT GSL_CONST_MKS_PROTON_MAGNETIC_MOMENT GSL_CONST_MKS_FARADAY
+ GSL_CONST_MKS_ELECTRON_CHARGE GSL_CONST_MKS_VACUUM_PERMITTIVITY GSL_CONST_MKS_VACUUM_PERMEABILITY GSL_CONST_MKS_DEBYE
+ GSL_CONST_MKS_GAUSS GSL_CONST_MKSA_SPEED_OF_LIGHT GSL_CONST_MKSA_GRAVITATIONAL_CONSTANT GSL_CONST_MKSA_PLANCKS_CONSTANT_H
+ GSL_CONST_MKSA_PLANCKS_CONSTANT_HBAR GSL_CONST_MKSA_ASTRONOMICAL_UNIT GSL_CONST_MKSA_LIGHT_YEAR GSL_CONST_MKSA_PARSEC
+ GSL_CONST_MKSA_GRAV_ACCEL GSL_CONST_MKSA_ELECTRON_VOLT GSL_CONST_MKSA_MASS_ELECTRON GSL_CONST_MKSA_MASS_MUON
+ GSL_CONST_MKSA_MASS_PROTON GSL_CONST_MKSA_MASS_NEUTRON GSL_CONST_MKSA_RYDBERG GSL_CONST_MKSA_BOLTZMANN
+ GSL_CONST_MKSA_MOLAR_GAS GSL_CONST_MKSA_STANDARD_GAS_VOLUME GSL_CONST_MKSA_MINUTE GSL_CONST_MKSA_HOUR
+ GSL_CONST_MKSA_DAY GSL_CONST_MKSA_WEEK GSL_CONST_MKSA_INCH GSL_CONST_MKSA_FOOT GSL_CONST_MKSA_YARD
+ GSL_CONST_MKSA_MILE GSL_CONST_MKSA_NAUTICAL_MILE GSL_CONST_MKSA_FATHOM GSL_CONST_MKSA_MIL GSL_CONST_MKSA_POINT
+ GSL_CONST_MKSA_TEXPOINT GSL_CONST_MKSA_MICRON GSL_CONST_MKSA_ANGSTROM GSL_CONST_MKSA_HECTARE GSL_CONST_MKSA_ACRE
+ GSL_CONST_MKSA_BARN GSL_CONST_MKSA_LITER GSL_CONST_MKSA_US_GALLON GSL_CONST_MKSA_QUART GSL_CONST_MKSA_PINT
+ GSL_CONST_MKSA_CUP GSL_CONST_MKSA_FLUID_OUNCE GSL_CONST_MKSA_TABLESPOON GSL_CONST_MKSA_TEASPOON GSL_CONST_MKSA_CANADIAN_GALLON
+ GSL_CONST_MKSA_UK_GALLON GSL_CONST_MKSA_MILES_PER_HOUR GSL_CONST_MKSA_KILOMETERS_PER_HOUR GSL_CONST_MKSA_KNOT
+ GSL_CONST_MKSA_POUND_MASS GSL_CONST_MKSA_OUNCE_MASS GSL_CONST_MKSA_TON GSL_CONST_MKSA_METRIC_TON GSL_CONST_MKSA_UK_TON
+ GSL_CONST_MKSA_TROY_OUNCE GSL_CONST_MKSA_CARAT GSL_CONST_MKSA_UNIFIED_ATOMIC_MASS GSL_CONST_MKSA_GRAM_FORCE
+ GSL_CONST_MKSA_POUND_FORCE GSL_CONST_MKSA_KILOPOUND_FORCE GSL_CONST_MKSA_POUNDAL GSL_CONST_MKSA_CALORIE GSL_CONST_MKSA_BTU
+ GSL_CONST_MKSA_THERM GSL_CONST_MKSA_HORSEPOWER GSL_CONST_MKSA_BAR GSL_CONST_MKSA_STD_ATMOSPHERE GSL_CONST_MKSA_TORR
+ GSL_CONST_MKSA_METER_OF_MERCURY GSL_CONST_MKSA_INCH_OF_MERCURY GSL_CONST_MKSA_INCH_OF_WATER GSL_CONST_MKSA_PSI
+ GSL_CONST_MKSA_POISE GSL_CONST_MKSA_STOKES GSL_CONST_MKSA_STILB GSL_CONST_MKSA_LUMEN GSL_CONST_MKSA_LUX GSL_CONST_MKSA_PHOT
+ GSL_CONST_MKSA_FOOTCANDLE GSL_CONST_MKSA_LAMBERT GSL_CONST_MKSA_FOOTLAMBERT GSL_CONST_MKSA_CURIE GSL_CONST_MKSA_ROENTGEN
+ GSL_CONST_MKSA_RAD GSL_CONST_MKSA_SOLAR_MASS GSL_CONST_MKSA_BOHR_RADIUS GSL_CONST_MKSA_NEWTON GSL_CONST_MKSA_DYNE
+ GSL_CONST_MKSA_JOULE GSL_CONST_MKSA_ERG GSL_CONST_MKSA_STEFAN_BOLTZMANN_CONSTANT GSL_CONST_MKSA_THOMSON_CROSS_SECTION
+ GSL_CONST_MKSA_BOHR_MAGNETON GSL_CONST_MKSA_NUCLEAR_MAGNETON GSL_CONST_MKSA_ELECTRON_MAGNETIC_MOMENT
+ GSL_CONST_MKSA_PROTON_MAGNETIC_MOMENT GSL_CONST_MKSA_FARADAY GSL_CONST_MKSA_ELECTRON_CHARGE GSL_CONST_MKSA_VACUUM_PERMITTIVITY
+ GSL_CONST_MKSA_VACUUM_PERMEABILITY GSL_CONST_MKSA_DEBYE GSL_CONST_MKSA_GAUSS GSL_CONST_NUM_FINE_STRUCTURE GSL_CONST_NUM_AVOGADRO
+ GSL_CONST_NUM_YOTTA GSL_CONST_NUM_ZETTA GSL_CONST_NUM_EXA GSL_CONST_NUM_PETA GSL_CONST_NUM_TERA GSL_CONST_NUM_GIGA
+ GSL_CONST_NUM_MEGA GSL_CONST_NUM_KILO GSL_CONST_NUM_MILLI GSL_CONST_NUM_MICRO GSL_CONST_NUM_NANO GSL_CONST_NUM_PICO
+ GSL_CONST_NUM_FEMTO GSL_CONST_NUM_ATTO GSL_CONST_NUM_ZEPTO GSL_CONST_NUM_YOCTO
+ GSL_DBL_EPSILON GSL_SQRT_DBL_EPSILON GSL_ROOT3_DBL_EPSILON GSL_ROOT4_DBL_EPSILON GSL_ROOT5_DBL_EPSILON
+ GSL_ROOT6_DBL_EPSILON GSL_LOG_DBL_EPSILON GSL_DBL_MIN GSL_SQRT_DBL_MIN GSL_ROOT3_DBL_MIN GSL_ROOT4_DBL_MIN
+ GSL_ROOT5_DBL_MIN GSL_ROOT6_DBL_MIN GSL_LOG_DBL_MIN GSL_DBL_MAX GSL_SQRT_DBL_MAX GSL_ROOT3_DBL_MAX
+ GSL_ROOT4_DBL_MAX GSL_ROOT5_DBL_MAX GSL_ROOT6_DBL_MAX GSL_LOG_DBL_MAX GSL_FLT_EPSILON GSL_SQRT_FLT_EPSILON
+ GSL_ROOT3_FLT_EPSILON GSL_ROOT4_FLT_EPSILON GSL_ROOT5_FLT_EPSILON GSL_ROOT6_FLT_EPSILON GSL_LOG_FLT_EPSILON
+ GSL_FLT_MIN GSL_SQRT_FLT_MIN GSL_ROOT3_FLT_MIN GSL_ROOT4_FLT_MIN GSL_ROOT5_FLT_MIN GSL_ROOT6_FLT_MIN
+ GSL_LOG_FLT_MIN GSL_FLT_MAX GSL_SQRT_FLT_MAX GSL_ROOT3_FLT_MAX GSL_ROOT4_FLT_MAX GSL_ROOT5_FLT_MAX
+ GSL_ROOT6_FLT_MAX GSL_LOG_FLT_MAX GSL_SFLT_EPSILON GSL_SQRT_SFLT_EPSILON GSL_ROOT3_SFLT_EPSILON GSL_ROOT4_SFLT_EPSILON
+ GSL_ROOT5_SFLT_EPSILON GSL_ROOT6_SFLT_EPSILON GSL_LOG_SFLT_EPSILON GSL_MACH_EPS GSL_SQRT_MACH_EPS GSL_ROOT3_MACH_EPS
+ GSL_ROOT4_MACH_EPS GSL_ROOT5_MACH_EPS GSL_ROOT6_MACH_EPS GSL_LOG_MACH_EPS)))
+
+ (int (GSL_SUCCESS GSL_FAILURE GSL_CONTINUE GSL_EDOM GSL_ERANGE GSL_EFAULT GSL_EINVAL GSL_EFAILED GSL_EFACTOR GSL_ESANITY
+ GSL_ENOMEM GSL_EBADFUNC GSL_ERUNAWAY GSL_EMAXITER GSL_EZERODIV GSL_EBADTOL GSL_ETOL GSL_EUNDRFLW GSL_EOVRFLW
+ GSL_ELOSS GSL_EROUND GSL_EBADLEN GSL_ENOTSQR GSL_ESING GSL_EDIVERGE GSL_EUNSUP GSL_EUNIMPL GSL_ECACHE GSL_ETABLE
+ GSL_ENOPROG GSL_ENOPROGJ GSL_ETOLF GSL_ETOLX GSL_ETOLG GSL_EOF
+ GSL_IEEE_ROUND_TO_NEAREST GSL_IEEE_ROUND_DOWN GSL_IEEE_ROUND_UP GSL_IEEE_ROUND_TO_ZERO GSL_IEEE_MASK_INVALID
+ GSL_IEEE_MASK_DENORMALIZED GSL_IEEE_MASK_DIVISION_BY_ZERO GSL_IEEE_MASK_OVERFLOW GSL_IEEE_MASK_UNDERFLOW
+ GSL_IEEE_MASK_ALL GSL_IEEE_TRAP_INEXACT
+ GSL_INTEG_GAUSS15 GSL_INTEG_GAUSS21 GSL_INTEG_GAUSS31 GSL_INTEG_GAUSS41 GSL_INTEG_GAUSS51 GSL_INTEG_GAUSS61
+ GSL_EIGEN_SORT_VAL_ASC GSL_EIGEN_SORT_VAL_DESC GSL_EIGEN_SORT_ABS_ASC GSL_EIGEN_SORT_ABS_DESC
+ gsl_fft_forward gsl_fft_backward
+ GSL_IEEE_TYPE_NAN GSL_IEEE_TYPE_INF GSL_IEEE_TYPE_NORMAL GSL_IEEE_TYPE_DENORMAL GSL_IEEE_TYPE_ZERO
+ GSL_IEEE_SINGLE_PRECISION GSL_IEEE_DOUBLE_PRECISION GSL_IEEE_EXTENDED_PRECISION GSL_LINALG_MOD_NONE
+ GSL_LINALG_MOD_TRANSPOSE GSL_LINALG_MOD_CONJUGATE
+ GSL_MESSAGE_MASK_A GSL_MESSAGE_MASK_B GSL_MESSAGE_MASK_C GSL_MESSAGE_MASK_D GSL_MESSAGE_MASK_E
+ GSL_MESSAGE_MASK_F GSL_MESSAGE_MASK_G GSL_MESSAGE_MASK_H
+ gsl_wavelet_forward gsl_wavelet_backward))
+
+ (C-macro (int (GSL_PREC_DOUBLE GSL_PREC_SINGLE GSL_PREC_APPROX GSL_SF_MATHIEU_COEFF GSL_SF_FACT_NMAX GSL_SF_DOUBLEFACT_NMAX
+ GSL_MAJOR_VERSION GSL_MINOR_VERSION
+ GSL_MODE_DEFAULT
+ GSL_INTEG_COSINE GSL_INTEG_SINE)))
+
+ (C-macro (double (GSL_SF_GAMMA_XMAX
+ GSL_POSINF GSL_NEGINF GSL_NAN GSL_POSZERO GSL_NEGZERO)))
+
+ (C-macro (char* GSL_VERSION))
+
+ (int (CblasRowMajor CblasColMajor CblasNoTrans CblasTrans CblasConjTrans
+ CblasUpper CblasLower CblasNonUnit CblasUnit CblasLeft CblasRight))
+
+
+ ;; redirect GSL errors to s7_error
+ (in-C "static s7_scheme *gsl_error_s7;
+ static void g_gsl_error(const char *reason, const char *file, int line, int gsl_errno)
+ {
+ s7_error(gsl_error_s7, s7_make_symbol(gsl_error_s7, \"gsl-error\"),
+ s7_list(gsl_error_s7, 5,
+ s7_make_string(gsl_error_s7, \"GSL: ~A, ~A in ~A line ~A\"),
+ s7_make_string(gsl_error_s7, gsl_strerror(gsl_errno)),
+ s7_make_string(gsl_error_s7, reason),
+ s7_make_string(gsl_error_s7, file),
+ s7_make_integer(gsl_error_s7, line)));
+ }")
+ (C-init "gsl_error_s7 = sc;")
+ (C-init "gsl_set_error_handler(g_gsl_error);")
+
+ (C-macro (int (GSL_SF_LEGENDRE_SCHMIDT GSL_SF_LEGENDRE_SPHARM GSL_SF_LEGENDRE_FULL GSL_SF_LEGENDRE_NONE)))
+
+ ;; special functions
+ ;; ((*libgsl* 'gsl_sf_bessel_J0) 1.0) -> 0.7651976865579666
+ ;; (let ((sfr ((*libgsl* 'gsl_sf_result.make)))) ((*libgsl* 'gsl_sf_bessel_J0_e) 1.0 sfr) ((*libgsl* 'gsl_sf_result.val) sfr))
+
+ (int gsl_sf_airy_Ai_e (double int gsl_sf_result*))
+ (double gsl_sf_airy_Ai (double int))
+ (int gsl_sf_airy_Bi_e (double int gsl_sf_result*))
+ (double gsl_sf_airy_Bi (double int))
+ (int gsl_sf_airy_Ai_scaled_e (double int gsl_sf_result*))
+ (double gsl_sf_airy_Ai_scaled (double int))
+ (int gsl_sf_airy_Bi_scaled_e (double int gsl_sf_result*))
+ (double gsl_sf_airy_Bi_scaled (double int))
+ (int gsl_sf_airy_Ai_deriv_e (double int gsl_sf_result*))
+ (double gsl_sf_airy_Ai_deriv (double int))
+ (int gsl_sf_airy_Bi_deriv_e (double int gsl_sf_result*))
+ (double gsl_sf_airy_Bi_deriv (double int))
+ (int gsl_sf_airy_Ai_deriv_scaled_e (double int gsl_sf_result*))
+ (double gsl_sf_airy_Ai_deriv_scaled (double int))
+ (int gsl_sf_airy_Bi_deriv_scaled_e (double int gsl_sf_result*))
+ (double gsl_sf_airy_Bi_deriv_scaled (double int))
+ (int gsl_sf_airy_zero_Ai_e (int gsl_sf_result*))
+ (double gsl_sf_airy_zero_Ai (int))
+ (int gsl_sf_airy_zero_Bi_e (int gsl_sf_result*))
+ (double gsl_sf_airy_zero_Bi (int))
+ (int gsl_sf_airy_zero_Ai_deriv_e (int gsl_sf_result*))
+ (double gsl_sf_airy_zero_Ai_deriv (int))
+ (int gsl_sf_airy_zero_Bi_deriv_e (int gsl_sf_result*))
+ (double gsl_sf_airy_zero_Bi_deriv (int))
+ (int gsl_sf_bessel_J0_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_J0 (double))
+ (int gsl_sf_bessel_J1_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_J1 (double))
+ (int gsl_sf_bessel_Jn_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_Jn (int double))
+ (int gsl_sf_bessel_Jn_array (int int double double*))
+ (int gsl_sf_bessel_Y0_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_Y0 (double))
+ (int gsl_sf_bessel_Y1_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_Y1 (double))
+ (int gsl_sf_bessel_Yn_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_Yn (int double))
+ (int gsl_sf_bessel_Yn_array (int int double double*))
+ (int gsl_sf_bessel_I0_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_I0 (double))
+ (int gsl_sf_bessel_I1_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_I1 (double))
+ (int gsl_sf_bessel_In_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_In (int double))
+ (int gsl_sf_bessel_In_array (int int double double*))
+ (int gsl_sf_bessel_I0_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_I0_scaled (double))
+ (int gsl_sf_bessel_I1_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_I1_scaled (double))
+ (int gsl_sf_bessel_In_scaled_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_In_scaled (int double))
+ (int gsl_sf_bessel_In_scaled_array (int int double double*))
+ (int gsl_sf_bessel_K0_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_K0 (double))
+ (int gsl_sf_bessel_K1_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_K1 (double))
+ (int gsl_sf_bessel_Kn_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_Kn (int double))
+ (int gsl_sf_bessel_Kn_array (int int double double*))
+ (int gsl_sf_bessel_K0_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_K0_scaled (double))
+ (int gsl_sf_bessel_K1_scaled_e (double gsl_sf_result*) )
+ (double gsl_sf_bessel_K1_scaled (double))
+ (int gsl_sf_bessel_Kn_scaled_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_Kn_scaled (int double))
+ (int gsl_sf_bessel_Kn_scaled_array (int int double double*))
+ (int gsl_sf_bessel_j0_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_j0 (double))
+ (int gsl_sf_bessel_j1_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_j1 (double))
+ (int gsl_sf_bessel_j2_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_j2 (double))
+ (int gsl_sf_bessel_jl_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_jl (int double))
+ (int gsl_sf_bessel_jl_array (int double double*))
+ (int gsl_sf_bessel_jl_steed_array (int double double*))
+ (int gsl_sf_bessel_y0_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_y0 (double))
+ (int gsl_sf_bessel_y1_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_y1 (double))
+ (int gsl_sf_bessel_y2_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_y2 (double))
+ (int gsl_sf_bessel_yl_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_yl (int double))
+ (int gsl_sf_bessel_yl_array (int double double*))
+ (int gsl_sf_bessel_i0_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_i0_scaled (double))
+ (int gsl_sf_bessel_i1_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_i1_scaled (double))
+ (int gsl_sf_bessel_i2_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_i2_scaled (double))
+ (int gsl_sf_bessel_il_scaled_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_il_scaled (int double))
+ (int gsl_sf_bessel_il_scaled_array (int double double*))
+ (int gsl_sf_bessel_k0_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_k0_scaled (double))
+ (int gsl_sf_bessel_k1_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_k1_scaled (double))
+ (int gsl_sf_bessel_k2_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_bessel_k2_scaled (double))
+ (int gsl_sf_bessel_kl_scaled_e (int double gsl_sf_result*))
+ (double gsl_sf_bessel_kl_scaled (int double))
+ (int gsl_sf_bessel_kl_scaled_array (int double double*))
+ (int gsl_sf_bessel_Jnu_e (double double gsl_sf_result*))
+ (double gsl_sf_bessel_Jnu (double double))
+ (int gsl_sf_bessel_Ynu_e (double double gsl_sf_result*))
+ (double gsl_sf_bessel_Ynu (double double))
+ (int gsl_sf_bessel_sequence_Jnu_e (double int size_t double*))
+ (int gsl_sf_bessel_Inu_scaled_e (double double gsl_sf_result*))
+ (double gsl_sf_bessel_Inu_scaled (double double))
+ (int gsl_sf_bessel_Inu_e (double double gsl_sf_result*))
+ (double gsl_sf_bessel_Inu (double double))
+ (int gsl_sf_bessel_Knu_scaled_e (double double gsl_sf_result*))
+ (double gsl_sf_bessel_Knu_scaled (double double))
+ (reader-cond ((>= gsl-version 1.15) (int gsl_sf_bessel_Knu_scaled_e10_e (double double gsl_sf_result_e10*))))
+ (int gsl_sf_bessel_Knu_e (double double gsl_sf_result*))
+ (double gsl_sf_bessel_Knu (double double))
+ (int gsl_sf_bessel_lnKnu_e (double double gsl_sf_result*))
+ (double gsl_sf_bessel_lnKnu (double double))
+ (int gsl_sf_bessel_zero_J0_e (int gsl_sf_result*))
+ (double gsl_sf_bessel_zero_J0 (int))
+ (int gsl_sf_bessel_zero_J1_e (int gsl_sf_result*))
+ (double gsl_sf_bessel_zero_J1 (int))
+ (int gsl_sf_bessel_zero_Jnu_e (double int gsl_sf_result*))
+ (double gsl_sf_bessel_zero_Jnu (double int))
+ (int gsl_sf_clausen_e (double gsl_sf_result*))
+ (double gsl_sf_clausen (double))
+ (int gsl_sf_hydrogenicR_1_e (double double gsl_sf_result*))
+ (double gsl_sf_hydrogenicR_1 (double double))
+ (int gsl_sf_hydrogenicR_e (int int double double gsl_sf_result*))
+ (double gsl_sf_hydrogenicR (int int double double))
+ (int gsl_sf_coulomb_wave_FG_e (double double double int gsl_sf_result* gsl_sf_result* gsl_sf_result* gsl_sf_result* double* double*))
+ (int gsl_sf_coulomb_wave_F_array (double int double double double* double*))
+ (int gsl_sf_coulomb_wave_FG_array (double int double double double* double* double* double*))
+ (int gsl_sf_coulomb_wave_FGp_array (double int double double double* double* double* double* double* double*))
+ (int gsl_sf_coulomb_wave_sphF_array (double int double double double* double*))
+ (int gsl_sf_coulomb_CL_e (double double gsl_sf_result*))
+ (int gsl_sf_coulomb_CL_array (double int double double*))
+ (int gsl_sf_coupling_3j_e (int int int int int int gsl_sf_result*))
+ (double gsl_sf_coupling_3j (int int int int int int))
+ (int gsl_sf_coupling_6j_e (int int int int int int gsl_sf_result*))
+ (double gsl_sf_coupling_6j (int int int int int int))
+ (int gsl_sf_coupling_RacahW_e (int int int int int int gsl_sf_result*))
+ (double gsl_sf_coupling_RacahW (int int int int int int))
+ (int gsl_sf_coupling_9j_e (int int int int int int int int int gsl_sf_result*))
+ (double gsl_sf_coupling_9j (int int int int int int int int int))
+ (int gsl_sf_dawson_e (double gsl_sf_result*))
+ (double gsl_sf_dawson (double))
+ (int gsl_sf_debye_1_e (double gsl_sf_result*))
+ (double gsl_sf_debye_1 (double))
+ (int gsl_sf_debye_2_e (double gsl_sf_result*))
+ (double gsl_sf_debye_2 (double))
+ (int gsl_sf_debye_3_e (double gsl_sf_result*))
+ (double gsl_sf_debye_3 (double))
+ (int gsl_sf_debye_4_e (double gsl_sf_result*))
+ (double gsl_sf_debye_4 (double))
+ (int gsl_sf_debye_5_e (double gsl_sf_result*))
+ (double gsl_sf_debye_5 (double))
+ (int gsl_sf_debye_6_e (double gsl_sf_result*))
+ (double gsl_sf_debye_6 (double))
+ (int gsl_sf_dilog_e (double gsl_sf_result*))
+ (double gsl_sf_dilog (double))
+ (int gsl_sf_complex_dilog_xy_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_complex_dilog_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_complex_spence_xy_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_multiply_e (double double gsl_sf_result*))
+ (double gsl_sf_multiply (double double))
+ (int gsl_sf_multiply_err_e (double double double double gsl_sf_result*))
+ (int gsl_sf_ellint_Kcomp_e (double int gsl_sf_result*))
+ (double gsl_sf_ellint_Kcomp (double int))
+ (int gsl_sf_ellint_Ecomp_e (double int gsl_sf_result*))
+ (double gsl_sf_ellint_Ecomp (double int))
+ (int gsl_sf_ellint_Pcomp_e (double double int gsl_sf_result*))
+ (double gsl_sf_ellint_Pcomp (double double int))
+ (int gsl_sf_ellint_Dcomp_e (double int gsl_sf_result*))
+ (double gsl_sf_ellint_Dcomp (double int))
+ (int gsl_sf_ellint_F_e (double double int gsl_sf_result*))
+ (double gsl_sf_ellint_F (double double int))
+ (int gsl_sf_ellint_E_e (double double int gsl_sf_result*))
+ (double gsl_sf_ellint_E (double double int))
+ (int gsl_sf_ellint_P_e (double double double int gsl_sf_result*))
+ (double gsl_sf_ellint_P (double double double int))
+ (reader-cond ((< gsl-version 2.0)
+ (int gsl_sf_ellint_D_e (double double double int gsl_sf_result*))
+ (double gsl_sf_ellint_D (double double double int)))
+ (#t
+ (int gsl_sf_ellint_D_e (double double int gsl_sf_result*))
+ (double gsl_sf_ellint_D (double double int))))
+ (int gsl_sf_ellint_RC_e (double double int gsl_sf_result*))
+ (double gsl_sf_ellint_RC (double double int))
+ (int gsl_sf_ellint_RD_e (double double double int gsl_sf_result*))
+ (double gsl_sf_ellint_RD (double double double int))
+ (int gsl_sf_ellint_RF_e (double double double int gsl_sf_result*))
+ (double gsl_sf_ellint_RF (double double double int))
+ (int gsl_sf_ellint_RJ_e (double double double double int gsl_sf_result*))
+ (double gsl_sf_ellint_RJ (double double double double int))
+ (int gsl_sf_elljac_e (double double double* double* double*)) ; these are double by reference
+ (int gsl_sf_erfc_e (double gsl_sf_result*))
+ (double gsl_sf_erfc (double))
+ (int gsl_sf_log_erfc_e (double gsl_sf_result*))
+ (double gsl_sf_log_erfc (double))
+ (int gsl_sf_erf_e (double gsl_sf_result*))
+ (double gsl_sf_erf (double))
+ (int gsl_sf_erf_Z_e (double gsl_sf_result*))
+ (int gsl_sf_erf_Q_e (double gsl_sf_result*))
+ (double gsl_sf_erf_Z (double))
+ (double gsl_sf_erf_Q (double))
+ (int gsl_sf_hazard_e (double gsl_sf_result*))
+ (double gsl_sf_hazard (double))
+ (int gsl_sf_exp_e (double gsl_sf_result*))
+ (double gsl_sf_exp (double))
+ (int gsl_sf_exp_e10_e (double gsl_sf_result_e10*))
+ (int gsl_sf_exp_mult_e (double double gsl_sf_result*))
+ (double gsl_sf_exp_mult (double double))
+ (int gsl_sf_exp_mult_e10_e (double double gsl_sf_result_e10*))
+ (int gsl_sf_expm1_e (double gsl_sf_result*))
+ (double gsl_sf_expm1 (double))
+ (int gsl_sf_exprel_e (double gsl_sf_result*))
+ (double gsl_sf_exprel (double))
+ (int gsl_sf_exprel_2_e (double gsl_sf_result*))
+ (double gsl_sf_exprel_2 (double))
+ (int gsl_sf_exprel_n_e (int double gsl_sf_result*))
+ (double gsl_sf_exprel_n (int double))
+ (int gsl_sf_exprel_n_CF_e (double double gsl_sf_result*))
+ (int gsl_sf_exp_err_e (double double gsl_sf_result*))
+ (int gsl_sf_exp_err_e10_e (double double gsl_sf_result_e10*))
+ (int gsl_sf_exp_mult_err_e (double double double double gsl_sf_result*))
+ (int gsl_sf_exp_mult_err_e10_e (double double double double gsl_sf_result_e10*))
+ (int gsl_sf_expint_E1_e (double gsl_sf_result*))
+ (double gsl_sf_expint_E1 (double))
+ (int gsl_sf_expint_E2_e (double gsl_sf_result*))
+ (double gsl_sf_expint_E2 (double))
+ (int gsl_sf_expint_En_e (int double gsl_sf_result*))
+ (double gsl_sf_expint_En (int double))
+ (int gsl_sf_expint_E1_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_expint_E1_scaled (double))
+ (int gsl_sf_expint_E2_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_expint_E2_scaled (double))
+ (int gsl_sf_expint_En_scaled_e (int double gsl_sf_result*))
+ (double gsl_sf_expint_En_scaled (int double))
+ (int gsl_sf_expint_Ei_e (double gsl_sf_result*))
+ (double gsl_sf_expint_Ei (double))
+ (int gsl_sf_expint_Ei_scaled_e (double gsl_sf_result*))
+ (double gsl_sf_expint_Ei_scaled (double))
+ (int gsl_sf_Shi_e (double gsl_sf_result*))
+ (double gsl_sf_Shi (double))
+ (int gsl_sf_Chi_e (double gsl_sf_result*))
+ (double gsl_sf_Chi (double))
+ (int gsl_sf_expint_3_e (double gsl_sf_result*))
+ (double gsl_sf_expint_3 (double))
+ (int gsl_sf_Si_e (double gsl_sf_result*))
+ (double gsl_sf_Si (double))
+ (int gsl_sf_Ci_e (double gsl_sf_result*))
+ (double gsl_sf_Ci (double))
+ (int gsl_sf_atanint_e (double gsl_sf_result*))
+ (double gsl_sf_atanint (double))
+ (int gsl_sf_fermi_dirac_m1_e (double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_m1 (double))
+ (int gsl_sf_fermi_dirac_0_e (double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_0 (double))
+ (int gsl_sf_fermi_dirac_1_e (double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_1 (double))
+ (int gsl_sf_fermi_dirac_2_e (double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_2 (double))
+ (int gsl_sf_fermi_dirac_int_e (int double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_int (int double))
+ (int gsl_sf_fermi_dirac_mhalf_e (double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_mhalf (double))
+ (int gsl_sf_fermi_dirac_half_e (double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_half (double))
+ (int gsl_sf_fermi_dirac_3half_e (double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_3half (double))
+ (int gsl_sf_fermi_dirac_inc_0_e (double double gsl_sf_result*))
+ (double gsl_sf_fermi_dirac_inc_0 (double double))
+ (int gsl_sf_lngamma_e (double gsl_sf_result*))
+ (double gsl_sf_lngamma (double))
+ (int gsl_sf_lngamma_sgn_e (double gsl_sf_result* double*))
+ (int gsl_sf_gamma_e (double gsl_sf_result*))
+ (double gsl_sf_gamma (double))
+ (int gsl_sf_gammastar_e (double gsl_sf_result*))
+ (double gsl_sf_gammastar (double))
+ (int gsl_sf_gammainv_e (double gsl_sf_result*))
+ (double gsl_sf_gammainv (double))
+ (int gsl_sf_lngamma_complex_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_taylorcoeff_e (int double gsl_sf_result*))
+ (double gsl_sf_taylorcoeff (int double))
+ (int gsl_sf_fact_e (int gsl_sf_result*))
+ (double gsl_sf_fact (int))
+ (int gsl_sf_doublefact_e (int gsl_sf_result*))
+ (double gsl_sf_doublefact (int))
+ (int gsl_sf_lnfact_e (int gsl_sf_result*))
+ (double gsl_sf_lnfact (int))
+ (int gsl_sf_lndoublefact_e (int gsl_sf_result*))
+ (double gsl_sf_lndoublefact (int))
+ (int gsl_sf_lnchoose_e (int int gsl_sf_result*))
+ (double gsl_sf_lnchoose (int int))
+ (int gsl_sf_choose_e (int int gsl_sf_result*))
+ (double gsl_sf_choose (int int))
+ (int gsl_sf_lnpoch_e (double double gsl_sf_result*))
+ (double gsl_sf_lnpoch (double double))
+ (int gsl_sf_lnpoch_sgn_e (double double gsl_sf_result* double*))
+ (int gsl_sf_poch_e (double double gsl_sf_result*))
+ (double gsl_sf_poch (double double))
+ (int gsl_sf_pochrel_e (double double gsl_sf_result*))
+ (double gsl_sf_pochrel (double double))
+ (int gsl_sf_gamma_inc_Q_e (double double gsl_sf_result*))
+ (double gsl_sf_gamma_inc_Q (double double))
+ (int gsl_sf_gamma_inc_P_e (double double gsl_sf_result*))
+ (double gsl_sf_gamma_inc_P (double double))
+ (int gsl_sf_gamma_inc_e (double double gsl_sf_result*))
+ (double gsl_sf_gamma_inc (double double))
+ (int gsl_sf_lnbeta_e (double double gsl_sf_result*))
+ (double gsl_sf_lnbeta (double double))
+ (int gsl_sf_lnbeta_sgn_e (double double gsl_sf_result* double*))
+ (int gsl_sf_beta_e (double double gsl_sf_result*))
+ (double gsl_sf_beta (double double))
+ (int gsl_sf_beta_inc_e (double double double gsl_sf_result*))
+ (double gsl_sf_beta_inc (double double double))
+ (int gsl_sf_gegenpoly_1_e (double double gsl_sf_result*))
+ (int gsl_sf_gegenpoly_2_e (double double gsl_sf_result*))
+ (int gsl_sf_gegenpoly_3_e (double double gsl_sf_result*))
+ (double gsl_sf_gegenpoly_1 (double double))
+ (double gsl_sf_gegenpoly_2 (double double))
+ (double gsl_sf_gegenpoly_3 (double double))
+ (int gsl_sf_gegenpoly_n_e (int double double gsl_sf_result*))
+ (double gsl_sf_gegenpoly_n (int double double))
+ (int gsl_sf_gegenpoly_array (int double double double*))
+ (int gsl_sf_hyperg_0F1_e (double double gsl_sf_result*))
+ (double gsl_sf_hyperg_0F1 (double double))
+ (int gsl_sf_hyperg_1F1_int_e (int int double gsl_sf_result*))
+ (double gsl_sf_hyperg_1F1_int (int int double))
+ (int gsl_sf_hyperg_1F1_e (double double double gsl_sf_result*))
+ (double gsl_sf_hyperg_1F1 (double double double))
+ (int gsl_sf_hyperg_U_int_e (int int double gsl_sf_result*))
+ (double gsl_sf_hyperg_U_int (int int double))
+ (int gsl_sf_hyperg_U_int_e10_e (int int double gsl_sf_result_e10*))
+ (int gsl_sf_hyperg_U_e (double double double gsl_sf_result*))
+ (double gsl_sf_hyperg_U (double double double))
+ (int gsl_sf_hyperg_U_e10_e (double double double gsl_sf_result_e10*))
+ (int gsl_sf_hyperg_2F1_e (double double double double gsl_sf_result*))
+ (double gsl_sf_hyperg_2F1 (double double double double))
+ (int gsl_sf_hyperg_2F1_conj_e (double double double double gsl_sf_result*))
+ (double gsl_sf_hyperg_2F1_conj (double double double double))
+ (int gsl_sf_hyperg_2F1_renorm_e (double double double double gsl_sf_result*))
+ (double gsl_sf_hyperg_2F1_renorm (double double double double))
+ (int gsl_sf_hyperg_2F1_conj_renorm_e (double double double double gsl_sf_result*))
+ (double gsl_sf_hyperg_2F1_conj_renorm (double double double double))
+ (int gsl_sf_hyperg_2F0_e (double double double gsl_sf_result*))
+ (double gsl_sf_hyperg_2F0 (double double double))
+ (int gsl_sf_laguerre_1_e (double double gsl_sf_result*))
+ (int gsl_sf_laguerre_2_e (double double gsl_sf_result*))
+ (int gsl_sf_laguerre_3_e (double double gsl_sf_result*))
+ (double gsl_sf_laguerre_1 (double double))
+ (double gsl_sf_laguerre_2 (double double))
+ (double gsl_sf_laguerre_3 (double double))
+ (int gsl_sf_laguerre_n_e (int double double gsl_sf_result*))
+ (double gsl_sf_laguerre_n (int double double))
+ (int gsl_sf_lambert_W0_e (double gsl_sf_result*))
+ (double gsl_sf_lambert_W0 (double))
+ (int gsl_sf_lambert_Wm1_e (double gsl_sf_result*))
+ (double gsl_sf_lambert_Wm1 (double))
+ (int gsl_sf_legendre_Pl_e (int double gsl_sf_result*))
+ (double gsl_sf_legendre_Pl (int double))
+ (int gsl_sf_legendre_Pl_array (int double double*))
+ (int gsl_sf_legendre_Pl_deriv_array ( int double double* double*))
+ (int gsl_sf_legendre_P1_e (double gsl_sf_result*))
+ (int gsl_sf_legendre_P2_e (double gsl_sf_result*))
+ (int gsl_sf_legendre_P3_e (double gsl_sf_result*))
+ (double gsl_sf_legendre_P1 (double))
+ (double gsl_sf_legendre_P2 (double))
+ (double gsl_sf_legendre_P3 (double))
+ (int gsl_sf_legendre_Q0_e (double gsl_sf_result*))
+ (double gsl_sf_legendre_Q0 (double))
+ (int gsl_sf_legendre_Q1_e (double gsl_sf_result*))
+ (double gsl_sf_legendre_Q1 (double))
+ (int gsl_sf_legendre_Ql_e (int double gsl_sf_result*))
+ (double gsl_sf_legendre_Ql (int double))
+ (int gsl_sf_legendre_Plm_e (int int double gsl_sf_result*))
+ (double gsl_sf_legendre_Plm (int int double))
+ (int gsl_sf_legendre_sphPlm_e (int int double gsl_sf_result*))
+ (double gsl_sf_legendre_sphPlm (int int double))
+
+ (reader-cond ((< gsl-version 2.0)
+ (int gsl_sf_legendre_array_size (int int))
+ (int gsl_sf_legendre_Plm_array (int int double double*))
+ (int gsl_sf_legendre_Plm_deriv_array (int int double double* double*))
+ (int gsl_sf_legendre_sphPlm_array (int int double double*))
+ (int gsl_sf_legendre_sphPlm_deriv_array (int int double double* double*)))
+ (#t
+ (int gsl_sf_legendre_array (int size_t double double*))
+ (int gsl_sf_legendre_array_e (int size_t double double double*))
+ (int gsl_sf_legendre_deriv_array (int size_t double double* double*))
+ (int gsl_sf_legendre_deriv_array_e (int size_t double double double* double*))
+ (int gsl_sf_legendre_deriv_alt_array (int size_t double double* double*))
+ (int gsl_sf_legendre_deriv_alt_array_e (int size_t double double double* double*))
+ (int gsl_sf_legendre_deriv2_array (int size_t double double* double* double*))
+ (int gsl_sf_legendre_deriv2_array_e (int size_t double double double* double* double*))
+ (int gsl_sf_legendre_deriv2_alt_array (int size_t double double* double* double*))
+ (int gsl_sf_legendre_deriv2_alt_array_e (int size_t double double double* double* double*))
+ (size_t gsl_sf_legendre_array_n (size_t))
+ (size_t gsl_sf_legendre_array_index (size_t size_t))
+ (size_t gsl_sf_legendre_nlm (size_t))))
+
+ (int gsl_sf_conicalP_half_e (double double gsl_sf_result*))
+ (double gsl_sf_conicalP_half (double double))
+ (int gsl_sf_conicalP_mhalf_e (double double gsl_sf_result*))
+ (double gsl_sf_conicalP_mhalf (double double))
+ (int gsl_sf_conicalP_0_e (double double gsl_sf_result*))
+ (double gsl_sf_conicalP_0 (double double))
+ (int gsl_sf_conicalP_1_e (double double gsl_sf_result*))
+ (double gsl_sf_conicalP_1 (double double))
+ (int gsl_sf_conicalP_sph_reg_e (int double double gsl_sf_result*))
+ (double gsl_sf_conicalP_sph_reg (int double double))
+ (int gsl_sf_conicalP_cyl_reg_e (int double double gsl_sf_result*))
+ (double gsl_sf_conicalP_cyl_reg (int double double))
+ (int gsl_sf_legendre_H3d_0_e (double double gsl_sf_result*))
+ (double gsl_sf_legendre_H3d_0 (double double))
+ (int gsl_sf_legendre_H3d_1_e (double double gsl_sf_result*))
+ (double gsl_sf_legendre_H3d_1 (double double))
+ (int gsl_sf_legendre_H3d_e (int double double gsl_sf_result*))
+ (double gsl_sf_legendre_H3d (int double double))
+ (int gsl_sf_legendre_H3d_array (int double double double*))
+ (int gsl_sf_log_e (double gsl_sf_result*))
+ (double gsl_sf_log (double))
+ (int gsl_sf_log_abs_e (double gsl_sf_result*))
+ (double gsl_sf_log_abs (double))
+ (int gsl_sf_complex_log_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_log_1plusx_e (double gsl_sf_result*))
+ (double gsl_sf_log_1plusx (double))
+ (int gsl_sf_log_1plusx_mx_e (double gsl_sf_result*))
+ (double gsl_sf_log_1plusx_mx (double))
+ (int gsl_sf_mathieu_a_array (int int double gsl_sf_mathieu_workspace* double*))
+ (int gsl_sf_mathieu_b_array (int int double gsl_sf_mathieu_workspace* double*))
+ (int gsl_sf_mathieu_a_coeff (int double double double*))
+ (int gsl_sf_mathieu_b_coeff (int double double double*))
+ (gsl_sf_mathieu_workspace* gsl_sf_mathieu_alloc (size_t double))
+ (void gsl_sf_mathieu_free (gsl_sf_mathieu_workspace*))
+ (int gsl_sf_mathieu_ce_array (int int double double gsl_sf_mathieu_workspace* double*))
+ (int gsl_sf_mathieu_se_array (int int double double gsl_sf_mathieu_workspace* double*))
+ (reader-cond ((< gsl-version 2.0)
+ (int gsl_sf_mathieu_Mc (int int double double gsl_sf_result*))
+ (int gsl_sf_mathieu_Ms (int int double double gsl_sf_result*))
+ (int gsl_sf_mathieu_ce (int double double gsl_sf_result*))
+ (int gsl_sf_mathieu_se (int double double gsl_sf_result*))
+ (int gsl_sf_mathieu_a (int double gsl_sf_result*))
+ (int gsl_sf_mathieu_b (int double gsl_sf_result*)))
+ (#t
+ (int gsl_sf_mathieu_Mc_e (int int double double gsl_sf_result*))
+ (double gsl_sf_mathieu_Mc (int int double double))
+ (int gsl_sf_mathieu_Ms_e (int int double double gsl_sf_result*))
+ (double gsl_sf_mathieu_Ms (int int double double))
+ (int gsl_sf_mathieu_a_e (int double gsl_sf_result*))
+ (double gsl_sf_mathieu_a (int double))
+ (int gsl_sf_mathieu_b_e (int double gsl_sf_result*))
+ (double gsl_sf_mathieu_b (int double))
+ (int gsl_sf_mathieu_ce_e (int double double gsl_sf_result*))
+ (double gsl_sf_mathieu_ce (int double double))
+ (int gsl_sf_mathieu_se_e (int double double gsl_sf_result*))
+ (double gsl_sf_mathieu_se (int double double))))
+ (int gsl_sf_mathieu_Mc_array (int int int double double gsl_sf_mathieu_workspace* double*))
+ (int gsl_sf_mathieu_Ms_array (int int int double double gsl_sf_mathieu_workspace* double*))
+ (int gsl_sf_pow_int_e (double int gsl_sf_result*))
+ (double gsl_sf_pow_int (double int))
+ (int gsl_sf_psi_int_e (int gsl_sf_result*))
+ (double gsl_sf_psi_int (int))
+ (int gsl_sf_psi_e (double gsl_sf_result*))
+ (double gsl_sf_psi (double))
+ (int gsl_sf_psi_1piy_e (double gsl_sf_result*))
+ (double gsl_sf_psi_1piy (double))
+ (int gsl_sf_complex_psi_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_psi_1_int_e (int gsl_sf_result*))
+ (double gsl_sf_psi_1_int (int))
+ (int gsl_sf_psi_1_e (double gsl_sf_result*))
+ (double gsl_sf_psi_1 (double))
+ (int gsl_sf_psi_n_e (int double gsl_sf_result*))
+ (double gsl_sf_psi_n (int double))
+ (int gsl_sf_result_smash_e (gsl_sf_result_e10* gsl_sf_result*))
+ (int gsl_sf_synchrotron_1_e (double gsl_sf_result*))
+ (double gsl_sf_synchrotron_1 (double))
+ (int gsl_sf_synchrotron_2_e (double gsl_sf_result*))
+ (double gsl_sf_synchrotron_2 (double))
+ (int gsl_sf_transport_2_e (double gsl_sf_result*))
+ (double gsl_sf_transport_2 (double))
+ (int gsl_sf_transport_3_e (double gsl_sf_result*))
+ (double gsl_sf_transport_3 (double))
+ (int gsl_sf_transport_4_e (double gsl_sf_result*))
+ (double gsl_sf_transport_4 (double))
+ (int gsl_sf_transport_5_e (double gsl_sf_result*))
+ (double gsl_sf_transport_5 (double))
+ (int gsl_sf_sin_e (double gsl_sf_result*))
+ (double gsl_sf_sin (double))
+ (int gsl_sf_cos_e (double gsl_sf_result*))
+ (double gsl_sf_cos (double))
+ (int gsl_sf_hypot_e (double double gsl_sf_result*))
+ (double gsl_sf_hypot (double double))
+ (int gsl_sf_complex_sin_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_complex_cos_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_complex_logsin_e (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_sinc_e (double gsl_sf_result*))
+ (double gsl_sf_sinc (double))
+ (int gsl_sf_lnsinh_e (double gsl_sf_result*))
+ (double gsl_sf_lnsinh (double))
+ (int gsl_sf_lncosh_e (double gsl_sf_result*))
+ (double gsl_sf_lncosh (double))
+ (int gsl_sf_polar_to_rect (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_rect_to_polar (double double gsl_sf_result* gsl_sf_result*))
+ (int gsl_sf_sin_err_e (double double gsl_sf_result*))
+ (int gsl_sf_cos_err_e (double double gsl_sf_result*))
+ (int gsl_sf_angle_restrict_symm_e (double*))
+ (double gsl_sf_angle_restrict_symm (double))
+ (int gsl_sf_angle_restrict_pos_e (double*))
+ (double gsl_sf_angle_restrict_pos (double))
+ (int gsl_sf_angle_restrict_symm_err_e (double gsl_sf_result*))
+ (int gsl_sf_angle_restrict_pos_err_e (double gsl_sf_result*))
+ (int gsl_sf_zeta_int_e (int gsl_sf_result*))
+ (double gsl_sf_zeta_int (int))
+ (int gsl_sf_zeta_e (double gsl_sf_result*))
+ (double gsl_sf_zeta (double))
+ (int gsl_sf_zetam1_e (double gsl_sf_result*))
+ (double gsl_sf_zetam1 (double))
+ (int gsl_sf_zetam1_int_e (int gsl_sf_result*))
+ (double gsl_sf_zetam1_int (int))
+ (int gsl_sf_hzeta_e (double double gsl_sf_result*))
+ (double gsl_sf_hzeta (double double))
+ (int gsl_sf_eta_int_e (int gsl_sf_result*))
+ (double gsl_sf_eta_int (int))
+ (int gsl_sf_eta_e (double gsl_sf_result*))
+ (double gsl_sf_eta (double))
+
+ (in-C "static s7_pointer g_gsl_sf_result_make(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(gsl_sf_result))));
+ }
+ static s7_pointer g_gsl_sf_result_val(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_real(sc, ((gsl_sf_result *)s7_c_pointer(s7_car(args)))->val));
+ }
+ static s7_pointer g_gsl_sf_result_err(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_real(sc, ((gsl_sf_result *)s7_c_pointer(s7_car(args)))->err));
+ }
+ static s7_pointer g_gsl_sf_result_e10_make(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(gsl_sf_result_e10))));
+ }
+ static s7_pointer g_to_doubles(s7_scheme *sc, s7_pointer args)
+ {
+ if (s7_is_vector(s7_car(args)))
+ return(s7_make_c_pointer(sc, (void *)s7_float_vector_elements(s7_car(args))));
+ return(s7_car(args));
+ }
+ ")
+
+ (C-function ("gsl_sf_result.make" g_gsl_sf_result_make "" 0))
+ (C-function ("gsl_sf_result_e10.make" g_gsl_sf_result_e10_make "" 0))
+ (C-function ("gsl_sf_result.val" g_gsl_sf_result_val "" 1))
+ (C-function ("gsl_sf_result.err" g_gsl_sf_result_err "" 1))
+ (C-function ("double*" g_to_doubles "" 1))
+
+ (double gsl_log1p (double))
+ (double gsl_expm1 (double))
+ (double gsl_hypot (double double))
+ (double gsl_hypot3 (double double double))
+ (double gsl_acosh (double))
+ (double gsl_asinh (double))
+ (double gsl_atanh (double))
+ (int gsl_isnan (double))
+ (int gsl_isinf (double))
+ (int gsl_finite (double))
+ (double gsl_nan (void))
+ (double gsl_posinf (void))
+ (double gsl_neginf (void))
+ (double gsl_fdiv (double double))
+ (double gsl_coerce_double (double))
+ (double gsl_ldexp (double int))
+
+ (in-C "static s7_pointer g_gsl_frexp(s7_scheme *sc, s7_pointer args)
+ {
+ int e = 0;
+ double res;
+ res = gsl_frexp(s7_real(s7_car(args)), &e);
+ return(s7_list(sc, 2, s7_make_real(sc, res), s7_make_integer(sc, e)));
+ }
+ ")
+ (C-function ("gsl_frexp" g_gsl_frexp "" 1))
+
+ (int gsl_fcmp (double double double))
+ (double gsl_pow_2 (double))
+ (double gsl_pow_3 (double))
+ (double gsl_pow_4 (double))
+ (double gsl_pow_5 (double))
+ (double gsl_pow_6 (double))
+ (double gsl_pow_7 (double))
+ (double gsl_pow_8 (double))
+ (double gsl_pow_9 (double))
+ (double gsl_pow_int (double int))
+
+ ;; gsl_cdf
+ (double gsl_cdf_ugaussian_P (double))
+ (double gsl_cdf_ugaussian_Q (double))
+ (double gsl_cdf_ugaussian_Pinv (double))
+ (double gsl_cdf_ugaussian_Qinv (double))
+ (double gsl_cdf_gaussian_P (double double))
+ (double gsl_cdf_gaussian_Q (double double))
+ (double gsl_cdf_gaussian_Pinv (double double))
+ (double gsl_cdf_gaussian_Qinv (double double))
+ (double gsl_cdf_gamma_P (double double double))
+ (double gsl_cdf_gamma_Q (double double double))
+ (double gsl_cdf_gamma_Pinv (double double double))
+ (double gsl_cdf_gamma_Qinv (double double double))
+ (double gsl_cdf_cauchy_P (double double))
+ (double gsl_cdf_cauchy_Q (double double))
+ (double gsl_cdf_cauchy_Pinv (double double))
+ (double gsl_cdf_cauchy_Qinv (double double))
+ (double gsl_cdf_laplace_P (double double))
+ (double gsl_cdf_laplace_Q (double double))
+ (double gsl_cdf_laplace_Pinv (double double))
+ (double gsl_cdf_laplace_Qinv (double double))
+ (double gsl_cdf_rayleigh_P (double double))
+ (double gsl_cdf_rayleigh_Q (double double))
+ (double gsl_cdf_rayleigh_Pinv (double double))
+ (double gsl_cdf_rayleigh_Qinv (double double))
+ (double gsl_cdf_chisq_P (double double))
+ (double gsl_cdf_chisq_Q (double double))
+ (double gsl_cdf_chisq_Pinv (double double))
+ (double gsl_cdf_chisq_Qinv (double double))
+ (double gsl_cdf_exponential_P (double double))
+ (double gsl_cdf_exponential_Q (double double))
+ (double gsl_cdf_exponential_Pinv (double double))
+ (double gsl_cdf_exponential_Qinv (double double))
+ (double gsl_cdf_exppow_P (double double double))
+ (double gsl_cdf_exppow_Q (double double double))
+ (double gsl_cdf_tdist_P (double double))
+ (double gsl_cdf_tdist_Q (double double))
+ (double gsl_cdf_tdist_Pinv (double double))
+ (double gsl_cdf_tdist_Qinv (double double))
+ (double gsl_cdf_fdist_P (double double double))
+ (double gsl_cdf_fdist_Q (double double double))
+ (double gsl_cdf_fdist_Pinv (double double double))
+ (double gsl_cdf_fdist_Qinv (double double double))
+ (double gsl_cdf_beta_P (double double double))
+ (double gsl_cdf_beta_Q (double double double))
+ (double gsl_cdf_beta_Pinv (double double double))
+ (double gsl_cdf_beta_Qinv (double double double))
+ (double gsl_cdf_flat_P (double double double))
+ (double gsl_cdf_flat_Q (double double double))
+ (double gsl_cdf_flat_Pinv (double double double))
+ (double gsl_cdf_flat_Qinv (double double double))
+ (double gsl_cdf_lognormal_P (double double double))
+ (double gsl_cdf_lognormal_Q (double double double))
+ (double gsl_cdf_lognormal_Pinv (double double double))
+ (double gsl_cdf_lognormal_Qinv (double double double))
+ (double gsl_cdf_gumbel1_P (double double double))
+ (double gsl_cdf_gumbel1_Q (double double double))
+ (double gsl_cdf_gumbel1_Pinv (double double double))
+ (double gsl_cdf_gumbel1_Qinv (double double double))
+ (double gsl_cdf_gumbel2_P (double double double))
+ (double gsl_cdf_gumbel2_Q (double double double))
+ (double gsl_cdf_gumbel2_Pinv (double double double))
+ (double gsl_cdf_gumbel2_Qinv (double double double))
+ (double gsl_cdf_weibull_P (double double double))
+ (double gsl_cdf_weibull_Q (double double double))
+ (double gsl_cdf_weibull_Pinv (double double double))
+ (double gsl_cdf_weibull_Qinv (double double double))
+ (double gsl_cdf_pareto_P (double double double))
+ (double gsl_cdf_pareto_Q (double double double))
+ (double gsl_cdf_pareto_Pinv (double double double))
+ (double gsl_cdf_pareto_Qinv (double double double))
+ (double gsl_cdf_logistic_P (double double))
+ (double gsl_cdf_logistic_Q (double double))
+ (double gsl_cdf_logistic_Pinv (double double))
+ (double gsl_cdf_logistic_Qinv (double double))
+ (double gsl_cdf_binomial_P (int double int))
+ (double gsl_cdf_binomial_Q (int double int))
+ (double gsl_cdf_poisson_P (int double))
+ (double gsl_cdf_poisson_Q (int double))
+ (double gsl_cdf_geometric_P (int double))
+ (double gsl_cdf_geometric_Q (int double))
+ (double gsl_cdf_negative_binomial_P (int double double))
+ (double gsl_cdf_negative_binomial_Q (int double double))
+ (double gsl_cdf_pascal_P (int double int))
+ (double gsl_cdf_pascal_Q (int double int))
+ (double gsl_cdf_hypergeometric_P (int int int int))
+ (double gsl_cdf_hypergeometric_Q (int int int int))
+
+
+ ;; gsl_dht
+ (gsl_dht* gsl_dht_alloc (size_t))
+ (gsl_dht* gsl_dht_new (size_t double double))
+ (int gsl_dht_init (gsl_dht* double double))
+ (double gsl_dht_x_sample (gsl_dht* int))
+ (double gsl_dht_k_sample (gsl_dht* int))
+ (void gsl_dht_free (gsl_dht*))
+ (int gsl_dht_apply (gsl_dht* double* double*))
+
+
+ ;; gsl_statistics
+ (double gsl_stats_mean (double* size_t size_t))
+ (double gsl_stats_variance (double* size_t size_t))
+ (double gsl_stats_sd (double* size_t size_t))
+ (double gsl_stats_variance_with_fixed_mean (double* size_t size_t double))
+ (double gsl_stats_sd_with_fixed_mean (double* size_t size_t double))
+ (double gsl_stats_tss (double* size_t size_t))
+ (double gsl_stats_tss_m (double* size_t size_t double))
+ (double gsl_stats_absdev (double* size_t size_t))
+ (double gsl_stats_skew (double* size_t size_t))
+ (double gsl_stats_kurtosis (double* size_t size_t))
+ (double gsl_stats_lag1_autocorrelation (double* size_t size_t))
+ (double gsl_stats_covariance (double* size_t double* size_t size_t))
+ (double gsl_stats_correlation (double* size_t double* size_t size_t))
+ (reader-cond ((>= gsl-version 1.16) (double gsl_stats_spearman (double* size_t double* size_t size_t double*))))
+ (double gsl_stats_variance_m (double* size_t size_t double))
+ (double gsl_stats_sd_m (double* size_t size_t double))
+ (double gsl_stats_absdev_m (double* size_t size_t double))
+ (double gsl_stats_skew_m_sd (double* size_t size_t double double))
+ (double gsl_stats_kurtosis_m_sd (double* size_t size_t double double))
+ (double gsl_stats_lag1_autocorrelation_m (double* size_t size_t double))
+ (double gsl_stats_covariance_m (double* size_t double* size_t size_t double double))
+ (double gsl_stats_wmean (double* size_t double* size_t size_t))
+ (double gsl_stats_wvariance (double* size_t double* size_t size_t))
+ (double gsl_stats_wsd (double* size_t double* size_t size_t))
+ (double gsl_stats_wvariance_with_fixed_mean (double* size_t double* size_t size_t double))
+ (double gsl_stats_wsd_with_fixed_mean (double* size_t double* size_t size_t double))
+ (double gsl_stats_wtss (double* size_t double* size_t size_t))
+ (double gsl_stats_wtss_m (double* size_t double* size_t size_t double))
+ (double gsl_stats_wabsdev (double* size_t double* size_t size_t))
+ (double gsl_stats_wskew (double* size_t double* size_t size_t))
+ (double gsl_stats_wkurtosis (double* size_t double* size_t size_t))
+ (double gsl_stats_wvariance_m (double* size_t double* size_t size_t double))
+ (double gsl_stats_wsd_m (double* size_t double* size_t size_t double))
+ (double gsl_stats_wabsdev_m (double* size_t double* size_t size_t double))
+ (double gsl_stats_wskew_m_sd (double* size_t double* size_t size_t double double))
+ (double gsl_stats_wkurtosis_m_sd (double* size_t double* size_t size_t double double))
+ (double gsl_stats_pvariance (double* size_t size_t double* size_t size_t))
+ (double gsl_stats_ttest (double* size_t size_t double* size_t size_t))
+ (double gsl_stats_max (double* size_t size_t))
+ (double gsl_stats_min (double* size_t size_t))
+ (void gsl_stats_minmax (double* double* double* size_t size_t))
+ (size_t gsl_stats_max_index (double* size_t size_t))
+ (size_t gsl_stats_min_index (double* size_t size_t))
+ (void gsl_stats_minmax_index (size_t* size_t* double* size_t size_t))
+ (double gsl_stats_median_from_sorted_data (double* size_t size_t))
+ (double gsl_stats_quantile_from_sorted_data (double* size_t size_t double))
+
+ (c-pointer (gsl_interp_linear gsl_interp_polynomial gsl_interp_cspline gsl_interp_cspline_periodic gsl_interp_akima
+ gsl_interp_akima_periodic gsl_min_fminimizer_goldensection gsl_min_fminimizer_brent gsl_min_fminimizer_quad_golden
+ gsl_multimin_fminimizer_nmsimplex gsl_multimin_fminimizer_nmsimplex2 gsl_multimin_fminimizer_nmsimplex2rand
+ gsl_multiroot_fsolver_dnewton gsl_multiroot_fsolver_broyden gsl_multiroot_fsolver_hybrid gsl_multiroot_fsolver_hybrids
+ gsl_prec_eps gsl_prec_sqrt_eps
+ gsl_prec_root3_eps gsl_prec_root4_eps gsl_prec_root5_eps gsl_prec_root6_eps gsl_root_fsolver_bisection gsl_root_fsolver_brent
+ gsl_root_fsolver_falsepos gsl_version
+ gsl_wavelet_daubechies gsl_wavelet_daubechies_centered gsl_wavelet_haar gsl_wavelet_haar_centered gsl_wavelet_bspline
+ gsl_wavelet_bspline_centered))
+
+ (reader-cond ((>= gsl-version 1.16)
+ (c-pointer (gsl_multifit_robust_default gsl_multifit_robust_bisquare gsl_multifit_robust_cauchy gsl_multifit_robust_fair
+ gsl_multifit_robust_huber gsl_multifit_robust_ols gsl_multifit_robust_welsch))))
+
+ (reader-cond ((>= gsl-version 2.0)
+ (c-pointer gsl_interp_steffen)))
+
+ (int (gsl_message_mask gsl_check_range))
+
+ ;; randist, rng
+ (c-pointer (gsl_qrng_niederreiter_2 gsl_qrng_sobol gsl_qrng_halton gsl_qrng_reversehalton
+ gsl_rng_borosh13 gsl_rng_coveyou gsl_rng_cmrg gsl_rng_fishman18 gsl_rng_fishman20 gsl_rng_fishman2x gsl_rng_gfsr4
+ gsl_rng_knuthran gsl_rng_knuthran2 gsl_rng_knuthran2002 gsl_rng_lecuyer21 gsl_rng_minstd gsl_rng_mrg gsl_rng_mt19937
+ gsl_rng_mt19937_1999 gsl_rng_mt19937_1998 gsl_rng_r250 gsl_rng_ran0 gsl_rng_ran1 gsl_rng_ran2 gsl_rng_ran3 gsl_rng_rand
+ gsl_rng_rand48 gsl_rng_random128_bsd gsl_rng_random128_glibc2 gsl_rng_random128_libc5 gsl_rng_random256_bsd
+ gsl_rng_random256_glibc2 gsl_rng_random256_libc5 gsl_rng_random32_bsd gsl_rng_random32_glibc2 gsl_rng_random32_libc5
+ gsl_rng_random64_bsd gsl_rng_random64_glibc2 gsl_rng_random64_libc5 gsl_rng_random8_bsd gsl_rng_random8_glibc2
+ gsl_rng_random8_libc5 gsl_rng_random_bsd gsl_rng_random_glibc2 gsl_rng_random_libc5 gsl_rng_randu
+ gsl_rng_ranf gsl_rng_ranlux gsl_rng_ranlux389 gsl_rng_ranlxd1 gsl_rng_ranlxd2 gsl_rng_ranlxs0 gsl_rng_ranlxs1
+ gsl_rng_ranlxs2 gsl_rng_ranmar gsl_rng_slatec gsl_rng_taus gsl_rng_taus2 gsl_rng_taus113 gsl_rng_transputer
+ gsl_rng_tt800 gsl_rng_uni gsl_rng_uni32 gsl_rng_vax gsl_rng_waterman14 gsl_rng_zuf gsl_rng_default gsl_rng_default_seed))
+
+ (gsl_qrng* gsl_qrng_alloc (gsl_qrng_type* int))
+ (int gsl_qrng_memcpy (gsl_qrng* gsl_qrng*))
+ (gsl_qrng* gsl_qrng_clone (gsl_qrng*))
+ (void gsl_qrng_free (gsl_qrng*))
+ (void gsl_qrng_init (gsl_qrng*))
+ (char* gsl_qrng_name (gsl_qrng*))
+ (size_t gsl_qrng_size (gsl_qrng*))
+ (void* gsl_qrng_state (gsl_qrng*))
+ (int gsl_qrng_get (gsl_qrng* double*))
+ (int gsl_ran_bernoulli (gsl_rng* double))
+ (double gsl_ran_bernoulli_pdf (int double))
+ (double gsl_ran_beta (gsl_rng* double double))
+ (double gsl_ran_beta_pdf (double double double))
+ (int gsl_ran_binomial (gsl_rng* double int))
+ (int gsl_ran_binomial_knuth (gsl_rng* double int))
+ (int gsl_ran_binomial_tpe (gsl_rng* double int))
+ (double gsl_ran_binomial_pdf (int double int))
+ (double gsl_ran_exponential (gsl_rng* double))
+ (double gsl_ran_exponential_pdf (double double))
+ (double gsl_ran_exppow (gsl_rng* double double))
+ (double gsl_ran_exppow_pdf (double double double))
+ (double gsl_ran_cauchy (gsl_rng* double))
+ (double gsl_ran_cauchy_pdf (double double))
+ (double gsl_ran_chisq (gsl_rng* double))
+ (double gsl_ran_chisq_pdf (double double))
+ (void gsl_ran_dirichlet (gsl_rng* size_t double* double*))
+ (double gsl_ran_dirichlet_pdf (size_t double* double*))
+ (double gsl_ran_dirichlet_lnpdf (size_t double* double*))
+ (double gsl_ran_erlang (gsl_rng* double double))
+ (double gsl_ran_erlang_pdf (double double double))
+ (double gsl_ran_fdist (gsl_rng* double double))
+ (double gsl_ran_fdist_pdf (double double double))
+ (double gsl_ran_flat (gsl_rng* double double))
+ (double gsl_ran_flat_pdf (double double double))
+ (double gsl_ran_gamma (gsl_rng* double double))
+ (double gsl_ran_gamma_int (gsl_rng* int))
+ (double gsl_ran_gamma_pdf (double double double))
+ (double gsl_ran_gamma_mt (gsl_rng* double double))
+ (double gsl_ran_gamma_knuth (gsl_rng* double double))
+ (double gsl_ran_gaussian (gsl_rng* double))
+ (double gsl_ran_gaussian_ratio_method (gsl_rng* double))
+ (double gsl_ran_gaussian_ziggurat (gsl_rng* double))
+ (double gsl_ran_gaussian_pdf (double double))
+ (double gsl_ran_ugaussian (gsl_rng*))
+ (double gsl_ran_ugaussian_ratio_method (gsl_rng*))
+ (double gsl_ran_ugaussian_pdf (double))
+ (double gsl_ran_gaussian_tail (gsl_rng* double double))
+ (double gsl_ran_gaussian_tail_pdf (double double double))
+ (double gsl_ran_ugaussian_tail (gsl_rng* double))
+ (double gsl_ran_ugaussian_tail_pdf (double double))
+ (void gsl_ran_bivariate_gaussian (gsl_rng* double double double double* double*))
+ (double gsl_ran_bivariate_gaussian_pdf (double double double double double))
+ (double gsl_ran_landau (gsl_rng*))
+ (double gsl_ran_landau_pdf (double))
+ (int gsl_ran_geometric (gsl_rng* double))
+ (double gsl_ran_geometric_pdf (int double))
+ (int gsl_ran_hypergeometric (gsl_rng* int int int))
+ (double gsl_ran_hypergeometric_pdf (int int int int))
+ (double gsl_ran_gumbel1 (gsl_rng* double double))
+ (double gsl_ran_gumbel1_pdf (double double double))
+ (double gsl_ran_gumbel2 (gsl_rng* double double))
+ (double gsl_ran_gumbel2_pdf (double double double))
+ (double gsl_ran_logistic (gsl_rng* double))
+ (double gsl_ran_logistic_pdf (double double))
+ (double gsl_ran_lognormal (gsl_rng* double double))
+ (double gsl_ran_lognormal_pdf (double double double))
+ (int gsl_ran_logarithmic (gsl_rng* double))
+ (double gsl_ran_logarithmic_pdf (int double))
+ ;; int* (void gsl_ran_multinomial (gsl_rng* size_t int double* int*)) ; unsigned int*
+ ;; int* (double gsl_ran_multinomial_pdf (size_t double* int*)) ; unsigned int*
+ ;; int* (double gsl_ran_multinomial_lnpdf (size_t double* int*)) ; unsigned int*
+ (int gsl_ran_negative_binomial (gsl_rng* double double))
+ (double gsl_ran_negative_binomial_pdf (int double double))
+ (int gsl_ran_pascal (gsl_rng* double int))
+ (double gsl_ran_pascal_pdf (int double int))
+ (double gsl_ran_pareto (gsl_rng* double double))
+ (double gsl_ran_pareto_pdf (double double double))
+ (int gsl_ran_poisson (gsl_rng* double))
+ ;; int* (void gsl_ran_poisson_array (gsl_rng* size_t int* double)) ; unsigned int*
+ (double gsl_ran_poisson_pdf (int double))
+ (double gsl_ran_rayleigh (gsl_rng* double))
+ (double gsl_ran_rayleigh_pdf (double double))
+ (double gsl_ran_rayleigh_tail (gsl_rng* double double))
+ (double gsl_ran_rayleigh_tail_pdf (double double double))
+ (double gsl_ran_tdist (gsl_rng* double))
+ (double gsl_ran_tdist_pdf (double double))
+ (double gsl_ran_laplace (gsl_rng* double))
+ (double gsl_ran_laplace_pdf (double double))
+ (double gsl_ran_levy (gsl_rng* double double))
+ (double gsl_ran_levy_skew (gsl_rng* double double double))
+ (double gsl_ran_weibull (gsl_rng* double double))
+ (double gsl_ran_weibull_pdf (double double double))
+ (void gsl_ran_dir_2d (gsl_rng* double* double*))
+ (void gsl_ran_dir_2d_trig_method (gsl_rng* double* double*))
+ (void gsl_ran_dir_3d (gsl_rng* double* double* double*))
+ (void gsl_ran_dir_nd (gsl_rng* size_t double*))
+ (void gsl_ran_shuffle (gsl_rng* void* size_t size_t))
+ (int gsl_ran_choose (gsl_rng* void* size_t void* size_t size_t))
+ (void gsl_ran_sample (gsl_rng* void* size_t void* size_t size_t))
+ (gsl_ran_discrete_t* gsl_ran_discrete_preproc (size_t double*))
+ (void gsl_ran_discrete_free (gsl_ran_discrete_t*))
+ (size_t gsl_ran_discrete (gsl_rng* gsl_ran_discrete_t*))
+ (double gsl_ran_discrete_pdf (size_t gsl_ran_discrete_t*))
+ (gsl_rng_type** gsl_rng_types_setup (void))
+ (gsl_rng* gsl_rng_alloc (gsl_rng_type*))
+ (int gsl_rng_memcpy (gsl_rng* gsl_rng*))
+ (gsl_rng* gsl_rng_clone (gsl_rng*))
+ (void gsl_rng_free (gsl_rng*))
+ (void gsl_rng_set (gsl_rng* int))
+ (int gsl_rng_max (gsl_rng*))
+ (int gsl_rng_min (gsl_rng*))
+ (char* gsl_rng_name (gsl_rng*))
+ (int gsl_rng_fread (FILE* gsl_rng*))
+ (int gsl_rng_fwrite (FILE* gsl_rng*))
+ (size_t gsl_rng_size (gsl_rng*))
+ (void* gsl_rng_state (gsl_rng*))
+ (void gsl_rng_print_state (gsl_rng*))
+ (gsl_rng_type* gsl_rng_env_setup (void))
+ (int gsl_rng_get (gsl_rng*))
+ (double gsl_rng_uniform (gsl_rng*))
+ (double gsl_rng_uniform_pos (gsl_rng*))
+ (int gsl_rng_uniform_int (gsl_rng* int))
+
+ ;; gsl_complex
+ (in-C "#define S7_TO_GSL_COMPLEX(sg, g) GSL_SET_COMPLEX(&g, s7_real_part(sg), s7_imag_part(sg))
+ #define GSL_TO_S7_COMPLEX(sc, g) s7_make_complex(sc, GSL_REAL(g), GSL_IMAG(g))
+
+ static s7_pointer s7_gsl_c_c(s7_scheme *sc, s7_pointer arg1, gsl_complex (*callee)(gsl_complex a))
+ {
+ gsl_complex g, g1;
+ S7_TO_GSL_COMPLEX(arg1, g1);
+ g = callee(g1);
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ static s7_pointer s7_gsl_r_c(s7_scheme *sc, s7_pointer arg1, gsl_complex (*callee)(double a))
+ {
+ gsl_complex g;
+ g = callee(s7_number_to_real(sc, arg1));
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ static s7_pointer s7_gsl_c_r(s7_scheme *sc, s7_pointer arg1, double (*callee)(gsl_complex a))
+ {
+ gsl_complex g1;
+ S7_TO_GSL_COMPLEX(arg1, g1);
+ return(s7_make_real(sc, callee(g1)));
+ }
+ static s7_pointer s7_gsl_cc_c(s7_scheme *sc, s7_pointer arg1, s7_pointer arg2, gsl_complex (*callee)(gsl_complex a, gsl_complex b))
+ {
+ gsl_complex g, g1, g2;
+ S7_TO_GSL_COMPLEX(arg1, g1);
+ S7_TO_GSL_COMPLEX(arg2, g2);
+ g = callee(g1, g2);
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ static s7_pointer s7_gsl_cr_c(s7_scheme *sc, s7_pointer arg1, s7_pointer arg2, gsl_complex (*callee)(gsl_complex a, double b))
+ {
+ gsl_complex g, g1;
+ S7_TO_GSL_COMPLEX(arg1, g1);
+ g = callee(g1, s7_number_to_real(sc, arg2));
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ static s7_pointer g_gsl_complex_arg(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_r(sc, s7_car(args), gsl_complex_arg));}
+ static s7_pointer g_gsl_complex_abs(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_r(sc, s7_car(args), gsl_complex_abs));}
+ static s7_pointer g_gsl_complex_abs2(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_r(sc, s7_car(args), gsl_complex_abs2));}
+ static s7_pointer g_gsl_complex_logabs(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_r(sc, s7_car(args), gsl_complex_logabs));}
+ static s7_pointer g_gsl_complex_conjugate(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_conjugate));}
+ static s7_pointer g_gsl_complex_inverse(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_inverse));}
+ static s7_pointer g_gsl_complex_negative(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_negative));}
+ static s7_pointer g_gsl_complex_sqrt(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sqrt));}
+ static s7_pointer g_gsl_complex_exp(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_exp));}
+ static s7_pointer g_gsl_complex_log(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_log));}
+ static s7_pointer g_gsl_complex_log10(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_log10));}
+ static s7_pointer g_gsl_complex_sin(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sin));}
+ static s7_pointer g_gsl_complex_cos(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_cos));}
+ static s7_pointer g_gsl_complex_sec(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sec));}
+ static s7_pointer g_gsl_complex_csc(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_csc));}
+ static s7_pointer g_gsl_complex_tan(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_tan));}
+ static s7_pointer g_gsl_complex_cot(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_cot));}
+ static s7_pointer g_gsl_complex_sinh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sinh));}
+ static s7_pointer g_gsl_complex_cosh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_cosh));}
+ static s7_pointer g_gsl_complex_sech(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_sech));}
+ static s7_pointer g_gsl_complex_csch(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_csch));}
+ static s7_pointer g_gsl_complex_tanh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_tanh));}
+ static s7_pointer g_gsl_complex_coth(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_coth));}
+ static s7_pointer g_gsl_complex_arctan(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arctan));}
+ static s7_pointer g_gsl_complex_arccot(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccot));}
+ static s7_pointer g_gsl_complex_arcsinh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arcsinh));}
+ static s7_pointer g_gsl_complex_arcsech(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arcsech));}
+ static s7_pointer g_gsl_complex_arccsch(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccsch));}
+ static s7_pointer g_gsl_complex_arccoth(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccoth));}
+ static s7_pointer g_gsl_complex_arcsin(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arcsin));}
+ static s7_pointer g_gsl_complex_arccos(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccos));}
+ static s7_pointer g_gsl_complex_arcsec(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arcsec));}
+ static s7_pointer g_gsl_complex_arccsc(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccsc));}
+ static s7_pointer g_gsl_complex_arccosh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arccosh));}
+ static s7_pointer g_gsl_complex_arctanh(s7_scheme *sc, s7_pointer args) {return(s7_gsl_c_c(sc, s7_car(args), gsl_complex_arctanh));}
+ static s7_pointer g_gsl_complex_sqrt_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_sqrt_real));}
+ static s7_pointer g_gsl_complex_arcsin_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arcsin_real));}
+ static s7_pointer g_gsl_complex_arccos_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arccos_real));}
+ static s7_pointer g_gsl_complex_arcsec_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arcsec_real));}
+ static s7_pointer g_gsl_complex_arccsc_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arccsc_real));}
+ static s7_pointer g_gsl_complex_arccosh_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arccosh_real));}
+ static s7_pointer g_gsl_complex_arctanh_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_r_c(sc, s7_car(args), gsl_complex_arctanh_real));}
+ static s7_pointer g_gsl_complex_add(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_add));}
+ static s7_pointer g_gsl_complex_sub(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_sub));}
+ static s7_pointer g_gsl_complex_mul(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_mul));}
+ static s7_pointer g_gsl_complex_div(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_div));}
+ static s7_pointer g_gsl_complex_log_b(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_log_b));}
+ static s7_pointer g_gsl_complex_pow(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cc_c(sc, s7_car(args), s7_cadr(args), gsl_complex_pow));}
+ static s7_pointer g_gsl_complex_add_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_add_real));}
+ static s7_pointer g_gsl_complex_sub_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_sub_real));}
+ static s7_pointer g_gsl_complex_mul_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_mul_real));}
+ static s7_pointer g_gsl_complex_div_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_div_real));}
+ static s7_pointer g_gsl_complex_add_imag(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_add_imag));}
+ static s7_pointer g_gsl_complex_sub_imag(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_sub_imag));}
+ static s7_pointer g_gsl_complex_mul_imag(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_mul_imag));}
+ static s7_pointer g_gsl_complex_div_imag(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_div_imag));}
+ static s7_pointer g_gsl_complex_pow_real(s7_scheme *sc, s7_pointer args) {return(s7_gsl_cr_c(sc, s7_car(args), s7_cadr(args), gsl_complex_pow_real));}
+ ")
+
+ (C-function ("gsl_complex_arg" g_gsl_complex_arg "" 1))
+ (C-function ("gsl_complex_abs" g_gsl_complex_abs "" 1))
+ (C-function ("gsl_complex_abs2" g_gsl_complex_abs2 "" 1))
+ (C-function ("gsl_complex_logabs" g_gsl_complex_logabs "" 1))
+
+ (C-function ("gsl_complex_conjugate" g_gsl_complex_conjugate "" 1))
+ (C-function ("gsl_complex_inverse" g_gsl_complex_inverse "" 1))
+ (C-function ("gsl_complex_negative" g_gsl_complex_negative "" 1))
+ (C-function ("gsl_complex_sqrt" g_gsl_complex_sqrt "" 1))
+ (C-function ("gsl_complex_exp" g_gsl_complex_exp "" 1))
+ (C-function ("gsl_complex_log" g_gsl_complex_log "" 1))
+ (C-function ("gsl_complex_log10" g_gsl_complex_log10 "" 1))
+ (C-function ("gsl_complex_sin" g_gsl_complex_sin "" 1))
+ (C-function ("gsl_complex_cos" g_gsl_complex_cos "" 1))
+ (C-function ("gsl_complex_sec" g_gsl_complex_sec "" 1))
+ (C-function ("gsl_complex_csc" g_gsl_complex_csc "" 1))
+ (C-function ("gsl_complex_tan" g_gsl_complex_tan "" 1))
+ (C-function ("gsl_complex_cot" g_gsl_complex_cot "" 1))
+ (C-function ("gsl_complex_sinh" g_gsl_complex_sinh "" 1))
+ (C-function ("gsl_complex_cosh" g_gsl_complex_cosh "" 1))
+ (C-function ("gsl_complex_sech" g_gsl_complex_sech "" 1))
+ (C-function ("gsl_complex_csch" g_gsl_complex_csch "" 1))
+ (C-function ("gsl_complex_tanh" g_gsl_complex_tanh "" 1))
+ (C-function ("gsl_complex_coth" g_gsl_complex_coth "" 1))
+ (C-function ("gsl_complex_arctan" g_gsl_complex_arctan "" 1))
+ (C-function ("gsl_complex_arccot" g_gsl_complex_arccot "" 1))
+ (C-function ("gsl_complex_arcsinh" g_gsl_complex_arcsinh "" 1))
+ (C-function ("gsl_complex_arcsech" g_gsl_complex_arcsech "" 1))
+ (C-function ("gsl_complex_arccsch" g_gsl_complex_arccsch "" 1))
+ (C-function ("gsl_complex_arccoth" g_gsl_complex_arccoth "" 1))
+ (C-function ("gsl_complex_arcsin" g_gsl_complex_arcsin "" 1))
+ (C-function ("gsl_complex_arccos" g_gsl_complex_arccos "" 1))
+ (C-function ("gsl_complex_arcsec" g_gsl_complex_arcsec "" 1))
+ (C-function ("gsl_complex_arccsc" g_gsl_complex_arccsc "" 1))
+ (C-function ("gsl_complex_arccosh" g_gsl_complex_arccosh "" 1))
+ (C-function ("gsl_complex_arctanh" g_gsl_complex_arctanh "" 1))
+
+ (C-function ("gsl_complex_sqrt_real" g_gsl_complex_sqrt_real "" 1))
+ (C-function ("gsl_complex_arcsin_real" g_gsl_complex_arcsin_real "" 1))
+ (C-function ("gsl_complex_arccos_real" g_gsl_complex_arccos_real "" 1))
+ (C-function ("gsl_complex_arcsec_real" g_gsl_complex_arcsec_real "" 1))
+ (C-function ("gsl_complex_arccsc_real" g_gsl_complex_arccsc_real "" 1))
+ (C-function ("gsl_complex_arccosh_real" g_gsl_complex_arccosh_real "" 1))
+ (C-function ("gsl_complex_arctanh_real" g_gsl_complex_arctanh_real "" 1))
+
+ (C-function ("gsl_complex_add" g_gsl_complex_add "" 2))
+ (C-function ("gsl_complex_sub" g_gsl_complex_sub "" 2))
+ (C-function ("gsl_complex_mul" g_gsl_complex_mul "" 2))
+ (C-function ("gsl_complex_div" g_gsl_complex_div "" 2))
+ (C-function ("gsl_complex_log_b" g_gsl_complex_log_b "" 2))
+ (C-function ("gsl_complex_pow" g_gsl_complex_pow "" 2))
+
+ (C-function ("gsl_complex_add_real" g_gsl_complex_add_real "" 2))
+ (C-function ("gsl_complex_sub_real" g_gsl_complex_sub_real "" 2))
+ (C-function ("gsl_complex_mul_real" g_gsl_complex_mul_real "" 2))
+ (C-function ("gsl_complex_div_real" g_gsl_complex_div_real "" 2))
+ (C-function ("gsl_complex_add_imag" g_gsl_complex_add_imag "" 2))
+ (C-function ("gsl_complex_sub_imag" g_gsl_complex_sub_imag "" 2))
+ (C-function ("gsl_complex_mul_imag" g_gsl_complex_mul_imag "" 2))
+ (C-function ("gsl_complex_div_imag" g_gsl_complex_div_imag "" 2))
+ (C-function ("gsl_complex_pow_real" g_gsl_complex_pow_real "" 2))
+
+
+ ;; cheb
+ (gsl_cheb_series* gsl_cheb_alloc (size_t))
+ (void gsl_cheb_free (gsl_cheb_series*))
+ (size_t gsl_cheb_order (gsl_cheb_series*))
+ (size_t gsl_cheb_size (gsl_cheb_series*))
+ (double* gsl_cheb_coeffs (gsl_cheb_series*))
+ (double gsl_cheb_eval (gsl_cheb_series* double))
+ (int gsl_cheb_eval_err (gsl_cheb_series* double double* double*))
+ (double gsl_cheb_eval_n (gsl_cheb_series* size_t double))
+ (int gsl_cheb_eval_n_err (gsl_cheb_series* size_t double double* double*))
+ (double gsl_cheb_eval_mode (gsl_cheb_series* double int))
+ (int gsl_cheb_eval_mode_e (gsl_cheb_series* double int double* double*))
+ (int gsl_cheb_calc_deriv (gsl_cheb_series* gsl_cheb_series*))
+ (int gsl_cheb_calc_integ (gsl_cheb_series* gsl_cheb_series*))
+
+ ;; gsl_function is a struct with double function(double void*) and void* params
+ (in-C "static s7_scheme *gsl_f_s7;
+ static gsl_function gsl_f;
+ static double gsl_f_caller(double x, void *p)
+ {
+ return(s7_real(s7_call(gsl_f_s7, (s7_pointer)p, s7_cons(gsl_f_s7, s7_make_real(gsl_f_s7, x), s7_nil(gsl_f_s7)))));
+ }
+ #define make_gsl_function(Args) do {gsl_f.function = gsl_f_caller; gsl_f.params = (void *)Args; gsl_f_s7 = sc;} while (0)
+ static s7_pointer g_gsl_cheb_init(s7_scheme *sc, s7_pointer args)
+ {
+ make_gsl_function(s7_cadr(args));
+ return(s7_make_integer(sc, gsl_cheb_init((gsl_cheb_series *)s7_c_pointer(s7_car(args)),
+ &gsl_f, s7_real(s7_caddr(args)), s7_real(s7_cadddr(args)))));
+ }
+ ")
+ (C-function ("gsl_cheb_init" g_gsl_cheb_init "" 4))
+
+ ;; interp
+ (gsl_interp_accel* gsl_interp_accel_alloc (void))
+ (int gsl_interp_accel_reset (gsl_interp_accel*))
+ (void gsl_interp_accel_free (gsl_interp_accel*))
+ (gsl_interp* gsl_interp_alloc (gsl_interp_type* size_t))
+ (int gsl_interp_init (gsl_interp* double* double* size_t))
+ (char* gsl_interp_name (gsl_interp*))
+ (int gsl_interp_min_size (gsl_interp*))
+ (reader-cond ((>= gsl-version 1.15) (int gsl_interp_type_min_size (gsl_interp_type*))))
+ (int gsl_interp_eval_e (gsl_interp* double* double* double gsl_interp_accel* double*))
+ (double gsl_interp_eval (gsl_interp* double* double* double gsl_interp_accel*))
+ (int gsl_interp_eval_deriv_e (gsl_interp* double* double* double gsl_interp_accel* double*))
+ (double gsl_interp_eval_deriv (gsl_interp* double* double* double gsl_interp_accel*))
+ (int gsl_interp_eval_deriv2_e (gsl_interp* double* double* double gsl_interp_accel* double*))
+ (double gsl_interp_eval_deriv2 (gsl_interp* double* double* double gsl_interp_accel*))
+ (int gsl_interp_eval_integ_e (gsl_interp* double* double* double double gsl_interp_accel* double*))
+ (double gsl_interp_eval_integ (gsl_interp* double* double* double double gsl_interp_accel*))
+ (void gsl_interp_free (gsl_interp*))
+ (size_t gsl_interp_bsearch (double* double size_t size_t))
+ (size_t gsl_interp_accel_find (gsl_interp_accel* double* size_t double))
+
+ ;; spline (based on interp above)
+ (gsl_spline* gsl_spline_alloc (gsl_interp_type* size_t))
+ (int gsl_spline_init (gsl_spline* double* double* size_t))
+ (char* gsl_spline_name (gsl_spline*))
+ (int gsl_spline_min_size (gsl_spline*))
+ (int gsl_spline_eval_e (gsl_spline* double gsl_interp_accel* double*))
+ (double gsl_spline_eval (gsl_spline* double gsl_interp_accel*))
+ (int gsl_spline_eval_deriv_e (gsl_spline* double gsl_interp_accel* double*))
+ (double gsl_spline_eval_deriv (gsl_spline* double gsl_interp_accel*))
+ (int gsl_spline_eval_deriv2_e (gsl_spline* double gsl_interp_accel* double*))
+ (double gsl_spline_eval_deriv2 (gsl_spline* double gsl_interp_accel*))
+ (int gsl_spline_eval_integ_e (gsl_spline* double double gsl_interp_accel* double*))
+ (double gsl_spline_eval_integ (gsl_spline* double double gsl_interp_accel*))
+ (void gsl_spline_free (gsl_spline*))
+
+ ;; bspline
+ (gsl_bspline_workspace* gsl_bspline_alloc (size_t size_t))
+ (void gsl_bspline_free (gsl_bspline_workspace*))
+ (size_t gsl_bspline_ncoeffs (gsl_bspline_workspace*))
+ (size_t gsl_bspline_order (gsl_bspline_workspace*))
+ (size_t gsl_bspline_nbreak (gsl_bspline_workspace*))
+ (double gsl_bspline_breakpoint (size_t gsl_bspline_workspace*))
+ (reader-cond ((>= gsl-version 1.16)
+ (double gsl_bspline_greville_abscissa (size_t gsl_bspline_workspace*))
+ (int gsl_bspline_knots_greville (gsl_vector* gsl_bspline_workspace* double*))))
+ (int gsl_bspline_knots (gsl_vector* gsl_bspline_workspace*))
+ (int gsl_bspline_knots_uniform (double double gsl_bspline_workspace*))
+ (int gsl_bspline_eval (double gsl_vector* gsl_bspline_workspace*))
+ (int gsl_bspline_eval_nonzero (double gsl_vector* size_t* size_t* gsl_bspline_workspace*))
+ ;;; out 2.0 (gsl_bspline_deriv_workspace* gsl_bspline_deriv_alloc (size_t))
+ ;;; out 2.0 (void gsl_bspline_deriv_free (gsl_bspline_deriv_workspace*))
+ (reader-cond ((>= gsl-version 2.0)
+ (int gsl_bspline_deriv_eval (double size_t gsl_matrix* gsl_bspline_workspace*))
+ (int gsl_bspline_deriv_eval_nonzero (double size_t gsl_matrix* size_t* size_t* gsl_bspline_workspace*))))
+
+ ;; sort
+ ;; perhaps size_t* -> int vector?
+
+ (void gsl_sort (double* size_t size_t))
+ (reader-cond ((>= gsl-version 1.16)
+ (void gsl_sort2 (double* size_t double* size_t size_t))
+ (void gsl_sort_vector2 (gsl_vector* gsl_vector*))
+ (int gsl_poly_dd_hermite_init (double* double* double* double* double* size_t))))
+ (void gsl_sort_index (size_t* double* size_t size_t))
+ (int gsl_sort_smallest (double* size_t double* size_t size_t))
+ (int gsl_sort_smallest_index (size_t* size_t double* size_t size_t))
+ (int gsl_sort_largest (double* size_t double* size_t size_t))
+ (int gsl_sort_largest_index (size_t* size_t double* size_t size_t))
+ (void gsl_sort_vector (gsl_vector*))
+ (int gsl_sort_vector_index (gsl_permutation* gsl_vector*))
+ (int gsl_sort_vector_smallest (double* size_t gsl_vector*))
+ (int gsl_sort_vector_largest (double* size_t gsl_vector*))
+ (int gsl_sort_vector_smallest_index (size_t* size_t gsl_vector*))
+ (int gsl_sort_vector_largest_index (size_t* size_t gsl_vector*))
+
+ ;; poly
+ (double gsl_poly_eval (double* int double))
+ (int gsl_poly_eval_derivs (double* size_t double double* size_t))
+ (int gsl_poly_dd_init (double* double* double* size_t))
+ (double gsl_poly_dd_eval (double* double* size_t double))
+ (int gsl_poly_dd_taylor (double* double double* double* size_t double*))
+ (void gsl_poly_complex_workspace_free (gsl_poly_complex_workspace*))
+ (gsl_poly_complex_workspace* gsl_poly_complex_workspace_alloc (size_t))
+
+ (in-C "static s7_pointer g_gsl_poly_complex_eval(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex z, rz;
+ S7_TO_GSL_COMPLEX(s7_caddr(args), z);
+ rz = gsl_poly_complex_eval((double *)s7_c_pointer(s7_car(args)), (int)s7_integer(s7_cadr(args)), z);
+ return(GSL_TO_S7_COMPLEX(sc, rz));
+ }
+ static s7_pointer g_gsl_complex_poly_complex_eval(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex *z;
+ gsl_complex rz, x;
+ int i, n;
+ s7_pointer v;
+ v = s7_car(args);
+ n = s7_integer(s7_cadr(args));
+ z = (gsl_complex *)calloc(n, sizeof(gsl_complex));
+ for (i = 0; i < n; i++)
+ S7_TO_GSL_COMPLEX(s7_vector_ref(sc, v, i), z[i]);
+ S7_TO_GSL_COMPLEX(s7_caddr(args), x);
+ rz = gsl_complex_poly_complex_eval(z, n, x);
+ free(z);
+ return(GSL_TO_S7_COMPLEX(sc, rz));
+ }
+ static s7_pointer g_gsl_poly_complex_solve_quadratic(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex z0, z1;
+ int result;
+ s7_pointer res;
+
+ res = s7_cadddr(args);
+ result = gsl_poly_complex_solve_quadratic(s7_number_to_real(sc, s7_car(args)), s7_number_to_real(sc, s7_cadr(args)),
+ s7_number_to_real(sc, s7_caddr(args)), &z0, &z1);
+ s7_vector_set(sc, res, 0, GSL_TO_S7_COMPLEX(sc, z0));
+ s7_vector_set(sc, res, 1, GSL_TO_S7_COMPLEX(sc, z1));
+
+ return(s7_make_integer(sc, result));
+ }
+ static s7_pointer g_gsl_poly_complex_solve_cubic(s7_scheme *sc, s7_pointer args)
+ {
+ /* trailing args are by ref, but I think I'll mimic the real solver above */
+ gsl_complex z0, z1, z2;
+ int result;
+ s7_pointer res;
+
+ result = gsl_poly_complex_solve_cubic(s7_number_to_real(sc, s7_car(args)), s7_number_to_real(sc, s7_cadr(args)),
+ s7_number_to_real(sc, s7_caddr(args)), &z0, &z1, &z2);
+ res = s7_cadddr(args);
+ s7_vector_set(sc, res, 0, GSL_TO_S7_COMPLEX(sc, z0));
+ s7_vector_set(sc, res, 1, GSL_TO_S7_COMPLEX(sc, z1));
+ s7_vector_set(sc, res, 2, GSL_TO_S7_COMPLEX(sc, z2));
+
+ return(s7_make_integer(sc, result));
+ }
+
+ static s7_pointer g_gsl_poly_complex_solve(s7_scheme *sc, s7_pointer args)
+ {
+ /* trailing args are by ref, but I think I'll mimic the real solver above */
+ double *z;
+ gsl_poly_complex_workspace *w;
+ int result, i, size;
+ s7_pointer res;
+
+ size = s7_integer(s7_cadr(args));
+ res = s7_caddr(args);
+
+ z = (double *)calloc(size * 2, sizeof(double));
+ w = gsl_poly_complex_workspace_alloc(size);
+ result = gsl_poly_complex_solve((double *)s7_c_pointer(s7_car(args)), size, w, (gsl_complex_packed_ptr)z);
+ gsl_poly_complex_workspace_free(w);
+
+ for (i = 0; i < size - 1; i++)
+ s7_vector_set(sc, res, i, s7_make_complex(sc, z[2 * i], z[2 * i + 1]));
+ free(z);
+
+ return(s7_make_integer(sc, result));
+ }
+
+ static s7_pointer g_gsl_poly_solve_quadratic(s7_scheme *sc, s7_pointer args)
+ {
+ double x0, x1;
+ int result;
+ double *res;
+ res = (double *)s7_c_pointer(s7_cadddr(args));
+ result = gsl_poly_solve_quadratic(s7_number_to_real(sc, s7_car(args)), s7_number_to_real(sc, s7_cadr(args)),
+ s7_number_to_real(sc, s7_caddr(args)), &x0, &x1);
+ res[0] = x0;
+ res[1] = x1;
+ return(s7_make_integer(sc, result));
+ }
+
+ static s7_pointer g_gsl_poly_solve_cubic(s7_scheme *sc, s7_pointer args)
+ {
+ double x0, x1, x2;
+ int result;
+ double *res;
+ res = (double *)s7_c_pointer(s7_cadddr(args));
+ result = gsl_poly_solve_cubic(s7_number_to_real(sc, s7_car(args)), s7_number_to_real(sc, s7_cadr(args)),
+ s7_number_to_real(sc, s7_caddr(args)), &x0, &x1, &x2);
+ res[0] = x0;
+ res[1] = x1;
+ res[2] = x2;
+ return(s7_make_integer(sc, result));
+ }
+ ")
+
+ (C-function ("gsl_poly_complex_eval" g_gsl_poly_complex_eval "" 3))
+ (C-function ("gsl_complex_poly_complex_eval" g_gsl_complex_poly_complex_eval "" 3))
+ (C-function ("gsl_poly_complex_solve_quadratic" g_gsl_poly_complex_solve_quadratic "" 4))
+ (C-function ("gsl_poly_complex_solve_cubic" g_gsl_poly_complex_solve_cubic "" 4))
+ (C-function ("gsl_poly_complex_solve" g_gsl_poly_complex_solve "" 3))
+ (C-function ("gsl_poly_solve_quadratic" g_gsl_poly_solve_quadratic "" 4))
+ (C-function ("gsl_poly_solve_cubic" g_gsl_poly_solve_cubic "" 4))
+
+ ;; vector
+ (in-C "static s7_pointer g_float_vector_to_gsl_vector(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_vector *g;
+ int size;
+ s7_pointer v;
+ v = s7_car(args);
+ size = s7_vector_length(v);
+ g = (gsl_vector *)s7_c_pointer(s7_cadr(args));
+ memcpy((void *)(g->data), (void *)s7_float_vector_elements(v), size * sizeof(double));
+ return(s7_cadr(args));
+ }
+ static s7_pointer g_gsl_vector_to_float_vector(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_vector *g;
+ int size;
+ s7_pointer v;
+ v = s7_cadr(args);
+ size = s7_vector_length(v);
+ g = (gsl_vector *)s7_c_pointer(s7_car(args));
+ memcpy((void *)s7_float_vector_elements(v), (void *)(g->data), size * sizeof(double));
+ return(s7_cadr(args));
+ }
+ ")
+ (C-function ("float-vector->gsl_vector" g_float_vector_to_gsl_vector "" 2))
+ (C-function ("gsl_vector->float-vector" g_gsl_vector_to_float_vector "" 2))
+
+ (gsl_vector* gsl_vector_alloc (size_t))
+ (gsl_vector* gsl_vector_calloc (size_t))
+ (gsl_vector* gsl_vector_alloc_from_vector (gsl_vector* size_t size_t size_t))
+ (void gsl_vector_free (gsl_vector*))
+ (void gsl_vector_set_zero (gsl_vector*))
+ (void gsl_vector_set_all (gsl_vector* double))
+ (int gsl_vector_set_basis (gsl_vector* size_t))
+ (int gsl_vector_fread (FILE* gsl_vector*))
+ (int gsl_vector_fwrite (FILE* gsl_vector*))
+ (int gsl_vector_fscanf (FILE* gsl_vector*))
+ (int gsl_vector_fprintf (FILE* gsl_vector* char*))
+ (int gsl_vector_memcpy (gsl_vector* gsl_vector*))
+ (int gsl_vector_reverse (gsl_vector*))
+ (int gsl_vector_swap (gsl_vector* gsl_vector*))
+ (int gsl_vector_swap_elements (gsl_vector* size_t size_t))
+ (double gsl_vector_max (gsl_vector*))
+ (double gsl_vector_min (gsl_vector*))
+ (size_t gsl_vector_max_index (gsl_vector*))
+ (size_t gsl_vector_min_index (gsl_vector*))
+ (int gsl_vector_add (gsl_vector* gsl_vector*))
+ (int gsl_vector_sub (gsl_vector* gsl_vector*))
+ (int gsl_vector_mul (gsl_vector* gsl_vector*))
+ (int gsl_vector_div (gsl_vector* gsl_vector*))
+ (int gsl_vector_scale (gsl_vector* double))
+ (int gsl_vector_add_constant (gsl_vector* double))
+ (reader-cond ((>= gsl-version 1.15) (int gsl_vector_equal (gsl_vector* gsl_vector*))))
+ (int gsl_vector_isnull (gsl_vector*))
+ (int gsl_vector_ispos (gsl_vector*))
+ (int gsl_vector_isneg (gsl_vector*))
+ (int gsl_vector_isnonneg (gsl_vector*))
+ (double gsl_vector_get (gsl_vector* size_t))
+ (void gsl_vector_set (gsl_vector* size_t double))
+ (double* gsl_vector_ptr (gsl_vector* size_t))
+ (double* gsl_vector_const_ptr (gsl_vector* size_t))
+ (void gsl_vector_minmax (gsl_vector* double* double*)) ; by ref
+ (void gsl_vector_minmax_index (gsl_vector* size_t* size_t*)) ; by ref
+
+ ;; matrix
+ (in-C "static s7_pointer g_float_vector_to_gsl_matrix(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_matrix *g;
+ int size;
+ s7_pointer v;
+ v = s7_car(args);
+ size = s7_vector_length(v);
+ g = (gsl_matrix *)s7_c_pointer(s7_cadr(args));
+ memcpy((void *)(g->data), (void *)s7_float_vector_elements(v), size * sizeof(double));
+ return(s7_cadr(args));
+ }
+ static s7_pointer g_gsl_matrix_to_float_vector(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_matrix *g;
+ int size;
+ s7_pointer v;
+ v = s7_cadr(args);
+ size = s7_vector_length(v);
+ g = (gsl_matrix *)s7_c_pointer(s7_car(args));
+ memcpy((void *)s7_float_vector_elements(v), (void *)(g->data), size * sizeof(double));
+ return(s7_cadr(args));
+ }
+ ")
+ (C-function ("float-vector->gsl_matrix" g_float_vector_to_gsl_matrix "" 2))
+ (C-function ("gsl_matrix->float-vector" g_gsl_matrix_to_float_vector "" 2))
+
+ (gsl_matrix* gsl_matrix_alloc (size_t size_t))
+ (gsl_matrix* gsl_matrix_calloc (size_t size_t))
+ (gsl_matrix* gsl_matrix_alloc_from_matrix (gsl_matrix* size_t size_t size_t size_t))
+ (gsl_vector* gsl_vector_alloc_row_from_matrix (gsl_matrix* size_t))
+ (gsl_vector* gsl_vector_alloc_col_from_matrix (gsl_matrix* size_t))
+ (void gsl_matrix_free (gsl_matrix*))
+ (void gsl_matrix_set_zero (gsl_matrix*))
+ (void gsl_matrix_set_identity (gsl_matrix*))
+ (void gsl_matrix_set_all (gsl_matrix* double))
+ (int gsl_matrix_fread (FILE* gsl_matrix*) )
+ (int gsl_matrix_fwrite (FILE* gsl_matrix*) )
+ (int gsl_matrix_fscanf (FILE* gsl_matrix*))
+ (int gsl_matrix_fprintf (FILE* gsl_matrix* char*))
+ (int gsl_matrix_memcpy (gsl_matrix* gsl_matrix*))
+ (int gsl_matrix_swap (gsl_matrix* gsl_matrix*))
+ (int gsl_matrix_swap_rows (gsl_matrix* size_t size_t))
+ (int gsl_matrix_swap_columns (gsl_matrix* size_t size_t))
+ (int gsl_matrix_swap_rowcol (gsl_matrix* size_t size_t))
+ (int gsl_matrix_transpose (gsl_matrix*))
+ (int gsl_matrix_transpose_memcpy (gsl_matrix* gsl_matrix*))
+ (double gsl_matrix_max (gsl_matrix*))
+ (double gsl_matrix_min (gsl_matrix*))
+ (void gsl_matrix_minmax (gsl_matrix* double* double*))
+ (void gsl_matrix_max_index (gsl_matrix* size_t* size_t*))
+ (void gsl_matrix_min_index (gsl_matrix* size_t* size_t*))
+ (void gsl_matrix_minmax_index (gsl_matrix* size_t* size_t* size_t* size_t*))
+ (reader-cond ((>= gsl-version 1.15) (int gsl_matrix_equal (gsl_matrix* gsl_matrix*))))
+ (int gsl_matrix_isnull (gsl_matrix*))
+ (int gsl_matrix_ispos (gsl_matrix*))
+ (int gsl_matrix_isneg (gsl_matrix*))
+ (int gsl_matrix_isnonneg (gsl_matrix*))
+ (int gsl_matrix_add (gsl_matrix* gsl_matrix*))
+ (int gsl_matrix_sub (gsl_matrix* gsl_matrix*))
+ (int gsl_matrix_mul_elements (gsl_matrix* gsl_matrix*))
+ (int gsl_matrix_div_elements (gsl_matrix* gsl_matrix*))
+ (int gsl_matrix_scale (gsl_matrix* double))
+ (int gsl_matrix_add_constant (gsl_matrix* double))
+ (int gsl_matrix_add_diagonal (gsl_matrix* double))
+ (int gsl_matrix_get_row (gsl_vector* gsl_matrix* size_t))
+ (int gsl_matrix_get_col (gsl_vector* gsl_matrix* size_t))
+ (int gsl_matrix_set_row (gsl_matrix* size_t gsl_vector*))
+ (int gsl_matrix_set_col (gsl_matrix* size_t gsl_vector*))
+ (double gsl_matrix_get (gsl_matrix* size_t size_t))
+ (void gsl_matrix_set (gsl_matrix* size_t size_t double))
+ (double* gsl_matrix_ptr (gsl_matrix* size_t size_t))
+ (double* gsl_matrix_const_ptr (gsl_matrix* size_t size_t))
+ (in-C "static s7_pointer g_gsl_matrix_size(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_matrix *g; g = (gsl_matrix *)s7_c_pointer(s7_car(args));
+ return(s7_cons(sc, s7_make_integer(sc, (s7_int)(g->size1)), s7_make_integer(sc, (s7_int)(g->size2))));
+ }")
+ (C-function ("gsl_matrix_size" g_gsl_matrix_size "" 1))
+
+ ;; cblas
+ (int gsl_blas_zdotu (gsl_vector_complex* gsl_vector_complex* gsl_complex*))
+ (int gsl_blas_zdotc (gsl_vector_complex* gsl_vector_complex* gsl_complex*))
+ (double gsl_blas_dnrm2 (gsl_vector*))
+ (double gsl_blas_dasum (gsl_vector*))
+ (double gsl_blas_dznrm2 (gsl_vector_complex*))
+ (double gsl_blas_dzasum (gsl_vector_complex*))
+ (size_t_t gsl_blas_idamax (gsl_vector*))
+ (size_t_t gsl_blas_izamax (gsl_vector_complex*))
+ (int gsl_blas_dswap (gsl_vector* gsl_vector*))
+ (int gsl_blas_dcopy (gsl_vector* gsl_vector*))
+ (int gsl_blas_daxpy (double gsl_vector* gsl_vector*))
+ (int gsl_blas_zswap (gsl_vector_complex* gsl_vector_complex*))
+ (int gsl_blas_zcopy (gsl_vector_complex* gsl_vector_complex*))
+ (int gsl_blas_drotg (double* double* double* double*))
+ (int gsl_blas_drotmg (double* double* double* double double*))
+ (int gsl_blas_drot (gsl_vector* gsl_vector* double double))
+ (int gsl_blas_drotm (gsl_vector* gsl_vector* double*))
+ (void gsl_blas_dscal (double gsl_vector*))
+ (void gsl_blas_zdscal (double gsl_vector_complex*))
+ (int gsl_blas_dgemv (int double gsl_matrix* gsl_vector* double gsl_vector*))
+ (int gsl_blas_dtrmv (int int int gsl_matrix* gsl_vector*))
+ (int gsl_blas_dtrsv (int int int gsl_matrix* gsl_vector*))
+ (int gsl_blas_ztrmv (int int int gsl_matrix_complex* gsl_vector_complex*))
+ (int gsl_blas_ztrsv (int int int gsl_matrix_complex* gsl_vector_complex*))
+ (int gsl_blas_dsymv (int double gsl_matrix* gsl_vector* double gsl_vector*))
+ (int gsl_blas_dger (double gsl_vector* gsl_vector* gsl_matrix*))
+ (int gsl_blas_dsyr (int double gsl_vector* gsl_matrix*))
+ (int gsl_blas_dsyr2 (int double gsl_vector* gsl_vector* gsl_matrix*))
+ (int gsl_blas_zher (int double gsl_vector_complex* gsl_matrix_complex*))
+ (int gsl_blas_dgemm (int int double gsl_matrix* gsl_matrix* double gsl_matrix*))
+ (int gsl_blas_dsymm (int int double gsl_matrix* gsl_matrix* double gsl_matrix*))
+ (int gsl_blas_dsyrk (int int double gsl_matrix* double gsl_matrix*))
+ (int gsl_blas_dsyr2k (int int double gsl_matrix* gsl_matrix* double gsl_matrix*))
+ (int gsl_blas_dtrmm (int int int int double gsl_matrix* gsl_matrix*))
+ (int gsl_blas_dtrsm (int int int int double gsl_matrix* gsl_matrix*))
+ (int gsl_blas_zherk (int int double gsl_matrix_complex* double gsl_matrix_complex*))
+ (double cblas_ddot (int double* int double* int))
+ (void cblas_zdotu_sub (int double* int double* int double*))
+ (void cblas_zdotc_sub (int double* int double* int double*))
+ (double cblas_dnrm2 (int double* int))
+ (double cblas_dasum (int double* int))
+ (double cblas_dznrm2 (int void* int))
+ (double cblas_dzasum (int void* int))
+ (size_t cblas_idamax (int double* int))
+ (size_t cblas_icamax (int void* int))
+ (size_t cblas_izamax (int void* int))
+ (void cblas_dswap (int double* int double* int))
+ (void cblas_dcopy (int double* int double* int))
+ (void cblas_daxpy (int double double* int double* int))
+ (void cblas_zswap (int double* int double* int))
+ (void cblas_zcopy (int double* int double* int))
+ (void cblas_zaxpy (int double* double* int double* int))
+ (void cblas_drotg (double* double* double* double*))
+ (void cblas_drotmg (double* double* double* double double*))
+ (void cblas_drot (int double* int double* int double double))
+ (void cblas_drotm (int double* int double* int double*))
+ (void cblas_dscal (int double double* int))
+ (void cblas_zscal (int double* double* int))
+ (void cblas_zdscal (int double double* int))
+ (void cblas_dgemv (int int int int double double* int double* int double double* int))
+ (void cblas_dgbmv (int int int int int int double double* int double* int double double* int))
+ (void cblas_dtrmv (int int int int int double* int double* int))
+ (void cblas_dtbmv (int int int int int int double* int double* int))
+ (void cblas_dtpmv (int int int int int double* double* int))
+ (void cblas_dtrsv (int int int int int double* int double* int))
+ (void cblas_dtbsv (int int int int int int double* int double* int))
+ (void cblas_dtpsv (int int int int int double* double* int))
+ (void cblas_zgemv (int int int int double* double* int double* int double* double* int))
+ (void cblas_zgbmv (int int int int int int double* double* int double* int double* double* int))
+ (void cblas_ztrmv (int int int int int double* int double* int))
+ (void cblas_ztbmv (int int int int int int double* int double* int))
+ (void cblas_ztpmv (int int int int int double* double* int))
+ (void cblas_ztrsv (int int int int int double* int double* int))
+ (void cblas_ztbsv (int int int int int int double* int double* int))
+ (void cblas_ztpsv (int int int int int double* double* int))
+ (void cblas_dsymv (int int int double double* int double* int double double* int))
+ (void cblas_dsbmv (int int int int double double* int double* int double double* int))
+ (void cblas_dspmv (int int int double double* double* int double double* int))
+ (void cblas_dger (int int int double double* int double* int double* int))
+ (void cblas_dsyr (int int int double double* int double* int))
+ (void cblas_dspr (int int int double double* int double*))
+ (void cblas_dsyr2 (int int int double double* int double* int double* int))
+ (void cblas_dspr2 (int int int double double* int double* int double*))
+ (void cblas_zhemv (int int int double* double* int double* int double* double* int))
+ (void cblas_zhbmv (int int int int double* double* int double* int double* double* int))
+ (void cblas_zhpmv (int int int double* double* double* int double* double* int))
+ (void cblas_zgeru (int int int double* double* int double* int double* int))
+ (void cblas_zgerc (int int int double* double* int double* int double* int))
+ (void cblas_zher (int int int double double* int double* int))
+ (void cblas_zhpr (int int int double double* int double*))
+ (void cblas_zher2 (int int int double* double* int double* int double* int))
+ (void cblas_zhpr2 (int int int double* double* int double* int double*))
+ (void cblas_dgemm (int int int int int int double double* int double* int double double* int))
+ (void cblas_dsymm (int int int int int double double* int double* int double double* int))
+ (void cblas_dsyrk (int int int int int double double* int double double* int))
+ (void cblas_dsyr2k (int int int int int double double* int double* int double double* int))
+ (void cblas_dtrmm (int int int int int int int double double* int double* int))
+ (void cblas_dtrsm (int int int int int int int double double* int double* int))
+ (void cblas_zgemm (int int int int int int double* double* int double* int double* double* int))
+ (void cblas_zsymm (int int int int int double* double* int double* int double* double* int))
+ (void cblas_zsyrk (int int int int int double* double* int double* double* int))
+ (void cblas_zsyr2k (int int int int int double* double* int double* int double* double* int))
+ (void cblas_ztrmm (int int int int int int int double* double* int double* int))
+ (void cblas_ztrsm (int int int int int int int double* double* int double* int))
+ (void cblas_zhemm (int int int int int double* double* int double* int double* double* int))
+ (void cblas_zherk (int int int int int double double* int double double* int))
+ (void cblas_zher2k (int int int int int double* double* int double* int double double* int))
+
+ ;; combination
+ (gsl_combination* gsl_combination_alloc (size_t size_t))
+ (gsl_combination* gsl_combination_calloc (size_t size_t))
+ (void gsl_combination_init_first (gsl_combination*))
+ (void gsl_combination_init_last (gsl_combination*))
+ (void gsl_combination_free (gsl_combination*))
+ (int gsl_combination_memcpy (gsl_combination* gsl_combination*) )
+ (int gsl_combination_fread (FILE* gsl_combination*))
+ (int gsl_combination_fwrite (FILE* gsl_combination*))
+ (int gsl_combination_fscanf (FILE* gsl_combination*))
+ (int gsl_combination_fprintf (FILE* gsl_combination* char*))
+ (size_t gsl_combination_n (gsl_combination*))
+ (size_t gsl_combination_k (gsl_combination*))
+ ;(size_t* gsl_combination_data (gsl_combination*))
+ (int gsl_combination_valid (gsl_combination*))
+ (int gsl_combination_next (gsl_combination*))
+ (int gsl_combination_prev (gsl_combination*))
+ (size_t gsl_combination_get (gsl_combination* size_t))
+ (in-C "static s7_pointer g_gsl_combination_to_int_vector(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_combination *g;
+ int i, size;
+ s7_int *el;
+ s7_pointer v;
+ v = s7_cadr(args);
+ size = s7_vector_length(v);
+ g = (gsl_combination *)s7_c_pointer(s7_car(args));
+ el = s7_int_vector_elements(v);
+ for (i = 0; i < size; i++) el[i] = (s7_int)(g->data[i]);
+ return(s7_cadr(args));
+ }
+ ")
+ (C-function ("gsl_combination->int-vector" g_gsl_combination_to_int_vector "" 2))
+
+ ;; rl+im for complex in most of these cases
+ (int gsl_dft_complex_forward (double* size_t size_t double*))
+ (int gsl_dft_complex_backward (double* size_t size_t double*))
+ (int gsl_dft_complex_inverse (double* size_t size_t double*))
+ (int gsl_dft_complex_transform (double* size_t size_t double* int))
+ (int gsl_fft_complex_radix2_forward (double* size_t size_t))
+ (int gsl_fft_complex_radix2_backward (double* size_t size_t))
+ (int gsl_fft_complex_radix2_inverse (double* size_t size_t))
+ (int gsl_fft_complex_radix2_transform (double* size_t size_t int))
+ (int gsl_fft_complex_radix2_dif_forward (double* size_t size_t))
+ (int gsl_fft_complex_radix2_dif_backward (double* size_t size_t))
+ (int gsl_fft_complex_radix2_dif_inverse (double* size_t size_t))
+ (int gsl_fft_complex_radix2_dif_transform (double* size_t size_t int))
+ (gsl_fft_complex_wavetable* gsl_fft_complex_wavetable_alloc (size_t))
+ (void gsl_fft_complex_wavetable_free (gsl_fft_complex_wavetable*))
+ (gsl_fft_complex_workspace* gsl_fft_complex_workspace_alloc (size_t))
+ (void gsl_fft_complex_workspace_free (gsl_fft_complex_workspace*))
+ (int gsl_fft_complex_memcpy (gsl_fft_complex_wavetable* gsl_fft_complex_wavetable*))
+ (int gsl_fft_complex_forward (double* size_t size_t gsl_fft_complex_wavetable* gsl_fft_complex_workspace*))
+ (int gsl_fft_complex_backward (double* size_t size_t gsl_fft_complex_wavetable* gsl_fft_complex_workspace*))
+ (int gsl_fft_complex_inverse (double* size_t size_t gsl_fft_complex_wavetable* gsl_fft_complex_workspace*))
+ (int gsl_fft_complex_transform (double* size_t size_t gsl_fft_complex_wavetable* gsl_fft_complex_workspace* int))
+ (int gsl_fft_real_radix2_transform (double* size_t size_t) )
+ (gsl_fft_real_wavetable* gsl_fft_real_wavetable_alloc (size_t))
+ (void gsl_fft_real_wavetable_free (gsl_fft_real_wavetable*))
+ (gsl_fft_real_workspace* gsl_fft_real_workspace_alloc (size_t))
+ (void gsl_fft_real_workspace_free (gsl_fft_real_workspace*))
+ (int gsl_fft_real_transform (double* size_t size_t gsl_fft_real_wavetable* gsl_fft_real_workspace*))
+ (int gsl_fft_real_unpack (double* double* size_t size_t))
+
+
+ (gsl_eigen_symm_workspace* gsl_eigen_symm_alloc (size_t))
+ (void gsl_eigen_symm_free (gsl_eigen_symm_workspace*))
+ (int gsl_eigen_symm (gsl_matrix* gsl_vector* gsl_eigen_symm_workspace*))
+ (gsl_eigen_symmv_workspace* gsl_eigen_symmv_alloc (size_t))
+ (void gsl_eigen_symmv_free (gsl_eigen_symmv_workspace*))
+ (int gsl_eigen_symmv (gsl_matrix* gsl_vector* gsl_matrix* gsl_eigen_symmv_workspace*))
+ (gsl_eigen_herm_workspace* gsl_eigen_herm_alloc (size_t))
+ (void gsl_eigen_herm_free (gsl_eigen_herm_workspace*))
+ (int gsl_eigen_herm (gsl_matrix_complex* gsl_vector* gsl_eigen_herm_workspace*))
+ (gsl_eigen_hermv_workspace* gsl_eigen_hermv_alloc (size_t))
+ (void gsl_eigen_hermv_free (gsl_eigen_hermv_workspace*))
+ (int gsl_eigen_hermv (gsl_matrix_complex* gsl_vector* gsl_matrix_complex* gsl_eigen_hermv_workspace*))
+ (gsl_eigen_francis_workspace* gsl_eigen_francis_alloc (void))
+ (void gsl_eigen_francis_free (gsl_eigen_francis_workspace*))
+ (void gsl_eigen_francis_T (int gsl_eigen_francis_workspace*))
+ (int gsl_eigen_francis (gsl_matrix* gsl_vector_complex* gsl_eigen_francis_workspace*))
+ (int gsl_eigen_francis_Z (gsl_matrix* gsl_vector_complex* gsl_matrix* gsl_eigen_francis_workspace*))
+ (gsl_eigen_nonsymm_workspace* gsl_eigen_nonsymm_alloc (size_t))
+ (void gsl_eigen_nonsymm_free (gsl_eigen_nonsymm_workspace*))
+ (void gsl_eigen_nonsymm_params (int int gsl_eigen_nonsymm_workspace*))
+ (int gsl_eigen_nonsymm (gsl_matrix* gsl_vector_complex* gsl_eigen_nonsymm_workspace*))
+ (int gsl_eigen_nonsymm_Z (gsl_matrix* gsl_vector_complex* gsl_matrix* gsl_eigen_nonsymm_workspace*))
+ (gsl_eigen_nonsymmv_workspace* gsl_eigen_nonsymmv_alloc (size_t))
+ (void gsl_eigen_nonsymmv_free (gsl_eigen_nonsymmv_workspace*))
+ (reader-cond ((>= gsl-version 1.15) (void gsl_eigen_nonsymmv_params (int gsl_eigen_nonsymmv_workspace*))))
+ (int gsl_eigen_nonsymmv (gsl_matrix* gsl_vector_complex* gsl_matrix_complex* gsl_eigen_nonsymmv_workspace*))
+ (int gsl_eigen_nonsymmv_Z (gsl_matrix* gsl_vector_complex* gsl_matrix_complex* gsl_matrix* gsl_eigen_nonsymmv_workspace*))
+ (gsl_eigen_gensymm_workspace* gsl_eigen_gensymm_alloc (size_t))
+ (void gsl_eigen_gensymm_free (gsl_eigen_gensymm_workspace*))
+ (int gsl_eigen_gensymm (gsl_matrix* gsl_matrix* gsl_vector* gsl_eigen_gensymm_workspace*))
+ (int gsl_eigen_gensymm_standardize (gsl_matrix* gsl_matrix*))
+ (gsl_eigen_gensymmv_workspace* gsl_eigen_gensymmv_alloc (size_t))
+ (void gsl_eigen_gensymmv_free (gsl_eigen_gensymmv_workspace*))
+ (int gsl_eigen_gensymmv (gsl_matrix* gsl_matrix* gsl_vector* gsl_matrix* gsl_eigen_gensymmv_workspace*))
+ (gsl_eigen_genherm_workspace* gsl_eigen_genherm_alloc (size_t))
+ (void gsl_eigen_genherm_free (gsl_eigen_genherm_workspace*))
+ (int gsl_eigen_genherm (gsl_matrix_complex* gsl_matrix_complex* gsl_vector* gsl_eigen_genherm_workspace*))
+ (int gsl_eigen_genherm_standardize (gsl_matrix_complex* gsl_matrix_complex*))
+ (gsl_eigen_genhermv_workspace* gsl_eigen_genhermv_alloc (size_t))
+ (void gsl_eigen_genhermv_free (gsl_eigen_genhermv_workspace*))
+ (int gsl_eigen_genhermv (gsl_matrix_complex* gsl_matrix_complex* gsl_vector* gsl_matrix_complex* gsl_eigen_genhermv_workspace*))
+ (gsl_eigen_gen_workspace* gsl_eigen_gen_alloc (size_t))
+ (void gsl_eigen_gen_free (gsl_eigen_gen_workspace*))
+ (void gsl_eigen_gen_params (int int int gsl_eigen_gen_workspace*))
+ (int gsl_eigen_gen (gsl_matrix* gsl_matrix* gsl_vector_complex* gsl_vector* gsl_eigen_gen_workspace*))
+ (int gsl_eigen_gen_QZ (gsl_matrix* gsl_matrix* gsl_vector_complex* gsl_vector* gsl_matrix* gsl_matrix* gsl_eigen_gen_workspace*))
+ (gsl_eigen_genv_workspace* gsl_eigen_genv_alloc (size_t))
+ (void gsl_eigen_genv_free (gsl_eigen_genv_workspace*))
+ (int gsl_eigen_genv (gsl_matrix* gsl_matrix* gsl_vector_complex* gsl_vector* gsl_matrix_complex* gsl_eigen_genv_workspace*))
+ (int gsl_eigen_genv_QZ (gsl_matrix* gsl_matrix* gsl_vector_complex* gsl_vector* gsl_matrix_complex* gsl_matrix* gsl_matrix* gsl_eigen_genv_workspace*))
+ (int gsl_eigen_symmv_sort (gsl_vector* gsl_matrix* int))
+ (int gsl_eigen_hermv_sort (gsl_vector* gsl_matrix_complex* int))
+ (int gsl_eigen_nonsymmv_sort (gsl_vector_complex* gsl_matrix_complex* int))
+ (int gsl_eigen_gensymmv_sort (gsl_vector* gsl_matrix* int))
+ (int gsl_eigen_genhermv_sort (gsl_vector* gsl_matrix_complex* int))
+ (int gsl_eigen_genv_sort (gsl_vector_complex* gsl_vector* gsl_matrix_complex* int))
+ (int gsl_schur_gen_eigvals (gsl_matrix* gsl_matrix* double* double* double* double* double*))
+ (int gsl_schur_solve_equation (double gsl_matrix* double double double gsl_vector* gsl_vector* double* double* double))
+ (int gsl_schur_solve_equation_z (double gsl_matrix* gsl_complex* double double gsl_vector_complex* gsl_vector_complex* double* double* double))
+ (int gsl_eigen_invert_jacobi (gsl_matrix* gsl_matrix* int))
+ (in-C "static s7_pointer g_gsl_eigen_jacobi(s7_scheme *sc, s7_pointer args)
+ {
+ unsigned int ref_arg = 0;
+ return(s7_make_integer(sc, (s7_int)gsl_eigen_jacobi((gsl_matrix*)s7_c_pointer(s7_car(args)), (gsl_vector*)s7_c_pointer(s7_cadr(args)),
+ (gsl_matrix*)s7_c_pointer(s7_caddr(args)), (int)s7_integer(s7_cadddr(args)), &ref_arg)));
+ }")
+ (C-function ("gsl_eigen_jacobi" g_gsl_eigen_jacobi "" 4))
+
+ (void gsl_error (char* char* int int))
+ (void gsl_stream_printf (char* char* int char*))
+ (char* gsl_strerror (int))
+ (gsl_error_handler_t* gsl_set_error_handler (gsl_error_handler_t*))
+ (gsl_error_handler_t* gsl_set_error_handler_off (void))
+ (gsl_stream_handler_t* gsl_set_stream_handler (gsl_stream_handler_t*))
+ (FILE* gsl_set_stream (FILE*))
+
+ (int gsl_fit_linear (double* size_t double* size_t size_t double* double* double* double* double* double*))
+ (int gsl_fit_wlinear (double* size_t double* size_t double* size_t size_t double* double* double* double* double* double*))
+ (int gsl_fit_linear_est (double double double double double double double* double*))
+ (int gsl_fit_mul (double* size_t double* size_t size_t double* double* double*))
+ (int gsl_fit_wmul (double* size_t double* size_t double* size_t size_t double* double* double*))
+ (int gsl_fit_mul_est (double double double double* double*))
+
+ (gsl_histogram* gsl_histogram_alloc (size_t))
+ (gsl_histogram* gsl_histogram_calloc (size_t))
+ (gsl_histogram* gsl_histogram_calloc_uniform (size_t double double))
+ (void gsl_histogram_free (gsl_histogram*))
+ (int gsl_histogram_increment (gsl_histogram* double))
+ (int gsl_histogram_accumulate (gsl_histogram* double double))
+ (int gsl_histogram_find (gsl_histogram* double size_t*))
+ (double gsl_histogram_get (gsl_histogram* size_t))
+ (int gsl_histogram_get_range (gsl_histogram* size_t double* double*))
+ (double gsl_histogram_max (gsl_histogram*))
+ (double gsl_histogram_min (gsl_histogram*))
+ (size_t gsl_histogram_bins (gsl_histogram*))
+ (void gsl_histogram_reset (gsl_histogram*))
+ (gsl_histogram* gsl_histogram_calloc_range (size_t double*))
+ (int gsl_histogram_set_ranges (gsl_histogram* double* size_t))
+ (int gsl_histogram_set_ranges_uniform (gsl_histogram* double double))
+ (int gsl_histogram_memcpy (gsl_histogram* gsl_histogram*))
+ (gsl_histogram* gsl_histogram_clone (gsl_histogram*))
+ (double gsl_histogram_max_val (gsl_histogram*))
+ (size_t gsl_histogram_max_bin (gsl_histogram*))
+ (double gsl_histogram_min_val (gsl_histogram*))
+ (size_t gsl_histogram_min_bin (gsl_histogram*))
+ (int gsl_histogram_equal_bins_p (gsl_histogram* gsl_histogram*))
+ (int gsl_histogram_add (gsl_histogram* gsl_histogram*))
+ (int gsl_histogram_sub (gsl_histogram* gsl_histogram*))
+ (int gsl_histogram_mul (gsl_histogram* gsl_histogram*))
+ (int gsl_histogram_div (gsl_histogram* gsl_histogram*))
+ (int gsl_histogram_scale (gsl_histogram* double))
+ (int gsl_histogram_shift (gsl_histogram* double))
+ (double gsl_histogram_sigma (gsl_histogram*))
+ (double gsl_histogram_mean (gsl_histogram*))
+ (double gsl_histogram_sum (gsl_histogram*))
+ (int gsl_histogram_fwrite (FILE* gsl_histogram*) )
+ (int gsl_histogram_fread (FILE* gsl_histogram*))
+ (int gsl_histogram_fprintf (FILE* gsl_histogram* char* char*))
+ (int gsl_histogram_fscanf (FILE* gsl_histogram*))
+ (gsl_histogram_pdf* gsl_histogram_pdf_alloc (size_t))
+ (int gsl_histogram_pdf_init (gsl_histogram_pdf* gsl_histogram*))
+ (void gsl_histogram_pdf_free (gsl_histogram_pdf*))
+ (double gsl_histogram_pdf_sample (gsl_histogram_pdf* double))
+ (gsl_histogram2d* gsl_histogram2d_alloc (size_t size_t))
+ (gsl_histogram2d* gsl_histogram2d_calloc (size_t size_t))
+ (gsl_histogram2d* gsl_histogram2d_calloc_uniform (size_t size_t double double double double))
+ (void gsl_histogram2d_free (gsl_histogram2d*))
+ (int gsl_histogram2d_increment (gsl_histogram2d* double double))
+ (int gsl_histogram2d_accumulate (gsl_histogram2d* double double double))
+ (int gsl_histogram2d_find (gsl_histogram2d* double double size_t* size_t*))
+ (double gsl_histogram2d_get (gsl_histogram2d* size_t size_t))
+ (int gsl_histogram2d_get_xrange (gsl_histogram2d* size_t double* double*))
+ (int gsl_histogram2d_get_yrange (gsl_histogram2d* size_t double* double*))
+ (double gsl_histogram2d_xmax (gsl_histogram2d*))
+ (double gsl_histogram2d_xmin (gsl_histogram2d*))
+ (size_t gsl_histogram2d_nx (gsl_histogram2d*))
+ (double gsl_histogram2d_ymax (gsl_histogram2d*))
+ (double gsl_histogram2d_ymin (gsl_histogram2d*))
+ (size_t gsl_histogram2d_ny (gsl_histogram2d*))
+ (void gsl_histogram2d_reset (gsl_histogram2d*))
+ (gsl_histogram2d* gsl_histogram2d_calloc_range (size_t size_t double* double*))
+ (int gsl_histogram2d_set_ranges_uniform (gsl_histogram2d* double double double double))
+ (int gsl_histogram2d_memcpy (gsl_histogram2d* gsl_histogram2d*))
+ (gsl_histogram2d* gsl_histogram2d_clone (gsl_histogram2d*))
+ (double gsl_histogram2d_max_val (gsl_histogram2d*))
+ (void gsl_histogram2d_max_bin (gsl_histogram2d* size_t* size_t*))
+ (double gsl_histogram2d_min_val (gsl_histogram2d*))
+ (void gsl_histogram2d_min_bin (gsl_histogram2d* size_t* size_t*))
+ (double gsl_histogram2d_xmean (gsl_histogram2d*))
+ (double gsl_histogram2d_ymean (gsl_histogram2d*))
+ (double gsl_histogram2d_xsigma (gsl_histogram2d*))
+ (double gsl_histogram2d_ysigma (gsl_histogram2d*))
+ (double gsl_histogram2d_cov (gsl_histogram2d*))
+ (double gsl_histogram2d_sum (gsl_histogram2d*))
+ (int gsl_histogram2d_equal_bins_p (gsl_histogram2d* gsl_histogram2d*) )
+ (int gsl_histogram2d_add (gsl_histogram2d* gsl_histogram2d*))
+ (int gsl_histogram2d_sub (gsl_histogram2d* gsl_histogram2d*))
+ (int gsl_histogram2d_mul (gsl_histogram2d* gsl_histogram2d*))
+ (int gsl_histogram2d_div (gsl_histogram2d* gsl_histogram2d*))
+ (int gsl_histogram2d_scale (gsl_histogram2d* double))
+ (int gsl_histogram2d_shift (gsl_histogram2d* double))
+ (int gsl_histogram2d_fwrite (FILE* gsl_histogram2d*) )
+ (int gsl_histogram2d_fread (FILE* gsl_histogram2d*))
+ (int gsl_histogram2d_fprintf (FILE* gsl_histogram2d* char* char*))
+ (int gsl_histogram2d_fscanf (FILE* gsl_histogram2d*))
+ (gsl_histogram2d_pdf* gsl_histogram2d_pdf_alloc (size_t size_t))
+ (int gsl_histogram2d_pdf_init (gsl_histogram2d_pdf* gsl_histogram2d*))
+ (void gsl_histogram2d_pdf_free (gsl_histogram2d_pdf*))
+ (int gsl_histogram2d_pdf_sample (gsl_histogram2d_pdf* double double double* double*))
+
+ ;(void gsl_ieee_printf_double (double*) ) ; these are ridiculous
+ ;(void gsl_ieee_fprintf_double (FILE* double*) )
+ ;(void gsl_ieee_double_to_rep (double* gsl_ieee_double_rep*) )
+ (void gsl_ieee_env_setup (void) ) ; looks for GSL_IEEE_MODE home var
+ ;(int gsl_ieee_read_mode_string (char* int* int* int*) ) ; int by ref
+ (int gsl_ieee_set_mode (int int int) )
+
+ (in-C "static s7_pointer g_gsl_deriv_central(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f;
+ make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_deriv_central(&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+ (double *)s7_c_pointer(s7_cadddr(args)), (double *)s7_c_pointer(s7_list_ref(sc, args, 4)))));
+ }
+ static s7_pointer g_gsl_deriv_backward(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f;
+ make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_deriv_backward(&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+ (double *)s7_c_pointer(s7_cadddr(args)), (double *)s7_c_pointer(s7_list_ref(sc, args, 4)))));
+ }
+ static s7_pointer g_gsl_deriv_forward(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f;
+ make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_deriv_forward(&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+ (double *)s7_c_pointer(s7_cadddr(args)), (double *)s7_c_pointer(s7_list_ref(sc, args, 4)))));
+ }
+ ")
+ (C-function ("gsl_deriv_central" g_gsl_deriv_central "" 5))
+ (C-function ("gsl_deriv_backward" g_gsl_deriv_backward "" 5))
+ (C-function ("gsl_deriv_forward" g_gsl_deriv_forward "" 5))
+
+
+ (gsl_integration_workspace* gsl_integration_workspace_alloc (size_t))
+ (void gsl_integration_workspace_free (gsl_integration_workspace*))
+ (gsl_integration_qaws_table* gsl_integration_qaws_table_alloc (double double int int))
+ (int gsl_integration_qaws_table_set (gsl_integration_qaws_table* double double int int))
+ (void gsl_integration_qaws_table_free (gsl_integration_qaws_table*))
+ (gsl_integration_qawo_table* gsl_integration_qawo_table_alloc (double double int size_t))
+ (int gsl_integration_qawo_table_set (gsl_integration_qawo_table* double double int))
+ (int gsl_integration_qawo_table_set_length (gsl_integration_qawo_table* double))
+ (void gsl_integration_qawo_table_free (gsl_integration_qawo_table*))
+
+ (in-C "#define Integration(Name) \
+ static s7_pointer g_gsl_integration_ ## Name (s7_scheme *sc, s7_pointer args) \
+ { \
+ gsl_function gsl_f; \
+ make_gsl_function(s7_car(args)); \
+ gsl_integration_ ## Name (&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)), \
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 3)), (double *)s7_c_pointer(s7_list_ref(sc, args, 4)), \
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 5)), (double *)s7_c_pointer(s7_list_ref(sc, args, 6))); \
+ return(s7_car(args)); \
+ }
+ Integration(qk15)
+ Integration(qk21)
+ Integration(qk31)
+ Integration(qk41)
+ Integration(qk51)
+ Integration(qk61)
+ ")
+ (C-function ("gsl_integration_qk15" g_gsl_integration_qk15 "" 7))
+ (C-function ("gsl_integration_qk21" g_gsl_integration_qk21 "" 7))
+ (C-function ("gsl_integration_qk31" g_gsl_integration_qk31 "" 7))
+ (C-function ("gsl_integration_qk41" g_gsl_integration_qk41 "" 7))
+ (C-function ("gsl_integration_qk51" g_gsl_integration_qk51 "" 7))
+ (C-function ("gsl_integration_qk61" g_gsl_integration_qk61 "" 7))
+
+ (in-C "static s7_pointer g_gsl_integration_qcheb(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ gsl_integration_qcheb(&gsl_f, s7_real(s7_cadr(args)), s7_real(s7_caddr(args)),
+ (double *)s7_c_pointer(s7_cadddr(args)), (double *)s7_c_pointer(s7_list_ref(sc, args, 4)));
+ return(s7_car(args));
+ }
+ static s7_pointer g_gsl_integration_qng(s7_scheme *sc, s7_pointer args)
+ {
+ size_t ref;
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qng(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 5)), (double *)s7_c_pointer(s7_list_ref(sc, args, 6)),
+ &ref)));
+ }
+ static s7_pointer g_gsl_integration_qag(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qag(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 5)), (int)s7_integer(s7_list_ref(sc, args, 6)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 7)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 8)), (double *)s7_c_pointer(s7_list_ref(sc, args, 9)))));
+ }
+ static s7_pointer g_gsl_integration_qagi(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qagi(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 3)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 4)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 5)), (double *)s7_c_pointer(s7_list_ref(sc, args, 6)))));
+ }
+ static s7_pointer g_gsl_integration_qagiu(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qagiu(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)), s7_real(s7_list_ref(sc, args, 3)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 4)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 5)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 6)), (double *)s7_c_pointer(s7_list_ref(sc, args, 7)))));
+ }
+ static s7_pointer g_gsl_integration_qagil(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qagil(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)), s7_real(s7_list_ref(sc, args, 3)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 4)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 5)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 6)), (double *)s7_c_pointer(s7_list_ref(sc, args, 7)))));
+ }
+ static s7_pointer g_gsl_integration_qags(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qags(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 5)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 6)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 7)), (double *)s7_c_pointer(s7_list_ref(sc, args, 8)))));
+ }
+ static s7_pointer g_gsl_integration_qagp(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qagp(&gsl_f, (double *)s7_c_pointer(s7_list_ref(sc, args, 1)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 2)),
+ s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 5)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 6)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 7)), (double *)s7_c_pointer(s7_list_ref(sc, args, 8)))));
+ }
+ static s7_pointer g_gsl_integration_qawc(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qawc(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ s7_real(s7_list_ref(sc, args, 3)), s7_real(s7_list_ref(sc, args, 4)),
+ s7_real(s7_list_ref(sc, args, 5)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 6)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 7)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 8)), (double *)s7_c_pointer(s7_list_ref(sc, args, 9)))));
+ }
+ static s7_pointer g_gsl_integration_qaws(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qaws(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ (gsl_integration_qaws_table *)s7_c_pointer(s7_list_ref(sc, args, 3)),
+ s7_real(s7_list_ref(sc, args, 4)), s7_real(s7_list_ref(sc, args, 5)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 6)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 7)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 8)), (double *)s7_c_pointer(s7_list_ref(sc, args, 9)))));
+ }
+ static s7_pointer g_gsl_integration_qawo(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qawo(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ s7_real(s7_list_ref(sc, args, 3)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 4)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 5)),
+ (gsl_integration_qawo_table *)s7_c_pointer(s7_list_ref(sc, args, 6)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 7)), (double *)s7_c_pointer(s7_list_ref(sc, args, 8)))));
+ }
+ static s7_pointer g_gsl_integration_qawf(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_integer(sc, gsl_integration_qawf(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ (size_t)s7_integer(s7_list_ref(sc, args, 3)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 4)),
+ (gsl_integration_workspace *)s7_c_pointer(s7_list_ref(sc, args, 5)),
+ (gsl_integration_qawo_table *)s7_c_pointer(s7_list_ref(sc, args, 6)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 7)), (double *)s7_c_pointer(s7_list_ref(sc, args, 8)))));
+ }
+ static s7_pointer g_gsl_integration_glfixed(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_car(args));
+ return(s7_make_real(sc, gsl_integration_glfixed(&gsl_f,
+ s7_real(s7_list_ref(sc, args, 1)), s7_real(s7_list_ref(sc, args, 2)),
+ (const gsl_integration_glfixed_table *)s7_c_pointer(s7_list_ref(sc, args, 3)))));
+ }
+ static s7_pointer g_gsl_integration_qk(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_function gsl_f; make_gsl_function(s7_list_ref(sc, args, 6));
+ gsl_integration_qk((int)s7_integer(s7_car(args)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 1)), (double *)s7_c_pointer(s7_list_ref(sc, args, 2)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 3)), (double *)s7_c_pointer(s7_list_ref(sc, args, 4)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 5)),
+ &gsl_f,
+ s7_real(s7_list_ref(sc, args, 7)), s7_real(s7_list_ref(sc, args, 8)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 9)), (double *)s7_c_pointer(s7_list_ref(sc, args, 10)),
+ (double *)s7_c_pointer(s7_list_ref(sc, args, 11)), (double *)s7_c_pointer(s7_list_ref(sc, args, 12)));
+ return(s7_car(args));
+ }")
+ (C-function ("gsl_integration_qcheb" g_gsl_integration_qcheb "" 5))
+ (C-function ("gsl_integration_qng" g_gsl_integration_qng "" 7))
+ (C-function ("gsl_integration_qag" g_gsl_integration_qag "" 10))
+ (C-function ("gsl_integration_qagi" g_gsl_integration_qagi "" 7))
+ (C-function ("gsl_integration_qagiu" g_gsl_integration_qagiu "" 8))
+ (C-function ("gsl_integration_qagil" g_gsl_integration_qagil "" 8))
+ (C-function ("gsl_integration_qags" g_gsl_integration_qags "" 9))
+ (C-function ("gsl_integration_qagp" g_gsl_integration_qagp "" 9))
+ (C-function ("gsl_integration_qawc" g_gsl_integration_qawc "" 10))
+ (C-function ("gsl_integration_qaws" g_gsl_integration_qaws "" 10))
+ (C-function ("gsl_integration_qawo" g_gsl_integration_qawo "" 9))
+ (C-function ("gsl_integration_qawf" g_gsl_integration_qawf "" 9))
+ (C-function ("gsl_integration_qk" g_gsl_integration_qk "" 13))
+ (C-function ("gsl_integration_glfixed" g_gsl_integration_glfixed "" 4))
+
+ (gsl_integration_glfixed_table* gsl_integration_glfixed_table_alloc (size_t))
+ (void gsl_integration_glfixed_table_free (gsl_integration_glfixed_table*))
+ (reader-cond ((>= gsl-version 1.15)
+ (int gsl_integration_glfixed_point (double double size_t double* double* gsl_integration_glfixed_table*))
+ (gsl_integration_cquad_workspace* gsl_integration_cquad_workspace_alloc (size_t))
+ (void gsl_integration_cquad_workspace_free (gsl_integration_cquad_workspace*))))
+
+ (int gsl_linalg_matmult (gsl_matrix* gsl_matrix* gsl_matrix*))
+ (int gsl_linalg_matmult_mod (gsl_matrix* int gsl_matrix* int gsl_matrix*))
+ (int gsl_linalg_exponential_ss (gsl_matrix* gsl_matrix* int))
+ (double gsl_linalg_householder_transform (gsl_vector*))
+ (int gsl_linalg_householder_hm (double gsl_vector* gsl_matrix*))
+ (int gsl_linalg_householder_mh (double gsl_vector* gsl_matrix*))
+ (int gsl_linalg_householder_hv (double gsl_vector* gsl_vector*))
+ (int gsl_linalg_householder_hm1 (double gsl_matrix*))
+
+ (in-C "static s7_pointer g_gsl_linalg_complex_householder_transform(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ g = gsl_linalg_complex_householder_transform((gsl_vector_complex *)s7_c_pointer(s7_car(args)));
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ static s7_pointer g_gsl_linalg_complex_householder_hm(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ S7_TO_GSL_COMPLEX(s7_car(args), g);
+ return(s7_make_integer(sc, gsl_linalg_complex_householder_hm(g, (gsl_vector_complex *)s7_c_pointer(s7_cadr(args)),
+ (gsl_matrix_complex *)s7_c_pointer(s7_caddr(args)))));
+ }
+ static s7_pointer g_gsl_linalg_complex_householder_mh(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ S7_TO_GSL_COMPLEX(s7_car(args), g);
+ return(s7_make_integer(sc, gsl_linalg_complex_householder_mh(g, (gsl_vector_complex *)s7_c_pointer(s7_cadr(args)),
+ (gsl_matrix_complex *)s7_c_pointer(s7_caddr(args)))));
+ }
+ static s7_pointer g_gsl_linalg_complex_householder_hv(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ S7_TO_GSL_COMPLEX(s7_car(args), g);
+ return(s7_make_integer(sc, gsl_linalg_complex_householder_hv(g, (gsl_vector_complex *)s7_c_pointer(s7_cadr(args)),
+ (gsl_vector_complex *)s7_c_pointer(s7_caddr(args)))));
+ }
+ static s7_pointer g_gsl_linalg_complex_LU_det(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ g = gsl_linalg_complex_LU_det((gsl_matrix_complex *)s7_c_pointer(s7_car(args)), (int)s7_integer(s7_cadr(args)));
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ static s7_pointer g_gsl_linalg_complex_LU_sgndet(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ g = gsl_linalg_complex_LU_sgndet((gsl_matrix_complex *)s7_c_pointer(s7_car(args)), (int)s7_integer(s7_cadr(args)));
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ ")
+ (C-function ("gsl_linalg_complex_householder_transform" g_gsl_linalg_complex_householder_transform "" 1))
+ (C-function ("gsl_linalg_complex_householder_hm" g_gsl_linalg_complex_householder_hm "" 3))
+ (C-function ("gsl_linalg_complex_householder_mh" g_gsl_linalg_complex_householder_mh "" 3))
+ (C-function ("gsl_linalg_complex_householder_hv" g_gsl_linalg_complex_householder_hv "" 3))
+ (C-function ("gsl_linalg_complex_LU_det" g_gsl_linalg_complex_LU_det "" 2))
+ (C-function ("gsl_linalg_complex_LU_sgndet" g_gsl_linalg_complex_LU_sgndet "" 2))
+
+ (int gsl_linalg_hessenberg_decomp (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_hessenberg_unpack (gsl_matrix* gsl_vector* gsl_matrix*))
+ (int gsl_linalg_hessenberg_unpack_accum (gsl_matrix* gsl_vector* gsl_matrix*))
+ (int gsl_linalg_hessenberg_set_zero (gsl_matrix*))
+ (int gsl_linalg_hessenberg_submatrix (gsl_matrix* gsl_matrix* size_t gsl_vector*))
+ (int gsl_linalg_hessenberg (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_hesstri_decomp (gsl_matrix* gsl_matrix* gsl_matrix* gsl_matrix* gsl_vector*))
+ (int gsl_linalg_SV_decomp (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_SV_decomp_mod (gsl_matrix* gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_SV_decomp_jacobi (gsl_matrix* gsl_matrix* gsl_vector*))
+ (int gsl_linalg_SV_solve (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+ (reader-cond ((>= gsl-version 1.16) (int gsl_linalg_SV_leverage (gsl_matrix* gsl_vector*))))
+ (in-C "static s7_pointer g_gsl_linalg_LU_decomp(s7_scheme *sc, s7_pointer args)
+ {
+ int s = 0;
+ return(s7_make_integer(sc, (s7_int)gsl_linalg_LU_decomp((gsl_matrix *)s7_c_pointer(s7_car(args)),
+ (gsl_permutation *)s7_c_pointer(s7_cadr(args)), &s)));
+ }")
+ (C-function ("gsl_linalg_LU_decomp" g_gsl_linalg_LU_decomp "" 2))
+ (int gsl_linalg_LU_solve (gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LU_svx (gsl_matrix* gsl_permutation* gsl_vector*))
+ (int gsl_linalg_LU_refine (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LU_invert (gsl_matrix* gsl_permutation* gsl_matrix*))
+ (double gsl_linalg_LU_det (gsl_matrix* int))
+ (double gsl_linalg_LU_lndet (gsl_matrix*))
+ (int gsl_linalg_LU_sgndet (gsl_matrix* int))
+ (in-C "static s7_pointer g_gsl_linalg_complex_LU_decomp(s7_scheme *sc, s7_pointer args)
+ {
+ int s = 0;
+ return(s7_make_integer(sc, (s7_int)gsl_linalg_complex_LU_decomp((gsl_matrix_complex *)s7_c_pointer(s7_car(args)),
+ (gsl_permutation *)s7_c_pointer(s7_cadr(args)), &s)));
+ }")
+ (C-function ("gsl_linalg_complex_LU_decomp" g_gsl_linalg_complex_LU_decomp "" 2))
+ (int gsl_linalg_complex_LU_solve (gsl_matrix_complex* gsl_permutation* gsl_vector_complex* gsl_vector_complex*))
+ (int gsl_linalg_complex_LU_svx (gsl_matrix_complex* gsl_permutation* gsl_vector_complex*))
+ (int gsl_linalg_complex_LU_refine (gsl_matrix_complex* gsl_matrix_complex* gsl_permutation* gsl_vector_complex* gsl_vector_complex* gsl_vector_complex*))
+ (int gsl_linalg_complex_LU_invert (gsl_matrix_complex* gsl_permutation* gsl_matrix_complex*))
+ (double gsl_linalg_complex_LU_lndet (gsl_matrix_complex*))
+ (int gsl_linalg_QR_decomp (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_QR_solve (gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QR_svx (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QR_lssolve (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QR_QRsolve (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QR_Rsolve (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QR_Rsvx (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_QR_update (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QR_QTvec (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QR_Qvec (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QR_QTmat (gsl_matrix* gsl_vector* gsl_matrix*))
+ (reader-cond ((>= gsl-version 2.0)
+ (int gsl_linalg_QR_matQ (gsl_matrix* gsl_vector* gsl_matrix*))
+ (void gsl_linalg_givens (double double double* double*))
+ (void gsl_linalg_givens_gv (gsl_vector* size_t size_t double double))))
+ (int gsl_linalg_QR_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_matrix*))
+ (int gsl_linalg_R_solve (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_R_svx (gsl_matrix* gsl_vector*))
+ (in-C "static s7_pointer g_gsl_linalg_QRPT_decomp(s7_scheme *sc, s7_pointer args)
+ {
+ int s = 0;
+ return(s7_make_integer(sc, (s7_int)gsl_linalg_QRPT_decomp((gsl_matrix *)s7_c_pointer(s7_car(args)),
+ (gsl_vector *)s7_c_pointer(s7_cadr(args)), (gsl_permutation *)s7_c_pointer(s7_caddr(args)), &s,
+ (gsl_vector *)s7_c_pointer(s7_cadddr(args)))));
+ }")
+ (C-function ("gsl_linalg_QRPT_decomp" g_gsl_linalg_QRPT_decomp "" 4))
+ (in-C "static s7_pointer g_gsl_linalg_QRPT_decomp2(s7_scheme *sc, s7_pointer args)
+ {
+ int s = 0;
+ return(s7_make_integer(sc, (s7_int)gsl_linalg_QRPT_decomp2((gsl_matrix *)s7_c_pointer(s7_car(args)), (gsl_matrix *)s7_c_pointer(s7_cadr(args)),
+ (gsl_matrix *)s7_c_pointer(s7_caddr(args)),
+ (gsl_vector *)s7_c_pointer(s7_cadddr(args)), (gsl_permutation *)s7_c_pointer(s7_list_ref(sc, args, 4)), &s,
+ (gsl_vector *)s7_c_pointer(s7_list_ref(sc, args, 5)))));
+ }")
+ (C-function ("gsl_linalg_QRPT_decomp2" g_gsl_linalg_QRPT_decomp2 "" 6))
+ (int gsl_linalg_QRPT_solve (gsl_matrix* gsl_vector* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QRPT_svx (gsl_matrix* gsl_vector* gsl_permutation* gsl_vector*))
+ (int gsl_linalg_QRPT_QRsolve (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QRPT_Rsolve (gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_QRPT_Rsvx (gsl_matrix* gsl_permutation* gsl_vector*))
+ (int gsl_linalg_QRPT_update (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_decomp (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_LQ_solve_T (gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_svx_T (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_lssolve_T (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_Lsolve_T (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_Lsvx_T (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_L_solve_T (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_vecQ (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_vecQT (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_matrix*))
+ (int gsl_linalg_LQ_update (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_LQ_LQsolve (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector*))
+ (in-C "static s7_pointer g_gsl_linalg_PTLQ_decomp(s7_scheme *sc, s7_pointer args)
+ {
+ int s = 0;
+ return(s7_make_integer(sc, (s7_int)gsl_linalg_PTLQ_decomp((gsl_matrix *)s7_c_pointer(s7_car(args)),
+ (gsl_vector *)s7_c_pointer(s7_cadr(args)), (gsl_permutation *)s7_c_pointer(s7_caddr(args)), &s,
+ (gsl_vector *)s7_c_pointer(s7_cadddr(args)))));
+ }")
+ (C-function ("gsl_linalg_PTLQ_decomp" g_gsl_linalg_PTLQ_decomp "" 4))
+ (in-C "static s7_pointer g_gsl_linalg_PTLQ_decomp2(s7_scheme *sc, s7_pointer args)
+ {
+ int s = 0;
+ return(s7_make_integer(sc, (s7_int)gsl_linalg_PTLQ_decomp2((gsl_matrix *)s7_c_pointer(s7_car(args)), (gsl_matrix *)s7_c_pointer(s7_cadr(args)),
+ (gsl_matrix *)s7_c_pointer(s7_caddr(args)),
+ (gsl_vector *)s7_c_pointer(s7_cadddr(args)), (gsl_permutation *)s7_c_pointer(s7_list_ref(sc, args, 4)), &s,
+ (gsl_vector *)s7_c_pointer(s7_list_ref(sc, args, 5)))));
+ }")
+ (C-function ("gsl_linalg_PTLQ_decomp2" g_gsl_linalg_PTLQ_decomp2 "" 6))
+ (int gsl_linalg_PTLQ_solve_T (gsl_matrix* gsl_vector* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_PTLQ_svx_T (gsl_matrix* gsl_vector* gsl_permutation* gsl_vector*))
+ (int gsl_linalg_PTLQ_LQsolve_T (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_PTLQ_Lsolve_T (gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_PTLQ_Lsvx_T (gsl_matrix* gsl_permutation* gsl_vector*))
+ (int gsl_linalg_PTLQ_update (gsl_matrix* gsl_matrix* gsl_permutation* gsl_vector* gsl_vector*))
+ (int gsl_linalg_cholesky_decomp (gsl_matrix*))
+ (int gsl_linalg_cholesky_solve (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_cholesky_svx (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_cholesky_invert (gsl_matrix*))
+ (int gsl_linalg_cholesky_decomp_unit (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_complex_cholesky_decomp (gsl_matrix_complex*))
+ (int gsl_linalg_complex_cholesky_solve (gsl_matrix_complex* gsl_vector_complex* gsl_vector_complex*))
+ (int gsl_linalg_complex_cholesky_svx (gsl_matrix_complex* gsl_vector_complex*))
+ (reader-cond ((>= gsl-version 1.15) (int gsl_linalg_complex_cholesky_invert (gsl_matrix_complex*))))
+ (int gsl_linalg_symmtd_decomp (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_symmtd_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_symmtd_unpack_T (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_hermtd_decomp (gsl_matrix_complex* gsl_vector_complex*))
+ (int gsl_linalg_hermtd_unpack (gsl_matrix_complex* gsl_vector_complex* gsl_matrix_complex* gsl_vector* gsl_vector*))
+ (int gsl_linalg_hermtd_unpack_T (gsl_matrix_complex* gsl_vector* gsl_vector*))
+ (int gsl_linalg_HH_solve (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_HH_svx (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_solve_symm_tridiag (gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_solve_tridiag (gsl_vector* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_solve_symm_cyc_tridiag (gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_solve_cyc_tridiag (gsl_vector* gsl_vector* gsl_vector* gsl_vector* gsl_vector*))
+ (int gsl_linalg_bidiag_decomp (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_bidiag_unpack (gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_bidiag_unpack2 (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix*))
+ (int gsl_linalg_bidiag_unpack_B (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_linalg_balance_matrix (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_balance_accum (gsl_matrix* gsl_vector*))
+ (int gsl_linalg_balance_columns (gsl_matrix* gsl_vector*))
+
+ (gsl_matrix_complex* gsl_matrix_complex_alloc (size_t size_t))
+ (gsl_matrix_complex* gsl_matrix_complex_calloc (size_t size_t))
+ (gsl_matrix_complex* gsl_matrix_complex_alloc_from_matrix (gsl_matrix_complex* size_t size_t size_t size_t))
+ (gsl_vector_complex* gsl_vector_complex_alloc_row_from_matrix (gsl_matrix_complex* size_t))
+ (gsl_vector_complex* gsl_vector_complex_alloc_col_from_matrix (gsl_matrix_complex* size_t))
+ (gsl_vector_complex* gsl_vector_complex_alloc (size_t))
+ (void gsl_vector_complex_free (gsl_vector_complex*))
+ (void gsl_matrix_complex_free (gsl_matrix_complex*))
+ (void gsl_matrix_complex_set_zero (gsl_matrix_complex*))
+ (void gsl_matrix_complex_set_identity (gsl_matrix_complex*))
+ (int gsl_matrix_complex_fread (FILE* gsl_matrix_complex*) )
+ (int gsl_matrix_complex_fwrite (FILE* gsl_matrix_complex*) )
+ (int gsl_matrix_complex_fscanf (FILE* gsl_matrix_complex*))
+ (int gsl_matrix_complex_fprintf (FILE* gsl_matrix_complex* char*))
+ (int gsl_matrix_complex_memcpy (gsl_matrix_complex* gsl_matrix_complex*))
+ (int gsl_matrix_complex_swap (gsl_matrix_complex* gsl_matrix_complex*))
+ (int gsl_matrix_complex_swap_rows (gsl_matrix_complex* size_t size_t))
+ (int gsl_matrix_complex_swap_columns (gsl_matrix_complex* size_t size_t))
+ (int gsl_matrix_complex_swap_rowcol (gsl_matrix_complex* size_t size_t))
+ (int gsl_matrix_complex_transpose (gsl_matrix_complex*))
+ (int gsl_matrix_complex_transpose_memcpy (gsl_matrix_complex* gsl_matrix_complex*))
+ (reader-cond ((>= gsl-version 1.15) (int gsl_matrix_complex_equal (gsl_matrix_complex* gsl_matrix_complex*))))
+ (int gsl_matrix_complex_isnull (gsl_matrix_complex*))
+ (int gsl_matrix_complex_ispos (gsl_matrix_complex*))
+ (int gsl_matrix_complex_isneg (gsl_matrix_complex*))
+ (int gsl_matrix_complex_isnonneg (gsl_matrix_complex*))
+ (int gsl_matrix_complex_add (gsl_matrix_complex* gsl_matrix_complex*))
+ (int gsl_matrix_complex_sub (gsl_matrix_complex* gsl_matrix_complex*))
+ (int gsl_matrix_complex_mul_elements (gsl_matrix_complex* gsl_matrix_complex*))
+ (int gsl_matrix_complex_div_elements (gsl_matrix_complex* gsl_matrix_complex*))
+
+ (in-C "static s7_pointer g_gsl_matrix_complex_set_all(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ S7_TO_GSL_COMPLEX(s7_cadr(args), g);
+ gsl_matrix_complex_set_all((gsl_matrix_complex *)s7_c_pointer(s7_car(args)), g);
+ return(s7_cadr(args));
+ }
+ static s7_pointer g_gsl_matrix_complex_set(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ s7_pointer cg;
+ cg = s7_cadddr(args);
+ S7_TO_GSL_COMPLEX(cg, g);
+ gsl_matrix_complex_set((gsl_matrix_complex *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)), g);
+ return(cg);
+ }
+ static s7_pointer g_gsl_matrix_complex_get(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ g = gsl_matrix_complex_get((gsl_matrix_complex *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)));
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ static s7_pointer g_gsl_matrix_complex_scale(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ S7_TO_GSL_COMPLEX(s7_cadr(args), g);
+ return(s7_make_integer(sc, gsl_matrix_complex_scale((gsl_matrix_complex *)s7_c_pointer(s7_car(args)), g)));
+ }
+ static s7_pointer g_gsl_matrix_complex_add_constant(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ S7_TO_GSL_COMPLEX(s7_cadr(args), g);
+ return(s7_make_integer(sc, gsl_matrix_complex_add_constant((gsl_matrix_complex *)s7_c_pointer(s7_car(args)), g)));
+ }
+ static s7_pointer g_gsl_matrix_complex_add_diagonal(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ S7_TO_GSL_COMPLEX(s7_cadr(args), g);
+ return(s7_make_integer(sc, gsl_matrix_complex_add_diagonal((gsl_matrix_complex *)s7_c_pointer(s7_car(args)), g)));
+ }
+ static s7_pointer g_gsl_vector_complex_get(s7_scheme *sc, s7_pointer args)
+ {
+ gsl_complex g;
+ g = gsl_vector_complex_get((gsl_vector_complex *)s7_c_pointer(s7_car(args)), s7_integer(s7_cadr(args)));
+ return(GSL_TO_S7_COMPLEX(sc, g));
+ }
+ ")
+ (C-function ("gsl_matrix_complex_set_all" g_gsl_matrix_complex_set_all "" 2))
+ (C-function ("gsl_matrix_complex_set" g_gsl_matrix_complex_set "" 4))
+ (C-function ("gsl_matrix_complex_get" g_gsl_matrix_complex_get "" 3))
+ (C-function ("gsl_vector_complex_get" g_gsl_vector_complex_get "" 2))
+ (C-function ("gsl_matrix_complex_scale" g_gsl_matrix_complex_scale "" 2))
+ (C-function ("gsl_matrix_complex_add_constant" g_gsl_matrix_complex_add_constant "" 2))
+ (C-function ("gsl_matrix_complex_add_diagonal" g_gsl_matrix_complex_add_diagonal "" 2))
+
+ (int gsl_matrix_complex_get_row (gsl_vector_complex* gsl_matrix_complex* size_t))
+ (int gsl_matrix_complex_get_col (gsl_vector_complex* gsl_matrix_complex* size_t))
+ (int gsl_matrix_complex_set_row (gsl_matrix_complex* size_t gsl_vector_complex*))
+ (int gsl_matrix_complex_set_col (gsl_matrix_complex* size_t gsl_vector_complex*))
+ (gsl_complex* gsl_matrix_complex_ptr (gsl_matrix_complex* size_t size_t))
+ (gsl_complex* gsl_matrix_complex_const_ptr (gsl_matrix_complex* size_t size_t))
+
+ (void gsl_message (char* char* int int))
+
+ (gsl_min_fminimizer* gsl_min_fminimizer_alloc (gsl_min_fminimizer_type*) )
+ (void gsl_min_fminimizer_free (gsl_min_fminimizer*))
+ (int gsl_min_fminimizer_set (gsl_min_fminimizer* gsl_function* double double double))
+ (int gsl_min_fminimizer_set_with_values (gsl_min_fminimizer* gsl_function* double double double double double double))
+ (int gsl_min_fminimizer_iterate (gsl_min_fminimizer*))
+ (char* gsl_min_fminimizer_name (gsl_min_fminimizer*))
+ (double gsl_min_fminimizer_x_minimum (gsl_min_fminimizer*))
+ (double gsl_min_fminimizer_x_lower (gsl_min_fminimizer*))
+ (double gsl_min_fminimizer_x_upper (gsl_min_fminimizer*))
+ (double gsl_min_fminimizer_f_minimum (gsl_min_fminimizer*))
+ (double gsl_min_fminimizer_f_lower (gsl_min_fminimizer*))
+ (double gsl_min_fminimizer_f_upper (gsl_min_fminimizer*))
+ (double gsl_min_fminimizer_minimum (gsl_min_fminimizer*))
+ (int gsl_min_test_interval (double double double double))
+ (int gsl_min_find_bracket (gsl_function* double* double* double* double* double* double* size_t))
+
+ ;; gsl_monte* is not doable -- they chose to pass a bare double* array to the (parameter) gsl_monte_function,
+ ;; and there's nothing I can do with that. To wrap and unwrap it on every call would make it unusable.
+ ;; I could keep wrappers around of all so-far-used sizes, but not until someone actually needs them.
+ ;; the fdf cases [removed in gsl 2.0?] are similar, I think, and the ode functions. GSL also assumes direct access to their
+ ;; structs (as in matrix size1/2) -- not very nice for our style of use.
+
+ (gsl_multifit_linear_workspace* gsl_multifit_linear_alloc (size_t size_t))
+ (void gsl_multifit_linear_free (gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_wlinear (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_wlinear_svd (gsl_matrix* gsl_vector* gsl_vector* double size_t* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_wlinear_usvd (gsl_matrix* gsl_vector* gsl_vector* double size_t* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_est (gsl_vector* gsl_vector* gsl_matrix* double* double*))
+ (int gsl_multifit_linear_residuals (gsl_matrix* gsl_vector* gsl_vector* gsl_vector*))
+ (reader-cond ((>= gsl-version 1.16)
+ (gsl_multifit_robust_workspace* gsl_multifit_robust_alloc (gsl_multifit_robust_type* size_t size_t))
+ (void gsl_multifit_robust_free (gsl_multifit_robust_workspace*))
+ (int gsl_multifit_robust_tune (double gsl_multifit_robust_workspace*))
+ (char* gsl_multifit_robust_name (gsl_multifit_robust_workspace*))
+ (gsl_multifit_robust_stats gsl_multifit_robust_statistics (gsl_multifit_robust_workspace*))
+ (int gsl_multifit_robust (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_multifit_robust_workspace*))
+ (int gsl_multifit_robust_est (gsl_vector* gsl_vector* gsl_matrix* double* double*))
+ (int gsl_multifit_fsolver_driver (gsl_multifit_fsolver* size_t double double))))
+ (int gsl_multifit_gradient (gsl_matrix* gsl_vector* gsl_vector*))
+ (int gsl_multifit_covar (gsl_matrix* double gsl_matrix*))
+ (gsl_multifit_fsolver* gsl_multifit_fsolver_alloc (gsl_multifit_fsolver_type* size_t size_t))
+ (void gsl_multifit_fsolver_free (gsl_multifit_fsolver*))
+ (int gsl_multifit_fsolver_set (gsl_multifit_fsolver* gsl_multifit_function* gsl_vector*))
+ (int gsl_multifit_fsolver_iterate (gsl_multifit_fsolver*))
+ (char* gsl_multifit_fsolver_name (gsl_multifit_fsolver*))
+ (gsl_vector* gsl_multifit_fsolver_position (gsl_multifit_fsolver*))
+ (int gsl_multifit_test_delta (gsl_vector* gsl_vector* double double))
+ (int gsl_multifit_test_gradient (gsl_vector* double))
+
+ (reader-cond ((< gsl-version 2.0)
+ (int gsl_multifit_linear_svd (gsl_matrix* gsl_vector* double size_t* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_usvd (gsl_matrix* gsl_vector* double size_t* gsl_vector* gsl_matrix* double* gsl_multifit_linear_workspace*)))
+ (#t
+ (int gsl_multifit_linear_svd (gsl_matrix* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_bsvd (gsl_matrix* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_solve (double gsl_matrix* gsl_vector* gsl_vector* double* double* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_applyW (gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_stdform1 (gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_wstdform1 (gsl_vector* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_stdform2 (gsl_matrix* gsl_matrix* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_wstdform2 (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_matrix* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_genform1 (gsl_vector* gsl_vector* gsl_vector* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_genform2 (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_wgenform2 (gsl_matrix* gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_matrix* gsl_vector* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_lreg (double double gsl_vector*))
+ (int gsl_multifit_linear_lcurve (gsl_vector* gsl_vector* gsl_vector* gsl_vector* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_linear_lcorner (gsl_vector* gsl_vector* size_t*))
+ (int gsl_multifit_linear_lcorner2 (gsl_vector* gsl_vector* size_t*))
+ (int gsl_multifit_linear_Lk (size_t size_t gsl_matrix*))
+ (int gsl_multifit_linear_Lsobolev (size_t size_t gsl_vector* gsl_matrix* gsl_multifit_linear_workspace*))
+ (int gsl_multifit_robust_maxiter (size_t gsl_multifit_robust_workspace*))
+ (int gsl_multifit_robust_weights (gsl_vector* gsl_vector* gsl_multifit_robust_workspace*))
+ (int gsl_multifit_robust_residuals (gsl_matrix* gsl_vector* gsl_vector* gsl_vector* gsl_multifit_robust_workspace*))
+ (int gsl_multifit_covar_QRPT (gsl_matrix* gsl_permutation* double gsl_matrix*))))
+
+ (gsl_multimin_fminimizer* gsl_multimin_fminimizer_alloc (gsl_multimin_fminimizer_type* size_t))
+ (void gsl_multimin_fminimizer_free (gsl_multimin_fminimizer*))
+ (char* gsl_multimin_fminimizer_name (gsl_multimin_fminimizer*))
+ (int gsl_multimin_fminimizer_iterate (gsl_multimin_fminimizer*))
+ (gsl_vector* gsl_multimin_fminimizer_x (gsl_multimin_fminimizer*))
+ (double gsl_multimin_fminimizer_minimum (gsl_multimin_fminimizer*))
+ (double gsl_multimin_fminimizer_size (gsl_multimin_fminimizer*))
+ (int gsl_multimin_test_gradient (gsl_vector* double))
+ (int gsl_multimin_test_size (double double))
+
+ ;; multimin_function is double f(gsl_vector* void*) -- so we can handle it (but not the fdf brand)
+ (in-C "static s7_scheme *gsl_mmf_s7;
+ static gsl_multimin_function gsl_mmf;
+ static double gsl_mmf_caller(const gsl_vector *x, void *p)
+ {
+ return(s7_real(s7_call(gsl_mmf_s7, (s7_pointer)p, s7_cons(gsl_mmf_s7, s7_make_c_pointer(gsl_mmf_s7, (void *)x), s7_nil(gsl_mmf_s7)))));
+ }
+ #define make_gsl_mm_function(Args, Size) do {gsl_mmf.f = gsl_mmf_caller; gsl_mmf.n = Size; gsl_mmf.params = (void *)Args; gsl_mmf_s7 = sc;} while (0)
+ static s7_pointer g_gsl_multimin_fminimizer_set(s7_scheme *sc, s7_pointer args)
+ {
+ make_gsl_mm_function(s7_cadr(args), ((gsl_vector *)s7_c_pointer(s7_caddr(args)))->size);
+ return(s7_make_integer(sc, gsl_multimin_fminimizer_set((gsl_multimin_fminimizer *)s7_c_pointer(s7_car(args)),
+ &gsl_mmf, (gsl_vector *)s7_c_pointer(s7_caddr(args)), (gsl_vector *)s7_c_pointer(s7_cadddr(args)))));
+ }
+ static s7_pointer g_gsl_multimin_diff(s7_scheme *sc, s7_pointer args)
+ {
+ make_gsl_mm_function(s7_caddr(args), ((gsl_vector *)s7_c_pointer(s7_car(args)))->size);
+ return(s7_make_integer(sc, gsl_multimin_diff(&gsl_mmf, (gsl_vector *)s7_c_pointer(s7_cadr(args)), (gsl_vector *)s7_c_pointer(s7_caddr(args)))));
+ }
+ static s7_pointer g_gsl_multimin_fminimizer_fval(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_real(sc, ((gsl_multimin_fminimizer *)s7_c_pointer(s7_car(args)))->fval));}
+ ")
+ (C-function ("gsl_multimin_fminimizer_set" g_gsl_multimin_fminimizer_set "" 4))
+ (C-function ("gsl_multimin_diff" g_gsl_multimin_diff "" 3))
+ (C-function ("gsl_multimin_fminimizer_fval" g_gsl_multimin_fminimizer_fval "" 1))
+
+
+ ;; int f(const gsl_vector* void* gsl_vector*) so the function is doable
+ (in-C "static s7_scheme *gsl_rf_s7;
+ static gsl_multiroot_function gsl_rf;
+ static int gsl_rf_caller(const gsl_vector *x, void *p, gsl_vector *y)
+ {
+ return(s7_integer(s7_call(gsl_rf_s7, (s7_pointer)p,
+ s7_cons(gsl_rf_s7, s7_make_c_pointer(gsl_rf_s7, (void *)x),
+ s7_cons(gsl_rf_s7, s7_make_c_pointer(gsl_rf_s7, (void *)y), s7_nil(gsl_rf_s7))))));
+ }
+ #define make_gsl_rf_function(Args, Size) do {gsl_rf.f = gsl_rf_caller; gsl_rf.n = Size; gsl_rf.params = (void *)Args; gsl_rf_s7 = sc;} while (0)
+ static s7_pointer g_gsl_multiroot_fsolver_set(s7_scheme *sc, s7_pointer args)
+ {
+ make_gsl_rf_function(s7_cadr(args), ((gsl_vector *)s7_c_pointer(s7_caddr(args)))->size);
+ return(s7_make_integer(sc, gsl_multiroot_fsolver_set((gsl_multiroot_fsolver *)s7_c_pointer(s7_car(args)),
+ &gsl_rf, (const gsl_vector *)s7_c_pointer(s7_caddr(args)))));
+ }
+ static s7_pointer g_gsl_multiroot_fdjacobian(s7_scheme *sc, s7_pointer args)
+ {
+ make_gsl_rf_function(s7_car(args), ((gsl_vector *)s7_c_pointer(s7_cadr(args)))->size);
+ return(s7_make_integer(sc, gsl_multiroot_fdjacobian(&gsl_rf, (gsl_vector *)s7_c_pointer(s7_cadr(args)),
+ (gsl_vector *)s7_c_pointer(s7_caddr(args)), s7_real(s7_cadddr(args)), (gsl_matrix *)s7_list_ref(sc, args, 4))));
+ }")
+ (C-function ("gsl_multiroot_fsolver_set" g_gsl_multiroot_fsolver_set "" 3))
+ (C-function ("gsl_multiroot_fdjacobian" g_gsl_multiroot_fdjacobian "" 5))
+ (gsl_multiroot_fsolver* gsl_multiroot_fsolver_alloc (gsl_multiroot_fsolver_type* size_t) )
+ (void gsl_multiroot_fsolver_free (gsl_multiroot_fsolver*))
+ (int gsl_multiroot_fsolver_iterate (gsl_multiroot_fsolver*))
+ (char* gsl_multiroot_fsolver_name (gsl_multiroot_fsolver*))
+ (gsl_vector* gsl_multiroot_fsolver_root (gsl_multiroot_fsolver*))
+ (gsl_vector* gsl_multiroot_fsolver_dx (gsl_multiroot_fsolver*))
+ (gsl_vector* gsl_multiroot_fsolver_f (gsl_multiroot_fsolver*))
+ (int gsl_multiroot_test_delta (gsl_vector* gsl_vector* double double))
+ (int gsl_multiroot_test_residual (gsl_vector* double))
+
+ (gsl_multiset* gsl_multiset_alloc (size_t size_t))
+ (gsl_multiset* gsl_multiset_calloc (size_t size_t))
+ (void gsl_multiset_init_first (gsl_multiset*))
+ (void gsl_multiset_init_last (gsl_multiset*))
+ (void gsl_multiset_free (gsl_multiset*))
+ (int gsl_multiset_memcpy (gsl_multiset* gsl_multiset*))
+ (int gsl_multiset_fread (FILE* gsl_multiset*))
+ (int gsl_multiset_fwrite (FILE* gsl_multiset*))
+ (int gsl_multiset_fscanf (FILE* gsl_multiset*))
+ (int gsl_multiset_fprintf (FILE* gsl_multiset* char*))
+ (size_t gsl_multiset_n (gsl_multiset*))
+ (size_t gsl_multiset_k (gsl_multiset*))
+ (size_t* gsl_multiset_data (gsl_multiset*))
+ (int gsl_multiset_valid (gsl_multiset*))
+ (int gsl_multiset_next (gsl_multiset*))
+ (int gsl_multiset_prev (gsl_multiset*))
+ (size_t gsl_multiset_get (gsl_multiset* size_t))
+
+ ;; the ode functions all pass bare double* arrays to the called function.
+ (gsl_permutation* gsl_permutation_alloc (size_t))
+ (gsl_permutation* gsl_permutation_calloc (size_t))
+ (void gsl_permutation_init (gsl_permutation*))
+ (void gsl_permutation_free (gsl_permutation*))
+ (int gsl_permutation_memcpy (gsl_permutation* gsl_permutation*))
+ (int gsl_permutation_fread (FILE* gsl_permutation*))
+ (int gsl_permutation_fwrite (FILE* gsl_permutation*))
+ (int gsl_permutation_fscanf (FILE* gsl_permutation*))
+ (int gsl_permutation_fprintf (FILE* gsl_permutation* char*))
+ (size_t gsl_permutation_size (gsl_permutation*))
+ (size_t* gsl_permutation_data (gsl_permutation*))
+ (int gsl_permutation_swap (gsl_permutation* size_t size_t))
+ (int gsl_permutation_valid (gsl_permutation*))
+ (void gsl_permutation_reverse (gsl_permutation*))
+ (int gsl_permutation_inverse (gsl_permutation* gsl_permutation*))
+ (int gsl_permutation_next (gsl_permutation*))
+ (int gsl_permutation_prev (gsl_permutation*))
+ (int gsl_permutation_mul (gsl_permutation* gsl_permutation* gsl_permutation*))
+ (int gsl_permutation_linear_to_canonical (gsl_permutation* gsl_permutation*))
+ (int gsl_permutation_canonical_to_linear (gsl_permutation* gsl_permutation*))
+ (size_t gsl_permutation_inversions (gsl_permutation*))
+ (size_t gsl_permutation_linear_cycles (gsl_permutation*))
+ (size_t gsl_permutation_canonical_cycles (gsl_permutation*))
+ (size_t gsl_permutation_get (gsl_permutation* size_t))
+ (int gsl_permute_complex (size_t* double* size_t size_t))
+ (int gsl_permute_complex_inverse (size_t* double* size_t size_t))
+ (int gsl_permute (size_t* double* size_t size_t))
+ (int gsl_permute_inverse (size_t* double* size_t size_t))
+ (int gsl_permute_vector_complex (gsl_permutation* gsl_vector_complex*))
+ (int gsl_permute_vector_complex_inverse (gsl_permutation* gsl_vector_complex*))
+ (int gsl_permute_vector (gsl_permutation* gsl_vector*))
+ (int gsl_permute_vector_inverse (gsl_permutation* gsl_vector*))
+
+ (gsl_root_fsolver* gsl_root_fsolver_alloc (gsl_root_fsolver_type*))
+ (void gsl_root_fsolver_free (gsl_root_fsolver*))
+ (int gsl_root_fsolver_set (gsl_root_fsolver* gsl_function* double double))
+ (int gsl_root_fsolver_iterate (gsl_root_fsolver*))
+ (char* gsl_root_fsolver_name (gsl_root_fsolver*))
+ (double gsl_root_fsolver_root (gsl_root_fsolver*))
+ (double gsl_root_fsolver_x_lower (gsl_root_fsolver*))
+ (double gsl_root_fsolver_x_upper (gsl_root_fsolver*))
+ (int gsl_root_test_interval (double double double double))
+ (int gsl_root_test_residual (double double))
+ (int gsl_root_test_delta (double double double double))
+
+ (gsl_sum_levin_u_workspace* gsl_sum_levin_u_alloc (size_t))
+ (void gsl_sum_levin_u_free (gsl_sum_levin_u_workspace*))
+ (int gsl_sum_levin_u_accel (double* size_t gsl_sum_levin_u_workspace* double* double*))
+ (int gsl_sum_levin_u_minmax (double* size_t size_t size_t gsl_sum_levin_u_workspace* double* double*))
+ (int gsl_sum_levin_u_step (double size_t size_t gsl_sum_levin_u_workspace* double*))
+ (gsl_sum_levin_utrunc_workspace* gsl_sum_levin_utrunc_alloc (size_t))
+ (void gsl_sum_levin_utrunc_free (gsl_sum_levin_utrunc_workspace*))
+ (int gsl_sum_levin_utrunc_accel (double* size_t gsl_sum_levin_utrunc_workspace* double* double*))
+ (int gsl_sum_levin_utrunc_minmax (double* size_t size_t size_t gsl_sum_levin_utrunc_workspace* double* double*))
+ (int gsl_sum_levin_utrunc_step (double size_t gsl_sum_levin_utrunc_workspace* double*))
+
+ (gsl_wavelet* gsl_wavelet_alloc (gsl_wavelet_type* size_t))
+ (void gsl_wavelet_free (gsl_wavelet*))
+ (char* gsl_wavelet_name (gsl_wavelet*))
+ (gsl_wavelet_workspace* gsl_wavelet_workspace_alloc (size_t))
+ (void gsl_wavelet_workspace_free (gsl_wavelet_workspace*))
+ (int gsl_wavelet_transform (gsl_wavelet* double* size_t size_t int gsl_wavelet_workspace*))
+ (int gsl_wavelet_transform_forward (gsl_wavelet* double* size_t size_t gsl_wavelet_workspace*))
+ (int gsl_wavelet_transform_inverse (gsl_wavelet* double* size_t size_t gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_transform (gsl_wavelet* double* size_t size_t size_t int gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_transform_forward (gsl_wavelet* double* size_t size_t size_t gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_transform_inverse (gsl_wavelet* double* size_t size_t size_t gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_nstransform (gsl_wavelet* double* size_t size_t size_t int gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_nstransform_forward (gsl_wavelet* double* size_t size_t size_t gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_nstransform_inverse (gsl_wavelet* double* size_t size_t size_t gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_transform_matrix (gsl_wavelet* gsl_matrix* int gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_transform_matrix_forward (gsl_wavelet* gsl_matrix* gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_transform_matrix_inverse (gsl_wavelet* gsl_matrix* gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_nstransform_matrix (gsl_wavelet* gsl_matrix* int gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_nstransform_matrix_forward (gsl_wavelet* gsl_matrix* gsl_wavelet_workspace*))
+ (int gsl_wavelet2d_nstransform_matrix_inverse (gsl_wavelet* gsl_matrix* gsl_wavelet_workspace*))
+
+ (reader-cond ((>= gsl-version 2.0)
+ ;; rstat
+ (gsl_rstat_quantile_workspace* gsl_rstat_quantile_alloc (double))
+ (void gsl_rstat_quantile_free (gsl_rstat_quantile_workspace*))
+ (int gsl_rstat_quantile_add (double gsl_rstat_quantile_workspace*))
+ (double gsl_rstat_quantile_get (gsl_rstat_quantile_workspace*))
+ (gsl_rstat_workspace* gsl_rstat_alloc (void))
+ (void gsl_rstat_free (gsl_rstat_workspace*))
+ (size_t gsl_rstat_n (gsl_rstat_workspace*))
+ (int gsl_rstat_add (double gsl_rstat_workspace*))
+ (double gsl_rstat_min (gsl_rstat_workspace*))
+ (double gsl_rstat_max (gsl_rstat_workspace*))
+ (double gsl_rstat_mean (gsl_rstat_workspace*))
+ (double gsl_rstat_variance (gsl_rstat_workspace*))
+ (double gsl_rstat_sd (gsl_rstat_workspace*))
+ (double gsl_rstat_sd_mean (gsl_rstat_workspace*))
+ (double gsl_rstat_median (gsl_rstat_workspace*))
+ (double gsl_rstat_skew (gsl_rstat_workspace*))
+ (double gsl_rstat_kurtosis (gsl_rstat_workspace*))
+ (int gsl_rstat_reset (gsl_rstat_workspace*))
+
+ ;; spblas
+ (int gsl_spblas_dgemv (int double gsl_spmatrix* gsl_vector* double gsl_vector*))
+ (int gsl_spblas_dgemm (double gsl_spmatrix* gsl_spmatrix* gsl_spmatrix*))
+ (size_t gsl_spblas_scatter (gsl_spmatrix* size_t double size_t* double* size_t gsl_spmatrix* size_t))
+
+ ;; splinalg
+ (c-pointer gsl_splinalg_itersolve_gmres)
+
+ (gsl_splinalg_itersolve* gsl_splinalg_itersolve_alloc (gsl_splinalg_itersolve_type* size_t size_t))
+ (void gsl_splinalg_itersolve_free (gsl_splinalg_itersolve*))
+ (char* gsl_splinalg_itersolve_name (gsl_splinalg_itersolve*))
+ (int gsl_splinalg_itersolve_iterate (gsl_spmatrix* gsl_vector* double gsl_vector* gsl_splinalg_itersolve*))
+ (double gsl_splinalg_itersolve_normr (gsl_splinalg_itersolve*))
+
+ ;; spmatrix
+ (C-macro (int (GSL_SPMATRIX_TRIPLET GSL_SPMATRIX_CCS)))
+ ;; #define GSL_SPMATRIX_ISTRIPLET (m) ((m)->sptype == GSL_SPMATRIX_TRIPLET)
+ ;; #define GSL_SPMATRIX_ISCCS (m) ((m)->sptype == GSL_SPMATRIX_CCS)
+
+ (gsl_spmatrix* gsl_spmatrix_alloc (size_t size_t))
+ (gsl_spmatrix* gsl_spmatrix_alloc_nzmax (size_t size_t size_t size_t))
+ (void gsl_spmatrix_free (gsl_spmatrix*))
+ (int gsl_spmatrix_realloc (size_t gsl_spmatrix*))
+ (int gsl_spmatrix_set_zero (gsl_spmatrix*))
+ (size_t gsl_spmatrix_nnz (gsl_spmatrix*))
+ (int gsl_spmatrix_compare_idx (size_t size_t size_t size_t))
+ (int gsl_spmatrix_memcpy (gsl_spmatrix* gsl_spmatrix*))
+ (double gsl_spmatrix_get (gsl_spmatrix* size_t size_t))
+ (int gsl_spmatrix_set (gsl_spmatrix* size_t size_t double))
+ (gsl_spmatrix* gsl_spmatrix_compcol (gsl_spmatrix*))
+ (void gsl_spmatrix_cumsum (size_t size_t*))
+ (int gsl_spmatrix_scale (gsl_spmatrix* double))
+ (int gsl_spmatrix_minmax (gsl_spmatrix* double* double*))
+ (int gsl_spmatrix_add (gsl_spmatrix* gsl_spmatrix* gsl_spmatrix*))
+ (int gsl_spmatrix_d2sp (gsl_spmatrix* gsl_matrix*))
+ (int gsl_spmatrix_sp2d (gsl_matrix* gsl_spmatrix*))
+ (int gsl_spmatrix_equal (gsl_spmatrix* gsl_spmatrix*))
+ (int gsl_spmatrix_transpose_memcpy (gsl_spmatrix* gsl_spmatrix*))
+
+ ;; interp2d
+ (c-pointer (gsl_interp2d_bilinear gsl_interp2d_bicubic))
+
+ (gsl_interp2d* gsl_interp2d_alloc (gsl_interp2d_type* size_t size_t))
+ (char* gsl_interp2d_name (gsl_interp2d*))
+ (size_t gsl_interp2d_min_size (gsl_interp2d*))
+ (size_t gsl_interp2d_type_min_size (gsl_interp2d_type*))
+ (int gsl_interp2d_set (gsl_interp2d* double* size_t size_t double))
+ (double gsl_interp2d_get (gsl_interp2d* double* size_t size_t))
+ (size_t gsl_interp2d_idx (gsl_interp2d* size_t size_t))
+ (int gsl_interp2d_init (gsl_interp2d* double* double* double* size_t size_t))
+ (void gsl_interp2d_free (gsl_interp2d*))
+ (double gsl_interp2d_eval (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+ (double gsl_interp2d_eval_extrap (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_interp2d_eval_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (int gsl_interp2d_eval_e_extrap (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_interp2d_eval_deriv_x (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_interp2d_eval_deriv_x_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_interp2d_eval_deriv_y (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_interp2d_eval_deriv_y_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_interp2d_eval_deriv_xx (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_interp2d_eval_deriv_xx_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_interp2d_eval_deriv_yy (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_interp2d_eval_deriv_yy_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_interp2d_eval_deriv_xy (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_interp2d_eval_deriv_xy_e (gsl_interp2d* double* double* double* double double gsl_interp_accel* gsl_interp_accel* double*))
+
+ ;; spline2n
+ (gsl_spline2d* gsl_spline2d_alloc (gsl_interp2d_type* size_t size_t))
+ (int gsl_spline2d_init (gsl_spline2d* double* double* double* size_t size_t))
+ (void gsl_spline2d_free (gsl_spline2d*))
+ (double gsl_spline2d_eval (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_spline2d_eval_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_spline2d_eval_deriv_x (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_spline2d_eval_deriv_x_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_spline2d_eval_deriv_y (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_spline2d_eval_deriv_y_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_spline2d_eval_deriv_xx (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_spline2d_eval_deriv_xx_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_spline2d_eval_deriv_yy (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_spline2d_eval_deriv_yy_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (double gsl_spline2d_eval_deriv_xy (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel*))
+ (int gsl_spline2d_eval_deriv_xy_e (gsl_spline2d* double double gsl_interp_accel* gsl_interp_accel* double*))
+ (size_t gsl_spline2d_min_size (gsl_spline2d*))
+ (char* gsl_spline2d_name (gsl_spline2d*))
+ (int gsl_spline2d_set (gsl_spline2d* double* size_t size_t double))
+ (double gsl_spline2d_get (gsl_spline2d* double* size_t size_t))
+ ))
+ )
+ "" (list "gsl/gsl_blas.h"
+ "gsl/gsl_blas_types.h"
+ "gsl/gsl_block.h"
+ "gsl/gsl_block_complex_double.h"
+ "gsl/gsl_block_double.h"
+ "gsl/gsl_bspline.h"
+ "gsl/gsl_cblas.h"
+ "gsl/gsl_cdf.h"
+ "gsl/gsl_chebyshev.h"
+ "gsl/gsl_check_range.h"
+ "gsl/gsl_combination.h"
+ "gsl/gsl_complex.h"
+ "gsl/gsl_complex_math.h"
+ "gsl/gsl_const.h"
+ "gsl/gsl_const_cgs.h"
+ "gsl/gsl_const_cgsm.h"
+ "gsl/gsl_const_mks.h"
+ "gsl/gsl_const_mksa.h"
+ "gsl/gsl_const_num.h"
+ "gsl/gsl_deriv.h"
+ "gsl/gsl_dft_complex.h"
+ "gsl/gsl_dht.h"
+ "gsl/gsl_diff.h"
+ "gsl/gsl_eigen.h"
+ "gsl/gsl_errno.h"
+ "gsl/gsl_fft.h"
+ "gsl/gsl_fft_complex.h"
+ "gsl/gsl_fft_real.h"
+ "gsl/gsl_fit.h"
+ "gsl/gsl_heapsort.h"
+ "gsl/gsl_histogram.h"
+ "gsl/gsl_histogram2d.h"
+ "gsl/gsl_ieee_utils.h"
+ "gsl/gsl_inline.h"
+ "gsl/gsl_integration.h"
+ "gsl/gsl_interp.h"
+ (reader-cond ((>= gsl-version 2.0)
+ "gsl/gsl_interp2d.h"))
+ "gsl/gsl_linalg.h"
+ "gsl/gsl_machine.h"
+ "gsl/gsl_math.h"
+ "gsl/gsl_matrix.h"
+ "gsl/gsl_matrix_complex_double.h"
+ "gsl/gsl_matrix_double.h"
+ "gsl/gsl_message.h"
+ "gsl/gsl_min.h"
+ "gsl/gsl_minmax.h"
+ "gsl/gsl_mode.h"
+ "gsl/gsl_multifit.h"
+ "gsl/gsl_multifit_nlin.h"
+ "gsl/gsl_multimin.h"
+ "gsl/gsl_multiroots.h"
+ "gsl/gsl_multiset.h"
+ "gsl/gsl_nan.h"
+ "gsl/gsl_permutation.h"
+ "gsl/gsl_permute.h"
+ "gsl/gsl_permute_complex_double.h"
+ "gsl/gsl_permute_double.h"
+ "gsl/gsl_permute_vector.h"
+ "gsl/gsl_permute_vector_complex_double.h"
+ "gsl/gsl_permute_vector_double.h"
+ "gsl/gsl_poly.h"
+ "gsl/gsl_pow_int.h"
+ "gsl/gsl_precision.h"
+ "gsl/gsl_qrng.h"
+ "gsl/gsl_randist.h"
+ "gsl/gsl_rng.h"
+ "gsl/gsl_roots.h"
+ (reader-cond ((>= gsl-version 2.0)
+ "gsl/gsl_rstat.h"))
+ "gsl/gsl_sf.h"
+ "gsl/gsl_sf_airy.h"
+ "gsl/gsl_sf_bessel.h"
+ "gsl/gsl_sf_clausen.h"
+ "gsl/gsl_sf_coulomb.h"
+ "gsl/gsl_sf_coupling.h"
+ "gsl/gsl_sf_dawson.h"
+ "gsl/gsl_sf_debye.h"
+ "gsl/gsl_sf_dilog.h"
+ "gsl/gsl_sf_elementary.h"
+ "gsl/gsl_sf_ellint.h"
+ "gsl/gsl_sf_elljac.h"
+ "gsl/gsl_sf_erf.h"
+ "gsl/gsl_sf_exp.h"
+ "gsl/gsl_sf_expint.h"
+ "gsl/gsl_sf_fermi_dirac.h"
+ "gsl/gsl_sf_gamma.h"
+ "gsl/gsl_sf_gegenbauer.h"
+ "gsl/gsl_sf_hyperg.h"
+ "gsl/gsl_sf_laguerre.h"
+ "gsl/gsl_sf_lambert.h"
+ "gsl/gsl_sf_legendre.h"
+ "gsl/gsl_sf_log.h"
+ "gsl/gsl_sf_mathieu.h"
+ "gsl/gsl_sf_pow_int.h"
+ "gsl/gsl_sf_psi.h"
+ "gsl/gsl_sf_result.h"
+ (reader-cond ((>= gsl-version 2.0)
+ "gsl/gsl_spblas.h"
+ "gsl/gsl_splinalg.h"
+ "gsl/gsl_spline2d.h"
+ "gsl/gsl_spmatrix.h"))
+ "gsl/gsl_sf_synchrotron.h"
+ "gsl/gsl_sf_transport.h"
+ "gsl/gsl_sf_trig.h"
+ "gsl/gsl_sf_zeta.h"
+ "gsl/gsl_siman.h"
+ "gsl/gsl_sort.h"
+ "gsl/gsl_sort_double.h"
+ "gsl/gsl_sort_vector.h"
+ "gsl/gsl_sort_vector_double.h"
+ "gsl/gsl_specfunc.h"
+ "gsl/gsl_spline.h"
+ "gsl/gsl_statistics.h"
+ "gsl/gsl_statistics_double.h"
+ "gsl/gsl_sum.h"
+ "gsl/gsl_sys.h"
+ "gsl/gsl_vector.h"
+ "gsl/gsl_vector_complex.h"
+ "gsl/gsl_vector_complex_double.h"
+ "gsl/gsl_vector_double.h"
+ "gsl/gsl_version.h"
+ "gsl/gsl_wavelet.h"
+ "gsl/gsl_wavelet2d.h"
+ )
+
+ "-I/usr/local/include -g3 -DGSL_DISABLE_DEPRECATED" "-lgsl -lgslcblas" "libgsl_s7")
+ ; GSL_DISABLE_DEPRECATED is needed to avoid a name collision (dating from version 1.7!!)
+ (curlet))))
+
+*libgsl*
diff --git a/libm.scm b/libm.scm
new file mode 100644
index 0000000..516dad4
--- /dev/null
+++ b/libm.scm
@@ -0,0 +1,154 @@
+;;; libm.scm
+;;;
+;;; tie the math library into the *libm* environment
+
+(require cload.scm)
+(provide 'libm.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((current-file (port-filename (current-input-port))))
+ (let ((directory (and (or (char=? (current-file 0) #\/)
+ (char=? (current-file 0) #\~))
+ (substring current-file 0 (- (length current-file) 9)))))
+ (when (and directory (not (member directory *load-path*)))
+ (set! *load-path* (cons directory *load-path*)))
+ (with-let (rootlet)
+ (require cload.scm))
+ (when (and directory (not (string-position directory *cload-cflags*)))
+ (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*)))))
+
+
+(if (not (defined? '*libm*))
+ (define *libm*
+ (with-let (unlet)
+
+ (set! *libraries* (cons (cons "libm.scm" (curlet)) *libraries*))
+
+ (c-define
+ '((double j0 (double) "Bessel j0")
+ (double j1 (double))
+ (double erf (double))
+ (double erfc (double))
+ (double lgamma (double))
+
+ (double fabs (double))
+ (double ceil (double))
+ (reader-cond ((not (provided? 'netbsd))
+ (double nearbyint (double))
+ (double scalbln (double int))
+ (double fma (double double double))))
+ (double rint (double))
+ (int llrint (double))
+ (int llround (double))
+ (double trunc (double))
+ (double fmod (double double))
+ (double ldexp (double int))
+ (double scalbn (double int))
+ (double exp2 (double))
+ (double expm1 (double))
+ (double log10 (double))
+ (double log1p (double))
+ (double log2 (double))
+ (int ilogb (double))
+ (double cbrt (double))
+ (double hypot (double double))
+ (double pow (double double))
+ (double fdim (double double))
+ (double tgamma (double))
+ (double copysign (double double))
+ (double nan (char*))
+ (double nextafter (double double))
+ (double nexttoward (double double))
+
+ (reader-cond ((not (provided? 'solaris))
+ (int fpclassify (double))
+ (int isfinite (double))
+ (int isinf (double))
+ (int isnan (double))
+ (int isnormal (double))
+ (int signbit (double))))
+
+ ;; exporting these will overwrite the built-in versions
+ (double floor (double))
+ (double round (double))
+ (double remainder (double double))
+ (double exp (double))
+ (double log (double))
+ (double sqrt (double))
+ (double cos (double))
+ (double sin (double))
+ (double tan (double))
+ (double cosh (double))
+ (double sinh (double))
+ (double tanh (double))
+ (double acos (double))
+ (double asin (double))
+ (double atan (double))
+ (double atan2 (double double))
+ (double acosh (double))
+ (double asinh (double))
+ (double atanh (double))
+
+ (int (FP_NAN FP_INFINITE FP_ZERO FP_SUBNORMAL FP_NORMAL))
+ (double (M_E M_LOG2E M_LOG10E M_LN2 M_LN10 M_PI M_PI_2 M_PI_4 M_1_PI M_2_PI M_2_SQRTPI M_SQRT2 M_SQRT1_2))
+
+ (C-macro (char* __VERSION__))
+ (C-macro (int (__SIZEOF_LONG_LONG__ __SIZEOF_INT__ __SIZEOF_POINTER__ __SIZEOF_LONG__ __SIZEOF_LONG_DOUBLE__ __SIZEOF_SIZE_T__
+ __SIZEOF_FLOAT__ __SIZEOF_SHORT__ __SIZEOF_DOUBLE__ __CHAR_BIT__ __DBL_MIN_EXP__ __DBL_MIN_10_EXP__ __LDBL_MAX_EXP__
+ __DBL_DIG__ __DECIMAL_DIG__ __BIGGEST_ALIGNMENT__ __DBL_MAX_EXP__ __LONG_LONG_MAX__ __FLT_MIN_EXP__ __FLT_MANT_DIG__
+ __FLT_RADIX__ __FLT_MAX_10_EXP__ __LONG_MAX__ __LDBL_MANT_DIG__ __FLT_DIG__ __INT_MAX__ __FLT_MAX_EXP__
+ __DBL_MANT_DIG__ __LDBL_MIN_EXP__ __LDBL_MAX_10_EXP__ __INTMAX_MAX__ __FLT_MIN_10_EXP__ __DBL_MAX_10_EXP__
+ __LDBL_MIN_10_EXP__ __LDBL_DIG__)))
+ (C-macro (double (__FLT_MIN__ __DBL_DENORM_MIN__ __LDBL_MAX__ __FLT_EPSILON__ __LDBL_MIN__ __DBL_MAX__ __DBL_MIN__
+ __LDBL_EPSILON__ __DBL_EPSILON__ __FLT_DENORM_MIN__ __FLT_MAX__ __LDBL_DENORM_MIN__)))
+
+ ;; these have arg by reference, return list in s7
+ (in-C "
+static s7_pointer g_remquo(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_real(s7_car(args)))
+ {
+ if (s7_is_real(s7_cadr(args)))
+ {
+ int quo = 0;
+ double rem;
+ rem = remquo(s7_number_to_real(sc, s7_car(args)), s7_number_to_real(sc, s7_cadr(args)), &quo);
+ return(s7_list(sc, 2, s7_make_real(sc, rem), s7_make_integer(sc, quo)));
+ }
+ return(s7_wrong_type_arg_error(sc, \"remquo\", 2, s7_cadr(args), \"a real\"));
+ }
+ return(s7_wrong_type_arg_error(sc, \"remquo\", 1, s7_car(args), \"a real\"));
+}
+static s7_pointer g_frexp(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_real(s7_car(args)))
+ {
+ int ex = 0;
+ double frac;
+ frac = frexp(s7_number_to_real(sc, s7_car(args)), &ex);
+ return(s7_list(sc, 2, s7_make_real(sc, frac), s7_make_integer(sc, ex)));
+ }
+ return(s7_wrong_type_arg_error(sc, \"frexp\", 1, s7_car(args), \"a real\"));
+}
+static s7_pointer g_modf(s7_scheme *sc, s7_pointer args)
+{
+ if (s7_is_real(s7_car(args)))
+ {
+ double frac, ip = 0.0;
+ frac = modf(s7_number_to_real(sc, s7_car(args)), &ip);
+ return(s7_list(sc, 2, s7_make_real(sc, frac), s7_make_real(sc, ip)));
+ }
+ return(s7_wrong_type_arg_error(sc, \"modf\", 1, s7_car(args), \"a real\"));
+}
+")
+ (C-function ("remquo" g_remquo "(remquo x y) returns a list: (remainder messed-up-quotient)" 2))
+ (C-function ("frexp" g_frexp "(frexp x) returns a list: (fraction exponent)" 1))
+ (C-function ("modf" g_modf "(modf x) returns a list: (int-part frac-part) -- this is not the same as fmod!" 1))
+ )
+ "" "math.h" "" "" "libm_s7")
+
+ (curlet))))
+
+*libm*
+;; the loader will return *libm*
+
diff --git a/libutf8proc.scm b/libutf8proc.scm
new file mode 100644
index 0000000..f12740c
--- /dev/null
+++ b/libutf8proc.scm
@@ -0,0 +1,193 @@
+;;; utf8proc.scm
+;;;
+;;; tie the utf8proc library into the *utf8proc* environment
+
+(require cload.scm)
+(provide 'libutf8proc.scm)
+
+;; if loading from a different directory, pass that info to C
+(let ((current-file (port-filename (current-input-port))))
+ (let ((directory (and (or (char=? (current-file 0) #\/)
+ (char=? (current-file 0) #\~))
+ (substring current-file 0 (- (length current-file) 9)))))
+ (when (and directory (not (member directory *load-path*)))
+ (set! *load-path* (cons directory *load-path*)))
+ (with-let (rootlet)
+ (require cload.scm))
+ (when (and directory (not (string-position directory *cload-cflags*)))
+ (set! *cload-cflags* (string-append "-I" directory " " *cload-cflags*)))))
+
+
+(if (not (defined? '*libutf8proc*))
+ (define *libutf8proc*
+ (with-let (unlet)
+
+ (set! *libraries* (cons (cons "libutf8proc.scm" (curlet)) *libraries*))
+
+ (c-define
+ '((C-macro (int (UTF8PROC_VERSION_MAJOR UTF8PROC_VERSION_MINOR UTF8PROC_VERSION_PATCH)))
+
+ (int (UTF8PROC_NULLTERM UTF8PROC_STABLE UTF8PROC_COMPAT UTF8PROC_COMPOSE UTF8PROC_DECOMPOSE
+ UTF8PROC_IGNORE UTF8PROC_REJECTNA UTF8PROC_NLF2LS UTF8PROC_NLF2PS UTF8PROC_NLF2LF
+ UTF8PROC_STRIPCC UTF8PROC_CASEFOLD UTF8PROC_CHARBOUND UTF8PROC_LUMP UTF8PROC_STRIPMARK))
+
+ (C-macro (int (UTF8PROC_ERROR_NOMEM UTF8PROC_ERROR_OVERFLOW UTF8PROC_ERROR_INVALIDUTF8 UTF8PROC_ERROR_NOTASSIGNED UTF8PROC_ERROR_INVALIDOPTS)))
+
+ (int (UTF8PROC_CATEGORY_CN UTF8PROC_CATEGORY_LU UTF8PROC_CATEGORY_LL UTF8PROC_CATEGORY_LT UTF8PROC_CATEGORY_LM
+ UTF8PROC_CATEGORY_LO UTF8PROC_CATEGORY_MN UTF8PROC_CATEGORY_MC UTF8PROC_CATEGORY_ME UTF8PROC_CATEGORY_ND
+ UTF8PROC_CATEGORY_NL UTF8PROC_CATEGORY_NO UTF8PROC_CATEGORY_PC UTF8PROC_CATEGORY_PD UTF8PROC_CATEGORY_PS
+ UTF8PROC_CATEGORY_PE UTF8PROC_CATEGORY_PI UTF8PROC_CATEGORY_PF UTF8PROC_CATEGORY_PO UTF8PROC_CATEGORY_SM
+ UTF8PROC_CATEGORY_SC UTF8PROC_CATEGORY_SK UTF8PROC_CATEGORY_SO UTF8PROC_CATEGORY_ZS UTF8PROC_CATEGORY_ZL
+ UTF8PROC_CATEGORY_ZP UTF8PROC_CATEGORY_CC UTF8PROC_CATEGORY_CF UTF8PROC_CATEGORY_CS UTF8PROC_CATEGORY_CO))
+
+ (int (UTF8PROC_BIDI_CLASS_L UTF8PROC_BIDI_CLASS_LRE UTF8PROC_BIDI_CLASS_LRO UTF8PROC_BIDI_CLASS_R UTF8PROC_BIDI_CLASS_AL
+ UTF8PROC_BIDI_CLASS_RLE UTF8PROC_BIDI_CLASS_RLO UTF8PROC_BIDI_CLASS_PDF UTF8PROC_BIDI_CLASS_EN UTF8PROC_BIDI_CLASS_ES
+ UTF8PROC_BIDI_CLASS_ET UTF8PROC_BIDI_CLASS_AN UTF8PROC_BIDI_CLASS_CS UTF8PROC_BIDI_CLASS_NSM UTF8PROC_BIDI_CLASS_BN
+ UTF8PROC_BIDI_CLASS_B UTF8PROC_BIDI_CLASS_S UTF8PROC_BIDI_CLASS_WS UTF8PROC_BIDI_CLASS_ON UTF8PROC_BIDI_CLASS_LRI
+ UTF8PROC_BIDI_CLASS_RLI UTF8PROC_BIDI_CLASS_FSI UTF8PROC_BIDI_CLASS_PDI))
+
+ (int (UTF8PROC_DECOMP_TYPE_FONT UTF8PROC_DECOMP_TYPE_NOBREAK UTF8PROC_DECOMP_TYPE_INITIAL UTF8PROC_DECOMP_TYPE_MEDIAL
+ UTF8PROC_DECOMP_TYPE_FINAL UTF8PROC_DECOMP_TYPE_ISOLATED UTF8PROC_DECOMP_TYPE_CIRCLE UTF8PROC_DECOMP_TYPE_SUPER
+ UTF8PROC_DECOMP_TYPE_SUB UTF8PROC_DECOMP_TYPE_VERTICAL UTF8PROC_DECOMP_TYPE_WIDE UTF8PROC_DECOMP_TYPE_NARROW
+ UTF8PROC_DECOMP_TYPE_SMALL UTF8PROC_DECOMP_TYPE_SQUARE UTF8PROC_DECOMP_TYPE_FRACTION UTF8PROC_DECOMP_TYPE_COMPAT))
+
+ (int (UTF8PROC_BOUNDCLASS_START UTF8PROC_BOUNDCLASS_OTHER UTF8PROC_BOUNDCLASS_CR UTF8PROC_BOUNDCLASS_LF
+ UTF8PROC_BOUNDCLASS_CONTROL UTF8PROC_BOUNDCLASS_EXTEND UTF8PROC_BOUNDCLASS_L UTF8PROC_BOUNDCLASS_V
+ UTF8PROC_BOUNDCLASS_T UTF8PROC_BOUNDCLASS_LV UTF8PROC_BOUNDCLASS_LVT UTF8PROC_BOUNDCLASS_REGIONAL_INDICATOR
+ UTF8PROC_BOUNDCLASS_SPACINGMARK))
+
+ (char* utf8proc_version (void))
+ (char* utf8proc_errmsg (int))
+ (int utf8proc_tolower ((utf8proc_int32_t int)))
+ (int utf8proc_toupper ((utf8proc_int32_t int)))
+ (int utf8proc_charwidth ((utf8proc_int32_t int)))
+ (int utf8proc_category ((utf8proc_int32_t int)))
+ (char* utf8proc_category_string ((utf8proc_int32_t int)))
+ (bool utf8proc_codepoint_valid ((utf8proc_int32_t int)))
+ (bool utf8proc_grapheme_break ((utf8proc_int32_t int) (utf8proc_int32_t int)))
+
+ (char* utf8proc_NFD (char*))
+ (char* utf8proc_NFC (char*))
+ (char* utf8proc_NFKD (char*))
+ (char* utf8proc_NFKC (char*))
+
+ (in-C "static s7_pointer g_utf8proc_iterate(s7_scheme *sc, s7_pointer args)
+ {
+ utf8proc_int32_t code_ref = 0;
+ int len, res;
+ char *str;
+ str = (char *)s7_string(s7_car(args));
+ len = s7_string_length(s7_car(args));
+ res = utf8proc_iterate(str, len, &code_ref);
+ return(s7_list(sc, 2, s7_make_integer(sc, code_ref), s7_make_integer(sc, res)));
+ }")
+ (C-function ("utf8proc_iterate" g_utf8proc_iterate "" 1))
+
+ (in-C "static s7_pointer g_utf8proc_encode_char(s7_scheme *sc, s7_pointer args)
+ {
+ ssize_t res;
+ utf8proc_uint8_t buf[8];
+ res = utf8proc_encode_char((utf8proc_int32_t)s7_integer(s7_car(args)), buf);
+ return(s7_list(sc, 2, s7_make_string_with_length(sc, buf, res), s7_make_integer(sc, res)));
+ }")
+ (C-function ("utf8proc_encode_char" g_utf8proc_encode_char "" 1))
+
+ (in-C "static s7_pointer g_utf8proc_reencode(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer buffer, codepoints, options;
+ ssize_t res;
+ buffer = s7_car(args);
+ codepoints = s7_cadr(args);
+ options = s7_caddr(args);
+ res = utf8proc_reencode((utf8proc_int32_t *)s7_string(buffer),
+ (utf8proc_ssize_t)s7_integer(codepoints),
+ (utf8proc_option_t)s7_integer(options));
+ return(s7_make_integer(sc, res));
+ }")
+ (C-function ("utf8proc_reencode" g_utf8proc_reencode "" 1))
+#|
+ (in-C "static s7_pointer g_utf8proc_utf8class(s7_scheme *sc, s7_pointer args)
+ {
+ return(s7_make_string_with_length(sc, (char *)utf8proc_utf8class, 256));
+ }")
+ (C-function ("utf8proc_utf8class" g_utf8proc_utf8class "" 0))
+|#
+ (in-C "static s7_pointer g_utf8proc_get_property(s7_scheme *sc, s7_pointer args)
+ {
+ const utf8proc_property_t *info;
+ info = utf8proc_get_property((utf8proc_int32_t)s7_integer(s7_car(args)));
+ return(s7_inlet(sc, s7_list(sc, 30,
+ s7_make_symbol(sc, \"category\"), s7_make_integer(sc, info->category),
+ s7_make_symbol(sc, \"combining_class\"), s7_make_integer(sc, info->combining_class),
+ s7_make_symbol(sc, \"bidi_class\"), s7_make_integer(sc, info->bidi_class),
+ s7_make_symbol(sc, \"decomp_type\"), s7_make_integer(sc, info->decomp_type),
+ s7_make_symbol(sc, \"uppercase_mapping\"), s7_make_integer(sc, info->uppercase_mapping),
+ s7_make_symbol(sc, \"lowercase_mapping\"), s7_make_integer(sc, info->lowercase_mapping),
+ s7_make_symbol(sc, \"titlecase_mapping\"), s7_make_integer(sc, info->titlecase_mapping),
+ s7_make_symbol(sc, \"comb1st_index\"), s7_make_integer(sc, info->comb1st_index),
+ s7_make_symbol(sc, \"comb2nd_index\"), s7_make_integer(sc, info->comb2nd_index),
+ s7_make_symbol(sc, \"bidi_mirrored\"), s7_make_integer(sc, info->bidi_mirrored),
+ s7_make_symbol(sc, \"comp_exclusion\"), s7_make_integer(sc, info->comp_exclusion),
+ s7_make_symbol(sc, \"ignorable\"), s7_make_integer(sc, info->ignorable),
+ s7_make_symbol(sc, \"control_boundary\"), s7_make_integer(sc, info->control_boundary),
+ s7_make_symbol(sc, \"boundclass\"), s7_make_integer(sc, info->boundclass),
+ s7_make_symbol(sc, \"charwidth\"), s7_make_integer(sc, info->charwidth))));
+ }")
+ (C-function ("utf8proc_get_property" g_utf8proc_get_property "" 1))
+
+ (in-C "static s7_pointer g_utf8proc_decompose_char(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer code, opt, str;
+ int last_boundclass;
+ utf8proc_ssize_t size;
+ utf8proc_int32_t *dst;
+ ssize_t res;
+ code = s7_car(args);
+ str = s7_cadr(args);
+ opt = s7_caddr(args);
+ dst = (utf8proc_int32_t *)s7_string(str);
+ size = (utf8proc_ssize_t)s7_string_length(str);
+ res = utf8proc_decompose_char((utf8proc_int32_t)s7_integer(code), dst, size, (utf8proc_option_t)s7_integer(opt), &last_boundclass);
+ return(s7_make_integer(sc, res));
+ }")
+ (C-function ("utf8proc_decompose_char" g_utf8proc_decompose_char "" 3))
+
+ (in-C "static s7_pointer g_utf8proc_map(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer opt, str;
+ ssize_t res;
+ utf8proc_uint8_t *dst;
+ str = s7_car(args);
+ opt = s7_cadr(args);
+ res = utf8proc_map((utf8proc_uint8_t *)s7_string(str), s7_string_length(str), &dst, (utf8proc_option_t)s7_integer(opt));
+ if (res < 0) return(s7_make_integer(sc, res));
+ return(s7_make_string_with_length(sc, dst, res));
+ }")
+ (C-function ("utf8proc_map" g_utf8proc_map "" 2))
+
+ (in-C "static s7_pointer g_utf8proc_decompose(s7_scheme *sc, s7_pointer args)
+ {
+ s7_pointer opt, str;
+ int len;
+ ssize_t res;
+ utf8proc_int32_t *dst;
+ str = s7_car(args);
+ opt = s7_cadr(args);
+ len = s7_string_length(str);
+ dst = (utf8proc_int32_t *)malloc(len * 4);
+ res = utf8proc_decompose((const utf8proc_uint8_t *)s7_string(str), len, dst, len, (utf8proc_option_t)s7_integer(opt));
+ if (res < 0) return(s7_make_integer(sc, res));
+ return(s7_make_string_with_length(sc, (char *)dst, res));
+ }")
+ (C-function ("utf8proc_decompose" g_utf8proc_decompose "" 2))
+ )
+
+ "" "utf8proc.h" "" "-lutf8proc" "utf8proc_s7")
+ (curlet))))
+
+*libutf8proc*
+
+
+
+
+
diff --git a/libxm.html b/libxm.html
deleted file mode 100644
index 8c73850..0000000
--- a/libxm.html
+++ /dev/null
@@ -1,117 +0,0 @@
-<html>
-<head>
-<title>xm</title>
-<style type="text/css">
-<!--
- EM.red {color:red; font-style:normal}
- EM.typing {color:maroon; font-style: normal}
- EM.listener {color:darkblue; font-style: normal}
- EM.tab {font-style: normal; font-size: small; font-family: fixed}
- EM.def {font-weight: bold; font-style: normal}
- H1 {text-align: center}
- UL {list-style-type: none}
-
- A {text-decoration:none}
- A:hover {text-decoration:underline}
- A.quiet {color:black; text-decoration:none}
- A.quiet:hover {text-decoration:underline}
--->
-</style>
-</head>
-<body bgcolor=white>
-
-<A NAME="xm"></A>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h1>xm</h1></td></tr></table>
-</td></tr></table>
-
-<br>
-<p>libxm provides s7, Ruby, and Forth (fth) bindings for Xlib, Xt, Xpm, and Xm (Motif);
-or alternatively (under the name libxg) Gtk, gdk, gdk-pixbuf, pango, cairo, and some of glib;
-and much of OpenGL.
-You can build it with just X, and so on — see README.libxm for details.
-There are several example files in the libxm package — anything with
-the extension "scm", "rb", or "fs". libxm can be used directly with s7, Ruby, or Forth,
-providing a graphical user-interface for scripts.
-</p>
-<p>
-All libxm names are exactly the same as the C name except that
-a "." is prepended (in Scheme) to struct field accessors — this prefix (and the postfix) can be set via the macros
-XM_PREFIX, XM_FIELD_PREFIX and XM_POSTFIX to whatever you like —
-"x:" or "<" and ">", etc. In Ruby, I'm prepending "R"; in Forth "F".
-I chose not to try to make these names fit into the
-"Scheme culture" (i.e. adding random dashes and uncapitalizing everything)
-because it is already too hard to keep track of the thousands of names
-in these libraries. By using the exact C name, embedded caps and all,
-there's no uncertainty about what the corresponding libxm name is;
-XmScaleSetValue becomes XmScaleSetValue.
-There are several differences between the C versions and the libxm
-versions; these are listed at the start of xm.c and xg.c. Briefly,
-an Arg list (in Motif) is a lisp list of name/value pairs and the "len" arg associated with it is optional;
-ref args are usually returned by the procedure in a list, and not passed in unless an initial value is needed;
-array args are passed as lists, and returned as lists;
-pointers to structs are '(type val) where val is opaque except via accessors
-(that is, all non-simple types are lists in xm where the first element is a symbol describing the type
-and the second is usually the C value stored directly as an unsigned long);
-"Va" args are passed and returned as lists, and the list length argument is optional;
-XtCallback procedure args are passed by value;
-the various "client data" args are optional;
-XtCallbackLists are passed as lists of procedure/data pairs;
-where an explicit NULL is needed as an arg, use #f (or '() for list args);
-structs are accessed by the field name and the lisp variable (which contains the struct type) —
-(.pixel color) for example, or (.foreground gcvalue);
-blank structs, where needed, can be created via (Name) — (XColor) or (XGCValues) for example.
-</p>
-
-<p>To use libxm from some existing program, you need only
-export the caller's XtAppContext and main shell widget (mainly to
-get the Display variable). In Snd, the g_main_widgets procedure
-passes back a list:
-</p>
-<pre>
- return(XEN_CONS(XEN_WRAP_APPCONTEXT(MAIN_APP(ss)),
- XEN_CONS(XEN_WRAP_WIDGET(MAIN_SHELL(ss)),
- XEN_CONS(XEN_WRAP_WIDGET(MAIN_PANE(ss)),...))));
-</pre>
-<p>The XEN entities are from the xen package that provides
-a wrapper for extension-language-specific functions
-and macros.
-</p>
-<pre>
- (set! app (car (<a class=quiet href="extsnd.html#mainwidgets">main-widgets</a>)))
-</pre>
-<p>For many examples, see snd-motif.scm,new-effects.scm,
-effects.rb, snd-xm.rb,
-and snd-test.scm in the Snd tarball. There is
-also some further discussion of this stuff in Snd's grfsnd.html (Ruby examples,
-etc).
-</p>
-<pre>
-(gtk_init 0 #f)
-(let ((window (gtk_window_new GTK_WINDOW_TOPLEVEL)))
- (g_signal_connect window "delete_event"
- (lambda (w e data)
- (gtk_main_quit)
- #t))
- (g_signal_connect window "destroy"
- (lambda (w data)
- (gtk_main_quit)))
-
- (gtk_container_set_border_width (GTK_CONTAINER window) 10)
-
- (let ((button (gtk_button_new_with_label "Click Me!")))
- (g_signal_connect button "clicked"
- (lambda (w data)
- (display "Hello World")))
-
- (gtk_container_add (GTK_CONTAINER window) button)
- (gtk_widget_show button)
- (gtk_widget_show window)
- (gtk_main)
- ))
-</pre>
-
-<p>There's a longer Gtk example in s7.html in the Snd package.
-</p>
-</body>
-</html>
diff --git a/lint.scm b/lint.scm
new file mode 100644
index 0000000..7953d00
--- /dev/null
+++ b/lint.scm
@@ -0,0 +1,4779 @@
+;;; lint for s7 scheme
+;;;
+;;; (lint "file.scm") checks file.scm for infelicities
+;;; to control the kinds of checks, set the variables below.
+
+(provide 'lint.scm)
+(require stuff.scm)
+;(require write.scm)
+
+(if (provided? 'pure-s7)
+ (begin
+ (define (make-polar mag ang) (complex (* mag (cos ang)) (* mag (sin ang))))
+
+ (define (memq a b) (member a b eq?))
+ (define (memv a b) (member a b eqv?))
+ (define (assq a b) (assoc a b eq?))
+ (define (assv a b) (assoc a b eqv?))
+
+ (define (char-ci=? . chars) (apply char=? (map char-upcase chars)))
+ (define (char-ci<=? . chars) (apply char<=? (map char-upcase chars)))
+ (define (char-ci>=? . chars) (apply char>=? (map char-upcase chars)))
+ (define (char-ci<? . chars) (apply char<? (map char-upcase chars)))
+ (define (char-ci>? . chars) (apply char>? (map char-upcase chars)))
+
+ (define (string-ci=? . strs) (apply string=? (map string-upcase strs)))
+ (define (string-ci<=? . strs) (apply string<=? (map string-upcase strs)))
+ (define (string-ci>=? . strs) (apply string>=? (map string-upcase strs)))
+ (define (string-ci<? . strs) (apply string<? (map string-upcase strs)))
+ (define (string-ci>? . strs) (apply string>? (map string-upcase strs)))
+
+ (define (let->list e)
+ (if (let? e)
+ (reverse! (map values e))
+ (error 'wrong-type-arg "let->list argument should be an environment: ~A" str)))
+ ))
+
+(define *report-unused-parameters* #f)
+(define *report-unused-top-level-functions* #f)
+(define *report-multiply-defined-top-level-functions* #f) ; same name defined at top level in more than one file
+(define *report-shadowed-variables* #f)
+(define *report-minor-stuff* #t) ; now obsolete (#t)
+(define *report-doc-strings* #f) ; report old-style (CL) doc strings
+
+(define *load-file-first* #f) ; this will actually load the file, so errors will stop lint
+(define start-up-let (rootlet))
+(define *current-file* "")
+(define *top-level-objects* (make-hash-table))
+(define *lint-output-port* *stderr*)
+
+(format *stderr* "loading lint.scm~%")
+(set! reader-cond #f)
+(define-macro (reader-cond . clauses) `(values)) ; clobber reader-cond to avoid dumb unbound-variable errors
+
+
+;;; --------------------------------------------------------------------------------
+;;; for snd-test.scm
+
+
+(set! *#readers*
+ (cons (cons #\_ (lambda (str)
+ (and (string=? str "__line__")
+ (port-line-number))))
+ *#readers*))
+
+(when (not (provided? 'snd))
+ (define defanimal define*)
+ (define definstrument define*)
+ (define defgenerator define*))
+
+
+;;; --------------------------------------------------------------------------------
+
+
+(define lint
+ (let ()
+ (define (any-real? lst) ; ignore 0.0 and 1.0 in this since they normally work
+ (and (pair? lst)
+ (or (and (number? (car lst))
+ (not (rational? (car lst)))
+ (not (= (car lst) 0.0))
+ (not (= (car lst) 1.0)))
+ (any-real? (cdr lst)))))
+
+ (define (quoted-undotted-pair? x)
+ (and (pair? x)
+ (eq? (car x) 'quote)
+ (pair? (cdr x))
+ (pair? (cadr x))
+ (positive? (length (cadr x)))))
+
+ (define (quoted-null? x)
+ (and (pair? x)
+ (eq? (car x) 'quote)
+ (pair? (cdr x))
+ (null? (cadr x))))
+
+ (define (code-constant? x)
+ (and (not (symbol? x))
+ (or (not (pair? x))
+ (and (eq? (car x) 'quote)
+ (list? (cdr x)))))) ; was pair?
+
+ (let ((no-side-effect-functions
+ ;; ideally we'd be able to add functions to this list, perhaps similar to the signatures
+ (let ((ht (make-hash-table)))
+ (for-each
+ (lambda (op)
+ (hash-table-set! ht op #t))
+ '(* + - / < <= = > >=
+ abs acos acosh and angle append aritable? arity ash asin asinh assoc assq assv atan atanh
+ begin boolean=? boolean? byte-vector byte-vector?
+ caaaar caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr caddr cadr
+ call-with-input-from-string call-with-input-from-file
+ c-pointer c-pointer? c-object? call-with-exit car case catch cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr
+ cddar cdddar cddddr cdddr cddr cdr ceiling char->integer char-alphabetic? char-ci<=?
+ char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase char-lower-case? char-numeric?
+ char-position char-ready? char-upcase char-upper-case? char-whitespace? char<=? char<?
+ char=? char>=? char>? char? complex complex? cond cons constant? continuation? cos
+ cosh curlet current-error-port current-input-port current-output-port cyclic-sequences
+ defined? denominator dilambda? do dynamic-wind
+ eof-object? eq? equal? eqv? even? exact->inexact exact? exp expt
+ float? float-vector float-vector-ref float-vector? floor for-each funclet
+ gcd gensym gensym?
+ hash-table hash-table* hash-table-entries hash-table-ref hash-table? help hook-functions
+ if imag-part inexact->exact inexact? infinite? inlet input-port?
+ int-vector int-vector-ref int-vector? iterator-at-end? iterator-sequence integer->char
+ integer-decode-float integer-length integer? iterator?
+ keyword->symbol keyword?
+ let->list lcm length let let* let-ref let? letrec letrec* list list->string list->vector list-ref
+ list-tail list? log logand logbit? logior lognot logxor
+ macro? magnitude make-byte-vector make-float-vector make-int-vector make-hash-table make-hook make-iterator make-keyword make-list make-polar
+ make-rectangular make-shared-vector make-string make-vector map max member memq memv min modulo morally-equal?
+ nan? negative? not null? number->string number? numerator
+ object->string odd? openlet? or outlet output-port? owlet
+ pair-line-number pair? peek-char port-closed? port-filename port-line-number positive? procedure-documentation
+ procedure-setter procedure-signature procedure-source procedure? proper-list? provided?
+ quasiquote quote quotient
+ random-state random-state->list random-state? rational? rationalize real-part real? remainder reverse rootlet round
+ s7-version sequence? sin sinh sqrt stacktrace string string->list string->number string->symbol string-append
+ string-ci<=? string-ci<? string-ci=? string-ci>=? string-ci>? string-downcase string-length
+ string-position string-ref string-upcase string<=? string<? string=? string>=? string>? string?
+ sublet substring symbol symbol->dynamic-value symbol->keyword symbol->string symbol->value symbol=? symbol?
+ tan tanh truncate
+ unless unlet
+ vector vector-append vector->list vector-dimensions vector-length vector-ref vector?
+ when with-baffle with-let with-input-from-file with-input-from-string with-output-to-string
+ zero?))
+ ;; do not include file-exists? or directory?
+ ht))
+
+ (deprecated-ops '((global-environment . rootlet)
+ (current-environment . curlet)
+ (make-procedure-with-setter . dilambda)
+ (procedure-with-setter? . dilambda?)
+ (make-random-state . random-state)
+ ;(make-rectangular . complex)
+
+ (data-format . sample-type)
+ (mus-sound-data-format . mus-sound-sample-type)
+ (mus-data-format-name . mus-sample-type-name)
+ (mus-data-format->string . mus-sample-type->string)))
+
+ (numeric-ops (let ((h (make-hash-table)))
+ (for-each
+ (lambda (op)
+ (set! (h op) #t))
+ '(+ * - /
+ sin cos tan asin acos atan sinh cosh tanh asinh acosh atanh
+ log exp expt sqrt make-polar complex
+ imag-part real-part abs magnitude angle max min exact->inexact
+ modulo remainder quotient lcm gcd
+ rationalize inexact->exact random
+ logior lognot logxor logand numerator denominator
+ floor round truncate ceiling ash))
+ h))
+
+ (repeated-args-table (let ((h (make-hash-table)))
+ (for-each
+ (lambda (op)
+ (set! (h op) #t))
+ '(= / max min < > <= >= - quotient remainder modulo and or
+ string=? string<=? string>=? string<? string>?
+ char=? char<=? char>=? char<? char>?
+ boolean=? symbol=?))
+ h))
+
+ (repeated-args-table-2 (let ((h (make-hash-table)))
+ (for-each
+ (lambda (op)
+ (set! (h op) #t))
+ '(= max min < > <= >= and or
+ string=? string<=? string>=? string<? string>?
+ char=? char<=? char>=? char<? char>?
+ boolean=? symbol=?))
+ h))
+
+ (syntaces (let ((h (make-hash-table)))
+ (for-each
+ (lambda (op)
+ (set! (h op) #t))
+ '(quote if begin let let* letrec letrec* cond case or and do set! unless when
+ with-let with-baffle
+ lambda lambda* define define*
+ define-macro define-macro* define-bacro define-bacro*
+ define-constant define-expansion))
+ h))
+
+ (format-control-char (let ((chars (make-vector 256 #f)))
+ (for-each
+ (lambda (c)
+ (vector-set! chars (char->integer c) #t))
+ '(#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\, #\{ #\} #\@ #\P #\*
+ #\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\N #\n #\W #\w #\v #\V
+ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+ chars))
+
+ (selector-types '(#t symbol? char? boolean? integer? rational? real? complex? number?))
+ (outport #t)
+ (loaded-files #f)
+ (globals #f)
+ (*e* (curlet))
+ (other-identifiers #f)
+ (quote-warnings 0)
+ (last-simplify-boolean-line-number -1)
+ (last-simplify-numeric-line-number -1)
+ (last-checker-line-number -1)
+ (line-number -1))
+#|
+ (define var-name (dilambda (lambda (v) (v :name)) (lambda (v x) (set! (v :name) x))))
+ (define var-ref (dilambda (lambda (v) (v :ref)) (lambda (v x) (set! (v :ref) x))))
+ (define var-set (dilambda (lambda (v) (v :set)) (lambda (v x) (set! (v :set) x))))
+ (define var-type (dilambda (lambda (v) (v :type)) (lambda (v x) (set! (v :type) x))))
+ (define var-value (dilambda (lambda (v) (v :value)) (lambda (v x) (set! (v :value) x))))
+ (define* (make-var name ref set fnc typ val new)
+ (inlet :var :var :name name :ref ref :set set :fnc fnc :type typ :value val :new new))
+ (define (var? v) (and (let? v) (eq? (v :var) :var)))
+ ;; but need var-member -- (assoc x y var-name)?
+
+ ;; var-type is set in make-var in do and the various lets, so new needs closure-type? and set var-type to procedure? or macro? etc
+ ;; define et al could also set the type
+|#
+
+ (define var? pair?)
+ (define var-member assq)
+ (define var-name car)
+ (define var-ref cadr)
+ (define var-set caddr)
+ (define (set-cadr! v val) (list-set! v 1 val))
+ (define (set-caddr! v val) (list-set! v 2 val))
+ (set! (procedure-setter cadr) set-cadr!)
+ (set! (procedure-setter caddr) set-caddr!)
+ (define var-type (dilambda (lambda (v) (list-ref v 3)) (lambda (v x) (list-set! v 3 x))))
+ (define var-value (dilambda (lambda (v) (list-ref v 4)) (lambda (v x) (list-set! v 4 x))))
+ ;; (define make-var (lambda* (name ref set typ val :allow-other-keys) (list name ref set typ val)))
+ ;; this :allow-other-keys is protecting us from bizarre keyword uses in non-s7 code.
+ (define var-new (dilambda (lambda (v) (list-ref v 5)) (lambda (v x) (list-set! v 5 x))))
+
+ (define* (make-var name ref set typ val new)
+ ;(if new (format *stderr* "~A: ~A~%~%" name new))
+ (list name ref set typ val new))
+
+ (define (return-type sym)
+ (let ((f (if (symbol? sym) (symbol->value sym *e*) sym)))
+ (and (procedure? f)
+ (let ((sig (procedure-signature f)))
+ (and (pair? sig)
+ (or (eq? (car sig) 'values) ; turn it into #t for now
+ (car sig))))))) ; this might be undefined in the current context (eg oscil? outside clm)
+
+ (define (->type c)
+ (cond ((pair? c)
+ (if (symbol? (car c))
+ (return-type (car c))
+ (or (pair? (car c)) 'pair?)))
+ ((integer? c) 'integer?)
+ ((rational? c) 'rational?)
+ ((real? c) 'real?)
+ ((number? c) 'number?)
+ ((keyword? c) 'keyword?)
+ ((symbol? c) 'symbol?)
+ ((byte-vector? c) 'byte-vector?)
+ ((string? c) 'string?)
+ ((null? c) 'null?)
+ ((char? c) 'char?)
+ ((boolean? c) 'boolean?)
+ ((float-vector? c) 'float-vector?)
+ ((int-vector? c) 'int-vector?)
+ ((vector? c) 'vector?)
+ ((let? c) 'let?)
+ ((hash-table? c) 'hash-table?)
+ ((input-port? c) 'input-port?)
+ ((output-port? c) 'output-port?)
+ ((iterator? c) 'iterator?)
+ ((continuation? c) 'continuation?)
+ ((dilambda? c) 'dilambda?)
+ ((procedure? c) 'procedure?)
+ ((macro? c) 'macro?)
+ ((random-state? c) 'random-state?)
+ ((eof-object? c) 'eof-object?)
+ ((c-pointer? c) 'c-pointer?)
+ (#t #t)))
+
+ (define bools '(symbol? integer? rational? real? number? complex? float? keyword? gensym? byte-vector? string? list?
+ char? boolean? float-vector? int-vector? vector? let? hash-table? input-port? null? pair?
+ output-port? iterator? continuation? dilambda? procedure? macro? random-state? eof-object? c-pointer?))
+
+ (define (compatible? type1 type2) ; we want type1, we have type2 -- is type2 ok?
+ ;(format *stderr* "compatible ~S ~S~%" type1 type2)
+ (or (eq? type1 type2)
+ (not (symbol? type1))
+ (not (symbol? type2))
+ (not (memq type1 bools))
+ (not (memq type2 bools))
+ (case type1
+ ((number? complex?) (memq type2 '(float? real? rational? integer? number? complex?)))
+ ((real?) (memq type2 '(float? rational? integer? complex? number?)))
+ ((float?) (memq type2 '(real? complex? number?)))
+ ((rational?) (memq type2 '(integer? real? complex? number?)))
+ ((integer?) (memq type2 '(real? rational? complex? number?)))
+ ((vector?) (memq type2 '(float-vector? int-vector?)))
+ ((float-vector? int-vector?) (eq? type2 'vector?))
+ ((symbol?) (memq type2 '(gensym? keyword?)))
+ ((keyword? gensym?) (eq? type2 'symbol?))
+ ((list?) (memq type2 '(null? pair?)))
+ ((pair? null?) (eq? type2 'list?))
+ ((dilambda?) (memq type2 '(procedure? macro? iterator?)))
+ ((procedure? macro?) (memq type2 '(dilambda? iterator?)))
+ ((iterator?) (memq type2 '(dilambda? procedure?)))
+ ((string?) (eq? type2 'byte-vector?))
+ ((byte-vector?) (eq? type2 'string?))
+ (else #f))))
+
+ (define (any-compatible? type1 type2)
+ ;; type1 and type2 can be either a list of types or a type
+ (if (symbol? type1)
+ (if (symbol? type2)
+ (compatible? type1 type2)
+ (and (pair? type2)
+ (or (compatible? type1 (car type2))
+ (any-compatible? type1 (cdr type2)))))
+ (and (pair? type1)
+ (or (compatible? (car type1) type2)
+ (any-compatible? (cdr type1) type2)))))
+
+ (define (subsumes? type1 type2)
+ (or (eq? type1 type2)
+ (case type1
+ ((rational?) (eq? type2 'integer?))
+ ((real?) (memq type2 '(integer? rational? float?)))
+ ((complex? number?) (memq type2 '(integer? rational? float? real? complex? number?)))
+ ((list?) (memq type2 '(pair? null? proper-list?)))
+ ((pair?) (eq? type2 'proper-list?))
+ ((vector?) (memq type2 '(float-vector? int-vector?)))
+ ((symbol?) (memq type2 '(keyword? gensym?)))
+ (else #f))))
+
+ (define (any-checker? types arg)
+ (if (and (symbol? types)
+ (not (eq? types 'values)))
+ ((symbol->value types *e*) arg)
+ (and (pair? types)
+ (or (any-checker? (car types) arg)
+ (any-checker? (cdr types) arg)))))
+
+ (define (never-false expr)
+ (or (eq? expr #t)
+ (let ((type (if (pair? expr)
+ (and (hash-table-ref no-side-effect-functions (car expr))
+ (return-type (car expr)))
+ (->type expr))))
+ (and (symbol? type)
+ (not (symbol? expr))
+ (not (memq type '(boolean? values)))))))
+
+ (define (never-true expr)
+ (or (not expr)
+ (and (pair? expr)
+ (eq? (car expr) 'not)
+ (let ((f (never-false (cadr expr))))
+ ;(format *stderr* "f: ~S~%" f)
+ f))))
+
+ ;; --------------------------------------------------------------------------------
+
+ (define (truncated-list->string form)
+ ;; return form -> string with limits on its length
+ (let* ((str (object->string form))
+ (len (length str)))
+ (if (< len 8)
+ (format #f " ~A" str)
+ (if (<= len 80)
+ (format #f "~% ~A" str)
+ (do ((i 77 (- i 1)))
+ ((or (= i 40)
+ (char-whitespace? (str i)))
+ (format #f "~% ~A..." (substring str 0 (if (<= i 40) 77 i)))))))))
+
+ (define (lists->string f1 f2)
+ ;; same but 2 strings that may need to be lined up vertically
+ (let* ((str1 (object->string f1))
+ (len1 (length str1))
+ (str2 (object->string f2))
+ (len2 (length str2)))
+ (if (< (+ len1 len2) 40)
+ (format #f "~A -> ~A" str1 str2)
+ (if (< (+ len1 len2) 80)
+ (format #f "~% ~A -> ~A" str1 str2)
+ (format #f "~% ~A ->~% ~A" str1 str2)))))
+
+ (define (lint-format str name . args)
+ (if (and (positive? line-number)
+ (< line-number 100000))
+ (apply format outport (string-append " ~A (line ~D): " str "~%") name line-number args)
+ (apply format outport (string-append " ~A: " str "~%") name args)))
+
+ (define (side-effect? form env)
+ ;; could evaluation of form have any side effects (like IO etc)
+
+ (if (and (proper-list? form) ; we don't want dotted lists or () here
+ (not (null? form)))
+ ;; can't optimize ((...)...) because the car might eval to a function
+ (or (and (not (hash-table-ref no-side-effect-functions (car form))) ; if func is not in that list, make no assumptions about it
+ (or (not (eq? (car form) 'format)) ; (format #f ...)
+ (cadr form)))
+ (case (car form)
+ ((set! define define* define-macro define-macro* define-bacro define-bacro* define-constant define-expansion) #t)
+
+ ((quote) #f)
+
+ ((case)
+ (or (not (pair? (cdr form)))
+ (side-effect? (cadr form) env) ; the selector
+ (letrec ((case-effect? (lambda (f e)
+ (and (pair? f)
+ (or (not (pair? (car f)))
+ (any? (lambda (ff) (side-effect? ff e)) (cdar f))
+ (case-effect? (cdr f) e))))))
+ (case-effect? (cddr form) env))))
+
+ ((cond)
+ (letrec ((cond-effect? (lambda (f e)
+ (and (pair? f)
+ (or (any? (lambda (ff) (side-effect? ff e)) (car f))
+ (cond-effect? (cdr f) e))))))
+ (or (not (pair? (cadr form)))
+ (cond-effect? (cdr form) env))))
+
+ ((let let* letrec letrec*)
+ (letrec ((let-effect? (lambda (f e)
+ (and (pair? f)
+ (or (not (pair? (car f)))
+ (not (pair? (cdar f))) ; an error, reported elsewhere: (let ((x)) x)
+ (side-effect? (cadar f) e)
+ (let-effect? (cdr f) e))))))
+ (if (symbol? (cadr form))
+ (or (let-effect? (caddr form) env)
+ (any? (lambda (ff) (side-effect? ff env)) (cdddr form)))
+ (or (let-effect? (cadr form) env)
+ (any? (lambda (ff) (side-effect? ff env)) (cddr form))))))
+
+ ((do)
+ (letrec ((do-effect? (lambda (f e)
+ (and (pair? f)
+ (or (not (pair? (car f)))
+ (not (pair? (cdar f)))
+ (side-effect? (cadar f) e)
+ (and (pair? (cddar f))
+ (side-effect? (caddar f) e))
+ (do-effect? (cdr f) e))))))
+ (or (< (length form) 3)
+ (not (list? (cadr form)))
+ (not (list? (caddr form)))
+ (do-effect? (cadr form) env)
+ (any? (lambda (ff) (side-effect? ff env)) (caddr form))
+ (any? (lambda (ff) (side-effect? ff env)) (cdddr form)))))
+
+ ;; ((lambda lambda*) (any? (lambda (ff) (side-effect? ff env)) (cddr form))) ; this is trickier than it looks
+
+ (else
+ (or (any? (lambda (f) (side-effect? f env)) (cdr form)) ; any subform has a side-effect
+ (let ((sig (procedure-signature (car form)))) ; sig has func arg and it is not known safe
+ (and sig
+ (memq 'procedure? (cdr sig))
+ (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (sg arg)
+ (when (eq? sg 'procedure?)
+ (if (or (not (symbol? arg))
+ (not (hash-table-ref no-side-effect-functions arg)))
+ (return #t))))
+ (cdr sig) (cdr form))
+ #f))))))))
+
+ (and (symbol? form)
+ (not (hash-table-ref no-side-effect-functions form))
+ (let ((e (or (var-member form env) (hash-table-ref globals form))))
+ (and (var? e)
+ (let? (var-new e)))))))
+
+
+ (define (just-constants? form env)
+ ;; can we probably evaluate form given just built-in stuff?
+ (or (and (constant? form)
+ (not (pair? form))
+ (not (vector? form)))
+ (and (pair? form)
+ (or (and (symbol? (car form))
+ (hash-table-ref no-side-effect-functions (car form))
+ (not (hash-table-ref globals (car form)))
+ (not (var-member (car form) env))) ; e.g. exp declared locally as a list
+ (and (constant? (car form))
+ (not (pair? (car form)))
+ (not (vector? (car form)))))
+ (just-constants? (cdr form) env))))
+
+
+ (define (equal-ignoring-constants? a b)
+ (or (morally-equal? a b)
+ (and (symbol? a)
+ (constant? a)
+ (morally-equal? (symbol->value a) b))
+ (and (symbol? b)
+ (constant? b)
+ (morally-equal? (symbol->value b) a))
+ (and (pair? a)
+ (pair? b)
+ (equal-ignoring-constants? (car a) (car b))
+ (equal-ignoring-constants? (cdr a) (cdr b)))))
+
+
+ (define (just-symbols? form)
+ (or (null? form)
+ (symbol? form)
+ (and (pair? form)
+ (symbol? (car form))
+ (just-symbols? (cdr form)))))
+
+ (define (list-any? f lst)
+ (if (pair? lst)
+ (or (f (car lst))
+ (list-any? f (cdr lst)))
+ (f lst)))
+
+ (define (reversible? func)
+ (memq func '(* + = char=? string=? eq? eqv? equal? morally-equal? logand logxor logior max min lcm gcd
+ < > <= >=
+ char<? char>? char<=? char>=?
+ string<? string>? string<=? string>=?
+ char-ci<? char-ci>? char-ci<=? char-ci>=?
+ string-ci<? string-ci>? string-ci<=? string-ci>=?)))
+
+ (define (reversed func)
+ (case func
+ ((<) '>) ((>) '<) ((<=) '>=) ((>=) '<=)
+ ((* + = char=? string=? eq? eqv? equal? morally-equal? logand logxor logior max min lcm gcd) func)
+ ((char<?) 'char>?) ((char>?) 'char<?) ((char<=?) 'char>=?) ((char>=?) 'char<=?)
+ ((string<?) 'string>?) ((string>?) 'string<?) ((string<=?) 'string>=?) ((string>=?) 'string<=?)
+ ((char-ci<?) 'char-ci>?) ((char-ci>?) 'char-ci<?) ((char-ci<=?) 'char-ci>=?) ((char-ci>=?) 'char-ci<=?)
+ ((string-ci<?) 'string-ci>?) ((string-ci>?) 'string-ci<?) ((string-ci<=?) 'string-ci>=?) ((string-ci>=?) 'string-ci<=?)
+ (else #f)))
+
+ (define (repeated-member? lst env)
+ (and (pair? lst)
+ (or (and (or (not (pair? (car lst)))
+ (and (not (side-effect? (car lst) env))
+ (not (eq? (caar lst) 'random))))
+ (pair? (cdr lst))
+ (member (car lst) (cdr lst)))
+ (repeated-member? (cdr lst) env))))
+
+ (define (check-args name head form checkers env max-arity)
+ ;; check for obvious argument type problems
+ ;; name = overall caller, head = current caller, checkers = proc or list of procs for checking args
+
+ (define (prettify-arg-number argn)
+ (if (or (not (= argn 1))
+ (pair? (cddr form)))
+ (format #f "~D " argn)
+ ""))
+
+ (define (check-checker checker at-end)
+ (if (eq? checker 'integer:real?)
+ (if at-end 'real? 'integer?)
+ (if (eq? checker 'integer:any?)
+ (or at-end 'integer?)
+ checker)))
+
+ (let ((arg-number 1))
+ (call-with-exit
+ (lambda (done)
+ (for-each
+ (lambda (arg)
+ (let ((checker (check-checker (if (list? checkers) (car checkers) checkers) (= arg-number (length (cdr form))))))
+ ;(format *stderr* "check-arg ~A check ~S via ~S~%" head arg checker)
+ (when (or (pair? checker)
+ (symbol? checker)) ; otherwise ignore type check on this argument (#t -> anything goes)
+ (if (pair? arg) ; arg is expr -- try to guess its type
+ (if (eq? (car arg) 'quote) ; '1 -> 1
+
+ ;; arg is quoted expression
+ (if (not (any-compatible? checker (if (pair? (cadr arg)) 'list? (->type (cadr arg)))))
+ (lint-format "~A's argument ~Ashould be a~A ~A: ~S: ~A"
+ name head
+ (prettify-arg-number arg-number)
+ (if (char=? (string-ref (format #f "~A" checker) 0) #\i) "n" "")
+ checker arg
+ (truncated-list->string form)))
+
+ ;; arg is an evaluated expression
+ (let ((op (return-type (car arg))))
+ ;; checker is arg-type, op is expression type (can also be a pair)
+ (unless (memq op '(#t #f values))
+
+ (if (or (not (any-compatible? checker op))
+ (and (just-constants? arg env) ; try to eval the arg
+ (catch #t
+ (lambda ()
+ (not (any-checker? checker (eval arg))))
+ (lambda ignore-catch-error-args
+ #f))))
+ (lint-format "~A's argument ~Ashould be a~A ~A: ~S: ~A"
+ name head
+ (prettify-arg-number arg-number)
+ (if (char=? (string-ref (format #f "~A" checker) 0) #\i) "n" "")
+ checker arg
+ (truncated-list->string form))))))
+ ;; arg is not a pair
+ (if (and (not (symbol? arg))
+ (not (any-checker? checker arg)))
+ (lint-format "~A's argument ~Ashould be a~A ~A: ~S: ~A"
+ name head
+ (prettify-arg-number arg-number)
+ (if (char=? (string-ref (format #f "~A" checker) 0) #\i) "n" "")
+ checker arg
+ (truncated-list->string form)))))
+
+ (if (list? checkers)
+ (if (null? (cdr checkers))
+ (done)
+ (set! checkers (cdr checkers))))
+ (set! arg-number (+ arg-number 1))
+ (if (> arg-number max-arity) (done))))
+ (cdr form))))))
+
+
+ (define (set-ref? name env)
+ ;; if name is in env, set its "I've been referenced" flag
+ (let ((data (or (var-member name env) (hash-table-ref globals name))))
+ (when (var? data)
+ (set! (var-ref data) #t)))
+ env)
+
+ (define (set-set? name new-val env)
+ ;; TODO: if (set! func val) need to either clear func info or fix it up
+
+ (let ((data (or (var-member name env) (hash-table-ref globals name))))
+ (when (var? data)
+ (set! (var-value data) new-val)
+ (set! (var-new data) #f) ; a stopgap
+ (set! (var-set data) #t))))
+
+ (define (proper-list lst)
+ ;; return lst as a proper list
+ (if (pair? lst)
+ (cons (car lst)
+ (if (pair? (cdr lst))
+ (proper-list (cdr lst))
+ (if (null? (cdr lst))
+ ()
+ (list (cdr lst)))))
+ lst))
+
+
+ (define (keywords lst)
+ (let ((count 0))
+ (do ((p lst (cdr p)))
+ ((null? p) count)
+ (if (keyword? (car p))
+ (set! count (+ count 1))))))
+ ;(count-if keyword? lst))
+
+ (define (check-star-parameters name args)
+ (if (list-any? (lambda (k) (memq k '(:key :optional))) args)
+ (lint-format ":optional and key are no longer accepted: ~A" name args))
+ (let ((r (memq :rest args)))
+ (if (and (pair? r)
+ (null? (cdr r)))
+ (lint-format ":rest parameter needs a name: ~A" name args)))
+ (let ((a (memq :allow-other-keys args)))
+ (if (and (pair? a)
+ (pair? (cdr a)))
+ (lint-format ":allow-other-keys should be at the end of the parameter list: ~A" name args))))
+
+ (define (tree-member sym tree)
+ (and (pair? tree)
+ (or (eq? (car tree) sym)
+ (and (pair? (car tree))
+ (tree-member sym (car tree)))
+ (tree-member sym (cdr tree)))))
+
+ (define (tree-car-member sym tree)
+ (and (pair? tree)
+ (or (eq? (car tree) sym)
+ (and (pair? (car tree))
+ (tree-car-member sym (car tree)))
+ (and (pair? (cdr tree))
+ (member sym (cdr tree) tree-car-member)))))
+
+ (define (remove item sequence)
+ (let ((got-it #f))
+ (map (lambda (x)
+ (if (and (not got-it)
+ (equal? x item))
+ (begin
+ (set! got-it #t)
+ (values))
+ x))
+ sequence)))
+
+ (define (remove-all item sequence)
+ (map (lambda (x)
+ (if (equal? x item)
+ (values)
+ x))
+ sequence))
+
+ (define (remove-if p l)
+ (cond ((null? l) ())
+ ((p (car l)) (remove-if p (cdr l)))
+ (else (cons (car l)
+ (remove-if p (cdr l))))))
+
+ (define (checked-eval form)
+ (catch #t
+ (lambda ()
+ (eval (copy-tree form)))
+ (lambda args
+ #t))) ; just ignore errors in this context
+
+ (define (return-type-ok? type ret)
+ (or (eq? type ret)
+ (and (pair? ret)
+ (memq type ret))))
+
+
+ (define (simplify-boolean in-form true false env)
+ ;; (or)->#f, (or x) -> x, (or x ... from here on we know x is #f), (or x #t...) -> (or x #t), any constant expr can be collapsed
+ ;; (or ... (or ...) ...) -> or of all, (or ... #f ...) toss the #f
+ ;; similarly for and
+ ;; (or ... (not (and ...))) -> (or ... (not x) [from here we know x is true] (not y)...)
+ ;; (or ... (not (and x1 x2 ...))) -> (or ... (not x1) (not x2)...), but is that simpler?
+
+ ;; (or x1 x2 x1) -> (or x1 x2)
+ ;; (and x1 x2 x1) -> (and x2 x1)
+
+ (define (bsimp uform)
+ ;; find and remove any expressions that have no effect on the outcome
+ (if (or (not (pair? uform))
+ (not (memq (car uform) '(and or not)))
+ (side-effect? uform env))
+ uform
+
+ (let ((vars ())
+ (associated-exprs ())
+ (ctr 0))
+
+ (define (tree-remove-all x lst)
+ (cond ((null? lst) ())
+ ((equal? (car lst) x) (tree-remove-all x (cdr lst)))
+ ((pair? (car lst)) (cons (tree-remove-all x (car lst)) (tree-remove-all x (cdr lst))))
+ (else (cons (car lst) (tree-remove-all x (cdr lst))))))
+
+ (define (canonical-tree lst)
+ (let ((data (assoc lst associated-exprs)))
+ (if data
+ (cdr data)
+ (if (pair? lst)
+ (cons (canonical-tree (car lst))
+ (canonical-tree (cdr lst)))
+ lst))))
+
+ (define (expand expr)
+ (define (car-rassoc val lst)
+ (and (pair? lst)
+ (if (equal? (cdar lst) val)
+ (car lst)
+ (car-rassoc val (cdr lst)))))
+ (let ((data (car-rassoc expr associated-exprs)))
+ (if data
+ (copy (car data))
+ (if (pair? expr)
+ (cons (expand (car expr))
+ (expand (cdr expr)))
+ expr))))
+
+ (define (bool-walk form func)
+ (if (and (pair? form)
+ (memq (car form) '(and or not)))
+ (for-each
+ (lambda (e)
+ (bool-walk e func))
+ (cdr form))
+ (func form)))
+
+ (bool-walk uform (lambda (val)
+ (if (and (or (pair? val)
+ (symbol? val))
+ (not (assoc val associated-exprs))
+ (not (memq val '(and or not)))) ; (not not)
+ (let ((new-var (string->symbol (format #f "bool-~D" ctr))))
+ (set! vars (cons new-var vars))
+ (set! associated-exprs (cons (cons val new-var) associated-exprs))
+ (set! ctr (+ ctr 1))))))
+
+ (if (or (null? vars)
+ (> (length vars) 8))
+ uform
+ (let ((len (length vars)))
+ (let ((vsize (expt 2 len))) ; 2^n possible cases
+ (let ((v (make-vector vsize))
+ (vals ())
+ (nonf (make-vector len))
+ (cur 0)
+ (ctr 0)
+ (form (canonical-tree uform)))
+ ;; (and (real? mag) (real? ang)) -> (and bool-0 bool-1)
+ ;; (not off) -> (not bool-0)
+ ;; (or din (sqrt 2.0)) -> (or bool-0 bool-1)
+
+ (for-each
+ (lambda (var)
+ (do ((i cur (+ i 1)))
+ ((not (tree-member i form)) ; tree-member uses eq? (should use = for this?)
+ (set! cur (+ i 1))
+ (vector-set! nonf ctr i)
+ (set! ctr (+ ctr 1)))))
+ vars)
+
+ (catch #t
+ (lambda ()
+ (let ((new-func (apply lambda vars form ())))
+ (do ((ctr 0 (+ ctr 1)))
+ ((= ctr vsize))
+ (vector-set! v ctr (apply new-func (let ((args ()))
+ (do ((i 0 (+ i 1)))
+ ((= i len) (reverse args))
+ (set! args (cons (and (logbit? ctr i)
+ (vector-ref nonf i))
+ args))))))
+ (if (not (member (vector-ref v ctr) vals))
+ (set! vals (cons (vector-ref v ctr) vals))))))
+ (lambda args 'error))
+
+ (if (= (length vals) 1)
+ (car vals)
+ (let ((none-vars ())
+ (pos -1))
+ (for-each
+ (lambda (var)
+ (set! pos (+ pos 1))
+ (call-with-exit
+ (lambda (return)
+ (do ((ctr 0 (+ ctr 1)))
+ ((= ctr vsize)
+ (set! none-vars (cons var none-vars)))
+ (if (and (not (logbit? ctr pos))
+ (not (equal? (vector-ref v ctr) (vector-ref v (logior ctr (ash 1 pos))))))
+ (return #f))))))
+ vars)
+
+ (if (pair? none-vars)
+ (begin
+ (for-each
+ (lambda (nv)
+ (set! form (tree-remove-all nv form)))
+ none-vars)
+ (expand form))
+ uform))))))))))
+
+ (define (true? e)
+ (or (member e true)
+ (and (pair? e)
+ (= (length e) 2)
+ (or (member e true
+ (lambda (a b)
+ ;; if a follows b, and b is true, do we know already know that a?
+ ;; (and (< x1 12) (real? x1) (= x1 1)) -> (and (< x1 12) (= x1 1))
+ (and (pair? b)
+ (or (and (= (length b) 2)
+ (equal? (cadr a) (cadr b))
+ (case (car a)
+ ((complex?) (memq (car b) '(number? real? rational? integer? even? odd?
+ positive? negative? zero? exact? inexact?)))
+ ((number?) (memq (car b) '(complex? real? rational? integer? even? odd?
+ positive? negative? zero? exact? inexact?)))
+ ((real?) (memq (car b) '(rational? integer? even? odd? positive? negative? exact? inexact?)))
+ ((rational?) (memq (car b) '(integer? even? odd?)))
+ ((integer?) (memq (car b) '(even? odd?)))
+ (else #f)))
+ (and (> (length b) 2)
+ (member (cadr a) (cdr b))
+ (case (car a)
+ ((complex? number?) (eq? (car b) '=))
+ ((real?) (memq (car b) '(< > <= >=)))
+ (else #f)))))))
+ (and (pair? (cadr e))
+ (memq (car e) bools)
+ (memq (return-type (caadr e)) bools)
+ (subsumes? (car e) (return-type (caadr e))))))))
+
+ (define (false? e)
+
+ (define (bad-arg-match a b)
+
+ ;; these accept only the given type and can return a boolean (so their value in a boolean expression is not known in advance)
+ (define (number-op? x) (memq x '(= < > <= >= even? odd? positive? negative? zero?)))
+ (define (char-op? x) (memq x '(char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?
+ char-alphabetic? char-numeric? char-whitespace? char-lower-case? char-upper-case?)))
+ (define (list-op? x) (memq x '(caaaar caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr caddr
+ cadr car cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar
+ cddddr cdddr cddr cdr list-ref)))
+ (define (string-op? x) (memq x '(string=? string<? string<=? string>? string>=? string-ci=? string-ci<? string-ci<=? string-ci>? string-ci>=?)))
+
+ (case a
+ ((complex? number? real? rational? integer?)
+ (or (char-op? b) ; that is, if these are false, then a non-number was accepted
+ (list-op? b) ; earlier as a valid argument, so it can't be a number
+ (string-op? b))) ; (or (char=? x1 #\a) (complex? x1) x1) -> (or (char=? x1 #\a) x1)
+ ((char?)
+ (or (number-op? b)
+ (list-op? b)
+ (string-op? b)))
+ ((string?)
+ (or (char-op? b)
+ (list-op? b)
+ (number-op? b)))
+ ((list?)
+ (or (char-op? b)
+ (number-op? b)
+ (string-op? b)))
+ ((boolean? procedure? symbol? continuation? let?)
+ (or (char-op? b)
+ (number-op? b)
+ (list-op? b)
+ (string-op? b)))
+ (else #f)))
+
+ (or (member e false)
+ (and (pair? e)
+ (= (length e) 2)
+ (or (member e false (lambda (a b)
+ (and (pair? b)
+ (>= (length b) 2)
+ (member (cadr a) (cdr b))
+ (bad-arg-match (car a) (car b)))))
+ (member e true (lambda (a b)
+ (and (pair? b)
+ (>= (length b) 2)
+ (member (cadr a) (cdr b))
+ (bad-arg-match (car a) (car b)))))
+ (and (pair? (cadr e))
+ (memq (car e) bools)
+ (memq (return-type (caadr e)) bools)
+ (not (any-compatible? (car e) (return-type (caadr e)))))))))
+
+ (define (contradictory? ands)
+ (let ((vars ()))
+ (call-with-exit
+ (lambda (return)
+ (do ((b ands (cdr b)))
+ ((null? b) #f)
+ (if (and (pair? b)
+ (pair? (car b))
+ (pair? (cdar b)))
+ (let* ((func (caar b))
+ (arg-type func)
+ (args (cdar b)))
+ (if (symbol? arg-type)
+ (for-each
+ (lambda (arg)
+ (if (symbol? arg)
+ (let ((type (assq arg vars)))
+ (if (not type)
+ (set! vars (cons (cons arg arg-type) vars))
+ (if (not (compatible? (cdr type) arg-type))
+ (return #t))))))
+ args)))))))))
+
+ (define (and-redundant? type1 type2)
+ (if (or (not (symbol? type1))
+ (not (symbol? type2))
+ (not (memq type1 bools))
+ (not (memq type2 bools)))
+ #f ; return #f if not (obviously) redundant, else return which of the two to keep
+ (if (eq? type1 type2)
+ type1
+ (case type1
+ ((number? complex?) (or (and (memq type2 '(float? real? rational? integer?)) type2)
+ (and (memq type2 '(number? complex?)) type1)))
+ ((real?) (or (and (memq type2 '(float? rational? integer?)) type2)
+ (and (memq type2 '(number? complex?)) type1)))
+ ((float?) (and (memq type2 '(real? complex? number?)) type1))
+ ((rational?) (or (and (eq? type2 'integer?) type2)
+ (and (memq type2 '(real? complex? number?)) type1)))
+ ((integer?) (and (memq type2 '(real? rational? complex? number?)) type1))
+ ((vector?) (and (memq type2 '(float-vector? int-vector?)) type2))
+ ((float-vector? int-vector?) (and (eq? type2 'vector?) type1))
+ ((symbol?) (and (memq type2 '(keyword? gensym?)) type2))
+ ((keyword? gensym?) (and (eq? type2 'symbol?) type1))
+ ((list?) (and (memq type2 '(null? pair?)) type2))
+ ((pair? null?) (and (eq? type2 'list?) type1))
+ ((string?) (and (eq? type2 'byte-vector?) type2))
+ ((byte-vector?) (and (eq? type2 'string?) type1))
+ (else #f)))))
+
+ (define (classify e)
+ ;; do we already know that e is true or false?
+ ;; some cases subsume others: if we know (integer? x) is true, (complex? x) is also true
+ (if (true? e)
+ #t ; the simple boolean is passed back which will either be dropped or will stop the outer expr build
+ (if (false? e)
+ #f
+ ;; eval of a constant expression here is tricky -- for example, (sqrt 2) should not be turned into 1.414...
+ (if (just-constants? e env)
+ (catch #t
+ (lambda ()
+ (let ((val (eval e)))
+ (if (boolean? val)
+ val
+ e)))
+ (lambda ignore e))
+ e))))
+
+ (define (store e value and/or)
+ ;; we can't make any assumptions about the expression if it might have side effects
+ ;; for example (or (= (oscil o) 0.0) (= (oscil o) 0.0)) can't be reduced
+
+ (if (or (not (pair? e))
+ (not (side-effect? e env)))
+ (let ((its-true (if (eq? and/or 'or)
+ (eq? value #t) ; or, so it's false if unknown
+ value)))
+ (if its-true
+ (set! true (cons e true))
+ (set! false (cons e false))))))
+
+ (let ((form (bsimp in-form)))
+ ;(format *stderr* "form: ~S~%" form)
+ (if (or (not (pair? form))
+ (not (memq (car form) '(or and not))))
+ (classify form)
+ (let ((len (length form)))
+
+ (case (car form)
+
+ ((not)
+ (if (= len 2)
+ (let* ((arg (cadr form))
+ (val (if (and (pair? arg)
+ (memq (car arg) '(and or not)))
+ (classify (simplify-boolean arg true false env))
+ (classify arg))))
+ ;(format *stderr* "val ~S, arg: ~S~%" val arg)
+ (if (boolean? val)
+ (not val)
+ (if (or (code-constant? arg)
+ (and (pair? arg)
+ (symbol? (car arg))
+ (hash-table-ref no-side-effect-functions (car arg))
+ (not (hash-table-ref globals (car arg)))
+ (let ((ret (return-type (car arg))))
+ (and (or (symbol? ret) (pair? ret))
+ (not (return-type-ok? 'boolean? ret))))
+ (not (var-member (car arg) env))))
+ #f
+ (if (and (pair? arg) ; (not (not ...)) -> ...
+ (pair? (cdr arg))
+ (eq? (car arg) 'not))
+ (cadr arg)
+ (if (not (equal? val arg))
+ `(not ,val)
+ (if (and (pair? arg)
+ (<= (length arg) 3)) ; avoid (<= 0 i 12) and such
+ (case (car arg)
+ ((<) `(>= ,@(cdr arg))) ; (not (< ...)) -> (>= ...)
+ ((>) `(<= ,@(cdr arg)))
+ ((<=) (if (morally-equal? (caddr arg) 0.0) `(positive? ,(cadr arg)) `(> ,@(cdr arg))))
+ ((>=) (if (morally-equal? (caddr arg) 0.0) `(negative? ,(cadr arg)) `(< ,@(cdr arg))))
+ ((char<?) `(char>=? ,@(cdr arg)))
+ ((char>?) `(char<=? ,@(cdr arg)))
+ ((char<=?) `(char>? ,@(cdr arg)))
+ ((char>=?) `(char<? ,@(cdr arg)))
+ ((char-ci<?) `(char-ci>=? ,@(cdr arg)))
+ ((char-ci>?) `(char-ci<=? ,@(cdr arg)))
+ ((char-ci<=?) `(char-ci>? ,@(cdr arg)))
+ ((char-ci>=?) `(char-ci<? ,@(cdr arg)))
+ ((string<?) `(string>=? ,@(cdr arg)))
+ ((string>?) `(string<=? ,@(cdr arg)))
+ ((string<=?) `(string>? ,@(cdr arg)))
+ ((string>=?) `(string<? ,@(cdr arg)))
+ ((string-ci<?) `(string-ci>=? ,@(cdr arg)))
+ ((string-ci>?) `(string-ci<=? ,@(cdr arg)))
+ ((string-ci<=?) `(string-ci>? ,@(cdr arg)))
+ ((string-ci>=?) `(string-ci<? ,@(cdr arg)))
+ ((odd?) `(even? ,@(cdr arg)))
+ ((even?) `(odd? ,@(cdr arg)))
+ ((exact?) `(inexact? ,@(cdr arg)))
+ ((inexact?) `(exact? ,@(cdr arg)))
+ ;; ((null?) `(pair? ,@(cdr arg)))
+ ;; this is not quite right
+ ;; char-upper-case? and lower are not switchable here
+
+ ;; if stuff loaded, (not (every? ...)) => any? and so on
+
+ ((zero?) ; (not (zero? (logand p (ash 1 i)))) -> (logbit? p i)
+ (let ((zarg (cadr arg))) ; (logand...)
+ (if (and (pair? zarg)
+ (eq? (car zarg) 'logand)
+ (pair? (cddr zarg))
+ (pair? (caddr zarg))
+ (eq? (caaddr zarg) 'ash)
+ (eqv? (cadr (caddr zarg)) 1))
+ `(logbit? ,(cadr zarg) ,(caddr (caddr zarg)))
+ form)))
+
+ (else form))
+ form))))))
+ form))
+
+ ((or)
+ (and (> len 1)
+ (let ((arg1 (cadr form)))
+ (if (= len 2)
+ (if (code-constant? arg1)
+ arg1
+ (classify arg1))
+ (if (true? arg1) ; no need to check anything else
+ #t ; side-effect? here is a nightmare
+ (let* ((arg2 (caddr form))
+ (t1 (and (= len 3)
+ (pair? arg1)
+ (pair? arg2)
+ (pair? (cdr arg1))
+ (pair? (cdr arg2))
+ (equal? (cadr arg1) (cadr arg2))
+ (not (side-effect? arg1 env))
+ (and-redundant? (car arg1) (car arg2)))))
+ (if t1
+ (if (eq? t1 (car arg1))
+ arg2
+ arg1)
+ (let ((sf #f))
+ (if (and (every? (lambda (p)
+ (and (pair? p)
+ (pair? (cdr p))
+ (eq? (car p) 'not)))
+ (cdr form))
+ (let ()
+ (set! sf (simplify-boolean `(not (and ,@(map cadr (cdr form)))) true false env))
+ (or (not (pair? sf))
+ (not (eq? (car sf) 'not))
+ (not (pair? (cadr sf)))
+ (not (eq? (caadr sf) 'and)))))
+ sf
+ ;; if all clauses are (eq-func x y) where one of x/y is a symbol|simple-expr repeated throughout
+ ;; and the y is a code-constant, or -> memq and friends. This could also handle cadr|caddr reversed.
+
+ ;; (or (pair? x) (null? x)) -> (list? x)
+
+ (let ((sym #f)
+ (eqf #f))
+ (if (every? (lambda (p)
+ (and (pair? p)
+ (if (not eqf)
+ (and (memq (car p) '(eq? eqv? equal? char=? string=? = char-ci=? string-ci=?))
+ (set! eqf (car p)))
+ (eq? eqf (car p)))
+ (if (not sym)
+ (and (not (side-effect? (cadr p) env))
+ (set! sym (cadr p)))
+ (equal? sym (cadr p)))
+ (code-constant? (caddr p))))
+ (cdr form))
+ (let* ((vals (map caddr (cdr form)))
+ (func (case eqf
+ ((eq?) 'memq)
+ ((eqv? char=?) 'memv)
+ ((=) (if (every? rational? vals) 'memv 'member))
+ (else 'member)))
+ (equals (if (and (eq? func 'member)
+ (not (eq? eqf 'equal?)))
+ (list eqf)
+ ()))
+ (elements (map (lambda (v) (if (pair? v) (cadr v) v)) vals)))
+ (if (and (eq? eqf 'char=?)
+ (= (length elements) 2)
+ (char-ci=? (car elements) (cadr elements)))
+ `(char-ci=? ,sym ,(car elements))
+ (if (and (eq? eqf 'string=?)
+ (= (length elements) 2)
+ (string-ci=? (car elements) (cadr elements)))
+ `(string-ci=? ,sym ,(car elements))
+ `(,func ,sym ',(map (lambda (v) (if (pair? v) (cadr v) v)) vals) , at equals))))
+
+ (let ((new-form ()))
+ (do ((exprs (cdr form) (cdr exprs)))
+ ((null? exprs)
+ (if (null? new-form)
+ #f
+ (if (null? (cdr new-form))
+ (car new-form)
+ `(or ,@(reverse new-form)))))
+ (let* ((e (car exprs))
+ (val (classify e)))
+
+ (if (and (pair? val)
+ (memq (car val) '(and or not)))
+ (set! val (classify (set! e (simplify-boolean e true false env)))))
+
+ (if val ; #f in or is ignored
+ (if (or (eq? val #t) ; #t or any non-#f constant in or ends the expression
+ (code-constant? val))
+ (begin
+ (if (null? new-form) ; (or x1 123) -> value of x1 first
+ (set! new-form (list val)) ;was `(,val))
+ (set! new-form (cons val new-form))) ;was (append `(,val) new-form))) ; reversed when returned
+ (set! exprs '(#t)))
+
+ ;; (or x1 x2 x1) -> (or x1 x2) is ok because if we get to x2, x1 is #f, so trailing x1 would still be #f
+
+ (if (and (pair? e) ; (or ...) -> splice into current
+ (eq? (car e) 'or))
+ (set! exprs (append e (cdr exprs))) ; we'll skip the 'or in do step
+ (begin ; else add it to our new expression with value #f
+ (store e val 'or)
+ (if (not (memq val new-form))
+ (set! new-form (cons val new-form)))))))))))))))))))))
+
+ ((and)
+ (or (= len 1)
+ (let ((arg1 (cadr form)))
+ (if (= len 2)
+ (classify arg1)
+ (and (not (contradictory? (cdr form)))
+ (let* ((arg2 (caddr form))
+ (t1 (and (= len 3)
+ (pair? arg1)
+ (pair? arg2)
+ (pair? (cdr arg1))
+ (pair? (cdr arg2))
+ (equal? (cadr arg1) (cadr arg2))
+ (not (side-effect? arg1 env))
+ (and-redundant? (car arg1) (car arg2))))) ; (and (integer? x) (number? x)) -> (integer? x)
+ (if t1
+ (if (eq? t1 (car arg1))
+ arg1
+ arg2)
+ (let ((new-form ()))
+
+ (if (and (= len 3)
+ (not (side-effect? arg1 env))
+ (equal? arg1 arg2)) ; (and x x) -> x
+ arg1
+
+ ;; (and (= ...)...) for more than 2 args?
+ ;; (and (< x y z) (< z w)) -> (< x y z w) ?
+ ;; (and (< x y) (< y z) (< z w)) -> (< x y z w)
+
+ (if (and (= len 3)
+ (pair? arg1)
+ (pair? arg2)
+ (reversible? (car arg1))
+ (null? (cdddr arg1))
+ (pair? (cdr arg2))
+ (pair? (cddr arg2))
+ (null? (cdddr arg2))
+ (not (side-effect? arg2 env)) ; arg1 is hit in any case
+ (or (eq? (car arg1) (car arg2))
+ (let ((rf (reversed (car arg2))))
+ (and (eq? (car arg1) rf)
+ (set! arg2 (append (list rf) (reverse (cdr arg2)))))))
+ (or (eq? (caddr arg1) (cadr arg2))
+ (eq? (cadr arg1) (caddr arg2))
+ (and (memq (car arg1) '(= char=? string=? char-ci=? string-ci=?))
+ (or (eq? (cadr arg1) (cadr arg2))
+ (eq? (caddr arg1) (caddr arg2))))))
+ (if (eq? (caddr arg1) (cadr arg2))
+ `(,(car arg1) ,(cadr arg1) ,(cadr arg2) ,(caddr arg2))
+ (if (eq? (cadr arg1) (caddr arg2))
+ `(,(car arg1) ,(cadr arg2) ,(cadr arg1) ,(caddr arg1))
+ (if (eq? (cadr arg1) (cadr arg2))
+ `(,(car arg1) ,(cadr arg1) ,(caddr arg1) ,(caddr arg2))
+ `(,(car arg1) ,(cadr arg1) ,(caddr arg1) ,(cadr arg2)))))
+
+ (do ((exprs (cdr form) (cdr exprs)))
+ ((null? exprs)
+ (if (null? new-form)
+ #t ; (and) -> #t
+ (let* ((nform (reverse new-form))
+ (newer-form (map (lambda (x cdr-x)
+ (if (and x (code-constant? x))
+ (values)
+ x))
+ nform (cdr nform))))
+ (if (null? newer-form)
+ (car new-form)
+ `(and , at newer-form ,(car new-form))))))
+
+ (let* ((e (car exprs))
+ (val (classify e)))
+
+ (if (and (pair? val)
+ (memq (car val) '(and or not)))
+ (set! val (classify (set! e (simplify-boolean e () false env)))))
+
+ ;; (and x1 x2 x1) is not reducible
+ ;; the final thing has to remain at the end, but can be deleted earlier if it can't short-circuit the evaluation,
+ ;; but if there are expressions following the first x1, we can't be sure that it is not
+ ;; protecting them:
+ ;; (and false-or-0 (display (list-ref lst false-or-0)) false-or-0)
+ ;; so I'll not try to optimize that case. But (and x x) is optimizable.
+
+ (if (eq? val #t)
+ (if (null? (cdr exprs)) ; (and x y #t) should not remove the #t
+ (if (or (and (pair? e)
+ (eq? (return-type (car e)) 'boolean?))
+ (eq? e #t))
+ (set! new-form (cons val new-form))
+ (if (or (null? new-form)
+ (not (equal? e (car new-form))))
+ (set! new-form (cons e new-form))))
+ (if (and (not (eq? e #t))
+ (or (null? new-form)
+ (not (member e new-form))))
+ (set! new-form (cons e new-form))))
+
+ (if (not val) ; #f in 'and' ends the expression
+ (begin
+ (if (or (null? new-form)
+ (just-symbols? new-form))
+ (set! new-form '(#f))
+ (set! new-form (cons #f new-form))) ;was (append '(#f) new-form)))
+ (set! exprs '(#f)))
+ (if (and (pair? e) ; if (and ...) splice into current
+ (eq? (car e) 'and))
+ (set! exprs (append e (cdr exprs)))
+ (if (not (and (pair? e) ; (and ... (or ... 123) ...) -> splice out or
+ (pair? (cdr exprs))
+ (eq? (car e) 'or)
+ (> (length e) 2)
+ (let ((last (list-ref e (- (length e) 1))))
+ (and last ; (or ... #f)
+ (code-constant? last)))))
+ (begin ; else add it to our new expression with value #t
+ (store e val 'and)
+ (if (or (not (pair? new-form))
+ (not (eq? val (car new-form))))
+ (set! new-form (cons val new-form)))))))))))))))))))))))))
+
+ (define (splice-if f lst)
+ (cond ((null? lst) ())
+ ((pair? lst)
+ (if (and (pair? (car lst))
+ (f (caar lst)))
+ (append (splice-if f (cdar lst)) (splice-if f (cdr lst)))
+ (cons (car lst) (splice-if f (cdr lst)))))
+ (#t lst)))
+
+
+ (define (simplify-numerics form env)
+ ;; this returns a form, possibly the original simplified
+ (let ((real-result? (lambda (op) (memq op '(imag-part real-part abs magnitude angle max min exact->inexact
+ modulo remainder quotient lcm gcd))))
+ (rational-result? (lambda (op) (memq op '(rationalize inexact->exact))))
+ (integer-result? (lambda (op) (memq op '(logior lognot logxor logand numerator denominator
+ floor round truncate ceiling ash)))))
+
+ (define (inverse-op op)
+ (case op
+ ((sin) 'asin) ((cos) 'acos) ((tan) 'atan) ((asin) 'sin) ((acos) 'cos) ((atan) 'tan)
+ ((sinh) 'asinh) ((cosh) 'acosh) ((tanh) 'atanh) ((asinh) 'sinh) ((acosh) 'cosh) ((atanh) 'tanh)
+ ((log) exp) ((exp) log)))
+
+
+ (define (remove-duplicates lst)
+ (letrec ((rem-dup
+ (lambda (lst nlst)
+ (cond ((null? lst) nlst)
+ ((and (member (car lst) nlst)
+ (or (not (pair? (car lst)))
+ (not (eq? (caar lst) 'random)))) ; this problem applies to anything that calls random, mus-random etc
+ (rem-dup (cdr lst) nlst))
+ (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+ (reverse (rem-dup lst ()))))
+
+ (define (just-rationals? form)
+ (or (null? form)
+ (rational? form)
+ (and (pair? form)
+ (rational? (car form))
+ (just-rationals? (cdr form)))))
+
+ (define (just-reals? form)
+ (or (null? form)
+ (real? form)
+ (and (pair? form)
+ (real? (car form))
+ (just-reals? (cdr form)))))
+
+ (define (just-integers? form)
+ (or (null? form)
+ (integer? form)
+ (and (pair? form)
+ (integer? (car form))
+ (just-integers? (cdr form)))))
+
+ (define (simplify-arg x)
+ (if (or (not (pair? x)) ; constants and the like look dumb if simplified
+ (hash-table-ref globals (car x))
+ (not (hash-table-ref no-side-effect-functions (car x)))
+ (var-member (car x) env))
+ x
+ (let ((f (simplify-numerics x env)))
+ (if (and (pair? f)
+ (just-rationals? f))
+ (catch #t
+ (lambda ()
+ (eval f))
+ (lambda ignore f))
+ f))))
+
+ (let* ((args (map simplify-arg (cdr form)))
+ (len (length args)))
+
+ (case (car form)
+ ((+)
+ (case len
+ ((0) 0)
+ ((1) (car args))
+ (else
+ (let ((val (remove-all 0 (splice-if (lambda (x) (eq? x '+)) args))))
+ (if (every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+ (let ((rats (collect-if list rational? val)))
+ (if (> (length rats) 1)
+ (let ((y (apply + rats)))
+ (if (zero? y)
+ (set! val (collect-if list (lambda (x) (not (number? x))) val))
+ (set! val (cons y (collect-if list (lambda (x) (not (number? x))) val))))))))
+ (case (length val)
+ ((0) 0)
+ ((1) (car val)) ; (+ x) -> x
+ (else `(+ , at val))))))) ; other obvious simplifications never happen
+
+ ((*)
+ (case len
+ ((0) 1)
+ ((1) (car args))
+ (else
+ (let ((val (remove-all 1 (splice-if (lambda (x) (eq? x '*)) args))))
+ (if (every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+ (let ((rats (collect-if list rational? val)))
+ (if (> (length rats) 1)
+ (let ((y (apply * rats)))
+ (if (= y 1)
+ (set! val (collect-if list (lambda (x) (not (number? x))) val))
+ (set! val (cons y (collect-if list (lambda (x) (not (number? x))) val))))))))
+ (case (length val)
+ ((0) 1)
+ ((1) (car val)) ; (* x) -> x
+ (else
+ (if (just-rationals? val)
+ (apply * val)
+ (if (memv 0 val) ; (* x 0 2) -> 0
+ 0
+ (if (= (length val) 2)
+ (if (memv -1 val)
+ `(- ,@(remove -1 val)) ; (* -1 x) -> (- x)
+ (if (and (pair? (car val))
+ (pair? (cadr val))
+ (= (length (car val)) 3)
+ (equal? (cdar val) (cdadr val))
+ (or (and (eq? (caar val) 'gcd) (eq? (caadr val) 'lcm))
+ (and (eq? (caar val) 'lcm) (eq? (caadr val) 'gcd))))
+ `(abs (* ,@(cdar val))) ; (* (gcd a b) (lcm a b)) -> (abs (* a b)) but only if 2 args?
+ `(* , at val)))
+ `(* , at val))))))))))
+
+ ((-)
+ (case len
+ ((0) form)
+ ((1) ; negate
+ (if (number? (car args))
+ (- (car args))
+ (if (not (list? (car args)))
+ `(- , at args)
+ (case (length (car args))
+ ((2) (if (eq? (caar args) '-)
+ (cadar args) ; (- (- x)) -> x
+ `(- , at args)))
+ ((3) (if (eq? (caar args) '-)
+ `(- ,(caddar args) ,(cadar args)) ; (- (- x y)) -> (- y x)
+ `(- , at args)))
+ (else `(- , at args))))))
+ ((2)
+ (if (just-rationals? args)
+ (apply - args)
+ (if (eqv? (car args) 0)
+ `(- ,(cadr args)) ; (- 0 x) -> (- x)
+ (if (eqv? (cadr args) 0)
+ (car args) ; (- x 0) -> x
+ (if (equal? (car args) (cadr args))
+ 0 ; (- x x)
+ (if (and (pair? (car args))
+ (eq? (caar args) '-)
+ (> (length (car args)) 2))
+ `(- ,@(cdar args) ,(cadr args)) ; (- (- x y) z) -> (- x y z) but leave (- (- x) ...)
+ `(- , at args)))))))
+ (else
+ (let ((val (remove-all 0 (splice-if (lambda (x) (eq? x '+)) (cdr args)))))
+ (if (every? (lambda (x) (or (not (number? x)) (rational? x))) val)
+ (let ((rats (collect-if list rational? val)))
+ (if (> (length rats) 1)
+ (let ((y (apply + rats)))
+ (if (zero? y)
+ (set! val (collect-if list (lambda (x) (not (number? x))) val))
+ (set! val (cons y (collect-if list (lambda (x) (not (number? x))) val))))))))
+ (set! val (cons (car args) val))
+ (let ((first-arg (car args))
+ (nargs (cdr val)))
+ (if (member first-arg nargs)
+ (begin
+ (set! nargs (remove first-arg nargs)) ; remove once
+ (set! first-arg 0)))
+ (if (null? nargs)
+ first-arg ; (- x 0 0 0)?
+ (if (and (eqv? first-arg 0)
+ (= (length nargs) 1))
+ (if (number? (car nargs))
+ (- (car nargs))
+ `(- ,(car nargs))) ; (- 0 0 0 x)?
+ `(- ,@(cons first-arg nargs)))))))))
+
+ ((/)
+ (case len
+ ((0) form)
+ ((1) ; invert
+ (if (number? (car args))
+ (if (zero? (car args))
+ `(/ ,(car args))
+ (/ (car args)))
+ (if (pair? (car args))
+ (if (and (= (length (car args)) 2)
+ (eq? (caar args) '/))
+ (cadar args)
+ `(/ , at args))
+ `(/ , at args))))
+ ((2)
+ (if (and (just-rationals? args)
+ (not (zero? (cadr args))))
+ (apply / args) ; including (/ 0 12) -> 0
+ (let ((arg1 (car args))
+ (arg2 (cadr args)))
+ (if (eqv? arg1 1) ; (/ 1 x) -> (/ x)
+ `(/ ,arg2)
+ (if (eqv? arg2 1)
+ arg1 ; (/ x 1) -> x
+ (if (and (pair? arg1) ; (/ (log x) (log y)) -> (log x y)
+ (= (length arg1) 2)
+ (pair? arg2)
+ (= (length arg2) 2)
+ (eq? (car arg1) 'log)
+ (eq? (car arg2) 'log))
+ `(log ,(cadr arg1) ,(cadr arg2))
+ (if (and (pair? arg1)
+ (eq? (car arg1) '/)
+ (pair? arg2)
+ (eq? '/ (car arg2)))
+ (let ((a1 (if (null? (cddr arg1)) `(/ 1 ,(cadr arg1)) arg1))
+ (a2 (if (null? (cddr arg2)) `(/ 1 ,(cadr arg2)) arg2)))
+ (simplify-numerics `(/ (* ,(cadr a1) ,@(cddr a2)) (* ,@(cddr a1) ,(cadr a2))) env))
+ `(/ , at args))))))))
+
+ (else
+ (if (and (just-rationals? args)
+ (not (memv 0 (cdr args)))
+ (not (memv 0.0 (cdr args))))
+ (apply / args)
+ (let ((nargs ; (/ x a (* b 1 c) d) -> (/ x a b c d) but not short cases
+ (remove-all 1 (splice-if (lambda (x) (eq? x '*)) (cdr args)))))
+ (if (null? nargs) ; (/ x 1 1) -> x
+ (car args)
+ `(/ ,@(cons (car args) nargs))))))))
+
+ ((sin cos asin acos sinh cosh tanh asinh acosh atanh exp)
+ (if (= len 1)
+ (if (and (pair? (car args))
+ (= (length (car args)) 2)
+ (eq? (caar args) (inverse-op (car form))))
+ (cadar args)
+ (if (eqv? (car args) 0)
+ (case (car form)
+ ((sin asin sinh asinh tanh atanh) 0)
+ ((exp cos cosh) 1)
+ (else `(,(car form) , at args)))
+ (if (and (eq? (car form) 'cos)
+ (pair? (car args))
+ (eq? (caar args) '-)
+ (null? (cddar args)))
+ `(cos ,(cadar args))
+ (if (eq? (car args) 'pi)
+ (case (car form)
+ ((sin) 0.0)
+ ((cos) 1.0)
+ (else `(,(car form) , at args)))
+ (if (eqv? (car args) 0.0)
+ (apply (symbol->value (car form)) '(0.0))
+ (if (and (eq? (car form) 'exp) ; (exp (* a (log b))) -> (expt b a)
+ (pair? (car args))
+ (eq? (caar args) '*))
+ (let ((targ (cdar args)))
+ (if (= (length targ) 2)
+ (if (and (pair? (car targ))
+ (eq? (caar targ) 'log)
+ (pair? (cdar targ))
+ (null? (cddar targ)))
+ `(expt ,(cadar targ) ,(cadr targ))
+ (if (and (pair? (cadr targ))
+ (eq? (caadr targ) 'log)
+ (pair? (cdadr targ))
+ (null? (cddadr targ)))
+ `(expt ,(cadadr targ) ,(car targ))
+ `(,(car form) , at args)))
+ `(,(car form) , at args)))
+ `(,(car form) , at args)))))))
+ `(,(car form) , at args)))
+
+ ((log)
+ (if (pair? args)
+ (if (eqv? (car args) 1)
+ 0
+ (if (and (= len 1)
+ (pair? (car args))
+ (= (length (car args)) 2)
+ (eq? (caar args) 'exp))
+ (cadar args)
+ (if (and (= len 2)
+ (equal? (car args) (cadr args)))
+ (if (integer? (car args))
+ 1
+ 1.0)
+ `(log , at args))))
+ form))
+
+ ((sqrt)
+ (if (pair? args)
+ (if (and (rational? (car args))
+ (= (car args) (* (sqrt (car args)) (sqrt (car args)))))
+ (sqrt (car args)) ; don't collapse (sqrt (* a a)), a=-1 for example
+ `(sqrt , at args))
+ form))
+
+ ((floor round ceiling truncate)
+ (if (= len 1)
+ (if (number? (car args))
+ (catch #t (lambda ()
+ (apply (symbol->value (car form)) args))
+ (lambda any
+ `(,(car form) , at args)))
+ (if (and (pair? (car args))
+ (integer-result? (caar args)))
+ (car args)
+ `(,(car form) , at args)))
+ form))
+
+ ((abs magnitude)
+ (if (= len 1)
+ (if (and (pair? (car args))
+ (memq (caar args) '(abs magnitude denominator)))
+ (car args)
+ (if (rational? (car args))
+ (abs (car args))
+ (if (and (pair? (car args)) ; (abs (modulo x 2)) -> (modulo x 2)
+ (eq? (caar args) 'modulo)
+ (= (length (car args)) 3)
+ (number? (caddar args))
+ (positive? (caddar args)))
+ (car args)
+ (if (and (pair? (car args)) ; (abs (- x)) -> (abs x)
+ (eq? (caar args) '-)
+ (pair? (cdar args))
+ (null? (cddar args)))
+ `(,(car form) ,(cadar args))
+ `(,(car form) , at args)))))
+ form))
+
+ ((imag-part)
+ (if (= len 1)
+ (if (or (real? (car args))
+ (and (pair? (car args))
+ (real-result? (caar args))))
+ 0.0
+ `(imag-part , at args))
+ form))
+
+ ((real-part)
+ (if (= len 1)
+ (if (or (real? (car args))
+ (and (pair? (car args))
+ (real-result? (caar args))))
+ (car args)
+ `(real-part , at args))
+ form))
+
+ ((denominator)
+ (if (= len 1)
+ (if (or (integer? (car args))
+ (and (pair? (car args))
+ (integer-result? (caar args))))
+ 1
+ `(denominator ,(car args)))
+ form))
+
+ ((numerator)
+ (if (= len 1)
+ (if (or (integer? (car args))
+ (and (pair? (car args))
+ (integer-result? (caar args))))
+ (car args)
+ (if (rational? (car args))
+ (numerator (car args))
+ `(numerator ,(car args))))
+ form))
+
+ ((random)
+ (if (and (= len 1)
+ (number? (car args)))
+ (if (and (integer? (car args))
+ (= (car args) 0))
+ 0
+ (if (morally-equal? (car args) 0.0)
+ 0.0
+ `(random , at args)))
+ `(random , at args)))
+ ;; what about (* 2.0 (random 1.0)) and the like?
+ ;; this is trickier than it appears: (* 2.0 (random 3)) etc
+
+ ((complex)
+ (if (and (= len 2)
+ (morally-equal? (cadr args) 0.0)) ; morally so that 0 matches
+ (car args)
+ `(complex , at args)))
+
+ ((rationalize lognot ash modulo remainder quotient)
+ (if (just-rationals? args)
+ (catch #t ; catch needed here for things like (ash 2 64)
+ (lambda ()
+ (apply (symbol->value (car form)) args))
+ (lambda ignore
+ `(,(car form) , at args))) ; use this form to pick up possible arg changes
+ `(,(car form) , at args)))
+
+ ((expt)
+ (if (= len 2)
+ (if (and (eqv? (car args) 0)
+ (not (eqv? (cadr args) 0)))
+ 0
+ (if (and (eqv? (cadr args) 0)
+ (not (eqv? (car args) 0)))
+ 1
+ (if (eqv? (car args) 1)
+ 1
+ (if (eqv? (cadr args) 1)
+ (car args)
+ (if (eqv? (cadr args) -1)
+ `(/ ,(car args))
+ (if (just-rationals? args)
+ (catch #t
+ (lambda ()
+ (let ((val (apply expt args)))
+ (if (integer? val)
+ val
+ `(expt , at args))))
+ (lambda args
+ `(expt , at args)))
+ `(expt , at args)))))))
+ form))
+
+ ((angle)
+ (if (pair? args)
+ (if (eqv? (car args) -1)
+ 'pi
+ (if (or (morally-equal? (car args) 0.0)
+ (eq? (car args) 'pi))
+ 0.0
+ `(angle , at args)))
+ form))
+
+ ((atan)
+ (if (and (= len 1)
+ (pair? (car args))
+ (= (length (car args)) 3)
+ (eq? (caar args) '/))
+ `(atan ,@(cdar args))
+ `(atan , at args)))
+
+ ((inexact->exact)
+ (if (= len 1)
+ (if (or (rational? (car args))
+ (and (pair? (car args))
+ (or (rational-result? (caar args))
+ (integer-result? (caar args)))))
+ (car args)
+ (if (number? (car args))
+ (catch #t (lambda () (inexact->exact (car args))) (lambda any `(inexact->exact , at args)))
+ `(inexact->exact , at args)))
+ form))
+
+ ((logior)
+ (set! args (remove-duplicates (remove-all 0 (splice-if (lambda (x) (eq? x 'logior)) args))))
+ (if (every? (lambda (x) (or (not (number? x)) (integer? x))) args)
+ (let ((rats (collect-if list integer? args)))
+ (if (> (length rats) 1)
+ (let ((y (apply logior rats)))
+ (if (zero? y)
+ (set! args (collect-if list (lambda (x) (not (number? x))) args))
+ (set! args (cons y (collect-if list (lambda (x) (not (number? x))) args))))))))
+ (if (null? args) ; (logior) -> 0
+ 0
+ (if (null? (cdr args)) ; (logior x) -> x
+ (car args)
+ (if (memv -1 args)
+ -1
+ (if (just-integers? args)
+ (apply logior args)
+ `(logior , at args))))))
+
+ ((logand)
+ (set! args (remove-duplicates (remove-all -1 (splice-if (lambda (x) (eq? x 'logand)) args))))
+ (if (every? (lambda (x) (or (not (number? x)) (integer? x))) args)
+ (let ((rats (collect-if list integer? args)))
+ (if (> (length rats) 1)
+ (let ((y (apply logand rats)))
+ (if (= y -1)
+ (set! args (collect-if list (lambda (x) (not (number? x))) args))
+ (set! args (cons y (collect-if list (lambda (x) (not (number? x))) args))))))))
+ (if (null? args)
+ -1
+ (if (null? (cdr args)) ; (logand x) -> x
+ (car args)
+ (if (memv 0 args)
+ 0
+ (if (just-integers? args)
+ (apply logand args)
+ `(logand , at args))))))
+ ;; (logand 1 (logior 2 x)) -> (logand 1 x)?
+ ;; (logand 1 (logior 1 x)) -> 1
+ ;; (logand 3 (logior 1 x))?
+ ;; similarly for (logior...(logand...))
+
+ ((logxor)
+ (set! args (splice-if (lambda (x) (eq? x 'logxor)) args)) ; is this correct??
+ (if (null? args)
+ 0
+ (if (null? (cdr args)) ; (logxor x) -> x??
+ (car args)
+ (if (just-integers? args)
+ (apply logxor args)
+ (if (and (= len 2)
+ (equal? (car args) (cadr args)))
+ 0
+ `(logxor , at args))))))
+
+ ((gcd)
+ (set! args (remove-duplicates (splice-if (lambda (x) (eq? x 'gcd)) args)))
+ (if (null? args)
+ 0
+ ;; here and in lcm, if just 1 arg -> (abs arg)
+ (if (memv 1 args)
+ 1
+ (if (just-integers? args)
+ (catch #t ; maybe (gcd -9223372036854775808 -9223372036854775808)
+ (lambda ()
+ (apply gcd args))
+ (lambda ignore
+ `(gcd , at args)))
+ (if (null? (cdr args))
+ `(abs ,(car args))
+ (if (eqv? (car args) 0)
+ `(abs ,(cadr args))
+ (if (eqv? (cadr args) 0)
+ `(abs ,(car args))
+ `(gcd , at args))))))))
+
+ ((lcm)
+ (set! args (remove-duplicates (splice-if (lambda (x) (eq? x 'lcm)) args)))
+ (if (null? args)
+ 1
+ (if (memv 0 args)
+ 0
+ (if (just-integers? args)
+ (catch #t
+ (lambda ()
+ (apply lcm args))
+ (lambda ignore
+ `(lcm , at args)))
+ (if (null? (cdr args))
+ `(abs ,(car args))
+ `(lcm , at args))))))
+
+ ((max min)
+ (if (pair? args)
+ (begin
+ (set! args (remove-duplicates (splice-if (lambda (x) (eq? x (car form))) args)))
+ (if (= len 1)
+ (car args)
+ (if (just-reals? args)
+ (apply (symbol->value (car form)) args)
+ (let ((nums (collect-if list number? args))
+ (other (if (eq? (car form) 'min) 'max 'min)))
+ (if (and (pair? nums)
+ (just-reals? nums)) ; non-real case checked elsewhere (later)
+ (let ((relop (if (eq? (car form) 'min) >= <=)))
+ (if (> (length nums) 1)
+ (set! nums (list (apply (symbol->value (car form)) nums))))
+ (let ((new-args (append nums (collect-if list (lambda (x) (not (number? x))) args))))
+ (let ((c1 (car nums)))
+ (set! new-args (collect-if list (lambda (x)
+ (or (not (pair? x))
+ (<= (length x) 2)
+ (not (eq? (car x) other))
+ (let ((c2 (find-if number? (cdr x))))
+ (or (not c2)
+ (relop c1 c2)))))
+ new-args)))
+ (if (< (length new-args) (length args))
+ (set! args new-args)))))
+ ;; if (max c1 (min c2 . args1) . args2) where (>= c1 c2) -> (max c1 . args2)
+ ;; if (min c1 (max c2 . args1) . args2) where (<= c1 c2) -> (min c1 . args2)
+
+ ;; there are more such cases: (max x (min x 3)) -> x and (min x (max x c)) -> x
+ ;; (max a b) is (- (min (- a) (- b))), but that doesn't help here -- the "-" gets in our way
+ (if (null? (cdr args)) ; (max (min x 3) (min x 3)) -> (max (min x 3)) -> (min x 3)
+ (car args)
+ (if (and (null? (cddr args)) ; (max|min x (min|max x ...) -> x
+ (or (and (pair? (car args))
+ (eq? (caar args) other)
+ (symbol? (cadr args)) ; actually this is probably not needed, but I want to avoid (random ...)
+ ;; perhaps instead use not min/max
+ (member (cadr args) (car args)))
+ (and (pair? (cadr args))
+ (eq? (caadr args) other)
+ (symbol? (car args))
+ (member (car args) (cadr args)))))
+ ((if (pair? (car args)) cadr car) args)
+ `(,(car form) , at args)))))))
+ form))
+
+ (else `(,(car form) , at args))))))
+
+
+ (define (->eqf x)
+ (case x
+ ((char?) '(eqv? char=?))
+ ((integer? rational? real? number? complex?) '(eqv? =))
+ ((symbol? keyword? boolean?)'(eq? eq?))
+ ((string? byte-vector?) '(equal? string=?))
+ ((null?) '(eq? null?))
+ ((pair? vector? float-vector? int-vector? hash-table?) '(equal? equal))
+ (else '(#t #t))))
+
+ (define (eqf selector)
+ (if (symbol? selector)
+ '(#t #t)
+ (if (not (pair? selector))
+ (->eqf (->type selector))
+ (if (eq? (car selector) 'quote)
+ (if (symbol? (cadr selector))
+ '(eq? eq?)
+ (if (null? (cadr selector))
+ '(eq? null?)
+ (if (char? (cadr selector))
+ '(eqv? char=?)
+ '(equal? equal?))))
+ (if (symbol? (car selector))
+ (->eqf (return-type (car selector)))
+ '(#t #t))))))
+
+
+ (define (check-special-cases name head form env)
+
+ (case head
+
+ ((memq assq memv assv member assoc)
+ (define (list-one? p)
+ (and (pair? p)
+ (pair? (cdr p))
+ (null? (cddr p))
+ (or (and (eq? (car p) 'list)
+ cadr)
+ (and (eq? (car p) 'quote)
+ (pair? (cadr p))
+ (null? (cdadr p))
+ (if (symbol? (caadr p))
+ (lambda (x) (list 'quote (caadr x)))
+ caadr)))))
+
+ (if (= (length form) 4)
+ (let ((func (list-ref form 3)))
+ (if (symbol? func)
+ (let ((sig (procedure-signature (symbol->value func))))
+ (if (and sig
+ (not (eq? (car sig) 'boolean?)))
+ (lint-format "~A is a questionable ~A function" name func head)))
+ (if (and (pair? func)
+ (= (length func) 3)
+ (eq? (car func) 'lambda)
+ (pair? (cadr func))
+ (pair? (caddr func)))
+ (if (not (member (length (cadr func)) '(2 -1)))
+ (lint-format "~A equality function (optional 3rd arg) should take two arguments" name head)
+ (if (eq? head 'member)
+ (let ((eq (caddr func))
+ (args (cadr func)))
+ (if (and (memq (car eq) '(eq? eqv? equal?))
+ (eq? (car args) (cadr eq))
+ (pair? (caddr eq))
+ (eq? (car (caddr eq)) 'car)
+ (pair? (cdr (caddr eq)))
+ (pair? (cdr args))
+ (eq? (cadr args) (cadr (caddr eq))))
+ (lint-format "member might perhaps be ~A"
+ name
+ (if (or (eq? func 'eq?)
+ (eq? (car (caddr func)) 'eq?))
+ 'assq
+ (if (eq? (car (caddr func)) 'eqv?)
+ 'assv
+ 'assoc))))))))))
+
+ (when (= (length form) 3)
+ (let ((selector (cadr form))
+ (items (caddr form)))
+ (let ((current-eqf (case head ((memq assq) 'eq?) ((memv assv) 'eqv?) (else 'equal?)))
+ (selector-eqf (eqf selector))
+ (one-item (and (memq head '(memq memv member)) (list-one? (caddr form)))))
+ ;; one-item assoc doesn't simplify cleanly
+
+ (if one-item
+ (let* ((target (one-item items))
+ (iter-eqf (eqf target)))
+ (lint-format "perhaps ~A" name
+ (if (or (symbol? target)
+ (and (pair? target)
+ (not (eq? (car target) 'quote))))
+ (lists->string form `(,(cadr iter-eqf) ,selector ',target))
+ (lists->string form `(,(cadr iter-eqf) ,selector ,target)))))
+
+ (letrec ((duplicates? (lambda (lst fnc)
+ (and (pair? lst)
+ (or (fnc (car lst) (cdr lst))
+ (duplicates? (cdr lst) fnc)))))
+ (duplicate-constants? (lambda (lst fnc)
+ (and (pair? lst)
+ (or (and (constant? (car lst))
+ (fnc (car lst) (cdr lst)))
+ (duplicate-constants? (cdr lst) fnc))))))
+ (if (and (pair? items)
+ (or (eq? (car items) 'list)
+ (and (eq? (car items) 'quote)
+ (pair? (cadr items)))))
+ (let ((baddy #f))
+ (catch #t
+ (lambda ()
+ (if (eq? (car items) 'list) ; TODO: restrict to constants?
+ (set! baddy (duplicate-constants? (cdr items) (symbol->value head)))
+ (set! baddy (duplicates? (cadr items) (symbol->value head)))))
+ (lambda args #f))
+ (if (pair? baddy)
+ (lint-format "duplicated entry ~S in ~A" name (car baddy) items))))
+
+ (if (and (symbol? (car selector-eqf))
+ (not (eq? (car selector-eqf) current-eqf)))
+ (lint-format "~A: perhaps ~A -> ~A" name form head
+ (if (memq head '(memq memv member))
+ (case (car selector-eqf) ((eq?) 'memq) ((eqv?) 'memv) ((equal?) 'member))
+ (case (car selector-eqf) ((eq?) 'assq) ((eqv?) 'assv) ((equal?) 'assoc))))))))
+
+ (when (and (memq head '(memq memv))
+ (pair? items)
+ (eq? (car items) 'quote)
+ (pair? (cadr items)))
+ (let ((bad (find-if (lambda (x)
+ (not (or (symbol? x)
+ (char? x)
+ (number? x)
+ (procedure? x) ; (memq abs '(1 #_abs 2)) !
+ (memq x '(#f #t () #<unspecified> #<undefined> #<eof>)))))
+ (cadr items))))
+ (if bad
+ (if (pair? bad)
+ (if (eq? (car bad) 'quote)
+ (lint-format "stray quote? ~A" name form)
+ (if (eq? (car bad) 'unquote)
+ (lint-format "stray comma? ~A" name form)
+ (lint-format "pointless list member: ~S in ~A" name bad form)))
+ (lint-format "pointless list member: ~S in ~A" name bad form)))))))))
+
+ ((if)
+ (let ((len (length form)))
+ (if (> len 4)
+ (lint-format "if has too many clauses: ~A" name form)
+ (if (< len 3)
+ (lint-format "if has too few clauses: ~A" name form)
+ (let ((test (cadr form))
+ (true (caddr form))
+ (false (if (= len 4) (cadddr form) 'no-false)))
+
+ (if (never-false test)
+ (lint-format "if test is never false: ~A" name form)
+ (if (and (never-true test) true) ; complain about (if #f #f) later
+ (lint-format "if test is never true: ~A" name form)))
+
+ (let ((expr (simplify-boolean test () () env)))
+ ;(format *stderr* "expr simplified: ~S~%" expr)
+
+ (if (not (side-effect? test env))
+ (if (or (equal? test true) (equal? expr true))
+ (lint-format "perhaps ~A" name
+ (lists->string form
+ (if (eq? false 'no-false)
+ (simplify-boolean `(or ,expr #<unspecified>) () () env)
+ (simplify-boolean `(or ,expr ,false) () () env))))
+ (if (or (equal? test false) (equal? expr false))
+ (lint-format "perhaps ~A" name
+ (lists->string form (simplify-boolean `(and ,expr ,true) () () env))))))
+
+ (if (pair? false)
+ (begin
+ (if (and (eq? (car false) 'if)
+ (pair? (cdr false))
+ (pair? (cadr false))
+ (eq? (caadr false) 'not)
+ (or (equal? test (cadr (cadr false))) (equal? expr (cadr (cadr false))))
+ (not (side-effect? test env)))
+ (lint-format "pointless repetition of if test: ~A" name (lists->string form `(if ,expr ,true ,(caddr false)))))
+
+ (if (and (eq? (car false) 'if) ; (if test0 expr (if test1 expr)) -> if (or test0 test1) expr)
+ (equal? true (caddr false)))
+ (let ((test1 (simplify-boolean `(or ,expr ,(cadr false)) () () env)))
+ (lint-format "perhaps ~A" name (lists->string form `(if ,test1 ,true ,@(cdddr false))))))
+
+ (if (and (pair? true) ; (if expr (set! var #t | #f) (set! var #f | #t)) -> (set! var expr|(not expr))??
+ (eq? (car true) 'set!)
+ (eq? (car false) 'set!)
+ (eq? (cadr true) (cadr false))
+ (boolean? (caddr true))
+ (boolean? (caddr false))
+ (not (eq? (caddr true) (caddr false))))
+ (lint-format "perhaps ~A"
+ name
+ (lists->string form
+ (if (caddr true)
+ `(set! ,(cadr true) ,expr)
+ `(set! ,(cadr true) (not ,expr)))))))
+ (if (eq? false 'no-false) ; no false branch
+ (begin
+ (if (and (pair? test) ; (if (pair? lst) (for-each f lst)) -> (for-each f lst)
+ (eq? (car test) 'pair?)
+ (pair? true)
+ (memq (car true) '(map for-each))
+ (eq? (cadr test) (caddr true)))
+ (lint-format "perhaps ~A" name (lists->string form true)))
+
+ (if (and (pair? true) ; (if test0 (if test1 expr)) -> (if (and test0 test1) expr) (else #<unspecified>)
+ (eq? (car true) 'if)
+ (null? (cdddr true)))
+ (let ((test1 (simplify-boolean `(and ,expr ,(cadr true)) () () env)))
+ (lint-format "perhaps ~A" name (lists->string form `(if ,test1 ,(caddr true)))))))))
+
+ (if (eq? expr #t)
+ (lint-format "perhaps ~A" name (lists->string form true))
+ (if (not expr)
+ (if (eq? false 'no-false)
+ (if true ; (if #f x) as a kludgey #<unspecified>
+ (lint-format "perhaps ~A" name (lists->string form #<unspecified>)))
+ (lint-format "perhaps ~A" name (lists->string form false)))
+ (if (not (equal? true false))
+ (if (boolean? true)
+ (if (boolean? false) ; ! (if expr #t #f) turned into something less verbose
+ (lint-format "perhaps ~A" name
+ (lists->string form (if true
+ expr
+ (simplify-boolean `(not ,expr) () () env))))
+ (lint-format "perhaps ~A" name
+ (lists->string form (if true
+ (if (eq? false 'no-false)
+ expr
+ (simplify-boolean `(or ,expr ,false) () () env))
+ (simplify-boolean
+ (if (eq? false 'no-false)
+ `(not ,expr)
+ `(and (not ,expr) ,false))
+ () () env)))))
+ (if (boolean? false)
+ (lint-format "perhaps ~A" name
+ (lists->string form (simplify-boolean
+ (if false
+ (if (and (pair? expr) (eq? (car expr) 'not))
+ `(or ,(cadr expr) ,true)
+ `(or (not ,expr) ,true))
+ `(and ,expr ,true))
+ () () env)))))
+ (if (= len 4)
+ (if (not (side-effect? test env))
+ (lint-format "if is not needed here: ~A" name (lists->string form true))
+ (lint-format "if is not needed here: ~A" name (lists->string form `(begin ,expr ,true))))))))))))))
+
+ ((car cdr
+ caar cadr cddr cdar
+ caaar caadr caddr cdddr cdaar cddar cadar cdadr
+ cadddr cddddr)
+ (let ((cxr? (lambda (s)
+ (and (pair? (cdr s))
+ (pair? (cadr s))
+ (memq (caadr s) '(car cdr cadr cddr cdar cdddr cddddr))))))
+ (if (and (not (= line-number last-simplify-boolean-line-number))
+ (cxr? form))
+ (let* ((arg1 (cadr form))
+ (arg2 (and arg1 (cxr? arg1) (cadr arg1)))
+ (arg3 (and arg2 (cxr? arg2) (cadr arg2))))
+ (set! last-simplify-boolean-line-number line-number)
+ (let* ((innards (lambda (c) (case c ((car) "a") ((cdr) "d") ((caar) "aa") ((cadr) "ad") ((cddr) "dd") ((cdar) "da")
+ ((caaar) "aaa") ((caadr) "aad") ((caddr) "add") ((cdddr) "ddd")
+ ((cdaar) "daa") ((cddar) "dda") ((cdadr) "dad") ((cadar) "ada")
+ ((cddddr) "dddd") ((cadddr) "addd"))))
+ (cxr (string-append (innards (car form))
+ (innards (car arg1))
+ (if arg2 (innards (car arg2)) "")
+ (if arg3 (innards (car arg3)) ""))))
+ (if (< (length cxr) 5)
+ (lint-format "perhaps ~A" name (lists->string form `(,(string->symbol (string-append "c" cxr "r")) ,(cadr (or arg3 arg2 arg1)))))
+ ;; if it's car|cdr followed by cdr's, use list-ref|tail
+ (if (not (char-position #\a cxr))
+ (lint-format "perhaps ~A" name (lists->string form `(list-tail ,(cadr (or arg3 arg2 arg1)) ,(length cxr))))
+ (if (not (char-position #\a (substring cxr 1)))
+ (lint-format "perhaps ~A" name (lists->string form `(list-ref ,(cadr (or arg3 arg2 arg1)) ,(- (length cxr) 1))))
+ (set! last-simplify-boolean-line-number -1))))))))
+
+ (if (and (memq head '(car cdr))
+ (pair? (cadr form))
+ (eq? (car (cadr form)) 'cons))
+ (lint-format "(~A~A) is the same as~A"
+ name head
+ (truncated-list->string (cadr form))
+ (if (eq? head 'car)
+ (truncated-list->string (cadadr form))
+ (truncated-list->string (caddr (cadr form)))))))
+
+ ((and or not)
+ (if (not (= line-number last-simplify-boolean-line-number))
+ (let ((val (simplify-boolean form () () env)))
+ (set! last-simplify-boolean-line-number line-number)
+ (if (not (equal? form val))
+ (lint-format "perhaps ~A" name (lists->string form val))))))
+
+ ((=)
+ (if (and (> (length form) 2)
+ (any-real? (cdr form)))
+ (lint-format "= can be troublesome with floats: ~A" name (truncated-list->string form)))
+ (let ((cleared-form (cons = (remove-if (lambda (x) (not (number? x))) (cdr form)))))
+ (if (and (> (length cleared-form) 2)
+ (not (checked-eval cleared-form)))
+ (lint-format "this comparison can't be true: ~A" name (truncated-list->string form))))
+ (when (and (= (length form) 3)
+ (eqv? (caddr form) 0))
+ (let ((arg (cadr form)))
+ (when (and (pair? arg)
+ (eq? (car arg) '-)
+ (= (length arg) 3))
+ (lint-format "perhaps ~A" name (lists->string form `(= ,(cadr arg) ,(caddr arg))))))))
+
+ ((< > <= >=) ; '= handled above
+ (let ((cleared-form (cons (car form) ; keep operator
+ (remove-if (lambda (x)
+ (not (number? x)))
+ (cdr form)))))
+ (if (and (> (length cleared-form) 2)
+ (not (checked-eval cleared-form)))
+ (lint-format "this comparison can't be true: ~A" name (truncated-list->string form))))
+ (when (and (= (length form) 3)
+ (eqv? (caddr form) 0))
+ (let ((arg (cadr form)))
+ (if (and (pair? arg)
+ (eq? (car arg) '-)
+ (= (length arg) 3))
+ (lint-format "perhaps ~A" name (lists->string form `(,(car form) ,(cadr arg) ,(caddr arg))))))))
+ ;; could change (> x 0) to (positive? x) and so on, but the former is clear and ubiquitous
+
+ ((char<? char>? char<=? char>=? char=?
+ char-ci<? char-ci>? char-ci<=? char-ci>=? char-ci=?)
+ (let ((cleared-form (cons (car form) ; keep operator
+ (remove-if (lambda (x)
+ (not (char? x)))
+ (cdr form)))))
+ (if (and (> (length cleared-form) 2)
+ (not (checked-eval cleared-form)))
+ (lint-format "this comparison can't be true: ~A" name (truncated-list->string form)))))
+
+ ((string<? string>? string<=? string>=? string=?
+ string-ci<? string-ci>? string-ci<=? string-ci>=? string-ci=?)
+ (let ((cleared-form (cons (car form) ; keep operator
+ (remove-if (lambda (x)
+ (not (string? x)))
+ (cdr form)))))
+ (if (and (> (length cleared-form) 2)
+ (not (checked-eval cleared-form)))
+ (lint-format "this comparison can't be true: ~A" name (truncated-list->string form)))))
+
+ ((call-with-exit)
+ (let ((return (and (pair? (cdr form))
+ (pair? (cadr form))
+ (eq? (caadr form) 'lambda)
+ (pair? (cdadr form))
+ (pair? (cadadr form))
+ (car (cadadr form)))))
+ (if (symbol? return)
+ (let ((body (cddadr form)))
+ (if (not (tree-member return body))
+ (lint-format "exit-function appears to be unused: ~A" name (truncated-list->string form)))))))
+
+ ((call-with-input-string call-with-input-file call-with-output-file)
+ ;; call-with-output-string func is the first arg, not second, but these checks get no hits
+ (let ((port (and (pair? (cdr form))
+ (pair? (cddr form))
+ (pair? (caddr form))
+ (eq? (caaddr form) 'lambda)
+ (pair? (cdaddr form))
+ (pair? (cadr (caddr form)))
+ (car (cadr (caddr form))))))
+ (if (symbol? port)
+ (let ((body (cddr (caddr form))))
+ (if (not (tree-member port body))
+ (lint-format "port appears to be unused: ~A" name (truncated-list->string form)))))))
+
+ ((/)
+ (if (pair? (cdr form))
+ (if (and (null? (cddr form))
+ (number? (cadr form))
+ (zero? (cadr form)))
+ (lint-format "attempt to invert zero: ~A" name (truncated-list->string form))
+ (if (and (pair? (cddr form))
+ (memv 0 (cddr form)))
+ (lint-format "attempt to divide by 0: ~A" name (truncated-list->string form))))))
+
+ ((copy)
+ (if (and (pair? (cdr form))
+ (or (number? (cadr form))
+ (boolean? (cadr form))
+ (char? (cadr form))
+ (and (pair? (cadr form))
+ (memq (caadr form) '(copy string-copy)))))
+ (lint-format "~A could be ~A" name form (cadr form))
+ (if (and (pair? (cdr form)) (equal? (cadr form) '(owlet)))
+ (lint-format "~A could be (owlet): owlet is copied internally" name form))))
+
+ ((string-copy)
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (memq (caadr form) '(copy string-copy)))
+ (lint-format "~A could be ~A" name form (cadr form))))
+
+ ((string)
+ (if (every? (lambda (x) (and (char? x) (not (member x '(#\null #\newline #\escape))))) (cdr form)) ;#\linefeed -> #\newline in reader
+ (lint-format "~A could be ~S" name form (apply string (cdr form)))))
+
+ ((string? number?)
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (eq? (caadr form) (if (eq? head 'string?) 'number->string 'string->number)))
+ (lint-format "perhaps ~A" name (lists->string form (cadr form)))))
+
+ ((vector-ref list-ref hash-table-ref let-ref int-vector-ref float-vector-ref)
+ (unless (= line-number last-checker-line-number)
+ (if (= (length form) 3)
+ (let ((seq (cadr form)))
+ (if (and (pair? seq)
+ (eq? (car seq) head) ; perhaps instead: (memq (car seq) '(vector-ref list-ref hash-table-ref let-ref))
+ (= (length seq) 3))
+ (let ((seq1 (cadr seq)))
+ (if (and (pair? seq1)
+ (eq? (car seq1) head)
+ (= (length seq1) 3))
+ (lint-format "perhaps ~A" name (lists->string form `(,(cadr seq1) ,(caddr seq1) ,(caddr seq) ,(caddr form))))
+ (lint-format "perhaps ~A" name (lists->string form `(,seq1 ,(caddr seq) ,(caddr form)))))))))
+ (set! last-checker-line-number line-number)))
+
+ ((vector-set! list-set! hash-table-set! float-vector-set! int-vector-set!)
+ (if (= (length form) 4)
+ (let ((target (cadr form))
+ (index (caddr form))
+ (val (cadddr form)))
+ (if (and (pair? val)
+ (= (length val) 3)
+ (eq? target (cadr val))
+ (equal? index (caddr val))
+ (memq (car val) '(vector-ref list-ref hash-table-ref float-vector-ref int-vector-ref)))
+ (lint-format "redundant?: ~A" name (truncated-list->string form))
+ (if (and (pair? target)
+ (memq (car target) '(vector-ref list-ref hash-table-ref float-vector-ref int-vector-ref)))
+ (lint-format "perhaps ~A" name (lists->string form `(set! (,@(cdr target) ,index) ,val)))
+ (if (or (code-constant? (cadr form))
+ (and (pair? (cadr form))
+ (memq (caadr form) '(make-vector vector make-string string make-list list append cons vector-append copy))))
+ (lint-format "perhaps ~A" name (lists->string form val))))))))
+
+ ((object->string)
+ (if (pair? (cdr form))
+ (if (and (pair? (cadr form))
+ (eq? (caadr form) 'object->string))
+ (lint-format "~A could be ~A" name form (cadr form))
+ (if (and (pair? (cddr form))
+ (not (pair? (caddr form)))
+ (or (not (symbol? (caddr form))) (keyword? (caddr form)))
+ (not (memq (caddr form) '(#f #t :readable))))
+ (lint-format "bad second argument: ~A" name (caddr form))))))
+
+ ((display)
+ (if (and (= (length form) 2)
+ (pair? (cadr form))
+ (eq? (caadr form) 'format)
+ (not (cadadr form)))
+ (lint-format "~A could be ~A" name form `(format #t ,@(cddadr form)))))
+
+ ((make-vector)
+ (if (and (= (length form) 4)
+ (code-constant? (caddr form))
+ (not (real? (caddr form)))
+ (eq? (cadddr form) #t))
+ (lint-format "~A won't create an homogenous vector" name form)))
+
+ ((reverse list->vector vector->list list->string string->list symbol->string string->symbol number->string)
+ ;; not string->number -- no point in copying a number and it's caught below
+ (let ((inverses '((reverse . reverse)
+ (list->vector . vector->list)
+ (vector->list . list->vector)
+ (symbol->string . string->symbol)
+ (string->symbol . symbol->string)
+ (list->string . string->list)
+ (string->list . list->string)
+ (number->string . string->number))))
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (pair? (cdadr form))
+ (eq? (caadr form) (let ((p (assq head inverses))) (and (pair? p) (cdr p)))))
+ (lint-format "~A could be (copy ~A)" name form (cadadr form)))))
+
+ ((char->integer integer->char symbol->keyword keyword->symbol string->number)
+ (let ((inverses '((char->integer . integer->char)
+ (integer->char . char->integer)
+ (symbol->keyword . keyword->symbol)
+ (keyword->symbol . symbol->keyword)
+ (string->number . number->string))))
+ (if (and (pair? (cdr form))
+ (pair? (cadr form))
+ (pair? (cdadr form))
+ (eq? (caadr form) (let ((p (assq head inverses))) (and (pair? p) (cdr p)))))
+ (lint-format "~A could be ~A" name form (cadadr form)))))
+
+ ((string-append)
+ (if (not (= line-number last-checker-line-number))
+ (let ((args (remove-all "" (splice-if (lambda (x) (eq? x 'string-append)) (cdr form)))))
+ (if (null? args)
+ (lint-format "perhaps ~A" name (lists->string form ""))
+ (if (null? (cdr args))
+ (lint-format "perhaps ~A, or use copy" name (lists->string form (car args)))
+ (if (every? string? args)
+ (lint-format "perhaps ~A" name (lists->string form (apply string-append args)))
+ (if (not (equal? args (cdr form)))
+ (lint-format "perhaps ~A" name (lists->string form `(string-append , at args)))))))
+ (set! last-checker-line-number line-number))))
+
+ ((vector-append)
+ (if (not (= line-number last-checker-line-number))
+ (let ((args (remove-all #() (splice-if (lambda (x) (eq? x 'vector-append)) (cdr form)))))
+ (if (null? args)
+ (lint-format "perhaps ~A" name (lists->string form #()))
+ (if (null? (cdr args))
+ (lint-format "perhaps ~A" name (lists->string form (car args)))
+ (if (every? vector? args)
+ (lint-format "perhaps ~A" name (lists->string form (apply vector-append args)))
+ (if (not (equal? args (cdr form)))
+ (lint-format "perhaps ~A" name (lists->string form `(vector-append , at args)))))))
+ (set! last-checker-line-number line-number))))
+
+ ((cons)
+ (if (and (= (length form) 3)
+ (pair? (caddr form))
+ (eq? (caaddr form) 'list))
+ (lint-format "perhaps ~A" name (lists->string form `(list ,(cadr form) ,@(cdaddr form))))))
+
+ ((append)
+ (unless (= line-number last-checker-line-number)
+ (set! last-checker-line-number line-number)
+ (letrec ((splice-append (lambda (lst)
+ (cond ((null? lst) ())
+ ((pair? lst)
+ (if (and (pair? (car lst))
+ (eq? (caar lst) 'append))
+ (if (null? (cdar lst))
+ (cons () (splice-append (cdr lst)))
+ (append (splice-append (cdar lst)) (splice-append (cdr lst))))
+ (cons (car lst) (splice-append (cdr lst)))))
+ (#t lst)))))
+ (let ((new-args (splice-append (cdr form)))) ; (append '(1) (append '(2) '(3))) -> (append '(1) '(2) '(3))
+ (let ((len1 (length new-args)))
+
+ (define (distribute-quote x)
+ (map (lambda (item)
+ (if (or (symbol? item)
+ (pair? item))
+ `(quote ,item)
+ item))
+ x))
+
+ (define (append->list . items)
+ (let ((lst (list 'list)))
+ (for-each (lambda (item)
+ (set! lst (append lst (if (eq? (car item) 'list)
+ (cdr item)
+ (distribute-quote (cadr item))))))
+ items)
+ lst))
+
+ (case len1
+ ((0) ; (append) -> ()
+ (lint-format "perhaps ~A" name (lists->string form ())))
+ ((1) ; (append x) -> x
+ (lint-format "perhaps ~A" name (lists->string form (car new-args))))
+ ((2)
+ (if (or (null? (cadr new-args)) ; (append (list x) ()) -> (list x)
+ (quoted-null? (cadr new-args))
+ (equal? (cadr new-args) '(list)))
+ (lint-format "perhaps clearer: ~A" name (lists->string form `(copy ,(car new-args))))
+ (if (null? (car new-args)) ; (append () x) -> x
+ (lint-format "perhaps ~A" name (lists->string form (cadr new-args)))
+ (if (and (pair? (car new-args)) ; (append (list x y) '(z)) -> (list x y 'z)
+ (or (eq? (caar new-args) 'list)
+ (quoted-undotted-pair? (car new-args)))
+ (pair? (cadr new-args))
+ (or (eq? (caadr new-args) 'list)
+ (quoted-undotted-pair? (cadr new-args))))
+ (lint-format "perhaps ~A" name (lists->string form (apply append->list new-args)))
+ (if (not (equal? (cdr form) new-args))
+ (lint-format "perhaps ~A" name (lists->string form `(append , at new-args))))))))
+ (else
+ (if (every? (lambda (item)
+ (and (pair? item)
+ (or (eq? (car item) 'list)
+ (quoted-undotted-pair? item))))
+ new-args)
+ (lint-format "perhaps ~A" name (lists->string form (apply append->list new-args)))
+ (if (not (equal? (cdr form) new-args))
+ (lint-format "perhaps ~A" name (lists->string form `(append , at new-args))))))))))))
+
+ ((apply)
+ (let ((function? (lambda (f)
+ (or (and (symbol? f)
+ (let ((func (symbol->value f *e*)))
+ (or (procedure? func)
+ (let ((e (or (var-member f env) (hash-table-ref globals f))))
+ (and (var? e)
+ (let? (var-new e))
+ (memq ((var-new e) 'type) '(define define* lambda lambda*)))))))
+ (and (pair? f)
+ (memq (car f) '(lambda lambda*)))))))
+
+ (if (and (pair? (cdr form))
+ (not (symbol? (cadr form)))
+ (not (applicable? (cadr form))))
+ (lint-format "~S is not applicable: ~A" name (cadr form) (truncated-list->string form))
+ (let ((len (length form)))
+ (when (> len 2)
+ (if (and (not (list? (form (- len 1))))
+ (code-constant? (form (- len 1))))
+ (lint-format "last argument should be a list: ~A" name (truncated-list->string form))
+ (if (and (= len 3)
+ (pair? (caddr form))
+ (eq? (caaddr form) 'list)
+ ;; macros are different here
+ (function? (cadr form)))
+ (lint-format "perhaps ~A" name (lists->string form `(,(cadr form) ,@(cdaddr form))))
+ (if (and (or (not (every? code-constant? (cddr form)))
+ (catch #t
+ (lambda ()
+ (let ((val (eval form)))
+ (lint-format "perhaps ~A -> ~S" name form val)
+ #t))
+ (lambda args #f)))
+ (symbol? (cadr form)))
+ (let ((func (symbol->value (cadr form) *e*)))
+ (if (procedure? func)
+ (let ((ary (arity func)))
+ (if (and (pair? ary)
+ (> (- (length (cddr form)) 1) (cdr ary))) ; last apply arg might be var=()
+ (lint-format "too many arguments for ~A: ~A" name (cadr form) form)))))))))))))
+
+ ((format snd-display)
+ (if (< (length form) 3)
+ (begin
+ (if (< (length form) 2)
+ (lint-format "~A has too few arguments: ~A" name head (truncated-list->string form))
+ (if (and (pair? (cadr form))
+ (eq? (caadr form) 'format))
+ (lint-format "redundant format: ~A" name (truncated-list->string form))
+ (if (and (code-constant? (cadr form))
+ (not (string? (cadr form))))
+ (lint-format "format with one argument takes a string: ~A" name (truncated-list->string form)))))
+ env)
+ (let ((control-string (if (string? (cadr form)) (cadr form) (caddr form)))
+ (args (if (string? (cadr form)) (cddr form) (cdddr form))))
+
+ (define (count-directives str name form)
+ (let ((curlys 0)
+ (dirs 0)
+ (pos (char-position #\~ str)))
+ (if pos
+ (let ((len (length str))
+ (tilde-time #t))
+ (do ((i (+ pos 1) (+ i 1)))
+ ((>= i len))
+ (let ((c (string-ref str i)))
+ (if tilde-time
+ (begin
+ (if (and (= curlys 0)
+ (not (memq c '(#\~ #\T #\t #\& #\% #\^ #\| #\newline #\}))) ; ~* consumes an arg
+ (not (call-with-exit
+ (lambda (return)
+ (do ((k i (+ k 1)))
+ ((= k len) #f)
+ ;; this can be confused by pad chars in ~T
+ (if (and (not (char-numeric? (string-ref str k)))
+ (not (char=? (string-ref str k) #\,)))
+ (return (char-ci=? (string-ref str k) #\t))))))))
+ (begin
+ ;; the possibilities are endless, so I'll stick to the simplest
+ (if (not (vector-ref format-control-char (char->integer c)))
+ (lint-format "unrecognized format directive: ~C in ~S, ~S" name c str form))
+ (set! dirs (+ dirs 1))
+
+ ;; ~n so try to figure out how many args are needed (this is not complete)
+ (when (char-ci=? c #\n)
+ (let ((j (+ i 1)))
+ (if (>= j len)
+ (lint-format "missing format directive: ~S" name str)
+ (begin
+ ;; if ,n -- add another, if then not T, add another
+ (if (char=? (string-ref str j) #\,)
+ (if (>= (+ j 1) len)
+ (lint-format "missing format directive: ~S" name str)
+ (if (char-ci=? (string-ref str (+ j 1)) #\n)
+ (begin
+ (set! dirs (+ dirs 1))
+ (set! j (+ j 2)))
+ (if (char-numeric? (string-ref str (+ j 1)))
+ (set! j (+ j 2))
+ (set! j (+ j 1))))))
+ (if (>= j len)
+ (lint-format "missing format directive: ~S" name str)
+ (if (not (char-ci=? (string-ref str j) #\t))
+ (set! dirs (+ dirs 1))))))))))
+
+ (set! tilde-time #f)
+ (case c
+ ((#\{) (set! curlys (+ curlys 1)))
+ ((#\}) (set! curlys (- curlys 1)))
+ ((#\^ #\|)
+ (if (zero? curlys)
+ (lint-format "~A has ~C outside ~~{~~}?" name str c)))))
+ (begin
+ (set! pos (char-position #\~ str i))
+ (if pos
+ (begin
+ (set! tilde-time #t)
+ (set! i pos))
+ (set! i len))))))
+
+ (if tilde-time
+ (lint-format "~A control string ends in tilde: ~A" name head (truncated-list->string form)))))
+
+ (if (not (= curlys 0))
+ (lint-format "~A has ~D unmatched ~A~A: ~A"
+ name head
+ (abs curlys)
+ (if (positive? curlys) "{" "}")
+ (if (> curlys 1) "s" "")
+ (truncated-list->string form)))
+ dirs))
+
+ (if (not (string? control-string))
+ (if (not (proper-list? args))
+ (lint-format "~S looks suspicious" name form))
+ (let ((ndirs (count-directives control-string name form))
+ (nargs (if (or (null? args) (pair? args)) (length args) 0)))
+ (if (not (= ndirs nargs))
+ (lint-format "~A has ~A arguments: ~A"
+ name head
+ (if (> ndirs nargs) "too few" "too many")
+ (truncated-list->string form))
+ (if (and (not (cadr form))
+ (zero? ndirs)
+ (not (char-position #\~ control-string)))
+ (lint-format "~A could be ~S, (format is a no-op here)" name form (caddr form)))))))))
+
+ ((sort!)
+ (if (= (length form) 3)
+ (let ((func (caddr form)))
+ (if (memq func '(= eq? eqv? equal? string=? char=? string-ci=? char-ci=?))
+ (lint-format "sort! with ~A may hang: ~A" name func (truncated-list->string form))
+ (if (symbol? func)
+ (let ((sig (procedure-signature (symbol->value func))))
+ (if (and sig
+ (not (eq? (car sig) 'boolean?)))
+ (lint-format "~A is a questionable sort! function" name func))))))))
+
+ ((substring)
+ (if (every? code-constant? (cdr form))
+ (catch #t
+ (lambda ()
+ (let ((val (eval form)))
+ (lint-format "perhaps ~A -> ~S" name form val)))
+ (lambda (type info)
+ (lint-format "~A -> ~A~%" name form (apply format #f info))))
+
+ (let ((str (cadr form)))
+ (if (and (pair? str)
+ (eq? (car str) 'substring)
+ (pair? (cddr form))
+ (null? (cdddr form))
+ (null? (cdddr str)))
+ (if (and (integer? (caddr form))
+ (integer? (caddr str)))
+ (lint-format "perhaps ~A" name
+ (lists->string form `(substring ,(cadr str) ,(+ (caddr str) (caddr form)))))
+ (lint-format "perhaps ~A" name
+ (lists->string form `(substring ,(cadr str) (+ ,(caddr str) ,(caddr form)))))))
+ ;; end indices are complicated -- since this rarely happens, not worth the trouble
+ (if (and (integer? (caddr form))
+ (zero? (caddr form))
+ (null? (cdddr form)))
+ (lint-format "perhaps clearer: ~A" name (lists->string form `(copy ,str)))))))
+
+ ((list-tail)
+ (if (= (length form) 3)
+ (if (and (integer? (caddr form))
+ (zero? (caddr form)))
+ (lint-format "perhaps ~A" name (lists->string form (cadr form)))
+ (if (and (pair? (cadr form))
+ (eq? (caadr form) 'list-tail))
+ (if (and (integer? (caddr form))
+ (integer? (caddr (cadr form))))
+ (lint-format "perhaps ~A" name
+ (lists->string form `(list-tail ,(cadadr form) ,(+ (caddr (cadr form)) (caddr form)))))
+ (lint-format "perhaps ~A" name
+ (lists->string form `(list-tail ,(cadadr form) (+ ,(caddr (cadr form)) ,(caddr form))))))))))
+
+ ((eq?)
+ (if (< (length form) 3)
+ (lint-format "eq? needs 2 arguments: ~A" name (truncated-list->string form))
+ (let ((arg1 (cadr form))
+ (arg2 (caddr form)))
+ (let ((eq1 (eqf arg1))
+ (eq2 (eqf arg2)))
+ (if (or (eq? (car eq1) 'equal?)
+ (eq? (car eq2) 'equal?))
+ (lint-format "eq? should be equal? in ~S" name form)
+ (if (or (eq? (car eq1) 'eqv?)
+ (eq? (car eq2) 'eqv?))
+ (lint-format "eq? should be eqv? in ~S" name form))))
+
+ (let ((expr 'unset)) ; (eq? e #f) or (eq? #f e) -> (not e)
+ (if (not arg1)
+ (set! expr (simplify-boolean `(not ,arg2) () () env))
+ (if (not arg2)
+ (set! expr (simplify-boolean `(not ,arg1) () () env))
+ (if (and (or (null? arg1)
+ (quoted-null? arg1))
+ (not (code-constant? arg2)))
+ (set! expr `(null? ,arg2))
+ (if (and (or (null? arg2)
+ (quoted-null? arg2))
+ (not (code-constant? arg1)))
+ (set! expr `(null? ,arg1))
+ (if (and (eq? arg1 #t)
+ (pair? arg2)
+ (eq? (return-type (car arg2)) 'boolean?))
+ (set! expr arg2)
+ (if (and (eq? arg2 #t)
+ (pair? arg1)
+ (eq? (return-type (car arg1)) 'boolean?))
+ (set! expr arg1)))))))
+ (if (not (eq? expr 'unset))
+ (lint-format "perhaps ~A" name (lists->string form expr)))))))
+
+ ((eqv? equal? morally-equal?)
+ (if (< (length form) 3)
+ (lint-format "~A needs 2 arguments: ~A" name head (truncated-list->string form))
+ (let ((arg1 (cadr form))
+ (arg2 (caddr form)))
+ (let ((eq1 (eqf arg1))
+ (eq2 (eqf arg2)))
+ (if (or (eq? (car eq1) 'equal?)
+ (eq? (car eq2) 'equal?))
+ (if (not (memq head '(equal? morally-equal?)))
+ (lint-format "~A should be equal? in ~S" name head form))
+ (if (or (eq? (car eq1) 'eqv?)
+ (eq? (car eq2) 'eqv?))
+ (if (and (not (eq? head 'eqv?))
+ (or (not (eq? head 'morally-equal?))
+ (and (or (not (number? arg1))
+ (rational? arg1)) ; here we have float-equal-epsilon
+ (or (not (number? arg2))
+ (rational? arg2)))))
+ (lint-format "~A ~A be eqv? in ~S" name head (if (eq? head 'eq?) "should" "could") form))
+ (if (or (eq? (car eq1) 'eq?)
+ (eq? (car eq2) 'eq?))
+ (if (or (not arg1) (not arg2))
+ (lint-format "~A could be not: ~A" name head
+ (lists->string form `(not ,(or arg1 arg2))))
+ (if (or (null? arg1) (null? arg2)
+ (quoted-null? arg1) (quoted-null? arg2))
+ (lint-format "~A could be null?: ~A" name head
+ (lists->string form
+ (if (or (null? arg1) (quoted-null? arg1))
+ `(null? ,arg2)
+ `(null? ,arg1))))
+ (if (not (eq? head 'eq?))
+ (lint-format "~A could be eq? in ~S" name head form)))))))))))
+
+ ((map for-each)
+ (let* ((len (length form))
+ (args (- len 2)))
+ (if (< len 3)
+ (lint-format "~A missing argument~A in: ~A"
+ name head
+ (if (= len 2) "" "s")
+ (truncated-list->string form))
+ (let ((func (cadr form))
+ (ary #f))
+ (if (and (symbol? func)
+ (defined? func)
+ (procedure? (symbol->value func *e*)))
+ (set! ary (arity (symbol->value func *e*)))
+
+ (if (and (pair? func)
+ (memq (car func) '(lambda lambda*))
+ (pair? (cadr func)))
+ (let ((arglen (length (cadr func))))
+ (if (eq? (car func) 'lambda)
+ (if (negative? arglen)
+ (set! ary (cons (abs arglen) 512000))
+ (set! ary (cons arglen arglen)))
+ (if (or (negative? arglen)
+ (memq :rest (cadr func)))
+ (set! ary (cons 0 512000))
+ (set! ary (cons 0 arglen)))))))
+
+ (if (pair? ary)
+ (if (< args (car ary))
+ (lint-format "~A has too few arguments in: ~A"
+ name head
+ (truncated-list->string form))
+ (if (> args (cdr ary))
+ (lint-format "~A has too many arguments in: ~A"
+ name head
+ (truncated-list->string form)))))
+
+ (for-each
+ (lambda (obj)
+ (if (and (pair? obj)
+ (memq (car obj) '(vector->list string->list let->list)))
+ (lint-format "~A could be simplified to: ~A ; (~A accepts non-list sequences)"
+ name
+ (truncated-list->string obj)
+ (truncated-list->string (cadr obj))
+ head)))
+ (cddr form))))))
+
+ ((magnitude)
+ (if (and (= (length form) 2)
+ (memq (->type (cadr form)) '(integer? rational? real?)))
+ (lint-format "perhaps use abs here: ~A" name form)))
+
+ ((null eq eqv equal) ; (null (cdr...))
+ (if (not (var-member head env))
+ (lint-format "misspelled '~A? in ~A?" name head form)))
+
+ ((open-input-file open-output-file)
+ (if (and (pair? (cdr form))
+ (pair? (cddr form))
+ (string? (caddr form))
+ (not (memv (string-ref (caddr form) 0) '(#\r #\w #\a)))) ; b + then e m c x if gcc
+ (lint-format "unexpected mode: ~A" name form)))
+
+ ((catch)
+ ;; catch tag is tricky -- it is evaluated, then eq? matches at error time, so we need
+ ;; to catch constants that can't be eq?
+ (if (= (length form) 4)
+ (let ((tag (cadr form)))
+ (if (or (and (not (pair? tag))
+ (or (number? tag) (char? tag) (length tag)))
+ (and (pair? tag)
+ (eq? (car tag) 'quote)
+ (or (not (pair? (cdr tag)))
+ (length (cadr tag)))))
+ (lint-format "catch tag ~S is unreliable (catch uses eq? to match tags)" name (cadr form))))))
+
+ ((load) ; pick up the top level declarations
+ (if (>= (length form) 2)
+ (scan form)))
+
+ ((*s7*)
+ (if (= (length form) 2)
+ (let ((arg (cadr form)))
+ (if (and (pair? arg)
+ (eq? (car arg) 'quote)
+ (symbol? (cadr arg))
+ (not (memq (cadr arg)
+ '(print-length safety cpu-time heap-size free-heap-size gc-freed max-string-length max-list-length
+ max-vector-length max-vector-dimensions default-hash-table-length initial-string-port-length
+ gc-protected-objects file-names rootlet-size c-types stack-top stack-size stacktrace-defaults
+ max-stack-size catches exits float-format-precision bignum-precision default-rationalize-error
+ default-random-state morally-equal-float-epsilon hash-table-float-epsilon undefined-identifier-warnings
+ gc-stats symbol-table-locked?))))
+ (lint-format "unknown *s7* field: ~A" name (cadr form))))))
+
+ )) ; end check-special-cases
+
+
+ (define (check-call name head form env)
+ (let ((fdata (or (var-member head env) (hash-table-ref globals head))))
+ ;(format *stderr* "~A call: ~A~%" form fdata)
+ (if (var? fdata)
+ ;; a local var
+ (if (let? (var-new fdata))
+ (let ((type ((var-new fdata) 'type))
+ (args ((var-new fdata) 'arglist))
+ (ary (and (not (eq? ((var-new fdata) 'decl) 'error))
+ (arity ((var-new fdata) 'decl)))))
+ ;(format *stderr* "~A ~S~%" ary (object->string ((var-new fdata) 'decl) :readable))
+ (if (pair? ary)
+ (let ((req (car ary))
+ (opt (cdr ary))
+ (pargs (if (pair? args)
+ (proper-list args)
+ (if (symbol? args)
+ (list args)
+ ()))))
+ (let ((call-args (length (cdr form))))
+ (if (< call-args req)
+ (lint-format "~A needs ~D argument~A: ~A"
+ name head
+ req (if (> req 1) "s" "")
+ (truncated-list->string form))
+ (if (> (- call-args (keywords (cdr form))) opt)
+ (lint-format "~A has too many arguments: ~A" name head (truncated-list->string form)))))
+ (if (and (memq type '(define* lambda*))
+ (pair? args)
+ (not (memq :allow-other-keys args)))
+
+ (for-each
+ (lambda (arg)
+ (if (and (keyword? arg)
+ (not (member (keyword->symbol arg) pargs
+ (lambda (a b)
+ (if (pair? b)
+ (eq? a (car b))
+ (eq? a b))))))
+ (lint-format "~A keyword argument ~A (in ~S) does not match any argument in ~S" name head arg form pargs)))
+ (cdr form)))))))
+ ;; not local var
+ (when (symbol? head)
+ (let ((head-value (symbol->value head *e*))) ; head might be "arity"!
+ (when (or (procedure? head-value)
+ (macro? head-value))
+ ;; check arg number
+ (let* ((args (length (cdr form)))
+ (ary (arity head-value))
+ (min-arity (car ary))
+ (max-arity (cdr ary)))
+ (if (< args min-arity)
+ (lint-format "~A needs ~A~D argument~A: ~A"
+ name head
+ (if (= min-arity max-arity) "" "at least ")
+ min-arity
+ (if (> min-arity 1) "s" "")
+ (truncated-list->string form))
+ (if (and (not (procedure-setter head-value))
+ (> (- args (keywords (cdr form))) max-arity))
+ (lint-format "~A has too many arguments: ~A" name head (truncated-list->string form))))
+ (if (and (procedure? head-value)
+ (pair? (cdr form))) ; there are args (the not-enough-args case is checked above)
+ (if (zero? max-arity)
+ (lint-format "too many arguments: ~A" name (truncated-list->string form))
+ (begin
+
+ (for-each (lambda (arg)
+ (if (pair? arg)
+ (if (negative? (length arg))
+ (lint-format "missing quote? ~A in ~A" name arg form)
+ (if (eq? (car arg) 'unquote)
+ (lint-format "stray comma? ~A in ~A" name arg form)))))
+ (cdr form))
+
+ ;; if keywords, check that they are acceptable
+ ;; this only applies to lambda*'s that have been previously loaded (lint doesn't create them)
+ (let ((source (procedure-source head-value)))
+ (if (and (pair? source)
+ (eq? (car source) 'lambda*))
+ (let ((decls (cadr source)))
+ (if (not (memq :allow-other-keys decls))
+ (for-each
+ (lambda (arg)
+ (if (and (keyword? arg)
+ (not (eq? arg :rest))
+ (not (member arg decls
+ (lambda (a b)
+ (if (pair? b)
+ (eq? (keyword->symbol a) (car b))
+ (eq? (keyword->symbol a) b))))))
+ (lint-format "~A keyword argument ~A (in ~S) does not match any argument in ~S" name head arg form decls)))
+ (cdr form))))))
+
+ ;; we've already checked for head in the current env above
+ (if (and (or (memq head '(eq? eqv?))
+ (and (= (length form) 3)
+ (hash-table-ref repeated-args-table head)))
+ (repeated-member? (cdr form) env))
+ (lint-format "this looks odd: ~A"
+ name
+ ;; sigh (= a a) could be used to check for non-finite numbers, I suppose,
+ ;; and (/ 0 0) might be deliberate (as in gmp)
+ ;; also (min (random x) (random x)) is not pointless
+ (truncated-list->string form))
+ (if (and (hash-table-ref repeated-args-table-2 head)
+ (repeated-member? (cdr form) env))
+ (lint-format "it looks odd to have repeated arguments in~A" name (truncated-list->string form))))
+
+ (when (memq head '(eq? eqv?))
+ (define (repeated-member-with-not? lst env)
+ (and (pair? lst)
+ (or (and (or (not (pair? (car lst)))
+ (not (side-effect? (car lst) env)))
+ (or (member (list 'not (car lst)) (cdr lst))
+ (and (pair? (car lst))
+ (eq? (caar lst) 'not)
+ (= (length (car lst)) 2)
+ (member (cadar lst) (cdr lst)))))
+ (repeated-member-with-not? (cdr lst) env))))
+ (if (repeated-member-with-not? (cdr form) env)
+ (lint-format "this looks odd: ~A" name (truncated-list->string form))))
+
+ ;; now try to check arg types
+ (let ((func (symbol->value head *e*)))
+ (let ((arg-data (let ((sig (procedure-signature func)))
+ (and (pair? sig)
+ (cdr sig)))))
+ ;; (format *stderr* "arg-data: ~A~%" arg-data)
+ (if (and arg-data
+ (or (not (pair? arg-data))
+ (not (eq? (car arg-data) #t))
+ (not (infinite? (length arg-data)))))
+ (check-args name head form arg-data env max-arity))))))))))))))
+
+ (define (get-generator form name head) ; defgenerator funcs
+ (let ((name (if (pair? (cadr form))
+ (caadr form)
+ (cadr form))))
+ ;; auto-define make-name, name?
+ (let ((make-name (string->symbol (string-append "make-" (symbol->string name))))
+ (name? (string->symbol (string-append (symbol->string name) "?"))))
+
+ (hash-table-set! globals make-name (make-var make-name))
+ (hash-table-set! globals name? (make-var name?)))))
+
+
+ (define (load-walk form)
+ ;; check form for top-level declarations, if load seen, and we haven't seen that file, load it
+ (let ((head (car form)))
+ (case head
+ ((begin)
+ (load-walk (cdr form)))
+
+ ((define-constant define-envelope)
+ (hash-table-set! globals (cadr form) (make-var (cadr form) :val (and (pair? (cddr form)) (caddr form)))))
+
+ ((defmacro defmacro*)
+ (hash-table-set! globals (cadr form) (make-var (cadr form)
+ :new (inlet :type head
+ :decl (eval (list head '_ (caddr form) #f))
+ :signature #f
+ :side-effect #t
+ :arglist (caddr form)
+ :definition form
+ :location #__line__))))
+ ((define)
+ (let ((name (cadr form)))
+ (if (pair? name)
+ (let ((fname (car name)))
+ (if (symbol? fname)
+ (if (keyword? fname)
+ (lint-format "keywords are constants ~A" name form)
+ (hash-table-set! globals fname
+ (make-var fname
+ :new (inlet :type 'define
+ :decl (eval (list 'define (cons '_ (cdadr form)) #f))
+ :signature #f
+ :side-effect #t
+ :arglist (cdr name)
+ :definition form
+ :location #__line__))))
+
+ (lint-format "what is this? ~A" name form)))
+ (hash-table-set! globals name (make-var name :val (and (pair? (cddr form)) (caddr form)))))))
+
+ ((define* define-expansion define-macro define-macro* define-bacro define-bacro* definstrument defanimal)
+ (hash-table-set! globals (caadr form) (make-var (caadr form)
+ :new (inlet :type head
+ :decl (eval (list head (cons '_ (cdadr form)) #f))
+ :signature #f
+ :side-effect #t
+ :arglist (cdadr form)
+ :definition form
+ :location #__line__))))
+
+ ((defgenerator)
+ (get-generator form 'defgenerator head))
+
+ ((if)
+ (if (pair? (cddr form))
+ (if (pair? (cdddr form))
+ (begin
+ (load-walk (cadddr form))
+ (load-walk (caddr form)))
+ (load-walk (caddr form)))))
+
+ ((load)
+ (if (>= (length form) 2)
+ (scan form))))))
+
+
+ (define (scan form)
+
+ (define (find-file file paths)
+ (and (pair? paths)
+ (catch #t
+ (lambda ()
+ (open-input-file (string-append (car paths) "/" file)))
+ (lambda args
+ (find-file file (cdr paths))))))
+
+ (let ((file (cadr form)))
+ (if (and (string? file)
+ (not (member file loaded-files)))
+ (let ((fp (catch #t
+ (lambda ()
+ (open-input-file file))
+ (lambda args
+ (or (find-file file *load-path*)
+ (and (format outport " can't load ~S~%" file) #f))))))
+ (if (input-port? fp)
+ (begin
+ (set! loaded-files (cons file loaded-files))
+ ;(format outport " (scanning ~S)~%" file)
+ (do ((form (read fp) (read fp)))
+ ((eof-object? form))
+ (if (and (pair? form)
+ (pair? (cdr form)))
+ (load-walk form)))
+ (close-input-port fp)))))))
+
+
+ (define (binding-ok? name head binding env second-pass)
+ ;; check let-style variable binding for various syntactic problems
+ (if second-pass
+ (and (pair? binding)
+ (symbol? (car binding))
+ ;(not (keyword? (car binding)))
+ (not (constant? (car binding)))
+ (pair? (cdr binding))
+ (or (null? (cddr binding))
+ (and (eq? head 'do)
+ (pair? (cddr binding)) ; (do ((i 0 . 1))...)
+ (null? (cdddr binding)))))
+
+ (cond ((not (pair? binding)) (lint-format "~A binding is not a list? ~S" name head binding) #f)
+ ((not (symbol? (car binding))) (lint-format "~A variable is not a symbol? ~S" name head binding) #f)
+ ((keyword? (car binding)) (lint-format "~A variable is a keyword? ~S" name head binding) #f)
+ ((constant? (car binding)) (lint-format "can't bind a constant: ~S" name binding) #f)
+ ((not (pair? (cdr binding)))
+ (if (null? (cdr binding))
+ (lint-format "~A variable value is missing? ~S" name head binding)
+ (lint-format "~A binding is an improper list? ~S" name head binding))
+ #f)
+ ((or (not (pair? (cdr binding)))
+ (and (pair? (cddr binding))
+ (or (not (eq? head 'do))
+ (pair? (cdddr binding)))))
+ (lint-format "~A binding is messed up: ~A" name head binding)
+ #f)
+ (else
+ (if (and *report-shadowed-variables*
+ (or (hash-table-ref globals (car binding))
+ (var-member (car binding) env)))
+ (lint-format "~A variable ~A in ~S shadows an earlier declaration" name head (car binding) binding))
+ #t))))
+
+
+ (define (env-difference name e1 e2 lst)
+ (if (or (null? e1)
+ (null? e2)
+ (eq? (car e1) (car e2)))
+ lst
+ (env-difference name (cdr e1) e2
+ (if (eq? name (var-name (car e1)))
+ lst
+ (cons (car e1) lst)))))
+
+
+ (define (report-usage name type head vars)
+ ;; report unused or set-but-unreferenced variables
+ (if (and (not (eq? head 'begin)) ; begin can redefine = set a variable
+ (pair? vars)
+ (proper-list? vars))
+ (do ((cur vars (cdr cur))
+ (rst (cdr vars) (cdr rst)))
+ ((null? rst))
+ (let ((repeat (var-member (var-name (car cur)) rst)))
+ ;; not globals here because the same name might be used as a global
+ (if repeat
+ (lint-format "~A ~A ~A is declared twice" name head type (var-name (car cur)))))))
+
+ (let ((set ())
+ (unused ()))
+ (for-each
+ (lambda (arg)
+ (if (hash-table-ref syntaces (var-name arg))
+ (lint-format "~A ~A named ~A is asking for trouble" name head type (var-name arg))
+ (if (not (symbol? (var-name arg)))
+ (lint-format "bad ~A ~A name: ~S" name head type (var-name arg))))
+ (if (and (not (var-ref arg))
+ (not (hash-table-ref other-identifiers (var-name arg))))
+ (if (var-set arg)
+ (set! set (cons (var-name arg) set))
+ (if (not (memq (var-name arg) '(documentation signature iterator?)))
+ (set! unused (cons (var-name arg) unused))))))
+ vars)
+
+ (if (pair? set)
+ (lint-format "~A ~A~A ~{~A~^, ~} set, but not used"
+ name head type (if (> (length set) 1) "s" "") (reverse set)))
+ (if (pair? unused)
+ (lint-format "~A ~A~A ~{~A~^, ~} not used"
+ name head type (if (> (length unused) 1) "s" "") (reverse unused)))))
+
+
+ (define (lint-walk-body name head body env)
+ ;; walk a body (a list of forms, the value of the last of which might be returned)
+
+ (if (not (proper-list? body))
+ (lint-format "stray dot? ~A" name (truncated-list->string body))
+
+ (let ((prev-f #f)
+ (prev-fs #f)
+ (prev-len 0)
+ (f-len 0)
+ (block-fs #f)
+ (dpy-f #f)
+ (dpy-start #f)
+ (len (length body)))
+ (if (eq? head 'do) (set! len (+ len 1))) ; last form in do body is not returned
+
+ (do ((fs body (cdr fs))
+ (ctr 0 (+ ctr 1)))
+ ((not (pair? fs)))
+ (let ((f (car fs)))
+
+ (if (pair? f)
+ (begin
+ (set! f-len (length f))
+ (if (eq? (car f) 'begin)
+ (lint-format "redundant begin: ~A" name (truncated-list->string f))))
+ (set! f-len 0))
+
+ (if (and (= f-len prev-len 3)
+ (eq? (car f) 'set!)
+ (eq? (car prev-f) 'set!)
+ (eq? (cadr f) (cadr prev-f)))
+ (let ((arg1 (caddr prev-f))
+ (arg2 (caddr f)))
+ (if (or (not (pair? arg2))
+ (not (tree-member (cadr f) arg2)))
+ (if (and (not (side-effect? arg1 env))
+ (not (side-effect? arg2 env)))
+ (lint-format "this could be omitted: ~A" name prev-f))
+ (if (and (pair? arg1)
+ (pair? arg2)
+ (eq? (car arg1) 'cons)
+ (eq? (car arg2) 'cons)
+ (eq? (cadr f) (caddr arg2))
+ (not (eq? (cadr f) (cadr arg2))))
+ (lint-format "perhaps ~A ~A -> ~A" name
+ prev-f f
+ `(set! ,(cadr f) (cons ,(cadr arg2) (cons ,@(cdr arg1)))))))))
+
+ (let ((repeated-if (and (= f-len prev-len 3)
+ (eq? (car f) 'if)
+ (eq? (car prev-f) 'if)
+ (equal? (cadr f) (cadr prev-f))))
+ (combine #f))
+ (if (not repeated-if)
+ (if block-fs
+ (if (not (eq? (cdr block-fs) prev-fs))
+ (set! combine prev-f)
+ (set! block-fs #f)))
+ (if block-fs
+ (set! combine (and (null? (cdr fs)) f))
+ (set! block-fs prev-fs)))
+
+ (when combine
+ (if (not (side-effect? (caadr block-fs) env))
+ (lint-format "perhaps combine repeated if's: ~A ... ~A -> (when ~A ~A ... ~A)" name
+ (car block-fs) combine
+ (cadr combine) (caddar block-fs) (caddr combine)))
+ (set! block-fs #f)))
+
+ (if (< ctr (- len 1))
+ ;; f is not the last form, so its value is ignored
+ (begin
+ (if (and (pair? f)
+ (eq? (car f) 'map))
+ (lint-format "map could be for-each: ~A" name (truncated-list->string f)))
+ (if (not (side-effect? f env))
+ (lint-format "this could be omitted: ~A" name (truncated-list->string f))))
+
+ ;; here f is the last form in the body
+ (when (and (pair? prev-f)
+ (pair? (cdr prev-f))
+ (pair? (cddr prev-f))) ; (set! ((L 1) 2)) an error, but lint should keep going
+ (if (and (eq? (car prev-f) 'set!)
+ (or (and (equal? (caddr prev-f) f) ; (begin ... (set! x (...)) (...))
+ (not (side-effect? f env)))
+ (and (symbol? f) ; (begin ... (set! x ...) x)
+ (eq? f (cadr prev-f)))))
+ (lint-format "this could be omitted: ~A" name (truncated-list->string f)))
+ (if (and (pair? f)
+ (pair? (cdr f))
+ (pair? (cddr f))
+ (eq? (cadr prev-f) (cadr f))
+ (or (and (eq? (car prev-f) 'vector-set!)
+ (eq? (car f) 'vector-ref))
+ (and (eq? (car prev-f) 'list-set!)
+ (eq? (car f) 'list-ref)))
+ (equal? (caddr f) (caddr prev-f))
+ (pair? (cdddr prev-f))
+ (not (pair? (cddddr prev-f)))
+ (not (pair? (cdddr f)))
+ (not (side-effect? (caddr f) env)))
+ (lint-format "this could be omitted: ~A" name (truncated-list->string f)))))
+
+ (let ((dpy-case (and (pair? f)
+ (memq (car f) '(display write newline write-char write-string))))) ; flush-output-port?
+ (define (out-port expr) ; ()=not specified (*stdout*), #f=something is wrong (not enough args)
+ (if (eq? (car expr) 'newline)
+ (if (pair? (cdr expr))
+ (cadr expr)
+ ())
+ (and (pair? (cdr expr))
+ (if (pair? (cddr expr))
+ (caddr expr)
+ ()))))
+ (when (and dpy-case
+ (not dpy-start))
+ (set! dpy-f fs)
+ (set! dpy-start ctr))
+ ;(format *stderr* "~A ~A ~A ~A~%" f ctr dpy-start len)
+ (when (and dpy-start
+ (> (- ctr dpy-start) (if dpy-case 1 2))
+ (or (= ctr (- len 1))
+ (not dpy-case)))
+ ;; display sequence starts at dpy-start, goes to ctr (prev-f) unless not dpy-case
+ (let ((ctrl-string "")
+ (args ())
+ (dctr 0)
+ (dpy-last (if (not dpy-case) prev-f f))
+ (op (out-port (car dpy-f)))
+ (exprs (make-list (if dpy-case (- ctr dpy-start -1) (- ctr dpy-start)) ())))
+ ;(format *stderr* "~A: ~A ~A ~A ~A~%" body dpy-case dpy-start ctr dpy-last)
+ (call-with-exit
+ (lambda (done)
+ (for-each
+ (lambda (d)
+ (if (not (equal? (out-port d) op))
+ (begin
+ (lint-format "unexpected port change: ~A -> ~A in ~A~%" name op (out-port d) d) ; ??
+ (done)))
+ (list-set! exprs dctr d)
+ (set! dctr (+ dctr 1))
+ (case (car d)
+ ((display)
+ (if (string? (cadr d))
+ (set! ctrl-string (string-append ctrl-string (cadr d)))
+ (begin
+ (set! ctrl-string (string-append ctrl-string "~A"))
+ (set! args (cons (cadr d) args)))))
+ ((write)
+ (if (string? (cadr d))
+ (set! ctrl-string (string-append ctrl-string "\"" (cadr d) "\""))
+ (begin
+ (set! ctrl-string (string-append ctrl-string "~S"))
+ (set! args (cons (cadr d) args)))))
+ ((write-char)
+ (if (char? (cadr d))
+ (set! ctrl-string (string-append ctrl-string (string (cadr d))))
+ (begin
+ (set! ctrl-string (string-append ctrl-string "~C"))
+ (set! args (cons (cadr d) args)))))
+ ((write-string) ; same as display but with possible start|end indices
+ (let ((indices (and (pair? (cddr d)) ; port
+ (pair? (cdddr d))
+ (cdddr d))))
+ (if (string? (cadr d))
+ (if indices
+ (if (and (integer? (car indices))
+ (or (null? (cdr indices))
+ (and (pair? indices)
+ (integer? (cadr indices)))))
+ (set! ctrl-string (string-append ctrl-string (apply substring (cadr d) indices)))
+ (begin
+ (set! ctrl-string (string-append ctrl-string "~A"))
+ (set! args (cons `(substring ,(cadr d) , at indices) args))))
+ (set! ctrl-string (string-append ctrl-string (cadr d))))
+ (begin
+ (set! ctrl-string (string-append ctrl-string "~A"))
+ (if indices
+ (set! args (cons `(substring ,(cadr d) , at indices) args))
+ (set! args (cons (cadr d) args)))))))
+ ((newline)
+ (set! ctrl-string (string-append ctrl-string "~%"))))
+
+ (when (eq? d dpy-last) ; op can be null => send to (current-output-port), return #f or #<unspecified>
+ (lint-format "perhaps ~A" name (lists->string exprs `(format ,op ,ctrl-string ,@(reverse args))))
+ (done)))
+ dpy-f))))
+ (set! dpy-start #f))
+ (unless dpy-case (set! dpy-start #f)))
+
+ (if (and (pair? f)
+ (memq head '(defmacro defmacro* define-macro define-macro* define-bacro define-bacro*))
+ (tree-member 'unquote f))
+ (lint-format "~A probably has too many unquotes: ~A" name head (truncated-list->string f)))
+
+ (set! prev-f f)
+ (set! prev-fs fs)
+ (set! prev-len f-len)
+ (set! env (lint-walk name f env))))))
+ env)
+
+
+ (define (lint-walk-function-body name head args arg-data body env)
+ ;; walk function body, with possible doc string at the start
+ (when (and (pair? body)
+ (pair? (cdr body))
+ (string? (car body)))
+ (if *report-doc-strings*
+ (lint-format "old-style doc string: ~S~%" name (car body)))
+ (set! body (cdr body))) ; ignore old-style doc-string
+ (lint-walk-body name head body env)
+ env)
+
+
+ (define (lint-walk-function head name args val form env)
+ ;(format *stderr* "function: ~A ~A ~A ~A~%" head name args val)
+
+ ;; check out function arguments (adding them to the current env), then walk its body, (name == function name, val == body)
+ ;; first check for (define (hi...) (ho...)) where ho has no opt args (and try to ignore possible string constant doc string)
+
+ (if (eq? head 'define)
+ (let ((bval (if (and (pair? val)
+ (string? (car val)))
+ (cdr val) ; strip away the (old-style) documentation string
+ val)))
+ (if (and (pair? bval) ; not (define (hi a) . 1)!
+ (pair? (car bval))
+ (null? (cdr bval))
+ (symbol? (caar bval))) ; not (define (hi) ((if #f + abs) 0))
+ (if (equal? args (cdar bval))
+ (let* ((cval (caar bval))
+ (p (symbol->value cval *e*))
+ (ary (arity p)))
+ (if (or (and (procedure? p)
+ (or (= (car ary) (cdr ary))
+ (= (length args) (cdr ary))))
+ (let ((e (or (var-member cval env)
+ (hash-table-ref globals cval))))
+ (and e
+ (var? e)
+ (let? (var-new e))
+ (let ((def ((var-new e) 'definition))
+ (e-args ((var-new e) 'arglist)))
+ (and
+ (pair? def)
+ (eq? ((var-new e) 'type) 'define)
+ (or (and (null? args)
+ (null? e-args))
+ (and (symbol? args)
+ (symbol? e-args))
+ (and (pair? args)
+ (pair? e-args)
+ (= (length args) (length e-args)))))))))
+ (lint-format "~A could be (define ~A ~A)" name name name cval)))
+ (if (and (eq? (caar bval) 'list-ref)
+ (pair? (cdar bval))
+ (pair? (cddar bval))
+ (eq? (car args) (cadar bval))
+ (null? (cdr args)))
+ (case (caddar bval)
+ ((0) (lint-format "~A could be (define ~A car)" name name name))
+ ((1) (lint-format "~A could be (define ~A cadr)" name name name))
+ ((2) (lint-format "~A could be (define ~A caddr)" name name name))
+ ((3) (lint-format "~A could be (define ~A cadddr)" name name name))))))))
+
+ (let ((ldata (and (symbol? name)
+ (make-var (if (not (memq head '(lambda lambda*))) name '[anonymous])
+ :new (inlet :type head
+ :decl (catch #t
+ (lambda ()
+ (case head
+ ((lambda)
+ (eval (list head (cadr form) #f)))
+ ((lambda*)
+ (eval (list head (copy (cadr form)) #f))) ; eval can remove :allow-other-keys!
+ ((define*)
+ (eval (list head (cons '_ (copy (cdadr form))) #f)))
+ ((defmacro defmacro*)
+ (eval (list head '_ (caddr form) #f)))
+ ((define-constant)
+ (eval (list 'define (cons '_ (cdadr form)) #f)))
+ (else
+ (eval (list head (cons '_ (cdadr form)) #f)))))
+ (lambda args
+ 'error))
+ :signature #f
+ :side-effect #t
+ :arglist (if (memq head '(defmacro defmacro*))
+ (caddr form)
+ (if (memq head '(lambda lambda*))
+ (cadr form)
+ (cdadr form)))
+ :definition form
+ :location #__line__)))))
+
+ (if (null? args)
+ (begin
+ (if (memq head '(define* lambda* defmacro* define-macro* define-bacro*))
+ (lint-format "~A could be ~A"
+ name head
+ (symbol (substring (symbol->string head) 0 (- (length (symbol->string head)) 1)))))
+ (lint-walk-function-body name head args () val env)
+ (if ldata
+ (append (list ldata) env)
+ env))
+
+ (if (or (symbol? args)
+ (pair? args))
+ (let ((arg-data (if (symbol? args) ; this is getting arg names to add to the environment
+ (list (make-var args))
+ (map
+ (lambda (arg)
+ (if (symbol? arg)
+ (if (memq arg '(:rest :allow-other-keys))
+ (values) ; map omits this entry
+ (make-var arg))
+ (if (or (not (pair? arg))
+ (not (= (length arg) 2))
+ (not (memq head '(define* lambda* defmacro* define-macro* define-bacro* definstrument))))
+ (begin
+ (lint-format "strange parameter for ~A: ~S" name head arg)
+ (values))
+ (begin
+ (if (not (cadr arg))
+ (lint-format "the default argument value is #f in ~A ~A" name head arg))
+ (make-var (car arg))))))
+ (proper-list args)))))
+
+ (lint-walk-function-body name head args arg-data val (append arg-data (if ldata (append (list ldata) env) env)))
+ (if *report-unused-parameters*
+ (report-usage name 'parameter head arg-data))
+ (if ldata
+ (append (list ldata) env)
+ env))
+
+ (begin
+ (lint-format "strange ~A parameter list ~A" name head args)
+ env)))))
+
+
+ (define (lint-walk name form env)
+ ;; walk a form
+ ;(format *stderr* "walk ~A, env: ~A~%~%" form env)
+
+ (if (symbol? form)
+ (set-ref? form env) ; returns env
+
+ (if (pair? form)
+ (let ((head (car form)))
+
+ (define (defmacro-case)
+ ;; ---------------- defmacro ----------------
+ (if (or (< (length form) 4)
+ (not (symbol? (cadr form))))
+ (lint-format "~A declaration is messed up: ~A" name head (truncated-list->string form))
+ (let ((sym (cadr form))
+ (args (caddr form))
+ (body (cdddr form)))
+ (if (and (pair? args)
+ (repeated-member? args env))
+ (lint-format "~A parameter is repeated: ~A" name head (truncated-list->string args)))
+ (lint-walk-function head sym args body form env))))
+
+ (define (define-case)
+ ;; ---------------- define ----------------
+ (if (< (length form) 2)
+ (begin
+ (lint-format "~S makes no sense" name form)
+ env)
+ (let ((sym (cadr form))
+ (val (cddr form)))
+
+ (if (symbol? sym)
+ (begin
+ ;(set! env (cons (list (make-var sym :typ (->type val))) env))
+
+ (if (keyword? sym)
+ (lint-format "keywords are constants ~A" name sym))
+
+ (if (memq head '(define define-constant define-envelope))
+ (let ((len (length form)))
+ (if (not (= len 3))
+ (lint-format "~S has ~A value~A?"
+ name form
+ (if (< len 3) "no" "too many")
+ (if (< len 3) "" "s"))))
+ (lint-format "~A is messed up" name (truncated-list->string form)))
+
+ (if (and (pair? val)
+ (null? (cdr val))
+ (equal? sym (car val)))
+ (lint-format "this ~A is either not needed, or is an error: ~A" name head (truncated-list->string form)))
+
+ (if (pair? (cddr form))
+ (let ((e (lint-walk sym (caddr form) env)))
+ (if (and (pair? e)
+ (eq? (var-name (car e)) '[anonymous])) ; (define x (lambda ...)) but it misses closures
+ (set! (var-name (car e)) sym)
+ (append (list (make-var sym)) env)))
+ (append (list (make-var sym)) env)))
+
+ ;; not (symbol? sym)
+ (if (and (pair? sym)
+ (not (pair? (car sym))))
+ (begin
+ (when (pair? (cdr sym))
+ (if (repeated-member? (proper-list (cdr sym)) env)
+ (lint-format "~A parameter is repeated: ~A" name head (truncated-list->string sym)))
+ (if (memq head '(define* define-macro* define-bacro*))
+ (check-star-parameters name (cdr sym))
+ (if (list-any? keyword? (cdr sym))
+ (lint-format "~A arglist can't handle keywords" name head))))
+
+ (if (and (eq? head 'definstrument)
+ (string? (car val)))
+ (set! val (cdr val)))
+
+ (if (keyword? (car sym))
+ (begin
+ (lint-format "keywords are constants ~A" name (car sym))
+ env)
+ (lint-walk-function head (car sym) (cdr sym) val form env)))
+
+ (begin
+ (lint-format "strange form: ~S" head form)
+ env))))))
+
+ (define (generator-case)
+ ;; ---------------- defgenerator ----------------
+ (get-generator form name head)
+ env)
+
+ (define (lambda-case)
+ ;; ---------------- lambda ----------------
+ ;; the lambda case includes stuff like call/cc?
+ (let ((len (length form)))
+ (if (< len 3)
+ (begin
+ (lint-format "~A is messed up in ~A" name head (truncated-list->string form))
+ env)
+ (let ((args (cadr form)))
+
+ (if (list? args)
+ (let ((arglen (length args)))
+ (if (null? args)
+ (if (eq? head 'lambda*) ; (lambda* ()...) -> (lambda () ...)
+ (lint-format "lambda* could be lambda: ~A" name form))
+ (begin ; args is a pair ; (lambda (a a) ...)
+ (if (repeated-member? (proper-list args) env)
+ (lint-format "~A parameter is repeated: ~A" name head (truncated-list->string args)))
+ (if (eq? head 'lambda*) ; (lambda* (a :b) ...)
+ (check-star-parameters name args)
+ (if (list-any? keyword? args) ; (lambda (:key) ...)
+ (lint-format "lambda arglist can't handle keywords (use lambda*)" name)))))
+
+ (if (and (eq? head 'lambda) ; (lambda () (f)) -> f, (lambda (a b) (f a b)) -> f
+ (= len 3)
+ (>= arglen 0)) ; not a dotted list
+ (let ((body (caddr form)))
+ (when (and (pair? body)
+ (symbol? (car body)))
+ (if (equal? args (cdr body))
+ (lint-format "perhaps ~A" name (lists->string form (car body)))
+ (if (equal? (reverse args) (cdr body))
+ (let ((rf (reversed (car body))))
+ (if rf (lint-format "perhaps ~A" name (lists->string form rf))))))))))
+
+ (if (and (symbol? args) ; (lambda args (apply f args)) -> f
+ (eq? head 'lambda)
+ (= len 3))
+ (let ((body (caddr form)))
+ (if (and (pair? body)
+ (= (length body) 3)
+ (eq? (car body) 'apply)
+ (symbol? (cadr body))
+ (eq? args (caddr body)))
+ (lint-format "perhaps ~A" name (lists->string form (cadr body)))))))
+
+ (lint-walk-function head name args (cddr form) form env)
+ env))))
+
+ (define (set-case)
+ ;; ---------------- set! ----------------
+ (if (not (= (length form) 3))
+ (begin
+ (lint-format "set! has too ~A arguments: ~S" name (if (> (length form) 3) "many" "few") form)
+ env)
+ (let ((settee (cadr form))
+ (setval (caddr form)))
+ (let ((result (lint-walk name setval env)))
+ ;(format *stderr* "result: ~A, env: ~A~%" result env)
+ (if (symbol? settee)
+ (if (constant? settee)
+ (lint-format "can't set! ~A (it is a constant)" name (truncated-list->string form)))
+ (if (pair? settee)
+ (begin
+ (if (memq (car settee) '(vector-ref list-ref string-ref hash-table-ref))
+ (lint-format "~A as target of set!~A" name (car settee) (truncated-list->string form)))
+ (lint-walk name settee env) ; this counts as a reference since it's by reference so to speak
+
+ ;; try type check (dilambda signatures)
+ (when (symbol? (car settee))
+ (let ((f (symbol->value (car settee) *e*)))
+ (when (dilambda? f)
+ (let ((sig (procedure-signature (procedure-setter f)))
+ (settee-len (length settee)))
+ (when (and (pair? sig)
+ (positive? settee-len)
+ (pair? (list-tail sig settee-len)))
+ (let ((checker (list-ref sig settee-len))
+ (arg-type (->type setval)))
+ (when (and (not (eq? 'symbol? arg-type))
+ (symbol? checker)
+ (not (compatible? checker arg-type)))
+ (lint-format "~A: new value should be a~A ~A: ~S: ~A"
+ name (car settee)
+ (if (char=? (string-ref (format #f "~A" checker) 0) #\i) "n" "")
+ checker arg-type
+ (truncated-list->string form)))))))))
+
+ (set! settee (do ((sym (car settee) (car sym)))
+ ((not (pair? sym)) sym))))
+ (lint-format "can't set! ~A" name (truncated-list->string form))))
+
+ (when (symbol? settee) ; see do above
+ (set-set? settee setval env))
+ (if (equal? (cadr form) (caddr form)) ; not settee and setval here!
+ (lint-format "pointless set!~A" name (truncated-list->string form)))
+
+ result))))
+
+ (define (quote-case)
+ ;; ---------------- quote ----------------
+ (let ((len (length form)))
+ (if (negative? len)
+ (lint-format "stray dot in quote's arguments? ~S" name form)
+ (if (not (= len 2))
+ (lint-format "quote has too ~A arguments: ~S"
+ name
+ (if (> (length form) 2) "many" "few")
+ form)
+ (if (and (< quote-warnings 20)
+ (or (number? (cadr form))
+ (boolean? (cadr form))
+ (string? (cadr form))
+ (vector? (cadr form))
+ (null? (cadr form))
+ (memq (cadr form) '(#<unspecified> #<undefined> #<eof>))))
+ (begin
+ (set! quote-warnings (+ quote-warnings 1))
+ (lint-format "quote is not needed here: ~A~A"
+ name (truncated-list->string form)
+ (if (= quote-warnings 20) "; will ignore this error henceforth." "")))))))
+ env)
+
+ (define (cond-case)
+ ;; ---------------- cond ----------------
+ (let ((ctr 0)
+ (len (- (length form) 1)))
+ (if (negative? len)
+ (lint-format "cond is messed up: ~A" name (truncated-list->string form))
+ (let ((exprs ())
+ (result :unset)
+ (has-else #f)
+ (has-combinations #f)
+ (falses ())
+ (prev-clause #f))
+ (for-each
+ (lambda (clause)
+ (set! ctr (+ ctr 1))
+
+ (if (and prev-clause
+ (not has-combinations)
+ (> len 2)
+ (pair? clause)
+ (equal? (cdr clause) (cdr prev-clause)))
+ (if (memq (car clause) '(else #t)) ; (cond ... (x z) (else z)) -> (cond ... (else z))
+ (if (not (side-effect? (car prev-clause) env))
+ (lint-format "this clause could be omitted: ~A" name prev-clause))
+ (set! has-combinations #t))) ; handle these later
+ (set! prev-clause clause)
+
+ (if (not (pair? clause))
+ (begin
+ (lint-format "cond clause is messed up: ~A" name (truncated-list->string clause))
+ (set! has-combinations #f))
+
+ (let ((expr (simplify-boolean (car clause) () falses env))
+ (test (car clause))
+ (sequel (cdr clause)))
+
+ (when (memq test '(else #t))
+ (set! has-else #t)
+ (if (and (pair? sequel)
+ (pair? (car sequel))
+ (null? (cdr sequel))
+ (eq? (caar sequel) 'cond))
+ (lint-format "else clause cond could be folded into the outer cond: ~A" name (truncated-list->string clause))))
+ (if (never-false expr)
+ (if (not (= ctr len))
+ (lint-format "cond test is never false: ~A" name form)
+ (if (and (not (memq expr '(#t else)))
+ (not (side-effect? test env)))
+ (lint-format "cond last test could be #t: ~A" name form)))
+ (if (never-true expr)
+ (lint-format "cond test is never true: ~A" name form)))
+ (if (not (side-effect? test env))
+ (begin
+ (if (and (not (memq test '(else #t)))
+ (pair? sequel)
+ (null? (cdr sequel)))
+ (if (equal? test (car sequel))
+ (lint-format "no need to repeat the test: ~A" name (lists->string clause (list test)))
+ (if (and (pair? (car sequel))
+ (pair? (cdar sequel))
+ (null? (cddar sequel))
+ (equal? test (cadar sequel)))
+ (lint-format "perhaps use => here: ~A" name
+ (lists->string clause (list test '=> (caar sequel)))))))
+ (if (member test exprs)
+ (lint-format "cond test repeated: ~A" name (truncated-list->string clause))
+ (set! exprs (cons test exprs)))))
+ (if (boolean? expr)
+ (if (not expr)
+ (lint-format "cond test is always false: ~A" name (truncated-list->string clause))
+ (if (not (= ctr len))
+ (lint-format "cond #t clause is not the last: ~A" name (truncated-list->string form))))
+ (if (eq? test 'else)
+ (if (not (= ctr len))
+ (lint-format "cond else clause is not the last: ~A" name (truncated-list->string form)))
+ (lint-walk name test env)))
+ (if (eq? result :unset)
+ (set! result sequel)
+ (if (not (equal? result sequel))
+ (set! result :unequal)))
+ (if (pair? sequel)
+ (if (eq? (car sequel) '=>)
+ (if (or (not (pair? (cdr sequel)))
+ (pair? (cddr sequel)))
+ (lint-format "cond => target is messed up: ~A" name (truncated-list->string clause))
+ (let ((f (cadr sequel)))
+ (if (symbol? f)
+ (let ((val (symbol->value f *e*)))
+ (if (procedure? val)
+ (if (not (aritable? val 1)) ; here values might be in test expr
+ (lint-format "=> target (~A) may be unhappy: ~A" name f clause))))
+ (if (and (pair? f)
+ (eq? (car f) 'lambda)
+ (pair? (cdr f))
+ (pair? (cadr f))
+ (not (= (length (cadr f)) 1)))
+ (lint-format "=> target (~A) may be unhappy: ~A" name f clause)))
+ (lint-walk name f env)))
+ (lint-walk-body name head sequel env))
+ (if (not (null? sequel)) ; (not (null?...)) here is correct -- we're looking for stray dots (lint is confused)
+ (lint-format "cond clause is messed up: ~A" name (truncated-list->string clause))))
+ (if (not (side-effect? expr env))
+ (set! falses (cons expr falses))
+ (set! result :unequal)))))
+ (cdr form))
+ (if (and has-else (pair? result)) ; all result clauses are the same (and not implicit)
+ (if (null? (cdr result))
+ (lint-format "perhaps ~A" name (lists->string form (car result)))
+ (lint-format "perhaps ~A" name (lists->string form `(begin , at result)))))
+
+ (if (= len 2)
+ (let ((c1 (cadr form))
+ (c2 (caddr form)))
+ (if (and (pair? c1) (= (length c1) 2)
+ (pair? c2) (= (length c2) 2)
+ (boolean? (cadr c1))
+ (boolean? (cadr c2))
+ (memq (car c2) '(#t else)))
+ (if (equal? (cadr c1) (cadr c2))
+ (if (not (side-effect? (car c1) env))
+ (lint-format "perhaps ~A" name (lists->string form (cadr c1))))
+ (if (eq? (cadr c1) #t)
+ (lint-format "perhaps ~A" name (lists->string form (car c1)))
+ (lint-format "perhaps ~A" name (lists->string form `(not ,(car c1)))))))))
+
+ (when has-combinations
+ (let ((new-clauses ())
+ (current-clauses ()))
+ (do ((clauses (cdr form) (cdr clauses)))
+ ((null? clauses)
+ (lint-format "perhaps ~A" name (lists->string form `(cond ,@(reverse new-clauses)))))
+ (let* ((clause (car clauses))
+ (result (cdr clause))) ; can be null in which case the test is the result
+ (if (and (pair? (cdr clauses))
+ (equal? result (cdar (cdr clauses))))
+ (set! current-clauses (cons clause current-clauses))
+ (if (pair? current-clauses)
+ (begin
+ (set! current-clauses (cons clause current-clauses))
+ (set! new-clauses (cons
+ (cons (simplify-boolean `(or ,@(map car (reverse current-clauses))) () () env)
+ result)
+ new-clauses))
+ (set! current-clauses ()))
+ (set! new-clauses (cons clause new-clauses))))))))))
+ env))
+
+ (define (case-case)
+ ;; ---------------- case ----------------
+ ;; here the keys are not evaluated, so we might have a list like (letrec define ...)
+ ;; also unlike cond, only 'else marks a default branch (not #t)
+ (if (< (length form) 3)
+ (lint-format "case is messed up: ~A" name (truncated-list->string form))
+ (let ((sel-type #t)
+ (selector (cadr form)))
+ (if (and (not (pair? selector))
+ (constant? selector))
+ (lint-format "case selector is a constant: ~A" name (truncated-list->string form)))
+ (lint-walk name selector env)
+ (if (and (pair? selector)
+ (symbol? (car selector)))
+ (begin
+ (set! sel-type (return-type (car selector)))
+ (if (and (symbol? sel-type)
+ (not (memq sel-type selector-types)))
+ (lint-format "case selector may not work with eqv: ~A" name (truncated-list->string selector)))))
+ (let ((all-keys ())
+ (all-exprs ())
+ (ctr 0)
+ (result :unset)
+ (exprs-repeated #f)
+ (else-foldable #f)
+ (has-else #f)
+ (len (length (cddr form))))
+ (for-each
+ (lambda (clause)
+ (set! ctr (+ ctr 1))
+ (if (not (pair? clause))
+ (lint-format "case clause should be a list: ~A" name (truncated-list->string clause))
+ (let ((keys (car clause))
+ (exprs (cdr clause)))
+ (if (null? exprs)
+ (lint-format "clause result is missing: ~A" name clause))
+ (if (eq? result :unset)
+ (set! result exprs)
+ (if (not (equal? result exprs))
+ (set! result :unequal)))
+ (if (member exprs all-exprs)
+ (set! exprs-repeated exprs)
+ (set! all-exprs (cons exprs all-exprs)))
+ (if (and (pair? exprs)
+ (null? (cdr exprs))
+ (pair? (car exprs))
+ (pair? (cdar exprs))
+ (null? (cddar exprs))
+ (equal? selector (cadar exprs)))
+ (lint-format "perhaps use => here: ~A" name
+ (lists->string clause (list keys '=> (caar exprs)))))
+ (if (pair? keys)
+ (if (not (proper-list? keys))
+ (if (null? keys)
+ (lint-format "null case key list: ~A" name (truncated-list->string clause))
+ (lint-format "stray dot in case case key list: ~A" name (truncated-list->string clause)))
+ (for-each
+ (lambda (key)
+ (if (or (vector? key)
+ (string? key)
+ (pair? key)
+ (hash-table? key))
+ (lint-format "case key ~S in ~S is unlikely to work (case uses eqv?)" name key clause))
+ (if (member key all-keys)
+ (lint-format "repeated case key ~S in ~S" name key clause)
+ (set! all-keys (cons key all-keys)))
+ ;; unintentional quote here, as in (case x ('a b)...) never happens and
+ ;; is hard to distinguish from (case x ((quote a) b)...) which happens a lot
+ (if (not (compatible? sel-type (->type key)))
+ (lint-format "case key ~S in ~S is pointless" name key clause)))
+ keys))
+ (if (not (eq? keys 'else))
+ (lint-format "bad case key ~S in ~S" name keys clause)
+ (begin
+ (set! has-else clause)
+ ;; exprs: (res) or if case, ((case ...)...)
+ (if (not (= ctr len))
+ (lint-format "case else clause is not the last: ~A"
+ name
+ (truncated-list->string (cddr form)))
+ (when (and (pair? exprs)
+ (pair? (car exprs))
+ (null? (cdr exprs)) ; just the case statement in the else clause
+ (eq? (caar exprs) 'case)
+ (equal? selector (cadar exprs))
+ (not (side-effect? selector env)))
+ (set! else-foldable (cddar exprs)))))))
+ (lint-walk-body name head exprs env))))
+ (cddr form))
+ (if (and has-else
+ (pair? result)
+ (not else-foldable))
+ (begin
+ (if (null? (cdr result))
+ (lint-format "perhaps ~A" name (lists->string form (car result)))
+ (lint-format "perhaps ~A" name (lists->string form `(begin , at result))))
+ (set! exprs-repeated #f)))
+
+ (when (or exprs-repeated else-foldable)
+ (let* ((new-keys-and-exprs ())
+ (else-clause (if else-foldable
+ (call-with-exit
+ (lambda (return)
+ (for-each (lambda (c) (if (eq? (car c) 'else) (return c))) else-foldable)
+ ()))
+ (or has-else ())))
+ (else-exprs (and (pair? else-clause) (cdr else-clause))))
+
+ (define (merge-case-keys clause)
+ ;(format *stderr* "clause: ~S~%" clause)
+ (let ((keys (car clause))
+ (exprs (cdr clause)))
+ (when (and (pair? exprs) ; ignore clauses that are messed up
+ (not (eq? keys 'else))
+ (not (equal? exprs else-exprs)))
+ (let ((prev (member exprs new-keys-and-exprs (lambda (a b) (equal? a (cdr b))))))
+ (if prev
+ (let* ((cur-clause (car prev))
+ (cur-keys (car cur-clause)))
+ (when (pair? cur-keys)
+ (set-car! cur-clause
+ (append cur-keys
+ (map (lambda (key)
+ (if (memv key cur-keys) (values) key))
+ keys)))))
+ (set! new-keys-and-exprs (cons (cons (copy (car clause)) (cdr clause)) new-keys-and-exprs)))))))
+
+ (for-each merge-case-keys (cddr form))
+ (if else-foldable
+ (for-each merge-case-keys else-foldable))
+
+ ;(format *stderr* "~%~A -> new: ~A, else: ~A~%" form new-keys-and-exprs else-clause)
+
+ (if (null? new-keys-and-exprs)
+ (if (or (null? else-clause) ; can this happen? (it's caught above as an error)
+ (null? (cdr else-clause)))
+ (lint-format "perhaps ~A" name (lists->string form ()))
+ (if (null? (cddr else-clause))
+ (lint-format "perhaps ~A" name (lists->string form (cadr else-clause)))
+ (lint-format "perhaps ~A" name (lists->string form `(begin ,@(cdr else-clause))))))
+ (lint-format "perhaps ~A" name
+ (lists->string form
+ (if (pair? else-clause)
+ `(case ,(cadr form) ,@(reverse new-keys-and-exprs) ,else-clause)
+ `(case ,(cadr form) ,@(reverse new-keys-and-exprs)))))))))))
+ env)
+
+ (define (do-case)
+ ;; ---------------- do ----------------
+ (let ((vars ()))
+ (if (or (< (length form) 3)
+ (not (proper-list? (cadr form)))
+ (not (proper-list? (caddr form))))
+ (lint-format "do is messed up: ~A" name (truncated-list->string form))
+
+ (let ((step-vars (cadr form)))
+
+ (if (not (side-effect? form env))
+ (let ((end+result (caddr form)))
+ (if (or (not (pair? end+result))
+ (null? (cdr end+result)))
+ (lint-format "this do-loop could be replaced by (): ~A" name (truncated-list->string form))
+ (if (and (null? (cddr end+result))
+ (code-constant? (cadr end+result)))
+ (lint-format "this do-loop could be replaced by ~A: ~A" name (cadr end+result) (truncated-list->string form))))))
+
+ ;; walk the init forms before adding the step vars to env
+ (do ((bindings step-vars (cdr bindings)))
+ ((not (pair? bindings))
+ (if (pair? bindings)
+ (lint-format "do variable list is not a proper list? ~S" name step-vars)))
+ (if (binding-ok? name head (car bindings) env #f)
+ (begin
+ (lint-walk name (cadar bindings) env)
+ (set! vars (append (list (make-var :name (caar bindings)
+ :typ (->type (cadar bindings))
+ :val (and (pair? (cddar bindings)) (caddar bindings))))
+ vars)))))
+
+ ;; walk the step exprs
+ (do ((bindings step-vars (cdr bindings)))
+ ((not (pair? bindings)))
+ (let ((stepper (car bindings))) ; the entire binding: '(i 0 (+ i 1))
+ (when (and (binding-ok? name head stepper env #t)
+ (pair? (cddr stepper)))
+ (lint-walk name (caddr stepper) (append vars env))
+ (if (eq? (car stepper) (caddr stepper)) ; (i 0 i) -> (i 0)
+ (lint-format "perhaps ~A" name (lists->string stepper (list (car stepper) (cadr stepper)))))
+ (let ((data (var-member (car stepper) vars)))
+ (set! (var-ref data) #f))
+ (when (and (pair? (caddr stepper))
+ (not (eq? (car stepper) (cadr stepper))) ; (lst lst (cdr lst))
+ (eq? (car (caddr stepper)) 'cdr)
+ (eq? (cadr stepper) (cadr (caddr stepper))))
+ (lint-format "this looks suspicious: ~A" name stepper)))))
+
+ ;; walk the body and end stuff (it's too tricky to find infinite do loops)
+ (if (pair? (caddr form))
+ (let ((end+result (caddr form)))
+ (lint-walk-body name head (cddr form) (append vars env))
+ (if (pair? end+result)
+ (let ((end (car end+result)))
+ (if (and (symbol? end) (memq end '(= > < >= <= null? not)))
+ (lint-format "perhaps missing parens: ~A" name end+result))
+ (if (never-false end)
+ (lint-format "end test is never false: ~A" name end)
+ (if end ; it's not #f
+ (if (never-true end)
+ (lint-format "end test is never true: ~A" name end)
+ (let ((v (and (pair? end)
+ (memq (car end) '(< > <= >=))
+ (pair? (cdr end))
+ (symbol? (cadr end))
+ (member (cadr end) vars (lambda (a b) (eq? a (var-name b)))))))
+ ;; if found, v is the var info
+ (when (pair? v)
+ (let ((step (var-value (car v))))
+ (when (pair? step)
+ (let ((inc (and (memq (car step) '(+ -))
+ (pair? (cdr step))
+ (pair? (cddr step))
+ (or (and (real? (cadr step)) (cadr step))
+ (and (real? (caddr step)) (caddr step))))))
+ (when (real? inc)
+ (if (or (and (eq? (car step) '+)
+ (positive? inc)
+ (memq (car end) '(< <=)))
+ (and (eq? (car step) '-)
+ (positive? inc)
+ (memq (car end) '(> >=))))
+ (lint-format "do step looks like it doesn't match end test: ~A" name
+ (lists->string step end))))))))))
+ (if (pair? (cdr end+result))
+ (lint-format "result is unreachable: ~A" name end+result)))))))
+ (lint-walk-body name head (cdddr form) (append vars env)))
+
+ ;; before report-usage, check for unused variables, and don't complain about them if
+ ;; they are referenced in an earlier step expr?(!)
+ (do ((v vars (cdr v)))
+ ((null? v))
+ (let ((var (car v)))
+ (unless (var-ref var)
+ ;; var was not seen in the end+result/body or any subsequent step exprs
+ ;; vars is reversed order, so we need only scan var-value of the rest
+
+ (if (side-effect? (var-value var) env)
+ (set! (var-ref var) #t)
+ (for-each
+ (lambda (nv)
+ (if (or (eq? (var-name var) (var-value nv))
+ (and (pair? (var-value nv))
+ (tree-member (var-name var) (var-value nv))))
+ (set! (var-ref var) #t)))
+ (cdr v))))))
+
+ (report-usage name 'variable head vars)
+
+ ;; check for do-loop as copy/fill! stand-in
+ (let ((end-test (and (pair? (caddr form)) (caaddr form)))
+ (body (cdddr form))
+ (setv #f))
+ (when (and (pair? end-test)
+ (= (length vars) 1)
+ (= (length body) 1)
+ (pair? (car body))
+ (memq (caar body) '(vector-set! float-vector-set! int-vector-set! list-set! string-set!))
+ (eq? (var-type (car vars)) 'integer?)
+ (eq? (car end-test) '=)
+ (eq? (cadr end-test) (var-name (car vars)))
+ (eq? (caddar body) (var-name (car vars)))
+ (let ((val (car (cdddar body))))
+ (set! setv val)
+ (or (code-constant? val)
+ (and (pair? val)
+ (memq (car val) '(vector-ref float-vector-ref int-vector-ref list-ref string-ref))
+ (eq? (caddr val) (var-name (car vars)))))))
+ (if (code-constant? setv)
+ (lint-format "perhaps ~A" name
+ (lists->string form `(fill! ,(cadar body) ,(car (cdddar body)) 0 ,(caddr end-test))))
+ (lint-format "perhaps ~A" name
+ (lists->string form `(copy ,(cadr setv) ,(cadar body) 0 ,(caddr end-test)))))))))
+ env))
+
+ (define (let-case)
+ ;; ---------------- let ----------------
+ (if (or (< (length form) 3)
+ (and (not (symbol? (cadr form)))
+ (not (list? (cadr form)))))
+ (lint-format "let is messed up: ~A" name (truncated-list->string form))
+ (let ((named-let (and (symbol? (cadr form)) (cadr form))))
+ (if (keyword? named-let)
+ (lint-format "bad let name: ~A" name named-let))
+
+ (unless named-let
+ ;; this could be extended to other such cases
+ (or (any? (lambda (var)
+ (or (not (pair? var))
+ (not (pair? (cdr var)))
+ (not (code-constant? (cadr var)))))
+ (cadr form))
+ (any? (lambda (expr)
+ (side-effect? expr env))
+ (cddr form))
+ (catch #t
+ (lambda ()
+ (let ((val (eval (copy-tree form) (rootlet))))
+ (lint-format "perhaps ~A" name (lists->string form val))))
+ (lambda args
+ 'error))))
+
+ (let ((vars (if (and named-let
+ (not (keyword? named-let))
+ (or (null? (caddr form))
+ (and (proper-list? (caddr form))
+ (every? pair? (caddr form)))))
+ (list (make-var named-let
+ :new (inlet :type head
+ :decl (eval (list 'define (cons '_ (map car (caddr form))) #f))
+ :signature #f
+ :side-effect #t
+ :arglist (map car (caddr form))
+ :definition form
+ :location #__line__))) ; TODO: named-let*
+ ()))
+ (varlist (if named-let (caddr form) (cadr form)))
+ (body (if named-let (cdddr form) (cddr form))))
+
+ (if (not (list? varlist))
+ (lint-format "let is messed up: ~A" name (truncated-list->string form))
+ (if (and (null? varlist)
+ (pair? body)
+ (null? (cdr body))
+ (not (side-effect? (car body) env)))
+ (lint-format "perhaps ~A" name (lists->string form (car body)))))
+
+ (do ((bindings varlist (cdr bindings)))
+ ((not (pair? bindings))
+ (if (pair? bindings)
+ (lint-format "let variable list is not a proper list? ~S" name varlist)))
+ (if (binding-ok? name head (car bindings) env #f)
+ (let ((val (cadar bindings)))
+ (if (and (pair? val)
+ (eq? 'lambda (car val))
+ (not (hash-table-ref globals (caar bindings)))
+ (tree-car-member (caar bindings) val)
+ (not (var-member (caar bindings) env)))
+ (lint-format "let variable ~A is called in its binding? Perhaps let should be letrec: ~A"
+ name (caar bindings)
+ (truncated-list->string bindings)))
+ (lint-walk name val env)
+
+ ;; can we tell its type and (as long as not set) check for type errors?
+ ;; need a function that turns a constant into a type indication,
+ ;; then append that as the 4th entry below (used only in do?)
+ ;; then use that in arg checks if arg is a known var
+
+ (set! vars (append (list (make-var (caar bindings) :val val :typ (->type val))) vars)))))
+ ;; each var is (sym ref set opt-type-data new)
+
+ (let* ((cur-env (append vars env))
+ (e (lint-walk-body name head body cur-env))
+ (nvars (if (null? cur-env)
+ e
+ (and (not (eq? e cur-env))
+ (env-difference name e cur-env ())))))
+ ;(format *stderr* "nvars: ~A e: ~A~%" nvars e)
+ (if (pair? nvars)
+ (if (eq? (var-name (car nvars)) '[anonymous])
+ (begin
+ (set! env (cons (car nvars) env))
+ (set! nvars (cdr nvars)))
+ (set! vars (append nvars vars)))))
+ (report-usage name 'variable head vars))))
+ env)
+
+ (define (let*-case)
+ ;; ---------------- let* ----------------
+ (if (< (length form) 3)
+ (lint-format "let* is messed up: ~A" name (truncated-list->string form))
+ (let ((named-let (and (symbol? (cadr form)) (cadr form))))
+ (let ((vars (if named-let (list (make-var named-let)) ()))
+ (varlist (if named-let (caddr form) (cadr form)))
+ (side-effects #f))
+ (if (not (list? varlist))
+ (lint-format "let* is messed up: ~A" name (truncated-list->string form)))
+ (do ((bindings varlist (cdr bindings)))
+ ((not (pair? bindings))
+ (if (pair? bindings)
+ (lint-format "let* variable list is not a proper list? ~S"
+ name (if named-let (caddr form) (cadr form)))))
+ (if (binding-ok? name head (car bindings) env #f)
+ (begin
+ (if (not side-effects)
+ (set! side-effects (side-effect? (cadar bindings) env)))
+ (lint-walk name (cadar bindings) (append vars env))
+ (set! vars (append (list (make-var (caar bindings) :val (cadar bindings) :typ (->type (cadar bindings)))) vars)))))
+
+ (if (and (not side-effects)
+ (not (any? var-ref vars)))
+ (lint-format "let* could be let: ~A" name (truncated-list->string form)))
+
+ ;; in s7, let evaluates var values top down, so this message is correct
+ ;; even in cases like (let ((ind (open-sound...)) (mx (maxamp))) ...)
+ ;; in r7rs, the order is not specified (section 4.2.2 of the spec), so
+ ;; here we would restrict this message to cases where there is only
+ ;; one variable, or where subsequent values are known to be independent.
+ ;; if each function could tell us what globals it depends on or affects,
+ ;; we could make this work in all cases.
+
+ (let* ((cur-env (append vars env))
+ (e (lint-walk-body name head (if named-let (cdddr form) (cddr form)) cur-env))
+ (nvars (and (not (eq? e cur-env))
+ (env-difference name e cur-env ()))))
+ (if (pair? nvars)
+ (set! vars (append nvars vars))))
+
+ (report-usage name 'variable head vars))))
+ env)
+
+ (define (letrec-case)
+ ;; ---------------- letrec ----------------
+ (if (< (length form) 3)
+ (lint-format "~A is messed up: ~A" name head (truncated-list->string form))
+ (let ((vars ()))
+ (if (null? (cadr form))
+ (lint-format "~A could be let: ~A" name head (truncated-list->string form))
+ (if (not (pair? (cadr form)))
+ (lint-format "~A is messed up: ~A" name head (truncated-list->string form))
+ (if (and (null? (cdadr form))
+ (eq? head 'letrec*)) ; this happens all the time!
+ (lint-format "letrec* could be letrec? ~A" name (truncated-list->string form)))))
+ (do ((bindings (cadr form) (cdr bindings)))
+ ((not (pair? bindings))
+ (if (pair? bindings)
+ (lint-format "letrec variable list is not a proper list? ~S" name (cadr form))))
+ (if (binding-ok? name head (car bindings) env #f)
+ (set! vars (append (list (make-var (caar bindings) :val (cadar bindings) :typ (->type (cadar bindings)))) vars))))
+ (let ((new-env (append vars env)))
+ (do ((bindings (cadr form) (cdr bindings)))
+ ((not (pair? bindings)))
+ (if (binding-ok? name head (car bindings) env #t)
+ (lint-walk name (cadar bindings) new-env)))
+
+ (let* ((cur-env (append vars env))
+ (e (lint-walk-body name head (cddr form) cur-env))
+ (nvars (and (not (eq? e cur-env))
+ (env-difference name e cur-env ()))))
+ (if (pair? nvars)
+ (set! vars (append nvars vars)))))
+
+ (report-usage name 'variable head vars)))
+ env)
+
+ (define (begin-case)
+ ;; ---------------- begin ----------------
+ (if (not (proper-list? form))
+ (begin
+ (lint-format "stray dot in begin? ~A" name (truncated-list->string form))
+ env)
+ (begin
+ (if (and (pair? (cdr form))
+ (null? (cddr form)))
+ (lint-format "begin could be omitted: ~A" name (truncated-list->string form)))
+ (lint-walk-body name head (cdr form) env)))
+ env)
+
+ (define (when-case)
+ ;; -------- when, unless --------
+ (if (< (length form) 3)
+ (lint-format "~A is messed up: ~A" name head (truncated-list->string form))
+ (let ((test (cadr form)))
+ (if (and (pair? test)
+ (eq? (car test) 'not))
+ (lint-format "possible optimization: ~A -> ~A"
+ name
+ (truncated-list->string form)
+ (truncated-list->string `(,(if (eq? head 'when) 'unless 'when)
+ ,(cadr test)
+ ,@(cddr form)))))
+ (if (never-false test)
+ (lint-format "~A test is never false: ~A" name head form)
+ (if (never-true test)
+ (lint-format "~A test is never true: ~A" name head form)))
+ (if (symbol? test)
+ (set-ref? test env)
+ (if (pair? test)
+ (lint-walk name test env)))
+ (let* ((e (lint-walk-body name head (cddr form) env))
+ (vars (if (not (eq? e env))
+ (env-difference name e env ())
+ ())))
+ (report-usage name 'variable head vars))))
+ env)
+
+ (define (with-let-case)
+ ;; -------- with-let --------
+ (if (< (length form) 3)
+ (lint-format "~A is messed up: ~A" head name (truncated-list->string form))
+ (let ((e (cadr form)))
+ (if (or (and (code-constant? e)
+ (not (let? e)))
+ (and (symbol? e)
+ (defined? e)
+ (not (let? (symbol->value e))))
+ (and (pair? e)
+ (let ((op (return-type (car e))))
+ (and op
+ (not (return-type-ok? 'let? op))))))
+ (lint-format "~A: first argument should be an environment: ~A" head name (truncated-list->string form)))
+ (if (symbol? e)
+ (set-ref? e env)
+ (if (pair? e)
+ (begin
+ (if (and (null? (cdr e))
+ (eq? (car e) 'curlet))
+ (lint-format "~A is not needed here: ~A" head name (truncated-list->string form)))
+ (lint-walk name e env))))
+ (let ((walked #f))
+ (if (or (and (symbol? e)
+ (memq e '(*gtk* *motif* *gl* *libc* *libm* *libgdbm* *libgsl*)))
+ (and (pair? e)
+ (eq? (car e) 'sublet)
+ (pair? (cdr e))
+ (memq (cadr e) '(*gtk* *motif* *gl* *libc* *libm* *libgdbm* *libgsl*))
+ (set! e (cadr e))))
+ (let ((lib (if (not (defined? e))
+ (let ((file (*autoload* e)))
+ (and (string? file)
+ (load file)))
+ (symbol->value e))))
+ (when (let? lib)
+ (let ((old-e *e*))
+ (set! *e* lib)
+ (let* ((e (lint-walk-body name head (cddr form) env))
+ (vars (if (not (eq? e env))
+ (env-difference name e env ())
+ ())))
+ (report-usage name 'variable head vars))
+ (set! *e* old-e)
+ (set! walked #t)))))
+
+ (unless walked
+ (let* ((e (lint-walk-body name head (cddr form) env))
+ (vars (if (not (eq? e env))
+ (env-difference name e env ())
+ ())))
+ (report-usage name 'variable head vars))))))
+ env)
+
+ (define (else-case)
+ ;; ---------------- everything else ----------------
+ (if (not (proper-list? form))
+ (begin
+ ;; these appear to be primarily macro arguments
+ (if (and (pair? form)
+ (symbol? (car form))
+ (procedure? (symbol->value (car form) *e*)))
+ (lint-format "unexpected dot: ~A" name (truncated-list->string form)))
+ env)
+ (begin
+ (when (symbol? head)
+ (check-call name head form env)
+ (if (not (or (hash-table-ref globals head)
+ (var-member head env)))
+ (check-special-cases name head form env))
+ (if (assq head deprecated-ops)
+ (lint-format "~A is deprecated; use ~A" name head (cdr (assq head deprecated-ops))))
+
+ (if (and (not (= line-number last-simplify-numeric-line-number))
+ (not (hash-table-ref globals head))
+ (hash-table-ref numeric-ops head)
+ (not (var-member head env)))
+ (let ((val (simplify-numerics form env)))
+ (if (not (equal-ignoring-constants? form val))
+ (begin
+ (set! last-simplify-numeric-line-number line-number)
+ (lint-format "perhaps ~A" name (lists->string form val))))))
+
+ ;; if we loaded this file first, and f (head) is defined (e.g. scan above),
+ ;; and it is used before it is defined, but not thereafter, the usage stuff
+ ;; can get confused, so other-identifiers is trying to track those.
+
+ (if (and (not (hash-table-ref other-identifiers head))
+ (not (defined? head start-up-let)))
+ (hash-table-set! other-identifiers head #t)))
+
+ (when (and (pair? head)
+ (> (length head) 0)
+ (eq? (car head) 'lambda))
+ (if (and (proper-list? (cadr head))
+ (not (= (length (cadr head)) (length (cdr form)))))
+ (lint-format "~A has ~A arguments: ~A"
+ head (car head)
+ (if (> (length (cadr head)) (length (cdr form)))
+ "too few" "too many")
+ (truncated-list->string form))))
+
+ (let ((vars env))
+ (for-each
+ (lambda (f)
+ (set! vars (lint-walk name f vars)))
+ form))
+ ))
+ env)
+
+ (set! line-number (pair-line-number form))
+ (case head
+
+ ((define define*
+ define-constant define-envelope
+ define-expansion define-macro define-macro* define-bacro define-bacro*
+ definstrument defanimal)
+ (define-case))
+
+ ((lambda lambda*) (lambda-case))
+ ((set!) (set-case))
+ ((quote) (quote-case))
+ ((cond) (cond-case))
+ ((case) (case-case))
+ ((do) (do-case))
+ ((let) (let-case))
+ ((let*) (let*-case))
+ ((letrec letrec*) (letrec-case))
+ ((begin) (begin-case))
+ ((when unless) (when-case))
+ ((with-let) (with-let-case))
+
+ ((defmacro defmacro*) (defmacro-case))
+ ((defgenerator) (generator-case))
+ ((define-syntax let-syntax letrec-syntax define-module) ; all meaningless in s7
+ ;; actually the real problem with checking other schemes' code is that they use a large number
+ ;; of non-standard # and \ forms. The # forms can mostly be kludged up via #*readers, but I'm
+ ;; not going to start building in all the crazy \ stuff.
+ ;; Some schemes use the execrable [] substitutes for () -- Gauche in particular.
+ env)
+
+ (else
+ (else-case))))
+
+ ;; else form is not a symbol and not a pair
+ env)))
+
+ ;;; --------------------------------------------------------------------------------
+ (let ((documentation "(lint file port) looks for infelicities in file's scheme code"))
+ (lambda* (file (outp *lint-output-port*) (report-input #t))
+ (set! outport outp)
+ (set! globals (make-hash-table))
+ (set! other-identifiers (make-hash-table))
+ (set! loaded-files ())
+ (set! last-simplify-boolean-line-number -1)
+ (set! last-simplify-numeric-line-number -1)
+ (set! last-checker-line-number -1)
+ (set! line-number -1)
+ (set! quote-warnings 0)
+
+ ;(format *stderr* "lint ~S~%" file)
+
+ (let ((fp (if (input-port? file)
+ file
+ (begin
+ (set! *current-file* file)
+ (if *load-file-first* ; this can improve the error checks
+ (load file))
+ (catch #t
+ (lambda ()
+ (let ((p (open-input-file file)))
+ (if report-input (format outport ";~A~%" file))
+ (set! loaded-files (cons file loaded-files))
+ p))
+ (lambda args
+ (format outport " can't open ~S: ~A~%" file (apply format #f (cadr args)))
+ #f))))))
+
+ (if (input-port? fp)
+ (let ((vars ())
+ (line 0)
+ (last-form #f)
+ (last-line-number -1))
+ (do ((form (read fp) (read fp)))
+ ((eof-object? form))
+ (if (pair? form)
+ (set! line (max line (pair-line-number form))))
+
+ (if (and (not (= last-line-number -1))
+ (not (side-effect? last-form vars)))
+ (format outport " top-level (line ~D): this has no effect: ~A~%"
+ last-line-number
+ (truncated-list->string last-form)))
+ (set! last-form form)
+ (set! last-line-number line)
+ (set! vars (lint-walk (if (symbol? form)
+ form
+ (and (pair? form)
+ (car form)))
+ form
+ vars)))
+
+ (if (and (pair? vars)
+ *report-multiply-defined-top-level-functions*)
+ (for-each
+ (lambda (var)
+ (let ((var-file (hash-table-ref *top-level-objects* (car var))))
+ (if (not var-file)
+ (hash-table-set! *top-level-objects* (car var) *current-file*)
+ (if (and (string? *current-file*)
+ (not (string=? var-file *current-file*)))
+ (format outport ";~S is defined at the top level in ~S and ~S~%" (car var) var-file *current-file*)))))
+ vars))
+
+ (if (and (string? file)
+ (pair? vars)
+ *report-unused-top-level-functions*)
+ (report-usage file 'top-level-var "" vars))
+
+ (if (not (input-port? file))
+ (close-input-port fp))))))))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; this reads an HTML file, finds likely-looking scheme code, and runs lint over it.
+;;; called on all snd files in hg.scm
+
+(define (html-lint file)
+
+ (define (remove-markups str)
+ (let ((tpos (string-position "<b>" str)))
+ (if tpos
+ (let ((epos (string-position "</b>" str)))
+ (remove-markups (string-append (substring str 0 tpos)
+ (substring str (+ tpos 3) epos)
+ (substring str (+ epos 4)))))
+ (let ((apos (string-position "<a " str))
+ (epos (string-position "<em " str)))
+ (if (and (not apos)
+ (not epos))
+ str
+ (let* ((pos (if (and apos epos) (min apos epos) (or apos epos)))
+ (bpos (char-position #\> str (+ pos 1)))
+ (epos (if (and apos (= pos apos))
+ (string-position "</a>" str (+ bpos 1))
+ (string-position "</em>" str (+ bpos 1)))))
+ (string-append (substring str 0 pos)
+ (substring str (+ bpos 1) epos)
+ (remove-markups (substring str (+ epos (if (and apos (= apos pos)) 4 5)))))))))))
+
+ (define (fixup-html str)
+ (let ((pos (char-position #\& str)))
+ (if (not pos)
+ str
+ (string-append (substring str 0 pos)
+ (let ((epos (char-position #\; str pos)))
+ (let ((substr (substring str (+ pos 1) epos)))
+ (let ((replacement (cond ((string=? substr "gt") ">")
+ ((string=? substr "lt") "<")
+ ((string=? substr "mdash") "-")
+ ((string=? substr "amp") "&")
+ (else (format #t "unknown: ~A~%" substr)))))
+ (string-append replacement
+ (fixup-html (substring str (+ epos 1)))))))))))
+
+ (call-with-input-file file
+ (lambda (f)
+ (do ((line-num 0 (+ line-num 1))
+ (line (read-line f #t) (read-line f #t)))
+ ((eof-object? line))
+
+ ;; look for <pre , gather everything until </pre>
+ ;; decide if it is scheme code (first char is #\()
+ ;; if so, clean out html markup stuff, call lint on that
+
+ (let ((pos (string-position "<pre" line)))
+ (if pos
+ (let ((code (substring line (+ (char-position #\> line) 1))))
+ (do ((cline (read-line f #t) (read-line f #t))
+ (rline 1 (+ rline 1)))
+ ((string-position "</pre>" cline)
+ (set! line-num (+ line-num rline)))
+ (set! code (string-append code cline)))
+
+ ;; is first non-whitespace char #\(? ignoring comments
+ (let ((len (length code)))
+ (do ((i 0 (+ i 1)))
+ ((>= i len))
+ (let ((c (string-ref code i)))
+ (if (not (char-whitespace? c))
+ (if (char=? c #\;)
+ (set! i (char-position #\newline code i))
+ (begin
+ (set! i (+ len 1))
+ (if (char=? c #\()
+ (catch #t
+ (lambda ()
+ (let ((ncode (with-input-from-string
+ (fixup-html (remove-markups code))
+ read)))
+ (call-with-output-file "t631-temp.scm"
+ (lambda (fout)
+ (format fout "~S~%" ncode)))
+ (let ((outstr (call-with-output-string
+ (lambda (p)
+ (let ((old-shadow *report-shadowed-variables*))
+ (set! *report-shadowed-variables* #t)
+ (lint "t631-temp.scm" p #f)
+ (set! *report-shadowed-variables* old-shadow))))))
+ (if (> (length outstr) 0)
+ (format #t ";~A ~D: ~A~%" file line-num outstr)))))
+ (lambda args
+ (format #t ";~A ~D, error in read: ~A ~A~%" file line-num args
+ (fixup-html (remove-markups code)))))))))))))))))))
diff --git a/makefile.in b/makefile.in
index 00be028..388b328 100644
--- a/makefile.in
+++ b/makefile.in
@@ -1,6 +1,3 @@
-PACKAGE = @SND_PACKAGE@
-VERSION = @SND_VERSION@
-
CC = @CC@
SHELL = @SHELL@
INSTALL = @INSTALL@
@@ -10,7 +7,6 @@ CFLAGS = @CFLAGS@
GTK_CFLAGS = @GTK_CFLAGS@
XEN_CFLAGS = @XEN_CFLAGS@
CAIRO_CFLAGS = @CAIRO_CFLAGS@
-MOTIF_FLAGS = @XFLAGS@
FFTW_CFLAGS = @FFTW_CFLAGS@
GL_FLAGS = @GL_FLAGS@
GSL_FLAGS = @GSL_CFLAGS@
@@ -23,14 +19,11 @@ LIBS = @LIBS@
XEN_LIBS = @XEN_LIBS@
GTK_LIBS = @GTK_LIBS@
GTK_LD_LIBS = @GTK_LD_LIBS@
-MOTIF_LIBS = @XLIBS@
AUDIO_LIB = @AUDIO_LIB@
GSL_LIBS = @GSL_LIBS@
GL_LIBS = @GL_LIBS@
GL_FILES = @GL_FILES@
FFTW_LIBS = @FFTW_LIBS@
-SNDLIB_LIB = @SNDLIB_LIB@
-FAM_LIB = @FAM_LIB@
JACK_LIBS = @JACK_LIBS@
GMP_LIBS = @GMP_LIBS@
@@ -49,10 +42,7 @@ top_srcdir = @top_srcdir@
datarootdir = ${prefix}/share
pkgdatadir = ${datarootdir}/snd
-# snd-help.c looks for the documentation in /usr/local/share/doc/snd-12 -- perhaps it should be pkgdatadir? or passed at compile time
-DEFS = -DSCRIPTS_DIR=\"$(pkgdatadir)\" @DEFS@
-
-SNDLIB_FILES = $(@SNDLIB_FILES@)
+DEFS = -DSCRIPTS_DIR=\"$(pkgdatadir)\"
GX_FILES = $(@GX_FILES@)
GX_HEADERS = $(@GX_HEADERS@)
@@ -61,13 +51,13 @@ GX_HEADERS = $(@GX_HEADERS@)
.SUFFIXES: .c .o
.c.o:
- $(CC) -c $(DEFS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(MOTIF_FLAGS) $(GSL_FLAGS) $(GL_FLAGS) $(JACK_FLAGS) $(FFTW_CFLAGS) $<
+ $(CC) -c $(DEFS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) $(GL_FLAGS) $(JACK_FLAGS) $(FFTW_CFLAGS) $<
SND_SCRIPTS = *.scm *.fs *.rb *.fsm
SNDLIB_HEADERS = mus-config.h sndlib.h _sndlib.h sndlib-strings.h clm.h vct.h sndlib2xen.h clm2xen.h xen.h clm-strings.h
SND_HEADERS = mus-config.h sndlib.h _sndlib.h clm.h snd.h snd-0.h snd-1.h snd-strings.h xen.h snd-menu.h snd-file.h
SND_X_HEADERS = snd-x0.h snd-x1.h
-SND_G_HEADERS = snd-g0.h snd-g1.h
+SND_G_HEADERS = snd-g0.h snd-g1.h glistener.h
SNDLIB_O_FILES = headers.o audio.o io.o sound.o clm.o xen.o vct.o sndlib2xen.o clm2xen.o
S7_HEADERS = s7.h mus-config.h
@@ -76,15 +66,11 @@ S7_O_FILES = @S7_LIB@
NO_GUI_HEADERS = snd-nogui0.h snd-nogui1.h
-O_FILES = snd-io.o snd-utils.o snd-listener.o snd-error.o snd-completion.o snd-menu.o snd-axis.o snd-data.o snd-fft.o snd-marks.o snd-file.o snd-edits.o snd-chn.o snd-dac.o snd-region.o snd-select.o snd-find.o snd-snd.o snd-help.o snd-main.o snd-print.o snd-trans.o snd-mix.o snd.o snd-env.o snd-xen.o snd-ladspa.o snd-kbd.o snd-sig.o snd-draw.o run.o
-
-X_O_FILES = snd-xutils.o snd-xhelp.o snd-xfind.o snd-xmenu.o snd-xdraw.o snd-xlistener.o snd-xchn.o snd-xsnd.o snd-xregion.o snd-xdrop.o snd-xmain.o snd-xmix.o snd-xrec.o snd-xenv.o snd-gxbitmaps.o snd-gxcolormaps.o snd-xfft.o snd-xprint.o snd-xfile.o snd-xprefs.o
+O_FILES = snd-io.o snd-utils.o snd-listener.o snd-completion.o snd-menu.o snd-axis.o snd-data.o snd-fft.o snd-marks.o snd-file.o snd-edits.o snd-chn.o snd-dac.o snd-region.o snd-select.o snd-find.o snd-snd.o snd-help.o snd-main.o snd-print.o snd-trans.o snd-mix.o snd.o snd-env.o snd-xen.o snd-ladspa.o snd-kbd.o snd-sig.o snd-draw.o
-XM_O_FILES = snd-xutils.o snd-xhelp.o snd-xfind.o snd-xmenu.o snd-xdraw.o snd-xlistener.o snd-xchn.o snd-xsnd.o snd-xregion.o snd-xdrop.o snd-xmain.o snd-xmix.o snd-xrec.o snd-xenv.o snd-gxbitmaps.o snd-gxcolormaps.o snd-xfft.o snd-xprint.o snd-xfile.o snd-xprefs.o xm.o
+MOTIF_O_FILES = snd-gxbitmaps.o snd-gxcolormaps.o snd-motif.o xm.o
-G_O_FILES = snd-gutils.o snd-ghelp.o snd-gfind.o snd-gmenu.o snd-gdraw.o snd-glistener.o snd-gchn.o snd-gsnd.o snd-gregion.o snd-gdrop.o snd-gmain.o snd-gmix.o snd-grec.o snd-genv.o snd-gxbitmaps.o snd-gxcolormaps.o snd-gfft.o snd-gprint.o snd-gfile.o snd-gprefs.o
-
-XG_O_FILES = snd-gutils.o snd-ghelp.o snd-gfind.o snd-gmenu.o snd-gdraw.o snd-glistener.o snd-gchn.o snd-gsnd.o snd-gregion.o snd-gdrop.o snd-gmain.o snd-gmix.o snd-grec.o snd-genv.o snd-gxbitmaps.o snd-gxcolormaps.o snd-gfft.o snd-gprint.o snd-gfile.o snd-gprefs.o xg.o
+GTK_O_FILES = snd-gutils.o snd-ghelp.o snd-gfind.o snd-gmenu.o snd-gdraw.o snd-glistener.o glistener.o snd-gchn.o snd-gsnd.o snd-gregion.o snd-gmain.o snd-gmix.o snd-genv.o snd-gxbitmaps.o snd-gxcolormaps.o snd-gfft.o snd-gfile.o snd-gprefs.o xg.o
NO_GUI_O_FILES = snd-nogui.o
GM_FILES = xm.o
@@ -95,46 +81,46 @@ NO_FILES =
main_target: @MAKE_TARGET@
-snd: $(SNDLIB_HEADERS) $(SND_HEADERS) $(GX_HEADERS) $(S7_HEADERS) $(S7_O_FILES) $(SNDLIB_FILES) $(O_FILES) $(GX_FILES) $(GL_FILES)
- $(CC) $(LDFLAGS) $(CFLAGS) $(S7_O_FILES) $(SNDLIB_FILES) $(O_FILES) $(GX_FILES) $(GL_FILES) -o snd $(SNDLIB_LIB) $(XEN_LIBS) $(GTK_LIBS) $(GL_LIBS) $(MOTIF_LIBS) $(JACK_LIBS) $(AUDIO_LIB) $(FFTW_LIBS) $(GSL_LIBS) $(FAM_LIB) $(GMP_LIBS) $(LIBS)
+snd: $(SNDLIB_HEADERS) $(SND_HEADERS) $(GX_HEADERS) $(S7_HEADERS) $(S7_O_FILES) $(SNDLIB_O_FILES) $(O_FILES) $(GX_FILES) $(GL_FILES)
+ $(CC) $(LDFLAGS) $(CFLAGS) $(S7_O_FILES) $(SNDLIB_O_FILES) $(O_FILES) $(GX_FILES) $(GL_FILES) -o snd $(SNDLIB_LIB) $(XEN_LIBS) $(GTK_LIBS) $(GL_LIBS) $(JACK_LIBS) $(AUDIO_LIB) $(FFTW_LIBS) $(GSL_LIBS) $(GMP_LIBS) $(LIBS)
xm: xen.h mus-config.h $(S7_HEADERS)
- $(CC) -c xm.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(MOTIF_FLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
- $(SO_LD) $(GM_FILES) -o $(GM_SO_FILE) $(SO_FLAGS) $(LDSO_FLAGS) $(ORIGINAL_LDFLAGS) $(GL_LIBS) $(MOTIF_LIBS) $(FAM_LIB) $(GMP_LIBS) $(LIBS)
+ $(CC) -c xm.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
+ $(SO_LD) $(GM_FILES) -o $(GM_SO_FILE) $(SO_FLAGS) $(LDSO_FLAGS) $(ORIGINAL_LDFLAGS) $(GL_LIBS) $(GMP_LIBS) $(LIBS)
xg: xen.h mus-config.h $(S7_HEADERS)
- $(CC) -c xg.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(MOTIF_FLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
- $(SO_LD) $(GG_FILES) -o $(GG_SO_FILE) $(LDSO_FLAGS) $(ORIGINAL_LDFLAGS) $(GTK_LD_LIBS) $(FAM_LIB) $(GMP_LIBS) $(LIBS)
+ $(CC) -c xg.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
+ $(SO_LD) $(GG_FILES) -o $(GG_SO_FILE) $(LDSO_FLAGS) $(ORIGINAL_LDFLAGS) $(GTK_LD_LIBS) $(GMP_LIBS) $(LIBS)
libxm: xen.h mus-config.h $(S7_HEADERS) $(S7_O_FILES)
rm -f xen.o
- $(CC) -c xen.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(MOTIF_FLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
- $(CC) -c xm.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(MOTIF_FLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_
- $(SO_LD) xen.o $(S7_O_FILES) $(GM_FILES) -o libxm.so $(SO_FLAGS) $(LDSO_FLAGS) $(ORIGINAL_LDFLAGS) $(GL_LIBS) $(MOTIF_LIBS) $(FAM_LIB) $(GMP_LIBS) $(XEN_LIBS) $(LIBS)
+ $(CC) -c xen.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
+ $(CC) -c xm.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
+ $(SO_LD) xen.o $(S7_O_FILES) $(GM_FILES) -o libxm.so $(SO_FLAGS) $(LDSO_FLAGS) $(ORIGINAL_LDFLAGS) $(GL_LIBS) $(GMP_LIBS) $(XEN_LIBS) $(LIBS)
libxg: xen.h mus-config.h $(S7_HEADERS) $(S7_O_FILES)
rm -f xen.o
- $(CC) -c xen.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(MOTIF_FLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
- $(CC) -c xg.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(MOTIF_FLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
- $(SO_LD) xen.o $(S7_O_FILES) $(GG_FILES) -o libxg.so $(LDSO_FLAGS) $(ORIGINAL_LDFLAGS) $(GTK_LD_LIBS) $(FAM_LIB) $(GMP_LIBS) $(XEN_LIBS) $(LIBS)
+ $(CC) -c xen.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
+ $(CC) -c xg.c -DUSE_SND=0 $(DEFS) $(SO_FLAGS) $(GTK_CFLAGS) $(CAIRO_CFLAGS) $(CFLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $(GL_FLAGS)
+ $(SO_LD) xen.o $(S7_O_FILES) $(GG_FILES) -o libxg.so $(LDSO_FLAGS) $(ORIGINAL_LDFLAGS) $(GTK_LD_LIBS) $(GMP_LIBS) $(XEN_LIBS) $(LIBS)
widget: snd_widget.o
-snd_widget.o: $(SNDLIB_HEADERS) $(SND_HEADERS) $(GX_HEADERS) $(S7_HEADERS) $(SNDLIB_FILES) $(O_FILES) $(GX_FILES) $(GL_FILES)
- $(LD) -r $(LDFLAGS) $(SNDLIB_FILES) $(O_FILES) $(GX_FILES) $(GL_FILES) -o snd_widget.o
+snd_widget.o: $(SNDLIB_HEADERS) $(SND_HEADERS) $(GX_HEADERS) $(S7_HEADERS) $(SNDLIB_O_FILES) $(O_FILES) $(GX_FILES) $(GL_FILES)
+ $(LD) -r $(LDFLAGS) $(SNDLIB_O_FILES) $(O_FILES) $(GX_FILES) $(GL_FILES) -o snd_widget.o
$(SNDLIB_O_FILES): $(SNDLIB_HEADERS) $(SND_HEADERS) $(S7_HEADERS)
$(O_FILES): $(SNDLIB_HEADERS) $(SND_HEADERS) $(SND_X_HEADERS) $(S7_HEADERS)
-$(X_O_FILES): $(SNDLIB_HEADERS) $(SND_HEADERS) $(SND_X_HEADERS) $(S7_HEADERS)
-$(G_O_FILES): $(SNDLIB_HEADERS) $(SND_HEADERS) $(SND_G_HEADERS) $(S7_HEADERS)
+$(MOTIF_O_FILES): $(SNDLIB_HEADERS) $(SND_HEADERS) $(SND_X_HEADERS) $(S7_HEADERS)
+$(GTK_O_FILES): $(SNDLIB_HEADERS) $(SND_HEADERS) $(SND_G_HEADERS) $(S7_HEADERS)
$(S7_O_FILES): $(S7_HEADERS) $(S7_FILES)
clean:
rm -f $(SNDLIB_O_FILES)
rm -f $(O_FILES)
- rm -f $(X_O_FILES)
- rm -f $(G_O_FILES)
+ rm -f $(MOTIF_O_FILES)
+ rm -f $(GTK_O_FILES)
rm -f $(NO_GUI_O_FILES)
rm -f $(GM_FILES)
rm -f $(GM_SO_FILE)
@@ -142,8 +128,8 @@ clean:
rm -f $(GG_SO_FILE)
rm -f $(GL_FILES)
rm -f $(S7_O_FILES)
- rm -f sndplay.o audinfo.o sndinfo.o
- rm -f snd sndplay audinfo sndinfo
+ rm -f sndplay.o sndinfo.o
+ rm -f snd sndplay sndinfo
distclean: clean
rm -f mus-config.h config.log config.status makefile
@@ -155,54 +141,46 @@ allclean:
rm -f *.o
rm -f *.so
rm -f *.a
- rm -f snd sndplay audinfo sndinfo
+ rm -f snd sndplay sndinfo
sndplay: $(SNDLIB_HEADERS) $(S7_HEADERS)
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 headers.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 io.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 audio.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 sound.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 sndplay.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 headers.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 io.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 audio.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 sound.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 sndplay.c
$(CC) $(LDFLAGS) $(CFLAGS) headers.o io.o audio.o sound.o sndplay.o -o sndplay $(JACK_LIBS) $(AUDIO_LIB) $(LIBS)
sndinfo: $(SNDLIB_HEADERS) $(S7_HEADERS)
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 headers.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 io.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 audio.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 sound.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 sndinfo.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 headers.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 io.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 audio.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 sound.c
+ $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 -DHAVE_EXTENSION_LANGUAGE=0 sndinfo.c
$(CC) $(LDFLAGS) $(CFLAGS) headers.o io.o audio.o sound.o sndinfo.o -o sndinfo $(JACK_LIBS) $(AUDIO_LIB) $(LIBS)
-audinfo: $(SNDLIB_HEADERS) $(S7_HEADERS)
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 headers.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 io.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 audio.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 sound.c
- $(CC) -c $(DEFS) $(CFLAGS) -DUSE_SND=0 audinfo.c
- $(CC) $(LDFLAGS) $(CFLAGS) headers.o io.o audio.o sound.o audinfo.o -o audinfo $(JACK_LIBS) $(AUDIO_LIB) $(LIBS)
-
install: snd
- ${SHELL} ${top_srcdir}/mkinstalldirs ${bindir}
- ${SHELL} ${top_srcdir}/mkinstalldirs ${mandir}
- ${SHELL} ${top_srcdir}/mkinstalldirs ${mandir}/man1
- ${SHELL} ${top_srcdir}/mkinstalldirs ${pkgdatadir}
- $(INSTALL) snd ${bindir}/snd
- $(INSTALL_DATA) ${top_srcdir}/snd.1 ${mandir}/man1
- (cd ${top_srcdir} && for f in ${SND_SCRIPTS}; do ${INSTALL_DATA} ${top_srcdir}/$${f} ${pkgdatadir}/$${f}; done)
+ ${SHELL} ${top_srcdir}/mkinstalldirs $(DESTDIR)${bindir}
+ ${SHELL} ${top_srcdir}/mkinstalldirs $(DESTDIR)${mandir}
+ ${SHELL} ${top_srcdir}/mkinstalldirs $(DESTDIR)${mandir}/man1
+ ${SHELL} ${top_srcdir}/mkinstalldirs $(DESTDIR)${pkgdatadir}
+ $(INSTALL) snd $(DESTDIR)${bindir}/snd
+ $(INSTALL_DATA) ${top_srcdir}/snd.1 $(DESTDIR)${mandir}/man1
+ (cd ${top_srcdir} && for f in ${SND_SCRIPTS}; do ${INSTALL_DATA} $${f} $(DESTDIR)${pkgdatadir}/$${f}; done)
uninstall:
- rm -f ${bindir}/snd
- rm -f ${mandir}/man1/snd.1
- for f in ${SND_SCRIPTS}; do rm -f ${pkgdatadir}/$${f}; done
+ rm -f $(DESTDIR)${bindir}/snd
+ rm -f $(DESTDIR)${mandir}/man1/snd.1
+ for f in ${SND_SCRIPTS}; do rm -f $(DESTDIR)${pkgdatadir}/$${f}; done
install-strip: snd
- ${SHELL} ${top_srcdir}/mkinstalldirs ${bindir}
- ${SHELL} ${top_srcdir}/mkinstalldirs ${mandir}
- ${SHELL} ${top_srcdir}/mkinstalldirs ${mandir}/man1
- ${SHELL} ${top_srcdir}/mkinstalldirs ${pkgdatadir}
- $(INSTALL) -s snd ${bindir}/snd
- $(INSTALL_DATA) ${top_srcdir}/snd.1 ${mandir}/man1
- (cd ${top_srcdir} && for f in ${SND_SCRIPTS}; do ${INSTALL_DATA} ${top_srcdir}/$${f} ${pkgdatadir}/$${f}; done)
+ ${SHELL} ${top_srcdir}/mkinstalldirs $(DESTDIR)${bindir}
+ ${SHELL} ${top_srcdir}/mkinstalldirs $(DESTDIR)${mandir}
+ ${SHELL} ${top_srcdir}/mkinstalldirs $(DESTDIR)${mandir}/man1
+ ${SHELL} ${top_srcdir}/mkinstalldirs $(DESTDIR)${pkgdatadir}
+ $(INSTALL) -s snd $(DESTDIR)${bindir}/snd
+ $(INSTALL_DATA) ${top_srcdir}/snd.1 $(DESTDIR)${mandir}/man1
+ (cd ${top_srcdir} && for f in ${SND_SCRIPTS}; do ${INSTALL_DATA} $${f} $(DESTDIR)${pkgdatadir}/$${f}; done)
Makefile: Makefile.in config.status
./config.status
diff --git a/maraca.scm b/maraca.scm
index ce1818a..fcc2c15 100644
--- a/maraca.scm
+++ b/maraca.scm
@@ -2,7 +2,9 @@
;;; translated from CLM's maraca.ins
(provide 'snd-maraca.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(define two-pi (* 2 pi))
@@ -12,55 +14,46 @@
(probability .0625)
(shell-freq 3200.0)
(shell-reso 0.96))
- (let* ((st (seconds->samples beg))
- (nd (+ st (seconds->samples dur)))
- (temp 0.0)
- (shake-energy 0.0)
- (snd-level 0.0)
- (input 0.0)
- (output (make-vct 2))
- (coeffs (make-vct 2))
- (num-beans 64)
- (j 0)
- (sndamp (/ amp 16384.0))
- (srate4 (floor (/ (mus-srate) 4)))
- (gain (/ (* (/ (log num-beans) (log 4.0)) 40) num-beans)))
- ;; gourd resonance filter
- (vct-set! coeffs 0 (* -2.0 shell-reso (cos (hz->radians shell-freq))))
- (vct-set! coeffs 1 (* shell-reso shell-reso))
+ (let ((num-beans 64))
+ (let ((st (seconds->samples beg))
+ (nd (seconds->samples (+ beg dur)))
+ (temp 0.0)
+ (shake-energy 0.0)
+ (snd-level 0.0)
+ (input 0.0)
+ (stop 0)
+ (h20 (hz->radians 20.0))
+ (sndamp (/ amp 16384.0))
+ (srate4 (floor (/ *clm-srate* 4)))
+ (gain (/ (* (log num-beans 4.0) 40) num-beans))
+ (tz (make-two-pole 1.0 (* -2.0 shell-reso (cos (hz->radians shell-freq))) (* shell-reso shell-reso)))
+ (oz (make-one-zero 1.0 -1.0))
+ ;; gourd resonance filter
+ )
+ (do ((i st (+ i srate4)))
+ ((>= i nd))
+ (set! temp 0.0)
+ (set! stop (min nd (+ i srate4)))
+ (do ((k i (+ k 1)))
+ ((= k stop))
+ (if (< temp two-pi)
+ (begin
+ ;; shake over 50msec and add shake energy
+ (set! temp (+ temp h20))
+ (set! shake-energy (+ shake-energy (- 1.0 (cos temp))))))
+ (set! shake-energy (* shake-energy system-decay))
+ ;; if collision, add energy
+ (if (< (random 1.0) probability)
+ (set! snd-level (+ snd-level (* gain shake-energy))))
+ ;; actual sound is random
+ (set! input (mus-random snd-level))
+ ;; compute exponential sound decay
+ (set! snd-level (* snd-level sound-decay))
+ ;; gourd resonance filter calc
+ (outa k (* sndamp (one-zero oz (two-pole tz input)))))))))
- (run
- (do ((i st (+ 1 i)))
- ((= i nd))
- (if (< temp two-pi)
- (begin
- ;; shake over 50msec and add shake energy
- (set! temp (+ temp (hz->radians 20)))
- (set! shake-energy (+ shake-energy (- 1.0 (cos temp))))))
- (if (= j srate4) ;shake 4 times/sec
- (begin
- (set! temp 0.0)
- (set! j 0)))
- (set! j (+ 1 j))
- (set! shake-energy (* shake-energy system-decay))
- ;; if collision, add energy
- (if (< (random 1.0) probability)
- (set! snd-level (+ snd-level (* gain shake-energy))))
- ;; actual sound is random
- (set! input (* snd-level (- (random 2.0) 1.0)))
- ;; compute exponential sound decay
- (set! snd-level (* snd-level sound-decay))
- ;; gourd resonance filter calc
- (set! input (- input
- (* (vct-ref output 0) (vct-ref coeffs 0))
- (* (vct-ref output 1) (vct-ref coeffs 1))))
- (vct-set! output 1 (vct-ref output 0))
- (vct-set! output 0 input)
- ;; extra zero for spectral shape, also fixup amp since Perry is assuming maxamp 16384
- (outa i (* sndamp (- (vct-ref output 0) (vct-ref output 1))))))))
-
-;;; maraca: (vct->channel (maraca 0 5 .5))
-;;; cabasa: (vct->channel (maraca 0 5 .5 0.95 0.997 0.5 3000.0 0.7))
+;;; maraca: (with-sound (:statistics #t :play #t) (maraca 0 5 .5))
+;;; cabasa: (with-sound (:statistics #t :play #t) (maraca 0 5 .5 0.95 0.997 0.5 3000.0 0.7))
(definstrument (big-maraca beg dur (amp .1)
(sound-decay 0.95)
@@ -70,84 +63,76 @@
(shell-resos '(0.96))
(randiff .01)
(with-filters #t))
- ;; like maraca, but takes a list of resonances and includes low-pass filter (or no filter)
- (let* ((st (seconds->samples beg))
- (nd (+ st (seconds->samples dur)))
- (temp 0.0)
- (temp1 0.0)
- (resn (length shell-freqs))
- (shake-energy 0.0)
- (snd-level 0.0)
- (input 0.0)
- (sum 0.0)
- (last-sum 0.0)
- (last-diff 0.0)
- (diff 0.0)
- (output (make-vct (* resn 2)))
- (coeffs (make-vct (* resn 2)))
- (basesf (make-vct resn))
- (num-beans 64)
- (j 0)
- (sndamp (/ amp (* 16384.0 resn)))
- (srate4 (floor (/ (mus-srate) 4)))
- (gain (/ (* (/ (log num-beans) (log 4)) 40) num-beans)))
- ;; gourd resonance filters
- (do ((i 0 (+ 1 i)))
- ((= i resn))
- (vct-set! coeffs (+ (* i 2) 0) (* -2.0 (list-ref shell-resos i) (cos (hz->radians (list-ref shell-freqs i)))))
- (vct-set! basesf i (vct-ref coeffs (+ (* i 2) 0)))
- (vct-set! coeffs (+ (* i 2) 1) (* (list-ref shell-resos i) (list-ref shell-resos i))))
+ ;; like maraca, but takes a list of resonances and includes low-pass filter (or no filter)
+ (let ((num-beans 64)
+ (resn (length shell-freqs)))
+ (let ((st (seconds->samples beg))
+ (nd (seconds->samples (+ beg dur)))
+ (temp 0.0)
+ (shake-energy 0.0)
+ (snd-level 0.0)
+ (input 0.0)
+ (sum 0.0)
+ (last-sum 0.0)
+ (tzs (make-vector resn))
+ (h20 (hz->radians 20.0))
+ (stop 0)
+ (sndamp (/ amp (* 16384.0 resn)))
+ (srate4 (floor (/ *clm-srate* 4)))
+ (gain (/ (* (log num-beans 4) 40) num-beans))
+ (oz (make-one-zero (/ amp (* resn 16384.0)) (/ amp (* resn 16384.0)))))
+
+ ;; we need to fixup Perry's frequency dithering amount since we're going through our mus-frequency method
+ (set! randiff (radians->hz randiff))
+
+ ;; gourd resonance filters
+ (do ((i 0 (+ i 1)))
+ ((= i resn))
+ (vector-set! tzs i (make-two-pole 1.0
+ (* -2.0 (shell-resos i) (cos (hz->radians (shell-freqs i))))
+ (* (shell-resos i) (shell-resos i)))))
+
+ (do ((i st (+ i srate4)))
+ ((>= i nd))
+ (set! temp 0.0)
+ (set! stop (min nd (+ i srate4)))
+ (do ((k i (+ k 1)))
+ ((= k stop))
+
+ (if (< temp two-pi)
+ (begin
+ ;; shake over 50msec and add shake energy
+ (set! temp (+ temp h20))
+ (set! shake-energy (+ shake-energy (- 1.0 (cos temp))))))
+
+ (set! shake-energy (* shake-energy system-decay))
+ ;; if collision, add energy
+ (if (< (random 1.0) probability)
+ (begin
+ (set! snd-level (+ snd-level (* gain shake-energy)))
+ ;; randomize res freqs a bit
+ (do ((j 0 (+ j 1)))
+ ((= j resn))
+ (set! (mus-frequency (vector-ref tzs j)) (+ (shell-freqs j) (mus-random randiff))))))
+
+ ;; actual sound is random
+ (set! input (mus-random snd-level))
+ ;; compute exponential sound decay
+ (set! snd-level (* snd-level sound-decay))
- (run
- (do ((i st (+ 1 i)))
- ((= i nd))
- (if (< temp two-pi)
- (begin
- ;; shake over 50msec and add shake energy
- (set! temp (+ temp (hz->radians 20.0)))
- (set! shake-energy (+ shake-energy (- 1.0 (cos temp))))))
- (if (= j srate4) ;shake 4 times/sec
- (begin
- (set! temp 0.0)
- (set! j 0)))
- (set! j (+ 1 j))
- (set! shake-energy (* shake-energy system-decay))
- ;; if collision, add energy
- (if (< (random 1.0) probability)
- (begin
- (set! snd-level (+ snd-level (* gain shake-energy)))
- ;; randomize res freqs a bit
- (do ((i 0 (+ 1 i)))
- ((= i resn))
- (vct-set! coeffs (+ (* i 2) 0) (+ (vct-ref basesf i) (- (random (* 2.0 randiff)) randiff))))))
- ;; actual sound is random
- (set! input (* snd-level (- (random 2.0) 1.0)))
- ;; compute exponential sound decay
- (set! snd-level (* snd-level sound-decay))
- ;; gourd resonance filter calcs
- (set! temp1 input)
- (set! last-sum sum)
- (set! sum 0.0)
- (do ((i 0 (+ 1 i)))
- ((= i resn))
- (set! input temp1)
- (set! input (- input
- (* (vct-ref output (+ (* i 2) 0)) (vct-ref coeffs (+ (* i 2) 0)))
- (* (vct-ref output (+ (* i 2) 1)) (vct-ref coeffs (+ (* i 2) 1)))))
- (vct-set! output (+ (* i 2) 1) (vct-ref output (+ (* i 2) 0)))
- (vct-set! output (+ (* i 2) 0) input)
- (set! sum (+ sum input)))
- (if with-filters
- (begin
- (set! last-diff diff)
- (set! diff (- sum last-sum))
- (set! temp1 (+ last-diff diff)))
- (set! temp1 sum))
- ;; extra zero for spectral shape, also fixup amp since Perry is assuming maxamp 16384
- (outa i (* sndamp temp1))))))
+ ;; gourd resonance filter calcs
+ (set! last-sum sum)
+ (set! sum 0.0)
+ (do ((j 0 (+ j 1)))
+ ((= j resn))
+ (set! sum (+ sum (two-pole (vector-ref tzs j) input))))
-;;; tambourine: (big-maraca 0 1 .25 0.95 0.9985 .03125 '(2300 5600 8100) '(0.96 0.995 0.995) .01)
-;;; sleighbells: (big-maraca 0 2 .5 0.97 0.9994 0.03125 '(2500 5300 6500 8300 9800) '(0.999 0.999 0.999 0.999 0.999))
-;;; sekere: (big-maraca 0 2 .5 0.96 0.999 .0625 '(5500) '(0.6))
-;;; windchimes: (big-maraca 0 2 .5 0.99995 0.95 .001 '(2200 2800 3400) '(0.995 0.995 0.995) .01 #f)
+ (if with-filters
+ (outa k (one-zero oz (- sum last-sum)))
+ (outa k (* sndamp sum))))))))
+
+;;; tambourine: (with-sound (:play #t :statistics #t) (big-maraca 0 1 .25 0.95 0.9985 .03125 '(2300 5600 8100) '(0.96 0.995 0.995) .01))
+;;; sleighbells: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .15 0.97 0.9994 0.03125 '(2500 5300 6500 8300 9800) '(0.999 0.999 0.999 0.999 0.999)))
+;;; sekere: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .5 0.96 0.999 .0625 '(5500) '(0.6)))
+;;; windchimes: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .5 0.99995 0.95 .001 '(2200 2800 3400) '(0.995 0.995 0.995) .01 #f))
diff --git a/marks-menu.scm b/marks-menu.scm
index 16f7698..fb2f4b3 100644
--- a/marks-menu.scm
+++ b/marks-menu.scm
@@ -2,35 +2,44 @@
(if (provided? 'xm)
(begin
- (if (not (provided? 'snd-effects-utils.scm))
- (load "effects-utils.scm"))
+ (require snd-effects-utils.scm)
(if (not (defined? 'mark-sync-color))
(load "snd-motif.scm"))))
+(when (provided? 'snd-motif)
+ (define mark-sync-color (*motif* 'mark-sync-color)))
+
(if (provided? 'xg)
(begin
- (if (not (provided? 'snd-gtk-effects-utils.scm))
- (load "gtk-effects-utils.scm"))
+ (require snd-gtk-effects-utils.scm)
(if (not (defined? 'mark-sync-color))
- (load "snd-gtk.scm"))))
+ (define (mark-sync-color x) x))))
(if (not (defined? 'mark-loops)) (load "examp.scm"))
(if (not (defined? 'play-between-marks)) (load "marks.scm"))
(if (not (defined? 'loop-between-marks)) (load "play.scm"))
+(define *e* (if (provided? 'snd-motif) *motif* *gtk*))
+(define update-label (*e* 'update-label))
+(define change-label (*e* 'change-label))
+(define make-effect-dialog (*e* 'make-effect-dialog))
+(define add-sliders (*e* 'add-sliders))
+(define activate-dialog (*e* 'activate-dialog))
+(define select-file (*e* 'select-file))
-(define marks-list '()) ; menu labels are updated to show current default settings
+(define marks-list ()) ; menu labels are updated to show current default settings
(define marks-menu (add-to-main-menu "Marks" (lambda ()
(update-label marks-list))))
-(define (find-two-marks)
- "(find-two-marks) looks for the marks for the marks-menu functions to use"
- (let* ((snd (selected-sound))
- (chn (selected-channel))
- (ms (marks snd chn)))
- (if (> (length ms) 1)
- (map mark->integer (list (car ms) (cadr ms)))
- (list))))
+(define find-two-marks
+ (let ((documentation "(find-two-marks) looks for the marks for the marks-menu functions to use"))
+ (lambda ()
+ (let* ((snd (selected-sound))
+ (chn (selected-channel))
+ (ms (marks snd chn)))
+ (if (> (length ms) 1)
+ (map mark->integer (list (car ms) (cadr ms)))
+ (list))))))
;;; -------- Play between by marks
@@ -41,14 +50,15 @@
(define play-between-marks-dialog #f)
(define play-between-marks-menu-label #f)
-(define (cp-play-between-marks)
- "(cp-play-between-marks) plays between 2 marks (marks-menu)"
- (play-between-marks (integer->mark play-between-marks-m1) (integer->mark play-between-marks-m2)))
+(define cp-play-between-marks
+ (let ((documentation "(cp-play-between-marks) plays between 2 marks (marks-menu)"))
+ (lambda ()
+ (play-between-marks (integer->mark play-between-marks-m1) (integer->mark play-between-marks-m2)))))
(if (or (provided? 'xm)
(provided? 'xg))
(begin
-
+
(define (set-syncs)
(for-each
(lambda (snd-marks)
@@ -64,22 +74,22 @@
snd-marks))
(marks))
(update-time-graph))
-
+
(define (max-mark) ; "id" here
(apply max (map mark->integer (marks (selected-sound) (selected-channel)))))
-
+
(define (min-mark)
(apply min (map mark->integer (marks (selected-sound) (selected-channel)))))
-
+
(define (post-play-between-marks-dialog)
(if (not play-between-marks-dialog)
- (let* ((inits (find-two-marks))
- (max-mark-id (max-mark))
- (sliders '()))
-
+ (let ((inits (find-two-marks))
+ (max-mark-id (max-mark))
+ (sliders ()))
+
(if (null? inits)
(snd-display ";no marks")
-
+
(begin
(set! play-between-marks-m1 (car inits))
(set! play-between-marks-m2 (cadr inits))
@@ -89,11 +99,11 @@
(set! play-between-marks-dialog
(make-effect-dialog
play-between-marks-label
-
+
(if (provided? 'snd-gtk)
(lambda (w context) (cp-play-between-marks))
(lambda (w context info) (cp-play-between-marks)))
-
+
(if (provided? 'snd-gtk)
(lambda (w context)
(help-dialog "Define selection by marks Help"
@@ -101,43 +111,41 @@
(lambda (w context info)
(help-dialog "Define selection by marks Help"
"Plays area between specified marks. Use the sliders to select the boundary marks.")))
-
+
(if (provided? 'snd-gtk)
(lambda (w data)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) play-between-marks-m1)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) play-between-marks-m2)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (cadr sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (car sliders)) play-between-marks-m1)
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (cadr sliders)) play-between-marks-m2)
)
(lambda (w c i)
- (XtSetValues (list-ref sliders 0) (list XmNvalue play-between-marks-m1))
- (XtSetValues (list-ref sliders 1) (list XmNvalue play-between-marks-m2))))))
-
+ ((*motif* 'XtSetValues) (sliders 0) (list (*motif* 'XmNvalue) play-between-marks-m1))
+ ((*motif* 'XtSetValues) (sliders 1) (list (*motif* 'XmNvalue) play-between-marks-m2))))))
+
(set! sliders
(add-sliders
play-between-marks-dialog
(list (list "mark one" 0 play-between-marks-m1 max-mark-id
(if (provided? 'snd-gtk)
(lambda (w context)
- (set! play-between-marks-m1 (gtk_adjustment_get_value (GTK_ADJUSTMENT w)))
+ (set! play-between-marks-m1 ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w)))
(set-syncs))
(lambda (w context info)
- (set! play-between-marks-m1 (gtk_adjustment_get_value info))
+ (set! play-between-marks-m1 ((*motif* '.value) info))
(set-syncs)))
1)
(list "mark two" 0 play-between-marks-m2 max-mark-id
- (if (provided? 'snd-gtk)
- (lambda (w context)
- (set! play-between-marks-m2 (gtk_adjustment_get_value (GTK_ADJUSTMENT w)))
- (set-syncs))
- (lambda (w context info)
- (set! play-between-marks-m2 (.value info))
- (set-syncs)))
- 1))))
-
+ (if (provided? 'snd-gtk)
+ (lambda (w context)
+ (set! play-between-marks-m2 ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w)))
+ (set-syncs))
+ (lambda (w context info)
+ (set! play-between-marks-m2 ((*motif* '.value) info))
+ (set-syncs)))
+ 1))))
+
(if (provided? 'snd-motif)
- (begin
- (hook-push select-channel-hook (lambda (snd chn)
+ (with-let (sublet *motif*)
+ (hook-push select-channel-hook (lambda (hook)
(let ((max-ms (max-mark))
(min-ms (min-mark))
(current-ms (find-two-marks)))
@@ -152,47 +160,47 @@
XmNvalue (car current-ms)))
(set! current-ms (cdr current-ms)))
sliders)))))
- (hook-push mark-hook (lambda (id snd chn reason)
- (if (and (= snd (selected-sound))
- (= chn (selected-channel))
- (= reason 0)) ; add-mark
+ (hook-push mark-hook (lambda (hook)
+ (if (and (= (hook 'snd) (selected-sound))
+ (= (hook 'chn) (selected-channel))
+ (= (hook 'reason) 0)) ; add-mark
(for-each
(lambda (slider)
(XtVaSetValues slider (list XmNmaximum (max-mark))))
sliders))))))))
(if play-between-marks-dialog
(activate-dialog play-between-marks-dialog)))))
-
- (set! play-between-marks-menu-label (add-to-menu marks-menu "Play between marks" (lambda () (post-play-between-marks-dialog)))))
-
+
+ (set! play-between-marks-menu-label (add-to-menu marks-menu "Play between marks" post-play-between-marks-dialog)))
+
(set! play-between-marks-menu-label (add-to-menu marks-menu play-between-marks-label cp-play-between-marks)))
(set! marks-list (cons (lambda ()
- (let ((new-label (format #f "Play between marks (~D ~D)" play-between-marks-m1 play-between-marks-m2)))
- (if play-between-marks-menu-label (change-label play-between-marks-menu-label new-label))
- (set! play-between-marks-label new-label)))
- marks-list))
+ (let ((new-label (format #f "Play between marks (~D ~D)" play-between-marks-m1 play-between-marks-m2)))
+ (if play-between-marks-menu-label (change-label play-between-marks-menu-label new-label))
+ (set! play-between-marks-label new-label)))
+ marks-list))
;;; -------- Loop play between marks
-(define loop-between-marks-m1 0)
-(define loop-between-marks-m2 1)
-(define loop-between-marks-buffer-size 512)
-(define loop-between-marks-label "Loop play between marks")
-(define loop-between-marks-dialog #f)
-(define loop-between-marks-default-buffer-widget #f)
-(define loop-between-marks-menu-label #f)
-
-(define use-combo-box-for-buffer-size #f) ; radio-buttons or combo-box choice
-
-(define (cp-loop-between-marks)
- "(cp-loop-between-marks) loops between two marks, playing (marks-menu)"
- (loop-between-marks (integer->mark loop-between-marks-m1) (integer->mark loop-between-marks-m2) loop-between-marks-buffer-size))
-
(if (provided? 'xm)
- (begin
-
+ (with-let (sublet *motif*)
+
+ (define loop-between-marks-m1 0)
+ (define loop-between-marks-m2 1)
+ (define loop-between-marks-buffer-size 512)
+ (define loop-between-marks-label "Loop play between marks")
+ (define loop-between-marks-dialog #f)
+ (define loop-between-marks-default-buffer-widget #f)
+ (define loop-between-marks-menu-label #f)
+
+ (define use-combo-box-for-buffer-size #f) ; radio-buttons or combo-box choice
+
+ (define (cp-loop-between-marks)
+ ;; cp-loop-between-marks) loops between two marks, playing (marks-menu)
+ (loop-between-marks (integer->mark loop-between-marks-m1) (integer->mark loop-between-marks-m2) loop-between-marks-buffer-size))
+
(define (overall-max-mark-id default-max)
(let ((maxid default-max))
(for-each
@@ -206,128 +214,127 @@
snd-marks))
(marks))
maxid))
-
+
(define (post-loop-between-marks-dialog)
(if (not loop-between-marks-dialog)
;; if loop-between-marks-dialog doesn't exist, create it
(let ((initial-loop-between-marks-m1 0)
(initial-loop-between-marks-m2 1)
- (initial-loop-between-marks-buffer-size 512)
- (sliders '())
+ (sliders ())
(max-mark-id (overall-max-mark-id 25)))
(set! loop-between-marks-dialog
(make-effect-dialog
loop-between-marks-label
- (lambda (w context info)
- (cp-loop-between-marks))
- (lambda (w context info)
- (help-dialog "Loop play between marks"
- "Move the sliders to set the mark numbers. Check a radio button to set the buffer size."))
- (lambda (w c i)
- (stop-playing))))
+ (lambda (w context info)
+ (cp-loop-between-marks))
+ (lambda (w context info)
+ (help-dialog "Loop play between marks"
+ "Move the sliders to set the mark numbers. Check a radio button to set the buffer size."))
+ (lambda (w c i)
+ (stop-playing))))
(set! sliders
(add-sliders
loop-between-marks-dialog
- (list (list "mark one" 0 initial-loop-between-marks-m1 max-mark-id
- (lambda (w context info)
- (set! loop-between-marks-m1 (/ (.value info) 1)))
- 1)
- (list "mark two" 0 initial-loop-between-marks-m2 max-mark-id
- (lambda (w context info)
- (set! loop-between-marks-m2 (/ (.value info) 1)))
- 1))))
-
+ (list (list "mark one" 0 initial-loop-between-marks-m1 max-mark-id
+ (lambda (w context info)
+ (set! loop-between-marks-m1 (.value info)))
+ 1)
+ (list "mark two" 0 initial-loop-between-marks-m2 max-mark-id
+ (lambda (w context info)
+ (set! loop-between-marks-m2 (.value info)))
+ 1))))
+
;; now add either a radio-button box or a combo-box for the buffer size
;; need to use XtParent here since "mainform" isn't returned by add-sliders
-
+
(if use-combo-box-for-buffer-size
;; this block creates a "combo box" to handle the buffer size
(let* ((s1 (XmStringCreateLocalized "Buffer size"))
(frame (XtCreateManagedWidget "frame" xmFrameWidgetClass (XtParent (car sliders))
- (list XmNborderWidth 1
- XmNshadowType XmSHADOW_ETCHED_IN
- XmNpositionIndex 2)))
+ (list XmNborderWidth 1
+ XmNshadowType XmSHADOW_ETCHED_IN
+ XmNpositionIndex 2)))
(frm (XtCreateManagedWidget "frm" xmFormWidgetClass frame
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color))))
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNbackground *basic-color*)))
(lab (XtCreateManagedWidget "Buffer size" xmLabelWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNlabelString s1
- XmNbackground (basic-color))))
- (buffer-labels (map (lambda (n) (XmStringCreateLocalized n)) (list "64" "128" "256" "512" "1024" "2048" "4096")))
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNlabelString s1
+ XmNbackground *basic-color*)))
+ (buffer-labels (map XmStringCreateLocalized (list "64" "128" "256" "512" "1024" "2048" "4096")))
(combo (XtCreateManagedWidget "buffersize" xmComboBoxWidgetClass frm
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget lab
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNitems buffer-labels
- XmNitemCount (length buffer-labels)
- XmNcomboBoxType XmDROP_DOWN_COMBO_BOX
- XmNbackground (basic-color)))))
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget lab
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNitems buffer-labels
+ XmNitemCount (length buffer-labels)
+ XmNcomboBoxType XmDROP_DOWN_COMBO_BOX
+ XmNbackground *basic-color*))))
(set! loop-between-marks-default-buffer-widget combo)
- (for-each (lambda (n) (XmStringFree n)) buffer-labels)
+ (for-each XmStringFree buffer-labels)
(XmStringFree s1)
(XtSetValues combo (list XmNselectedPosition 1))
(XtAddCallback combo XmNselectionCallback
- (lambda (w c i)
- (let* ((selected (.item_or_text i))
- (size-as-string (XmStringUnparse selected #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
- (set! loop-between-marks-buffer-size (string->number size-as-string))))))
-
+ (lambda (w c i)
+ (let* ((selected (.item_or_text i))
+ (size-as-string (XmStringUnparse selected #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
+ (set! loop-between-marks-buffer-size (string->number size-as-string))))))
+
;; this block creates a "radio button box"
(let* ((s1 (XmStringCreateLocalized "Buffer size"))
(frame (XtCreateManagedWidget "frame" xmFrameWidgetClass (XtParent (car sliders))
- (list XmNborderWidth 1
- XmNshadowType XmSHADOW_ETCHED_IN
- XmNpositionIndex 2)))
+ (list XmNborderWidth 1
+ XmNshadowType XmSHADOW_ETCHED_IN
+ XmNpositionIndex 2)))
(frm (XtCreateManagedWidget "frm" xmFormWidgetClass frame
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color))))
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNbackground *basic-color*)))
(rc (XtCreateManagedWidget "rc" xmRowColumnWidgetClass frm
- (list XmNorientation XmHORIZONTAL
- XmNradioBehavior #t
- XmNradioAlwaysOne #t
- XmNentryClass xmToggleButtonWidgetClass
- XmNisHomogeneous #t
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNbackground (basic-color))))
- (lab (XtCreateManagedWidget "Buffer size" xmLabelWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget rc
- XmNbottomAttachment XmATTACH_FORM
- XmNlabelString s1
- XmNalignment XmALIGNMENT_BEGINNING
- XmNbackground (basic-color)))))
+ (list XmNorientation XmHORIZONTAL
+ XmNradioBehavior #t
+ XmNradioAlwaysOne #t
+ XmNentryClass xmToggleButtonWidgetClass
+ XmNisHomogeneous #t
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNbackground *basic-color*))))
+ (XtCreateManagedWidget "Buffer size" xmLabelWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget rc
+ XmNbottomAttachment XmATTACH_FORM
+ XmNlabelString s1
+ XmNalignment XmALIGNMENT_BEGINNING
+ XmNbackground *basic-color*))
(for-each
-
- (lambda (size)
+
+ (lambda (size)
(let ((button (XtCreateManagedWidget (format #f "~D" size) xmToggleButtonWidgetClass rc
- (list XmNbackground (basic-color)
- XmNvalueChangedCallback (list (lambda (w c i) (if (.set i) (set! loop-between-marks-buffer-size c))) size)
- XmNset (= size loop-between-marks-buffer-size)))))
+ (list XmNbackground *basic-color*
+ XmNvalueChangedCallback (list (lambda (w c i) (if (.set i) (set! loop-between-marks-buffer-size c))) size)
+ XmNset (= size loop-between-marks-buffer-size)))))
(if (= size loop-between-marks-buffer-size)
(set! loop-between-marks-default-buffer-widget button))))
(list 64 128 256 512 1024 2048 4096))
(XmStringFree s1)))))
(activate-dialog loop-between-marks-dialog))
-
- (set! loop-between-marks-menu-label (add-to-menu marks-menu "Loop play between marks" (lambda () (post-loop-between-marks-dialog))))
-
+
+ (set! loop-between-marks-menu-label (add-to-menu marks-menu "Loop play between marks" post-loop-between-marks-dialog))
+
(set! marks-list (cons (lambda ()
(let ((new-label (format #f "Loop play between marks (~D ~D ~D)"
loop-between-marks-m1 loop-between-marks-m2 loop-between-marks-buffer-size)))
@@ -340,63 +347,66 @@
;;; -------- trim from and back (goes by first or last mark)
-(define (trim-front)
- "trim-front finds the first mark in each of the syncd channels and removes all samples before it"
- (let ((snc (sync)))
- (define (trim-front-one-channel snd chn)
- (if (< (length (marks snd chn)) 1)
- (report-in-minibuffer "trim-front needs a mark" snd)
- (delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (trim-front-one-channel snd chn)))
- (all-chans))
- (trim-front-one-channel (selected-sound) (selected-channel)))))
+(define trim-front
+ (let ((documentation "trim-front finds the first mark in each of the syncd channels and removes all samples before it"))
+ (lambda ()
+ (let ((snc (sync)))
+ (define (trim-front-one-channel snd chn)
+ (if (< (length (marks snd chn)) 1)
+ (status-report "trim-front needs a mark" snd)
+ (delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)))
+ (if (> snc 0)
+ (apply map
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (trim-front-one-channel snd chn)))
+ (all-chans))
+ (trim-front-one-channel (selected-sound) (selected-channel)))))))
(add-to-menu marks-menu "Trim before mark" trim-front)
-(define (trim-back)
- "trim-back finds the last mark in each of the syncd channels and removes all samples after it"
- (let ((snc (sync)))
- (define (trim-back-one-channel snd chn)
- (if (< (length (marks snd chn)) 1)
- (report-in-minibuffer "trim-back needs a mark" snd)
- (let ((endpt (mark-sample (car (reverse (marks snd chn))))))
- (delete-samples (+ endpt 1) (- (frames snd chn) endpt)))))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (trim-back-one-channel snd chn)))
- (all-chans))
- (trim-back-one-channel (selected-sound) (selected-channel)))))
+(define trim-back
+ (let ((documentation "trim-back finds the last mark in each of the syncd channels and removes all samples after it"))
+ (lambda ()
+ (let ((snc (sync)))
+ (define (trim-back-one-channel snd chn)
+ (if (< (length (marks snd chn)) 1)
+ (status-report "trim-back needs a mark" snd)
+ (let ((endpt (mark-sample (car (reverse (marks snd chn))))))
+ (delete-samples (+ endpt 1) (- (framples snd chn) endpt)))))
+ (if (> snc 0)
+ (apply map
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (trim-back-one-channel snd chn)))
+ (all-chans))
+ (trim-back-one-channel (selected-sound) (selected-channel)))))))
(add-to-menu marks-menu "Trim behind mark" trim-back)
;;; -------- crop (trims front and back)
-(define (crop)
- "crop finds the first and last marks in each of the syncd channels and removes all samples outside them"
- (let ((snc (sync)))
- (define (crop-one-channel snd chn)
- (if (< (length (marks snd chn)) 2)
- (report-in-minibuffer "crop needs start and end marks" snd)
- (as-one-edit
- (lambda ()
- (delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)
- (let ((endpt (mark-sample (car (reverse (marks snd chn))))))
- (delete-samples (+ endpt 1) (- (frames snd chn) endpt))))
- "crop")))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (crop-one-channel snd chn)))
- (all-chans))
- (crop-one-channel (selected-sound) (selected-channel)))))
+(define crop
+ (let ((documentation "crop finds the first and last marks in each of the syncd channels and removes all samples outside them"))
+ (lambda ()
+ (let ((snc (sync)))
+ (define (crop-one-channel snd chn)
+ (if (< (length (marks snd chn)) 2)
+ (status-report "crop needs start and end marks" snd)
+ (as-one-edit
+ (lambda ()
+ (delete-samples 0 (mark-sample (car (marks snd chn))) snd chn)
+ (let ((endpt (mark-sample (car (reverse (marks snd chn))))))
+ (delete-samples (+ endpt 1) (- (framples snd chn) endpt))))
+ "crop")))
+ (if (> snc 0)
+ (apply map
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (crop-one-channel snd chn)))
+ (all-chans))
+ (crop-one-channel (selected-sound) (selected-channel)))))))
(add-to-menu marks-menu "Crop around marks" crop)
@@ -411,30 +421,31 @@
(define fit-to-mark-dialog #f)
(define fit-to-mark-menu-label #f)
-(define (cp-fit-to-marks)
- "(cp-fit-to-marks) fits the selection between two marks (marks-menu)"
- (if (selection?)
- (fit-selection-between-marks (integer->mark fit-to-mark-one) (integer->mark fit-to-mark-two))
- (define-selection-via-marks (integer->mark fit-to-mark-one) (integer->mark fit-to-mark-two))))
+(define cp-fit-to-marks
+ (let ((documentation "(cp-fit-to-marks) fits the selection between two marks (marks-menu)"))
+ (lambda ()
+ (if (selection?)
+ (fit-selection-between-marks (integer->mark fit-to-mark-one) (integer->mark fit-to-mark-two))
+ (define-selection-via-marks (integer->mark fit-to-mark-one) (integer->mark fit-to-mark-two))))))
(if (or (provided? 'xm)
(provided? 'xg))
(begin
-
+
(define (post-fit-to-mark-dialog)
(if (not fit-to-mark-dialog)
(let ((initial-fit-to-mark-one 0)
(initial-fit-to-mark-two 1)
- (sliders '()))
-
+ (sliders ()))
+
(set! fit-to-mark-dialog
(make-effect-dialog
fit-to-mark-label
-
+
(if (provided? 'snd-gtk)
(lambda (w context) (cp-fit-to-marks))
(lambda (w context info) (cp-fit-to-marks)))
-
+
(if (provided? 'snd-gtk)
(lambda (w context)
(help-dialog "Fit selection to marks Help"
@@ -444,46 +455,44 @@ using the granulate generator to fix up the selection duration (this still is no
(help-dialog "Fit selection to marks Help"
"Fit-selection-between-marks tries to squeeze the current selection between two marks,\
using the granulate generator to fix up the selection duration (this still is not perfect). Move the sliders to set the mark numbers.")))
-
+
(if (provided? 'snd-gtk)
(lambda (w data)
(set! fit-to-mark-one initial-fit-to-mark-one)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) fit-to-mark-one)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (car sliders)) fit-to-mark-one)
(set! fit-to-mark-two initial-fit-to-mark-two)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) fit-to-mark-two)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (cadr sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (cadr sliders)) fit-to-mark-two)
)
(lambda (w c i)
(set! fit-to-mark-one initial-fit-to-mark-one)
- (XtSetValues (list-ref sliders 0) (list XmNvalue fit-to-mark-one))
+ ((*motif* 'XtSetValues) (sliders 0) (list (*motif* 'XmNvalue) fit-to-mark-one))
(set! fit-to-mark-two initial-fit-to-mark-two)
- (XtSetValues (list-ref sliders 1) (list XmNvalue fit-to-mark-two))))))
-
+ ((*motif* 'XtSetValues) (sliders 1) (list (*motif* 'XmNvalue) fit-to-mark-two))))))
+
(set! sliders
(add-sliders
fit-to-mark-dialog
(list (list "mark one" 0 initial-fit-to-mark-one 20
(if (provided? 'snd-gtk)
- (lambda (w context) (set! fit-to-mark-one (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- (lambda (w context info) (set! fit-to-mark-one (.value info))))
+ (lambda (w context) (set! fit-to-mark-one ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
+ (lambda (w context info) (set! fit-to-mark-one ((*motif* '.value) info))))
1)
(list "mark two" 0 initial-fit-to-mark-two 20
(if (provided? 'snd-gtk)
- (lambda (w context) (set! fit-to-mark-two (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
+ (lambda (w context) (set! fit-to-mark-two ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
(lambda (w context info) (set! fit-to-mark-two (.value info))))
1))))))
(activate-dialog fit-to-mark-dialog))
-
- (set! fit-to-mark-menu-label (add-to-menu marks-menu "Fit selection to marks" (lambda () (post-fit-to-mark-dialog)))))
-
+
+ (set! fit-to-mark-menu-label (add-to-menu marks-menu "Fit selection to marks" post-fit-to-mark-dialog)))
+
(set! fit-to-mark-menu-label (add-to-menu marks-menu fit-to-mark-label cp-fit-to-marks)))
(set! marks-list (cons (lambda ()
- (let ((new-label (format #f "Fit selection to marks (~D ~D)" fit-to-mark-one fit-to-mark-two)))
- (if fit-to-mark-menu-label (change-label fit-to-mark-menu-label new-label))
- (set! fit-to-mark-label new-label)))
- marks-list))
+ (let ((new-label (format #f "Fit selection to marks (~D ~D)" fit-to-mark-one fit-to-mark-two)))
+ (if fit-to-mark-menu-label (change-label fit-to-mark-menu-label new-label))
+ (set! fit-to-mark-label new-label)))
+ marks-list))
;;; -------- Define selection by marks
@@ -494,40 +503,41 @@ using the granulate generator to fix up the selection duration (this still is no
(define define-by-mark-dialog #f)
(define define-by-mark-menu-label #f)
-(define (define-selection-via-marks m1 m2)
- "(define-selection-via-marks m1 m2) defines the selection via marks (marks-menu)"
- (let ((m1sc (mark-home m1))
- (m2sc (mark-home m2)))
- (if (not (equal? m1sc m2sc))
- (snd-error "define-selection-via-marks assumes the marks are in the same channel")
- (let ((beg (min (mark-sample m1) (mark-sample m2)))
- (end (max (mark-sample m1) (mark-sample m2)))
- (snd (car m1sc))
- (chn (cadr m1sc)))
- (set! (selection-member? snd chn) #t)
- (set! (selection-position snd chn) beg)
- (set! (selection-frames snd chn) (+ 1 (- end beg)))))))
+(define define-selection-via-marks
+ (let ((documentation "(define-selection-via-marks m1 m2) defines the selection via marks (marks-menu)"))
+ (lambda (m1 m2)
+ (let ((m1sc (mark-home m1))
+ (m2sc (mark-home m2)))
+ (if (not (equal? m1sc m2sc))
+ (snd-error "define-selection-via-marks assumes the marks are in the same channel")
+ (let ((beg (min (mark-sample m1) (mark-sample m2)))
+ (end (max (mark-sample m1) (mark-sample m2)))
+ (snd (car m1sc))
+ (chn (cadr m1sc)))
+ (set! (selection-member? snd chn) #t)
+ (set! (selection-position snd chn) beg)
+ (set! (selection-framples snd chn) (+ 1 (- end beg)))))))))
(define (cp-define-by-marks)
- (define-selection-via-marks (integer->mark define-by-mark-one) (integer->mark define-by-mark-two)))
+ (define-selection-via-marks (integer->mark define-by-mark-one) (integer->mark define-by-mark-two)))
(if (or (provided? 'xm) (provided? 'xg))
(begin
-
+
(define (post-define-by-mark-dialog)
(if (not define-by-mark-dialog)
(let ((initial-define-by-mark-one 0)
(initial-define-by-mark-two 1)
- (sliders '()))
-
+ (sliders ()))
+
(set! define-by-mark-dialog
(make-effect-dialog
define-by-mark-label
-
+
(if (provided? 'snd-gtk)
(lambda (w context) (cp-define-by-marks))
(lambda (w context info) (cp-define-by-marks)))
-
+
(if (provided? 'snd-gtk)
(lambda (w context)
(help-dialog "Define selection by marks Help"
@@ -535,46 +545,44 @@ using the granulate generator to fix up the selection duration (this still is no
(lambda (w context info)
(help-dialog "Define selection by marks Help"
"Selects and highlights area between marks. Use the sliders to choose the boundary marks.")))
-
+
(if (provided? 'snd-gtk)
(lambda (w data)
(set! define-by-mark-one initial-define-by-mark-one)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) define-by-mark-one)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (car sliders)) define-by-mark-one)
(set! define-by-mark-two initial-define-by-mark-two)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (cadr sliders)) define-by-mark-two)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (cadr sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (cadr sliders)) define-by-mark-two)
)
(lambda (w c i)
(set! define-by-mark-one initial-define-by-mark-one)
- (XtSetValues (list-ref sliders 0) (list XmNvalue define-by-mark-one))
+ ((*motif* 'XtSetValues) (sliders 0) (list (*motif* 'XmNvalue) define-by-mark-one))
(set! define-by-mark-two initial-define-by-mark-two)
- (XtSetValues (list-ref sliders 1) (list XmNvalue define-by-mark-two))))))
-
+ ((*motif* 'XtSetValues) (sliders 1) (list (*motif* 'XmNvalue) define-by-mark-two))))))
+
(set! sliders
(add-sliders
define-by-mark-dialog
(list (list "mark one" 0 initial-define-by-mark-one 25
(if (provided? 'snd-gtk)
- (lambda (w context) (set! define-by-mark-one (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- (lambda (w context info) (set! define-by-mark-one (.value info))))
+ (lambda (w context) (set! define-by-mark-one ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
+ (lambda (w context info) (set! define-by-mark-one ((*motif* '.value) info))))
1)
(list "mark two" 0 initial-define-by-mark-two 25
(if (provided? 'snd-gtk)
- (lambda (w context) (set! define-by-mark-two (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
- (lambda (w context info) (set! define-by-mark-two (.value info))))
+ (lambda (w context) (set! define-by-mark-two ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
+ (lambda (w context info) (set! define-by-mark-two ((*motif* '.value) info))))
1))))))
(activate-dialog define-by-mark-dialog))
-
- (set! define-by-mark-menu-label (add-to-menu marks-menu "Define selection by marks" (lambda () (post-define-by-mark-dialog)))))
-
+
+ (set! define-by-mark-menu-label (add-to-menu marks-menu "Define selection by marks" post-define-by-mark-dialog)))
+
(set! define-by-mark-menu-label (add-to-menu marks-menu define-by-mark-label cp-define-by-marks)))
(set! marks-list (cons (lambda ()
- (let ((new-label (format #f "Define selection by marks (~D ~D)" define-by-mark-one define-by-mark-two)))
- (if define-by-mark-menu-label (change-label define-by-mark-menu-label new-label))
- (set! define-by-mark-label new-label)))
- marks-list))
+ (let ((new-label (format #f "Define selection by marks (~D ~D)" define-by-mark-one define-by-mark-two)))
+ (if define-by-mark-menu-label (change-label define-by-mark-menu-label new-label))
+ (set! define-by-mark-label new-label)))
+ marks-list))
(add-to-menu marks-menu #f #f)
@@ -585,38 +593,43 @@ using the granulate generator to fix up the selection duration (this still is no
(define mark-sync-number 0)
-(define (start-sync)
- "(start-sync) starts mark syncing (marks-menu)"
- (set! mark-sync-number (+ (mark-sync-max) 1)))
+(define start-sync
+ (let ((documentation "(start-sync) starts mark syncing (marks-menu)"))
+ (lambda ()
+ (set! mark-sync-number (+ (mark-sync-max) 1)))))
-(define (stop-sync)
- "(stop-sync) stops mark-syncing (marks-menu)"
- (set! mark-sync-number 0))
+(define stop-sync
+ (let ((documentation "(stop-sync) stops mark-syncing (marks-menu)"))
+ (lambda ()
+ (set! mark-sync-number 0))))
-(define (click-to-sync id)
- "(click-to-sync id) sets a mark's sync field when it is clicked (marks-menu)"
- (set! (sync id) mark-sync-number)
- #f)
+(define click-to-sync
+ (let ((documentation "(click-to-sync id) sets a mark's sync field when it is clicked (marks-menu)"))
+ (lambda (id)
+ (set! (sync id) mark-sync-number)
+ #f)))
-(hook-push mark-click-hook click-to-sync)
+(hook-push mark-click-hook (lambda (hook) (click-to-sync (hook 'id))))
(define m-sync #f)
(define m-sync-label "Mark sync (On)")
(define no-m-sync-label "Mark sync (Off)")
-(define (msync!)
- "(msync!) starts mark syncing (marks-menu)"
- (set! m-sync #t)
- (if mark-sync-menu-label (change-label mark-sync-menu-label m-sync-label))
- (start-sync)
- (mark-sync-color "yellow"))
-
-(define (unmsync!)
- "(unmsync!) stops mark syncing (marks-menu)"
- (set! m-sync #f)
- (if mark-sync-menu-label (change-label mark-sync-menu-label no-m-sync-label))
- (stop-sync))
+(define msync!
+ (let ((documentation "(msync!) starts mark syncing (marks-menu)"))
+ (lambda ()
+ (set! m-sync #t)
+ (if mark-sync-menu-label (change-label mark-sync-menu-label m-sync-label))
+ (start-sync)
+ (mark-sync-color "yellow"))))
+
+(define unmsync!
+ (let ((documentation "(unmsync!) stops mark syncing (marks-menu)"))
+ (lambda ()
+ (set! m-sync #f)
+ (if mark-sync-menu-label (change-label mark-sync-menu-label no-m-sync-label))
+ (stop-sync))))
(set! mark-sync-menu-label
(add-to-menu marks-menu no-m-sync-label
@@ -637,8 +650,8 @@ using the granulate generator to fix up the selection duration (this still is no
;;; -------- mark loop dialog (this refers to sound header mark points, not Snd mark objects!)
(if (provided? 'xm)
- (begin
-
+ (with-let (sublet *motif*)
+
;; Here is a first stab at the loop dialog (I guessed a lot as to what these buttons
;; are supposed to do -- have never used these loop points).
@@ -648,13 +661,13 @@ using the granulate generator to fix up the selection duration (this still is no
(define (update-labels start range end sus-rel range-in-secs)
(if range-in-secs
(begin
- (change-label start (format #f "~,3F" (/ (list-ref loop-data (* sus-rel 2)) (srate))))
- (change-label range (format #f "~,3F" (/ (- (list-ref loop-data (+ 1 (* sus-rel 2))) (list-ref loop-data (* sus-rel 2))) (srate))))
- (change-label end (format #f "~,3F" (/ (list-ref loop-data (+ 1 (* sus-rel 2))) (srate)))))
+ (change-label start (format #f "~,3F" (/ (loop-data (* sus-rel 2)) (srate))))
+ (change-label range (format #f "~,3F" (/ (- (loop-data (+ 1 (* sus-rel 2))) (loop-data (* sus-rel 2))) (srate))))
+ (change-label end (format #f "~,3F" (/ (loop-data (+ 1 (* sus-rel 2))) (srate)))))
(begin
- (change-label start (format #f "~D" (list-ref loop-data (* sus-rel 2))))
- (change-label range (format #f "~D" (- (list-ref loop-data (+ 1 (* sus-rel 2))) (list-ref loop-data (* sus-rel 2)))))
- (change-label end (format #f "~D" (list-ref loop-data (+ 1 (* sus-rel 2))))))))
+ (change-label start (format #f "~D" (loop-data (* sus-rel 2))))
+ (change-label range (format #f "~D" (- (loop-data (+ 1 (* sus-rel 2))) (loop-data (* sus-rel 2)))))
+ (change-label end (format #f "~D" (loop-data (+ 1 (* sus-rel 2))))))))
(define (create-loop-dialog)
(if (not (Widget? loop-dialog))
@@ -671,7 +684,7 @@ using the granulate generator to fix up the selection duration (this still is no
XmNdialogTitle titlestr
XmNresizePolicy XmRESIZE_GROW
XmNnoResize #f
- XmNbackground (basic-color)
+ XmNbackground *basic-color*
XmNtransient #f)))
(XtAddCallback loop-dialog
XmNcancelCallback (lambda (w context info)
@@ -693,7 +706,7 @@ using the granulate generator to fix up the selection duration (this still is no
XmNtopAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_WIDGET
XmNbottomWidget (XmMessageBoxGetChild loop-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color))))
+ XmNbackground *basic-color*)))
(leftform
(XtCreateManagedWidget "lform" xmFormWidgetClass mainform
(list XmNleftAttachment XmATTACH_FORM
@@ -701,7 +714,7 @@ using the granulate generator to fix up the selection duration (this still is no
XmNrightPosition 50
XmNtopAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color))))
+ XmNbackground *basic-color*)))
(rightform
(XtCreateManagedWidget "rform" xmFormWidgetClass mainform
(list XmNleftAttachment XmATTACH_WIDGET
@@ -709,7 +722,7 @@ using the granulate generator to fix up the selection duration (this still is no
XmNrightAttachment XmATTACH_FORM
XmNtopAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color)))))
+ XmNbackground *basic-color*))))
(for-each
(lambda (parent top-label offset)
(let* ((main-label (XtCreateManagedWidget top-label xmLabelWidgetClass parent
@@ -725,16 +738,16 @@ using the granulate generator to fix up the selection duration (this still is no
XmNbottomAttachment XmATTACH_FORM
XmNshadowThickness 6
XmNshadowType XmSHADOW_ETCHED_OUT)))
- (frame-form (XtCreateManagedWidget "fform" xmFormWidgetClass main-frame '()))
+ (frame-form (XtCreateManagedWidget "fform" xmFormWidgetClass main-frame ()))
(top-frame (XtCreateManagedWidget "topf" xmFrameWidgetClass frame-form
(list XmNleftAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_FORM
XmNtopAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE)))
- (top-form (XtCreateManagedWidget "tform" xmFormWidgetClass top-frame '()))
+ (top-form (XtCreateManagedWidget "tform" xmFormWidgetClass top-frame ()))
(left-column (XtCreateManagedWidget "lcol" xmRowColumnWidgetClass top-form
(list XmNorientation XmVERTICAL
- XmNbackground (position-color)
+ XmNbackground *position-color*
XmNleftAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_POSITION
XmNrightPosition 40
@@ -749,7 +762,7 @@ using the granulate generator to fix up the selection duration (this still is no
XmNbottomAttachment XmATTACH_FORM)))
(right-column (XtCreateManagedWidget "lcol" xmRowColumnWidgetClass top-form
(list XmNorientation XmVERTICAL
- XmNbackground (position-color)
+ XmNbackground *position-color*
XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget mid-column
XmNrightAttachment XmATTACH_FORM
@@ -757,30 +770,30 @@ using the granulate generator to fix up the selection duration (this still is no
XmNbottomAttachment XmATTACH_FORM)))
(rowlefttop (XtCreateManagedWidget "r1" xmRowColumnWidgetClass left-column
(list XmNorientation XmHORIZONTAL
- XmNbackground (position-color)
+ XmNbackground *position-color*
XmNspacing 0)))
- (leftrange (XtCreateManagedWidget "range" xmPushButtonWidgetClass left-column '()))
+ (leftrange (XtCreateManagedWidget "range" xmPushButtonWidgetClass left-column ()))
(rowleftbottom (XtCreateManagedWidget "r1" xmRowColumnWidgetClass left-column
(list XmNorientation XmHORIZONTAL
- XmNbackground (position-color)
+ XmNbackground *position-color*
XmNspacing 0)))
(rowrighttop (XtCreateManagedWidget "r1" xmRowColumnWidgetClass right-column
(list XmNorientation XmHORIZONTAL
- XmNbackground (position-color)
+ XmNbackground *position-color*
XmNspacing 0)))
(rowrightmid (XtCreateManagedWidget "r1" xmRowColumnWidgetClass right-column
(list XmNorientation XmHORIZONTAL
- XmNbackground (position-color))))
+ XmNbackground *position-color*)))
(rightsep (XtCreateManagedWidget "rsep" xmSeparatorWidgetClass rowrightmid
(list XmNseparatorType XmNO_LINE
XmNorientation XmVERTICAL
- XmNbackground (position-color)
+ XmNbackground *position-color*
XmNwidth 20)))
- (rightlock (XtCreateManagedWidget "lock" xmToggleButtonWidgetClass rowrightmid '()))
+ (rightlock (XtCreateManagedWidget "lock" xmToggleButtonWidgetClass rowrightmid ()))
(rowrightbottom (XtCreateManagedWidget "r1" xmRowColumnWidgetClass right-column
(list XmNorientation XmHORIZONTAL
- XmNbackground (position-color)
+ XmNbackground *position-color*
XmNspacing 0)))
(midlab1 (XtCreateManagedWidget "0.000" xmLabelWidgetClass mid-column
(list XmNleftAttachment XmATTACH_FORM
@@ -836,7 +849,7 @@ using the granulate generator to fix up the selection duration (this still is no
(if (= mode 1)
(set! mode 2)
(set! mode 1))
- (list-set! loop-data (+ offset 6) mode)
+ (set! (loop-data (+ offset 6)) mode)
(change-label w (if (= mode 1) "forward" "forw/back")))))
(XtAddCallback leftrange XmNactivateCallback
(lambda (w c i)
@@ -844,61 +857,61 @@ using the granulate generator to fix up the selection duration (this still is no
(update-labels midlab1 midlab2 midlab3 offset range-in-secs)))
(for-each
(lambda (rparent loc)
- (let* ((farleft (XtCreateManagedWidget "<<" xmPushButtonWidgetClass rparent '()))
- (stopleft (XtCreateManagedWidget " O " xmPushButtonWidgetClass rparent '()))
- (lotsleft (XtCreateManagedWidget "<< " xmPushButtonWidgetClass rparent '()))
- (someleft (XtCreateManagedWidget " < " xmPushButtonWidgetClass rparent '()))
- (sus-rel-start (* offset 2)))
+ (let ((farleft (XtCreateManagedWidget "<<" xmPushButtonWidgetClass rparent ()))
+ (stopleft (XtCreateManagedWidget " O " xmPushButtonWidgetClass rparent ()))
+ (lotsleft (XtCreateManagedWidget "<< " xmPushButtonWidgetClass rparent ()))
+ (someleft (XtCreateManagedWidget " < " xmPushButtonWidgetClass rparent ()))
+ (sus-rel-start (* offset 2)))
(XtAddCallback farleft XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) 0 (list-ref loop-data sus-rel-start))))
- (list-set! loop-data (+ loc (* offset 2)) ml)
+ (let ((ml (if (= loc 0) 0 (loop-data sus-rel-start))))
+ (set! (loop-data (+ loc (* offset 2))) ml)
(update-labels midlab1 midlab2 midlab3 offset range-in-secs))))
(XtAddCallback stopleft XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) 0 (list-ref loop-data sus-rel-start))))
- (list-set! loop-data (+ loc (* offset 2)) ml)
+ (let ((ml (if (= loc 0) 0 (loop-data sus-rel-start))))
+ (set! (loop-data (+ loc (* offset 2))) ml)
(update-labels midlab1 midlab2 midlab3 offset range-in-secs))))
(XtAddCallback lotsleft XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) 0 (list-ref loop-data sus-rel-start))))
- (list-set! loop-data (+ loc (* offset 2)) (max ml (- (list-ref loop-data (+ loc (* offset 2))) 10)))
+ (let ((ml (if (= loc 0) 0 (loop-data sus-rel-start))))
+ (set! (loop-data (+ loc (* offset 2))) (max ml (- (loop-data (+ loc (* offset 2))) 10)))
(update-labels midlab1 midlab2 midlab3 offset range-in-secs))))
(XtAddCallback someleft XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) 0 (list-ref loop-data sus-rel-start))))
- (list-set! loop-data (+ loc (* offset 2)) (max ml (- (list-ref loop-data (+ loc (* offset 2))) 1)))
+ (let ((ml (if (= loc 0) 0 (loop-data sus-rel-start))))
+ (set! (loop-data (+ loc (* offset 2))) (max ml (- (loop-data (+ loc (* offset 2))) 1)))
(update-labels midlab1 midlab2 midlab3 offset range-in-secs))))))
(list rowlefttop rowleftbottom)
(list 0 1))
(for-each
(lambda (rparent loc)
- (let* ((someright (XtCreateManagedWidget " > " xmPushButtonWidgetClass rparent '()))
- (lotsright (XtCreateManagedWidget " >>" xmPushButtonWidgetClass rparent '()))
- (stopright (XtCreateManagedWidget " O " xmPushButtonWidgetClass rparent '()))
- (farright (XtCreateManagedWidget ">>" xmPushButtonWidgetClass rparent '()))
- (sus-rel-start (* offset 2)))
+ (let ((someright (XtCreateManagedWidget " > " xmPushButtonWidgetClass rparent ()))
+ (lotsright (XtCreateManagedWidget " >>" xmPushButtonWidgetClass rparent ()))
+ (stopright (XtCreateManagedWidget " O " xmPushButtonWidgetClass rparent ()))
+ (farright (XtCreateManagedWidget ">>" xmPushButtonWidgetClass rparent ()))
+ (sus-rel-start (* offset 2)))
(XtAddCallback farright XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) (list-ref loop-data (+ sus-rel-start 1)) (frames))))
- (list-set! loop-data (+ loc (* offset 2)) ml)
+ (let ((ml (if (= loc 0) (loop-data (+ sus-rel-start 1)) (framples))))
+ (set! (loop-data (+ loc (* offset 2))) ml)
(update-labels midlab1 midlab2 midlab3 offset range-in-secs))))
(XtAddCallback stopright XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) (list-ref loop-data (+ sus-rel-start 1)) (frames))))
- (list-set! loop-data (+ loc (* offset 2)) ml)
+ (let ((ml (if (= loc 0) (loop-data (+ sus-rel-start 1)) (framples))))
+ (set! (loop-data (+ loc (* offset 2))) ml)
(update-labels midlab1 midlab2 midlab3 offset range-in-secs))))
(XtAddCallback lotsright XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) (list-ref loop-data (+ sus-rel-start 1)) (frames))))
- (list-set! loop-data (+ loc (* offset 2)) (min ml (+ (list-ref loop-data (+ loc (* offset 2))) 10)))
+ (let ((ml (if (= loc 0) (loop-data (+ sus-rel-start 1)) (framples))))
+ (set! (loop-data (+ loc (* offset 2))) (min ml (+ (loop-data (+ loc (* offset 2))) 10)))
(update-labels midlab1 midlab2 midlab3 offset range-in-secs))))
(XtAddCallback someright XmNactivateCallback
(lambda (w c i)
- (let ((ml (if (= loc 0) (list-ref loop-data (+ sus-rel-start 1)) (frames))))
- (list-set! loop-data (+ loc (* offset 2)) (min ml (+ (list-ref loop-data (+ loc (* offset 2))) 1)))
+ (let ((ml (if (= loc 0) (loop-data (+ sus-rel-start 1)) (framples))))
+ (set! (loop-data (+ loc (* offset 2))) (min ml (+ (loop-data (+ loc (* offset 2))) 1)))
(update-labels midlab1 midlab2 midlab3 offset range-in-secs))))))
(list rowrighttop rowrightbottom)
(list 0 1))))
@@ -912,7 +925,7 @@ using the granulate generator to fix up the selection duration (this still is no
(not (XmIsRowColumn n))
(not (XmIsSeparator n)))
(begin
- (XmChangeColor n (basic-color))
+ (XmChangeColor n *basic-color*)
(if (XmIsToggleButton n)
(XtVaSetValues n (list XmNselectColor
(let* ((col (XColor))
@@ -933,24 +946,25 @@ using the granulate generator to fix up the selection duration (this still is no
;;; -------- Delete all marks
-(add-to-menu marks-menu "Delete all marks" (lambda () (delete-marks)))
+(add-to-menu marks-menu "Delete all marks" delete-marks)
(add-to-menu marks-menu #f #f)
;;; -------- Explode all marks to separate files
-(define (mark-explode)
- "(mark-explode) produces separate files as delineated by successive marks (marks-menu)"
- (let ((start 0))
- (for-each
- (lambda (mark)
- (let ((len (- (mark-sample mark) start))
- (filename (snd-tempnam)))
- (array->file filename
- (channel->vct start len)
- len (srate) 1)
- (set! start (mark-sample mark))))
- (caar (marks)))))
+(define mark-explode
+ (let ((documentation "(mark-explode) produces separate files as delineated by successive marks (marks-menu)"))
+ (lambda ()
+ (let ((start 0))
+ (for-each
+ (lambda (mark)
+ (let ((len (- (mark-sample mark) start))
+ (filename (snd-tempnam)))
+ (array->file filename
+ (channel->float-vector start len)
+ len (srate) 1)
+ (set! start (mark-sample mark))))
+ (caar (marks)))))))
(add-to-menu marks-menu "Explode marks to files" mark-explode)
diff --git a/marks.fs b/marks.fs
index a2b0ffb..4be0058 100644
--- a/marks.fs
+++ b/marks.fs
@@ -1,19 +1,19 @@
-\ -*- snd-forth -*-
\ marks.fs -- marks.scm|rb -> marks.fs
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
\ Created: Tue Dec 27 19:22:06 CET 2005
-\ Changed: Mon Oct 18 17:43:36 CEST 2010
+\ Changed: Wed Nov 21 19:52:34 CET 2012
\ Commentary:
\
-\ add-named-mark ( samp name snd chn -- mark )
-\ mark-name->id ( name -- m )
-\ move-syncd-marks ( sync diff -- )
-\ describe-mark ( id -- ary )
+\ add-named-mark ( samp name snd chn -- mark )
+\ mark-name->id ( name -- m )
+\ move-syncd-marks ( sync diff -- )
+\ describe-mark ( id -- ary )
\
-\ save-mark-properties ( -- )
-\ mark-click-info ( id -- #t )
+\ save-mark-properties ( -- )
+\ mark-click-info ( id -- #t )
+\ marks->string ( snd -- str )
\ Code:
@@ -25,167 +25,207 @@ require examp
\ snd #f: all sounds
\ chn #f: all channels
: marks-length <{ :optional snd #f chn #f edpos #f -- len }>
- snd sound? if
- chn channel? if
- snd chn edpos marks
- else
- snd chn edpos marks car
- then
- else
- snd chn edpos marks car car
- then length
+ snd sound? if
+ chn channel? if
+ snd chn edpos marks
+ else
+ snd chn edpos marks car
+ then
+ else
+ snd chn edpos marks car car
+ then length
;
-: marks? ( :optional snd chn edpos -- f ) marks-length 0> ;
+: marks? ( :optional snd chn edpos -- f )
+ marks-length 0>
+;
\ from rubber.fs
-: add-named-mark ( samp name snd chn -- mark )
- { samp name snd chn }
- samp snd chn add-mark { m }
- m name set-mark-name drop
- m
+: add-named-mark { samp name snd chn -- mark }
+ samp snd chn add-mark { m }
+ m name set-mark-name drop
+ m
;
\ mark-name->id is a global version of find-mark
: mark-name->id ( name -- m )
- doc" Like find-mark but searches all currently accessible channels."
- { name }
- #f \ flag
- sounds each { snd }
- snd channels 0 ?do
- name snd i undef find-mark { m }
- m mark? if
- drop \ replace #f with mark
- m
- exit
- then
- loop
- end-each
+ doc" Like find-mark but searche all currently accessible channels."
+ { name }
+ #f \ flag
+ sounds each { snd }
+ snd channels 0 ?do
+ name snd i undef find-mark { m }
+ m mark? if
+ drop \ replace #f with mark
+ m
+ exit
+ then
+ loop
+ end-each
;
-: move-syncd-marks ( sync diff )
- doc" Moves all marks sharing SYNC by DIFF samples."
- { syn diff }
- syn syncd-marks each ( m ) dup undef mark-sample diff + set-mark-sample drop end-each
+: move-syncd-marks ( sync diff -- )
+ doc" Move all marks sharing SYNC by DIFF samples."
+ { syn diff }
+ syn syncd-marks each { m }
+ m undef mark-sample diff + { val }
+ m val set-mark-sample drop
+ end-each
;
: describe-mark ( id -- ary )
- doc" Returns a description of the movements of mark ID over the channel's edit history."
- { id }
- id <'> mark-home 'no-such-mark nil fth-catch if
- sounds each { snd }
- snd channels 0 ?do
- 0 snd i ( chn ) edits each + end-each 1+ ( max-edits ) 0 ?do
- snd j ( chn ) #f marks { m }
- m
- id m array-member? && if
- #( snd j ( chn ) )
- leave
- then
- loop
- loop
- end-each
- then { mark-setting }
- mark-setting array? if
- mark-setting 0 array-ref { snd }
- mark-setting 1 array-ref { chn }
- #( #( 'mark id 'sound snd snd short-file-name 'channel chn ) ) { descr }
- 0 snd chn edits each + end-each 1+ 1 ?do
- descr
- snd chn i marks id array-member? if
- id i mark-sample
- else
- #f
- then
- array-push drop
- loop
- descr
- else
- 'no-such-mark #( get-func-name id ) fth-throw
- then
+ doc" Return a description of the movements of mark ID over \
+the channel's edit history."
+ { id }
+ id <'> mark-home 'no-such-mark nil fth-catch if
+ sounds each { snd }
+ snd channels 0 ?do
+ 0 snd i ( chn ) edits each
+ +
+ end-each 1+ ( max-edits ) 0 ?do
+ snd j ( chn ) #f marks { m }
+ m
+ id m array-member? && if
+ #( snd j ( chn ) )
+ leave
+ then
+ loop
+ loop
+ end-each
+ then { mark-setting }
+ mark-setting array? if
+ mark-setting 0 array-ref { snd }
+ mark-setting 1 array-ref { chn }
+ #( #( 'mark id
+ 'sound snd snd short-file-name
+ 'channel chn ) ) { descr }
+ 0 snd chn edits each
+ +
+ end-each 1+ 1 ?do
+ descr
+ snd chn i marks id array-member? if
+ id i mark-sample
+ else
+ #f
+ then array-push drop
+ loop
+ descr
+ else
+ 'no-such-mark #( "%s: %s" get-func-name id ) fth-throw
+ then
;
\ --- Mark Properties ---
hide
+: mark-writeit { mp mhome msamp io -- }
+ io "\t%S 0 find-sound to snd\n"
+ #( mhome 0 array-ref file-name ) io-write-format
+ io "\tsnd sound? if\n" io-write
+ io " %d snd %d find-mark to mk\n"
+ #( msamp mhome 1 array-ref ) io-write-format
+ io "\t\tmk mark? if\n" io-write
+ io "\t\t\tmk %S set-mark-properties\n" #( mp ) io-write-format
+ io "\t\tthen\n" io-write
+ io "\tthen\n" io-write
+;
+
: save-mark-properties-cb <{ filename -- }>
- undef undef undef marks car car cons? if
- filename :fam a/o io-open { io }
- io $" \n\\ from save-mark-properties in %s\n" #( *filename* ) io-write-format
- io $" require marks\n\n" io-write
- io $" let:\n" io-write
- io $" nil nil { snd mk }\n" io-write
- undef undef undef marks each ( snd-m )
- each ( chn-m )
- each { m }
- m mark-properties { mp }
- mp if
- m mark-home { mhome }
- m undef mark-sample { msamp }
- io $" %S 0 find-sound to snd\n" #( mhome 0 array-ref file-name ) io-write-format
- io $" snd sound? if\n" io-write
- io $" %d snd %d find-mark to mk\n" #( msamp mhome 1 array-ref ) io-write-format
- io $" mk mark? if\n" io-write
- io $" mk %S set-mark-properties\n" #( mp ) io-write-format
- io $" then\n" io-write
- io $" then\n" io-write
- then
- end-each
- end-each
- end-each
- io $" ;let\n" io-write
- io io-close
- then
+ undef undef undef marks car car cons? if
+ filename :fam a/o io-open { io }
+ io "\n\\ from save-mark-properties in %s\n"
+ #( *filename* ) io-write-format
+ io "require marks\n\n" io-write
+ io "let: ( -- )\n" io-write
+ io "\tnil nil { snd mk }\n" io-write
+ undef undef undef marks each ( snd-m )
+ each ( chn-m )
+ each { m }
+ m mark-properties { mp }
+ mp if
+ m mark-home { mhome }
+ m undef mark-sample { msamp }
+ mp mhome msamp io mark-writeit
+ then
+ end-each
+ end-each
+ end-each
+ io ";let\n" io-write
+ io io-close
+ then
;
set-current
+
: save-mark-properties ( -- )
- doc" Sets up an after-save-state-hook function to save any mark-properties."
- after-save-state-hook <'> save-mark-properties-cb add-hook!
+ doc" Set up an after-save-state-hook \
+function to save any mark-properties."
+ after-save-state-hook <'> save-mark-properties-cb add-hook!
;
previous
: mark-click-info <{ id -- #t }>
- doc" A mark-click-hook function that describes a mark and its properties.\n\
-mark-click-hook <'> mark-click-info add-hook!"
- $" mark id: %s\n" #( id ) string-format make-string-output-port { prt }
- id mark-name empty? unless prt $" name: %s\n" #( id mark-name ) port-puts-format then
- prt $" sample: %s (%.3f secs)\n"
- #( id undef mark-sample dup id mark-home 0 array-ref srate f/ ) port-puts-format
- id mark-sync if prt $" sync: %s\n" #( id mark-sync ) port-puts-format then
- id mark-properties { props }
- props empty? unless prt $" properties: %s" #( props ) port-puts-format then
- $" Mark Info" prt port->string info-dialog drop
- #t
+ doc" A mark-click-hook function that describes a \
+mark and its properties.\n\
+mark-click-hook <'> mark-click-info add-hook!."
+ " mark id: %s\n" #( id ) string-format
+ make-string-output-port { prt }
+ id mark-name empty? unless
+ prt " name: %s\n" #( id mark-name ) port-puts-format
+ then
+ prt " sample: %s (%.3f secs)\n"
+ #( id undef mark-sample dup id mark-home 0 array-ref srate f/ )
+ port-puts-format
+ id mark-sync if
+ prt " sync: %s\n" #( id mark-sync ) port-puts-format
+ then
+ id mark-properties { props }
+ props empty? unless
+ prt " properties: %s" #( props ) port-puts-format
+ then
+ "Mark Info" prt port->string info-dialog drop
+ #t
;
\ mark-click-hook <'> mark-click-info add-hook!
\ This code saves mark info in the sound file header, and reads it
\ back in when the sound is later reopened.
-: marks->string { sndf }
- $" \nrequire marks\n" make-string-output-port { prt }
- prt $" let:\n" port-puts
- prt $" #f { mr }\n" port-puts
- sndf marks each ( chan-marks )
- prt $" \n \\ channel %d\n" #( i ) port-puts-format
- each { m }
- m nil? ?leave
- $" %s #f %d %S %d add-mark to mk\n"
- #( m undef mark-sample
- j ( chn )
- m mark-name length 0= if #f else m mark-name then
- m mark-sync ) port-puts-format
- m mark-properties { props }
- props if $" mk %S set-mark-properties\n" #( props ) port-puts-format then
- end-each
- end-each
- prt $" ;let\n" port-puts
- prt port->string
+: marks->string { snd -- str }
+ "\nrequire marks\n" make-string-output-port { prt }
+ prt "let: ( -- )\n" port-puts
+ prt "\t#f { mr }\n" port-puts
+ snd marks each { chan-marks }
+ prt "\n\t\\ channel %d\n" #( i ) port-puts-format
+ chan-marks each { m }
+ m nil? ?leave
+ "\t%s #f %d %S %d add-mark to mk\n"
+ #( m undef mark-sample
+ j ( chn )
+ m mark-name length 0= if
+ #f
+ else
+ m mark-name
+ then
+ m mark-sync ) port-puts-format
+ m mark-properties { props }
+ props if
+ "\tmk %S set-mark-properties\n"
+ #( props ) port-puts-format
+ then
+ end-each
+ end-each
+ prt ";let\n" port-puts
+ prt port->string
;
0 [if]
- output-comment-hook lambda: <{ str }> selected-sound marks->string ; add-hook!
- after-open-hook lambda: <{ snd -- }>
- snd comment ( str ) <'> string-eval #t nil fth-catch if ( str ) drop then
- ; add-hook!
+ output-comment-hook lambda: <{ str }>
+ selected-sound marks->string
+ ; add-hook!
+
+ after-open-hook lambda: <{ snd -- }>
+ snd comment ( str ) <'> string-eval #t nil fth-catch if
+ ( str ) drop
+ then
+ ; add-hook!
[then]
\ marks.fs ends here
diff --git a/marks.rb b/marks.rb
index ad2ebae..4d597bd 100644
--- a/marks.rb
+++ b/marks.rb
@@ -1,11 +1,9 @@
-# marks.rb -- marks.scm --> marks.rb -*- snd-ruby -*-
+# marks.rb -- marks.scm --> marks.rb
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Wed Mar 23 02:08:47 CET 2005
-# Changed: Sat Feb 06 13:48:36 CET 2010
+# Created: 05/03/23 02:08:47
+# Changed: 14/11/14 07:02:23
-# Commentary:
-#
# examples of mark-related functions
#
# module Mark
@@ -40,9 +38,6 @@
# mark_click_info(id)
# eval_header(sndf)
# marks2string(sndf)
-#
-
-# Code:
require "hooks"
@@ -50,7 +45,8 @@ module Mark
# mark_name2id is a global version of find-mark
add_help(:mark_name2id,
- "mark_name2id(name) is like find-mark but searches all currently accessible channels")
+ "mark_name2id(name) \
+Is like find-mark but searches all currently accessible channels.")
def mark_name2id(name)
Snd.sounds.each do |snd|
channels(snd).times do |chn|
@@ -65,24 +61,33 @@ module Mark
# move_syncd_marks moves all syncd marks together
add_help(:move_syncd_marks,
- "move_syncd_marks(sync, diff) moves all marks sharing sync by diff samples")
+ "move_syncd_marks(sync, diff) \
+Moves all marks sharing sync by diff samples.")
def move_syncd_marks(sync, diff)
- (syncd_marks(sync) or []).each do |m| set_mark_sample(m, mark_sample(m) + diff) end
+ (syncd_marks(sync) or []).each do |m|
+ set_mark_sample(m, mark_sample(m) + diff)
+ end
end
# describe_mark shows mark history
add_help(:describe_mark,
- "describe_mark(id) \
-returns a description of the movements of mark id over the channel's edit history")
+ "describe_mark(id) \
+Returns a description of the movements of mark ID over \
+the channel's edit history.")
def describe_mark(id)
- if (mark_setting = Snd.catch do mark_home(id) end.first) == :no_such_mark
+ mark_setting = Snd.catch do
+ mark_home(id)
+ end.first
+ if mark_setting == :no_such_mark
Snd.sounds.each do |snd|
break if array?(mark_setting)
channels(snd).times do |chn|
break if array?(mark_setting)
max_edits = 0
- edits(snd, chn).each do |n| max_edits += n end
+ edits(snd, chn).each do |n|
+ max_edits += n
+ end
0.upto(max_edits) do |ed|
if (m = marks(snd, chn, ed)) and m.member?(id)
mark_setting = [snd, chn]
@@ -95,7 +100,9 @@ returns a description of the movements of mark id over the channel's edit histor
if array?(mark_setting)
snd, chn = mark_setting
max_edits = 0
- edits(snd, chn).each do |n| max_edits += n end
+ edits(snd, chn).each do |n|
+ max_edits += n
+ end
descr = [[:mark, id, :sound, snd, short_file_name(snd), :channel, chn]]
0.upto(max_edits) do |ed|
if marks(snd, chn, ed).member?(id)
@@ -136,11 +143,14 @@ returns a description of the movements of mark id over the channel's edit histor
# syncronize sounds at a given mark
add_help(:syncup,
- "syncup(*ids) \
-pads the channels with zeros so that all the marks in ids list occur at the same time")
+ "syncup(*ids) \
+Pads the channels with zeros so that all the marks in IDS list \
+occur at the same time.")
def syncup(*args_ids)
ids = args_ids.flatten
- samps = ids.map do |id| mark?(id) and mark_sample(id) end
+ samps = ids.map do |id|
+ mark?(id) and mark_sample(id)
+ end
max_samp = samps.max
ids.zip(samps) do |id, samp|
if samp < max_samp
@@ -151,11 +161,13 @@ pads the channels with zeros so that all the marks in ids list occur at the same
end
end
- # fit selection between marks, expanding via granulate (this needs some tweaking...)
+ # fit selection between marks, expanding via granulate (this
+ # needs some tweaking...)
add_help(:fit_selection_between_marks,
- "fit_selection_between_marks(m1, m2) \
-fits (and mixes) the current selection (via granulate) between the given marks")
+ "fit_selection_between_marks(m1, m2) \
+Fits (and mixes) the current selection (via granulate) \
+between the given marks.")
def fit_selection_between_marks(m1, m2)
m1_samp = mark_sample(m1)
m2_samp = mark_sample(m2)
@@ -166,7 +178,7 @@ fits (and mixes) the current selection (via granulate) between the given marks")
m1, m1_home[0], m1_home[1], m2, m2_home[0], m2_home[1])
else
mark_samps = m2_samp - m1_samp
- selection_samps = selection_frames
+ selection_samps = selection_framples()
reg_data = region2vct
reader = make_sampler(m1_samp)
gr = make_granulate(:expansion, mark_samps / selection_samps.to_f)
@@ -191,7 +203,8 @@ fits (and mixes) the current selection (via granulate) between the given marks")
# pad_marks inserts silence before each in a list of marks
add_help(:pad_marks,
- "pad_marks(ids, secs) inserts secs seconds of silence before each mark in ids")
+ "pad_marks(ids, secs) \
+Inserts SECS seconds of silence before each mark in IDS.")
def pad_marks(ids, secs)
silence_length = (secs * srate()).floor
silence_samps = Vct.new(silence_length)
@@ -207,7 +220,8 @@ fits (and mixes) the current selection (via granulate) between the given marks")
# play_syncd_marks
add_help(:play_syncd_marks,
- "play_syncd_marks(sync) starts playing from all marks sharing sync")
+ "play_syncd_marks(sync) \
+Starts playing from all marks sharing SYNC.")
def play_syncd_marks(sync)
chans = 1
rate = 22050
@@ -222,8 +236,8 @@ fits (and mixes) the current selection (via granulate) between the given marks")
end
add_help(:play_between_marks,
- "play_between_marks([mark1=false, [mark2=false]]) \
-plays the portion between the marks (searching for plausible default marks)")
+ "play_between_marks(mark1=false, mark2=false) \
+Plays the portion between the marks (searching for plausible default marks).")
def play_between_marks(mark1 = false, mark2 = false)
snd = Snd.snd
chn = Snd.chn
@@ -270,7 +284,8 @@ plays the portion between the marks (searching for plausible default marks)")
pos2 = mark_sample(m2)
beg = [pos1, pos2].min
len = [pos1, pos2].max
- play(mark_home(m1).car, :channel, mark_home(m1).cadr, :start, beg, :end, len)
+ play(mark_home(m1).car,
+ :channel, mark_home(m1).cadr, :start, beg, :end, len)
end
end
@@ -278,21 +293,23 @@ plays the portion between the marks (searching for plausible default marks)")
def initialize(snd)
@snd = snd
@marklist = marks(@snd, 0)
- @samplist = (@marklist or []).map do |m| mark_sample(m) end
+ @samplist = (@marklist or []).map do |m|
+ mark_sample(m)
+ end
@samp = 0
end
def report_mark_names_play_hook(size)
@samp += size
if array?(@samplist) and @samp >= @samplist.first
- report_in_minibuffer(mark_sample(@marklist.first), @snd)
+ snd_print(mark_sample(@marklist.first), @snd)
@marklist.unshift
@samplist.unshift
end
end
def report_mark_names_stop_playing_hook(snd)
- report_in_minibuffer("", snd)
+ snd_print("", snd)
$play_hook.remove_hook("report-mark-names-play")
$stop_playing_hook.remove_hook("report-mark-names-stop-playing")
end
@@ -301,7 +318,8 @@ plays the portion between the marks (searching for plausible default marks)")
# report_mark_names causes mark names to be posted in the minibuffer as a sound is played
add_help(:report_mark_names,
- "report_mark_names() causes mark names to be printed as they are passed while playing")
+ "report_mark_names() \
+Causes mark names to be printed as they are passed while playing.")
def report_mark_names
$start_playing_hook.add_hook!("marks.rb") do |snd|
rp = Mark_report.new(snd)
@@ -317,8 +335,9 @@ plays the portion between the marks (searching for plausible default marks)")
# eval_between_marks
add_help(:eval_between_marks,
- "eval_between_marks(&func) \
-evaluates func between the leftmost marks; func takes one arg, the original sample")
+ "eval_between_marks(&func) \
+Evaluates FUNC between the leftmost marks; \
+FUNC takes one arg, the original sample.")
def eval_between_marks(func1 = nil, &func2)
func = if block_given?
func2
@@ -344,24 +363,31 @@ evaluates func between the leftmost marks; func takes one arg, the original samp
beg = mark_sample(winl[0])
len = mark_sample(winl[1]) - beg
old_data = channel2vct(beg, len, snd, chn)
- new_data = Vct.new(len) do |i| func.call(old_data[i]) end
+ new_data = Vct.new(len) do |i|
+ func.call(old_data[i])
+ end
vct2channel(new_data, beg, len, snd, chn)
end
else
- report_in_minibuffer("need 2 marks")
+ snd_print("need 2 marks")
end
end
end
- # bind_key(?m, 0, lambda do | | prompt_in_minibuffer("mark eval:", eval_between_marks) end)
+ # bind_key(?m, 0,
+ # lambda do | |
+ # prompt_in_minibuffer("mark eval:", eval_between_marks)
+ # end)
# snap_marks
- add_help(:snap_marks, "snap_marks() places marks at current selection boundaries")
+ add_help(:snap_marks,
+ "snap_marks() \
+Places marks at current selection boundaries.")
def snap_marks
if selection?
selection_members.each do |snd, chn|
pos = selection_position(snd, chn)
- len = selection_frames(snd, chn)
+ len = selection_framples(snd, chn)
add_mark(pos, snd, chn)
add_mark(pos + len, snd, chn)
end
@@ -371,8 +397,8 @@ evaluates func between the leftmost marks; func takes one arg, the original samp
# define_selection_via_marks
add_help(:define_selection_via_marks,
- "define_selection_via_marks(m1, m2) \
-defines the current selection to lie between the marks given")
+ "define_selection_via_marks(m1, m2) \
+Defines the current selection to lie between the marks given.")
def define_selection_via_marks(m1, m2)
m1sc = mark_home(m1)
m2sc = mark_home(m2)
@@ -385,17 +411,20 @@ defines the current selection to lie between the marks given")
end
set_selection_member?(true, snd, chn)
set_selection_position(beg, snd, chn)
- set_selection_frames(fin - beg + 1, snd, chn)
+ set_selection_framples(fin - beg + 1, snd, chn)
else
- Snd.raise(:snd_error, "define_selection_via_marks assumes the marks are in the same channel")
+ Snd.raise(:snd_error,
+ "define_selection_via_marks assumes the marks are \
+in the same channel")
end
end
# snap_mark_to_beat
add_help(:snap_mark_to_beat,
- "snap_mark_to_beat() \
-ensures that when a mark is dragged, its released position is always on a beat")
+ "snap_mark_to_beat() \
+Ensures that when a mark is dragged, \
+its released position is always on a beat.")
def snap_mark_to_beat
mark_release = 4
$mark_hook.add_hook!(get_func_name) do |m, snd, chn, reason|
@@ -420,8 +449,8 @@ ensures that when a mark is dragged, its released position is always on a beat")
# write out each section of a file between marks as a separate file
add_help(:mark_explode,
- "mark_explode([header_type=Mus_next, [data_format=Mus_bfloat]]) \
-splits a sound into a bunch of sounds based on mark placements")
+ "mark_explode(header_type=Mus_next, data_format=Mus_bfloat) \
+Splits a sound into a bunch of sounds based on mark placements.")
def mark_explode(htype = Mus_next, dformat = Mus_bfloat)
start = 0
file_ctr = 0
@@ -435,9 +464,12 @@ splits a sound into a bunch of sounds based on mark placements")
channels(snd).times do |chn|
set_selection_member?(true, snd, chn)
set_selection_position(start, snd, chn)
- set_selection_frames(last - start, snd, chn)
+ set_selection_framples(last - start, snd, chn)
end
- save_selection(filename, :header_type, htype, :data_format, dformat, :srate, srate(snd))
+ save_selection(filename,
+ :header_type, htype,
+ :sample_type, dformat,
+ :srate, srate(snd))
channels(snd).times do |chn|
set_selection_member?(false, snd, chn)
end
@@ -452,8 +484,8 @@ splits a sound into a bunch of sounds based on mark placements")
# === Mark Properties ===
#
add_help(:save_mark_properties,
- "save_mark_properties() \
-sets up an $after_save_state_hook function to save any mark-properties")
+ "save_mark_properties() \
+Sets up an $after_save_state_hook function to save any mark-properties.")
def save_mark_properties
$after_save_state_hook.add_hook!(get_func_name) do |fname|
File.open(File.expand_path(fname), "a+") do |f|
@@ -465,9 +497,11 @@ sets up an $after_save_state_hook function to save any mark-properties")
if mp = mark_properties(m)
snd, chn = mark_home(m)
msamp = mark_sample(m)
- f.printf("if sound?(snd = find_sound(%s))\n", file_name(snd).inspect)
- f.printf(" if mark?(m = find_mark(%d, snd, %d))\n", msamp, chn)
- f.printf(" set_mark_properties(m, %s)\n", mp.inspect)
+ f.printf("if sound?(snd = find_sound(%s))\n",
+ file_name(snd).inspect)
+ f.printf(" if mark?(m = find_mark(%d, snd, %d))\n",
+ msamp, chn)
+ f.printf(" set_mark_properties(m, %p)\n", mp)
f.printf(" end\n")
f.printf("end\n")
end
@@ -482,22 +516,33 @@ sets up an $after_save_state_hook function to save any mark-properties")
# === Mark Click Info ===
#
add_help(:mark_click_info,
- "mark_click_info(n) \
-is a $mark_click_hook function that describes a mark and its properties")
+ "mark_click_info(n) \
+Is a $mark_click_hook function that describes a mark and its properties.")
def mark_click_info(id)
Snd.raise(:no_such_mark, id) unless mark?(id)
- info_dialog("Mark info", format("\
+ mname = mark_name(id)
+ mnamestr = ""
+ if mname
+ mnamestr = format("\n mark name: %p", mname)
+ end
+ msamp = mark_sample(id)
+ msync = mark_sync(id)
+ msyncstr = ""
+ if msync.nonzero?
+ msyncstr = format("\n sync: %d", msync)
+ end
+ props = mark_properties(id)
+ propstr = ""
+ if props
+ propstr = format("\n properties: %p", props)
+ end
+ info_dialog("Mark info",
+ format("\
mark id: %s%s
sample: %d (%1.3f secs)%s%s",
- id,
- ((s = mark_name(id)) ?
- format("\n mark name: %s", s.inspect) : ""),
- mark_sample(id),
- mark_sample(id) / srate(mark_home(id)[0]).to_f,
- (mark_sync(id).nonzero? ?
- format("\n sync: %d", mark_sync(id)) : ""),
- ((props = mark_properties(id)) ?
- format("\n properties: %s", props.inspect) : "")))
+ id, mnamestr,
+ msamp, msamp / srate(mark_home(id)[0]).to_f,
+ msyncstr, propstr))
true
end
@@ -520,7 +565,9 @@ is a $mark_click_hook function that describes a mark and its properties")
end
str
end
- # $output_comment_hook.add_hook!("marks2string") do |str| marks2string(selected_sound()) end
+ # $output_comment_hook.add_hook!("marks2string") do |str|
+ # marks2string(selected_sound())
+ # end
# $after_open_hook.add_hook!("marks2string") do |snd|
# if string?(str = comment(snd))
# Snd.catch do eval(str, TOPLEVEL_BINDING, "(eval-header)", 1) end.first
diff --git a/marks.scm b/marks.scm
index 87f6b10..e8918e8 100644
--- a/marks.scm
+++ b/marks.scm
@@ -1,6 +1,7 @@
;;; examples of mark-related functions
(provide 'snd-marks.scm)
+(require snd-selection.scm snd-hooks.scm)
;;; Contents:
;;; mark-name->id is a global version of find-mark
@@ -12,7 +13,6 @@
;;; pad-marks inserts silence before each in a list of marks
;;; play-syncd-marks and play-between-marks
;;; report-mark-names causes mark names to be posted in the minibuffer as a sound is played
-;;; eval-between-marks evaluates func between two marks
;;; snap-marks places marks at current selection boundaries
;;; define-selection-via-marks selects the portion between two marks
;;; snap-mark-to-beat forces dragged mark to end up on a beat
@@ -23,64 +23,67 @@
;;; -------- mark-name->id is a global version of find-mark
-(define (mark-name->id name)
- "(mark-name->id name) is like find-mark but searches all currently accessible channels"
- (call-with-exit
- (lambda (return)
- (for-each
- (lambda (snd)
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (let ((mark (find-mark name snd chn)))
- (if (mark? mark)
- (return mark)))))
- (sounds))
- 'no-such-mark)))
+(define mark-name->id
+ (let ((documentation "(mark-name->id name) is like find-mark but searches all currently accessible channels"))
+ (lambda (name)
+ (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (snd)
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels snd)))
+ (let ((mark (find-mark name snd chn)))
+ (if (mark? mark)
+ (return mark)))))
+ (sounds))
+ 'no-such-mark)))))
;;; -------- move-syncd-marks moves all syncd marks together
-(define (move-syncd-marks sync diff)
- "(move-syncd-marks sync diff) moves all marks sharing sync by diff samples"
- (for-each (lambda (m)
- (set! (mark-sample m) (+ (mark-sample m) diff)))
- (syncd-marks sync)))
+(define move-syncd-marks
+ (let ((documentation "(move-syncd-marks sync diff) moves all marks sharing sync by diff samples"))
+ (lambda (synch diff)
+ (for-each (lambda (m)
+ (set! (mark-sample m) (+ (mark-sample m) diff)))
+ (syncd-marks synch)))))
;;; -------- describe-mark shows mark history
-(define (describe-mark id)
- "(describe-mark mark) returns a description of the movements of mark over the channel's edit history"
- (let ((mark-setting (catch 'no-such-mark (lambda () (mark-home id)) (lambda args #f))))
- (if (not mark-setting)
- ;; not an active mark, so go scrounging for it
- ;; we're looking at every edit of every channel
- (set! mark-setting (call-with-exit
- (lambda (return)
- (for-each
- (lambda (snd)
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (let* ((max-edits (apply + (edits snd chn))))
- (do ((ed 0 (+ 1 ed)))
- ((> ed max-edits))
- (if (member id (marks snd chn ed))
- (return (list snd chn)))))))
- (sounds))
- #f))))
- (if (list? mark-setting)
- (let* ((snd (car mark-setting))
- (chn (cadr mark-setting))
- (max-edits (apply + (edits snd chn)))
- (descr '())
- (header (list id sound: snd (short-file-name snd) 'channel: chn)))
- (do ((i max-edits (- i 1)))
- ((< i 0) descr)
- (if (member id (marks snd chn i))
- (set! descr (cons (mark-sample id i) descr))
- (set! descr (cons #f descr))))
- (cons header descr))
- (throw 'no-such-mark (list "describe-mark" id)))))
+(define describe-mark
+ (let ((documentation "(describe-mark mark) returns a description of the movements of mark over the channel's edit history"))
+ (lambda (id)
+ (let ((mark-setting (catch 'no-such-mark (lambda () (mark-home id)) (lambda args #f))))
+ (if (not mark-setting)
+ ;; not an active mark, so go scrounging for it
+ ;; we're looking at every edit of every channel
+ (set! mark-setting (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (snd)
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels snd)))
+ (let ((max-edits (apply + (edits snd chn))))
+ (do ((ed 0 (+ 1 ed)))
+ ((> ed max-edits))
+ (if (member id (marks snd chn ed))
+ (return (list snd chn)))))))
+ (sounds))
+ #f))))
+ (if (pair? mark-setting)
+ (let* ((snd (car mark-setting))
+ (chn (cadr mark-setting))
+ (max-edits (apply + (edits snd chn)))
+ (descr ())
+ (header (list id sound: snd (short-file-name snd) 'channel: chn)))
+ (do ((i max-edits (- i 1)))
+ ((< i 0) descr)
+ (if (member id (marks snd chn i))
+ (set! descr (cons (mark-sample id i) descr))
+ (set! descr (cons #f descr))))
+ (cons header descr))
+ (error 'no-such-mark (list "describe-mark" id)))))))
;;; -------- click marks between start-sync and stop-sync to sync them together
@@ -90,344 +93,324 @@
(define (start-sync) (set! mark-sync-number (+ (mark-sync-max) 1)))
(define (stop-sync) (set! mark-sync-number 0))
(define (click-to-sync id) (set! (sync id) mark-sync-number) #f)
-;(hook-push mark-click-hook click-to-sync)
+ ;(hook-push mark-click-hook (lambda (hook) (click-to-sync (hook 'id))))
;;; -------- syncronize sounds at a given mark
(define syncup
- (lambda ids
- "(syncup marks) pads the channels with zeros so that all the given marks occur at the same time"
- (let* ((samps (map mark-sample ids))
- (max-samp (apply max samps)))
- (define (pad-to-sync lst-ids lst-samps)
- (if (not (null? lst-ids))
- (begin
- (if (< (car lst-samps) max-samp)
- (let ((nsamps (- max-samp (car lst-samps)))
- (snd-chn (mark-home (car lst-ids))))
- (insert-samples 0 nsamps (make-vct nsamps) (car snd-chn) (cadr snd-chn))))
- (pad-to-sync (cdr lst-ids) (cdr lst-samps)))))
- (pad-to-sync ids samps))))
+ (let ((documentation "(syncup marks) pads the channels with zeros so that all the given marks occur at the same time"))
+ (lambda ids
+ (let* ((samps (map mark-sample ids))
+ (max-samp (apply max samps)))
+ (define (pad-to-sync lst-ids lst-samps)
+ (if (pair? lst-ids)
+ (begin
+ (if (< (car lst-samps) max-samp)
+ (let ((nsamps (- max-samp (car lst-samps)))
+ (snd-chn (mark-home (car lst-ids))))
+ (insert-samples 0 nsamps (make-float-vector nsamps) (car snd-chn) (cadr snd-chn))))
+ (pad-to-sync (cdr lst-ids) (cdr lst-samps)))))
+ (pad-to-sync ids samps)))))
;;; -------- fit selection between marks, expanding via granulate (this needs some tweaking...)
-(define (fit-selection-between-marks m1 m2)
- "(fit-selection-between-marks m1 m2) fits (and mixes) the current selection (via granulate) between the given marks"
- (let* ((m1-samp (mark-sample m1))
- (m2-samp (mark-sample m2))
- (m1-home (mark-home m1))
- (m2-home (mark-home m2)))
- (if (not (selection?))
- (throw 'no-active-selection))
- (if (not (equal? m1-home m2-home))
- (snd-print (format #f "~A is in ~A[~A] but ~A is in ~A[~A]?"
- m1 (car m1-home) (cadr m1-home)
- m2 (car m2-home) (cadr m2-home)))
- (let* ((mark-samps (- m2-samp m1-samp))
- (selection-samps (selection-frames))
- (reg-data (let ((data (make-vct selection-samps))
- (rd (make-sampler (selection-position))))
- (do ((i 0 (+ 1 i)))
- ((= i selection-samps))
- (vct-set! data i (rd)))
- data))
- (inctr 0))
- (if (= mark-samps selection-samps)
- (map-channel (lambda (y)
- (let ((val (+ y (vct-ref reg-data inctr))))
- (set! inctr (+ 1 inctr))
- val))
- m1-samp mark-samps (car m1-home) (cadr m1-home))
- (let* ((gr (make-granulate :expansion (/ mark-samps selection-samps))))
- (map-channel (lambda (y)
- (+ y (granulate gr (lambda (dir)
- (if (or (>= inctr selection-samps)
- (< inctr 0))
- 0.0
- (let ((val (vct-ref reg-data inctr)))
- (set! inctr (+ inctr dir))
- val))))))
- m1-samp mark-samps (car m1-home) (cadr m1-home))))))))
+(define fit-selection-between-marks
+ (let ((documentation "(fit-selection-between-marks m1 m2) fits (and mixes) the current selection (via granulate) between the given marks"))
+ (lambda (m1 m2)
+ (let ((m1-samp (mark-sample m1))
+ (m2-samp (mark-sample m2))
+ (m1-home (mark-home m1))
+ (m2-home (mark-home m2)))
+ (if (not (selection?))
+ (error 'no-active-selection))
+ (if (not (equal? m1-home m2-home))
+ (snd-print (format #f "~A is in ~A[~A] but ~A is in ~A[~A]?"
+ m1 (car m1-home) (cadr m1-home)
+ m2 (car m2-home) (cadr m2-home)))
+ (let* ((mark-samps (- m2-samp m1-samp))
+ (selection-samps (selection-framples))
+ (reg-data (let ((data (make-float-vector selection-samps))
+ (rd (make-sampler (selection-position))))
+ (do ((i 0 (+ 1 i)))
+ ((= i selection-samps))
+ (set! (data i) (rd)))
+ data))
+ (inctr 0))
+ (if (= mark-samps selection-samps)
+ (map-channel (lambda (y)
+ (let ((val (+ y (reg-data inctr))))
+ (set! inctr (+ 1 inctr))
+ val))
+ m1-samp mark-samps (car m1-home) (cadr m1-home))
+ (let ((gr (make-granulate :expansion (/ mark-samps selection-samps)
+ :input (lambda (dir)
+ (if (or (>= inctr selection-samps)
+ (< inctr 0))
+ 0.0
+ (let ((val (reg-data inctr)))
+ (set! inctr (+ inctr dir))
+ val))))))
+ (map-channel (lambda (y)
+ (+ y (granulate gr)))
+ m1-samp mark-samps (car m1-home) (cadr m1-home))))))))))
;;; -------- pad-marks inserts silence before each in a list of marks
-(define (pad-marks ids secs)
- "(pad-marks marks secs) inserts secs seconds of silence before each mark"
- (let* ((silence-length (floor (* secs (srate))))
- (silence-samps (make-vct silence-length)))
- (as-one-edit
- (lambda ()
- (for-each
- (lambda (n)
- (let ((samp (max 0 (- (mark-sample n) 1)))
- (home (mark-home n)))
- (insert-samples samp silence-length silence-samps (car home) (cadr home))))
- ids)))))
+(define pad-marks
+ (let ((documentation "(pad-marks marks secs) inserts secs seconds of silence before each mark"))
+ (lambda (ids secs)
+ (let* ((silence-length (floor (* secs (srate))))
+ (silence-samps (make-float-vector silence-length)))
+ (as-one-edit
+ (lambda ()
+ (for-each
+ (lambda (n)
+ (let ((samp (max 0 (- (mark-sample n) 1)))
+ (home (mark-home n)))
+ (insert-samples samp silence-length silence-samps (car home) (cadr home))))
+ ids)))))))
;;; -------- play-syncd-marks
-(define (play-syncd-marks sync)
- "(play-syncd-marks sync) starts playing from all marks sharing sync"
- (let ((chans 1)
- (rate 22050))
- (for-each
- (lambda (m)
- (let* ((sound (car (mark-home m)))
- (channel (cadr (mark-home m)))
- (new-player (make-player sound channel)))
- (add-player new-player (mark-sample m))
- (set! chans (max chans (+ 1 channel)))
- (set! rate (max rate (srate sound)))))
- (syncd-marks sync))
- (start-playing chans rate)))
+(define play-syncd-marks
+ (let ((documentation "(play-syncd-marks sync) starts playing from all marks sharing sync"))
+ (lambda (synch)
+ (let ((chans 1)
+ (rate 22050))
+ (for-each
+ (lambda (m)
+ (let* ((sound (car (mark-home m)))
+ (channel (cadr (mark-home m)))
+ (new-player (make-player sound channel)))
+ (add-player new-player (mark-sample m))
+ (set! chans (max chans (+ 1 channel)))
+ (set! rate (max rate (srate sound)))))
+ (syncd-marks synch))
+ (start-playing chans rate)))))
(define play-between-marks
- (lambda args
- "(play-between-marks ...) plays the portion between the marks (searching for plausible default marks)"
- (let* ((snd (or (selected-sound) (car (sounds))))
- (chn (or (selected-channel) 0))
- (m1 (if (> (length args) 0)
- (car args)
- (let find-mark ((ms (marks snd chn)))
- (if (null? ms)
- (begin
- (snd-print ";no marks in current window?")
- #f)
- (if (>= (mark-sample (car ms)) (left-sample snd chn))
- (car ms)
- (find-mark (cdr ms)))))))
- (m2 (and (mark? m1)
- (if (> (length args) 1)
- (cadr args)
- (let find-another-mark ((ms (marks snd chn)))
- (if (null? ms)
- (begin
- (snd-print ";no second mark?")
- #f)
- (if (> (mark-sample (car ms)) (mark-sample m1))
- (car ms)
- (find-another-mark (cdr ms)))))))))
- (if (and (mark? m1)
- (mark? m2))
- (let* ((pos1 (mark-sample m1))
- (pos2 (mark-sample m2))
- (beg (min pos1 pos2))
- (end (max pos1 pos2)))
- (play (car (mark-home m1))
- :channel (cadr (mark-home m1))
- :start beg
- :end end))))))
+ (let ((documentation "(play-between-marks ...) plays the portion between the marks (searching for plausible default marks)"))
+ (lambda args
+ (let* ((snd (or (selected-sound) (car (sounds))))
+ (chn (or (selected-channel) 0))
+ (m1 (if (> (length args) 0)
+ (car args)
+ (let find-mark ((ms (marks snd chn)))
+ (if (null? ms)
+ (begin
+ (snd-print ";no marks in current window?")
+ #f)
+ (if (>= (mark-sample (car ms)) (left-sample snd chn))
+ (car ms)
+ (find-mark (cdr ms)))))))
+ (m2 (and (mark? m1)
+ (if (> (length args) 1)
+ (cadr args)
+ (let find-another-mark ((ms (marks snd chn)))
+ (if (null? ms)
+ (begin
+ (snd-print ";no second mark?")
+ #f)
+ (if (> (mark-sample (car ms)) (mark-sample m1))
+ (car ms)
+ (find-another-mark (cdr ms)))))))))
+ (if (and (mark? m1)
+ (mark? m2))
+ (let* ((pos1 (mark-sample m1))
+ (pos2 (mark-sample m2))
+ (beg (min pos1 pos2))
+ (end (max pos1 pos2)))
+ (play (car (mark-home m1))
+ :channel (cadr (mark-home m1))
+ :start beg
+ :end end)))))))
;;; -------- report-mark-names causes mark names to be posted in the minibuffer as a sound is played
-(if (not (provided? 'snd-hooks.scm)) (load "hooks.scm"))
-
-(define (report-mark-names)
- "(report-mark-names) causes mark names to be printed as they are passed while playing"
- (hook-push start-playing-hook
- (lambda (snd)
- (let* ((marklist (marks snd 0))
- (samplist (map mark-sample marklist))
- (samp 0))
-
- (define (report-mark-names-play-hook size)
- (set! samp (+ samp size))
- (if (and (not (null? samplist))
- (>= samp (car samplist)))
- (begin
- (report-in-minibuffer (mark-name (car marklist)) snd)
- (set! marklist (cdr marklist))
- (set! samplist (cdr samplist)))))
-
- (define (report-mark-names-stop-playing-hook snd)
- (report-in-minibuffer "" snd)
- (hook-remove play-hook report-mark-names-play-hook)
- (hook-remove stop-playing-hook report-mark-names-stop-playing-hook))
-
- (hook-push stop-playing-hook report-mark-names-stop-playing-hook)
- (hook-push play-hook report-mark-names-play-hook)
- #f))))
-
-
-;;; -------- eval-between-marks
-
-(define (eval-between-marks func)
- "(eval-between-marks func) evaluates func between the leftmost marks; func takes one arg, the original sample"
-
- (define (find-if pred l)
- (cond ((null? l) #f)
- ((pred (car l)) l)
- (else (find-if pred (cdr l)))))
-
- (if (procedure? func)
- ;; find leftmost two marks in selected chn
- (let ((chan (selected-channel))
- (snd (selected-sound)))
- (if (< chan 0) (set! chan 0)) ;perhaps not current sound, so no selected channel in it
- (let ((mlist (marks snd chan)))
- (if (< (length mlist) 2)
- (report-in-minibuffer "need 2 marks")
- (let* ((left-samp (left-sample snd chan))
- (winl (find-if (lambda (n) (> (mark-sample n) left-samp)) mlist)))
- (if (and winl (> (length winl) 1))
- (let* ((beg (mark-sample (car winl)))
- (len (- (mark-sample (cadr winl)) beg))
- (new-data (make-vct len))
- (old-data (channel->vct beg len snd chan)))
- (do ((k 0 (+ 1 k)))
- ((= k len) (vct->channel new-data beg len snd chan))
- (vct-set! new-data k (func (vct-ref old-data k))))))))))))
-
-;(bind-key #\m 0 (lambda () "eval between marks" (prompt-in-minibuffer "mark eval:" eval-between-marks)))
+(define report-mark-names
+ (let ((documentation "(report-mark-names) causes mark names to be printed as they are passed while playing"))
+ (lambda ()
+ (hook-push start-playing-hook
+ (lambda (snd)
+ (let* ((marklist (marks snd 0))
+ (samplist (map mark-sample marklist))
+ (samp 0))
+
+ (define (report-mark-names-play-hook hook)
+ (set! samp (+ samp (hook 'size)))
+ (if (and (pair? samplist)
+ (>= samp (car samplist)))
+ (begin
+ (status-report (mark-name (car marklist)) snd)
+ (set! marklist (cdr marklist))
+ (set! samplist (cdr samplist)))))
+
+ (define (report-mark-names-stop-playing-hook hook)
+ (status-report "" (hook 'snd))
+ (hook-remove play-hook report-mark-names-play-hook)
+ (hook-remove stop-playing-hook report-mark-names-stop-playing-hook))
+
+ (hook-push stop-playing-hook report-mark-names-stop-playing-hook)
+ (hook-push play-hook report-mark-names-play-hook)
+ #f))))))
;;; -------- snap-marks
-(define (snap-marks)
- "snap-marks places marks at current selection boundaries"
- (let ((ms (list)))
- (if (selection?)
- (for-each
- (lambda (select)
- (let ((pos (apply selection-position select))
- (len (apply selection-frames select)))
- (set! ms (cons (apply add-mark pos select) ms))
- (set! ms (cons (apply add-mark (+ pos len) select) ms))))
- (selection-members)))
- (reverse ms)))
+(define snap-marks
+ (let ((documentation "snap-marks places marks at current selection boundaries"))
+ (lambda ()
+ (let ((ms (list)))
+ (if (selection?)
+ (for-each
+ (lambda (select)
+ (let ((pos (apply selection-position select))
+ (len (apply selection-framples select)))
+ (set! ms (cons (apply add-mark (+ pos len) select)
+ (cons (apply add-mark pos select) ms)))))
+ (selection-members)))
+ (reverse ms)))))
;;; -------- define-selection-via-marks
-(define (define-selection-via-marks m1 m2)
- "(define-selection-via-marks m1 m2) defines the current selection to lie between the marks given"
- (let ((m1sc (mark-home m1))
- (m2sc (mark-home m2)))
- (if (not (equal? m1sc m2sc))
- (snd-error "define-selection-via-marks assumes the marks are in the same channel")
- (let ((beg (min (mark-sample m1) (mark-sample m2)))
- (end (max (mark-sample m1) (mark-sample m2)))
- (snd (car m1sc))
- (chn (cadr m1sc)))
- (if (selection?)
- (set! (selection-member? #t) #f)) ; clear entire current selection, if any
- (set! (selection-member? snd chn) #t)
- (set! (selection-position snd chn) beg)
- (set! (selection-frames snd chn) (+ 1 (- end beg)))))))
+(define define-selection-via-marks
+ (let ((documentation "(define-selection-via-marks m1 m2) defines the current selection to lie between the marks given"))
+ (lambda (m1 m2)
+ (let ((m1sc (mark-home m1))
+ (m2sc (mark-home m2)))
+ (if (not (equal? m1sc m2sc))
+ (snd-error "define-selection-via-marks assumes the marks are in the same channel")
+ (let ((beg (min (mark-sample m1) (mark-sample m2)))
+ (end (max (mark-sample m1) (mark-sample m2)))
+ (snd (car m1sc))
+ (chn (cadr m1sc)))
+ (if (selection?)
+ (set! (selection-member? #t) #f)) ; clear entire current selection, if any
+ (set! (selection-member? snd chn) #t)
+ (set! (selection-position snd chn) beg)
+ (set! (selection-framples snd chn) (+ 1 (- end beg)))))))))
;;; -------- snap-mark-to-beat
-(define (snap-mark-to-beat)
- "(snap-mark-to-beat) ensures that when a mark is dragged, its released position is always on a beat"
- (let ((mark-release 4))
- (hook-push mark-hook
- (lambda (mrk snd chn reason)
- (if (= reason mark-release)
- (let* ((samp (mark-sample mrk))
- (bps (/ (beats-per-minute snd chn) 60.0))
- (sr (srate snd))
- (beat (floor (/ (* samp bps) sr)))
- (lower (floor (/ (* beat sr) bps)))
- (higher (floor (/ (* (+ 1 beat) sr) bps))))
- (set! (mark-sample mrk)
- (if (< (- samp lower) (- higher samp))
- lower
- higher))))))))
+(define snap-mark-to-beat
+ (let ((documentation "(snap-mark-to-beat) ensures that when a mark is dragged, its released position is always on a beat"))
+ (lambda ()
+ (let ((mark-release 4))
+ (hook-push mark-hook
+ (lambda (hook)
+ (let ((mrk (hook 'id))
+ (snd (hook 'snd))
+ (chn (hook 'chn))
+ (reason (hook 'reason)))
+ (if (= reason mark-release)
+ (let* ((samp (mark-sample mrk))
+ (bps (/ (beats-per-minute snd chn) 60.0))
+ (sr (srate snd))
+ (beat (floor (/ (* samp bps) sr)))
+ (lower (floor (/ (* beat sr) bps)))
+ (higher (floor (/ (* (+ 1 beat) sr) bps))))
+ (set! (mark-sample mrk)
+ (if (< (- samp lower) (- higher samp))
+ lower
+ higher)))))))))))
;;; -------- mark-explode
;;;
;;; write out each section of a file between marks as a separate file
-(define* (mark-explode (htype mus-next) (dformat mus-bfloat))
- "(mark-explode header-type data-format) splits a sound into a bunch of sounds based on mark placements"
- (let ((start 0)
- (file-ctr 0)
- (snd (or (selected-sound) (car (sounds)))))
- (for-each
- (lambda (mark)
- (let ((end (mark-sample mark)))
- (if (> end start)
- (let ((filename (format #f "mark-~D.snd" file-ctr)))
- (set! file-ctr (+ 1 file-ctr))
- (do ((i 0 (+ 1 i)))
- ((= i (channels snd)))
- (set! (selection-member? snd i) #t)
- (set! (selection-position snd i) start)
- (set! (selection-frames snd i) (- end start)))
- (save-selection filename :header-type htype :data-format dformat :srate (srate snd))
- (do ((i 0 (+ 1 i)))
- ((= i (channels snd)))
- (set! (selection-member? snd i) #f))))
- (set! start end)))
- (car (marks snd)))
- (update-time-graph snd)))
+(define mark-explode
+ (let ((documentation "(mark-explode header-type sample-type) splits a sound into a bunch of sounds based on mark placements"))
+ (lambda* ((htype mus-next) (dformat mus-bfloat))
+ (let ((start 0)
+ (file-ctr 0)
+ (snd (or (selected-sound) (car (sounds)))))
+ (for-each
+ (lambda (mark)
+ (let ((end (mark-sample mark)))
+ (if (> end start)
+ (let ((filename (format #f "mark-~D.snd" file-ctr)))
+ (set! file-ctr (+ 1 file-ctr))
+ (do ((i 0 (+ 1 i)))
+ ((= i (channels snd)))
+ (set! (selection-member? snd i) #t)
+ (set! (selection-position snd i) start)
+ (set! (selection-framples snd i) (- end start)))
+ (save-selection filename :header-type htype :sample-type dformat :srate (srate snd))
+ (do ((i 0 (+ 1 i)))
+ ((= i (channels snd)))
+ (set! (selection-member? snd i) #f))))
+ (set! start end)))
+ (car (marks snd)))
+ (update-time-graph snd)))))
;;; -------- save mark property lists
-(define (save-mark-properties)
- "(save-mark-properties) sets up an after-save-state-hook function to save any mark-properties"
-
- (define (open-appending filename)
- (open-output-file filename "a"))
-
- (define (close-appending fd)
- (close-output-port fd))
-
- (hook-push after-save-state-hook
- (lambda (filename)
- (let ((fd (open-appending filename)))
- (format fd "~%~%;;; from remember-mark-properties in marks.scm~%")
- (format fd "(if (not (defined? 'mark-property)) (load \"marks.scm\"))~%")
- (for-each
- (lambda (snd-m)
- (for-each
- (lambda (chn-m)
- (for-each
- (lambda (m)
- (let ((mp (mark-properties m)))
- (if (and mp
- (list? mp)
- (not (null? mp)))
- (let ((mhome (mark-home m))
- (msamp (mark-sample m)))
- (format fd "(let ((s (find-sound ~S)))~%" (file-name (car mhome)))
- (format fd " (if (sound? s)~%")
- (format fd " (let ((m (find-mark ~A s ~A)))~%" msamp (cadr mhome))
- (format fd " (if (mark? m)~%")
- (format fd " (set! (mark-properties m) '~A)))))~%" mp)))))
- chn-m))
- snd-m))
- (marks))
- (close-appending fd)))))
-
-
-(define (mark-click-info n)
- "(mark-click-info n) is a mark-click-hook function that describes a mark and its properties"
- (help-dialog "Mark Help"
- (format #f "Mark ~A~A:~% sample: ~D = ~,3F secs~A~A"
- n
- (let ((name (mark-name n)))
- (if (> (string-length name) 0)
- (format #f " (~S)" name)
- ""))
- (mark-sample n)
- (/ (mark-sample n) (srate (car (mark-home n))))
- (if (not (= (sync n) 0))
- (format #f "~% sync: ~A" (sync n))
- "")
- (let ((props (mark-properties n)))
- (if (and (list? props)
- (not (null? props)))
- (format #f "~% properties: '~A" props)
- ""))))
- #t)
+(define save-mark-properties
+ (let ((documentation "(save-mark-properties) sets up an after-save-state-hook function to save any mark-properties"))
+ (lambda ()
+
+ (define (open-appending filename)
+ (open-output-file filename "a"))
+
+ (define close-appending close-output-port)
+
+ (hook-push after-save-state-hook
+ (lambda (hook)
+ (let* ((filename (hook 'name))
+ (fd (open-appending filename)))
+ (format fd "~%~%;;; from remember-mark-properties in marks.scm~%")
+ (format fd "(if (not (defined? 'mark-property)) (load \"marks.scm\"))~%")
+ (for-each
+ (lambda (snd-m)
+ (for-each
+ (lambda (chn-m)
+ (for-each
+ (lambda (m)
+ (let ((mp (mark-properties m)))
+ (if (and mp
+ (pair? mp))
+ (let ((mhome (mark-home m))
+ (msamp (mark-sample m)))
+ (format fd "(let ((s (find-sound ~S)))~%" (file-name (car mhome)))
+ (format fd " (if (sound? s)~%")
+ (format fd " (let ((m (find-mark ~A s ~A)))~%" msamp (cadr mhome))
+ (format fd " (if (mark? m)~%")
+ (format fd " (set! (mark-properties m) '~A)))))~%" mp)))))
+ chn-m))
+ snd-m))
+ (marks))
+ (close-appending fd)))))))
+
+
+(define mark-click-info
+ (let ((documentation "(mark-click-info n) is a mark-click-hook function that describes a mark and its properties"))
+ (lambda (hook)
+ (let ((n (hook 'id)))
+ (help-dialog "Mark Help"
+ (format #f "Mark ~A~A:~% sample: ~D = ~,3F secs~A~A"
+ n
+ (let ((name (mark-name n)))
+ (if (> (length name) 0)
+ (format #f " (~S)" name)
+ ""))
+ (mark-sample n)
+ (* 1.0 (/ (mark-sample n) (srate (car (mark-home n)))))
+ (if (not (= (sync n) 0))
+ (format #f "~% sync: ~A" (sync n))
+ "")
+ (let ((props (mark-properties n)))
+ (if (pair? props)
+ (format #f "~% properties: '~A" props)
+ ""))))
+ (set! (hook 'result) #t)))))
#|
@@ -436,12 +419,12 @@
(define (eval-header sndf)
(and (string? (comment sndf))
(catch #t
- (lambda ()
- (eval-string (comment sndf)))
- (lambda args #f))))
+ (lambda ()
+ (eval-string (comment sndf)))
+ (lambda args #f))))
(define (marks->string sndf)
- (let ((str (format #f "(if (not (provided? 'snd-marks.scm)) (load \"marks.scm\"))~%(let ((m #f))~%"))
+ (let ((str (format #f "(require snd-marks.scm)~%(let ((m #f))~%"))
(chan 0))
(for-each
(lambda (chan-marks)
@@ -454,24 +437,47 @@
(mark-sample m)
chan
(if (and (string? (mark-name m))
- (> (string-length (mark-name m)) 0))
+ (> (length (mark-name m)) 0))
(format #f "~S" (mark-name m))
#f)
(sync m))))
- (if (not (null? (mark-properties m)))
+ (if (pair? (mark-properties m))
(set! str
(string-append str
(format #f
" (set! (mark-properties m) '~A)~%"
(mark-properties m))))))
- chan-marks)
+ chan-marks)
(set! chan (+ 1 chan)))
(marks sndf))
(string-append str (format #f " m)~%"))))
-
-(hook-push output-comment-hook (lambda (str) (marks->string (selected-sound))))
-(hook-push after-open-hook (lambda (snd) (eval-header snd)))
-|#
-
+(hook-push output-comment-hook (lambda (hook) (set! (hook 'result) (marks->string (selected-sound)))))
+(hook-push after-open-hook (lambda (hook) (set! (hook 'result) (eval-header (hook 'snd)))))
+|#
+#|
+;; from snd11?
+(define (delete-between-marks)
+ (let ((mx (marks 0 0)))
+ (if (and (pair? mx)
+ (pair? (cdr mx))) ; there are at least 2 marks
+ (let ((pos (cursor 0 0))
+ (deb #f)
+ (fin #f))
+ (for-each
+ (lambda (m)
+ (if (<= (mark-sample m) pos)
+ (set! deb (mark-sample m)))
+ (if (and (not fin)
+ (> (mark-sample m) pos))
+ (set! fin (mark-sample m))))
+ (sort! mx (lambda (a b)
+ (< (mark-sample a) (mark-sample b)))))
+ (when (and deb fin)
+ (let ((dur (- fin deb)))
+ (apply for-each
+ (lambda (s c)
+ (delete-samples deb dur s c))
+ (all-chans))))))))
+|#
diff --git a/maxf.scm b/maxf.scm
index 8898926..bde4364 100644
--- a/maxf.scm
+++ b/maxf.scm
@@ -4,6 +4,9 @@
;; Last: Tue Mar 25 04:32:23 CET 2003
;; Version: $Revision: 1.2 $
+;; array -> vector functions added by Bill S, 18-Apr-11
+;; defgenerator changes (Bill 25-Jul-12)
+
;; It follows the original header by Juan Reyes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -33,8 +36,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'snd-maxf.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-;;; (if (not (provided? 'snd-jcrev.scm)) (load "jcrev.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(define *locsig-type* mus-interp-sinusoidal)
@@ -44,55 +48,51 @@
(display str)
(snd-print str))))
-(defgenerator mvm
- (pp1 0.0 :type float) (pp2 0.0 :type float) (pp3 0.0 :type float)
- (yy1 0.0 :type float) (yy2 0.0 :type float)
- (zz1 0.0 :type float) (zz2 0.0 :type float)
- (out 0.0 :type float))
+(defgenerator mvm sample pp1 pp2 pp3 yy1 yy2 zz1 zz2 out)
+
+(define (mvmfilt b sample0)
+ (let-set! b 'sample sample0)
+ (with-let b
+ (set! yy2 (- (+ (* pp1 yy1)
+ (* pp2 zz1))
+ (* pp3 sample)))
+ (set! zz2 (- zz1 (* pp2 yy2)))
+ (set! zz1 zz2)
+ (set! yy1 yy2)
+ (set! out yy1)))
-(define-macro (mvmfilt b sample0)
- `(let ((sample ,sample0))
- (set! (mvm-yy2 ,b) (- (+ (* (mvm-pp1 ,b) (mvm-yy1 ,b))
- (* (mvm-pp2 ,b) (mvm-zz1 ,b)))
- (* (mvm-pp3 ,b) sample)))
- (set! (mvm-zz2 ,b) (- (mvm-zz1 ,b) (* (mvm-pp2 ,b) (mvm-yy2 ,b))))
- (set! (mvm-zz1 ,b) (mvm-zz2 ,b))
- (set! (mvm-yy1 ,b) (mvm-yy2 ,b))
- (set! (mvm-out ,b) (mvm-yy1 ,b))))
+(define pi2s (/ (* 2.0 pi) *clm-srate*))
+(define i2s (/ 2.0 *clm-srate*))
+(define tper (/ 1.0 *clm-srate*))
-(define-macro (set-coeffs nom ampl frequ decaying)
- `(let* ((b ,nom)
- (famp ,ampl)
- (ffreq ,frequ)
- (fdecay ,decaying)
- (tper (/ 1.0 (mus-srate)))
- (centerfreq (/ (* 2.0 pi ffreq) (mus-srate)))
- (maxdecay (/ (* 2.0 tper) (* centerfreq centerfreq)))
+(define (set-coeffs b famp ffreq fdecay)
+ (let ((centerfreq (* ffreq pi2s)))
+ (let ((maxdecay (/ (* 2.0 tper) (* centerfreq centerfreq)))
(mindecay (/ tper centerfreq)))
- ;; Conditions for JOS constraints
- ;; maxdecay: Filter may be unstable
- ;; mindecay: Filter may not oscillate
- (if (>= fdecay maxdecay)
- (set! fdecay maxdecay)
- (set! fdecay (* 1.0 fdecay)))
- (if (<= fdecay mindecay)
- (set! fdecay mindecay))
- (set! (mvm-pp1 b) (- 1.0 (/ 2.0 (* fdecay (mus-srate)))))
- (set! (mvm-pp2 b) (/ (* 2.0 pi ffreq) (mus-srate)))
- (set! (mvm-pp3 b) (* (mvm-pp2 b) famp))))
+ ;; Conditions for JOS constraints
+ ;; maxdecay: Filter may be unstable
+ ;; mindecay: Filter may not oscillate
+ (if (>= fdecay maxdecay)
+ (set! fdecay maxdecay)
+ (if (<= fdecay mindecay)
+ (set! fdecay mindecay)))
+ (set! (b 'pp1) (- 1.0 (/ i2s fdecay)))
+ (set! (b 'pp2) (* ffreq pi2s))
+ (set! (b 'pp3) (* (b 'pp2) famp)))))
+
+(define (make-array initial-value dim1 dim2) ; I'm guessing ...
+ (make-vector (list dim1 dim2) initial-value))
+
+(define (array-set! arr val i1 i2)
+ (set! (arr i1 i2) val))
+
+(define array-ref vector-ref)
+
+(define maxfilter
-(define* (maxfilter file beg
- (att 1.0)
- (numf 1)
- (freqfactor 1.0)
- (amplitude 1.0)
- (amp-env '(0 1 100 1))
- (degree (random 90.0))
- (distance 1.0)
- (reverb-amount 0.2))
- "(maxfilter file beg (att 1.0) (numf 1) (freqfactor 1.0)
- (amplitude 1.0) (amp-env '(0 1 100 1))
- (degree (random 90.0)) (distance 1.0) (reverb-amount 0.2))
+ (let ((documentation "(maxfilter file beg (att 1.0) (numf 1) (freqfactor 1.0)
+ (amplitude 1.0) (amp-env '(0 1 100 1))
+ (degree (random 90.0)) (distance 1.0) (reverb-amount 0.2))
This is Max Mathews (mvm) new filter (2002) High-Q, 2-Integrator,
filter with Two Poles, and one Zero at the Origin
@@ -111,230 +111,230 @@ the desired phase.
(numf 4) 4 filters
(numf 9) 9 filters
(numf 12) 12 filters
- (numf 13) 13 filters"
- (let* ((beg (floor (* beg (mus-srate))))
- (dur (mus-sound-duration file))
- (end (+ beg (floor (* dur (mus-srate)))))
- (rdA (make-readin :file file :channel 0))
- (formfil (make-mvm))
- (ampf (make-env :envelope amp-env :scaler amplitude :duration dur))
- (state-0 (make-array 0.0 1 3))
- (state-1 (make-array 0.0 12 3))
- (state-2 (make-array 0.0 9 3))
- (state-3 (make-array 0.0 13 3))
- (state-4 (make-array 0.0 4 3))
- (state-5 (make-array 0.0 2 3))
- (loc (make-locsig :degree degree
- :distance distance
- :reverb reverb-amount
- :type *locsig-type*)))
- (cond ((= numf 1)
- (snd-msg ";;;; State 0 (default): One filter~%")
- (array-set! state-0 7.54e-002 0 0)
- (array-set! state-0 (* 2000 freqfactor) 0 1)
- (array-set! state-0 2.0 0 2))
- ;;
- ((= numf 2)
- (snd-msg ";;;; State 5: Two filters~%")
- (array-set! state-5 7.54e-003 0 0)
- (array-set! state-5 (* 200.0 freqfactor) 0 1)
- (array-set! state-5 4.0 0 2)
- ;;
- (array-set! state-5 7.54e-004 1 0)
- (array-set! state-5 (* 800.0 freqfactor) 1 1)
- (array-set! state-5 1.0 1 2))
- ;;
- ((= numf 4)
- (snd-msg ";;;; State 4: Four filters~%")
- (array-set! state-4 7.54e-002 0 0)
- (array-set! state-4 (* 1000.0 freqfactor) 0 1)
- (array-set! state-4 0.5 0 2)
- ;;
- (array-set! state-4 3.225e-002 1 0)
- (array-set! state-4 (* 400.0 freqfactor) 1 1)
- (array-set! state-4 3.0 1 2)
- ;;
- (array-set! state-4 1.14e-002 2 0)
- (array-set! state-4 (* 800.0 freqfactor) 2 1)
- (array-set! state-4 2.8 2 2)
- ;;
- (array-set! state-4 7.54e-002 3 0)
- (array-set! state-4 (* 1600.0 freqfactor) 3 1)
- (array-set! state-4 1.0 3 2))
- ;;
- ((= numf 9)
- (snd-msg ";;;; State 2: Streached overtone string 9 filters~%")
- (array-set! state-2 1.07e-002 0 0)
- (array-set! state-2 100.0 0 1)
- (array-set! state-2 2.5 0 2)
- ;;
- (array-set! state-2 1.07e-002 1 0)
- (array-set! state-2 202.0 1 1)
- (array-set! state-2 0.75 1 2)
- ;;
- (array-set! state-2 1.07e-002 2 0)
- (array-set! state-2 305.0 2 1)
- (array-set! state-2 0.5 2 2)
- ;;
- (array-set! state-2 7.077e-003 3 0)
- (array-set! state-2 408.0 3 1)
- (array-set! state-2 0.4 3 2)
- ;;
- (array-set! state-2 1.07e-002 4 0)
- (array-set! state-2 501.0 4 1)
- (array-set! state-2 0.3 4 2)
- ;;
- (array-set! state-2 1.07e-002 5 0)
- (array-set! state-2 612.0 5 1)
- (array-set! state-2 0.25 5 2)
- ;;
- (array-set! state-2 1.07e-003 6 0)
- (array-set! state-2 715.0 6 1)
- (array-set! state-2 0.25 6 2)
- ;;
- (array-set! state-2 1.07e-002 7 0)
- (array-set! state-2 817.0 7 1)
- (array-set! state-2 0.2 7 2)
- ;;
- (array-set! state-2 1.07e-002 8 0)
- (array-set! state-2 920.0 8 1)
- (array-set! state-2 0.18 8 2))
- ;;
- ((= numf 12)
- (snd-msg ";;;; State 1: Risset bell long 12 filters~%")
- (array-set! state-1 5.025e-002 0 0)
- (array-set! state-1 224.0 0 1)
- (array-set! state-1 3.7 0 2)
- ;;
- (array-set! state-1 5.025e-002 1 0)
- (array-set! state-1 225.0 1 1)
- (array-set! state-1 3.3 1 2)
- ;;
- (array-set! state-1 5.025e-002 2 0)
- (array-set! state-1 368.0 2 1)
- (array-set! state-1 2.8 2 2)
- ;;
- (array-set! state-1 5.025e-002 3 0)
- (array-set! state-1 369.0 3 1)
- (array-set! state-1 2.4 3 2)
- ;;
- (array-set! state-1 1.047e-002 4 0)
- (array-set! state-1 476.0 4 1)
- (array-set! state-1 1.9 4 2)
- ;;
- (array-set! state-1 5.025e-002 5 0)
- (array-set! state-1 680.0 5 1)
- (array-set! state-1 1.7 5 2)
- ;;
- (array-set! state-1 5.025e-002 6 0)
- (array-set! state-1 800.0 6 1)
- (array-set! state-1 1.5 6 2)
- ;;
- (array-set! state-1 4.05e-002 7 0)
- (array-set! state-1 1096.0 7 1)
- (array-set! state-1 1.1 7 2)
- ;;
- (array-set! state-1 4.05e-002 8 0)
- (array-set! state-1 1099.0 8 1)
- (array-set! state-1 0.9 8 2)
- ;;
- (array-set! state-1 4.05e-002 9 0)
- (array-set! state-1 1200.0 9 1)
- (array-set! state-1 0.6 9 2)
- ;;
- (array-set! state-1 3.78e-002 10 0)
- (array-set! state-1 1504.0 10 1)
- (array-set! state-1 0.4 10 2)
- ;;
- (array-set! state-1 4.05e-002 11 0)
- (array-set! state-1 1628.0 11 1)
- (array-set! state-1 0.3 11 2))
- ;;
- ((= numf 13)
- (snd-msg ";;;; State 3: Open major chord with repeated octave 12 filters~%")
- (array-set! state-3 5.025e-002 0 0)
- (array-set! state-3 100.0 0 1)
- (array-set! state-3 2.0 0 2)
- ;;
- (array-set! state-3 5.025e-002 1 0)
- (array-set! state-3 251.0 1 1)
- (array-set! state-3 2.0 1 2)
- ;;
- (array-set! state-3 5.025e-002 2 0)
- (array-set! state-3 299.0 2 1)
- (array-set! state-3 2.0 2 2)
- ;;
- (array-set! state-3 5.025e-002 3 0)
- (array-set! state-3 401.0 3 1)
- (array-set! state-3 2.0 3 2)
- ;;
- (array-set! state-3 5.025e-002 4 0)
- (array-set! state-3 199.0 4 1)
- (array-set! state-3 2.0 4 2)
- ;;
- (array-set! state-3 5.025e-002 5 0)
- (array-set! state-3 501.0 5 1)
- (array-set! state-3 2.0 5 2)
- ;;
- (array-set! state-3 5.025e-002 6 0)
- (array-set! state-3 599.0 6 1)
- (array-set! state-3 2.0 6 2)
- ;;
- (array-set! state-3 5.025e-002 7 0)
- (array-set! state-3 801.0 7 1)
- (array-set! state-3 2.0 7 2)
- ;;
- (array-set! state-3 5.025e-002 8 0)
- (array-set! state-3 201.0 8 1)
- (array-set! state-3 2.0 8 2)
- ;;
- (array-set! state-3 5.025e-002 9 0)
- (array-set! state-3 749.0 9 1)
- (array-set! state-3 2.0 9 2)
- ;;
- (array-set! state-3 5.025e-002 10 0)
- (array-set! state-3 900.0 10 1)
- (array-set! state-3 2.0 10 2)
- ;;
- (array-set! state-3 5.025e-004 11 0)
- (array-set! state-3 1205.0 11 1)
- (array-set! state-3 2.0 11 2)
- ;;
- (array-set! state-3 5.025e-004 12 0)
- (array-set! state-3 1205.0 12 1)
- (array-set! state-3 2.0 12 2))
- (t
- (snd-msg "Please leave default or enter [1] [2] [4] [9] [12] [13]~%")
- (set! numf 1)))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (let ((outvalA (* att (readin rdA)))
- (add-fl 0))
- (do ((j 0 (+ 1 j)))
- ((= j numf))
- (cond ((= numf 1)
- (set-coeffs formfil (array-ref state-0 j 0)
- (array-ref state-0 j 1) (array-ref state-0 j 2)))
- ((= numf 2)
- (set-coeffs formfil (array-ref state-5 j 0)
- (array-ref state-5 j 1) (array-ref state-5 j 2)))
- ((= numf 4)
- (set-coeffs formfil (array-ref state-4 j 0)
- (array-ref state-4 j 1) (array-ref state-4 j 2)))
- ((= numf 9)
- (set-coeffs formfil (array-ref state-2 j 0)
- (array-ref state-2 j 1) (array-ref state-2 j 2)))
- ((= numf 12)
- (set-coeffs formfil (array-ref state-1 j 0)
- (array-ref state-1 j 1) (array-ref state-1 j 2)))
- ((= numf 13)
- (set-coeffs formfil (array-ref state-3 j 0)
- (array-ref state-3 j 1) (array-ref state-3 j 2))))
- (let ((filsig (mvmfilt formfil outvalA)))
- (set! add-fl (+ add-fl filsig))))
- (locsig loc i (* (env ampf) add-fl)))))))
+ (numf 13) 13 filters"))
+ (lambda* (file beg
+ (att 1.0)
+ (numf 1)
+ (freqfactor 1.0)
+ (amplitude 1.0)
+ (amp-env '(0 1 100 1))
+ (degree (random 90.0))
+ (distance 1.0)
+ (reverb-amount 0.2))
+ (let ((beg (floor (* beg *clm-srate*)))
+ (dur (mus-sound-framples file)))
+ (let ((formfil (make-mvm))
+ (end (+ beg dur))
+ (rdA (make-readin :file file :channel 0))
+ (ampf (make-env :envelope amp-env :scaler amplitude :length dur))
+ (state-0 (make-array 0.0 1 3))
+ (state-1 (make-array 0.0 12 3))
+ (state-2 (make-array 0.0 9 3))
+ (state-3 (make-array 0.0 13 3))
+ (state-4 (make-array 0.0 4 3))
+ (state-5 (make-array 0.0 2 3))
+ (loc (make-locsig :degree degree
+ :distance distance
+ :reverb reverb-amount
+ :type *locsig-type*)))
+ (cond ((= numf 1)
+ (snd-msg ";;;; State 0 (default): One filter~%")
+ (array-set! state-0 7.54e-002 0 0)
+ (array-set! state-0 (* 2000 freqfactor) 0 1)
+ (array-set! state-0 2.0 0 2))
+ ;;
+ ((= numf 2)
+ (snd-msg ";;;; State 5: Two filters~%")
+ (array-set! state-5 7.54e-003 0 0)
+ (array-set! state-5 (* 200.0 freqfactor) 0 1)
+ (array-set! state-5 4.0 0 2)
+ ;;
+ (array-set! state-5 7.54e-004 1 0)
+ (array-set! state-5 (* 800.0 freqfactor) 1 1)
+ (array-set! state-5 1.0 1 2))
+ ;;
+ ((= numf 4)
+ (snd-msg ";;;; State 4: Four filters~%")
+ (array-set! state-4 7.54e-002 0 0)
+ (array-set! state-4 (* 1000.0 freqfactor) 0 1)
+ (array-set! state-4 0.5 0 2)
+ ;;
+ (array-set! state-4 3.225e-002 1 0)
+ (array-set! state-4 (* 400.0 freqfactor) 1 1)
+ (array-set! state-4 3.0 1 2)
+ ;;
+ (array-set! state-4 1.14e-002 2 0)
+ (array-set! state-4 (* 800.0 freqfactor) 2 1)
+ (array-set! state-4 2.8 2 2)
+ ;;
+ (array-set! state-4 7.54e-002 3 0)
+ (array-set! state-4 (* 1600.0 freqfactor) 3 1)
+ (array-set! state-4 1.0 3 2))
+ ;;
+ ((= numf 9)
+ (snd-msg ";;;; State 2: Streached overtone string 9 filters~%")
+ (array-set! state-2 1.07e-002 0 0)
+ (array-set! state-2 100.0 0 1)
+ (array-set! state-2 2.5 0 2)
+ ;;
+ (array-set! state-2 1.07e-002 1 0)
+ (array-set! state-2 202.0 1 1)
+ (array-set! state-2 0.75 1 2)
+ ;;
+ (array-set! state-2 1.07e-002 2 0)
+ (array-set! state-2 305.0 2 1)
+ (array-set! state-2 0.5 2 2)
+ ;;
+ (array-set! state-2 7.077e-003 3 0)
+ (array-set! state-2 408.0 3 1)
+ (array-set! state-2 0.4 3 2)
+ ;;
+ (array-set! state-2 1.07e-002 4 0)
+ (array-set! state-2 501.0 4 1)
+ (array-set! state-2 0.3 4 2)
+ ;;
+ (array-set! state-2 1.07e-002 5 0)
+ (array-set! state-2 612.0 5 1)
+ (array-set! state-2 0.25 5 2)
+ ;;
+ (array-set! state-2 1.07e-003 6 0)
+ (array-set! state-2 715.0 6 1)
+ (array-set! state-2 0.25 6 2)
+ ;;
+ (array-set! state-2 1.07e-002 7 0)
+ (array-set! state-2 817.0 7 1)
+ (array-set! state-2 0.2 7 2)
+ ;;
+ (array-set! state-2 1.07e-002 8 0)
+ (array-set! state-2 920.0 8 1)
+ (array-set! state-2 0.18 8 2))
+ ;;
+ ((= numf 12)
+ (snd-msg ";;;; State 1: Risset bell long 12 filters~%")
+ (array-set! state-1 5.025e-002 0 0)
+ (array-set! state-1 224.0 0 1)
+ (array-set! state-1 3.7 0 2)
+ ;;
+ (array-set! state-1 5.025e-002 1 0)
+ (array-set! state-1 225.0 1 1)
+ (array-set! state-1 3.3 1 2)
+ ;;
+ (array-set! state-1 5.025e-002 2 0)
+ (array-set! state-1 368.0 2 1)
+ (array-set! state-1 2.8 2 2)
+ ;;
+ (array-set! state-1 5.025e-002 3 0)
+ (array-set! state-1 369.0 3 1)
+ (array-set! state-1 2.4 3 2)
+ ;;
+ (array-set! state-1 1.047e-002 4 0)
+ (array-set! state-1 476.0 4 1)
+ (array-set! state-1 1.9 4 2)
+ ;;
+ (array-set! state-1 5.025e-002 5 0)
+ (array-set! state-1 680.0 5 1)
+ (array-set! state-1 1.7 5 2)
+ ;;
+ (array-set! state-1 5.025e-002 6 0)
+ (array-set! state-1 800.0 6 1)
+ (array-set! state-1 1.5 6 2)
+ ;;
+ (array-set! state-1 4.05e-002 7 0)
+ (array-set! state-1 1096.0 7 1)
+ (array-set! state-1 1.1 7 2)
+ ;;
+ (array-set! state-1 4.05e-002 8 0)
+ (array-set! state-1 1099.0 8 1)
+ (array-set! state-1 0.9 8 2)
+ ;;
+ (array-set! state-1 4.05e-002 9 0)
+ (array-set! state-1 1200.0 9 1)
+ (array-set! state-1 0.6 9 2)
+ ;;
+ (array-set! state-1 3.78e-002 10 0)
+ (array-set! state-1 1504.0 10 1)
+ (array-set! state-1 0.4 10 2)
+ ;;
+ (array-set! state-1 4.05e-002 11 0)
+ (array-set! state-1 1628.0 11 1)
+ (array-set! state-1 0.3 11 2))
+ ;;
+ ((= numf 13)
+ (snd-msg ";;;; State 3: Open major chord with repeated octave 12 filters~%")
+ (array-set! state-3 5.025e-002 0 0)
+ (array-set! state-3 100.0 0 1)
+ (array-set! state-3 2.0 0 2)
+ ;;
+ (array-set! state-3 5.025e-002 1 0)
+ (array-set! state-3 251.0 1 1)
+ (array-set! state-3 2.0 1 2)
+ ;;
+ (array-set! state-3 5.025e-002 2 0)
+ (array-set! state-3 299.0 2 1)
+ (array-set! state-3 2.0 2 2)
+ ;;
+ (array-set! state-3 5.025e-002 3 0)
+ (array-set! state-3 401.0 3 1)
+ (array-set! state-3 2.0 3 2)
+ ;;
+ (array-set! state-3 5.025e-002 4 0)
+ (array-set! state-3 199.0 4 1)
+ (array-set! state-3 2.0 4 2)
+ ;;
+ (array-set! state-3 5.025e-002 5 0)
+ (array-set! state-3 501.0 5 1)
+ (array-set! state-3 2.0 5 2)
+ ;;
+ (array-set! state-3 5.025e-002 6 0)
+ (array-set! state-3 599.0 6 1)
+ (array-set! state-3 2.0 6 2)
+ ;;
+ (array-set! state-3 5.025e-002 7 0)
+ (array-set! state-3 801.0 7 1)
+ (array-set! state-3 2.0 7 2)
+ ;;
+ (array-set! state-3 5.025e-002 8 0)
+ (array-set! state-3 201.0 8 1)
+ (array-set! state-3 2.0 8 2)
+ ;;
+ (array-set! state-3 5.025e-002 9 0)
+ (array-set! state-3 749.0 9 1)
+ (array-set! state-3 2.0 9 2)
+ ;;
+ (array-set! state-3 5.025e-002 10 0)
+ (array-set! state-3 900.0 10 1)
+ (array-set! state-3 2.0 10 2)
+ ;;
+ (array-set! state-3 5.025e-004 11 0)
+ (array-set! state-3 1205.0 11 1)
+ (array-set! state-3 2.0 11 2)
+ ;;
+ (array-set! state-3 5.025e-004 12 0)
+ (array-set! state-3 1205.0 12 1)
+ (array-set! state-3 2.0 12 2))
+ (t
+ (snd-msg "Please leave default or enter [1] [2] [4] [9] [12] [13]~%")
+ (set! numf 1)))
+
+ (let ((run-state (case numf
+ ((1) state-0)
+ ((2) state-5)
+ ((4) state-4)
+ ((9) state-2)
+ ((12) state-1)
+ ((13) state-3))))
+
+ (do ((i beg (+ 1 i)))
+ ((= i end))
+ (let ((outvalA (* att (readin rdA)))
+ (add-fl 0.0))
+ (do ((j 0 (+ 1 j)))
+ ((= j numf))
+ (set-coeffs formfil (array-ref run-state j 0) (array-ref run-state j 1) (array-ref run-state j 2))
+ (set! add-fl (+ add-fl (mvmfilt formfil outvalA))))
+ (locsig loc i (* (env ampf) add-fl))))))))))
+
;; (let* ((ifile "dog.snd")
;; (ofile "gmax_dog.snd")
;; (snd (find-sound ofile))
diff --git a/misc.scm b/misc.scm
index 598b4ff..21ec2dd 100644
--- a/misc.scm
+++ b/misc.scm
@@ -2,34 +2,18 @@
(if (not (provided? 'snd-motif)) (snd-error "misc.scm only works in the Motif version of Snd."))
-(if (not (provided? 'snd-snd-motif.scm)) (load "snd-motif.scm"))
-(if (not (provided? 'snd-examp.scm)) (load "examp.scm"))
-(if (not (provided? 'snd-extensions.scm)) (load "extensions.scm"))
-(if (not (provided? 'snd-dsp.scm)) (load "dsp.scm"))
-(if (not (provided? 'snd-draw.scm)) (load "draw.scm"))
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
-(if (not (provided? 'snd-enved.scm)) (load "enved.scm"))
-(if (not (provided? 'snd-hooks.scm)) (load "hooks.scm"))
-(if (not (provided? 'snd-marks.scm)) (load "marks.scm"))
-(if (not (provided? 'snd-mix.scm)) (load "mix.scm"))
-(if (not (provided? 'snd-moog.scm)) (load "moog.scm"))
-(if (not (provided? 'snd-play.scm)) (load "play.scm"))
-(if (not (provided? 'snd-rubber.scm)) (load "rubber.scm"))
-(if (not (provided? 'snd-zip.scm)) (load "zip.scm"))
-(if (not (provided? 'snd-new-effects.scm)) (load "new-effects.scm"))
-(if (not (provided? 'snd-special-menu.scm)) (load "special-menu.scm"))
-(if (not (provided? 'snd-new-backgrounds.scm)) (load "new-backgrounds.scm"))
-(if (not (provided? 'snd-marks-menu.scm)) (load "marks-menu.scm"))
-(if (not (provided? 'snd-fft-menu.scm)) (load "fft-menu.scm"))
-(if (not (provided? 'snd-edit123.scm)) (load "edit123.scm"))
-(if (not (provided? 'snd-effects-utils.scm)) (load "effects-utils.scm"))
+(require snd-snd-motif.scm snd-examp.scm snd-extensions.scm snd-dsp.scm snd-draw.scm snd-env.scm snd-enved.scm)
+(require snd-hooks.scm snd-marks.scm snd-mix.scm snd-moog.scm snd-play.scm snd-rubber.scm snd-zip.scm snd-edit123.scm)
+(require snd-new-effects.scm snd-special-menu.scm snd-new-backgrounds.scm snd-marks-menu.scm snd-fft-menu.scm snd-effects-utils.scm)
+
+(with-let *motif*
(keep-file-dialog-open-upon-ok)
-(set! (ask-about-unsaved-edits) #t)
+(set! *ask-about-unsaved-edits* #t)
(if (not (hook-member show-disk-space after-open-hook))
(hook-push after-open-hook show-disk-space))
-;(define wd (make-pixmap (cadr (main-widgets)) rough))
+;(define wd (make-pixmap (cadr (main-widgets)) rough)) ; this comes from new-backgrounds.scm
;(for-each-child (cadr (main-widgets)) (lambda (w) (XtSetValues w (list XmNbackgroundPixmap wd))))
(define wd (make-pixmap (cadr (main-widgets)) rough))
@@ -62,10 +46,13 @@
(paint-all w)))
(dialog-widgets))
-(if (not (hook-member paint-all new-widget-hook))
- (hook-push new-widget-hook paint-all))
+(define (hook-paint-all hook)
+ (paint-all (hook 'widget)))
+
+(if (not (hook-member hook-paint-all new-widget-hook))
+ (hook-push new-widget-hook hook-paint-all))
-(set! (mix-waveform-height) 32)
+(set! *mix-waveform-height* 32)
;;; (with-level-meters 2)
@@ -104,8 +91,8 @@
;;;
;(hook-push after-open-hook
-; (lambda (snd)
-; (XtUnmanageChild (find-child (list-ref (sound-widgets snd) 2) "play"))))
+; (lambda (hook)
+; (XtUnmanageChild (find-child (list-ref (sound-widgets (hook 'snd)) 2) "play"))))
;;;
@@ -145,16 +132,16 @@
XmNdialogTitle titlestr
XmNresizePolicy XmRESIZE_GROW
XmNnoResize #f
- XmNbackground (basic-color)
+ XmNbackground *basic-color*
XmNtransient #f))))
(for-each
(lambda (button color)
(XtVaSetValues
(XmMessageBoxGetChild new-dialog button)
- (list XmNarmColor (selection-color)
+ (list XmNarmColor *selection-color*
XmNbackground color)))
(list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
- (list (highlight-color) (highlight-color) (highlight-color)))
+ (list *highlight-color* *highlight-color* *highlight-color*))
(XtAddCallback new-dialog XmNcancelCallback
(lambda (w c i) (XtUnmanageChild w)))
@@ -167,12 +154,13 @@
(lambda (w c i)
(let ((new-name (XmTextFieldGetString rename-text)))
(if (and (string? new-name)
- (> (string-length new-name) 0)
+ (> (length new-name) 0)
(>= (selected-sound) 0))
- (let ((current-name (file-name)))
+ (let ();(current-name (file-name)))
(save-sound-as new-name)
(close-sound)
- (rename-file current-name new-name)
+ ;(rename-file current-name new-name)
+ ;; (delete-file current-name) perhaps?
(open-sound new-name)
(XtUnmanageChild w))))))
(XmStringFree xhelp)
@@ -187,13 +175,13 @@
XmNbottomAttachment XmATTACH_WIDGET
XmNbottomWidget (XmMessageBoxGetChild rename-dialog XmDIALOG_SEPARATOR)
XmNorientation XmVERTICAL
- XmNbackground (basic-color))))
+ XmNbackground *basic-color*)))
(label (XtCreateManagedWidget "new name:" xmLabelWidgetClass mainform
(list XmNleftAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color)))))
+ XmNbackground *basic-color*))))
(set! rename-text
(XtCreateManagedWidget "newname" xmTextFieldWidgetClass mainform
(list XmNleftAttachment XmATTACH_WIDGET
@@ -201,14 +189,14 @@
XmNrightAttachment XmATTACH_FORM
XmNtopAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color))))
+ XmNbackground *basic-color*)))
(XtAddEventHandler rename-text EnterWindowMask #f
(lambda (w context ev flag)
(XmProcessTraversal w XmTRAVERSE_CURRENT)
(XtSetValues w (list XmNbackground (white-pixel)))))
(XtAddEventHandler rename-text LeaveWindowMask #f
(lambda (w context ev flag)
- (XtSetValues w (list XmNbackground (basic-color))))))))
+ (XtSetValues w (list XmNbackground *basic-color*)))))))
(if (not (XtIsManaged rename-dialog))
(XtManageChild rename-dialog)
(raise-dialog rename-dialog)))
@@ -244,7 +232,7 @@
(define (append-selection)
(if (selection?)
- (insert-selection (frames))))
+ (insert-selection (framples))))
(add-to-menu 1 "Append Selection" append-selection)
@@ -253,7 +241,7 @@
(define (replace-with-selection)
(let ((beg (cursor))
- (len (selection-frames)))
+ (len (selection-framples)))
(delete-samples beg len)
(insert-selection beg)))
@@ -268,16 +256,16 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(hook-push open-raw-sound-hook
- (lambda (file choices)
- (list 2 44100 (if (little-endian?) mus-lshort mus-bshort))))
+ (lambda (hook)
+ (set! (hook 'result) (list 2 44100 (if (little-endian?) mus-lshort mus-bshort)))))
(hook-push open-hook
- (lambda (filename)
- (if (= (mus-sound-header-type filename) mus-raw)
- (let ((rawfile (string-append filename ".raw")))
- (system (format #f "mpg123 -s ~A > ~A" filename rawfile))
- rawfile)
- #f)))
+ (lambda (hook)
+ (let ((filename (hook 'name)))
+ (if (= (mus-sound-header-type filename) mus-raw)
+ (let ((rawfile (string-append filename ".raw")))
+ (system (format #f "mpg123 -s ~A > ~A" filename rawfile))
+ (set! (hook 'result) rawfile))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -286,16 +274,16 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(hook-push open-raw-sound-hook
- (lambda (file choices)
- (list 2 44100 (if (little-endian?) mus-lshort mus-bshort))))
+ (lambda (hook)
+ (set! (hook 'result) (list 2 44100 (if (little-endian?) mus-lshort mus-bshort)))))
(hook-push open-hook
- (lambda (filename)
- (if (= (mus-sound-header-type filename) mus-raw)
- (let ((rawfile (string-append filename ".raw")))
- (system (format #f "ogg123 -d raw -f ~A ~A" rawfile filename))
- rawfile)
- #f)))
+ (lambda (hook)
+ (let ((filename (hook 'name)))
+ (if (= (mus-sound-header-type filename) mus-raw)
+ (let ((rawfile (string-append filename ".raw")))
+ (system (format #f "ogg123 -d raw -f ~A ~A" rawfile filename))
+ (set! (hook 'result) rawfile))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -321,3 +309,4 @@
(define deselect-all unselect-all)
+)
diff --git a/mix.fs b/mix.fs
index b3c88be..c08eebb 100644
--- a/mix.fs
+++ b/mix.fs
@@ -1,175 +1,202 @@
-\ -*- snd-forth -*-
\ mix.fs -- mix.scm -> mix.fs
\ Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Tue Oct 11 18:23:12 CEST 2005
-\ Changed: Thu Apr 15 15:58:17 CEST 2010
+\ Created: 05/10/11 18:23:12
+\ Changed: 14/04/27 16:13:40
+\
+\ @(#)mix.fs 1.35 4/27/14
\ Commentary:
\
\ ;;; various mix related functions
\
-\ mix-sound ( file start -- mix-id )
-\ silence-all-mixes ( -- )
-\ find-mix ( sample snd chn -- mx )
-\ mix->vct ( id -- vct )
-\ save-mix ( id filename -- )
-\ mix-maxamp ( id -- max-amp )
-\ snap-mix-to-beat ( at-tag-position -- )
+\ mix-sound ( file start -- mix-id )
+\ silence-all-mixes ( -- )
+\ find-mix ( sample snd chn -- mx )
+\ mix->vct ( id -- vct )
+\ mix-maxamp ( id -- max-amp )
+\ snap-mix-to-beat ( at-tag-position -- )
\
-\ mix-click-sets-amp ( id -- #t )
-\ mix-click-info ( id -- #t )
-\ mix-name->id ( name -- id )
+\ mix-click-sets-amp ( id -- #t )
+\ mix-click-info ( id -- #t )
+\ mix-name->id ( name -- id )
\
-\ delete-mix ( id -- val )
-\ scale-mixes ( mix-list scl -- )
-\ silence-mixes ( mix-list -- )
-\ move-mixes ( mix-list samps -- )
-\ src-mixes ( mix-list sr -- )
-\ transpose-mixes ( mix-list semitones -- )
-\ color-mixes ( mix-list col -- )
-\ set-mixes-tag-y ( mix-list new-y -- )
-\ mixes-maxamp ( mix-list -- mx )
-\ scale-tempo ( mix-list tempo-scl -- )
-\ mixes-length ( mix-list -- len )
-\ save-mixes ( mix-list filename -- )
+\ delete-mix ( id -- val )
+\ scale-mixes ( mix-list scl -- )
+\ silence-mixes ( mix-list -- )
+\ move-mixes ( mix-list samps -- )
+\ src-mixes ( mix-list sr -- )
+\ transpose-mixes ( mix-list semitones -- )
+\ color-mixes ( mix-list col -- )
+\ set-mixes-tag-y ( mix-list new-y -- )
+\ mixes-maxamp ( mix-list -- mx )
+\ scale-tempo ( mix-list tempo-scl -- )
+\ mixes-length ( mix-list -- len )
require clm
require examp
: tree-for-each ( proc-or-xt tree -- )
- doc" Applies PROC-OR-XT to every leaf of TREE."
- { proc-or-xt tree }
- tree nil? unless
- tree cons? if
- proc-or-xt tree car recurse
- proc-or-xt tree cdr recurse
- else
- proc-or-xt proc? if proc-or-xt '( tree ) run-proc drop then
- then
- then
+ doc" Apply PROC-OR-XT to every leaf of TREE."
+ { proc-or-xt tree }
+ tree nil? unless
+ tree cons? if
+ proc-or-xt tree car recurse
+ proc-or-xt tree cdr recurse
+ else
+ proc-or-xt proc? if
+ proc-or-xt '( tree ) run-proc drop
+ else
+ tree proc-or-xt execute
+ then
+ then
+ then
;
: mix-sound <{ file :optional start 0 -- id }>
- doc" Mixes FILE (all chans) at START in the currently selected sound."
- file start #t undef undef undef undef mix
+ doc" Mix FILE (all chans) at START in the currently selected sound."
+ file start #t undef undef undef undef mix
;
hide
-: silence-mix-xt <{ id -- }> id 0.0 set-mix-amp drop ;
-: silence-all-mixes-cb <{ -- }> <'> silence-mix-xt undef undef mixes tree-for-each ;
+: silence-mix-xt <{ id -- }>
+ id 0.0 set-mix-amp drop
+;
+
+: silence-all-mixes-cb <{ -- }>
+ <'> silence-mix-xt undef undef mixes tree-for-each
+;
set-current
+
: silence-all-mixes ( -- )
- doc" Sets all mix amps to 0."
- <'> silence-all-mixes-cb undef as-one-edit drop
+ doc" Set all mix amps to 0."
+ <'> silence-all-mixes-cb undef as-one-edit drop
;
previous
: find-mix <{ samp :optional snd #f chn #f -- mx }>
- doc" Returns the id of the mix at the given SAMPLE, or #f."
- #f \ flag
- snd snd-snd chn snd-chn mixes each { id }
- id mix-position samp d= if
- drop \ drop flag
- id
- leave
- then
- end-each
+ doc" Return the id of the mix at the given SAMPLE, or #f."
+ #f \ flag
+ snd snd-snd chn snd-chn mixes each { id }
+ id mix-position samp d= if
+ drop \ drop flag
+ id \ return ID
+ leave
+ then
+ end-each
;
: mix->vct ( id -- v )
- doc" Returns mix's data in vct."
- { id }
- id mix? false? if 'no-such-mix #( get-func-name id ) fth-throw then
- id 0 make-mix-sampler { reader }
- id mix-length 0.0 make-vct map! reader read-mix-sample end-map
- reader free-sampler drop
-;
-
-: save-mix ( id fname -- )
- doc" Saves mix data (as floats) in FILENAME."
- { id fname }
- id mix->vct { v }
- fname #f srate mus-sound-open-output { fd }
- fd 0 v vct-length 1- 1 v undef undef vct->sound-data mus-sound-write drop
- fd v vct-length 4 * mus-sound-close-output drop
+ doc" Return mix's data in vct."
+ { id }
+ id mix? unless
+ 'no-such-mix #( "%s: %s" get-func-name id ) fth-throw
+ then
+ id 0 make-mix-sampler { reader }
+ id mix-length 0.0 make-vct map!
+ reader read-mix-sample
+ end-map
+ reader free-sampler drop
;
: mix-maxamp ( id -- max-amp )
- doc" Returns the max amp in the given mix."
- mix->vct vct-peak
+ doc" Return the max amp in the given mix."
+ mix->vct vct-peak
;
hide
-: snap-mix-to-beat-cb ( id samps self -- #t )
- { id samps self }
- id mix-position samps + { samp }
- id mix-home 0 array-ref { snd }
- id mix-home 1 array-ref { chn }
- snd chn beats-per-minute 60.0 f/ { bps }
- snd srate { sr }
- samp bps f* sr f/ floor { beat }
- beat sr f* bps f/ floor f>s { lower }
- beat 1.0 f+ sr f* bps f/ floor f>s { higher }
- id
- samp lower - higher samp - < if 0 lower max else higher then set-mix-position drop
- #t
+: snap-mix-to-beat-cb { id samps self -- #t }
+ id mix-position samps + { samp }
+ id mix-home 0 array-ref { snd }
+ id mix-home 1 array-ref { chn }
+ snd chn beats-per-minute 60.0 f/ { bps }
+ snd srate { sr }
+ samp bps f* sr f/ floor { beat }
+ beat sr f* bps f/ floor f>s { lower }
+ beat 1.0 f+ sr f* bps f/ floor f>s { higher }
+ id
+ samp lower - higher samp - < if
+ 0 lower max
+ else
+ higher
+ then set-mix-position drop
+ #t
;
set-current
+
: snap-mix-to-beat <{ -- }>
- doc" Forces a dragged mix to end up on a beat (see beats-per-minute). \
+ doc" Force a dragged mix to end up on a beat (see beats-per-minute). \
Resets mix-release-hook to cancel."
- mix-release-hook snap-mix-to-beat-cb add-hook!
+ mix-release-hook snap-mix-to-beat-cb add-hook!
;
previous
\ --- Mix Property ---
: mix-click-sets-amp <{ id -- #t }>
- 'zero id mix-property not if
- 'amp id id mix-amp set-mix-property drop
- id 0.0 set-mix-amp drop
- 'zero id #t set-mix-property
- else
- id 'amp id mix-property set-mix-amp drop
- 'zero id #f set-mix-property
- then drop
- #t \ #t --> omit default action
+ 'zero id mix-property not if
+ 'amp id id mix-amp set-mix-property drop
+ id 0.0 set-mix-amp drop
+ 'zero id #t set-mix-property
+ else
+ id 'amp id mix-property set-mix-amp drop
+ 'zero id #f set-mix-property
+ then drop
+ #t \ #t --> omit default action
;
\ mix-click-hook <'> mix-click-sets-amp add-hook!
\ mix-click-info
: mix-click-info <{ id -- #t }>
- doc" A mix-click-hook function that describes a mix and its properties.\n\
-mix-click-hook <'> mix-click-info add-hook!"
- id mix-home 0 array-ref { mid }
- id mix-name empty? if "" else $" (%S)" #( id mix-name ) string-format then { mname }
- $" mix id: %s%s\n" #( id mname ) string-format make-string-output-port { prt }
- prt $" position: %d (%.3f secs)\n" #( id mix-position dup mid srate f/ ) port-puts-format
- prt $" length: %d (%.3f secs)\n" #( id mix-length dup mid srate f/ ) port-puts-format
- prt $" in: %s[%d]\n" #( mid short-file-name id mix-home 1 array-ref ) port-puts-format
- prt $" scaler: %s\n" #( id mix-amp ) port-puts-format
- prt $" speed: %.3f\n" #( id mix-speed ) port-puts-format
- prt $" env: %s\n" #( id mix-amp-env ) port-puts-format
- id mix-properties { props }
- props empty? unless prt $" properties: %s\n" #( props ) port-puts-format then
- $" Mix info" prt port->string info-dialog drop
- #t
+ doc" A mix-click-hook function that describes a \
+mix and its properties.\n\
+mix-click-hook <'> mix-click-info add-hook!."
+ id mix-home 0 array-ref { mid }
+ id mix-name empty? if
+ ""
+ else
+ " (%S)" #( id mix-name ) string-format
+ then { mname }
+ " mix id: %s%s\n" #( id mname )
+ string-format make-string-output-port { prt }
+ prt " position: %d (%.3f secs)\n"
+ #( id mix-position dup mid srate f/ ) port-puts-format
+ prt " length: %d (%.3f secs)\n"
+ #( id mix-length dup mid srate f/ ) port-puts-format
+ prt " in: %s[%d]\n"
+ #( mid short-file-name id mix-home 1 array-ref ) port-puts-format
+ prt " scaler: %s\n" #( id mix-amp ) port-puts-format
+ prt " speed: %.3f\n" #( id mix-speed ) port-puts-format
+ prt " env: %s\n" #( id mix-amp-env ) port-puts-format
+ id mix-properties { props }
+ props empty? unless
+ prt " properties: %s\n" #( props ) port-puts-format
+ then
+ "Mix info" prt port->string info-dialog drop
+ #t
;
\ mix-click-hook <'> mix-click-info add-hook!
\ ;;; -------- mix-name->id
-: mix-name->id { name -- mx }
- doc" Returns the mix id associated with NAME."
- #f
- sounds each { snd }
- snd channels 0 do
- snd i ( chn ) mixes each { mx }
- mx mix-name name string= if drop mx exit then
- end-each
- loop
- end-each dup false? if drop 'no-such-mix #( get-func-name name ) fth-throw then
+: mix-name->id ( name -- mx )
+ doc" Return the mix id associated with NAME."
+ { name }
+ #f \ flag
+ sounds each { snd }
+ snd channels 0 do
+ snd i ( chn ) mixes each { mx }
+ mx mix-name name string= if
+ drop \ flag
+ mx \ return value
+ exit \ leave word with mx on TOS
+ then
+ end-each
+ loop
+ end-each dup unless
+ drop
+ 'no-such-mix #( "%s: %S" get-func-name name ) fth-throw
+ then
;
\ ;;; ---------------- backwards compatibilty
@@ -179,91 +206,126 @@ mix-click-hook <'> mix-click-info add-hook!"
\ ;;; -------- mix lists (used to be "tracks"
hide
: scale-mixes-cb { mix-list scl -- prc; self -- }
- 0 proc-create mix-list , scl , ( prc )
- does> { self -- }
- self cell+ @ { scl }
- self @ each dup mix-amp scl f* set-mix-amp drop end-each
+ 0 proc-create ( prc )
+ mix-list , scl ,
+ does> { self -- }
+ self cell+ @ { scl }
+ self @ ( mix-list ) each { mx }
+ mx mix-amp scl f* { val }
+ mx val set-mix-amp drop
+ end-each
;
set-current
-: scale-mixes ( mix-list scl -- ) scale-mixes-cb undef as-one-edit drop ;
+: scale-mixes ( mix-list scl -- )
+ scale-mixes-cb undef as-one-edit drop
+;
+
previous
-: silence-mixes ( mix-list -- ) 0.0 scale-mixes ;
+: silence-mixes ( mix-list -- )
+ 0.0 scale-mixes
+;
hide
: move-mixes-cb { mix-list samps -- prc; self -- }
- 0 proc-create mix-list , samps , ( prc )
- does> { self -- }
- self cell+ @ { samps }
- self @ each dup mix-position samps + set-mix-position drop end-each
+ 0 proc-create ( prc )
+ mix-list , samps ,
+ does> { self -- }
+ self cell+ @ { samps }
+ self @ ( mix-list ) each { mx }
+ mx mix-position samps + { val }
+ mx val set-mix-position drop
+ end-each
;
set-current
-: move-mixes ( mix-list samps -- ) move-mixes-cb undef as-one-edit drop ;
+
+: move-mixes ( mix-list samps -- )
+ move-mixes-cb undef as-one-edit drop
+;
previous
hide
: src-mixes-cb { mix-list sr -- prc; self -- }
- 0 proc-create mix-list , sr , ( prc )
- does> { self -- }
- self cell+ @ { sr }
- self @ each dup mix-speed sr f* set-mix-speed drop end-each
+ 0 proc-create ( prc )
+ mix-list , sr ,
+ does> { self -- }
+ self cell+ @ { sr }
+ self @ ( mix-list ) each { mx }
+ mx mix-speed sr f* { val }
+ mx val set-mix-speed drop
+ end-each
;
set-current
-: src-mixes ( mix-list sr -- ) src-mixes-cb undef as-one-edit drop ;
+
+: src-mixes ( mix-list sr -- )
+ src-mixes-cb undef as-one-edit drop
+;
previous
: transpose-mixes ( mix-list semitones -- )
- doc" Transposes each mix in mix-list by semitones."
- 12.0 f/ 2.0 swap f** src-mixes
+ doc" Transpose each mix in mix-list by semitones."
+ 12.0 f/ 2.0 swap f** src-mixes
;
'snd-nogui provided? [unless]
- : color-mixes ( mix-list col -- ) { col } each { m } m col set-mix-color drop end-each ;
- : set-mixes-tag-y ( mix-list new-y -- ) { new-y } each { m } m new-y set-mix-tag-y drop end-each ;
- : mixes-maxamp ( mix-list -- mx ) 0.0 swap each { m } m mix-maxamp fmax end-each ;
+ : color-mixes { mix-list col -- }
+ mix-list each { mx }
+ mx col set-mix-color drop
+ end-each
+ ;
+
+ : set-mixes-tag-y { mix-list new-y -- }
+ mix-list each { mx }
+ mx new-y set-mix-tag-y drop
+ end-each
+ ;
+
+ : mixes-maxamp { mix-list -- amp }
+ 0.0 { amp }
+ mix-list each { mx }
+ mx mix-maxamp amp fmax to amp
+ end-each
+ amp
+ ;
[then]
hide
: scale-tempo-cb { mix-list tempo-scl first-beg -- prc; self -- }
- 0 proc-create mix-list , tempo-scl , first-beg , ( prc )
- does> { self -- }
- self cell+ @ { tempo-scl }
- self 2 cells + @ { first-beg }
- self @ each { m }
- m mix-position first-beg - tempo-scl f* f>s { diff }
- diff 0<> if m first-beg diff + set-mix-position drop then
- end-each
+ 0 proc-create ( prc )
+ mix-list , tempo-scl , first-beg ,
+ does> { self -- }
+ self @ { mix-list }
+ self cell+ @ { tempo-scl }
+ self 2 cells + @ { first-beg }
+ mix-list each { mx }
+ mx mix-position first-beg - tempo-scl f* f>s { diff }
+ diff 0<> if
+ mx first-beg diff + set-mix-position drop
+ then
+ end-each
;
set-current
-: scale-tempo ( mix-list tempo-scl -- )
- { mix-list tempo-scl }
- mix-list 0 array-ref mix-position dup { first-beg last-beg }
- mix-list 1 nil array-subarray each { m }
- m mix-position { pos }
- first-beg pos min to first-beg
- last-beg pos max to last-beg
- end-each
- mix-list tempo-scl first-beg scale-tempo-cb undef as-one-edit drop
+
+: scale-tempo { mix-list tempo-scl -- }
+ mix-list 0 array-ref mix-position dup { first-beg last-beg }
+ mix-list 1 nil array-subarray each { mx }
+ mx mix-position { pos }
+ first-beg pos min to first-beg
+ last-beg pos max to last-beg
+ end-each
+ mix-list tempo-scl first-beg scale-tempo-cb undef as-one-edit drop
;
previous
\ ;;; reverse-mix-list is mix-list -1.0 scale-tempo
-: mixes-length ( mix-list -- len )
- { mix-list }
- 0 mix-list each { m } m mix-position m mix-length + max end-each
- 0 mix-list each mix-position min end-each - 1+
-;
-
-: save-mixes ( mix-list filename -- )
- { mix-list filename }
- mix-list mix-length { len }
- 0 mix-list each mix-position min end-each { beg }
- len 0.0 make-vct { data }
- mix-list each { m } data m mix->vct m mix-position beg - vct-add! drop end-each
- filename #f srate 1 #f #f "" mus-sound-open-output { fd }
- fd 0 len 1- 1 data vct->sound-data mus-sound-write drop
- fd 4 data vct-length * mus-sound-close-output drop
+: mixes-length { mix-list -- len }
+ 0 ( maxlen ) mix-list each { mx }
+ ( maxlen ) mx mix-position mx mix-length + max
+ end-each ( maxlen )
+ 0 ( minlen ) mix-list each { mx }
+ ( minlen ) mx mix-position min
+ end-each ( maxlen minlen ) - 1+
;
\ mix.fs ends here
diff --git a/mix.rb b/mix.rb
index 34e8ef6..aa35449 100644
--- a/mix.rb
+++ b/mix.rb
@@ -1,11 +1,9 @@
-# mix.rb -- mix.scm --> mix.rb -*- snd-ruby -*-
+# mix.rb -- mix.scm --> mix.rb
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Tue Feb 22 13:40:33 CET 2005
-# Changed: Sat Feb 06 18:21:12 CET 2010
+# Created: 05/02/22 13:40:33
+# Changed: 14/11/13 05:01:39
-# Commentary:
-#
# various mix related functions
#
# module Mix (see mix.scm)
@@ -13,7 +11,6 @@
# silence_all_mixes
# find_mix(sample, snd, chn)
# mix2vct(id)
-# save_mix(id, filename)
# mix_maxamp(id)
# snap_mix_to_beat(at_tag_position)
#
@@ -32,32 +29,6 @@
# mixes_maxamp(mix_list)
# scale_tempo(mix_list, tempo_scl)
# mixes_length(mix_list)
-# save_mixes(mix_list, filename)
-#
-# module Mixer_matrix (see mixer.scm)
-# mixer_copy(mx)
-# make_zero_mixer(n)
-# mixer_diagonal?(mx)
-# mixer_transpose(mx)
-# sub_matrix(mx, row, col)
-# mixer_determinant(mx)
-# mixer_poly(mx, *coeffs)
-# mixer_trace(mx)
-# invert_matrix(mx, b, zero)
-# mixer_solve(a, b)
-# mixer_inverse(mx)
-#
-# mixer_equal?(mx1, mx2)
-# mixer_normal?(mx)
-# mixer_orthogonal?(mx)
-# mixer_unitary?(mx)
-# mixer_symmetric?(mx)
-# mixer_hermitian?(mx)
-#
-# frame_reverse(fr)
-#
-
-# Code:
require "clm"
@@ -66,59 +37,64 @@ module Mix
# === MIX ===
#
add_help(:mix_sound,
- "mix(sound(file, start) \
-mixes file (all chans) at start in the currently selected sound.")
+ "mix_sound(file, start) \
+Mixes file (all chans) at start in the currently selected sound.")
def mix_sound(file, start)
mix(file, start, true)
end
- add_help(:delete_all_mixes, "delete_all_mixes() sets all mix amps to 0.")
+ add_help(:delete_all_mixes,
+ "delete_all_mixes() \
+Sets all mix amps to 0.")
def silence_all_mixes
- as_one_edit_rb(get_func_name) do (mixes or []).flatten.each do |id| set_mix_amp(id, 0.0) end end
+ as_one_edit_rb(get_func_name) do
+ (mixes or []).flatten.each do |id|
+ set_mix_amp(id, 0.0)
+ end
+ end
end
add_help(:find_mix,
- "find_mix(sample, [snd=false, [chn=false]]) \
-returns the id of the mix at the given sample, or nil.")
+ "find_mix(sample, snd=false, chn=false) \
+Returns the id of the mix at the given sample, or nil.")
def find_mix(sample, snd = false, chn = false)
- (mixes(Snd.snd(snd), Snd.chn(chn)) or []).detect do |n| mix_position(n) == sample end
+ (mixes(Snd.snd(snd), Snd.chn(chn)) or []).detect do |n|
+ mix_position(n) == sample
+ end
end
- add_help(:mix2vct, "mix2vct(id) returns mix's data in vct.")
+ add_help(:mix2vct,
+ "mix2vct(id) \
+Returns mix's data in vct.")
def mix2vct(id)
Snd.raise(:no_such_mix, id) unless mix?(id)
len = mix_length(id)
rd = make_mix_sampler(id)
- v = Vct.new(len) do |i| read_mix_sample(rd) end
+ v = Vct.new(len) do |i|
+ read_mix_sample(rd)
+ end
free_sampler(rd)
v
end
- unless defined? save_mix
- add_help(:save_mix, "save_mix(id, filename) saves mix data (as floats) in file FILENAME.")
- def save_mix(id, filename)
- Snd.raise(:no_such_mix, id) unless mix?(id)
- v = mix2vct(id)
- fd = mus_sound_open_output(filename, srate(), 1, false, false, "")
- mus_sound_write(fd, 0, v.length - 1, 1, vct2sound_data(v))
- mus_sound_close_output(fd, 4 * v.length)
- end
- end
-
- add_help(:mix_maxamp, "mix_maxamp(id) returns the max amp in the given mix.")
+ add_help(:mix_maxamp,
+ "mix_maxamp(id) \
+Returns the max amp in the given mix.")
def mix_maxamp(id)
Snd.raise(:no_such_mix, id) unless mix?(id)
len = mix_length(id)
rd = make_mix_sampler(id)
peak = read_mix_sample(rd).abs
- (1...len).each do peak = [peak, read_mix_sample(rd).abs].max end
+ (1...len).each do
+ peak = [peak, read_mix_sample(rd).abs].max
+ end
free_sampler(rd)
peak
end
add_help(:snap_mix_to_beat,
- "snap_mix_to_beat() \
-forces a dragged mix to end up on a beat (see beats-per-minute). \
+ "snap_mix_to_beat() \
+Forces a dragged mix to end up on a beat (see beats-per-minute). \
Reset $mix_release_hook to cancel.")
def snap_mix_to_beat
$mix_release_hook.add_hook!(get_func_name) do |id, samps_moved|
@@ -153,17 +129,32 @@ Reset $mix_release_hook to cancel.")
end
true
end
- # $mix_click_hook.add_hook!("mix-click-sets-amp", &method(:mix_click_sets_amp).to_proc)
+ # $mix_click_hook.add_hook!("mix-click-sets-amp",
+ # &method(:mix_click_sets_amp).to_proc)
#
# === Mix Click Info ===
#
add_help(:mix_click_info,
- "mix_click_info(n) \
-is a $mix_click_hook function that describes a mix and its properties.")
+ "mix_click_info(n) \
+Is a $mix_click_hook function that describes a mix and its properties.")
def mix_click_info(id)
Snd.raise(:no_such_mix, id) unless mix?(id)
- info_dialog("Mix Info", format("\
+ mnamestr = ""
+ mname = mix_name(id)
+ if mname
+ mnamestr = format("\n mix name: %p", mname)
+ end
+ msr = srate(mix_home(id)[0]).to_f
+ propstr = ""
+ props = mix_properties(id)
+ if props
+ propstr = format("\n properties: %p", props)
+ end
+ mpos = mix_position(id)
+ mlen = mix_length(id)
+ info_dialog("Mix Info",
+ format("\
mix id: %s%s
position: %d (%1.3f secs)
length: %d (%1.3f secs)
@@ -171,26 +162,21 @@ is a $mix_click_hook function that describes a mix and its properties.")
scaler: %s
speed: %s
env: %s%s",
- id,
- ((s = mix_name(id)) ?
- format("\n mix name: %s", s.inspect) :
- ""),
- mix_position(id), mix_position(id) / srate(mix_home(id)[0]).to_f,
- mix_length(id), mix_length(id) / srate(mix_home(id)[0]).to_f,
- short_file_name(mix_home(id)[0]),
- mix_home(id)[1],
- mix_amp(id),
- mix_speed(id),
- mix_amp_env(id),
- ((props = mix_properties(id)) ?
- format("\n properties: %s", props.inspect) :
- "")))
+ id, mnamestr,
+ mpos, mpos / msr,
+ mlen, mlen / msr,
+ short_file_name(mix_home(id)[0]), mix_home(id)[1],
+ mix_amp(id),
+ mix_speed(id),
+ mix_amp_env(id), propstr))
true
end
- # $mix_click_hook.add_hook!("mix-click-info", &method(:mix_click_info).to_proc)
+ # $mix_click_hook.add_hook!("mix-click-info",
+ # &method(:mix_click_info).to_proc)
add_help(:mix_name2id,
- "mix_name2id(name) returns the mix id associated with NAME.")
+ "mix_name2id(name) \
+Returns the mix id associated with NAME.")
def mix_name2id(name)
ret = :no_such_mix
Snd.sounds.each do |snd|
@@ -244,7 +230,7 @@ is a $mix_click_hook function that describes a mix and its properties.")
add_help(:transpose_track,
"transpose_mixes(mix_list, semitones) \
-transposes each mix in MIX_LIST by SEMITONES.")
+Transposes each mix in MIX_LIST by SEMITONES.")
def transpose_mixes(mix_list, semitones)
src_mixes(mix_list, 2.0 ** (semitones / 12.0))
end
@@ -289,270 +275,16 @@ transposes each mix in MIX_LIST by SEMITONES.")
# reverse_mix_list is scale_tempo(mix_list, -1.0)
def mixes_length(mix_list)
- max_len = mix_list.map do |m| mix_position(m) + mix_length(m) end.max
- min_len = mix_list.map do |m| mix_position(m) end.min
+ max_len = mix_list.map do |m|
+ mix_position(m) + mix_length(m)
+ end.max
+ min_len = mix_list.map do |m|
+ mix_position(m)
+ end.min
max_len - min_len + 1
end
-
- def save_mixes(mix_list, filename)
- len = mixes_length(mix_list)
- beg = mix_list.map do |m| mix_position(m) end.min
- data = Vct.new(len)
- mix_list.each do |m|
- vct_add!(data, mix2vct(m), mix_position(m) - beg)
- end
- fd = mus_sound_open_output(filename(srate(), 1, false, false, ""))
- mus_sound_write(fd, 0, len - 1, vct2sound_data(data))
- mus_sound_close_output(fd, 4 * data.length)
- end
end
include Mix
-#
-# === MIXER.SCM ===
-#
-module Mixer_matrix
- def mixer_copy(mx)
- nmx = make_mixer(mx.length)
- mx.length.times do |i|
- mx.length.times do |j|
- mixer_set!(nmx, i, j, mixer_ref(mx, i, j))
- end
- end
- nmx
- end
-
- alias make_zero_mixer make_mixer
-
- def mixer_diagonal?(mx)
- if mx.length == 1
- true
- else
- mx.length.times do |i|
- mx.length.times do |j|
- if i != j and mixer_ref(mx, i, j).nonzero?
- return false
- end
- end
- end
- true
- end
- end
-
- def mixer_transpose(mx)
- nmx = make_zero_mixer(mx.length)
- mx.length.times do |i|
- mx.length.times do |j|
- mixer_set!(nmx, j, i, mixer_ref(mx, i, j))
- end
- end
- nmx
- end
-
- def sub_matrix(mx, row, col)
- nmx = make_zero_mixer(mx.length - 1)
- ni = 0
- mx.length.times do |i|
- if i != row
- nj = 0
- mx.length.times do |j|
- if j != col
- mixer_set!(nmx, ni, nj, mixer_ref(mx, i, j))
- nj += 1
- end
- end
- ni += 1
- end
- end
- nmx
- end
-
- def mixer_determinant(mx)
- if mx.length == 1
- mixer_ref(mx, 0, 0)
- else
- if mx.length == 2
- mixer_ref(mx, 0, 0) * mixer_ref(mx, 1, 1) - mixer_ref(mx, 0, 1) * mixer_ref(mx, 1, 0)
- else
- if mx.length == 3
- ((mixer_ref(mx, 0, 0) * mixer_ref(mx, 1, 1) * mixer_ref(mx, 2, 2) +
- mixer_ref(mx, 0, 1) * mixer_ref(mx, 1, 2) * mixer_ref(mx, 2, 0) +
- mixer_ref(mx, 0, 2) * mixer_ref(mx, 1, 0) * mixer_ref(mx, 2, 1)) -
- (mixer_ref(mx, 0, 0) * mixer_ref(mx, 1, 2) * mixer_ref(mx, 2, 1) +
- mixer_ref(mx, 0, 1) * mixer_ref(mx, 1, 0) * mixer_ref(mx, 2, 2) +
- mixer_ref(mx, 0, 2) * mixer_ref(mx, 1, 1) * mixer_ref(mx, 2, 0)))
- else
- sum = 0.0
- sign = 1
- mx.length.times do |i|
- mult = mixer_ref(mx, 0, i)
- if mult != 0.0
- sum = sum + sign * mult * mixer_determinant(sub_matrix(mx, 0, i))
- end
- sign = -sign
- end
- sum
- end
- end
- end
- end
-
- def mixer_poly(mx, *coeffs)
- n = coeffs.length
- nmx = make_scalar_mixer(mx.length, coeffs[-1])
- x = mixer_multiply(mx, 1.0)
- (n - 2).downto(0) do |i|
- nmx = mixer_add(nmx, mixer_multiply(x, coeffs[i]))
- x = mixer_multiply(mx, x)
- end
- nmx
- end
-
- def mixer_trace(mx)
- sum = 0.0
- mx.length.times do |i| sum += mixer_ref(mx, i, i) end
- sum
- end
-
- def invert_matrix(mx, b = nil, zero = 1.0e-7)
- # ;; translated from Numerical Recipes (gaussj)
- cols = make_array(mx.length, 0)
- rows = make_array(mx.length, 0)
- pivots = make_array(mx.length, 0)
- mx.length.times do |i|
- biggest = 0.0
- col = 0
- row = 0
- mx.length.times do |j|
- if pivots[j] != 1
- mx.length.times do |k|
- if pivots[k] == 0
- val = mixer_ref(mx, j, k).abs
- if val > biggest
- col = k
- row = j
- biggest = val
- else
- if pivots[k] == 1
- return false
- end
- end
- end
- end
- end
- end
- pivots[col] += 1
- if row != col
- temp = (b ? frame_ref(b, row) : 0.0)
- if b
- frame_set!(b, row, frame_ref(b, col))
- frame_set!(b, col, temp)
- end
- mx.length.times do |k|
- temp = mixer_ref(mx, row, k)
- mixer_set!(mx, row, k, mixer_ref(mx, col, k))
- mixer_set!(mx, col, k, temp)
- end
- end
- cols[i] = col
- rows[i] = row
- if mixer_ref(mx, col, col).abs < zero
- return false
- end
- inverse_pivot = 1.0 / mixer_ref(mx, col, col)
- mixer_set!(mx, col, col, 1.0)
- mx.length.times do |k|
- mixer_set!(mx, col, k, inverse_pivot * mixer_ref(mx, col, k))
- end
- if b
- frame_set!(b, col, inverse_pivot * frame_ref(b, col))
- end
- mx.length.times do |k|
- if k != col
- scl = mixer_ref(mx, k, col)
- mixer_set!(mx, k, col, 0.0)
- mx.length.times do |m|
- mixer_set!(mx, k, m, mixer_ref(mx, k, m) - scl * mixer_ref(mx, col, m))
- end
- if b
- frame_set!(b, k, frame_ref(b, k) - scl * frame_ref(b, col))
- end
- end
- end
- end
- (mx.length - 1).downto(0) do |i|
- if rows[i] != cols[i]
- mx.length.times do |k|
- temp = mixer_ref(mx, k, rows[i])
- mixer_set!(mx, k, rows[i], mixer_ref(mx, k, cols[i]))
- mixer_set!(mx, k, cols[i], temp)
- end
- end
- end
- [mx, b]
- end
-
- # Ax=b where A is mixer and b is frame, returns frame
- def mixer_solve(a, b)
- val = invert_matrix(a, b)
- val and val[1]
- end
-
- def mixer_inverse(mx)
- val = invert_matrix(mx)
- val and val[0]
- end
-
- def mixer_equal?(mx1, mx2)
- if mx1.length == mx2.length
- mx1.length.times do |i|
- mx2.length.times do |j|
- if (mixer_ref(mx1, i, j) - mixer_ref(mx2, i, j)).abs > 0.001
- return false
- end
- end
- end
- true
- else
- false
- end
- end
-
- def mixer_normal?(mx)
- mixer_equal?(mixer_multiply(mx, mixer_transpose(mx)),
- mixer_multiply(mixer_transpose(mx), mx))
- end
-
- def mixer_orthogonal?(mx)
- mixer_equal?(mixer_transpose(mx),
- mixer_inverse(mx))
- end
- alias mixer_unitary? mixer_orthogonal?
-
- def mixer_symmetric?(mx)
- mixer_equal?(mx, mixer_transpose(mx))
- end
- alias mixer_hermitian? mixer_symmetric?
-
- def frame_reverse(fr)
- len = fr.length
- j = len - 1
- (0...(len / 2)).each do |i|
- temp = frame_ref(fr, i)
- frame_set!(fr, i, frame_ref(fr, j))
- frame_set!(fr, j, temp)
- j -= 1
- end
- fr
- end
-
- def frame_copy(fr)
- len = fr.length
- nfr = make_frame(len)
- len.times do |i| frame_set!(nfr, i, frame_ref(fr, i)) end
- nfr
- end
-end
-
# mix.rb ends here
diff --git a/mix.scm b/mix.scm
index 8cebc24..acf3c50 100644
--- a/mix.scm
+++ b/mix.scm
@@ -1,6 +1,6 @@
;;; various mix related functions
;;;
-;;; (mix->vct mix) return mix data in vct
+;;; (mix->float-vector mix) return mix data in float-vector
;;; (snap-mix-to-beat) forces dragged mix to end up on a beat
;;; (silence-all-mixes) sets all mix amps to 0.0
;;; (find-mix sample snd chn) returns the mix at the given sample, or #f
@@ -10,89 +10,68 @@
;;; check-mix-tags tries to move mix tags around to avoid collisions
+(require snd-env.scm)
(provide 'snd-mix.scm)
-(define (tree-for-each func tree)
- "(tree-for-each func tree) applies func to every leaf of 'tree'"
- (cond ((null? tree) '())
- ((not (pair? tree)) (func tree))
- (else (tree-for-each func (car tree))
- (tree-for-each func (cdr tree)))))
-
-(define (tree-for-each-reversed func tree)
- "(tree-for-each-reversed func tree) applies func to every leaf of 'tree' moving in reverse through all the lists"
- (define (flatten lst)
- ;; there's probably a more elegant way to do this
- (cond ((null? lst) '())
- ((pair? lst)
- (if (pair? (car lst))
- (append (flatten (car lst)) (flatten (cdr lst)))
- (cons (car lst) (flatten (cdr lst)))))
- (#t lst)))
- (for-each func (reverse (flatten tree))))
-
-
-(define (mix-sound file start)
- "(mix-sound file start) mixes file (all chans) at start in the currently selected sound."
- (mix file start #t))
-
-
-(define (silence-all-mixes)
- "(silence-all-mixes) sets all mix amps to 0"
- (as-one-edit
+(define tree-for-each
+ (let ((documentation "(tree-for-each func tree) applies func to every leaf of 'tree'"))
+ (lambda (func tree)
+ (cond ((null? tree) ())
+ ((not (pair? tree)) (func tree))
+ (else (tree-for-each func (car tree))
+ (tree-for-each func (cdr tree)))))))
+
+(define tree-for-each-reversed
+ (let ((documentation "(tree-for-each-reversed func tree) applies func to every leaf of 'tree' moving in reverse through all the lists"))
+ (lambda (func tree)
+ (define (flatten lst)
+ ;; there's probably a more elegant way to do this
+ (cond ((null? lst) ())
+ ((pair? lst)
+ (if (pair? (car lst))
+ (append (flatten (car lst)) (flatten (cdr lst)))
+ (cons (car lst) (flatten (cdr lst)))))
+ (#t lst)))
+ (for-each func (reverse (flatten tree))))))
+
+
+(define mix-sound
+ (let ((documentation "(mix-sound file start) mixes file (all chans) at start in the currently selected sound."))
+ (lambda (file start)
+ (mix file start #t))))
+
+
+(define silence-all-mixes
+ (let ((documentation "(silence-all-mixes) sets all mix amps to 0"))
(lambda ()
- (tree-for-each
- (lambda (id)
- (set! (mix-amp id) 0.0))
- (mixes)))))
-
-
-(define* (find-mix sample snd chn)
- "(find-mix sample snd chn) returns the mix at the given sample, or #f"
- (let ((mix-list (mixes (or snd (selected-sound) (car (sounds))) (or chn (selected-channel snd) 0))))
- (call-with-exit
- (lambda (found-it)
- (for-each
- (lambda (n)
- (if (= (mix-position n) sample)
- (found-it n)))
- mix-list)
- #f))))
-
-
-(define (mix->vct id)
- "(mix->vct mix) returns mix's data in vct"
- (if (mix? id)
- (let* ((len (frames id))
- (v (make-vct len))
- (reader (make-mix-sampler id)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! v i (read-mix-sample reader)))
- (free-sampler reader)
- v)
- (throw 'no-such-mix (list "mix->vct" id))))
+ (as-one-edit
+ (lambda ()
+ (tree-for-each
+ (lambda (id)
+ (set! (mix-amp id) 0.0))
+ (mixes)))))))
+
+
+(define find-mix
+ (let ((documentation "(find-mix sample snd chn) returns the mix at the given sample, or #f"))
+ (lambda* (samp snd chn)
+ (let ((mix-list (mixes (or snd (selected-sound) (car (sounds))) (or chn (selected-channel snd) 0))))
+ (call-with-exit
+ (lambda (found-it)
+ (for-each
+ (lambda (n)
+ (if (= (mix-position n) samp)
+ (found-it n)))
+ mix-list)
+ #f))))))
+
+(define (mix->float-vector id) (samples 0 (mix-length id) id))
;;; 12-Nov-09: moved save-mix to C (snd-mix.c)
+(define (mix-maxamp id) (float-vector-peak (mix->float-vector id)))
-(define (mix-maxamp id)
- "(mix-maxamp mix) returns the max amp in the given mix"
- (if (mix? id)
- (let* ((len (frames id))
- (peak 0.0)
- (reader (make-mix-sampler id)))
- (set! peak (abs (read-mix-sample reader)))
- (do ((i 1 (+ 1 i)))
- ((= i len))
- (let ((val (abs (read-mix-sample reader))))
- (if (> val peak)
- (set! peak val))))
- (free-sampler reader)
- peak)
- (throw 'no-such-mix (list "mix-maxamp" id))))
-
;;; -------- snap dragged mix(es) to the nearest beat
@@ -111,9 +90,10 @@
higher))
#t))
-(define (snap-mix-to-beat)
- "(snap-mix-to-beat) forces a dragged mix to end up on a beat (see beats-per-minute). (hook-remove mix-release-hook snap-mix-1) to cancel."
- (hook-push mix-release-hook snap-mix-1 #t))
+(define snap-mix-to-beat
+ (let ((documentation "(snap-mix-to-beat) forces a dragged mix to end up on a beat (see beats-per-minute). (hook-remove mix-release-hook snap-mix-1) to cancel."))
+ (lambda ()
+ (hook-push mix-release-hook (lambda (hook) (set! (hook 'result) (snap-mix-1 (hook 'id) (hook 'samples))))))))
(define (snap-syncd-mixes-1 id samps-moved)
@@ -133,11 +113,12 @@
(set! (mix-position id) new-position)
(move-mixes (syncd-mixes (sync id)) true-samps-moved))
#t))
-
-(define (snap-syncd-mixes-to-beat)
- "(snap-mix-to-beat) forces a dragged mix to end up on a beat (see beats-per-minute). \
-All mixes sync'd to it are also moved the same number of samples. (hook-remove mix-release-hook snap-syncd-mixes-1) to cancel."
- (hook-push mix-release-hook snap-syncd-mixes-1 #t))
+
+(define snap-syncd-mixes-to-beat
+ (let ((documentation "(snap-mix-to-beat) forces a dragged mix to end up on a beat (see beats-per-minute). \
+All mixes sync'd to it are also moved the same number of samples. (hook-remove mix-release-hook snap-syncd-mixes-1) to cancel."))
+ (lambda ()
+ (hook-push mix-release-hook (lambda (hook) (set! (hook 'result) (snap-syncd-mixes-1 (hook 'id) (hook 'samples))))))))
@@ -146,75 +127,78 @@ All mixes sync'd to it are also moved the same number of samples. (hook-remove m
(define (mix-click-sets-amp)
(hook-push mix-click-hook
- (lambda (n)
- (let ((zeroed (mix-property :zero n)))
- (if (not zeroed)
- (begin
- (set! (mix-property :amp n) (mix-amp n))
- (set! (mix-amp n) 0.0)
- (set! (mix-property :zero n) #t))
- (begin
- (set! (mix-amp n) (mix-property :amp n))
- (set! (mix-property :zero n) #f)))
- #t))))
-
-;(mix-click-sets-amp)
+ (lambda (hook)
+ (let ((n (hook 'id)))
+ (let ((zeroed (mix-property :zero n)))
+ (if (not zeroed)
+ (begin
+ (set! (mix-property :amp n) (mix-amp n))
+ (set! (mix-amp n) 0.0)
+ (set! (mix-property :zero n) #t))
+ (begin
+ (set! (mix-amp n) (mix-property :amp n))
+ (set! (mix-property :zero n) #f)))
+ (set! (hook 'result) #t))))))
+
+ ;(mix-click-sets-amp)
;;; ---------- mix-click-info
-(define (mix-click-info n)
- "(mix-click-info n) is a mix-click-hook function that describes a mix and its properties"
- (help-dialog "Mix Help"
- (format #f "Mix ~A (sync: ~A):~% position: ~D = ~,3F secs~% length: ~D (~,3F secs)~% in: ~A[~D]~% scaler: ~A~% speed: ~A~% env: ~A~A"
- (if (mix-name n)
- (format #f "~S (~A)" (mix-name n) n)
- (format #f "~A" n))
- (mix-sync n)
- (mix-position n)
- (* 1.0 (/ (mix-position n) (srate (car (mix-home n)))))
- (frames n)
- (* 1.0 (/ (frames n) (srate (car (mix-home n)))))
- (short-file-name (car (mix-home n)))
- (cadr (mix-home n))
- (mix-amp n)
- (mix-speed n)
- (mix-amp-env n)
- (let ((props (mix-properties n)))
- (if (and (list? props)
- (not (null? props)))
- (format #f "~% properties: '~A" props)
- ""))))
- #t)
-
-;(hook-push mix-click-hook mix-click-info)
+(define mix-click-info
+ (let ((documentation "(mix-click-info n) is a mix-click-hook function that describes a mix and its properties"))
+ (lambda (n)
+ (help-dialog "Mix Help"
+ (format #f "Mix ~A (sync: ~A):~% position: ~D = ~,3F secs~% length: ~D (~,3F secs)~% in: ~A[~D]~% scaler: ~A~% speed: ~A~% env: ~A~A"
+ (if (mix-name n)
+ (format #f "~S (~A)" (mix-name n) n)
+ (format #f "~A" n))
+ (mix-sync n)
+ (mix-position n)
+ (* 1.0 (/ (mix-position n) (srate (car (mix-home n)))))
+ (framples n)
+ (* 1.0 (/ (framples n) (srate (car (mix-home n)))))
+ (short-file-name (car (mix-home n)))
+ (cadr (mix-home n))
+ (mix-amp n)
+ (mix-speed n)
+ (mix-amp-env n)
+ (let ((props (mix-properties n)))
+ (if (pair? props)
+ (format #f "~% properties: '~A" props)
+ ""))))
+ #t)))
+
+ ;(hook-push mix-click-hook (lambda (hook) (set! (hook 'result) (mix-click-info (hook 'id)))))
;;; -------- mix-name->id
-(define (mix-name->id name)
- "(mix-name->id name) returns the mix associated with 'name'"
- (call-with-exit
- (lambda (return)
- (for-each
- (lambda (snd)
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (for-each
- (lambda (m)
- (if (and (string? (mix-name m))
- (string=? (mix-name m) name))
- (return m)))
- (mixes snd chn))))
- (sounds))
- 'no-such-mix)))
+(define mix-name->id
+ (let ((documentation "(mix-name->id name) returns the mix associated with 'name'"))
+ (lambda (name)
+ (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (snd)
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels snd)))
+ (for-each
+ (lambda (m)
+ (if (and (string? (mix-name m))
+ (string=? (mix-name m) name))
+ (return m)))
+ (mixes snd chn))))
+ (sounds))
+ 'no-such-mix)))))
;;; ---------------- backwards compatibilty
-(define (delete-mix id)
- "(delete-mix mix) sets the mix's amp to 0.0"
- (set! (mix-amp id) 0.0))
+(define delete-mix
+ (let ((documentation "(delete-mix mix) sets the mix's amp to 0.0"))
+ (lambda (id)
+ (set! (mix-amp id) 0.0))))
@@ -223,380 +207,373 @@ All mixes sync'd to it are also moved the same number of samples. (hook-remove m
;;; to use these based on a mix-sync setting, use syncd-mixes below:
;;; (scale-mixes (syncd-mixes 2) 2.0) scales all mixes whose mix-sync field is 2 by 2.0.
-(define (scale-mixes mix-list scl)
- "(scale-mixes mix-list scl) scales the amplitude of each mix in 'mix-list' by 'scl'"
- (as-one-edit
- (lambda ()
- (for-each
- (lambda (m)
- (set! (mix-amp m) (* scl (mix-amp m))))
- mix-list))))
-
-
-(define (silence-mixes mix-list)
- "(silence-mixes mix-list) sets the amplitude of each mix in 'mix-list' to 0.0"
- (scale-mixes mix-list 0.0))
+(define scale-mixes
+ (let ((documentation "(scale-mixes mix-list scl) scales the amplitude of each mix in 'mix-list' by 'scl'"))
+ (lambda (mix-list scl)
+ (as-one-edit
+ (lambda ()
+ (for-each
+ (lambda (m)
+ (set! (mix-amp m) (* scl (mix-amp m))))
+ mix-list))))))
-(define (move-mixes mix-list samps)
- "(move-mixes mix-list samps) moves each mix in 'mix-list' by 'samps' samples"
- (as-one-edit
- (lambda ()
- (for-each
- (lambda (m)
- (set! (mix-position m) (max 0 (+ (mix-position m) samps))))
- mix-list))))
+(define silence-mixes
+ (let ((documentation "(silence-mixes mix-list) sets the amplitude of each mix in 'mix-list' to 0.0"))
+ (lambda (mix-list)
+ (scale-mixes mix-list 0.0))))
-(define (src-mixes mix-list sr)
- "(src-mixes mix-list sr) multiplies the speed (resampling ratio) of each mix in 'mix-list' by 'sr'"
- (if (not (= sr 0.0))
+(define move-mixes
+ (let ((documentation "(move-mixes mix-list samps) moves each mix in 'mix-list' by 'samps' samples"))
+ (lambda (mix-list samps)
(as-one-edit
(lambda ()
(for-each
(lambda (m)
- (set! (mix-speed m) (* (mix-speed m) sr)))
- mix-list)))))
+ (set! (mix-position m) (max 0 (+ (mix-position m) samps))))
+ mix-list))))))
+
+
+(define src-mixes
+ (let ((documentation "(src-mixes mix-list sr) multiplies the speed (resampling ratio) of each mix in 'mix-list' by 'sr'"))
+ (lambda (mix-list sr)
+ (if (not (= sr 0.0))
+ (as-one-edit
+ (lambda ()
+ (for-each
+ (lambda (m)
+ (set! (mix-speed m) (* (mix-speed m) sr)))
+ mix-list)))))))
-(define (transpose-mixes mix-list semitones)
- "(transpose-mixes mix-list semitones) transposes each mix in mix-list by semitones"
- (if (not (= semitones 0))
- (src-mixes mix-list (expt 2.0 (/ semitones 12.0)))))
+(define transpose-mixes
+ (let ((documentation "(transpose-mixes mix-list semitones) transposes each mix in mix-list by semitones"))
+ (lambda (mix-list semitones)
+ (if (not (= semitones 0))
+ (src-mixes mix-list (expt 2.0 (/ semitones 12.0)))))))
-(define (color-mixes mix-list col)
- "(color-mixes mix-list color) sets the tag and waveform color of each mix in 'mix-list' to 'color'"
- (for-each
- (lambda (m)
- (set! (mix-color m) col))
- mix-list))
+(define color-mixes
+ (let ((documentation "(color-mixes mix-list color) sets the tag and waveform color of each mix in 'mix-list' to 'color'"))
+ (lambda (mix-list col)
+ (for-each
+ (lambda (m)
+ (set! (mix-color m) col))
+ mix-list))))
-(define (set-mixes-tag-y mix-list new-y)
- "(set-mixes-tag-y mix-list new-y) sets the mix tag vertical position of each mix in 'mix-list' to 'new-y'. The \
+(define set-mixes-tag-y
+ (let ((documentation "(set-mixes-tag-y mix-list new-y) sets the mix tag vertical position of each mix in 'mix-list' to 'new-y'. The \
position is measured from the top of the graph, so higher tag-y values position the tag lower in the graph. For \
example, if you know the frequency of the mix sound, you can reflect that in the tag height with: \n\n\
\n\
- (set! (mix-tag-y mix-id) (round (* 100 (- 1.0 (/ (log (/ freq 40.0)) (* (log 2.0) 7))))))\n"
-
- (for-each
- (lambda (m)
- (set! (mix-tag-y m) new-y))
- mix-list))
-
-
-(define (mixes-maxamp mix-list)
- "(mixes-maxamp mix-list) returns the maximum amplitude of the data in the mixes in 'mix-list'"
- (let ((mx 0.0))
- (for-each
- (lambda (m)
- (set! mx (max mx (mix-maxamp m))))
- mix-list)
- mx))
+ (set! (mix-tag-y mix-id) (round (* 100 (- 1.0 (/ (log (/ freq 40.0)) (* (log 2.0) 7))))))\n"))
+ (lambda (mix-list new-y)
+
+ (for-each
+ (lambda (m)
+ (set! (mix-tag-y m) new-y))
+ mix-list))))
+
+
+(define mixes-maxamp
+ (let ((documentation "(mixes-maxamp mix-list) returns the maximum amplitude of the data in the mixes in 'mix-list'"))
+ (lambda (mix-list)
+ (let ((mx 0.0))
+ (for-each
+ (lambda (m)
+ (set! mx (max mx (mix-maxamp m))))
+ mix-list)
+ mx))))
-(define (scale-tempo mix-list tempo-scl)
- "(scale-tempo mix-list scl) changes the rate at which the mixes in 'mix-list' occur to reflect \
+(define scale-tempo
+ (let ((documentation "(scale-tempo mix-list scl) changes the rate at which the mixes in 'mix-list' occur to reflect \
the tempo scaler 'scl'. If 'scl' is 2.0, for example, the mixes are re-positioned so that they \
happen twice as slowly (the data is not resampled -- each mix is untouched except that its begin time \
-may change)"
-
- (let* ((first-beg (mix-position (car mix-list)))
- (last-beg first-beg))
- (for-each
- (lambda (m)
- (let ((pos (mix-position m)))
- (set! first-beg (min first-beg pos))
- (set! last-beg (max last-beg pos))))
- (cdr mix-list))
- (as-one-edit
- (lambda ()
- (for-each
- (lambda (m)
- (let ((diff (round (* tempo-scl (- (mix-position m) first-beg)))))
- (if (not (= diff 0))
- (set! (mix-position m) (+ first-beg diff)))))
- mix-list)))))
-
-;;; reverse-mix-list is (scale-tempo mix-list -1.0)
-
-
-(define (mixes-length mix-list)
- "(mixes-length mix-list) returns the number of samples between the start of the earliest mix and the \
-last end of the mixes in 'mix-list'"
- (+ 1 (- (apply max (map (lambda (m)
- (+ (mix-position m) (frames m)))
- mix-list))
- (apply min (map mix-position mix-list)))))
-
-
-(define (save-mixes mix-list filename)
- "(save-mixes mix-list filename) saves the data of the mixes in 'mix-list' in 'filename'"
- (let* ((len (mixes-length mix-list))
- (beg (apply min (map mix-position mix-list)))
- (data (make-vct len)))
- (for-each
- (lambda (m)
- (vct-add! data (mix->vct m) (- (mix-position m) beg)))
- mix-list)
- (let ((fd (mus-sound-open-output filename (srate) 1 #f #f "")))
- (mus-sound-write fd 0 (- len 1) 1 (vct->sound-data data))
- (mus-sound-close-output fd (* (mus-bytes-per-sample mus-out-format) (length data))))))
-
-
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
-
-(define (env-mixes mix-list overall-amp-env)
- "(env-mixes mix-list amp-env) applies 'amp-env' as a global amplitude envelope to the mixes in 'mix-list'"
- (let* ((mix-begs (map mix-position mix-list))
- (mix-ends (map (lambda (m) (+ (mix-position m) (frames m))) mix-list))
- (beg (apply min mix-begs))
- (end (apply max mix-ends))
- (first-x (car overall-amp-env))
- (last-x (envelope-last-x overall-amp-env))
- (x-scale (/ (- last-x first-x) (+ 1 (- end beg)))))
- (as-one-edit
- (lambda ()
- (for-each
- (lambda (m)
- (let* ((beg-x (+ first-x (* x-scale (- (mix-position m) beg))))
- (end-x (+ first-x (* x-scale (- (+ (mix-position m) (frames m)) beg))))
- (wenv (window-envelope beg-x end-x overall-amp-env)))
- (if (null? (mix-amp-env m))
- (set! (mix-amp-env m) wenv)
- (set! (mix-amp-env m) (multiply-envelopes (mix-amp-env m) wenv)))))
- mix-list)))))
-
-
-(define* (sync-all-mixes (new-sync 1))
- ;; a replacement for set-all-tracks in snd-8
- "(sync-all-mixes (new-sync 1)) sets the mix-sync field of every active mix to new-sync"
- (for-each
- (lambda (snd-m)
- (for-each
- (lambda (chn-m)
+may change)"))
+ (lambda (mix-list tempo-scl)
+
+ (let* ((first-beg (mix-position (car mix-list)))
+ (last-beg first-beg))
(for-each
(lambda (m)
- (set! (sync m) new-sync))
- chn-m))
- snd-m))
- (mixes)))
+ (let ((pos (mix-position m)))
+ (set! first-beg (min first-beg pos))
+ (set! last-beg (max last-beg pos))))
+ (cdr mix-list))
+ (as-one-edit
+ (lambda ()
+ (for-each
+ (lambda (m)
+ (let ((diff (round (* tempo-scl (- (mix-position m) first-beg)))))
+ (if (not (= diff 0))
+ (set! (mix-position m) (+ first-beg diff)))))
+ mix-list)))))))
+;;; reverse-mix-list is (scale-tempo mix-list -1.0)
-(define (syncd-mixes val)
- "(syncd-mixes val) returns a list (possibly null) of all mixes whose mix-sync field is set to 'val'"
- (if (<= val 0)
- (list)
- (let ((mix-list '()))
- (for-each
- (lambda (snd-m)
- (for-each
- (lambda (chn-m)
- (for-each
- (lambda (m)
- (if (= (sync m) val)
- (set! mix-list (cons m mix-list))))
- chn-m))
- snd-m))
- (mixes))
- mix-list)))
-
-(define (play-mixes mix-list)
- "(play-mixes mix-list) plays the mixes in 'mix-list'"
- (let* ((sorted-mixes (sort! mix-list (lambda (a b) (< (mix-position a) (mix-position b)))))
- (now (mix-position (car sorted-mixes))))
- (play (lambda ()
- (while (and (not (null? sorted-mixes))
- (= now (mix-position (car sorted-mixes))))
- (play (let ((mx (car sorted-mixes)))
- (if (integer? mx)
- (integer->mix mx)
- mx)))
- (set! sorted-mixes (cdr sorted-mixes)))
- (set! now (+ 1 now))
- (if (null? sorted-mixes)
- #f
- 0.0)))))
+(define mixes-length
+ (let ((documentation "(mixes-length mix-list) returns the number of samples between the start of the earliest mix and the \
+last end of the mixes in 'mix-list'"))
+ (lambda (mix-list)
+ (+ 1 (- (apply max (map (lambda (m)
+ (+ (mix-position m) (framples m)))
+ mix-list))
+ (apply min (map mix-position mix-list)))))))
+
+
+(define env-mixes
+ (let ((documentation "(env-mixes mix-list amp-env) applies 'amp-env' as a global amplitude envelope to the mixes in 'mix-list'"))
+ (lambda (mix-list overall-amp-env)
+ (let* ((mix-begs (map mix-position mix-list))
+ (mix-ends (map (lambda (m) (+ (mix-position m) (framples m))) mix-list))
+ (beg (apply min mix-begs))
+ (end (apply max mix-ends))
+ (first-x (car overall-amp-env))
+ (last-x (envelope-last-x overall-amp-env))
+ (x-scale (/ (- last-x first-x) (+ 1 (- end beg)))))
+ (as-one-edit
+ (lambda ()
+ (for-each
+ (lambda (m)
+ (let* ((beg-x (+ first-x (* x-scale (- (mix-position m) beg))))
+ (end-x (+ first-x (* x-scale (- (+ (mix-position m) (framples m)) beg))))
+ (wenv (window-envelope beg-x end-x overall-amp-env)))
+ (if (null? (mix-amp-env m))
+ (set! (mix-amp-env m) wenv)
+ (set! (mix-amp-env m) (multiply-envelopes (mix-amp-env m) wenv)))))
+ mix-list)))))))
+
+
+(define sync-all-mixes
+ ;; a replacement for set-all-tracks in snd-8
+ (let ((documentation "(sync-all-mixes (new-sync 1)) sets the mix-sync field of every active mix to new-sync"))
+ (lambda* ((new-sync 1))
+ (for-each
+ (lambda (snd-m)
+ (for-each
+ (lambda (chn-m)
+ (for-each
+ (lambda (m)
+ (set! (sync m) new-sync))
+ chn-m))
+ snd-m))
+ (mixes)))))
+
+
+(define syncd-mixes
+ (let ((documentation "(syncd-mixes val) returns a list (possibly null) of all mixes whose mix-sync field is set to 'val'"))
+ (lambda (val)
+ (if (<= val 0)
+ (list)
+ (let ((mix-list ()))
+ (for-each
+ (lambda (snd-m)
+ (for-each
+ (lambda (chn-m)
+ (for-each
+ (lambda (m)
+ (if (= (sync m) val)
+ (set! mix-list (cons m mix-list))))
+ chn-m))
+ snd-m))
+ (mixes))
+ mix-list)))))
+
+
+(define play-mixes
+ (let ((documentation "(play-mixes mix-list) plays the mixes in 'mix-list'"))
+ (lambda (mix-list)
+ (let* ((sorted-mixes (sort! (copy mix-list) (lambda (a b) (< (mix-position a) (mix-position b)))))
+ (now (mix-position (car sorted-mixes))))
+ (play (lambda ()
+ (while (and (pair? sorted-mixes)
+ (= now (mix-position (car sorted-mixes))))
+ (play (let ((mx (car sorted-mixes)))
+ (if (integer? mx)
+ (integer->mix mx)
+ mx)))
+ (set! sorted-mixes (cdr sorted-mixes)))
+ (set! now (+ 1 now))
+ (and (pair? sorted-mixes)
+ 0.0)))))))
;;; -------- pan-mix --------
-(define* (pan-mix name beg pan snd (chn 0) auto-delete)
-
- "(pan-mix file start pan-env snd (chn 0) (auto-delete #f)) mixes 'file' into the sound 'snd'
+(define pan-mix
+
+ (let ((documentation "(pan-mix file start pan-env snd (auto-delete #f)) mixes 'file' into the sound 'snd'
starting at 'start' (in samples) using 'pan-env' to decide how to split the sound between the output channels (0: all chan 0, 1: all chan 1).
So, (pan-mix \"oboe.snd\" 0 '(0 0 1 1)) goes from all chan 0 to all chan 1.
'auto-delete' determines whether the in-coming file should be treated as a temporary file and deleted when the mix
is no longer accessible. pan-mix returns a list of the mixes performing the
-panning operation."
-
- (let* ((index (or snd (selected-sound) (and (sounds) (car (sounds)))))
- (deletion-choice (if auto-delete 3 0)) ; multichannel deletion case
- (end-deletion-choice (if (= deletion-choice 3) 4 0)))
- (if (not (sound? index))
- (throw 'no-such-sound (list "pan-mix" snd)))
- (if (not (file-exists? name))
- (throw 'no-such-file (list "pan-mix" name)))
+panning operation."))
- (as-one-edit
- (lambda ()
-
- (define (invert-envelope e)
- (if (null? e)
- '()
- (append (list (car e) (- 1.0 (cadr e)))
- (invert-envelope (cddr e)))))
-
- (let ((incoming-chans (channels name))
- (receiving-chans (channels index)))
-
- (if (= incoming-chans 1)
-
- ;; mono input
-
- (if (= receiving-chans 1)
-
- ;; mono to mono = just scale or envelope
- (let ((idx (mix name beg 0 index 0 (with-mix-tags) auto-delete))) ; file start in-chan snd chn ...
- (if (and idx (mix? (car idx)))
- (let ((id (car idx)))
- (set! (mix-amp-env id) (invert-envelope pan))
- idx)
- #f))
-
- ;; mono to stereo
- (let ((idx0 (mix name beg 0 index 0 (with-mix-tags) deletion-choice))
- (idx1 (mix name beg 0 index 1 (with-mix-tags) end-deletion-choice)))
- (if (and idx0 (mix? (car idx0))
- idx1 (mix? (car idx1)))
- (let ((id0 (car idx0))
- (id1 (car idx1)))
- (set! (mix-amp-env id0) (invert-envelope pan))
- (set! (mix-amp-env id1) pan)
- (list id0 id1))
- #f)))
-
- ;; stero input
+ (lambda* (name beg pan snd auto-delete)
+
+ (let* ((index (or snd (selected-sound) (and (sounds) (car (sounds)))))
+ (deletion-choice (if auto-delete 3 0)) ; multichannel deletion case
+ (end-deletion-choice (if (= deletion-choice 3) 4 0)))
+ (if (not (sound? index))
+ (error 'no-such-sound (list "pan-mix" snd)))
+ (if (not (file-exists? name))
+ (error 'no-such-file (list "pan-mix" name)))
+
+ (as-one-edit
+ (lambda ()
+
+ (define (invert-envelope e)
+ (if (null? e)
+ ()
+ (append (list (car e) (- 1.0 (cadr e)))
+ (invert-envelope (cddr e)))))
+
+ (let ((incoming-chans (channels name))
+ (receiving-chans (channels index)))
- (if (= receiving-chans 1)
-
- ;; stereo -> mono => scale or envelope both input chans into the output
- (let ((idx0 (mix name beg 0 index 0 (with-mix-tags) deletion-choice))
- (idx1 (mix name beg 1 index 0 (with-mix-tags) end-deletion-choice)))
- (if (and idx0 (mix? (car idx0))
- idx1 (mix? (car idx1)))
- (let ((id0 (car idx0))
- (id1 (car idx1)))
- (set! (mix-amp-env id0) (invert-envelope pan))
- (set! (mix-amp-env id1) (invert-envelope pan))
- (list id0 id1))
- #f))
-
- ;; stereo -> stereo => incoming chans are treated equally, each panned into outputs
- (let ((idx00 (mix name beg 0 index 0 (with-mix-tags) deletion-choice))
- (idx01 (mix name beg 0 index 1 (with-mix-tags) deletion-choice))
- (idx10 (mix name beg 1 index 0 (with-mix-tags) deletion-choice))
- (idx11 (mix name beg 1 index 1 (with-mix-tags) end-deletion-choice)))
-
- (if (and idx00 (mix? (car idx00))
+ (if (= incoming-chans 1)
+
+ ;; mono input
+
+ (if (= receiving-chans 1)
+
+ ;; mono to mono = just scale or envelope
+ (let ((idx (mix name beg 0 index 0 *with-mix-tags* auto-delete))) ; file start in-chan snd chn ...
+ (and idx (mix? (car idx))
+ (let ((id (car idx)))
+ (set! (mix-amp-env id) (invert-envelope pan))
+ idx)))
+
+ ;; mono to stereo
+ (let ((idx0 (mix name beg 0 index 0 *with-mix-tags* deletion-choice))
+ (idx1 (mix name beg 0 index 1 *with-mix-tags* end-deletion-choice)))
+ (and idx0 (mix? (car idx0))
+ idx1 (mix? (car idx1))
+ (let ((id0 (car idx0))
+ (id1 (car idx1)))
+ (set! (mix-amp-env id0) (invert-envelope pan))
+ (set! (mix-amp-env id1) pan)
+ (list id0 id1)))))
+
+ ;; stero input
+
+ (if (= receiving-chans 1)
+
+ ;; stereo -> mono => scale or envelope both input chans into the output
+ (let ((idx0 (mix name beg 0 index 0 *with-mix-tags* deletion-choice))
+ (idx1 (mix name beg 1 index 0 *with-mix-tags* end-deletion-choice)))
+ (and idx0 (mix? (car idx0))
+ idx1 (mix? (car idx1))
+ (let ((id0 (car idx0))
+ (id1 (car idx1)))
+ (set! (mix-amp-env id0) (invert-envelope pan))
+ (set! (mix-amp-env id1) (invert-envelope pan))
+ (list id0 id1))))
+
+ ;; stereo -> stereo => incoming chans are treated equally, each panned into outputs
+ (let ((idx00 (mix name beg 0 index 0 *with-mix-tags* deletion-choice))
+ (idx01 (mix name beg 0 index 1 *with-mix-tags* deletion-choice))
+ (idx10 (mix name beg 1 index 0 *with-mix-tags* deletion-choice))
+ (idx11 (mix name beg 1 index 1 *with-mix-tags* end-deletion-choice)))
+
+ (and idx00 (mix? (car idx00))
idx01 (mix? (car idx01))
idx10 (mix? (car idx10))
- idx11 (mix? (car idx11)))
- (let ((id00 (car idx00))
- (id01 (car idx01))
- (id10 (car idx10))
- (id11 (car idx11)))
- (set! (mix-amp-env id00) (invert-envelope pan))
- (set! (mix-amp-env id10) (invert-envelope pan))
- (set! (mix-amp-env id01) pan)
- (set! (mix-amp-env id11) pan)
- (list id00 id01 id10 id11))
- #f)))))))))
-
-
-(define* (pan-mix-selection beg pan snd chn)
-
- "(pan-mix-selection start pan-env snd chn) mixes the current selection into the sound 'snd'
-starting at 'start' (in samples) using 'pan-env' to pan (0: all chan 0, 1: all chan 1)."
-
- (if (not (selection?))
- (throw 'no-active-selection (list "pan-mix-selection"))
- (pan-mix (save-selection (snd-tempnam)) beg pan snd chn #t)))
-
-
-(define* (pan-mix-region reg beg pan snd chn)
-
- "(pan-mix-region reg start pan-env snd chn) mixes the given region into the sound 'snd'
-starting at 'start' (in samples) using 'pan-env' to pan (0: all chan 0, 1: all chan 1)."
-
- (if (not (region? reg))
- (throw 'no-such-region (list "pan-mix-region" reg))
- (pan-mix (save-region reg (snd-tempnam)) beg pan snd chn #t)))
-
-
-(define* (pan-mix-vct v beg pan snd chn)
-
- "(pan-mix-vct v start pan-env snd chn) mixes the vct data into the sound 'snd'
-starting at 'start' (in samples) using 'pan-env' to pan (0: all chan 0, 1: all chan 1)."
-
- (let* ((temp-file (snd-tempnam))
- (fd (mus-sound-open-output temp-file (srate snd) 1 #f #f "")))
- (mus-sound-write fd 0 (- (length v) 1) 1 (vct->sound-data v))
- (mus-sound-close-output fd (* (mus-bytes-per-sample mus-out-format) (length v)))
- (pan-mix temp-file beg pan snd chn #t)))
+ idx11 (mix? (car idx11))
+ (let ((id00 (car idx00))
+ (id01 (car idx01))
+ (id10 (car idx10))
+ (id11 (car idx11)))
+ (set! (mix-amp-env id00) (invert-envelope pan))
+ (set! (mix-amp-env id10) (invert-envelope pan))
+ (set! (mix-amp-env id01) pan)
+ (set! (mix-amp-env id11) pan)
+ (list id00 id01 id10 id11)))))))))))))
+
+
+(define pan-mix-selection
+ (let ((documentation "(pan-mix-selection start pan-env snd) mixes the current selection into the sound 'snd'
+starting at 'start' (in samples) using 'pan-env' to pan (0: all chan 0, 1: all chan 1)."))
+ (lambda* (beg pan snd)
+ (if (not (selection?))
+ (error 'no-active-selection (list "pan-mix-selection"))
+ (pan-mix (save-selection (snd-tempnam)) beg pan snd #t)))))
+
+
+(define pan-mix-region
+ (let ((documentation "(pan-mix-region reg start pan-env snd) mixes the given region into the sound 'snd'
+starting at 'start' (in samples) using 'pan-env' to pan (0: all chan 0, 1: all chan 1)."))
+ (lambda* (reg beg pan snd)
+ (if (not (region? reg))
+ (error 'no-such-region (list "pan-mix-region" reg))
+ (pan-mix (save-region reg (snd-tempnam)) beg pan snd #t)))))
+
+
+(define pan-mix-float-vector
+ (let ((documentation "(pan-mix-float-vector v start pan-env snd) mixes the float-vector data into the sound 'snd'
+starting at 'start' (in samples) using 'pan-env' to pan (0: all chan 0, 1: all chan 1)."))
+ (lambda* (v beg pan snd)
+ (let ((temp-file (snd-tempnam)))
+ (array->file temp-file v (length v) (srate snd) 1)
+ (pan-mix temp-file beg pan snd #t)))))
;;; -------- delay-channel-mixes
-(define* (delay-channel-mixes beg dur snd chn)
- "(delay-channel-mixes beg dur snd chn) adds dur (which can be negative) to the \
-begin time of each mix that starts after beg in the given channel"
- (for-each
- (lambda (m)
- (if (>= (mix-position m) beg)
- (set! (mix-position m) (max 0 (+ (mix-position m) dur)))))
- (mixes (or snd
- (selected-sound)
- (car (sounds)))
- (or chn 0))))
+(define delay-channel-mixes
+ (let ((documentation "(delay-channel-mixes beg dur snd chn) adds dur (which can be negative) to the \
+begin time of each mix that starts after beg in the given channel"))
+ (lambda* (beg dur snd chn)
+ (for-each
+ (lambda (m)
+ (if (>= (mix-position m) beg)
+ (set! (mix-position m) (max 0 (+ (mix-position m) dur)))))
+ (mixes (or snd
+ (selected-sound)
+ (car (sounds)))
+ (or chn 0))))))
+
;;; -------- check-mix-tags
-(define* (check-mix-tags snd chn)
- "(check-mix-tags snd chn) tries to move mix tags around to avoid collisions"
- (if (not snd)
- (for-each check-mix-tags (sounds))
- (if (not chn)
- (let ((chns (channels snd)))
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (check-mix-tags snd i)))
- (let ((mxs (mixes snd chn))
- (changed #f))
- (define (check-mix mx trailing-mixes)
- (if (not (null? trailing-mixes))
- (let ((pos (mix-position mx))
- (ls (left-sample snd chn))
- (rs (right-sample snd chn)))
- (if (<= ls pos rs)
- (let ((x (x->position (/ pos (srate snd))))
- (y (mix-tag-y mx)))
- (for-each
- (lambda (other-mix)
- (let ((other-pos (mix-position other-mix)))
- (if (<= ls other-pos rs)
- (let ((other-x (x->position (/ other-pos (srate snd))))
- (other-y (mix-tag-y other-mix)))
- (if (and (< (abs (- x other-x)) 6)
- (< (abs (- y other-y)) 10))
- (begin
- (set! (mix-tag-y other-mix) (+ (mix-tag-y other-mix) 20))
- (set! changed #t)))))))
- trailing-mixes)))
- (check-mix (car trailing-mixes) (cdr trailing-mixes)))))
- (check-mix (car mxs) (cdr mxs))
- (if changed
- (update-time-graph snd chn))))))
+(define check-mix-tags
+ (let ((documentation "(check-mix-tags snd chn) tries to move mix tags around to avoid collisions"))
+ (lambda* (snd chn)
+ (if (not snd)
+ (for-each check-mix-tags (sounds))
+ (if (not chn)
+ (let ((chns (channels snd)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (check-mix-tags snd i)))
+ (let ((mxs (mixes snd chn))
+ (changed #f))
+ (define (check-mix mx trailing-mixes)
+ (if (pair? trailing-mixes)
+ (let ((pos (mix-position mx))
+ (ls (left-sample snd chn))
+ (rs (right-sample snd chn)))
+ (if (<= ls pos rs)
+ (let ((x (x->position (/ pos (srate snd))))
+ (y (mix-tag-y mx)))
+ (for-each
+ (lambda (other-mix)
+ (let ((other-pos (mix-position other-mix)))
+ (if (<= ls other-pos rs)
+ (let ((other-x (x->position (/ other-pos (srate snd))))
+ (other-y (mix-tag-y other-mix)))
+ (if (and (< (abs (- x other-x)) 6)
+ (< (abs (- y other-y)) 10))
+ (begin
+ (set! (mix-tag-y other-mix) (+ (mix-tag-y other-mix) 20))
+ (set! changed #t)))))))
+ trailing-mixes)))
+ (check-mix (car trailing-mixes) (cdr trailing-mixes)))))
+ (check-mix (car mxs) (cdr mxs))
+ (if changed
+ (update-time-graph snd chn))))))))
diff --git a/mixer.scm b/mixer.scm
deleted file mode 100644
index 7506d41..0000000
--- a/mixer.scm
+++ /dev/null
@@ -1,222 +0,0 @@
-;;; mixer and frame stuff, mostly oriented toward linear algebra (see also snd-test)
-;;;
-;;; make-zero-mixer, mixer-diagonal?, mixer-transpose, mixer-determinant,
-;;; mixer-solve, mixer-inverse, invert-matrix, mixer-trace, mixer-poly, mixer-copy
-
-(provide 'snd-mixer.scm)
-
-(define (mixer-copy umx)
- "(mixer-copy umx) returns a copy of its argument (a mixer)"
- (let* ((size (length umx))
- (mx (make-mixer size)))
- (do ((i 0 (+ 1 i)))
- ((= i size))
- (do ((j 0 (+ 1 j)))
- ((= j size))
- (mixer-set! mx i j (mixer-ref umx i j))))
- mx))
-
-(define (make-zero-mixer n)
- "(make-zero-mixer n) returns an empty mixer"
- (make-mixer n))
-
-(define mat
- (make-procedure-with-setter
- (lambda (m i j)
- "(mat m i j) accesses an element of the matrix (mixer) 'm'"
- (mixer-ref m i j))
- (lambda (m i j x)
- (mixer-set! m i j x))))
-
-(define (mixer-diagonal? m)
- "(mixer-diagonal? m) returns #t if 'm' is a diagonal mixer"
- (let ((n (length m)))
- (or (= n 1)
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i n) #t)
- (do ((j 0 (+ 1 j)))
- ((= j n))
- (if (and (not (= i j))
- (not (= (mat m i j) 0.0)))
- (return #f)))))))))
-
-(define (mixer-transpose mx)
- "(mixer-transpose mx) returns a new mixer of 'mx' transposed"
- (let* ((n (length mx))
- (nmx (make-zero-mixer n)))
- (do ((i 0 (+ 1 i)))
- ((= i n))
- (do ((j 0 (+ 1 j)))
- ((= j n))
- (set! (mat nmx j i) (mat mx i j))))
- nmx))
-
-(define (sub-matrix mx row col)
- "(sub-matrix mx row col) returns a portion of the matrix 'mx'"
- (let* ((old-n (length mx))
- (new-n (- old-n 1))
- (nmx (make-zero-mixer new-n)))
- (do ((i 0 (+ 1 i))
- (ni 0))
- ((= i old-n))
- (if (not (= i row))
- (begin
- (do ((j 0 (+ 1 j))
- (nj 0))
- ((= j old-n))
- (if (not (= j col))
- (begin
- (set! (mat nmx ni nj) (mat mx i j))
- (set! nj (+ nj 1)))))
- (set! ni (+ 1 ni)))))
- nmx))
-
-(define (mixer-determinant mx)
- "(mixer-determinant mx) returns the determinant of 'mx'"
- (let ((n (length mx)))
- (if (= n 1)
- (mat mx 0 0)
- (if (= n 2)
- (- (* (mat mx 0 0) (mat mx 1 1))
- (* (mat mx 0 1) (mat mx 1 0)))
- (if (= n 3)
- (- (+ (* (mat mx 0 0) (mat mx 1 1) (mat mx 2 2))
- (* (mat mx 0 1) (mat mx 1 2) (mat mx 2 0))
- (* (mat mx 0 2) (mat mx 1 0) (mat mx 2 1)))
- (+ (* (mat mx 0 0) (mat mx 1 2) (mat mx 2 1))
- (* (mat mx 0 1) (mat mx 1 0) (mat mx 2 2))
- (* (mat mx 0 2) (mat mx 1 1) (mat mx 2 0))))
- (let ((sum 0.0)
- (sign 1))
- (do ((i 0 (+ 1 i)))
- ((= i n))
- (let ((mult (mat mx 0 i)))
- (if (not (= mult 0.0))
- (set! sum (+ sum (* sign mult (mixer-determinant (sub-matrix mx 0 i))))))
- (set! sign (- sign))))
- sum))))))
-
-(define* (mixer-poly mx :rest coeffs)
- "(mixer-poly mx :rest coeffs) returns a new mixer, the result of treating 'mx' as the argument to the polynomial defined by the 'coeffs' list"
- (let* ((n (length coeffs))
- (nmx (make-scalar-mixer (length mx) (list-ref coeffs (- n 1))))
- (x (mixer* mx 1.0)))
- (do ((i (- n 2) (- i 1)))
- ((< i 0))
- (set! nmx (mixer+ nmx (mixer* x (list-ref coeffs i))))
- (set! x (mixer* mx x)))
- nmx))
-
-;;; (define (vct-norm v1) (sqrt (dot-product v1 v1)))
-
-(define (mixer-trace mx)
- "(mixer-trace mx) returns the trace of 'mx'"
- (let ((sum 0.0)
- (n (length mx)))
- (do ((i 0 (+ 1 i)))
- ((= i n) sum)
- (set! sum (+ sum (mat mx i i))))))
-
-
-(define* (invert-matrix matrix b (zero 1.0e-7))
- "(invert-matrix matrix b (zero 1.0e-7)) inverts 'matrix'"
- ;; translated from Numerical Recipes (gaussj)
- (call-with-exit
- (lambda (return)
- (let* ((n (length matrix))
- (cols (make-vector n 0))
- (rows (make-vector n 0))
- (pivots (make-vector n 0)))
- (do ((i 0 (+ 1 i)))
- ((= i n))
- (let ((biggest 0.0)
- (col 0)
- (row 0))
- (do ((j 0 (+ 1 j)))
- ((= j n))
- (if (not (= (pivots j) 1))
- (begin
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (if (= (pivots k) 0)
- (let ((val (abs (mat matrix j k))))
- (if (> val biggest)
- (begin
- (set! col k)
- (set! row j)
- (set! biggest val))))
- (if (> (pivots k) 1)
- (return #f)))))))
- (if (< biggest zero) (return #f)) ; this can be fooled (floats...): (invert-matrix (make-mixer 3 1 2 3 3 2 1 4 5 6))
- (set! (pivots col) (+ (pivots col) 1))
- (if (not (= row col))
- (let ((temp (if b (frame-ref b row) 0.0)))
- (if b
- (begin
- (frame-set! b row (frame-ref b col))
- (frame-set! b col temp)))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! temp (mat matrix row k))
- (set! (mat matrix row k) (mat matrix col k))
- (set! (mat matrix col k) temp))))
- (set! (cols i) col)
- (set! (rows i) row)
- ;; round-off troubles here
- (if (< (abs (mat matrix col col)) zero)
- (return #f))
- (let ((inverse-pivot (/ 1.0 (mat matrix col col))))
- (set! (mat matrix col col) 1.0)
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! (mat matrix col k) (* inverse-pivot (mat matrix col k))))
- (if b (frame-set! b col (* inverse-pivot (frame-ref b col)))))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (if (not (= k col))
- (let ((scl (mat matrix k col)))
- (set! (mat matrix k col) 0.0)
- (do ((m 0 (+ 1 m)))
- ((= m n))
- (set! (mat matrix k m) (- (mat matrix k m) (* scl (mat matrix col m)))))
- (if b (frame-set! b k (- (frame-ref b k) (* scl (frame-ref b col))))))))))
- (do ((i (- n 1) (- i 1)))
- ((< i 0))
- (if (not (= (rows i) (cols i)))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (let ((temp (mat matrix k (rows i))))
- (set! (mat matrix k (rows i)) (mat matrix k (cols i)))
- (set! (mat matrix k (cols i)) temp)))))
- (list matrix b)))))
-
-;;; it would be faster to use invert-matrix to calculate the determinant, but that
-;;; really forces us to use doubles throughout -- probably should anyway...
-
-(define (mixer-solve A b)
- "(mixer-solve A b) returns the solution of Ax=b"
- (let ((val (invert-matrix A b)))
- (and val (cadr val))))
-
-(define (mixer-inverse A)
- "(mixer-inverse A) returns the inverse of 'A'"
- (let ((val (invert-matrix A)))
- (and val (car val))))
-
-#|
-(define (plane p1 p2 p3) ; each p a list of 3 coords, returns list (a b c d) of ax + by + cz = 1 (d = -1)
- (let ((m (make-mixer 3))
- (f (make-frame 3 1 1 1)))
- (do ((i 0 (+ 1 i)))
- ((= i 3))
- (mixer-set! m 0 i (list-ref p1 i))
- (mixer-set! m 1 i (list-ref p2 i))
- (mixer-set! m 2 i (list-ref p3 i)))
- (let ((b (mixer-solve m f)))
- (list (frame-ref b 0) (frame-ref b 1) (frame-ref b 2) -1))))
-
-;;; (plane '(0 0 1) '(1 0 0) '(0 1 0))
-;;; (1.0 1.0 1.0 -1)
-|#
diff --git a/mockery.scm b/mockery.scm
new file mode 100644
index 0000000..38cf0e7
--- /dev/null
+++ b/mockery.scm
@@ -0,0 +1,1136 @@
+(provide 'mockery.scm)
+
+(define (outlet-member obj e)
+ (or (eq? obj e)
+ (and (not (eq? obj (rootlet)))
+ (outlet-member (outlet obj) e))))
+
+(define (make-method f accessor)
+ (lambda args
+ (if (let? (car args))
+ (apply f (accessor (car args)) (cdr args))
+ (apply f (car args) (accessor (cadr args)) (cddr args)))))
+
+(define (make-object . args)
+ (openlet
+ (apply inlet args)))
+
+
+(define (mock->string obj . args)
+ (dynamic-wind
+ (lambda () (coverlet obj))
+ (lambda () (apply #_object->string (obj 'value) args))
+ (lambda () (openlet obj))))
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(define *mock-vector*
+ (let ((mock-vector? #f))
+ (let ((mock-vector-class
+ (openlet
+ (inlet 'morally-equal? (make-method #_morally-equal? (lambda (obj) (obj 'value))) ; see comment below
+
+ 'local-set! (lambda (obj i val) ; reactive-vector uses this as a hook into vector-set!
+ (if (vector? (obj 'value))
+ (#_vector-set! (obj 'value) i val)
+ (error 'wrong-type-arg "vector-set! ~S ~S ~S" obj i val))) ; the wrong arg here is 'i
+ 'vector-set! (lambda (obj i val) ((obj 'local-set!) obj i val) val)
+ 'let-set! (lambda (obj i val) ((obj 'local-set!) obj i val) val)
+
+ 'vector-ref (lambda (obj i)
+ (if (mock-vector? obj)
+ (#_vector-ref (obj 'value) i)
+ (error 'wrong-type-arg "vector-ref ~S ~S" obj i)))
+
+ 'let-ref (lambda (obj i) (#_vector-ref (obj 'value) i)) ; the implicit case, so 'i can't be the culprit
+ 'vector-length (lambda (obj) (#_length (obj 'value)))
+ (reader-cond ((not (provided? 'pure-s7))
+ 'vector-append (make-method #_vector-append (lambda (obj) (obj 'value)))))
+ 'reverse (lambda (obj) (#_reverse (obj 'value)))
+ 'sort! (lambda (obj f) (#_sort! (obj 'value) f))
+ 'make-iterator (lambda (obj) (#_make-iterator (obj 'value)))
+ 'arity (lambda (obj) (#_arity (obj 'value)))
+ 'object->string (lambda* (obj (w #t)) (if (eq? w :readable) "*mock-vector*" "#<mock-vector-class>"))
+ 'vector-dimensions (lambda (obj) (#_vector-dimensions (obj 'value)))
+ 'fill! (lambda (obj val) (#_fill! (obj 'value) val))
+
+ 'vector->list (lambda (obj . args)
+ (if (mock-vector? obj)
+ (map values (obj 'value))
+ (error 'wrong-type-arg "vector->list ~S ~S" obj args)))
+
+ 'make-shared-vector (lambda* (obj dim (off 0))
+ (if (mock-vector? obj)
+ (#_make-shared-vector (obj 'value) dim off)
+ (error 'wrong-type-arg "make-shared-vector ~S ~S ~S" obj dim off)))
+
+ 'vector-fill! (lambda (obj . args)
+ (if (mock-vector? obj)
+ (apply #_fill! (obj 'value) args)
+ (error 'wrong-type-arg "vector-fill! ~S ~S ~S ~S" obj val start end)))
+
+ 'copy (lambda* (source dest . args)
+ ;; copy by itself does not make a new vector, but if no dest we
+ ;; need a copy of source, so use coverlet/openlet to make sure
+ ;; we aren't caught in an infinite recursion.
+ (if (mock-vector? source)
+ (if (and dest (not (let? dest)))
+ (apply copy (source 'value) dest args)
+ (let ((nobj (or dest
+ (dynamic-wind
+ (lambda () (coverlet source))
+ (lambda () (openlet (copy source)))
+ (lambda () (openlet source))))))
+ (if dest
+ (apply copy (source 'value) (nobj 'value) args)
+ (set! (nobj 'value) (copy (source 'value))))
+ nobj))
+ (error 'wrong-type-arg "copy ~S ~S ~S" source dest args)))
+ 'vector? (lambda (obj) #t)
+ 'values (lambda (obj . args) (obj 'value))
+ 'length (lambda (obj) (#_length (obj 'value)))
+ 'append (make-method #_append (lambda (obj) (obj 'value)))
+ 'class-name 'mock-vector))))
+
+ (define* (make-mock-vector len (init #<unspecified>))
+ (openlet (sublet mock-vector-class
+ 'value (#_make-vector len init)
+ 'object->string mock->string)))
+
+ (define (mock-vector . args)
+ (let ((v (make-mock-vector 0)))
+ (set! (v 'value) (apply #_vector args))
+ v))
+
+ (set! mock-vector? (lambda (obj)
+ (and (openlet? obj)
+ (outlet-member obj mock-vector-class))))
+
+ (curlet))))
+
+
+#|
+;;; the morally-equal? method should track circles (via cyclic-sequences?)
+;;; as it is now, this code cores up indefinitely:
+(let ((v1 ((*mock-vector* 'mock-vector) 1 2 3 4))
+ (v2 ((*mock-vector* 'mock-vector) 2 3 4))
+ (v3 #(1 2 3 4))
+ (v4 #(2 3 4)))
+ (vector-set! v2 0 v1)
+ (vector-set! v1 0 v2)
+ (vector-set! v4 0 v3)
+ (vector-set! v3 0 v4)
+ (morally-equal? v1 v3))
+;;; but how to make this cooperate with the built-in method -- we should call cyclic-sequences just once
+|#
+
+#|
+;; vector that grows to accommodate vector-set!
+
+(define stretchable-vector-class
+ (let ((local-ref (lambda (obj index)
+ (if (>= index (length (obj 'value)))
+ (obj 'initial-element)
+ (#_vector-ref (obj 'value) index))))
+ (local-set! (lambda (obj index val)
+ (if (>= index (length (obj 'value)))
+ (set! (obj 'value) (copy (obj 'value) (make-vector (+ index 8) (obj 'initial-element)))))
+ (#_vector-set! (obj 'value) index val))))
+ (openlet
+ (sublet (*mock-vector* 'mock-vector-class)
+ 'value (vector)
+ 'object->string mock->string
+ 'initial-element #f
+ 'vector-ref local-ref
+ 'let-ref local-ref
+ 'vector-set! local-set!
+ 'let-set! local-set!))))
+|#
+
+
+;;; --------------------------------------------------------------------------------
+
+(define *mock-hash-table*
+ (let ((mock-hash-table? #f))
+ (let ((mock-hash-table-class
+ (openlet
+ (inlet 'morally-equal? (lambda (x y) (#_morally-equal? (x 'mock-hash-table-table) y))
+ 'hash-table-ref (lambda (obj key) (#_hash-table-ref (obj 'mock-hash-table-table) key))
+ 'hash-table-set! (lambda (obj key val) (#_hash-table-set! (obj 'mock-hash-table-table) key val))
+ 'hash-table-entries (lambda (obj) (#_hash-table-entries (obj 'mock-hash-table-table)))
+ 'make-iterator (lambda (obj) (#_make-iterator (obj 'mock-hash-table-table)))
+
+ 'let-ref-fallback (lambda (obj key)
+ (if (defined? 'mock-hash-table-table obj)
+ (#_hash-table-ref (obj 'mock-hash-table-table) key)))
+ 'let-set!-fallback (lambda (obj key val)
+ (if (defined? 'mock-hash-table-table obj)
+ (#_hash-table-set! (obj 'mock-hash-table-table) key val)))
+
+ ;; the fallbacks are needed because hash-tables and lets use exactly the same syntax in implicit indexing:
+ ;; (x 'y) but s7 can't tell that in this one case, we actually want the 'y to be a key not a field.
+ ;; So, to avoid infinite recursion in let-ref (implicit index), if let-ref can't find the let field,
+ ;; and the let has 'let-ref|set!-fallback, let-ref|set! passes the argument to that function rather than
+ ;; return #<undefined>.
+ ;;
+ ;; (round (openlet (inlet 'round (lambda (obj) (#_round (obj 'value))) 'let-ref-fallback (lambda args 3)))) -> 3
+
+ 'fill! (lambda (obj val) (#_fill! (obj 'mock-hash-table-table) val))
+ 'reverse (lambda (obj) (#_reverse (obj 'mock-hash-table-table)))
+ 'object->string (lambda* (obj (w #t)) (if (eq? w :readable) "*mock-hash-table*" "#<mock-hash-table-class>"))
+ 'arity (lambda (obj) (#_arity (obj 'mock-hash-table-table)))
+ 'copy (lambda* (source dest . args)
+ (if (mock-hash-table? source)
+ (if (and dest (not (let? dest)))
+ (apply copy (obj 'mock-hash-table-table) dest args)
+ (let ((nobj (or dest (openlet (copy (coverlet source))))))
+ (openlet source)
+ (set! (nobj 'mock-hash-table-table) (copy (source 'mock-hash-table-table)))
+ nobj))
+ (error 'wrong-type-arg "copy ~S ~S ~S" source dest args)))
+ 'hash-table? (lambda (obj) #t)
+ 'values (lambda (obj . args) (obj 'mock-hash-table-table))
+ 'length (lambda (obj) (#_length (obj 'mock-hash-table-table)))
+ 'append (make-method #_append (lambda (obj) (obj 'value)))
+ 'class-name 'mock-hash-table))))
+
+ (define* (make-mock-hash-table (len 511))
+ (openlet
+ (sublet mock-hash-table-class
+ 'mock-hash-table-table (#_make-hash-table len)
+
+ ;; object->string here is a problem -- don't set any value to the object itself!
+ 'object->string (lambda (obj . args) ; can't use mock->string because the value is not in the 'value field
+ (dynamic-wind
+ (lambda () (coverlet obj))
+ (lambda () (apply #_object->string (obj 'mock-hash-table-table) args))
+ (lambda () (openlet obj)))))))
+
+ (define (mock-hash-table . args)
+ (let ((v (make-mock-hash-table)))
+ (set! (v 'mock-hash-table-table) (apply #_hash-table args))
+ v))
+
+ (define (mock-hash-table* . args)
+ (let ((v (make-mock-hash-table)))
+ (set! (v 'mock-hash-table-table) (apply #_hash-table* args))
+ v))
+
+ (set! mock-hash-table? (lambda (obj)
+ (and (openlet? obj)
+ (outlet-member obj mock-hash-table-class))))
+
+ (curlet))))
+
+
+#|
+;; hash-table that returns a special identifier when key is not in the table
+
+(define gloomy-hash-table
+ (openlet
+ (sublet (*mock-hash-table* 'mock-hash-table-class) ; ideally this would be a separate (not copied) gloomy-hash-table-class
+ 'mock-hash-table-table #f
+ 'false (gensym)
+ 'not-a-key #f
+ 'hash-table-ref (lambda (obj key)
+ (let ((val (#_hash-table-ref (obj 'mock-hash-table-table) key)))
+ (if (eq? val (obj 'false))
+ #f
+ (or val (obj 'not-a-key)))))
+ 'hash-table-key? (lambda (obj key)
+ (#_hash-table-ref (obj 'mock-hash-table-table) key)))))
+
+(define (hash-table-key? obj key)
+ ((obj 'hash-table-key?) obj key))
+
+(define* (make-gloomy-hash-table (len 511) not-a-key)
+ (let ((ht (copy gloomy-hash-table)))
+ (set! (ht 'mock-hash-table-table) (make-hash-table len))
+ (set! (ht 'not-a-key) not-a-key)
+ ht))
+|#
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(define *mock-string*
+ (let ((mock-string? #f))
+ (let ((mock-string-class
+ (openlet
+ (inlet 'morally-equal? (lambda (x y) (#_morally-equal? (x 'value) y))
+ 'reverse (lambda (obj) (#_reverse (obj 'value)))
+ 'object->string (lambda* (obj (w #t)) (if (eq? w :readable) "*mock-string*" "#<mock-string-class>"))
+ 'arity (lambda (obj) (#_arity (obj 'value)))
+ 'make-iterator (lambda (obj) (#_make-iterator (obj 'value)))
+ 'let-ref (lambda (obj i) (#_string-ref (obj 'value) i)) ; these are the implicit cases
+ 'let-set! (lambda (obj i val) (string-set! (obj 'value) i val))
+ 'string-length (lambda (obj) (#_length (obj 'value)))
+ 'string-append (make-method #_string-append (lambda (obj) (obj 'value)))
+ 'string-copy (lambda (obj) (#_copy (obj 'value)))
+ 'string=? (make-method #_string=? (lambda (obj) (obj 'value)))
+ 'string<? (make-method #_string<? (lambda (obj) (obj 'value)))
+ 'string>? (make-method #_string>? (lambda (obj) (obj 'value)))
+ 'string<=? (make-method #_string<=? (lambda (obj) (obj 'value)))
+ 'string>=? (make-method #_string>=? (lambda (obj) (obj 'value)))
+ 'string-downcase (lambda (obj) (#_string-downcase (obj 'value)))
+ 'string-upcase (lambda (obj) (#_string-upcase (obj 'value)))
+ 'string->symbol (lambda (obj) (#_string->symbol (obj 'value)))
+ 'symbol (lambda (obj) (#_symbol (obj 'value)))
+ 'gensym (lambda (obj) (#_gensym (obj 'value)))
+ 'make-keyword (lambda (obj) (#_make-keyword (obj 'value)))
+ 'open-input-string (lambda (obj) (#_open-input-string (obj 'value)))
+ 'call-with-input-string (lambda (obj f) (#_call-with-input-string (obj 'value) f))
+ 'with-input-from-string (lambda (obj f) (#_with-input-from-string (obj 'value) f))
+ 'directory? (lambda (obj) (#_directory? (obj 'value)))
+ 'file-exists? (lambda (obj) (#_file-exists? (obj 'value)))
+ 'getenv (lambda (obj) (#_getenv (obj 'value)))
+ 'delete-file (lambda (obj) (#_delete-file (obj 'value)))
+ 'system (lambda* (obj cap) (#_system (obj 'value) cap))
+ '->byte-vector (lambda (obj) (#_->byte-vector (obj 'value))) ; this is in-place!
+ 'load (lambda* (obj (e (curlet))) (#_load (obj 'value) e))
+ 'eval-string (lambda* (obj (e (curlet))) (#_eval-string (obj 'value) e))
+ 'char-position (make-method #_char-position (lambda (obj) (obj 'value)))
+
+ 'format (make-method #_format (lambda (obj) (obj 'value)))
+ 'string-fill! (lambda* (obj val (start 0) end)
+ (if (mock-string? obj)
+ (#_string-fill! (obj 'value) val start (or end (#_string-length (obj 'value))))
+ (error 'wrong-type-arg "string-fill! ~S ~S ~S ~S" obj val start end)))
+
+ 'fill! (lambda (obj val)
+ (if (mock-string? obj)
+ (#_fill! (obj 'value) val)
+ (error 'wrong-type-arg "fill! ~S ~S" obj val)))
+
+ 'copy (lambda* (obj . args)
+ (if (mock-string? obj)
+ (apply #_copy (obj 'value) args)
+ (error 'wrong-type-arg "copy ~S ~S" obj args)))
+
+ 'substring (lambda (obj . args)
+ (if (mock-string? obj)
+ (apply #_substring (obj 'value) args)
+ (error 'wrong-type-arg "substring ~S ~S" obj args)))
+
+ 'string->number (lambda* (obj (r 10))
+ (if (mock-string? obj)
+ (#_string->number (obj 'value) r)
+ (error 'wrong-type-arg "string->number ~S ~S" obj r)))
+
+ 'write-string (lambda (obj . args)
+ (if (mock-string? obj)
+ (apply #_write-string (obj 'value) args)
+ (error 'wrong-type-arg "write-string ~S ~S" obj args)))
+
+ 'string-position (lambda* (s1 s2 (start 0))
+ (if (mock-string? s1)
+ (#_string-position (s1 'value) s2 start)
+ (if (mock-string? s2)
+ (#_string-position s1 (s2 'value) start)
+ (error 'wrong-type-arg "write-string ~S ~S ~S" s1 s2 start))))
+ 'string-ref (lambda (obj i)
+ (if (mock-string? obj)
+ (#_string-ref (obj 'value) i)
+ (error 'wrong-type-arg "string-ref ~S ~S" obj i)))
+
+ 'string-set! (lambda (obj i val)
+ (if (mock-string? obj)
+ (#_string-set! (obj 'value) i val)
+ (error 'wrong-type-arg "string-set! ~S ~S ~S" obj i val)))
+ (reader-cond ((not (provided? 'pure-s7))
+ 'string->list (make-method #_string->list (lambda (obj) (obj 'value)))
+ 'string-ci=? (make-method #_string-ci=? (lambda (obj) (obj 'value)))
+ 'string-ci<? (make-method #_string-ci<? (lambda (obj) (obj 'value)))
+ 'string-ci>? (make-method #_string-ci>? (lambda (obj) (obj 'value)))
+ 'string-ci<=? (make-method #_string-ci<=? (lambda (obj) (obj 'value)))
+ 'string-ci>=? (make-method #_string-ci>=? (lambda (obj) (obj 'value)))))
+
+ 'string? (lambda (obj) #t)
+ 'values (lambda (obj . args) (obj 'value))
+ 'length (lambda (obj) (#_string-length (obj 'value)))
+ 'append (make-method #_append (lambda (obj) (obj 'value)))
+ 'class-name 'mock-string))))
+
+ (define* (make-mock-string len (init #\null))
+ (openlet (sublet mock-string-class
+ 'value (#_make-string len init)
+ 'object->string mock->string)))
+
+ (define (mock-string . args)
+ (let ((v (make-mock-string 0)))
+ (set! (v 'value)
+ (if (string? (car args))
+ (car args)
+ (apply #_string args)))
+ v))
+
+ (set! mock-string? (lambda (obj)
+ (and (openlet? obj)
+ (outlet-member obj mock-string-class))))
+
+ (curlet))))
+
+#|
+;; string that is always the current time of day
+(require libc.scm)
+
+(define time-string
+ (let ((daytime (lambda args
+ (with-let (sublet *libc*)
+ (let ((timestr (make-string 64)))
+ (let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z"
+ (localtime
+ (time.make (time (c-pointer 0)))))))
+ (substring timestr 0 len)))))))
+ (openlet
+ (sublet (*mock-string* 'mock-string-class) ; the mock-string isn't really needed here
+ 'let-ref-fallback daytime
+ 'object->string daytime))))
+
+;; similarly ("JIT data"):
+(define ? (openlet
+ (inlet 'object->string (lambda (obj . args)
+ (apply #_object->string (owlet) args)))))
+
+|#
+
+
+;;; --------------------------------------------------------------------------------
+
+(define *mock-char*
+ (let ((mock-char? #f))
+ (let ((mock-char-class
+ (openlet
+ (inlet 'morally-equal? (lambda (x y) (#_morally-equal? (x 'value) y))
+ 'char-upcase (lambda (obj) (#_char-upcase (obj 'value)))
+ 'char-downcase (lambda (obj) (#_char-downcase (obj 'value)))
+ 'char->integer (lambda (obj) (#_char->integer (obj 'value)))
+ 'char-upper-case? (lambda (obj) (#_char-upper-case? (obj 'value)))
+ 'char-lower-case? (lambda (obj) (#_char-lower-case? (obj 'value)))
+ 'char-alphabetic? (lambda (obj) (#_char-alphabetic? (obj 'value)))
+ 'char-numeric? (lambda (obj) (#_char-numeric? (obj 'value)))
+ 'char-whitespace? (lambda (obj) (#_char-whitespace? (obj 'value)))
+ 'char=? (make-method #_char=? (lambda (obj) (obj 'value)))
+ 'char<? (make-method #_char<? (lambda (obj) (obj 'value)))
+ 'char>? (make-method #_char>? (lambda (obj) (obj 'value)))
+ 'char<=? (make-method #_char<=? (lambda (obj) (obj 'value)))
+ 'char>=? (make-method #_char>=? (lambda (obj) (obj 'value)))
+ 'char-ci=? (make-method #_char-ci=? (lambda (obj) (obj 'value)))
+ 'char-ci<? (make-method #_char-ci<? (lambda (obj) (obj 'value)))
+ 'char-ci>? (make-method #_char-ci>? (lambda (obj) (obj 'value)))
+ 'char-ci<=? (make-method #_char-ci<=? (lambda (obj) (obj 'value)))
+ 'char-ci>=? (make-method #_char-ci>=? (lambda (obj) (obj 'value)))
+ 'string (make-method #_string (lambda (obj) (obj 'value)))
+ 'object->string (lambda* (obj (w #t)) (if (eq? w :readable) "*mock-char*" "#<mock-char-class>"))
+ 'arity (lambda (obj) (#_arity (obj 'value)))
+ 'format (make-method #_format (lambda (obj) (obj 'value)))
+ 'make-string (make-method #_make-string (lambda (obj) (obj 'value)))
+ 'char-position (make-method #_char-position (lambda (obj) (obj 'value)))
+
+ 'write-char (lambda (obj . args)
+ (if (mock-char? obj)
+ (apply #_write-char (obj 'value) args)
+ (error 'wrong-type-arg "write-char: ~S ~S" obj args)))
+
+ 'string-set! (lambda (obj ind val)
+ (if (and (string? obj)
+ (integer? ind))
+ (#_string-set! obj ind (val 'value))
+ (error 'wrong-type-arg "string-set! ~S ~S ~S" obj ind val)))
+
+ 'copy (lambda (obj . args)
+ (if (mock-char? obj)
+ (obj 'value)
+ (error 'wrong-type-arg "copy: ~S ~S" obj args)))
+ 'char? (lambda (obj) #t)
+ 'class-name 'mock-char
+ 'length (lambda (obj) #f)
+ 'values (lambda (obj . args) (obj 'value))))))
+
+ (define (mock-char c)
+ (if (and (char? c)
+ (not (let? c)))
+ (openlet
+ (sublet (*mock-char* 'mock-char-class)
+ 'value c
+ 'object->string mock->string))
+ (error 'wrong-type-arg "mock-char ~S is not a char" c)))
+
+ (set! mock-char? (lambda (obj)
+ (and (openlet? obj)
+ (outlet-member obj mock-char-class))))
+
+ (curlet))))
+
+#|
+;;; eventually I'll conjure up unichars like (define lambda (byte-vector #xce #xbb)) via mock-char,
+;;; then combine those into unistring via mock-string
+;;;
+;;; (string-length obj)->g_utf8_strlen etc
+;;; (g_unichar_isalpha (g_utf8_get_char (byte-vector #xce #xbb))) -> #t
+;;; (g_utf8_strlen (byte-vector #xce #xbb #xce #xba) 10) -> 2
+;;; (g_utf8_normalize (byte-vector #xce #xbb #xce #xba) 4 G_NORMALIZE_DEFAULT)
+;;; but the ones that return gunichar (toupper) currently don't return a byte-vector or a string
+;;; maybe gunichar->byte-vector?
+;;; need glib.scm, or unicode.scm to load the stuff
+|#
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(define *mock-number*
+ (let ((mock-number? #f))
+
+ (define* (range-method-1 func arg start end)
+ (if (not end)
+ (func arg (start 'value))
+ (if (not (let? start))
+ (func arg start (end 'value))
+ (apply func arg (start 'value) end ()))))
+
+ (define* (range-method-2 func arg1 arg2 start end)
+ (if (not end)
+ (func arg1 arg2 (start 'value))
+ (if (not (let? start))
+ (func arg1 arg2 start (end 'value))
+ (apply func arg1 arg2 (start 'value) end ()))))
+
+ (let ((mock-number-class
+ (openlet
+ (inlet
+ 'morally-equal? (lambda (x y) (#_morally-equal? (x 'value) y))
+ 'object->string (lambda* (obj (w #t)) (if (eq? w :readable) "*mock-number*" "#<mock-number-class>"))
+ 'arity (lambda (obj) (#_arity (obj 'value)))
+ 'real-part (lambda (obj) (#_real-part (obj 'value)))
+ 'imag-part (lambda (obj) (#_imag-part (obj 'value)))
+ 'numerator (lambda (obj) (#_numerator (obj 'value)))
+ 'denominator (lambda (obj) (#_denominator (obj 'value)))
+ 'even? (lambda (obj) (#_even? (obj 'value)))
+ 'odd? (lambda (obj) (#_odd? (obj 'value)))
+ 'zero? (lambda (obj) (#_zero? (obj 'value)))
+ 'positive? (lambda (obj) (#_positive? (obj 'value)))
+ 'negative? (lambda (obj) (#_negative? (obj 'value)))
+ 'infinite? (lambda (obj) (#_infinite? (obj 'value)))
+ 'nan? (lambda (obj) (#_nan? (obj 'value)))
+ (reader-cond ((not (provided? 'pure-s7))
+ 'make-polar (make-method #_make-polar (lambda (obj) (obj 'value)))
+ 'make-rectangular (make-method #_complex (lambda (obj) (obj 'value)))))
+ 'complex (make-method #_complex (lambda (obj) (obj 'value)))
+ 'random-state (make-method #_random-state (lambda (obj) (obj 'value)))
+ 'magnitude (lambda (obj) (#_magnitude (obj 'value)))
+ 'angle (lambda (obj) (#_angle (obj 'value)))
+ 'rationalize (make-method #_rationalize (lambda (obj) (obj 'value)))
+ 'abs (lambda (obj) (#_abs (obj 'value)))
+ 'exp (lambda (obj) (#_exp (obj 'value)))
+ 'log (make-method #_log (lambda (obj) (obj 'value)))
+ 'sin (lambda (obj) (#_sin (obj 'value)))
+ 'cos (lambda (obj) (#_cos (obj 'value)))
+ 'tan (lambda (obj) (#_tan (obj 'value)))
+ 'asin (lambda (obj) (#_asin (obj 'value)))
+ 'acos (lambda (obj) (#_acos (obj 'value)))
+ 'atan (make-method #_atan (lambda (obj) (obj 'value)))
+ 'sinh (lambda (obj) (#_sinh (obj 'value)))
+ 'cosh (lambda (obj) (#_cosh (obj 'value)))
+ 'tanh (lambda (obj) (#_tanh (obj 'value)))
+ 'asinh (lambda (obj) (#_asinh (obj 'value)))
+ 'acosh (lambda (obj) (#_acosh (obj 'value)))
+ 'atanh (lambda (obj) (#_atanh (obj 'value)))
+ 'sqrt (lambda (obj) (#_sqrt (obj 'value)))
+ 'expt (make-method #_expt (lambda (obj) (obj 'value)))
+ 'floor (lambda (obj) (#_floor (obj 'value)))
+ 'ceiling (lambda (obj) (#_ceiling (obj 'value)))
+ 'truncate (lambda (obj) (#_truncate (obj 'value)))
+ 'round (lambda (obj) (#_round (obj 'value)))
+ 'integer->char (lambda (obj) (#_integer->char (obj 'value)))
+ 'inexact->exact (lambda (obj) (#_inexact->exact (obj 'value)))
+ 'exact->inexact (lambda (obj) (#_exact->inexact (obj 'value)))
+ 'integer-length (lambda (obj) (#_integer-length (obj 'value)))
+ 'integer-decode-float (lambda (obj) (#_integer-decode-float (obj 'value)))
+ 'number? (lambda (obj) (#_number? (obj 'value))) ; why not #t? currently (mock-number (mock-number ...)) is an error
+ 'integer? (lambda (obj) (#_integer? (obj 'value)))
+ 'real? (lambda (obj) (#_real? (obj 'value)))
+ 'complex? (lambda (obj) (#_complex? (obj 'value)))
+ 'rational? (lambda (obj) (#_rational? (obj 'value)))
+ 'exact? (lambda (obj) (#_exact? (obj 'value)))
+ 'inexact? (lambda (obj) (#_inexact? (obj 'value)))
+ 'ash (make-method #_ash (lambda (obj) (obj 'value)))
+ 'logbit? (make-method #_logbit? (lambda (obj) (obj 'value)))
+ 'number->string (make-method #_number->string (lambda (obj) (obj 'value)))
+ 'random (make-method #_random (lambda (obj) (obj 'value)))
+ 'quotient (make-method #_quotient (lambda (obj) (obj 'value)))
+ 'remainder (make-method #_remainder (lambda (obj) (obj 'value)))
+ 'modulo (make-method #_modulo (lambda (obj) (obj 'value)))
+ 'lognot (lambda (obj) (#_lognot (obj 'value)))
+ 'logior (make-method #_logior (lambda (obj) (obj 'value)))
+ 'logxor (make-method #_logxor (lambda (obj) (obj 'value)))
+ 'logand (make-method #_logand (lambda (obj) (obj 'value)))
+ ;; any object that has lcm or gcd also needs rational?
+ 'lcm (make-method #_lcm (lambda (obj) (obj 'value)))
+ 'gcd (make-method #_gcd (lambda (obj) (obj 'value)))
+ '+ (make-method #_+ (lambda (obj) (obj 'value)))
+ '- (make-method #_- (lambda (obj) (obj 'value)))
+ '* (make-method #_* (lambda (obj) (obj 'value)))
+ '/ (make-method #_/ (lambda (obj) (obj 'value)))
+ ;; any object that has min or max also needs real?
+ 'max (make-method #_max (lambda (obj) (obj 'value)))
+ 'min (make-method #_min (lambda (obj) (obj 'value)))
+ '= (make-method #_= (lambda (obj) (obj 'value)))
+ '< (make-method #_< (lambda (obj) (obj 'value)))
+ '> (make-method #_> (lambda (obj) (obj 'value)))
+ '<= (make-method #_<= (lambda (obj) (obj 'value)))
+ '>= (make-method #_>= (lambda (obj) (obj 'value)))
+ 'write-byte (lambda (byte . port) (apply #_write-byte (byte 'value) port))
+
+ 'make-list (lambda (ind . args) (apply #_make-list (ind 'value) args))
+ 'make-vector (make-method #_make-vector (lambda (obj) (obj 'value)))
+ 'make-float-vector(make-method #_make-float-vector (lambda (obj) (obj 'value)))
+ 'make-hash-table (lambda (ind . args) (apply #_make-hash-table (ind 'value) args))
+ 'make-byte-vector (make-method #_make-byte-vector (lambda (obj) (obj 'value)))
+
+ 'byte-vector (make-method #_byte-vector (lambda (obj) (obj 'value)))
+ 'format (make-method #_format (lambda (obj) (obj 'value)))
+
+ 'make-string (lambda (ind . args)
+ (if (mock-number? ind)
+ (apply #_make-string (ind 'value) args)
+ (error 'wrong-type-arg "make-string ~S ~S" ind args)))
+
+ 'string-ref (lambda (str ind)
+ (if (string? str)
+ (#_string-ref str (ind 'value))
+ (error 'wrong-type-arg "make-string ~S ~S" str ind)))
+
+ 'string-set! (lambda (str ind val)
+ (if (string? str)
+ (#_string-set! str (ind 'value) val)
+ (error 'wrong-type-arg "string-set! ~S ~S ~S" str ind val)))
+
+ 'string->number (lambda (str radix)
+ (if (string? str)
+ (#_string->number str (radix 'value))
+ (error 'wrong-type-arg "string->number ~S ~S" str radix)))
+
+ 'list-ref (lambda (lst ind)
+ (if (pair? lst)
+ (#_list-ref lst (ind 'value))
+ (error 'wrong-type-arg "list-ref ~S ~S" lst ind)))
+
+ 'list-set! (lambda (lst ind val)
+ (if (pair? lst)
+ (#_list-set! lst (ind 'value) val)
+ (error 'wrong-type-arg "list-set! ~S ~S ~S" lst ind val)))
+
+ 'list-tail (lambda (lst ind)
+ (if (pair? lst)
+ (#_list-tail lst (ind 'value))
+ (error 'wrong-type-arg "list-tail ~S ~S" ind args)))
+
+ 'vector-ref (lambda (vec ind)
+ (if (vector? vec)
+ (#_vector-ref vec (ind 'value))
+ (error 'wrong-type-arg "vector-ref ~S ~S" vec ind)))
+
+ 'vector-set! (lambda (vec ind val)
+ (if (vector? vec)
+ (#_vector-set! vec (ind 'value) val)
+ (error 'wrong-type-arg "vector-set! ~S ~S ~S" vec ind val)))
+
+ 'make-shared-vector (lambda (obj dims offset)
+ (if (and (vector? obj)
+ (pair? dims))
+ (#_make-shared-vector obj dims (offset 'value))
+ (error 'wrong-type-arg "make-shared-vector ~S ~S ~S" obj dims offset)))
+
+ 'vector->list (lambda* (vec start end)
+ (if (vector? vec)
+ ;; when there are two args, either might have triggered this method call,
+ ;; if (not (let? end)) or (let? start), start must be a mock-number
+ ;; and if (not (let? start)), end must be a mock-number, but
+ ;; if (let? start) and (let? end), end might be anything
+ (range-method-1 #_vector->list vec start end)
+ (error 'wrong-type-arg "vector->list ~S ~S ~S" vec start end)))
+
+ 'vector-fill! (lambda* (vec c start end)
+ (if (vector? vec)
+ (range-method-2 #_vector-fill! vec c start end)
+ (error 'wrong-type-arg "vector-fill! ~S ~S ~S ~S" vec c start end)))
+
+ 'substring (lambda* (str start end)
+ (if (string? str)
+ (range-method-1 #_substring start end)
+ (error 'wrong-type-arg "substring ~S ~S ~S" str start end)))
+
+ 'string-fill! (lambda* (str c start end)
+ (if (and (string? str)
+ (char? c))
+ (range-method-2 #_string-fill! str c start end)
+ (error 'wrong-type-arg "string-fill! ~S ~S ~S ~S" str c start end)))
+
+ 'string->list (lambda* (str start end)
+ (if (string? str)
+ (range-method-1 #_string->list str start end)
+ (error 'wrong-type-arg "string->list ~S ~S ~S" str start end)))
+
+ 'write-string (lambda* (str port start end)
+ (if (and (string? str)
+ (output-port? port))
+ (range-method-2 #_write-string str port start end)
+ (error 'wrong-type-arg "write-string ~S ~S ~S ~S" str port start end)))
+
+ 'read-string (lambda* (k (port (current-input-port)))
+ (#_read-string (k 'value) port))
+
+ 'copy (lambda* (obj dest start end)
+ (if (mock-number? obj)
+ (obj 'value)
+ (if (or (mock-number? start)
+ (mock-number? end))
+ (range-method-2 #_copy obj dest start end)
+ (error 'wrong-type-arg "copy ~S ~S ~S ~S" obj dest start end))))
+
+ 'length (lambda (obj) #f)
+ 'number? (lambda (obj) #t)
+ 'values (lambda (obj . args) (obj 'value))
+ 'class-name 'mock-number))))
+
+ (define (mock-number x)
+ (if (and (number? x)
+ (not (let? x)))
+ (openlet
+ (sublet (*mock-number* 'mock-number-class)
+ 'value x
+ 'object->string mock->string))
+ (error 'wrong-type-arg "mock-number ~S is not a number" x)))
+
+ (set! mock-number? (lambda (obj)
+ (and (openlet? obj)
+ (outlet-member obj mock-number-class))))
+
+ (curlet))))
+
+
+#|
+;;; fuzzy number
+
+(define fuzzy-number
+ (let ((fuzz (lambda (fx)
+ (#_* fx (#_- 1.05 (#_random .1))))))
+ (lambda (fx)
+ (openlet
+ (sublet
+ (*mock-number* 'mock-number-class)
+ 'let-ref-fallback (lambda (obj sym) (fuzz fx))
+ 'object->string (lambda (obj . args) (#_number->string (fuzz fx))))))))
+
+
+;;; interval arithmetic
+;;;
+;;; from Wikipedia:
+;;; x + y = [a+c, b+d]
+;;; x - y = [a-d, b-c]
+;;; x × y = [min(ac, ad, bc, bd), max(ac, ad, bc, bd)]
+;;; x / y = [min(a/c, a/d, b/c, b/d), max(a/c, a/d, b/c, b/d)]
+
+(define *interval*
+ (let* ((make-interval #f)
+ (low (lambda (z) (z 'low)))
+ (high (lambda (z) (z 'high)))
+ (interval-class
+ (openlet (sublet (*mock-number* 'mock-number-class)
+
+ '+ (lambda args
+ (let ((lo 0)
+ (hi 0))
+ (for-each
+ (lambda (z)
+ (if (let? z)
+ (begin
+ (set! lo (+ lo (low z)))
+ (set! hi (+ hi (high z))))
+ (begin
+ (set! lo (+ lo z))
+ (set! hi (+ hi z)))))
+ args)
+ (make-interval lo hi)))
+
+ '* (lambda args
+ (let ((lo 1)
+ (hi 1))
+ (for-each
+ (lambda (z)
+ (let ((zlo (if (let? z) (low z) z))
+ (zhi (if (let? z) (high z) z)))
+ (let ((ac (* lo zlo))
+ (ad (* lo zhi))
+ (bc (* hi zlo))
+ (bd (* hi zhi)))
+ (set! lo (min ac ad bc bd))
+ (set! hi (max ac ad bc bd)))))
+ args)
+ (make-interval lo hi)))
+
+ '- (lambda args
+ (let ((z (car args)))
+ (if (null? (cdr args)) ; negate (must be let? else how did we get here?)
+ (make-interval (- (high z)) (- (low z)))
+ (let ((lo (low z))
+ (hi (high z)))
+ (for-each
+ (lambda (z)
+ (if (let? z)
+ (begin
+ (set! lo (- lo (high z)))
+ (set! hi (- hi (low z))))
+ (begin
+ (set! lo (- lo z))
+ (set! hi (- hi z)))))
+ (cdr args))
+ (make-interval lo hi)))))
+
+ '/ (lambda args
+ (let ((z (car args)))
+ (if (null? (cdr args)) ; invert
+ (make-interval (/ (high z)) (/ (low z)))
+ (let ((lo (low z))
+ (hi (high z)))
+ (for-each
+ (lambda (z)
+ (let ((zlo (if (let? z) (low z) z))
+ (zhi (if (let? z) (high z) z)))
+ (let ((ac (/ lo zlo))
+ (ad (/ lo zhi))
+ (bc (/ hi zlo))
+ (bd (/ hi zhi)))
+ (set! lo (min ac ad bc bd))
+ (set! hi (max ac ad bc bd)))))
+ (cdr args))
+ (make-interval lo hi)))))
+
+ 'abs (lambda (z)
+ (if (positive? (low z))
+ (make-interval (low z) (high z))
+ (if (negative? (high z))
+ (make-interval (abs (high z)) (abs (low z)))
+ (make-interval 0 (max (abs (low z)) (abs (high z)))))))
+
+ 'object->string (lambda (obj . args)
+ (format #f "#<interval: ~S ~S>" (low obj) (high obj)))
+ ))))
+
+ (set! make-interval (lambda (low high)
+ (if (> low high) (format *stderr* "~A ~A~%" low high))
+ (openlet (sublet interval-class 'low low 'high high))))
+
+ (curlet)))
+
+(define x ((*interval* 'make-interval) 3.0 4.0))
+|#
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(define *mock-pair*
+ (let ((mock-pair? #f))
+ (let ((mock-pair-class
+ (openlet
+ (inlet 'morally-equal? (lambda (x y) (#_morally-equal? (x 'value) y))
+ 'pair-line-number (lambda (obj) (#_pair-line-number (obj 'value)))
+ 'list->string (lambda (obj) (#_list->string (obj 'value)))
+ 'object->string (lambda* (obj (w #t)) (if (eq? w :readable) "*mock-pair*" "#<mock-pair-class>"))
+ 'list? (lambda (obj) (#_list? (obj 'value)))
+ 'car (lambda (obj) (#_car (obj 'value)))
+ 'cdr (lambda (obj) (#_cdr (obj 'value)))
+ 'set-car! (lambda (obj val) (#_set-car! (obj 'value) val))
+ 'set-cdr! (lambda (obj val) (#_set-cdr! (obj 'value) val))
+ 'caar (lambda (obj) (#_caar (obj 'value)))
+ 'cadr (lambda (obj) (#_cadr (obj 'value)))
+ 'cdar (lambda (obj) (#_cdar (obj 'value)))
+ 'cddr (lambda (obj) (#_cddr (obj 'value)))
+ 'caaar (lambda (obj) (#_caaar (obj 'value)))
+ 'caadr (lambda (obj) (#_caadr (obj 'value)))
+ 'cadar (lambda (obj) (#_cadar (obj 'value)))
+ 'cdaar (lambda (obj) (#_cdaar (obj 'value)))
+ 'caddr (lambda (obj) (#_caddr (obj 'value)))
+ 'cdddr (lambda (obj) (#_cdddr (obj 'value)))
+ 'cdadr (lambda (obj) (#_cdadr (obj 'value)))
+ 'cddar (lambda (obj) (#_cddar (obj 'value)))
+ 'caaaar (lambda (obj) (#_caaaar (obj 'value)))
+ 'caaadr (lambda (obj) (#_caaadr (obj 'value)))
+ 'caadar (lambda (obj) (#_caadar (obj 'value)))
+ 'cadaar (lambda (obj) (#_cadaar (obj 'value)))
+ 'caaddr (lambda (obj) (#_caaddr (obj 'value)))
+ 'cadddr (lambda (obj) (#_cadddr (obj 'value)))
+ 'cadadr (lambda (obj) (#_cadadr (obj 'value)))
+ 'caddar (lambda (obj) (#_caddar (obj 'value)))
+ 'cdaaar (lambda (obj) (#_cdaaar (obj 'value)))
+ 'cdaadr (lambda (obj) (#_cdaadr (obj 'value)))
+ 'cdadar (lambda (obj) (#_cdadar (obj 'value)))
+ 'cddaar (lambda (obj) (#_cddaar (obj 'value)))
+ 'cdaddr (lambda (obj) (#_cdaddr (obj 'value)))
+ 'cddddr (lambda (obj) (#_cddddr (obj 'value)))
+ 'cddadr (lambda (obj) (#_cddadr (obj 'value)))
+ 'cdddar (lambda (obj) (#_cdddar (obj 'value)))
+ 'assoc (lambda (val obj . args) (apply #_assoc val (obj 'value) args))
+ (reader-cond ((not (provided? 'pure-s7))
+ 'assq (lambda (val obj) (#_assq val (obj 'value)))
+ 'assv (lambda (val obj) (#_assv val (obj 'value)))
+ 'memq (lambda (val obj) (#_memq val (obj 'value)))
+ 'memv (lambda (val obj) (#_memv val (obj 'value)))))
+ 'member (lambda (val obj . args) (apply #_member val (obj 'value) args))
+ 'let-ref (lambda (obj ind) (coverlet obj) (let ((val (#_list-ref (obj 'value) ind))) (openlet obj) val))
+ 'let-set! (lambda (obj ind val) (coverlet obj) (#_list-set! (obj 'value) ind val) (openlet obj) val)
+ 'arity (lambda (obj) (#_arity (obj 'value)))
+ 'fill! (lambda (obj val) (#_fill! (obj 'value) val))
+ 'reverse (lambda (obj) (#_reverse (obj 'value)))
+ 'reverse! (lambda (obj) (set! (obj 'value) (#_reverse (obj 'value))))
+ 'sort! (lambda (obj f) (#_sort! (obj 'value) f))
+ 'make-iterator (lambda (obj) (#_make-iterator (obj 'value)))
+ 'eval (lambda (f obj) (#_eval (obj 'value)))
+ 'list->vector (lambda (obj) (#_list->vector (obj 'value)))
+
+ 'list-tail (lambda (obj . args)
+ (if (mock-pair? obj)
+ (apply #_list-tail (obj 'value) args)
+ (error 'wrong-type-arg "list-tail ~S ~S" obj args)))
+
+ 'copy (lambda (obj . args)
+ (if (mock-pair? obj)
+ (apply #_copy (obj 'value) args)
+ (error 'wrong-type-arg "copy ~S ~S" obj args)))
+
+ 'make-shared-vector (lambda (obj dims . args)
+ (if (mock-pair? dims)
+ (apply #_make-shared-vector obj (dims 'value) args)
+ (error 'wrong-type-arg "make-shared-vector ~S ~S ~S" obj dims args)))
+
+ 'make-vector (lambda (obj dims . args)
+ (if (mock-pair? dims)
+ (apply #_make-vector obj (dims 'value) args)
+ (error 'wrong-type-arg "make-vector ~S ~S ~S" obj dims args)))
+
+ 'append (make-method #_append (lambda (obj) (obj 'value)))
+
+ 'list-ref (lambda (obj ind)
+ (if (mock-pair? obj)
+ (#_list-ref (obj 'value) ind)
+ (error 'wrong-type-arg "list-ref ~S ~S" obj ind)))
+
+ 'list-set! (lambda (obj ind val)
+ (if (mock-pair? obj)
+ (#_list-set! (obj 'value) ind val)
+ (error 'wrong-type-arg "list-set! ~S ~S ~S" obj ind val)))
+
+ 'pair? (lambda (obj) #t)
+ 'length (lambda (obj) (#_length (obj 'value)))
+ 'values (lambda (obj . args) (obj 'value))
+ 'append (make-method #_append (lambda (obj) (obj 'value)))
+ 'class-name 'mock-pair))))
+
+ (define (mock-pair . args)
+ (openlet
+ (sublet (*mock-pair* 'mock-pair-class)
+ 'value (copy args)
+ 'object->string mock->string)))
+
+ (set! mock-pair? (lambda (obj)
+ (and (openlet? obj)
+ (outlet-member obj mock-pair-class))))
+
+ (curlet))))
+
+#|
+(let ((immutable-list-class
+ (sublet (*mock-pair* 'mock-pair-class)
+ 'object->string mock->string
+
+ 'let-set! (lambda (obj i val)
+ (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1))))
+ (list-set! (obj 'value) i val))
+ 'list-set! (lambda (obj i val)
+ (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1))))
+ (list-set! (obj 'value) i val))
+ 'set-car! (lambda (obj val)
+ (set! (obj 'value) (cons val (cdr (obj 'value)))))
+ 'set-cdr! (lambda (obj val)
+ (set! (obj 'value) (cons (car (obj 'value)) val)))
+ 'fill! (lambda (obj val)
+ (set! (obj 'value) (fill! (copy (obj 'value)) val)))
+ 'reverse! (lambda (obj)
+ (set! (obj 'value) (reverse (obj 'value))))
+ 'sort! (lambda (obj func)
+ (set! (obj 'value) (sort! (copy (obj 'value)) func))))))
+
+ (define (immutable-list lst)
+ (openlet
+ (sublet immutable-list-class
+ 'value lst))))
+|#
+
+;;; since a mock-pair prints itself as if a list, you can get some strange printout results:
+;;; (cons 'a ((*mock-pair* 'mock-pair) 'b 'c)) -> '(a . (b c))
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(define *mock-symbol*
+ (let ((mock-symbol-class
+ (openlet
+ (inlet 'object->string (lambda* (obj (w #t)) (if (eq? w :readable) "*mock-symbol*" "#<mock-symbol-class>"))
+ 'morally-equal? (lambda (x y) (#_morally-equal? (x 'value) y))
+ 'gensym? (lambda (obj) (#_gensym? (obj 'value)))
+ 'symbol->string (lambda (obj) (#_symbol->string (obj 'value)))
+ 'symbol->value (lambda (obj . args) (apply #_symbol->value (obj 'value) args))
+ 'symbol->dynamic-value (lambda (obj) (#_symbol->dynamic-value (obj 'value)))
+ 'symbol-access (lambda (obj . args) (apply #_symbol-access (obj 'value) args))
+ 'provided? (lambda (obj) (#_provided? (obj 'value)))
+ 'provide (lambda (obj) (#_provide (obj 'value)))
+ 'defined? (lambda (obj) (#_defined? (obj 'value)))
+ 'symbol->keyword (lambda (obj) (#_symbol->keyword (obj 'value)))
+ 'keyword? (lambda (obj) (#_keyword? (obj 'value)))
+ 'keyword->symbol (lambda (obj) (#_keyword->symbol (obj 'value)))
+ 'format (lambda (str s . args) (#_symbol->string s))
+ 'symbol? (lambda (obj) #t)
+ 'class-name 'mock-symbol
+ 'values (lambda (obj . args) (obj 'value))
+ ))))
+
+ (define (mock-symbol s)
+ (if (and (symbol? s)
+ (not (let? s)))
+ (openlet
+ (sublet (*mock-symbol* 'mock-symbol-class)
+ 'value s
+ 'object->string mock->string))
+ (error 'wrong-type-arg "mock-symbol ~S is not a symbol" s)))
+
+ (define (mock-symbol? obj)
+ (and (openlet? obj)
+ (outlet-member obj mock-symbol-class)))
+
+ (curlet)))
+
+
+;;; --------------------------------------------------------------------------------
+
+(define *mock-port*
+ (let ((mock-port? #f))
+ (let ((mock-port-class
+ (openlet
+ (inlet 'port? (lambda (obj) #t)
+ 'morally-equal? (lambda (x y) (#_morally-equal? (x 'value) y))
+ 'close-input-port (lambda (obj) (#_close-input-port (obj 'value)))
+ 'close-output-port (lambda (obj) (#_close-output-port (obj 'value)))
+ 'flush-output-port (lambda (obj) (#_flush-output-port (obj 'value)))
+ 'get-output-string (lambda (obj) (#_get-output-string (obj 'value)))
+ 'newline (lambda (obj) (#_newline (obj 'value)))
+ 'write (lambda (x obj) (#_write x (obj 'value)))
+ 'display (lambda (x obj) (#_display x (obj 'value)))
+ 'read-char (lambda (obj) (#_read-char (obj 'value)))
+ 'peek-char (lambda (obj) (#_peek-char (obj 'value)))
+ 'read-byte (lambda (obj) (#_read-byte (obj 'value)))
+ 'read-line (lambda (obj . args) (apply #_read-line (obj 'value) args))
+ 'read (lambda (obj) (#_read (obj 'value)))
+ 'input-port? (lambda (obj) (#_input-port? (obj 'value)))
+ 'output-port? (lambda (obj) (#_output-port? (obj 'value)))
+ 'port-closed? (lambda (obj) (#_port-closed? (obj 'value)))
+ 'char-ready? (lambda (obj) (#_char-ready? (obj 'value)))
+ 'port-line-number (lambda (obj) (#_port-line-number (obj 'value)))
+ 'port-filename (lambda (obj) (#_port-filename (obj 'value)))
+ 'object->string (lambda* (obj (w #t)) (if (eq? w :readable) "*mock-port*" "#<mock-port-class>"))
+ 'format (make-method #_format (lambda (obj) (obj 'value)))
+
+ 'set-current-output-port (lambda (obj) (#_set-current-output-port (obj 'value)))
+ 'set-current-input-port (lambda (obj) (#_set-current-input-port (obj 'value)))
+ 'set-current-error-port (lambda (obj) (#_set-current-error-port (obj 'value)))
+
+ 'write-char (lambda (c obj)
+ (if (mock-port? obj)
+ (#_write-char c (obj 'value))
+ (error 'wrong-type-arg "write-char ~S ~S" c obj)))
+
+ 'write-string (lambda (s obj . args)
+ (if (mock-port? obj)
+ (apply #_write-string s (obj 'value) args)
+ (error 'wrong-type-arg "write-string ~S ~S ~S" s obj args)))
+
+ 'write-byte (lambda (b obj)
+ (if (mock-port? obj)
+ (#_write-byte b (obj 'value))
+ (error 'wrong-type-arg "write-byte ~S ~S" b obj)))
+
+ 'read-string (lambda (k obj)
+ (if (mock-port? obj)
+ (#_read-string k (obj 'value))
+ (error 'wrong-type-arg "read-string ~S ~S" k obj)))
+ 'values (lambda (obj . args) (obj 'value))
+ 'class-name 'mock-port
+ ))))
+
+ (define (mock-port port)
+ (if (and (or (input-port? port)
+ (output-port? port))
+ (not (let? port)))
+ (openlet
+ (sublet (*mock-port* 'mock-port-class)
+ 'value port
+ 'object->string mock->string))
+ (error 'wrong-type-arg "mock-port ~S is not a port" port)))
+
+ (set! mock-port? (lambda (obj)
+ (and (openlet? obj)
+ (outlet-member obj mock-port-class))))
+
+ (curlet))))
+
+;;; sublet of any of these needs to include the value field or a let-ref-fallback
+#|
+(require libc.scm)
+
+(define *input-file*
+ (let ((file-write-date (lambda (file)
+ (with-let (sublet *libc* :file file)
+ (let ((buf (stat.make)))
+ (stat file buf)
+ (let ((date (stat.st_mtime buf)))
+ (free buf)
+ date)))))
+ (file-size (lambda (file)
+ (with-let (sublet *libc* :file file)
+ (let ((buf (stat.make)))
+ (stat file buf)
+ (let ((size (stat.st_size buf)))
+ (free buf)
+ size)))))
+ (file-owner (lambda (file)
+ (with-let (sublet *libc* :file file)
+ (let ((buf (stat.make)))
+ (stat file buf)
+ (let ((uid (stat.st_uid buf)))
+ (free buf)
+ (let ((pwd (getpwuid uid)))
+ (passwd.pw_name pwd))))))))
+ (openlet
+ (sublet (*mock-port* 'mock-port-class)
+ 'value #f
+ 'length (lambda (obj) (file-size (obj 'file-name)))
+ 'owner (lambda (obj) (file-owner (obj 'file-name)))
+ 'write-date (lambda (obj) (file-write-date (obj 'file-name)))))))
+
+(define (open-a-file file)
+ (let ((p (openlet
+ (sublet *input-file*
+ 'file-name file))))
+ (set! (p 'value) (open-input-file "oboe.snd"))
+ p))
+
+(define p (open-a-file "oboe.snd"))
+(length p) -> 101684
+((p 'owner) p) -> "bil"
+|#
+
diff --git a/moog.scm b/moog.scm
index b851130..97618af 100644
--- a/moog.scm
+++ b/moog.scm
@@ -9,14 +9,14 @@
;;;
;;; translated to Snd scheme function by Bill,
;;; changed 21-Sep-10 to use defgenerator
-;;; changed 17-Apr-05 to use def-clm-struct (for the optimizer's benefit)
-;;; changed 11-Jul-06 to use array-interp
(provide 'snd-moog.scm)
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-(define moog-gaintable (vct 0.999969 0.990082 0.980347 0.970764 0.961304 0.951996 0.94281 0.933777 0.924866 0.916077
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+
+(define moog-gaintable (float-vector 0.999969 0.990082 0.980347 0.970764 0.961304 0.951996 0.94281 0.933777 0.924866 0.916077
0.90741 0.898865 0.890442 0.882141 0.873962 0.865906 0.857941 0.850067 0.842346 0.834686
0.827148 0.819733 0.812378 0.805145 0.798004 0.790955 0.783997 0.77713 0.770355 0.763672
0.75708 0.75058 0.744141 0.737793 0.731537 0.725342 0.719238 0.713196 0.707245 0.701355
@@ -70,46 +70,134 @@
;;; I prefered to translate Hz into the internal parameter rather than controlling
;;; the cutoff frequency in terms of a number that goes between -1 and 1.
-(defgenerator moog
- (freq 0.0 :type float)
- (Q 0.0 :type float)
- (s #f :type vct)
- (y 0.0 :type float)
- (fc 0.0 :type float))
-
-(define (make-moog-filter frequency Q)
- "(make-moog-filter frequency Q) makes a new moog-filter generator. 'frequency' is the cutoff in Hz,
-'Q' sets the resonance: 0 = no resonance, 1: oscillates at 'frequency'"
- (make-moog :freq frequency
- :Q Q
- :s (make-vct 4)
- :y 0.0
- :fc (envelope-interp (/ frequency (* (mus-srate) 0.5)) moog-freqtable)))
+#|
+(defgenerator moog freq Q s y fc gain sig)
+
+(define make-moog-filter
+ (let ((documentation "(make-moog-filter frequency Q) makes a new moog-filter generator. 'frequency' is the cutoff in Hz,
+'Q' sets the resonance: 0 = no resonance, 1: oscillates at 'frequency'"))
+ (lambda (frequency Q)
+ (let ((frq (envelope-interp (/ frequency (* *clm-srate* 0.5)) moog-freqtable)))
+ (make-moog :freq frequency
+ :Q Q
+ :s (make-float-vector 4)
+ :y 0.0
+ :fc frq
+ :gain (* Q (array-interp moog-gaintable (+ 99.0 (* frq 99.0)))))))))
+
(define moog-frequency
- (make-procedure-with-setter
- (lambda (gen)
- "(moog-frequency gen) accesses the cutoff frequency of the Moog filter 'gen'"
- (moog-freq gen))
+ (dilambda
+ (let ((documentation "(moog-frequency gen) accesses the cutoff frequency of the Moog filter 'gen'"))
+ (lambda (gen)
+ (gen 'freq)))
(lambda (gen frq)
- (set! (moog-freq gen) frq)
- (set! (moog-fc gen) (envelope-interp (/ frq (* (mus-srate) 0.5)) moog-freqtable)))))
-
-(define (moog-filter m sig)
- ;"(moog-filter m sig) is the generator associated with make-moog-filter"
- (let ((A (* 0.25 (- sig (moog-y m))))
- (st 0.0))
- (do ((cell 0 (+ 1 cell)))
- ((= cell 4))
- (set! st (vct-ref (moog-s m) cell))
- (set! A (min (max -0.95 (+ A (* (moog-fc m) (- A st)))) 0.95))
- (vct-set! (moog-s m) cell A)
- (set! A (min (max -0.95 (+ A st)) 0.95)))
- (set! (moog-y m)
- (* A (moog-Q m)
- (array-interp moog-gaintable (+ 99 (* (moog-fc m) 99.0)))))
- A))
-
-
-;;; (define gen (make-moog-filter 500.0 .1))
-;;; (map-channel (lambda (y) (moog-filter gen y)))
+ (let ((fr (envelope-interp (/ frq (* *clm-srate* 0.5)) moog-freqtable)))
+ (set! (gen 'freq) frq)
+ (set! (gen 'fc) fr)
+ (set! (gen 'gain) (* (gen 'Q) (array-interp moog-gaintable (+ 99.0 (* fr 99.0)))))))))
+
+
+(define moog-filter
+ (let ((documentation "(moog-filter m sig) is the generator associated with make-moog-filter"))
+ (lambda (m sig)
+ (let-set! m 'sig sig)
+ (with-let m
+ (let ((A (* 0.25 (- sig y)))
+ (st 0.0))
+ (do ((cell 0 (+ 1 cell)))
+ ((= cell 4))
+ (set! st (float-vector-ref s cell))
+ (set! A (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
+ (float-vector-set! s cell A)
+ (set! A (min 0.95 (max -0.95 (+ A st)))))
+ (set! y (* A gain))
+ A)))))
+
+;;; (let ((gen (make-moog-filter 500.0 .1))) (map-channel (lambda (y) (moog-filter gen y))))
+
+|#
+
+;;; faster version?
+
+(defgenerator moog freq Q s0 s1 s2 s3 y fc gain sig)
+
+(define make-moog-filter
+ (let ((documentation "(make-moog-filter frequency Q) makes a new moog-filter generator. 'frequency' is the cutoff in Hz,
+'Q' sets the resonance: 0 = no resonance, 1: oscillates at 'frequency'"))
+ (lambda (frequency Q)
+ (let ((frq (envelope-interp (/ frequency (* *clm-srate* 0.5)) moog-freqtable)))
+ (make-moog :freq frequency
+ :Q Q
+ :y 0.0 :s0 0.0 :s1 0.0 :s2 0.0 :s3 0.0
+ :fc frq
+ :gain (* Q (array-interp moog-gaintable (+ 99.0 (* frq 99.0)))))))))
+
+
+(define moog-frequency
+ (dilambda
+ (let ((documentation "(moog-frequency gen) accesses the cutoff frequency of the Moog filter 'gen'"))
+ (lambda (gen)
+ (gen 'freq)))
+ (lambda (gen frq)
+ (let ((fr (envelope-interp (/ frq (* *clm-srate* 0.5)) moog-freqtable)))
+ (set! (gen 'freq) frq)
+ (set! (gen 'fc) fr)
+ (set! (gen 'gain) (* (gen 'Q) (array-interp moog-gaintable (+ 99.0 (* fr 99.0)))))))))
+
+
+(define moog-filter
+ (let ((documentation "(moog-filter m sig) is the generator associated with make-moog-filter"))
+ (lambda (m sig)
+ ; see below for the "saturate" option
+ (let-set! m 'sig sig)
+ (with-let m
+ (let ((A (* 0.25 (- sig y)))
+ (st 0.0))
+
+ (set! st s0)
+ (set! s0 (+ A (* fc (- A st))))
+ (set! A (+ s0 st))
+
+ (set! st s1)
+ (set! s1 (+ A (* fc (- A st))))
+ (set! A (+ s1 st))
+
+ (set! st s2)
+ (set! s2 (+ A (* fc (- A st))))
+ (set! A (+ s2 st))
+
+ (set! st s3)
+ (set! s3 (+ A (* fc (- A st))))
+ (set! A (+ s3 st))
+
+ (set! y (* A gain))
+ A)))))
+
+(define moog-filter-saturated
+ (let ((documentation "(moog-filter-saturated m sig) is the generator associated with make-moog-filter with internal saturation"))
+ (lambda (m sig)
+ (let-set! m 'sig sig)
+ (with-let m
+ (let ((A (* 0.25 (- sig y)))
+ (st 0.0))
+
+ (set! st s0)
+ (set! s0 (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
+ (set! A (min 0.95 (max -0.95 (+ s0 st))))
+
+ (set! st s1)
+ (set! s1 (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
+ (set! A (min 0.95 (max -0.95 (+ s1 st))))
+
+ (set! st s2)
+ (set! s2 (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
+ (set! A (min 0.95 (max -0.95 (+ s2 st))))
+
+ (set! st s3)
+ (set! s3 (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
+ (set! A (min 0.95 (max -0.95 (+ s3 st))))
+
+ (set! y (* A gain))
+ A)))))
+
diff --git a/mus-config.h.in b/mus-config.h.in
index 28efe23..fe82738 100644
--- a/mus-config.h.in
+++ b/mus-config.h.in
@@ -1,238 +1,142 @@
#ifndef MUS_CONFIG_H_LOADED
#define MUS_CONFIG_H_LOADED
-/* Define to `int' or something if <sys/types.h> doesn't define. */
-#undef mode_t
-#undef pid_t
-#undef size_t
-#undef ssize_t
-#undef mus_long_t
-#undef int64_t
-
-#undef HAVE_GETCWD
-#undef HAVE_STRFTIME
-#undef HAVE_STRERROR
-#undef HAVE_READLINK
-#undef HAVE_GETLINE
-#undef HAVE_SETLOCALE
-#undef HAVE_SLEEP
-#undef HAVE_ACCESS
-#undef HAVE_OPENDIR
-#undef HAVE_SIGNAL
-#undef USE_STATVFS
-#undef USE_STATFS
-#undef HAVE_DIFFTIME
-#undef HAVE_GETTIMEOFDAY
-#undef HAVE_VSNPRINTF
-#undef HAVE_VASPRINTF
-#undef HAVE_SNPRINTF
-#undef HAVE_MEMMOVE
-#undef HAVE_LSTAT
-#undef HAVE_STRCASECMP
-#undef HAVE_PATHCONF
-#undef HAVE_DECL_HYPOT
-#undef HAVE_DECL_ISNAN
-#undef HAVE_DECL_ISINF
-
-#undef HAVE_COMPLEX_TRIG
-#undef WITH_COMPLEX
-
-#undef HAVE_SPECIAL_FUNCTIONS
-#undef WORDS_BIGENDIAN
-#undef _FILE_OFFSET_BITS
-#undef _LARGE_FILES
-#undef HAVE___FUNC__
-#undef SIZEOF_OFF_T
-#undef SIZEOF_LONG
-#undef SIZEOF_LONG_LONG
-#undef SIZEOF_UNSIGNED_LONG
-#undef SIZEOF_UNSIGNED_LONG_LONG
-#undef SIZEOF_VOID_P
-#undef SIZEOF_INTPTR_T
-#undef SIZEOF_INT
-#undef SIZEOF_INT64_T
-#undef SIZEOF_SSIZE_T
-#undef HAVE_GETTEXT
-#undef HAVE_READLINE
-#undef HAVE_NESTED_FUNCTIONS
-
-#undef HAVE_FCNTL_H
-#undef HAVE_LIMITS_H
-#undef HAVE_STRING_H
-#undef HAVE_UNISTD_H
-#undef HAVE_STDBOOL_H
-#undef HAVE_DLFCN_H
-#undef HAVE_SYS_SOUNDCARD_H
-#undef HAVE_MACHINE_SOUNDCARD_H
-#undef HAVE_SYS_MIXER_H
-#undef MUS_HAVE_USR_LIB_OSS
-#undef MUS_HAVE_USR_LOCAL_LIB_OSS
-#undef MUS_HAVE_OPT_OSS
-#undef MUS_HAVE_VAR_LIB_OSS
-#undef HAVE_LIBC_H
-#undef HAVE_SETJMP_H
-#undef HAVE_GNU_LIBC_VERSION_H
-#undef HAVE_SYS_PARAM_H
-#undef HAVE_SYS_MOUNT_H
-#undef HAVE_ALSA_ASOUNDLIB_H
-#undef HAVE_BYTESWAP_H
-#undef HAVE_STDINT_H
-#undef HAVE_FAM_H
-#undef HAVE_SYS_TIME_H
-#undef HAVE_DIRENT_H
-#undef FGREP_PROG
-
-#undef HAVE_PTHREAD_H
-#undef HAVE_PTHREADS
-
-#undef SND_PACKAGE
-#undef SND_VERSION
-#undef SND_HOST
-
-#undef HAVE_OSX
-#undef HAVE_WINDOZE
-#undef HAVE_SUN
-#undef HAVE_NETBSD
-#undef HAVE_LINUX
-
-#undef MUS_LINUX
-#undef MUS_SUN
-#undef MUS_OPENBSD
-#undef MUS_NETBSD
-#undef MUS_WINDOZE
-#undef HAVE_OSS
-#undef HAVE_ALSA
-#undef HAVE_JACK_IN_LINUX
-#undef MUS_JACK
-#undef MUS_MAC_OSX
-#undef MUS_ESD
-#undef MUS_HPUX
-#undef MUS_ESD_VERSION
-#undef MUS_AUDIOFILE_VERSION
-#undef HAVE_KAUDIODEVICEPROPERTYTRANSPORTTYPE
-#undef HAVE_KLINEARPCMFORMATFLAGISNONINTERLEAVED
-#undef HAVE_AUDIODEVICEDESTROYIOPROCID
-#undef MUS_JACK_VERSION
+/* --disable-deprecated */
+#undef DISABLE_DEPRECATED
+
+/* --with-temp-dir */
+#undef MUS_DEFAULT_TEMP_DIR
+
+/* --with-save-dir */
+#undef MUS_DEFAULT_SAVE_DIR
+
+/* --with-doc-dir */
+#undef MUS_DEFAULT_DOC_DIR
+
+/* --with-gmp */
+#undef WITH_GMP
+
+/* --with-pulseaudio */
#undef MUS_PULSEAUDIO
+
+/* --with-portaudio -- obsolete? hard to tell from the website
+ */
#undef MUS_PORTAUDIO
+/* --with-ladspa */
+#undef HAVE_LADSPA
+
+/* --with-fftw or if fftw.pc exists */
#undef HAVE_FFTW3
-#undef WITH_GMP
+/* --with-gsl or if gsl.pc exists */
#undef HAVE_GSL
-#undef MUS_GSL_VERSION
-#undef HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
-
-#undef HAVE_SCHEME
-#undef HAVE_RUBY
-#undef HAVE_FORTH
-#undef HAVE_S7
-#undef HAVE_EXTENSION_LANGUAGE
-
-#undef HAVE_FAM
-#undef HAVE_FAM_NO_EXISTS
-#undef MUS_GAMIN_VERSION
+/* --with-gl, also glu if glu.pc exists */
#undef HAVE_GL
-#undef JUST_GL
#undef HAVE_GLU
+
+/* --with-gl2ps */
#undef WITH_GL2PS
-#undef MUS_DEFAULT_TEMP_DIR
-#undef MUS_DEFAULT_SAVE_DIR
-#undef MUS_DEFAULT_DOC_DIR
-#undef MUS_TRAP_SEGFAULT
-#undef SND_AS_WIDGET
-#undef mus_float_t
-#define mus_long_t int64_t
-#undef WITH_DOUBLES
-#undef SNDLIB_USE_FLOATS
-#undef MUS_DEBUGGING
-#undef HAVE_LADSPA
-#undef MUS_SAMPLE_BITS
-#undef WITH_SHARED_SNDLIB
+/* the default or --with-s7 */
+#undef HAVE_SCHEME
+
+/* --with-ruby */
+#undef HAVE_RUBY
+/* --with-forth */
+#undef HAVE_FORTH
+
+/* the default or --with-gtk */
#undef USE_GTK
+
+/* --with-motif */
#undef USE_MOTIF
+
+/* --with-editres (requires --with-motif) */
+#undef WITH_EDITRES
+
+/* --without-gui */
#undef USE_NO_GUI
-#undef HAVE_X
-#undef HAVE_MOTIF
-#undef HAVE_XmToolTipGetLabel
-#undef HAVE_XmCreateDataField
-#undef HAVE_XmCreateButtonBox
-#undef HAVE_XmCreateTabStack
-#undef HAVE_XmCreateDropDown
-#undef HAVE_XmCreateColumn
-#undef HAVE_XmCreateFontSelector
-#undef HAVE_XmCreateColorSelector
-#undef HAVE_STATIC_XM
-#undef MUS_WITH_EDITRES
-#undef HAVE_XSHAPEQUERYEXTENSION
-
-#undef MUS_RUBY_VERSION
-#undef RUBY_RELEASE_DATE
-#undef RUBY_SEARCH_PATH
-#undef HAVE_RB_PROC_NEW
-
-#undef WITH_RELATIVE_PANES
-#undef HAVE_MAKE_RATIO
-#undef HAVE_MAKE_RECTANGULAR
-
-#undef HAVE_GTK_WIDGET_GET_HAS_TOOLTIP
-#undef HAVE_GTK_TEST_WIDGET_CLICK
-#undef HAVE_GTK_ADJUSTMENT_GET_UPPER
-#undef HAVE_GTK_SCALE_ADD_MARK
-#undef HAVE_GTK_INFO_BAR_NEW
-#undef HAVE_GTK_STATUS_ICON_GET_TITLE
-#undef HAVE_GTK_WIDGET_GET_VISIBLE
-#undef HAVE_GTK_WIDGET_GET_MAPPED
-#undef HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-#undef HAVE_GTK_3
-
-#undef HAVE_CAIRO_GLYPH_ALLOCATE
-#undef HAVE_CAIRO_REGION_XOR
-
-#undef MUS_PANGO_VERSION
-#undef MUS_CAIRO_VERSION
-
-#undef XM_DISABLE_DEPRECATED
-#undef CLM_DISABLE_DEPRECATED
-#undef SNDLIB_DISABLE_DEPRECATED
-#undef XEN_DISABLE_DEPRECATED
-#undef S7_DISABLE_DEPRECATED
-#undef SND_DISABLE_DEPRECATED
-
-#undef WITH_PROFILING
+/* --with-oss */
+#undef HAVE_OSS
+/* --with-alsa and default in linux */
+#undef HAVE_ALSA
+
+/* --with-jack */
+#undef MUS_JACK
+
+/* --without-audio */
+#undef WITH_AUDIO
+
+
+/* paths to various audio decoders */
#undef HAVE_OGG
#undef PATH_OGGDEC
#undef PATH_OGGENC
+/* ogg.pc, exec_prefix/bin/ogg* */
+
#undef HAVE_FLAC
#undef PATH_FLAC
+
#undef HAVE_SPEEX
#undef PATH_SPEEXDEC
#undef PATH_SPEEXENC
-#undef HAVE_MPEG
-#undef PATH_MPG123
+
#undef HAVE_TIMIDITY
#undef PATH_TIMIDITY
+
+#undef HAVE_MPEG
+#undef PATH_MPG123
#undef HAVE_MPG321
#undef PATH_MPG321
-#undef HAVE_SHORTEN
-#undef PATH_SHORTEN
+
#undef HAVE_TTA
#undef PATH_TTA
+
#undef HAVE_WAVPACK
#undef PATH_WAVPACK
#undef PATH_WVUNPACK
+
+
+#undef WORDS_BIGENDIAN
+/* __LITTLE_ENDIAN__ = 1 if gcc osx, but not linux __x86_64?
+ I think it's worth a try to simply use __BIG_ENDIAN__ here
+ it won't work everywhere, but neither will the rest of the code
+ */
+
+#ifdef __SIZEOF__POINTER__
+ #define SIZEOF_VOID_P __SIZEOF_POINTER__
+#else
+ #undef SIZEOF_VOID_P
+#endif
+
+
+
+
+/* ---------------------------------------- */
+
#ifndef USE_SND
#define USE_SND 1
#endif
+#if HAVE_SCHEME
+ #define WITH_SYSTEM_EXTRAS 1
+#endif
+
+#ifndef HAVE_EXTENSION_LANGUAGE
+ #define HAVE_EXTENSION_LANGUAGE (HAVE_SCHEME || HAVE_RUBY || HAVE_FORTH)
+#endif
+
+#define HAVE_COMPLEX_NUMBERS ((!_MSC_VER) && ((!HAVE_FORTH) || HAVE_COMPLEX)) /* the latter defined in fth-lib.h I think */
+#define HAVE_COMPLEX_TRIG ((!_MSC_VER) && (!__cplusplus) && (!__FreeBSD__)) /* this assumes sys/param.h has been included */
+#define HAVE_MAKE_RATIO (HAVE_SCHEME)
+
#ifdef _MSC_VER
- typedef long mus_long_t;
#define ssize_t int
#define snprintf _snprintf
#define strtoll strtol
@@ -242,5 +146,4 @@
#define _CRT_SECURE_CPP_OVERLOAD_STANDARD_NAMES 1
#endif
#endif
-
#endif
diff --git a/musglyphs.rb b/musglyphs.rb
index b9814b3..ccbf163 100644
--- a/musglyphs.rb
+++ b/musglyphs.rb
@@ -2,7 +2,7 @@
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
# Created: Wed Apr 06 00:47:44 CEST 2005
-# Changed: Sat Feb 19 17:16:34 CET 2011
+# Changed: Sat Mar 12 01:47:25 CET 2011
# Commentary:
#
@@ -178,7 +178,9 @@ module Musglyphs
def draw
unless @pathlist.empty?
- draw_lines(@pathlist.flatten.compact, @snd, @chn, @ax)
+ cr = make_cairo(channel_widgets(@snd, @chn)[0])
+ draw_lines(@pathlist.flatten.compact, @snd, @chn, @ax, cr)
+ free_cairo(cr)
end
@pathlist.clear
self
@@ -186,7 +188,9 @@ module Musglyphs
def fill_in
unless @pathlist.empty?
- fill_polygon(@pathlist.flatten.compact, @snd, @chn, @ax)
+ cr = make_cairo(channel_widgets(@snd, @chn)[0])
+ fill_polygon(@pathlist.flatten.compact, @snd, @chn, @ax, cr)
+ free_cairo(cr)
end
@pathlist.clear
self
@@ -201,7 +205,9 @@ module Musglyphs
end
def circle(x0, y0, rad)
- draw_dot(to_x(x0), to_y(y0), (@size * rad * 2.0).floor, @snd, @chn, @ax)
+ cr = make_cairo(channel_widgets(@snd, @chn)[0])
+ draw_dot(to_x(x0), to_y(y0), (@size * rad * 2.0).floor, @snd, @chn, @ax, cr)
+ free_cairo(cr)
self
end
diff --git a/musglyphs.scm b/musglyphs.scm
index abb615a..0e83e32 100644
--- a/musglyphs.scm
+++ b/musglyphs.scm
@@ -63,7 +63,7 @@
;; now make a little Postscript interpreter...
(define curx 0) ; the Postscript "path" handlers
(define cury 0)
-(define pathlist '())
+(define pathlist ())
(define ps-size 50)
(define bezier-segments 50)
(define (->x x)
@@ -112,25 +112,25 @@
#f))
(define* (fill-in score :rest args)
- (if (not (null? pathlist))
+ (if (pair? pathlist)
(let ((cr (make-cairo (car (channel-widgets ps-snd ps-chn)))))
(fill-polygon
(make-polygon
(reverse pathlist))
ps-snd ps-chn ps-ax cr)
(free-cairo cr)))
- (set! pathlist '())
+ (set! pathlist ())
#f)
(define (draw score arg)
- (if (not (null? pathlist))
+ (if (pair? pathlist)
(let ((cr (make-cairo (car (channel-widgets ps-snd ps-chn)))))
(draw-lines
(make-polygon
(reverse pathlist))
ps-snd ps-chn ps-ax cr)
(free-cairo cr)))
- (set! pathlist '())
+ (set! pathlist ())
#f)
(define (circle score x0 y0 rad . rest)
@@ -140,12 +140,11 @@
ps-snd ps-chn ps-ax cr)
(free-cairo cr)))
-(define old-defvar defvar)
-(defmacro defvar (name value) `(define ,name ,value))
+(define-macro (defvar name value) `(define ,name ,value))
(define-macro (setf a b) `(set! ,a ,b))
-(defmacro defun (name ignored-args . body)
+(define-macro (defun name ignored-args . body)
;; in cmn-glyphs every defun has two args, the "score" and an optional "style"
`(define ,name (lambda args
((lambda (score style) ; needed by the procedure body
@@ -162,7 +161,7 @@
#f #f))))
(define t #t)
-(defmacro in-package (name) #f)
+(define-macro (in-package name) #f)
(define (music-font score) #f)
(define g-mustext (lambda args #f))
(define (output-type score) #f)
@@ -171,7 +170,7 @@
(define sound-comment comment)
;(define comment
-; (make-procedure-with-setter
+; (dilambda
; (lambda* ((scr #f) (msg 0))
; "(comment (scr #f) (msg 0)) tries to make musglyph.scm safe for comments"
; (if (or (number? msg)
@@ -183,53 +182,43 @@
; (apply (setter sound-comment) (list snd val))))))
;(load "loop.scm") ; Rick's loop implementation (cm/src/loop.scm)
-(defmacro progn args `(begin , at args))
+(define progn begin)
(load "cmn-glyphs.lisp")
-(set! defvar old-defvar)
-;(set! declare old-declare)
-
;;; a portion of CMN here to make it easier to display notes
(define (frequency->note-octave-and-accidental freq)
(define (frequency->pitch freq)
- (define (log2 x) (/ (log x) (log 2.0)))
- (floor (* 12 (+ (log2 (/ freq 16.351)) (/ 1.0 24)))))
+ (floor (* 12 (+ (log (/ freq 16.351) 2) (/ 1.0 24)))))
(define (pitch->note-octave-and-accidental pitch)
(let* ((pclass (modulo pitch 12))
(octave (floor (/ pitch 12)))
(cclass (case pclass
- ((0) 0)
- ((1) 0) ; c-sharp
+ ((0 1) 0) ; c-sharp
((2) 1)
- ((3) 2) ; e-flat
- ((4) 2)
- ((5) 3)
- ((6) 3) ; f-sharp
+ ((3 4) 2) ; e-flat
+ ((5 6) 3) ; f-sharp
((7) 4)
- ((8) 5) ; a-flat
- ((9) 5)
- ((10) 6); b-flat
- ((11) 6))))
+ ((8 9) 5) ; a-flat
+ (else 6)))) ; b-flat
(list pclass octave
(if (or (= pclass 1) (= pclass 6))
:sharp
- (if (or (= pclass 3) (= pclass 8) (= pclass 10))
- :flat
- #f))
+ (and (or (= pclass 3) (= pclass 8) (= pclass 10))
+ :flat))
cclass
pitch)))
(pitch->note-octave-and-accidental (frequency->pitch freq)))
-(define (note-data->pclass val) (car val))
-(define (note-data->octave val) (cadr val))
-(define (note-data->accidental val) (caddr val))
-(define (note-data->cclass val) (cadddr val))
+(define note-data->pclass car)
+(define note-data->octave cadr)
+(define note-data->accidental caddr)
+(define note-data->cclass cadddr)
(define (note-data->pitch val) (list-ref val 4))
@@ -244,7 +233,7 @@
(define treble-tag-y 30)
-(define bass-tag-y (+ treble-tag-y (* 4 (mix-waveform-height))))
+(define bass-tag-y (+ treble-tag-y (* 4 *mix-waveform-height*)))
(define (draw-a-note freq dur x0 ty0 size with-clef treble)
@@ -253,7 +242,7 @@
(accidental (note-data->accidental note-data))
(cclass (note-data->cclass note-data))
(octave (note-data->octave note-data))
- (pitch (note-data->pitch note-data))
+ ;(pitch (note-data->pitch note-data))
(y0 (if treble treble-tag-y bass-tag-y))
(width (* (+ (if with-clef (if treble 0.9 1.2) 0.75)
(if accidental 0.1 0.0)
@@ -332,33 +321,38 @@
;; this is the example in the documentation
(define (draw-mix-tag id ox oy x y)
- (let ((width (mix-tag-width))
- (height (mix-tag-height))
+ (let ((width *mix-tag-width*)
+ (height *mix-tag-height*)
(home (mix-home id)))
(if (not (= oy -1)) ; already erased?
(fill-rectangle (- ox 1 (/ width 2)) (- oy 1 height) (+ width 2) (+ height 2) (car home) (cadr home) time-graph #t))
(fill-rectangle (- x (/ width 2)) (- y height) width height (car home) (cadr home))))
(hook-push draw-mix-hook
- (lambda (id ox oy x y)
- (draw-mix-tag id ox oy x y)
- (draw-a-note (or (mix-property 'frequency id) 440.0)
- (/ (length id) (srate))
- x y
- (* 2 (mix-waveform-height))
- #f
- (eq? (mix-property 'instrument id) 'violin))
- #t))
+ (lambda (hook)
+ (let ((id (hook 'id))
+ (ox (hook 'old-x))
+ (oy (hook 'old-y))
+ (x (hook 'x))
+ (y (hook 'y)))
+ (draw-mix-tag id ox oy x y)
+ (draw-a-note (or (mix-property 'frequency id) 440.0)
+ (/ (length id) (srate))
+ x y
+ (* 2 *mix-waveform-height*)
+ #f
+ (eq? (mix-property 'instrument id) 'violin)))
+ (set! (hook 'result) #t)))
(hook-push after-graph-hook
- (lambda (s c)
- (let ((size (* 2 (mix-waveform-height))))
+ (lambda (hook)
+ (let ((size (* 2 *mix-waveform-height*)))
(draw-staff 0 treble-tag-y (* 1.0 size) (* .25 size))
(draw-staff 0 bass-tag-y (* 1.0 size) (* .25 size))
(draw-treble-clef 0 (+ treble-tag-y (* size .76)) size)
(draw-bass-clef (* size .075) (+ bass-tag-y (* size .26)) size))))
-(set! (mix-waveform-height) 20)
+(set! *mix-waveform-height* 20)
(let ((oldie (find-sound "test.snd")))
(if (sound? oldie)
@@ -413,39 +407,45 @@
;;; here is the same example, but with vertical drag interpreted as pitch change, and the
;;; note head itself is the mix tag:
-(set! (show-mix-waveforms) #f)
+(set! *show-mix-waveforms* #f)
(hook-push draw-mix-hook
- (lambda (id ox oy x y)
- (let* ((xy (draw-a-note (or (mix-property 'frequency id) 440.0)
+ (lambda (hook)
+ (let* ((id (hook 'id))
+ (x (hook 'x))
+ (y (hook 'y))
+ (xy (draw-a-note (or (mix-property 'frequency id) 440.0)
(/ (length id) (srate))
x y
- (* 2 (mix-waveform-height))
+ (* 2 *mix-waveform-height*)
#f
(eq? (mix-property 'instrument id) 'violin)))
(note-x (round (car xy)))
- (note-y (round (- (cadr xy) (mix-tag-height)))))
+ (note-y (round (- (cadr xy) *mix-tag-height*))))
(if (not (mix-property 'original-tag-y id))
(begin
(set! (mix-property 'original-frequency id) (mix-property 'frequency id))
(set! (mix-property 'original-tag-y id) note-y)
(set! (mix-property 'interval id) 0)))
- (list note-x note-y))))
+ (set! (hook 'result) (list note-x note-y)))))
(hook-push after-graph-hook
- (lambda (s c)
- (let ((size (* 2 (mix-waveform-height))))
+ (lambda (hook)
+ (let ((size (* 2 *mix-waveform-height*)))
(draw-staff 0 treble-tag-y (* 1.0 size) (* .25 size))
(draw-staff 0 bass-tag-y (* 1.0 size) (* .25 size))
(draw-treble-clef 0 (+ treble-tag-y (* size .76)) size)
(draw-bass-clef (* size .075) (+ bass-tag-y (* size .26)) size))))
(hook-push mix-drag-hook
- (lambda (n x y)
- (let ((orig-y (mix-property 'original-tag-y n)))
+ (lambda (hook)
+ (let* ((n (hook 'id))
+ (x (hook 'x))
+ (y (hook 'y))
+ (orig-y (mix-property 'original-tag-y n)))
(if orig-y
- (let ((interval (round (/ (* 12 (- (+ (mix-tag-height) orig-y) y))
- (* 2 (mix-waveform-height)))))
+ (let ((interval (round (/ (* 12 (- (+ *mix-tag-height* orig-y) y))
+ (* 2 *mix-waveform-height*))))
(current-interval (mix-property 'interval n)))
;; this gives the number of semitones we have drifted
(if (not (= current-interval interval))
@@ -455,20 +455,22 @@
(expt 2.0 (/ interval 12.0)))))))))))
(hook-push mix-release-hook
- (lambda (id samps)
- (as-one-edit
- (lambda ()
- (set! (mix-position id) (+ samps (mix-position id)))
- (let ((interval (mix-property 'interval id)))
- (if (not (= interval 0))
- (let ((last-interval (mix-property 'last-interval id)))
- (if (or (not last-interval)
- (not (= last-interval interval)))
- (set! (mix-speed id) (expt 2.0 (/ interval 12.0))))))
- (set! (mix-property 'last-interval id) interval))))
- #t))
-
-(set! (mix-waveform-height) 20)
+ (lambda (hook)
+ (let ((n (hook 'id))
+ (samps (hook 'samples)))
+ (as-one-edit
+ (lambda ()
+ (set! (mix-position id) (+ samps (mix-position id)))
+ (let ((interval (mix-property 'interval id)))
+ (if (not (= interval 0))
+ (let ((last-interval (mix-property 'last-interval id)))
+ (if (or (not last-interval)
+ (not (= last-interval interval)))
+ (set! (mix-speed id) (expt 2.0 (/ interval 12.0))))))
+ (set! (mix-property 'last-interval id) interval))))
+ (set! (hook 'result) #t))))
+
+(set! *mix-waveform-height* 20)
(let ((oldie (find-sound "test.snd")))
(if (sound? oldie)
diff --git a/nb.rb b/nb.rb
index 9cbbb29..d702214 100644
--- a/nb.rb
+++ b/nb.rb
@@ -1,12 +1,10 @@
-# nb.rb -- translation of nb.rb
+# nb.rb -- translation of nb.scm
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Tue Dec 10 22:08:15 CET 2002
-# Changed: Sat Jul 31 22:40:21 CEST 2010
+# Created: 02/12/10 22:08:15
+# Changed: 14/11/13 03:02:23
-# Commentary:
-#
-# Tested with Snd 9.5, Motif 2.2.2, Ruby 1.6.6, 1.6.8 and 1.8.6.
+# Tested with Snd 15.x, Ruby 2.x.x
#
# type nb = make_nb
# nb.help
@@ -45,8 +43,6 @@ nb.close # removes mouse hooks
nb.help # this help
=end
-# Code:
-
require "hooks"
with_silence do
unless defined? DBM.open
@@ -118,7 +114,7 @@ class NB
end
def name=(filename)
- if filename and File.exists?(File.expand_path(filename))
+ if filename and File.exist?(File.expand_path(filename))
@name = filename
show_popup_info
else
@@ -162,7 +158,7 @@ class NB
end
def unb
- if @name and File.exists?(File.expand_path(@name))
+ if @name and File.exist?(File.expand_path(@name))
with_dbm do |db|
db.delete(@name)
end
@@ -181,7 +177,7 @@ class NB
end
def nb
- if @name and File.exists?(File.expand_path(@name))
+ if @name and File.exist?(File.expand_path(@name))
with_dbm do |db|
db[@name] = @notes
end
@@ -218,9 +214,9 @@ class NB
cs = mus_sound_chans(@name)
sr = mus_sound_srate(@name)
len = format("%1.3f", mus_sound_samples(@name).to_f / (cs * sr.to_f))
- d_format = mus_data_format_name(mus_sound_data_format(@name))
+ d_format = mus_sample_type_name(mus_sound_sample_type(@name))
h_type = mus_header_type_name(mus_sound_header_type(@name))
- frms = mus_sound_frames(@name)
+ frms = mus_sound_framples(@name)
max_amp = ""
if mus_sound_maxamp_exists?(@name)
str = ""
@@ -229,10 +225,11 @@ class NB
end
max_amp = format("\n maxamp: [%s]", str[0..-3])
end
- date = Time.at(mus_sound_write_date(@name)).localtime.strftime("%a %d-%b-%y %H:%M %Z")
+ fdate = Time.at(mus_sound_write_date(@name))
+ date = fdate.localtime.strftime("%a %d-%b-%y %H:%M %z")
info_string = format("\
chans: %d, srate: %d
- length: %1.3f (%d frames)
+ length: %1.3f (%d frms)
format: %s [%s]%s
written: %s\n", cs, sr, len, frms, d_format, h_type, max_amp, date)
if defined?($info_comment_hook) and hook?($info_comment_hook)
@@ -241,7 +238,9 @@ written: %s\n", cs, sr, len, frms, d_format, h_type, max_amp, date)
info_string += format("comment: %s\n", s)
end
else
- $info_comment_hook.run_hook do |prc| info_string = prc.call(@name, info_string) end
+ $info_comment_hook.run_hook do |prc|
+ info_string = prc.call(@name, info_string)
+ end
end
else
if s = mus_sound_comment(@name)
@@ -324,7 +323,9 @@ the $nb_database entries of SND will be returned.")
attr_reader :popup_nb_hook
def close
- if @dialog.kind_of?(Dialog) and RWidget?(@dialog.dialog) and RXtIsManaged(@dialog.dialog)
+ if @dialog.kind_of?(Dialog) and
+ RWidget?(@dialog.dialog) and
+ RXtIsManaged(@dialog.dialog)
RXtUnmanageChild(@dialog.dialog)
end
super
@@ -333,7 +334,7 @@ the $nb_database entries of SND will be returned.")
protected
def post_edit
if !@name and RWidget?(@message_widget)
- @name = if File.exists?(file = current_label(@message_widget).split[0])
+ @name = if File.exist?(file = current_label(@message_widget).split[0])
file
else
format("no such file: %s", file.inspect)
@@ -349,7 +350,8 @@ the $nb_database entries of SND will be returned.")
self.notes = RXmTextGetString(@text_widget)
end
@file_name = @dialog.add_label(@name)
- @text_widget = @dialog.add_text(:rows, 16, :columns, 60, :wordwrap, true, :value, @notes)
+ @text_widget = @dialog.add_text(:rows, 16, :columns, 60,
+ :wordwrap, true, :value, @notes)
@dialog.doit_string("Submit")
end
activate_dialog(@dialog.dialog)
@@ -383,12 +385,12 @@ o Submit: submits info from edit widget
#{self.description}",
["{Libxm}: graphics module",
"{Ruby}: extension language",
- "{Motif}: Motif extensions via Libxm"])
+ "{Motif}: Motif extensions via libxm"])
end
def post_popup?
$mouse_enter_label_hook.member?(@db_hook_name) and
- File.exists?(current_label(@message_widget).split[0])
+ File.exist?(current_label(@message_widget).split[0])
end
private
@@ -412,14 +414,18 @@ o Submit: submits info from edit widget
def setup_menu(wid)
@message_widget = find_child(wid, "Message")
- make_snd_popup("NB Edit Info", :where, :event, :parent, find_child(wid, "post-it-text")) do
+ make_snd_popup("NB Edit Info",
+ :where, :event,
+ :parent, find_child(wid, "post-it-text")) do
entry("Edit Info") do |w, snd, chn| Kernel.xm_nb.post_edit end
entry("Prune DB") do |w, snd, chn| Kernel.xm_nb.prune_db end
entry("Clear current Info") do |w, snd, chn| Kernel.xm_nb.unb end
entry("Close NB Edit") do |w, snd, chn| Kernel.xm_nb.close end
separator
entry("Help") do |w, snd, chn| Kernel.xm_nb.help_cb end
- before_popup_hook.add_hook!("NB Edit Info") do |d1, d2, d3| Kernel.xm_nb.post_popup? end
+ before_popup_hook.add_hook!("NB Edit Info") do |d1, d2, d3|
+ Kernel.xm_nb.post_popup?
+ end
end
end
@@ -430,8 +436,12 @@ o Submit: submits info from edit widget
def show_edit_info
xfname = string2compound(@name)
- RWidget?(@file_name) and RXtVaSetValues(@file_name, [RXmNlabelString, xfname])
- RWidget?(@text_widget) and RXtVaSetValues(@text_widget, [RXmNvalue, @notes])
+ if RWidget?(@file_name)
+ RXtVaSetValues(@file_name, [RXmNlabelString, xfname])
+ end
+ if RWidget?(@text_widget)
+ RXtVaSetValues(@text_widget, [RXmNvalue, @notes])
+ end
RXmStringFree(xfname)
end
end if provided?("xm")
diff --git a/nb.scm b/nb.scm
index 8175eb5..d9ad762 100644
--- a/nb.scm
+++ b/nb.scm
@@ -10,111 +10,114 @@
(define use-gdbm #f)
(define nb-database "nb.db")
-(define (nb file note)
- "(nb file note) adds 'note' to the info asociated with 'file'"
- (let ((ptr (gdbm-open nb-database 'create)))
- (if (gdbm? ptr)
- (let ((current-note (and (gdbm-exists? ptr file)
- (gdbm-fetch ptr file))))
- (gdbm-store! ptr
- file
- (if (string? current-note)
- (string-append note (string #\newline) current-note)
- note)
- 'replace)
- (gdbm-close! ptr)))))
+(define nb
+ (let ((documentation "(nb file note) adds 'note' to the info asociated with 'file'"))
+ (lambda (file note)
+ (let ((ptr (gdbm-open nb-database 'create)))
+ (if (gdbm? ptr)
+ (let ((current-note (and (gdbm-exists? ptr file)
+ (gdbm-fetch ptr file))))
+ (gdbm-store! ptr
+ file
+ (if (string? current-note)
+ (string-append note (string #\newline) current-note)
+ note)
+ 'replace)
+ (gdbm-close! ptr)))))))
-(define (unb file)
- "(unb file) removes file's info from the nb (gdbm) data base"
- (let ((ptr (gdbm-open nb-database 'write)))
- (if (gdbm? ptr)
- (begin
- (gdbm-delete! ptr file)
- (gdbm-close! ptr)))))
+(define unb
+ (let ((documentation "(unb file) removes file's info from the nb (gdbm) data base"))
+ (lambda (file)
+ (let ((ptr (gdbm-open nb-database 'write)))
+ (if (gdbm? ptr)
+ (begin
+ (gdbm-delete! ptr file)
+ (gdbm-close! ptr)))))))
-(define (prune-db)
- "(prune-db) cleans up the nb (gdbm) data base by removing references to non-existent files"
- (define (collect-files ptr key files)
- (if key
- (collect-files ptr (gdbm-next-key ptr key) (cons key files))
- files))
- (define (prune-file ptr files)
- (if (not (null? files))
- (begin
- (if (not (file-exists? (car files)))
- (begin
- (snd-print (format #f "pruning ~A" (car files)))
- (gdbm-delete! ptr (car files))))
- (prune-file ptr (cdr files)))))
- (let ((ptr (gdbm-open nb-database 'read)))
- (if (gdbm? ptr)
- (let ((files (collect-files ptr (gdbm-first-key ptr) '())))
- (gdbm-close! ptr)
- (if (not (null? files))
- (let ((ptr (gdbm-open nb-database 'write)))
- (prune-file ptr files)
- (gdbm-close! ptr)))))))
+(define prune-db
+ (let ((documentation "(prune-db) cleans up the nb (gdbm) data base by removing references to non-existent files"))
+ (lambda ()
+ (define (collect-files ptr key files)
+ (if key
+ (collect-files ptr (gdbm-next-key ptr key) (cons key files))
+ files))
+ (define (prune-file ptr files)
+ (if (pair? files)
+ (begin
+ (if (not (file-exists? (car files)))
+ (begin
+ (snd-print (format #f "pruning ~A" (car files)))
+ (gdbm-delete! ptr (car files))))
+ (prune-file ptr (cdr files)))))
+ (let ((ptr (gdbm-open nb-database 'read)))
+ (if (gdbm? ptr)
+ (let ((files (collect-files ptr (gdbm-first-key ptr) ())))
+ (gdbm-close! ptr)
+ (if (pair? files)
+ (let ((ptr (gdbm-open nb-database 'write)))
+ (prune-file ptr files)
+ (gdbm-close! ptr)))))))))
(define nb-mouse-response-time 0)
-(define (files-popup-info type position name)
- "(files-popup-info type position name) is intended as a mouse-enter-label hook function.
-It causes a description of the file to popup when the mouse crosses the filename"
+(define files-popup-info
+ (let ((documentation "(files-popup-info type position name) is intended as a mouse-enter-label hook function.
+It causes a description of the file to popup when the mouse crosses the filename"))
+ (lambda (type position name)
+ (define file-info
+ (lambda (file)
+ ;; (file-info file) -> description (as a string) of file
+ (format #f "~A: ~% chans: ~D, srate: ~D, len: ~A~% ~A ~A~A~% written: ~A~A~A"
+ file
+ (channels file)
+ (srate file)
+ (let ((den (* (channels file) (srate file))))
+ (if (> den 0)
+ (format #f "~1,3F" (* 1.0 (/ (mus-sound-samples file) den)))
+ "unknown"))
+ (mus-header-type-name (mus-sound-header-type file))
+ (mus-sample-type-name (mus-sound-sample-type file))
+ (if (mus-sound-maxamp-exists? file)
+ (format #f "~% maxamp: ~A" (mus-sound-maxamp file))
+ "")
+ (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date file)))
+ (let ((comment (mus-sound-comment file)))
+ (if (and (string? comment)
+ (> (length comment) 0))
+ (format #f "~% comment: ~A" comment)
+ ""))
+ (if (and use-gdbm
+ (file-exists? nb-database))
+ (let* ((ptr (gdbm-open nb-database 'read))
+ (note (gdbm-fetch ptr file)))
+ (gdbm-close! ptr)
+ (if (string? note)
+ (format #f "~%~A" note)
+ ""))
+ ""))))
- (define file-info
- (lambda (file)
- "(file-info file) -> description (as a string) of file"
- (format #f "~A: ~% chans: ~D, srate: ~D, len: ~A~% ~A ~A~A~% written: ~A~A~A"
- file
- (channels file)
- (srate file)
- (let ((den (* (channels file) (srate file))))
- (if (> den 0)
- (format #f "~1,3F" (exact->inexact (/ (mus-sound-samples file) den)))
- "unknown"))
- (mus-header-type-name (mus-sound-header-type file))
- (mus-data-format-name (mus-sound-data-format file))
- (if (mus-sound-maxamp-exists? file)
- (format #f "~% maxamp: ~A" (mus-sound-maxamp file))
- "")
- (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date file)))
- (let ((comment (mus-sound-comment file)))
- (if (and (string? comment)
- (> (string-length comment) 0))
- (format #f "~% comment: ~A" comment)
- ""))
- (if (and use-gdbm
- (file-exists? nb-database))
- (let* ((ptr (gdbm-open nb-database 'read))
- (note (gdbm-fetch ptr file)))
- (gdbm-close! ptr)
- (if (string? note)
- (format #f "~%~A" note)
- ""))
- ""))))
-
- (let ((region-viewer 2))
- (set! nb-mouse-response-time (get-internal-real-time))
- (if (not (= type region-viewer))
- (let ((info-exists (list-ref (dialog-widgets) 20)))
- (info-dialog name (file-info name))
- (let ((info-widget (list-ref (dialog-widgets) 20)))
- (if info-widget
- (if (not info-exists) ; keep the help dialog from overlapping the files dialog
- (let* ((files-dialog (list-ref (dialog-widgets) 8))
+ (let ((region-viewer 2))
+ (set! nb-mouse-response-time (get-internal-real-time))
+ (if (not (= type region-viewer))
+ (let ((info-exists (list-ref (dialog-widgets) 15)))
+ (info-dialog name (file-info name))
+ (let ((info-widget (list-ref (dialog-widgets) 15)))
+ (if (and info-widget
+ (not info-exists)) ; keep the help dialog from overlapping the files dialog
+ (let* ((files-dialog (list-ref (dialog-widgets) 5))
(files-position (widget-position files-dialog))
(files-size (widget-size files-dialog)))
(set! (widget-position info-widget) (list (+ (car files-position) (car files-size) 10)
- (+ (cadr files-position) 10)))))))))))
+ (+ (cadr files-position) 10))))))))))))
(define (files-popdown-info type position name)
(let ((cur-time (get-internal-real-time)))
(in 1000 (lambda ()
(if (> cur-time nb-mouse-response-time)
- (hide-widget (list-ref (dialog-widgets) 20)))))))
+ (hide-widget (list-ref (dialog-widgets) 15)))))))
-(hook-push mouse-enter-label-hook files-popup-info)
-(hook-push mouse-leave-label-hook files-popdown-info)
+(hook-push mouse-enter-label-hook (lambda (hook) (files-popup-info (hook 'type) (hook 'position) (hook 'label))))
+(hook-push mouse-leave-label-hook (lambda (hook) (files-popdown-info (hook 'type) (hook 'position) (hook 'label))))
diff --git a/new-effects.scm b/new-effects.scm
index 73e4d0d..b910a4c 100644
--- a/new-effects.scm
+++ b/new-effects.scm
@@ -1,3216 +1,3117 @@
-(if (not (provided? 'snd-motif)) (snd-error "new-effects.scm is Motif-specific"))
-
-(if (not (provided? 'xm))
- (let ((hxm (dlopen "xm.so")))
- (if (string? hxm)
- (snd-error (format #f "new-effects.scm needs the xm module (either 'make xm' or build Snd with --with-static-xm): ~A" hxm))
- (dlinit hxm "Init_libxm"))))
+(if (not (provided? 'snd-motif))
+ (snd-error "new-effects.scm is Motif-specific"))
(provide 'snd-new-effects.scm)
-
-(if (not (provided? 'snd-effects-utils.scm)) (load "effects-utils.scm"))
-(if (not (provided? 'snd-xm-enved.scm)) (load "xm-enved.scm"))
-(if (not (provided? 'snd-moog.scm)) (load "moog.scm"))
-(if (not (provided? 'snd-rubber.scm)) (load "rubber.scm"))
-(if (not (provided? 'snd-dsp.scm)) (load "dsp.scm"))
-
-(define effects-list '()) ; menu labels are updated to show current settings
-
-(define effects-menu (add-to-main-menu "Effects" (lambda () (update-label effects-list))))
-
-(define (plausible-mark-samples)
- "(plausible-mark-samples) finds two marks in the current channel in or nearest to current window"
- (let* ((snd (selected-sound))
- (chn (selected-channel))
- (ms (sort! (map mark-sample (marks snd chn)) <)))
- (if (< (length ms) 2)
- (throw 'no-such-mark (list "mark-related action requires two marks"))
- (if (= (length ms) 2)
- ms
- (let* ((lw (left-sample snd chn))
- (rw (right-sample snd chn))
- (cw (cursor snd chn))
- (favor (if (and (>= cw lw)
- (<= cw rw))
- cw
- (* .5 (+ lw rw)))))
- ;; favor is the point we center the search on
- (define (centered-points points)
- (if (= (length points) 2)
- points
- (let ((p1 (car points))
- (p2 (cadr points))
- (p3 (caddr points)))
- (if (< (abs (- p1 favor)) (abs (- p3 favor)))
- (list p1 p2)
- (centered-points (cdr points))))))
- (centered-points ms))))))
-
-(define map-chan-over-target-with-sync
- ;; target: 'marks -> beg=closest marked sample, dur=samples to next mark
- ;; 'sound -> beg=0, dur=all samples in sound
- ;; 'selection -> beg=selection-position, dur=selection-frames
- ;; 'cursor -> beg=cursor, dur=samples to end of sound
- ;; decay is how long to run the effect past the end of the sound
- (lambda (func target origin decay)
- (if (and (eq? target 'selection)
- (not (selection?)))
- (snd-print ";no selection")
- (if (and (eq? target 'sound)
- (null? (sounds)))
- (snd-print ";no sound")
- (if (and (eq? target 'marks)
- (or (null? (sounds))
- (< (length (marks (selected-sound) (selected-channel))) 2)))
- (snd-print ";no marks")
- (let* ((snc (sync))
- (ms (and (eq? target 'marks)
- (plausible-mark-samples)))
- (beg (if (eq? target 'sound)
- 0
- (if (eq? target 'selection)
- (selection-position)
- (if (eq? target 'cursor)
- (cursor (selected-sound) (selected-channel))
- (car ms)))))
- (overlap (if decay
- (floor (* (srate) decay))
- 0)))
- (apply for-each
- (lambda (snd chn)
- (let ((end (if (or (eq? target 'sound)
- (eq? target 'cursor))
- (- (frames snd chn) 1)
- (if (eq? target 'selection)
- (+ (selection-position) (selection-frames))
- (cadr ms)))))
- (if (= (sync snd) snc)
- (map-channel (func (- end beg)) beg (+ end overlap 1) snd chn #f
- (format #f "~A ~A ~A"
- (origin target (- end beg))
- (if (eq? target 'sound) 0 beg)
- (if (eq? target 'sound) #f (+ 1 (- end beg))))))))
-
- (if (> snc 0)
- (all-chans)
- (list (list (selected-sound))
- (list (selected-channel)))))))))))
-
-(define yellow-pixel
- (let ((pix #f))
- (lambda ()
- (if (not pix)
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr))
- (col (XColor)))
- (if (= (XAllocNamedColor dpy cmap "yellow" col col) 0)
- (snd-error "can't allocate yellow!")
- (set! pix (.pixel col)))))
- pix)))
-
-(define (add-target mainform target-callback truncate-callback)
- ;; add a set of 3 radio buttons at the bottom of the main section for choice between sound, selection, between-marks
- ;; target-callback should take one arg, a symbol: 'sound, 'selection, 'marks, and apply the effect accordingly (upon "DoIt")
- ;; truncate-callback (if any) takes one arg: boolean representing toggle state (#t = on)
- (let* ((sep (XtCreateManagedWidget "sep" xmSeparatorWidgetClass mainform
+(require snd-effects-utils.scm snd-xm-enved.scm snd-moog.scm snd-rubber.scm snd-dsp.scm)
+
+(with-let (sublet *motif*)
+
+ (define effects-list ()) ; menu labels are updated to show current settings
+
+ (define effects-menu (add-to-main-menu "Effects" (lambda () (update-label effects-list))))
+
+ (define plausible-mark-samples
+ (let ((documentation "(plausible-mark-samples) finds two marks in the current channel in or nearest to current window"))
+ (lambda ()
+ (let* ((snd (selected-sound))
+ (chn (selected-channel))
+ (ms (sort! (map mark-sample (marks snd chn)) <)))
+ (if (< (length ms) 2)
+ (error 'no-such-mark (list "mark-related action requires two marks"))
+ (if (= (length ms) 2)
+ ms
+ (let* ((lw (left-sample snd chn))
+ (rw (right-sample snd chn))
+ (cw (cursor snd chn))
+ (favor (if (>= rw cw lw)
+ cw
+ (* .5 (+ lw rw)))))
+ ;; favor is the point we center the search on
+ (define (centered-points points)
+ (if (= (length points) 2)
+ points
+ (let ((p1 (car points))
+ (p2 (cadr points))
+ (p3 (caddr points)))
+ (if (< (abs (- p1 favor)) (abs (- p3 favor)))
+ (list p1 p2)
+ (centered-points (cdr points))))))
+ (centered-points ms))))))))
+
+ (define map-chan-over-target-with-sync
+ ;; target: 'marks -> beg=closest marked sample, dur=samples to next mark
+ ;; 'sound -> beg=0, dur=all samples in sound
+ ;; 'selection -> beg=selection-position, dur=selection-framples
+ ;; 'cursor -> beg=cursor, dur=samples to end of sound
+ ;; decay is how long to run the effect past the end of the sound
+ (lambda (func target origin decay)
+ (if (and (eq? target 'selection)
+ (not (selection?)))
+ (snd-print ";no selection")
+ (if (and (eq? target 'sound)
+ (null? (sounds)))
+ (snd-print ";no sound")
+ (if (and (eq? target 'marks)
+ (or (null? (sounds))
+ (< (length (marks (selected-sound) (selected-channel))) 2)))
+ (snd-print ";no marks")
+ (let* ((snc (sync))
+ (ms (and (eq? target 'marks)
+ (plausible-mark-samples)))
+ (beg (if (eq? target 'sound)
+ 0
+ (if (eq? target 'selection)
+ (selection-position)
+ (if (eq? target 'cursor)
+ (cursor (selected-sound) (selected-channel))
+ (car ms)))))
+ (overlap (if decay
+ (floor (* (srate) decay))
+ 0)))
+ (apply for-each
+ (lambda (snd chn)
+ (let ((end (if (memq target '(sound cursor))
+ (- (framples snd chn) 1)
+ (if (eq? target 'selection)
+ (+ (selection-position) (selection-framples))
+ (cadr ms)))))
+ (if (= (sync snd) snc)
+ (map-channel (func (- end beg)) beg (+ end overlap 1) snd chn #f
+ (format #f "~A ~A ~A"
+ (origin target (- end beg))
+ (if (eq? target 'sound) 0 beg)
+ (and (not (eq? target 'sound)) (+ 1 (- end beg))))))))
+
+ (if (> snc 0)
+ (all-chans)
+ (list (list (selected-sound))
+ (list (selected-channel)))))))))))
+
+ (define yellow-pixel
+ (let ((pix #f))
+ (lambda ()
+ (if (not pix)
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr))
+ (col (XColor)))
+ (if (= (XAllocNamedColor dpy cmap "yellow" col col) 0)
+ (snd-error "can't allocate yellow!")
+ (set! pix (.pixel col)))))
+ pix)))
+
+
+ (define (add-target mainform target-callback truncate-callback)
+ ;; add a set of 3 radio buttons at the bottom of the main section for choice between sound, selection, between-marks
+ ;; target-callback should take one arg, a symbol: 'sound, 'selection, 'marks, and apply the effect accordingly (upon "DoIt")
+ ;; truncate-callback (if any) takes one arg: boolean representing toggle state (#t = on)
+
+ (XtCreateManagedWidget "sep" xmSeparatorWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNseparatorType XmSHADOW_ETCHED_OUT
+ XmNbackground *basic-color*))
+ (let ((rc (XtCreateManagedWidget "rc" xmRowColumnWidgetClass mainform
(list XmNorientation XmHORIZONTAL
- XmNseparatorType XmSHADOW_ETCHED_OUT
- XmNbackground (basic-color))))
- (rc (XtCreateManagedWidget "rc" xmRowColumnWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNbackground (basic-color)
- XmNradioBehavior #t
- XmNradioAlwaysOne #t
- XmNbottomAttachment XmATTACH_FORM
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNentryClass xmToggleButtonWidgetClass
- XmNisHomogeneous #t))))
- (for-each
- (lambda (name type on)
- (XtCreateManagedWidget name xmToggleButtonWidgetClass rc
- (list XmNbackground (basic-color)
- XmNset on
- XmNselectColor (yellow-pixel)
- XmNindicatorType XmONE_OF_MANY_ROUND
- XmNarmCallback (list (lambda (w c i)
- (target-callback type))
- #f))))
- (list "entire sound" "selection" "between marks")
- (list 'sound 'selection 'marks)
- (list #t #f #f))
- (if truncate-callback
- (let* ((trsep (XtCreateManagedWidget "trsep" xmSeparatorWidgetClass mainform
- (list XmNorientation XmHORIZONTAL)))
- (trbutton (XtCreateManagedWidget "truncate at end" xmToggleButtonWidgetClass mainform
- (list XmNbackground (basic-color)
- XmNset #t
- XmNselectColor (yellow-pixel)))))
- (XtAddCallback trbutton XmNvalueChangedCallback (lambda (w c i) (truncate-callback (.set i)))) ))
- rc))
-
-(define (effect-frames target)
- (if (eq? target 'sound)
- (- (frames) 1)
- (if (eq? target 'selection)
- (selection-frames)
- (+ 1 (abs (apply - (plausible-mark-samples)))))))
-
-
+ XmNbackground *basic-color*
+ XmNradioBehavior #t
+ XmNradioAlwaysOne #t
+ XmNbottomAttachment XmATTACH_FORM
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNentryClass xmToggleButtonWidgetClass
+ XmNisHomogeneous #t))))
+ (for-each
+ (lambda (name type on)
+ (XtCreateManagedWidget name xmToggleButtonWidgetClass rc
+ (list XmNbackground *basic-color*
+ XmNset on
+ XmNselectColor (yellow-pixel)
+ XmNindicatorType XmONE_OF_MANY_ROUND
+ XmNarmCallback (list (lambda (w c i)
+ (target-callback type))
+ #f))))
+ (list "entire sound" "selection" "between marks")
+ (list 'sound 'selection 'marks)
+ (list #t #f #f))
+ (if truncate-callback
+ (XtCreateManagedWidget "trsep" xmSeparatorWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL))
+ (let ((trbutton (XtCreateManagedWidget "truncate at end" xmToggleButtonWidgetClass mainform
+ (list XmNbackground *basic-color*
+ XmNset #t
+ XmNselectColor (yellow-pixel)))))
+ (XtAddCallback trbutton XmNvalueChangedCallback (lambda (w c i) (truncate-callback (.set i))))))
+ rc))
+
+ (define (effect-framples target)
+ (if (eq? target 'sound)
+ (- (framples) 1)
+ (if (eq? target 'selection)
+ (selection-framples)
+ (+ 1 (abs (apply - (plausible-mark-samples)))))))
+
+
;;; (Bill) changed 12-Oct-04 to make detached edit lists work (need globally accessible effect functions, etc)
;;; (Bill) changed 12-Oct-06 for new watcher mechanism, rather than the selection-button list, selection-changed-hook etc
-
-
+
+
;;; *******************************
;;; **
;;; BEGIN PARAMETRIZED EFFECTS **
;;; **
;;; *******************************
-
-
+
+
;;; AMPLITUDE EFFECTS
-
-(define* (effects-squelch-channel amp gate-size snd chn)
- "(effects-squelch-channel amount gate-size snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((f0 (make-moving-average gate-size))
- (f1 (make-moving-average gate-size :initial-element 1.0)))
- (map-channel (lambda (y) (* y (moving-average f1 (if (< (moving-average f0 (* y y)) amp) 0.0 1.0))))
- 0 #f snd chn #f
- (format #f "effects-squelch-channel ~A ~A" amp gate-size))))
-
-
-(let* ((amp-menu-list '())
- (amp-menu (XmCreatePulldownMenu (main-menu effects-menu) "Amplitude Effects"
- (list XmNbackground (basic-color))))
- (amp-cascade (XtCreateManagedWidget "Amplitude Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
- (list XmNsubMenuId amp-menu
- XmNbackground (basic-color)))))
- (XtAddCallback amp-cascade XmNcascadingCallback (lambda (w c i) (update-label amp-menu-list)))
+ (define* (effects-squelch-channel amp gate-size snd chn no-silence)
+ (let ((f0 (make-moving-average gate-size))
+ (f1 (make-moving-average gate-size :initial-element 1.0)))
+ (if no-silence
+ (map-channel (lambda (y)
+ (let ((val (* y (moving-average f1 (ceiling (- (moving-average f0 (* y y)) amp))))))
+ (and (not (zero? val)) val)))
+ 0 #f snd chn #f (format #f "effects-squelch-channel ~A ~A" amp gate-size))
+ (map-channel (lambda (y)
+ (* y (moving-average f1 (ceiling (- (moving-average f0 (* y y)) amp)))))
+ 0 #f snd chn #f (format #f "effects-squelch-channel ~A ~A" amp gate-size)))))
-;;; -------- Gain (gain set by gain-amount)
- (let ((gain-amount 1.0)
- (gain-label "Gain")
- (gain-dialog #f)
- (gain-target 'sound)
- (gain-envelope #f))
-
- (define (scale-envelope e scl)
- (if (null? e)
- '()
- (append (list (car e) (* scl (cadr e)))
- (scale-envelope (cddr e) scl))))
-
- (define (post-gain-dialog)
- (if (not (Widget? gain-dialog))
- ;; if gain-dialog doesn't exist, create it
- (let ((initial-gain-amount 1.0)
- (sliders '())
- (fr #f))
- (set! gain-dialog
- (make-effect-dialog
- gain-label
-
- (lambda (w context info)
- (let ((with-env (and (not (equal? (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0)))
- (scale-envelope (xe-envelope gain-envelope) gain-amount))))
- (if (eq? gain-target 'sound)
- (if with-env
- (env-sound with-env)
- (scale-by gain-amount))
- (if (eq? gain-target 'selection)
- (if (selection?)
- (if with-env
- (env-selection with-env)
- (scale-selection-by gain-amount))
- (snd-print ";no selection"))
- (let ((pts (catch 'no-such-mark
- (lambda () (plausible-mark-samples))
- (lambda args #f))))
- (if pts
+ (let* ((amp-menu-list ())
+ (amp-menu (XmCreatePulldownMenu (main-menu effects-menu) "Amplitude Effects"
+ (list XmNbackground *basic-color*)))
+ (amp-cascade (XtCreateManagedWidget "Amplitude Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
+ (list XmNsubMenuId amp-menu
+ XmNbackground *basic-color*))))
+ (XtAddCallback amp-cascade XmNcascadingCallback (lambda (w c i) (update-label amp-menu-list)))
+
+
+;;; -------- Gain (gain set by gain-amount)
+
+ (let ((gain-amount 1.0)
+ (gain-label "Gain")
+ (gain-dialog #f)
+ (gain-target 'sound)
+ (gain-envelope #f))
+
+ (define (scale-envelope e scl)
+ (if (null? e)
+ ()
+ (append (list (car e) (* scl (cadr e)))
+ (scale-envelope (cddr e) scl))))
+
+ (define (post-gain-dialog)
+ (if (not (Widget? gain-dialog))
+ ;; if gain-dialog doesn't exist, create it
+ (let ((initial-gain-amount 1.0)
+ (sliders ())
+ (fr #f))
+ (set! gain-dialog
+ (make-effect-dialog
+ gain-label
+
+ (lambda (w context info)
+ (let ((with-env (and (not (equal? (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0)))
+ (scale-envelope (xe-envelope gain-envelope) gain-amount))))
+ (if (eq? gain-target 'sound)
+ (if with-env
+ (env-sound with-env)
+ (scale-by gain-amount))
+ (if (eq? gain-target 'selection)
+ (if (selection?)
(if with-env
- (env-sound with-env (car pts) (- (cadr pts) (car pts)))
- (scale-by gain-amount (car pts) (- (cadr pts) (car pts))))
- (snd-print ";no marks")))))))
-
- (lambda (w context info)
- (help-dialog "Gain"
- "Move the slider to change the gain scaling amount."))
-
- (lambda (w c i)
- (set! gain-amount initial-gain-amount)
- (set! (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0))
- (XtSetValues (car sliders) (list XmNvalue (floor (* gain-amount 100)))))
-
- (lambda ()
- (effect-target-ok gain-target))))
-
- (set! sliders
- (add-sliders gain-dialog
- (list (list "gain" 0.0 initial-gain-amount 5.0
- (lambda (w context info)
- (set! gain-amount (/ (.value info) 100.0)))
- 100))))
- (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
- (list XmNheight 200
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget (list-ref sliders (- (length sliders) 1))
- XmNshadowThickness 4
- XmNshadowType XmSHADOW_ETCHED_OUT)))
-
- (let ((target-row (add-target (XtParent (XtParent (car sliders)))
- (lambda (target)
- (set! gain-target target)
- (XtSetSensitive (XmMessageBoxGetChild gain-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
- (activate-dialog gain-dialog)
-
- (set! gain-envelope (xe-create-enved "gain" fr
- (list XmNheight 200)
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0))
- (XtVaSetValues fr (list XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget target-row)))
-
- )
- (activate-dialog gain-dialog)))
-
- (let ((child (XtCreateManagedWidget "Gain" xmPushButtonWidgetClass amp-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+ (env-selection with-env)
+ (scale-selection-by gain-amount))
+ (snd-print ";no selection"))
+ (let ((pts (catch 'no-such-mark
+ plausible-mark-samples
+ (lambda args #f))))
+ (if pts
+ (if with-env
+ (env-sound with-env (car pts) (- (cadr pts) (car pts)))
+ (scale-by gain-amount (car pts) (- (cadr pts) (car pts))))
+ (snd-print ";no marks")))))))
+
+ (lambda (w context info)
+ (help-dialog "Gain"
+ "Move the slider to change the gain scaling amount."))
+
(lambda (w c i)
- (post-gain-dialog)))
- (set! amp-menu-list (cons (lambda ()
- (let ((new-label (format #f "Gain (~1,2F)" gain-amount)))
- (change-label child new-label)))
- amp-menu-list))))
-
-
+ (set! gain-amount initial-gain-amount)
+ (set! (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0))
+ (XtSetValues (car sliders) (list XmNvalue (floor (* gain-amount 100)))))
+
+ (lambda ()
+ (effect-target-ok gain-target))))
+
+ (set! sliders
+ (add-sliders gain-dialog
+ (list (list "gain" 0.0 initial-gain-amount 5.0
+ (lambda (w context info)
+ (set! gain-amount (/ (.value info) 100.0)))
+ 100))))
+ (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
+ (list XmNheight 200
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget (sliders (- (length sliders) 1))
+ XmNshadowThickness 4
+ XmNshadowType XmSHADOW_ETCHED_OUT)))
+
+ (let ((target-row (add-target (XtParent (XtParent (car sliders)))
+ (lambda (target)
+ (set! gain-target target)
+ (XtSetSensitive (XmMessageBoxGetChild gain-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+ (activate-dialog gain-dialog)
+
+ (set! gain-envelope (xe-create-enved "gain" fr
+ (list XmNheight 200)
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope gain-envelope) (list 0.0 1.0 1.0 1.0))
+ (XtVaSetValues fr (list XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget target-row)))
+
+ )
+ (activate-dialog gain-dialog)))
+
+ (let ((child (XtCreateManagedWidget "Gain" xmPushButtonWidgetClass amp-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-gain-dialog)))
+ (set! amp-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Gain (~1,2F)" gain-amount)))
+ (change-label child new-label)))
+ amp-menu-list))))
+
+
;;; -------- Normalize
;;;
-
- (let ((normalize-amount 1.0)
- (normalize-label "Normalize")
- (normalize-dialog #f)
- (normalize-target 'sound))
-
- (define (post-normalize-dialog)
- (if (not (Widget? normalize-dialog))
- ;; if normalize-dialog doesn't exist, create it
- (let ((initial-normalize-amount 1.0)
- (sliders '()))
- (set! normalize-dialog
- (make-effect-dialog
- normalize-label
-
- (lambda (w context info)
- (if (eq? normalize-target 'sound)
- (scale-to normalize-amount)
- (if (eq? normalize-target 'selection)
- (if (selection?)
- (scale-selection-to normalize-amount)
- (snd-print ";no selection"))
- (let ((pts (plausible-mark-samples)))
- (if pts
- (scale-to normalize-amount (car pts) (- (cadr pts) (car pts))))))))
-
- (lambda (w context info)
- (help-dialog "Normalize"
- "Normalize scales amplitude to the normalize amount. Move the slider to change the scaling amount."))
-
- (lambda (w c i)
- (set! normalize-amount initial-normalize-amount)
- (XtSetValues (car sliders) (list XmNvalue (floor (* normalize-amount 100)))))
-
- (lambda ()
- (effect-target-ok normalize-target))))
-
- (set! sliders
- (add-sliders normalize-dialog
- (list (list "normalize" 0.0 initial-normalize-amount 1.0
- (lambda (w context info)
- (set! normalize-amount (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! normalize-target target)
- (XtSetSensitive (XmMessageBoxGetChild normalize-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog normalize-dialog))
-
- (let ((child (XtCreateManagedWidget "Normalize" xmPushButtonWidgetClass amp-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((normalize-amount 1.0)
+ (normalize-label "Normalize")
+ (normalize-dialog #f)
+ (normalize-target 'sound))
+
+ (define (post-normalize-dialog)
+ (if (not (Widget? normalize-dialog))
+ ;; if normalize-dialog doesn't exist, create it
+ (let ((initial-normalize-amount 1.0)
+ (sliders ()))
+ (set! normalize-dialog
+ (make-effect-dialog
+ normalize-label
+
+ (lambda (w context info)
+ (if (eq? normalize-target 'sound)
+ (scale-to normalize-amount)
+ (if (eq? normalize-target 'selection)
+ (if (selection?)
+ (scale-selection-to normalize-amount)
+ (snd-print ";no selection"))
+ (let ((pts (plausible-mark-samples)))
+ (if pts
+ (scale-to normalize-amount (car pts) (- (cadr pts) (car pts))))))))
+
+ (lambda (w context info)
+ (help-dialog "Normalize"
+ "Normalize scales amplitude to the normalize amount. Move the slider to change the scaling amount."))
+
(lambda (w c i)
- (post-normalize-dialog)))
+ (set! normalize-amount initial-normalize-amount)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* normalize-amount 100)))))
+
+ (lambda ()
+ (effect-target-ok normalize-target))))
+
+ (set! sliders
+ (add-sliders normalize-dialog
+ (list (list "normalize" 0.0 initial-normalize-amount 1.0
+ (lambda (w context info)
+ (set! normalize-amount (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! normalize-target target)
+ (XtSetSensitive (XmMessageBoxGetChild normalize-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog normalize-dialog))
- (set! amp-menu-list (cons (lambda ()
- (let ((new-label (format #f "Normalize (~1,2F)" normalize-amount)))
- (change-label child new-label)))
- amp-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "Normalize" xmPushButtonWidgetClass amp-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-normalize-dialog)))
+
+ (set! amp-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Normalize (~1,2F)" normalize-amount)))
+ (change-label child new-label)))
+ amp-menu-list))))
+
+
;;; -------- Gate (gate set by gate-amount)
;;;
-
- (let ((gate-amount 0.01)
- (gate-label "Gate")
- (gate-dialog #f)
- (gate-size 128)
- (omit-silence #f))
-
- (define (post-gate-dialog)
- (if (not (Widget? gate-dialog))
- ;; if gate-dialog doesn't exist, create it
- (let ((initial-gate-amount 0.01)
- (sliders '()))
- (set! gate-dialog
- (make-effect-dialog
- gate-label
-
- (lambda (w context info)
- (let ((snc (sync)))
- (if (> snc 0)
- (apply map
- (lambda (snd chn)
- (if (= (sync snd) snc)
- (effects-squelch-channel (* gate-amount gate-amount) gate-size snd chn)))
- (all-chans))
- (effects-squelch-channel (* gate-amount gate-amount) gate-size (selected-sound) (selected-channel)))))
-
- (lambda (w context info)
- (help-dialog "Gate"
- "Move the slider to change the gate intensity. Higher values gate more of the sound."))
-
- (lambda (w c i)
- (set! gate-amount initial-gate-amount)
- (XtSetValues (car sliders) (list XmNvalue (floor (* gate-amount 1000)))))
-
- (lambda ()
- (not (null? (sounds))))))
-
- (set! sliders
- (add-sliders gate-dialog
- (list (list "gate" 0.0 initial-gate-amount 0.1
- (lambda (w context info)
- (set! gate-amount (/ (.value info) 1000.0)))
- 1000))))
- ;; now add a toggle button setting omit-silence
- ;; (need to use XtParent here because the containing RowColumn widget is
- ;; hidden in add-sliders -- perhaps it should be returned in the slider list)
-
- (let* ((s1 (XmStringCreateLocalized "Omit silence"))
- (toggle
- (XtCreateManagedWidget "Omit silence" xmToggleButtonWidgetClass (XtParent (car sliders))
- (list XmNselectColor (selection-color)
- XmNbackground (basic-color)
- XmNvalue (if omit-silence 1 0)
- XmNlabelString s1))))
- (XmStringFree s1)
- (XtAddCallback toggle XmNvalueChangedCallback (lambda (w c i)
- (set! omit-silence (.set i)))))))
- (activate-dialog gate-dialog))
-
- (let ((child (XtCreateManagedWidget "Gate" xmPushButtonWidgetClass amp-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((gate-amount 0.01)
+ (gate-label "Gate")
+ (gate-dialog #f)
+ (gate-size 128)
+ (omit-silence #f))
+
+ (define (post-gate-dialog)
+ (if (not (Widget? gate-dialog))
+ ;; if gate-dialog doesn't exist, create it
+ (let ((initial-gate-amount 0.01)
+ (sliders ()))
+ (set! gate-dialog
+ (make-effect-dialog
+ gate-label
+
+ (lambda (w context info)
+ (let ((snc (sync)))
+ (if (> snc 0)
+ (apply map
+ (lambda (snd chn)
+ (if (= (sync snd) snc)
+ (effects-squelch-channel (* gate-amount gate-amount) gate-size snd chn omit-silence)))
+ (all-chans))
+ (effects-squelch-channel (* gate-amount gate-amount) gate-size (selected-sound) (selected-channel) omit-silence))))
+
+ (lambda (w context info)
+ (help-dialog "Gate"
+ "Move the slider to change the gate intensity. Higher values gate more of the sound."))
+
(lambda (w c i)
- (post-gate-dialog)))
+ (set! gate-amount initial-gate-amount)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* gate-amount 1000)))))
+
+ (lambda ()
+ (pair? (sounds)))))
+
+ (set! sliders
+ (add-sliders gate-dialog
+ (list (list "gate" 0.0 initial-gate-amount 0.1
+ (lambda (w context info)
+ (set! gate-amount (/ (.value info) 1000.0)))
+ 1000))))
+ ;; now add a toggle button setting omit-silence
+ ;; (need to use XtParent here because the containing RowColumn widget is
+ ;; hidden in add-sliders -- perhaps it should be returned in the slider list)
+
+ (let* ((s1 (XmStringCreateLocalized "Omit silence"))
+ (toggle
+ (XtCreateManagedWidget "Omit silence" xmToggleButtonWidgetClass (XtParent (car sliders))
+ (list XmNselectColor *selection-color*
+ XmNbackground *basic-color*
+ XmNvalue (if omit-silence 1 0)
+ XmNlabelString s1))))
+ (XmStringFree s1)
+ (XtAddCallback toggle XmNvalueChangedCallback (lambda (w c i)
+ (set! omit-silence (.set i)))))))
+ (activate-dialog gate-dialog))
- (set! amp-menu-list (cons (lambda ()
- (let ((new-label (format #f "Gate (~1,4F)" gate-amount)))
- (change-label child new-label)))
- amp-menu-list))))
- )
-
+ (let ((child (XtCreateManagedWidget "Gate" xmPushButtonWidgetClass amp-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-gate-dialog)))
+
+ (set! amp-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Gate (~1,4F)" gate-amount)))
+ (change-label child new-label)))
+ amp-menu-list))))
+ )
+
;;; DELAY EFFECTS
;;;
-
-(define* (effects-echo input-samps-1 delay-time echo-amount beg dur snd chn)
- "(effects-echo input-samps-1 delay-time echo-amount beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((del (make-delay (round (* delay-time (srate snd)))))
- (samp 0)
- (input-samps (or input-samps-1 dur (frames snd chn))))
- (map-channel (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (* echo-amount (+ (tap del) (if (<= samp input-samps) inval 0.0))))))
- beg dur snd chn #f
- (format #f "effects-echo ~A ~A ~A ~A ~A" input-samps-1 delay-time echo-amount beg dur))))
-
-(define* (effects-flecho-1 scaler secs input-samps-1 beg dur snd chn)
- "(effects-flecho-1 scaler secs input-samps-1 beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let* ((flt (make-fir-filter :order 4 :xcoeffs (vct .125 .25 .25 .125)))
- (del (make-delay (round (* secs (srate snd)))))
- (samp 0)
- (input-samps (or input-samps-1 dur (frames snd chn))))
- (map-channel (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (fir-filter flt (* scaler (+ (tap del) (if (<= samp input-samps) inval 0.0)))))))
- beg dur snd chn #f
- (format #f "effects-flecho-1 ~A ~A ~A ~A ~A" scaler secs input-samps-1 beg dur))))
-
-(define* (effects-zecho-1 scaler secs frq amp input-samps-1 beg dur snd chn)
- "(effects-zecho-1 scaler secs frq amp input-samps-1 beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let* ((os (make-oscil frq))
- (len (round (* secs (srate snd))))
- (del (make-delay len :max-size (round (+ len amp 1))))
- (samp 0)
- (input-samps (or input-samps-1 dur (frames snd chn))))
- (map-channel (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (* scaler (+ (tap del) (if (<= samp input-samps) inval 0.0)))
- (* amp (oscil os)))))
- beg dur snd chn #f
- (format #f "effects-zecho-1 ~A ~A ~A ~A ~A ~A ~A" scaler secs frq amp input-samps-1 beg dur))))
-
-
-(let* ((delay-menu-list '())
- (delay-menu (XmCreatePulldownMenu (main-menu effects-menu) "Delay Effects"
- (list XmNbackground (basic-color))))
- (delay-cascade (XtCreateManagedWidget "Delay Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
- (list XmNsubMenuId delay-menu
- XmNbackground (basic-color)))))
- (XtAddCallback delay-cascade XmNcascadingCallback (lambda (w c i) (update-label delay-menu-list)))
+ (define effects-echo
+ (let ((documentation "(effects-echo input-samps-1 delay-time echo-amount beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (input-samps-1 delay-time echo-amount beg dur snd chn)
+ (let* ((del (make-delay (round (* delay-time (srate snd)))))
+ (len (or dur (framples snd chn)))
+ (input-samps (or input-samps-1 len)))
+ (as-one-edit
+ (lambda ()
+ (map-channel
+ (lambda (inval)
+ (+ inval
+ (delay del (* echo-amount (+ (tap del) inval)))))
+ beg input-samps snd chn)
+ (if (> len input-samps)
+ (map-channel
+ (lambda (inval)
+ (+ inval
+ (delay del (* echo-amount (tap del)))))
+ (+ beg input-samps) (- dur input-samps) snd chn)))
+ (format #f "effects-echo ~A ~A ~A ~A ~A" input-samps-1 delay-time echo-amount beg dur))))))
+
+ (define effects-flecho-1
+ (let ((documentation "(effects-flecho-1 scaler secs input-samps-1 beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (scaler secs input-samps-1 beg dur snd chn)
+ (let ((flt (make-fir-filter :order 4 :xcoeffs (float-vector .125 .25 .25 .125)))
+ (del (make-delay (round (* secs (srate snd))))))
+ (if (and (not input-samps-1) (not dur))
+ (map-channel (lambda (inval)
+ (+ inval
+ (delay del
+ (fir-filter flt (* scaler (+ (tap del) inval))))))
+ beg #f snd chn #f
+ (format #f "effects-flecho-1 ~A ~A ~A ~A ~A" scaler secs input-samps-1 beg #f))
+ (let* ((cutoff (- (or input-samps-1 dur (framples snd chn)) 1))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (map-channel (lambda (inval)
+ (+ inval
+ (delay del
+ (fir-filter flt (* scaler (+ (tap del) (* (env genv) inval)))))))
+ beg dur snd chn #f
+ (format #f "effects-flecho-1 ~A ~A ~A ~A ~A" scaler secs input-samps-1 beg dur))))))))
+
+ (define effects-zecho-1
+ (let ((documentation "(effects-zecho-1 scaler secs frq amp input-samps-1 beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (scaler secs frq amp input-samps-1 beg dur snd chn)
+ (let* ((os (make-oscil frq))
+ (len (round (* secs (srate snd))))
+ (del (make-delay len :max-size (round (+ len amp 1))))
+ (cutoff (- (or input-samps-1 dur (framples snd chn)) 1))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (map-channel (lambda (inval)
+ (+ inval
+ (delay del
+ (* scaler (+ (tap del) (* (env genv) inval)))
+ (* amp (oscil os)))))
+ beg dur snd chn #f
+ (format #f "effects-zecho-1 ~A ~A ~A ~A ~A ~A ~A" scaler secs frq amp input-samps-1 beg dur))))))
+
+
+ (let* ((delay-menu-list ())
+ (delay-menu (XmCreatePulldownMenu (main-menu effects-menu) "Delay Effects"
+ (list XmNbackground *basic-color*)))
+ (delay-cascade (XtCreateManagedWidget "Delay Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
+ (list XmNsubMenuId delay-menu
+ XmNbackground *basic-color*))))
+ (XtAddCallback delay-cascade XmNcascadingCallback (lambda (w c i) (update-label delay-menu-list)))
+
;;; -------- Echo (controlled by delay-time and echo-amount)
-
- (let ((delay-time .5) ; i.e. delay between echoes
- (echo-amount .2)
- (echo-label "Echo")
- (echo-dialog #f)
- (echo-target 'sound)
- (echo-truncate #t))
-
- (define (post-echo-dialog)
- (if (not (Widget? echo-dialog))
- ;; if echo-dialog doesn't exist, create it
- (let ((initial-delay-time 0.5)
- (initial-echo-amount 0.2)
- (sliders '()))
- (set! echo-dialog
- (make-effect-dialog
- echo-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (input-samps)
- (let ((del (make-delay (round (* delay-time (srate)))))
- (samp 0))
- (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (* echo-amount (+ (tap del) (if (<= samp input-samps) inval 0.0))))))))
- echo-target
- (lambda (target input-samps)
- (format #f "effects-echo ~A ~A ~A"
- (if (eq? target 'sound) #f input-samps)
- delay-time echo-amount))
- (and (not echo-truncate)
- (* 4 delay-time))))
-
- (lambda (w context info)
- (help-dialog "Echo"
- "The sliders change the delay time and echo amount."))
-
- (lambda (w c i)
- (set! delay-time initial-delay-time)
- (XtSetValues (car sliders) (list XmNvalue (floor (* delay-time 100))))
- (set! echo-amount initial-echo-amount)
- (XtSetValues (cadr sliders) (list XmNvalue (floor (* echo-amount 100)))))
-
- (lambda ()
- (effect-target-ok echo-target))))
-
- (set! sliders
- (add-sliders echo-dialog
- (list (list "delay time" 0.0 initial-delay-time 2.0
- (lambda (w context info)
- (set! delay-time (/ (.value info) 100.0)))
- 100)
- (list "echo amount" 0.0 initial-echo-amount 1.0
- (lambda (w context info)
- (set! echo-amount (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! echo-target target)
- (XtSetSensitive (XmMessageBoxGetChild echo-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- (lambda (truncate)
- (set! echo-truncate truncate)))))
-
- (activate-dialog echo-dialog))
-
- (let ((child (XtCreateManagedWidget "Echo" xmPushButtonWidgetClass delay-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
- (lambda (w c i)
- (post-echo-dialog)))
+
+ (let ((delay-time .5) ; i.e. delay between echoes
+ (echo-amount .2)
+ (echo-label "Echo")
+ (echo-dialog #f)
+ (echo-target 'sound)
+ (echo-truncate #t))
- (set! delay-menu-list (cons (lambda ()
- (let ((new-label (format #f "Echo (~1,2F ~1,2F)" delay-time echo-amount)))
- (change-label child new-label)))
- delay-menu-list))))
-
-
+ (define (post-echo-dialog)
+ (if (not (Widget? echo-dialog))
+ ;; if echo-dialog doesn't exist, create it
+ (let ((initial-delay-time 0.5)
+ (initial-echo-amount 0.2)
+ (sliders ()))
+ (set! echo-dialog
+ (make-effect-dialog
+ echo-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (cutoff)
+ (let ((del (make-delay (round (* delay-time (srate)))))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (lambda (inval)
+ (+ inval
+ (delay del
+ (* echo-amount (+ (tap del) (* (env genv) inval))))))))
+ echo-target
+ (lambda (target input-samps)
+ (format #f "effects-echo ~A ~A ~A"
+ (and (not (eq? target 'sound)) input-samps)
+ delay-time echo-amount))
+ (and (not echo-truncate)
+ (* 4 delay-time))))
+
+ (lambda (w context info)
+ (help-dialog "Echo"
+ "The sliders change the delay time and echo amount."))
+
+ (lambda (w c i)
+ (set! delay-time initial-delay-time)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* delay-time 100))))
+ (set! echo-amount initial-echo-amount)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor (* echo-amount 100)))))
+
+ (lambda ()
+ (effect-target-ok echo-target))))
+
+ (set! sliders
+ (add-sliders echo-dialog
+ (list (list "delay time" 0.0 initial-delay-time 2.0
+ (lambda (w context info)
+ (set! delay-time (/ (.value info) 100.0)))
+ 100)
+ (list "echo amount" 0.0 initial-echo-amount 1.0
+ (lambda (w context info)
+ (set! echo-amount (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! echo-target target)
+ (XtSetSensitive (XmMessageBoxGetChild echo-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ (lambda (truncate)
+ (set! echo-truncate truncate)))))
+
+ (activate-dialog echo-dialog))
+
+ (let ((child (XtCreateManagedWidget "Echo" xmPushButtonWidgetClass delay-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-echo-dialog)))
+
+ (set! delay-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Echo (~1,2F ~1,2F)" delay-time echo-amount)))
+ (change-label child new-label)))
+ delay-menu-list))))
+
+
;;; -------- Filtered echo
-
- (let ((flecho-scaler 0.5)
- (flecho-delay 0.9)
- (flecho-label "Filtered echo")
- (flecho-dialog #f)
- (flecho-target 'sound)
- (flecho-truncate #t))
-
- (define flecho-1
- (lambda (scaler secs input-samps)
- (let* ((flt (make-fir-filter :order 4 :xcoeffs (vct .125 .25 .25 .125)))
- (del (make-delay (round (* secs (srate)))))
- (samp 0))
- (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (fir-filter flt (* scaler (+ (tap del) (if (<= samp input-samps) inval 0.0))))))))))
-
- (define (post-flecho-dialog)
- (if (not (Widget? flecho-dialog))
- ;; if flecho-dialog doesn't exist, create it
- (let ((initial-flecho-scaler 0.5)
- (initial-flecho-delay 0.9)
- (sliders '()))
- (set! flecho-dialog
- (make-effect-dialog
- flecho-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (input-samps)
- (flecho-1 flecho-scaler flecho-delay input-samps))
- flecho-target
- (lambda (target input-samps)
- (format #f "effects-flecho-1 ~A ~A ~A"
- flecho-scaler flecho-delay
- (if (eq? target 'sound) #f input-samps)))
- (and (not flecho-truncate)
- (* 4 flecho-delay))))
-
- (lambda (w context info)
- (help-dialog "Filtered echo"
- "Move the sliders to set the filter scaler and the delay time in seconds."))
-
- (lambda (w c i)
- (set! flecho-scaler initial-flecho-scaler)
- (XtSetValues (list-ref sliders 0) (list XmNvalue (floor (* flecho-scaler 100))))
- (set! flecho-delay initial-flecho-delay)
- (XtSetValues (list-ref sliders 1) (list XmNvalue (floor (* flecho-delay 100)))))
-
- (lambda ()
- (effect-target-ok flecho-target))))
-
- (set! sliders
- (add-sliders flecho-dialog
- (list (list "filter scaler" 0.0 initial-flecho-scaler 1.0
- (lambda (w context info)
- (set! flecho-scaler (/ (.value info) 100.0)))
- 100)
- (list "delay time (secs)" 0.0 initial-flecho-delay 3.0
- (lambda (w context info)
- (set! flecho-delay (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! flecho-target target)
- (XtSetSensitive (XmMessageBoxGetChild flecho-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- (lambda (truncate)
- (set! flecho-truncate truncate)))))
-
- (activate-dialog flecho-dialog))
-
- (let ((child (XtCreateManagedWidget "Filtered echo" xmPushButtonWidgetClass delay-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((flecho-scaler 0.5)
+ (flecho-delay 0.9)
+ (flecho-label "Filtered echo")
+ (flecho-dialog #f)
+ (flecho-target 'sound)
+ (flecho-truncate #t))
+
+ (define flecho-1
+ (lambda (scaler secs cutoff)
+ (let ((flt (make-fir-filter :order 4 :xcoeffs (float-vector .125 .25 .25 .125)))
+ (del (make-delay (round (* secs (srate)))))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (lambda (inval)
+ (+ inval
+ (delay del
+ (fir-filter flt (* scaler (+ (tap del) (* (env genv) inval))))))))))
+
+ (define (post-flecho-dialog)
+ (if (not (Widget? flecho-dialog))
+ ;; if flecho-dialog doesn't exist, create it
+ (let ((initial-flecho-scaler 0.5)
+ (initial-flecho-delay 0.9)
+ (sliders ()))
+ (set! flecho-dialog
+ (make-effect-dialog
+ flecho-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (input-samps)
+ (flecho-1 flecho-scaler flecho-delay input-samps))
+ flecho-target
+ (lambda (target input-samps)
+ (format #f "effects-flecho-1 ~A ~A ~A"
+ flecho-scaler flecho-delay
+ (and (not (eq? target 'sound)) input-samps)))
+ (and (not flecho-truncate)
+ (* 4 flecho-delay))))
+
+ (lambda (w context info)
+ (help-dialog "Filtered echo"
+ "Move the sliders to set the filter scaler and the delay time in seconds."))
+
(lambda (w c i)
- (post-flecho-dialog)))
+ (set! flecho-scaler initial-flecho-scaler)
+ (XtSetValues (sliders 0) (list XmNvalue (floor (* flecho-scaler 100))))
+ (set! flecho-delay initial-flecho-delay)
+ (XtSetValues (sliders 1) (list XmNvalue (floor (* flecho-delay 100)))))
+
+ (lambda ()
+ (effect-target-ok flecho-target))))
+
+ (set! sliders
+ (add-sliders flecho-dialog
+ (list (list "filter scaler" 0.0 initial-flecho-scaler 1.0
+ (lambda (w context info)
+ (set! flecho-scaler (/ (.value info) 100.0)))
+ 100)
+ (list "delay time (secs)" 0.0 initial-flecho-delay 3.0
+ (lambda (w context info)
+ (set! flecho-delay (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! flecho-target target)
+ (XtSetSensitive (XmMessageBoxGetChild flecho-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ (lambda (truncate)
+ (set! flecho-truncate truncate)))))
+
+ (activate-dialog flecho-dialog))
- (set! delay-menu-list (cons (lambda ()
- (let ((new-label (format #f "Filtered echo (~1,2F ~1,2F)" flecho-scaler flecho-delay)))
- (change-label child new-label)))
- delay-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "Filtered echo" xmPushButtonWidgetClass delay-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-flecho-dialog)))
+
+ (set! delay-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Filtered echo (~1,2F ~1,2F)" flecho-scaler flecho-delay)))
+ (change-label child new-label)))
+ delay-menu-list))))
+
+
;;; -------- Modulated echo
;;; -------- very slick
-
- (let ((zecho-scaler 0.5)
- (zecho-delay 0.75)
- (zecho-freq 6)
- (zecho-amp 10.0)
- (zecho-label "Modulated echo")
- (zecho-dialog #f)
- (zecho-target 'sound)
- (zecho-truncate #t))
-
- (define zecho-1
- (lambda (scaler secs frq amp input-samps)
- (let* ((os (make-oscil frq))
- (len (round (* secs (srate))))
- (del (make-delay len :max-size (round (+ len amp 1))))
- (samp 0))
- (lambda (inval)
- (set! samp (+ 1 samp))
- (+ inval
- (delay del
- (* scaler (+ (tap del) (if (<= samp input-samps) inval 0.0)))
- (* amp (oscil os))))))))
-
- (define (post-zecho-dialog)
- (if (not (Widget? zecho-dialog))
- ;; if zecho-dialog doesn't exist, create it
- (let ((initial-zecho-scaler 0.5)
- (initial-zecho-delay 0.75)
- (initial-zecho-freq 6)
- (initial-zecho-amp 10.0)
- (sliders '()))
- (set! zecho-dialog
- (make-effect-dialog
- zecho-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (input-samps)
- (zecho-1 zecho-scaler zecho-delay zecho-freq zecho-amp input-samps))
- zecho-target
- (lambda (target input-samps)
- (format #f "effects-zecho-1 ~A ~A ~A ~A ~A"
- zecho-scaler zecho-delay zecho-freq zecho-amp
- (if (eq? target 'sound) #f input-samps)))
- (and (not zecho-truncate)
- (* 4 zecho-delay))))
-
- (lambda (w context info)
- (help-dialog "Modulated echo"
- "Move the sliders to set the echo scaler,
+
+ (let ((zecho-scaler 0.5)
+ (zecho-delay 0.75)
+ (zecho-freq 6)
+ (zecho-amp 10.0)
+ (zecho-label "Modulated echo")
+ (zecho-dialog #f)
+ (zecho-target 'sound)
+ (zecho-truncate #t))
+
+ (define zecho-1
+ (lambda (scaler secs frq amp cutoff)
+ (let* ((os (make-oscil frq))
+ (len (round (* secs (srate))))
+ (del (make-delay len :max-size (round (+ len amp 1))))
+ (genv (make-env (list 0.0 1.0 cutoff 1.0 (+ cutoff 1) 0.0 (+ cutoff 100) 0.0) :length (+ cutoff 100))))
+ (lambda (inval)
+ (+ inval
+ (delay del
+ (* scaler (+ (tap del) (* (env genv) inval)))
+ (* amp (oscil os))))))))
+
+ (define (post-zecho-dialog)
+ (if (not (Widget? zecho-dialog))
+ ;; if zecho-dialog doesn't exist, create it
+ (let ((initial-zecho-scaler 0.5)
+ (initial-zecho-delay 0.75)
+ (initial-zecho-freq 6)
+ (initial-zecho-amp 10.0)
+ (sliders ()))
+ (set! zecho-dialog
+ (make-effect-dialog
+ zecho-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (input-samps)
+ (zecho-1 zecho-scaler zecho-delay zecho-freq zecho-amp input-samps))
+ zecho-target
+ (lambda (target input-samps)
+ (format #f "effects-zecho-1 ~A ~A ~A ~A ~A"
+ zecho-scaler zecho-delay zecho-freq zecho-amp
+ (and (not (eq? target 'sound)) input-samps)))
+ (and (not zecho-truncate)
+ (* 4 zecho-delay))))
+
+ (lambda (w context info)
+ (help-dialog "Modulated echo"
+ "Move the sliders to set the echo scaler,
the delay time in seconds, the modulation frequency, and the echo amplitude."))
-
- (lambda (w c i)
- (set! zecho-scaler initial-zecho-scaler)
- (XtSetValues (list-ref sliders 0) (list XmNvalue (floor (* zecho-scaler 100))))
- (set! zecho-delay initial-zecho-delay)
- (XtSetValues (list-ref sliders 1) (list XmNvalue (floor (* zecho-delay 100))))
- (set! zecho-freq initial-zecho-freq)
- (XtSetValues (list-ref sliders 2) (list XmNvalue (floor (* zecho-freq 100))))
- (set! zecho-amp initial-zecho-amp)
- (XtSetValues (list-ref sliders 3) (list XmNvalue (floor (* zecho-amp 100)))))
-
- (lambda ()
- (effect-target-ok zecho-target))))
-
- (set! sliders
- (add-sliders zecho-dialog
- (list (list "echo scaler" 0.0 initial-zecho-scaler 1.0
- (lambda (w context info)
- (set! zecho-scaler (/ (.value info) 100.0)))
- 100)
- (list "delay time (secs)" 0.0 initial-zecho-delay 3.0
- (lambda (w context info)
- (set! zecho-delay (/ (.value info) 100.0)))
- 100)
- (list "modulation frequency" 0.0 initial-zecho-freq 100.0
- (lambda (w context info)
- (set! zecho-freq (/ (.value info) 100.0)))
- 100)
- (list "modulation amplitude" 0.0 initial-zecho-amp 100.0
- (lambda (w context info)
- (set! zecho-amp (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! zecho-target target)
- (XtSetSensitive (XmMessageBoxGetChild zecho-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- (lambda (truncate)
- (set! zecho-truncate truncate)))))
- (activate-dialog zecho-dialog))
-
- (let ((child (XtCreateManagedWidget "Modulated echo" xmPushButtonWidgetClass delay-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
(lambda (w c i)
- (post-zecho-dialog)))
+ (set! zecho-scaler initial-zecho-scaler)
+ (XtSetValues (sliders 0) (list XmNvalue (floor (* zecho-scaler 100))))
+ (set! zecho-delay initial-zecho-delay)
+ (XtSetValues (sliders 1) (list XmNvalue (floor (* zecho-delay 100))))
+ (set! zecho-freq initial-zecho-freq)
+ (XtSetValues (sliders 2) (list XmNvalue (floor (* zecho-freq 100))))
+ (set! zecho-amp initial-zecho-amp)
+ (XtSetValues (sliders 3) (list XmNvalue (floor (* zecho-amp 100)))))
+
+ (lambda ()
+ (effect-target-ok zecho-target))))
+
+ (set! sliders
+ (add-sliders zecho-dialog
+ (list (list "echo scaler" 0.0 initial-zecho-scaler 1.0
+ (lambda (w context info)
+ (set! zecho-scaler (/ (.value info) 100.0)))
+ 100)
+ (list "delay time (secs)" 0.0 initial-zecho-delay 3.0
+ (lambda (w context info)
+ (set! zecho-delay (/ (.value info) 100.0)))
+ 100)
+ (list "modulation frequency" 0.0 initial-zecho-freq 100.0
+ (lambda (w context info)
+ (set! zecho-freq (/ (.value info) 100.0)))
+ 100)
+ (list "modulation amplitude" 0.0 initial-zecho-amp 100.0
+ (lambda (w context info)
+ (set! zecho-amp (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! zecho-target target)
+ (XtSetSensitive (XmMessageBoxGetChild zecho-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ (lambda (truncate)
+ (set! zecho-truncate truncate)))))
+ (activate-dialog zecho-dialog))
- (set! delay-menu-list (cons (lambda ()
- (let ((new-label (format #f "Modulated echo (~1,2F ~1,2F ~1,2F ~1,2F)"
- zecho-scaler zecho-delay zecho-freq zecho-amp)))
- (change-label child new-label)))
- delay-menu-list))))
- )
-
+ (let ((child (XtCreateManagedWidget "Modulated echo" xmPushButtonWidgetClass delay-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-zecho-dialog)))
+
+ (set! delay-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Modulated echo (~1,2F ~1,2F ~1,2F ~1,2F)"
+ zecho-scaler zecho-delay zecho-freq zecho-amp)))
+ (change-label child new-label)))
+ delay-menu-list))))
+ )
+
;;; FILTERS
;;;
-
-(define* (effects-comb-filter scaler size beg dur snd chn)
- "(effects-comb-filter scaler-1 size beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((delay-line (make-vct size 0.0))
- (delay-loc 0))
- (lambda (x)
- (let ((result (vct-ref delay-line delay-loc)))
- (vct-set! delay-line delay-loc (+ x (* scaler result)))
- (set! delay-loc (+ 1 delay-loc))
- (if (= delay-loc size) (set! delay-loc 0))
- result))))
-
-(define* (effects-comb-chord scaler size amp interval-one interval-two beg dur snd chn)
- "(effects-comb-chord scaler size amp interval-one interval-two beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((c1 (make-comb scaler size))
- (c2 (make-comb scaler (* size interval-one)))
- (c3 (make-comb scaler (* size interval-two))))
- (map-channel (lambda (x)
- (* amp (+ (comb c1 x) (comb c2 x) (comb c3 x))))
- beg dur snd chn #f
- (format #f "effects-comb-chord ~A ~A ~A ~A ~A ~A ~A" scaler size amp interval-one interval-two beg dur))))
-
-(define* (effects-moog freq Q beg dur snd chn)
- "(effects-moog freq Q beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((gen (make-moog-filter freq Q)))
- (map-channel (lambda (inval)
- (moog-filter gen inval))
- beg dur snd chn #f
- (format #f "effects-moog ~A ~A ~A ~A" freq Q beg dur))))
-
-(define* (effects-bbp freq bw beg dur snd chn)
- "(effects-bbp freq bw beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((flt (make-butter-band-pass freq bw)))
- (clm-channel flt beg dur snd chn #f #f
- (format #f "effects-bbp ~A ~A ~A ~A" freq bw beg dur))))
-
-(define* (effects-bbr freq bw beg dur snd chn)
- "(effects-bbr freq bw beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((flt (make-butter-band-reject freq bw)))
- (clm-channel flt beg dur snd chn #f #f
- (format #f "effects-bbr ~A ~A ~A ~A" freq bw beg dur))))
-
-(define* (effects-bhp freq beg dur snd chn)
- "(effects-bhp freq beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((flt (make-butter-high-pass freq)))
- (clm-channel flt beg dur snd chn #f #f
- (format #f "effects-bhp ~A ~A ~A" freq beg dur))))
-
-(define* (effects-blp freq beg dur snd chn)
- "(effects-blp freq beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((flt (make-butter-low-pass freq)))
- (clm-channel flt beg dur snd chn #f #f
- (format #f "effects-blp ~A ~A ~A" freq beg dur))))
-
-
-(let* ((filter-menu-list '())
- (filter-menu (XmCreatePulldownMenu (main-menu effects-menu) "Filter Effects"
- (list XmNbackground (basic-color))))
- (filter-cascade (XtCreateManagedWidget "Filter Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
- (list XmNsubMenuId filter-menu
- XmNbackground (basic-color))))
- (root-2 (sqrt 2.0)))
-
- (XtAddCallback filter-cascade XmNcascadingCallback (lambda (w c i) (update-label filter-menu-list)))
+ (define effects-comb-filter
+ (let ((documentation "(effects-comb-filter scaler-1 size beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (scaler size beg dur snd chn)
+ (let ((delay-line (make-float-vector size 0.0))
+ (delay-loc 0))
+ (lambda (x)
+ (let ((result (delay-line delay-loc)))
+ (set! (delay-line delay-loc) (+ x (* scaler result)))
+ (set! delay-loc (+ 1 delay-loc))
+ (if (= delay-loc size) (set! delay-loc 0))
+ result))))))
+
+ (define effects-comb-chord
+ (let ((documentation "(effects-comb-chord scaler size amp interval-one interval-two beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (scaler size amp interval-one interval-two beg dur snd chn)
+ (let ((cs (make-comb-bank (vector (make-comb scaler size)
+ (make-comb scaler (* size interval-one))
+ (make-comb scaler (* size interval-two))))))
+ (map-channel (lambda (x)
+ (* amp (comb-bank cs x)))
+ beg dur snd chn #f
+ (format #f "effects-comb-chord ~A ~A ~A ~A ~A ~A ~A" scaler size amp interval-one interval-two beg dur))))))
+
+ (define effects-moog
+ (let ((documentation "(effects-moog freq Q beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (freq Q beg dur snd chn)
+ (let ((gen (make-moog-filter freq Q)))
+ (map-channel (lambda (inval)
+ (moog-filter gen inval))
+ beg dur snd chn #f
+ (format #f "effects-moog ~A ~A ~A ~A" freq Q beg dur))))))
+
+ (define effects-bbp
+ (let ((documentation "(effects-bbp freq bw beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (freq bw beg dur snd chn)
+ (let ((flt (make-butter-band-pass freq bw)))
+ (clm-channel flt beg dur snd chn #f #f
+ (format #f "effects-bbp ~A ~A ~A ~A" freq bw beg dur))))))
+
+ (define effects-bbr
+ (let ((documentation "(effects-bbr freq bw beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (freq bw beg dur snd chn)
+ (let ((flt (make-butter-band-reject freq bw)))
+ (clm-channel flt beg dur snd chn #f #f
+ (format #f "effects-bbr ~A ~A ~A ~A" freq bw beg dur))))))
+
+ (define effects-bhp
+ (let ((documentation "(effects-bhp freq beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (freq beg dur snd chn)
+ (let ((flt (make-butter-high-pass freq)))
+ (clm-channel flt beg dur snd chn #f #f
+ (format #f "effects-bhp ~A ~A ~A" freq beg dur))))))
+
+ (define effects-blp
+ (let ((documentation "(effects-blp freq beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (freq beg dur snd chn)
+ (let ((flt (make-butter-low-pass freq)))
+ (clm-channel flt beg dur snd chn #f #f
+ (format #f "effects-blp ~A ~A ~A" freq beg dur))))))
+
+
+ (let* ((filter-menu-list ())
+ (filter-menu (XmCreatePulldownMenu (main-menu effects-menu) "Filter Effects"
+ (list XmNbackground *basic-color*)))
+ (filter-cascade (XtCreateManagedWidget "Filter Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
+ (list XmNsubMenuId filter-menu
+ XmNbackground *basic-color*))))
+
+ (XtAddCallback filter-cascade XmNcascadingCallback (lambda (w c i) (update-label filter-menu-list)))
+
;;; -------- Butterworth band-pass filter
-
- (let ((band-pass-freq 1000)
- (band-pass-bw 100)
- (band-pass-label "Band-pass filter")
- (band-pass-dialog #f)
- (band-pass-target 'sound))
-
- (define (post-band-pass-dialog)
- (if (not (Widget? band-pass-dialog))
- ;; if band-pass-dialog doesn't exist, create it
- (let ((initial-band-pass-freq 1000)
- (initial-band-pass-bw 100)
- (sliders '()))
- (set! band-pass-dialog
- (make-effect-dialog
- band-pass-label
-
- (lambda (w context info)
- (let ((flt (make-butter-band-pass band-pass-freq band-pass-bw)))
- (if (eq? band-pass-target 'sound)
- (filter-sound flt #f #f #f #f (format #f "effects-bbp ~A ~A 0 #f" band-pass-freq band-pass-bw))
- (if (eq? band-pass-target 'selection)
- (filter-selection flt)
- (let* ((ms (plausible-mark-samples))
- (bg (car ms))
- (nd (+ 1 (- (cadr ms) (car ms)))))
- (clm-channel flt bg nd #f #f #f #f
- (format #f "effects-bbp ~A ~A ~A ~A" band-pass-freq band-pass-bw bg nd)))))))
- (lambda (w context info)
- (help-dialog "Band-pass filter"
- "Butterworth band-pass filter. Move the sliders to change the center frequency and bandwidth."))
-
- (lambda (w c i)
- (set! band-pass-freq initial-band-pass-freq)
- (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 band-pass-freq 22050)))
- (set! band-pass-bw initial-band-pass-bw)
- (XtSetValues (cadr sliders) (list XmNvalue (floor band-pass-bw))))
-
- (lambda ()
- (effect-target-ok band-pass-target))))
-
- (set! sliders
- (add-sliders band-pass-dialog
- (list (list "center frequency" 20 initial-band-pass-freq 22050
- (lambda (w context info)
- (set! band-pass-freq (scale-linear->log 20 (.value info) 22050)))
- 1 'log)
- (list "bandwidth" 0 initial-band-pass-bw 1000
- (lambda (w context info)
- (set! band-pass-bw (.value info)))
- 1))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! band-pass-target target)
- (XtSetSensitive (XmMessageBoxGetChild band-pass-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog band-pass-dialog))
-
- (let ((child (XtCreateManagedWidget "Band-pass filter" xmPushButtonWidgetClass filter-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((band-pass-freq 1000)
+ (band-pass-bw 100)
+ (band-pass-label "Band-pass filter")
+ (band-pass-dialog #f)
+ (band-pass-target 'sound))
+
+ (define (post-band-pass-dialog)
+ (if (not (Widget? band-pass-dialog))
+ ;; if band-pass-dialog doesn't exist, create it
+ (let ((initial-band-pass-freq 1000)
+ (initial-band-pass-bw 100)
+ (sliders ()))
+ (set! band-pass-dialog
+ (make-effect-dialog
+ band-pass-label
+
+ (lambda (w context info)
+ (let ((flt (make-butter-band-pass band-pass-freq band-pass-bw)))
+ (if (eq? band-pass-target 'sound)
+ (filter-sound flt #f #f #f #f (format #f "effects-bbp ~A ~A 0 #f" band-pass-freq band-pass-bw))
+ (if (eq? band-pass-target 'selection)
+ (filter-selection flt)
+ (let* ((ms (plausible-mark-samples))
+ (bg (car ms))
+ (nd (+ 1 (- (cadr ms) (car ms)))))
+ (clm-channel flt bg nd #f #f #f #f
+ (format #f "effects-bbp ~A ~A ~A ~A" band-pass-freq band-pass-bw bg nd)))))))
+ (lambda (w context info)
+ (help-dialog "Band-pass filter"
+ "Butterworth band-pass filter. Move the sliders to change the center frequency and bandwidth."))
+
(lambda (w c i)
- (post-band-pass-dialog)))
+ (set! band-pass-freq initial-band-pass-freq)
+ (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 band-pass-freq 22050)))
+ (set! band-pass-bw initial-band-pass-bw)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor band-pass-bw))))
+
+ (lambda ()
+ (effect-target-ok band-pass-target))))
+
+ (set! sliders
+ (add-sliders band-pass-dialog
+ (list (list "center frequency" 20 initial-band-pass-freq 22050
+ (lambda (w context info)
+ (set! band-pass-freq (scale-linear->log 20 (.value info) 22050)))
+ 1 'log)
+ (list "bandwidth" 0 initial-band-pass-bw 1000
+ (lambda (w context info)
+ (set! band-pass-bw (.value info)))
+ 1))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! band-pass-target target)
+ (XtSetSensitive (XmMessageBoxGetChild band-pass-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog band-pass-dialog))
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Band-pass filter (~,2F ~D" band-pass-freq band-pass-bw)))
- (change-label child new-label)))
- filter-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Band-pass filter" xmPushButtonWidgetClass filter-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-band-pass-dialog)))
+
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Band-pass filter (~,2F ~D" band-pass-freq band-pass-bw)))
+ (change-label child new-label)))
+ filter-menu-list))))
+
;;; -------- Butterworth band-reject (notch) filter
-
- (let ((notch-freq 100)
- (notch-bw 100)
- (notch-label "Band-reject filter")
- (notch-dialog #f)
- (notch-target 'sound))
-
- (define (post-notch-dialog)
- (if (not (Widget? notch-dialog))
- ;; if notch-dialog doesn't exist, create it
- (let ((initial-notch-freq 100)
- (initial-notch-bw 100)
- (sliders '()))
- (set! notch-dialog
- (make-effect-dialog
- notch-label
-
- (lambda (w context info)
- (let ((flt (make-butter-band-reject notch-freq notch-bw)))
- (if (eq? notch-target 'sound)
- (filter-sound flt #f #f #f #f (format #f "effects-bbr ~A ~A 0 #f" notch-freq notch-bw))
- (if (eq? notch-target 'selection)
- (filter-selection flt)
- (let* ((ms (plausible-mark-samples))
- (bg (car ms))
- (nd (+ 1 (- (cadr ms) (car ms)))))
- (clm-channel flt bg nd #f #f #f #f
- (format #f "effects-bbr ~A ~A ~A ~A" notch-freq notch-bw bg nd)))))))
- (lambda (w context info)
- (help-dialog "Band-reject filter"
- "Butterworth band-reject filter. Move the sliders to change the center frequency and bandwidth."))
-
- (lambda (w c i)
- (set! notch-freq initial-notch-freq)
- (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 notch-freq 22050)))
- (set! notch-bw initial-notch-bw)
- (XtSetValues (cadr sliders) (list XmNvalue (floor notch-bw))))
-
- (lambda ()
- (effect-target-ok notch-target))))
-
- (set! sliders
- (add-sliders notch-dialog
- (list (list "center frequency" 20 initial-notch-freq 22050
- (lambda (w context info)
- (set! notch-freq (scale-linear->log 20 (.value info) 22050)))
- 1 'log)
- (list "bandwidth" 0 initial-notch-bw 1000
- (lambda (w context info)
- (set! notch-bw (.value info)))
- 1))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! notch-target target)
- (XtSetSensitive (XmMessageBoxGetChild notch-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog notch-dialog))
-
- (let ((child (XtCreateManagedWidget "Band-reject filter" xmPushButtonWidgetClass filter-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((notch-freq 100)
+ (notch-bw 100)
+ (notch-label "Band-reject filter")
+ (notch-dialog #f)
+ (notch-target 'sound))
+
+ (define (post-notch-dialog)
+ (if (not (Widget? notch-dialog))
+ ;; if notch-dialog doesn't exist, create it
+ (let ((initial-notch-freq 100)
+ (initial-notch-bw 100)
+ (sliders ()))
+ (set! notch-dialog
+ (make-effect-dialog
+ notch-label
+
+ (lambda (w context info)
+ (let ((flt (make-butter-band-reject notch-freq notch-bw)))
+ (if (eq? notch-target 'sound)
+ (filter-sound flt #f #f #f #f (format #f "effects-bbr ~A ~A 0 #f" notch-freq notch-bw))
+ (if (eq? notch-target 'selection)
+ (filter-selection flt)
+ (let* ((ms (plausible-mark-samples))
+ (bg (car ms))
+ (nd (+ 1 (- (cadr ms) (car ms)))))
+ (clm-channel flt bg nd #f #f #f #f
+ (format #f "effects-bbr ~A ~A ~A ~A" notch-freq notch-bw bg nd)))))))
+ (lambda (w context info)
+ (help-dialog "Band-reject filter"
+ "Butterworth band-reject filter. Move the sliders to change the center frequency and bandwidth."))
+
(lambda (w c i)
- (post-notch-dialog)))
+ (set! notch-freq initial-notch-freq)
+ (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 notch-freq 22050)))
+ (set! notch-bw initial-notch-bw)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor notch-bw))))
+
+ (lambda ()
+ (effect-target-ok notch-target))))
+
+ (set! sliders
+ (add-sliders notch-dialog
+ (list (list "center frequency" 20 initial-notch-freq 22050
+ (lambda (w context info)
+ (set! notch-freq (scale-linear->log 20 (.value info) 22050)))
+ 1 'log)
+ (list "bandwidth" 0 initial-notch-bw 1000
+ (lambda (w context info)
+ (set! notch-bw (.value info)))
+ 1))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! notch-target target)
+ (XtSetSensitive (XmMessageBoxGetChild notch-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog notch-dialog))
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Band-reject filter (~,2F ~D)" notch-freq notch-bw)))
- (change-label child new-label)))
- filter-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Band-reject filter" xmPushButtonWidgetClass filter-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-notch-dialog)))
+
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Band-reject filter (~,2F ~D)" notch-freq notch-bw)))
+ (change-label child new-label)))
+ filter-menu-list))))
+
;;; -------- Butterworth high-pass filter
-
- (let ((high-pass-freq 100)
- (high-pass-label "High-pass filter")
- (high-pass-dialog #f)
- (high-pass-target 'sound))
-
- (define (post-high-pass-dialog)
- (if (not (Widget? high-pass-dialog))
- ;; if high-pass-dialog doesn't exist, create it
- (let ((initial-high-pass-freq 100)
- (sliders '()))
- (set! high-pass-dialog
- (make-effect-dialog
- high-pass-label
-
- (lambda (w context info)
- (let ((flt (make-butter-high-pass high-pass-freq)))
- (if (eq? high-pass-target 'sound)
- (filter-sound flt #f #f #f #f (format #f "effects-bhp ~A 0 #f" high-pass-freq))
- (if (eq? high-pass-target 'selection)
- (filter-selection flt)
- (let* ((ms (plausible-mark-samples))
- (bg (car ms))
- (nd (+ 1 (- (cadr ms) (car ms)))))
- (clm-channel flt bg nd #f #f #f #f
- (format #f "effects-bhp ~A ~A ~A" high-pass-freq bg nd)))))))
-
- (lambda (w context info)
- (help-dialog "High-pass filter"
- "Butterworth high-pass filter. Move the slider to change the high-pass cutoff frequency."))
-
- (lambda (w c i)
- (set! high-pass-freq initial-high-pass-freq)
- (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 high-pass-freq 22050))))
-
- (lambda ()
- (effect-target-ok high-pass-target))))
-
- (set! sliders
- (add-sliders high-pass-dialog
- (list (list "high-pass cutoff frequency" 20 initial-high-pass-freq 22050
- (lambda (w context info)
- (set! high-pass-freq (scale-linear->log 20 (.value info) 22050)))
- 1 'log))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! high-pass-target target)
- (XtSetSensitive (XmMessageBoxGetChild high-pass-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog high-pass-dialog))
-
- (let ((child (XtCreateManagedWidget "High-pass filter" xmPushButtonWidgetClass filter-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((high-pass-freq 100)
+ (high-pass-label "High-pass filter")
+ (high-pass-dialog #f)
+ (high-pass-target 'sound))
+
+ (define (post-high-pass-dialog)
+ (if (not (Widget? high-pass-dialog))
+ ;; if high-pass-dialog doesn't exist, create it
+ (let ((initial-high-pass-freq 100)
+ (sliders ()))
+ (set! high-pass-dialog
+ (make-effect-dialog
+ high-pass-label
+
+ (lambda (w context info)
+ (let ((flt (make-butter-high-pass high-pass-freq)))
+ (if (eq? high-pass-target 'sound)
+ (filter-sound flt #f #f #f #f (format #f "effects-bhp ~A 0 #f" high-pass-freq))
+ (if (eq? high-pass-target 'selection)
+ (filter-selection flt)
+ (let* ((ms (plausible-mark-samples))
+ (bg (car ms))
+ (nd (+ 1 (- (cadr ms) (car ms)))))
+ (clm-channel flt bg nd #f #f #f #f
+ (format #f "effects-bhp ~A ~A ~A" high-pass-freq bg nd)))))))
+
+ (lambda (w context info)
+ (help-dialog "High-pass filter"
+ "Butterworth high-pass filter. Move the slider to change the high-pass cutoff frequency."))
+
(lambda (w c i)
- (post-high-pass-dialog)))
+ (set! high-pass-freq initial-high-pass-freq)
+ (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 high-pass-freq 22050))))
+
+ (lambda ()
+ (effect-target-ok high-pass-target))))
+
+ (set! sliders
+ (add-sliders high-pass-dialog
+ (list (list "high-pass cutoff frequency" 20 initial-high-pass-freq 22050
+ (lambda (w context info)
+ (set! high-pass-freq (scale-linear->log 20 (.value info) 22050)))
+ 1 'log))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! high-pass-target target)
+ (XtSetSensitive (XmMessageBoxGetChild high-pass-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog high-pass-dialog))
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "High-pass filter (~,2F)" high-pass-freq)))
- (change-label child new-label)))
- filter-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "High-pass filter" xmPushButtonWidgetClass filter-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-high-pass-dialog)))
+
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "High-pass filter (~,2F)" high-pass-freq)))
+ (change-label child new-label)))
+ filter-menu-list))))
+
+
;;; -------- Butterworth low-pass filter
-
- (let ((low-pass-freq 1000)
- (low-pass-label "Low-pass filter")
- (low-pass-dialog #f)
- (low-pass-target 'sound))
-
- (define (post-low-pass-dialog)
- (if (not (Widget? low-pass-dialog))
- ;; if low-pass-dialog doesn't exist, create it
- (let ((initial-low-pass-freq 1000)
- (sliders '()))
- (set! low-pass-dialog
- (make-effect-dialog
- low-pass-label
-
- (lambda (w context info)
- (let ((flt (make-butter-low-pass low-pass-freq)))
- (if (eq? low-pass-target 'sound)
- (filter-sound flt #f #f #f #f (format #f "effects-blp ~A 0 #f" low-pass-freq))
- (if (eq? low-pass-target 'selection)
- (filter-selection flt)
- (let* ((ms (plausible-mark-samples))
- (bg (car ms))
- (nd (+ 1 (- (cadr ms) (car ms)))))
- (clm-channel flt bg nd #f #f #f #f
- (format #f "effects-blp ~A ~A ~A" low-pass-freq bg nd)))))))
-
- (lambda (w context info)
- (help-dialog "Low-pass filter"
- "Butterworth low-pass filter. Move the slider to change the low-pass cutoff frequency."))
-
- (lambda (w c i)
- (set! low-pass-freq initial-low-pass-freq)
- (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 low-pass-freq 22050))))
-
- (lambda ()
- (effect-target-ok low-pass-target))))
-
- (set! sliders
- (add-sliders low-pass-dialog
- (list (list "low-pass cutoff frequency" 20 initial-low-pass-freq 22050
- (lambda (w context info)
- (set! low-pass-freq (scale-linear->log 20 (.value info) 22050)))
- 1 'log))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! low-pass-target target)
- (XtSetSensitive (XmMessageBoxGetChild low-pass-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog low-pass-dialog))
-
- (let ((child (XtCreateManagedWidget "Low-pass filter" xmPushButtonWidgetClass filter-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((low-pass-freq 1000)
+ (low-pass-label "Low-pass filter")
+ (low-pass-dialog #f)
+ (low-pass-target 'sound))
+
+ (define (post-low-pass-dialog)
+ (if (not (Widget? low-pass-dialog))
+ ;; if low-pass-dialog doesn't exist, create it
+ (let ((initial-low-pass-freq 1000)
+ (sliders ()))
+ (set! low-pass-dialog
+ (make-effect-dialog
+ low-pass-label
+
+ (lambda (w context info)
+ (let ((flt (make-butter-low-pass low-pass-freq)))
+ (if (eq? low-pass-target 'sound)
+ (filter-sound flt #f #f #f #f (format #f "effects-blp ~A 0 #f" low-pass-freq))
+ (if (eq? low-pass-target 'selection)
+ (filter-selection flt)
+ (let* ((ms (plausible-mark-samples))
+ (bg (car ms))
+ (nd (+ 1 (- (cadr ms) (car ms)))))
+ (clm-channel flt bg nd #f #f #f #f
+ (format #f "effects-blp ~A ~A ~A" low-pass-freq bg nd)))))))
+
+ (lambda (w context info)
+ (help-dialog "Low-pass filter"
+ "Butterworth low-pass filter. Move the slider to change the low-pass cutoff frequency."))
+
(lambda (w c i)
- (post-low-pass-dialog)))
+ (set! low-pass-freq initial-low-pass-freq)
+ (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 low-pass-freq 22050))))
+
+ (lambda ()
+ (effect-target-ok low-pass-target))))
+
+ (set! sliders
+ (add-sliders low-pass-dialog
+ (list (list "low-pass cutoff frequency" 20 initial-low-pass-freq 22050
+ (lambda (w context info)
+ (set! low-pass-freq (scale-linear->log 20 (.value info) 22050)))
+ 1 'log))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! low-pass-target target)
+ (XtSetSensitive (XmMessageBoxGetChild low-pass-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog low-pass-dialog))
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Low-pass filter (~,2F)" low-pass-freq)))
- (change-label child new-label)))
- filter-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Low-pass filter" xmPushButtonWidgetClass filter-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-low-pass-dialog)))
+
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Low-pass filter (~,2F)" low-pass-freq)))
+ (change-label child new-label)))
+ filter-menu-list))))
+
;;; more filters
-
+
;;; -------- Comb filter
;;;
;;; (truncate)
-
- (let ((comb-scaler 0.1)
- (comb-size 50)
- (comb-label "Comb filter")
- (comb-dialog #f)
- (comb-target 'sound))
-
- (define (post-comb-dialog)
- (if (not (Widget? comb-dialog))
- ;; if comb-dialog doesn't exist, create it
- (let ((initial-comb-scaler 0.1)
- (initial-comb-size 50)
- (sliders '()))
- (set! comb-dialog
- (make-effect-dialog
- comb-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (effects-comb-filter comb-scaler comb-size))
- comb-target
- (lambda (target samps)
- (format #f "effects-comb-filter ~A ~A" comb-scaler comb-size))
- #f))
-
- (lambda (w context info)
- (help-dialog "Comb filter"
- "Move the sliders to change the comb scaler and size."))
-
- (lambda (w c i)
- (set! comb-scaler initial-comb-scaler)
- (XtSetValues (car sliders) (list XmNvalue (floor (* comb-scaler 100))))
- (set! comb-size initial-comb-size)
- (XtSetValues (cadr sliders) (list XmNvalue (floor comb-size))))
-
- (lambda ()
- (effect-target-ok comb-target))))
-
- (set! sliders
- (add-sliders comb-dialog
- (list (list "scaler" 0.0 initial-comb-scaler 1.0
- (lambda (w context info)
- (set! comb-scaler (/ (.value info) 100.0)))
- 100)
- (list "size" 0 initial-comb-size 100
- (lambda (w context info)
- (set! comb-size (.value info)))
- 1))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! comb-target target)
- (XtSetSensitive (XmMessageBoxGetChild comb-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog comb-dialog))
-
- (let ((child (XtCreateManagedWidget "Comb filter" xmPushButtonWidgetClass filter-menu
- (list XmNbackground (basic-color)))))
-
- (XtAddCallback child XmNactivateCallback
+
+ (let ((comb-scaler 0.1)
+ (comb-size 50)
+ (comb-label "Comb filter")
+ (comb-dialog #f)
+ (comb-target 'sound))
+
+ (define (post-comb-dialog)
+ (if (not (Widget? comb-dialog))
+ ;; if comb-dialog doesn't exist, create it
+ (let ((initial-comb-scaler 0.1)
+ (initial-comb-size 50)
+ (sliders ()))
+ (set! comb-dialog
+ (make-effect-dialog
+ comb-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (effects-comb-filter comb-scaler comb-size))
+ comb-target
+ (lambda (target samps)
+ (format #f "effects-comb-filter ~A ~A" comb-scaler comb-size))
+ #f))
+
+ (lambda (w context info)
+ (help-dialog "Comb filter"
+ "Move the sliders to change the comb scaler and size."))
+
(lambda (w c i)
- (post-comb-dialog)))
+ (set! comb-scaler initial-comb-scaler)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* comb-scaler 100))))
+ (set! comb-size initial-comb-size)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor comb-size))))
+
+ (lambda ()
+ (effect-target-ok comb-target))))
+
+ (set! sliders
+ (add-sliders comb-dialog
+ (list (list "scaler" 0.0 initial-comb-scaler 1.0
+ (lambda (w context info)
+ (set! comb-scaler (/ (.value info) 100.0)))
+ 100)
+ (list "size" 0 initial-comb-size 100
+ (lambda (w context info)
+ (set! comb-size (.value info)))
+ 1))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! comb-target target)
+ (XtSetSensitive (XmMessageBoxGetChild comb-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog comb-dialog))
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Comb filter (~1,2F ~D)" comb-scaler comb-size)))
- (change-label child new-label)))
- filter-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Comb filter" xmPushButtonWidgetClass filter-menu
+ (list XmNbackground *basic-color*))))
+
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-comb-dialog)))
+
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Comb filter (~1,2F ~D)" comb-scaler comb-size)))
+ (change-label child new-label)))
+ filter-menu-list))))
+
;;; -------- Comb-chord filter
;;;
;;; (truncate)
-
- (let ((new-comb-chord-scaler 0.95)
- (new-comb-chord-size 60)
- (new-comb-chord-amp 0.3)
- (new-comb-chord-interval-one 0.75)
- (new-comb-chord-interval-two 1.20)
- (new-comb-chord-label "Comb chord filter")
- (new-comb-chord-dialog #f)
- (new-comb-chord-target 'sound))
-
- (define new-comb-chord
- (lambda (scaler size amp interval-one interval-two)
- "Comb chord filter: create chords by using filters at harmonically related sizes."
- (let ((c1 (make-comb scaler size))
- (c2 (make-comb scaler (* size interval-one)))
- (c3 (make-comb scaler (* size interval-two))))
- (lambda (x)
- (* amp (+ (comb c1 x) (comb c2 x) (comb c3 x)))))))
-
- (define (post-new-comb-chord-dialog)
- (if (not (Widget? new-comb-chord-dialog))
- ;; if new-comb-chord-dialog doesn't exist, create it
- (let ((initial-new-comb-chord-scaler 0.95)
- (initial-new-comb-chord-size 60)
- (initial-new-comb-chord-amp 0.3)
- (initial-new-comb-chord-interval-one 0.75)
- (initial-new-comb-chord-interval-two 1.20)
- (sliders '()))
- (set! new-comb-chord-dialog
- (make-effect-dialog
- new-comb-chord-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (new-comb-chord new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
- new-comb-chord-interval-one new-comb-chord-interval-two))
- new-comb-chord-target
- (lambda (target samps)
- (format #f "effects-comb-chord ~A ~A ~A ~A ~A"
- new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
- new-comb-chord-interval-one new-comb-chord-interval-two))
- #f))
-
- (lambda (w context info)
- (help-dialog "Comb chord filter"
- "Creates chords by using filters at harmonically related sizes. Move the sliders to set the comb chord parameters."))
-
- (lambda (w c i)
- (set! new-comb-chord-scaler initial-new-comb-chord-scaler)
- (XtSetValues (list-ref sliders 0) (list XmNvalue (floor (* new-comb-chord-scaler 100))))
- (set! new-comb-chord-size initial-new-comb-chord-size)
- (XtSetValues (list-ref sliders 1) (list XmNvalue new-comb-chord-size))
- (set! new-comb-chord-amp initial-new-comb-chord-amp)
- (XtSetValues (list-ref sliders 2) (list XmNvalue (floor (* new-comb-chord-amp 100))))
- (set! new-comb-chord-interval-one initial-new-comb-chord-interval-one)
- (XtSetValues (list-ref sliders 3) (list XmNvalue (floor (* new-comb-chord-interval-one 100))))
- (set! new-comb-chord-interval-two initial-new-comb-chord-interval-two)
- (XtSetValues (list-ref sliders 4) (list XmNvalue (floor (* new-comb-chord-interval-two 100)))))
-
- (lambda ()
- (effect-target-ok new-comb-chord-target))))
-
- (set! sliders
- (add-sliders new-comb-chord-dialog
- (list (list "chord scaler" 0.0 initial-new-comb-chord-scaler 1.0
- (lambda (w context info)
- (set! new-comb-chord-scaler (/ (.value info) 100.0)))
- 100)
- (list "chord size" 0 initial-new-comb-chord-size 100
- (lambda (w context info)
- (set! new-comb-chord-size (.value info)))
- 1)
- (list "amplitude" 0.0 initial-new-comb-chord-amp 1.0
- (lambda (w context info)
- (set! new-comb-chord-amp (/ (.value info) 100.0)))
- 100)
- (list "interval one" 0.0 initial-new-comb-chord-interval-one 2.0
- (lambda (w context info)
- (set! new-comb-chord-interval-one (/ (.value info) 100.0)))
- 100)
- (list "interval two" 0.0 initial-new-comb-chord-interval-two 2.0
- (lambda (w context info)
- (set! new-comb-chord-interval-two (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! new-comb-chord-target target)
- (XtSetSensitive (XmMessageBoxGetChild new-comb-chord-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog new-comb-chord-dialog))
-
- (let ((child (XtCreateManagedWidget "Comb chord filter" xmPushButtonWidgetClass filter-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((new-comb-chord-scaler 0.95)
+ (new-comb-chord-size 60)
+ (new-comb-chord-amp 0.3)
+ (new-comb-chord-interval-one 0.75)
+ (new-comb-chord-interval-two 1.20)
+ (new-comb-chord-label "Comb chord filter")
+ (new-comb-chord-dialog #f)
+ (new-comb-chord-target 'sound))
+
+ (define new-comb-chord
+ (lambda (scaler size amp interval-one interval-two)
+ ;; Comb chord filter: create chords by using filters at harmonically related sizes.
+ (let ((cs (make-comb-bank (vector (make-comb scaler size)
+ (make-comb scaler (* size interval-one))
+ (make-comb scaler (* size interval-two))))))
+ (lambda (x)
+ (* amp (comb-bank cs x))))))
+
+ (define (post-new-comb-chord-dialog)
+ (if (not (Widget? new-comb-chord-dialog))
+ ;; if new-comb-chord-dialog doesn't exist, create it
+ (let ((initial-new-comb-chord-scaler 0.95)
+ (initial-new-comb-chord-size 60)
+ (initial-new-comb-chord-amp 0.3)
+ (initial-new-comb-chord-interval-one 0.75)
+ (initial-new-comb-chord-interval-two 1.20)
+ (sliders ()))
+ (set! new-comb-chord-dialog
+ (make-effect-dialog
+ new-comb-chord-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (new-comb-chord new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
+ new-comb-chord-interval-one new-comb-chord-interval-two))
+ new-comb-chord-target
+ (lambda (target samps)
+ (format #f "effects-comb-chord ~A ~A ~A ~A ~A"
+ new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
+ new-comb-chord-interval-one new-comb-chord-interval-two))
+ #f))
+
+ (lambda (w context info)
+ (help-dialog "Comb chord filter"
+ "Creates chords by using filters at harmonically related sizes. Move the sliders to set the comb chord parameters."))
+
(lambda (w c i)
- (post-new-comb-chord-dialog)))
+ (set! new-comb-chord-scaler initial-new-comb-chord-scaler)
+ (XtSetValues (sliders 0) (list XmNvalue (floor (* new-comb-chord-scaler 100))))
+ (set! new-comb-chord-size initial-new-comb-chord-size)
+ (XtSetValues (sliders 1) (list XmNvalue new-comb-chord-size))
+ (set! new-comb-chord-amp initial-new-comb-chord-amp)
+ (XtSetValues (sliders 2) (list XmNvalue (floor (* new-comb-chord-amp 100))))
+ (set! new-comb-chord-interval-one initial-new-comb-chord-interval-one)
+ (XtSetValues (sliders 3) (list XmNvalue (floor (* new-comb-chord-interval-one 100))))
+ (set! new-comb-chord-interval-two initial-new-comb-chord-interval-two)
+ (XtSetValues (sliders 4) (list XmNvalue (floor (* new-comb-chord-interval-two 100)))))
+
+ (lambda ()
+ (effect-target-ok new-comb-chord-target))))
+
+ (set! sliders
+ (add-sliders new-comb-chord-dialog
+ (list (list "chord scaler" 0.0 initial-new-comb-chord-scaler 1.0
+ (lambda (w context info)
+ (set! new-comb-chord-scaler (/ (.value info) 100.0)))
+ 100)
+ (list "chord size" 0 initial-new-comb-chord-size 100
+ (lambda (w context info)
+ (set! new-comb-chord-size (.value info)))
+ 1)
+ (list "amplitude" 0.0 initial-new-comb-chord-amp 1.0
+ (lambda (w context info)
+ (set! new-comb-chord-amp (/ (.value info) 100.0)))
+ 100)
+ (list "interval one" 0.0 initial-new-comb-chord-interval-one 2.0
+ (lambda (w context info)
+ (set! new-comb-chord-interval-one (/ (.value info) 100.0)))
+ 100)
+ (list "interval two" 0.0 initial-new-comb-chord-interval-two 2.0
+ (lambda (w context info)
+ (set! new-comb-chord-interval-two (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! new-comb-chord-target target)
+ (XtSetSensitive (XmMessageBoxGetChild new-comb-chord-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog new-comb-chord-dialog))
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Comb chord filter (~1,2F ~D ~1,2F ~1,2F ~1,2F)"
- new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
- new-comb-chord-interval-one new-comb-chord-interval-two)))
- (change-label child new-label)))
- filter-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Comb chord filter" xmPushButtonWidgetClass filter-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-new-comb-chord-dialog)))
+
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Comb chord filter (~1,2F ~D ~1,2F ~1,2F ~1,2F)"
+ new-comb-chord-scaler new-comb-chord-size new-comb-chord-amp
+ new-comb-chord-interval-one new-comb-chord-interval-two)))
+ (change-label child new-label)))
+ filter-menu-list))))
+
;;; -------- Moog filter
;;;
-
- (let ((moog-cutoff-frequency 10000)
- (moog-resonance 0.5)
- (moog-label "Moog filter")
- (moog-dialog #f)
- (moog-target 'sound))
-
- (define (moog freq Q)
- (let ((gen (make-moog-filter freq Q)))
- (lambda (inval)
- (moog-filter gen inval))))
-
- (define (post-moog-dialog)
- (if (not (Widget? moog-dialog))
- ;; if moog-dialog doesn't exist, create it
- (let ((initial-moog-cutoff-frequency 10000)
- (initial-moog-resonance 0.5)
- (sliders '()))
- (set! moog-dialog
- (make-effect-dialog
- moog-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (ignored) (moog moog-cutoff-frequency moog-resonance))
- moog-target
- (lambda (target samps)
- (format #f "effects-moog-filter ~A ~A" moog-cutoff-frequency moog-resonance))
- #f))
-
- (lambda (w context info)
- (help-dialog "Moog filter"
- "Moog-style 4-pole lowpass filter with 24db/oct rolloff and variable resonance.
+
+ (let ((moog-cutoff-frequency 10000)
+ (moog-resonance 0.5)
+ (moog-label "Moog filter")
+ (moog-dialog #f)
+ (moog-target 'sound))
+
+ (define (moog freq Q)
+ (let ((gen (make-moog-filter freq Q)))
+ (lambda (inval)
+ (moog-filter gen inval))))
+
+ (define (post-moog-dialog)
+ (if (not (Widget? moog-dialog))
+ ;; if moog-dialog doesn't exist, create it
+ (let ((initial-moog-cutoff-frequency 10000)
+ (initial-moog-resonance 0.5)
+ (sliders ()))
+ (set! moog-dialog
+ (make-effect-dialog
+ moog-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (ignored) (moog moog-cutoff-frequency moog-resonance))
+ moog-target
+ (lambda (target samps)
+ (format #f "effects-moog-filter ~A ~A" moog-cutoff-frequency moog-resonance))
+ #f))
+
+ (lambda (w context info)
+ (help-dialog "Moog filter"
+ "Moog-style 4-pole lowpass filter with 24db/oct rolloff and variable resonance.
Move the sliders to set the filter cutoff frequency and resonance."))
-
- (lambda (w c i)
- (set! moog-cutoff-frequency initial-moog-cutoff-frequency)
- (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 moog-cutoff-frequency 22050)))
- (set! moog-resonance initial-moog-resonance)
- (XtSetValues (cadr sliders) (list XmNvalue (floor (* moog-resonance 100)))))
-
- (lambda ()
- (effect-target-ok moog-target))))
-
- (set! sliders
- (add-sliders moog-dialog
- (list (list "cutoff frequency" 20 initial-moog-cutoff-frequency 22050
- (lambda (w context info)
- (set! moog-cutoff-frequency (scale-linear->log 20 (.value info) 22050)))
- 1 'log)
- (list "resonance" 0.0 initial-moog-resonance 1.0
- (lambda (w context info)
- (set! moog-resonance (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! moog-target target)
- (XtSetSensitive (XmMessageBoxGetChild moog-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog moog-dialog))
-
- (let ((child (XtCreateManagedWidget "Moog filter" xmPushButtonWidgetClass filter-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
(lambda (w c i)
- (post-moog-dialog)))
+ (set! moog-cutoff-frequency initial-moog-cutoff-frequency)
+ (XtSetValues (car sliders) (list XmNvalue (scale-log->linear 20 moog-cutoff-frequency 22050)))
+ (set! moog-resonance initial-moog-resonance)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor (* moog-resonance 100)))))
+
+ (lambda ()
+ (effect-target-ok moog-target))))
+
+ (set! sliders
+ (add-sliders moog-dialog
+ (list (list "cutoff frequency" 20 initial-moog-cutoff-frequency 22050
+ (lambda (w context info)
+ (set! moog-cutoff-frequency (scale-linear->log 20 (.value info) 22050)))
+ 1 'log)
+ (list "resonance" 0.0 initial-moog-resonance 1.0
+ (lambda (w context info)
+ (set! moog-resonance (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! moog-target target)
+ (XtSetSensitive (XmMessageBoxGetChild moog-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog moog-dialog))
- (set! filter-menu-list (cons (lambda ()
- (let ((new-label (format #f "Moog filter (~,2F ~1,2F)" moog-cutoff-frequency moog-resonance)))
- (change-label child new-label)))
- filter-menu-list))))
- )
-
+ (let ((child (XtCreateManagedWidget "Moog filter" xmPushButtonWidgetClass filter-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-moog-dialog)))
+
+ (set! filter-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Moog filter (~,2F ~1,2F)" moog-cutoff-frequency moog-resonance)))
+ (change-label child new-label)))
+ filter-menu-list))))
+ )
+
;;; FREQUENCY EFFECTS
;;;
-
-
-(let* ((freq-menu-list '())
- (freq-menu (XmCreatePulldownMenu (main-menu effects-menu) "Frequency Effects"
- (list XmNbackground (basic-color))))
- (freq-cascade (XtCreateManagedWidget "Frequency Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
- (list XmNsubMenuId freq-menu
- XmNbackground (basic-color)))))
- (XtAddCallback freq-cascade XmNcascadingCallback (lambda (w c i) (update-label freq-menu-list)))
-
-;;; -------- Adaptive saturation
-;;;
-
- (let ((adsat-size 4)
- (adsat-label "Adaptive saturation")
- (adsat-dialog #f)
- (adsat-target 'sound))
-
- (define (cp-adsat)
- "adsat does weird stuff by adsat size"
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (let ((mn 0.0)
- (mx 0.0)
- (n 0)
- (vals (make-vct adsat-size)))
- (lambda (val)
- (if (= n adsat-size)
- (begin
- (do ((i 0 (+ 1 i)))
- ((= i adsat-size))
- (if (>= (vct-ref vals i) 0.0)
- (vct-set! vals i mx)
- (vct-set! vals i mn)))
- (set! n 0)
- (set! mx 0.0)
- (set! mn 0.0)
- vals)
- (begin
- (vct-set! vals n val)
- (if (> val mx) (set! mx val))
- (if (< val mn) (set! mn val))
- (set! n (+ 1 n))
- #f)))))
- adsat-target
- (lambda (target samps)
- (format #f "adsat ~A" adsat-size))
- #f))
-
- (define (post-adsat-dialog)
- (if (not (Widget? adsat-dialog))
- ;; if adsat-dialog doesn't exist, create it
- (let ((initial-adsat-size 4)
- (sliders '()))
- (set! adsat-dialog
- (make-effect-dialog
- adsat-label
-
- (lambda (w context info) (cp-adsat))
-
- (lambda (w context info)
- (help-dialog "Adaptive saturation"
- "Move the slider to change the saturation scaling factor."))
-
- (lambda (w c i)
- (set! adsat-size initial-adsat-size)
- (XtSetValues (car sliders) (list XmNvalue adsat-size)))
-
- (lambda ()
- (effect-target-ok adsat-target))))
-
- (set! sliders
- (add-sliders adsat-dialog
- (list (list "adaptive saturation size" 0 initial-adsat-size 10
- (lambda (w context info)
- (set! adsat-size (.value info)))
- 1))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! adsat-target target)
- (XtSetSensitive (XmMessageBoxGetChild adsat-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog adsat-dialog))
-
- (let ((child (XtCreateManagedWidget "Adaptive saturation" xmPushButtonWidgetClass freq-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
- (lambda (w c i)
- (post-adsat-dialog)))
-
- (set! freq-menu-list (cons (lambda ()
- (let ((new-label (format #f "Adaptive saturation (~D)" adsat-size)))
- (change-label child new-label)))
- freq-menu-list))))
+ (let* ((freq-menu-list ())
+ (freq-menu (XmCreatePulldownMenu (main-menu effects-menu) "Frequency Effects"
+ (list XmNbackground *basic-color*)))
+ (freq-cascade (XtCreateManagedWidget "Frequency Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
+ (list XmNsubMenuId freq-menu
+ XmNbackground *basic-color*))))
+
+ (XtAddCallback freq-cascade XmNcascadingCallback (lambda (w c i) (update-label freq-menu-list)))
+
;;; -------- Sample rate conversion (resample)
;;;
-
- (let ((src-amount 0.0)
- (src-label "Sample rate conversion")
- (src-dialog #f)
- (src-menu-widget #f)
- (src-target 'sound))
-
- (define (post-src-dialog)
- (if (not (Widget? src-dialog))
- ;; if src-dialog doesn't exist, create it
- (let ((initial-src-amount 0.0)
- (sliders '()))
- (set! src-dialog
- (make-effect-dialog
- src-label
-
- (lambda (w context info)
- (if (eq? src-target 'sound)
- (src-sound src-amount)
- (if (eq? src-target 'selection)
- (if (selection?)
- (src-selection src-amount)
- (snd-print ";no selection"))
- (snd-print "can't apply src between marks yet"))))
-
- (lambda (w context info)
- (help-dialog "Sample rate conversion"
- "Move the slider to change the sample rate.
+
+ (let ((src-amount 0.0)
+ (src-label "Sample rate conversion")
+ (src-dialog #f)
+ (src-target 'sound))
+
+ (define (post-src-dialog)
+ (if (not (Widget? src-dialog))
+ ;; if src-dialog doesn't exist, create it
+ (let ((initial-src-amount 0.0)
+ (sliders ()))
+ (set! src-dialog
+ (make-effect-dialog
+ src-label
+
+ (lambda (w context info)
+ (if (eq? src-target 'sound)
+ (src-sound src-amount)
+ (if (eq? src-target 'selection)
+ (if (selection?)
+ (src-selection src-amount)
+ (snd-print ";no selection"))
+ (snd-print "can't apply src between marks yet"))))
+
+ (lambda (w context info)
+ (help-dialog "Sample rate conversion"
+ "Move the slider to change the sample rate.
Values greater than 1.0 speed up file play, negative values reverse it."))
-
- (lambda (w c i)
- (set! src-amount initial-src-amount)
- (XtSetValues (car sliders) (list XmNvalue (floor (* src-amount 100)))))
-
- (lambda ()
- (effect-target-ok src-target))))
-
- (set! sliders
- (add-sliders src-dialog
- (list (list "sample rate" -2.0 initial-src-amount 2.0
- (lambda (w context info)
- (set! src-amount (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! src-target target)
- (XtSetSensitive (XmMessageBoxGetChild src-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
- (activate-dialog src-dialog))
-
- (let ((child (XtCreateManagedWidget "Sample rate scaling" xmPushButtonWidgetClass freq-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
(lambda (w c i)
- (post-src-dialog)))
+ (set! src-amount initial-src-amount)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* src-amount 100)))))
+
+ (lambda ()
+ (effect-target-ok src-target))))
+
+ (set! sliders
+ (add-sliders src-dialog
+ (list (list "sample rate" -2.0 initial-src-amount 2.0
+ (lambda (w context info)
+ (set! src-amount (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! src-target target)
+ (XtSetSensitive (XmMessageBoxGetChild src-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+ (activate-dialog src-dialog))
- (set! freq-menu-list (cons (lambda ()
- (let ((new-label (format #f "Sample rate scaling (~1,2F)" src-amount)))
- (change-label child new-label)))
- freq-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "Sample rate scaling" xmPushButtonWidgetClass freq-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-src-dialog)))
+
+ (set! freq-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Sample rate scaling (~1,2F)" src-amount)))
+ (change-label child new-label)))
+ freq-menu-list))))
+
+
;;; -------- Time and pitch scaling by granular synthesis and sampling rate conversion
;;;
-
- (let ((time-scale 1.0)
- (hop-size 0.05)
- (segment-length 0.15)
- (ramp-scale 0.5)
- (pitch-scale 1.0)
- (expsrc-label "Time/pitch scaling")
- (expsrc-dialog #f)
- (expsrc-target 'sound))
-
- (define (post-expsrc-dialog)
- (if (not (Widget? expsrc-dialog))
- (let ((initial-time-scale 1.0)
- (initial-hop-size 0.05)
- (initial-segment-length 0.15)
- (initial-ramp-scale 0.5)
- (initial-pitch-scale 1.0)
- (sliders '()))
- (set! expsrc-dialog
- (make-effect-dialog
- expsrc-label
-
- (lambda (w context info)
- (let ((snd (selected-sound)))
- (save-controls snd)
- (reset-controls snd)
- (set! (speed-control snd) pitch-scale)
- (let ((new-time (* pitch-scale time-scale)))
- (if (not (= new-time 1.0))
- (begin
- (set! (expand-control? snd) #t)
- (set! (expand-control snd) new-time)
- (set! (expand-control-hop snd) hop-size)
- (set! (expand-control-length snd) segment-length)
- (set! (expand-control-ramp snd) ramp-scale))))
- (if (eq? expsrc-target 'marks)
- (let ((ms (plausible-mark-samples)))
- (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
- (apply-controls snd (if (eq? expsrc-target 'sound) 0 2)))
- (restore-controls snd)))
-
- (lambda (w context info)
- (help-dialog "Time/pitch scaling"
- "Move the sliders to change the time/pitch scaling parameters."))
-
- (lambda (w c i)
- (set! time-scale initial-time-scale)
- (XtSetValues (list-ref sliders 0) (list XmNvalue (floor (* time-scale 100))))
- (set! hop-size initial-hop-size)
- (XtSetValues (list-ref sliders 1) (list XmNvalue (floor (* hop-size 100))))
- (set! segment-length initial-segment-length)
- (XtSetValues (list-ref sliders 2) (list XmNvalue (floor (* segment-length 100))))
- (set! ramp-scale initial-ramp-scale)
- (XtSetValues (list-ref sliders 3) (list XmNvalue (floor (* ramp-scale 100))))
- (set! pitch-scale initial-pitch-scale)
- (XtSetValues (list-ref sliders 4) (list XmNvalue (floor (* pitch-scale 100)))))
-
- (lambda ()
- (effect-target-ok expsrc-target))))
-
- (set! sliders
- (add-sliders expsrc-dialog
- (list (list "time scale" 0.0 initial-time-scale 5.0
- (lambda (w context info)
- (set! time-scale (/ (.value info) 100.0)))
- 100)
- (list "hop size" 0.0 initial-hop-size 1.0
- (lambda (w context info)
- (set! hop-size (/ (.value info) 100.0)))
- 100)
- (list "segment length" 0.0 initial-segment-length 0.5
- (lambda (w context info)
- (set! segment-length (/ (.value info) 100.0)))
- 100)
- (list "ramp scale" 0.0 initial-ramp-scale 0.5
- (lambda (w context info)
- (set! ramp-scale (/ (.value info) 100.0)))
- 1000)
- (list "pitch scale" 0.0 initial-pitch-scale 5.0
- (lambda (w context info)
- (set! pitch-scale (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! expsrc-target target)
- (XtSetSensitive (XmMessageBoxGetChild expsrc-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog expsrc-dialog))
-
- (let ((child (XtCreateManagedWidget "Time/pitch scaling" xmPushButtonWidgetClass freq-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((time-scale 1.0)
+ (hop-size 0.05)
+ (segment-length 0.15)
+ (ramp-scale 0.5)
+ (pitch-scale 1.0)
+ (expsrc-label "Time/pitch scaling")
+ (expsrc-dialog #f)
+ (expsrc-target 'sound))
+
+ (define (post-expsrc-dialog)
+ (if (not (Widget? expsrc-dialog))
+ (let ((initial-time-scale 1.0)
+ (initial-hop-size 0.05)
+ (initial-segment-length 0.15)
+ (initial-ramp-scale 0.5)
+ (initial-pitch-scale 1.0)
+ (sliders ()))
+ (set! expsrc-dialog
+ (make-effect-dialog
+ expsrc-label
+
+ (lambda (w context info)
+ (let ((snd (selected-sound)))
+ (save-controls snd)
+ (reset-controls snd)
+ (set! (speed-control snd) pitch-scale)
+ (let ((new-time (* pitch-scale time-scale)))
+ (if (not (= new-time 1.0))
+ (begin
+ (set! (expand-control? snd) #t)
+ (set! (expand-control snd) new-time)
+ (set! (expand-control-hop snd) hop-size)
+ (set! (expand-control-length snd) segment-length)
+ (set! (expand-control-ramp snd) ramp-scale))))
+ (if (eq? expsrc-target 'marks)
+ (let ((ms (plausible-mark-samples)))
+ (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
+ (apply-controls snd (if (eq? expsrc-target 'sound) 0 2)))
+ (restore-controls snd)))
+
+ (lambda (w context info)
+ (help-dialog "Time/pitch scaling"
+ "Move the sliders to change the time/pitch scaling parameters."))
+
(lambda (w c i)
- (post-expsrc-dialog)))
+ (set! time-scale initial-time-scale)
+ (XtSetValues (sliders 0) (list XmNvalue (floor (* time-scale 100))))
+ (set! hop-size initial-hop-size)
+ (XtSetValues (sliders 1) (list XmNvalue (floor (* hop-size 100))))
+ (set! segment-length initial-segment-length)
+ (XtSetValues (sliders 2) (list XmNvalue (floor (* segment-length 100))))
+ (set! ramp-scale initial-ramp-scale)
+ (XtSetValues (sliders 3) (list XmNvalue (floor (* ramp-scale 100))))
+ (set! pitch-scale initial-pitch-scale)
+ (XtSetValues (sliders 4) (list XmNvalue (floor (* pitch-scale 100)))))
+
+ (lambda ()
+ (effect-target-ok expsrc-target))))
+
+ (set! sliders
+ (add-sliders expsrc-dialog
+ (list (list "time scale" 0.0 initial-time-scale 5.0
+ (lambda (w context info)
+ (set! time-scale (/ (.value info) 100.0)))
+ 100)
+ (list "hop size" 0.0 initial-hop-size 1.0
+ (lambda (w context info)
+ (set! hop-size (/ (.value info) 100.0)))
+ 100)
+ (list "segment length" 0.0 initial-segment-length 0.5
+ (lambda (w context info)
+ (set! segment-length (/ (.value info) 100.0)))
+ 100)
+ (list "ramp scale" 0.0 initial-ramp-scale 0.5
+ (lambda (w context info)
+ (set! ramp-scale (/ (.value info) 100.0)))
+ 1000)
+ (list "pitch scale" 0.0 initial-pitch-scale 5.0
+ (lambda (w context info)
+ (set! pitch-scale (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! expsrc-target target)
+ (XtSetSensitive (XmMessageBoxGetChild expsrc-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog expsrc-dialog))
- (set! freq-menu-list (cons (lambda ()
- (let ((new-label (format #f "Time/pitch scaling (~1,2F ~1,2F)" time-scale pitch-scale)))
- (change-label child new-label)))
- freq-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "Time/pitch scaling" xmPushButtonWidgetClass freq-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-expsrc-dialog)))
+
+ (set! freq-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Time/pitch scaling (~1,2F ~1,2F)" time-scale pitch-scale)))
+ (change-label child new-label)))
+ freq-menu-list))))
+
+
;;; -------- Time-varying sample rate conversion (resample)
;;; (KSM)
-
- (let ((src-timevar-scale 1.0)
- (src-timevar-label "Src-Timevar")
- (src-timevar-dialog #f)
- (src-timevar-target 'sound)
- (src-timevar-envelope #f))
-
- (define (scale-envelope e scl)
- (if (null? e)
- '()
- (append (list (car e) (* scl (cadr e)))
- (scale-envelope (cddr e) scl))))
-
- (define (post-src-timevar-dialog)
- (if (not (Widget? src-timevar-dialog))
- ;; if src-timevar-dialog doesn't exist, create it
- (let ((initial-src-timevar-scale 1.0)
- (sliders '())
- (fr #f))
- (set! src-timevar-dialog
- (make-effect-dialog
- src-timevar-label
-
- (lambda (w context info)
- (let ((env (scale-envelope (xe-envelope src-timevar-envelope)
- src-timevar-scale)))
- (if (eq? src-timevar-target 'sound)
- (src-sound env)
- (if (eq? src-timevar-target 'selection)
- (if (selection-member? (selected-sound))
- (src-selection env)
- (display ";no selection"))
- (let ((pts (plausible-mark-samples)))
- (if pts
- (let* ((beg (car pts))
- (end (cadr pts))
- (len (- end beg)))
- (src-channel (make-env env :length len) beg len (selected-sound)))))))))
-
- (lambda (w context info)
- (help-dialog "Src-Timevar"
- "Move the slider to change the src-timevar scaling amount."))
-
- (lambda (w c i)
- (set! src-timevar-scale initial-src-timevar-scale)
- (set! (xe-envelope src-timevar-envelope) (list 0.0 1.0 1.0 1.0))
- (XtSetValues (car sliders) (list XmNvalue (* src-timevar-scale 100))))
-
- (lambda ()
- (effect-target-ok src-timevar-target))))
-
- (set! sliders
- (add-sliders src-timevar-dialog
- (list (list "Resample factor" 0.0 initial-src-timevar-scale 10.0
- (lambda (w context info)
- (set! src-timevar-scale (/ (.value info) 100.0)))
- 100))))
- (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
- (list XmNheight 200
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget (list-ref sliders (- (length sliders) 1))
- XmNshadowThickness 4
- XmNshadowType XmSHADOW_ETCHED_OUT)))
-
- (let ((target-row (add-target (XtParent (XtParent (car sliders)))
- (lambda (target)
- (set! src-timevar-target target)
- (XtSetSensitive (XmMessageBoxGetChild src-timevar-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
- (activate-dialog src-timevar-dialog)
-
- (set! src-timevar-envelope (xe-create-enved "src-timevar" fr
- (list XmNheight 200)
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope src-timevar-envelope) (list 0.0 1.0 1.0 1.0))
- (XtVaSetValues fr (list XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget target-row)))
-
- )
- (activate-dialog src-timevar-dialog)))
-
- (let ((child (XtCreateManagedWidget "Time-varying sample rate scaling" xmPushButtonWidgetClass freq-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+ (let ((src-timevar-scale 1.0)
+ (src-timevar-label "Src-Timevar")
+ (src-timevar-dialog #f)
+ (src-timevar-target 'sound)
+ (src-timevar-envelope #f))
+
+ (define (scale-envelope e scl)
+ (if (null? e)
+ ()
+ (append (list (car e) (* scl (cadr e)))
+ (scale-envelope (cddr e) scl))))
+
+ (define (post-src-timevar-dialog)
+ (if (not (Widget? src-timevar-dialog))
+ ;; if src-timevar-dialog doesn't exist, create it
+ (let ((initial-src-timevar-scale 1.0)
+ (sliders ())
+ (fr #f))
+ (set! src-timevar-dialog
+ (make-effect-dialog
+ src-timevar-label
+
+ (lambda (w context info)
+ (let ((env (scale-envelope (xe-envelope src-timevar-envelope)
+ src-timevar-scale)))
+ (if (eq? src-timevar-target 'sound)
+ (src-sound env)
+ (if (eq? src-timevar-target 'selection)
+ (if (selection-member? (selected-sound))
+ (src-selection env)
+ (display ";no selection"))
+ (let ((pts (plausible-mark-samples)))
+ (if pts
+ (let* ((beg (car pts))
+ (end (cadr pts))
+ (len (- end beg)))
+ (src-channel (make-env env :length len) beg len (selected-sound)))))))))
+
+ (lambda (w context info)
+ (help-dialog "Src-Timevar"
+ "Move the slider to change the src-timevar scaling amount."))
+
(lambda (w c i)
- (post-src-timevar-dialog)))
+ (set! src-timevar-scale initial-src-timevar-scale)
+ (set! (xe-envelope src-timevar-envelope) (list 0.0 1.0 1.0 1.0))
+ (XtSetValues (car sliders) (list XmNvalue (* src-timevar-scale 100))))
+
+ (lambda ()
+ (effect-target-ok src-timevar-target))))
+
+ (set! sliders
+ (add-sliders src-timevar-dialog
+ (list (list "Resample factor" 0.0 initial-src-timevar-scale 10.0
+ (lambda (w context info)
+ (set! src-timevar-scale (/ (.value info) 100.0)))
+ 100))))
+ (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
+ (list XmNheight 200
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget (sliders (- (length sliders) 1))
+ XmNshadowThickness 4
+ XmNshadowType XmSHADOW_ETCHED_OUT)))
+
+ (let ((target-row (add-target (XtParent (XtParent (car sliders)))
+ (lambda (target)
+ (set! src-timevar-target target)
+ (XtSetSensitive (XmMessageBoxGetChild src-timevar-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+ (activate-dialog src-timevar-dialog)
+
+ (set! src-timevar-envelope (xe-create-enved "src-timevar" fr
+ (list XmNheight 200)
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope src-timevar-envelope) (list 0.0 1.0 1.0 1.0))
+ (XtVaSetValues fr (list XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget target-row)))
+
+ )
+ (activate-dialog src-timevar-dialog)))
+
- (set! freq-menu-list (cons (lambda ()
- (let ((new-label "Time-varying sample rate scaling"))
- (change-label child new-label)))
- freq-menu-list))))
+ (let ((child (XtCreateManagedWidget "Time-varying sample rate scaling" xmPushButtonWidgetClass freq-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-src-timevar-dialog)))
+
+ (set! freq-menu-list (cons (lambda ()
+ (let ((new-label "Time-varying sample rate scaling"))
+ (change-label child new-label)))
+ freq-menu-list))))
+
+ ;--------------------------------------------------------------------------------
+ )
-;--------------------------------------------------------------------------------
- )
-
;;; MODULATION EFFECTS
;;;
-
-(define* (effects-am freq en beg dur snd chn)
- "(effects-am freq en beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let* ((os (make-oscil freq))
- (e (and en (make-env en :length dur))))
- (map-channel (if e
- (lambda (inval)
- (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
- (lambda (inval)
- (amplitude-modulate 1.0 inval (oscil os))))
- beg dur snd chn #f
- (format #f "effects-am ~A ~A ~A ~A" freq (if en (format #f "'~A" en) #f) beg dur))))
-
-(define* (effects-rm freq gliss-env beg dur snd chn)
- "(effects-rm freq gliss-env beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let* ((os (make-oscil freq))
- (e (and gliss-env (make-env gliss-env :length dur))))
- (map-channel (if e
- (lambda (inval)
- (* inval (* (env e) (oscil os))))
- (lambda (inval)
- (* inval (oscil os))))
- beg dur snd chn #f
- (format #f "effects-rm ~A ~A ~A ~A" freq (if gliss-env (format #f "'~A" gliss-env) #f) beg dur))))
-
-
-(let* ((mod-menu-list '())
- (mod-menu (XmCreatePulldownMenu (main-menu effects-menu) "Modulation Effects"
- (list XmNbackground (basic-color))))
- (mod-cascade (XtCreateManagedWidget "Modulation Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
- (list XmNsubMenuId mod-menu
- XmNbackground (basic-color)))))
-
- (XtAddCallback mod-cascade XmNcascadingCallback (lambda (w c i) (update-label mod-menu-list)))
+ (define effects-am
+ (let ((documentation "(effects-am freq en beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (freq en beg dur snd chn)
+ (let ((os (make-oscil freq))
+ (e (and en (make-env en :length dur))))
+ (map-channel (if e
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (oscil os))))
+ beg dur snd chn #f
+ (format #f "effects-am ~A ~A ~A ~A" freq (and en (format #f "'~A" en)) beg dur))))))
+
+ (define effects-rm
+ (let ((documentation "(effects-rm freq gliss-env beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (freq gliss-env beg dur snd chn)
+ (let ((os (make-oscil freq))
+ (e (and gliss-env (make-env gliss-env :length dur))))
+ (map-channel (if e
+ (lambda (inval)
+ (* inval (env e) (oscil os)))
+ (lambda (inval)
+ (* inval (oscil os))))
+ beg dur snd chn #f
+ (format #f "effects-rm ~A ~A ~A ~A" freq (and gliss-env (format #f "'~A" gliss-env)) beg dur))))))
+
+ (let* ((mod-menu-list ())
+ (mod-menu (XmCreatePulldownMenu (main-menu effects-menu) "Modulation Effects"
+ (list XmNbackground *basic-color*)))
+ (mod-cascade (XtCreateManagedWidget "Modulation Effects" xmCascadeButtonWidgetClass (main-menu effects-menu)
+ (list XmNsubMenuId mod-menu
+ XmNbackground *basic-color*))))
+
+ (XtAddCallback mod-cascade XmNcascadingCallback (lambda (w c i) (update-label mod-menu-list)))
+
;;; -------- Amplitude modulation
;;;
-
- (let ((am-effect-amount 100.0)
- (am-effect-label "Amplitude modulation")
- (am-effect-dialog #f)
- (am-effect-target 'sound)
- (am-effect-envelope #f))
-
- (define am-effect
- (lambda (freq)
- (let* ((os (make-oscil freq))
- (need-env (not (equal? (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))))
- (e (and need-env (make-env (xe-envelope am-effect-envelope) :length (effect-frames am-effect-target)))))
- (if need-env
- (lambda (inval)
- (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
- (lambda (inval)
- (amplitude-modulate 1.0 inval (oscil os)))))))
-
- (define (post-am-effect-dialog)
- (if (not (Widget? am-effect-dialog))
- ;; if am-effect-dialog doesn't exist, create it
- (let ((initial-am-effect-amount 100.0)
- (sliders '())
- (fr #f))
- (set! am-effect-dialog
- (make-effect-dialog
- am-effect-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (am-effect am-effect-amount))
- am-effect-target
- (lambda (target samps)
- (format #f "effects-am ~A ~A" am-effect-amount
- (let* ((need-env (not (equal? (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))))
- (e (and need-env (xe-envelope am-effect-envelope))))
- (if e (format #f "'~A" e)
- #f))))
- #f))
-
- (lambda (w context info)
- (help-dialog "Amplitude modulation"
- "Move the slider to change the modulation amount."))
-
- (lambda (w c i)
- (set! am-effect-amount initial-am-effect-amount)
- (set! (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))
- (XtSetValues (car sliders) (list XmNvalue (floor am-effect-amount))))
-
- (lambda ()
- (effect-target-ok am-effect-target))))
-
- (set! sliders
- (add-sliders am-effect-dialog
- (list (list "amplitude modulation" 0.0 initial-am-effect-amount 1000.0
- (lambda (w context info)
- (set! am-effect-amount (.value info)))
- 1))))
- (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
- (list XmNheight 200
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget (list-ref sliders (- (length sliders) 1))
- XmNshadowThickness 4
- XmNshadowType XmSHADOW_ETCHED_OUT)))
- (let ((target-row (add-target (XtParent (XtParent (car sliders)))
- (lambda (target)
- (set! am-effect-target target)
- (XtSetSensitive (XmMessageBoxGetChild am-effect-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog am-effect-dialog)
- (set! am-effect-envelope (xe-create-enved "am" fr
- (list XmNheight 200)
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))
- (XtVaSetValues fr (list XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget target-row)))
- )
- (activate-dialog am-effect-dialog)))
-
- (let ((child (XtCreateManagedWidget "Amplitude modulation" xmPushButtonWidgetClass mod-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((am-effect-amount 100.0)
+ (am-effect-label "Amplitude modulation")
+ (am-effect-dialog #f)
+ (am-effect-target 'sound)
+ (am-effect-envelope #f))
+
+ (define am-effect
+ (lambda (freq)
+ (let* ((os (make-oscil freq))
+ (need-env (not (equal? (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))))
+ (e (and need-env (make-env (xe-envelope am-effect-envelope) :length (effect-framples am-effect-target)))))
+ (if need-env
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (* (env e) (oscil os))))
+ (lambda (inval)
+ (amplitude-modulate 1.0 inval (oscil os)))))))
+
+ (define (post-am-effect-dialog)
+ (if (not (Widget? am-effect-dialog))
+ ;; if am-effect-dialog doesn't exist, create it
+ (let ((initial-am-effect-amount 100.0)
+ (sliders ())
+ (fr #f))
+ (set! am-effect-dialog
+ (make-effect-dialog
+ am-effect-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (am-effect am-effect-amount))
+ am-effect-target
+ (lambda (target samps)
+ (format #f "effects-am ~A ~A" am-effect-amount
+ (let* ((need-env (not (equal? (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))))
+ (e (and need-env (xe-envelope am-effect-envelope))))
+ (and e (format #f "'~A" e)))))
+ #f))
+
+ (lambda (w context info)
+ (help-dialog "Amplitude modulation"
+ "Move the slider to change the modulation amount."))
+
(lambda (w c i)
- (post-am-effect-dialog)))
+ (set! am-effect-amount initial-am-effect-amount)
+ (set! (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))
+ (XtSetValues (car sliders) (list XmNvalue (floor am-effect-amount))))
+
+ (lambda ()
+ (effect-target-ok am-effect-target))))
+
+ (set! sliders
+ (add-sliders am-effect-dialog
+ (list (list "amplitude modulation" 0.0 initial-am-effect-amount 1000.0
+ (lambda (w context info)
+ (set! am-effect-amount (.value info)))
+ 1))))
+ (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
+ (list XmNheight 200
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget (sliders (- (length sliders) 1))
+ XmNshadowThickness 4
+ XmNshadowType XmSHADOW_ETCHED_OUT)))
+ (let ((target-row (add-target (XtParent (XtParent (car sliders)))
+ (lambda (target)
+ (set! am-effect-target target)
+ (XtSetSensitive (XmMessageBoxGetChild am-effect-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog am-effect-dialog)
+ (set! am-effect-envelope (xe-create-enved "am" fr
+ (list XmNheight 200)
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope am-effect-envelope) (list 0.0 1.0 1.0 1.0))
+ (XtVaSetValues fr (list XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget target-row)))
+ )
+ (activate-dialog am-effect-dialog)))
- (set! mod-menu-list (cons (lambda ()
- (let ((new-label (format #f "Amplitude modulation (~1,2F)" am-effect-amount)))
- (change-label child new-label)))
- mod-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Amplitude modulation" xmPushButtonWidgetClass mod-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-am-effect-dialog)))
+
+ (set! mod-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Amplitude modulation (~1,2F)" am-effect-amount)))
+ (change-label child new-label)))
+ mod-menu-list))))
+
;;; -------- Ring modulation
;;;
-
- (let ((rm-frequency 100)
- (rm-radians 100)
- (rm-label "Ring modulation")
- (rm-dialog #f)
- (rm-target 'sound)
- (rm-envelope #f))
-
- (define rm-effect ; avoid collision with examp.scm
- (lambda (freq gliss-env)
- (let* ((os (make-oscil freq))
- (need-env (and rm-envelope (not (equal? (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0)))))
- (e (and need-env (make-env (xe-envelope rm-envelope) :length (effect-frames rm-target))))
- (len (frames))
- (genv (make-env :envelope gliss-env :length len)))
- (if need-env
- (lambda (inval)
- (* inval (* (env e) (oscil os))))
- (lambda (inval)
- (* inval (oscil os)))))))
-
- (define (post-rm-dialog)
- (if (not (Widget? rm-dialog))
- ;; if rm-dialog doesn't exist, create it
- (let ((initial-rm-frequency 100)
- (initial-rm-radians 100)
- (sliders '())
- (fr #f))
- (set! rm-dialog
- (make-effect-dialog
- rm-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (rm-effect rm-frequency (list 0 0 1 (hz->radians rm-radians))))
- rm-target
- (lambda (target samps)
- (format #f "effects-rm ~A ~A" rm-frequency
- (let* ((need-env (not (equal? (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))))
- (e (and need-env (xe-envelope rm-envelope))))
- (if e (format #f "'~A" e)
- #f))))
- #f))
-
- (lambda (w context info)
- (help-dialog "Ring modulation"
- "Move the slider to change the ring modulation parameters."))
-
- (lambda (w c i)
- (set! rm-frequency initial-rm-frequency)
- (set! (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))
- (XtSetValues (car sliders) (list XmNvalue rm-frequency))
- (set! rm-radians initial-rm-radians)
- (XtSetValues (cadr sliders) (list XmNvalue rm-radians)))
-
- (lambda ()
- (effect-target-ok rm-target))))
-
- (set! sliders
- (add-sliders rm-dialog
- (list
- (list "modulation frequency" 0 initial-rm-frequency 1000
- (lambda (w context info)
- (set! rm-frequency (.value info)))
- 1)
- (list "modulation radians" 0 initial-rm-radians 360
- (lambda (w context info)
- (set! rm-radians (.value info)))
- 1))))
- (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
- (list XmNheight 200
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget (list-ref sliders (- (length sliders) 1))
- XmNshadowThickness 4
- XmNshadowType XmSHADOW_ETCHED_OUT)))
- (let ((target-row (add-target (XtParent (XtParent (car sliders)))
- (lambda (target)
- (set! rm-target target)
- (XtSetSensitive (XmMessageBoxGetChild rm-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog rm-dialog)
- (set! rm-envelope (xe-create-enved "rm frequency" fr
- (list XmNheight 200)
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))
- (XtVaSetValues fr (list XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget target-row)))
- )
- (activate-dialog rm-dialog)))
-
- (let ((child (XtCreateManagedWidget "Ring modulation" xmPushButtonWidgetClass mod-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((rm-frequency 100)
+ (rm-radians 100)
+ (rm-label "Ring modulation")
+ (rm-dialog #f)
+ (rm-target 'sound)
+ (rm-envelope #f))
+
+ (define rm-effect ; avoid collision with examp.scm
+ (lambda (freq gliss-env)
+ (let* ((os (make-oscil freq))
+ (need-env (and rm-envelope (not (equal? (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0)))))
+ (e (and need-env (make-env (xe-envelope rm-envelope) :length (effect-framples rm-target)))))
+ (if need-env
+ (lambda (inval)
+ (* inval (env e) (oscil os)))
+ (lambda (inval)
+ (* inval (oscil os)))))))
+
+ (define (post-rm-dialog)
+ (if (not (Widget? rm-dialog))
+ ;; if rm-dialog doesn't exist, create it
+ (let ((initial-rm-frequency 100)
+ (initial-rm-radians 100)
+ (sliders ())
+ (fr #f))
+ (set! rm-dialog
+ (make-effect-dialog
+ rm-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (rm-effect rm-frequency (list 0 0 1 (hz->radians rm-radians))))
+ rm-target
+ (lambda (target samps)
+ (format #f "effects-rm ~A ~A" rm-frequency
+ (let* ((need-env (not (equal? (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))))
+ (e (and need-env (xe-envelope rm-envelope))))
+ (and e (format #f "'~A" e)))))
+ #f))
+
+ (lambda (w context info)
+ (help-dialog "Ring modulation"
+ "Move the slider to change the ring modulation parameters."))
+
(lambda (w c i)
- (post-rm-dialog)))
-
- (set! mod-menu-list (cons (lambda ()
- (let ((new-label (format #f "Ring modulation (~D ~D)"
- rm-frequency rm-radians)))
- (change-label child new-label)))
- mod-menu-list))))
- )
-
+ (set! rm-frequency initial-rm-frequency)
+ (set! (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))
+ (XtSetValues (car sliders) (list XmNvalue rm-frequency))
+ (set! rm-radians initial-rm-radians)
+ (XtSetValues (cadr sliders) (list XmNvalue rm-radians)))
+
+ (lambda ()
+ (effect-target-ok rm-target))))
+
+ (set! sliders
+ (add-sliders rm-dialog
+ (list
+ (list "modulation frequency" 0 initial-rm-frequency 1000
+ (lambda (w context info)
+ (set! rm-frequency (.value info)))
+ 1)
+ (list "modulation radians" 0 initial-rm-radians 360
+ (lambda (w context info)
+ (set! rm-radians (.value info)))
+ 1))))
+ (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
+ (list XmNheight 200
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget (sliders (- (length sliders) 1))
+ XmNshadowThickness 4
+ XmNshadowType XmSHADOW_ETCHED_OUT)))
+ (let ((target-row (add-target (XtParent (XtParent (car sliders)))
+ (lambda (target)
+ (set! rm-target target)
+ (XtSetSensitive (XmMessageBoxGetChild rm-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog rm-dialog)
+ (set! rm-envelope (xe-create-enved "rm frequency" fr
+ (list XmNheight 200)
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope rm-envelope) (list 0.0 1.0 1.0 1.0))
+ (XtVaSetValues fr (list XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget target-row)))
+ )
+ (activate-dialog rm-dialog)))
+
+ (let ((child (XtCreateManagedWidget "Ring modulation" xmPushButtonWidgetClass mod-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-rm-dialog)))
+
+ (set! mod-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Ring modulation (~D ~D)"
+ rm-frequency rm-radians)))
+ (change-label child new-label)))
+ mod-menu-list))))
+ )
+
;;; REVERBS
;;;
-
-(define* (effects-cnv snd0-1 amp snd chn)
- "(effects-cnv snd0-1 amp snd chn) is used by the effects dialog to tie into edit-list->function"
- (let* ((snd0 (if (sound? snd0-1) snd0-1 (car (sounds))))
- (flt-len (frames snd0))
- (total-len (+ flt-len (frames snd chn)))
- (cnv (make-convolve :filter (channel->vct 0 flt-len snd0)))
- (sf (make-sampler 0 snd chn))
- (out-data (make-vct total-len)))
- (vct-map! out-data (lambda () (convolve cnv (lambda (dir) (next-sample sf)))))
- (free-sampler sf)
- (vct-scale! out-data amp)
- (let ((max-samp (vct-peak out-data)))
- (vct->channel out-data 0 total-len snd chn #f (format #f "effects-cnv ~A ~A" snd0 amp))
- (if (> max-samp 1.0) (set! (y-bounds snd chn) (list (- max-samp) max-samp)))
- max-samp)))
-
-(define (effects-jc-reverb input-samps volume)
- "(effects-jc-reverb input-samps volume) is used by the effects dialog to tie into edit-list->function"
- (let* ((allpass1 (make-all-pass -0.700 0.700 1051))
- (allpass2 (make-all-pass -0.700 0.700 337))
- (allpass3 (make-all-pass -0.700 0.700 113))
- (comb1 (make-comb 0.742 4799))
- (comb2 (make-comb 0.733 4999))
- (comb3 (make-comb 0.715 5399))
- (comb4 (make-comb 0.697 5801))
- (outdel1 (make-delay (round (* .013 (srate)))))
- (comb-sum 0.0)
- (comb-sum-1 0.0)
- (comb-sum-2 0.0)
- (delA 0.0)
- (delB 0.0)
- (samp 0))
- (lambda (inval)
- (let ((allpass-sum (all-pass allpass3
- (all-pass allpass2
- (all-pass allpass1
- (if (< samp input-samps) inval 0.0))))))
- (set! samp (+ 1 samp))
- (set! comb-sum-2 comb-sum-1)
- (set! comb-sum-1 comb-sum)
- (set! comb-sum
- (+ (comb comb1 allpass-sum)
- (comb comb2 allpass-sum)
- (comb comb3 allpass-sum)
- (comb comb4 allpass-sum)))
- (+ inval
- (* volume (delay outdel1 comb-sum)))))))
-
-(define* (effects-jc-reverb-1 volume beg dur snd chn)
- "(effects-jc-reverb-1 volume beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (map-channel (effects-jc-reverb (or dur (frames snd chn)) volume)
- beg dur snd chn #f
- (format #f "effects-jc-reverb-1 ~A ~A ~A" volume beg dur)))
-
-
-(let* ((reverb-menu-list '())
- (reverb-menu (XmCreatePulldownMenu (main-menu effects-menu) "Reverbs"
- (list XmNbackground (basic-color))))
- (reverb-cascade (XtCreateManagedWidget "Reverbs" xmCascadeButtonWidgetClass (main-menu effects-menu)
- (list XmNsubMenuId reverb-menu
- XmNbackground (basic-color)))))
-
- (XtAddCallback reverb-cascade XmNcascadingCallback (lambda (w c i) (update-label reverb-menu-list)))
-
+ (define effects-cnv
+ (let ((documentation "(effects-cnv snd0-1 amp snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (snd0-1 amp snd chn)
+ (let* ((snd0 (if (sound? snd0-1) snd0-1 (car (sounds))))
+ (flt-len (framples snd0))
+ (total-len (+ flt-len (framples snd chn)))
+ (cnv (make-convolve :filter (channel->float-vector 0 flt-len snd0)
+ :input (make-sampler 0 snd chn)))
+ (out-data (make-float-vector total-len)))
+ (do ((i 0 (+ i 1)))
+ ((= i total-len))
+ (set! (out-data i) (convolve cnv)))
+ (float-vector-scale! out-data amp)
+ (let ((max-samp (float-vector-peak out-data)))
+ (float-vector->channel out-data 0 total-len snd chn #f (format #f "effects-cnv ~A ~A" snd0 amp))
+ (if (> max-samp 1.0) (set! (y-bounds snd chn) (list (- max-samp) max-samp)))
+ max-samp)))))
+
+
+ (define effects-jc-reverb
+ (let ((documentation "(effects-jc-reverb volume beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (volume beg dur snd chn)
+ (let ((allpass1 (make-all-pass -0.700 0.700 1051))
+ (allpass2 (make-all-pass -0.700 0.700 337))
+ (allpass3 (make-all-pass -0.700 0.700 113))
+ (comb1 (make-comb 0.742 4799))
+ (comb2 (make-comb 0.733 4999))
+ (comb3 (make-comb 0.715 5399))
+ (comb4 (make-comb 0.697 5801))
+ (outdel1 (make-delay (round (* .013 (srate)))))
+ (e (make-env '(0 1 1 0) :scaler volume :base 0.0 :length dur)))
+ (let ((combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
+ (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
+ (lambda (inval)
+ (+ inval
+ (delay outdel1 (comb-bank combs (all-pass-bank allpasses (* inval (env e))))))))))))
+
+ (define* (effects-jc-reverb-1 volume beg dur snd chn)
+ (map-channel (effects-jc-reverb volume (or beg 0) (or dur (framples snd chn)) snd chn)
+ (or beg 0) dur snd chn #f
+ (format #f "effects-jc-reverb-1 ~A ~A ~A" volume beg dur)))
+
+ (let* ((reverb-menu-list ())
+ (reverb-menu (XmCreatePulldownMenu (main-menu effects-menu) "Reverbs"
+ (list XmNbackground *basic-color*)))
+ (reverb-cascade (XtCreateManagedWidget "Reverbs" xmCascadeButtonWidgetClass (main-menu effects-menu)
+ (list XmNsubMenuId reverb-menu
+ XmNbackground *basic-color*))))
+
+ (XtAddCallback reverb-cascade XmNcascadingCallback (lambda (w c i) (update-label reverb-menu-list)))
+
+
;;; -------- Reverb from Michael McNabb's Nrev
;;; -------- very nice reverb actually
;;;
;;; (truncate)
-
- (let ((reverb-amount 0.1)
- (reverb-filter 0.5)
- (reverb-feedback 1.09)
- (reverb-label "McNabb reverb")
- (reverb-dialog #f)
- (reverb-target 'sound))
-
- ;; add reverb-control-decay (with ramp?) and reverb-truncate
-
- (define (post-reverb-dialog)
- (if (not (Widget? reverb-dialog))
- ;; if reverb-dialog doesn't exist, create it
- (let ((initial-reverb-amount 0.1)
- (initial-reverb-filter 0.5)
- (initial-reverb-feedback 1.09)
- (sliders '()))
- (set! reverb-dialog
- (make-effect-dialog
- reverb-label
-
- (lambda (w context info)
- (let ((snd (selected-sound)))
- (save-controls snd)
- (reset-controls snd)
- (set! (reverb-control? snd) #t)
- (set! (reverb-control-scale snd) reverb-amount)
- (set! (reverb-control-lowpass snd) reverb-filter)
- (set! (reverb-control-feedback snd) reverb-feedback)
- (if (eq? reverb-target 'marks)
- (let ((ms (plausible-mark-samples)))
- (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
- (apply-controls snd (if (eq? reverb-target 'sound) 0 2)))
- (restore-controls snd)))
-
- (lambda (w context info)
- (help-dialog "McNabb reverb"
- "Reverberator from Michael McNabb.
+
+ (let ((reverb-amount 0.1)
+ (reverb-filter 0.5)
+ (reverb-feedback 1.09)
+ (reverb-label "McNabb reverb")
+ (reverb-dialog #f)
+ (reverb-target 'sound))
+
+ ;; add reverb-control-decay (with ramp?) and reverb-truncate
+
+ (define (post-reverb-dialog)
+ (if (not (Widget? reverb-dialog))
+ ;; if reverb-dialog doesn't exist, create it
+ (let ((initial-reverb-amount 0.1)
+ (initial-reverb-filter 0.5)
+ (initial-reverb-feedback 1.09)
+ (sliders ()))
+ (set! reverb-dialog
+ (make-effect-dialog
+ reverb-label
+
+ (lambda (w context info)
+ (let ((snd (selected-sound)))
+ (save-controls snd)
+ (reset-controls snd)
+ (set! (reverb-control? snd) #t)
+ (set! (reverb-control-scale snd) reverb-amount)
+ (set! (reverb-control-lowpass snd) reverb-filter)
+ (set! (reverb-control-feedback snd) reverb-feedback)
+ (if (eq? reverb-target 'marks)
+ (let ((ms (plausible-mark-samples)))
+ (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
+ (apply-controls snd (if (eq? reverb-target 'sound) 0 2)))
+ (restore-controls snd)))
+
+ (lambda (w context info)
+ (help-dialog "McNabb reverb"
+ "Reverberator from Michael McNabb.
Adds reverberation scaled by reverb amount, lowpass filtering, and feedback. Move the sliders to change the reverb parameters."))
-
- (lambda (w c i)
- (set! reverb-amount initial-reverb-amount)
- (XtSetValues (car sliders) (list XmNvalue (floor (* reverb-amount 100))))
- (set! reverb-filter initial-reverb-filter)
- (XtSetValues (cadr sliders) (list XmNvalue (floor (* reverb-filter 100))))
- (set! reverb-feedback initial-reverb-feedback)
- (XtSetValues (caddr sliders) (list XmNvalue (floor (* reverb-feedback 100)))))
-
- (lambda ()
- (effect-target-ok reverb-target))))
-
- (set! sliders
- (add-sliders reverb-dialog
- (list (list "reverb amount" 0.0 initial-reverb-amount 1.0
- (lambda (w context info)
- (set! reverb-amount (/ (.value info) 100.0)))
- 100)
- (list "reverb filter" 0.0 initial-reverb-filter 1.0
- (lambda (w context info)
- (set! reverb-filter (/ (.value info) 100.0)))
- 100)
- (list "reverb feedback" 0.0 initial-reverb-feedback 1.25
- (lambda (w context info)
- (set! reverb-feedback (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! reverb-target target)
- (XtSetSensitive (XmMessageBoxGetChild reverb-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog reverb-dialog))
-
- (let ((child (XtCreateManagedWidget "McNabb reverb" xmPushButtonWidgetClass reverb-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
(lambda (w c i)
- (post-reverb-dialog)))
+ (set! reverb-amount initial-reverb-amount)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* reverb-amount 100))))
+ (set! reverb-filter initial-reverb-filter)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor (* reverb-filter 100))))
+ (set! reverb-feedback initial-reverb-feedback)
+ (XtSetValues (caddr sliders) (list XmNvalue (floor (* reverb-feedback 100)))))
+
+ (lambda ()
+ (effect-target-ok reverb-target))))
+
+ (set! sliders
+ (add-sliders reverb-dialog
+ (list (list "reverb amount" 0.0 initial-reverb-amount 1.0
+ (lambda (w context info)
+ (set! reverb-amount (/ (.value info) 100.0)))
+ 100)
+ (list "reverb filter" 0.0 initial-reverb-filter 1.0
+ (lambda (w context info)
+ (set! reverb-filter (/ (.value info) 100.0)))
+ 100)
+ (list "reverb feedback" 0.0 initial-reverb-feedback 1.25
+ (lambda (w context info)
+ (set! reverb-feedback (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! reverb-target target)
+ (XtSetSensitive (XmMessageBoxGetChild reverb-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog reverb-dialog))
- (set! reverb-menu-list (cons (lambda ()
- (let ((new-label (format #f "McNabb reverb (~1,2F ~1,2F ~1,2F)"
- reverb-amount reverb-filter reverb-feedback)))
- (change-label child new-label)))
- reverb-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "McNabb reverb" xmPushButtonWidgetClass reverb-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-reverb-dialog)))
+
+ (set! reverb-menu-list (cons (lambda ()
+ (let ((new-label (format #f "McNabb reverb (~1,2F ~1,2F ~1,2F)"
+ reverb-amount reverb-filter reverb-feedback)))
+ (change-label child new-label)))
+ reverb-menu-list))))
+
+
;;; -------- Chowning reverb
;;;
-
- (let ((jc-reverb-decay 2.0)
- (jc-reverb-volume 0.1)
- (jc-reverb-label "Chowning reverb")
- (jc-reverb-dialog #f)
- (jc-reverb-target 'sound)
- (jc-reverb-truncate #t))
-
- (define (post-jc-reverb-dialog)
- (if (not (Widget? jc-reverb-dialog))
- ;; if jc-reverb-dialog doesn't exist, create it
- (let ((initial-jc-reverb-decay 2.0)
- (initial-jc-reverb-volume 0.1)
- (sliders '()))
- (set! jc-reverb-dialog
- (make-effect-dialog
- jc-reverb-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (samps) (effects-jc-reverb samps jc-reverb-volume))
- jc-reverb-target
- (lambda (target samps)
- (format #f "effects-jc-reverb-1 ~A" jc-reverb-volume))
- (and (not jc-reverb-truncate) jc-reverb-decay)))
-
- (lambda (w context info)
- (help-dialog "Chowning reverb"
- "Nice reverb from John Chowning. Move the sliders to set the reverb parameters."))
-
- (lambda (w c i)
- (set! jc-reverb-decay initial-jc-reverb-decay)
- (XtSetValues (list-ref sliders 0) (list XmNvalue (floor (* jc-reverb-decay 100))))
- (set! jc-reverb-volume initial-jc-reverb-volume)
- (XtSetValues (list-ref sliders 1) (list XmNvalue (floor (* jc-reverb-volume 100)))))
-
- (lambda ()
- (effect-target-ok jc-reverb-target))))
-
- (set! sliders
- (add-sliders jc-reverb-dialog
- (list (list "decay duration" 0.0 initial-jc-reverb-decay 10.0
- (lambda (w context info)
- (set! jc-reverb-decay (/ (.value info) 100)))
- 100)
- (list "reverb volume" 0.0 initial-jc-reverb-volume 1.0
- (lambda (w context info)
- (set! jc-reverb-volume (/ (.value info) 100)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! jc-reverb-target target)
- (XtSetSensitive (XmMessageBoxGetChild jc-reverb-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- (lambda (truncate)
- (set! jc-reverb-truncate truncate)))))
- (activate-dialog jc-reverb-dialog))
-
- (let ((child (XtCreateManagedWidget "Chowning reverb" xmPushButtonWidgetClass reverb-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((jc-reverb-decay 2.0)
+ (jc-reverb-volume 0.1)
+ (jc-reverb-label "Chowning reverb")
+ (jc-reverb-dialog #f)
+ (jc-reverb-target 'sound)
+ (jc-reverb-truncate #f))
+
+ (define (post-jc-reverb-dialog)
+ (if (not (Widget? jc-reverb-dialog))
+ ;; if jc-reverb-dialog doesn't exist, create it
+ (let ((initial-jc-reverb-decay 2.0)
+ (initial-jc-reverb-volume 0.1)
+ (sliders ()))
+ (set! jc-reverb-dialog
+ (make-effect-dialog
+ jc-reverb-label
+
+ (lambda (w context info)
+ ;(pad-channel (- (framples) 1) (srate))
+ (map-chan-over-target-with-sync
+ (lambda (samps)
+ (effects-jc-reverb jc-reverb-volume samps (framples)))
+ jc-reverb-target
+ (lambda (target samps)
+ (format #f "effects-jc-reverb-1 ~A" jc-reverb-volume))
+ (and (not jc-reverb-truncate) jc-reverb-decay)))
+
+ (lambda (w context info)
+ (help-dialog "Chowning reverb"
+ "Nice reverb from John Chowning. Move the sliders to set the reverb parameters."))
+
(lambda (w c i)
- (post-jc-reverb-dialog)))
+ (set! jc-reverb-decay initial-jc-reverb-decay)
+ (XtSetValues (sliders 0) (list XmNvalue (floor (* jc-reverb-decay 100))))
+ (set! jc-reverb-volume initial-jc-reverb-volume)
+ (XtSetValues (sliders 1) (list XmNvalue (floor (* jc-reverb-volume 100)))))
+
+ (lambda ()
+ (effect-target-ok jc-reverb-target))))
+
+ (set! sliders
+ (add-sliders jc-reverb-dialog
+ (list (list "decay duration" 0.0 initial-jc-reverb-decay 10.0
+ (lambda (w context info)
+ (set! jc-reverb-decay (/ (.value info) 100)))
+ 100)
+ (list "reverb volume" 0.0 initial-jc-reverb-volume 1.0
+ (lambda (w context info)
+ (set! jc-reverb-volume (/ (.value info) 100)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! jc-reverb-target target)
+ (XtSetSensitive (XmMessageBoxGetChild jc-reverb-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ (lambda (truncate)
+ (set! jc-reverb-truncate truncate)))))
+ (activate-dialog jc-reverb-dialog))
- (set! reverb-menu-list (cons (lambda ()
- (let ((new-label (format #f "Chowning reverb (~1,2F ~1,2F)"
- jc-reverb-decay jc-reverb-volume)))
- (change-label child new-label)))
- reverb-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Chowning reverb" xmPushButtonWidgetClass reverb-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-jc-reverb-dialog)))
+
+ (set! reverb-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Chowning reverb (~1,2F ~1,2F)"
+ jc-reverb-decay jc-reverb-volume)))
+ (change-label child new-label)))
+ reverb-menu-list))))
+
;;; -------- Convolution
;;;
;;; (progress report? truncate?)
-
- (let ((convolve-sound-one 0)
- (convolve-sound-two 1)
- (convolve-amp 0.01)
- (convolve-label "Convolution")
- (convolve-dialog #f))
-
- (define (post-convolve-dialog)
- (if (not (Widget? convolve-dialog))
- ;; if convolve-dialog doesn't exist, create it
- (let ((initial-convolve-sound-one 0)
- (initial-convolve-sound-two 1)
- (initial-convolve-amp 0.01)
- (sliders '()))
- (set! convolve-dialog
- (make-effect-dialog
- convolve-label
-
- (lambda (w context info)
- (effects-cnv convolve-sound-one convolve-amp convolve-sound-two))
-
- (lambda (w context info)
- (help-dialog "Convolution"
- "Very simple convolution. Move the sliders to set the numbers of the soundfiles to be convolved and the amount for the amplitude scaler. Output will be scaled to floating-point values, resulting in very large (but not clipped) amplitudes. Use the Normalize amplitude effect to rescale the output. The convolution data file typically defines a natural reverberation source, and the output from this effect can provide very striking reverb effects. You can find convolution data files on sites listed at http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data."))
-
- (lambda (w c i)
- (set! convolve-sound-one initial-convolve-sound-one)
- (XtSetValues (list-ref sliders 0) (list XmNvalue convolve-sound-one))
- (set! convolve-sound-two initial-convolve-sound-two)
- (XtSetValues (list-ref sliders 1) (list XmNvalue convolve-sound-two))
- (set! convolve-amp initial-convolve-amp)
- (XtSetValues (list-ref sliders 2) (list XmNvalue (floor (* convolve-amp 100)))))
-
- (lambda ()
- (not (null? (sounds))))))
-
- (set! sliders
- (add-sliders convolve-dialog
- (list (list "impulse response file" 0 initial-convolve-sound-one 24
- (lambda (w context info)
- (set! convolve-sound-one (.value info)))
- 1)
- (list "sound file" 0 initial-convolve-sound-two 24
- (lambda (w context info)
- (set! convolve-sound-two (.value info)))
- 1)
- (list "amplitude" 0.0 initial-convolve-amp 0.10
- (lambda (w context info)
- (set! convolve-amp (/ (.value info) 100.0)))
- 1000))))))
- (activate-dialog convolve-dialog))
-
- (let ((child (XtCreateManagedWidget "Convolution" xmPushButtonWidgetClass reverb-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((convolve-sound-one 0)
+ (convolve-sound-two 1)
+ (convolve-amp 0.01)
+ (convolve-label "Convolution")
+ (convolve-dialog #f))
+
+ (define (post-convolve-dialog)
+ (if (not (Widget? convolve-dialog))
+ ;; if convolve-dialog doesn't exist, create it
+ (let ((initial-convolve-sound-one 0)
+ (initial-convolve-sound-two 1)
+ (initial-convolve-amp 0.01)
+ (sliders ()))
+ (set! convolve-dialog
+ (make-effect-dialog
+ convolve-label
+
+ (lambda (w context info)
+ (effects-cnv convolve-sound-one convolve-amp convolve-sound-two))
+
+ (lambda (w context info)
+ (help-dialog "Convolution"
+ "Very simple convolution. Move the sliders to set the numbers of the soundfiles to be convolved and the amount for the amplitude scaler. Output will be scaled to floating-point values, resulting in very large (but not clipped) amplitudes. Use the Normalize amplitude effect to rescale the output. The convolution data file typically defines a natural reverberation source, and the output from this effect can provide very striking reverb effects. You can find convolution data files on sites listed at http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data."))
+
(lambda (w c i)
- (post-convolve-dialog)))
+ (set! convolve-sound-one initial-convolve-sound-one)
+ (XtSetValues (sliders 0) (list XmNvalue convolve-sound-one))
+ (set! convolve-sound-two initial-convolve-sound-two)
+ (XtSetValues (sliders 1) (list XmNvalue convolve-sound-two))
+ (set! convolve-amp initial-convolve-amp)
+ (XtSetValues (sliders 2) (list XmNvalue (floor (* convolve-amp 100)))))
+
+ (lambda ()
+ (pair? (sounds)))))
+
+ (set! sliders
+ (add-sliders convolve-dialog
+ (list (list "impulse response file" 0 initial-convolve-sound-one 24
+ (lambda (w context info)
+ (set! convolve-sound-one (.value info)))
+ 1)
+ (list "sound file" 0 initial-convolve-sound-two 24
+ (lambda (w context info)
+ (set! convolve-sound-two (.value info)))
+ 1)
+ (list "amplitude" 0.0 initial-convolve-amp 0.10
+ (lambda (w context info)
+ (set! convolve-amp (/ (.value info) 100.0)))
+ 1000))))))
+ (activate-dialog convolve-dialog))
- (set! reverb-menu-list (cons (lambda ()
- (let ((new-label (format #f "Convolution (~D ~D ~1,2F)"
- convolve-sound-one convolve-sound-two convolve-amp)))
- (change-label child new-label)))
- reverb-menu-list))))
- )
-
+ (let ((child (XtCreateManagedWidget "Convolution" xmPushButtonWidgetClass reverb-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-convolve-dialog)))
+
+ (set! reverb-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Convolution (~D ~D ~1,2F)"
+ convolve-sound-one convolve-sound-two convolve-amp)))
+ (change-label child new-label)))
+ reverb-menu-list))))
+ )
+
;;; VARIOUS AND MISCELLANEOUS
;;;
-
-(define* (effects-hello-dentist frq amp beg dur snd chn)
- "(effects-hello-dentist frq amp beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let* ((rn (make-rand-interp :frequency frq :amplitude amp))
- (i 0)
- (j 0)
- (len (or dur (frames snd chn)))
- (in-data (channel->vct beg len snd chn))
- (out-len (round (* len (+ 1.0 (* 2 amp)))))
- (out-data (make-vct out-len))
- (rd (make-src :srate 1.0
- :input (lambda (dir)
- (let ((val (if (and (>= i 0) (< i len))
- (vct-ref in-data i)
- 0.0)))
- (set! i (+ i dir))
- val)))))
- (do ()
- ((or (= i len) (= j out-len)))
- (vct-set! out-data j (src rd (rand-interp rn)))
- (set! j (+ j 1)))
- (vct->channel out-data beg j snd chn #f
- (format #f "effects-hello-dentist ~A ~A ~A ~A" frq amp beg (if (= len (frames snd chn)) #f len)))))
-
-(define* (effects-fp srf osamp osfrq beg dur snd chn)
- "(effects-fp srf osamp osfrq beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let* ((os (make-oscil osfrq))
- (sr (make-src :srate srf))
- (sf (make-sampler beg))
- (len (or dur (frames snd chn)))
- (out-data (make-vct len)))
- (vct-map! out-data
- (lambda ()
- (src sr (* osamp (oscil os))
- (lambda (dir)
- (if (> dir 0)
- (next-sample sf)
- (previous-sample sf))))))
- (free-sampler sf)
- (vct->channel out-data beg len snd chn #f
- (format #f "effects-fp ~A ~A ~A ~A ~A" srf osamp osfrq beg (if (= len (frames snd chn)) #f len)))))
-
-(define* (effects-position-sound mono-snd pos snd chn)
- "(effects-position-sound mono-snd pos-1 snd chn) is used by the effects dialog to tie into edit-list->function"
- (let ((len (frames mono-snd))
- (reader1 (make-sampler 0 mono-snd)))
- (if (number? pos)
- (map-channel (lambda (y)
- (+ y (* pos (read-sample reader1))))
- 0 len snd chn #f
- (format #f "effects-position-sound ~A ~A" mono-snd pos))
- (let ((e1 (make-env pos :length len)))
- (if (and (number? chn) (= chn 1))
- (map-channel (lambda (y)
- (+ y (* (env e1) (read-sample reader1))))
- 0 len snd chn #f
- (format #f "effects-position-sound ~A '~A" mono-snd pos))
+
+ (define effects-hello-dentist
+ (let ((documentation "(hello-dentist frq amp snd chn) varies the sampling rate randomly, making a voice sound quavery: (hello-dentist 40.0 .1)"))
+ (lambda* (frq amp beg dur snd chn)
+ (let* ((rn (make-rand-interp :frequency frq :amplitude amp))
+ (len (or dur (- (framples snd chn) beg)))
+ (sf (make-sampler beg snd chn))
+ (rd (make-src :srate 1.0
+ :input (lambda (dir) (read-sample-with-direction sf dir)))))
+ (map-channel
+ (lambda (y)
+ (src rd (rand-interp rn)))
+ beg len snd chn #f (format #f "effects-hello-dentist ~A ~A ~A ~A" frq amp beg (and (not (= len (framples snd chn))) len)))))))
+
+
+ (define* (effects-fp sr osamp osfrq beg dur snd chn)
+ (let* ((os (make-oscil osfrq))
+ (len (framples snd chn))
+ (sf (make-sampler beg snd chn))
+ (s (make-src :srate sr :input (lambda (dir) (read-sample-with-direction sf dir)))))
+ (map-channel
+ (lambda (y)
+ (src s (* osamp (oscil os))))
+ beg len snd chn #f (format #f "effects-fp ~A ~A ~A ~A ~A" sr osamp osfrq beg (and (not (= len (framples snd chn))) len)))))
+
+
+ (define effects-position-sound
+ (let ((documentation "(effects-position-sound mono-snd pos-1 snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (mono-snd pos snd chn)
+ (let ((len (framples mono-snd))
+ (reader1 (make-sampler 0 mono-snd)))
+ (if (number? pos)
(map-channel (lambda (y)
- (+ y (* (- 1.0 (env e1)) (read-sample reader1))))
+ (+ y (* pos (read-sample reader1))))
0 len snd chn #f
- (format #f "effects-position-sound ~A '~A" mono-snd pos)))))))
-
-(define* (effects-flange amount speed time beg dur snd chn)
- "(effects-flange amount speed time beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (let* ((ri (make-rand-interp :frequency speed :amplitude amount))
- (len (round (* time (srate snd))))
- (del (make-delay len :max-size (round (+ len amount 1)))))
- (map-channel (lambda (inval)
- (* .75 (+ inval
- (delay del
- inval
- (rand-interp ri)))))
- beg dur snd chn #f (format #f "effects-flange ~A ~A ~A ~A ~A"
- amount speed time beg (if (and (number? dur) (not (= dur (frames snd chn)))) dur #f)))))
-
-(define (effects-cross-synthesis cross-snd amp fftsize r)
- "(effects-cross-synthesis cross-snd amp fftsize r) is used by the effects dialog to tie into edit-list->function"
- ;; cross-snd is the index of the other sound (as opposed to the map-channel sound)
- (let* ((freq-inc (/ fftsize 2))
- (fdr (make-vct fftsize))
- (fdi (make-vct fftsize))
- (spectr (make-vct freq-inc))
- (inctr 0)
- (ctr freq-inc)
- (radius (- 1.0 (/ r fftsize)))
- (bin (/ (srate) fftsize))
- (formants (make-vector freq-inc)))
- (do ((i 0 (+ 1 i)))
- ((= i freq-inc))
- (vector-set! formants i (make-formant (* i bin) radius)))
- (lambda (inval)
- (let ((outval 0.0))
- (if (= ctr freq-inc)
- (begin
- (set! fdr (channel->vct inctr fftsize cross-snd 0))
- (set! inctr (+ inctr freq-inc))
- (spectrum fdr fdi #f 2)
- (vct-subtract! fdr spectr)
- (vct-scale! fdr (/ 1.0 freq-inc))
- (set! ctr 0)))
- (set! ctr (+ ctr 1))
- (vct-add! spectr fdr)
- (* amp (formant-bank spectr formants inval))))))
-
-(define* (effects-cross-synthesis-1 cross-snd amp fftsize r beg dur snd chn)
- "(effects-cross-synthesis-1 cross-snd amp fftsize r beg dur snd chn) is used by the effects dialog to tie into edit-list->function"
- (map-channel (effects-cross-synthesis (if (sound? cross-snd) cross-snd (car (sounds))) amp fftsize r)
- beg dur snd chn #f
- (format #f "effects-cross-synthesis-1 ~A ~A ~A ~A ~A ~A" cross-snd amp fftsize r beg dur)))
-
-(let* ((misc-menu-list '())
- (misc-menu (XmCreatePulldownMenu (main-menu effects-menu) "Various"
- (list XmNbackground (basic-color))))
- (misc-cascade (XtCreateManagedWidget "Various" xmCascadeButtonWidgetClass (main-menu effects-menu)
- (list XmNsubMenuId misc-menu
- XmNbackground (basic-color)))))
-
- (XtAddCallback misc-cascade XmNcascadingCallback (lambda (w c i) (update-label misc-menu-list)))
-
-
+ (format #f "effects-position-sound ~A ~A" mono-snd pos))
+ (let ((e1 (make-env pos :length len)))
+ (if (and (number? chn) (= chn 1))
+ (map-channel (lambda (y)
+ (+ y (* (env e1) (read-sample reader1))))
+ 0 len snd chn #f
+ (format #f "effects-position-sound ~A '~A" mono-snd pos))
+ (map-channel (lambda (y)
+ (+ y (* (- 1.0 (env e1)) (read-sample reader1))))
+ 0 len snd chn #f
+ (format #f "effects-position-sound ~A '~A" mono-snd pos)))))))))
+
+ (define effects-flange
+ (let ((documentation "(effects-flange amount speed time beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (amount speed time beg dur snd chn)
+ (let* ((ri (make-rand-interp :frequency speed :amplitude amount))
+ (len (round (* time (srate snd))))
+ (del (make-delay len :max-size (round (+ len amount 1)))))
+ (map-channel (lambda (inval)
+ (* .75 (+ inval
+ (delay del
+ inval
+ (rand-interp ri)))))
+ beg dur snd chn #f (format #f "effects-flange ~A ~A ~A ~A ~A"
+ amount speed time beg (and (number? dur) (not (= dur (framples snd chn))) dur)))))))
+
+ (define effects-cross-synthesis
+ (let ((documentation "(effects-cross-synthesis cross-snd amp fftsize r) is used by the effects dialog to tie into edit-list->function"))
+ (lambda (cross-snd amp fftsize r)
+ ;; cross-snd is the index of the other sound (as opposed to the map-channel sound)
+ (let* ((freq-inc (/ fftsize 2))
+ (fdr (make-float-vector fftsize))
+ (fdi (make-float-vector fftsize))
+ (spectr (make-float-vector freq-inc))
+ (inctr 0)
+ (ctr freq-inc)
+ (radius (- 1.0 (/ r fftsize)))
+ (bin (/ (srate) fftsize))
+ (formants (make-vector freq-inc)))
+ (do ((i 0 (+ 1 i)))
+ ((= i freq-inc))
+ (set! (formants i) (make-formant (* i bin) radius)))
+ (set! formants (make-formant-bank formants spectr))
+ (lambda (inval)
+ (if (= ctr freq-inc)
+ (begin
+ (set! fdr (channel->float-vector inctr fftsize cross-snd 0))
+ (set! inctr (+ inctr freq-inc))
+ (spectrum fdr fdi #f 2)
+ (float-vector-subtract! fdr spectr)
+ (float-vector-scale! fdr (/ 1.0 freq-inc))
+ (set! ctr 0)))
+ (set! ctr (+ ctr 1))
+ (float-vector-add! spectr fdr)
+ (* amp (formant-bank formants inval)))))))
+
+ (define effects-cross-synthesis-1
+ (let ((documentation "(effects-cross-synthesis-1 cross-snd amp fftsize r beg dur snd chn) is used by the effects dialog to tie into edit-list->function"))
+ (lambda* (cross-snd amp fftsize r beg dur snd chn)
+ (map-channel (effects-cross-synthesis (if (sound? cross-snd) cross-snd (car (sounds))) amp fftsize r)
+ beg dur snd chn #f
+ (format #f "effects-cross-synthesis-1 ~A ~A ~A ~A ~A ~A" cross-snd amp fftsize r beg dur)))))
+
+ (let* ((misc-menu-list ())
+ (misc-menu (XmCreatePulldownMenu (main-menu effects-menu) "Various"
+ (list XmNbackground *basic-color*)))
+ (misc-cascade (XtCreateManagedWidget "Various" xmCascadeButtonWidgetClass (main-menu effects-menu)
+ (list XmNsubMenuId misc-menu
+ XmNbackground *basic-color*))))
+
+ (XtAddCallback misc-cascade XmNcascadingCallback (lambda (w c i) (update-label misc-menu-list)))
+
+
;;; -------- Place sound
;;;
-
- (let ((mono-snd 0)
- (stereo-snd 1)
- (pan-pos 45)
- (place-sound-label "Place sound")
- (place-sound-dialog #f)
- (place-sound-target 'sound)
- (place-sound-envelope #f))
-
- (define (place-sound mono-snd stereo-snd pan-env)
- "(place-sound mono-snd stereo-snd pan-env) mixes a mono sound into a stereo sound, splitting
-it into two copies whose amplitudes depend on the envelope 'pan-env'. If 'pan-env' is
-a number, the sound is split such that 0 is all in channel 0 and 90 is all in channel 1."
- (let ((len (frames mono-snd)))
+
+ (let ((mono-snd 0)
+ (stereo-snd 1)
+ (pan-pos 45)
+ (place-sound-label "Place sound")
+ (place-sound-dialog #f)
+ (place-sound-target 'sound)
+ (place-sound-envelope #f))
+
+ (define (place-sound mono-snd stereo-snd pan-env)
+ ;; (place-sound mono-snd stereo-snd pan-env) mixes a mono sound into a stereo sound, splitting
+ ;; it into two copies whose amplitudes depend on the envelope 'pan-env'. If 'pan-env' is
+ ;; a number, the sound is split such that 0 is all in channel 0 and 90 is all in channel 1.
(if (number? pan-env)
- (let* ((pos (/ pan-env 90.0)))
+ (let ((pos (/ pan-env 90.0)))
(effects-position-sound mono-snd pos stereo-snd 1)
(effects-position-sound mono-snd (- 1.0 pos) stereo-snd 0))
(begin
(effects-position-sound mono-snd pan-env stereo-snd 1)
- (effects-position-sound mono-snd pan-env stereo-snd 0)))))
-
- (define (post-place-sound-dialog)
- (if (not (Widget? place-sound-dialog))
- (let ((initial-mono-snd 0)
- (initial-stereo-snd 1)
- (initial-pan-pos 45)
- (sliders '())
- (fr #f))
- (set! place-sound-dialog
- (make-effect-dialog
- place-sound-label
-
- (lambda (w context info)
- (let ((e (xe-envelope place-sound-envelope)))
- (if (not (equal? e (list 0.0 1.0 1.0 1.0)))
- (place-sound mono-snd stereo-snd e)
- (place-sound mono-snd stereo-snd pan-pos))))
-
- (lambda (w context info)
- (help-dialog "Place sound"
- "Mixes mono sound into stereo sound field."))
-
- (lambda (w c i)
- (set! mono-snd initial-mono-snd)
- (XtSetValues (list-ref sliders 0) (list XmNvalue mono-snd))
- (set! stereo-snd initial-stereo-snd)
- (XtSetValues (list-ref sliders 1) (list XmNvalue stereo-snd))
- (set! pan-pos initial-pan-pos)
- (XtSetValues (list-ref sliders 2) (list XmNvalue pan-pos)))
-
- (lambda ()
- (effect-target-ok place-sound-target))))
-
- (set! sliders
- (add-sliders place-sound-dialog
- (list (list "mono sound" 0 initial-mono-snd 50
- (lambda (w context info)
- (set! mono-snd (.value info)))
- 1)
- (list "stereo sound" 0 initial-stereo-snd 50
- (lambda (w context info)
- (set! stereo-snd (.value info)))
- 1)
- (list "pan position" 0 initial-pan-pos 90
- (lambda (w context info)
- (set! pan-pos (.value info)))
- 1))))
- (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
- (list XmNheight 200
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNbottomAttachment XmATTACH_FORM
- XmNtopWidget (list-ref sliders (- (length sliders) 1))
- XmNshadowThickness 4
- XmNshadowType XmSHADOW_ETCHED_OUT)))
-
- (activate-dialog place-sound-dialog)
- (set! place-sound-envelope (xe-create-enved "panning" fr
- (list XmNheight 200
- XmNbottomAttachment XmATTACH_FORM
- )
- '(0.0 1.0 0.0 1.0)))
- (set! (xe-envelope place-sound-envelope) (list 0.0 1.0 1.0 1.0))
- ))
-
- (activate-dialog place-sound-dialog))
-
- (let ((child (XtCreateManagedWidget "Place sound" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+ (effects-position-sound mono-snd pan-env stereo-snd 0))))
+
+ (define (post-place-sound-dialog)
+ (if (not (Widget? place-sound-dialog))
+ (let ((initial-mono-snd 0)
+ (initial-stereo-snd 1)
+ (initial-pan-pos 45)
+ (sliders ())
+ (fr #f))
+ (set! place-sound-dialog
+ (make-effect-dialog
+ place-sound-label
+
+ (lambda (w context info)
+ (let ((e (xe-envelope place-sound-envelope)))
+ (if (not (equal? e (list 0.0 1.0 1.0 1.0)))
+ (place-sound mono-snd stereo-snd e)
+ (place-sound mono-snd stereo-snd pan-pos))))
+
+ (lambda (w context info)
+ (help-dialog "Place sound"
+ "Mixes mono sound into stereo sound field."))
+
(lambda (w c i)
- (post-place-sound-dialog)))
+ (set! mono-snd initial-mono-snd)
+ (XtSetValues (sliders 0) (list XmNvalue mono-snd))
+ (set! stereo-snd initial-stereo-snd)
+ (XtSetValues (sliders 1) (list XmNvalue stereo-snd))
+ (set! pan-pos initial-pan-pos)
+ (XtSetValues (sliders 2) (list XmNvalue pan-pos)))
+
+ (lambda ()
+ (effect-target-ok place-sound-target))))
+
+ (set! sliders
+ (add-sliders place-sound-dialog
+ (list (list "mono sound" 0 initial-mono-snd 50
+ (lambda (w context info)
+ (set! mono-snd (.value info)))
+ 1)
+ (list "stereo sound" 0 initial-stereo-snd 50
+ (lambda (w context info)
+ (set! stereo-snd (.value info)))
+ 1)
+ (list "pan position" 0 initial-pan-pos 90
+ (lambda (w context info)
+ (set! pan-pos (.value info)))
+ 1))))
+ (set! fr (XtCreateManagedWidget "fr" xmFrameWidgetClass (XtParent (XtParent (car sliders)))
+ (list XmNheight 200
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNbottomAttachment XmATTACH_FORM
+ XmNtopWidget (sliders (- (length sliders) 1))
+ XmNshadowThickness 4
+ XmNshadowType XmSHADOW_ETCHED_OUT)))
+
+ (activate-dialog place-sound-dialog)
+ (set! place-sound-envelope (xe-create-enved "panning" fr
+ (list XmNheight 200
+ XmNbottomAttachment XmATTACH_FORM
+ )
+ '(0.0 1.0 0.0 1.0)))
+ (set! (xe-envelope place-sound-envelope) (list 0.0 1.0 1.0 1.0))
+ ))
+
+ (activate-dialog place-sound-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Place sound (~D ~D ~D)"
- mono-snd stereo-snd pan-pos)))
- (change-label child new-label)))
- misc-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "Place sound" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-place-sound-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Place sound (~D ~D ~D)"
+ mono-snd stereo-snd pan-pos)))
+ (change-label child new-label)))
+ misc-menu-list))))
+
+
;;; -------- Insert silence (at cursor, silence-amount in secs)
;;;
-
- (let ((silence-amount 1.0)
- (silence-label "Add silence")
- (silence-dialog #f))
-
- (define (post-silence-dialog)
- (if (not (Widget? silence-dialog))
- ;; if silence-dialog doesn't exist, create it
- (let ((initial-silence-amount 1.0)
- (sliders '()))
- (set! silence-dialog
- (make-effect-dialog
- silence-label
-
- (lambda (w context info)
- (insert-silence (cursor)
- (floor (* (srate) silence-amount))))
-
- (lambda (w context info)
- (help-dialog "Add silence"
- "Move the slider to change the number of seconds of silence added at the cursor position."))
-
- (lambda (w c i)
- (set! silence-amount initial-silence-amount)
- (XtSetValues (car sliders) (list XmNvalue (floor (* silence-amount 100)))))
-
- (lambda ()
- (not (null? (sounds))))))
-
- (set! sliders
- (add-sliders silence-dialog
- (list (list "silence" 0.0 initial-silence-amount 5.0
- (lambda (w context info)
- (set! silence-amount (/ (.value info) 100.0)))
- 100))))))
- (activate-dialog silence-dialog))
-
- (let ((child (XtCreateManagedWidget "Add silence" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((silence-amount 1.0)
+ (silence-label "Add silence")
+ (silence-dialog #f))
+
+ (define (post-silence-dialog)
+ (if (not (Widget? silence-dialog))
+ ;; if silence-dialog doesn't exist, create it
+ (let ((initial-silence-amount 1.0)
+ (sliders ()))
+ (set! silence-dialog
+ (make-effect-dialog
+ silence-label
+
+ (lambda (w context info)
+ (insert-silence (cursor)
+ (floor (* (srate) silence-amount))))
+
+ (lambda (w context info)
+ (help-dialog "Add silence"
+ "Move the slider to change the number of seconds of silence added at the cursor position."))
+
(lambda (w c i)
- (post-silence-dialog)))
+ (set! silence-amount initial-silence-amount)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* silence-amount 100)))))
+
+ (lambda ()
+ (pair? (sounds)))))
+
+ (set! sliders
+ (add-sliders silence-dialog
+ (list (list "silence" 0.0 initial-silence-amount 5.0
+ (lambda (w context info)
+ (set! silence-amount (/ (.value info) 100.0)))
+ 100))))))
+ (activate-dialog silence-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Add silence (~1,2F)" silence-amount)))
- (change-label child new-label)))
- misc-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "Add silence" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-silence-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Add silence (~1,2F)" silence-amount)))
+ (change-label child new-label)))
+ misc-menu-list))))
+
+
;;; -------- Contrast (brightness control)
;;;
-
- (let ((contrast-amount 1.0)
- (contrast-label "Contrast enhancement")
- (contrast-dialog #f)
- (contrast-target 'sound))
-
- (define (post-contrast-dialog)
- (if (not (Widget? contrast-dialog))
- ;; if contrast-dialog doesn't exist, create it
- (let ((initial-contrast-amount 1.0)
- (sliders '()))
- (set! contrast-dialog
- (make-effect-dialog
- contrast-label
-
- (lambda (w context info)
- (let ((peak (maxamp))
- (snd (selected-sound)))
- (save-controls snd)
- (reset-controls snd)
- (set! (contrast-control? snd) #t)
- (set! (contrast-control snd) contrast-amount)
- (set! (contrast-control-amp snd) (/ 1.0 peak))
- (set! (amp-control snd) peak)
- (if (eq? contrast-target 'marks)
- (let ((ms (plausible-mark-samples)))
- (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
- (apply-controls snd (if (eq? contrast-target 'sound) 0 2)))
- (restore-controls snd)))
-
- (lambda (w context info)
- (help-dialog "Contrast enhancement"
- "Move the slider to change the contrast intensity."))
-
- (lambda (w c i)
- (set! contrast-amount initial-contrast-amount)
- (XtSetValues (car sliders) (list XmNvalue (floor (* contrast-amount 100)))))
-
- (lambda ()
- (effect-target-ok contrast-target))))
-
- (set! sliders
- (add-sliders contrast-dialog
- (list (list "contrast enhancement" 0.0 initial-contrast-amount 10.0
- (lambda (w context info)
- (set! contrast-amount (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! contrast-target target)
- (XtSetSensitive (XmMessageBoxGetChild contrast-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog contrast-dialog))
-
- (let ((child (XtCreateManagedWidget "Contrast enhancement" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((contrast-amount 1.0)
+ (contrast-label "Contrast enhancement")
+ (contrast-dialog #f)
+ (contrast-target 'sound))
+
+ (define (post-contrast-dialog)
+ (if (not (Widget? contrast-dialog))
+ ;; if contrast-dialog doesn't exist, create it
+ (let ((initial-contrast-amount 1.0)
+ (sliders ()))
+ (set! contrast-dialog
+ (make-effect-dialog
+ contrast-label
+
+ (lambda (w context info)
+ (let ((peak (maxamp))
+ (snd (selected-sound)))
+ (save-controls snd)
+ (reset-controls snd)
+ (set! (contrast-control? snd) #t)
+ (set! (contrast-control snd) contrast-amount)
+ (set! (contrast-control-amp snd) (/ 1.0 peak))
+ (set! (amp-control snd) peak)
+ (if (eq? contrast-target 'marks)
+ (let ((ms (plausible-mark-samples)))
+ (apply-controls snd 0 (car ms) (+ 1 (- (cadr ms) (car ms)))))
+ (apply-controls snd (if (eq? contrast-target 'sound) 0 2)))
+ (restore-controls snd)))
+
+ (lambda (w context info)
+ (help-dialog "Contrast enhancement"
+ "Move the slider to change the contrast intensity."))
+
(lambda (w c i)
- (post-contrast-dialog)))
+ (set! contrast-amount initial-contrast-amount)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* contrast-amount 100)))))
+
+ (lambda ()
+ (effect-target-ok contrast-target))))
+
+ (set! sliders
+ (add-sliders contrast-dialog
+ (list (list "contrast enhancement" 0.0 initial-contrast-amount 10.0
+ (lambda (w context info)
+ (set! contrast-amount (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! contrast-target target)
+ (XtSetSensitive (XmMessageBoxGetChild contrast-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog contrast-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Contrast enhancement (~1,2F)" contrast-amount)))
- (change-label child new-label)))
- misc-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Contrast enhancement" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-contrast-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Contrast enhancement (~1,2F)" contrast-amount)))
+ (change-label child new-label)))
+ misc-menu-list))))
+
;;; -------- Cross synthesis
;;;
-
- (let ((cross-synth-sound 1)
- (cross-synth-amp .5)
- (cross-synth-fft-size 128)
- (cross-synth-radius 6.0)
- (cross-synth-label "Cross synthesis")
- (cross-synth-dialog #f)
- (cross-synth-default-fft-widget #f)
- (cross-synth-target 'sound))
-
- (define (post-cross-synth-dialog)
- (if (not (Widget? cross-synth-dialog))
- ;; if cross-synth-dialog doesn't exist, create it
- (let ((initial-cross-synth-sound 1)
- (initial-cross-synth-amp .5)
- (initial-cross-synth-fft-size 128)
- (initial-cross-synth-radius 6.0)
- (sliders '()))
- (set! cross-synth-dialog
- (make-effect-dialog
- cross-synth-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (effects-cross-synthesis cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius))
- cross-synth-target
- (lambda (target samps)
- (format #f "effects-cross-synthesis-1 ~A ~A ~A ~A"
- cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius))
- #f))
-
- (lambda (w context info)
- (help-dialog "Cross synthesis"
- "The sliders set the number of the soundfile to be cross-synthesized,
+
+ (let ((cross-synth-sound 1)
+ (cross-synth-amp .5)
+ (cross-synth-fft-size 128)
+ (cross-synth-radius 6.0)
+ (cross-synth-label "Cross synthesis")
+ (cross-synth-dialog #f)
+ (cross-synth-default-fft-widget #f)
+ (cross-synth-target 'sound))
+
+ (define (post-cross-synth-dialog)
+ (if (not (Widget? cross-synth-dialog))
+ ;; if cross-synth-dialog doesn't exist, create it
+ (let ((initial-cross-synth-sound 1)
+ (initial-cross-synth-amp .5)
+ (initial-cross-synth-fft-size 128)
+ (initial-cross-synth-radius 6.0)
+ (sliders ()))
+ (set! cross-synth-dialog
+ (make-effect-dialog
+ cross-synth-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (effects-cross-synthesis cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius))
+ cross-synth-target
+ (lambda (target samps)
+ (format #f "effects-cross-synthesis-1 ~A ~A ~A ~A"
+ cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius))
+ #f))
+
+ (lambda (w context info)
+ (help-dialog "Cross synthesis"
+ "The sliders set the number of the soundfile to be cross-synthesized,
the synthesis amplitude, the FFT size, and the radius value."))
-
- (lambda (w c i)
- (set! cross-synth-sound initial-cross-synth-sound)
- (XtSetValues (list-ref sliders 0) (list XmNvalue cross-synth-sound))
- (set! cross-synth-amp initial-cross-synth-amp)
- (XtSetValues (list-ref sliders 1) (list XmNvalue (floor (* cross-synth-amp 100))))
- (set! cross-synth-fft-size initial-cross-synth-fft-size)
- (if use-combo-box-for-fft-size
- (XtSetValues cross-synth-default-fft-widget (list XmNselectedPosition 1))
- (XmToggleButtonSetState cross-synth-default-fft-widget #t #t))
- (set! cross-synth-radius initial-cross-synth-radius)
- (XtSetValues (list-ref sliders 2) (list XmNvalue (floor (* cross-synth-radius 100)))))
-
- (lambda ()
- (effect-target-ok cross-synth-target))))
-
- (set! sliders
- (add-sliders cross-synth-dialog
- (list (list "input sound" 0 initial-cross-synth-sound 20
- (lambda (w context info)
- (set! cross-synth-sound (.value info)))
- 1)
- (list "amplitude" 0.0 initial-cross-synth-amp 1.0
- (lambda (w context info)
- (set! cross-synth-amp (/ (.value info) 100)))
- 100)
- (list "radius" 0.0 initial-cross-synth-radius 360.0
- (lambda (w context info)
- (set! cross-synth-radius (/ (.value info) 100)))
- 100))))
-
- ;; now add either a radio-button box or a combo-box for the fft size
- ;; need to use XtParent here since "mainform" isn't returned by add-sliders
-
- (if use-combo-box-for-fft-size
- ;; this block creates a "combo box" to handle the fft size
- (let* ((s1 (XmStringCreateLocalized "FFT size"))
- (frame (XtCreateManagedWidget "frame" xmFrameWidgetClass (XtParent (car sliders))
- (list XmNborderWidth 1
- XmNshadowType XmSHADOW_ETCHED_IN
- XmNpositionIndex 2)))
- (frm (XtCreateManagedWidget "frm" xmFormWidgetClass frame
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color))))
- (lab (XtCreateManagedWidget "FFT size" xmLabelWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNlabelString s1
- XmNbackground (basic-color))))
- (fft-labels (map (lambda (n) (XmStringCreateLocalized n)) (list "64" "128" "256" "512" "1024" "4096")))
- (combo (XtCreateManagedWidget "fftsize" xmComboBoxWidgetClass frm
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget lab
+
+ (lambda (w c i)
+ (set! cross-synth-sound initial-cross-synth-sound)
+ (XtSetValues (sliders 0) (list XmNvalue cross-synth-sound))
+ (set! cross-synth-amp initial-cross-synth-amp)
+ (XtSetValues (sliders 1) (list XmNvalue (floor (* cross-synth-amp 100))))
+ (set! cross-synth-fft-size initial-cross-synth-fft-size)
+ (if use-combo-box-for-fft-size ; defined in effects-utils.scm
+ (XtSetValues cross-synth-default-fft-widget (list XmNselectedPosition 1))
+ (XmToggleButtonSetState cross-synth-default-fft-widget #t #t))
+ (set! cross-synth-radius initial-cross-synth-radius)
+ (XtSetValues (sliders 2) (list XmNvalue (floor (* cross-synth-radius 100)))))
+
+ (lambda ()
+ (effect-target-ok cross-synth-target))))
+
+ (set! sliders
+ (add-sliders cross-synth-dialog
+ (list (list "input sound" 0 initial-cross-synth-sound 20
+ (lambda (w context info)
+ (set! cross-synth-sound (.value info)))
+ 1)
+ (list "amplitude" 0.0 initial-cross-synth-amp 1.0
+ (lambda (w context info)
+ (set! cross-synth-amp (/ (.value info) 100)))
+ 100)
+ (list "radius" 0.0 initial-cross-synth-radius 360.0
+ (lambda (w context info)
+ (set! cross-synth-radius (/ (.value info) 100)))
+ 100))))
+
+ ;; now add either a radio-button box or a combo-box for the fft size
+ ;; need to use XtParent here since "mainform" isn't returned by add-sliders
+
+ (if use-combo-box-for-fft-size
+ ;; this block creates a "combo box" to handle the fft size
+ (let* ((s1 (XmStringCreateLocalized "FFT size"))
+ (frame (XtCreateManagedWidget "frame" xmFrameWidgetClass (XtParent (car sliders))
+ (list XmNborderWidth 1
+ XmNshadowType XmSHADOW_ETCHED_IN
+ XmNpositionIndex 2)))
+ (frm (XtCreateManagedWidget "frm" xmFormWidgetClass frame
+ (list XmNleftAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_FORM
XmNtopAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_FORM
- XmNitems fft-labels
- XmNitemCount (length fft-labels)
- XmNcomboBoxType XmDROP_DOWN_COMBO_BOX
- XmNbackground (basic-color)))))
- (set! cross-synth-default-fft-widget combo)
- (for-each (lambda (n) (XmStringFree n)) fft-labels)
- (XmStringFree s1)
- (XtSetValues combo (list XmNselectedPosition 1))
- (XtAddCallback combo XmNselectionCallback
- (lambda (w c i)
- (let* ((selected (.item_or_text i))
- (size-as-string (XmStringUnparse selected #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
- (set! cross-synth-fft-size (string->number size-as-string))))))
-
- ;; this block creates a "radio button box"
- (let* ((s1 (XmStringCreateLocalized "FFT size"))
- (frame (XtCreateManagedWidget "frame" xmFrameWidgetClass (XtParent (car sliders))
- (list XmNborderWidth 1
- XmNshadowType XmSHADOW_ETCHED_IN
- XmNpositionIndex 2)))
- (frm (XtCreateManagedWidget "frm" xmFormWidgetClass frame
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color))))
- (rc (XtCreateManagedWidget "rc" xmRowColumnWidgetClass frm
- (list XmNorientation XmHORIZONTAL
- XmNradioBehavior #t
- XmNradioAlwaysOne #t
- XmNentryClass xmToggleButtonWidgetClass
- XmNisHomogeneous #t
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNbackground (basic-color))))
- (lab (XtCreateManagedWidget "FFT size" xmLabelWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget rc
- XmNbottomAttachment XmATTACH_FORM
- XmNlabelString s1
- XmNalignment XmALIGNMENT_BEGINNING
- XmNbackground (basic-color)))))
- (for-each
- (lambda (size)
- (let ((button (XtCreateManagedWidget (format #f "~D" size) xmToggleButtonWidgetClass rc
- (list XmNbackground (basic-color)
- XmNvalueChangedCallback (list (lambda (w c i)
- (if (.set i)
- (set! cross-synth-fft-size c)))
- size)
- XmNset (= size cross-synth-fft-size)))))
- (if (= size cross-synth-fft-size)
- (set! cross-synth-default-fft-widget button))))
- (list 64 128 256 512 1024 4096))
- (XmStringFree s1)))
-
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! cross-synth-target target)
- (XtSetSensitive (XmMessageBoxGetChild cross-synth-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog cross-synth-dialog))
-
- (let ((child (XtCreateManagedWidget "Cross synthesis" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
- (lambda (w c i)
- (post-cross-synth-dialog)))
+ XmNbackground *basic-color*)))
+ (lab (XtCreateManagedWidget "FFT size" xmLabelWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNlabelString s1
+ XmNbackground *basic-color*)))
+ (fft-labels (map XmStringCreateLocalized (list "64" "128" "256" "512" "1024" "4096")))
+ (combo (XtCreateManagedWidget "fftsize" xmComboBoxWidgetClass frm
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget lab
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNitems fft-labels
+ XmNitemCount (length fft-labels)
+ XmNcomboBoxType XmDROP_DOWN_COMBO_BOX
+ XmNbackground *basic-color*))))
+ (set! cross-synth-default-fft-widget combo)
+ (for-each XmStringFree fft-labels)
+ (XmStringFree s1)
+ (XtSetValues combo (list XmNselectedPosition 1))
+ (XtAddCallback combo XmNselectionCallback
+ (lambda (w c i)
+ (let* ((selected (.item_or_text i))
+ (size-as-string (XmStringUnparse selected #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
+ (set! cross-synth-fft-size (string->number size-as-string))))))
+
+ ;; this block creates a "radio button box"
+ (let* ((s1 (XmStringCreateLocalized "FFT size"))
+ (frame (XtCreateManagedWidget "frame" xmFrameWidgetClass (XtParent (car sliders))
+ (list XmNborderWidth 1
+ XmNshadowType XmSHADOW_ETCHED_IN
+ XmNpositionIndex 2)))
+ (frm (XtCreateManagedWidget "frm" xmFormWidgetClass frame
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNbackground *basic-color*)))
+ (rc (XtCreateManagedWidget "rc" xmRowColumnWidgetClass frm
+ (list XmNorientation XmHORIZONTAL
+ XmNradioBehavior #t
+ XmNradioAlwaysOne #t
+ XmNentryClass xmToggleButtonWidgetClass
+ XmNisHomogeneous #t
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNbackground *basic-color*))))
+ (XtCreateManagedWidget "FFT size" xmLabelWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget rc
+ XmNbottomAttachment XmATTACH_FORM
+ XmNlabelString s1
+ XmNalignment XmALIGNMENT_BEGINNING
+ XmNbackground *basic-color*))
+ (for-each
+ (lambda (size)
+ (let ((button (XtCreateManagedWidget (format #f "~D" size) xmToggleButtonWidgetClass rc
+ (list XmNbackground *basic-color*
+ XmNvalueChangedCallback (list (lambda (w c i)
+ (if (.set i)
+ (set! cross-synth-fft-size c)))
+ size)
+ XmNset (= size cross-synth-fft-size)))))
+ (if (= size cross-synth-fft-size)
+ (set! cross-synth-default-fft-widget button))))
+ (list 64 128 256 512 1024 4096))
+ (XmStringFree s1)))
+
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! cross-synth-target target)
+ (XtSetSensitive (XmMessageBoxGetChild cross-synth-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog cross-synth-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Cross synthesis (~D ~1,2F ~D ~1,2F)"
- cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius)))
- (change-label child new-label)))
- misc-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Cross synthesis" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-cross-synth-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Cross synthesis (~D ~1,2F ~D ~1,2F)"
+ cross-synth-sound cross-synth-amp cross-synth-fft-size cross-synth-radius)))
+ (change-label child new-label)))
+ misc-menu-list))))
+
;;; -------- Flange and phasing
;;;
-
- (let ((flange-speed 2.0)
- (flange-amount 5.0)
- (flange-time 0.001)
- (flange-label "Flange")
- (flange-dialog #f)
- (flange-target 'sound))
-
- (define (post-flange-dialog)
- (if (not (Widget? flange-dialog))
- ;; if flange-dialog doesn't exist, create it
- (let ((initial-flange-speed 2.0)
- (initial-flange-amount 5.0)
- (initial-flange-time 0.001)
- (sliders '()))
- (set! flange-dialog
- (make-effect-dialog
- flange-label
-
- (lambda (w context info)
- (map-chan-over-target-with-sync
- (lambda (ignored)
- (let* ((ri (make-rand-interp :frequency flange-speed :amplitude flange-amount))
- (len (round (* flange-time (srate))))
- (del (make-delay len :max-size (round (+ len flange-amount 1)))))
- (lambda (inval)
- (* .75 (+ inval
- (delay del
- inval
- (rand-interp ri)))))))
- flange-target
- (lambda (target samps)
- (format #f "effects-flange ~A ~A ~A" flange-amount flange-speed flange-time))
- #f))
-
- (lambda (w context info)
- (help-dialog "Flange"
- "Move the sliders to change the flange speed, amount, and time"))
-
- (lambda (w c i)
- (set! flange-speed initial-flange-speed)
- (XtSetValues (car sliders) (list XmNvalue (floor (* flange-speed 10))))
- (set! flange-amount initial-flange-amount)
- (XtSetValues (cadr sliders) (list XmNvalue (floor (* flange-amount 10))))
- (set! flange-time initial-flange-time)
- (XtSetValues (caddr sliders) (list XmNvalue (floor (* flange-time 100)))))
-
- (lambda ()
- (effect-target-ok flange-target))))
-
- (set! sliders
- (add-sliders flange-dialog
- (list (list "flange speed" 0.0 initial-flange-speed 100.0
- (lambda (w context info)
- (set! flange-speed (/ (.value info) 10.0)))
- 10)
- (list "flange amount" 0.0 initial-flange-amount 100.0
- (lambda (w context info)
- (set! flange-amount (/ (.value info) 10.0)))
- 10)
- ;; flange time ought to use a non-linear scale (similar to amp in control panel)
- (list "flange time" 0.0 initial-flange-time 1.0
- (lambda (w context info)
- (set! flange-time (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! flange-target target)
- (XtSetSensitive (XmMessageBoxGetChild flange-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog flange-dialog))
-
- (let ((child (XtCreateManagedWidget "Flange" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((flange-speed 2.0)
+ (flange-amount 5.0)
+ (flange-time 0.001)
+ (flange-label "Flange")
+ (flange-dialog #f)
+ (flange-target 'sound))
+
+ (define (post-flange-dialog)
+ (if (not (Widget? flange-dialog))
+ ;; if flange-dialog doesn't exist, create it
+ (let ((initial-flange-speed 2.0)
+ (initial-flange-amount 5.0)
+ (initial-flange-time 0.001)
+ (sliders ()))
+ (set! flange-dialog
+ (make-effect-dialog
+ flange-label
+
+ (lambda (w context info)
+ (map-chan-over-target-with-sync
+ (lambda (ignored)
+ (let* ((ri (make-rand-interp :frequency flange-speed :amplitude flange-amount))
+ (len (round (* flange-time (srate))))
+ (del (make-delay len :max-size (round (+ len flange-amount 1)))))
+ (lambda (inval)
+ (* .75 (+ inval
+ (delay del
+ inval
+ (rand-interp ri)))))))
+ flange-target
+ (lambda (target samps)
+ (format #f "effects-flange ~A ~A ~A" flange-amount flange-speed flange-time))
+ #f))
+
+ (lambda (w context info)
+ (help-dialog "Flange"
+ "Move the sliders to change the flange speed, amount, and time"))
+
(lambda (w c i)
- (post-flange-dialog)))
+ (set! flange-speed initial-flange-speed)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* flange-speed 10))))
+ (set! flange-amount initial-flange-amount)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor (* flange-amount 10))))
+ (set! flange-time initial-flange-time)
+ (XtSetValues (caddr sliders) (list XmNvalue (floor (* flange-time 100)))))
+
+ (lambda ()
+ (effect-target-ok flange-target))))
+
+ (set! sliders
+ (add-sliders flange-dialog
+ (list (list "flange speed" 0.0 initial-flange-speed 100.0
+ (lambda (w context info)
+ (set! flange-speed (/ (.value info) 10.0)))
+ 10)
+ (list "flange amount" 0.0 initial-flange-amount 100.0
+ (lambda (w context info)
+ (set! flange-amount (/ (.value info) 10.0)))
+ 10)
+ ;; flange time ought to use a non-linear scale (similar to amp in control panel)
+ (list "flange time" 0.0 initial-flange-time 1.0
+ (lambda (w context info)
+ (set! flange-time (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! flange-target target)
+ (XtSetSensitive (XmMessageBoxGetChild flange-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog flange-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Flange (~1,2F ~1,2F ~1,3F)"
- flange-speed flange-amount flange-time)))
- (change-label child new-label)))
- misc-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "Flange" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-flange-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Flange (~1,2F ~1,2F ~1,3F)"
+ flange-speed flange-amount flange-time)))
+ (change-label child new-label)))
+ misc-menu-list))))
+
+
;;; -------- Randomize phase
;;;
;;; (source, progress, target)
-
- (let ((random-phase-amp-scaler 3.14)
- (random-phase-label "Randomize phase")
- (random-phase-dialog #f))
-
- (define (post-random-phase-dialog)
- (if (not (Widget? random-phase-dialog))
- ;; if random-phase-dialog doesn't exist, create it
- (let ((initial-random-phase-amp-scaler 3.14)
- (sliders '()))
- (set! random-phase-dialog
- (make-effect-dialog
- random-phase-label
-
- (lambda (w context info)
- (rotate-phase (lambda (x) (random random-phase-amp-scaler))))
-
- (lambda (w context info)
- (help-dialog "Randomize phase"
- "Move the slider to change the randomization amplitude scaler."))
-
- (lambda (w c i)
- (set! random-phase-amp-scaler initial-random-phase-amp-scaler)
- (XtSetValues (car sliders) (list XmNvalue (floor (* random-phase-amp-scaler 100)))))
-
- (lambda ()
- (not (null? (sounds))))))
-
- (set! sliders
- (add-sliders random-phase-dialog
- (list (list "amplitude scaler" 0.0 initial-random-phase-amp-scaler 100.0
- (lambda (w context info)
- (set! random-phase-amp-scaler (/ (.value info) 100.0)))
- 100))))))
- (activate-dialog random-phase-dialog))
-
- (let ((child (XtCreateManagedWidget "Randomize phase" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((random-phase-amp-scaler 3.14)
+ (random-phase-label "Randomize phase")
+ (random-phase-dialog #f))
+
+ (define (post-random-phase-dialog)
+ (if (not (Widget? random-phase-dialog))
+ ;; if random-phase-dialog doesn't exist, create it
+ (let ((initial-random-phase-amp-scaler 3.14)
+ (sliders ()))
+ (set! random-phase-dialog
+ (make-effect-dialog
+ random-phase-label
+
+ (lambda (w context info)
+ (rotate-phase (lambda (x) (random random-phase-amp-scaler))))
+
+ (lambda (w context info)
+ (help-dialog "Randomize phase"
+ "Move the slider to change the randomization amplitude scaler."))
+
(lambda (w c i)
- (post-random-phase-dialog)))
+ (set! random-phase-amp-scaler initial-random-phase-amp-scaler)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* random-phase-amp-scaler 100)))))
+
+ (lambda ()
+ (pair? (sounds)))))
+
+ (set! sliders
+ (add-sliders random-phase-dialog
+ (list (list "amplitude scaler" 0.0 initial-random-phase-amp-scaler 100.0
+ (lambda (w context info)
+ (set! random-phase-amp-scaler (/ (.value info) 100.0)))
+ 100))))))
+ (activate-dialog random-phase-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Randomize phase (~1,2F)" random-phase-amp-scaler)))
- (change-label child new-label)))
- misc-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Randomize phase" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-random-phase-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Randomize phase (~1,2F)" random-phase-amp-scaler)))
+ (change-label child new-label)))
+ misc-menu-list))))
+
;;; -------- Robotize
;;;
;;; (progress report?)
-
- (let ((samp-rate 1.0)
- (osc-amp 0.3)
- (osc-freq 20)
- (robotize-label "Robotize")
- (robotize-dialog #f)
- (robotize-target 'sound))
-
- (define (post-robotize-dialog)
- (if (not (Widget? robotize-dialog))
- ;; if robotize-dialog doesn't exist, create it
- (let ((initial-samp-rate 1.0)
- (initial-osc-amp 0.3)
- (initial-osc-freq 20)
- (sliders '()))
- (set! robotize-dialog
- (make-effect-dialog
- robotize-label
-
- (lambda (w context info)
- (let ((ms (and (eq? robotize-target 'marks)
- (plausible-mark-samples))))
- (effects-fp samp-rate osc-amp osc-freq
- (if (eq? robotize-target 'sound)
- 0
- (if (eq? robotize-target 'selection)
- (selection-position)
- (car ms)))
- (if (eq? robotize-target 'sound)
- (frames)
- (if (eq? robotize-target 'selection)
- (selection-frames)
- (- (cadr ms) (car ms)))))))
-
- (lambda (w context info)
- (help-dialog "Robotize"
- "Move the sliders to set the sample rate, oscillator amplitude, and oscillator frequency."))
-
- (lambda (w c i)
- (set! samp-rate initial-samp-rate)
- (XtSetValues (car sliders) (list XmNvalue (floor (* samp-rate 100))))
- (set! osc-amp initial-osc-amp)
- (XtSetValues (cadr sliders) (list XmNvalue (floor (* osc-amp 100))))
- (set! osc-freq initial-osc-freq)
- (XtSetValues (caddr sliders) (list XmNvalue (floor (* osc-freq 100)))))
-
- (lambda ()
- (effect-target-ok robotize-target))))
-
- (set! sliders
- (add-sliders robotize-dialog
- (list (list "sample rate" 0.0 initial-samp-rate 2.0
- (lambda (w context info)
- (set! samp-rate (/ (.value info) 100.0)))
- 100)
- (list "oscillator amplitude" 0.0 initial-osc-amp 1.0
- (lambda (w context info)
- (set! osc-amp (/ (.value info) 100.0)))
- 100)
- (list "oscillator frequency" 0.0 initial-osc-freq 60
- (lambda (w context info)
- (set! osc-freq (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! robotize-target target)
- (XtSetSensitive (XmMessageBoxGetChild robotize-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog robotize-dialog))
-
- (let ((child (XtCreateManagedWidget "Robotize" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((samp-rate 1.0)
+ (osc-amp 0.3)
+ (osc-freq 20)
+ (robotize-label "Robotize")
+ (robotize-dialog #f)
+ (robotize-target 'sound))
+
+ (define (post-robotize-dialog)
+ (if (not (Widget? robotize-dialog))
+ ;; if robotize-dialog doesn't exist, create it
+ (let ((initial-samp-rate 1.0)
+ (initial-osc-amp 0.3)
+ (initial-osc-freq 20)
+ (sliders ()))
+ (set! robotize-dialog
+ (make-effect-dialog
+ robotize-label
+
+ (lambda (w context info)
+ (let ((ms (and (eq? robotize-target 'marks)
+ (plausible-mark-samples))))
+ (effects-fp samp-rate osc-amp osc-freq
+ (if (eq? robotize-target 'sound)
+ 0
+ (if (eq? robotize-target 'selection)
+ (selection-position)
+ (car ms)))
+ (if (eq? robotize-target 'sound)
+ (framples)
+ (if (eq? robotize-target 'selection)
+ (selection-framples)
+ (- (cadr ms) (car ms)))))))
+
+ (lambda (w context info)
+ (help-dialog "Robotize"
+ "Move the sliders to set the sample rate, oscillator amplitude, and oscillator frequency."))
+
(lambda (w c i)
- (post-robotize-dialog)))
+ (set! samp-rate initial-samp-rate)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* samp-rate 100))))
+ (set! osc-amp initial-osc-amp)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor (* osc-amp 100))))
+ (set! osc-freq initial-osc-freq)
+ (XtSetValues (caddr sliders) (list XmNvalue (floor (* osc-freq 100)))))
+
+ (lambda ()
+ (effect-target-ok robotize-target))))
+
+ (set! sliders
+ (add-sliders robotize-dialog
+ (list (list "sample rate" 0.0 initial-samp-rate 2.0
+ (lambda (w context info)
+ (set! samp-rate (/ (.value info) 100.0)))
+ 100)
+ (list "oscillator amplitude" 0.0 initial-osc-amp 1.0
+ (lambda (w context info)
+ (set! osc-amp (/ (.value info) 100.0)))
+ 100)
+ (list "oscillator frequency" 0.0 initial-osc-freq 60
+ (lambda (w context info)
+ (set! osc-freq (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! robotize-target target)
+ (XtSetSensitive (XmMessageBoxGetChild robotize-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog robotize-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Robotize (~1,2F ~1,2F ~1,2F)" samp-rate osc-amp osc-freq)))
- (change-label child new-label)))
- misc-menu-list))))
-
+ (let ((child (XtCreateManagedWidget "Robotize" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-robotize-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Robotize (~1,2F ~1,2F ~1,2F)" samp-rate osc-amp osc-freq)))
+ (change-label child new-label)))
+ misc-menu-list))))
+
;;; -------- Rubber sound
;;;
-
- (let ((rubber-factor 1.0)
- (rubber-label "Rubber sound")
- (rubber-dialog #f)
- (rubber-target 'sound))
-
- (define (post-rubber-dialog)
- (if (not (Widget? rubber-dialog))
- ;; if rubber-dialog doesn't exist, create it
- (let ((initial-rubber-factor 1.0)
- (sliders '()))
- (set! rubber-dialog
- (make-effect-dialog
- rubber-label
-
- (lambda (w context info)
- (rubber-sound rubber-factor))
-
- (lambda (w context info)
- (help-dialog "Rubber sound"
- "Stretches or contracts the time of a sound. Move the slider to change the stretch factor."))
-
- (lambda (w c i)
- (set! rubber-factor initial-rubber-factor)
- (XtSetValues (car sliders) (list XmNvalue (floor (* rubber-factor 100)))))
-
- (lambda ()
- (effect-target-ok rubber-target))))
-
- (set! sliders
- (add-sliders rubber-dialog
- (list (list "stretch factor" 0.0 initial-rubber-factor 5.0
- (lambda (w context info)
- (set! rubber-factor (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! rubber-target target)
- (XtSetSensitive (XmMessageBoxGetChild rubber-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
- (activate-dialog rubber-dialog))
-
- (let ((child (XtCreateManagedWidget "Rubber sound" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((rubber-factor 1.0)
+ (rubber-label "Rubber sound")
+ (rubber-dialog #f)
+ (rubber-target 'sound))
+
+ (define (post-rubber-dialog)
+ (if (not (Widget? rubber-dialog))
+ ;; if rubber-dialog doesn't exist, create it
+ (let ((initial-rubber-factor 1.0)
+ (sliders ()))
+ (set! rubber-dialog
+ (make-effect-dialog
+ rubber-label
+
+ (lambda (w context info)
+ (rubber-sound rubber-factor))
+
+ (lambda (w context info)
+ (help-dialog "Rubber sound"
+ "Stretches or contracts the time of a sound. Move the slider to change the stretch factor."))
+
(lambda (w c i)
- (post-rubber-dialog)))
+ (set! rubber-factor initial-rubber-factor)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* rubber-factor 100)))))
+
+ (lambda ()
+ (effect-target-ok rubber-target))))
+
+ (set! sliders
+ (add-sliders rubber-dialog
+ (list (list "stretch factor" 0.0 initial-rubber-factor 5.0
+ (lambda (w context info)
+ (set! rubber-factor (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! rubber-target target)
+ (XtSetSensitive (XmMessageBoxGetChild rubber-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+ (activate-dialog rubber-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Rubber sound (~1,2F)" rubber-factor)))
- (change-label child new-label)))
- misc-menu-list))))
-
-
+ (let ((child (XtCreateManagedWidget "Rubber sound" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-rubber-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Rubber sound (~1,2F)" rubber-factor)))
+ (change-label child new-label)))
+ misc-menu-list))))
+
+
;;; -------- Wobble
;;;
;;; (progress report)
-
- (let ((wobble-frequency 50)
- (wobble-amplitude 0.5)
- (wobble-label "Wobble")
- (wobble-dialog #f)
- (wobble-target 'sound))
-
- (define (post-wobble-dialog)
- (if (not (Widget? wobble-dialog))
- ;; if wobble-dialog doesn't exist, create it
- (let ((initial-wobble-frequency 50)
- (initial-wobble-amplitude 0.5)
- (sliders '()))
- (set! wobble-dialog
- (make-effect-dialog
- wobble-label
-
- (lambda (w context info)
- (let ((ms (and (eq? wobble-target 'marks)
- (plausible-mark-samples))))
- (effects-hello-dentist
- wobble-frequency wobble-amplitude
- (if (eq? wobble-target 'sound)
- 0
- (if (eq? wobble-target 'selection)
- (selection-position)
- (car ms)))
- (if (eq? wobble-target 'sound)
- (frames)
- (if (eq? wobble-target 'selection)
- (selection-frames)
- (- (cadr ms) (car ms)))))))
-
- (lambda (w context info)
- (help-dialog "Wobble"
- "Move the sliders to set the wobble frequency and amplitude."))
-
- (lambda (w c i)
- (set! wobble-frequency initial-wobble-frequency)
- (XtSetValues (car sliders) (list XmNvalue (floor (* wobble-frequency 100))))
- (set! wobble-amplitude initial-wobble-amplitude)
- (XtSetValues (cadr sliders) (list XmNvalue (floor (* wobble-amplitude 100)))))
-
- (lambda ()
- (effect-target-ok wobble-target))))
-
- (set! sliders
- (add-sliders wobble-dialog
- (list (list "wobble frequency" 0 initial-wobble-frequency 100
- (lambda (w context info)
- (set! wobble-frequency (/ (.value info) 100.0)))
- 100)
- (list "wobble amplitude" 0.0 initial-wobble-amplitude 1.0
- (lambda (w context info)
- (set! wobble-amplitude (/ (.value info) 100.0)))
- 100))))
- (add-target (XtParent (car sliders))
- (lambda (target)
- (set! wobble-target target)
- (XtSetSensitive (XmMessageBoxGetChild wobble-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
- #f)))
-
- (activate-dialog wobble-dialog))
-
- (let ((child (XtCreateManagedWidget "Wobble" xmPushButtonWidgetClass misc-menu
- (list XmNbackground (basic-color)))))
- (XtAddCallback child XmNactivateCallback
+
+ (let ((wobble-frequency 50)
+ (wobble-amplitude 0.5)
+ (wobble-label "Wobble")
+ (wobble-dialog #f)
+ (wobble-target 'sound))
+
+ (define (post-wobble-dialog)
+ (if (not (Widget? wobble-dialog))
+ ;; if wobble-dialog doesn't exist, create it
+ (let ((initial-wobble-frequency 50)
+ (initial-wobble-amplitude 0.5)
+ (sliders ()))
+ (set! wobble-dialog
+ (make-effect-dialog
+ wobble-label
+
+ (lambda (w context info)
+ (let ((ms (and (eq? wobble-target 'marks)
+ (plausible-mark-samples))))
+ (effects-hello-dentist
+ wobble-frequency wobble-amplitude
+ (if (eq? wobble-target 'sound)
+ 0
+ (if (eq? wobble-target 'selection)
+ (selection-position)
+ (car ms)))
+ (if (eq? wobble-target 'sound)
+ (framples)
+ (if (eq? wobble-target 'selection)
+ (selection-framples)
+ (- (cadr ms) (car ms)))))))
+
+ (lambda (w context info)
+ (help-dialog "Wobble"
+ "Move the sliders to set the wobble frequency and amplitude."))
+
(lambda (w c i)
- (post-wobble-dialog)))
+ (set! wobble-frequency initial-wobble-frequency)
+ (XtSetValues (car sliders) (list XmNvalue (floor (* wobble-frequency 100))))
+ (set! wobble-amplitude initial-wobble-amplitude)
+ (XtSetValues (cadr sliders) (list XmNvalue (floor (* wobble-amplitude 100)))))
+
+ (lambda ()
+ (effect-target-ok wobble-target))))
+
+ (set! sliders
+ (add-sliders wobble-dialog
+ (list (list "wobble frequency" 0 initial-wobble-frequency 100
+ (lambda (w context info)
+ (set! wobble-frequency (/ (.value info) 100.0)))
+ 100)
+ (list "wobble amplitude" 0.0 initial-wobble-amplitude 1.0
+ (lambda (w context info)
+ (set! wobble-amplitude (/ (.value info) 100.0)))
+ 100))))
+ (add-target (XtParent (car sliders))
+ (lambda (target)
+ (set! wobble-target target)
+ (XtSetSensitive (XmMessageBoxGetChild wobble-dialog XmDIALOG_OK_BUTTON) (effect-target-ok target)))
+ #f)))
+
+ (activate-dialog wobble-dialog))
- (set! misc-menu-list (cons (lambda ()
- (let ((new-label (format #f "Wobble (~1,2F ~1,2F)" wobble-frequency wobble-amplitude)))
- (change-label child new-label)))
- misc-menu-list))))
- )
-
+ (let ((child (XtCreateManagedWidget "Wobble" xmPushButtonWidgetClass misc-menu
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback child XmNactivateCallback
+ (lambda (w c i)
+ (post-wobble-dialog)))
+
+ (set! misc-menu-list (cons (lambda ()
+ (let ((new-label (format #f "Wobble (~1,2F ~1,2F)" wobble-frequency wobble-amplitude)))
+ (change-label child new-label)))
+ misc-menu-list))))
+ )
+
;;;
;;; END PARAMETRIZED EFFECTS
;;;
-
-(add-to-menu effects-menu #f #f)
-(add-to-menu effects-menu "Octave-down" (lambda () (down-oct 2)))
-(add-to-menu effects-menu "Remove clicks"
- (lambda ()
- (define (find-click loc)
- (let ((reader (make-sampler loc))
- (samp0 0.0)
- (samp1 0.0)
- (samp2 0.0)
- (samps (make-vct 10))
- (samps-ctr 0)
- (diff 1.0)
- (len (frames)))
- (call-with-exit
- (lambda (return)
- (do ((ctr loc (+ 1 ctr)))
- ((= ctr len) #f)
- (set! samp0 samp1)
- (set! samp1 samp2)
- (set! samp2 (next-sample reader))
- (vct-set! samps samps-ctr samp0)
- (if (< samps-ctr 9)
- (set! samps-ctr (+ samps-ctr 1))
- (set! samps-ctr 0))
- (let ((local-max (max .1 (vct-peak samps))))
- (if (and (> (abs (- samp0 samp1)) local-max)
- (> (abs (- samp1 samp2)) local-max)
- (< (abs (- samp0 samp2)) (/ local-max 2)))
- (return (- ctr 1)))))))))
-
- (define (remove-click loc)
- (let ((click (find-click loc)))
- (if click
- (begin
- (smooth-sound (- click 2) 4)
- (remove-click (+ click 2))))))
- (remove-click 0)))
-
-(define* (effects-remove-dc snd chn)
- (map-channel
- (let ((lastx 0.0)
- (lasty 0.0))
- (lambda (inval)
- (set! lasty (+ inval (- (* 0.999 lasty) lastx)))
- (set! lastx inval)
- lasty))
- 0 #f snd chn #f "effects-remove-dc"))
-
-(add-to-menu effects-menu "Remove DC" (lambda () (effects-remove-dc)))
-
-(add-to-menu effects-menu "Spiker" (lambda () (spike)))
-
-(define* (effects-compand snd chn)
- (map-channel
- (let* ((tbl (vct -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
- 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000)))
- (lambda (inval)
- (let ((index (+ 8.0 (* 8.0 inval))))
- (array-interp tbl index 17))))
- 0 #f snd chn #f "effects-compand"))
-
-(add-to-menu effects-menu "Compand" (lambda () (effects-compand)))
-
-(add-to-menu effects-menu "Invert" (lambda () (scale-by -1)))
-(add-to-menu effects-menu "Reverse" (lambda () (reverse-sound)))
-(add-to-menu effects-menu "Null phase" (lambda () (zero-phase)))
-
-
+
+ (add-to-menu effects-menu #f #f)
+ (add-to-menu effects-menu "Octave-down" (lambda () (down-oct 2)))
+ (add-to-menu effects-menu "Remove clicks"
+ (lambda ()
+ (define (find-click loc)
+ (let ((reader (make-sampler loc))
+ (mmax (make-moving-max 10))
+ (samp0 0.0)
+ (samp1 0.0)
+ (samp2 0.0)
+ (len (framples)))
+ (call-with-exit
+ (lambda (return)
+ (do ((ctr loc (+ ctr 1)))
+ ((= ctr len) #f)
+ (set! samp0 samp1)
+ (set! samp1 samp2)
+ (set! samp2 (next-sample reader))
+ (let ((local-max (max .1 (moving-max mmax samp0))))
+ (if (and (> (abs (- samp0 samp1)) local-max)
+ (> (abs (- samp1 samp2)) local-max)
+ (< (abs (- samp0 samp2)) (/ local-max 2)))
+ (return (- ctr 1)))))))))
+ (define (remove-click loc)
+ (let ((click (find-click loc)))
+ (if click
+ (begin
+ (smooth-sound (- click 2) 4)
+ (remove-click (+ click 2))))))
+ (remove-click 0)))
+
+ (define* (effects-remove-dc snd chn)
+ (let* ((len (framples snd chn))
+ (data (make-float-vector len))
+ (reader (make-sampler 0 snd chn)))
+ (let ((lastx 0.0)
+ (lasty 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((inval (next-sample reader)))
+ (set! lasty (+ inval (- (* 0.999 lasty) lastx)))
+ (set! lastx inval)
+ (float-vector-set! data i lasty))))
+ (float-vector->channel data 0 len snd chn current-edit-position "effects-remove-dc")))
+
+ (add-to-menu effects-menu "Remove DC" effects-remove-dc)
+
+ (add-to-menu effects-menu "Spiker" spike)
+
+ (define* (effects-compand snd chn)
+ (let ((tbl (float-vector -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250
+ 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000)))
+ (let ((len (framples snd chn)))
+ (let ((reader (make-sampler 0 snd chn))
+ (data (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! data i (array-interp tbl (+ 8.0 (* 8.0 (next-sample reader))) 17)))
+ (float-vector->channel data 0 len snd chn current-edit-position "effects-compand")))))
+
+ (add-to-menu effects-menu "Compand" effects-compand)
+
+ (add-to-menu effects-menu "Invert" (lambda () (scale-by -1)))
+ (add-to-menu effects-menu "Reverse" reverse-sound)
+ (add-to-menu effects-menu "Null phase" zero-phase)
+
+
+ )
\ No newline at end of file
diff --git a/noise.scm b/noise.scm
index 2304642..df6d540 100644
--- a/noise.scm
+++ b/noise.scm
@@ -14,8 +14,7 @@
;;; The "noise" instrument (useful for Oceanic Music):
(provide 'snd-noise.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
+(require snd-ws.scm snd-env.scm)
(define *locsig-type* mus-interp-sinusoidal)
@@ -44,62 +43,64 @@
;; whistle, very broad more of a whoosh. this is basically "simple
;; fm", but the modulating signal is white noise.
- (let* ((beg (seconds->samples startime))
- (end (+ beg (seconds->samples dur)))
- (carrier (make-oscil freq0))
- (modulator (make-rand :frequency rfreq0 :amplitude 1.0))
- (loc (make-locsig :degree degree
- :distance distance
- :reverb reverb-amount
- :type *locsig-type*))
- (dev-0 (hz->radians dev0))
-
- ;; next fix-up troubles in attack and decay times (there are
- ;; lots of ways to handle this -- the basic problem is that
- ;; these durned instruments end up having way too many
- ;; parameters. rick taube's common music replacement for pla
- ;; should help, but just for old time's sake, we'll do it the
- ;; way the ancients did it. (we could also package up this
- ;; stuff in our own function, somewhat like the allvln
- ;; function in vln.clm, leaving the instrument code to apply
- ;; envelopes and other data to some patch).
-
- (amp-attack (attack-point dur ampat ampdc))
- (amp-decay (- 100.0 (attack-point dur ampdc ampat)))
- (freq-attack (attack-point dur freqat freqdc))
- (freq-decay (- 100.0 (attack-point dur freqdc freqat)))
- (dev-attack (attack-point dur devat devdc))
- (dev-decay (- 100.0 (attack-point dur devdc devat)))
- (rfreq-attack (attack-point dur rfreqat rfreqdc))
- (rfreq-decay (- 100.0 (attack-point dur rfreqdc rfreqat)))
-
- ;; now make the actual envelopes -- these all assume we are
- ;; thinking in terms of the "value when the envelope is 1"
- ;; (i.e. dev1 and friends), and the "value when the envelope
- ;; is 0" (i.e. dev0 and friends) -- over the years this
- ;; seemed to make beginners happier than various other ways
- ;; of describing the y-axis behaviour of the envelope. all
- ;; this boiler-plate for envelopes might seem overly
- ;; elaborate when our basic instrument is really simple, but
- ;; in most cases, and this one in particular, nearly all the
- ;; musical interest comes from the envelopes, not the
- ;; somewhat dull spectrum generated by the basic patch.
-
- (dev-f (make-env (stretch-envelope devfun 25 dev-attack 75 dev-decay)
- :duration dur :scaler (hz->radians (- dev1 dev0))))
- (amp-f (make-env (stretch-envelope ampfun 25 amp-attack 75 amp-decay)
- :duration dur :scaler amp))
- (freq-f (make-env (stretch-envelope glissfun 25 freq-attack 75 freq-decay)
- :duration dur :scaler (hz->radians (- freq1 freq0))))
- (rfreq-f (make-env (stretch-envelope rfreqfun 25 rfreq-attack 75 rfreq-decay)
- :duration dur :scaler (hz->radians (- rfreq1 rfreq0)))))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (locsig loc i (* (env amp-f)
- (oscil carrier (+ (env freq-f)
- (* (+ dev-0 (env dev-f))
- (rand modulator (env rfreq-f)))))))))))
+ (let (;; fix-up troubles in attack and decay times (there are
+ ;; lots of ways to handle this -- the basic problem is that
+ ;; these durned instruments end up having way too many
+ ;; parameters. rick taube's common music replacement for pla
+ ;; should help, but just for old time's sake, we'll do it the
+ ;; way the ancients did it. (we could also package up this
+ ;; stuff in our own function, somewhat like the allvln
+ ;; function in vln.clm, leaving the instrument code to apply
+ ;; envelopes and other data to some patch).
+
+ (amp-attack (attack-point dur ampat ampdc))
+ (amp-decay (- 100.0 (attack-point dur ampdc ampat)))
+ (freq-attack (attack-point dur freqat freqdc))
+ (freq-decay (- 100.0 (attack-point dur freqdc freqat)))
+ (dev-attack (attack-point dur devat devdc))
+ (dev-decay (- 100.0 (attack-point dur devdc devat)))
+ (rfreq-attack (attack-point dur rfreqat rfreqdc))
+ (rfreq-decay (- 100.0 (attack-point dur rfreqdc rfreqat))))
+
+ (let ((beg (seconds->samples startime))
+ (end (seconds->samples (+ startime dur)))
+ (carrier (make-oscil freq0))
+ (modulator (make-rand :frequency rfreq0 :amplitude 1.0))
+ (loc (make-locsig :degree degree
+ :distance distance
+ :reverb reverb-amount
+ :type *locsig-type*))
+
+ ;; now make the actual envelopes -- these all assume we are
+ ;; thinking in terms of the "value when the envelope is 1"
+ ;; (i.e. dev1 and friends), and the "value when the envelope
+ ;; is 0" (i.e. dev0 and friends) -- over the years this
+ ;; seemed to make beginners happier than various other ways
+ ;; of describing the y-axis behaviour of the envelope. all
+ ;; this boiler-plate for envelopes might seem overly
+ ;; elaborate when our basic instrument is really simple, but
+ ;; in most cases, and this one in particular, nearly all the
+ ;; musical interest comes from the envelopes, not the
+ ;; somewhat dull spectrum generated by the basic patch.
+
+ (dev-f (make-env (stretch-envelope devfun 25 dev-attack 75 dev-decay)
+ :duration dur
+ :offset (hz->radians dev0)
+ :scaler (hz->radians (- dev1 dev0))))
+ (amp-f (make-env (stretch-envelope ampfun 25 amp-attack 75 amp-decay)
+ :duration dur :scaler amp))
+ (freq-f (make-env (stretch-envelope glissfun 25 freq-attack 75 freq-decay)
+ :duration dur :scaler (hz->radians (- freq1 freq0))))
+ (rfreq-f (make-env (stretch-envelope rfreqfun 25 rfreq-attack 75 rfreq-decay)
+ :duration dur :scaler (hz->radians (- rfreq1 rfreq0)))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (locsig loc i (* (env amp-f)
+ (oscil carrier (+ (env freq-f)
+ (* (env dev-f) (rand modulator (env rfreq-f)))))))))))
+
+;;; (with-sound () (fm-noise 0 0.5 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1 1000 '(0 0 100 1) 0.1 0.1 10 1000 '(0 0 100 1) 0 0 100 500 '(0 0 100 1) 0 0))
+
;; (let* ((ofile "test.snd")
;; (snd (find-sound ofile)))
@@ -133,9 +134,10 @@
(devfun '(0 0 100 1))
(devat 0)
(devdc 0)
- (degree (random 90.0))
- (distance 1.0)
- (reverb-amount 0.005))
+; (degree (random 90.0))
+; (distance 1.0)
+; (reverb-amount 0.005)
+ )
(let* ((dur (/ len (floor (srate))))
(amp-attack (attack-point dur ampat ampdc))
(amp-decay (- 100.0 (attack-point dur ampdc ampat)))
@@ -170,20 +172,26 @@
;; (outfile "test.snd")
;; (snd (find-sound outfile))
;; (loc (make-locsig :degree (random 3535.0) :channels chns))
-;; (data (vct-map! (make-vct len) (make-fm-noise len 500))))
+;; (data (make-float-vector len)))
+;; (do ((i 0 (+ i 1)))
+;; ((= i len))
+;; (set! (data i) (make-fm-noise len 500)))
;; (if snd
;; (close-sound snd))
-;; (set! snd (new-sound outfile mus-next mus-bshort (mus-srate) chns))
-;; (do ((i 0 (+ 1 i)))
+;; (set! snd (new-sound outfile chns *clm-srate* mus-bshort mus-next))
+;; (do ((i 0 (+ i 1)))
;; ((= i chns))
-;; (mix-vct (vct-scale! (vct-copy data) (locsig-ref loc i)) beg snd i #f))
+;; (mix-float-vector (float-vector-scale! (copy data) (locsig-ref loc i)) beg snd i #f))
;; (let* ((beg (floor (* 10 (srate))))
;; (len (+ beg (floor (* dur (srate)))))
;; (loc (make-locsig :degree (random 3535.0) :channels chns))
-;; (data (vct-map! (make-vct len) (make-fm-noise len 200))))
-;; (do ((i 0 (+ 1 i)))
+;; (data (make-float-vector len)))
+;; (do ((i 0 (+ i 1)))
+;; ((= i len))
+;; (set! (data i) (make-fm-noise len 200)))
+;; (do ((i 0 (+ i 1)))
;; ((= i chns))
-;; (mix-vct (vct-scale! (vct-copy data) (locsig-ref loc i)) beg snd i #f))
+;; (mix-float-vector (float-vector-scale! (copy data) (locsig-ref loc i)) beg snd i #f))
;; (play snd 0)))
;; noise.scm ends here
diff --git a/nrev.scm b/nrev.scm
index 5fca1ab..0010c20 100644
--- a/nrev.scm
+++ b/nrev.scm
@@ -2,72 +2,74 @@
(provide 'snd-nrev.scm)
-(if (and (not (provided? 'snd-ws.scm))
- (not (provided? 'sndlib-ws.scm)))
- (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(definstrument (nrev (reverb-factor 1.09) (lp-coeff 0.7) (volume 1.0))
;; reverb-factor controls the length of the decay -- it should not exceed (/ 1.0 .823)
;; lp-coeff controls the strength of the low pass filter inserted in the feedback loop
;; output-scale can be used to boost the reverb output
- (define (prime? val)
- (or (= val 2)
- (and (odd? val)
- (do ((i 3 (+ i 2))
- (lim (sqrt val)))
- ((or (= 0 (modulo val i)) (> i lim))
- (> i lim))))))
- (define (next-prime val)
- (if (prime? val)
- val
- (next-prime (+ val 2))))
-
- (let* ((srscale (/ (mus-srate) 25641))
- (val 0)
- (dly-len (list 1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19)))
- (do ((i 0 (+ i 1)))
- ((= i 15))
- (let ((val (floor (* srscale (list-ref dly-len i)))))
- (if (even? val) (set! val (+ 1 val)))
- (list-set! dly-len i (next-prime val))))
- (let* ((len (+ (mus-srate) (frames *reverb*)))
- (comb1 (make-comb (* .822 reverb-factor) (list-ref dly-len 0)))
- (comb2 (make-comb (* .802 reverb-factor) (list-ref dly-len 1)))
- (comb3 (make-comb (* .773 reverb-factor) (list-ref dly-len 2)))
- (comb4 (make-comb (* .753 reverb-factor) (list-ref dly-len 3)))
- (comb5 (make-comb (* .753 reverb-factor) (list-ref dly-len 4)))
- (comb6 (make-comb (* .733 reverb-factor) (list-ref dly-len 5)))
+ (let ((dly-len (if (= (floor *clm-srate*) 44100)
+ (vector 2467 2753 3217 3533 3877 4127 599 197 67 101 97 73 67 53 37)
+ (and (= (floor *clm-srate*) 22050)
+ (vector 1237 1381 1607 1777 1949 2063 307 97 31 53 47 37 31 29 17))))
+ (chan2 (> (channels *output*) 1))
+ (chan4 (= (channels *output*) 4)))
+
+ (if (not dly-len)
+ (let ((srscale (/ *clm-srate* 25641)))
+ (define (prime? val)
+ (or (= val 2)
+ (and (odd? val)
+ (do ((i 3 (+ i 2))
+ (lim (sqrt val)))
+ ((or (= 0 (modulo val i)) (> i lim))
+ (> i lim))))))
+ (define (next-prime val)
+ (if (prime? val)
+ val
+ (next-prime (+ val 2))))
+ (set! dly-len (vector 1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19))
+ (do ((i 0 (+ i 1)))
+ ((= i 15))
+ (let ((val (floor (* srscale (dly-len i)))))
+ (if (even? val) (set! val (+ val 1)))
+ (set! (dly-len i) (next-prime val))))))
+
+ (let ((len (+ (floor *clm-srate*) (framples *reverb*)))
+ (comb1 (make-comb (* .822 reverb-factor) (dly-len 0)))
+ (comb2 (make-comb (* .802 reverb-factor) (dly-len 1)))
+ (comb3 (make-comb (* .773 reverb-factor) (dly-len 2)))
+ (comb4 (make-comb (* .753 reverb-factor) (dly-len 3)))
+ (comb5 (make-comb (* .753 reverb-factor) (dly-len 4)))
+ (comb6 (make-comb (* .733 reverb-factor) (dly-len 5)))
(low (make-one-pole lp-coeff (- lp-coeff 1.0)))
- (chan2 (> (channels *output*) 1))
- (chan4 (= (channels *output*) 4))
- (allpass1 (make-all-pass -0.700 0.700 (list-ref dly-len 6)))
- (allpass2 (make-all-pass -0.700 0.700 (list-ref dly-len 7)))
- (allpass3 (make-all-pass -0.700 0.700 (list-ref dly-len 8)))
- (allpass4 (make-all-pass -0.700 0.700 (list-ref dly-len 9))) ; 10 for quad
- (allpass5 (make-all-pass -0.700 0.700 (list-ref dly-len 11)))
- (allpass6 (if chan2 (make-all-pass -0.700 0.700 (list-ref dly-len 12)) #f))
- (allpass7 (if chan4 (make-all-pass -0.700 0.700 (list-ref dly-len 13)) #f))
- (allpass8 (if chan4 (make-all-pass -0.700 0.700 (list-ref dly-len 14)) #f)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i len))
- (let* ((rev (* volume (ina i *reverb*)))
- (outrev (all-pass allpass4
- (one-pole low
- (all-pass allpass3
- (all-pass allpass2
- (all-pass allpass1
- (+ (comb comb1 rev)
- (comb comb2 rev)
- (comb comb3 rev)
- (comb comb4 rev)
- (comb comb5 rev)
- (comb comb6 rev)))))))))
- (outa i (all-pass allpass5 outrev))
- (if chan2 (outb i (all-pass allpass6 outrev)))
- (if chan4 (outc i (all-pass allpass7 outrev)))
- (if chan4 (outd i (all-pass allpass8 outrev)))))))))
+ (allpass1 (make-all-pass -0.700 0.700 (dly-len 6)))
+ (allpass2 (make-all-pass -0.700 0.700 (dly-len 7)))
+ (allpass3 (make-all-pass -0.700 0.700 (dly-len 8)))
+ (allpass4 (make-all-pass -0.700 0.700 (dly-len 9))) ; 10 for quad
+ (allpass5 (make-all-pass -0.700 0.700 (dly-len 11)))
+ (allpass6 (and chan2 (make-all-pass -0.700 0.700 (dly-len 12))))
+ (allpass7 (and chan4 (make-all-pass -0.700 0.700 (dly-len 13))))
+ (allpass8 (and chan4 (make-all-pass -0.700 0.700 (dly-len 14)))))
+ (let ((filts (if (not chan2)
+ (vector allpass5)
+ (if (not chan4)
+ (vector allpass5 allpass6)
+ (vector allpass5 allpass6 allpass7 allpass8))))
+ (combs (make-comb-bank (vector comb1 comb2 comb3 comb4 comb5 comb6)))
+ (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (out-bank filts i
+ (all-pass allpass4
+ (one-pole low
+ (all-pass-bank allpasses
+ (comb-bank combs (* volume (ina i *reverb*))))))))))))
+
+;;; (with-sound (:reverb nrev) (outa 0 .1) (outa 0 .5 *reverb*))
diff --git a/numerics.scm b/numerics.scm
index 756523e..e058304 100644
--- a/numerics.scm
+++ b/numerics.scm
@@ -1,5 +1,11 @@
(provide 'snd-numerics.scm)
+(when (provided? 'pure-s7)
+ (define (make-polar mag ang)
+ (if (and (real? mag) (real? ang))
+ (complex (* mag (cos ang)) (* mag (sin ang)))
+ (error 'wrong-type-arg "make-polar args should be real"))))
+
;;; random stuff I needed at one time or another while goofing around...
;;; there are a lot more in snd-test.scm
@@ -15,32 +21,56 @@
(old-facts factorials))
(set! num-factorials n)
(set! factorials (make-vector num-factorials 0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i old-num))
(set! (factorials i) (old-facts i)))))
(if (zero? (factorials n))
(set! (factorials n) (* n (factorial (- n 1)))))
(factorials n))))
-(define (binomial-direct n m) ; "n-choose-m" might be a better name (there are much better ways to compute this -- see below)
+#|
+;;; maxima uses this:
+
+;; From Richard Fateman's paper, "Comments on Factorial Programs",
+;; http://www.cs.berkeley.edu/~fateman/papers/factorial.pdf
+;;
+;; k(n,m) = n*(n-m)*(n-2*m)*...
+;;
+;; (k n 1) is n!
+;;
+;; This is much faster (3-4 times) than the original factorial
+;; function.
+
+(define (factorial n)
+ (define (k n m)
+ (if (<= n m)
+ n
+ (* (k n (* 2 m))
+ (k (- n m) (* 2 m)))))
+ (if (zero? n)
+ 1
+ (k n 1)))
+|#
+
+(define (binomial-direct n m)
(/ (factorial n)
(* (factorial m) (factorial (- n m)))))
-(define (n-choose-k n k)
- "(n-choose-k n k) computes the binomial coefficient C(N,K)"
- (let ((mn (min k (- n k))))
- (if (< mn 0)
- 0
- (if (= mn 0)
- 1
- (let* ((mx (max k (- n k)))
- (cnk (+ 1 mx)))
- (do ((i 2 (+ 1 i)))
- ((> i mn) cnk)
- (set! cnk (/ (* cnk (+ mx i)) i))))))))
-
-(define binomial n-choose-k)
-
+(define n-choose-k
+ (let ((documentation "(n-choose-k n k) computes the binomial coefficient C(N,K)"))
+ (lambda (n k)
+ (let ((mn (min k (- n k))))
+ (if (< mn 0)
+ 0
+ (if (= mn 0)
+ 1
+ (let* ((mx (max k (- n k)))
+ (cnk (+ 1 mx)))
+ (do ((i 2 (+ i 1)))
+ ((> i mn) cnk)
+ (set! cnk (/ (* cnk (+ mx i)) i))))))))))
+
+
;;; --------------------------------------------------------------------------------
;;; from Numerical Recipes
@@ -57,7 +87,7 @@
(begin
(set! somx2 (sqrt (* (- 1.0 x) (+ 1.0 x))))
(set! fact 1.0)
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((> i m))
(set! pmm (* (- pmm) fact somx2))
(set! fact (+ fact 2.0)))))
@@ -67,7 +97,7 @@
(if (= l (+ m 1))
pmmp1
(let ((pk 0.0)) ; NR used "ll" which is unreadable
- (do ((k (+ m 2) (+ 1 k)))
+ (do ((k (+ m 2) (+ k 1)))
((> k l))
(set! pk (/ (- (* x (- (* 2 k) 1) pmmp1)
(* (+ k m -1) pmm))
@@ -82,11 +112,11 @@
(let ((n (- (length a) 1)))
(if (= n 0)
(a 0)
- (let* ((r x)
- (s 1.0)
- (h 0.0)
- (sum (a 0)))
- (do ((k 1 (+ 1 k)))
+ (let ((r x)
+ (s 1.0)
+ (h 0.0)
+ (sum (a 0)))
+ (do ((k 1 (+ k 1)))
((= k n))
(set! h r)
(set! sum (+ sum (* r (a k))))
@@ -100,12 +130,12 @@
v)
x))
-;;; (with-sound (:scaled-to 0.5) (do ((i 0 (+ 1 i)) (x 0.0 (+ x .1))) ((= i 10000)) (outa i (legendre 20 (cos x)))))
+;;; (with-sound (:scaled-to 0.5) (do ((i 0 (+ i 1)) (x 0.0 (+ x .1))) ((= i 10000)) (outa i (legendre 20 (cos x)))))
#|
;; if l odd, there seems to be sign confusion:
(with-sound (:channels 2 :scaled-to 1.0)
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(theta 0.0 (+ theta 0.01)))
((= i 10000))
(outa i (plgndr 1 1 (cos theta)))
@@ -114,7 +144,7 @@
;; this works:
(with-sound (:channels 2 :scaled-to 1.0)
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(theta 0.0 (+ theta 0.01)))
((= i 10000))
(let ((x (cos theta)))
@@ -139,7 +169,7 @@
(fn2 1.0))
(if (= n 1)
fn1
- (do ((k 2 (+ 1 k))
+ (do ((k 2 (+ k 1))
(k0 2.0 (+ k0 1.0)))
((> k n) fn)
(set! fn (/ (- (* 2 x fn1 (+ k alpha -1.0))
@@ -149,11 +179,11 @@
(set! fn1 fn)))))))))
-;;; (with-sound (:scaled-to 0.5) (do ((i 0 (+ 1 i)) (x 0.0 (+ x .1))) ((= i 10000)) (outa i (gegenbauer 15 (cos x) 1.0))))
+;;; (with-sound (:scaled-to 0.5) (do ((i 0 (+ i 1)) (x 0.0 (+ x .1))) ((= i 10000)) (outa i (gegenbauer 15 (cos x) 1.0))))
#|
(with-sound (:scaled-to 0.5)
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(theta 0.0 (+ theta 0.05)))
((= i 10000))
(let ((x (cos theta)))
@@ -165,11 +195,11 @@
(let ((n (- (length a) 1)))
(if (= n 0)
(a 0)
- (let* ((r (* kind x))
- (s 1.0)
- (h 0.0)
- (sum (a 0)))
- (do ((k 1 (+ 1 k)))
+ (let ((r (* kind x))
+ (s 1.0)
+ (h 0.0)
+ (sum (a 0)))
+ (do ((k 1 (+ k 1)))
((= k n))
(set! h r)
(set! sum (+ sum (* r (a k))))
@@ -187,11 +217,11 @@
(let ((n (- (length a) 1)))
(if (= n 0)
(a 0)
- (let* ((r (* 2 x))
- (s 1.0)
- (h 0.0)
- (sum (a 0)))
- (do ((k 1 (+ 1 k))
+ (let ((r (* 2 x))
+ (s 1.0)
+ (h 0.0)
+ (sum (a 0)))
+ (do ((k 1 (+ k 1))
(k2 2 (+ k2 2)))
((= k n))
(set! h r)
@@ -210,11 +240,11 @@
(let ((n (- (length a) 1)))
(if (= n 0)
(a 0)
- (let* ((r (- (+ alpha 1.0) x))
- (s 1.0)
- (h 0.0)
- (sum (a 0)))
- (do ((k 1 (+ 1 k)))
+ (let ((r (- (+ alpha 1.0) x))
+ (s 1.0)
+ (h 0.0)
+ (sum (a 0)))
+ (do ((k 1 (+ k 1)))
((= k n))
(set! h r)
(set! sum (+ sum (* r (a k))))
@@ -241,17 +271,18 @@
;;; most cases won't work right because we're assuming real output and so on
(define* (automorph a b c d snd chn)
- (let* ((len (frames snd chn))
- (pow2 (ceiling (/ (log len) (log 2))))
+ (let* ((len (framples snd chn))
+ (pow2 (ceiling (log len 2)))
(fftlen (floor (expt 2 pow2)))
+ (fftlen2 (/ fftlen 2))
(fftscale (/ 1.0 fftlen))
- (rl (channel->vct 0 fftlen snd chn))
- (im (make-vct fftlen)))
+ (rl (channel->float-vector 0 fftlen snd chn))
+ (im (make-float-vector fftlen)))
(fft rl im 1)
- (vct-scale! rl fftscale)
- (vct-scale! im fftscale)
+ (float-vector-scale! rl fftscale)
+ (float-vector-scale! im fftscale)
;; handle 0 case by itself
- (let* ((c1 (make-rectangular (rl 0) (im 0)))
+ (let* ((c1 (complex (rl 0) (im 0)))
(val (/ (+ (* a c1) b)
(+ (* c c1) d)))
(rval (real-part val))
@@ -260,8 +291,8 @@
(set! (im 0) ival))
(do ((i 1 (+ i 1))
(k (- fftlen 1) (- k 1)))
- ((= i (/ fftlen 2)))
- (let* ((c1 (make-rectangular (rl i) (im i)))
+ ((= i fftlen2))
+ (let* ((c1 (complex (rl i) (im i)))
(val (/ (+ (* a c1) b) ; (az + b) / (cz + d)
(+ (* c c1) d)))
(rval (real-part val))
@@ -271,15 +302,17 @@
(set! (rl k) rval)
(set! (im k) (- ival))))
(fft rl im -1)
- (vct->channel rl 0 len snd chn #f (format #f "automorph ~A ~A ~A ~A" a b c d))))
+ (float-vector->channel rl 0 len snd chn #f (format #f "automorph ~A ~A ~A ~A" a b c d))))
|#
+#|
;;; --------------------------------------------------------------------------------
+;;; these are in snd-xen.c??
(define (bes-i1 x) ;I1(x)
(if (< (abs x) 3.75)
- (let* ((y (expt (/ x 3.75) 2)))
+ (let ((y (expt (/ x 3.75) 2)))
(* x (+ 0.5
(* y (+ 0.87890594
(* y (+ 0.51498869
@@ -330,6 +363,7 @@
(if (= j n) (set! ans bip)))
(if (and (< x 0.0) (odd? n)) (set! ans (- ans)))
(* ans (/ (bes-i0 x) bi)))))))
+|#
;;; --------------------------------------------------------------------------------
@@ -347,13 +381,13 @@
(define (Si x)
(if (>= x 1.0)
(- (/ pi 2) (* (cos x) (aux-f x)) (* (sin x) (aux-g x)))
- (let* ((sum x)
- (fact 2.0)
- (one -1.0)
- (xs x)
- (x2 (* x x))
- (err .000001)
- (unhappy #t))
+ (let ((sum x)
+ (fact 2.0)
+ (one -1.0)
+ (xs x)
+ (x2 (* x x))
+ (err .000001)
+ (unhappy #t))
(do ((i 3.0 (+ i 2.0)))
((not unhappy))
(set! xs (/ (* one x2 xs) (* i fact)))
@@ -367,14 +401,14 @@
(define (Ci x)
(if (>= x 1.0)
(- (* (sin x) (aux-f x)) (* (cos x) (aux-g x)))
- (let* ((g .5772156649)
- (sum 0.0)
- (fact 1.0)
- (one -1.0)
- (xs 1.0)
- (x2 (* x x))
- (err .000001)
- (unhappy #t))
+ (let ((g .5772156649)
+ (sum 0.0)
+ (fact 1.0)
+ (one -1.0)
+ (xs 1.0)
+ (x2 (* x x))
+ (err .000001)
+ (unhappy #t))
(do ((i 2.0 (+ i 2.0)))
((not unhappy))
(set! xs (/ (* one x2 xs) (* i fact)))
@@ -417,8 +451,7 @@
(/ (* 2.0 sum2 (factorial n)
(if (= (modulo n 4) 0) -1 1))
(expt (* 2.0 pi) n))))))
- (set! (saved-values n) value)
- value)))))
+ (set! (saved-values n) value))))))
(define (bernoulli-poly n x)
(let ((fact 1.0)
@@ -675,7 +708,7 @@
(do ((i 0 (+ i 1)))
((= i nhx))
(set! y (* 16.0 (- y (floor y))))
- (string-set! chx i (string-ref hx (floor y))))
+ (set! (chx i) (hx (floor y))))
chx))
(define expm
@@ -790,7 +823,7 @@
;;; --------------------------------------------------------------------------------
-(define* (sin-nx-peak n (error 1e-12))
+(define* (sin-nx-peak n (err 1e-12))
;; return the min peak amp and its location for sin(x)+sin(nx+a)
(let* ((size (* n 100))
(incr (/ (* 2 pi) size))
@@ -806,10 +839,9 @@
(set! peak val)
(set! location x)))))
;; now narrow it by zigzagging around the peak
- (let ((zig-size (* incr 2))
- (x location))
+ (let ((x location))
(do ((zig-size (* incr 2) (/ zig-size 2)))
- ((< zig-size error))
+ ((< zig-size err))
(let ((cur (abs (+ (sin x) (sin (+ offset (* n x))))))
(left (abs (+ (sin (- x zig-size)) (sin (+ (* n (- x zig-size)) offset))))))
(if (< left cur)
@@ -818,3 +850,10 @@
(set! x (+ x zig-size))))
(set! x (- x zig-size)))))
(list (abs (+ (sin x) (sin (+ (* n x) offset)))) x))))
+
+;;; --------------------------------------------------------------------------------
+
+(define (exptmod a b n) ; from the net somewhere: (modulo (expt a b) n)
+ (cond ((zero? b) 1)
+ ((even? b) (exptmod (modulo (* a a) n) (quotient b 2) n))
+ (else (modulo (* a (exptmod (modulo (* a a) n) (quotient b 2) n)) n))))
diff --git a/oscope.scm b/oscope.scm
deleted file mode 100644
index 73862dc..0000000
--- a/oscope.scm
+++ /dev/null
@@ -1,233 +0,0 @@
-;;; a software oscilloscope using the standard Snd channel display interface
-
-(provide 'snd-oscope.scm)
-
-(define audio-srate 44100) ; graph's sampling rate
-(define max-cycle 8192) ; maximum size in samples of the displayed buffer
-(define cycle-length 1024) ; initial cycle length
-
-
-(if (provided? 'snd-motif)
- (if (not (provided? 'xm))
- (let ((hxm (dlopen "xm.so")))
- (if (string? hxm)
- (snd-error (format #f "oscope.scm needs the xm module (either 'make xm' or build Snd with --with-static-xm): ~A" hxm))
- (dlinit hxm "Init_libxm"))))
- (if (provided? 'snd-gtk)
- (if (not (provided? 'xg))
- (let ((hxm (dlopen "xg.so")))
- (if (string? hxm)
- (snd-error (format #f "oscope.scm needs the xg module (either 'make xg' or build Snd with --with-static-xg): ~A" hxm))
- (dlinit hxm "Init_libxg"))))))
-
-(define red-pixel
- (if (provided? 'snd-motif)
- (let ((pix #f))
- (lambda ()
- (if (not pix)
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr))
- (col (XColor)))
- (if (= (XAllocNamedColor dpy cmap "red" col col) 0)
- (snd-error "can't allocate red!")
- (set! pix (.pixel col)))))
- pix))
- #f))
-
-(define oscope-dialog #f)
-(define oscope-input-data (make-sound-data 1 256))
-(define cycle-start 0)
-(define oscope-power #f)
-(define oscope-frozen #f)
-(define oscope-input-port #f)
-(define oscope-graph-data #f)
-(define oscope-input-frames #f)
-(define oscope-graph #f)
-
-(define (power-func off-func)
- (set! oscope-power (not oscope-power))
- (if oscope-power
- (begin
- (set! oscope-input-port (mus-audio-open-input 0 audio-srate 1 mus-lshort 512))
- (if (not (= oscope-input-port -1))
- (begin
- (do ()
- ((not oscope-power))
- (mus-audio-read oscope-input-port oscope-input-data oscope-input-frames)
- (if (not oscope-frozen)
- (begin
- (set! cycle-start (sound-data->sound-data oscope-input-data oscope-graph-data cycle-start oscope-input-frames cycle-length))
- (if (< cycle-start oscope-input-frames)
- (begin
- (if (time-graph? oscope-graph 0) (update-time-graph oscope-graph 0))
- (if (transform-graph? oscope-graph 0) (update-transform-graph oscope-graph 0)))))))
- (if oscope-power
- (begin
- (off-func)
- (set! oscope-power #f)))
- (mus-audio-close oscope-input-port))
- (snd-print ";can't open audio input?"))))
- #f)
-
-(define (freeze-func)
- (set! oscope-frozen (not oscope-frozen))
- (if oscope-frozen
- (begin
- (if (time-graph? oscope-graph 0) (update-time-graph oscope-graph 0))
- (if (transform-graph? oscope-graph 0) (update-transform-graph oscope-graph 0))))
- #f)
-
-(define (cycle-func size)
- (let ((old-length cycle-length)
- (old-frozen oscope-frozen))
- (set! oscope-frozen #t)
- (set! cycle-length size)
- (set! cycle-start 0)
- (if (< cycle-length old-length)
- (do ((i cycle-length (+ 1 i)))
- ((>= i old-length))
- (sound-data-set! oscope-graph-data 0 i 0.0)))
- (set! oscope-frozen old-frozen)
- #f))
-
-
-(if (provided? 'snd-motif)
- ;; -------- motif case --------
- (define (make-oscope)
- (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Oscilloscope" XmFONTLIST_DEFAULT_TAG)))
- (set! oscope-dialog (XmCreateTemplateDialog (cadr (main-widgets)) "oscilloscope"
- (list XmNokLabelString xdismiss
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNtransient #f
- XmNheight 600
- XmNwidth 800
- XmNbackground (basic-color))))
- (XtVaSetValues (XmMessageBoxGetChild oscope-dialog XmDIALOG_OK_BUTTON)
- (list XmNarmColor (selection-color)
- XmNbackground (highlight-color)))
- (XtAddCallback oscope-dialog
- XmNokCallback (lambda (w context info)
- (set! oscope-power #f)
- (XtUnmanageChild oscope-dialog)))
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (XtManageChild oscope-dialog)
- (let* ((toppane (XtCreateManagedWidget "oscope-pane" xmFormWidgetClass oscope-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild oscope-dialog XmDIALOG_SEPARATOR))))
- (bottom-row (XtCreateManagedWidget "oscope-row" xmRowColumnWidgetClass toppane
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_NONE
- XmNbottomAttachment XmATTACH_FORM
- XmNorientation XmVERTICAL)))
- (prow (XtCreateManagedWidget "oscope-row" xmRowColumnWidgetClass bottom-row
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNorientation XmHORIZONTAL
- XmNbackground (basic-color))))
- (power-button (XtCreateManagedWidget "power" xmToggleButtonWidgetClass prow
- (list XmNbackground (basic-color)
- XmNselectColor (red-pixel))))
- (freeze-button (XtCreateManagedWidget "freeze" xmToggleButtonWidgetClass prow
- (list XmNbackground (basic-color)
- XmNselectColor (red-pixel))))
- (cycle-title (XmStringCreate "cycle length" XmFONTLIST_DEFAULT_TAG))
- (cycle (XtCreateManagedWidget "oscope-cycle" xmScaleWidgetClass bottom-row
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNminimum 32
- XmNmaximum max-cycle
- XmNvalue cycle-length
- XmNdecimalPoints 0
- XmNtitleString cycle-title
- XmNbackground (basic-color))))
- (mainform (XtCreateManagedWidget "oscope-form" xmFormWidgetClass toppane
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget bottom-row
- XmNbackground (basic-color)))))
- (set! oscope-graph (make-variable-graph mainform "input" max-cycle audio-srate))
- (set! oscope-graph-data (channel-data oscope-graph 0))
- (set! oscope-input-frames 256)
- (set! (right-sample oscope-graph 0) cycle-length)
- (set! (max-transform-peaks oscope-graph 0) 10)
- (XtAddCallback cycle XmNvalueChangedCallback (lambda (w context info) (set! cycle-length (.value info))))
- (XtAddCallback cycle XmNdragCallback (lambda (w context info) (cycle-func (.value info))))
- (XtAddCallback freeze-button XmNvalueChangedCallback (lambda (w context info) (freeze-func)))
- (XtAddCallback power-button XmNvalueChangedCallback
- (lambda (w context info)
- (power-func (lambda ()
- (XmToggleButtonSetValue power-button XmUNSET #f)))))
- (list oscope-graph oscope-graph-data))))
-
- ;; -------- gtk case --------
- (define (make-oscope)
- (let ((dismiss-button (gtk_button_new_with_label "Go Away")))
- (gtk_widget_set_name dismiss-button "quit_button")
- (set! oscope-dialog (gtk_dialog_new))
- (gtk_window_set_title (GTK_WINDOW oscope-dialog) "Oscilloscope")
- (gtk_container_set_border_width (GTK_CONTAINER oscope-dialog) 10)
- (gtk_window_set_default_size (GTK_WINDOW oscope-dialog) 800 600)
- (gtk_window_set_resizable (GTK_WINDOW oscope-dialog) #t)
- (gtk_widget_realize oscope-dialog)
- (g_signal_connect oscope-dialog "delete_event" (lambda (w ev data)
- (set! oscope-power #f)
- (gtk_widget_hide oscope-dialog)
- #t)
- #f)
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG oscope-dialog))) dismiss-button #t #t 10)
- (g_signal_connect dismiss-button "clicked" (lambda (w data)
- (set! oscope-power #f)
- (gtk_widget_hide oscope-dialog))
- #f)
- (gtk_widget_show dismiss-button)
- ;; to change button color: gtk_widget_modify_base(w, GTK_STATE_NORMAL, col);
- ;; gtk_widget_modify_base(w, GTK_STATE_PRELIGHT, col);
- (let ((mainform (gtk_dialog_get_content_area (GTK_DIALOG oscope-dialog))))
- (set! oscope-graph (make-variable-graph mainform "input" max-cycle audio-srate))
- (let* ((hbox (gtk_hbox_new #f 0))
- (power-button (gtk_toggle_button_new_with_label "power"))
- (freeze-button (gtk_toggle_button_new_with_label "freeze")))
- (set! oscope-graph-data (channel-data oscope-graph 0))
- (set! oscope-input-frames 256)
- (gtk_box_pack_start (GTK_BOX mainform) hbox #f #f 4)
- (gtk_widget_show hbox)
- (gtk_box_pack_start (GTK_BOX hbox) power-button #f #f 6)
- (gtk_box_pack_start (GTK_BOX hbox) freeze-button #f #f 6)
- (gtk_widget_show power-button)
- (gtk_widget_show freeze-button)
- (let* ((adj (gtk_adjustment_new cycle-length 32 max-cycle 1.0 10.0 1.0))
- (scale (gtk_hscale_new (GTK_ADJUSTMENT adj)))
- (label (gtk_label_new "cycle length")))
- (if (not (provided? 'gtk3)) (gtk_range_set_update_policy (GTK_RANGE (GTK_SCALE scale)) GTK_UPDATE_CONTINUOUS))
- (gtk_scale_set_digits (GTK_SCALE scale) 0)
- (gtk_scale_set_value_pos (GTK_SCALE scale) GTK_POS_TOP)
- (gtk_scale_set_draw_value (GTK_SCALE scale) #t)
- (gtk_box_pack_start (GTK_BOX mainform) scale #f #f 0)
- (gtk_widget_show scale)
- (gtk_box_pack_start (GTK_BOX mainform) label #f #f 0)
- (gtk_widget_show label)
- (g_signal_connect adj "value_changed" (lambda (w d) (cycle-func (floor (gtk_adjustment_get_value (GTK_ADJUSTMENT adj)))) #f))
- (set! (right-sample oscope-graph 0) cycle-length)
- (set! (max-transform-peaks oscope-graph 0) 10)
- (g_signal_connect freeze-button "toggled" (lambda (w d) (freeze-func) #f))
- (g_signal_connect power-button "toggled" (lambda (w d) (power-func (lambda () #f)) #f))
- (gtk_widget_show_all oscope-dialog)
- (list oscope-graph oscope-graph-data)))))))
-
-(define oscope (make-oscope))
-
diff --git a/peak-phases.scm b/peak-phases.scm
index bb0909d..a3afe28 100644
--- a/peak-phases.scm
+++ b/peak-phases.scm
@@ -2,20 +2,25 @@
(load "primes.scm")
;;; multiply these phases by pi before use as initial-phases (and use sin, not cos -- see tstall below)
+;;; to translate these peaks into the more standard crest-factor, (/ (* peak (sqrt 2)) (sqrt N))
+;;; in the all harmonics case, these go from 1.356 (20) to 1.406 (106) leaving aside N<8
+;;; the square root => sqrt(2), so 1.414 is not good.
+
+(define fv float-vector)
;;; ---------------------------------------- all harmonics ----------------------------------------
(define noid-min-peak-phases (vector
-#(1 1.0 #(0))
-#(2 1.76 #(0 0))
+(vector 1 1.0 (fv 0))
+(vector 2 1.76 (fv 0 0))
;; the 1.76 can be calculated (given here that 0 is the min)
;; take derivative of sin(x) + sin(2x) = cos(x) + 2cos(2x)
;; use cos(2x) = 2cos^2(x) - 1 to turn this into a quadratic polynomial in cos(x)
;; 4cos^2(x) + cos(x) - 2
-;; let x be cos(x), quadratic formula gives (-1 + sqrt(33))/8, [poly-roots (vct -2 1 4) -> (0.59307033081725 -0.84307033081725)]
+;; let x be cos(x), quadratic formula gives (-1 + sqrt(33))/8, [poly-roots (float-vector -2 1 4) -> (0.59307033081725 -0.84307033081725)]
;; take acos of that to get cos(x):
;; (acos (+ -1/8 (/ (sqrt (+ 1 32)) 8))) -> 0.93592945566133
;; plug that into the original:
@@ -47,3372 +52,3280 @@
;;; 3 all --------------------------------------------------------------------------------
-#(3 2.1949383250709 #(0 0 1)
+(vector 3 2.1949383250709 (fv 0 0 1)
- 1.9798054823226 #(0.0 5.897251124274717204443163609539624303579E-1 3.166675693251937984129540382127743214369E-1)
- 1.9798054823222 #(0.0 4.102748875720859667026729766803327947855E-1 1.683332430673265878162681019603041931987E0)
- 1.9798054823226 #(0.0 1.58972511242745917492413809668505564332E0 3.166675693251493894919690319511573761702E-1)
- 1.9798054823222 #(0.0 1.410274887572085966702672976680332794785E0 1.683332430673265878162681019603041931987E0)
+ 1.9798054823226 (fv 0.0 5.897251124274717204443163609539624303579E-1 3.166675693251937984129540382127743214369E-1)
+ 1.9798054823222 (fv 0.0 4.102748875720859667026729766803327947855E-1 1.683332430673265878162681019603041931987E0)
+ 1.9798054823226 (fv 0.0 1.58972511242745917492413809668505564332E0 3.166675693251493894919690319511573761702E-1)
+ 1.9798054823222 (fv 0.0 1.410274887572085966702672976680332794785E0 1.683332430673265878162681019603041931987E0)
- ;; :(tstall '#(0 62/39 19/60))
+ ;; :(tstall (fv 0 62/39 19/60))
;; (1.979860844111887127172689015942912379187E0 5.5534000000004)
- ;; same for #(0 23/39 19/60), always the case (it's symmetric in the 2nd), sin(x) +/- sin(2x + a) + sin(3x + b)
- ;; :(tstall #(0.0 5.897251124274717204443163609539624303579E-1 3.166675693251937984129540382127743214369E-1) 0.0000001)
+ ;; same for (fv 0 23/39 19/60), always the case (it's symmetric in the 2nd), sin(x) +/- sin(2x + a) + sin(3x + b)
+ ;; :(tstall (fv 0.0 5.897251124274717204443163609539624303579E-1 3.166675693251937984129540382127743214369E-1) 0.0000001)
;; (1.979806197137575924716806491964687429097E0 0.1714663000039)
- 1.9797181063317 #(0.0 0.41022177723939 1.6832780274654)
- 1.979716725384 #(0.0 1.5897793760084 0.31672588155614)
- 1.9797162690553 #(0.0 1.4102202429311 1.6832728267862)
+ 1.9797181063317 (fv 0.0 0.41022177723939 1.6832780274654)
+ 1.979716725384 (fv 0.0 1.5897793760084 0.31672588155614)
+ 1.9797162690553 (fv 0.0 1.4102202429311 1.6832728267862)
+
+ ;; polynomial is surprisingly good:
+ ;; :all 3 (fv 1.9797767193773 0.066455282926612 1.7863254855475)
+
+ ;; big fft
+ 1.979806 #(0.000000 0.410275 1.683332)
)
;;; 4 all --------------------------------------------------------------------------------
-#(4 2.2962718935302 #(0 1 1 1)
+(vector 4 2.2962718935302 (fv 0 1 1 1)
- 2.040 #(0 33/35 67/50 10/9) ;#(0 1/9 17/24 71/36) -- 2.04242
- 2.04012799263 #(0.000 0.072 0.674 1.912)
- 2.04012799263 #(0.000 0.928 1.326 1.088)
- 2.04012799263 #(0.000 1.072 0.674 0.912)
- 2.04012799263 #(0.000 1.928 1.326 0.088)
+ 2.040 (fv 0 33/35 67/50 10/9) ;(vector 0 1/9 17/24 71/36) -- 2.04242
+ 2.04012799263 (fv 0.000 0.072 0.674 1.912)
+ 2.04012799263 (fv 0.000 0.928 1.326 1.088)
+ 2.04012799263 (fv 0.000 1.072 0.674 0.912)
+ 2.04012799263 (fv 0.000 1.928 1.326 0.088)
- 2.0392323180235 #(0.0 9.429973765023149656627765580196864902973E-1 1.340090256365081833322960846999194473028E0 1.112605206055434337031329050660133361816E0)
+ 2.0392323180235 (fv 0.0 9.429973765023149656627765580196864902973E-1 1.340090256365081833322960846999194473028E0 1.112605206055434337031329050660133361816E0)
- 2.038956 #(0.000000 0.944585 1.341508 1.115059)
- 2.038954 #(0.000000 1.055406 0.658486 0.884929)
- 2.038954 #(0.000000 0.055405 0.658485 1.884926)
- 2.038954 #(0.000000 1.944593 1.341515 0.115071)
+ 2.038956 (fv 0.000000 0.944585 1.341508 1.115059)
+ 2.038954 (fv 0.000000 1.055406 0.658486 0.884929)
+ 2.038954 (fv 0.000000 0.055405 0.658485 1.884926)
+ 2.038954 (fv 0.000000 1.944593 1.341515 0.115071)
+
+ ;; :all 4 (fv 2.060278672942 -0.70579973196553 0.90455920034382)
+ ;; big fft
+ 2.039104 #(0.000000 0.055486 0.658542 1.885004)
+ 2.039103 #(0.000000 0.055488 0.658545 1.885009)
)
;;; 5 all -------------------------------------------------------------------------------- ; 2.23
-#(5 2.5405211753511 #(0 1 0 0 0)
+(vector 5 2.5405211753511 (fv 0 1 0 0 0)
- 2.3434929847717 #(0.0 0.84531772136688 1.6645057201385 1.4203575849533 1.5933285951614)
- 2.3434844481891 #(0.0 1.8453152570243 1.6649825491504 0.42142125263938 1.5942588576594)
+ 2.3434929847717 (fv 0.0 0.84531772136688 1.6645057201385 1.4203575849533 1.5933285951614)
+ 2.3434844481891 (fv 0.0 1.8453152570243 1.6649825491504 0.42142125263938 1.5942588576594)
- 2.343549 #(0.000000 1.845237 1.664402 0.420189 1.593154)
- 2.343533 #(0.000000 1.154716 0.335535 0.579695 0.406714)
- 2.343497 #(0.000000 0.845320 1.664496 1.420334 1.593308)
+ 2.343549 (fv 0.000000 1.845237 1.664402 0.420189 1.593154)
+ 2.343533 (fv 0.000000 1.154716 0.335535 0.579695 0.406714)
+ 2.343497 (fv 0.000000 0.845320 1.664496 1.420334 1.593308)
- 2.343527 #(0.000000 0.154667 0.335503 1.579672 0.406698)
- 2.343513 #(0.000000 0.154687 0.335490 1.579647 0.406677)
- 2.343508 #(0.000000 1.845332 1.664532 0.420369 1.593338)
+ 2.343527 (fv 0.000000 0.154667 0.335503 1.579672 0.406698)
+ 2.343513 (fv 0.000000 0.154687 0.335490 1.579647 0.406677)
+ 2.343508 (fv 0.000000 1.845332 1.664532 0.420369 1.593338)
+
+ ;; pp:
+ 2.343485 (fv 0.000000 1.154683 0.335509 0.579687 0.406716)
)
;;; 6 all -------------------------------------------------------------------------------- ; 2.4494
-#(6 2.8200183503167 #(0 0 0 0 1 0)
+(vector 6 2.8200183503167 (fv 0 0 0 0 1 0)
- 2.5598928928375 #(0.0 0.91140931844711 0.34124284982681 1.3568490743637 1.4451304674149 1.2563138008118)
- 2.5509102344513 #(0.0 0.88722838124921 0.26020415169852 1.2966409163042 1.3233535939997 1.15281977798)
- 2.5493413065822 #(0.0 0.88655948906463 0.26426014425456 1.3003055923199 1.3306838066896 1.1573162129407)
+ 2.5598928928375 (fv 0.0 0.91140931844711 0.34124284982681 1.3568490743637 1.4451304674149 1.2563138008118)
+ 2.5509102344513 (fv 0.0 0.88722838124921 0.26020415169852 1.2966409163042 1.3233535939997 1.15281977798)
+ 2.5493413065822 (fv 0.0 0.88655948906463 0.26426014425456 1.3003055923199 1.3306838066896 1.1573162129407)
- 2.549466 #(0.000000 1.113453 1.735461 0.699472 0.668803 0.842320)
- 2.549414 #(0.000000 0.886661 0.264519 1.300599 1.331194 1.157723)
- 2.549386 #(0.000000 0.113427 1.735535 1.699526 0.668940 1.842412)
- 2.549385 #(0.000000 1.886568 0.264458 0.300485 1.331039 0.157570)
- 2.549360 #(0.000000 0.886491 0.264319 1.300337 1.330828 1.157371)
+ 2.549466 (fv 0.000000 1.113453 1.735461 0.699472 0.668803 0.842320)
+ 2.549414 (fv 0.000000 0.886661 0.264519 1.300599 1.331194 1.157723)
+ 2.549386 (fv 0.000000 0.113427 1.735535 1.699526 0.668940 1.842412)
+ 2.549385 (fv 0.000000 1.886568 0.264458 0.300485 1.331039 0.157570)
+ 2.549360 (fv 0.000000 0.886491 0.264319 1.300337 1.330828 1.157371)
)
;;; 7 all -------------------------------------------------------------------------------- ; 2.64575
-#(7 3.072141248417 #(0 0 0 1 1 0 1)
+(vector 7 3.072141248417 (fv 0 0 0 1 1 0 1)
- 2.639426 #(0.000000 0.904980 0.986109 1.721148 1.291116 1.621443 0.966099)
- 2.639402 #(0.000000 0.095202 1.014213 1.278914 0.709149 1.378847 1.034223)
- 2.639371 #(0.000000 1.095652 1.014884 0.279318 0.709755 0.379605 1.035166)
- 2.639364 #(0.000000 1.904695 0.985719 0.720925 1.290796 0.621014 0.965536)
+ 2.639426 (fv 0.000000 0.904980 0.986109 1.721148 1.291116 1.621443 0.966099)
+ 2.639402 (fv 0.000000 0.095202 1.014213 1.278914 0.709149 1.378847 1.034223)
+ 2.639371 (fv 0.000000 1.095652 1.014884 0.279318 0.709755 0.379605 1.035166)
+ 2.639364 (fv 0.000000 1.904695 0.985719 0.720925 1.290796 0.621014 0.965536)
)
;;; 8 all -------------------------------------------------------------------------------- ; 2.8284
-#(8 3.5725696916739 #(0 1 0 0 0 0 1 1)
- 3.4905790371793 #(0 1 0 0 1 1 1 0)
+(vector 8 3.4905790371793 (fv 0 1 0 0 1 1 1 0)
+
+ 2.795099 (fv 0.000000 1.333103 1.192134 0.394213 1.162609 1.955320 1.855302 0.126169)
+ 2.794748 (fv 0.000000 0.333225 1.192073 1.394414 1.162519 0.954914 1.855082 1.126189)
+ 2.794737 (fv 0.000000 1.666686 0.807757 0.605305 0.837099 1.044558 0.144428 0.873255)
+ 2.794719 (fv 0.000000 0.666709 0.807769 1.605408 0.837217 0.044625 0.144433 1.873342)
+ 2.794585 (fv 0.000000 0.666699 0.807707 1.605285 0.837106 0.044540 0.144374 1.873180)
- 2.795099 #(0.000000 1.333103 1.192134 0.394213 1.162609 1.955320 1.855302 0.126169)
- 2.794748 #(0.000000 0.333225 1.192073 1.394414 1.162519 0.954914 1.855082 1.126189)
- 2.794737 #(0.000000 1.666686 0.807757 0.605305 0.837099 1.044558 0.144428 0.873255)
- 2.794719 #(0.000000 0.666709 0.807769 1.605408 0.837217 0.044625 0.144433 1.873342)
+ ;; pp:
+ 2.880745 (fv 0.000000 0.873927 1.696839 1.009332 0.354675 0.227015 0.156852 0.523641)
+ ;; big fft
+ 2.794684 #(0.000000 0.333223 1.192169 1.394521 1.162690 0.955202 1.855341 1.126445)
)
;;; 9 all --------------------------------------------------------------------------------
-#(9 3.7118878501776 #(0 0 0 0 1 0 0 0 1)
- 3.5954569026984 #(0 1 1 0 1 0 1 1 1)
+(vector 9 3.5954569026984 (fv 0 1 1 0 1 0 1 1 1)
- 2.962087 #(0.000000 0.872517 1.501013 0.464057 -0.056897 1.063020 1.251698 1.436014 1.254131)
- 2.962094 #(0.000000 1.127564 0.498862 1.535743 0.056794 0.936657 0.748023 0.563510 0.745376)
- 2.962065 #(0.000000 -0.127444 1.501316 1.464492 -0.056263 0.063823 1.252240 0.437075 1.255320)
- 2.961916 #(0.000000 0.127632 0.498978 0.536080 0.057253 -0.062716 0.748729 1.564172 0.746161)
- 2.961829 #(0.000000 1.872309 1.500693 1.463585 1.942384 0.062267 1.250564 0.435026 1.252813)
+ 2.962087 (fv 0.000000 0.872517 1.501013 0.464057 -0.056897 1.063020 1.251698 1.436014 1.254131)
+ 2.962094 (fv 0.000000 1.127564 0.498862 1.535743 0.056794 0.936657 0.748023 0.563510 0.745376)
+ 2.962065 (fv 0.000000 -0.127444 1.501316 1.464492 -0.056263 0.063823 1.252240 0.437075 1.255320)
+ 2.961916 (fv 0.000000 0.127632 0.498978 0.536080 0.057253 -0.062716 0.748729 1.564172 0.746161)
+ 2.961829 (fv 0.000000 1.872309 1.500693 1.463585 1.942384 0.062267 1.250564 0.435026 1.252813)
+ 2.961652 (fv 0.000000 1.872337 1.500914 1.463820 1.942618 0.062504 1.251193 0.435609 1.253539)
+
+ ;; pp:
+ 2.961653 (fv 0.000000 0.872337 1.500915 0.463821 1.942617 1.062504 1.251196 1.435614 1.253542)
)
;;; 10 all -------------------------------------------------------------------------------- ; 3.162
-#(10 3.8132503352626 #(0 1 0 1 0 0 0 0 0 1)
- 3.7726427002737 #(0 1 1 0 0 0 0 1 0 1)
- 3.7587492407668 #(0 1 1 0 1 1 1 0 0 0)
- 3.7587492407668 #(0 0 1 1 1 0 1 1 0 1)
+(vector 10 3.7587492407668 (fv 0 1 1 0 1 1 1 0 0 0)
+
+ 3.102964 (fv 0.000000 0.071632 0.396251 0.504925 0.052683 0.212597 1.057168 -0.172275 1.102043 0.501144)
+ 3.102823 (fv 0.000000 1.070629 0.394872 1.503703 0.050925 1.211208 1.054650 0.825637 1.099957 1.498128)
+ 3.102782 (fv 0.000000 0.927743 1.602314 0.494139 -0.054832 0.785103 0.940332 1.169212 0.894844 0.494709)
+ 3.102734 (fv 0.000000 1.928606 1.603786 1.495372 -0.052790 1.786999 0.942669 0.172108 0.897837 1.498611)
+ 3.102303 (fv 0.000000 -0.071891 1.603086 1.494633 -0.053985 1.786024 0.941426 0.170569 0.896122 1.496522)
- 3.102964 #(0.000000 0.071632 0.396251 0.504925 0.052683 0.212597 1.057168 -0.172275 1.102043 0.501144)
- 3.102823 #(0.000000 1.070629 0.394872 1.503703 0.050925 1.211208 1.054650 0.825637 1.099957 1.498128)
- 3.102782 #(0.000000 0.927743 1.602314 0.494139 -0.054832 0.785103 0.940332 1.169212 0.894844 0.494709)
- 3.102734 #(0.000000 1.928606 1.603786 1.495372 -0.052790 1.786999 0.942669 0.172108 0.897837 1.498611)
- 3.102729 #(0.000000 -0.072172 1.602638 1.494434 -0.054524 1.785698 0.940876 0.169981 0.895530 1.495531)
- 3.102679 #(0.000000 -0.071505 1.603768 1.495148 -0.052966 1.786780 0.942656 0.171631 0.897221 1.498092)
+ ;; pp:
+ 3.270687 (fv 0.000000 1.665169 -0.138115 1.364203 0.226693 -0.150959 1.661874 0.514042 1.098209 1.445028)
)
;;; 11 all -------------------------------------------------------------------------------- ; 3.31662
-#(11 4.0969838225299 #(0 0 1 1 0 0 0 0 1 0 1)
- 4.0506916989601 #(0 0 0 1 1 1 1 0 1 1 0)
- 3.8018732822274 #(0 1 0 0 1 0 0 0 1 1 1)
- 3.8018732822274 #(0 0 0 1 1 1 0 1 1 0 1)
+(vector 11 3.8018732822274 (fv 0 1 0 0 1 0 0 0 1 1 1)
- 3.218779 #(0.000000 1.481192 0.090871 1.382649 0.458289 0.338680 0.056042 0.328676 0.834049 1.786486 1.800056)
- 3.218745 #(0.000000 1.518100 1.908924 1.617043 1.540909 0.660141 -0.056826 0.670660 1.165195 1.212229 0.198401)
- 3.218587 #(0.000000 0.518100 1.908924 0.617043 1.540909 1.660141 -0.056826 1.670660 1.165195 0.212229 0.198401)
- 3.218514 #(0.000000 0.481786 0.091759 0.383540 0.459429 1.340439 0.058075 1.330988 0.836240 0.789345 -0.196819)
- 3.218444 #(0.000000 0.482127 0.090769 0.383093 0.459045 1.339823 0.056682 1.328792 0.834826 0.787716 -0.199032)
+ 3.218745 (fv 0.000000 1.518100 1.908924 1.617043 1.540909 0.660141 -0.056826 0.670660 1.165195 1.212229 0.198401)
+ 3.218587 (fv 0.000000 0.518100 1.908924 0.617043 1.540909 1.660141 -0.056826 1.670660 1.165195 0.212229 0.198401)
+ 3.218514 (fv 0.000000 0.481786 0.091759 0.383540 0.459429 1.340439 0.058075 1.330988 0.836240 0.789345 -0.196819)
+ 3.218444 (fv 0.000000 0.482127 0.090769 0.383093 0.459045 1.339823 0.056682 1.328792 0.834826 0.787716 -0.199032)
+ 3.217965 (fv 0.000000 0.482287 0.091029 0.383292 0.459507 1.340271 0.057231 1.329368 0.835616 0.788459 -0.198129)
+
+ ;; pp:
+ 3.468683 (fv 0.000000 0.627804 1.366835 0.412917 1.258123 0.658181 0.350130 1.736695 1.823585 1.864191 0.254629)
)
;;; 12 all -------------------------------------------------------------------------------- ; 3.464
-#(12 3.761 #(0 0 1 1 0 0 0 0 0 1 0 1)
- 3.7616552322386 #(0 1 1 0 0 1 0 1 0 0 0 0)
+(vector 12 3.7616552322386 (fv 0 1 1 0 0 1 0 1 0 0 0 0)
+
+ 3.389586 (fv 0.000000 0.076743 0.348321 0.615321 0.763893 0.188090 0.117764 1.147735 1.461927 0.591300 1.497863 0.867456)
+ 3.389547 (fv 0.000000 -0.079085 1.648740 1.380212 1.228354 1.804105 1.875295 0.844196 0.527781 1.396624 0.490362 1.119947)
+ 3.389430 (fv 0.000000 1.081078 0.354514 1.624157 0.776410 1.200581 0.129241 0.162495 1.480822 1.614178 1.518801 1.892528)
+ 3.389128 (fv 0.000000 1.076659 0.348730 1.615059 0.764020 1.188577 0.117561 0.148053 1.462454 1.591386 1.497945 1.868055)
+ 3.388654 (fv 0.000000 1.076620 0.347797 1.614462 0.764164 1.188107 0.116910 0.147164 1.461571 1.590619 1.496557 1.866148)
- 3.390214 #(0.000000 1.090729 0.365806 1.643109 0.802167 1.224244 0.152508 0.190760 1.518783 1.662203 1.561813 -0.056814)
- 3.389584 #(0.000000 0.081158 0.353056 0.623087 0.775861 0.199327 0.127597 1.160276 1.479330 0.612404 1.515935 0.889377)
- 3.389586 #(0.000000 0.076743 0.348321 0.615321 0.763893 0.188090 0.117764 1.147735 1.461927 0.591300 1.497863 0.867456)
- 3.389547 #(0.000000 -0.079085 1.648740 1.380212 1.228354 1.804105 1.875295 0.844196 0.527781 1.396624 0.490362 1.119947)
- 3.389430 #(0.000000 1.081078 0.354514 1.624157 0.776410 1.200581 0.129241 0.162495 1.480822 1.614178 1.518801 1.892528)
- 3.389128 #(0.000000 1.076659 0.348730 1.615059 0.764020 1.188577 0.117561 0.148053 1.462454 1.591386 1.497945 1.868055)
+ ;; pp:
+ 3.546003 (fv 0.000000 0.813150 -1.878303 1.450426 -0.112095 -1.110299 -0.487466 -0.181683 0.060170 -0.004101 -0.103775 -0.960524)
)
;;; 13 all -------------------------------------------------------------------------------- ; 3.6055
-#(13 4.2969298731102 #(0 1 0 1 0 0 1 1 0 0 0 0 0)
- 4.1211657406183 #(0 0 0 0 0 0 1 1 0 0 1 0 1)
+(vector 13 4.1211657406183 (fv 0 0 0 0 0 0 1 1 0 0 1 0 1)
- 3.525309 #(0.000000 1.051846 0.170520 1.635159 0.455907 1.511384 -0.147127 1.055447 1.000548 0.097871 0.005880 0.160672 0.616896)
- 3.525164 #(0.000000 0.947554 1.827637 0.362791 1.540717 0.485315 0.143016 0.940517 0.994364 1.896615 -0.012058 1.833412 1.375539)
- 3.525069 #(0.000000 0.947187 1.827546 0.362752 1.541123 0.485247 0.142279 0.941021 0.994821 1.896143 -0.012766 1.832600 1.375866)
+ 3.525309 (fv 0.000000 1.051846 0.170520 1.635159 0.455907 1.511384 -0.147127 1.055447 1.000548 0.097871 0.005880 0.160672 0.616896)
+ 3.525164 (fv 0.000000 0.947554 1.827637 0.362791 1.540717 0.485315 0.143016 0.940517 0.994364 1.896615 -0.012058 1.833412 1.375539)
+ 3.525069 (fv 0.000000 0.947187 1.827546 0.362752 1.541123 0.485247 0.142279 0.941021 0.994821 1.896143 -0.012766 1.832600 1.375866)
;; tstall (flip odds):
- 3.5254909 #(0.000000 0.051846 0.170520 0.635159 0.455907 0.511384 -0.147127 0.055447 1.000548 1.097871 0.005880 1.160672 0.616896)
+ 3.5254909 (fv 0.000000 0.051846 0.170520 0.635159 0.455907 0.511384 -0.147127 0.055447 1.000548 1.097871 0.005880 1.160672 0.616896)
- 3.525038 #(0.000000 0.946517 1.827042 0.361916 1.539603 0.484426 0.141403 0.938505 0.992273 1.893878 -0.015423 1.830018 1.372777)
- 3.524879 #(0.000000 0.948502 1.829668 0.364984 1.544240 0.488687 0.147763 0.945396 1.000061 1.903153 -0.004551 1.840699 1.384079)
+ 3.525038 (fv 0.000000 0.946517 1.827042 0.361916 1.539603 0.484426 0.141403 0.938505 0.992273 1.893878 -0.015423 1.830018 1.372777)
+ 3.524879 (fv 0.000000 0.948502 1.829668 0.364984 1.544240 0.488687 0.147763 0.945396 1.000061 1.903153 -0.004551 1.840699 1.384079)
+ 3.524127 (fv 0.000000 0.948325 1.829839 0.364837 1.544231 0.489035 0.147691 0.944940 1.000036 1.902764 -0.004752 1.840449 1.384160)
+
+ ;; pp:
+ 3.850623 (fv 0.000000 0.969515 0.236902 1.700081 1.532485 1.012414 0.716276 0.879825 0.831162 1.111747 1.357361 -0.014630 0.962342)
)
;;; 14 all -------------------------------------------------------------------------------- ; 3.7416
-#(14 4.3488449994701 #(0 0 1 1 0 1 0 1 1 0 0 0 0 0)
- 4.1603193984251 #(0 1 0 1 1 0 1 0 0 0 1 0 0 0)
+(vector 14 4.1603193984251 (fv 0 1 0 1 1 0 1 0 0 0 1 0 0 0)
+
+ 3.613280 (fv 0.000000 0.028982 0.530538 0.496734 -0.474935 -0.580078 0.104750 1.488617 -0.565757 -0.157842 -1.258035 -0.057079 0.253472 -0.294346)
+ 3.613121 (fv 0.000000 0.028974 0.530453 0.496128 -0.475742 -0.580534 0.104588 -0.512201 1.433649 1.841085 0.741103 -0.058374 0.252301 -0.295482)
+ 3.612244 (fv 0.000000 0.028654 0.530107 0.495786 -0.476137 -0.581023 0.103729 -0.513152 1.433095 1.840437 0.739729 -0.059420 0.251093 -0.296875)
- 3.615056 #(0.000000 -0.014234 1.497005 1.525139 0.510798 0.632906 1.943720 0.571193 0.639383 0.229407 1.337049 0.146893 1.848962 0.407090)
- 3.613339 #(0.000000 1.024769 1.581138 0.589649 0.616118 1.792590 0.082043 1.743552 0.858157 1.441060 1.566137 1.409695 0.151752 1.740508)
- 3.613280 #(0.000000 0.028982 0.530538 0.496734 -0.474935 -0.580078 0.104750 1.488617 -0.565757 -0.157842 -1.258035 -0.057079 0.253472 -0.294346)
- 3.613121 #(0.000000 0.028974 0.530453 0.496128 -0.475742 -0.580534 0.104588 -0.512201 1.433649 1.841085 0.741103 -0.058374 0.252301 -0.295482)
+ ;; pp:
+ 3.738333 (fv 0.000000 0.876144 1.749283 0.255257 1.233908 0.925717 1.713300 0.790918 0.423428 0.079568 -0.060539 0.064404 0.601933 0.291808)
)
;;; 15 all -------------------------------------------------------------------------------- ; 3.8729
-#(15 4.4060654286219 #(0 1 0 1 0 1 1 1 1 1 0 1 1 0 0) ; 3.87298 (3.8729833462074)
+(vector 15 4.4060654286219 (fv 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0) ; 3.87298 (3.8729833462074)
+
+ 3.768991 (fv 0.000000 0.863434 1.069349 1.651266 0.272078 0.287377 1.735528 1.050008 0.997192 -0.020076 1.092043 1.658049 1.188297 1.641481 1.391589)
+ 3.768033 (fv 0.000000 0.863152 1.069135 1.651353 0.271851 0.287255 1.735115 1.049678 0.996877 -0.020587 1.091869 1.657562 1.187769 1.641176 1.391193)
- 3.769174 #(0.000000 0.861484 1.066267 1.645788 0.266828 0.280266 1.728769 1.041069 0.986580 -0.030711 1.080503 1.645587 1.174768 1.625077 1.375877)
- 3.768991 #(0.000000 0.863434 1.069349 1.651266 0.272078 0.287377 1.735528 1.050008 0.997192 -0.020076 1.092043 1.658049 1.188297 1.641481 1.391589)
+ ;; pp:
+ 3.859726 (fv 0.000000 0.426404 1.082257 -0.378600 0.672681 0.084435 0.794375 -0.135830 -0.492292 -0.747360 0.439828 0.395595 0.865535 0.672400 -1.271921)
)
;;; 16 all --------------------------------------------------------------------------------
-#(16 4.6832396970099 #(0 0 1 1 0 0 1 0 0 1 0 1 0 0 0 0)
- 4.5445760745314 #(0 1 1 0 1 0 1 0 0 0 1 1 0 0 0 0)
+(vector 16 4.5445760745314 (fv 0 1 1 0 1 0 1 0 0 0 1 1 0 0 0 0)
- 3.880044 #(0.000000 1.305525 1.470275 0.177035 0.840097 1.175803 -0.045240 1.607574 1.078362 0.676837 1.296177 0.358482 1.543390 0.161953 0.029701 -1.946850)
- 3.875293 #(0.000000 0.731415 0.678125 1.193317 1.630455 1.274923 -0.010275 1.463125 0.520861 0.201904 -0.170540 -0.119593 1.314021 1.618273 0.238721 1.406287)
- 3.875080 #(0.000000 0.730612 0.678979 1.195144 1.632126 1.276744 -0.008560 1.467028 0.525375 0.204869 -0.166129 -0.115302 1.317856 1.622654 0.244306 1.412402)
+ 3.875080 (fv 0.000000 0.730612 0.678979 1.195144 1.632126 1.276744 -0.008560 1.467028 0.525375 0.204869 -0.166129 -0.115302 1.317856 1.622654 0.244306 1.412402)
+ 3.873760 (fv 0.000000 0.727564 0.672436 1.188603 1.622426 1.266314 -0.018679 1.451325 0.507181 0.185750 -0.189066 -0.140317 1.293402 1.595942 0.216437 1.382779)
+
+ ;; pp:
+ 3.898248 (fv 0.000000 0.999637 1.627971 0.563839 1.354119 0.602036 1.818873 1.125095 0.889883 0.658070 0.547416 0.178002 0.696357 0.711221 1.277932 1.486763)
)
;;; 17 all -------------------------------------------------------------------------------- ; 4.1231
-#(17 4.7478643837553 #(0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1)
- 4.7478643837553 #(0 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1)
- 4.7654988506492 #(0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 1 1)
- 4.7654988506492 #(0 1 0 1 1 0 0 0 0 1 1 0 1 1 1 0 1)
+(vector 17 4.7654988506492 (fv 0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 1 1)
+
+ 3.981459 (fv 0.000000 0.520484 1.429480 0.505816 -0.891395 0.114390 0.146335 0.416197 0.938893 0.898753 0.507264 0.650687 -0.081499 -0.607990 0.213218 -0.096782 -0.652476)
+ 3.980210 (fv 0.000000 0.519908 1.429364 0.506455 -0.889349 0.115888 0.147799 0.418944 0.941982 0.901488 0.510707 0.653289 -0.078010 -0.603698 0.217190 -0.091931 -0.646982)
- 4.014837 #(0.000000 1.466046 1.041812 -0.108499 1.356223 0.981589 1.262667 0.715209 0.388569 1.081759 1.825430 0.656039 1.178209 0.785251 1.435495 -0.342701 -0.159210)
- 4.009869 #(0.000000 1.659692 0.153864 0.208373 0.465377 0.801497 0.333865 -0.306619 0.133983 0.553164 0.090623 1.393118 -0.083771 1.035016 -1.047840 0.020577 0.849233)
- 3.981459 #(0.000000 0.520484 1.429480 0.505816 -0.891395 0.114390 0.146335 0.416197 0.938893 0.898753 0.507264 0.650687 -0.081499 -0.607990 0.213218 -0.096782 -0.652476)
+ ;; pp:
+ 4.025451 (fv 0.000000 0.806442 1.640772 0.524823 1.518315 0.179778 1.375417 0.889535 -0.006539 1.626695 1.126057 1.328368 0.940320 1.091090 1.265244 1.868967 -0.027469)
)
;;; 18 all -------------------------------------------------------------------------------- ; 4.24264
-#(18 4.9109328272248 #(0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 0)
- 4.8247395547715 #(0 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 1 0)
- 4.795 #(0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0)
+(vector 18 4.795 (fv 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0)
- 4.160068 #(0.000000 1.247966 0.634845 0.085105 1.281747 1.591288 0.560708 1.554818 0.532041 1.253325 0.973787 0.305025 0.369962 0.426191 -0.060193 0.478556 0.689072 1.025864)
- 4.149424 #(0.000000 0.783719 1.424772 -0.028969 0.797469 0.495441 1.555906 0.574291 1.602121 0.919568 1.186181 1.878000 1.832983 1.781966 0.287268 1.741363 1.571076 1.265215)
- 4.145376 #(0.000000 0.815970 1.442468 0.022437 0.838057 0.561089 1.647234 0.678944 1.711039 1.021597 1.327383 0.016884 -0.030470 1.937927 0.480054 1.947188 1.779952 1.482341)
+ 4.145376 (fv 0.000000 0.815970 1.442468 0.022437 0.838057 0.561089 1.647234 0.678944 1.711039 1.021597 1.327383 0.016884 -0.030470 1.937927 0.480054 1.947188 1.779952 1.482341)
+ 4.139748 #(0.000000 0.841029 1.468092 0.061368 0.883567 0.618102 1.726318 0.769330 1.807136 1.123961 1.445068 0.140416 0.092314 0.077559 0.642622 0.110176 1.960387 1.676428)
+ 4.139675 #(0.000000 0.843694 1.471411 0.063968 0.889446 0.622071 1.732660 0.775711 1.815657 1.135238 1.453657 0.151363 0.100548 0.088867 0.654716 0.119261 -0.025900 1.692198)
)
;;; 19 all -------------------------------------------------------------------------------- ; 4.35889
-#(19 5.0964118877766 #(0 0 0 0 1 1 0 1 0 0 1 0 0 0 1 0 0 0 1)
- 5.0269187181249 #(0 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0)
- 5.0140104455275 #(0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 0)
- 4.957 #(0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1)
+(vector 19 4.957 (fv 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1)
- 4.256823 #(0.000000 0.950552 1.078946 1.827333 0.322429 0.515165 1.448194 1.262486 0.963019 0.265994 0.371763 0.920917 0.630954 0.586208 1.035067 0.365945 1.213903 0.045859 1.507359)
- 4.236757 #(0.000000 1.035424 1.317375 0.882321 0.748630 1.392844 1.209695 0.917957 1.063517 0.320073 1.579879 0.456384 1.606003 -0.204593 -1.100470 0.700110 1.199787 1.220259 -0.044138)
- 4.223666 #(0.000000 0.962025 0.721631 1.138738 1.342295 0.675056 0.848936 1.157044 1.060853 -0.213787 0.531124 1.684505 0.561245 0.375645 1.309393 -0.531388 0.959835 0.983902 0.285296)
+ 4.220950 (fv 0.000000 0.963878 0.724427 1.142775 1.347933 0.681634 0.858134 1.165699 1.071759 -0.202310 0.544201 1.698473 0.575529 0.392352 1.327300 -0.513540 0.980505 1.004716 0.307249)
+ 4.218225 #(0.000000 0.975837 0.737298 1.163191 1.372213 0.708367 0.893430 1.205301 1.114000 -0.155007 0.595375 1.754296 0.630178 0.457584 1.398341 -0.439927 1.059040 1.087418 0.391362)
+
+ ;; pp:
+ 4.321309 (fv 0.000000 0.745098 1.155175 -0.037958 0.532342 1.473567 0.665377 -0.049708 1.767937 0.914818 -0.119772 -0.388406 1.775638 1.206519 1.079401 1.118695 1.930701 1.737887 -0.008406)
)
;;; 20 all -------------------------------------------------------------------------------- ; 4.4721
-#(20 5.2602326468873 #(0 1 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 1)
- 5.2536671092168 #(0 1 0 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1)
- 5.2516581503036 #(0 1 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 0 0 1)
- 5.2027356749364 #(0 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 0 0)
- 5.202707605727 #(0 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0)
+(vector 20 5.202707605727 (fv 0 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0)
+
+ 4.288981 (fv 0.000000 1.288096 1.467454 -0.169090 1.858403 0.280935 0.217741 -0.031571 0.876318 1.220549 0.027164 0.381448 1.736192 1.508757 1.292734 0.007137 1.225400 0.645757 1.237414 0.420948)
+ 4.287997 #(0.000000 1.306723 1.491084 -0.138208 -0.106223 0.318045 0.270418 0.024135 0.938829 1.289927 0.097314 0.462063 -0.166575 1.604629 1.393707 0.120917 1.335729 0.768117 1.366096 0.562618)
- 4.290058 #(0.000000 1.287568 1.468290 -0.170532 1.858695 0.280488 0.217365 -0.031942 0.876344 1.219692 0.026561 0.381289 1.735799 1.508060 1.291588 0.006572 1.225731 0.645841 1.236621 0.419452)
+ ;; pp:
+ 4.467948 (fv 0.000000 0.926509 1.348679 0.244038 1.242002 0.019828 1.173056 0.068338 1.504010 1.041584 0.276603 1.806452 1.767012 1.665479 1.374797 1.361818 1.827476 0.132481 0.796064 0.727142)
)
;;; 21 all -------------------------------------------------------------------------------- ; 4.5825
-#(21 5.3651112556805 #(0 1 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 0 1 1 1)
- 5.3503630356826 #(0 1 0 1 1 1 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1)
- 5.3430035169068 #(0 1 1 1 1 1 0 1 1 0 0 0 0 1 0 1 1 0 0 0 1)
- 5.3468859417495 #(0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1)
- 5.3164971341632 #(0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 1 0 0 0)
- 5.3164971341632 #(0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0)
+(vector 21 5.3164971341632 (fv 0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0)
+
+ 4.482399 (fv 0.000000 1.397497 1.231727 1.288294 -0.006341 1.417563 -0.224775 1.544084 0.158820 1.058039 0.318600 1.788531 1.041209 0.988222 1.527762 0.536397 0.600751 0.298693 0.721205 1.590350 -0.083320)
+
+ ;; pp:
+ 4.574194 (fv 0.000000 0.830108 1.212818 -0.114835 0.663864 1.570276 0.585550 1.478198 0.603181 0.202958 1.649503 0.901982 0.255866 0.012434 0.019243 -0.386770 -0.332788 -0.375429 0.023280 0.553342 0.478240)
- 4.484397 #(0.000000 1.399581 1.230490 1.289720 -0.005391 1.417174 -0.222099 1.544621 0.160786 1.057475 0.320522 1.788712 1.040114 0.988797 1.529192 0.536731 0.600787 0.298519 0.720851 1.592406 -0.083584)
+ ;;20+1
+ 4.466298 #(0.000000 0.909097 0.238169 0.468983 0.883242 -0.050068 0.873199 0.299129 0.119990 0.693144 0.718516 0.626261 1.588601 1.027074 -0.097623 0.296983 1.533310 -0.381362 -0.344831 0.732964 0.856609)
+ 4.446059 #(0.000000 0.180019 0.218530 0.984925 -0.958137 -0.620910 0.483363 0.553272 0.541028 -0.013728 0.552503 0.454333 1.235179 -1.297121 0.258699 -0.559729 -0.469061 0.813196 -0.429872 0.235309 -0.551694)
+ 4.442505 #(0.000000 0.229264 0.300308 1.095021 -0.794869 -0.465067 0.642830 0.761336 0.766200 0.262204 0.844388 0.785992 1.557676 -0.940794 0.628826 -0.139027 -0.056712 1.215181 0.022101 0.740212 -0.084960)
)
;;; 22 all -------------------------------------------------------------------------------- ; 4.6904
-#(22 5.3384906472168 #(0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 0 0 1 0 1)
- 5.3118962410791 #(0 1 1 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 1 0)
- 5.29249935509144 #(0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 0 1 1 1 1 1)
- 5.292244006282 #(0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0)
+(vector 22 5.292244006282 (fv 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0)
- 4.622803 #(0.000000 1.340373 0.970954 1.002159 0.880275 1.416080 1.819200 1.007752 0.255081 0.347189 0.600359 0.574629 0.015990 0.999438 1.635477 0.619917 0.631959 1.121023 0.599154 1.883352 0.740818 1.129065)
- 4.588140 #(0.000000 -0.096778 1.080722 0.593207 -0.254680 1.023732 0.716557 1.901465 -0.019583 0.278478 1.160188 0.996330 1.054608 1.061984 1.434750 0.905801 0.882108 1.425520 0.362314 1.555862 0.347441 1.064021)
+ 4.586632 (fv 0.000000 -0.097347 1.080504 0.590888 -0.253961 1.023423 0.714156 1.899465 -0.021982 0.277218 1.158938 0.994197 1.053415 1.055197 1.429563 0.904330 0.879709 1.421582 0.356096 1.550705 0.340822 1.056446)
+
+ ;; pp:
+ 4.652382 (fv 0.000000 0.770633 1.384088 0.317715 1.400813 0.382294 1.252492 0.280512 1.930558 1.151783 0.690579 0.045402 0.011035 1.255532 1.463333 1.386585 0.797105 0.928163 1.091040 1.178341 1.461782 1.888245)
+
+ ;; 20+2
+ 4.571664 #(0.000000 1.311821 0.851164 0.580547 0.048402 1.274604 0.456442 1.682804 0.779139 1.627033 1.074351 1.013793 0.652224 0.595232 0.638584 1.055905 1.176957 1.287858 0.085124 0.572185 1.547525 0.045133)
+ 4.539850 #(0.000000 1.877088 1.220531 0.766350 0.912511 -0.049264 -0.015453 1.476348 0.128719 1.226510 1.377381 1.241269 1.228768 0.089299 1.482606 0.589500 -0.172007 0.157776 0.679537 0.684018 -0.353829 0.532234)
)
;;; 23 all -------------------------------------------------------------------------------- ; 4.7958
-#(23 5.5572876930237 #(0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 1 0 0 0)
- 5.35928895203514 #(0 1 1 0 0 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1)
- 5.3592889520338 #(0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1)
+(vector 23 5.3592889520338 (fv 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1)
+
+ 4.605166 (fv 0.000000 0.690307 -0.223703 0.265767 1.214689 0.913389 0.192629 1.489393 1.370656 0.848931 0.362934 0.592228 0.586290 0.001276 1.085398 1.699229 1.577973 0.044583 0.292577 1.343812 0.079208 -0.074880 0.197817)
+ 4.603716 #(0.000000 0.728519 -0.170578 0.343467 1.289714 1.021005 0.302988 1.638069 1.530207 1.013139 0.545865 0.789599 0.817820 0.223908 1.348504 -0.016545 -0.131209 0.351331 0.607617 -0.321862 0.423879 0.291671 0.585222)
- 4.607681 #(0.000000 0.689399 -0.223358 0.265838 1.213936 0.913933 0.191373 1.489050 1.370717 0.847890 0.362722 0.592331 0.586381 0.000455 1.084840 1.698411 1.578127 0.043618 0.291463 1.342365 0.078224 -0.076344 0.195753)
+ ;; pp:
+ 4.710615 (fv 0.000000 0.902511 1.536988 0.243249 1.001545 1.634662 0.695827 1.858861 0.975507 -0.294658 1.045533 0.585569 -0.187029 1.386517 1.153500 1.032794 1.102165 0.705294 0.968823 1.234672 1.719694 1.916952 0.231307)
)
;;; 24 all -------------------------------------------------------------------------------- ; 4.89897
-#(24 5.7082858085632 #(0 1 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0)
- 5.6697635650635 #(0 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0)
- 5.6446962356567 #(0 1 1 0 0 1 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0)
- 5.635 #(0 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1)
- 5.6358969066981 #(0 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 0 1 1 0)
+(vector 24 5.6358969066981 (fv 0 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 0 1 1 0)
+
+ 4.728042 (fv 0.000000 1.858980 1.366314 1.303093 0.303565 0.363906 -0.013052 0.288365 1.150614 1.733252 0.305478 1.054343 0.956930 0.688496 0.150610 0.766590 0.723928 0.358579 1.444965 0.475911 1.678841 0.331630 0.146133 0.753447)
+
+ ;; pp:
+ 4.889570 (fv 0.000000 0.652535 1.042108 0.029625 0.992596 0.108788 0.963358 1.727152 1.075228 0.458712 1.655013 0.983185 0.212822 0.044079 1.553136 1.514188 1.228593 0.684074 0.951192 1.149281 1.171121 1.382495 1.676492 0.457795)
- 4.730847 #(0.000000 1.860054 1.365565 1.300661 0.304467 0.364421 -0.013175 0.287107 1.148150 1.732528 0.305694 1.054141 0.959139 0.689514 0.150812 0.767232 0.724213 0.359240 1.442900 0.475499 1.678401 0.330818 0.144568 0.751992)
+ ;; 23+1
+ 4.797502 #(0.000000 0.815912 -0.489010 0.238747 0.464672 -0.791156 -0.258728 1.104213 0.634676 0.636859 0.115975 -0.179694 0.187452 -0.818880 0.261843 -0.587852 -0.717075 0.590119 -0.373998 0.804963 -0.982681 -0.821174 -0.611885 -0.513579)
)
;;; 25 all -------------------------------------------------------------------------------- ; 5
-#(25 5.7284736633301 #(0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0)
- 5.7190117835999 #(0 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1)
- 5.6488965032573 #(0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0)
- 5.6488965032573 #(0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0)
+(vector 25 5.6488965032573 (fv 0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0)
- 4.855641 #(0.000000 0.229926 1.726904 0.449778 0.015484 0.016859 0.462379 0.871412 0.609322 0.654662 0.062760 0.825989 0.576895 -0.081196 -0.112104 1.739215 0.575276 0.891044 1.388407 0.667892 1.843741 1.342090 1.776343 0.652054 1.004535)
+ 4.852860 (fv 0.000000 0.230967 1.727317 0.450764 0.017370 0.018890 0.465256 0.875082 0.612377 0.658132 0.067557 0.830777 0.581695 -0.075473 -0.106051 1.748399 0.582315 0.898509 1.395989 0.676438 1.853985 1.350704 1.785330 0.662329 1.015229)
+
+ ;; pp:
+ 4.921362 (fv 0.000000 0.851508 1.100092 -0.096894 0.569229 1.392351 1.000621 -0.034780 0.968948 0.124084 0.790431 -0.082333 0.100565 1.032584 0.439519 0.313536 0.111622 0.176204 1.585564 1.488261 0.160713 -0.042818 0.611461 0.760689 0.720307)
+
+ ;; 24+1?
+ 4.867199 #(0.000000 0.511988 0.599074 1.109026 -0.258266 -0.311525 -0.180815 0.514703 -0.058310 0.500087 -0.447647 -1.097227 -0.392984 -0.773229 -0.739391 1.039107 0.423028 -0.118139 1.262658 1.681945 -0.043110 1.191717 1.700807 0.042704 -0.767223)
)
;;; 26 all -------------------------------------------------------------------------------- ; 5.0990
-#(26 5.8922033309937 #(0 1 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0)
- 5.8206262588501 #(0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0)
- 5.78661186695166 #(0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 0 0 1)
- 5.7865648269653 #(0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0)
+(vector 26 5.7865648269653 (fv 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0)
+
+ 5.004963 (fv 0.000000 0.356503 0.613044 0.799459 0.607543 -0.552567 0.275717 0.954617 0.539225 0.390115 0.747516 -0.287816 0.661916 1.821078 -0.045167 -0.217306 1.531723 0.896950 0.283527 0.968137 0.942126 0.004913 -0.474898 0.935500 1.374671 0.106691)
+ 4.982437 #(0.000000 0.157773 0.357579 0.470573 0.208359 -1.095460 -0.324361 0.305853 -0.246382 -0.421030 -0.124942 -1.314179 -0.526336 0.680713 -1.271118 -1.537428 0.186315 -0.648152 -1.272801 -0.741946 -0.801258 -1.769664 -0.386094 -1.048075 -0.774396 -0.009812)
+ 4.981911 #(0.000000 0.114804 0.305276 0.394495 0.122048 -1.227102 -0.469461 0.152164 -0.415952 -0.596715 -0.349375 -1.548844 -0.778154 0.402539 -1.542539 -1.840236 -0.152677 -0.992660 -1.641041 -1.138828 -1.199533 -0.219776 -0.823305 -1.512557 -1.273176 -0.520822)
+
+ ;; pp:
+ 5.069005 (fv 0.000000 0.693839 1.223177 0.171124 0.655819 1.659284 0.862412 0.167152 1.036280 0.233275 1.065043 0.332100 0.088514 1.217811 0.718617 0.463929 -0.022907 0.301609 1.664942 1.593693 1.159306 1.575199 1.658356 1.791865 0.367495 0.523068)
- 5.023346 #(0.000000 0.471497 0.419434 0.860585 1.369474 -0.146335 1.642121 0.161223 1.825222 0.594228 1.689539 0.413066 1.098262 1.472516 1.249094 1.170567 0.839656 0.942436 0.149512 -0.243079 1.269486 1.068124 -0.150509 1.648862 0.945727 1.703664)
- 5.008256 #(0.000000 0.356007 0.611393 0.800030 0.608139 -0.552559 0.276762 0.954695 0.541230 0.391873 0.749201 -0.287679 0.663114 1.822966 -0.042535 -0.215786 1.534399 0.896769 0.284021 0.968921 0.944615 0.005656 -0.473527 0.937503 1.376587 0.108845)
+ ;; 25+1
+ 5.143899 (fv 0.000000 0.339898 1.703660 0.334703 -0.033066 0.152772 0.352050 0.937913 0.431489 0.569881 0.083296 0.920798 0.392044 -0.279901 -0.309500 1.803373 0.465037 0.973772 1.156286 0.616150 1.812432 1.192020 1.791336 0.747339 0.851095 0.182401)
)
;;; 27 all -------------------------------------------------------------------------------- ; 5.1961
-#(27 5.980658531189 #(0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1)
- 5.8753982451551 #(0 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0)
- 5.8753981590271 #(0 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0)
+(vector 27 5.8753981590271 (fv 0 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0)
- 5.066453 #(0.000000 1.180887 1.012981 -0.037241 0.953126 0.743204 0.046304 -0.010627 1.594368 1.830120 1.926912 0.836044 0.497153 0.820806 0.580883 1.308790 0.813677 0.203614 0.448890 0.870192 1.163708 0.319673 0.498880 -0.075386 0.820143 1.666968 0.421343)
+ 5.063979 (fv 0.000000 1.181312 1.011523 -0.037795 0.952214 0.743188 0.046346 -0.011550 1.593930 1.829003 1.926981 0.836368 0.497093 0.820784 0.581154 1.308971 0.813642 0.203348 0.448693 0.869589 1.163120 0.319576 0.498929 -0.074366 0.820574 1.666665 0.421783)
+
+ ;; pp:
+ 5.178190 (fv 0.000000 0.576339 1.415874 0.213916 0.629425 1.693659 0.296051 1.239867 0.501966 1.807544 0.478176 -0.072336 1.103954 0.283214 0.269354 -0.586084 0.967552 0.762560 0.644862 0.769649 0.453206 0.327359 1.119459 1.407959 1.575398 0.090804 0.240986)
+
+ ;; 26+1
+ 5.126119 #(0.000000 0.900772 1.219713 0.169043 1.065297 1.224400 0.165897 0.980264 0.050341 1.214424 0.625722 0.135385 1.464791 0.070454 0.417426 0.174034 0.437373 0.493624 0.582463 1.623009 1.820016 1.778385 0.847413 1.132593 0.293556 1.847407 0.436103)
)
;;; 28 all -------------------------------------------------------------------------------- ; 5.2915
-#(28 6.1332263946533 #(0 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0)
- 6.107029914856 #(0 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1)
- 6.0962085723877 #(0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0)
- 6.0962085723877 #(0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 1)
+(vector 28 6.0962085723877 (fv 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 1)
+
+ 5.157284 (fv 0.000000 0.613262 -0.034248 0.167107 1.753362 0.009121 1.168065 1.319935 0.754215 1.452315 0.403030 1.384036 -0.445049 1.700477 0.448730 1.102474 0.302577 0.114957 0.813938 -1.221580 0.733588 -0.228287 1.379195 0.775101 0.357079 0.863661 0.744441 -0.542730)
+ 5.156726 #(0.000000 0.621583 -0.025615 0.185073 1.770611 0.035230 1.190822 1.343738 0.783921 1.481359 0.438924 1.421434 -0.401379 1.746999 0.501100 1.159948 0.364927 0.179358 0.879866 -1.146659 0.808429 -0.150109 1.458018 0.864191 0.450456 0.959743 0.840089 -0.445751)
- 5.201582 #(0.000000 -0.594236 0.471372 -0.239106 0.026372 1.367317 -1.367383 0.475651 -0.077031 -1.126466 0.500322 -0.840077 0.289150 0.017573 1.087716 1.066819 1.177512 0.077022 0.675500 0.393911 1.002792 0.832733 0.902383 1.149342 0.256199 0.532177 1.776896 0.135269)
- 5.161016 #(0.000000 0.609398 -0.031546 0.163654 1.750544 0.009072 1.168722 1.319687 0.754527 1.449905 0.404768 1.387397 -0.443377 1.700390 0.448442 1.105795 0.302344 0.108046 0.813277 -1.223453 0.735575 -0.228080 1.376959 0.772459 0.355021 0.857861 0.747767 -0.540969)
+ ;; pp:
+ 5.257514 (fv 0.000000 0.637044 1.032618 -0.063334 0.493709 1.172496 0.265676 1.071428 0.186660 1.119263 0.450916 1.523906 0.926797 0.655305 -0.125687 1.119620 1.002091 0.595772 0.366822 0.141548 0.074245 -0.326675 0.086270 0.158575 0.648670 0.735199 1.036773 -0.335597)
)
;;; 29 all -------------------------------------------------------------------------------- ; 5.38516
-#(29 6.2162199020386 #(0 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0)
- 6.2025485038757 #(0 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1)
- 6.1994609975558 #(0 0 1 0 1 0 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 0 0 1 0)
- 6.168496131897 #(0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1)
- 6.168496131897 #(0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 0 1 0 1)
+(vector 29 6.168496131897 (fv 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 0 1 0 1)
+
+ 5.241325 (fv 0.000000 1.424549 1.434579 0.952506 0.877300 1.948583 1.592791 0.964559 0.950012 1.429458 0.788068 0.556113 0.404906 0.813692 1.604109 0.138120 0.925420 1.345282 1.048370 1.281239 1.347177 1.752489 1.781053 0.782127 0.063659 1.163981 0.330203 1.128951 1.871926)
+
+ ;; pp:
+ 5.354004 (fv 0.000000 0.686564 1.165583 1.805539 0.645303 1.392789 0.389959 1.584227 0.184212 1.132208 0.594808 1.885153 0.760508 0.108139 1.597930 1.248057 0.449409 0.388311 -0.040221 -0.137762 0.035489 0.097197 1.554759 1.643774 1.707832 0.439164 0.286463 0.690398 1.001814)
- 5.244731 #(0.000000 1.423197 1.434334 0.954277 0.877662 1.948724 1.591838 0.966340 0.952717 1.429672 0.787029 0.555356 0.405697 0.817643 1.603999 0.138279 0.926533 1.343354 1.048968 1.281826 1.347978 1.753988 1.784362 0.779861 0.066133 1.166301 0.329314 1.131806 1.874060)
+ ;; 28+1
+ 5.309949 #(0.000000 0.846874 0.241547 0.392668 0.105733 0.593095 -0.055728 1.769258 1.471201 0.259232 1.487017 0.394902 0.593301 0.594134 1.608339 0.527615 1.618053 1.488443 0.038033 0.264977 0.515061 1.719999 1.612303 0.816240 0.367893 0.553084 0.901271 1.615714 0.762730)
)
;;; 30 all -------------------------------------------------------------------------------- ; 5.4772
-#(30 6.3668465614319 #(0 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 0 1 0 1 0 1 1 1)
- 6.3080444335938 #(0 0 1 1 0 0 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 1 0 1)
- 6.2868418693542 #(0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 1 1 1)
- 6.257221698761 #(0 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 1 0 1)
+(vector 30 6.257221698761 (fv 0 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 1 0 1)
- 5.366694 #(0.000000 1.367293 0.678335 1.056059 -0.506652 0.354228 0.103786 0.546097 0.755979 0.321279 -0.471933 -0.199299 0.505109 0.194951 -0.044195 1.645993 0.866175 1.019312 1.251553 0.153557 0.520073 -0.271182 0.225402 -0.451939 0.517701 0.215495 0.989027 0.341703 0.791872 0.749094)
+ 5.361273 (fv 0.000000 1.372797 0.670580 1.057136 -0.495516 0.360919 0.095174 0.542106 0.748047 0.327246 -0.458569 -0.196062 0.499790 0.195141 -0.041091 1.640040 0.876134 1.017379 1.243023 0.157336 0.532420 -0.270945 0.222972 -0.454366 0.519190 0.206280 0.985739 0.329627 0.782987 0.753526)
+
+ ;; pp:
+ 5.457123 (fv 0.000000 0.579295 1.086489 0.271361 0.351869 1.393293 0.343724 1.326421 0.262824 0.711061 0.185497 1.430027 0.435525 0.024911 1.289605 1.541120 0.534068 0.426466 1.770822 1.448308 1.691046 1.363221 0.940381 1.411829 1.232407 1.698674 -0.061281 0.480912 0.397265 0.093509)
+ 5.457522 #(0.000000 0.180374 0.737535 -0.629271 -0.119582 0.936316 1.168308 1.717509 -0.402864 -0.373354 0.211140 0.477066 1.180570 -1.170786 0.943217 0.201779 -0.611919 0.922150 1.095538 0.984255 -0.262406 0.845304 1.611083 0.846240 0.705768 -0.037782 -0.632928 0.048519 -0.449702 1.337980)
+
+ ;; 29+1
+ 5.407828 #(0.000000 1.401096 1.376571 1.008941 1.027589 -0.085696 1.660515 0.983168 0.985870 1.410812 0.796458 0.476205 0.194328 1.091142 1.765086 0.052662 1.081109 1.265325 0.992243 1.285402 1.599846 1.557990 0.374401 1.559263 0.508151 1.671660 0.671171 1.718845 -0.085252 0.533771)
)
;;; 31 all -------------------------------------------------------------------------------- ; 5.56776
-#(31 6.4472563825087 #(0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 0 1 1 1)
- 6.3776631355286 #(0 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 1 1 1 1)
- 6.3353910446167 #(0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 0 1)
- 6.3243918418884 #(0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1)
+(vector 31 6.3243918418884 (fv 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1)
+
+ 5.479252 (fv 0.000000 1.715332 0.740879 1.282120 0.005121 1.133820 1.648029 0.843835 0.870127 0.362478 -0.012264 1.508703 0.898921 1.010311 1.653601 0.519170 0.543334 0.643526 1.650052 0.937580 0.006302 1.745072 0.413200 1.629321 0.671152 0.807947 1.140772 1.157434 0.674253 1.101147 1.176272)
+ 5.478665 #(0.000000 1.772425 0.803174 1.328405 0.081611 1.219664 1.725421 0.969769 1.009467 0.524607 0.150580 1.691934 1.088386 1.212688 1.849460 0.777872 0.785597 0.893510 -0.072450 1.225337 0.333131 0.071155 0.764064 0.012661 1.020004 1.202423 1.541822 1.587594 1.095956 1.541832 1.635240)
+
+ 5.457715 #(0.000000 0.335441 1.084827 0.018253 0.737437 1.328926 0.232615 1.324648 1.548727 1.102230 0.582938 0.356482 1.414652 1.240061 0.257198 0.650632 1.787556 1.748026 -0.020851 0.033891 1.146224 0.784975 1.568424 1.015644 1.832440 -0.392011 -0.347982 -0.739222 -0.325456 -0.578410 0.397608)
+ 5.453054 #(0.000000 0.330034 1.062392 -0.018048 0.701747 1.293007 0.182311 1.269874 1.478913 1.017407 0.501409 0.269712 1.315062 1.138628 0.142159 0.526931 -0.345056 1.613950 -0.162150 -0.111306 0.991533 0.609140 1.408136 0.828750 1.658057 -0.598529 -0.552356 -0.936876 -0.551564 -0.796775 0.156224)
- 5.483548 #(0.000000 1.716513 0.734155 1.284407 0.002926 1.138357 1.651222 0.840380 0.862951 0.362868 -0.011541 1.508984 0.900956 1.004294 1.662373 0.522900 0.542553 0.647212 1.649604 0.938574 0.006447 1.743627 0.420681 1.628282 0.676409 0.803864 1.141938 1.155986 0.676801 1.099313 1.174563)
+ ;; pp:
+ 5.506117 (fv 0.000000 0.677676 1.291605 1.787569 0.657442 1.382372 0.087522 0.893379 -0.050356 0.800441 -0.050934 1.224977 0.724031 1.793437 1.031051 0.628566 0.200527 1.931215 1.228105 1.043046 0.856098 0.884359 0.667113 1.148772 0.506576 0.784927 0.816254 1.304861 1.786988 1.852001 0.224722)
+
+ ;;; 30+1
+ 5.550882 #(0.000000 1.425022 0.538933 1.069581 -0.597930 0.307695 0.154011 0.587861 0.779449 0.144783 -0.543105 -0.308223 0.381009 0.256948 -0.103754 1.614961 0.898101 1.043268 1.242618 0.013120 0.441700 -0.261691 0.222365 -0.327392 0.395779 0.143572 0.965764 0.164756 0.636599 0.716823 0.000189)
)
;;; 32 all -------------------------------------------------------------------------------- ; 5.65685
-#(32 6.5261273384094 #(0 0 0 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0)
- 6.4710988998413 #(0 0 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 0 0 0)
- 6.4692246308309 #(0 0 1 1 0 1 0 1 0 0 1 1 1 0 1 0 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0)
- 6.4519599479542 #(0 0 0 0 0 1 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1)
- 6.4451498985291 #(0 0 0 0 0 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 1 0)
+(vector 32 6.4451498985291 (fv 0 0 0 0 0 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 1 0)
+
+ 5.525650 (fv 0.000000 -0.351133 1.293972 -0.243467 0.375774 0.341597 0.388720 0.121948 0.157486 1.353778 0.236182 0.278745 0.140738 1.315014 1.717753 1.193420 1.734782 1.635830 0.448546 0.657631 0.934238 0.325644 1.910640 1.330301 0.498135 1.394503 1.747576 0.388629 0.706077 0.075100 0.832948 -0.013902)
- 5.529767 #(0.000000 -0.357496 1.295472 -0.244166 0.378862 0.343677 0.387655 0.125795 0.157477 1.354195 0.239429 0.278240 0.142338 1.318038 1.716131 1.194338 1.731815 1.633958 0.445551 0.658322 0.932928 0.324708 1.907298 1.327700 0.501470 1.391423 1.750708 0.386360 0.706755 0.076956 0.832906 -0.015253)
+ ;; pp:
+ 5.604748 (fv 0.000000 0.799811 1.174111 -0.060224 0.824446 1.499635 0.054636 1.116026 0.103247 0.980855 0.143722 1.410098 0.567912 -0.275862 1.109567 0.582020 0.052513 1.796805 1.346558 0.470148 0.633702 0.311062 0.341355 0.120966 0.347342 -0.087220 -0.235617 0.166536 0.617003 0.982789 1.015963 1.699479)
)
;;; 33 all -------------------------------------------------------------------------------- ; 5.74456
-#(33 6.678719997406 #(0 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 1 1 1 1 1 0 1 0 1 0 0)
- 6.6342549324036 #(0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 0 1)
- 6.6147227287292 #(0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0)
- 6.5579299926758 #(0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 0)
+(vector 33 6.5579299926758 (fv 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 0)
+
+ 5.631190 (fv 0.000000 0.097616 0.529848 0.847242 0.662939 0.833596 1.914696 0.035703 0.153599 0.327398 1.407575 -0.021932 0.932495 1.243452 0.370234 0.653095 -0.062589 1.855791 0.441043 0.248847 0.782346 0.465080 -0.161731 0.929949 0.594824 1.321736 1.693332 1.192619 0.260596 1.271517 1.690356 1.109725 0.567421)
+ 5.610410 #(0.000000 0.121938 0.577637 0.964946 0.701543 0.945275 0.057342 0.144831 0.337733 0.549414 1.625058 0.265950 1.238074 1.576246 0.724815 0.984490 0.297228 0.251221 0.699155 0.548588 1.186306 0.951889 0.285802 1.345917 1.014217 1.823546 0.088927 1.726245 0.867511 1.795939 0.286630 1.739958 1.218430)
+ 5.608483 #(0.000000 0.127672 0.575757 0.971725 0.693309 0.950898 0.070948 0.160557 0.341181 0.560186 1.645087 0.281844 1.260852 1.598287 0.730804 1.014936 0.316122 0.275621 0.725241 0.597914 1.221833 0.996203 0.324966 1.372541 1.062261 1.875167 0.130133 1.748519 0.894847 1.849289 0.335743 1.776799 1.261232)
- 5.635107 #(0.000000 0.096917 0.534048 0.844232 0.664210 0.830370 1.909422 0.035015 0.156012 0.327754 1.408862 -0.022849 0.930596 1.245585 0.370155 0.652349 -0.062548 1.851506 0.444607 0.245493 0.778912 0.461144 -0.163445 0.929749 0.597185 1.314796 1.697920 1.195133 0.256759 1.266343 1.688596 1.108980 0.567202)
+ ;; pp:
+ 5.744046 (fv 0.000000 0.648617 1.091146 -0.080415 0.482263 1.100917 0.071191 1.062577 0.109918 0.836095 -0.052549 1.287445 0.382948 1.391104 0.926942 0.308725 1.631613 0.947331 0.900375 0.124874 0.064712 1.506574 1.488794 1.444593 1.476988 1.247778 1.089616 1.639634 -0.152998 -0.001330 0.434944 0.915078 0.903432)
+
+ ;; 32+1
+ 5.661968 (fv 0.000000 -0.352238 1.421554 -0.062497 0.287660 0.210756 0.410931 0.134572 0.285343 1.484578 0.353937 0.356204 0.097780 1.509309 1.823077 1.336946 1.794210 1.915189 0.597192 0.803204 1.197066 0.523451 0.168550 1.601444 0.858978 1.682815 0.027376 0.555153 1.077928 0.275560 1.108578 0.224908 -0.307634)
)
;;; 34 all -------------------------------------------------------------------------------- ; 5.8309518
-#(34 6.7310481071472 #(0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0)
- 6.7281470298767 #(0 1 0 0 0 1 0 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 0)
- 6.7141165733337 #(0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 0)
- 6.6820402145386 #(0 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 0)
- 6.6788883209229 #(0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 0)
- 6.6782836914062 #(0 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 0)
+(vector 34 6.6782836914062 (fv 0 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 0)
+
+ 5.716435 (fv 0.000000 1.537850 0.239691 0.279680 1.093753 0.273847 0.872235 1.496985 1.522928 0.760723 1.655491 0.025814 1.234543 0.204722 1.320964 0.722548 0.795411 1.810303 1.109323 1.456118 1.072015 0.656715 1.724740 1.409441 -0.521616 1.350972 1.541354 1.489386 0.627886 0.677049 0.878489 -0.127150 -0.020441 0.557443)
+ 5.715522 #(0.000000 1.535834 0.312631 0.280224 1.148017 0.182965 0.826725 1.571414 1.581831 0.887796 1.704031 0.067574 1.286355 0.321441 1.363349 0.812149 0.980936 1.891675 1.179822 1.532746 1.177536 0.667908 1.925108 1.578399 -0.430841 1.453028 1.642459 1.613448 0.724642 0.739942 1.051391 0.000286 0.024547 0.665325)
+ 5.715061 #(0.000000 1.557376 0.316186 0.303275 1.175381 0.206598 0.863890 1.615342 1.613470 0.958427 1.750728 0.111536 1.351364 0.386942 1.439281 0.903963 1.075401 -0.020759 1.279610 1.643520 1.269919 0.800947 0.050818 1.687932 -0.298939 1.577236 -0.205754 -0.244682 0.852707 0.888744 1.194917 0.175251 0.202437 0.844132)
- 5.721275 #(0.000000 1.537213 0.239671 0.278042 1.094883 0.274881 0.871861 1.496857 1.521795 0.761213 1.656084 0.025131 1.235452 0.206266 1.321622 0.722819 0.794646 1.810454 1.109962 1.456186 1.070438 0.656560 1.724659 1.407688 -0.522881 1.349622 1.540863 1.488043 0.627895 0.673112 0.878488 -0.129260 -0.021006 0.554817)
+ ;; pp:
+ 5.801677 (fv 0.000000 0.960590 1.230620 -0.161839 0.543814 1.323075 0.313096 0.853533 -0.212153 1.135960 -0.100861 0.915755 0.332189 1.257774 0.850007 0.263168 1.528284 0.501744 0.475602 -0.081405 1.503307 1.166122 1.260528 0.746339 0.481380 0.722221 0.959406 1.108477 0.637618 0.962601 1.236659 1.273002 -0.011533 0.165609)
)
;;; 35 all -------------------------------------------------------------------------------- ; 5.9160
-#(35 6.8652677536011 #(0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 0 0 1 0 0 0 0 0)
- 6.8216953277588 #(0 0 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0)
- 6.7839112281799 #(0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0)
- 6.7759642601013 #(0 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0)
- 6.7637429237366 #(0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0)
+(vector 35 6.7637429237366 (fv 0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0)
- 5.769511 #(0.000000 0.102697 1.401830 0.818397 1.461851 0.154032 1.618494 1.534460 1.543814 0.875127 1.319240 1.294792 1.413591 0.147300 1.056367 0.647379 1.391041 1.070554 0.137544 0.362172 1.848827 1.486280 0.790850 1.754258 0.990175 1.205429 0.198438 -0.165833 0.163564 -0.016866 0.359072 0.684081 1.633963 0.564667 0.903834)
+ 5.764294 (fv 0.000000 0.100183 1.398707 0.822554 1.459800 0.154045 1.619372 1.535907 1.542373 0.876004 1.322076 1.293113 1.412723 0.146555 1.058946 0.645359 1.390817 1.072269 0.132103 0.365169 1.845456 1.487696 0.791518 1.753949 0.991873 1.205376 0.200418 -0.166259 0.161894 -0.021712 0.362318 0.686081 1.632970 0.565468 0.901578)
+ 5.761550 #(0.000000 0.109331 1.415904 0.863973 1.504657 0.200254 1.669142 1.598436 1.595369 0.964840 1.410141 1.378302 1.505772 0.261951 1.178950 0.757734 1.524984 1.223665 0.264922 0.531725 0.000853 1.660270 0.971853 -0.071328 1.201271 1.414050 0.409445 0.053601 0.377052 0.191601 0.609357 0.945758 -0.105595 0.829816 1.179558)
+
+ ;; pp:
+ 5.895826 (fv 0.000000 0.643741 1.250469 1.867865 0.530176 1.122535 0.024737 1.205120 0.194580 0.988315 1.702722 0.964190 0.348453 1.456006 0.520276 -0.302930 1.556990 0.638548 -0.211365 1.748454 1.424618 0.940371 0.466444 0.212559 0.146415 0.251126 0.228984 -0.138555 0.352126 0.459061 0.664909 1.353503 1.665947 1.723726 0.002732)
)
;;; 36 all -------------------------------------------------------------------------------- ; 6
-#(36 6.9388113021851 #(0 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 0 1 0 1 0 0 0 0)
- 6.934184551239 #(0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 1 1 0 0 1 1 0 0 0)
- 6.9237461090088 #(0 0 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 0 0)
- 6.9208335876465 #(0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1)
- 6.8763957023621 #(0 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 1 0 0)
- 6.8008880615234 #(0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1)
+(vector 36 6.8008880615234 (fv 0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1)
+
+ 5.926043 (fv 0.000000 1.020111 0.677817 0.140140 0.932921 0.775557 0.190635 1.853238 0.762697 0.237889 0.277245 0.161572 1.553054 0.008070 0.283378 1.674361 -0.347149 0.590912 0.944213 0.823255 0.043034 -0.091562 0.229555 1.352871 0.981843 0.171776 0.581947 0.691871 1.000348 0.829120 1.162722 1.690975 0.634924 1.730234 0.452876 1.429867)
- 5.931449 #(0.000000 1.020268 0.677676 0.141480 0.933164 0.775943 0.190974 1.852375 0.763224 0.240685 0.277882 0.163474 1.552588 0.007697 0.283092 1.674709 -0.345165 0.591058 0.945716 0.824253 0.043245 -0.089554 0.231180 1.353274 0.983801 0.173104 0.583544 0.693163 1.001038 0.832122 1.162817 1.689517 0.636045 1.729156 0.451707 1.432502)
+ ;; pp:
+ 5.876240 (fv 0.000000 0.880722 1.509714 0.204909 0.817303 1.618536 0.560409 1.279749 0.308262 -0.524358 0.395653 -0.826907 0.386964 -0.034537 1.535549 1.090154 0.375322 1.512598 1.132860 1.558960 0.892393 0.587406 0.099621 0.325394 -0.086852 -0.097620 -0.036583 0.411674 0.423371 -0.013442 0.469946 0.536299 1.271922 -0.393606 -0.170370 0.277903)
+ 5.872670 #(0.000000 1.008642 1.468259 0.136066 0.832884 1.675080 0.561995 1.215779 0.176163 -0.645512 0.301135 -0.915574 0.346533 -0.147416 1.414097 1.167654 0.437921 1.345264 1.026772 1.438289 0.848806 0.422687 -0.153016 0.254467 -0.256778 -0.257882 -0.180820 0.369974 0.206740 -0.196159 0.361067 0.357334 1.155902 -0.541647 -0.334470 0.076521)
+ 5.871695 #(0.000000 0.976078 1.428851 0.077798 0.772784 1.602082 0.472100 1.111861 0.058266 -0.754466 0.191131 -1.049850 0.189192 -0.311703 1.251680 0.977617 0.232753 1.137715 0.806190 1.201023 0.616244 0.157943 -0.415443 -0.020130 -0.548605 -0.551223 -0.509170 0.040073 -0.121612 -0.560043 -0.007571 -0.025396 0.766768 -0.951503 -0.743309 -0.341165)
+
+ ;; 35+1
+ 5.968866 #(0.000000 0.133611 1.230434 0.841852 1.312856 0.529755 1.370310 1.332590 1.580324 0.930341 1.428865 1.755052 1.561249 -0.230712 1.582178 0.486609 1.188339 0.984457 0.043840 -0.015979 -0.155552 1.235391 0.874947 1.643065 1.184316 0.952918 0.543242 -0.381983 0.458292 0.068269 0.575524 0.723748 -0.044728 0.683083 1.573491 0.035965)
)
;;; 37 all -------------------------------------------------------------------------------- ; 6.0827
-#(37 7.1209874153137 #(0 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0)
- 7.1156206130981 #(0 0 0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0)
- 7.1152505874634 #(0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 0)
- 7.1046371459961 #(0 1 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 0 0 0)
- 7.0939922332764 #(0 0 1 1 1 0 1 0 0 0 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0)
- 7.0588836669922 #(0 1 0 1 0 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0)
- 7.0475845336914 #(0 1 1 1 1 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 0 0)
- 7.0251078605652 #(0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 0)
+(vector 37 7.0251078605652 (fv 0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 0)
+
+ 5.927989 (fv 0.000000 1.362671 1.825924 0.295316 1.739841 1.835463 1.048945 1.351967 0.301179 0.388225 1.780488 1.534131 0.435239 0.318363 -0.101295 0.220840 0.998360 1.646237 1.362259 0.730890 0.388056 1.327874 0.110340 1.924981 0.324484 0.429209 1.542714 0.665030 0.018148 0.321441 1.812097 0.446891 1.633693 1.056009 1.344989 1.426723 1.818561)
+ 5.918646 #(0.000000 1.276868 1.775826 0.292236 1.788221 1.829337 1.043839 1.351449 0.259082 0.375705 1.700935 1.487286 0.337951 0.306327 -0.126317 0.091444 0.949870 1.546870 1.374856 0.654967 0.351723 1.285561 0.074903 1.824326 0.227704 0.400930 1.466430 0.609151 0.009920 0.222861 1.672440 0.383746 1.542055 1.018281 1.254945 1.323042 1.739217)
+ 5.918139 #(0.000000 1.268085 1.769551 0.285066 1.784410 1.812873 1.034440 1.342674 0.256292 0.366678 1.679577 1.477236 0.317949 0.294007 -0.148484 0.067735 0.925643 1.526359 1.349946 0.624511 0.326721 1.258438 0.049695 1.798322 0.189031 0.360477 1.435009 0.581192 -0.024865 0.191624 1.638560 0.341145 1.503234 0.980493 1.208657 1.269237 1.688696)
- 5.933969 #(0.000000 1.357580 1.821190 0.294387 1.750925 1.845472 1.054143 1.356098 0.293620 0.391313 1.778601 1.534928 0.426019 0.315757 -0.095725 0.216499 0.999813 1.634650 1.366520 0.730349 0.391123 1.330014 0.106679 1.912375 0.325125 0.431168 1.541075 0.670579 0.023629 0.320519 1.802217 0.442394 1.635271 1.059117 1.341290 1.420508 1.824162)
+ ;; pp:
+ 5.974361 (fv 0.000000 0.722538 1.156373 1.818176 0.424359 1.001884 -0.224545 0.967675 0.089627 0.943734 -0.013572 0.947114 1.914887 1.102823 0.609766 -0.045075 0.989242 0.549752 1.615428 1.344389 0.949028 0.684491 0.483044 1.586745 1.704247 1.024089 1.360720 1.162825 1.209506 1.208578 0.870877 1.201701 1.782696 0.290706 0.253842 0.466340 0.855161)
)
;;; 38 all -------------------------------------------------------------------------------- ; 6.1644
-#(38 7.1993880271912 #(0 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0)
- 7.1926069259644 #(0 0 1 0 1 0 0 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0)
- 7.1880865097046 #(0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0)
- 7.1807923316956 #(0 1 0 1 0 0 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0)
- 7.1668581962585 #(0 0 1 0 1 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 1 1 0 1 1 0 0 1 0 0 0)
- 7.1260185241699 #(0 1 0 1 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0)
- 7.1221342086792 #(0 0 1 0 1 0 1 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 0 0 0)
- 7.0688242912292 #(0 0 1 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0)
+(vector 38 7.0688242912292 (fv 0 0 1 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0)
- 6.141081 #(0.000000 0.476359 1.183611 1.424660 0.720669 0.084602 1.874771 1.422499 0.404825 0.949357 0.682500 1.709551 1.802453 0.795775 1.088809 0.144361 1.364027 0.520155 0.230721 0.817258 1.067794 1.407900 0.308825 1.598206 1.778867 1.700646 -0.474543 1.394960 1.012106 1.341722 0.530505 1.592235 0.510888 0.855540 1.374812 1.298891 0.989427 1.632520)
- 6.112901 #(0.000000 0.435265 1.232390 1.592140 0.836456 0.140325 -0.094894 1.539078 0.470950 0.771273 0.750164 1.724158 1.821204 0.853516 0.903137 0.046891 1.315027 0.369503 0.212941 0.799169 0.967782 1.376713 0.275913 1.621961 1.870720 -0.089853 -0.470105 1.152992 0.774553 1.201108 0.584460 1.304184 0.432119 0.965384 1.318742 1.146654 0.975990 1.527437)
+ 6.106333 (fv 0.000000 0.434523 1.232452 1.590516 0.836713 0.138216 -0.095509 1.537371 0.469612 0.772082 0.748819 1.723571 1.820323 0.854103 0.903800 0.048646 1.316356 0.369282 0.213334 0.798970 0.966914 1.376827 0.274641 1.618764 1.873131 -0.092091 -0.470518 1.150403 0.773945 1.198395 0.586433 1.306012 0.434228 0.963298 1.320012 1.145313 0.975992 1.528312)
+
+ ;; pp:
+ 6.069129 (fv 0.000000 0.353204 1.147865 -0.165608 0.617213 1.415461 0.231168 1.083939 0.117365 0.131316 1.707213 1.274701 0.816253 0.960543 -0.063212 0.270965 1.418066 0.902830 1.619238 0.591718 0.977208 0.940720 1.787513 0.746703 0.165197 1.177699 0.830675 1.652814 1.371740 1.118022 1.133381 1.232097 1.370669 1.218425 0.194971 -0.026100 0.615354 0.750336)
+
+ ;; 37+1
+ 6.055823 (fv 0.000000 1.140317 1.804958 0.269386 1.581973 1.647143 0.908514 1.357676 0.255360 0.413319 1.759464 1.403831 0.462290 0.275768 -0.260643 0.081477 0.945988 1.674168 1.558839 0.619719 0.448569 1.181188 0.261467 0.173066 0.317765 0.523175 1.483135 0.623965 0.065573 0.279749 1.647027 0.558187 1.546480 1.177439 1.567967 1.574734 1.849511 0.049835)
)
;;; 39 all -------------------------------------------------------------------------------- ; 6.2449
-#(39 7.3091864585876 #(0 0 0 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0)
- 7.2959136962891 #(0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 0 0)
- 7.2940211296082 #(0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0)
- 7.2713379859924 #(0 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0)
- 7.2698922157288 #(0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 1 0 0 0)
- 7.2519464492798 #(0 1 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0)
- 7.2313327789307 #(0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0)
- 7.1506487936623 #(0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 0 1)
+(vector 39 7.1506487936623 (fv 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 0 1)
+
+ 6.123916 (fv 0.000000 0.040215 0.172894 1.637830 1.177239 0.763654 -0.119272 0.532576 0.565933 -0.105342 -0.131500 0.223610 0.603849 1.034619 1.719874 1.942807 1.262885 -0.012239 1.521972 1.205939 0.909582 1.593149 1.660841 1.495691 0.901808 0.173365 0.594080 1.535985 0.099680 1.416781 0.772460 -0.143795 1.283054 1.611294 1.560252 0.291114 1.497861 0.152708 0.428638)
+ 6.123617 #(0.000000 0.022194 0.139382 1.578109 1.109939 0.686598 -0.209261 0.437705 0.449420 -0.232701 -0.273875 0.070822 0.433690 0.853619 1.527629 -0.258054 1.050086 -0.235174 1.275677 0.950078 0.647199 1.303772 1.358361 1.189190 0.591278 -0.165906 0.244128 1.187114 -0.273717 1.031390 0.371517 -0.540240 0.858520 1.177992 1.114387 -0.172733 1.027118 -0.340480 -0.076231)
- 6.130953 #(0.000000 0.038461 0.171605 1.637522 1.177657 0.764596 -0.121999 0.532157 0.566373 -0.107168 -0.131067 0.222564 0.601164 1.033230 1.720725 1.942372 1.261330 -0.012481 1.519629 1.204483 0.906347 1.595016 1.659825 1.493185 0.901436 0.172939 0.594674 1.531973 0.100311 1.415234 0.766685 -0.148692 1.282135 1.608493 1.559674 0.288962 1.494453 0.151064 0.429304)
+ ;; pp:
+ 6.206556 (fv 0.000000 0.714125 0.999676 1.714571 0.529099 1.103279 1.739177 0.796762 1.681925 0.899057 1.703669 0.970830 1.925662 0.861561 -0.048288 1.636413 0.684994 0.118298 1.376444 0.590000 0.292657 1.963808 1.418598 1.344996 0.647105 0.610362 0.012866 0.209613 -0.013687 0.186819 0.011104 -0.022072 0.158390 0.584179 1.099029 1.037543 1.650004 1.749468 0.443068)
)
;;; 40 all -------------------------------------------------------------------------------- ; 6.3245
-#(40 7.4570450782776 #(0 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0)
- 7.448447227478 #(0 1 1 1 0 1 1 1 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 0 0)
- 7.4427533149719 #(0 1 1 0 0 1 1 0 0 1 0 1 0 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0)
- 7.4250183105469 #(0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 1 0 0 1 1 0 0 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0)
- 7.4126052856445 #(0 1 0 1 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0)
- 7.4104852676392 #(0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 1)
- 7.4014959335327 #(0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0)
- 7.3913831710815 #(0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 0 0 0)
+(vector 40 7.3913831710815 (fv 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 0 0 0)
+
+ 6.288342 (fv 0.000000 1.454424 1.336242 0.229719 0.982419 1.371484 1.659070 1.721074 -0.039860 0.456961 0.523564 1.259764 0.318922 0.087125 -0.000634 1.738216 -0.345360 -0.093074 0.023146 0.160891 -0.147874 1.232278 0.789559 0.888228 0.482450 1.447335 0.166012 1.058063 1.516605 1.834071 1.250289 0.562291 1.417730 1.678824 0.619402 -0.109426 1.547164 0.339656 1.224949 0.726676)
+
+ ;; pp.scm using (+ pi (/ pi 40)) and (- (/ pi 2))
+ 6.236401 (fv 0.000000 0.772219 1.201231 0.091963 0.183059 1.041989 1.811758 0.387321 1.330915 0.336134 1.429758 0.457811 -0.040075 1.279315 -0.162113 0.993833 0.310259 1.390530 1.133639 0.515117 -0.283405 1.239507 1.056859 0.563309 0.888313 0.077823 -0.241421 1.625166 1.389376 1.528163 1.539643 1.801710 1.314626 1.482031 0.189224 0.088532 0.546429 0.832570 1.329921 1.394636)
- 6.328818 #(0.000000 -0.185771 1.608833 0.118847 0.817687 1.353844 1.415394 1.577468 -0.167919 0.452879 0.750506 1.135243 -0.091923 0.422968 0.015288 1.927628 -0.209142 0.433543 0.464803 0.118398 0.065517 0.879942 0.906211 1.106392 0.447050 1.638584 0.371725 1.545148 0.220166 -0.139773 1.376317 0.506218 1.939479 1.290399 0.482924 -0.145636 -0.030130 1.377304 1.794185 0.858100)
- 6.299043 #(0.000000 1.472809 1.342339 0.246263 0.991856 1.364904 1.647208 1.737556 -0.043009 0.433781 0.542673 1.274446 0.327101 0.080827 -0.005060 1.722843 -0.348703 -0.102392 0.020851 0.163683 -0.163807 1.232757 0.806939 0.869455 0.520612 1.473286 0.172075 1.061287 1.508730 1.814241 1.251176 0.573394 1.417654 1.686745 0.620310 -0.108344 1.534180 0.355574 1.249840 0.714009)
+ ;; 39+1
+ 6.223875 #(0.000000 0.017488 0.395122 1.676489 1.264189 0.771372 -0.011418 0.532062 0.348765 -0.291944 -0.034478 0.399358 0.691637 1.117218 1.716574 0.114046 1.298557 0.074462 1.617194 1.080550 1.108787 1.427161 1.645893 1.492515 0.908836 0.183198 0.586816 1.733289 0.192174 1.419647 0.686684 -0.174875 1.274049 1.555620 1.606137 0.123322 1.462205 0.157438 0.491542 -0.249961)
)
;;; 41 all -------------------------------------------------------------------------------- ; 6.4031
-#(41 7.5969347953796 #(0 1 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0)
- 7.5873513221741 #(0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0)
- 7.5666546821594 #(0 0 1 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 0)
- 7.5657444000244 #(0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 0 0 0)
- 7.544189453125 #(0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0)
- 7.4959030151367 #(0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0)
- 7.4493231773376 #(0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0)
- 7.4106826782227 #(0 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1)
+(vector 41 7.4106826782227 (fv 0 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1)
- 6.336362 #(0.000000 1.136564 1.769039 -0.302528 1.219485 1.077066 0.499384 0.459848 1.421023 1.898005 0.403090 0.295010 -1.896917 1.896083 1.647995 1.178305 0.666829 1.680796 0.463075 0.545628 1.334683 0.394364 -0.085600 0.753986 0.467752 0.515771 0.824057 0.897722 1.181114 -0.015790 0.947115 1.655981 0.729980 0.146814 0.128215 0.219239 0.873463 0.080337 1.491244 0.201806 0.413100)
+ 6.328763 (fv 0.000000 1.142395 1.764533 -0.297234 1.214342 1.074168 0.499096 0.455971 1.425043 1.900660 0.405160 0.299024 -1.901144 1.886599 1.644748 1.176229 0.661037 1.678309 0.464540 0.540147 1.345672 0.396385 -0.079815 0.750463 0.469580 0.512532 0.818295 0.900948 1.176821 -0.024695 0.941067 1.661160 0.722192 0.141569 0.127463 0.210921 0.877068 0.077777 1.493046 0.191845 0.414613)
+ 6.279752 #(0.000000 1.039440 1.670537 -0.269122 1.058663 1.073053 0.461356 0.338125 1.379608 1.686032 0.168477 0.220127 -0.046702 -0.025677 1.700045 1.127479 0.601951 1.764849 0.395397 0.778987 1.079511 0.525179 -0.400733 0.741798 0.221415 0.104621 0.721445 0.669340 0.961099 -0.201573 0.643173 1.703776 0.553797 -0.208803 -0.109492 0.033494 0.694117 0.116494 1.191608 0.020301 0.131256)
+ 6.278483 #(0.000000 1.038469 1.689102 -0.246889 1.070891 1.081477 0.456681 0.352855 1.380232 1.717208 0.185595 0.242413 -0.037760 -0.028341 1.684169 1.135689 0.606635 1.756147 0.422850 0.765104 1.090059 0.552553 -0.368817 0.733599 0.247441 0.131196 0.725118 0.703272 0.972734 -0.170957 0.673987 1.704514 0.578697 -0.183550 -0.096757 0.046184 0.705164 0.130867 1.217191 0.056397 0.199710)
+
+ ;; 40+1
+ 6.357979 #(0.000000 -0.014992 0.249240 1.543670 1.126815 0.662312 -0.052816 0.619055 0.369857 -0.115477 -0.003391 0.180442 0.565001 0.924831 1.661456 -0.128503 1.291579 -0.077357 1.542827 0.991944 0.960719 1.395109 1.631218 1.333505 0.925448 -0.150607 0.489479 1.798022 -0.099011 1.252747 0.567676 -0.055660 1.075602 1.407498 1.261622 0.087709 1.323935 -0.086458 0.259809 -0.431448 0.139996)
)
;;; 42 all -------------------------------------------------------------------------------- ; 6.4807
-#(42 7.8644123077393 #(0 0 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0)
- 7.8588690757751 #(0 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 0 0 1 1 1)
- 7.8527493476868 #(0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0)
- 7.8154973983765 #(0 1 1 0 1 0 1 0 0 1 1 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0)
- 7.7903428077698 #(0 1 0 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 0)
- 7.7545323371887 #(0 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 1 0 1 0 0 0 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1)
- 7.6252284049988 #(0 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0)
+(vector 42 7.6252284049988 (fv 0 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0)
+
+ 6.458009 (fv 0.000000 1.779914 1.358689 1.879744 1.431714 1.455314 0.050417 0.106324 1.650278 0.287736 1.685176 1.015814 0.661574 0.193645 0.754970 0.912901 1.865274 -0.192264 1.123351 1.730828 0.304030 1.844656 1.379904 1.178786 0.508869 0.433728 0.920606 1.193377 1.562403 0.705424 1.521220 0.671316 1.715032 0.818246 0.696173 0.646766 1.054986 -0.067193 0.041834 0.484025 0.025667 0.817193)
- 6.464893 #(0.000000 1.777721 1.362060 1.880737 1.431585 1.455037 0.052702 0.105796 1.651630 0.287045 1.683139 1.015277 0.661529 0.194207 0.756376 0.910419 1.866053 -0.192627 1.123051 1.729823 0.301806 1.843362 1.378516 1.176461 0.506074 0.433232 0.920716 1.193082 1.560050 0.706086 1.520300 0.669832 1.714507 0.815715 0.696115 0.645572 1.054319 -0.068772 0.041576 0.487012 0.023257 0.816292)
+ ;; pp:
+ 6.432404 (fv 0.000000 0.970539 1.075055 0.363395 0.562687 1.503003 0.305818 1.159109 -0.331893 0.844703 -0.625323 0.633095 -0.150641 1.248856 0.138597 1.484859 0.287309 -0.516557 0.004989 0.635673 0.412760 0.072104 -0.034630 0.781885 1.052252 0.670637 0.477407 0.370916 -0.497791 0.214269 0.268953 -0.018432 0.090095 0.191222 0.329896 1.234637 1.181873 1.460275 -0.201010 0.565027 0.336488 1.227322)
+
+ ;; 41+1
+ 6.374134 #(0.000000 1.160594 -0.035009 -0.337995 1.287896 1.152937 0.370349 0.599654 1.434075 0.331903 0.337639 0.227520 0.031784 0.056373 1.754183 1.233325 0.766762 -0.105337 0.381752 0.608417 1.177813 0.853286 -0.000702 0.980553 0.580193 0.503346 0.721433 1.102554 1.338903 -0.104016 1.021288 -0.193635 0.638903 0.186655 0.282480 0.311801 1.029234 0.514030 1.400087 0.298091 0.559980 -0.413468)
)
;;; 43 all -------------------------------------------------------------------------------- ; 6.5574
-#(43 7.8286972045898 #(0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0)
- 7.824122428894 #(0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 1 1)
- 7.8140468597412 #(0 1 0 1 0 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 0)
- 7.8020606040955 #(0 1 1 1 0 0 0 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 0 0 0 0 0)
- 7.7842569351196 #(0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1)
- 7.7697319984436 #(0 0 1 0 1 0 1 1 0 1 0 1 0 0 0 1 1 1 0 1 0 0 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1)
- 7.7580170631409 #(0 0 0 0 1 1 1 0 1 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0)
- 7.7244353294373 #(0 1 0 1 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1)
- 7.6866073608398 #(0 1 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0)
- 7.6619415283203 #(0 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1)
+(vector 43 7.6619415283203 (fv 0 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1)
+
+ 6.474636 (fv 0.000000 1.150199 1.694193 1.156056 0.712558 0.642330 1.062359 0.333465 0.208319 1.376434 0.672147 0.421707 0.175691 0.110131 0.012554 0.457050 1.790874 1.449901 0.302494 0.007271 0.824529 0.122259 0.582806 0.097251 0.623774 0.359297 1.299289 0.938333 1.768060 0.180654 1.104716 1.340371 1.395970 0.480619 1.800871 0.228016 0.933560 0.262964 0.673103 1.298731 1.471774 -0.223423 0.770589)
+
+ ;; 42+1
+ 6.484540 #(0.000000 0.799805 0.296138 -0.181661 1.243255 0.972255 0.211011 0.157981 1.334009 0.607658 0.666111 0.172358 0.489130 0.433262 0.074913 -0.108461 0.327642 -0.177912 0.391650 0.361860 1.366441 1.197611 0.114750 0.879694 0.781347 0.470866 0.964657 1.349973 1.443504 0.050313 1.040919 -0.331503 1.092413 0.101381 0.547246 0.325671 1.577550 0.316146 1.327141 0.900920 0.939639 -0.347989 0.327657)
+ )
- 6.482409 #(0.000000 1.144559 1.691771 1.153951 0.716239 0.646091 1.063134 0.342868 0.213241 1.376155 0.672100 0.425584 0.173096 0.110029 0.015293 0.460666 1.796149 1.444048 0.314197 0.012835 0.819748 0.119031 0.582195 0.100074 0.621426 0.361508 1.290142 0.942275 1.772437 0.174260 1.102162 1.335380 1.397832 0.481081 1.799028 0.225127 0.933833 0.257264 0.672894 1.297185 1.465653 -0.223387 0.778846)
- )
;;; 44 all -------------------------------------------------------------------------------- ; 6.6332
-#(44 8.0920171737671 #(0 0 0 0 1 0 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 1 0 1 0 0)
- 7.9767818450928 #(0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1)
+(vector 44 7.9767818450928 (fv 0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1)
- 6.552505 #(0.000000 0.516530 0.224688 0.526733 -0.270777 1.917868 -0.031145 -0.157428 0.072119 1.708014 1.778556 0.463152 0.275914 0.508605 1.163702 0.356039 -1.719404 0.466987 0.149273 1.208679 1.406203 0.743516 1.669343 1.404167 0.072628 0.264489 0.573670 0.758686 -0.024977 1.581357 0.913109 1.310679 0.226713 0.685141 1.566700 0.432175 -0.042399 1.284123 0.875160 0.466218 1.017090 0.066147 1.376720 0.160417)
+ 6.544063 (fv 0.000000 0.521564 0.221232 0.526957 -0.268317 1.919404 -0.035203 -0.157289 0.069290 1.705251 1.788014 0.459816 0.274398 0.505529 1.163758 0.357930 -1.720040 0.469129 0.146265 1.215606 1.405712 0.742844 1.668145 1.402279 0.067840 0.255308 0.567789 0.756058 -0.027555 1.587315 0.915687 1.314433 0.227656 0.688969 1.566702 0.434208 -0.041884 1.283408 0.878206 0.471503 1.018383 0.062893 1.376612 0.157588)
+
+ ;; 43+1
+ 6.617718 #(0.000000 0.929303 0.214195 -0.305607 1.575411 0.960005 0.543631 0.816651 1.159803 0.112080 0.077010 0.590695 -0.040249 -0.288217 1.448848 1.235788 0.754544 -0.407692 0.476307 0.769330 1.241658 1.259441 0.282090 0.960527 0.572071 0.268642 0.862727 -0.063301 1.181813 0.657762 0.694907 0.056205 0.912295 0.475141 0.694152 0.927496 1.094556 1.105653 1.775202 -0.143116 1.075592 -0.229850 0.469130 -0.375239)
)
;;; 45 all -------------------------------------------------------------------------------- ; 6.7082
-#(45 8.197151904921 #(0 0 0 1 1 0 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1)
- 8.1777801513672 #(0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 1)
+(vector 45 8.1777801513672 (fv 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 1)
+
+ 6.629206 (fv 0.000000 0.961180 -0.043617 -0.239190 1.278111 0.166389 0.542833 0.768578 1.444629 -0.095831 1.211952 -0.026602 1.739185 0.951577 1.809231 0.253449 0.320575 0.356270 1.309005 0.639731 1.394153 0.026971 -0.051944 0.744827 0.030297 -0.420287 0.144422 1.021322 1.302658 0.297709 -0.048481 -0.152658 1.144902 1.677136 1.170155 1.132592 1.153458 -0.076024 1.369092 1.009916 0.503324 -0.247395 0.103592 1.569752 0.081999)
+ 6.624045 #(0.000000 1.027137 -0.006949 -0.241567 1.292392 0.249243 0.688163 0.937733 1.490593 0.055551 1.221039 0.178575 1.739730 1.011821 -0.089036 0.442654 0.375914 0.532475 1.410268 0.844396 1.467724 0.085993 0.105745 0.803510 0.299479 -0.089745 0.369095 1.074672 1.565553 0.558935 0.123221 0.059937 1.431538 -0.190214 1.489626 1.543857 1.489693 0.130690 1.680298 1.260465 0.724859 0.164445 0.433945 -0.212764 0.411030)
+ 6.612690 #(0.000000 0.809914 0.760766 -0.199070 0.584393 1.010129 -0.444768 -0.272636 0.950655 0.770420 -0.288810 0.049214 -1.454088 0.191424 -1.076560 -0.306479 -0.326951 -1.245176 0.685415 0.506132 0.101749 0.628099 0.641810 0.560186 1.064779 -0.804404 -0.612448 0.708592 1.898500 0.642577 0.682702 -0.598959 -1.216733 -1.420060 0.084743 0.265460 1.286043 0.185429 1.160604 0.022683 -0.437513 0.122344 -0.218434 -0.653674 -1.002688)
- 6.639489 #(0.000000 0.966420 -0.044531 -0.240502 1.270298 0.169441 0.543088 0.772071 1.440700 -0.093594 1.218663 -0.019734 1.742907 0.945849 1.806797 0.252599 0.311111 0.361190 1.303388 0.643250 1.387776 0.026360 -0.052141 0.742454 0.035272 -0.414124 0.148909 1.021694 1.310608 0.295730 -0.047078 -0.147191 1.152931 1.674629 1.172328 1.139236 1.154731 -0.074720 1.377379 1.004684 0.506295 -0.238786 0.104153 1.570431 0.085954)
+ ;; 44+1
+ 6.714595 #(0.000000 0.564364 0.130777 0.656228 -0.319916 1.775107 -0.124290 -0.070841 0.124442 1.500414 1.820670 0.445101 0.236733 0.416487 1.155210 0.503587 -1.734245 0.426011 0.254073 1.069259 1.324509 0.611279 1.824321 1.376553 -0.114105 0.172880 0.631450 0.863080 -0.077524 1.662079 0.769087 1.304043 0.122140 0.610255 1.653927 0.326711 -0.168576 1.291324 0.851943 0.606010 1.047149 0.079373 1.047078 0.035371 -0.264517)
)
;;; 46 all -------------------------------------------------------------------------------- ; 6.7823
-#(46 8.4391345977783 #(0 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0)
- 8.22203540802 #(0 1 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 0)
+(vector 46 8.22203540802 (fv 0 1 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 0)
- 6.699675 #(0.000000 1.448795 1.081717 1.923365 0.599093 0.110602 0.062986 0.201393 1.127916 0.800992 0.134374 1.541686 0.425230 0.988970 1.044715 0.905011 0.394025 1.877303 1.779770 0.103636 0.810901 1.462019 1.298360 0.506301 0.690905 0.079943 0.741252 1.295527 0.922954 1.948031 1.523204 1.191425 1.863021 1.502798 -0.017565 0.925811 1.378082 1.110394 1.347775 1.468163 0.886624 1.241739 -0.114390 0.646794 0.156750 0.998631)
+ 6.691037 (fv 0.000000 1.445996 1.082935 1.926602 0.599270 0.110590 0.061353 0.197460 1.126524 0.801213 0.136799 1.544533 0.424316 0.988423 1.042912 0.904549 0.394264 1.877367 1.781398 0.106378 0.814176 1.462479 1.299353 0.505357 0.691608 0.079788 0.741755 1.296349 0.923407 1.954315 1.519832 1.193777 1.868646 1.501978 -0.016089 0.928107 1.377054 1.114171 1.348483 1.466927 0.885968 1.244812 -0.112245 0.649026 0.159882 0.999017)
+
+ ;; 45+1
+ 6.737496 #(0.000000 0.891082 0.437629 -0.631499 1.355029 0.088312 0.525030 0.893686 1.472031 -0.146846 0.973741 0.114371 1.794819 1.120888 1.803610 0.267646 0.313821 0.176598 1.483030 0.561548 1.444435 0.111178 -0.116383 0.572485 0.384889 -0.539242 -0.000026 1.504176 1.488659 0.718239 -0.059775 0.251172 1.363526 1.830593 1.709614 1.067908 1.076519 0.522533 1.398513 0.992929 0.954368 -0.123192 0.213695 1.865385 0.089802 -0.018905)
)
;;; 47 all -------------------------------------------------------------------------------- ; 6.8556
-#(47 8.4154777526855 #(0 1 1 1 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 1 0)
- 8.3755550384521 #(0 0 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0)
- 8.3640232086182 #(0 0 0 0 1 0 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 1 1 0 0 0)
- 8.3221893310547 #(0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 1 0 1 0 0)
+(vector 47 8.3221893310547 (fv 0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 1 0 1 0 0)
+
+ 6.827640 (fv 0.000000 1.713417 0.880595 0.228916 0.656232 0.000986 0.228917 -0.027955 1.208960 0.359921 0.457263 0.229897 0.942770 1.345553 -0.054940 0.652154 0.967593 1.474188 0.749564 1.214391 0.623653 1.483712 1.914097 -0.195445 1.486123 0.775521 1.114155 1.267810 1.798008 0.660315 0.102413 1.302210 1.004781 1.037205 1.145399 0.299807 1.478644 1.078433 0.364686 1.769537 0.263449 0.339932 0.328599 1.167886 1.782492 1.089675 1.333666)
- 6.839431 #(0.000000 1.707000 0.885271 0.233907 0.651927 -0.011748 0.217674 -0.026454 1.211428 0.349699 0.457067 0.222525 0.948014 1.342792 -0.049850 0.652055 0.968625 1.464418 0.749553 1.222877 0.635210 1.480624 1.915233 -0.202765 1.474975 0.776193 1.112445 1.266123 1.809237 0.658024 0.102958 1.290639 1.006124 1.030838 1.151617 0.307178 1.475376 1.085280 0.368954 1.771707 0.262040 0.332089 0.325281 1.173936 1.776791 1.092991 1.334125)
+ ;; pp.scm
+ 6.756605 (fv 0.000000 0.765562 1.030062 1.788209 0.493707 1.020553 1.799942 0.685170 1.481088 0.566613 1.302518 0.066670 1.157386 0.282906 1.328526 0.161298 1.388649 0.879050 1.843229 1.039366 0.409576 -0.055025 1.222366 0.535280 0.169247 1.679128 1.342099 0.894436 0.643082 0.345708 0.301808 -0.401334 0.022950 1.550170 1.565812 1.633017 1.764984 1.880338 1.607034 1.569498 0.111731 0.416082 0.781558 0.894597 1.438223 1.659212 0.166997)
)
;;; 48 all -------------------------------------------------------------------------------- ; 6.9282
-#(48 8.6921081542969 #(0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1)
- 8.5232070520636 #(0 0 1 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 1 1)
- 8.4671268463135 #(0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1)
+(vector 48 8.4671268463135 (fv 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1)
- 6.871100 #(0.000000 0.601479 1.243488 1.031934 1.049235 0.596883 1.662432 1.332867 0.654168 1.789395 1.338287 0.008569 0.383718 1.918449 0.167686 0.199365 1.570673 1.514426 0.642526 0.516053 0.941786 -0.405198 1.600367 0.834398 0.797046 0.741498 0.174574 0.975068 0.363528 0.473179 1.257141 0.662389 1.164668 0.895449 1.707104 0.726409 0.457854 0.350294 0.207246 0.807488 1.129362 1.480839 0.314066 1.583313 0.357468 0.760120 1.603578 0.627828)
+ 6.861797 (fv 0.000000 0.598880 1.244788 1.029903 1.049082 0.596958 1.659653 1.333585 0.658254 1.786003 1.335584 0.009329 0.382880 1.914281 0.167535 0.198984 1.572176 1.516863 0.640701 0.516067 0.942009 -0.405338 1.601326 0.836539 0.796978 0.739838 0.171913 0.969497 0.363583 0.469203 1.258504 0.656687 1.162915 0.889585 1.702682 0.725369 0.456133 0.349105 0.208023 0.802519 1.129136 1.479603 0.312580 1.579555 0.353334 0.757965 1.599847 0.626811)
+
+ ;; 47+1
+ 6.892392 #(0.000000 0.688844 1.275690 -0.029196 0.666687 1.219038 1.796126 0.686703 1.387045 0.299015 1.486000 0.217586 1.168099 0.122356 1.320410 0.506266 1.401144 0.705689 0.099274 1.001293 0.250881 -0.338513 1.011906 0.589633 -0.026149 1.658621 0.999181 0.670111 0.425438 0.181969 0.283085 -0.428382 -0.237009 1.436619 1.467751 1.345785 1.658556 -0.130875 1.611827 1.446511 -0.136029 0.162128 0.614874 0.798756 1.306679 1.726452 0.077838 -0.060906)
+
+ ;; 50-2
+ 6.804078 #(0.000000 0.874821 0.948620 -0.030050 0.326575 1.258972 -0.088513 0.113859 0.340515 -0.014269 1.691477 0.675893 0.119114 -0.035346 1.426532 1.152480 0.791174 0.976063 0.731143 1.014136 1.203667 0.311022 -0.203371 1.591275 1.628122 -0.181766 0.450459 0.902610 0.339563 -0.440014 -0.112189 0.959920 1.425584 0.089561 1.717366 0.518887 0.024084 1.133195 1.349821 0.385099 1.797184 0.189610 0.147986 1.156584 -0.006309 1.527354 0.195815 0.002013)
)
;;; 49 all -------------------------------------------------------------------------------- ; 7
-#(49 8.7310771942139 #(0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 1 0 1 0 1 0)
- 8.6587047576904 #(0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 0 0 1 0 1 0 0)
- 8.7183141708374 #(0 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 1)
- 8.5157623291016 #(0 1 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0)
+(vector 49 8.5157623291016 (fv 0 1 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0)
- 6.921571 #(0.000000 1.428159 -0.117715 -0.216673 1.072814 1.015693 0.650701 1.622259 0.539828 0.421480 1.870093 1.161169 0.985539 1.720420 0.365388 0.060714 0.531355 1.517179 1.463949 0.724994 0.961176 1.538829 1.564877 1.431255 0.933914 1.183544 1.508100 -0.167102 1.668032 0.675482 0.243270 0.673725 0.266636 1.083568 0.367176 -0.139144 -0.047776 1.096102 1.977531 0.481511 1.201649 0.171345 0.858647 0.506382 1.643450 0.142346 0.246748 1.854181 0.300891)
+ 6.911687 (fv 0.000000 1.423917 -0.117078 -0.215912 1.065526 1.018507 0.645263 1.632151 0.540556 0.415851 1.870183 1.161732 0.983376 1.723916 0.372700 0.063452 0.534166 1.512588 1.454603 0.719318 0.962295 1.537720 1.562020 1.433858 0.930756 1.181983 1.504188 -0.167777 1.662278 0.680834 0.246207 0.675469 0.268474 1.089455 0.369548 -0.146942 -0.055836 1.091821 1.976652 0.486415 1.202030 0.175707 0.854435 0.506884 1.646470 0.139127 0.235704 1.857608 0.297006)
+
+ ;; 50-1
+ 6.910295 #(0.000000 1.059948 1.102312 -0.154766 0.271011 1.001259 -0.322228 0.611181 1.084580 0.193049 1.708690 0.549448 0.114307 -0.112275 1.323751 1.621007 1.041438 1.446405 0.346446 0.779211 0.803707 0.229069 1.620947 -0.129471 -0.141064 0.581982 -0.069220 1.242954 -0.424957 -0.059702 -0.076232 1.090459 1.897927 -0.587283 0.232044 0.877329 -0.465364 1.521832 1.430023 0.510607 0.119336 0.032708 0.304452 0.848312 0.725150 0.798920 0.612486 0.214940 1.234846)
+ 6.907185 #(0.000000 1.059469 1.114179 -0.150791 0.258478 0.994889 -0.336259 0.599168 1.084896 0.192104 1.698208 0.543042 0.115884 -0.128271 1.314296 1.621485 1.044197 1.442142 0.334969 0.776113 0.823403 0.227295 1.618113 -0.132905 -0.144839 0.578330 -0.074014 1.260097 -0.447140 -0.067108 -0.086664 1.078815 1.896924 -0.604152 0.214555 0.862267 -0.492164 1.511993 1.411560 0.503434 0.119933 0.010833 0.282277 0.838215 0.717315 0.788849 0.600355 0.201253 1.210362)
)
;;; 50 all -------------------------------------------------------------------------------- ; 7.071
-#(50 8.8124130871436 #(0 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 0 1 1)
- 8.8096923828125 #(0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1)
- 8.7809114456177 #(0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 1)
+(vector 50 8.7809114456177 (fv 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 1)
+
+ 7.001572 (fv 0.000000 1.510483 0.569660 1.177547 -0.063746 1.651491 0.398933 1.945813 1.189455 0.886784 0.877834 1.209513 -0.281791 0.817195 0.562593 1.509576 -0.448618 -0.075249 1.004074 1.022851 1.197099 0.475529 0.725043 0.148549 0.625214 0.676229 0.641014 0.276388 1.297552 1.512294 0.880442 -0.093329 0.470630 1.205879 -0.595773 0.927383 1.198964 0.435022 1.291534 0.884451 -0.190056 1.483748 1.136079 1.665203 0.167401 0.524695 0.182147 -0.336866 0.803181 1.503900)
- 7.012037 #(0.000000 1.518462 0.574719 1.180581 -0.071581 1.653903 0.383507 1.942586 1.193435 0.894300 0.881006 1.205594 -0.288325 0.828304 0.567914 1.512952 -0.440030 -0.090766 1.002786 1.021351 1.187251 0.469608 0.728567 0.145823 0.628420 0.677462 0.648236 0.282939 1.286544 1.503623 0.871216 -0.095610 0.470791 1.182595 -0.605051 0.913214 1.210469 0.442104 1.279187 0.878023 -0.172203 1.482435 1.115265 1.665926 0.162893 0.521820 0.173284 -0.336809 0.804378 1.499300)
+ ;; 49+1
+ 7.064944 #(0.000000 1.558009 -0.108565 -0.226913 0.920197 1.180894 0.537671 1.554384 0.613756 0.458358 0.091191 1.387557 0.869986 1.858139 0.547904 0.135691 0.583740 1.710905 1.421339 0.744505 1.032127 1.414994 1.701011 1.686329 0.940524 1.064348 1.388446 -0.279583 1.723434 0.898036 0.320378 0.547937 0.335420 1.264319 0.407052 0.022184 -0.017105 0.905945 1.912730 0.523724 1.239641 0.158867 0.840449 0.693502 1.785642 0.002311 0.342012 1.897108 0.429747 0.359280)
+
+ ;; 51-1?
+ 6.967233 #(0.000000 0.970268 1.092398 1.888744 0.176055 1.242915 -0.182630 0.498873 0.714528 0.065776 1.516006 0.488189 0.172228 1.824642 1.137081 1.246514 0.918186 1.083274 0.311853 0.739323 0.800717 0.461460 1.390793 1.467948 1.702761 -0.157496 0.172343 0.955766 -0.200187 -0.202194 -0.109455 0.590305 1.500923 -0.065490 1.470764 0.488682 -0.351464 1.288146 1.359535 0.275868 1.584539 0.037303 -0.097518 0.950689 0.185166 0.880435 0.283304 -0.239816 1.354407 1.605268)
+ 6.966444 #(0.000000 0.969561 1.094228 1.889603 0.178237 1.243506 -0.179029 0.498784 0.715615 0.064553 1.519591 0.490911 0.171201 1.825529 1.138600 1.243991 0.920476 1.084610 0.315165 0.739666 0.806931 0.459500 1.392905 1.470398 1.703973 -0.154232 0.175316 0.961121 -0.195877 -0.203581 -0.104914 0.596805 1.500152 -0.064411 1.474852 0.495330 -0.345550 1.291380 1.361659 0.279253 1.587805 0.037979 -0.094175 0.955070 0.189359 0.883451 0.286407 -0.239876 1.359571 1.605865)
)
;;; 51 all -------------------------------------------------------------------------------- ; 7.141
-#(51 8.8691492080688 #(0 1 1 1 1 0 1 0 1 0 1 1 1 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1)
- 8.8213935921978 #(0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1)
+(vector 51 8.8213935921978 (fv 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1)
- 7.072652 #(0.000000 1.276053 1.272640 1.602245 -0.115082 1.092895 -0.116279 0.584274 0.518657 0.111451 1.394885 0.472340 0.525794 1.783643 1.010164 1.308342 0.598472 1.173559 0.653082 0.686440 0.653554 0.574400 1.695799 1.670141 1.661321 -0.231877 0.197920 0.719332 -0.176115 0.107877 -0.040788 0.923442 1.332118 1.400206 1.533232 0.345811 -0.105908 1.449314 1.226733 0.352279 1.457541 0.190602 1.883826 0.819410 0.140480 0.965943 0.017846 -0.013368 1.274513 1.512794 0.227520)
+ 7.062061 (fv 0.000000 1.277482 1.272374 1.604932 -0.114681 1.091849 -0.113655 0.581995 0.517152 0.112646 1.392203 0.473053 0.525951 1.781540 1.014930 1.311666 0.597941 1.173291 0.649975 0.688396 0.657382 0.570575 1.699334 1.669408 1.662666 -0.233111 0.196711 0.718758 -0.174442 0.105462 -0.039308 0.924279 1.329687 1.401301 1.538357 0.347724 -0.110320 1.449195 1.223831 0.349599 1.470761 0.191238 1.885833 0.819453 0.145490 0.967802 0.015777 -0.014902 1.276127 1.513254 0.227467)
+ 7.061972 #(0.000000 1.276628 1.273765 1.607581 -0.114970 1.091264 -0.113040 0.580864 0.516735 0.113082 1.390932 0.474109 0.525638 1.784132 1.017927 1.316859 0.597754 1.174733 0.647452 0.691328 0.661372 0.567341 1.701460 1.671297 1.665426 -0.232474 0.194748 0.720612 -0.170875 0.103745 -0.037365 0.924964 1.329745 1.406880 1.540907 0.349954 -0.109891 1.449476 1.227519 0.347601 1.477324 0.191963 1.887908 0.821661 0.147626 0.967297 0.015607 -0.013051 1.280470 1.516669 0.226095)
)
;;; 52 all -------------------------------------------------------------------------------- ; 7.211
-#(52 9.1133499145508 #(0 0 1 1 0 1 1 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 0 1)
- 9.109245300293 #(0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 0 0 0 1 1 0 0 1 1 1 0 0 0 0 0 0)
- 8.9920463562012 #(0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0)
+(vector 52 8.9920463562012 (fv 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0)
+
+ 7.134954 (fv 0.000000 0.621560 1.464578 1.482376 0.135707 1.345519 0.584967 0.540885 1.784345 0.393329 1.745283 0.530433 1.414971 1.247472 1.329889 0.999552 0.933504 1.580199 0.519254 0.315472 0.473007 1.123477 -0.056053 0.241576 0.391709 1.244898 1.883529 1.120931 1.698334 -0.149261 0.218191 1.134898 0.533381 1.222211 0.249553 -0.114715 1.262472 0.846800 0.877356 0.688478 0.673983 1.103698 1.385836 1.036560 1.331275 0.414915 1.604362 0.874160 0.543444 1.406115 1.239524 0.816202)
+ 7.131761 #(0.000000 0.537475 1.434186 1.485257 0.169881 1.416948 0.579251 0.545053 1.903917 0.399401 1.765906 0.542670 1.396121 1.264296 1.322696 0.985374 0.995894 1.591655 0.505552 0.250919 0.433406 1.124308 -0.040021 0.168815 0.391865 1.242269 1.875020 1.121196 1.704677 -0.131089 0.170120 1.111726 0.615076 1.228577 0.309881 -0.149015 1.305694 0.861912 0.914108 0.664306 0.720147 1.136263 1.351328 1.011200 1.402304 0.485461 1.536405 0.819898 0.530949 1.451849 1.212610 0.799774)
- 7.145945 #(0.000000 0.618534 1.462183 1.480620 0.139044 1.350448 0.582538 0.545020 1.783759 0.393210 1.748123 0.527539 1.415076 1.250169 1.330978 1.006467 0.931859 1.577727 0.520208 0.309085 0.476065 1.121194 -0.056674 0.240879 0.396009 1.245343 1.886860 1.120968 1.699219 -0.144729 0.212044 1.133426 0.534474 1.225983 0.251700 -0.120102 1.262285 0.853827 0.882016 0.690677 0.674538 1.110152 1.383976 1.043216 1.337252 0.412146 1.596391 0.874214 0.544627 1.408675 1.248701 0.818888)
+ ;; 51+1
+ 7.189639 #(0.000000 1.613047 1.226926 1.461226 -0.208975 1.160308 0.015278 0.874276 0.441796 0.145203 1.228806 0.566007 0.867165 1.631256 1.099751 1.575849 0.905365 1.096254 1.105187 0.482059 0.890391 0.608271 1.917275 1.824879 1.614793 0.165400 0.031023 0.768526 0.036022 0.101130 0.266024 1.042278 1.643239 1.401788 1.800366 0.504130 0.383632 -0.022284 1.238194 0.732080 1.858191 0.525715 0.107150 0.590054 0.832408 1.192418 0.215401 0.405342 1.484800 1.897855 1.002469 0.467126)
)
;;; 53 all -------------------------------------------------------------------------------- ; 7.280
-#(53 9.171422958374 #(0 0 1 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 1 1 1 0)
- 9.0914754867554 #(0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 1 1 0 0)
+(vector 53 9.0914754867554 (fv 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 1 1 0 0)
+
+ 7.198047 (fv 0.000000 0.609644 0.849387 1.600527 1.158365 1.715833 0.524245 -0.059778 0.291176 0.319451 0.985683 1.372433 1.089427 1.749317 1.594481 0.166060 0.927925 -0.362027 0.850015 1.635397 0.732972 1.007069 0.880865 0.290674 0.176669 0.886718 1.772633 0.908528 -0.020813 0.082874 0.257671 1.590012 0.330359 1.893554 1.401328 1.102801 0.720925 0.360594 1.357080 1.833049 0.574052 1.403405 1.851942 1.638866 1.670052 -0.125543 1.654904 0.840665 0.189500 1.798641 0.330271 0.101100 1.702877)
- 7.209094 #(0.000000 0.612833 0.847420 1.599295 1.160337 1.715965 0.523134 -0.052392 0.294416 0.317311 0.991409 1.371117 1.087165 1.749911 1.595414 0.163865 0.927248 -0.367457 0.847712 1.637484 0.733862 1.006649 0.882135 0.293298 0.175148 0.883926 1.769097 0.905189 -0.022552 0.080220 0.262196 1.590093 0.327460 1.892776 1.403026 1.106698 0.719004 0.358594 1.354312 1.829349 0.571375 1.403295 1.844565 1.637189 1.669162 -0.121908 1.652623 0.850515 0.187001 1.799725 0.328936 0.100823 1.704811)
+ ;; 54-1
+ 7.246308 #(0.000000 1.532310 -0.094995 1.372753 -0.225031 1.502079 0.056954 0.367578 1.317903 -0.308906 0.288435 -0.135988 0.144140 1.007501 -0.258190 0.832754 1.691061 0.210863 0.421782 1.089380 1.093649 0.443939 0.473594 0.319946 1.564712 -0.127810 1.590182 1.208800 1.280863 -0.068396 1.806097 1.025552 0.141011 1.391092 0.873396 0.397519 1.327658 0.757527 1.353264 0.340770 0.460425 0.732779 1.339617 0.707719 1.128519 1.697349 1.656716 0.826604 0.294361 0.406394 0.110907 1.094470 0.337662)
)
;;; 54 all -------------------------------------------------------------------------------- ; 7.348
-#(54 9.2755253455568 #(0 1 1 0 1 1 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 1 1 1 1)
- 9.1825122833252 #(0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1)
+(vector 54 9.1825122833252 (fv 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1)
- 7.265959 #(0.000000 1.659027 -0.127520 1.382335 -0.145009 1.237177 0.073542 0.450153 1.197453 -0.231628 0.109704 0.006064 0.130666 1.043101 -0.220223 0.680973 1.438047 0.446195 0.558605 1.086637 1.046192 0.270844 0.431116 0.186523 1.461544 -0.058809 1.603425 1.075507 1.038319 -0.059923 1.627674 1.136454 0.010663 1.425562 0.763051 0.525967 1.174251 0.675129 1.456436 0.406196 0.548951 0.833277 1.203166 0.764469 1.011085 1.776195 1.634564 0.871111 0.212395 0.454923 0.082894 1.240608 0.537501 0.782225)
+ 7.253898 (fv 0.000000 1.663275 -0.127344 1.382101 -0.144643 1.243444 0.071415 0.455351 1.200018 -0.228088 0.114774 0.009236 0.130605 1.041538 -0.220166 0.676007 1.432141 0.450339 0.554653 1.087402 1.040513 0.270076 0.433523 0.188787 1.457394 -0.061608 1.604147 1.071620 1.033490 -0.059301 1.622008 1.136168 0.012303 1.419176 0.768515 0.526817 1.171505 0.678139 1.461086 0.399056 0.554571 0.834287 1.199853 0.770698 1.010430 1.778823 1.630548 0.874770 0.206125 0.453526 0.079377 1.237714 0.535149 0.779971)
+ 7.251376 #(0.000000 1.671606 -0.132668 1.341878 -0.143910 1.246587 0.061425 0.494279 1.199722 -0.185866 0.117035 0.003655 0.151884 1.021723 -0.210779 0.641242 1.366533 0.459003 0.565412 1.109528 1.023492 0.285228 0.454125 0.242355 1.465689 -0.057208 1.627387 1.006195 1.007496 -0.044962 1.574220 1.136668 0.030509 1.454684 0.778081 0.519496 1.098118 0.703324 1.453053 0.377008 0.578494 0.803467 1.196201 0.736893 1.011210 1.821383 1.576365 0.863547 0.163595 0.432959 0.102185 1.227214 0.512712 0.787061)
)
;;; 55 all -------------------------------------------------------------------------------- ; 7.416
-#(55 9.2178440093994 #(0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 0)
- 9.0889595835043 #(0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1)
+(vector 55 9.0889595835043 (fv 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1)
- 7.340585 #(0.000000 0.946452 0.378361 1.733275 1.133321 1.113794 -0.198783 1.057892 0.983855 1.739966 0.452763 0.852251 1.634827 0.968473 1.084849 0.999225 1.405125 1.477330 -0.290368 1.533247 1.688850 0.973274 0.920558 1.409952 0.402276 0.418563 1.362327 0.022401 1.436669 0.094827 0.951348 1.024102 1.294559 0.837296 1.422417 0.668180 1.669399 0.345226 0.452445 -0.157734 1.065237 0.335469 0.247611 -0.005126 1.631069 0.774705 0.406301 1.394409 1.822692 -0.222467 -0.235538 0.863405 1.172529 0.611285 1.502973)
+ 7.328036 (fv 0.000000 0.947722 0.378414 1.734925 1.134763 1.116950 -0.197611 1.060282 0.984801 1.744033 0.450580 0.852453 1.635373 0.966832 1.084419 1.003901 1.404608 1.476265 -0.291566 1.533682 1.691990 0.972863 0.920394 1.410967 0.405768 0.418479 1.362359 0.024022 1.434953 0.091943 0.952661 1.025574 1.292952 0.834214 1.423909 0.663594 1.666584 0.346034 0.453528 -0.158265 1.069551 0.339500 0.250235 -0.001369 1.635787 0.775741 0.405595 1.391152 1.825120 -0.221132 -0.233774 0.866177 1.169485 0.610484 1.501517)
+
+ ;; 54+1
+ 7.432099 #(0.000000 1.618747 -0.153449 1.551651 0.057022 0.983319 0.329322 0.592671 1.061368 -0.265451 0.093666 0.073689 0.191970 0.941940 -0.226532 0.630718 1.504459 0.398912 0.677456 0.969759 0.922508 0.474687 0.473824 0.106191 1.485519 0.211317 1.508720 1.087336 1.052013 0.035924 1.550864 1.050089 0.185510 1.339619 0.715238 0.544593 0.922333 0.813638 1.418714 0.428930 0.510114 0.892067 1.174189 0.405049 1.026718 -0.076773 1.305507 0.682450 0.215555 0.324834 -0.145842 1.269187 0.603278 0.899585 -0.345857)
)
;;; 56 all -------------------------------------------------------------------------------- ; 7.483
-#(56 9.4667987823486 #(0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 0 1 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0)
- 9.3902807235718 #(0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1)
- 9.1394176483154 #(0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0)
+(vector 56 9.1394176483154 (fv 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0)
- 7.360991 #(0.000000 1.543888 1.523421 -0.220067 1.567797 0.074209 1.227839 1.349772 0.293300 1.631134 -0.247187 0.062113 -0.027509 1.595648 1.557164 0.546892 0.520153 1.128658 0.107042 0.044076 1.189630 0.101657 1.308393 1.048025 1.845149 1.741349 0.733348 0.626397 0.965235 1.421507 1.258418 1.584681 1.816659 1.271986 -0.020688 0.636866 1.568771 1.136963 0.544579 0.685969 0.939011 0.309732 0.684659 0.231719 0.726644 -0.247462 1.525360 0.598744 1.230916 0.017230 1.782234 1.871228 1.027530 0.551126 1.149823 -1.909146)
+ 7.349437 (fv 0.000000 1.546087 1.523699 -0.222814 1.563242 0.073887 1.226569 1.346857 0.292837 1.634387 -0.251778 0.060895 -0.022143 1.595396 1.558207 0.543894 0.524391 1.131307 0.107395 0.049540 1.190567 0.105407 1.309188 1.049686 1.847136 1.739252 0.730834 0.631473 0.965848 1.428286 1.258515 1.585209 1.811352 1.268900 -0.020138 0.642231 1.575017 1.141819 0.549674 0.685664 0.941820 0.311404 0.683359 0.230880 0.725054 -0.246162 1.525527 0.596605 1.235099 0.021275 1.782957 1.875900 1.027532 0.553643 1.151157 -1.905652)
)
;;; 57 all -------------------------------------------------------------------------------- ; 7.5498
-#(57 9.650218963623 #(0 0 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 1 1 0 1 1 0)
- 9.616 #(0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 1)
- 9.370246887207 #(0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0)
+(vector 57 9.370246887207 (fv 0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0)
- 7.509148 #(0.000000 0.538868 0.975928 0.790951 1.577613 0.441886 0.415416 0.317765 1.821808 1.016717 1.074498 0.989206 0.174839 0.636824 1.504783 1.453271 1.810320 -0.067742 1.597702 1.499867 -0.089433 0.256141 -0.122647 1.279036 0.624009 0.595303 1.574788 1.106981 1.063486 1.463723 1.755853 0.761981 0.950483 1.384952 0.761269 0.425884 1.584289 0.429913 1.484792 1.442356 1.021762 1.820351 1.351145 0.235878 1.135424 0.584026 1.105072 1.443087 0.278481 1.393995 0.171323 0.825253 0.110986 1.674745 1.175789 1.462814 1.330165)
- )
+ 7.442633 (fv 0.000000 0.628456 1.084630 0.786609 1.548782 0.496773 0.435493 0.422694 1.803774 0.918361 0.997194 1.049098 0.185525 0.660957 1.525706 1.561906 1.871425 -0.071743 1.628047 1.493214 -0.116955 0.206404 -0.134909 1.268493 0.758821 0.611040 1.564268 1.138473 1.072129 1.438518 1.711282 0.723211 0.929199 1.378242 0.744685 0.403345 1.655964 0.451399 1.464052 1.394001 0.957137 1.897197 1.337811 0.214489 1.090057 0.644474 1.099729 1.418576 0.330091 1.432560 0.258645 0.901692 0.058744 1.707516 1.251524 1.445949 1.245045)
+ 7.441636 #(0.000000 0.622348 1.085878 0.781116 1.543398 0.503464 0.436201 0.436360 1.804081 0.922203 0.997170 1.054550 0.182189 0.658266 1.514505 1.560476 1.876098 -0.073438 1.631568 1.494541 -0.115431 0.197586 -0.136568 1.260188 0.759194 0.602693 1.552249 1.137538 1.078917 1.441614 1.707363 0.723396 0.932457 1.367004 0.727498 0.408065 1.643814 0.447632 1.455697 1.392558 0.945330 1.895625 1.343191 0.216675 1.082075 0.643569 1.094957 1.407053 0.340178 1.425341 0.271660 0.889612 0.056066 1.700603 1.245948 1.440641 1.250791)
+
+ ;; 56+1
+ 7.588529 #(0.000000 1.559006 1.528143 -0.234828 1.510743 0.072763 1.134383 1.362254 0.303204 1.570684 -0.091506 0.027141 0.127155 1.600459 1.489127 0.559851 0.585109 1.217750 0.060591 0.195572 1.371350 0.291252 1.406886 1.100984 -0.016324 1.766768 0.695302 0.610137 0.999643 1.441896 1.186797 1.655783 1.557906 1.163328 -0.045033 0.552673 1.529458 1.154094 0.507727 0.569429 0.791719 0.355519 0.577628 0.178344 0.617622 -0.241675 1.589877 0.728380 1.261435 0.065292 1.580960 -0.002275 1.148223 0.618586 1.286855 -1.867003 0.103477)
+ )
;;; 58 all -------------------------------------------------------------------------------- ; 7.6157
-#(58 9.623 #(0 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1)
- 9.6140956878662 #(0 0 1 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 1)
- 9.4419231414795 #(0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1)
+(vector 58 9.4419231414795 (fv 0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1)
+
+ 7.593225 (fv 0.000000 0.986536 1.505069 0.859324 0.384061 0.501999 -0.052945 0.091682 1.243523 1.160936 0.166126 1.095539 1.756174 -0.122227 0.552109 1.557396 0.685859 1.585162 1.476945 1.055076 1.281043 0.783847 1.368420 0.615588 0.179246 0.641014 1.029588 -0.186574 0.302199 -0.049566 0.358796 -0.163645 1.827318 0.906618 1.173192 -0.306816 0.026558 0.176625 -0.050521 -0.001713 0.047940 0.417922 -0.025755 0.782149 0.436145 0.202813 1.499347 0.776547 1.362707 0.702487 -0.159222 1.853688 0.812543 0.355313 1.668872 1.299867 1.606542 0.186584)
+
+ ;; pp:
+ 7.586012 (fv 0.000000 0.718317 1.202315 0.028202 0.604627 1.135917 1.727021 0.381274 1.040230 1.739246 0.978472 1.777017 0.523285 1.243580 0.029135 1.381437 0.426286 1.404192 0.617991 1.834215 0.844002 0.191054 1.403866 0.517083 0.013036 1.338892 0.991152 0.141969 1.593581 0.974013 0.805540 -0.094361 1.826176 1.316543 1.040287 0.818373 0.169416 0.148481 -0.005247 1.691109 1.757644 1.290544 1.656395 1.204579 1.394324 1.303854 1.338185 1.515030 1.707660 1.781840 0.030717 0.283137 0.603418 0.969911 1.476088 1.200110 0.180175 0.633552)
+
+ ;; pp1:
+ 7.594343 (fv 0.000000 0.749835 1.196036 0.047415 0.621780 1.104858 1.683423 0.410089 0.997331 1.769746 1.019444 1.735512 0.510619 1.182024 0.010849 1.425649 0.362140 1.372448 0.624015 1.767029 0.754918 0.170009 1.406108 0.542718 -0.053715 1.339230 0.959996 0.102424 1.529396 0.978636 0.817177 -0.083573 1.854806 1.266587 1.089732 0.774700 0.147541 0.176983 -0.055229 1.674926 1.784675 1.300584 1.684703 1.169175 1.432021 1.273282 1.317555 1.468408 1.655397 1.821619 -0.009845 0.244752 0.605771 0.971746 1.410204 1.112895 0.141141 0.622757)
- 7.605335 #(0.000000 0.991505 1.507679 0.860951 0.382381 0.507390 -0.051536 0.090561 1.243888 1.162630 0.170393 1.094573 1.756892 -0.125619 0.548706 1.553459 0.687827 1.588232 1.473243 1.049285 1.277234 0.778888 1.365697 0.610798 0.182839 0.638066 1.028058 -0.186523 0.294872 -0.052669 0.356411 -0.171837 1.823550 0.906165 1.167861 -0.302228 0.026951 0.167281 -0.047683 1.995297 0.050153 0.416681 -0.026880 0.786257 0.431073 0.201288 1.493808 0.773882 1.361706 0.698183 -0.162081 1.856543 0.815812 0.352998 1.666541 1.295003 1.606397 0.195070)
+ 7.604882 (fv 0.000000 1.003143 -0.865267 0.010219 -0.099642 -0.478021 -0.093216 0.744325 -0.039294 -0.002416 0.551785 0.316654 -0.123222 0.301399 -0.383480 -0.165893 -0.726009 0.524402 0.651077 -0.962303 0.315215 -0.603015 0.258064 -0.340148 -0.256538 -0.041913 -0.379049 -0.712938 -0.349442 0.451149 -0.446083 0.896871 -0.490206 -0.472734 0.420264 0.151583 0.131069 0.834014 0.859212 0.483964 -0.544840 -0.090156 0.432176 -0.243993 -0.843563 -0.050600 -0.631713 0.342919 0.025289 0.027400 1.444366 -0.042492 -1.145968 0.638141 -0.833781 -0.384767 -0.149344 0.896836)
+
+ ;; 57+1
+ 7.533390 #(0.000000 0.631892 1.030548 0.996535 1.749363 0.527130 0.477024 0.368639 1.802926 1.003296 1.026792 0.861445 0.354012 0.677047 1.520092 1.568568 1.887052 -0.077599 1.681866 1.559188 -0.163779 -0.032281 -0.010624 1.336711 0.753633 0.560677 1.590572 1.250944 1.018806 1.569329 1.806513 0.820053 1.037991 1.389344 0.762236 0.480656 1.661302 0.465658 1.499904 1.500135 0.971523 1.890287 1.276369 0.072382 1.249962 0.582710 1.223535 1.436175 0.383524 1.412000 0.135455 0.769171 0.142483 1.827353 1.151930 1.547046 1.202745 -0.195258)
+
+ 7.481139 #(0.000000 0.494120 0.912027 1.088506 1.796520 0.662315 0.621396 0.504785 1.809811 0.899674 1.186628 0.627937 0.587445 0.746949 1.418182 1.435063 1.844205 -0.044267 1.752818 1.424221 -0.141018 -0.093784 -0.133478 1.461699 0.840220 0.767006 1.740731 1.152491 1.108382 1.653182 1.853596 0.981136 1.198681 1.579726 0.839579 0.463906 1.810603 0.643978 1.514569 1.529989 1.033048 0.123830 1.430921 0.210010 1.371841 0.593103 1.143424 1.331116 0.451352 1.357884 0.020742 0.723087 0.311054 -0.015301 1.089900 1.570530 1.273463 -0.350924)
+ 7.472170 #(0.000000 0.430844 0.953515 1.095387 1.834428 0.602659 0.597853 0.392425 1.797011 0.826392 1.113427 0.446408 0.529227 0.680942 1.329125 1.343688 1.818639 -0.122172 1.616802 1.292467 -0.195382 -0.212590 -0.247151 1.374774 0.796549 0.699593 1.645545 0.964816 1.084815 1.558580 1.737062 0.927802 1.039786 1.477445 0.712702 0.296961 1.758646 0.488444 1.376075 1.455278 0.882990 -0.037083 1.238179 0.077306 1.133427 0.444398 0.934392 1.211465 0.276242 1.242882 -0.192105 0.541924 0.088132 -0.286088 0.846397 1.327678 1.119123 -0.618251)
)
;;; 59 all -------------------------------------------------------------------------------- ; 7.6811
-#(59 9.9013983722749 #(0 0 0 1 1 0 0 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 1 0 1)
- 9.4819116592407 #(0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0)
+(vector 59 9.4819116592407 (fv 0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0)
+
+ 7.633759 (fv 0.000000 -0.102106 0.411390 1.377383 1.497595 0.124070 0.977823 0.515946 1.620540 0.196166 1.145526 -0.281630 -0.195296 1.404391 0.189637 1.328165 -0.070129 0.678415 0.164240 0.284857 -0.029704 0.602274 0.993542 1.271589 0.492176 0.728322 0.791637 0.338071 1.390375 1.125972 0.444347 0.171840 0.693527 1.264131 0.439002 1.477092 0.989010 0.611429 0.828210 0.480652 -1.722373 1.692898 0.138317 0.412855 0.367615 1.849818 1.092865 1.381771 0.372051 1.523953 1.713816 0.119731 0.675902 0.655871 0.560189 0.993051 1.958772 1.303462 0.504587)
- 7.655955 #(0.000000 -0.110476 0.408125 1.385142 1.498699 0.119353 1.000262 0.520317 1.595842 0.200612 1.135619 -0.296126 -0.209984 1.401017 0.213174 1.291051 -0.063195 0.652053 0.187724 0.284722 -0.034841 0.589475 0.973964 1.266148 0.481044 0.704189 0.781233 0.329444 1.413714 1.100024 0.453597 0.164748 0.677634 1.251227 0.461739 1.471383 0.980045 0.594023 0.825150 0.489408 -1.733231 1.697109 0.148984 0.416824 0.349296 1.856774 1.096640 1.416359 0.336179 1.528165 1.699671 0.087523 0.663744 0.681053 0.568024 1.017299 1.940095 1.298083 0.506037)
+ ;; 60-1
+ 7.668205 (fv 0.000000 0.260999 0.306319 0.829788 0.601433 -0.678190 0.032714 -0.031883 1.182121 0.436499 0.860411 1.529871 0.029506 -0.270659 1.490132 0.906453 0.632531 -0.000842 1.433413 0.099705 1.394290 1.492347 1.704612 0.859780 -0.064335 0.888916 0.823173 -0.092258 1.655169 1.087888 0.521033 0.694079 0.255286 0.100258 0.664742 0.255239 -0.004409 -0.020809 -0.246563 0.401722 0.426493 1.163559 0.741366 0.718411 0.770050 0.987515 -0.377733 -0.050194 0.650015 -0.412935 -0.094285 0.634376 0.230847 1.070214 0.078695 0.757129 0.097582 0.734853 -0.028246)
+
+ ; 58+1
+ 7.567729 #(0.000000 0.753874 1.108606 0.974281 0.283985 0.662033 0.650997 0.171167 1.713034 0.855505 1.018749 0.891985 0.435917 0.540560 1.459830 1.555159 -0.222214 -0.376165 1.777521 1.607719 -0.138482 -0.185224 0.145078 1.584935 1.029502 0.327951 1.867036 1.174458 1.172033 1.652747 -0.202580 1.284972 0.919829 1.617599 1.002052 0.275343 0.183263 0.550709 1.391786 1.438151 1.764529 0.225407 1.674751 0.321832 1.364256 0.748496 1.336450 1.931791 0.857675 1.688807 0.307620 0.802036 0.148078 0.020000 1.074227 1.654778 1.010253 0.016684 -0.457710)
+ 7.555219 #(0.000000 0.684018 1.137315 0.968223 0.237663 0.655411 0.703581 0.179129 1.756606 0.877973 1.046593 1.013282 0.452948 0.616147 1.401809 1.505193 -0.202722 -0.390244 1.724472 1.616182 -0.097477 -0.170782 0.119472 1.497307 1.040170 0.317714 1.813227 1.115091 1.108189 1.689417 -0.262762 1.307718 0.931892 1.606817 0.960377 0.411286 0.247771 0.642681 1.412085 1.412909 1.797063 0.172164 1.740367 0.372886 1.379890 0.765467 1.444968 -0.036026 0.938248 1.692947 0.425883 0.844447 0.152098 -0.006221 1.039656 1.801143 1.018286 -0.026353 -0.556475)
)
;;; 60 all -------------------------------------------------------------------------------- ; 7.7459
-#(60 9.783 #(0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
- 9.575254043103 #(0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
+(vector 60 9.575254043103 (fv 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
- 7.610300 #(0.000000 0.318845 0.262184 0.916106 0.689832 -0.660662 0.045547 1.968430 1.153969 0.422285 0.867341 1.410791 0.142376 -0.313580 1.398752 1.052236 0.770515 0.063241 1.506311 0.100032 1.335469 1.486638 1.612205 0.831321 -0.220005 0.988625 0.777120 0.090293 1.687822 1.226271 0.670144 0.885007 0.146054 0.266661 0.627733 0.168119 0.159910 0.189884 -0.180218 0.553703 0.407259 1.285546 0.869695 0.792008 0.943205 1.157463 -0.196388 0.036713 0.558682 -0.233985 0.127104 0.725047 0.294752 1.018346 1.777029 0.680885 0.110125 0.820682 0.094275 0.378958)
+ 7.588747 (fv 0.000000 0.303100 0.261228 0.917131 0.691793 -0.677124 0.027342 -0.014801 1.166154 0.416979 0.851167 1.410955 0.139409 -0.306122 1.416862 1.054300 0.792442 0.062922 1.507148 0.118287 1.375215 1.459904 1.620963 0.828106 -0.237368 0.987982 0.753194 0.096604 1.712227 1.239483 0.673351 0.871862 0.125962 0.260000 0.626286 0.147473 0.131774 0.201212 -0.194457 0.538798 0.418147 1.292448 0.871870 0.794549 0.988888 1.131816 -0.166311 0.052304 0.543793 -0.229410 0.113585 0.733683 0.271039 1.008427 1.788452 0.654055 0.106430 0.828086 0.097436 0.376461)
)
;;; 61 all -------------------------------------------------------------------------------- ; 7.8102
-#(61 10.140303840769 #(0 1 0 0 0 0 0 0 0 0 1 0 1 1 1 0 1 0 0 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 1 1 0 1 1 0 0 0 0 1 0 0 0 1)
- 9.9175914844707 #(0 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1)
+(vector 61 9.9175914844707 (fv 0 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1)
+
+ 7.764539 (fv 0.000000 0.501749 1.326260 -0.002830 0.440140 1.954758 -0.008202 0.999918 0.013473 0.542424 0.025115 0.566063 0.591900 -0.196853 0.709527 1.494974 0.701049 1.000710 1.261876 0.543883 0.605458 1.371875 -0.020772 0.931648 0.804346 0.926420 0.633175 0.027958 1.257581 0.427959 1.076239 -0.091270 1.537981 0.146252 0.640848 0.257921 1.798714 0.191485 0.663913 1.946117 1.528077 1.065296 -0.320137 1.459211 1.030583 1.751744 1.068882 0.287431 0.162869 0.095930 0.749409 1.433537 1.416981 -0.082974 0.219907 0.200900 1.575224 1.106230 0.733650 1.327996 1.447241)
- 7.775121 #(0.000000 0.502087 1.324881 -0.001281 0.440956 1.953367 -0.007175 0.999252 0.012653 0.541047 0.023639 0.564178 0.592788 -0.196184 0.708700 1.495094 0.698888 1.002069 1.260987 0.543150 0.606360 1.371816 -0.020016 0.932101 0.806271 0.927756 0.631807 0.029651 1.256968 0.429051 1.078992 -0.090266 1.537076 0.146321 0.640445 0.257723 1.798916 0.193164 0.662564 1.947183 1.525428 1.067021 -0.320133 1.459267 1.027549 1.750564 1.068876 0.285654 0.164521 0.097292 0.747875 1.433198 1.416162 -0.083307 0.220358 0.202645 1.575416 1.105457 0.732163 1.326110 1.449526)
+ ;; pp:
+ 7.753858 (fv 0.000000 0.319725 1.167003 1.840366 0.153760 1.056380 1.530371 0.068799 1.142107 1.630458 0.891055 1.372619 0.446834 1.091219 0.302492 1.393205 0.356103 1.143793 0.345744 1.558858 0.517245 1.731373 1.219460 0.122291 1.292388 0.849768 0.068299 1.373758 1.017991 0.385053 1.507703 1.138013 0.742591 0.285609 -0.125056 1.492440 1.058816 0.934160 0.593744 0.533680 -0.158800 0.426341 1.446080 1.766771 1.695866 1.560056 1.478090 1.737231 1.729597 0.116298 0.076540 -0.001350 0.001958 0.473570 1.021992 1.263777 1.530152 1.876463 0.039103 0.812610 1.066132)
+
+ ;; 60+1
+ 7.729878 #(0.000000 0.501241 0.237606 0.978914 0.682320 -0.738346 0.003863 0.191015 1.258332 0.203094 0.830345 1.438000 0.152627 -0.532209 1.427014 1.183594 0.624701 0.243054 1.493579 0.176931 1.408163 1.569029 1.678314 1.134453 -0.499872 1.081037 0.741424 0.444731 -0.070094 1.364678 0.717892 0.199159 0.000037 0.421827 0.501644 0.000638 0.131801 0.556608 -0.305504 0.649919 0.349420 1.653016 0.747436 0.624576 1.071688 1.251490 -0.264205 0.104670 0.467823 -0.348124 0.060239 0.441345 0.332223 0.905903 -0.014010 1.116703 0.324059 1.085578 0.038446 0.393074 -0.044048)
+ 7.729641 #(0.000000 0.463648 0.245219 0.945196 0.651048 -0.734088 -0.016499 0.184730 1.247724 0.212438 0.819397 1.428152 0.148261 -0.535985 1.427158 1.161684 0.581178 0.249034 1.491750 0.150878 1.346200 1.564279 1.670074 1.129799 -0.517659 1.083110 0.682400 0.429246 1.869837 1.323050 0.738685 0.117986 -0.006088 0.376783 0.463179 -0.062397 0.035476 0.478607 -0.302119 0.573529 0.313684 1.619169 0.720247 0.569804 1.007611 1.154366 -0.364804 0.027671 0.390125 -0.440484 -0.028117 0.397064 0.225794 0.831365 -0.099773 1.002690 0.244315 1.000681 -0.071291 0.315345 -0.100933)
+ 7.724678 #(0.000000 0.468911 0.239568 0.955993 0.660017 -0.740608 -0.005773 0.183020 1.262803 0.205104 0.825719 1.427337 0.148985 -0.545646 1.421878 1.165785 0.583348 0.241399 1.492038 0.153867 1.352915 1.564264 1.676784 1.122923 -0.525089 1.072617 0.697447 0.431113 1.876815 1.332016 0.730929 0.138318 -0.020534 0.383941 0.464477 -0.046001 0.053991 0.488682 -0.308619 0.592538 0.314268 1.634774 0.717562 0.581911 1.005194 1.161246 -0.358260 0.043757 0.409907 -0.425384 -0.020488 0.390805 0.247045 0.840009 -0.081618 1.014893 0.255614 1.022742 -0.054507 0.325271 -0.099612)
)
;;; 62 all -------------------------------------------------------------------------------- ; 7.8740
-#(62 10.281167984009 #(0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0)
- 9.9292116165161 #(0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0)
+(vector 62 9.9292116165161 (fv 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0)
- 7.811575 #(0.000000 0.805793 1.783670 0.191444 1.679211 1.437432 1.810761 1.058412 0.097707 0.692512 0.056651 1.440271 1.429495 0.064932 1.725113 0.154383 0.953660 0.005956 0.909972 1.220066 0.678100 0.675360 0.110072 1.589651 0.227528 1.130522 0.419071 0.238918 0.740204 0.623754 0.345007 1.542352 1.522894 1.658127 0.230001 1.494045 1.127032 0.766049 1.158906 1.490958 -0.003659 1.020262 1.286326 1.157837 0.395965 1.615501 1.466461 1.774694 1.874775 0.687372 1.683378 1.503489 0.698137 0.696413 0.938385 1.168075 0.120571 1.203970 0.794176 0.694455 1.267909 1.489886)
+ 7.792971 (fv 0.000000 0.798156 1.779815 0.185967 1.670273 1.438952 1.815697 1.053871 0.087440 0.689337 0.052342 1.443903 1.423782 0.060887 1.727890 0.158639 0.952692 0.005318 0.914138 1.225205 0.683016 0.673829 0.109419 1.593849 0.225994 1.125995 0.418481 0.240605 0.743642 0.622844 0.353010 1.543180 1.534972 1.657806 0.217386 1.492286 1.132686 0.760213 1.147881 1.490201 0.001889 1.030507 1.289026 1.160822 0.387338 1.616191 1.464636 1.793960 1.874455 0.680274 1.683218 1.490668 0.689023 0.705366 0.946252 1.171040 0.109657 1.208442 0.793211 0.697986 1.263366 1.490757)
)
;;; 63 all -------------------------------------------------------------------------------- ; 7.9372
-#(63 10.265982627869 #(0 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 0)
- 9.9866892843745 #(0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 0)
- 9.9555234909058 #(0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 1 0)
+(vector 63 9.9555234909058 (fv 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 1 0)
+
+ 7.900930 (fv 0.000000 0.112702 0.086876 0.634314 1.554089 0.214604 -0.203567 1.256800 0.100458 0.246503 1.488987 0.107459 1.914177 1.161772 1.897454 0.320257 1.283205 0.869894 1.466310 1.256681 0.167147 1.720679 0.949230 1.041227 1.129363 1.077459 1.317157 1.129579 0.390441 1.000383 0.208075 1.779398 1.501532 1.375523 -0.023235 1.338796 1.635364 1.234484 1.323162 0.435451 0.903475 1.821268 1.474898 0.271740 1.558504 0.547732 0.837920 0.522756 0.001164 1.566827 1.197274 1.065607 0.155490 1.019206 1.516032 -0.064964 -0.144993 0.026714 1.048953 1.812875 0.299023 0.685547 0.728053)
- 7.915619 #(0.000000 0.120068 0.106273 0.622270 1.543545 0.214722 -0.210150 1.275733 0.118786 0.224623 1.508429 0.118145 1.909835 1.161946 1.902887 0.315877 1.298140 0.862137 1.497840 1.232686 0.162830 1.733269 0.955089 1.019846 1.155195 1.054741 1.328267 1.142053 0.383291 1.017417 0.199828 1.814399 1.496202 1.368522 -0.021016 1.329536 1.649892 1.265200 1.343468 0.419751 0.901236 1.809980 1.455710 0.289767 1.566099 0.473808 0.850214 0.488303 -0.004622 1.573995 1.202728 1.045962 0.196951 0.998303 1.508863 -0.099573 -0.152247 0.000445 1.073897 1.806159 0.285584 0.669349 0.695591)
+ 7.876881 (fv 0.000000 0.730162 1.053547 1.853555 0.252740 0.906538 1.566071 0.152709 1.015626 1.877411 0.660255 1.513063 -0.004442 1.023537 0.043516 0.973208 -0.080949 0.883081 -0.126245 1.080582 0.224101 1.423101 0.674610 1.604094 0.756913 0.381286 1.606872 1.293154 0.397443 1.644011 1.075770 0.644269 0.164589 -0.255888 1.331182 0.886941 0.357762 0.438290 1.706681 1.847928 1.153249 1.311949 1.226087 1.303371 0.783267 0.589091 0.697039 0.351577 0.554862 0.724022 0.729451 0.902218 0.841292 1.194121 1.061823 1.429706 0.001167 -0.011629 0.776088 1.037188 1.244629 1.522995 0.260285)
+
+ ;; 62+1
+ 7.805914 #(0.000000 0.601934 1.819111 0.471849 1.796784 1.557939 -0.026564 1.127818 0.479364 1.051771 0.128278 1.076188 1.581105 0.002062 1.593371 -0.164858 0.669949 -0.006771 0.676728 1.318085 0.880976 0.767111 0.655478 1.155761 0.306644 0.952223 0.140967 -0.196485 0.579088 0.861236 0.136455 1.859532 1.366764 1.343580 -0.020718 1.262958 0.917610 0.622309 1.387853 1.550991 -0.057003 1.281603 1.600851 1.216655 0.278309 1.739420 1.301224 -0.116573 -0.098586 0.465030 1.677940 1.531395 1.096719 0.709448 0.878166 1.233881 -0.104305 1.481973 0.932474 0.299442 0.967864 1.232287 -0.358064)
+ 7.800306 #(0.000000 0.593041 1.814687 0.483090 1.809567 1.570434 -0.010963 1.133312 0.508100 1.082828 0.132800 1.081295 1.609650 0.004376 1.602307 -0.148895 0.679922 0.003650 0.695902 1.342115 0.911951 0.821441 0.666366 1.192523 0.330741 0.982706 0.167927 -0.164040 0.595303 0.873621 0.175773 1.884907 1.412718 1.374024 -0.003632 1.286158 0.950933 0.635806 1.438790 1.594221 -0.018194 1.324380 1.640059 1.280459 0.314889 1.818114 1.342146 -0.063931 -0.074642 0.525213 1.767962 1.608859 1.143810 0.780779 0.927340 1.305959 -0.057784 1.556344 1.011039 0.353582 0.998321 1.295658 -0.292113)
)
;;; 64 all -------------------------------------------------------------------------------- ; 8
-#(64 10.1628899603246 #(0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1 0 1)
- 9.957244923706 #(0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1)
+(vector 64 9.957244923706 (fv 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1)
+
+ 7.941887 (fv 0.000000 0.078350 0.185008 1.926703 0.321363 1.181646 1.402668 0.610982 0.623089 1.216601 1.332592 -0.291595 1.818855 1.612142 0.352450 -0.172928 1.880133 1.280898 1.910145 0.775896 0.915424 1.581714 0.463086 0.548034 1.045305 1.495776 -1.677351 1.247040 0.522690 1.227534 1.269499 0.212698 -0.052232 1.635256 1.888480 1.734142 1.150438 1.012285 0.389543 -0.097094 -0.358616 1.129328 0.215283 0.611096 0.487394 1.263156 0.637871 1.355777 0.092029 0.148467 1.060411 0.413204 1.241091 0.569303 1.457881 0.998119 0.874341 0.432403 1.077636 0.523921 0.747328 1.722616 0.867015 0.916274)
+
+ ;; pp.scm:
+ 7.992914 (fv 0.000000 0.651329 1.088511 1.713470 0.442276 0.963521 1.501931 0.310181 1.212960 -0.011104 0.778232 1.515305 0.316833 1.237177 0.296916 1.189311 0.026642 1.098222 -0.017818 1.134719 0.273596 1.474260 0.550810 1.706455 0.919546 0.198719 1.526951 0.883788 0.268629 1.826193 1.021575 0.329612 -0.041590 1.516394 1.042877 0.648305 0.185654 -0.069051 1.607952 1.190320 1.094592 0.588439 0.829542 0.393611 0.610572 0.171199 0.117077 0.152394 -0.147682 0.017404 0.185404 0.037181 0.373288 0.371013 0.642715 0.482850 0.968331 1.382474 1.590294 -0.024057 0.298876 0.749699 1.152958 1.682631)
- 7.978894 #(0.000000 0.062748 0.214490 1.946211 0.375980 1.202415 1.444886 0.581472 0.619585 1.220590 1.323597 -0.257210 1.855219 1.626239 0.296983 -0.187321 1.804872 1.314663 1.871420 0.737758 0.876449 1.566261 0.435077 0.562641 1.090388 1.479600 -1.704712 1.261343 0.494589 1.198365 1.267933 0.230404 -0.062372 1.608998 1.872209 1.699515 1.176321 1.034450 0.341108 -0.096308 -0.257449 1.100225 0.268119 0.634041 0.456550 1.342112 0.646832 1.414318 0.066308 0.190333 1.066163 0.414814 1.219900 0.536761 1.496099 1.038238 0.817881 0.385125 1.053943 0.490078 0.755677 1.744843 0.865424 0.945011)
+ ;; 63+1
+ 7.860026 #(0.000000 0.809578 1.898769 0.467844 0.006957 1.570179 0.166964 1.399056 0.441035 1.263158 0.221043 1.092426 1.474756 0.007976 1.573880 0.092893 0.611450 0.051852 0.479088 1.319456 0.803792 1.198336 0.735571 1.265423 0.465756 0.760698 0.362640 -0.062961 0.627636 0.844966 -0.014667 1.769347 1.323936 1.245960 0.116850 1.375744 0.996394 0.370750 1.317375 1.741914 -0.329960 1.202157 1.458151 1.120658 0.217396 1.857269 1.281001 -0.057938 -0.080468 0.444525 1.682891 1.595713 1.143362 0.554820 0.939242 1.248217 -0.289778 1.508665 1.074317 0.351970 0.956968 1.151169 -0.275737 -0.049296)
+ 7.856464 #(0.000000 0.822234 1.908730 0.467749 0.006656 1.612213 0.171726 1.378057 0.490600 1.283019 0.198540 1.138986 1.474359 0.023573 1.618066 0.107006 0.645127 0.046120 0.470802 1.320344 0.831192 1.192841 0.749343 1.290871 0.485677 0.828180 0.364554 -0.060479 0.620764 0.905935 -0.004028 1.773415 1.346206 1.276795 0.145101 1.369520 1.077798 0.374122 1.316067 1.750075 -0.308445 1.240419 1.495628 1.155630 0.297494 1.866545 1.311588 -0.004376 -0.041514 0.509113 1.692680 1.642970 1.149448 0.643495 0.990275 1.299612 -0.217370 1.583383 1.064236 0.447176 1.021444 1.233603 -0.209539 0.030332)
)
;;; 65 all -------------------------------------------------------------------------------- ; 8.0622
-#(65 10.598279953003 #(0 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0)
- 10.18968963623 #(0 0 1 1 1 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0)
- 10.157649040222 #(0 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0)
+(vector 65 10.157649040222 (fv 0 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0)
+
+ 8.034868 (fv 0.000000 -0.445401 1.151245 1.279345 1.476130 1.870307 1.647070 -0.199190 0.996479 1.841605 1.029874 1.628641 0.687865 0.948026 1.437242 1.472256 1.713531 0.116128 0.684445 1.801135 -0.030628 1.120947 0.852540 1.164480 1.740537 0.856297 1.486946 0.172686 0.895511 0.630282 1.378315 0.169569 1.750827 0.453225 1.137053 0.474570 0.449455 1.468205 1.690172 0.505222 -0.186497 0.479672 0.299749 1.440549 1.876899 0.243582 0.699167 0.152947 0.932331 0.165767 1.486581 1.086937 1.179952 1.305509 1.186761 0.971873 0.910187 0.131821 0.021623 1.435803 1.077493 0.071755 1.363290 0.536054 0.282812)
+
+ ;; pp:
+ 7.973113 (fv 0.000000 0.586863 1.108547 1.809568 0.236474 0.932200 1.490976 0.236358 1.190604 -0.011282 0.981987 1.626061 0.541325 1.333541 0.166220 1.028548 0.073540 1.235912 0.201403 1.061871 0.289618 1.557561 0.463038 1.533243 0.718960 -0.031407 1.248624 0.634414 -0.029632 1.295765 0.653432 0.144947 1.300831 1.398877 0.579343 0.760977 0.024336 1.714192 1.357070 0.952728 0.458396 0.300957 -0.033236 0.181552 1.850554 1.728158 1.394294 1.294304 1.438841 1.230165 1.383584 1.610036 1.601644 1.798980 0.041945 -0.165907 -0.108364 0.492371 0.832142 1.280146 1.457449 -0.051803 0.040231 0.532391 1.056982)
- 8.049909 #(0.000000 -0.446175 1.152111 1.274218 1.471107 1.869109 1.646119 -0.200538 0.992854 1.838171 1.032151 1.623448 0.683127 0.950605 1.436574 1.469159 1.715523 0.111309 0.688598 1.800715 -0.037419 1.123821 0.857055 1.161424 1.739632 0.851884 1.487769 0.172253 0.894080 0.621558 1.384372 0.163069 1.750057 0.455138 1.140123 0.472456 0.451332 1.463908 1.691310 0.505465 -0.173319 0.473843 0.299526 1.439658 1.883361 0.241434 0.707867 0.159008 0.932049 0.164972 1.478674 1.087344 1.182300 1.308258 1.186099 0.969542 0.910302 0.129703 0.022258 1.437260 1.072541 0.076135 1.367769 0.540366 0.280335)
+ ;; 65+1
+ 7.989976 #(0.000000 0.717074 1.790137 0.303763 0.122314 1.682143 0.216359 1.275289 0.381110 1.232945 0.219920 1.195050 1.544622 0.012541 1.697713 0.164535 0.808696 -0.033093 0.436931 1.424336 0.953440 1.075346 0.847229 1.377732 0.455680 0.844396 0.388170 -0.232520 0.566111 1.006265 0.239235 -0.064356 1.478182 1.310771 0.100992 1.360730 1.120501 0.518973 1.403629 1.737998 -0.215831 1.519996 1.486448 1.299685 0.264762 0.058410 1.261254 0.113761 -0.018088 0.416310 -0.086576 1.654308 1.428048 0.818894 0.929752 1.422804 -0.004686 1.681128 1.117926 0.396261 1.114085 1.263468 -0.302127 -0.143751 0.249776)
+ 7.986549 #(0.000000 0.705159 -0.181004 0.217327 0.156922 1.778990 0.191147 1.113801 0.272034 1.171044 0.257920 1.334728 -0.188087 -0.096820 -0.018998 0.262759 0.954023 -0.039897 0.341389 1.444996 0.917955 1.089303 1.099624 1.600822 0.474003 1.078678 0.419361 -0.346529 0.769135 1.102121 0.462514 0.194004 1.393289 1.207814 0.168583 1.451937 1.578978 0.606330 1.663672 1.685805 -0.285434 1.500953 1.544223 1.459210 0.522782 0.144120 1.248342 0.284057 0.175310 0.542283 0.012495 1.586311 1.315843 1.018961 1.170529 -0.156886 0.147650 -0.231754 1.368201 0.537962 1.411226 1.416444 -0.114344 -0.050059 0.647067)
)
;;; 66 all -------------------------------------------------------------------------------- ; 8.1240
-#(66 10.450973400896 #(0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0)
- 10.26798183746 #(0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1)
- 10.208241079264 #(0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0)
+(vector 66 10.208241079264 (fv 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0)
- 8.079487 #(0.000000 1.153150 1.931857 0.462113 1.731561 1.710863 1.715933 0.944570 0.645433 -0.291944 0.723102 0.880701 0.715971 1.251924 0.307932 0.383135 1.055626 0.365955 1.884522 0.160912 0.982932 1.585574 -0.307591 0.612629 -0.008245 1.394990 1.418136 1.267296 0.138708 0.442912 0.122114 1.715153 1.080908 1.079237 0.782798 0.937662 1.271524 0.301823 0.287575 1.505934 0.286473 1.240859 1.593742 1.516289 0.304746 0.460811 1.001843 0.270503 1.088059 0.150785 1.648192 0.713269 0.607159 1.971719 0.941804 0.110359 0.945985 0.031841 0.542419 0.739613 0.139168 0.108044 0.571013 0.288234 0.658661 0.740751)
+ 8.056638 (fv 0.000000 1.161331 1.936583 0.473825 1.730430 1.710083 1.722704 0.938539 0.650961 -0.301116 0.711382 0.874289 0.712393 1.263523 0.315048 0.391659 1.059022 0.363325 1.881127 0.161704 0.986800 1.590034 -0.289492 0.615410 -0.014906 1.387045 1.412270 1.265945 0.128543 0.445787 0.121476 1.705959 1.084173 1.066949 0.774156 0.933891 1.279265 0.297308 0.298325 1.512363 0.271282 1.243162 1.580605 1.521644 0.312598 0.465014 1.006013 0.269153 1.083812 0.157700 1.646414 0.707835 0.598039 1.973506 0.954025 0.104991 0.944717 0.038847 0.538283 0.734911 0.143649 0.104089 0.567333 0.271330 0.665962 0.751070)
+
+ ;; 67-1
+ 8.057849 #(0.000000 0.557868 1.277675 0.035082 0.606360 1.351203 1.836909 0.715558 1.256481 1.526554 0.538579 1.530425 0.580514 1.498578 0.116903 0.933739 0.019326 0.887252 -0.086797 0.604738 1.551540 0.736914 0.131651 1.149747 0.282533 1.227997 0.618183 0.164429 1.585108 1.228651 0.546852 -0.196864 1.480532 0.533190 -0.284020 1.599530 1.236535 0.954887 0.575524 0.413221 -0.000524 0.162211 1.214867 0.627804 0.589019 0.838842 0.451898 0.970982 0.399993 0.164558 0.108022 0.046075 0.027216 0.532334 0.358013 0.837176 0.729555 1.147175 0.936661 1.785417 0.184687 0.636068 0.955301 1.150651 1.841869 1.851218)
+ 8.044495 #(0.000000 0.581065 1.291916 0.059254 0.617899 1.347083 1.813127 0.736507 1.273944 1.499042 0.544683 1.521865 0.547535 1.489105 0.122725 0.930947 -0.019577 0.828332 -0.123574 0.579943 1.554404 0.681236 0.080353 1.124307 0.249845 1.207295 0.630833 0.181490 1.580635 1.191264 0.544001 -0.219496 1.461932 0.541340 -0.290780 1.610474 1.275097 0.940533 0.570196 0.341107 -0.017602 0.133281 1.166976 0.573116 0.556656 0.758376 0.419521 0.906007 0.305727 0.149020 0.017843 0.033007 -0.043063 0.469814 0.304703 0.839693 0.673714 1.093033 0.885579 1.735487 0.146827 0.560866 0.914370 1.104996 1.771632 1.846520)
)
;;; 67 all -------------------------------------------------------------------------------- ; 8.1853
-#(67 10.780866622925 #(0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 1)
- 10.514228551195 #(0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1)
- 10.445269388021 #(0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1)
- 10.422191619873 #(0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 1)
+(vector 67 10.422191619873 (fv 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 1)
+
+ 8.144904 (fv 0.000000 0.836848 1.681555 1.191647 0.070261 0.942251 1.797644 1.070294 0.265921 1.462866 0.142770 0.004389 0.118755 0.795004 0.861059 0.364013 1.094070 0.938540 1.352932 1.681133 0.801557 -0.166830 1.660232 1.811404 -0.089491 1.793031 0.410641 1.462829 0.992048 -0.005221 0.624981 -0.049054 -0.100216 0.046599 -0.054149 1.061978 0.471687 -0.484886 1.299787 0.103592 0.873660 1.581185 1.539111 1.747106 0.867454 1.194479 0.984380 1.039016 -0.137566 1.440640 0.758746 0.623227 0.623868 1.161467 1.535042 0.328555 1.691644 -0.115223 0.929805 1.714954 0.103897 1.241682 1.520953 1.062392 0.666399 0.064868 1.788882)
- 8.163823 #(0.000000 0.838152 1.680715 1.201253 0.077456 0.940403 1.804957 1.066081 0.262005 1.472251 0.149264 0.010457 0.116033 0.788961 0.862552 0.362266 1.091398 0.938711 1.359304 1.676367 0.794760 -0.167880 1.666765 1.819549 -0.096650 1.796146 0.406663 1.458902 0.992423 -0.014056 0.622577 -0.052248 -0.109334 0.042971 -0.055573 1.059987 0.478234 -0.475750 1.299870 0.101852 0.870075 1.583450 1.543826 1.751730 0.864722 1.185927 0.990829 1.037189 -0.127942 1.435143 0.760170 0.624670 0.619941 1.151817 1.530702 0.322603 1.701088 -0.122823 0.938253 1.706161 0.103701 1.245288 1.529452 1.065514 0.671463 0.053550 1.796294)
+ ;; pp:
+ 8.072785 (fv 0.000000 0.714480 1.141487 -0.059495 0.626617 1.143106 1.724186 0.562381 1.166774 1.775820 0.595712 1.588031 0.453186 1.514340 0.088154 0.928491 -0.033585 0.878492 -0.006785 0.660928 1.635393 0.709844 0.143551 1.201690 0.276956 1.367207 0.639357 0.086720 1.577267 1.234748 0.475681 -0.133351 1.448411 0.486601 -0.203691 1.708040 1.315311 0.962381 0.408017 0.396955 1.868803 -0.051618 1.159243 0.738595 0.693611 0.852762 0.510509 0.806906 0.489441 0.162663 0.197789 0.090682 0.076822 0.594675 0.394390 0.961428 0.800767 1.169831 1.000600 1.531863 1.954261 0.431033 0.762550 1.024871 1.795795 1.769037 0.290496)
)
;;; 68 all -------------------------------------------------------------------------------- ; 8.2462
-#(68 10.585594177246 #(0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1)
- 10.460547747753 #(0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1)
+(vector 68 10.460547747753 (fv 0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1)
- 8.188358 #(0.000000 0.352116 1.875038 1.062486 0.767490 0.946162 0.715380 0.727249 0.375420 0.200968 0.471871 0.085113 1.511610 0.927856 0.817729 0.937156 0.791101 1.070289 1.208551 1.051280 0.729905 1.727851 0.059580 1.737295 1.414664 0.225121 0.095605 -0.007899 0.541431 0.692101 1.311437 0.131417 1.527386 1.541351 0.061759 0.206864 1.781335 0.996002 1.296234 1.409564 0.107064 1.263431 0.723272 0.020198 1.432982 1.101258 0.750147 1.481018 0.392474 1.289560 0.560677 1.447245 1.216129 0.175107 0.466904 1.151553 -0.018416 1.461665 0.198418 1.132801 -0.138658 0.684998 1.459377 -0.237010 0.547417 0.684083 0.984611 1.512488)
+ 8.168157 (fv 0.000000 0.354978 1.878673 1.059221 0.759731 0.956747 0.711479 0.720163 0.372733 0.204844 0.455442 0.097446 1.506513 0.919884 0.814781 0.935488 0.786490 1.074073 1.203975 1.052443 0.726494 1.730845 0.062987 1.716136 1.412039 0.233751 0.090641 -0.003605 0.550389 0.691280 1.313887 0.137194 1.521036 1.556316 0.070039 0.198694 1.780701 0.986693 1.284403 1.408455 0.102332 1.273719 0.728671 0.008237 1.436719 1.092816 0.742660 1.480879 0.410157 1.288179 0.559234 1.425899 1.219179 0.189574 0.471285 1.159537 -0.028955 1.469388 0.210392 1.141156 -0.135055 0.687474 1.468060 -0.235268 0.553950 0.681055 0.986756 1.515599)
+
+ ;; 69-1
+ 8.134657 #(0.000000 0.790373 1.239220 0.460881 1.120937 1.102394 0.719196 1.260788 1.351581 0.150109 0.706820 1.708757 0.126405 0.573565 0.873737 1.541466 0.883699 0.146819 0.862233 -0.420165 0.374490 0.879454 1.601783 1.026685 -0.075871 -0.210918 0.449967 0.015278 0.084909 0.099093 -0.094596 1.643405 -0.042800 1.741808 0.515794 1.802790 0.939496 -0.125366 1.455519 0.180731 0.916674 -0.121997 0.876713 0.618219 0.625033 -0.767565 0.178266 0.158103 -0.126698 1.357885 1.217166 -0.144966 -0.267986 0.336938 0.761158 0.645268 0.017305 1.693864 1.248389 0.629256 0.208779 -0.415265 -0.031605 -0.400471 0.725040 0.782451 0.715907 0.712328)
)
;;; 69 all -------------------------------------------------------------------------------- ; 8.3066
-#(69 10.631803698099 #(0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0)
- 10.544771744298 #(0 0 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0)
- 10.495518383865 #(0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0)
+(vector 69 10.495518383865 (fv 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0)
+
+ 8.197146 (fv 0.000000 0.551719 0.168788 -0.171535 0.603472 1.646430 0.831219 -0.112901 1.600971 0.776706 -0.257580 1.457106 0.729936 0.539913 1.421843 0.548661 0.072361 0.728562 0.364648 -0.109430 1.359599 1.471812 0.472868 -0.088533 0.623026 0.167759 1.605110 0.053141 0.996253 1.258861 1.710199 1.079237 0.316774 0.568130 0.226861 -0.084943 1.702544 1.075688 0.298153 0.507109 1.291563 1.177929 1.707324 -0.001439 0.386332 0.512557 0.380487 0.243873 1.516865 0.101344 -0.768813 1.646072 0.275192 0.139649 1.389985 1.576705 0.346880 0.446918 1.441036 0.376743 1.075298 0.134005 0.942798 0.778785 1.014815 1.144279 1.213481 1.047075 1.249788)
- 8.233753 #(0.000000 0.534992 0.163595 -0.179031 0.603281 1.669354 0.842065 -0.123172 1.596362 0.769263 -0.250094 1.458438 0.728489 0.531220 1.419532 0.563623 0.092816 0.718338 0.357470 -0.107995 1.352683 1.474351 0.461823 -0.065711 0.633747 0.170094 1.611428 0.068683 0.998561 1.243271 1.706849 1.082979 0.313371 0.569023 0.236509 -0.080224 1.699109 1.065785 0.302393 0.505828 1.303872 1.152648 1.698357 0.011483 0.387745 0.511826 0.358321 0.263163 1.495618 0.071530 -0.760526 1.629771 0.289289 0.134250 1.384190 1.576209 0.342624 0.442406 1.433057 0.376278 1.065601 0.125721 0.962977 0.796045 0.987625 1.133634 1.219494 1.054645 1.253184)
+ ;; 70-1
+ 8.143974 #(0.000000 0.563151 1.347234 0.372166 1.011160 1.230491 0.749402 1.243692 1.327484 0.188943 0.690097 1.705036 0.306148 0.675830 0.924357 1.699354 0.831298 0.036827 0.920452 -0.161127 0.378618 1.012001 1.732453 1.018416 0.093399 -0.223999 0.415971 -0.093239 0.157176 -0.107480 -0.077653 1.591872 -0.197575 1.675265 0.529602 1.688724 1.228937 -0.066917 1.910851 0.147616 0.958159 0.065098 0.692177 0.777376 0.643403 -0.410706 0.296222 0.415687 -0.096263 1.411122 1.263478 0.068706 -0.286121 0.572877 1.080715 0.960873 -0.048076 1.732249 1.330711 0.695044 0.195422 -0.180667 0.159809 -0.240900 0.873699 0.964556 0.811214 0.629243 -0.017179)
)
;;; 70 all -------------------------------------------------------------------------------- ; 8.3666
-#(70 10.957886695862 #(0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 0)
- 10.651799201965 #(0 0 0 0 1 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0)
- 10.635682482778 #(0 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0)
- 10.532930374146 #(0 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0)
+(vector 70 10.532930374146 (fv 0 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0)
- 8.196768 #(0.000000 0.589529 1.425953 0.221379 0.968677 1.246438 0.792676 1.191223 1.328488 0.154409 0.791099 1.799614 0.410049 0.842595 1.094597 1.585978 0.865405 1.947708 1.025881 -0.096702 0.437833 1.081822 1.881812 1.027078 0.089992 0.157936 0.513334 0.037690 0.219211 -0.078770 0.187364 1.516498 -0.015188 1.577495 0.500249 1.764576 1.210938 0.057989 1.935494 0.084029 1.227082 0.188952 0.589121 0.844291 0.768539 -0.216171 0.470655 0.412965 0.148907 1.442158 1.015484 0.078180 -0.144585 0.678877 1.279661 0.998708 -0.084070 1.724481 1.380212 0.566628 0.212722 -0.023171 0.111672 -0.078444 0.958143 1.025995 0.855497 0.661271 -0.012901 1.294108)
+ 8.176963 (fv 0.000000 0.587989 1.431825 0.221285 0.960638 1.245837 0.795275 1.178692 1.324313 0.151685 0.789663 1.805305 0.407280 0.848410 1.089893 1.582619 0.871354 1.940142 1.022672 -0.098747 0.444755 1.081717 1.884930 1.020069 0.094475 0.162127 0.516048 0.043396 0.218952 -0.075886 0.177709 1.517609 -0.008561 1.566136 0.502844 1.768539 1.199988 0.053518 1.941460 0.082194 1.231659 0.182374 0.578473 0.843872 0.777996 -0.220205 0.467426 0.426401 0.154145 1.445497 1.004198 0.090981 -0.148632 0.673583 1.270739 1.002492 -0.085118 1.727335 1.374618 0.568333 0.205667 -0.017872 0.120962 -0.075966 0.957264 1.025234 0.841047 0.662525 -0.011036 1.297608)
)
;;; 71 all -------------------------------------------------------------------------------- ; 8.4261
-#(71 10.922951698303 #(0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 0)
- 10.610488331633 #(0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0)
+(vector 71 10.610488331633 (fv 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0)
- 8.342627 #(0.000000 0.141337 -0.158488 1.386295 0.213176 0.202745 1.043498 1.429334 0.015577 1.537756 0.354878 1.059553 -0.208180 0.646065 0.415652 0.991893 1.126141 0.879065 0.869862 0.442326 0.772499 0.442793 0.497509 1.102662 0.463869 1.201431 1.159514 0.972040 1.302388 0.774369 -0.489263 0.568155 0.812832 0.528557 0.258407 1.656977 -0.161464 0.665060 1.056094 -0.129929 1.023415 0.114186 0.672275 0.460865 1.764411 1.324298 0.778294 0.100031 0.765943 1.170675 1.488561 1.776604 -0.148445 1.535987 -0.044767 0.367374 1.054685 1.119818 0.565109 0.253657 1.475192 0.271610 0.888136 1.151754 1.034942 0.256921 1.616849 0.309381 1.402732 0.559976 0.166209)
+ 8.319609 (fv 0.000000 0.140438 -0.156343 1.390907 0.216508 0.199081 1.047301 1.430567 0.016863 1.549577 0.363516 1.057536 -0.217538 0.646697 0.414461 0.993065 1.127770 0.877766 0.873392 0.440804 0.760841 0.449527 0.494946 1.105821 0.463488 1.200046 1.158237 0.977607 1.309426 0.772719 -0.483517 0.568526 0.817490 0.531524 0.272201 1.656272 -0.164981 0.659567 1.062868 -0.123485 1.015493 0.120132 0.671070 0.461022 1.766703 1.319785 0.775590 0.108288 0.757022 1.176333 1.486331 1.779348 -0.137633 1.540074 -0.041450 0.361903 1.057755 1.116867 0.573932 0.250328 1.480465 0.262890 0.893036 1.148682 1.046983 0.264942 1.618761 0.311598 1.395691 0.570219 0.159607)
+
+ ;; 70+1
+ 8.333845 #(0.000000 0.741042 1.489019 -0.124872 1.268392 1.336326 0.512548 0.937748 0.951723 0.152568 1.028858 -0.243353 0.086205 0.754698 1.441559 1.417305 1.142670 0.184075 0.610630 -0.436955 0.403625 1.323364 0.186977 1.074933 -0.224436 -0.269303 1.049190 0.015439 -0.107110 0.312582 0.157384 1.210121 0.061920 -0.163401 -0.010172 1.328828 -0.661526 -0.792391 -0.010926 -0.210071 1.441868 0.452979 0.227037 0.940601 0.552485 -0.755529 0.905193 -0.467293 0.369813 1.273291 1.124208 -0.504204 0.400118 0.917761 0.809535 0.178683 -0.004496 -0.260484 -0.237370 0.532021 0.652869 0.225451 -0.671013 0.610113 1.148179 1.320266 0.936680 0.634471 0.405144 1.190440 0.850770)
+ 8.312176 #(0.000000 0.874002 1.383024 0.378933 0.799884 1.165596 0.533309 1.282741 0.886396 0.160934 0.729340 0.018471 0.256784 0.836821 0.836340 1.632305 0.875224 0.107603 1.058269 -0.313629 0.260148 1.563506 0.301401 1.147223 0.010044 0.210590 0.782179 0.044072 -0.074852 0.152561 0.153788 1.381267 -0.147303 1.443749 -0.014793 1.548909 0.014576 -0.121925 0.202272 0.029847 1.157828 0.486406 0.678816 1.002783 0.802159 -0.032653 0.703505 0.093729 0.211124 1.142051 1.177369 -0.359654 -0.078427 0.818294 0.971684 0.534909 -0.090789 -0.374344 1.667746 0.494486 0.436543 0.088578 -0.362483 0.515273 1.078602 1.312304 0.992479 0.513991 0.105033 1.004668 0.388247)
)
;;; 72 all -------------------------------------------------------------------------------- ; 8.4853
-#(72 11.061260849739 #(0 1 1 0 1 0 0 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 0 1)
- 10.908146369485 #(0 1 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0)
- 10.800657366855 #(0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0)
+(vector 72 10.800657366855 (fv 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0)
+
+ 8.472893 (fv 0.000000 -0.093428 0.860520 0.651650 0.036400 1.174208 -0.214755 0.653075 0.661176 1.355137 1.759893 1.116459 1.283776 0.222435 0.388195 1.541066 0.171819 0.911538 0.292609 1.508023 0.997352 1.385529 0.022962 0.061408 -0.061153 0.241196 0.345845 0.923448 0.626801 0.283115 0.129077 0.499608 0.703807 0.614285 0.908458 0.403245 1.817077 1.458947 0.221667 1.213107 1.163972 1.117128 0.465749 0.627880 0.010093 0.512887 0.278332 0.535697 1.736410 -0.297420 0.467311 1.419905 1.531806 0.300181 0.244309 1.719696 1.200428 1.778805 1.081039 0.613164 1.654092 1.161237 1.675808 0.051072 0.709895 1.432879 0.690303 1.567340 0.453011 1.156931 0.253055 -0.113821)
- 8.484975 #(0.000000 -0.092424 0.858171 0.650912 0.036725 1.175528 -0.216048 0.653294 0.661478 1.355613 1.761283 1.116547 1.282048 0.222210 0.391186 1.543181 0.171736 0.912437 0.291502 1.506782 0.997167 1.382716 0.025768 0.062824 -0.062744 0.238670 0.346046 0.925508 0.627575 0.283647 0.130856 0.497026 0.704884 0.615109 0.909106 0.403897 1.813997 1.458867 0.223219 1.214622 1.163400 1.117909 0.465716 0.626392 0.009599 0.512105 0.279706 0.535511 1.736036 -0.298604 0.469908 1.421114 1.532543 0.295274 0.241750 1.721184 1.195551 1.780212 1.082278 0.611999 1.657465 1.159168 1.676597 0.050083 0.706569 1.431356 0.691415 1.565501 0.453580 1.157227 0.253598 -0.114374)
+ ;; pp.scm:
+ 8.398072 (fv 0.000000 0.721030 0.948975 1.651519 0.233429 1.256419 1.215593 0.048780 1.144871 0.213229 0.880829 1.692382 0.366636 0.960208 1.629523 0.574770 1.546769 0.517973 1.617121 0.416046 1.542708 0.301404 1.290249 0.820158 0.258866 0.894435 0.090675 1.532038 0.985523 -0.034703 1.528561 0.881196 0.099225 -0.003432 1.044040 0.536864 -0.131692 1.029980 1.151362 0.675489 -0.005731 -0.378928 1.525987 1.057922 0.658986 0.443501 0.074450 0.429490 -0.435612 0.068631 -0.209332 1.531485 1.585628 1.667775 1.257877 1.589580 1.146646 -0.378411 1.726866 -0.167738 -0.290459 -0.269650 0.365115 0.370457 0.748015 1.193861 1.678605 0.010066 0.170551 0.863723 0.838123 1.538906)
)
;;; 73 all -------------------------------------------------------------------------------- ; 8.5440
-#(73 10.9493838342178 #(0 0 0 1 0 0 1 0 1 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0)
- 10.889594078064 #(0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0)
- 10.876985549927 #(0 0 1 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 0)
- 10.773231506348 #(0 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1)
+(vector 73 10.773231506348 (fv 0 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1)
- 8.446321 #(0.000000 -1.844193 0.237307 1.465217 0.629537 1.095175 0.712636 0.012226 1.169468 0.065480 1.016798 -0.329653 1.126563 0.968277 1.108048 -0.060773 1.198413 -1.808050 0.092558 0.973987 1.580884 1.034973 -0.064582 1.876144 0.423790 1.574791 0.945315 0.996158 1.254991 1.730074 0.521314 0.345139 -0.020878 1.604099 0.420461 0.362267 0.327651 1.057782 0.530307 0.585259 1.283046 0.066106 0.246485 0.035152 -0.022106 -0.244526 -0.102501 1.633297 0.463739 1.532663 0.133410 0.080702 0.452435 1.059580 1.900609 0.508488 1.229317 0.665900 0.380825 1.661321 1.359302 0.405399 0.573977 0.877078 1.830531 -0.330877 1.112625 0.321882 1.296622 0.006121 0.121167 1.613339 0.587042)
+ 8.432898 (fv 0.000000 -1.848123 0.239060 1.464251 0.628713 1.091837 0.714118 0.011434 1.168318 0.062880 1.015397 -0.328225 1.126530 0.965816 1.106076 -0.063170 1.197633 -1.809778 0.091864 0.972492 1.580451 1.036972 -0.065401 1.876586 0.421742 1.575936 0.943040 0.998651 1.251175 1.731410 0.520979 0.344525 -0.022728 1.604302 0.415026 0.363810 0.330426 1.053516 0.529548 0.585862 1.282692 0.064995 0.245738 0.033146 -0.021970 -0.243322 -0.102869 1.628985 0.462863 1.533635 0.132871 0.079809 0.450013 1.062550 1.900737 0.507033 1.228155 0.664499 0.381483 1.660810 1.361854 0.409741 0.569163 0.877009 1.830036 -0.331099 1.110302 0.325340 1.299368 0.004038 0.123887 1.612282 0.588683)
+ 8.433132 (fv 0.000000 -1.847444 0.237344 1.464638 0.628887 1.093285 0.714406 0.013323 1.168036 0.063810 1.016680 -0.328601 1.126593 0.966206 1.107076 -0.063367 1.197228 -1.807287 0.093599 0.972529 1.580674 1.036337 -0.065390 1.875846 0.422275 1.575682 0.944151 0.999284 1.251360 1.730976 0.519804 0.344632 -0.023064 1.604915 0.415187 0.364741 0.329769 1.054442 0.530131 0.585700 1.283021 0.065351 0.245840 0.033137 -0.021137 -0.245019 -0.102624 1.631439 0.462301 1.532901 0.133014 0.079045 0.450558 1.061941 1.898554 0.507196 1.226904 0.663782 0.379349 1.659890 1.360030 0.408513 0.568905 0.876030 1.829471 -0.331743 1.109442 0.325360 1.299379 0.003611 0.124368 1.612931 0.587209)
)
;;; 74 all -------------------------------------------------------------------------------- ; 8.6023
-#(74 11.023842939777 #(0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0)
- 10.97177028656 #(0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0)
- 10.70422077179 #(0 1 1 1 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 0)
- 10.684138298035 #(0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1)
+(vector 74 10.684138298035 (fv 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1)
- 8.522549 #(0.000000 1.308223 0.177459 1.526026 0.937597 -0.024601 1.085518 0.614759 0.049431 0.860735 0.093536 0.737237 1.854555 0.003485 1.317116 0.116687 1.181918 1.498268 0.317464 0.590633 1.531559 -0.086575 -0.133597 1.006298 1.096914 -0.190687 1.048510 0.964382 0.087235 1.640984 0.509301 -0.557687 1.723185 1.626802 0.042599 -0.071979 1.390407 -0.009996 1.250033 0.217590 -0.005086 1.634165 1.609260 1.030941 0.810004 1.284548 1.519877 -0.525322 0.344866 1.051686 1.363807 0.633571 -0.114841 0.039341 0.287263 0.636619 0.015029 0.292361 1.104964 1.064061 0.969443 0.983445 -0.058122 0.391672 -0.025078 0.785780 0.237799 0.847721 1.406177 1.102012 -0.034164 -0.293347 1.408045 1.196896)
+ 8.497103 (fv 0.000000 1.325782 0.182538 1.505234 0.945874 -0.041671 1.080868 0.605444 0.042184 0.866151 0.092779 0.735532 1.859565 0.020319 1.317206 0.107906 1.193633 1.487996 0.330731 0.601261 1.523499 -0.092194 -0.139866 0.997309 1.096776 -0.197191 1.061243 0.954641 0.070885 1.639404 0.509022 -0.561148 1.719565 1.632249 0.046116 -0.076359 1.376098 -0.015465 1.245129 0.220256 -0.000849 1.641349 1.603215 1.034336 0.812483 1.278349 1.510965 -0.515530 0.337854 1.060139 1.372801 0.633196 -0.113165 0.038608 0.288776 0.637200 0.027245 0.289307 1.083582 1.060936 0.972742 0.986362 -0.049682 0.384401 -0.025034 0.779020 0.227500 0.842052 1.419898 1.088862 -0.034683 -0.286302 1.416569 1.188508)
)
;;; 75 all -------------------------------------------------------------------------------- ; 8.6603
-#(75 11.477107048035 #(0 1 0 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 0)
- 10.935811368418 #(0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1)
+(vector 75 10.935811368418 (fv 0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1)
- 8.632092 #(0.000000 1.764538 1.253717 1.380131 0.141660 0.884682 1.326757 0.151113 0.154215 1.314652 0.887522 1.246745 1.573179 0.307247 0.432900 1.533989 1.740530 0.962265 1.871122 1.036920 1.278109 1.361382 1.313877 1.226953 1.383966 1.652065 0.772497 0.601545 0.259704 1.027667 1.195633 0.578641 0.070369 1.192119 1.340996 0.302513 0.815916 1.847978 0.733786 0.580160 0.791274 1.073081 1.407414 0.033212 1.241236 0.205017 1.338993 1.559239 1.579125 1.693991 1.740949 0.077155 1.110452 0.215215 1.132812 0.442513 -0.149965 1.355219 0.030640 1.303153 0.831361 0.424206 0.206330 1.308387 1.829214 0.045619 0.064895 0.212321 1.545976 0.843068 1.074333 0.246320 0.771956 0.376604 1.449632)
+ 8.611733 (fv 0.000000 1.755991 1.257704 1.380660 0.149810 0.888775 1.327127 0.155263 0.151577 1.307367 0.881185 1.244394 1.574597 0.297434 0.440838 1.532006 1.732873 0.955224 1.870085 1.039379 1.279345 1.370265 1.314175 1.228630 1.384735 1.656856 0.776266 0.604534 0.261984 1.021399 1.199829 0.578676 0.077339 1.180219 1.340992 0.303192 0.817942 1.840717 0.738716 0.586273 0.790045 1.068192 1.408743 0.034139 1.236420 0.200452 1.339574 1.564413 1.584603 1.696238 1.745531 0.073419 1.093015 0.201959 1.123150 0.434940 -0.158552 1.357895 0.030228 1.300705 0.831156 0.431680 0.205560 1.314167 1.822576 0.046350 0.064332 0.206633 1.539706 0.841946 1.061607 0.243862 0.776250 0.362661 1.442056)
+
+ ;; pp:
+ 8.821449 (fv 0.000000 0.643920 1.130972 1.690238 0.292464 0.869774 1.528895 0.096431 0.833368 1.732367 0.427956 1.133243 1.895101 0.800425 1.503313 0.355825 1.366323 0.344133 1.388010 0.331489 1.394341 0.485612 1.420333 0.688914 1.775329 0.789323 0.036609 1.415234 0.580136 1.640322 0.948602 0.310562 1.639770 0.988134 0.358709 1.824434 1.269806 0.767195 0.219365 1.612634 1.203169 0.799392 0.490094 0.057192 1.813674 1.532055 1.111172 0.983185 0.529777 0.494315 0.164905 0.200436 0.060224 0.054336 1.844838 1.742836 -0.015897 1.650654 1.808368 1.772294 1.907511 0.205329 0.331823 0.493249 0.521115 0.584376 0.981386 1.313449 1.561550 1.968782 0.480174 0.693653 1.229745 1.573452 0.052739)
+
+ ;; 74+1
+ 8.558162 #(0.000000 1.299463 0.144766 1.482206 0.852041 0.041751 0.945435 0.663483 0.032304 0.784185 0.138079 0.757000 1.655016 -0.051151 1.355972 0.142680 1.361194 1.375515 0.355950 0.322113 1.647006 -0.122201 -0.167635 1.027227 0.946767 -0.181720 1.159893 0.860801 0.046383 1.617661 0.451596 -0.634275 1.845795 1.639204 0.033347 -0.058314 1.256252 0.010245 1.129872 0.165186 -0.262708 1.745515 1.511527 1.020459 0.814780 1.270884 1.648219 -0.420679 0.234869 1.046009 1.235347 0.477491 0.107721 -0.063079 0.160473 0.709557 -0.087490 0.220254 0.843552 0.987545 0.718476 0.992398 -0.027851 0.215501 0.090914 0.848865 0.253479 0.800849 1.468047 1.086774 -0.125845 -0.438777 1.410433 1.246292 0.092658)
+
+ ;; 76-1
+ 9.623 (fv 0.000000 0.389242 -0.170662 1.421644 1.248164 0.164000 0.718605 1.792721 0.677210 1.518595 0.963267 -0.186472 1.263794 1.595425 0.383743 0.443182 1.535243 0.669172 1.194047 0.802827 1.746269 0.569800 1.408025 1.796723 1.258639 0.620093 0.886554 0.863256 0.711462 1.456391 -0.186271 0.639923 1.414383 -0.059653 0.858601 0.618312 0.847274 0.301714 0.319909 0.359052 0.817062 -0.212571 0.558016 0.169995 1.152558 0.886044 1.332154 0.013242 0.369659 -0.032997 1.710630 1.029547 0.363359 -0.095703 0.197840 0.264645 1.078918 0.774045 1.172991 1.082380 0.650868 1.140749 0.194089 0.747056 0.734148 0.248352 1.094670 0.793873 -0.197763 1.665030 0.915389 0.675623 1.504323 1.585265 1.586133)
)
;;; 76 all -------------------------------------------------------------------------------- ; 8.7178
-#(76 11.329963225913 #(0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 0)
- 11.208243370056 #(0 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0)
- 10.689208030701 #(0 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0)
+(vector 76 10.689208030701 (fv 0 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0)
- 8.643242 #(0.000000 0.388535 -0.169633 1.420957 1.245999 0.167805 0.713529 1.790854 0.679861 1.520955 0.961798 -0.181972 1.261311 1.597487 0.384840 0.445852 1.533600 0.666902 1.195141 0.798959 1.743970 0.575122 1.404884 1.805044 1.254626 0.624574 0.885078 0.855448 0.711315 1.462608 -0.182427 0.641966 1.412400 -0.057813 0.857919 0.614882 0.850150 0.304482 0.321716 0.357262 0.813636 -0.217811 0.554746 0.171178 1.149054 0.882059 1.332660 0.010871 0.367462 -0.034408 1.717758 1.029357 0.361457 -0.096494 0.192752 0.264541 1.072049 0.776916 1.176760 1.079884 0.655770 1.138154 0.191379 0.748841 0.737827 0.251433 1.090382 0.795518 -0.196925 1.663403 0.913193 0.664962 1.502965 1.583111 1.584691 1.086292)
+ 8.622898 (fv 0.000000 0.389242 -0.170662 1.421644 1.248164 0.164000 0.718605 1.792721 0.677210 1.518595 0.963267 -0.186472 1.263794 1.595425 0.383743 0.443182 1.535243 0.669172 1.194047 0.802827 1.746269 0.569800 1.408025 1.796723 1.258639 0.620093 0.886554 0.863256 0.711462 1.456391 -0.186271 0.639923 1.414383 -0.059653 0.858601 0.618312 0.847274 0.301714 0.319909 0.359052 0.817062 -0.212571 0.558016 0.169995 1.152558 0.886044 1.332154 0.013242 0.369659 -0.032997 1.710630 1.029547 0.363359 -0.095703 0.197840 0.264645 1.078918 0.774045 1.172991 1.082380 0.650868 1.140749 0.194089 0.747056 0.734148 0.248352 1.094670 0.793873 -0.197763 1.665030 0.915389 0.675623 1.504323 1.585265 1.586133 1.087431)
)
;;; 77 all -------------------------------------------------------------------------------- ; 8.7750
-#(77 11.25105381012 #(0 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0)
- 11.114716461811 #(0 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0)
+(vector 77 11.114716461811 (fv 0 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0)
- 8.715992 #(0.000000 0.343638 0.500823 0.595013 1.397515 1.795155 0.103221 0.260159 0.939396 0.392726 0.658523 0.284936 1.145414 0.211389 0.208587 0.814386 1.399647 1.683620 0.522095 0.161940 -0.260472 0.364847 0.092955 -0.140928 0.770130 0.072000 -0.057107 0.788934 0.718362 1.679456 0.738735 1.235005 -0.110249 1.582164 0.658415 -0.031936 -0.144814 1.611469 1.468462 0.703202 -0.054689 1.228801 0.878516 0.475373 0.494996 0.321146 1.621221 0.590444 0.569863 0.911694 0.704465 1.139732 0.710823 -0.078502 0.365256 0.181971 0.721506 1.469760 0.759141 0.752858 1.495901 1.652077 1.482651 1.747881 0.982464 1.370293 0.546967 -0.602071 1.839976 0.848896 1.037692 0.314370 0.515661 0.004471 1.329690 -0.114255 1.302545)
+ 8.693626 (fv 0.000000 0.342470 0.518102 0.602103 1.407511 1.793531 0.096346 0.250378 0.943784 0.388159 0.656038 0.296223 1.141950 0.214103 0.212479 0.828756 1.402312 1.692057 0.511954 0.158583 -0.254149 0.373835 0.095344 -0.147316 0.784069 0.081610 -0.056393 0.798330 0.705534 1.696239 0.742515 1.236436 -0.107133 1.590407 0.658892 -0.033009 -0.161883 1.612218 1.476439 0.692575 -0.060023 1.224517 0.875204 0.501273 0.494798 0.327706 1.600469 0.607079 0.567961 0.917115 0.716199 1.138396 0.731691 -0.084350 0.371809 0.181536 0.739186 1.478965 0.762792 0.759384 1.499056 1.662862 1.474568 1.752637 0.981158 1.382311 0.543578 -0.609814 1.825975 0.848970 1.045950 0.310451 0.519502 0.003348 1.354017 -0.105098 1.298274)
)
;;; 78 all -------------------------------------------------------------------------------- ; 8.8318
-#(78 11.559678967298 #(0 1 1 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 1 1 0 0 0 1)
- 11.541502084124 #(0 1 1 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1)
- 11.471938943963 #(0 1 1 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1)
+(vector 78 11.471938943963 (fv 0 1 1 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1)
- 8.744206 #(0.000000 1.239285 1.237261 0.078116 0.092605 1.616877 0.344363 1.853082 1.550439 0.023954 1.407516 1.785799 1.255102 0.692763 0.314801 1.055942 0.782816 1.713171 0.548737 0.557675 0.788958 1.844287 0.772589 1.428243 0.898347 0.578374 1.609787 0.279494 1.207579 1.491759 0.746752 1.733047 1.569273 1.439916 1.462217 0.641522 1.124944 1.571028 1.455424 0.685782 0.614738 1.390178 -0.085617 0.661197 0.478569 1.288588 1.791544 0.994137 1.631807 0.402625 0.790835 1.298406 0.985821 1.875388 0.991075 0.174727 0.344688 0.032881 -0.174887 1.451309 -0.071867 1.634445 0.478661 0.256394 0.032169 -0.139110 0.164314 1.014894 0.852396 0.981002 1.404172 1.592305 0.155949 -0.216955 1.811776 0.241133 1.848863 1.014514)
+ 8.722411 (fv 0.000000 1.255512 1.230399 0.081980 0.091889 1.621099 0.342591 1.837930 1.553347 0.020611 1.397162 1.790981 1.252453 0.690562 0.318059 1.053703 0.774563 1.716197 0.556425 0.552259 0.785064 1.839927 0.777897 1.437066 0.895405 0.585543 1.604873 0.287802 1.218230 1.490317 0.738166 1.716918 1.559725 1.441156 1.459900 0.634618 1.118581 1.560941 1.459563 0.686391 0.612299 1.393780 -0.080258 0.668424 0.483242 1.297761 1.805261 0.997133 1.633324 0.413677 0.790560 1.306313 0.980643 1.877269 0.988455 0.158400 0.345980 0.044253 -0.181533 1.453766 -0.079535 1.631519 0.486812 0.259728 0.034933 -0.142793 0.162924 0.999804 0.854260 0.983588 1.417702 1.583925 0.160842 -0.232352 1.810021 0.235258 1.847667 1.008413)
)
;;; 79 all -------------------------------------------------------------------------------- ; 8.8882
-#(79 11.431832400958 #(0 0 1 1 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 0 0 1 1 0 1 1 0 0 1 0)
- 11.407577489438 #(0 0 1 1 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 0)
- 11.334476470947 #(0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 1 0)
+(vector 79 11.334476470947 (fv 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 1 0)
+
+ 8.845367 (fv 0.000000 1.238318 1.165090 1.291700 0.803595 0.614248 1.388497 1.905092 0.146964 0.775475 0.093294 -0.057178 0.069260 0.967289 0.726888 1.927694 0.404014 -0.050125 1.170622 0.795731 0.415661 0.113117 0.949983 0.547877 0.937155 0.147536 1.182414 0.680260 0.043365 0.406697 0.191985 0.520170 0.649818 0.646884 0.567272 1.384599 1.089945 0.420022 1.776381 1.388186 1.481564 0.061642 1.806781 0.638535 0.038366 1.606509 1.826388 1.366478 1.328019 0.480776 1.683074 0.476259 0.537766 1.179629 1.609320 1.234604 0.090600 0.429089 1.028733 0.835166 0.689618 1.227466 0.068475 0.130750 1.461448 1.601183 1.627224 0.857096 1.862391 0.455364 1.260302 0.135047 1.550455 0.219288 0.922341 0.004761 0.651583 1.409352 1.642849)
- 8.866826 #(0.000000 1.234513 1.172681 1.292757 0.812031 0.616031 1.388387 1.894336 0.138847 0.770448 0.090920 -0.061612 0.074248 0.963205 0.726199 1.918232 0.394970 -0.054875 1.174869 0.806430 0.412283 0.105077 0.951097 0.546227 0.933678 0.141339 1.178992 0.673677 0.043328 0.398646 0.188933 0.522705 0.653118 0.644965 0.570289 1.381602 1.084020 0.415241 1.765900 1.388637 1.482112 0.060623 1.809157 0.629721 0.025024 1.603052 1.825890 1.359891 1.340251 0.480313 1.679536 0.469584 0.535689 1.182636 1.606418 1.232038 0.082934 0.426373 1.036198 0.835028 0.689115 1.222631 0.076323 0.130148 1.458386 1.608396 1.617994 0.848188 1.858843 0.448332 1.245482 0.120650 1.540537 0.224841 0.916439 -0.009589 0.647508 1.404566 1.649292)
+ ;; pp:
+ 8.789422 (fv 0.000000 0.841271 1.349529 1.890897 0.486913 1.229207 1.764686 0.291323 1.071234 1.657114 0.392223 1.196564 -0.051237 1.012534 1.818519 0.557943 1.398685 0.101423 1.163908 0.287712 1.222706 0.108952 1.110220 0.148905 1.491258 0.557702 1.639140 0.711113 1.834003 1.123857 0.414123 1.736420 1.249713 0.566166 1.633495 0.696955 0.342141 1.602019 1.390394 0.718811 0.378092 1.687751 1.289262 0.793430 0.544409 0.190417 1.780346 1.824595 1.124520 1.532834 0.805430 0.739198 0.373300 -0.106662 1.921342 -0.093028 1.851981 1.677334 0.037484 1.564822 1.520739 1.501603 1.425816 1.592847 1.805684 0.130893 0.254917 0.439595 0.443645 0.715009 0.911405 1.240948 -0.028352 0.369153 0.881458 1.168966 1.410521 1.748339 0.400660)
)
;;; 80 all -------------------------------------------------------------------------------- ; 8.9443
-#(80 11.828915596008 #(0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1)
- 11.745326966911 #(0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 0)
- 11.438133302082 #(0 1 1 1 1 1 0 1 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 0)
- 11.30185508728 #(0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0)
+(vector 80 11.30185508728 (fv 0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0)
- 8.854024 #(0.000000 0.717833 0.750747 0.704640 1.103307 1.551920 1.677009 1.743957 1.743437 1.405677 0.732066 -0.001419 0.791908 0.609103 0.225897 0.543794 1.247717 0.528075 1.737148 1.158221 0.134966 0.560344 0.481477 1.178346 0.210400 1.695099 1.868886 -0.022940 0.443021 -0.097270 1.425754 0.294460 1.415150 1.362500 0.717057 -0.279529 0.876445 0.376959 0.714006 0.898229 0.588814 1.678487 -0.011952 0.621695 -0.260295 0.675280 1.397411 0.022747 0.496095 1.195845 0.589172 0.258277 0.579017 0.642796 1.737100 0.177163 0.510454 1.083948 0.696970 0.375335 0.527409 0.713976 1.396498 1.514892 1.146280 0.670561 0.305554 -0.147484 1.058331 1.484774 0.687340 0.134802 1.270809 -0.335865 0.344739 1.876696 1.913823 1.631828 0.776934 -0.164910)
+ 8.831605 (fv 0.000000 0.718457 0.752874 0.707265 1.105140 1.556866 1.675971 1.743288 1.737050 1.402684 0.726424 0.001544 0.787560 0.610707 0.221912 0.548490 1.255462 0.532840 1.735795 1.159475 0.139393 0.566082 0.477708 1.186070 0.213588 1.697938 1.877210 -0.027617 0.446036 -0.097653 1.420626 0.288659 1.413894 1.358919 0.713009 -0.285435 0.875204 0.375292 0.708148 0.907015 0.596415 1.676708 -0.002236 0.617188 -0.254880 0.679354 1.396570 0.024604 0.491384 1.191175 0.583286 0.255907 0.583959 0.646881 1.743044 0.166682 0.513542 1.079013 0.694687 0.379588 0.528146 0.707196 1.408903 1.510794 1.151055 0.672700 0.297721 -0.154036 1.059849 1.480109 0.687072 0.133333 1.264870 -0.326181 0.342810 1.875130 1.918140 1.634313 0.782341 -0.170226)
)
;;; 81 all -------------------------------------------------------------------------------- ; 9
-#(81 11.712129592896 #(0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0)
- 11.501712958685 #(0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 0 0)
- 11.22668050284 #(0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1)
+(vector 81 11.22668050284 (fv 0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1)
- 8.980797 #(0.000000 0.631669 0.915188 0.370219 0.489953 1.334965 0.656188 1.761764 1.144671 1.456221 0.439069 0.215128 1.112645 0.041999 1.342174 1.778439 1.252169 0.754044 1.116158 0.032105 1.596496 0.100952 1.911789 -0.011028 0.863037 0.824098 1.304878 1.355755 1.030018 0.122747 0.952738 1.169849 0.281027 1.518326 1.812850 0.549743 1.367684 0.694392 0.657315 1.698026 1.001370 1.818756 -0.150223 -0.021445 0.744017 1.664158 0.378342 0.502293 0.704416 0.732092 -0.189637 0.507665 0.351182 0.003191 -0.213306 0.934888 -0.623571 1.647057 1.777570 1.359204 1.129372 0.311328 1.894416 0.202272 1.179761 0.912968 0.384248 -0.060010 0.317560 0.089433 1.058344 -0.081745 1.144675 0.312205 -0.111915 -0.213513 0.240746 1.570176 0.118233 0.125787 -0.131769)
+ 8.961491 (fv 0.000000 0.634711 0.914288 0.369120 0.489315 1.342522 0.647705 1.766421 1.148272 1.455934 0.450010 0.224566 1.110702 0.040996 1.346853 1.773154 1.255402 0.752437 1.110884 0.031625 1.597766 0.103816 1.912905 -0.011027 0.863686 0.820253 1.302167 1.352505 1.039370 0.116915 0.947518 1.168519 0.272351 1.514646 1.808891 0.551022 1.359986 0.703545 0.651408 1.697573 1.001093 1.819478 -0.153070 -0.020542 0.748602 1.669047 0.373021 0.491577 0.705265 0.740848 -0.189697 0.502215 0.348836 0.005306 -0.207198 0.930183 -0.631614 1.639932 1.773044 1.357496 1.130593 0.312825 1.896666 0.201668 1.169961 0.899991 0.382267 -0.065252 0.308097 0.095309 1.059630 -0.075945 1.147344 0.303812 -0.113244 -0.220507 0.240152 1.567520 0.130729 0.128142 -0.134246)
+
+ ;; pp:
+ 8.909320 (fv 0.000000 0.637783 1.093840 1.736075 0.229438 0.855956 1.363854 0.030260 0.521624 1.242121 0.051165 0.675419 1.614595 0.476873 1.278688 0.012785 0.817110 -0.304934 0.720383 -0.202920 0.733695 0.107439 1.315558 0.129614 1.122993 0.193244 1.234642 0.403581 1.725244 0.895732 0.205820 1.636536 0.593082 1.809528 1.260391 0.470119 -0.070091 1.399098 0.818162 0.271203 1.928340 1.562814 0.865292 0.051460 1.916623 1.232135 1.265689 0.734799 0.654116 0.188660 0.092307 1.641866 1.468875 0.817027 0.972897 0.621305 0.637924 0.617240 0.962249 0.473819 0.518139 0.286173 0.438785 0.267011 0.412016 0.426579 0.834941 1.189978 1.256888 1.096694 1.389245 1.442391 -0.226908 0.347927 0.458943 0.982038 1.505430 1.850054 0.061414 0.437908 0.768823)
)
;;; 82 all -------------------------------------------------------------------------------- ; 9.0554
-#(82 11.697486877441 #(0 0 1 1 0 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0)
- 11.601468306037 #(0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0)
+(vector 82 11.601468306037 (fv 0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0)
+
+ 9.074372 (fv 0.000000 1.648602 0.113059 0.965847 0.614379 1.876939 0.598065 0.033495 1.128904 0.535962 0.404933 0.340847 -0.287176 1.664997 0.944124 0.484563 1.365390 -0.175780 1.135023 1.030858 0.610885 1.630994 0.348969 1.892603 0.337558 0.278067 1.048537 1.676406 0.392409 0.207975 0.887089 1.313518 1.800663 1.007393 0.181812 -0.074478 0.144619 1.511865 1.173214 0.664191 1.387698 1.632837 0.132108 0.353188 0.227412 1.024174 1.607289 0.662392 -0.023377 -0.428601 1.063517 1.407784 1.563623 0.788150 1.561202 0.023129 0.361493 1.608137 1.816713 0.962416 0.274252 0.900687 0.860331 0.458473 0.118859 0.572111 0.805640 1.846370 0.649018 0.713232 0.291663 -1.866918 0.486252 0.300849 0.355338 1.356604 0.996671 0.882787 1.511703 1.110696 1.774461 0.441695)
- 9.092276 #(0.000000 1.643845 0.116237 0.965503 0.610509 1.874498 0.595148 0.034396 1.126799 0.532467 0.406281 0.337194 -0.287344 1.667198 0.943162 0.482383 1.363242 -0.179447 1.135164 1.031732 0.611166 1.632651 0.345508 1.891125 0.333623 0.278988 1.046611 1.675344 0.387973 0.206236 0.888665 1.310275 1.800539 1.007364 0.183049 -0.073103 0.142520 1.514043 1.171338 0.664940 1.389737 1.632194 0.125941 0.354480 0.230298 1.021544 1.610311 0.660762 -0.026969 -0.421658 1.061859 1.410730 1.560784 0.784087 1.564774 0.019943 0.364750 1.607957 1.817770 0.963578 0.273302 0.894027 0.860255 0.459659 0.120381 0.571336 0.807646 1.842560 0.650001 0.716999 0.290558 -1.869941 0.485166 0.304561 0.353479 1.359662 0.998307 0.877161 1.513991 1.113535 1.769238 0.443443)
+ ;; pp:
+ 8.942054 (fv 0.000000 0.741190 1.211121 1.767480 0.098390 0.839201 1.102556 -0.209453 0.453250 1.122839 0.064920 0.959867 1.388767 0.263801 1.292900 0.219769 1.265994 0.422114 1.103821 -0.093210 0.755477 0.000245 0.969187 1.607339 1.053959 0.313625 1.046034 0.279348 1.465040 0.751688 0.022843 1.470315 0.592990 1.853486 1.118710 0.593243 1.855200 0.862858 0.945784 0.185739 1.601158 1.076300 0.669622 0.291600 1.841348 1.175765 0.663836 0.601642 0.369909 1.837262 -0.023948 1.335189 1.343186 0.755277 0.855544 0.293163 0.518573 0.368668 0.285100 0.386831 1.688397 0.163703 0.172910 0.313842 -0.159903 -0.137818 0.212922 0.539645 0.627827 0.897666 0.865830 1.159886 1.047275 1.360198 1.762925 0.204264 1.078567 0.797293 1.200018 1.357729 0.204458 0.441846)
)
;;; 83 all -------------------------------------------------------------------------------- ; 9.1104
-#(83 12.009690094281 #(0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 0)
- 11.868338980165 #(0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0)
- 11.429935034332 #(0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
+(vector 83 11.429935034332 (fv 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
- 8.961799 #(0.000000 0.417511 0.123051 1.158874 0.088185 0.819668 0.337828 1.204160 -0.173978 1.747956 1.589096 1.159440 1.285566 0.189528 1.471159 0.238082 1.623531 0.221731 1.646820 -0.137286 1.526883 0.690147 0.553750 1.525748 -0.229545 -0.008147 0.040617 0.593920 0.904647 0.772510 0.838247 0.723684 0.985328 0.614019 0.409019 0.153002 0.903219 0.109886 0.410021 0.841834 0.542109 1.678642 1.474656 0.628575 0.156596 -0.010676 1.454470 0.986045 0.180600 0.724723 0.638364 1.108540 0.613076 0.233633 0.664061 1.525170 1.836909 0.936421 -0.055156 1.272260 0.326237 1.832208 1.004965 -0.162863 0.288440 0.347530 0.407158 0.044194 0.573395 1.370273 1.602412 0.761793 1.455388 -0.010090 0.692781 1.521140 0.987309 0.562931 0.031337 0.040207 0.191444 0.848002 1.339596)
+ 8.938600 (fv 0.000000 0.414028 0.125789 1.159865 0.086238 0.817482 0.340516 1.199339 -0.170286 1.744945 1.587696 1.158800 1.281058 0.190384 1.473320 0.235428 1.621261 0.225261 1.644931 -0.137023 1.525995 0.691219 0.557902 1.528647 -0.234276 -0.009740 0.044217 0.592778 0.909815 0.773874 0.836299 0.726340 0.981312 0.618405 0.408288 0.150201 0.908250 0.109103 0.413166 0.847395 0.541585 1.672450 1.474939 0.635397 0.153870 -0.014899 1.455728 0.983819 0.181154 0.726107 0.638924 1.106663 0.611788 0.238433 0.670956 1.522770 1.842401 0.939513 -0.051810 1.267322 0.323759 1.831419 1.004026 -0.159128 0.287041 0.349723 0.402841 0.045990 0.570998 1.374651 1.603295 0.760887 1.460939 -0.002747 0.693326 1.517648 0.987805 0.554027 0.029827 0.036863 0.188640 0.849464 1.347102)
)
;;; 84 all -------------------------------------------------------------------------------- ; 9.1652
-#(84 12.073565240583 #(0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 0 1)
- 11.956374168396 #(0 1 1 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 1 1 1 0)
- 11.944072619199 #(0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 0 1)
- 11.81104850769 #(0 0 1 1 1 1 1 0 1 1 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 0 1)
- 11.774056434631 #(0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1)
+(vector 84 11.774056434631 (fv 0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1)
- 9.044627 #(0.000000 0.158886 -0.210250 0.195261 1.195184 0.517464 0.195892 1.421969 1.602303 0.071615 0.595762 0.499604 1.879644 1.304073 1.377585 1.011012 1.568143 1.089093 0.587622 1.187493 0.186273 0.622190 0.440476 1.757991 0.219597 -0.165212 1.503744 1.955265 0.141647 0.854790 1.260160 1.293130 -0.290826 0.449644 -0.216667 -0.357069 1.222891 0.995734 1.646867 1.481943 0.240032 -0.156617 0.756442 1.705742 0.970148 0.357111 0.146317 1.150734 0.483083 0.971202 0.614390 1.330885 0.785777 0.726013 0.571047 1.451004 1.035429 0.764217 0.692906 1.023401 0.006242 0.082780 1.745617 0.712045 0.857320 1.260942 1.336156 0.606086 1.025870 1.515907 0.103150 1.494287 -0.042516 0.924806 0.284502 0.770648 -0.210734 0.729191 0.795889 1.593846 1.080628 1.207295 1.607707 0.584819)
+ 9.023210 (fv 0.000000 0.159304 -0.208530 0.193874 1.193993 0.513874 0.193906 1.420202 1.601162 0.069662 0.596870 0.499106 1.879705 1.298791 1.380896 1.011752 1.567079 1.088823 0.586749 1.189212 0.187019 0.623891 0.443258 1.756821 0.221910 -0.166048 1.505325 1.956699 0.145006 0.858253 1.259810 1.292214 -0.292005 0.449812 -0.218977 -0.354252 1.219999 0.997645 1.646540 1.482430 0.239288 -0.155628 0.755326 1.705293 0.967714 0.360450 0.143064 1.152089 0.481087 0.972815 0.614833 1.330922 0.788019 0.726428 0.572863 1.454284 1.031818 0.764416 0.692179 1.019395 0.005944 0.083543 1.745841 0.713648 0.857380 1.260681 1.338561 0.608841 1.025699 1.518383 0.107569 1.492751 -0.040716 0.923284 0.288212 0.772164 -0.210851 0.728511 0.794985 1.593926 1.082153 1.208449 1.606070 0.581831)
)
;;; 85 all -------------------------------------------------------------------------------- ; 9.2195
-#(85 12.387479800774 #(0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1)
- 12.285636929325 #(0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0)
- 11.953980403239 #(0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 1)
- 11.927130699158 #(0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 1 1 0 1)
+(vector 85 11.927130699158 (fv 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 1 1 0 1)
- 9.155142 #(0.000000 0.380905 0.038485 1.427676 0.418774 1.143887 0.738795 -0.138920 -0.454319 0.633733 1.401035 1.829903 0.612463 1.329130 0.766071 1.638016 1.584849 0.375324 0.769332 0.485445 0.235537 1.112001 0.802364 1.648233 0.007356 0.655910 0.986138 -0.055905 1.737354 1.799347 1.128169 0.081366 1.415863 0.454274 0.389908 0.822053 0.576320 1.356446 1.538887 0.405186 0.910231 1.261555 0.959447 0.667265 1.346163 0.260116 0.337909 0.289782 1.567855 0.045616 0.923310 1.714171 0.917970 1.032097 0.717152 1.565266 1.329678 1.249287 0.225180 0.893035 0.620800 0.858660 0.594346 1.300378 0.832415 1.435079 0.912667 1.215421 0.459983 1.518837 1.285312 0.638740 0.992128 0.655406 1.360621 -0.241349 0.713736 0.312950 -0.003245 0.034401 -0.163266 1.682639 0.653039 0.587292 0.083050)
+ 9.127702 (fv 0.000000 0.377539 0.047529 1.429700 0.417181 1.140688 0.738197 -0.138709 -0.448043 0.627123 1.392127 1.819604 0.611302 1.321770 0.758910 1.628764 1.577483 0.372253 0.761090 0.479480 0.236979 1.110344 0.805106 1.644437 0.008357 0.656171 0.991297 -0.054354 1.739257 1.797129 1.125137 0.066677 1.422676 0.455091 0.389601 0.812550 0.569451 1.358336 1.535806 0.395945 0.917012 1.261389 0.975555 0.676523 1.340562 0.262979 0.348691 0.300647 1.560755 0.036844 0.912709 1.718241 0.914499 1.035722 0.712055 1.556119 1.328161 1.240892 0.216373 0.897089 0.626805 0.862584 0.585791 1.306757 0.828290 1.426360 0.918009 1.215542 0.443071 1.531104 1.274055 0.636447 0.998872 0.647434 1.352131 -0.267987 0.709420 0.317461 -0.001614 0.037126 -0.160098 1.679742 0.637515 0.582751 0.080874)
+
+ ;; 84+1
+ 9.178091 #(0.000000 0.092570 -0.328688 0.101879 1.164231 0.484791 0.263025 1.451681 1.371169 0.108316 0.583377 0.421708 0.063889 1.308369 1.554699 0.834440 1.382249 1.018775 0.556330 1.227389 0.358177 0.557221 0.316807 0.026851 0.347091 -0.193100 1.503856 1.682820 0.057602 0.906412 1.391283 1.172258 -0.306686 0.435069 -0.568978 -0.558083 1.240277 0.880388 1.809028 1.648747 0.142044 -0.051135 0.843030 1.589081 1.068210 0.522719 0.218341 1.007282 0.577304 0.998448 0.637448 1.458645 0.805087 0.732402 0.662530 1.436936 1.230072 0.780536 0.678657 1.336068 0.047814 0.297831 1.418569 0.786054 0.797109 1.410904 1.430707 0.466713 0.866817 1.332398 -0.186495 1.178146 -0.048740 1.088830 0.300282 0.620896 -0.201097 0.818687 0.773330 1.535207 1.274976 1.303891 1.667213 0.674931 -0.125079)
+
+ ;; 86-1
+ 9.057437 #(0.000000 0.570249 1.184584 1.763388 0.253739 0.874255 1.649278 -0.092856 0.545746 1.441082 0.012387 0.739864 1.567229 0.641869 1.248428 -0.258864 0.979020 0.106196 1.239561 0.188339 0.720317 1.206705 0.453833 1.256155 0.621647 1.775821 0.919384 0.039412 0.513365 0.132311 1.564752 0.722942 -0.071448 0.948131 0.009774 -0.016202 1.545153 0.487923 1.885615 1.372906 0.427563 1.527257 1.364251 0.890503 0.310553 1.662790 1.384147 1.043036 0.692189 -0.262514 1.340606 1.191753 0.846965 0.759339 0.701652 0.227347 0.525330 -0.260407 1.542211 1.308169 1.173799 1.057289 0.913467 1.783655 0.864914 1.204813 0.682233 0.998463 0.661854 1.098908 1.112695 1.765172 1.335644 1.631977 -0.249510 -0.168729 0.097422 0.642025 1.050451 1.546328 0.006675 0.099459 0.586892 1.021930 1.127145)
+ 9.056499 #(0.000000 0.570308 1.184668 1.763370 0.253738 0.874213 1.649266 -0.092904 0.545708 1.441048 0.012251 0.739873 1.567319 0.641927 1.248333 -0.259041 0.979149 0.106269 1.239451 0.188403 0.720423 1.206709 0.453748 1.256279 0.621678 1.775878 0.919381 0.039448 0.513410 0.132072 1.564796 0.722923 -0.071345 0.948116 0.009644 -0.016259 1.545160 0.488035 1.885525 1.372878 0.427535 1.527093 1.364161 0.890433 0.310618 1.662754 1.384111 1.043150 0.692172 -0.262652 1.340519 1.191733 0.846909 0.759400 0.701644 0.227485 0.525106 -0.260481 1.542300 1.308046 1.173799 1.057405 0.913483 1.783592 0.864774 1.204856 0.682218 0.998396 0.661847 1.098951 1.112628 1.765109 1.335517 1.632001 -0.249528 -0.168911 0.097451 0.641933 1.050350 1.546283 0.006653 0.099465 0.586819 1.021860 1.127109)
)
-;;; 86 all -------------------------------------------------------------------------------- ; 9.2736
-#(86 11.942325532619 #(0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 0)
- 11.819784750357 #(0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
- 11.780031204224 #(0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
+;;; 86 all -------------------------------------------------------------------------------- ; 9.27362
+(vector 86 11.780031204224 (fv 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
- 9.230692 #(0.000000 -0.334039 0.926164 -0.124191 1.090943 0.081684 0.849995 -0.011891 1.474280 1.306511 0.415880 0.297495 1.663504 0.505989 1.691813 1.168579 0.793963 0.979648 0.976412 1.054146 1.793369 1.473478 1.869912 1.488144 1.920132 0.456191 1.689121 0.600429 0.954005 -0.162273 0.844298 1.043993 0.896731 0.724180 0.151142 1.621304 1.194355 1.519134 0.802067 1.177618 0.837530 0.861683 1.517885 1.510358 0.387838 0.391953 0.797931 0.808974 1.194114 1.752017 0.271771 0.592790 0.332392 1.536346 0.764940 0.691268 1.019474 0.686812 -0.031050 0.955035 0.191738 0.395296 1.617143 0.226761 0.907332 1.312630 1.426434 0.601637 1.494177 -0.655997 1.696110 0.972899 1.425838 1.445779 1.278992 1.171807 0.629493 0.322978 1.751601 0.769386 1.539778 0.210098 0.103494 1.141251 -0.367091 0.043288)
+ 9.206953 (fv 0.000000 -0.339088 0.933342 -0.128298 1.099279 0.084536 0.851599 -0.014992 1.465425 1.307317 0.418122 0.289943 1.668778 0.506500 1.696171 1.171193 0.792416 0.989400 0.972892 1.055909 1.790099 1.474165 1.862965 1.486120 1.916599 0.452792 1.686062 0.595804 0.951171 -0.158372 0.842834 1.045604 0.896962 0.721188 0.145646 1.627929 1.192540 1.524829 0.808536 1.173303 0.835497 0.870602 1.525244 1.506688 0.379810 0.397104 0.800652 0.803279 1.193873 1.751911 0.273257 0.582749 0.328287 1.542626 0.758388 0.690207 1.020504 0.688526 -0.031652 0.949811 0.197494 0.391786 1.605605 0.223632 0.906957 1.312801 1.428402 0.597149 1.497710 -0.659689 1.704635 0.962819 1.427359 1.450510 1.282944 1.167035 0.635413 0.328489 1.735204 0.771081 1.542497 0.207128 0.104268 1.136822 -0.363620 0.034704)
+
+ ;; 87-1
+ 9.154099 #(0.000000 0.546512 1.116802 1.888989 0.250808 0.822374 1.651582 -0.005692 0.626109 1.455571 0.073330 0.769650 1.652439 0.510220 1.146206 -0.051780 0.983214 -0.011253 1.055524 0.058792 0.798885 1.375789 0.494600 1.319397 0.591354 1.783545 0.902610 -0.070574 0.807019 0.110199 1.541898 0.751946 0.067110 0.972246 0.094850 1.874652 1.395502 0.413454 1.892267 1.394755 0.404089 1.604275 1.353279 0.912134 0.279923 1.677474 1.359302 1.024954 0.494212 -0.204624 1.444381 1.142405 0.986643 0.784929 0.720869 0.142356 0.321014 -0.264424 1.700672 1.171217 1.168722 0.911571 0.897262 1.490697 0.828456 1.047805 0.694648 0.985672 0.794358 1.062298 1.103188 1.595006 1.521040 1.764525 -0.106047 0.016946 0.120669 0.643435 1.011018 1.433782 0.064397 0.052151 0.670043 1.097438 1.450840 1.829744)
)
;;; 87 all -------------------------------------------------------------------------------- ; 9.3274
-#(87 12.170317807503 #(0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 1)
- 12.065419665482 #(0 0 1 1 1 0 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1)
- 11.76194265333 #(0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
+(vector 87 11.76194265333 (fv 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
+
+ 9.336088 (fv 0.000000 0.935303 -0.305855 0.639666 -0.205066 0.575166 1.878633 -0.031633 0.332111 0.265245 0.447761 1.471005 0.466239 1.074654 0.243517 0.903095 0.071080 0.582837 0.986978 1.432105 0.143848 1.529993 0.888064 0.154620 1.746534 1.298224 1.092204 0.252914 1.241973 -0.114644 0.118634 1.005127 -0.195946 0.639640 0.754289 -0.065632 0.714364 1.300342 0.839106 1.256746 0.582262 1.885531 1.298010 0.384388 0.185574 1.168220 1.586291 1.242180 1.296083 0.391273 0.262871 0.811036 0.806565 0.431451 1.015342 1.630813 1.685662 -0.062763 0.311437 -0.322103 1.934808 -0.217239 0.478902 -0.218460 1.046362 0.603169 1.523851 1.302931 0.360083 0.678610 0.838126 1.626723 0.408089 0.150785 0.439104 0.575446 0.524826 1.662738 0.111387 1.179455 0.712858 0.531389 0.286195 0.456407 0.251572 1.398780 1.753711)
- 9.358003 #(0.000000 0.917048 -0.311785 0.642647 -0.205204 0.582314 1.898461 -0.024552 0.329898 0.268299 0.440843 1.448464 0.454542 1.076718 0.246847 0.901887 0.058472 0.588942 0.994326 1.407667 0.139444 1.534956 0.883357 0.149607 1.728963 1.298191 1.081074 0.258614 1.246139 -0.134330 0.116518 0.996053 -0.203773 0.669411 0.729357 -0.064647 0.727903 1.292762 0.857269 1.239178 0.572623 1.877916 1.287687 0.363508 0.193143 1.163490 1.580623 1.262144 1.280194 0.368818 0.264356 0.814367 0.818419 0.452394 1.027814 1.642149 1.700744 -0.061795 0.332638 -0.322348 1.925783 -0.196360 0.476767 -0.196630 1.068496 0.593809 1.511793 1.282405 0.352112 0.686244 0.854093 1.649890 0.426684 0.174878 0.456513 0.587219 0.512937 1.667484 0.114975 1.176889 0.725815 0.528007 0.301048 0.451654 0.256907 1.393249 1.756875)
+ ;; pp:start point was (pp.scm, make-pp.scm): pi+pi/87 and -pi/2
+ 9.201148 (fv 0.000000 0.606264 1.286641 1.633640 0.300135 0.826873 1.570361 0.039518 0.674212 1.390759 0.031099 0.782113 1.606099 0.456663 1.310938 -0.012755 1.011947 1.962275 1.031324 1.924212 0.700369 1.463259 0.449090 1.418882 0.516579 1.837916 1.056960 -0.026846 1.090144 0.187208 1.379580 0.694876 0.055771 0.972409 0.040906 1.575865 1.149936 0.410530 1.850809 1.237404 0.345035 1.553764 1.235369 0.825540 0.101389 1.583999 1.336472 0.955112 0.350910 -0.239863 1.473194 1.184033 1.132454 0.656789 0.797039 0.036147 0.315231 -0.255734 1.842540 1.250679 1.177721 1.108481 0.895012 1.358540 0.880609 0.969577 0.756153 1.004262 0.902032 1.003387 1.132762 1.561102 1.534103 1.804297 0.070209 -0.024117 0.069086 0.402650 0.873594 1.402800 1.716632 1.930312 0.453843 0.755753 1.442497 1.742394 -0.135628)
)
;;; 88 all -------------------------------------------------------------------------------- ; 9.3808
-#(88 12.085149765015 #(0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1)
- 11.991882324219 #(0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 1 1)
- 11.638312339783 #(0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1)
+(vector 88 11.638312339783 (fv 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1)
- 9.343418 #(0.000000 0.887956 0.464501 1.614594 0.821686 1.646992 0.218953 0.315322 0.393870 1.258337 0.882283 1.623858 1.371480 1.451799 1.795352 1.473073 0.066558 0.792053 0.330041 0.639625 0.087093 1.085211 0.335362 0.037139 0.466568 0.202117 0.540176 1.537429 -0.275703 1.371998 0.261945 0.228292 1.408142 0.979440 0.714584 0.468533 0.499211 1.311752 -0.019339 0.340922 0.847649 0.796658 -0.077415 0.538977 1.598118 0.707017 0.579011 1.626748 0.816834 1.484080 1.172195 0.087689 0.456222 -0.173522 1.174790 -0.282013 0.417678 1.200295 1.296580 1.008708 0.959490 -0.000634 1.193366 1.769344 1.744912 1.196249 1.237925 1.115575 1.126390 1.012621 0.225580 0.019679 0.930376 0.756561 -0.279021 0.561791 0.178161 0.502566 1.250521 0.532978 1.116478 1.115218 0.522197 0.528407 1.670569 1.592717 0.540350 1.278411)
+ 9.316523 (fv 0.000000 0.878486 0.456733 1.616494 0.833842 1.630288 0.213084 0.318066 0.387075 1.258199 0.888074 1.626323 1.385324 1.449641 1.788877 1.459694 0.074476 0.796586 0.333918 0.652336 0.086019 1.093159 0.327760 0.026729 0.468210 0.200167 0.537074 1.539924 -0.274885 1.353211 0.267108 0.236471 1.407050 0.990605 0.724714 0.464124 0.495860 1.314621 -0.030616 0.350065 0.839694 0.794947 -0.082046 0.540462 1.600245 0.715450 0.591095 1.608103 0.808561 1.476715 1.175725 0.089220 0.447550 -0.172825 1.173712 -0.287102 0.416439 1.195370 1.285929 1.007325 0.957271 -0.013128 1.194681 1.765216 1.741310 1.202198 1.235154 1.112410 1.116838 1.017962 0.227564 0.013993 0.930616 0.757675 -0.297628 0.560900 0.173387 0.493968 1.241443 0.533916 1.114281 1.119507 0.538020 0.529723 1.672789 1.594826 0.538626 1.278733)
+
+ ;; 87 + 1 (pp)
+ 9.255901 #(0.000000 0.704719 1.188893 1.675767 0.096018 0.845936 1.487824 0.078995 0.667889 1.297691 -0.023647 0.780968 1.603472 0.340759 1.204870 0.026757 1.150149 0.124316 1.065077 1.884618 0.609326 1.416953 0.372499 1.356073 0.453572 1.767703 1.001278 -0.238843 0.931840 0.205018 1.420053 0.675690 0.112242 1.052571 0.089462 1.485924 1.236180 0.407150 1.816803 1.284565 0.400450 1.410505 1.095373 0.831937 0.217112 1.631168 1.291427 1.030080 0.299217 -0.282356 1.506750 1.204044 1.185604 0.656589 0.898458 0.004864 0.154258 -0.340896 1.825973 1.369257 1.104084 0.921755 0.900302 1.295845 0.824555 1.094591 0.785023 1.079180 0.885480 0.926136 0.942138 1.655789 1.435560 1.812571 -0.053178 0.016700 0.075866 0.223760 0.836926 1.243772 1.565476 1.835913 0.515899 0.597634 1.438547 1.710832 -0.154189 0.323632)
)
;;; 89 all -------------------------------------------------------------------------------- ; 9.4340
-#(89 12.644 #(0 0 0 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 1)
- 12.148494905477 #(0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1)
+(vector 89 12.148494905477 (fv 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1)
+
+ 9.351480 (fv 0.000000 0.115345 0.952969 1.130622 0.084058 0.254252 0.443202 0.470071 0.932794 0.466331 0.591979 0.457396 1.528107 0.715257 1.847307 0.403253 0.673874 1.456603 0.267262 0.304798 0.064020 -0.007350 0.259234 -0.287472 0.913317 0.595047 1.491194 0.951199 1.469407 0.524123 -0.304693 -0.076445 1.827209 1.059199 1.449793 1.495662 0.754984 0.852314 0.216817 0.724819 0.597427 1.273980 0.926620 0.643916 0.066061 0.625597 1.284699 0.657854 0.605911 1.653365 1.442076 1.033587 -0.542590 1.262635 1.257414 1.117301 0.126208 0.112501 1.272548 0.912632 0.005045 0.757226 0.049364 -0.033316 1.800311 -0.300949 0.310947 1.267820 0.529700 0.817110 -0.265053 1.152779 -0.048439 0.296709 1.270792 1.398568 -1.703554 0.050635 0.940556 0.440806 1.384526 0.885947 -0.609539 0.281434 0.391260 0.168064 1.027217 1.891400 0.923378)
- 9.377240 #(0.000000 0.117127 0.949044 1.129910 0.088260 0.253993 0.444879 0.470017 0.939322 0.468883 0.579224 0.454983 1.528592 0.712302 1.850624 0.404098 0.665586 1.456504 0.272261 0.315652 0.063846 -0.014660 0.256360 -0.287594 0.913083 0.592452 1.486133 0.949862 1.467206 0.517500 -0.301308 -0.076915 1.831040 1.061749 1.455274 1.504731 0.758268 0.843663 0.213603 0.735667 0.608438 1.277790 0.934937 0.642948 0.062326 0.624587 1.286858 0.659874 0.604667 1.657257 1.442036 1.034348 -0.543863 1.265261 1.261088 1.120390 0.118707 0.118065 1.275290 0.902222 0.006804 0.755258 0.060316 -0.032393 1.800020 -0.302532 0.302886 1.273672 0.520417 0.810925 -0.273302 1.153871 -0.057615 0.290835 1.269805 1.398723 -1.698380 0.051952 0.943857 0.440574 1.379377 0.874601 -0.614529 0.278919 0.401903 0.168674 1.026461 1.883039 0.931312)
+ ;; 90-1:
+ 9.353077 #(0.000000 0.101446 0.552891 0.728107 0.524893 0.145214 1.596053 1.301540 0.926397 0.496933 0.459068 0.452889 -0.240583 1.847402 1.625502 1.401709 1.344010 1.170760 1.113124 0.952056 0.990499 1.326791 1.137187 1.344890 1.398023 1.149659 1.097175 1.559308 1.708797 -0.021498 0.416394 0.386368 0.384056 0.606232 0.977603 1.375793 1.270354 1.302953 0.359489 0.616160 1.115795 1.441415 1.647690 0.643610 0.895244 0.975118 1.685984 -0.077953 0.815100 1.503675 0.336177 0.774857 1.287785 1.833629 0.348295 1.088177 0.209087 0.777608 -0.029670 0.123001 1.329891 0.059409 1.263588 0.016222 0.685238 1.233668 0.561348 1.497739 1.015119 0.057179 0.615014 1.898096 0.865835 1.905681 0.688463 -0.268308 1.169876 0.259887 1.566670 1.025132 -0.067077 1.290408 0.701373 0.247065 1.395004 1.347652 0.414191 -0.013443 1.694985)
+ 9.345721 #(0.000000 0.103486 0.551861 0.726996 0.523771 0.144646 1.597548 1.302819 0.925442 0.494761 0.457372 0.448545 -0.241478 1.847854 1.625226 1.401271 1.344622 1.169875 1.113623 0.952209 0.990633 1.328837 1.137936 1.343935 1.399193 1.149690 1.096126 1.561038 1.711408 -0.022261 0.415937 0.388160 0.384297 0.607557 0.979556 1.373917 1.270638 1.303704 0.361732 0.614655 1.116132 1.440007 1.647123 0.645566 0.896623 0.974182 1.687056 -0.077314 0.812365 1.506132 0.337144 0.772963 1.287030 1.834127 0.348950 1.088801 0.208217 0.776609 -0.031553 0.124342 1.329352 0.062088 1.264941 0.018704 0.686528 1.235155 0.563447 1.498951 1.015729 0.058587 0.616286 1.897192 0.867074 1.907854 0.688520 -0.265323 1.172547 0.258395 1.566059 1.027835 -0.069245 1.293131 0.701031 0.244435 1.397502 1.346741 0.412354 -0.014152 1.693363)
)
;;; 90 all -------------------------------------------------------------------------------- ; 9.4868
-#(90 12.524876494276 #(0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1)
- 12.364291918726 #(0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 1 0 0 0)
- 12.299262768523 #(0 0 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 0)
- 12.059710502625 #(0 0 1 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0)
+(vector 90 12.059710502625 (fv 0 0 1 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0)
+
+ 9.398614 (fv 0.000000 0.892706 1.062256 0.213835 0.203111 1.398668 1.054220 0.038528 1.142619 0.118583 0.457258 1.631677 1.573493 1.353053 0.245939 0.098142 1.245835 1.513894 0.025359 0.747716 0.843192 1.216875 0.015492 0.415459 0.312421 1.153905 1.780617 0.437612 -0.400304 -0.029367 1.378815 -0.215560 0.280582 1.233159 0.249478 0.201675 0.961263 0.048927 0.571980 0.265611 0.963409 1.336060 0.891681 1.142504 1.421083 1.162603 1.027272 0.851118 0.849549 0.034892 1.199036 0.308700 1.882141 0.734414 0.473371 1.758626 0.761172 0.952217 -0.108344 1.230664 0.088942 0.737287 0.280477 0.684695 1.865274 1.638095 0.534719 0.573717 0.414603 0.759210 0.580912 -0.293171 0.034364 1.872658 1.705405 0.725925 -0.286371 0.704217 0.268789 0.757724 0.268458 1.430890 1.325737 1.264595 0.335646 0.223092 0.572527 0.875084 0.723299 0.490792)
- 9.430825 #(0.000000 0.887147 1.059333 0.210193 0.192837 1.393255 1.059126 0.040450 1.141755 0.117009 0.461962 1.636798 1.576408 1.352281 0.249431 0.099206 1.250690 1.513915 0.029377 0.737164 0.840350 1.222613 0.015871 0.422524 0.325057 1.146714 1.805085 0.444404 -0.400766 -0.015312 1.382477 -0.225393 0.273687 1.224836 0.251381 0.204624 0.965182 0.041279 0.582894 0.262459 0.972538 1.331462 0.898815 1.132159 1.429308 1.168443 1.032206 0.857918 0.862333 0.030567 1.192033 0.312472 1.889122 0.720756 0.475238 1.750041 0.763397 0.940692 -0.110348 1.229783 0.087609 0.750091 0.296535 0.682143 1.859335 1.628262 0.545598 0.574985 0.416004 0.759908 0.584374 -0.299077 0.032320 1.862544 1.698593 0.733791 -0.277507 0.702854 0.271177 0.756758 0.274343 1.427248 1.341416 1.272169 0.335072 0.227522 0.565189 0.870507 0.731188 0.487922)
+ ;; 91-1
+ 9.369284 #(0.000000 0.030596 0.512977 0.726782 0.477829 0.081885 1.589694 1.322061 1.083902 0.559521 0.448753 0.385931 -0.189736 1.722513 1.513355 1.392162 1.333913 1.122941 1.145305 1.071310 1.267721 1.283537 1.282341 1.395603 1.460843 1.220013 1.214982 1.532704 1.680386 -0.041828 0.369697 0.425933 0.371638 0.589333 1.041407 1.225589 1.172832 1.376354 0.162279 0.498805 1.164883 1.416170 1.867958 0.505897 0.978762 1.054842 1.522372 -0.063766 0.952495 1.463756 0.521257 0.824505 1.179094 1.811681 0.447390 1.180931 0.235815 0.652944 -0.161883 -0.021774 1.283901 -0.087905 1.281512 -0.144202 0.579788 1.336977 0.409226 1.333107 0.963576 0.011530 0.529499 1.655761 0.578200 1.742908 0.613593 -0.239938 1.074047 0.302129 1.602392 0.926017 -0.218685 1.216630 0.428055 0.183727 1.506714 1.185120 0.296902 -0.071562 1.483831 0.585762)
)
;;; 91 all -------------------------------------------------------------------------------- ; 9.5394
-#(91 12.389336585999 #(0 1 1 0 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 0)
- 12.363633155823 #(0 1 1 0 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 0 0 0 0 0 1 1 1 0)
- 12.335505485535 #(0 1 1 0 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0 1 1 1 0)
- 12.130150794983 #(0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0)
+(vector 91 12.130150794983 (fv 0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0)
- 9.495836 #(0.000000 0.441791 1.519625 1.678533 0.698644 1.379407 1.716159 1.212833 0.624870 0.944524 0.786063 1.779235 0.918263 1.083258 0.500740 1.164556 1.202749 0.317985 0.104298 1.690336 1.770291 0.110918 0.404236 1.503421 -0.049567 0.633263 0.477544 0.630334 1.515728 0.374445 1.835228 -0.016108 1.625476 1.900064 -0.085919 -0.016688 1.592935 0.343260 0.361588 0.157515 0.522945 1.673248 1.385224 0.544454 1.166566 0.117145 0.910388 -0.129833 1.115828 0.404456 1.645151 0.603069 0.902744 1.685450 0.317593 0.351578 -0.102619 1.716925 -0.233621 0.917112 1.707251 0.320096 0.190895 0.294691 1.008989 0.986863 1.434812 1.454994 0.491949 1.883326 0.713400 1.064425 1.011927 0.494393 1.107987 1.138086 1.722266 -0.000121 0.188758 1.239673 0.378287 -0.178132 1.448800 0.143214 1.419844 1.012538 0.928858 0.104889 1.668494 -0.015493 0.846775)
+ 9.460641 (fv 0.000000 0.436117 1.518395 1.686873 0.685584 1.390220 1.721023 1.218901 0.617875 0.942031 0.798753 1.787198 0.914695 1.067725 0.500698 1.164934 1.198775 0.318349 0.110243 1.683123 1.771564 0.104141 0.404057 1.512291 -0.053002 0.635555 0.485286 0.639133 1.522433 0.362468 1.841483 -0.018649 1.636664 1.891231 -0.092223 0.000560 1.591693 0.345850 0.362361 0.150153 0.525106 1.675920 1.376159 0.544954 1.155066 0.115196 0.924275 -0.119311 1.123186 0.422131 1.628623 0.610317 0.891460 1.679635 0.315850 0.345138 -0.095637 1.712298 -0.241584 0.926203 1.708802 0.312769 0.179387 0.288518 0.999840 0.990421 1.415220 1.453610 0.512219 1.890115 0.694941 1.068928 1.023842 0.497685 1.095073 1.132736 1.716879 -0.012368 0.180422 1.245447 0.380145 -0.172552 1.441547 0.152524 1.430740 1.014319 0.944154 0.113921 1.674916 -0.025585 0.846123)
+
+ ;; 92-1
+ 9.406571 #(0.000000 0.070183 0.558945 0.616954 0.488264 0.097581 1.643944 1.396224 1.158953 0.725014 0.517196 0.327654 -0.169876 1.614114 1.687774 1.412838 1.174539 1.259505 1.130798 1.052361 1.015956 1.267208 1.254231 1.379495 1.394559 1.223329 1.348807 1.448672 1.402107 -0.114780 0.204211 0.407141 0.213819 0.557195 0.878563 1.293773 1.227658 1.440547 0.218508 0.668102 0.992197 1.450344 1.592835 0.514105 0.745631 1.232389 1.450929 -0.020833 0.958476 1.514641 0.316511 0.755172 1.221264 1.755846 0.507669 1.139584 0.110724 0.749907 0.055238 0.050342 1.322976 0.038212 1.303755 -0.169105 0.463456 1.427795 0.697605 1.381025 0.968559 0.022635 0.695622 1.792840 0.529902 1.903317 0.747931 -0.193306 0.982955 0.298689 1.702098 1.077145 -0.265151 1.140052 0.371003 -0.055705 1.235675 1.006638 0.294853 1.755510 1.459678 0.647624 -0.081756)
)
;;; 92 all -------------------------------------------------------------------------------- ; 9.5917
-#(92 12.627931418696 #(0 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1)
- 12.009957507951 #(0 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 1)
+(vector 92 12.009957507951 (fv 0 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 1)
+
+ 9.517966 (fv 0.000000 0.086823 0.747623 -0.085371 0.122456 -0.230268 0.119188 1.361402 1.167782 0.037384 1.047768 0.553092 0.649815 1.008382 0.794506 0.305054 1.023759 0.770450 1.886190 0.685208 0.379196 0.684576 0.589903 0.070635 1.842447 1.673609 -0.393612 0.098157 1.794112 0.846616 0.025307 0.910127 0.590170 1.608490 0.410052 1.692507 -0.369713 0.406231 1.469315 1.471065 0.951373 1.130104 0.531009 1.015991 1.488443 0.280351 0.460606 1.244663 1.053735 0.254819 0.300775 0.994290 1.059430 1.061070 1.049296 1.008564 -0.162768 1.637847 1.291833 1.037154 0.364051 0.144913 0.533100 1.075664 1.325409 -0.343880 0.931404 1.449787 0.745214 0.874779 -0.406152 1.757226 1.474675 0.453343 1.845066 0.544094 1.158828 0.100488 1.840683 0.221106 0.924537 1.893930 0.736114 1.402591 0.613840 0.057492 0.409601 -0.093628 1.271558 0.626825 0.949050 -0.217069)
- 9.548159 #(0.000000 0.081756 0.746478 -0.077855 0.112648 -0.236882 0.122638 1.380290 1.173041 0.032925 1.039859 0.531923 0.640368 1.016406 0.796308 0.311356 1.036421 0.767750 1.883608 0.694342 0.375048 0.680687 0.588047 0.058300 1.829200 1.675476 -0.374251 0.104586 1.781030 0.845782 0.020765 0.917996 0.596724 1.612629 0.404421 1.694670 -0.360174 0.407008 1.474088 1.470214 0.947619 1.130595 0.528888 1.024241 1.474718 0.266295 0.462167 1.230216 1.042356 0.263360 0.302248 0.989158 1.047294 1.069093 1.066952 1.009038 -0.160325 1.639370 1.272890 1.038430 0.362262 0.144592 0.530404 1.062066 1.330335 -0.326553 0.943917 1.438633 0.754581 0.885015 -0.400844 1.753567 1.472087 0.458697 1.850334 0.538599 1.162368 0.094428 1.833743 0.225204 0.918506 1.874585 0.737310 1.404303 0.626714 0.051385 0.397404 -0.099262 1.272288 0.620318 0.962801 -0.214783)
+ ;; 93-1
+ 9.419885 (fv 0.000000 0.069529 0.633901 0.633608 0.570434 0.157518 1.715794 1.321616 1.084449 0.794466 0.425008 0.283514 -0.131990 1.646881 1.533838 1.442714 1.177599 1.239726 1.207883 1.015321 0.976921 1.262383 1.278818 1.276322 1.338824 1.226865 1.318320 1.361295 1.375488 -0.072989 0.149612 0.367026 0.181636 0.504697 0.851522 1.286853 1.425655 1.395838 0.306909 0.627046 0.973004 1.385102 1.455309 0.477354 0.684776 1.138509 1.548279 -0.072451 0.798558 1.262715 0.056514 0.791921 1.056616 1.695546 0.434938 1.116470 0.025573 0.789168 -0.006184 0.138467 1.335319 0.002519 1.259750 -0.081984 0.549375 1.443475 0.683161 1.338585 0.966058 1.876977 0.624731 1.787187 0.503447 1.917935 0.840074 -0.187662 1.042424 0.183738 1.737882 1.038721 -0.194530 1.214452 0.488651 0.014114 1.273532 1.004556 0.303820 1.746128 1.409399 0.765865 0.191028 1.596552)
)
;;; 93 all -------------------------------------------------------------------------------- ; 9.6437
-#(93 12.624432854783 #(0 0 1 0 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1)
- 12.125471062226 #(0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1)
+(vector 93 12.125471062226 (fv 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1)
- 9.692724 #(0.000000 1.501897 1.738607 1.808087 -0.109505 0.480675 0.497985 -0.184090 -0.046956 1.292753 0.112861 1.003007 1.690293 0.946838 0.883677 1.353865 1.701949 0.884252 1.096043 1.400464 0.330304 0.522248 0.297699 0.657698 0.185424 0.422257 1.146197 0.118985 0.247124 -0.216031 0.504550 -0.043134 0.268354 1.170655 0.982285 0.516360 0.016367 1.846537 1.101931 0.562051 0.422173 1.023927 1.497464 1.833876 1.642751 1.374503 1.655502 1.143114 1.571689 -0.042304 0.803602 0.830731 1.587415 -0.165962 1.561227 -0.315632 1.410594 1.419905 0.213472 0.916160 0.159510 0.606727 0.281674 -0.357914 1.497237 1.483311 0.335425 1.533677 0.869052 -0.177109 1.420877 0.166996 0.662797 1.338081 0.523494 0.522956 1.506807 1.246205 1.805995 1.345029 0.147981 0.097546 1.232867 1.499215 1.194032 0.407402 1.812152 1.358269 0.387423 1.436746 0.666666 1.737983 0.510950)
+ 9.668780 (fv 0.000000 1.502492 1.735960 1.811396 -0.104957 0.482636 0.500559 -0.183071 -0.047836 1.299077 0.116243 0.998697 1.692766 0.951722 0.883989 1.357273 1.702880 0.882694 1.095034 1.397512 0.329332 0.527364 0.298917 0.655212 0.187816 0.424294 1.150209 0.114579 0.252718 -0.217705 0.508106 -0.043801 0.270810 1.167969 0.982839 0.517943 0.010809 1.845815 1.098777 0.567160 0.419087 1.030585 1.503183 1.837046 1.638737 1.381290 1.657079 1.137100 1.564675 -0.040237 0.809480 0.832346 1.587671 -0.164235 1.557353 -0.318789 1.412269 1.419735 0.213834 0.923183 0.158106 0.606199 0.283874 -0.361272 1.495430 1.475886 0.334771 1.534489 0.873427 -0.175602 1.422400 0.168157 0.667278 1.332909 0.520912 0.514379 1.506377 1.240021 1.795506 1.354822 0.149370 0.097693 1.231885 1.499794 1.191816 0.402471 1.807112 1.364329 0.383172 1.438070 0.658534 1.737005 0.518886)
+
+ ;; pp:
+ 9.412639 (fv 0.000000 0.102641 0.679230 0.798388 0.598526 0.445036 1.682481 1.416478 1.010866 0.838753 0.518866 0.185140 -0.260801 1.643327 1.645133 1.587871 1.510095 1.367190 1.252764 1.075109 0.997402 1.226792 1.097666 1.109286 1.266675 1.142806 1.396415 1.366757 1.323435 -0.151657 0.110933 0.254314 0.125232 0.426419 0.874355 1.227943 1.386454 1.437438 0.183960 0.673205 0.896736 1.317085 1.421345 0.557215 0.650544 0.979705 1.599286 -0.027664 0.967924 1.389243 -0.027060 0.800953 1.098758 1.686133 0.493843 1.257456 0.105617 0.800125 0.006765 0.139250 1.353019 -0.059007 1.198209 0.066444 0.431719 1.470864 0.547882 1.294688 0.757592 1.690943 0.714913 1.735237 0.542409 1.804533 0.779629 -0.296056 1.090213 0.178123 1.832019 1.000948 -0.131923 1.161644 0.360890 0.065736 1.232224 0.792139 0.176636 1.688866 1.432871 0.734257 0.042563 1.592538 0.764029)
)
;;; 94 all -------------------------------------------------------------------------------- ; 9.6954
-#(94 12.840441703796 #(0 1 0 1 1 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0)
- 12.510846178591 #(0 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0)
+(vector 94 12.510846178591 (fv 0 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0)
+
+ 9.614457 (fv 0.000000 0.354827 0.986082 0.678218 0.074619 1.069713 1.084979 -0.010872 1.376391 1.050934 0.019873 0.645649 0.930266 1.023286 -0.324271 0.129791 1.399266 0.790347 1.024795 0.364675 1.268057 0.467841 0.596106 0.634764 0.920301 0.577212 1.246648 0.805833 -0.021659 -0.091918 0.865047 0.408442 1.292571 1.382486 -0.396633 1.688655 0.645075 1.689205 0.543001 -0.020503 1.556121 1.527556 1.671083 1.274725 1.683665 1.385648 1.434218 0.579921 1.533529 0.946387 1.280342 1.067943 -0.140266 0.061709 0.145137 0.716787 0.346453 1.817745 0.110851 1.072741 1.054881 1.191219 0.552352 1.218769 1.077324 -0.052815 -0.201076 1.253349 1.375788 0.845621 0.366991 0.916267 0.628985 1.420824 1.381120 0.247768 0.913794 -0.038130 1.360273 -0.162096 1.251116 1.166185 0.322598 1.024569 1.763375 0.466730 1.066807 0.067495 0.545386 1.308131 1.358919 0.937638 0.693078 0.195493)
- 9.644282 #(0.000000 0.354341 0.984106 0.690688 0.074146 1.079889 1.089261 -0.010639 1.376534 1.051449 0.023877 0.642648 0.918190 1.016317 -0.313408 0.127609 1.402993 0.784198 1.028911 0.380805 1.268755 0.449128 0.596460 0.646240 0.906399 0.578044 1.246031 0.798735 -0.011352 -0.103833 0.875681 0.412566 1.300964 1.378784 -0.400623 1.691280 0.636796 1.700872 0.553799 -0.021222 1.544997 1.523407 1.669899 1.277091 1.661895 1.392089 1.436436 0.590842 1.521637 0.934251 1.285356 1.059857 -0.150827 0.078391 0.131692 0.714447 0.346939 1.816260 0.108620 1.078948 1.052367 1.185622 0.547768 1.223880 1.094859 -0.058809 -0.188403 1.236770 1.379562 0.840551 0.358495 0.923936 0.628862 1.400423 1.383942 0.235871 0.893647 -0.037097 1.359918 -0.162963 1.243497 1.168849 0.341691 1.023123 1.768214 0.457149 1.063795 0.077391 0.542133 1.307171 1.353492 0.936614 0.691443 0.190240)
+ ;; 93+1
+ 9.543681 #(0.000000 0.070784 0.635867 0.742637 0.475019 0.302813 1.825409 1.378229 1.077426 0.877718 0.610301 0.202771 -0.182277 1.673466 1.553357 1.494058 1.368050 1.336285 1.249015 1.094284 1.026782 1.245912 1.085605 1.018283 1.167850 1.013374 1.392524 1.418879 1.281568 -0.274841 -0.022454 0.129657 0.125509 0.504384 0.935744 1.276977 1.483975 1.477426 0.196761 0.675603 0.862408 1.192185 1.459380 0.549610 0.569998 1.001464 1.695499 0.066362 0.898853 1.281654 0.050116 0.806388 1.047653 1.730201 0.520253 1.351614 0.000078 1.010541 -0.167505 0.168460 1.307105 0.008313 1.198293 0.190292 0.394166 1.604739 0.575546 1.381303 0.832277 1.821709 0.813449 1.752392 0.618919 0.026374 0.880532 -0.283635 1.155422 0.216026 1.884068 1.144874 -0.171918 1.125849 0.302834 -0.082892 1.104687 0.762677 0.111766 1.593198 1.158618 0.738387 -0.017688 1.548369 0.670450 -0.209765)
)
;;; 95 all -------------------------------------------------------------------------------- ; 9.7468
-#(95 12.744465939438 #(0 0 1 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0)
- 12.706251144409 #(0 0 1 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0)
- 12.448801040649 #(0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0)
- 12.431831359863 #(0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
+(vector 95 12.431831359863 (fv 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
- 9.619300 #(0.000000 1.389444 1.173060 1.121241 0.856889 0.607772 0.055596 1.196286 0.869219 0.059329 1.680941 -0.012386 0.088876 1.773566 1.311822 1.614776 0.851112 -0.101869 0.921546 1.157898 0.456962 1.630497 1.174167 0.784625 0.403453 1.472735 1.250988 0.700975 1.782612 1.672898 1.624075 1.348756 1.055557 0.715342 1.786738 0.230645 0.627749 1.044445 1.446583 1.192541 0.999864 0.282615 0.715822 0.833684 0.896346 1.561785 0.396074 0.603621 1.220508 0.100084 0.666624 -0.073123 0.120627 0.251153 0.752966 1.690584 0.811108 -0.422808 1.072771 1.140470 0.015411 1.748552 0.020463 0.360988 1.204934 0.090777 0.591403 1.136021 0.839874 1.208884 0.837091 0.355678 0.989761 0.089908 1.785532 0.846361 1.321708 1.215409 -0.120365 1.051531 0.191425 1.206634 0.887833 1.667268 1.114820 1.566489 -0.205687 1.609686 0.018688 1.359727 0.845343 1.005260 -0.409341 0.192488 1.774464)
+ 9.594917 (fv 0.000000 1.389542 1.176101 1.128189 0.857825 0.606938 0.053944 1.193702 0.869053 0.060247 1.681618 -0.018030 0.093189 1.777775 1.314304 1.617940 0.848617 -0.108633 0.918764 1.157666 0.455570 1.631612 1.168101 0.785976 0.402697 1.470789 1.252874 0.702336 1.782377 1.673658 1.631189 1.349352 1.050241 0.712255 1.786745 0.232201 0.625268 1.043139 1.455512 1.195110 0.998337 0.283110 0.709026 0.841439 0.900171 1.560899 0.398341 0.605576 1.226269 0.101415 0.662630 -0.080073 0.123777 0.243381 0.746050 1.688701 0.805710 -0.417799 1.076341 1.138430 0.020724 1.738280 0.026371 0.359523 1.207908 0.092412 0.589896 1.141872 0.833369 1.211938 0.834700 0.366724 0.985159 0.093930 1.781990 0.844009 1.324575 1.222996 -0.119995 1.044915 0.191275 1.202233 0.891410 1.663012 1.114750 1.562345 -0.205599 1.605273 0.019367 1.356810 0.858474 1.006151 -0.416772 0.195895 1.774084)
)
;;; 96 all -------------------------------------------------------------------------------- ; 9.7980
-#(96 12.828451411951 #(0 0 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1 0 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 0 1)
- 12.705632891559 #(0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1)
- 12.682573318481 #(0 1 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 1)
- 12.586637130548 #(0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1)
+(vector 96 12.586637130548 (fv 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1)
- 9.731791 #(0.000000 1.684917 0.450297 0.357553 0.041394 1.532196 1.128325 1.518442 0.057586 0.647179 0.742817 1.831537 0.016236 -0.236209 0.157204 -0.019672 0.120507 1.017719 1.435521 1.448244 1.515648 1.078681 0.631831 0.515567 -0.087572 1.446253 -0.252085 0.537354 0.699750 1.127482 0.394493 0.524997 0.104550 0.828495 1.793674 1.035545 1.112483 0.631839 0.772785 -0.504933 0.559306 0.697538 1.753669 1.744801 0.366795 1.452968 0.872815 1.135869 0.043233 1.474821 1.271929 0.758234 1.231188 -0.452051 1.081735 -0.255072 0.943400 1.689606 1.407405 -0.279534 0.676416 1.063793 -0.066506 0.096495 0.706568 -0.053808 0.861778 0.912016 0.015977 1.002617 -0.003652 1.434152 1.102813 0.570189 1.831294 1.154004 1.243947 1.150735 0.992728 -0.311790 0.158209 0.897745 0.913969 1.572839 1.061284 0.132256 1.352919 0.157611 -0.377645 0.262997 0.398375 0.770994 -0.050089 1.276275 1.025174 1.548034)
+ 9.698754 (fv 0.000000 1.686945 0.467972 0.353719 0.039839 1.529803 1.113587 1.518769 0.069518 0.641616 0.744046 1.828910 0.013471 -0.229934 0.181085 -0.011815 0.130449 1.033538 1.435542 1.445735 1.524439 1.088117 0.632800 0.518998 -0.093855 1.447748 -0.258898 0.540666 0.708408 1.141240 0.388952 0.533151 0.107615 0.843908 1.797589 1.037747 1.105446 0.651000 0.775586 -0.512743 0.563193 0.707947 1.740714 1.753866 0.373300 1.459832 0.879332 1.133261 0.035182 1.481640 1.284446 0.744828 1.229402 -0.449568 1.081113 -0.235470 0.939023 1.698241 1.413068 -0.279150 0.681300 1.084041 -0.075079 0.087600 0.709157 -0.062761 0.870661 0.903931 0.019006 1.008038 -0.009901 1.442216 1.097881 0.558710 1.835109 1.151033 1.232982 1.137424 0.991349 -0.312466 0.156001 0.908045 0.922926 1.582365 1.057816 0.119723 1.368068 0.167350 -0.363438 0.279779 0.391520 0.751632 -0.048111 1.271729 1.046123 1.547668)
+
+ ;; 95+1
+ 9.726779 #(0.000000 1.272536 1.234689 1.036804 0.806804 0.685514 -0.233507 1.195648 0.974626 -0.133690 1.612184 -0.250031 0.153834 1.639158 1.448966 1.429020 0.841318 0.036800 0.809280 1.124317 0.410517 1.790247 0.947605 0.878411 0.284331 1.437808 1.242148 0.609187 1.691642 1.608067 1.542734 1.433245 1.048694 0.695483 1.770228 0.049652 0.565924 1.008807 1.378374 1.235802 0.944856 0.275648 0.688876 0.690791 0.947538 1.724048 0.507279 0.344409 1.011255 0.053102 0.655524 0.015954 -0.000803 0.135128 0.906712 1.703603 0.898426 -0.371698 1.225250 0.634585 -0.033241 1.655363 -0.118205 0.384853 1.242318 0.157876 0.169651 1.065989 0.596048 1.102812 0.663038 0.195163 0.860121 -0.157778 1.681909 0.740009 1.139644 0.978398 -0.218097 0.770242 0.520081 1.060101 0.721838 1.327594 1.028501 1.403966 -0.169752 1.470700 0.038544 1.145229 0.628698 0.803002 -0.539861 0.036303 1.343341 -0.219240)
)
;;; 97 all -------------------------------------------------------------------------------- ; 9.8489
-#(97 13.438 #(0 0 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0)
- 12.872588157654 #(0 0 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
- 12.585 #(0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
+(vector 97 12.585 (fv 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
- 9.839814 #(0.000000 1.593370 0.915732 0.151544 1.277433 1.389483 1.514988 0.759280 0.808264 1.015121 0.628969 1.878610 1.225516 0.807628 -0.029109 1.501675 1.748176 -0.212815 -0.283342 -0.060605 0.241177 0.733364 1.685499 0.086529 1.594234 0.617379 1.159782 1.232742 1.447384 0.828803 0.848176 0.210565 1.370227 0.437959 0.370445 1.454682 0.207684 1.447907 1.133487 1.392051 0.911198 1.761124 0.070980 1.475536 1.266076 0.804860 -0.165586 -0.034529 0.037402 0.938705 0.458164 -0.450434 -0.008546 1.683324 0.936733 1.752178 1.292855 0.707416 0.034117 1.696091 1.939598 -0.153759 1.603759 0.780656 1.449054 1.075759 1.396408 0.022977 1.942295 0.443710 0.606095 0.872624 1.320544 0.504649 0.896125 1.619880 0.223974 1.372267 1.190161 0.660654 0.449339 0.798982 1.445433 0.391048 1.044618 0.185982 0.830966 0.174484 0.389234 0.561811 1.797039 0.567000 1.223881 0.837011 -0.109882 0.705002 1.250398)
+ 9.811290 (fv 0.000000 1.599348 0.923331 0.142353 1.275817 1.382624 1.510378 0.732924 0.806532 1.015499 0.620826 1.882699 1.212790 0.807183 -0.023255 1.516389 1.732605 -0.201884 -0.277404 -0.055883 0.240940 0.731931 1.673522 0.086425 1.587574 0.602365 1.160815 1.229056 1.456929 0.833735 0.852700 0.201630 1.357627 0.458255 0.370269 1.445354 0.215612 1.445930 1.140683 1.395090 0.893305 1.761792 0.069580 1.477150 1.261329 0.799176 -0.171506 -0.046281 0.037534 0.945505 0.457403 -0.446133 -0.016772 1.686139 0.929506 1.761163 1.283945 0.714187 0.030687 1.699690 1.935312 -0.149630 1.586492 0.783961 1.445990 1.058255 1.383027 0.027818 1.949317 0.450708 0.615659 0.863171 1.311974 0.506328 0.888408 1.633309 0.234089 1.362300 1.207491 0.660429 0.454914 0.801172 1.438508 0.392994 1.045451 0.178268 0.808166 0.169353 0.379391 0.545139 1.796419 0.579129 1.221213 0.829753 -0.091400 0.706540 1.245414)
+
+ ;; pp:
+ 9.860243 (fv 0.000000 0.680977 0.966253 1.634215 0.365093 0.771173 1.259550 0.007495 0.693755 1.428280 0.352398 1.032784 1.549276 0.384182 1.088250 1.711305 0.715748 1.441436 0.402491 1.285065 0.056701 0.943326 1.812606 1.043581 -0.072780 0.808810 1.940683 1.225707 -0.029466 1.139541 0.383446 1.652614 0.799608 1.845091 0.834727 0.161218 1.415263 0.601512 1.879909 1.404443 0.587018 1.806810 1.169986 0.643827 -0.082912 1.345651 0.782502 0.239840 1.583476 1.376880 0.682406 0.262024 1.847899 1.521309 1.138292 0.467250 0.281908 -0.070976 1.718683 1.523340 1.285749 0.765922 0.681731 0.268165 0.290564 0.046020 0.082000 1.791305 1.766394 1.373062 1.769852 1.419717 1.707739 1.313906 1.401690 1.527792 1.718640 1.280023 1.582817 1.850590 0.103668 0.041251 0.363022 0.586729 0.741602 0.886403 0.989519 1.522393 1.709847 0.193187 0.406948 0.736802 1.329603 1.619101 -0.034816 0.612167 1.088037)
+
+ ;; 98-1
+ 9.733625 #(0.000000 -0.316389 0.763514 1.085136 -0.007054 1.613164 0.368355 0.497362 0.266819 0.792626 1.605095 0.379462 0.795808 0.617439 0.340832 1.408797 0.884588 0.777692 -0.061819 1.329857 1.611199 0.024913 1.778069 1.061965 1.317076 1.286538 -0.063928 0.439816 1.190286 1.720423 -0.281159 0.284236 1.261293 1.715607 1.258044 1.027201 0.992940 1.404704 0.918469 0.571955 0.670954 -0.578424 1.681045 1.759567 -0.365702 0.685884 0.480691 0.685380 0.103522 0.029224 1.512644 0.122325 0.600548 0.070986 0.493468 0.652824 -0.059890 1.290005 1.370566 0.135509 0.143591 -0.197126 0.478025 0.315521 0.839450 0.083388 0.553358 1.161959 0.770340 1.132488 0.641596 1.702281 0.277494 1.930557 0.772636 0.175945 1.352904 0.123527 1.448091 0.194310 0.330488 1.631688 1.302741 0.566332 1.521760 0.740046 0.257004 1.532435 0.681554 0.238673 0.612205 0.128510 1.851063 0.280067 1.237302 -0.034034 0.240185)
)
;;; 98 all -------------------------------------------------------------------------------- ; 9.8995
-#(98 13.163645755645 #(0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1)
- 13.161917686462 #(0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 1 0 1 1 1 1)
- 12.724907890996 #(0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1)
+(vector 98 12.724907890996 (fv 0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1)
- 9.799769 #(0.000000 -0.184390 0.672598 1.163838 -0.146643 1.670662 0.365124 0.494381 0.189890 0.715337 1.720138 0.379783 1.018039 0.545642 0.339735 1.540240 0.971296 0.937036 -0.109224 1.641631 1.644930 0.040639 1.858083 1.215593 1.297208 1.229104 0.028842 0.400190 1.200223 1.645391 -0.155781 0.270431 1.280534 1.669794 1.152202 0.908166 1.138750 1.470826 0.855686 0.445466 0.761051 -0.417698 1.879236 1.729042 -0.232011 0.761600 0.559402 0.613282 0.223257 -0.021220 1.526177 -0.045240 0.584021 0.027686 0.482662 0.554590 -0.036036 1.259012 1.345898 0.062087 0.283645 -0.241620 0.616704 0.496852 0.823044 -0.006741 0.585533 1.231872 0.841089 1.221919 0.681653 1.656349 0.297392 1.895052 0.728250 0.052042 1.539190 0.178328 1.453398 0.358964 0.120060 1.524269 1.185888 0.505789 1.414597 0.851132 0.006033 1.480677 0.608696 0.208825 0.550642 0.257955 1.780931 0.268397 1.156630 -0.081969 0.201933 1.209386)
+ 9.767029 (fv 0.000000 -0.188323 0.675144 1.162326 -0.152620 1.669640 0.370125 0.494628 0.190555 0.715197 1.719005 0.377693 1.013961 0.545798 0.345914 1.535759 0.968261 0.937780 -0.119329 1.630311 1.635898 0.029531 1.850111 1.208612 1.298337 1.226547 0.020306 0.388794 1.210462 1.649716 -0.158605 0.268380 1.285081 1.672163 1.145021 0.908520 1.140268 1.468740 0.844848 0.440912 0.760836 -0.415872 1.889804 1.724959 -0.229249 0.766901 0.564605 0.613211 0.221081 -0.012880 1.521722 -0.044019 0.593078 0.034669 0.491432 0.559669 -0.045684 1.255880 1.344088 0.070215 0.282883 -0.229690 0.625053 0.504422 0.811212 -0.012186 0.589513 1.241057 0.831526 1.215774 0.684110 1.651422 0.305036 1.891476 0.747710 0.040696 1.539490 0.154881 1.456564 0.357589 0.123799 1.523900 1.179657 0.504889 1.418226 0.850462 0.009923 1.481216 0.600938 0.216302 0.543002 0.255145 1.787452 0.279328 1.172852 -0.085076 0.199219 1.196556)
)
;;; 99 all -------------------------------------------------------------------------------- ; 9.9499
-#(99 13.236550650051 #(0 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1)
- 13.002375571256 #(0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0)
+(vector 99 13.002375571256 (fv 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0)
+
+ 9.856524 (fv 0.000000 0.532142 1.131528 0.051928 1.654946 0.271228 1.101349 1.560647 1.619023 1.108572 0.726033 0.727251 -0.132854 0.360041 0.670224 1.663602 -0.493942 -0.197685 1.604359 1.799803 1.040897 0.122580 0.382051 1.681979 0.430500 1.558581 0.044836 1.543992 1.439831 0.906809 1.334494 1.667502 1.130520 0.467062 1.310080 0.675817 0.797910 0.443927 1.274100 0.336343 0.146059 -0.192316 0.742563 0.471697 1.596436 -0.009686 1.651640 1.837904 0.406037 0.558091 -0.016989 1.479179 0.903735 1.116299 -0.060825 0.179513 -0.026846 1.811414 0.072416 -0.014783 0.060148 0.361427 1.207468 0.945662 0.068194 1.516887 0.004488 0.212016 0.737847 -0.343051 0.746533 0.527238 1.812564 0.462282 1.376985 0.882738 1.070840 1.718397 0.663551 0.922534 1.724192 -0.576637 1.416748 1.206588 0.385428 0.383601 1.504489 1.636715 0.253055 1.809058 0.862228 1.855156 1.029803 0.604391 1.515278 0.827373 1.237016 1.652558 1.330582)
- 9.886163 #(0.000000 0.534028 1.131020 0.052495 1.656857 0.270387 1.097408 1.562800 1.613922 1.111520 0.728287 0.733136 -0.129623 0.356680 0.665272 1.669297 -0.487755 -0.198528 1.606161 1.799402 1.040182 0.120586 0.388135 1.686096 0.426860 1.559339 0.047565 1.547461 1.445147 0.897409 1.324406 1.658025 1.131216 0.464464 1.314173 0.675097 0.799271 0.442671 1.273782 0.338498 0.153719 -0.189231 0.750597 0.469092 1.606718 -0.008563 1.648162 1.839887 0.398296 0.554558 -0.017526 1.478066 0.900700 1.115580 -0.053739 0.181849 -0.026811 1.808090 0.072099 -0.013848 0.067448 0.359051 1.205384 0.945833 0.071322 1.513843 0.008212 0.203403 0.734155 -0.337249 0.755660 0.539767 1.814276 0.454875 1.383171 0.871788 1.077978 1.708414 0.668726 0.917976 1.714338 -0.566837 1.421498 1.210508 0.386019 0.383058 1.495562 1.642194 0.246789 1.814718 0.864676 1.844814 1.032553 0.593758 1.519164 0.833585 1.243935 1.647224 1.331074)
+ ;; 100-1
+ 9.837088 #(0.000000 0.501632 0.934877 -0.406945 1.720666 0.060221 0.986624 1.296415 1.868188 0.930965 0.372307 0.709017 -0.252505 0.160880 0.812384 1.543611 -0.433820 -0.259337 1.687543 1.624404 0.816138 0.040401 0.111607 -0.236070 0.269290 1.314408 0.264913 1.524076 1.510591 0.672939 1.225301 1.486867 1.198432 0.684715 1.400436 0.809536 0.790904 0.226400 1.325157 0.378418 0.148020 -0.182631 0.691385 0.400855 1.875888 -0.034659 1.584706 0.098304 0.424031 0.680276 -0.260219 1.393931 1.457882 1.172138 0.294071 0.176446 -0.047801 -0.268365 -0.154114 0.172473 0.026218 0.381410 0.486670 0.694651 0.137283 1.339580 -0.408431 0.346779 0.297247 -0.681534 0.303276 0.742358 1.426415 0.456204 1.180942 0.678579 1.815369 1.742844 0.288364 0.833505 1.638509 -0.777919 1.367299 1.067232 -0.002137 0.375276 1.602540 1.654913 0.141825 1.294416 0.790392 1.752947 1.096531 0.330167 1.510639 0.495286 1.348117 1.506107 1.279426)
+ 9.827383 #(0.000000 0.489851 0.987809 -0.394189 1.760605 0.036969 0.958351 1.266375 1.844806 0.928905 0.347370 0.708814 -0.213250 0.135838 0.840288 1.524164 -0.453078 -0.222429 1.664862 1.650792 0.843217 0.096982 0.106278 -0.254905 0.311964 1.356301 0.208474 1.484260 1.533307 0.693746 1.221284 1.494648 1.192154 0.704448 1.399404 0.773577 0.730819 0.230112 1.305343 0.384931 0.092126 -0.177018 0.678108 0.424573 1.876518 -0.110628 1.580149 0.105746 0.460598 0.667046 -0.301428 1.430147 1.462027 1.200592 0.294468 0.132684 -0.034510 -0.232945 -0.131872 0.235724 -0.003826 0.390220 0.478949 0.708773 0.158613 1.284193 -0.406418 0.372748 0.269091 -0.683069 0.298317 0.742905 1.467502 0.490499 1.200844 0.658586 1.777690 1.768714 0.250192 0.808599 1.653844 -0.705600 1.331238 1.087732 0.038158 0.351212 1.574369 1.702783 0.145504 1.240857 0.779939 1.689313 1.071204 0.299434 1.500921 0.518280 1.343637 1.492826 1.331082)
)
;;; 100 all -------------------------------------------------------------------------------- ; 10
-#(100 13.230233676417 #(0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 1 1 1 1 1 0 1 0)
- 12.998435541498 #(0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0)
+(vector 100 12.998435541498 (fv 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0)
+
+ 9.934540 (fv 0.000000 -0.003002 1.124858 1.923310 1.313585 0.903273 0.269057 1.550768 -0.053877 1.309350 0.259003 0.111356 1.649851 -0.475532 0.829676 0.358899 1.751244 0.579333 0.816025 0.729724 0.670859 0.992375 1.547721 -0.006147 1.191599 -0.084864 -0.001041 0.113001 0.580223 -0.405864 1.746923 1.268810 1.705215 1.056469 -0.197189 1.293674 0.934396 0.701720 0.582761 1.455750 1.232104 0.066182 1.464245 1.672004 0.239530 1.711330 -0.092878 0.399845 1.787310 0.046607 0.724822 1.735381 1.288901 0.460956 0.591963 0.996187 1.917259 0.311027 0.319804 1.898631 1.336795 0.632408 0.203462 1.031863 1.346167 0.931351 0.938341 -0.021240 0.003608 0.259606 1.507194 1.470684 0.324860 1.386425 0.298636 1.353945 1.922770 1.226486 0.467967 1.127400 0.946778 1.636808 0.285401 1.555027 1.572734 1.271086 1.042408 1.022431 1.651957 1.039348 0.338431 0.852870 0.945331 1.308135 1.631151 1.286426 0.091020 0.620928 0.894381 1.712980)
- 9.965015 #(0.000000 -0.001001 1.131637 1.929251 1.310147 0.901375 0.274409 1.553766 -0.054469 1.308368 0.253744 0.119758 1.655789 -0.475471 0.832861 0.369334 1.741462 0.570657 0.827754 0.732785 0.670436 0.989991 1.549166 -0.008118 1.186175 -0.087787 0.000762 0.102877 0.576666 -0.413854 1.751274 1.266791 1.702998 1.052402 -0.197055 1.283493 0.939179 0.706423 0.572940 1.462562 1.232847 0.074421 1.468899 1.657923 0.230397 1.707858 -0.096662 0.396414 1.783782 0.045851 0.719087 1.745826 1.294185 0.468472 0.591451 0.994484 1.907677 0.303016 0.318446 1.900847 1.334868 0.633142 0.207110 1.036681 1.354882 0.937713 0.942003 -0.021455 0.012370 0.262248 1.506798 1.472825 0.316341 1.377459 0.298776 1.345976 1.924758 1.234745 0.460488 1.125057 0.941887 1.624730 0.280441 1.553785 1.581918 1.271952 1.060691 1.019423 1.652817 1.030928 0.343246 0.842546 0.943999 1.301808 1.635755 1.288147 0.094535 0.617867 0.889231 1.702315)
+ ;; 99+1
+ 9.840430 #(0.000000 0.622605 0.940347 -0.023879 1.823374 0.046101 0.987386 1.386868 1.714786 1.047746 0.546094 0.770951 -0.265661 0.292412 0.888118 1.675189 -0.427745 -0.167443 1.762203 1.576180 0.923298 0.110300 0.331275 1.952651 0.241655 1.589880 0.276846 1.519665 1.333705 0.834984 1.249804 1.700983 1.188281 0.627881 1.352135 0.781883 0.873102 0.286686 1.236704 0.305170 0.118608 -0.061299 0.746712 0.436256 1.850021 0.025967 1.523851 0.111789 0.590538 0.644667 -0.043430 1.449342 1.285442 1.251443 0.387240 0.168668 -0.008131 -0.077897 -0.090554 0.128941 0.292252 0.590066 0.910912 0.845002 0.114157 1.267409 -0.143231 0.405284 0.467262 -0.510143 0.597548 0.663042 1.615835 0.378343 1.456219 0.634771 1.512841 1.710315 0.498665 0.804929 1.545845 -0.422582 1.525481 1.254165 0.184553 0.563406 1.423281 1.785321 0.228158 1.573508 0.775481 1.683423 1.226447 0.381675 1.467512 0.862051 1.538318 1.641940 1.350297 0.135931)
+
+ 9.835590 #(0.000000 0.570539 0.883467 -0.014746 1.809284 0.037164 0.942356 1.400420 1.689848 1.054845 0.548531 0.724602 -0.281675 0.241599 0.863477 1.691280 -0.386312 -0.167207 1.712242 1.554897 0.916947 0.154344 0.337144 -0.027896 0.191502 1.562234 0.293369 1.468239 1.368021 0.858183 1.215102 1.710412 1.168343 0.641872 1.384374 0.758703 0.847326 0.232955 1.203009 0.285135 0.164856 0.006319 0.731916 0.364606 1.825894 0.043345 1.457606 0.099304 0.693634 0.599315 -0.080515 1.358403 1.276512 1.306804 0.350411 0.153823 -0.066078 -0.056199 -0.130700 0.138204 0.313702 0.671650 0.858922 0.893029 0.081041 1.207722 -0.186661 0.401736 0.459231 -0.571478 0.607326 0.634928 1.590455 0.322847 1.466431 0.635387 1.523516 1.640986 0.518971 0.735455 1.517620 -0.440561 1.538277 1.209947 0.169421 0.568757 1.501995 1.704851 0.248785 1.539090 0.803108 1.622622 1.319362 0.357166 1.483707 0.858733 1.549787 1.667959 1.355314 0.166782)
+ 9.828147 #(0.000000 0.606381 0.917097 -0.052963 1.840850 0.076195 1.000382 1.379573 1.713959 1.056049 0.567183 0.755185 -0.243029 0.240141 0.901208 1.696896 -0.401067 -0.172213 1.702278 1.572589 0.995369 0.092107 0.339155 -0.047255 0.209942 1.548195 0.250627 1.493833 1.397582 0.850788 1.234138 1.694866 1.205737 0.609514 1.413541 0.774375 0.843373 0.256747 1.182652 0.287452 0.151651 -0.040175 0.718613 0.370108 1.797287 0.037564 1.483372 0.063366 0.673221 0.647681 -0.130882 1.410330 1.289134 1.259368 0.378589 0.179096 -0.077706 -0.126123 -0.197835 0.087734 0.222460 0.660561 0.798643 0.833272 0.064575 1.260850 -0.205610 0.363184 0.404543 -0.579680 0.559469 0.652793 1.526709 0.333879 1.432283 0.642498 1.543163 1.637538 0.499172 0.795803 1.495177 -0.493071 1.544279 1.224387 0.125780 0.527014 1.451448 1.716932 0.232752 1.503302 0.799684 1.669661 1.257116 0.363202 1.442143 0.833946 1.525977 1.616490 1.388269 0.088027)
)
;;; 101 all -------------------------------------------------------------------------------- ; 10.0499
-#(101 14.018204689026 #(0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0)
- 13.645306283587 #(0 0 1 0 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 0 1 0 0)
- 13.268 #(0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0)
- 13.219774246216 #(0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0)
+(vector 101 13.219774246216 (fv 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0)
+
+ ;; pp.scm:
+ 9.969423 (fv 0.000000 0.594013 1.021081 1.737097 -0.040619 0.752674 1.481517 0.041655 0.616216 1.273976 -0.239494 0.706555 1.350693 0.121717 0.873486 1.615554 0.502899 0.859104 0.100209 1.240389 0.001564 0.940100 -0.110501 0.399212 1.639677 0.823186 1.849867 0.970964 1.815596 0.977295 1.876945 1.029064 0.250663 1.106062 0.440754 1.692440 0.937531 0.143047 1.343876 0.363444 1.897361 0.954251 0.489534 1.687124 1.352147 0.540407 -0.261830 1.349441 0.704373 0.447495 1.734922 1.090380 0.653989 0.307022 1.449780 1.794904 0.808626 0.497093 0.423383 -0.280469 1.640122 1.217125 1.143712 0.677390 0.472908 0.243924 0.123084 -0.178887 1.588534 1.317289 1.403860 1.454850 1.459048 1.165832 1.237401 1.000847 1.421104 1.051039 1.364625 1.447050 1.541757 1.176845 1.530906 1.723380 1.795645 0.095341 0.481918 0.307978 0.454615 1.009308 0.963604 1.200422 1.757436 -0.015019 0.420112 1.020994 1.127410 1.866034 -0.291409 0.497289 1.096855)
- 10.090196 #(0.000000 1.446073 0.304766 -0.049401 1.597712 1.543271 1.096383 0.426840 0.360422 0.104186 -0.329992 0.645347 1.904500 0.774155 0.734279 -0.096115 1.698196 0.037441 1.607885 -0.502865 0.668930 1.450585 0.838605 0.205515 0.372150 1.588108 0.778560 1.308422 0.656316 0.172860 0.933035 1.420615 0.667085 0.842596 0.845936 0.541591 1.583020 1.175426 -0.091383 -0.034489 0.125112 1.688584 0.708679 0.048520 1.552461 0.795897 1.532853 0.388378 0.617086 -0.308763 0.519407 0.497175 0.851213 1.582055 1.853071 1.151780 1.192531 0.191906 -0.344743 1.535367 1.103518 0.104793 1.047992 1.550939 0.501512 1.744268 1.155427 0.638222 0.104840 0.743148 1.693799 1.854071 1.886357 1.345718 1.612616 1.344392 1.502233 0.460781 0.814350 1.229293 0.652160 1.284745 1.454081 1.043069 1.485420 1.036144 1.174654 1.310843 -0.006848 1.271684 0.021601 0.161674 0.529782 1.014144 1.138065 1.519552 1.592947 0.366337 0.795376 1.706164 -0.107960)
+ ;; 100+1
+ 9.935434 #(0.000000 0.608940 0.851264 -0.183247 1.727138 0.122260 0.917387 1.478656 1.680087 0.974509 0.439323 0.791848 -0.400157 0.270939 0.826559 1.771349 -0.433691 -0.112515 1.672261 1.661638 0.947155 -0.005681 0.389466 0.024556 0.225657 1.489635 0.270053 1.524879 1.478658 0.920158 1.189636 1.632789 1.150797 0.730326 1.420509 0.804787 0.804256 0.161800 1.160606 0.404414 0.173309 -0.015766 0.808661 0.387616 1.832938 0.006849 1.436327 0.251026 0.730578 0.634439 -0.102483 1.314743 1.381684 1.164318 0.424834 0.251180 -0.031006 -0.152152 -0.160917 -0.051668 0.286561 0.725355 0.786811 0.879068 0.251667 1.304955 -0.186646 0.532400 0.492416 -0.418753 0.613717 0.827376 1.513960 0.266304 1.474733 0.648266 1.615446 1.681220 0.455322 0.845513 1.730307 -0.669948 1.389624 1.537351 0.147023 0.449375 1.548892 1.696954 0.063719 1.612335 0.578406 1.747879 1.363473 0.348630 1.578073 0.726784 1.512834 1.528359 1.464039 0.047404 0.063700)
)
;;; 102 all -------------------------------------------------------------------------------- ; 10.0995
-#(102 13.521512151222 #(0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 0 1 1 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 0)
- 13.497511863708 #(0 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1)
- 13.300039088203 #(0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 0)
- 13.194128990173 #(0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 0)
+(vector 102 13.194128990173 (fv 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 0)
- 10.106394 #(0.000000 0.096014 0.512829 0.418318 0.752080 0.990986 -0.193027 0.035466 0.058769 1.577086 1.356965 1.322626 0.791191 0.752768 0.757924 0.268264 1.679125 0.408899 0.550462 -0.536261 0.961122 1.339422 1.616291 0.509427 1.908176 1.869887 0.939963 0.221381 0.540137 1.351885 1.742970 0.603035 1.549080 1.131051 0.775747 -0.236877 0.056760 1.824714 0.659991 -0.105184 1.261636 0.559403 0.212248 0.593404 0.460488 0.573890 1.058141 1.791385 0.523534 0.092766 0.227187 0.356137 1.883693 0.036566 0.936932 0.979707 1.947894 1.455669 0.943339 1.066750 0.642463 0.331923 0.143476 1.623500 0.673766 -0.254385 1.186301 1.957985 0.217212 0.065676 0.136268 0.324194 0.843091 0.501508 0.120928 0.684836 1.983842 0.663465 0.229491 1.343918 0.127233 0.707041 -0.415140 0.917064 1.409612 0.740990 1.665236 1.832174 -0.407369 0.350300 1.051154 -0.367569 0.122005 1.006735 1.055549 1.223498 0.362901 1.014887 1.429184 1.021373 0.769463 1.877125)
+ 10.088316 (fv 0.000000 0.095626 0.514266 0.420449 0.749499 0.992394 -0.193393 0.039052 0.057117 1.575374 1.352773 1.322452 0.794003 0.750383 0.756593 0.273089 1.675537 0.407815 0.550801 -0.538502 0.957909 1.336960 1.614983 0.508708 1.910222 1.874209 0.940387 0.222605 0.538045 1.356000 1.741919 0.598382 1.550605 1.131133 0.773140 -0.232481 0.055269 1.822145 0.659426 -0.100655 1.261624 0.557410 0.214081 0.588453 0.458097 0.577319 1.055339 1.792023 0.525700 0.097434 0.222735 0.356704 1.885210 0.037676 0.938171 0.984298 1.949046 1.455206 0.941409 1.068679 0.637889 0.330852 0.138031 1.619860 0.674126 -0.251106 1.183963 1.959835 0.213213 0.066073 0.132459 0.329261 0.847485 0.503486 0.122913 0.684764 1.979054 0.659531 0.231782 1.341252 0.124898 0.707447 -0.419234 0.913042 1.413830 0.741236 1.664719 1.833486 -0.410776 0.347702 1.045974 -0.368342 0.123701 1.012180 1.052039 1.226053 0.364036 1.015550 1.423284 1.022491 0.770674 1.877516)
+
+ ;; pp:
+ 10.025038 (fv 0.000000 0.605553 0.983049 1.667341 0.280594 0.813730 1.347579 0.067151 0.773566 1.170135 -0.000437 0.776577 1.339736 0.097477 0.851330 1.565309 0.392180 1.136191 -0.027326 0.943192 1.737718 0.813011 1.699444 0.599876 1.617440 0.776150 1.855177 0.961431 1.915827 0.882986 1.666203 0.596064 -0.104064 1.326950 0.560052 1.687567 0.667080 1.807593 1.118197 0.382149 1.651756 0.780071 0.152645 1.439416 0.767927 0.282152 1.693680 1.210781 0.759553 0.009785 1.134002 0.817236 0.333315 0.071267 1.596603 1.242164 0.957402 0.421360 -0.130961 1.394848 1.288611 0.865712 0.865151 0.398958 0.298422 -0.229411 1.889300 1.384404 1.672436 1.144983 1.294122 0.887806 0.874167 0.414036 1.058747 0.759420 0.922388 0.730377 0.900207 0.658168 0.691340 0.678324 0.551776 0.884009 1.344859 1.136367 1.415423 1.606731 1.827838 -0.020510 0.115669 0.332208 0.674134 1.028023 1.276947 1.696675 0.283199 0.564387 1.040113 1.365277 -0.292333 0.240887)
+
+ ;; 100+2
+ 10.007699 #(0.000000 0.699259 0.886512 -0.027935 1.951661 0.038656 0.782145 1.495632 1.825902 1.099844 0.475719 1.085184 -0.119480 0.345084 0.668327 1.655215 -0.443184 -0.222547 1.620205 1.430704 0.954443 0.138630 0.492113 0.019065 0.360482 1.757422 0.157902 1.550392 1.470306 0.988675 1.229630 1.690004 1.105453 0.565169 1.377624 0.841390 0.797989 0.376013 1.289740 0.395261 0.327620 0.083381 0.811382 0.494890 1.711550 0.206485 1.428555 0.082286 0.761093 0.622976 0.077603 1.537629 1.287362 1.146947 0.366315 0.298958 -0.023089 -0.278375 -0.121615 0.126454 0.360907 0.413437 0.811052 0.779664 0.308170 1.185116 -0.261499 0.353036 0.563752 -0.254871 0.625520 0.581032 1.603887 0.363229 1.270011 0.973174 1.589594 1.789366 0.533330 0.642520 1.506401 -0.681000 1.607118 1.357272 0.089328 0.463060 1.308512 1.901050 0.296922 1.480369 0.840448 1.959389 1.137022 0.183179 1.512091 0.749846 1.564567 1.660530 1.343282 0.039704 0.123170 -0.256915)
)
;;; 103 all -------------------------------------------------------------------------------- ; 10.1489
-#(103 13.720711052869 #(0 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 1 0 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1)
- 13.673172572795 #(0 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1)
- 13.435972213745 #(0 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 0 1)
+(vector 103 13.435972213745 (fv 0 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 0 1)
- 10.101830 #(0.000000 0.779040 0.792380 0.548437 0.301518 -0.171523 0.807616 1.543917 0.476378 0.825912 0.404353 0.771435 0.057761 0.070919 0.246610 -0.004829 1.571259 1.041971 1.680403 0.061019 0.053674 1.443153 0.915357 1.450377 1.296324 -0.068527 0.476005 1.135942 1.128184 1.081684 0.121830 0.575313 1.004419 0.923438 0.244395 0.278271 -0.411309 1.415291 0.932386 1.131682 0.493241 -0.666110 0.533379 0.941164 1.389944 0.414552 0.044599 1.193285 0.282946 1.517277 1.586127 1.157912 1.234345 1.236620 0.109808 1.094374 1.341412 0.602136 1.179605 0.289104 1.472916 0.644003 1.305292 1.741714 1.345972 0.728398 0.062621 0.907096 -0.185754 1.482985 0.772387 1.389110 -0.158693 1.516573 0.591644 0.026576 -0.103410 0.857342 0.286178 1.415733 0.955950 -0.309475 0.130683 0.219471 0.634902 0.595859 0.503528 0.656832 1.183993 1.318426 1.219229 1.224738 0.661949 1.590071 0.875785 1.463265 0.039917 0.132657 0.988083 0.230257 0.206084 0.976333 0.999523)
+ 10.072606 (fv 0.000000 0.775992 0.789071 0.551328 0.298530 -0.168268 0.810417 1.541024 0.478641 0.826848 0.407673 0.769783 0.052469 0.071330 0.252339 -0.003477 1.565238 1.042251 1.681717 0.063581 0.058867 1.442741 0.917343 1.448313 1.294486 -0.061724 0.478951 1.132882 1.128620 1.082449 0.123678 0.578486 1.003285 0.918654 0.241363 0.278868 -0.414912 1.418211 0.927244 1.134797 0.489863 -0.664481 0.529310 0.940119 1.393533 0.416277 0.044802 1.197865 0.283028 1.514978 1.590639 1.159829 1.236485 1.237279 0.109313 1.090962 1.341243 0.602478 1.179629 0.285726 1.482652 0.648833 1.308230 1.743441 1.346535 0.727031 0.061582 0.907076 -0.185896 1.479865 0.775766 1.389852 -0.161651 1.518832 0.594834 0.022777 -0.099476 0.851631 0.289254 1.413652 0.958286 -0.309988 0.125895 0.222920 0.633318 0.584266 0.503924 0.660246 1.182087 1.319466 1.213616 1.220516 0.662413 1.589230 0.875855 1.466144 0.036061 0.139801 0.986962 0.226038 0.202950 0.978447 0.999923)
+ 10.023934 #(0.000000 0.753951 0.779673 0.518393 0.316206 -0.218083 0.870139 1.504736 0.508331 0.809688 0.422025 0.773554 0.037541 0.011964 0.304036 -0.003721 1.596496 1.002801 1.709587 -0.064057 -0.025768 1.445605 0.900990 1.377053 1.302865 -0.071628 0.443866 1.140251 1.156707 1.055832 0.196967 0.522965 0.962707 0.915851 0.186338 0.326806 -0.419425 1.382164 0.924290 1.127505 0.506077 -0.717365 0.490628 0.923836 1.311668 0.417410 -0.037217 1.246121 0.223044 1.428120 1.587827 1.073312 1.216073 1.312023 0.011344 1.054200 1.272110 0.513048 1.232588 0.290590 1.484043 0.603027 1.228594 1.651785 1.264921 0.718395 0.081981 0.874691 -0.108206 1.415361 0.782165 1.369202 -0.230282 1.487595 0.594625 -0.026402 -0.131347 0.854028 0.304794 1.364105 0.950801 -0.275135 0.155865 0.133819 0.584290 0.570116 0.430581 0.629602 1.186517 1.300988 1.131914 1.156254 0.652711 1.526271 0.724500 1.498674 -0.060166 0.161032 0.948319 0.277002 0.145951 0.963056 1.070311)
)
;;; 104 all -------------------------------------------------------------------------------- ; 10.1980
-#(104 14.242193222046 #(0 1 1 0 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0)
- 13.682311361591 #(0 1 1 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0)
- 13.330215043333 #(0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0)
+(vector 104 13.330215043333 (fv 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0)
- 10.151829 #(0.000000 1.620706 1.708341 0.965550 1.395591 1.098846 0.152423 1.210229 1.450878 0.834342 1.530620 -0.146444 1.086540 1.311781 0.833093 0.264096 0.959060 0.396659 0.448736 0.841207 1.677200 0.880637 1.606077 0.780250 0.388506 0.712116 1.702858 0.053095 0.843705 0.053768 0.548203 0.094770 1.771663 0.143966 0.938519 0.532315 -0.148275 1.624687 1.588949 0.685241 0.829306 0.094891 0.906476 0.263385 -0.297650 0.854522 -0.016250 0.747207 1.541560 -0.029545 0.019655 0.790541 0.531647 0.624113 0.349121 0.433764 0.704063 1.587473 1.487247 1.439348 0.299325 1.124962 0.356890 0.120919 0.723942 0.042405 1.715127 1.308559 0.120046 0.357801 0.405758 1.411137 1.459076 0.624784 0.907148 1.792552 1.087791 1.059046 1.816148 1.630076 0.514303 0.621223 1.216200 0.119900 0.454251 1.726800 0.070090 -0.179477 0.332959 1.538298 1.668726 -0.472472 -0.010346 0.140180 0.232927 0.626367 0.708138 0.673265 0.188971 1.336970 0.657201 0.472091 1.631976 0.746897)
+ 10.124244 (fv 0.000000 1.622675 1.706946 0.969141 1.395974 1.097698 0.150298 1.207570 1.449278 0.836769 1.526696 -0.147627 1.089028 1.314193 0.833408 0.265551 0.958522 0.397626 0.447242 0.837858 1.676927 0.883730 1.604731 0.779720 0.388122 0.713835 1.704244 0.052983 0.837107 0.054588 0.549459 0.093126 1.768139 0.144405 0.937970 0.532416 -0.149569 1.622840 1.586484 0.686471 0.830291 0.095651 0.908595 0.259853 -0.301519 0.855324 -0.014912 0.748872 1.538644 -0.030037 0.020462 0.792578 0.531283 0.625746 0.346250 0.434570 0.703831 1.586850 1.489275 1.435865 0.300417 1.125540 0.355002 0.123270 0.728375 0.039493 1.718698 1.307117 0.118823 0.358408 0.405752 1.413026 1.454448 0.630369 0.900592 1.792896 1.090807 1.061221 1.814531 1.630768 0.510555 0.618481 1.214968 0.122072 0.455822 1.727623 0.073245 -0.177442 0.329678 1.542732 1.673278 -0.469931 -0.007785 0.142142 0.231493 0.623628 0.711468 0.673585 0.185009 1.333716 0.659875 0.472080 1.635059 0.745116)
+
+ ;; 103+1
+ 10.275285 #(0.000000 0.766045 0.758318 0.527263 0.297602 -0.220660 0.843254 1.514408 0.485353 0.812135 0.348878 0.775197 0.047879 0.029543 0.283642 0.002716 1.604201 1.035276 1.656724 -0.040752 0.022899 1.491112 0.898813 1.356951 1.324619 -0.033929 0.459965 1.111102 1.133048 1.011882 0.204025 0.504974 0.921280 0.802500 0.220289 0.307291 -0.400054 1.435114 0.877954 1.160776 0.500458 -0.700012 0.491131 0.918641 1.205216 0.410209 0.061124 1.219224 0.201639 1.418580 1.569885 1.076223 1.149827 1.271335 0.104510 1.096467 1.299860 0.536464 1.174176 0.267049 1.435559 0.590482 1.183704 1.667286 1.299866 0.752687 0.061344 0.872137 -0.023202 1.396793 0.800897 1.378479 -0.284533 1.542592 0.617940 -0.056150 -0.076140 0.860473 0.211375 1.366917 1.010531 -0.227839 0.171693 0.186622 0.600417 0.530929 0.483380 0.644987 1.142519 1.358336 1.101883 1.125957 0.647607 1.571711 0.728839 1.592844 -0.003107 0.163651 0.931816 0.281116 0.161282 0.950629 1.042875 -0.059815)
)
;;; 105 all -------------------------------------------------------------------------------- ; 10.2470
-#(105 14.418999645918 #(0 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 0 0 0 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 1 0)
- 13.595993876506 #(0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 1 0)
+(vector 105 13.595993876506 (fv 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 1 0)
- 10.199436 #(0.000000 0.593143 0.234139 1.319605 1.358630 -0.401818 0.536047 0.620748 0.326676 1.062162 -0.156060 -0.031917 1.234524 1.771816 1.088375 1.511967 0.088122 1.000296 -0.058802 -0.053565 1.487139 0.779734 0.479463 1.421952 0.157520 -0.258888 0.123544 0.481193 1.176594 1.115507 1.076069 1.268061 0.961348 1.941134 1.084993 1.538048 0.309025 1.385170 1.946551 1.284882 -0.011087 1.361131 1.317837 1.088143 0.480652 0.459678 1.095745 0.480313 0.565768 1.557232 0.590032 1.382834 1.149821 0.200522 0.308748 0.583636 0.629424 0.850392 0.794457 -0.191768 1.492497 1.297004 0.276621 0.106627 1.746361 1.597493 1.903169 1.657013 0.407123 0.143476 1.354389 1.691746 1.124454 0.915067 1.246788 0.386540 -0.244283 0.150081 0.079312 0.823925 -0.022197 0.545695 0.328249 -0.039896 1.635254 0.434777 0.156864 0.394668 -0.277503 0.666890 0.202609 1.084057 1.062054 -0.045522 0.595668 0.640173 1.113020 0.038743 0.571286 -0.179284 1.650658 0.368601 0.619409 1.694123 1.281407)
+ 10.169606 (fv 0.000000 0.591462 0.235800 1.321672 1.356594 -0.405542 0.538022 0.615762 0.326243 1.062550 -0.153260 -0.031444 1.233243 1.770308 1.085997 1.514420 0.095655 1.000755 -0.065552 -0.053493 1.481942 0.777394 0.483679 1.419470 0.159850 -0.259703 0.126983 0.478035 1.178492 1.111834 1.075738 1.268063 0.962249 1.943997 1.083333 1.538989 0.307093 1.387414 1.941208 1.284189 -0.012780 1.356158 1.317824 1.095171 0.472030 0.459214 1.096373 0.477967 0.565821 1.566421 0.590639 1.381435 1.150189 0.197776 0.315906 0.587160 0.629501 0.853485 0.797405 -0.187739 1.489470 1.296970 0.273664 0.102171 1.749652 1.601370 1.902817 1.658081 0.403983 0.138955 1.356476 1.693746 1.125750 0.916183 1.246086 0.386904 -0.248158 0.148664 0.070783 0.819794 -0.019914 0.547099 0.323707 -0.046514 1.635194 0.435105 0.156523 0.390396 -0.277746 0.665321 0.200546 1.082837 1.059380 -0.041536 0.592565 0.634526 1.116414 0.039718 0.575393 -0.178156 1.655927 0.370318 0.615340 1.693958 1.282592)
)
;;; 106 all -------------------------------------------------------------------------------- ; 10.2956
-#(106 14.299785614014 #(0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
- 13.811582734804 #(0 0 1 0 1 0 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
- 13.421741504769 #(0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0)
- 13.200031373463 #(0 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
+(vector 106 13.200031373463 (fv 0 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
- 10.267612 #(0.000000 0.060687 -0.054269 1.223991 1.069303 0.967866 -0.113941 0.537870 0.773931 1.093440 1.603090 1.129062 1.251876 0.112243 -0.007477 -0.179201 1.221889 0.977738 0.253666 0.038110 0.328609 0.708856 1.499157 0.260930 0.844411 0.129153 0.518564 0.084104 1.211679 1.197280 -0.212479 0.555258 1.277691 0.074208 1.303811 0.397868 0.047977 1.020085 -0.135962 0.066357 1.217859 0.764141 1.651160 0.812427 1.477230 -0.162926 1.131234 0.393123 1.708450 0.390033 1.531603 1.032540 0.665856 0.949935 0.552029 0.742707 1.234919 1.733383 0.571056 1.601565 0.249758 1.208940 1.017059 1.619918 1.316181 0.221909 1.355910 1.139452 0.142762 0.419560 0.131198 1.745334 -0.008861 -0.202789 0.306000 0.117910 -0.498429 1.077502 0.024644 -0.090790 1.757247 1.355206 0.454660 1.059184 1.019416 -0.121131 0.261587 0.131517 0.026672 0.410146 0.034785 0.513313 1.132719 0.589979 1.432503 1.808129 0.367311 0.240684 1.502046 -0.348484 0.357502 1.650029 1.372439 1.291593 -0.211597 1.336882)
+ 10.233770 (fv 0.000000 0.055119 -0.050942 1.221658 1.069634 0.969833 -0.120088 0.537260 0.774846 1.097793 1.607343 1.125046 1.248849 0.110938 0.000911 -0.176700 1.224234 0.974172 0.258380 0.044520 0.328839 0.706861 1.491508 0.262253 0.850888 0.129635 0.528138 0.085967 1.206179 1.203105 -0.212392 0.552998 1.277370 0.069273 1.300991 0.395491 0.052184 1.017350 -0.139116 0.060719 1.223876 0.765705 1.643712 0.809882 1.480192 -0.160266 1.133315 0.396498 1.706614 0.389700 1.530945 1.033706 0.669577 0.953867 0.549025 0.735362 1.230749 1.732990 0.576594 1.599366 0.250495 1.206074 1.016404 1.623424 1.318513 0.223760 1.354914 1.140942 0.138240 0.414002 0.134404 1.756706 -0.015032 -0.196090 0.317193 0.119056 -0.492220 1.081019 0.025882 -0.092539 1.764132 1.357709 0.458311 1.060374 1.019483 -0.126097 0.259596 0.137076 0.020444 0.418031 0.040745 0.523959 1.133024 0.593829 1.429205 1.802013 0.365195 0.248492 1.498863 -0.344913 0.359725 1.657142 1.374238 1.289802 -0.217105 1.333949)
)
;;; 107 all -------------------------------------------------------------------------------- ; 10.3441
-#(107 13.927956268954 #(0 1 0 1 1 0 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1)
- 13.912716531306 #(0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 1 0 1 0 1 0 0)
- 13.624429092956 #(0 1 0 1 1 0 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
- 13.224366750161 #(0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
+(vector 107 13.224366750161 (fv 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
- 10.308825 #(0.000000 1.285914 0.727368 1.700484 1.796902 0.500274 0.002125 0.645475 1.557190 0.754976 0.413631 -0.174210 0.192415 1.382843 1.484796 0.553834 1.079358 0.128315 0.276537 1.057465 -0.210317 1.762289 1.161741 0.302799 0.025920 1.715379 1.381188 1.714186 0.538877 -0.079199 0.385480 1.913830 1.686037 0.390828 1.313933 1.058527 -0.006057 1.173533 0.099032 1.120627 1.585078 0.183805 0.043951 0.182375 1.516920 1.501785 0.022010 0.237365 0.050468 0.880070 0.490558 0.978758 1.365606 1.839257 1.225056 0.600407 0.938793 1.417242 0.948654 1.205227 0.360743 1.182419 1.488787 0.278984 0.112279 1.260998 1.512313 1.144870 1.491508 1.384063 0.505379 1.324525 1.038850 1.352520 0.522195 1.487254 0.342450 -0.086945 0.787736 0.279907 0.035659 1.661228 0.183454 1.100958 0.774770 0.664076 0.088907 1.420200 1.750164 0.065520 1.978170 1.532327 1.442710 0.283413 0.528588 1.121434 -0.444957 1.678864 1.309676 1.474379 1.451455 0.561769 0.115867 0.988971 0.500488 0.712776 1.608173)
+ 10.273899 (fv 0.000000 1.285870 0.722685 1.695642 1.789973 0.495199 0.001511 0.648393 1.565696 0.756830 0.421656 -0.184836 0.187469 1.381401 1.501800 0.551266 1.079110 0.129360 0.283265 1.059394 -0.217105 1.758613 1.156467 0.305791 0.018881 1.709795 1.386465 1.716357 0.543922 -0.077767 0.376814 1.917356 1.703183 0.375846 1.314995 1.049255 -0.015490 1.182770 0.105614 1.125738 1.580574 0.196175 0.043631 0.176951 1.523484 1.504279 0.024743 0.233174 0.051990 0.885176 0.485127 0.978870 1.366279 1.841166 1.225239 0.599047 0.937430 1.422432 0.950869 1.195765 0.360876 1.187450 1.491233 0.274262 0.123358 1.276789 1.498182 1.151090 1.495794 1.385360 0.511524 1.320969 1.040843 1.323508 0.526850 1.486006 0.358172 -0.084804 0.784722 0.263761 0.033435 1.669885 0.179635 1.097636 0.771172 0.674320 0.095788 1.426496 1.763465 0.078301 1.972016 1.520526 1.431005 0.272982 0.550020 1.118797 -0.453975 1.686563 1.286924 1.481496 1.458102 0.550556 0.115818 1.002355 0.493193 0.718245 1.621218)
)
;;; 108 all -------------------------------------------------------------------------------- ; 10.3923
-#(108 14.009567264777 #(0 0 1 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 0 0 0)
- 13.998919339781 #(0 0 1 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 0)
- 13.694299006963 #(0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 1 1 1 0 0 0 0 1)
- 13.534 #(0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1)
+(vector 108 13.534 (fv 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1)
- 10.341409 #(0.000000 1.291002 0.754260 1.806925 1.104834 0.765477 1.438521 1.629410 0.526797 1.810980 1.181008 0.011408 0.355548 0.092641 0.430083 0.198061 0.903741 0.743842 0.670858 -0.110974 1.146769 1.813781 0.550836 0.274498 0.836423 1.126894 -0.182011 -0.338248 0.644597 0.161459 0.868182 1.269151 0.832405 1.218399 1.664805 1.059628 1.942308 -0.011012 0.364902 0.722455 0.624496 1.571064 0.110457 0.569542 1.800696 0.876038 0.071097 0.070923 0.550048 0.328955 0.547744 0.338650 1.648546 1.034793 0.471712 1.774120 0.241250 1.849158 1.140642 1.227501 0.832327 0.425107 0.642813 1.258050 1.085797 0.644639 0.431383 0.971551 0.108347 0.689221 0.417011 1.802929 1.350079 0.150177 0.402982 0.572067 1.441115 0.531496 -0.176405 0.298501 0.919166 1.089100 0.411452 0.851111 1.520546 1.878528 0.519843 1.243056 -0.052979 0.833847 0.278909 1.955683 1.767351 1.536271 1.530713 -0.110226 1.325897 -0.070619 1.047052 0.534478 0.700822 0.070191 0.069307 1.205317 1.620431 1.070223 1.372454 0.851276)
+ 10.312988 (fv 0.000000 1.293654 0.754043 1.806542 1.109001 0.766775 1.436021 1.627340 0.528605 1.806494 1.181378 0.013554 0.353388 0.092480 0.431618 0.200495 0.904126 0.741464 0.675051 -0.110957 1.146773 1.810641 0.552983 0.275055 0.835876 1.123930 -0.182193 -0.339155 0.645146 0.163632 0.868047 1.269556 0.830686 1.219557 1.665806 1.060039 1.944315 -0.011848 0.365415 0.718256 0.624511 1.571990 0.113371 0.572031 1.797961 0.876379 0.068642 0.072119 0.553161 0.329387 0.545574 0.337595 1.647194 1.034042 0.468339 1.774314 0.240404 1.846502 1.142528 1.223731 0.832499 0.428931 0.643890 1.257704 1.085969 0.643637 0.429070 0.971966 0.109095 0.689833 0.417898 1.804672 1.346983 0.150026 0.404292 0.575881 1.441149 0.533070 -0.177095 0.298641 0.921545 1.086883 0.410704 0.849120 1.518187 1.874571 0.517824 1.242109 -0.053714 0.834159 0.276990 1.956354 1.765190 1.537622 1.530954 -0.106766 1.325278 -0.071959 1.045056 0.533410 0.699958 0.068418 0.070057 1.204618 1.620552 1.072110 1.372120 0.848823)
)
-;;; 109 all -------------------------------------------------------------------------------- ; 10.4403
-#(109 13.820175866598 #(0 0 0 1 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0)
- 13.496821304096 #(0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0)
+;;; 109 all -------------------------------------------------------------------------------- ; 10.440306508911
+(vector 109 13.496821304096 (fv 0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0)
+
+ 10.432370 (fv 0.000000 0.222737 0.395964 0.267704 0.984627 0.196896 1.257313 -0.049947 0.063508 1.503629 1.207170 0.259470 1.634989 1.732463 0.102120 1.779072 -0.448069 1.030982 -0.170238 0.241134 1.050790 1.545206 1.217799 1.632326 -0.260618 1.981321 1.563052 0.646224 0.963725 1.195450 1.382468 0.912278 -0.055446 -0.043084 1.544497 1.444807 0.819657 0.741044 0.122396 1.518758 -0.047192 1.432176 0.150062 1.445372 1.689041 1.538858 1.607305 0.672865 0.037321 1.002894 0.706157 0.845104 0.402627 1.438914 1.038104 1.050343 0.380185 1.252881 -0.144926 -0.130041 -0.022885 1.740880 1.268140 -0.038596 0.221618 0.937959 1.603605 0.465293 -0.010315 0.708519 1.255289 0.623840 0.892628 0.632806 0.245713 1.831669 -0.020202 0.561348 0.735902 1.121505 0.850852 0.147905 1.162108 1.085140 0.352699 1.043580 0.226572 1.785966 0.379633 0.873437 1.384309 1.785370 1.080206 1.256403 1.169325 0.672865 1.444061 0.325194 0.278183 1.165719 -0.193709 1.182201 0.138301 0.079081 1.231522 0.798589 -0.014107 0.372822 1.050722)
+ ;; [checked]
- 10.469015 #(0.000000 0.227957 0.395632 0.273872 0.974280 0.198553 1.271296 -0.057997 0.075182 1.491357 1.203280 0.260939 1.610818 1.730388 0.085486 1.766931 -0.437699 1.027244 -0.156136 0.233654 1.075471 1.568576 1.218747 1.640304 -0.259257 1.959776 1.562887 0.645798 0.969195 1.188619 1.371699 0.933169 -0.050315 -0.056148 1.583978 1.435207 0.804318 0.724771 0.103794 1.519357 -0.042674 1.417289 0.143025 1.455697 1.674581 1.562612 1.607087 0.665070 0.048674 0.995383 0.699683 0.841412 0.391545 1.431081 1.026971 1.041619 0.388318 1.261439 -0.139526 -0.121199 -0.017265 1.746541 1.252462 -0.030905 0.240948 0.948446 1.599755 0.471597 -0.023328 0.714038 1.243226 0.632481 0.898900 0.640832 0.230382 1.821587 -0.043794 0.575315 0.747081 1.156991 0.842991 0.163663 1.155600 1.077236 0.371269 1.041464 0.208306 1.786810 0.377962 0.876185 1.398545 1.766262 1.078694 1.274580 1.179216 0.684809 1.458111 0.316252 0.272840 1.168623 -0.196865 1.159897 0.116516 0.099380 1.236142 0.801537 -0.024773 0.353923 1.047514)
+ ;; pp:
+ 10.450104 (fv 0.000000 0.623079 1.000690 1.676565 0.329793 0.812365 1.369654 0.033036 0.636775 1.205357 1.818620 0.518482 1.271099 -0.006177 0.798686 1.518819 0.365150 1.120280 1.863547 0.825398 1.655423 0.561458 1.434421 0.357234 1.260951 0.112744 1.108421 0.195312 1.204468 0.187317 1.151003 0.344529 1.318670 0.493356 1.634474 0.713838 1.719668 0.894392 0.187447 1.393869 0.631586 1.857642 1.152308 0.558736 1.895158 0.937863 0.284606 1.593849 1.131320 0.496395 1.862604 1.450055 1.017002 0.269052 1.590119 1.223313 0.766679 0.191870 1.793336 1.442714 0.950223 0.613488 0.158729 1.978172 1.504759 1.404948 0.934115 0.506811 0.307861 0.053560 0.056210 1.784308 1.658677 1.460879 1.312182 1.175464 0.793270 0.871641 0.543638 0.736870 0.773799 0.716297 0.645633 0.912396 0.319672 0.772867 0.727345 0.920587 0.879052 1.066787 1.359741 1.428609 1.742928 0.019718 0.299864 0.439508 0.461036 0.748673 0.838321 1.439140 1.960382 0.367463 0.781933 1.129021 1.394803 1.904930 0.281191 0.715525 1.133222)
+
+ ;; ppe:
+ 10.470162 (fv 0.000000 0.451543 0.456061 0.147873 0.922547 -0.015839 1.326621 0.024116 -0.214919 1.809411 1.260411 -0.041222 1.497661 1.558073 1.813230 1.792964 -0.178738 0.909655 0.169254 0.063699 1.161084 1.372145 1.379335 1.141902 -0.228933 1.774907 1.529928 0.313058 1.032527 0.848013 1.268723 1.218902 1.606823 -0.185860 1.765043 1.039756 0.745126 0.269721 0.154169 1.685147 -0.249171 1.208381 0.488385 1.400686 1.729831 1.462720 1.767018 0.760244 0.226518 1.299640 0.590535 1.231728 0.337540 1.363389 1.096692 0.848743 0.528317 1.290759 1.823255 0.006608 0.050582 1.737871 1.377769 0.292561 0.372415 1.032383 1.772564 0.594274 1.989312 0.990074 1.229632 0.208396 0.695371 0.886409 0.070239 1.725783 -0.164935 0.277786 0.838920 1.005114 0.874184 0.343822 0.665942 0.650106 0.585298 0.979509 -0.150741 1.631833 0.286195 1.077553 1.249512 1.979846 1.138840 1.144065 1.361495 0.626673 1.081435 -0.100313 0.333711 1.298242 -0.025467 1.240351 0.507433 -0.065459 1.581161 0.747520 -0.025829 0.466153 1.514665)
+
+ ;; 108+1
+ 10.457243 #(0.000000 1.269530 0.760051 1.729694 1.122945 0.814880 1.466156 1.631086 0.616903 1.786832 1.344985 0.030797 0.418832 0.037877 0.373313 0.275814 0.977767 0.677872 0.673791 -0.065296 1.118192 1.826436 0.508528 0.285632 0.821565 1.103219 -0.267070 -0.330900 0.618539 0.170243 0.892990 1.223460 0.764058 1.162302 1.620423 0.957344 0.023461 -0.059770 0.381474 0.692706 0.660066 1.703495 0.098695 0.624314 1.751336 0.844891 0.120502 0.057294 0.621996 0.319901 0.586587 0.186646 1.685806 0.974557 0.474304 1.735548 0.234787 1.810600 1.138824 1.194376 0.872559 0.435412 0.677166 1.290849 1.011702 0.701077 0.322755 0.950082 0.024752 0.607227 0.415633 1.702576 1.323090 0.195261 0.365091 0.675664 1.408251 0.606997 -0.208324 0.308915 0.941088 1.034722 0.364193 0.967725 1.444390 1.941283 0.456248 1.293589 0.032476 0.805832 0.141117 1.965347 1.709815 1.528055 1.586120 -0.152788 1.361484 0.019126 1.044770 0.500796 0.670659 0.067435 -0.009310 1.226198 1.603811 1.046583 1.365223 0.883194 0.193296)
+
+ ;; 110-1
+ 10.322689 #(0.000000 0.462741 1.225949 -0.043832 0.328249 1.203588 1.366455 0.188790 0.662494 1.254935 0.088331 0.613339 1.462149 0.115526 0.949842 1.737591 0.506946 1.154137 -0.032436 0.629976 1.492938 0.520189 1.718079 0.515487 1.428565 0.137996 1.083472 0.059980 1.139261 0.225618 1.233707 0.316895 1.419668 0.505397 -0.033495 1.176194 0.083251 0.973170 -0.022020 1.079081 0.404451 -0.075399 0.954069 0.083319 1.505012 0.979962 0.145560 1.327979 0.617711 0.036057 1.210156 0.994048 0.360797 0.174071 1.687531 1.240584 0.732227 -0.166972 1.189885 0.961323 0.562443 0.160936 1.676083 1.644780 1.189431 1.265120 0.457405 -0.062176 -0.195559 1.385371 1.408492 1.397143 0.885687 1.094863 0.605162 1.202260 0.535171 0.604107 -0.037920 -0.116681 -0.077010 -0.133672 0.060191 0.259325 0.089984 -0.015913 0.025781 0.203482 0.430865 0.266253 0.224375 0.677975 0.937860 1.248001 1.478415 1.717389 -0.074246 -0.120586 0.330859 0.557195 1.125288 1.605582 1.607504 0.218383 0.840491 1.393138 1.612134 0.160685 0.161037)
+ 10.322461 #(0.000000 0.462674 1.225929 -0.043823 0.328289 1.203623 1.366492 0.188811 0.662499 1.254926 0.088298 0.613331 1.462150 0.115531 0.949884 1.737576 0.506973 1.154095 -0.032430 0.630002 1.492901 0.520199 1.718088 0.515495 1.428578 0.137955 1.083433 0.059942 1.139302 0.225628 1.233696 0.316931 1.419646 0.505419 -0.033497 1.176199 0.083263 0.973159 -0.022043 1.079044 0.404491 -0.075384 0.954089 0.083290 1.505001 0.979986 0.145592 1.327990 0.617711 0.036068 1.210133 0.994076 0.360795 0.174016 1.687546 1.240574 0.732273 -0.167006 1.189898 0.961364 0.562444 0.160956 1.676079 1.644808 1.189461 1.265171 0.457402 -0.062179 -0.195550 1.385369 1.408507 1.397115 0.885691 1.094876 0.605175 1.202259 0.535204 0.604108 -0.037958 -0.116695 -0.076978 -0.133663 0.060171 0.259320 0.089947 -0.015900 0.025779 0.203485 0.430891 0.266250 0.224373 0.677986 0.937839 1.248001 1.478410 1.717359 -0.074278 -0.120509 0.330877 0.557156 1.125282 1.605553 1.607549 0.218369 0.840506 1.393115 1.612150 0.160649 0.161027)
)
;;; 110 all -------------------------------------------------------------------------------- ; 10.4881
-#(110 13.885513312292 #(0 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 1 0)
- 13.64278793335 #(0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 1)
- 13.592092514038 #(0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 1)
+(vector 110 13.592092514038 (fv 0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 1)
- 10.539886 #(0.000000 1.031581 -0.284626 0.704425 -0.062549 -0.036267 1.475895 1.417456 0.902026 1.585867 0.459977 1.464449 -0.044207 1.727302 0.633628 0.509554 1.237181 0.895391 1.393509 0.030322 0.723504 1.263644 0.985072 0.552063 0.151195 1.241755 0.797306 1.153019 1.208827 1.184627 0.392377 0.645742 0.756139 0.237951 1.807480 0.121589 0.654072 0.649838 1.111475 0.110933 1.881969 0.072143 0.988345 0.333160 0.127061 1.350848 1.381686 0.783754 1.431346 0.076896 0.501288 0.735615 0.373636 0.303229 0.476251 0.891742 1.232096 1.647008 0.740670 1.091772 0.557325 0.999130 1.175817 1.165159 1.008298 0.616601 1.871741 1.256445 0.580438 0.409646 -0.062641 0.171707 0.006537 1.008906 1.241198 0.858468 0.908856 0.509095 1.347090 0.513602 1.661013 1.073848 1.328713 -0.088190 0.423575 1.720849 0.558832 1.080031 0.980055 -0.124481 1.165885 -0.045443 1.915991 0.670638 -0.334413 1.951281 0.077127 -0.164429 1.154564 0.261433 0.962312 0.495395 1.156320 -0.071758 1.645005 0.919352 0.908938 1.935965 1.076648 0.651927)
- 10.539547 #(0.000000 1.024716 -0.289258 0.707046 -0.058012 -0.038646 1.472843 1.420407 0.911146 1.584137 0.461301 1.459741 -0.042760 1.729804 0.637649 0.501172 1.240131 0.897064 1.398053 0.024586 0.725655 1.267261 0.992317 0.556506 0.156852 1.245549 0.792090 1.159167 1.210347 1.188132 0.390304 0.648625 0.758029 0.244999 1.807507 0.123753 0.651938 0.647069 1.112190 0.105134 1.878672 0.070496 0.983477 0.343229 0.122430 1.356019 1.372818 0.782030 1.428915 0.081706 0.503851 0.741753 0.369873 0.299286 0.480770 0.894838 1.228877 1.649348 0.751688 1.092371 0.560958 0.999248 1.177500 1.181638 1.015213 0.616012 1.872799 1.250520 0.586997 0.415423 -0.068473 0.170168 0.010822 1.014597 1.250755 0.856686 0.906576 0.506922 1.334854 0.511806 1.661332 1.067908 1.338664 -0.095758 0.419669 1.726239 0.556094 1.078192 0.974820 -0.116771 1.156292 -0.043180 1.911855 0.669459 -0.344036 1.969870 0.073437 -0.163961 1.151920 0.251071 0.948910 0.503604 1.165349 -0.068107 1.646565 0.919685 0.915867 1.939038 1.071629 0.656292)
+ 10.443826 (fv 0.000000 0.966857 -0.310939 0.754018 -0.215289 0.050408 1.345912 1.407669 0.917300 1.537339 0.464664 1.377382 -0.129707 1.562018 0.873176 0.378480 1.188634 1.002593 1.467403 -0.157591 0.611052 1.240086 1.200021 0.642960 0.011727 1.278266 0.757206 1.221576 1.173971 1.148607 0.352945 0.591698 0.569729 0.204560 1.805523 0.091751 0.494475 0.741755 1.173490 0.125853 1.836232 0.189233 1.047389 0.359034 0.299905 1.335669 1.331935 0.866342 1.429328 0.175988 0.321575 0.808716 0.418347 0.305766 0.587213 0.859103 1.233827 1.612185 0.649515 1.232962 0.438531 1.088539 1.160206 1.276056 0.991705 0.605889 1.920272 1.294151 0.591700 0.477186 -0.114311 0.103729 0.053546 1.057780 1.113226 0.935069 0.869987 0.585069 1.193799 0.314064 1.564843 1.009796 1.434593 -0.061294 0.394207 1.540076 0.463315 1.070060 1.005570 -0.247697 1.209164 0.032912 1.882456 0.617912 -0.419949 0.119714 0.033254 -0.149035 1.146172 0.301556 1.043038 0.611637 1.119274 -0.185496 1.474180 0.910726 0.869288 0.008729 1.113223 0.605574)
+
+ ;; pp:
+ 10.416677 (fv 0.000000 0.636826 1.168776 1.802237 0.316567 0.986572 1.395425 0.009381 0.711647 1.264223 1.932392 0.627165 1.472185 0.196446 0.915303 1.747756 0.298057 1.087093 -0.098251 0.679800 1.474105 0.503701 1.516136 0.488851 1.222583 0.157308 1.093122 0.014882 1.111898 0.174280 1.267353 0.186944 1.319383 0.570938 1.741756 0.793533 -0.092041 0.821354 -0.104426 1.044239 0.485714 1.864668 0.984585 0.108795 1.386239 0.942801 0.150487 1.312495 0.693148 -0.057522 1.440466 0.911264 0.464590 -0.106316 1.425558 0.757031 0.414982 -0.197207 1.393462 0.845365 0.655558 0.173740 1.724477 1.622714 1.133952 1.113326 0.491749 0.027662 -0.081584 1.624363 1.523158 1.483424 1.009127 1.065663 0.489911 0.865535 0.429699 0.506066 0.168610 0.091635 -0.004728 0.101995 0.057231 0.244394 0.215629 0.140294 0.025423 0.249165 0.312773 0.491767 0.509301 0.585407 1.082514 1.193775 1.427418 1.634094 0.038165 -0.066305 0.261200 0.531951 1.008338 1.495805 1.630762 0.003123 0.564786 1.124822 1.373512 0.020469 0.093862 0.692170)
)
;;; 111 all -------------------------------------------------------------------------------- ; 10.5357
-#(111 14.436 #(0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 1 1 0 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1)
- 14.359505653381 #(0 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0)
- 13.80813938144 #(0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1)
+(vector 111 13.80813938144 (fv 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1)
+
+ 10.489680 (fv 0.000000 1.276377 0.968620 -0.218445 1.901880 0.088071 1.832261 1.338375 0.312772 1.516596 -0.040044 1.173079 0.061551 1.259985 1.326413 -0.075796 1.430603 0.457729 0.555673 0.169939 0.778858 0.499517 1.015059 1.507495 0.252622 0.024778 0.982934 -0.060048 0.808349 1.306234 -0.213685 0.893109 1.680180 0.816232 1.412440 1.447865 1.309405 0.967681 0.468074 1.167299 -0.294730 0.516281 1.115680 1.346378 1.503302 1.329509 0.069846 0.507313 -0.050602 1.169163 1.172511 1.329654 1.283831 1.273536 0.082962 0.472668 1.944396 -0.083515 1.629124 1.133239 1.648857 0.792610 0.954204 1.052081 0.877455 0.393129 1.388896 0.794997 1.052606 1.611060 1.743638 -0.167971 0.888631 0.570983 1.576402 0.843125 0.114093 0.127173 -0.133155 0.386550 0.090826 -0.017777 0.548430 0.313331 0.380367 1.607846 1.086331 0.772909 1.643444 0.182619 1.863239 1.234660 1.568659 0.555853 0.450573 1.731233 0.287714 1.462361 1.635622 0.921500 0.450553 1.230974 -0.314374 1.516211 0.633822 0.309849 1.238687 0.080817 0.340326 0.819921 0.108053)
- 10.528443 #(0.000000 1.272411 0.962005 -0.230902 1.900477 0.092011 1.826605 1.332325 0.303996 1.517220 -0.039233 1.168346 0.064635 1.256383 1.327875 -0.072148 1.431093 0.441201 0.544463 0.178167 0.790663 0.499475 1.033101 1.509224 0.261279 0.023728 0.991735 -0.051954 0.815009 1.315847 -0.206249 0.884992 1.685222 0.818729 1.410466 1.451346 1.329687 0.972268 0.452709 1.167173 -0.298868 0.521581 1.120839 1.346937 1.484579 1.339138 0.068881 0.512628 -0.052179 1.158876 1.177629 1.327725 1.286272 1.263574 0.077949 0.481835 1.928137 -0.079298 1.636115 1.119306 1.636368 0.783172 0.958297 1.049108 0.855170 0.391159 1.393303 0.791035 1.041630 1.605491 1.734285 -0.177929 0.893146 0.550477 1.578047 0.829093 0.118810 0.120035 -0.129637 0.369243 0.086213 -0.031112 0.542118 0.295894 0.380695 1.591786 1.093017 0.787735 1.655191 0.195536 1.856745 1.227319 1.576268 0.556782 0.445580 1.741501 0.299520 1.450404 1.620647 0.932062 0.453133 1.218862 -0.329037 1.520042 0.626784 0.314825 1.229206 0.084852 0.334150 0.796421 0.123072)
+ ;; pp:
+ 10.643017 (fv 0.000000 0.596037 0.998452 1.643602 0.188094 0.782119 1.390123 1.810388 0.670975 1.236188 1.928555 0.736392 1.354483 0.006575 0.718278 1.554028 0.172799 1.022616 1.853097 0.691617 1.671397 0.482108 1.396206 0.302319 1.140585 0.111154 0.983122 0.056085 1.055691 0.244450 1.330135 0.199631 1.342393 0.616747 1.511753 0.573545 1.630931 0.744657 -0.127581 1.276167 0.582439 1.726242 0.856228 0.208204 1.620801 0.767397 -0.120308 1.331917 0.688933 0.171660 1.532348 0.908708 0.322624 0.027670 1.377420 0.714808 0.162920 1.602731 1.164131 0.775892 0.384718 0.044281 1.527000 1.328705 0.880737 0.584683 0.141627 1.752084 1.448907 1.433198 0.874054 1.138685 0.574512 0.605078 0.161111 0.252563 -0.040319 -0.061275 1.677664 1.534157 1.653785 1.516730 1.618593 1.597830 1.517008 1.764779 1.586607 1.708185 1.767619 1.608773 1.820236 0.130593 0.415076 0.510025 0.490569 0.957514 1.270290 1.288854 1.456687 1.689789 0.173097 0.338870 0.690795 1.081327 1.548637 1.886234 0.458387 0.722046 1.068087 1.577951 0.177921)
+
+ ;; 112-1
+ 10.443480 #(0.000000 -0.037648 1.480547 0.898464 0.849030 0.715984 0.623417 1.093452 1.045921 0.246543 -0.344784 0.997605 0.429765 1.643868 1.074256 0.709084 1.236163 1.022832 0.593800 1.797589 1.639095 0.499474 0.451589 0.525734 0.819269 1.059245 1.215835 0.300337 0.312343 0.508727 1.809376 1.802285 0.733765 0.697253 0.213017 0.226942 0.966882 -0.054080 1.879864 1.400510 1.357810 0.290115 0.291026 1.461469 1.516948 0.034933 0.486567 0.403300 0.540306 0.175821 0.605359 0.053443 -0.120390 0.105172 0.600333 0.664197 1.296750 -0.152576 0.244035 0.980125 0.718707 -0.396109 0.441995 0.857389 0.411314 0.615877 0.959296 0.472542 0.178066 1.504140 1.379940 1.172606 -0.073019 1.778815 0.168644 0.842220 -0.533009 0.218109 1.118845 -0.068508 0.820652 0.991755 -0.019081 1.121993 1.252324 1.508966 1.128293 0.270315 0.609971 -0.037115 1.065942 0.157780 1.138199 0.066912 1.242092 -0.087703 0.391351 0.761091 0.405427 0.623899 1.599600 0.333353 -0.321760 0.806575 1.571941 1.193797 1.308207 1.479299 1.022704 -0.056211 1.366886)
)
;;; 112 all -------------------------------------------------------------------------------- ; 10.5830
-#(112 14.387 #(0 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 1 1 0)
- 14.250584755219 #(0 0 1 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 1 1 0)
- 14.059637729172 #(0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1)
- 13.719 #(0 1 1 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0)
+(vector 112 13.719 (fv 0 1 1 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0)
- 10.494064 #(0.000000 -0.065967 1.590397 0.942766 0.780240 0.818804 0.713224 1.047070 1.122037 0.290265 -0.315075 0.937037 0.364964 1.650844 1.191739 0.732210 1.257607 0.983795 0.503474 1.899517 1.619061 0.444249 0.455917 0.533636 0.685264 0.885057 1.294871 0.246328 0.353253 0.475152 1.785786 1.847200 0.798228 0.519252 0.165271 0.222288 0.882705 0.028893 1.767976 1.572689 1.346291 0.107973 0.386300 1.464204 1.530078 -0.027392 0.402912 0.275299 0.474333 0.232861 0.619759 0.028359 -0.066211 -0.095896 0.579051 0.719456 1.278606 -0.202303 0.372921 0.856495 0.819588 -0.328811 0.480559 0.800015 0.467655 0.631812 0.911076 0.441145 0.114203 1.521100 1.408878 1.229284 -0.133869 1.722355 0.275624 0.813139 -0.439854 0.264952 1.183757 -0.119259 0.752044 1.161199 0.234169 1.197462 1.266605 1.427548 1.110838 0.317061 0.580836 -0.114658 0.997686 0.151297 1.091025 1.914805 1.181670 -0.014602 0.296264 0.817354 0.399057 0.671310 1.536768 0.457232 -0.253450 0.788591 1.688197 1.258709 1.232978 1.364931 1.048086 0.026652 1.318966 0.393448)
+ 10.459590 (fv 0.000000 -0.062913 1.592216 0.942127 0.779122 0.819196 0.718354 1.051311 1.122277 0.289276 -0.312849 0.932738 0.364926 1.651917 1.193754 0.735359 1.259741 0.983056 0.504666 1.898067 1.619072 0.449638 0.460210 0.529471 0.685535 0.885439 1.297728 0.246636 0.353836 0.474674 1.786116 1.844574 0.794031 0.522576 0.168364 0.225941 0.884728 0.029172 1.770209 1.576812 1.352123 0.112130 0.389134 1.458224 1.532633 -0.027079 0.404717 0.274263 0.478667 0.228414 0.618491 0.032636 -0.068031 -0.092335 0.583363 0.722295 1.283590 -0.207344 0.372473 0.858879 0.815320 -0.324439 0.478159 0.803167 0.466456 0.633813 0.914568 0.438946 0.113725 1.518872 1.409010 1.227714 -0.134104 1.718626 0.277412 0.813327 -0.439158 0.260660 1.183284 -0.118611 0.754421 1.157336 0.232930 1.195932 1.264381 1.427453 1.112389 0.316426 0.581550 -0.107354 0.998672 0.153435 1.101697 1.916684 1.183525 -0.016743 0.301725 0.815282 0.398182 0.676231 1.536900 0.451259 -0.254624 0.791021 1.692791 1.255094 1.233704 1.361151 1.046040 0.024905 1.319507 0.390306)
)
;;; 113 all -------------------------------------------------------------------------------- ; 10.6301
-#(113 14.501041453443 #(0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1)
- 14.027848738379 #(0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1)
+(vector 113 14.027848738379 (fv 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1)
+
+ 10.600374 (fv 0.000000 0.803646 1.150583 -0.063719 0.153874 1.101937 1.517661 1.839236 0.205434 0.503789 1.408027 1.282481 0.272193 0.581489 0.335632 0.191891 1.772311 1.188767 0.099798 1.108690 0.011443 -0.134966 0.851026 0.685097 0.180285 -0.598894 0.447561 0.453948 1.859577 0.373971 -0.017010 1.368747 0.811506 1.286383 1.607236 0.428535 0.456478 0.425986 0.560105 1.702212 1.615194 -0.029581 1.141022 0.404596 0.679875 1.483164 0.383858 0.334137 1.078889 1.358586 1.100321 0.206891 -0.260760 1.245372 1.320253 -0.104904 0.095400 0.153720 1.818561 0.632022 0.857521 -0.124243 1.123425 -0.152970 0.639127 0.101388 0.775543 0.547622 0.403455 1.168990 1.099889 1.089210 1.061140 1.095647 -0.008863 1.297497 0.125060 1.432503 0.841141 0.967915 1.177416 0.211122 0.724975 0.094432 1.035737 1.190949 0.605535 -0.311727 1.252767 0.699524 1.428815 0.329899 0.934047 0.582587 0.113129 0.668360 0.786133 0.103091 0.745732 1.809761 0.414589 0.231740 -0.023699 1.470163 1.649059 1.087085 1.691589 1.869557 0.611645 1.538351 0.985815 1.244743 0.786305)
+
+ ;; pp:
+ 10.533209 (fv 0.000000 0.701701 1.023037 1.805117 0.325103 0.864669 1.301988 0.041817 0.605545 1.212149 1.794798 0.682259 1.361354 0.200642 1.040014 1.570001 0.413916 1.135956 1.836914 0.609510 1.482300 0.433561 1.396354 0.242061 1.189941 0.064290 0.924650 1.865499 0.844070 1.972890 1.045011 0.019512 1.010788 0.256118 1.454283 0.372006 1.414933 0.757156 1.833026 0.854510 0.058898 1.301933 0.794807 0.059810 1.092848 0.343912 1.857250 1.216439 0.367607 1.585969 1.093436 0.524265 1.847968 1.349059 0.839561 0.495981 1.801236 1.298227 0.638863 0.266374 1.658935 1.480658 0.907119 0.639357 0.037985 1.986216 1.525743 1.288722 0.717261 0.704091 0.182223 0.044649 1.629714 1.819647 1.366848 1.330078 1.172022 1.015716 0.897536 0.806098 0.193895 0.422839 0.374579 0.235069 0.423986 0.463374 0.446056 0.493571 0.177728 0.437229 0.621846 0.665477 0.619012 0.807147 1.289974 1.297164 1.517281 1.924928 0.144210 0.370826 0.244142 0.591610 0.749322 1.350513 1.818547 -0.017393 0.517731 1.113988 1.244052 1.823099 0.067707 0.517248 0.930474)
- 10.628620 #(0.000000 0.804080 1.149010 -0.063089 0.150935 1.104268 1.521135 1.836056 0.206226 0.503297 1.406488 1.285064 0.274095 0.578695 0.335647 0.185976 1.774622 1.190989 0.101557 1.107553 0.011086 -0.137360 0.853322 0.687182 0.177328 -0.599833 0.447328 0.454405 1.857939 0.376244 -0.017939 1.372764 0.811896 1.283734 1.604098 0.428205 0.455145 0.422204 0.562216 1.700073 1.614038 -0.032454 1.139954 0.401428 0.675340 1.481784 0.382981 0.331816 1.078787 1.356927 1.106989 0.206475 -0.262484 1.245857 1.321182 -0.105360 0.095372 0.154867 1.817199 0.632785 0.857917 -0.123654 1.126106 -0.151996 0.642639 0.099823 0.774538 0.548547 0.405197 1.168560 1.102692 1.089264 1.062686 1.091892 -0.002896 1.296870 0.122422 1.429905 0.839903 0.968711 1.178312 0.214174 0.717936 0.091860 1.034687 1.191477 0.608157 -0.307032 1.255990 0.693232 1.426224 0.330716 0.936715 0.581004 0.111388 0.672492 0.790003 0.098686 0.746060 1.806624 0.412886 0.232865 -0.024008 1.468717 1.649949 1.091244 1.689398 1.869662 0.610641 1.537059 0.985897 1.243621 0.786454)
+ ;; 112+1
+ 10.576527 #(0.000000 -0.099725 1.731869 1.126572 0.894565 0.787291 0.763373 1.116837 1.193937 0.158815 -0.328224 1.005844 0.228474 1.576738 1.262088 0.726943 1.268236 1.028150 0.589551 1.934756 1.609372 0.549105 0.446947 0.675880 0.714883 0.715628 1.363097 0.197217 0.353490 0.498917 1.784841 1.858473 0.777450 0.430951 0.142623 0.145377 1.039521 0.058101 1.806559 1.621009 1.395572 0.126961 0.400552 1.407730 1.420143 0.113046 0.482937 0.384809 0.357336 0.283000 0.705514 -0.045003 0.046604 -0.167904 0.589381 0.672696 1.241252 -0.116645 0.444533 0.866902 0.717018 -0.308546 0.397419 0.905566 0.584026 0.513164 0.877715 0.340382 0.028422 1.468619 1.404513 1.266203 -0.129199 1.813800 0.484278 0.806396 -0.359344 0.323726 1.188865 -0.113226 0.736080 1.212752 0.152030 1.358239 1.256305 1.492197 1.073162 0.176415 0.460366 -0.046759 0.938493 0.111495 1.045740 -0.030211 1.265442 0.071430 0.331346 0.715146 0.333258 0.829360 1.647336 0.578653 -0.323225 0.799001 1.641979 1.340856 1.121452 1.538434 1.235479 0.162729 1.417493 0.473155 0.256349)
)
;;; 114 all -------------------------------------------------------------------------------- ; 10.6771
-#(114 14.119774267447 #(0 1 1 1 1 1 0 0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 1)
- 13.847382931726 #(0 1 1 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1)
+(vector 114 13.847382931726 (fv 0 1 1 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1)
+
+ 10.628224 (fv 0.000000 0.615672 0.948130 0.747004 0.833637 0.289537 1.854717 0.930205 1.803295 1.161499 -0.674663 0.075654 -0.069447 1.150337 -0.219431 0.096417 1.741068 -0.016217 1.826914 -0.308775 0.152833 0.789042 0.803929 0.462314 0.626523 1.267262 0.400780 0.962101 1.687986 0.905206 0.268457 0.651715 0.114771 1.475643 0.044755 0.228029 0.514674 0.188213 -0.185396 1.589097 0.877857 -0.230405 1.243228 1.194822 1.559225 1.498045 0.808593 -0.017518 1.442649 1.211002 1.811223 0.625459 1.384771 0.613911 0.308197 1.431371 1.357215 1.098185 0.214395 1.664025 1.740860 1.399478 0.567842 0.816563 1.298643 1.214440 0.204096 1.160510 1.171795 0.002888 0.712001 0.408799 0.129596 0.526919 1.018226 1.540087 1.326981 1.269312 0.284234 1.408491 0.614427 1.282597 0.201606 0.407636 1.049940 -0.424432 1.688488 0.609780 -0.014895 -0.443393 1.774217 1.192149 -0.353060 1.542744 1.597711 0.829765 0.335469 0.940418 1.687078 -0.157090 1.505994 0.110351 1.069331 0.286269 -0.198482 1.240708 -0.041616 1.268700 0.079424 0.525193 1.036769 0.352036 1.456021 -0.218427)
- 10.666636 #(0.000000 0.614587 0.946135 0.744028 0.830467 0.295643 1.859996 0.927868 1.798229 1.159985 -0.678317 0.076995 -0.068286 1.149742 -0.221805 0.097806 1.742729 -0.019692 1.821217 -0.313628 0.148946 0.793355 0.805046 0.464820 0.622623 1.270905 0.395632 0.966903 1.683687 0.909240 0.268451 0.648833 0.111761 1.479595 0.043947 0.222328 0.516022 0.191647 -0.180357 1.590546 0.887993 -0.231116 1.240400 1.193896 1.567213 1.499510 0.807483 -0.016674 1.449808 1.210316 1.814775 0.635374 1.382856 0.615068 0.311844 1.426196 1.350711 1.093935 0.209935 1.662875 1.746337 1.408395 0.571940 0.813621 1.298535 1.211085 0.202813 1.157541 1.173204 0.001182 0.713307 0.403523 0.129530 0.527008 1.011442 1.540240 1.325467 1.268151 0.292146 1.408645 0.617535 1.282424 0.204319 0.416346 1.052739 -0.423077 1.686818 0.616286 -0.010664 -0.442650 1.761577 1.189945 -0.353002 1.540981 1.594262 0.840864 0.335908 0.951179 1.678483 -0.157834 1.504779 0.114095 1.075638 0.286067 -0.198092 1.245731 -0.036803 1.273610 0.072950 0.531704 1.037555 0.351192 1.453106 -0.220225)
+ ;; pp:
+ 10.517948 (fv 0.000000 0.513150 0.874296 0.883964 0.730138 0.492200 1.910349 0.914831 -0.079055 1.078332 -0.626669 0.137543 -0.184379 1.218055 -0.394114 -0.038192 1.661163 0.020764 -0.078690 -0.096176 0.170832 0.906574 0.889519 0.505117 0.670269 1.228477 0.365822 0.917034 1.728829 0.934323 0.199610 0.715554 0.056223 1.583731 0.085811 0.136885 0.354627 0.123817 -0.315376 1.492556 0.991663 -0.233639 1.201411 1.218512 1.753756 1.719460 0.679044 -0.197393 1.570682 1.193787 1.873756 0.557014 1.432466 0.588568 0.309382 1.651394 1.357542 1.190693 0.264093 1.733513 1.676510 1.179474 0.616239 0.734925 1.107757 1.048586 0.066290 1.132123 1.205852 -0.090603 0.754355 0.838256 -0.013038 0.421890 0.968163 1.389079 1.284090 1.323690 0.432981 1.323326 0.730210 1.395732 0.109710 0.246664 1.169930 -0.449126 1.545991 0.365384 0.076032 -0.458822 1.876049 1.124853 -0.255218 1.423147 1.451143 0.955505 0.281503 0.928421 1.983790 -0.130994 1.684131 0.142847 1.010533 0.452692 -0.386536 1.218551 -0.132981 1.371320 0.120371 0.410528 1.083879 0.496636 1.350228 -0.127680)
)
;;; 115 all -------------------------------------------------------------------------------- ; 10.7238
-#(115 15.196797370911 #(0 0 0 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 1 0)
- 14.359978160099 #(0 0 0 0 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0)
+(vector 115 14.359978160099 (fv 0 0 0 0 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0)
- 10.717507 #(0.000000 0.222481 0.546838 1.119154 0.063006 1.831725 0.641137 0.435696 1.248429 1.599656 0.541339 -0.023551 0.888464 0.967125 0.102020 0.727079 0.408817 1.049253 -0.124801 1.174675 0.461576 1.044560 0.987797 1.255284 1.254409 0.896410 0.217500 1.825847 -0.114031 0.729193 1.368665 1.274315 -0.070498 0.808420 1.301892 0.098646 0.267689 0.381835 0.923885 0.086773 0.358009 0.897943 1.527563 1.455661 1.231084 1.325296 1.419014 1.494331 0.604395 1.313606 0.330272 1.183318 1.215012 0.230367 1.539782 -0.002492 0.670387 0.462408 0.258678 0.712696 1.786442 0.273322 -0.210560 0.367030 -0.147489 1.130471 1.481270 0.836670 0.394464 0.104781 -0.043218 1.383248 0.046074 1.012146 0.547213 0.522496 1.055292 1.085647 -0.482203 1.008480 0.463909 0.702465 1.271523 0.965237 0.099820 1.536224 0.689884 0.268824 0.895953 -0.032949 1.093430 1.071950 0.176187 1.200501 0.880653 1.686794 0.580626 0.747279 -0.008408 0.405279 -0.017062 0.114681 0.074322 0.855233 0.641334 0.082686 0.638646 1.226616 0.318095 0.005428 -0.380924 1.527397 0.524732 0.452834 0.353829)
+ 10.651124 (fv 0.000000 0.205632 0.521043 1.123267 0.039976 1.837568 0.645276 0.444856 1.235953 1.614101 0.576705 -0.032817 0.913102 0.971540 0.123207 0.744147 0.392163 1.071292 -0.098894 1.183735 0.447902 1.029195 1.008083 1.241655 1.280374 0.851598 0.236819 1.816127 -0.109787 0.735910 1.359965 1.270732 -0.070459 0.794811 1.337404 0.069925 0.240715 0.381811 0.943512 0.073841 0.371201 0.917351 1.527618 1.440973 1.203354 1.349081 1.416186 1.496910 0.596478 1.312074 0.317957 1.177389 1.248077 0.233191 1.529687 -0.003737 0.662497 0.466830 0.261424 0.663736 1.797196 0.273538 -0.239584 0.345229 -0.159975 1.144743 1.462922 0.849868 0.439184 0.064973 -0.068494 1.400482 0.060773 0.986838 0.519130 0.531890 1.046288 1.063229 -0.449183 0.987082 0.473670 0.722114 1.227775 0.954889 0.100062 1.512033 0.697126 0.308149 0.914574 -0.044099 1.083776 1.037385 0.163494 1.178786 0.886753 1.659086 0.598578 0.720776 -0.009109 0.443556 -0.035564 0.124043 0.119757 0.888837 0.603645 0.075938 0.648026 1.218123 0.325603 0.011855 -0.390969 1.523387 0.517639 0.461045 0.382395)
+
+ ;; pp:
+ 10.692099 (fv 0.000000 0.682108 1.004779 1.652402 0.376256 0.931307 1.336301 -0.042653 0.588667 1.131321 1.748894 0.607835 1.177352 0.067431 0.978893 1.474587 0.304669 1.111594 1.772579 0.564007 1.383113 0.290881 1.312527 0.215649 0.998467 1.886147 0.914831 1.987244 0.837886 1.778286 0.954819 0.007952 0.956821 0.049735 1.234469 0.317950 1.546668 0.474841 1.665959 0.756708 1.898394 0.922825 0.371276 1.716491 0.889079 0.061723 1.582232 0.834088 0.114964 1.594440 0.728947 -0.028372 1.273062 0.885177 0.297790 1.790777 1.254681 1.031275 0.275613 1.607695 1.196021 0.692250 0.421770 -0.204945 1.512060 0.983139 0.944306 0.546267 0.135875 1.788546 1.584465 1.138761 1.024708 0.473784 0.573120 0.243555 0.106429 0.088753 1.821567 1.941212 1.609147 1.360828 1.169556 1.150415 1.008492 1.219522 1.057528 1.215083 1.411123 0.944912 1.124604 1.295606 1.527918 1.383902 1.570266 -0.108659 -0.107049 0.292041 0.547918 0.923643 1.165187 1.026903 1.427566 1.557678 -0.113193 0.455092 0.823626 1.321739 1.608732 1.934769 0.561130 0.698218 1.143434 1.648015 0.348542)
+
+ ;; 114+1
+ 10.621744 #(0.000000 0.519128 0.786784 0.918158 0.650178 0.457293 1.964414 0.915637 -0.037992 1.187864 -0.612331 0.073197 0.008576 1.197804 -0.364310 0.047620 1.612311 0.098163 -0.054077 -0.087970 0.039413 0.986129 0.969342 0.451170 0.648283 1.253012 0.349815 0.949459 1.680558 0.960988 0.220312 0.666892 -0.069695 1.584459 0.070346 0.154295 0.414900 0.222762 -0.268103 1.413909 0.961497 -0.210113 1.203087 1.172411 1.792543 1.742069 0.706989 -0.208070 1.562128 1.211841 0.011662 0.482644 1.455971 0.642656 0.264522 1.637721 1.461442 1.154901 0.149110 1.871307 1.810194 1.307963 0.530941 0.678563 1.057540 1.204932 0.204765 1.173394 1.102820 -0.082769 0.639150 0.715081 -0.172130 0.444439 1.033638 1.431627 1.223005 1.352911 0.473564 1.345853 0.701386 1.441324 0.065510 0.263153 1.148218 -0.395379 1.422829 0.339640 0.186555 -0.374702 1.783978 1.192276 -0.175028 1.327174 1.534754 1.031453 0.306400 0.980338 0.017668 -0.122396 1.685264 0.121507 0.952038 0.457874 -0.310268 1.350976 -0.129566 1.387678 0.182170 0.404390 1.132228 0.552993 1.477216 -0.117535 0.087972)
)
;;; 116 all -------------------------------------------------------------------------------- ; 10.7703
-#(116 14.830805621528 #(0 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 0 0 1 1 1)
- 14.175787507646 #(0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 1 1 0)
+(vector 116 14.175787507646 (fv 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 1 1 0)
- 10.701472 #(0.000000 0.796613 0.126119 1.152806 0.578791 1.672615 1.439552 0.802803 -0.069730 0.614657 1.008563 0.241056 1.426394 1.358539 0.519879 1.305347 0.111768 0.482789 1.251065 -0.063126 1.821750 1.002520 1.770269 0.996256 0.219157 0.236209 0.921476 0.250573 0.242453 1.208345 1.192447 1.546475 0.666242 0.274998 0.724402 0.041261 0.123986 1.053740 -0.475188 1.038600 0.455393 1.206137 1.058489 0.253073 0.913746 -0.469883 1.282382 1.263668 1.713600 0.144380 1.562440 0.119947 1.209935 1.207845 1.380811 1.281100 -0.395455 1.910411 1.608188 0.471850 1.104739 0.211176 1.460089 1.810867 1.436539 0.084234 1.196107 1.183762 1.574270 0.069463 1.159080 0.607339 0.569165 1.028155 1.125679 -0.213049 1.004465 1.009371 0.186688 1.531318 1.787353 1.236697 0.607638 0.762730 1.751745 1.422878 0.953374 0.295947 0.939562 0.321654 0.475590 0.040368 0.105707 0.215912 1.090041 1.138950 1.660936 0.522256 1.198857 -0.358743 1.527455 1.223140 -0.015236 1.276710 -0.471987 -0.460503 0.028694 0.971498 1.007845 0.424061 0.344889 0.466205 0.905531 0.749038 -0.297162 0.077115)
+ 10.666895 (fv 0.000000 0.794041 0.130396 1.155449 0.575356 1.670182 1.438030 0.802411 -0.073881 0.612189 1.011030 0.243247 1.424701 1.360754 0.519915 1.303274 0.114440 0.486440 1.248641 -0.062831 1.818237 1.003329 1.774020 0.995383 0.217514 0.236196 0.918414 0.251978 0.240543 1.203872 1.193015 1.546847 0.668684 0.276657 0.720261 0.041331 0.124685 1.052830 -0.470877 1.036338 0.454033 1.208580 1.059685 0.252464 0.910634 -0.469687 1.282886 1.260566 1.714177 0.148852 1.558794 0.117249 1.208112 1.206944 1.379709 1.280227 -0.397300 1.912745 1.609055 0.469506 1.102260 0.207876 1.456855 1.808614 1.436770 0.080959 1.197513 1.183739 1.574767 0.068412 1.162064 0.609158 0.566278 1.029997 1.123257 -0.210554 1.006729 1.012851 0.184672 1.531574 1.788773 1.233395 0.609493 0.767948 1.753741 1.423961 0.953617 0.300031 0.940377 0.324215 0.472402 0.042965 0.104811 0.217444 1.091263 1.136923 1.660947 0.519559 1.199475 -0.360436 1.523678 1.224456 -0.014998 1.278905 -0.475457 -0.462757 0.028990 0.974163 1.009397 0.422500 0.343570 0.466660 0.909671 0.746952 -0.297506 0.078048)
)
;;; 117 all -------------------------------------------------------------------------------- ; 10.8167
-#(117 14.857519237248 #(0 1 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 1 0 1 0 1 0)
- 14.522986412048 #(0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1)
- 14.136 #(0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1)
+(vector 117 14.136 (fv 0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1)
- 10.804171 #(0.000000 1.397559 1.239411 1.615753 -0.003930 1.541219 1.291021 -0.377953 0.183588 0.809737 0.245675 -0.553408 0.482251 1.585823 0.488860 1.253783 1.574823 0.499736 0.596522 0.975824 0.291458 1.043907 1.422732 1.854867 -0.149003 0.862345 1.591872 0.966728 0.796385 1.582039 -0.292572 0.192147 1.573777 1.111959 -0.254357 1.424309 0.260578 0.599627 0.579979 0.044774 0.120367 0.136159 0.198275 1.920139 -0.029505 0.183136 1.649622 0.347537 0.003072 1.816571 1.470549 1.285876 1.660711 0.075627 0.908371 0.855107 0.580940 -0.277202 1.484935 0.822956 -0.273741 1.873558 0.262911 1.068013 0.257136 1.332133 0.710052 1.550371 0.969373 0.795449 0.599229 0.829620 1.586418 0.485539 1.602141 1.538643 1.137990 1.126091 1.642791 0.432012 -0.194952 1.263220 1.620927 0.817646 0.222403 0.050865 0.297286 1.773739 1.048641 1.030847 0.788208 1.131228 1.468194 1.384829 -0.138296 0.801985 -0.125165 -0.173882 0.777335 -0.236295 0.784049 1.306230 0.311558 1.468208 0.590452 1.017357 0.981404 -0.109689 -0.023511 1.245194 0.550061 0.349431 -0.456318 0.730891 1.165529 0.091302 0.939475)
+ 10.740323 (fv 0.000000 1.376267 1.204802 1.617264 0.013985 1.562933 1.297010 -0.381289 0.175690 0.812406 0.271907 -0.572032 0.505210 1.569967 0.483045 1.266493 1.587294 0.516881 0.600232 0.990644 0.302416 1.037870 1.417076 1.853643 -0.147420 0.890223 1.567662 0.981809 0.815941 1.608390 -0.281550 0.201337 1.556451 1.125175 -0.236163 1.445336 0.258466 0.600771 0.570165 0.048623 0.131732 0.130088 0.167451 1.924952 -0.030799 0.148010 1.615329 0.361965 0.025922 1.817684 1.449080 1.328054 1.692177 0.082231 0.922069 0.868297 0.602630 -0.302067 1.498947 0.796296 -0.211597 1.912831 0.263824 1.087462 0.264795 1.339326 0.746964 1.555264 0.991573 0.792728 0.572734 0.831900 1.561482 0.487864 1.625032 1.584684 1.155708 1.141107 1.673417 0.421621 -0.187613 1.264593 1.627549 0.823098 0.254093 0.097500 0.358549 1.789940 1.103526 1.081236 0.794597 1.136333 1.473853 1.388624 -0.112319 0.798455 -0.090384 -0.176678 0.782426 -0.241572 0.802635 1.296656 0.310053 1.464029 0.628323 1.034158 1.019782 -0.078897 0.005414 1.234988 0.557243 0.357637 -0.491315 0.727622 1.220297 0.073271 0.925087)
)
;;; 118 all -------------------------------------------------------------------------------- ; 10.8628
-#(118 15.151820108516 #(0 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 0)
- 14.496 #(0 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 0 1)
- 14.207115029287 #(0 1 1 1 1 1 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0)
+(vector 118 14.207115029287 (fv 0 1 1 1 1 1 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0)
- 10.831124 #(0.000000 -0.177191 -0.143667 0.023486 0.036074 0.761272 -0.177933 1.639320 0.352295 1.394230 0.881342 1.705932 0.470737 0.075965 1.087272 0.609627 0.282805 0.703038 1.761804 -0.450855 1.253115 0.345582 0.722177 0.261668 1.833631 1.529380 1.426895 1.320094 0.645710 1.426758 1.604268 0.066824 0.694435 0.316134 0.217047 0.555605 0.684926 0.407821 0.627620 1.954085 1.290654 1.270727 1.531201 -0.447491 1.101999 -0.429035 1.102661 0.928332 1.319598 0.357441 1.784038 1.254285 1.228879 1.248950 1.401256 0.030546 1.077097 1.093896 0.126600 1.237914 1.010366 0.638212 1.113582 0.448539 -0.285439 1.508070 1.292662 0.246795 1.535924 0.833149 0.977080 0.550907 0.156585 1.040425 1.099099 0.554581 -0.049455 0.958310 1.035602 0.137284 0.885474 0.986782 -0.027953 1.708251 1.896043 0.752046 1.638059 1.587480 1.011258 1.544050 0.764383 1.513980 -0.228648 0.121097 -0.238014 0.273206 1.257658 1.099787 1.123033 0.216195 1.333412 0.104846 0.659326 -0.111836 1.002384 0.258731 1.031743 -0.278392 1.842065 0.194362 0.644565 1.058447 0.210973 1.059721 1.902099 0.068184 0.790709 1.187466)
+ 10.789998 (fv 0.000000 -0.175913 -0.143823 0.018273 0.027771 0.767311 -0.171214 1.636246 0.351281 1.388337 0.882351 1.707573 0.469183 0.078893 1.085758 0.618150 0.277129 0.703491 1.759709 -0.452169 1.251866 0.357896 0.724274 0.269975 1.838904 1.530293 1.426834 1.312699 0.647676 1.426356 1.595332 0.060341 0.690735 0.318521 0.226388 0.557313 0.682546 0.405400 0.629229 1.956450 1.295086 1.263226 1.531833 -0.446064 1.088083 -0.430622 1.100111 0.930366 1.309892 0.353356 1.791502 1.255481 1.229378 1.253262 1.406532 0.024314 1.063085 1.088221 0.123383 1.238746 1.005923 0.642418 1.110925 0.453476 -0.290616 1.496832 1.287503 0.244996 1.530267 0.834163 0.976178 0.556214 0.154839 1.049337 1.096181 0.549254 -0.047077 0.951697 1.030491 0.147772 0.888048 0.978379 -0.017946 1.704759 1.894288 0.751630 1.629711 1.581497 1.015790 1.546094 0.769995 1.519488 -0.226811 0.116498 -0.232287 0.274508 1.259352 1.098443 1.128583 0.216589 1.343006 0.117206 0.662844 -0.110291 1.010752 0.251673 1.029907 -0.274450 1.835049 0.199877 0.646328 1.080725 0.210236 1.055491 1.898124 0.072310 0.796446 1.191135)
)
;;; 119 all -------------------------------------------------------------------------------- ; 10.9087
-#(119 15.63721370697 #(0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0 0 1 0 1 0 1)
- 14.803846337507 #(0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0 0 1 0 1 0 1)
- 14.502624011553 #(0 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0)
+(vector 119 14.502624011553 (fv 0 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0)
+
+ 10.894037 (fv 0.000000 0.630386 0.843125 1.285949 0.340650 -0.017357 0.327019 1.384996 1.081793 1.397782 0.680727 0.599720 0.760758 1.651799 1.943215 0.601150 0.438753 0.220032 0.283706 0.321338 1.848806 -0.818805 1.279239 0.233383 -0.265065 0.149488 0.866113 1.211455 -0.153192 1.086507 -0.117739 0.108345 0.296077 0.924788 0.407609 0.257469 1.108157 0.337516 1.501434 -0.160734 0.937661 1.194914 0.677862 1.064411 -0.083066 0.280209 0.164734 0.604351 1.488726 0.546557 -0.173942 0.258452 -0.144704 1.931749 1.121694 0.070973 1.246077 0.433607 -0.015989 1.447158 1.307009 0.290513 1.032586 0.483509 0.866614 0.896091 0.118763 0.703456 1.160811 -0.272718 1.618947 0.922379 0.186934 0.444686 0.391527 -0.170445 0.686201 0.072390 -0.083273 0.261424 1.315326 1.343146 -0.078550 0.581799 0.100158 0.342044 0.531455 0.823995 0.311378 0.398507 -0.067564 1.021721 0.099971 0.375472 1.694822 -0.129069 0.760774 0.760279 0.907128 1.373425 1.265414 0.699858 -0.214864 -0.228584 1.101084 1.533737 1.209100 1.477560 0.508584 0.989498 0.862450 0.271802 1.549833 0.881136 1.017209 0.041014 1.240632 1.019564 1.718786)
- 10.923606 #(0.000000 0.626057 0.846306 1.290647 0.337731 -0.013242 0.320675 1.382219 1.073378 1.398733 0.681322 0.602560 0.766871 1.657066 1.942923 0.600115 0.437757 0.221744 0.284958 0.317065 1.848928 -0.815570 1.278358 0.232050 -0.264028 0.152061 0.867717 1.215223 -0.154048 1.083037 -0.116333 0.112342 0.296975 0.922704 0.407857 0.255163 1.107610 0.339935 1.500238 -0.161453 0.939141 1.186773 0.672141 1.060979 -0.078633 0.283990 0.164429 0.607721 1.483764 0.541174 -0.179690 0.260292 -0.147996 1.935747 1.129189 0.065241 1.239774 0.425038 -0.009061 1.451641 1.302898 0.288198 1.030913 0.480304 0.860293 0.901726 0.121643 0.708829 1.158601 -0.261482 1.618095 0.920095 0.188454 0.454453 0.389031 -0.172507 0.684159 0.062703 -0.093201 0.257359 1.320270 1.345892 -0.087769 0.576242 0.094643 0.338442 0.518971 0.818066 0.308207 0.397865 -0.075499 1.028596 0.106242 0.378021 1.692159 -0.128748 0.762397 0.756911 0.903837 1.369073 1.275388 0.698582 -0.214815 -0.232929 1.091942 1.536056 1.207392 1.480121 0.521118 0.978689 0.861476 0.270888 1.546102 0.879377 1.013764 0.038438 1.227226 1.029455 1.715721)
+ ;; pp:
+ 10.835933 (fv 0.000000 0.654099 1.035661 1.681354 0.271205 0.793039 1.296335 0.060400 0.653112 1.232942 1.881379 0.620355 1.199841 0.014260 0.823834 1.413032 0.189484 0.947478 1.588848 0.403300 1.280378 0.215388 1.137801 1.956237 0.732861 1.657436 0.792204 1.789188 0.703767 1.598762 0.539735 1.541253 0.421443 1.469357 0.779053 -0.021286 1.026341 0.083226 1.233425 0.357509 1.441485 0.752264 1.858411 1.012419 0.073105 1.341491 0.748507 0.322726 1.533912 0.715880 0.027861 1.454725 0.694006 -0.082536 1.358750 0.823835 0.158492 1.802363 1.289166 0.871603 0.288280 1.653699 1.258131 0.754564 0.197129 -0.135159 1.406727 1.305489 0.902560 0.505625 0.165621 1.980298 1.711088 1.181402 1.035732 0.515951 0.573196 0.077979 0.369360 -0.029664 0.027976 1.710591 1.639472 1.419449 1.489927 1.072898 1.080212 0.909135 0.903629 1.096948 0.947039 1.126463 1.358955 0.953854 1.137457 1.170488 1.431020 1.393091 1.493097 1.708464 0.028863 0.359918 0.447603 0.693507 1.013920 0.980939 1.193095 1.522944 -0.124582 0.421795 0.849849 1.081289 1.559178 0.036966 0.454552 0.747770 1.437228 1.496079 0.068555)
)
;;; 120 all -------------------------------------------------------------------------------- ; 10.9545
-#(120 14.761 #(0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1)
- 14.534638752286 #(0 0 0 0 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0)
+(vector 120 14.534638752286 (fv 0 0 0 0 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0)
- 10.916008 #(0.000000 1.762456 1.430243 0.658574 0.093948 0.678155 1.323078 0.556956 0.077943 1.892328 0.975370 0.234280 0.032617 1.871869 0.115198 0.805855 1.699877 0.189431 0.348950 1.321142 0.129360 0.625569 -0.294761 -0.172172 0.423101 1.482760 -0.236118 0.325919 -0.372530 1.705599 0.942459 0.924815 1.724436 1.323928 1.330261 0.319165 1.343880 0.102779 0.693949 0.027626 -0.055943 1.336222 -0.012341 1.696838 0.251357 -0.177390 1.467773 1.712411 1.253003 0.728244 1.871539 0.005176 0.028571 0.697340 1.533550 0.479721 1.105008 0.659761 1.219994 0.634356 0.378939 0.379969 0.089099 0.806225 0.435232 0.297385 0.944344 -0.113250 -0.112976 1.184459 1.267911 0.984877 0.236791 0.776059 1.628297 -0.280880 -0.185549 0.619327 0.088649 1.403395 0.487284 -0.293748 1.289622 1.729692 1.583033 1.189970 0.277255 0.233654 1.439790 0.585511 1.522538 0.608560 0.877556 1.435403 1.062321 0.936175 1.263195 0.013496 -0.130056 0.103453 1.394278 1.180831 1.829650 1.738980 0.231074 0.366475 0.654407 -0.129063 0.090650 0.078012 0.691369 1.077528 1.070609 -0.154115 1.072520 -0.216235 0.134775 -0.209785 0.460495 1.364244)
+ 10.877907 (fv 0.000000 1.760966 1.432317 0.661698 0.093764 0.677833 1.324379 0.560678 0.084000 1.893101 0.982568 0.231983 0.030976 1.869849 0.114160 0.803943 1.697252 0.187259 0.348967 1.325837 0.129934 0.628168 -0.292961 -0.172670 0.424548 1.491809 -0.230282 0.327899 -0.371234 1.709483 0.949653 0.922124 1.730156 1.323261 1.332457 0.313981 1.342414 0.100580 0.697678 0.026744 -0.054235 1.341652 -0.009876 1.698348 0.248931 -0.183551 1.470018 1.710913 1.251473 0.727247 1.872729 0.011341 0.025061 0.694946 1.531659 0.478715 1.097259 0.657341 1.219034 0.633776 0.382770 0.377028 0.092620 0.800796 0.434789 0.301288 0.942251 -0.118601 -0.116547 1.180657 1.270834 0.986907 0.237837 0.780073 1.628870 -0.280374 -0.194405 0.622013 0.090032 1.411166 0.490814 -0.298299 1.291149 1.730249 1.587675 1.193266 0.285035 0.236562 1.437795 0.582458 1.521211 0.605547 0.877830 1.441130 1.061898 0.936396 1.257893 0.016398 -0.126771 0.102714 1.392810 1.183106 1.832099 1.740994 0.232560 0.367779 0.656921 -0.130561 0.093991 0.079826 0.694300 1.076720 1.076648 -0.154506 1.074489 -0.219932 0.141670 -0.212932 0.458505 1.362796)
)
;;; 121 all -------------------------------------------------------------------------------- ; 11
-#(121 14.765577345045 #(0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0)
- 14.619540214539 #(0 1 0 1 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
- 14.286643427331 #(0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
- 14.184466362 #(0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
+(vector 121 14.184466362 (fv 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
- 10.962963 #(0.000000 1.016187 1.328268 0.695857 0.491085 0.313246 0.183769 1.319303 0.942703 -0.064359 1.472742 1.209909 0.458283 1.621544 1.350734 0.350141 1.538224 1.154613 0.658478 1.752199 0.882719 0.681955 0.343685 0.637943 0.244582 0.050419 1.685690 0.609598 -0.647371 1.581936 1.420145 1.294575 0.373670 1.683851 1.336970 1.100816 0.421298 0.178681 0.670362 0.746146 1.347261 0.605669 0.951364 1.721079 0.108254 1.761710 1.761823 0.677696 0.702746 0.916374 1.294937 1.672015 -0.006289 1.669596 1.423136 0.535159 1.064444 0.078769 -0.156423 1.670301 -0.267871 1.600958 0.220626 0.484680 0.667196 0.100949 0.260553 0.317489 0.370227 0.520002 1.214555 1.202884 0.773413 0.205134 0.776796 0.974992 -0.215350 0.704937 0.287636 1.833722 0.465298 1.902880 0.967827 0.016237 1.246735 1.351954 0.479598 0.836059 1.141038 1.670094 0.766338 -0.073141 0.463941 1.322888 1.045222 1.739348 0.813628 0.775259 1.028349 0.077559 0.791507 1.360037 0.705295 0.074227 0.583796 0.514730 1.211643 0.843018 0.582362 0.859488 1.813707 1.063860 0.160524 0.767772 -0.156317 0.239454 0.295516 0.311025 1.297427 0.196429 0.580906)
+ 10.924906 (fv 0.000000 1.021993 1.334449 0.689448 0.491891 0.317117 0.185100 1.316740 0.942417 -0.055518 1.467945 1.216575 0.460144 1.613483 1.346938 0.351666 1.534737 1.166463 0.663385 1.751743 0.887304 0.686057 0.353407 0.640903 0.247744 0.051185 1.683771 0.607042 -0.642997 1.586265 1.428130 1.293714 0.376348 1.687396 1.342115 1.114987 0.421788 0.173805 0.664896 0.744172 1.338635 0.611663 0.948619 1.727026 0.108093 1.757613 1.759583 0.684030 0.701845 0.897975 1.291554 1.678993 -0.010218 1.672340 1.419180 0.531998 1.055064 0.071044 -0.158722 1.660752 -0.273616 1.601063 0.212433 0.488138 0.674057 0.101023 0.258204 0.323292 0.370652 0.521650 1.206457 1.206236 0.768851 0.204856 0.771378 0.971274 -0.207666 0.711434 0.295654 1.831769 0.464965 1.896472 0.968538 0.024673 1.250922 1.351355 0.486851 0.833273 1.147617 1.669210 0.770997 -0.072413 0.463363 1.323688 1.050580 1.732192 0.819244 0.777660 1.040697 0.078135 0.787038 1.358361 0.700196 0.074501 0.587042 0.515371 1.216302 0.852496 0.581485 0.849691 1.814480 1.077357 0.162962 0.766524 -0.151640 0.240975 0.296067 0.314628 1.286198 0.210485 0.583580)
)
;;; 122 all -------------------------------------------------------------------------------- ; 11.0454
-#(122 14.800878258504 #(0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0)
- 14.536 #(0 1 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0)
+(vector 122 14.536 (fv 0 1 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0)
- 10.987538 #(0.000000 1.707675 0.118424 0.692107 1.244611 1.255987 -0.204796 0.408468 1.203568 1.273710 0.642733 1.289840 1.782851 0.038929 1.156689 1.159593 1.690866 1.499976 0.999155 1.434522 1.725134 0.879479 0.377659 1.618844 0.126958 1.151664 1.079945 0.462237 1.103609 1.528663 1.421241 0.715357 0.757081 0.293063 1.145093 0.686861 0.064077 0.475186 1.091447 0.424873 1.085795 0.492984 0.935310 1.658200 0.464801 0.979736 0.373632 1.451416 1.600503 -0.405495 0.540621 1.732049 0.050578 1.197514 0.535158 0.740518 1.586690 -0.029336 0.026947 0.994604 0.348181 -0.037835 1.294017 0.192714 0.605800 1.007931 0.910579 1.100617 1.288860 0.927339 1.421030 1.311349 1.823095 0.254175 0.988652 0.676299 0.637797 0.445776 1.498975 0.533477 1.180443 0.518851 0.129394 1.069455 1.973248 0.741477 1.232787 1.283707 1.633382 -0.057943 1.205125 1.262821 1.056176 0.852632 1.193732 0.872135 -0.315497 0.467194 0.077376 0.418059 1.324337 1.928188 1.583897 1.253637 -0.171672 -0.891732 0.382156 0.206653 0.284079 1.674804 1.515676 0.760634 1.658872 0.755304 0.237011 -0.133745 1.687144 -0.342286 0.867657 -0.096244 1.096351 0.945948)
+ 10.949841 (fv 0.000000 1.704153 0.121290 0.688837 1.244030 1.262068 -0.197896 0.413249 1.197451 1.272156 0.642587 1.292432 1.783982 0.043702 1.158291 1.164647 1.692639 1.493672 1.007369 1.436042 1.725774 0.880017 0.375925 1.616969 0.128447 1.149978 1.084930 0.463608 1.105848 1.530070 1.424718 0.719589 0.763768 0.288678 1.156946 0.691396 0.064365 0.469636 1.091974 0.426323 1.090313 0.491849 0.938048 1.656418 0.459182 0.976494 0.376276 1.451323 1.601769 -0.407170 0.538990 1.732338 0.050678 1.192103 0.536699 0.739148 1.592439 -0.026377 0.032581 0.995911 0.348311 -0.030558 1.293098 0.192261 0.610689 1.016189 0.912642 1.102218 1.291663 0.930392 1.417016 1.312774 1.826696 0.250091 0.993926 0.681381 0.628174 0.441959 1.489842 0.532045 1.179384 0.517873 0.125155 1.064841 1.980073 0.744857 1.235778 1.280286 1.634199 -0.058763 1.206383 1.265460 1.054717 0.853628 1.196638 0.872935 -0.314369 0.468836 0.081998 0.420778 1.325508 1.934649 1.587718 1.251054 -0.176641 -0.893762 0.381112 0.198904 0.283702 1.674181 1.521739 0.754893 1.659031 0.756575 0.235790 -0.129516 1.697508 -0.350053 0.868125 -0.095111 1.099831 0.951722)
)
;;; 123 all -------------------------------------------------------------------------------- ; 11.0905
-#(123 15.175 #(0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 1 0 1)
- 15.041822824398 #(0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 1 0 1)
- 15.006 #(0 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 1 0 1)
- 14.80501968131 #(0 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 1 0 1)
- 14.67458183944 #(0 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 1 0 1)
+(vector 123 14.67458183944 (fv 0 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 1 0 1)
- 11.126787 #(0.000000 -0.092286 0.501049 0.850192 1.262921 0.050126 -0.139532 1.228899 0.772759 -0.394860 1.195859 0.021190 0.215619 0.185299 1.201284 1.845531 1.295176 1.296761 0.819873 1.901284 0.129555 0.228428 0.846389 1.342636 0.173969 -0.082520 1.372159 0.993857 0.854662 -0.355894 -0.076404 -0.220993 1.682071 1.041210 1.130829 0.303012 0.514157 1.792896 -0.098517 0.651144 1.568973 1.325382 0.671024 -0.215979 1.546324 0.620731 0.864601 0.166782 -0.038673 1.043243 0.815914 1.106574 1.734814 0.008686 1.055810 0.652427 1.855506 0.175975 0.629131 0.406484 -0.029306 1.549816 1.408359 -0.069892 1.596593 0.355540 -0.071254 0.295815 0.434380 -0.151241 -0.071882 0.230404 1.154471 0.044698 -0.178034 1.804197 1.246532 1.458639 1.255263 1.064255 -0.006885 1.160658 1.839831 -0.101315 1.041313 0.123224 1.381469 0.240363 0.809533 -0.253630 1.705073 0.557138 0.096101 0.550294 -0.023574 0.507018 1.849910 1.276843 0.277263 0.329365 0.989490 0.072371 0.948936 1.383002 1.150425 1.393149 0.620880 1.518104 0.868131 0.464452 0.788557 1.756859 0.737428 -0.163471 0.113770 0.775766 1.371711 1.066708 1.252256 1.261840 1.189416 -0.049162 -0.316517)
+ 11.089811 (fv 0.000000 -0.095705 0.502046 0.843201 1.262416 0.051297 -0.136069 1.229943 0.769550 -0.394544 1.202311 0.030935 0.212789 0.180234 1.202646 1.847334 1.298798 1.298567 0.826116 1.899995 0.130966 0.229988 0.849236 1.354957 0.175337 -0.090289 1.376955 0.986456 0.858952 -0.348674 -0.073167 -0.218495 1.696358 1.036669 1.130688 0.308330 0.510630 1.786938 -0.105214 0.654929 1.564764 1.314058 0.677163 -0.213165 1.538085 0.616182 0.862650 0.165337 -0.034200 1.035704 0.813627 1.106006 1.740931 0.014126 1.052235 0.657556 1.858826 0.165758 0.630519 0.409633 -0.040211 1.543795 1.391268 -0.071463 1.608090 0.360070 -0.066709 0.298864 0.437480 -0.144723 -0.061475 0.229100 1.150525 0.049068 -0.178297 1.796933 1.253507 1.460767 1.254789 1.053122 -0.014640 1.158719 1.833281 -0.100606 1.043660 0.125118 1.383020 0.234098 0.814218 -0.263454 1.710640 0.541462 0.096383 0.540963 -0.022417 0.505975 1.860187 1.286017 0.269581 0.338845 0.988364 0.065927 0.952682 1.381585 1.156408 1.384314 0.622434 1.536785 0.876899 0.457680 0.787662 1.764741 0.741434 -0.166817 0.104157 0.779344 1.374068 1.055092 1.250202 1.254085 1.185506 -0.050283 -0.314919)
+
+ ;; pp:
+ 11.016135 (fv 0.000000 0.647630 1.074276 1.756268 0.251422 0.804135 1.421127 0.040524 0.665959 1.111755 1.848209 0.635476 1.226811 0.078653 0.744267 1.473903 0.238865 0.830996 1.602610 0.483888 1.291535 0.032720 0.918740 1.769630 0.682055 1.658606 0.644590 1.383351 0.360438 1.331009 0.396705 1.499558 0.394585 1.332297 0.284286 1.367163 0.697156 1.873754 1.072911 0.259822 1.429562 0.401628 1.434105 0.713387 0.052744 1.073687 0.172805 1.418890 0.502359 0.008598 1.451186 0.715950 -0.032063 1.332938 0.645483 -0.170523 1.375389 0.799087 0.277881 1.623936 1.051516 0.728226 0.326139 1.759949 1.287776 0.814001 0.247394 -0.079677 1.277221 1.247278 0.815434 0.548501 0.120625 1.806890 1.668828 1.491775 0.975860 0.670802 0.343501 0.107101 -0.116370 1.739084 1.782173 1.584916 1.517015 1.084964 1.270093 0.937194 1.142225 0.603049 0.902612 0.582213 0.697513 0.723238 0.854795 0.946568 1.173389 0.894182 1.104017 0.982296 1.332899 1.077929 1.505566 1.771677 1.766832 0.125556 0.284805 0.740017 0.785432 0.946551 1.254134 1.343675 1.825955 0.281285 0.688963 0.928919 1.510642 0.002528 0.243797 0.692027 1.356775 1.422418 -0.003671)
)
;;; 124 all -------------------------------------------------------------------------------- ; 11.1355
-#(124 15.808239936829 #(0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 0 1)
- 15.141 #(0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 0 1)
- 14.607 #(0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1)
+(vector 124 14.607 (fv 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1)
- 11.113276 #(0.000000 0.150349 1.687168 0.686722 1.002129 0.904830 0.512753 0.231044 1.633778 0.165444 0.131082 -0.009463 -0.051376 0.895475 0.978698 0.036022 0.431144 0.969255 1.306772 0.929516 0.238612 1.335083 0.055205 -0.005629 1.065739 0.430818 1.394091 0.543358 1.474987 -0.648783 1.630652 0.613383 0.456106 0.359335 0.204682 1.440728 -0.289928 1.020458 1.382536 1.363728 0.381113 0.749121 0.300187 0.250749 0.726141 0.906755 0.493365 0.379091 1.440507 0.492097 1.483192 1.306819 0.999370 -0.128573 0.924081 1.798204 0.163042 0.305971 0.423767 0.676567 1.774988 0.972052 -0.018587 1.342316 0.137094 0.040777 -0.111042 1.521509 0.134953 1.860316 0.907893 1.307383 0.015040 0.767541 1.191474 0.674863 1.200153 0.349057 0.595111 -0.400975 1.457212 1.665209 1.371979 0.539811 1.129530 1.861823 -0.459633 -0.450081 0.671015 1.827788 1.548099 0.606141 1.101005 0.216575 0.459182 0.188577 1.090380 0.500589 1.274723 1.686028 0.193030 0.670432 0.543978 1.352992 -0.322543 0.235777 0.194799 1.734684 0.767590 0.275109 -0.395861 1.007844 0.636979 0.536447 0.773714 1.277690 0.740911 0.764043 0.888021 1.338312 0.633944 1.098030 0.597966 0.495429)
+ 11.060270 (fv 0.000000 0.155441 1.710148 0.675606 0.991885 0.930398 0.521431 0.244313 1.630742 0.168790 0.137270 0.000305 -0.043062 0.897696 0.964832 0.045064 0.425268 0.964217 1.290413 0.929170 0.235812 1.335949 0.057667 0.001006 1.068524 0.446791 1.393120 0.549817 1.466180 -0.642251 1.637204 0.595543 0.457077 0.355722 0.196249 1.437718 -0.302241 1.024336 1.392207 1.340742 0.398137 0.737820 0.315317 0.261053 0.730496 0.895111 0.489074 0.360451 1.441085 0.496392 1.486058 1.322042 1.007323 -0.126599 0.931744 1.784266 0.161232 0.306266 0.415406 0.681040 1.790701 0.980642 -0.005904 1.343074 0.136975 0.027551 -0.124807 1.525812 0.151673 1.852354 0.924568 1.280951 0.029602 0.736180 1.201925 0.667470 1.226105 0.326690 0.609507 -0.393588 1.467285 1.671123 1.358186 0.541731 1.122604 1.867616 -0.473631 -0.417534 0.660754 1.837680 1.546497 0.596764 1.110785 0.215660 0.434300 0.180279 1.110604 0.505631 1.274765 1.668673 0.193680 0.673308 0.543007 1.365849 -0.310522 0.237117 0.174423 1.731063 0.766964 0.281277 -0.402143 0.989963 0.637238 0.526844 0.787012 1.257855 0.717061 0.758671 0.882050 1.342356 0.626910 1.083549 0.608055 0.472324)
)
;;; 125 all -------------------------------------------------------------------------------- ; 11.1803
-#(125 15.546414800183 #(0 0 0 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0)
- 14.985 #(0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0)
+(vector 125 14.985 (fv 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0)
+
+ ;; 11.16794
+ 11.160786 (fv 0.000000 1.015332 1.208067 1.409127 0.622612 0.043137 0.789070 0.545823 0.370412 0.925346 1.157620 0.165772 1.424901 0.898702 1.656211 0.988303 1.801194 1.470568 1.745983 0.609307 -0.597689 0.731241 -0.142723 0.984230 0.073162 1.875752 0.335696 1.602183 0.142368 0.017160 0.448032 0.120103 0.041279 0.523055 0.073650 1.053879 -0.306921 1.513911 1.101021 1.602539 -0.121119 0.641316 -0.004631 1.595461 1.743817 0.418939 0.589672 1.179156 0.811957 1.197450 1.342788 1.287174 1.574681 1.241671 0.609625 0.929510 0.079585 0.612922 1.100363 0.431650 -0.459913 0.120058 0.264463 0.028955 1.140993 0.787792 1.007154 0.514281 1.114045 1.286846 1.241625 0.916235 0.449091 1.255016 0.869776 0.016192 1.421914 1.225032 1.302610 0.650162 0.956126 0.761196 -0.213826 0.222275 -0.426223 1.123082 0.506980 1.405113 0.081703 0.828457 1.262806 1.843366 0.399948 0.473729 -0.529905 1.215838 1.003418 1.687511 0.432881 1.055890 1.071502 1.087648 0.147867 -0.002533 0.317269 1.612891 -0.180768 1.003458 1.820527 0.761821 1.137143 0.352919 -0.090034 1.456553 0.819912 0.115658 0.246973 0.936701 1.319554 0.851128 1.479387 0.046130 1.488656 0.854373 0.867709)
- 11.195865 #(0.000000 1.021920 1.213922 1.412814 0.623528 0.049287 0.793116 0.543725 0.365739 0.929596 1.163985 0.173749 1.431422 0.899649 1.648754 0.998033 1.812611 1.470158 1.753067 0.611812 -0.592058 0.738308 -0.138440 0.986469 0.074520 1.876464 0.337635 1.602466 0.143205 0.020024 0.445537 0.127764 0.042835 0.521149 0.070999 1.057792 -0.294843 1.510062 1.102509 1.588227 -0.112524 0.633735 -0.002527 1.593295 1.747538 0.416766 0.591786 1.180764 0.809003 1.199323 1.339394 1.279012 1.581324 1.252799 0.606375 0.934502 0.092564 0.615518 1.099111 0.438053 -0.448943 0.118369 0.251777 0.031029 1.133877 0.792369 0.996565 0.513109 1.108088 1.292142 1.239230 0.926827 0.448829 1.254511 0.878406 0.024836 1.413162 1.226671 1.307269 0.657832 0.953757 0.760666 -0.213400 0.215583 -0.434012 1.127338 0.508554 1.402876 0.083689 0.816045 1.259696 1.848525 0.401421 0.468027 -0.520160 1.206553 1.008266 1.681941 0.432260 1.039271 1.067225 1.090362 0.148858 -0.004758 0.328380 1.599455 -0.176949 0.996464 1.819798 0.759919 1.129128 0.356962 -0.085875 1.450604 0.824682 0.121943 0.243354 0.927450 1.324140 0.850099 1.481520 0.051627 1.497099 0.859325 0.867939)
+ ;; pp.scm:
+ 11.105486 (fv 0.000000 0.668250 1.004851 1.665604 0.270207 0.823031 1.317389 1.895775 0.442735 1.092420 1.706335 0.316469 1.053513 1.851731 0.426377 1.214568 0.111950 0.768130 1.567897 0.318224 1.096474 0.028789 0.851033 1.730934 0.518266 1.394840 0.485490 1.534760 0.346603 1.302654 0.195595 1.075240 0.149474 1.131730 0.186045 1.296000 0.352391 1.439364 0.663850 1.837274 0.958873 0.121068 1.316333 0.242865 1.517748 0.747235 1.882566 1.040766 0.534079 1.729417 0.993163 0.496721 1.811700 1.002981 0.317419 1.678987 0.959753 0.256596 1.817235 1.299690 0.756280 0.292629 1.822282 1.254136 0.905795 0.232927 1.675869 1.252625 0.924210 0.377830 0.081344 1.650592 1.565111 1.210398 0.823930 0.495597 0.170992 -0.097351 1.629713 1.238397 1.141529 0.804262 0.860680 0.603481 0.666502 0.428034 0.395443 0.132689 1.849680 0.035737 1.395931 1.824957 1.358060 1.651982 1.606952 1.718179 1.670215 1.887548 1.688422 1.844666 -0.292284 0.050366 -0.101906 0.075572 0.305815 0.606639 0.913420 1.030088 1.512470 1.549064 1.827384 0.007726 0.106419 0.461039 0.753337 1.221334 1.792974 0.097112 0.617097 1.170484 1.176316 1.664541 0.165974 0.635539 1.022624)
+
+ ;; pp1:
+ 11.114689 (fv 0.000000 0.681978 1.028261 1.706912 0.292133 0.848775 1.343922 1.911777 0.451105 1.069054 1.693074 0.301918 1.035579 1.825832 0.435611 1.230581 0.111624 0.750696 1.574421 0.321180 1.071098 -0.013053 0.852483 1.783026 0.524168 1.371392 0.475241 1.562570 0.337915 1.270461 0.221125 1.100498 0.123076 1.107894 0.160645 1.270692 0.306224 1.479440 0.658107 1.838424 0.945824 0.091726 1.332313 0.238983 1.552958 0.749521 1.839061 1.045392 0.486297 1.712081 0.982243 0.539957 1.767541 0.934362 0.293124 1.675620 0.993763 0.206674 1.792070 1.270778 0.729123 0.284390 1.801314 1.282266 0.918468 0.252050 1.650401 1.232066 0.903570 0.313672 0.087588 1.657912 1.543341 1.232872 0.839991 0.464849 0.196039 -0.147366 1.653544 1.258396 1.123045 0.770121 0.900031 0.618800 0.692026 0.397188 0.475351 0.152075 1.894219 0.030184 1.418582 1.854056 1.299662 1.631587 1.652019 1.730754 1.687797 1.916199 1.730490 1.823361 -0.277080 0.063403 -0.121338 0.021902 0.284828 0.586626 0.860176 0.999715 1.490642 1.510249 1.792225 0.008814 0.113621 0.391836 0.733891 1.237143 1.809005 0.128227 0.638952 1.175937 1.156619 1.663599 0.187027 0.654280 1.021025)
)
;;; 126 all -------------------------------------------------------------------------------- ; 11.224972
-#(126 15.477880483871 #(0 0 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 0 1 0 1)
- 14.898634217167 #(0 0 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 1 0 1)
- 14.722991453869 #(0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
- 14.67419786533 #(0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
+(vector 126 14.67419786533 (fv 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
- 11.184211 #(0.000000 0.899014 0.372342 1.290085 0.770095 0.860102 1.614945 1.741025 1.950258 0.839235 -0.089458 1.702904 0.328500 0.831125 -0.114673 0.080345 1.000469 0.927576 1.331249 0.404112 1.472037 0.865423 0.734309 0.285645 0.614583 0.941442 0.873479 0.130149 0.100696 0.034919 0.338572 1.697468 1.193246 1.203134 1.019094 0.866629 0.775318 0.514482 1.281837 0.986098 0.200002 0.684619 0.584690 1.229049 0.836369 0.879432 1.322367 1.207527 -0.037322 1.275811 0.561087 0.323996 0.895336 0.127263 0.361921 1.405186 1.385996 1.052467 1.086029 0.695197 1.265141 1.109967 1.321493 0.551214 1.768537 1.419209 1.188657 1.413655 0.263582 0.467913 0.362775 0.620863 1.835645 -0.006371 0.889515 0.178901 -0.164681 0.467832 0.845274 0.102569 0.482809 0.764304 0.174879 0.506344 1.310783 1.829888 0.518214 0.137714 1.279309 1.028273 -0.049709 1.655742 1.725339 0.164196 0.998319 1.525337 0.931168 1.604252 1.538530 -0.675449 0.142296 0.125534 0.516257 -0.140693 1.028632 1.051002 0.843418 0.158765 1.018529 0.217892 1.385450 0.228685 1.294261 0.066260 0.605215 1.226948 0.025180 1.814526 0.804350 0.778733 1.109888 0.656389 -0.102354 0.142417 1.272296 0.718238)
+ 11.145483 (fv 0.000000 0.899293 0.378495 1.289186 0.777288 0.858338 1.619831 1.737202 1.951674 0.835017 -0.087625 1.707725 0.328507 0.828194 -0.110415 0.084984 1.000160 0.933659 1.329981 0.403112 1.465299 0.867776 0.736209 0.286670 0.614444 0.936369 0.873213 0.123325 0.103437 0.033532 0.337773 1.704277 1.195946 1.204920 1.015411 0.867778 0.772767 0.521662 1.281071 0.987342 0.207100 0.684428 0.579999 1.230109 0.833339 0.874869 1.325709 1.214223 -0.039340 1.273384 0.554903 0.324879 0.897065 0.122734 0.357179 1.405113 1.382262 1.052698 1.093027 0.696151 1.256101 1.113094 1.329670 0.549960 1.774690 1.419208 1.188823 1.415491 0.266597 0.476692 0.360990 0.613975 1.834829 -0.016278 0.893804 0.177235 -0.162182 0.465943 0.846924 0.105182 0.478317 0.762411 0.169998 0.509253 1.306498 1.829812 0.517679 0.137251 1.279904 1.030500 -0.049960 1.650399 1.720514 0.164442 0.994973 1.525343 0.937775 1.609285 1.534911 -0.677300 0.133781 0.129445 0.518965 -0.144758 1.037002 1.052666 0.841376 0.157786 1.034141 0.219735 1.379782 0.222272 1.298276 0.072801 0.604052 1.220954 0.022881 1.817683 0.809301 0.789103 1.114921 0.656136 -0.111384 0.132814 1.271527 0.712891)
)
;;; 127 all -------------------------------------------------------------------------------- ; 11.269427
-#(127 15.59486896452 #(0 1 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 0)
- 14.859080656941 #(0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 1 1 0)
- 14.851 #(0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0)
+(vector 127 14.851 (fv 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0)
- 11.217245 #(0.000000 1.071752 1.247594 0.283408 1.249511 0.288197 1.766808 0.242405 1.154986 1.311423 0.080261 1.853336 1.715482 1.371624 1.050496 -0.394502 0.002328 1.374085 0.296034 1.619920 1.164328 1.747989 1.232137 0.380143 0.350961 0.123127 0.306507 -0.164629 0.015119 1.227611 0.227247 0.374502 0.198981 1.136563 0.213003 1.632493 0.743591 -0.280874 0.637404 0.997556 0.074557 0.740755 1.836845 1.422170 0.645341 0.716460 0.224819 1.629877 0.897560 1.165648 1.172894 0.279185 0.796592 1.896949 0.958200 1.873508 0.212467 0.458664 0.464196 1.418669 1.260647 1.173959 0.215621 0.217681 1.936563 0.847954 1.693897 -0.188804 -0.282054 0.914815 0.424329 1.350212 0.172192 0.583768 0.496518 0.439611 0.014097 -0.061382 0.873295 -0.115773 0.147312 1.759798 1.716865 -0.045494 0.128339 0.278006 0.178578 1.081161 1.088604 1.213950 1.171907 1.385147 -0.189730 0.237145 0.872307 1.583656 1.752460 1.501551 1.246278 0.252761 -0.022893 1.417737 0.772533 0.062359 1.321208 0.616800 1.669021 0.349916 0.559372 1.119609 1.679283 0.494121 1.036757 1.344290 1.285804 1.666563 0.581903 0.499358 -0.039151 0.054002 0.133538 1.507643 0.315981 1.292426 1.416304 0.252229 1.519647)
+ 11.176112 (fv 0.000000 1.071888 1.248428 0.289874 1.246619 0.289572 1.760445 0.245569 1.154033 1.309416 0.081159 1.849794 1.710269 1.368867 1.052576 -0.398246 -0.001522 1.370275 0.292491 1.626710 1.166078 1.755696 1.227481 0.377631 0.354241 0.127104 0.305667 -0.167076 0.018149 1.234977 0.220914 0.373111 0.199191 1.136953 0.209502 1.631334 0.736118 -0.280026 0.637855 0.997502 0.069226 0.738973 1.836372 1.422035 0.641751 0.717645 0.227787 1.627490 0.896625 1.164185 1.181473 0.283052 0.793654 1.893617 0.958053 1.877395 0.211241 0.448741 0.465207 1.415492 1.261864 1.182640 0.217781 0.211053 1.936678 0.848219 1.690040 -0.183682 -0.275325 0.916325 0.426519 1.353568 0.171309 0.590049 0.503441 0.438773 0.014163 -0.062159 0.869887 -0.128424 0.144319 1.756020 1.717018 -0.046012 0.125572 0.279523 0.175456 1.083651 1.091291 1.212635 1.168385 1.392580 -0.189037 0.240170 0.866374 1.580620 1.749254 1.502399 1.243019 0.251600 -0.018231 1.414780 0.773115 0.067214 1.323483 0.617886 1.663914 0.351482 0.571589 1.123483 1.679985 0.501109 1.035832 1.346170 1.289512 1.663306 0.584848 0.500505 -0.031006 0.055228 0.131713 1.510949 0.309811 1.293736 1.414224 0.248635 1.517857)
)
-;;; 128 all -------------------------------------------------------------------------------- ; 11.3137
-#(128 15.689241428851 #(0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1)
- 15.287684641887 #(0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1)
- 15.249417304993 #(0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1)
- 15.138 #(0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1)
+;;; 128 all -------------------------------------------------------------------------------- ; 11.313708498985
+(vector 128 15.138 (fv 0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1)
+
+ 11.309209 (fv 0.000000 1.243323 0.073338 1.687189 1.124666 1.389841 0.847573 1.018728 0.290645 0.447958 0.152825 0.408946 1.554733 1.027824 0.742595 1.417320 1.174719 0.230635 0.137711 0.205770 -0.223930 -0.484352 0.868175 0.460794 0.073208 1.470166 -0.048840 -0.141098 1.057707 1.534980 0.337573 1.200647 1.372018 -0.041548 0.602859 1.849030 -0.103678 0.815675 0.107720 0.796671 0.027496 0.761821 1.113332 0.855622 0.650295 0.713381 0.490023 1.179238 -0.088446 0.282357 -0.437849 1.210715 1.321994 0.443637 1.300839 1.352381 -0.001933 0.442309 -0.088426 0.287664 0.126405 -0.108646 0.637631 0.580452 1.256195 1.182134 1.382836 1.180662 1.171900 0.353945 1.569554 0.076717 1.316852 1.092094 0.641656 0.578236 1.268290 1.296116 0.291194 1.287832 1.351802 0.877933 0.046043 0.135350 0.952936 1.137202 0.623256 -0.396801 0.327118 0.077316 0.800999 0.673083 1.387941 0.952139 1.436716 0.326423 0.697455 0.564179 1.047968 0.663414 0.327317 0.386236 0.415974 0.266450 1.112215 0.646830 0.208505 1.019398 -0.208967 0.964650 0.120229 1.347295 1.011374 1.053660 1.549663 0.688863 1.745386 0.772703 1.031951 0.182902 0.350269 0.873751 1.129081 1.610214 -0.035633 1.365829 0.190640 1.177284)
- 11.351515 #(0.000000 1.246987 0.081181 1.683333 1.136018 1.408927 0.857156 1.005585 0.280769 0.437545 0.165883 0.418543 1.561560 1.029866 0.730044 1.415407 1.161543 0.229720 0.134077 0.214255 -0.219720 -0.486154 0.864302 0.472245 0.065408 1.462225 -0.031094 -0.139645 1.066131 1.528591 0.332142 1.210418 1.371254 -0.025193 0.603292 1.851383 -0.119225 0.813393 0.115971 0.801595 0.016457 0.774260 1.119233 0.862673 0.652800 0.708254 0.490423 1.192398 -0.096752 0.284032 -0.437311 1.205367 1.335015 0.439149 1.295108 1.356658 0.006840 0.440678 -0.089611 0.274708 0.139345 -0.109928 0.652748 0.587200 1.268121 1.188609 1.372817 1.181973 1.178406 0.358253 1.578528 0.072441 1.295888 1.093882 0.648786 0.590375 1.276257 1.306209 0.296137 1.270800 1.359549 0.874950 0.042461 0.149826 0.946559 1.133353 0.621640 -0.396156 0.325030 0.070488 0.814106 0.684269 1.392650 0.961729 1.436073 0.318221 0.704061 0.562211 1.029618 0.662647 0.327287 0.395358 0.410325 0.267355 1.105408 0.664395 0.195760 1.007776 -0.221701 0.973737 0.122875 1.342569 1.027296 1.057143 1.550628 0.675745 1.749529 0.783082 1.049665 0.183599 0.345875 0.898454 1.119510 1.594944 -0.053645 1.385677 0.201214 1.178302)
+ ;; pp:
+ 11.210356 (fv 0.000000 0.529477 1.092204 1.655320 0.240176 0.840083 1.290316 0.036113 0.414482 1.184815 1.733487 0.475904 1.226699 -0.054687 0.544000 1.373024 0.096261 0.605273 1.510542 0.229851 0.972933 -0.008717 0.768966 1.800241 0.536684 1.336088 0.309226 1.164728 0.254148 1.069819 0.021808 0.945032 -0.039508 0.972460 -0.067607 1.002895 0.197048 1.366967 0.351763 1.540663 0.648980 1.698360 0.730857 0.118485 1.274417 0.283223 1.327398 0.691807 0.012365 1.128647 0.533746 1.871605 1.252479 0.321809 1.476722 1.286815 0.557929 1.863054 1.365020 0.715719 -0.012609 1.699347 1.092581 0.354365 -0.098429 1.602411 1.106114 0.622866 0.186170 1.647857 1.109362 0.904818 0.566992 0.283406 1.734276 1.302248 1.135583 0.996099 0.637141 0.319233 -0.334659 -0.051454 1.363705 1.553533 1.027907 1.065457 0.795998 0.486251 0.704843 0.431262 0.496789 0.160271 0.268391 -0.277422 -0.064873 -0.149375 -0.202682 0.078495 -0.086833 -0.064332 0.234996 -0.109719 0.180200 0.196396 0.559877 0.436602 0.563596 0.942230 1.157161 1.450532 1.353287 1.969232 0.307428 0.330752 0.455679 0.656549 1.076389 1.439415 1.817226 0.185723 0.623808 1.021760 1.554273 1.872894 0.258818 0.595831 0.908779 1.816125)
)
-;;; 256 all --------------------------------------------------------------------------------
-#(256 23.353 #(0 0 1 1 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 1)
+;;; 256 all -------------------------------------------------------------------------------- (16)
+(vector 256 23.353 (fv 0 0 1 1 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 1)
- 19.419887 #(0.000000 1.716123 1.732087 -1.159217 -1.111520 -0.968808 -1.435400 -0.980823 -1.916807 -0.777076 -0.006575 -1.146768 -1.413466 -0.191988 -0.866295 -1.754753 -1.834771 -1.414461 -0.004612 -0.668272 -0.899105 -1.045292 -1.394965 0.031304 -1.790029 -0.414595 -0.628926 -0.793341 -0.055059 -1.758819 -1.799745 -0.999573 0.034849 -0.438143 -0.082246 -1.718822 -1.067223 -1.726228 -1.738785 -0.419090 -0.072253 -0.101418 -0.158940 -0.227475 -0.805306 0.102396 -1.029779 -0.944501 -1.627544 -0.240643 -0.800061 -1.852822 -0.736694 -0.374906 -0.992797 -1.321129 -1.165724 -0.132383 -0.296684 0.074652 -0.170663 -1.021946 -0.249235 -0.014896 -1.684156 -0.101483 -1.472567 -1.065248 -0.193000 -1.821851 -1.577478 -0.971415 -1.706313 -0.460547 -0.802154 -1.066096 -0.465880 -1.780964 -0.317180 -1.128696 -1.243327 -1.545720 -0.981842 -1.941220 -1.430454 -0.739300 -0.401708 -0.807818 -0.139664 -1.670340 -0.370514 -0.908540 -1.051026 -0.655448 -0.201175 -1.447197 -1.020563 -0.461820 -0.563775 -0.492581 -1.123348 -0.019694 -0.284015 -0.493247 -1.800533 -0.026879 -1.684265 -0.072889 -1.236206 -1.605481 -0.854278 -0.780460 -1.556451 -0.100281 -1.481863 -1.785235 -0.054386 -1.322733 -1.272196 -0.484418 -0.487202 -0.934744 -0.351935 0.001840 -1.361830 -1.761915 -0.791484 -1.765946 -0.130275 -0.078233 -1.712033 -1.491273 -1.447810 -1.802668 -1.915196 -0.812291 0.020535 -0.059922 -0.115027 -1.741334 -1.716313 -0.574287 -1.796141 -1.411787 -0.352083 -0.219272 -0.492707 -1.281724 -0.237492 -0.661764 -0.251830 -1.447982 -0.928988 -0.834556 -1.105051 -1.600594 -0.610828 -0.521753 -1.538844 -1.739439 -0.438630 0.200255 -1.495825 -0.208613 -1.899242 -0.565203 -0.701498 -0.013982 -0.268393 -0.851043 -1.316608 -1.311782 -1.571398 -0.868046 -0.450718 -1.523921 -1.175122 -1.013090 -0.336313 -0.297343 -0.710311 -0.121169 -0.855768 -0.583293 -1.278840 -1.685639 -0.237176 -1.113655 -0.038017 -0.925030 -0.002618 -1.084014 -0.914850 -1.109784 -1.951680 -0.258074 -1.242904 -1.747165 -1.546773 -0.010135 -0.293716 -0.365165 -0.380179 -1.009365 -0.199175 -0.107143 -0.355342 0.056494 -1.740548 -0.797850 -1.195468 -1.012191 -0.519448 -1.741712 -1.728278 -1.202843 -0.439103 0.018019 -0.505945 -0.712019 -0.888461 -0.466715 -1.884487 -1.110926 -1.377129 -1.412918 -0.283507 -1.736733 -0.423668 -1.180448 -0.750304 -0.826461 -0.252142 -0.607448 -0.795197 -1.729275 -1.937314 -1.775060 0.018302 -1.136763 0.041039 -1.517119 -0.102466 -0.808497 -0.452532 -1.777418 -1.448279 -0.170123 -0.689274 -1.668514 -0.718568 -1.461386 -0.741628 -0.144206 -0.275574 0.275344)
+ 16.061041 (fv 0.000000 0.925796 0.374630 -0.108513 -0.821698 -0.025087 -0.506195 0.298783 0.035173 0.012160 0.459017 0.128871 0.955347 -0.719489 0.827601 0.829509 -0.132131 0.534593 0.213472 -0.471818 -0.764121 0.240055 -0.480081 0.847706 -0.032870 -0.481128 0.761455 -0.211601 0.010004 0.568923 -0.059172 -0.017957 0.170478 -0.613989 -0.042068 -0.938552 -1.012251 0.796792 -0.038645 -0.426760 -0.192132 -0.528083 -0.017037 -0.489368 0.355556 0.515110 0.821955 -0.244212 -0.238511 -0.789603 0.734511 0.783320 0.368778 -0.600810 0.581954 0.316603 0.874508 -1.013265 0.262565 0.824972 0.323390 -0.162260 -0.116223 -0.866816 -0.634726 0.764949 -0.318122 0.145813 0.067938 0.841588 -0.127386 -0.237218 -0.267186 -0.539198 0.835759 -0.143418 0.496218 0.887615 0.191628 0.011726 -0.612239 0.722732 -0.991602 0.938142 -0.612137 -0.577649 0.191369 -0.198359 0.337475 0.755205 0.683654 -0.318641 -0.814741 -0.354751 0.276257 0.469693 0.801805 -0.420187 0.880092 -0.544351 -0.948063 -0.889987 0.198598 -0.517903 -0.352606 -0.663604 -0.191808 -0.767415 -0.712906 0.924699 -0.850674 -0.237297 -0.047403 0.885741 -0.631553 0.768862 -0.094846 0.448006 -0.666459 -0.850386 0.514580 0.225037 0.511035 0.964534 -0.769372 0.838413 0.741093 0.377443 0.167837 0.877026 -0.054752 0.586836 -0.861511 1.030824 -0.288593 -0.124961 0.009157 -0.927185 0.163383 0.645894 -0.013717 -0.492535 -0.082090 0.437620 0.389280 -0.586666 0.905444 -0.102217 0.591427 -0.168941 0.306715 0.219495 -0.472513 -0.146685 0.752590 0.629396 0.714907 -0.507356 -0.442117 0.799056 0.422576 0.662410 -0.341174 -0.732367 0.014039 -0.183894 0.905125 -0.870456 -0.053268 -0.141515 -0.799646 0.336566 -0.304144 0.389935 0.399830 0.307027 -0.871155 0.107846 0.738408 -0.473227 0.903561 -0.708458 0.732745 -0.039953 -0.750947 0.595806 0.272676 0.007716 0.005802 0.007590 0.079344 0.221588 -0.936127 -0.035027 0.033764 -0.726372 -0.868892 0.770707 -0.383408 -0.651714 0.527250 -0.719737 0.519993 0.226575 0.223677 -0.873550 0.461070 0.964642 -0.617656 -0.035337 -0.800003 -0.139782 0.456176 0.867699 -0.523192 0.078855 0.641942 -0.831683 0.649701 -0.186292 0.569982 -0.772489 -0.286347 -0.113877 -0.219001 0.574600 0.095286 0.790223 0.375659 0.208137 0.644267 -0.013565 0.348413 -0.089854 0.753366 0.482545 0.088959 0.879933 -0.175976 0.137202 0.015772 0.222959 -0.016971 -0.184196 0.277924 0.739236 -0.669637 -0.868483 0.795679 0.675602 0.826275 0.073079 0.690996 0.894373 0.004910 0.425706)
+
+ ;; pp:
+ 16.350377 (fv 0.000000 0.552796 0.999754 1.596338 0.126332 0.673759 1.143594 1.786231 0.239358 0.837076 1.376094 -0.027483 0.557207 1.197707 1.840730 0.374019 1.046415 1.758004 0.340195 0.989599 1.620624 0.260723 0.941286 1.573013 0.271552 0.902927 1.633570 0.349820 1.063867 1.825055 0.557595 1.306577 0.088807 0.790267 1.529892 0.294932 1.020408 1.744984 0.604757 1.412603 0.281886 1.100728 1.889905 0.686280 1.553865 0.453907 1.302529 0.100750 0.984465 -0.035558 0.826606 1.720865 0.586422 1.445731 0.436162 1.366180 0.314278 1.261198 0.174270 1.139476 0.076878 0.981955 0.014752 1.001254 0.023464 1.025553 0.021016 1.003733 0.047800 1.070120 0.227544 1.225662 0.275497 1.290238 0.339903 1.445648 0.643098 1.696622 0.736906 1.856892 0.946479 0.080466 1.251303 0.348155 1.578331 0.792557 1.845915 0.951067 0.268564 1.510384 0.657787 1.813775 1.031959 0.320499 1.463662 0.701523 0.024031 1.255492 0.480762 1.684919 1.051974 0.424109 1.601000 0.892871 0.243024 1.614521 1.010751 0.221241 1.491807 0.862210 0.215650 1.557126 0.968758 0.385009 1.808699 1.162553 0.511515 1.916283 1.311004 0.789593 0.295563 1.706075 1.087230 0.543068 0.069395 1.561470 0.989040 0.453388 -0.108044 1.480909 1.040634 0.572985 0.051211 1.625308 1.183041 0.686760 0.302383 1.860622 1.529645 0.987474 0.557505 0.084969 1.853756 1.336365 0.952019 0.595441 0.210294 1.971086 1.605010 1.282084 1.025620 0.569157 0.327228 1.866582 1.606594 1.434632 1.017654 0.911350 0.391676 0.232063 0.001884 1.730059 1.574735 1.286832 1.121780 0.801569 0.646973 0.508234 0.242177 0.255472 1.901657 1.795256 1.544468 1.353518 1.252299 1.049061 0.957214 0.842369 0.785364 0.631556 0.708280 0.450967 0.377024 0.408728 0.166649 0.302099 0.202780 0.096226 0.047151 -0.060241 -0.054511 -0.141528 0.011242 -0.035439 -0.105943 -0.008495 0.261657 -0.027784 0.212454 0.144202 0.244055 0.276291 0.439789 0.497793 0.528548 0.655999 0.693233 0.786857 0.888896 1.103132 1.128106 1.412355 1.557348 1.790407 1.883313 0.127747 0.354527 0.531053 0.664039 0.693143 1.026705 1.248860 1.533013 1.656903 -0.153410 0.211226 0.477106 0.861202 1.107385 1.382365 1.702920 1.856715 0.292313 0.666914 1.015054 1.228045 1.584336 1.886548 0.103276 0.465850 0.933761 1.404258 1.699106 0.163965 0.511514 0.978218 1.466876 1.813824 0.330510 0.850353 1.126689 1.666255 0.008649 0.560148 1.018515 1.617664)
)
-;;; 512 all --------------------------------------------------------------------------------
-#(512 34.212551772691 #(0 0 1 1 0 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1)
+;;; 512 all -------------------------------------------------------------------------------- (22.627)
+(vector 512 34.212551772691 (fv 0 0 1 1 0 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1)
- 31.391244 #(0.000000 0.536490 0.982156 1.426326 -0.129626 1.732808 0.654778 -0.037467 0.717993 0.534761 1.425863 1.198865 1.682980 1.546213 -0.071047 1.401448 0.937782 0.982596 0.016895 0.072103 0.569596 0.486124 -0.097286 1.158349 0.918371 1.039216 -0.251432 0.819547 0.575793 0.544080 0.369375 -0.184848 0.368901 0.803569 1.569591 0.698176 0.192969 0.724313 0.149571 1.805778 1.481586 1.290110 0.699094 1.248324 0.394364 0.244421 1.636448 0.053830 1.021639 0.391890 0.621807 0.669918 0.722984 1.661047 -0.053982 1.184501 1.452118 -0.038748 0.079581 -0.157031 0.040992 1.236847 1.450072 0.167693 1.624681 -0.088284 1.086971 0.793397 0.916304 0.324493 0.532068 0.802293 0.153202 1.762480 0.101252 1.207328 -0.129231 0.230528 1.030310 1.154258 1.508591 0.616033 0.882311 1.661175 1.953694 1.099650 0.966354 0.501383 1.007682 0.222557 1.610959 1.720178 1.247885 0.606186 0.834708 1.558361 -0.017869 1.310156 1.008083 0.659261 0.131563 1.937703 0.412195 0.236592 1.603060 1.101767 0.827617 0.591143 0.816380 1.263921 0.148742 0.104597 0.053092 1.950756 0.641813 0.585000 1.924936 1.150271 1.393796 1.729921 0.941614 1.154412 0.016709 0.693894 0.725621 1.812021 0.151548 0.913871 1.847999 1.447775 0.154900 1.383798 1.268622 1.684293 0.167755 0.064703 1.097955 1.093726 0.462700 1.179880 -0.028079 1.477485 1.219357 0.751030 -0.060337 1.210332 0.214512 -0.561537 0.631221 0.866225 0.505200 1.649399 0.763462 -0.177460 -0.124321 0.301932 1.215601 1.531126 1.037628 1.084693 0.882199 1.071766 -0.102511 1.933157 0.994409 1.327775 0.857160 0.274823 0.564669 -0.099448 1.183881 1.389926 0.212160 0.718775 0.317581 0.924967 0.405513 1.649930 1.527277 0.183790 1.201712 0.469506 -0.155659 0.854295 0.612216 0.966494 0.705453 0.102052 0.675180 1.609733 0.239829 1.243022 1.279694 0.667433 0.574003 0.556613 0.553333 0.600770 0.751871 0.860635 1.492204 1.208264 1.697379 1.870484 0.648885 0.791931 0.713354 1.230332 0.984751 0.006536 1.150837 1.690631 -0.027051 0.380760 1.276448 0.938348 0.619960 1.881157 0.864399 0.721671 0.604021 0.280855 1.903049 1.689084 0.993376 0.147486 0.728308 1.043826 -0.093977 0.201345 0.211713 0.591694 1.563665 0.629162 0.028541 1.220537 0.848678 1.673148 1.269501 1.423564 1.256969 0.563220 1.571156 1.255956 0.182322 0.799277 0.912648 0.801445 0.560308 0.589828 0.497125 0.933069 0.424475 0.705311 1.598444 -0.187983 0.441238 0.761108 -0.025473 1.486361 1.415485 -0.420955 -0.301161 0.451074 1.599095 0.958690 0.764750 1.826910 0.763259 1.565082 0.482133 0.634148 0.689109 0.870842 0.258187 1.307766 -0.061122 1.322321 0.737932 1.331468 0.501857 1.012652 0.853045 1.281963 0.626236 1.018208 0.355320 1.778787 -0.216416 0.289103 1.466104 0.834557 1.495024 1.347843 0.915718 0.019062 0.109237 0.935987 0.642501 1.116001 0.102778 1.044616 0.401839 0.000557 1.388259 1.103344 0.236147 1.095986 1.490085 0.811184 1.620642 0.447193 -0.162667 0.472053 0.254521 -0.249527 1.201426 0.405149 1.876543 0.266187 0.130139 1.907565 0.661173 1.806986 1.714549 -0.045649 0.161300 1.867579 0.410807 0.692661 0.164446 1.373170 0.784111 1.624643 1.842397 0.851982 0.372586 -0.153180 0.163399 0.937623 1.029810 0.577761 1.885373 0.257007 1.919724 0.221390 0.992752 0.799199 0.726916 0.499383 0.847904 1.435092 1.516436 1.415791 0.718336 0.775042 0.214479 0.693437 1.416323 0.376686 -0.088726 1.305444 0.236013 1.760923 0.882461 0.966026 -0.039945 1.586889 0.146351 1.058484 -0.153465 0.874027 1.562558 0.221053 0.700956 0.490493 0.224584 0.721736 0.907632 1.824769 1.463914 1.787340 0.284520 0.447051 0.015084 0.421417 0.946031 1.985021 0.625260 1.706503 0.181495 0.118414 1.205197 1.823047 1.191165 1.046795 1.286118 -0.026177 0.916951 1.695990 1.490318 1.309732 1.464060 1.688925 0.463066 0.812221 1.691121 0.060699 1.771571 0.651609 0.701067 0.994197 1.863648 1.878055 0.461586 1.225301 1.689333 0.585832 0.163978 -0.087727 0.814512 1.996254 0.412873 -0.094955 0.264337 0.270751 1.142549 -0.024966 0.070370 0.161447 0.009507 0.773710 1.826772 0.919015 0.469842 1.605350 0.130163 0.372875 0.706787 0.275237 -0.485192 0.934255 0.076963 1.578025 1.319281 -0.268275 1.006626 1.518212 0.244270 0.393465 0.362653 0.762951 0.101773 0.641925 -0.044830 -0.086144 0.912315 0.865131 0.751696 0.355646 1.669420 0.959146 1.402229 0.790946 1.375834 1.946560 0.829893 1.038967 0.415598 0.605293 0.953370 1.545858 0.816660 0.535574 0.545621 1.444071 1.427861 0.317581 1.324961 0.709073 0.233889 1.997939 0.837353 0.714659 0.502688 1.282277 0.578831 -0.367027 0.456635 0.005356 0.566115 1.015260 0.456787 1.559690 0.821948 0.873735 -0.125757 1.347975 1.234391 0.394165 1.313322 1.674955 1.957471 0.199796 -0.216128 1.145281 0.020796 -0.033417 1.546313 0.684777 0.721518 1.014713)
+ ;; from (try-all :all 512 513 1.0491155462743 0.38189660798029) = 28.3830
+ 23.664022 (fv 0.000000 0.427568 1.639326 1.360155 1.811218 1.092160 0.747868 1.186461 0.447302 0.141557 0.619324 1.833463 1.544347 0.007451 1.194940 0.942391 1.467079 0.598818 0.341862 0.856599 -0.009623 1.790305 0.303605 1.433809 1.210097 1.744422 0.850431 0.701542 1.184133 0.353157 0.158700 0.631775 1.816582 1.649038 0.151955 1.319099 1.140756 1.686037 0.836885 0.603284 1.210040 0.328240 0.128897 0.747775 1.857031 1.647146 0.229954 1.360640 1.181891 1.738203 0.916825 0.772560 1.263892 0.487557 0.357369 0.837989 0.072479 1.952904 0.462538 1.655604 1.530780 0.044826 1.188380 1.093422 1.643465 0.760457 0.671146 1.165553 0.382517 0.270309 0.819071 0.053545 1.937012 0.495125 1.742677 1.542501 0.125650 1.325748 1.210027 1.732088 0.935701 0.824564 1.323484 0.585708 0.506420 1.029721 0.338323 0.187075 0.760806 0.050676 1.850037 0.464992 1.677973 1.565113 0.144103 1.317521 1.321113 1.874238 1.016306 1.069091 1.608386 0.796518 0.769622 1.333499 0.614032 0.483343 1.064146 0.380172 0.255809 0.868411 0.110092 0.019745 0.602426 1.831203 1.791424 0.362161 1.643680 1.595486 0.149263 1.495555 1.407870 1.984422 1.287342 1.186467 1.794990 1.091502 0.997302 1.627715 0.925839 0.869778 1.436400 0.757469 0.721612 1.297170 0.565566 0.560684 1.139226 0.428000 0.421240 0.966706 0.319226 0.330813 0.889093 0.219241 0.195335 0.812296 0.094799 0.052902 0.683712 0.010896 1.971130 0.608327 1.935753 1.931121 0.569627 1.867175 1.867249 0.441783 1.801138 1.790921 0.371408 1.777986 1.738617 0.401066 1.733047 1.661490 0.354101 1.627871 1.606589 0.288724 1.577834 1.666020 0.321728 1.651393 1.656482 0.323319 1.730257 1.617220 0.293458 1.714829 1.659553 0.344931 1.670147 1.687943 0.352602 1.662557 1.707106 0.369928 1.772978 1.748463 0.482487 1.829720 1.820057 0.586300 1.834899 1.928514 0.630781 1.937126 0.006886 0.678213 0.089703 0.093158 0.772429 0.211946 0.205897 0.907314 0.295511 0.339317 1.025320 0.390289 0.436223 1.172670 0.563140 0.575421 1.326146 0.743539 0.740636 1.478962 0.859750 0.923341 1.622809 0.996123 1.103566 1.788348 1.176067 1.280213 -0.047092 1.383754 1.395483 0.152500 1.517048 1.632989 0.388897 1.741484 1.847120 0.652366 0.024054 0.131465 0.878250 0.336434 0.307596 1.072008 0.542503 0.578597 1.334996 0.751250 0.821777 1.656098 1.025574 1.190055 1.955170 1.316203 1.418474 0.154347 1.615247 1.696950 0.413353 1.897018 -0.040080 0.750302 0.194941 0.311683 1.127700 0.508014 0.639251 1.420913 0.883930 0.954476 1.736379 1.219406 1.363982 0.067216 1.594026 1.696195 0.520754 1.968937 0.073197 0.846293 0.295874 0.412637 1.264631 0.683696 0.770777 1.578119 1.049706 1.256677 0.075650 1.516235 1.661663 0.486701 1.923042 0.102476 0.897895 0.421239 0.520799 1.398872 0.764863 0.918394 1.741709 1.285842 1.432958 0.285406 1.740186 1.875561 0.693279 0.189999 0.363512 1.130608 0.742662 0.877597 1.690466 1.167157 1.260179 0.095687 1.647656 1.862836 0.750171 0.242633 0.398738 1.269810 0.693295 0.943617 1.819562 1.329456 1.523078 0.289946 1.903623 0.046720 0.919252 0.382106 0.589683 1.382685 1.026289 1.195161 0.073095 1.610391 1.738812 0.696675 0.192997 0.388398 1.259408 0.742094 1.024183 1.864212 1.458122 1.534179 0.402744 -0.061224 0.271156 1.098904 0.634032 0.812991 1.726192 1.349800 1.524054 0.405111 1.914339 0.225666 1.134052 0.737598 0.871970 1.836536 1.374934 1.616164 0.466416 0.050312 0.256071 1.130926 0.806016 0.967517 1.857501 1.430024 1.677286 0.624674 0.171527 0.493105 1.331230 0.893429 1.180472 0.103949 1.752760 1.965087 0.889376 0.401019 0.670116 1.685650 1.210490 1.475318 0.371575 0.023405 0.308232 1.175094 0.785590 1.015636 -0.029618 1.589597 1.841867 0.744953 0.423044 0.654663 1.649721 1.235327 1.552140 0.505770 0.153285 0.430626 1.295928 0.916060 1.261458 0.277022 1.879571 0.086016 1.069989 0.709985 0.993888 -0.020550 1.578106 1.903961 0.873960 0.405819 0.766821 1.720050 1.395240 1.689328 0.591580 0.237019 0.518171 1.489451 1.175876 1.436552 0.419316 0.110972 0.456395 1.431851 1.135703 1.433153 0.412157 0.047498 0.368496 1.359894 0.994487 1.371051 0.374236 -0.007165 0.356413 1.341081 0.997966 1.348371 0.388959 0.042648 0.317800 1.336452 1.006864 1.349497 0.415416 0.057830 0.422080 1.335388 1.091374 1.397964 0.381417 0.219147 0.454116 1.473546 1.128064 1.458934 0.561157 0.201897 0.582036 1.638190 1.188476 1.678318 0.658219 0.380328 0.735596 1.749438 1.526079 1.911184 0.877724 0.628235 0.991698 0.058067 1.723282 0.138422 1.198701 0.866452 1.210404 0.321220 0.058540 0.420700 1.466851 1.211297 1.555352 0.603793 0.342675 0.773740 1.815254 1.579109 1.942762 1.000717 0.737614 1.114407 0.230063 0.006013 0.382590 1.515868 1.246214 1.651494 0.773676 0.514207 0.940214 0.045277)
)
-;;; 1024 all --------------------------------------------------------------------------------
-#(1024 54.490282136658 #(0 0 0 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 0 1 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0)
+;;; 1024 all -------------------------------------------------------------------------------- (32)
+(vector 1024 54.490282136658 (fv 0 0 0 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 0 1 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0)
- 49.867216 #(0.000000 0.327463 1.836047 0.835169 1.252076 1.674070 0.220548 1.042475 1.509095 1.579464 0.895304 1.247426 1.151972 1.490500 0.157542 1.123668 0.047756 0.787232 0.294584 1.733356 0.107736 1.156565 0.757337 0.396950 1.528176 1.246645 0.358019 1.104207 0.205112 -0.175155 1.961979 0.116865 1.705056 1.224069 1.280180 1.615850 -0.006555 1.362186 1.094292 -0.132951 0.689557 -0.034245 1.478824 0.731044 0.924965 0.400017 0.459628 0.386074 -0.101383 1.148365 0.704241 0.744738 -0.052844 0.067315 0.369521 0.758466 1.902583 1.899586 1.598319 1.737623 1.540374 1.696560 1.697499 0.487205 1.085963 1.880631 1.477181 1.668863 0.024424 1.517648 0.365516 0.200991 1.320714 0.186157 0.388617 1.467282 1.382441 0.897334 0.626981 0.319121 1.447908 0.616025 1.804381 1.745575 1.813291 0.789135 0.051659 1.904341 0.503423 1.476255 0.310011 0.604315 1.774089 1.349431 0.552058 0.129885 0.768054 -0.042991 0.438904 1.716492 1.079908 0.082240 1.637563 1.782814 1.167399 1.555367 1.493576 1.678716 -0.108181 1.820002 0.874064 1.607670 0.305117 1.407464 1.406799 0.699493 1.582569 1.388350 0.152096 1.215999 0.220403 0.345901 0.015759 0.103791 1.475118 1.377921 1.679643 0.718421 0.305952 1.129388 0.650190 1.214505 0.313791 1.900895 -0.280859 0.827104 0.966094 0.952334 0.465933 0.582045 1.202693 0.486327 0.130731 1.189722 1.845737 0.943304 1.846468 0.736959 0.494820 0.406920 0.444435 1.414861 1.519794 0.691958 1.296671 0.239996 1.370349 1.087196 0.317189 1.730290 0.211314 0.381111 1.011776 0.833783 0.304407 0.204684 0.592149 1.184369 1.190663 0.322231 1.702889 0.256307 1.071017 0.840867 -0.242520 0.479950 0.584840 -0.105808 1.448894 0.833770 1.887925 0.447183 0.314914 0.590005 0.817397 1.520556 1.737874 0.323699 0.068906 0.069837 1.455903 1.768167 1.147201 1.651376 0.903538 0.404965 0.830838 1.574402 1.302241 0.460573 0.902816 1.351294 1.845320 -0.081248 0.117244 1.311180 1.295830 0.026240 1.722593 0.293615 0.016937 -0.020631 1.563094 0.366968 0.499012 0.343554 0.941646 1.842772 0.263412 0.928044 0.666097 0.965699 0.095392 0.386295 0.685342 1.098466 0.314857 0.096187 1.378947 1.725601 1.638174 1.066852 0.324141 0.309496 0.903826 1.884009 0.246373 1.446212 0.826576 0.056908 0.590948 1.115228 0.881198 1.458300 0.734711 1.242163 1.780534 0.853455 1.667872 0.196825 1.537188 1.607676 1.937251 1.074072 1.633616 0.370489 0.008710 0.036175 1.429420 1.071794 1.840602 1.451692 1.243956 1.431107 0.691835 0.914980 1.199410 0.181293 1.253487 1.088758 1.075474 0.108051 -0.045571 0.503001 0.028741 1.519924 0.162181 0.231314 1.014758 0.853208 1.665684 1.803304 1.068408 1.146822 1.117985 0.847058 0.807390 1.300311 0.358831 -0.176058 1.632353 0.793462 1.223895 1.408096 0.574718 1.116086 1.528188 1.863540 0.148438 1.178815 1.094527 1.806614 -0.012374 0.398182 0.065034 0.201600 1.678653 1.635712 1.101239 1.677879 1.376663 0.893127 0.765563 1.312772 0.394500 0.623281 1.386574 1.609733 1.397744 0.447440 0.193906 0.667070 1.098978 1.496626 1.415310 0.148141 0.472594 0.260368 0.383833 1.628233 0.220327 0.047597 1.174267 1.122635 0.357754 1.987414 0.602071 0.303888 1.036218 0.431162 1.929514 1.164116 1.448233 0.387663 1.542441 0.132675 1.507592 0.773415 1.237768 1.176487 0.709116 1.107050 1.826342 1.282624 0.165318 1.688758 1.353368 1.369182 0.103481 0.492312 0.148528 0.820568 0.043996 1.646622 0.840124 0.753421 0.628590 0.827439 0.938395 1.158874 1.692810 0.816126 1.584484 0.133035 0.633441 1.856698 0.223451 1.094007 1.265750 1.192640 0.395952 1.640962 1.917364 1.688116 1.442386 0.211922 0.568924 0.069021 0.337714 0.057686 1.444757 0.805875 1.387495 1.241537 1.258564 -0.138313 0.232318 1.082810 0.919288 0.672564 0.858948 1.226057 0.513353 0.916746 0.480683 0.371996 1.820855 1.467856 -0.009218 -0.283047 -0.004140 0.307827 1.551706 1.336385 0.311540 -0.227376 1.460075 1.374821 1.644972 0.942584 -0.008731 1.230541 -0.050886 0.756145 1.492824 0.234443 1.038831 0.415396 0.259582 0.094433 1.743809 1.773181 1.193767 1.144637 1.107278 1.073467 0.192765 1.121611 1.358143 0.256730 -0.001826 0.319586 0.785692 0.371007 0.790865 0.733080 1.010016 0.365066 -0.098482 0.630804 0.165791 1.416869 0.881841 1.014309 0.992919 0.234901 1.418323 1.609100 1.112565 1.226695 1.306198 -0.096032 1.659930 1.253925 1.468504 1.649207 0.667054 0.642219 0.816619 1.780578 1.068621 1.659145 0.823854 0.791623 0.343295 1.504822 1.385473 1.019994 1.644651 0.766151 1.645632 0.537825 0.398247 1.293204 0.059160 0.178873 1.447287 0.527125 0.387974 0.131115 0.312785 1.604447 1.506949 1.620066 1.861402 0.145250 0.285949 -0.076877 1.710147 1.391166 0.304424 1.033493 1.242586 0.544670 1.096730 0.523155 -0.189246 1.481005 1.033398 0.768935 0.023972 1.612024 1.483055 0.518798 0.299824 0.004960 0.939759 0.174131 0.190042 1.122756 0.636602 1.584671 0.313933 1.551720 0.904685 -0.060326 0.005540 -0.025426 1.183830 1.574816 0.451159 0.567990 0.636937 1.946081 0.103934 1.024172 0.668272 0.598832 0.942076 0.803712 0.025316 0.279283 0.860683 1.108376 0.495592 -0.216459 0.511102 0.839492 0.325629 0.423941 0.964281 1.869174 1.376322 0.695771 0.307933 0.728584 0.258248 1.021908 0.522105 1.443610 0.699209 1.445438 0.129220 0.656902 0.367233 1.583887 1.284330 0.304291 1.225496 0.476577 -0.012778 1.769867 1.304421 1.416331 1.394685 1.657958 0.575537 1.154454 1.482178 0.502570 1.130768 0.623558 1.451860 1.828731 1.028878 -0.009475 0.876872 0.279098 0.766784 1.311330 0.735794 0.541035 1.842543 0.936643 1.574537 1.396428 1.299258 0.148915 0.106232 1.382409 0.363703 1.437792 0.458828 0.697511 0.377860 0.415873 0.707742 0.076333 0.899058 1.164566 0.519739 1.494067 0.722474 0.267706 0.170213 0.062507 1.608638 1.572808 0.586666 0.770343 0.501734 1.095273 0.909347 1.158611 1.763224 0.928306 1.155477 -0.094050 1.234292 1.636569 0.857401 1.601954 1.562867 0.898006 0.745695 1.244420 1.045502 0.037133 1.054100 0.435628 -0.045614 1.310834 1.323179 1.515436 0.396760 1.549668 0.626053 0.262609 1.128936 -0.206617 0.519603 -0.070276 0.368711 0.384606 -0.046953 0.004776 1.132741 0.208440 1.125384 0.279383 0.206414 1.581812 0.366788 1.631341 0.047828 0.984452 0.695910 0.001831 0.818618 -0.063551 1.509031 1.770858 1.145267 0.218736 0.163266 0.304181 0.524463 -0.107417 0.636073 0.319627 0.873046 1.806848 0.905657 1.431126 1.307693 0.411432 1.050612 0.383394 0.297520 1.470377 1.512342 1.119568 -0.164563 1.409877 1.369612 0.893616 0.187194 1.160112 -0.426584 1.472282 1.524100 0.642913 0.291994 1.439671 0.405710 0.699882 0.685768 1.837220 -0.135020 0.618382 1.538502 1.936925 1.869902 1.304847 1.204678 1.245764 0.849343 0.077370 1.376208 0.128986 0.683191 1.168443 0.773303 0.918277 0.361282 1.325992 0.182420 0.557109 0.856130 0.916468 1.073525 -0.056735 0.457839 1.415303 1.493321 0.837421 1.245510 0.324402 1.072023 1.495966 0.779674 1.792871 0.438686 1.400304 -0.029656 0.771387 1.191604 0.497478 0.949389 0.583656 1.568371 0.818618 0.376624 1.922430 1.597926 1.106025 1.349123 1.097987 1.226814 0.449548 0.978715 1.149809 0.090419 1.181951 0.196841 0.169854 1.157525 0.672195 -0.013396 1.381930 0.763467 1.101984 1.081354 1.745447 0.052582 0.434851 0.710038 0.252432 1.547955 1.291922 0.243233 0.084185 1.718412 0.754270 1.712834 -0.113817 -0.185231 0.645607 0.602242 0.698745 1.484932 0.708616 0.806637 1.321352 0.822224 0.486883 0.890968 0.415997 0.868384 0.439809 0.369575 0.155202 0.890177 0.736148 1.282829 0.496635 0.179507 0.581791 0.861737 1.329786 0.952408 1.311372 0.616676 1.793129 0.198151 0.583196 0.014657 0.736984 0.943676 1.304757 0.104216 1.131163 0.886646 1.431121 0.607723 1.834661 0.350032 1.233992 0.553257 1.415608 1.339899 -0.021117 1.320488 0.646222 1.478825 0.253185 1.344375 0.782507 0.242220 1.348393 1.611945 1.891346 0.403449 0.420262 1.560522 0.492852 1.786347 0.954743 0.927910 1.007730 0.966809 1.183914 0.132915 0.235582 1.182222 0.510621 0.119231 1.400333 1.559546 0.434169 0.106340 1.159731 1.145452 1.403938 0.593410 0.423464 1.214964 0.097415 0.659427 1.330465 0.265373 0.978681 -0.241303 1.410817 0.374681 0.982607 0.620477 1.028389 1.023993 0.703520 1.277773 0.757705 1.040223 0.694910 0.158208 1.192658 1.103184 1.154745 0.138529 0.659537 1.567368 0.955008 -0.008595 1.044148 0.615600 0.596413 1.600428 -0.130936 0.209722 0.597264 0.214794 0.424799 0.791647 0.212593 1.490120 0.029575 0.222065 1.056546 0.514551 1.117830 0.080900 0.698795 0.825148 0.128150 -1.946314 1.296496 1.764967 -0.109275 0.619906 1.046853 -0.050885 1.414055 0.243491 0.805047 0.478126 0.210018 0.383272 1.147815 -0.142393 0.254600 0.974724 1.253165 0.759822 0.390277 1.900341 0.600527 0.913172 1.508819 0.838474 0.842307 0.052699 0.015556 0.443439 0.953984 0.747720 -0.054054 0.972040 -0.241904 1.438074 0.685282 0.673901 0.604914 0.601935 0.592279 0.658902 1.125537 0.853760 1.677094 1.268821 0.909583 0.771236 0.955089 1.189800 0.847715 0.318412 1.928436 1.740119 0.412900 1.589818 1.013917 1.215481 -0.014813 1.247880 0.223321 0.897915 0.951870 0.304753 1.763894 1.166419 1.525081 1.491253 1.646299 0.047929 0.453022 0.624295 -0.345040 0.250292 1.322349 1.263984 0.481892 1.819190 1.498516 0.274084 0.915689 1.490261 0.159303 1.347132 1.407289 -0.117297 1.828899 1.616281 0.092870 0.390260 -0.086407 1.668212 0.707778 -0.125709 -0.068702 -0.008020 1.483304 1.668166 0.205490 0.775194 1.173496 1.068329 -0.181766 1.426966 1.728307 1.644513 0.798234 0.762223 -0.195164 0.527024 1.036420)
+ ;; from (try-all :all 1024 1025 0.0030465754082342 1.0966230312279) = 39.6408 -- starting point for next
+ 33.410875 (fv 0.000000 0.258148 0.589168 0.994411 1.357701 1.683025 0.069074 0.453421 0.797628 1.185816 1.582436 1.938092 0.307108 0.753155 1.054506 1.465084 1.815186 0.241264 0.539120 0.935358 1.344730 1.757342 0.087826 0.560243 0.909870 1.313450 1.644065 0.104593 0.476633 0.874522 1.288326 1.742330 0.203193 0.590704 1.014919 1.387211 1.858546 0.251755 0.613119 1.088831 1.500246 1.956678 0.355205 0.836294 1.268025 1.705878 0.108690 0.586645 1.046489 1.430729 1.904826 0.322624 0.787698 1.277011 1.718145 0.125412 0.585092 1.047194 1.448174 1.936035 0.420374 0.902587 1.333104 1.856924 0.327896 0.858579 1.268399 1.749900 0.253263 0.677442 1.219161 1.714857 0.177166 0.633557 1.169787 1.640415 0.140512 0.621582 1.091651 1.607728 0.104564 0.583756 1.118053 1.652294 0.153513 0.714859 1.194251 1.697620 0.276971 0.782347 1.313258 1.816056 0.294830 0.852045 1.367731 1.912889 0.443181 0.976528 1.489519 0.048647 0.602555 1.171111 1.696946 0.267367 0.808494 1.328988 1.847036 0.429147 0.989539 1.554476 0.119989 0.631320 1.259112 1.823414 0.393440 0.968836 1.504033 0.126560 0.727472 1.269985 1.846490 0.405486 1.041942 1.582030 0.184859 0.803907 1.384064 0.001185 0.565238 1.185485 1.799966 0.388364 0.991281 1.615016 0.210322 0.777733 1.381829 -0.001858 0.601802 1.237656 1.865352 0.533475 1.133402 1.742192 0.420236 1.017900 1.625681 0.265207 0.907047 1.531875 0.165179 0.869961 1.486073 0.135412 0.775460 1.391805 0.032701 0.662061 1.355447 -0.029896 0.673845 1.349264 0.011611 0.729065 1.361114 0.013249 0.666596 1.353522 -0.007100 0.647754 1.363243 0.014621 0.674314 1.412588 0.079158 0.792604 1.491853 0.154571 0.839031 1.536947 0.216086 0.941461 1.657001 0.337150 1.060668 1.746479 0.482706 1.226119 1.946733 0.643851 1.336905 0.013042 0.754294 1.496162 0.232890 0.988475 1.681309 0.448137 1.146402 1.881464 0.552981 1.297819 0.098645 0.832913 1.606715 0.332666 1.035466 1.818940 0.554955 1.343968 0.085509 0.792214 1.558162 0.368596 1.106235 1.895172 0.644633 1.405521 0.165480 0.925201 1.747451 0.473692 1.324609 0.053177 0.850917 1.628773 0.424746 1.258663 0.036370 0.797966 1.564071 0.352485 1.148447 -0.002783 0.797088 1.561969 0.392501 1.189092 -0.019088 0.843646 1.634513 0.453206 1.275296 0.054828 0.916548 1.733451 0.558960 1.389762 0.203638 1.054862 1.897500 0.708809 1.574733 0.423071 1.215266 0.027342 0.899322 1.791858 0.620622 1.492274 0.320845 1.174701 0.051833 0.913009 1.796449 0.665146 1.471491 0.328743 1.193965 0.076732 0.978576 1.811604 0.666355 1.562427 0.437112 1.309285 0.223487 1.113773 0.007247 0.849622 1.753745 0.664875 1.576770 0.455394 1.360922 0.282060 1.150668 0.049047 0.927118 1.816088 0.739465 1.705374 0.642039 1.518132 0.405444 1.340122 0.312878 1.226245 0.139772 1.077510 -0.018816 0.936435 1.857875 0.823248 1.722658 0.669787 1.630579 0.550282 1.483551 0.473002 1.439850 0.374042 1.322563 0.264157 1.241756 0.176119 1.137549 0.127690 1.073354 0.045113 0.987362 -0.009728 0.938618 1.894769 0.930534 1.889094 0.819648 1.834591 0.887814 1.825305 0.751612 1.788639 0.781856 1.799187 0.761171 1.765995 0.797679 1.787953 0.747401 1.771597 0.793400 1.786941 0.805798 1.801885 0.838640 1.863755 0.878598 1.883687 0.921909 -0.012600 0.953576 0.028661 1.053164 0.071002 1.090274 0.114661 1.146587 0.180317 1.267377 0.271949 1.348847 0.373158 1.422115 0.472335 1.601819 0.584885 1.638612 0.781047 1.776789 0.821569 1.888293 0.973656 0.059587 1.102322 0.189225 1.264548 0.323677 1.429081 0.526711 1.594088 0.678108 1.711258 0.856227 1.948913 1.030332 0.171134 1.248971 0.337083 1.456252 0.496413 1.599787 0.743435 1.845411 0.979199 0.069456 1.191262 0.312034 1.362623 0.533174 1.673105 0.803847 1.903793 1.042569 0.150816 1.299359 0.434192 1.602414 0.715947 1.838326 1.018218 0.157768 1.253948 0.407857 1.573899 0.779851 1.904361 1.060636 0.223176 1.356991 0.495392 1.680203 0.833630 0.009780 1.167530 0.315957 1.492554 0.654024 1.856891 1.023069 0.220534 1.440206 0.582264 1.748500 0.970294 0.123193 1.307613 0.556564 1.730012 0.926711 0.113171 1.343735 0.556253 1.746273 0.934223 0.123997 1.384091 0.614003 1.782610 1.015379 0.224947 1.465548 0.684093 1.908440 1.124583 0.358057 1.642940 0.875505 0.064339 1.292308 0.557537 1.782713 1.008802 0.272821 1.511713 0.764842 0.030194 1.274549 0.483182 1.727237 1.016792 0.261776 1.522862 0.796446 0.042895 1.304520 0.619998 1.876690 1.148478 0.428322 1.679455 1.004325 0.300377 1.550416 0.835254 0.173352 1.448704 0.698650 -0.033801 1.272024 0.597214 1.859218 1.200705 0.517289 1.763401 1.106977 0.387334 1.700638 1.066989 0.326662 1.604820 0.962763 0.281408 1.585892 0.935892 0.271981 1.571275 0.916662 0.291788 1.570649 0.930716 0.269192 1.579444 0.969565 0.290012 1.615565 0.990795 0.311402 1.657094 0.994116 0.432873 1.757318 1.056873 0.417532 1.795268 1.185595 0.580763 1.918349 1.267276 0.656331 0.049168 1.401813 0.749992 0.176783 1.556953 0.966950 0.314017 1.682209 1.095751 0.473881 1.821750 1.291249 0.673330 0.057423 1.460592 0.890407 0.273536 1.708953 1.094797 0.541733 1.932285 1.354523 0.747235 0.170227 1.592085 1.015544 0.439882 1.847343 1.288875 0.701630 0.111506 1.621007 1.032815 0.491968 1.882621 1.348432 0.738302 0.277658 1.682524 1.144243 0.582029 0.024994 1.499949 0.920010 0.401061 1.889106 1.372403 0.804920 0.264480 1.729722 1.190624 0.695948 0.173617 1.607894 1.119209 0.625052 0.097713 1.558780 1.044363 0.564907 0.006836 1.535288 0.979484 0.498306 0.016897 1.518916 1.048287 0.505482 0.034846 1.537224 1.038826 0.583381 0.066441 1.582671 1.095360 0.652592 0.165653 1.666405 1.195978 0.749638 0.244931 1.794728 1.302261 0.855517 0.402763 1.919243 1.506054 0.990141 0.529140 0.090161 1.628924 1.232711 0.756188 0.320069 1.866574 1.434290 1.010093 0.586649 0.125842 1.632778 1.248832 0.786217 0.395146 1.983594 1.522744 1.184214 0.725738 0.283806 1.853291 1.411973 1.029503 0.623510 0.190003 1.817951 1.405723 0.998692 0.625566 0.196526 1.824631 1.367636 1.002432 0.638505 0.270362 1.867749 1.456887 1.107903 0.666557 0.365450 1.943932 1.534564 1.164468 0.812181 0.417778 0.109315 1.746468 1.348757 1.018766 0.607455 0.251719 1.902085 1.522432 1.168361 0.826689 0.501772 0.186624 1.829613 1.504989 1.149945 0.826038 0.430311 0.156773 1.805915 1.442117 1.129384 0.789359 0.448838 0.128070 1.860262 1.509251 1.221965 0.897472 0.558148 0.251257 1.927642 1.640546 1.338781 1.036792 0.710068 0.403207 0.109563 1.811625 1.572455 1.213598 0.939472 0.623448 0.409350 0.066783 1.811153 1.483733 1.240294 0.962497 0.677702 0.428980 0.151873 1.860959 1.600097 1.372939 1.073698 0.858833 0.549541 0.358709 0.048040 1.780703 1.499339 1.321408 1.026078 0.811519 0.563815 0.272950 0.101217 1.778901 1.584563 1.357171 1.096114 0.901285 0.691896 0.423414 0.187540 0.012408 1.741503 1.538220 1.375071 1.132353 0.924933 0.712966 0.501385 0.301492 0.064052 1.847152 1.740905 1.454340 1.287762 1.094301 0.900958 0.693746 0.504913 0.275695 0.137705 -0.008305 1.750189 1.585524 1.414196 1.262553 1.013251 0.925388 0.715978 0.553457 0.407454 0.213702 0.088434 1.972600 1.762556 1.622037 1.422263 1.305690 1.086572 0.965745 0.818250 0.679809 0.548833 0.434281 0.274574 0.162711 -0.016721 1.874108 1.711171 1.634760 1.470116 1.433824 1.198309 1.122645 0.994884 0.863715 0.716974 0.651737 0.505774 0.376030 0.305317 0.172395 0.043840 1.956668 1.879928 1.790226 1.657792 1.628858 1.503591 1.453387 1.399691 1.283663 1.175444 1.093586 1.015878 0.867180 0.833771 0.733456 0.751208 0.644973 0.524402 0.519350 0.448915 0.402270 0.223991 0.272710 0.178576 0.121816 0.014901 -0.008456 0.000722 1.948116 1.864026 1.799285 1.772492 1.761973 1.729645 1.648114 1.613644 1.601091 1.593669 1.506616 1.533589 1.464454 1.452519 1.424863 1.443072 1.448035 1.385776 1.402879 1.416069 1.400653 1.366739 1.389222 1.353373 1.316055 1.338545 1.366489 1.376447 1.387658 1.386874 1.383521 1.414816 1.478876 1.431144 1.443821 1.476250 1.453501 1.470783 1.513891 1.537062 1.574083 1.565440 1.667183 1.688265 1.726029 1.812251 1.818225 1.909534 1.893859 1.960853 -1.792261 0.049720 0.115471 0.168584 0.227816 0.312337 0.320765 0.432479 0.460834 0.497553 0.618812 0.667533 0.714551 0.786901 0.873018 0.948666 1.026741 1.049685 1.177075 1.308478 1.411491 1.456896 1.608694 1.673563 1.762266 1.858920 1.974208 0.033942 0.165671 0.243992 0.350794 0.473925 0.585735 0.737599 0.804002 0.963652 1.066959 1.216838 1.312134 1.446813 1.594176 1.676806 1.816313 1.965577 0.113977 0.201793 0.324796 0.449133 0.633633 0.769013 0.895692 1.061461 1.163832 1.372251 1.483231 1.640906 1.802011 -0.030958 0.155600 0.377255 0.507459 0.640650 0.847956 1.016719 1.214303 1.427027 1.567855 1.764212 1.940432 0.043642 0.292095 0.470854 0.648508 0.820657 1.060906 1.222563 1.354202 1.598601 1.737516 -0.028100 0.202713 0.374375 0.584831 0.817057 1.020703 1.253416 1.457146 1.644498 1.875195 0.140343 0.371551 0.579412 0.847798 1.090746 1.313318 1.565314 1.779179 -1.706782 0.198770 0.511497 0.711566 0.950424 1.152889 1.372135 1.700365 1.869801 0.181432 0.440942 0.691235 0.983921 1.186243 1.477055 1.750551 0.035866 0.314930 0.558441 0.801324 1.080423 1.361289 1.616783 1.906440 0.211190 0.450778 0.806041 1.119162 1.408538 1.703492 0.007343 0.317836 0.612325 0.935395 1.211907 1.545362 1.855618 0.133582 0.501303 0.746887 1.072480 1.396132 1.651845 -0.008716 0.328392 0.710493 1.027135 1.346260 1.695106 0.085660)
)
-;;; 2048 all --------------------------------------------------------------------------------
-#(2048 89.570060996356 #(0 1 1 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 0)
+;;; 2048 all -------------------------------------------------------------------------------- (45.254)
+(vector 2048 89.570060996356 (fv 0 1 1 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 0)
- 77.350213 #(0.000000 0.555539 0.501262 1.044749 0.287771 1.412682 1.651595 0.929560 0.549846 1.324740 1.935869 1.135478 1.476903 0.201893 1.072368 1.469797 1.856304 1.710124 0.155645 1.734478 1.438672 1.662318 0.369149 1.305539 1.380565 0.760274 1.791213 0.758033 1.460302 0.314773 1.273350 1.445081 1.922068 1.981608 0.787530 0.220848 0.749937 0.852506 1.079197 1.596357 0.533643 1.661423 1.309207 0.570204 0.799186 0.806331 0.147029 1.886462 -0.011055 1.620080 0.764653 1.039822 1.399443 0.540383 1.263941 1.520079 0.955253 1.475051 0.569591 1.021593 1.696488 1.384568 0.888621 1.246065 0.141108 1.760633 0.530062 0.078663 -0.052280 1.231263 1.886752 1.022966 0.731660 1.519866 0.815188 1.842595 0.428998 0.982542 0.268300 0.449940 0.825066 0.093779 1.541877 1.530942 -0.044025 1.404789 1.172967 1.495494 0.986869 1.354411 0.977699 1.323218 0.290527 0.642299 1.141685 0.305403 0.116047 1.498648 0.363158 1.133291 1.021968 1.050915 0.004007 0.316776 -0.008246 1.753451 1.448398 0.727763 0.491974 0.467132 0.349093 0.846144 -0.057302 0.451593 -0.185527 0.954499 -0.017687 1.738336 1.132264 1.277860 1.255149 0.644067 1.787009 0.975542 0.787661 1.834522 0.750059 0.165831 1.781394 0.656243 0.189155 0.885417 1.864367 1.861898 0.835353 1.925872 0.784282 0.149366 0.389909 1.891355 0.667211 1.629093 -0.156731 0.686377 -0.046381 1.379719 0.174257 1.815414 1.782186 1.460458 1.225364 0.215276 0.433813 0.778669 0.770455 0.591200 1.467950 1.402450 1.237374 1.213320 1.107618 1.577857 0.153528 1.496479 1.690453 0.757018 1.164466 1.863222 1.556344 0.411893 0.045128 -0.148474 0.690145 1.255681 1.262642 1.053606 0.652441 1.807011 1.212250 1.298870 1.843582 0.679071 1.071529 1.212117 0.457856 0.037265 0.056807 0.289533 1.340623 0.191271 0.023689 0.079151 1.691347 0.427278 0.798824 0.971986 0.219384 1.510317 1.755539 0.020056 -0.108987 1.920829 0.654279 1.269937 0.625973 1.626210 1.557939 0.060795 1.054050 0.688441 1.815486 1.547017 1.227524 0.184287 0.725676 1.529612 0.145770 1.961037 0.740800 1.404065 0.938756 0.807687 1.820918 0.792546 -0.054241 0.457527 1.314210 1.386331 1.330133 1.364743 0.425434 0.805132 0.601427 1.151039 0.181880 0.588421 1.746772 0.525817 -0.062391 0.174995 -0.229241 1.865325 0.777080 0.576100 1.157737 1.173633 1.108300 0.620180 0.679835 1.829428 1.415691 1.510131 0.278064 0.869124 1.774022 1.810644 -0.249575 -0.122332 0.003232 1.632364 1.298768 0.233819 0.326577 0.745415 0.803076 1.768981 0.251203 0.915819 1.691281 0.742817 0.546973 0.218234 1.629248 1.253580 1.354290 0.528862 1.813762 0.263825 0.781654 1.287354 0.093701 0.698575 0.887912 1.137370 1.529613 1.518332 0.469199 1.225525 0.065649 0.280063 0.033222 0.909971 0.563943 1.914227 -0.065120 1.804400 0.103014 0.719986 1.951068 0.757568 0.217891 0.598460 1.177422 0.353950 1.684496 1.079766 1.303468 0.083664 -0.101540 0.424187 1.703711 0.337732 0.080405 0.592311 1.778334 1.635999 0.889894 1.617811 -0.035024 0.001647 0.924071 0.404662 1.353001 0.748591 1.771296 1.263408 -0.089484 0.221854 0.796659 -0.134496 0.228028 -0.006122 0.001128 1.259921 0.408335 1.472770 1.057188 1.208943 0.859616 0.951961 0.715820 0.286498 1.182115 0.918625 1.616017 1.001494 1.156487 0.467273 0.762620 1.416134 1.041549 1.777524 1.975901 1.424345 1.013724 1.528658 0.546749 1.515054 0.722119 1.165674 -0.188903 1.095713 0.017814 1.713209 0.808498 0.510307 0.811778 0.118225 0.831248 -0.024877 0.111979 0.001521 0.995340 -0.029678 0.290675 0.273513 0.805748 0.398880 0.215141 1.450122 1.736611 1.571552 1.456815 1.117397 1.312031 1.124964 0.952301 0.371672 1.874636 1.681841 0.351506 1.462640 0.011383 0.220945 0.998689 1.953549 -0.140064 0.559134 1.277572 1.812283 0.159287 1.701742 0.028876 0.066961 1.832832 1.596575 1.021889 0.172947 -0.123165 1.617572 0.738832 0.135822 0.899103 0.675147 0.590566 1.141705 0.619940 1.835079 1.810902 0.002593 0.085103 0.459750 1.324431 0.679980 1.499886 1.342828 0.113834 0.419635 0.474996 1.341851 0.784830 0.644960 1.049676 0.463071 -0.083825 0.357307 1.521176 1.668760 1.414541 0.331217 0.933878 0.750349 -0.094259 1.512555 0.057719 1.957253 1.855659 0.525060 0.191371 0.086135 0.778769 1.177665 1.138710 0.469141 0.550747 1.927353 0.597089 0.788555 -0.049972 0.972408 0.774953 0.590333 0.590142 1.188901 0.464196 0.937929 0.701475 1.283776 1.839285 0.195083 1.905586 1.378602 0.369590 0.773647 1.495702 1.010798 1.832039 1.743886 1.062461 1.551722 0.161056 0.247843 0.963386 -0.138497 0.113261 1.624467 1.660928 0.708473 1.847610 1.082010 1.479425 0.325611 0.661837 0.996064 1.316217 0.550535 0.354734 1.792945 0.587728 0.521299 1.867430 0.374452 1.069128 1.359185 1.163695 0.951998 1.554486 0.652597 0.335947 -0.007622 0.361202 1.522520 0.972243 1.090924 1.066404 1.473604 0.640795 1.326138 1.634896 0.633935 0.819042 0.374617 0.068108 0.899846 0.802853 1.002802 0.759373 0.912908 1.407252 1.871269 1.750381 1.651341 0.745903 0.461669 0.010571 1.287847 0.966184 0.583195 0.846835 0.694802 0.418880 1.389707 0.135708 0.155010 1.328469 0.737490 1.774328 0.368667 1.177429 1.152407 0.410099 1.383384 1.321282 1.568075 1.554693 1.238949 1.708897 0.117567 1.335460 1.803251 1.767886 0.012287 0.229862 0.355011 1.249238 1.512803 0.578011 1.451312 1.246621 -0.119738 1.826298 1.173428 0.117885 1.168928 0.345406 1.476069 -0.166920 1.034463 0.382725 0.245749 0.326820 0.118853 -0.057706 0.849665 0.007921 0.613571 0.734308 1.134450 0.749676 1.890959 0.378518 1.752809 1.108432 1.225504 0.442657 0.756270 1.860343 0.369036 1.527507 0.444954 0.930412 1.102519 1.878509 0.479922 1.150077 1.602579 0.058713 0.962265 0.328221 1.661628 0.457747 0.271408 1.870263 1.306306 0.335093 0.169626 0.654033 1.444649 0.614644 1.787700 0.114577 0.749670 0.270604 1.159625 0.989586 0.567069 1.072818 1.888945 -0.085294 0.121997 0.763024 0.984919 0.155703 -0.016260 0.191743 0.212740 0.115788 0.830523 1.683788 0.348500 0.124881 0.670456 0.678523 1.096574 0.897665 1.161154 0.986261 0.052581 0.418547 1.926610 1.527221 0.733566 1.720164 0.588071 0.718754 0.656306 1.222241 0.299541 1.655932 1.738610 0.208473 1.377056 1.640789 0.933028 0.500950 0.266025 0.202787 1.158416 1.726212 1.606686 0.645745 1.477768 1.448364 1.953745 0.028736 0.535783 0.762769 0.101338 1.101876 0.758538 0.004060 1.805216 1.598025 1.230557 0.047096 1.594085 0.215135 0.853051 1.296541 1.417117 0.235968 0.643987 1.405340 1.661579 0.911175 0.443065 1.589884 0.446420 1.073318 0.341514 0.657629 1.701362 1.726879 1.038635 1.625078 0.744561 0.038576 0.786606 0.041993 1.298454 0.218073 0.832914 0.079816 1.047928 0.782023 1.638485 1.342287 1.936893 0.724752 -0.015138 0.922139 1.148652 1.670824 0.337136 0.637705 1.001048 -0.228216 1.495036 0.605922 1.410177 1.011580 0.373865 -0.050306 -0.030282 1.482241 1.182296 0.616043 1.884674 1.514223 0.449114 1.217143 1.156828 0.699730 0.102999 0.250137 -0.031123 1.355748 1.655393 1.161987 1.872025 1.869860 1.112928 1.115924 0.563079 0.100168 1.165211 0.614544 1.264233 1.208279 0.960027 1.628427 1.610521 0.459497 0.403669 1.211322 0.657728 0.590534 1.175789 1.353568 1.427489 1.516217 1.243310 0.036331 1.415204 1.335414 0.312401 0.846162 1.692827 0.881253 1.673563 1.476773 0.491668 0.078271 1.772063 0.429881 0.829599 1.510362 1.324221 0.970839 1.031818 1.605683 0.417137 0.539905 1.124071 1.428885 0.758991 1.336089 0.469378 0.968420 1.462076 0.079466 1.439924 1.447561 1.037226 0.032416 -0.028897 0.368902 0.151743 1.133019 1.512185 1.860937 1.628533 0.118447 1.427979 0.445947 0.232361 0.041062 1.774814 -0.000513 0.970153 0.175939 -0.114292 0.214713 0.557618 0.732536 1.302739 0.889277 1.136665 1.083674 0.654661 1.702739 0.901405 1.509089 0.547946 0.795351 1.387886 0.101319 1.071538 0.300259 1.362963 1.449746 1.621519 0.648860 1.238117 0.385683 0.777458 1.582777 0.090560 1.423196 0.518231 0.129612 0.369422 1.062708 1.137679 1.093619 0.410051 -0.028865 0.764992 0.842311 0.311702 1.830111 0.825103 0.859872 1.362654 0.443486 0.796728 0.015052 1.894804 0.178369 1.350106 1.080421 0.074839 1.798439 1.439047 0.543832 1.787518 1.095677 1.399291 1.218684 1.329215 0.024198 1.277854 1.781214 1.897330 0.663755 0.933197 1.460518 0.015174 0.890021 0.299191 0.591948 0.637994 0.192189 1.518365 0.789317 0.221733 1.393516 1.452171 1.164045 1.425340 1.211899 0.133999 1.809860 1.760137 0.786782 0.058488 1.033658 1.696528 0.115067 1.775639 1.843275 1.658795 1.102731 0.033810 1.518485 0.287243 0.872813 1.110274 1.284147 1.409632 0.002816 1.287616 1.920460 1.545101 0.357241 0.586921 0.250178 0.941329 0.683970 1.816670 1.249502 0.715161 1.288352 1.693684 -0.049681 0.500555 0.738239 0.766636 1.371281 0.427733 1.686588 1.002051 0.758627 0.719945 0.772296 0.797069 1.369126 1.077561 0.114153 1.255930 1.134835 0.290465 1.528414 1.156214 1.255893 0.569904 0.306550 1.578306 -0.027271 0.175993 0.505511 1.123829 1.257104 0.836799 0.957553 0.983670 0.264465 1.266100 0.704111 0.184087 1.468253 0.982413 -0.018410 0.765235 0.844886 0.194386 0.957304 0.466408 0.358006 1.273348 0.958858 0.192485 1.537449 0.762105 1.953919 0.360697 1.896891 0.771484 1.562116 0.477611 0.862940 1.057378 1.667997 0.072578 0.987503 0.634043 1.564453 1.444159 1.122332 0.573990 -0.026527 0.262861 0.694100 1.056833 0.776423 1.948071 1.715568 1.887729 0.174970 -0.171751 1.467195 1.339357 1.881230 0.084291 1.864481 1.857912 0.659248 0.423773 -0.012834 1.278787 1.236726 0.247062 0.279965 1.858545 1.197597 0.522526 0.880799 0.648553 0.790672 1.467274 -0.136872 0.250201 0.665615 0.060502 0.639605 0.387814 0.576618 0.316508 1.567811 0.098866 0.141794 1.102771 0.799866 0.345332 1.009816 0.888907 1.440320 1.300171 1.855403 0.546924 0.083787 1.421153 1.562621 0.072527 0.037440 0.573282 1.293324 1.351032 1.399589 0.771864 1.155326 0.219484 0.989074 0.912196 1.752766 1.745645 1.137247 0.591051 0.105617 0.254271 0.434891 -0.094733 0.689956 1.337531 0.526193 0.871788 1.523712 1.319939 -0.014173 0.862280 0.823385 0.054355 0.629683 0.514687 1.439869 0.563628 0.106880 0.266513 0.239968 1.239315 1.205902 1.537987 1.098124 0.859805 0.863555 0.449285 1.422210 0.199768 1.541420 0.165019 0.357841 1.333702 0.780552 1.817421 1.326090 1.556642 0.158090 0.988718 0.674445 1.749600 0.960378 0.084288 0.655024 1.656664 0.587799 0.266345 1.475692 0.355335 1.516077 0.871619 0.114120 0.528946 -0.021508 1.566964 0.763272 -0.041987 1.595826 0.231857 1.599241 1.621312 1.104850 1.046262 0.120831 0.746877 0.255028 1.065960 1.308573 1.030611 0.412491 1.820905 0.676300 0.872818 1.288694 1.324473 0.222472 -0.042336 0.351502 0.979300 0.592070 1.751901 1.130980 0.635238 1.762905 1.273495 1.080044 0.919480 1.179593 1.820413 -0.178963 1.488909 1.547676 1.413473 0.037220 0.540918 0.498348 0.519105 1.466716 1.160558 1.879868 1.779510 0.227415 1.843328 0.973617 1.469836 0.661373 0.789077 1.686318 1.083096 0.731552 0.631974 0.625195 0.518437 0.775161 0.599994 1.433824 1.546850 0.244876 1.235352 1.089325 0.745382 0.631062 0.172135 1.346869 0.691421 0.557946 0.547526 0.910145 1.806512 0.841829 0.035993 0.164089 0.876851 0.419736 1.447045 0.857337 1.449753 0.335596 1.526369 1.237708 0.224164 0.915030 1.895158 0.321894 0.243163 0.253147 0.767202 1.294104 1.921776 0.626583 0.519179 1.368603 1.836644 0.124415 0.786054 0.509813 0.419967 1.197343 1.868597 0.775064 0.252892 0.318984 0.927666 1.932340 1.673779 0.940320 1.012894 1.522815 1.848921 1.524047 0.876052 0.835068 0.202396 0.794377 1.439611 0.074539 -0.075361 1.885112 0.757920 0.329423 1.361749 0.638054 1.833880 1.623912 1.949599 1.140473 0.640646 1.616862 1.093454 0.364866 1.044146 1.776136 1.508751 1.419919 0.732729 1.039208 1.607877 1.063599 1.218045 1.039226 0.726168 0.417832 1.530379 1.814359 0.766578 1.503198 0.394050 1.486705 1.297175 1.401889 -0.082990 1.629865 0.667706 -0.397919 1.071902 1.710567 1.259419 0.488686 0.774842 0.495281 0.690810 -0.138360 0.995138 0.649084 1.726986 1.822386 1.675677 0.871295 0.552178 0.176435 1.151023 1.706719 1.714074 1.232741 1.305463 1.102357 1.338847 1.735865 0.353156 0.053635 1.854965 0.082734 1.117492 1.602812 0.202797 0.527913 1.196926 0.224179 0.259190 1.607857 0.393217 0.665176 0.698877 1.498248 0.402702 0.734968 0.030220 0.717933 0.287575 0.263201 1.292487 0.766597 1.392089 1.702156 0.928571 0.132747 0.718224 -0.022519 0.695395 0.961009 0.836784 0.544693 0.008738 0.733264 1.627723 1.340817 1.883794 0.273239 0.966759 -0.014448 1.703981 0.745520 0.782103 1.349896 0.309738 1.248191 0.900551 0.446724 1.461235 1.068695 1.874609 0.429643 0.991606 0.853954 0.549724 0.691665 0.919866 1.355260 0.399310 1.207242 1.036111 0.331131 1.923340 1.034344 1.785499 1.692182 1.469165 1.114091 0.784790 1.244341 1.215443 0.532863 1.669624 1.876519 0.370732 1.081205 0.630715 0.067840 0.069610 0.360604 0.248517 0.996373 0.072779 1.278622 0.558082 0.871795 0.006302 -0.080693 0.699858 0.670774 0.036839 0.792313 1.053054 0.373523 0.895965 0.219529 0.603841 1.529929 1.571200 1.572745 1.371021 0.483877 0.339338 0.252508 1.449230 0.776954 -0.037096 1.490924 0.862926 -0.010051 1.492206 0.908991 0.850959 0.799315 1.197209 1.798803 1.906307 0.600800 1.929103 1.773167 1.595466 1.116230 1.849141 -0.138473 1.401561 1.089434 1.454707 1.516034 0.405189 0.364581 0.477576 1.238788 1.699265 1.225421 1.132382 0.818130 0.342357 -0.093965 0.277981 1.214872 1.234457 1.644311 0.791369 1.302431 1.793582 0.731030 1.184737 1.815189 0.836787 1.397548 0.795514 1.731490 1.978947 1.699272 -0.087754 1.229538 0.342806 1.370505 1.915848 0.745665 -0.007586 0.973025 0.820357 0.688041 1.687190 0.295857 1.467741 0.510938 1.446447 0.725517 0.934034 0.280828 0.016119 0.464653 0.039176 0.699325 0.325100 0.107226 0.235540 -0.001189 1.374634 0.697151 1.094635 0.813547 1.004845 0.482350 0.999131 0.106594 0.262632 1.035519 1.040389 1.543929 1.111148 0.589803 0.294786 0.739019 0.976084 0.242874 1.533302 1.797675 0.710897 0.037253 1.540031 -0.138585 0.099110 0.002289 0.351043 1.535626 1.094114 1.596706 1.760672 0.111407 1.067403 0.300312 1.066585 1.479561 0.664804 1.829358 -0.133782 0.959441 1.032728 1.396513 1.674422 1.797836 1.031267 1.515695 1.300521 1.221482 1.135268 1.060354 0.280176 0.099445 0.768971 1.623602 1.175004 0.859700 0.318892 1.048016 1.141598 0.451777 0.809913 1.805898 -0.088147 0.408319 0.962852 0.001868 0.190438 -0.086998 1.638471 0.448879 1.897520 0.102606 1.398992 0.552579 1.630596 1.779521 1.459921 1.806379 -0.015856 0.522021 1.606515 0.866415 1.424116 0.555575 1.948281 1.030085 1.522586 1.487448 0.345793 0.419242 0.262081 -0.137605 0.615015 1.404327 0.444728 1.303330 1.429523 1.612489 0.842585 0.811464 1.213611 1.776209 0.851089 0.965962 0.450547 1.048746 0.577828 0.621931 1.428382 1.449142 0.237328 1.159246 1.621752 1.046157 1.746994 0.219170 0.418162 1.636099 1.220316 1.860240 1.104417 0.911381 -0.221721 0.477919 0.648802 1.465706 1.034322 0.722603 0.484344 0.507547 1.362755 0.260305 0.012258 1.063129 0.125427 0.731236 1.951972 1.460277 1.336222 1.327980 0.292992 1.466729 0.979436 1.525635 1.525911 0.335487 0.473741 -0.076837 0.875218 0.622684 0.081840 0.662885 1.733616 0.541135 0.388849 0.020387 1.077932 1.301097 1.479384 0.696331 1.842813 0.869590 1.665039 0.472033 0.087064 0.068769 0.055497 0.502784 1.571676 1.461867 1.681430 0.147791 1.648422 1.206459 -0.037747 0.322247 1.620310 0.330283 0.874529 1.548328 0.082016 0.899640 0.252738 1.639547 1.115960 0.718372 1.473943 0.699136 1.736238 1.746811 1.089863 0.308838 1.120907 1.649835 0.230940 0.599980 0.596666 1.447764 0.198200 1.696185 0.270568 -0.052189 1.459685 1.889516 0.973187 0.172200 1.005083 0.140394 -0.325498 0.227479 1.423139 0.675559 1.625686 1.773134 1.707271 0.913240 1.631036 0.019460 -0.103583 0.286102 0.291320 0.171705 1.446563 0.484585 0.563140 1.120302 1.858354 -0.041253 1.012849 1.296992 1.301978 0.760269 1.753296 0.283422 0.885422 1.492344 1.329990 0.612597 1.921560 0.200214 0.943390 0.512296 1.447564 1.846183 1.707477 0.147308 1.193487 0.573805 0.940372 0.256928 1.884388 0.083286 0.452700 0.291224 0.183037 0.545393 0.513289 1.568504 0.086795 1.616080 0.313708 1.244178 1.366657 0.283715 0.918206 0.203207 1.448705 1.446830 1.040873 1.730698 1.611476 0.946093 0.666703 0.615895 -0.026318 1.856548 1.350941 0.160944 1.170338 0.103712 1.306411 1.265492 0.066769 0.766652 0.588182 1.233682 0.122447 1.681384 0.412335 0.178479 1.660841 1.811596 0.064779 1.196947 0.102828 1.177751 1.680742 0.449282 0.904230 1.612891 0.610492 1.241968 1.399466 0.400447 1.883535 1.261774 1.133011 0.954793 1.391021 0.070613 1.790155 0.647170 1.538113 0.897498 1.281308 0.839515 0.299338 1.976000 1.258249 1.677501 0.492876 0.811265 1.486293 1.219526 0.118255 0.198524 0.778925 0.559223 0.356595 0.911936 0.224097 0.843920 0.757074 1.245721 1.201767 1.503895 1.262673 1.087280 1.841884 0.809693 0.271807 0.201811 0.731278 1.725985 1.815260 0.626935 0.345144 1.819499 0.455162 1.284539 0.586586 -0.039343 1.180043 1.600481 1.257565 1.070955 1.769321 1.284756 0.544339 0.946351 1.252154 1.036230 1.576752 1.153164 0.375443 1.727961 1.571085 -0.025115 1.130257 1.617683 0.962908 1.778427 0.723156 0.083418 0.399245 1.317049 1.776371 1.599518 1.205637 0.260734 1.602902 0.159849 0.015420 1.100020 1.095699 0.079940 0.912501 0.640796 0.462014 0.677260 1.211741 1.516331 1.260972 0.602754 1.418955 1.106479 1.705887 -0.011794 -0.109286 0.655006 0.832139 0.926535 1.469372 0.543237 -0.034228 1.638292 1.960348 1.105376 1.332042 1.230009 0.928482 0.888952 0.046935 0.000507 1.314819 0.300831 0.937048 1.256196 0.493401 1.660853 0.728526 -0.110992 1.233577 0.930248 0.678472 -0.188603 1.218183 0.336483 1.191586 0.137376 1.533100 0.065052 0.981398 0.031577 0.994203 0.870125 0.262473 0.406748 0.511844 0.815002 0.421443 1.909838 1.226523 0.209198 0.929653 1.101747 0.799872 -0.201492 0.710339 1.291323 0.977953 1.379452 1.641037 0.096914 1.857579 -0.096609 0.337720 0.155086 0.269412 1.616182 0.568248 0.498010 1.652758 1.650958 0.244174 0.661813 1.505931 0.002924 0.107270 1.744250 -0.050778 1.467242 1.623260 0.801762 0.194925 0.642578 1.510339 1.586904 0.355100 0.041208 0.186780 1.201510 0.782417 -0.071305 1.709116 1.537271 1.490599 0.543263 -0.128944 1.746343 1.737663 -0.131604 0.721233 -0.033503 0.381659 0.516023 0.468830 0.968358 1.682010 1.574023 1.572387 0.110095 0.087750 1.339801 0.879220 0.721407 1.874303 0.700889 0.258858 1.621111 0.253234 1.424104 1.511284 0.981212 0.722846 0.700750 1.110812 0.395794 1.195186 0.912389 1.340990 0.476183 1.514745 1.613236 0.410309 0.055535 0.162381 0.534469 0.793452 1.780666 0.700207 1.016778 0.157602 0.161820 1.110015 0.882580 0.709147 1.213415 -0.036555 1.633111 1.171847 0.640753 0.205253 1.266074 1.492664 0.580884 0.765533 1.322154 0.370372 1.440758 0.830815 1.501849 1.539966 1.852372 0.365379 1.004282 1.053251 0.251083 0.118197)
+ ;; from (try-all :all 2048 2049 1.0476749041086 0.34832901677121) = 55.7655 start for next
+ 50.205430 (fv 0.000000 0.435841 1.590025 1.333909 1.800782 0.936896 0.640772 1.054371 0.276465 0.022204 0.420173 1.637156 1.317845 1.822696 0.936038 0.684182 1.165979 0.256451 0.034146 0.530882 1.581638 1.361041 1.855482 0.981545 0.775560 1.219427 0.308786 0.074234 0.592840 1.697019 1.456943 1.894603 1.053571 0.870395 1.260578 0.415941 0.216750 0.664998 1.768556 1.530284 0.017758 1.155044 0.880167 1.399032 0.522236 0.296590 0.788933 1.883168 1.702734 0.130840 1.241124 1.015672 1.506862 0.618786 0.413989 0.882191 0.040812 1.770208 0.266965 1.415350 1.179212 1.617452 0.837073 0.560382 1.039153 0.189709 0.008982 0.428192 1.582302 1.375969 1.775847 1.001684 0.722251 1.221935 0.371046 0.124429 0.658497 1.801753 1.557144 0.055429 1.167445 0.965998 1.463160 0.590632 0.421360 0.870506 1.979716 1.785918 0.217687 1.423155 1.229053 1.677639 0.820116 0.622279 1.118801 0.227079 0.047207 0.530002 1.646116 1.495215 1.938348 1.092314 0.858748 1.368355 0.507435 0.300967 0.831830 1.945902 1.701826 0.241789 1.346179 1.176339 1.698123 0.782522 0.593683 1.099893 0.220752 0.071121 0.492713 1.698729 1.537108 0.003593 1.112312 0.923924 1.420945 0.591862 0.368816 0.876237 0.024325 1.841665 0.349974 1.496560 1.313963 1.781383 0.909134 0.778966 1.228602 0.360482 0.169252 0.720535 1.827819 1.642014 0.151850 1.298858 1.132119 1.583582 0.775812 0.613883 1.034899 0.197663 0.038469 0.550873 1.681101 1.473296 0.002756 1.168244 0.976999 1.468806 0.641511 0.472463 0.917530 0.115543 1.932746 0.461045 1.615860 1.421110 1.916591 1.100326 0.915266 1.450442 0.570898 0.409829 0.895347 0.064350 1.886870 0.368337 1.508665 1.402167 1.875808 1.089074 0.915502 1.348721 0.569668 0.334905 0.845366 0.062665 1.931036 0.423161 1.570481 1.376249 1.892683 1.058012 0.892579 1.382946 0.530863 0.389584 0.911546 0.066065 1.944943 0.431750 1.524837 1.397825 1.916894 1.103011 0.925384 1.421598 0.609580 0.450668 0.957299 0.103861 0.017005 0.489835 1.632099 1.491083 0.040341 1.187478 1.048136 1.580660 0.750188 0.526672 1.095701 0.287178 0.103106 0.633176 1.805673 1.635672 0.181746 1.340109 1.155467 1.751104 0.863186 0.725371 1.256183 0.417821 0.247907 0.731305 1.971687 1.812887 0.362885 1.544484 1.346445 1.843347 1.064098 0.903511 1.425141 0.615217 0.470411 0.992301 0.186866 0.055090 0.515270 1.737073 1.613907 0.129315 1.316755 1.145516 1.689159 0.887610 0.688556 1.250192 0.483418 0.277491 0.831631 -0.015312 1.878418 0.427015 1.584482 1.443552 1.963597 1.131045 1.053018 1.569404 0.748022 0.602632 1.105250 0.310334 0.191836 0.693611 1.868001 1.741296 0.244951 1.472171 1.322184 1.879876 1.046328 0.929137 1.487162 0.690252 0.536393 1.028834 0.241099 0.137310 0.681359 1.872418 1.703102 0.276974 1.417116 1.322284 1.892467 1.055982 0.931972 1.453120 0.680784 0.569223 1.072473 0.292525 0.179779 0.702639 1.907779 1.763892 0.296945 1.502504 1.403596 1.895642 1.078898 1.020313 1.582828 0.728374 0.631181 1.177822 0.386973 0.229679 0.763366 -0.020603 1.884762 0.449056 1.615978 1.445670 0.076665 1.319406 1.139316 1.687368 0.868342 0.754364 1.316715 0.562902 0.373746 0.962616 0.143265 0.060537 0.597136 1.794156 1.674512 0.244828 1.423610 1.307469 1.861513 1.128650 1.011922 1.509496 0.793005 0.646450 1.183857 0.401441 0.274501 0.848007 0.152648 1.938838 0.515464 1.751327 1.585203 0.128719 1.344067 1.257980 1.813937 1.034672 0.961830 1.482792 0.710147 0.627952 1.158173 0.396545 0.308224 0.839308 0.084640 1.949979 0.467374 1.766014 1.652675 0.156038 1.404099 1.323696 1.916673 1.129204 1.007203 1.565692 0.792625 0.676519 1.246538 0.476588 0.355046 0.897504 0.154095 0.032713 0.616322 1.822050 1.713319 0.339487 1.549436 1.415806 -0.029700 1.251496 1.105739 1.706293 0.927616 0.827632 1.429701 0.652859 0.511881 1.153658 0.364245 0.227734 0.828965 0.039610 1.955264 0.489121 1.779904 1.680272 0.264792 1.492297 1.379563 1.958496 1.182126 1.073866 1.647475 0.887025 0.759908 1.352711 0.598690 0.504193 1.064292 0.364855 0.256068 0.821048 0.072182 1.978457 0.553596 1.801077 1.686861 0.245374 1.501095 1.463244 0.048757 1.270724 1.195638 1.795159 0.991907 0.929823 1.498115 0.775504 0.635637 1.221022 0.502033 0.392861 1.015769 0.238715 0.139376 0.772010 -0.001203 1.966386 0.502478 1.754699 1.653913 0.238134 1.455433 1.421962 0.005716 1.237219 1.195953 1.785244 1.034444 0.946973 1.522226 0.772000 0.724085 1.279219 0.566698 0.471639 1.081117 0.318698 0.216243 0.869842 0.093780 0.035928 0.580682 1.866189 1.774688 0.335441 1.640447 1.567092 0.150911 1.385331 1.332318 1.956070 1.197687 1.107245 1.722318 0.935373 0.939612 1.481560 0.775194 0.705562 1.294862 0.556921 0.470799 1.085453 0.374791 0.241371 0.872640 0.127624 0.032808 0.648015 1.958410 1.857207 0.450764 1.687826 1.673077 0.276455 1.524057 1.465118 0.092578 1.331259 1.262485 1.865029 1.129716 1.070468 1.691226 0.954621 0.907368 1.547298 0.800536 0.754442 1.318798 0.655491 0.523948 1.167921 0.458202 0.394916 0.974268 0.209530 0.172260 0.769859 0.045732 -0.027787 0.639418 1.895968 1.831369 0.455565 1.755348 1.702164 0.323430 1.549605 1.507505 0.099809 1.366067 1.343189 1.936579 1.213931 1.207459 1.780054 1.037769 1.005956 1.688129 0.918293 0.876995 1.491983 0.755576 0.731170 1.306379 0.613008 0.560202 1.151819 0.453386 0.401075 1.052899 0.336562 0.307092 0.918155 0.200321 0.133534 0.755336 0.041372 -0.036174 0.643495 1.904976 1.892087 0.486352 1.795593 1.721679 0.369291 1.607795 1.576284 0.213583 1.494045 1.463382 0.080370 1.381980 1.326067 1.977786 1.247994 1.213791 1.878128 1.145632 1.125599 1.744040 1.003768 0.975298 1.655044 0.946812 0.902005 1.481429 0.838355 0.806420 1.384034 0.676425 0.687951 1.289459 0.584933 0.544028 1.143652 0.530696 0.446531 1.060469 0.381371 0.383221 0.985636 0.284345 0.259040 0.894751 0.181035 0.155719 0.802236 0.121624 0.058494 0.696055 -0.033257 -0.009001 0.631717 1.933686 1.907503 0.526027 1.815256 1.827541 0.422361 1.751874 1.770954 0.332622 1.681580 1.649270 0.311710 1.607800 1.583524 0.245744 1.540534 1.499654 0.148625 1.457370 1.373290 0.075021 1.394843 1.347459 -0.005752 1.303682 1.317955 1.926281 1.233373 1.253750 1.868046 1.183593 1.200479 1.828734 1.154318 1.138091 1.739705 1.063036 1.026015 1.760005 1.052209 0.997647 1.670582 1.013683 0.946378 1.618597 0.957911 0.901792 1.567409 0.889999 0.912144 1.559979 0.891151 0.880294 1.500532 0.874896 0.781828 1.470208 0.813331 0.808539 1.418100 0.746813 0.751008 1.419231 0.717221 0.726739 1.410727 0.731944 0.676864 1.409264 0.642315 0.664365 1.364908 0.686123 0.651596 1.257741 0.652814 0.617542 1.306260 0.604389 0.592953 1.273395 0.605575 0.615524 1.252456 0.600454 0.596734 1.273260 0.596265 0.607909 1.252575 0.565927 0.570637 1.242139 0.541616 0.579959 1.248588 0.553529 0.579117 1.248565 0.574621 0.589047 1.309100 0.589822 0.602557 1.287938 0.578939 0.630286 1.280033 0.567074 0.622654 1.240139 0.594827 0.651875 1.291451 0.614140 0.689991 1.288405 0.659401 0.658369 1.319440 0.687094 0.674513 1.346708 0.688976 0.753907 1.375336 0.762674 0.739012 1.414601 0.787609 0.775338 1.420075 0.806180 0.800733 1.486208 0.845147 0.821967 1.516891 0.910404 0.867286 1.542889 0.887043 0.903213 1.634817 0.952223 0.964661 1.682581 0.979874 1.017143 1.672617 0.994877 1.107400 1.788990 1.110961 1.073654 1.789664 1.138909 1.162757 1.815050 1.225817 1.210897 1.926791 1.302244 1.265372 -0.026931 1.330408 1.387907 0.023026 1.451566 1.422994 0.130173 1.484590 1.521586 0.183712 1.551561 1.583662 0.282642 1.591114 1.655077 0.304500 1.684251 1.694195 0.429792 1.769650 1.808357 0.487540 1.818396 1.853851 0.530630 1.955039 -0.119812 0.676604 0.023437 0.063422 0.780580 0.147218 0.198738 0.872448 0.220227 0.252425 0.986952 0.295255 0.393016 1.036257 0.448018 0.427099 1.156162 0.552881 0.530707 1.267911 0.635862 0.680452 1.365591 0.735775 0.797614 1.468054 0.829271 0.858249 1.597356 0.963427 0.979328 1.664777 1.072381 1.131497 1.848461 1.213953 1.199832 1.960555 1.304633 1.318228 0.076788 1.452570 1.479484 0.164500 1.572776 1.636533 0.356533 1.684649 1.726841 0.451773 1.812513 1.874046 0.543934 1.930798 1.972699 0.744026 0.063643 0.159361 0.823095 0.219497 0.299864 0.954777 0.358746 0.414413 1.115727 0.519760 0.542990 1.311137 0.651203 0.710761 1.454950 0.772652 0.872236 1.543810 0.968311 1.006341 1.723434 1.088664 1.231621 1.884135 1.281249 1.347331 0.036078 1.419412 1.446527 0.204240 1.613579 1.679100 0.340114 1.736107 1.840278 0.571743 1.943781 0.023224 0.697394 0.138951 0.151958 0.882054 0.266019 0.342269 1.098555 0.488882 0.520277 1.270261 0.682615 0.682051 1.423350 0.809398 0.923761 1.649263 1.068684 1.091760 1.803833 1.223733 1.263221 0.017517 1.421547 1.466248 0.224731 1.593966 1.649396 0.409457 1.781845 1.845835 0.622136 -0.009609 0.077538 0.792485 0.188358 0.288489 1.013605 0.431185 0.495730 1.211960 0.604816 0.676648 1.456905 0.844139 0.905285 1.630909 1.032426 1.128266 1.853145 1.262038 1.300211 0.056675 1.467598 1.530064 0.291293 1.687552 1.755257 0.468236 1.938565 -0.011915 0.736090 0.173114 0.213450 0.994156 0.364997 0.457458 1.187825 0.639595 0.686838 1.462796 0.854330 0.903639 1.704943 1.071752 1.179798 1.898999 1.338040 1.405342 0.147449 1.639838 1.676028 0.379818 1.815921 1.886234 0.634529 0.079207 0.176862 0.921077 0.270512 0.406031 1.127890 0.593242 0.648029 1.403498 0.841450 0.919674 1.687653 1.135150 1.209027 1.975682 1.393578 1.449497 0.153208 1.639075 1.709636 0.452445 1.874711 0.022432 0.714196 0.206678 0.205405 0.997873 0.413099 0.533511 1.297878 0.703835 0.801048 1.536439 0.962427 1.059551 1.860285 1.319040 1.383017 0.135002 1.534723 1.648532 0.422108 1.844915 1.956976 0.704238 0.117947 0.249102 1.002403 0.473197 0.500625 1.262507 0.728698 0.830758 1.550450 1.042097 1.137051 1.913071 1.319323 1.401617 0.205540 1.634001 1.717675 0.487628 1.929708 0.032724 0.779967 0.225924 0.383724 1.109069 0.562827 0.649848 1.460986 0.840877 0.966680 1.747337 1.203625 1.315331 0.088823 1.496248 1.629011 0.431806 1.822514 1.942005 0.728686 0.158211 0.297041 1.029719 0.522309 0.626677 1.357536 0.800226 0.986575 1.730215 1.163174 1.231016 0.034610 1.521930 1.589379 0.414306 1.841215 1.927232 0.696438 0.186996 0.290301 1.088563 0.519977 0.648216 1.417722 0.845987 1.012127 1.780754 1.219818 1.368384 0.133468 1.552692 1.697685 0.489975 1.948146 0.025352 0.835325 0.308902 0.425789 1.189446 0.647629 0.780553 1.534982 0.953650 1.144994 1.982784 1.383491 1.490496 0.239036 1.733469 1.907366 0.658487 0.109199 0.230682 1.052834 0.517391 0.608626 1.405419 0.866368 0.974067 1.812201 1.250521 1.390848 0.148194 1.623658 1.769017 0.559808 0.019981 0.093630 0.962157 0.385643 0.557254 1.332258 0.775494 0.936936 1.712764 1.224080 1.333572 0.130012 1.553976 1.733749 0.509265 0.048320 0.120671 0.899273 0.371543 0.562577 1.333084 0.820342 0.953357 1.769820 1.220433 1.358228 0.127107 1.579894 1.763318 0.586085 0.056061 0.168973 0.987419 0.437016 0.613035 1.379444 0.892129 1.014623 1.821313 1.267297 1.418105 0.246254 1.755013 1.842641 0.624100 0.156213 0.268757 1.103436 0.559665 0.758240 1.532549 1.036259 1.153852 1.946220 1.432069 1.593807 0.418226 1.855454 0.035725 0.832622 0.314591 0.476792 1.257265 0.773297 0.905003 1.712302 1.200651 1.350735 0.149477 1.642212 1.802991 0.603766 0.109674 0.272495 1.104655 0.552848 0.662208 1.508113 0.969884 1.222187 1.957345 1.483565 1.659081 0.418223 1.951257 0.147291 0.901050 0.444550 0.555960 1.394491 0.833321 1.009746 1.850858 1.330172 1.483655 0.313675 1.811415 -0.000236 0.794841 0.301262 0.490013 1.322742 0.745660 0.925074 1.784514 1.271636 1.375387 0.219194 1.716991 1.919514 0.731082 0.283071 0.394652 1.209183 0.703971 0.883949 1.723347 1.226581 1.417977 0.169502 1.728678 1.897967 0.751809 0.206641 0.351287 1.193966 0.679687 0.833001 1.679398 1.202836 1.369136 0.221180 1.698828 1.890944 0.736466 0.259414 0.428156 1.246968 0.715069 0.887462 1.766067 1.234005 1.366933 0.267319 1.785542 1.921115 0.782951 0.288312 0.432145 1.324227 0.812529 0.987537 1.849387 1.334204 1.550652 0.384742 1.887557 0.032221 0.888154 0.427508 0.583364 1.373198 0.935366 1.078859 1.962687 1.425781 1.648177 0.492137 0.010583 0.174236 1.065860 0.556317 0.711714 1.613293 1.102246 1.261519 0.161159 1.621868 1.845116 0.621649 0.151344 0.408750 1.266111 0.733611 0.981402 1.781143 1.313677 1.478251 0.389746 1.864238 0.058118 0.877935 0.412750 0.590919 1.454967 0.995341 1.160158 0.052979 1.551988 1.735067 0.575701 0.113408 0.309369 1.203349 0.691004 0.901203 1.755113 1.285355 1.469400 0.316179 1.835734 0.063761 0.937353 0.419020 0.615917 1.461648 1.030447 1.209615 0.096211 1.589011 1.815774 0.626322 0.175182 0.402805 1.254295 0.809294 0.981937 1.881195 1.349170 1.565323 0.444505 1.905301 0.141863 1.013394 0.599160 0.768860 1.639481 1.173121 1.378015 0.207298 1.781004 -0.005481 0.841053 0.359648 0.584036 1.466213 1.014043 1.198019 0.047150 1.611088 1.803839 0.693503 0.251733 0.378659 1.292988 0.846097 1.025550 1.895967 1.457063 1.643561 0.544671 0.078331 0.286831 1.144981 0.701288 0.911563 1.800290 1.360060 1.533921 0.464563 1.970167 0.187072 1.028247 0.574824 0.822213 1.719286 1.250441 1.465682 0.304625 1.883042 0.150589 0.966248 0.508969 0.740351 1.592154 1.164985 1.396695 0.251798 1.797977 0.055983 0.893992 0.460716 0.676688 1.575389 1.096148 1.354511 0.224581 1.739098 0.014063 0.882137 0.432033 0.697360 1.575477 1.060614 1.342466 0.184638 1.767539 1.986710 0.880248 0.447116 0.686853 1.534981 1.149302 1.322036 0.217110 1.750455 -0.028293 0.927727 0.463276 0.699948 1.574079 1.122276 1.344937 0.239499 1.798792 0.041111 0.901108 0.502016 0.734564 1.619516 1.235793 1.392027 0.313428 1.875178 0.114986 0.986008 0.554567 0.774672 1.670995 1.277666 1.490688 0.422851 1.938664 0.192686 1.081363 0.636062 0.878896 1.801674 1.320125 1.610705 0.510337 0.119965 0.288198 1.229365 0.736391 0.974652 1.921844 1.522756 1.760341 0.627784 0.195364 0.424026 1.350173 0.914137 1.149417 0.055182 1.641041 1.885754 0.774177 0.341638 0.609082 1.476268 1.075234 1.336728 0.232957 1.816024 0.059891 0.977615 0.583895 0.818725 1.691585 1.233407 1.522719 0.426347 -0.011898 0.222340 1.211913 0.738174 1.037566 1.889523 1.491590 1.769255 0.654387 0.200388 0.477881 1.388587 0.995612 1.263033 0.151400 1.737244 1.994853 0.888393 0.448480 0.715631 1.639779 1.266990 1.475739 0.402022 0.001228 0.277508 1.193996 0.717293 1.022382 1.945731 1.528880 1.769925 0.676796 0.308016 0.544866 1.452245 1.056044 1.374139 0.251435 1.839100 0.082677 1.030130 0.593594 0.869317 1.751919 1.380599 1.660743 0.544875 0.134766 0.419262 1.359116 0.926374 1.200425 0.154745 1.776244 0.028854 0.907934 0.517864 0.744877 1.733023 1.291145 1.589046 0.524515 0.143068 0.380331 1.270800 0.877957 1.158416 0.095496 1.721531 1.962074 0.894065 0.487382 0.748783 1.673707 1.270037 1.572661 0.487139 0.118310 0.353424 1.330880 0.967912 1.217091 0.192030 1.746726 -0.008521 0.972139 0.569214 0.836629 1.792874 1.387645 1.624565 0.632818 0.169837 0.496488 1.391429 1.038248 1.276246 0.204951 1.839860 0.124740 1.060001 0.657481 0.979959 1.891365 1.498561 1.801028 0.717400 0.315222 0.620564 1.593479 1.178952 1.451115 0.404598 -0.005528 0.313885 1.242306 0.875831 1.127959 0.103028 1.705375 0.012699 0.926034 0.577294 0.846113 1.771401 1.375194 1.686187 0.652973 0.275173 0.528957 1.475197 1.099695 1.450803 0.394864 0.006041 0.319714 1.201074 0.888068 1.130526 0.060555 1.730127 0.003973 0.970567 0.557199 0.876983 1.840537 1.453875 1.730436 0.638584 0.293627 0.612145 1.531639 1.167803 1.518469 0.454591 0.106958 0.368985 1.332865 0.982631 1.260304 0.220211 1.799722 0.130226 1.090090 0.701451 1.045234 1.992618 1.626535 1.912666 0.832021 0.542880 0.767909 1.778263 1.387748 1.677161 0.622205 0.269109 0.574635 1.558243 1.182994 1.450696 0.491452 0.103672 0.400119 1.344518 0.981223 1.258072 0.251476 1.912489 0.232691 1.206418 0.805953 1.119358 0.155055 1.751168 0.097851 1.025890 0.706010 0.960410 1.942316 1.626433 1.884328 0.851879 0.504554 0.821261 1.761778 1.407905 1.711340 0.647584 0.347790 0.647152 1.648746 1.244924 1.563845 0.588763 0.158974 0.503437 1.536265 1.121954 1.454121 0.423763 0.114434 0.400278 1.338609 0.993706 1.358821 0.328396 1.956735 0.261393 1.267373 0.955613 1.253328 0.224608 1.856628 0.199058 1.200999 0.819656 1.137486 0.135404 1.793163 0.131100 1.078350 0.741351 1.039393 0.045261 1.699515 0.034737 0.942610 0.684756 0.956308 1.947394 1.633657 1.953278 0.904052 0.580961 0.913879 1.941411 1.519052 1.840622 0.910119 0.527420 0.861293 1.849422 1.475381 1.830601 0.799091 0.501857 0.787766 1.823294 1.467731 1.806424 0.805269 0.474582 0.781946 1.776540 1.418537 1.762883 0.746070 0.408613 0.726389 1.745127 1.428283 1.754540 0.728069 0.441878 0.746600 1.796204 1.449997 1.776429 0.722670 0.436401 0.744719 1.778994 1.480572 1.763916 0.815336 0.489032 0.764749 1.811814 1.487438 1.838366 0.811299 0.501320 0.823771 1.854833 1.502868 1.856794 0.827719 0.514633 0.852477 1.882215 1.488580 1.848649 0.877645 0.587786 0.926814 1.877153 1.575992 1.906019 0.886676 0.595984 0.881146 1.940054 1.606287 1.971408 0.988642 0.638192 0.966941 -0.034374 1.681077 0.038373 1.056408 0.657252 1.076689 0.087476 1.760605 0.121715 1.145163 0.789531 1.173448 0.151127 1.823534 0.220276 1.230586 0.960040 1.285670 0.295263 1.934113 0.314088 1.332202 1.053238 1.375323 0.392866 0.077220 0.422213 1.491168 1.127803 1.497376 0.554172 0.257811 0.586449 1.609325 1.351152 1.703027 0.627074 0.353088 0.709213 1.720064 1.442884 1.782680 0.814896 0.553387 0.852715 1.895941 1.554321 1.962098 1.013833 0.655921 0.994618 0.054934 1.764435 0.062870 1.163046 0.871528 1.257156 0.223435 1.905372 0.338569 1.306277 0.999931 1.337253 0.417104 0.138892 0.412245 1.511698 1.256056 1.543124 0.590173 0.339601 0.650455 1.683826 1.408811 1.811474 0.828456 0.526423 0.859787 1.896452 1.608591 1.948197 0.987654 0.706760 1.085696 0.133347 1.825976 0.258446 1.274079 0.944752 1.296320 0.326958 0.024339 0.456524 1.468787 1.203458 1.509480 0.615416 0.269963 0.688191 1.723537 1.390152 1.854907 0.886894 0.581734 0.936911 -0.009509 1.698888 0.060556 1.142012 0.859242 1.247280 0.274968 1.947669 0.305504 1.435482 1.121364 1.480498 0.522708 0.241328 0.603319 1.705040 1.426237 1.816412 0.844853 0.559458 0.950007 -0.864208 1.718587 0.075844 1.114880 0.838172 1.221123 0.266618 0.058618 0.363782 1.417961 1.157081 1.554190 0.607338 0.348635 0.729484 1.765027 1.524808 1.887413 0.942863 0.666378 1.035608 0.084672 1.857745 0.236807 1.282523 1.041036 1.443839 0.463754 0.200441 0.623163 1.679375 1.373487 1.771844 0.850867 0.606126 0.995693 0.033893 1.821449 0.146087 1.202112 0.961147 1.370514 0.434572 0.169771 0.556607 1.637108 1.396269 1.729452 0.842038 0.609721 0.932603 0.015326)
)
-;;; 4096 155.67; (expt 4096 .6) is 147
-;;; 65536 704.86! [.59 = 697, .5 = 256]
))
+;; :all 65536 (320.768635104 1.6604741485419 0.83776099628482) 0.52033682944489
+;; :all 65536 (309.91637906494 0.64007539845073 4.5547029008803e-05) 0.5172334495671 (0)
+;; :all 65536 (303.64661814299 1.3570805366568 -4.6971909684279e-05) 0.5153905931919 (200)
+
+;; :all 131072 (438.77509431894 1.4462367399126 2.0944027696821) 0.51631398987158 (sqrt: 362)
+
+
;;; ---------------------------------------- odd numbered harmonics ----------------------------------------
(define nodd-min-peak-phases (vector
-#(1 1.0 #(0)
+(vector 1 1.0 (fv 0)
)
-#(2 1.539 #(0 0)
+(vector 2 1.539 (fv 0 0)
)
;;; 3 odd --------------------------------------------------------------------------------
-#(3 1.7548747062683 #(0 1 1)
+(vector 3 1.7548747062683 (fv 0 1 1)
- 1.7393749801561 #(0.0 1.205686890924528215096600547440175432712E0 1.297035953235478072942399307976302225143E0)
- 1.7387926578522 #(0.0 1.2094986438751 1.3025436401367)
- 1.7387455701828 #(0.0 0.79018270969391 0.69699490070343)
+ 1.7393749801561 (fv 0.0 1.205686890924528215096600547440175432712E0 1.297035953235478072942399307976302225143E0)
+ 1.7387926578522 (fv 0.0 1.2094986438751 1.3025436401367)
+ 1.7387455701828 (fv 0.0 0.79018270969391 0.69699490070343)
- 1.738745 #(0.000000 1.209826 1.303017)
- 1.738744 #(0.000000 0.790172 0.696980)
+ 1.738745 (fv 0.000000 1.209826 1.303017)
+ 1.738744 (fv 0.000000 0.790172 0.696980)
)
;;; 4 odd --------------------------------------------------------------------------------
-#(4 2.19460272789 #(0 1 0 0)
+(vector 4 2.19460272789 (fv 0 1 0 0)
- 2.050 #(0 39/25 26/29 27/22)
- 2.048743724823 #(0 111/256 281/256 195/256)
- 2.0466175079346 #(0 223/512 563/512 49/64)
+ 2.050 (fv 0 39/25 26/29 27/22)
+ 2.048743724823 (fv 0 111/256 281/256 195/256)
+ 2.0466175079346 (fv 0 223/512 563/512 49/64)
- 2.045218 #(0.000000 1.563819 0.899661 1.233860)
- 2.045217 #(0.000000 0.436172 1.100327 0.766122)
+ 2.045218 (fv 0.000000 1.563819 0.899661 1.233860)
+ 2.045217 (fv 0.000000 0.436172 1.100327 0.766122)
)
;;; 5 odd -------------------------------------------------------------------------------- ; 2.2360679
-#(5 2.7317879199982 #(0 1 1 0 0)
+(vector 5 2.7317879199982 (fv 0 1 1 0 0)
- 2.3731805734023 #(0 7/16 7/4 5/8 7/16)
+ 2.3731805734023 (fv 0 7/16 7/4 5/8 7/16)
- 2.307252 #(0.000000 0.393369 1.754476 0.596108 0.424804)
- 2.307253 #(0.000000 1.606636 0.245540 1.403918 1.575230)
+ 2.307252 (fv 0.000000 0.393369 1.754476 0.596108 0.424804)
+ 2.307253 (fv 0.000000 1.606636 0.245540 1.403918 1.575230)
)
;;; 6 odd -------------------------------------------------------------------------------- ; 2.44948
-#(6 2.8638670444489 #(0 0 0 0 1 0)
+(vector 6 2.8638670444489 (fv 0 0 0 0 1 0)
- 2.522759 #(0.000000 1.360421 1.129847 1.035439 1.320248 0.102465)
- 2.522749 #(0.000000 0.639403 0.869779 0.964074 0.679243 -0.103102)
+ 2.522759 (fv 0.000000 1.360421 1.129847 1.035439 1.320248 0.102465)
+ 2.522749 (fv 0.000000 0.639403 0.869779 0.964074 0.679243 -0.103102)
)
;;; 7 odd -------------------------------------------------------------------------------- ; 2.64575
-#(7 2.9204399585724 #(0 0 0 1 1 0 1)
+(vector 7 2.9204399585724 (fv 0 0 0 1 1 0 1)
- 2.618497 #(0.000000 1.527527 0.524623 0.177241 0.453108 1.577456 1.970355)
- 2.618376 #(0.000000 0.474123 1.477585 1.824644 1.552691 0.429533 0.035303)
+ 2.618497 (fv 0.000000 1.527527 0.524623 0.177241 0.453108 1.577456 1.970355)
+ 2.618376 (fv 0.000000 0.474123 1.477585 1.824644 1.552691 0.429533 0.035303)
+ 2.618302 (fv 0.000000 0.474154 1.477730 1.824846 1.552894 0.429720 0.035636)
)
;;; 8 odd -------------------------------------------------------------------------------- ; 2.828427
-#(8 3.2507002353668 #(0 1 1 0 1 1 1 0)
+(vector 8 3.2507002353668 (fv 0 1 1 0 1 1 1 0)
- 2.8071956634521 #(0 109/128 7/4 1 13/16 123/64 21/128 43/128)
+ 2.8071956634521 (fv 0 109/128 7/4 1 13/16 123/64 21/128 43/128)
- 2.791000 #(0.000000 1.197326 0.326760 1.111456 1.318751 0.231304 1.994192 1.872649)
- 2.790858 #(0.000000 0.802399 1.672681 0.887888 0.680265 1.767889 0.004580 0.126233)
- 2.790799 #(0.000000 1.197514 0.327251 1.112061 1.319778 0.232086 -0.004810 -0.126263)
+ 2.790858 (fv 0.000000 0.802399 1.672681 0.887888 0.680265 1.767889 0.004580 0.126233)
+ 2.790799 (fv 0.000000 1.197514 0.327251 1.112061 1.319778 0.232086 -0.004810 -0.126263)
+ 2.790663 (fv 0.000000 1.196617 0.325818 1.109894 1.316877 0.229200 -0.008217 -0.130363)
)
;;; 9 odd -------------------------------------------------------------------------------- ; 3
-#(9 3.5549147642153 #(0 1 0 1 1 0 0 0 0)
- 3.46973755015 #(0 1 1 0 1 0 0 0 1)
- 3.4140722751617 #(0 0 1 1 1 1 0 1 0)
+(vector 9 3.4140722751617 (fv 0 0 1 1 1 1 0 1 0)
- 2.886575 #(0.000000 0.394663 0.625974 1.648922 0.070810 1.803585 1.908749 0.903752 0.378081)
- 2.886464 #(0.000000 1.605518 1.374012 0.351118 1.929257 0.196622 0.091381 1.096286 1.622082)
+ 2.886575 (fv 0.000000 0.394663 0.625974 1.648922 0.070810 1.803585 1.908749 0.903752 0.378081)
+ 2.886464 (fv 0.000000 1.605518 1.374012 0.351118 1.929257 0.196622 0.091381 1.096286 1.622082)
+ 2.886241 (fv 0.000000 1.605727 1.374318 0.351747 1.930232 0.197770 0.092557 1.097753 1.623786)
)
;;; 10 odd -------------------------------------------------------------------------------- ; 3.162277
-#(10 3.5391488075256 #(0 0 1 1 0 1 0 0 0 0)
+(vector 10 3.5391488075256 (fv 0 0 1 1 0 1 0 0 0 0)
- 3.054055 #(0.000000 0.508058 0.119325 0.663858 1.627094 1.847660 0.043999 1.283121 0.512586 0.295891)
- 3.054035 #(0.000000 0.528914 0.163543 0.741593 1.737455 -0.019531 0.179460 1.441592 0.691200 0.513749)
- 3.054019 #(0.000000 1.467927 1.828996 1.243932 0.242207 -0.005741 1.795358 0.528965 1.275954 1.445527)
+ 3.054055 (fv 0.000000 0.508058 0.119325 0.663858 1.627094 1.847660 0.043999 1.283121 0.512586 0.295891)
+ 3.054035 (fv 0.000000 0.528914 0.163543 0.741593 1.737455 -0.019531 0.179460 1.441592 0.691200 0.513749)
+ 3.054019 (fv 0.000000 1.467927 1.828996 1.243932 0.242207 -0.005741 1.795358 0.528965 1.275954 1.445527)
- 3.053923 #(0.000000 0.530606 0.167556 0.749983 1.748996 -0.005015 0.193787 1.458258 0.709754 0.536958)
- 3.053807 #(0.000000 0.524885 0.155185 0.727764 -0.282439 -0.043214 0.155190 1.412864 0.658810 0.474600)
+ 3.053923 (fv 0.000000 0.530606 0.167556 0.749983 1.748996 -0.005015 0.193787 1.458258 0.709754 0.536958)
+ 3.053807 (fv 0.000000 0.524885 0.155185 0.727764 -0.282439 -0.043214 0.155190 1.412864 0.658810 0.474600)
+ 3.053435 (fv 0.000000 0.525383 0.155614 0.727601 -0.282536 -0.043650 0.155330 1.412909 0.659050 0.474369)
)
;;; 11 odd -------------------------------------------------------------------------------- ; 3.31662
-#(11 3.6182308197021 #(0 0 0 1 1 1 0 1 1 0 1) ; 3.31662
+(vector 11 3.6182308197021 (fv 0 0 0 1 1 1 0 1 1 0 1) ; 3.31662
- 3.177383 #(0.000000 1.758655 0.386236 -0.008172 1.159122 0.785208 0.739625 0.606297 1.367332 0.311355 0.827147)
- 3.177220 #(0.000000 0.232935 1.599549 -0.005436 0.822576 1.185453 1.230375 1.357659 0.594255 1.644007 1.122113)
- 3.177201 #(0.000000 1.748294 0.370273 -0.021500 1.141958 0.751903 0.709536 0.566072 1.323348 0.262962 0.769859)
+ 3.177383 (fv 0.000000 1.758655 0.386236 -0.008172 1.159122 0.785208 0.739625 0.606297 1.367332 0.311355 0.827147)
+ 3.177220 (fv 0.000000 0.232935 1.599549 -0.005436 0.822576 1.185453 1.230375 1.357659 0.594255 1.644007 1.122113)
+ 3.177201 (fv 0.000000 1.748294 0.370273 -0.021500 1.141958 0.751903 0.709536 0.566072 1.323348 0.262962 0.769859)
- 3.177182 #(0.000000 1.764972 0.396592 0.001274 1.171590 0.806702 0.760785 0.632485 1.395663 0.343598 0.864498)
- 3.177098 #(0.000000 1.745038 0.362715 -0.030740 1.128748 0.736155 0.690326 0.545405 1.303285 0.236832 0.743503)
+ 3.177182 (fv 0.000000 1.764972 0.396592 0.001274 1.171590 0.806702 0.760785 0.632485 1.395663 0.343598 0.864498)
+ 3.177098 (fv 0.000000 1.745038 0.362715 -0.030740 1.128748 0.736155 0.690326 0.545405 1.303285 0.236832 0.743503)
+ 3.176608 (fv 0.000000 1.744464 0.362417 -0.030039 1.129933 0.735652 0.691339 0.545454 1.302582 0.237082 0.742494)
)
;;; 12 odd -------------------------------------------------------------------------------- ; 3.464101
-#(12 4.0877377663658 #(0 0 0 0 1 0 1 0 0 1 1 0)
- 4.0507665657231 #(0 1 0 1 0 0 1 1 0 0 0 0)
- 4.0 #(0 0 1 1 0 0 0 0 0 1 0 1)
- 4.0 #(0 1 1 0 1 0 0 0 1 0 0 0)
- 4.0 #(0 1 0 1 0 0 1 0 0 1 1 1)
- 4.0 #(0 1 0 1 1 0 0 1 0 0 0 0)
+(vector 12 4.0 (fv 0 0 1 1 0 0 0 0 0 1 0 1)
- 3.364341 #(0.000000 -0.081820 1.399778 1.018584 0.994103 1.854492 0.464370 0.769854 0.179932 0.999593 0.618367 1.331545)
- 3.363698 #(0.000000 0.073271 0.585961 0.960666 0.978302 0.113696 1.500041 1.186734 1.772452 0.944338 1.321484 0.602060)
- 3.362737 #(0.000000 -0.077029 1.405769 1.027930 1.006574 1.870564 0.481680 0.791450 0.202834 1.026360 0.648485 1.363973)
+ 3.363698 (fv 0.000000 0.073271 0.585961 0.960666 0.978302 0.113696 1.500041 1.186734 1.772452 0.944338 1.321484 0.602060)
+ 3.362737 (fv 0.000000 -0.077029 1.405769 1.027930 1.006574 1.870564 0.481680 0.791450 0.202834 1.026360 0.648485 1.363973)
+ 3.361884 (fv 0.000000 -0.077168 1.405944 1.028559 1.007566 1.871331 0.482574 0.792122 0.203932 1.027727 0.649507 1.365630)
)
;;; 13 odd -------------------------------------------------------------------------------- ; 3.60555
-#(13 3.9482246631869 #(0 0 0 0 0 0 1 1 0 0 1 0 1)
- 3.8778836727142 #(0 0 1 1 0 0 1 0 1 0 0 0 0)
+(vector 13 3.8778836727142 (fv 0 0 1 1 0 0 1 0 1 0 0 0 0)
- 3.531897 #(0.000000 0.670162 -0.095257 0.537542 -0.014805 0.385445 0.484518 1.431811 0.066607 0.001633 1.257240 0.820923 0.574587)
- 3.476053 #(0.000000 0.380793 0.961293 0.353157 0.446308 0.965358 0.539394 0.172183 -0.067910 0.976833 -0.486927 1.072643 -0.036066)
- 3.475486 #(0.000000 1.620375 1.040657 1.650169 1.557159 1.039441 1.466014 -0.165746 0.075570 1.032228 0.496820 0.937529 0.047188)
- 3.475452 #(0.000000 1.620672 1.042066 1.652912 1.561748 1.044454 1.472771 -0.159565 0.082334 1.041828 0.507070 0.948164 0.058404)
+ 3.476053 (fv 0.000000 0.380793 0.961293 0.353157 0.446308 0.965358 0.539394 0.172183 -0.067910 0.976833 -0.486927 1.072643 -0.036066)
+ 3.475486 (fv 0.000000 1.620375 1.040657 1.650169 1.557159 1.039441 1.466014 -0.165746 0.075570 1.032228 0.496820 0.937529 0.047188)
+ 3.475452 (fv 0.000000 1.620672 1.042066 1.652912 1.561748 1.044454 1.472771 -0.159565 0.082334 1.041828 0.507070 0.948164 0.058404)
+ 3.474532 (fv 0.000000 1.621213 1.042646 1.653413 1.561849 1.044891 1.473168 -0.158623 0.083544 1.042513 0.507800 0.949479 0.059341)
)
;;; 14 odd -------------------------------------------------------------------------------- ; 3.741657
-#(14 4.2126383781433 #(0 0 0 0 0 1 1 0 0 1 0 1 0 0)
- 4.2575645446777 #(0 1 0 0 1 0 0 1 0 0 0 1 1 1)
- 4.2842662512094 #(0 1 1 0 0 1 1 1 0 1 0 0 0 0)
+(vector 14 4.2842662512094 (fv 0 1 1 0 0 1 1 1 0 1 0 0 0 0)
- 3.6206462 #(0.000000 1.058317 0.285078 1.806037 0.777548 1.158566 0.154927 1.434637 1.675813 0.358961 0.394684 0.549621 0.067593 0.064796)
- 3.606512 #(0.000000 0.785150 1.482463 -0.077041 0.773052 0.357080 1.202237 -0.069790 1.584889 0.769902 0.652503 0.409520 0.740393 0.675317)
- 3.600425 #(0.000000 1.139545 0.351170 -0.114733 0.966482 1.234831 0.292454 1.539190 0.009726 0.589539 0.769919 0.798632 0.417679 0.467195)
- 3.599409 #(0.000000 0.851134 1.636505 0.091221 1.006010 0.744090 1.678264 0.418648 -0.048848 1.351639 1.174737 1.143087 1.519418 1.448182)
+ 3.606512 (fv 0.000000 0.785150 1.482463 -0.077041 0.773052 0.357080 1.202237 -0.069790 1.584889 0.769902 0.652503 0.409520 0.740393 0.675317)
+ 3.600425 (fv 0.000000 1.139545 0.351170 -0.114733 0.966482 1.234831 0.292454 1.539190 0.009726 0.589539 0.769919 0.798632 0.417679 0.467195)
+ 3.599409 (fv 0.000000 0.851134 1.636505 0.091221 1.006010 0.744090 1.678264 0.418648 -0.048848 1.351639 1.174737 1.143087 1.519418 1.448182)
+ 3.598494 (fv 0.000000 0.850577 1.637081 0.089423 1.006545 0.749551 1.681409 0.420517 -0.044040 1.351533 1.177890 1.148728 1.524043 1.447267)
)
;;; 15 odd -------------------------------------------------------------------------------- ; 3.872983
-#(15 4.4701427567987 #(0 1 0 0 1 0 1 1 1 1 1 0 0 1 1)
- 4.4776539802551 #(0 0 1 0 1 0 0 1 0 0 0 1 1 1 1)
- 4.5555243492126 #(0 1 0 0 1 0 1 0 0 1 1 0 0 0 0)
+(vector 15 4.4701427567987 (fv 0 1 0 0 1 0 1 1 1 1 1 0 0 1 1)
- 3.759718 #(0.000000 -0.397665 0.806430 -0.136442 1.561904 0.158128 0.655585 -0.218498 0.035467 0.628496 0.322341 0.470757 -0.271280 1.477753 1.665977)
- 3.754132 #(0.000000 0.903767 1.420933 1.923281 1.041289 0.252052 0.873412 0.620154 1.578503 0.111918 0.212810 -0.101363 1.630440 0.487026 0.384094)
- 3.753088 #(0.000000 1.135982 0.074052 1.463569 1.541245 1.092705 1.157015 0.490295 1.413226 1.335648 0.694560 1.273492 1.624971 0.104821 0.184801)
- 3.739752 #(0.000000 1.191367 0.176518 1.591145 1.710423 1.309889 1.422724 0.785426 1.754948 1.707551 1.122738 1.744847 0.127913 0.663567 0.776627)
+ 3.739752 (fv 0.000000 1.191367 0.176518 1.591145 1.710423 1.309889 1.422724 0.785426 1.754948 1.707551 1.122738 1.744847 0.127913 0.663567 0.776627)
+ 3.738430 (fv 0.000000 1.190239 0.174514 1.589466 1.706591 1.305812 1.416225 0.779885 1.746839 1.699566 1.113488 1.734421 0.117674 0.652032 0.763074)
)
;;; 16 odd -------------------------------------------------------------------------------- ; 4
-#(16 4.5778832343715 #(0 1 1 0 0 0 0 1 0 0 1 1 1 0 1 0)
- 4.5854911804199 #(0 0 1 0 1 0 1 1 0 1 1 1 1 1 0 0)
- 4.6032500267029 #(0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0)
- 4.6629304885864 #(0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 1)
- 4.6691436767578 #(0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 1)
+(vector 16 4.5778832343715 (fv 0 1 1 0 0 0 0 1 0 0 1 1 1 0 1 0)
- 3.863264 #(0.000000 0.212739 0.823601 0.183475 0.522013 1.322798 0.144924 -0.004654 0.283110 0.829370 -0.006329 1.351573 0.889059 1.066540 0.816406 -0.008936)
- 3.858242 #(0.000000 0.144652 0.676444 0.017002 0.269119 1.012194 1.772841 1.585260 1.809100 0.289620 1.399960 0.670537 0.175237 0.296937 -0.017357 1.108803)
+ 3.858242 (fv 0.000000 0.144652 0.676444 0.017002 0.269119 1.012194 1.772841 1.585260 1.809100 0.289620 1.399960 0.670537 0.175237 0.296937 -0.017357 1.108803)
+ 3.857020 (fv 0.000000 0.144607 0.675956 0.016527 0.269112 1.012147 1.772535 1.584482 1.808783 0.289484 1.400085 0.669674 0.174650 0.295492 -0.017769 1.108482)
)
;;; 17 odd -------------------------------------------------------------------------------- ; 4.12310
-#(17 4.5790815353394 #(0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0)
- 4.6202440261841 #(0 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1)
- 4.8765740394592 #(0 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 0)
+(vector 17 4.5790815353394 (fv 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0)
- 3.97646324 #(0.000000 0.753931 1.605116 -0.013833 0.719484 1.221266 1.149453 -0.016400 0.682620 0.271202 0.759215 0.509449 0.934281 0.751176 0.303242 1.755965 1.144501)
- 3.927805 #(0.000000 0.618908 0.864629 1.180783 1.677629 1.929621 0.580975 1.820904 0.468136 1.289907 0.485211 0.029658 1.160895 0.856998 0.644358 0.814931 0.296558)
+ 3.927805 (fv 0.000000 0.618908 0.864629 1.180783 1.677629 1.929621 0.580975 1.820904 0.468136 1.289907 0.485211 0.029658 1.160895 0.856998 0.644358 0.814931 0.296558)
+ 3.926355 (fv 0.000000 0.619515 0.864447 1.181990 1.677700 1.930862 0.582927 1.823955 0.470265 1.290931 0.488790 0.031736 1.163146 0.861017 0.648828 0.818286 0.301049)
)
;;; 18 odd -------------------------------------------------------------------------------- ; 4.2426406
-#(18 4.801501750946 #(0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0)
- 4.857753276825 #(0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0)
- 4.86248254776 #(0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 0)
- 5.0418791770935 #(0 0 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0)
- 5.0524249076843 #(0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0)
- 5.0652704238892 #(0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 0 0)
- 5.0697374343872 #(0 0 0 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0)
- 5.0979032516479 #(0 1 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0)
+(vector 18 4.801501750946 (fv 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0)
- 4.18242582 #(0.000000 1.136222 0.770438 0.400169 1.826042 1.428576 1.017726 1.528217 0.877622 1.606644 0.825490 0.569790 0.688245 0.883189 1.302521 1.639646 0.475959 1.347778)
- 4.130024 #(0.000000 1.754352 1.775885 0.648861 0.498465 0.100092 0.902120 1.526431 0.475472 1.473007 0.551653 0.202011 1.209083 1.439412 1.702576 1.066652 0.934229 1.195458)
- 4.071185 #(0.000000 0.956640 1.083713 0.493342 0.797185 0.138960 0.613585 0.388904 -0.007616 0.968034 0.616152 1.753096 0.351362 1.174080 1.220111 1.511627 0.186455 1.775153)
+ 4.071185 (fv 0.000000 0.956640 1.083713 0.493342 0.797185 0.138960 0.613585 0.388904 -0.007616 0.968034 0.616152 1.753096 0.351362 1.174080 1.220111 1.511627 0.186455 1.775153)
+ 4.069528 (fv 0.000000 0.956814 1.082990 0.493213 0.796608 0.137780 0.611831 0.387091 -0.011186 0.965014 0.614046 1.752338 0.348807 1.169857 1.216059 1.508238 0.182073 1.770765)
)
;;; 19 odd -------------------------------------------------------------------------------- ; 4.358898
-#(19 5.0520766258263 #(0 0 0 0 1 1 1 1 0 1 1 0 1 0 0 0 1 0 0)
- 5.0155117084604 #(0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0)
- 4.9927339414282 #(0 1 0 0 1 1 0 1 1 1 0 1 1 1 1 0 0 0 1)
- 4.9885946763115 #(0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0)
- 4.9724504091175 #(0 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 1)
- 4.9609222566765 #(0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0)
- 4.8924918279945 #(0 1 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1)
+(vector 19 4.8924918279945 (fv 0 1 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1)
- 4.341600 #(0.000000 1.579328 0.343104 1.375842 0.353081 0.423388 1.240118 1.912826 1.194961 1.293193 0.615240 0.016197 0.673856 0.516664 0.391481 1.727303 0.190251 0.501442 0.668027)
- 4.195254 #(0.000000 0.791760 0.603530 1.420197 0.161131 1.375504 1.353582 1.630311 0.304896 0.430904 0.181997 0.875060 1.590045 0.702894 0.531692 0.132476 0.893747 0.532901 0.172031)
- 4.173923 #(0.000000 0.329738 1.407540 1.252167 0.448297 0.551162 1.341659 1.859617 1.357020 0.222879 0.553639 1.254187 0.641694 -0.208417 1.489583 1.646436 1.391179 1.758274 1.299312)
+ 4.173923 (fv 0.000000 0.329738 1.407540 1.252167 0.448297 0.551162 1.341659 1.859617 1.357020 0.222879 0.553639 1.254187 0.641694 -0.208417 1.489583 1.646436 1.391179 1.758274 1.299312)
+ 4.171858 (fv 0.000000 0.330499 1.406874 1.250304 0.450026 0.551790 1.342413 1.858827 1.359366 0.223792 0.553485 1.256415 0.641759 -0.208630 1.490602 1.646088 1.388713 1.758053 1.297635)
)
;;; 20 odd -------------------------------------------------------------------------------- ; 4.472135
-#(20 5.136606875959 #(0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0)
- 5.104093841111 #(0 1 1 0 1 1 0 1 0 1 0 0 0 1 1 0 0 0 0 0)
- 5.043 #(0 1 0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0)
+(vector 20 5.043 (fv 0 1 0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0)
- 4.360063 #(0.000000 0.073521 -0.009620 0.184167 -0.090618 0.682702 1.090680 1.616612 1.399432 0.352373 1.094838 -0.499526 0.947850 -0.319867 1.410866 0.829866 -0.654620 0.294523 -0.287091 1.405089)
+ 4.357980 (fv 0.000000 0.074668 -0.007236 0.182274 -0.090904 0.683075 1.087950 1.620610 1.402047 0.349796 1.096502 -0.498958 0.949574 -0.321894 1.411823 0.831379 -0.654670 0.294879 -0.284984 1.407225)
)
;;; 21 odd -------------------------------------------------------------------------------- ; 4.5825756
-#(21 5.2726634376804 #(0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0)
- 5.2359894831295 #(0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1)
- 5.2142992491192 #(0 1 1 0 0 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 1)
- 5.2105652502144 #(0 1 1 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0)
- 5.1372244578347 #(0 1 1 1 0 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1)
+(vector 21 5.1372244578347 (fv 0 1 1 1 0 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1)
- 4.450399 #(0.000000 1.232888 0.090626 0.908626 0.292628 1.789632 -0.064521 1.337231 1.077653 0.742032 1.053479 1.212396 1.464307 0.813375 1.503599 1.665799 0.652080 0.032818 1.058665 1.235482 -0.037282)
+ 4.448460 (fv 0.000000 1.232455 0.090847 0.908719 0.292484 1.788804 -0.065161 1.337389 1.076226 0.741452 1.053336 1.212537 1.463874 0.812811 1.503269 1.665124 0.651549 0.032446 1.058206 1.235365 -0.036822)
)
;;; 22 odd -------------------------------------------------------------------------------- ; 4.6904157
-#(22 5.5119525535942 #(0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0)
- 5.473 #(0 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 1 1 0 1 1)
- 5.1805551751198 #(0 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0)
+(vector 22 5.1805551751198 (fv 0 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0)
- 4.582778 #(0.000000 0.181219 0.413695 1.937138 0.354645 0.584330 1.521156 1.778203 1.534204 1.337940 -0.034924 1.699942 0.807878 0.347955 1.849970 -0.102930 0.038171 0.664785 1.395334 0.513333 1.628189 0.471554)
+ 4.581017 (fv 0.000000 0.180996 0.414015 1.937535 0.354831 0.584078 1.521008 1.778595 1.533807 1.338106 -0.034930 1.700610 0.808153 0.348626 1.850606 -0.102689 0.038967 0.664253 1.395687 0.513457 1.627689 0.472162)
)
;;; 23 odd -------------------------------------------------------------------------------- ; 4.7958315
-#(23 5.5374279022217 #(0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0)
- 5.4125407453101 #(0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1)
+(vector 23 5.4125407453101 (fv 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1)
- 4.663897 #(0.000000 0.403435 0.142748 -0.306349 -0.210666 0.795999 1.004771 1.283072 1.566950 0.563329 0.340321 0.292952 1.204762 0.724980 0.539830 0.518629 0.906326 0.187293 1.164337 0.997077 -1.862047 1.042851 -0.124041)
+ 4.661614 (fv 0.000000 0.402662 0.143299 -0.307618 -0.213995 0.796949 1.006633 1.285380 1.569840 0.564104 0.342477 0.293161 1.200899 0.723618 0.539973 0.518746 0.907665 0.184015 1.163786 0.995418 -1.860771 1.039418 -0.124574)
)
;;; 24 odd -------------------------------------------------------------------------------- ; 4.89897948
-#(24 5.6568542494923 #(0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 0)
- 5.6584029055795 #(0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0)
- 5.62041703818643 #(0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1)
- 5.6193280144865 #(0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1)
+(vector 24 5.6193280144865 (fv 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1)
- 4.789073 #(0.000000 0.498962 1.192122 1.399568 0.478175 1.498537 -0.058937 0.823036 0.009630 0.862968 0.052440 1.055798 0.997888 1.799698 -0.043449 0.198517 0.646569 0.269929 0.032678 0.156758 0.040928 -0.117138 1.174336 0.689332)
+ 4.786434 (fv 0.000000 0.498846 1.191572 1.399155 0.479838 1.497230 -0.058887 0.823598 0.010384 0.864577 0.051220 1.057330 0.998513 1.799328 -0.041050 0.199658 0.646825 0.272218 0.034139 0.159133 0.043804 -0.115906 1.177655 0.690674)
)
;;; 25 odd -------------------------------------------------------------------------------- ; 5
-#(25 5.7861609458923 #(0 1 0 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 1 1)
- 5.7734115151023 #(0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1)
- 5.7220960914079 #(0 1 0 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1)
+(vector 25 5.7220960914079 (fv 0 1 0 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1)
- 4.889151 #(0.000000 -0.128293 0.647012 0.790395 -0.286222 0.142942 1.157912 1.181898 -0.008090 -0.239858 1.215092 0.277126 0.697826 1.108639 0.614409 1.458730 0.405980 0.119432 0.178568 -0.086880 1.056419 0.142726 0.542932 0.376693 0.306796)
+ 4.886819 (fv 0.000000 -0.128793 0.647898 0.792536 -0.285146 0.144218 1.160103 1.183437 -0.004858 -0.239530 1.215352 0.277973 0.699697 1.110172 0.616181 1.458993 0.406636 0.121039 0.182656 -0.085662 1.058149 0.147121 0.546131 0.378165 0.309175)
)
;;; 26 odd -------------------------------------------------------------------------------- ; 5.0990
-#(26 5.8912210464478 #(0 1 0 0 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0)
- 5.8572101593018 #(0 1 0 1 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 0)
- 5.8545204896237 #(0 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0)
- 5.8537594936002 #(0 0 0 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1)
+(vector 26 5.8537594936002 (fv 0 0 0 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1)
- 5.008456 #(0.000000 1.693298 1.368284 1.373891 0.627805 0.749201 1.218581 1.690405 1.084549 0.650173 -0.133773 1.086196 0.314357 0.195942 0.717774 1.230001 1.543258 -0.160224 1.426853 1.764971 0.866097 1.848572 0.672503 -0.114245 0.170724 0.146283)
+ 5.006443 (fv 0.000000 1.694135 1.368613 1.372881 0.625230 0.749494 1.218456 1.691757 1.088538 0.652397 -0.134215 1.088115 0.314540 0.197061 0.715518 1.230349 1.542812 -0.159343 1.427261 1.767442 0.867761 1.850745 0.671024 -0.112496 0.172562 0.147817)
)
;;; 27 odd -------------------------------------------------------------------------------- ; 5.196152
-#(27 5.9741146989154 #(0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 0 0 1 0)
- 5.968769496567 #(0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 1)
- 5.9206547737122 #(0 1 0 0 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0)
- 5.8637111082051 #(0 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1)
+(vector 27 5.8637111082051 (fv 0 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1)
- 5.091597 #(0.000000 0.108433 1.216643 1.164927 0.973412 -0.021700 0.035052 -0.150680 0.575434 1.005110 1.378469 0.117668 0.956832 1.742119 0.131354 -0.244103 0.873574 0.514283 1.810072 0.920776 0.162873 1.223342 1.596642 1.233515 1.209783 1.332933 1.299893)
+ 5.088823 (fv 0.000000 0.108028 1.216984 1.164689 0.975005 -0.022884 0.035464 -0.148996 0.575654 1.005987 1.378471 0.117457 0.956928 1.741009 0.131397 -0.243584 0.873140 0.514628 1.810242 0.918281 0.161062 1.222969 1.595595 1.233298 1.211975 1.332117 1.297417)
)
;;; 28 odd -------------------------------------------------------------------------------- ; 5.291502
-#(28 6.0999548630948 #(0 1 0 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0)
- 6.0720555632906 #(0 0 1 1 0 0 0 0 1 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 1)
- 6.057788848877 #(0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 0 1 0 0 0)
- 6.0276107788086 #(0 0 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1)
+(vector 28 6.0276107788086 (fv 0 0 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1)
- 5.092585 #(0.000000 1.695440 -0.043623 0.222052 0.119988 0.906658 0.748492 0.144655 -0.170479 0.199068 0.623366 -0.017877 1.188512 1.804895 0.527591 0.257090 0.180945 1.672974 1.633662 0.481970 1.385001 1.687455 0.368286 1.304198 0.926301 0.205231 0.776507 0.352984)
+ 5.088899 (fv 0.000000 1.695594 -0.042323 0.221585 0.121059 0.906440 0.747864 0.144725 -0.170880 0.198031 0.623261 -0.016920 1.187997 1.805776 0.526952 0.257290 0.181436 1.671568 1.634262 0.482276 1.385748 1.687591 0.368532 1.304502 0.925524 0.205838 0.775793 0.352193)
)
;;; 29 odd -------------------------------------------------------------------------------- ; 5.385164
-#(29 6.2191140571712 #(0 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1)
- 6.1821198011886 #(0 0 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0)
- 6.1290216445923 #(0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 0)
- 6.1179310275088 #(0 0 1 0 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1)
- 6.0348020511367 #(0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 1)
+(vector 29 6.0348020511367 (fv 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 1)
- 5.267374 #(0.000000 0.150950 0.558525 0.734122 1.367984 -0.010939 1.646605 0.436638 1.718320 1.202816 0.978274 1.009951 0.702458 1.591440 0.711769 0.372772 0.283792 1.401587 0.653090 0.959946 0.846748 0.832705 0.047894 1.107158 1.102787 1.831833 0.612394 1.520781 0.108517)
+ 5.263365 (fv 0.000000 0.151064 0.558177 0.735081 1.367806 -0.011277 1.649265 0.435302 1.718318 1.203162 0.977127 1.010028 0.703023 1.591655 0.710208 0.371369 0.285721 1.400549 0.654738 0.961707 0.849244 0.833954 0.047113 1.107680 1.103136 1.834278 0.611441 1.521356 0.107658)
)
;;; 30 odd -------------------------------------------------------------------------------- ; 5.4772255
-#(30 6.2854590415955 #(0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0)
- 6.2697563171387 #(0 1 0 1 0 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 1 1)
- 6.2528157234192 #(0 1 1 1 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 1)
- 6.2357559204102 #(0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
+(vector 30 6.2357559204102 (fv 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
- 5.356917 #(0.000000 -0.272403 0.779609 0.427831 1.743491 0.813040 1.826167 0.242297 0.800154 0.444205 0.599989 1.282484 -0.036742 0.801786 0.590077 1.134322 0.784392 1.820310 1.361582 1.648573 1.057728 0.274607 0.187893 0.071940 0.646543 1.513903 1.900196 1.697822 1.289117 1.535078)
+ 5.353062 (fv 0.000000 -0.273797 0.780589 0.428126 1.742006 0.813705 1.826779 0.243133 0.799231 0.444552 0.600071 1.280010 -0.037027 0.801371 0.587721 1.132556 0.784854 1.819749 1.361833 1.646165 1.057885 0.274456 0.188906 0.072120 0.645190 1.511097 1.900389 1.698668 1.288971 1.535352)
)
;;; 31 odd -------------------------------------------------------------------------------- ; 5.56776
-#(31 6.3631281852722 #(0 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1)
- 6.3062944412231 #(0 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1)
- 6.269211769104 #(0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 0 0)
- 6.1342258453369 #(0 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1)
+(vector 31 6.1342258453369 (fv 0 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1)
- 5.423494 #(0.000000 1.386303 -0.055734 1.470363 1.133289 0.301867 1.278872 0.118563 0.785226 0.165360 0.277066 1.264913 0.806911 0.592449 0.252572 0.349148 0.668297 0.601505 0.393268 1.237828 -0.182749 1.792953 1.685727 0.766750 0.385388 1.093159 0.147275 0.340746 0.884734 1.109480 0.159614)
+ 5.418933 (fv 0.000000 1.386056 -0.055103 1.470738 1.133338 0.301486 1.278842 0.118113 0.785586 0.164711 0.277129 1.264947 0.805303 0.592921 0.251470 0.348783 0.666372 0.600263 0.392807 1.237206 -0.185182 1.790868 1.684032 0.764715 0.385641 1.091814 0.146242 0.339596 0.884327 1.106807 0.158763)
)
;;; 32 odd -------------------------------------------------------------------------------- ; 5.65685
-#(32 6.5067925453186 #(0 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 0)
- 6.5040426254272 #(0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1)
- 6.4926128387451 #(0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1)
- 6.4840421676636 #(0 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 0 0 1)
- 6.4720740318298 #(0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1)
- 6.3532226957365 #(0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1)
+(vector 32 6.3532226957365 (fv 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1)
- 5.567572 #(0.000000 0.861612 1.209352 0.519940 1.052688 1.500206 0.176574 1.932012 0.476025 1.248486 1.078099 0.961526 1.430505 1.363781 0.301762 1.949580 1.401541 1.767835 1.762773 0.053035 1.192812 0.032127 1.950646 1.510242 1.125351 1.064249 0.897680 1.674417 0.357268 1.272658 0.844033 1.936450)
+ 5.563263 (fv 0.000000 0.861343 1.208721 0.520795 1.054113 1.500902 0.176395 1.932292 0.475897 1.249746 1.078677 0.960255 1.432432 1.363500 0.301492 1.951062 1.402695 1.767079 1.762968 0.052405 1.191435 0.031852 1.950934 1.508841 1.124488 1.063642 0.897258 1.672866 0.358501 1.273522 0.844792 1.935288)
)
;;; 33 odd -------------------------------------------------------------------------------- ; 5.74456
-#(33 6.6069865226746 #(0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 1 0)
- 6.6028137207031 #(0 0 0 1 1 0 1 1 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1)
- 6.5531010627747 #(0 1 0 0 1 1 1 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0)
- 6.5466594696045 #(0 1 1 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 1 0 1 1 1 1)
- 6.5448527336121 #(0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1)
- 6.4944429397583 #(0 1 0 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 1 1 0)
+(vector 33 6.4944429397583 (fv 0 1 0 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 1 1 0)
- 5.606985 #(0.000000 1.601250 1.154201 1.251204 1.484471 0.841351 0.331138 1.775294 1.322346 1.205337 1.309192 0.894341 0.780080 0.993837 1.545031 0.197628 0.378099 0.791105 1.808947 1.068283 0.948274 1.605477 1.762770 1.528242 1.622190 0.602603 1.560229 -0.275479 0.725028 1.892782 0.568803 -0.062637 0.716748)
+ 5.602961 (fv 0.000000 1.602314 1.153414 1.251950 1.483737 0.842898 0.331110 1.775787 1.322292 1.204304 1.308143 0.894156 0.779513 0.992393 1.543652 0.196767 0.377438 0.791269 1.809959 1.067569 0.948715 1.605054 1.761811 1.528262 1.622887 0.603858 1.560497 -0.275070 0.725193 1.894504 0.570411 -0.063928 0.717166)
)
;;; 34 odd -------------------------------------------------------------------------------- ; 5.8309518
-#(34 6.7313859392731 #(0 1 0 0 1 0 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0)
- 6.7289090156555 #(0 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 0 0 1 0 0 1 0 0)
- 6.7241077423096 #(0 1 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0)
- 6.6926617622375 #(0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 0 0)
- 6.6887402534485 #(0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 0)
- 6.67742395401 #(0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0)
- 6.5771403312683 #(0 0 1 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0)
+(vector 34 6.5771403312683 (fv 0 0 1 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0)
- 5.745149 #(0.000000 1.128000 0.272515 -0.039342 0.299166 0.551340 0.311135 0.243296 0.298010 -0.034808 1.017937 0.346637 1.523918 0.449629 1.252707 0.940022 0.532163 0.349046 1.187598 0.382385 0.597063 -0.156613 1.373428 0.579016 1.245233 1.475704 0.214408 0.059071 0.148707 1.076050 1.407267 0.860377 1.325750 0.147798)
+ 5.740544 (fv 0.000000 1.128136 0.272558 -0.038354 0.299624 0.550945 0.313230 0.243494 0.297552 -0.035270 1.018110 0.345979 1.524929 0.448210 1.252682 0.941202 0.533185 0.349491 1.187324 0.383773 0.599245 -0.155984 1.372487 0.578854 1.244062 1.476419 0.215593 0.058496 0.148247 1.077304 1.406503 0.859804 1.327046 0.146527)
)
;;; 35 odd -------------------------------------------------------------------------------- ; 5.9160
-#(35 6.8717794418335 #(0 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 1 1 1 1 1 0 0 0 0 1 0 0)
- 6.8709630966187 #(0 1 1 1 0 1 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0)
- 6.8534955978394 #(0 1 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 0)
- 6.8080215454102 #(0 1 0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 0 0 0)
- 6.7822489738464 #(0 1 1 0 0 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0)
- 6.7593507766724 #(0 0 0 1 1 1 1 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0 1 0 0 0 1 0 0)
- 6.7392678260803 #(0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0)
+(vector 35 6.7392678260803 (fv 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0)
- 5.838235 #(0.000000 0.446999 1.593042 1.667453 0.393874 0.928772 1.354904 1.466772 0.226754 1.215249 0.009860 0.231727 1.867304 1.148536 1.079686 1.602019 0.201717 1.367553 -0.043267 1.213451 0.401906 0.197087 1.726905 1.537420 -0.145221 -0.105823 1.452971 0.350421 1.134485 0.211013 1.683797 0.967568 0.587830 1.050198 0.967015)
+ 5.833275 (fv 0.000000 0.446552 1.591598 1.665970 0.393066 0.930519 1.356028 1.466278 0.225797 1.216894 0.009583 0.233020 1.866671 1.148796 1.079614 1.602870 0.201424 1.366765 -0.045388 1.214248 0.402056 0.196949 1.726073 1.538289 -0.146596 -0.105825 1.452686 0.350527 1.133547 0.212285 1.683225 0.967867 0.587559 1.049939 0.968758)
)
;;; 36 odd -------------------------------------------------------------------------------- ; 6
-#(36 6.9997129440308 #(0 0 1 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 0 0 0)
- 6.9918489456177 #(0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 1 0 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0)
- 6.9864625930786 #(0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 0 0 0 0)
- 6.9756178855896 #(0 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0)
- 6.9730844497681 #(0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 0 0)
- 6.9310870170593 #(0 1 1 1 0 1 1 1 1 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 0 0 0)
- 6.838840007782 #(0 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0)
- 6.8277182579041 #(0 1 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0)
+(vector 36 6.8277182579041 (fv 0 1 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0)
+
+ 5.977640 (fv 0.000000 -0.070466 1.538192 0.984355 0.488221 1.019554 1.547512 1.704002 1.584416 0.668394 -0.001385 0.884114 1.504028 -0.187464 0.437132 1.457048 0.752720 0.480053 1.746828 0.789836 0.816665 1.133277 1.144098 1.330854 0.114924 1.293712 1.538716 1.521496 0.841528 0.693020 1.172435 0.408530 0.666143 -0.084621 1.417045 -0.037001)
- 5.983255 #(0.000000 -0.071327 1.538343 0.985204 0.488035 1.019685 1.547684 1.703103 1.583517 0.669047 -0.001440 0.883683 1.502756 -0.187744 0.437581 1.457932 0.751989 0.479226 1.747646 0.789392 0.816532 1.132990 1.144569 1.331775 0.115868 1.292599 1.537766 1.521605 0.842496 0.692135 1.172036 0.408574 0.665199 -0.083713 1.417640 -0.036259)
+ ;; 35+1
+ 6.030643 #(0.000000 1.022108 1.134386 0.040000 1.020689 1.082726 -0.154753 1.098409 0.988397 0.898657 1.161207 0.157216 -0.172638 1.251128 1.003109 0.170160 0.036385 0.822058 1.148915 -0.012280 -0.203882 0.002376 0.142366 -0.019253 0.880987 1.211008 -0.244514 0.790432 -0.315814 0.996657 -0.069816 0.913294 0.063655 0.034201 0.148650 -0.048872)
+ 6.023572 #(0.000000 1.006794 1.135292 0.054179 1.034731 1.098175 -0.131238 1.084424 0.944530 0.864373 1.175974 0.171650 -0.115246 1.244948 1.003278 0.206506 0.095902 0.771056 1.143860 -0.009618 -0.227281 -0.055671 0.132916 -0.028444 0.924379 1.277595 -0.228977 0.811154 -0.325012 1.010432 -0.091469 1.009174 0.052639 0.009978 0.088793 -0.099301)
)
;;; 37 odd -------------------------------------------------------------------------------- ; 6.0827
-#(37 7.1364183425903 #(0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 0 0 0 0 0)
- 7.1333456039429 #(0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 0 0 0 0)
- 7.1091394424438 #(0 1 1 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0)
- 7.1067843437195 #(0 1 0 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 0)
- 7.0880541801453 #(0 1 0 1 0 0 1 0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0)
- 7.0842223167419 #(0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 0)
- 7.0678915977478 #(0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0)
- 7.0 #(0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0)
+(vector 37 7.0 (fv 0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0)
- 6.024853 #(0.000000 1.197998 1.847287 0.935006 1.782937 0.496617 0.026869 0.302955 1.087642 1.074685 1.005491 1.377595 0.273425 1.653861 0.070205 0.494353 1.198438 -0.081973 0.936958 0.883593 1.529878 0.426603 0.218858 1.480597 1.569766 1.445696 0.463800 0.267438 1.385323 0.811147 0.214359 0.106300 0.522104 0.380804 0.177813 0.326019 -0.015506)
+ 6.019116 (fv 0.000000 1.198867 1.849092 0.935330 1.781957 0.496846 0.026335 0.303736 1.089299 1.074310 1.006658 1.377317 0.271438 1.654659 0.071833 0.494433 1.198697 -0.081156 0.936704 0.883271 1.529398 0.425484 0.218240 1.480439 1.569267 1.446099 0.465358 0.265303 1.385278 0.810099 0.212275 0.106695 0.522036 0.380536 0.175723 0.325421 -0.016008)
)
;;; 38 odd -------------------------------------------------------------------------------- ; 6.1644
-#(38 7.1993670463562 #(0 1 1 0 1 0 0 1 0 1 1 1 0 1 0 0 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 0 0 0 0)
- 7.1947164535522 #(0 0 1 0 1 0 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 1 1)
- 7.1848387718201 #(0 1 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 0 0 0 0)
- 7.1674456596375 #(0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 0)
- 7.0878057479858 #(0 1 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 0 0 0 0)
- 7.027690410614 #(0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0)
+(vector 38 7.027690410614 (fv 0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 0 0 0)
- 6.150178 #(0.000000 0.458381 0.980410 1.182584 1.502374 1.305302 0.863491 1.146667 1.407357 1.061564 0.795229 1.420865 1.626108 0.940678 1.765120 -0.200782 0.758841 1.330656 0.859416 0.934009 0.734086 -0.018706 1.390826 0.222287 1.806876 0.258169 -0.107351 1.180819 1.133567 0.286545 1.542814 0.215728 1.086918 1.359138 1.067734 1.591630 0.412893 0.246316)
+ 6.144266 (fv 0.000000 0.459111 0.978423 1.181967 1.503059 1.306778 0.862780 1.146756 1.405445 1.059554 0.793798 1.421482 1.624819 0.940808 1.764974 -0.199270 0.756440 1.330911 0.861332 0.933256 0.734269 -0.017456 1.393657 0.220679 1.806219 0.259427 -0.110057 1.180170 1.136238 0.286941 1.541821 0.220515 1.089015 1.358525 1.068195 1.590398 0.413700 0.247552)
+
+ ;; 37+1
+ 6.138688 #(0.000000 1.046261 1.784835 0.956057 1.812170 0.474533 0.170721 0.206638 1.084578 1.210612 0.877325 1.304868 0.216526 1.666615 0.017582 0.377950 1.122637 -0.152317 0.759942 0.908307 1.610556 0.619180 0.252252 1.289240 1.682699 1.456452 0.437125 0.204631 1.313659 1.057657 0.251390 0.015459 0.426277 0.374256 0.211841 0.291412 0.083784 0.055093)
+ 6.109073 #(0.000000 0.982171 1.705612 0.986921 1.873378 0.509690 0.102590 0.186755 1.133224 1.164029 0.874124 1.283945 0.138084 1.739224 -0.073147 0.350734 1.013698 -0.141497 0.646696 0.873432 1.551583 0.589738 0.246954 1.196679 1.600352 1.425024 0.430454 0.103410 1.227168 1.077407 0.227980 -0.028101 0.385573 0.330289 0.176030 0.160255 0.005449 0.061254)
+ 6.108235 #(0.000000 0.982140 1.705650 0.987359 1.873951 0.509617 0.101844 0.187009 1.133759 1.164160 0.874009 1.284219 0.137756 1.739325 -0.073001 0.350923 1.012778 -0.140699 0.646579 0.873989 1.552501 0.590083 0.247447 1.196795 1.599951 1.425383 0.431367 0.103900 1.228072 1.077985 0.228759 -0.027472 0.386360 0.330507 0.175983 0.160536 0.005039 0.061859)
)
;;; 39 odd -------------------------------------------------------------------------------- ; 6.2449
-#(39 7.3710842132568 #(0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0)
- 7.3583292961121 #(0 1 0 0 1 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 1 0 0 0 0 0 0)
- 7.3438787460327 #(0 1 0 1 0 1 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0)
- 7.3397698402405 #(0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0)
- 7.3336853981018 #(0 0 0 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0)
- 7.3038640022278 #(0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0)
- 7.2819819450378 #(0 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0)
- 7.2700448036194 #(0 0 1 1 0 0 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 0)
- 7.2362656593323 #(0 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0)
+(vector 39 7.2362656593323 (fv 0 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0)
- 6.187454 #(0.000000 0.388618 1.432653 1.784425 0.371935 0.650011 0.589744 1.419632 1.232381 1.275218 1.031193 0.648549 1.314783 1.550413 0.796967 0.829675 0.920444 0.286140 1.176611 0.777335 1.481467 -0.170605 1.810857 0.590069 1.604413 0.287254 1.659794 1.308709 0.893762 0.025955 0.915239 0.336227 0.586243 1.686232 1.285404 1.206990 1.759017 1.037935 0.925206)
+ 6.181539 (fv 0.000000 0.390214 1.432668 1.784856 0.372658 0.651343 0.590730 1.420862 1.232876 1.274776 1.031604 0.648830 1.314325 1.550338 0.798266 0.829350 0.920173 0.286182 1.175424 0.776791 1.481341 -0.170207 1.810272 0.591377 1.604472 0.287027 1.660006 1.308050 0.895442 0.027306 0.915319 0.337380 0.586293 1.687170 1.285611 1.205943 1.760871 1.039296 0.923977)
)
;;; 40 odd -------------------------------------------------------------------------------- ; 6.3245
-#(40 7.6328768730164 #(0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 0 1 1)
- 7.5038495063782 #(0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 1)
+(vector 40 7.5038495063782 (fv 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 1)
- 6.277925 #(0.000000 1.286847 1.056558 1.064552 0.386122 0.823982 0.120665 1.715364 1.070368 1.544864 0.375054 1.038193 0.380390 0.305991 1.429156 0.150341 0.742273 -1.907886 0.495478 -0.131302 1.454190 1.544371 0.424550 1.222035 1.334261 1.409069 0.400912 1.070887 1.396403 -0.550278 0.327917 1.771458 0.927243 0.552970 1.392666 1.183354 1.462584 1.291648 1.910305 1.576805)
+ 6.272478 (fv 0.000000 1.284197 1.055354 1.062168 0.387815 0.825054 0.121504 1.716073 1.070732 1.544312 0.376494 1.037163 0.380448 0.304545 1.428265 0.150454 0.740589 -1.906896 0.496136 -0.130727 1.453974 1.546206 0.424585 1.220704 1.332527 1.409234 0.400583 1.072058 1.397035 -0.550500 0.327899 1.771283 0.928925 0.550551 1.392166 1.184654 1.462753 1.291611 1.910777 1.578007)
)
;;; 41 odd -------------------------------------------------------------------------------- ; 6.4031
-#(41 7.86743174872036 #(0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 0 0)
- 7.7093445316966 #(0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1)
+(vector 41 7.7093445316966 (fv 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1)
- 6.327577 #(0.000000 0.582814 1.286033 1.434762 0.968648 0.414373 0.202678 -0.084375 1.012441 1.216240 0.698275 0.906119 0.006115 0.289651 0.751619 0.181944 1.916605 0.830850 0.905938 0.268842 -0.060925 0.318843 0.592034 1.698481 1.912304 1.683298 0.193210 0.459818 0.828474 1.122554 0.525807 1.056723 0.751455 0.901980 -0.077116 0.957355 -0.093347 1.453165 0.349371 1.538528 1.034674)
+ 6.321636 (fv 0.000000 0.581881 1.284007 1.435590 0.968036 0.414485 0.203921 -0.085398 1.011694 1.215509 0.697775 0.907045 0.006237 0.289299 0.751565 0.182523 1.917428 0.830815 0.908047 0.267572 -0.061197 0.319855 0.591342 1.699511 1.912692 1.683447 0.192711 0.461781 0.828435 1.122559 0.524721 1.057548 0.753199 0.901168 -0.077807 0.957092 -0.092721 1.453709 0.349112 1.539336 1.035529)
)
;;; 42 odd -------------------------------------------------------------------------------- ; 6.4807
-#(42 7.9323644638062 #(0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0)
- 7.8349797520917 #(0 0 1 0 0 0 0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 1 1)
- 7.77445936203 #(0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1)
+(vector 42 7.77445936203 (fv 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1)
- 6.408479 #(0.000000 0.615414 1.470843 0.696787 0.198900 1.065083 0.258615 1.498581 1.009578 1.330852 -0.125534 0.667854 -0.151832 1.235447 1.351733 1.833745 1.621535 1.576927 0.386650 1.123212 1.738064 0.185423 -0.092954 -0.362850 1.267803 0.809007 0.146693 0.174438 0.940048 0.098849 1.557978 1.898566 1.061904 1.399143 1.502843 -0.309744 1.594046 1.048117 0.348277 0.500199 0.501915 1.050638)
+ 6.403222 (fv 0.000000 0.615457 1.471291 0.696790 0.198813 1.064683 0.257669 1.499443 1.009189 1.331704 -0.126692 0.668087 -0.151536 1.235993 1.351147 1.834812 1.622001 1.575606 0.387431 1.123625 1.738720 0.186291 -0.093048 -0.362694 1.268339 0.808624 0.147243 0.174237 0.939940 0.098301 1.557405 1.899768 1.063327 1.398074 1.503515 -0.309876 1.592871 1.047295 0.347548 0.500256 0.502585 1.050388)
)
;;; 43 odd -------------------------------------------------------------------------------- ; 6.5574
-#(43 7.8550543785095 #(0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 0 1 0 1)
- 7.8274940102143 #(0 0 1 0 0 1 0 1 0 1 0 1 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0)
- 7.7573688953539 #(0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 1)
+(vector 43 7.7573688953539 (fv 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 1)
- 6.480896 #(0.000000 0.162445 0.869999 0.643054 0.499615 0.316081 0.502954 0.136590 0.117083 1.312132 1.258206 1.002617 1.668339 0.653729 0.901112 0.185217 1.792525 1.096541 0.881150 0.351883 0.533560 1.402531 1.721250 -0.341462 0.698820 1.678458 1.686345 1.303828 -0.030019 0.457569 1.242075 0.589258 1.726081 0.987456 0.169302 1.113924 0.233149 0.477401 1.064623 1.025028 1.388482 1.105104 1.814053)
+ 6.474181 (fv 0.000000 0.163031 0.868018 0.644438 0.499955 0.314476 0.501651 0.136276 0.115801 1.311189 1.257885 1.003167 1.668510 0.653556 0.900535 0.185303 1.792109 1.097281 0.880040 0.351492 0.533331 1.402396 1.722630 -0.341451 0.699659 1.677594 1.684893 1.301554 -0.032447 0.458521 1.242927 0.587312 1.726991 0.987710 0.168427 1.112409 0.233710 0.476465 1.063291 1.023410 1.387257 1.104431 1.814614)
)
;;; 44 odd -------------------------------------------------------------------------------- ; 6.6332
-#(44 8.20137867697624 #(0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0)
- 7.9338580613871 #(0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0)
+(vector 44 7.9338580613871 (fv 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0)
- 6.604847 #(0.000000 0.351044 1.306542 1.465763 1.320249 0.565440 0.399940 -0.237398 1.055407 0.418613 0.685395 1.680568 1.845447 1.017355 1.471092 1.618392 0.598714 0.202675 1.546748 0.895775 1.499434 -0.449664 0.958870 0.671637 0.465436 0.361895 0.743954 0.800411 1.320233 0.704441 1.101784 1.234656 0.652603 1.451040 0.413040 1.111137 0.556088 1.736681 0.344377 0.023949 0.937837 1.223467 1.558214 1.345712)
+ 6.599250 (fv 0.000000 0.351178 1.306835 1.466283 1.319851 0.565360 0.401323 -0.237018 1.055625 0.418518 0.685726 1.681541 1.845435 1.019294 1.472175 1.617323 0.599443 0.202024 1.548869 0.896807 1.498980 -0.449736 0.958935 0.672395 0.465421 0.363298 0.745996 0.800573 1.320237 0.704768 1.103042 1.233693 0.653096 1.449790 0.411870 1.110453 0.556583 1.736823 0.345497 0.024788 0.937504 1.224464 1.559019 1.346766)
)
;;; 45 odd -------------------------------------------------------------------------------- ; 6.7082
-#(45 8.1525803340105 #(0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1)
- 8.1351366043091 #(0 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0)
+(vector 45 8.1351366043091 (fv 0 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0)
- 6.631015 #(0.000000 1.007271 0.477966 1.144428 0.405377 0.709562 0.591098 0.023922 1.174211 1.114679 1.631206 1.257380 1.314198 0.342822 0.579809 1.458996 0.840637 0.297374 1.352000 1.645616 1.557736 1.966797 0.747895 1.349386 0.523533 0.276675 1.146356 1.736290 1.157329 1.019943 0.469399 1.677619 1.797739 1.624789 1.799637 0.670741 1.546255 1.428852 1.094569 0.113612 0.742588 1.142278 0.965770 1.246971 0.979825)
+ 6.624897 (fv 0.000000 1.004365 0.475962 1.144412 0.404466 0.708852 0.590380 0.024072 1.172296 1.113281 1.630362 1.256665 1.314082 0.342438 0.579726 1.460036 0.838934 0.298273 1.354989 1.643563 1.558056 1.967600 0.749164 1.349815 0.523705 0.276619 1.145711 1.733713 1.155806 1.020242 0.468578 1.677226 1.799379 1.623813 1.799356 0.670303 1.547676 1.429802 1.095547 0.114545 0.743241 1.141259 0.963105 1.247487 0.978965)
)
;;; 46 odd -------------------------------------------------------------------------------- ; 6.7823
-#(46 8.2970391011104 #(0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 1 0 1 0)
- 8.1455316543579 #(0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1)
+(vector 46 8.1455316543579 (fv 0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1)
- 6.716722 #(0.000000 0.589157 0.764149 0.948916 0.779538 1.268976 0.079906 -0.380388 0.448649 1.688367 0.584830 0.606310 0.913828 1.245805 0.098838 0.459100 0.785114 0.012839 0.855902 1.034909 1.254775 0.506944 1.208460 0.513427 0.740531 1.441441 0.587365 1.582678 0.642329 1.527431 1.201228 0.845885 0.317234 0.031593 0.892897 0.339503 -0.008048 1.585731 0.008559 0.333144 0.349434 -0.214088 -0.070758 1.486266 0.987125 0.864350)
+ 6.709237 (fv 0.000000 0.588728 0.764172 0.948247 0.778447 1.268756 0.080491 -0.381973 0.448541 1.688302 0.583900 0.609230 0.913000 1.244782 0.098190 0.458033 0.787717 0.012905 0.854674 1.035325 1.255759 0.507374 1.208176 0.514489 0.741105 1.441899 0.585374 1.583344 0.643511 1.525932 1.201616 0.846916 0.319659 0.030560 0.895113 0.341984 -0.007305 1.588064 0.007988 0.334683 0.349739 -0.215667 -0.068989 1.488454 0.988215 0.867211)
)
;;; 47 odd -------------------------------------------------------------------------------- ; 6.8556
-#(47 8.4595276184949 #(0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 0 1)
- 8.336971282959 #(0 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 0)
+(vector 47 8.336971282959 (fv 0 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 0)
- 6.793437 #(0.000000 0.899395 0.699139 0.822602 0.369563 0.538099 0.016185 1.556790 1.551639 1.250469 -0.202952 1.763170 0.028017 0.112846 -0.039936 0.661519 0.095443 1.286970 1.353214 0.225122 0.058009 1.649322 -0.090812 0.524816 1.307299 -0.085913 0.352297 1.754603 1.303478 0.680448 0.691624 0.498042 1.007138 1.659354 0.432424 0.069410 0.584615 1.128677 1.938358 0.151391 1.459330 0.723424 1.430080 0.763673 1.799518 1.483215 0.487535)
+ 6.785244 (fv 0.000000 0.898263 0.698671 0.821497 0.370262 0.536725 0.016930 1.555315 1.553643 1.249848 -0.203480 1.765177 0.026588 0.111231 -0.039332 0.662791 0.096267 1.286138 1.353013 0.226230 0.057438 1.648120 -0.088502 0.524016 1.306955 -0.084552 0.350695 1.753518 1.303444 0.678968 0.693452 0.498589 1.005882 1.660165 0.430707 0.068634 0.587061 1.130543 1.939600 0.152146 1.459634 0.723147 1.428638 0.763075 1.800028 1.481715 0.488673)
)
;;; 48 odd -------------------------------------------------------------------------------- ; 6.9282
-#(48 8.35563071219336 #(0 1 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 0 1)
+(vector 48 8.35563071219336 (fv 0 1 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 0 1)
- 6.835163 #(0.000000 0.997242 1.077938 0.149348 1.528296 -0.144544 1.645543 1.724106 0.412368 1.173532 0.495751 1.410794 0.605451 1.627909 1.065123 1.230087 0.099086 0.693088 0.395116 1.297542 -0.002909 1.140281 1.344910 1.577784 0.242812 1.511699 1.184571 1.698155 1.379098 1.590433 -0.081242 0.467836 0.884195 0.626744 0.754723 0.096706 0.294020 0.637061 1.769875 1.347383 0.924721 0.394311 0.137881 1.279289 0.156722 0.442718 0.372065 -0.030241)
+ 6.828028 (fv 0.000000 0.998004 1.077433 0.148071 1.527370 -0.144913 1.645316 1.723923 0.412024 1.174877 0.494923 1.411660 0.605628 1.628272 1.064698 1.228914 0.098971 0.692407 0.395792 1.297327 -0.001580 1.140646 1.342219 1.577941 0.241000 1.510351 1.184692 1.697190 1.378912 1.591005 -0.082196 0.468455 0.883072 0.625939 0.755107 0.095773 0.293743 0.637279 1.770381 1.345208 0.924216 0.393583 0.137327 1.278382 0.157871 0.442417 0.371701 -0.029442)
)
;;; 49 odd -------------------------------------------------------------------------------- ; 7
-#(49 8.57458718352971 #(0 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0)
+(vector 49 8.57458718352971 (fv 0 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0)
- 6.997932 #(0.000000 -0.164932 0.062543 1.158715 1.337678 0.224375 0.048734 -0.092163 1.331151 1.726668 0.869593 0.492681 0.773739 1.547901 0.177653 0.783886 1.699317 1.314118 1.727115 1.406752 1.010538 0.644469 1.163474 0.987306 1.315592 -0.176138 0.077515 1.241145 1.483011 1.781204 0.940989 0.041761 -0.011584 1.150594 0.905660 1.772957 1.156521 1.425270 0.817709 1.841119 0.475148 1.453704 0.759985 0.412258 1.319758 0.058409 0.262995 0.090380 0.205050)
+ 6.988750 (fv 0.000000 -0.166791 0.066489 1.162315 1.337152 0.223301 0.045811 -0.093825 1.332601 1.728915 0.870363 0.493056 0.773831 1.546388 0.179602 0.790122 1.699394 1.317163 1.725149 1.408847 1.015662 0.639057 1.163324 0.986617 1.318547 -0.170292 0.080070 1.239083 1.484292 1.779081 0.940479 0.037560 -0.006305 1.151063 0.903661 1.767180 1.162011 1.427957 0.814000 1.843040 0.477534 1.459006 0.756363 0.414970 1.321498 0.061120 0.265825 0.092137 0.202930)
)
;;; 50 odd -------------------------------------------------------------------------------- ; 7.07
-#(50 8.7349090576172 #(0 0 1 1 1 0 0 1 1 0 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 0 1 1 0 1)
- 8.7194833755493 #(0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1)
- 8.711 #(0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1)
+(vector 50 8.711 (fv 0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1)
- 6.955341 #(0.000000 1.361678 1.058811 0.255280 1.370961 1.849509 -0.002708 1.051990 0.138785 0.680633 0.885054 1.004997 1.663130 1.665701 1.471149 1.691478 0.092552 0.824520 1.755358 1.033319 0.055803 1.509243 0.690460 1.232103 0.639211 1.442515 1.557836 1.909825 0.175467 1.577584 1.679153 1.359609 1.558171 1.882842 1.134585 1.054710 0.137527 1.900435 0.058225 0.972013 1.379097 0.844996 0.356897 0.497540 1.235873 0.734577 0.652916 0.243110 1.084307 -0.045442)
+ 6.947137 (fv 0.000000 1.361221 1.058873 0.255818 1.371652 1.848584 -0.002271 1.052656 0.139885 0.680884 0.885258 1.006144 1.663943 1.665052 1.470510 1.693036 0.091983 0.825894 1.755289 1.033123 0.055566 1.508725 0.691199 1.233170 0.641006 1.442066 1.557992 1.909688 0.175284 1.577225 1.678517 1.358807 1.558359 1.883371 1.133931 1.053187 0.137949 1.901321 0.058023 0.971798 1.378739 0.843519 0.357409 0.498187 1.235125 0.734586 0.653589 0.242791 1.085625 -0.043484)
)
;;; 51 odd -------------------------------------------------------------------------------- ; 7.141
-#(51 8.7549686431885 #(0 1 0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 0 1 1 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 1 1 0 0)
- 8.5829010009766 #(0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0)
+(vector 51 8.5829010009766 (fv 0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0)
- 7.096527 #(0.000000 0.875368 0.866585 0.366556 1.901318 0.762740 0.081945 0.353658 0.070457 -0.036906 1.276630 -0.100591 1.088053 1.483697 0.799665 1.260034 0.731898 1.035022 1.384348 0.727467 0.609497 1.769166 1.226741 0.727432 1.040086 -0.063351 0.731367 1.488924 1.564906 0.530594 0.845020 -0.126898 1.209170 0.537957 1.043481 0.904176 -0.107364 0.353482 0.368625 1.395965 1.206170 1.694837 0.348787 0.221877 0.523879 0.374501 0.283303 1.406180 0.933746 0.586801 0.938867)
+ 7.087726 (fv 0.000000 0.875029 0.865937 0.367918 1.900818 0.762934 0.081270 0.353365 0.070375 -0.037477 1.275772 -0.100171 1.088567 1.481918 0.798713 1.260047 0.731048 1.035501 1.384103 0.728234 0.608922 1.769831 1.228331 0.727930 1.038826 -0.062865 0.731133 1.490525 1.564219 0.530975 0.845759 -0.127106 1.209031 0.537607 1.042200 0.906452 -0.105250 0.353212 0.368083 1.395843 1.206034 1.694293 0.348968 0.222228 0.523051 0.375570 0.283017 1.406111 0.934909 0.587260 0.940073)
)
;;; 52 odd -------------------------------------------------------------------------------- ; 7.211
-#(52 9.0527429580688 #(0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0)
- 8.8599758148193 #(0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 1 0 0 0 1)
+(vector 52 8.8599758148193 (fv 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 1 0 0 0 1)
- 7.087457 #(0.000000 0.217695 0.815228 0.652105 0.472210 0.034513 -0.067645 0.661251 0.580253 0.051364 1.785056 0.529546 0.204393 -0.248113 1.238820 0.097387 0.952805 0.167446 0.758512 1.718336 0.161942 1.593107 0.882652 0.246677 1.208436 0.995914 0.028887 0.487573 1.153005 0.362942 0.720923 0.863427 0.090963 0.015179 0.082123 0.995009 1.057407 1.708206 0.745582 -0.334290 1.156564 0.740724 0.619550 1.021238 1.501400 1.347681 1.370305 1.480905 0.364029 1.829054 0.147181 0.425026)
+ 7.080087 (fv 0.000000 0.216994 0.815073 0.651401 0.471967 0.035007 -0.067747 0.660856 0.580235 0.052345 1.785696 0.529423 0.205578 -0.247148 1.238971 0.096672 0.952857 0.166426 0.759284 1.719458 0.161518 1.592928 0.883009 0.245604 1.208605 0.995562 0.029395 0.487673 1.152615 0.362903 0.721410 0.862934 0.090743 0.014994 0.082182 0.993529 1.056537 1.708353 0.746025 -0.333233 1.155949 0.740213 0.619117 1.020646 1.502770 1.347142 1.371490 1.480724 0.363059 1.828476 0.147552 0.424061)
)
;;; 53 odd -------------------------------------------------------------------------------- ; 7.280
-#(53 9.2427225112915 #(0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 1 1 1)
- 9.1345848658318 #(0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1)
- 9.127 #(0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 1 1 0)
- 9.037 #(0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0)
+(vector 53 9.037 (fv 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0)
- 7.262699 #(0.000000 1.318151 0.101459 0.289786 -0.119097 -0.146485 -0.293324 0.280779 1.566732 0.694468 -0.116485 1.113061 1.591529 1.084167 0.010921 0.755131 0.402167 0.796024 1.668068 1.188156 1.225433 -0.118667 0.261833 0.206088 0.738000 0.157919 0.602453 0.683895 1.946532 -0.041821 0.580586 1.320706 -0.040626 1.308445 1.170168 0.355036 0.400054 -0.096590 0.059830 1.235105 0.058733 -0.031903 1.320494 0.598137 1.403789 -0.235653 -0.006619 -0.082758 1.022209 1.628209 -0.221414 0.514399 0.302625)
+ 7.252601 (fv 0.000000 1.316368 0.101159 0.287376 -0.120486 -0.146148 -0.293575 0.279566 1.566833 0.692861 -0.116203 1.111486 1.592177 1.082742 0.010661 0.754630 0.400780 0.795713 1.670109 1.185717 1.226796 -0.120012 0.262637 0.206364 0.738299 0.157263 0.604374 0.683095 1.946305 -0.043066 0.580881 1.320138 -0.043078 1.307240 1.171743 0.356072 0.398418 -0.096678 0.059824 1.235855 0.057573 -0.031810 1.322088 0.600804 1.405030 -0.237620 -0.007423 -0.083489 1.021491 1.628805 -0.222749 0.516076 0.301362)
)
;;; 54 odd -------------------------------------------------------------------------------- ; 7.348
-#(54 9.3444428264144 #(0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1)
- 9.025 #(0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0)
+(vector 54 9.025 (fv 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0)
- 7.339595 #(0.000000 0.350559 1.362977 0.097386 1.595473 -0.032427 1.224737 1.245364 0.698545 0.969572 0.164220 1.059552 0.540526 0.011195 0.316266 -0.095223 1.225363 -0.108200 0.246249 0.433632 1.750390 0.124025 0.094876 1.556310 1.217642 1.416623 0.342330 0.687673 1.844706 1.656149 0.529513 1.422776 0.398792 0.610434 1.930726 0.675146 0.534580 1.080859 0.632666 -0.021849 1.284430 0.610179 0.825155 1.798001 1.267819 0.441167 0.836854 1.350151 1.194495 1.785599 -0.134924 0.099725 0.583021 0.357813)
+ 7.328138 (fv 0.000000 0.352535 1.363504 0.096670 1.597330 -0.030072 1.222144 1.243528 0.696875 0.968663 0.162138 1.056566 0.539804 0.008667 0.316670 -0.098837 1.225380 -0.112322 0.244903 0.436331 1.746403 0.122260 0.091220 1.558109 1.217585 1.412994 0.339182 0.690620 1.846588 1.658518 0.529876 1.420789 0.398352 0.612668 1.926173 0.676632 0.529358 1.076039 0.628593 -0.021834 1.281928 0.607717 0.819453 1.795488 1.260788 0.439390 0.834961 1.345636 1.190831 1.783406 -0.135996 0.097131 0.579836 0.358027)
)
;;; 55 odd -------------------------------------------------------------------------------- ; 7.416
-#(55 9.3425494397445 #(0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 1 0)
- 9.2039985656738 #(0 0 1 1 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
+(vector 55 9.2039985656738 (fv 0 0 1 1 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
- 7.376285 #(0.000000 0.394541 -0.156702 1.307504 0.779327 1.202831 1.581822 -0.091231 1.563538 0.221269 1.485207 0.596063 -0.042341 0.379191 0.102333 0.447750 1.705968 1.178123 1.314481 1.096895 0.261308 -0.071847 0.226478 0.241541 1.577414 0.203272 0.428907 1.250299 1.620102 0.667053 0.636418 0.025149 0.389265 0.545003 1.106144 0.997037 1.710465 0.607669 -0.353752 1.113420 1.187447 0.059518 1.021882 1.137107 0.719220 1.579828 0.168219 0.738086 0.421390 0.535966 0.141999 1.649129 0.498749 0.386848 -0.074787)
+ 7.364233 (fv 0.000000 0.395190 -0.153867 1.307052 0.778840 1.201427 1.584425 -0.091689 1.563398 0.221226 1.485388 0.595790 -0.041635 0.380534 0.103234 0.445988 1.706774 1.178799 1.315522 1.096083 0.260274 -0.072891 0.228062 0.239593 1.575799 0.203611 0.427975 1.251992 1.620128 0.666682 0.636489 0.025180 0.388251 0.546392 1.107252 0.996609 1.708598 0.607806 -0.354744 1.114522 1.187212 0.060556 1.020751 1.136440 0.719385 1.579705 0.166783 0.736570 0.421572 0.534881 0.141987 1.649951 0.500500 0.386302 -0.074892)
)
;;; 56 odd -------------------------------------------------------------------------------- ; 7.483
-#(56 9.5274312814935 #(0 0 0 1 1 1 1 0 0 0 0 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0)
- 9.3816785812378 #(0 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 0)
+(vector 56 9.3816785812378 (fv 0 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 0)
- 7.430862 #(0.000000 0.415381 1.081559 1.275869 0.766434 1.292496 1.835802 1.785069 0.677361 1.018528 0.392801 0.359725 0.699709 1.165239 0.564971 1.088781 0.889925 0.843895 1.421134 1.562120 0.249967 1.869433 1.109945 1.293917 1.863833 0.055045 0.339020 1.625219 1.602156 -0.021521 1.462886 1.792658 0.409899 1.678181 1.012948 1.358494 1.604067 1.247115 1.026903 0.457616 0.152668 0.241641 1.173520 0.204611 1.413253 1.498672 -0.139383 1.272546 0.393912 1.316023 0.894804 1.582304 0.565678 1.720651 1.611888 1.046875)
+ 7.419120 (fv 0.000000 0.417128 1.082491 1.276854 0.765982 1.295111 1.835030 1.786443 0.675192 1.020185 0.394420 0.359608 0.697463 1.166247 0.564899 1.087103 0.889865 0.844186 1.419287 1.562675 0.248998 1.869468 1.111986 1.294693 1.863255 0.052934 0.338636 1.626312 1.601681 -0.021561 1.462490 1.791020 0.409025 1.675990 1.011444 1.359048 1.605820 1.247285 1.024241 0.457113 0.153603 0.242127 1.175155 0.206257 1.412766 1.496703 -0.140135 1.270904 0.393803 1.315634 0.897708 1.585792 0.563930 1.722379 1.612675 1.047507)
)
;;; 57 odd -------------------------------------------------------------------------------- ; 7.549
-#(57 9.5457010269165 #(0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 1 1 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0)
- 9.543363571167 #(0 1 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 1)
- 9.3903837203979 #(0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 1 1 0)
+(vector 57 9.3903837203979 (fv 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 0 0 0 1 1 0)
- 7.498232 #(0.000000 -0.129172 1.380361 0.700320 0.780441 0.090360 1.662756 0.878900 1.570440 1.307072 1.212448 0.971480 0.736973 1.472139 1.503004 1.321091 -0.333336 0.652738 1.407756 0.559265 0.970311 0.614385 1.441684 0.387567 1.768917 0.697588 -0.175161 0.102601 0.178290 1.528309 0.468873 0.084595 0.063505 0.298061 0.525085 0.923933 1.286889 1.429105 0.333843 1.303850 0.808595 0.285713 0.098774 1.284736 0.038814 0.328707 1.274912 0.350159 1.518973 1.572017 0.226187 0.841753 0.707945 0.437563 0.618742 0.866615 1.853272)
+ 7.488896 (fv 0.000000 -0.127939 1.380652 0.701541 0.779535 0.090662 1.662797 0.879717 1.570316 1.307786 1.211090 0.971455 0.738042 1.474139 1.501173 1.322773 -0.333947 0.651999 1.407414 0.559437 0.970911 0.613447 1.441437 0.387240 1.769723 0.695953 -0.175580 0.102181 0.180022 1.529463 0.468743 0.084931 0.062956 0.298511 0.524008 0.924744 1.286647 1.428978 0.334028 1.302926 0.807711 0.283976 0.097723 1.284073 0.038191 0.329167 1.275797 0.351298 1.518403 1.571791 0.227818 0.842734 0.707030 0.435243 0.618490 0.867851 1.852691)
)
;;; 58 odd -------------------------------------------------------------------------------- ; 7.6157
-#(58 9.7054271697998 #(0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1)
- 9.6265433375878 #(0 1 1 0 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1)
- 9.5893135070801 #(0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0)
+(vector 58 9.5893135070801 (fv 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0)
- 7.598672 #(0.000000 0.516612 -0.135604 1.326789 0.395744 0.909105 0.527608 1.063385 1.236764 1.276962 1.783043 1.593622 0.538252 1.424728 1.604760 0.377666 0.889860 1.360735 1.916730 1.468925 0.486173 0.038464 1.361456 1.049229 0.702328 1.228604 0.063610 0.347194 0.482264 1.185990 1.001848 0.892083 0.200401 0.209605 1.800538 1.048999 -0.101819 1.814176 1.482403 -0.164805 1.425678 0.558965 -0.223574 0.437750 1.102143 0.465949 0.281660 1.510234 0.399717 1.610286 -0.049657 1.496031 -0.266799 0.339116 0.926410 0.217853 1.901038 -0.038423)
+ 7.585947 (fv 0.000000 0.517595 -0.138781 1.328351 0.394157 0.908218 0.526218 1.063012 1.239066 1.277916 1.783309 1.590363 0.539572 1.425376 1.601385 0.376842 0.888852 1.358950 1.916790 1.468314 0.490842 0.036065 1.359391 1.047397 0.699655 1.225098 0.065253 0.350008 0.483077 1.188989 1.002860 0.893562 0.202836 0.208109 1.801392 1.050084 -0.102454 1.813439 1.482474 -0.166271 1.426695 0.563055 -0.225427 0.436837 1.102639 0.467507 0.283291 1.511898 0.400494 1.606371 -0.049354 1.495330 -0.267319 0.336083 0.925094 0.220186 1.902233 -0.035784)
)
;;; 59 odd -------------------------------------------------------------------------------- ; 7.681
-#(59 9.955 #(0 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0 0)
- 9.6750946044922 #(0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1)
- 9.5173864364624 #(0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0)
+(vector 59 9.5173864364624 (fv 0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0)
- 7.628430 #(0.000000 1.762994 0.513214 1.350497 0.396107 0.368444 0.306636 0.831799 1.232009 0.678209 0.015531 1.889753 1.633971 1.299693 0.423666 1.402645 0.715420 1.275542 1.487968 1.871889 1.737937 0.571028 0.058906 1.976774 0.295598 1.562776 0.774230 0.089633 0.242956 1.144195 0.785322 1.431466 1.007284 1.408259 0.811862 0.226871 0.926289 0.944428 -0.065490 0.204556 1.060450 0.673565 1.237223 1.421161 0.464445 1.650404 1.982931 1.032162 1.490820 1.351206 0.647400 1.371005 0.261767 0.720954 1.559044 1.181892 0.746365 0.927152 1.442807)
+ 7.617785 (fv 0.000000 1.762340 0.513621 1.350480 0.395272 0.369068 0.305583 0.831518 1.232517 0.676844 0.014044 1.888953 1.633364 1.298874 0.424500 1.402106 0.715815 1.275937 1.488547 1.873193 1.738228 0.570388 0.057875 1.975863 0.297300 1.563912 0.772704 0.090655 0.241787 1.145030 0.785784 1.432008 1.006607 1.408581 0.812224 0.224382 0.926131 0.944185 -0.064326 0.205583 1.060366 0.673429 1.237483 1.421583 0.464247 1.651757 1.984268 1.030220 1.489122 1.350599 0.646010 1.371095 0.262034 0.720620 1.557135 1.181053 0.745491 0.926931 1.443337)
)
;;; 60 odd -------------------------------------------------------------------------------- ; 7.7459
-#(60 9.8824768066406 #(0 1 0 1 1 1 1 1 1 0 1 0 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 0)
- 9.6560277938843 #(0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0)
+(vector 60 9.6560277938843 (fv 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0)
- 7.709748 #(0.000000 -0.020671 0.600831 1.675790 0.725943 0.358919 0.891460 0.765736 0.238937 0.820251 0.187326 0.996419 -0.076743 1.733226 1.719685 -0.079842 1.632736 0.230651 1.219304 -0.443689 1.508741 0.286774 0.743604 1.151633 1.815993 -0.008565 -0.168438 1.514997 0.247600 1.295630 1.210868 0.398238 0.341046 1.801457 0.378915 0.180184 1.808568 1.599816 0.493171 0.299229 0.111605 0.855314 1.806582 0.665008 1.223124 1.636432 1.426846 0.558429 0.087292 0.972159 -0.106439 1.103783 1.346165 0.427845 -0.084855 1.609696 0.060246 0.847249 0.678781 0.580836)
+ 7.699628 (fv 0.000000 -0.021305 0.599580 1.675097 0.724803 0.358532 0.890770 0.765518 0.237166 0.821603 0.185949 0.996346 -0.076908 1.733595 1.718331 -0.080896 1.631867 0.229557 1.219113 -0.444442 1.509828 0.286787 0.741904 1.151478 1.816287 -0.008152 -0.169986 1.514652 0.248473 1.296089 1.211441 0.399013 0.342384 1.801962 0.377537 0.181714 1.809056 1.599925 0.494049 0.298590 0.110648 0.855221 1.804868 0.666943 1.224265 1.636192 1.425598 0.559152 0.087897 0.972335 -0.105600 1.103327 1.345409 0.428767 -0.084957 1.609410 0.060258 0.846549 0.678506 0.580784)
)
;;; 61 odd -------------------------------------------------------------------------------- ; 7.8102
-#(61 9.9989261627197 #(0 0 0 1 0 1 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1)
- 9.9643812179565 #(0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1)
- 9.8069976254571 #(0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 0 0 0)
- 9.6689287776524 #(0 0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1)
+(vector 61 9.6689287776524 (fv 0 0 0 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1)
- 7.785940 #(0.000000 -0.344035 0.780624 1.808341 0.250309 0.511377 0.080614 1.156775 0.820476 0.392090 -0.519581 1.679294 0.562126 0.124871 0.037611 1.745936 1.825676 1.086555 1.688053 0.704340 0.270700 1.402108 1.232848 0.487597 1.474823 -0.284646 0.795967 1.369438 0.657817 0.974474 1.000398 0.177017 1.023875 0.864966 0.405700 0.718453 0.072830 1.456422 -0.479406 0.735547 1.217599 0.812412 1.022836 0.830688 1.510230 1.175223 1.640030 0.780812 -0.009698 1.223518 -0.208985 0.133118 0.651112 1.217323 -0.447806 0.092414 -0.063668 0.675161 0.911236 0.947342 0.780516)
+ 7.775467 (fv 0.000000 -0.343145 0.781525 1.809127 0.251480 0.512435 0.079273 1.157280 0.819596 0.391398 -0.518556 1.678636 0.560600 0.125318 0.035700 1.744672 1.824327 1.087291 1.692006 0.706036 0.269610 1.403225 1.233897 0.487088 1.476172 -0.284871 0.794501 1.368364 0.656660 0.974817 1.000338 0.175726 1.024682 0.865508 0.404847 0.718158 0.071740 1.457732 -0.480756 0.735357 1.217441 0.811494 1.022056 0.829877 1.509011 1.174960 1.639594 0.781475 -0.011943 1.221853 -0.208689 0.133149 0.650142 1.217107 -0.446658 0.092120 -0.062880 0.676055 0.910707 0.946198 0.780527)
)
;;; 62 odd -------------------------------------------------------------------------------- ; 7.8740
-#(62 10.200 #(0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0)
- 10.048614501953 #(0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1)
- 9.8772821666628 #(0 1 1 1 0 1 0 0 1 0 0 1 0 1 1 0 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0)
- 9.7982149124146 #(0 0 1 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 0)
+(vector 62 9.7982149124146 (fv 0 0 1 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 0)
- 7.851031 #(0.000000 0.023873 -0.411749 0.242048 0.676035 0.221261 1.417734 1.355098 1.676631 0.752173 0.205654 0.114165 0.043129 1.236395 0.589599 0.670945 0.509906 0.346010 0.608775 0.183358 -1.589145 -0.229859 0.146851 0.386812 0.095362 0.658093 0.872550 -0.063115 1.389659 0.084608 1.356297 1.286024 1.637975 0.780883 0.572550 1.464848 1.895994 0.251656 0.381513 0.249764 1.345656 1.157202 0.231339 0.882060 1.213582 0.602018 0.822726 1.397479 0.056407 0.948188 0.422964 1.384650 0.169537 1.430947 1.722186 0.842231 0.377148 0.985467 1.153047 0.445832 1.878658 1.100772)
- 7.827300 #(0.000000 0.186064 -0.253611 0.263500 0.631663 0.128802 1.483075 1.281691 1.557456 0.709512 0.292484 0.049697 -0.087694 1.426400 0.597020 0.679966 0.447559 0.382351 0.716879 0.084458 -1.564948 -0.139956 0.230356 0.340925 0.082970 0.638648 0.924159 -0.077788 1.383506 0.165456 1.518415 1.221878 1.575170 0.898586 0.322838 1.508540 -0.066092 0.115614 0.408297 0.298471 1.252342 1.083974 0.264969 0.922588 1.330008 0.690470 0.795693 1.526423 0.162198 0.886485 0.508520 1.477531 0.318133 1.340825 1.784108 0.798413 0.525906 1.054620 1.307975 0.409118 -0.027408 1.102595)
+ 7.816985 (fv 0.000000 0.185485 -0.254761 0.263400 0.632430 0.127767 1.483161 1.282005 1.556675 0.709224 0.293439 0.049467 -0.087443 1.425471 0.595679 0.678957 0.447779 0.382124 0.717681 0.082649 -1.563917 -0.140691 0.229960 0.339346 0.083428 0.640485 0.923623 -0.076532 1.385224 0.166806 1.518517 1.222370 1.575074 0.899045 0.324075 1.508603 -0.064272 0.115115 0.407781 0.298344 1.252368 1.084082 0.264721 0.922346 1.331199 0.689780 0.795795 1.526817 0.163429 0.888100 0.510259 1.478381 0.318687 1.341508 1.785614 0.798865 0.525568 1.053899 1.308203 0.410567 -0.026960 1.103176)
)
;;; 63 odd -------------------------------------------------------------------------------- ; 7.9372
-#(63 10.203475952148 #(0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 1 0)
- 10.191082449969 #(0 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 1 0)
- 9.8550319671631 #(0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 1 0)
+(vector 63 9.8550319671631 (fv 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 1 0)
- 7.916953 #(0.000000 1.546435 0.155396 0.898868 0.624858 0.563351 0.345785 0.704785 0.980536 1.014765 1.741059 0.009721 -0.039852 0.471287 1.202426 0.366771 0.369579 1.293814 0.310719 1.015679 1.843002 0.475414 1.865180 0.861309 0.880002 1.524976 0.949670 0.063863 0.657339 0.624833 0.890050 0.159573 0.668731 1.537225 -0.133566 1.887205 1.093363 1.578937 1.507735 1.618599 1.790062 1.491423 0.832146 0.166962 1.796695 0.043958 1.835012 1.002469 1.480132 0.609034 0.814858 1.239348 0.109235 -0.111805 1.347593 1.167359 0.906733 0.153678 1.422813 0.721368 0.432419 -0.039974 0.656436)
+ 7.904133 (fv 0.000000 1.545501 0.155683 0.898914 0.625696 0.564119 0.345790 0.703891 0.981672 1.014462 1.740323 0.008567 -0.039871 0.470077 1.202746 0.366398 0.367999 1.293490 0.310624 1.016687 1.843528 0.474437 1.864085 0.859066 0.880435 1.525047 0.949229 0.065485 0.658928 0.625456 0.890422 0.157110 0.668174 1.537633 -0.133525 1.887056 1.094821 1.580831 1.506736 1.621226 1.791740 1.492769 0.830911 0.166732 1.797834 0.044991 1.834240 1.000450 1.479368 0.610232 0.816463 1.240492 0.107919 -0.111385 1.348751 1.167090 0.907202 0.154866 1.422414 0.720983 0.430601 -0.041659 0.656229)
)
;;; 64 odd -------------------------------------------------------------------------------- ; 8
-#(64 10.559404013831 #(0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0)
- 10.301 #(0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1)
- 10.113667488098 #(0 1 1 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 0 0 0 0 0 1)
- 10.022200584412 #(0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 0 1)
- 10.0 #(0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0)
+(vector 64 10.0 (fv 0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0)
- 7.969220 #(0.000000 0.942426 0.215865 1.054243 0.820961 0.780626 1.083509 0.220158 0.531096 -0.001105 1.275898 1.059168 1.433698 0.244300 0.634823 0.375205 1.294533 0.051485 1.562336 0.853763 0.659629 0.850146 0.788839 0.003242 0.643174 -0.752204 0.795756 0.548041 1.341659 0.716222 1.722289 1.079318 1.010545 0.344598 1.393111 1.376994 1.263596 0.486287 1.142604 0.032701 0.468932 -0.098812 -0.020402 0.566924 1.793049 0.510256 0.420750 0.992520 1.133654 1.670325 -0.051968 0.159257 -0.042161 1.773491 0.331580 0.761615 1.502070 1.813334 1.080165 1.090829 0.366565 1.520501 0.864970 0.915549)
+ 7.957414 (fv 0.000000 0.941670 0.218463 1.054436 0.821282 0.779097 1.084317 0.220811 0.530574 -0.001214 1.277468 1.056444 1.434429 0.244804 0.635637 0.374642 1.294283 0.051882 1.563945 0.856817 0.659797 0.848723 0.789207 0.004337 0.642492 -0.752744 0.794434 0.546992 1.340010 0.716341 1.722360 1.081100 1.009399 0.345867 1.393328 1.377443 1.264631 0.487017 1.142544 0.031648 0.469271 -0.098334 -0.019627 0.567023 1.791954 0.511740 0.421519 0.992945 1.133377 1.668348 -0.054246 0.158608 -0.042808 1.772093 0.331126 0.762153 1.499580 1.813299 1.079657 1.088576 0.368377 1.519001 0.864479 0.914946)
)
;;; 65 odd -------------------------------------------------------------------------------- ; 8.0622
-#(65 10.517309434908 #(0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1)
- 10.169842720032 #(0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1)
+(vector 65 10.169842720032 (fv 0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1)
- 8.056884 #(0.000000 1.510831 1.423028 1.699963 1.498707 1.181627 -0.088927 1.273160 0.247257 1.454140 1.113995 0.406241 0.070571 0.504245 0.789715 1.686483 -0.030577 0.150278 0.260614 0.573221 1.904265 0.050104 1.633795 1.088214 1.406918 1.617122 0.542878 1.595259 0.708728 1.183079 1.723327 0.257425 -0.289825 0.361721 1.807772 1.245271 1.634137 1.268116 1.403100 0.050021 1.071157 0.033859 0.084593 0.128309 0.848998 1.224198 1.267907 0.839148 0.944320 1.723145 0.173412 0.953100 1.521519 1.305995 0.463264 -0.021313 1.791965 1.038193 0.490151 1.795998 0.197878 1.247617 0.563853 0.910632 0.853435)
+ 8.041843 (fv 0.000000 1.510279 1.423698 1.698060 1.501053 1.180996 -0.085543 1.272940 0.246128 1.452754 1.116882 0.406181 0.071379 0.504041 0.790673 1.684489 -0.028841 0.150831 0.258232 0.575724 1.903805 0.049803 1.632670 1.087031 1.406375 1.614155 0.540793 1.593111 0.703911 1.182639 1.722176 0.257146 -0.290703 0.360167 1.805766 1.244616 1.636667 1.267448 1.403263 0.048920 1.072378 0.033352 0.081404 0.128813 0.847252 1.224433 1.268463 0.838170 0.941587 1.720222 0.172123 0.951570 1.520723 1.306591 0.465991 -0.022358 1.791525 1.039956 0.489959 1.798920 0.197346 1.247948 0.566292 0.910361 0.850668)
)
;;; 66 odd -------------------------------------------------------------------------------- ; 8.1240
-#(66 10.212840820553 #(0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0)
+(vector 66 10.212840820553 (fv 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0)
+
+ 8.137089 (fv 0.000000 0.867002 -0.091284 0.941017 0.985813 1.124822 -0.061065 0.794288 1.395872 1.715915 0.180754 1.493753 0.091406 -0.059796 0.775109 -0.175925 1.503403 0.926368 0.549523 0.719653 -0.225722 0.805496 0.016786 1.138759 0.185499 1.460462 1.586490 0.459741 1.668207 1.371214 0.709682 0.824263 0.306383 0.060221 1.519433 1.454263 1.678352 0.268698 0.281303 0.104475 0.990641 -0.061422 1.164978 0.345674 0.648924 1.140977 0.632657 0.963358 1.933250 0.002500 1.501010 0.074909 0.787595 1.107851 1.157288 1.691148 1.812947 1.291647 1.327838 1.731755 1.607111 1.129367 0.868934 1.256116 1.509418 0.963219)
- 8.152519 #(0.000000 0.866935 -0.089256 0.942887 0.986280 1.124257 -0.058721 0.794763 1.398694 1.717942 0.181826 1.495852 0.089714 -0.060504 0.777604 -0.175473 1.508247 0.929228 0.551426 0.720497 -0.224335 0.808186 0.019635 1.137660 0.190361 1.463415 1.589596 0.459778 1.668113 1.372724 0.710461 0.826569 0.303134 0.062828 1.516924 1.453601 1.677311 0.269139 0.284078 0.104841 0.990731 -0.060552 1.169936 0.345992 0.646761 1.142421 0.634537 0.960315 1.933804 0.003810 1.496908 0.075983 0.788006 1.106606 1.154387 1.689686 1.817964 1.295056 1.329043 1.732480 1.610244 1.132249 0.873517 1.253677 1.510100 0.970646)
+ 8.095195 (fv 0.000000 0.946051 -0.069946 0.931149 1.114323 1.098389 -0.039332 0.877524 1.318916 1.775911 0.245290 1.539842 0.131201 -0.108794 0.748602 -0.153383 1.475925 0.851225 0.482687 0.831474 -0.195116 0.598903 -0.150418 1.241002 0.075671 1.415619 1.425349 0.401276 1.645496 1.378829 0.717955 0.820749 0.280776 0.102463 1.505118 1.466659 1.804612 0.370381 0.198640 0.039917 0.927835 0.130993 1.362388 0.264055 0.657827 1.168088 0.670275 0.998910 -0.080695 -0.000494 1.446059 0.092607 0.764024 1.120077 1.135001 1.626300 -0.038234 1.325677 1.373468 1.689492 1.591066 1.008988 0.840459 1.246657 1.459948 0.945345)
)
;;; 67 odd -------------------------------------------------------------------------------- ; 8.1853
-#(67 10.718281745911 #(0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 1 1 1)
- 10.287303318203 #(0 1 0 1 0 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 0 1)
- 10.209677696228 #(0 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 1)
+(vector 67 10.209677696228 (fv 0 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 1)
- 8.140113 #(0.000000 0.155466 0.760883 0.315279 1.611567 0.604505 0.952503 0.422859 -0.110717 1.446644 0.863120 0.198683 1.537970 0.172945 0.737633 0.917952 1.525668 1.422263 1.335913 0.799910 0.024604 0.360279 1.034409 1.252325 0.398919 1.737406 0.199643 0.356905 1.847021 -0.157877 -0.118494 -0.295512 1.763970 0.919292 0.548382 0.781855 -0.102137 1.938675 1.078316 1.928740 0.777671 0.358596 1.566808 0.659818 0.896035 1.286026 1.636591 -0.098939 1.687308 0.890977 1.387398 0.067835 0.498237 0.528412 0.140353 0.953743 0.656419 0.020448 0.775601 0.504669 1.382512 0.099587 0.960404 0.154498 0.652814 0.201259 0.384882)
+ 8.127999 (fv 0.000000 0.156189 0.759312 0.316632 1.612933 0.605013 0.952530 0.423099 -0.112233 1.447269 0.863131 0.200670 1.538179 0.172873 0.737196 0.916694 1.524894 1.423218 1.337268 0.799228 0.023760 0.359774 1.033535 1.252717 0.399347 1.736421 0.199827 0.358145 1.847858 -0.157369 -0.118965 -0.296280 1.764663 0.918422 0.547247 0.781682 -0.101912 1.939111 1.078792 1.928250 0.777073 0.358591 1.566766 0.658960 0.895914 1.285541 1.636763 -0.098157 1.684110 0.891684 1.386081 0.068089 0.497477 0.528377 0.140207 0.953073 0.655659 0.018618 0.774991 0.503967 1.384065 0.100041 0.959741 0.153740 0.654728 0.200720 0.384936)
)
;;; 68 odd -------------------------------------------------------------------------------- ; 8.24621
-#(68 10.698028101377 #(0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 0 1 1)
- 10.359804316765 #(0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0)
+(vector 68 10.359804316765 (fv 0 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0)
- 8.237777 #(0.000000 0.287260 1.637282 0.913464 0.670540 0.328671 0.246035 0.136837 0.769776 0.021397 1.323912 0.954657 1.085115 0.872319 0.285360 1.695146 0.473225 0.748728 0.775617 0.820583 1.601837 1.300420 0.415151 0.511432 1.013866 0.550878 1.247025 0.003037 0.286758 0.257211 0.059640 0.708593 0.358634 0.897268 0.581748 0.436230 1.242190 1.693947 0.779868 1.534904 -0.139991 0.643444 1.658729 0.851180 -0.011025 1.615464 1.677980 1.053330 1.432021 0.976173 1.748623 0.515863 0.357125 1.160712 -0.221951 0.714602 0.162028 1.479801 1.651854 0.021721 0.291746 1.854910 1.422956 0.382759 0.984968 1.342995 0.717228 0.487230)
+ 8.204414 (fv 0.000000 0.279095 1.647677 0.913913 0.663406 0.323080 0.240930 0.148599 0.780719 0.015227 1.335435 0.919514 1.070941 0.877126 0.293550 1.686752 0.481693 0.755701 0.785320 0.815615 1.595420 1.293383 0.426688 0.494705 1.026142 0.549725 1.259770 -0.007824 0.278489 0.224750 0.082547 0.719555 0.355973 0.908801 0.541094 0.432336 1.241602 1.708744 0.772870 1.505613 -0.137480 0.654507 1.657469 0.849573 0.009380 1.611286 1.676352 1.046709 1.432096 0.979028 1.747525 0.522938 0.318568 1.148496 -0.245690 0.703484 0.171945 1.485079 1.659272 -0.006233 0.283657 1.852744 1.398727 0.371514 0.974831 1.325922 0.719933 0.483798)
)
;;; 69 odd -------------------------------------------------------------------------------- ; 8.3066
-#(69 11.012202262878 #(0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 1)
- 10.744618415833 #(0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 1)
- 10.636575441359 #(0 0 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1)
- 10.452348709106 #(0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1)
+(vector 69 10.452348709106 (fv 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1)
- 8.286822 #(0.000000 1.788409 1.282257 -0.243275 0.144332 0.147372 0.582588 1.352720 0.820670 0.189941 1.414000 0.749482 1.059640 1.185143 1.094489 1.016383 0.161516 0.036696 0.497605 0.199194 1.710632 0.158778 0.616819 1.421634 1.168175 0.254077 1.519069 -0.175539 0.581179 0.194080 0.931559 -0.335790 0.288181 1.495548 0.038347 1.508309 0.993101 1.383618 1.230992 0.720738 1.621197 1.080692 0.185939 0.155063 0.909757 1.202469 1.049902 1.890071 0.429591 0.699293 -0.158546 0.279706 1.502937 0.567855 0.587581 0.684816 -0.246769 0.661087 0.986565 1.105766 0.572827 0.606959 -0.158508 0.926574 1.112685 0.938932 0.623827 1.346926 0.670541)
+ 8.274908 (fv 0.000000 1.788801 1.283513 -0.242756 0.145250 0.146755 0.584479 1.353542 0.821070 0.189803 1.413669 0.749926 1.058442 1.185407 1.095039 1.015258 0.161858 0.034929 0.498704 0.198138 1.711445 0.157768 0.616185 1.421248 1.168404 0.254474 1.519482 -0.175837 0.581687 0.194579 0.931780 -0.336100 0.287461 1.495068 0.039168 1.507647 0.993152 1.382317 1.231363 0.721890 1.622206 1.080570 0.186638 0.155662 0.909604 1.203958 1.050254 1.890059 0.428940 0.701250 -0.160137 0.279994 1.502298 0.567568 0.585424 0.686015 -0.246566 0.662061 0.986133 1.103373 0.572438 0.607162 -0.159332 0.926622 1.112278 0.937694 0.624990 1.345312 0.670451)
)
;;; 70 odd -------------------------------------------------------------------------------- ; 8.3666
-#(70 11.087729454041 #(0 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 1 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 1 1)
- 10.431521047498 #(0 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 1)
+(vector 70 10.431521047498 (fv 0 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 1)
- 8.344229 #(0.000000 1.210661 0.655754 -0.224516 0.271396 0.913305 1.006255 0.113609 1.640020 1.393717 1.775050 -0.158996 -0.193257 0.916832 -0.148716 -0.344462 0.173084 0.447314 0.685205 -0.187860 0.123528 0.641037 0.845944 0.921331 0.825549 -0.455435 1.004294 0.651009 0.326005 -0.379188 0.336398 0.882050 0.474953 1.925514 1.430108 1.350858 -0.183421 1.397130 0.598878 0.896121 1.137061 0.575085 1.213663 1.852292 0.377272 1.791604 0.834215 1.492119 0.305967 1.538053 0.647542 0.263658 1.348425 1.037055 0.891893 1.108632 -0.493657 -0.250068 1.081105 0.973406 0.593719 0.788896 0.004640 0.854363 1.606493 1.049265 0.833416 1.192766 0.128584 0.709546)
+ 8.328488 (fv 0.000000 1.209391 0.655351 -0.224668 0.270551 0.912782 1.006468 0.115362 1.639506 1.394128 1.775544 -0.158964 -0.191285 0.916307 -0.148807 -0.343643 0.171981 0.447415 0.684977 -0.187759 0.122627 0.642332 0.846737 0.920787 0.824105 -0.455822 1.004331 0.650453 0.327784 -0.378239 0.335174 0.883411 0.475111 1.924029 1.429019 1.351303 -0.183533 1.395982 0.599233 0.896200 1.135652 0.575692 1.213789 1.853140 0.377792 1.790714 0.835251 1.493542 0.305236 1.538414 0.647163 0.263422 1.348466 1.037276 0.893701 1.108073 -0.492190 -0.249170 1.081128 0.973414 0.593299 0.786885 0.003725 0.855855 1.605169 1.050037 0.831705 1.193285 0.128148 0.709803)
)
;;; 71 odd -------------------------------------------------------------------------------- ; 8.4261
-#(71 11.111848131381 #(0 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 1)
- 11.002258540604 #(0 0 0 0 0 1 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 1 1 0 0)
- 10.642364501953 #(0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0)
+(vector 71 10.642364501953 (fv 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0)
- 8.494597 #(0.000000 1.241385 0.744775 1.908651 0.012368 0.113425 -0.138323 1.584678 0.174803 0.776159 1.140287 0.817522 0.826077 0.747792 -0.285861 0.324310 1.105317 0.412569 1.657525 1.194529 0.971003 1.535926 1.845864 1.810044 1.494017 1.732440 0.530333 1.375076 0.848609 0.432902 1.152581 1.760015 -0.168545 0.715306 -0.060195 1.111780 1.551320 -0.100856 0.111091 0.995892 1.003323 0.457198 1.027706 1.365576 1.607726 -0.047880 1.221365 1.142981 1.182397 1.366006 0.748295 1.081426 1.186939 0.281032 1.422126 0.409907 1.089408 -0.186842 0.856345 0.131916 -0.056137 1.073312 1.269949 0.512071 1.882988 0.245939 -0.056928 1.516432 1.489448 0.437742 1.853913)
- 8.494356 #(0.000000 1.238878 0.752118 1.905122 0.006718 0.112305 -0.130351 1.588615 0.182729 0.770571 1.140765 0.818443 0.834328 0.745189 -0.280201 0.327776 1.092580 0.411181 1.668522 1.201707 0.978655 1.542598 1.840800 1.812742 1.492937 1.720915 0.528929 1.372913 0.843303 0.440329 1.145426 1.766861 -0.170690 0.708568 -0.055983 1.109763 1.555956 -0.111408 0.102793 0.997648 1.004721 0.445439 1.033320 1.365442 1.621088 -0.049401 1.214509 1.127272 1.179494 1.354682 0.751545 1.081403 1.182377 0.274791 1.417860 0.401397 1.094429 -0.189226 0.857744 0.117842 -0.058759 1.067085 1.266715 0.523051 1.873912 0.241231 -0.058360 1.525389 1.491717 0.433919 1.851752)
+ 8.475519 (fv 0.000000 1.238076 0.753931 1.905336 0.009769 0.107430 -0.130621 1.591198 0.182824 0.768320 1.146473 0.823523 0.829676 0.742699 -0.276539 0.324236 1.092544 0.415195 1.670265 1.207403 0.977157 1.540240 1.842707 1.816863 1.497289 1.724381 0.528087 1.371720 0.846254 0.443580 1.148328 1.771135 -0.168351 0.710309 -0.056239 1.109626 1.555511 -0.110149 0.103207 0.997197 1.006113 0.446860 1.034785 1.366376 1.616338 -0.046807 1.211677 1.130244 1.187406 1.353421 0.750549 1.080694 1.186040 0.268525 1.418417 0.401769 1.093799 -0.192487 0.855080 0.124908 -0.060822 1.069669 1.270728 0.527632 1.877202 0.240913 -0.052204 1.530974 1.498303 0.436500 1.851527)
+
+ ;; from this, but :odd 71 0.53864770353023 (fv 9.9351872829636 -0.2379167494546 3.1853837584999)??
+ ;; 9.9437 (fv 0.0000 1.0614 0.0950 1.1008 0.0787 1.0289 1.9512 0.8458 1.7125 0.5514 1.3626 0.1459 0.9014 1.6290 0.3289 1.0010 1.6452 0.2617 0.8503 1.4112 1.9442 0.4494 0.9268 1.3764 1.7982 0.1921 0.5583 0.8967 1.2072 1.4899 1.7449 1.9720 0.1713 0.3428 0.4865 0.6024 0.6904 0.7507 0.7831 0.7878 0.7646 0.7136 0.6349 0.5283 0.3939 0.2316 0.0416 1.8238 1.5781 1.3047 1.0034 0.6744 0.3175 1.9328 1.5203 1.0800 0.6119 0.1159 1.5922 1.0407 0.4613 1.8541 1.2192 0.5564 1.8658 1.1474 0.4012 1.6272 0.8253 1.9957 1.1382 )
+
+ 8.471193 (fv 0.000000 1.251993 0.120909 1.147167 0.101021 0.991005 0.102768 0.840256 1.667018 0.493083 1.454975 0.236751 0.930972 1.613715 0.282901 1.264934 1.852683 0.309294 0.763244 1.396502 0.016107 0.421575 0.832061 0.905495 1.670197 0.206770 0.024145 0.415927 1.292038 1.512037 1.549693 1.890115 0.264325 -0.038970 0.344515 0.662351 0.896654 0.664956 0.697808 0.735895 0.787344 0.830776 0.256004 0.590650 0.201668 0.204354 0.381917 1.530833 1.289723 1.098254 0.882568 0.234043 0.016492 0.014075 1.543842 0.771174 0.029614 -0.188598 1.614192 0.901328 0.316437 -0.299368 1.157490 0.464174 -0.326258 1.156953 0.332845 1.674680 0.336028 -0.185110 1.185822)
+
+ 8.406561 (fv 0.000000 1.136768 0.110422 1.080469 0.111645 0.980565 0.087135 0.892409 1.705799 0.484945 1.412134 0.209542 0.909173 1.678801 0.332063 1.134599 1.765595 0.287552 0.824497 1.474171 0.122562 0.547316 0.786695 0.921126 1.628959 0.181855 0.048990 0.491779 1.249164 1.531973 1.630614 -0.083456 0.308877 -0.134450 0.334308 0.596938 0.779083 0.610588 0.769576 0.748353 0.930715 0.765564 0.342767 0.573683 0.144254 0.219685 0.317964 1.469956 1.186980 1.051035 0.789756 0.253764 0.026652 -0.023543 1.467574 0.724088 0.114734 -0.223070 1.555542 0.968486 0.132084 -0.314737 1.118620 0.462013 -0.390063 1.067074 0.324923 1.582422 0.354510 -0.234876 1.172540)
)
;;; 72 odd -------------------------------------------------------------------------------- ; 8.4853
-#(72 11.026193997702 #(0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1)
- 10.912703440154 #(0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1)
- 10.880306243896 #(0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1)
+(vector 72 10.880306243896 (fv 0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1)
- 8.378171 #(0.000000 1.529558 0.709801 0.190298 0.777576 1.675243 1.052075 1.157929 0.196980 1.188004 0.205866 0.809331 1.907495 0.734674 1.470821 1.751598 0.976416 0.215728 1.669106 0.038607 0.307940 0.803976 0.414378 0.685861 0.933693 1.104675 0.869385 0.012366 1.431231 1.039259 0.654309 0.051201 1.637963 0.041069 0.434779 1.596488 0.630841 0.512994 1.124630 1.472576 0.029980 0.728427 0.901058 0.365007 0.830423 0.776797 0.088290 1.122947 0.055739 0.979747 0.814367 1.330398 0.404619 1.438457 0.752191 1.069756 1.034522 0.951753 0.589282 0.207019 0.696731 1.363655 0.008165 0.225109 -0.030188 1.267141 1.009132 -0.515935 0.251162 0.236358 0.010473 1.882402)
+ 8.366430 (fv 0.000000 1.529157 0.709835 0.191619 0.777505 1.673931 1.052039 1.157229 0.197845 1.188203 0.205209 0.808312 1.907251 0.734102 1.471024 1.752009 0.976735 0.215092 1.669497 0.039070 0.308185 0.805661 0.414650 0.685942 0.933087 1.104471 0.869537 0.010581 1.431457 1.039490 0.654718 0.051163 1.637896 0.041328 0.434461 1.596916 0.630066 0.513683 1.126090 1.472280 0.029687 0.729904 0.900726 0.364456 0.829387 0.775767 0.087943 1.122617 0.054278 0.980310 0.814649 1.331669 0.404897 1.438813 0.751132 1.069103 1.033498 0.950755 0.588560 0.206118 0.697556 1.364322 0.007771 0.225318 -0.029948 1.266843 1.008881 -0.515131 0.251545 0.235634 0.009431 1.881826)
)
;;; 73 odd -------------------------------------------------------------------------------- ; 8.5440
-#(73 11.087996391987 #(0 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 1)
- 10.907942771912 #(0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1)
+(vector 73 10.907942771912 (fv 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1)
- 8.574407 #(0.000000 1.479030 0.402045 -0.004306 1.132328 1.536082 0.075511 -0.229674 0.982076 1.313660 1.725149 -0.020176 0.244387 1.594367 0.061505 0.453626 0.752394 1.116805 0.573832 1.645884 0.498029 0.434660 1.288093 0.599867 -0.182242 0.083837 0.097035 1.345400 1.504627 0.068960 1.476501 1.405483 0.037761 0.417464 0.076506 0.400559 0.967092 0.564160 1.003378 1.219554 0.657224 0.738606 0.250920 0.570375 -0.199829 0.420095 0.214145 1.425922 0.685975 1.125445 0.379503 0.112342 0.283224 1.171351 1.260656 0.595905 0.118275 -0.153831 -0.010280 0.310723 1.726161 0.321280 0.691375 -0.256195 1.438039 1.136063 0.257185 1.508383 0.277140 0.992605 0.285475 1.589346 0.006298)
+ 8.514653 (fv 0.000000 1.403201 0.376583 -0.053235 1.209136 1.524715 0.146380 -0.261365 0.834173 1.272975 1.772227 0.023615 0.314599 1.515420 0.115615 0.532763 0.813612 1.148749 0.624829 1.610666 0.428301 0.533410 1.364035 0.688805 -0.345103 -0.033075 0.031988 1.294508 1.610808 0.200563 1.512417 1.458407 0.018985 0.336604 -0.051222 0.346655 1.033154 0.703796 1.103730 1.139661 0.592095 0.478459 0.370549 0.620498 -0.386452 0.468708 0.040902 1.488975 0.539537 0.999795 0.347372 0.354446 0.387241 1.176009 1.306213 0.778993 0.280166 0.010910 0.034863 0.320352 1.620759 0.391262 0.863014 -0.075789 1.338588 1.092040 0.260638 1.463660 0.169121 0.826134 0.241084 1.728130 -0.116721)
)
;;; 74 odd -------------------------------------------------------------------------------- ; 8.6023
-#(74 11.4198214166449 #(0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 0 1 0 0 1 1 0)
- 11.288741871055 #(0 0 1 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 1 0)
- 11.262331896 #(0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0)
+(vector 74 11.262331896 (fv 0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0)
- 8.499266 #(0.000000 0.229780 0.327959 0.885531 0.912117 -0.092723 1.468720 1.391934 0.102441 0.875858 1.118460 -0.375530 1.137749 1.793736 0.272094 0.159061 1.300294 0.336282 0.458088 0.993918 0.720261 1.265165 1.158294 0.202474 0.831724 1.368262 -0.207846 0.552108 0.143138 0.767306 -0.040640 0.249068 0.685868 1.808514 1.721528 1.633672 -0.372193 1.923644 1.132899 1.668332 0.858653 1.387504 0.638230 -0.325198 0.281805 1.477051 0.573370 0.063407 1.116536 1.234159 1.093910 0.166267 1.190601 0.933823 0.158663 1.594531 1.078221 1.252165 1.746965 1.137500 1.344497 1.096053 0.654411 0.038240 1.286202 -0.395790 1.311514 1.071413 0.014051 0.220542 -0.214455 0.088112 1.490200 0.953022)
+ 8.487915 (fv 0.000000 0.229202 0.328610 0.886519 0.913243 -0.092303 1.469261 1.392280 0.102684 0.875868 1.119399 -0.375546 1.138609 1.792722 0.270873 0.158504 1.300583 0.337402 0.457798 0.994721 0.720190 1.266403 1.157785 0.204200 0.832717 1.368187 -0.207911 0.551921 0.143469 0.767289 -0.041673 0.248888 0.686134 1.808117 1.719833 1.634354 -0.372228 1.923379 1.132948 1.667043 0.857041 1.387145 0.637791 -0.326159 0.280564 1.478231 0.572776 0.063470 1.115045 1.234238 1.093760 0.166042 1.189669 0.933614 0.159392 1.594960 1.079073 1.251388 1.747471 1.137640 1.343339 1.096317 0.655141 0.037576 1.286106 -0.396608 1.310863 1.072774 0.013655 0.220749 -0.215382 0.087335 1.489739 0.952386)
)
;;; 75 odd -------------------------------------------------------------------------------- ; 8.6603
-#(75 11.202813597023 #(0 0 0 1 0 1 0 0 1 1 1 0 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 1 1)
- 11.190553665161 #(0 0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1 1)
- 10.942812919617 #(0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1)
+(vector 75 10.942812919617 (fv 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 0 1 1)
- 8.668254 #(0.000000 1.112469 1.875887 -0.026373 0.873438 0.095971 0.967653 0.181160 1.801758 0.768128 1.707976 0.246911 0.921356 -0.034956 0.074885 1.467008 -0.538529 1.313198 1.356134 0.937128 0.143811 0.975344 1.652369 0.079291 0.305228 1.084959 -0.051323 -0.029222 0.417780 0.002559 0.513986 0.339318 0.923028 0.578397 0.869998 0.516177 0.511665 0.091053 1.846064 0.265370 1.634579 0.775228 1.704976 0.144518 0.979837 1.756802 1.507247 0.052185 0.101111 0.324482 0.879678 1.067872 1.256585 0.314115 1.872022 0.311751 1.587978 1.913503 0.735752 1.788568 0.038450 0.027008 0.925953 0.865947 0.320873 1.741469 1.292078 0.874020 -0.237862 1.536171 1.359178 0.612627 0.669624 0.985440 0.035788)
+ 8.649507 (fv 0.000000 1.109688 1.876179 -0.024908 0.874394 0.094974 0.967726 0.182001 1.798004 0.764080 1.705983 0.246581 0.919892 -0.031641 0.074543 1.466120 -0.542452 1.308866 1.354893 0.937217 0.141091 0.972731 1.649929 0.076730 0.306081 1.082330 -0.056612 -0.033267 0.417204 0.002975 0.510299 0.334065 0.921554 0.578842 0.861949 0.516829 0.507298 0.089901 1.846522 0.266232 1.636125 0.773196 1.708397 0.143239 0.982116 1.755516 1.504659 0.043743 0.095624 0.325057 0.879744 1.064185 1.252657 0.311473 1.870059 0.309527 1.581011 1.908962 0.734045 1.785988 0.038323 0.023116 0.922283 0.858183 0.320752 1.741469 1.289108 0.871189 -0.238214 1.531119 1.355752 0.609175 0.669122 0.984951 0.033177)
)
;;; 76 odd -------------------------------------------------------------------------------- ; 8.7178
-#(76 11.511628975629 #(0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 1 0 0)
- 11.446428749262 #(0 0 1 1 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0)
- 11.21743106842 #(0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 0 0 0)
+(vector 76 11.21743106842 (fv 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 0 0 0)
- 8.667469 #(0.000000 0.173790 0.838805 0.789463 1.213093 0.485335 1.020928 1.078399 1.511521 0.873261 1.658530 0.471293 1.282869 0.224121 1.187401 1.002080 0.600743 0.457836 1.522883 0.013770 0.484909 1.037816 0.887670 0.819225 0.428812 0.518972 0.949913 1.375977 0.275180 0.804309 0.131238 1.430746 0.574969 0.010263 1.710981 1.359641 0.416738 0.860556 0.492545 0.882535 0.253061 0.013550 1.530100 0.177573 1.883932 1.958726 0.358846 1.604088 0.941189 1.032385 0.502445 0.924340 -0.059772 1.149434 0.761766 0.584515 1.514004 1.022826 0.504830 0.957579 1.937786 0.290107 0.388089 1.349727 0.430411 1.690298 1.349802 0.156860 0.892102 0.710578 1.606531 1.584045 1.628047 1.565022 0.126535 0.825103)
+ 8.651279 (fv 0.000000 0.173353 0.839453 0.789458 1.213196 0.485342 1.020793 1.079117 1.510944 0.872759 1.658963 0.469539 1.282086 0.224500 1.187595 1.001928 0.601189 0.457802 1.523606 0.013310 0.486526 1.038767 0.887428 0.818932 0.429987 0.518887 0.949464 1.376735 0.275451 0.805159 0.132159 1.431344 0.575428 0.009721 1.711880 1.360202 0.416637 0.859810 0.491831 0.882963 0.253397 0.012929 1.530000 0.177927 1.883242 1.959160 0.357646 1.604277 0.939839 1.031583 0.502599 0.924357 -0.060587 1.148550 0.762073 0.585290 1.515308 1.022656 0.505967 0.958132 1.937796 0.289650 0.388753 1.349929 0.430727 1.688517 1.350532 0.156971 0.890960 0.708951 1.606885 1.582622 1.628222 1.565608 0.127771 0.825769)
)
;;; 77 odd -------------------------------------------------------------------------------- ; 8.7750
-#(77 11.623893901139 #(0 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 1)
- 11.38523739395 #(0 0 1 0 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 1 0 1 1 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 1)
- 11.302083969116 #(0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 0 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 1)
- 11.192246437073 #(0 1 0 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0)
+(vector 77 11.192246437073 (fv 0 1 0 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0)
- 8.720822 #(0.000000 1.733701 1.603429 1.700969 0.951902 1.205175 0.494435 0.079464 1.861212 1.411318 0.615814 0.455812 0.176024 0.523436 0.530754 0.947861 1.313105 1.035089 -0.217320 1.260206 0.365598 -0.233999 0.849717 1.173847 -0.194316 1.450566 0.290048 1.455414 0.669109 0.645301 1.306202 1.196855 0.656788 0.888442 1.963373 0.824468 -1.764774 0.784806 0.143235 -0.053640 0.034401 0.725393 -0.055740 0.122204 1.065683 1.577903 0.715442 -0.210936 1.194335 -0.094730 0.313833 0.914807 -0.006926 0.154744 0.086232 1.895832 1.191200 -0.344011 -0.287336 0.072782 0.944909 0.650252 0.108754 0.250509 -0.265918 1.016486 0.107872 1.056302 1.067976 1.856817 0.230679 0.491339 0.104307 0.571264 1.732668 0.354217 0.822056)
+ 8.707019 (fv 0.000000 1.733898 1.602888 1.700625 0.951967 1.205480 0.494785 0.079322 1.861432 1.411332 0.615577 0.456043 0.176616 0.522662 0.530871 0.948923 1.312747 1.035434 -0.217439 1.260792 0.366350 -0.233439 0.849314 1.174459 -0.193276 1.451248 0.290403 1.453670 0.668542 0.644436 1.306523 1.198202 0.657361 0.888118 1.964614 0.824349 -1.765380 0.784141 0.143386 -0.053030 0.033585 0.726269 -0.055055 0.121221 1.064245 1.578078 0.715470 -0.211778 1.194974 -0.095151 0.313319 0.914111 -0.007802 0.154723 0.086177 1.895682 1.191957 -0.344176 -0.285803 0.072705 0.944928 0.649978 0.107843 0.251480 -0.267013 1.016287 0.107966 1.055797 1.067984 1.857635 0.230948 0.492625 0.104053 0.572353 1.732176 0.353482 0.821975)
)
;;; 78 odd -------------------------------------------------------------------------------- ; 8.8318
-#(78 11.455265310659 #(0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 0 0)
+(vector 78 11.455265310659 (fv 0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 0 0)
- 8.729356 #(0.000000 1.668485 0.756881 0.164914 0.289019 0.683738 0.557466 0.681140 1.097879 0.470475 1.849525 1.090119 0.923292 1.128778 0.104893 -0.129854 0.327318 -0.052377 1.142292 0.483703 0.896185 0.813263 0.303231 0.071921 -0.169336 0.656334 0.700271 1.004643 -0.007613 -0.189595 0.559279 0.412621 0.828634 1.110416 -0.043163 0.613136 0.576424 0.610668 1.234212 0.584457 0.886470 1.854111 1.163800 1.496242 0.204546 1.117343 1.730821 1.711658 0.817116 1.208857 1.691767 0.213957 -0.047663 0.692490 0.108958 0.207419 0.460514 1.630357 -0.229930 1.444850 1.207247 -0.028547 1.708255 1.337332 1.004020 0.392739 1.182087 -0.206920 1.255142 0.056134 1.571731 0.643024 1.169335 0.291922 1.024749 0.560962 0.633805 0.122584)
+ 8.715270 (fv 0.000000 1.669247 0.757594 0.165819 0.288294 0.684770 0.557521 0.680526 1.097350 0.470057 1.849497 1.090608 0.922922 1.129049 0.104794 -0.129005 0.326960 -0.051784 1.142568 0.483331 0.896117 0.813482 0.302867 0.073158 -0.168821 0.656167 0.700004 1.004810 -0.007423 -0.189996 0.560929 0.412734 0.830296 1.110767 -0.043008 0.613326 0.576197 0.610404 1.233787 0.583712 0.887457 1.853983 1.162911 1.497407 0.204463 1.117898 1.731543 1.711291 0.816677 1.207698 1.691953 0.214296 -0.046452 0.692536 0.108168 0.208702 0.459557 1.630550 -0.229002 1.446147 1.208030 -0.028606 1.708585 1.336818 1.004606 0.393864 1.182948 -0.208442 1.255124 0.056920 1.572769 0.643674 1.170025 0.291140 1.025254 0.562266 0.633856 0.124004)
)
;;; 79 odd -------------------------------------------------------------------------------- ; 8.8882
-#(79 11.710210993982 #(0 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0)
- 11.54291004024 #(0 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0)
+(vector 79 11.54291004024 (fv 0 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0)
- 8.896018 #(0.000000 0.387510 0.039885 1.302450 -1.634790 1.145864 0.527511 0.409524 0.133322 0.618726 0.726428 1.093510 1.443980 1.195905 0.025740 1.622873 0.268928 0.031404 1.217257 1.594745 -0.069866 1.222552 0.216602 0.614940 0.798687 0.116991 1.252720 1.280090 1.114114 0.677740 1.163766 1.055690 -0.106691 1.064497 1.107250 1.520392 0.672184 0.954158 -0.169534 0.236606 1.339596 0.781920 1.493440 -0.082181 1.652604 1.471004 0.172078 1.076990 0.713396 1.157254 -0.001018 0.610783 1.445702 1.341093 1.318118 -0.085294 0.468648 0.409828 1.234229 0.299172 0.325772 -0.034066 1.095880 1.479114 1.252976 0.226961 1.115568 1.237290 0.553648 1.057643 0.604108 0.783486 0.105930 1.331245 1.033399 1.050683 0.269013 1.660709 1.099752)
+ 8.864559 (fv 0.000000 0.357256 0.036759 1.292339 -1.618603 1.176406 0.544736 0.398074 0.109043 0.617241 0.697903 1.118083 1.422870 1.215951 0.004362 1.621202 0.264308 0.010496 1.213090 1.597753 -0.054911 1.223572 0.202448 0.615339 0.757193 0.130847 1.245098 1.256256 1.117774 0.701640 1.170787 1.057213 -0.087146 1.024522 1.105914 1.493238 0.672326 0.950638 -0.158430 0.266150 1.329043 0.773121 1.527296 -0.078973 1.669452 1.490229 0.141063 1.057903 0.727028 1.146281 0.010335 0.602841 1.428986 1.325796 1.320411 -0.094534 0.491229 0.443206 1.223761 0.317919 0.333487 -0.004296 1.074159 1.511918 1.245758 0.213171 1.140531 1.245789 0.552067 1.083032 0.600490 0.777304 0.106919 1.336123 1.060329 1.059212 0.289692 1.668881 1.086200)
)
;;; 80 odd -------------------------------------------------------------------------------- ; 8.9443
-#(80 12.0 #(0 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 1 1 1 0 1 0)
- 11.963202476501 #(0 0 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 1 0 1)
- 11.681501776885 #(0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1)
- 11.501195907593 #(0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 0 1 1)
- 11.122416496277 #(0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1)
+(vector 80 11.122416496277 (fv 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1)
- 8.966840 #(0.000000 0.661930 0.591026 1.546721 0.372093 1.435958 0.289288 1.717731 1.162449 1.219831 0.354768 1.127898 0.411868 0.765781 0.129086 -0.235083 -0.003090 0.870196 1.184502 0.569372 1.718656 1.048800 0.577871 0.174310 0.762202 -0.050660 0.167991 1.478092 0.667550 1.332754 0.866599 0.030816 1.245765 1.129099 0.141034 0.735378 1.081604 -0.096834 0.930718 0.130011 0.365928 1.496569 0.484648 0.854401 -0.116856 0.315186 0.839681 1.292344 1.439449 0.875285 0.375589 1.163679 0.488334 0.837394 0.100841 1.524726 1.196397 0.517924 0.487587 0.906811 1.387797 1.463126 0.110133 0.978040 0.606017 0.307385 0.552641 0.834972 1.361134 1.487818 1.647277 1.949743 -0.025976 -0.174957 1.698130 0.102525 -0.191930 0.022986 -0.354235 1.081197)
+ 8.870144 (fv 0.000000 0.655710 0.591720 1.625031 0.418269 1.346736 0.349691 1.735905 1.181438 1.185938 0.537355 1.048431 0.310338 0.725392 0.138830 -0.162626 -0.012235 1.033480 1.181949 0.616925 1.912794 0.918753 0.626238 0.223870 0.664522 -0.078088 0.256973 1.394811 0.721353 1.350998 0.870615 0.111718 1.175636 1.041732 -0.087582 0.658928 1.024480 -0.106481 0.957206 0.153547 0.343423 1.369668 0.634606 0.765343 -0.148776 0.328436 0.827668 1.133483 1.461950 0.929478 0.348570 1.212214 0.446866 0.848436 0.219387 1.773456 1.168998 0.793903 0.614230 1.089360 1.446367 1.640320 0.120507 0.926616 0.816912 0.468029 0.525200 0.868913 1.510302 1.541893 -0.030330 0.055242 0.070867 0.042035 1.687456 0.144651 -0.241563 0.096801 -0.095086 0.917714)
)
;;; 81 odd -------------------------------------------------------------------------------- ; 9
-#(81 11.757609887857 #(0 1 1 0 0 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1)
- 11.553661099057 #(0 0 1 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1)
- 11.381307601929 #(0 0 1 0 0 0 1 0 1 0 0 1 1 1 1 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1)
- 11.372210502625 #(0 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1)
+(vector 81 11.372210502625 (fv 0 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1)
- 8.938280 #(0.000000 0.164163 -0.381995 0.082273 1.097690 1.524980 0.078154 0.977027 0.408032 0.831645 0.534458 0.613745 1.643545 -0.056855 0.445383 1.445249 0.996794 0.840341 0.528576 0.832183 0.248694 0.503659 1.190869 0.745199 -0.207830 0.493180 1.110768 0.979564 0.817424 1.339225 1.000239 1.337112 1.804980 0.900301 0.555096 1.747018 0.604514 0.728373 -0.166786 1.057975 1.176578 1.277286 1.123213 1.126706 -0.223073 0.316831 1.081671 0.509223 0.250907 0.339256 0.400440 1.857422 0.606345 0.245361 0.806195 -0.037774 -0.062149 1.551950 1.126873 0.180864 0.977133 0.409972 1.244129 1.541822 1.450323 0.050180 0.208039 1.102210 0.960222 0.189646 0.354075 1.725006 1.385403 0.545652 1.966161 0.479656 0.757658 1.039518 -0.003878 1.477925 0.905974)
+ 8.926326 (fv 0.000000 0.164735 -0.380225 0.081555 1.097918 1.524480 0.077656 0.977304 0.407700 0.831319 0.533822 0.615403 1.642513 -0.058036 0.444751 1.446330 0.995710 0.841112 0.528746 0.832226 0.248085 0.502898 1.190162 0.745146 -0.208212 0.492995 1.110378 0.980131 0.817203 1.338834 1.000001 1.336192 1.804389 0.900670 0.555661 1.748659 0.603816 0.728857 -0.167279 1.058563 1.176033 1.277029 1.122180 1.127499 -0.224172 0.316000 1.080199 0.508511 0.252234 0.338999 0.400496 1.857653 0.607017 0.245631 0.807136 -0.037588 -0.063570 1.552479 1.126540 0.180335 0.976685 0.410774 1.244176 1.541645 1.450598 0.050542 0.208414 1.102430 0.959489 0.189328 0.354550 1.724776 1.384943 0.545643 1.965929 0.479461 0.756949 1.038515 -0.004640 1.477899 0.906680)
)
;;; 82 odd -------------------------------------------------------------------------------- ; 9.0554
-#(82 11.815696616621 #(0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0)
- 11.662058134504 #(0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 0)
+(vector 82 11.662058134504 (fv 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 0)
- 8.909747 #(0.000000 1.650612 0.929517 0.669256 0.459403 1.573941 1.404195 1.106584 0.597245 0.021075 1.134108 0.618333 1.701567 0.504688 1.614112 1.519348 0.471267 1.288905 0.060234 0.428883 0.231544 1.558491 0.383847 0.161183 0.067869 -0.030823 1.866263 -0.109899 1.124061 0.250171 0.520082 0.463753 1.760213 0.123926 -0.064308 1.879300 0.090180 0.846003 1.061340 -0.249136 -0.241794 0.207623 1.549571 0.621018 0.599188 1.032450 -0.103750 1.727462 0.898610 0.128533 0.928728 1.722453 0.730288 1.329994 0.777815 1.207335 0.370497 1.268799 1.811328 0.561524 0.695364 1.442141 0.214004 1.839213 0.083350 1.604737 1.503841 0.121198 0.272219 0.894828 0.554983 -0.358509 0.959743 0.865689 1.049804 1.458162 1.064197 -0.106409 0.240195 0.516061 0.295267 -0.036262)
+ 8.895498 (fv 0.000000 1.650756 0.929235 0.669074 0.458613 1.575883 1.406092 1.106790 0.596730 0.021347 1.134970 0.616933 1.701827 0.504785 1.614982 1.519418 0.470952 1.289129 0.059550 0.427695 0.231422 1.559220 0.383709 0.161407 0.068209 -0.031038 1.865998 -0.109083 1.124535 0.249567 0.520329 0.463755 1.759816 0.122747 -0.063135 1.879507 0.089457 0.845717 1.061947 -0.248630 -0.240924 0.207853 1.548893 0.621489 0.599673 1.031885 -0.104736 1.726398 0.898686 0.128558 0.928155 1.723232 0.730130 1.329452 0.779285 1.207734 0.370523 1.269134 1.812531 0.562255 0.696469 1.440871 0.214062 1.838981 0.082605 1.605017 1.504365 0.122097 0.273097 0.895327 0.555120 -0.358045 0.959494 0.864915 1.049696 1.458692 1.063317 -0.105762 0.240946 0.516137 0.295184 -0.035654)
)
;;; 83 odd -------------------------------------------------------------------------------- ; 9.1104
-#(83 12.05688291879 #(0 0 1 1 1 0 0 0 0 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1)
- 11.795211509729 #(0 0 1 1 1 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1)
- 11.732900669843 #(0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1)
+(vector 83 11.732900669843 (fv 0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1)
- 9.074406 #(0.000000 0.848363 1.074758 0.345456 0.201738 1.511342 1.111690 0.571954 1.580917 0.217930 0.978731 0.830148 0.504480 0.410659 1.579630 1.031815 0.665814 1.347101 1.680520 1.486612 0.617432 -0.257159 0.905569 0.230442 0.059101 -0.145913 0.546663 0.383926 1.385811 0.664215 1.583988 0.054614 1.670920 1.387250 1.915736 0.554497 1.478153 0.227950 -0.050850 0.209626 -0.192027 1.818184 0.655939 1.258956 0.062729 0.650887 -0.034038 1.076009 0.761935 0.655162 1.031848 0.851448 0.101068 1.305930 1.683296 0.919211 1.132521 0.788696 0.089621 0.752780 0.650872 0.662390 0.956044 -0.152331 1.699522 0.066690 0.561161 0.668879 1.944212 0.506687 0.166828 1.291229 1.367439 0.074476 1.017001 0.584499 1.285520 0.730717 0.793469 0.838037 0.817876 1.774805 0.234948)
+ 9.060733 (fv 0.000000 0.847614 1.074595 0.345210 0.202371 1.511917 1.112425 0.572830 1.582187 0.218687 0.979697 0.829284 0.504832 0.409321 1.581223 1.031036 0.666780 1.347208 1.680503 1.486577 0.618089 -0.256946 0.905019 0.230952 0.059969 -0.145434 0.545921 0.384376 1.384380 0.665205 1.583895 0.055621 1.669433 1.386960 1.917214 0.552314 1.477586 0.229404 -0.049820 0.210015 -0.192839 1.819422 0.656731 1.258726 0.062676 0.649682 -0.033937 1.076469 0.763030 0.654748 1.032680 0.850557 0.101236 1.303860 1.683735 0.917766 1.133625 0.788918 0.091033 0.752267 0.650807 0.661591 0.956487 -0.151184 1.699725 0.067039 0.562858 0.669739 1.945082 0.507537 0.168655 1.291963 1.367257 0.073343 1.018407 0.584241 1.284655 0.733315 0.794277 0.838058 0.819351 1.776021 0.236189)
)
;;; 84 odd -------------------------------------------------------------------------------- ; 9.1652
-#(84 12.003616535189 #(0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1)
- 11.724502770898 #(0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1)
- 11.626023292542 #(0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1)
+(vector 84 11.626023292542 (fv 0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1)
+
+ 9.185550 (fv 0.000000 -0.021653 -0.040601 1.163796 1.903509 0.943755 0.646624 1.866284 1.925515 0.123826 0.553199 0.965947 -0.075756 1.082744 1.817561 1.285536 1.050220 0.807240 0.605743 0.429498 0.508235 1.302559 1.611197 -0.514061 0.753992 1.700832 1.582166 0.521137 0.493019 0.834823 1.698189 0.272829 1.846496 1.874128 0.834101 0.281869 1.080560 1.438521 0.953941 1.280344 1.022208 1.661905 1.607595 1.126422 0.777808 0.689451 0.023149 0.691721 0.542242 0.838865 0.011483 1.098563 0.333470 0.611697 0.199907 -0.091248 0.912993 0.515958 1.079940 1.005613 0.731323 0.930947 0.301128 0.363360 0.978049 -0.000124 -0.516420 0.523117 0.574889 0.270432 1.275532 0.818251 1.531964 1.322842 0.207974 1.087144 1.315578 0.094014 1.345898 1.884730 0.414183 1.230212 1.440972 0.367718)
- 9.215910 #(0.000000 -0.016897 -0.041858 1.166306 1.895189 0.944874 0.643336 1.863030 1.916628 0.125638 0.543301 0.957491 -0.074351 1.076684 1.814105 1.292125 1.053052 0.799372 0.595093 0.432949 0.516219 1.307938 1.618831 -0.514584 0.747130 1.692171 1.582767 0.519676 0.482603 0.842616 1.698116 0.266671 1.852901 1.850278 0.837516 0.265834 1.093171 1.452636 0.963071 1.267541 1.005167 1.661913 1.588006 1.099412 0.771860 0.692210 0.015845 0.691691 0.522870 0.857574 0.022337 1.105922 0.322573 0.608691 0.199902 -0.095892 0.895792 0.515357 1.091523 0.997599 0.725611 0.925444 0.295004 0.341041 0.965069 0.010237 -0.516196 0.522612 0.565034 0.285995 1.251358 0.837025 1.508307 1.318155 0.202042 1.071218 1.303633 0.090227 1.338999 1.878913 0.395975 1.212113 1.441438 0.375783)
+ ;; (fv 10.778808034738 -0.227659005925 3.1786048937356)
+ ;; 10.7788 (fv 0.0000 0.9393 1.9022 0.8886 1.8986 0.9322 1.9893 1.0700 0.1743 1.3021 0.4535 1.6284 0.8269 0.0490 1.2946 0.5638 1.8566 1.1729 0.5128 1.8762 1.2632 0.6738 0.1079 1.5656 1.0469 0.5517 0.0801 1.6320 1.2075 0.8066 0.4292 0.0754 1.7452 1.4385 1.1554 0.8959 0.6599 0.4474 0.2586 0.0933 1.9515 1.8334 1.7387 1.6677 1.6202 1.5963 1.5959 1.6191 1.6659 1.7362 1.8301 1.9476 0.0886 0.2531 0.4413 0.6530 0.8882 1.1471 1.4295 1.7354 0.0649 0.4180 0.7947 1.1949 1.6186 0.0660 0.5368 1.0313 1.5493 0.0909 0.6560 1.2448 1.8570 0.4929 1.1522 1.8352 0.5417 1.2718 0.0254 0.8027 1.6034 0.4278 1.2757 0.1471 )
+
+ 9.165706 (fv 0.000000 0.934656 0.009740 0.892912 1.914788 0.817407 -0.047164 1.003969 0.164884 1.249319 0.380071 1.616476 0.954376 0.202231 1.312292 0.604557 -0.077459 1.312472 0.754364 -0.003767 1.276135 0.650523 0.170854 1.618591 1.053160 0.577476 -0.205916 1.453889 1.286143 0.889924 0.243897 -0.239706 1.833300 1.444468 1.151374 0.857183 0.586020 0.323924 0.036983 0.119493 -0.037558 1.940953 1.593882 -0.092635 1.798428 1.555339 1.399215 1.467642 1.835150 1.833867 -0.004678 -0.067916 0.264183 0.072836 0.826599 0.656778 1.089237 1.011513 1.337524 1.652586 0.118011 0.621082 0.947811 1.150679 1.538842 -0.108726 0.395215 0.886557 1.570811 -0.049501 0.809380 1.348209 1.743527 0.295071 1.055258 1.946886 0.463731 1.299054 0.188329 0.827519 0.037317 0.845744 1.341936 0.257273)
+
+ 9.138477 (fv 0.000000 1.077136 0.063003 0.974335 0.001930 0.872203 0.017246 1.080670 0.235219 1.252888 0.378851 1.612382 0.956324 0.200975 1.336006 0.666511 -0.109401 1.250621 0.645704 -0.034379 1.373066 0.621844 0.153419 1.662637 1.014313 0.564772 -0.158790 1.458303 1.312400 0.935605 0.228083 -0.303405 1.933909 1.508310 1.203183 0.851210 0.700949 0.260045 0.137593 0.186330 -0.029149 0.093187 1.669321 -0.022893 1.804433 1.569916 1.547568 1.535838 1.866608 1.883016 0.163191 -0.079249 0.336381 0.043460 0.741963 0.718443 1.177177 1.028118 1.387506 1.729902 0.144100 0.716901 1.003307 1.132902 1.504355 -0.063217 0.409728 0.962060 1.632348 0.020339 0.842809 1.386919 1.688164 0.250155 0.883600 1.992873 0.466027 1.340844 0.278519 0.955099 -0.020386 0.926876 1.398431 0.248264)
+
+ 9.133456 (fv 0.000000 1.059401 0.031287 0.939386 -0.017860 0.901644 0.001799 1.027990 0.230681 1.311963 0.341928 1.644077 0.966811 0.236475 1.300649 0.692497 -0.027953 1.347389 0.723063 -0.003313 1.322772 0.582050 0.159545 1.703814 1.026586 0.555590 -0.158337 1.444034 1.321735 1.003900 0.274358 -0.325622 1.927342 1.457207 1.230507 0.919830 0.720469 0.244803 0.085297 0.173845 -0.048361 0.080359 1.671325 0.039907 1.736091 1.631912 1.486133 1.471880 1.784848 1.922823 0.107240 -0.103436 0.280519 -0.025774 0.700275 0.720167 1.157653 1.036798 1.295565 1.717341 0.156191 0.724169 1.042098 1.172208 1.529978 -0.089227 0.426393 0.952547 1.692201 0.117254 0.809203 1.354853 1.694705 0.278490 0.926144 0.035100 0.434956 1.402186 0.356337 0.912787 0.017302 1.021860 1.401595 0.333844)
+
)
;;; 85 odd -------------------------------------------------------------------------------- ; 9.2195
-#(85 12.48290348053 #(0 1 1 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1)
- 12.309050256429 #(0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1)
- 11.829360154975 #(0 0 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1)
+(vector 85 11.829360154975 (fv 0 0 0 1 0 0 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1)
- 9.186875 #(0.000000 1.199589 -0.044628 0.497308 0.154859 0.438152 1.717472 -0.154199 0.254542 0.942436 -0.112473 1.664475 1.596673 1.073217 0.295231 1.489136 -0.086764 1.402164 1.815066 1.099579 -0.402047 1.351151 1.266029 1.075381 0.061269 -0.370068 0.813531 0.325078 0.635444 1.653216 1.582025 0.619596 1.054683 1.391301 1.099011 0.285039 1.477712 1.042491 1.920966 0.305327 -0.626071 1.791744 1.775779 0.677880 1.504950 1.182842 0.630312 1.357180 0.666166 0.343028 0.927999 0.192968 1.009139 1.193717 -0.116706 0.080349 1.591884 1.522309 0.439534 1.765543 0.396840 1.445714 -0.047030 0.961385 0.316866 0.615340 1.086151 0.290605 0.141705 0.155546 0.507476 0.686601 1.471669 1.165264 0.371221 0.294363 0.405004 -1.767531 1.245679 0.994150 1.008648 0.784412 1.105658 1.673689 0.087622)
+ 9.172932 (fv 0.000000 1.198268 -0.046093 0.496651 0.155499 0.438914 1.717129 -0.153996 0.255959 0.942459 -0.112043 1.664994 1.597976 1.071752 0.293731 1.489898 -0.088206 1.402767 1.814932 1.099748 -0.400724 1.351064 1.265640 1.075629 0.060651 -0.371046 0.814537 0.326687 0.633977 1.654428 1.582553 0.618025 1.054016 1.391986 1.098803 0.284271 1.476963 1.042434 1.922088 0.305413 -0.626240 1.791879 1.777727 0.678099 1.505684 1.182071 0.629820 1.357783 0.665420 0.341784 0.926591 0.193623 1.006880 1.192651 -0.116178 0.080172 1.591790 1.522361 0.438822 1.766471 0.395503 1.446548 -0.046614 0.961931 0.316539 0.616763 1.087859 0.290761 0.142685 0.155135 0.508154 0.686168 1.471184 1.165229 0.372220 0.294409 0.404832 -1.767095 1.243980 0.993281 1.007462 0.784244 1.104711 1.671816 0.086342)
)
;;; 86 odd -------------------------------------------------------------------------------- ; 9.2736
-#(86 12.300269991896 #(0 0 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1)
- 12.274354058598 #(0 0 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1)
- 12.140432277993 #(0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1)
+(vector 86 12.140432277993 (fv 0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1)
- 9.229657 #(0.000000 0.676354 0.369030 1.486329 -0.025485 0.680338 0.928473 1.201257 0.762657 0.130377 -0.062786 0.333564 0.755274 0.551167 0.780812 -0.164191 1.829646 -0.359839 0.452753 0.394365 1.217765 1.665611 1.262355 0.464512 0.486134 1.714606 0.418513 0.981168 0.818024 0.010352 0.750365 0.986748 1.412111 0.251274 1.542103 0.683503 0.250161 0.698737 0.175973 0.312958 1.883786 1.099602 1.640896 1.726312 -0.397466 1.509070 0.363477 1.073119 1.570926 0.692111 1.202031 -0.105190 0.984420 0.849544 -0.104846 1.581968 -0.053371 0.837452 1.425484 1.118465 -0.078002 0.537670 1.395102 -0.009396 1.539171 0.438231 0.217804 0.527908 0.854162 0.357115 0.425527 0.871447 0.435289 0.768652 0.097290 1.701874 0.991228 1.315175 1.134637 0.438482 0.043386 0.788600 0.137974 -0.082130 1.097475 0.573900)
+ 9.213343 (fv 0.000000 0.676268 0.369198 1.486263 -0.026625 0.678855 0.928889 1.200870 0.763422 0.131815 -0.064018 0.334478 0.754549 0.549209 0.781916 -0.164085 1.831169 -0.359871 0.452632 0.395640 1.217523 1.666783 1.263104 0.462675 0.487261 1.713262 0.419400 0.982422 0.818648 0.009279 0.749148 0.986045 1.410580 0.251205 1.543152 0.685375 0.249458 0.699138 0.175620 0.312944 1.884362 1.099441 1.640835 1.728596 -0.397229 1.509431 0.364317 1.073248 1.571193 0.690550 1.201949 -0.104903 0.984182 0.850373 -0.106842 1.582861 -0.052279 0.837387 1.423896 1.118738 -0.077783 0.539913 1.394923 -0.009295 1.541216 0.438460 0.217352 0.527395 0.855264 0.357004 0.424674 0.870332 0.435096 0.770273 0.096843 1.702425 0.991351 1.315154 1.133850 0.440564 0.044541 0.788769 0.138246 -0.080948 1.096067 0.575869)
)
-;;; 87 odd -------------------------------------------------------------------------------- ; 9.3274
-#(87 12.733045578003 #(0 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 1)
- 12.481803894043 #(0 1 0 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 0 0 0 0 0 0 1 0 1)
- 11.937030388359 #(0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1)
+;;; 87 odd -------------------------------------------------------------------------------- ; 9.32737905
+(vector 87 11.937030388359 (fv 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1)
- 9.389697 #(0.000000 1.286342 0.768247 1.389576 0.582625 1.398818 0.637184 1.074148 0.975492 0.824738 0.107711 0.227771 1.239027 0.842120 0.674384 -0.305418 0.405905 0.576889 0.776558 1.375784 1.828185 0.200779 1.136791 0.489270 0.797598 0.613880 1.568789 1.362196 0.743843 0.854673 0.959652 1.591780 -0.063630 1.025759 0.473681 0.415755 0.140781 0.758743 1.566077 1.688243 1.156130 0.894553 0.701099 0.359913 0.645085 0.341184 -0.051101 0.150541 1.077039 0.161301 0.839875 1.154663 -0.546650 1.294777 0.298143 -0.322405 1.222392 0.507679 -0.039784 1.589932 0.416623 1.985228 0.202031 1.741933 0.762350 1.404485 0.658672 -0.292737 -0.084527 -0.627892 1.582736 0.368537 0.587215 1.232505 0.357471 1.054695 0.092354 0.219371 0.918652 0.255351 0.325491 0.714280 0.845269 1.290376 0.624380 -0.260964 1.149466)
+ 9.317037 (fv 0.000000 1.269780 0.764198 1.382169 0.560101 1.397366 0.619615 1.110127 1.074742 0.786154 0.097129 0.187903 1.280480 1.001234 0.625991 -0.253578 0.524611 0.642531 0.754319 1.395067 1.865340 0.173765 1.213561 0.413784 0.704706 0.640451 1.483492 1.299442 0.783307 0.912207 0.977809 1.588075 -0.173310 1.063721 0.534821 0.450809 0.251070 0.792950 1.489833 1.745329 1.098607 0.960633 0.682333 0.343541 0.677820 0.343804 -0.007548 0.114569 1.083276 0.044826 0.931689 1.109596 -0.582840 1.287598 0.295851 -0.261696 1.183896 0.581304 -0.088958 1.623439 0.434479 0.025514 0.230711 1.672013 0.717129 1.395826 0.682208 -0.299168 -0.096350 -0.604219 1.679467 0.411395 0.711815 1.234251 0.324421 0.995113 0.167630 0.383406 0.968742 0.310771 0.425004 0.820195 0.922682 1.343873 0.606017 -0.248788 1.112139)
)
;;; 88 odd -------------------------------------------------------------------------------- ; 9.3808
-#(88 12.652858832418 #(0 0 1 0 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0)
- 12.592202186584 #(0 0 1 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0)
- 12.128922775356 #(0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1)
+(vector 88 12.128922775356 (fv 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1)
- 9.339918 #(0.000000 0.720339 1.146737 1.623067 0.921072 1.475969 1.668103 0.418235 1.222247 1.077413 0.636737 0.109539 0.709502 0.402803 1.341957 0.470722 1.037308 -0.015461 -0.222700 1.400463 0.256767 -0.054105 1.038749 1.524816 0.900296 0.540263 0.958868 1.268402 0.664040 1.799469 1.659561 0.625325 0.519431 0.588343 -0.003608 1.346034 -0.055418 0.616993 0.290115 1.478166 0.856424 0.751820 1.853079 1.836924 0.067007 0.197050 1.497158 0.819960 1.744097 0.146565 0.230424 1.433334 -0.204813 1.617743 0.980573 0.922438 1.591672 1.189863 -0.475553 1.519013 0.444193 0.115736 0.335162 1.366663 0.159693 1.179451 1.014284 0.499069 1.277979 0.703604 1.395819 -0.001375 0.960082 1.169341 1.286842 1.914653 1.400883 1.411197 1.485106 -0.463047 0.123686 0.490434 -0.038286 1.041577 -0.101572 -0.066962 1.662556 1.642111)
+ 9.324023 (fv 0.000000 0.720070 1.146170 1.623229 0.919914 1.475051 1.669418 0.417706 1.222880 1.077800 0.636671 0.109954 0.709268 0.401961 1.342317 0.470950 1.038199 -0.014165 -0.223115 1.401527 0.255061 -0.053613 1.038430 1.524899 0.900064 0.540757 0.958685 1.268571 0.665381 1.798791 1.658869 0.625852 0.519615 0.589311 -0.003435 1.345809 -0.056260 0.616788 0.290786 1.478184 0.854964 0.750706 1.853143 1.837616 0.068009 0.196260 1.496079 0.820255 1.744388 0.146057 0.230788 1.434358 -0.205448 1.616936 0.981163 0.921532 1.591565 1.188825 -0.476209 1.518808 0.443241 0.115647 0.334751 1.367563 0.160132 1.179927 1.012776 0.498582 1.276116 0.704338 1.396987 -0.001804 0.959954 1.167324 1.287070 1.914346 1.400505 1.413492 1.484414 -0.463663 0.122173 0.488918 -0.038072 1.041389 -0.101511 -0.067115 1.661217 1.643428)
)
;;; 89 odd -------------------------------------------------------------------------------- ; 9.4340
-#(89 13.0 #(0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 1 1 1 0)
- 12.521632157997 #(0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 1 1 1 0)
- 12.4725522995 #(0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0)
- 12.362 #(0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0)
+(vector 89 12.362 (fv 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0)
- 9.346993 #(0.000000 0.047585 0.764599 0.137682 0.484804 0.759080 0.332378 1.221252 0.134153 0.762504 0.615753 -0.054836 0.470556 1.548916 1.042542 0.304552 0.280707 1.178668 1.496208 1.306490 1.253708 1.214516 -0.188103 1.642657 1.456760 1.199499 1.160185 0.516982 1.260479 1.450226 0.156023 1.423835 0.525669 0.557475 0.212559 1.877421 0.927137 -0.030523 0.422540 1.205943 0.690152 1.788982 1.067020 0.003249 0.897582 1.065856 1.434364 0.575958 -0.149891 1.287577 1.126084 1.260100 1.431607 0.305611 0.342884 0.824341 1.068800 1.722601 1.669455 0.910433 1.312671 0.346214 0.613932 0.305954 1.059428 1.497114 -0.733930 1.276911 0.627704 1.183458 -0.275907 0.360819 0.535785 -0.102344 0.125423 1.197210 0.779130 1.945441 1.305629 0.923359 0.921117 0.869554 1.104160 1.606577 0.867705 -0.118107 0.317277 -0.192649 0.432716)
+ 9.331615 (fv 0.000000 0.049094 0.763150 0.136548 0.483778 0.759076 0.333224 1.220929 0.134557 0.764345 0.615745 -0.054859 0.470862 1.549452 1.042755 0.304443 0.281140 1.178803 1.496311 1.304814 1.254180 1.214938 -0.188361 1.642263 1.456263 1.200682 1.159330 0.518402 1.259168 1.450349 0.156876 1.423052 0.526144 0.557187 0.211944 1.876505 0.927439 -0.029530 0.421763 1.206664 0.690297 1.789526 1.067082 0.003086 0.897179 1.065326 1.434687 0.576391 -0.150316 1.287422 1.126966 1.259277 1.431443 0.305104 0.343134 0.824875 1.068860 1.722713 1.668311 0.909968 1.314221 0.346498 0.614998 0.306500 1.059400 1.495807 -0.733779 1.277563 0.627585 1.184462 -0.276841 0.360604 0.535684 -0.101891 0.124422 1.197248 0.778353 1.945787 1.307086 0.922575 0.921600 0.870062 1.105219 1.606237 0.868032 -0.120196 0.316193 -0.191814 0.432808)
)
;;; 90 odd -------------------------------------------------------------------------------- ; 9.4868
-#(90 13.064256668091 #(0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 0 1 0 1 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 1)
- 12.44910044225 #(0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 1 0 1)
- 12.309 #(0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 0 1 0 0 0 1)
+(vector 90 12.309 (fv 0 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 0 1 0 0 0 1)
- 9.436701 #(0.000000 0.773505 -0.033658 0.815796 0.818047 -0.047651 -0.024829 1.145564 1.125661 -0.088150 0.982163 1.911391 0.885732 -0.170023 0.479326 0.410423 1.014184 0.169489 0.765492 0.759138 1.290607 0.618930 -0.228480 1.549938 0.757340 0.279915 1.553144 0.673478 0.162474 0.690471 0.847848 1.563513 1.023103 1.145484 1.064484 0.943489 -0.316594 0.816404 1.430496 0.223533 0.861391 0.935491 0.765542 0.942775 1.888457 1.615353 1.641335 1.139822 1.699804 1.517710 1.002521 0.700030 0.892182 1.412159 1.482920 0.373837 0.488466 0.408565 0.664845 0.727776 0.134831 1.017103 1.427009 0.114981 0.459175 0.986270 0.828021 0.031029 1.115807 0.182438 0.074555 0.121528 1.385616 1.496385 1.812576 0.488763 0.252650 1.880329 1.059682 0.152601 0.760106 0.237947 1.396326 1.492612 0.744375 1.034715 1.062077 0.485045 0.510759 -0.305293)
+ 9.421684 (fv 0.000000 0.773463 -0.034237 0.815187 0.818292 -0.048506 -0.025177 1.145716 1.124687 -0.087471 0.982715 1.911529 0.885016 -0.169554 0.478422 0.410159 1.012688 0.169228 0.764485 0.758910 1.289872 0.618276 -0.229660 1.549110 0.758331 0.279930 1.553579 0.672439 0.162166 0.690601 0.847281 1.562839 1.023152 1.146052 1.063766 0.943600 -0.316637 0.816595 1.430319 0.223152 0.862408 0.935019 0.764642 0.942440 1.888157 1.614273 1.641359 1.139335 1.700104 1.516977 1.001915 0.698936 0.890613 1.412580 1.482707 0.374132 0.486389 0.409585 0.664613 0.728056 0.135717 1.017586 1.427256 0.114262 0.459920 0.985474 0.828118 0.029864 1.115880 0.182529 0.074455 0.121011 1.384155 1.498024 1.812648 0.488592 0.254186 1.880026 1.059948 0.152702 0.760476 0.236696 1.396118 1.492214 0.743805 1.035917 1.060796 0.484826 0.509085 -0.305704)
)
;;; 91 odd -------------------------------------------------------------------------------- ; 9.5394
-#(91 13.107619285583 #(0 0 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0)
- 12.7095674403 #(0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0)
- 12.351367950439 #(0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0)
+(vector 91 12.351367950439 (fv 0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0)
- 9.472474 #(0.000000 0.103322 0.965245 0.946555 1.775784 -0.123525 1.033177 0.167729 0.730365 0.272347 0.777958 0.023561 0.032735 0.985295 1.058644 0.146211 1.327009 1.317285 0.064755 1.737791 0.743574 0.114198 -0.008785 0.234234 1.253354 0.596497 1.472628 1.451817 1.654617 1.556635 -0.031448 0.585111 1.189727 1.752923 0.699707 0.272268 1.022684 1.546132 1.000260 0.687962 1.015368 0.833433 -0.085038 1.600726 0.991481 1.337153 1.548205 0.641090 0.463360 1.062244 1.212520 0.321300 0.290948 0.063961 0.566545 0.852825 0.846710 -0.173756 1.396008 1.222223 0.869928 0.709509 0.514844 0.978855 0.740431 1.758817 0.992970 1.422693 0.493803 0.952325 -0.083858 1.856893 1.059758 -0.193001 0.702778 1.143470 1.162209 1.656663 1.357403 0.809606 -0.196696 1.185060 1.693038 1.048013 1.192330 0.597670 1.575503 0.403114 0.284797 0.378568 0.171547)
+ 9.456608 (fv 0.000000 0.103422 0.965610 0.946880 1.775735 -0.122619 1.034051 0.168472 0.730448 0.272671 0.778481 0.021689 0.033093 0.984786 1.059637 0.145824 1.327186 1.317989 0.064861 1.738590 0.743092 0.115729 -0.009073 0.235258 1.253963 0.597261 1.473274 1.451939 1.654969 1.556762 -0.031925 0.584248 1.188923 1.752060 0.699420 0.272619 1.021928 1.546707 1.001394 0.687724 1.015815 0.834084 -0.085438 1.600278 0.991105 1.336531 1.547902 0.640465 0.462581 1.062100 1.213310 0.321259 0.291622 0.063730 0.566090 0.852786 0.847201 -0.174185 1.395263 1.222072 0.870150 0.708746 0.513822 0.978903 0.739358 1.760219 0.991895 1.423353 0.493188 0.952658 -0.084183 1.857020 1.060335 -0.192588 0.702407 1.144217 1.162221 1.656319 1.357097 0.810997 -0.196628 1.185541 1.692605 1.048778 1.191279 0.597890 1.575870 0.403387 0.283378 0.378021 0.172627)
)
;;; 92 odd -------------------------------------------------------------------------------- ; 9.5916630
-#(92 12.42142723142 #(0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1)
- 12.280749613899 #(0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 0 1)
+(vector 92 12.280749613899 (fv 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 0 1)
- 9.568718 #(0.000000 1.218564 1.386158 0.940602 0.501270 1.851759 0.318856 1.708198 0.556580 0.891777 0.675341 0.365869 -0.175693 0.894300 1.540392 0.972741 0.317392 1.923799 0.683481 1.371627 0.199456 1.709929 0.178123 -0.300168 0.694768 0.828120 0.827578 0.518230 1.033094 1.221318 0.472245 1.154435 1.069566 0.054253 0.286032 1.692948 0.724146 -0.009846 1.421981 0.760864 0.422432 1.179826 0.293449 1.282000 0.969461 0.723292 1.587816 1.451124 0.985628 0.576381 0.032366 1.280437 0.636376 0.838089 1.053841 1.608556 0.082827 0.619306 1.664581 -0.071242 0.366808 1.111253 1.462879 0.789880 1.454655 1.060992 1.000225 0.660517 0.542383 1.192162 1.594296 0.899938 1.279245 0.844309 0.855356 -0.118266 0.907539 1.750001 1.597052 1.852247 0.369329 0.535573 0.819111 1.437747 0.504264 0.301728 0.152984 0.507551 0.080633 -0.056402 1.895026 0.601208)
+ 9.552661 (fv 0.000000 1.217977 1.385618 0.939614 0.500483 1.851006 0.319542 1.708679 0.556310 0.891376 0.674923 0.365733 -0.175465 0.892985 1.540146 0.973262 0.317469 1.925159 0.685389 1.371188 0.200154 1.709968 0.177693 -0.300538 0.695154 0.829261 0.826887 0.518213 1.033752 1.220316 0.472703 1.153927 1.069740 0.054639 0.285291 1.692400 0.723359 -0.010143 1.422901 0.759732 0.421539 1.178988 0.292771 1.282542 0.969261 0.723210 1.587532 1.451565 0.985309 0.576854 0.032105 1.279589 0.637040 0.836814 1.053214 1.607968 0.083343 0.618958 1.664826 -0.072056 0.366474 1.110340 1.463534 0.789016 1.455017 1.061490 0.999534 0.659448 0.541265 1.191626 1.594463 0.899514 1.279707 0.844186 0.855539 -0.116804 0.909316 1.750334 1.598414 1.853269 0.368452 0.535158 0.818452 1.438032 0.503813 0.301666 0.154109 0.506999 0.079492 -0.057406 1.894913 0.600742)
)
;;; 93 odd -------------------------------------------------------------------------------- ; 9.6437
-#(93 13.111316272074 #(0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1)
- 13.078753471375 #(0 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 0 0)
- 12.587555885315 #(0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 0 1 1 0 1 0 1 1 1 1)
- 12.403578299298 #(0 1 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1)
+(vector 93 12.403578299298 (fv 0 1 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1)
- 9.670553 #(0.000000 1.235508 1.331414 0.783429 0.056248 -0.079129 0.928858 1.357398 0.870327 1.259552 0.502828 0.897395 0.923117 1.800701 1.613402 1.402170 0.282475 1.136764 1.719422 0.991947 1.498647 0.207900 -0.307547 1.472758 0.608720 1.031787 0.361619 0.410619 0.201280 1.489138 1.578373 -0.273606 -0.134839 0.137834 -0.334133 0.906384 -0.110688 0.516225 0.242774 0.179682 0.018272 0.776650 0.252550 1.725290 1.378157 -0.195855 -0.355380 0.897112 1.905026 0.048615 0.031547 0.675873 -0.180683 0.584792 0.785609 1.296685 0.032549 1.375153 1.690097 0.385906 0.838706 1.179858 1.453066 1.863123 1.096632 1.278322 0.940375 1.719940 0.717668 1.327591 0.077745 -0.052771 0.975174 0.436764 0.296900 0.672226 -0.227460 1.573109 0.305031 0.009358 0.956608 0.973741 1.624500 0.697386 1.296570 1.189507 1.545911 1.681915 0.759872 -0.039115 1.417069 1.253534 0.855398)
+ 9.628761 (fv 0.000000 1.192712 1.317592 0.793671 0.099933 -0.070495 0.916675 1.443504 0.876536 1.333886 0.502339 0.879490 0.963974 1.813405 1.616449 1.406560 0.249623 1.099165 1.684130 0.971324 1.504790 0.210004 -0.334645 1.442259 0.574758 1.021850 0.284510 0.399479 0.184247 1.487488 1.612401 -0.235561 -0.129797 0.178650 -0.371978 0.920412 -0.107159 0.561074 0.178586 0.184745 -0.019738 0.790773 0.250122 1.738768 1.375989 -0.216295 -0.331946 0.885688 1.988915 0.048056 0.095104 0.757409 -0.209034 0.574534 0.777126 1.337323 -0.015675 1.471677 1.723082 0.373584 0.844517 1.228790 1.358490 1.817661 1.097143 1.261125 0.949204 1.719884 0.720744 1.257519 0.078221 -0.091904 0.999562 0.486340 0.282135 0.639284 -0.163690 1.618168 0.349231 0.088441 0.985965 0.932832 1.613134 0.712978 1.300533 1.211114 1.605834 1.719815 0.768198 -0.076989 1.468170 1.231822 0.852206)
)
;;; 94 odd -------------------------------------------------------------------------------- ; 9.6954
-#(94 12.792093608509 #(0 1 1 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1)
- 12.789479876738 #(0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1)
+(vector 94 12.789479876738 (fv 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1)
- 9.678003 #(0.000000 1.589551 0.971217 0.766111 0.768496 0.711353 1.092017 0.351019 1.302594 0.297040 0.485445 0.598680 1.198101 1.746044 0.722403 -0.396798 1.398621 0.439578 0.960848 0.110092 1.178056 -1.743249 0.301964 1.425465 0.084984 -0.026192 0.537642 1.284638 0.182225 0.411297 1.540137 0.226159 -0.423612 0.345451 1.365975 0.346046 0.465728 0.364086 1.177138 1.072690 0.952872 0.776558 0.718129 0.829980 0.968336 0.639936 0.295812 -0.156701 1.323161 0.193881 0.424398 0.333833 0.196188 0.404400 1.170156 0.250262 0.562176 0.899770 0.751909 0.195684 1.579644 1.276933 0.371713 1.347398 0.042072 1.220494 0.517460 1.086817 0.960539 1.908404 0.490834 1.687265 -0.290318 1.470181 0.108997 0.281356 0.764945 1.430380 1.143701 0.132376 1.824911 1.230041 -0.052822 1.490815 1.263501 0.076032 1.206429 0.629720 0.641010 0.938128 -0.083532 1.738941 1.620193 0.747019)
+ 9.653914 (fv 0.000000 1.588712 0.970594 0.765681 0.768893 0.708013 1.088997 0.348116 1.304828 0.302466 0.484457 0.598101 1.195823 1.750495 0.723696 -0.394564 1.399290 0.440079 0.957225 0.110914 1.178680 -1.746723 0.306178 1.424281 0.083938 -0.026412 0.531864 1.282735 0.186630 0.411663 1.537740 0.224065 -0.422374 0.338118 1.366092 0.348038 0.469097 0.358167 1.178154 1.072296 0.953715 0.778556 0.718707 0.831159 0.966980 0.639988 0.294231 -0.156503 1.325326 0.192979 0.424804 0.332961 0.198719 0.405180 1.172779 0.251315 0.565156 0.903572 0.754645 0.195819 1.584153 1.274227 0.370217 1.346701 0.041617 1.218979 0.515044 1.085194 0.964032 1.907141 0.492814 1.684100 -0.290159 1.467461 0.104316 0.280575 0.761449 1.432721 1.137691 0.132533 1.823280 1.230711 -0.052109 1.493267 1.265211 0.071008 1.206644 0.630379 0.639830 0.932228 -0.085525 1.738146 1.623323 0.751204)
)
;;; 95 odd -------------------------------------------------------------------------------- ; 9.7468
-#(95 13.132 #(0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0)
- 12.981590594561 #(0 1 1 0 1 0 1 0 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0)
- 12.858592033386 #(0 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0)
- 12.575266058635 #(0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 0 0)
+(vector 95 12.575266058635 (fv 0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 0 0)
- 9.736955 #(0.000000 1.292994 0.048312 -0.369332 1.659089 1.559702 0.880603 1.136731 1.448430 0.335838 0.984675 1.427113 1.844226 1.226397 0.634906 0.989849 0.331125 0.249272 0.360569 1.195068 0.197706 1.702856 1.070457 0.299261 0.742287 0.166618 0.140689 0.843426 1.379134 1.374123 0.644342 0.228631 0.386255 1.779902 0.890807 1.059556 0.113681 0.569023 1.432670 1.251279 0.833921 1.818261 1.159858 0.868078 0.830243 0.419939 1.732537 1.276221 1.064568 1.463336 0.178256 0.641674 0.715078 1.085195 0.875802 1.641255 -0.092713 0.087333 -0.321383 1.686034 1.002471 -0.167089 1.045998 -0.114652 1.198861 -0.026907 0.886624 1.515752 0.099926 0.111370 1.258489 1.084420 0.252091 0.991499 0.662234 0.905461 0.809217 1.142839 1.354734 1.560662 0.123037 1.444306 1.912420 1.220437 -0.163525 -0.296363 1.393745 0.425110 1.423179 1.199824 0.613457 -0.026131 1.027959 1.052494 0.134779)
+ 9.716924 (fv 0.000000 1.295576 0.051583 -0.370221 1.659103 1.560139 0.883258 1.136184 1.446082 0.336165 0.984827 1.426922 1.840974 1.223315 0.635432 0.990680 0.332450 0.247993 0.361771 1.193162 0.200656 1.699397 1.071493 0.299430 0.743325 0.167398 0.140913 0.844624 1.382714 1.375685 0.647006 0.229451 0.386840 1.780080 0.889230 1.061105 0.116922 0.567648 1.435830 1.255231 0.833620 1.820993 1.158323 0.868650 0.833531 0.419654 1.734245 1.273400 1.062531 1.460253 0.175543 0.639252 0.712611 1.085237 0.872288 1.639660 -0.093743 0.087045 -0.323684 1.687923 1.002234 -0.168363 1.044853 -0.114093 1.195353 -0.026012 0.883764 1.512322 0.102179 0.114077 1.256119 1.084835 0.251990 0.992344 0.663746 0.903707 0.809231 1.141845 1.353235 1.559958 0.119755 1.444404 1.912417 1.220976 -0.164602 -0.295612 1.393445 0.425402 1.426929 1.201811 0.614353 -0.027563 1.025805 1.054465 0.134046)
)
;;; 96 odd -------------------------------------------------------------------------------- ; 9.7980
-#(96 13.232 #(0 1 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0)
- 13.00986051659 #(0 1 0 0 0 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0)
- 12.956554412842 #(0 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 0 0 1 1 0)
- 12.803173065186 #(0 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 1 0)
+(vector 96 12.803173065186 (fv 0 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 1 0)
- 9.782602 #(0.000000 0.435195 1.537819 0.231864 0.103233 0.264099 0.996186 0.091013 0.471628 -0.102058 0.584271 1.903384 0.672129 1.002694 1.283172 0.082486 0.268690 0.435909 0.732818 0.095242 0.806024 -0.067812 0.579522 -0.105280 0.334365 1.262023 1.472191 0.331354 0.588641 0.218116 0.351996 1.351116 1.836043 1.561218 1.208063 0.650425 0.812787 0.138586 1.106986 -0.141386 1.693875 1.777043 0.081822 0.373837 0.451568 -0.069496 0.753677 0.865719 1.797203 0.791712 0.568087 0.646200 1.351015 1.186114 1.789610 0.860510 1.746972 1.212289 0.581218 0.654765 0.962819 1.015600 0.606107 0.148023 0.283772 -0.354804 1.284635 0.474722 0.641464 0.511073 1.460343 0.929644 1.241207 0.225416 0.227730 1.199259 1.808259 -0.003342 0.744394 0.180361 1.364063 -0.373691 1.422279 1.453286 1.392630 1.334725 0.036575 1.547735 0.888100 0.461818 1.742941 0.894781 0.306868 1.812545 0.219972 0.928512)
+ 9.759447 (fv 0.000000 0.435576 1.538976 0.230825 0.102821 0.263319 0.997316 0.091618 0.472323 -0.103132 0.585027 1.906149 0.670612 1.002137 1.281685 0.083578 0.271396 0.433634 0.733402 0.099534 0.807149 -0.070119 0.575530 -0.103613 0.335070 1.262648 1.473382 0.330894 0.589593 0.216256 0.350636 1.350446 1.836442 1.560161 1.205882 0.649393 0.812682 0.141066 1.111869 -0.141497 1.693969 1.777393 0.080165 0.375196 0.449681 -0.067423 0.754077 0.868345 1.797143 0.793576 0.568117 0.646818 1.350309 1.187659 1.791215 0.862642 1.742949 1.213798 0.583814 0.650546 0.965237 1.015772 0.605956 0.144297 0.285298 -0.351085 1.282066 0.474001 0.642725 0.511289 1.457452 0.929763 1.241810 0.227521 0.228779 1.199150 1.811444 -0.006366 0.744946 0.179491 1.361847 -0.378016 1.423650 1.452225 1.393417 1.335482 0.037183 1.548694 0.890495 0.461455 1.744132 0.896894 0.307836 1.812808 0.221251 0.928513)
)
;;; 97 odd -------------------------------------------------------------------------------- ; 9.8489
-#(97 13.340280990563 #(0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0)
- 12.954301727663 #(0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0)
- 12.837450993031 #(0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1)
+(vector 97 12.837450993031 (fv 0 0 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1)
- 9.856329 #(0.000000 0.379635 1.473147 0.135915 -0.139580 1.476327 0.224359 1.269913 1.615232 0.578219 1.661592 0.196706 0.627614 1.027505 0.069670 0.933296 0.704622 -0.303376 0.092027 0.688170 0.309672 0.951172 0.648473 0.817522 0.597441 0.700078 0.257803 0.731701 1.509050 0.131676 -0.163779 1.666402 1.754966 0.416660 1.462357 1.218227 0.221971 0.356371 0.561019 0.622876 1.424872 -0.143840 -0.287633 1.750019 0.298082 1.803077 0.498739 1.837901 -0.064581 -0.182018 1.657730 0.653604 1.575145 1.228072 0.786640 1.897004 1.694853 1.072096 0.095100 0.067694 0.376144 0.773748 1.099082 0.009001 0.223288 1.724768 0.804447 0.011393 0.688619 0.510640 0.472286 0.941854 1.717749 1.587062 0.920862 0.790699 0.179367 -0.134281 1.215291 1.816025 0.680246 0.281288 1.333151 1.750119 1.536197 0.882271 0.415591 0.835827 -0.027448 0.657024 0.681838 1.073342 1.521920 0.824894 1.105254 0.673272 -0.103060)
+ 9.832277 (fv 0.000000 0.379259 1.470054 0.135241 -0.137798 1.476571 0.223942 1.269139 1.617761 0.578479 1.659896 0.192321 0.628723 1.030748 0.068332 0.935772 0.702035 -0.308246 0.093619 0.687832 0.312122 0.952725 0.646784 0.815901 0.600402 0.700649 0.257079 0.728929 1.512814 0.133748 -0.161439 1.667289 1.756964 0.419090 1.460039 1.221568 0.216587 0.357346 0.560096 0.621329 1.423958 -0.140419 -0.285305 1.752977 0.296245 1.796763 0.502171 1.837539 -0.068388 -0.176521 1.655407 0.652714 1.571976 1.231728 0.781936 1.899698 1.696905 1.070324 0.093931 0.071079 0.376824 0.772939 1.099059 0.004831 0.221806 1.727680 0.800189 0.011067 0.690398 0.512420 0.475317 0.941280 1.720146 1.587206 0.923080 0.792083 0.180477 -0.133205 1.214230 1.814657 0.679279 0.282075 1.334889 1.751170 1.536951 0.882536 0.418450 0.834681 -0.026902 0.654794 0.680161 1.077779 1.525535 0.824205 1.102618 0.673911 -0.106249)
)
;;; 98 odd -------------------------------------------------------------------------------- ; 9.8995
-#(98 13.53905582428 #(0 1 0 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 0 0 1 0)
- 13.128762135265 #(0 1 1 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 0 0 1 0 0 1 0)
- 13.062 #(0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 1 1 0)
- 12.972 #(0 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0)
+(vector 98 12.972 (fv 0 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0)
+
+ 9.918320 (fv 0.000000 1.126272 0.810135 -0.157043 -0.284411 1.014546 1.656515 0.886620 0.589412 -0.165849 0.041656 1.689870 -0.133502 1.386309 0.753684 1.607028 0.455527 0.729530 1.603812 -0.176801 0.980471 1.557823 1.120428 0.608500 -0.040856 1.654422 1.694414 1.546900 1.545046 0.721205 0.133219 1.189224 1.204719 1.195353 1.299299 -0.156627 0.826681 -0.088693 0.692437 1.036020 0.358333 1.488711 1.027717 0.069063 1.141577 0.328360 0.719016 0.851669 0.356065 0.712122 1.039551 1.236061 1.577925 0.317909 -0.158255 0.050224 -0.509790 1.519264 0.203085 -0.063235 0.037529 0.962155 1.059331 0.698574 0.810336 0.743673 1.683751 0.457113 0.419520 0.759860 1.462788 1.502247 0.636526 0.416346 0.963144 1.154048 0.694553 0.104918 -0.349860 1.108892 1.631062 0.589884 1.392769 1.258082 0.568391 0.753256 1.211016 0.009043 0.817095 0.265385 1.455548 1.585953 1.547698 1.855964 1.737942 0.229735 1.055700 1.696455)
- 9.946856 #(0.000000 1.129480 0.809194 -0.148383 -0.282968 1.012485 1.655051 0.884773 0.590929 -0.174496 0.041696 1.691491 -0.136809 1.384021 0.751594 1.604893 0.466671 0.727003 1.603538 -0.178306 0.985633 1.558230 1.127661 0.616550 -0.037693 1.655248 1.690921 1.546083 1.548795 0.724045 0.136371 1.195805 1.202356 1.196950 1.300168 -0.150395 0.828531 -0.092572 0.689445 1.045577 0.362754 1.481987 1.029407 0.075276 1.144207 0.329667 0.720038 0.847967 0.358834 0.703124 1.044227 1.235727 1.575988 0.327431 -0.161368 0.055937 -0.504677 1.520859 0.200240 -0.057909 0.039756 0.954400 1.053380 0.698818 0.809552 0.741676 1.695582 0.447635 0.418734 0.760130 1.449182 1.500376 0.635715 0.420581 0.969678 1.159177 0.696775 0.113302 -0.354044 1.105962 1.628543 0.598247 1.396724 1.256265 0.568684 0.739013 1.211555 0.009153 0.818332 0.271098 1.454469 1.585380 1.543089 1.852553 1.741719 0.226245 1.056110 1.697365)
+ ;; pp:
+ 9.852643 (fv 0.000000 0.515219 1.262972 1.697020 0.335436 0.889905 1.519089 0.044736 0.650497 1.270750 -0.178917 0.674989 1.450432 0.254900 1.097572 -0.107043 0.651195 1.335130 0.272796 1.297874 0.224159 0.962708 0.053062 1.193382 0.101327 0.836439 -0.105754 1.215012 0.128574 1.109391 0.442046 1.523411 0.553345 1.725474 0.541762 -0.127793 1.417975 0.631717 1.576620 0.767281 0.059112 1.609436 1.033347 0.556109 1.727081 1.010442 0.702568 -0.141336 1.349027 0.669399 0.583528 0.147350 1.497924 0.934945 0.610721 0.101044 -0.019997 1.772284 1.165297 0.883648 0.540756 0.695909 0.051843 0.036770 1.823953 1.940217 1.253231 1.381574 1.135330 0.962885 1.084109 1.188033 1.135270 0.827723 0.748628 1.126276 1.272339 0.770370 1.246808 1.223016 1.570254 1.399310 1.628085 1.829166 -0.154940 0.353005 0.721669 0.726808 0.892330 1.197955 1.533013 0.212675 0.669097 1.140181 1.156217 1.790457 0.422623 0.510791)
)
;;; 99 odd -------------------------------------------------------------------------------- ; 9.9499
-#(99 13.792359352112 #(0 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1)
- 13.577017376954 #(0 0 0 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1)
- 13.046126365662 #(0 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 0 0 1)
- 13.000000000002 #(0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0)
+(vector 99 13.000000000002 (fv 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0)
- 10.006125 #(0.000000 0.528692 0.116438 1.473042 1.205530 0.950201 1.046307 0.074640 1.003961 0.576938 1.414373 1.603956 1.438918 1.542751 1.904103 0.458527 0.413197 1.248734 0.979010 0.067810 0.745438 -0.757533 1.060547 1.414361 1.130098 -0.046662 1.335316 1.085655 0.342368 1.485309 1.799207 0.122005 0.710300 -0.198619 0.637520 1.280402 0.034741 1.163492 0.966039 -0.137037 1.621186 0.571924 0.615555 1.393968 1.558038 0.489054 0.945921 0.505869 0.598584 0.170059 0.772163 -0.255093 0.366982 1.141998 0.179062 1.354097 0.342786 -0.158023 0.678610 0.581738 1.070419 0.961674 1.142515 0.889394 0.328365 0.880190 0.497389 0.365854 0.760872 0.754794 -0.158387 -0.323446 1.751433 1.121980 0.519074 -0.140936 0.062819 1.156952 0.541009 0.000751 0.420966 0.192163 1.452456 -0.328733 1.059089 1.643008 0.158938 0.465071 1.084045 1.120572 0.992235 0.686420 1.293352 0.548093 1.294608 -0.138818 0.986417 1.098871 1.116957)
+ 9.927757 (fv 0.000000 0.612324 0.079141 1.434202 1.000660 0.891242 1.012263 -0.017562 0.996629 0.611063 1.321217 1.621637 1.504948 1.624898 0.001412 0.412734 0.326019 1.366721 1.072960 0.116515 0.715979 -0.740444 1.161301 1.297736 1.041757 0.027020 1.458453 1.107119 0.363908 1.415543 1.763457 0.255777 0.686434 -0.085735 0.651473 1.217063 -0.047283 1.151992 0.790695 -0.152103 1.647917 0.508714 0.628648 1.408143 1.292464 0.474000 1.003650 0.520847 0.629804 0.218082 0.785490 -0.232867 0.391411 1.172299 0.273141 1.313231 0.427739 0.013232 0.516032 0.610598 1.282766 1.029342 0.967918 1.073490 0.454858 0.915907 0.522595 0.274119 0.827376 0.861574 -0.158909 -0.432703 1.871750 1.122982 0.647824 -0.195710 0.262542 1.053968 0.565099 0.024117 0.401586 0.264805 1.587960 -0.370184 1.152346 1.774247 0.242656 0.316777 1.195086 1.067518 1.112347 0.688842 1.446613 0.608318 1.321142 -0.167020 0.907334 1.022140 1.062351)
)
;;; 100 odd -------------------------------------------------------------------------------- ; 10
-#(100 13.916926312979 #(0 1 1 1 0 1 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 1 0)
- 13.24493912033 #(0 1 1 1 0 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0)
- 13.117680368039 #(0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0)
+(vector 100 13.117680368039 (fv 0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0)
- 10.000652 #(0.000000 1.000074 1.084813 0.662031 0.563213 1.560436 0.371230 1.092167 1.749588 0.630113 1.329101 0.684716 -0.462172 0.513673 0.836535 1.091106 0.188784 -0.041123 1.316313 -0.063377 0.875337 1.329606 0.224744 -0.049224 0.086749 1.254944 0.861728 0.535568 1.923634 0.928482 0.895132 1.155028 0.407006 0.075849 1.532400 -0.099767 1.563086 1.727644 -0.180747 -0.007264 0.829571 1.372319 0.801058 1.732449 0.216283 0.765221 0.293669 0.068834 0.400840 -0.062022 0.762677 0.293057 0.666668 1.162953 0.227955 0.937137 0.514011 -0.233239 1.936466 0.248638 0.481214 0.380834 0.944481 0.097613 0.833233 0.596836 0.029083 1.213595 0.622348 -0.032660 1.136026 1.604457 0.355046 0.481611 1.167408 1.577260 1.454901 0.256171 0.486229 0.286059 0.227241 0.219245 1.309996 1.750799 -0.142558 1.025161 0.045291 0.429442 -0.058546 1.362172 0.387490 1.503947 1.254840 1.153044 0.280507 -0.379156 0.640786 0.956168 1.108107 1.100244)
- 10.000316 #(0.000000 0.998906 1.085444 0.660341 0.563163 1.561468 0.376519 1.094494 1.751072 0.633745 1.331156 0.688057 -0.457207 0.516519 0.840266 1.090207 0.190011 -0.039325 1.319972 -0.065319 0.869634 1.333060 0.222864 -0.046488 0.087211 1.246653 0.861397 0.526616 1.917374 0.934078 0.898294 1.155308 0.409319 0.078390 1.529415 -0.098511 1.566989 1.726658 -0.185457 -0.006331 0.829719 1.375070 0.800759 1.736663 0.221118 0.763630 0.296247 0.066705 0.400415 -0.063414 0.761038 0.288037 0.668011 1.162085 0.232288 0.937974 0.512005 -0.228913 1.938091 0.251799 0.480920 0.380430 0.944347 0.097386 0.835365 0.598000 0.024579 1.214680 0.617171 -0.032006 1.141112 1.606182 0.358614 0.481315 1.175719 1.578931 1.448468 0.254959 0.486792 0.285955 0.229267 0.218495 1.309098 1.748840 -0.141445 1.022855 0.042941 0.428921 -0.062954 1.366044 0.387519 1.499580 1.252047 1.157664 0.281619 -0.380891 0.637260 0.954065 1.108512 1.101890)
+ 9.967820 (fv 0.000000 1.016486 1.075466 0.675161 0.574401 1.527303 0.369311 1.093743 1.758162 0.649535 1.329616 0.683289 -0.464743 0.488528 0.846167 1.093202 0.188464 -0.009742 1.328398 -0.092736 0.866724 1.306141 0.236206 -0.048398 0.065984 1.250377 0.880265 0.529903 1.908284 0.909975 0.870318 1.170730 0.401807 0.051428 1.546047 -0.084383 1.553645 1.723234 -0.192262 -0.005451 0.846559 1.396413 0.793410 1.734419 0.268618 0.782362 0.300041 0.085963 0.406528 -0.058412 0.759019 0.311738 0.688186 1.163736 0.207596 0.957152 0.518038 -0.238894 1.966069 0.254028 0.497859 0.406362 0.948142 0.108565 0.809242 0.618274 0.008503 1.224166 0.619792 -0.063172 1.170177 1.631095 0.360399 0.496092 1.173684 1.571576 1.461266 0.250954 0.485376 0.293914 0.241987 0.266855 1.299097 1.747740 -0.157940 1.025403 0.055859 0.443647 -0.030039 1.366811 0.369467 1.523632 1.262832 1.148761 0.265795 -0.397124 0.678718 0.978216 1.111928 1.121642)
)
;;; 101 odd -------------------------------------------------------------------------------- ; 10.0499
-#(101 13.462674500314 #(0 1 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 0 0 0 0 1 1 1)
- 13.28250751675 #(0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1)
+(vector 101 13.28250751675 (fv 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1)
- 9.985099 #(0.000000 -0.072627 1.535521 -0.101847 0.950897 0.663252 1.375709 0.390384 1.430461 1.384292 0.702118 0.190696 0.164623 0.880313 1.054375 0.381579 1.515055 1.203592 0.503942 0.921663 0.390915 0.949061 1.113873 0.554967 1.896911 1.768183 1.765553 1.550914 0.401415 0.254973 0.395217 1.626419 0.832367 0.745106 0.451082 -0.082581 0.892195 1.874747 1.780790 -0.418618 1.635795 -0.023847 0.902053 -0.412136 1.924156 0.195136 -0.086886 0.652704 1.188561 0.342199 0.582997 1.814716 1.208918 1.789413 0.551249 0.992722 0.259236 0.282908 1.010342 1.612902 1.372768 1.012575 0.839258 1.333554 1.263810 0.326001 0.342496 -0.075811 -0.460356 0.487733 1.512656 1.808194 1.012232 -0.304359 1.576224 0.026261 0.002529 1.291458 1.659163 1.439279 0.653889 1.151439 0.651564 1.475574 -0.055097 -0.024371 0.728138 0.455477 1.496913 0.764086 0.286904 1.427124 0.078348 0.749738 1.836073 1.338623 -0.186453 1.925511 -0.153296 0.400406 1.448704)
+ 9.964634 (fv 0.000000 -0.073111 1.535769 -0.102555 0.949824 0.661791 1.376397 0.389320 1.429271 1.382915 0.702074 0.190023 0.165010 0.880936 1.053717 0.381858 1.515003 1.204543 0.504035 0.920455 0.391206 0.949414 1.113429 0.554900 1.897469 1.768789 1.766679 1.550589 0.402518 0.254763 0.394916 1.625563 0.833640 0.744524 0.452145 -0.082936 0.892795 1.873582 1.781184 -0.418454 1.636196 -0.022737 0.903335 -0.412208 1.924024 0.194797 -0.087158 0.651748 1.188278 0.341571 0.583987 1.814760 1.207941 1.789448 0.551284 0.991618 0.259118 0.282624 1.011184 1.611901 1.372798 1.012968 0.839711 1.331909 1.264042 0.325794 0.343316 -0.075857 -0.460634 0.488689 1.512646 1.806638 1.012723 -0.303497 1.575625 0.027198 0.002241 1.290806 1.657896 1.438044 0.654010 1.150362 0.652919 1.476118 -0.053999 -0.024155 0.726437 0.454484 1.497660 0.765182 0.287065 1.425963 0.079052 0.750136 1.836142 1.337567 -0.185862 1.924720 -0.153672 0.400041 1.450120)
)
;;; 102 odd -------------------------------------------------------------------------------- ; 10.0995
-#(102 13.701085090637 #(0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0)
- 13.159336831147 #(0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0)
+(vector 102 13.159336831147 (fv 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0)
- 10.064853 #(0.000000 -0.277361 0.173336 0.080640 1.768112 1.608670 0.603223 0.557164 0.376939 1.097594 0.557893 1.658067 0.679922 0.436381 1.704137 0.881931 0.676987 1.227078 -0.017803 0.220616 -0.211631 1.306808 0.689838 0.655896 0.992875 0.615591 1.764174 1.131578 0.120157 0.184560 1.035150 1.439437 1.372165 1.417714 0.504644 0.310322 0.194741 1.343993 1.645395 0.393298 0.050577 0.686588 0.243752 0.754029 0.964966 1.162442 1.767101 0.912204 1.540320 0.989425 0.153881 1.180537 0.494665 0.826648 -0.195378 1.268325 1.482747 -0.154869 1.003446 0.058072 1.563074 1.605366 0.910437 1.017064 0.439844 -0.174248 0.279525 0.398989 1.341690 -0.098032 1.086786 1.051289 0.556894 0.751769 -0.399613 0.095142 0.689169 0.552411 0.778412 0.059228 0.427383 0.270033 0.480799 0.192968 0.563967 0.687083 0.127404 1.864160 -0.045407 1.018115 1.779101 -0.005589 0.882104 1.021111 0.514317 1.481967 0.957685 0.518784 1.187427 -0.017871 1.608648 0.515079)
+ 10.045766 (fv 0.000000 -0.279070 0.173878 0.081403 1.768938 1.607495 0.603256 0.555897 0.375867 1.098499 0.557935 1.658062 0.679353 0.435605 1.704584 0.882188 0.675710 1.226519 -0.017413 0.221732 -0.211376 1.307302 0.689909 0.655783 0.993058 0.615004 1.764502 1.131327 0.119482 0.185094 1.035751 1.439320 1.373211 1.418236 0.503946 0.310742 0.195150 1.345393 1.645648 0.392993 0.050135 0.685592 0.243679 0.754096 0.965418 1.162001 1.767714 0.912263 1.540226 0.989163 0.153496 1.180193 0.495181 0.826820 -0.194339 1.268780 1.482827 -0.154668 1.003093 0.057371 1.563631 1.606126 0.908893 1.017810 0.439667 -0.174146 0.280275 0.399111 1.342959 -0.098826 1.087834 1.050762 0.557805 0.752893 -0.400427 0.095731 0.689016 0.552247 0.778927 0.058727 0.428406 0.269116 0.480708 0.192361 0.563638 0.686642 0.128600 1.864221 -0.045520 1.018032 1.780635 -0.005046 0.881801 1.021244 0.513775 1.482476 0.956890 0.518235 1.186738 -0.018819 1.609204 0.515712)
)
;;; 103 odd -------------------------------------------------------------------------------- ; 10.1489
-#(103 13.551587266363 #(0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1)
- 13.142812158651 #(0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1)
+(vector 103 13.142812158651 (fv 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1)
- 10.129497 #(0.000000 1.367358 0.405204 1.489606 1.297848 1.174523 0.722805 1.119214 0.562281 1.504325 1.426597 0.054801 1.554009 0.367376 0.263730 -0.029265 1.678431 0.352171 1.366942 0.206166 -0.182780 0.842006 0.284165 1.193372 1.755146 1.261188 0.896644 0.187446 0.404130 0.535946 0.046180 0.851283 1.322036 0.927366 0.676280 0.098060 1.569330 0.543049 0.857146 1.852788 0.291578 1.098105 1.160813 -0.047568 1.182033 -0.111780 0.641291 0.487075 1.088304 0.673975 1.804779 0.331391 0.760580 0.503287 0.945386 0.125142 1.094470 1.173116 1.305944 -0.083575 1.063227 -0.229525 1.340552 1.010728 0.464670 0.561769 0.422900 0.862643 1.822875 1.617201 -0.234029 1.269477 1.411586 0.287983 -0.512541 1.287024 0.552775 0.692922 1.552813 1.230144 1.841024 0.904336 0.867459 0.231489 1.454794 0.969433 1.067875 0.135489 0.918657 0.814569 0.472175 1.431512 0.214221 0.664572 0.772881 0.947513 1.152762 0.551757 0.890049 1.133433 0.035227 -0.040777 1.756156)
+ 10.102476 (fv 0.000000 1.369258 0.406430 1.487363 1.300312 1.174178 0.725871 1.118946 0.567934 1.507074 1.421940 0.060397 1.553534 0.366960 0.264364 -0.027869 1.681923 0.350717 1.364154 0.204515 -0.180262 0.842363 0.287472 1.198426 1.756374 1.259211 0.898266 0.187309 0.401610 0.535873 0.048012 0.851696 1.323060 0.925186 0.678890 0.097118 1.570744 0.545725 0.858166 1.853728 0.291531 1.096726 1.166849 -0.045402 1.179837 -0.111020 0.643454 0.486562 1.084325 0.673411 1.808268 0.331853 0.761303 0.506929 0.948787 0.125433 1.093138 1.172704 1.300823 -0.087765 1.061422 -0.231489 1.345595 1.007175 0.463207 0.567128 0.417701 0.867458 1.827132 1.618306 -0.235698 1.268358 1.413906 0.291274 -0.510359 1.287040 0.555326 0.694591 1.555786 1.225983 1.844314 0.908000 0.867329 0.232081 1.454227 0.972019 1.069240 0.133107 0.915878 0.821231 0.471133 1.434428 0.215881 0.667043 0.772841 0.944850 1.153588 0.551253 0.882554 1.134378 0.032596 -0.042233 1.758816)
)
;;; 104 odd -------------------------------------------------------------------------------- ; 10.1980
-#(104 13.622 #(0 0 0 1 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
- 13.301904678345 #(0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
- 13.214084551284 #(0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
- 13.176067352295 #(0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
+(vector 104 13.176067352295 (fv 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 1 0)
- 10.197682 #(0.000000 0.863926 -0.114078 0.950350 1.175661 1.344075 0.082822 1.782733 0.040185 -0.272879 0.488829 1.366289 1.584630 0.309170 1.040083 0.303327 0.637955 1.604166 -0.079944 1.173716 0.017490 0.876954 0.738526 1.016034 -0.392102 0.681834 1.681442 1.019933 0.455266 1.273665 0.664281 1.377717 0.930414 0.631312 0.877955 1.106795 0.851400 1.099039 0.942704 1.634875 -0.086357 1.209696 0.911584 1.024486 0.384784 0.941185 0.987993 0.180059 0.218775 1.149436 1.623594 0.097566 0.985300 1.827115 0.936872 0.311634 -0.017250 0.172601 -0.020533 0.758560 0.024288 0.668236 0.816260 1.635938 1.402576 1.158954 1.357995 1.543531 1.256099 1.011759 0.855357 0.924713 0.015327 0.369748 -0.087711 1.051011 -0.035604 0.659745 -0.092901 -0.158809 1.263301 0.329207 0.452828 1.158869 1.298152 0.127788 1.629497 0.811566 0.922803 1.387886 0.700299 0.322667 1.339628 1.512632 1.485824 1.947335 0.780441 0.352854 0.614338 1.433724 1.462625 0.827646 0.672737 -0.326275)
+ 10.168550 (fv 0.000000 0.863337 -0.113966 0.952335 1.179324 1.344589 0.086001 1.784568 0.040939 -0.278342 0.492392 1.373041 1.589416 0.305140 1.040154 0.306852 0.639739 1.605433 -0.082316 1.171614 0.018705 0.877480 0.742834 1.013469 -0.394587 0.679538 1.685340 1.015860 0.451982 1.273683 0.656961 1.380347 0.930414 0.629931 0.875751 1.106458 0.854029 1.097615 0.942886 1.634232 -0.087153 1.214976 0.912099 1.026106 0.377766 0.938615 0.980356 0.179306 0.223817 1.145177 1.622990 0.100820 0.989970 1.826246 0.934306 0.310115 -0.012658 0.179983 -0.026220 0.755024 0.027968 0.662514 0.819461 1.633236 1.403644 1.156857 1.356308 1.542286 1.253871 1.012715 0.852908 0.924116 0.022097 0.368327 -0.090612 1.052696 -0.034185 0.655336 -0.097080 -0.157717 1.261805 0.337757 0.457703 1.158886 1.296591 0.128958 1.630443 0.809473 0.920747 1.393423 0.696288 0.328360 1.336354 1.510499 1.486152 1.947494 0.779240 0.349685 0.612445 1.433252 1.461547 0.826387 0.679858 -0.337976)
)
;;; 105 odd -------------------------------------------------------------------------------- ; 10.2470
-#(105 14.179738044739 #(0 1 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 0)
- 13.491228801467 #(0 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0)
+(vector 105 13.491228801467 (fv 0 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0)
- 10.131921 #(0.000000 0.048605 1.344826 1.092185 0.666732 0.967945 0.647984 0.707885 1.513963 1.538273 0.526788 1.493491 1.624777 0.708197 0.594329 0.874756 1.542759 1.854469 0.426540 0.027665 1.615962 1.505954 0.465284 1.158057 -0.404759 1.664368 0.782514 1.352808 -0.234210 1.359941 1.390172 0.564253 0.900743 -0.306288 1.197384 1.370119 1.005184 0.397901 0.628789 1.627527 0.835797 1.060650 1.445371 1.380126 1.601025 0.271413 1.328786 -0.187577 -0.215828 0.274442 1.675122 1.482700 0.685334 -0.075072 1.171124 0.020557 -0.282890 0.805419 0.169656 0.520447 1.239522 0.911621 -0.107214 0.771426 1.222270 1.259879 0.242914 1.416539 -0.087126 1.794377 1.019540 0.208821 0.637550 0.680848 1.216765 -0.252050 1.342253 0.794875 0.531145 1.152521 0.964454 0.767746 0.004307 0.486981 1.527626 0.184593 1.581109 0.376023 0.269962 0.979099 1.678604 1.757472 1.492739 0.386600 1.219449 0.329925 1.293596 -0.099606 0.401377 0.164676 0.338496 0.226066 0.417416 -0.115454 1.295180)
+ 10.115828 (fv 0.000000 0.049019 1.344835 1.091641 0.665700 0.968893 0.648602 0.707898 1.514354 1.538919 0.526334 1.493761 1.624995 0.707437 0.593803 0.874212 1.543010 1.853745 0.426397 0.026573 1.615940 1.506593 0.465693 1.159200 -0.404908 1.664358 0.782410 1.352302 -0.234654 1.360029 1.390064 0.562127 0.900595 -0.305834 1.198378 1.369945 1.005775 0.397773 0.628843 1.626964 0.837449 1.061154 1.446306 1.380391 1.599960 0.270806 1.328543 -0.187842 -0.215850 0.275407 1.674813 1.481684 0.685411 -0.076514 1.172112 0.021028 -0.282040 0.805083 0.169438 0.519532 1.238467 0.912197 -0.108203 0.770912 1.223603 1.260598 0.243317 1.416653 -0.085803 1.793597 1.018898 0.209596 0.637018 0.680644 1.218601 -0.251927 1.342315 0.794662 0.530948 1.151958 0.965018 0.768542 0.003792 0.487969 1.528116 0.185132 1.582165 0.376426 0.269883 0.979543 1.678175 1.757906 1.492507 0.386900 1.219606 0.328787 1.292795 -0.100060 0.401454 0.164930 0.339091 0.226350 0.418706 -0.115549 1.296351)
)
;;; 106 odd -------------------------------------------------------------------------------- ; 10.2956
-#(106 13.492804348903 #(0 1 1 1 1 0 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 0 1 0 0 1)
- 13.091135978699 #(0 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0)
+(vector 106 13.091135978699 (fv 0 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0)
- 10.219870 #(0.000000 0.831457 1.059866 0.596513 0.203572 1.202836 1.655535 1.163517 0.731459 1.050758 -0.085058 1.049207 0.670016 0.708207 1.587517 0.104255 0.094867 1.175642 1.676862 0.458791 0.488660 1.294364 -0.329374 1.742839 0.960395 0.228899 1.222887 1.137549 1.166359 0.274224 -0.217656 1.771342 -0.105250 0.980029 0.425296 1.122536 1.737732 1.407880 0.325017 1.348540 0.309801 0.275863 0.394277 1.220311 0.354324 0.866523 0.344304 0.655123 0.909708 0.941558 0.976683 0.143596 0.685321 0.787407 -0.061104 -0.012442 1.689647 -0.088597 1.428962 -0.052752 1.783690 0.110295 0.959667 1.179961 0.324377 1.230833 1.617161 1.768536 1.319730 1.676888 1.562727 0.226036 0.576547 0.774262 -0.022873 1.783508 1.405871 0.334142 1.611569 1.352827 1.311396 0.372721 1.917732 1.162942 0.910364 1.738148 1.152888 -0.034582 0.059664 1.404949 -0.250907 0.992009 1.479488 0.003613 1.833705 0.616189 0.073654 1.354318 1.163385 0.193109 0.856577 0.093284 0.262730 1.393835 0.203290 1.603299)
+ 10.198335 (fv 0.000000 0.831679 1.059524 0.595983 0.203261 1.202829 1.655547 1.163399 0.731912 1.050991 -0.085268 1.049064 0.669107 0.707558 1.587356 0.103456 0.095032 1.177165 1.677580 0.458849 0.488238 1.294418 -0.328225 1.742764 0.960376 0.232688 1.221102 1.139466 1.165521 0.274312 -0.217213 1.769983 -0.106435 0.980799 0.424668 1.120797 1.738923 1.408831 0.326124 1.349134 0.307375 0.275240 0.392410 1.221176 0.352509 0.866366 0.344959 0.656333 0.909394 0.940268 0.976614 0.141881 0.684412 0.786921 -0.062121 -0.010568 1.690036 -0.088688 1.427313 -0.052874 1.785355 0.109989 0.958795 1.179624 0.324837 1.229886 1.616903 1.768092 1.318950 1.675999 1.563712 0.225381 0.575251 0.774252 -0.022742 1.783220 1.405786 0.332796 1.613495 1.352845 1.308309 0.373980 1.918112 1.162561 0.910064 1.737277 1.152808 -0.033675 0.058425 1.406045 -0.253836 0.991335 1.479963 0.005130 1.832773 0.614974 0.073456 1.352269 1.161897 0.192184 0.857686 0.091488 0.263380 1.392944 0.202339 1.603064)
)
;;; 107 odd -------------------------------------------------------------------------------- ; 10.3441
-#(107 13.864 #(0 1 0 1 1 1 0 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 1 1)
- 13.762476921082 #(0 0 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1)
- 13.722554538648 #(0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1)
- 13.537808159641 #(0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 0 1)
+(vector 107 13.537808159641 (fv 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 0 1)
- 10.326453 #(0.000000 1.450782 1.657076 0.102352 0.785633 1.255499 -0.021765 1.748527 0.348101 1.599769 1.551974 0.116377 1.641066 1.666286 0.228729 1.700453 0.203714 1.049380 -0.309714 0.171364 0.851458 0.164954 1.473236 0.766218 0.799382 0.361635 1.295000 0.490741 -0.037582 -0.032010 0.340540 1.592845 0.672635 0.112221 -0.108171 1.020126 0.906650 0.722229 0.347381 1.024418 -0.168464 0.887524 0.078758 1.762855 1.318322 1.595140 1.628151 0.009962 1.512005 0.470821 0.667521 1.173503 0.339514 0.139685 0.338124 0.439387 1.263007 -0.191001 0.398660 0.258796 0.102123 1.040189 0.820594 1.958522 1.114473 0.701358 1.569491 -0.334665 0.782160 1.201725 0.707758 -0.340087 0.477773 0.496236 -0.059236 0.691118 0.974198 0.383403 1.782564 -0.026617 1.852983 0.370115 0.296854 0.539467 0.115678 0.898127 1.814987 1.010183 1.610777 -0.211682 -0.142922 0.735210 0.879216 0.127341 1.843580 -0.068041 1.634446 0.224774 1.204568 0.868390 0.061760 0.691776 1.780360 1.815803 1.574876 1.074542 1.557957)
+ 10.295953 (fv 0.000000 1.453513 1.655211 0.102988 0.785431 1.249929 -0.025066 1.750838 0.347673 1.604380 1.551092 0.115495 1.639861 1.667898 0.228709 1.701673 0.201321 1.045139 -0.312647 0.175688 0.855996 0.160415 1.472612 0.763114 0.800624 0.361142 1.295288 0.490786 -0.039842 -0.032740 0.339591 1.592008 0.669279 0.117545 -0.109117 1.018536 0.901071 0.716433 0.346971 1.020475 -0.173945 0.889314 0.077058 1.765220 1.318363 1.591641 1.626283 0.012132 1.508938 0.471426 0.670071 1.171727 0.339306 0.138717 0.336161 0.439088 1.260263 -0.187548 0.396198 0.258209 0.100455 1.039650 0.818140 1.958400 1.117502 0.697124 1.567939 -0.332396 0.783424 1.205431 0.709006 -0.344647 0.483889 0.499549 -0.063258 0.695169 0.972581 0.387305 1.779513 -0.022586 1.856190 0.369348 0.297097 0.538965 0.115827 0.894957 1.816307 1.006210 1.611567 -0.212466 -0.136556 0.733243 0.881259 0.131239 1.843996 -0.064517 1.632049 0.217595 1.203085 0.867259 0.064249 0.691138 1.782204 1.811114 1.580857 1.070340 1.558270)
)
;;; 108 odd -------------------------------------------------------------------------------- ; 10.3923
-#(108 13.775 #(0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 0 0 0)
- 13.751863479614 #(0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0)
- 13.584542754139 #(0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0)
- 13.472808406168 #(0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0)
+(vector 108 13.472808406168 (fv 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0)
- 10.344255 #(0.000000 1.824520 0.122314 1.360231 0.590726 1.028949 -0.433950 1.040899 -1.272916 0.781192 -0.169762 1.605831 1.009879 1.810948 0.632474 -0.208090 0.463377 1.074598 1.520901 -0.179292 1.523496 0.422067 0.146027 0.899344 -0.453367 0.547841 0.895645 1.660986 0.346634 1.472076 -0.164652 -1.900650 0.407119 0.262102 0.474802 -0.028386 1.801371 1.325510 1.589688 0.345276 0.447486 0.271155 0.831371 1.871319 -0.312822 1.895863 1.025104 0.721910 0.727049 0.337614 0.859667 1.378845 0.848218 0.468638 -0.381991 0.451260 -0.496637 1.102792 1.102360 1.647057 0.310215 -0.456508 0.949531 0.522687 0.921922 0.642937 0.782166 1.182643 0.966499 0.457015 0.499713 1.075329 1.927806 0.159557 0.160006 0.419777 0.925233 0.445241 0.327770 1.459503 0.903300 -0.021037 1.062845 1.176537 1.223478 0.259126 0.622478 1.571341 0.619923 1.977598 1.545679 1.671477 0.421317 1.206148 1.436625 0.183245 0.250467 0.717384 -1.375304 0.498467 0.186698 0.551580 0.272149 1.380684 1.012073 0.307375 1.434191 0.097770)
+ 10.325467 (fv 0.000000 1.823999 0.121670 1.358801 0.589768 1.029967 -0.433790 1.041582 -1.274122 0.780646 -0.169734 1.604597 1.010159 1.810789 0.632723 -0.206688 0.463178 1.073646 1.521165 -0.178712 1.523791 0.423100 0.144424 0.899019 -0.452142 0.547962 0.895764 1.662227 0.346193 1.471302 -0.164671 -1.901696 0.406602 0.262326 0.474119 -0.030228 1.801622 1.325384 1.588387 0.343116 0.445611 0.273212 0.831258 1.871029 -0.312461 1.896993 1.025139 0.721577 0.726171 0.338346 0.861017 1.378901 0.847116 0.469202 -0.383235 0.452023 -0.496006 1.102062 1.102044 1.646809 0.311243 -0.456688 0.949926 0.520943 0.921326 0.643117 0.781598 1.182150 0.966506 0.456713 0.498859 1.075971 1.927079 0.160322 0.159648 0.419881 0.925743 0.446322 0.326978 1.459788 0.903977 -0.021458 1.063237 1.175806 1.223175 0.258595 0.623246 1.572004 0.621332 1.978290 1.546402 1.672410 0.423727 1.205710 1.436589 0.182917 0.251425 0.718333 -1.375705 0.497395 0.186440 0.550196 0.272118 1.380692 1.012574 0.305814 1.433937 0.098087)
)
;;; 109 odd -------------------------------------------------------------------------------- ; 10.4403
-#(109 13.889015913621 #(0 1 1 1 1 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 1 0)
- 13.798 #(0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 0)
+(vector 109 13.798 (fv 0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 0 1 1 0 0)
- 10.447305 #(0.000000 -0.332747 1.856284 0.312680 0.484748 1.927773 1.088972 1.267933 0.733543 1.369643 1.486039 1.207514 1.939207 0.145323 0.998545 1.515814 0.977742 0.874068 0.600370 0.915744 0.065835 1.624077 1.210341 0.446057 0.454470 1.365593 0.282333 0.392410 1.299389 1.103296 0.942614 0.508962 0.478160 1.475335 1.215400 0.999847 1.155519 0.416592 1.279274 -1.549528 1.234797 0.411337 -0.129375 1.006981 1.172195 0.592980 1.508509 0.805198 0.437373 0.361150 1.283098 0.890007 1.744947 0.245490 0.798736 1.396489 1.450786 1.300277 1.254124 0.506125 1.510674 1.101443 0.051132 1.480128 0.705191 0.041699 0.967150 1.794361 0.482467 0.725995 0.216064 0.229451 1.349369 -0.385925 1.676483 -0.044355 1.721416 0.996988 0.436891 0.002809 0.251427 1.491345 -0.119718 0.680963 0.838250 0.996312 1.668413 0.775867 1.054860 1.110238 1.080089 1.703345 1.107466 0.299563 0.900966 -0.003862 0.472673 1.242728 1.401441 -0.551114 0.290909 1.087488 0.370437 0.909607 0.670684 1.943031 -0.126821 0.059762 0.190973)
- 10.447067 #(0.000000 -0.328478 1.852602 0.294965 0.478682 1.934826 1.089775 1.273433 0.732061 1.367756 1.485458 1.203743 1.940600 0.159832 0.998702 1.516814 0.972946 0.867564 0.601527 0.919553 0.062958 1.622336 1.207584 0.454420 0.459988 1.381294 0.277822 0.388818 1.293234 1.098775 0.941486 0.509987 0.471552 1.481135 1.213889 0.996314 1.141913 0.400559 1.275870 -1.545152 1.223410 0.409526 -0.137035 1.015351 1.169645 0.592364 1.496856 0.800606 0.428601 0.364393 1.282982 0.892214 1.747732 0.240071 0.789274 1.406131 1.443306 1.288486 1.237978 0.489264 1.517110 1.096230 0.054531 1.472615 0.699041 0.038218 0.958129 1.785939 0.483704 0.729505 0.223236 0.211868 1.345261 -0.396392 1.666595 -0.042851 1.728489 0.984031 0.437718 -0.012369 0.259839 1.490542 -0.120473 0.686966 0.831415 0.998998 1.661960 0.779409 1.048865 1.101797 1.089030 1.693260 1.097695 0.297423 0.906166 -0.012621 0.476474 1.240637 1.395733 -0.547995 0.295528 1.084931 0.357070 0.907049 0.651109 1.937478 -0.127798 0.053816 0.189265)
+ 10.413972 (fv 0.000000 -0.329332 1.852441 0.301192 0.479205 1.938689 1.086891 1.271023 0.729396 1.367900 1.483662 1.203078 1.940935 0.158023 0.999249 1.513297 0.973974 0.871966 0.600005 0.917499 0.064963 1.625056 1.204390 0.450307 0.459827 1.379619 0.277893 0.390957 1.292297 1.095127 0.941246 0.509853 0.476400 1.479425 1.214972 0.999425 1.144172 0.402758 1.277806 -1.541834 1.224224 0.408937 -0.140267 1.012505 1.167342 0.593542 1.500901 0.801861 0.428256 0.363108 1.278773 0.897271 1.754344 0.238279 0.787476 1.405582 1.439989 1.293816 1.237720 0.491493 1.514000 1.092355 0.055457 1.477338 0.699004 0.040279 0.957508 1.786210 0.481649 0.726028 0.215740 0.216870 1.343437 -0.395385 1.669265 -0.047054 1.724398 0.984510 0.441756 -0.012720 0.257871 1.485641 -0.121426 0.687863 0.835502 1.004805 1.663485 0.780698 1.042433 1.097029 1.089236 1.689246 1.096756 0.293532 0.899560 -0.005695 0.471699 1.241990 1.396400 -0.542444 0.294633 1.091314 0.356171 0.908370 0.648337 1.936350 -0.128643 0.053871 0.188853)
)
;;; 110 odd -------------------------------------------------------------------------------- ; 10.4881
-#(110 13.816418806615 #(0 1 0 0 1 0 0 0 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 0)
- 13.75 #(0 1 0 0 1 0 0 0 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 0)
- 13.576010454591 #(0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0)
+(vector 110 13.576010454591 (fv 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0)
- 10.428714 #(0.000000 1.583648 1.129947 0.924483 0.406218 0.107483 0.653744 1.235487 1.676370 1.425640 -0.320483 -0.107084 1.651812 1.222776 1.376614 0.069497 0.036419 0.617898 1.591711 1.247220 1.419953 1.406557 1.068982 1.180192 1.368282 -0.309030 -0.229078 -0.257646 0.342115 0.189163 1.898380 1.210347 -0.362412 0.481282 1.177829 1.497680 1.566659 0.971763 -0.048036 0.765500 1.365583 1.546335 0.839087 0.519122 0.784308 1.840403 0.201291 0.693805 0.994434 0.137673 0.417047 -0.003491 1.430114 0.547860 0.454673 0.880169 0.020167 0.612909 1.447706 1.144730 1.475850 0.804732 0.822423 0.175147 1.164727 0.079122 1.148465 1.449874 1.656083 1.757507 0.522095 0.256492 1.707393 0.482401 1.375989 0.505894 0.992394 -0.613752 0.867142 0.307069 0.414958 0.138700 0.061995 1.128335 1.488240 0.707466 -0.097812 1.382959 0.291675 1.123924 -0.072807 0.981998 0.037908 1.759351 0.406830 0.016970 -0.606290 1.005853 1.670441 -0.214830 1.779783 0.878839 0.413502 1.289771 0.861063 0.802739 1.189840 0.135826 0.109595 0.731827)
+ 10.408073 (fv 0.000000 1.583299 1.129147 0.924363 0.405386 0.106463 0.654471 1.235816 1.676675 1.424024 -0.320821 -0.106137 1.651584 1.223458 1.376470 0.070578 0.035561 0.618393 1.591071 1.247092 1.420738 1.407145 1.068993 1.180774 1.368120 -0.309458 -0.227815 -0.257077 0.341569 0.189699 1.898096 1.209271 -0.362341 0.480813 1.176223 1.497789 1.567432 0.970389 -0.047452 0.764481 1.364232 1.546603 0.838685 0.519999 0.785088 1.840526 0.201375 0.694162 0.995107 0.138310 0.417265 -0.004223 1.430441 0.548174 0.456155 0.879102 0.021026 0.612402 1.448544 1.143273 1.475463 0.804075 0.821149 0.175404 1.164546 0.079156 1.149637 1.448505 1.656091 1.757415 0.521205 0.257194 1.707629 0.482292 1.377093 0.507438 0.991226 -0.612661 0.868064 0.306724 0.414844 0.138628 0.061298 1.129023 1.487975 0.706799 -0.099480 1.383589 0.290834 1.123787 -0.072238 0.982011 0.038233 1.760058 0.405531 0.016972 -0.604791 1.005236 1.670267 -0.215358 1.779967 0.879139 0.413047 1.290874 0.860692 0.804540 1.190191 0.135277 0.110128 0.732322)
)
;;; 111 odd -------------------------------------------------------------------------------- ; 10.5357
-#(111 14.376 #(0 0 0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0)
- 14.114 #(0 0 0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0)
- 13.709900383304 #(0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0)
+(vector 111 13.709900383304 (fv 0 0 0 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 0)
- 10.652065 #(0.000000 0.090785 0.440103 -0.183218 0.557614 -0.014834 1.208921 0.852282 -0.323535 0.106833 1.713596 0.023752 -0.040779 1.021406 0.839274 1.939537 1.435389 1.328474 1.620179 1.602873 0.198968 0.328481 1.952601 0.964508 0.028106 1.608367 0.808355 1.905574 1.467605 0.052421 0.964603 0.902097 0.548080 0.701466 -0.021847 1.416536 0.835443 0.951946 1.263983 0.811334 0.410179 0.788412 0.337898 -0.099500 0.613260 0.091412 1.056921 1.281484 0.118022 1.281209 1.355941 0.195871 0.829226 1.637171 1.606724 0.464283 1.362024 -0.184598 1.699968 0.629492 0.126606 0.280166 0.078974 0.933728 0.603627 0.488421 0.478349 0.358901 1.753853 1.434279 -0.379508 0.025525 1.373920 1.461287 -0.216523 0.532124 0.001853 0.715168 1.439363 1.904639 0.805251 0.048479 -0.003557 1.673760 1.807022 0.393370 1.472401 0.589668 1.628015 0.412269 1.291088 0.205801 0.480791 0.830583 1.243727 -0.111282 -0.019518 -0.038887 0.376310 1.761500 1.377056 1.237011 0.026296 -0.130313 0.380493 1.046875 0.112931 1.193709 1.554088 0.756711 0.499378)
+ 10.588903 (fv 0.000000 0.083293 0.444830 -0.213766 0.524915 -0.005956 1.175907 0.783294 -0.343790 -0.015069 1.676924 0.021997 -0.012805 1.023472 0.864450 1.922773 1.431731 1.374839 1.561767 1.633583 0.198147 0.245727 1.910466 0.995751 0.091514 1.666123 0.750477 1.953152 1.512135 0.025831 0.969938 0.804619 0.507564 0.688555 -0.027332 1.433090 0.812479 0.893934 1.245019 0.835304 0.404414 0.839838 0.338429 -0.112731 0.636982 0.099621 1.080987 1.292673 0.177317 1.292327 1.284755 0.253860 0.748555 1.591323 1.605479 0.445460 1.332537 -0.181589 1.668331 0.627699 0.074537 0.208177 0.135644 0.846946 0.614940 0.479986 0.443281 0.299879 1.767930 1.411021 -0.391645 0.057816 1.376551 1.471560 -0.203049 0.453124 0.061036 0.704839 1.379390 1.848624 0.771131 -0.036797 0.007834 1.611881 1.733830 0.412751 1.415257 0.544650 1.539165 0.414455 1.242586 0.195280 0.522916 0.859907 1.238816 -0.090313 -0.027707 -0.025034 0.375248 1.748950 1.440534 1.222909 0.018270 -0.118073 0.275708 1.112569 0.089742 1.167857 1.617530 0.755934 0.450427)
+
+ ;; pp:
+ 10.417134 (fv 0.000000 0.334233 1.073081 1.649039 0.219597 0.888802 1.379829 0.088335 0.555458 1.328032 1.801862 0.615319 1.429043 0.326004 0.993452 1.804613 0.545160 1.317910 1.885616 0.678140 1.509274 0.323491 1.236504 0.282786 1.199970 0.195704 1.232493 0.160017 0.897560 -0.082586 1.086392 0.182366 1.277299 0.339072 1.485948 0.630905 1.802953 0.832621 -0.132126 1.110982 0.486291 1.681037 0.774846 -0.032051 1.638442 0.870514 -0.093334 1.333411 0.747525 0.167590 1.347374 0.845491 0.233833 1.720211 1.112373 0.655737 0.273424 1.815808 1.225426 0.609827 0.164644 -0.241753 1.556306 1.087036 0.843899 0.560878 -0.058558 1.838311 1.465620 1.239758 1.091378 0.528065 0.791149 0.332440 0.584210 0.055836 0.449981 1.753070 0.093654 1.657239 1.503059 1.399887 1.433488 1.544146 1.513188 1.637379 1.822882 1.796041 1.687813 1.720729 1.754274 -0.098151 -0.072877 0.197474 0.504171 0.827563 1.033490 1.323144 1.356797 1.748728 -0.150347 0.352269 0.632744 0.932570 1.684081 0.187586 0.495859 1.035344 1.327590 1.648341 0.358056)
)
;;; 112 odd -------------------------------------------------------------------------------- ; 10.5830
-#(112 14.528804585299 #(0 0 1 1 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 0 1 0 0)
- 14.383410482601 #(0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 0 1 0 0)
- 13.92684841156 #(0 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1)
+(vector 112 13.92684841156 (fv 0 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1)
- 10.615626 #(0.000000 0.315463 0.146847 0.765407 0.251177 0.876117 1.449325 0.248273 1.509144 0.787358 1.178338 1.083876 0.035304 1.782642 0.281187 0.761824 0.714166 1.576721 1.277807 1.242664 1.021678 -0.136800 1.721851 1.644958 1.258260 0.574039 0.520610 0.367877 1.126109 1.011840 0.279444 0.013816 0.101646 1.703134 0.800903 1.603036 0.551365 1.023328 0.563751 0.383203 0.154767 0.521052 0.030824 1.723438 0.182835 1.183172 0.914697 0.556558 1.657904 0.877111 0.112184 1.052281 0.933373 -0.063145 0.651370 1.057321 -0.387635 1.473800 0.245455 0.385678 0.416810 0.946218 1.007339 1.334975 0.599632 0.798692 0.308940 -0.483335 0.460792 1.294438 0.599783 0.417823 0.079577 0.297917 0.491472 0.233573 0.631367 1.123147 -0.236708 0.662772 1.183135 -0.088562 1.135021 0.785932 1.499731 1.552907 1.147841 0.575414 0.279374 1.468380 0.182403 0.270223 1.644246 1.232037 0.155772 0.340225 1.584432 0.096606 0.037037 1.023191 1.149591 1.444735 0.633376 1.566625 1.090802 1.533164 1.605425 0.888886 1.387664 0.651869 1.356634 -0.052061)
+ ;; 10.58293147
+ 10.582025 (fv 0.000000 0.311823 0.137469 0.765085 0.247252 0.880370 1.452735 0.240993 1.506478 0.780197 1.183194 1.086565 0.032933 1.780577 0.281098 0.764676 0.712557 1.579682 1.277796 1.238223 1.014207 -0.140323 1.716730 1.644672 1.253593 0.578221 0.527661 0.367318 1.131386 1.012757 0.285059 0.010509 0.097401 1.699590 0.802620 1.600737 0.550167 1.026747 0.562219 0.378187 0.150437 0.522055 0.022316 1.717789 0.186746 1.186644 0.914782 0.563095 1.653911 0.869696 0.117700 1.053735 0.935756 -0.055221 0.653101 1.059195 -0.397205 1.469022 0.238158 0.393902 0.410251 0.955768 1.001018 1.337003 0.602349 0.798689 0.307413 -0.479763 0.463243 1.296128 0.608105 0.417995 0.073111 0.291455 0.483686 0.231728 0.630836 1.131231 -0.228753 0.669521 1.185569 -0.089761 1.130815 0.778132 1.502582 1.555252 1.149912 0.577946 0.284522 1.467470 0.172271 0.275044 1.633737 1.228854 0.152388 0.342365 1.574177 0.099351 0.042391 1.025180 1.146998 1.437785 0.647927 1.566576 1.091754 1.532311 1.602420 0.887895 1.387294 0.660060 1.356768 -0.056782)
)
;;; 113 odd -------------------------------------------------------------------------------- ; 10.6301
-#(113 14.292 #(0 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 1 0 0)
- 14.00348588593 #(0 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 0 1 0 0)
- 13.825498858186 #(0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0)
+(vector 113 13.825498858186 (fv 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0)
- 10.629040 #(0.000000 0.901497 0.184290 1.188787 0.326124 1.326928 0.329732 -0.067411 0.803455 1.762608 1.040526 1.882255 1.271132 -0.453465 -0.030472 1.784300 -0.041842 0.637898 0.694132 1.097911 0.931626 1.523672 1.772443 1.406459 1.564650 0.836946 1.771508 0.711355 1.118387 0.809213 0.810413 0.891070 0.127366 1.273461 1.438899 1.233277 0.435108 0.221280 1.287952 0.681516 0.511288 0.905658 0.250141 0.507604 0.433636 1.270880 0.405422 0.255168 1.419646 1.332103 1.277606 0.687723 0.389653 1.763099 0.372664 1.863493 0.148105 1.608005 0.630162 0.548868 0.879371 1.689564 0.861332 0.913432 0.281775 1.642391 0.432377 1.143504 0.378183 1.682779 1.724848 0.619177 0.167060 0.753163 0.900073 1.882269 1.606011 0.209505 0.320699 1.378382 0.838295 0.483376 -0.063039 0.034702 0.052434 1.378985 1.667939 0.491280 1.060046 0.336259 0.862784 1.010962 0.384434 0.755591 0.846223 0.395964 0.494496 0.815664 0.719163 1.164623 1.981698 0.566880 1.421850 1.548725 1.486996 0.838817 1.220909 1.015798 -0.079378 -0.200653 0.706575 0.649433 1.400401)
+ 10.586426 (fv 0.000000 0.880973 0.176609 1.175777 0.325354 1.332354 0.320489 -0.071032 0.810398 1.764286 1.047524 1.891121 1.274870 -0.462450 -0.016593 1.802245 -0.046896 0.623724 0.697636 1.104725 0.928560 1.531658 1.767776 1.410783 1.560300 0.841358 1.754992 0.695860 1.109332 0.811865 0.787805 0.897767 0.126996 1.290009 1.439543 1.231735 0.428818 0.217484 1.274411 0.676699 0.491905 0.907831 0.251383 0.502017 0.436195 1.271188 0.390987 0.252204 1.423164 1.333446 1.284283 0.685749 0.387192 1.752967 0.379905 1.873082 0.147356 1.600693 0.620101 0.533661 0.873916 1.687058 0.856213 0.905702 0.279125 1.651302 0.425155 1.158445 0.384556 1.685623 1.738609 0.620191 0.166765 0.760816 0.887704 1.876641 1.612703 0.207434 0.310898 1.383166 0.834523 0.489910 -0.069256 0.030910 0.047326 1.374933 1.678060 0.495762 1.058376 0.337747 0.859288 0.994496 0.384200 0.735993 0.843904 0.381801 0.488130 0.839325 0.731059 1.159772 1.973051 0.569688 1.423018 1.561321 1.485614 0.834971 1.215611 1.015531 -0.080496 -0.203441 0.704520 0.652007 1.385821)
)
;;; 114 odd -------------------------------------------------------------------------------- ; 10.6771
-#(114 14.507795639854 #(0 0 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 1)
- 14.388 #(0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 0 0)
- 13.974405288696 #(0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0)
- 13.920305720092 #(0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 0 0)
+(vector 114 13.920305720092 (fv 0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 0 0)
- 10.639522 #(0.000000 -0.267736 0.572253 0.317482 0.924690 1.616055 0.727312 0.692942 0.986006 1.598271 0.290059 0.153295 1.761267 0.140873 1.181578 -0.380408 1.501930 1.142652 0.746375 1.618351 0.405854 1.157119 0.378855 0.538422 0.751325 0.738526 0.915561 1.625674 0.451663 0.961394 0.587710 1.869952 0.722390 1.555516 0.902570 0.774917 1.284618 0.346272 1.686401 1.090318 0.263797 1.108884 -0.009462 0.420904 1.806458 1.409316 1.769684 1.251841 0.693530 1.604389 1.667357 1.532521 0.963438 -0.681106 1.705225 1.127232 -0.203656 0.277585 0.178923 1.810404 0.763909 0.031712 0.540190 0.755483 0.684864 1.837885 0.716479 1.848906 1.363561 0.951028 -0.061530 1.854333 0.122201 -0.136683 1.146676 0.361191 0.781644 1.598382 1.122657 1.137075 0.560705 -0.016610 0.332337 1.473950 0.198510 0.302425 1.320929 1.570365 1.548960 -0.089706 1.910507 0.810470 -0.150539 1.372603 1.425655 0.264356 1.613505 0.175679 0.787674 1.259986 1.370189 1.919319 1.489019 1.396524 0.961958 0.516052 0.518341 1.244811 0.284372 1.708279 1.615845 0.811628 1.315859 1.697355)
+ 10.620769 (fv 0.000000 -0.265733 0.572658 0.316585 0.923883 1.614948 0.728669 0.692865 0.985653 1.596503 0.291068 0.153708 1.761462 0.140269 1.183433 -0.379854 1.503387 1.143776 0.747711 1.619251 0.404594 1.157009 0.378840 0.537946 0.751007 0.739900 0.914353 1.624008 0.450778 0.962869 0.588872 1.869278 0.721483 1.557011 0.902276 0.776013 1.285044 0.345048 1.685952 1.091106 0.263288 1.107778 -0.009439 0.420734 1.806464 1.410193 1.769595 1.251788 0.691963 1.604897 1.666646 1.531003 0.963757 -0.680527 1.705352 1.126307 -0.203837 0.277321 0.178995 1.809866 0.763029 0.031476 0.539819 0.755127 0.685061 1.837935 0.717076 1.848829 1.364997 0.950055 -0.061791 1.853324 0.123916 -0.136693 1.146568 0.362176 0.781284 1.598429 1.120688 1.139170 0.560329 -0.015310 0.331374 1.472918 0.199430 0.303861 1.321918 1.569172 1.548780 -0.090459 1.912266 0.810039 -0.152547 1.372081 1.425080 0.264711 1.614349 0.175290 0.789472 1.260114 1.370945 1.918464 1.489942 1.397616 0.963993 0.516634 0.516943 1.244942 0.283787 1.709141 1.616073 0.810759 1.316742 1.696489)
)
;;; 115 odd -------------------------------------------------------------------------------- ; 10.7238
-#(115 14.773869138996 #(0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 0 1 1 0 1 1 1 0 1 0 1 1 1 1 1)
- 14.449532208006 #(0 0 0 0 1 0 0 0 0 1 0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0)
- 14.20306968689 #(0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1)
+(vector 115 14.20306968689 (fv 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1)
- 10.703321 #(0.000000 0.788800 -0.305140 -0.033624 0.760221 0.633207 0.249003 0.847120 1.261268 0.568548 0.946622 0.501194 0.309895 1.284720 0.846530 0.048008 1.566238 1.293149 0.243218 0.280432 1.570011 0.754929 1.490264 0.038037 0.165679 0.198345 0.962944 1.000720 0.172840 1.449805 -0.298846 0.086730 1.672864 1.098644 1.142013 0.383255 1.331059 0.654193 1.176839 0.650724 0.440950 0.865379 1.260473 -0.112267 0.069091 1.538600 0.072974 1.737443 1.209846 0.079735 -0.237086 0.215449 0.144525 0.343892 0.005879 0.036702 0.314452 0.889670 0.309377 0.066837 -0.267367 -0.014513 1.284599 0.526010 -0.401983 1.184721 0.827704 0.024137 0.878240 0.266075 1.091744 1.076125 -0.002234 0.040476 0.043356 1.571712 0.907913 0.685877 0.723664 0.060084 0.404707 1.455762 1.403189 1.360677 1.220342 0.089810 -0.915116 0.819137 1.446216 -0.045666 0.553424 0.626115 1.800896 0.514628 0.655662 0.749510 1.853030 1.130281 1.638494 0.405260 -0.004844 0.883640 0.101190 0.542648 0.542532 0.998484 1.503264 1.857108 1.262942 0.577966 0.923453 0.262158 0.596580 0.824138 0.350195)
+ 10.674304 (fv 0.000000 0.789887 -0.303859 -0.033056 0.759195 0.636525 0.248364 0.847489 1.259597 0.571635 0.950311 0.503307 0.311625 1.283873 0.845368 0.051963 1.567172 1.288876 0.243542 0.283164 1.566596 0.754789 1.490536 0.039434 0.168217 0.197813 0.961175 1.000724 0.173724 1.453836 -0.299975 0.087165 1.672267 1.098120 1.146505 0.379755 1.328375 0.651767 1.173825 0.650295 0.441141 0.865349 1.257754 -0.111945 0.068441 1.538745 0.068967 1.734610 1.208209 0.079563 -0.236732 0.216584 0.140036 0.340430 0.008574 0.036605 0.315028 0.890542 0.307266 0.065201 -0.267238 -0.016662 1.283003 0.528002 -0.402562 1.186323 0.829551 0.025932 0.882753 0.264357 1.091661 1.076730 -0.001406 0.040934 0.042083 1.567774 0.906679 0.687134 0.720339 0.063372 0.406664 1.457338 1.400253 1.359707 1.217492 0.090043 -0.918052 0.816288 1.443080 -0.046946 0.555663 0.622694 1.800570 0.513267 0.655836 0.746318 1.849833 1.129389 1.637640 0.403829 -0.005965 0.883415 0.100025 0.540813 0.541888 0.996530 1.501665 1.855318 1.257420 0.578586 0.925447 0.264080 0.596871 0.828008 0.353618)
)
;;; 116 odd -------------------------------------------------------------------------------- ; 10.7703
-#(116 14.661133289609 #(0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 1 0 1 1 1 1 1 0 0)
- 14.619069099426 #(0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0)
- 13.887789451571 #(0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0)
+(vector 116 13.887789451571 (fv 0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0)
- 10.761274 #(0.000000 0.476755 1.879600 1.179006 0.827780 1.453428 0.787405 1.051598 1.213459 0.179315 0.747650 1.269660 0.032054 1.634428 -0.151720 0.778255 0.274467 1.471326 0.562168 1.805383 0.216448 0.156593 1.048148 0.169253 0.220439 0.776725 0.397421 0.634587 -0.104994 0.313662 1.775679 0.161542 1.717487 1.119790 1.391523 0.105329 1.024261 1.531740 1.548560 -0.245797 0.490590 1.544942 0.178004 0.658209 0.264377 1.054603 0.894791 1.443866 1.721366 0.002430 1.151325 1.058316 0.111540 0.862710 0.782948 1.279003 0.503340 0.943233 0.797769 1.334557 1.656468 1.679889 0.257826 0.888434 0.069211 1.520190 1.239161 1.555198 0.515062 1.257800 1.258260 1.029904 1.357646 1.907316 1.280638 1.170950 0.249358 1.620475 0.210728 1.523357 -0.092797 0.708133 1.857712 0.183216 0.745662 0.759651 0.246102 -0.157260 1.665704 0.236118 -0.220395 1.215862 1.458755 1.518945 1.204373 0.477705 -0.382546 0.212607 0.336558 1.438529 1.042931 0.854257 0.387654 1.704015 1.440705 -0.139583 1.278681 0.715831 0.736744 1.589746 1.780797 1.655597 -0.316348 0.175850 1.445044 0.991222)
+ 10.733274 (fv 0.000000 0.476000 1.878001 1.180059 0.831300 1.453614 0.786219 1.052031 1.218138 0.179523 0.743868 1.265853 0.031570 1.636184 -0.152324 0.778296 0.271634 1.469546 0.565495 1.807809 0.217280 0.159382 1.049221 0.170285 0.221763 0.774648 0.398259 0.637279 -0.107284 0.312805 1.776901 0.160502 1.717634 1.119938 1.391025 0.105351 1.023277 1.530674 1.548380 -0.251006 0.488559 1.544222 0.177807 0.661206 0.257716 1.053732 0.893027 1.445098 1.722088 0.002770 1.151812 1.061439 0.110999 0.865286 0.781438 1.277991 0.502793 0.943734 0.798521 1.333645 1.654972 1.679619 0.259243 0.886975 0.069664 1.517348 1.237826 1.551946 0.514540 1.258563 1.258071 1.027685 1.355844 1.909459 1.281504 1.171068 0.250655 1.622642 0.211675 1.522349 -0.092396 0.705855 1.861520 0.183629 0.746566 0.759808 0.250024 -0.159043 1.664858 0.237853 -0.217693 1.217376 1.459590 1.517349 1.206266 0.478670 -0.380779 0.210779 0.338305 1.433407 1.043804 0.854323 0.392836 1.702198 1.439694 -0.141576 1.283279 0.715495 0.734335 1.585749 1.775978 1.654290 -0.315773 0.174327 1.442380 0.993240)
)
;;; 117 odd -------------------------------------------------------------------------------- ; 10.8167
-#(117 14.63381513714 #(0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1)
- 14.427604264985 #(0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1)
+(vector 117 14.427604264985 (fv 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 1 1)
- 10.817682 #(0.000000 0.104145 0.680193 -0.037818 1.069789 0.985499 0.912864 1.467141 1.730959 0.839907 1.309497 0.616552 1.546346 -0.234162 1.482339 0.844739 1.247363 0.240187 0.850532 -0.025035 0.452238 0.810803 1.489490 1.572440 1.180921 0.777887 0.112329 0.903343 1.166870 -0.154318 0.510812 1.677070 1.684245 1.221431 1.842442 0.537410 0.341186 0.043996 -0.082243 1.470088 1.566516 0.174343 -0.068667 0.915313 0.599319 1.569387 0.693179 1.122913 -0.424627 0.611746 1.493578 0.869845 0.898216 1.357975 1.648748 1.410401 0.039068 1.686221 1.093147 0.738318 1.239186 0.471813 1.446918 0.981644 0.803238 1.512586 0.965834 0.275801 0.097350 1.600226 -0.005704 1.895667 1.405092 1.240445 0.381655 0.520708 0.416839 1.053019 0.153569 0.781705 0.764205 1.863292 0.021348 1.469819 0.084480 1.795247 0.436348 0.737979 0.443138 -0.060234 1.251268 0.137736 1.734983 1.867493 1.565231 0.428086 0.539457 0.902159 1.633269 1.124259 0.409430 0.766302 0.285168 1.398263 0.261612 0.024589 0.270776 0.678612 -0.079165 0.506599 0.231790 1.244990 1.647062 0.237776 0.026395 1.133072 1.452980)
+ 10.783290 (fv 0.000000 0.108967 0.680440 -0.039849 1.073915 0.982905 0.909467 1.470260 1.730853 0.840580 1.309090 0.612716 1.548112 -0.231227 1.489945 0.841297 1.245447 0.244987 0.849971 -0.022279 0.452974 0.810744 1.489407 1.567278 1.188237 0.772892 0.113419 0.906478 1.169175 -0.156676 0.507744 1.684543 1.686412 1.219650 1.843836 0.541605 0.346082 0.043904 -0.079283 1.469849 1.567795 0.179241 -0.068928 0.912255 0.602511 1.574715 0.695060 1.133392 -0.425958 0.610886 1.496396 0.865636 0.895412 1.362633 1.653811 1.404165 0.041681 1.692317 1.094403 0.739550 1.239428 0.479228 1.439160 0.986149 0.801910 1.514113 0.963332 0.281851 0.106127 1.599308 -0.004925 1.893302 1.411671 1.244923 0.383170 0.517813 0.421067 1.058052 0.153400 0.778671 0.754438 1.880309 0.023746 1.476647 0.081600 1.798573 0.432245 0.735923 0.440628 -0.064421 1.249491 0.136405 1.735439 1.868665 1.565831 0.435031 0.537457 0.904590 1.634892 1.124196 0.408216 0.769901 0.281419 1.398400 0.260352 0.021213 0.275268 0.681889 -0.074136 0.502025 0.237163 1.241676 1.638668 0.242962 0.026823 1.133262 1.452416)
)
;;; 118 odd -------------------------------------------------------------------------------- ; 10.8628
-#(118 14.922 #(0 1 1 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 0 0)
- 14.72793006897 #(0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1)
- 14.399567650824 #(0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1)
+(vector 118 14.399567650824 (fv 0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1)
- 10.832938 #(0.000000 1.509361 1.811439 1.324434 0.672977 0.977968 0.395816 0.294427 0.401178 1.800921 0.491372 1.565608 -0.365118 1.100639 1.074407 0.502753 0.455394 0.407244 0.228127 0.757819 1.514775 0.348109 1.449814 0.867213 1.501091 0.351921 -0.411182 -0.146357 0.240036 1.114822 0.652526 -0.507043 -0.021180 1.852572 0.585222 0.429167 0.051003 0.750735 1.449559 1.226793 1.754137 1.882688 0.484371 1.753819 0.007772 0.164743 0.582240 0.998674 -0.089163 0.950887 1.424941 1.513175 1.570966 -0.258818 0.530250 1.497793 1.327487 -0.593912 1.538291 0.728122 0.443802 1.055514 1.385329 0.874593 0.075231 1.099971 1.735164 0.605662 1.534691 1.016285 0.484806 0.437907 1.109578 1.808309 0.027893 0.298620 -0.064618 0.782812 1.283021 0.358673 -0.031014 1.363312 0.688037 1.190577 1.440225 1.142039 1.126241 1.239238 0.136905 1.490129 1.026405 0.527596 0.889191 -0.021537 0.141751 -0.353593 1.163865 1.003327 0.099774 1.219348 1.079721 1.772918 1.379333 1.457017 0.703017 0.986748 1.492837 1.628794 0.957376 -0.056404 1.653914 0.429249 1.736305 -0.163790 0.278470 -0.109824 1.167850 1.877376)
+ 10.812235 (fv 0.000000 1.507972 1.809575 1.323971 0.671235 0.977919 0.397118 0.294709 0.400614 1.800046 0.492728 1.565979 -0.363038 1.100463 1.075231 0.502016 0.457037 0.406728 0.228418 0.756367 1.513939 0.347068 1.450936 0.868009 1.501709 0.352220 -0.413052 -0.148923 0.240400 1.115439 0.653043 -0.505473 -0.021974 1.853042 0.586305 0.428092 0.050201 0.752546 1.451411 1.228490 1.754283 1.881544 0.485306 1.754300 0.007006 0.163634 0.582385 0.998129 -0.090614 0.952205 1.425714 1.513296 1.570494 -0.259048 0.529336 1.498547 1.326491 -0.594238 1.538496 0.728657 0.444244 1.055319 1.385207 0.874327 0.074427 1.100816 1.734905 0.605814 1.533043 1.017063 0.482871 0.438583 1.108829 1.808956 0.029357 0.297016 -0.063569 0.780909 1.283400 0.359665 -0.032425 1.363808 0.687851 1.190450 1.438414 1.141910 1.126025 1.239471 0.136191 1.489911 1.026641 0.526687 0.890040 -0.022700 0.140687 -0.353757 1.164330 1.005641 0.099661 1.220163 1.081145 1.773078 1.376716 1.458019 0.703593 0.987305 1.493840 1.628605 0.957392 -0.054994 1.652856 0.431213 1.736293 -0.162073 0.279632 -0.110283 1.166212 1.877544)
)
;;; 119 odd -------------------------------------------------------------------------------- ; 10.9087
-#(119 15.03294064107 #(0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1)
- 14.647579104049 #(0 1 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1)
- 14.464 #(0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1)
+(vector 119 14.464 (fv 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1)
+
+ 10.915923 (fv 0.000000 1.468971 -0.070109 0.743471 0.865207 0.740713 1.375563 1.856253 1.493876 0.001446 1.555119 1.873527 0.486379 1.616655 0.160602 1.367247 0.912321 0.764636 0.328487 -0.313335 0.385982 0.645370 0.408989 -0.210208 1.638205 0.329206 1.585495 1.658528 -0.015737 0.563000 0.062305 -0.007952 1.615694 0.120849 0.556636 1.351804 1.028805 0.044823 -0.249641 0.450875 -0.188130 1.054822 1.658005 0.732611 1.051144 0.181032 -0.061461 0.014104 0.174656 1.497989 1.287601 1.362445 0.209461 0.902894 1.389971 0.577406 1.285084 1.677882 0.836076 1.093131 -0.061912 0.754157 0.925122 0.984483 0.745399 1.783690 0.907228 0.093044 0.001514 0.775385 1.257954 1.480444 1.312457 1.195686 1.427916 1.726017 1.291212 1.845006 1.072451 0.380596 -0.077482 -0.030557 0.660125 1.346002 0.823989 0.235481 1.377946 1.450150 0.552324 0.398627 1.336527 0.073526 0.466630 0.590308 0.928946 0.828743 -0.154986 1.149963 0.492935 1.772069 0.204388 1.490853 -0.315475 0.097407 1.157089 0.698006 1.513716 1.488764 0.923673 0.108745 1.168110 0.729608 1.392132 1.740139 1.454066 0.757828 1.227068 0.584339 1.581610)
- 10.953314 #(0.000000 1.472457 -0.082644 0.753367 0.852524 0.740869 1.365349 1.856851 1.499878 0.001246 1.549157 1.881176 0.496353 1.609391 0.157559 1.370973 0.903847 0.760281 0.336560 -0.309936 0.387300 0.653713 0.409662 -0.202947 1.650313 0.331379 1.577406 1.651599 -0.006883 0.560847 0.051486 -0.005347 1.618574 0.117984 0.553296 1.356311 1.023397 0.043871 -0.250586 0.460721 -0.180958 1.046115 1.652796 0.738529 1.052565 0.170943 -0.055016 0.018095 0.170611 1.494881 1.285591 1.354174 0.208158 0.903196 1.381293 0.587536 1.288451 1.670699 0.837671 1.080352 -0.058452 0.754798 0.924391 0.984580 0.740761 1.794418 0.901249 0.089248 0.007521 0.763517 1.249208 1.472886 1.313691 1.196837 1.407590 1.726914 1.281649 1.842099 1.082751 0.386764 -0.077435 -0.021999 0.665495 1.347030 0.829066 0.223909 1.373211 1.445267 0.545903 0.397862 1.348840 0.085553 0.454018 0.586098 0.932964 0.817263 -0.162706 1.137188 0.499626 1.761847 0.203437 1.482372 -0.313735 0.100647 1.156117 0.700716 1.510207 1.483052 0.917189 0.113079 1.148624 0.722479 1.390928 1.742136 1.447708 0.769452 1.227137 0.579127 1.593709)
+ ;; pp:
+ 11.037707 (fv 0.000000 0.330663 0.977506 1.486310 0.146671 0.619852 1.212563 1.835260 0.429131 1.137767 1.722966 0.554725 1.336956 0.080712 0.852554 1.473118 0.165981 0.811544 1.502696 0.343077 1.371306 0.205531 0.905257 1.934366 1.020467 1.933150 0.730878 1.550089 0.565733 1.543669 0.452622 1.507940 0.734165 1.641237 0.799367 0.020448 1.044223 0.039537 1.305538 0.570880 1.458969 0.622353 1.797356 0.986890 0.251789 1.442933 0.753665 0.270337 1.533653 0.647011 -0.011278 1.435253 0.493723 -0.176024 1.395851 0.880365 0.222324 1.709439 1.376910 0.824516 0.330942 1.733291 1.350769 0.852276 0.247847 -0.101792 1.361637 1.450559 0.694333 0.792939 0.273393 1.916534 1.612649 1.136729 1.027650 0.745376 0.479123 0.468161 -0.088607 0.141257 1.721063 1.745485 1.474071 1.547129 1.195469 1.231545 0.976850 0.989136 1.181833 0.899203 1.200899 1.168317 1.143250 1.360858 1.307442 1.171633 1.402153 1.656644 1.531180 1.874515 0.028657 0.416186 0.465448 0.590264 1.056005 1.152867 1.387578 1.553815 0.076236 0.350372 0.561320 1.007917 1.385094 1.972832 0.449173 0.459147 1.193699 1.594244 0.056947)
+
+ ;; 118+1
+ 10.815476 (fv 0.000000 1.511627 1.860509 1.251771 0.680390 0.954029 0.497464 0.422082 0.549359 1.789096 0.627036 1.559684 -0.285316 1.102920 1.110972 0.497639 0.358913 0.339963 0.170351 0.820368 1.613321 0.311453 1.667587 0.845824 1.477518 0.323382 -0.462336 -0.121701 0.278431 1.251253 0.730313 -0.512813 0.050332 1.905719 0.581701 0.491221 0.037053 0.850077 1.454447 1.218666 1.827857 1.931466 0.444700 1.716033 0.031317 0.208955 0.719947 1.025308 -0.162952 0.941579 1.416409 1.490055 1.661028 -0.177347 0.601149 1.427738 1.318738 -0.598055 1.513344 0.818145 0.331744 0.938565 1.416971 0.755203 0.134509 1.154206 1.729909 0.622158 1.596632 1.050190 0.348364 0.402844 1.083937 1.814009 0.098380 0.333506 -0.078532 0.814360 1.186888 0.456002 0.118529 1.475204 0.706833 1.153688 1.398936 1.202344 1.140027 1.452557 0.124581 1.538313 1.096684 0.449897 0.816791 -0.073645 0.157032 -0.377184 1.176926 0.948380 0.061745 1.231800 0.991632 1.829471 1.268286 1.394920 0.669763 0.966107 1.360959 1.524586 1.033990 0.094975 1.707832 0.468762 1.695289 -0.249729 0.213611 -0.109788 1.260368 1.791243 -0.325923)
)
;;; 120 odd -------------------------------------------------------------------------------- ; 10.9545
-#(120 14.701 #(0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 1)
- 14.672351088208 #(0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 1)
- 14.578378677368 #(0 1 0 1 0 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1)
- 14.530112637252 #(0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0)
+(vector 120 14.530112637252 (fv 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0)
- 10.944979 #(0.000000 1.631084 1.386163 1.212293 0.282694 1.390715 0.111257 0.265389 0.981899 1.225000 0.890351 1.655515 1.768068 0.697158 1.242506 0.723170 0.697683 1.130846 0.993484 1.302395 0.313386 0.606407 1.496902 1.438878 -0.030696 0.721064 0.808247 1.404244 1.845189 -0.006224 0.491303 -0.095242 0.226600 -0.181791 0.143903 0.994964 0.355959 0.282763 0.966331 0.230844 1.507287 0.177035 0.405081 1.444703 0.488809 0.993117 -0.060434 1.516934 0.636006 0.456202 1.140008 1.114602 0.759195 -0.128939 1.238833 1.405836 0.198459 -0.000302 1.366816 0.725410 0.862311 1.277558 0.565743 1.308380 0.592308 0.234387 1.178606 1.731135 0.364822 -0.144460 0.521795 1.740798 0.224674 1.632227 0.601821 0.928859 0.626771 0.433439 1.782020 0.936969 1.484119 0.994823 1.700228 0.217091 0.002438 0.765077 1.684225 1.551422 0.977072 0.321347 0.440100 0.261176 1.685064 0.971788 0.205646 0.727201 0.388181 1.062489 0.669572 0.703478 0.106606 1.759785 1.844679 0.290634 0.559763 -0.056722 0.529166 0.467645 -0.088446 1.744075 0.454251 1.249738 1.358022 0.400797 1.135053 1.057741 0.447463 0.807488 0.707908 0.100098)
+ 10.908578 (fv 0.000000 1.631022 1.381443 1.212465 0.280876 1.393291 0.111686 0.270527 0.978937 1.227425 0.890939 1.651369 1.764648 0.695615 1.236913 0.727116 0.698874 1.130809 0.997193 1.306023 0.313921 0.604505 1.499034 1.434773 -0.031959 0.721966 0.805711 1.401787 1.847562 -0.006201 0.484669 -0.092885 0.221199 -0.183123 0.140129 0.993753 0.357992 0.281932 0.966898 0.230227 1.509169 0.180321 0.405315 1.445457 0.491155 0.993111 -0.061813 1.514617 0.638001 0.451798 1.136956 1.109239 0.762301 -0.132886 1.231861 1.405253 0.200172 0.005626 1.367415 0.727395 0.860721 1.277905 0.564602 1.311600 0.590071 0.237783 1.173320 1.731939 0.366179 -0.147635 0.520386 1.741652 0.218116 1.635795 0.602629 0.928717 0.628620 0.437182 1.782199 0.939080 1.479011 0.992710 1.705346 0.225711 0.000961 0.770434 1.683323 1.555459 0.976408 0.318440 0.438208 0.262452 1.689840 0.975712 0.209291 0.727490 0.382719 1.065032 0.672130 0.702874 0.107185 1.755713 1.841965 0.283698 0.562788 -0.058140 0.525625 0.471391 -0.086606 1.741760 0.455380 1.248256 1.359448 0.404279 1.132787 1.054875 0.443335 0.808907 0.713857 0.102341)
)
;;; 121 odd -------------------------------------------------------------------------------- ; 11
-#(121 15.185772112492 #(0 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0)
- 14.673 #(0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0)
- 14.355115628334 #(0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0)
+(vector 121 14.355115628334 (fv 0 0 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0)
+
+ 10.999150 (fv 0.000000 0.719860 0.938641 0.400955 1.830792 0.217487 1.930089 0.909842 0.382707 1.104036 1.362552 1.609877 0.538869 1.202159 1.228082 0.918074 0.761902 0.900279 1.079854 0.387994 0.099489 0.100875 1.443224 0.976872 1.189188 0.334621 0.186401 1.007773 1.759908 1.802561 0.304789 0.800487 0.421388 1.531470 0.342409 1.763739 0.609609 0.238091 0.387711 0.077698 1.394770 1.550045 1.073770 -0.012632 0.461456 0.365441 0.558370 -0.144510 0.377065 -0.136065 0.495723 0.024372 0.599268 0.707454 1.784582 0.849322 0.801737 -0.000698 0.370684 -0.319990 0.047344 1.411089 -0.180064 1.795978 1.184028 0.211991 0.750419 1.558447 0.936061 0.770891 0.210380 0.477885 0.773230 1.314821 1.776398 0.360518 0.353595 1.763194 0.626584 0.453820 1.817369 0.757593 0.448588 0.747723 1.349523 0.084314 0.839331 0.432101 1.175829 -0.480593 1.521898 1.472118 0.461937 -0.352155 0.231781 1.128258 1.179502 -0.264358 1.594681 1.130852 1.819287 1.407276 0.357399 0.261689 0.296975 1.241018 0.528908 0.936623 1.018062 1.507272 1.409703 0.904346 -0.089508 0.657699 0.797276 1.771059 0.906319 0.794023 0.195827 -0.015182 1.382236)
- 11.073877 #(0.000000 0.700232 0.988760 0.414088 1.818752 0.200696 1.870116 0.913883 0.368474 1.118884 1.368743 1.643905 0.552146 1.199902 1.238146 0.895369 0.776224 0.972715 1.093565 0.402527 0.009153 0.102406 1.407997 0.995425 1.209378 0.314616 0.160449 1.037486 1.789123 1.801304 0.317813 0.774067 0.429011 1.555989 0.331199 1.732693 0.577666 0.201231 0.387994 0.052411 1.432087 1.539653 1.101405 -0.046805 0.438095 0.337176 0.544253 -0.105888 0.346245 -0.088455 0.514830 0.019302 0.629420 0.713076 1.816355 0.843482 0.754475 -0.070324 0.327946 -0.281415 0.026144 1.376298 -0.148818 1.806853 1.154773 0.177284 0.759751 1.507800 0.965866 0.754273 0.205341 0.406646 0.701656 1.302103 1.786729 0.291980 0.391316 1.761314 0.613391 0.456558 1.802786 0.729027 0.424174 0.730561 1.340328 0.094483 0.838409 0.436119 1.160470 -0.425315 1.532263 1.432604 0.446927 -0.330473 0.234970 1.085792 1.184749 -0.209380 1.589661 1.176672 1.830622 1.354994 0.346484 0.242195 0.273740 1.210125 0.482750 0.943282 1.042926 1.478183 1.396305 0.847644 -0.096795 0.632992 0.759471 1.766242 0.900881 0.776142 0.187262 -0.035934 1.359321)
+ ;; pp:
+ 10.964853 (fv 0.000000 0.398403 0.789366 1.639224 0.095384 0.603386 1.413253 -0.024715 0.418890 1.292082 1.611148 0.340631 1.108765 1.695063 0.580930 1.343797 0.280670 0.901558 1.616611 0.471137 1.087682 0.133909 0.906863 1.859279 0.568482 1.631317 0.654611 1.507476 0.361682 1.510922 0.499281 1.470975 0.300411 1.347262 0.617157 1.704177 0.828780 1.880799 1.043180 0.289911 1.416774 0.542005 1.546439 0.900363 0.167177 1.249035 0.407571 1.759267 1.085148 0.584948 1.716513 0.882082 0.508912 1.827501 0.986992 0.387974 1.888925 1.337010 0.836823 0.307293 1.641585 1.441301 0.767423 0.352201 1.694822 1.489433 0.858014 0.699679 0.213088 1.881335 1.746103 0.996170 1.013175 0.481879 0.378821 0.145113 1.583267 1.647206 1.099338 0.993610 1.018212 0.718965 0.851336 0.334482 0.624100 0.047757 0.264635 -0.323610 -0.302771 0.007865 1.748671 1.715799 0.102814 0.097582 0.089500 0.089824 -0.047495 0.097783 0.230671 0.371131 0.395035 0.485871 1.031900 1.248794 1.442726 1.594017 1.850116 0.167236 0.339312 0.429488 0.766566 1.120859 1.686086 0.133797 0.674257 1.033037 1.205258 1.718874 0.166520 0.534447 1.081831)
)
;;; 122 odd -------------------------------------------------------------------------------- ; 11.0454
-#(122 15.079724293912 #(0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0)
- 14.561 #(0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 1 1)
- 14.266534958875 #(0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1)
+(vector 122 14.266534958875 (fv 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1)
- 11.088235 #(0.000000 1.290668 1.120279 1.738304 1.139363 0.025686 1.366609 -0.052302 -0.036192 0.462036 1.531745 0.242597 1.211084 0.130294 1.305673 1.946156 1.396040 1.414246 1.741594 1.279039 1.513357 -0.033037 1.536578 0.223304 1.249215 0.371951 0.501583 1.259257 1.151734 0.090144 1.290696 1.647941 1.393303 0.283789 0.254887 -0.405089 0.556013 -0.090973 1.430103 0.769351 0.245692 1.567492 0.740682 0.590759 1.515815 0.555156 1.438330 0.009511 1.664340 1.749281 0.508641 1.592369 0.310725 1.408251 0.639889 -0.362818 -0.192346 -0.624124 0.880881 0.903815 0.039893 0.808549 0.981564 1.300398 0.178375 1.557819 0.915975 1.844534 -0.329052 0.544236 1.008714 0.855744 0.965524 0.676375 0.810486 0.630137 1.923240 0.223419 1.077211 0.295787 0.400125 1.344242 -0.314384 0.606003 0.759246 1.290959 0.570017 1.111143 -0.036778 0.314076 0.025767 1.578289 0.980187 0.993299 0.930842 1.323373 1.616181 -0.024066 0.390507 0.510015 1.466712 1.300932 -0.259403 0.449951 0.319426 -0.011128 0.073790 -0.288587 -0.030733 1.802599 0.583901 0.391858 0.033935 1.682733 1.268083 0.577776 0.914019 0.839335 1.443706 1.624898 0.812731 0.755300)
+ 11.010771 (fv 0.000000 1.285362 1.109765 1.769522 1.118511 0.025809 1.380894 -0.023810 -0.040154 0.477589 1.538986 0.261754 1.175104 0.132069 1.284014 1.937597 1.377797 1.405930 1.758393 1.282889 1.486625 -0.056321 1.528467 0.214498 1.235960 0.342086 0.501436 1.266150 1.154766 0.072612 1.295064 1.657622 1.389498 0.272462 0.259989 -0.421623 0.539671 -0.109400 1.457518 0.782406 0.238503 1.568707 0.742855 0.582523 1.544996 0.568221 1.469856 -0.013151 1.702120 1.738232 0.495569 1.623452 0.280213 1.398587 0.655444 -0.357815 -0.175614 -0.641353 0.853648 0.913786 0.039735 0.805399 0.987536 1.353101 0.200447 1.531233 0.925738 1.853509 -0.339223 0.575217 0.991404 0.868567 0.980697 0.661437 0.825668 0.642114 1.923343 0.222086 1.058889 0.329972 0.424129 1.343097 -0.325621 0.616372 0.777895 1.290746 0.563995 1.114886 -0.032692 0.303925 0.022515 1.568213 1.005956 0.993523 0.945016 1.316628 1.600265 0.004312 0.404044 0.508968 1.509703 1.266589 -0.292614 0.449335 0.327309 -0.027947 0.095691 -0.305771 -0.038174 1.851423 0.567671 0.373102 0.032065 1.664572 1.263320 0.558380 0.899406 0.824927 1.437277 1.639347 0.806318 0.739271)
)
;;; 123 odd -------------------------------------------------------------------------------- ; 11.0905
-#(123 15.249 #(0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 0 1 0)
- 15.019962594276 #(0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0)
- 14.795100232697 #(0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0)
+(vector 123 14.795100232697 (fv 0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0)
- 11.174405 #(0.000000 1.263107 1.734643 1.072676 0.847553 0.775353 0.497116 0.593210 0.598662 -0.088399 1.669433 1.080663 -0.063776 1.740025 0.143400 0.411860 0.521763 1.127237 1.598056 0.917640 1.386062 0.439551 0.814037 0.038847 0.109402 1.204436 0.411015 1.242063 1.211610 -0.259335 0.073961 -0.061686 0.733302 0.891045 1.171034 0.466288 0.794808 1.091009 0.740347 1.575268 0.146894 0.306511 1.721120 0.190462 1.462111 -0.209871 0.655442 0.213997 0.417204 1.144739 0.354961 1.146304 0.210847 1.471696 1.351484 0.852448 1.121360 1.580414 0.073400 0.601426 0.363496 0.636961 0.991149 0.463343 1.784961 1.549737 0.341890 0.930629 1.273176 1.421642 0.052489 0.954413 1.869476 1.416800 0.530460 0.520932 1.943213 1.368296 1.776938 0.275025 0.587738 0.394943 0.097520 0.007659 0.751076 0.305203 0.972456 0.258752 0.806334 0.682393 1.490102 0.416519 1.375160 1.392616 0.537933 1.443446 1.014262 0.281285 0.962685 1.115423 -0.131744 0.209775 1.788244 -0.452090 -0.219954 0.998279 -0.656174 0.552610 -0.114977 1.179608 -0.484357 1.250190 0.895388 1.554022 1.449955 1.453482 1.208560 0.584825 1.385799 1.628356 0.852009 0.493700 1.311312)
+ 11.117974 (fv 0.000000 1.262698 1.743243 1.074484 0.862475 0.785191 0.510312 0.582728 0.572628 -0.088059 1.664778 1.092330 -0.084164 1.734977 0.143912 0.402913 0.514775 1.115307 1.630947 0.922571 1.361065 0.426472 0.818315 0.052105 0.105138 1.201879 0.422607 1.251988 1.202423 -0.257950 0.069201 -0.064548 0.721964 0.891435 1.163338 0.489652 0.800922 1.113478 0.729679 1.592733 0.127179 0.300890 1.709393 0.172666 1.452078 -0.215073 0.642218 0.228379 0.403691 1.149702 0.347815 1.145024 0.203450 1.473310 1.349864 0.832166 1.109084 1.584188 0.087952 0.610084 0.356770 0.605944 1.021694 0.463739 1.799512 1.527466 0.330450 0.923701 1.275830 1.440075 0.070553 0.931440 1.867718 1.401219 0.527205 0.524478 1.943022 1.358574 1.765573 0.269987 0.599212 0.397347 0.099304 -0.004043 0.750837 0.311340 0.977644 0.259270 0.829971 0.677623 1.491913 0.411691 1.356052 1.394632 0.542733 1.451416 1.005068 0.285973 0.960285 1.132877 -0.136129 0.201370 1.788028 -0.448022 -0.229434 1.007668 -0.665334 0.552776 -0.103552 1.183857 -0.521659 1.255730 0.912247 1.532970 1.479294 1.441480 1.200164 0.598200 1.369457 1.661067 0.851812 0.484837 1.318223)
+
+ ;; pp:
+ 11.220425 (fv 0.000000 0.365848 1.054393 1.548722 0.083290 0.846622 1.243796 1.975082 0.530118 1.107798 1.698368 0.394906 1.261238 1.932773 0.709817 1.516065 0.289612 0.915816 1.713378 0.516514 1.369027 0.084750 0.935528 1.825369 0.700695 1.570817 0.581567 1.522187 0.450938 1.444224 0.424228 1.427039 0.366241 1.246498 0.294330 1.489859 0.444710 1.600045 0.769131 1.818819 0.882796 0.180405 1.318163 0.438713 1.518577 0.911091 0.311354 1.423178 0.560415 -0.093959 1.444287 0.598087 1.777270 1.408474 0.711081 0.112383 1.490437 0.904666 0.286560 1.771712 1.145544 0.724678 0.267468 1.796311 1.311228 0.841811 0.365537 1.880834 1.503328 1.287234 0.819314 0.526370 -0.077772 1.787440 1.491417 1.044589 1.141961 0.479419 0.379101 0.330996 -0.143470 1.807816 1.736856 1.461325 1.278241 1.506158 1.106149 1.221780 0.919096 1.122923 0.682195 0.948573 0.684101 0.822257 0.900682 0.969747 0.998896 1.031330 0.981000 1.116626 1.207464 1.514496 1.484110 1.685927 -0.131788 0.102608 0.256377 0.543811 0.846258 1.358549 1.270751 1.590115 -0.239901 0.243476 0.677754 0.899634 1.476294 1.901976 0.254194 0.661350 1.294177 1.496684 0.048409)
+
+ ;; 122 + 1
+ 11.250448 (fv 0.000000 1.302757 1.104016 1.882979 1.077650 0.053765 1.380440 0.003809 -0.046007 0.495357 1.519889 0.149797 1.197260 0.142817 1.219075 1.962202 1.461975 1.397810 1.755477 1.312034 1.459888 0.010987 1.489492 0.259453 1.259472 0.317472 0.521518 1.299213 1.226523 0.026938 1.296841 1.668722 1.337105 0.314301 0.330300 -0.438601 0.526089 -0.123698 1.469579 0.756219 0.172470 1.621261 0.778923 0.588722 1.542018 0.631414 1.527628 -0.038678 1.791364 1.687889 0.422304 1.584058 0.300597 1.413330 0.639674 -0.328087 -0.133739 -0.644241 0.881718 0.903075 -0.003259 0.764074 1.053115 1.364090 0.158374 1.544589 0.996921 1.813142 -0.279028 0.566236 1.039397 0.862143 0.979166 0.609771 0.860576 0.627137 1.959235 0.243884 1.018838 0.390319 0.475059 1.332423 -0.275526 0.611933 0.766476 1.331409 0.615945 1.094395 -0.004564 0.363420 -0.045135 1.527572 1.077299 0.997558 1.035936 1.286389 1.540261 0.059435 0.352601 0.552519 1.479640 1.199179 -0.317815 0.440438 0.336153 -0.013127 0.157566 -0.304297 -0.069647 1.901289 0.528335 0.359084 -0.007292 1.702466 1.215578 0.562997 0.913601 0.801948 1.409876 1.632172 0.750795 0.670695 -0.003034)
+
+ ;; 124 - 1
+ 11.087851 (fv 0.000000 0.624121 0.261315 1.181018 0.329816 0.723473 -0.058557 1.121126 0.418750 -0.560184 0.201221 -0.009188 0.964547 0.675383 0.540517 1.692402 0.238659 0.271713 0.649234 1.358679 -0.523949 0.096515 1.070752 0.415974 1.194076 0.398537 0.119705 1.390687 1.865110 0.657711 0.628353 0.094042 -0.039698 0.818092 0.264925 1.627819 0.564214 1.707948 1.323380 0.532853 1.528599 0.040464 0.169356 1.020624 1.633435 0.566927 0.135046 0.139973 1.154314 0.011466 -0.490861 0.640253 0.477507 1.036610 0.601286 0.864853 1.673244 0.103614 0.490773 0.239735 1.004984 0.751604 0.598287 0.049449 -0.383209 0.952738 0.587827 1.358167 1.134886 0.996730 1.062079 1.715631 0.870675 -0.669782 1.719322 1.286177 0.181430 1.375280 1.727572 0.723568 0.180864 0.793875 1.229108 1.479462 0.352987 0.476172 0.647844 0.506675 0.826807 0.037970 0.147029 -0.376170 -0.079080 -0.448861 -0.361893 0.784673 0.253239 1.081508 0.018537 1.194702 1.598635 -0.278698 1.403864 0.071060 0.431595 1.221066 1.608714 0.689332 0.715718 0.497216 1.832187 1.548074 1.325487 -0.697479 1.412701 -0.064789 1.545460 1.865863 0.574246 1.018052 0.826593 0.850894 0.538141)
)
;;; 124 odd -------------------------------------------------------------------------------- ; 11.1355
-#(124 15.930208950198 #(0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 0)
- 14.82254124518 #(0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0)
+(vector 124 14.82254124518 (fv 0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0)
+
+ 11.133385 (fv 0.000000 0.737767 0.242894 1.222279 0.471270 0.719745 -0.111581 1.125372 0.519029 -0.602995 0.207831 -0.019375 0.977253 0.730038 0.549277 1.736357 0.178856 0.378067 0.703036 1.285405 -0.440424 0.022976 1.081105 0.394590 1.176445 0.423028 0.024758 1.348044 1.875622 0.693243 0.631295 0.154785 -0.072026 0.840426 0.310333 1.680668 0.596016 1.796624 1.329261 0.552169 1.550621 -0.029191 0.120286 1.042346 1.643782 0.557105 0.100245 0.192082 1.115887 -0.044021 -0.568040 0.660295 0.446779 0.996296 0.543383 0.887166 1.696504 0.164237 0.565638 0.240616 0.980219 0.676086 0.528834 0.128308 -0.348116 0.973101 0.673237 1.259063 1.135685 0.928208 1.088345 1.731248 0.837036 -0.669991 1.701824 1.338691 0.198045 1.382482 1.748178 0.598583 0.174133 0.840707 1.239171 1.490991 0.324491 0.560298 0.680939 0.488255 0.866976 0.067351 0.114746 -0.374109 -0.011129 -0.482864 -0.335823 0.770685 0.238886 1.104919 -0.086380 1.175827 1.697828 -0.309033 1.420456 0.050528 0.410791 1.224188 1.576124 0.696620 0.749167 0.492507 1.752832 1.565235 1.317346 -0.708509 1.533585 -0.144615 1.567818 1.921771 0.617703 1.048643 0.900156 0.810098 0.470909 -0.287077)
+
+ ;; pp:
+ 11.348159 (fv 0.000000 0.420291 0.994113 1.605062 0.142556 0.741991 1.232518 1.818784 0.570117 1.112532 1.715041 0.498288 1.242193 1.903819 0.738569 1.440312 0.052035 0.859274 1.700608 0.416370 1.222707 0.007385 0.792200 1.771446 0.548685 1.661284 0.559436 1.442669 0.358986 1.258045 0.260744 1.254293 0.320180 1.305252 0.361287 1.403913 0.572629 1.603076 0.693636 1.846854 1.012682 0.188863 1.352443 0.397048 1.645973 0.881785 0.066704 1.295103 0.504646 1.870898 1.303297 0.570018 1.829957 1.080888 0.545590 1.923840 1.269013 0.679145 0.161303 1.594647 0.985227 0.464326 0.012233 1.568478 1.180634 0.730528 0.110665 1.618518 1.175834 0.879996 0.432189 0.136812 1.777876 1.490107 1.188949 0.907621 0.550479 0.242984 -0.059790 1.929821 1.371631 1.423168 1.146477 0.972409 0.858534 0.924887 0.595740 0.679411 0.488048 0.636418 0.072322 0.281040 0.204879 0.089915 0.287853 0.416670 0.453983 0.352329 0.503511 0.432486 0.571020 0.790600 0.687796 1.008010 1.155356 1.385540 1.648000 1.747132 0.045146 0.425981 0.717415 0.741128 1.002981 1.282324 1.660931 0.156386 0.411627 0.950904 1.417985 1.747974 0.260323 0.677519 1.016797 1.669557)
- 11.269365 #(0.000000 0.765878 0.249865 1.189803 0.492526 0.735853 -0.074165 1.122839 0.516182 -0.655750 0.121595 -0.080237 0.948560 0.652949 0.664271 1.784318 0.075012 0.359668 0.683859 1.356337 -0.401969 0.184774 1.103520 0.399349 1.207084 0.292056 0.109187 1.332057 1.779179 0.706809 0.682293 0.153433 -0.129300 0.766796 0.345672 1.676952 0.651229 1.754847 1.400567 0.576663 1.553672 -0.036434 0.163623 1.087353 1.591649 0.491903 0.098679 0.064382 1.081633 0.000351 -0.512780 0.720614 0.285651 0.866284 0.596878 0.977674 1.674208 0.118916 0.579190 0.350375 0.970936 0.702419 0.531412 0.091261 -0.376713 0.931147 0.625782 1.263288 1.142045 0.941163 1.129496 1.795522 0.957734 -0.660840 1.729495 1.265890 0.159429 1.331911 1.712163 0.648096 0.112260 0.834212 1.260988 1.428485 0.419734 0.495135 0.796723 0.482579 0.851839 0.069378 -0.019211 -0.366158 -0.019626 -0.447121 -0.290910 0.776747 0.219727 1.097436 -0.093494 1.229468 1.643850 -0.253939 1.342210 0.092571 0.368904 1.272299 1.540788 0.643503 0.780468 0.419732 1.721984 1.387510 1.313363 -0.587214 1.493599 -0.070747 1.541768 1.805608 0.634098 1.023768 0.929482 0.724974 0.500337 -0.207205)
+ ;; 125-1
+ 11.120334 (fv 0.000000 0.836933 0.196277 0.584882 0.301240 1.853484 1.324094 0.689541 0.969365 0.207127 0.815576 1.493174 1.646002 1.091372 1.338767 0.007260 0.223249 1.375996 0.396818 0.809290 0.595471 0.291935 0.828280 1.079040 -0.045835 0.055676 0.687157 1.387372 0.387604 1.113048 0.635795 -0.184152 0.086995 0.683755 -0.523880 0.957683 0.004250 0.887892 -0.247566 0.473338 0.863028 1.537875 1.279363 1.883742 -0.079415 1.606587 1.410357 1.815201 1.258365 -0.140836 0.062288 -0.117723 0.136197 0.025366 0.240444 0.337975 0.245314 1.565210 1.190385 0.061707 1.059358 1.066927 -0.243845 -0.140470 0.080704 -0.220916 0.436644 1.755266 1.123977 1.300903 1.292668 0.127266 0.478120 0.197515 0.674823 1.740766 0.286316 1.346417 -0.000673 0.759878 1.360448 0.328373 -0.116210 1.391350 1.022226 1.179474 0.838754 0.041237 0.614743 0.475843 0.203018 1.724933 1.421322 0.133569 1.485945 -0.070709 -0.071535 1.023240 0.511154 0.013014 1.379753 0.972914 1.226974 1.882336 0.135006 1.035934 -0.225880 1.034246 0.410768 0.390305 1.143196 1.223233 0.144114 1.611032 0.509896 1.218446 0.494123 -0.071045 0.511805 0.489583 0.116710 1.542243 0.745207 0.200411)
)
;;; 125 odd -------------------------------------------------------------------------------- ; 11.1803
-#(125 15.409635839002 #(0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0)
- 14.833 #(0 0 1 1 0 1 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 1 0)
- 14.82163143158 #(0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 1 0 0 1 1 1 0 0)
+(vector 125 14.82163143158 (fv 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 1 0 0 1 1 1 0 0)
- 11.143384 #(0.000000 0.846147 0.164682 0.565057 0.226437 1.867215 1.345991 0.693710 0.961142 0.219953 0.770784 1.602321 1.604302 1.034154 1.311897 0.093611 0.282846 1.337473 0.376913 0.846137 0.465370 0.349498 0.724439 1.139439 -0.106202 0.113415 0.655862 1.406998 0.488075 1.115563 0.791781 -0.180933 0.025661 0.673622 -0.402009 0.966899 1.822376 0.970010 -0.163262 0.486770 0.773247 1.663588 1.147924 1.935404 -0.055644 1.592256 1.404027 1.938125 1.296949 -0.074041 0.010910 -0.100766 0.155829 0.050205 0.227201 0.403635 0.389572 1.452148 1.063548 0.135341 1.038476 1.059297 -0.173332 -0.157889 -0.051033 -0.167668 0.369219 1.766155 1.166150 1.232749 1.256080 0.100141 0.389505 0.161519 0.702628 1.869992 0.233669 1.379632 -0.022923 0.664298 1.353499 0.393150 -0.083656 1.308694 0.973869 1.219737 0.824782 0.153464 0.584581 0.391814 0.296069 1.753981 1.427122 0.111509 1.354008 -0.063184 0.005094 0.989544 0.552729 -0.030673 1.397641 1.053529 1.231569 1.874380 0.104706 1.091384 -0.184506 1.107323 0.404388 0.372295 1.168150 1.222153 0.199039 1.547966 0.541724 1.118602 0.462067 -0.110972 0.498113 0.553358 0.177143 1.513083 0.771640 0.281912 0.492275)
+ 11.122080 (fv 0.000000 0.847003 0.165605 0.564848 0.227076 1.866949 1.345525 0.694388 0.959809 0.220564 0.772501 1.602410 1.604719 1.034958 1.311625 0.093909 0.283228 1.337145 0.377730 0.845137 0.466461 0.350583 0.723543 1.140286 -0.106738 0.112805 0.654453 1.405583 0.488341 1.115481 0.791692 -0.180702 0.024701 0.675117 -0.401907 0.966930 1.823188 0.970009 -0.163692 0.487827 0.774136 1.664048 1.147399 1.934923 -0.055579 1.590906 1.404741 1.937024 1.297324 -0.074406 0.012276 -0.101828 0.157087 0.049344 0.227099 0.402796 0.390545 1.452083 1.063131 0.134397 1.038993 1.058234 -0.172834 -0.157850 -0.051398 -0.166122 0.368524 1.765197 1.164117 1.233067 1.255917 0.100656 0.389203 0.162934 0.701475 1.871318 0.234658 1.379710 -0.022077 0.663615 1.352469 0.392445 -0.083922 1.307168 0.973714 1.219169 0.823481 0.152576 0.585169 0.393119 0.296805 1.754607 1.427512 0.110549 1.353534 -0.062637 0.005406 0.988733 0.551978 -0.032302 1.396422 1.051496 1.232496 1.873765 0.104448 1.090614 -0.186610 1.107217 0.405013 0.371843 1.166939 1.223105 0.199359 1.547104 0.541567 1.118832 0.462118 -0.111041 0.497800 0.551619 0.175381 1.513543 0.771791 0.282381 0.491699)
)
;;; 126 odd -------------------------------------------------------------------------------- ; 11.2250
-#(126 15.556811374771 #(0 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 1)
- 14.961482935205 #(0 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1)
+(vector 126 14.961482935205 (fv 0 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1)
- 11.342148 #(0.000000 1.281468 1.862018 -0.459193 0.876144 -0.574644 0.906933 1.273513 1.204771 1.696216 0.812472 0.901548 1.027365 0.904810 1.210038 -0.121356 -0.391867 0.384417 1.681688 0.697231 0.007100 0.098492 0.198551 1.624691 0.057244 0.836243 1.264174 1.546044 0.447305 -0.271114 0.140169 0.449181 -0.027372 0.902993 -0.293888 -0.061698 -0.134150 1.155096 0.858608 1.400544 0.921871 1.792294 0.066075 1.671362 0.522272 0.905187 1.691434 1.581734 0.385316 0.069337 -0.090015 1.966722 -0.119385 -0.079273 0.951609 1.104387 1.581857 1.512254 1.065102 0.031783 0.338050 0.240295 0.424608 0.004140 -0.050206 0.640253 -0.120787 0.798543 1.097040 0.064638 0.640347 1.256203 1.361163 0.892681 -0.162816 1.647320 0.537062 1.076976 1.180948 1.258693 1.482858 0.804314 1.272045 1.836843 0.612939 0.418467 -0.019665 1.315386 0.412786 1.621682 1.278477 0.864216 0.947485 -0.168352 1.445189 1.293279 1.161724 0.749547 1.562545 1.449270 0.386191 0.328840 1.663471 1.604040 0.900509 0.411887 0.838550 0.354174 1.412087 -0.197746 0.588069 -0.101978 0.793890 -0.203682 0.437240 1.008779 0.664899 1.138140 -1.860913 1.744488 1.211292 1.691539 0.714562 0.710108 0.049301 1.160155)
+ 11.217157 (fv 0.000000 1.333463 1.865492 -0.356718 0.933752 -0.563391 0.868454 1.227379 1.262853 1.734302 0.789925 0.887286 1.032388 0.794621 1.230657 -0.133505 -0.396357 0.347068 1.645124 0.776662 -0.030992 0.148253 0.191160 1.597265 0.105283 0.900423 1.230893 1.571345 0.370052 -0.251197 0.174670 0.404122 -0.082381 0.889967 -0.215160 -0.008260 -0.099660 1.159763 0.889422 1.423884 0.871705 1.850409 0.087109 1.706676 0.622672 0.936165 1.688780 1.528677 0.346829 0.012071 -0.088550 -0.030577 -0.043782 -0.058951 0.933603 1.070465 1.475594 1.531127 0.991234 0.010808 0.356054 0.157103 0.451907 -0.030459 -0.024818 0.523063 -0.129422 0.815521 1.075724 0.055269 0.750932 1.244054 1.306512 0.899391 -0.257291 1.664054 0.588171 1.065503 1.219153 1.371075 1.522174 0.737588 1.228742 1.773501 0.629941 0.387629 0.029457 1.398967 0.393091 1.680074 1.275817 0.905734 0.977246 -0.221887 1.339886 1.268897 1.260526 0.645165 1.510347 1.465708 0.394415 0.283387 1.630537 1.623821 0.888008 0.433073 0.790823 0.410278 1.398034 -0.237262 0.505122 -0.149516 0.721213 -0.202493 0.454561 1.014466 0.552452 1.112325 -1.848818 1.758603 1.154778 1.507049 0.724439 0.691362 -0.014103 1.227764)
)
;;; 127 odd -------------------------------------------------------------------------------- ; 11.2694
-#(127 15.055509004493 #(0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 1 0)
- 15.018874168396 #(0 0 1 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 1)
- 14.695912364919 #(0 0 1 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0)
+(vector 127 14.695912364919 (fv 0 0 1 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0)
- 11.322555 #(0.000000 0.473879 0.787022 0.357043 -0.211399 1.302405 0.979265 0.528856 1.325877 0.373340 -0.235386 1.365237 1.541040 0.437421 0.306914 -0.345119 0.310122 0.459038 1.248012 0.787512 0.390466 1.211679 1.373379 0.278579 0.874368 1.159162 0.281479 1.031672 0.845499 1.814398 0.628578 0.028324 1.633106 1.151873 0.117586 0.770614 -0.005011 1.824787 1.764778 -0.153287 1.156304 0.583993 1.021191 0.679024 1.346282 0.972016 1.222835 1.598064 1.158888 1.611938 -0.299835 0.374421 0.829790 1.184435 0.892331 0.396249 0.655278 0.947085 1.518575 1.770122 0.537206 1.073036 -0.350799 1.701841 1.246618 -0.270363 0.939948 1.600587 1.092618 0.967220 1.195889 1.104291 0.885768 1.738273 1.821206 1.254269 1.309480 0.576032 1.388476 1.398899 0.603695 -0.242503 0.161932 -0.053077 0.155406 1.510346 0.363401 1.024203 0.704014 1.171072 0.321470 0.632879 0.440021 0.053527 1.151385 0.439423 0.552249 0.546858 0.007630 1.397609 1.649035 0.817826 0.220821 1.527819 0.981956 1.737159 0.164097 -0.415413 0.809654 0.994440 0.913117 1.749903 1.629612 0.083617 0.215238 -0.022615 0.897952 1.225274 1.322453 1.294185 0.403513 0.776631 1.092503 0.230645 1.123789 -0.133048 0.973248)
+ 11.267676 (fv 0.000000 0.469645 0.796786 0.361018 -0.201613 1.310280 0.989111 0.525386 1.353693 0.378912 -0.241786 1.383164 1.533963 0.433890 0.325960 -0.352400 0.296358 0.481541 1.224829 0.787501 0.393768 1.211089 1.363561 0.247670 0.870376 1.154368 0.308126 1.041640 0.835212 1.804302 0.606799 0.022246 1.619342 1.154695 0.087857 0.758989 -0.028398 1.810844 1.763099 -0.171773 1.163226 0.592499 1.004685 0.695738 1.351120 0.977805 1.234286 1.609466 1.168845 1.598062 -0.321012 0.375057 0.817093 1.176853 0.878725 0.404937 0.672879 0.953648 1.504900 1.779440 0.534644 1.065489 -0.364994 1.703967 1.257601 -0.285618 0.908588 1.590737 1.087624 0.949190 1.204116 1.100315 0.879186 1.728483 1.796612 1.248626 1.298091 0.553842 1.379947 1.414383 0.591234 -0.228889 0.158060 -0.027394 0.157851 1.486700 0.372769 1.034786 0.707926 1.165159 0.328389 0.640197 0.421469 0.024384 1.129354 0.412245 0.531741 0.551732 0.008170 1.397227 1.653335 0.820170 0.216962 1.538735 0.975199 1.704359 0.157705 -0.426269 0.813101 0.999429 0.880927 1.743457 1.627725 0.094175 0.211869 0.002839 0.900464 1.204980 1.320644 1.281147 0.386967 0.783858 1.096686 0.213553 1.120859 -0.145308 0.996884)
)
;;; 128 odd -------------------------------------------------------------------------------- ; 11.3137
-#(128 15.527 #(0 0 1 1 0 1 1 0 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 1 1 1 1 0 1 1 1)
- 15.003612518311 #(0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1)
- 14.876242756695 #(0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1)
+(vector 128 14.876242756695 (fv 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1)
- 11.302721 #(0.000000 0.169054 0.661893 0.880173 0.278641 0.678856 0.931526 0.978280 1.757834 1.213451 0.532471 0.662818 0.739268 0.134190 0.797490 0.009706 0.269208 -0.271309 1.060034 0.186611 0.489445 1.368747 0.726848 0.527769 1.115514 -0.326478 0.463956 0.009548 0.770399 1.356255 1.649633 -0.164195 0.125641 1.581305 0.810517 0.338710 1.087586 0.719458 0.798741 1.008047 0.347018 0.103245 1.067850 0.727129 1.677359 0.476641 0.857341 0.768451 1.285937 -0.148932 0.784934 -0.156249 1.026971 -0.326797 0.615869 1.459954 0.958744 0.539696 1.327226 0.766200 0.624305 1.414204 1.474982 1.185762 0.205039 0.097700 1.022504 1.166100 1.463160 1.560728 0.623512 0.025319 0.729085 0.394451 0.085371 0.465431 0.159297 0.256213 0.366591 1.486743 0.280600 1.355319 0.252769 -0.135635 1.949501 0.311088 1.761593 1.294910 0.995409 0.872727 1.480219 -0.008747 0.772847 0.877287 0.044084 0.058796 1.345042 1.671249 1.462705 0.544517 0.020684 0.431165 -0.007958 0.984584 -0.206950 0.684900 0.875183 0.190295 0.615101 1.331921 1.330051 0.875717 0.442953 1.085734 0.978796 1.645667 0.546325 1.942183 1.536820 0.577980 1.062260 0.430888 0.394831 -0.094850 1.491668 1.197047 1.751280 1.711758)
+ 11.261196 (fv 0.000000 0.166552 0.658187 0.892812 0.275075 0.681304 0.935134 0.976324 1.751013 1.223679 0.531374 0.670158 0.738172 0.131342 0.784571 -0.001918 0.261947 -0.271711 1.074675 0.180917 0.495904 1.378525 0.720362 0.537440 1.116473 -0.311806 0.462073 0.021129 0.764859 1.361657 1.645691 -0.164691 0.135735 1.576068 0.824450 0.335134 1.099359 0.719625 0.791638 0.999013 0.348593 0.103014 1.062792 0.739933 1.675943 0.488371 0.860700 0.759566 1.276788 -0.135237 0.780818 -0.165115 1.024663 -0.327864 0.608127 1.454969 0.958609 0.555060 1.331156 0.762777 0.625297 1.411237 1.470303 1.190821 0.207444 0.108639 1.023133 1.165243 1.464221 1.564262 0.616076 0.019451 0.729986 0.402652 0.078552 0.454134 0.152695 0.263463 0.361958 1.475980 0.276689 1.365673 0.254488 -0.143709 1.946127 0.309551 1.760348 1.294342 0.981564 0.863637 1.477654 -0.019128 0.751338 0.878849 0.050601 0.063334 1.353561 1.669390 1.451518 0.535767 0.012898 0.428045 -0.011136 0.975409 -0.201088 0.677802 0.866124 0.188482 0.625213 1.342113 1.315837 0.879874 0.445664 1.081775 0.978490 1.662778 0.529736 1.946523 1.542905 0.571344 1.054205 0.430980 0.402697 -0.095096 1.487261 1.198691 1.754313 1.700742)
)
;;; 256 odd --------------------------------------------------------------------------------
-#(256 22.546259712247 #(0 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1)
+(vector 256 22.546259712247 (fv 0 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1)
- 19.779971 #(0.000000 0.287166 1.811728 0.003647 1.563327 -0.199797 1.748861 -0.027658 1.491523 0.358283 1.786152 0.407453 1.895896 1.702005 0.820432 1.443342 0.126567 0.528978 1.062681 0.144427 1.060071 0.368932 1.288502 1.669328 0.601969 1.609873 0.009521 0.796369 0.509981 1.904275 0.044862 0.614773 1.710675 1.495519 1.692276 1.250582 1.156222 1.594534 0.298597 1.684540 0.924734 0.804943 0.689590 1.177326 0.902799 0.909396 0.954254 0.261017 1.169485 0.938560 0.019866 1.334679 1.574350 0.442405 0.413355 1.552164 0.377894 1.422514 0.243015 0.559434 1.800624 1.468365 1.592498 0.584550 0.034812 0.293061 0.193868 1.089628 1.551790 0.037622 1.190818 0.318859 0.819004 1.851057 0.518624 0.663998 0.448473 0.066841 0.121442 0.912629 1.902379 1.968342 0.338155 1.260192 0.187056 1.823089 0.529718 0.076074 1.893909 1.177725 0.252346 0.193078 1.743428 1.843296 1.581080 0.130352 0.411188 0.552704 1.459730 -0.190870 1.185873 1.213912 1.881537 1.413927 0.390691 0.406250 1.645390 0.152258 0.066573 1.047526 0.945901 1.029638 1.224255 1.274278 1.742960 0.466865 1.882173 1.585879 1.499684 1.765278 0.688359 1.510365 0.729048 1.561332 0.482075 1.161051 0.635742 0.621496 0.237812 1.429801 1.538338 1.807873 0.866385 0.985705 0.165602 0.760224 1.891478 1.496052 0.933548 1.722668 0.466509 0.099331 0.101735 0.991972 1.628542 1.607529 1.751580 1.265628 0.234833 0.306012 1.365655 1.492678 1.262225 1.708575 1.110893 1.962624 1.207292 1.779446 0.254648 1.807960 1.406200 0.343366 1.203432 0.955798 0.389970 1.528111 1.208576 0.010439 0.869974 0.035552 1.208552 0.683287 0.473739 0.683814 1.317711 0.374975 1.738225 0.120217 -0.175098 1.582996 0.867052 0.692109 0.493305 1.718047 1.208498 1.811081 1.821705 0.654337 0.217531 -0.099005 1.010084 0.259226 1.288077 1.708184 0.570772 0.336605 0.604351 0.689981 1.178933 -0.158272 0.131307 -0.014422 0.959472 1.490474 1.313114 0.053727 0.366844 0.481538 1.929683 0.975977 1.124109 1.896357 0.758496 0.888582 0.159146 0.818597 1.655710 0.590078 1.621154 1.243084 0.695850 0.941639 0.608910 -0.136277 0.932800 1.416731 0.412678 0.218232 0.303734 0.129337 1.481931 0.515983 0.719833 1.705010 0.804065 1.067955 0.475270 0.737429 1.074355 1.333884 0.284629 1.317930 1.349354 1.980213 0.481352 1.075718 1.302558 1.547761 1.722849 1.882200 1.571505 0.804632 1.874854 -0.081974 1.014450 0.864487)
+ 16.932554 (fv 0.000000 0.299828 1.705033 -0.245282 1.517634 -0.512250 1.852696 -0.212031 1.625444 0.510314 1.972741 0.173230 1.725475 1.547901 0.804668 1.394746 0.173496 0.531764 0.731522 -0.060988 0.953386 0.234883 1.327931 1.710749 0.682372 1.593381 0.151697 0.696761 0.537335 1.969147 0.015426 0.808226 1.907797 1.558581 1.628528 1.165756 1.125630 1.795673 0.141122 0.016332 1.288127 0.941042 0.739123 0.972611 0.864761 0.875493 1.065737 0.205053 1.185762 0.863116 -0.053729 1.247127 1.771030 0.213109 0.203770 1.794944 0.080805 1.593027 0.197375 0.662307 -0.007433 1.307614 1.700096 0.641288 -0.016776 0.227057 0.210364 1.170957 1.587764 0.027010 1.239534 0.423010 0.803348 -0.009082 0.446764 0.636465 0.493264 -0.127025 0.112814 0.882192 1.818458 -0.107988 0.396084 1.293132 0.043609 1.657883 0.579794 0.180007 1.771600 1.131077 0.309105 0.137609 1.680511 0.060225 1.648041 -0.009446 0.270642 0.473937 1.608416 -0.014724 1.203911 1.240003 1.624613 1.562696 0.423323 0.330495 1.342929 0.063255 0.191341 0.910443 0.987286 0.949497 1.223867 1.261957 1.880192 0.302246 1.712139 1.779224 1.265963 1.777754 0.696982 1.379173 0.849932 1.580925 0.603387 1.028575 0.637130 0.740605 0.190997 1.448533 1.601710 1.704646 0.662313 0.835536 0.132357 0.868721 1.868738 1.555439 0.857103 1.813342 0.384273 0.308585 0.123611 1.182477 1.477561 1.678828 1.369057 1.213135 0.205042 0.425013 1.472803 1.396888 1.212323 1.858077 1.187399 0.010710 1.114100 1.840176 0.270787 0.093299 1.447701 0.449012 1.201616 1.113975 0.530506 1.655828 1.255713 -0.011414 0.956758 0.101851 1.223128 0.632983 0.423115 0.389217 1.423871 0.446874 1.820967 -0.029749 -0.443778 1.464394 0.868892 0.727400 0.578567 1.659072 1.017705 1.973528 -0.008925 0.757464 0.297947 -0.349297 0.883303 0.128256 1.200088 1.880227 0.584973 0.246525 0.618040 0.702249 1.255753 -0.329844 0.271022 0.297799 1.233191 1.390939 1.235027 0.303733 0.154150 0.491021 1.847433 1.056124 1.120988 1.805844 0.419548 1.016328 0.066448 0.893486 1.505832 0.702704 1.551981 1.267138 0.736198 0.947423 0.706820 -0.380019 0.873753 1.478444 0.561669 0.158253 0.016654 0.113131 1.644053 0.533397 0.826036 1.694860 0.852972 1.098260 0.229336 0.855766 1.051022 1.369585 0.520607 1.599761 1.473656 0.002020 0.572466 1.209260 1.275104 1.740654 1.738870 1.725547 1.490686 0.651000 0.118628 -0.196423 0.917329 0.845710)
)
;;; 512 odd --------------------------------------------------------------------------------
-#(512 35.541 #(0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0)
+(vector 512 35.541 (fv 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0)
- 31.627573 #(0.000000 0.641971 0.823435 1.073329 0.539150 1.644256 0.942410 0.791472 1.064522 0.907704 1.428794 0.001231 1.342358 1.365932 0.655059 1.273217 0.387305 1.151713 0.464556 0.040873 1.211746 0.565890 0.572488 0.447248 1.881382 0.212994 1.677831 1.225395 1.627225 1.565389 0.526112 0.810610 1.095356 0.987163 1.475014 0.670579 0.628158 0.893664 1.170671 1.124505 0.755854 0.300778 0.869316 0.919963 0.365823 1.723706 1.014851 0.498120 0.637194 0.352754 1.176211 0.866662 0.273392 -0.100029 0.834522 1.417914 0.163216 0.001094 0.094626 0.941186 0.740318 1.686733 0.919502 0.781344 1.668460 1.372868 1.926722 -0.013075 1.859527 0.808579 1.050819 1.202535 -0.065064 1.005084 0.221611 0.092920 0.014314 -0.126624 1.411892 0.640148 1.726499 1.132514 0.613199 0.879500 1.336432 1.600858 0.194537 1.580641 0.936076 1.506791 0.812228 0.638475 1.187229 1.635303 1.915488 0.799069 0.160834 0.881635 0.830638 -0.237466 1.203243 0.069071 1.015759 1.594863 0.741846 0.396797 1.024115 1.576269 0.297798 0.159265 1.736938 1.305428 -0.180384 0.324437 1.638834 1.298223 1.545155 1.094452 0.373838 1.545743 1.267383 0.175106 0.836172 0.339434 1.641107 0.308164 0.618412 0.020865 1.493642 1.738528 0.223837 1.728277 -0.001512 0.572589 0.109109 1.031926 0.299462 0.994195 1.218696 0.638982 0.509796 1.559371 0.148304 0.598851 1.007413 1.005303 1.318366 0.405786 1.262346 1.267264 0.506932 1.133813 0.475700 1.880509 0.789002 0.453480 0.239026 0.227558 1.059055 0.767671 0.566336 0.870093 0.650822 1.420300 0.752287 0.068587 0.289154 0.589494 0.967799 0.716662 -0.136748 0.894624 1.762980 0.374462 0.652941 0.795161 0.405835 0.987008 1.149128 0.792408 1.814055 0.946290 1.372088 1.420931 0.766271 1.803197 0.048647 0.842236 1.000451 1.426188 0.472345 1.886308 0.733469 0.500330 1.201671 0.533436 0.047414 0.185851 0.012020 0.210052 0.058992 0.149168 0.225954 1.275422 1.600178 0.027805 0.734000 1.142974 0.760770 1.247212 1.162280 1.726486 0.314615 0.098353 1.326208 1.035621 0.171545 0.304654 0.998041 1.758815 1.437338 0.710766 0.526788 0.043168 0.406921 0.608124 1.606403 0.893683 0.477997 0.000670 0.488634 -0.069036 -0.061680 0.112820 1.036929 1.548689 0.075054 1.741209 1.196178 0.352973 1.109566 -0.088309 0.774755 0.401376 0.242119 1.087618 0.068851 0.857888 1.221587 -0.019816 1.439372 1.169566 1.554426 1.678997 1.788747 0.784626 0.497675 1.010605 0.845773 1.777904 0.686256 1.393740 1.509084 1.190820 0.403592 1.261550 1.103977 0.536027 1.461863 1.261457 0.063297 0.362984 1.275933 0.945974 -0.109974 -0.203292 0.297974 1.745096 1.406757 0.680111 1.145314 0.780465 1.423008 -0.110897 0.521349 0.893654 1.653106 1.409408 1.732378 1.643879 1.021437 0.297832 0.198983 1.426222 1.445222 0.925063 0.860053 1.108162 1.379936 1.207276 1.543307 0.381530 -0.226848 -0.264262 0.012490 0.992932 0.864424 1.492055 0.915972 1.732040 0.817003 0.307476 1.352170 0.423888 1.329013 1.399071 0.992404 1.355255 1.651646 0.309776 1.671406 1.043917 1.869139 1.594136 -0.005031 1.744908 0.655800 1.327847 1.409992 -0.103359 0.063715 0.768347 -0.043384 1.369031 0.587208 1.037146 1.074892 1.093514 0.744290 0.053865 0.348258 1.204096 1.167382 -0.131176 0.694914 -0.167478 0.848484 1.882004 0.096415 1.570844 0.993590 -0.020994 0.913612 1.588955 0.704219 1.085327 1.546526 0.651243 0.540599 0.940847 0.628133 0.081446 1.846942 0.928486 0.107920 0.007586 -0.062816 1.188460 1.236358 1.495043 0.028409 1.657622 1.712531 1.879651 0.801929 0.276453 0.178559 0.124729 0.356095 1.077818 1.274958 -0.171551 0.461760 0.426529 0.303303 0.286626 1.048164 1.799901 1.036822 1.694543 0.305443 1.309533 1.256076 0.827871 0.345051 1.259048 0.783575 0.662862 0.523535 0.764332 1.439512 1.490591 1.277727 1.771280 0.968938 1.828813 0.616693 0.026985 0.630998 1.165842 1.604957 0.506658 1.643773 -0.010849 1.199100 -0.097492 1.070350 1.825319 1.071090 -0.091097 0.476000 0.246988 0.001741 1.570443 0.157951 1.654163 0.256397 0.418448 0.401357 1.115814 -0.163746 0.006042 1.620231 1.476353 0.625221 1.336783 1.237377 1.107035 -0.011244 0.501244 0.937261 0.874984 1.284656 0.415597 0.001246 0.170531 1.295187 1.042093 1.554322 0.772877 1.325785 1.217688 0.441610 -1.899803 0.043140 1.813774 0.405185 1.057689 0.374283 1.706719 1.083516 0.941168 1.031645 1.166947 0.663039 1.808751 0.239071 1.846075 0.787534 1.538073 1.752155 0.737674 0.162097 1.744119 0.626675 1.785334 0.656878 1.530504 1.882550 -0.066498 0.448671 1.407281 0.142294 0.329252 0.502527 1.533283 1.717776 1.422026 0.012518 1.271419 1.775104 0.652861 0.652894 0.475309 1.835944 1.609988 -0.142017 0.251089 0.591652 0.158013 0.883469 1.255936 0.571626 0.204126 1.716678 1.066841 0.807994 1.069000 0.686395 1.517494 1.291233 1.140441)
+ ;; from (try-all :odd 512 513 0.0057812032540294 1.0142361702487) = 28.7291 start for next
+ 23.716849 (fv 0.000000 1.386177 0.713008 0.003452 1.325461 0.665248 0.008142 1.314724 0.691474 0.066339 1.435981 0.804093 0.172765 1.522234 0.893751 0.277258 1.610102 1.005246 0.376177 1.775441 1.206877 0.615802 0.010188 1.376708 0.765127 0.173375 1.635776 1.029586 0.489561 1.940906 1.346730 0.810290 0.190213 1.646200 1.058365 0.502081 -0.085212 1.398947 0.892744 0.400807 1.903960 1.353268 0.833725 0.289010 1.806848 1.257743 0.707460 0.242200 1.750575 1.251783 0.742940 0.232633 1.756296 1.281177 0.783502 0.304115 1.846750 1.350399 0.916463 0.494039 0.029209 1.596080 1.095129 0.687317 0.229205 1.736704 1.290854 0.857342 0.417897 0.006810 1.604785 1.207241 0.745888 0.368498 1.939438 1.557313 1.176888 0.751323 0.345064 1.946256 1.587416 1.205053 0.847721 0.500526 0.105201 1.713914 1.348245 0.999166 0.643810 0.294307 -0.009291 1.648246 1.318017 0.946007 0.571567 0.250113 1.948602 1.641225 1.351970 1.040145 0.722431 0.402249 0.068667 1.761778 1.483321 1.168792 0.902292 0.622562 0.393716 0.071396 1.793757 1.520668 1.253207 0.968382 0.706598 0.478102 0.212208 1.966285 1.706429 1.495684 1.219831 0.986339 0.727326 0.553916 0.347750 0.133150 1.913130 1.701236 1.512062 1.283083 1.044773 0.859493 0.685612 0.480978 0.318075 0.155658 1.970256 1.731367 1.604854 1.456327 1.268574 1.110936 0.962304 0.806527 0.641956 0.496465 0.404452 0.274399 0.124501 -0.069746 1.814128 1.693756 1.567361 1.452982 1.402427 1.267889 1.106117 1.025358 0.944270 0.854118 0.753166 0.662874 0.577504 0.540814 0.454691 0.364705 0.334774 0.260515 0.174172 0.114008 0.059753 0.021108 1.967795 1.940561 1.926108 1.817829 1.816578 1.829230 1.763717 1.746146 1.768340 1.735638 1.694243 1.717300 1.700307 1.673492 1.703276 1.765354 1.728149 1.721871 1.792759 1.836518 1.790659 1.869572 1.931889 1.911416 -0.049508 0.040552 0.076661 0.124548 0.190446 0.213683 0.290047 0.374351 0.444676 0.515097 0.588488 0.695903 0.781037 0.806660 0.921756 1.050977 1.179273 1.276197 1.323471 1.440301 1.570781 1.698955 1.827110 1.973403 0.095016 0.228855 0.385876 0.488292 0.634453 0.804119 0.947283 1.092378 1.233063 1.412122 1.598977 1.789895 1.950360 0.140199 0.270111 0.484542 0.676076 0.875520 1.062416 1.258627 1.458192 1.707297 1.921954 0.119209 0.298949 0.581405 0.769515 1.026853 1.223167 1.513273 1.727029 -0.017306 0.209900 0.500939 0.701672 0.977279 1.216826 1.499384 1.779833 0.099435 0.337187 0.641811 0.927329 1.208595 1.453552 1.744657 0.045196 0.356852 0.724238 1.011858 1.349837 1.617935 1.987915 0.263154 0.637781 0.962300 1.293802 1.623598 1.910194 0.353508 0.625937 1.050232 1.343506 1.742985 0.092929 0.488000 0.864319 1.233651 1.609043 0.033469 0.414020 0.804580 1.109133 1.582193 1.963439 0.408246 0.805244 1.229890 1.616430 -0.005644 0.499002 0.871222 1.383619 1.742006 0.241871 0.636412 1.111292 1.523864 0.013426 0.430112 0.957489 1.390576 1.854792 0.298131 0.775965 1.336493 1.765508 0.284032 0.739560 1.225735 1.770015 0.245509 0.759950 1.283127 1.750994 0.271698 0.822357 1.329050 1.911458 0.424517 0.913054 1.452733 0.010207 0.507166 1.142838 1.653176 0.267116 0.766064 1.355041 1.954872 0.526119 1.075422 1.710371 0.220956 0.795713 1.455244 0.009017 0.572263 1.233742 1.805199 0.351214 1.029595 1.670810 0.244898 0.937764 1.599384 0.123281 0.827498 1.421956 0.071912 0.728628 1.352525 0.045071 0.629616 1.340343 -0.005599 0.656031 1.375774 0.006637 0.704005 1.346778 0.026276 0.793500 1.469628 0.149189 0.900114 1.563003 0.245092 0.942737 1.649937 0.383461 1.127594 1.833496 0.630173 1.303349 0.131274 0.795917 1.555017 0.354577 1.010369 1.836168 0.566636 1.392645 0.086446 0.905432 1.674552 0.357250 1.244274 1.933313 0.772802 1.613083 0.347109 1.198474 -0.009249 0.816204 1.581830 0.444697 1.252833 0.100839 0.820624 1.756368 0.556323 1.425952 0.202073 1.114604 1.862430 0.795077 1.577287 0.478129 1.375476 0.190400 1.049976 -0.001037 0.879181 1.750477 0.621432 1.466044 0.413933 1.258876 0.154463 1.083320 0.023406 0.861084 1.792442 0.739423 1.747839 0.555786 1.545715 0.467356 1.398174 0.305932 1.268574 0.245015 1.132661 0.145880 1.048422 0.017779 0.982729 1.923364 0.991511 1.957307 0.987170 1.902716 0.862590 1.910349 0.888567 1.920187 0.891111 1.886256 0.901663 1.918496 0.888352 1.914645 0.897685 -0.010739 0.984051 0.045577 1.089818 0.179909 1.199148 0.242854 1.360751 0.407503 1.407270 0.484554 1.541970 0.605558 1.705736 0.805033 1.904246 0.915747 0.018600 1.130323 0.275353 1.311301 0.394011 1.535459 0.601518 1.753472 0.894346 0.028620 1.161824 0.267287 1.447242 0.509507 1.658579 0.805465 0.032994 1.137888 0.321598 1.466044 0.648028 1.757642 1.015016 0.177874 1.323344 0.563863 1.750425 0.967203 0.229423 1.447094 0.698358)
)
;;; 1024 odd --------------------------------------------------------------------------------
-#(1024 52.508 #(0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0)
+(vector 1024 52.508 (fv 0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0)
- 48.812539 #(0.000000 1.519639 1.650443 1.195998 1.376729 1.899699 1.970244 0.812566 0.904608 0.600090 1.324454 0.983250 1.017466 0.767844 0.473656 1.362846 0.411668 1.143136 1.709002 1.799336 1.634334 1.127351 -0.096953 1.054946 0.631221 1.250117 1.431825 1.462402 0.392219 1.150149 0.361692 -0.007895 1.410301 -0.155259 1.559313 1.025404 0.848567 0.413175 1.206342 0.941843 1.655170 1.899345 -0.179528 1.520982 0.422331 1.843755 0.338626 0.259524 1.219677 0.928668 0.359292 -0.035002 0.292293 1.153387 1.456000 -0.123570 1.766526 1.738248 0.524497 0.103671 1.368994 0.239364 0.976560 1.227616 0.548531 0.854823 0.785093 -0.197237 1.336605 1.539099 0.835663 1.511255 0.962715 0.529653 1.142525 1.602263 1.389138 0.657746 1.560084 0.537641 1.281309 1.646253 0.540975 0.972241 -0.100372 0.678740 1.332669 1.561545 0.551248 1.375355 0.212979 1.193149 1.549790 0.906638 1.351033 1.793558 1.975586 1.399301 1.183386 0.721803 1.068055 0.343392 -0.284674 0.637779 0.099731 1.080489 1.644659 1.671862 0.243661 1.739989 0.343292 0.666143 1.387914 0.983866 0.682169 1.307094 0.441588 -0.079958 1.574357 0.516534 0.821922 0.946185 1.676179 1.618357 1.436315 1.560073 0.444652 1.752148 1.545784 1.140653 1.762060 0.454780 1.132888 1.286946 0.909353 0.217248 1.608014 0.408949 0.982308 0.842400 -0.210310 0.264674 0.498652 0.910983 1.178934 -0.004034 0.340697 0.615753 -0.136166 1.321752 0.263196 1.709158 0.839955 1.174310 0.322353 0.297043 1.553360 1.401766 1.007148 1.677521 0.741845 0.907691 1.276494 0.432523 1.605921 1.143725 1.756996 0.320225 1.288530 0.332776 -0.196583 0.603381 1.336746 0.086445 1.672621 0.890109 0.463938 1.357177 0.922958 0.697499 0.299459 1.219213 1.829846 1.943642 0.749969 0.829949 0.653853 0.398390 0.727336 1.275356 0.674723 0.748253 0.256595 0.201768 1.419157 0.468013 -0.030328 1.410807 0.229406 1.979323 1.794527 -0.016365 1.616308 1.369367 0.712107 1.706465 1.848255 0.226421 1.849134 0.380595 1.411511 0.299912 0.108735 1.186805 0.457520 0.271926 -0.067552 1.609142 1.431855 0.868110 1.197096 1.629939 0.035468 1.862078 0.753638 0.605706 1.277352 1.735611 1.272105 0.935222 1.246256 1.571576 1.870573 0.025272 1.040066 0.940302 1.227315 1.882565 1.396880 0.843794 1.345301 0.792983 1.395248 0.706526 1.661413 0.446114 0.907125 -0.062988 1.049496 1.071169 1.136989 1.421889 0.905366 0.518945 1.552620 0.983677 -0.059829 1.561292 1.006026 0.133199 1.906396 0.441897 1.763764 1.574203 1.360252 1.738862 -0.148160 1.201349 0.701943 1.000967 1.904072 1.310693 -0.020100 0.178949 0.724875 0.252065 0.310697 1.382325 1.227708 0.408125 0.958815 0.649841 -0.077987 1.301784 0.826432 1.474625 0.805014 1.200874 0.124273 0.639817 0.336398 0.230644 0.675556 0.205384 1.219305 0.297402 0.896968 0.099148 1.180783 0.995222 1.801650 1.005890 1.669304 1.555321 0.893841 0.076777 0.821684 0.103460 1.274312 1.641740 0.108476 0.474745 0.106818 1.121379 0.259728 1.241445 0.558062 0.844266 0.902584 1.679800 1.962091 1.160123 1.751210 1.564581 1.787630 0.017232 0.526177 0.946544 1.537788 0.162595 0.274043 -0.044734 0.870207 1.061828 1.973221 0.316719 1.874725 1.919981 0.798782 -0.079217 1.207291 0.982608 0.779931 0.543867 1.919099 1.476795 0.646670 0.139511 1.457573 1.694085 0.629716 1.716191 0.131491 0.664390 0.787058 0.586046 0.644992 -0.006434 1.389868 1.461697 1.509464 1.325643 1.325259 1.204176 1.780741 0.818762 0.535146 0.040136 1.734284 1.577489 0.131655 0.306406 1.644914 1.594499 1.639871 1.971222 1.349697 0.012654 -0.129510 1.611419 0.072394 1.749559 1.734331 0.117738 1.641966 0.797545 0.365172 0.268189 0.523823 1.624812 0.594331 1.509286 0.660606 0.244640 1.683550 0.574769 0.691397 0.958587 1.980250 -0.055636 0.626289 0.244708 1.483613 1.349865 0.598110 1.383298 0.003756 0.637659 -0.080158 0.676783 0.636104 1.458856 0.713675 0.532894 1.606586 0.019165 -0.068957 1.679326 1.139161 0.032928 0.191688 1.041482 0.050956 0.579658 -0.086398 0.011405 1.881689 0.667973 1.016102 0.664665 0.937454 1.751825 1.316685 0.124775 1.792093 0.746284 1.794429 0.643490 0.622783 0.556543 0.160050 0.107300 0.132343 0.640078 1.177660 1.821213 1.816797 0.766212 0.843537 1.824573 0.062901 1.724824 1.075620 -0.018658 1.030264 1.530522 1.314744 1.689721 0.324854 0.383385 1.535095 1.312333 0.745413 1.612902 0.986807 0.028575 0.527696 0.022035 1.685790 0.049529 0.258771 0.934595 1.292434 1.410893 0.805550 0.379555 1.953132 1.889999 0.256214 1.738588 -0.077133 1.023294 0.169218 0.252723 1.382993 1.154004 0.545944 1.321628 0.996409 1.398047 0.279943 0.403421 0.999037 1.888683 1.595423 1.628037 0.559370 1.693110 0.686705 0.382186 0.172950 1.892951 0.773946 0.976296 1.321030 0.111411 1.621968 0.153825 0.547817 1.789581 1.033120 1.189280 1.377718 0.724048 1.497776 0.211222 1.135220 0.266237 -0.119750 1.227078 1.763611 1.286882 0.019319 0.217713 1.199864 0.139524 1.574282 1.464184 1.150806 0.500220 0.119072 0.741896 0.924713 0.317970 0.222493 1.640251 0.523108 0.481320 0.822623 1.781413 0.213174 0.526517 0.784168 0.325984 1.630501 0.652451 0.316042 0.853892 0.706219 0.007041 1.327154 1.456855 1.828532 0.975735 0.357055 1.857690 1.354029 -0.002919 1.867148 0.775657 1.449311 0.258681 1.761863 0.655676 1.286698 0.401581 1.805723 0.089138 1.750159 -0.068260 1.189680 0.106126 0.502482 -0.049569 0.188084 0.806860 1.767305 0.783989 0.042035 -0.089529 1.620846 1.742942 1.638746 1.719033 0.620464 0.165571 1.198973 1.674614 1.772405 0.539545 0.054570 1.607511 1.487697 0.667428 0.150144 1.328158 1.098030 0.732064 1.431842 1.088525 0.593456 1.151458 1.172287 0.425020 1.182693 0.220969 1.859578 1.566433 0.923298 0.977581 0.362573 0.127506 1.222420 1.575324 1.416319 0.704553 0.751691 0.764554 1.478321 0.276418 0.260139 1.048863 1.597529 1.209535 1.071833 1.356900 1.823221 0.498971 0.746938 0.652020 1.900459 0.028526 1.481411 0.327912 1.079162 1.904872 0.898093 0.576127 1.484575 1.189478 1.135242 0.137399 1.126530 0.274352 0.797920 1.009056 0.338346 1.610297 -0.226829 1.631574 0.959330 1.320781 1.954762 1.442338 0.384065 0.746277 0.250366 1.096580 1.790088 0.003760 0.999329 1.147548 0.586431 0.599300 1.667488 1.279694 1.378872 0.759814 0.286225 0.889077 1.344080 1.453847 0.842622 0.487144 1.759146 -0.021070 1.741457 0.255220 -0.087000 0.379022 1.406398 1.296095 1.573207 0.547077 0.266035 1.220016 0.967606 1.841949 1.059298 0.545929 1.503344 0.057557 1.865376 0.175297 0.023235 -0.129818 0.081379 0.343826 0.309096 1.178139 1.234620 0.401212 0.247771 1.242728 0.215679 1.555335 0.391381 0.215626 1.318046 1.403085 1.109228 1.784926 -0.059823 0.366344 1.472272 0.134227 0.905526 0.317002 1.705593 0.778299 1.488104 1.866262 0.311398 1.071911 0.626873 0.238504 -0.012674 1.321815 0.134023 0.680665 0.878893 0.847214 0.978909 1.839554 0.440437 1.381565 0.402718 0.001953 0.405290 1.118864 1.625751 0.595378 1.714297 1.740414 0.774178 1.699347 1.192736 0.295696 1.260521 0.701036 1.140521 0.356675 0.978455 1.370680 1.420406 0.130293 1.653114 -0.018893 0.205569 1.517424 0.446663 1.261641 1.895881 1.784830 1.763404 1.312276 1.486071 1.216977 1.956752 0.167875 1.476998 0.857182 0.633043 1.109241 0.002331 0.823632 0.871605 0.377286 0.698788 0.438774 1.153781 1.232744 0.574432 -0.020814 0.677651 1.865215 0.654114 0.735767 1.621349 1.517040 1.717531 1.731811 -0.054153 1.877084 0.317175 0.457941 0.096350 1.311998 0.489681 1.413648 0.564409 1.706366 0.164517 0.790116 0.629520 1.107932 0.148285 0.249165 0.506282 0.500732 0.232053 1.264683 0.554141 0.156996 0.326906 1.494430 0.478989 0.922682 -0.195313 1.587851 1.760958 0.894217 0.283230 0.952266 0.740249 1.100321 0.880764 1.505061 0.604270 0.704770 -0.047172 0.511816 1.807854 0.422215 1.522333 0.963650 1.304077 1.666527 1.502872 0.589480 1.376377 1.698090 1.158540 0.370463 0.811208 0.347224 0.006019 0.975977 1.784091 1.823852 0.346739 0.110648 0.819458 0.262966 -0.022950 0.321824 0.959696 0.889141 0.219784 1.217523 1.828829 1.188780 0.642719 1.233994 1.041576 0.808517 0.545278 0.807380 -0.100107 1.389803 1.807516 0.153430 1.534635 1.483870 1.199173 0.558907 1.363742 1.066229 0.228446 0.249453 0.894989 0.990075 0.432789 1.489101 -0.125393 1.049266 -0.060522 0.592996 1.108054 0.556959 -0.010652 -0.122495 1.192843 1.419502 1.033551 1.312986 1.654147 1.925127 0.570975 0.668912 0.596661 0.829670 0.124816 1.442843 0.029297 1.031269 1.673783 0.961837 1.711478 0.674847 0.749091 0.236244 0.804937 1.696901 0.928621 0.764829 1.715576 1.230534 0.889448 0.986091 0.837907 1.573717 0.972857 0.317330 0.783659 1.499296 1.172750 0.024671 0.919212 1.526316 1.664955 0.823036 1.671347 0.781608 1.212905 0.794665 1.831645 0.704887 0.663996 1.716970 1.335391 0.027250 0.914860 1.219676 1.163079 1.499094 1.582351 1.784156 1.039722 0.794989 0.345994 0.696063 0.060440 -0.034531 -0.014465 0.729209 1.532895 0.872457 0.952792 1.406826 1.546432 0.813457 0.051863 -0.057923 1.613237 0.606250 0.434442 1.717713 0.718646 1.651523 1.780966 1.568871 1.319644 -0.013301 0.004435 0.210102 0.085420 1.825764 0.539987 0.842744 1.405067 0.388233 0.609273 1.790490 0.014141 1.051512 0.713006 1.582000 1.973531 0.351609 0.656460 -0.024499 1.169279 0.458410 1.325534 0.274793 0.654578 0.624672 0.130134 0.295107 0.020848 0.076070 0.118378 0.940751 1.186130 0.553624 1.471068 1.866328 1.822359 1.955424 1.788350 1.554351 0.750241 0.632195 1.295917 -0.114335 1.180616 -0.008546 1.109797 1.348653 1.327862 1.845807 0.705358 0.002658)
+ ;; pp:
+ 34.392721 (fv 0.000000 1.317015 0.674779 1.982962 1.240298 0.528350 1.833009 1.184236 0.493774 1.806145 1.182946 0.448825 1.821424 1.151757 0.480986 1.763416 1.095092 0.480961 1.791102 1.089742 0.425064 1.810482 1.139747 0.479199 1.851874 1.159831 0.593521 1.908566 1.257454 0.624639 1.923688 1.356173 0.730179 0.065917 1.453464 0.796504 0.143823 1.498311 0.930898 0.268139 1.670589 1.071439 0.437215 1.830479 1.211388 0.579275 1.944545 1.352798 0.782323 0.163213 1.546183 0.998593 0.372903 1.740779 1.173402 0.607928 1.957457 1.421061 0.794849 0.200913 1.627038 1.034849 0.443314 1.872228 1.278283 0.705912 0.120047 1.589838 1.008630 0.435503 1.873305 1.305243 0.750876 0.182690 1.613160 1.076228 0.522005 1.956954 1.342360 0.862346 0.285706 1.760264 1.217014 0.657381 0.105715 1.596004 1.072881 0.509956 1.989648 1.482549 0.909572 0.382452 1.811853 1.285963 0.790319 0.256573 1.787382 1.233231 0.764390 0.267593 1.710421 1.204241 0.717040 0.198483 1.666956 1.176156 0.629456 0.175734 1.712604 1.178350 0.682452 0.188929 1.683627 1.202732 0.719895 0.262572 1.790292 1.295239 0.795972 0.278798 1.833102 1.391719 0.903871 0.449916 1.974967 1.508707 1.037936 0.583107 0.141605 1.703044 1.238440 0.740044 0.299258 1.855225 1.429576 0.989596 0.514764 0.062488 1.647875 1.166263 0.761797 0.338506 1.886563 1.481742 1.044532 0.567257 0.147738 1.716688 1.294451 0.881968 0.450214 0.034958 1.623040 1.198786 0.793126 0.363888 1.989592 1.572534 1.171188 0.776534 0.389043 1.952235 1.569973 1.168583 0.777864 0.378289 -0.001325 1.586748 1.247726 0.850390 0.447022 0.074915 1.698680 1.326882 0.923704 0.565421 0.237083 1.853803 1.462394 1.056831 0.725010 0.363991 0.012216 1.652820 1.277504 0.885858 0.571701 0.222046 1.859385 1.459785 1.149298 0.900479 0.511390 0.159291 1.820323 1.458104 1.134095 0.799510 0.484897 0.157474 1.805324 1.476907 1.156786 0.816645 0.506771 0.217712 1.883199 1.597354 1.267437 0.968501 0.643403 0.348141 0.020835 1.704752 1.434890 1.117956 0.830415 0.530503 0.257242 1.947331 1.636892 1.333893 1.094111 0.807494 0.497231 0.208241 1.915803 1.637253 1.344506 1.123056 0.818815 0.558438 0.305779 0.033645 1.746424 1.518158 1.254602 0.968482 0.703273 0.446681 0.191633 1.923009 1.675267 1.476497 1.243700 0.963799 0.702657 0.470865 0.216712 1.947604 1.723443 1.524612 1.317633 1.059361 0.803260 0.606501 0.385543 0.151108 1.924868 1.695521 1.503299 1.281531 1.057219 0.859940 0.639048 0.449655 0.223761 0.026912 1.843647 1.609629 1.457584 1.243217 1.015301 0.856152 0.640867 0.449759 0.305372 0.109063 1.942683 1.700967 1.531585 1.369794 1.168417 1.002048 0.845104 0.663340 0.497202 0.326517 0.140599 1.976113 1.831407 1.680660 1.549301 1.318125 1.191866 1.065805 0.880646 0.703951 0.550638 0.452796 0.318542 0.141930 -0.012601 1.907136 1.768430 1.584977 1.494785 1.346262 1.172515 1.087240 0.966198 0.858840 0.703924 0.583577 0.474879 0.356476 0.197334 0.117696 0.015827 1.890727 1.784295 1.703630 1.595638 1.506189 1.428853 1.274571 1.233343 1.102367 1.018735 0.924053 0.785452 0.761105 0.689124 0.597680 0.499179 0.407270 0.343269 0.277076 0.175925 0.088491 0.032717 1.967765 1.919505 1.879027 1.804127 1.733139 1.641796 1.606538 1.554956 1.479897 1.436117 1.392760 1.340159 1.307310 1.256130 1.185964 1.154240 1.120113 1.056364 1.031418 1.011146 1.002760 0.949072 0.908672 0.908037 0.883988 0.852980 0.834564 0.819259 0.795425 0.760734 0.784982 0.783111 0.748706 0.732608 0.767981 0.770232 0.734127 0.724984 0.741588 0.719772 0.746177 0.752984 0.689077 0.730980 0.788291 0.778438 0.770103 0.834963 0.846761 0.844355 0.877284 0.886824 0.967748 0.943247 0.953145 0.998516 1.074936 1.134627 1.111633 1.183518 1.239447 1.257881 1.304163 1.349165 1.420127 1.460314 1.496520 1.556878 1.614974 1.710803 1.681591 1.773792 1.838949 1.957629 0.007509 0.060966 0.115693 0.179937 0.241468 0.370584 0.498441 0.512979 0.546150 0.672229 0.777236 0.837830 0.920719 1.012615 1.155268 1.230312 1.320616 1.421802 1.501826 1.610987 1.679360 1.836841 1.934427 0.048217 0.190841 0.256986 0.405599 0.477014 0.615469 0.744693 0.842741 1.035072 1.099483 1.194667 1.378972 1.515049 1.643373 1.758812 1.911300 0.069797 0.206668 0.341125 0.455780 0.613455 0.755668 0.907850 1.081007 1.195602 1.383308 1.535129 1.721055 1.878218 0.041536 0.189026 0.353901 0.557274 0.704028 0.848737 1.054909 1.205891 1.405592 1.560938 1.774026 1.957109 0.091600 0.275670 0.473243 0.686721 0.885668 1.094370 1.301170 1.471171 1.681947 1.843932 0.083106 0.309503 0.504329 0.657776 0.958045 1.134304 1.324317 1.567796 1.766909 -0.010677 0.204548 0.402525 0.672227 0.872133 1.100672 1.351290 1.618868 1.843408 0.075626 0.310891 0.533995 0.758681 1.049764 1.305644 1.509216 1.751579 -0.013073 0.274157 0.516916 0.787195 1.008768 1.270118 1.566936 1.844511 0.111113 0.352928 0.603624 0.891444 1.163881 1.458453 1.733841 0.023761 0.272991 0.561395 0.839977 1.118462 1.400784 1.742015 0.003935 0.343587 0.574049 0.863833 1.186411 1.499354 1.787869 0.097742 0.435769 0.722422 1.020105 1.302404 1.633505 1.971294 0.287332 0.601601 0.938262 1.263087 1.592727 1.925082 0.218290 0.545858 0.867906 1.215434 1.551258 1.932054 0.206490 0.558053 0.870542 1.249383 1.578868 1.965694 0.297948 0.669516 1.033694 1.365067 1.747836 0.132641 0.442218 0.763117 1.198426 1.557543 1.923389 0.271522 0.661990 1.014563 1.444192 1.797008 0.161991 0.524112 0.888782 1.298446 1.718909 0.076039 0.484430 0.839832 1.306121 1.668787 0.083313 0.435491 0.879913 1.257582 1.690719 0.080308 0.506436 0.891141 1.311805 1.764926 0.152722 0.559148 0.971038 1.448176 1.861615 0.252724 0.712441 1.076577 1.539614 1.971176 0.471842 0.835551 1.309070 1.717329 0.180700 0.636594 1.064174 1.544102 -0.007762 0.416278 0.869839 1.382020 1.815476 0.242696 0.711954 1.170869 1.650991 0.114702 0.570777 1.081829 1.495277 0.019284 0.487771 0.924782 1.480485 1.900085 0.404735 0.867120 1.327489 1.826631 0.358328 0.808934 1.333994 1.818046 0.333979 0.806858 1.380168 1.806454 0.359466 0.853343 1.382938 1.862803 0.340011 0.872790 1.396435 1.899417 0.442767 0.947972 1.493994 1.980445 0.529919 1.068138 1.589158 0.137689 0.663574 1.181143 1.752788 0.322938 0.820947 1.373072 1.889133 0.445963 0.992038 1.528221 0.095252 0.632298 1.198655 1.748035 0.297075 0.936319 1.444019 0.047595 0.589072 1.154608 1.695982 0.330959 0.852209 1.389811 0.077042 0.588685 1.198301 1.795185 0.391299 0.937105 1.523925 0.144908 0.714581 1.301387 1.939659 0.493164 1.107096 1.703099 0.316955 0.870409 1.501496 0.129186 0.711707 1.317045 1.978135 0.584637 1.224551 1.868953 0.442970 1.080315 1.707774 0.357018 0.974517 1.620426 0.235492 0.841352 1.521747 0.123410 0.790984 1.421592 0.064670 0.723003 1.351207 0.045603 0.693853 1.324941 1.912908 0.655177 1.230998 1.943702 0.623916 1.262813 1.966107 0.647728 1.291260 -0.014812 0.660846 1.298115 1.981874 0.677526 1.342226 0.031840 0.703622 1.442866 0.109986 0.793203 1.504134 0.206491 0.825844 1.597562 0.229750 0.978345 1.663467 0.352650 1.124308 1.766717 0.525984 1.219293 1.922574 0.634505 1.397287 0.124002 0.815463 1.541148 0.270810 0.971099 1.707596 0.437736 1.212172 1.890534 0.685239 1.396549 0.142117 0.918957 1.612171 0.353680 1.097854 1.856615 0.625689 1.360735 0.144106 0.868556 1.645077 0.371361 1.159444 1.934695 0.709026 1.444089 0.261765 0.979371 1.759253 0.586016 1.331408 0.040944 0.869861 1.656050 0.398966 1.230315 -0.011049 0.832509 1.590410 0.444043 1.224804 1.942115 0.805768 1.569036 0.391426 1.193271 0.004924 0.842160 1.602154 0.437188 1.258662 0.040043 0.863713 1.717625 0.507115 1.354811 0.156612 1.008626 1.821294 0.688919 1.479431 0.297482 1.146867 -1.810005 0.794603 1.643039 0.507902 1.394627 0.290315 1.060141 1.927240 0.768749 1.644777 0.486261 1.317365 0.218780 1.036302 1.922905 0.779349 1.630284 0.563756 1.406014 0.271501 1.141687 0.041164 0.874901 1.775827 0.668920 1.546772 0.364463 1.296432 0.170145 1.097114 1.973808 0.882000 1.792309 0.693487 1.612279 0.474678 1.407303 0.261600 1.229905 0.148970 1.031540 1.947561 0.833597 1.730941 0.706036 1.602109 0.526360 1.446317 0.373717 1.307908 0.239206 1.185883 0.110452 1.032954 1.964211 0.907562 1.815735 0.787542 1.710692 0.656401 1.632264 0.576380 1.564089 0.528884 1.469549 0.431489 1.360957 0.347473 1.293543 0.222180 1.220673 0.162142 1.148842 0.133424 1.094691 0.066720 1.019692 -0.006786 1.047790 0.011236 0.965321 -0.001627 0.937877 1.944261 0.948457 1.895707 0.938491 1.920374 0.874935 1.899449 0.872969 1.896569 0.903922 1.912216 0.936328 1.952448 0.974497 -0.020866 1.017959 0.034307 1.070969 0.074184 1.113113 0.135779 1.148879 0.214381 1.271662 0.291028 1.343329 0.357341 1.403370 0.477523 1.529396 0.455395 1.531182 0.601378 1.631083 0.711227 1.779155 0.803158 1.876551 0.904319 -0.035936 1.056817 0.081070 1.174378 0.241814 1.361054 0.443021 1.490091 0.588025 1.673301 0.764365 1.818515 0.913749 -1.572594 1.052243 0.145347 1.264925 0.396952 1.483333 0.517869 1.682100 0.797822 1.866022 0.903075 0.059188 1.174828 0.259185 1.333418 0.505568 1.549370 0.702792 1.812741 0.956324 0.074522 1.232362 0.362743 1.384904 0.593454 1.680361 0.825559 -0.014856 1.137655 0.232493 1.374902 0.524195 1.748587 0.847680 -0.019007 1.123158 0.242002 1.489181 0.571161 1.741577 0.879445 0.077203 1.250223 0.427139 1.517047 0.773877 1.934390 1.107301 0.293756 1.489154 0.668130 1.818952 0.975240 0.242147 1.451579)
)
;;; 2048 odd --------------------------------------------------------------------------------
-#(2048 83.108 #(0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 0 1 0 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 0 1 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 0 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0)
+(vector 2048 83.108 (fv 0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 0 1 0 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 0 1 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 0 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0)
- 78.937441 #(0.000000 1.689846 1.018490 1.611502 0.639207 -0.082787 1.592906 0.601026 0.457537 0.853588 0.246480 0.384884 1.166407 1.518233 1.610776 0.682841 1.354812 1.022675 1.260499 -0.112300 0.069724 0.538233 1.350546 1.731710 1.788711 0.798385 1.720292 0.552885 1.914312 0.083341 1.189678 1.001287 -0.016752 0.082208 1.635077 1.097941 -0.211066 1.915710 0.755430 0.377368 0.141690 1.508951 -0.063008 0.455045 0.203452 0.898819 1.541895 0.734814 1.350906 1.164589 0.953740 1.385840 0.788728 1.463142 1.354194 0.191281 0.579789 1.257225 0.559072 1.122363 1.468759 0.308060 0.535123 0.171149 -0.035758 0.383213 1.313251 0.349952 1.270535 1.135458 1.334934 1.890883 0.201654 1.594547 1.903186 1.646471 0.951539 1.635073 1.622014 1.631851 1.367584 1.552595 1.728701 0.503153 -0.095067 1.062992 1.535287 0.428952 -0.115113 0.904825 1.834421 1.316028 0.139571 1.862408 1.474241 0.357211 1.399016 0.565894 0.914744 1.336730 -0.021306 0.427360 0.982944 0.246389 1.520693 1.429115 1.795578 1.639579 0.993318 1.397084 1.476412 0.372916 0.127072 0.078109 1.452725 1.376697 1.742105 0.223687 0.910528 1.065049 1.633967 1.318213 0.850379 1.824021 0.982950 1.747574 1.683992 0.758363 0.534234 0.648109 1.761061 1.684306 0.998762 0.599534 0.636315 1.560104 -0.085181 0.292286 0.687333 1.315914 1.968365 0.498146 0.872936 0.750372 1.064806 0.913607 -0.281292 1.049262 1.431464 0.630016 0.070509 0.782794 0.040723 1.266929 0.098300 0.871494 1.325216 0.428614 -0.023960 -0.257052 1.568632 1.612023 0.370339 0.462301 0.888796 -0.048313 0.277648 1.743637 1.021040 1.635300 0.468648 -0.299562 1.640302 0.579774 0.064992 0.038520 0.939604 1.190498 0.120304 0.541286 0.541673 1.009244 1.560773 1.452497 0.646789 1.167337 0.164892 1.045596 1.183654 1.504427 0.689198 0.507543 0.474697 0.285834 0.591708 1.250029 0.879318 1.605841 0.233841 0.888556 0.769118 0.609719 0.005003 1.165066 1.500099 0.895021 0.312884 -0.181818 -0.210240 0.557941 0.168915 1.201735 1.729684 0.438679 0.710349 0.066805 1.172545 1.217293 1.790687 0.425805 0.600925 1.609051 1.095530 0.709253 0.066051 1.122549 0.360681 0.504521 1.391375 1.336403 0.056554 0.787635 0.366142 1.100069 -0.145467 0.490070 0.750042 0.057074 0.500767 1.115333 1.323101 1.500424 1.652321 1.578052 1.424819 1.991538 1.503509 1.341974 0.124773 0.286553 1.512043 1.195123 0.116467 1.495999 0.150475 0.027458 1.256602 1.914178 1.348946 0.392902 1.287852 0.230423 0.958003 0.103199 0.114147 1.300265 1.337726 1.960234 0.875466 1.375678 0.887083 1.091556 1.629083 0.517975 0.251541 0.586015 0.521301 0.456918 1.797111 0.628470 0.222309 1.874302 0.151586 1.270942 0.496347 1.704067 1.347411 0.882141 1.354015 0.482906 0.856096 1.842757 1.198720 0.849675 1.254644 0.826368 1.421665 1.565656 1.849673 0.296163 1.321414 1.594984 0.087468 1.904057 1.770304 0.793373 1.811382 1.738248 0.462200 0.809299 0.173428 1.173632 0.144430 0.424475 1.053220 0.438286 1.053618 1.341106 0.601239 0.987605 0.470342 -0.084584 1.657004 0.844639 0.225215 0.485905 0.210184 0.877181 0.051768 0.365625 0.433545 0.746015 1.265726 1.261056 0.846870 0.380347 1.777246 0.734969 1.263058 1.188062 1.231298 0.176469 0.633541 0.141868 0.355117 1.292107 0.788635 0.283102 1.491545 0.163836 1.840225 0.320653 0.924229 1.684915 0.457135 0.366316 0.874699 0.332267 0.811181 0.009053 1.707102 1.224700 0.647231 0.470735 0.285938 1.249680 0.848736 0.154419 1.302189 0.895984 0.384598 1.149654 1.339615 0.657930 0.197967 1.099859 0.240221 -0.153442 0.545081 0.929453 1.706713 1.972300 1.409127 1.618121 0.006566 0.576765 0.166203 0.440455 0.587109 0.296341 1.125394 1.573122 0.397018 0.779058 0.971743 0.402398 1.799594 0.038208 1.672239 0.269341 0.945851 0.650314 1.220807 0.761092 1.240143 1.289371 1.635050 1.213648 1.046902 1.318709 1.036745 0.879976 -0.197862 1.091013 0.799716 0.415004 0.529374 0.637845 0.383399 0.463124 1.542566 0.699920 1.623643 1.293281 1.800152 -0.015788 0.322487 1.117097 0.956307 0.996452 1.172323 1.326188 1.147377 1.113843 0.785183 1.575362 0.649795 0.523062 1.860141 0.223472 -0.063293 1.909246 1.736574 0.279197 1.477865 0.554212 1.260388 0.277292 1.918266 0.649419 1.792368 0.946606 1.286217 1.246372 1.179007 1.168477 1.733196 0.040035 1.869694 0.417707 -0.156793 -0.001456 0.649687 1.705122 1.327413 -0.139936 1.559127 -0.059925 0.722765 0.854277 -0.012595 0.185935 0.880412 0.884245 1.159530 1.868145 1.721058 1.444300 1.726310 1.551803 1.792034 1.663910 1.037587 0.549667 0.246300 1.919241 0.898305 0.864542 0.391918 1.169414 1.044794 0.943499 -0.018653 0.086991 1.211404 -0.409634 1.709608 1.558102 1.500905 0.023446 0.566640 1.586175 -0.075684 0.457930 0.590761 1.012075 0.155814 1.237055 1.774284 1.163196 1.795167 1.756188 0.853326 0.344718 1.331156 1.207746 1.380685 0.825802 -0.204853 0.528726 1.294224 0.820804 1.714428 1.655171 0.596704 0.807545 0.528328 0.170826 1.360744 1.164118 1.534691 1.959252 0.988720 1.825915 0.954587 1.225160 1.067375 0.648538 0.689203 0.574944 0.228763 0.739069 1.338497 1.522466 1.148973 0.666870 0.301196 1.345073 0.515258 0.304323 1.626868 0.573854 0.770224 0.922824 0.986235 0.208474 0.534145 1.448620 0.464703 0.329886 0.435022 1.080056 1.761027 1.393992 0.840270 0.262735 0.545578 0.566577 1.039111 1.013874 0.439128 1.378553 1.474475 0.078150 0.097586 0.430367 1.040096 0.267498 1.407214 0.720580 1.398352 1.906690 1.573703 0.691050 -0.001253 1.087465 0.916375 1.561718 1.104275 -0.024568 1.743167 0.657410 0.043592 -0.071737 1.277783 1.669473 1.445207 1.805207 1.084871 0.357552 0.482975 -0.129299 0.222610 0.964868 1.674946 1.111144 0.811232 1.444958 0.936872 0.630285 0.291784 0.547889 1.274707 0.491720 1.178913 1.597362 1.417560 0.905568 0.064594 -0.006279 0.681924 0.572009 0.510396 0.882066 1.337806 0.824705 0.900296 0.161452 1.480708 0.429205 0.998680 0.862028 0.872584 1.079492 0.049996 -0.061398 0.641068 1.223042 0.895426 0.016166 1.705578 0.370580 1.235064 -0.076644 0.016159 1.553502 0.272781 1.680527 1.735360 1.216306 0.022477 1.458031 0.335270 1.029615 1.390275 -0.072170 0.673519 0.918164 0.172376 1.873272 0.143937 0.143151 1.946490 1.050878 1.389078 1.718545 0.761876 1.584491 0.076813 0.426127 1.157282 1.665873 1.282022 0.297428 1.612887 1.525788 0.109507 0.850433 1.541619 1.906604 1.351349 0.712067 0.032909 1.741764 1.603154 0.331176 1.967791 -0.047457 0.458334 0.650869 1.822431 1.699982 0.392443 0.889921 0.738170 1.855018 1.469024 1.304174 0.145973 0.241900 0.483690 0.610548 0.244614 0.690385 0.625302 1.254416 1.724031 1.813264 0.692617 0.895372 1.588647 1.665977 1.093177 1.780833 0.040080 0.147953 0.452095 1.815039 0.610101 1.499230 0.418529 1.527535 1.809753 1.780717 1.208619 1.087756 0.044489 1.396951 1.008861 1.166751 -0.015608 1.040863 1.011715 -0.389544 1.669576 1.727841 0.409541 1.391926 1.267091 1.816381 1.266583 1.292674 1.538488 0.792896 1.144202 0.190028 1.168753 0.058544 1.008912 -0.033880 0.982838 1.145292 1.408490 1.218427 1.723407 1.907386 0.024240 0.720236 0.415344 1.872643 1.418392 0.399808 1.547256 0.227670 0.450452 1.674352 0.768133 1.757588 0.207193 1.366841 0.954998 0.102805 1.840467 1.672033 0.946903 0.828078 1.755832 0.884133 0.608293 1.688522 1.454057 -0.091730 -0.218085 1.430139 1.876307 1.361689 0.162513 0.428011 0.099895 1.496198 0.017040 1.527240 1.600076 0.702599 1.227307 0.445765 0.991653 0.193662 0.653609 0.032302 -0.082556 -0.076239 1.247906 1.725657 0.098284 0.458830 0.585844 0.788715 0.476530 1.571552 0.062623 1.411266 1.153636 1.113152 0.388102 1.666505 -0.010299 0.608357 0.002597 0.400810 0.236498 1.574672 1.024283 1.142883 0.739700 1.197592 1.569635 1.120229 0.086709 0.760356 1.446372 0.526550 0.983182 0.898425 1.210298 0.777244 1.126512 0.150391 1.780786 0.777891 1.141635 0.546798 1.666439 1.352269 0.900695 1.494562 0.579397 0.725360 0.320734 0.768538 -0.104320 1.309681 1.358290 0.178735 1.223322 0.916266 0.737696 0.608325 -0.024323 0.252577 0.022089 0.625930 1.055275 1.732884 0.450856 1.338871 0.564340 0.408611 1.468491 1.325711 0.758030 0.859666 0.600947 1.793976 0.169648 1.263140 0.822255 0.174901 0.291032 1.213018 1.398540 1.120993 1.022251 -0.023604 1.740733 1.244085 0.970147 0.777177 1.692535 0.188452 1.351635 1.161318 1.256602 1.751087 0.013196 -0.020020 1.265055 1.092603 1.917020 0.602027 0.227003 1.388828 1.812699 0.448303 0.993327 1.552104 0.642990 0.227204 0.536533 -0.171320 -0.037833 0.286305 1.107339 1.082198 1.823262 -0.118176 1.508469 0.574280 0.745998 0.151052 0.343717 0.754622 0.850362 0.188574 1.308237 0.557021 1.622333 0.740050 -0.106173 -0.036187 0.929924 1.028599 0.128394 0.655953 0.554832 0.478155 1.700954 1.480740 0.692557 0.784791 0.538025 1.181506 1.027617 1.061888 0.554753 1.885562 0.427859 0.878171 1.705383 1.731963 1.584336 0.604257 1.269572 1.224752 0.395571 1.377190 0.473402 1.037091 1.321103 0.241379 0.536589 1.212185 0.436461 1.328625 1.400157 1.301094 0.177789 0.219838 -0.214149 1.529232 0.144458 1.192349 1.282177 1.056078 1.550038 -0.173016 0.100030 0.265853 0.645390 0.923329 0.085731 1.043286 1.818031 1.237997 1.530902 0.423281 0.255900 0.058007 1.501958 0.593022 0.868580 1.054524 0.798523 1.892550 1.536475 1.470470 1.466108 0.333749 0.753592 0.381069 0.805574 -0.083849 0.230417 0.524273 1.576543 0.796882 1.326149 1.468547 0.883022 1.145331 1.129588 0.767485 0.714530 -0.051568 0.381323 0.900830 0.938250 1.115005 0.803678 0.478197 0.102689 1.790473 0.186175 1.138002 0.407343 0.081624 -0.078497 1.907566 0.568199 0.206528 0.698892 1.618703 1.116152 1.630912 0.735694 1.657675 -0.029995 0.597313 -0.074403 1.651119 0.671345 0.428239 0.340794 0.303227 1.221853 0.149125 1.845223 0.690593 1.519544 0.570921 0.378247 1.959188 -0.007756 0.533438 1.355284 0.385166 0.748448 0.519275 0.121959 0.127587 1.048075 1.696453 0.957310 1.509362 1.558839 0.717115 0.377524 0.867385 0.483117 1.383031 -0.097048 1.840125 1.664936 1.781564 0.631422 -0.103132 0.403964 1.771127 0.746246 0.918520 1.169435 0.737263 1.212805 1.178431 0.492576 0.605805 0.341944 1.377818 0.931836 0.529464 1.388507 1.052530 0.254824 -0.081377 0.937911 1.308701 1.681287 1.041637 0.101439 0.808291 0.144335 0.199211 0.907294 1.556385 1.606147 0.993618 0.565487 1.805140 0.626057 0.297878 0.108579 0.333362 0.383693 0.664077 0.780133 1.818635 1.485239 1.804957 1.845173 0.759440 0.296443 1.827938 0.708014 1.691701 0.097561 1.790460 0.002644 1.363152 1.554413 0.128835 0.088458 1.075820 1.662939 0.305822 0.097597 0.951771 0.612277 0.927043 1.564098 1.633525 1.149458 0.821430 0.621419 0.295695 -0.035046 0.526376 1.760242 0.054878 0.643260 1.248458 0.803343 1.623275 0.668091 0.657572 1.121589 1.524828 1.183610 1.417931 1.405314 0.536478 0.777992 1.514447 1.406728 1.296213 0.977414 1.302449 0.188034 0.494615 0.604689 1.593324 0.321907 1.433822 0.820379 0.896724 1.841162 0.648542 0.849222 1.488341 1.646264 0.422691 1.202526 1.552600 1.286227 0.205148 0.977204 0.071457 0.072226 0.854723 1.474934 0.490317 0.994710 1.695319 0.149264 1.945845 -0.050080 1.100174 1.428384 0.392919 1.388543 1.470599 1.687390 -0.209425 0.981376 1.820625 1.486939 1.163029 0.254903 1.663587 0.173397 1.158270 0.008252 1.527331 0.957022 1.565874 0.399190 1.405211 1.610452 0.517417 0.017736 1.604007 0.441982 -0.117242 1.540578 1.122133 0.783699 1.475956 0.425079 0.061031 1.809454 0.020958 1.791601 0.082641 1.232839 0.787976 0.330191 1.079316 0.726671 1.154152 0.664516 0.651535 0.733283 0.178061 1.170989 1.021345 1.431385 1.099593 1.694602 0.959398 1.896463 1.048918 0.980361 1.074828 1.193343 0.231910 1.142775 1.514885 0.820666 1.664680 1.082302 1.454204 1.588263 1.689028 1.772394 1.918052 0.740639 0.483110 0.712257 0.069489 0.905804 1.535153 0.363147 1.835617 0.006427 0.899992 0.380714 1.396011 0.685106 1.823151 0.493868 1.604512 0.224912 0.847624 1.141404 1.562281 1.012902 0.067857 0.682509 1.253834 1.124161 0.614664 0.283374 1.613595 1.434018 0.305996 1.201243 1.266871 0.838092 0.076908 1.420109 1.146620 0.622686 1.115452 0.924323 0.974351 0.825545 1.439257 1.047256 0.983947 -0.023433 0.739378 0.058896 1.009265 0.099088 0.208031 0.584839 1.555592 0.199829 1.098928 1.389603 0.203500 1.217365 0.487433 0.522761 1.901220 0.024564 0.335503 1.627773 0.511258 0.181775 1.136641 0.858910 1.135934 1.389248 1.254197 1.570636 0.887318 1.421787 1.619915 1.382710 0.324584 1.154740 1.550762 0.651293 0.306905 1.355501 0.026583 1.261312 0.455843 1.440013 1.036724 1.152275 0.920599 0.682892 0.672700 1.070057 1.453899 1.087117 1.098307 1.315810 1.292233 0.819280 0.701348 0.997834 1.209758 1.168699 0.077635 0.868252 1.083290 1.930890 0.353494 1.250223 0.310608 1.253033 1.727092 -1.975097 0.941442 0.539454 1.355973 1.005988 0.701618 1.813894 1.775295 0.242359 1.510528 0.986700 1.547890 -0.012287 1.356305 1.522370 0.878012 1.294380 0.155478 1.042814 0.348062 1.188096 1.135315 1.520515 0.878021 0.622847 1.073612 0.317276 1.370638 0.685988 0.992102 1.497485 1.458836 1.101655 0.035966 1.192860 0.380699 1.178862 0.618449 0.213396 0.559044 1.830349 1.447613 0.780973 0.149827 0.000783 1.578653 0.246629 0.619069 0.870396 1.009880 0.007773 1.529581 1.531002 1.437893 1.160448 0.240842 0.009787 1.814160 1.271699 0.449839 0.395650 -0.113986 -0.067771 0.643784 0.033350 0.664053 1.167828 1.330358 0.974541 1.039259 1.278764 0.649775 1.807600 1.456944 1.297261 1.733868 0.415873 -0.032983 0.865685 0.984468 1.747983 1.754950 1.624645 0.955834 0.669497 0.707638 0.496434 0.214751 0.573953 1.537258 1.920697 1.147869 0.279585 1.887307 1.463413 0.319350 0.444741 1.008618 1.021958 0.435657 0.185043 1.371241 0.855151 0.505792 0.741886 0.871680 0.370576 1.264162 1.034020 1.020442 -0.032455 0.151317 0.930427 1.250914 0.457365 1.711895 1.622588 1.474334 0.727044 0.158372 0.547219 1.964062 0.960274 -0.043104 1.429620 1.502524 1.799005 1.879995 0.965812 1.601466 -0.115173 1.786859 -0.082629 1.571997 0.151759 0.116636 -0.138644 1.220180 1.544541 0.711250 1.337424 1.122127 1.265975 1.641180 0.369341 0.941194 1.756270 1.554377 0.421053 0.367857 1.468897 0.120653 1.868696 1.648081 0.013217 0.546092 1.094144 0.662116 1.286971 1.508045 0.588153 1.236472 0.589536 0.744566 -0.014088 1.541068 1.703645 1.335776 0.751643 1.645108 1.835447 -0.004121 1.225363 0.415798 1.680503 0.651280 0.657478 1.380731 1.366587 0.360555 1.416929 0.218857 1.003629 0.196413 0.458188 0.219018 0.371207 0.792944 0.732561 1.096142 1.517356 0.544260 0.244358 1.027194 0.914613 -0.264228 1.386405 0.399853 0.192045 -0.056645 0.448320 1.168258 0.216500 1.282546 0.378607 0.437151 0.271768 0.227147 0.947933 1.169574 1.692082 0.352268 1.556365 0.430126 1.874195 1.391513 1.410537 0.937927 -0.099725 1.350224 0.198315 0.235114 1.785468 1.268030 1.467114 1.142498 0.972180 1.325000 0.953697 1.637360 1.870641 0.094691 0.308883 0.051680 0.986847 0.571862 0.079983 1.563896 0.588847 0.287709 0.038406 0.213414 0.278655 1.462399 0.910186 0.949603 0.231716 0.110559 0.750252 1.849528 -0.017336 1.351536 1.030800 0.135700 1.350730 1.752152 1.144277 0.825775 0.482093 0.451732 0.553985 0.050941 1.589921 1.226160 0.121789 1.892118 1.514707 1.947830 1.899008 0.106199 0.095068 1.481495 0.637728 0.793037 1.046402 0.656131 0.981478 1.645677 1.692830 1.201035 1.580738 0.862287 1.857116 0.752617 1.140952 0.535734 1.166873 1.813586 1.358043 1.562120 0.887429 0.453656 0.808900 1.329005 1.880473 1.667600 0.168656 0.082993 0.554744 0.113094 0.184322 1.116499 1.257143 1.463536 0.845188 0.753503 0.545217 0.808865 0.734823 0.010412 0.637141 0.721788 1.206453 1.725305 0.835897 0.641933 0.849589 1.122095 1.122129 0.082734 1.852811 0.736282 0.466664 0.727515 1.164618 0.912293 0.714009 1.682613 0.400246 0.931132 1.423104 0.690233 0.402124 0.519093 0.013658 1.495360 0.513651 1.911956 1.531564 0.638779 1.926638 0.085423 1.244383 1.405098 0.240999 1.024934 0.085108 1.136585 1.354954 0.694244 0.147529 1.114749 0.327110 0.099190 0.519456 1.197549 1.441452 0.985099 0.496182 0.344015 0.311060 0.341567 1.223570 0.104840 1.555720 0.310844 1.427243 0.253303 1.861208 0.751524 1.176798 0.011549 1.520196 0.725046 1.248869 1.766864 1.132848 0.788957 0.794897 0.471681 1.719229 1.386139 1.274509 -0.039519 1.527659 0.844650 1.774762 0.707953 1.216432 1.474809 0.078357 0.551012 1.506891 1.599422 0.243091 0.153408 0.457904 0.924834 1.678234 0.096402 0.949920 1.821400 0.824671 1.452500 1.524634 1.003177 1.464511 1.816518 1.713961 0.863097 0.517152 0.758012 0.136979 0.120142 0.690421 0.223639 1.498008 1.562219 1.678837 1.627798 0.839019 1.132131 1.535145 1.518018 0.297419 0.203623 0.546133 1.052566 0.784445 1.055616 0.148830 1.720326 0.140740 0.266692 1.425404 0.783229 0.124041 1.494743 0.644046 1.644611 0.750264 1.828214 1.787737 0.538946 0.550047 1.183492 1.041592 0.959210 0.270846 -0.035403 1.739175 0.534984 1.624026 1.611428 1.579430 1.022286 0.855608 1.828514 0.038338 1.291444 0.134507 1.254891 0.596733 0.399162 -0.114539 -0.055887 1.938324 1.170327 1.087488 1.697423 0.478833 0.757412 0.171117 1.059573 0.635458 -0.161792 1.015750 1.708417 0.270384 0.660484 1.333092 -0.030724 1.713327 0.151431 -0.174953 -0.041691 0.300599 0.725691 1.065660 0.588839 0.723013 1.086514 1.665008 0.904689 0.943094 1.548079 1.780577 1.098286 1.413405 0.080554 0.679165 0.451513 1.625382 0.791710 0.263149 -0.161505 1.192182 0.992099 0.009485 1.008730 1.535096 1.036929 1.297483 1.822460 0.975063 -0.085459 1.420746 0.376603 0.192391 -0.220597 0.389186 1.323278 0.098973 0.116023 0.308756 0.430429 1.250750 1.912196 0.463174 0.133615 1.184156 0.919106 1.188101 0.221491 0.139415 1.695088 1.043669 0.180492 0.167037 0.186236 1.544480 0.189182 1.816467 0.395217 1.129900 0.056081 1.599691 0.956415 1.935582 1.752012 1.235924 0.567385 1.236629 1.378551 -0.032682 0.967778 1.161775 0.439121 0.146630 0.210634 0.838256 0.256489 1.849426 1.034341 0.180033 0.002728 0.460610 -0.059008 1.026499 0.239384 0.014096 0.253629 1.317847 1.430188 0.739864 1.356334 0.501333 1.570755 0.964145 1.279445 0.064247 0.367146 1.924309 0.038641 1.441898 1.500527 0.252632 0.522914 1.127721 0.149886 0.482652 0.742163 0.866292 0.415201 0.038035 0.581754 1.410195 1.305935 1.399564 -0.002591 1.315112 0.506490 0.634606 0.712693 1.491569 0.763732 1.133934 1.646626 1.199255 1.255783 0.793887 0.463719 1.274033 0.646579 1.299227 0.074139 1.517832 0.680066 0.556593 0.198377 0.731884 1.265722 0.273535 0.174173 1.643091 0.233723 0.835886 0.331656 0.841667 1.950204 1.700806 1.493564 1.992014 1.047484 0.056101 0.246552 1.178977 1.446793 0.909130 0.666524 1.743752 -0.065462 0.647845 1.528075 -0.027380 0.892732 1.060713 0.961817 0.819512 0.522143 0.761281 0.549432 0.374579 0.281346 0.405971 1.961061 0.861053 0.951913 0.894288 0.120547 1.199477 1.578494 0.905148 0.153248 0.867220 0.425392 0.982660 0.841154 1.540130 1.454289 1.585546 1.708407 0.786107 0.741469)
+ ;; pp:
+ 49.287435 (fv 0.000000 1.163050 0.277646 1.373554 0.532725 1.655947 0.820565 1.927219 1.072745 0.213781 1.356870 0.485766 1.631061 0.742006 1.904473 1.072791 0.168162 1.327500 0.482508 1.618303 0.771705 1.904773 1.075185 0.215222 1.331659 0.505811 1.654486 0.806874 1.967453 1.148945 0.298519 1.468811 0.620677 1.776228 0.916764 0.084037 1.276979 0.394330 1.564305 0.749970 1.921810 1.121962 0.283495 1.432158 0.569765 1.736470 0.945747 0.080800 1.281360 0.443507 1.625343 0.807138 1.931288 1.158701 0.321739 1.530411 0.700718 1.890240 1.080826 0.244264 1.426463 0.600267 1.774421 0.956059 0.179462 1.370744 0.545050 1.731587 0.953856 0.145408 1.309295 0.511421 1.720420 0.940468 0.138677 1.323833 0.526937 1.717512 0.960485 0.118979 1.328593 0.512297 1.743197 0.943001 0.142257 1.379625 0.549098 1.794241 0.979771 0.180869 1.419130 0.639674 1.850039 1.057471 0.290050 1.461420 0.718417 1.916269 1.159248 0.376289 1.563835 0.838106 0.037452 1.264868 0.508203 1.717190 0.935903 0.151060 1.445292 0.635249 1.867259 1.091222 0.317894 1.534564 0.808426 0.018427 1.266394 0.501751 1.761251 0.969688 0.237229 1.447668 0.716233 1.967410 1.198658 0.437002 1.692103 0.935631 0.200934 1.451676 0.665324 1.935418 1.194689 0.438772 1.699157 0.941183 0.203098 1.450490 0.729357 1.974455 1.213355 0.514075 1.770795 1.016076 0.295868 1.541971 0.834628 0.084952 1.374773 0.619458 1.894143 1.155880 0.407649 1.664716 0.945886 0.261286 1.509195 0.790733 0.047158 1.339941 0.639173 1.891712 1.178155 0.440268 1.738740 1.006239 0.332871 1.560537 0.905839 0.183339 1.475973 0.742124 0.065572 1.351730 0.625747 1.922985 1.191379 0.495991 1.756410 1.042066 0.381601 1.688479 0.992449 0.276849 1.595880 0.892119 0.200958 1.480411 0.818652 0.063966 1.413208 0.715156 0.060494 1.306176 0.640302 1.933579 1.251340 0.581804 1.880299 1.222695 0.508151 1.829141 1.161265 0.457492 1.752607 1.117371 0.435825 1.739733 1.091313 0.385593 1.723501 1.053105 0.375468 1.675086 1.049746 0.382492 1.691106 1.002188 0.342988 1.668975 1.033939 0.350582 1.709840 1.039364 0.383857 1.699746 1.051825 0.373545 1.743567 1.077799 0.434091 1.756970 1.053381 0.443137 1.778145 1.141987 0.502378 1.868431 1.182592 0.530883 1.877105 1.221950 0.588162 -0.002020 1.300304 0.652550 0.036320 1.381929 0.759328 0.108443 1.476502 0.816837 0.213269 1.571344 0.932844 0.309569 1.662539 1.059667 0.419312 1.755499 1.147048 0.543079 1.922420 1.264945 0.657934 0.013132 1.401680 0.801987 0.158358 1.552678 0.920579 0.315474 1.699024 1.059115 0.446156 1.851458 1.209975 0.614230 1.975779 1.374097 0.796121 0.175298 1.591247 0.945333 0.354628 1.747078 1.154595 0.559485 1.967019 1.333396 0.720565 0.122103 1.526595 0.940456 0.327202 1.755683 1.117391 0.561694 1.958381 1.361193 0.803458 0.184110 1.616629 1.006925 0.442089 1.829688 1.261188 0.655027 0.090202 1.509923 0.945564 0.313543 1.753214 1.130948 0.568508 0.031964 1.450068 0.852461 0.283077 1.729985 1.127584 0.580935 -0.001861 1.435678 0.878175 0.293173 1.719785 1.184765 0.606034 0.040632 1.478744 0.942562 0.348499 1.801185 1.227587 0.696736 0.112509 1.564761 0.997649 0.448218 1.895579 1.324465 0.786873 0.273294 1.679282 1.152398 0.603084 0.027394 1.495848 0.964252 0.380193 1.852378 1.306385 0.788058 0.249156 1.687499 1.121997 0.611298 0.090174 1.559009 0.973272 0.464823 1.921940 1.378762 0.867253 0.345833 1.810423 1.301030 0.744928 0.252599 1.735986 1.205901 0.677471 0.145109 1.614381 1.080917 0.586366 0.083099 1.542748 1.001440 0.520731 0.003110 1.438773 0.930269 0.427623 1.972229 1.416238 0.940471 0.422555 1.905093 1.411628 0.878267 0.378282 1.870882 1.386240 0.872844 0.369185 1.888119 1.372843 0.868051 0.364903 1.849288 1.377695 0.870674 0.392638 1.894252 1.393508 0.953494 0.447692 1.964212 1.461256 0.958900 0.491909 0.001252 1.522315 1.032375 0.545182 0.047665 1.604571 1.102550 0.587351 0.146687 1.653910 1.193132 0.725831 0.238418 1.753114 1.296242 0.838033 0.349570 1.877468 1.384694 0.938419 0.481820 0.045217 1.557648 1.099375 0.609911 0.138825 1.670480 1.217161 0.761162 0.340569 1.849982 1.398484 0.929634 0.476983 0.033188 1.587225 1.150229 0.660516 0.218545 1.773455 1.321194 0.875537 0.412455 1.975569 1.556914 1.085507 0.655478 0.222974 1.781550 1.346518 0.898635 0.461489 0.030688 1.577108 1.128616 0.706201 0.284734 1.848941 1.423074 1.012127 0.550319 0.127044 1.684664 1.271718 0.847352 0.414193 1.990134 1.521095 1.136567 0.750291 0.337126 1.862249 1.460431 1.049297 0.669842 0.216907 1.819953 1.412426 0.984992 0.572590 0.137306 1.767447 1.330047 0.905950 0.512494 0.103808 1.706053 1.292143 0.937524 0.519078 0.097820 1.712597 1.292745 0.903437 0.500926 0.107737 1.719337 1.308083 0.905177 0.496968 0.133013 1.759477 1.355972 0.957870 0.560591 0.197890 1.801611 1.398075 1.020267 0.618113 0.240199 1.874548 1.486894 1.113092 0.726528 0.377432 1.957833 1.606621 1.229674 0.862702 0.506555 0.105441 1.735997 1.326469 0.994534 0.620808 0.244606 1.879074 1.511642 1.143326 0.775799 0.401368 0.075791 1.702891 1.377919 1.004500 0.619170 0.276148 1.905577 1.568310 1.206071 0.869241 0.512412 0.122276 1.822305 1.441374 1.069500 0.718082 0.389240 0.063602 1.687756 1.378724 0.999805 0.650714 0.332978 1.980285 1.636670 1.301261 0.946200 0.636798 0.314748 1.971775 1.637355 1.287360 0.964448 0.629994 0.298934 1.960682 1.641690 1.343792 1.003153 0.675512 0.317256 0.019972 1.693194 1.366188 1.021532 0.736417 0.404438 0.047067 1.755472 1.430810 1.127679 0.827156 0.504993 0.204999 1.869602 1.559982 1.266750 0.972466 0.612460 0.337579 0.023582 1.728936 1.434699 1.106015 0.784009 0.538390 0.203285 1.928266 1.597064 1.317846 1.015077 0.718614 0.443946 0.127570 1.807078 1.525053 1.247182 0.954079 0.675954 0.383769 0.077633 1.801620 1.532606 1.255462 0.983867 0.644793 0.353207 0.086592 1.828378 1.554513 1.293246 0.994370 0.712475 0.454107 0.144932 1.895728 1.591466 1.368095 1.085410 0.814684 0.542596 0.266934 0.005277 1.745816 1.477185 1.204917 0.948437 0.678999 0.410227 0.182102 1.882179 1.612229 1.401104 1.147230 0.888055 0.606492 0.343709 0.087358 1.853764 1.632545 1.312124 1.126022 0.888426 0.609422 0.346571 0.088432 1.864069 1.624618 1.413636 1.129791 0.907899 0.664305 0.453125 0.192741 1.939732 1.724665 1.446730 1.208735 1.009088 0.791036 0.553547 0.269865 0.050008 1.869993 1.607891 1.398702 1.178112 0.955620 0.721846 0.505763 0.260159 0.071405 1.830854 1.568352 1.366891 1.174316 0.942949 0.745228 0.526140 0.332456 0.118352 1.885916 1.701433 1.472261 1.239299 1.044248 0.831700 0.625882 0.454237 0.215857 0.017252 1.819254 1.615407 1.449492 1.196228 0.982253 0.820818 0.604584 0.442977 0.216483 0.024304 1.829511 1.646493 1.443177 1.275320 1.091080 0.881819 0.729119 0.498708 0.327643 0.166437 1.958363 1.799653 1.588527 1.414994 1.260561 1.019025 0.883661 0.702271 0.505868 0.333038 0.161804 1.992906 1.833629 1.635304 1.475105 1.312466 1.145459 0.986121 0.827858 0.611131 0.477466 0.312332 0.162403 1.993033 1.816815 1.647505 1.499793 1.348955 1.165690 1.035882 0.893667 0.723295 0.585232 0.422874 0.271934 0.113531 1.952972 1.802172 1.650708 1.483461 1.343486 1.218552 1.084842 0.927073 0.776245 0.635502 0.458305 0.373982 0.258566 0.082490 1.916515 1.785127 1.662029 1.542014 1.401296 1.288328 1.126154 1.007559 0.889400 0.744625 0.632843 0.508419 0.378037 0.200669 0.085018 0.008202 1.848031 1.734169 1.614621 1.493930 1.370837 1.302166 1.164868 1.024290 0.930883 0.834625 0.701624 0.606512 0.466962 0.388720 0.279406 0.140918 0.032687 1.927348 1.811775 1.710266 1.620460 1.492805 1.381998 1.317908 1.197423 1.122147 0.998133 0.894736 0.822100 0.734668 0.601331 0.525309 0.427892 0.326892 0.282159 0.156951 0.069505 1.983007 1.895744 1.832368 1.741307 1.671465 1.579508 1.479397 1.407456 1.341307 1.292493 1.172022 1.054844 1.025425 0.938514 0.866058 0.788578 0.719667 0.627909 0.568933 0.499665 0.417215 0.362650 0.295768 0.225056 0.146637 0.113130 0.045846 1.971304 1.915101 1.840250 1.815002 1.742119 1.655607 1.609235 1.549662 1.484722 1.419617 1.408714 1.318908 1.280672 1.236078 1.178979 1.119651 1.066519 1.044417 1.008080 0.950081 0.924323 0.862134 0.835117 0.809024 0.773528 0.699906 0.685111 0.616527 0.592797 0.532897 0.500140 0.456585 0.437938 0.409107 0.390095 0.358332 0.312446 0.308676 0.240543 0.209907 0.216831 0.210411 0.161769 0.125653 0.125949 0.116670 0.080163 0.075626 0.045297 0.004806 -0.000881 0.026299 1.965793 1.933605 1.942786 1.944348 1.952614 1.952589 1.927103 1.902751 1.909232 1.908039 1.900517 1.879669 1.891581 1.879298 1.891872 1.877416 1.870643 1.886309 1.944953 1.916353 1.939154 1.880988 1.904419 1.908941 1.910254 1.932089 1.969282 1.952058 1.945000 1.980171 0.011419 0.039090 0.041500 0.047816 0.085029 0.081559 0.110170 0.137541 0.124670 0.182784 0.191545 0.201628 0.268114 0.278620 0.284381 0.311542 0.326223 0.361901 0.375616 0.463339 0.474532 0.486778 0.532068 0.571238 0.610468 0.633708 0.681958 0.718256 0.773051 0.824140 0.873293 0.876610 0.910965 0.966901 1.003523 1.070562 1.122780 1.175620 1.208791 1.265780 1.302068 1.370182 1.451044 1.483311 1.520585 1.580432 1.644102 1.730843 1.770789 1.797830 1.879017 1.937891 0.019856 0.060042 0.124553 0.170564 0.216811 0.336571 0.366439 0.419283 0.547803 0.615076 0.686756 0.743054 0.808192 0.868812 0.967965 1.030425 1.105495 1.195851 1.276820 1.343432 1.439087 1.529664 1.600300 1.698173 1.760479 1.837558 1.924128 0.038094 0.120241 0.214007 0.317951 0.407855 0.504676 0.570855 0.654240 0.764928 0.855805 0.954502 1.051709 1.155105 1.262197 1.344793 1.435407 1.543123 1.670772 1.770468 1.865799 1.988288 0.099499 0.209570 0.297997 0.416558 0.512994 0.646099 0.763826 0.829292 0.972586 1.100975 1.192463 1.318284 1.435661 1.552010 1.667446 1.796953 1.895828 0.041405 0.168834 0.302036 0.399196 0.525607 0.643567 0.817912 0.935908 1.049011 1.178889 1.349363 1.470533 1.565826 1.734269 1.896736 0.005501 0.133187 0.267100 0.426661 0.580310 0.701157 0.855104 0.989792 1.134964 1.281741 1.433081 1.557022 1.743754 1.844434 0.034007 0.156833 0.323091 0.480395 0.650146 0.794963 0.940476 1.107393 1.252731 1.423226 1.591762 1.737804 1.887833 0.066146 0.199816 0.395900 0.573298 0.691305 0.879701 1.072741 1.236826 1.402627 1.563880 1.718916 1.915062 0.045140 0.237581 0.438738 0.580798 0.784617 0.966030 1.127512 1.284041 1.500016 1.652029 1.856424 0.063337 0.220388 0.388642 0.607545 0.805909 0.974538 1.152853 1.362173 1.532955 1.747946 1.927504 0.137055 0.324156 0.511474 0.727234 0.929245 1.096943 1.311277 1.529510 1.717204 1.929354 0.136096 0.316537 0.493748 0.725549 0.936978 1.151687 1.364715 1.550641 1.788754 1.967369 0.214151 0.411319 0.596806 0.843522 1.075423 1.273303 1.508848 1.709102 1.926626 0.164669 0.367063 0.581444 0.843645 1.064477 1.297447 1.488808 1.750805 1.965800 0.201438 0.416395 0.646546 0.890452 1.084015 1.348861 1.594443 1.818075 0.050802 0.296115 0.523258 0.792692 1.017642 1.273538 1.482331 1.728422 1.963843 0.219496 0.485923 0.690905 0.954474 1.220165 1.432291 1.730053 1.984033 0.222784 0.506499 0.721622 1.020753 1.264124 1.484071 1.737442 0.008877 0.293763 0.536176 0.800572 1.062039 1.344801 1.603165 1.888281 0.130074 0.414558 0.656092 0.938783 1.204182 1.472600 1.715585 0.025355 0.292603 0.583538 0.845516 1.127921 1.372150 1.695546 1.966468 0.221543 0.530377 0.793558 1.098411 1.356632 1.654543 1.955535 0.215710 0.523709 0.795967 1.100511 1.400246 1.690427 1.972022 0.266207 0.566998 0.873330 1.145759 1.473687 1.732502 0.041309 0.361298 0.681781 0.985976 1.233662 1.568222 1.842062 0.150190 0.511624 0.781348 1.087933 1.430677 1.711532 0.035866 0.350229 0.682226 0.921244 1.280371 1.577240 1.931037 0.233182 0.556380 0.877749 1.201053 1.529754 1.819573 0.176157 0.513656 0.816790 1.153452 1.451900 1.807514 0.113756 0.472986 0.806765 1.112493 1.445282 1.798965 0.093781 0.440000 0.772831 1.149981 1.498818 1.820883 0.161426 0.511652 0.813634 1.170367 1.539558 1.880179 0.197605 0.545597 0.908196 1.248869 1.624027 1.993151 0.291418 0.679658 1.035077 1.372909 1.711740 0.072351 0.454139 0.769060 1.133182 1.524037 1.903171 0.230092 0.617044 0.952001 1.338296 1.713107 0.075994 0.443935 0.779891 1.161968 1.532485 1.934216 0.232916 0.643695 1.033693 1.388978 1.763418 0.158282 0.531564 0.923030 1.280607 1.680049 0.033058 0.432091 0.830342 1.225022 1.574525 1.980673 0.372020 0.765894 1.154297 1.543700 1.929241 0.336874 0.704501 1.078420 1.502864 1.874394 0.278411 0.673779 1.082558 1.485362 1.892655 0.272103 0.679143 1.126508 1.483018 1.858194 0.311886 0.706336 1.119689 1.515117 1.930234 0.352607 0.728958 1.180615 1.582674 -0.011458 0.382422 0.817149 1.225669 1.663555 0.072122 0.522136 0.931979 1.334156 1.759365 0.194206 0.619361 1.047129 1.473102 1.908252 0.351516 0.772083 1.179926 1.644483 0.044574 0.475749 0.917446 1.334503 1.758597 0.228962 0.656066 1.131261 1.531736 1.952420 0.415411 0.858312 1.294649 1.758848 0.189426 0.612886 1.083380 1.497505 1.985693 0.443336 0.886511 1.331150 1.813863 0.233070 0.676790 1.130099 1.603581 0.055302 0.540261 0.998997 1.449019 1.920455 0.358725 0.844856 1.264985 1.778111 0.235398 0.686816 1.158649 1.610447 0.090461 0.550418 1.066038 1.507364 1.994625 0.420151 0.944881 1.409278 1.887639 0.359391 0.848416 1.314772 1.770668 0.248792 0.760921 1.244402 1.756852 0.252652 0.703484 1.163404 1.654408 0.164679 0.655036 1.142941 1.625021 0.133904 0.622543 1.126263 1.630291 0.123546 0.625620 1.093073 1.619368 0.102469 0.606535 1.087101 1.587765 0.099897 0.628994 1.136702 1.620371 0.161959 0.636159 1.142893 1.681191 0.151857 0.677434 1.211596 1.703772 0.227926 0.771686 1.266146 1.802804 0.317100 0.816843 1.330334 1.861595 0.386103 0.907612 1.408022 1.955543 0.472098 0.989797 1.544380 0.060134 0.607569 1.120958 1.622179 0.202636 0.754702 1.259644 1.800413 0.355305 0.852467 1.427250 1.936931 0.476054 1.030783 1.560498 0.106947 0.646657 1.237864 1.760957 0.297533 0.839061 1.392090 1.981467 0.509204 1.041723 1.622010 0.107363 0.685230 1.282738 1.821548 0.392932 0.943170 1.514801 0.035058 0.608491 1.175191 1.746330 0.299139 0.879938 1.445070 -0.001787 0.554868 1.132782 1.683410 0.273212 0.846311 1.408423 0.003830 0.577097 1.115510 1.694824 0.296676 0.868917 1.443750 0.022513 0.593863 1.183583 1.773899 0.348573 0.938190 1.535508 0.069825 0.715089 1.266797 1.883415 0.452363 1.042844 1.630007 0.194710 0.822770 1.421686 0.006472 0.621176 1.225177 1.804178 0.408934 1.002193 1.614950 0.209691 0.797600 1.413215 0.043022 0.605270 1.230426 1.842139 0.430016 1.071181 1.656314 0.292321 0.899593 1.524578 0.123367 0.722937 1.338216 1.965637 0.591781 1.216201 1.814694 0.429343 1.061910 1.690552 0.337918 0.935448 1.583594 0.173086 0.798338 1.428447 0.077432 0.684896 1.325474 1.963397 0.593516 1.253180 1.853700 0.531347 1.151683 1.746520 0.425377 1.027823 1.699093 0.333177 0.972850 1.609902 0.254362 0.906653 1.526954 0.225847 0.835769 1.466855 0.149601 0.794755 1.472543 0.118131 0.734656 1.404030 0.060242 0.727045 1.340500 0.029564 0.718625 1.343988 -0.004346 0.685714 1.342591 1.966238 0.667503 1.349852 -0.002971 0.703210 1.357155 0.009465 0.670856 1.356398 0.013330 0.698167 1.342918 0.045357 0.716155 1.383634 0.066321 0.749850 1.425646 0.130825 0.789828 1.468799 0.124200 0.833100 1.513466 0.184968 0.911501 1.594174 0.253162 0.976866 1.658160 0.318972 1.008058 1.691692 0.429447 1.114864 1.830218 0.507740 1.192600 1.907363 0.627089 1.308050 -0.023869 0.692513 1.415262 0.119283 0.836039 1.521751 0.244980 0.952758 1.642834 0.365258 1.090581 1.783116 0.502517 1.253315 1.907048 0.640444 1.381762 0.084253 0.818390 1.500682 0.258511 0.959052 1.666093 0.436675 1.168622 1.860895 0.574076 1.283511 0.009657 0.798719 1.538205 0.214051 0.952450 1.698753 0.447784 1.186388 1.858247 0.626974 1.347987 0.102119 0.855522 1.567443 0.343708 1.048347 1.808415 0.563378 1.317260 0.037027 0.798248 1.543255 0.284540 1.038822 1.782415 0.536310 1.274786 0.033989 0.801778 1.518276 0.287239 1.093224 1.832048 0.574059 1.361341 0.088951 0.857131 1.626231 0.399419 1.160410 1.908691 0.691937 1.400996 0.198198 1.010876 1.783108 0.552378 1.321187 0.069810 0.822885 1.649640 0.398546 1.161881 1.992740 0.718709 1.494106 0.274327 1.069239 1.874949 0.654740 1.412139 0.213263 1.030112 1.748596 0.568168 1.374868 0.155842 0.909714 1.739498 0.532008 1.295260 0.100142 0.892104 1.684374 0.494276 1.299126 0.082168 0.868839 1.674733 0.523178 1.308308 0.060301 0.901403 1.723633 0.527144 1.315281 0.095071 0.928769 1.769688 0.546110 1.365559 0.165197 0.991664 1.800022 0.649448 1.439023 0.280113 1.099551 1.892902 0.728472 1.558461 0.355122 1.155267 0.036651 0.803555 1.642245 0.486101 1.329471 0.153373 0.982109 1.814973 0.657477 1.472081 0.306013 1.138804 1.982639 0.806632 1.637032 0.492622 1.340692 0.166678 0.988021 1.860739 0.705110 1.541783 0.378007 1.213916 0.031456 0.923334 1.732364 0.624150 1.479737 0.314949 1.150499 0.017070 0.859860 1.709562 0.576208 1.451144 0.288172 1.156845 0.018462 0.888828 1.738856 0.600882 1.451392 0.305358 1.162471 0.071454 0.893471 1.790525 0.655173 1.527197 0.387534 1.299810 0.149548 1.016876 1.901076 0.773925 1.669962 0.533885 1.422131 0.264889 1.162826 0.053904 0.925273 1.783822 0.699297 1.593338 0.446127 1.329094 0.254005 1.148241 0.039106 0.936392 1.775754 0.686922 1.585294 0.459409 1.358560 0.246673 1.169932 0.062721 0.983726 1.860184 0.765327 1.652246 0.576169 1.499099 0.384989 1.260554 0.200648 1.126723 -0.014215 0.905397 1.801886 0.753345 1.641865 0.558767 1.467752 0.368838 1.294027 0.198410 1.090981 0.052952 0.991699 1.874409 0.806543 1.749760 0.655559 1.568484 0.520862 1.412201 0.366118 1.291778 0.238178 1.186893 0.061166 0.989290 1.973099 0.910404 1.832384 0.729437 1.723776 0.611997 1.559408 0.503451 1.415081 0.384261 1.301727 0.266130 1.222404 0.110539 1.064083 0.035684 0.943491 1.931964 0.862767 1.795698 0.762421 1.744397 0.666272 1.629091 0.597084 1.552001 0.500765 1.485981 0.446479 1.384691 0.357775 1.317093 0.302197 1.238922 0.194762 1.180556 0.151639 1.104156 0.074275 1.063876 0.008701 0.973523 1.931938 0.929619 1.899785 0.841696 1.876181 0.845013 1.791292 0.775116 1.753572 0.692830 1.726733 0.701663 1.665288 0.631802 1.649201 0.617241 1.594365 0.594942 1.588591 0.590950 1.543461 0.545092 1.544258 0.510400 1.542625 0.487864 1.489414 0.513606 1.491923 0.493471 1.497027 0.496715 1.533646 0.485406 1.488094 0.496820 1.543844 0.524720 1.515833 0.565220 1.558524 0.600489 1.612307 0.598486 1.630142 0.583528 1.626331 0.601297 1.642574 0.701670 1.674391 0.711291 1.729818 0.761143 1.763746 0.824000 1.826874 0.860664 1.866172 0.942874 1.940443 0.980274 -0.790948 1.041163 0.048939 1.113624 0.095128 1.190982 0.189672 1.265115 0.274570 1.325492 0.374151 1.447798)
)
))
+;; :odd 65536 (311.51645615075 1.5666759234657 2.0944106499714) 0.51769778542275 (100)
+
+
;;; ---------------------------------------- prime-numbered harmonics (and 1st) ----------------------------------------
(define primoid-min-peak-phases (vector
-#(1 1.0 #(0)
+(vector 1 1.0 (fv 0)
)
-#(2 1.76 #(0 1)
+(vector 2 1.76 (fv 0 1)
)
;;; 3 prime --------------------------------------------------------------------------------
-#(3 2.1949384212494 #(0 0 1)
- 1.980 #(0 62/39 13/41) ; 1 2 3 -- same as :all in this case
- 1.9798574987316 #(0.0 1.5896952797511 0.31654707828801)
- 1.9798030853271 #(0.0 1.5897271633148 0.31667485833168)
+(vector 3 2.1949384212494 (fv 0 0 1)
+ 1.980 (fv 0 62/39 13/41) ; 1 2 3 -- same as :all in this case
+ 1.9798574987316 (fv 0.0 1.5896952797511 0.31654707828801)
+ 1.9798030853271 (fv 0.0 1.5897271633148 0.31667485833168)
)
;;; 4 prime --------------------------------------------------------------------------------
-#(4 2.5978584289551 #(0 0 1 1)
+(vector 4 2.5978584289551 (fv 0 0 1 1)
- ;2.2039985204158 #(0 0 12 4) / 20
- 2.1930510997772 #(0.000 0.996 0.596 0.217)
- 2.1930510997772 #(0.000 1.996 0.596 0.217)
- 2.1930510997772 #(0.000 0.004 1.404 1.783)
+ ;2.2039985204158 (fv 0 0 12 4) / 20
+ 2.1930510997772 (fv 0.000 0.996 0.596 0.217)
+ 2.1930510997772 (fv 0.000 1.996 0.596 0.217)
+ 2.1930510997772 (fv 0.000 0.004 1.404 1.783)
- 2.1927945613861 #(0.0 1.0065363103693 1.4072853370949 1.7873527125308)
- 2.1921416218407 #(0.0 1.0052774357064 1.4058145325161 1.7854903085184)
- 2.1921210289001 #(0.0 1.0052587985992 1.4057868719101 1.7854607105255)
+ 2.1927945613861 (fv 0.0 1.0065363103693 1.4072853370949 1.7873527125308)
+ 2.1921416218407 (fv 0.0 1.0052774357064 1.4058145325161 1.7854903085184)
+ 2.1921210289001 (fv 0.0 1.0052587985992 1.4057868719101 1.7854607105255)
)
;;; 5 prime --------------------------------------------------------------------------------
-#(5 2.7172040939331 #(0 0 1 0 0)
+(vector 5 2.7172040939331 (fv 0 0 1 0 0)
- 2.476848 #(0.000000 1.577434 0.385232 1.294742 1.022952)
- 2.476837 #(0.000000 0.422530 1.614642 0.705077 0.976763)
+ 2.476848 (fv 0.000000 1.577434 0.385232 1.294742 1.022952)
+ 2.476837 (fv 0.000000 0.422530 1.614642 0.705077 0.976763)
)
;;; 6 prime --------------------------------------------------------------------------------
-#(6 3.1241359710693 #(0 0 0 1 0 0)
+(vector 6 3.1241359710693 (fv 0 0 0 1 0 0)
- 2.805574 #(0.000000 1.568945 0.034019 1.082417 0.900415 0.797509)
- 2.805492 #(0.000000 0.431060 -0.033992 0.917551 1.099550 1.202470)
+ 2.805574 (fv 0.000000 1.568945 0.034019 1.082417 0.900415 0.797509)
+ 2.805492 (fv 0.000000 0.431060 -0.033992 0.917551 1.099550 1.202470)
+ 2.805413 (fv 0.000000 0.431110 -0.033974 0.917615 1.099635 1.202594)
)
;;; 7 prime --------------------------------------------------------------------------------
-#(7 3.5358893688327 #(0 0 0 0 0 1 0)
- 3.4886319637299 #(0 1 1 0 0 0 0)
+(vector 7 3.4886319637299 (fv 0 1 1 0 0 0 0)
- 3.061861 #(0.000000 0.715739 0.261422 0.169339 0.062479 1.180650 0.330190)
+ 3.061861 (fv 0.000000 0.715739 0.261422 0.169339 0.062479 1.180650 0.330190)
+ 3.061763 (fv 0.000000 0.715523 0.261251 0.168577 0.061828 1.179155 0.328665)
)
;;; 8 prime --------------------------------------------------------------------------------
-#(8 3.8668605608975 #(0 1 0 1 1 1 0 0)
- 3.7088719446694 #(0 1 0 0 0 0 1 0)
- 3.7088720798492 #(0 0 0 0 0 0 1 0)
+(vector 8 3.7088720798492 (fv 0 0 0 0 0 0 1 0)
- 3.263115 #(0.000000 0.207652 0.035023 1.752163 0.064249 0.346105 1.403170 0.065734)
- 3.262977 #(0.000000 0.792550 1.965637 0.248661 1.936840 1.655647 0.598935 1.936915)
+ 3.263115 (fv 0.000000 0.207652 0.035023 1.752163 0.064249 0.346105 1.403170 0.065734)
+ 3.262977 (fv 0.000000 0.792550 1.965637 0.248661 1.936840 1.655647 0.598935 1.936915)
+ 3.262789 (fv 0.000000 0.792261 1.965087 0.247823 1.935907 1.654053 0.597010 1.934463)
)
;;; 9 prime --------------------------------------------------------------------------------
-#(9 4.0320072303689 #(0 1 1 0 1 0 0 0 0)
- 3.915482117267 #(0 1 0 1 1 1 0 0 0)
- 3.9154822826385 #(0 0 0 1 1 1 0 0 0)
+(vector 9 3.9154822826385 (fv 0 0 0 1 1 1 0 0 0)
- 3.382645 #(0.000000 0.562589 0.520940 1.521127 1.682374 0.721497 0.805534 1.254209 0.726847)
- 3.382399 #(0.000000 1.437745 1.479554 0.480268 0.319088 1.280870 1.197460 0.749784 1.277141)
+ 3.382645 (fv 0.000000 0.562589 0.520940 1.521127 1.682374 0.721497 0.805534 1.254209 0.726847)
+ 3.382399 (fv 0.000000 1.437745 1.479554 0.480268 0.319088 1.280870 1.197460 0.749784 1.277141)
+ 3.382150 (fv 0.000000 1.437471 1.479039 0.479171 0.317977 1.279012 1.195104 0.746644 1.274032)
)
;;; 10 prime --------------------------------------------------------------------------------
-#(10 4.1794095733027 #(0 0 1 0 0 1 1 1 1 1)
- 4.1718228801521 #(0 0 0 0 0 1 0 0 1 0)
- 4.1209712028503 #(0 0 1 0 0 0 1 0 0 0)
+(vector 10 4.1209712028503 (fv 0 0 1 0 0 0 1 0 0 0)
- 3.602714 #(0.000000 0.594153 1.304664 1.610566 1.241680 0.148124 1.920208 0.972526 1.622030 0.768137)
- 3.602602 #(0.000000 1.405079 0.694565 0.388252 0.756491 1.849937 0.076683 1.023761 0.374165 1.226329)
- 3.602329 #(0.000000 0.594431 1.305346 1.611464 1.243212 0.149889 1.922392 0.975619 1.625276 0.772405)
+ 3.602602 (fv 0.000000 1.405079 0.694565 0.388252 0.756491 1.849937 0.076683 1.023761 0.374165 1.226329)
+ 3.602329 (fv 0.000000 0.594431 1.305346 1.611464 1.243212 0.149889 1.922392 0.975619 1.625276 0.772405)
+ 3.601897 (fv 0.000000 0.594605 1.305309 1.611462 1.242927 0.149405 1.922318 0.974872 1.624292 0.771826)
)
;;; 11 prime --------------------------------------------------------------------------------
-#(11 4.56653492525 #(0 0 1 0 1 1 1 0 0 0 0)
- 4.487418596136 #(0 0 0 0 0 0 1 1 0 1 1)
- 4.4176635742188 #(0 0 1 0 0 0 0 0 0 1 0)
+(vector 11 4.4176635742188 (fv 0 0 1 0 0 0 0 0 0 1 0)
- 3.779310 #(0.000000 0.795034 0.550625 0.191200 0.209037 0.086985 0.729229 1.230323 0.721250 -0.058459 1.262582)
- 3.779046 #(0.000000 0.211414 1.453486 1.827574 1.811694 1.949216 1.313595 0.823256 1.334141 0.127849 0.824659)
+ 3.779046 (fv 0.000000 0.211414 1.453486 1.827574 1.811694 1.949216 1.313595 0.823256 1.334141 0.127849 0.824659)
+ 3.778444 (fv 0.000000 0.211392 1.453207 1.827566 1.811268 1.948666 1.312975 0.822389 1.333108 0.126706 0.823083)
)
;;; 12 prime --------------------------------------------------------------------------------
-#(12 4.7299025085604 #(0 0 1 0 1 1 1 1 0 1 0 0)
- 4.6850221453825 #(0 0 1 0 1 0 1 1 1 0 0 0)
- 4.3595271110535 #(0 0 0 0 0 0 1 0 1 1 0 1)
+(vector 12 4.3595271110535 (fv 0 0 0 0 0 0 1 0 1 1 0 1)
- 3.936657 #(0.000000 0.367346 0.997085 1.763425 1.295636 0.140826 0.757652 1.565853 1.284651 0.304758 0.331248 0.325474)
- 3.936584 #(0.000000 0.366730 0.995852 1.762390 1.293763 0.137304 0.753397 1.560313 1.278944 0.297723 0.322472 0.315856)
+ 3.936657 (fv 0.000000 0.367346 0.997085 1.763425 1.295636 0.140826 0.757652 1.565853 1.284651 0.304758 0.331248 0.325474)
+ 3.936584 (fv 0.000000 0.366730 0.995852 1.762390 1.293763 0.137304 0.753397 1.560313 1.278944 0.297723 0.322472 0.315856)
+ 3.935928 (fv 0.000000 0.367095 0.996695 1.763345 1.295131 0.139476 0.755820 1.563961 1.282494 0.302360 0.327995 0.321982)
)
;;; 13 prime --------------------------------------------------------------------------------
-#(13 5.06212613641 #(0 1 0 0 1 0 1 0 1 1 0 0 0)
- 4.9963458682976 #(0 1 0 0 1 1 1 1 1 1 1 0 1)
- 4.9494566649932 #(0 1 0 0 1 1 0 0 0 0 1 1 1)
- 4.8980793952942 #(0 0 0 1 0 0 1 1 1 1 1 1 0)
+(vector 13 4.8980793952942 (fv 0 0 0 1 0 0 1 1 1 1 1 1 0)
- 4.180492 #(0.000000 1.772215 1.337771 1.572723 0.985677 1.717413 1.821689 0.986759 1.151868 0.637061 0.595788 1.561353 1.695959)
- 4.155503 #(0.000000 1.115751 0.463368 0.110540 0.613302 1.581997 1.394002 -0.005270 1.724217 0.023531 1.743892 0.616897 0.124222)
- 4.155104 #(0.000000 0.888606 1.516761 -0.128988 1.376524 0.383262 0.572385 -0.041726 0.228441 1.918487 0.187862 1.304384 1.779710)
+ 4.155503 (fv 0.000000 1.115751 0.463368 0.110540 0.613302 1.581997 1.394002 -0.005270 1.724217 0.023531 1.743892 0.616897 0.124222)
+ 4.155104 (fv 0.000000 0.888606 1.516761 -0.128988 1.376524 0.383262 0.572385 -0.041726 0.228441 1.918487 0.187862 1.304384 1.779710)
+ 4.154486 (fv 0.000000 0.888925 1.516611 -0.128449 1.377349 0.383874 0.573640 -0.040502 0.230047 1.920090 0.190320 1.307111 1.782269)
)
;;; 14 prime --------------------------------------------------------------------------------
-#(14 4.827317237854 #(0 0 0 0 1 0 0 0 0 1 1 0 0 0)
+(vector 14 4.827317237854 (fv 0 0 0 0 1 0 0 0 0 1 1 0 0 0)
- 4.328845 #(0.000000 1.631608 0.105786 1.732589 0.749692 0.105117 0.626364 1.395811 1.430614 0.705052 0.780338 1.582470 1.046721 0.950090)
- 4.326087 #(0.000000 0.362120 1.888454 0.251240 1.230086 1.854603 1.332783 0.548088 0.507657 1.215301 1.123713 0.312281 0.829297 0.910443)
- 4.325356 #(0.000000 0.359558 1.885647 0.244632 1.221244 1.839379 1.316045 0.525308 0.483244 1.183590 1.084986 0.271051 0.780356 0.855105)
+ 4.325356 (fv 0.000000 0.359558 1.885647 0.244632 1.221244 1.839379 1.316045 0.525308 0.483244 1.183590 1.084986 0.271051 0.780356 0.855105)
+ 4.324364 (fv 0.000000 0.359123 1.885242 0.244967 1.221612 1.840358 1.317076 0.526663 0.485486 1.185929 1.087828 0.273652 0.783599 0.859686)
)
;;; 15 prime --------------------------------------------------------------------------------
-#(15 5.2087744996197 #(0 0 0 0 1 0 0 0 1 1 1 0 1 1 1)
- 5.1680134390775 #(0 0 0 0 1 0 1 1 0 0 1 1 1 1 1)
- 5.116711139679 #(0 0 0 0 1 1 0 0 1 0 0 0 1 1 1)
+(vector 15 5.116711139679 (fv 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1)
- 4.482073 #(0.000000 0.430607 1.010272 0.810816 1.103409 1.274070 0.728190 1.576850 0.465054 1.582164 0.985518 1.441214 0.149277 1.211260 1.202522)
- 4.468487 #(0.000000 -0.170894 1.166594 0.261941 0.795313 -0.037553 0.002464 1.693993 1.753074 1.644706 -0.070294 0.671844 1.070595 0.053777 -0.250027)
- 4.467959 #(0.000000 1.165302 0.822381 1.719844 1.177673 0.000074 -0.047034 0.249259 0.174863 0.272306 -0.034377 1.204925 0.800910 1.798882 0.085175)
+ 4.467959 (fv 0.000000 1.165302 0.822381 1.719844 1.177673 0.000074 -0.047034 0.249259 0.174863 0.272306 -0.034377 1.204925 0.800910 1.798882 0.085175)
+ 4.465870 #(0.000000 1.195783 0.875671 1.808021 1.309702 0.184662 0.170474 0.531131 0.521153 0.683109 0.474077 -0.194026 1.432983 0.523484 0.889349)
)
;;; 16 prime --------------------------------------------------------------------------------
-#(16 5.3690811579971 #(0 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1)
- 5.2829658956774 #(0 0 1 0 0 0 1 0 0 0 0 0 1 1 1 0)
- 5.2015118598938 #(0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1)
+(vector 16 5.2015118598938 (fv 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1)
- 4.662724 #(0.000000 0.254861 1.684311 0.497899 0.656871 1.722503 0.329340 1.047910 0.635053 1.158523 0.448629 0.050078 1.573549 1.470622 1.991728 1.975781)
- 4.607704 #(0.000000 0.863393 1.574552 1.705278 1.569228 0.102457 0.353917 0.651931 1.696462 1.761383 0.072955 1.294632 -0.307040 1.072928 1.543936 0.777891)
- 4.602871 #(0.000000 0.062093 0.362233 0.127394 0.197994 1.532775 1.215275 0.817953 1.672076 1.484960 0.991530 1.690500 1.074819 1.570572 1.070642 1.684336)
- 4.602505 #(0.000000 0.065822 0.364277 0.133567 0.202441 1.541212 1.225002 0.832999 1.687176 1.503245 1.015565 1.715739 1.103351 1.602678 1.102870 1.723542)
+ 4.602505 (fv 0.000000 0.065822 0.364277 0.133567 0.202441 1.541212 1.225002 0.832999 1.687176 1.503245 1.015565 1.715739 1.103351 1.602678 1.102870 1.723542)
+ 4.600306 #(0.000000 0.087862 0.378855 0.177701 0.258884 1.624830 1.330220 0.960734 1.836164 1.680878 1.236729 1.958382 1.391766 1.922763 1.425076 0.083217)
)
;;; 17 prime --------------------------------------------------------------------------------
-#(17 5.6171013426079 #(0 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1)
- 5.5776449751108 #(0 1 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1)
- 5.5725093120778 #(0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 1 0)
- 5.5318970680237 #(0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1)
+(vector 17 5.5318970680237 (fv 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1)
- 4.732840 #(0.000000 1.594259 1.537383 1.654009 0.059827 1.456178 1.640619 0.725632 -0.052840 0.741210 1.485914 1.399005 0.596215 1.791931 0.887057 0.720499 0.037113)
- 4.720335 #(0.000000 0.741764 1.745798 1.858232 0.394387 0.086105 0.379819 1.692029 1.022315 0.008990 1.069411 1.241786 0.653220 0.028583 1.334535 1.358902 0.976814)
+ 4.719141 (fv 0.000000 0.742295 1.745265 1.857635 0.393094 0.085265 0.379253 1.692020 1.022244 0.008090 1.067230 1.241546 0.650781 0.027258 1.334059 1.354939 0.974983)
+ 4.718649 #(0.000000 0.751159 1.770960 1.891296 0.451714 0.167219 0.486669 1.820262 1.171314 0.188288 1.302438 1.491326 0.945450 0.342701 1.668608 1.730493 1.394926)
)
;;; 18 prime --------------------------------------------------------------------------------
-#(18 5.6380511040237 #(0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0)
- 5.518 #(0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 0)
+(vector 18 5.518 (fv 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 0)
- 4.881625 #(0.000000 1.688958 1.279188 1.177293 -0.318361 0.802007 0.250184 -0.270074 -0.003800 1.870180 1.633808 0.442468 -0.114869 0.906870 1.252354 1.245762 -0.107436 0.786324)
- 4.856709 #(0.000000 0.761349 1.398941 1.387382 -0.020892 1.258976 0.808017 0.461939 0.840319 0.868659 0.861865 1.748851 1.411948 0.655653 1.051244 1.278422 0.114546 1.310974)
+ 4.855354 (fv 0.000000 0.761212 1.399765 1.386893 -0.022155 1.259519 0.806762 0.461717 0.840663 0.867450 0.860949 1.743030 1.407070 0.651538 1.045391 1.279111 0.110257 1.307989)
+ 4.855108 #(0.000000 0.750207 1.384561 1.357598 -0.059069 1.202337 0.735689 0.367843 0.732570 0.743255 0.704408 1.570924 1.212329 0.426050 0.813634 1.013534 -0.181098 0.979190)
)
;;; 19 prime --------------------------------------------------------------------------------
-#(19 5.9841752522819 #(0 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 1 0)
- 5.707 #(0 0 1 0 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1)
- 5.7069295560724 #(0 1 1 0 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1)
+(vector 19 5.7069295560724 (fv 0 1 1 0 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1)
- 5.050598 #(0.000000 0.718637 1.798883 1.579536 0.015456 1.806520 0.208708 1.353434 1.112089 1.766036 0.720549 1.107314 0.509279 -0.117956 1.148417 0.726527 0.254889 1.769009 0.642150)
- 5.016706 #(0.000000 1.615592 1.626110 1.313424 1.625675 1.187140 1.457241 0.377999 -0.071449 0.474555 0.996594 1.284924 0.372672 1.499744 0.593870 0.033098 1.161407 0.320243 1.064382)
+ 5.015020 (fv 0.000000 1.616061 1.626145 1.313686 1.626275 1.187207 1.456980 0.377509 -0.071549 0.474989 0.997350 1.285450 0.372950 1.499943 0.593785 0.033723 1.161466 0.319734 1.064282)
+ 4.998754 #(0.000000 1.645363 1.697584 1.402853 1.761967 1.410480 1.731078 0.730841 0.373575 0.971264 1.632848 -0.032567 1.185342 0.399132 1.548900 1.042245 0.314528 1.610838 0.400814)
)
;;; 20 prime --------------------------------------------------------------------------------
-#(20 5.9970674135126 #(0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 0 1)
- 5.9696664680177 #(0 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 0)
- 5.931 #(0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 0 0)
- 5.8879864574703 #(0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1)
+(vector 20 5.8879864574703 (fv 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1)
- 5.219761 #(0.000000 1.154818 1.816853 1.891880 -0.032202 0.197019 1.018732 1.639212 0.953425 0.695031 0.577021 1.061687 0.455312 0.907081 0.481515 1.400124 0.806615 1.262883 0.187894 1.041939)
- 5.214980 #(0.000000 0.840843 0.870934 -1.936784 0.124790 0.037596 1.842854 1.506881 0.243469 1.454635 0.781572 1.020004 -0.209275 1.345639 1.356003 1.554666 0.375592 1.561439 1.206468 1.818047)
- 5.190073 #(0.000000 1.305012 0.829288 0.733488 0.022101 1.272217 1.780612 0.000702 1.609711 0.398599 0.056785 1.250942 0.237528 0.553904 0.013636 0.751667 1.626948 0.622700 1.016243 0.075548)
+ 5.188618 (fv 0.000000 1.304708 0.831211 0.731788 0.021326 1.272273 1.777479 0.002778 1.612017 0.397413 0.057603 1.250739 0.234023 0.556087 0.011742 0.753589 1.624826 0.625035 1.017719 0.079500)
+ 5.182566 #(0.000000 1.263246 0.762194 0.608532 -0.162633 0.980718 1.431801 -0.440489 1.122128 -0.196813 -0.666076 0.455149 -0.710850 -0.505486 -1.097448 -0.446751 0.276095 -0.871587 -0.537639 -1.622748)
)
;;; 21 prime --------------------------------------------------------------------------------
-#(21 6.1566464314438 #(0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 0)
- 6.1375694270894 #(0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0)
- 6.1138607493652 #(0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0)
+(vector 21 6.1138607493652 (fv 0 0 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0)
- 5.486939 #(0.000000 1.054487 0.664992 0.221211 0.326872 1.588195 1.592726 1.336003 -0.011408 0.242484 1.885446 1.030420 0.900483 1.377784 1.752653 1.724134 1.420616 1.866623 1.449894 1.955882 0.634259)
- 5.329864 #(0.000000 0.272438 0.199162 0.592353 1.763983 0.854454 0.508802 0.394659 -0.117248 0.409584 1.672133 1.498039 0.065454 0.630259 0.862041 1.058228 0.978442 1.314381 0.056427 1.089844 1.751788)
+ 5.324980 (fv 0.000000 0.284388 0.190620 0.601870 1.760108 0.865412 0.509624 0.391482 -0.117180 0.413220 1.669494 1.501699 0.066514 0.632948 0.866546 1.073191 0.975355 1.318609 0.054208 1.081180 1.759607)
+ 5.323612 #(0.000000 0.280854 0.184723 0.594540 1.747745 0.845155 0.483640 0.360116 -0.153262 0.371609 1.613941 1.441516 -0.006745 0.553330 0.784905 0.983522 0.871481 1.204293 -0.066217 0.952578 1.624372)
)
;;; 22 prime --------------------------------------------------------------------------------
-#(22 6.389194775669 #(0 0 0 0 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1)
- 6.3868380259357 #(0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1)
- 6.33751039349071 #(0 1 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0)
- 6.3374844973589 #(0 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0)
+(vector 22 6.3374844973589 (fv 0 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0)
- 5.446875 #(0.000000 1.499440 1.283938 1.144681 0.719116 0.527122 0.660420 1.925016 0.467488 0.510019 0.651972 0.189033 1.100881 0.083261 0.858169 -0.068443 1.057677 1.751471 1.463218 0.262023 0.956227 1.595986)
+ 5.444390 (fv 0.000000 1.499825 1.282805 1.145752 0.718322 0.527629 0.660515 1.924701 0.466877 0.510672 0.652853 0.187109 1.099971 0.084112 0.857217 -0.068874 1.056229 1.751779 1.460546 0.258516 0.957206 1.594508)
+ 5.433554 #(0.000000 1.486514 1.390599 1.149545 0.921462 0.702749 0.884951 0.283286 0.900936 0.913025 1.182081 0.780309 1.832213 0.822636 1.714820 0.783014 0.057705 0.842269 0.698584 1.561603 0.224265 0.995298)
)
;;; 23 prime --------------------------------------------------------------------------------
-#(23 6.540168762207 #(0 0 1 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 1 1)
- 6.5358400344849 #(0 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 0 1)
- 6.5309901747782 #(0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1)
+(vector 23 6.5309901747782 (fv 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1)
- 5.565974 #(0.000000 0.280072 0.583006 0.220820 1.169537 1.339905 0.218207 0.992259 0.637686 1.632445 0.471619 0.405900 0.174129 0.471682 0.291956 0.732155 1.276601 1.526921 0.610296 0.145879 1.083090 1.485988 1.453304)
+ 5.563562 (fv 0.000000 0.281094 0.583074 0.221311 1.169287 1.340406 0.217839 0.992042 0.637288 1.632696 0.471670 0.404966 0.171954 0.469626 0.291125 0.731904 1.276906 1.527897 0.612764 0.143351 1.082353 1.486999 1.452340)
+ 5.562290 #(0.000000 0.285874 0.595224 0.235000 1.193968 1.380397 0.263651 1.051885 0.699527 1.708311 0.571007 0.512971 0.292952 0.607887 0.434888 0.887469 1.457277 1.731817 0.825388 0.371687 1.321790 1.739434 1.728651)
)
;;; 24 prime --------------------------------------------------------------------------------
-#(24 6.6087727546692 #(0 0 0 1 1 0 1 1 1 1 1 0 0 1 0 0 1 0 0 1 1 0 0 0)
- 6.5951228141785 #(0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 0)
- 6.5623834870329 #(0 0 1 1 0 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0)
+(vector 24 6.5623834870329 (fv 0 0 1 1 0 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0)
- 5.648813 #(0.000000 0.823449 1.872686 1.168306 1.224201 0.475640 -0.083514 -0.215772 1.778440 1.402433 0.289117 1.689650 -0.267772 1.131983 1.838884 1.456147 1.364358 0.420868 0.904518 0.159286 0.263582 0.761288 1.249489 1.433666)
+ 5.645656 (fv 0.000000 0.825211 1.870903 1.169702 1.224751 0.476917 -0.084281 -0.215343 1.779853 1.403261 0.289331 1.689966 -0.267939 1.131483 1.839470 1.455399 1.365050 0.422908 0.906355 0.161003 0.266551 0.763039 1.248766 1.436520)
+ 5.642196 #(0.000000 0.890373 -0.094314 1.286595 1.344700 0.673123 0.114259 0.064347 0.093887 1.778664 0.785400 0.193244 0.317478 1.782787 0.521724 0.200559 0.236076 1.409678 1.913185 1.269474 1.450265 -0.052106 0.501351 0.830713)
)
;;; 25 prime --------------------------------------------------------------------------------
-#(25 6.84773846418216 #(0 0 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0)
- 6.8138422966003 #(0 0 1 0 1 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1 0 1 1 1 1)
- 6.6733964421745 #(0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 1 1 0 0 0)
- 6.635721206665 #(0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1)
+(vector 25 6.635721206665 (fv 0 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1)
- 5.813573 #(0.000000 0.564911 1.200822 1.329523 1.447410 0.306033 -0.098681 1.176108 1.304951 0.187783 1.568028 0.363121 -0.024452 1.548137 -0.225969 1.038784 1.386643 1.015126 1.883396 0.547333 1.619119 0.868161 1.480246 0.448882 0.532692)
+ 5.810785 (fv 0.000000 0.563705 1.200194 1.330185 1.448503 0.304746 -0.097873 1.178970 1.307797 0.187993 1.570595 0.364607 -0.021932 1.552639 -0.223928 1.041142 1.388107 1.015775 1.883861 0.551891 1.621094 0.871585 1.482986 0.450455 0.538066)
)
;;; 26 prime --------------------------------------------------------------------------------
-#(26 6.9502968788147 #(0 1 1 1 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 0 1)
- 6.9264550209045 #(0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1)
- 6.9264546836564 #(0 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1)
- 6.8401503562927 #(0 1 0 0 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1)
+(vector 26 6.8401503562927 (fv 0 1 0 0 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 0 1)
+
+ 6.060342 (fv 0.000000 -0.041165 -0.003731 0.423811 0.999953 0.846414 -0.006772 1.678875 0.280560 0.164498 1.427575 0.432370 0.295956 0.293617 -0.083444 1.838911 -0.050243 0.444002 1.425675 0.812741 0.728420 0.505166 0.737245 1.256666 1.911599 0.384822)
+ 6.058136 #(0.000000 -0.021770 0.018901 0.439476 1.003477 0.859441 0.019351 1.721839 0.345805 0.234535 1.519443 0.503441 0.356442 0.416885 0.030839 -0.020167 0.056498 0.603049 1.590340 0.966971 0.922202 0.689424 0.952624 1.488151 0.129980 0.653028)
+ 6.056645 #(0.000000 -0.016558 0.026579 0.448353 1.015651 0.876809 0.043994 1.754158 0.381360 0.275434 1.572444 0.558006 0.419413 0.493841 0.110178 0.066677 0.147843 0.710739 1.703199 1.084656 1.051087 0.819777 1.096976 1.639534 0.286953 0.830565)
+
+ ;; 25+1
+ 6.122073 (fv 0.000000 0.460498 1.557923 1.378525 1.718931 0.447198 0.063372 0.871474 1.497987 0.124645 1.393742 0.468348 -0.079259 1.274284 -0.437034 1.081613 1.726707 1.093435 1.712067 0.466467 1.547007 0.967081 1.258363 0.304978 0.430183 0.007813)
- 6.063104 #(0.000000 -0.040642 -0.004393 0.423533 0.998702 0.844985 -0.007945 1.677989 0.280630 0.166153 1.429567 0.432524 0.295773 0.292916 -0.082996 1.840240 -0.049155 0.444255 1.425383 0.812487 0.729616 0.506799 0.739054 1.259043 1.913256 0.385463)
+ ;; 27-1
+ 6.163135 (fv 0.000000 0.728435 -0.162948 -0.044439 -0.171766 1.094395 0.029113 0.072422 1.082217 0.879605 -0.111434 1.156162 1.018106 0.872058 0.997367 0.178509 -0.068227 -0.141285 1.119460 -0.213041 0.834585 -0.226205 0.775314 -0.211931 0.098174 0.839934)
+
+ ;; 24+2
+ 6.157978 (fv 0.000000 0.747592 -0.138036 -0.096812 -0.252632 1.140904 0.038566 0.088301 1.237633 1.010838 0.001393 0.982309 1.045743 0.842207 0.970725 0.281016 0.130720 0.128208 1.180011 0.026054 0.957275 -0.052702 1.071527 -0.026637 0.338920 1.156596)
)
;;; 27 prime --------------------------------------------------------------------------------
-#(27 7.0658421516418 #(0 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0)
- 6.9657588005066 #(0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1)
- 6.949148677349 #(0 0 0 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1)
- 6.9491486549377 #(0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1)
+(vector 27 6.9491486549377 (fv 0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1)
- 6.137583 #(0.000000 1.619581 0.267139 0.606186 0.261665 1.740283 1.690461 1.043940 0.088531 1.522330 0.679836 1.839876 1.226540 -0.050705 0.849177 -0.057921 1.520066 0.451537 0.222201 1.185294 1.245606 1.695630 -0.037885 1.789624 1.793694 1.556609 0.364662)
+ 6.133994 (fv 0.000000 1.619323 0.268498 0.605329 0.261788 1.741906 1.690385 1.044397 0.095253 1.526766 0.682732 1.844188 1.227922 -0.046848 0.854154 -0.053734 1.525611 0.460071 0.230079 1.191101 1.252287 1.704028 -0.029667 1.798141 1.802482 1.571525 0.379519)
)
;;; 28 prime --------------------------------------------------------------------------------
-#(28 7.2303333282471 #(0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 0)
- 7.2299618721008 #(0 0 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0)
- 7.2240290641785 #(0 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1)
- 7.1576952692751 #(0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0)
- 7.1576952934265 #(0 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0)
+(vector 28 7.1576952934265 (fv 0 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0)
- 6.194333 #(0.000000 0.461469 1.000349 0.803373 1.168587 0.024623 1.058059 0.556758 0.339687 -0.039138 0.758066 1.745059 0.807780 1.571890 1.228964 0.154521 0.924717 0.956602 0.566419 0.484182 0.866381 1.111454 0.658768 1.596394 1.589793 0.525646 1.470517 0.088018)
+ 6.190947 (fv 0.000000 0.460822 1.000235 0.802902 1.169351 0.023696 1.059034 0.557253 0.339303 -0.037893 0.757652 1.745281 0.808299 1.572816 1.228654 0.154747 0.925847 0.957314 0.565556 0.484885 0.864794 1.110639 0.659146 1.596331 1.587743 0.524304 1.470688 0.086831)
)
;;; 29 prime --------------------------------------------------------------------------------
-#(29 7.2895045280457 #(0 0 1 0 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0)
- 7.24235304747816 #(0 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 0)
- 7.2415904369233 #(0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 0)
+(vector 29 7.2415904369233 (fv 0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 0)
- 6.368765 #(0.000000 0.900254 0.027142 1.660657 0.584082 0.593092 1.394525 1.009940 -0.075116 0.062062 1.780420 1.537061 1.001163 1.590260 -0.058740 1.025484 1.516754 1.279232 0.139731 -0.033979 0.723291 0.483719 0.612778 1.372812 1.210251 1.303795 0.985792 0.846655 0.580521)
+ 6.364996 (fv 0.000000 0.899299 0.027883 1.660781 0.583908 0.594226 1.394105 1.009420 -0.076432 0.063436 1.779221 1.537249 1.002516 1.590894 -0.057219 1.023692 1.515341 1.279493 0.140022 -0.035094 0.723643 0.484040 0.612756 1.373872 1.209603 1.304864 0.985337 0.845953 0.581252)
)
;;; 30 prime --------------------------------------------------------------------------------
-#(30 7.5369029045105 #(0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 0 0)
- 7.5239403940776 #(0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 1 0 0 0 1 1)
- 7.5096759796143 #(0 0 0 0 1 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0 1)
- 7.4977698326111 #(0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 1)
- 7.1189651489258 #(0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0)
+(vector 30 7.1189651489258 (fv 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 0)
- 6.455056 #(0.000000 1.685092 0.803144 0.933178 0.851205 1.702893 1.276757 1.473891 1.214641 1.899135 0.955275 1.785116 1.951375 1.380993 0.108043 0.107362 1.259044 1.566833 0.410038 0.385357 1.590927 0.967494 0.055307 0.915568 1.665534 1.654904 1.093237 1.341512 0.652362 0.862919)
+ 6.451812 (fv 0.000000 1.683608 0.803658 0.933316 0.850814 1.701341 1.277986 1.473972 1.214431 1.898492 0.954836 1.784293 1.951482 1.381903 0.107238 0.105553 1.260609 1.566570 0.409971 0.385253 1.590967 0.968660 0.054889 0.914665 1.664915 1.656054 1.094096 1.343614 0.650979 0.864222)
)
;;; 31 prime --------------------------------------------------------------------------------
-#(31 7.5859903003103 #(0 1 1 0 0 0 0 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1)
- 7.5834159851074 #(0 0 0 1 1 0 0 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0)
- 7.5718903541565 #(0 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1)
- 7.4906754493713 #(0 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 1)
+(vector 31 7.4906754493713 (fv 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 1)
+
+ 6.701515 (fv 0.000000 0.707031 0.658082 0.778665 1.395076 0.565253 0.395956 1.065744 1.710897 0.801620 1.512714 1.121124 1.688469 1.338401 0.622466 1.725968 1.295045 0.892738 0.244280 0.958065 0.828867 0.800413 0.064995 1.349330 1.878947 0.861664 0.695097 1.073201 0.907698 1.910585 0.416756)
- 6.705979 #(0.000000 0.706297 0.657580 0.778811 1.395490 0.565205 0.395745 1.065925 1.710781 0.800620 1.512161 1.120272 1.688611 1.338404 0.623109 1.725845 1.294941 0.893147 0.243948 0.958568 0.828527 0.799976 0.065389 1.349213 1.878166 0.860699 0.694577 1.072202 0.907981 1.910156 0.416901)
+ ;; 30+1
+ 6.615976 (fv 0.000000 1.619082 0.923169 1.083084 0.781957 1.611725 1.231796 1.488577 1.226090 0.083999 1.020558 1.699217 -0.014673 1.346295 -0.063182 -0.022308 1.145334 1.655017 0.305814 0.373230 1.594198 0.992544 0.008700 0.844473 1.661053 1.801356 0.850925 1.501091 0.639723 0.929876 0.176165)
)
;;; 32 prime --------------------------------------------------------------------------------
-#(32 7.7375974655151 #(0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0)
- 7.719434261322 #(0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 1 1 0)
- 7.6655950546265 #(0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 1)
- 7.6567826271057 #(0 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0 1 1 0 0 0 0)
- 7.6309351921082 #(0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0)
+(vector 32 7.6309351921082 (fv 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0)
+
+ 6.829554 (fv 0.000000 0.353769 0.512450 0.072420 0.585526 0.147200 0.899992 1.177093 0.978539 1.319655 0.744178 0.765351 0.245581 0.971119 0.793076 1.664663 0.073560 1.968693 0.219541 -0.142255 1.387234 0.796908 0.143099 1.544481 1.359170 -0.183896 0.300411 0.910906 1.770472 1.091214 0.308566 1.575721)
- 6.846403 #(0.000000 0.317420 0.520300 0.070642 0.584887 0.129922 0.892922 1.218093 1.001423 1.318288 0.729983 0.777258 0.277892 0.951754 0.791917 1.675165 0.083629 1.952041 0.195446 -0.156586 1.400977 0.824055 0.125965 1.513575 1.367842 -0.159130 0.268405 0.922547 1.768785 1.088588 0.278513 1.541236)
+ ;; 31+1
+ 6.864557 (fv 0.000000 1.684531 0.907871 0.937049 0.576460 1.576459 1.338803 1.563265 1.353157 -0.035626 1.089066 1.735003 -0.147935 1.441252 -0.039130 -0.134227 1.098931 1.555167 0.496142 0.453987 1.332697 1.055734 0.066385 0.757972 1.840407 1.616574 0.776929 1.400044 0.751413 0.894663 0.088525 0.248633)
+
+ ;; 33-1
+ 6.772281 (fv 0.000000 -0.104424 1.369006 0.833384 0.832316 0.684545 1.080484 0.996539 1.125140 0.264781 0.104162 1.034076 1.132845 0.966270 -0.147521 -0.070104 -0.108305 0.137329 0.336575 0.120508 -0.030229 1.160998 -0.149314 0.018366 1.122475 -0.088339 0.190809 0.749038 -0.017283 -0.181633 0.895249 0.011511)
)
;;; 33 prime --------------------------------------------------------------------------------
-#(33 7.9869227409363 #(0 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 0 0 1 0 1 1 1 1)
- 7.8325562477112 #(0 0 0 0 0 1 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 1 0)
- 7.7895503044128 #(0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1 0 0 1)
- 7.7389698028564 #(0 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 0)
+(vector 33 7.7389698028564 (fv 0 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 1 1 0)
- 6.852788 #(0.000000 1.539200 1.266286 0.748660 0.963206 0.758460 0.877683 0.418254 1.018962 0.962837 1.081332 0.548891 1.498585 0.195137 0.924655 0.365849 0.603185 1.399010 0.183124 1.140496 0.264983 0.002467 0.997753 0.033237 0.434579 0.985662 1.782031 0.300811 1.604739 1.624255 0.715653 0.020296 0.685693)
+ 6.846444 (fv 0.000000 1.540730 1.269040 0.749184 0.961715 0.756150 0.876752 0.416027 1.022774 0.964239 1.083376 0.550495 1.494046 0.196678 0.925862 0.362000 0.602774 1.401166 0.181115 1.142230 0.264880 0.003237 0.994773 0.034504 0.433160 0.985315 1.781928 0.301442 1.605371 1.626266 0.719713 0.024414 0.683173)
)
;;; 34 prime --------------------------------------------------------------------------------
-#(34 8.0215682983398 #(0 0 1 1 0 0 1 0 1 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0)
- 7.9724597930908 #(0 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 1 0 0 0 0 0 0 0 0)
- 7.9716167449951 #(0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1)
- 7.9716163031165 #(0 1 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 0 0 1)
- 7.9624452590942 #(0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 0 0 0)
+(vector 34 7.9624452590942 (fv 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 0 0 0)
- 6.997530 #(0.000000 1.756192 0.197911 1.712054 0.360535 0.831758 0.346826 0.629395 1.913574 1.210034 1.177415 -1.879851 1.382898 0.684831 1.526025 -0.404142 1.591629 1.225539 1.048920 0.612131 0.689895 1.211303 0.621944 0.033165 1.291756 1.065477 0.499766 0.035421 0.801314 1.427457 1.247900 0.450251 1.560447 0.395183)
+ 6.991192 (fv 0.000000 1.753519 0.200582 1.709673 0.364080 0.826783 0.339745 0.629017 1.916751 1.209744 1.171294 -1.878381 1.379347 0.682133 1.526150 -0.403398 1.590798 1.225400 1.046260 0.612397 0.683970 1.216405 0.626313 0.038228 1.289324 1.063867 0.495350 0.036835 0.806562 1.424403 1.251942 0.446062 1.562643 0.395827)
)
;;; 35 prime --------------------------------------------------------------------------------
-#(35 8.2040424346924 #(0 0 0 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 0 0 0)
- 8.1993579864502 #(0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 0 0)
- 8.1756086349487 #(0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 0 1)
- 8.1555442810059 #(0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0)
- 8.1336851119995 #(0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 0 0 0 0)
- 8.1317510604858 #(0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 0 1 0 0 0 0)
- 8.0019035339355 #(0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 0 0)
+(vector 35 8.0019035339355 (fv 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 0 0)
+
+ 7.163607 (fv 0.000000 1.266503 0.439150 0.502027 -0.033212 1.025554 1.236433 1.852606 1.521580 0.894650 0.982935 1.338812 0.175216 1.929333 1.483026 0.812681 0.144350 1.543173 0.347773 0.191753 0.996456 1.584603 0.595312 0.526825 0.409349 0.179419 0.765371 0.331481 0.734526 0.534073 1.395010 0.148584 0.213643 0.199292 1.071967)
- 7.169782 #(0.000000 1.263902 0.439503 0.501488 -0.036484 1.026773 1.235138 1.853123 1.521674 0.898273 0.987196 1.339489 0.176261 1.926640 1.485753 0.807619 0.143449 1.546015 0.350769 0.194390 0.997233 1.588432 0.596576 0.529514 0.411057 0.178144 0.766424 0.340274 0.736061 0.536972 1.395515 0.152382 0.219479 0.207343 1.079036)
+ ;; 34+1
+ 7.250722 (fv 0.000000 1.833406 0.276500 1.676183 0.284824 0.952861 0.274961 0.549393 1.855724 1.259088 1.170735 -1.972280 1.233657 0.707290 1.353858 -0.502547 1.522469 1.324648 0.749540 0.580274 0.753018 1.178005 0.466257 0.194427 1.292227 0.949230 0.518969 0.114495 0.772899 1.429905 1.258425 0.333692 1.615077 0.323568 0.024260)
+
+ ;; 36-1
+ 7.226635 (fv 0.000000 0.015639 1.313898 1.067017 0.012678 0.205933 -0.220601 0.741706 1.132622 1.273222 0.064153 -0.061062 0.016379 -0.109368 1.266070 0.708642 0.100132 0.506303 0.326245 0.009869 0.128374 0.656500 0.103915 0.211137 -0.048847 0.134642 0.911060 -0.081204 1.078761 0.959214 1.298439 0.058469 -0.265528 -0.047843 0.487719)
+
+ ;; 37-2
+ 7.337307 (fv 0.000000 1.255715 1.209445 1.285464 0.609971 1.084010 0.746511 0.131735 0.992588 -0.165317 1.349080 0.347697 1.563547 0.269558 1.052909 1.187133 0.630960 0.126283 1.974444 0.920793 0.149276 0.235777 0.684763 0.805570 1.167945 0.309490 0.732548 0.639985 1.194191 -0.082787 0.442732 0.130132 1.297597 1.522523 -0.004298)
+
+ ;; 36-1 again
+ 7.270607 (fv 0.000000 1.224685 0.688298 0.933888 0.799409 1.040304 0.882804 1.691450 1.134732 0.118453 1.557180 0.586802 1.344681 0.201498 1.086994 1.546739 0.883322 0.653756 0.179650 1.296869 -0.225456 -0.099064 0.999391 0.575486 1.210161 0.192596 0.624682 0.585705 1.229555 0.174654 0.165564 0.036132 1.525777 1.424254 0.061875)
)
;;; 36 prime --------------------------------------------------------------------------------
-#(36 8.4211139678955 #(0 0 0 0 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0)
- 8.4162702560425 #(0 0 0 0 1 1 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0)
- 8.4114933013916 #(0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 0 0 1 1 1 0 0 0 0 0)
- 8.3864717483521 #(0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 0 0 0 0 0)
- 8.3820142745972 #(0 0 0 1 0 0 1 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 1 1 1 1 0 1 0 0 0 0 0)
- 8.3783054351807 #(0 1 1 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 0 0 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0)
- 8.3031883239746 #(0 0 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0)
+(vector 36 8.3031883239746 (fv 0 0 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0)
+
+ 7.274340 (fv 0.000000 0.295214 1.648256 0.584870 0.666257 0.185867 0.791897 0.205307 0.094941 1.078003 0.393529 1.106172 0.869922 0.874970 0.914168 -0.075429 0.352173 -0.206951 1.433194 0.016874 1.804925 1.769354 0.780563 1.415336 1.733698 0.569376 0.514365 1.527457 0.738716 1.585860 0.004452 0.303849 0.468887 1.200500 1.687045 -0.272506)
- 7.280082 #(0.000000 0.294761 1.647724 0.587053 0.665755 0.185039 0.791373 0.207007 0.096330 1.079919 0.394875 1.106000 0.870746 0.874300 0.914483 -0.076086 0.352212 -0.205907 1.433246 0.017852 1.806977 1.768162 0.777435 1.414293 1.732442 0.566989 0.514995 1.525687 0.739924 1.587133 0.004339 0.303343 0.468930 1.199769 1.687861 -0.272353)
+ ;; 34+2
+ 7.326328 (fv 0.000000 0.224320 -0.145696 0.800619 0.068109 0.664686 1.202282 -0.026091 0.124729 1.390134 0.094406 0.787084 -0.284049 0.196932 0.011705 -0.061258 1.288162 0.209106 0.650222 0.837106 1.144479 -0.004444 -0.079317 -0.252873 1.282751 1.105461 -0.151235 -0.220044 0.048391 0.784914 0.800542 0.208916 -0.135577 0.180326 -0.083829 0.058422)
+
+ ;; 37-1
+ 7.188203 (fv 0.000000 1.311785 0.710177 0.919863 0.806114 1.220385 0.913244 1.649138 1.158903 -0.117650 1.420543 0.532433 1.420824 0.031354 1.130470 1.529113 0.851075 0.566610 -0.022612 1.109803 -0.179865 -0.219467 1.014788 0.671450 1.268941 0.095596 0.593655 0.518696 1.410763 0.018554 0.158212 0.022548 1.368086 1.347905 1.919434 1.204584)
)
;;; 37 prime --------------------------------------------------------------------------------
-#(37 8.6493539810181 #(0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 1 0 1 0 0)
- 8.5117635726929 #(0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 1 1 0)
- 8.4779825210571 #(0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0)
- 8.4775905609131 #(0 0 1 0 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1)
+(vector 37 8.4775905609131 (fv 0 0 1 0 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1)
- 7.297775 #(0.000000 1.395632 1.098679 1.239017 0.588402 1.095080 0.653176 1.737438 1.140056 0.033833 1.501911 0.225410 1.625324 0.174540 1.299228 1.079000 0.677213 0.149592 1.836234 1.058668 -0.012258 0.027671 0.886816 0.699363 1.426208 0.167581 0.800515 0.616270 1.042057 0.117950 0.537680 -0.071450 1.316921 1.392182 1.919277 1.301776 1.677134)
+ 7.291595 (fv 0.000000 1.385574 1.094219 1.256844 0.579410 1.074351 0.652085 1.737017 1.132509 0.023783 1.497034 0.201580 1.618763 0.156207 1.295800 1.067404 0.684624 0.145230 1.829069 1.057901 0.013674 0.026959 0.892842 0.719241 1.431201 0.175608 0.784924 0.608541 1.031616 0.099402 0.526982 -0.079447 1.301608 1.399791 1.919478 1.303159 1.654914)
)
;;; 38 prime --------------------------------------------------------------------------------
-#(38 8.6871099472046 #(0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 0 1 0 0 0 0 0 0 0)
- 8.67653465271 #(0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0)
- 8.6688671112061 #(0 1 0 0 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 0 0 0)
- 8.6612920761108 #(0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0)
- 8.6306476593018 #(0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0)
- 8.6206035614014 #(0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0)
- 8.5991640090942 #(0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0)
- 8.5527725219727 #(0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)
+(vector 38 8.5527725219727 (fv 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)
- 7.402566 #(0.000000 0.233155 1.168251 -0.109726 0.359730 0.959950 0.067969 0.724033 0.167622 0.631655 1.540692 1.733494 0.341946 1.112437 1.355122 -0.335473 0.297651 0.277730 1.096262 -0.227854 1.743997 0.486003 0.002233 0.659076 1.839056 0.967972 0.290034 0.438981 0.884333 0.649103 0.478914 1.515557 0.205372 0.150915 -0.153921 1.377711 0.627341 0.171389)
+ 7.395907 (fv 0.000000 0.229361 1.165787 -0.110257 0.360118 0.958030 0.069946 0.724227 0.169462 0.629891 1.545997 1.736970 0.340776 1.117984 1.362890 -0.333746 0.304546 0.284267 1.101870 -0.220411 1.748591 0.492644 0.009938 0.667006 1.844837 0.974373 0.297199 0.452149 0.892727 0.659717 0.488303 1.523287 0.213584 0.164389 -0.141331 1.392379 0.641595 0.183921)
)
;;; 39 prime --------------------------------------------------------------------------------
-#(39 8.9125862121582 #(0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 0 0 0 0 0 0)
- 8.8173857964668 #(0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0)
+(vector 39 8.8173857964668 (fv 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0)
- 7.462619 #(0.000000 0.007184 0.952353 -0.058886 1.652308 1.379167 0.944040 0.381310 -0.157056 0.995816 0.907956 1.435609 0.370197 0.331200 1.307527 1.593709 -0.021747 1.050228 1.534226 1.367297 1.174641 1.240279 0.685449 0.661754 0.492802 0.706605 0.997172 1.029159 1.009131 1.152088 1.459259 0.201871 1.248452 1.814044 1.395412 0.023854 0.379064 1.430461 1.554978)
+ 7.452083 (fv 0.000000 -0.003327 0.916189 -0.059920 1.642633 1.388547 0.951086 0.403885 -0.174730 0.969870 0.918579 1.463076 0.392796 0.310790 1.322505 1.568519 -0.013721 1.080957 1.546749 1.334291 1.196748 1.241477 0.666226 0.658367 0.483066 0.709740 0.970447 1.021587 1.015221 1.154977 1.464323 0.177481 1.236124 1.797764 1.373028 0.022625 0.381731 1.433474 1.548372)
)
;;; 40 prime --------------------------------------------------------------------------------
-#(40 9.0681540417544 #(0 1 0 0 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1)
- 8.9134502410889 #(0 0 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1)
+(vector 40 8.9134502410889 (fv 0 0 1 0 1 1 0 0 1 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1)
+
+ 7.703588 (fv 0.000000 1.735488 1.656851 1.224286 0.044381 0.581732 0.870499 0.678243 0.396963 1.559949 1.753552 0.343685 1.182244 0.436049 0.704051 1.315848 0.612950 0.283482 1.616300 0.417655 1.870367 0.045128 0.404846 0.027986 1.838093 1.350622 0.788217 0.264993 1.270928 0.453126 0.746731 1.438328 0.714772 1.669939 -0.004462 0.932368 1.451203 0.182154 1.479009 1.559243)
- 7.709371 #(0.000000 1.736887 1.656918 1.223607 0.043658 0.581801 0.871649 0.677984 0.397692 1.559307 1.752118 0.343461 1.181038 0.436146 0.703188 1.315547 0.613047 0.284533 1.616041 0.418094 1.868888 0.044219 0.404956 0.027853 1.837944 1.351166 0.786580 0.266485 1.270203 0.452404 0.746555 1.439001 0.715305 1.668653 -0.003806 0.933865 1.451472 0.181890 1.478333 1.558459)
+ ;; 39+1
+ 7.542973 (fv 0.000000 -0.041200 1.048990 -0.088096 1.469596 1.426659 0.704430 0.532863 -0.271666 1.021284 0.854349 1.691302 0.165173 0.234052 1.293759 1.553143 -0.290199 1.111317 1.388897 1.428535 1.198923 1.295686 0.607124 0.554003 0.553080 0.829915 1.372981 1.113790 0.892248 1.036179 1.715559 0.155629 1.485519 1.734906 1.416427 0.111242 0.390867 1.435517 1.580034 0.394829)
)
;;; 41 prime --------------------------------------------------------------------------------
-#(41 9.295313835144 #(0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0)
- 9.1567583084106 #(0 1 0 0 0 1 0 1 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0)
+(vector 41 9.1567583084106 (fv 0 1 0 0 0 1 0 1 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0)
+
+ 7.865855 (fv 0.000000 0.608338 -0.060098 1.260166 0.343974 0.016950 -0.247861 -0.127427 0.108013 -0.084777 1.510985 0.480995 1.445979 -0.013184 1.345726 0.790782 0.040458 1.554753 1.065658 0.404394 0.487625 0.747477 1.296516 0.562390 1.713973 0.682704 0.619563 0.946390 0.938148 0.771516 1.743852 1.318578 0.561202 0.223419 0.656108 1.580261 0.293473 0.865769 0.313306 1.414219 0.732206)
- 7.873320 #(0.000000 0.607756 -0.056537 1.261680 0.344721 0.017386 -0.245973 -0.125184 0.108312 -0.085060 1.508851 0.480530 1.449114 -0.016899 1.347757 0.790101 0.036206 1.554160 1.064218 0.404291 0.491098 0.747753 1.294955 0.560643 1.717340 0.682374 0.619471 0.944032 0.937915 0.770667 1.743174 1.318275 0.557298 0.220796 0.654358 1.580664 0.294369 0.865506 0.311869 1.412278 0.730630)
+ ;; 40 + 1
+ 7.720320 (fv 0.000000 -0.115191 1.182807 0.023805 1.562688 1.390669 0.693038 0.384401 -0.432021 0.902901 0.808566 1.764939 0.071559 0.180956 1.306988 1.386263 -0.325917 1.184850 1.379486 1.267820 1.088531 1.531591 0.443244 0.383528 0.465953 0.767254 1.394223 1.223657 0.755343 1.085342 1.737843 0.118005 1.556067 1.593289 1.235706 0.152645 0.264917 1.446707 1.588810 0.262147 0.136941)
)
;;; 42 prime --------------------------------------------------------------------------------
-#(42 9.3096771240234 #(0 0 1 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0)
- 9.2193641662598 #(0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0)
+(vector 42 9.2193641662598 (fv 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0)
- 7.976649 #(0.000000 -0.294067 -0.100221 1.645937 0.993055 1.213312 1.300615 1.703743 0.311509 1.376003 1.018425 1.242737 0.341290 -0.026256 0.792964 0.385141 1.597388 0.299886 1.243911 0.805740 1.871409 1.514300 0.817060 0.278711 0.153124 1.791391 0.440745 1.042299 1.104284 0.810751 1.172080 0.353060 0.087889 0.393969 1.056414 1.165308 0.252160 0.201723 1.386435 0.806866 0.859271 0.585244)
+ 7.967849 (fv 0.000000 -0.295563 -0.099748 1.645998 0.994997 1.211069 1.302259 1.702033 0.311003 1.380194 1.021127 1.240710 0.343052 -0.024723 0.792276 0.383501 1.598556 0.301882 1.243030 0.805694 1.869672 1.515585 0.818223 0.277882 0.151155 1.792151 0.439910 1.043803 1.106182 0.814125 1.169477 0.353168 0.087800 0.390591 1.058086 1.167577 0.254783 0.202834 1.385207 0.802821 0.860337 0.585161)
+
+ ;; 41+1
+ 7.869767 (fv 0.000000 -0.061943 1.138293 -0.062352 1.677941 1.387789 0.696129 0.354209 -0.606277 0.820682 0.889412 1.749845 0.156626 0.153950 1.241240 1.226387 -0.243954 1.180563 1.446765 1.133383 1.088516 1.534516 0.379614 0.441871 0.531294 0.625705 1.211996 1.249505 0.811274 1.137271 1.690807 0.091208 1.719416 1.589298 1.288167 0.231299 0.255350 1.544776 1.691946 0.324682 0.145604 -0.146627)
)
;;; 43 prime --------------------------------------------------------------------------------
-#(43 9.4925568571597 #(0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1)
- 9.4329051971436 #(0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1)
+(vector 43 9.4329051971436 (fv 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1)
+
+ 8.045098 (fv 0.000000 1.817726 0.258426 -0.110242 1.213496 0.116841 0.189488 1.576716 0.807175 0.814618 0.974723 1.682997 0.507481 0.400625 1.207987 1.609632 0.042496 -0.018345 0.188609 1.537320 1.421611 1.487985 0.125474 1.195313 1.777900 0.097292 1.089983 0.284602 -0.035452 0.114851 -0.014176 0.684966 0.713816 1.698239 1.505014 0.277355 1.721721 1.307506 0.790560 -0.024590 1.696281 0.234403 1.469880)
- 8.052596 #(0.000000 1.816863 0.251180 -0.101803 1.211293 0.124141 0.186625 1.581986 0.803744 0.812819 0.977042 1.687777 0.501603 0.399596 1.200421 1.598413 0.039999 -0.019672 0.189458 1.532596 1.423271 1.490395 0.129144 1.199440 1.781325 0.095327 1.091938 0.281252 -0.033146 0.111893 -0.011424 0.683919 0.720246 1.699710 1.499670 0.283290 1.727430 1.305891 0.786441 -0.012809 1.706663 0.229827 1.476606)
+ ;; 44-1
+ 7.936372 (fv 0.000000 0.547620 0.739031 1.442428 0.549512 0.577585 0.459986 1.527195 1.215306 0.359566 1.254454 1.014209 0.650822 0.596119 0.113760 0.896295 1.336762 1.511746 1.057661 0.208519 1.475881 1.168554 0.473943 0.693948 1.550424 1.853884 0.945372 1.595949 0.778275 1.634785 0.682180 0.046625 1.212650 1.360060 1.301003 1.439535 -0.124409 0.942540 0.731761 1.333209 0.714942 0.471897 0.650290)
)
;;; 44 prime --------------------------------------------------------------------------------
-#(44 9.6622378996026 #(0 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0)
- 9.6263332366943 #(0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1)
+(vector 44 9.6263332366943 (fv 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1)
- 8.186379 #(0.000000 1.258294 0.188009 0.793457 0.965304 0.871206 0.511482 0.770526 0.338509 0.782315 0.038940 0.860944 1.772325 0.077037 0.206405 1.741762 1.806951 0.917625 1.517383 0.315876 0.489585 0.195725 1.293188 1.256809 0.594477 0.227025 1.096923 1.257180 0.601302 -0.027693 0.327006 0.018133 0.569657 1.049726 1.290541 1.483881 1.062746 -0.257630 0.220151 1.063343 0.811758 1.528320 0.926790 1.801379)
+ 8.176709 (fv 0.000000 1.257550 0.185092 0.796030 0.965692 0.874957 0.509986 0.767942 0.341523 0.782136 0.038164 0.864386 1.769646 0.079272 0.204040 1.740714 1.803726 0.921433 1.521099 0.318212 0.489644 0.199834 1.292293 1.253087 0.592822 0.223282 1.099161 1.260064 0.604685 -0.025938 0.319010 0.021098 0.567021 1.052022 1.286473 1.481285 1.059939 -0.262037 0.222072 1.063305 0.811574 1.525604 0.928719 1.796860)
+
+ ;; 45-1
+ 8.096356 (fv 0.000000 0.562197 0.780059 1.445061 0.297993 0.361779 0.450977 1.579753 1.251177 0.406295 1.140037 1.270462 0.688429 0.742666 0.310753 0.814792 1.242058 1.590925 1.239292 0.244955 1.563091 1.453652 0.466187 0.926031 1.420624 1.869915 0.975705 1.750035 0.662252 1.713066 0.628893 0.005473 1.403763 1.231668 1.313745 1.548647 0.181657 1.165934 0.757198 1.479137 0.584746 0.478571 0.777834 -0.217890)
)
;;; 45 prime --------------------------------------------------------------------------------
-#(45 9.8476276594031 #(0 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 0 1 1)
- 9.7923860549927 #(0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1)
+(vector 45 9.7923860549927 (fv 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1)
- 8.165485 #(0.000000 0.511608 0.822951 1.455331 0.214795 0.307770 0.458366 1.481675 1.271193 0.361373 1.143591 1.370431 0.826361 0.739155 0.259327 0.773657 1.244167 1.667129 1.265669 0.163403 1.558668 1.566056 0.363200 0.842794 1.459807 1.913157 0.921378 1.780310 0.525759 1.791391 0.579740 0.074335 1.283163 1.241235 1.309917 1.536918 0.147037 1.158220 0.825732 1.333624 0.588712 0.481129 0.728773 -0.256053 0.795327)
+ 8.156599 (fv 0.000000 0.504922 0.822887 1.454973 0.213937 0.312131 0.458345 1.480849 1.269108 0.365243 1.136961 1.370780 0.828694 0.744612 0.260671 0.781252 1.246491 1.660559 1.261864 0.159271 1.560422 1.570906 0.366422 0.845904 1.468563 1.922211 0.928352 1.793476 0.526909 1.787205 0.580505 0.086715 1.290991 1.241712 1.319383 1.542592 0.148589 1.164537 0.833531 1.339389 0.578898 0.484755 0.736594 -0.242427 0.801799)
)
;;; 46 prime --------------------------------------------------------------------------------
-#(46 9.928765296936 #(0 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0)
- 9.8914480209351 #(0 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 1 0)
- 9.7220277786255 #(0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0)
+(vector 46 9.7220277786255 (fv 0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0)
- 8.272231 #(0.000000 0.446355 0.086083 1.446810 1.089670 0.773446 1.029698 0.397020 -0.026542 1.855242 0.020094 1.355538 1.090648 -0.116009 1.241301 0.491166 0.418934 1.014167 1.841270 0.628548 1.149623 0.250485 0.790131 1.148896 0.945837 0.162231 0.886695 1.383112 1.954825 0.083965 -0.492480 0.492721 1.326171 0.815200 1.214161 0.712998 -0.027992 1.494579 0.879607 0.963700 1.300593 1.255054 1.312098 0.517498 0.520426 1.097202)
+ 8.261457 (fv 0.000000 0.441366 0.083292 1.447582 1.080353 0.774431 1.031820 0.396571 -0.029186 1.855247 0.017145 1.352007 1.097546 -0.117433 1.240120 0.492762 0.418188 1.012485 1.839598 0.629307 1.143304 0.248686 0.786166 1.148481 0.944111 0.160389 0.887598 1.383912 1.951363 0.089194 -0.493379 0.490615 1.318218 0.811054 1.210433 0.709880 -0.035076 1.496491 0.871523 0.967276 1.296575 1.252407 1.309942 0.517653 0.515382 1.088417)
)
;;; 47 prime --------------------------------------------------------------------------------
-#(47 10.097447395325 #(0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 0 0 0)
- 10.0 #(0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0)
+(vector 47 10.0 (fv 0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0)
+
+ 8.421570 (fv 0.000000 1.199171 0.222010 0.019659 0.963763 0.124932 1.211729 1.737991 1.094580 1.129734 1.190285 0.683207 -0.164112 0.760349 0.581192 1.729176 1.903941 0.164043 1.172610 0.400191 0.298724 1.638863 1.039149 1.877811 1.604178 1.896976 0.373311 1.442981 1.057507 1.304308 1.366346 0.989245 1.435551 1.273331 -0.037405 1.342363 0.026228 1.277440 1.325955 1.225688 -0.091448 1.243683 1.490056 0.134719 0.038689 0.617889 0.397223)
- 8.431403 #(0.000000 1.195845 0.223688 0.002679 0.969447 0.123048 1.208727 1.738269 1.096701 1.139773 1.184914 0.696967 -0.153442 0.760266 0.590296 1.724814 1.904918 0.166203 1.168185 0.392281 0.301484 1.647772 1.038367 1.885275 1.601069 1.909785 0.393812 1.444378 1.061995 1.300421 1.364246 0.997567 1.438013 1.277661 -0.028216 1.341591 0.032641 1.284716 1.325050 1.230561 -0.098780 1.252019 1.487905 0.140338 0.038983 0.624965 0.404914)
+ ;; 46+1
+ 8.268289 (fv 0.000000 0.357443 0.232912 1.380147 1.115226 0.794363 1.003118 0.354162 -0.098010 1.882974 0.011731 1.431470 1.060533 -0.173886 1.243389 0.433576 0.427301 0.932883 1.964789 0.661151 1.135623 0.224910 0.703565 1.198466 0.988252 0.007869 0.877345 1.478313 1.822166 0.223930 -0.274799 0.527743 1.328214 0.957522 1.199220 0.836897 0.009700 1.499725 0.828964 0.836474 1.158394 1.390117 1.252214 0.607531 0.602372 1.108309 -0.308979)
)
;;; 48 prime --------------------------------------------------------------------------------
-#(48 10.298553466797 #(0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 0)
- 10.248653411865 #(0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0)
- 10.073040962219 #(0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1)
+(vector 48 10.073040962219 (fv 0 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1)
- 8.478110 #(0.000000 0.336000 1.569771 1.666599 0.443072 0.427146 0.737988 1.691482 -0.014410 0.001805 0.949022 0.783579 0.530492 1.026372 0.768167 0.421666 0.982198 0.321759 -0.018200 0.450966 -0.010718 0.638571 1.620288 1.250536 1.850327 -0.214693 0.826191 1.366790 1.275437 0.688618 1.532175 1.116194 -0.141056 0.605717 1.704882 0.651133 1.381033 0.845938 0.436723 0.927364 1.369020 1.153512 1.850814 1.185924 0.735474 0.962820 0.284695 -0.262489)
+ 8.468727 (fv 0.000000 0.332125 1.567930 1.667264 0.442332 0.427404 0.736248 1.688653 -0.012194 0.001963 0.946717 0.783117 0.528363 1.021452 0.764794 0.424311 0.975629 0.318718 -0.017782 0.452256 -0.011646 0.634442 1.620045 1.251183 1.855810 -0.212250 0.823868 1.371356 1.272442 0.687371 1.532020 1.114788 -0.144494 0.601199 1.707870 0.646890 1.378450 0.845449 0.429827 0.928104 1.365712 1.152987 1.849756 1.181620 0.737310 0.960075 0.285625 -0.264250)
)
;;; 49 prime --------------------------------------------------------------------------------
-#(49 10.28332063912 #(0 0 1 0 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 0)
- 10.207101821899 #(0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 1 0 0 0 0)
- 10.209 #(0 1 1 0 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 0)
+(vector 49 10.209 (fv 0 1 1 0 0 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 0)
+
+ 8.635701 (fv 0.000000 1.497567 0.290121 0.986848 0.952275 0.318809 -0.087393 0.815566 0.755417 1.644345 1.093196 1.596845 1.195048 1.825278 0.352544 1.500396 0.111683 1.721871 0.368622 0.016610 1.166008 0.992742 0.548001 1.794858 -0.049088 0.145023 0.031735 0.501144 1.167443 1.072488 1.771198 1.965444 1.813832 0.055643 1.178365 0.731304 -0.108216 1.823862 1.684500 1.505474 0.962838 1.663276 0.896417 -0.047513 0.341741 0.867962 0.622940 1.858325 1.225407)
+
+ ;; 48+1
+ 8.663039 (fv 0.000000 0.233282 1.589447 1.671036 0.438087 0.414167 0.679012 1.728850 0.023692 0.137515 1.015881 0.702030 0.655508 0.905046 0.682763 0.579979 1.082390 0.228729 -0.103033 0.415057 0.029242 0.738968 1.600166 1.205869 1.975508 -0.109422 0.921796 1.220834 1.561720 0.608646 1.497185 1.060920 -0.116318 0.565733 1.743370 0.776166 1.333349 0.886037 0.536440 0.806648 1.332765 1.166311 1.868868 1.215596 0.738421 0.985296 0.279827 -0.366830 0.092455)
- 8.646636 #(0.000000 1.500224 0.285369 0.985091 0.948702 0.314746 -0.082290 0.815056 0.760127 1.638003 1.095425 1.598187 1.203694 1.817077 0.348765 1.494637 0.113363 1.721160 0.374135 0.022011 1.167613 0.993020 0.549868 1.791373 -0.045838 0.144106 0.035392 0.505334 1.169625 1.082594 1.764673 1.965820 1.815862 0.053174 1.178031 0.723915 -0.106669 1.831172 1.689847 1.513357 0.958521 1.659686 0.894550 -0.051091 0.334699 0.873219 0.619845 1.852917 1.226619)
+ ;; 51-2
+ 8.582839 (fv 0.000000 1.015072 1.263701 0.053109 -0.198567 -0.119876 -0.074305 0.688310 -0.022609 -0.056918 -0.335561 1.264545 0.175435 0.115160 0.045329 0.044221 0.357377 1.286502 1.011774 0.136492 0.790313 1.216480 1.412877 1.287840 -0.457032 1.185491 0.632250 1.022556 0.092623 0.762340 0.282587 1.173246 0.884457 -0.232556 1.275664 0.026771 1.001804 1.127230 -0.112893 0.390785 1.060560 -0.011579 0.935318 0.798092 1.155912 -0.045270 0.311662 -0.007451 -0.291556)
)
;;; 50 prime --------------------------------------------------------------------------------
-#(50 10.669495582581 #(0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 1 1 1 1 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1)
- 10.402973175049 #(0 0 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1)
+(vector 50 10.402973175049 (fv 0 0 1 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1)
- 8.684225 #(0.000000 1.491285 1.053702 1.020229 1.328967 1.080905 0.579059 1.658920 1.277781 1.220025 1.247417 1.457379 0.844590 1.786071 0.049672 0.679920 -0.106729 0.040557 1.115278 1.947349 1.169239 1.002609 0.957464 0.190531 0.763547 0.482139 0.972588 0.115870 0.839723 0.099065 1.319364 1.244222 1.951643 0.924070 0.456641 -0.193008 0.833141 1.072839 0.157119 1.601827 0.879014 1.362790 0.930151 1.476405 0.060196 1.605624 0.644761 1.303297 0.055602 1.229714)
+ 8.676090 (fv 0.000000 1.487746 1.059441 1.025372 1.327289 1.088034 0.562677 1.658212 1.275003 1.216651 1.253782 1.464671 0.843363 1.799547 0.053937 0.685289 -0.108899 0.042484 1.103905 1.939714 1.165290 1.002239 0.949057 0.182130 0.764686 0.473808 0.974801 0.114296 0.831687 0.096978 1.328258 1.232106 1.944542 0.907302 0.451517 -0.196659 0.834303 1.063413 0.149435 1.600622 0.877347 1.358710 0.921698 1.475066 0.048402 1.601242 0.635073 1.286124 0.058142 1.221762)
)
;;; 51 prime --------------------------------------------------------------------------------
-#(51 10.5841327092253 #(0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1)
+(vector 51 10.5841327092253 (fv 0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1)
- 8.663348 #(0.000000 0.551592 1.578396 0.858228 0.463956 0.050766 1.206747 1.407379 0.754907 -0.009022 -0.318589 1.577609 0.775746 -0.087009 1.972322 0.370750 1.193375 0.825570 1.042298 0.972051 -0.101619 0.018264 0.370749 0.809275 0.571012 0.780773 0.251578 1.522021 0.517746 0.487517 0.353262 1.792362 0.344072 0.182378 1.270129 0.433247 0.354110 0.458680 0.925520 0.368371 1.156211 1.182036 0.094916 1.564537 1.890913 1.171735 1.233909 0.740609 0.187822 0.007563 0.620374)
+ 8.652946 (fv 0.000000 0.552138 1.581370 0.856634 0.465868 0.045489 1.205822 1.403218 0.756158 -0.011738 -0.321071 1.578958 0.777145 -0.086815 1.971735 0.371739 1.194751 0.827647 1.040995 0.971514 -0.103101 0.019110 0.372121 0.808088 0.569420 0.781614 0.253334 1.524564 0.516258 0.490039 0.356392 1.792991 0.344408 0.177045 1.267803 0.433404 0.355268 0.458783 0.927023 0.366207 1.155001 1.183690 0.095395 1.563819 1.892864 1.168287 1.234142 0.740278 0.190550 0.004346 0.616333)
)
;;; 52 prime --------------------------------------------------------------------------------
-#(52 10.767134666443 #(0 0 0 0 1 0 1 1 0 0 0 0 0 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 0)
- 10.737469673157 #(0 0 0 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 1)
- 10.64324760437 #(0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0)
+(vector 52 10.64324760437 (fv 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0)
- 8.829976 #(0.000000 0.189833 -0.095321 0.103523 1.734972 1.636212 1.776375 0.447652 1.408978 0.718269 0.422827 -0.240483 1.065635 1.672499 0.096631 0.248263 1.268172 0.493726 1.430604 -0.093598 1.403422 0.422128 -0.036423 1.525046 0.038007 1.463508 -0.028029 0.494989 0.961838 0.306204 0.766195 0.681632 1.132427 1.623313 0.696326 1.783188 -0.038737 1.912521 1.157849 1.535940 1.832384 0.996700 0.918739 1.258280 0.146290 1.434415 0.596523 1.427479 0.741860 0.866228 1.093135 0.879250)
+ 8.817479 (fv 0.000000 0.192798 -0.100823 0.105700 1.730433 1.638226 1.781516 0.446103 1.408775 0.715209 0.415865 -0.245030 1.066219 1.674348 0.092550 0.243790 1.271420 0.492458 1.433072 -0.090924 1.409056 0.418163 -0.043783 1.528262 0.043370 1.470310 -0.026080 0.499433 0.961527 0.302716 0.768317 0.686930 1.132134 1.628592 0.701543 1.788137 -0.034028 1.911798 1.160323 1.534119 1.837005 0.994515 0.926867 1.263245 0.147467 1.441753 0.596623 1.430563 0.749640 0.874777 1.097276 0.882051)
)
;;; 53 prime --------------------------------------------------------------------------------
-#(53 10.969209228042 #(0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 0 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 0 1 0 0 1 1 0 0 1 1 0 0 0 1 0)
- 10.959488868713 #(0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1)
- 10.950836181641 #(0 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 1 0 0 0)
- 10.851609230042 #(0 1 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1)
- 10.848851203918 #(0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0)
- 10.678050692694 #(0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0)
+(vector 53 10.678050692694 (fv 0 1 0 0 1 0 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0)
- 8.962739 #(0.000000 0.787748 1.224472 0.348955 0.332349 0.206924 0.899745 1.916102 1.003870 1.829055 1.665073 0.308025 1.691143 -0.197070 0.388505 0.060512 0.531716 0.680481 0.982948 1.778975 1.222664 0.337140 0.649753 -0.058803 1.547972 0.347003 1.141161 1.624512 1.517680 1.047295 0.924527 0.369009 1.875994 0.555201 0.473060 0.775593 0.840193 0.580200 -0.039078 0.260263 1.048468 1.260739 0.825455 1.842214 0.358480 1.362211 0.973969 0.709279 1.468635 0.680495 0.951978 1.110552 0.102154)
+ 8.953081 (fv 0.000000 0.788009 1.225451 0.347894 0.336100 0.208645 0.898104 1.918038 1.003547 1.827170 1.665391 0.306753 1.689654 -0.198226 0.387896 0.060438 0.532055 0.677523 0.983575 1.778621 1.222864 0.337168 0.648048 -0.059018 1.548622 0.344050 1.142170 1.624821 1.518580 1.046929 0.925606 0.370284 1.876402 0.554168 0.470781 0.776401 0.841340 0.579159 -0.039732 0.259208 1.047217 1.262845 0.826737 1.840523 0.361249 1.360958 0.974324 0.708988 1.467968 0.681409 0.951917 1.111614 0.104759)
)
;;; 54 prime --------------------------------------------------------------------------------
-#(54 11.062943458557 #(0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 1 1 1)
- 11.050 #(0 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 1 1)
- 10.781757504258 #(0 0 1 0 1 0 1 0 0 0 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 1 1 1 1)
- 10.582709312439 #(0 0 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1)
+(vector 54 10.582709312439 (fv 0 0 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1)
- 9.122754 #(0.000000 1.371718 1.647509 1.765709 1.072652 1.166979 0.496825 1.353848 1.098308 1.556239 1.724413 0.301688 1.361856 0.671515 0.597770 1.673383 1.201109 0.688742 0.332400 0.211856 0.118769 -0.068161 1.428413 0.807983 0.883687 1.616945 0.075292 0.411424 1.107510 -0.044106 -0.211445 1.350985 1.358975 1.302926 0.217147 0.764805 1.565255 0.201788 0.572159 1.688349 -0.053211 0.300068 1.047699 1.702269 0.903641 1.277808 0.974048 1.524795 1.749864 0.166081 0.962447 1.732370 0.155129 0.299698)
+ 9.112388 (fv 0.000000 1.372093 1.646727 1.761844 1.071783 1.166972 0.499625 1.353759 1.094968 1.557358 1.723230 0.305306 1.364143 0.672762 0.599554 1.674554 1.196343 0.689593 0.333493 0.212755 0.120333 -0.065165 1.426986 0.808156 0.885002 1.618233 0.075135 0.412240 1.106276 -0.040331 -0.211790 1.351271 1.357179 1.301081 0.221358 0.762445 1.564667 0.202710 0.573995 1.689552 -0.051477 0.301020 1.046697 1.701827 0.907077 1.277114 0.971869 1.525859 1.752503 0.167031 0.961443 1.737745 0.154432 0.302453)
+
+ ;; 53+1:
+ 8.998093 (fv 0.000000 0.833931 1.255875 0.472195 0.500550 0.340958 0.889757 0.121823 0.999320 0.070168 1.822021 0.295115 1.599399 -0.278061 0.379867 0.053981 0.523149 0.552145 1.083746 1.542483 1.125023 0.280437 0.929583 0.145648 1.540352 0.570681 1.206535 1.391546 1.500834 1.280825 0.880416 0.297287 1.694488 0.607699 0.578077 0.733733 1.017737 0.538903 -0.079031 0.194742 1.159273 1.400820 0.893900 1.836755 0.359898 1.011475 0.991536 0.601097 1.637805 0.711833 1.160027 0.904915 0.240256 -0.100113)
)
;;; 55 prime --------------------------------------------------------------------------------
-#(55 11.142364777492 #(0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 1)
- 10.806410031758 #(0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0)
+(vector 55 10.806410031758 (fv 0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 0)
- 9.156419 #(0.000000 0.967925 0.925485 -0.361372 0.611036 0.765787 0.913978 1.392398 0.612598 0.953863 1.346824 -0.021854 0.737080 1.738712 1.628312 1.348991 1.308197 0.205185 1.282997 1.105756 0.626638 0.886978 0.369873 -0.354647 1.472129 1.218930 -1.840112 0.457051 0.319882 1.570527 -0.402697 1.290674 1.204800 1.401836 1.336388 0.648113 0.124756 0.662802 1.220070 0.574934 1.505863 0.327299 0.302060 0.227547 1.667375 0.068249 1.091443 1.792589 0.449965 1.704708 1.553134 -0.115887 1.846414 0.247132 0.001560)
+ 9.146479 (fv 0.000000 0.967563 0.927691 -0.360864 0.609958 0.765470 0.915027 1.392793 0.614248 0.953214 1.344500 -0.018857 0.737576 1.736931 1.631618 1.349440 1.307993 0.206073 1.281714 1.103145 0.628925 0.887703 0.370354 -0.354414 1.471798 1.220261 -1.840190 0.459998 0.319058 1.569823 -0.402409 1.289240 1.207248 1.401276 1.334659 0.647076 0.124770 0.659947 1.220235 0.570854 1.506684 0.326123 0.300730 0.226766 1.668245 0.069090 1.091084 1.792555 0.448614 1.706735 1.552724 -0.117313 1.845004 0.249242 0.002966)
)
;;; 56 prime --------------------------------------------------------------------------------
-#(56 11.365570068359 #(0 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 0 1 0 0 0 1)
- 11.143131256104 #(0 1 0 1 0 0 1 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 1)
- 10.976176261902 #(0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 1 1 1 0 0 0 0 1 1 1 1 1 1 1)
+(vector 56 10.976176261902 (fv 0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 1 1 1 0 0 0 0 1 1 1 1 1 1 1)
+
+ 9.398396 (fv 0.000000 0.094656 0.695846 1.603834 1.096947 0.190376 1.605668 0.402610 1.589743 -0.046719 0.479899 1.053090 1.455624 1.475630 1.560612 1.146935 -0.097134 1.379647 0.063965 0.026372 0.001091 0.417420 0.372665 0.295880 0.375803 1.735862 -0.241158 0.226369 0.344276 0.614802 1.609054 1.733862 -0.048343 1.607193 0.295369 0.796984 0.953479 0.777849 -0.315058 -0.215768 1.445593 0.800481 -0.018312 0.085983 1.492275 1.800390 0.955850 0.344132 0.748720 -0.182377 -0.021909 0.550436 1.590599 1.124545 1.577258 1.243187)
- 9.416584 #(0.000000 0.093454 0.692950 1.604693 1.098286 0.189908 1.613637 0.406025 1.587842 -0.053260 0.474665 1.058332 1.463288 1.478131 1.559644 1.146560 -0.091847 1.380484 0.060200 0.022433 -0.002830 0.411724 0.362485 0.300148 0.374664 1.733714 -0.236120 0.226722 0.349149 0.620200 1.609175 1.723836 -0.045613 1.606408 0.295699 0.786642 0.960470 0.772238 -0.316639 -0.224592 1.451262 0.795641 -0.015445 0.090399 1.494369 1.799834 0.955874 0.337462 0.746304 -0.185507 -0.017244 0.552767 1.595238 1.125471 1.583148 1.239997)
+ ; 55+1
+ 9.213442 (fv 0.000000 0.950801 0.904714 -0.508703 0.661009 0.831586 0.884308 1.497773 0.634206 0.800998 1.332469 0.044201 0.725326 1.681333 1.804312 1.427989 1.278065 0.225748 1.222051 1.044010 0.570030 1.029930 0.330187 -0.354523 1.385937 1.248658 -1.994529 0.420806 0.301325 1.707662 -0.449043 1.164884 1.219283 1.466837 1.371490 0.636485 0.172055 0.643834 1.272809 0.563267 1.543526 0.353044 0.368529 0.213972 1.758208 0.147525 1.155503 1.739729 0.512727 1.742754 1.612106 -0.186498 1.717200 0.213592 0.028127 -0.105694)
)
;;; 57 prime --------------------------------------------------------------------------------
-#(57 11.484163284302 #(0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1)
- 11.352762647901 #(0 0 1 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 1 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1)
- 11.247724533081 #(0 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1)
+(vector 57 11.247724533081 (fv 0 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0 1 1)
+
+ 9.567937 (fv 0.000000 -0.074489 1.764667 1.562855 -0.045942 1.688785 0.424094 0.788093 1.318249 1.699500 1.597710 0.759778 0.347915 -0.095100 0.967999 1.558373 1.224410 -0.005793 1.163013 1.817831 1.260212 1.123377 0.674940 0.664211 1.043062 -0.159530 1.686511 0.775041 1.335210 0.664604 0.251332 0.046341 0.133324 0.094858 -0.073202 1.314310 1.874591 1.317512 0.082927 1.516375 0.524906 0.812252 0.819331 0.420977 1.188424 0.646402 1.644694 0.551897 0.757891 1.055306 1.295231 1.095924 0.627116 1.401110 0.235317 1.483585 0.936274)
- 9.580707 #(0.000000 -0.076299 1.764060 1.563027 -0.044952 1.688463 0.425188 0.787527 1.317034 1.701606 1.597550 0.759419 0.348339 -0.094857 0.968619 1.557143 1.226280 -0.006283 1.163517 1.816901 1.260563 1.123869 0.675278 0.663577 1.044069 -0.159899 1.684865 0.776808 1.334222 0.668012 0.251735 0.046287 0.135820 0.094855 -0.072155 1.314337 1.875554 1.316503 0.082995 1.516239 0.524074 0.814054 0.818574 0.420357 1.188628 0.649052 1.644152 0.552734 0.759640 1.054786 1.294831 1.094087 0.626845 1.402385 0.235318 1.482165 0.935592)
+ ;; old 56+1
+ 9.529594 (fv 0.000000 0.147122 0.761626 1.581775 0.991521 0.303398 1.538303 0.250231 1.516156 -0.033991 0.496296 1.098128 1.450885 1.473689 1.672255 1.122803 -0.210233 1.300861 0.064078 0.004743 0.013527 0.414701 0.325782 0.261492 0.363241 1.708852 -0.205248 0.171322 0.269253 0.615657 1.654144 1.808189 -0.053761 1.665701 0.276750 0.872232 1.105105 0.764170 -0.448707 -0.286149 1.484838 0.786694 -0.015133 0.173812 1.436796 1.864880 0.980591 0.327079 0.799812 -0.230067 -0.066056 0.534676 1.508154 1.155564 1.645708 1.183535 0.088307)
+
+ ;; 56+1
+ 9.246042 (fv 0.000000 1.068254 0.912344 -0.579409 0.699964 0.833848 0.899690 1.280880 0.729555 0.772814 1.165620 0.113563 0.958418 1.776654 1.746943 1.402708 1.254651 0.244552 1.303164 0.938450 0.572896 0.902407 0.419733 -0.424031 1.525432 1.318732 -1.856680 0.294120 0.271355 1.825185 -0.454382 1.066744 1.206377 1.513453 1.348624 0.487546 0.090590 0.574392 1.204512 0.396962 1.588976 0.339722 0.399778 0.196224 1.725471 0.086935 1.086444 1.835851 0.439978 1.611137 1.567240 -0.063335 1.719558 0.447194 0.045334 -0.250234 0.164616)
)
;;; 58 prime --------------------------------------------------------------------------------
-#(58 11.564489172529 #(0 1 1 0 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 1)
- 11.261419321863 #(0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1)
+(vector 58 11.261419321863 (fv 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1)
+
+ 9.496347 (fv 0.000000 0.059743 0.548997 0.530263 0.226709 0.929160 -0.003047 0.125973 0.533773 1.548469 1.087643 1.570490 0.714949 0.863084 1.167817 1.094596 0.710052 1.511445 0.483704 1.291778 1.179203 1.180959 0.109073 0.094424 -0.384843 0.103787 0.722897 0.948977 1.484212 0.671726 0.961877 1.358209 1.232685 1.456297 0.651862 0.171910 0.370224 1.284842 1.052862 0.918644 1.853795 0.756435 1.065168 1.308648 0.977275 0.827028 1.655929 0.742384 0.217339 0.808896 0.296638 1.208667 1.265590 0.019271 0.389600 0.183945 0.533565 1.638734)
- 9.505688 #(0.000000 0.060154 0.549424 0.529823 0.226464 0.928253 -0.003860 0.126075 0.535738 1.548766 1.086902 1.570493 0.715282 0.862695 1.168378 1.094074 0.708964 1.511211 0.483824 1.290855 1.179194 1.180588 0.108491 0.095036 -0.384594 0.103534 0.722834 0.949201 1.483989 0.672445 0.963174 1.357476 1.233255 1.455883 0.651944 0.172940 0.371325 1.285219 1.053056 0.918891 1.852593 0.756272 1.066052 1.307811 0.977662 0.827781 1.654721 0.742013 0.216364 0.809284 0.296889 1.207803 1.265136 0.019240 0.388774 0.184370 0.532181 1.637933)
+ ;; 57+1
+ 9.428825 (fv 0.000000 1.018908 0.901444 -0.615819 0.860485 0.681403 0.932140 1.367257 0.748226 0.856986 1.087905 -0.048047 0.777707 1.778584 1.735112 1.472731 1.253932 0.300987 1.373471 0.844264 0.566375 0.847406 0.280264 -0.528105 1.424599 1.371262 -0.084608 0.304532 0.358385 1.652997 -0.476953 1.150522 1.226908 1.441019 1.199333 0.513348 0.039957 0.545771 1.150857 0.473094 1.508935 0.466022 0.322870 0.315957 1.725788 0.047786 1.078150 1.717254 0.429354 1.592876 1.500586 -0.142982 1.851065 0.442979 -0.034671 -0.282154 0.042441 0.094078)
)
;;; 59 prime --------------------------------------------------------------------------------
-#(59 11.677247047424 #(0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 0)
- 11.650652430228 #(0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 0 0 0)
- 11.523194313049 #(0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 0 0 1)
- 11.34253692627 #(0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1)
+(vector 59 11.34253692627 (fv 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1)
- 9.461071 #(0.000000 1.026140 1.257671 0.308284 0.971242 0.409576 0.151782 1.791247 1.988196 -0.027696 1.420905 -0.028605 1.207353 1.130986 0.882378 0.849723 1.361873 -0.046185 1.807272 1.493710 -0.131531 1.567304 0.343209 1.947891 0.741228 0.985033 0.389842 1.584893 1.932530 0.722301 1.180584 0.976008 0.567278 1.190475 1.426215 -0.109519 0.165619 0.978474 1.347322 1.547306 0.663597 -0.010689 1.175220 1.168146 0.783264 1.100310 1.669726 0.567047 0.268954 1.914914 1.025090 0.079837 0.521327 1.722588 0.202188 0.120284 0.124037 0.434366 0.915092)
+ 9.424456 (fv 0.000000 0.987831 1.263819 0.296674 0.942023 0.441708 0.159032 1.836629 0.018568 -0.056141 1.409550 -0.045051 1.184001 1.106575 0.859402 0.865929 1.344330 -0.022715 1.852739 1.494636 -0.146236 1.538496 0.317717 1.985293 0.734507 0.982797 0.398619 1.595615 1.945403 0.701589 1.197367 1.012887 0.543978 1.174908 1.430788 -0.128888 0.147545 0.984537 1.324816 1.549298 0.656696 -0.006636 1.201874 1.148588 0.795564 1.108773 1.687645 0.571018 0.266043 1.954157 1.006840 0.084613 0.524554 1.761460 0.208641 0.094850 0.141845 0.437731 0.909728)
)
;;; 60 prime --------------------------------------------------------------------------------
-#(60 11.705318182776 #(0 1 1 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0)
- 11.579921722412 #(0 0 1 0 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0)
- 11.512454032898 #(0 0 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0)
+(vector 60 11.512454032898 (fv 0 0 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0)
- 9.667978 #(0.000000 1.548847 1.677415 1.073802 -0.181695 1.465698 0.177673 1.297055 1.181959 0.798813 0.182895 1.568307 1.362887 0.494046 -0.056223 1.003765 1.540834 0.417083 1.700236 0.183373 0.906287 0.332491 0.794205 0.889356 1.122881 1.798411 0.731468 0.770885 1.702649 0.812172 0.661668 1.187770 1.645325 1.481247 1.241021 1.798473 0.253210 0.360427 1.758487 0.792556 0.132677 0.641699 0.955794 -0.225974 -0.094699 1.369963 1.923099 1.413822 -0.028130 0.411742 1.206891 1.720478 0.222564 0.679253 1.694855 0.956992 0.036315 1.794176 0.005989 0.786641)
+ 9.657740 (fv 0.000000 1.547780 1.677673 1.073672 -0.181562 1.466665 0.178185 1.296168 1.180984 0.799114 0.182696 1.568868 1.363180 0.494840 -0.056028 1.003607 1.541063 0.417763 1.700695 0.183440 0.905951 0.331420 0.794062 0.890276 1.122192 1.798420 0.731798 0.770804 1.703299 0.813575 0.660992 1.187791 1.645314 1.481351 1.240486 1.798220 0.254797 0.358769 1.758554 0.791594 0.131877 0.642084 0.956267 -0.226021 -0.095209 1.368914 1.922174 1.414955 -0.029158 0.411776 1.206976 1.720135 0.221233 0.679698 1.694654 0.956928 0.036757 1.792835 0.004408 0.786308)
+
+ ;; 59+1
+ 9.567932 (fv 0.000000 0.987181 1.155730 0.332214 0.959672 0.422609 0.139164 1.858170 1.971933 -0.085625 1.367690 0.092445 1.162248 1.070252 0.880093 0.923540 1.286688 -0.075166 1.802993 1.583654 -0.058064 1.544851 0.459865 -0.017801 0.622918 1.081434 0.420245 1.717169 1.954432 0.771937 1.209324 0.923890 0.475411 1.176878 1.472899 -0.165713 0.114758 1.012016 1.333064 1.459949 0.672973 0.014198 1.279333 1.152000 0.797283 1.103957 1.630723 0.491103 0.146670 1.964833 1.081703 0.052456 0.483259 1.761154 0.245675 0.138222 0.019396 0.460673 0.907223 -0.053470)
)
;;; 61 prime --------------------------------------------------------------------------------
-#(61 11.989195823669 #(0 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1 1 0 0 0 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0)
- 11.915099143982 #(0 1 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0)
- 11.850807189941 #(0 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1)
+(vector 61 11.850807189941 (fv 0 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1)
+
+ 9.848207 (fv 0.000000 0.465768 1.502052 1.208112 1.687111 1.098823 0.136558 1.242624 0.803898 1.305434 0.569022 0.707134 0.107360 0.681230 1.626786 1.180372 0.428544 0.064966 0.220601 0.606687 1.112200 0.761343 0.147814 1.074432 0.974575 0.150330 0.295078 1.965080 0.596171 1.395202 1.511902 0.719123 0.058806 0.162986 1.356055 1.017221 1.069746 0.022458 1.119273 0.473964 1.602481 0.117785 0.745272 0.467208 1.699348 0.892580 0.864605 0.883970 -0.281719 1.309124 0.657105 1.259919 1.224601 1.818239 1.863265 0.645463 0.762464 -0.184384 0.778659 1.743798 0.403645)
- 9.857803 #(0.000000 0.466268 1.503602 1.208588 1.687860 1.099918 0.137279 1.242705 0.804618 1.306366 0.568259 0.707170 0.108285 0.681183 1.626277 1.180013 0.428464 0.064770 0.219892 0.605545 1.111572 0.760878 0.147730 1.074544 0.974666 0.150162 0.294602 1.965478 0.597519 1.395690 1.511883 0.719628 0.058147 0.163297 1.356049 1.018041 1.070671 0.023174 1.119954 0.473191 1.603630 0.117703 0.746049 0.466808 1.699718 0.892498 0.864332 0.884108 -0.280786 1.308248 0.656636 1.259003 1.224255 1.817476 1.863730 0.646744 0.763022 -0.184766 0.778109 1.743818 0.403893)
+ ;; 60+1
+ 9.674304 (fv 0.000000 0.942988 1.185184 0.401228 0.922656 0.384439 0.124613 1.797598 1.871679 -0.085568 1.287716 0.127521 1.211990 1.110404 1.018269 0.906936 1.241998 -0.006224 1.802916 1.625042 -0.136580 1.655334 0.507522 0.019978 0.578715 1.045428 0.440588 1.674467 1.983824 0.788229 1.261730 0.967897 0.387538 1.232060 1.526658 -0.187478 0.170755 1.104323 1.383734 1.532583 0.668063 0.082609 1.255511 1.174792 0.795177 1.135630 1.640793 0.324749 0.311806 1.930005 1.005470 -0.027359 0.440238 1.824355 0.182093 -0.005304 0.026835 0.470199 0.945827 0.102044 -0.110982)
)
;;; 62 prime --------------------------------------------------------------------------------
-#(62 12.4221113188342 #(0 1 0 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 1 0)
- 11.929849152918 #(0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 1 0 1 0)
- 11.709966659546 #(0 0 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 1 0 1 0)
+(vector 62 11.709966659546 (fv 0 0 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 1 0 1 0)
- 9.803599 #(0.000000 0.170647 0.475064 0.215625 1.703990 -0.036625 1.104250 0.625722 1.606257 0.236935 0.050419 0.616857 1.279319 1.149798 1.100884 1.265077 0.345148 0.152443 0.439704 0.699502 0.313898 1.456184 -0.721516 0.297665 1.494400 -0.409104 0.242987 1.686671 0.592117 1.576026 1.089120 0.193081 0.927450 -0.113678 -0.087483 0.107716 1.534423 0.712324 1.228001 1.261977 0.244009 1.783706 0.892154 0.557312 0.843881 1.576957 1.202330 0.684078 0.137954 0.666532 0.162571 0.389256 1.875347 0.560333 0.695915 0.124170 0.661013 1.406163 0.639613 1.275381 1.810536 0.210899)
+ 9.787654 (fv 0.000000 0.164735 0.495571 0.194524 1.700130 -0.039330 1.112293 0.631854 1.622240 0.234398 0.057253 0.622061 1.299807 1.150659 1.089362 1.262936 0.326220 0.146372 0.440190 0.705699 0.320098 1.480138 -0.723459 0.298112 1.483411 -0.413300 0.234477 1.688059 0.592934 1.563752 1.095288 0.196837 0.912297 -0.114061 -0.100816 0.101717 1.569678 0.725974 1.210511 1.268915 0.220895 1.789986 0.880755 0.550271 0.862882 1.562267 1.201540 0.696671 0.139442 0.617496 0.156201 0.378889 1.874933 0.550733 0.693398 0.120666 0.641553 1.379939 0.633855 1.283976 1.797799 0.211762)
+
+ ;; 63-1
+ 9.733736 (fv 0.000000 -0.139952 0.119957 0.369616 1.566294 0.358962 1.150575 0.658899 1.145823 0.565498 0.818035 -0.078756 0.339361 0.036853 -0.081445 1.284492 0.104736 1.510521 0.937147 0.788271 1.526814 1.396514 1.280490 1.469510 1.789649 0.285213 0.650226 0.881585 0.728974 1.810762 -0.044930 1.659215 0.713447 0.623929 1.496774 0.951425 0.357075 1.369241 1.674041 0.637986 0.902200 0.722908 0.299878 -0.044061 0.733643 0.407073 1.473577 0.408899 -0.199740 0.425185 0.345580 1.674452 0.584665 1.350356 0.031128 1.247150 0.256688 0.635884 0.503839 0.135030 0.263417 1.006656)
)
;;; 63 prime --------------------------------------------------------------------------------
-#(63 12.219760894775 #(0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0)
- 12.000000000004 #(0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0)
- 11.975765228271 #(0 0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0)
+(vector 63 11.975765228271 (fv 0 0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0)
- 9.729796 #(0.000000 -0.194062 0.122432 0.207516 1.629274 0.226937 1.127144 0.674007 1.187492 0.607971 0.795447 -0.143191 0.275764 0.049401 -0.032213 1.281828 0.170320 1.509877 0.926571 0.720279 1.664485 1.429017 1.214534 1.502206 1.720315 0.374149 0.733151 0.843363 0.644756 1.771421 -0.062737 1.758919 0.658152 0.638096 1.431865 0.933752 0.449748 1.376515 1.659460 0.691492 0.901933 0.706965 0.261322 0.018411 0.759043 0.429968 1.446100 0.382355 -0.212387 0.419226 0.411287 1.770964 0.502367 1.413238 0.020630 1.331346 0.246691 0.601731 0.402447 0.097397 0.242930 1.015349 0.319273)
+ 9.712956 (fv 0.000000 -0.211512 0.128156 0.205336 1.631792 0.223993 1.120077 0.677974 1.189520 0.635587 0.786994 -0.140042 0.270508 0.031528 -0.026718 1.271754 0.161836 1.519308 0.919403 0.725190 1.656604 1.430895 1.216006 1.507263 1.740613 0.380045 0.740422 0.860394 0.644699 1.785241 -0.063336 1.757196 0.670969 0.631113 1.432730 0.929994 0.449373 1.355893 1.665671 0.697673 0.900343 0.706516 0.261640 0.022846 0.779166 0.410962 1.451999 0.372853 -0.213671 0.428231 0.418722 1.770544 0.502738 1.423557 0.029160 1.322724 0.247556 0.608992 0.392989 0.101597 0.240746 1.015503 0.321046)
)
;;; 64 prime --------------------------------------------------------------------------------
-#(64 12.176999092102 #(0 0 1 0 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1)
- 11.932915769505 #(0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1)
+(vector 64 11.932915769505 (fv 0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1)
- 9.928683 #(0.000000 -0.170836 0.277577 1.457481 0.411222 0.496295 1.258686 0.942620 0.460447 -0.040657 1.399602 0.586409 1.001989 1.550810 0.411397 0.896745 0.919489 0.341110 0.067718 -0.007486 0.022222 0.281873 0.969820 1.262637 0.102175 0.589241 1.539280 0.554808 1.658362 1.425825 0.094639 0.727265 0.379714 1.258992 0.367478 0.294638 0.691177 1.350772 0.836612 1.351285 1.365104 1.641896 0.643511 0.521132 1.145303 1.510465 0.365331 -0.121311 0.021055 1.358294 0.604508 0.518299 0.040829 1.605074 0.951721 0.772612 0.887245 1.326167 1.665215 0.943492 0.569057 0.681418 0.230468 0.548135)
+ 9.911897 (fv 0.000000 -0.176519 0.277243 1.457679 0.409823 0.492128 1.258703 0.953828 0.451970 -0.035755 1.413815 0.576790 1.007663 1.557197 0.406393 0.901721 0.935399 0.344434 0.058666 -0.004874 0.033568 0.266354 0.964058 1.260921 0.110946 0.586184 1.551133 0.560107 1.655832 1.431146 0.094791 0.726936 0.404173 1.258539 0.363860 0.287498 0.704556 1.358694 0.848351 1.352219 1.358382 1.634548 0.646434 0.536511 1.151363 1.507902 0.370229 -0.111562 0.018845 1.351430 0.613337 0.524145 0.030867 1.602701 0.958191 0.774983 0.900142 1.319974 1.665985 0.954409 0.571244 0.683517 0.257283 0.560359)
)
;;; 65 prime --------------------------------------------------------------------------------
-#(65 12.496994018555 #(0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 1 0)
- 12.264873504639 #(0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 0)
+(vector 65 12.264873504639 (fv 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 0)
+
+ 10.245810 (fv 0.000000 1.314885 -0.128565 -0.061767 0.245423 0.308150 0.666161 1.799635 0.121779 1.318087 1.095106 1.813764 1.363803 0.687883 0.082989 1.252556 0.674431 0.081538 1.120705 -0.053380 0.222404 0.418326 1.266348 1.095265 1.090145 0.914385 0.672015 0.091667 0.221386 0.230885 1.047444 0.950558 0.582123 1.829143 1.939330 0.054401 0.665085 0.669868 1.410783 0.893429 1.398299 1.087907 0.120341 1.456277 0.134554 1.548051 0.155644 0.252207 0.317819 0.803060 0.255268 0.011364 1.407071 1.292331 1.862089 -0.144291 1.528219 0.241256 -0.215537 1.071975 0.180828 1.509027 1.608200 1.880646 0.432459)
- 10.285596 #(0.000000 1.323078 -0.131983 -0.053584 0.225780 0.296225 0.662773 1.810095 0.112805 1.329524 1.118105 1.791174 1.371778 0.714423 0.089340 1.244596 0.676061 0.077318 1.124451 -0.042630 0.218895 0.439684 1.292741 1.091288 1.097009 0.937114 0.672360 0.037275 0.220610 0.194396 1.070368 0.931204 0.568172 1.869324 1.937324 0.070647 0.684059 0.655283 1.394447 0.910690 1.451044 1.090670 0.101781 1.467166 0.132281 1.506138 0.152181 0.211825 0.325427 0.820431 0.280838 0.017086 1.407327 1.298679 1.878586 -0.119671 1.557564 0.243126 -0.205445 1.085097 0.178064 1.536459 1.624482 1.866093 0.417399)
+ ;; 64+1
+ 10.041913 (fv 0.000000 -0.231597 0.347996 1.329229 0.210946 0.358775 1.318136 0.940959 0.423445 -0.059602 1.487652 0.528102 0.959962 1.627507 0.242008 0.890416 1.013953 0.381481 0.048421 0.000955 0.073351 0.222260 0.956448 1.250606 0.032874 0.581396 1.552144 0.533024 1.803356 1.588620 0.155988 0.709145 0.416103 1.098822 0.371144 0.488313 0.641224 1.409761 0.769076 1.378012 1.338517 1.672969 0.693576 0.622573 1.111879 1.498797 0.384021 -0.285902 0.098531 1.294593 0.540682 0.514444 0.031708 1.544980 0.882941 0.833995 0.886145 1.471130 1.590019 0.959450 0.407950 0.787696 0.104075 0.545846 0.096608)
)
;;; 66 prime --------------------------------------------------------------------------------
-#(66 12.564531326294 #(0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 0 1 0)
- 12.359117360586 #(0 0 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 1 0 1 0 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 1 0 1 0)
- 12.347700119019 #(0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0)
- 12.090668678284 #(0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0)
+(vector 66 12.090668678284 (fv 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0)
- 10.231088 #(0.000000 -0.257491 0.414055 1.230988 0.030692 0.437810 1.202666 1.084680 0.397057 0.105712 0.400060 0.961431 1.286806 0.210170 1.035035 0.149638 1.729551 1.232085 -0.345922 0.156751 0.126820 1.131947 0.095037 0.474384 0.813800 0.547762 1.592419 0.342714 0.604489 0.213333 0.265609 0.091125 0.203844 0.947651 0.723723 0.055546 0.332522 0.860104 1.406427 1.256901 1.199356 0.021362 1.136727 1.204927 0.868312 1.542807 0.527899 1.703420 -0.165539 0.933317 0.605908 1.874837 1.187420 0.707496 1.057232 1.283825 1.131342 0.266041 0.622609 0.100259 0.657708 0.216852 1.501939 0.787443 0.031392 0.357622)
+ 10.065843 (fv 0.000000 -0.332278 0.420111 1.296912 0.003400 0.570050 1.383101 1.228319 0.329402 0.002928 0.332461 0.786693 1.331535 0.237292 1.020996 0.126259 1.613105 1.241426 -0.367526 0.057745 0.063068 1.144890 0.058649 0.546763 0.792290 0.527577 1.597907 0.336733 0.558202 0.349266 0.412838 -0.066236 0.132007 1.032081 0.645360 0.084627 0.218015 0.961024 1.464682 1.216442 1.186753 0.039444 1.139907 1.145545 1.026317 1.617341 0.492061 1.804706 -0.218027 0.872723 0.567401 1.745335 1.259266 0.682677 1.100993 1.200392 1.089304 0.237539 0.552581 0.047166 0.743492 0.228597 1.363708 0.915715 -0.032741 0.312099)
)
;;; 67 prime --------------------------------------------------------------------------------
-#(67 12.65784740448 #(0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 1 1)
- 12.20425496356 #(0 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1)
+(vector 67 12.20425496356 (fv 0 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1)
- 10.340714 #(0.000000 -0.061072 1.239567 1.937783 0.377879 0.132023 1.308710 1.039352 0.077809 0.041567 0.382918 0.612282 0.090586 0.254648 0.686259 0.089324 1.549498 1.651907 1.405520 0.682356 1.021254 0.988802 1.575485 0.948929 0.603030 0.848484 0.622854 1.084675 0.279155 0.704526 0.934257 1.625327 1.470456 0.853065 1.295115 0.813178 -0.167355 1.307752 1.665434 0.129938 1.415781 1.193997 0.754451 1.498211 1.288864 0.011137 0.970766 0.585724 1.096778 1.010987 1.346957 1.015658 1.430968 0.507178 0.028674 1.497005 0.684830 0.385254 0.742104 1.607538 1.197068 0.700264 0.193872 -0.005342 0.945237 0.487916 0.497029)
+ 10.320633 (fv 0.000000 -0.066702 1.242059 1.936441 0.363520 0.137300 1.303419 1.038801 0.086937 0.040742 0.388452 0.616008 0.087295 0.258798 0.692201 0.072909 1.551804 1.636838 1.398740 0.687317 1.022745 0.988646 1.580618 0.947110 0.593084 0.854099 0.599585 1.071060 0.286673 0.719337 0.932505 1.632806 1.461969 0.862483 1.295247 0.807609 -0.156076 1.297879 1.679745 0.135687 1.421850 1.188268 0.748752 1.493420 1.296035 0.019305 0.979542 0.607739 1.082240 1.014220 1.355630 1.025509 1.427015 0.501576 0.029659 1.501116 0.667518 0.375063 0.738972 1.634670 1.190958 0.695412 0.198543 0.008987 0.953545 0.492193 0.512363)
+
+ ;; 66+1
+ 10.270103 (fv 0.000000 -0.339086 0.529826 1.196633 0.017211 0.503338 1.254976 1.117868 0.397424 -0.207937 0.422035 0.795324 1.396533 0.167749 1.073809 0.015795 1.618310 1.175144 -0.342555 0.080333 0.003741 1.084430 -0.010093 0.560025 0.867130 0.369945 1.456200 0.444129 0.652644 0.167650 0.320656 -0.145242 0.307342 1.062944 0.883767 0.299612 0.277397 1.030332 1.417097 1.462867 1.323580 0.189769 1.089141 0.993348 0.915509 1.413244 0.654039 1.674522 -0.169566 0.974872 0.769627 1.866694 1.124536 0.783559 1.039716 1.307670 1.055658 0.169272 0.711344 0.060085 0.731555 0.347823 1.529167 0.605251 0.021941 0.493045 -0.306702)
+
+ ;; 63+4
+ 10.427697 (fv 0.000000 0.966407 0.007580 1.117030 0.884875 -0.175736 1.107926 1.097831 1.037576 0.927078 0.966085 0.319675 1.083926 1.106087 -0.189435 0.791093 0.993213 0.299434 1.143696 -0.196739 -0.029109 0.887111 0.277418 0.908738 0.949002 0.901486 1.105128 -0.045569 -0.301510 0.181857 -0.008960 0.833755 0.782101 0.955244 1.472884 0.046447 1.032739 0.722326 0.974274 -0.002839 -0.169106 0.164428 1.138848 0.015499 -0.200081 0.988166 0.843017 1.122563 0.966722 1.090406 0.167301 -0.055129 1.042886 1.189957 0.335648 0.995142 0.029028 1.138068 1.075538 0.633942 0.180537 0.051411 0.928317 0.861628 0.910920 0.920218 1.020151)
)
;;; 68 prime --------------------------------------------------------------------------------
-#(68 12.551372528076 #(0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 1)
- 12.501034736633 #(0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 0 1 0 1 0 0 1 0 1)
- 12.466281890869 #(0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 0 1)
+(vector 68 12.466281890869 (fv 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 0 1)
+
+ 10.396366 (fv 0.000000 0.186038 1.693540 -0.027216 1.013938 1.733700 0.097268 1.072327 -0.058595 1.297512 -0.223714 1.812708 1.571967 1.911449 0.105375 0.724913 0.167937 1.379937 1.003328 0.296337 -0.012219 0.740941 0.185685 1.450530 0.967328 0.422187 -0.221136 1.128630 1.299506 1.950429 -0.063323 -0.049468 0.618925 -0.250368 1.155850 1.363266 1.946601 1.896273 0.663379 0.530614 -0.343257 1.261470 -0.040006 0.308974 1.407553 1.782235 1.820125 1.703055 0.892390 0.956493 1.267334 1.223362 0.886365 0.857699 0.303604 1.740946 1.505785 1.372752 0.598965 0.555179 0.138411 0.702673 0.141261 1.356921 1.480871 1.810731 0.336170 1.491601)
- 10.412735 #(0.000000 0.175204 1.688716 -0.022299 1.014278 1.734958 0.107526 1.076082 -0.059797 1.298045 -0.215245 1.814967 1.568100 1.905542 0.112744 0.720254 0.161568 1.384534 1.000808 0.295833 0.001750 0.740793 0.183234 1.441771 0.972475 0.430689 -0.220844 1.134918 1.305138 1.953744 -0.056243 -0.044006 0.614789 -0.255450 1.160186 1.374458 1.941909 1.902525 0.661288 0.531305 -0.343089 1.268101 -0.041675 0.309515 1.403292 1.786893 1.815365 1.702025 0.894997 0.951916 1.266692 1.225472 0.894684 0.854877 0.293710 1.743030 1.510597 1.372397 0.596900 0.559597 0.130313 0.693827 0.131855 1.358212 1.479389 1.813226 0.336990 1.483160)
+ ;; 69-1:
+ 10.294332 (fv 0.000000 1.774482 1.200978 1.227268 1.382220 0.282793 1.553903 1.732456 0.753211 0.760153 1.851640 1.366776 1.204200 0.843725 0.253043 0.277483 0.103836 -0.065448 1.410455 0.651921 1.994318 0.062621 0.954681 0.275021 0.597686 1.119852 0.016268 -0.163905 1.984242 1.567894 0.922417 -0.007109 1.063508 1.828059 0.334844 1.052665 1.253633 1.262611 1.579598 0.998618 1.505098 1.876188 0.866523 -0.096826 0.810066 0.678537 0.661302 -0.487197 0.199269 0.661440 1.362169 1.024823 0.238200 0.872311 1.253153 1.455210 0.266625 1.222868 1.015892 1.101616 1.115849 0.596998 1.881890 -0.207678 1.082090 0.165311 1.300155 1.153433)
)
;;; 69 prime --------------------------------------------------------------------------------
-#(69 12.88109067433 #(0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 1 0 0 0 1 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 0 0 1)
- 12.549396894774 #(0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1)
- 12.336643218994 #(0 0 1 0 0 1 1 0 1 1 0 1 1 1 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1)
- 12.29846572876 #(0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0)
+(vector 69 12.29846572876 (fv 0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0)
- 10.424259 #(0.000000 1.742473 1.382765 1.285554 1.274286 0.192900 1.712998 1.657798 0.786400 0.713212 1.977194 1.439286 1.180830 0.867159 0.225922 0.238914 0.164947 0.073753 1.459012 0.721839 1.958638 0.138724 0.873185 0.240378 0.530925 0.991763 1.761185 -0.252698 1.788886 1.677469 0.777365 1.937871 1.088344 1.772777 0.407177 0.999072 1.277127 1.377007 1.656111 1.029078 1.515102 1.711959 0.964688 -0.219754 0.860996 0.621409 0.750661 -0.255993 0.046377 0.589948 1.358801 1.071768 0.317554 0.871306 1.156852 1.462756 0.171117 1.161675 0.998179 1.062426 1.027283 0.471331 1.755106 0.013061 0.963911 0.314908 1.327855 1.292938 0.726709)
+ 10.373386 (fv 0.000000 1.755739 1.344798 1.270777 1.245975 0.212147 1.637341 1.674637 0.780881 0.678256 0.020823 1.453992 1.251154 0.906274 0.263210 0.219658 0.201277 -0.006107 1.482279 0.690309 1.943780 0.107940 0.891912 0.210217 0.501788 1.062586 1.748465 -0.256216 1.793890 1.653062 0.760504 1.930618 1.125386 1.733012 0.392253 1.017032 1.329369 1.438951 1.614342 0.946373 1.511397 1.735151 0.924137 -0.243047 0.908372 0.619579 0.722525 -0.263766 0.070586 0.505534 1.390127 1.112173 0.360123 0.888486 1.115007 1.574719 0.192671 1.168644 1.072297 1.024494 1.027776 0.495929 1.728234 0.030466 1.010825 0.303774 1.356890 1.301979 0.677665)
)
;;; 70 prime --------------------------------------------------------------------------------
-#(70 13.072455719834 #(0 0 0 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0)
- 12.851739571463 #(0 1 0 1 0 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0)
- 12.797727584839 #(0 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0)
- 12.669577598572 #(0 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0)
- 12.665026664734 #(0 1 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 0 0)
+(vector 70 12.665026664734 (fv 0 1 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 0 0)
- 10.457212 #(0.000000 0.656562 0.152418 -0.212720 0.451668 1.050536 0.302692 1.607206 1.045214 1.661220 0.960685 1.098142 0.972042 0.783971 0.635983 0.180192 0.075478 0.654748 0.889416 0.443294 0.965930 1.663051 1.048777 0.021723 1.892932 1.737415 1.694958 0.836161 1.025884 1.916828 1.372458 0.504994 -0.109617 0.549223 0.204404 0.044456 1.287367 -0.078853 0.485771 1.773996 1.401110 0.481442 0.195077 0.619655 1.368280 1.208180 1.467842 1.578734 1.402351 1.925361 0.396224 1.534144 0.086213 0.216735 0.971969 -0.141622 1.510563 0.678259 1.376396 0.717289 0.331558 0.696595 1.626791 0.822010 0.081087 1.100267 0.137774 0.895201 0.865418 0.138039)
+ 10.403198 (fv 0.000000 0.659269 0.149246 -0.229331 0.464031 1.037303 0.297808 1.605092 1.041553 1.638786 0.968456 1.081487 0.986031 0.766531 0.645236 0.176746 0.062926 0.650627 0.887571 0.432390 0.968052 1.660369 1.053082 0.034606 1.910731 1.746043 1.683430 0.821251 1.040772 1.932221 1.382437 0.501614 -0.111054 0.532350 0.190557 0.045053 1.319570 -0.066664 0.486188 1.777508 1.395223 0.491473 0.176001 0.623855 1.347864 1.207736 1.451417 1.558733 1.414717 1.920228 0.418857 1.530616 0.099510 0.214659 0.967449 -0.145006 1.519241 0.691963 1.366826 0.718889 0.337519 0.685633 1.635424 0.816319 0.060380 1.097292 0.149441 0.900329 0.876399 0.145344)
)
;;; 71 prime --------------------------------------------------------------------------------
-#(71 13.189444031428 #(0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 0)
- 13.116391136133 #(0 0 0 1 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 0)
- 13.027417182922 #(0 1 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0)
- 12.702159881592 #(0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 1 1 0)
- 12.609085083008 #(0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 0)
+(vector 71 12.609085083008 (fv 0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 0)
- 10.588750 #(0.000000 0.698560 0.911711 0.922770 1.615040 0.861278 0.820728 1.026394 0.524936 0.624685 0.709525 0.832411 1.646420 0.520010 0.759018 0.528369 0.944895 1.150720 1.239225 1.298915 0.389284 0.174954 0.801554 0.548706 0.619810 1.411421 0.131532 0.295538 0.010315 1.263464 0.757471 1.337231 1.076475 0.041744 0.560347 1.716907 1.670240 0.976428 0.065211 0.613659 1.095723 0.223743 1.418900 0.587329 0.900690 1.677654 1.229862 0.212986 1.748168 0.890863 0.948376 0.300537 1.011728 0.006029 1.239697 0.089124 1.220923 1.112984 0.261440 0.277080 1.833613 0.912890 1.766143 1.620682 0.377900 0.226808 0.295654 0.935938 0.701550 1.400246 1.368285)
+ 10.523064 (fv 0.000000 0.688011 0.968837 0.940634 1.605222 0.888784 0.799658 0.986589 0.551066 0.615309 0.653186 0.893971 1.635005 0.515944 0.737309 0.499869 0.965484 1.166543 1.233403 1.277963 0.357632 0.184373 0.829321 0.533549 0.654127 1.345320 0.132782 0.366320 0.049851 1.315507 0.714178 1.332359 1.090257 0.069099 0.561445 1.760121 1.667327 0.986854 0.112329 0.614048 1.104774 0.212197 1.392955 0.553988 0.863015 1.668891 1.231650 0.232935 1.786061 0.865166 0.966113 0.257005 0.993747 -0.000704 1.235807 0.060112 1.258818 1.073792 0.276968 0.278092 1.838200 0.920318 1.799026 1.603861 0.357301 0.246709 0.264914 0.955910 0.731514 1.325161 1.347000)
)
;;; 72 prime --------------------------------------------------------------------------------
-#(72 13.268 #(0 1 1 1 0 0 1 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 1 1 1 0)
- 13.043850898743 #(0 0 1 0 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 0 1 0 0 0 1 1)
- 12.841200828552 #(0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0)
- 12.708446502686 #(0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 1)
+(vector 72 12.708446502686 (fv 0 0 1 0 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 1)
- 10.603190 #(0.000000 1.521232 1.112331 -0.193784 1.577765 1.055244 1.459693 0.761215 1.509630 1.255529 0.026386 -0.001597 1.671245 0.097141 1.613233 1.391358 1.625106 0.239998 0.075687 1.025536 -0.219670 1.863271 1.148293 0.099510 0.594826 0.270125 1.426706 0.151114 0.731356 0.082720 0.736315 1.761631 1.553017 -0.166775 1.860278 1.245131 1.252688 0.181037 1.192073 1.197838 1.635930 -0.041924 1.246828 0.649804 1.090461 0.186797 1.324203 0.690517 1.156748 0.156333 0.748517 1.284929 -0.038625 1.653984 0.986611 0.870536 1.684911 0.548216 0.615062 0.659218 0.333361 0.979623 1.239211 0.141984 1.588206 1.304201 0.078987 0.381454 0.139739 0.914163 1.167238 0.111593)
+ 10.579571 (fv 0.000000 1.526666 1.114036 -0.188699 1.569783 1.061483 1.461941 0.746029 1.509803 1.264040 0.039120 0.005480 1.670375 0.087176 1.602839 1.411297 1.630968 0.248800 0.070549 1.021733 -0.228089 1.869979 1.152734 0.098898 0.604652 0.265485 1.435929 0.170559 0.737250 0.104974 0.731428 1.774793 1.550528 -0.147974 1.870001 1.248377 1.256893 0.177185 1.205217 1.218210 1.654506 -0.048160 1.262662 0.659765 1.099483 0.193101 1.327235 0.693549 1.139270 0.170053 0.767850 1.284172 -0.044820 1.663616 1.015434 0.890883 1.694823 0.554893 0.622406 0.662793 0.328828 0.995738 1.236624 0.150517 1.587539 1.302619 0.103369 0.398303 0.131685 0.921928 1.168883 0.112924)
)
;;; 73 prime --------------------------------------------------------------------------------
-#(73 13.602198600769 #(0 0 1 1 0 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 1 0 0 1 1 0 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 0 0 1 1)
- 13.40486240387 #(0 1 0 0 0 0 0 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0)
- 12.986406962349 #(0 1 0 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 1 1 1 0 1 0 1 0)
- 12.877750118249 #(0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0)
+(vector 73 12.877750118249 (fv 0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0)
- 10.774501 #(0.000000 0.603451 0.358340 0.662091 1.540503 0.300290 1.056119 0.000333 1.699614 0.462844 0.713894 0.323230 1.270558 0.743720 0.539956 0.085865 1.740612 0.355719 0.392278 0.908212 0.236331 1.505682 1.247200 1.650154 1.292673 0.385957 -0.025725 0.341370 1.551460 1.191510 1.086152 1.629644 1.314790 1.399822 1.587125 1.425714 -0.055319 0.159241 0.724677 -0.053025 0.560188 0.169199 -0.078713 0.179100 0.926622 1.018659 1.673699 0.742607 1.375673 1.361068 0.299666 1.345950 1.002780 0.417550 0.207554 0.068040 0.787041 1.872707 0.457147 1.059093 1.413314 0.339199 1.726479 0.612772 1.453478 0.544356 1.419763 0.832939 1.432855 0.272049 0.440052 0.101430 1.591545)
+ 10.737656 (fv 0.000000 0.602102 0.352641 0.632006 1.552371 0.296077 1.082110 0.013914 1.761810 0.456416 0.737747 0.295270 1.253093 0.753406 0.547256 0.051955 1.746228 0.377469 0.418110 0.901371 0.231886 1.499847 1.247926 1.681473 1.281726 0.414399 -0.025093 0.354821 1.545561 1.180195 1.073840 1.640054 1.311359 1.388818 1.571352 1.435069 -0.082478 0.162069 0.705649 -0.084633 0.587089 0.167800 -0.063043 0.159333 0.913473 1.004072 1.669680 0.741708 1.378872 1.360081 0.270841 1.349751 1.013148 0.450718 0.226120 0.098676 0.779207 1.870363 0.442457 1.048600 1.409639 0.334422 1.713108 0.607567 1.451973 0.551597 1.404406 0.821452 1.414792 0.265647 0.470100 0.101296 1.610504)
+
+ ;; 72+1
+ 10.689130 (fv 0.000000 1.525750 1.157802 -0.130495 1.566135 1.068083 1.436324 0.699061 1.496431 1.345845 -0.045471 -0.032146 1.656974 0.163846 1.519166 1.394757 1.503557 0.183007 0.248242 1.068642 -0.134987 1.855031 1.116717 -0.022218 0.511499 0.347386 1.347662 0.149072 0.778251 0.082394 0.706357 1.835299 1.598933 -0.137332 1.800937 1.334976 1.258225 0.107942 1.165982 1.097698 1.720927 -0.060245 1.266550 0.522159 1.151393 0.179388 1.306382 0.759803 1.190783 0.160999 0.709993 1.280967 -0.169862 1.562918 1.019413 0.839429 1.731380 0.566096 0.647229 0.704371 0.329975 1.072857 1.320759 0.275029 1.479112 1.297543 0.103782 0.366305 0.194503 1.011614 1.086013 0.243622 -0.036669)
)
;;; 74 prime --------------------------------------------------------------------------------
-#(74 13.442555427551 #(0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1)
- 13.395832061768 #(0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 1 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 1 1)
- 13.261976242065 #(0 1 1 0 0 0 1 0 0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1)
- 13.115156173706 #(0 1 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 1)
+(vector 74 13.115156173706 (fv 0 1 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 1)
- 10.722373 #(0.000000 0.315582 1.346488 0.640922 0.570327 0.407144 0.064188 0.000251 0.699372 1.413065 0.628446 1.257130 0.141242 1.195704 0.972791 0.812016 0.300588 0.776124 -0.178469 1.543356 0.002632 1.053864 1.128416 1.691702 1.964704 1.268542 -0.120232 1.481634 0.237741 1.227683 1.007579 0.404861 0.081139 0.132082 -0.004637 -0.188104 0.533610 0.153323 1.252319 0.029321 0.147235 0.057504 -0.064524 1.515672 1.423317 1.062201 1.864918 1.746650 0.246730 0.580903 0.650629 0.689179 1.439409 1.731434 1.061112 1.894162 1.549146 0.049774 0.034752 1.268091 0.472126 0.412818 1.817448 1.904873 0.653167 0.759302 1.215205 0.091829 1.218178 1.192836 -0.161918 0.807636 -0.180288 0.297849)
+ 10.649887 (fv 0.000000 0.311188 1.290942 0.614169 0.538966 0.384100 0.109850 0.021551 0.798332 1.375278 0.593955 1.270048 0.158912 1.156782 1.030374 0.821590 0.254106 0.736652 -0.160646 1.527962 0.008622 1.070061 1.131441 1.654723 1.927687 1.286729 -0.139272 1.540344 0.234722 1.262327 0.958913 0.415825 0.099669 0.142462 -0.047631 -0.219606 0.497897 0.164613 1.298918 -0.030959 0.077929 0.023069 -0.048674 1.490524 1.421741 1.027040 1.916604 1.756080 0.253777 0.507377 0.665062 0.691819 1.450238 1.738862 1.010067 1.810972 1.515691 0.044783 0.082536 1.267984 0.419709 0.481882 1.832483 1.839130 0.674123 0.733681 1.236692 0.099256 1.206529 1.152388 -0.150515 0.755739 -0.177039 0.279539)
)
;;; 75 prime --------------------------------------------------------------------------------
-#(75 13.676464080811 #(0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 1 1)
- 13.618774108319 #(0 1 0 0 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 1 0 0)
- 13.357945520561 #(0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1)
- 13.254356384277 #(0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1)
+(vector 75 13.254356384277 (fv 0 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1)
+
+ 11.022299 (fv 0.000000 0.351470 1.008124 1.291533 1.352523 1.219130 1.555492 -0.093523 0.793123 1.710126 0.845582 1.377487 0.007190 1.144398 0.030789 1.388046 0.801302 1.006307 1.228947 1.174967 0.712656 1.235684 0.437185 1.685920 1.628311 0.432535 1.406407 0.211487 1.631733 1.309990 0.088839 1.823347 0.645147 0.984102 0.938592 0.791055 1.200055 1.653923 1.369127 1.660169 1.684809 1.277014 1.423374 1.618705 1.761213 0.185242 0.737016 0.819843 1.700256 1.790111 1.582839 0.397943 0.430644 0.413691 1.861593 0.597392 0.781277 0.169222 1.035252 0.907321 0.225899 -0.109171 1.673244 0.994007 0.840763 0.321135 1.684359 1.522767 0.808080 0.918598 -0.016940 0.115899 0.890010 0.043957 1.335248)
- 11.032115 #(0.000000 0.351913 1.008229 1.290810 1.351921 1.218626 1.554526 -0.093588 0.793102 1.711302 0.845347 1.377484 0.006784 1.144284 0.031683 1.388145 0.800960 1.006082 1.229342 1.174225 0.712147 1.236527 0.437347 1.686206 1.627692 0.432656 1.405914 0.210961 1.631819 1.309977 0.087860 1.822432 0.644408 0.984571 0.939058 0.792248 1.201512 1.653580 1.368837 1.658514 1.685766 1.277126 1.423026 1.618112 1.761457 0.185672 0.737921 0.819532 1.700455 1.788301 1.582342 0.398274 0.430584 0.412799 1.861407 0.596133 0.780806 0.168670 1.035568 0.907062 0.225518 -0.107722 1.673471 0.992911 0.840564 0.320937 1.685024 1.523213 0.807801 0.919539 -0.015957 0.116192 0.890310 0.044547 1.335987)
+ ;; 74+1
+ 10.845278 (fv 0.000000 0.303549 1.218741 0.552551 0.569127 0.472240 0.245073 0.036162 0.777257 1.317108 0.637687 1.223165 0.113140 1.175025 0.935816 0.812633 0.204261 0.775370 -0.063348 1.606612 -0.062866 1.039670 1.212702 1.714844 1.899468 1.335566 -0.020119 1.590425 0.290190 1.193213 1.001576 0.516379 0.026311 0.170930 -0.096650 -0.315084 0.554428 0.144183 1.271300 0.005031 0.147859 0.041442 -0.048782 1.533805 1.480719 1.134329 1.851707 1.704199 0.286268 0.581546 0.690124 0.731502 1.497188 1.734408 1.013517 -0.010349 1.506433 0.024492 0.040181 1.200857 0.486442 0.422051 1.858040 1.837071 0.586958 0.629092 1.226159 0.139529 1.240473 1.272372 -0.245955 0.719958 -0.223615 0.281302 0.252047)
)
;;; 76 prime --------------------------------------------------------------------------------
-#(76 13.691219362758 #(0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0)
- 13.288178191792 #(0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1)
+(vector 76 13.288178191792 (fv 0 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1)
- 11.082413 #(0.000000 1.179182 0.931475 0.921286 1.828412 0.562150 1.231889 1.345837 0.788596 0.090702 0.931554 0.724461 0.872093 1.601897 0.587377 1.205321 0.475472 -0.139894 0.781730 0.567418 0.533126 0.323891 1.817577 0.129692 0.909592 1.639992 1.335572 -0.048328 0.742056 1.787078 0.470163 -0.291516 0.659728 1.160563 1.825578 0.699675 0.866452 1.858507 0.032982 0.157778 0.523081 0.165327 1.641887 0.863448 1.762406 1.012082 0.595485 0.050743 0.694825 1.549198 1.213781 0.031201 0.470008 0.023469 1.069435 1.190167 1.198186 0.440368 0.783288 1.497718 0.680233 0.671753 1.585429 1.321243 0.048467 0.942696 1.215482 1.879420 0.592916 0.176010 0.634435 0.454045 -0.096683 1.830724 0.759993 0.600643)
+ 11.052689 (fv 0.000000 1.173531 0.914653 0.927606 1.833325 0.572990 1.228121 1.340974 0.777818 0.101179 0.922381 0.727758 0.848668 1.622591 0.600587 1.207357 0.483679 -0.135739 0.789693 0.557916 0.529588 0.315324 1.810649 0.126643 0.909249 1.640326 1.342327 -0.052236 0.755820 1.799623 0.462177 -0.288032 0.651075 1.169254 1.824988 0.704237 0.880995 1.859829 0.036089 0.149448 0.542052 0.160045 1.646079 0.860838 1.752249 1.025660 0.604221 0.046575 0.711402 1.553525 1.214111 0.036075 0.479955 0.029596 1.070090 1.208893 1.207610 0.470868 0.758081 1.507527 0.678107 0.675805 1.580182 1.324295 0.061587 0.955350 1.218409 1.880195 0.596793 0.165057 0.646006 0.454851 -0.080576 1.833376 0.764382 0.602862)
+
+ ;; 75+1
+ 10.919127 (fv 0.000000 0.249051 1.283752 0.578538 0.465889 0.328282 0.397520 0.048700 0.732044 1.506763 0.870470 1.024466 0.125905 1.199969 1.200490 0.828996 0.327349 0.743916 -0.083081 1.581866 -0.022026 1.010771 1.314126 1.641110 1.977207 1.418126 -0.002727 1.553515 0.292061 1.103162 1.068475 0.567360 0.089633 0.183619 -0.243814 -0.246117 0.459882 0.118225 1.182209 0.017390 0.042772 0.114593 -0.081235 1.493721 1.405420 1.147867 1.909741 1.653034 0.237976 0.515913 0.601555 0.768092 1.451311 1.697940 1.055226 -0.095470 1.438708 0.052821 -0.122724 1.275935 0.441115 0.338376 1.822506 1.852761 0.555244 0.752898 1.362553 0.167682 1.066534 1.298923 -0.414288 0.895495 -0.078589 0.121695 0.415788 -0.032714)
)
;;; 77 prime --------------------------------------------------------------------------------
-#(77 14.029663085938 #(0 1 0 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1)
- 13.845010757446 #(0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0 0)
- 13.330450043717 #(0 1 0 1 0 0 0 1 0 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1)
- 13.158900260925 #(0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 1 1)
+(vector 77 13.158900260925 (fv 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 1 1 1 1)
- 10.896722 #(0.000000 1.165158 0.917575 1.925235 0.145338 1.469839 1.848479 0.663017 0.900367 0.676239 0.915076 1.396944 1.745783 -0.223947 0.377228 0.160389 1.340301 0.223510 0.789020 0.315323 1.447417 0.486381 1.173746 1.116069 0.267057 1.314169 1.268520 0.669022 0.988213 0.054845 0.842376 -0.099612 0.506953 0.532628 0.524387 0.945799 0.354097 -0.138246 0.927859 0.905974 -0.345006 0.026091 0.379093 0.146254 0.324980 1.411597 0.128500 1.956074 0.522991 0.454742 0.133469 1.767338 0.483719 0.478292 1.700923 1.356730 1.168836 0.979103 0.806081 1.927869 0.591126 0.217017 0.634125 0.630938 1.453497 1.244956 0.241113 1.297998 1.000311 0.335871 1.479704 0.663726 1.439405 0.985968 -0.201372 1.661996 -0.098692)
+ 10.802937 (fv 0.000000 1.170348 0.872365 1.938370 0.176318 1.425001 1.816351 0.600885 0.838206 0.617008 0.862854 1.459906 1.685266 -0.294339 0.340282 0.188975 1.272363 0.222263 0.754500 0.303643 1.420294 0.520239 1.223316 1.153660 0.209190 1.335123 1.331714 0.719154 0.909245 -0.009852 0.827474 -0.139034 0.531790 0.623898 0.587466 0.935238 0.452213 -0.149439 0.923750 0.885640 -0.429219 0.037445 0.354080 0.150061 0.302072 1.423031 0.130250 -0.009435 0.571653 0.410660 0.194501 1.802956 0.455392 0.509514 1.619972 1.373513 1.082720 1.024058 0.798330 0.005055 0.529388 0.193199 0.652877 0.658529 1.505933 1.232728 0.171053 1.366924 1.004855 0.355582 1.506276 0.574068 1.502183 1.005869 -0.239104 1.730993 -0.006156)
)
;;; 78 prime --------------------------------------------------------------------------------
-#(78 13.920186042786 #(0 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1)
- 13.683882347187 #(0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1)
- 13.498236182018 #(0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1)
+(vector 78 13.498236182018 (fv 0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1)
+
+ 11.128810 (fv 0.000000 1.556151 1.350766 1.079560 1.627456 1.824396 0.970239 1.719188 0.076491 0.356551 0.956437 1.450393 1.649467 1.028644 0.913293 0.244507 0.114759 1.070289 1.644113 1.454817 0.980418 0.918084 0.619510 1.767585 1.807117 0.656270 1.762010 0.672983 0.042023 -0.071247 0.983492 -0.081135 0.135693 0.114828 1.357805 -0.252941 1.850579 1.671928 0.257832 0.920719 0.631282 0.706947 1.321680 1.346893 -0.182371 -0.272451 0.054087 1.657623 0.055118 0.350677 1.314600 0.063294 0.902678 0.105522 1.670846 0.405032 -0.075578 -0.012369 -0.068016 1.298918 0.818077 -0.266776 0.759067 0.508057 -0.040066 1.459059 0.532881 1.133191 1.019843 -0.486096 1.086169 0.894532 1.300427 1.601490 0.616399 1.768752 1.000095 1.636458)
- 11.143804 #(0.000000 1.554361 1.351090 1.079023 1.626138 1.825771 0.970375 1.716507 0.075337 0.356138 0.957653 1.450413 1.650089 1.030169 0.914151 0.243129 0.117108 1.069266 1.642461 1.454248 0.981056 0.918890 0.620104 1.767858 1.807620 0.657408 1.762619 0.671276 0.040792 -0.070513 0.985159 -0.082678 0.137669 0.115438 1.357578 -0.253099 1.849973 1.671217 0.257722 0.921993 0.630697 0.707466 1.323108 1.344724 -0.181591 -0.271750 0.052044 1.657061 0.055399 0.351340 1.315269 0.065553 0.903608 0.106720 1.669866 0.404499 -0.075873 -0.011648 -0.069786 1.299267 0.818092 -0.267117 0.758806 0.508922 -0.039949 1.458382 0.534294 1.133940 1.019936 -0.485822 1.084774 0.894915 1.301040 1.601606 0.618844 1.766949 1.000229 1.637281)
+ ;; 77+1
+ 11.104393 (fv 0.000000 1.124037 0.854979 1.945811 0.208140 1.468398 1.815990 0.611918 0.912844 0.730140 0.961369 1.376309 1.803559 -0.243021 0.398976 0.193476 1.338837 0.340346 0.793855 0.341671 1.410779 0.565778 1.176931 1.048390 0.277106 1.445162 1.185150 0.642492 0.933385 0.019030 0.859542 -0.113411 0.532157 0.598476 0.550518 0.931780 0.311264 -0.108835 0.867767 0.932278 -0.351004 0.021213 0.390636 0.076987 0.338139 1.457487 0.082705 1.889708 0.513158 0.413795 0.138548 1.809057 0.494899 0.552125 1.690745 1.358244 1.250637 0.989495 0.775385 1.847135 0.528873 0.242941 0.558866 0.669472 1.484739 1.334473 0.249966 1.409992 1.022049 0.346238 1.534652 0.641930 1.394789 0.932978 -0.210333 1.769933 -0.083609 -0.106856)
)
;;; 79 prime --------------------------------------------------------------------------------
-#(79 14.000000000005 #(0 0 0 0 0 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 0 1 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 1 1 0)
- 13.77695274353 #(0 1 1 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 0 0 1 0 0)
- 13.178678233398 #(0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1)
+(vector 79 13.178678233398 (fv 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1)
- 11.240494 #(0.000000 1.314698 1.469947 1.322741 0.552921 1.139925 0.772290 1.074937 0.564339 1.790988 1.661353 0.757293 0.687978 1.551387 -0.052738 0.432336 1.775365 0.013563 0.617064 1.306235 -0.001956 1.605073 0.568812 0.245730 0.951447 0.977416 1.750014 0.453974 0.114584 0.443918 1.015005 1.420297 0.278660 0.859890 1.589855 1.546276 1.517432 0.558533 1.512659 -0.001019 1.651581 1.327493 1.374034 0.042045 1.540369 0.546913 0.708918 0.550942 0.020430 1.130710 1.533221 -0.036717 0.579934 -0.104548 0.234707 0.510044 1.032794 0.940980 -0.292058 -0.034922 -0.071772 1.457271 0.360064 1.599657 0.296849 0.727997 0.024240 0.534427 1.412972 1.695217 -0.006593 -0.007219 1.475564 1.695041 1.175522 1.818712 1.793629 1.423622 0.906716)
+ 11.177833 (fv 0.000000 1.310798 1.470398 1.323367 0.553981 1.135824 0.783258 1.090444 0.524280 1.788975 1.639185 0.764585 0.676397 1.561727 -0.046007 0.428923 1.763449 0.011640 0.636361 1.341212 0.004579 1.608860 0.575061 0.243266 0.907181 0.977184 1.726699 0.431482 0.140827 0.464141 1.057140 1.400168 0.289408 0.838151 1.631807 1.530460 1.501458 0.566438 1.487014 0.015110 1.680036 1.296993 1.364424 0.039821 1.528230 0.589464 0.715462 0.552663 -0.017058 1.149326 1.516482 -0.030051 0.582733 -0.149911 0.234725 0.517539 1.013720 0.964483 -0.295150 -0.068887 -0.069035 1.472439 0.368231 1.600803 0.316013 0.723864 0.014324 0.524613 1.419685 1.673198 -0.043005 -0.029455 1.487321 1.686189 1.173017 1.833259 1.763911 1.426155 0.892867)
)
;;; 80 prime --------------------------------------------------------------------------------
-#(80 14.309369414534 #(0 1 1 0 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 0)
- 14.119678497314 #(0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1)
- 13.563344594765 #(0 1 1 0 0 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 1 0 0 1 0 0 1 0 1 0 0)
- 13.547472953796 #(0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1)
+(vector 80 13.547472953796 (fv 0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 1)
- 11.467322 #(0.000000 -0.012437 0.391202 0.220927 0.027029 0.978277 0.514588 0.532958 0.361634 0.617262 1.341635 0.888891 1.601691 1.372454 0.123191 0.279258 -0.016799 0.465465 1.222875 1.958104 0.569117 1.700039 0.580085 1.200636 1.408620 1.173249 0.506922 0.800401 0.267240 -0.106539 1.746280 0.434909 1.044480 1.843412 0.032856 1.870511 0.543349 1.650225 0.514479 1.863606 0.330936 0.129176 0.410029 0.986585 1.603466 0.778859 0.138059 1.178200 0.746199 1.117365 0.917073 0.797330 0.356100 1.163554 0.639876 1.216374 0.367434 0.258408 0.897856 0.040377 1.818040 1.401676 1.192487 0.699284 1.371126 0.285723 0.603887 0.171793 1.255679 0.148602 1.271897 0.592541 1.746778 0.953881 1.488550 1.384669 1.365235 1.727867 1.576624 1.630169)
+ 11.451369 (fv 0.000000 -0.011188 0.391305 0.222144 0.025668 0.977359 0.513223 0.531901 0.360643 0.616841 1.341911 0.888846 1.600347 1.373974 0.123418 0.279769 -0.016126 0.463887 1.222914 1.957299 0.569052 1.699668 0.580517 1.202146 1.407428 1.172831 0.507495 0.800333 0.267556 -0.108002 1.745992 0.435164 1.044228 1.843822 0.030677 1.871048 0.542929 1.649600 0.514183 1.864352 0.330625 0.131744 0.409433 0.986423 1.602974 0.780283 0.138004 1.178452 0.747173 1.116954 0.917346 0.796903 0.356061 1.164738 0.640385 1.216938 0.366648 0.258624 0.900284 0.041536 1.817962 1.403113 1.192348 0.700576 1.370480 0.286847 0.603480 0.172807 1.255252 0.148259 1.272121 0.592895 1.744785 0.951797 1.489669 1.384870 1.365248 1.727217 1.576364 1.630892)
+
+ ;; 79+1
+ 11.248369 (fv 0.000000 1.320660 1.562587 1.230907 0.791500 1.111831 0.776332 1.212269 0.471199 1.929248 1.797736 0.814341 0.620835 1.395121 -0.166860 0.291055 1.737100 0.070444 0.531137 1.293083 0.075352 1.711864 0.539841 0.274514 0.922582 0.992421 1.608388 0.391268 0.216699 0.537576 0.886521 1.411196 0.301396 0.827503 1.619143 1.601542 1.558307 0.639158 1.445488 -0.167072 1.736837 1.279584 1.414784 0.077225 1.537483 0.689000 0.730293 0.519349 -0.104713 1.140696 1.722734 -0.057361 0.493518 -0.183111 0.352303 0.572659 0.917617 1.016232 -0.317574 -0.040058 -0.065357 1.491653 0.416263 1.654521 0.241001 0.536870 0.065165 0.568896 1.612372 1.840754 0.054958 0.057425 1.377368 1.668931 1.097005 1.763836 1.887359 1.244817 0.894926 -0.107373)
)
;;; 81 prime --------------------------------------------------------------------------------
-#(81 14.317508929282 #(0 1 0 0 1 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0)
- 14.256287400004 #(0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 0 1 1)
- 13.652944564819 #(0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 1)
+(vector 81 13.652944564819 (fv 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 1)
+
+ 11.500874 (fv 0.000000 0.060156 1.198187 0.010810 -0.059627 1.336892 0.174682 0.177182 0.303039 0.507728 0.174616 0.162104 0.767672 0.283268 0.740356 1.244073 0.411651 0.771082 0.597722 1.646364 0.130092 1.399674 1.196320 1.542256 1.814795 0.969378 1.368552 0.008802 1.647015 1.538679 0.957584 0.562757 0.185463 0.612441 1.264483 1.129777 -0.291833 0.231345 1.808426 -0.095607 1.827790 0.807634 0.929515 0.025793 1.640598 1.271614 1.470525 0.036943 0.657753 0.872430 1.519719 0.128077 0.109048 0.492656 -0.089269 0.591629 -0.109776 0.882829 0.675418 0.557752 1.879709 0.050861 1.363712 1.313213 0.120759 0.673965 0.894225 1.390640 -0.198915 1.435867 0.650146 0.682721 0.919339 1.509191 0.176654 0.428794 0.550059 1.279511 0.067206 1.270072 0.509792)
- 11.513790 #(0.000000 0.058683 1.197396 0.010328 -0.060302 1.336613 0.174722 0.177880 0.302291 0.507855 0.174739 0.161816 0.766704 0.284426 0.740083 1.244090 0.410446 0.771751 0.597588 1.645990 0.129802 1.399382 1.196528 1.543294 1.815296 0.968575 1.367490 0.009344 1.647537 1.539562 0.958870 0.563098 0.184264 0.612519 1.264316 1.130159 -0.292758 0.231500 1.808431 -0.095502 1.828623 0.807865 0.928719 0.025343 1.639954 1.271834 1.469724 0.036411 0.658807 0.871259 1.519642 0.127989 0.108066 0.491618 -0.091452 0.589349 -0.110762 0.883740 0.675853 0.557768 1.878666 0.050932 1.363703 1.314145 0.120489 0.673949 0.893205 1.389971 -0.199669 1.435960 0.649382 0.682766 0.919254 1.508876 0.175750 0.428360 0.550580 1.280261 0.066602 1.270465 0.510181)
+ ;; 80+1
+ 11.318789 (fv 0.000000 1.312875 1.595991 1.250300 0.860994 1.125394 0.798611 1.212371 0.450471 1.878426 1.854513 0.914795 0.516574 1.401974 -0.113348 0.191503 1.535380 0.090102 0.579969 1.358286 0.094046 1.749820 0.409421 0.342346 0.891748 1.034938 1.701846 0.411592 0.161183 0.550475 0.945261 1.433769 0.390250 0.782945 1.725670 1.526810 1.626189 0.651868 1.370885 -0.153655 1.876481 1.236862 1.409437 0.102929 1.494796 0.718278 0.752798 0.534726 -0.125235 1.053652 1.624242 -0.009527 0.513674 -0.193412 0.274147 0.590252 0.888478 1.001277 -0.294725 -0.017970 0.022617 1.502755 0.474472 1.669991 0.292823 0.423633 -0.068585 0.472411 1.717891 1.789153 0.120369 -0.013158 1.253256 1.671744 1.049132 1.799303 1.831390 1.289936 0.966946 -0.056458 0.096803)
)
;;; 82 prime --------------------------------------------------------------------------------
-#(82 14.492313651671 #(0 1 0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0)
- 14.126787045134 #(0 1 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0)
+(vector 82 14.126787045134 (fv 0 1 0 1 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0)
- 11.492896 #(0.000000 1.167914 -0.046308 1.432193 0.006592 1.403521 0.546783 1.692332 0.899065 -0.076462 1.028607 0.381893 1.529729 0.076013 0.131619 1.428631 1.224703 1.065783 0.134594 0.252780 1.940716 0.221091 1.522602 0.080222 0.116523 1.164174 0.452344 1.076456 0.105827 0.322727 0.015847 0.012294 0.835762 0.583649 1.418913 0.375005 0.962232 0.106620 0.268121 0.160268 0.427262 1.135189 0.576822 1.594435 1.418762 -0.005956 1.734803 0.347099 0.715131 0.650767 0.175224 0.189154 0.617850 -0.013711 0.118639 0.504508 1.460760 1.343756 1.244395 -0.030250 0.817620 1.457756 1.769590 -0.004749 0.577276 1.248575 1.743191 1.354844 0.735176 0.401884 1.035564 1.244600 0.707924 1.652323 0.531469 1.167863 0.843445 0.089601 0.026657 0.421981 0.714469 0.174360)
+ 11.462533 (fv 0.000000 1.174537 -0.036810 1.449073 0.002634 1.412064 0.527823 1.690777 0.901678 -0.091711 1.027422 0.397477 1.526657 0.088004 0.143741 1.426347 1.215238 1.051627 0.132305 0.242096 1.932884 0.204037 1.515523 0.068047 0.117753 1.158626 0.459284 1.081363 0.079849 0.326802 0.035989 0.012387 0.861938 0.605551 1.407324 0.411725 0.979703 0.090881 0.271335 0.152506 0.410872 1.149930 0.566324 1.611304 1.416641 0.010695 1.743925 0.323768 0.693725 0.691039 0.186118 0.191067 0.629603 -0.034867 0.109309 0.522152 1.478755 1.337464 1.245454 -0.020762 0.796712 1.449381 1.763960 0.000713 0.577015 1.247460 1.754051 1.376869 0.724941 0.407841 1.068454 1.226119 0.726352 1.657000 0.543820 1.177669 0.881363 0.120220 0.019239 0.418519 0.727327 0.208388)
+
+ ;; 81+1
+ 11.476728 (fv 0.000000 1.354025 1.769404 1.190492 0.845403 1.129164 0.681502 1.298591 0.526568 1.843796 1.839481 0.929391 0.545970 1.407502 -0.189236 0.155330 1.457831 0.110325 0.689064 1.222186 0.140271 1.863572 0.397423 0.425505 0.924253 1.034491 1.746896 0.221413 0.062871 0.570198 0.961166 1.514028 0.333971 0.850400 1.784003 1.484569 1.642647 0.680600 1.387654 -0.169385 1.868168 1.192895 1.317483 0.057642 1.550333 0.713537 0.826588 0.568782 -0.116091 1.031193 1.647713 0.076692 0.476679 -0.258739 0.325137 0.519423 0.928625 1.015174 -0.230419 -0.032172 0.037533 1.492936 0.495027 1.663321 0.378454 0.435791 -0.107582 0.529403 1.716992 1.827784 0.057964 -0.044990 1.256674 1.627386 1.007381 1.757651 1.738780 1.265746 1.051412 0.004277 0.076991 0.034105)
+
+ ;; 83-1
+ 11.480416 (fv 0.000000 0.454164 1.374754 0.722227 0.986349 1.377355 1.172894 0.123589 1.410636 1.726879 1.302862 1.602018 1.474058 1.472070 0.412168 1.770446 1.982011 1.625710 0.940561 0.534669 0.102735 0.053883 0.631657 1.350304 0.393669 0.521507 -0.049446 0.629634 1.041110 1.379158 -0.156331 1.690517 0.010013 1.800842 0.947691 1.681261 1.009361 1.763476 0.941228 1.218725 1.847726 0.614247 1.223796 0.150627 0.820237 0.298534 1.321472 0.537094 1.742045 0.701084 0.211813 0.587227 0.340134 0.598492 1.566318 1.525148 0.920822 1.421639 1.608617 0.590851 0.062396 0.476310 0.647458 0.340763 1.923701 0.385843 0.256835 1.446458 1.741785 0.470072 1.939455 0.907485 0.836540 0.652790 1.796743 1.327810 0.106788 1.646107 1.364400 0.210392 0.634295 1.443213)
)
;;; 83 prime --------------------------------------------------------------------------------
-#(83 14.249828726851 #(0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1)
- 14.019070339131 #(0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1)
+(vector 83 14.019070339131 (fv 0 1 1 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1)
- 11.530913 #(0.000000 0.475851 1.444723 0.757858 0.904733 1.501000 1.172728 0.149404 1.398761 1.716820 1.242155 1.599695 1.478450 1.407001 0.382196 1.635658 1.907376 1.571796 0.846512 0.449900 0.103090 1.981338 0.703863 1.449564 0.361534 0.581715 -0.030748 0.642866 0.969864 1.352552 -0.172092 1.707652 0.048421 1.731512 0.992904 1.700015 0.858355 1.740263 0.896726 1.353984 1.888945 0.627725 1.157786 0.151758 1.019689 0.390146 1.356401 0.566666 1.739523 0.772509 0.240025 0.445990 0.326095 0.646242 1.537467 1.582347 0.988216 1.423442 1.523720 0.570404 -0.022544 0.566320 0.634722 0.252204 1.923713 0.461661 0.402149 1.505531 1.697273 0.454165 1.861622 0.840310 0.827276 0.672857 1.807267 1.203815 0.217162 1.657444 1.547367 0.123306 0.644059 1.373094 0.323065)
+ 11.495305 (fv 0.000000 0.489724 1.459665 0.744876 0.880930 1.487259 1.179525 0.143969 1.398705 1.711637 1.229644 1.599300 1.480153 1.405136 0.390934 1.640936 1.928348 1.588509 0.860260 0.449815 0.093357 1.993956 0.692831 1.455573 0.371844 0.551569 -0.014841 0.652289 1.000821 1.372208 -0.157122 1.697110 0.020676 1.736939 1.000046 1.712927 0.862704 1.740081 0.913067 1.344458 1.894797 0.629049 1.175321 0.159464 0.992773 0.367516 1.362985 0.576721 1.753109 0.776625 0.227603 0.452205 0.315264 0.636900 1.541376 1.554828 0.983967 1.431020 1.527430 0.561443 -0.018728 0.579720 0.634527 0.252657 1.931947 0.472631 0.403447 1.506115 1.700022 0.443875 1.857223 0.863365 0.830784 0.658374 1.791596 1.216322 0.200510 1.645886 1.544611 0.129139 0.651447 1.366065 0.329410)
)
;;; 84 prime --------------------------------------------------------------------------------
-#(84 14.422843763275 #(0 1 0 0 0 0 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 0)
- 14.299305314276 #(0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 1)
- 14.264351844788 #(0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 0 0 0 0 1 0 1 1)
- 14.024940956301 #(0 1 0 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 0)
+(vector 84 14.024940956301 (fv 0 1 0 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 0)
- 11.574409 #(0.000000 1.282560 1.223342 1.432002 1.016293 1.316720 0.865352 -0.349697 -0.449190 0.539467 0.805974 1.143171 0.803868 0.772002 0.921234 -0.063479 1.899949 1.328576 0.637099 0.932911 1.469876 1.614987 -0.339167 1.478309 0.483741 0.390886 1.163942 0.470357 0.810273 0.219645 1.036897 0.113548 1.710057 0.572911 0.443119 0.251833 1.104291 0.711113 0.543726 0.758143 0.527244 1.366330 0.023964 1.410219 0.075815 0.456877 1.054385 0.584006 1.147423 1.240401 0.041550 1.096751 -0.036363 1.057252 0.479329 -0.635745 0.691549 0.690230 1.726385 0.566175 1.047778 0.855209 0.538148 0.960995 0.559253 1.097595 -0.120621 1.348534 0.182512 0.797733 0.973860 0.095284 -0.192937 1.397744 1.551467 0.661691 0.567804 1.234522 0.049550 0.901267 1.649967 0.830469 0.179233 0.669484)
+ 11.536851 (fv 0.000000 1.288171 1.222912 1.421316 0.994256 1.309106 0.862461 -0.365885 -0.460542 0.530989 0.804830 1.140139 0.788715 0.769440 0.941320 -0.061500 1.897753 1.285116 0.647118 0.948482 1.478812 1.645309 -0.360540 1.475165 0.480180 0.398442 1.131834 0.453887 0.828958 0.223971 1.033478 0.103677 1.715711 0.595485 0.422094 0.246530 1.081093 0.706350 0.534924 0.737096 0.520740 1.348231 0.027898 1.430351 0.071366 0.456025 1.024992 0.563780 1.148663 1.244878 0.023430 1.078768 -0.035007 1.108834 0.481954 -0.628990 0.715248 0.675907 1.709977 0.563135 1.037605 0.888801 0.556599 0.958729 0.571715 1.126122 -0.072129 1.378438 0.187340 0.783805 0.989989 0.112073 -0.183972 1.388719 1.544777 0.651714 0.568338 1.234814 0.056527 0.901152 1.674263 0.800528 0.192396 0.655541)
)
;;; 85 prime --------------------------------------------------------------------------------
-#(85 14.721940394615 #(0 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 0 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 0 0 0 0 0 0 0 0 1)
- 14.400919537796 #(0 0 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1)
- 14.253310943921 #(0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1)
+(vector 85 14.253310943921 (fv 0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1)
- 11.658173 #(0.000000 0.057675 0.207712 1.739463 0.566681 1.645284 1.163543 1.533369 1.062251 1.718627 0.614059 1.771722 0.699885 0.908615 1.284958 -0.076979 1.321082 1.261508 1.501617 1.252253 1.406099 0.898174 0.480875 1.255956 -0.017435 0.053248 0.134529 1.076192 0.929255 1.253036 0.829973 0.379995 0.660610 1.782336 1.116886 1.269969 1.023352 1.217362 1.188474 1.430360 0.700062 0.248219 0.608814 1.452507 0.174847 1.980494 0.173937 1.282177 0.609684 1.692249 0.885912 0.936520 0.243555 0.894760 -0.201209 0.783107 0.206551 1.128072 1.606420 1.725374 1.483375 -0.492744 1.785078 1.513649 1.724359 -0.434796 0.783505 1.860353 1.292787 1.178441 0.135156 0.781679 1.120054 -0.183986 1.745835 0.391382 -0.040387 0.614303 0.370700 0.247671 1.133349 1.582642 0.708383 -0.225945 -0.111485)
+ 11.588928 (fv 0.000000 0.051144 0.232251 1.722677 0.580164 1.682133 1.175152 1.551429 1.040385 1.746433 0.629958 1.774843 0.701195 0.931344 1.300787 -0.092863 1.300643 1.259885 1.530011 1.258206 1.393028 0.930782 0.485840 1.244517 -0.032618 0.062247 0.154622 1.065009 0.904299 1.262092 0.852812 0.408235 0.633914 1.770716 1.085864 1.265219 1.003699 1.255985 1.195701 1.382932 0.704891 0.246143 0.639193 1.457010 0.146909 1.982729 0.165366 1.294717 0.624758 1.669440 0.868773 0.953753 0.230896 0.915079 -0.212743 0.773612 0.218470 1.122339 1.601419 1.730078 1.474786 -0.488722 1.796889 1.514239 1.703114 -0.437786 0.743917 1.859124 1.287147 1.160254 0.159597 0.817545 1.148746 -0.204270 1.716652 0.382598 -0.057580 0.598631 0.343212 0.230053 1.103741 1.603024 0.720362 -0.247891 -0.077598)
)
;;; 86 prime --------------------------------------------------------------------------------
-#(86 14.993455205117 #(0 0 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 1 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 0 1)
- 14.394402956102 #(0 0 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1 1 0 0 0 0 1)
- 14.017106967247 #(0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1)
+(vector 86 14.017106967247 (fv 0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1)
- 11.538173 #(0.000000 1.257211 0.755102 1.760570 1.053221 1.125958 1.193499 0.994955 1.748532 0.712251 0.177700 0.562988 1.134204 0.235767 0.728778 0.302145 0.564852 1.272795 0.865279 0.293326 0.696817 0.364062 0.244337 1.692516 0.325607 1.482255 0.112382 1.764339 0.390598 1.097379 1.852168 0.383884 1.598759 0.321666 0.222367 1.453166 0.861474 1.218092 0.475643 0.148937 1.482182 1.779657 1.800072 1.719008 1.123242 0.712150 0.539832 -0.312865 0.992840 1.111346 0.122252 1.868981 1.335563 0.877255 1.683180 0.892791 0.999703 1.642294 1.226711 0.837700 1.947500 0.463608 1.056193 1.078837 1.537270 1.526240 0.006649 0.654868 -0.124745 0.281314 0.634066 1.772359 0.323717 1.303204 0.482285 1.468185 1.902011 0.569900 1.483980 0.829916 0.731950 0.635233 1.341801 1.297467 1.873810 1.498208)
+ 11.517897 (fv 0.000000 1.259153 0.753054 1.764686 1.049517 1.125067 1.190973 0.991011 1.742456 0.708907 0.178161 0.559310 1.128716 0.240782 0.729992 0.303371 0.569838 1.273658 0.861674 0.290602 0.694623 0.362989 0.243116 1.696103 0.326714 1.481176 0.105867 1.763155 0.389638 1.096089 1.860461 0.384795 1.595111 0.327309 0.224303 1.457357 0.863276 1.221159 0.474861 0.148710 1.484645 1.778010 1.802629 1.714822 1.122256 0.709074 0.540633 -0.317254 0.997156 1.115917 0.123376 1.869025 1.339712 0.876345 1.682733 0.893530 0.998209 1.642978 1.224902 0.836368 1.948885 0.464451 1.058190 1.080864 1.538683 1.521142 0.009248 0.654339 -0.126350 0.282369 0.636445 1.771914 0.323435 1.302976 0.483884 1.466774 1.898584 0.571020 1.479654 0.824385 0.735539 0.638514 1.340179 1.302713 1.869702 1.497079)
)
;;; 87 prime --------------------------------------------------------------------------------
-#(87 14.798576861642 #(0 0 0 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0)
- 14.519235937355 #(0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 0)
- 13.98394199918 #(0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 0)
+(vector 87 13.98394199918 (fv 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 0)
+
+ 11.888688 (fv 0.000000 0.482398 1.227138 1.272721 0.078687 1.831113 1.162310 1.536977 1.689231 0.888900 -0.147273 1.167875 0.136674 0.075484 0.629027 1.034119 0.307327 0.024754 1.634526 1.779718 -0.119653 0.312698 0.930420 1.385321 1.107173 1.761414 0.822994 0.223996 0.948219 0.050573 1.181566 -0.076310 1.414999 0.950580 1.442020 0.563152 0.962072 1.833788 0.503591 1.266688 1.037104 0.455604 0.146748 1.270845 0.375842 1.270415 0.973599 0.773789 1.316233 0.694384 1.909797 0.637408 1.683609 1.640242 0.084358 0.069276 0.823261 1.794579 0.489470 1.507812 0.467715 1.270885 1.378929 1.892053 0.446100 1.349825 1.591977 0.875580 1.281794 0.089884 0.566164 1.762552 1.251149 0.938610 1.580460 1.542270 0.684665 0.182715 1.926062 0.347598 0.716836 1.752700 1.597850 1.520331 1.622999 0.031320 1.757914)
- 11.941336 #(0.000000 0.480159 1.221187 1.272535 0.070996 1.832080 1.160813 1.532495 1.702487 0.897959 -0.155848 1.166540 0.133232 0.082308 0.644198 1.030615 0.305956 0.025830 1.632889 1.777040 -0.113842 0.307360 0.941636 1.398535 1.110473 1.769657 0.824395 0.224482 0.962365 0.047365 1.176372 -0.067349 1.411516 0.951601 1.438656 0.560151 0.967629 1.840345 0.499887 1.253922 1.035801 0.461306 0.136963 1.269282 0.375659 1.270855 0.977710 0.772610 1.310465 0.693224 1.909580 0.657310 1.688758 1.645463 0.092532 0.070694 0.826485 1.799426 0.493600 1.519481 0.471911 1.282529 1.379330 1.885790 0.436572 1.343146 1.602274 0.872178 1.288149 0.084375 0.570947 1.767245 1.253704 0.924571 1.591522 1.529376 0.685247 0.184219 1.930392 0.361039 0.709417 1.750404 1.601851 1.518567 1.614624 0.027505 1.760602)
+ ;; 86 + 1
+ 11.612976 (fv 0.000000 1.296504 0.726706 1.718822 1.046681 1.126904 1.153426 0.940241 1.708793 0.818644 0.107576 0.530980 1.122499 0.334577 0.735679 0.325192 0.616360 1.132997 0.845995 0.287311 0.640223 0.397260 0.270000 1.691583 0.368381 1.503691 0.176791 1.719860 0.415279 1.070108 1.956631 0.329587 1.654694 0.271910 0.194847 1.468802 0.897532 1.267673 0.483007 0.130123 1.446495 1.802533 1.802082 1.708319 1.123221 0.822012 0.552025 -0.324423 0.903301 1.074684 0.198879 1.961955 1.280447 0.787297 1.695626 0.996555 1.020892 1.595011 1.302967 0.813723 1.889725 0.419999 1.093466 1.051442 1.549928 1.587010 -0.012516 0.597662 -0.094834 0.261495 0.632231 1.919100 0.281141 1.272306 0.493568 1.244869 1.877721 0.661378 1.459138 0.814695 0.650143 0.614249 1.318253 1.365141 1.852338 1.532615 -0.014292)
)
;;; 88 prime --------------------------------------------------------------------------------
-#(88 15.158827781677 #(0 1 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1)
- 14.908 #(0 1 1 0 1 0 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 0 1 1 0)
- 14.84298551254 #(0 1 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0)
- 14.837036132812 #(0 1 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0)
- 14.825139803345 #(0 0 0 0 1 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0)
+(vector 88 14.825139803345 (fv 0 0 0 0 1 0 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0)
- 12.005966 #(0.000000 0.784063 0.583258 -0.032149 0.163808 0.328478 0.695745 0.791940 0.507644 0.396117 1.249311 0.826891 1.438537 1.346783 1.097811 0.836274 0.285349 0.832735 0.396442 0.462396 0.361898 1.183941 1.002305 0.908155 0.300099 1.533191 0.012913 -0.072755 0.995711 1.778383 0.687323 0.044309 0.465788 0.580356 0.998155 0.177939 1.437216 0.677022 1.615256 0.045780 0.566038 1.136333 0.636172 0.355924 1.821255 1.658255 1.589011 1.540226 1.621839 1.239248 1.605828 0.923615 1.791573 0.224213 1.057752 1.753768 0.670151 1.244161 0.682412 0.318462 0.831376 1.043185 0.550028 0.280385 1.731617 0.407187 1.758144 -0.020410 1.247993 0.309363 0.756110 0.657619 1.127810 -0.365007 1.908633 0.823630 1.016921 0.942110 1.685769 0.569829 1.741622 1.707118 1.304176 0.477986 0.894611 0.215112 1.447384 0.713984)
+ 11.988941 (fv 0.000000 0.784577 0.582655 -0.034103 0.163974 0.329543 0.693568 0.791635 0.508446 0.396915 1.248395 0.826252 1.437835 1.346260 1.098554 0.836111 0.285181 0.833650 0.396981 0.462954 0.362450 1.183096 1.004262 0.908804 0.301743 1.532670 0.011752 -0.072123 0.996811 1.778401 0.688894 0.044599 0.465473 0.579840 0.996613 0.177680 1.437542 0.677747 1.616279 0.045690 0.566144 1.136899 0.636783 0.355278 1.821475 1.658271 1.588631 1.539506 1.624123 1.239000 1.605890 0.921379 1.791768 0.223451 1.057625 1.753981 0.669208 1.245749 0.682902 0.319986 0.831757 1.041603 0.551747 0.279645 1.731984 0.406762 1.759751 -0.021178 1.248606 0.309853 0.756421 0.658187 1.127576 -0.365423 1.909061 0.823437 1.017441 0.941761 1.686220 0.570407 1.741961 1.705746 1.303576 0.477079 0.894393 0.214957 1.446786 0.714971)
+
+ ;; 87+1
+ 11.814735 (fv 0.000000 1.368148 0.691154 1.687498 1.039684 1.203556 1.189736 1.006697 1.714307 0.763256 0.064985 0.571039 1.207048 0.283865 0.790295 0.371929 0.626841 1.136922 0.897180 0.250579 0.703180 0.367153 0.285039 1.638464 0.403793 1.574680 0.178418 1.768394 0.361495 1.131365 1.971622 0.329290 1.677397 0.231014 0.189969 1.483487 0.936641 1.267305 0.514462 0.133317 1.438805 1.804423 1.766680 1.772823 1.080035 0.819063 0.520465 -0.385910 0.897901 1.088041 0.197160 0.026953 1.297496 0.779688 1.684839 1.075719 1.000862 1.653028 1.332924 0.886650 1.939949 0.418280 1.124021 1.085155 1.563576 1.537898 -0.095926 0.685710 -0.089908 0.297752 0.611005 1.863915 0.336806 1.344864 0.522590 1.267887 1.872098 0.632836 1.388439 0.783559 0.644197 0.609366 1.338438 1.322505 1.876261 1.537568 -0.063978 -0.021791)
)
;;; 89 prime --------------------------------------------------------------------------------
-#(89 15.157893052401 #(0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 1 1 0 1 0 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 1)
- 14.69031483888 #(0 1 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1)
+(vector 89 14.69031483888 (fv 0 1 0 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1)
+
+ 12.145572 (fv 0.000000 0.358269 1.288170 -0.001864 0.867779 1.364244 1.109375 1.164634 -0.016236 -0.166115 0.449176 1.706240 1.833933 -0.037127 1.772608 0.464339 0.514549 -0.440413 0.091904 1.161505 1.250171 0.825773 0.104691 1.330145 0.165858 0.782047 0.989298 1.471958 -1.844798 0.511831 1.629263 1.091421 0.075823 0.883705 0.737372 1.834115 1.253424 0.188184 -0.236434 0.698883 0.462924 1.137084 1.094253 1.071593 1.735305 1.138289 1.560372 0.992360 1.412813 1.873908 0.448635 -0.005058 0.329007 1.672360 0.604898 1.727995 0.648160 0.750281 0.125793 1.632855 1.581670 1.571564 1.278678 0.191912 0.145586 1.306040 0.445369 -0.231408 -0.001410 1.354497 1.551515 1.659096 -0.403896 0.821589 1.439452 1.005908 1.563170 1.260522 0.450255 1.234179 0.926658 0.279960 0.002426 1.200149 1.285451 0.986678 0.303114 1.568249 0.304851)
- 12.236176 #(0.000000 0.348320 1.287038 0.007097 0.865358 1.347209 1.120626 1.165165 -0.029369 -0.155944 0.430528 1.700951 1.827948 -0.032011 1.772923 0.459638 0.514010 -0.430139 0.100938 1.172085 1.247315 0.822993 0.110540 1.350176 0.194744 0.787307 0.984600 1.482409 -1.836984 0.519146 1.643699 1.091848 0.061172 0.876657 0.741363 1.863580 1.250442 0.195966 -0.246144 0.670441 0.444951 1.126256 1.097903 1.069457 1.735021 1.148374 1.578709 0.998967 1.423872 1.857562 0.447801 0.012722 0.322643 1.677738 0.601028 1.715046 0.641200 0.767701 0.123926 1.641009 1.574556 1.581658 1.284404 0.187431 0.122626 1.299082 0.432781 -0.227710 -0.002719 1.356395 1.560128 1.657238 -0.426784 0.819878 1.425764 1.010408 1.555298 1.270036 0.439730 1.236738 0.903421 0.281711 0.017609 1.213773 1.296914 0.990734 0.290751 1.572939 0.300657)
+ ;; 88+1
+ 11.787567 (fv 0.000000 1.314164 0.689513 1.628993 1.144940 1.224705 1.150205 1.016059 1.723195 0.713105 0.005841 0.484975 1.239550 0.341275 0.773786 0.398433 0.655094 1.170929 1.038464 0.301899 0.723090 0.410530 0.287119 1.633201 0.260609 1.623354 0.115980 1.879009 0.455545 1.070015 0.017172 0.270422 1.692490 0.233092 0.152980 1.556192 0.883089 1.261531 0.502559 0.146173 1.438907 1.785157 1.804773 1.715166 1.064977 0.807912 0.565628 -0.439659 0.842957 1.290534 0.179519 -0.023924 1.443203 0.792272 1.565433 1.032012 0.991867 1.644953 1.337404 0.854036 0.023578 0.413260 1.087165 1.065012 1.583652 1.496116 -0.065654 0.692422 -0.146363 0.297624 0.616209 1.798178 0.385485 1.334745 0.400370 1.168196 1.828136 0.707167 1.548668 0.793572 0.670466 0.690206 1.451727 1.295947 1.819151 1.442501 -0.262177 -0.013858 0.006952)
)
;;; 90 prime --------------------------------------------------------------------------------
-#(90 15.253639451837 #(0 1 1 0 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1)
- 14.917379556641 #(0 1 1 0 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1)
- 14.831111851861 #(0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1)
+(vector 90 14.831111851861 (fv 0 1 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 1 1 1)
- 12.056744 #(0.000000 0.307198 1.830828 1.069339 1.209168 0.604779 0.256536 0.525247 0.519446 0.536947 0.272027 -0.102258 0.084335 1.020949 1.760360 1.149831 1.632027 1.385248 0.366955 1.832462 0.180804 1.692636 -0.414002 0.612653 1.437265 1.137462 0.624650 -0.136679 0.250062 0.624539 1.491982 0.095878 0.093040 1.434895 0.085551 -0.378955 1.234204 1.596445 1.429517 0.222645 0.333987 1.839006 0.657096 1.065450 0.250774 0.983086 0.112323 0.508278 0.547977 1.168959 -0.132545 0.478827 1.595884 0.393468 1.864859 1.026898 1.387429 0.023517 0.958078 1.170965 1.334934 1.449087 1.064559 0.072973 1.291263 1.652574 0.465043 1.500197 1.171451 1.206297 0.731786 0.208154 1.383720 0.213707 0.459758 1.161261 0.218672 1.655509 0.258098 0.978042 0.989461 1.073881 -0.281420 -0.408393 1.590485 0.387463 0.612704 -0.165240 1.181051 0.980617)
+ 12.022848 (fv 0.000000 0.304537 1.829033 1.070382 1.207038 0.596236 0.255424 0.517237 0.518037 0.555724 0.263998 -0.092809 0.086181 1.031798 1.764620 1.155127 1.629595 1.381762 0.374989 1.817825 0.178145 1.717460 -0.421617 0.620765 1.435692 1.136975 0.618586 -0.142602 0.257261 0.632270 1.492625 0.098530 0.089288 1.438957 0.096419 -0.388671 1.239417 1.591519 1.418382 0.224847 0.327382 1.847389 0.645292 1.057386 0.245292 0.974759 0.113802 0.520412 0.536708 1.166960 -0.123664 0.466667 1.597708 0.387840 1.876598 1.035063 1.402503 0.035393 0.945965 1.170137 1.338358 1.449697 1.072439 0.060883 1.296995 1.652836 0.462073 1.502645 1.166005 1.209720 0.739421 0.202107 1.382598 0.210680 0.451167 1.145693 0.222332 1.637533 0.245553 0.987799 0.980876 1.068255 -0.276826 -0.417000 1.573560 0.382232 0.604329 -0.155944 1.170763 0.979682)
)
;;; 91 prime --------------------------------------------------------------------------------
-#(91 15.264 #(0 1 0 0 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 0)
- 14.775403022766 #(0 1 1 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0)
- 14.702056847646 #(0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0)
+(vector 91 14.702056847646 (fv 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0)
- 12.140937 #(0.000000 1.675637 0.556936 0.722801 1.537750 1.102042 -0.101595 1.093430 0.859314 1.845520 1.153653 1.203117 0.545401 1.605492 1.579123 0.935294 1.203294 1.190764 1.913162 -0.167613 1.662427 1.225566 1.464258 0.620130 0.946055 0.717518 1.771356 1.681314 1.390305 1.330900 0.989573 0.506966 0.358756 0.616890 0.376823 1.414459 1.783218 1.998480 0.564997 0.540991 -0.206921 -0.066330 0.464449 0.521847 0.862740 0.160054 1.549876 1.123659 0.020943 0.715485 1.052752 0.907390 0.557759 -1.732856 0.759478 1.432685 0.411679 0.497931 1.439196 1.777727 0.570633 0.389619 1.754496 0.220457 -0.062797 1.429251 0.984243 1.847929 0.697350 1.433481 0.372915 1.546867 0.492308 0.677237 0.456393 0.963191 1.618683 0.943611 1.650744 0.603497 -0.290939 1.085362 1.760990 0.353691 0.337993 0.565781 0.619287 0.758779 1.405625 -0.042191 0.588157)
+ 12.084424 (fv 0.000000 1.661963 0.526933 0.737897 1.547408 1.147810 -0.075617 1.067829 0.852458 1.831985 1.111705 1.210703 0.536594 1.562730 1.564495 0.931257 1.183443 1.206159 1.917460 -0.142965 1.673803 1.211553 1.446589 0.613092 0.971147 0.710033 1.752892 1.683084 1.418254 1.337958 1.028503 0.530465 0.358051 0.607198 0.374767 1.422247 1.801820 -0.023693 0.571429 0.547868 -0.171993 -0.069230 0.452658 0.503964 0.822577 0.139237 1.564879 1.109027 0.054201 0.693725 1.047747 0.930670 0.524559 -1.746051 0.764531 1.459015 0.440040 0.505370 1.433135 1.753190 0.597210 0.403986 1.752023 0.224587 -0.006227 1.424459 1.006632 1.837329 0.717913 1.423544 0.374217 1.561701 0.508321 0.662754 0.466739 0.959175 1.632864 0.950048 1.612332 0.591280 -0.303047 1.088472 1.746777 0.350796 0.275475 0.538357 0.642430 0.726819 1.423969 -0.019252 0.614624)
)
;;; 92 prime --------------------------------------------------------------------------------
-#(92 15.373 #(0 0 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 0 0 1 0 1 0)
- 15.307026596891 #(0 0 1 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 0 0 1 0 1 0)
- 14.9424 #(0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0)
- 14.556435035882 #(0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0)
+(vector 92 14.556435035882 (fv 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0)
- 12.141851 #(0.000000 1.121198 1.201412 1.172799 1.560695 1.384888 0.366891 0.100992 1.214134 0.685191 1.715398 0.263864 0.739539 0.904388 1.368889 0.162079 0.589299 -0.573953 0.239212 0.085376 1.758536 0.391799 0.366297 1.244129 1.815285 0.735110 -0.475557 0.929837 1.525316 0.279250 0.608201 0.848886 1.028605 1.751215 1.129120 1.837977 0.169354 1.143834 0.661673 1.345096 0.564421 0.277411 0.521904 0.007856 1.504775 1.114595 0.792291 1.810361 0.616573 1.305179 1.764878 0.755815 1.536039 1.639054 1.293341 -0.210534 1.323024 0.204279 0.023842 0.642820 0.594812 0.912000 1.365883 1.320485 0.793420 1.526837 0.198702 1.309137 1.121319 1.660995 0.583889 1.441301 1.305016 -0.151122 1.419087 1.230631 0.871749 1.516779 1.059649 1.942992 -0.426053 1.204009 1.293575 1.522746 0.451092 0.666441 0.670381 0.493277 0.180453 0.948556 0.721554 1.126959)
+ 12.111629 (fv 0.000000 1.123677 1.203180 1.174948 1.560019 1.384341 0.367155 0.099459 1.212291 0.682305 1.716557 0.261123 0.730999 0.903465 1.369526 0.155486 0.590372 -0.569988 0.244209 0.083007 1.764474 0.389454 0.365639 1.245993 1.816418 0.730704 -0.475666 0.929928 1.528963 0.279291 0.611191 0.845099 1.029972 1.753120 1.126371 1.838017 0.163977 1.146545 0.659479 1.341785 0.566953 0.273863 0.527929 0.012905 1.508411 1.113794 0.790470 1.810888 0.619444 1.306005 1.764955 0.757522 1.532832 1.638004 1.292139 -0.220293 1.326791 0.207925 0.021426 0.636407 0.595067 0.920176 1.364542 1.317600 0.792553 1.523336 0.199497 1.310295 1.126679 1.660906 0.580494 1.441629 1.307014 -0.149187 1.422606 1.228427 0.874268 1.519111 1.056591 1.949465 -0.426058 1.208008 1.301151 1.521711 0.452094 0.671757 0.665097 0.498102 0.181724 0.953835 0.725167 1.124133)
)
;;; 93 prime --------------------------------------------------------------------------------
-#(93 15.814494404587 #(0 1 0 1 0 0 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1)
- 15.072628413546 #(0 1 0 0 0 0 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 0 1)
- 14.994668960571 #(0 1 0 1 0 0 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1)
+(vector 93 14.994668960571 (fv 0 1 0 1 0 0 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1)
- 12.337404 #(0.000000 0.199384 1.181377 -0.024201 1.227004 -0.403155 0.169069 1.313374 1.060209 1.370587 -0.472300 0.051421 1.826699 -0.225250 1.794290 0.175834 0.028609 1.765806 -0.022243 0.925196 1.319256 1.348912 0.657206 1.020842 0.555558 1.678848 0.119727 0.153961 0.786704 0.313300 1.908285 1.380447 0.486861 0.160738 1.547509 1.177377 0.671014 -0.176467 1.804170 1.892509 1.067006 1.154363 0.248271 0.425839 1.568068 0.283129 0.861417 -0.338481 0.531323 1.450852 0.605369 0.122250 1.130971 1.186536 1.043222 1.153011 1.486659 0.326059 0.200310 0.376428 0.906821 0.388816 0.780658 0.245514 0.355496 0.697785 1.371467 1.169400 1.188143 0.531176 0.008649 1.692664 0.426262 -0.331185 0.225082 0.479572 -0.022528 0.821096 0.182126 1.393369 0.214279 0.952509 1.779789 0.476901 0.371565 0.018437 1.507141 0.676888 -0.004655 1.098034 1.472915 0.136016 1.154457)
+ 12.323397 (fv 0.000000 0.199963 1.180724 -0.024343 1.226375 -0.402136 0.168523 1.313836 1.060714 1.370552 -0.471865 0.051393 1.826180 -0.226097 1.794079 0.176177 0.029279 1.765656 -0.022993 0.924413 1.319281 1.348871 0.657083 1.021102 0.556079 1.679658 0.119278 0.154784 0.786857 0.314106 1.909349 1.379970 0.486239 0.159940 1.547391 1.177792 0.671257 -0.176460 1.805002 1.892101 1.067471 1.153719 0.249337 0.426943 1.568658 0.284044 0.861446 -0.338286 0.531428 1.450755 0.605670 0.121121 1.131478 1.187561 1.041801 1.153378 1.486202 0.325760 0.201023 0.376157 0.907130 0.389618 0.779509 0.246617 0.355275 0.698575 1.371835 1.170196 1.188933 0.531048 0.008203 1.693556 0.426031 -0.330917 0.226068 0.478929 -0.022448 0.820583 0.181321 1.394112 0.214726 0.952096 1.780527 0.477402 0.370644 0.018381 1.506735 0.676340 -0.005190 1.098917 1.472044 0.136836 1.154585)
+
+ ;; 92+1
+ 11.941773 (fv 0.000000 1.137688 1.089778 1.068356 1.532544 1.432457 0.360804 -0.026160 1.251592 0.723161 1.753475 0.321792 0.652597 0.831785 1.248203 0.098788 0.605754 -0.620144 0.303325 -0.047105 1.719165 0.369582 0.426774 1.169373 1.859324 0.741230 -0.571365 0.881904 1.545056 0.328084 0.606744 0.850606 0.996606 1.766597 1.046556 1.767688 0.237622 1.228793 0.632423 1.337245 0.542894 0.162245 0.534219 0.069759 1.516061 1.102446 0.948393 1.619738 0.549855 1.379503 1.785272 0.859611 1.503940 1.656139 1.246212 -0.223489 1.412206 0.325338 0.101699 0.705391 0.747074 0.979316 1.385520 1.241306 0.625921 1.535144 0.140376 1.223617 1.154594 1.635856 0.580110 1.431599 1.354268 -0.085341 1.513604 1.083083 0.960280 1.481804 1.049034 1.936911 -0.305123 1.144650 1.328494 1.401780 0.463677 0.612788 0.648525 0.589928 0.274669 0.913704 0.769534 1.048236 -0.031107)
)
;;; 94 prime --------------------------------------------------------------------------------
-#(94 15.835750579834 #(0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1)
- 15.441287870957 #(0 0 0 1 0 0 1 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 1 1 1 0 0 0 1 0 0 0 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0)
- 14.811392756555 #(0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0)
+(vector 94 14.811392756555 (fv 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0)
+
+ 12.372284 (fv 0.000000 0.443961 0.975468 0.665627 0.603420 0.053131 0.306985 1.398862 1.315822 1.027281 0.141353 0.068859 0.515109 1.551710 0.559483 1.154898 1.062171 1.088212 0.844250 0.492324 -0.085203 0.372997 1.377703 1.412362 1.590941 0.015253 -0.053671 1.084827 1.672259 1.823973 0.424632 1.792989 0.693404 1.273404 0.373397 1.282394 -0.222604 0.823730 1.821435 0.830056 0.905326 1.119027 0.338679 0.323132 1.572257 1.693368 1.617589 1.262068 1.377617 -0.071238 1.120960 0.924011 0.108375 0.409469 0.705856 1.358638 1.649735 1.159074 1.592832 0.679108 1.663652 1.223795 0.200633 -0.160917 1.201748 0.776569 0.821633 0.259058 0.902729 0.178012 1.711364 0.349704 0.758303 0.750335 0.936872 0.168192 0.485748 0.828259 1.367780 0.601135 0.970970 1.052074 1.846930 -0.031412 0.332694 1.027172 1.579686 0.520946 0.479472 0.979137 -0.124751 1.022187 0.809346 1.384445)
- 12.390444 #(0.000000 0.442594 0.976331 0.665786 0.603271 0.053090 0.307472 1.400762 1.315767 1.028388 0.140848 0.068513 0.514072 1.552009 0.559794 1.155607 1.063025 1.087988 0.844444 0.492913 -0.084585 0.372774 1.378553 1.412319 1.589283 0.014867 -0.053914 1.084161 1.672222 1.822407 0.424558 1.793698 0.692495 1.272472 0.373964 1.282636 -0.222864 0.823800 1.822201 0.830869 0.904326 1.119723 0.338690 0.321497 1.571716 1.692835 1.616048 1.262347 1.377880 -0.070761 1.120098 0.924538 0.108561 0.411256 0.707004 1.358717 1.649817 1.159219 1.592920 0.679336 1.663815 1.224789 0.200280 -0.161522 1.202020 0.776333 0.822358 0.260550 0.902405 0.176986 1.710782 0.350666 0.757147 0.751023 0.936938 0.167598 0.485449 0.827380 1.368715 0.601831 0.971363 1.053001 1.848008 -0.031544 0.333229 1.027316 1.579397 0.520231 0.479392 0.980362 -0.124839 1.021181 0.808933 1.385417)
+ ;; 93+1
+ 12.114932 (fv 0.000000 1.123175 1.150884 1.058343 1.465121 1.413282 0.350764 0.114071 1.226428 0.791079 1.790932 0.440109 0.565381 0.734544 1.327723 -0.001005 0.566798 -0.729477 0.316829 -0.017120 1.801895 0.389351 0.381914 1.198959 1.820572 0.721571 -0.570163 0.955754 1.536499 0.370558 0.593528 0.885066 1.037479 1.768525 1.105455 1.756351 0.226836 1.186245 0.651550 1.384674 0.494435 0.218370 0.473389 0.034709 1.487137 1.083964 0.911945 1.641974 0.559886 1.326260 1.842092 0.870886 1.399307 1.629693 1.284916 -0.226560 1.347506 0.289919 0.059989 0.740638 0.739763 0.950849 1.395859 1.190558 0.656884 1.519451 0.124394 1.191107 1.225318 1.686413 0.517977 1.395642 1.256343 -0.098747 1.532037 1.044403 0.978522 1.573287 0.994934 1.946711 -0.367453 1.259056 1.292220 1.531327 0.451283 0.592779 0.641359 0.711046 0.198007 0.990565 0.746192 1.039960 -0.062670 0.073205)
)
;;; 95 prime --------------------------------------------------------------------------------
-#(95 15.827 #(0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 1 0 1 1 1 1 0 0)
- 15.616318215916 #(0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 1 0 1 1 1 1 0 0)
- 15.240 #(0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1)
+(vector 95 15.240 (fv 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1)
- 12.529885 #(0.000000 0.319726 0.928447 0.596767 1.400966 1.608830 1.678257 1.495841 1.311137 0.166949 1.219402 -0.277171 1.090318 1.092388 0.631312 0.916853 0.658056 1.542609 1.745327 1.491867 1.234130 0.111923 0.951445 -0.237997 0.460762 0.811826 -0.022617 0.514596 0.904374 0.470288 0.046299 0.051102 0.386478 0.905559 0.759275 0.091168 0.961182 1.148167 0.606507 0.258695 1.310909 1.707735 1.852806 0.401394 0.218873 0.510027 1.428304 0.217571 0.136098 1.850982 0.416453 0.135016 0.082067 1.037895 1.391993 0.282431 0.893363 0.782324 0.768860 1.749139 0.946180 0.521544 0.707496 0.379754 1.364095 0.382853 0.045558 1.898122 -0.116785 0.478985 -0.141602 0.628846 1.443079 1.081334 1.727293 1.352621 0.661117 0.276638 0.185748 0.103010 0.260213 0.845885 0.746100 1.872219 0.251233 1.363338 0.641421 1.156801 0.383531 0.928301 0.022644 0.828703 -0.173532 1.861384 0.783885)
+ 12.459772 (fv 0.000000 0.308397 0.934622 0.587781 1.397996 1.615701 1.668964 1.492915 1.308563 0.159020 1.213403 -0.279408 1.096006 1.085558 0.623876 0.907176 0.667480 1.557434 1.743106 1.498468 1.233171 0.109361 0.947947 -0.262447 0.459131 0.819588 -0.021230 0.492364 0.906782 0.461816 0.056526 0.050587 0.383393 0.910532 0.762726 0.098762 0.955132 1.150421 0.604248 0.259751 1.309549 1.704622 1.855016 0.399458 0.217387 0.513436 1.433314 0.218651 0.133592 1.857292 0.423016 0.136928 0.083580 1.034506 1.391713 0.293770 0.897050 0.785540 0.765384 1.736279 0.958030 0.524446 0.709466 0.374572 1.361583 0.387916 0.039566 1.900932 -0.119192 0.460590 -0.150181 0.605728 1.448737 1.077599 1.714282 1.351134 0.667262 0.278426 0.183437 0.118876 0.258415 0.843668 0.748044 1.868376 0.252888 1.363041 0.638212 1.171836 0.388947 0.935784 0.020120 0.828215 -0.177354 1.862097 0.788220)
+
+ ;; 94+1
+ 12.114676 (fv 0.000000 1.049345 1.220803 1.147373 1.381621 1.355515 0.454825 -0.009436 1.057569 0.663900 1.874811 0.433507 0.556807 0.623352 1.242792 0.067786 0.465225 -0.661340 0.331985 0.032227 1.933091 0.432343 0.547379 1.107124 1.846431 0.517946 -0.547570 0.897607 1.611921 0.403112 0.647511 0.899598 0.890804 1.716130 0.996200 1.713540 0.243854 1.180551 0.688999 1.559934 0.583466 0.197293 0.600073 0.000101 1.458490 0.994760 0.956495 1.648139 0.660393 1.228976 1.774516 0.893844 1.390831 1.720570 1.135089 -0.091470 1.277862 0.255881 0.036343 0.799886 0.761090 0.891306 1.295964 1.096543 0.475861 1.537136 0.091181 1.218377 1.140426 1.690539 0.527790 1.400945 1.266740 -0.072678 1.541904 1.035302 1.038433 1.493972 1.075712 0.036991 -0.268077 1.190854 1.324282 1.468048 0.376266 0.545926 0.611626 0.692246 0.190910 0.902204 0.677044 1.063647 0.021187 0.238133 0.189775)
)
;;; 96 prime --------------------------------------------------------------------------------
-#(96 16.039880627473 #(0 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 1 0 1)
- 15.648203810823 #(0 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 1 1 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 1 0 1)
- 15.281 #(0 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 0)
- 15.135 #(0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 0)
+(vector 96 15.135 (fv 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 0)
+
+ 12.492843 (fv 0.000000 0.873070 1.523025 1.689063 1.621286 0.209607 1.316613 0.108148 0.756280 0.640008 0.419483 0.710721 0.117557 0.928853 0.153806 1.300975 1.239985 1.289571 0.156284 0.662086 0.349173 1.208328 1.779199 0.633972 1.299682 1.009543 0.022986 0.835814 1.094725 0.331638 0.023179 0.982537 0.733828 1.430422 0.013874 0.572853 1.429326 1.360223 0.715744 1.266448 0.151948 -0.250137 0.209445 1.031335 1.611402 0.877878 0.362241 0.304460 0.144893 0.651630 1.742329 -0.323477 0.366805 -0.060410 1.858308 0.038329 0.825659 1.544770 1.420995 1.255395 1.068254 0.786905 1.057541 1.015027 0.909813 1.295370 1.205379 0.957770 1.601794 1.221780 -0.114116 0.749254 1.369402 1.509613 0.642078 1.929687 1.163562 0.908511 0.510199 1.519292 0.122002 1.225494 0.717297 1.501496 1.345341 1.759811 1.056238 0.842883 0.086174 -0.090366 1.445692 1.226504 0.003120 1.148302 0.440021 0.622101)
- 12.685808 #(0.000000 0.918485 1.444343 1.648494 1.625981 0.216414 1.342281 0.083546 0.768970 0.698938 0.475053 0.737494 0.166339 0.947695 0.045431 1.284369 1.274367 1.281271 0.187812 0.557575 0.318671 1.195787 1.823589 0.655990 1.305567 1.077181 0.065454 0.817166 1.078464 0.397055 -0.016906 0.961404 0.786945 1.429327 -0.005004 0.519478 1.431263 1.371868 0.718664 1.296270 0.106425 -0.231837 0.232013 1.032390 1.641638 0.928077 0.422283 0.221489 0.127532 0.745692 1.664075 -0.327806 0.398346 -0.073195 1.850746 0.035544 0.749915 1.523682 1.392816 1.286349 1.078505 0.843798 1.052646 1.027226 0.909294 1.370098 1.220471 0.990788 1.637283 1.259014 -0.081246 0.728338 1.402327 1.507202 0.627020 1.889555 1.222943 0.906067 0.531345 1.520333 0.082474 1.269427 0.646996 1.482113 1.319853 1.748941 1.135501 0.847369 0.082451 -0.145109 1.447633 1.254109 -0.015216 1.134975 0.345034 0.664570)
+ ;; 95+1:
+ 12.292710 (fv 0.000000 0.988646 1.162429 1.171314 1.353255 1.405759 0.327802 0.036207 1.152154 0.760541 1.790856 0.433527 0.499858 0.656756 1.296573 0.100791 0.476489 -0.653216 0.158372 -0.037710 1.892726 0.409386 0.436140 1.049351 1.766476 0.708019 -0.505881 0.843836 1.661627 0.229932 0.569810 0.855526 0.889991 1.754840 1.079009 1.690629 0.282542 1.176826 0.695771 1.456983 0.462708 0.168189 0.469857 -0.027597 1.521311 1.099282 0.982686 1.576751 0.669770 1.287335 1.818933 0.859497 1.442403 1.798895 1.290873 -0.254434 1.216440 0.266504 0.064071 0.816920 0.860902 0.922870 1.417663 1.159681 0.595958 1.424400 0.223626 1.172296 1.139585 1.606147 0.520047 1.392856 1.257846 -0.113917 1.518583 1.050121 0.979442 1.573289 0.984941 0.063610 -0.290095 1.277068 1.272139 1.596596 0.361931 0.600022 0.601776 0.740696 0.153344 0.997841 0.670149 1.019583 -0.020870 0.222109 0.072606 -0.120463)
)
;;; 97 prime --------------------------------------------------------------------------------
-#(97 15.972457232959 #(0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0)
- 15.726 #(0 1 1 0 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 1 0)
- 15.685384750366 #(0 0 0 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1)
- 15.404807595571 #(0 0 0 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1)
+(vector 97 15.404807595571 (fv 0 0 0 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1)
- 12.663922 #(0.000000 1.283291 0.143485 0.559129 0.269228 0.648351 0.365881 0.483416 -0.164756 0.662386 1.291055 0.500967 0.278099 0.770276 1.749460 1.048715 1.486918 0.485090 1.698182 1.397294 0.328347 1.029636 0.190258 0.303577 0.735844 0.786469 0.491363 1.589700 0.464678 1.367751 1.285712 0.783406 1.324388 0.012579 1.550058 1.674419 1.428239 1.693432 0.244501 1.012744 1.433374 -0.193849 0.020189 0.382702 0.793503 1.037773 1.665497 1.925675 0.560528 0.585410 0.410602 0.420380 1.146739 0.579276 0.029936 -0.199569 -0.157162 1.355200 1.605930 0.733425 1.893717 0.753971 1.679831 1.296223 0.616546 1.808955 0.365501 0.224842 0.881599 0.429574 0.567183 -0.064126 1.465958 0.879943 0.121063 1.514034 0.840775 0.047981 0.200513 0.282768 1.117741 -0.247020 0.445125 1.590617 -0.094152 1.247824 1.652771 0.603675 1.723602 0.820386 0.701964 -0.054795 0.177899 1.437498 0.769815 0.742672 0.965893)
+ 12.614880 (fv 0.000000 1.284279 0.149066 0.562607 0.268625 0.641221 0.361525 0.485960 -0.169882 0.664945 1.289316 0.500133 0.276653 0.768466 1.755836 1.046199 1.488691 0.489610 1.701223 1.395902 0.323258 1.026098 0.187307 0.308257 0.739745 0.789576 0.492878 1.589801 0.464866 1.368873 1.280528 0.783754 1.321490 0.013196 1.554947 1.672951 1.438390 1.698792 0.240337 1.015821 1.431743 -0.194791 0.030419 0.391715 0.797023 1.035054 1.666367 1.927621 0.564941 0.590092 0.408995 0.415222 1.147686 0.588418 0.024767 -0.204650 -0.157255 1.351342 1.609704 0.733349 1.898358 0.761937 1.674424 1.298247 0.616295 1.801868 0.366757 0.227606 0.881755 0.435048 0.566914 -0.068726 1.464351 0.867461 0.114711 1.507714 0.831540 0.049432 0.189086 0.282295 1.125245 -0.244779 0.442202 1.591355 -0.090711 1.248227 1.649885 0.616280 1.727109 0.815894 0.698498 -0.049477 0.179382 1.436511 0.773196 0.738555 0.962998)
+
+ ;; 96+1
+ 12.398175 (fv 0.000000 0.974270 1.133417 1.101751 1.279979 1.359434 0.467927 0.007144 1.127487 0.748820 1.781756 0.396487 0.493733 0.688975 1.203401 0.019970 0.359263 -0.697201 0.166440 -0.073865 1.841340 0.479438 0.471569 1.120468 1.818011 0.722611 -0.578854 0.797365 1.619794 0.192675 0.470320 0.880530 0.894647 1.773867 1.129911 1.684306 0.298114 1.192448 0.753562 1.463120 0.415850 0.230519 0.523840 -0.047429 1.497367 1.045637 0.968082 1.645436 0.623475 1.314407 1.792633 0.841218 1.383624 1.923347 1.362714 -0.210443 1.197651 0.311815 0.117464 0.802332 0.840490 0.962756 1.351153 1.154240 0.658169 1.483444 0.257624 1.139948 1.196778 1.594898 0.489729 1.391360 1.298495 -0.114146 1.474319 1.038981 0.962592 1.548377 0.947581 0.030073 -0.290725 1.335845 1.310097 1.567936 0.325931 0.520450 0.493969 0.704044 0.140441 0.974535 0.754580 0.981153 0.043144 0.213245 0.187923 -0.104791 0.154449)
)
;;; 98 prime --------------------------------------------------------------------------------
-#(98 16.082024156883 #(0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)
- 15.695913722267 #(0 0 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)
- 15.435913738557 #(0 0 0 0 1 1 1 0 1 1 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0)
+(vector 98 15.435913738557 (fv 0 0 0 0 1 1 1 0 1 1 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0)
+
+ 12.753270 (fv 0.000000 0.786132 0.095307 1.867898 0.883791 1.021595 1.308123 1.131908 0.540702 0.504302 1.434468 1.493630 0.417411 0.284692 1.504062 1.429716 1.676581 -0.039254 0.683934 0.973509 0.648393 1.434613 -0.061544 1.814076 0.647769 0.683085 1.793781 0.237679 0.776690 1.663998 0.170625 1.433546 1.041819 1.122171 1.897558 1.320541 0.723949 1.237497 0.689348 1.846291 1.246028 1.446201 0.606616 1.671663 1.464134 0.585342 0.644021 0.435796 0.213425 1.357738 1.586232 1.545703 0.819890 1.367545 0.012567 0.450279 0.655234 0.788890 0.591992 0.545966 1.254900 0.392933 1.583204 0.076358 1.856160 0.823271 1.021281 1.623051 1.585893 1.245898 0.683755 0.476818 1.035792 1.047834 -0.069790 -0.004312 -0.361114 1.398618 1.383822 0.421997 1.705664 0.029556 -0.066198 0.051203 1.722364 1.322079 1.292928 1.662147 -0.016256 1.310728 1.707597 1.375469 1.546348 1.943030 -0.036451 0.558144 -0.266574 0.833410)
+
+ ;; 99-1
+ 12.622612 (fv 0.000000 1.601197 0.675735 0.824937 1.585712 1.856247 0.097348 -0.128093 1.025651 0.480455 0.954279 0.347491 0.626587 0.694458 0.898162 1.272532 0.684634 1.137767 1.643934 1.521275 1.047103 0.680901 1.232138 0.886175 0.603433 0.065324 -0.003442 1.143022 1.262279 1.001078 1.502240 1.539684 0.387527 -0.240796 0.914257 1.021072 0.830135 0.895349 0.823768 1.454208 -0.127486 1.570891 0.443883 0.892431 1.170381 1.366309 0.941425 0.702939 0.571855 0.280140 1.656638 0.472320 0.260055 1.153301 0.949715 0.148316 1.066487 0.427830 0.818544 -0.167385 0.411934 0.330689 0.887299 0.734213 1.728731 0.063612 0.466751 0.013162 -0.447231 0.444351 1.131814 0.061263 1.074639 0.944421 1.055502 -0.026068 1.648026 1.034453 1.399998 0.887501 0.104617 0.511260 1.435502 0.677269 0.344898 0.942483 -0.009809 0.923335 0.650809 -0.003419 1.067454 1.910756 0.250458 1.576481 0.901923 1.611933 1.145031 0.515175)
- 12.920009 #(0.000000 0.780724 0.072285 1.879109 0.914824 1.031238 1.322917 1.116298 0.521410 0.501393 1.418600 1.475592 0.415604 0.285310 1.526943 1.437520 1.724809 -0.033614 0.693664 0.968432 0.668306 1.432173 -0.065941 1.844704 0.628304 0.707376 1.800117 0.230472 0.772220 1.652030 0.170660 1.413147 1.039560 1.114424 1.893301 1.313182 0.734786 1.229510 0.694653 1.844838 1.220594 1.472522 0.604106 1.653771 1.503335 0.607774 0.656798 0.388777 0.205190 1.335879 1.588721 1.512304 0.779080 1.363697 0.032851 0.457428 0.673004 0.808769 0.593122 0.542570 1.233264 0.382824 1.574795 0.069819 1.839077 0.841527 1.039673 1.649768 1.575981 1.258162 0.680541 0.488652 1.036527 1.043171 -0.079358 0.009302 -0.347052 1.408300 1.405462 0.427786 1.719593 0.030885 -0.086379 0.053218 1.726006 1.312740 1.278484 1.669201 -0.005445 1.291528 1.691889 1.372113 1.574334 1.952357 -0.056118 0.563055 -0.272517 0.855187)
+ ;; 97+1
+ 12.554819 (fv 0.000000 0.994754 1.201978 1.095875 1.228090 1.349063 0.520404 -0.005278 1.113744 0.684830 1.821835 0.418458 0.556811 0.671609 1.340860 -0.027127 0.490888 -0.669559 0.196112 -0.069433 1.791636 0.479800 0.480819 1.161113 1.931188 0.706820 -0.575437 0.825517 1.635684 0.154310 0.437054 0.834616 0.805687 1.760916 1.041481 1.654400 0.268843 1.252679 0.716018 1.507696 0.427453 0.212559 0.610822 -0.045110 1.474585 1.069280 0.938458 1.658424 0.606033 1.274272 1.871557 0.851412 1.378375 1.849718 1.305539 -0.196977 1.250436 0.271972 0.159635 0.861188 0.835566 1.009947 1.382413 1.136755 0.601730 1.508016 0.177040 1.096731 1.112114 1.556213 0.514409 1.424495 1.306796 -0.096547 1.551938 0.983953 0.982538 1.547826 0.947292 0.070780 -0.301979 1.274952 1.268078 1.506608 0.343339 0.539960 0.515360 0.716545 0.138903 1.075775 0.830359 1.045994 0.028008 0.165284 0.183640 -0.064893 0.128193 -0.025514)
)
;;; 99 prime --------------------------------------------------------------------------------
-#(99 16.078 #(0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0)
- 15.391923904419 #(0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0)
+(vector 99 15.391923904419 (fv 0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0)
- 13.112740 #(0.000000 1.572886 0.651212 0.615805 1.622963 1.793377 0.219923 -0.018584 0.926994 0.587290 1.131746 0.255840 0.625573 0.762161 0.820785 1.324349 0.663748 1.135383 1.530035 1.615875 1.188125 0.756840 1.180285 0.960877 0.729822 1.906374 -0.005391 1.106385 1.196990 0.965892 1.469743 1.621266 0.314843 -0.082757 0.810994 0.990722 0.998657 0.874742 0.841285 1.201590 -0.059749 1.590031 0.623880 1.015537 1.318255 1.366509 1.064663 0.641130 0.548639 0.171830 1.670925 0.575619 0.450674 1.053840 1.089036 0.109701 1.049762 0.479399 0.819379 0.001624 0.424918 0.270882 0.874244 0.665857 1.824856 0.066880 0.351158 -0.076541 -0.507873 0.585054 1.298877 0.113009 1.026545 0.835555 1.156129 0.057661 1.509212 0.984885 1.339898 0.925960 0.050792 0.433338 1.353188 0.443096 0.370285 1.189794 -0.032233 0.728644 0.649831 -0.046726 1.062259 1.890764 0.303223 1.561366 0.861605 1.592479 1.044818 0.485877 1.097977)
+ ;; started at 13.08
+ 12.671121 (fv 0.000000 1.578825 0.666211 0.726552 1.538384 1.791570 0.099320 -0.160491 0.989473 0.596822 1.035192 0.247178 0.628445 0.721303 0.845175 1.341449 0.627742 1.157974 1.573300 1.577559 1.146243 0.642518 1.253235 0.873141 0.677674 1.983841 -0.058813 1.145842 1.258749 1.002052 1.540728 1.596826 0.319265 -0.110992 0.873225 1.001714 0.958663 0.883044 0.804615 1.392171 -0.105346 1.566142 0.586138 0.950489 1.209868 1.332589 1.087730 0.608633 0.545623 0.189852 1.681493 0.487350 0.405093 1.121113 0.988264 0.089589 1.002114 0.406924 0.857351 -0.106561 0.434389 0.315978 0.874454 0.677274 1.738995 0.126523 0.418419 -0.034288 -0.514474 0.544729 1.186629 0.091214 1.023974 0.889868 1.105258 -0.014030 1.568529 1.019817 1.384214 0.868550 0.027819 0.525808 1.447056 0.636493 0.394992 1.091277 -0.079518 0.886075 0.569418 -0.004838 1.104104 1.810908 0.227707 1.565455 0.923044 1.560572 1.031354 0.513130 1.131259)
)
;;; 100 prime --------------------------------------------------------------------------------
-#(100 16.360503791276 #(0 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0)
- 15.909478013087 #(0 0 1 1 1 0 0 0 0 1 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 0 0)
- 15.637986183167 #(0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1)
+(vector 100 15.637986183167 (fv 0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 1)
- 13.135183 #(0.000000 1.374837 1.374829 1.611683 1.544843 0.396434 1.472161 0.888963 0.903770 0.459149 0.142110 1.549539 1.109125 0.820282 0.284681 1.431269 0.372312 -0.228272 1.134077 0.056742 1.250369 0.557683 0.330404 0.746754 0.454225 -0.371117 -0.019940 0.360427 1.409535 0.594402 0.887728 1.236220 -0.011921 1.429613 1.294785 0.020685 1.378524 1.290039 1.169123 0.044040 0.117580 0.526762 0.360124 1.140298 1.629003 1.016003 0.001804 0.887569 1.374780 0.048554 1.544732 1.625867 0.860390 0.174492 0.533968 1.025572 0.793713 1.719937 1.923518 1.280928 1.674841 -0.019943 -0.231820 1.260677 1.668630 1.084704 1.681448 1.274089 0.462844 1.353626 0.102441 1.719817 0.412322 1.444400 1.573151 1.979199 1.001916 1.206977 -0.170962 0.052517 1.486101 0.666011 1.062891 0.572224 1.264708 1.520966 0.612227 0.698692 1.545244 1.922039 0.990114 0.980895 1.777629 1.691310 0.622807 0.351285 0.706302 0.145526 1.622930 1.238672)
+ 12.957637 (fv 0.000000 1.386453 1.370643 1.628038 1.538390 0.424621 1.485227 0.897618 0.907971 0.449160 0.163275 1.571834 1.093156 0.838120 0.247905 1.436852 0.372882 -0.220773 1.118451 0.054878 1.267282 0.565411 0.289581 0.731340 0.458703 -0.367224 -0.030109 0.334428 1.397987 0.598724 0.901920 1.214518 -0.004754 1.438150 1.307411 0.016366 1.337284 1.304934 1.171963 0.021267 0.117441 0.560545 0.340812 1.151463 1.666509 1.019303 -0.015114 0.880146 1.373879 0.049199 1.503584 1.604549 0.862952 0.189305 0.529694 1.029077 0.778339 1.706291 1.914727 1.273598 1.699313 -0.031345 -0.253493 1.258299 1.649412 1.077808 1.672514 1.251013 0.462905 1.384023 0.091088 1.738772 0.445974 1.424109 1.582876 1.988433 0.984011 1.200230 -0.169021 0.062775 1.511082 0.660711 1.089055 0.545793 1.273058 1.509833 0.626971 0.715771 1.564417 1.945654 0.972744 0.969507 1.754542 1.683747 0.602245 0.329311 0.710216 0.150434 1.629408 1.227167)
+
+ ;; 99+1
+ 12.716986 (fv 0.000000 1.614268 0.794652 0.719356 1.522693 1.839206 0.053187 -0.216045 1.077547 0.626072 0.992447 0.258424 0.613665 0.666154 0.797791 1.297151 0.666442 1.138663 1.568655 1.598721 1.081507 0.701607 1.189990 0.875992 0.670799 0.120588 0.002798 1.147193 1.214233 0.961367 1.487074 1.498267 0.315736 -0.163747 0.892348 0.853335 0.781180 0.904959 0.815695 1.365580 -0.161311 1.770543 0.467808 0.858870 1.202500 1.263259 1.179260 0.605694 0.567979 0.170780 1.783259 0.557899 0.419137 1.246376 1.015382 0.060732 1.143789 0.421313 0.784488 -0.191174 0.582308 0.326318 0.868037 0.700245 1.775099 0.084259 0.487674 0.052341 -0.505041 0.601192 1.234546 0.060079 0.970347 0.831571 1.221404 0.028687 1.689191 1.030841 1.384017 0.852184 0.054733 0.492124 1.493372 0.743678 0.351949 0.983070 -0.060785 0.924421 0.622513 0.041911 1.106639 1.715696 0.158455 1.595681 0.922989 1.564481 1.036395 0.544443 1.152503 -0.027178)
)
;;; 101 prime --------------------------------------------------------------------------------
-#(101 15.994265071036 #(0 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 1 0 1 1 0)
- 15.74836063385 #(0 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 0)
- 15.735968313601 #(0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1)
+(vector 101 15.735968313601 (fv 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1)
- 13.087541 #(0.000000 0.725023 -0.175586 1.541704 0.743036 0.123077 0.340263 1.650512 0.389357 0.074415 0.369641 1.510823 0.281594 1.802549 1.102516 1.575470 -0.241219 1.514429 0.364252 1.004434 0.755361 1.311136 0.291706 1.317619 1.674416 0.097075 0.470671 0.755831 -0.357503 -0.096814 0.066582 1.477968 0.702352 1.075301 0.550479 1.321686 0.990468 0.113492 0.581577 0.081164 1.957236 0.187961 1.293513 1.230644 0.727743 0.517961 0.253684 1.621928 1.567438 1.145516 0.490732 1.750442 0.062059 1.244463 0.033219 1.051954 0.437336 0.115934 0.381222 1.011917 0.786560 -0.011902 1.265648 0.201568 0.699125 -0.006315 0.615587 -0.326408 0.858615 1.215211 1.130905 0.063641 1.241924 0.012961 1.666596 0.917380 1.100841 1.233945 0.579405 1.698279 0.655161 0.053215 0.505527 1.262047 0.596679 0.815638 0.355453 0.352620 0.990850 0.584399 0.388695 0.174126 0.872981 0.123386 0.229772 0.496351 1.110639 0.927123 0.241478 0.463213 0.459464)
+ 12.909758 (fv 0.000000 0.720714 -0.182655 1.565457 0.753622 0.130143 0.334294 1.650697 0.417832 0.048827 0.344422 1.486401 0.292931 1.799521 1.111655 1.558792 -0.221559 1.531040 0.348578 0.973695 0.761485 1.268033 0.273978 1.313895 1.704221 0.068165 0.481602 0.743938 -0.351235 -0.099468 0.085867 1.467502 0.670175 1.060411 0.557784 1.309992 0.991970 0.107757 0.556296 0.077508 1.974081 0.189947 1.303789 1.238050 0.718111 0.534076 0.252095 1.598289 1.547761 1.182866 0.464613 1.755609 0.089102 1.246032 0.080260 1.036577 0.473927 0.107892 0.368036 0.986840 0.765140 -0.036059 1.290823 0.227451 0.726294 -0.006595 0.616819 -0.359117 0.861664 1.267742 1.139832 0.077396 1.257827 0.004277 1.664182 0.904514 1.106007 1.213475 0.580481 1.709443 0.640563 0.036194 0.492519 1.274675 0.574901 0.832654 0.371185 0.344722 0.998543 0.576680 0.369414 0.177252 0.865880 0.137875 0.239059 0.486022 1.121460 0.939339 0.230403 0.470154 0.464729)
+
+ ;; 102-1
+ 12.654378 (fv 0.000000 0.039802 1.217841 -0.018794 -0.264350 1.648606 -0.106572 1.436093 1.744759 1.197340 1.116039 0.322269 -0.319802 1.429760 1.337731 1.367755 1.294986 0.934427 1.178285 0.242928 0.397639 0.030160 0.470705 0.489509 0.721431 0.877160 0.586365 1.300090 0.056753 0.396042 0.694396 -0.123538 0.601882 1.828235 1.061453 1.208202 1.515734 1.300848 0.385739 1.295236 0.466727 1.125610 1.584167 0.360500 0.430768 1.515128 1.002486 1.429469 1.701067 0.146032 1.922601 1.668726 1.734188 0.898236 1.467655 0.751985 1.587598 0.572766 0.063367 1.242347 -0.141898 0.518327 1.188113 1.385035 1.498198 -0.400261 -0.058961 1.288706 1.366806 0.035365 1.606021 -0.052356 0.617357 0.512726 0.520602 1.405519 1.969640 -0.459289 0.438819 1.509996 1.047832 0.536024 0.230428 0.540739 1.290987 1.664498 0.615778 1.436029 1.298481 1.467348 0.158627 0.119363 1.098827 0.065055 0.380410 0.835569 0.455358 0.512707 1.391092 0.922515 1.335905)
)
;;; 102 prime --------------------------------------------------------------------------------
-#(102 16.342473246951 #(0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 0 1)
- 15.374809992584 #(0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1)
+(vector 102 15.374809992584 (fv 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1)
+
+ 13.125163 (fv 0.000000 0.284570 1.185932 0.254020 0.458026 1.777924 0.273972 0.352012 0.871247 1.673334 1.496604 0.270045 1.591827 -0.188397 0.589501 1.091682 1.741121 0.196787 0.525310 1.321393 1.205053 -0.057392 1.556520 -1.961535 1.179860 1.122770 0.814829 1.500056 -0.069946 0.070497 1.237530 1.280644 0.820936 1.402645 0.152660 1.210341 0.842206 0.369359 0.105608 0.811471 0.529059 0.041857 1.655756 0.893298 1.337926 1.496211 1.428234 0.556092 0.432069 0.925348 1.205854 1.544664 1.704644 1.229630 0.303212 1.758935 1.188278 1.467436 1.586279 1.260300 1.300112 1.011729 1.695629 1.060370 1.604385 0.957028 1.624378 0.311506 0.745336 0.578867 0.572336 1.655636 0.424967 1.250130 0.974803 1.251963 1.312562 0.463398 -0.038700 1.540879 0.156800 0.564982 0.689178 0.544052 1.778377 0.813450 0.561441 0.695184 0.270384 1.438063 0.744019 1.224468 0.148794 1.411742 1.416148 0.158444 1.282043 0.332184 1.434585 0.991269 -0.118131 -0.014118)
- 13.419883 #(0.000000 0.281257 1.196409 0.203186 0.436524 1.773570 0.299340 0.346874 0.862769 1.640219 1.491694 0.268479 1.586503 -0.184529 0.554425 1.109900 1.658770 0.227947 0.511661 1.320139 1.155874 -0.046300 1.561592 -1.936920 1.190788 1.178518 0.844439 1.546109 -0.043643 1.977375 1.235571 1.316999 0.808539 1.442575 0.162048 1.228843 0.807677 0.353237 0.157607 0.838921 0.486364 0.065612 1.640912 0.845205 1.343071 1.490638 1.455570 0.580745 0.483151 0.950994 1.251241 1.527061 1.696514 1.260144 0.309200 1.744307 1.156366 1.459148 1.553460 1.225834 1.280081 1.001025 1.667011 1.106580 1.602412 1.015511 1.572254 0.298117 0.742537 0.565539 0.538962 1.653251 0.415285 1.273270 0.959430 1.254964 1.339263 0.434000 0.016840 1.573352 0.141186 0.574750 0.741614 0.505077 1.792226 0.760377 0.566700 0.738988 0.258806 1.445856 0.722269 1.262778 0.142302 1.410200 1.413043 0.175547 1.249371 0.287089 1.412409 0.953307 -0.123315 0.027608)
+ ;; 103-1
+ 12.631141 (fv 0.000000 0.074843 1.219158 -0.027199 -0.254073 1.624605 -0.135701 1.453877 1.755897 1.198675 1.090421 0.272002 -0.249474 1.447439 1.360955 1.341148 1.290153 0.969167 1.135329 0.243792 0.418984 1.946250 0.601544 0.456951 0.765282 0.872982 0.576621 1.365615 0.094262 0.399525 0.677984 -0.086420 0.567433 1.780255 1.046981 1.205389 1.534885 1.234066 0.439028 1.336514 0.490354 1.104410 1.622676 0.382214 0.417306 1.496561 0.975909 1.398390 1.624475 0.141661 1.921427 1.688187 1.741843 0.901238 1.419496 0.813192 1.607447 0.585967 -0.020824 1.251511 -0.203691 0.513177 1.192285 1.326136 1.473869 -0.455142 -0.016589 1.259703 1.293519 0.048863 1.685391 -0.099881 0.662916 0.500247 0.557103 1.438861 1.941547 -0.474933 0.373608 1.542760 1.006189 0.593009 0.247793 0.539650 1.340923 1.675659 0.620550 1.469642 1.328665 1.442498 0.149610 0.049207 1.111223 0.085126 0.353623 0.826677 0.461777 0.518667 1.404379 0.899861 1.337308 0.525132)
)
;;; 103 prime --------------------------------------------------------------------------------
-#(103 16.7018587939366 #(0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 0 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 1 1 1 1 1)
- 16.296298498866 #(0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1 1 1)
+(vector 103 16.296298498866 (fv 0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1 1 1)
- 13.449216 #(0.000000 0.272143 0.377356 0.292017 0.607083 0.441282 1.423002 1.592393 0.730518 1.523469 0.470290 0.824988 0.147370 0.176486 -0.032643 1.705049 0.756222 0.131042 1.741882 0.311752 0.868210 1.172639 -0.011409 0.649184 1.097934 0.134631 0.678704 0.147845 1.434244 1.304597 1.378099 0.758207 -0.049029 1.298077 0.260065 1.175190 0.408273 0.214904 1.860116 0.582309 -0.135035 1.518350 1.816437 0.540710 -0.100437 1.091932 0.475851 0.952587 0.191830 0.675911 0.461957 0.614569 0.882972 1.729318 1.609544 1.312937 1.225402 1.843902 0.346079 0.079335 0.702348 -0.040197 0.506247 0.302022 1.421077 1.663673 0.351225 0.958350 1.255426 0.219495 0.965071 -0.076555 0.033242 1.697753 0.490027 1.414967 1.516649 0.350617 1.071460 0.842296 1.756074 1.486637 0.820799 0.628738 1.258212 0.475149 1.098700 1.008442 0.146123 0.306270 1.531348 1.862967 0.830466 1.644330 0.662956 1.223188 0.422050 1.075230 1.481717 1.101012 0.679997 0.485307 0.734251)
+ 13.256855 (fv 0.000000 0.253687 0.364122 0.283681 0.599056 0.452778 1.412525 1.578158 0.723002 1.502688 0.469327 0.823618 0.138223 0.170924 -0.041881 1.730522 0.763213 0.124296 1.756004 0.298966 0.867744 1.163387 -0.026926 0.637630 1.135341 0.124472 0.638511 0.161082 1.417534 1.311969 1.355755 0.769867 -0.015620 1.263904 0.253925 1.195956 0.435477 0.207251 1.875570 0.589212 -0.141939 1.489218 1.811390 0.546189 -0.100127 1.137591 0.512565 0.982503 0.208205 0.661546 0.459680 0.647870 0.862493 1.703684 1.626808 1.293610 1.244032 1.833651 0.313984 0.098233 0.713078 -0.030639 0.471225 0.283054 1.436428 1.697146 0.363648 0.928407 1.232119 0.232840 0.986487 -0.076225 0.058237 1.691889 0.445904 1.400974 1.534686 0.353656 1.081845 0.844988 1.752497 1.490478 0.820514 0.624503 1.244095 0.481359 1.092852 1.038822 0.122193 0.306870 1.545599 1.882053 0.840143 1.618524 0.664876 1.172112 0.425428 1.063389 1.459465 1.132826 0.707914 0.476065 0.729618)
+
+ ;; 104-1
+ 12.891616 (fv 0.000000 0.020230 1.100455 -0.027655 -0.341498 1.573639 -0.166459 1.336909 1.614334 1.265242 1.070753 0.200336 -0.139945 1.315758 1.256048 1.330780 1.163466 0.897749 1.119686 0.362299 0.301310 1.883571 0.506864 0.431140 0.779158 0.861103 0.563763 1.317182 0.358448 0.581384 0.662511 -0.059228 0.585764 1.735705 1.134223 1.253804 1.488711 1.296145 0.401006 1.318547 0.409838 1.063168 1.784758 0.605346 0.454705 1.514331 1.036227 1.443746 1.590100 0.152638 1.937048 1.659118 1.596372 0.834928 1.202317 0.791629 1.638040 0.394481 0.036287 1.308852 -0.027851 0.483382 1.137070 1.471797 1.436021 -0.339247 1.959465 1.416371 1.274782 -0.056416 1.618621 0.073487 0.645516 0.465048 0.562814 1.499952 1.962975 -0.425202 0.177209 1.576794 1.092923 0.684292 0.216536 0.469811 1.278388 1.697283 0.494244 1.421192 1.305461 1.352595 0.145716 0.152674 1.146529 0.138563 0.239706 0.891463 0.397696 0.605319 1.317917 0.759776 1.395135 0.600443 1.308594)
)
;;; 104 prime --------------------------------------------------------------------------------
-#(104 16.659368297545 #(0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 1 0 1 1 0 0 0 0)
- 16.473171464163 #(0 0 0 1 0 0 0 1 1 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 0 0)
- 15.919013023376 #(0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 0 1)
+(vector 104 15.919013023376 (fv 0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 0 1)
- 13.214296 #(0.000000 0.004412 1.022436 -0.068043 -0.414071 1.594522 -0.066214 1.264327 1.547436 1.269359 0.990428 0.200209 -0.032278 1.354653 1.171229 1.356785 1.163125 0.862637 1.033768 0.337543 0.265587 1.891112 0.389214 0.450890 0.778203 0.869397 0.542330 1.280271 0.485057 0.680772 0.591845 -0.073455 0.599815 1.637914 1.177031 1.308266 1.433070 1.330796 0.329164 1.260147 0.519922 1.045954 1.840074 0.643049 0.434980 1.540023 1.067193 1.448093 1.601048 0.122276 1.914118 1.720290 1.508656 0.908875 1.184928 0.747535 1.634896 0.412342 1.975068 1.379546 -0.129594 0.497199 1.178778 1.455978 1.455635 -0.261000 1.849421 1.435819 1.132381 -0.025799 1.635270 0.079892 0.601637 0.425199 0.580237 1.494633 1.924943 -0.469663 0.121095 1.502896 1.134312 0.780363 0.227576 0.443205 1.379418 1.667995 0.424025 1.390185 1.215129 1.345257 0.178051 0.297703 1.130012 0.161519 0.231220 0.970407 0.340314 0.632220 1.277916 0.785470 1.408943 0.638357 1.284402 -0.264254)
+ 12.987392 (fv 0.000000 0.019656 1.020820 -0.122857 -0.383416 1.743762 -0.077551 1.285344 1.556500 1.347778 1.007108 0.271391 -0.017599 1.323289 1.224441 1.254961 1.192419 0.950226 1.083964 0.356128 0.296702 1.898956 0.423819 0.431784 0.740632 0.838009 0.555934 1.287966 0.437690 0.641910 0.602950 -0.082685 0.609730 1.650999 1.107220 1.287768 1.459073 1.340092 0.368618 1.276887 0.523746 1.035407 1.951274 0.598910 0.440828 1.523180 1.064599 1.442876 1.610632 0.084831 1.933213 1.678415 1.492367 0.869607 1.168981 0.759731 1.683066 0.461763 1.964877 1.344876 -0.085783 0.568560 1.208659 1.424190 1.445388 -0.303350 1.915514 1.421848 1.165687 -0.066096 1.641117 0.068094 0.584541 0.457188 0.559162 1.501643 1.956646 -0.560037 0.043217 1.538096 1.142301 0.678432 0.239030 0.380298 1.373491 1.617773 0.449327 1.348144 1.243227 1.328890 0.139617 0.253213 1.094223 0.214901 0.235818 0.939054 0.321415 0.563100 1.348449 0.703267 1.435425 0.687968 1.242454 -0.344280)
)
;;; 105 prime --------------------------------------------------------------------------------
-#(105 17.115185731735 #(0 0 0 1 0 1 0 1 1 0 1 0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 0 0 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 1)
- 16.038356734428 #(0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0)
+(vector 105 16.038356734428 (fv 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0)
- 13.162192 #(0.000000 0.008719 0.199449 0.207588 0.073582 1.462441 0.547796 0.565841 0.228066 0.810491 0.490858 1.481630 0.511064 0.639372 1.766860 1.751101 1.027233 0.177812 1.350902 -0.180779 1.244045 -0.108855 1.609736 1.094639 1.223479 0.101991 1.524580 1.304896 1.228445 1.672768 1.762321 1.493349 0.103938 0.176298 0.862556 1.376544 1.460202 1.327328 0.650252 1.066441 0.619071 0.034470 0.262987 0.336144 1.519852 1.806347 1.798277 0.427374 -0.189306 0.458115 1.236631 1.336746 -0.072774 0.874678 1.419489 -0.103108 1.469518 1.876663 0.585626 0.912350 0.004463 0.325207 0.318383 1.426930 1.106491 0.909591 -0.170279 0.063008 0.944152 0.103894 1.128901 1.538899 1.435814 -0.144505 1.357767 -0.121633 1.801039 0.779519 1.394390 0.521345 0.739074 0.869719 0.658823 0.422683 1.514864 1.936736 1.123354 1.495205 1.630808 1.715447 1.282971 0.089851 -0.018313 1.185192 1.508130 0.072072 0.910842 1.878800 0.452276 1.050132 0.255435 -0.014317 0.767164 1.415145 1.898624)
+ 13.058436 (fv 0.000000 0.018841 0.195855 0.206420 0.065633 1.458550 0.564954 0.584050 0.255393 0.821477 0.473289 1.497087 0.488701 0.595510 1.763919 1.795152 1.020709 0.148507 1.419452 -0.190874 1.252819 -0.115417 1.572364 1.086172 1.203320 0.123978 1.519196 1.337538 1.222474 1.661628 1.792441 1.530814 0.073522 0.146382 0.880812 1.383907 1.455106 1.313842 0.612949 1.097744 0.661951 0.056058 0.292577 0.309700 1.553938 1.839317 1.798626 0.412574 -0.220475 0.391331 1.230536 1.329793 -0.061036 0.863566 1.369439 -0.108592 1.446517 1.870258 0.562986 0.909666 0.015512 0.313473 0.325423 1.421234 1.107012 0.906081 -0.185513 0.052032 0.945263 0.140137 1.151954 1.558716 1.433167 -0.154754 1.358982 -0.108152 1.794830 0.776903 1.411273 0.506284 0.746113 0.870064 0.655404 0.430773 1.492137 1.947814 1.106281 1.476409 1.624757 1.670125 1.262143 0.090556 0.017948 1.208649 1.518613 0.097884 0.893396 1.883764 0.459504 1.072858 0.258050 0.025247 0.792929 1.431035 1.911968)
)
;;; 106 prime --------------------------------------------------------------------------------
-#(106 16.130035426315 #(0 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1)
- 15.730461834714 #(0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1)
+(vector 106 15.730461834714 (fv 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1)
- 13.240390 #(0.000000 0.992165 1.702836 0.966590 -0.106629 0.928573 -0.103202 1.893633 0.528000 0.628161 0.611330 0.772632 1.409011 1.584619 0.705768 1.204739 1.250577 0.244628 0.995645 1.351659 0.389442 1.783676 1.105217 -0.954583 1.282223 1.430221 1.116553 0.601765 -0.045130 1.154827 1.313193 0.019729 0.407305 -0.184105 0.878029 1.322893 1.288082 1.302451 0.331394 1.034207 1.224333 0.647627 1.586069 1.183846 1.268781 0.233385 0.490894 0.047406 1.067979 0.484561 0.953711 1.046199 0.025711 0.959123 1.056437 1.235181 1.531867 0.279708 0.551614 -0.201227 0.203862 1.097782 0.603545 1.764537 0.885247 0.803431 1.046060 1.114712 0.975591 0.378801 1.362310 0.880911 0.523351 0.326083 1.480218 0.914410 0.256856 1.824574 0.593356 0.198238 -0.152794 -0.237615 1.378705 0.482729 1.299777 1.442677 1.076121 1.594870 1.088290 0.941494 -0.377374 0.181856 1.256987 1.731253 1.534790 1.857707 0.838667 1.295754 -0.127986 0.439764 -0.300649 0.370523 1.501608 0.733514 0.649140 1.077512)
+ 13.079950 (fv 0.000000 0.991683 1.667079 0.952198 -0.158134 0.908256 -0.128985 1.883696 0.540349 0.614398 0.596989 0.783975 1.428368 1.597136 0.736884 1.252068 1.305873 0.231319 1.020117 1.388373 0.377031 1.796792 1.091025 -0.916486 1.247592 1.449627 1.096507 0.594132 -0.088485 1.169711 1.329459 0.003695 0.368539 -0.180221 0.842521 1.314435 1.291992 1.272149 0.292625 1.025337 1.197144 0.687141 1.597409 1.201509 1.264866 0.210655 0.462014 0.072105 1.054043 0.490923 0.945944 1.071461 0.064888 0.965001 1.073253 1.205548 1.546442 0.256599 0.512902 -0.205146 0.188856 1.063444 0.616804 1.743279 0.914154 0.807038 1.016753 1.132350 0.990751 0.400337 1.345943 0.880688 0.534474 0.323663 1.462334 0.913980 0.240611 1.904272 0.651788 0.182999 -0.180558 -0.266742 1.405697 0.476547 1.309300 1.415664 1.075072 1.577006 1.108476 0.911007 -0.337178 0.168855 1.245061 1.768086 1.542431 1.828360 0.829179 1.275739 -0.086776 0.463079 -0.336090 0.362914 1.505253 0.753982 0.654367 1.043320)
)
;;; 107 prime --------------------------------------------------------------------------------
-#(107 16.541004232936 #(0 0 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1)
- 16.328491210938 #(0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1)
- 16.264743804932 #(0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1)
- 16.2013 #(0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1)
+(vector 107 16.2013 (fv 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 0 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 1)
+
+ 13.454325 (fv 0.000000 0.389504 0.200622 1.043121 0.761894 1.811391 1.013338 -0.029178 1.657156 0.071414 1.541808 1.697328 1.530731 0.828486 0.142611 0.827276 0.363623 0.731067 0.344946 0.056374 1.429426 0.761263 0.713573 1.043714 1.789986 0.913538 0.284688 1.632024 0.219315 1.596281 0.482719 0.716103 0.082813 0.889064 1.454911 -0.018694 1.031913 0.769500 1.225826 1.094301 0.011285 1.403439 1.540236 1.228421 1.198312 0.763787 1.489126 0.037842 1.393526 1.595697 1.484515 1.699381 0.910044 0.346999 1.483481 0.762896 0.323372 1.323234 0.494595 1.056252 0.710041 0.505300 0.227945 0.637730 1.459638 1.234710 0.493803 1.016315 0.230683 0.093113 0.713556 0.351744 1.777886 0.983943 0.185348 0.658457 0.665347 0.215532 0.767846 1.194595 0.781272 1.709017 0.088709 0.815194 0.381579 0.627948 1.674861 0.568794 1.433122 0.535438 1.473475 1.534920 1.207161 0.582128 0.284193 0.977855 0.959238 0.627080 0.292937 0.193644 0.627895 1.586822 1.256893 1.318535 0.663707 0.022219 1.167626)
- 13.578637 #(0.000000 0.391002 0.217818 1.057872 0.776747 1.819431 1.025182 -0.017381 1.668870 0.098512 1.521729 1.669185 1.520480 0.810582 0.150069 0.807471 0.362159 0.734498 0.333693 0.053960 1.424453 0.775750 0.715950 1.058192 1.805467 0.897351 0.309879 1.656952 0.235522 1.615116 0.486248 0.714986 0.086692 0.906820 1.454421 -0.007427 1.028893 0.780037 1.212611 1.106148 0.011291 1.409323 1.535680 1.217514 1.214737 0.766743 1.465517 0.036713 1.395912 1.568257 1.478726 1.702426 0.886572 0.355010 1.479628 0.767197 0.321308 1.292641 0.492814 1.055289 0.717361 0.491586 0.229081 0.639199 1.455653 1.236059 0.509135 0.994184 0.231718 0.113709 0.725448 0.346558 1.798938 0.957893 0.174204 0.669755 0.677827 0.216921 0.767732 1.191642 0.800958 1.724727 0.098304 0.817422 0.346951 0.638591 1.696317 0.579191 1.431884 0.553728 1.487371 1.525976 1.227527 0.576874 0.268600 0.991542 0.956851 0.612337 0.291327 0.190845 0.623108 1.590026 1.233157 1.314476 0.648090 -0.005033 1.173013)
+ ;; 106+1
+ 13.202367 (fv 0.000000 1.000613 1.684756 1.030591 -0.144674 0.930087 -0.073206 1.869216 0.492462 0.667691 0.532693 0.721976 1.419258 1.577138 0.740297 1.322068 1.346534 0.154223 1.065715 1.368889 0.410182 1.822841 1.125450 -0.885511 1.290555 1.433074 1.046721 0.707499 -0.124656 1.201693 1.347393 0.018662 0.502177 -0.078873 0.756433 1.230311 1.259142 1.367069 0.315216 1.023759 1.259356 0.661168 1.411343 1.215010 1.266771 0.189892 0.505302 -0.011494 1.187732 0.519532 0.949942 1.050962 -0.019894 1.078182 0.992807 1.143414 1.633065 0.324324 0.492441 -0.218768 0.188780 0.963413 0.578702 1.692089 1.002935 0.841457 1.096611 1.231089 0.982778 0.479408 1.297577 0.816566 0.491832 0.381540 1.447787 0.924630 0.221301 1.796849 0.662118 0.111778 -0.098285 -0.205921 1.443651 0.375879 1.302820 1.419045 1.157539 1.514324 1.141534 0.934891 -0.258550 0.136149 1.293417 1.740995 1.504775 1.852338 0.849037 1.301984 -0.143638 0.497510 -0.382560 0.320355 1.490322 0.666001 0.663075 0.925267 0.075096)
)
;;; 108 prime --------------------------------------------------------------------------------
-#(108 17.139458240072 #(0 1 1 1 0 0 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 1 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1)
- 16.664336486859 #(0 1 1 1 0 0 1 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 1 1 1)
- 16.517358779907 #(0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1)
+(vector 108 16.517358779907 (fv 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 1)
- 13.693142 #(0.000000 0.749484 0.661760 1.264142 0.294329 1.423836 -0.223285 1.535313 1.145454 1.627967 -0.102306 0.102032 1.183981 0.662868 1.657997 0.308667 1.696641 1.598064 1.275747 0.966669 0.843787 1.088165 0.627526 0.937054 0.013282 -0.042249 0.222524 0.238040 1.671478 1.867327 0.734959 0.875450 0.158925 0.539702 1.237990 0.707159 0.482436 1.254963 0.146440 0.313344 0.516026 1.283614 1.153523 -0.259255 0.534126 0.241880 0.339729 1.782529 0.564937 1.820977 0.719409 1.710220 1.616941 0.001926 1.337770 -0.144831 0.577074 1.448322 0.804354 1.493238 0.794204 0.335420 0.707537 0.673162 0.339910 0.351116 1.800116 1.298341 0.261536 0.036204 0.793196 0.573677 1.648315 0.723757 0.292121 1.432510 1.678903 0.186996 0.178229 0.470758 1.070114 1.123249 0.126215 -0.077137 1.599044 0.071280 0.896837 0.217192 0.242208 0.796959 1.467940 0.333354 0.567683 1.536130 0.955215 0.586920 1.092640 1.593662 0.581857 1.786941 1.360826 1.850235 0.131443 0.021463 1.695660 -0.088666 -0.224141 1.635388)
+ 13.566156 (fv 0.000000 0.728699 0.665336 1.259359 0.312955 1.409197 -0.227152 1.537467 1.153791 1.627076 -0.109225 0.091841 1.196044 0.651957 1.667279 0.297872 1.708304 1.600040 1.279774 0.976975 0.859888 1.094622 0.659631 0.928550 0.001741 -0.027962 0.214582 0.238151 1.673247 1.887884 0.736064 0.892280 0.140937 0.557264 1.253347 0.704162 0.470712 1.242786 0.158371 0.301659 0.524953 1.272263 1.156799 -0.239176 0.540826 0.229025 0.331628 1.768533 0.578592 1.809543 0.717505 1.699923 1.628036 -0.006910 1.357544 -0.139327 0.574888 1.440391 0.790214 1.511908 0.799982 0.339724 0.692982 0.670833 0.340679 0.340555 1.796897 1.303289 0.258157 0.027036 0.818761 0.552085 1.636862 0.719532 0.280874 1.446822 1.675335 0.170540 0.167079 0.487215 1.068313 1.129396 0.130584 -0.078228 1.601308 0.067975 0.896148 0.221651 0.232515 0.805049 1.470867 0.339643 0.563679 1.554585 0.968287 0.574484 1.097469 1.601363 0.583017 1.789341 1.359201 1.858560 0.117486 0.025512 1.678463 -0.072670 -0.213093 1.615471)
+
+ ;; 107+1
+ 13.161718 (fv 0.000000 0.987739 1.733133 1.054188 -0.119939 0.910849 0.010896 1.915591 0.510331 0.662472 0.507733 0.711187 1.421434 1.531951 0.698359 1.366502 1.433114 0.162830 1.031829 1.385260 0.380744 1.872146 1.120453 -0.900242 1.311562 1.361998 1.093182 0.717990 -0.097277 1.161510 1.367817 0.082904 0.485601 -0.064734 0.731587 1.181418 1.308157 1.250173 0.316423 1.011227 1.301355 0.644463 1.445963 1.205118 1.208647 0.244654 0.589262 -0.059634 1.176596 0.571146 1.043371 1.083159 0.006076 1.077933 0.991663 1.165270 1.605164 0.390047 0.441435 -0.106544 0.175661 1.010931 0.543321 1.751721 0.965777 0.870079 1.024670 1.181296 0.990067 0.440808 1.351390 0.806214 0.421993 0.407648 1.468845 0.828507 0.187943 1.771172 0.634836 0.107090 -0.067569 -0.177001 1.469562 0.463678 1.334677 1.387523 1.126011 1.572881 1.170585 1.010919 -0.335535 0.129689 1.331430 1.676924 1.536965 1.783188 0.838550 1.260495 -0.084649 0.463288 -0.384118 0.341860 1.494266 0.699617 0.647486 0.913118 0.121686 0.025406)
)
;;; 109 prime --------------------------------------------------------------------------------
-#(109 17.4553 #(0 1 0 0 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0)
- 17.086888321276 #(0 0 1 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 0 1 1 1 1 0)
- 16.93954489715 #(0 0 1 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 0 1 1 1 1 0)
- 16.726722717285 #(0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 1)
+(vector 109 16.726722717285 (fv 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 1)
- 13.713866 #(0.000000 1.368043 -0.021005 0.760322 0.653068 1.150611 0.000566 0.315000 0.781412 0.702392 0.479209 1.039331 1.597702 0.078927 1.784666 1.187399 1.428941 1.144414 1.840559 0.233375 0.220884 0.854445 0.272427 1.454440 0.646322 1.486588 -0.095738 1.477293 0.582311 1.085476 0.858629 1.676310 0.635697 0.229192 1.466923 0.937377 1.282326 0.810020 0.815540 1.233340 1.572519 1.607607 0.618826 0.669812 1.239242 0.093577 1.462315 0.244439 0.884266 0.007744 1.566464 0.481909 1.401274 0.762103 0.672551 0.251698 0.822093 0.804970 0.856632 1.154411 0.833700 1.348572 0.795435 1.712769 0.400407 0.728635 1.519833 0.849094 1.590604 1.056648 -0.206713 0.920448 0.316338 0.278193 1.321263 0.443144 0.474890 1.407739 0.305806 1.661464 1.108414 1.179202 0.198385 0.608607 0.373306 0.005940 -0.284636 0.766662 1.669232 0.477735 0.565483 0.439584 0.726048 -0.016601 1.495369 -0.049673 0.475691 0.508950 1.893703 1.463224 0.581509 0.195968 1.331054 1.137422 1.013483 0.692425 0.901482 1.126871 0.393430)
+ 13.649150 (fv 0.000000 1.372685 -0.023096 0.764121 0.652451 1.161206 0.008161 0.316013 0.797732 0.714473 0.487368 1.050633 1.595865 0.070630 1.790292 1.172057 1.415647 1.153468 1.827169 0.230707 0.215213 0.858764 0.278893 1.454000 0.649000 1.487731 -0.093971 1.467452 0.578832 1.089439 0.854711 1.680527 0.623468 0.213876 1.468708 0.944679 1.289165 0.802006 0.813501 1.223343 1.569276 1.613534 0.610297 0.672562 1.232493 0.103141 1.459267 0.251097 0.877797 0.013403 1.560238 0.500350 1.399744 0.774367 0.659639 0.252122 0.824594 0.812839 0.861276 1.156805 0.833828 1.345402 0.790424 1.718416 0.402535 0.733335 1.522110 0.842132 1.600144 1.051832 -0.203657 0.911191 0.314178 0.284195 1.331343 0.434428 0.490954 1.410099 0.311769 1.658687 1.103289 1.173009 0.197955 0.613754 0.369986 0.003017 -0.302157 0.765490 1.656484 0.479210 0.563523 0.438269 0.714490 -0.012143 1.495468 -0.063161 0.479473 0.509000 1.902431 1.448189 0.587148 0.187985 1.316513 1.133117 1.008029 0.693260 0.907818 1.116038 0.394946)
+
+ ;; 108+1
+ 13.143741 (fv 0.000000 0.981295 1.812666 1.117956 -0.185500 0.887133 -0.042123 1.869958 0.605292 0.660698 0.487240 0.624166 1.449694 1.534689 0.782613 1.451064 1.414295 0.227989 1.073340 1.379009 0.377980 1.849622 1.090582 -0.935851 1.300468 1.325519 1.018826 0.640677 -0.151618 1.157148 1.372788 0.030561 0.535214 0.003928 0.716545 1.230702 1.288510 1.214069 0.401399 1.044897 1.420969 0.699802 1.461844 1.182797 1.140031 0.222134 0.599399 -0.075721 1.205878 0.475321 1.079680 1.212881 -0.096955 1.107746 1.109769 1.169670 1.644352 0.462528 0.400247 -0.075889 0.244499 0.883273 0.555132 1.799341 1.047944 0.815280 0.989170 1.236643 1.002684 0.340197 1.339964 0.830022 0.342213 0.420385 1.313509 0.797027 0.138670 1.741420 0.612419 0.142853 -0.104009 -0.165428 1.519255 0.376528 1.265335 1.374075 1.080427 1.589793 1.292179 1.057071 -0.356737 0.109826 1.273643 1.715122 1.539078 1.804591 0.847821 1.225593 -0.104087 0.410682 -0.411370 0.366927 1.453570 0.665830 0.721383 0.960549 0.197868 0.027654 -0.001988)
)
;;; 110 prime --------------------------------------------------------------------------------
-#(110 17.014086078381 #(0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 1)
- 16.799713998439 #(0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1)
- 16.455888332339 #(0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1)
+(vector 110 16.455888332339 (fv 0 1 1 0 1 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 1)
+
+ 13.753511 (fv 0.000000 0.848399 0.494893 1.537753 0.056503 1.192968 1.014976 1.000380 0.176221 0.063643 0.945853 -0.068422 1.888547 0.530097 1.932585 0.363227 0.205713 0.801411 0.700920 0.687774 0.323313 0.855436 1.706412 1.023431 1.539017 1.189953 0.005598 1.402697 1.398321 0.097413 0.650843 0.983076 -0.039672 1.076216 1.303860 0.579074 0.077434 1.403649 0.444054 1.850591 1.616413 0.004099 1.016957 0.276287 0.460935 1.424558 0.455559 1.774494 1.736742 0.257321 1.711197 0.589769 0.080807 0.068711 1.794312 0.030231 1.983460 1.792079 0.697501 1.563642 0.912299 1.306605 0.631662 1.306070 -0.020912 0.369231 0.339819 1.307905 -0.099842 0.333029 0.056818 -0.061161 0.558252 1.627518 -0.126860 1.759233 1.646547 0.826803 -0.148545 1.670003 1.989516 1.496557 0.799184 0.829408 0.352552 1.567755 1.722037 1.366413 1.337959 0.542553 0.828268 -0.090626 1.570252 0.921528 0.763668 1.791188 0.313328 1.353716 0.012540 0.577255 1.197100 -0.067959 0.264526 0.484251 0.882328 0.325360 0.489410 0.497137 1.466498 0.363086)
- 13.805964 #(0.000000 0.850978 0.496834 1.538461 0.057529 1.195446 1.014977 0.994525 0.170824 0.058894 0.948373 -0.068733 1.886198 0.531902 1.934638 0.362166 0.203787 0.794891 0.695793 0.687162 0.314724 0.855958 1.697535 1.030628 1.541383 1.188833 0.005371 1.405269 1.392011 0.102039 0.647614 0.987652 -0.041493 1.073826 1.310641 0.576509 0.069341 1.405702 0.439993 1.854845 1.615684 0.005038 1.022871 0.274442 0.463720 1.425499 0.458295 1.772813 1.740662 0.265049 1.709763 0.588586 0.083263 0.069227 1.793734 0.026652 1.986605 1.792340 0.702235 1.565474 0.910789 1.305328 0.635426 1.311077 -0.023507 0.367776 0.344114 1.304934 -0.105918 0.334030 0.058054 -0.062328 0.556612 1.632781 -0.120698 1.759575 1.650380 0.830339 -0.150768 1.670459 1.986901 1.490820 0.794677 0.829190 0.351319 1.564751 1.723279 1.364306 1.337914 0.541445 0.830224 -0.096060 1.563020 0.921297 0.770806 1.792062 0.314562 1.352514 0.003813 0.577062 1.197663 -0.071106 0.263501 0.482109 0.880908 0.327632 0.486090 0.493532 1.469222 0.365417)
+ ;; 109+1
+ 13.385857 (fv 0.000000 1.005423 1.782283 1.037310 -0.213053 0.879928 -0.046517 1.873303 0.602952 0.747924 0.548631 0.551919 1.533520 1.564233 0.767686 1.439845 1.429058 0.210745 1.048360 1.272572 0.420497 1.907528 1.007798 -0.875985 1.280681 1.283565 1.002224 0.663448 -0.175829 1.191021 1.396519 0.008645 0.463633 -0.035145 0.773513 1.183723 1.280027 1.209216 0.370736 1.024088 1.346178 0.572424 1.493165 1.210957 1.190749 0.243885 0.627363 -0.093472 1.163170 0.538660 1.062757 1.203025 -0.076830 1.020755 1.065456 1.180141 1.616909 0.426164 0.442881 -0.033300 0.224949 0.880028 0.544694 1.835856 0.965989 0.842443 0.993190 1.292542 0.995849 0.354562 1.374934 0.864622 0.357717 0.414238 1.429257 0.844435 0.199497 1.704803 0.599091 0.164856 -0.041591 -0.188982 1.576927 0.379552 1.197978 1.412448 1.100509 1.573418 1.244031 1.006949 -0.394739 0.102675 1.270463 1.672535 1.525836 1.772058 0.832852 1.187053 -0.004100 0.474378 -0.431920 0.321063 1.410302 0.680526 0.673358 0.951529 0.162772 0.079611 0.022569 0.116743)
)
;;; 111 prime --------------------------------------------------------------------------------
-#(111 16.941944255543 #(0 1 1 1 0 0 1 1 0 0 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 1)
- 16.783880166046 #(0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0)
- 16.6662 #(0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0)
+(vector 111 16.6662 (fv 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0)
- 13.788984 #(0.000000 0.606706 0.484954 0.498424 -0.157307 1.297848 1.836011 1.168709 0.874538 0.520436 0.019312 0.431259 0.345466 1.101551 1.495066 1.420286 0.996232 -0.127662 1.539095 1.223432 0.929515 1.780436 1.249341 0.489827 1.037564 -0.133209 0.909240 0.448986 1.540861 1.348174 1.033554 0.936178 1.591352 0.965227 1.876721 0.574214 1.326265 0.763779 0.098295 1.910739 1.712120 0.851548 0.780778 1.534393 0.284095 0.908725 0.708689 1.587498 1.103751 0.050689 1.071509 -0.014873 1.704189 1.002721 0.036556 0.637915 -0.001460 0.313166 1.732276 1.701794 0.042917 0.358256 0.616160 1.568849 1.267306 1.841478 1.916228 1.610723 1.580584 0.890738 0.958740 1.404356 1.032401 1.156628 1.539226 1.304541 0.006134 0.323892 0.653163 -0.007578 -0.272078 1.699124 0.852360 1.254810 0.841818 0.036292 0.364632 1.082770 1.067163 1.418330 1.071859 -0.183205 0.435654 -0.183156 1.186824 -0.208936 1.467403 -0.025649 0.088225 0.212310 1.480927 1.409325 0.615094 1.721907 0.685504 0.290637 1.432210 0.068797 -0.267889 0.341499 1.170085)
+ 13.722535 (fv 0.000000 0.609754 0.477824 0.498205 -0.160828 1.311478 1.827872 1.163524 0.877088 0.528558 0.012460 0.425841 0.347225 1.111527 1.506620 1.410636 0.996952 -0.131493 1.544916 1.238729 0.920166 1.777555 1.246912 0.483008 1.025725 -0.124782 0.923160 0.448660 1.543112 1.342373 1.038202 0.935130 1.601650 0.963178 1.878258 0.588174 1.312098 0.758893 0.091784 1.903351 1.707234 0.845481 0.771218 1.534277 0.275800 0.904288 0.700394 1.584631 1.096911 0.048546 1.076681 -0.004790 1.712699 1.002701 0.028040 0.631055 0.000599 0.321247 1.728365 1.696152 0.050007 0.370978 0.617539 1.556864 1.281962 1.845086 1.923574 1.593500 1.577659 0.887043 0.956244 1.403764 1.038378 1.157002 1.529481 1.305687 0.017547 0.326930 0.654165 -0.007752 -0.267214 1.694215 0.852596 1.259529 0.832944 0.035647 0.361584 1.075053 1.075715 1.409307 1.062617 -0.201186 0.434486 -0.180399 1.188883 -0.221873 1.452975 -0.020938 0.072031 0.208492 1.474047 1.409906 0.615391 1.726165 0.685592 0.292682 1.428870 0.069915 -0.271563 0.353890 1.174756)
+
+ ;; 110+1
+ 13.484289 (fv 0.000000 0.995043 1.654854 0.951488 -0.186960 0.850693 -0.104052 1.791806 0.632389 0.741244 0.372539 0.536429 1.585222 1.564873 0.754743 1.533715 1.436886 0.265913 1.082971 1.345237 0.422609 1.896766 1.047262 -0.941259 1.315104 1.247825 1.012008 0.626763 -0.163895 1.147771 1.361070 0.089508 0.489357 -0.001980 0.747126 1.129161 1.312043 1.244841 0.335129 1.099634 1.435470 0.558588 1.594865 1.187385 1.215330 0.231616 0.653215 -0.079848 1.147198 0.522561 1.074244 1.189158 0.024016 1.002127 1.145705 1.183921 1.636771 0.398476 0.358443 -0.058263 0.246181 0.942683 0.482681 1.823368 1.038771 0.798364 0.979012 1.260203 1.008839 0.331481 1.329527 0.889282 0.388705 0.378727 1.394091 0.860317 0.191774 1.792101 0.682065 0.246000 -0.121897 -0.155296 1.603714 0.392748 1.177859 1.362462 1.085317 1.557823 1.337471 1.045764 -0.299177 0.095852 1.207771 1.749557 1.574722 1.798042 0.795838 1.277804 -0.046897 0.399079 -0.477065 0.322241 1.436449 0.774690 0.635047 0.952898 0.197693 0.020089 0.072586 0.105711 -0.061722)
)
;;; 112 prime --------------------------------------------------------------------------------
-#(112 17.423562009124 #(0 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1)
- 16.697049415765 #(0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1)
+(vector 112 16.697049415765 (fv 0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 1)
+
+ 13.804835 (fv 0.000000 0.660626 0.012013 1.067055 1.731382 0.878320 0.900685 1.333334 0.681047 1.863220 1.352916 0.703854 1.515374 0.461716 0.898953 1.919840 0.286167 0.735654 -0.086197 0.617448 0.511110 1.353376 1.062165 1.636012 0.515505 1.399695 1.421287 -0.379478 0.731516 0.180102 1.567557 1.923199 -0.007316 1.368320 1.294564 0.578724 1.657029 0.985867 0.321763 1.643211 0.183594 -0.095598 1.792723 0.880687 0.335377 0.402596 1.614065 0.786600 0.590837 0.174605 0.357314 0.363837 -0.136455 0.186803 1.076928 1.936757 0.633832 1.217976 0.067642 0.078632 0.866945 1.729624 0.916168 1.228002 1.090442 0.162856 0.012895 1.357444 0.829157 1.905883 0.224325 1.392049 1.223672 1.768609 0.413025 0.871017 1.661030 1.831359 0.223665 1.475164 0.272068 0.564210 0.622152 1.113002 0.676345 -0.006078 1.737306 1.187465 0.535707 1.077110 1.810506 1.386823 0.000557 1.452387 1.030585 0.842150 -0.158625 1.174437 0.579578 -0.079023 1.196883 0.846201 0.482764 0.945473 0.701184 0.898505 0.170202 0.481114 0.605193 0.955521 -0.054086 0.358715)
- 13.886200 #(0.000000 0.668884 0.016543 1.086308 1.753671 0.870406 0.899635 1.349022 0.684916 1.848406 1.327153 0.707892 1.505723 0.456873 0.890501 1.921016 0.282968 0.734358 -0.080787 0.617017 0.510042 1.366351 1.086017 1.633570 0.515024 1.394835 1.419604 -0.386302 0.732300 0.172693 1.576996 1.916741 -0.002208 1.382421 1.274995 0.567715 1.647134 0.973673 0.323616 1.650743 0.181228 -0.093444 1.792891 0.876345 0.334048 0.392155 1.606271 0.781126 0.603387 0.175765 0.335211 0.359667 -0.122682 0.200917 1.071548 1.943881 0.627103 1.218006 0.059464 0.087177 0.861150 1.725503 0.899187 1.216280 1.088335 0.154828 0.000058 1.356838 0.843556 1.899534 0.221613 1.389808 1.228928 1.749562 0.404363 0.868650 1.665707 1.842126 0.219776 1.466165 0.267367 0.569038 0.636449 1.099330 0.688631 -0.003215 1.739614 1.184093 0.537425 1.088871 1.821614 1.404141 0.001630 1.458680 1.035594 0.836741 -0.158565 1.182552 0.569904 -0.076766 1.194210 0.838070 0.477988 0.949106 0.689724 0.911011 0.180999 0.479624 0.592522 0.954764 -0.047372 0.351193)
+ ;; 111+1
+ 13.560854 (fv 0.000000 0.996200 1.682628 0.999634 -0.183169 0.941340 -0.063380 1.872352 0.588785 0.718316 0.404204 0.564721 1.640073 1.488214 0.688322 1.540833 1.402097 0.325664 1.088557 1.271965 0.430614 -0.023931 1.082172 -0.819505 1.289052 1.272358 1.016703 0.615500 -0.063492 1.173776 1.419856 0.160057 0.471424 0.025687 0.794626 1.093604 1.347648 1.313640 0.365769 1.198433 1.539259 0.590650 1.625522 1.236869 1.255735 0.261849 0.614310 -0.133810 1.106507 0.525198 1.040282 1.242100 -0.009151 0.940124 1.120632 1.244098 1.583333 0.484225 0.270298 -0.091909 0.275038 0.915341 0.498191 1.846447 1.147765 0.805686 0.960525 1.293095 0.980148 0.249336 1.277364 0.859717 0.447170 0.347316 1.500244 0.749545 0.120155 1.639932 0.628998 0.242589 -0.052482 -0.149374 1.587211 0.461604 1.136482 1.323997 1.019660 1.587802 1.220439 1.097627 -0.381422 0.113408 1.209314 1.808025 1.585895 1.749582 0.823561 1.289475 0.074159 0.350519 -0.613785 0.308515 1.554187 0.783853 0.541355 0.955629 0.179584 0.128995 -0.001165 0.025208 -0.107472 -0.097625)
)
;;; 113 prime --------------------------------------------------------------------------------
-#(113 17.29593895793 #(0 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 0)
- 16.7898 #(0 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 0 1)
- 16.203890830538 #(0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1)
+(vector 113 16.203890830538 (fv 0 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1)
- 14.057318 #(0.000000 0.557995 -0.182537 1.025293 1.901472 0.986292 1.868282 0.948793 1.414981 1.257506 0.831785 -0.063985 0.677687 0.285571 1.031058 0.609784 1.245602 1.205556 0.348210 0.194415 1.228928 1.746319 1.274993 0.304353 0.566671 0.723168 1.722824 0.136251 0.960791 1.047740 0.279867 0.611203 -0.198529 0.801392 0.035741 1.577546 0.160447 1.399401 1.821162 0.183956 0.613967 0.920243 0.511316 1.337126 1.394759 1.553897 1.304755 0.040803 1.423884 0.434632 0.672082 1.101604 0.263545 1.308530 1.246658 -0.178994 1.249821 -0.079140 1.431280 1.852619 0.036453 -0.214107 0.012340 1.848986 0.981377 0.089127 -0.018099 0.835731 -0.231693 0.885241 0.428462 0.722455 1.750663 0.849331 0.159643 0.670384 1.915526 0.330289 0.591784 0.130607 1.246855 0.964054 1.619956 1.325230 0.411420 1.879814 1.025892 1.181197 0.515354 0.076302 0.124174 0.647860 0.025627 1.276585 0.172432 0.842315 1.198905 0.265739 1.332736 1.721272 1.553083 1.377678 1.102145 0.822053 0.379974 1.880797 1.551712 1.838977 0.683245 1.301719 1.076362 0.947269 0.315840)
+ 13.613456 (fv 0.000000 0.554013 -0.189590 1.040342 1.895741 0.972257 1.983763 0.925350 1.413107 1.187039 0.890581 -0.092527 0.648924 0.275297 1.034974 0.578278 1.412961 1.217860 0.290211 0.146756 1.277989 1.797973 1.243546 0.309623 0.588952 0.766281 1.732300 0.158146 0.970241 1.057713 0.155581 0.740347 -0.278224 0.813051 0.090610 1.633987 0.141253 1.362430 1.811341 0.106172 0.560908 0.975141 0.414465 1.325189 1.317848 1.670918 1.310037 0.138103 1.544695 0.427642 0.688876 1.115251 0.104011 1.249484 1.283379 -0.217415 1.248803 -0.055143 1.377781 1.794050 -0.051929 -0.190679 -0.001958 1.872135 1.015649 0.017838 -0.117121 0.829495 -0.198380 0.905735 0.272607 0.619166 1.647347 0.816228 0.007369 0.650952 0.045714 0.308454 0.434057 0.201848 1.245915 0.933121 1.619736 1.351637 0.362509 1.868147 1.070766 1.188359 0.400988 0.049686 0.087230 0.628970 0.077489 1.262876 0.220162 0.869503 1.130712 0.267514 1.396227 1.721653 1.550102 1.446927 1.155950 0.841581 0.384623 1.977430 1.631746 0.006140 0.715062 1.236385 1.051311 0.995413 0.371400)
)
;;; 114 prime --------------------------------------------------------------------------------
-#(114 17.592388063856 #(0 0 1 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 0 1 0 0 1 1 1 0 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1)
- 16.769464540605 #(0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 0 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1)
- 16.442732865586 #(0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1)
+(vector 114 16.442732865586 (fv 0 0 1 1 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 0 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1)
+
+ 14.166020 (fv 0.000000 1.038356 0.826275 1.128674 -0.125090 1.829063 1.262013 1.160559 1.519516 1.502014 1.857796 1.525394 0.946893 1.361851 0.493317 1.621550 0.040839 0.825455 1.881008 1.165270 1.273827 0.159303 1.756090 1.393155 1.413051 0.957215 0.252091 1.226129 -0.094317 0.742943 1.002043 1.336572 1.592258 -0.082802 1.594640 0.366562 0.390860 1.427038 1.739079 0.663205 0.933325 1.484965 0.194283 0.375410 0.493300 0.605961 1.748551 0.279636 1.804517 0.357640 0.998348 0.681772 0.367098 0.467866 1.810315 1.933552 1.894370 1.189828 1.415118 1.834729 1.938426 1.415450 0.009074 1.747634 1.249287 0.770928 -0.115261 1.409451 1.246513 0.675514 1.266338 1.477875 -0.114148 0.185420 0.629532 1.098645 0.874254 0.446592 0.243371 0.516051 1.248852 0.028651 -0.007127 1.709807 1.312205 0.257361 1.279674 0.901557 0.855388 1.469222 1.328726 1.208217 1.433035 1.922664 0.274941 0.148828 0.367238 -0.254062 1.751340 0.773665 1.053171 0.567664 1.773987 1.113690 1.183578 1.066952 0.102607 0.071815 1.625657 1.255723 1.028659 0.085305 0.356288 0.418655)
- 14.236579 #(0.000000 1.036327 0.827546 1.126761 -0.123327 1.828974 1.265998 1.161768 1.510468 1.494823 1.867504 1.525133 0.955954 1.357032 0.494608 1.616989 0.047792 0.830922 1.884756 1.161796 1.268269 0.159720 1.759825 1.397301 1.418671 0.959114 0.249836 1.225561 -0.103486 0.744451 1.024414 1.338050 1.598514 -0.075646 1.595065 0.365244 0.395300 1.430578 1.749978 0.667563 0.933048 1.491044 0.199371 0.383523 0.483000 0.601654 1.749445 0.271504 1.789698 0.371345 1.001884 0.674679 0.363101 0.464654 1.810413 1.942893 1.886120 1.180145 1.409823 1.835604 1.922514 1.418242 0.008071 1.753510 1.249374 0.752278 -0.121936 1.398534 1.250336 0.682339 1.259829 1.459031 -0.104534 0.192546 0.637253 1.103705 0.872259 0.456856 0.241161 0.517629 1.257699 0.020245 -0.004672 1.709986 1.307051 0.260849 1.286291 0.907286 0.858024 1.467290 1.335944 1.217121 1.434843 1.918952 0.271352 0.162999 0.369183 -0.250325 1.759063 0.770947 1.037931 0.580765 1.784281 1.107010 1.180433 1.064049 0.095330 0.070761 1.641804 1.257268 1.016258 0.080495 0.357626 0.420012)
+ ;; 113+1
+ 13.529505 (fv 0.000000 0.609603 -0.150717 1.144620 1.885952 1.029695 -0.017328 1.023651 1.375935 1.049542 0.876959 -0.157071 0.712430 0.086142 1.092731 0.678537 1.443976 1.204147 0.360088 0.209607 1.268934 1.814390 1.230253 0.384833 0.625288 0.787682 1.706820 0.104070 0.975842 1.091508 0.162798 0.719194 -0.185681 0.851344 0.004406 1.551988 0.158850 1.400167 1.727125 0.074860 0.565161 0.958867 0.364724 1.349213 1.351889 1.679509 1.314199 0.132307 1.403589 0.369532 0.648564 1.160585 -0.009001 1.392847 1.218123 -0.146011 1.322032 -0.127699 1.286444 1.741589 -0.086769 -0.151954 0.062929 1.896116 1.063027 0.005563 -0.069693 0.819283 -0.185224 0.958608 0.217640 0.593867 1.814658 0.753485 -0.046094 0.586286 0.067659 0.127457 0.558174 0.155027 1.389478 0.905687 1.516935 1.472391 0.370204 1.903438 1.085058 1.201428 0.394426 0.093638 0.098055 0.586236 0.108735 1.290199 0.287019 0.975146 1.134274 0.275315 1.391551 1.689333 1.493530 1.402264 1.275785 0.772955 0.474442 0.009426 1.766587 0.112461 0.593436 1.228805 0.896377 1.061049 0.277890 -0.013199)
)
;;; 115 prime --------------------------------------------------------------------------------
-#(115 17.480941944057 #(0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 0)
- 17.1559 #(0 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 1 1 0 1 0 1 1 1 0 1 0 1 0)
- 16.774665887963 #(0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 0 1 0)
+(vector 115 16.774665887963 (fv 0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 0 1 0)
- 14.195905 #(0.000000 1.581384 0.359569 1.337533 0.280302 0.918294 0.364213 1.473971 0.384174 0.688772 0.641197 1.288123 1.581827 0.459955 0.255832 0.065914 -0.478107 0.953312 0.728095 1.252709 0.420324 0.945119 0.566642 0.085079 0.548579 0.468029 1.088015 1.620273 0.046643 1.516348 0.784400 0.485179 1.889332 -0.140916 0.406181 1.528551 0.213557 1.519527 -0.238225 0.582769 1.517619 -0.088513 1.674734 0.283535 0.743872 0.454049 1.489543 1.012794 -0.018370 1.569928 1.248805 0.437378 -0.032843 0.769744 1.107436 1.302368 0.330683 1.945944 -0.096210 1.904089 1.395704 1.273689 1.208210 1.828849 0.694765 0.528866 1.363352 1.277654 -0.090413 0.076798 0.165349 1.500957 1.095404 0.316141 0.362593 1.574963 1.487404 0.983564 1.702831 0.846840 0.121350 1.354956 0.943442 1.957055 0.689525 1.352372 0.813866 1.488333 1.307932 0.307180 1.783388 0.502099 0.852746 0.043457 0.890142 0.752680 1.578668 1.212459 1.037267 0.205260 1.480834 0.210471 0.177140 1.411191 -0.296206 0.461944 1.502490 1.520434 1.465609 1.640321 1.417022 1.025457 0.152824 0.003201 0.309560)
+ 14.106616 (fv 0.000000 1.570092 0.362453 1.337474 0.264875 0.921400 0.355874 1.476538 0.382397 0.690102 0.627233 1.283297 1.585161 0.461353 0.250428 0.070613 -0.478768 0.954888 0.726879 1.251951 0.417891 0.945598 0.563852 0.084589 0.533104 0.472131 1.084144 1.608792 0.044337 1.518184 0.783171 0.484129 1.900804 -0.149622 0.399475 1.517825 0.218983 1.531509 -0.230530 0.567148 1.520162 -0.082961 1.681948 0.292123 0.756368 0.448131 1.473802 1.014666 -0.012646 1.572834 1.242744 0.425093 -0.031699 0.769537 1.112143 1.298398 0.333581 1.945824 -0.101577 1.894990 1.397266 1.272345 1.210062 1.810802 0.715502 0.534600 1.359024 1.288083 -0.103335 0.078475 0.156596 1.496646 1.076856 0.312782 0.361663 1.568537 1.496774 0.979145 1.697729 0.843520 0.130906 1.341892 0.946201 1.950539 0.684184 1.344931 0.821452 1.479748 1.308019 0.296269 1.793184 0.500147 0.839533 0.057599 0.886809 0.752434 1.587024 1.203157 1.022448 0.212093 1.492893 0.209714 0.165780 1.402030 -0.307350 0.474032 1.513784 1.517441 1.459089 1.632203 1.421380 1.032369 0.154966 0.002531 0.304007)
+
+ ;; 114+1
+ 13.732359 (fv 0.000000 0.572178 -0.139025 0.983887 1.920434 1.123578 1.978353 0.968214 1.349051 1.117228 0.839675 -0.190533 0.694004 0.125250 1.107764 0.641260 1.405169 1.199788 0.276763 0.250348 1.204416 1.682914 1.257883 0.312057 0.695310 0.801198 1.682635 0.125698 0.950119 1.070718 0.245730 0.776193 -0.167540 0.949181 -0.042356 1.548062 0.106820 1.334788 1.742804 0.109905 0.567469 0.997715 0.375385 1.298162 1.314791 1.688434 1.235156 0.141282 1.427214 0.400188 0.631107 1.144708 -0.003109 1.362927 1.143332 -0.234998 1.276203 -0.143654 1.307422 1.689156 -0.014380 -0.262664 0.075462 1.880295 1.062640 0.101776 -0.026648 0.801460 -0.217311 0.971985 0.270988 0.672521 1.816202 0.778522 0.051104 0.549038 0.052885 0.201837 0.612616 0.180579 1.355932 0.900040 1.595492 1.482393 0.476525 1.886230 0.983641 1.114556 0.404677 0.048952 0.080076 0.569993 0.080539 1.262764 0.266797 0.946313 1.101489 0.203645 1.377876 1.725578 1.491484 1.434839 1.127583 0.826060 0.448266 0.008333 1.780636 0.098825 0.586600 1.122038 0.995066 1.017216 0.354291 0.057246 0.069092)
)
;;; 116 prime --------------------------------------------------------------------------------
-#(116 17.885190963745 #(0 1 1 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0)
- 16.812931137234 #(0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0)
+(vector 116 16.812931137234 (fv 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0)
+
+ 14.328742 (fv 0.000000 0.856207 0.986788 0.751460 1.884184 1.255896 0.144210 1.208511 0.255866 1.782286 0.019244 0.566742 0.407768 -0.089210 1.344767 1.018853 -0.034882 0.530119 1.597864 0.501326 -0.230774 -0.097023 -0.000389 0.665472 1.635375 1.228232 1.206358 0.850292 0.888987 0.993112 0.654339 0.818974 0.003413 1.565831 0.042608 0.878547 0.321526 0.088958 0.292372 -0.331777 0.700821 0.894714 0.005944 -0.346944 0.114845 1.049758 0.798720 0.790858 0.117448 1.021841 0.389934 0.399103 0.195343 1.878118 1.577823 0.477002 0.256545 1.229924 -0.002011 0.133077 0.537008 0.396216 0.701816 0.985840 1.738910 0.328555 0.541523 0.876819 0.876185 0.445666 0.685165 1.594949 0.620581 -0.127456 0.921400 0.311110 1.793307 0.275641 1.366815 0.824915 0.239454 0.832837 1.417323 1.769240 0.980992 1.239944 1.591029 -0.051475 1.486421 1.525417 -0.025657 0.653170 1.313243 1.650610 1.580897 1.618532 0.633267 0.393928 1.496919 -0.276408 0.878277 0.281939 0.351152 0.468289 1.618075 1.571369 0.984717 1.909405 0.851519 1.720488 0.929949 1.296555 1.289941 0.911398 0.225491 0.695200)
- 14.490748 #(0.000000 0.852451 1.011116 0.778710 1.887500 1.262425 0.121091 1.196517 0.286158 1.779515 0.027215 0.558502 0.419284 -0.103648 1.346169 1.000833 -0.026087 0.541136 1.586844 0.518243 -0.236412 -0.092939 -0.005121 0.694848 1.630553 1.222085 1.195478 0.845747 0.906013 0.980988 0.636965 0.830999 -0.007926 1.551928 0.021102 0.892841 0.322394 0.099066 0.267262 -0.317301 0.722885 0.896119 -0.024809 -0.371989 0.105477 1.054280 0.799731 0.790515 0.152153 1.013013 0.383973 0.384777 0.203635 1.883722 1.579638 0.482333 0.234811 1.213767 0.018595 0.125782 0.531837 0.387715 0.690577 0.983619 1.747403 0.317524 0.568277 0.889351 0.861430 0.449539 0.681972 1.605697 0.636984 -0.146875 0.941295 0.315255 1.802892 0.271552 1.351286 0.828019 0.239627 0.832053 1.443254 1.792237 0.948670 1.243745 1.579484 -0.038556 1.474587 1.515784 -0.017825 0.644585 1.285693 1.657697 1.562339 1.602477 0.597296 0.400112 1.474673 -0.260578 0.894339 0.302701 0.341971 0.452779 1.603234 1.564828 0.988334 1.911538 0.861595 1.725679 0.937842 1.295554 1.312928 0.904459 0.239069 0.694751)
+ ;; 115+1
+ 13.782751 (fv 0.000000 1.670105 0.303378 1.514771 0.060477 0.906403 0.370378 1.628880 0.301098 0.717479 0.564448 1.198544 1.701046 0.489974 0.092684 0.106689 -0.600359 0.960290 0.727113 1.181333 0.468036 0.933578 0.612714 0.102105 0.439119 0.536613 0.989488 1.668598 -0.080124 1.683573 0.654250 0.599004 1.870044 -0.069895 0.298556 1.555710 0.285805 1.565873 -0.205135 0.563645 1.519179 -0.152285 1.687696 0.402404 0.955645 0.241673 1.401865 1.046960 -0.019116 1.640885 1.197901 0.505391 0.095168 0.718441 1.181463 1.406618 0.309258 1.952979 -0.107329 1.969648 1.502137 1.090118 1.043918 1.702710 0.780485 0.583772 1.473922 1.490931 -0.163373 0.133574 0.135840 1.533071 1.015158 0.398692 0.320450 1.364722 1.538313 0.970480 1.636937 0.963390 0.136800 1.340905 1.204598 0.054477 0.486418 1.417827 0.808183 1.530254 1.191144 0.320075 1.853919 0.467453 0.809752 0.120164 0.781600 0.697424 1.379599 1.216021 0.948183 0.099657 1.566373 0.116729 -0.093843 1.319423 -0.420543 0.691568 1.660724 1.496943 1.401099 1.619305 1.446415 0.867038 0.105822 0.158044 0.282349 -0.011943)
)
;;; 117 prime --------------------------------------------------------------------------------
-#(117 18.290939331055 #(0 1 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1)
- 17.710553146299 #(0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 1)
- 17.5997 #(0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 1)
+(vector 117 17.5997 (fv 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 1)
- 14.627118 #(0.000000 0.220805 0.991607 0.121080 1.194014 1.238118 0.315555 1.901005 0.456952 0.670290 -0.068242 0.185060 0.145927 1.764655 0.117078 1.303635 1.221014 1.520962 1.452218 1.592579 0.140867 1.239057 1.528875 0.993713 0.298768 0.675595 1.233037 0.245970 0.576539 0.410387 0.594666 0.687935 0.850406 1.616380 1.788158 1.947481 -0.076462 0.767846 0.664536 0.278776 1.716755 0.441908 0.355337 1.185064 1.589332 0.435060 0.232588 0.946211 0.914423 0.527615 0.868139 1.335097 0.815982 0.064904 1.046626 1.263509 1.628889 1.606449 1.545307 0.579674 0.823796 0.669123 0.753583 0.494204 1.290769 1.927727 1.465117 0.323221 1.743171 -0.004150 -1.856227 0.202512 -0.084965 1.785837 0.698453 0.092144 0.429470 0.699924 1.019375 1.590474 1.402620 0.397185 -0.005441 1.636760 1.111555 1.233100 1.466123 1.390809 1.245232 0.472243 0.597483 -0.106278 1.274076 1.795459 0.428071 1.115174 0.229499 1.434630 0.221561 0.122599 0.263273 1.037848 1.552646 0.710615 1.620410 0.108667 0.447690 0.024174 0.198257 1.005366 1.616605 0.152028 1.400238 -0.019070 0.599393 1.919661 0.620422)
+ 14.497812 (fv 0.000000 0.224426 0.992019 0.138711 1.176503 1.236445 0.315077 1.906428 0.448900 0.678218 -0.088951 0.205668 0.157937 1.760779 0.121986 1.314615 1.230068 1.510274 1.468208 1.579772 0.156575 1.223695 1.547174 0.976223 0.294979 0.682844 1.254567 0.255930 0.581609 0.421918 0.606116 0.691338 0.828316 1.627063 1.800785 0.001165 -0.086581 0.763116 0.639955 0.291470 1.735899 0.422553 0.362144 1.186351 1.590842 0.426463 0.245182 0.967296 0.891425 0.519158 0.866605 1.346855 0.815662 0.075921 1.039570 1.274467 1.634408 1.602113 1.536366 0.552713 0.810604 0.673899 0.744845 0.479678 1.304967 1.905715 1.460213 0.317282 1.748084 -0.013722 -1.881692 0.174856 -0.080552 1.785033 0.698053 0.094949 0.417990 0.698446 0.985481 1.584075 1.403772 0.388703 0.009472 1.646671 1.128281 1.234472 1.443078 1.392782 1.271405 0.499301 0.604344 -0.127230 1.264738 1.785688 0.416206 1.113044 0.215095 1.469439 0.236533 0.117496 0.271632 1.034059 1.537681 0.722701 1.631698 0.103905 0.435634 0.027785 0.196356 1.018099 1.623844 0.142536 1.403226 -0.013797 0.598011 1.913682 0.626571)
+
+ ;; 116 + 1
+ 13.889211 (fv 0.000000 1.679442 0.299199 1.367111 0.052770 0.927297 0.328215 1.615881 0.302404 0.707696 0.516039 1.151316 1.673258 0.534217 0.190986 0.074151 -0.598397 0.913919 0.765928 1.260413 0.423264 1.023745 0.609735 0.153506 0.453539 0.468256 1.018228 1.788765 -0.068307 1.692855 0.624116 0.609141 1.910624 -0.022395 0.256365 1.514074 0.233219 1.516754 -0.154609 0.590788 1.514050 -0.043651 1.742187 0.341087 0.951970 0.371363 1.447587 1.079612 0.057107 1.623815 1.214707 0.567773 0.057804 0.791128 1.221209 1.383201 0.340554 -0.013292 -0.005609 1.947264 1.370803 1.062963 1.024336 1.739421 0.767066 0.671699 1.426918 1.511148 -0.149781 0.104225 0.061945 1.535119 0.940075 0.392689 0.259023 1.411809 1.598917 0.941897 1.683270 0.884953 0.108874 1.319701 1.100749 -0.050961 0.639728 1.429813 0.861586 1.511163 1.232212 0.240917 1.860927 0.406637 0.844627 0.125914 0.873615 0.651653 1.385473 1.135755 0.994702 0.030143 1.590457 0.161005 0.055154 1.334956 -0.459106 0.663912 1.678280 1.514956 1.365867 1.519273 1.441132 0.891112 0.176832 0.115181 0.351957 -0.175561 0.176948)
)
;;; 118 prime --------------------------------------------------------------------------------
-#(118 17.985612869263 #(0 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0)
- 17.181785583496 #(0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0)
+(vector 118 17.181785583496 (fv 0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 0 1 0)
+
+ 14.497443 (fv 0.000000 1.591354 0.741888 1.722967 -0.237709 0.685421 0.503550 1.254854 0.808656 0.911251 0.050157 0.861734 0.314280 1.341176 0.379991 0.875641 1.466708 0.300573 0.954767 1.385324 0.125132 0.348374 0.577011 1.655837 0.564307 0.582376 1.167510 0.907420 0.444532 0.218679 1.737312 0.252903 0.411946 1.083113 -0.185163 0.978023 -0.109963 1.511202 0.503851 1.662809 0.033875 0.523452 0.521481 0.883976 -0.357599 0.187161 0.880047 1.490736 0.844255 0.801313 0.683070 1.279258 1.624126 0.834042 1.570571 1.331665 0.812207 0.082063 -0.178779 0.727851 0.635760 0.472598 0.529740 1.710166 0.757477 0.262267 0.672628 0.403198 0.034164 -0.022037 0.130101 1.350219 1.105735 1.695932 0.323683 1.252068 0.744970 1.161905 1.322245 0.994864 0.697837 1.637816 0.396302 1.702348 -0.270747 -0.077800 0.225947 1.713037 1.228521 1.665048 1.679022 1.393803 0.704244 0.296414 -0.016270 0.947613 1.856633 1.384283 0.527416 0.984409 1.396798 0.351021 0.292270 0.549569 1.663499 0.778229 0.016680 1.156232 0.122381 0.159439 0.648535 0.193057 0.084166 -0.213455 0.477204 0.673154 0.992874 0.783540)
- 14.569974 #(0.000000 1.596067 0.744046 1.723199 -0.234407 0.679260 0.503863 1.250067 0.809186 0.892381 0.047515 0.854942 0.317520 1.345576 0.374933 0.873766 1.469673 0.303123 0.951000 1.386890 0.133651 0.351553 0.579644 1.667352 0.573795 0.587636 1.165427 0.916057 0.433125 0.207966 1.739392 0.257663 0.411537 1.079231 -0.186627 0.983183 -0.114196 1.509092 0.490861 1.674652 0.028986 0.510745 0.524092 0.887861 -0.361693 0.176020 0.883778 1.497538 0.844654 0.809343 0.690890 1.278126 1.612836 0.829978 1.578244 1.334505 0.805240 0.091457 -0.174493 0.734027 0.639305 0.473873 0.523413 1.701815 0.747892 0.269756 0.687129 0.400704 0.028374 -0.024192 0.119335 1.338681 1.108494 1.699196 0.327048 1.240990 0.753930 1.161731 1.314139 0.986402 0.693851 1.636441 0.399966 1.707901 -0.267235 -0.075533 0.220927 1.707055 1.217815 1.664470 1.680795 1.383554 0.703873 0.290117 -0.015559 0.948392 1.853235 1.374445 0.533692 0.982296 1.396761 0.349324 0.282074 0.538674 1.661612 0.787560 0.016099 1.161036 0.129201 0.164631 0.641916 0.194084 0.090422 -0.214206 0.477024 0.675938 0.990952 0.776647)
+ ;; 117+1
+ 13.955663 (fv 0.000000 1.656893 0.312860 1.406022 0.045609 0.940726 0.323204 1.558622 0.313593 0.699110 0.536076 1.119751 1.657613 0.469730 0.215020 0.137907 -0.614064 0.902352 0.821797 1.171991 0.441310 1.059221 0.661850 0.277594 0.394536 0.546400 0.968850 1.793240 -0.073575 1.622506 0.677941 0.641837 1.952355 -0.044282 0.215122 1.490798 0.302768 1.506837 -0.235108 0.508030 1.520891 -0.097109 1.755394 0.256002 1.007243 0.327520 1.464098 1.079175 0.017892 1.590910 1.290254 0.601225 -0.032662 0.654468 1.229419 1.312262 0.353655 -0.032649 0.034883 1.896617 1.433210 1.047605 1.126390 1.674282 0.764405 0.618210 1.508232 1.671380 -0.173491 0.106521 0.149565 1.507742 0.949278 0.443666 0.317362 1.314645 1.634673 0.873102 1.588608 0.915021 0.172843 1.351037 1.151673 -0.042685 0.619993 1.550214 0.823729 1.429222 1.211772 0.248747 1.864022 0.374155 0.849134 0.123908 0.792603 0.736151 1.435290 1.198233 1.078587 0.058874 1.626102 0.122469 0.017624 1.330950 -0.499655 0.706598 1.629594 1.438050 1.370171 1.549897 1.430173 0.915025 0.119087 0.070759 0.413439 -0.125417 0.236481 -0.031842)
)
;;; 119 prime --------------------------------------------------------------------------------
-#(119 18.0781 #(0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1)
- 17.500297546387 #(0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 0 0 0 1 0 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 0 0 0 1 1 0 1 1 0 1 1)
- 17.167841346875 #(0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1)
+(vector 119 17.167841346875 (fv 0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1)
- 14.408814 #(0.000000 1.375189 1.071022 1.242440 0.450990 0.998130 0.326674 1.843865 0.041314 1.298255 1.549600 0.728725 0.954357 0.210306 0.258026 0.853247 0.859188 1.806208 0.813463 0.489722 1.319166 0.220708 1.124582 0.689558 0.845489 1.609689 0.806401 0.054477 0.166878 1.261413 1.535247 1.157013 0.246959 1.098683 1.211371 1.480714 0.888598 1.095577 0.143710 0.446743 0.627530 -0.214209 0.869157 0.987311 1.647164 0.491855 1.672710 1.658710 -0.131740 1.196026 0.901578 0.904840 1.143977 1.145197 1.583426 1.531389 1.405502 1.862185 1.337274 1.937430 1.059859 0.948857 1.139733 1.324304 1.811032 1.700941 0.580164 -0.045223 0.685307 0.392691 1.344339 0.593103 0.306761 0.675562 1.844377 0.894862 0.375821 1.240725 0.150697 0.233925 0.772355 0.408178 1.156979 1.889926 0.784292 1.158424 1.614023 1.923769 0.178324 0.577984 0.979419 1.603914 0.496130 -0.104558 1.507087 0.928188 1.105479 1.078482 0.022778 0.000587 0.337587 1.518887 0.862493 0.615630 0.570835 1.763292 0.669405 0.025042 1.420397 1.954660 0.629737 -0.124232 1.900169 -0.020999 -0.021326 1.568593 0.925796 1.826280 0.630851)
+ 14.390682 (fv 0.000000 1.375664 1.071878 1.242281 0.449872 0.997239 0.326902 1.844870 0.041292 1.299611 1.550408 0.729190 0.953350 0.209856 0.257680 0.853205 0.858641 1.807278 0.814295 0.490323 1.317949 0.220101 1.124178 0.689692 0.845713 1.610142 0.807190 0.053107 0.167263 1.261235 1.535767 1.158168 0.246566 1.099513 1.210170 1.481156 0.887639 1.096230 0.144442 0.446125 0.627726 -0.213400 0.869947 0.988021 1.647446 0.493250 1.672678 1.658411 -0.130924 1.196700 0.900590 0.905506 1.144054 1.144682 1.583644 1.532418 1.405419 1.861571 1.337158 1.938890 1.060547 0.949400 1.139259 1.324089 1.811791 1.700889 0.580433 -0.043873 0.685223 0.393731 1.345217 0.593893 0.307423 0.675865 1.845148 0.894101 0.377727 1.240396 0.150868 0.234381 0.772691 0.408668 1.155960 1.889975 0.784676 1.158424 1.614216 1.924591 0.178912 0.577105 0.980476 1.603643 0.495073 -0.104468 1.507041 0.927685 1.105445 1.078554 0.022413 0.000361 0.338859 1.519222 0.863311 0.615320 0.570559 1.762687 0.669024 0.026456 1.421100 1.955221 0.629611 -0.125129 1.900181 -0.021163 -0.020189 1.567842 0.924421 1.826999 0.630355)
+
+ ;; 118+1
+ 14.018618 (fv 0.000000 1.667367 0.322872 1.356274 0.058995 0.960979 0.391067 1.596203 0.294396 0.668831 0.482386 1.201983 1.684789 0.511518 0.202150 0.119421 -0.566103 0.969879 0.710276 1.185777 0.439002 1.081943 0.730732 0.236637 0.526675 0.480731 1.028367 1.739731 -0.138846 1.593254 0.713861 0.553938 1.957692 0.049573 0.238503 1.491899 0.251089 1.428730 -0.126673 0.452175 1.482756 -0.053077 1.780248 0.323594 0.960159 0.318559 1.403830 1.045323 0.072970 1.671965 1.340192 0.627012 0.093313 0.726626 1.260031 1.369364 0.271099 0.039064 -0.011301 1.960494 1.463622 1.056374 1.121811 1.627859 0.817517 0.663209 1.409881 1.612732 -0.152806 0.038886 0.274896 1.521348 0.915556 0.404329 0.221685 1.199737 1.694611 0.915335 1.572323 0.961485 0.112089 1.311173 1.127868 -0.177640 0.609597 1.415894 0.807680 1.506084 1.239635 0.162405 1.866700 0.317949 0.857946 0.112683 0.879435 0.694750 1.339170 1.270491 1.111213 0.092592 1.497893 0.151420 0.069449 1.319832 -0.496262 0.680555 1.680836 1.536147 1.322680 1.555058 1.410956 0.888418 0.228998 0.018175 0.403145 -0.128572 0.219741 -0.075154 -0.155224)
)
;;; 120 prime --------------------------------------------------------------------------------
-#(120 17.635260884038 #(0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 0 1 1 0)
- 17.540792728815 #(0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 0 1 1 0)
- 17.067 #(0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0)
+(vector 120 17.067 (fv 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0)
- 14.524959 #(0.000000 1.301717 0.698963 1.322959 0.029721 0.075491 1.249411 0.928553 0.917898 1.170439 0.353189 1.153536 0.879332 0.139943 1.185364 0.874683 0.688790 1.688174 0.035143 0.235033 1.237886 0.527991 0.271016 0.644262 0.925052 -0.208780 1.214156 1.874500 1.933100 0.730829 0.896276 1.057096 1.135016 0.954489 0.334651 0.092791 -0.063197 1.544481 0.335246 1.522155 0.895543 1.015367 0.519003 0.889894 0.948619 -0.127471 0.261933 0.137648 0.497807 1.184176 1.684758 0.827208 0.578622 0.865213 1.365947 1.372683 1.895562 0.457620 0.435531 1.432400 -0.028354 1.474814 0.202699 1.318058 0.472203 0.493824 0.206846 0.317920 1.230868 1.521189 1.317489 0.339180 0.417829 0.501639 1.696705 1.229469 1.345435 1.341166 1.894404 0.952307 -0.214577 0.492892 1.946473 1.424864 0.216104 0.428782 0.199762 0.570446 0.979529 1.572716 1.177602 1.210536 0.033609 1.176049 0.288305 0.274414 0.773228 0.202340 -0.006260 -0.017964 0.629262 1.520814 0.347885 1.351282 0.556150 1.133597 0.492414 1.690640 0.943352 1.036983 0.627287 1.118682 0.537792 0.251752 0.836543 0.740472 0.997862 0.731171 1.529223 -0.074152)
+ 14.458666 (fv 0.000000 1.293108 0.698019 1.317447 0.029496 0.078825 1.245576 0.933427 0.917420 1.172126 0.357395 1.156156 0.879865 0.129592 1.181392 0.882110 0.690853 1.687107 0.025873 0.234607 1.243328 0.528035 0.272217 0.646247 0.920540 -0.212257 1.217024 1.877596 1.938817 0.737497 0.901785 1.059044 1.128268 0.954000 0.339889 0.097863 -0.055556 1.539115 0.342970 1.531145 0.894486 1.025619 0.519579 0.900743 0.956748 -0.133937 0.256714 0.139176 0.495069 1.185608 1.684763 0.822374 0.580038 0.873037 1.366028 1.356196 1.900731 0.458911 0.428437 1.433784 -0.025135 1.471236 0.210352 1.314750 0.475084 0.493167 0.205827 0.317580 1.227052 1.530659 1.302191 0.347571 0.409940 0.502737 1.688087 1.230409 1.337757 1.342952 1.903513 0.955786 -0.215055 0.487009 1.948923 1.411678 0.225274 0.421106 0.203875 0.568136 0.977570 1.560054 1.164692 1.211841 0.037236 1.165323 0.284280 0.274360 0.776762 0.207157 -0.008462 -0.022949 0.633618 1.519303 0.349119 1.348337 0.561608 1.136896 0.486384 1.690665 0.939858 1.037942 0.628883 1.115783 0.551269 0.261357 0.835768 0.754522 0.995311 0.736018 1.536035 -0.082119)
+
+ ;; 119+1
+ 14.042466 (fv 0.000000 1.695702 0.296711 1.338908 -0.078265 1.044647 0.445401 1.570773 0.356080 0.726875 0.562835 1.121698 1.696368 0.511401 0.207025 0.089500 -0.565140 0.942644 0.652808 1.167682 0.412919 0.987661 0.705879 0.198820 0.440865 0.512441 1.083421 1.751114 -0.069762 1.661970 0.763824 0.509555 1.981466 0.038582 0.269865 1.492095 0.267412 1.351405 -0.147933 0.429115 1.485596 -0.131353 1.737203 0.373649 0.934842 0.295981 1.401570 1.025505 0.159868 1.751013 1.267064 0.606930 0.033477 0.655345 1.307003 1.298431 0.292781 -0.055933 0.016301 1.947579 1.426247 1.012103 1.014686 1.610683 0.794183 0.636102 1.398468 1.630487 -0.106933 0.019245 0.234173 1.454561 0.871538 0.489427 0.182807 1.191314 1.653186 0.812730 1.596587 0.968349 0.144419 1.254337 1.168160 -0.201543 0.642098 1.430541 0.891933 1.544951 1.231299 0.070309 1.961946 0.325740 0.895972 0.097452 0.983847 0.726652 1.390398 1.237569 1.108864 0.162933 1.463000 0.108857 0.104118 1.340850 -0.457424 0.750886 1.757915 1.530952 1.370214 1.508778 1.434766 0.846018 0.114800 0.004043 0.307829 -0.143116 0.279204 -0.090078 -0.107619 0.067028)
)
;;; 121 prime --------------------------------------------------------------------------------
-#(121 18.236074758398 #(0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0)
- 17.782977183017 #(0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0)
+(vector 121 17.782977183017 (fv 0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 0)
- 14.575521 #(0.000000 -0.105351 1.728570 0.015154 0.360130 1.562476 1.867196 -0.544497 0.362522 0.430307 1.184293 1.862718 1.389835 0.233131 0.227120 0.206707 0.310159 0.164726 1.217037 -0.112563 0.632314 1.280510 1.095049 0.844273 0.382954 0.337963 1.762074 -0.299544 -0.077200 0.030802 1.157920 1.395461 0.357997 1.064601 1.126194 0.703689 1.268741 0.594908 0.645715 0.435241 0.542280 1.296801 0.514643 0.781201 0.187351 0.127067 1.612638 1.109429 -0.111409 1.512216 0.371984 1.337603 1.120427 1.408704 0.027164 0.627560 1.484319 -0.142860 1.055040 0.830760 1.417660 0.807146 0.780844 1.459746 1.437899 1.550179 0.569232 0.568384 -0.535196 0.640730 0.997714 1.252317 -0.072433 1.124428 1.048243 -0.069300 1.802111 1.588193 0.588957 0.017434 1.330280 0.370978 -0.063799 1.256028 0.721793 1.832417 0.248697 0.350392 1.619446 1.477145 0.524813 1.355315 0.193559 0.315414 0.013779 1.277325 0.135202 1.172931 1.491196 0.645394 0.946677 1.012213 0.731767 0.643945 1.604482 1.113331 -0.239254 0.115566 0.543424 0.622885 1.653950 1.114583 0.278617 0.950492 1.630837 -0.160637 1.014956 0.317639 0.084543 1.033427 0.424279)
+ 14.145310 (fv 0.000000 -0.025891 1.793636 0.033424 0.540007 1.698366 1.937124 -0.609559 0.386368 0.372251 1.167122 0.009884 1.449702 0.151646 0.129257 0.221923 0.286263 0.194141 1.256596 -0.022208 0.587239 1.364223 1.036771 0.840539 0.300738 0.487086 1.849878 -0.356013 -0.244608 -0.042719 1.244769 1.401449 0.301842 1.027056 1.091793 0.623370 1.184562 0.517907 0.649838 0.331082 0.619154 1.467356 0.525086 0.836576 0.132708 0.186394 1.646954 1.207107 -0.124102 1.434383 0.438192 1.403615 1.086842 1.456374 0.098749 0.654033 1.469902 -0.092397 0.999549 0.914715 1.334656 0.842194 0.762721 1.400578 1.518574 1.628966 0.557815 0.576931 -0.575198 0.632751 1.009717 1.185394 -0.060402 1.274789 1.032399 -0.216393 1.814193 1.597562 0.558478 0.044897 1.319287 0.285577 -0.020660 1.082584 0.821657 1.849151 0.241943 0.297525 1.569624 1.593287 0.604518 1.347238 0.159734 0.361474 0.136103 1.298636 0.140131 1.192829 1.398339 0.674275 0.995843 0.943454 0.693721 0.589259 1.642401 1.051611 -0.266130 0.115428 0.439245 0.514540 1.691776 1.063362 0.306592 0.883309 1.563638 -0.186910 0.971866 0.448146 0.177042 1.080065 0.466207)
)
;;; 122 prime --------------------------------------------------------------------------------
-#(122 18.225525517344 #(0 1 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1)
- 17.876078447724 #(0 1 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1)
+(vector 122 17.876078447724 (fv 0 1 1 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1)
+
+ 14.809716 (fv 0.000000 0.670494 1.886159 1.577487 1.777777 0.820522 0.567040 1.808673 1.691383 1.749354 0.999669 0.365962 -0.283305 1.315547 1.858625 0.083801 0.099076 1.593409 0.962399 0.938500 1.204685 1.174037 0.436114 0.616669 1.449802 0.424694 -0.043743 0.290754 0.536765 1.858591 1.302286 0.144562 1.898540 1.713336 0.304273 0.606056 -0.343580 1.320384 1.725243 1.070484 1.043894 1.041218 1.783423 1.623935 -0.119894 0.812509 0.330462 0.830339 1.651746 1.473863 0.826929 0.035844 0.962490 1.154392 0.108692 0.207697 -0.125372 0.785657 0.181654 0.507958 -0.099870 0.817795 0.576379 1.616959 1.203159 1.408060 0.803943 1.042280 0.347552 1.737313 1.151753 0.038129 1.376834 1.472899 0.308707 -0.055847 1.688664 1.527458 1.503192 0.428260 1.398802 0.697613 0.797253 1.257898 1.721624 0.405578 1.003490 0.227680 1.041522 0.134919 1.342074 1.464937 0.605066 -0.038087 1.389658 0.040933 0.121007 0.729584 0.212582 0.373515 1.668140 -0.235335 0.732650 0.289389 1.049347 -0.077662 0.429686 0.147005 1.585407 1.353860 1.815248 1.314972 0.285783 1.787337 1.040122 0.959573 1.461408 0.006176 1.591906 -0.004243 1.203878 1.856838)
- 14.899453 #(0.000000 0.670712 1.878713 1.580954 1.771690 0.816483 0.565955 1.811693 1.702108 1.751297 0.998876 0.381345 -0.278005 1.314713 1.859690 0.093133 0.100706 1.592873 0.960338 0.933985 1.202107 1.166264 0.425919 0.613230 1.438860 0.417219 -0.048036 0.298086 0.529956 1.864846 1.309935 0.152842 1.897819 1.724924 0.319193 0.595170 -0.331667 1.315673 1.727371 1.056820 1.037916 1.029466 1.780320 1.604895 -0.119347 0.793590 0.336229 0.844658 1.654040 1.487834 0.824835 0.030428 0.948262 1.172300 0.105031 0.222575 -0.120142 0.787360 0.189710 0.509157 -0.095061 0.807844 0.571069 1.628903 1.205542 1.410436 0.803691 1.062801 0.354083 1.747792 1.150969 0.038537 1.369842 1.470499 0.308909 -0.052067 1.676407 1.541548 1.506956 0.443120 1.392091 0.705388 0.787212 1.265892 1.719656 0.403531 1.002522 0.223578 1.027366 0.133860 1.328960 1.466983 0.603334 -0.045832 1.409774 0.029739 0.119053 0.729543 0.218850 0.371267 1.670977 -0.239842 0.728784 0.287473 1.049813 -0.086134 0.418136 0.137746 1.577400 1.352495 1.819005 1.317218 0.284856 1.788608 1.044754 0.949032 1.451805 0.021291 1.586781 0.001763 1.200244 1.852215)
+ ;; from 121+1
+ 14.077769 (fv 0.000000 -0.102882 1.749236 -0.004117 0.483853 1.765874 1.938255 -0.600392 0.405831 0.339694 1.084448 1.949979 1.449950 0.179825 0.196465 0.250508 0.230057 0.267538 1.186702 -0.013547 0.609348 1.275263 1.002412 0.929479 0.351264 0.550827 1.866085 -0.207369 -0.221459 -0.043981 1.181650 1.372732 0.322165 0.950666 1.016902 0.608561 1.206924 0.503654 0.566235 0.334378 0.545128 1.400875 0.599963 0.865496 0.228459 0.195440 1.563459 1.162224 -0.092823 1.463200 0.340144 1.432985 0.949791 1.498279 0.068471 0.623276 1.392543 -0.178909 0.913012 0.880422 1.353490 0.813253 0.747974 1.430440 1.480413 1.631261 0.640181 0.621156 -0.581884 0.645199 1.046241 1.177765 0.048757 1.254481 1.019786 -0.266200 1.761071 1.575419 0.546658 -0.000712 1.213661 0.352510 -0.036380 1.089333 0.735910 1.940744 0.321816 0.327061 1.683870 1.638125 0.601090 1.278317 0.270163 0.360522 0.023473 1.250704 0.243204 1.199993 1.329172 0.588810 0.966119 0.939463 0.761317 0.553614 1.599868 1.062777 -0.228048 0.241966 0.388550 0.647592 1.729999 1.118550 0.325131 0.887699 1.516026 -0.170170 1.006043 0.421332 0.259983 1.062250 0.497913 0.166635)
)
;;; 123 prime --------------------------------------------------------------------------------
-#(123 18.144585330068 #(0 1 0 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 0 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1)
- 17.389867782593 #(0 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0)
- 17.273 #(0 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0)
+(vector 123 17.273 (fv 0 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 0 0 1 0 0)
- 14.629223 #(0.000000 0.020118 0.589710 0.982606 0.992585 0.370919 -0.039845 0.301098 1.756952 0.367978 1.925609 0.433396 -0.092039 1.364803 0.790084 1.730502 1.452748 0.945227 0.540146 0.666387 -0.133939 1.898965 1.614029 0.126316 -0.075154 1.041892 1.411118 1.598629 0.354738 1.698748 1.704334 0.448611 0.703131 1.037843 1.268052 1.641508 0.389846 0.690881 0.963806 0.798975 -0.028297 0.683900 1.219410 0.345319 0.250206 0.186441 1.166154 0.798884 1.529093 1.054218 1.662173 1.816720 1.438720 1.298373 0.280317 0.227591 0.998058 1.127214 0.635250 1.152982 1.613941 0.686449 0.491932 0.223913 1.290821 0.403924 0.672849 1.584504 1.003387 0.671048 0.629874 0.263695 -0.092697 0.971503 -0.143703 1.121104 0.514684 1.345618 0.208760 0.469513 0.484823 0.465074 -0.187189 0.813245 1.399980 1.775449 1.424509 0.414057 -0.318429 0.990483 0.351377 -0.121003 0.609147 -0.197246 0.650021 0.752632 0.402775 1.001453 0.667751 -0.098034 -0.021621 0.780203 0.421421 0.636898 0.934318 0.490976 1.329165 0.890962 0.826410 0.431613 1.072795 1.484791 0.544812 0.885792 1.474009 1.459756 1.911909 0.601240 -0.071738 1.819697 1.528786 0.045004 0.589962)
+ 14.606318 (fv 0.000000 0.018375 0.589471 0.983384 0.991984 0.372395 -0.040275 0.299423 1.756771 0.367581 1.925315 0.431987 -0.091930 1.365768 0.790238 1.730935 1.453895 0.945086 0.541022 0.665855 -0.133333 1.898784 1.614955 0.125913 -0.075642 1.042483 1.409785 1.598074 0.355453 1.697472 1.704234 0.447761 0.702787 1.037349 1.268895 1.641450 0.389018 0.691038 0.964549 0.799007 -0.028923 0.682141 1.218121 0.346438 0.248506 0.187480 1.166792 0.799601 1.529262 1.053370 1.663430 1.815223 1.438810 1.297963 0.281072 0.228128 0.996820 1.126305 0.635366 1.152238 1.612305 0.687034 0.492102 0.223406 1.290673 0.404319 0.673144 1.585101 1.003033 0.671106 0.630415 0.262596 -0.092794 0.970586 -0.143151 1.120737 0.513895 1.346570 0.209142 0.468700 0.483816 0.465304 -0.188333 0.812984 1.400518 1.773921 1.423889 0.414054 -0.317948 0.988906 0.349734 -0.120165 0.609604 -0.196752 0.649574 0.752742 0.402866 1.001890 0.667657 -0.097642 -0.022329 0.780061 0.422052 0.637506 0.933615 0.491032 1.329969 0.891484 0.826863 0.432342 1.071482 1.483913 0.545228 0.886707 1.473772 1.459843 1.911936 0.601733 -0.070730 1.820410 1.529051 0.044995 0.589246)
+
+ ;; 122+1
+ 14.218431 (fv 0.000000 -0.071277 1.809148 -0.020616 0.407111 1.755823 1.904945 -0.715971 0.341233 0.449964 1.085208 0.031030 1.532200 0.268807 0.148267 0.268084 0.272209 0.202242 1.223891 -0.064002 0.629461 1.331632 1.050525 0.887285 0.370000 0.565442 1.910419 -0.226719 -0.262129 -0.049320 1.111879 1.377442 0.321129 0.921437 0.982936 0.703155 1.229920 0.446816 0.492798 0.314076 0.541522 1.414758 0.522185 0.801174 0.218712 0.168371 1.631951 1.208384 -0.085808 1.408101 0.423643 1.324899 0.982011 1.466628 0.095538 0.635570 1.314596 -0.072617 1.020892 0.911989 1.330565 0.770391 0.725410 1.510974 1.479974 1.759621 0.639552 0.614948 -0.510015 0.641435 0.965296 1.113277 0.074254 1.206499 1.003706 -0.366482 1.772703 1.570225 0.592942 0.091270 1.226107 0.311704 0.007633 0.964361 0.718780 1.974845 0.242071 0.343141 1.709800 1.693786 0.483738 1.265900 0.338851 0.340533 0.047929 1.263159 0.240281 1.186223 1.427920 0.613439 0.969107 0.960914 0.712662 0.596951 1.686986 1.021249 -0.262802 0.214377 0.402786 0.561682 1.740484 1.058116 0.341115 0.933358 1.469760 -0.231395 1.023135 0.404403 0.200269 1.060708 0.484072 0.072981 0.045518)
)
;;; 124 prime --------------------------------------------------------------------------------
-#(124 18.115 #(0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1)
- 17.868420183527 #(0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 0 1 1 0 0 1)
+(vector 124 17.868420183527 (fv 0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 0 1 1 0 0 1)
- 14.905565 #(0.000000 1.225012 1.002286 1.143474 1.505356 0.116541 1.069626 1.423691 0.398769 0.178571 0.358276 1.163737 0.271949 0.748464 1.396968 1.625038 0.513788 0.166106 1.542965 0.950413 1.296508 1.124769 0.341302 0.031392 1.886408 0.694465 -0.265019 0.612029 -0.179830 1.341920 1.650955 0.840236 1.079028 0.611375 0.719639 1.559859 0.024106 1.338213 -0.207686 0.068395 0.933847 0.947701 0.942597 1.358401 0.811033 1.105295 0.738773 0.598268 1.013524 0.238809 1.290312 0.884449 1.679440 1.308440 0.031000 0.111537 1.122835 0.576282 1.307466 0.280097 1.398999 1.453247 1.066309 1.122916 0.015893 1.553278 0.606066 0.378797 1.503892 0.365909 0.353626 1.265866 1.667804 0.044340 0.696520 0.614682 0.969036 0.704955 0.560648 -0.052607 0.764796 1.515171 0.415004 1.468475 1.638530 1.204259 0.587948 1.407673 0.239728 1.791950 1.688367 1.339991 1.698574 1.910442 1.139017 1.668172 0.012811 1.819708 0.953312 0.816376 0.581564 1.228715 1.189086 0.141492 1.228361 -0.230139 1.561398 0.571908 0.925335 0.332480 0.945674 1.580240 1.626004 1.846466 0.091521 -0.190531 0.013407 0.449850 -0.022734 0.928005 1.202676 1.673577 1.103563 1.136351)
+ 14.790618 (fv 0.000000 1.222162 0.999539 1.142487 1.505674 0.123191 1.078191 1.428308 0.398665 0.193203 0.342797 1.160548 0.272137 0.744922 1.397108 1.629980 0.516700 0.161533 1.540757 0.951466 1.306414 1.131481 0.340080 0.022600 1.902411 0.678905 -0.266096 0.618248 -0.195173 1.348860 1.656222 0.843246 1.086674 0.610041 0.732222 1.576567 -0.001222 1.325305 -0.206092 0.061466 0.937472 0.938375 0.951723 1.351728 0.822770 1.101763 0.749753 0.602996 1.016336 0.240295 1.282512 0.877283 1.675716 1.308583 0.020424 0.112525 1.125186 0.567562 1.325344 0.286941 1.392684 1.457107 1.070715 1.116929 0.019425 1.553921 0.611895 0.374394 1.517480 0.357614 0.351325 1.265831 1.671035 0.028656 0.694185 0.608779 0.968580 0.705917 0.557377 -0.050792 0.760543 1.517363 0.410154 1.478833 1.629314 1.203011 0.602580 1.412252 0.251943 1.776030 1.689098 1.335837 1.695826 1.914988 1.139727 1.661355 -0.008029 1.815582 0.952555 0.813836 0.589787 1.222025 1.184138 0.133013 1.235368 -0.243658 1.554911 0.580687 0.939871 0.323060 0.942785 1.574937 1.605974 1.858030 0.079942 -0.197497 0.010513 0.448075 -0.013192 0.950902 1.198378 1.685266 1.111201 1.137042)
+
+ ;; 123+1
+ 14.279834 (fv 0.000000 -0.081380 1.782165 -0.062634 0.363611 1.777729 1.870086 -0.748456 0.397000 0.457689 1.108119 0.004930 1.540452 0.247288 0.180358 0.333199 0.182296 0.178249 1.230554 -0.108533 0.646062 1.305622 0.825072 0.858877 0.381906 0.623442 1.836712 -0.249134 -0.191182 -0.125952 1.112553 1.374523 0.342721 0.833331 0.944734 0.720943 1.282090 0.390216 0.453997 0.358637 0.493600 1.372859 0.624272 0.735874 0.299299 0.184937 1.617155 1.281616 -0.070863 1.469387 0.307926 1.334541 0.930607 1.487203 0.131059 0.597353 1.290211 -0.242352 1.036453 0.942866 1.246650 0.636276 0.826032 1.531105 1.485955 1.813085 0.625741 0.627771 -0.579465 0.642188 0.969289 1.138476 0.074565 1.189823 0.939892 -0.416570 1.739435 1.565378 0.588268 0.099664 1.234765 0.379725 -0.063217 0.934469 0.845969 1.930710 0.181988 0.295750 1.696778 1.677311 0.505493 1.249700 0.433102 0.439581 0.020795 1.231023 0.285770 1.217649 1.421529 0.551828 0.924619 0.972048 0.789871 0.556108 1.717849 1.016229 -0.325643 0.376556 0.293594 0.487260 1.648794 1.072609 0.281420 0.961161 1.519437 -0.241812 1.031705 0.425825 0.197195 1.096632 0.361878 0.106170 -0.074233 0.005979)
)
;;; 125 prime --------------------------------------------------------------------------------
-#(125 18.072 #(0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1)
- 17.637776156888 #(0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 0 1 1 1)
+(vector 125 17.637776156888 (fv 0 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 0 1 1 1)
+
+ 14.772411 (fv 0.000000 1.488367 0.539453 0.636319 1.701536 0.864646 0.653079 -0.015234 -0.146959 -0.016393 1.159310 0.253720 0.483376 0.791134 0.148523 1.139178 0.651015 0.419622 1.011424 1.343222 0.375202 1.487445 1.136349 1.264222 1.195821 1.118452 0.058438 0.180283 -0.364874 1.141390 0.108460 0.432578 1.082489 -0.344327 0.561149 -0.050777 0.153514 0.046289 0.013379 0.201861 0.723817 0.636257 0.099730 -0.252366 1.579710 1.247947 0.727318 0.604484 0.768675 1.814508 0.866882 0.945446 1.203952 0.553202 1.570818 0.438899 1.210503 0.074303 1.805294 1.142851 0.477720 0.743449 -0.030259 0.761798 0.442190 0.180723 0.743309 -0.143585 1.116545 1.404371 0.204979 0.238499 1.331119 1.234638 1.176686 1.242725 0.433339 0.737611 -0.052694 0.108421 1.540317 0.211091 1.637087 0.618282 0.999958 1.643481 0.805826 1.863967 0.824505 0.797379 0.836059 -0.009548 1.065334 1.608230 -0.042496 0.454917 0.581669 0.915626 0.146732 0.685151 0.520442 1.115897 0.367688 0.129909 1.145807 0.921815 0.252576 -0.010734 0.180757 1.854774 0.546533 1.532747 1.382619 0.143523 0.214257 0.954384 0.657013 1.826584 1.432640 0.172761 -0.181378 1.290872 1.519863 0.506886 0.104986)
- 14.796957 #(0.000000 1.489150 0.539331 0.634979 1.701408 0.864681 0.652750 -0.015197 -0.146540 -0.016358 1.159558 0.253662 0.481905 0.791830 0.147903 1.139082 0.652189 0.420001 1.012300 1.342082 0.377311 1.488332 1.136930 1.264247 1.195096 1.116780 0.058516 0.178705 -0.366590 1.140669 0.109716 0.432238 1.082233 -0.343715 0.561174 -0.051814 0.153299 0.045772 0.012331 0.201392 0.722829 0.635520 0.100094 -0.252089 1.578867 1.247953 0.728382 0.604986 0.768395 1.815619 0.865643 0.945145 1.203809 0.551097 1.572083 0.440004 1.210603 0.072716 1.804894 1.143680 0.477001 0.743607 -0.029000 0.761618 0.442489 0.180376 0.744133 -0.142984 1.115214 1.404341 0.204907 0.238654 1.330667 1.234052 1.176311 1.241003 0.432611 0.738268 -0.052139 0.107769 1.540278 0.210487 1.636320 0.617392 1.000885 1.643405 0.805452 1.863584 0.823302 0.797344 0.834978 -0.010371 1.066080 1.607370 -0.042344 0.455401 0.582258 0.915463 0.146181 0.686249 0.521335 1.117797 0.366804 0.130324 1.144984 0.920531 0.252799 -0.010635 0.179830 1.854098 0.546496 1.533002 1.381863 0.143620 0.213691 0.954728 0.658612 1.826216 1.433294 0.172637 -0.180880 1.290970 1.519401 0.506653 0.105063)
+ ;; 124+1
+ 14.335616 (fv 0.000000 -0.073704 1.756721 -0.027521 0.555274 1.787030 1.851198 -0.739687 0.444117 0.371512 1.030097 0.041170 1.545538 0.189519 0.163161 0.279241 0.173564 0.127795 1.239047 -0.127708 0.674274 1.329026 0.927305 0.921971 0.291034 0.575583 1.919448 -0.265928 -0.189299 -0.242314 1.071327 1.320148 0.401414 0.885029 1.046562 0.775451 1.215839 0.374013 0.421290 0.242139 0.417910 1.413086 0.643233 0.744664 0.179383 0.219870 1.572661 1.345306 -0.060756 1.371806 0.318705 1.344767 0.903717 1.446972 0.029587 0.642047 1.254548 -0.199918 1.025990 0.987502 1.268140 0.763438 0.716412 1.540475 1.448750 1.854247 0.619685 0.691226 -0.557884 0.607847 0.974173 1.151524 -0.000158 1.208581 0.923167 -0.344361 1.808080 1.613014 0.625897 0.097908 1.229154 0.352252 -0.000924 0.978476 0.892610 1.915124 0.237884 0.295218 1.727938 1.672743 0.433468 1.238004 0.487776 0.417610 0.023342 1.153124 0.251246 1.196960 1.459291 0.552975 0.974914 0.953186 0.742186 0.557329 1.742338 1.006012 -0.331621 0.294231 0.321006 0.465332 1.742325 1.134043 0.251983 0.900167 1.477710 -0.206427 1.075443 0.425293 0.211597 1.112385 0.321994 0.162492 -0.098661 0.047474 0.072546)
)
;;; 126 prime --------------------------------------------------------------------------------
-#(126 19.269804000854 #(0 0 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 1)
- 18.284595039843 #(0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1)
+(vector 126 18.284595039843 (fv 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1)
+
+ 14.919977 (fv 0.000000 1.469803 0.590807 0.764079 1.791170 0.333377 0.787711 1.497688 1.425800 1.198769 -0.142602 1.315353 -0.073058 1.238142 -0.046252 1.358363 0.881227 0.034517 0.376307 0.332870 0.693500 1.217503 0.199404 -0.446423 0.007791 1.544042 1.693684 1.705920 0.539256 1.329303 -0.184478 1.516336 1.012314 1.494800 1.597619 0.336783 1.080235 0.583130 1.276101 1.725256 0.652789 1.276830 1.460138 1.593259 0.514539 1.170620 1.278633 0.619783 1.325249 1.591358 0.207365 1.060129 0.815013 0.040269 1.468914 0.227402 0.515366 0.731820 0.621073 0.837063 1.275146 0.259307 0.585385 0.909317 0.921047 0.261764 0.230595 1.268807 1.340737 0.628738 0.406147 1.678580 0.814730 0.487283 1.140440 0.869819 1.474812 0.775855 -0.116531 0.130586 0.641169 1.517310 1.370799 1.423659 0.321563 0.178649 1.411675 1.146911 0.966764 1.521079 1.121859 -0.427787 0.506332 1.644605 1.138614 1.523684 0.664505 0.648038 0.075277 0.416802 0.443365 1.235830 1.173282 1.107298 0.136026 -0.032457 1.449977 -0.023926 1.087880 -0.136228 1.342249 1.136201 1.846662 0.865407 0.833970 1.810099 1.018847 -0.107251 0.065627 1.367299 0.507024 0.142912 1.416639 0.609252 0.711456 0.417251)
- 14.941683 #(0.000000 1.469293 0.591484 0.763151 1.789721 0.333025 0.788760 1.497639 1.426084 1.200386 -0.142694 1.315629 -0.071647 1.237344 -0.044527 1.358113 0.880539 0.035628 0.375254 0.332763 0.694047 1.219245 0.199666 -0.446473 0.007507 1.545599 1.694524 1.705499 0.540273 1.329605 -0.184015 1.516406 1.012994 1.494497 1.598117 0.335438 1.078946 0.582790 1.276569 1.725361 0.653646 1.276820 1.460433 1.594274 0.516378 1.170625 1.278942 0.620102 1.325134 1.591924 0.206845 1.061164 0.814215 0.041768 1.468936 0.227617 0.514325 0.731714 0.620886 0.836917 1.274928 0.259805 0.586834 0.909520 0.920580 0.260595 0.230897 1.269216 1.341337 0.628234 0.406619 1.679674 0.814720 0.487833 1.139574 0.868636 1.475403 0.775382 -0.115445 0.130412 0.640926 1.519056 1.369408 1.424248 0.322567 0.178267 1.410033 1.145914 0.965461 1.521405 1.120389 -0.426649 0.506355 1.643683 1.138491 1.523767 0.664413 0.648162 0.074183 0.417118 0.444387 1.237062 1.172666 1.107214 0.137300 -0.031536 1.449226 -0.024353 1.087448 -0.136190 1.342085 1.135721 1.847806 0.864027 0.833791 1.809788 1.020544 -0.106599 0.064896 1.367085 0.506159 0.143722 1.417198 0.609306 0.711810 0.418019)
+ ;; 127 - 1
+ 14.478183 (fv 0.000000 0.930861 1.435103 1.015217 0.133148 0.287358 1.954448 0.877191 -0.313979 0.188033 1.404924 0.797822 1.641089 -0.072460 0.883498 1.253629 0.955039 1.649989 1.112182 0.909200 1.887346 0.566087 0.831325 1.595619 1.015259 1.132981 1.214225 1.758075 1.475152 1.620993 0.072446 -0.059078 -0.182289 -0.039338 0.155445 0.529297 0.046388 1.441668 0.535178 0.222607 0.659275 1.874433 0.311495 1.718719 0.434358 1.778879 1.619012 0.517997 0.354459 -0.261087 0.248995 1.922764 0.605114 1.052457 -0.265751 1.118974 0.375392 1.608325 1.902594 0.729575 1.283255 1.305350 0.868120 1.355763 1.680987 0.242830 0.477218 1.016250 0.628871 -0.030446 0.679211 1.826138 1.874720 1.129680 1.690954 1.195384 0.889438 1.205646 1.461460 -0.453690 0.712708 1.258870 1.879622 1.875344 1.343716 1.283838 0.647289 0.933542 0.025722 -0.304513 0.859639 0.850257 0.333502 1.942927 1.798084 1.335700 0.932797 0.281618 -0.061736 1.117606 1.074494 0.424155 0.429073 1.579564 1.707609 0.889204 0.016152 1.499631 0.327239 1.110073 0.816898 0.676932 0.517090 0.873228 0.943685 1.557236 1.328668 0.393069 1.595818 0.801812 0.427544 0.632088 1.930520 1.052145 0.001869 0.373834)
)
;;; 127 prime --------------------------------------------------------------------------------
-#(127 19.129140790802 #(0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1)
- 18.198689419357 #(0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1)
+(vector 127 18.198689419357 (fv 0 0 0 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1)
- 14.990895 #(0.000000 -0.111257 0.316262 0.553170 0.708325 1.664307 1.774525 1.224454 1.871094 0.125961 0.660393 1.214602 -0.230571 0.430580 0.820283 0.606875 1.915093 0.932237 0.141289 0.700573 1.105093 0.343202 1.104235 0.862103 1.130961 0.356018 0.718714 1.096604 0.636279 1.467431 0.135010 1.184249 0.893061 1.884290 0.357095 0.962532 1.693284 0.779393 1.375940 -0.246137 1.186861 1.789929 0.701103 0.284522 1.866773 0.822774 1.711714 0.440211 0.276718 1.328040 1.296343 1.479191 1.082504 0.741834 1.267406 1.947329 0.779388 0.909325 0.326906 0.975651 0.622632 0.027562 0.943713 0.969521 0.262927 1.784111 0.202564 0.096199 -0.526707 1.901811 0.538412 1.807348 -0.149251 0.929337 0.775040 1.164700 1.634538 1.576405 0.668034 0.746679 0.895591 0.099893 1.160382 0.173164 1.191092 1.305070 1.246193 0.638433 0.425588 1.710593 0.864496 0.096872 1.259679 1.364420 1.342381 0.972212 0.212594 0.749548 1.254979 0.917623 0.089463 0.128872 0.824489 0.227602 1.416916 0.657737 0.151293 1.816238 1.922576 1.009690 0.966794 0.577977 1.526013 1.202510 0.964907 1.849439 0.831193 0.227879 0.378908 0.142111 -0.022683 0.510220 0.908358 0.883319 0.793893 1.298225 0.796838)
+ 14.912432 (fv 0.000000 -0.112564 0.330831 0.563931 0.720452 1.659462 1.770279 1.222445 1.859857 0.126001 0.651461 1.215294 -0.233033 0.427403 0.814844 0.606037 1.919973 0.930971 0.148326 0.698675 1.110446 0.338577 1.107127 0.863142 1.130521 0.352666 0.715295 1.098761 0.639947 1.470989 0.137887 1.186298 0.901174 1.895291 0.359770 0.973168 1.699946 0.771080 1.375904 -0.248826 1.181644 1.789978 0.712701 0.277767 1.875124 0.813518 1.712932 0.451921 0.276945 1.323596 1.302350 1.483287 1.090079 0.743389 1.264854 1.950370 0.782969 0.914279 0.320477 0.990740 0.622004 0.030993 0.934242 0.961767 0.268688 1.789126 0.206081 0.101936 -0.529878 1.903369 0.539774 1.823204 -0.147241 0.928082 0.776302 1.167127 1.638509 1.576221 0.666141 0.750484 0.892326 0.100670 1.158426 0.166814 1.186903 1.306719 1.235546 0.635532 0.425679 1.719459 0.863874 0.092801 1.266262 1.369621 1.347298 0.966081 0.206817 0.754899 1.254971 0.922627 0.087389 0.135770 0.821247 0.230310 1.412479 0.655130 0.149628 1.814319 1.923709 1.016259 0.975859 0.575686 1.520455 1.205512 0.978744 1.845650 0.833521 0.220528 0.380346 0.141961 -0.028883 0.515081 0.897680 0.876651 0.794347 1.289685 0.792317)
+
+ ;; 128-1
+ 14.536393 (fv 0.000000 0.910972 1.475131 1.009861 0.062727 0.222323 1.938743 0.836711 -0.379271 0.255108 1.367947 0.841274 1.648864 0.015930 0.884691 1.125991 0.989606 1.607929 1.107388 0.857011 1.831346 0.433218 0.833149 1.592445 1.050762 1.008151 1.363530 1.700977 1.491038 1.682961 0.086100 -0.103806 -0.179348 0.003896 0.165438 0.493687 0.089620 1.387284 0.581547 0.176309 0.705269 1.811651 0.301490 1.707605 0.333845 1.832817 1.652148 0.600871 0.309714 -0.231587 0.303261 1.879368 0.673797 1.138199 -0.287759 1.071255 0.390644 1.597999 1.895638 0.729896 1.280128 1.313792 0.920129 1.387655 1.675038 0.226144 0.498585 1.104083 0.607578 0.005976 0.644124 1.859066 1.816208 1.159654 1.721231 1.377183 0.892151 1.087634 1.544878 -0.427006 0.761009 1.308993 1.890672 1.804683 1.325584 1.333615 0.649826 0.878906 0.043600 -0.222822 0.983855 0.725901 0.429955 1.892651 1.820617 1.395993 0.939478 0.246907 -0.065788 1.167118 1.004041 0.432075 0.450312 1.618752 1.686873 0.868341 1.893872 1.401676 0.376204 1.113598 0.748962 0.732995 0.557016 0.919800 0.871855 1.529811 1.275389 0.387399 1.586418 0.758929 0.456983 0.576267 1.810711 1.106484 0.012213 0.311973 1.081248)
)
;;; 128 prime --------------------------------------------------------------------------------
-#(128 18.871676504971 #(0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 1 0 0 0 1 0 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1)
- 18.306106723228 #(0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1)
- 18.276384353638 #(0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1)
+(vector 128 18.276384353638 (fv 0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1)
- 14.667285 #(0.000000 0.931174 1.489132 0.990268 0.020347 0.226113 1.896454 0.891194 -0.377689 0.281127 1.322458 0.818813 1.651826 -0.055248 0.966820 1.087202 0.951519 1.525934 1.135877 0.855815 1.835072 0.360776 0.916273 1.572198 0.997388 0.944282 1.350378 1.718097 1.531275 1.623227 0.039185 -0.139776 -0.118705 -0.026887 0.100190 0.507381 0.130873 1.390590 0.571187 0.082564 0.721016 1.820403 0.326768 1.742670 0.336867 1.801710 1.660996 0.603601 0.256943 -0.212708 0.267343 1.836636 0.638861 1.174382 -0.322483 1.063746 0.348741 1.599093 1.827581 0.674983 1.282544 1.269368 0.942051 1.378215 1.656953 0.206878 0.483082 1.069523 0.599890 0.057727 0.600665 1.889085 1.805098 1.115541 1.753521 1.425107 0.975760 1.071626 1.528546 -0.378730 0.778058 1.332565 1.904705 1.772965 1.336053 1.330923 0.633649 0.886102 0.004730 -0.192371 0.965530 0.720953 0.447083 1.930594 1.755387 1.465735 0.935401 0.255402 -0.047480 1.156967 0.968975 0.464892 0.466846 1.652165 1.704951 0.901848 1.786018 1.358746 0.424833 1.131336 0.712516 0.757844 0.567450 0.971447 0.828278 1.520838 1.270533 0.436484 1.562169 0.743065 0.442387 0.566906 1.785012 1.190786 -0.033645 0.318999 1.096483 0.816249)
+ 14.551285 (fv 0.000000 0.924459 1.485422 0.985256 0.056811 0.219930 1.908499 0.913743 -0.403193 0.259904 1.334649 0.827148 1.624714 -0.021872 0.937257 1.122813 0.961899 1.532146 1.148701 0.868319 1.827482 0.356035 0.897995 1.553711 0.943178 0.960525 1.352917 1.720117 1.523327 1.617955 0.013172 -0.149597 -0.137644 -0.034035 0.111097 0.498787 0.121406 1.399436 0.620595 0.082527 0.702328 1.824635 0.362315 1.752651 0.335052 1.794344 1.642190 0.610334 0.262361 -0.222978 0.248243 1.869656 0.644580 1.192948 -0.312319 1.070271 0.368940 1.593867 1.836900 0.676177 1.276819 1.276408 0.936758 1.361721 1.692175 0.215294 0.511916 1.079847 0.588820 0.055407 0.579633 1.891289 1.810098 1.133091 1.733591 1.452365 0.980479 1.078929 1.556717 -0.427469 0.779143 1.336023 1.912299 1.782248 1.339461 1.329616 0.616924 0.917615 0.006788 -0.195359 0.981816 0.758001 0.419952 1.868089 1.758394 1.479010 0.921655 0.244745 -0.038674 1.158515 0.987245 0.469852 0.442126 1.652528 1.699770 0.900506 1.793377 1.368738 0.405805 1.083967 0.706228 0.759055 0.550546 0.985536 0.835398 1.537041 1.252754 0.414912 1.587016 0.741668 0.441787 0.537126 1.829954 1.207186 -0.038603 0.324826 1.093300 0.845470)
)
;;; 256 prime --------------------------------------------------------------------------------
-#(256 27.740 #(0 1 0 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1)
+(vector 256 27.740 (fv 0 1 0 1 0 1 0 1 0 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1)
- 25.419292 #(0.000000 1.139929 1.102745 1.741314 0.362270 1.867278 -0.105796 0.818148 1.710527 1.852271 1.124318 1.670890 1.153503 0.195801 1.002124 0.467505 1.049937 0.142894 0.085485 1.658937 0.491728 1.241311 1.322988 0.765513 1.862684 0.158048 0.184902 0.364251 0.607460 0.160072 1.059841 1.058104 1.188210 1.281788 0.605768 0.044404 0.063311 0.674089 0.592930 0.211703 0.030582 0.160150 1.609868 1.314862 1.540462 0.499958 0.255349 1.385713 1.225596 1.323240 1.907235 1.512131 0.755403 0.859403 1.645985 1.326003 0.062908 0.441796 0.954669 0.168027 0.516707 0.922222 0.189230 0.272544 0.472239 0.553957 1.434892 0.429635 1.400931 0.255779 0.446915 -0.097364 0.010974 0.185385 1.838088 0.722158 0.636251 0.319610 0.900579 0.585282 1.916411 0.284763 1.647549 0.469510 0.056494 1.051937 0.839561 0.491974 1.028802 1.773079 0.399350 1.305864 1.439648 1.938862 1.794159 0.371223 1.096547 0.742554 0.816016 1.210775 0.917874 0.861164 0.505923 1.824144 1.685486 0.860715 1.263824 1.850040 0.906459 1.245640 1.446237 0.478492 0.330388 0.240550 0.475287 0.333923 0.461789 0.887379 0.765592 1.453119 0.159768 1.029570 1.310462 0.743877 0.659014 0.156047 1.339711 1.733763 1.914764 1.783195 0.311674 0.523974 1.009176 1.284070 0.814963 1.982550 1.654619 1.786557 0.152975 0.552534 1.941831 1.909265 0.024048 1.982739 0.172030 0.361974 1.716273 -0.145229 0.059166 0.923627 1.369358 0.259568 0.603591 1.244786 1.772948 1.455451 0.278943 1.396699 0.483204 0.706810 0.610680 1.017552 0.504030 1.246537 0.695997 1.710753 0.064401 0.966739 0.486122 1.103392 1.069961 1.199883 0.173924 1.605015 1.493330 1.468259 0.224231 1.356642 0.799457 0.943289 1.443695 0.483173 1.340693 0.391180 1.005750 1.024557 0.693691 0.750249 0.307649 0.380108 1.914054 0.115308 0.520112 0.000006 0.467400 1.333649 0.446022 0.351018 1.570672 1.024307 0.066464 0.462119 0.177876 0.365882 0.903910 0.056543 1.482436 0.056456 1.134537 0.787030 0.268455 0.834182 -0.004538 1.625912 1.079081 1.485660 0.837184 0.498066 1.823166 1.225371 1.040093 0.129168 0.924645 0.160099 1.780342 0.192620 1.690804 0.751720 1.760030 1.260828 0.448859 1.138104 0.090032 0.250034 -0.145296 1.040075 1.391702 0.079881 0.515861 0.385145 1.779559 0.214107 0.743183 1.112600 0.419711 1.838072 1.427776 0.925752 1.817873 0.317608 0.532205 1.862275 0.506156 1.710729 1.157460 0.942925)
+ 23.954812 (fv 0.000000 1.204657 1.078759 1.682184 0.289433 1.857298 -0.103078 0.812130 1.708916 1.896961 1.156555 1.703874 1.227021 0.182267 1.041071 0.489158 1.008682 0.135723 0.046495 1.634992 0.566031 1.311776 1.337489 0.673226 1.836763 0.159154 0.202747 0.341271 0.471573 0.119586 1.124289 1.100574 1.091468 1.313210 0.642853 0.117292 -0.058379 0.647409 0.710309 0.207284 0.060417 0.146614 1.530493 1.426852 1.584556 0.403196 0.281684 1.359791 1.211733 1.335753 1.885602 1.477601 0.688497 0.894421 1.600991 1.328569 0.005997 0.453096 0.992624 0.185444 0.508566 0.835246 0.264281 0.242464 0.561992 0.572786 1.360366 0.402158 1.414686 0.275179 0.381572 -0.113917 0.093761 0.181937 1.876554 0.763184 0.742398 0.316668 0.919942 0.466632 1.953058 0.269310 1.678357 0.562522 0.033550 0.978955 0.884214 0.441468 1.069549 1.818992 0.418629 1.336178 1.464108 0.008854 1.818306 0.399905 1.080809 0.763485 0.787603 1.378379 0.936433 0.806686 0.536881 1.819028 1.671276 0.786432 1.275261 1.884577 0.933469 1.355576 1.479258 0.462174 0.332804 0.282457 0.550215 0.317652 0.454496 0.923565 0.787078 1.464952 0.107434 1.071904 1.315331 0.744343 0.731492 0.092424 1.422672 1.730219 1.887932 1.793030 0.347585 0.560825 1.039175 1.321464 0.820946 1.971856 1.662872 1.726858 0.163305 0.618347 1.843241 1.984311 0.060498 0.046747 0.257781 0.365656 1.677750 -0.207494 0.053362 0.938280 1.295484 0.245637 0.522272 1.268074 1.776463 1.391102 0.235187 1.356696 0.411477 0.726380 0.608354 1.031435 0.374485 1.212534 0.683978 1.636985 -0.020727 1.002990 0.490099 1.193211 1.072433 1.116935 0.177132 1.577198 1.488833 1.426992 0.196808 1.359200 0.812178 0.923445 1.498869 0.535636 1.325569 0.453085 0.957271 0.999087 0.721363 0.748530 0.296873 0.424017 1.951248 0.179282 0.622927 -0.057442 0.420195 1.292402 0.421561 0.376166 1.549061 0.996315 0.165646 0.418099 0.201640 0.421702 0.831456 0.106402 1.463327 0.005503 1.240637 0.776492 0.181978 0.800991 0.047810 1.685961 1.102672 1.488982 0.855213 0.435527 1.756187 1.183435 0.997613 0.162344 0.965285 0.203761 1.756880 0.117280 1.723671 0.647873 1.760056 1.248565 0.397491 1.167098 0.048428 0.194870 -0.145837 0.946144 1.336821 0.037491 0.496156 0.411789 1.814729 0.171113 0.774274 1.046076 0.369134 1.865905 1.353847 0.811560 1.792633 0.305766 0.578868 1.799589 0.584644 1.768023 1.140595 0.983334)
)
;;; 512 prime --------------------------------------------------------------------------------
-#(512 43.486 #(0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1)
+(vector 512 43.486 (fv 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1)
- 40.250883 #(0.000000 1.067513 1.698501 0.882175 0.731347 0.396065 0.813755 0.963760 0.557013 0.330055 0.624000 1.141499 1.802667 1.147883 0.326439 1.700018 0.473901 -1.947004 0.102662 0.379112 0.161997 0.698965 0.728968 1.831300 1.279360 0.816655 0.480698 0.093700 1.500681 0.898464 0.536091 0.756778 0.355391 1.392086 1.233289 1.645259 1.641894 1.615256 0.190786 0.267903 -0.286330 -0.089039 0.457097 0.658540 1.669825 0.917012 -0.042627 1.298688 0.946526 1.789310 0.083576 1.102187 0.738679 1.390586 0.999921 1.312093 1.826088 0.412733 1.685728 0.303259 1.268988 0.900854 0.694405 1.727172 1.988661 1.867458 0.705458 0.724026 0.979505 0.018063 1.080148 0.984039 0.301365 0.996085 0.485066 1.698333 0.099220 0.144439 1.014550 -0.046011 0.199879 0.463422 1.340837 0.783213 1.151598 0.929237 1.727193 1.863491 1.325152 0.546479 0.970852 1.131669 1.594581 0.745485 0.269563 0.379861 0.913425 1.716346 0.963726 0.148826 -0.018344 0.857745 0.892045 1.081944 0.100251 1.000912 0.257282 0.111202 -0.008496 0.039287 1.417113 0.640192 0.675981 0.443529 0.868295 0.738861 0.820750 0.210774 0.082349 0.151630 0.783391 -0.180922 -0.106637 1.765370 0.742155 1.145606 1.368009 0.515346 0.436263 0.531741 0.802011 1.255309 1.894160 0.809353 1.813552 0.281020 0.025004 0.747411 0.889253 1.421629 1.808561 1.930509 0.839043 0.610805 0.811512 0.326999 1.060202 0.726316 0.486908 1.524130 1.740371 0.854892 1.794712 0.054857 0.374885 0.689897 0.804719 0.518621 0.778791 0.586676 1.098197 0.585149 1.186102 0.137320 -0.004366 0.332212 1.070131 1.845537 1.823307 0.557314 0.209620 0.792755 1.166951 0.717837 0.512510 0.629260 0.191128 1.302358 -0.197581 1.489802 0.982325 1.740676 -0.076574 1.688248 0.129965 0.784432 1.177913 1.102657 0.962095 0.929165 0.113690 1.498481 0.501354 0.386777 1.808656 0.189192 1.582104 0.598519 1.088596 1.677954 0.635479 0.886732 1.765869 1.721541 1.323683 -0.029727 1.928583 1.600246 0.279454 1.267423 0.990704 0.156419 0.680659 1.338166 1.787057 1.240138 0.302495 0.331931 0.199416 0.603149 0.714679 0.722359 1.555137 0.579030 0.968070 0.619479 1.564829 -0.173450 0.479277 1.582690 1.625073 -0.082864 1.364367 0.506113 1.020073 0.013031 0.901348 0.115571 1.654832 1.160506 1.382047 1.813620 1.803032 1.458055 0.157051 0.295770 -0.207462 1.435226 1.701103 0.634436 0.784529 0.075139 0.479500 1.222882 1.537827 0.905886 1.390016 0.322620 1.008572 0.815478 1.829604 0.684699 0.623092 1.869009 1.370361 1.545318 0.088302 -0.093316 0.065215 1.068848 0.441787 1.694437 0.956069 0.531992 0.195136 0.288213 1.080005 0.403178 0.327435 0.601585 0.419989 0.803862 0.624187 0.121109 -0.032458 1.233677 1.888075 0.416680 0.921255 -0.123147 1.100991 0.523132 1.866156 1.580633 1.521367 0.834357 0.017950 1.945026 1.112936 0.074866 0.578255 1.851390 0.917212 0.470515 1.494667 1.926605 0.420451 1.685173 1.321757 0.252699 0.908983 0.451996 1.280635 1.347889 1.101279 0.819891 0.717237 1.824992 0.064816 1.741467 0.171609 0.367474 1.450054 1.791245 0.070692 1.882472 0.030173 1.297571 1.480154 1.019678 0.718667 0.009196 0.641561 1.714326 1.179383 0.407542 1.176762 0.501786 1.884444 1.476017 1.294272 0.449015 0.628767 1.217169 0.537140 1.715118 1.505923 0.199813 1.524782 1.165141 1.676667 1.223004 0.016727 0.463878 1.136164 -0.053033 -0.084847 1.208615 1.445901 1.497341 0.161310 1.250596 0.942847 0.829403 0.387769 0.719178 1.738210 0.958532 0.472944 0.434584 0.253559 0.806841 0.948416 1.626398 1.745251 1.181118 0.900461 0.328407 0.004865 0.656956 1.561263 0.493976 0.215685 1.621837 0.977926 0.157229 0.368698 0.411012 0.533672 1.014733 0.265047 1.919729 1.249631 0.505841 0.810354 0.808424 1.184479 0.057215 0.275118 1.014035 1.475267 0.761434 1.193820 1.598491 0.134348 1.906886 0.063865 0.360892 1.182738 1.769838 0.652317 0.819564 0.835923 0.873375 0.958236 1.235262 -0.217562 0.548985 0.580422 0.773421 0.815778 0.094611 0.051274 0.456619 1.003721 0.560851 1.398235 1.328115 1.445608 1.526814 0.276018 1.944863 1.629687 0.184749 1.510383 0.270380 1.027430 1.256674 0.015870 0.564502 0.718165 1.794438 1.735884 0.904383 1.655901 1.675424 0.066250 1.899808 0.176362 1.550287 1.717784 0.905738 1.345949 1.001299 1.577679 0.550037 1.204039 1.754941 0.899017 0.959777 1.948798 0.199359 1.227196 1.454662 0.390714 1.580219 0.079875 1.186840 0.105451 0.922283 1.889599 1.204774 0.367870 0.720431 1.167140 1.635057 1.070144 -0.105934 0.316941 1.460835 1.680478 0.253545 1.791164 1.507054 0.456342 0.357901 1.697439 0.953658 0.592291 1.033133 1.478020 1.576280 1.358444 0.415789 -0.015554 1.241819 0.088719 1.636832 1.709484 0.595426 1.748375 1.690569 1.694795 1.541541 0.654394 0.467730 0.368448 1.418385 1.025035 0.300805 -0.128955 1.867573)
+ 38.602884 (fv 0.000000 1.082143 1.690042 0.893575 0.756109 0.365343 0.807438 0.940757 0.585435 0.342350 0.594341 1.140652 1.817226 1.102492 0.331462 1.612595 0.512173 -1.909591 0.094152 0.360726 0.151765 0.706858 0.749498 1.906233 1.235313 0.796232 0.500830 0.064536 1.490244 0.959772 0.522500 0.779779 0.400580 1.439171 1.288511 1.693600 1.634346 1.612029 0.250323 0.286364 -0.273948 -0.057072 0.444920 0.673291 1.660718 0.950511 -0.044480 1.277714 0.922828 1.742498 0.067040 1.123761 0.731844 1.393404 1.039320 1.324896 1.831174 0.387406 1.709067 0.274769 1.267431 0.959919 0.715608 1.693570 0.000362 1.870214 0.699669 0.668933 0.997821 -0.008050 1.092934 0.993144 0.278118 0.973866 0.508203 1.715050 0.139916 0.132362 1.047327 -0.053979 0.185439 0.405403 1.344059 0.788131 1.083324 0.893261 1.764451 1.883814 1.299760 0.554300 0.979273 1.155257 1.533722 0.768283 0.256481 0.366299 0.921394 1.649597 0.976718 0.165847 0.006944 0.856772 0.899715 1.074092 0.112821 1.082075 0.258835 0.138175 -0.004825 0.001351 1.429175 0.630347 0.684026 0.531342 0.847633 0.762458 0.815632 0.219787 0.092949 0.202477 0.797900 -0.145417 -0.117708 1.761218 0.769741 1.161104 1.342323 0.523211 0.405201 0.497008 0.787122 1.231664 1.866867 0.811507 1.822296 0.236359 -0.004728 0.793757 0.887814 1.429788 1.804982 1.942786 0.923502 0.603222 0.794618 0.368216 1.088308 0.796327 0.542686 1.544013 1.716025 0.878200 1.782174 0.062214 0.364255 0.646601 0.833457 0.599270 0.751311 0.607033 1.116295 0.605117 1.252490 0.144452 0.065646 0.340371 1.042827 1.788314 1.880686 0.569623 0.189168 0.776287 1.195192 0.727742 0.491941 0.571446 0.260116 1.294844 -0.224851 1.513707 1.029946 1.744464 -0.045793 1.705297 0.170929 0.776558 1.159210 1.100586 0.974908 0.889723 0.131669 1.514065 0.483669 0.374957 1.765248 0.173880 1.574655 0.579673 1.075226 1.695626 0.618344 0.910042 1.785601 1.685191 1.340397 -0.031592 1.930247 1.607968 0.311691 1.234826 1.008031 0.136574 0.693831 1.350593 1.790691 1.248723 0.321392 0.332409 0.211515 0.677389 0.675342 0.748083 1.542146 0.537541 0.945052 0.644544 1.587504 -0.198604 0.497285 1.589685 1.631769 -0.102021 1.434262 0.504366 1.007294 -0.071908 0.889783 0.106723 1.597262 1.184125 1.385914 1.784083 1.814813 1.444514 0.168106 0.275712 -0.230240 1.482952 1.749244 0.624319 0.820132 0.038543 0.453451 1.192705 1.551536 0.933988 1.412615 0.290421 0.996887 0.879431 1.841715 0.672561 0.642185 1.873294 1.346219 1.516340 0.034439 -0.025203 0.114641 1.027748 0.436673 1.695049 0.946949 0.531849 0.288148 0.279537 1.094778 0.375490 0.307554 0.627782 0.418409 0.832934 0.666935 0.114950 -0.053285 1.218299 1.879745 0.386673 0.915368 -0.165173 1.124058 0.466149 1.878428 1.629128 1.512993 0.806896 0.046040 1.932554 1.129093 0.063911 0.559840 1.823056 0.947920 0.467855 1.479381 1.855655 0.408469 1.725599 1.305170 0.270211 0.911615 0.523954 1.318986 1.354400 1.104393 0.792536 0.687738 1.816953 0.079500 1.734615 0.148004 0.393542 1.491324 1.809997 0.036899 1.917219 0.036016 1.292915 1.439271 0.992174 0.734749 0.043086 0.632449 1.678465 1.214089 0.407041 1.157576 0.467194 1.849834 1.465874 1.299867 0.452820 0.577350 1.178402 0.504471 1.704246 1.529399 0.119449 1.587272 1.187154 1.736018 1.251019 0.054071 0.448967 1.151610 -0.041983 -0.058564 1.189234 1.429143 1.489017 0.205182 1.257753 0.994036 0.781546 0.390902 0.744400 1.772431 0.919261 0.499894 0.419934 0.281518 0.736860 0.910447 1.681100 1.722013 1.141474 0.827377 0.320102 0.007503 0.593080 1.581219 0.475353 0.227567 1.630156 0.895436 0.162740 0.389713 0.427078 0.505436 0.990570 0.227561 1.922194 1.293488 0.525156 0.798692 0.804781 1.222760 -0.002373 0.214414 1.011966 1.489753 0.749041 1.209362 1.542616 0.129806 1.948618 0.096126 0.340987 1.210097 1.746925 0.607998 0.771692 0.843752 0.870293 0.931325 1.216995 -0.219011 0.558727 0.605157 0.764943 0.813267 0.109796 0.025290 0.418750 0.976910 0.611063 1.425653 1.312703 1.416454 1.541723 0.279510 0.000239 1.660016 0.196937 1.482933 0.237398 1.048222 1.226372 0.074770 0.565242 0.782888 1.814840 1.669287 0.878760 1.658003 1.628831 0.063412 1.934276 0.152397 1.633067 1.697411 0.919379 1.358819 1.021028 1.568829 0.560019 1.191100 1.722100 0.879855 0.967865 1.958702 0.180163 1.190964 1.472899 0.387723 1.635329 -0.004167 1.194302 0.101361 0.922515 1.847355 1.174116 0.380497 0.721821 1.201075 1.612741 1.020268 -0.168817 0.406276 1.455790 1.666789 0.232089 1.791143 1.515844 0.427944 0.351285 1.732308 0.954418 0.569378 1.065546 1.527300 1.587063 1.317922 0.415597 0.001422 1.240139 0.099248 1.639437 1.663543 0.562245 1.762090 1.669121 1.738347 1.503729 0.665114 0.450457 0.358214 1.358391 1.040768 0.320330 -0.191120 1.844458)
)
;;; 1024 prime --------------------------------------------------------------------------------
-#(1024 70.140 #(0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1)
+(vector 1024 70.140 (fv 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1)
+
+ 65.349256 (fv 0.000000 -0.129848 0.969209 0.836351 0.061754 1.032484 0.051397 -0.047672 0.218624 0.018916 -0.064346 -0.087720 0.896115 1.194836 0.077672 -0.093665 -0.097710 -0.086592 0.949666 1.122929 -0.067767 0.950039 1.122745 0.018018 0.930855 -0.245701 0.859196 -0.118393 -0.017421 0.154025 -0.211100 -0.109137 0.940842 -0.140564 0.967517 -0.167684 0.023269 0.025376 -0.045911 0.903419 -0.200515 -0.239733 0.820269 1.087952 1.103155 -0.067139 0.794572 -0.000447 0.796383 -0.050127 -0.097253 1.071546 0.028226 0.109239 0.999458 0.870447 0.946254 -0.081085 1.245293 0.861076 0.913395 -0.009593 0.921868 1.075746 0.111204 0.213778 0.007799 0.861516 0.879520 1.119282 1.112758 0.023180 0.087708 -0.039342 0.017034 -0.142251 -0.066926 0.123437 -0.087868 0.910913 0.108597 -0.196132 1.069560 1.014239 0.192506 0.075011 0.674937 -0.174632 1.062546 0.982886 -0.071153 -0.102231 1.008769 -0.021251 -0.043692 0.910660 1.203363 0.930076 1.192149 1.079643 1.139869 -0.102933 0.892075 1.081967 1.117296 1.069641 0.961155 0.889926 0.104236 -0.012679 1.018557 0.083425 0.102764 1.041332 1.049506 1.057530 0.927572 -0.192969 -0.132492 0.997314 1.171628 1.067315 1.038820 1.033745 1.322831 -0.007981 0.994085 0.965156 0.070645 1.143780 -0.097751 -0.035141 1.081372 0.841845 0.110341 -0.016561 1.124066 1.050833 0.937074 0.926741 -0.150226 0.056436 0.964946 1.014226 0.961483 0.200116 -0.027025 -0.042596 0.873435 1.128675 -0.074217 0.034750 0.002625 0.037174 1.052187 -0.007505 1.057468 -0.020629 0.954765 1.162873 0.836305 0.919671 0.176115 0.867824 0.159416 0.913293 0.972493 -0.057629 0.902111 0.973589 -0.086627 -0.008031 -0.139087 0.943821 1.137966 0.070214 -0.004563 0.871135 -0.028372 0.970905 -0.036782 0.845326 0.108872 0.880706 -0.063917 0.888627 0.925543 1.066596 0.853571 -0.093806 0.904332 -0.112339 0.945758 0.871634 -0.096140 1.001890 1.129246 0.963672 0.170539 1.085873 0.061910 1.045363 -0.043655 0.071480 -0.112838 1.140479 -0.203871 0.018032 0.967477 -0.109462 0.786798 0.159117 0.091987 1.000511 0.121439 0.998700 0.114766 0.043124 -0.051500 1.039391 -0.116269 0.884009 0.038584 0.870599 -0.009894 -0.177026 1.208055 1.281757 0.041090 1.074146 -0.185247 -0.160109 -0.084894 -0.013678 1.116236 0.043626 0.914436 1.186335 0.008002 -0.013450 -0.068550 0.867764 -0.069795 0.028624 1.053037 1.105179 1.148503 -0.078114 -0.107345 0.808140 0.888280 -0.101397 0.863680 -0.177989 0.805880 0.985054 0.997369 0.970739 0.045371 0.041317 -0.112380 1.007911 0.837435 0.969586 0.893134 1.011096 0.079245 0.911597 -0.043743 1.012740 1.031412 0.069924 0.910651 0.066980 0.855519 1.128309 1.046886 -0.009687 -0.147082 0.900969 1.137525 0.881305 1.084781 -0.031000 1.031283 0.123503 -0.135598 0.951868 0.887466 -0.122854 -0.039498 1.017664 -0.102471 1.018993 1.022945 0.093609 0.101814 1.044330 -0.102747 0.051954 0.001832 1.002061 1.025387 0.930853 0.958319 0.146189 0.932064 0.106399 1.032653 0.014707 0.032026 0.879101 -0.027770 0.031687 0.111934 0.802921 -0.076047 0.059286 0.065123 0.128711 0.974155 1.040636 -0.158251 -0.044445 -0.146345 1.152523 0.901758 -0.061750 0.921515 0.108254 -0.128639 1.088615 0.119335 1.107712 0.012965 0.831934 0.917791 0.827352 0.931376 0.029208 0.968659 1.110903 1.139422 0.103217 0.804597 0.104877 1.024813 1.110962 1.158506 1.074313 0.918885 1.091629 1.052239 1.155470 0.969547 0.176177 1.193274 1.000806 0.167489 -0.087811 1.272916 0.090580 0.837388 0.853777 0.021673 0.795498 0.153088 -0.039163 0.886259 0.953876 0.846456 0.902225 0.108103 -0.023242 1.091272 0.796242 1.011212 0.961046 1.021211 0.039001 -0.032781 1.042170 1.131254 1.092307 0.999148 0.071362 0.869992 0.079822 1.110594 1.044065 1.166722 0.955017 0.117000 0.059709 1.113545 0.131377 1.023012 -0.114272 0.975103 0.983023 -0.046717 0.032378 0.224959 -0.069345 0.040516 1.089631 0.899237 0.136151 0.832552 1.215356 0.881670 0.944211 0.848668 0.152316 -0.124640 0.919395 0.853571 0.038901 0.049308 1.049839 -0.129701 1.004425 -0.052754 0.002949 -0.037696 0.133904 -0.020847 0.967100 0.902003 0.019567 -0.130260 -0.157473 -0.071944 0.135523 0.944472 -0.199005 -0.011428 -0.057531 1.218722 0.021172 0.873547 0.871952 0.950595 -0.066828 0.911583 0.960085 0.059484 1.216384 -0.015251 0.921576 1.107399 1.190526 1.009427 1.067453 1.067973 0.105850 -0.001821 0.968722 0.047666 0.095350 1.060487 0.951973 0.082517 1.139249 1.053557 0.799986 0.981175 0.927100 1.108483 -0.113217 0.056334 0.923079 -0.168060 1.160952 1.109659 0.931859 0.005663 0.016298 0.221144 -0.021547 1.134376 1.041640 -0.085720 1.009292 1.001582 0.885811 0.011233 0.110421 0.907129 0.093259 0.973361 0.842954 0.055170 1.054987 1.014198 -0.048044 0.812989 -0.144503 0.010466 1.029196 0.774851 0.843001 0.004633 1.225056 0.948512 -0.001831 -0.091454 -0.110441 0.000770 0.042991 0.840050 0.957463 0.073186 1.131453 -0.127608 1.100834 0.028867 0.991329 -0.079297 0.226099 1.081074 1.094744 -0.196334 -0.315150 -0.099639 0.860961 1.022403 0.767717 0.956186 1.242205 -0.055123 0.982544 1.115183 0.186049 0.867447 -0.036624 0.161043 -0.021433 0.029621 0.825744 0.027361 -0.010122 1.051195 0.027158 0.125747 -0.012676 1.018144 0.217569 -0.139580 1.065948 0.653885 0.017558 0.122910 1.005607 -0.024503 1.016854 0.118126 0.117812 0.209380 0.129761 0.103368 0.851695 0.818381 -0.060532 0.047740 1.092005 0.126179 -0.128900 1.046458 1.172438 0.945933 0.969409 0.186286 0.067827 0.866733 1.045200 1.053391 0.154799 -0.076177 1.034977 -0.251459 0.843987 1.036970 0.109710 1.081980 -0.054976 -0.104881 0.977835 0.917720 1.151081 1.224827 0.036178 1.178894 0.852252 1.170082 1.170461 0.979772 0.962385 0.904510 0.000036 -0.069878 0.919872 0.173255 1.075581 -0.013411 1.144951 -0.113696 0.013363 1.098609 1.014644 -0.003549 -0.244091 0.859325 1.071514 0.043866 1.123524 0.973631 0.994259 0.294619 0.940489 0.920230 0.796504 -0.004450 1.029035 -0.000831 0.920995 1.002150 0.986683 1.009523 1.089643 0.007497 1.152282 0.045887 1.088386 0.885838 -0.027924 0.051985 -0.076538 -0.224663 0.028256 -0.124194 0.724391 1.154873 0.792085 0.945537 1.154353 0.115964 0.986499 0.966811 1.012457 1.019910 -0.144866 0.815479 0.985586 0.913383 -0.150963 0.023412 -0.040408 -0.003953 0.004799 0.998876 0.002820 -0.098213 1.057293 -0.129926 0.137392 1.102538 1.079292 1.089070 1.130675 1.020925 1.154058 1.123118 0.858700 0.978386 0.138491 0.154692 1.041549 1.046975 1.030488 -0.158543 0.870238 0.064134 0.875614 -0.094478 0.900905 0.880022 1.134267 0.779059 0.063545 1.070040 -0.086015 1.008573 0.109322 -0.247240 0.015151 1.151193 -0.102164 0.087261 0.007995 0.854703 1.140979 -0.090975 0.812937 1.001838 0.168940 0.981369 -0.006072 -0.134631 1.058021 1.081911 0.004162 1.014677 0.995130 1.055979 -0.015306 0.058775 1.111668 0.059318 1.008648 0.996646 0.848989 -0.109175 1.102945 0.116474 0.906494 -0.120660 0.877452 0.886871 0.085411 0.884701 1.181621 1.062561 0.189097 0.973371 1.214908 0.001252 1.030678 0.152018 -0.037592 1.176813 0.948804 0.061120 1.019977 1.028438 -0.000808 0.087217 0.826864 0.893273 -0.207696 -0.074786 -0.108728 0.152240 -0.121688 0.980366 -0.049309 0.988905 0.044844 1.037851 0.979360 0.997856 1.209193 0.179051 1.004545 0.962175 1.139200 1.064077 0.021192 0.871727 0.976645 -0.060807 -0.016180 1.233966 0.984256 -0.044995 0.845917 0.182605 0.998382 0.007096 -0.023173 -0.024155 0.146239 1.013539 0.995536 0.048524 1.174691 1.141919 1.101145 -0.104732 0.114083 1.102748 0.983142 1.123097 -0.131915 1.072939 -0.138725 0.845004 -0.163152 -0.079593 1.018944 1.012216 0.030165 1.054447 0.994960 0.152361 -0.060656 1.093567 0.946563 0.106698 0.153793 -0.034551 1.295949 0.943407 -0.163119 0.067866 1.194305 0.979105 1.022403 1.106721 0.934941 -0.016105 1.092573 -0.050474 0.132465 0.025768 0.046448 0.920971 0.032186 0.827060 -0.132549 0.143363 0.083704 0.912578 -0.030293 0.096970 -0.039315 -0.023765 1.016646 0.854818 -0.052889 1.056921 0.089890 1.018924 0.081699 -0.114805 0.930082 -0.021013 0.109704 0.995297 -0.078029 1.125314 0.178931 0.020308 -0.221485 1.187702 0.047629 0.040061 1.015073 0.069320 0.060090 -0.115159 1.088644 -0.081572 0.068986 0.955768 0.084087 0.114901 1.013399 0.080815 -0.114939 1.007244 -0.059946 1.062447 1.043256 0.100314 1.021597 1.004933 -0.021577 -0.187720 -0.061395 -0.075323 -0.009496 0.985795 0.872323 -0.046461 0.888848 -0.053261 -0.110021 1.099191 0.979002 1.060305 1.062463 1.171427 0.691334 1.098940 0.054888 -0.017909 -0.010409 -0.111589 0.082490 0.948398 1.144871 0.127743 0.031811 1.026180 1.046146 -0.030210 -0.103802 0.989801 -0.310437 1.153393 1.012685 0.952894 1.001378 0.015652 1.054587 1.328504 -0.151531 1.037238 1.151575 0.030623 1.108802 -0.028053 0.044671 0.901073 0.934031 0.058498 0.039050 1.065155 0.024139 -0.131291 -0.082086 0.854526 1.154246 -0.049980 -0.184925 1.049877 -0.115467 -0.018300 1.001119 0.057983 1.189518 -0.114544 1.258100 1.123841 0.961039 1.070424 -0.124628 0.209509 0.034004 0.948762 1.100182 0.083224 0.948264 1.081482 0.076927 -0.000455 0.950737 0.098354 1.005742 1.019785 0.974317 0.230726 -0.067827 1.165865 0.048218 -0.058027 0.937849 0.079916 -0.012394 0.069161 0.050349 0.906284 0.832283 0.101171 0.790746 0.156878 0.740395 1.017554 0.191391 0.080956 1.000597 0.844203 0.944456 -0.111179 0.982617 1.037761 0.099785 0.851180 0.116591 0.142708 -0.015906 0.096645 0.965791 0.020953 0.925519 1.197465 -0.055737 1.095928 -0.064679 0.010255 0.936661 1.178645 0.190866 1.141107 0.130145 0.023056 0.121484 0.185090 -0.056773 0.100045 0.069574 1.039529 0.996635 1.085726 0.949189 -0.165723 -0.039203 1.116369 -0.064244 0.940174 -0.154655 1.121041 0.902088)
)
;;; 2048 prime --------------------------------------------------------------------------------
-#(2048 102.619 #(0 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1)
+(vector 2048 102.619 (fv 0 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 0 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 1 0 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1 1 1 0 0 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 0 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1 1 1 1 0 0 1 0 1 1 0 1 1 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 1 1 0 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1)
+
+ 95.904258 (fv 0.000000 -0.184827 -0.106502 -0.094974 0.803466 0.945074 0.963289 0.946874 -0.103266 0.049155 1.087214 0.886218 0.016107 0.059052 1.086003 0.896052 0.832875 0.168267 0.929954 0.104821 0.801629 0.032075 0.032796 0.227531 0.906532 1.124909 1.032850 0.878053 0.813900 -0.267885 0.885447 1.090714 0.853533 -0.000373 1.207049 0.922018 0.048308 0.893672 0.856221 0.975035 0.868154 0.098949 0.791588 1.196055 0.919249 -0.152557 0.991948 1.006717 1.133320 1.186246 0.920884 -0.060763 0.895777 0.020781 0.811521 0.941459 0.931533 0.044866 -0.116604 0.896466 0.029517 1.096540 0.918555 0.948344 0.929326 1.133930 0.012583 0.960301 1.199033 0.051836 1.012281 -0.182278 -0.104579 0.982487 0.083391 -0.235240 0.238134 0.851365 1.147123 -0.183897 0.931617 0.014719 0.969454 0.114930 -0.007528 0.927332 0.038357 0.920680 -0.081674 -0.182395 -0.011442 1.061361 0.921566 -0.084353 1.041705 0.161045 -0.067878 1.074036 0.941106 0.966219 0.919599 1.168159 1.032081 0.945189 0.044320 0.039817 -0.089720 1.130429 -0.069569 -0.278003 0.838588 0.754892 0.905296 0.076030 0.931578 0.143938 -0.063198 0.009752 0.994216 -0.018389 1.061023 0.998466 -0.064949 0.889855 -0.094736 -0.151667 1.224271 -0.191231 0.981083 0.017183 -0.228680 -0.064528 -0.051088 0.940309 1.101261 -0.034752 0.950794 -0.088223 1.190759 0.000979 1.058816 1.106846 0.070946 0.194156 1.093892 0.886993 1.017953 -0.051739 -0.284107 0.024602 0.969253 1.247816 0.935610 -0.089803 0.006657 0.841177 1.059923 1.023429 0.866137 0.046390 -0.124782 -0.252595 0.166144 1.083896 1.139053 0.949050 1.094868 1.174455 -0.189695 1.188365 1.031424 1.009889 1.067591 0.935164 0.237409 0.909064 0.009677 -0.177665 0.046406 1.016694 1.057379 -0.055836 0.052713 -0.065039 0.120813 0.836055 1.178838 0.902715 0.920359 0.806116 -0.117471 1.158887 0.994531 -0.009494 -0.163337 1.040739 1.131213 0.025531 -0.009616 0.139395 0.950856 -0.014744 0.115132 1.125894 -0.190579 0.101124 -0.125308 0.963704 0.026526 1.118700 0.022614 0.807945 0.913877 0.030742 0.927436 0.988232 -0.140750 0.124385 0.986885 0.991816 1.146772 -0.062919 0.074766 -0.034226 1.128490 0.957963 1.096308 1.046278 -0.048364 0.116505 1.136521 1.090002 -0.014238 -0.112155 1.033034 1.160610 -0.094599 0.068313 1.266010 1.098976 0.044651 0.131033 -0.116651 -0.075950 1.046348 0.030055 0.793219 -0.117150 1.124225 -0.160989 1.100541 1.045178 0.962828 -0.073358 -0.019227 1.173791 1.059709 0.937667 0.966884 0.928018 1.041334 -0.201315 0.174562 1.021851 -0.049449 0.907458 -0.107815 1.126703 0.073928 0.982065 0.825831 -0.033241 0.067472 0.917284 0.902681 1.015596 0.904075 -0.075353 -0.108265 0.963265 -0.090615 0.920339 0.977780 0.090733 0.904078 0.000883 1.347356 1.014221 0.985375 -0.100963 0.008783 0.942615 1.002685 1.149002 0.158462 0.917602 -0.099583 -0.025442 1.103430 0.071006 -0.151207 0.055689 -0.038941 0.098832 0.911418 1.062737 0.996744 0.760254 0.996130 0.014262 0.032851 0.956371 0.019061 0.996091 0.200667 1.164966 0.045741 0.060264 1.166834 -0.025387 0.966912 1.043716 0.969667 1.084931 -0.065039 0.974364 0.980017 0.844958 0.179207 0.723395 1.083973 -0.074447 0.912360 1.089065 1.005958 -0.119354 1.049441 0.937401 0.912303 0.937357 0.078173 0.927334 -0.094425 0.851189 0.132753 0.133028 1.043045 0.054936 -0.083812 0.903122 1.042637 1.178266 -0.107401 1.047050 -0.128737 0.160133 0.840861 0.896100 1.126802 0.903407 0.262267 0.053879 0.947798 -0.144016 -0.003985 0.146029 0.074915 0.771488 1.227288 0.890268 0.933106 1.075829 0.057968 0.066132 0.249704 -0.017827 0.090465 -0.047385 -0.060718 0.123360 0.988529 0.904277 -0.005465 -0.084169 -0.247831 0.999998 0.910292 1.144645 0.071091 0.088886 1.023713 -0.025414 0.984571 -0.240585 0.967555 -0.138539 0.196983 1.010405 -0.049670 -0.081707 0.064139 0.997860 0.836573 1.161272 -0.021657 0.041743 -0.127308 0.045553 0.018541 -0.044739 0.088082 0.142342 0.114457 1.055260 1.064567 -0.119380 -0.070251 -0.004341 0.963091 -0.120638 0.258819 1.053558 0.878500 1.069022 -0.123646 -0.014321 1.121295 1.085748 -0.044674 0.870738 0.685253 -0.051358 1.001113 -0.231350 0.033853 0.961438 0.037712 -0.113045 0.108555 1.037350 1.011749 1.028331 -0.080798 0.196328 0.059651 0.046311 0.977929 0.955683 -0.011917 0.990010 0.826271 0.043303 1.009806 1.189345 0.021063 0.072917 0.057585 0.061242 0.879010 0.849055 1.018528 0.955494 -0.055041 1.189587 -0.028346 -0.082984 0.099423 -0.024146 0.146930 -0.067314 0.849801 0.213148 0.924340 0.080454 0.905046 -0.129837 0.863551 -0.015056 1.161555 -0.111647 0.827215 0.819815 1.100249 1.048851 0.084224 1.096872 0.064524 1.027164 0.125925 0.828778 -0.032148 1.059894 1.017072 0.834004 -0.032573 -0.063582 1.159025 1.022326 0.063607 1.022556 1.099517 0.097842 0.150138 1.115534 0.951150 0.988949 0.155650 -0.134289 -0.115258 1.037176 1.021182 0.975772 1.072700 1.222345 0.924272 0.973662 0.930252 0.059705 0.077967 -0.109443 -0.103486 0.972696 -0.144205 0.802195 0.975677 0.802607 -0.042079 1.071307 1.022073 0.907916 1.035902 -0.048853 0.907965 0.883285 0.084385 -0.108649 0.944568 0.005988 0.933534 1.065312 -0.070265 -0.076879 -0.017044 -0.098932 1.208925 0.930986 -0.119229 -0.037509 1.090406 0.992176 -0.000651 0.937690 0.916741 -0.066544 1.095679 -0.058814 1.036581 -0.051849 -0.017058 -0.030283 0.051491 0.954183 0.950362 -0.021757 -0.062612 1.017252 0.855360 0.008584 0.998471 0.053177 -0.102277 -0.071410 -0.113602 0.020219 0.047660 0.112990 0.815120 1.152303 1.067537 1.052888 0.004076 0.157730 0.930208 0.885789 0.948613 1.018989 0.998994 -0.098675 0.134960 0.084711 0.092822 0.103312 -0.196457 1.024530 1.108457 0.891294 1.054699 1.016928 -0.022703 0.811591 1.004965 -0.017036 0.232325 0.973190 1.052258 1.071581 1.167101 -0.078778 1.126544 0.054092 0.108866 0.166665 1.087490 0.998143 -0.013409 0.871172 0.885040 1.019108 1.127064 1.196444 0.957927 0.852239 -0.008268 -0.145143 1.063054 -0.026011 1.007974 0.983277 -0.031336 1.126868 0.969557 0.015995 0.940510 0.206836 -0.166196 0.069999 0.106477 0.969534 0.962793 1.057184 0.039570 1.013939 0.966957 -0.186086 1.043328 0.103727 0.826020 0.082145 0.142187 0.193131 0.806568 -0.194497 0.073921 0.929470 0.014750 1.003891 1.130669 0.912871 -0.166896 -0.010434 0.224001 0.019969 0.882091 1.015999 0.050540 0.927299 -0.028913 0.088865 -0.038210 0.838785 0.179969 -0.063760 0.909551 0.970913 0.864195 -0.147216 1.017549 0.931612 1.076838 0.174334 -0.004854 1.146351 -0.071188 0.005023 0.983870 0.987921 -0.073293 1.144937 -0.008273 1.069178 0.160218 0.940671 -0.099513 -0.160986 -0.053460 -0.000349 -0.066930 0.258818 0.037651 0.899944 1.011860 -0.024019 0.049159 -0.114396 0.997122 0.988277 -0.086170 1.100402 0.827506 -0.071549 1.014472 0.830365 -0.029296 1.033932 -0.095907 -0.073030 0.967696 1.060165 0.920338 1.199129 -0.072200 0.053416 -0.126898 1.108390 0.903008 1.109424 0.964135 -0.083890 0.099047 -0.111937 1.079528 1.230021 1.124700 0.946124 1.081677 -0.089364 1.123287 0.082817 -0.048549 0.013111 -0.005217 1.016286 0.025359 -0.151572 1.137235 1.013948 1.006359 -0.020039 -0.117293 1.111762 0.892597 1.058754 0.795600 0.996014 0.931963 1.115786 -0.029889 0.877043 -0.234877 1.149674 1.027911 1.261517 0.048880 0.113954 -0.024127 0.075365 -0.048636 0.036252 0.831941 0.943628 0.982317 0.918776 1.086510 0.931126 -0.077364 0.039915 1.020953 -0.068839 0.962253 0.910823 0.025853 0.065365 0.021206 -0.021296 0.872652 0.026536 -0.052762 0.003250 0.029539 0.991921 1.021217 -0.042456 0.777756 0.980840 0.078981 -0.130613 0.133311 -0.065841 -0.085861 1.178451 0.115564 1.082062 1.015392 0.928586 0.967073 1.156891 -0.010223 0.936469 -0.154645 0.995277 1.073333 -0.010159 -0.073318 1.117785 0.123446 0.035440 0.914424 0.055982 1.255170 0.975126 0.021080 -0.037628 1.048938 0.871136 1.107293 0.955878 -0.056277 1.017033 0.090456 0.993267 0.757034 1.002409 0.941223 0.920711 1.181339 0.032023 -0.085516 0.974206 -0.026907 0.142086 -0.002800 0.952901 1.119119 1.039547 0.762175 1.056838 -0.114595 0.884738 0.718220 0.960728 -0.156479 1.189199 -0.165202 0.904637 -0.041429 -0.050488 -0.179745 1.054673 -0.082418 0.030881 1.160170 0.821960 -0.086297 0.010350 0.932553 0.035420 -0.009593 0.011040 0.051718 0.904123 0.028769 0.100605 1.033920 -0.169584 1.086360 1.131494 0.107596 -0.114123 0.021393 0.010364 -0.152848 0.035197 0.012279 -0.133590 -0.062321 1.204840 0.937029 -0.068386 1.145671 0.973614 1.135843 0.883055 0.070061 0.997608 1.003482 0.989245 1.204030 1.197676 0.838535 0.029369 -0.215349 1.060468 0.880276 0.931456 0.125650 1.132780 -0.117697 0.200533 0.075686 1.191015 1.016195 0.037000 1.110074 0.982317 0.982573 0.824837 -0.229925 1.006482 -0.062451 -0.057872 0.979641 -0.230341 -0.020939 1.006077 0.857917 1.098933 -0.267219 0.043265 0.935436 0.964162 -0.007168 0.164970 0.165342 1.068220 0.945315 0.948634 1.023862 -0.029831 0.992343 0.020292 0.067126 0.932456 0.808919 0.096733 0.000609 0.083113 1.019237 0.858419 1.013183 0.098990 0.930352 -0.062223 1.082324 -0.042610 1.104376 0.999943 -0.136202 0.964477 -0.092847 1.096219 1.036690 1.110447 0.987439 0.893158 0.111588 -0.094486 0.748732 0.981962 1.023640 1.021660 0.931300 1.325728 0.988586 0.832724 0.042650 -0.080219 -0.124412 0.083378 -0.047165 0.013229 0.179035 1.036229 0.106634 -0.154080 0.015828 -0.138512 0.228898 0.970943 1.152854 0.994299 1.087348 1.079495 -0.014073 0.985630 1.046303 0.921605 -0.148486 -0.082307 1.049524 0.140156 1.012720 0.976567 0.874688 -0.045198 1.031276 0.883380 0.011846 -0.003498 1.009216 0.885002 0.172619 0.843282 0.029227 -0.097679 -0.125796 0.933874 0.978897 0.725114 0.844720 1.075252 0.947844 0.926610 0.182857 0.841432 1.040159 0.998281 0.169201 0.136041 1.216461 0.161331 -0.074244 1.061895 0.862101 0.118827 1.150273 1.131402 0.028905 0.802992 -0.116645 0.004795 -0.035171 -0.225349 -0.011793 1.004637 1.052814 0.132105 0.965384 1.075721 0.233900 0.952135 0.901143 1.131006 0.032321 1.011176 0.873840 0.182329 -0.079077 0.896822 0.005166 0.903099 1.092780 -0.025076 -0.019178 0.015239 0.984311 1.216486 0.992874 0.054129 0.144836 0.099554 0.103521 0.100432 -0.026631 0.042079 0.163741 1.041917 0.792159 0.979852 0.977128 0.103524 1.113377 -0.157199 1.027202 0.929073 1.074076 -0.112317 0.199279 0.760239 0.001430 1.277148 0.009244 0.986963 0.109581 1.086070 -0.134094 0.327295 0.686709 -0.296672 0.932890 0.968488 0.216488 0.165531 0.285075 -0.094601 -0.165028 0.950486 0.963591 0.864035 -0.065266 1.013992 0.911092 -0.094152 -0.152792 1.070739 -0.039448 1.166353 -0.004048 0.032871 0.996625 1.100064 1.255396 0.839630 -0.081969 0.162263 0.140738 1.003998 0.779814 0.961648 1.146742 0.167212 0.925641 1.185256 0.824157 -0.033666 -0.007601 0.908697 0.230017 0.822888 0.740994 0.033372 1.160544 1.098836 -0.044005 1.021078 0.126042 0.049334 0.898357 1.032574 0.865757 0.947486 0.886121 0.055309 0.044278 -0.037421 1.134951 0.864539 -0.011595 -0.007199 0.067683 1.090102 1.092557 0.046997 0.027613 0.949146 0.875265 0.136983 -0.135656 0.985803 -0.132003 0.135341 0.013222 1.091309 1.098115 0.015599 0.119349 0.014805 1.069340 1.102334 1.032680 -0.031084 0.906554 -0.088863 0.069579 1.064396 0.128172 1.022790 1.107156 -0.057182 0.995012 1.054566 1.042520 -0.160709 1.125070 -0.094154 0.046403 -0.069345 0.119373 -0.184893 0.070830 1.044722 1.098693 1.111409 1.135049 0.985119 0.066473 0.058424 1.004842 -0.094015 1.117752 0.799547 1.268968 0.039520 0.996895 -0.102408 -0.030667 0.930842 1.078283 1.102597 0.055578 0.110127 0.923904 1.005813 0.918634 1.079133 -0.099263 0.905943 1.047321 0.848243 -0.009403 -0.068258 1.012623 -0.037975 1.142196 0.851851 0.109046 1.141382 0.890904 0.996832 -0.088058 1.288646 1.097971 -0.100491 0.918525 0.015332 1.145115 0.117738 1.014796 -0.205627 -0.177297 -0.006318 0.055035 1.183699 0.900390 1.055439 1.182836 0.107470 0.210820 -0.154634 1.100666 0.004257 0.125613 0.849489 1.120995 -0.046236 -0.066772 0.011079 -0.102932 0.932197 0.023264 0.246085 0.163405 0.869069 0.102531 1.077511 0.954854 0.038602 0.079792 0.927047 0.983181 1.030696 0.962590 -0.055603 -0.107934 1.126555 0.946728 1.063664 0.137033 -0.128875 0.885196 0.091522 0.893839 1.007955 0.978475 0.978266 0.067848 1.038168 1.090875 -0.061309 1.116028 1.016019 0.011872 -0.108054 0.108874 0.083760 0.113696 1.116111 0.014309 0.005128 1.099189 -0.004973 1.325065 1.221479 0.028469 1.235019 -0.212490 0.962518 1.027151 -0.044149 0.142639 0.155400 0.936540 -0.039180 0.937115 -0.085578 1.019973 1.270603 0.140594 0.061038 1.087655 0.063712 1.177018 -0.029958 0.758319 0.051019 -0.094233 0.962416 -0.006348 -0.003660 0.019678 1.112579 1.058837 -0.108754 0.005081 0.979604 0.909652 -0.162160 0.189741 1.115396 -0.046934 0.809487 0.174222 -0.004756 1.140939 0.812895 0.050537 0.171915 -0.128895 0.969610 0.953147 1.047572 0.122563 0.889198 -0.104048 0.001916 -0.008785 1.172703 -0.213570 -0.114233 -0.152007 -0.161789 -0.132968 1.055565 0.784424 0.202349 -0.012066 0.004158 -0.039121 1.114936 0.962613 0.954226 1.105200 0.985756 1.026320 -0.117780 0.866616 1.000189 -0.163224 0.999105 1.165142 0.001717 1.023313 -0.052468 -0.233246 -0.078417 -0.014831 0.008989 0.105092 1.100102 -0.114187 0.962275 0.827359 -0.135499 1.155899 0.983914 -0.197096 0.920622 0.925756 0.074101 1.105182 0.068112 0.889324 0.995794 -0.181975 1.079197 -0.174077 -0.086147 1.108775 0.836038 0.920177 0.069115 1.056833 1.065288 1.011220 0.037095 -0.051383 0.059023 0.966919 0.975420 0.992209 -0.050411 1.034776 0.060947 0.024827 0.189251 1.128565 -0.026102 0.882647 1.113292 0.059688 -0.055524 1.097931 -0.076831 0.148308 0.009684 0.993343 0.181407 0.980680 -0.253676 1.203786 0.837538 -0.111906 -0.046920 0.992998 1.138650 0.102810 0.732933 0.974495 1.134363 0.841220 -0.244832 0.191984 1.089926 -0.014286 1.033093 0.795315 0.027888 1.086315 0.921910 0.023081 1.023830 0.070684 1.183612 -0.197469 -0.072227 1.175515 1.132615 0.147372 1.165071 0.693358 0.086944 0.167356 1.154251 0.067038 1.011388 0.195281 0.162053 0.058855 0.118483 1.091391 1.199083 0.861074 0.152693 -0.184650 -0.275426 0.016699 1.041744 1.082925 0.896020 -0.212005 -0.028325 0.837564 1.192865 0.964038 1.140280 0.832699 0.060523 1.017736 0.007067 1.222558 0.776881 1.025602 0.136510 1.065558 0.031534 1.120667 -0.017440 -0.095844 0.986588 0.811881 1.008160 1.083596 -0.057608 1.030774 -0.185755 1.016553 -0.060277 0.044570 0.071469 1.026382 -0.218238 -0.134819 0.125155 1.052665 0.219534 1.053074 0.975626 0.942097 0.042773 0.914988 0.904458 1.068383 0.122945 -0.160737 0.195111 -0.112309 0.079404 0.873713 0.743694 -0.042029 0.017013 1.026689 -0.033216 0.846494 1.151063 -0.096712 0.933521 -0.150138 0.998351 0.097766 1.014397 1.003826 0.249110 -0.089820 -0.095115 -0.041617 1.005328 -0.026956 0.282608 -0.227117 0.900497 0.151081 1.074944 0.999410 0.070956 0.989252 1.046830 0.036838 0.060586 0.119680 1.033878 1.147593 1.072223 1.038019 -0.063806 -0.066418 -0.094579 0.121532 0.058665 0.065637 0.015630 1.033625 -0.167401 -0.044227 0.109799 1.069494 0.978455 0.951966 0.848373 1.183717 0.052564 -0.139052 0.109210 1.056692 1.084067 0.913136 0.026099 0.888367 1.004145 -0.006357 -0.186626 1.147417 0.008987 1.033956 0.198511 1.087879 0.153898 -0.007073 -0.053729 0.960733 -0.079153 -0.112602 0.118601 1.127696 0.124208 -0.118455 1.113389 -0.141400 0.095581 0.831887 0.079625 1.065606 1.064953 -0.043117 0.883460 -0.117838 0.984417 1.073930 -0.020071 -0.020565 -0.110661 -0.029427 0.000735 0.129840 -0.059144 0.853604 0.029159 1.153760 -0.035371 0.120975 0.829886 0.902305 0.004019 1.024841 -0.008315 -0.040841 0.081011 0.034157 0.925135 0.026143 -0.146226 0.818801 0.997553 -0.057337 0.039344 0.045043 -0.058730 0.061450 0.034397 0.032312 1.021479 0.069734 0.032385 -0.034352 1.143739 0.128130 0.837756 0.143447 1.191780 1.005715 -0.145746 0.060156 -0.089751 0.993522 1.117964 1.113924 -0.051214 0.989301 1.131346 0.978070 1.120586 -0.104089 0.755209 0.911168 0.043338 0.799533 -0.065789 1.035956 1.103884 1.108033 -0.011160 0.018199 1.076458 1.033226 1.049461 0.927281 0.875446 -0.132488 -0.016539 1.040494 -0.085837 0.845351 0.082137 0.957295 0.975488 -0.233161 1.046308 0.968283 1.119329 0.799388 0.835437 1.198178 1.006967 -0.080996 1.022071 0.222670 1.054955 1.028112 0.145964 0.775125 0.053077 -0.139928 0.982870 0.012204 1.181785 -0.055209 0.064440 0.028436 -0.055658 0.988257 0.885626 0.925751 1.041503 -0.102556 0.199169 0.817618 1.118232 -0.154162 1.103379 0.161217 0.043204 0.038827 0.297793 0.101115 1.084585 0.911258 -0.017387 1.093864 1.174369 -0.052884 1.010587 1.084918 1.042023 0.988052 1.008470 1.079842 0.911711 -0.105412 1.049916 0.966051 -0.030853 0.634323 0.027996 0.065373 0.165603 -0.198745 0.121133 0.904870 0.798116 0.109313 -0.023197 -0.012270 -0.099679 -0.007982 0.957938 0.064886 1.066324 0.891833 0.030809 0.008848 -0.058683 1.151904 -0.064909 0.005548 0.092447 0.994226 0.980543 0.036553 0.977629 0.908112 1.053035 1.015332 1.120582 1.029707 0.935519 0.767415 -0.107332 1.106993 0.051063 -0.090849 -0.152447 1.074408 0.930237 -0.134191 -0.041339 1.154220 0.912402 0.915882 -0.155688 0.004278 1.005960 -0.029173 0.929692 0.891253 0.904414 -0.022210 0.912185 0.032760 -0.175809 1.064184 0.004444 1.023131 0.014814 0.025559 0.065555 0.781532 -0.029379 -0.197955 0.897852 -0.013217 1.093294 0.004968 -0.102189 1.031592 0.748643 0.996666 0.053363 -0.174095 0.022123 1.073767 0.026629 0.817199 0.923850 0.016734 1.000997 0.181206 0.011231 0.956073 0.190711 0.864217 -0.176983 1.016978 1.028389 0.023092 0.841323 1.197465 -0.032185 -0.023935 -0.154948 0.938794 0.022079 0.018001 0.863273 0.095137 -0.103529 1.048691 1.044424 1.076913 -0.091685 1.016448 0.235867 -0.191122 1.021688 0.903834 1.103008 1.062811 0.974671 0.808982 0.919788 0.797299 0.003866 0.924240 1.138022 1.138392 -0.086041 -0.072381 1.089510 0.997304 -0.196238 -0.081117 0.998652 -0.136927 1.094476 1.025478 1.128812 -0.043799 -0.160622 1.202644 -0.097115 1.028359 1.128248 1.149200 0.046912 1.215106 0.095300 0.230991 -0.177631 1.060265 0.025009 -0.087069 -0.045585 0.107297 0.905981 1.067101 1.105134 0.200901 0.832244 -0.158358 0.063741 -0.002433 0.178939 1.150184 -0.013758 0.739082 0.970621 1.116445 -0.077580 0.874011 -0.000811 0.757786 1.027494 0.948749 0.128206 1.197540 -0.121973 -0.035650 0.227456 1.012591 0.093402 0.788900 0.046330 1.127347 0.937960 0.147998 0.295156 0.047168 -0.449697 1.185666 1.027567 1.056837 0.896828 0.093411 0.188188 1.051113 0.196550 0.986178 0.963111 1.064836 0.986799 0.068409 0.940694 0.044600 0.930849 0.776664 1.119660 0.877476 -0.187121 0.889222 0.896426 1.114193 0.109176 0.974296 0.017034 0.058848 0.003626 -0.056434 -0.053055 -0.327863 1.110462 1.191687 0.833810 -0.093180 1.062518 0.877602 0.130458 1.046517 0.945395 -0.042202 0.884421 0.076614 0.998365 0.963405 -0.042360 1.233324 1.032498 0.850640 0.878991 1.172081 -0.131938 0.138522 1.031223 -0.060356 1.045766 1.146384 1.014251 1.035122 1.033944 0.910994 0.140291 0.017496 0.074785 0.017803 1.051564 0.940908 1.102397 0.914000 -0.151381 -0.037398 0.841172 0.980431 0.926522 1.010521 0.906633 0.898542 -0.046207 1.056040 -0.119697 -0.388635 1.042092 1.062407 -0.114191 0.973897 0.038767 0.170771 0.104476 0.108748 0.973779 0.829369 0.903094)
)
)
)
@@ -3422,1117 +3335,951 @@
(define neven-min-peak-phases (vector
-#(1 1.0 #(0)
+(vector 1 1.0 (fv 0)
)
-#(2 1.7601724863052 #(0 0)
+(vector 2 1.7601724863052 (fv 0 0)
)
;;; 3 even --------------------------------------------------------------------------------
-#(3 2.2325525283813 #(0 0 0)
- 2.0235652605711 #(0 33/64 63/128)
+(vector 3 2.2325525283813 (fv 0 0 0)
+ 2.0235652605711 (fv 0 33/64 63/128)
- 2.0214650630951 #(0.0 0.52414411306381 0.48787820339203)
- 2.021465 #(0.000000 0.475854 0.512123)
- 2.021465 #(0.000000 0.524145 0.487877)
- 2.021465 #(0.000000 1.475854 1.512123) ; etc
+ 2.0214650630951 (fv 0.0 0.52414411306381 0.48787820339203)
+ 2.021465 (fv 0.000000 0.475854 0.512123)
+ 2.021465 (fv 0.000000 0.524145 0.487877)
+ 2.021465 (fv 0.000000 1.475854 1.512123) ; etc
)
;;; 4 even --------------------------------------------------------------------------------
-#(4 2.8359191417694 #(0 0 0 0)
- 2.450505601523 #(0 3/16 21/32 15/32)
+(vector 4 2.8359191417694 (fv 0 0 0 0)
+ 2.450505601523 (fv 0 3/16 21/32 15/32)
- ;2.434727537119 #(0 37 52 46) / 31
+ ;2.434727537119 (fv 0 37 52 46) / 31
- 2.4311048984528 #(0.000 0.191 0.672 0.479)
- 2.4311048984528 #(0.000 0.809 0.328 0.521)
+ 2.4311048984528 (fv 0.000 0.191 0.672 0.479)
+ 2.4311048984528 (fv 0.000 0.809 0.328 0.521)
- ;; (optit :even 4 1/4 (expt 2 -100) 2.8359191417694 #(0 0 0 0))
- 2.4308773660653 #(0.0 -1.907463741733863571425899863243103027344E-1 -6.709215487223971763341978657990694046021E-1 -4.783757035623090736464746441924944519997E-1)
+ ;; (optit :even 4 1/4 (expt 2 -100) 2.8359191417694 (fv 0 0 0 0))
+ 2.4308773660653 (fv 0.0 -1.907463741733863571425899863243103027344E-1 -6.709215487223971763341978657990694046021E-1 -4.783757035623090736464746441924944519997E-1)
- ;; (optit :even 4 1/4 (expt 2 -100) 2.450505601523 #(0 3/16 21/32 15/32))
- 2.430877366065 #(0.0 1.907463741737958073940717440564185380936E-1 6.709215487230322239042834553401917219162E-1 4.783757035631506226991405128501355648041E-1)
- 2.4305741786957 #(0.0 0.19146482345276 0.67236139177392 0.47990912646831)
+ ;; (optit :even 4 1/4 (expt 2 -100) 2.450505601523 (fv 0 3/16 21/32 15/32))
+ 2.430877366065 (fv 0.0 1.907463741737958073940717440564185380936E-1 6.709215487230322239042834553401917219162E-1 4.783757035631506226991405128501355648041E-1)
+ 2.4305741786957 (fv 0.0 0.19146482345276 0.67236139177392 0.47990912646831)
)
;;; 5 even --------------------------------------------------------------------------------
-#(5 2.816308259964 #(0 1 0 0 0)
+(vector 5 2.816308259964 (fv 0 1 0 0 0)
- 2.6048328876495 #(0.0 1.7889379262924 0.49464252591133 0.018512051552534 0.013387856073678)
+ 2.6048328876495 (fv 0.0 1.7889379262924 0.49464252591133 0.018512051552534 0.013387856073678)
- 2.604848 #(0.000000 0.211049 1.505353 1.981536 -0.013355)
+ 2.604848 (fv 0.000000 0.211049 1.505353 1.981536 -0.013355)
)
;;; 6 even --------------------------------------------------------------------------------
-#(6 2.9795869831363 #(0 0 1 0 0 0)
- 2.9795892238617 #(0 1 0 1 1 1)
+(vector 6 2.9795869831363 (fv 0 0 1 0 0 0)
- 2.8369779013614 #(0.0 0.17925976781335 1.4035822186281 0.79344665247706 0.91203230191116 1.0958477007498)
+ 2.8369779013614 (fv 0.0 0.17925976781335 1.4035822186281 0.79344665247706 0.91203230191116 1.0958477007498)
- 2.836991 #(0.000000 0.178390 1.402472 0.792230 0.912414 1.093877)
- 2.836980 #(0.000000 1.821818 0.597785 1.208038 1.087532 0.906567)
- 2.836978 #(0.000000 1.178373 0.402442 1.792189 1.912334 0.093818)
- 2.836972 #(0.000000 1.178483 0.402570 -0.207680 -0.087726 0.094035)
- 2.836966 #(0.000000 0.821717 1.597697 0.207985 0.087685 -0.093549)
+ 2.836991 (fv 0.000000 0.178390 1.402472 0.792230 0.912414 1.093877)
+ 2.836980 (fv 0.000000 1.821818 0.597785 1.208038 1.087532 0.906567)
+ 2.836978 (fv 0.000000 1.178373 0.402442 1.792189 1.912334 0.093818)
+ 2.836972 (fv 0.000000 1.178483 0.402570 -0.207680 -0.087726 0.094035)
+ 2.836966 (fv 0.000000 0.821717 1.597697 0.207985 0.087685 -0.093549)
+ 2.836953 (fv 0.000000 0.821609 1.597559 0.207843 0.087745 -0.093780)
)
;;; 7 even --------------------------------------------------------------------------------
-#(7 3.4936672673663 #(0 0 0 0 1 0 0)
- 3.3825581073761 #(0 0 0 0 0 1 0)
+(vector 7 3.3825581073761 (fv 0 0 0 0 0 1 0)
- 3.0470769405365 #(0.0 0.503662109375 0.87483215332031 1.0009307861328 1.2656555175781 0.71012878417969 0.30850219726562)
- 3.0469672679901 #(0.0 0.50373814372209 0.87540721456314 1.0012873875657 1.2663739438299 0.71078327011007 0.30959991380794)
+ 3.0470769405365 (fv 0.0 0.503662109375 0.87483215332031 1.0009307861328 1.2656555175781 0.71012878417969 0.30850219726562)
+ 3.0469672679901 (fv 0.0 0.50373814372209 0.87540721456314 1.0012873875657 1.2663739438299 0.71078327011007 0.30959991380794)
+ 3.046965 (fv 0.000000 0.503616 0.874674 1.000689 1.265332 0.709676 0.308046)
)
;;; 8 even --------------------------------------------------------------------------------
-#(8 3.7968969947382 #(0 0 1 1 0 0 0 0)
- 3.7706393073421 #(0 1 0 1 1 0 0 0)
- 3.611234664917 #(0 0 0 0 0 1 0 0)
-
- 3.197691 #(0.000000 1.463442 0.984712 1.413077 0.862890 0.889575 1.684691 1.613214)
- 3.197689 #(0.000000 0.536983 1.016250 0.588185 1.138902 1.112562 0.318083 0.389844)
- 3.197673 #(0.000000 0.463394 -0.015494 0.412641 1.862274 -0.111008 0.683799 0.612199)
- 3.197643 #(0.000000 1.536907 0.016088 1.587997 0.138641 0.112256 1.317694 1.389405)
+(vector 8 3.611234664917 (fv 0 0 0 0 0 1 0 0)
+
+ 3.197691 (fv 0.000000 1.463442 0.984712 1.413077 0.862890 0.889575 1.684691 1.613214)
+ 3.197689 (fv 0.000000 0.536983 1.016250 0.588185 1.138902 1.112562 0.318083 0.389844)
+ 3.197673 (fv 0.000000 0.463394 -0.015494 0.412641 1.862274 -0.111008 0.683799 0.612199)
+ 3.197643 (fv 0.000000 1.536907 0.016088 1.587997 0.138641 0.112256 1.317694 1.389405)
+ 3.197539 (fv 0.000000 1.536753 0.015811 1.587753 0.138248 0.111716 1.317048 1.388715)
)
;;; 9 even --------------------------------------------------------------------------------
-#(9 4.1871630323114 #(0 1 1 0 0 0 0 1 0)
- 4.1397546805979 #(0 0 1 0 0 0 1 1 1)
- 4.0601739883423 #(0 0 0 0 0 0 1 1 0)
-
- 3.454235 #(0.000000 1.380130 1.542684 1.103203 1.094600 0.755189 1.642794 1.504783 0.092364)
- 3.454343 #(0.000000 0.380149 0.542653 0.103243 0.094157 1.755278 0.642603 0.504207 1.092117)
- 3.454167 #(0.000000 1.619814 1.457133 1.896576 1.905245 0.244460 1.356830 1.494866 0.907164)
- 3.454104 #(0.000000 1.619789 1.457225 1.896592 1.905347 0.244468 1.356940 1.495046 0.907280)
+(vector 9 4.0601739883423 (fv 0 0 0 0 0 0 1 1 0)
+
+ 3.454235 (fv 0.000000 1.380130 1.542684 1.103203 1.094600 0.755189 1.642794 1.504783 0.092364)
+ 3.454343 (fv 0.000000 0.380149 0.542653 0.103243 0.094157 1.755278 0.642603 0.504207 1.092117)
+ 3.454167 (fv 0.000000 1.619814 1.457133 1.896576 1.905245 0.244460 1.356830 1.494866 0.907164)
+ 3.454104 (fv 0.000000 1.619789 1.457225 1.896592 1.905347 0.244468 1.356940 1.495046 0.907280)
+ 3.453978 (fv 0.000000 1.619848 1.457320 1.896841 1.905503 0.244896 1.357384 1.495389 0.907798)
)
;;; 10 even --------------------------------------------------------------------------------
-#(10 4.1456241150012 #(0 0 0 1 1 0 0 0 0 0)
- 4.0054845809937 #(0 1 1 0 0 0 0 0 1 0)
+(vector 10 4.0054845809937 (fv 0 1 1 0 0 0 0 0 1 0)
- 3.559069 #(0.000000 0.728493 1.283356 1.458356 0.068046 1.297046 -0.008724 1.763762 1.458102 1.082546)
- 3.559031 #(0.000000 1.271816 0.716134 0.541742 -0.068143 0.702758 0.008941 0.237259 0.543599 0.918279)
- 3.558934 #(0.000000 0.270311 1.713387 1.540231 0.930533 1.700561 1.006089 1.239216 1.544459 1.919820)
+ 3.559069 (fv 0.000000 0.728493 1.283356 1.458356 0.068046 1.297046 -0.008724 1.763762 1.458102 1.082546)
+ 3.559031 (fv 0.000000 1.271816 0.716134 0.541742 -0.068143 0.702758 0.008941 0.237259 0.543599 0.918279)
+ 3.558934 (fv 0.000000 0.270311 1.713387 1.540231 0.930533 1.700561 1.006089 1.239216 1.544459 1.919820)
+ 3.558711 (fv 0.000000 0.271020 1.715408 1.541006 0.931409 1.702058 1.007613 1.237445 1.543048 1.918285)
)
;;; 11 even --------------------------------------------------------------------------------
-#(11 4.2814919726737 #(0 1 1 1 0 1 1 0 1 1 1)
- 4.8058149616573 #(0 0 0 1 0 1 0 0 0 0 0)
- 4.2754249521261 #(0 1 0 1 0 0 1 1 1 1 1)
- 4.2368197441101 #(0 0 1 1 0 1 1 1 0 0 0)
+(vector 11 4.2368197441101 (fv 0 0 1 1 0 1 1 1 0 0 0)
- 3.656997 #(0.000000 0.364553 0.246524 0.545081 1.820586 -0.010486 0.065265 0.895857 0.689390 0.398119 1.238723)
- 3.656853 #(0.000000 0.636042 0.753996 0.455733 1.180490 1.011649 0.936897 0.106845 0.312362 0.605377 1.764604)
- 3.656814 #(0.000000 1.363823 1.245209 1.543687 0.818338 0.986715 1.061848 1.892251 1.683956 1.393470 0.233084)
- 3.656676 #(0.000000 1.635670 1.752596 1.453762 0.177717 0.008296 -0.065661 1.103599 1.306278 1.601279 0.759437)
+ 3.656997 (fv 0.000000 0.364553 0.246524 0.545081 1.820586 -0.010486 0.065265 0.895857 0.689390 0.398119 1.238723)
+ 3.656853 (fv 0.000000 0.636042 0.753996 0.455733 1.180490 1.011649 0.936897 0.106845 0.312362 0.605377 1.764604)
+ 3.656814 (fv 0.000000 1.363823 1.245209 1.543687 0.818338 0.986715 1.061848 1.892251 1.683956 1.393470 0.233084)
+ 3.656676 (fv 0.000000 1.635670 1.752596 1.453762 0.177717 0.008296 -0.065661 1.103599 1.306278 1.601279 0.759437)
+ 3.656141 (fv 0.000000 1.635206 1.752773 1.453484 0.177816 0.008586 -0.066147 1.102294 1.308244 1.599463 0.758738)
)
;;; 12 even --------------------------------------------------------------------------------
-#(12 4.5077774785482 #(0 1 0 1 1 0 1 1 1 0 0 0)
- 4.4722682088655 #(0 1 0 0 1 0 0 0 0 1 1 1)
- 4.4100483425078 #(0 0 0 1 1 0 1 0 0 0 0 0)
+(vector 12 4.4100483425078 (fv 0 0 0 1 1 0 1 0 0 0 0 0)
- 3.788546 #(0.000000 1.556167 0.360103 0.557527 1.272879 -0.160667 1.208794 0.416499 0.207991 0.153798 0.406432 0.105283)
- 3.788220 #(0.000000 0.550342 1.343009 1.534780 0.244087 0.805462 0.167902 1.368575 1.154099 1.090872 1.336846 1.030125)
- 3.787893 #(0.000000 0.448349 1.651266 1.457646 0.745846 0.182779 0.817835 1.614340 -0.173074 -0.112402 -0.361602 -0.056645)
- 3.787770 #(0.000000 1.448638 0.653979 0.460567 1.750296 1.187409 1.823828 0.621465 0.835166 0.896814 0.649295 0.954712)
- 3.787607 #(0.000000 1.552098 0.349619 0.543969 1.255255 1.818801 1.184427 0.387699 0.175349 0.115468 0.364328 0.059990)
- 3.787594 #(0.000000 0.551763 1.347551 1.541126 0.252553 0.815620 0.180247 1.383525 1.170726 1.109400 1.357991 1.052935)
+ 3.787770 (fv 0.000000 1.448638 0.653979 0.460567 1.750296 1.187409 1.823828 0.621465 0.835166 0.896814 0.649295 0.954712)
+ 3.787607 (fv 0.000000 1.552098 0.349619 0.543969 1.255255 1.818801 1.184427 0.387699 0.175349 0.115468 0.364328 0.059990)
+ 3.787594 (fv 0.000000 0.551763 1.347551 1.541126 0.252553 0.815620 0.180247 1.383525 1.170726 1.109400 1.357991 1.052935)
+ 3.786929 (fv 0.000000 0.551301 1.345490 1.538545 0.249324 0.811835 0.175379 1.377915 1.164645 1.102028 1.349918 1.044104)
)
;;; 13 even --------------------------------------------------------------------------------
-#(13 4.7678911684727 #(0 1 1 0 0 1 0 1 0 0 0 0 0)
- 4.4552875568415 #(0 1 0 0 1 1 0 1 0 1 1 1 1)
- 4.4076361656189 #(0 0 1 0 1 1 0 0 1 1 1 1 1)
+(vector 13 4.4076361656189 (fv 0 0 1 0 1 1 0 0 1 1 1 1 1)
- 3.973640 #(0.000000 0.230119 1.573121 1.035418 0.607827 0.004639 0.570316 1.864444 0.017841 1.712936 0.049649 0.243649 0.758519)
- 3.973518 #(0.000000 1.227848 0.569459 0.032525 1.602849 0.995992 1.561449 0.851502 1.005100 0.700156 1.033637 1.225072 1.740227)
- 3.973285 #(0.000000 0.221343 1.559694 1.013474 0.580564 -0.035047 0.522724 -0.190833 -0.044249 1.645456 -0.025041 0.160741 0.667019)
- 3.973148 #(0.000000 0.225623 1.564256 1.022022 0.590378 -0.019884 0.539658 -0.171656 -0.022033 1.670109 0.001495 0.190555 0.699291)
- 3.973041 #(0.000000 0.226214 1.565751 1.024299 0.592784 -0.015292 0.545848 -0.164098 -0.014254 1.677783 0.010954 0.201582 0.710821)
+ 3.973518 (fv 0.000000 1.227848 0.569459 0.032525 1.602849 0.995992 1.561449 0.851502 1.005100 0.700156 1.033637 1.225072 1.740227)
+ 3.973285 (fv 0.000000 0.221343 1.559694 1.013474 0.580564 -0.035047 0.522724 -0.190833 -0.044249 1.645456 -0.025041 0.160741 0.667019)
+ 3.973148 (fv 0.000000 0.225623 1.564256 1.022022 0.590378 -0.019884 0.539658 -0.171656 -0.022033 1.670109 0.001495 0.190555 0.699291)
+ 3.973041 (fv 0.000000 0.226214 1.565751 1.024299 0.592784 -0.015292 0.545848 -0.164098 -0.014254 1.677783 0.010954 0.201582 0.710821)
+ 3.972554 (fv 0.000000 0.227025 1.566229 1.025033 0.594027 -0.014872 0.545046 -0.165560 -0.014836 1.678196 0.010096 0.200561 0.709954)
)
;;; 14 even --------------------------------------------------------------------------------
-#(14 4.6162051765776 #(0 0 1 0 1 0 0 1 1 0 0 0 0 0)
- 4.5770673751831 #(0 1 1 0 0 1 1 1 1 1 1 0 1 0)
+(vector 14 4.5770673751831 (fv 0 1 1 0 0 1 1 1 1 1 1 0 1 0)
- 4.099610 #(0.000000 -0.080758 -0.027479 0.199399 0.386347 0.449299 0.202554 1.784429 1.717900 0.329527 0.954548 -0.264053 0.856281 0.353663)
- 4.099044 #(0.000000 0.064712 0.002392 1.758239 1.562496 1.488613 1.718784 0.123849 0.177636 1.552432 0.915397 0.118052 0.982785 1.477200)
- 4.098933 #(0.000000 1.064573 1.002412 0.758783 0.562663 0.489006 0.720164 1.124184 1.179525 0.554249 1.917231 1.120737 -0.014393 0.478996)
- 4.098145 #(0.000000 1.929164 -0.010969 0.226671 0.421687 0.490908 0.253400 1.847703 1.785923 0.405487 1.039797 -0.170604 0.960326 0.465294)
- 4.097747 #(0.000000 0.927497 0.986240 1.222647 1.417439 1.485272 1.245695 0.840056 0.775783 1.393795 0.027626 0.815063 1.945062 1.449403)
+ 4.097747 (fv 0.000000 0.927497 0.986240 1.222647 1.417439 1.485272 1.245695 0.840056 0.775783 1.393795 0.027626 0.815063 1.945062 1.449403)
+ 4.096703 (fv 0.000000 0.927014 0.985352 1.221418 1.415761 1.483290 1.243140 0.836933 0.772657 1.390170 0.023348 0.810693 1.940171 1.444293)
)
;;; 15 even --------------------------------------------------------------------------------
-#(15 4.949674522378 #(0 1 1 1 0 0 0 0 1 0 0 0 1 0 0)
- 4.8773546682689 #(0 1 1 0 0 0 1 1 0 1 0 0 0 0 0)
- 4.7838921546936 #(0 0 0 0 0 1 1 1 1 0 1 1 1 0 1)
+(vector 15 4.7838921546936 (fv 0 0 0 0 0 1 1 1 1 0 1 1 1 0 1)
- 4.199573 #(0.000000 0.504296 0.613533 0.293607 0.288557 1.021780 0.287132 0.744077 -0.060941 1.352372 0.993154 1.256681 1.521460 0.388861 0.364865)
- 4.197351 #(0.000000 0.630844 0.628794 1.068650 1.167425 0.572395 1.431155 1.077518 0.027658 0.719923 1.211198 1.055057 0.880835 0.189555 0.316525)
- 4.193772 #(0.000000 1.675587 1.705815 0.187561 0.316258 1.764366 0.667280 0.345731 1.343497 0.068095 0.602689 0.479768 0.335628 1.703907 1.864339)
- 4.193545 #(0.000000 1.673990 1.704095 0.184742 0.312157 1.759699 0.661838 0.338558 1.336129 0.060082 0.592895 0.470075 0.323799 1.690560 1.851587)
- 4.193539 #(0.000000 1.674972 1.705674 0.187574 0.315997 1.764079 0.667192 0.344813 1.343115 0.068186 0.601740 0.479341 0.334140 1.702389 1.863580)
+ 4.193545 (fv 0.000000 1.673990 1.704095 0.184742 0.312157 1.759699 0.661838 0.338558 1.336129 0.060082 0.592895 0.470075 0.323799 1.690560 1.851587)
+ 4.193539 (fv 0.000000 1.674972 1.705674 0.187574 0.315997 1.764079 0.667192 0.344813 1.343115 0.068186 0.601740 0.479341 0.334140 1.702389 1.863580)
+ 4.192089 (fv 0.000000 1.673474 1.702683 0.182852 0.310553 1.756894 0.658556 0.335052 1.332116 0.055950 0.587971 0.464438 0.317829 1.684035 1.844319)
)
;;; 16 even --------------------------------------------------------------------------------
-#(16 5.1845584915919 #(0 0 0 0 0 0 1 1 1 0 0 1 1 0 1 0)
- 5.1708735549117 #(0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1)
- 5.1363370276686 #(0 0 0 0 0 0 0 0 1 0 1 1 0 0 0 1)
- 5.0737318992615 #(0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0)
+(vector 16 5.0737318992615 (fv 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 0)
- 4.396519 #(0.000000 1.090547 1.139126 -0.009529 0.458824 0.778347 -0.106183 1.308832 1.218737 0.200208 0.290540 0.016830 0.423513 0.112582 0.603363 0.004222)
- 4.353701 #(0.000000 0.561831 0.989050 1.195832 1.557580 0.017410 0.685599 1.728228 0.371692 0.005402 0.173541 0.126093 1.783105 1.542090 0.769507 0.225043)
- 4.328579 #(0.000000 -0.050344 1.847492 1.547825 1.358460 0.943178 0.995171 1.405548 1.304846 1.241639 0.001478 0.213619 1.127944 0.266623 1.638359 0.274327)
- 4.326872 #(0.000000 0.955614 0.859979 0.567169 0.385493 -0.026738 0.033152 0.450270 0.355426 0.300069 1.068503 1.286708 0.206676 1.350539 0.730076 1.370356)
- 4.326467 #(0.000000 0.954646 0.857741 0.564427 0.380619 -0.030405 0.027220 0.443651 0.347240 0.290827 1.057423 1.274647 0.193509 1.337335 0.715554 1.355809)
- 4.326323 #(0.000000 0.953094 0.856111 0.562335 0.378555 -0.035716 0.021343 0.437774 0.341052 0.283988 1.049334 1.266917 0.184364 1.326298 0.704383 1.343207)
+ 4.326467 (fv 0.000000 0.954646 0.857741 0.564427 0.380619 -0.030405 0.027220 0.443651 0.347240 0.290827 1.057423 1.274647 0.193509 1.337335 0.715554 1.355809)
+ 4.326323 (fv 0.000000 0.953094 0.856111 0.562335 0.378555 -0.035716 0.021343 0.437774 0.341052 0.283988 1.049334 1.266917 0.184364 1.326298 0.704383 1.343207)
+ 4.325044 (fv 0.000000 0.953571 0.856165 0.561119 0.376819 -0.035768 0.021241 0.436352 0.339200 0.281830 1.047126 1.263828 0.181703 1.324018 0.701028 1.340302)
)
;;; 17 even --------------------------------------------------------------------------------
-#(17 5.2972948285536 #(0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1)
- 5.2612584721964 #(0 1 0 0 1 0 1 0 1 1 1 0 0 1 1 1 1)
- 5.2483402924188 #(0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1)
- 5.2332563400269 #(0 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0)
+(vector 17 5.2332563400269 (fv 0 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0)
- 4.494270 #(0.000000 1.690932 1.377703 -0.129164 -0.024726 0.145784 0.623192 0.601419 1.696617 1.062285 0.338962 0.425431 0.203410 -0.198553 0.017368 0.919786 1.663170)
- 4.479510 #(0.000000 1.466836 1.017287 1.287212 1.239798 1.196077 1.475713 1.252884 0.088143 1.339107 0.374990 0.334947 -0.053319 1.236824 1.357721 0.013234 0.581999)
- 4.464269 #(0.000000 1.476895 1.019325 1.288655 1.217216 1.181033 1.470508 1.274331 0.076928 1.335513 0.388067 0.349071 -0.061964 1.248056 1.367096 0.016797 0.585932)
- 4.464096 #(0.000000 1.478399 1.021179 1.293532 1.222041 1.188322 1.479616 1.284032 0.091138 1.349289 0.401522 0.364537 -0.044880 1.268488 1.386805 0.039323 0.607489)
+ 4.464096 (fv 0.000000 1.478399 1.021179 1.293532 1.222041 1.188322 1.479616 1.284032 0.091138 1.349289 0.401522 0.364537 -0.044880 1.268488 1.386805 0.039323 0.607489)
+ 4.463016 (fv 0.000000 1.478182 1.023133 1.293051 1.222719 1.187462 1.479990 1.285327 0.088371 1.348357 0.403976 0.365587 -0.044469 1.267681 1.387786 0.039745 0.610112)
)
;;; 18 even --------------------------------------------------------------------------------
-#(18 5.4135673169319 #(0 0 0 1 0 1 1 1 0 1 1 0 0 0 0 1 0 0)
- 5.3738845938103 #(0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 0 0 1)
- 5.3310880661011 #(0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 0)
+(vector 18 5.3310880661011 (fv 0 1 1 1 1 0 0 1 0 1 1 0 0 0 1 0 0 0)
- 4.589734 #(0.000000 0.128904 0.791112 1.176829 1.319456 -0.047760 0.250141 1.390995 0.366355 1.103698 0.393661 -0.024093 1.112970 0.986605 0.815414 0.987317 0.858855 0.551348)
- 4.580164 #(0.000000 0.088065 1.683756 0.348660 0.864971 1.361146 1.224199 0.124257 0.574705 0.001082 1.664767 0.723022 1.280851 0.880081 1.007566 1.375306 1.095774 0.962641)
- 4.570825 #(0.000000 1.014207 0.576401 1.182722 1.623809 0.037366 -0.106276 0.719945 1.088940 0.493703 0.074031 1.074477 1.595481 1.109120 1.197779 1.498819 1.161324 0.997523)
+ 4.569421 (fv 0.000000 1.011793 0.580064 1.185332 1.624771 0.036509 -0.103084 0.721775 1.089226 0.493658 0.073953 1.074825 1.595710 1.108207 1.196849 1.497424 1.163445 0.995437)
)
;;; 19 even --------------------------------------------------------------------------------
-#(19 5.4721938266519 #(0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0)
- 5.4619059562683 #(0 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 0)
+(vector 19 5.4619059562683 (fv 0 0 1 0 0 0 0 0 0 0 1 0 0 1 1 1 0 0 0)
- 4.760423 #(0.000000 0.078500 -0.009665 0.445299 0.326637 1.124753 0.889843 1.345388 1.144621 0.990641 0.735224 1.219841 0.734403 1.676249 0.197585 1.008479 1.250738 0.438525 0.297651)
- 4.747536 #(0.000000 1.217706 0.673412 0.449616 1.339090 1.249452 0.119748 -0.159813 -0.067080 0.446567 1.155275 1.187059 0.684859 0.863274 0.563311 1.197365 0.360905 0.957607 0.891096)
- 4.743668 #(0.000000 1.219811 0.663388 0.442999 1.326759 1.245187 0.104481 -0.172642 -0.076545 0.433008 1.136268 1.162596 0.675108 0.838538 0.550324 1.176777 0.324581 0.937881 0.863149)
- 4.743457 #(0.000000 1.217893 0.656820 0.434930 1.318439 1.234525 0.095173 -0.185206 -0.086731 0.407144 1.121209 1.131725 0.654678 0.822361 0.535204 1.154897 0.288114 0.908839 0.830917)
+ 4.741489 (fv 0.000000 1.217162 0.660633 0.437661 1.320878 1.235636 0.094939 -0.184508 -0.090396 0.415156 1.119340 1.141612 0.652398 0.817014 0.525642 1.150459 0.295913 0.906911 0.831168)
)
;;; 20 even --------------------------------------------------------------------------------
-#(20 5.670516977407 #(0 0 1 0 0 1 0 0 0 1 0 0 0 1 1 1 0 0 0 0)
- 5.5380347270104 #(0 0 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0)
- 5.5266017913818 #(0 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0)
+(vector 20 5.5266017913818 (fv 0 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0)
- 4.841326 #(0.000000 0.883035 0.097875 0.018453 1.302230 0.272330 1.409446 1.703194 0.582507 1.044653 0.993417 1.668381 0.672273 0.285918 0.289609 0.363572 1.035594 0.801569 0.774777 0.509188)
+ 4.839482 (fv 0.000000 0.882739 0.097549 0.018330 1.302731 0.272028 1.407538 1.702479 0.580972 1.045015 0.992304 1.669564 0.673981 0.282219 0.289947 0.363499 1.033218 0.803741 0.771035 0.508087)
)
;;; 21 even --------------------------------------------------------------------------------
-#(21 5.7292241651627 #(0 0 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0)
- 5.6852540969849 #(0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1)
- 5.6849967470046 #(0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0)
+(vector 21 5.6849967470046 (fv 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0)
- 4.921985 #(0.000000 -0.018937 1.375553 1.496177 -0.139325 1.937047 0.317759 0.213913 0.072638 0.935832 1.306093 0.124717 0.468826 1.814956 1.578619 1.412244 0.051100 1.297844 0.783258 1.334465 0.605216)
+ 4.919735 (fv 0.000000 -0.021966 1.377831 1.499470 -0.139205 1.937761 0.320320 0.217546 0.069290 0.938854 1.308616 0.123782 0.469963 1.818882 1.581666 1.414927 0.056553 1.301602 0.788305 1.336052 0.607478)
)
;;; 22 even --------------------------------------------------------------------------------
-#(22 5.9318449080552 #(0 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 1 1)
- 5.9259635937391 #(0 0 1 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 1 0 0)
- 5.8572781078687 #(0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0)
+(vector 22 5.8572781078687 (fv 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0)
- 5.057619 #(0.000000 -1.549052 1.840561 0.899352 0.955243 0.675735 1.388002 0.130931 1.230411 1.016199 1.248642 1.548860 -1.869404 1.414806 -0.062473 -0.077279 1.209336 1.129629 0.911002 1.328778 1.284364 0.506500)
+ 5.055233 (fv 0.000000 -1.550778 1.843415 0.900724 0.955590 0.677531 1.390686 0.133831 1.229871 1.016503 1.245622 1.546957 -1.869615 1.414871 -0.060378 -0.077148 1.210164 1.132173 0.909114 1.325478 1.285781 0.509617)
)
;;; 23 even --------------------------------------------------------------------------------
-#(23 5.9574251174927 #(0 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0)
- 5.9548940658569 #(0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 0 1 1 1 1 1 0 1)
- 5.9208135892745 #(0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0)
+(vector 23 5.9208135892745 (fv 0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 0 0 0 0)
- 5.150197 #(0.000000 0.491565 0.619397 0.387291 -0.214520 1.136551 0.632100 0.890158 1.398097 0.878024 0.675567 0.944519 0.610269 -0.181328 0.353190 1.383289 1.649469 0.413950 0.150962 0.559863 0.266346 1.101816 1.465450)
+ 5.147900 (fv 0.000000 0.493561 0.617878 0.386087 -0.215675 1.136922 0.632292 0.891205 1.398746 0.878537 0.676611 0.945565 0.610792 -0.182076 0.354229 1.383426 1.649635 0.414770 0.152656 0.561509 0.267633 1.102796 1.466348)
)
;;; 24 even --------------------------------------------------------------------------------
-#(24 6.119236946106 #(0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 1 0)
- 6.0757751464844 #(0 0 0 0 1 1 0 0 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1)
- 6.0318420391191 #(0 0 1 1 0 0 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 0 0 1)
- 6.0318420391191 #(0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0)
+(vector 24 6.0318420391191 (fv 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0)
+
+ 5.253162 (fv 0.000000 0.045084 0.641921 -0.205904 0.266767 1.228115 0.912709 0.214922 1.487762 1.357882 0.864877 0.404420 0.601935 0.594931 0.069420 1.052347 1.659787 1.624121 0.035857 0.245103 1.406872 0.042697 -0.053953 0.167577)
- 5.255682 #(0.000000 0.045474 0.639735 -0.206951 0.266882 1.229094 0.912231 0.212812 1.489192 1.359872 0.864819 0.404719 0.603383 0.597438 0.068739 1.051236 1.659277 1.626118 0.036193 0.246242 1.406697 0.040503 -0.053562 0.164493)
+ ;; nce:
+ 5.253153 (fv 0.000000 0.045202 0.642246 -0.205352 0.266926 1.228585 0.913398 0.215740 1.488650 1.358650 0.865965 0.405240 0.603061 0.596132 0.070695 1.053498 1.661316 1.625634 0.037488 0.246663 1.408918 0.044558 -0.052337 0.169870)
)
;;; 25 even --------------------------------------------------------------------------------
-#(25 6.2507610321045 #(0 0 1 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0)
- 6.2422542572021 #(0 0 1 1 0 0 0 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1 1)
- 6.152729668872 #(0 1 0 1 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 0 0)
- 6.1513186981755 #(0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1)
+(vector 25 6.1513186981755 (fv 0 0 1 0 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 1 1)
- 5.405563 #(0.000000 0.044827 1.794775 1.405349 1.248426 0.256712 0.428860 -0.020263 0.210400 1.157456 1.741591 0.245940 1.005440 0.948100 0.615139 0.227320 0.746752 0.771990 0.270736 1.529920 0.384512 1.822551 0.327748 0.151266 0.690608)
+ 5.403228 (fv 0.000000 0.045060 1.794212 1.406802 1.249045 0.257853 0.430644 -0.020674 0.209605 1.159346 1.742584 0.244624 1.006989 0.948352 0.613996 0.229169 0.745474 0.773295 0.271006 1.529917 0.384835 1.822065 0.327936 0.153008 0.689262)
+
+ ;; nce:
+ 5.408253 (fv 0.000000 -0.043635 1.870808 1.373617 1.322838 0.337670 0.345509 0.039602 0.231587 1.174477 1.746219 0.272425 1.051956 0.894710 0.701095 0.201178 0.713607 0.745859 0.396015 1.495521 0.465720 1.748739 0.254514 0.207309 0.670746)
)
;;; 26 even --------------------------------------------------------------------------------
-#(26 6.3358421325684 #(0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 1 1 0)
- 6.3140621185303 #(0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 1)
- 6.2921685546228 #(0 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1)
- 6.2921685546205 #(0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0)
+(vector 26 6.2921685546205 (fv 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0)
- 5.454886 #(0.000000 0.050016 0.205870 1.808742 0.405651 -0.024060 0.116196 0.407889 0.823937 0.626331 0.635265 0.067838 0.842405 0.576072 -0.127322 -0.089535 1.707122 0.545902 0.984830 1.260435 0.630088 1.784744 1.306613 1.809592 0.666905 0.989508)
+ 5.452331 (fv 0.000000 0.051327 0.204117 1.807782 0.408597 -0.021081 0.115796 0.407761 0.824888 0.626144 0.637118 0.067354 0.844059 0.574978 -0.127497 -0.091341 1.702516 0.546084 0.986055 1.260143 0.631019 1.781357 1.305578 1.812413 0.666374 0.989339)
)
;;; 27 even --------------------------------------------------------------------------------
-#(27 6.4054713249207 #(0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 0)
- 6.243681443715 #(0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1)
- 6.2436904245852 #(0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1)
+(vector 27 6.2436904245852 (fv 0 1 1 0 0 0 0 0 1 0 0 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1)
- 5.623706 #(0.000000 -0.020576 0.519707 0.371551 0.864699 1.334512 -0.208181 1.688257 0.033386 1.773592 0.573873 1.617213 0.354916 1.095283 1.392347 1.239659 1.112991 0.853261 0.890503 0.160590 -0.311451 1.252818 1.081249 -0.272186 1.565173 0.964482 1.599914)
+ 5.620374 (fv 0.000000 -0.021456 0.516604 0.372410 0.864531 1.336703 -0.209149 1.689313 0.033950 1.772624 0.571345 1.616802 0.355488 1.092886 1.391271 1.240098 1.111612 0.854249 0.888716 0.157123 -0.311986 1.252460 1.082038 -0.272435 1.564985 0.964546 1.600742)
)
;;; 28 even --------------------------------------------------------------------------------
-#(28 6.6246975836201 #(0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1)
- 6.6145820617676 #(0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0)
- 6.5361909866333 #(0 0 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1)
+(vector 28 6.5361909866333 (fv 0 0 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1)
+
+ 5.731679 (fv 0.000000 1.447589 1.395977 0.797533 1.295906 1.462640 1.534875 1.774902 1.013697 0.705377 0.626264 1.242696 1.362454 0.181714 0.805604 1.271981 0.570662 1.779635 -0.124462 1.352040 -0.225912 1.764222 0.153642 1.298969 0.773437 0.201599 0.803480 0.102660)
- 5.735312 #(0.000000 1.446564 1.395795 0.794943 1.296122 1.464047 1.535520 1.775478 1.012087 0.704121 0.624490 1.243648 1.360898 0.181612 0.804675 1.270828 0.567656 1.780076 -0.124407 1.351868 -0.223622 1.763371 0.154008 1.296854 0.775406 0.203491 0.802273 0.102755)
+ ;; nce:
+ 5.757769 (fv 0.000000 -0.064452 1.194800 0.947245 0.026529 0.920008 0.673833 0.051447 -0.007043 1.637680 1.814843 1.945096 0.720067 0.530198 0.753640 0.603773 1.296939 0.860024 0.197512 0.571117 0.903138 1.152266 0.326717 0.457781 -0.069831 0.864587 1.677694 0.471749)
)
;;; 29 even --------------------------------------------------------------------------------
-#(29 6.7166719436646 #(0 0 1 0 1 1 0 0 0 1 1 1 0 1 0 0 1 1 0 1 1 1 1 1 1 1 1 0 0)
- 6.7148699760437 #(0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 1 0 0)
- 6.6767044067383 #(0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1)
+(vector 29 6.6767044067383 (fv 0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1)
- 5.770226 #(0.000000 1.752583 1.827320 1.103585 0.682546 0.650877 0.531929 0.078102 0.175544 1.355580 1.450164 1.046064 1.724627 1.604828 0.350175 0.848881 0.374945 1.131460 1.003712 0.972516 0.411587 0.914857 1.010043 0.192283 0.966189 0.663343 1.289531 1.532023 0.429197)
+ 5.766338 (fv 0.000000 1.750571 1.825931 1.106253 0.681108 0.654013 0.530242 0.078216 0.174544 1.354195 1.454712 1.045782 1.722411 1.607453 0.347380 0.849326 0.377709 1.136286 1.004911 0.970793 0.410809 0.919085 1.010160 0.193230 0.966878 0.662369 1.289507 1.533180 0.429508)
)
;;; 30 even --------------------------------------------------------------------------------
-#(30 6.8207087516785 #(0 0 0 1 0 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 1 0)
- 6.8207082748413 #(0 1 1 0 1 1 0 0 1 0 0 1 0 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1)
- 6.799307346344 #(0 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 0)
- 6.6998701095581 #(0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 0)
+(vector 30 6.6998701095581 (fv 0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 0)
+
+ 5.906955 (fv 0.000000 0.906624 1.374273 1.276597 -0.178673 0.094922 0.333601 0.129339 0.400307 0.946356 1.401096 0.557587 0.654474 1.274947 0.061009 -0.048005 1.903626 1.753056 1.439902 1.944968 1.607217 1.115332 0.419220 1.617499 1.734563 1.091117 0.095163 0.781775 -0.001559 1.852411)
- 5.910618 #(0.000000 0.908807 1.373286 1.277087 -0.177124 0.095893 0.332228 0.128921 0.398841 0.946104 1.403293 0.557346 0.656008 1.276507 0.062453 -0.049983 1.902438 1.755902 1.437139 1.947315 1.608205 1.117016 0.415452 1.614229 1.733504 1.087788 0.099823 0.781893 -0.003344 1.852877)
+ ;; nce:
+ 5.930402 (fv 0.000000 -0.023546 1.489564 1.475097 0.916826 0.864026 1.899229 1.607559 0.910332 0.924096 1.371927 0.795577 0.542873 0.396054 0.844978 1.658639 0.174074 0.939529 1.326938 1.039010 1.301858 1.417763 1.619561 1.723680 0.850267 0.018519 1.089727 0.405902 1.206335 1.833260)
)
;;; 31 even --------------------------------------------------------------------------------
-#(31 6.9357690811157 #(0 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1)
- 6.9057178497314 #(0 0 1 1 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1)
- 6.9018726284795 #(0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 0 0 0 0 0 1 1 1 0 0 0 1 0 0 0 0)
- 6.8986349105835 #(0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0)
- 6.8660564422607 #(0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0)
+(vector 31 6.8660564422607 (fv 0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0)
- 5.991553 #(0.000000 1.294060 1.380565 1.150714 1.133080 1.031322 1.467952 1.316738 1.560524 1.149380 1.426520 0.309986 0.093879 -0.092838 1.618876 0.386127 1.276099 0.768874 0.092478 1.372697 0.935849 0.029991 0.353204 1.817033 0.371684 0.700369 1.341168 1.538111 1.331703 0.301405 0.818032)
+ 5.987789 (fv 0.000000 1.294084 1.380328 1.151198 1.131917 1.032100 1.467500 1.317593 1.561230 1.149337 1.426512 0.310391 0.093956 -0.092069 1.618651 0.385482 1.276093 0.768907 0.092705 1.372235 0.935730 0.030657 0.353616 1.817773 0.372502 0.700675 1.341184 1.537494 1.331726 0.302069 0.818207)
)
;;; 32 even --------------------------------------------------------------------------------
-#(32 7.1377140468569 #(0 1 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 0 1 1 0 0)
- 7.0221180915833 #(0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1)
- 7.011866569519 #(0 0 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 0 1 1)
- 7.003 #(0 1 0 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1)
- 6.9974670410156 #(0 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 0)
+(vector 32 6.9974670410156 (fv 0 0 0 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0 1 0)
- 6.065521 #(0.000000 0.285485 1.824991 0.361483 1.113714 0.962272 1.152452 1.837244 0.183331 1.504654 0.432023 1.106977 0.465457 1.357599 1.532977 1.672348 0.833050 1.852805 -0.259910 1.830866 0.240364 0.782902 0.068331 1.705348 0.669695 -0.000853 1.835622 1.185939 1.464578 1.660632 0.971966 1.137154)
+ 6.061091 (fv 0.000000 0.284769 1.824838 0.360868 1.114185 0.962149 1.153553 1.836957 0.183317 1.504519 0.431670 1.106470 0.465083 1.359049 1.532974 1.672623 0.833072 1.851412 -0.259099 1.829526 0.240313 0.782734 0.067562 1.704922 0.670838 0.000337 1.835105 1.184487 1.464400 1.660678 0.971147 1.137597)
)
;;; 33 even --------------------------------------------------------------------------------
-#(33 7.1199560165405 #(0 0 1 1 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 0 0 0 0 1)
- 7.0745658874512 #(0 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 0)
- 7.0716042518616 #(0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 1)
- 7.0670447349548 #(0 1 0 0 0 0 1 0 0 1 1 1 1 0 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0)
- 6.978609085083 #(0 0 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0)
+(vector 33 6.978609085083 (fv 0 0 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 1 0 1 0 1 1 0)
- 6.167745 #(0.000000 -0.096128 -0.403532 1.394302 -0.306153 0.366725 0.336897 0.377486 0.129520 0.155758 1.349437 0.237012 0.252758 0.242534 1.430701 1.663672 1.235952 1.670554 1.653037 0.461736 0.694770 0.916622 0.353714 1.885227 1.308226 0.583336 1.382051 1.789584 0.399779 0.760162 0.153822 0.882572 0.072583)
+ 6.162617 (fv 0.000000 -0.095863 -0.402980 1.394421 -0.306134 0.366840 0.337119 0.377845 0.129322 0.155850 1.349812 0.235845 0.252319 0.242909 1.431344 1.664418 1.236043 1.670315 1.653641 0.461681 0.695631 0.916345 0.353418 1.885954 1.309177 0.582371 1.382992 1.788982 0.399357 0.760664 0.154447 0.882692 0.073082)
)
;;; 34 even --------------------------------------------------------------------------------
-#(34 7.3321795463562 #(0 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 1 0 0 1 0)
- 7.3251795768738 #(0 0 1 1 0 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 0 0 0)
- 7.3184022903442 #(0 0 1 0 0 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0)
- 7.314661026001 #(0 1 1 1 1 0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 0 0 1)
- 7.3119759559631 #(0 0 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0)
- 7.2703185081482 #(0 0 1 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 0 0 0)
- 7.2649097442627 #(0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 0)
- 7.2615523338318 #(0 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0)
+(vector 34 7.2615523338318 (fv 0 1 0 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0)
- 6.227370 #(0.000000 -0.031608 0.094260 0.501322 0.851565 0.574319 0.752579 1.914315 -0.024136 0.146123 0.293598 1.382749 -0.007303 0.943173 1.233826 0.413289 0.585905 -0.053959 1.840331 0.251300 0.156183 0.682280 0.409304 -0.127609 0.821531 0.505162 1.230500 1.450862 1.154797 0.222977 1.121593 1.588896 1.074815 0.528460)
+ 6.222816 (fv 0.000000 -0.031974 0.094234 0.502100 0.850042 0.574691 0.752336 1.914959 -0.024174 0.146232 0.295078 1.383128 -0.007584 0.943763 1.235227 0.413741 0.587141 -0.053979 1.839683 0.252526 0.156123 0.682869 0.409598 -0.127649 0.823619 0.505563 1.228553 1.452425 1.154757 0.224780 1.122198 1.589227 1.075252 0.529430)
)
;;; 35 even --------------------------------------------------------------------------------
-#(35 7.3807096481323 #(0 0 0 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 0 1 0 0)
- 7.3793916702271 #(0 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 0 0)
- 7.3590030670166 #(0 1 1 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 0 1 1 0 1 1 0 0 0)
- 7.3509883880615 #(0 1 0 1 1 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 1 0)
- 7.3254580497742 #(0 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 0 1 1 1 0 0 0)
- 7.3159041404724 #(0 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 0 0 0)
- 7.3109955787659 #(0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0)
- 7.2921919822693 #(0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0)
+(vector 35 7.2921919822693 (fv 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0)
- 6.367846 #(0.000000 -0.108669 1.553997 0.219946 0.239914 1.171916 0.131219 0.808334 1.471028 1.403743 0.917976 1.560929 -0.099551 1.196249 0.221190 1.203335 0.775814 0.877451 1.783091 1.125640 1.421280 0.952331 0.640445 1.820580 1.425829 -0.517287 1.350976 1.568319 1.481991 0.524429 0.575358 0.865798 -0.127600 -0.103963 0.426994)
+ 6.362258 (fv 0.000000 -0.109595 1.553671 0.219728 0.238496 1.170971 0.131935 0.808676 1.471325 1.403853 0.916637 1.560710 -0.099827 1.196395 0.221158 1.202313 0.775632 0.876517 1.782554 1.124579 1.420710 0.952275 0.641256 1.819844 1.425015 -0.516862 1.352551 1.568353 1.482981 0.524776 0.577204 0.865347 -0.128894 -0.102429 0.426519)
)
;;; 36 even --------------------------------------------------------------------------------
-#(36 7.5039777755737 #(0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 0 0 1 0 1 1 0 0 1 0 0 0 0 0)
- 7.497097492218 #(0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0)
- 7.4732356071472 #(0 1 1 1 0 0 0 0 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0)
- 7.4679698944092 #(0 1 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 0 0 0)
- 7.466917514801 #(0 0 0 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 0 0 0 0 0 0)
- 7.4267778396606 #(0 0 0 1 0 1 1 1 1 0 1 0 0 1 1 0 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0)
- 7.4214091300964 #(0 0 1 0 1 0 1 0 0 0 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 0 0)
- 7.3326554298401 #(0 0 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0)
+(vector 36 7.3326554298401 (fv 0 0 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0)
- 6.437336 #(0.000000 0.003662 0.086859 1.388832 0.898267 1.459432 0.131070 1.657729 1.521867 1.471295 0.951271 1.325100 1.241786 1.395425 0.150709 1.064708 0.651806 1.427047 1.086410 0.098846 0.328758 1.795857 1.461283 0.857023 1.694299 1.032403 1.245628 0.175004 -0.134353 0.154319 -0.012838 0.387005 0.719800 1.603900 0.574577 0.835322)
+ 6.432117 (fv 0.000000 0.004340 0.086403 1.388728 0.898065 1.458617 0.131985 1.657435 1.521273 1.472417 0.951218 1.324245 1.241442 1.395549 0.150266 1.064974 0.650640 1.427046 1.086279 0.098701 0.328772 1.795832 1.461165 0.857821 1.693245 1.032679 1.245848 0.174782 -0.135078 0.155045 -0.013817 0.388292 0.719587 1.603641 0.575715 0.836424)
+
+ ;; nce:
+ 6.433446 (fv 0.000000 -0.039571 0.060618 1.408936 0.882042 1.447670 0.143068 1.639607 1.518329 1.469129 0.942793 1.305387 1.226395 1.375800 0.162353 1.047466 0.675921 1.406954 1.102981 0.111251 0.337382 1.829176 1.494772 0.804464 1.712328 1.039053 1.250692 0.166362 -0.143216 0.133112 -0.012403 0.370517 0.701621 1.606484 0.581751 0.854317)
)
;;; 37 even --------------------------------------------------------------------------------
-#(37 7.6800961494446 #(0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 0 0)
- 7.6781373023987 #(0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0)
- 7.6548581123352 #(0 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 0)
- 7.6323590278625 #(0 0 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 0 0)
- 7.6028599739075 #(0 0 0 0 0 1 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 0 0)
- 7.5926213264465 #(0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 0)
- 7.5687103271484 #(0 0 1 0 1 0 1 0 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0)
- 7.4919209480286 #(0 1 1 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0)
+(vector 37 7.4919209480286 (fv 0 1 1 0 0 1 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 0 0)
- 6.585942 #(0.000000 0.011008 1.017324 0.696121 0.135367 0.854814 0.790621 0.128903 1.849684 0.689318 0.247068 0.205586 0.157375 1.585384 0.005616 0.200081 1.745306 -0.359483 0.556626 0.875435 0.785801 0.017784 -0.119678 0.200337 1.347510 1.017941 0.160604 0.559071 0.649488 0.969395 0.727879 1.097195 1.685669 0.610572 1.758498 0.446671 1.384812)
+ ;; ce:
+ 6.533287 (fv 0.000000 0.011564 0.880733 1.522736 0.250376 0.789024 1.673119 0.570623 1.276735 0.341425 -0.532081 0.348007 -0.836598 0.457646 -0.009210 1.409326 1.013302 0.369886 1.439731 1.104224 1.371479 0.882940 0.611993 0.167228 0.213651 -0.123007 -0.145430 -0.035562 0.326284 0.342544 0.027533 0.469211 0.589131 1.242729 -0.350729 -0.122043 0.359222)
)
;;; 38 even --------------------------------------------------------------------------------
-#(38 7.7734541893005 #(0 1 0 0 1 1 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 0)
- 7.7677249908447 #(0 0 0 0 0 1 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 0)
- 7.7656890155417 #(0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 0 0 0 0)
- 7.7583861351013 #(0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 0 0 0 0 0)
- 7.735631942749 #(0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 1 0 1 0 0 1 0 1 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0)
- 7.669114112854 #(0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0)
+(vector 38 7.669114112854 (fv 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 0)
- 6.542358 #(0.000000 -0.020303 1.378297 1.768113 0.243867 1.765618 1.779113 1.045484 1.285905 0.293978 0.321881 1.722391 1.560756 0.401328 0.335125 -0.059127 0.231619 0.961929 1.594001 1.401091 0.650439 0.412010 1.330120 0.099600 1.940222 0.267803 0.404762 1.515814 0.579493 0.002405 0.261785 1.800376 0.421241 1.617996 1.112239 1.305682 1.421552 1.716025)
+ 6.536590 (fv 0.000000 -0.020563 1.377251 1.769036 0.243537 1.765876 1.779834 1.045673 1.286350 0.293614 0.321305 1.723518 1.560003 0.401205 0.333918 -0.059485 0.232219 0.960903 1.594163 1.401434 0.649608 0.412099 1.329747 0.099455 1.939824 0.267997 0.403580 1.515217 0.579512 0.002234 0.262847 1.800156 0.419089 1.615975 1.110793 1.305676 1.421012 1.714827)
)
;;; 39 even --------------------------------------------------------------------------------
-#(39 8.060715675354 #(0 1 1 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0 1 1 0 0 1)
- 8.0530862808228 #(0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1)
- 8.0486888885498 #(0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0)
- 8.0062685830938 #(0 0 0 1 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0)
+(vector 39 8.0062685830938 (fv 0 0 0 1 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 0)
- 6.689415 #(0.000000 1.090879 0.284125 0.241210 1.659863 1.656905 0.222034 1.551984 0.232558 0.327126 1.766842 0.510226 0.574252 0.683911 0.355310 1.005185 0.649101 0.443898 1.695983 0.328207 -0.210284 0.337823 -0.053929 -0.119928 0.552242 1.088498 0.035109 1.385052 0.803815 1.342122 0.005138 0.412028 0.488966 1.360603 1.310078 1.490626 1.367238 0.635929 0.517776)
+ 6.683157 (fv 0.000000 1.091390 0.284404 0.240879 1.660743 1.656550 0.223587 1.552502 0.232972 0.325977 1.767287 0.511127 0.573904 0.685387 0.354731 1.006014 0.648089 0.445081 1.696394 0.327980 -0.210151 0.338005 -0.052572 -0.119111 0.551717 1.087945 0.035621 1.385382 0.802270 1.342811 0.005749 0.410111 0.489512 1.361009 1.309724 1.490142 1.368577 0.636471 0.518214)
)
;;; 40 even --------------------------------------------------------------------------------
-#(40 8.1045722961426 #(0 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0)
- 8.0884717473459 #(0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 1)
- 8.0304555793911 #(0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 0 1)
+(vector 40 8.0304555793911 (fv 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 0 1)
- 6.754190 #(0.000000 0.030689 0.021651 0.135013 1.638872 1.202950 0.744852 -0.149854 0.506001 0.559979 -0.083923 -0.079271 0.148915 0.575333 1.046460 1.733620 1.932979 1.304210 -0.056648 1.483655 1.130988 0.869014 1.564354 1.665797 1.479270 0.851691 0.124355 0.568510 1.545462 0.061018 1.378168 0.738977 -0.238425 1.303931 1.521189 1.551704 0.223877 1.494780 0.103303 0.386809)
+ 6.748142 (fv 0.000000 0.029455 0.022065 0.136105 1.638522 1.203180 0.744941 -0.148784 0.506171 0.560051 -0.084723 -0.078289 0.149301 0.575133 1.046850 1.733499 1.932780 1.304846 -0.055855 1.484587 1.130478 0.869457 1.564935 1.665772 1.478237 0.851162 0.123617 0.568797 1.544770 0.060395 1.377474 0.739849 -0.238843 1.303906 1.521850 1.552033 0.224167 1.493979 0.103832 0.387098)
)
;;; 41 even --------------------------------------------------------------------------------
-#(41 8.3439186011904 #(0 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 1)
- 8.2169809341431 #(0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0)
+(vector 41 8.2169809341431 (fv 0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0)
- 6.888023 #(0.000000 0.132293 0.436495 -0.019389 0.596393 -0.300033 0.298472 -0.292644 -0.125140 1.381000 1.229842 1.013511 0.995283 0.164958 0.060220 -0.313757 -0.409293 1.322245 -0.216145 0.007023 1.718164 0.636734 0.521917 0.976140 1.418046 -0.764769 1.376202 0.287197 1.475195 1.361945 0.552126 -0.329835 1.190849 0.378384 1.221061 1.703825 0.053486 0.665254 1.564834 1.322188 0.167849)
+ 6.881035 (fv 0.000000 0.133290 0.436430 -0.019956 0.597994 -0.299445 0.298044 -0.291816 -0.125561 1.379945 1.227240 1.012471 0.995085 0.165521 0.059156 -0.315277 -0.410140 1.321719 -0.217071 0.006502 1.718169 0.636248 0.520158 0.977079 1.417462 -0.764436 1.377242 0.286309 1.475385 1.360726 0.551504 -0.329940 1.190956 0.377718 1.221012 1.703028 0.053941 0.664915 1.563928 1.320457 0.168607)
)
;;; 42 even --------------------------------------------------------------------------------
-#(42 8.3791161021838 #(0 1 1 1 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1)
- 8.3605623245239 #(0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1)
+(vector 42 8.3605623245239 (fv 0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1)
- 6.948397 #(0.000000 -0.007339 1.287350 1.753651 -0.276891 1.209769 0.996221 0.480828 0.607235 1.419822 -0.000709 0.317258 0.225037 -1.793291 -0.086501 1.622229 1.142325 0.611823 1.710932 0.371635 0.494214 1.156812 0.719031 -0.061120 0.895633 0.558250 0.567694 0.672932 0.964437 1.131724 0.010306 1.066049 1.756944 0.686461 0.165683 0.031441 0.191341 0.815827 0.403781 1.294123 0.159190 0.487681)
+ 6.941481 (fv 0.000000 -0.007293 1.286795 1.752349 -0.276621 1.210682 0.997503 0.480778 0.607692 1.419140 -0.000887 0.317063 0.225619 -1.792990 -0.085405 1.621718 1.141369 0.612500 1.711137 0.371822 0.494518 1.158070 0.720118 -0.061260 0.895705 0.558493 0.565336 0.673764 0.965927 1.131140 0.011389 1.067604 1.758075 0.687249 0.164819 0.032158 0.192333 0.816334 0.404498 1.292703 0.160108 0.486834)
)
;;; 43 even --------------------------------------------------------------------------------
-#(43 8.4720001220703 #(0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 1 1 1 1 0 1 0 1 0 0 0 0 0 1 1 1 0)
- 8.3471550144283 #(0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0)
+(vector 43 8.3471550144283 (fv 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 1 0 0)
- 7.062412 #(0.000000 0.046908 1.659577 1.618765 1.902264 1.535486 1.519626 0.139930 -0.012902 1.735111 0.123544 1.727779 0.967940 0.859038 0.315797 0.782736 0.749803 1.792431 -0.192146 1.214122 1.594925 0.300529 1.829726 1.397155 1.088683 0.460810 0.319455 0.888779 1.307574 1.599385 0.871439 1.625985 0.871091 1.802349 0.868457 0.618949 0.931384 0.967603 1.701292 0.258625 0.614612 0.031982 0.804445)
+ 7.055197 (fv 0.000000 0.047763 1.657931 1.619393 1.901312 1.535197 1.519084 0.139389 -0.012074 1.734976 0.124057 1.726677 0.967925 0.859090 0.315172 0.782383 0.749080 1.794616 -0.192964 1.214822 1.594002 0.299675 1.830679 1.396713 1.089896 0.461626 0.318824 0.888695 1.307168 1.600142 0.874003 1.625797 0.872538 1.803252 0.868969 0.618677 0.932144 0.968270 1.700058 0.258149 0.614848 0.031586 0.805044)
)
;;; 44 even --------------------------------------------------------------------------------
-#(44 8.6881771087646 #(0 0 1 0 1 1 1 1 0 0 1 0 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 1 1 0 0 1 1 0)
- 8.4271850585938 #(0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1 1)
+(vector 44 8.4271850585938 (fv 0 0 1 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 1 1)
- 7.055563 #(0.000000 -0.024015 1.041720 1.707562 0.914041 0.669112 0.789560 1.059559 0.488432 0.357805 1.448313 0.555623 0.559130 0.048231 0.102520 0.263359 0.561881 1.755219 1.446041 0.607585 0.096985 0.549129 0.219734 0.642077 0.109144 0.624921 0.657627 1.176276 0.894190 1.899421 0.047806 1.098963 1.393880 1.434065 0.525071 1.590040 -0.110027 0.804330 0.329083 0.620757 1.471398 1.416441 -0.298035 1.020172)
+ 7.048255 (fv 0.000000 -0.024272 1.042039 1.706381 0.915231 0.667566 0.791468 1.060500 0.486474 0.357952 1.448848 0.555099 0.559674 0.047957 0.101663 0.263196 0.561105 1.754886 1.445748 0.607834 0.094941 0.549126 0.219045 0.643754 0.108792 0.622710 0.657739 1.176141 0.892775 1.899443 0.047927 1.097541 1.395320 1.432930 0.524754 1.590031 -0.111160 0.804186 0.328664 0.621384 1.470620 1.417525 -0.298999 1.020701)
)
;;; 45 even --------------------------------------------------------------------------------
-#(45 8.7060899734497 #(0 1 0 1 0 0 1 0 1 1 1 1 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0)
- 8.6457691192627 #(0 0 0 1 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 1 0 0)
- 8.6353975051189 #(0 0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1)
+(vector 45 8.6353975051189 (fv 0 0 1 0 0 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1)
- 7.172161 #(0.000000 0.101498 0.426622 0.244232 0.443289 -0.379389 1.941134 -0.101819 -0.134059 -0.026489 1.677318 1.774566 0.505995 0.350819 0.551918 1.094009 0.285748 -1.617536 0.539781 0.211542 1.155256 1.345841 0.803207 1.612221 1.393169 0.188531 0.473935 0.608660 0.585919 -0.043409 1.515586 0.919322 1.090840 0.246850 0.593361 1.531904 0.320109 0.049249 1.141222 0.865337 0.301002 0.987530 -0.104296 1.339941 0.196512)
+ 7.165216 (fv 0.000000 0.100769 0.427512 0.242955 0.443088 -0.380155 1.940929 -0.101098 -0.133968 -0.026473 1.678192 1.774836 0.508005 0.350465 0.553068 1.094302 0.286670 -1.617200 0.541014 0.212204 1.154970 1.344936 0.804485 1.614258 1.391670 0.188798 0.475817 0.610176 0.585642 -0.044233 1.516307 0.921356 1.091747 0.246161 0.592046 1.532410 0.320765 0.050475 1.141805 0.866052 0.300507 0.986581 -0.103223 1.338567 0.196051)
)
;;; 46 even --------------------------------------------------------------------------------
-#(46 8.9638475105267 #(0 1 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1)
- 8.7939519711145 #(0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0)
+(vector 46 8.7939519711145 (fv 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0)
- 7.283836 #(0.000000 -0.055294 1.032465 -0.131124 -0.261982 1.225591 0.253197 0.556799 0.758684 1.480325 -0.140977 1.184141 0.012987 1.777237 0.881307 1.883681 0.221385 0.298513 0.448373 1.172682 0.679429 1.341106 0.082236 -0.085300 0.762657 -0.028259 -0.366493 0.048043 1.038936 1.414741 0.227153 -0.059599 -0.203781 1.201131 1.632451 1.204796 1.219257 1.182306 -0.060741 1.268698 0.937497 0.490204 -0.178774 0.027075 1.489257 0.058590)
+ 7.276006 (fv 0.000000 -0.054506 1.032755 -0.130142 -0.261502 1.224902 0.252129 0.556107 0.758621 1.480820 -0.142360 1.184737 0.014000 1.776705 0.882036 1.883695 0.222183 0.298085 0.448405 1.172485 0.678362 1.341204 0.081280 -0.085381 0.763100 -0.029414 -0.367000 0.048240 1.040410 1.413704 0.227444 -0.058776 -0.204130 1.202166 1.632528 1.205475 1.219937 1.182203 -0.061521 1.269256 0.937830 0.491219 -0.180909 0.028085 1.489097 0.059386)
)
;;; 47 even --------------------------------------------------------------------------------
-#(47 8.8732557296753 #(0 1 0 0 0 1 1 1 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 1 0 0 1)
- 8.8477687835693 #(0 0 0 1 1 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 1 1 1 0 1 0 0)
- 8.7835607528687 #(0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1)
+(vector 47 8.7835607528687 (fv 0 0 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 1 1)
- 7.300155 #(0.000000 -0.062087 1.442299 1.057982 1.926248 0.607546 0.093639 0.058585 0.177259 1.141590 0.824553 0.142675 1.542633 0.438343 0.942871 1.070786 0.908755 0.331664 1.825700 1.744345 0.079324 0.779871 1.377975 1.290627 0.478990 0.650707 0.040656 0.753740 1.194367 0.872339 1.816695 1.466374 1.199563 1.733606 1.529491 -0.102253 0.906285 1.309295 1.098734 1.239606 1.394675 0.876282 1.145540 -0.144929 0.593485 0.074352 0.938482)
+ 7.292551 (fv 0.000000 -0.062265 1.442422 1.057676 1.927078 0.605872 0.092606 0.058532 0.177290 1.141099 0.824596 0.143569 1.542821 0.439342 0.943358 1.070588 0.909454 0.332472 1.825929 1.744493 0.079522 0.781524 1.378798 1.290207 0.477850 0.651309 0.041772 0.753335 1.194909 0.871931 1.816269 1.466251 1.199198 1.733301 1.531356 -0.102896 0.905701 1.309802 1.098908 1.238880 1.394185 0.875551 1.145434 -0.145313 0.593458 0.073230 0.938656)
)
;;; 48 even --------------------------------------------------------------------------------
-#(48 9.12184715271 #(0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1)
- 8.9965600967407 #(0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1)
+(vector 48 8.9965600967407 (fv 0 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1)
- 7.474126 #(0.000000 0.070239 1.074215 1.157299 0.848479 0.448148 -0.110880 0.924571 0.710266 1.666944 0.400870 1.406229 0.367270 1.104874 1.804893 0.695592 1.381898 1.018859 1.130033 1.207390 1.370288 -0.147581 1.774211 0.266088 0.501427 0.569425 1.484913 0.428415 0.102395 0.025162 1.539625 1.143271 1.439041 1.212210 0.834073 0.105112 1.296692 1.351195 1.645674 0.836913 1.239133 1.467542 1.752822 0.800139 1.353522 0.848769 0.297705 1.379071)
+ ;; ce:
+ 7.406994 (fv 0.000000 0.047945 0.826536 0.973372 1.740017 0.529769 1.008330 1.827057 0.727986 1.449120 0.514522 1.295511 0.015768 1.206235 0.269772 1.336523 0.110706 1.398598 0.887898 1.776715 1.044804 0.419039 -0.057090 1.238424 0.514960 0.147966 1.655287 1.338551 0.870612 0.661410 0.361317 0.267510 -0.382725 -0.031215 1.567563 1.583622 1.671939 1.775367 1.875910 1.638385 1.546190 0.129055 0.397477 0.763475 0.970476 1.468225 1.622446 0.158949)
)
;;; 49 even --------------------------------------------------------------------------------
-#(49 9.2634744644165 #(0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 1 1 1 1 0 1 0 0 1 1 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1)
- 9.1650037765503 #(0 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0)
+(vector 49 9.1650037765503 (fv 0 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0)
- 7.595465 #(0.000000 0.096228 0.646975 1.135300 1.032407 1.068612 0.694071 1.559702 1.241199 0.633754 1.823358 1.544526 0.043334 0.212821 1.418008 0.385473 0.114976 1.352558 1.573053 0.802379 0.455562 0.930772 -0.250760 1.748793 0.472363 0.477583 0.785309 -0.169564 1.197253 -0.047526 0.415040 1.391034 0.587182 0.903292 1.083562 1.248043 0.910107 0.958295 0.364336 -0.018809 0.788873 1.142100 1.114430 0.785847 1.052977 0.538413 0.677669 1.683487 0.311019)
+ ;; ce:
+ 7.532053 (fv 0.000000 0.041305 0.532327 1.215473 1.024214 1.052795 0.585923 1.613470 1.301563 0.656356 1.815283 1.368492 -0.020005 0.356482 1.940348 0.124177 0.127083 1.593092 1.501593 0.678778 0.554128 0.952456 -0.422395 1.575963 0.870840 0.819687 0.743668 0.245617 0.895216 0.369895 0.471783 1.223006 0.679195 1.170671 0.931311 1.629049 0.745807 0.483912 0.397101 0.224181 0.816909 1.126241 1.477811 0.320980 1.574780 0.412692 0.741112 1.583749 0.654625)
)
;;; 50 even --------------------------------------------------------------------------------
-#(50 9.348 #(0 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 1 1 0 0 0 0 1 1 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0) ; symmetric??
- 9.1582123370176 #(0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1)
+(vector 50 9.1582123370176 (fv 0 1 0 0 1 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1)
- 7.630873 #(0.000000 -0.055292 1.339289 1.713161 -0.210589 0.906328 0.762331 0.562254 1.573681 0.215991 0.269919 1.603887 1.093901 0.684857 1.367411 -0.123066 -0.031451 0.317473 1.016209 1.196525 0.820849 0.467958 0.971405 1.418538 0.762999 0.531879 1.244870 1.543976 -0.557057 1.385210 0.504311 0.180999 0.933193 0.125099 0.462543 0.398029 1.563865 1.716772 1.177862 1.817340 1.707877 0.982058 1.850277 0.952050 -0.135791 1.104157 -0.483889 -0.250169 1.491089 -0.002279)
+ ;; ce:
+ 7.553949 (fv 0.000000 0.001153 1.444901 -0.126735 -0.207597 1.037485 0.982912 0.657278 1.609015 0.548946 0.388265 1.860455 1.146064 0.991559 1.714083 0.419464 0.114879 0.538313 1.517340 1.406138 0.768916 1.006070 1.575014 1.565071 1.458974 0.980173 1.203265 1.481696 -0.150280 1.613515 0.690225 0.227360 0.618441 0.290246 1.012000 0.302852 -0.136236 -0.046604 1.075996 0.025371 0.550031 1.195469 0.193455 0.810822 0.527380 1.640757 0.113795 0.191137 1.871211 0.281051)
)
;;; 51 even --------------------------------------------------------------------------------
-#(51 9.5728101730347 #(0 1 0 1 0 1 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0)
- 9.3615226745605 #(0 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0)
+(vector 51 9.3615226745605 (fv 0 0 0 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0)
- 7.663158 #(0.000000 -0.064651 1.656212 0.786486 1.196504 -0.042923 1.617244 0.289919 1.476850 1.080748 1.042083 0.815797 1.259706 -0.312938 0.780771 0.627294 1.629941 -0.270954 -0.309694 0.868287 1.105884 1.326913 0.800473 0.829756 0.424736 0.633634 0.774786 0.865077 0.330952 1.072676 1.501396 1.065274 -0.108727 0.349823 1.324768 -0.206030 1.486301 1.229744 0.304261 1.429175 0.829620 -0.226812 1.476083 1.337259 1.407309 0.079850 0.545863 0.170478 0.127008 0.873359 1.436569)
+ ;; nce:
+ 7.601889 (fv 0.000000 -0.097299 1.522524 0.604656 1.190459 -0.046061 1.637924 0.391838 1.914014 1.191379 0.937217 0.903859 1.190560 -0.310642 0.795112 0.607488 1.496318 -0.432640 -0.101925 0.993972 1.031274 1.167246 0.466609 0.643027 0.235799 0.569210 0.641350 0.632197 0.268712 1.299950 1.493958 0.876871 -0.115765 0.447597 1.299543 -0.601543 0.991250 1.221680 0.433618 1.269835 0.891674 -0.222937 1.508906 1.194487 1.696510 0.136336 0.547118 0.154250 -0.399784 0.814800 1.474647)
)
;;; 52 even --------------------------------------------------------------------------------
-#(52 9.5426025390625 #(0 1 0 0 0 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 0 0 0)
- 9.449512348335 #(0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
+(vector 52 9.449512348335 (fv 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 1 1 1 0 1 1)
- 7.794364 #(0.000000 0.083531 1.266276 1.230071 1.681292 0.170861 0.826023 -0.019004 0.636852 0.494085 1.633131 1.587904 0.245150 0.508642 1.591386 0.714991 1.329302 0.762000 1.221644 0.809255 0.692736 0.588222 0.493848 1.742352 1.689711 1.787033 1.853492 -0.074947 0.734629 1.822974 -0.036285 -0.123439 0.481618 1.702973 1.619923 1.736043 0.286094 0.225671 1.268707 0.952779 0.225752 1.357457 -0.175930 1.810032 0.959846 0.087071 0.437941 0.079193 -0.042540 0.855548 1.138020 0.411037)
+ ;; ce:
+ 7.715514 (fv 0.000000 -0.034843 1.299671 1.297722 1.635310 -0.140716 1.100950 -0.118100 0.547763 0.498559 0.115301 1.387617 0.497862 0.517177 1.775867 1.036003 1.303001 0.627699 1.126538 0.667873 0.716185 0.672233 0.573373 1.713393 1.674703 1.675881 -0.219625 0.205462 0.688511 -0.167042 0.095308 -0.056923 0.925655 1.318413 1.379568 1.567357 0.318805 -0.064577 1.458169 1.228224 0.320505 1.504325 0.170852 1.908593 0.774335 0.156462 0.959528 -0.009590 -0.029886 1.318052 1.521653 0.208620)
)
;;; 53 even --------------------------------------------------------------------------------
-#(53 9.7638588738802 #(0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1)
- 9.627 #(0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0)
- 9.6159172058105 #(0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 1 0)
+(vector 53 9.6159172058105 (fv 0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 1 0)
- 7.759835 #(0.000000 0.035546 0.621986 1.387736 1.448588 0.207810 1.400467 0.715760 0.551925 0.038680 0.347448 1.847564 0.552875 1.490635 1.340787 1.373841 1.129340 1.023232 1.672855 0.563258 0.162475 0.439529 1.164320 -0.070020 0.315192 0.563234 1.174096 1.840181 1.161105 1.789501 0.001048 0.214536 1.156005 0.634722 1.203489 0.236802 -0.136919 1.267155 0.914184 0.931515 0.733349 0.757764 1.209526 1.289119 1.087001 1.356020 0.577711 1.464606 0.727028 0.563174 1.514252 1.240697 0.722731)
+ 7.750487 (fv 0.000000 0.036779 0.620619 1.389030 1.448590 0.206060 1.401187 0.716369 0.552235 0.039103 0.347305 1.846613 0.552018 1.491421 1.339207 1.372862 1.129023 1.023345 1.671571 0.563034 0.162746 0.439370 1.163228 -0.070535 0.315773 0.561792 1.174490 1.839925 1.161557 1.788132 0.000155 0.215127 1.156326 0.635275 1.204301 0.236777 -0.137602 1.267159 0.914139 0.933059 0.732878 0.757869 1.209147 1.287260 1.087065 1.355017 0.578394 1.465757 0.725442 0.562270 1.513798 1.240390 0.721272)
)
;;; 54 even --------------------------------------------------------------------------------
-#(54 9.7764141549279 #(0 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1)
- 9.748743057251 #(0 0 1 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 0)
- 9.5190944671631 #(0 1 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 1)
+(vector 54 9.5190944671631 (fv 0 1 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 1)
- 7.854095 #(0.000000 0.062488 0.633437 0.842494 1.608684 1.150014 1.709447 0.507907 -0.043400 0.310180 0.314489 0.986855 1.351202 1.064597 1.712618 1.603616 0.131731 0.925223 -0.380693 0.855290 1.637618 0.812568 1.014166 0.863245 0.326993 0.192017 0.895991 1.735139 0.874569 -0.001502 0.106127 0.213661 1.657346 0.274265 1.906934 1.436908 1.086335 0.701403 0.410548 1.401909 1.873393 0.558789 1.402185 1.776574 1.632491 1.672455 -0.088196 1.646633 0.861507 0.136745 1.829002 0.307423 0.084108 1.710760)
+ 7.845083 (fv 0.000000 0.061451 0.633202 0.842273 1.609750 1.150617 1.710229 0.507090 -0.042557 0.310551 0.314728 0.987790 1.351858 1.063896 1.713078 1.603814 0.132592 0.924440 -0.380633 0.855851 1.637781 0.813597 1.013698 0.861640 0.327742 0.192164 0.896540 1.734094 0.874167 -0.001625 0.106463 0.214754 1.657275 0.272925 1.907315 1.437104 1.086576 0.701261 0.411048 1.402011 1.872416 0.559924 1.401281 1.776842 1.632661 1.672063 -0.088862 1.645896 0.861803 0.137030 1.828399 0.307366 0.083970 1.711361)
)
;;; 55 even --------------------------------------------------------------------------------
-#(55 10.131931993478 #(0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1)
- 9.9292899584938 #(0 0 0 0 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 1 1 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1)
- 9.7848987579346 #(0 1 0 0 1 0 1 0 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 1)
- 9.6719217300415 #(0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1)
+(vector 55 9.6719217300415 (fv 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1)
- 8.016066 #(0.000000 -0.082054 1.618351 -0.077463 1.592793 0.266962 1.131833 0.010074 0.313633 0.668809 0.124104 1.911001 0.119622 0.162526 0.716555 0.198841 0.549940 1.719805 -0.070825 0.389302 0.590289 1.428838 0.075004 -0.092899 0.072801 0.962687 -0.042534 1.729131 1.279380 0.530749 1.381238 1.227224 0.661567 1.498523 0.645178 0.495962 0.414442 0.154587 -0.216242 1.114812 -0.034634 0.232875 0.639416 0.944249 0.358421 1.154904 1.453988 1.101819 0.139923 -0.078374 0.240259 1.395254 0.754268 0.085288 0.400543)
+ ;; ce:
+ 7.908224 (fv 0.000000 -0.006122 1.706850 -0.138031 1.409264 -0.179924 1.291393 0.095673 0.477101 1.213765 -0.191085 0.117017 0.016865 0.128090 1.052814 -0.223928 0.648751 1.402762 0.456990 0.553356 1.095940 1.027495 0.299767 0.447120 0.205834 1.452671 -0.085699 1.609363 1.101039 1.058600 -0.087300 1.595987 1.179897 0.004643 1.423903 0.778740 0.553053 1.139184 0.724189 1.453952 0.381783 0.586983 0.831862 1.181073 0.788144 1.024391 1.771531 1.598505 0.863121 0.198894 0.450345 0.085968 1.228457 0.544951 0.771388)
)
;;; 56 even --------------------------------------------------------------------------------
-#(56 10.014793395996 #(0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 1 0 0 1)
- 9.9184818267822 #(0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1)
- 9.7564358364052 #(0 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 1 1)
- 9.6809562784664 #(0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1)
+(vector 56 9.6809562784664 (fv 0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 1 0 1 1 0 1 0 1)
- 8.051716 #(0.000000 -0.110412 1.000081 0.393255 1.768905 1.133565 1.139366 -0.334691 1.165273 1.040609 1.739258 0.356497 0.814599 1.517852 1.042656 1.213413 1.223454 1.657048 1.639679 -0.139440 1.640233 1.720552 0.732182 0.850395 1.194087 0.394996 0.562011 1.363161 -0.131773 1.420268 -0.299733 1.097809 1.467136 1.408510 0.638192 1.303209 0.435031 1.517017 0.481789 0.322382 -0.061597 0.782900 0.638496 0.433164 -0.056603 1.743752 0.538457 0.464342 1.107758 1.869484 -0.155085 -0.289768 0.759107 1.180199 0.539669 1.538263)
+ ;; ce:
+ 8.011195 (fv 0.000000 0.008210 0.905992 0.396571 1.720897 1.158304 1.138541 -0.149073 1.014952 1.018591 1.745765 0.438732 0.854592 1.654860 1.011019 1.080405 0.999544 1.358343 1.494524 -0.322084 1.515909 1.690243 0.974840 0.937768 1.405811 0.436415 0.424543 1.360935 -0.014499 1.482939 0.090605 0.959441 1.032814 1.287153 0.868562 1.424617 0.689023 1.690605 0.303801 0.396076 -0.120753 1.039594 0.342297 0.231504 -0.042441 1.626406 0.755064 0.442808 1.366653 1.769637 -0.205340 -0.239797 0.934356 1.176593 0.655901 1.488666)
)
;;; 57 even --------------------------------------------------------------------------------
-#(57 10.246812120784 #(0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1 1 0)
- 10.116240908787 #(0 0 1 1 1 0 0 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 1 0 0 1 0 0 0)
- 9.9813938140869 #(0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1)
- 9.8992366790771 #(0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 1)
+(vector 57 9.8992366790771 (fv 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 1)
- 8.125098 #(0.000000 -0.075049 1.608340 1.588297 -0.170486 1.411066 0.276083 1.067740 1.372921 0.180790 1.656164 -0.078557 0.230465 0.078926 1.562644 1.587137 0.355360 0.375503 1.172674 0.142224 -0.041642 1.247135 0.054582 1.299077 1.091431 1.780977 1.783949 0.653874 0.745029 1.192595 1.408867 1.197635 1.354234 1.776582 1.397144 0.024568 0.492877 1.561210 1.257206 0.559596 0.553957 0.797601 0.210901 0.828758 0.113813 0.751912 -0.175344 1.575798 0.581419 1.294390 -0.062249 1.668605 1.588884 1.006717 0.443975 0.805651 -1.919954)
+ ;; ce:
+ 7.998443 (fv 0.000000 -0.014666 1.566831 1.522473 -0.249684 1.548885 0.061859 1.226467 1.343794 0.283370 1.644204 -0.263860 0.040445 -0.006696 1.612019 1.549636 0.536480 0.507272 1.129223 0.096416 0.070654 1.146329 0.116347 1.310955 1.044576 1.855920 1.741244 0.737054 0.646099 0.980172 1.413425 1.269711 1.581860 1.800144 1.281998 -0.058342 0.653062 1.547228 1.144145 0.578917 0.690679 0.861263 0.345954 0.676296 0.259007 0.725329 -0.285685 1.547409 0.602010 1.240793 0.038406 1.789143 1.881017 1.026132 0.600098 1.097228 -1.919911)
)
;;; 58 even --------------------------------------------------------------------------------
-#(58 10.486150288901 #(0 1 0 1 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1)
- 10.185283647732 #(0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 1 1 0 1 0 1)
- 10.040289878845 #(0 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 0 1 0 1)
- 9.8761510848999 #(0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 1)
+(vector 58 9.8761510848999 (fv 0 1 1 1 1 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 1 0 0 0 1)
+
+ 8.102746 (fv 0.000000 0.021804 0.347449 0.712574 0.904596 1.645925 0.230015 0.473992 0.104969 1.934740 1.209012 1.104800 1.062683 0.358409 0.785934 1.465266 1.235573 1.772411 0.072477 1.559281 1.754795 0.147077 0.219637 0.050078 1.441852 0.333339 0.672730 1.789640 1.230725 1.303568 1.622831 1.659814 0.995447 1.205094 1.295826 0.837873 0.521849 1.476121 0.531055 1.439237 1.534776 0.923559 1.866584 1.504388 0.402718 1.262304 0.589470 1.403389 1.379169 0.218840 1.535374 0.130494 0.618342 0.285582 1.711521 1.399310 1.463120 1.577451)
- 8.112914 #(0.000000 0.022129 0.347519 0.711875 0.905787 1.645367 0.230741 0.475874 0.104168 1.935121 1.209703 1.105200 1.061722 0.358385 0.787738 1.465115 1.236500 1.773625 0.073646 1.559984 1.755198 0.148352 0.219767 0.049641 1.441218 0.333975 0.672454 1.791541 1.230941 1.303696 1.622455 1.659982 0.997576 1.205454 1.297841 0.837559 0.523520 1.476683 0.531384 1.438450 1.535998 0.924978 1.866353 1.506465 0.400679 1.261238 0.589390 1.403733 1.378671 0.217998 1.537285 0.129987 0.619677 0.286667 1.712381 1.398881 1.464017 1.577660)
+ ;; nce:
+ 8.160514 (fv 0.000000 0.018101 0.649039 1.105139 0.805799 1.552840 0.507143 0.455093 0.410985 1.820561 0.914505 0.984750 1.066413 0.191884 0.653627 1.510871 1.561405 1.875189 -0.078120 1.639973 1.489309 -0.122302 0.187579 -0.137707 1.247718 0.796984 0.621022 1.565078 1.132796 1.098952 1.427880 1.663078 0.762131 0.965307 1.352999 0.722067 0.412348 1.684775 0.457834 1.443318 1.385930 0.962906 1.869715 1.351690 0.195092 1.084773 0.690763 1.132481 1.402235 0.306205 1.443881 0.266933 0.858427 0.045513 1.705481 1.280871 1.423605 1.246177)
)
;;; 59 even --------------------------------------------------------------------------------
-#(59 10.306503751934 #(0 1 0 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1)
- 10.305177937827 #(0 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1 1)
- 10.237511634827 #(0 1 1 0 1 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1 1)
- 10.094394683838 #(0 1 1 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1)
+(vector 59 10.094394683838 (fv 0 1 1 0 1 0 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1)
- 8.203866 #(0.000000 0.190448 1.065425 1.405641 0.668051 0.441510 0.460220 -0.028731 0.103022 1.234324 1.287468 0.261955 0.892308 1.623612 -0.079211 0.794350 1.676395 0.757617 1.624142 1.287403 1.022297 1.269905 0.622046 1.173500 0.638917 0.085221 0.804962 1.212452 -0.067963 0.211065 0.177993 0.447292 -0.092178 1.813239 1.121306 1.269328 -0.270652 1.861132 0.195962 0.087225 0.045055 0.257165 0.385478 0.151604 1.002982 0.353286 0.090528 1.494420 0.839823 1.423843 0.776678 -0.109491 1.897480 0.854361 0.283710 1.503842 1.605714 1.607028 0.286142)
+ 8.194538 (fv 0.000000 0.192440 1.064997 1.405447 0.666893 0.441718 0.460123 -0.029893 0.102290 1.233991 1.287456 0.262828 0.891341 1.622477 -0.078945 0.794492 1.676056 0.757298 1.625170 1.288224 1.021602 1.270621 0.622162 1.173256 0.639594 0.085293 0.804874 1.211161 -0.067577 0.210901 0.178378 0.446246 -0.092053 1.813463 1.120832 1.269392 -0.271084 1.861664 0.195222 0.087459 0.045547 0.257753 0.386709 0.151559 1.002452 0.352762 0.090741 1.494023 0.840240 1.424148 0.778422 -0.109268 1.896909 0.853535 0.284500 1.503148 1.606229 1.606587 0.287318)
)
;;; 60 even --------------------------------------------------------------------------------
-#(60 10.491376876831 #(0 0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0)
- 10.333255371943 #(0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0)
+(vector 60 10.333255371943 (fv 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 1 0 1 0 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0)
- 8.322204 #(0.000000 0.015783 0.100597 0.396118 1.343582 1.502599 0.249341 0.971362 0.737130 1.560772 0.263689 1.239822 -0.429148 -0.121752 1.529765 0.191904 1.270541 0.100979 0.618053 0.287175 0.310753 0.121755 0.646005 0.952035 1.140590 0.456121 0.631616 0.921737 0.397838 1.354393 1.176485 0.515773 0.170935 0.662300 1.320281 0.506584 1.564968 0.875496 0.530902 0.783473 0.470802 -1.818435 1.656522 0.207883 0.414360 0.204568 1.748953 1.237007 1.335573 0.084493 1.468792 1.666177 0.266453 0.650277 0.639484 0.431640 1.172232 1.862712 1.376133 0.482405)
+ 8.312421 (fv 0.000000 0.016764 0.099999 0.395290 1.344482 1.502674 0.248570 0.971438 0.736859 1.561216 0.263938 1.242184 -0.428796 -0.122031 1.528486 0.190921 1.269506 0.099840 0.618839 0.286668 0.310580 0.121766 0.645000 0.953645 1.140529 0.456214 0.631806 0.922426 0.396932 1.354468 1.176819 0.515695 0.171198 0.662750 1.320434 0.506395 1.565445 0.874857 0.531897 0.782628 0.471079 -1.819575 1.656923 0.206815 0.413621 0.205859 1.749126 1.236787 1.333671 0.085487 1.468799 1.666444 0.266215 0.649751 0.639546 0.431656 1.171882 1.863798 1.376382 0.482890)
+
+ ;; ce:
+ 8.297419 (fv 0.000000 -0.050827 -0.093113 0.415337 1.376502 1.483467 0.139153 0.992518 0.529850 1.653904 0.191931 1.095275 -0.256090 -0.161285 1.405742 0.150354 1.336151 -0.049296 0.676639 0.179468 0.223738 -0.026447 0.633754 1.009834 1.247179 0.478290 0.662079 0.748655 0.357085 1.374703 1.160927 0.429236 0.231499 0.680606 1.275377 0.482417 1.486029 0.955636 0.656194 0.784771 0.415616 -1.691681 1.767041 0.147548 0.371057 0.291191 1.824186 1.135403 1.361375 0.394251 1.554796 1.735953 0.147583 0.633615 0.589877 0.598198 0.971637 1.904531 1.249959 0.504018)
)
;;; 61 even --------------------------------------------------------------------------------
-#(61 10.587104797363 #(0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 0 1 1 1 1 0 1 1 1 0 0 1 1 0)
- 10.557340621948 #(0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1)
- 10.209 #(0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 0 0 1 0 0)
- 10.120587847566 #(0 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
+(vector 61 10.120587847566 (fv 0 0 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1)
- 8.366742 #(0.000000 1.258178 -0.273312 -0.168705 1.504274 1.206987 0.124830 -0.060690 1.610770 1.088327 0.680322 0.360767 0.164509 1.520465 0.956293 1.666741 0.199856 0.791789 1.474144 0.320023 0.484199 0.418716 0.784084 1.900509 0.044812 1.163999 0.060647 0.826762 0.560081 0.680754 0.248123 1.841603 1.410795 1.373990 0.020160 -0.230509 0.397032 0.190278 0.476117 1.250306 1.546711 0.144361 -0.183212 0.873189 0.114086 1.522621 1.359385 0.319344 1.069665 0.312618 0.724343 0.497185 1.189056 0.405328 1.583891 1.899038 0.211226 1.624462 1.735729 1.907653 -0.189631)
+ ;; ce:
+ 8.246633 (fv 0.000000 0.014137 0.312612 0.249295 0.935740 0.710600 -0.670222 0.029791 0.000981 1.147441 0.399682 0.888394 1.440126 0.108877 -0.294608 1.403751 1.053458 0.779516 0.066815 1.543587 0.107940 1.359190 1.494404 1.618478 0.815280 -0.244135 0.981345 0.739684 0.088784 1.710138 1.218977 0.672306 0.896304 0.148600 0.266242 0.612315 0.136648 0.136688 0.184375 -0.198309 0.518044 0.411032 1.286324 0.855547 0.828794 0.991646 1.167294 -0.167119 0.070397 0.487614 -0.198225 0.121902 0.696143 0.291992 0.984667 1.799531 0.623251 0.161592 0.779281 0.099176 0.369046)
)
;;; 62 even --------------------------------------------------------------------------------
-#(62 10.800075218392 #(0 0 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0)
- 10.501984943687 #(0 0 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 0 1 1)
- 10.318392753601 #(0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 0 1 1)
+(vector 62 10.318392753601 (fv 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 0 1 1)
- 8.400949 #(0.000000 0.864458 -0.038414 0.501196 0.179664 0.200103 0.407531 -0.098837 -0.037961 1.400638 1.554321 1.065607 1.126900 -0.411553 0.372081 1.689758 1.512318 0.827454 0.057927 1.183722 0.355224 0.869969 0.826354 1.068607 0.056042 0.926277 0.995230 -0.406458 1.243519 1.409181 0.624163 1.296775 0.600916 1.816174 1.916791 0.665361 1.150089 0.642924 0.000005 0.107098 1.146904 1.336151 0.730713 0.682578 1.190263 0.380013 0.515520 0.587980 0.783771 1.268497 1.454622 1.495985 0.332311 -0.411738 0.643838 0.803147 1.052427 1.562574 0.968975 0.734810 -0.027945 1.711163)
+ 8.390962 (fv 0.000000 0.864131 -0.039302 0.501838 0.179590 0.198870 0.408743 -0.099436 -0.035241 1.399095 1.555420 1.066003 1.126029 -0.412606 0.371657 1.690168 1.511157 0.827619 0.057876 1.184261 0.354886 0.869166 0.825315 1.069197 0.055544 0.926747 0.994446 -0.406535 1.243161 1.409918 0.623323 1.296612 0.600545 1.814707 1.913723 0.665613 1.150575 0.642943 -0.000728 0.108004 1.148509 1.338004 0.731747 0.682804 1.190657 0.379742 0.514953 0.586813 0.784946 1.269079 1.453729 1.496418 0.332671 -0.412333 0.644169 0.803815 1.053593 1.563066 0.967726 0.733563 -0.027726 1.710240)
)
;;; 63 even --------------------------------------------------------------------------------
-#(63 10.855396270752 #(0 1 1 1 0 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1)
- 10.68339442069 #(0 0 1 0 0 1 0 1 0 0 1 1 1 1 1 1 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 1 1 0)
- 10.562 #(0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 0 1 1 0)
- 10.45694065094 #(0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 1 0)
+(vector 63 10.45694065094 (fv 0 0 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 1 0)
- 8.423739 #(0.000000 0.009618 0.821970 1.791486 0.181797 1.698882 1.457656 1.781295 1.048149 0.064354 0.657063 -0.016828 1.426542 1.490520 0.019540 1.749210 0.167274 0.935034 0.018191 0.949896 1.164924 0.695576 0.666858 0.087167 1.619921 0.168429 1.102017 0.391291 0.229536 0.703529 0.621279 0.344319 1.518995 1.513271 1.627483 0.238304 1.445712 1.071970 0.772616 1.186586 1.488906 -0.089969 0.947360 1.288821 1.143896 0.328817 1.580654 1.515556 1.753428 1.826180 0.654622 1.606246 1.482414 0.742232 0.684914 0.938228 1.078022 0.077160 1.128623 0.769036 0.655262 1.252793 1.466376)
+ 8.413888 (fv 0.000000 0.010634 0.820887 1.791906 0.180821 1.699733 1.457775 1.781040 1.049055 0.063682 0.656198 -0.016519 1.426220 1.490473 0.018505 1.749295 0.166920 0.934178 0.018879 0.949939 1.163838 0.694420 0.665805 0.087679 1.619302 0.169784 1.099805 0.390614 0.230991 0.703447 0.620497 0.345622 1.520041 1.514348 1.626503 0.238228 1.445149 1.071455 0.772257 1.186699 1.488207 -0.090097 0.947955 1.288711 1.143854 0.328539 1.581009 1.516219 1.752145 1.825272 0.656629 1.607807 1.482688 0.741468 0.684282 0.938749 1.078766 0.076298 1.127102 0.768415 0.654765 1.253057 1.466721)
)
;;; 64 even --------------------------------------------------------------------------------
-#(64 10.952004432678 #(0 0 0 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1 1 1 0 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1)
- 10.532917976379 #(0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 0 0 0 1 1 1 1)
- 10.487 #(0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 1)
+(vector 64 10.487 (fv 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 1)
- 8.509604 #(0.000000 -0.109816 0.253364 0.149301 0.516905 1.679792 0.261913 -0.312318 1.498264 0.133866 0.193613 1.528669 0.125592 1.681793 0.957197 -0.016188 0.162582 1.232993 0.955891 1.516226 1.272605 0.226438 1.801864 0.923759 0.995912 1.136206 0.893362 1.310802 1.256738 0.313762 0.968574 0.136641 1.841715 1.348696 1.399350 -0.194184 1.345738 1.529009 1.112038 1.362452 0.328012 0.804639 1.815965 1.479086 0.165332 1.500776 0.227702 0.804746 0.516051 0.094935 1.527961 1.274895 0.915516 0.129175 1.022920 1.363005 -0.188515 -0.124972 -0.176986 0.991840 1.710523 0.183329 0.509340 0.492026)
+ 8.500897 (fv 0.000000 -0.110230 0.253682 0.149208 0.517156 1.680690 0.261962 -0.311932 1.499119 0.134139 0.193946 1.528316 0.126448 1.680960 0.957330 -0.015272 0.163098 1.233151 0.955877 1.516677 1.271750 0.225924 1.801609 0.924065 0.996478 1.135973 0.892170 1.311436 1.257336 0.314351 0.968388 0.136861 1.841069 1.348391 1.398845 -0.195293 1.345125 1.529238 1.112945 1.363188 0.328366 0.804723 1.816185 1.478898 0.163962 1.500837 0.226838 0.805475 0.515967 0.095385 1.528024 1.274946 0.915048 0.129649 1.022985 1.362093 -0.189345 -0.123957 -0.176055 0.992212 1.710004 0.183155 0.509794 0.492211)
)
;;; 65 even --------------------------------------------------------------------------------
-#(65 10.903659606228 #(0 1 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 1 0)
- 10.842938423157 #(0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0)
- 10.593795776367 #(0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0)
+(vector 65 10.593795776367 (fv 0 1 1 1 1 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0)
- 8.676233 #(0.000000 0.112163 -0.020943 0.116222 1.900963 0.396563 1.680825 1.359761 0.348760 0.415953 0.967290 1.337470 -0.203131 1.378048 1.264366 0.201078 -0.125589 1.489689 1.148806 1.935596 0.883170 0.691985 1.773701 0.524202 0.644363 1.274691 1.471186 -1.905538 1.695202 0.750834 0.849476 1.497329 0.223646 -0.093592 1.666162 1.784490 1.446477 1.274874 1.071737 0.210664 -1.857175 -0.017456 1.017967 0.391342 0.268683 0.786955 1.375875 0.677944 1.512094 1.733629 0.560046 1.132913 0.709727 1.135353 0.972177 1.172228 1.352208 0.943698 0.013046 0.901823 0.155118 0.962186 1.792401 0.893322 0.983558)
+ ;; ce:
+ 8.609777 (fv 0.000000 0.010286 0.073308 0.156025 1.953119 0.326605 1.156187 1.359503 0.615092 0.625095 1.209776 1.377583 -0.310622 1.815585 1.618945 0.328652 -0.127781 1.904210 1.297763 1.916187 0.801813 0.929154 1.581967 0.478151 0.556340 1.031862 1.480609 -1.661291 1.218834 0.549647 1.223081 1.263443 0.189207 -0.057436 1.688891 1.890453 1.705454 1.164550 1.023002 0.394890 -0.072758 -0.362543 1.102983 0.220165 0.570828 0.506586 1.236790 0.668284 1.330270 0.072079 0.187084 1.026028 0.423887 1.229321 0.594086 1.447463 0.979393 0.850808 0.463831 1.022159 0.562154 0.740405 1.709952 0.862548 0.909149)
)
;;; 66 even --------------------------------------------------------------------------------
-#(66 10.77367179842 #(0 0 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0)
+(vector 66 10.77367179842 (fv 0 0 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 0)
- 8.796537 #(0.000000 -0.016565 -0.199772 1.161953 1.340921 1.507345 1.884822 1.592890 -0.264955 1.193446 1.763610 1.251194 1.537957 0.544119 1.032882 1.490336 1.404282 1.717014 0.287837 0.531797 1.877650 0.316163 1.149173 0.919447 1.194978 1.640717 1.061188 1.597782 0.182177 0.877909 0.469220 1.276806 0.227677 1.747063 0.513978 1.113553 0.297947 0.431893 1.223247 1.530102 0.441349 -0.053149 0.261439 0.093282 1.260730 1.766200 0.227199 0.642564 0.323006 1.113189 0.112534 1.357466 1.090446 1.458044 1.160341 1.034050 1.054997 0.783892 -0.001837 -0.182403 1.221068 0.823179 -0.075372 1.345444 0.412421 0.097624)
+ ;; ce:
+ 8.678699 (fv 0.000000 0.454997 1.496948 0.519770 1.672039 0.567223 1.755017 0.736664 1.985212 1.381007 0.655920 0.131168 1.193358 0.617219 1.831999 1.143743 0.488405 0.001490 1.636224 1.056726 0.387222 0.101202 1.826852 1.187505 0.710721 0.377670 0.096617 1.812536 1.688958 1.476343 1.264972 1.142558 1.049579 0.690750 1.195534 0.929938 1.522099 1.266451 1.390797 1.538518 1.605610 1.574083 1.889598 0.006801 0.695550 0.832932 1.160944 1.293180 1.683176 0.244325 0.530816 1.180483 1.812767 0.268820 0.993683 1.695534 1.919653 0.449948 1.560150 0.338318 1.266700 1.853107 0.910590 1.381060 0.420174 1.311948)
)
;;; 67 even --------------------------------------------------------------------------------
-#(67 11.373999595642 #(0 0 0 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 1)
- 11.240343093872 #(0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 1 0 0 1 0 0 0)
- 10.668939590454 #(0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0)
+(vector 67 10.668939590454 (fv 0 1 1 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 0 0 1 0 0 0)
- 8.835053 #(0.000000 0.010432 1.067312 1.823178 0.520025 1.575911 1.617290 1.745863 0.829242 0.596665 -0.041816 0.699062 0.848421 0.694448 1.111783 0.095084 0.244326 1.231901 0.052099 1.837733 0.259234 1.003181 1.401757 -0.435611 0.594875 0.010165 1.327407 1.545415 1.104676 0.146824 0.409648 0.023560 1.316036 0.912041 0.978196 0.798923 0.869656 1.526399 0.141251 0.229975 1.274429 0.150124 1.174373 1.754998 1.483685 -0.005378 0.425550 0.852442 0.307207 0.829266 0.566795 1.599556 0.655955 0.602546 1.899205 0.916988 0.312525 0.511941 0.157463 0.489305 0.669253 0.004951 -0.294560 0.852858 0.482025 0.633699 0.790773)
+ ;; ce:
+ 8.715278 (fv 0.000000 -0.048714 1.201233 1.932201 0.432152 1.784378 1.706119 1.715110 0.918127 0.634326 -0.280426 0.736091 0.881233 0.715749 1.255373 0.306961 0.430124 1.043814 0.355900 1.887422 0.161687 0.974683 1.590380 -0.300251 0.580494 -0.035950 1.388432 1.396578 1.262995 0.125471 0.427569 0.132635 1.747845 1.090690 1.059664 0.781885 0.922127 1.269399 0.290961 0.283370 1.543322 0.245179 1.267332 1.559397 1.540498 0.278811 0.442330 0.979302 0.305622 1.057402 0.123531 1.659773 0.687811 0.574242 1.988850 0.928855 0.118304 0.916897 0.064414 0.547707 0.733829 0.168859 0.108897 0.552498 0.271579 0.641458 0.722670)
)
;;; 68 even --------------------------------------------------------------------------------
-#(68 11.328473091125 #(0 1 0 0 0 1 0 0 1 1 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 0 1 0)
- 10.834321813096 #(0 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 1 0)
+(vector 68 10.834321813096 (fv 0 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 1 0)
- 8.809500 #(0.000000 -0.202517 0.845118 1.587036 1.066385 -0.149048 1.120701 1.659704 1.089136 0.137847 1.655937 0.159606 -0.124937 1.734273 1.001533 0.710533 0.504254 1.211009 1.009962 1.203524 1.334762 0.904948 1.913924 1.907876 1.555425 -0.288261 1.586544 0.759985 1.389250 1.332004 0.077351 0.448382 -0.177637 -0.044235 -0.034330 0.027252 1.219797 0.348668 -0.196501 1.482537 -0.006026 0.929636 1.400397 1.457243 1.736107 0.445590 1.030188 0.901988 1.049510 0.147665 1.403488 0.554585 0.395915 0.569494 0.899139 1.449076 0.649048 1.959354 0.043951 0.923701 1.632731 0.515794 1.025395 1.436786 0.995949 0.734092 0.009900 1.885069)
+ ;; ce:
+ 8.754943 (fv 0.000000 0.006701 0.662467 1.132456 -0.029127 0.614111 1.150467 1.706479 0.619454 1.199242 1.758840 0.562498 1.597544 0.407921 1.558651 0.097672 0.926756 -0.032275 0.853950 0.002762 0.680777 1.599641 0.725147 0.147702 1.201496 0.263849 1.380478 0.615269 0.086221 1.573333 1.233822 0.463104 -0.134996 1.463347 0.467790 -0.201328 1.692933 1.307865 0.941345 0.423601 0.364303 1.897445 -0.044200 1.168331 0.738828 0.662829 0.834882 0.503840 0.773952 0.485349 0.168198 0.227087 0.122039 0.075266 0.590053 0.402757 0.920519 0.805378 1.169878 1.002493 1.566599 1.933905 0.435730 0.760806 1.023096 1.785992 1.801946 0.257114)
)
;;; 69 even --------------------------------------------------------------------------------
-#(69 11.439030647278 #(0 0 1 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0)
- 11.237507249543 #(0 0 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 0 0)
- 11.164121627808 #(0 0 0 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0)
+(vector 69 11.164121627808 (fv 0 0 0 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 0 1 0)
+
+ 8.870351 (fv 0.000000 -0.002928 0.090043 1.728264 1.193144 0.838010 0.865027 0.720973 0.639322 0.246096 0.057627 0.302959 -0.048089 1.638389 0.900762 0.946630 1.090094 0.801115 1.083281 1.325801 0.953024 0.800047 1.660883 0.042716 1.927302 1.582152 0.107129 0.057190 -0.097633 0.434745 0.530943 1.556013 -0.117080 1.617479 1.566580 -0.082197 0.137002 1.745306 1.025473 1.476477 1.524388 0.192617 1.281951 0.528156 0.227376 1.631586 1.077576 0.616842 1.479500 0.199402 1.336867 0.525138 1.593133 1.323175 0.217188 0.498012 1.287694 0.007842 1.310482 0.013236 0.970642 -0.011247 0.684481 1.560396 -0.131105 0.613388 0.586300 0.981366 1.715362)
- 8.882183 #(0.000000 -0.002452 0.089327 1.727919 1.191918 0.837252 0.865293 0.721066 0.640976 0.246203 0.058788 0.303607 -0.048842 1.638810 0.901375 0.946486 1.089842 0.800794 1.083001 1.326249 0.953183 0.799812 1.661496 0.042534 1.927486 1.582672 0.107035 0.056444 -0.098881 0.435817 0.531089 1.556172 -0.117172 1.616821 1.565038 -0.082712 0.136727 1.745387 1.025423 1.476190 1.523800 0.192013 1.281891 0.528262 0.226304 1.630399 1.076247 0.616096 1.479281 0.200550 1.337842 0.524937 1.593755 1.323462 0.216670 0.497835 1.287864 0.006701 1.310527 0.012951 0.970966 -0.011886 0.684710 1.561500 -0.130709 0.613578 0.586721 0.981115 1.714520)
+ ;; ce:
+ 8.871460 (fv 0.000000 0.024677 0.348753 1.853212 1.026433 0.764498 0.988619 0.726212 0.717099 0.354110 0.211391 0.453497 0.101716 1.483433 0.914508 0.822283 0.913048 0.815074 1.083064 1.158865 1.024685 0.695931 1.752852 0.025183 1.742985 1.441890 0.242171 0.072208 0.012411 0.538299 0.676243 1.315025 0.155925 1.560315 1.592984 0.078875 0.242794 1.804492 0.950070 1.285093 1.411716 0.049957 1.246246 0.728985 0.030862 1.434432 1.085297 0.759494 1.436818 0.422412 1.268623 0.590795 1.364269 1.235546 0.170900 0.477972 1.127120 -0.054549 1.479098 0.172668 1.199653 -0.107230 0.674735 1.486658 -0.230242 0.542693 0.703829 0.966900 1.458811)
)
;;; 70 even --------------------------------------------------------------------------------
-#(70 11.561226844788 #(0 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 1 1 0 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 0 1)
- 11.405939102173 #(0 1 0 1 0 0 1 0 0 1 0 1 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 0 1)
- 11.188811302185 #(0 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 1)
+(vector 70 11.188811302185 (fv 0 1 1 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 1 0 1 1)
- 9.013944 #(0.000000 0.131681 0.592478 0.187596 -0.153998 0.551744 1.683398 0.676244 0.114007 1.447068 0.845975 -0.399654 1.332904 0.663426 0.497139 1.152005 0.418991 0.298935 0.897888 0.507104 -0.045324 1.145797 1.680818 0.271880 0.375367 0.829257 0.132587 1.611154 0.410334 1.132847 1.436330 1.541024 1.000170 0.350151 0.552733 0.558090 -0.054241 1.896172 0.975454 0.128331 0.669765 1.321132 0.944958 1.793472 0.061180 0.313421 0.594071 0.216950 0.385332 1.353799 0.034986 -0.420373 -0.050342 0.525245 -0.047519 1.516646 1.493169 0.638418 0.504073 1.794738 0.411171 1.278792 0.524285 0.918799 0.874163 1.136481 1.069720 1.351179 1.308601 1.153516)
+ ;; ce:
+ 8.848811 (fv 0.000000 0.246703 1.002261 0.886061 0.801873 1.809738 1.108544 0.562043 1.825392 1.804522 1.262385 0.421389 0.361557 1.923401 1.951742 1.062427 0.438003 0.228289 1.097160 1.013865 0.764041 0.470243 0.831289 0.101425 1.763202 0.709481 0.498799 0.216191 0.861166 0.122620 0.547738 1.235046 0.857238 0.383439 0.822746 0.754977 0.703208 0.715041 0.359010 1.832044 0.247507 1.317151 1.405217 0.206638 0.707472 1.340219 1.707159 1.823029 1.938700 1.479437 0.258261 1.667534 0.316971 1.157956 1.277369 0.826722 1.196822 0.248386 0.546752 1.821030 1.066474 1.952221 1.238401 0.305398 0.369743 0.877722 1.232005 1.532682 1.629962 0.062770)
)
;;; 71 even --------------------------------------------------------------------------------
-#(71 11.438183906719 #(0 1 1 1 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 0)
- 11.28450554254 #(0 1 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 0)
- 11.146488189697 #(0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0)
+(vector 71 11.146488189697 (fv 0 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0)
- 9.114856 #(0.000000 0.079512 0.625637 1.258690 0.530271 1.102376 1.093859 0.924603 1.127361 1.465196 1.978988 0.781071 1.701646 0.435589 0.972835 1.155327 1.250855 0.950011 1.850158 1.204728 -0.103064 0.326705 1.400609 1.779285 0.762070 0.256054 0.297017 0.663174 0.185495 0.230410 0.275812 0.274632 1.444487 0.206163 1.664388 0.390994 1.586947 1.028266 -0.035793 1.646808 1.740352 1.373293 0.064075 0.508392 0.692252 0.633670 -0.002972 0.245396 0.212616 0.224802 1.243207 1.008003 -0.140506 -0.201647 0.435289 1.385341 0.505875 0.468274 1.777445 1.329508 0.574054 0.141199 1.636750 -0.043895 -0.187385 0.966166 1.053784 0.643080 0.361303 0.135234 1.188823)
+ ;; ce:
+ 8.877033 (fv 0.000000 0.494925 1.537244 0.892084 0.150008 1.375283 0.111396 0.180070 1.039621 1.603551 0.974071 0.067462 1.566530 0.645476 1.559374 0.286202 1.250076 1.040362 0.597158 0.170031 1.495084 0.538551 1.605790 0.911462 0.561795 0.131327 0.669920 1.494711 1.488338 0.162432 0.349959 1.071758 0.876821 1.835299 1.877472 1.338427 1.055237 0.961547 0.343936 0.685277 1.268629 0.932565 0.412531 1.233930 1.960684 0.356135 1.869394 1.068031 1.470058 1.669216 1.450884 1.495861 1.103585 1.290131 0.589390 1.675751 1.864756 1.328404 1.588855 1.689588 1.394915 1.481997 1.790524 0.376533 0.659979 0.194369 0.714680 1.009374 1.293563 1.133522 0.906132)
)
;;; 72 even --------------------------------------------------------------------------------
-#(72 11.543568607158 #(0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 1 1 0)
- 11.492732978803 #(0 0 0 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1)
- 11.323646371629 #(0 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0)
+(vector 72 11.323646371629 (fv 0 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0)
- 8.999641 #(0.000000 -0.129280 0.251897 -0.154350 1.236715 0.220574 0.101679 0.999358 1.284174 0.195939 1.573231 0.404892 1.031540 -0.200961 0.592507 0.635634 1.000142 1.218428 0.877389 0.893481 0.592403 0.848098 0.476370 0.520631 1.077636 0.564131 1.203934 1.187341 1.029801 1.266759 0.667825 -0.431659 0.484361 0.764220 0.428949 0.085191 1.685345 -0.153912 0.748809 1.100839 -0.155691 1.176123 0.117185 0.702507 0.527513 1.670283 1.316719 0.695926 0.044796 0.737927 1.072838 1.523887 1.860563 -0.166699 1.584859 -0.032004 0.368939 1.075747 0.934197 0.509926 0.367329 1.530382 0.338533 0.867641 1.012369 0.843777 0.372382 1.597883 0.201202 1.450486 0.578394 0.229918)
+ 8.985526 (fv 0.000000 -0.132001 0.251840 -0.152367 1.238134 0.223104 0.102612 0.998567 1.283059 0.195894 1.573363 0.407537 1.033361 -0.202081 0.593147 0.635495 1.000647 1.220151 0.876169 0.891935 0.590452 0.848621 0.474219 0.520369 1.077034 0.562333 1.205154 1.187120 1.031050 1.268084 0.666333 -0.432529 0.483326 0.764356 0.428610 0.084679 1.685196 -0.154809 0.749260 1.099715 -0.153921 1.175926 0.117589 0.701530 0.528397 1.669792 1.315998 0.695987 0.047259 0.736352 1.073555 1.525504 1.860608 -0.168018 1.587814 -0.029717 0.367471 1.076978 0.934753 0.510954 0.369425 1.530708 0.338598 0.869566 1.012951 0.841118 0.372289 1.598627 0.202786 1.450618 0.578685 0.231358)
+
+ ;; nce:
+ 8.996610 (fv 0.000000 0.020435 0.148826 -0.173981 1.377729 0.211130 0.166992 1.053622 1.458337 0.005572 1.576161 0.391690 1.074146 -0.213327 0.588223 0.422230 0.994634 1.149413 0.858889 0.855458 0.451324 0.722371 0.451607 0.485779 1.099748 0.481778 1.183724 1.119200 0.986503 1.262651 0.778215 -0.493824 0.577630 0.838272 0.526378 0.254738 1.698601 -0.156321 0.698602 1.048110 -0.140804 0.991469 0.138073 0.652727 0.457506 1.770023 1.311357 0.782250 0.170414 0.740584 1.195615 1.519642 1.761376 -0.154135 1.542454 -0.027224 0.389381 1.045008 1.107881 0.609081 0.244277 1.495852 0.294775 0.922470 1.153689 1.027914 0.296649 1.621186 0.277016 1.409256 0.557607 0.152023)
)
;;; 73 even --------------------------------------------------------------------------------
-#(73 11.708482477396 #(0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0)
- 11.567651928526 #(0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 0 0)
- 11.416394233704 #(0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0)
+(vector 73 11.416394233704 (fv 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 0)
- 9.173211 #(0.000000 0.026931 1.901549 0.868511 0.647540 0.077472 1.155920 -0.019917 0.517365 0.616412 1.388394 1.521405 1.173142 1.149732 0.333154 0.392798 1.620884 0.186114 0.977691 0.373139 1.548567 1.129525 1.464743 -0.104222 0.005842 0.038335 0.391928 0.425433 0.819755 0.701894 0.292217 0.070286 0.577383 0.675639 0.714009 0.871963 0.472933 1.695281 1.421418 0.023555 1.158610 1.177981 0.998322 0.330393 0.619100 0.124091 0.703210 0.123850 0.616158 1.673754 -0.285766 0.254546 1.422185 1.558015 0.228600 0.264599 1.727004 1.336216 1.778170 1.199873 0.637494 1.730410 1.218642 1.737207 -0.025321 0.920527 1.364456 0.696315 1.619992 0.362395 1.172036 0.183705 -0.057535)
+ ;; ce:
+ 9.061347 (fv 0.000000 -0.013492 0.700057 0.971458 1.656489 0.226217 1.266397 1.217251 0.034107 1.132703 0.209805 0.859555 1.676063 0.359664 0.948491 1.631395 0.566735 1.564253 0.503600 1.614448 0.423074 1.551405 0.311534 1.292368 0.836304 0.277624 0.872873 0.108697 1.546043 0.974228 -0.054286 1.516659 0.873622 0.075543 -0.025545 1.027508 0.575666 -0.130582 1.023997 1.136740 0.704834 -0.015132 -0.346526 1.509690 1.112218 0.655940 0.431045 0.092523 0.384582 -0.406961 0.058570 -0.216957 1.536312 1.587308 1.645182 1.277358 1.546578 1.141387 -0.381783 1.707248 -0.163708 -0.313272 -0.263055 0.347717 0.363093 0.778459 1.216671 1.669453 -0.038813 0.148398 0.866038 0.847643 1.513063)
)
;;; 74 even --------------------------------------------------------------------------------
-#(74 11.869382858276 #(0 0 0 1 0 0 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 1 1)
- 11.749699425492 #(0 0 0 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1)
- 11.47264289856 #(0 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 1)
+(vector 74 11.47264289856 (fv 0 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0 1 1)
- 9.263570 #(0.000000 -0.084027 -1.881031 1.820622 1.386379 0.814061 0.860965 0.758823 0.122948 1.299348 0.054781 1.146445 -0.196258 1.076883 0.908773 1.144675 1.888291 1.269798 -1.733988 0.151695 0.784450 1.818161 1.112375 -0.147585 1.931580 0.243199 1.662395 0.943448 1.105225 1.261639 1.617629 0.224343 0.029136 1.852666 1.670412 0.240423 0.497364 1.728775 1.313182 0.805217 0.890606 1.313709 -0.176114 0.372546 -0.004865 1.850208 0.023896 0.121127 1.553046 0.216148 1.685695 1.976294 1.786296 0.458823 1.346316 1.634248 0.393595 1.234148 0.957013 0.674688 1.604052 1.155047 0.690092 0.676870 1.253331 1.633711 -0.333171 1.029786 0.123566 1.137032 1.697482 0.219129 1.297137 0.608891)
+ ;; ce:
+ 9.134480 (fv 0.000000 0.102279 0.371397 0.523001 1.843248 1.152941 1.651341 1.411384 0.791794 0.097952 1.057024 0.161099 0.857363 0.427397 0.372120 0.661194 1.523876 0.922082 -0.041073 -0.033604 0.996743 1.697191 1.295880 0.242720 0.296660 0.925120 0.229105 1.701968 1.808512 0.155026 0.755549 1.603330 1.534401 1.305218 1.056671 1.959110 0.012243 0.095634 0.866653 0.499791 0.642664 1.366362 0.320578 0.556112 0.471836 0.546071 0.453257 0.620145 0.487633 1.413108 0.647644 1.248023 1.294495 1.814325 0.514274 1.440895 0.132821 0.969503 0.559010 0.339598 1.732485 1.513938 0.682886 0.936970 1.342790 0.397470 0.364797 1.929409 1.198862 0.270546 1.048858 1.252852 0.860205 0.013479)
)
;;; 75 even --------------------------------------------------------------------------------
-#(75 12.015588177241 #(0 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 0 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1)
- 11.787453747993 #(0 1 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 0 1 0 1 1 0 0 0 0 0 1)
- 11.599789619446 #(0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1)
- 11.479255355845 #(0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1)
+(vector 75 11.479255355845 (fv 0 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 1)
- 9.221262 #(0.000000 0.085310 1.363467 0.177935 1.633734 1.010267 0.073480 1.094419 0.754314 0.141480 0.840213 0.080469 0.755348 1.735854 0.012281 1.279064 0.142632 1.016730 1.483377 0.042178 0.531843 1.485182 0.064705 -0.031285 1.192319 1.198950 -0.183826 0.922535 0.855495 0.104223 1.560153 0.494815 -0.611634 1.766462 1.656204 -0.040687 -0.011161 1.318226 -0.124427 1.445070 0.197683 0.029322 1.681516 1.556816 1.182411 0.923080 1.218502 1.571140 -0.485027 0.228759 1.000954 1.228682 0.723477 -0.001381 0.005096 0.223274 0.622246 0.014663 0.003370 1.251942 0.962389 0.692357 0.931822 -0.201767 0.436886 0.014560 0.745095 0.368142 0.804882 1.305211 1.114881 -0.150527 -0.350656 1.448480 1.333461)
+ ;; ce:
+ 9.136718 (fv 0.000000 0.002886 1.335455 0.159358 1.480181 0.946385 -0.044639 1.084031 0.633473 0.070872 0.846110 0.073920 0.712875 1.849807 0.002049 1.333644 0.084510 1.217578 1.455838 0.351015 0.583697 1.521673 -0.105875 -0.161704 1.008277 1.067855 -0.227255 1.066234 0.968179 0.069816 1.652420 0.515209 -0.583628 1.701274 1.644474 0.045597 -0.072256 1.396842 -0.036343 1.242335 0.205214 -0.046339 1.655176 1.585631 1.056865 0.812824 1.251896 1.501857 -0.501015 0.327372 1.079894 1.360106 0.639144 -0.102077 0.025865 0.258537 0.650404 0.029251 0.316419 1.073801 1.065871 0.953311 0.976263 -0.016818 0.369518 -0.028524 0.754304 0.267168 0.876021 1.386930 1.128217 -0.044803 -0.305853 1.417010 1.210349)
)
;;; 76 even --------------------------------------------------------------------------------
-#(76 11.890932162956 #(0 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1)
- 11.477294510597 #(0 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1)
+(vector 76 11.477294510597 (fv 0 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1)
- 9.407825 #(0.000000 0.083486 1.747635 1.385354 1.267959 0.331661 0.961293 1.065603 0.130366 0.045061 1.434505 1.152287 1.280714 1.668618 0.249531 0.393192 1.697500 1.580316 0.803451 1.930809 1.212539 1.250456 1.314556 1.414420 1.021167 1.409071 1.402235 0.862502 0.733608 0.385016 1.014250 1.271619 0.439848 0.152007 1.210433 1.482443 0.380213 0.804923 1.796144 0.607869 0.415155 0.498594 1.036925 1.244809 0.533278 1.075916 0.380849 1.202201 1.545114 1.430244 1.579758 1.539121 0.016711 1.228393 0.057263 1.221469 0.648202 -0.142545 1.405369 -0.018892 1.530465 0.679656 0.540116 0.587014 1.389697 1.692489 0.071181 -0.122521 0.166179 1.721930 0.857634 1.339404 0.199699 0.951572 0.605326 1.638639)
+ ;; ce:
+ 9.274323 (fv 0.000000 -0.012165 1.750183 1.230595 1.387108 0.131448 0.902665 1.325819 0.139220 0.132421 1.315838 0.916320 1.247629 1.543004 0.326242 0.479315 1.525889 1.714627 0.992625 1.849378 1.028201 1.309429 1.365818 1.322280 1.222257 1.381076 1.644593 0.773733 0.614835 0.306624 1.009114 1.162734 0.610055 0.099066 1.125761 1.356329 0.324777 0.800340 1.850117 0.710340 0.610191 0.810114 1.107918 1.417728 -0.023776 1.259738 0.196765 1.355631 1.575090 1.576385 1.741085 1.748236 0.050375 1.081011 0.178534 1.097122 0.438057 -0.170346 1.371443 0.019537 1.307599 0.833238 0.430491 0.202986 1.382655 1.791419 0.002565 0.061873 0.176928 1.554826 0.852820 1.065814 0.297645 0.742549 0.387652 1.429885)
)
;;; 77 even --------------------------------------------------------------------------------
-#(77 11.909692733602 #(0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 0 0 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1)
- 11.875939332637 #(0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 1 1)
- 11.594018936157 #(0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1)
+(vector 77 11.594018936157 (fv 0 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1)
- 9.374510 #(0.000000 0.134220 -0.169213 -0.107475 1.467161 1.487216 0.488154 0.769253 1.294580 0.614637 1.374209 0.964474 -0.054726 1.225075 1.759943 0.168497 0.328631 1.433143 0.756375 1.138386 0.976348 1.501592 0.479787 1.457115 1.816319 1.254115 0.661872 0.508558 1.119210 0.606672 1.260166 -0.125159 0.827645 1.361140 0.199864 0.894440 0.816656 0.872364 0.197626 0.011533 0.602157 1.006683 0.036687 0.728533 0.181576 0.796788 0.738374 1.238113 1.975836 0.372113 0.037131 1.775158 0.993865 0.189745 1.830078 0.128397 1.937883 1.118643 0.779947 0.811581 0.852696 1.096069 0.878652 0.342773 0.818181 1.089582 0.596362 1.186741 1.149839 1.789869 1.736355 0.808680 0.581727 1.448926 1.851680 1.376542 0.992615)
+ ;; ce:
+ 9.277681 (fv 0.000000 -0.007935 0.356695 -0.167840 1.436050 1.267495 0.166108 0.719740 1.788089 0.701383 1.502062 0.971109 -0.201146 1.261312 1.596232 0.380082 0.436900 1.530759 0.673592 1.168750 0.815135 1.757429 0.573966 1.406748 1.792933 1.256151 0.643583 0.884960 0.868508 0.759790 1.464002 -0.196244 0.635729 1.419530 -0.026848 0.857441 0.646295 0.815860 0.331225 0.324537 0.379771 0.793029 -0.189194 0.533286 0.175986 1.162021 0.894997 1.330799 0.028604 0.329088 -0.042751 1.722552 1.010170 0.365295 -0.089972 0.186813 0.250172 1.045796 0.805669 1.150679 1.074682 0.666765 1.119179 0.223717 0.745979 0.727191 0.250299 1.103832 0.833082 -0.215344 1.645081 0.897326 0.690160 1.501085 1.581868 1.570534 1.086810)
)
;;; 78 even --------------------------------------------------------------------------------
-#(78 11.940728787203 #(0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0)
+(vector 78 11.940728787203 (fv 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 0)
- 9.350215 #(0.000000 1.406014 1.136271 0.627748 0.129558 0.271741 0.003626 1.739436 1.296042 1.387540 0.096579 1.822272 0.846050 1.039368 1.481252 0.895833 0.826019 0.840770 0.430659 0.718741 1.652426 0.733196 0.670625 1.833755 0.965666 1.267942 1.851534 1.170087 1.403059 0.720722 1.055697 1.444328 1.322020 1.350596 0.414838 0.929643 1.496792 0.894908 0.004237 1.201066 1.802474 0.448098 1.139997 0.075691 1.121063 0.477457 1.722933 0.403110 0.668388 0.045861 1.846300 0.961184 0.765234 1.815305 0.327684 0.120655 1.324253 1.238351 1.405422 -0.005822 1.465722 1.535894 1.050642 0.249749 1.956000 0.420863 0.290249 0.855379 1.032136 0.874983 1.340023 0.850930 1.473229 1.079667 -0.020851 0.624995 0.620989 1.381542)
+ 9.335941 (fv 0.000000 1.404748 1.136727 0.627680 0.129528 0.271686 0.002711 1.737837 1.295987 1.387168 0.097658 1.822832 0.846464 1.039100 1.481322 0.895294 0.827592 0.841157 0.429643 0.718521 1.651578 0.732848 0.670593 1.833752 0.966314 1.266799 1.852734 1.169793 1.403542 0.722295 1.054728 1.444480 1.323054 1.351419 0.414445 0.928183 1.497407 0.895056 0.003473 1.202042 1.804296 0.448756 1.139768 0.075452 1.121542 0.477216 1.723231 0.402648 0.668323 0.045598 1.846940 0.961710 0.765295 1.814929 0.327072 0.120487 1.324670 1.238079 1.405578 -0.005216 1.466365 1.535268 1.050547 0.249219 1.956711 0.420435 0.291291 0.855796 1.032224 0.874733 1.340034 0.852331 1.473861 1.078790 -0.021411 0.624891 0.620475 1.381664)
)
;;; 79 even --------------------------------------------------------------------------------
-#(79 12.421415328979 #(0 0 1 1 1 1 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 0 0 1 1 1 0 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1)
- 11.878196632448 #(0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1)
+(vector 79 11.878196632448 (fv 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 1 1)
- 9.551575 #(0.000000 -0.017717 1.010040 1.402799 -0.133062 0.193665 1.897633 0.275807 1.797141 1.351041 -0.183281 1.587574 1.726774 1.190365 0.965347 0.333529 1.073567 1.000669 1.665336 0.295081 0.569560 0.895029 1.375834 0.740527 1.376495 0.651712 0.578431 1.535276 0.448941 1.182968 1.554104 0.904624 1.778955 1.513476 1.240774 1.118212 0.681329 1.198596 1.719095 0.917574 0.269120 1.101498 1.261176 1.926759 0.656288 0.684593 1.167344 1.942356 1.317423 1.410149 0.548462 0.720571 1.525944 1.111217 1.459500 0.741592 0.049785 0.531744 -0.062997 1.977672 1.617952 1.721364 1.275495 0.271507 -0.020917 -0.141057 0.286151 0.323156 1.050749 0.878160 0.877601 1.389266 1.425720 0.313163 -0.190765 1.695272 1.976972 1.552786 0.811009)
+ ;; ce:
+ 9.380733 (fv 0.000000 0.510780 0.252633 0.712748 0.045825 0.533290 0.570911 1.782693 1.778269 1.965545 0.949265 0.812889 1.687090 1.664308 1.581407 1.710616 0.952117 1.113251 0.535130 1.949191 0.392710 1.113892 0.673455 0.088774 1.234594 1.234700 1.363303 0.874218 0.053582 1.508928 0.207664 0.009853 1.481504 1.794166 0.192648 0.693227 0.386323 1.341036 0.276027 0.630139 0.405686 0.785949 0.090167 1.080676 0.339556 0.634603 1.972094 0.909674 0.642872 1.742555 1.044458 1.900464 0.893867 1.044986 0.466092 0.081355 1.748407 0.417739 0.609777 0.867444 0.996078 1.921822 0.146017 1.547350 1.786775 0.079134 0.379049 1.145195 0.491146 0.827840 1.444544 0.381774 1.018247 0.133450 0.186735 0.732527 1.660451 1.720421 1.438682)
)
;;; 80 even --------------------------------------------------------------------------------
-#(80 12.739060401917 #(0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 0 0 1 0 0 0 1 1 0 0 0 1 1 1 1 0 1 0 0 1 0 1 1 0 0)
- 12.228775030303 #(0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 1 1 1 1 1 0 1 1 1 0 0 0)
- 12.095606803894 #(0 1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0)
- 11.989325523376 #(0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0)
+(vector 80 11.989325523376 (fv 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0)
- 9.585355 #(0.000000 -0.039146 1.216169 1.225365 1.242533 0.818969 0.655292 1.434718 1.825294 0.130365 0.732123 0.083564 -0.059370 0.114759 0.972611 0.734896 1.804356 0.300148 -0.033557 1.070717 0.858001 0.391759 0.076209 0.834812 0.440125 0.971715 0.084740 1.110756 0.695731 -0.024363 0.373284 0.155801 0.457440 0.650163 0.689883 0.616476 1.259421 0.961835 0.347576 1.689242 1.430389 1.505142 -0.051868 1.544675 0.698547 -0.005959 1.648048 1.945381 1.352187 1.279772 0.341034 1.498563 0.550061 0.646332 1.181791 1.523968 1.148035 -0.004915 0.440435 1.030887 0.880410 0.775578 1.057170 0.071435 0.159064 1.514715 1.504461 1.567920 0.970909 1.642713 0.548673 1.183900 0.135892 1.599137 0.248413 0.887335 1.861195 0.609355 1.379313 1.460968)
+ ;; ce:
+ 9.493437 (fv 0.000000 -0.003056 0.871305 1.349319 1.858308 0.466908 1.244422 1.764043 0.291426 1.076281 1.682758 0.386304 1.182056 -0.041504 1.018049 1.794160 0.591085 1.410404 0.075268 1.154361 0.262047 1.215494 0.086813 1.119384 0.112085 1.492482 0.546321 1.626715 0.687674 1.840924 1.113879 0.412411 1.693842 1.217772 0.566191 1.613902 0.702693 0.386708 1.626693 1.362021 0.738932 0.368846 1.672871 1.299617 0.788427 0.551598 0.187991 1.803477 1.774821 1.164009 1.487614 0.770019 0.742630 0.390398 -0.088422 1.923288 -0.109062 1.842146 1.690251 0.008381 1.550824 1.531659 1.497616 1.396079 1.603050 1.793260 0.154336 0.252178 0.425516 0.421130 0.697112 0.901699 1.252555 0.016759 0.375241 0.855613 1.211546 1.433945 1.792863 0.351953)
)
;;; 81 even --------------------------------------------------------------------------------
-#(81 12.189952580352 #(0 1 1 1 0 0 0 1 0 0 0 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1)
- 12.039585160315 #(0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0)
- 11.979215621948 #(0 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0)
+(vector 81 11.979215621948 (fv 0 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0)
- 9.558489 #(0.000000 0.469822 1.698326 0.270058 0.604556 1.525484 0.530630 1.207945 1.612610 0.187798 0.339465 0.230788 0.089159 1.188609 1.494769 1.768298 0.445080 1.628602 1.417795 1.112268 1.147662 0.595749 1.452531 1.836706 1.083082 0.721263 0.691626 1.361008 -0.033761 0.879534 0.695120 0.886205 0.123515 1.896274 0.195742 0.079774 1.606335 1.306902 1.350960 0.105815 0.838255 1.046156 0.505354 1.492627 0.552269 0.191682 1.480261 0.814245 1.906030 0.934681 0.172640 -0.072958 0.119925 0.997141 1.809664 1.171342 0.247021 0.798857 0.108205 0.134076 0.310922 0.953554 1.529889 0.902080 1.401027 1.648265 1.704713 1.788475 1.821948 1.619236 0.388594 0.191888 0.024361 1.630595 0.658570 1.726477 1.703947 0.182650 0.491700 0.139784 1.751192)
+ ;; ce:
+ 9.529325 (fv 0.000000 -0.003984 0.725186 0.743737 0.729531 1.119765 1.541925 1.678935 1.738481 1.721543 1.393185 0.731045 0.019478 0.771584 0.581855 0.216656 0.563399 1.242114 0.560651 1.738359 1.170491 0.159270 0.566126 0.483569 1.182790 0.181604 1.706151 1.854339 -0.002194 0.437844 -0.070207 1.440872 0.286463 1.398996 1.367061 0.708028 -0.290957 0.883528 0.399205 0.712176 0.881360 0.586332 1.691690 -0.045439 0.598789 -0.244443 0.663603 1.393152 0.011936 0.502973 1.160110 0.596199 0.257846 0.544341 0.629333 1.752684 0.177491 0.528429 1.038556 0.728481 0.384225 0.529890 0.711236 1.400194 1.498453 1.156244 0.653763 0.305758 -0.155269 1.073363 1.458379 0.702870 0.141716 1.302726 -0.329814 0.298639 1.892688 1.900138 1.655169 0.812034 -0.182220)
)
;;; 82 even --------------------------------------------------------------------------------
-#(82 12.307968522655 #(0 0 0 0 0 0 0 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 1 0 1 0)
- 12.071621513807 #(0 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0)
- 11.74796962738 #(0 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0)
+(vector 82 11.74796962738 (fv 0 0 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 0)
- 9.676764 #(0.000000 0.054833 0.615140 0.818489 0.254430 0.589161 1.258757 0.664578 1.681103 1.349323 1.667745 0.346543 0.099989 1.174511 -0.051843 1.344149 1.719051 1.145130 0.902405 1.268240 0.085850 1.492605 0.058379 0.029777 0.001662 0.762499 0.872304 1.294581 1.329943 0.985924 0.094240 0.923968 1.023470 0.427797 1.651465 1.830628 0.828430 1.532418 0.611571 0.734072 1.676823 0.897389 1.894317 0.000278 1.839380 0.872307 1.627079 0.399867 0.568434 0.822089 0.780291 -0.216774 0.564648 0.410247 -0.082082 -0.132149 0.828144 -0.402969 -0.158746 1.882000 1.498340 1.119801 0.121895 -0.137090 0.377562 1.154537 1.061623 0.446763 -0.131598 0.356747 0.153038 1.135321 1.749244 1.148647 0.340887 -0.047593 -0.166208 0.094032 1.605615 0.249162 0.276500 -0.014521)
+ ;; ce:
+ 9.530985 (fv 0.000000 0.002581 0.665465 1.069477 1.708629 0.244744 0.815275 1.389506 0.072967 0.518149 1.258636 0.104869 0.672550 1.578904 0.486254 1.275378 -0.016236 0.797153 -0.276393 0.747043 -0.159462 0.727529 0.109229 1.313965 0.107559 1.101244 0.135391 1.229652 0.386704 1.699152 0.875100 0.220480 1.674529 0.566929 1.803565 1.281089 0.420527 -0.095373 1.451514 0.833105 0.334393 1.926106 1.521915 0.797742 0.037620 1.890450 1.238469 1.288596 0.773237 0.606049 0.213821 0.049140 1.607755 1.437666 0.833194 0.946550 0.684670 0.626164 0.630512 0.902897 0.480081 0.471365 0.308602 0.413372 0.258949 0.442607 0.453613 0.854111 1.173261 1.257079 1.135118 1.379336 1.476222 -0.234240 0.311478 0.480664 1.015136 1.521091 1.852304 0.056526 0.425563 0.785949)
)
;;; 83 even --------------------------------------------------------------------------------
-#(83 12.587569236755 #(0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 0 1)
- 11.931811297539 #(0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1)
+(vector 83 11.931811297539 (fv 0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 1 0 1 0 1 1 0 0 1)
- 9.767259 #(0.000000 0.102593 1.639141 0.081328 1.151320 0.626241 1.684932 0.782925 -0.056646 1.227566 0.605211 0.709515 0.358935 -0.242853 1.892290 1.134255 0.256735 1.553097 0.022466 1.675138 1.070020 0.270875 1.631485 0.324298 0.044021 0.268956 0.415216 1.125597 1.813051 0.408037 0.349513 0.811590 1.220484 1.910993 0.953167 0.078611 -0.100459 0.023438 1.416427 1.470730 0.505597 1.669842 1.567460 0.078227 0.350088 0.200537 1.181200 1.689167 0.368177 0.045453 -0.197006 1.365875 1.378585 1.612338 0.632026 1.652616 -0.071553 0.250171 1.459931 1.545577 0.827731 0.327287 0.793792 0.841732 0.323267 1.732872 0.565117 0.809925 1.454943 0.787392 0.675275 0.043769 -1.889050 0.543810 0.316258 0.399558 1.282322 1.235786 1.101861 1.687624 1.292850 1.748096 0.210315)
+ ;; ce:
+ 9.549360 (fv 0.000000 0.032288 0.834116 1.401416 0.035368 0.406563 1.177626 1.509613 0.291626 0.972552 1.726763 0.692721 1.687201 0.129594 1.085873 0.204017 1.139515 0.273445 1.482102 0.192295 1.080179 1.979882 1.285941 0.340403 0.985304 0.533609 1.865099 0.628799 1.889210 1.180384 0.539244 1.842377 1.350512 0.512399 1.815213 1.164340 0.726996 -0.012813 1.099275 1.226281 0.551613 0.011231 1.538277 1.191883 0.928674 0.507861 1.826344 1.417654 1.468918 1.265287 0.819366 0.969679 0.428274 0.455249 1.949916 0.041645 1.591382 1.883937 1.784338 1.762163 1.899526 1.307740 1.800619 1.929764 0.063585 1.701620 1.807254 0.159705 0.531560 0.710036 1.009902 1.081386 1.423742 1.377653 1.714397 0.170534 0.667428 1.526663 1.444085 1.827303 0.046079 0.991518 1.278845)
)
;;; 84 even --------------------------------------------------------------------------------
-#(84 12.747644424438 #(0 0 0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 1)
- 12.50866273996 #(0 0 0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 0 1 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 1)
- 12.426499838032 #(0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
+(vector 84 12.426499838032 (fv 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 0 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 0 1 1 0 0)
- 9.762438 #(0.000000 0.170282 0.576303 -0.028262 0.857580 0.181501 1.167275 0.416604 1.111665 1.830794 1.714984 1.578546 1.004949 1.288581 -0.155265 1.230425 0.391598 1.776116 -0.161591 1.713755 -0.009300 1.768477 0.694671 0.955358 1.707974 0.082630 -0.144038 1.830923 0.648687 0.673119 0.900932 0.924933 0.753181 0.521052 0.553218 0.251970 0.297192 0.979614 0.081335 0.246258 1.012609 0.415006 1.585513 1.693158 0.623901 0.300362 0.076026 1.554457 1.135844 0.208029 0.730335 0.734464 1.411513 0.671231 0.323124 0.462103 1.559065 1.855419 1.139721 0.307307 1.252819 0.089907 1.772043 1.227994 -0.058027 0.062417 0.183164 0.525045 -0.003979 0.123434 1.311344 1.293550 0.827692 1.680378 1.705851 0.824636 1.429784 1.481225 0.431774 0.059063 0.183554 0.155092 0.953216 1.394917)
+ ;; ce:
+ 9.633962 (fv 0.000000 0.374922 1.183581 1.290870 0.705975 0.037122 1.139367 1.048350 0.334310 1.326801 1.647856 1.857607 1.812109 0.301068 1.658406 1.344389 0.416349 0.219667 1.233884 1.040486 1.625160 1.657982 1.232289 1.436356 0.879314 1.500837 0.083989 0.524445 1.496583 0.195492 0.415250 0.867702 1.173743 1.828747 1.840334 -0.001715 0.114874 1.289221 0.907468 1.568406 0.412257 0.461669 1.993995 0.175480 1.741500 1.629849 1.860704 1.739722 1.644034 1.223183 0.177672 0.444348 1.320675 1.200379 1.245918 0.030713 1.304971 1.969297 1.489901 0.864880 0.577011 0.034043 1.934323 1.447131 0.730445 1.571480 0.003554 0.387041 0.486597 1.351900 0.594794 1.157107 0.726867 1.857734 0.748709 1.799335 1.043537 0.919611 0.874828 0.732255 1.153375 1.608544 0.740331 1.571952)
)
;;; 85 even --------------------------------------------------------------------------------
-#(85 12.635076593197 #(0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1)
- 12.624737923152 #(0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 0 1)
- 12.270205061432 #(0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1)
+(vector 85 12.270205061432 (fv 0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1)
+
+ 9.693668 (fv 0.000000 0.195989 0.490949 0.331600 0.887562 0.028445 1.546017 1.385311 0.812190 1.115113 1.801497 0.487288 0.525794 0.074082 1.723182 1.944316 1.781964 0.421600 0.177518 1.829367 0.571078 1.783004 0.344177 0.329133 1.891108 0.440324 0.259558 0.143603 0.779362 1.104207 1.976902 0.561742 0.767039 1.340228 0.253563 1.774888 1.741378 1.554241 1.474673 0.298807 0.272176 1.211675 1.002346 0.130871 1.176937 0.697418 0.199450 0.178715 1.330092 0.855241 1.512332 1.331159 0.219055 1.811575 1.934102 1.939888 1.043996 0.748687 0.643521 0.780509 1.267694 0.441215 0.667193 0.454905 1.688291 1.972173 0.503377 0.756581 0.239100 0.784029 1.470486 0.189182 1.795940 0.379978 1.569889 1.093199 1.711138 0.905143 0.045022 0.285289 1.219061 0.953496 1.196694 1.742789 0.902060)
- 9.711278 #(0.000000 0.194605 0.491462 0.330258 0.886222 0.027890 1.545925 1.385084 0.810944 1.115692 1.799895 0.488140 0.525391 0.075197 1.724362 1.943515 1.781197 0.422406 0.176365 1.829013 0.570296 1.784049 0.347336 0.330639 1.890499 0.438632 0.259437 0.144537 0.780176 1.104317 1.977961 0.560997 0.767166 1.341637 0.252850 1.775505 1.742391 1.552872 1.473504 0.299281 0.272093 1.210075 1.003274 0.129974 1.177045 0.699003 0.199764 0.177937 1.330648 0.854701 1.512774 1.332124 0.220221 1.811124 1.934998 1.938072 1.044479 0.748919 0.644390 0.780212 1.268627 0.440152 0.665985 0.453315 1.690313 1.972614 0.503844 0.756853 0.239851 0.786126 1.470882 0.186946 1.795609 0.380133 1.568824 1.093296 1.712037 0.903804 0.045566 0.285573 1.219484 0.952633 1.198002 1.741547 0.901756)
+ ;; nce:
+ 9.690941 (fv 0.000000 -0.005460 0.145938 -0.187800 0.177698 1.176520 0.517469 0.210175 1.436686 1.607383 0.066090 0.593136 0.482635 1.868920 1.291310 1.386910 1.029893 1.540100 1.084274 0.614905 1.153312 0.206651 0.588776 0.424148 1.780700 0.201677 -0.148794 1.539105 1.959298 0.153524 0.855868 1.263643 1.287920 -0.293735 0.438019 -0.206018 -0.356273 1.231052 1.001435 1.635849 1.476715 0.216231 -0.158631 0.753539 1.686606 0.980832 0.355756 0.168014 1.126044 0.500388 0.943877 0.638970 1.307633 0.790226 0.733504 0.595806 1.464991 1.037472 0.754676 0.719213 1.040414 0.002877 0.074104 1.737856 0.729741 0.862345 1.242108 1.321487 0.621750 1.011073 1.510125 0.085724 1.514690 -0.060524 0.938871 0.309540 0.743320 -0.211769 0.753436 0.803987 1.556267 1.083936 1.193072 1.598509 0.578392)
)
;;; 86 even --------------------------------------------------------------------------------
-#(86 13.114136440046 #(0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0)
- 12.791990425787 #(0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0)
+(vector 86 12.791990425787 (fv 0 0 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 0 0 1 1 1 0 0)
- 9.817693 #(0.000000 0.137630 0.325804 0.011402 1.488450 0.504331 1.228591 0.954377 -0.126845 -0.291456 0.637160 1.327174 1.732900 0.568209 1.352383 0.703924 1.806229 1.469200 0.381481 0.707104 0.544956 0.307044 1.040239 0.876696 1.786522 0.105134 0.639647 0.988922 -0.046786 1.716919 1.836622 1.163379 0.033869 1.526374 0.510745 0.463212 0.777846 0.612772 1.663505 1.491859 0.475366 1.094605 1.294624 1.118738 0.602976 1.233446 0.344846 0.414736 0.337988 1.713186 0.141992 0.820289 1.700261 0.899674 0.803377 0.770421 1.413333 1.317352 1.268496 0.266814 0.770469 0.659807 0.900203 0.684337 1.290706 0.801258 1.418972 1.034985 1.201218 0.337022 1.584727 1.435335 0.607387 1.067991 0.542017 1.319733 -0.195508 0.715933 0.386011 0.040687 0.271408 -0.038430 1.701574 0.563030 0.675684 0.164945)
+ 9.804520 (fv 0.000000 0.137494 0.326172 0.010382 1.487613 0.505001 1.228062 0.954717 -0.127893 -0.290666 0.636565 1.325872 1.732483 0.567284 1.353499 0.704440 1.806655 1.469223 0.382393 0.706107 0.545460 0.307640 1.039546 0.875080 1.787391 0.105900 0.639604 0.989302 -0.045857 1.717167 1.835064 1.163334 0.033557 1.525348 0.510815 0.463389 0.777198 0.612036 1.665125 1.493136 0.475659 1.095674 1.296538 1.117478 0.603294 1.233039 0.344624 0.414746 0.337889 1.713708 0.141791 0.820548 1.699043 0.899800 0.803706 0.771637 1.413475 1.319088 1.268258 0.265658 0.770528 0.659195 0.900807 0.683986 1.290180 0.800356 1.418815 1.036184 1.201710 0.337696 1.582663 1.435772 0.606855 1.068190 0.540979 1.320205 -0.195129 0.714820 0.387530 0.040243 0.270436 -0.038662 1.702501 0.563408 0.676006 0.165316)
+
+ ;; nce:
+ 9.779022 (fv 0.000000 0.012842 0.387371 0.019737 1.439011 0.434664 1.128389 0.730743 -0.150815 -0.440514 0.639771 1.390058 1.794981 0.621810 1.311431 0.767684 1.625416 1.570273 0.387894 0.736564 0.474233 0.261823 1.118332 0.820501 1.669010 0.015560 0.675733 0.978312 -0.064261 1.739844 1.817488 1.131007 0.062688 1.453390 0.448140 0.394070 0.831458 0.606366 1.363181 1.537589 0.426586 0.909340 1.240040 0.972834 0.683746 1.305881 0.259400 0.331948 0.295699 1.578329 0.042939 0.918607 1.689154 0.940724 1.007722 0.753380 1.536736 1.334795 1.258278 0.206096 0.883227 0.623082 0.840214 0.596829 1.277982 0.836896 1.407813 0.924493 1.193604 0.465208 1.513477 1.273116 0.679902 0.975579 0.664944 1.360910 -0.287799 0.710949 0.308010 -0.006577 0.020520 -0.156639 1.682660 0.621205 0.561199 0.080346)
)
;;; 87 even --------------------------------------------------------------------------------
-#(87 13.008953483644 #(0 0 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 0 1 0 0 0)
- 12.872 #(0 0 1 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 1 0 1 0 0 0)
- 12.669403362513 #(0 0 1 1 0 0 1 0 0 0 1 1 1 0 1 0 0 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 0 0 1)
- 12.625063286678 #(0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
+(vector 87 12.625063286678 (fv 0 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0)
+
+ 9.874660 (fv 0.000000 0.366900 0.585885 0.360276 1.741378 1.383744 0.806085 0.218985 1.748601 1.513484 1.913086 1.499231 1.804617 1.560415 0.976184 0.564077 0.614555 0.706893 1.155782 1.743949 0.256106 1.587276 1.479629 0.499900 0.621596 1.318438 0.505053 -0.000351 1.493931 0.351932 1.677582 1.117619 1.631442 0.001969 0.286212 0.372264 0.187053 0.296894 0.961309 0.849648 1.557109 1.714474 -0.039206 1.347988 1.896634 1.217858 1.504538 0.380552 0.871895 1.911392 0.768943 1.752782 0.535064 0.764217 0.468880 0.181130 0.490835 1.212121 1.451975 1.107304 0.551132 0.225217 0.930971 0.652946 1.821236 0.839189 1.745456 0.283826 1.910401 1.397382 1.626785 0.236815 0.165723 1.103589 1.501862 1.903299 0.205800 0.189795 0.285228 0.129502 1.654212 0.651262 -0.043737 0.438462 1.813853 0.852642 1.712123)
- 9.889024 #(0.000000 0.366991 0.586913 0.360901 1.740728 1.384162 0.805910 0.217632 1.749145 1.513446 1.914358 1.498829 1.803468 1.559486 0.976317 0.564360 0.614111 0.707949 1.156894 1.743306 0.256222 1.586971 1.479599 0.499846 0.621514 1.317817 0.505146 0.000534 1.494960 0.352601 1.676014 1.117417 1.632166 0.002617 0.286450 0.373823 0.188379 0.297602 0.961356 0.849358 1.556920 1.713531 -0.039955 1.346844 1.895993 1.216553 1.503968 0.380714 0.871663 1.911020 0.768741 1.752404 0.533488 0.762855 0.468441 0.180656 0.491508 1.211531 1.451203 1.107185 0.550781 0.224170 0.930646 0.651683 1.821997 0.839381 1.744801 0.283662 1.910602 1.397540 1.626708 0.236560 0.165610 1.103868 1.502230 1.900791 0.204501 0.189312 0.284088 0.128672 1.652947 0.651768 -0.044070 0.438223 1.814181 0.851609 1.711638)
+ ;; nce:
+ 9.877641 (fv 0.000000 -0.021457 -0.332767 0.963844 -0.139669 1.122611 0.073163 0.865822 -0.025982 1.478876 1.300682 0.423658 0.322274 1.661211 0.500543 1.705512 1.176402 0.809437 0.981075 0.972708 1.087640 1.788381 1.486099 1.855937 1.496729 1.909818 0.429000 1.696291 0.561926 0.965567 -0.162109 0.839848 1.033495 0.899864 0.728978 0.135257 1.630992 1.197929 1.514698 0.814714 1.165293 0.851600 0.892043 1.519176 1.529996 0.381556 0.396698 0.783215 0.824621 1.214567 1.738938 0.263930 0.560204 0.335777 1.558427 0.771167 0.709316 1.002333 0.687389 -0.031156 0.967435 0.220860 0.392729 1.627417 0.223702 0.908693 1.299159 1.409401 0.619154 1.469733 -0.654637 1.678656 0.999708 1.410546 1.423816 1.288829 1.153651 0.643357 0.343990 1.755018 0.782145 1.521746 0.184384 0.116670 1.179413 -0.365261 0.035182)
)
;;; 88 even --------------------------------------------------------------------------------
-#(88 13.132745742798 #(0 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 0 1 0)
- 12.908752771202 #(0 0 0 1 1 0 0 1 0 0 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 0 1 1 1 0 1 0 1 0)
- 12.675436588537 #(0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 1 0 1 0 1 0)
- 12.661032846106 #(0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
+(vector 88 12.661032846106 (fv 0 0 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1)
- 9.984856 #(0.000000 -0.194878 0.928890 -0.293355 0.583688 -0.150420 0.591959 0.047369 0.050897 0.248118 0.310355 0.576937 1.256207 0.525784 1.120697 0.263301 0.758170 0.236814 0.644939 1.021260 1.448464 0.311898 1.448733 0.825188 0.188409 1.721400 1.302710 1.118478 0.313147 1.079828 -0.079534 -0.033988 1.114460 -0.003004 0.626095 0.819010 -0.238498 0.717503 1.192114 0.940747 1.226089 0.688979 1.844402 1.401995 0.154794 0.077096 1.279690 1.496316 1.258798 1.240197 0.492916 0.403449 0.703023 0.884355 0.450253 1.033650 1.711259 1.615616 0.008201 0.437902 -0.140411 1.950190 -0.172955 0.665896 -0.213634 1.142268 0.503724 1.417395 1.150705 0.374977 0.424637 0.858348 1.471800 0.633697 0.161274 0.811465 0.754673 0.720098 1.610600 0.130946 1.210619 0.777834 0.451096 0.273916 0.429706 0.506467 1.243546 1.586514)
+ ;; ce:
+ 9.812216 (fv 0.000000 0.055268 0.583779 1.234211 1.628798 0.277023 0.822779 1.625146 0.035507 0.649602 1.426919 0.034524 0.760555 1.584090 0.426236 1.297108 -0.064648 1.003285 1.954848 1.040940 1.931089 0.684474 1.457006 0.442932 1.400956 0.522371 1.821243 1.045778 -0.071524 1.059165 0.175444 1.376515 0.683418 0.093932 0.976929 0.065328 1.602577 1.185163 0.398809 1.873751 1.266959 0.334189 1.528861 1.254369 0.874420 0.121432 1.565807 1.331351 0.966676 0.377764 -0.254628 1.470234 1.160191 1.088192 0.680440 0.787715 0.046065 0.265716 -0.241611 1.809516 1.268665 1.177712 1.068293 0.934673 1.317512 0.907560 0.977837 0.781524 0.997530 0.958638 1.010309 1.152240 1.559668 1.510870 1.793541 0.022384 -0.034413 0.066685 0.419014 0.865510 1.381137 1.729658 1.950350 0.466719 0.747652 1.418392 1.765101 -0.161755)
)
;;; 89 even --------------------------------------------------------------------------------
-#(89 13.321250915527 #(0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 1 0)
- 13.191189069613 #(0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 1 1 1 0 0 0 1 1)
- 12.707793861614 #(0 0 1 0 1 0 1 1 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 0 0 0 1 1)
- 12.335865540187 #(0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1)
+(vector 89 12.335865540187 (fv 0 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 1 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 0 1 1 0 0 1 1 1 1 1 1)
- 10.125982 #(0.000000 -0.047754 0.911062 0.377192 1.405152 0.900905 1.692898 0.140019 0.279601 0.353264 1.319666 0.832036 1.685683 1.264629 1.495300 1.733677 1.394797 -0.027832 0.675920 0.212046 0.528573 0.273765 1.091602 0.381557 0.091066 0.479049 0.092041 0.434438 1.648188 -0.303141 1.638082 0.242163 0.248187 1.327376 0.903210 0.808594 0.669216 0.691955 1.387089 -0.010681 0.132515 0.727890 0.782250 0.083840 0.429422 1.733826 0.782731 0.588050 1.687325 0.848787 1.634783 1.184449 0.229129 0.461092 -0.165276 1.451843 -0.261586 0.212298 1.512449 1.391008 1.012684 0.980934 0.167914 1.101654 1.768264 1.849416 1.334910 1.235432 1.310415 1.418266 1.076905 0.040513 0.083987 0.990582 0.879402 -0.090717 0.777554 0.143505 0.476823 1.647364 0.497925 1.096780 1.074405 0.565138 0.657633 1.471647 1.710440 0.587946 1.328452)
+ ;; ce:
+ 9.997916 (fv 0.000000 0.020244 0.870163 0.459782 1.610176 0.844000 1.631839 0.198513 0.309236 0.389591 1.266554 0.907717 1.601376 1.371297 1.457522 1.745042 1.476212 0.073975 0.814060 0.353740 0.627872 0.101452 1.077167 0.352892 0.063779 0.448255 0.216020 0.534427 1.535778 -0.255643 1.360537 0.276814 0.262932 1.399548 0.980210 0.702925 0.453704 0.501694 1.341730 0.007203 0.345436 0.837214 0.770776 -0.073243 0.532634 1.583256 0.698601 0.593928 1.599304 0.808070 1.440125 1.148274 0.114072 0.434799 -0.164129 1.193330 -0.269745 0.418138 1.192504 1.289901 0.986576 0.905136 0.005956 1.233570 1.751871 1.723660 1.197839 1.205999 1.118756 1.106261 1.003380 0.216161 0.037880 0.928786 0.755785 -0.278629 0.531970 0.188018 0.465858 1.197436 0.572455 1.090538 1.091674 0.532343 0.511453 1.688563 1.590718 0.571898 1.255870)
)
;;; 90 even --------------------------------------------------------------------------------
-#(90 13.53812119512 #(0 1 1 1 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 0 0 0 1 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 1 1 0 1)
- 13.016282120103 #(0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0)
- 12.781593429563 #(0 1 1 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 1 0 1 0)
- 12.716424196959 #(0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0)
+(vector 90 12.716424196959 (fv 0 1 1 0 1 1 0 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0)
- 10.257361 #(0.000000 0.027996 -0.006598 1.150004 0.908564 0.295949 0.221696 0.534430 0.378839 0.943372 0.490613 0.427636 0.909525 1.144924 0.599938 0.008226 0.463880 0.323597 1.625039 0.261057 0.277379 -0.048173 -0.104741 0.193861 -0.037391 0.694650 0.919426 1.207032 0.663006 1.485422 0.504206 -0.158527 -0.103153 1.714775 1.137322 1.285529 1.235968 0.718366 0.620227 0.277333 0.677544 0.641341 1.357978 0.938383 0.611249 0.064953 0.357207 1.237560 0.605522 0.591979 1.320378 1.168991 1.167881 -0.406554 1.138419 1.225813 1.026827 0.096259 0.150782 1.619841 0.727810 -0.036454 0.884247 -0.005266 1.937441 1.644584 -0.047110 0.327287 1.230278 0.244147 0.848830 -0.245448 1.334988 0.144482 0.689152 1.235531 1.671332 -1.618554 0.383506 1.057419 0.473000 1.440958 1.311750 -0.177020 0.244750 0.751994 0.111614 1.196636 1.787383 0.739493)
+ ;; ce:
+ 10.013305 (fv 0.000000 0.276249 0.662327 1.808806 0.247081 1.503786 1.940324 0.419803 0.731998 1.474410 1.308170 1.676869 1.811609 1.215798 0.664610 0.066241 0.912393 1.461826 0.512334 1.631743 1.956766 1.975237 0.185753 0.741305 0.480828 1.966454 1.916940 1.119423 0.845500 1.620533 0.975449 0.450183 0.934883 1.109333 0.667354 1.305384 1.605133 1.189882 1.538095 1.240075 1.975310 0.162522 1.100171 1.036777 1.043788 0.744032 1.593875 0.517982 0.225081 0.407155 1.741456 1.796412 1.700950 0.367751 0.443832 0.733427 0.886793 0.217138 0.457578 1.931221 1.821137 1.223426 0.206884 1.785700 -0.026139 0.112791 0.288549 1.184345 0.406919 0.005051 0.510070 1.732554 1.458011 0.524459 1.130913 0.434368 0.819466 0.015795 0.021375 1.211968 0.985111 0.213416 0.003383 0.752814 1.988526 0.349626 0.383655 1.548554 0.699363 -0.001079)
)
;;; 91 even --------------------------------------------------------------------------------
-#(91 13.63089466095 #(0 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 0 1)
- 13.263186228373 #(0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 0 1)
- 12.853587071592 #(0 0 0 1 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0)
+(vector 91 12.853587071592 (fv 0 0 0 1 1 0 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 0 0)
- 10.185072 #(0.000000 -0.121261 0.774430 0.976357 0.305808 0.148986 1.218503 1.149398 0.079937 1.009479 -0.005209 0.273679 1.476050 1.551960 1.355633 0.137841 1.961604 1.336386 1.569498 -0.006803 0.881244 0.532872 1.281557 -0.111370 0.465784 0.411583 1.090976 1.764842 0.402700 -0.176633 0.163579 1.528375 -0.130505 0.265315 1.306545 0.280563 0.261120 1.120837 0.197080 0.762427 0.548492 0.981909 1.074100 0.995207 0.999034 1.606715 1.057540 1.043181 0.749318 1.176221 0.268766 1.019175 0.444029 0.044821 0.701858 0.524713 0.084713 0.852196 0.906169 0.032867 1.375072 -0.083926 0.688044 0.557605 0.828408 1.859781 1.722587 0.747148 0.569915 0.580906 1.134750 0.368477 -0.172506 1.657894 1.881437 1.584605 0.916105 -0.181963 0.665373 0.446687 0.729882 0.296731 1.577675 1.491108 1.266889 0.298960 0.279506 0.447126 0.927294 0.767204 0.546263)
+ ;; ce:
+ 10.062777 (fv 0.000000 -0.044026 0.916183 1.049904 0.191738 0.191234 1.416236 1.067714 0.063138 1.147303 0.129837 0.429350 1.643604 1.587481 1.357034 0.252125 0.130779 1.268840 1.505767 0.040246 0.758000 0.845409 1.205711 0.041467 0.397400 0.371419 1.129085 1.761538 0.418123 -0.386013 -0.020991 1.418674 -0.227521 0.262381 1.257327 0.247702 0.200474 1.000030 0.059835 0.524653 0.278663 0.930707 1.291316 0.903105 1.153153 1.399218 1.175091 1.040190 0.853009 0.848960 0.050279 1.156146 0.310675 1.870226 0.711775 0.475029 1.761660 0.754317 0.936989 -0.122427 1.219572 0.099878 0.730317 0.306957 0.685890 1.871434 1.660611 0.509309 0.546923 0.432379 0.751420 0.579102 -0.249566 -0.007122 1.880100 1.723260 0.707224 -0.253994 0.741449 0.308553 0.722662 0.266964 1.454100 1.331867 1.250657 0.301803 0.242062 0.553976 0.852613 0.695715 0.487374)
)
;;; 92 even --------------------------------------------------------------------------------
-#(92 13.355320111641 #(0 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 1 1 0)
- 12.754180011349 #(0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 1 1 0)
+(vector 92 12.754180011349 (fv 0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 1 1 0)
- 10.250272 #(0.000000 0.056037 0.364662 1.867502 1.667018 0.777108 1.204531 1.458826 1.168530 0.636619 0.947017 0.752454 1.912628 0.992164 1.499877 0.402162 1.115347 1.108011 0.520413 -0.131086 1.643938 1.643927 0.134636 0.331580 1.353610 0.107879 0.629282 0.467673 0.514108 1.551920 0.355270 1.528197 0.055233 1.678465 1.847066 0.129084 0.257262 1.368797 0.811229 0.492542 0.122334 0.644938 1.781488 1.585226 0.230273 1.322005 0.109289 0.836069 -0.099958 0.962541 0.505709 1.536549 0.658995 0.989755 1.513268 0.216190 0.745626 -0.326493 1.629228 -0.246421 1.197456 1.539005 0.193800 0.015827 0.150400 1.047425 1.232842 1.355997 1.172804 0.624590 1.509210 0.853875 1.006746 0.793389 0.514494 1.167417 1.218172 1.730564 0.004090 0.031546 1.306015 0.683433 -0.087358 1.431196 -0.020145 1.570655 1.083974 0.837686 0.078969 1.677558 1.808648 0.910855)
+ ;; ce:
+ 10.123598 (fv 0.000000 0.031164 0.420530 1.499100 1.680395 0.704037 1.385766 1.730884 1.246618 0.630183 0.903224 0.818406 1.762884 0.926615 1.036829 0.514947 1.139487 1.191198 0.306323 0.126221 1.698783 1.815556 0.082954 0.421957 1.558085 -0.046639 0.629395 0.492462 0.620351 1.539766 0.337850 1.829874 -0.029044 1.650869 1.891900 -0.107840 0.000042 1.651572 0.308113 0.328220 0.164791 0.503391 1.668351 1.327181 0.552781 1.134137 0.130061 0.912409 -0.106533 1.117087 0.419486 1.645903 0.619628 0.903437 1.717082 0.277879 0.300313 -0.111169 1.701263 -0.282651 0.916960 1.725278 0.299760 0.206730 0.258427 0.976768 1.006419 1.405478 1.458477 0.511219 1.976132 0.649673 1.067569 1.036236 0.561892 1.032699 1.113462 1.760313 -0.031912 0.151642 1.253446 0.366329 -0.207662 1.411375 0.168281 1.402361 1.015831 0.966440 0.109303 1.719898 -0.033652 0.850348)
)
;;; 93 even --------------------------------------------------------------------------------
-#(93 13.783703804016 #(0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 1 0 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1 0)
- 13.143995954461 #(0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0)
- 12.876626968384 #(0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0)
+(vector 93 12.876626968384 (fv 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0)
- 10.139434 #(0.000000 -0.035247 0.074207 0.427003 -0.281697 -0.017791 0.214690 -0.151844 1.427784 1.064625 1.938388 0.906036 0.409898 0.612373 0.984618 1.022294 0.622875 1.013211 0.533894 1.661176 0.644316 0.184270 0.624141 0.642067 -0.007540 1.951151 1.709330 -0.085355 0.278286 1.822877 0.699641 0.129223 1.020582 0.662018 1.702176 0.535251 1.886628 -0.287937 0.144846 1.378271 1.384570 1.055834 1.007712 0.340316 0.857671 1.488053 0.307622 0.299162 1.145843 0.773720 0.274711 0.667355 1.064019 0.729085 1.141619 1.118411 0.932161 1.594272 1.937559 1.219873 0.920141 0.541069 0.172947 0.581141 1.100919 1.191683 -0.339022 1.514466 1.224519 0.648388 0.845313 -0.415325 0.031944 1.460277 0.288889 0.140550 0.633375 1.012587 0.137920 1.584716 0.330991 0.902462 0.043251 0.952166 1.409335 0.569678 0.142859 0.643887 -0.102517 1.740359 0.748374 1.014533 0.004323)
+ 10.120779 (fv 0.000000 -0.035376 0.073991 0.427701 -0.282243 -0.018747 0.215658 -0.153445 1.426646 1.066559 1.939228 0.906624 0.410081 0.611941 0.984019 1.022397 0.624511 1.012954 0.533644 1.662254 0.644321 0.184706 0.621632 0.642800 -0.008009 1.949179 1.710653 -0.084032 0.277398 1.824022 0.699251 0.129968 1.020811 0.661971 1.702058 0.534563 1.888605 -0.287827 0.144583 1.379920 1.385073 1.054451 1.007433 0.338841 0.857467 1.489234 0.309837 0.300057 1.146999 0.772495 0.275152 0.667315 1.064213 0.727453 1.142263 1.118538 0.931092 1.595399 1.937578 1.220927 0.920538 0.541725 0.173459 0.580373 1.100745 1.191038 -0.340664 1.515332 1.223959 0.649170 0.846642 -0.414943 0.030223 1.461947 0.288064 0.141033 0.634411 1.011893 0.138288 1.584616 0.333385 0.901662 0.043826 0.951055 1.409243 0.569338 0.143517 0.644810 -0.103707 1.742249 0.748991 1.014192 0.003204)
)
;;; 94 even --------------------------------------------------------------------------------
-#(94 13.381710407562 #(0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 1 0)
- 12.991560374803 #(0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1)
+(vector 94 12.991560374803 (fv 0 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 0 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 1 1)
- 10.452968 #(0.000000 0.077172 1.511363 1.686716 1.749151 -0.041848 0.544137 0.498178 -0.166766 1.819926 1.294083 0.157408 1.110265 1.694097 0.827651 0.831764 1.385887 1.752696 1.034777 1.138354 1.262593 0.477469 0.653226 0.472948 0.782246 0.220028 0.536897 1.247420 0.142882 0.146542 -0.193123 0.264515 -0.055424 0.066248 1.205622 0.961593 0.443453 0.032988 -0.007187 1.078761 0.501048 0.675129 0.951660 1.567536 1.810629 1.747130 1.414119 1.737316 1.309448 1.645290 -0.138147 0.753178 0.787171 1.540355 -0.032603 1.686755 -0.306440 1.624259 1.494449 0.090554 1.050716 0.458630 0.747664 0.299256 -0.135651 1.339209 1.679115 0.233517 1.565368 0.724575 -0.082485 1.657203 0.129206 0.539787 1.408921 0.556456 0.618297 1.530859 1.044016 1.679891 1.199774 0.134848 0.185266 1.212547 1.401964 1.121941 0.244234 1.725335 1.521816 0.404286 1.567112 0.902298 1.776960 0.743042)
+ ;; ce:
+ 10.168153 (fv 0.000000 0.158749 0.428472 1.119399 1.397485 1.337099 1.326309 0.765212 0.646549 0.366853 0.358406 0.186940 -0.004160 1.693556 1.760221 1.908281 -0.019516 0.044061 0.077064 0.115948 0.108699 0.200075 0.580690 0.574214 0.728439 1.050221 1.095053 1.499686 1.600782 1.705303 0.371346 0.785397 1.061620 1.118378 1.565155 0.180785 0.671073 0.956955 1.179900 0.062702 0.732776 1.104782 1.678100 1.936449 1.211526 1.440956 1.926880 0.701684 1.206989 0.357893 0.937759 1.642399 0.674496 1.095199 1.838835 0.811161 1.664081 0.728543 1.536793 0.935285 1.167394 0.592984 1.298896 0.711769 1.719531 0.207782 1.415604 0.678365 1.539785 1.187347 0.265338 1.410498 0.621725 1.553961 0.975230 0.124475 1.147511 0.723691 1.974302 1.764820 1.095390 0.083191 1.554760 0.873910 0.746004 0.060230 1.781492 1.338588 0.986007 0.875321 0.329252 1.786619 1.490792 0.801318)
)
;;; 95 even --------------------------------------------------------------------------------
-#(95 13.458537482645 #(0 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 0 0 1 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 1 1 1 0 1 1 0 0 1 0)
- 12.939489078295 #(0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0)
+(vector 95 12.939489078295 (fv 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 0 1 1 1 0 0 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 1 0 0 1 1 0 1 1 0 0 1 0)
- 10.463298 #(0.000000 -0.050735 0.315921 1.108927 0.781909 -0.043415 0.857976 0.821678 -0.031600 0.919700 1.186343 0.134770 0.242579 0.630541 0.902454 -0.077103 0.206537 1.622760 0.872016 1.147567 0.452764 1.184281 0.782150 0.325772 1.095535 0.811971 1.007078 1.026365 0.291637 1.775048 -0.028422 1.244381 0.567379 1.344045 1.096943 -0.061303 1.369318 0.654885 1.520730 0.626115 0.173869 1.827469 1.269503 1.806664 0.970320 1.444812 1.172825 1.199141 0.201459 1.636519 0.999348 0.956396 1.120492 0.021300 0.051207 0.042729 0.298454 0.113127 1.641034 0.182509 1.093959 0.874166 1.083065 0.076266 1.554824 1.524699 1.818927 0.192458 1.119465 1.049021 0.917722 0.861582 0.586329 0.912188 1.349618 1.278557 0.704090 1.267578 1.267445 1.460934 0.083492 1.190172 0.852283 0.364369 0.709171 1.564181 0.266479 1.390855 0.113104 0.435572 0.615704 1.085391 0.807400 0.550186 -0.211906)
+ ;; ce:
+ 10.274816 (fv 0.000000 0.191955 0.747873 1.620627 1.444931 1.117449 0.280309 0.480520 1.626406 1.210786 1.123735 0.279148 1.110058 1.602457 1.869386 0.773421 1.408758 0.850581 0.528012 0.913946 0.482409 1.573182 0.994233 1.305292 1.545980 0.033608 1.905037 0.750852 0.522232 1.918658 0.047508 1.217238 0.972743 0.083444 0.371581 0.796063 1.083361 0.261908 1.433959 0.521900 0.192999 1.966737 0.129605 0.500888 0.331274 0.913857 0.815429 1.023459 0.478085 1.566987 1.222813 1.708572 1.719376 0.723585 1.103104 1.428438 0.152348 0.040494 1.696898 0.190236 1.378447 1.550950 1.870103 1.503205 0.324210 0.355888 1.476257 1.524550 1.168199 1.485278 1.191081 0.963527 1.662530 1.621072 0.604273 0.737525 1.817225 0.670588 1.938761 1.575766 0.221849 1.885601 1.971423 1.331586 0.219292 1.195712 0.125970 0.883030 0.146163 0.807704 1.769915 -0.019375 1.792299 1.733519 1.458753)
)
;;; 96 even --------------------------------------------------------------------------------
-#(96 13.465419214875 #(0 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 0)
- 13.179516746745 #(0 1 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 0 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 0)
- 13.077001047978 #(0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
+(vector 96 13.077001047978 (fv 0 0 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1)
- 10.566355 #(0.000000 0.153702 1.472942 1.120012 1.160647 0.821651 0.587258 0.167937 1.237041 0.827124 -0.057223 1.536062 -0.118884 0.274562 1.893550 1.286204 1.478143 0.868564 0.058468 0.687528 1.013586 0.329615 1.906635 0.947418 0.701871 0.385093 1.808729 1.328542 0.677135 1.662741 1.726910 1.295260 1.481724 1.136467 0.546764 1.751302 0.078093 0.792005 0.823189 1.491124 1.353118 0.334517 0.446559 0.644701 0.864084 0.815324 1.379101 0.182756 0.668352 1.139161 0.088039 0.542020 -0.156458 -0.131708 1.823097 0.847242 0.071484 0.952017 -0.065685 1.613440 0.884356 1.807679 1.636664 1.838638 0.543128 1.360802 -0.051400 0.563283 1.558762 0.784395 1.080952 0.974305 0.736801 0.974386 -0.161382 1.496357 1.628419 1.347955 1.450295 -0.115816 1.158280 0.634373 1.227982 0.999131 1.675731 1.365219 1.653642 -0.118219 1.360090 -0.079777 1.183942 0.786810 1.103793 -0.124899 0.090712 1.897254)
+ ;; ce:
+ 10.249441 (fv 0.000000 0.009923 1.397522 1.166061 1.129381 0.862136 0.621841 0.072414 1.181071 0.867293 0.079004 1.693135 -0.014893 0.108345 1.780717 1.327197 1.625536 0.881623 1.921096 0.933503 1.182023 0.476766 1.614305 1.196403 0.811564 0.443720 1.497667 1.275176 0.722032 1.799828 1.704575 1.646983 1.348940 1.072546 0.729932 1.823713 0.260241 0.680766 1.080411 1.441731 1.246268 1.050406 0.336794 0.747049 0.875357 0.924454 1.579785 0.440504 0.667236 1.229671 0.158392 0.708858 1.967741 0.138461 0.274346 0.799091 1.692696 0.840214 1.597165 1.145148 1.181538 0.078566 1.784249 0.079340 0.404851 1.249515 0.162426 0.631488 1.171930 0.883287 1.256995 0.882531 0.425580 1.043774 0.166379 1.858551 0.915286 1.404785 1.287221 1.948447 1.096165 0.270960 1.267765 0.984855 1.705672 1.206954 1.635747 1.831700 1.675862 0.020775 1.394335 0.961664 1.111073 1.653261 0.221394 1.853173)
)
;;; 97 even --------------------------------------------------------------------------------
-#(97 13.449318349909 #(0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0)
- 12.969611395004 #(0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0)
+(vector 97 12.969611395004 (fv 0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 1 0)
- 10.473709 #(0.000000 0.336192 1.886833 0.226727 0.154280 0.092340 1.841462 1.440270 1.388643 1.616491 0.763608 0.653842 1.803570 0.107948 -0.143742 0.030873 -0.196188 -0.121683 0.492701 1.666203 1.409056 1.657438 0.927891 0.953253 0.600134 -0.000159 1.709867 -0.389128 0.698839 0.780682 1.060836 0.362553 0.491750 -0.004358 0.925282 1.831440 1.210086 1.527684 0.529145 0.498010 -0.539614 0.623566 0.775862 1.789603 1.612108 0.173061 1.057697 0.777772 1.096853 -0.150116 1.712761 1.551905 0.700800 1.365504 -0.472888 1.361701 -0.470148 1.027630 1.915608 1.667718 0.171452 0.609885 1.024021 0.234985 0.170073 0.768739 1.828625 0.788511 1.100453 -0.209410 1.104107 -0.005833 1.535682 1.304759 0.908949 1.937381 1.363789 1.174389 1.240777 0.899785 -0.185667 -0.018199 0.890799 0.561673 1.621697 1.348024 0.327255 1.363160 -0.104066 -0.274734 0.221654 0.177667 0.884194 -0.074703 0.893420 1.152423 1.623781)
+ ;; ce:
+ 10.353915 (fv 0.000000 0.014320 1.699930 0.475338 0.327588 0.038537 1.537175 1.151125 1.532968 0.067981 0.615972 0.753995 1.850077 0.031584 -0.245176 0.175732 0.019153 0.133227 1.047045 1.449249 1.470511 1.537141 1.108379 0.638023 0.512045 -0.123137 1.442397 -0.285045 0.550401 0.725732 1.137347 0.384697 0.518421 0.107675 0.832943 1.779119 1.053524 1.101550 0.692043 0.797241 -0.542271 0.567053 0.702166 1.746525 1.756713 0.337727 1.446061 0.906449 1.109794 0.007168 1.480499 1.290329 0.754314 1.222669 -0.462191 1.087068 -0.251963 0.941593 1.663909 1.425711 -0.319978 0.693993 1.098604 -0.057825 0.103974 0.674596 -0.040855 0.861405 0.891647 0.007811 0.988956 -0.007355 1.453777 1.088127 0.560798 1.836913 1.159295 1.225761 1.137877 0.994253 -0.314791 0.194425 0.944400 0.940972 1.573317 1.084581 0.080135 1.392169 0.150957 -0.334184 0.271188 0.375796 0.741022 -0.072930 1.298672 1.087468 1.547582)
)
;;; 98 even --------------------------------------------------------------------------------
-#(98 13.942760654268 #(0 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1)
- 13.490633234777 #(0 1 1 0 1 1 0 0 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 1 0 1 1 1)
- 13.468658765207 #(0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
+(vector 98 13.468658765207 (fv 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1)
- 10.548158 #(0.000000 0.335592 0.174106 1.835550 1.249042 0.850802 1.080276 1.568622 1.163644 1.479201 1.950600 1.857437 1.412001 1.217773 0.915942 0.558206 0.305247 0.918981 1.259810 1.471116 1.970967 0.559096 1.377669 0.529556 1.248783 0.950202 0.435253 1.311910 1.602930 0.091062 1.801437 0.132369 1.730659 1.239530 0.644372 0.885496 0.273576 1.215183 0.710343 0.760370 1.320097 1.147034 0.316127 0.910814 0.472216 0.783513 0.640135 1.915788 0.367843 0.640392 1.920496 1.632621 1.072384 1.815518 1.739714 1.463198 0.462329 0.135247 -0.042026 1.631507 1.492073 0.122366 0.362554 0.246573 1.919459 0.774553 0.713811 1.369261 0.277579 0.455722 1.364539 1.715028 0.286658 1.072303 0.520612 1.211798 0.127160 1.095622 0.637728 0.779763 0.408352 0.477942 1.224811 0.213427 1.389427 0.314743 1.919206 0.578879 0.449721 0.913746 1.336880 0.916860 0.074981 1.027684 0.800389 0.374478 1.215032 0.088055)
+ ;; ce:
+ 10.480580 (fv 0.000000 0.029942 1.595740 0.929637 0.140250 1.273956 1.370085 1.486506 0.768736 0.810999 0.987699 0.622931 1.874848 1.232431 0.796670 -0.004456 1.530075 1.744503 -0.182347 -0.272539 -0.039867 0.251416 0.711006 1.684207 0.083442 1.563617 0.619745 1.154797 1.221621 1.412817 0.843588 0.857496 0.194384 1.348416 0.436247 0.378473 1.472625 0.199665 1.452604 1.135822 1.388047 0.919731 1.753351 0.083481 1.454770 1.242435 0.826611 -0.194897 -0.034005 0.041385 0.915233 0.468973 -0.449881 -0.034037 1.686105 0.937405 1.775189 1.272187 0.656772 0.051128 1.735808 1.941754 -0.153834 1.560953 0.798180 1.420628 1.100906 1.382273 0.014181 1.975964 0.450586 0.615591 0.885414 1.287826 0.533661 0.896633 1.605571 0.202012 1.330045 1.186911 0.653866 0.460432 0.799268 1.432588 0.419263 1.021867 0.188412 0.775135 0.208746 0.411264 0.553114 1.806129 0.584153 1.223473 0.816232 -0.069138 0.707217 1.215423)
)
;;; 99 even --------------------------------------------------------------------------------
-#(99 14.049349722487 #(0 1 1 0 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 1 1 0 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1)
- 13.942 #(0 1 1 0 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 1)
- 13.341398779709 #(0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1)
+(vector 99 13.341398779709 (fv 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 0 1)
- 10.431646 #(0.000000 0.712626 1.280622 0.927914 0.134401 1.557090 0.117397 1.599339 0.492335 0.900536 0.192494 1.933455 1.385730 0.734570 0.986506 1.561643 1.511796 1.637570 0.383135 0.075813 0.540085 1.371029 0.484785 1.006528 1.151293 1.973027 0.610135 0.187717 1.291526 0.846895 0.073478 0.991946 0.162545 1.930318 1.073213 1.297219 1.795085 0.743156 1.868126 0.001223 0.349274 1.408134 0.962302 0.007963 0.633723 1.377865 1.109961 1.629463 0.476572 0.825028 1.404324 1.579633 0.789657 0.218962 0.390171 1.592294 0.360579 0.569380 0.576632 1.380182 0.889776 1.826504 0.051762 1.721803 0.270943 1.359491 1.295938 0.621549 0.011756 0.403752 1.517491 1.690115 1.416933 0.835985 1.164116 0.776207 0.842565 1.007295 0.525006 0.446413 0.141635 0.622198 0.817299 1.146512 1.215448 0.934836 1.081989 1.030911 1.230731 1.092156 1.434121 0.539787 0.953714 1.254034 0.477191 0.159449 1.646301 0.621600 0.431289)
+ 10.395229 (fv 0.000000 0.706072 1.286640 0.926913 0.137440 1.547226 0.117224 1.604362 0.484929 0.893678 0.211396 1.934935 1.381569 0.741431 1.002510 1.548591 1.501995 1.642732 0.386486 0.063170 0.535977 1.363015 0.485356 1.002502 1.149707 1.971779 0.610054 0.176963 1.296429 0.848185 0.077879 0.989380 0.162448 1.939484 1.081728 1.291006 1.781243 0.747318 1.861605 -0.003717 0.355879 1.413789 0.958311 0.004291 0.617108 1.378378 1.118347 1.632856 0.492813 0.823307 1.406872 1.588630 0.799940 0.218833 0.397527 1.627895 0.349077 0.557886 0.566534 1.362311 0.876480 1.822463 0.047284 1.726490 0.281473 1.360892 1.302327 0.630439 0.026319 0.398853 1.499306 1.696667 1.409746 0.843535 1.156093 0.782651 0.844572 0.996729 0.505075 0.454056 0.125470 0.633842 0.812248 1.139044 1.201855 0.936107 1.075661 1.055341 1.239337 1.081381 1.450660 0.544145 0.960193 1.261524 0.471575 0.159670 1.647942 0.617964 0.426032)
)
;;; 100 even --------------------------------------------------------------------------------
-#(100 14.500160217285 #(0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 1)
- 13.694382146343 #(0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0)
- 13.512077331543 #(0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0)
+(vector 100 13.512077331543 (fv 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0)
- 10.494638 #(0.000000 -0.079671 0.576167 1.217964 -0.015542 1.793473 0.223827 1.036603 1.449545 1.620466 1.146877 0.664087 0.661614 -0.267273 0.246337 0.754770 1.746875 -0.424131 -0.112248 1.668230 1.661411 0.951460 0.087426 0.300865 1.789759 0.512310 1.549361 -0.087196 1.605298 1.458657 0.978569 1.248305 1.570725 1.271348 0.557408 1.282195 0.772802 0.628826 0.448545 1.192738 0.106008 0.224564 -0.182844 0.743777 0.463389 1.606270 -0.217614 1.706613 1.918233 0.365368 0.426855 0.088661 1.477150 0.882253 1.142779 0.062083 0.026113 0.092497 1.834226 0.100619 -0.001456 0.084436 0.282321 1.182187 0.972186 0.307463 1.553696 0.062036 0.154552 0.753707 -0.335259 0.692135 0.554581 1.706510 0.441056 1.320063 0.994915 1.023998 1.734773 0.774643 1.099836 1.818904 -0.445838 1.514517 1.247394 0.530884 0.247678 1.474283 1.799655 0.293838 1.840625 0.906491 1.780895 1.141318 0.571212 1.547047 0.742609 1.260209 1.702168 1.408957)
+ 10.472141 (fv 0.000000 -0.079327 0.575962 1.216890 -0.014744 1.794579 0.223351 1.035736 1.450027 1.621511 1.146130 0.664482 0.663607 -0.266960 0.246822 0.754872 1.746592 -0.423496 -0.112090 1.668859 1.661047 0.950742 0.085504 0.302466 1.790192 0.512158 1.549763 -0.087872 1.606339 1.457814 0.979132 1.246348 1.572286 1.270907 0.557192 1.282392 0.773062 0.627296 0.449140 1.192929 0.105994 0.224683 -0.182519 0.743965 0.463017 1.607410 -0.217575 1.706348 1.917272 0.364576 0.425823 0.089107 1.477241 0.882347 1.143269 0.061661 0.026397 0.093540 1.833116 0.100956 -0.001875 0.084325 0.282798 1.183349 0.971365 0.306714 1.553029 0.062053 0.155585 0.754942 -0.336663 0.692895 0.554870 1.705080 0.442045 1.319460 0.995119 1.023180 1.734006 0.775241 1.099502 1.819778 -0.446034 1.513278 1.247469 0.530165 0.247921 1.473754 1.799924 0.292965 1.840516 0.908343 1.781887 1.143210 0.571911 1.546526 0.744154 1.261450 1.702101 1.407355)
)
;;; 101 even --------------------------------------------------------------------------------
-#(101 14.704120635986 #(0 1 1 1 0 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 1)
- 14.20509180893 #(0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1)
- 13.916260357992 #(0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1)
+(vector 101 13.916260357992 (fv 0 1 1 1 1 0 0 0 1 1 0 1 1 0 1 1 1 1 1 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 0 1 1 0 1 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1)
- 10.815985 #(0.000000 -0.145103 0.013717 1.187850 1.896657 1.284210 1.008156 0.249562 1.354000 -0.000674 1.261507 0.039587 0.269687 1.581801 -0.306711 0.950889 0.285653 1.802217 0.621535 0.724933 0.672004 0.608852 0.914649 1.328135 -0.019089 1.324987 -0.014488 1.902296 0.195992 0.463583 -0.232105 1.628569 1.350232 1.628506 1.140243 -0.091891 1.443070 0.797625 1.000901 0.447444 1.255830 1.331322 0.592280 1.492656 1.821509 0.042088 1.845260 0.084089 0.209794 1.550826 0.150879 0.571306 1.818254 1.320042 0.173286 0.518061 0.765341 0.009154 0.194237 0.153279 1.891695 1.238314 0.566485 0.210382 1.199949 1.184056 0.587334 0.851448 -0.069941 -0.066972 0.115149 1.476352 1.369871 0.062776 1.383887 0.341243 0.789878 1.889515 1.572340 0.443254 1.045334 0.818600 1.535001 0.167533 1.737424 1.403993 1.206273 0.946372 1.309947 1.661019 1.095912 0.264151 0.898147 0.970652 1.319971 1.477537 1.079481 0.035237 0.714179 0.805933 1.681374)
+ ;; ce:
+ 10.577830 (fv 0.000000 0.230088 0.489949 1.896308 0.933068 0.593501 0.422308 0.060228 1.624707 0.198599 1.858938 1.074760 1.176893 0.981397 1.101455 0.671865 0.424692 0.090154 1.204682 1.678470 1.838266 0.024568 0.595975 1.448081 0.084971 1.587793 0.520717 0.874796 1.272960 1.935410 1.267081 1.651444 1.443667 0.106075 1.743028 0.700933 0.469120 0.378892 0.399951 0.519935 1.685545 1.698426 0.785883 0.473603 0.884326 1.731208 1.464294 1.924822 0.636901 0.305356 0.801079 1.744433 1.003951 0.836001 0.264502 0.624042 1.251558 0.465073 1.095465 1.359393 1.201558 0.893610 0.464655 0.265401 1.373759 1.898225 1.761890 -0.002084 1.345698 1.606225 0.081343 1.615987 1.843685 0.952555 0.240683 1.457724 0.753500 1.550264 1.132929 0.635603 1.553592 1.597112 0.562720 1.442901 1.005554 1.242061 1.201605 1.261095 1.477713 0.348336 0.005918 1.590197 0.313622 0.668027 1.281558 1.857136 1.788055 0.849243 1.615883 0.119440 1.251097)
)
;;; 102 even --------------------------------------------------------------------------------
-#(102 14.246722674125 #(0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1)
- 13.955191612177 #(0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 0 1 1 0 1 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1)
- 13.554303556646 #(0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0)
+(vector 102 13.554303556646 (fv 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 0 1 1 1 0 0 0 1 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0)
- 10.850668 #(0.000000 0.061894 1.499003 0.229655 -0.067660 1.708735 1.457676 1.264707 0.235172 0.321405 0.126383 -0.270635 0.509262 1.557659 0.854366 0.798847 0.004856 1.780931 0.013028 1.467930 -0.413899 0.706699 1.622384 0.845187 0.474654 0.337612 1.700591 0.678869 1.382390 0.642812 0.140618 1.093101 1.377738 0.531821 0.895800 0.914314 0.690264 1.566793 1.297797 -0.187873 -0.106642 0.193941 -0.014489 0.436322 -0.030551 1.447109 1.127681 1.809551 0.377176 0.448543 -0.323728 0.477422 0.500770 0.804538 1.606142 1.912249 1.281869 1.060141 0.368992 -0.412004 1.602172 1.062383 0.171571 1.104118 1.777967 0.640527 1.679612 1.073814 0.721196 -0.030333 0.739937 1.770157 1.823764 1.732180 1.459952 1.633235 1.213288 1.454778 0.509636 0.917131 1.283908 0.685725 1.147097 1.155049 0.985081 1.630108 0.963364 1.295157 1.006260 0.065310 1.421697 0.119013 0.210954 0.586481 1.130076 1.300269 1.579367 1.728076 0.591524 0.895693 1.669323 -0.127507)
+ ;; ce:
+ 10.573986 (fv 0.000000 0.455448 1.592339 0.516746 1.755302 0.430730 1.719525 0.951344 -0.011584 1.094962 0.249269 1.210204 0.681046 1.814999 1.100181 0.342805 1.598301 0.973279 1.813912 1.543187 1.213360 0.476019 1.876128 1.338406 0.323141 0.086213 1.782029 1.276211 0.922086 0.263981 1.923412 1.289879 0.951410 0.707896 0.012549 1.851646 1.630674 1.384243 1.051926 0.762336 0.305766 0.298705 1.874016 1.899771 1.620966 1.734952 1.429925 1.177184 1.271518 1.112585 1.351310 1.169594 1.017169 1.072042 1.161752 0.892462 1.662674 1.237843 1.407508 1.778309 1.632181 -0.005924 0.137286 0.529299 0.602002 0.855550 1.115330 1.528193 1.708150 1.986964 0.217781 0.770088 1.353099 1.819055 0.042966 0.583719 0.854932 1.780394 1.890656 0.692898 1.277125 1.902467 0.022802 0.892858 1.554169 0.132068 0.918216 1.832708 0.149377 0.742587 1.856221 0.273349 1.013342 0.114623 0.855957 1.713909 0.875532 1.432041 0.715192 1.022773 0.307135 1.424286)
)
;;; 103 even --------------------------------------------------------------------------------
-#(103 14.267168699654 #(0 1 0 1 1 1 1 1 0 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 0 1 1 0 1 0)
- 14.260 #(0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 0 1 1 0 1 0)
- 13.923377530893 #(0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0)
+(vector 103 13.923377530893 (fv 0 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0)
- 10.852005 #(0.000000 1.228238 0.635143 0.261645 1.380061 1.065858 0.489452 0.538074 0.047840 1.383075 0.297305 1.189569 0.354749 1.185435 0.294513 1.601241 0.526489 1.035110 1.043952 0.374094 0.728779 1.243739 0.904102 0.490093 0.739625 1.282787 0.552876 0.838031 1.517612 0.981622 1.204670 0.700836 0.730871 1.030279 1.760958 0.803133 1.014613 0.569176 1.726823 1.698372 0.206306 0.733107 1.363760 0.297810 -0.067331 1.045393 0.405754 0.168058 0.198314 0.057242 0.892496 0.709473 1.697521 0.385403 0.119351 0.151385 1.392150 1.518504 0.577090 1.270520 0.483081 1.345502 0.346229 1.282419 0.125247 0.510769 0.943235 1.324591 1.434004 0.922603 0.086100 1.559225 0.959339 0.779765 1.470808 0.404481 0.400093 0.765811 0.757481 1.509859 1.852624 1.951080 0.002222 0.027463 0.578912 0.359660 0.911333 1.049630 0.325861 1.585363 1.523359 1.480155 1.380840 1.319756 1.227840 0.590705 1.904815 0.426286 0.345219 1.934109 0.687278 1.983868 0.179632)
+ ;; ce:
+ 10.655070 (fv 0.000000 0.098203 0.840876 1.375107 0.153742 0.905827 1.598049 0.226902 1.106387 1.951313 0.409173 1.416206 0.300008 0.991894 1.877024 0.769923 1.633937 0.581083 1.464525 0.440302 1.508923 0.447643 1.643543 0.650572 1.662974 0.812624 0.114340 1.320550 0.512587 1.607339 0.712150 1.624256 0.673697 0.132515 1.684625 1.034157 0.294350 1.413417 0.670789 0.070085 1.514860 0.928557 0.150294 1.635889 1.040664 0.560013 0.195302 1.710399 1.367615 1.043173 0.402177 1.662716 1.456941 1.147051 0.985707 0.632104 0.408799 0.275068 1.862616 1.424547 1.082981 1.090416 0.822477 0.915783 0.592819 0.610365 0.257982 0.450718 0.126885 0.491389 0.133294 0.376246 0.118720 0.195423 1.887844 0.645109 0.531798 0.762689 0.732490 0.998025 0.912568 1.060467 1.162384 1.198622 1.637406 0.207879 0.126974 0.580167 0.848976 1.222343 1.532632 1.780660 0.095903 0.581413 1.052384 1.441822 1.990917 0.734482 1.101269 1.710370 0.157742 0.650375 1.262955)
)
;;; 104 even --------------------------------------------------------------------------------
-#(104 14.290776635081 #(0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 1)
- 14.080453047533 #(0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
+(vector 104 14.080453047533 (fv 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
- 10.801773 #(0.000000 0.876181 0.473950 1.568286 0.109997 0.707237 1.127067 0.793779 0.557556 0.238458 1.694325 1.876224 1.265084 1.550844 0.404215 1.469260 1.952626 0.548602 0.919020 0.412468 1.642952 0.509921 0.909458 1.029404 0.614021 1.286217 0.725812 0.234163 1.752879 0.589278 1.527570 1.242958 0.572970 -0.010352 0.767067 1.208386 1.945908 0.200861 0.703648 1.194706 0.321915 0.408806 0.452091 0.274882 1.698370 0.888361 1.016807 1.312123 1.139687 1.336363 1.487737 0.374275 0.945555 -0.016481 0.593945 0.461770 0.230785 1.364624 1.555745 0.992733 0.908267 1.122755 1.054105 0.540331 1.910655 0.565648 0.835455 0.878859 0.771717 0.622403 0.874080 1.209226 0.677148 0.062900 0.531654 0.571504 0.911671 1.481197 1.364775 1.587026 1.924377 0.069596 1.803865 1.025396 0.079136 1.464902 0.216752 1.179753 0.063086 1.368524 0.449111 1.251123 0.246977 0.138072 0.255447 0.256692 1.698008 1.370094 0.347695 0.106206 0.012547 0.960444 0.837744 1.651503)
+ ;; ce:
+ 10.681525 (fv 0.000000 -0.024256 0.783678 0.790357 0.543059 0.305361 -0.134503 0.818664 1.525254 0.494738 0.824462 0.413278 0.768548 0.076204 0.116598 0.283930 0.002578 1.585676 1.025319 1.696095 0.040592 0.097252 1.464874 0.943760 1.446445 1.337085 -0.054264 0.475515 1.125978 1.147471 1.094995 0.186610 0.588805 0.970144 0.882957 0.245963 0.284357 -0.394290 1.437271 0.927960 1.125343 0.492129 -0.680606 0.536491 0.927855 1.405256 0.384789 0.057902 1.208331 0.288662 1.508156 1.581082 1.167052 1.243667 1.226450 0.112600 1.111908 1.348016 0.638821 1.169461 0.306222 1.466381 0.659007 1.306085 1.700156 1.339421 0.711646 0.085484 0.909896 -0.178331 1.447928 0.767489 1.399367 -0.197416 1.574394 0.605814 -0.011981 -0.082006 0.824364 0.264841 1.418643 0.988277 -0.314078 0.146715 0.221811 0.630751 0.576546 0.496630 0.654974 1.143866 1.326186 1.202136 1.173988 0.681397 1.563605 0.912110 1.479070 0.009348 0.151736 0.948455 0.251873 0.215256 0.959463 1.013975)
)
;;; 105 even --------------------------------------------------------------------------------
-#(105 14.699862480164 #(0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 0 1 0 0 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 0 1 1 1 1 0)
- 14.062 #(0 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 1 0 0 0 1 1 0 1 1 1 0 0)
- 14.023490699521 #(0 1 1 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 1 1 1 0 0)
+(vector 105 14.023490699521 (fv 0 1 1 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 1 1 1 0 0)
- 10.941971 #(0.000000 -0.187948 1.420784 1.684636 0.966254 1.512156 1.009871 0.217709 1.349130 1.573953 0.726205 1.337331 -0.162277 0.932402 1.214906 0.911402 0.052471 0.870401 0.441040 0.216499 0.943996 1.593913 0.615486 1.701930 0.798738 0.302390 0.385526 1.716665 -0.119326 0.803640 0.412120 0.581607 0.067383 1.761829 0.296770 0.789585 0.346421 -0.212278 1.700688 1.532150 0.504980 1.138581 1.821217 0.777439 -0.028468 -0.206527 0.700888 0.063354 0.415592 1.431921 0.006088 1.622543 0.686646 0.591972 0.967715 0.273343 0.406589 0.527330 1.501248 1.520881 1.541441 0.029944 0.917137 0.326267 1.969933 0.460485 -0.003223 1.808869 1.291159 0.062127 0.253793 0.259888 1.371171 1.293921 0.755578 1.129868 1.418358 0.927868 1.005703 1.584643 1.746117 0.383789 0.374527 1.197609 0.074246 0.267495 1.428760 1.878106 -0.436700 0.357692 1.575698 1.590468 -0.213945 -0.147145 0.000232 0.078845 0.639619 0.730227 0.860832 0.010713 1.392552 0.341600 0.269589 1.266982 0.520730)
+ ;; ce:
+ 10.762178 (fv 0.000000 0.397875 0.415370 0.882172 0.546824 1.353988 1.428323 0.899356 0.371635 0.978504 0.763060 1.852147 0.544169 0.212342 0.787152 0.707632 0.540670 1.634630 1.456913 1.887455 0.659515 1.903305 1.487136 0.606049 0.181640 0.198532 0.870626 0.299967 1.007267 0.225649 1.806738 0.672311 0.647212 0.706876 1.445160 0.654294 0.635429 0.365790 0.507155 0.852393 0.362305 0.862000 0.544259 1.758526 1.506465 1.313083 0.892464 0.407338 1.550831 0.757533 1.555137 -0.026848 1.155141 1.305207 1.788542 1.889285 0.358766 1.027604 0.314507 0.587817 0.916345 0.200487 1.411080 1.048840 1.178903 0.194143 1.901728 1.960301 1.945844 1.173118 1.765984 0.206171 1.625946 0.040059 1.626954 0.263952 1.564387 1.266244 1.622196 0.755369 0.949828 0.255858 0.753659 1.729344 1.050369 1.743664 1.440420 0.145640 0.301718 1.174665 0.822890 1.317300 1.570892 0.407998 0.956005 1.432600 0.239369 0.699233 1.040355 0.955730 0.525379 0.245609 0.402988 1.983561 1.494957)
)
;;; 106 even --------------------------------------------------------------------------------
-#(106 14.783208847046 #(0 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 0 1 0 1 1 1 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 1 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 1 1)
- 14.160224278203 #(0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 1 1)
- 14.077123010357 #(0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1)
+(vector 106 14.077123010357 (fv 0 0 1 1 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 0 1 1 0 0 0 0 1 1 1 0 1 1)
- 10.937724 #(0.000000 -0.021006 0.602277 0.222295 1.224508 1.399334 -0.361552 0.368998 0.658569 0.338008 0.956489 -0.170752 -0.034378 1.254067 1.758511 1.072169 1.466513 -0.017204 0.938105 -0.019187 1.910251 1.526876 0.844597 0.357593 1.469275 0.135169 -0.193187 0.165383 0.484749 1.133980 1.156968 1.015640 1.282926 0.962312 1.858449 1.284582 1.497012 0.387871 1.480932 1.900800 1.346180 -0.018482 1.396189 1.351926 1.038791 0.569001 0.487032 1.094906 0.511659 0.687258 1.542084 0.536678 1.318395 1.221173 0.238476 0.287737 0.510069 0.718753 0.925159 0.743178 -0.108854 1.479583 1.341646 0.339971 0.267986 1.790709 1.682412 1.874454 1.564715 0.267558 0.221470 1.307717 1.593619 1.256687 0.848317 1.116024 0.212823 -0.127452 0.194634 0.141078 0.817506 0.006412 0.592816 0.457930 0.021271 1.663153 0.367623 0.276691 0.431595 -0.229998 0.718511 0.257030 1.132713 1.003178 -0.019766 0.726101 0.690196 1.003756 0.030718 0.637535 0.016372 1.696251 0.332033 0.718340 1.766774 1.317341)
+ ;; ce:
+ 10.830737 (fv 0.000000 -0.005846 0.570672 0.234799 1.335287 1.359588 -0.419716 0.539638 0.608529 0.339921 1.061903 -0.158242 -0.044398 1.229716 1.763841 1.099423 1.509512 0.089726 1.005316 -0.075124 -0.066461 1.466196 0.771111 0.468552 1.415804 0.138963 -0.245805 0.138836 0.477088 1.188902 1.132158 1.069838 1.264025 0.968611 1.914288 1.097597 1.541915 0.300326 1.372837 1.925102 1.312271 -0.023238 1.373743 1.323233 1.094484 0.489712 0.482163 1.087861 0.500643 0.570320 1.558451 0.587192 1.367163 1.157295 0.201827 0.338548 0.589886 0.627255 0.836138 0.810466 -0.203530 1.496837 1.317835 0.258851 0.104005 1.762383 1.590637 1.892947 1.673713 0.391886 0.132951 1.390857 1.679677 1.113406 0.925816 1.243522 0.395898 -0.235350 0.125786 0.071751 0.796497 -0.006564 0.517719 0.324240 -0.029479 1.648460 0.422894 0.173347 0.366226 -0.269652 0.667311 0.224137 1.099578 1.062306 -0.039311 0.586541 0.652636 1.087861 0.037847 0.544588 -0.167470 1.665629 0.356235 0.598705 1.690854 1.284152)
)
;;; 107 even --------------------------------------------------------------------------------
-#(107 14.355038210217 #(0 0 0 1 0 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 1)
- 13.979104817741 #(0 0 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
+(vector 107 13.979104817741 (fv 0 0 0 1 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 0 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 0 0 0 1 0 1)
- 11.005938 #(0.000000 -0.152782 0.059123 0.188869 1.463332 0.930639 0.806476 0.136201 0.654675 0.810392 1.016300 1.350392 1.061798 1.364432 -0.041300 0.168344 -0.359847 1.218788 0.795846 0.501180 -0.024493 0.202205 0.640426 1.454337 1.776278 0.763882 0.160917 0.444848 0.258658 1.440008 1.245178 0.071109 0.327120 1.296634 0.046212 1.023781 0.546595 0.019158 0.917219 -0.198799 -0.058533 1.433243 0.649563 1.647559 0.840569 1.338341 -0.051540 1.154263 0.353986 1.605539 0.303978 1.379613 0.830345 0.794564 0.676864 0.507207 0.609040 1.104090 1.629006 0.621541 1.284634 0.433166 0.972284 1.214434 1.583539 1.131037 0.166397 1.405260 1.017324 0.034297 0.546793 0.070755 1.893227 -0.058368 -0.420869 0.346893 0.240283 -0.374201 1.388806 -0.213357 -0.024422 1.699652 1.361802 0.963635 1.261946 0.834893 -0.252593 -0.005080 -0.177106 0.115790 0.533980 1.793213 0.157266 1.085735 0.654508 1.420225 1.807076 0.311951 0.472461 1.416088 -0.172054 0.167442 1.601068 1.549967 1.308938 -0.177059 1.224114)
+ ;; ce:
+ 10.937211 (fv 0.000000 -0.004224 0.060024 -0.045111 1.214471 1.071129 0.959468 -0.117229 0.526421 0.777989 1.101830 1.594870 1.129631 1.240597 0.114410 -0.015477 -0.160025 1.227190 0.975588 0.257050 0.062807 0.334972 0.704097 1.491576 0.263834 0.840227 0.134041 0.515784 0.095610 1.204429 1.214110 -0.209995 0.542934 1.280779 0.060334 1.305652 0.399609 0.055093 1.015156 -0.124325 0.060155 1.228735 0.771913 1.621598 0.808853 1.471209 -0.169978 1.121641 0.399914 1.719441 0.379423 1.503274 1.042517 0.685780 0.947470 0.570388 0.750717 1.227614 1.713741 0.574606 1.613832 0.259018 1.237457 1.030851 1.608948 1.331324 0.222275 1.365789 1.141241 0.137043 0.400610 0.136266 1.777801 -0.008027 -0.188345 0.319469 0.129091 -0.503698 1.075061 0.022495 -0.104170 1.746336 1.362807 0.487726 1.046216 1.025881 -0.113705 0.257262 0.139668 0.033537 0.410121 0.067540 0.536883 1.096402 0.595602 1.418336 1.800057 0.344577 0.240890 1.498996 -0.357281 0.342654 1.655013 1.372406 1.308709 -0.240755 1.334030)
)
;;; 108 even --------------------------------------------------------------------------------
-#(108 14.418597227362 #(0 1 0 1 1 0 0 1 1 0 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 1 0 0 0 1 0 1 0 1 1 0 0 0 1 1 0 0 0 1 1 0 1 0 0 1 1 0 1 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 0 1 0 0 0 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 0 0 0)
- 14.367991447449 #(0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1)
- 14.247987286758 #(0 1 0 1 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 1 0 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 1)
- 14.201394892821 #(0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
+(vector 108 14.201394892821 (fv 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1)
- 11.043665 #(0.000000 0.136537 1.271180 0.548764 1.652018 1.801786 0.470936 -0.010014 0.579320 1.563445 0.739600 0.557688 -0.038926 0.339426 1.303120 1.442458 0.577838 1.095409 0.077955 0.318466 1.081538 -0.201330 1.669657 1.038155 0.301238 0.015989 1.755015 1.339679 1.952355 0.613056 0.026007 0.481969 1.888237 1.497565 0.358989 1.292902 1.124067 0.086287 1.201747 0.128848 1.084968 1.615044 0.405371 -0.150390 0.235166 1.444008 1.615654 1.890719 0.364225 0.118558 0.996318 0.605551 1.036773 1.334430 1.626819 1.217978 0.574767 0.986540 1.302704 1.016862 1.292821 0.209677 1.186449 1.439031 0.172888 1.829325 1.327255 1.512266 1.255177 1.506643 1.349517 0.645512 1.281799 1.178910 1.415487 0.557644 1.505169 0.179949 -0.026228 0.708160 0.518265 0.018021 1.778113 0.177969 0.999559 0.827760 0.654073 0.029433 1.520840 1.816658 -0.066858 1.906096 1.407971 1.658890 0.292497 0.514653 0.871127 -0.368023 1.655256 1.413129 1.455647 1.433381 0.581839 0.032974 1.110634 0.517464 0.786314 1.757155)
+ ;; ce:
+ 10.928835 (fv 0.000000 0.001349 1.292491 0.733848 1.693309 1.799399 0.481169 -0.003953 0.631395 1.556718 0.747743 0.394608 -0.163614 0.178289 1.389719 1.500511 0.566775 1.069628 0.140033 0.292869 1.057556 -0.232775 1.757479 1.152928 0.313785 -0.002063 1.713110 1.409517 1.701701 0.540017 -0.081333 0.363976 1.907649 1.714406 0.366131 1.312522 1.061649 -0.016307 1.204902 0.111229 1.131127 1.599963 0.195405 0.048689 0.148454 1.536192 1.518659 0.029237 0.220432 0.060747 0.889494 0.493752 0.976299 1.363602 1.809211 1.216107 0.616567 0.927578 1.398521 0.961300 1.194676 0.366929 1.180567 1.477072 0.270916 0.119650 1.287137 1.475762 1.163703 1.481070 1.371759 0.541244 1.311014 1.044588 1.313660 0.533979 1.490951 0.356285 -0.069909 0.767914 0.271739 0.014710 1.682385 0.162634 1.095329 0.775810 0.661086 0.068467 1.450209 1.785189 0.063589 1.966358 1.523081 1.437414 0.274911 0.580082 1.089239 -0.463689 1.664646 1.305111 1.466902 1.475663 0.556905 0.115271 0.981770 0.504641 0.709948 1.631495)
)
;;; 109 even --------------------------------------------------------------------------------
-#(109 14.988188773557 #(0 1 0 1 0 1 0 1 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 0)
- 14.476561866583 #(0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1)
+(vector 109 14.476561866583 (fv 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 0 1 1 1)
- 11.098831 #(0.000000 0.028619 1.385080 0.549590 1.876532 1.178519 0.890837 1.468610 1.689325 0.574248 1.679833 0.989944 0.255560 0.353318 0.012710 0.495137 0.095039 0.595683 0.799715 0.830383 -0.205507 1.361526 1.668093 0.634579 0.009770 0.690966 0.913743 -0.194383 -0.133899 0.636924 0.294193 0.716647 1.318906 0.928215 1.182704 1.386529 1.121517 1.755683 -0.152570 0.482213 0.626290 0.706515 1.715352 0.380955 0.875176 1.717261 0.873060 1.897283 0.174115 0.841685 0.021467 0.478384 0.256613 1.551913 1.017288 0.253845 1.760374 0.196138 1.786494 0.973052 1.235694 1.063178 0.493602 0.679772 1.149259 1.053345 0.977424 0.263791 0.602694 0.345104 1.021864 0.029400 1.709421 1.330629 0.009184 0.000724 0.652796 1.378114 0.335073 -0.080719 0.417170 0.837436 0.869059 0.218996 0.565255 1.158166 1.561519 0.437762 1.434678 1.777483 1.022929 0.339623 1.738390 1.806006 1.535802 1.301993 -0.180401 1.531809 -0.299934 1.166652 0.373092 0.682278 -0.038856 1.852390 1.539388 1.583564 1.115320 1.285396 0.856107)
+ ;; ce:
+ 10.962218 (fv 0.000000 -0.020139 1.296818 0.759398 1.805908 1.100728 0.800122 1.439412 1.622620 0.514993 1.795449 1.209391 0.020235 0.358160 0.092111 0.419753 0.215041 0.890857 0.739133 0.655070 -0.097603 1.149145 1.795049 0.529356 0.278854 0.849651 1.115508 -0.203443 -0.316571 0.636461 0.169404 0.863285 1.244658 0.826671 1.217995 1.641136 1.077104 1.940135 -0.019991 0.361800 0.684590 0.618864 1.574258 0.100541 0.539464 1.815288 0.854878 0.087950 0.096927 0.551713 0.357857 0.524099 0.322958 1.655523 1.025258 0.447127 1.801347 0.241837 1.863980 1.144261 1.218309 0.839437 0.457453 0.658738 1.245153 1.083988 0.663284 0.430502 0.960078 0.132118 0.667264 0.423888 1.801298 1.342075 0.136707 0.381362 0.568108 1.442671 0.522741 -0.163023 0.297994 0.902549 1.034272 0.408426 0.838530 1.491663 1.889043 0.510513 1.243885 -0.037162 0.829406 0.263055 1.957688 1.777764 1.532407 1.532356 -0.098135 1.343701 -0.090007 1.030266 0.540482 0.697946 0.058406 0.051557 1.224797 1.605931 1.084281 1.340523 0.856409)
)
;;; 110 even --------------------------------------------------------------------------------
-#(110 14.433 #(0 1 0 0 1 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0)
- 14.401108392424 #(0 1 0 0 1 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 0 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 0)
- 14.141825477743 #(0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0)
+(vector 110 14.141825477743 (fv 0 0 0 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 1 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0)
- 11.282730 #(0.000000 0.085938 0.434574 0.404718 0.208216 1.002251 0.017839 1.220062 -0.099170 -0.147882 1.734295 1.417753 0.022341 1.477622 1.693219 1.816306 1.730927 -0.089715 0.961695 0.269867 0.078794 1.199608 1.287065 1.430338 1.183626 -0.288170 1.726206 1.515138 0.425011 1.025663 0.994510 1.296904 1.206240 1.649742 -0.076220 1.829169 1.159622 0.671789 0.221595 0.317809 1.728013 -0.231604 1.185097 0.474790 1.307242 1.624555 1.562206 1.615913 0.938421 0.140852 1.123574 0.507498 1.206224 0.265393 1.342248 1.018840 0.861102 0.446319 1.259367 1.836613 -0.058680 0.161330 1.666526 1.422050 0.262284 0.313268 0.893483 1.607243 0.339126 1.883972 1.051844 1.013497 0.387124 0.709728 0.825119 0.038941 1.766261 -0.120631 0.325461 0.847143 1.121438 0.769287 0.486925 0.627030 0.696424 0.645500 0.961681 -0.199525 1.756664 0.360405 1.127148 1.204874 1.800182 1.129687 0.980254 1.479137 0.674722 1.213835 0.045021 0.500345 1.365200 0.069877 1.220181 0.488236 -0.091224 1.604089 0.817340 -0.129216 0.372376 1.381651)
+ ;; ce:
+ 11.083621 (fv 0.000000 0.102224 0.391557 0.595597 0.594876 1.372717 0.692712 1.820557 0.592991 0.744933 0.284097 0.094534 1.236489 0.656692 0.836105 1.286301 1.045083 0.906213 0.452242 1.303365 1.815972 0.742162 1.260200 1.034689 1.519277 1.714910 0.030360 1.701396 0.878133 1.252260 1.563515 1.824493 1.440884 0.550691 0.625323 0.322441 0.255155 1.747348 1.715563 1.206982 0.695445 1.179481 0.756077 1.528329 0.919865 1.229029 1.159425 1.320573 0.445003 1.914934 0.957065 0.751755 0.916124 0.636546 1.677594 1.368208 1.478534 0.887675 1.827907 0.505854 0.598384 0.760342 0.616916 0.235984 0.997501 1.394766 0.145444 0.892122 1.825648 1.436307 0.231097 0.844561 0.320584 0.655075 0.450233 0.147790 1.886750 0.073198 0.684099 0.980548 1.422263 1.230129 0.607855 1.708107 1.670067 1.087055 1.809960 1.108445 0.779703 1.445375 0.004959 0.570411 1.025881 0.429647 0.658700 0.663819 0.227169 1.057047 0.056802 0.087954 1.060399 1.762629 1.235596 0.276822 0.266842 1.518690 1.130656 0.442538 0.924181 1.667970)
)
;;; 111 even --------------------------------------------------------------------------------
-#(111 14.983455708572 #(0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 1 0 1 1 0 0 1 0 0 0 0 0 0 0 1 0 1 1 0 0 0 1 0 1 0 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 0 1)
- 14.470418444168 #(0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 0 1)
- 14.043108609984 #(0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 0 1)
+(vector 111 14.043108609984 (fv 0 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 1 1 0 1)
- 11.371159 #(0.000000 0.117646 1.226844 -0.122529 0.747896 -0.001504 0.154436 1.348455 1.456556 0.674983 1.502143 0.204492 1.640422 0.020914 1.581387 0.178449 0.783896 1.196402 0.870214 1.281908 0.145445 0.750518 0.926475 0.889820 0.554286 0.377388 0.924842 0.957103 1.263129 0.944094 1.126502 0.118954 0.584206 0.924771 0.343617 1.764380 -0.046777 0.993760 0.447988 1.043504 0.038435 1.902230 0.172535 1.200198 0.315559 0.377988 1.240543 1.492901 0.842608 1.681873 0.171398 0.659051 0.801270 0.095499 0.169540 0.516181 1.059584 1.551804 1.746792 1.038958 1.138286 0.700647 1.280253 1.223962 1.003596 1.101052 0.672566 1.704422 1.368086 0.192751 0.415834 1.761910 -0.160248 -0.018976 1.050344 1.353558 0.610847 0.917811 0.229514 1.328432 0.983158 1.512039 1.194164 1.375774 0.007459 0.227271 1.922758 0.580178 1.193755 0.721789 -0.149497 1.148404 0.010853 1.852128 0.532584 -0.240297 1.575395 -0.049245 -0.138911 1.284956 0.545788 0.721671 0.499946 1.403461 0.243221 1.738573 1.116799 0.795736 1.886954 1.382133 0.559261)
+ ;; ce:
+ 11.044285 (fv 0.000000 0.158015 0.933037 1.614942 0.438728 1.109662 1.925788 0.472812 1.243741 0.106020 0.791740 1.640176 0.492268 1.485008 0.348988 1.215620 0.210371 0.907594 1.877045 0.815828 1.746879 0.708997 1.883211 1.043991 0.199639 1.074067 0.180622 1.253869 0.348260 1.556554 0.806309 0.044157 1.125294 0.382590 1.810361 1.146217 0.335649 1.611965 0.680338 1.937389 1.233789 0.766403 0.308709 1.641326 0.874950 0.294876 0.039653 1.398544 0.690400 0.241248 1.690671 1.329862 0.933824 0.621841 0.215994 1.901023 1.430062 1.233607 0.739730 0.472666 0.123106 0.067252 1.738994 1.459373 1.478846 1.201845 1.291598 0.805256 0.526423 0.555011 0.429805 0.468900 0.550665 0.287845 0.418385 0.091842 0.561234 0.306326 0.551107 0.349285 0.443927 0.497444 0.741730 0.889477 1.210808 1.343091 1.439025 1.479999 1.836181 0.047632 0.373687 0.550415 0.777036 1.388872 1.698564 0.091159 0.463192 0.987707 1.050209 1.564941 1.953806 0.531885 1.227608 1.522869 0.053791 0.776531 1.501133 1.889970 0.686171 0.911252 1.640718)
)
;;; 112 even --------------------------------------------------------------------------------
-#(112 14.939 #(0 0 1 0 1 1 0 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1 1 1 1 0 0 1 1 1 0 0 1 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 0 0 0 0 0)
- 14.53456401825 #(0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 1 0 0 1)
+(vector 112 14.53456401825 (fv 0 0 0 1 0 0 0 1 1 0 0 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 1 1 0 0 1)
- 11.292567 #(0.000000 0.052076 1.449770 0.814663 -0.247572 1.895564 0.135792 1.735004 1.573985 0.331805 1.659775 -0.231737 1.310819 0.149173 1.247141 1.294982 -0.004143 1.248949 0.464936 0.477770 0.113655 0.366300 0.628069 1.123534 1.387057 0.072584 0.067501 0.959452 0.027870 0.815401 1.278718 -0.292677 0.888131 1.592441 0.840118 1.475393 1.353152 1.276728 1.050508 0.566634 1.187371 -0.239080 0.467241 0.930731 1.284910 1.447873 1.331754 0.069609 0.457582 -0.174773 1.219530 1.088488 1.288764 1.377845 0.987633 0.114756 0.555833 1.691350 -0.152846 1.609429 1.136439 1.427754 0.711100 0.927501 0.938066 0.748870 0.240701 1.308829 0.957586 1.001171 1.454349 1.500492 -0.142752 0.728549 0.833721 1.599138 0.792050 -0.057132 0.117454 -0.215643 0.345723 0.020504 0.083768 0.538454 0.163656 0.323068 1.530883 1.053267 0.870965 1.487790 1.864207 1.830119 1.169562 1.583447 0.613685 0.447572 1.670592 0.345460 1.622217 1.604438 0.856860 0.279201 1.304678 -0.411678 1.405440 0.577897 0.350541 1.348683 0.157279 0.229188 0.699383 0.181125)
+ ;; ce:
+ 11.132899 (fv 0.000000 -0.004199 1.283910 0.989370 -0.208623 1.916334 0.074521 1.835438 1.334006 0.305929 1.500009 -0.074494 1.168847 0.049877 1.276892 1.333761 -0.092116 1.454810 0.477624 0.576171 0.178508 0.764025 0.524952 1.017918 1.503303 0.222438 0.024354 0.989207 -0.051649 0.790422 1.303684 -0.215343 0.911639 1.672316 0.816315 1.393173 1.438934 1.325167 0.960271 0.472591 1.161764 -0.301446 0.550621 1.114416 1.344136 1.489640 1.336572 0.050968 0.500820 -0.057732 1.192684 1.166393 1.318354 1.292569 1.273498 0.099165 0.438587 1.952651 -0.094274 1.629010 1.153422 1.621198 0.812392 0.958180 1.035359 0.874583 0.398809 1.397735 0.813120 1.083168 1.586479 1.738041 -0.184237 0.887045 0.555348 1.573618 0.841883 0.094362 0.127164 -0.091421 0.370018 0.132149 0.004963 0.522483 0.330656 0.374322 1.610332 1.059431 0.769509 1.653723 0.151945 1.881470 1.251612 1.570585 0.545409 0.439130 1.754244 0.242385 1.453705 1.649898 0.928413 0.488588 1.234024 -0.316648 1.499904 0.614604 0.329349 1.231718 0.063978 0.324984 0.806167 0.116728)
)
;;; 113 even --------------------------------------------------------------------------------
-#(113 15.33184168793 #(0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1)
- 14.840950350147 #(0 0 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 1 0 1 0 1 1 1 0 1 1 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 0 1)
- 14.699631659332 #(0 0 1 1 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0)
+(vector 113 14.699631659332 (fv 0 0 1 1 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 0 0 0 0 0 0 1 1 1 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0)
- 11.216283 #(0.000000 0.034493 -0.153093 1.459921 1.038242 0.545400 1.066164 0.810029 0.882306 1.151429 0.361400 -0.225318 0.818702 0.300589 1.380931 1.164425 0.721285 1.273948 1.037609 0.376743 0.006347 1.528790 0.324394 0.524477 0.606911 0.791557 0.712418 1.386267 0.276751 0.371665 0.521333 1.866961 1.735656 0.805565 0.266720 0.330338 0.240509 0.751780 0.224119 1.598845 1.480799 1.500861 0.010191 0.526597 1.500185 1.722653 0.023323 0.366518 0.289654 0.405546 0.394156 0.776171 0.072618 0.005184 -0.255719 0.542403 0.682436 1.514684 -0.060155 0.675380 0.866110 0.874565 -0.238370 0.433881 0.836017 0.804678 0.630967 0.754421 0.269167 0.054528 1.651299 1.400373 1.316396 0.018647 1.803255 0.432627 1.131206 -0.222833 0.200591 1.276227 -0.053247 0.560086 1.169112 0.404812 1.335011 1.142749 1.457138 0.999957 0.478261 0.557780 -0.072635 1.253221 0.242676 0.994594 1.835665 1.124183 0.230790 0.354032 1.073997 0.472451 0.710147 1.736914 0.422318 -0.192273 0.924066 1.553129 1.280181 1.153614 1.326888 1.335759 -0.001683 1.279730 0.424775)
+ ;; ce:
+ 11.086230 (fv 0.000000 -0.000389 -0.085077 1.561730 0.939636 0.783800 0.822356 0.753902 1.063386 1.064106 0.248945 -0.331235 0.891273 0.384236 1.666476 1.209055 0.747827 1.261264 0.977109 0.473018 1.869842 1.640635 0.426272 0.493282 0.533612 0.678013 0.886344 1.278452 0.240683 0.355081 0.485535 1.773399 1.825457 0.749792 0.520365 0.198490 0.250957 0.893317 0.038147 1.767495 1.585752 1.382949 0.153130 0.345263 1.470526 1.544311 -0.012268 0.353892 0.265833 0.472828 0.199271 0.570776 0.068734 -0.052674 -0.058660 0.544786 0.747249 1.268098 -0.214510 0.394163 0.864637 0.802715 -0.354031 0.495687 0.772508 0.500088 0.648134 0.893273 0.437351 0.101751 1.505344 1.430317 1.237725 -0.133160 1.737117 0.276904 0.819294 -0.436692 0.255417 1.171282 -0.127128 0.741289 1.135948 0.224854 1.189320 1.263745 1.436981 1.094323 0.315920 0.551659 -0.076936 0.988425 0.147044 1.117725 1.898145 1.201889 0.000719 0.311682 0.796660 0.441683 0.674490 1.525693 0.432480 -0.261252 0.793197 1.692433 1.264116 1.229766 1.345051 1.012949 0.026436 1.326999 0.385241)
)
;;; 114 even --------------------------------------------------------------------------------
-#(114 14.84645338611 #(0 1 0 1 0 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1)
- 14.794 #(0 1 0 1 0 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1)
- 14.492 #(0 1 0 1 0 1 0 0 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 0 0 0 0 0 1)
+(vector 114 14.492 (fv 0 1 0 1 0 1 0 0 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 0 0 0 0 0 1)
- 11.356897 #(0.000000 0.976628 0.808321 0.074838 -0.091236 1.126551 1.017261 0.514534 1.806574 1.174873 0.455466 0.372062 1.126669 1.075372 0.531994 1.131573 0.250079 0.763292 1.028631 0.936963 1.068589 0.865300 1.918338 1.624401 0.607369 1.000670 1.275747 1.407328 0.253949 0.805919 0.326942 1.022076 1.226700 1.552616 1.221799 0.388804 0.414448 1.367880 0.318317 1.377206 1.595964 0.526911 1.893429 0.015797 0.339704 1.562597 1.223173 1.195398 0.112044 0.004839 1.133889 1.976725 -0.034261 0.620365 1.104741 0.117860 1.764152 0.851137 1.929796 0.582611 0.448875 1.591387 1.662520 1.831672 1.519719 1.385664 1.833036 1.487136 0.341323 1.197949 0.971070 1.765996 0.869467 1.731107 0.924096 0.760523 0.990678 0.852828 1.253216 1.486512 0.625733 1.818663 1.886386 1.543647 1.773795 1.786918 0.739659 1.148384 1.421155 1.965620 0.451994 0.068514 -0.035203 1.612770 0.278943 0.852364 0.398711 1.265814 1.620724 1.378757 1.344779 1.078150 1.858617 0.512975 1.195055 0.199250 0.617366 0.307565 1.507165 1.345616 1.168007 1.510790 0.877364 1.295139)
+ ;; ce:
+ 11.157135 (fv 0.000000 -0.039464 0.696620 1.049808 1.784392 0.325544 0.858380 1.305402 0.025713 0.621307 1.231983 1.810377 0.686152 1.384942 0.194646 1.038532 1.591698 0.399402 1.138014 1.856685 0.607032 1.487902 0.438056 1.390980 0.254957 1.178058 0.067020 0.938265 1.875276 0.851076 0.004242 1.047055 0.045055 1.007007 0.277254 1.473760 0.430329 1.411705 0.732780 1.815871 0.875020 0.057294 1.303464 0.776395 0.029104 1.052938 0.330119 1.901182 1.233681 0.357134 1.566517 1.090726 0.497634 1.859625 1.337968 0.810851 0.475823 1.810735 1.275081 0.613201 0.249187 1.680606 1.475238 0.917317 0.615081 0.035115 1.985536 1.555790 1.295493 0.711316 0.674571 0.194958 0.031526 1.689053 1.752486 1.376552 1.332463 1.199628 1.038471 0.887824 0.776195 0.244582 0.396901 0.380408 0.272363 0.437965 0.462200 0.460243 0.479976 0.174041 0.442325 0.587458 0.662414 0.624435 0.793505 1.270764 1.312001 1.527872 1.906728 0.154209 0.367925 0.274540 0.568448 0.741643 1.347518 1.802398 -0.015484 0.528377 1.078486 1.236948 1.800583 0.083771 0.530926 0.938750)
)
;;; 115 even --------------------------------------------------------------------------------
-#(115 14.597 #(0 0 0 1 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
- 14.568 #(0 1 0 1 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
+(vector 115 14.568 (fv 0 1 0 1 0 0 1 1 0 1 0 1 0 1 0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1)
- 11.357913 #(0.000000 0.130620 0.807071 0.767803 0.925730 0.828694 0.272895 1.625511 0.911006 1.654017 1.164241 -0.650968 0.173815 0.024927 1.025079 -0.246317 0.266112 1.669232 1.737725 1.680753 -0.585346 0.223703 0.921180 0.584010 0.398903 0.477516 1.355666 0.429778 0.992748 1.424254 0.930393 0.479964 0.823295 0.239747 1.602004 0.010801 0.050027 0.088934 0.284776 -0.182079 1.660354 0.967105 -0.129325 1.170730 1.336872 1.591949 1.616921 0.952746 -0.128258 1.642675 1.198479 1.655226 0.746587 1.225725 0.723411 0.391372 1.162996 1.656013 1.010244 0.194476 1.953351 1.676061 1.546068 0.805976 0.820168 1.036489 1.106612 0.510150 1.059638 1.219141 0.158414 0.879208 0.763889 -0.102748 0.298231 0.916982 1.389258 1.375825 1.134994 0.440105 1.328142 1.011545 1.189691 0.174721 0.584965 0.925512 -0.474936 1.378278 1.055272 1.928422 -0.320235 1.780001 0.990995 -0.163268 1.621185 1.490956 0.790934 0.472327 0.890898 1.536827 -0.225863 1.544275 0.144047 1.148997 0.538353 -0.028008 1.097041 -0.058956 1.333697 -0.011438 0.328027 0.881416 0.342874 1.112925 -0.274742)
+ ;; ce:
+ 11.164043 (fv 0.000000 -0.007735 0.519521 0.853408 0.869518 0.698179 0.507264 1.931615 0.907177 -0.081980 1.081445 -0.614824 0.113202 -0.200689 1.235563 -0.410618 -0.044424 1.664294 0.004420 -0.047758 -0.084756 0.183149 0.916469 0.869368 0.512976 0.672797 1.215314 0.375058 0.915864 1.704866 0.936574 0.218869 0.698296 0.045271 1.628914 0.078964 0.149407 0.338531 0.117882 -0.320994 1.491596 1.006019 -0.240429 1.202447 1.241878 1.751514 1.720285 0.676992 -0.221839 1.582392 1.209034 1.838537 0.581983 1.407446 0.568243 0.270174 1.675976 1.382944 1.186838 0.261842 1.726931 1.658063 1.186047 0.622126 0.744214 1.106115 1.040724 0.077608 1.153074 1.203757 -0.097198 0.746254 0.828552 0.000738 0.431630 0.964545 1.375943 1.286789 1.299809 0.427471 1.340955 0.754972 1.408156 0.094923 0.222079 1.183606 -0.446708 1.549043 0.356824 0.090057 -0.448761 1.856851 1.141144 -0.262172 1.428502 1.426364 0.962275 0.289782 0.928089 1.983331 -0.130528 1.708026 0.141800 0.998440 0.458314 -0.400945 1.256766 -0.158747 1.393865 0.122714 0.409705 1.066166 0.512662 1.368814 -0.157203)
)
;;; 116 even --------------------------------------------------------------------------------
-#(116 15.190026349904 #(0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1)
- 15.016979484255 #(0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1)
+(vector 116 15.016979484255 (fv 0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 1 1 1)
- 11.575768 #(0.000000 -0.099721 0.211431 0.271108 0.944864 -0.203901 1.515860 0.285298 0.365274 1.445658 1.646558 0.500804 -0.273042 1.070833 1.100561 0.130954 0.691195 0.424368 1.003734 -0.155812 1.139199 0.135880 0.918096 0.529961 1.202066 1.326673 1.142335 0.043701 1.703817 -0.154053 0.800326 1.405702 0.791637 0.145098 0.627516 1.452423 0.033383 0.243580 0.542622 0.767861 -0.080324 0.338149 1.000536 1.724495 1.524278 1.217355 1.389212 1.320333 1.622076 0.700173 1.568896 0.188940 1.597851 1.378662 0.615390 1.432718 0.266235 0.731768 0.487037 0.301742 1.087034 1.691800 0.294389 -0.003223 0.163259 0.292411 1.070627 1.368373 0.806231 0.098379 0.079026 0.105795 1.713339 0.014381 1.386496 0.728377 0.536844 0.863810 1.078399 -0.246843 1.092782 0.874846 0.919686 1.572605 0.913524 0.310711 1.764043 0.559120 0.284042 1.142755 0.078223 1.437259 1.292941 0.405209 1.111286 0.789897 0.042050 0.605203 0.832503 0.073053 0.448873 0.088236 0.314862 0.169815 0.744695 0.671235 0.297574 0.881847 1.095449 0.538606 0.534404 -0.090007 1.613958 0.582753 0.285040 0.312599)
+ ;; ce:
+ 11.308873 (fv 0.000000 0.106229 0.367548 0.759703 1.450113 0.465588 0.341776 1.222993 1.113540 1.977777 0.446611 1.479153 0.955230 1.992164 0.113898 1.375014 0.059260 1.796441 0.549529 1.451646 0.822821 0.184153 0.830995 0.917449 1.204323 1.332702 0.993172 0.476637 0.152682 0.285363 1.211807 1.922965 1.934074 0.639385 1.616893 0.230624 1.048187 1.300335 1.518811 0.179696 1.385435 1.756315 0.391503 1.071522 1.058267 0.918446 1.149703 1.296773 1.452377 0.657106 1.424678 0.536336 1.485981 1.611780 0.685035 0.081570 0.627797 1.372075 1.222404 1.169964 1.598122 0.868152 1.372826 0.969303 1.586861 1.193094 0.604224 0.998617 0.464449 0.148345 1.841878 1.782198 1.348866 0.090916 1.094752 0.710300 0.820593 1.392694 1.514436 0.049760 1.558012 1.165815 1.487314 0.076812 1.896177 1.104849 0.595775 1.855654 1.593410 0.247419 1.353710 0.594589 0.610661 1.819899 0.938600 0.733465 1.567730 0.600698 0.773170 0.184194 0.659368 0.319562 0.537696 0.610429 1.447619 1.265473 0.841708 1.485819 0.127545 1.328769 1.079928 0.763531 0.772097 1.829006 1.877480 1.871926)
)
;;; 117 even --------------------------------------------------------------------------------
-#(117 15.56056534994 #(0 1 1 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 1 1 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 1 0 1 0 1 1 0)
- 15.070538411179 #(0 0 1 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 1 1 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0)
- 14.875072951405 #(0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0)
+(vector 117 14.875072951405 (fv 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 1 1 1 1 1 0 1 0 1 1 0 1 0 0 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 1 0)
- 11.389441 #(0.000000 -0.090427 0.922956 0.030636 1.407735 0.432193 1.722256 1.422268 0.780292 -0.089766 0.873424 1.147616 0.015336 1.448096 1.343259 0.468123 1.345656 0.065057 0.556041 1.487242 1.915334 1.842169 0.989023 1.945768 1.115863 0.117776 0.441605 0.921155 0.426768 0.326298 1.146174 1.197845 1.820212 0.322737 0.234152 0.869202 0.309179 0.068487 1.210513 -0.510225 0.834260 0.469012 1.215566 0.850918 0.141081 1.171266 -0.351411 1.252030 1.457605 1.594864 0.122097 1.600141 0.086196 1.276595 1.236545 1.403060 1.221154 -0.179546 1.792629 1.425410 0.671891 1.000269 0.076533 1.451638 1.567577 1.600874 0.119618 1.191498 1.102986 1.591706 0.297012 1.438261 0.739895 0.669514 0.993766 1.090070 -0.233096 1.163680 1.206084 0.210328 1.610801 1.922339 1.345451 0.583765 0.826043 1.770776 1.600471 1.033640 0.461622 0.830265 0.537807 0.106352 0.106679 -0.086503 0.403330 1.341692 1.126360 1.668426 0.458645 0.972432 -0.066606 1.591952 1.411611 -0.096328 1.479437 -0.492696 -0.288457 0.151978 1.002009 0.819367 0.475582 0.436270 0.493912 0.707498 0.744412 -0.094817 0.202579)
+ ;; ce:
+ 11.316924 (fv 0.000000 0.002007 0.781183 0.142859 1.136983 0.564897 1.668822 1.434278 0.786253 -0.066154 0.611443 0.995393 0.251112 1.435273 1.364551 0.525535 1.314966 0.129127 0.479417 1.253995 -0.066213 1.791978 1.010496 1.762957 1.001915 0.214345 0.247689 0.903489 0.260750 0.253476 1.207167 1.205379 1.535712 0.678624 0.281388 0.707771 0.067718 0.139190 1.072777 -0.486251 1.036395 0.468802 1.185352 1.038535 0.280173 0.909530 -0.484113 1.287468 1.260568 1.711487 0.150804 1.583879 0.090810 1.204628 1.205628 1.363904 1.302202 -0.374153 1.893817 1.633143 0.456452 1.096868 0.228741 1.451713 1.797254 1.457252 0.043295 1.213733 1.209057 1.602790 0.068325 1.156775 0.622551 0.595184 1.038306 1.138842 -0.234118 1.017885 1.021316 0.185827 1.543882 1.771287 1.232077 0.638733 0.782279 1.727494 1.416897 0.927851 0.310771 0.940398 0.359593 0.479087 0.049395 0.127472 0.206640 1.096147 1.150359 1.659289 0.531691 1.180395 -0.391853 1.508862 1.232699 -0.058238 1.293947 -0.476640 -0.441677 -0.000097 0.976133 1.008107 0.426436 0.349033 0.468049 0.890361 0.742074 -0.282223 0.097574)
)
;;; 118 even --------------------------------------------------------------------------------
-#(118 15.425480892646 #(0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1)
- 14.841081077183 #(0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1)
- 14.774983755641 #(0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1)
+(vector 118 14.774983755641 (fv 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 1 0 0 1 0 0 1 1 0 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 1 1 0 0 1 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1)
- 11.600755 #(0.000000 0.270851 0.074271 0.113327 0.727491 1.386761 1.316101 1.226307 -0.000940 0.754574 1.654418 1.286911 0.954689 0.140710 1.791031 0.715317 1.780087 0.471704 1.552631 1.952713 0.842147 0.051361 1.508390 0.077771 0.705187 0.905144 0.348333 1.344004 1.090818 1.193205 0.088181 0.486861 1.341015 1.097797 0.736722 1.625568 1.746274 0.897536 1.522384 1.695765 1.556243 1.893025 0.199103 0.477348 0.401646 0.792688 1.383631 1.013878 0.190918 0.129992 0.144160 0.063104 0.204917 0.844761 1.659335 0.625674 0.782834 0.919196 0.420551 0.414607 -0.077383 1.119413 1.647786 0.210873 1.492160 0.867808 0.218354 1.798168 1.008006 0.807875 0.937614 1.040417 1.461677 0.512864 1.586156 1.113955 1.238729 1.263527 1.534560 0.235112 1.388691 1.008188 0.590689 1.331431 0.846753 0.504789 0.624601 1.144180 0.910768 0.573471 0.836755 0.746435 1.494176 1.976822 0.180633 1.011692 0.401517 1.672492 -0.087949 1.198857 0.745241 1.604050 0.520052 0.012857 1.267895 0.561107 1.089703 1.377403 0.807814 1.089586 0.836543 0.379875 0.372747 0.163874 1.481389 0.170896 1.443980 0.456701)
+ ;; ce:
+ 11.484440 (fv 0.000000 0.001991 1.371443 1.203612 1.612576 0.004093 1.549674 1.288096 -0.387029 0.195003 0.810853 0.270601 -0.577973 0.504742 1.563436 0.486759 1.262262 1.570710 0.506761 0.593681 0.979316 0.335707 1.012168 1.408672 1.854537 -0.158648 0.922395 1.542523 0.986042 0.834203 1.587297 -0.259646 0.182780 1.551059 1.155567 -0.257572 1.455112 0.260440 0.601953 0.584384 0.049890 0.147201 0.144045 0.167346 1.932438 -0.017361 0.127366 1.610439 0.342924 0.013626 1.817380 1.463720 1.349166 1.704788 0.073700 0.915288 0.862503 0.591911 -0.314143 1.485517 0.827715 -0.237036 1.912130 0.274385 1.072007 0.283372 1.321692 0.776602 1.550269 0.993130 0.787661 0.571393 0.826289 1.556852 0.493665 1.623055 1.585319 1.166393 1.153368 1.675993 0.390711 -0.188185 1.283768 1.613360 0.827291 0.287448 0.106800 0.359659 1.804631 1.116403 1.085383 0.798175 1.148482 1.482094 1.397430 -0.132223 0.799212 -0.083458 -0.185498 0.780581 -0.264041 0.816859 1.276724 0.301164 1.464050 0.647926 1.027415 1.036757 -0.070219 0.009504 1.202438 0.566235 0.360100 -0.509218 0.735525 1.198215 0.064044 0.933335)
)
;;; 119 even --------------------------------------------------------------------------------
-#(119 15.519069915733 #(0 1 1 0 0 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 0 1)
- 14.971 #(0 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1)
+(vector 119 14.971 (fv 0 1 0 0 1 0 1 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1)
- 11.647167 #(0.000000 0.533683 0.754070 1.450011 0.240436 0.788302 1.916282 1.507888 1.754792 0.992836 0.500366 0.541482 -0.028901 1.396858 1.371738 0.778577 0.931128 1.125468 1.831945 1.358824 1.731416 -0.026231 1.548838 0.589125 0.787634 0.611793 0.914120 1.244840 1.569393 1.419408 0.969957 1.719311 0.451274 1.700268 1.758617 0.307256 1.173543 1.875935 1.873597 0.470675 0.458135 0.525383 0.932690 1.734523 0.048615 0.195126 1.466289 1.277077 1.450859 0.611329 0.003314 1.909851 1.871427 0.384756 0.855074 1.693853 0.785296 0.442470 0.849824 0.471715 0.119222 0.230590 0.380853 1.367598 1.483224 1.254021 1.341975 1.620287 1.033891 1.028526 0.951943 1.484933 1.807506 1.676638 0.932763 1.662578 1.750336 1.509884 1.093010 1.773996 1.292701 0.553823 1.120214 0.478001 0.802084 1.522721 1.052499 0.345315 0.822354 0.949813 1.909032 1.425166 0.729703 1.645292 0.601468 0.575210 1.639906 1.029616 1.316349 0.034119 1.484383 1.256914 0.639165 1.666862 1.377609 0.780282 0.666510 -0.044889 1.293889 1.917241 0.814978 1.716222 0.318535 0.365510 1.576683 0.795538 1.653149 1.010308 1.730285)
+ ;; ce:
+ 11.482774 (fv 0.000000 0.022508 -0.154621 -0.133560 0.019055 0.044006 0.744199 -0.189660 1.646970 0.323873 1.389900 0.872285 1.714451 0.465026 0.101347 1.045318 0.619662 0.299667 0.695492 1.761299 -0.465991 1.247091 0.360217 0.709249 0.270723 1.861018 1.538710 1.394055 1.300550 0.683046 1.420419 1.591103 0.068117 0.694826 0.315654 0.206747 0.551524 0.669546 0.407597 0.609362 1.957764 1.313475 1.269191 1.535059 -0.453483 1.127112 -0.438414 1.098010 0.925063 1.295295 0.349547 1.800021 1.265884 1.210725 1.261945 1.409059 0.031987 1.064471 1.087820 0.131065 1.230087 1.008698 0.646880 1.108562 0.465537 -0.286867 1.491020 1.274669 0.240579 1.517428 0.852795 0.970665 0.563004 0.179967 1.049271 1.080429 0.558118 -0.026181 0.946833 1.033681 0.158731 0.889882 0.983418 -0.020663 1.724961 1.892566 0.743055 1.647217 1.582049 1.007387 1.541602 0.779919 1.494250 -0.227797 0.081916 -0.223533 0.250776 1.270562 1.106978 1.124428 0.217158 1.341937 0.121564 0.628868 -0.092377 1.005391 0.266805 1.036087 -0.286050 1.835950 0.190028 0.634731 1.031073 0.250385 1.062823 1.900473 0.065255 0.789889 1.186094)
)
;;; 120 even --------------------------------------------------------------------------------
-#(120 15.824793168635 #(0 0 1 1 0 0 1 0 1 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)
- 15.350 #(0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)
- 15.153992567168 #(0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)
+(vector 120 15.153992567168 (fv 0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)
- 11.738601 #(0.000000 1.213686 0.974573 0.242278 1.864871 0.243588 0.639360 0.435355 0.502584 1.338624 1.113054 1.616395 0.411484 1.840577 1.691016 1.044638 0.916936 1.852843 0.924328 0.411522 1.378424 1.932787 0.743525 1.713586 1.876070 0.467626 -0.029102 1.809854 1.418022 1.118436 1.904153 1.756641 0.933520 0.315003 0.089031 0.615131 1.846442 1.759102 0.107876 0.593634 0.106155 0.210259 1.373430 0.377556 1.669830 1.857173 1.508117 0.212358 1.930993 -0.026133 0.194637 0.550016 0.373199 0.910779 0.127794 0.521183 0.226334 0.996276 1.080369 0.078265 0.446558 1.733790 1.632989 1.572923 0.180448 1.831568 0.812409 1.387926 0.892610 0.592148 0.449990 1.298665 1.749981 0.300905 1.741502 0.981519 1.410089 1.526800 1.801726 0.937852 0.427109 0.756913 0.096790 1.713823 1.529505 0.107429 1.385639 0.859257 0.278559 0.642177 0.013514 0.907681 1.102521 1.241899 0.532237 1.277162 0.733715 0.856669 1.608081 0.948601 0.661735 1.606157 0.466916 0.673485 1.689176 0.198888 1.950818 0.537723 1.883320 0.085184 1.719313 0.687565 1.262064 -0.036519 0.185884 1.656459 1.818900 1.916931 0.919460 0.760572)
+ ;; ce:
+ 11.467293 (fv 0.000000 0.182387 0.991318 1.555550 0.388952 1.165472 1.861486 0.514097 1.467680 0.222754 0.972121 1.805786 0.710465 1.475951 0.467146 1.464916 0.222083 1.170792 0.137691 0.926627 1.940353 0.964985 0.072695 1.174272 0.187090 1.145640 0.255557 1.524936 0.697660 1.793860 0.870660 1.991349 1.164698 0.214289 1.427601 0.920631 0.315825 1.506380 0.771158 0.081551 1.397459 0.660219 0.101946 1.376912 0.742252 1.975042 1.384246 0.994395 0.741688 0.116508 1.476904 0.995545 0.574556 -0.050092 1.395747 1.037641 0.654167 0.178367 0.000799 1.661003 1.401198 1.027447 0.549822 0.319024 -0.009775 1.643655 1.451741 1.190761 1.247596 1.019397 0.814792 0.637301 0.619820 0.528955 0.206546 0.210086 1.907606 0.080551 1.852358 0.220977 0.039775 0.240556 0.118697 0.201230 0.183490 0.410415 0.195004 0.346621 0.384871 0.552316 0.919228 0.966578 1.294194 1.669482 1.481782 1.816544 0.045277 0.459121 0.610971 0.884884 1.313099 1.767978 0.251484 0.557317 0.967847 1.457578 1.608185 1.982656 0.491182 1.030233 1.763557 0.343009 0.756305 1.429088 0.071947 0.646318 1.100378 0.016785 0.234469 0.966926)
)
;;; 121 even --------------------------------------------------------------------------------
-#(121 15.507 #(0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 1 1 1 1 1 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1)
- 15.168510014453 #(0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 0 0 1)
- 14.652157793709 #(0 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 1 0 0 0 1)
+(vector 121 14.652157793709 (fv 0 0 1 1 0 0 1 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 1 1 0 0 0 1)
- 11.598014 #(0.000000 0.073012 1.850286 1.644847 0.984311 0.503625 1.138015 1.918375 1.257356 0.832370 0.642296 1.887354 1.320622 1.229206 1.089486 1.472429 0.058748 1.149405 1.746123 1.912817 0.987830 1.899759 0.407371 1.687150 1.917953 0.493840 1.707878 0.109123 0.724421 0.103972 0.215248 1.563878 1.725219 0.495226 0.237040 0.318074 1.380177 0.551006 1.360233 0.026363 1.446533 1.334140 0.871237 1.674028 1.439216 0.155518 1.802667 1.506410 1.799380 1.435766 0.914156 0.231827 0.401656 0.484996 1.331753 0.254560 1.269489 0.025883 1.590382 0.313867 1.835978 1.557767 1.752887 1.574134 0.226584 1.944752 1.947203 0.665188 1.643517 1.728079 1.206569 1.261103 1.175334 0.530658 1.016181 1.947946 0.191032 0.418140 1.308688 0.821494 0.182156 1.367512 0.826438 0.444939 0.872694 0.824884 0.507447 1.655020 1.735124 1.148120 0.330025 1.256548 0.559927 0.897752 1.483743 1.141884 1.140288 1.523640 0.366787 0.289717 0.643043 0.064498 1.929754 0.569375 0.601730 1.245941 1.477661 1.749183 1.093299 1.364939 1.446528 0.134625 0.580058 0.687665 1.600499 0.924444 1.781584 0.037889 1.907180 0.633073 1.604367)
+ ;; ce:
+ 11.519858 (fv 0.000000 0.011378 1.753896 1.437136 0.631135 0.114781 0.660482 1.334498 0.581894 0.089402 1.905979 0.990187 0.248688 0.037998 1.898481 0.142274 0.776484 1.706556 0.191753 0.338054 1.318431 0.126497 0.601712 -0.255350 -0.163162 0.402669 1.476694 -0.235785 0.342102 -0.362582 1.698550 0.968284 0.940716 1.711626 1.326298 1.313163 0.329811 1.359487 0.105165 0.702440 0.022566 -0.069577 1.342187 0.008210 1.716840 0.240520 -0.171785 1.502743 1.676402 1.248370 0.723049 1.865376 0.001307 0.034537 0.684465 1.516715 0.492834 1.116078 0.672438 1.182471 0.641149 0.373795 0.379475 0.145636 0.762178 0.433641 0.347370 0.948832 -0.132296 -0.133379 1.190338 1.266604 1.009701 0.238209 0.752479 1.596905 -0.296398 -0.192578 0.605136 0.075081 1.420344 0.466284 -0.288768 1.297330 1.689017 1.567153 1.185252 0.260951 0.236638 1.431783 0.599599 1.509650 0.653104 0.899471 1.457027 1.068607 0.961380 1.256645 0.033616 -0.139517 0.092125 1.417841 1.213189 1.821992 1.761054 0.238734 0.417918 0.642844 -0.104823 0.081427 0.065359 0.670607 1.054994 1.082441 -0.176585 1.119180 -0.224101 0.108660 -0.203752 0.470242 1.351870)
)
;;; 122 even --------------------------------------------------------------------------------
-#(122 16.162 #(0 0 1 1 0 0 0 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 0 0 1 1 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1)
- 15.305 #(0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 0 1 0 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 0 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 1 0 0 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 0 1 1 1 1)
- 15.057187309653 #(0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
+(vector 122 15.057187309653 (fv 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 1 1 1 1 1)
- 11.801457 #(0.000000 0.204837 1.499244 1.780845 1.651094 1.405374 1.707435 1.890590 1.056465 1.017663 0.201255 0.021796 1.914773 1.289596 0.375833 0.669336 1.779088 1.096469 1.263513 0.561965 0.144832 1.566475 1.502246 1.434194 1.923126 1.691842 1.587108 1.474959 0.735911 -0.044189 0.211553 0.013748 0.368999 1.614143 0.964456 1.023734 0.712162 0.455898 0.363484 0.928386 1.480011 0.219078 1.627106 0.465330 1.221441 -0.031360 1.876043 0.033968 1.342938 1.220955 -0.030220 0.505908 0.964342 1.688225 1.507145 1.380505 0.766889 1.587034 0.813462 0.716558 0.851692 1.087273 1.113649 0.074527 0.564824 0.789169 0.627033 0.980909 1.132740 1.394855 0.079266 0.569184 0.889416 0.689511 0.311485 1.229903 1.528536 0.671299 1.731398 1.352942 1.256435 0.352791 1.762493 1.281148 0.357426 1.530279 0.078551 1.715767 0.133128 0.513509 1.289716 0.709958 0.003006 0.741597 1.827725 1.671043 0.827936 0.078059 0.069514 0.656043 1.716005 1.091238 1.329516 1.108072 0.669680 1.267734 1.854881 0.643367 0.487262 0.378083 0.842322 -0.092677 1.419963 0.879812 1.592303 1.164764 1.606453 1.679795 -0.075858 0.992425 0.467483 0.975350)
+ ;; ce:
+ 11.608575 (fv 0.000000 0.491043 0.007498 0.791398 0.660542 0.960014 1.233279 1.608131 1.227878 1.325414 0.833262 0.826707 1.074054 0.805872 0.453534 0.680408 0.163876 1.857437 1.971814 1.942244 1.528127 1.170281 1.451447 1.612886 0.379280 0.469353 0.748640 0.861019 0.289879 1.554726 0.245277 0.578277 0.944303 0.525039 0.312641 0.462849 0.710444 0.524042 0.736659 1.743905 0.289146 1.405383 1.146345 1.959424 1.266837 0.105168 0.264372 0.716079 0.180416 0.676462 1.349909 0.242201 1.112324 1.903652 0.096097 0.298665 1.938506 0.907637 0.445138 0.676772 1.018566 1.538692 1.890411 1.037889 1.754475 0.454828 0.375080 1.028535 1.584256 0.107387 0.732227 1.941438 0.410085 0.465514 0.392267 1.461968 0.104792 1.428078 0.866762 0.928264 0.963879 0.060101 0.001979 1.538408 1.110694 0.832374 1.363340 1.030944 1.856655 0.680542 1.663245 1.268139 0.925891 1.913766 1.292282 1.484272 0.663172 0.251878 0.695143 1.443461 0.967688 0.177908 1.246199 1.066133 0.923551 1.951433 0.308206 1.532986 1.662559 1.880618 0.612432 0.084712 1.836918 1.410469 0.509104 0.078690 0.955183 1.487132 0.007102 1.473132 0.898543 1.722166)
)
;;; 123 even --------------------------------------------------------------------------------
-#(123 15.443287674437 #(0 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 0)
- 15.448 #(0 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 0)
- 15.332496766406 #(0 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 1 1 0 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 0 1 1 1 0)
- 15.156582832336 #(0 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0)
+(vector 123 15.156582832336 (fv 0 0 0 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 0 1 0 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 0 0 0 1 1 0 1 1 1 0)
- 11.772394 #(0.000000 0.096708 -0.071966 -0.017423 0.996288 1.258468 1.360128 -0.300741 0.355817 1.225283 1.694468 0.655704 1.307790 1.789702 0.263830 0.954379 1.115593 1.552531 1.515008 1.142488 1.308928 1.686820 0.970118 0.252667 1.384715 0.056922 1.298509 0.866473 0.314302 1.065572 1.550899 1.310539 0.424410 0.733627 0.448569 1.283886 0.778487 0.331054 0.324230 1.140203 0.606068 1.161014 0.537668 0.804056 1.504524 0.339676 1.097122 0.194000 1.577336 1.971610 -0.260293 0.410617 1.654768 -0.079026 0.891466 0.410588 0.682392 1.788355 1.829845 1.713771 0.868999 0.491758 -0.098058 1.219133 0.219117 0.273501 0.675576 1.042383 1.273065 1.555347 0.892794 1.359319 1.121382 1.659388 0.233142 1.058170 0.725198 0.404836 0.405787 1.393273 0.566964 1.003311 0.484739 0.296374 0.945307 1.760489 0.572075 1.351878 1.327592 1.641104 1.900658 1.515779 1.285933 1.038154 1.214151 1.218854 0.806520 -0.199570 0.454622 0.215872 0.670453 0.900955 1.598013 1.465661 1.426087 -0.222878 -0.722341 0.133449 0.132233 0.097047 1.716971 1.308294 0.542078 1.960913 0.755947 0.210005 -0.058319 1.498352 -0.396530 0.620609 -0.281753 1.014967 0.968924)
+ ;; ce:
+ 11.636238 (fv 0.000000 -0.006745 1.718129 0.124324 0.694087 1.248162 1.264742 -0.205335 0.401180 1.175941 1.275199 0.664232 1.306473 1.775017 0.032088 1.172990 1.182530 1.684652 1.496052 1.018965 1.419875 1.724105 0.881080 0.365436 1.623371 0.118184 1.144470 1.090686 0.455215 1.110091 1.537843 1.409976 0.722528 0.766713 0.291253 1.154526 0.688621 0.079128 0.455767 1.072502 0.449509 1.072583 0.529271 0.933123 1.665962 0.456257 0.965966 0.378656 1.446789 1.599052 -0.405591 0.510787 1.741784 0.047873 1.179439 0.534603 0.738060 1.583394 -0.036662 0.033912 0.990276 0.359185 -0.041714 1.309428 0.206155 0.615264 1.013822 0.916642 1.092385 1.276567 0.943657 1.397941 1.325784 1.841099 0.255550 0.983848 0.698027 0.630229 0.444618 1.485280 0.538087 1.172707 0.510703 0.139282 1.060931 1.974722 0.748366 1.241445 1.282543 1.643915 -0.055670 1.226488 1.259535 1.054944 0.867004 1.180445 0.871590 -0.304557 0.449098 0.105044 0.415180 1.325658 1.915647 1.593801 1.274805 -0.206650 -0.888906 0.385364 0.203928 0.267603 1.679470 1.529346 0.775016 1.650475 0.752800 0.231942 -0.128889 1.695246 -0.352686 0.872132 -0.113288 1.107634 0.969190)
)
;;; 124 even --------------------------------------------------------------------------------
-#(124 15.877207326383 #(0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 1)
- 15.402028019163 #(0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 0)
- 15.192802705519 #(0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 0)
+(vector 124 15.192802705519 (fv 0 1 0 1 0 0 0 0 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 1 0)
- 11.862518 #(0.000000 -0.039920 -0.147864 0.466824 0.719172 1.198126 -0.184791 -0.065982 1.145479 0.769326 -0.333250 0.975912 0.104428 0.300835 0.224128 1.257144 1.770332 1.134148 1.286330 1.076793 1.866665 0.062661 0.046491 0.653016 1.130789 0.043821 0.055844 1.207525 0.952657 0.759658 -0.497986 -0.183603 -0.216815 1.649095 0.998371 1.245053 0.237866 0.654205 0.016596 -0.083762 0.619475 1.620894 1.414538 0.944976 -0.183829 1.525989 0.697621 0.728431 0.067592 -0.130392 1.020989 0.766146 1.134564 1.658466 0.064684 0.929901 0.556394 1.724914 0.192745 0.714840 0.327964 0.010921 1.480416 1.440846 -0.062840 1.565448 0.183519 0.327561 0.395953 0.232661 0.028704 -0.110050 0.078330 1.085699 0.122533 -0.079461 1.784236 1.299442 1.655861 1.144748 1.170289 -0.061664 1.082245 1.822818 -0.137533 1.152516 0.011129 1.354656 0.340130 0.656499 -0.143152 1.664753 0.345788 0.333582 0.390624 0.154618 0.661989 1.920906 1.236440 0.398996 0.162421 0.862761 -0.212819 0.990900 1.278078 1.396157 1.425204 0.542569 1.382500 0.797368 0.408369 0.692433 1.622319 0.737335 -0.196447 0.039821 0.719202 1.364388 1.102840 1.355878 1.216767 1.486865 -0.120249 -0.254124)
+ ;; ce:
+ 11.657070 (fv 0.000000 -0.014444 0.618588 1.072923 1.770483 0.269156 0.799491 1.415133 0.042486 0.667402 1.107625 1.860582 0.629761 1.228415 0.069647 0.757140 1.477152 0.235584 0.874179 1.620964 0.498598 1.283127 0.032336 0.931298 1.753048 0.690202 1.655180 0.637473 1.388106 0.380043 1.352876 0.417570 1.513619 0.398780 1.331736 0.297986 1.356056 0.723808 1.880303 1.075552 0.270324 1.454538 0.409485 1.419750 0.727467 0.088163 1.085380 0.180158 1.411841 0.476674 0.009315 1.487690 0.712294 -0.024891 1.362496 0.659010 -0.191074 1.370827 0.842745 0.281346 1.600375 1.056928 0.756127 0.303601 1.748097 1.271638 0.793604 0.293922 -0.112046 1.276835 1.265355 0.825565 0.530280 0.127474 1.794406 1.661127 1.499821 1.002415 0.662420 0.351459 0.106647 -0.108853 1.731304 1.778120 1.591760 1.488839 1.111393 1.249609 0.941574 1.119732 0.633391 0.859266 0.602796 0.706230 0.723444 0.862387 0.960018 1.160855 0.914474 1.092081 1.010153 1.292261 1.124565 1.486704 1.752791 1.765950 0.121592 0.301316 0.732598 0.775797 0.931505 1.227451 1.354358 1.806530 0.301686 0.668653 0.912777 1.521847 -0.005389 0.243631 0.695894 1.356048 1.421601 -0.009388)
)
;;; 125 even --------------------------------------------------------------------------------
-#(125 15.874541816027 #(0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 1 0 1 0 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0)
- 15.743360519409 #(0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 1 1 0 0 0 0 0 1 0 0 1 0 1 0 0 0 0 0 0 1 0 1 1 0 1 1 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0)
- 15.340427254326 #(0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0)
+(vector 125 15.340427254326 (fv 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 0 0 0 1 1 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0)
- 11.841139 #(0.000000 0.133069 0.520738 0.384439 1.640913 0.007434 0.002330 1.914894 -0.009568 1.414072 0.320024 0.305029 0.558594 0.697005 1.810884 0.121250 1.459606 1.879749 0.708543 1.312371 0.882622 0.602681 1.868404 0.902880 0.760232 0.173878 1.732302 0.880049 0.306061 1.340836 1.482711 -0.045840 1.207119 1.230824 1.289453 1.245781 0.734367 1.163876 0.820039 1.127576 1.433035 0.864874 1.194962 1.130105 1.210107 1.833222 0.213697 0.221029 0.157048 1.476438 0.574345 -0.001854 1.703910 1.819621 0.842819 0.138779 1.179870 1.661528 0.088619 0.478747 0.875533 -0.051166 1.537306 0.589221 0.338221 1.324697 1.498311 1.512921 1.297307 0.139811 1.926476 1.319096 1.796378 0.762950 1.923160 0.368013 0.102729 0.971126 0.213185 0.706784 1.961694 1.888862 0.281904 0.234803 1.690882 0.482188 1.406702 1.204712 1.452759 0.849854 0.086826 0.210160 1.643469 0.056140 1.264479 1.845175 1.404143 0.638869 0.571858 1.436044 1.852656 0.886476 1.442354 1.509635 0.388085 1.212261 1.829301 1.873228 1.641695 0.693744 0.551357 0.272150 1.738331 1.553744 1.554398 0.211283 1.012611 0.391320 0.836983 1.069424 1.529637 1.376921 0.031959 1.608094 1.780455)
+ ;; ce:
+ 11.726117 (fv 0.000000 -0.030799 0.144449 1.728737 0.676919 0.980768 0.920869 0.523856 0.255848 1.651421 0.139364 0.110259 -0.007857 -0.065476 0.898902 0.948218 0.041888 0.431499 0.955394 1.279597 0.899810 0.236632 1.338434 0.051979 0.022413 1.076247 0.455727 1.395710 0.537276 1.454562 -0.640673 1.646766 0.563227 0.468669 0.349014 0.207631 1.436456 -0.313434 1.039871 1.394849 1.334026 0.410015 0.714625 0.314535 0.295044 0.730112 0.878789 0.469330 0.349941 1.427732 0.501996 1.482747 1.311352 1.023386 -0.133711 0.934640 1.777275 0.139714 0.307620 0.411617 0.680605 1.805628 0.987833 -0.006267 1.325295 0.129226 0.029571 -0.131946 1.571497 0.134896 1.855074 0.957063 1.276873 0.033353 0.738862 1.196621 0.702473 1.212401 0.334974 0.594964 -0.391144 1.491428 1.659733 1.324319 0.593336 1.121378 1.836235 -0.494188 -0.410122 0.669230 1.852484 1.550441 0.612411 1.088978 0.233243 0.429977 0.213254 1.111633 0.529727 1.280152 1.687453 0.208804 0.661537 0.543046 1.373269 -0.302027 0.236049 0.167939 1.751438 0.754446 0.306753 -0.393681 0.981979 0.613716 0.543141 0.783701 1.211717 0.696576 0.743400 0.902651 1.308022 0.648265 1.051117 0.596115 0.465417)
)
;;; 126 even --------------------------------------------------------------------------------
-#(126 15.964 #(0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1)
- 15.680 #(0 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 1 1)
- 15.28212621738 #(0 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 1)
+(vector 126 15.28212621738 (fv 0 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 0 0 0 1 1 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 1 0 1 1 1 1 0 0 1 1 1 0 1 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 1 1)
- 12.002187 #(0.000000 1.759024 0.813389 0.624550 0.567669 1.308910 0.698930 1.060000 0.470477 0.320985 0.835756 0.684354 1.313185 0.463776 1.828335 0.266428 1.329451 -0.130797 1.515278 1.353330 0.000889 0.579030 1.701750 0.669502 1.424996 0.457575 1.810100 -0.007846 1.338014 1.396249 1.154022 1.294045 0.958810 0.681142 0.618127 0.144130 1.159370 1.426902 0.765788 0.164166 0.630564 0.603942 1.328486 0.198662 1.858128 1.572734 1.888744 1.605904 0.559604 1.871129 1.801244 -0.049450 1.678513 1.589080 0.890567 0.397139 0.191374 1.086660 1.332786 1.796152 0.880091 1.772131 0.117107 -0.016006 1.521434 0.526973 1.814984 1.617274 1.083808 1.394789 1.413607 1.266437 0.463808 1.855072 0.632624 1.845021 0.723978 1.798138 1.746992 1.720510 0.326061 0.516421 0.546210 1.144755 1.420708 0.529930 1.733708 0.398062 1.431640 1.704681 0.624770 0.725677 0.924232 1.250987 1.178841 -0.005317 1.091388 0.928505 1.564585 1.888953 0.396643 0.168896 1.891867 0.672671 0.614935 0.689157 1.727168 1.731208 0.745957 1.044301 1.861456 0.248777 1.145588 0.205889 1.679951 0.904534 1.834460 0.001048 0.337808 0.180039 1.824662 0.152410 0.208162 1.477291 0.628491 0.509856)
+ ;; ce:
+ 11.728732 (fv 0.000000 0.080423 0.859652 1.251285 0.001006 0.708480 1.329479 1.910986 0.575680 1.212005 1.941153 0.634379 1.324750 0.149467 1.036506 1.708281 0.612012 1.577838 0.338405 1.197595 0.029554 0.897812 1.895059 0.811840 1.778431 0.660286 1.607791 0.800800 1.947497 0.840295 1.874911 0.873100 1.809637 0.999296 0.039834 1.184996 0.352552 1.522062 0.693733 0.018959 1.247028 0.457540 1.699479 1.003229 -0.011631 1.387625 0.675778 1.873479 1.137263 0.739657 0.006673 1.350424 0.946270 0.348539 1.590673 1.018988 0.508851 1.844396 1.236918 0.897127 0.426111 1.973108 1.634669 1.217265 0.734120 0.464551 1.899258 1.421045 1.113676 0.840738 0.386615 0.153879 1.864697 1.811230 1.560296 1.258544 1.008246 0.775514 0.569961 0.379626 0.120794 0.073632 1.824999 1.979635 1.804273 1.934045 1.809824 1.823348 1.667350 1.525160 1.703620 1.223510 1.668539 1.353060 1.680931 1.768624 1.959157 0.014225 0.272244 0.168722 0.385113 0.365860 0.784448 0.739738 0.967615 1.309874 1.705334 0.092760 0.302680 0.844130 0.978941 1.342601 1.583162 1.784704 0.228093 0.608194 1.171628 1.840667 0.207453 0.811900 1.464070 1.557525 0.111382 0.715963 1.219826 1.691486)
)
;;; 127 even --------------------------------------------------------------------------------
-#(127 15.859804776319 #(0 0 0 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1)
- 15.609939955803 #(0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 0 0 1 0 0 1 0 1)
- 15.237931718393 #(0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
+(vector 127 15.237931718393 (fv 0 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0)
- 11.913755 #(0.000000 0.458850 1.749293 1.686980 1.016374 0.990647 1.522872 0.801093 1.304331 1.843601 1.219893 0.783232 1.019421 0.053198 0.919029 0.387742 1.105543 0.395465 0.906078 1.616363 1.280872 0.741908 0.352938 0.856621 0.779346 1.597503 0.417802 0.590376 0.462084 0.791009 1.268742 0.039216 1.773565 1.753673 0.065503 0.340450 0.733359 0.958707 1.113398 0.363739 0.582597 0.175665 1.109759 1.432121 0.472418 0.695858 0.963284 0.012893 0.246314 1.603090 1.271846 0.940722 1.132660 0.279700 1.897097 0.495068 0.153528 0.545025 0.606519 0.848849 0.956781 0.078095 0.328272 0.919053 0.732876 0.292624 0.304674 0.754331 1.303151 0.590226 1.234317 1.570782 0.187174 1.891910 0.528718 1.889052 1.496041 1.692719 0.615316 1.545870 1.222066 0.118457 0.751452 0.688288 1.421821 0.751484 1.485360 0.709688 0.821177 0.364122 0.640261 -0.048924 0.128383 0.628891 1.563597 0.740933 1.719216 1.598894 0.744959 1.016017 1.369307 0.626835 0.727546 1.663454 1.417725 1.133790 1.699063 1.738199 1.495982 0.767698 0.620764 0.229899 1.470090 0.911845 0.122359 1.255523 0.180442 1.434472 1.591298 1.064500 1.546130 0.191440 0.169145 1.960740 0.585029 0.102784 0.134910)
+ ;; ce:
+ 11.791982 (fv 0.000000 -0.006501 0.895946 0.390502 1.267039 0.777220 0.845244 1.619366 1.738905 1.963883 0.834239 -0.095420 1.729892 0.328487 0.839467 -0.107042 0.077371 1.006289 0.934388 1.316468 0.399445 1.446071 0.867321 0.749721 0.310809 0.608045 0.928981 0.860186 0.132975 0.107680 0.035103 0.310673 1.698683 1.209244 1.219344 1.008158 0.868768 0.774429 0.524607 1.259150 0.968654 0.225551 0.670254 0.584349 1.206486 0.849939 0.881353 1.316256 1.223028 -0.051550 1.266841 0.533270 0.307133 0.871408 0.135067 0.350791 1.392175 1.398704 1.054665 1.094835 0.720758 1.235433 1.111126 1.315441 0.540735 1.759697 1.421149 1.220945 1.416174 0.271820 0.476065 0.346906 0.599580 1.865670 -0.010232 0.873428 0.191144 -0.138143 0.473276 0.793750 0.140345 0.466125 0.753788 0.166751 0.509961 1.311817 1.848999 0.485052 0.151803 1.266182 1.022497 -0.055512 1.662000 1.747291 0.161074 0.983665 1.511467 0.958919 1.602506 1.536897 -0.682895 0.108054 0.153831 0.495344 -0.168193 1.039701 1.035352 0.840794 0.198694 1.029171 0.222780 1.379441 0.220019 1.296462 0.080553 0.616328 1.212980 -0.006268 1.810129 0.820776 0.816381 1.107475 0.666818 -0.087937 0.128508 1.246653 0.713705)
)
;;; 128 even --------------------------------------------------------------------------------
-#(128 16.159544533014 #(0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 1 0 0 0 0 0 1 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 1 0)
- 15.889096531102 #(0 1 0 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 1 0 0 1 1 0 1 1 1 0 1 0 1 0 0 0 1 1 1 1 0 1 0 0 1 0 1 1 1 0 0)
- 15.651492555885 #(0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0)
+(vector 128 15.651492555885 (fv 0 0 0 1 0 0 1 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0)
- 11.946934 #(0.000000 0.110224 1.317433 1.797526 1.102100 0.209029 1.428571 1.133123 1.632697 0.966873 1.116149 0.053301 0.092706 0.080960 0.153580 1.911501 0.649551 1.205157 0.796416 1.681445 1.325103 1.167536 1.542241 1.540056 1.033980 1.216814 1.085574 1.454359 1.219961 1.442465 0.723712 -0.023293 0.417722 0.263117 1.497356 0.790233 0.461255 1.671594 0.890215 1.810658 0.506636 1.761132 0.517331 1.843531 1.534981 1.096675 1.225228 1.023113 0.739520 -0.076641 0.652583 0.393846 1.809030 0.694212 1.885624 1.228118 0.137130 0.809928 1.317389 1.488341 0.513454 0.557099 0.616797 1.885556 0.018888 0.075443 1.175365 0.234696 0.503636 0.474674 1.878540 1.591338 0.735580 1.822707 0.361140 0.476433 0.591681 0.266240 0.510620 1.681323 0.782048 1.166910 0.944203 1.047479 1.530230 0.037515 0.350043 0.428391 1.229480 1.269067 1.818028 1.973676 0.353988 1.146808 1.566981 0.325006 1.523161 1.595138 1.833021 1.643280 0.932822 0.720878 0.421477 1.661757 1.281770 0.925020 0.356017 1.588082 0.247426 0.670664 1.456924 0.330352 1.282145 1.774045 0.594101 0.625163 1.183843 0.352914 0.519728 0.045311 0.462410 0.609312 0.252206 1.188143 0.342225 0.672241 1.683813 1.329048)
+ ;; ce:
+ 11.856765 (fv 0.000000 0.002702 1.085974 1.244165 0.302147 1.259231 0.307623 1.789071 0.248647 1.161010 1.314907 0.079451 1.835817 1.698549 1.371220 1.062438 -0.405684 -0.007858 1.415666 0.290877 1.615872 1.200022 1.723864 1.253269 0.379007 0.343005 0.128516 0.302246 -0.164454 0.039402 1.245595 0.229693 0.371762 0.212878 1.130208 0.211997 1.630376 0.731113 -0.271994 0.633039 1.003806 0.078215 0.728092 1.810709 1.419272 0.630789 0.702176 0.258274 1.627944 0.906125 1.142708 1.149739 0.327453 0.775766 1.891018 0.949407 1.868463 0.197100 0.436054 0.455859 1.396494 1.235603 1.184602 0.213251 0.192580 1.964426 0.843243 1.673738 -0.209417 -0.268734 0.946608 0.413048 1.382483 0.177431 0.571412 0.488003 0.422161 0.038021 -0.036166 0.871695 -0.124327 0.115262 1.774007 1.705740 -0.048183 0.114070 0.284773 0.198720 1.083200 1.095261 1.210900 1.153612 1.411655 -0.216841 0.226895 0.871232 1.590562 1.732972 1.482631 1.243964 0.261758 -0.017247 1.413734 0.786022 0.083529 1.333636 0.641441 1.707810 0.335402 0.567273 1.111144 1.682879 0.513761 1.029576 1.342257 1.314503 1.650528 0.559848 0.478412 -0.031753 0.050313 0.117019 1.542665 0.315940 1.287375 1.423028 0.248383 1.516714)
)
;;; 256 even --------------------------------------------------------------------------------
-#(256 24.434719362486 #(0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1)
+(vector 256 24.434719362486 (fv 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 0 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1)
- 21.147051 #(0.000000 0.013043 0.920117 0.211418 0.668306 1.385627 1.906635 0.858012 -0.025540 1.212427 1.778724 0.580100 0.439691 1.356157 -0.119063 0.434266 0.154352 0.442955 -0.005968 1.535794 1.403556 0.183703 0.719695 0.808134 0.717026 -0.004795 0.750023 0.510510 -0.111539 0.030727 1.471914 0.702448 0.847566 0.053362 -0.108798 1.030415 0.581323 1.534487 0.340353 1.468027 1.258297 0.652253 -0.177908 1.046447 0.259688 1.647334 1.350135 0.131395 0.878222 0.018247 1.361793 1.595723 -0.194803 1.278955 0.422974 0.308531 1.680151 0.819388 0.650454 1.170154 0.982131 0.916385 0.251795 0.614215 0.058138 0.237243 0.480617 0.078361 0.274005 1.104676 -0.049561 0.890974 0.285114 1.560285 -0.042858 1.287080 0.986201 0.225144 1.911656 0.412797 1.906001 1.113150 0.002975 0.378566 0.185842 0.978524 0.886147 1.174987 1.402841 1.532148 0.452840 1.653473 1.368866 1.142209 0.399142 -0.053477 1.387350 1.063119 1.101594 0.660387 0.318690 -0.075495 1.596588 1.423152 0.699488 1.066220 0.932593 0.726316 0.721243 0.616117 1.231920 1.204386 0.280095 0.737486 0.246794 1.225672 1.938762 1.669744 1.911752 0.028184 0.352670 1.169110 1.138933 0.911609 1.153860 1.295188 1.451568 1.222645 1.836765 0.315515 1.661130 0.665886 1.423539 -0.027924 1.624245 0.211892 0.318464 1.015468 1.652245 0.240743 1.150550 1.257988 1.368042 0.690738 1.931274 -0.034743 0.771903 1.856503 0.683190 0.957751 0.409827 0.925581 0.140171 0.602555 0.465835 0.338671 1.281554 0.705219 1.397775 1.170389 0.382381 0.242999 0.668790 0.700098 1.973505 0.627343 0.670404 0.886476 0.982946 0.759522 0.694097 0.252884 0.859515 1.570045 1.546775 0.284098 0.314092 0.168123 1.469812 1.098694 0.268268 1.420670 1.272723 0.382719 0.671480 1.435402 -0.110241 0.561019 1.353828 1.506014 0.931446 1.044498 1.647818 0.262634 1.666668 0.124893 0.309225 1.239534 0.520530 1.500534 0.061664 1.274884 -0.244216 1.650214 0.424051 0.892559 0.202169 0.442374 0.683088 1.684786 1.219867 0.391490 1.016231 1.491883 1.765165 1.764702 1.283017 0.934137 0.230333 1.283241 -0.045685 1.411918 1.307833 1.725023 0.245397 0.538120 1.457284 0.616433 0.168907 0.521502 0.384247 0.974783 0.364292 0.076939 -0.235106 1.283357 1.428764 1.664927 0.374574 1.099794 0.852722 1.803641 0.274149 1.335009 1.914350 -0.207888 0.073165 1.428393 1.365955 1.849232 0.634655 0.268387 -0.166276 0.397839 0.357434 0.489122)
+ ;; ce:
+ 16.895858 (fv 0.000000 -0.009189 0.902358 0.365887 -0.111323 -0.780998 -0.023618 -0.522343 0.279380 0.055265 -0.008058 0.474170 0.130008 0.951121 -0.734333 0.844285 0.824339 -0.107239 0.507621 0.164958 -0.496056 -0.789687 0.259333 -0.449818 0.843661 -0.030179 -0.474099 0.774618 -0.182868 0.024412 0.577418 -0.074812 -0.020675 0.192634 -0.599606 -0.070169 -0.948055 -0.992660 0.778395 -0.043578 -0.432579 -0.186685 -0.510874 -0.014069 -0.480270 0.346549 0.508024 0.846868 -0.259984 -0.239547 -0.834355 0.758428 0.757435 0.373609 -0.602450 0.574091 0.372351 0.871018 -1.004894 0.279914 0.796533 0.315579 -0.170724 -0.162430 -0.867211 -0.645076 0.714848 -0.271719 0.114112 0.067143 0.832100 -0.116990 -0.262191 -0.281235 -0.535795 0.830911 -0.182047 0.489779 0.867411 0.246384 -0.008329 -0.604672 0.770953 -0.982833 0.931441 -0.618590 -0.552932 0.209497 -0.183212 0.365740 0.769646 0.703588 -0.289040 -0.817528 -0.369365 0.293481 0.472048 0.790519 -0.426911 0.891352 -0.538143 -0.944128 -0.920976 0.221321 -0.509927 -0.348596 -0.644560 -0.213342 -0.745624 -0.706666 0.930922 -0.848273 -0.242448 -0.036301 0.898791 -0.590640 0.780449 -0.061417 0.458673 -0.691004 -0.831524 0.551686 0.225320 0.474068 0.953196 -0.781398 0.825342 0.760168 0.391595 0.124100 0.860713 -0.055973 0.585971 -0.869796 1.059960 -0.289476 -0.119142 0.020537 -0.912617 0.156202 0.608148 0.008605 -0.492103 -0.103742 0.428971 0.411193 -0.565692 0.935156 -0.112585 0.617223 -0.155032 0.327195 0.230999 -0.493871 -0.157653 0.741876 0.652071 0.725265 -0.509926 -0.435321 0.803678 0.422316 0.647203 -0.330251 -0.717114 -0.003821 -0.171433 0.905326 -0.870296 -0.075782 -0.123811 -0.827857 0.305695 -0.297883 0.361037 0.368875 0.307670 -0.861180 0.111296 0.743619 -0.505788 0.890369 -0.751559 0.768455 0.001867 -0.755119 0.593706 0.249715 0.003021 0.017365 -0.006817 0.077961 0.209405 -0.908703 -0.016914 0.016411 -0.745949 -0.862316 0.805206 -0.373876 -0.644818 0.552974 -0.723400 0.564147 0.221354 0.241461 -0.891285 0.457125 0.981689 -0.591672 -0.034527 -0.765054 -0.120687 0.438528 0.848881 -0.507062 0.069395 0.639313 -0.825275 0.641684 -0.188946 0.565634 -0.791635 -0.287596 -0.132874 -0.202513 0.559214 0.080018 0.796540 0.338441 0.210736 0.641999 0.009248 0.322360 -0.028925 0.697480 0.479428 0.122723 0.885702 -0.174527 0.157389 0.019802 0.207762 -0.007817 -0.188184 0.284891 0.769384 -0.699713 -0.860470 0.816560 0.661637 0.821235 0.090760 0.680062 0.906877 -0.017234)
)
;;; 512 even --------------------------------------------------------------------------------
-#(512 35.776 #(0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1)
+(vector 512 35.776 (fv 0 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 0 1 1 1 1 1 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 0 1 1 0 1 0 1 1 0 1 1 1 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 1 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 0 1 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 1 0 0 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 1)
- 31.628149 #(0.000000 0.193458 0.879636 1.705304 0.490370 0.075082 0.075683 1.300845 1.564891 0.673316 0.757185 0.241756 0.594649 0.885118 0.323693 1.454812 0.908273 1.351061 1.781313 0.564771 0.183286 0.637926 0.622421 1.045142 0.517278 0.296784 1.410403 0.602065 0.772561 1.389650 0.527960 1.708369 0.033642 1.830155 1.178018 1.593299 0.764263 1.671821 0.206173 1.235732 1.402783 1.788135 0.201137 0.539609 -0.025782 0.918770 0.935892 0.891239 1.913603 1.292613 -0.101151 0.722659 0.055747 -0.088554 0.598806 0.380559 1.211892 1.546048 0.916625 1.399887 1.565523 0.904754 1.010130 1.643551 1.461234 0.875915 0.213846 0.357475 1.186241 1.381267 0.754949 1.779095 1.006740 1.311595 1.737320 1.086140 0.608280 1.768795 1.226748 0.139423 0.844731 1.174543 0.052337 0.835236 0.709458 1.432591 0.165398 0.442884 0.896570 1.597184 1.133267 1.895467 1.175626 0.109893 1.094502 1.928908 -0.087649 1.565508 0.274473 0.027155 1.554166 1.239019 1.373234 1.458458 1.546571 0.031108 1.855623 1.647770 1.494922 1.630144 0.041700 1.725269 0.114205 1.279109 0.713125 1.361675 1.293302 0.370706 1.155957 0.160127 1.306020 1.564145 0.329533 1.577490 0.426179 0.865540 0.506954 0.836528 1.895468 1.155187 1.524271 1.949386 0.062295 1.616901 0.556622 0.305661 1.919946 1.844259 0.313013 0.024129 1.635243 1.597075 1.722121 0.294542 1.002701 1.459972 1.504069 0.899408 0.331782 0.396363 1.663102 1.290621 1.116303 1.021895 0.255551 1.181969 0.645937 1.543659 1.606428 0.192360 0.894664 -0.002504 0.398536 1.481294 0.918465 0.074277 0.749762 0.689678 0.975924 0.653357 1.294427 1.063153 0.441398 0.872255 0.882166 0.959648 1.175046 1.530354 0.796278 0.915558 0.628151 0.260515 1.245714 1.010362 -0.030800 0.853342 0.047830 1.010196 1.020267 0.045034 1.849312 1.096281 0.221294 1.343819 1.249551 0.337281 0.664846 1.064716 1.335370 1.464875 0.181615 -0.072256 0.046603 1.522391 0.275503 0.681141 1.127342 0.430827 1.110432 1.803612 0.451171 0.807526 0.146612 0.741306 0.879652 0.538416 0.789395 0.835580 0.727230 1.500085 1.242144 0.634364 1.803171 1.822514 0.007316 0.582259 1.098006 1.111451 1.052686 0.268482 1.292779 0.408770 0.900978 1.129338 1.119845 0.000211 0.183560 0.409985 1.130318 0.154686 0.903140 1.250848 0.304084 0.291391 0.665312 0.134932 1.031483 1.180817 0.740031 0.591860 0.493782 0.623373 1.760510 1.738938 0.012331 1.868767 0.485398 0.081272 0.744972 1.162890 1.398893 0.348679 1.033764 1.570188 1.891519 0.983723 -0.050025 1.963561 0.683179 1.444931 1.720623 1.922344 1.346126 0.185147 0.425063 0.833788 1.212862 -0.059036 0.979852 1.030316 0.907000 1.585882 1.726983 1.272771 0.520458 -0.246594 0.841441 0.243286 0.398740 1.568681 0.966791 0.492237 1.295293 0.553432 1.719542 1.511716 0.828907 1.018781 1.032010 1.199895 1.666214 1.226917 1.062734 1.392689 0.232672 1.537926 0.453832 1.574299 1.015965 1.273439 -0.120286 1.196312 0.890951 0.947130 0.079812 0.887578 0.233129 0.272637 1.660534 0.099048 0.112940 0.379953 0.313779 0.871859 0.259424 0.974751 0.544740 0.642333 0.302637 -1.970061 0.729276 1.344147 1.146828 0.710229 0.621069 1.365003 1.840156 1.310442 1.151197 1.477337 0.559900 0.108648 0.736983 0.902099 0.115156 1.417090 0.059287 0.355397 1.408677 1.265478 0.852907 -0.030095 0.935670 1.092577 1.649094 -0.066605 0.057334 0.214826 0.920179 1.511506 0.311621 1.288626 0.990573 1.623492 -0.026333 0.306924 1.579035 1.170370 1.732023 1.379262 1.454543 0.891698 0.314877 1.693038 1.768550 0.910599 1.712155 0.945812 0.118254 1.453481 1.939489 0.720326 0.426107 1.203759 1.574972 0.592306 0.975781 0.305093 -0.166629 0.079805 0.409358 0.854323 0.437473 1.528093 0.769890 0.423876 1.508832 1.226392 -1.878260 -0.092214 1.155334 0.010793 1.006280 1.091219 0.386780 0.322578 0.667815 0.434221 1.551779 1.471623 0.419732 1.605348 0.905476 0.713039 0.202928 1.354968 1.929707 0.296628 1.021984 1.535443 0.083646 0.013591 1.615944 -0.015945 1.228774 1.545535 0.273210 1.194157 1.343078 1.185077 1.122175 0.433956 0.758581 0.690958 0.339400 1.730253 0.001977 1.448248 0.615799 0.047214 0.859970 0.772423 1.342656 0.293016 -1.937301 1.859989 1.689477 1.784597 1.602245 0.845767 1.643665 -0.004067 0.091824 1.211465 0.680110 0.230715 0.070609 1.607121 1.378560 0.381059 0.163719 0.922614 0.053089 0.596216 0.562829 1.081319 -0.048350 0.527026 1.238211 0.277364 1.357698 1.757117 1.384714 1.522857 1.368884 0.056972 0.225257 0.823227 0.584976 -1.935447 0.491177 0.763213 1.717924 0.488438 1.535602 0.456160 0.375383 0.517346 1.517261 0.749545 1.085532 0.050128 1.339560 1.741740 1.301265 1.630336 1.618351 1.672383 1.593969 0.959235 0.695771 0.230646 1.678169 0.693007 1.099661 1.490070 0.420988 1.438392 0.212033 1.272969 1.845317 1.413990)
+ ;; from (try-all :even 512 513 0.0057725498034576 0.26769012113045) = 29.0733
+ ;; ce:
+ 24.510365 (fv 0.000000 -0.019547 0.424156 1.640830 1.364680 1.818776 1.105842 0.737080 1.188869 0.460419 0.154877 0.614397 1.827954 1.526781 0.018169 1.203682 0.956144 1.444331 0.584264 0.344508 0.856804 -0.002275 1.790988 0.291010 1.439116 1.211881 1.741084 0.845603 0.707294 1.180635 0.339890 0.164786 0.645301 1.820612 1.656940 0.157290 1.307936 1.130965 1.686613 0.833679 0.620052 1.209627 0.322209 0.138398 0.734419 1.838268 1.653494 0.235420 1.341020 1.194471 1.729004 0.905361 0.771623 1.262727 0.487832 0.366383 0.843119 0.069579 1.963835 0.460118 1.649699 1.520680 0.055018 1.185740 1.101098 1.643899 0.752530 0.667948 1.169078 0.382792 0.269771 0.820501 0.061364 1.929744 0.493658 1.740499 1.549752 0.138458 1.334798 1.217842 1.724754 0.932476 0.823652 1.326258 0.605394 0.510375 1.024728 0.340933 0.185795 0.774497 0.036705 1.862931 0.456043 1.668642 1.590302 0.139925 1.318436 1.326961 1.864132 1.011509 1.051965 1.624689 0.808072 0.775618 1.339118 0.606082 0.484361 1.076072 0.379297 0.250899 0.852275 0.110682 0.007792 0.595200 1.830378 1.789905 0.359788 1.659536 1.611286 0.154864 1.497402 1.399711 1.998779 1.270070 1.199870 1.801564 1.085483 1.010139 1.613933 0.921049 0.862702 1.434888 0.750644 0.728545 1.284532 0.570978 0.570652 1.118882 0.422457 0.414420 0.977086 0.320768 0.330042 0.881914 0.218609 0.199085 0.805391 0.088964 0.043485 0.695205 -0.000491 1.966513 0.612316 1.930538 1.950727 0.563038 1.854742 1.879285 0.451929 1.795108 1.794421 0.370361 1.783471 1.745602 0.399279 1.738776 1.661161 0.350902 1.625174 1.614568 0.302843 1.577093 1.678861 0.313770 1.663823 1.660571 0.328157 1.709209 1.610846 0.310206 1.720381 1.669108 0.335355 1.656296 1.693491 0.346281 1.654195 1.699773 0.373651 1.773772 1.752470 0.473140 1.826907 1.822715 0.581620 1.832675 1.919552 0.622630 1.929526 0.005176 0.677897 0.085092 0.090877 0.761048 0.206124 0.205634 0.890197 0.304835 0.339949 1.002646 0.395940 0.448746 1.152273 0.561345 0.581101 1.310704 0.737714 0.744961 1.486545 0.848210 0.931544 1.627529 1.007712 1.110684 1.778206 1.199087 1.278685 -0.040639 1.383705 1.405450 0.148513 1.511196 1.633778 0.391073 1.740722 1.849679 0.658438 0.031218 0.137149 0.870371 0.331222 0.296051 1.070588 0.528400 0.591834 1.345092 0.751955 0.829846 1.642139 1.030239 1.201544 1.943718 1.298486 1.407002 0.143893 1.607481 1.695116 0.415675 1.905744 -0.027620 0.742513 0.206291 0.320377 1.123679 0.506496 0.647078 1.425059 0.880594 0.962991 1.736110 1.225483 1.369479 0.064842 1.600531 1.706861 0.517054 1.973656 0.069623 0.837048 0.295925 0.404900 1.263222 0.684812 0.775618 1.577141 1.057937 1.264522 0.064638 1.531997 1.682245 0.471443 1.922985 0.104388 0.897292 0.423113 0.526550 1.412335 0.758158 0.917306 1.736464 1.285171 1.451805 0.278569 1.745150 1.879876 0.677038 0.183709 0.366812 1.118883 0.736257 0.864386 1.688806 1.159516 1.253423 0.100375 1.645658 1.871576 0.762011 0.249411 0.395560 1.273133 0.699592 0.948774 1.805372 1.338330 1.530595 0.294092 1.900787 0.034538 0.923012 0.390364 0.586314 1.386265 1.030145 1.202559 0.071001 1.609371 1.743831 0.671235 0.194183 0.391537 1.251984 0.751826 1.009573 1.860932 1.448367 1.525073 0.422286 -0.073409 0.262981 1.099563 0.626545 0.818453 1.723102 1.361444 1.531582 0.390953 1.909101 0.215438 1.139977 0.737652 0.881882 1.821234 1.380301 1.618894 0.473317 0.045322 0.250969 1.146414 0.800355 0.959156 1.857842 1.429019 1.673847 0.622261 0.184525 0.502145 1.323715 0.914639 1.172552 0.096636 1.761155 1.977345 0.871966 0.396190 0.668483 1.677724 1.221155 1.466337 0.368967 0.009966 0.302335 1.180746 0.786475 1.025502 -0.022711 1.584463 1.830638 0.746555 0.413840 0.650268 1.656745 1.224810 1.557055 0.513491 0.173029 0.435007 1.290629 0.926051 1.263115 0.272344 1.896521 0.084566 1.048863 0.725520 0.987362 -0.027617 1.571108 1.900984 0.869809 0.386916 0.758635 1.730437 1.409025 1.672233 0.588812 0.243929 0.511763 1.494695 1.169935 1.437757 0.431437 0.111507 0.458811 1.437247 1.136523 1.434884 0.401589 0.040030 0.372128 1.370962 0.999488 1.378913 0.377301 -0.009324 0.355264 1.331258 1.008855 1.339035 0.373593 0.044480 0.312196 1.329497 1.000220 1.342701 0.417261 0.083063 0.411303 1.346062 1.090657 1.409862 0.373501 0.211768 0.447452 1.458597 1.131955 1.458774 0.553807 0.205989 0.569249 1.645656 1.188483 1.668112 0.674809 0.371651 0.732131 1.751447 1.522458 1.904784 0.884407 0.617430 0.990830 0.073047 1.730004 0.133217 1.189522 0.869836 1.203019 0.328634 0.051596 0.424552 1.471161 1.210755 1.549745 0.605989 0.343260 0.768857 1.816839 1.581320 1.934635 1.014299 0.737558 1.116115 0.236955 0.018173 0.380416 1.539634 1.251595 1.652099 0.829587 0.536746 0.936033)
)
;;; 1024 even --------------------------------------------------------------------------------
-#(1024 51.895 #(0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0)
+(vector 1024 51.895 (fv 0 1 0 0 0 1 1 0 0 0 0 1 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 0 0 0 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 1 0 1 0 1 1 1 0 1 0 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 1 0 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 1 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 1 0 1 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0 1 0 0 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 0 0 0 0 1 0 1 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 1 0 1 1 1 0 0 0 1 1 1 0 1 0 1 0 0 1 0 1 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1 0 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 0 0 0 1 0 0 1 1 0 0 1 1 0 1 0 0 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 0 0 1 0 1 1 1 1 1 0 0 0 0 1 0 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 0 1 1 1 1 0 1 0 1 0 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0 0 1 0 0 1 0 1 1 0 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 1 1 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1 1 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 1 0 0 1 0 0 0 1 1 1 0 0 1 1 1 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 0 1 1 1 0 0 1 1 1 1 0 0)
- 51.627202 #(0.000000 1.029633 -0.012293 0.012880 0.026980 0.979853 0.999814 -0.000026 0.008393 -0.008618 -0.022589 0.994746 0.002832 1.008481 0.003050 0.997875 0.996213 1.012876 0.966656 0.015767 1.000358 -0.002088 0.014429 0.990790 0.013957 1.001392 -0.004078 0.967774 1.013049 1.007123 0.985283 0.013699 0.971495 0.995694 1.026385 0.974549 0.984726 0.014450 1.020521 1.057512 -0.000030 1.035989 1.011331 -0.003193 -0.024617 1.040479 0.999058 0.999748 1.023188 0.015959 0.999918 -0.018936 0.999973 -0.023246 -0.020062 1.051671 0.022658 0.002794 0.974167 0.991086 1.010851 -0.001529 1.001922 1.036863 0.021006 0.005011 1.000699 0.000936 1.014853 0.987112 0.961076 -0.027263 -0.000447 0.965279 -0.006262 -0.009089 0.013976 0.015081 0.978343 0.998354 -0.031203 0.998879 0.993033 0.003160 1.007951 -0.029531 0.037120 0.015294 -0.004457 0.999168 0.006669 0.003518 -0.020636 0.989249 1.037455 0.983981 1.009819 0.041730 1.025735 0.004988 1.017361 0.003502 1.042945 0.015924 1.024463 0.960856 0.011509 0.010562 0.988670 0.024436 0.966800 -0.002597 -0.016676 0.022567 -0.028052 0.946179 -0.017664 1.028163 1.003919 0.001928 1.027279 -0.018987 0.026212 1.037909 0.988421 0.989442 0.020639 0.966655 1.036646 0.002339 0.008427 -0.005614 0.995024 0.983470 0.983405 0.042460 0.974342 0.994593 0.956085 0.009439 0.014059 0.004228 -0.019889 0.026260 0.974355 0.992867 -0.012583 0.984210 0.977740 1.012509 0.987531 0.000750 1.019558 0.026047 1.016442 1.035160 0.993711 -0.030273 1.002476 -0.005058 1.000699 -0.013934 0.956348 1.046660 -0.027964 0.032912 0.003031 0.977465 0.004538 0.989628 0.963685 1.010626 -0.012712 1.018052 -0.017753 1.015077 0.998898 -0.009983 0.997626 0.017615 -0.000785 0.002492 -0.012174 0.002126 -0.016138 1.012447 0.997926 0.966007 -0.013935 1.029393 -0.013026 -0.007371 1.016575 1.007787 1.056292 0.973143 -0.033484 0.035206 0.014191 -0.029943 -0.028705 0.008654 1.000375 -0.021321 0.995735 0.005904 -0.005691 0.957727 0.987992 -0.036335 0.960456 -0.001191 1.023020 0.989914 0.968869 0.041460 0.977261 -0.011659 1.009737 -0.021828 1.008003 -0.001250 0.022942 -0.048050 -0.009089 1.009767 1.043325 1.003191 0.971106 -0.021518 1.028051 -0.011409 1.025024 0.979361 1.044646 1.011438 1.010722 0.031823 -0.028157 0.983741 -0.020268 1.009392 -0.007202 0.998145 -0.026679 1.026788 -0.081497 1.010086 0.018136 -0.018995 -0.001939 0.022706 -0.023740 -0.007240 -0.012899 -0.018640 1.038529 1.020417 0.968369 0.994357 1.027397 0.000794 -0.000991 0.991696 0.031240 0.998445 1.044540 0.970462 0.026110 1.010814 1.020783 0.015899 1.018002 -0.031991 0.007949 0.001502 -0.012758 1.001363 0.004017 -0.007267 0.010560 0.013211 -0.009000 0.009694 1.014273 0.018818 -0.034834 1.028054 -0.003934 1.000986 1.002141 0.992753 -0.028723 1.028360 0.987299 -0.013088 0.996655 1.026438 1.006617 -0.029586 0.003482 0.997825 0.977397 -0.001844 0.989263 0.017137 -0.018305 -0.000071 0.035462 -0.000083 0.020862 0.961786 1.014986 -0.009066 0.004347 0.961092 0.991390 1.004558 0.027069 0.984372 -0.023434 0.988090 0.035406 -0.013962 1.041369 0.024094 0.005763 -0.024629 0.999857 0.043759 0.025275 0.984999 0.997705 0.974194 0.991177 1.004969 0.984649 0.030149 0.982526 0.026091 0.008305 0.993917 0.948422 -0.015968 0.018284 1.030583 0.048958 1.046400 0.020097 -0.041524 0.961135 0.980055 1.003964 1.036523 -0.038536 0.993082 -0.008009 0.037197 0.005452 0.985760 1.009046 0.989319 -0.023085 0.000904 0.027545 -0.000386 1.003513 -0.003653 0.001093 1.022776 0.997472 1.001837 0.009261 0.012077 0.942776 -0.005592 0.975448 0.004766 0.991773 0.016776 0.978178 -0.007370 0.982051 0.960966 1.011421 -0.023355 0.980278 0.973420 0.045377 -0.005290 0.956521 0.992809 0.027688 0.025117 -0.022656 -0.030804 -0.015162 1.036309 -0.026387 0.983041 -0.021172 0.035189 -0.027150 1.004452 0.027891 0.011484 0.034644 0.978769 0.023693 0.998483 0.986597 0.987475 0.010519 0.029762 1.001533 0.993668 -0.016914 1.024557 1.048005 0.011502 1.011339 0.994209 1.017864 0.992986 0.014354 -0.013499 0.992949 -0.060393 -0.016525 1.005615 0.984517 0.995298 0.015187 1.030776 -0.033503 0.000253 0.037666 1.025964 1.007485 0.988947 0.022461 0.006082 -0.020616 1.004962 0.012512 0.962994 -0.004937 1.011421 1.041467 1.008283 0.995643 0.971042 0.987471 0.001468 -0.007697 0.991715 1.049958 1.012746 1.035164 -0.032069 1.013038 0.006264 1.006054 0.035898 0.032052 0.963860 1.014151 0.949502 0.999608 0.009928 0.001465 1.029049 1.025787 1.026326 -0.043190 -0.007875 0.009982 0.011519 0.983107 0.005975 1.006135 -0.001058 -0.024465 1.034626 0.978896 1.011989 1.027524 1.041145 -0.025044 0.018773 0.023996 -0.011560 1.024837 -0.013806 1.002818 0.015362 1.050348 0.022866 0.962501 0.984475 0.010984 -0.010308 0.952987 0.024839 -0.026681 1.012307 1.001104 0.036619 -0.025891 0.014527 0.990542 0.011253 0.024178 1.008209 0.016545 -0.034511 0.036489 -0.014980 1.008478 0.989790 0.976929 1.025218 0.995142 0.987581 0.028634 0.033934 0.019969 -0.021838 1.028720 -0.028955 1.015472 -0.006441 -0.020510 -0.018391 0.978147 0.015688 -0.021362 0.952391 0.029016 0.001211 -0.008983 1.017301 0.981964 -0.001380 0.985470 0.022753 -0.004467 1.038918 -0.047590 1.013576 0.992650 1.023843 0.035368 0.026779 0.037419 1.014741 0.995189 0.997746 -0.034357 0.995854 0.003107 0.951826 -0.014409 0.013970 1.057036 -0.046316 0.969485 1.013522 -0.031630 0.992596 0.019914 -0.030536 0.998738 1.009072 0.042841 0.007827 -0.040331 0.996280 0.005153 0.977472 1.017287 -0.007443 1.023492 1.008942 0.976506 0.991476 0.021767 0.994859 -0.020314 0.017953 0.030219 -0.014664 1.027291 0.995978 0.994587 0.009074 0.983176 0.979563 0.026420 -0.010245 0.972168 1.035690 0.001320 0.993513 -0.006353 0.993098 1.018795 1.026884 1.026658 0.970022 0.999193 1.016983 0.979543 -0.022890 0.020692 -0.040886 1.018579 -0.011065 0.055122 0.983881 0.025346 -0.040047 1.013370 0.955646 1.036308 0.991315 0.033330 -0.025327 0.016975 0.995791 0.981244 0.961974 1.008112 1.057891 -0.001461 0.987480 0.009720 -0.026757 0.013022 0.980104 0.999666 -0.012002 -0.002490 1.031008 -0.036579 -0.019712 -0.012903 0.988206 0.016822 0.004518 1.021480 1.018658 0.022505 -0.040063 0.965796 0.967095 -0.030506 0.986755 0.009185 -0.029252 0.027913 -0.001038 0.005149 1.030725 -0.022649 -0.050486 0.985861 1.023283 -0.035330 -0.003861 -0.024807 -0.017869 1.007192 0.991993 -0.037209 -0.015099 1.024263 0.988398 1.000630 -0.011148 1.011225 1.003859 1.000624 0.027737 1.030697 -0.007960 0.015120 0.030404 1.063288 -0.015487 0.009610 0.997903 -0.014983 0.009095 0.001637 0.028463 -0.017241 0.980929 1.031302 0.957184 1.006390 -0.000930 0.026429 -0.035760 -0.008466 0.002222 1.003563 0.029085 0.031352 0.955169 0.956096 1.049753 1.023909 0.993320 1.004337 0.981836 0.009217 0.959911 0.028388 0.983865 -0.035427 -0.010471 -0.031064 -0.002590 0.956357 0.036784 -0.009809 0.991834 -0.034104 -0.018459 0.012906 0.991005 0.022404 1.021742 0.004101 -0.003005 0.999319 0.002777 0.970118 0.020836 -0.025284 1.027935 -0.012000 -0.004879 -0.034122 0.007932 1.021494 0.992149 1.020224 0.016422 1.035923 1.005921 0.970291 1.017378 1.005947 -0.036189 -0.030483 0.001790 0.032815 1.014774 0.983789 0.988084 0.023220 -0.019774 0.971264 -0.028081 -0.029889 0.992294 1.005999 0.977060 1.014232 -0.021160 -0.010988 0.959821 0.005604 0.021718 -0.021955 1.054722 -0.016545 0.964984 0.985050 0.984349 1.031167 0.974286 0.002534 0.035348 -0.012068 -0.013231 1.015785 0.023828 1.015996 -0.031622 1.005232 -0.009273 -0.019787 1.025036 -0.026464 0.006101 0.967905 1.014269 0.979093 -0.029265 -0.021119 1.021888 0.954078 0.000085 0.002622 0.994485 1.000089 0.999748 0.998280 0.023211 0.988740 -0.018255 0.960366 0.045586 -0.019498 0.008522 1.020829 1.008354 0.006514 1.022643 0.015185 0.000755 0.018782 1.014301 0.027370 -0.012785 1.014767 0.991316 1.003698 1.039078 0.005598 0.005237 1.002700 1.029163 0.004849 -0.028907 -0.023045 1.017953 0.020296 0.006471 1.017652 -0.022322 1.034186 1.027202 -0.016734 1.002485 0.047223 0.040688 0.006990 0.990955 0.022236 1.031053 -0.003084 1.020609 0.017659 0.020197 0.011235 0.962757 0.001996 1.044123 0.976238 -0.019950 1.030412 0.011057 1.017582 0.014033 0.025446 1.004206 -0.003240 0.027075 -0.007050 -0.035685 0.992859 1.011519 0.014202 0.981388 1.005139 1.004029 1.006912 1.005778 1.021140 0.983053 -0.016137 -0.014145 1.000304 0.997530 1.003746 1.049578 0.959733 0.000454 -0.009718 -0.026521 0.029837 0.007222 1.010987 0.005317 -0.030318 1.007035 -0.032687 -0.011029 0.989009 1.041889 0.982391 -0.018390 0.038156 1.006608 0.000964 0.020590 0.018089 1.004892 1.001298 0.040112 1.005506 1.015600 -0.009035 0.940825 0.000076 0.006269 0.006741 -0.012462 -0.037129 0.010208 -0.024410 -0.019642 -0.014977 -0.024707 0.990616 0.038768 0.010238 1.040880 -0.006119 -0.047665 0.986770 -0.011567 1.004318 -0.029971 1.013665 -0.022161 1.002074 0.010501 0.960155 0.984224 1.026497 -0.016095 1.010019 0.031642 0.999133 0.979670 0.000233 -0.007173 1.008576 0.977465 0.974203 0.962648 1.001036 0.999199 1.006937 1.008107 1.030886 0.032255 0.013490 1.006674 1.009720 -0.000453 0.030604 1.006832 1.002142 1.011386 -0.032413 -0.010262 1.028395 1.007678 0.997719 1.024479 0.960010 -0.004909 0.994707 -0.013372 0.977065 0.994209 0.973989 0.007180 -0.027035 0.985703 -0.005303 -0.038704 0.037271 1.004149 0.966830 1.029492 -0.024194 -0.015545 1.038917 1.042772 1.001889 0.998939 0.955875 -0.005453 0.980182 -0.007532 0.998567 0.983303 0.017570 -0.020865 -0.013117 1.027734 0.984047 0.038060 -0.007684 1.009226 -0.024667 1.000606 1.016532 0.981910 -0.010374 0.007713 1.032539 0.989510 1.024116 1.001067 0.024989 -0.020873)
+ ;; ce:
+ 34.486667 (fv 0.000000 0.010065 0.257552 0.593803 0.986349 1.354691 1.689002 0.065945 0.448419 0.795563 1.178916 1.585370 1.936149 0.310262 0.750710 1.056729 1.463725 1.825064 0.240816 0.539819 0.934214 1.340840 1.748800 0.092213 0.555713 0.915825 1.311840 1.650847 0.107697 0.477455 0.875194 1.288435 1.748432 0.197793 0.591516 1.015839 1.387092 1.854496 0.260210 0.614591 1.088807 1.497165 1.960609 0.347241 0.837150 1.265241 1.711792 0.103196 0.588662 1.043276 1.427385 1.898809 0.315073 0.790510 1.283232 1.726769 0.124226 0.582532 1.048754 1.444755 1.928781 0.425680 0.899080 1.335881 1.855991 0.327701 0.850115 1.267294 1.746464 0.254433 0.681023 1.221402 1.713475 0.176608 0.633457 1.170011 1.638469 0.136940 0.628672 1.079274 1.611588 0.107068 0.579047 1.125534 1.649825 0.159484 0.714499 1.195717 1.694762 0.283005 0.777095 1.317639 1.818676 0.294685 0.848021 1.366508 1.912960 0.442114 0.974399 1.491097 0.046085 0.607725 1.172318 1.701676 0.262890 0.804042 1.333049 1.847711 0.428372 0.986686 1.556422 0.120990 0.632701 1.249707 1.826221 0.398395 0.969062 1.507301 0.132868 0.725711 1.273823 1.851630 0.403540 1.046615 1.591703 0.182065 0.801530 1.386897 0.003430 0.562296 1.182148 1.798000 0.384640 0.992083 1.618128 0.211791 0.774713 1.389562 -0.001657 0.608366 1.236020 1.865011 0.529780 1.135532 1.738754 0.419570 1.019563 1.624992 0.265061 0.904049 1.533452 0.168181 0.865137 1.479101 0.127557 0.777817 1.390745 0.031342 0.661481 1.347873 -0.028252 0.673301 1.341813 0.012139 0.723533 1.359095 0.015081 0.667348 1.354810 -0.010820 0.651242 1.361901 0.014799 0.676361 1.414902 0.077676 0.777314 1.483046 0.156058 0.835487 1.534362 0.214249 0.944327 1.656367 0.337182 1.061518 1.736952 0.487837 1.221677 1.941805 0.641987 1.334519 0.012624 0.761615 1.493616 0.235055 0.987696 1.681644 0.449481 1.152512 1.880553 0.557489 1.300096 0.093548 0.829304 1.606739 0.333558 1.038662 1.817653 0.564596 1.346595 0.088231 0.789038 1.556219 0.364445 1.109277 1.894547 0.648472 1.394876 0.167696 0.927734 1.744135 0.473122 1.327580 0.053170 0.846408 1.630482 0.424396 1.252576 0.026366 0.794678 1.571738 0.353780 1.148629 -0.009061 0.802059 1.560730 0.388025 1.189760 -0.020908 0.838019 1.634252 0.450483 1.274303 0.061988 0.909080 1.739029 0.567344 1.395698 0.191004 1.056594 1.900321 0.701479 1.570664 0.420443 1.216101 0.035038 0.906051 1.794894 0.619739 1.485033 0.319328 1.177367 0.049998 0.912455 1.796694 0.663275 1.464877 0.322458 1.201076 0.079874 0.975135 1.812753 0.671629 1.550884 0.438265 1.308416 0.227568 1.107771 0.008272 0.852340 1.757258 0.665419 1.573359 0.450697 1.364674 0.288498 1.149330 0.046861 0.927672 1.818815 0.731499 1.703383 0.640630 1.515945 0.404842 1.338883 0.309581 1.223075 0.140786 1.078108 -0.017158 0.933921 1.856585 0.819946 1.718757 0.674573 1.629213 0.552624 1.480565 0.473092 1.440553 0.370780 1.316286 0.261652 1.233065 0.181284 1.136614 0.128844 1.063581 0.043473 0.988622 -0.007730 0.942926 1.896166 0.930670 1.890388 0.822783 1.839642 0.888701 1.829032 0.748117 1.787911 0.785711 1.793168 0.753464 1.768597 0.785917 1.789379 0.746424 1.769933 0.789526 1.789893 0.806228 1.806824 0.845014 1.858918 0.876599 1.887462 0.916183 -0.011424 0.947836 0.026544 1.052806 0.074297 1.092552 0.117837 1.145621 0.172062 1.271069 0.265950 1.343262 0.368273 1.426940 0.471985 1.600258 0.591440 1.643063 0.779963 1.778002 0.823172 1.887460 0.980164 0.056312 1.104881 0.194563 1.270671 0.317598 1.432357 0.527173 1.586831 0.679001 1.710986 0.856576 1.952932 1.034214 0.168860 1.247239 0.332452 1.455153 0.496571 1.598578 0.746454 1.841506 0.980194 0.065850 1.191729 0.313463 1.362280 0.540259 1.674133 0.807281 1.901298 1.046989 0.152754 1.296905 0.437367 1.599457 0.712142 1.832022 1.021052 0.159471 1.255226 0.399699 1.567354 0.776219 1.903366 1.055241 0.221691 1.359842 0.508090 1.682588 0.830923 0.010406 1.164777 0.321654 1.495630 0.648746 1.854778 1.028798 0.224012 1.437178 0.587301 1.746745 0.969426 0.124185 1.311647 0.558251 1.730677 0.926291 0.114111 1.341596 0.557527 1.745728 0.936491 0.127337 1.383134 0.617625 1.786691 1.023246 0.229459 1.472437 0.676585 1.907197 1.123237 0.355057 1.633938 0.880784 0.058692 1.279872 0.552335 1.779394 1.011586 0.276736 1.508029 0.759625 0.024536 1.276380 0.493761 1.728419 1.013811 0.266997 1.523472 0.795713 0.046243 1.307283 0.623236 1.877970 1.148383 0.427672 1.683629 1.001954 0.298274 1.554589 0.835462 0.173731 1.457407 0.693880 -0.034472 1.275602 0.593467 1.866633 1.210093 0.521728 1.772084 1.113712 0.385701 1.695457 1.069859 0.333163 1.607126 0.969652 0.282736 1.586932 0.934788 0.272131 1.571926 0.921386 0.293345 1.575513 0.936770 0.269737 1.574193 0.968165 0.284669 1.613899 0.986360 0.310459 1.654676 0.993511 0.432366 1.747611 1.058842 0.426357 1.800267 1.182611 0.576028 1.923944 1.270340 0.656610 0.044384 1.408707 0.752047 0.170780 1.558617 0.971026 0.315606 1.679451 1.091283 0.469917 1.819954 1.288114 0.668750 0.054741 1.461129 0.888977 0.275646 1.712213 1.100500 0.539170 1.932708 1.357198 0.750588 0.169930 1.599158 1.015737 0.433884 1.847466 1.290316 0.699471 0.106715 1.618980 1.039270 0.483584 1.877301 1.355281 0.739383 0.283415 1.680260 1.142458 0.582946 0.025158 1.503785 0.917235 0.402386 1.888910 1.374775 0.801742 0.267251 1.729725 1.190453 0.690588 0.170200 1.607615 1.116870 0.626944 0.099949 1.558114 1.042989 0.565792 0.001984 1.534796 0.981050 0.506989 0.024697 1.512493 1.045167 0.509838 0.035449 1.540981 1.040413 0.579777 0.067009 1.583544 1.092800 0.643044 0.165297 1.660919 1.190925 0.750261 0.244662 1.789497 1.303951 0.852702 0.402882 1.925637 1.511267 0.983904 0.525287 0.093612 1.625678 1.236625 0.751894 0.317275 1.862598 1.434730 1.003450 0.590395 0.130259 1.632064 1.251831 0.793529 0.395744 1.982905 1.518992 1.185899 0.724078 0.280841 1.851085 1.414649 1.036031 0.628024 0.190307 1.817967 1.407380 0.997638 0.626750 0.187117 1.827944 1.364014 1.005368 0.643575 0.271950 1.870132 1.455625 1.102716 0.663688 0.366474 1.947786 1.531948 1.165389 0.820292 0.417060 0.106203 1.736409 1.349795 1.017056 0.602019 0.247808 1.904232 1.522798 1.168173 0.822339 0.502122 0.190982 1.830461 1.503095 1.146005 0.824132 0.425448 0.163732 1.809535 1.439358 1.134762 0.787451 0.444950 0.125696 1.859821 1.507864 1.225427 0.898766 0.552383 0.249459 1.921771 1.641843 1.335828 1.036153 0.712405 0.407286 0.113814 1.810275 1.573082 1.216807 0.937380 0.622140 0.413886 0.065441 1.811766 1.479615 1.239853 0.962208 0.676221 0.428567 0.149787 1.861526 1.595913 1.378366 1.072254 0.858051 0.546952 0.352387 0.048977 1.781409 1.500802 1.320643 1.034780 0.814060 0.561026 0.270289 0.105077 1.781981 1.587128 1.356228 1.096895 0.899561 0.695426 0.422635 0.191053 0.015040 1.742763 1.540766 1.372440 1.135422 0.929280 0.712972 0.501615 0.300048 0.059338 1.847659 1.743466 1.446302 1.288333 1.097146 0.896394 0.693469 0.504749 0.273709 0.134422 -0.008122 1.752436 1.590209 1.416861 1.263443 1.015309 0.919786 0.724562 0.550733 0.413427 0.220154 0.085059 1.972253 1.758570 1.618664 1.418349 1.309492 1.092633 0.962125 0.822521 0.683138 0.548516 0.433745 0.271343 0.157018 -0.024488 1.878961 1.706051 1.633364 1.472286 1.423267 1.197350 1.130839 0.991815 0.864748 0.717411 0.656940 0.500335 0.378398 0.306249 0.174522 0.042370 1.957239 1.876551 1.787343 1.657177 1.630866 1.501218 1.454476 1.399481 1.281728 1.174679 1.094880 1.013897 0.872646 0.836534 0.733703 0.745572 0.645048 0.520901 0.517442 0.446338 0.403105 0.220915 0.272964 0.177893 0.121891 0.010365 -0.003026 -0.000541 1.946558 1.858421 1.798242 1.770282 1.765566 1.731024 1.646864 1.612063 1.606047 1.594080 1.512626 1.534901 1.459982 1.452555 1.426312 1.441887 1.450640 1.394928 1.401770 1.413824 1.398282 1.361199 1.386696 1.351788 1.315050 1.337782 1.369731 1.375462 1.382434 1.387327 1.390480 1.425063 1.472649 1.428947 1.444989 1.479959 1.454545 1.459856 1.514843 1.537769 1.564144 1.568551 1.669900 1.683717 1.723822 1.813102 1.823001 1.907890 1.890197 1.964939 -1.797036 0.049327 0.116611 0.169727 0.229816 0.312230 0.322585 0.436099 0.459978 0.494355 0.617621 0.657990 0.713966 0.784856 0.873687 0.939607 1.031179 1.056185 1.173421 1.311953 1.410978 1.454966 1.612093 1.676857 1.761378 1.862190 1.974384 0.042558 0.158632 0.245595 0.350975 0.483237 0.594289 0.729058 0.805700 0.959748 1.072984 1.213228 1.313277 1.445492 1.585944 1.673320 1.810642 1.960761 0.110169 0.205253 0.318753 0.449203 0.638254 0.764806 0.903920 1.064434 1.168013 1.366785 1.485581 1.644159 1.803584 -0.028237 0.153100 0.380114 0.509401 0.641451 0.849001 1.016399 1.215481 1.423241 1.573069 1.764733 1.942264 0.047242 0.295850 0.470228 0.640443 0.830347 1.055180 1.227983 1.357851 1.599606 1.739714 -0.029549 0.205220 0.379610 0.585030 0.816103 1.019847 1.251050 1.461935 1.647821 1.868576 0.147180 0.369132 0.579279 0.840715 1.094368 1.320093 1.565710 1.787983 -1.714361 0.195527 0.507750 0.710357 0.949912 1.153061 1.372724 1.700420 1.865502 0.178913 0.436041 0.694461 0.986729 1.187621 1.476665 1.752454 0.027539 0.321199 0.550142 0.802831 1.077337 1.362471 1.620159 1.900867 0.213014 0.446588 0.803703 1.113716 1.403572 1.697697 0.018021 0.315688 0.615559 0.932639 1.205074 1.541734 1.854009 0.125499 0.502519 0.744264 1.071360 1.395926 1.658298 -0.006671 0.333250 0.704886 1.026706 1.348527 1.693526)
)
;;; 2048 even --------------------------------------------------------------------------------
-#(2048 87.471149563312 #(0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 1 0 0 1 1)
+(vector 2048 87.471149563312 (fv 0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 1 1 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 0 0 1 1 0 1 1 0 0 1 0 1 1 0 0 0 0 0 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 1 1 1 0 1 1 1 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 0 0 0 1 1 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 1 1 0 1 1 1 1 0 0 0 1 1 1 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 1 0 0 0 1 1 1 0 1 1 1 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0 0 0 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 0 0 0 0 1 1 1 0 0 1 0 1 0 1 0 1 1 0 1 1 0 0 1 0 0 1 1 1 0 0 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 0 0 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 1 1 0 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 1 1 0 0 1 1 1 0 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 1 0 0 1 0 1 1 0 0 0 0 1 1 0 1 1 0 1 0 0 1 0 1 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 1 0 0 1 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 1 1 0 0 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 0 0 1 0 1 1 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 0 0 1 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 0 1 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 1 1 1 0 1 1 0 1 0 0 0 1 1 0 1 0 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 1 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 1 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 1 1 0 1 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 1 0 0 1 0 1 1 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 0 1 0 0 0 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 0 1 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 1 0 1 0 1 1 0 0 0 1 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 1 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 0 1 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 0 1 1 1 1 1 0 0 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 0 1 0 0 1 1)
- 78.079325 #(0.000000 1.036212 -0.043685 0.331976 0.639530 1.127516 1.095152 1.508236 0.077934 1.337557 0.072113 -0.092944 0.796909 1.784824 0.440076 0.246196 1.387524 0.190896 1.640182 0.925143 0.346541 1.367537 0.178172 0.900392 1.703536 1.678208 1.753849 0.425105 0.187619 1.751892 1.898170 0.616148 1.276449 1.748534 0.146310 1.804887 0.286781 -0.064076 1.520935 0.166848 1.246710 0.087250 0.943537 1.755401 0.334485 0.490353 1.501725 1.277784 1.245080 0.471353 0.764254 1.697034 1.056331 1.736214 0.463227 0.796303 1.150866 -0.021932 0.234603 0.080694 1.745115 0.716674 0.093762 0.744119 1.143077 1.540437 1.841607 1.711093 0.867517 1.296036 1.315314 1.006884 0.239668 1.666083 1.671147 1.716928 -0.027459 1.906723 0.073560 1.255469 1.796692 0.526703 0.076840 0.934228 0.293278 0.367456 0.305891 1.422085 1.299849 1.951249 1.462008 1.040367 1.853366 0.810937 0.603550 0.848743 0.268307 1.173776 1.919876 1.102197 1.660214 1.762553 1.781211 0.633437 0.456915 0.254253 0.486765 0.536153 1.493176 0.945749 1.791455 0.934973 0.284784 1.433744 0.425334 0.064742 0.690643 1.925513 1.755950 0.618329 1.632172 -0.059593 1.375330 0.869966 1.487228 1.414963 0.333672 0.780241 1.330677 0.484533 0.218933 0.162630 0.710074 0.419557 -0.032680 0.883965 1.717277 0.430915 0.263252 1.360127 0.169506 1.343179 1.234460 1.750884 0.164361 0.378299 1.460882 0.897871 0.213904 0.128719 0.360447 0.555828 1.579900 1.051631 1.398250 1.313610 0.220306 0.871110 1.178519 1.513441 1.303728 0.802201 0.242388 1.900778 1.477677 0.067540 0.652996 0.103896 0.687602 0.914043 0.697581 0.105317 1.825200 0.024458 0.235192 0.433521 0.312835 0.809192 1.808814 0.468703 0.865854 1.628971 1.590464 1.720208 0.790391 0.109924 1.554973 -0.023990 1.192392 0.712254 -0.008308 1.166932 0.323937 0.599507 1.428804 1.009547 0.297463 1.703546 1.729917 1.681205 0.524857 1.697748 0.256667 1.120927 0.047187 1.189398 0.820638 0.699302 0.002442 1.121649 1.667851 0.869163 1.641192 0.656529 0.841409 0.057676 -0.196215 1.453792 1.886624 0.125107 0.602688 0.239635 0.436713 1.300259 1.239844 0.261666 1.553825 0.240232 0.801341 0.507041 1.560623 1.566831 1.253461 -0.062284 1.669509 1.095250 0.027748 1.068831 0.602783 1.174264 1.815938 0.796036 0.386048 1.233720 1.401215 0.759974 0.913111 1.179032 1.213203 0.938878 1.696577 0.360595 1.305400 0.044128 1.743675 1.440756 1.459247 0.623194 1.508843 1.421417 1.629960 0.477983 0.835293 -0.070334 0.708287 1.142955 0.932387 1.813043 1.382192 0.381127 0.190410 0.729845 0.321732 0.824558 -0.020023 1.607442 0.200267 0.318647 0.044651 1.768240 0.643757 1.206201 1.468765 0.601437 1.706259 0.495261 0.956913 0.394710 1.176569 0.800067 1.886558 1.605179 1.122676 1.144265 1.561625 0.181947 1.309849 1.577300 0.495188 1.655610 1.180832 1.194001 0.875913 0.228611 1.639141 0.550083 1.839287 0.580971 -0.197365 0.327613 1.901067 0.522438 1.020637 1.267341 1.342859 0.445176 0.112095 0.457659 0.120276 0.250883 1.204237 1.402798 1.271260 1.255292 0.578618 1.686129 0.490946 1.771289 1.121957 0.127348 0.581481 0.812819 1.448200 -0.003892 -0.044962 0.952367 1.033247 -0.085086 0.150310 0.057854 1.842500 0.716853 0.935519 0.269127 1.299626 0.388259 0.164338 1.057650 1.178504 1.241059 0.565924 1.615325 0.390452 0.686889 1.489199 0.183366 1.767188 1.365040 1.248231 1.196393 0.220573 0.358798 0.163202 1.499695 1.793435 -0.212597 0.677471 0.562186 1.706417 0.638842 0.138384 1.541313 1.495553 1.825920 1.099565 0.289989 1.936921 0.388891 1.617689 0.315048 0.242499 1.724502 0.758918 0.479832 0.306301 1.154626 1.015534 1.286300 0.819723 0.897789 1.897385 0.811133 1.198870 -0.023538 1.581550 1.752737 0.752872 1.653243 1.098279 0.913859 0.290667 0.391090 0.448864 1.747363 1.628653 1.296395 1.685456 0.410609 0.613612 0.229500 1.978170 0.563390 1.684018 1.175413 1.421149 0.835252 1.423949 1.519247 0.020578 0.410433 0.532037 1.105479 1.305389 0.747326 0.273148 1.468421 1.561328 1.045465 0.300840 1.851806 1.623959 -0.020047 0.551127 0.952587 1.750489 0.425896 1.297055 1.252366 0.774082 0.008302 0.830022 0.354751 1.630433 0.527393 0.320074 0.992472 1.329100 0.937461 -0.124987 0.528489 0.860443 1.777412 -0.179698 1.649835 1.523675 0.255615 0.752546 1.044250 1.061394 1.473542 1.559139 1.750843 0.228407 0.244978 0.318506 0.214338 -0.127687 0.016065 1.683527 1.059087 1.084321 1.209844 1.162599 1.700206 1.028836 1.111259 0.965422 1.349098 0.449160 1.236238 1.152610 1.241247 0.441411 1.200500 1.575948 0.056337 0.109621 0.678763 1.605571 1.462870 0.670350 1.160814 0.178948 1.776617 0.814727 1.471143 0.666341 0.666497 0.003085 0.367263 1.764549 1.817682 0.565043 0.256262 0.744401 0.069362 0.856509 1.798907 0.484543 1.036560 1.448462 1.009617 0.983445 0.719152 0.713983 1.197878 0.928722 0.442562 0.632379 1.311255 1.163303 1.389071 0.013803 1.283658 0.183551 0.216748 0.742490 0.246195 0.580366 1.004491 0.032852 1.729133 1.159382 1.701779 0.944042 1.827589 0.917849 1.400392 1.223004 1.113159 0.052572 0.168081 1.615230 1.221824 1.526728 1.850771 -0.240328 1.487522 1.159816 1.866293 1.698164 0.013835 -0.093167 0.180008 0.018965 1.603158 1.613742 1.313466 1.035280 1.492647 0.815996 0.391557 1.242014 0.993247 1.401424 0.488225 0.393455 0.894952 0.309407 0.321448 0.558471 0.718740 1.467551 0.500281 0.439320 1.869730 1.364530 1.553036 0.969732 1.636285 1.798396 1.363995 0.920638 0.126592 0.286258 1.696296 0.331371 0.356812 0.490460 1.101761 0.373647 0.097306 0.453078 1.827015 0.179707 -0.019918 -0.106312 0.084833 1.193623 0.408083 0.143266 0.206533 1.082562 0.158416 0.854906 0.878107 0.339914 0.457130 0.154799 0.176600 0.085438 0.131041 0.453107 0.593969 0.303633 0.916178 1.161798 1.896318 0.930094 0.986481 1.688216 0.819416 1.265892 0.011344 0.265144 0.267354 1.189048 0.659992 1.171202 1.786897 0.902370 -0.041938 0.785186 0.246222 1.558295 1.890657 1.369584 1.616357 1.670144 1.849685 1.342838 1.757000 1.172827 0.103451 0.032886 1.109693 0.659929 0.371860 1.404352 1.477883 1.155474 0.555608 0.969331 0.650971 1.813202 1.603915 0.999884 1.494172 1.882922 1.689689 1.690194 0.705259 1.560645 1.081311 0.825846 1.685601 0.689103 0.269731 0.147349 0.167554 0.803327 0.198449 1.282138 1.170132 0.901085 1.709183 0.934868 1.972921 0.385259 1.488122 0.118213 1.387825 0.546603 0.472410 0.223942 0.792440 1.272964 0.539143 1.056110 0.965279 1.256909 0.069278 0.438772 0.688522 1.474529 1.518833 0.647516 1.850584 -0.061940 1.420599 1.301753 0.184502 0.147262 0.261775 0.575331 1.308330 1.224554 0.672189 0.758277 1.191895 1.228368 0.130276 0.482407 1.350231 1.750711 0.397622 1.713381 1.011249 0.522822 1.072918 1.821285 0.965512 0.063639 0.566385 1.807346 1.175784 1.223074 1.591887 -0.168041 0.271021 1.529439 0.521842 0.823001 0.940921 1.684294 0.286489 1.242930 1.937690 0.607200 0.275302 1.790606 0.491021 1.035487 -0.045868 0.085148 1.238065 1.129382 -0.053312 1.545108 0.434470 0.810550 1.100562 0.221267 1.037507 1.624758 1.555603 1.062386 0.144378 0.886916 0.149410 -0.066826 1.113563 0.490079 0.634885 0.842660 0.061321 1.725263 1.823881 0.115290 1.146242 0.979557 1.530480 0.067327 0.568197 0.897626 0.771983 0.563170 1.194766 0.655189 1.549104 1.322518 0.483177 0.760693 1.010138 0.534980 0.223935 1.152460 1.731132 1.519096 0.446488 1.420973 1.696386 1.157486 1.211136 1.546897 1.232762 1.175520 0.355595 1.525833 -0.042267 1.352048 0.992497 -0.093673 0.742530 0.634885 -0.089066 0.868194 0.573537 1.674126 0.329153 1.158907 1.178480 0.551158 1.486852 -0.071558 0.725909 1.395015 1.209212 0.379942 0.747225 0.444854 0.946742 1.211242 1.139390 1.010957 1.097783 0.203142 1.127162 1.614090 1.772287 0.331896 1.598023 1.816077 0.662803 1.330979 0.944114 1.383701 0.797215 1.196402 1.084443 1.184444 1.682543 1.168272 1.958979 -0.058496 0.841894 1.219141 1.365510 0.769766 1.232995 0.960628 1.742029 1.659964 0.361424 0.247996 1.622047 1.491439 1.012850 0.556413 0.070470 1.055118 0.709469 1.227676 1.050289 1.817507 1.250045 0.044881 -0.105998 0.360108 0.510639 -0.000754 0.913624 0.014253 0.869683 0.815496 -0.043945 1.463465 1.037174 0.323537 0.584260 1.687824 0.186494 1.408948 0.905638 1.501561 1.450375 1.647727 1.343515 0.997551 0.097973 0.620795 0.473197 0.975124 1.453483 0.888388 0.452833 1.689714 0.696728 0.633683 0.509294 1.106199 0.373384 1.699003 1.169996 0.082561 0.289835 0.757159 1.514061 1.528786 0.435419 0.161517 0.726914 1.380867 1.654754 0.604942 0.070114 0.541874 1.167294 1.310511 1.570194 0.673809 1.267196 0.489289 1.272471 1.573227 1.458789 0.530304 0.456318 1.679920 1.109017 0.240982 1.697797 0.777016 0.870109 1.599744 1.746059 0.193197 0.572600 1.617885 0.423393 0.264299 1.931463 0.929567 1.333438 0.553075 0.123102 0.783267 1.986789 1.667679 1.525086 1.102518 0.117178 0.013899 0.476557 1.428021 1.781881 0.479378 1.440749 0.433516 0.176847 1.747379 1.328355 0.058455 1.628266 1.215447 1.600718 0.965239 1.219616 1.227710 0.034900 1.335400 0.576945 0.169250 1.234608 1.110724 1.740429 1.656377 0.259109 1.608270 0.156542 0.335333 0.895697 -0.078619 0.093744 0.937474 0.090269 0.752748 0.885184 1.935435 1.556700 1.833155 0.379459 1.439350 0.281834 1.377687 1.469181 0.560304 0.350829 0.370361 0.413143 1.546821 1.107825 0.763796 1.687563 0.219324 0.055037 -0.020128 1.641061 1.731840 1.877911 1.717828 1.356597 1.730658 0.588868 0.835297 0.297291 0.088419 0.412212 1.415406 1.017343 1.423175 0.375775 1.302219 0.953702 0.678804 1.572374 1.727477 0.254556 1.094641 1.162163 0.143319 0.854688 1.063038 0.441476 1.282254 1.589355 0.648429 0.822071 1.490818 0.276396 1.213776 0.318534 1.167492 0.713979 0.593799 1.038818 1.843043 0.450884 1.098196 1.002340 1.751110 1.258344 0.802075 0.796882 0.068028 0.990778 1.404822 0.767441 0.258966 0.014912 0.397819 1.169281 0.671758 0.828982 0.684022 1.483627 0.060148 0.140681 0.965311 1.046164 1.448760 0.937335 0.043049 1.426389 0.175311 0.942467 1.289194 0.705897 0.195736 1.367220 0.481110 1.117710 0.026294 1.480040 1.701576 0.741539 0.129438 1.793396 0.216626 0.338432 1.293825 1.852766 0.567380 0.675267 1.660257 1.295361 0.379806 0.115345 0.037783 0.635233 0.390593 0.891898 1.623418 1.141114 0.967319 0.436616 1.163548 1.438313 1.028606 1.507879 0.276194 1.126750 1.086763 0.657033 -0.091488 1.327256 1.184128 1.357378 0.116523 1.532550 0.455893 1.613945 0.808970 0.183575 0.288911 -0.057175 0.416408 1.883558 1.036690 -0.004024 1.155543 0.908210 0.958228 0.735059 -0.149409 -0.109242 1.993416 0.061976 0.994397 0.312822 0.358556 0.357396 0.166228 1.906441 1.936369 1.954589 1.571014 0.719233 0.153949 0.028336 1.320995 1.240948 0.545995 1.805452 1.619213 0.231489 1.707803 0.618275 0.642514 1.471382 1.348917 1.095451 0.221991 0.792513 0.689445 1.882995 1.365514 1.063222 1.950163 0.465549 0.519653 0.736476 1.311946 1.452773 1.442715 1.517899 0.924450 -0.258534 0.766737 0.924843 0.502570 1.115330 1.657088 0.120016 1.780444 1.686548 0.035927 0.449644 0.309346 1.622740 0.581408 0.299807 1.408994 0.611973 0.764394 0.604130 1.299785 1.686040 1.006944 0.701090 1.243781 0.213973 0.887207 1.233295 1.666529 0.235283 1.402144 1.228392 0.531790 0.502582 1.344011 1.047300 1.113632 0.075538 1.422393 1.570034 1.313722 0.186419 0.938804 1.688331 0.356313 1.160071 1.677615 0.597077 0.892649 1.278418 1.866713 0.634605 1.131045 1.247527 0.323580 1.122900 0.478811 0.712857 0.778489 0.733910 0.492143 1.681476 0.182306 0.475863 1.491278 0.187728 0.437657 0.198048 1.236439 0.268664 0.149327 0.934080 1.438262 1.896760 0.457386 0.548858 1.210218 1.289090 1.057745 0.668857 1.173530 0.693912 1.373334 0.504490 1.774419 1.309479 0.081305 1.710946 1.383983 0.433639 0.367597 0.598191 0.968980 0.477561 1.759027 0.625170 1.727969 1.718828 0.634164 0.574901 1.059254 0.056017 0.516804 0.253417 0.694276 1.806842 1.251926 1.330344 0.582436 0.789520 1.835852 0.867891 1.822064 1.359273 0.296168 0.365411 0.131864 0.093576 0.901545 1.224841 -0.103847 0.409143 1.472189 1.522564 0.937037 0.936778 0.858129 0.405727 0.803283 0.405592 1.621314 0.477697 1.071232 1.490250 0.210905 0.388916 0.148961 0.484107 0.248858 0.677626 1.216797 1.366933 0.495657 1.673293 0.762780 1.143691 1.830348 0.353612 0.038958 1.687620 0.671154 0.712933 1.807885 1.122232 1.188992 1.701760 0.242220 1.603391 0.699724 1.054033 0.076868 1.632921 1.612600 0.087130 0.365903 0.458822 1.024159 1.354588 0.392699 1.423641 1.204423 1.164681 1.649578 1.256031 1.243822 1.042854 0.005560 1.024514 0.604398 0.680137 1.912453 0.670310 0.213643 0.446770 1.090682 1.474974 1.806865 0.764624 1.563431 0.473634 0.510617 1.001005 1.364194 0.537668 -0.014680 0.885588 -0.005747 1.738242 1.410596 1.602084 0.734862 1.493989 1.349989 0.406916 1.170482 -0.017990 1.034213 0.634019 1.456131 0.974789 -0.144669 1.737158 -0.037172 1.400515 1.623550 0.499450 1.479595 0.507050 1.358218 0.582744 1.475859 0.513808 1.600273 1.836597 1.059912 -0.072725 1.290524 -0.073595 1.937918 0.300206 0.119306 1.027133 -0.093444 0.011477 1.127890 1.399417 1.853798 1.657887 0.145866 0.588742 0.873359 0.762305 1.639168 0.778598 0.019634 1.817733 0.156595 0.169164 1.530459 1.438248 0.803585 -0.094272 0.468694 0.847016 0.311870 0.299559 0.551763 0.793044 1.160950 0.697742 1.837771 0.754430 1.758952 0.505686 1.737258 0.020417 1.293145 1.675271 0.394950 0.929538 0.720083 0.978614 0.784199 0.905034 0.921702 0.937761 1.562150 1.166453 1.603212 0.260741 0.602140 1.673881 0.673664 1.946860 1.010728 1.288978 1.297659 1.198620 0.504487 1.420515 1.576870 0.975311 1.683510 1.543454 1.716402 0.940588 1.162463 1.651787 0.589731 0.285012 0.638073 1.089187 1.489366 0.491525 1.435921 1.014411 1.601370 0.949407 1.694644 0.959875 -0.062780 -0.004119 1.163389 0.589582 1.149178 1.817933 0.849953 1.802695 1.461496 1.665429 1.837845 0.976053 0.862346 0.530923 0.811633 0.503788 -0.027013 1.611602 0.057407 0.611054 1.824034 0.259920 0.148035 0.105941 -0.021158 1.835611 1.319838 1.754236 1.193537 1.357026 0.094401 1.491186 0.366416 1.555586 1.669437 0.823707 1.243186 0.432020 1.052515 0.858115 1.022105 0.954847 1.455406 1.318994 0.283690 1.211015 0.710161 0.270613 1.714336 1.101135 0.235311 1.092475 1.008566 0.447003 0.602655 0.757184 0.009064 0.530056 1.724465 0.607925 1.121575 1.099024 0.882158 0.934761 0.125447 0.972944 0.967420 1.343086 0.315752 1.165505 1.109567 1.918061 1.478347 0.850704 0.940172 0.696083 0.793045 1.211155 0.866708 0.135821 0.480730 1.058685 0.463469 0.583533 1.522858 0.588384 0.353159 1.576867 1.754930 0.850029 1.919190 1.543405 0.995776 0.821301 1.793940 1.151072 -0.047846 1.508846 1.746284 0.877808 0.214307 0.787802 -0.003151 1.141139 1.698635 0.232169 1.093325 1.515191 0.901564 1.506350 0.135967 1.384636 -0.242650 0.302616 1.608186 0.459148 0.023364 0.249132 1.086552 0.992569 1.132819 0.061330 1.433907 1.539244 0.001712 1.876374 1.299743 1.030055 0.164439 0.092647 0.881217 1.088556 1.351722 -0.088421 0.062334 -0.051555 1.260415 0.983686 0.258617 0.860731 0.793959 0.416831 1.721077 0.095305 0.351122 0.421061 1.074247 -0.008811 1.438063 1.858745 1.305784 0.273960 1.682787 1.279785 0.274409 1.389220 0.882641 1.632991 1.590305 0.893791 0.055411 1.041678 1.451974 0.782716 0.213219 0.208404 1.139321 0.013312 0.073161 1.595535 1.686000 1.590328 0.023294 0.960934 0.758890 0.838775 1.710621 1.483697 1.281650 1.870804 0.139547 0.420537 0.308122 0.843944 0.520105 0.603303 -0.123864 1.234056 1.586800 0.927689 1.817960 1.506645 1.174470 0.276079 0.650528 0.932391 1.014056 0.664840 1.016866 1.426511 0.276789 0.219182 -0.115031 -0.164867 0.961712 0.416951 1.540063 0.375102 1.075987 1.313615 1.096641 0.764154 1.064504 0.355545 1.636517 0.212986 0.487153 0.606986 0.525136 0.094256 1.722629 0.854306 0.459009 1.050404 0.099495 1.863554 1.019865 1.702596 1.229915 1.749507 0.590639 0.164343 1.868513 1.170840 1.017598 0.404087 1.088319 0.595386 0.693810 1.531079 -0.137773 0.882791 1.035974 1.610308 1.572178 1.281505 1.448052 1.385965 0.085841 0.156089 1.020082 1.499413 1.367482 1.202166 -0.310324 1.093902 0.466865 0.481107 0.055940 1.626791 0.579934 0.932207 0.524863 0.771645 1.410464 1.781815 0.875062 1.565260 0.492144 0.931433 0.731301 0.464124 0.688570 0.033927 0.659049 -0.144339 1.390582 0.216364 1.564810 1.784761 0.542130 1.644616 0.892364 0.103014 1.151370 0.406893 0.685594 0.203695 0.116843 1.116841 0.017775 1.255535 0.180776 1.604852 1.357176 0.844518 1.917543 0.710840 0.586218 -0.084711 0.326304 0.583894 0.000981 1.527582 0.764193 0.691981 1.254365 0.042940 0.799959 1.234613 0.912676 1.261576 1.804612 1.772885 1.638278 1.452687 1.856363 1.017673 1.335012 1.093288 1.791716 0.240760 1.583614 0.215117 1.054497 1.759230 1.720795 1.725051 0.719870 1.536084 0.793019 0.072407 1.612325 0.603805 0.749790 0.930307 1.444787 0.076331 0.716031 0.751130 1.730048 1.119736 1.740692 1.642864 1.211815 0.613767 1.280443 0.196315 0.724783 0.377146 1.066938 1.497331 1.166708 1.287064 1.948271 1.408327 0.113842 -0.199587 0.630400 0.343945 1.153303 0.303357 -0.235653 1.575467 1.304018 0.481724 0.321926 1.036142 1.030288 0.337553 0.573686 1.834042 0.718673 0.182114 0.139978 0.253556 1.503381 0.215937 1.358417 0.238777 1.828073 0.206519 0.338254 0.358048 1.340274 1.144155 0.382861 -0.237688 1.081990 0.287210 0.604778 0.308728 1.486981 0.684669 1.827156 0.478181 1.795964 1.220849 1.367205 0.507990 0.995111 0.581857 0.196941 1.401782 0.618658 0.678201 1.941176 0.922033 0.346514 1.451221 1.191571 0.812039 0.176868 0.358644 0.856782 1.053754 0.172649 -0.008915 0.891004 1.275467 1.965871 1.446554 1.059213 1.698536 0.639863 1.290197 1.301277 0.460338 0.904108 1.206822 1.204141 0.172712 1.004515 0.611142 0.640455 1.099407 0.564655 0.577778 1.778285 0.167018 0.507458 0.762661 0.259884 0.066707 0.947613 0.965715 0.752844 0.822051 1.036867 1.496747 1.109711 1.909353 0.600886 1.668852 1.668992 -0.160977 0.189295 1.475624 0.412875 0.557318 1.130005 0.439886 1.255571 1.411751 0.901388 0.499673 1.791033 0.684314 -0.123345 1.518751 0.858235 1.779307 0.897544 1.242344 1.789823 1.117474 0.471404 0.148429 0.200067 1.627870 1.184473 1.258861 1.514572 1.105948 0.122797 0.601905 0.937069 0.692200 1.745527 1.038032 0.377653 0.204106 1.113841 0.997556 1.126370 0.095557 1.147967 0.559979 1.673772 1.556295 0.142426 1.654656 0.686755 0.114523 1.891052 1.870233 0.340505 0.325592 1.788001 1.691946 1.832371 0.254110 -0.056957 0.552635 0.359382 1.244098 0.331889 0.956126 1.636252 0.526733 1.070660 0.740225 1.503924 0.042864 0.662653 0.013249 0.159303 0.325720 0.297550 0.820869 1.730514 0.000052 0.161939 0.357257 0.877505 1.576861 1.847738 0.044951 0.597694 1.584933 -0.105788 1.430351 0.083180 1.563544 1.130148 1.599446 1.171509 0.524299 0.631284 0.480371 1.906399 0.915214 1.139324 0.334117 1.299283 0.373882 0.383787 0.345985 1.171992 0.720625 1.314793 1.338926)
+ ;; (try-all :even 2048 2049 0.0014328746687631 0.51217918249646) = 56.93601 start for next
+ ;; ce:
+ 50.887273 (fv 0.000000 -0.001703 0.433172 1.590778 1.336810 1.796101 0.945990 0.630649 1.068973 0.276030 0.019619 0.418921 1.642205 1.314880 1.815562 0.937954 0.690335 1.166456 0.260174 0.033467 0.534551 1.577952 1.359691 1.855935 0.978115 0.778145 1.214744 0.305514 0.073250 0.585950 1.700979 1.456846 1.891326 1.051448 0.870291 1.262779 0.419868 0.209104 0.667538 1.764244 1.534253 0.022691 1.157333 0.886455 1.397513 0.522770 0.305417 0.791572 1.882641 1.706581 0.124613 1.245754 1.016938 1.507704 0.621789 0.423116 0.882723 0.034318 1.775279 0.266045 1.420137 1.176158 1.620182 0.842558 0.553079 1.037944 0.182615 0.005162 0.432646 1.577593 1.375077 1.777427 0.999839 0.726166 1.218120 0.366911 0.123723 0.662290 1.808464 1.555557 0.050943 1.161441 0.961088 1.469391 0.581778 0.421014 0.869182 1.964711 1.782785 0.217679 1.412311 1.228590 1.681851 0.818320 0.617489 1.120821 0.226824 0.041870 0.539030 1.644423 1.496409 1.937912 1.088438 0.861771 1.374952 0.504902 0.301816 0.831900 1.946273 1.700988 0.237333 1.351841 1.174113 1.697709 0.766188 0.601502 1.097799 0.223664 0.073707 0.490731 1.705779 1.529713 0.004900 1.114151 0.927806 1.413217 0.593263 0.370397 0.876728 0.024219 1.840075 0.345172 1.498140 1.311278 1.774455 0.911735 0.779474 1.231046 0.351370 0.170176 0.732535 1.828332 1.647912 0.151754 1.304922 1.134715 1.583698 0.773654 0.612595 1.042987 0.199634 0.036653 0.549756 1.681847 1.475587 0.005194 1.173802 0.977842 1.470305 0.643755 0.476622 0.917721 0.111850 1.936419 0.450243 1.616355 1.416777 1.915014 1.098462 0.907664 1.447783 0.570918 0.405291 0.889269 0.066991 1.881365 0.373330 1.508358 1.402579 1.870612 1.085131 0.920739 1.348392 0.568783 0.336415 0.843225 0.063446 1.926774 0.418106 1.565445 1.379520 1.897103 1.050320 0.891564 1.380927 0.530987 0.385626 0.908446 0.068664 1.943935 0.430612 1.518729 1.398232 1.924184 1.103625 0.924587 1.417433 0.610522 0.456479 0.953409 0.112059 0.013043 0.495872 1.633744 1.493163 0.038519 1.187544 1.048687 1.588579 0.748576 0.532785 1.100237 0.281535 0.104911 0.635452 1.811612 1.634030 0.184177 1.345558 1.153862 1.750039 0.857060 0.732788 1.250092 0.418042 0.246015 0.725057 1.972355 1.807991 0.351695 1.540788 1.347415 1.848165 1.067747 0.908528 1.413312 0.618180 0.467879 0.991799 0.190738 0.053795 0.507730 1.744900 1.620134 0.124619 1.318661 1.152397 1.685590 0.894836 0.688791 1.239521 0.488835 0.282246 0.831794 -0.015794 1.883123 0.431031 1.583860 1.447618 1.964025 1.125655 1.064343 1.569856 0.748855 0.603708 1.107653 0.309052 0.196774 0.696407 1.871049 1.742283 0.240318 1.473905 1.321207 1.881514 1.047815 0.924156 1.493868 0.689863 0.543896 1.026203 0.246976 0.140944 0.678125 1.870899 1.706720 0.276250 1.408196 1.319078 1.889412 1.061123 0.937583 1.451370 0.684034 0.567548 1.075578 0.293854 0.180105 0.705838 1.911360 1.764817 0.292975 1.493988 1.411105 1.895989 1.081687 1.012629 1.575334 0.718344 0.628406 1.174951 0.386415 0.230260 0.768066 -0.015753 1.886981 0.454216 1.616098 1.441778 0.077596 1.316514 1.144927 1.696140 0.867400 0.757625 1.309429 0.563210 0.364175 0.954929 0.137349 0.057751 0.597415 1.789122 1.677288 0.252684 1.417924 1.313555 1.862237 1.126315 1.015807 1.510443 0.802206 0.652057 1.184565 0.404523 0.277585 0.843687 0.148971 1.933489 0.514414 1.743011 1.592866 0.129290 1.346399 1.259419 1.817805 1.029171 0.962338 1.475532 0.708188 0.633076 1.151811 0.395581 0.307725 0.834201 0.078405 1.959228 0.466843 1.769721 1.650538 0.159441 1.402559 1.321215 1.914285 1.128095 1.014297 1.571134 0.803693 0.677208 1.246457 0.469701 0.356795 0.908733 0.149102 0.035900 0.615966 1.826481 1.708851 0.339243 1.554134 1.413247 -0.028956 1.251019 1.106816 1.704569 0.926586 0.827768 1.430366 0.655894 0.524343 1.153832 0.363573 0.234391 0.825975 0.037037 1.955590 0.487803 1.776970 1.679179 0.270247 1.494959 1.379330 1.956206 1.186819 1.071982 1.644518 0.897716 0.759160 1.349574 0.601679 0.512657 1.067152 0.367997 0.259056 0.818805 0.070970 1.979460 0.551129 1.797928 1.685198 0.237267 1.508404 1.457352 0.047420 1.261021 1.192815 1.789893 0.995526 0.930294 1.496757 0.778086 0.636312 1.222185 0.505076 0.392642 1.016934 0.236492 0.140361 0.774022 0.001411 1.961469 0.498526 1.750119 1.648169 0.240766 1.450209 1.419896 0.004281 1.237513 1.195486 1.793570 1.030159 0.946491 1.529067 0.769460 0.726220 1.269159 0.564615 0.472841 1.084479 0.322182 0.217540 0.870218 0.092806 0.039652 0.580465 1.871900 1.768958 0.330755 1.643083 1.574291 0.148815 1.382016 1.330434 1.953984 1.191904 1.113085 1.729795 0.935173 0.941506 1.487573 0.777735 0.706146 1.300602 0.552074 0.471965 1.086702 0.368313 0.238388 0.870358 0.129144 0.034415 0.647185 1.956907 1.855191 0.450494 1.695322 1.674270 0.277115 1.525710 1.462245 0.090299 1.329096 1.259635 1.870782 1.128184 1.069973 1.694787 0.953585 0.907980 1.546930 0.802555 0.747675 1.322734 0.664094 0.527920 1.163169 0.460332 0.399285 0.970040 0.217204 0.171752 0.769371 0.047350 -0.025234 0.632915 1.894302 1.830249 0.455254 1.760595 1.701533 0.321139 1.541634 1.515918 0.102674 1.367783 1.346029 1.941486 1.223287 1.213347 1.782946 1.029999 1.005092 1.692642 0.911840 0.875191 1.494140 0.757479 0.727400 1.310293 0.611635 0.559689 1.154763 0.453641 0.402989 1.051223 0.342693 0.309148 0.919084 0.199108 0.132609 0.759042 0.053229 -0.033954 0.648811 1.906240 1.894740 0.483288 1.798246 1.730147 0.369025 1.616846 1.576788 0.217080 1.494201 1.461719 0.088483 1.386902 1.325078 1.982480 1.249756 1.217589 1.872681 1.143670 1.127132 1.742603 1.001258 0.969685 1.653400 0.948140 0.903244 1.474757 0.844045 0.804740 1.381313 0.669059 0.696990 1.287624 0.590259 0.542974 1.139086 0.529408 0.444238 1.060949 0.381119 0.387330 0.982887 0.274265 0.262799 0.892622 0.182183 0.155238 0.802580 0.125716 0.062385 0.697970 -0.029110 -0.005740 0.631814 1.935506 1.905147 0.526743 1.805035 1.822539 0.427610 1.754204 1.769095 0.334244 1.671094 1.648758 0.313430 1.604455 1.580989 0.249732 1.534106 1.501925 0.141332 1.456591 1.376333 0.087064 1.395898 1.349285 -0.007846 1.309141 1.324784 1.926752 1.235223 1.257013 1.870695 1.183965 1.196890 1.833185 1.161076 1.134259 1.737981 1.066217 1.029285 1.761061 1.046404 1.003567 1.669085 1.015282 0.945700 1.628153 0.957401 0.910198 1.578015 0.892702 0.920061 1.560411 0.892643 0.883270 1.499087 0.881141 0.786754 1.465346 0.814870 0.806704 1.420951 0.745568 0.748981 1.428779 0.724569 0.722331 1.414318 0.735199 0.680304 1.412191 0.642055 0.663317 1.362918 0.692620 0.652852 1.255275 0.655029 0.616540 1.306668 0.607368 0.596378 1.278318 0.605729 0.626127 1.248672 0.605969 0.598531 1.270199 0.590247 0.604018 1.248420 0.564539 0.573991 1.243120 0.541247 0.581568 1.247013 0.548311 0.583389 1.254363 0.570054 0.592870 1.314918 0.584147 0.601170 1.285128 0.585385 0.636800 1.268157 0.564860 0.618673 1.241680 0.593206 0.649499 1.294308 0.619335 0.690828 1.290074 0.662251 0.659564 1.319465 0.684267 0.676527 1.346573 0.684074 0.749941 1.376399 0.760563 0.735778 1.409735 0.781193 0.776861 1.424608 0.803012 0.794890 1.482330 0.849249 0.820388 1.516581 0.910615 0.864461 1.540065 0.895368 0.913334 1.630286 0.950361 0.962747 1.686669 0.985439 1.020247 1.674781 0.998529 1.106931 1.784420 1.109819 1.080550 1.792617 1.141848 1.167488 1.815820 1.225904 1.216862 1.932151 1.308230 1.267897 -0.026968 1.330184 1.385176 0.022707 1.458233 1.415333 0.128552 1.487923 1.523242 0.191001 1.550003 1.584242 0.283355 1.596921 1.662782 0.308217 1.689429 1.701664 0.432683 1.765615 1.799785 0.477706 1.814969 1.847473 0.536692 1.956606 -0.125001 0.671687 0.021081 0.062099 0.778322 0.143122 0.195164 0.870404 0.217515 0.248340 0.992771 0.296311 0.393796 1.036703 0.444136 0.428455 1.144392 0.545916 0.532816 1.274635 0.638559 0.682382 1.366079 0.738438 0.791235 1.469530 0.832133 0.861591 1.597033 0.965134 0.975949 1.660906 1.074595 1.121780 1.850802 1.205711 1.200292 1.955639 1.297951 1.320764 0.075418 1.456186 1.481933 0.158684 1.566840 1.641287 0.359580 1.677476 1.730799 0.448508 1.815321 1.873655 0.540161 1.931330 1.974330 0.742536 0.063433 0.156314 0.825290 0.223991 0.306298 0.962765 0.360970 0.418863 1.127740 0.516243 0.542975 1.312005 0.652439 0.710545 1.452213 0.776568 0.871797 1.548353 0.973587 1.004549 1.725321 1.089618 1.233086 1.882229 1.280829 1.345266 0.036253 1.417172 1.451706 0.202998 1.622238 1.674924 0.340016 1.728728 1.833591 0.567298 1.946042 0.023405 0.702356 0.135275 0.153799 0.884198 0.265400 0.340889 1.099730 0.493458 0.526956 1.267239 0.676407 0.690082 1.422573 0.812500 0.926029 1.644040 1.074851 1.097114 1.811626 1.221109 1.268846 0.019885 1.418865 1.465834 0.226550 1.602283 1.642652 0.409600 1.782663 1.847764 0.612518 -0.014414 0.080272 0.793644 0.189642 0.287941 1.015956 0.430798 0.498270 1.212055 0.606553 0.678263 1.458990 0.847157 0.901708 1.629236 1.030896 1.120792 1.854770 1.260369 1.292084 0.058109 1.472251 1.530032 0.298666 1.686445 1.750885 0.465407 1.926615 -0.015762 0.736186 0.179728 0.219514 0.995121 0.367989 0.459496 1.186779 0.640597 0.690551 1.458450 0.858324 0.911511 1.699195 1.068188 1.186092 1.897316 1.337175 1.402416 0.144009 1.638297 1.673138 0.373403 1.812913 1.888979 0.630635 0.080370 0.169331 0.914815 0.273060 0.393754 1.122091 0.596144 0.640794 1.390765 0.839105 0.918214 1.680880 1.131151 1.205710 1.974811 1.393861 1.452322 0.156477 1.645144 1.718367 0.451059 1.878144 0.022469 0.716191 0.203622 0.204052 1.000934 0.419218 0.531168 1.297295 0.702318 0.799989 1.534195 0.962961 1.059623 1.864764 1.322381 1.390676 0.140300 1.535535 1.653796 0.423232 1.846167 1.958815 0.705134 0.115159 0.251430 1.006465 0.470237 0.504026 1.267250 0.734232 0.836445 1.549915 1.039694 1.136664 1.905550 1.321296 1.400727 0.208474 1.633666 1.709003 0.486386 1.940896 0.025205 0.789590 0.229116 0.395199 1.113150 0.560152 0.653681 1.459139 0.830910 0.975236 1.738577 1.210343 1.308624 0.093706 1.493739 1.620053 0.424641 1.828846 1.940485 0.729339 0.163547 0.294790 1.029106 0.522695 0.623772 1.363366 0.795679 0.991955 1.735746 1.166232 1.233433 0.033448 1.517164 1.590656 0.407889 1.837549 1.928075 0.698672 0.187906 0.288583 1.089091 0.525365 0.646727 1.419503 0.847075 1.003035 1.770682 1.222701 1.368528 0.132834 1.552702 1.702988 0.486356 1.942867 0.028321 0.834453 0.305865 0.427874 1.193367 0.646670 0.777994 1.535326 0.959127 1.141152 1.974723 1.386313 1.482039 0.241727 1.733430 1.907279 0.652190 0.113225 0.233654 1.053634 0.521015 0.606360 1.407458 0.868195 0.979596 1.802838 1.252544 1.387190 0.144685 1.620697 1.765258 0.551267 0.016634 0.102630 0.966227 0.379774 0.557760 1.339080 0.772792 0.943942 1.714448 1.227165 1.340588 0.135412 1.553794 1.733262 0.505137 0.052411 0.115242 0.903954 0.369383 0.566147 1.338694 0.822997 0.955372 1.767911 1.219397 1.351801 0.123533 1.574789 1.767438 0.582707 0.059344 0.173569 0.987297 0.434401 0.616641 1.368611 0.898977 1.018679 1.815949 1.269299 1.423987 0.244273 1.756592 1.844278 0.628834 0.156429 0.267440 1.098495 0.557657 0.757430 1.527200 1.032316 1.157667 1.941839 1.435329 1.592128 0.417339 1.857219 0.027921 0.825078 0.326257 0.472209 1.266409 0.776877 0.907550 1.713542 1.197483 1.352897 0.148954 1.643699 1.805895 0.598148 0.109639 0.271416 1.099053 0.556356 0.664165 1.505314 0.973330 1.224262 1.958351 1.490436 1.656174 0.418476 1.960327 0.146807 0.899660 0.444751 0.550436 1.400125 0.831060 1.011690 1.850969 1.328814 1.486005 0.311620 1.812294 -0.006342 0.797723 0.305173 0.491901 1.322423 0.745375 0.923548 1.782732 1.275234 1.378532 0.222379 1.713386 1.920722 0.741433 0.280929 0.401426 1.209280 0.698837 0.886341 1.726784 1.225163 1.413939 0.172159 1.726536 1.893106 0.754636 0.203236 0.351446 1.190416 0.680791 0.829406 1.684757 1.210208 1.371232 0.224484 1.699825 1.891292 0.738873 0.258642 0.425836 1.243225 0.713196 0.891190 1.771850 1.235681 1.368819 0.270358 1.784768 1.928168 0.781510 0.284144 0.430703 1.331232 0.807861 0.993486 1.852203 1.325750 1.549374 0.376307 1.889520 0.034521 0.884377 0.427788 0.583618 1.373059 0.934920 1.074386 1.964373 1.419552 1.645249 0.489767 0.008746 0.185928 1.061283 0.556624 0.715745 1.608195 1.103831 1.267216 0.164802 1.613900 1.850921 0.624698 0.161160 0.408839 1.261772 0.735470 0.975590 1.782335 1.311907 1.475716 0.390097 1.869546 0.060780 0.873934 0.410643 0.589799 1.451558 0.998661 1.152970 0.054633 1.557268 1.731872 0.575393 0.117821 0.307307 1.198887 0.683313 0.897819 1.753607 1.284857 1.473685 0.314273 1.836871 0.060820 0.932547 0.420398 0.613590 1.461860 1.038061 1.203207 0.095116 1.584547 1.810340 0.624226 0.177690 0.397754 1.253072 0.802314 0.987311 1.879162 1.342549 1.566135 0.442620 1.908917 0.137619 1.011650 0.599336 0.755517 1.642027 1.174961 1.369054 0.211942 1.782659 -0.010486 0.840251 0.357521 0.581790 1.461271 1.014049 1.200403 0.044641 1.613689 1.808581 0.690100 0.250270 0.388899 1.294231 0.842257 1.021201 1.901029 1.462877 1.641210 0.546531 0.075531 0.291167 1.142643 0.703128 0.915213 1.799433 1.361706 1.526251 0.463549 1.971569 0.185024 1.029933 0.578985 0.824751 1.713096 1.250117 1.463497 0.301505 1.881822 0.143407 0.962817 0.507734 0.729352 1.590586 1.169240 1.393909 0.249757 1.802780 0.053110 0.895331 0.464179 0.669201 1.582612 1.097231 1.355127 0.231353 1.735403 0.021720 0.880348 0.431395 0.697354 1.573165 1.060767 1.347507 0.185124 1.772265 1.983494 0.879718 0.443530 0.687541 1.535902 1.151743 1.322419 0.212153 1.745041 -0.024853 0.929578 0.461659 0.706048 1.575808 1.122374 1.345663 0.241665 1.798693 0.038133 0.893828 0.497759 0.738405 1.619233 1.230529 1.391018 0.311367 1.875986 0.111417 0.982712 0.552692 0.779545 1.673926 1.277817 1.495634 0.424964 1.933807 0.193663 1.085748 0.635034 0.877002 1.797408 1.324014 1.603040 0.515913 0.114700 0.279027 1.230954 0.738758 0.971164 1.923699 1.522824 1.758904 0.629325 0.199968 0.431971 1.357304 0.920686 1.144660 0.047634 1.638457 1.887367 0.770386 0.339803 0.608798 1.474763 1.082399 1.336813 0.240373 1.815488 0.071521 0.978055 0.575127 0.812951 1.691650 1.236419 1.523987 0.428018 -0.014053 0.227398 1.211471 0.739843 1.033454 1.889876 1.490608 1.764875 0.650358 0.197774 0.479040 1.394298 0.990877 1.266721 0.153708 1.743738 1.993903 0.889105 0.452779 0.717556 1.641719 1.258531 1.472505 0.400527 0.003181 0.277816 1.190582 0.720088 1.018145 1.947482 1.529759 1.763205 0.679772 0.305019 0.551595 1.459782 1.056328 1.376741 0.254961 1.837237 0.083779 1.033490 0.597121 0.863372 1.752800 1.369817 1.661724 0.554009 0.132249 0.412929 1.366488 0.929237 1.205521 0.153686 1.780997 0.028187 0.910073 0.518459 0.747299 1.736440 1.285832 1.584544 0.515963 0.139650 0.379555 1.267964 0.869992 1.153100 0.094361 1.717865 1.955775 0.900339 0.490824 0.754072 1.676728 1.277159 1.570274 0.491155 0.127499 0.354589 1.327580 0.971916 1.203157 0.189781 1.749254 -0.000141 0.971242 0.569275 0.834995 1.792334 1.386324 1.620367 0.641313 0.177512 0.493821 1.395372 1.027112 1.276574 0.195767 1.840052 0.118782 1.057366 0.655353 0.981627 1.889857 1.497516 1.809949 0.727076 0.311895 0.619859 1.589373 1.177776 1.446089 0.402884 -0.013138 0.323859 1.242590 0.872932 1.139811 0.103389 1.705727 0.012476 0.932654 0.580713 0.844428 1.776557 1.375650 1.683357 0.653489 0.286018 0.530346 1.477873 1.102629 1.446550 0.391220 0.013493 0.315912 1.191737 0.889652 1.135899 0.064317 1.726753 0.008311 0.973187 0.561368 0.881325 1.835182 1.452878 1.728216 0.640203 0.296506 0.611465 1.537761 1.163681 1.521594 0.455106 0.113603 0.376193 1.335690 0.990813 1.252928 0.217355 1.798201 0.130538 1.099312 0.694187 1.042508 1.990873 1.625313 1.908796 0.833102 0.534393 0.775983 1.784275 1.381831 1.684754 0.630094 0.272616 0.575688 1.559911 1.184625 1.453679 0.491431 0.104067 0.400708 1.342106 0.977889 1.261797 0.248038 1.904884 0.237792 1.209205 0.805676 1.119936 0.155727 1.752922 0.098394 1.023110 0.709066 0.956558 1.945167 1.621782 1.885544 0.851378 0.511350 0.815303 1.752479 1.417551 1.712996 0.651328 0.341725 0.648800 1.652874 1.229749 1.564655 0.595314 0.162557 0.496357 1.536686 1.115189 1.443475 0.423294 0.108662 0.395018 1.332526 0.999816 1.352353 0.328398 1.960089 0.256657 1.276205 0.950110 1.251154 0.223763 1.856947 0.198310 1.202811 0.823347 1.139257 0.137493 1.791954 0.126818 1.077613 0.742716 1.034617 0.042667 1.702855 0.035869 0.942965 0.683955 0.962192 1.957952 1.636826 1.953521 0.904062 0.576569 0.908521 1.946168 1.527121 1.835900 0.915076 0.530360 0.860954 1.848124 1.476416 1.825816 0.801278 0.498232 0.791951 1.825898 1.460369 1.801238 0.807022 0.470147 0.775520 1.782957 1.421022 1.758922 0.747391 0.412834 0.729983 1.748458 1.430447 1.754281 0.725069 0.444203 0.754125 1.805117 1.457795 1.776284 0.724624 0.428724 0.744488 1.781494 1.483810 1.771396 0.825589 0.485350 0.772930 1.812210 1.489700 1.842892 0.808972 0.497919 0.826699 1.849758 1.501581 1.863781 0.830698 0.510646 0.856199 1.880392 1.487637 1.841337 0.883565 0.587660 0.933592 1.879899 1.575694 1.912690 0.882053 0.596355 0.876449 1.942318 1.604954 1.957913 0.991402 0.632658 0.965194 -0.031486 1.680264 0.039739 1.057207 0.660079 1.072774 0.084190 1.760660 0.122642 1.146243 0.783356 1.166710 0.158916 1.820281 0.220718 1.231907 0.956518 1.285669 0.300669 1.936753 0.315132 1.335110 1.060246 1.374454 0.394758 0.082667 0.417144 1.497357 1.121455 1.497524 0.558460 0.253594 0.585079 1.609798 1.353184 1.698378 0.628590 0.358364 0.702657 1.718959 1.448521 1.778728 0.811121 0.552978 0.858398 1.901305 1.551915 1.964990 1.006942 0.659821 0.990952 0.063543 1.773494 0.063737 1.160916 0.874963 1.254235 0.227903 1.909287 0.327897 1.310953 0.994777 1.331010 0.411728 0.136015 0.418712 1.516878 1.254075 1.541807 0.597800 0.341732 0.654709 1.684819 1.408026 1.806837 0.819367 0.523512 0.857369 1.895100 1.607979 1.949425 0.987941 0.703347 1.084034 0.136539 1.830122 0.250645 1.285193 0.947170 1.289548 0.328696 0.029933 0.461597 1.469311 1.207559 1.503925 0.619432 0.268080 0.678945 1.716381 1.398922 1.858266 0.884402 0.579547 0.942855 -0.007780 1.697643 0.060832 1.147089 0.859119 1.243156 0.279683 1.948552 0.303518 1.436858 1.120717 1.478393 0.523558 0.237367 0.599745 1.706188 1.421576 1.811698 0.850440 0.556037 0.945518 -0.871745 1.728994 0.072385 1.111766 0.835570 1.223297 0.269709 0.056622 0.355706 1.422876 1.147014 1.551471 0.600627 0.344660 0.724082 1.763987 1.516159 1.882823 0.942715 0.661410 1.033320 0.094097 1.855748 0.231455 1.280646 1.044202 1.442450 0.460350 0.194810 0.625856 1.678168 1.370560 1.773190 0.847696 0.600688 1.001562 0.035016 1.824811 0.145896 1.197674 0.963152 1.364275 0.436987 0.180547 0.564604 1.641854 1.399407 1.733896 0.850418 0.609483 0.927674)
)
))
@@ -4545,303 +4292,8 @@
;;; this includes cases involving all sines (0 and 1), as compared to all cosines (1/2 and 3/2)
-#|
- (with-sound (:channels 2 :clipped #f)
- (let* ((n 24)
- (c-phases (vct 1/2 1/2 1/2 1/2 1/2 3/2 1/2 1/2 1/2 3/2 1/2 1/2 1/2 3/2 3/2 3/2 3/2 3/2 1/2 3/2 1/2 1/2 3/2 1/2))
- (s-phases (vct 0 1 0 0 0 0 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 0 1 1))
-
- ;; n amp phase
-
- (cos-phases (make-vct 72))
- (sin-phases (make-vct 72)))
-
- (do ((i 0 (+ i 3))
- (j 0 (+ j 1)))
- ((= i 72))
- (set! (cos-phases i) (+ j 1))
- (set! (sin-phases i) (+ j 1))
- (set! (cos-phases (+ i 1)) 1.0)
- (set! (sin-phases (+ i 1)) 1.0)
- (set! (cos-phases (+ i 2)) (* pi (c-phases j)))
- (set! (sin-phases (+ i 2)) (* pi (s-phases j))))
-
- (let ((gen1 (make-polyoid 100.0 cos-phases))
- (gen2 (make-polyoid 100.0 sin-phases)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 88200))
- (outa i (polyoid gen1 0.0))
- (outb i (polyoid gen2 0.0)))))))
-
-(set! (mus-rand-seed) (current-time))
-(set! (print-length) 1000000)
-
-(define (vector-find-if func vect)
- (let ((len (vector-length vect))
- (result #f))
- (do ((i 0 (+ i 1)))
- ((or (= i len)
- result)
- result)
- (set! result (func (vect i))))))
-
-(define low-primes (vector 1
- 2 3 5 7 11 13 17 19 23
- 29 31 37 41 43 47 53 59 61
- 67 71 73 79 83 89 97 101 103
- 107 109 113 127 131 137 139 149 151
- 157 163 167 173 179 181 191 193 197
- 199 211 223 227 229 233 239 241 251
- 257 263 269 271 277 281 283 293 307
- 311 313 317 331 337 347 349 353 359
- 367 373 379 383 389 397 401 409 419
- 421 431 433 439 443 449 457 461 463
- 467 479 487 491 499 503 509 521 523
- 541 547 557 563 569 571 577 587 593
- 599 601 607 613 617 619 631 641 643
- 647 653 659 661 673 677 683 691 701
- 709 719 727 733 739 743 751 757 761
- 769 773 787 797 809 811 821 823 827
- 829 839 853 857 859 863 877 881 883
- 887 907 911 919 929 937 941 947 953
- 967 971 977 983 991 997 1009 1013 1019
- 1021 1031 1033 1039 1049 1051 1061 1063 1069
- 1087 1091 1093 1097 1103 1109 1117 1123 1129
- 1151 1153 1163 1171 1181 1187 1193 1201 1213
- 1217 1223 1229 1231 1237 1249 1259 1277 1279
- 1283 1289 1291 1297 1301 1303 1307 1319 1321
- 1327 1361 1367 1373 1381 1399 1409 1423 1427
- 1429 1433 1439 1447 1451 1453 1459 1471 1481
- 1483 1487 1489 1493 1499 1511 1523 1531 1543
- 1549 1553 1559 1567 1571 1579 1583 1597 1601
- 1607 1609 1613 1619 1621 1627 1637 1657 1663
- 1667 1669 1693 1697 1699 1709 1721 1723 1733))
-
-(define (get-fft-size choice n1)
- (let ((n (if (eq? choice :all) n1
- (if (not (eq? choice :prime)) (* 2 n1)
- (low-primes n1)))))
- (min (expt 2 16)
- (expt 2 (ceiling (/ (log (* n 64)) (log 2)))))))
-
-(define (random n)
- (if (rational? n)
- (mus-irandom n)
- (mus-frandom n)))
-
-(define pi2 (/ pi 2))
-(define data-file "test.data")
-
-(define (save-case n choice peak phases)
- (let ((fd (open-output-file data-file "a")))
- (format fd "~%;~A: ~A ~A #(" n choice peak)
- (do ((m 0 (+ 1 m)))
- ((= m n))
- (if (zero? (phases m))
- (format fd "0")
- (format fd "1"))
- (if (< m (- n 1))
- (format fd " ")))
- (format fd ")~%")
- (close-output-port fd)))
-
-(define (try-any)
- (let ((choice (let ((v (random 4)))
- (case v
- ((0) :all)
- ((1) :even)
- ((2) :odd)
- (else :prime))))
- (n (+ 24 (random 104))))
- (let* ((size (get-fft-size choice n))
- (tries (if (not (eq? choice :prime)) 2500000 500000))
- (fft-rl (make-vct size))
- (fft-im (make-vct size)))
-
- (format #t ";~D ~A~%" n choice)
-
- (let* ((cur-min 1000.0)
- (phases (make-vct n 0.0)))
- (let ((min-val (vector-find-if (lambda (val)
- (and val
- (vector? val)
- (= (val 0) n)
- (let ((a-val (val 1))
- (a-len (vector-length val)))
- (do ((k 2 (+ 1 k)))
- ((= k a-len))
- (if (and (number? (val k))
- (< (val k) a-val))
- (set! a-val (val k))))
- a-val)))
- (if (eq? choice :all)
- noid-min-peak-phases
- (if (eq? choice :odd)
- nodd-min-peak-phases
- (if (eq? choice :even)
- neven-min-peak-phases
- primoid-min-peak-phases))))))
- (if (and (number? min-val)
- (< min-val cur-min))
- (set! cur-min min-val)))
-
- (let ((nc (if (eq? choice :all) 0
- (if (eq? choice :odd) 1
- (if (eq? choice :even) 2 3)))))
-
- (run
- (lambda ()
-
- (do ((try 0 (+ 1 try)))
- ((= try tries))
- (do ((i 1 (+ 1 i)))
- ((= i n))
- (if (> (random 1.0) 0.5)
- (set! (phases i) pi)
- (set! (phases i) 0.0)))
- (clear-array fft-rl)
- (clear-array fft-im)
-
- (do ((k 0 (+ k 1)))
- ((= k n))
- (let ((phi (+ (phases k) pi2))
- (bin (if (= nc 0) (+ k 1)
- (if (= nc 1) (+ 1 (* k 2))
- (if (= nc 2) (max 1 (* k 2))
- (low-primes k))))))
- (set! (fft-rl bin) (cos phi))
- (set! (fft-im bin) (sin phi))))
-
- (let ((peak (vct-peak (mus-fft fft-rl fft-im size -1))))
- (if (< peak cur-min)
- (begin
- (save-case n choice peak phases)
- (format #t ";~A: ~A ~A #(" n choice peak)
- (do ((m 0 (+ 1 m)))
- ((= m n))
- (if (zero? (phases m))
- (format #t "0")
- (format #t "1"))
- (if (< m (- n 1))
- (format #t " ")))
- (format #t ")~%")
- (set! cur-min peak))))
- )))))))
-
- (set! (mus-rand-seed) (current-time))
- (try-any))
-
-(define* (try-all (num-threads 2) (data "test.data"))
- (set! data-file data)
- (let ((threads '()))
- (do ((i 0 (+ i 1)))
- ((= i num-threads))
- (set! threads (cons (make-thread try-any) threads)))
- (for-each
- (lambda (thread)
- (join-thread thread))
- threads)))
-
-;;; then once a new local minimum is found,
-(define (optit choice n)
- (let* ((size (get-fft-size choice n))
- (fft-rl (make-vct size))
- (fft-im (make-vct size)))
-
- (let* ((phases (make-vct n 0.0))
- (min-phase 0.0)
- (min-phases (make-vector n 0)))
- (let* ((min-val (vector-find-if (lambda (val)
- (and val
- (vector? val)
- (= (val 0) n)
- (let ((a-val (val 1))
- (a-len (vector-length val))
- (a-data (val 2)))
- (do ((k 3 (+ 1 k)))
- ((= k a-len))
- (if (and (number? (val k))
- (< (val k) a-val))
- (begin
- (set! a-val (val k))
- (set! a-data (val (+ k 1))))))
- (list a-val a-data))))
- (if (eq? choice :all)
- noid-min-peak-phases
- (if (eq? choice :odd)
- nodd-min-peak-phases
- (if (eq? choice :even)
- neven-min-peak-phases
- primoid-min-peak-phases)))))
- (cur-min (car min-val))
- (cur-phases (cadr min-val)))
-
- (set! min-phase cur-min)
- ;(format #t "~A ~A: ~A~%" choice n cur-min)
-
- (let ((nc (if (eq? choice :all) 0
- (if (eq? choice :odd) 1
- (if (eq? choice :even) 2 3))))
- (inc 1))
-
- (do ()
- ((> inc 1))
-
- (do ((i 1 (+ i 1)))
- ((= i n))
- (let ((old-val (cur-phases i)))
- (do ((k 0 (+ k 1)))
- ((> k inc))
- (if (not (= old-val (/ k inc)))
- (begin
- (set! (cur-phases i) (/ k inc))
-
- (clear-array fft-rl)
- (clear-array fft-im)
-
- (do ((m 0 (+ m 1)))
- ((= m n))
- (let ((phi (+ (* pi (cur-phases m)) pi2))
- (bin (if (= nc 0) (+ m 1)
- (if (= nc 1) (+ 1 (* m 2))
- (if (= nc 2) (max 1 (* m 2))
- (low-primes m))))))
- (set! (fft-rl bin) (cos phi))
- (set! (fft-im bin) (sin phi))))
-
- (let ((peak (vct-peak (mus-fft fft-rl fft-im size -1))))
- (if (< peak min-phase)
- (begin
- (do ((m 0 (+ 1 m)))
- ((= m n))
- (set! (min-phases m) (cur-phases m)))
- (set! min-phase peak))))
-
- (set! (cur-phases i) old-val))))))
-
- ;(format #t "~D: ~A~%" inc min-phase)
-
- (if (< min-phase (- cur-min .001))
- (begin
- (do ((m 0 (+ m 1)))
- ((= m n))
- (set! (cur-phases m) (min-phases m)))
- (set! cur-min min-phase)
- (if (= inc 1)
- (format #t ";~A: ~A ~A ~A~%" n choice cur-min cur-phases)))
- (begin
- (set! inc (* inc 2))))))
-
-
- ;(format #t ";~A: ~A ~A ~A~%" n choice cur-min cur-phases)
- ))))
-|#
-
-
-
(define (tstodd phs)
- (let ((len (vector-length phs))
+ (let ((len (length phs))
(incr 0.0001)
(mx 0.0)
(loc 0.0))
@@ -4859,15 +4311,16 @@
(define (tstoddderiv x phs)
(let ((sum 0.0)
- (len (vector-length phs)))
+ (len (length phs)))
(do ((i 0 (+ i 1))
(j 1 (+ j 2)))
((= i len) sum)
(set! sum (+ sum (* j (cos (+ (* j x) (* pi (phs i))))))))))
-(define (tstall phs)
- (let ((len (vector-length phs))
+(define* (tstall phs phs1)
+ (if (real? phs) (set! phs phs1))
+ (let ((len (length phs))
(incr 0.0001)
(mx 0.0)
(loc 0.0))
@@ -4884,7 +4337,7 @@
(set! loc x)))))))
(define (tstallf mult phs)
- (let ((len (vector-length phs))
+ (let ((len (length phs))
(incr 0.0001)
(mx 0.0)
(loc 0.0))
@@ -4903,7 +4356,7 @@
(set! loc x)))))))
(define (tsteven phs)
- (let ((len (vector-length phs))
+ (let ((len (length phs))
(incr 0.0001)
(mx 0.0)
(loc 0.0))
@@ -4919,7 +4372,7 @@
(set! loc x)))))))
(define (tstprime phs)
- (let ((len (vector-length phs))
+ (let ((len (length phs))
(incr 0.0001)
(mx 0.0)
(loc 0.0))
@@ -4936,7 +4389,7 @@
(define (tstallderiv x phs)
(let ((sum 0.0)
- (len (vector-length phs)))
+ (len (length phs)))
(do ((i 0 (+ i 1))
(j 1 (+ j 1)))
((= i len) sum)
@@ -4946,7 +4399,7 @@
(define (get-best choice n)
(define (vector-find-if func vect)
- (let ((len (vector-length vect))
+ (let ((len (length vect))
(result #f))
(do ((i 0 (+ i 1)))
((or (= i len)
@@ -4959,7 +4412,7 @@
(vector? val)
(= (val 0) n)
(let ((a-val (val 1))
- (a-len (vector-length val))
+ (a-len (length val))
(a-data (val 2)))
(do ((k 3 (+ 1 k)))
((= k a-len))
@@ -4981,7 +4434,7 @@
(let* ((phs-data (get-best :all len))
(phs (cadr phs-data))
(mx (car phs-data))
- (v (make-vct (ceiling (+ (* 2 pi 1000) 2))))
+ (v (make-float-vector (ceiling (+ (* 2 pi 1000) 2))))
(incr 0.001))
(do ((x 0.0 (+ x incr))
(i 0 (+ i 1)))
@@ -4992,38 +4445,70 @@
((= k len))
(set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))
(set! (v i) val)))
- (let ((ns (new-sound)))
- (vct->channel v)
- (set! (y-bounds) (list (- mx) mx)))))
-
+ (new-sound)
+ (float-vector->channel v)
+ (set! (y-bounds) (list (- mx) mx))))
+
+(define (showphases mx phs)
+ (let ((v (make-float-vector (ceiling (+ (* 2 pi 1000) 2))))
+ (incr 0.001)
+ (len (length phs)))
+ (do ((x 0.0 (+ x incr))
+ (i 0 (+ i 1)))
+ ((> x (* 2 pi)))
+ (let ((val 0.0))
+ (do ((k 0 (+ k 1))
+ (j 1 (+ j 1)))
+ ((= k len))
+ (set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))
+ (set! (v i) val)))
+ (new-sound)
+ (float-vector->channel v)
+ (set! (y-bounds) (list (- mx) mx))))
-(define (get-worst-overall choice choices)
- (let ((diffs (make-vector 116))
- (total 0.0)
- (this 0.0)
- (last 0.0)
- (next 0.0)
- (choice-list '())
- (first (car (get-best choice 11))))
- (set! this first)
- (set! next (car (get-best choice 12)))
- (do ((i 12 (+ i 1)))
- ((= i 128))
- (set! last this)
- (set! this next)
- (set! next (car (get-best choice (+ i 1))))
- (set! (diffs (- i 12)) (cons i (+ (- this last) (- this next))))
- (set! total (+ total (abs (- this last)))))
- (sort! diffs (lambda (a b)
- (> (cdr a) (cdr b))))
- (do ((i (- choices 1) (- i 1)))
- ((< i 0))
- (let ((c (diffs i)))
- (set! choice-list (cons (diffs i) choice-list))))
-
- (list choice-list (- (+ total first) this)))) ; first to this would be a straight line
+(define (showodd len)
+ (let* ((phs-data (get-best :odd len))
+ (phs (cadr phs-data))
+ (mx (car phs-data))
+ (v (make-float-vector (ceiling (+ (* 2 pi 1000) 2))))
+ (incr 0.001))
+ (do ((x 0.0 (+ x incr))
+ (i 0 (+ i 1)))
+ ((> x (* 2 pi)))
+ (let ((val 0.0))
+ (do ((k 0 (+ k 1))
+ (j 1 (+ j 2)))
+ ((= k len))
+ (set! val (+ val (sin (+ (* j x) (* pi (phs k)))))))
+ (set! (v i) val)))
+ (new-sound)
+ (float-vector->channel v)
+ (set! (y-bounds) (list (- mx) mx))))
+
+(define (showdiff n1 n2)
+ (let* ((len (length n1))
+ (data (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (data i) (modulo (- (n1 i) (n2 i)) 2.0))
+ (if (> (data i) 1.0)
+ (set! (data i) (- (data i) 2.0))
+ (if (< (data i) -1)
+ (set! (data i) (+ (data i) 2.0)))))
+ (new-sound)
+ (float-vector->channel data)
+ ))
+
+(define (differ snd)
+ (let ((x 0.0))
+ (map-channel
+ (lambda (y)
+ (let ((res (- y x)))
+ (set! x y)
+ res))
+ 0 #f snd 0)))
(define (find-other-mins peak-amp peak-phases)
@@ -5035,7 +4520,7 @@
(let ((temp-phases (copy peak-phases))
(n (length peak-phases))
- (results '()))
+ (results ()))
;; flip evens
(do ((i 1 (+ i 2)))
@@ -5066,28 +4551,78 @@
(format #t ";~A -> ~A?~%" peak-amp val))
(set! results (cons (list val temp-phases) results)))
- (format #f "~{~{~,8F ~A~%~}~}" (reverse results))
+; (format #f "~{~{~,8F ~A~%~}~}" (reverse results))
results
))
-;;; :(find-other-mins (car (tstall #(0.0 0.1 0.2 0.3))) #(0.0 0.1 0.2 0.3))
-;;; 3.49630991 #(0.0 1.1 0.2 1.3)
-;;; 3.49630680 #(0.0 1.9 1.8 1.7)
-;;; 3.49630979 #(0.0 0.9 1.8 0.7)
+;;; :(find-other-mins (car (tstall (fv 0.0 0.1 0.2 0.3))) (fv 0.0 0.1 0.2 0.3))
+;;; 3.49630991 (fv 0.0 1.1 0.2 1.3)
+;;; 3.49630680 (fv 0.0 1.9 1.8 1.7)
+;;; 3.49630979 (fv 0.0 0.9 1.8 0.7)
+
-(set! (print-length) 123123)
+
+(define (canonicalize-one i p)
+ (let ((data (get-best :all i)))
+ (let ((old-peak (car data))
+ (old-phases (cadr data)))
+ (let ((phases (copy old-phases)))
+ (if (< (phases 2) -1.0)
+ (set! (phases 2) (+ (phases 2) 2.0))
+ (if (> (phases 2) 1.0)
+ (set! (phases 2) (- (phases 2) 2.0))))
+ (if (< (phases 2) 0.0)
+ (do ((j 1 (+ j 1)))
+ ((>= j i))
+ (set! (phases j) (modulo (- 2.0 (phases j)) 2.0))))
+ (if (< (phases 1) -1.0)
+ (set! (phases 1) (+ (phases 1) 2.0))
+ (if (> (phases 1) 1.0)
+ (set! (phases 1) (- (phases 1) 2.0))))
+ (if (< (phases 1) 0.0) ; this is an "even" harmonic
+ (do ((j 1 (+ j 2)))
+ ((>= j i))
+ (set! (phases j) (modulo (+ 1.0 (phases j)) 2.0))))
+ (do ((j 1 (+ j 1)))
+ ((= j i))
+ (if (< (phases j) -1.0)
+ (set! (phases j) (+ (phases j) 2.0))
+ (if (> (phases j) 1.0)
+ (set! (phases j) (- (phases j) 2.0)))))
+ (let ((new-peak-info (tstall phases)))
+ (let ((new-peak (car new-peak-info)))
+ (if (> (abs (- new-peak old-peak)) .001)
+ (format *stderr* "oops: ~D: ~A ~A~%" i old-peak new-peak))
+ (format p "(vector ~D ~,6F (fv " i new-peak)
+ (do ((k 1 (+ k 1)))
+ ((= k i))
+ (format p "~,6F " (phases (- k 1))))
+ (format p "~,6F))~% ;; loc: ~F~%~%" (phases (- i 1)) (/ (cadr new-peak-info) pi))))))))
+
+(define (canonicalize)
+ ;; this is slow because we call tstall on each one
+ (call-with-output-file "pp4.scm"
+ (lambda (p)
+ (format p "(define noid-min-peak-phases (vector~%~%(vector 1 1.0 (fv 0))~%(vector 2 1.76 (fv 0 0))~%~%")
+ (do ((i 3 (+ i 1)))
+ ((> i 128))
+ (format *stderr* "~D " i)
+ (canonicalize-one i p))
+ (format p "))~%"))))
+
+(if (provided? 'snd) (set! (print-length) 123123) (set! (*s7* 'print-length) 123123))
(define (show-mins i)
(let ((data (get-best :all i)))
(let ((other-mins (apply find-other-mins data)))
(let ((pk1 (cadr data))
- (pk2 (cadr (car other-mins)))
- (pk3 (cadr (cadr other-mins)))
+ (pk2 (cadar other-mins))
+ (pk3 (cadadr other-mins))
(pk4 (cadr (caddr other-mins))))
- (if (or (> (abs (- (car (car other-mins)) (car data))) .001)
- (> (abs (- (car (cadr other-mins)) (car data))) .001)
- (> (abs (- (car (caddr other-mins)) (car data))) .001))
+ (if (or (> (abs (- (caar other-mins) (car data))) .001)
+ (> (abs (- (caadr other-mins) (car data))) .001)
+ (> (abs (- (caaddr other-mins) (car data))) .001))
(format #t "trouble in ~D: ~A ~A~%" i data other-mins))
(let ((phases (sort! (list pk1 pk2 pk3 pk4)
@@ -5121,56 +4656,83 @@
;; 1 Jun 4261.356
;; 1 Jul 4244.312, sqrts: 82 74 0 0
;; 1 Aug 4218.456, sqrts: 82 74 0 0
-;; 1 Sep 4209.464, sqrts: 85 74 0 0
-;; 1 Oct 4202.347, sqrts: 89 75 0 0
-;; 1 Nov 4198.764, sqrts: 94 78 0 0
-;; 1 Dec 4196.395, sqrts: 98 84 0 0
+;; 1 Sep 4209.464, sqrts: 85 74 0 0 (9.5330)
+;; 1 Oct 4202.347, sqrts: 89 75 0 0 (6.9438)
+;; 1 Nov 4198.764, sqrts: 94 78 0 0 (5.5196)
+;; 1 Dec 4196.395, sqrts: 98 84 0 0 (4.1226)
;; (11)
-;; 1 Jan 4194.669, sqrts: 101 91 0 0
-;; 1 Feb 4194.106, sqrts: 105 91 0 0
-;; 1 Mar 4193.048, sqrts: 110 95 0 0
-
-; all 0.4861 (20) to 0.5035 (110), dist: 0.8209, 7.6497
-; odd 0.4821 (11) to 0.5030 (85), dist: 1.6845, 6.5585
-; even 0.5103 (99) to 0.5244 (22), dist: 67.5138, 0.0000
-; prime 0.5448 (24) to 0.5634 (117), dist: 254.3740, 0.0000
-
-; all 0.4861 (20) to 0.5012 (110), dist: 0.4150, 7.8239
-; odd 0.4821 (11) to 0.5025 (124), dist: 1.2712, 6.6233
-; even 0.5103 (99) to 0.5244 (22), dist: 67.5138, 0.0000
-; prime 0.5448 (24) to 0.5634 (117), dist: 254.3740, 0.0000
-
+;; 1 Jan 4194.669, sqrts: 101 91 0 0 (2.9465)
+;; 1 Feb 4194.106, sqrts: 105 91 0 0 (2.5054)
+;; 1 Mar 4193.048, sqrts: 110 95 0 0 (1.6862)
+;; 1 Apr 4188.373, sqrts: 114 104 0 0 (0.8505)
+;; 1 May 4186.610, sqrts: 114 105 0 0 (0.6439)
+;; 1 Jun 4186.498, sqrts: 115 105 0 0 (0.5422)
+;; 1 Nov 4186.465, sqrts: 116 105 0 0 (0.5095)
+;; 1 Dec 4186.315, sqrts: 117 108 0 0 (0.4198)
+;; (12)
+;; 1 Jan 4185.693, sqrts: 118 112 0 0 (0.3225)
+;; 1 Feb 4185.458, sqrts: 119 113 0 0 (0.2534)
+;; 1 Mar 4185.289, sqrts: 119 115 0 0 (0.1710)
+;; 1 Apr 4185.029, sqrts: 120 115 0 0 (0.1464)
+;; 1 Nov 4184.742, sqrts: 120 115 0 0 (0.1429)
+;; 1 Dec 4184.727, sqrts: 121 115 0 0 (0.1349)
+;; (13)
+;; 1 Feb 4184.520, sqrts: 122 115 0 0 (0.1159)
+;; 1 Jun 4184.160, sqrts: 122 118 0 0 (0.0926)
+;; 1 Aug 4183.948, sqrts: 122 118 0 0 (0.0440)
+;; 1 Sep 4183.825, sqrts: 122 119 0 0 (0.0382)
+;; 1 Oct 4183.673, sqrts: 122 119 0 0 (0.0382)
+;; 1 Nov 4183.616, sqrts: 122 119 0 0 (0.0382)
+;; 1 Dec 4183.180, sqrts: 122 120 0 0 (0.0361)
+;; (14)
+;; 1 Jan 4183.004, sqrts: 122 120 0 0 (0.0346)
+;; 1 Mar 4182.956, sqrts: 122 120 0 0 (0.0346)
+;; 1 Apr 4182.919, sqrts: 122 120 0 0 (0.0346)
+;; 1 May 4182.759, sqrts: 122 120 0 0 (0.0346)
+;; 1 Jun 4177.414, sqrts: 122 120 0 0 (0.0346)
+;; 1 Jul 4174.620, sqrts: 122 120 0 0 (0.0346)
+;; 1 Aug 4171.810, sqrts: 122 120 0 0 (0.0346)
+;; 1 Sep 4169.400, sqrts: 122 120 0 0 (0.0346)
+;; 1 Oct 4166.886, sqrts: 122 121 0 0 (0.0242)
+;; 1 Nov 4163.522, sqrts: 122 122 0 0 (0.0000)
+;; 1 Dec 4161.032, sqrts: 122 122 0 0 (0.0000)
+;; (15)
+;; 1 Jan 4158.938
+;; 1 Feb 4156.526
+;; 1 Mar 4154.769
+;; 1 Apr 4154.180
+;; 1 May 4153.716
+;; 1 Jun 4153.330
+;; 1 Jul 4152.859
+;; 1 Aug 4152.637
+;; 1 Sep 4152.306
+;; 1 Oct 4152.200
+;; 1 Nov 4152.089
+
+; all 0.4860 (20) to 0.4987 (106), dist: 0.0000, 13.5427
+; odd 0.4820 (11) to 0.5000 (112), dist: 0.0000, 8.5572
+; even 0.5085 (115) to 0.5242 (22), dist: 57.6719, 0.0000
+; prime 0.5445 (24) to 0.5540 (67), dist: 232.5954, 0.0000
;(test-all-phases #f) in test-phases.scm
#|
-:(load "test-phases.scm")
-test-all-phases
-:(test-all-phases #f)
-;all peaks... Tue 01-Mar-2011 03:16
-;all 512: peak-phases value: 31.391244, current: 31.393507890848, diff: 0.0022638908477184
-;all 1024: peak-phases value: 49.867216, current: 49.863543040531, diff: -0.0036729594690925
-(0.0036729594690925 1024)
-;odd peaks... Tue 01-Mar-2011 03:46
-;odd 2048: peak-phases value: 78.937441, current: 78.931916185936, diff: -0.0055248140642448
-(0.0055248140642448 2048)
-;even peaks... Tue 01-Mar-2011 04:15
-;even 256: peak-phases value: 21.147051, current: 21.149844044205, diff: 0.0027930442051805
-;even 512: peak-phases value: 31.628149, current: 31.625265493922, diff: -0.0028835060781311
-;even 1024: peak-phases value: 51.627202, current: 51.61731817532, diff: -0.0098838246798678
-;even 2048: peak-phases value: 78.079325, current: 78.055349684919, diff: -0.023975315080577
-(0.023975315080577 2048)
-;prime peaks... Tue 01-Mar-2011 04:52
-;prime 124: peak-phases value: 14.905565, current: 14.903183245254, diff: -0.0023817547457075
-;prime 256: peak-phases value: 25.419292, current: 25.416395401039, diff: -0.0028965989614846
-(0.0028965989614846 256)
-;all done! Tue 01-Mar-2011 05:16
+<2> (test-all-phases #f)
+;all peaks... Mon 26-Oct-2015 13:11
+(0.001495737399423547 101)
+;odd peaks... Mon 26-Oct-2015 13:17
+(0.001687315629258279 125)
+;even peaks... Mon 26-Oct-2015 13:21
+(0.001467169674692848 4)
+;prime peaks... Mon 26-Oct-2015 13:25
+(0.001975582609148319 2048)
+;all done! Mon 26-Oct-2015 13:30
+";all done! Mon 26-Oct-2015 13:30
|#
;;; gad161: clean-up-evens
-;;; t139.scm: show-circles
-;;; t241.scm: canonicalize
-
-;;; at x=0 we have sum sin(phi) for each phase -- this might speed up the initial check
-
-
+;;; t139.scm: show-circle (Motif-based)
+;;; t283.scm: poly stuff
+;;; tmp26.scm sqrt graph
+;;; t404.scm for averages, graphed via graph-averages.scm
+;;; t405.scm for function searcher
diff --git a/piano.scm b/piano.scm
index daf9edc..5091c67 100644
--- a/piano.scm
+++ b/piano.scm
@@ -1,52 +1,12 @@
;;; CLM piano.ins (Scott Van Duyne) translated to Snd/Scheme
(provide 'snd-piano.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
-(if (not (provided? 'snd-generators.scm)) (load "generators.scm"))
-
-
-(defgenerator one-pole-allpass (coeff 0.0) (x1 0.0) (y1 0.0))
-
-(define (one-pole-allpass gen input)
- (declare (gen one-pole-allpass) (input float))
- (let* ((coeff (one-pole-allpass-coeff gen))
- (y1 (one-pole-allpass-y1 gen))
- (x1 (one-pole-allpass-x1 gen)))
- (set! (one-pole-allpass-y1 gen) (+ (* coeff (- input y1)) x1))
- (set! (one-pole-allpass-x1 gen) input)
- (one-pole-allpass-y1 gen)))
-
-
-(defgenerator expseg (currentValue 0.0) (targetValue 0.0)) ; (like musickit asymp)
-
-(define (expseg gen r)
- (declare (gen expseg) (r float))
- (let ((cv (expseg-currentValue gen))
- (tv (expseg-targetValue gen)))
- (set! (expseg-currentValue gen) (+ cv (* (- tv cv) r)))
- cv)) ; (bil) this is slightly different (getting clicks)
-
-
-(defgenerator one-pole-swept (y1 0.0))
-
-(define (one-pole-swept gen input coef)
- (declare (gen one-pole-swept) (input float) (coeff float))
- ;; signal controlled one-pole lowpass filter
- (set! (one-pole-swept-y1 gen) (- (* (+ 1 coef) input) (* coef (one-pole-swept-y1 gen))))
- (one-pole-swept-y1 gen))
-
-
-(defgenerator pnoise (seed 16383))
-
-(define (pnoise gen amp)
- (declare (gen pnoise) (amp float))
- ;; very special noise generator
- (set! (pnoise-seed gen) (logand (+ (* (pnoise-seed gen) 1103515245) 12345) #xffffffff))
- ;; (bil) added the logand -- otherwise we get an overflow somewhere
- (* amp (- (* (modulo (floor (/ (pnoise-seed gen) 65536)) 65536) 0.0000305185) 1.0)))
-
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(require snd-env.scm)
+;;; see generators.scm for the old scheme versions of one-pole-all-pass, pnoise, one-pole-swept, and expseg
(define number-of-stiffness-allpasses 8)
(define longitudinal-mode-cutoff-keynum 29)
@@ -104,15 +64,15 @@
(definstrument (p start (duration 1.0)
(keyNum 60.0) ; middleC=60: can use fractional part to detune
(strike-velocity 0.5) ; corresponding normalized velocities (range: 0.0--1.0)
- (pedal-down #f) ; set to #t for sustain pedal down...pedal-down-times not yet implemented
+ pedal-down ; set to #t for sustain pedal down...pedal-down-times not yet implemented
(release-time-margin 0.75) ; extra compute time allowed beyond duration
(amp .5) ; amp scale of noise inputs...
;;slider controls
(detuningFactor 1.0)
- (detuningFactor-table '())
+ (detuningFactor-table ())
(stiffnessFactor 1.0)
- (stiffnessFactor-table '())
+ (stiffnessFactor-table ())
(pedalPresenceFactor .3)
(longitudinalMode 10.5)
(StrikePositionInvFac -0.9)
@@ -167,10 +127,7 @@
(unaCordaGain-table default-unaCordaGain-table))
;; converts t60 values to suitable :rate values for expseg
- (define (In-t60 t60) (- 1.0 (expt 0.001 (/ 1.0 t60 (mus-srate)))))
-
- (define (one-pole-one-zero f0 f1 input)
- (one-zero f0 (one-pole f1 input)))
+ (define (In-t60 t60) (- 1.0 (expt 0.001 (/ 1.0 t60 *clm-srate*))))
(define (make-one-pole-one-zero a0 a1 b1)
(list (make-one-zero a0 a1)
@@ -192,6 +149,12 @@
(+ 1 (* a1 c)))
(* b1 s a1 s)))))
+ (define (signum n)
+ ;; in CL this returns 1.0 if n is float
+ (if (positive? n) 1
+ (if (zero? n) 0
+ -1)))
+
(define (get-allpass-coef samp-frac wT)
(let ((ta (tan (- (* samp-frac wT))))
(c (cos wT))
@@ -199,13 +162,9 @@
(/ (+ (- ta)
(* (signum ta)
(sqrt (* (+ 1 (* ta ta))
- (* s s)))))
+ (* s s))))) ; is this correct? it's in the original
(- (* c ta) s))))
- (define (signum x)
- (if (= x 0.0) 0
- (if (< x 0.0) -1 1)))
-
(define (apfloor len wT)
(let* ((len-int (floor len))
(len-frac (- len len-int)))
@@ -221,7 +180,7 @@
(list len-int (get-allpass-coef len-frac wT))))
(define (tune-piano frequency stiffnessCoefficient numAllpasses b0 b1 a1)
- (let* ((wT (/ (* frequency two-pi) (mus-srate)))
+ (let* ((wT (/ (* frequency two-pi) *clm-srate*))
(len (/ (+ two-pi
(* numAllpasses
(apPhase stiffnessCoefficient wT))
@@ -229,227 +188,239 @@
wT)))
(apfloor len wT)))
- (let* ((beg (seconds->samples start))
- (end (+ beg (seconds->samples (+ duration release-time-margin))))
- (dur (floor (* duration (mus-srate))))
- (freq (* 440.0 (expt 2.0 (/ (- keyNum 69.0) 12.0))))
- (wT (/ (* two-pi freq) (mus-srate)))
-
- ;;look-up parameters in tables (or else use the override value)
- (loudPole (or loudPole (envelope-interp keyNum loudPole-table)))
- (softPole (or softPole (envelope-interp keyNum softPole-table)))
- (loudGain (or loudGain (envelope-interp keyNum loudGain-table)))
- (softGain (or softGain (envelope-interp keyNum softGain-table)))
-
- (strikePosition (or strikePosition (envelope-interp keyNum strikePosition-table)))
- (detuning2 (or detuning2 (envelope-interp keyNum detuning2-table)))
- (detuning3 (or detuning3 (envelope-interp keyNum detuning3-table)))
- (stiffnessCoefficient (or stiffnessCoefficient (envelope-interp keyNum stiffnessCoefficient-table)))
- (singleStringDecayRate-1 (or singleStringDecayRate (envelope-interp keyNum singleStringDecayRate-table)))
- (singleStringDecayRate (* singleStringDecayRateFactor singleStringDecayRate-1))
- (singleStringZero (or singleStringZero (envelope-interp keyNum singleStringZero-table)))
- (singleStringPole (or singleStringPole (envelope-interp keyNum singleStringPole-table)))
-
- (releaseLoopGain (or releaseLoopGain (envelope-interp keyNum releaseLoopGain-table)))
- (DryTapFiltCoeft60 (or DryTapFiltCoeft60 (envelope-interp keyNum DryTapFiltCoeft60-table)))
- (DryTapFiltCoefTarget (or DryTapFiltCoefTarget (envelope-interp keyNum DryTapFiltCoefTarget-table)))
- (DryTapFiltCoefCurrent (or DryTapFiltCoefCurrent (envelope-interp keyNum DryTapFiltCoefCurrent-table)))
- (DryTapAmpt60 (or DryTapAmpt60 (envelope-interp keyNum DryTapAmpt60-table)))
- (sustainPedalLevel (or sustainPedalLevel (envelope-interp keyNum sustainPedalLevel-table)))
- (pedalResonancePole (or pedalResonancePole (envelope-interp keyNum pedalResonancePole-table)))
- (pedalEnvelopet60 (or pedalEnvelopet60 (envelope-interp keyNum pedalEnvelopet60-table)))
- (soundboardCutofft60 (or soundboardCutofft60 (envelope-interp keyNum soundboardCutofft60-table)))
- (DryPedalResonanceFactor (or DryPedalResonanceFactor (envelope-interp keyNum DryPedalResonanceFactor-table)))
- (unaCordaGain (or unaCordaGain (envelope-interp keyNum unaCordaGain-table)))
- (detuningFactor (if (null? detuningFactor-table) (envelope-interp keyNum detuningFactor-table) detuningFactor))
- (stiffnessFactor (if (null? stiffnessFactor-table) (envelope-interp keyNum stiffnessFactor-table) stiffnessFactor))
-
- ;;initialize soundboard impulse response elements
-
- (dryTap-one-pole-one-zero-pair (make-one-pole-one-zero 1.0 0.0 0.0))
- (dryTap0 (car dryTap-one-pole-one-zero-pair))
- (dryTap1 (cadr dryTap-one-pole-one-zero-pair))
-
- (dryTap-coef-expseg (make-expseg :currentValue DryTapFiltCoefCurrent :targetValue DryTapFiltCoefTarget))
- (drycoefrate (In-t60 DryTapFiltCoeft60))
- (dryTap-one-pole-swept (make-one-pole-swept))
- (dryTap-amp-expseg (make-expseg :currentValue 1.0 :targetValue 0.0))
- (dryamprate (In-t60 DryTapAmpt60))
-
- ;;initialize open-string resonance elements
- (wetTap-one-pole-one-zero-pair (make-one-pole-one-zero (- 1.0 (* (signum pedalResonancePole) pedalResonancePole)) 0.0 (- pedalResonancePole)))
- (wetTap0 (car wetTap-one-pole-one-zero-pair))
- (wetTap1 (cadr wetTap-one-pole-one-zero-pair))
-
- (wetTap-coef-expseg (make-expseg :currentValue 0.0 :targetValue -.5))
- (wetcoefrate (In-t60 pedalEnvelopet60))
- (wetTap-one-pole-swept (make-one-pole-swept))
- (wetTap-amp-expseg (make-expseg :currentValue (* sustainPedalLevel pedalPresenceFactor (if pedal-down 1.0 DryPedalResonanceFactor))
- :targetValue 0.0))
- (wetamprate (In-t60 pedalEnvelopet60))
- (sb-cutoff-rate (In-t60 soundboardCutofft60))
-
- ;;initialize velocity-dependent piano hammer filter elements
- (hammerPole (+ softPole (* (- loudPole softPole) strike-velocity)))
- (hammerGain (+ softGain (* (- loudGain softGain) strike-velocity)))
- (hammer-one-pole (make-vector 4))
-
- ;;strike position comb filter delay length
- (agraffe-len (/ (* (mus-srate) strikePosition) freq)))
+ (let (;;look-up parameters in tables (or else use the override value)
+ (loudPole (or loudPole (envelope-interp keyNum loudPole-table)))
+ (softPole (or softPole (envelope-interp keyNum softPole-table)))
+ (loudGain (or loudGain (envelope-interp keyNum loudGain-table)))
+ (softGain (or softGain (envelope-interp keyNum softGain-table)))
+
+ (strikePosition (or strikePosition (envelope-interp keyNum strikePosition-table)))
+ (detuning2 (or detuning2 (envelope-interp keyNum detuning2-table)))
+ (detuning3 (or detuning3 (envelope-interp keyNum detuning3-table)))
+ (stiffnessCoefficient (or stiffnessCoefficient (envelope-interp keyNum stiffnessCoefficient-table)))
+ (singleStringDecayRate-1 (or singleStringDecayRate (envelope-interp keyNum singleStringDecayRate-table)))
+
+ (singleStringZero (or singleStringZero (envelope-interp keyNum singleStringZero-table)))
+ (singleStringPole (or singleStringPole (envelope-interp keyNum singleStringPole-table)))
+
+ (releaseLoopGain (or releaseLoopGain (envelope-interp keyNum releaseLoopGain-table)))
+ (DryTapFiltCoeft60 (or DryTapFiltCoeft60 (envelope-interp keyNum DryTapFiltCoeft60-table)))
+ (DryTapFiltCoefTarget (or DryTapFiltCoefTarget (envelope-interp keyNum DryTapFiltCoefTarget-table)))
+ (DryTapFiltCoefCurrent (or DryTapFiltCoefCurrent (envelope-interp keyNum DryTapFiltCoefCurrent-table)))
+ (DryTapAmpt60 (or DryTapAmpt60 (envelope-interp keyNum DryTapAmpt60-table)))
+ (sustainPedalLevel (or sustainPedalLevel (envelope-interp keyNum sustainPedalLevel-table)))
+ (pedalResonancePole (or pedalResonancePole (envelope-interp keyNum pedalResonancePole-table)))
+ (pedalEnvelopet60 (or pedalEnvelopet60 (envelope-interp keyNum pedalEnvelopet60-table)))
+ (soundboardCutofft60 (or soundboardCutofft60 (envelope-interp keyNum soundboardCutofft60-table)))
+ (DryPedalResonanceFactor (or DryPedalResonanceFactor (envelope-interp keyNum DryPedalResonanceFactor-table)))
+ (unaCordaGain (or unaCordaGain (envelope-interp keyNum unaCordaGain-table)))
+ (detuningFactor (if (null? detuningFactor-table) (envelope-interp keyNum detuningFactor-table) detuningFactor))
+ (stiffnessFactor (if (null? stiffnessFactor-table) (envelope-interp keyNum stiffnessFactor-table) stiffnessFactor))
+
+ (dryTap-one-pole-one-zero-pair (make-one-pole-one-zero 1.0 0.0 0.0))
+ (dryTap-one-pole-swept 0.0)
+ (wetTap-one-pole-swept 0.0)
+
+ (beg (seconds->samples start))
+ (dur (seconds->samples duration))
+ (freq (* 440.0 (expt 2.0 (/ (- keyNum 69.0) 12.0)))))
-
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (vector-set! hammer-one-pole i (make-one-pole (* 1.0 (- 1.0 hammerPole)) (- hammerPole))))
-
- (let* ((vals (apfloor agraffe-len wT))
- (dlen1 (car vals))
- (apcoef1 (cadr vals))
- (agraffe-delay1 (make-delay dlen1))
- (agraffe-tuning-ap1 (make-one-pole-allpass apcoef1))
-
- ;;compute coefficients for and initialize the coupling filter
- ;; taking L=g(1 - bz^-1)/(1-b), and computing Hb = -(1-L)/(2-L)
- (attenuationPerPeriod (expt 10.0 (/ singleStringDecayRate freq 20.0)))
- (g attenuationPerPeriod) ;;DC gain
- (b singleStringZero)
- (a singleStringPole)
- (ctemp (+ 1 (- b) g (- (* a g))
- (* nstrings (+ 1 (- b) (- g) (* a g)))))
-
- (cfb0 (/ (* 2 (+ -1 b g (- (* a g)))) ctemp))
- (cfb1 (/ (* 2 (+ a (- (* a b)) (- (* b g)) (* a b g))) ctemp))
- (cfa1 (/ (+ (- a) (* a b) (- (* b g)) (* a b g)
- (* nstrings (+ (- a) (* a b) (* b g) (- (* a b g)))))
- ctemp))
- (couplingFilter-pair (make-one-pole-one-zero cfb0 cfb1 cfa1))
- (cou0 (car couplingFilter-pair))
- (cou1 (cadr couplingFilter-pair))
-
- ;;determine string tunings (and longitudinal modes, if present)
- (freq1 (if (<= keyNum longitudinal-mode-cutoff-keynum) (* freq longitudinalMode) freq))
- (freq2 (+ freq (* detuning2 detuningFactor)))
- (freq3 (+ freq (* detuning3 detuningFactor)))
-
- ;;scale stiffness coefficients, if desired
- (stiffnessCoefficient (if (> stiffnessFactor 1.0)
- (- stiffnessCoefficient
- (* (+ 1 stiffnessCoefficient)
- (- stiffnessFactor 1)))
- (* stiffnessCoefficient stiffnessFactor)))
- (stiffnessCoefficientL (if (<= keyNum longitudinal-mode-cutoff-keynum)
- longitudinal-mode-stiffness-coefficient
- stiffnessCoefficient))
-
- ;;initialize the coupled-string elements
- (vals1 (tune-piano freq1 stiffnessCoefficientL number-of-stiffness-allpasses cfb0 cfb1 cfa1))
- (delayLength1 (car vals1))
- (tuningCoefficient1 (cadr vals1))
- (vals2 (tune-piano freq2 stiffnessCoefficient number-of-stiffness-allpasses cfb0 cfb1 cfa1))
- (delayLength2 (car vals2))
- (tuningCoefficient2 (cadr vals2))
- (vals3 (tune-piano freq3 stiffnessCoefficient number-of-stiffness-allpasses cfb0 cfb1 cfa1))
- (delayLength3 (car vals3))
- (tuningCoefficient3 (cadr vals3))
-
- (string1-delay (make-delay (- delayLength1 1)))
- (string1-tuning-ap (make-one-pole-allpass tuningCoefficient1))
- (string1-stiffness-ap (make-vector 8))
- (string2-delay (make-delay (- delayLength2 1)))
- (string2-tuning-ap (make-one-pole-allpass tuningCoefficient2))
- (string2-stiffness-ap (make-vector 8))
- (string3-delay (make-delay (- delayLength3 1)))
- (string3-tuning-ap (make-one-pole-allpass tuningCoefficient3))
- (string3-stiffness-ap (make-vector 8))
-
- ;;initialize loop-gain envelope
- (loop-gain-expseg (make-expseg :currentValue loop-gain-default :targetValue releaseLoopGain))
- (looprate (In-t60 loop-gain-env-t60))
- (dryTap 0.0)
- (openStrings 0.0)
- (combedExcitationSignal 0.0)
- (adelOut 0.0)
- (adelIn 0.0)
- (totalTap 0.0)
- (loop-gain loop-gain-default)
- (is-release-time #f)
- (string1-junction-input 0.0)
- (string2-junction-input 0.0)
- (string3-junction-input 0.0)
- (couplingFilter-input 0.0)
- (couplingFilter-output 0.0)
- (sampCount 0)
- (noi (make-pnoise)))
-
- (do ((i 0 (+ 1 i))) ((= i 8))
- (vector-set! string1-stiffness-ap i (make-one-pole-allpass stiffnessCoefficientL)))
- (do ((i 0 (+ 1 i))) ((= i 8))
- (vector-set! string2-stiffness-ap i (make-one-pole-allpass stiffnessCoefficient)))
- (do ((i 0 (+ 1 i))) ((= i 8))
- (vector-set! string3-stiffness-ap i (make-one-pole-allpass stiffnessCoefficient)))
+ (let((end (+ beg dur (seconds->samples release-time-margin)))
+ (release-time (+ beg dur))
+ (wT (/ (* two-pi freq) *clm-srate*))
+ ;;strike position comb filter delay length
+ (agraffe-len (/ (* *clm-srate* strikePosition) freq))
+ (singleStringDecayRate (* singleStringDecayRateFactor singleStringDecayRate-1)))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (if is-release-time
- (set! loop-gain (expseg loop-gain-expseg looprate))
- (if (= sampCount dur)
- (begin
- (set! is-release-time #t)
- (set! dryamprate sb-cutoff-rate)
- (set! wetamprate sb-cutoff-rate))))
- (set! dryTap (* (expseg dryTap-amp-expseg dryamprate)
- (one-pole-swept dryTap-one-pole-swept
- (one-pole-one-zero dryTap0 dryTap1 (pnoise noi amp)) ;(- (random (* 2 amp)) amp))
- (expseg dryTap-coef-expseg drycoefrate))))
- (set! openStrings (* (expseg wetTap-amp-expseg wetamprate)
- (one-pole-swept wetTap-one-pole-swept
- (one-pole-one-zero wetTap0 wetTap1 (pnoise noi amp)) ;(- (random (* 2 amp)) amp))
- (expseg wetTap-coef-expseg wetcoefrate))))
- (set! totalTap (+ dryTap openStrings))
-
- (set! adelIn totalTap)
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (set! adelIn (one-pole (vector-ref hammer-one-pole i) adelIn)))
-
- (set! combedExcitationSignal (* hammerGain (+ adelOut (* adelIn StrikePositionInvFac))))
- (set! adelOut (one-pole-allpass agraffe-tuning-ap1 (delay agraffe-delay1 adelIn)))
- (set! string1-junction-input (+ couplingFilter-output string1-junction-input))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (set! string1-junction-input (one-pole-allpass (vector-ref string1-stiffness-ap i) string1-junction-input)))
-
- (set! string1-junction-input (+ (* unaCordaGain combedExcitationSignal)
- (* loop-gain
- (delay string1-delay
- (one-pole-allpass string1-tuning-ap string1-junction-input)))))
- (set! string2-junction-input (+ couplingFilter-output string2-junction-input))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (set! string2-junction-input (one-pole-allpass (vector-ref string2-stiffness-ap i) string2-junction-input)))
- (set! string2-junction-input (+ combedExcitationSignal
- (* loop-gain (delay string2-delay
- (one-pole-allpass string2-tuning-ap string2-junction-input)))))
- (set! string3-junction-input (+ couplingFilter-output string3-junction-input))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (set! string3-junction-input (one-pole-allpass (vector-ref string3-stiffness-ap i) string3-junction-input)))
-
- (set! string3-junction-input (+ combedExcitationSignal
- (* loop-gain
- (delay string3-delay
- (one-pole-allpass string3-tuning-ap string3-junction-input)))))
- (set! couplingFilter-input (+ string1-junction-input string2-junction-input string3-junction-input))
- (set! couplingFilter-output (one-pole-one-zero cou0 cou1 couplingFilter-input))
- (set! sampCount (+ 1 sampCount))
- (outa i couplingFilter-input))))))
+ (let (;;initialize soundboard impulse response elements
+ ;;initialize open-string resonance elements
+ (wetTap-one-pole-one-zero-pair (make-one-pole-one-zero (- 1.0 (* (signum pedalResonancePole) pedalResonancePole)) 0.0 (- pedalResonancePole)))
+ (sb-cutoff-rate (In-t60 soundboardCutofft60))
+
+ ;;initialize velocity-dependent piano hammer filter elements
+ (hammerPole (+ softPole (* (- loudPole softPole) strike-velocity)))
+ (hammerGain (+ softGain (* (- loudGain softGain) strike-velocity)))
+
+ (vals (apfloor agraffe-len wT))
+ (attenuationPerPeriod (expt 10.0 (/ singleStringDecayRate freq 20.0))))
-#|
+ (let ((dlen1 (car vals))
+ (apcoef1 (cadr vals))
+
+ ;;compute coefficients for and initialize the coupling filter
+ ;; taking L=g(1 - bz^-1)/(1-b), and computing Hb = -(1-L)/(2-L)
+
+ (g attenuationPerPeriod) ;;DC gain
+ (b singleStringZero)
+ (a singleStringPole)
+
+ ;;determine string tunings (and longitudinal modes, if present)
+ (freq1 (if (<= keyNum longitudinal-mode-cutoff-keynum) (* freq longitudinalMode) freq))
+ (freq2 (+ freq (* detuning2 detuningFactor)))
+ (freq3 (+ freq (* detuning3 detuningFactor)))
+
+ ;;scale stiffness coefficients, if desired
+ (stiffnessCoefficient (if (> stiffnessFactor 1.0)
+ (- stiffnessCoefficient
+ (* (+ 1 stiffnessCoefficient)
+ (- stiffnessFactor 1)))
+ (* stiffnessCoefficient stiffnessFactor))))
+
+ (let ((ctemp (+ 1 (- b) g (- (* a g))
+ (* nstrings (+ 1 (- b) (- g) (* a g)))))
+ (stiffnessCoefficientL (if (<= keyNum longitudinal-mode-cutoff-keynum)
+ longitudinal-mode-stiffness-coefficient
+ stiffnessCoefficient)))
+
+ (let ((cfb0 (/ (* 2 (+ -1 b g (- (* a g)))) ctemp))
+ (cfb1 (/ (* 2 (+ a (- (* a b)) (- (* b g)) (* a b g))) ctemp))
+ (cfa1 (/ (+ (- a) (* a b) (- (* b g)) (* a b g)
+ (* nstrings (+ (- a) (* a b) (* b g) (- (* a b g)))))
+ ctemp))
+
+ (agraffe-delay1 (make-delay dlen1))
+ (agraffe-tuning-ap1 (make-one-pole-all-pass 1 apcoef1)))
+
+ (let ((couplingFilter-pair (make-one-pole-one-zero cfb0 cfb1 cfa1))
+ ;;initialize the coupled-string elements
+ (vals1 (tune-piano freq1 stiffnessCoefficientL number-of-stiffness-allpasses cfb0 cfb1 cfa1))
+ (vals2 (tune-piano freq2 stiffnessCoefficient number-of-stiffness-allpasses cfb0 cfb1 cfa1))
+ (vals3 (tune-piano freq3 stiffnessCoefficient number-of-stiffness-allpasses cfb0 cfb1 cfa1)))
+
+ (let ((delayLength1 (car vals1))
+ (tuningCoefficient1 (cadr vals1))
+
+ (delayLength2 (car vals2))
+ (tuningCoefficient2 (cadr vals2))
+
+ (delayLength3 (car vals3))
+ (tuningCoefficient3 (cadr vals3)))
+
+ (let ((dryTap0 (car dryTap-one-pole-one-zero-pair))
+ (dryTap1 (cadr dryTap-one-pole-one-zero-pair))
+
+ (wetTap0 (car wetTap-one-pole-one-zero-pair))
+ (wetTap1 (cadr wetTap-one-pole-one-zero-pair))
+
+ (op1 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
+ (op2 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
+ (op3 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
+ (op4 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
+
+ (cou0 (car couplingFilter-pair))
+ (cou1 (cadr couplingFilter-pair))
+
+ (string1-delay (make-delay (- delayLength1 1)))
+ (string1-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient1))
+ (string1-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficientL))
+
+ (string2-delay (make-delay (- delayLength2 1)))
+ (string2-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient2))
+ (string2-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficient))
+
+ (string3-delay (make-delay (- delayLength3 1)))
+ (string3-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient3))
+ (string3-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficient))
+
+ ;;initialize loop-gain envelope
+ (loop-gain loop-gain-default)
+ (loop-gain-ry (* releaseLoopGain (In-t60 loop-gain-env-t60)))
+ (loop-gain-rx (- 1.0 (In-t60 loop-gain-env-t60)))
+
+ (dry-coef (* 1.0 DryTapFiltCoefCurrent))
+ (dry-coef-ry (* DryTapFiltCoefTarget (In-t60 DryTapFiltCoeft60)))
+ (dry-coef-rx (- 1.0 (In-t60 DryTapFiltCoeft60)))
+ (wet-coef 0.0)
+ (wet-coef-ry (* -0.5 (In-t60 pedalEnvelopet60)))
+ (wet-coef-rx (- 1.0 (In-t60 pedalEnvelopet60)))
+
+ (dryTap 0.0)
+ (dryTap-x 1.0)
+ (dryTap-rx (- 1.0 (In-t60 DryTapAmpt60)))
+
+ (openStrings 0.0)
+ (wetTap-x (* sustainPedalLevel pedalPresenceFactor (if pedal-down 1.0 DryPedalResonanceFactor)))
+ (wetTap-rx (- 1.0 (In-t60 pedalEnvelopet60)))
+
+ (combedExcitationSignal 0.0)
+ (adelOut 0.0)
+ (adelIn 0.0)
+ (totalTap 0.0)
+ (string1-junction-input 0.0)
+ (string2-junction-input 0.0)
+ (string3-junction-input 0.0)
+ (couplingFilter-input 0.0)
+ (couplingFilter-output 0.0)
+ (temp1 0.0)
+ ;; (pn-gen 16383)
+ (pnoise (int-vector 16383))
+ (interp 0.0)
+ )
+
+ (define (piano-loop beg end)
+ (do ((i beg (+ i 1)))
+ ((= i end))
+
+ (set! loop-gain (+ (* interp (+ loop-gain-ry (* loop-gain-rx loop-gain)))
+ (* (- 1.0 interp) loop-gain-default)))
+
+ (set! temp1 (one-zero dryTap0 (one-pole dryTap1 (piano-noise pnoise amp))))
+ (set! dry-coef (+ dry-coef-ry (* dry-coef-rx dry-coef)))
+ (set! dryTap-one-pole-swept (- (* (+ 1.0 dry-coef) temp1) (* dry-coef dryTap-one-pole-swept)))
+ (set! dryTap-x (* dryTap-x dryTap-rx))
+ (set! dryTap (* dryTap-x dryTap-one-pole-swept))
+
+ (set! temp1 (one-zero wetTap0 (one-pole wetTap1 (piano-noise pnoise amp))))
+ (set! wet-coef (+ wet-coef-ry (* wet-coef-rx wet-coef)))
+ (set! wetTap-one-pole-swept (- (* (+ 1.0 wet-coef) temp1) (* wet-coef wetTap-one-pole-swept)))
+ (set! wetTap-x (* wetTap-x wetTap-rx))
+ (set! openStrings (* wetTap-x wetTap-one-pole-swept))
+
+ (set! totalTap (+ dryTap openStrings))
+
+ (set! adelIn (one-pole op1 (one-pole op2 (one-pole op3 (one-pole op4 totalTap)))))
+ (set! combedExcitationSignal (* hammerGain (+ adelOut (* adelIn StrikePositionInvFac))))
+ (set! adelOut (one-pole-all-pass agraffe-tuning-ap1 (delay agraffe-delay1 adelIn)))
+
+ (set! string1-junction-input
+ (+ (* unaCordaGain combedExcitationSignal)
+ (* loop-gain
+ (delay string1-delay
+ (one-pole-all-pass string1-tuning-ap
+ (one-pole-all-pass string1-stiffness-ap
+ (+ string1-junction-input couplingFilter-output)))))))
+ (set! string2-junction-input
+ (+ combedExcitationSignal
+ (* loop-gain
+ (delay string2-delay
+ (one-pole-all-pass string2-tuning-ap
+ (one-pole-all-pass string2-stiffness-ap
+ (+ string2-junction-input couplingFilter-output)))))))
+ (set! string3-junction-input
+ (+ combedExcitationSignal
+ (* loop-gain
+ (delay string3-delay
+ (one-pole-all-pass string3-tuning-ap
+ (one-pole-all-pass string3-stiffness-ap
+ (+ string3-junction-input couplingFilter-output)))))))
+
+ (set! couplingFilter-input (+ string1-junction-input string2-junction-input string3-junction-input))
+ (set! couplingFilter-output (one-zero cou0 (one-pole cou1 couplingFilter-input)))
+
+ (outa i couplingFilter-input)))
+
+ (piano-loop beg release-time)
+ (set! dryTap-rx (- 1.0 sb-cutoff-rate))
+ (set! wetTap-rx dryTap-rx)
+ (set! interp 1.0)
+ (piano-loop release-time end)
+ ))))))))))
+
+#|
(with-sound ()
- (do ((i 0 (+ 1 i))) ((= i 8))
+ (do ((i 0 (+ i 1))) ((= i 8))
(p
(* i .5)
:duration .5
@@ -466,7 +437,7 @@
(with-sound ()
- (do ((i 0 (+ 1 i))) ((= i 8))
+ (do ((i 0 (+ i 1))) ((= i 8))
(p
(* i .5)
:duration .5
@@ -496,7 +467,7 @@
(with-sound ()
- (do ((i 0 (+ 1 i))) ((= i 8))
+ (do ((i 0 (+ i 1))) ((= i 8))
(p
(* i .5)
:duration .5
@@ -522,7 +493,7 @@
82.986 -0.040 92.240 .3 96.000 .5
99.000 .7 108.000 .7)
;these are the actual allpass coefficients modified here
- ;to allow dampedness at hig freqs
+ ;to allow dampedness at high freqs
)))
(let ((i 5))
diff --git a/pix/100twice.png b/pix/100twice.png
new file mode 100644
index 0000000..c9a1078
Binary files /dev/null and b/pix/100twice.png differ
diff --git a/pix/8way.png b/pix/8way.png
new file mode 100644
index 0000000..b2429e3
Binary files /dev/null and b/pix/8way.png differ
diff --git a/pix/averages.png b/pix/averages.png
new file mode 100644
index 0000000..f5659a0
Binary files /dev/null and b/pix/averages.png differ
diff --git a/pix/s64pi.png b/pix/s64pi.png
new file mode 100644
index 0000000..9fe6d3a
Binary files /dev/null and b/pix/s64pi.png differ
diff --git a/pix/simprec.png b/pix/simprec.png
deleted file mode 100644
index 231f8a6..0000000
Binary files a/pix/simprec.png and /dev/null differ
diff --git a/pix/sndosc.png b/pix/sndosc.png
deleted file mode 100644
index 2d6ae7e..0000000
Binary files a/pix/sndosc.png and /dev/null differ
diff --git a/pix/sqrt.png b/pix/sqrt.png
index 680edf1..c9331a3 100644
Binary files a/pix/sqrt.png and b/pix/sqrt.png differ
diff --git a/pix/sqrt1.png b/pix/sqrt1.png
index 20ec952..215bd9b 100644
Binary files a/pix/sqrt1.png and b/pix/sqrt1.png differ
diff --git a/pix/toc-blank.png b/pix/toc-blank.png
deleted file mode 100644
index 83c8d4b..0000000
Binary files a/pix/toc-blank.png and /dev/null differ
diff --git a/pix/toc-minus.png b/pix/toc-minus.png
deleted file mode 100644
index ebbad94..0000000
Binary files a/pix/toc-minus.png and /dev/null differ
diff --git a/pix/toc-plus.png b/pix/toc-plus.png
deleted file mode 100644
index b242ec3..0000000
Binary files a/pix/toc-plus.png and /dev/null differ
diff --git a/play.rb b/play.rb
index e93a706..0d8f7c8 100644
--- a/play.rb
+++ b/play.rb
@@ -1,101 +1,51 @@
# play.rb -- play.scm -> play.rb
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Fri Apr 22 23:36:39 CEST 2005
-# Changed: Sat Feb 19 17:20:26 CET 2011
+# Created: 05/04/22 23:36:39
+# Changed: 14/11/14 08:21:06
-# Commentary:
-#
# playing-related examples
#
-# open_play_output(out_chans, out_srate, out_format, out_bufsize)
-# play_sound(&func)
# play_often(n)
# play_region_forever(reg)
-# loop_between_marks(m1, m2, bufsize)
-# start_dac
+# start_dac(srate, chans)
# stop_dac
-# vector_synthesis(files, read_even_when_not_playing, &driver)
# play_with_amps(snd, *rest)
# play_sine(freq, amp)
# play_sines(freq_and_amps)
-#
-# Code:
-
-def open_play_output(out_chans = 1,
- out_srate = 22050,
- out_format = (little_endian? ? Mus_lshort : Mus_bshort),
- out_bufsize = 256)
- unless out_format then out_format = little_endian? ? Mus_lshort : Mus_bshort end
- if no_error = $mus_error_hook.empty?
- $mus_error_hook.add_hook!(get_func_name) do |type, msg| true end
- end
- audio_fd = Snd.catch(:all, -1) do
- mus_audio_open_output(0, out_srate, out_chans, out_format, out_bufsize * 2)
- end.first
- if no_error then $mus_error_hook.remove_hook!(get_func_name) end
- if audio_fd != -1 then set_dac_size(out_bufsize) end
- [audio_fd, out_chans, out_bufsize]
-end
-
-add_help(:play_sound,
- "play_sound(&func) \
-plays the currently selected sound, calling func on each data buffer, if func exists")
-def play_sound
- if sounds.null?
- Snd.display("no sounds open")
- else
- filechans = channels()
- audio_fd, outchans, pframes = open_play_output(filechans, srate, false, 256)
- if audio_fd == -1
- Snd.display("could not open dac")
- else
- len = frames
- data = SoundData.new(outchans, pframes)
- 0.step(len, pframes) do |beg|
- if outchans > 1 and filechans > 1
- [outchans, filechans].min.times do |chn|
- samples2sound_data(beg, pframes, false, chn, data, Current_edit_position, chn)
- end
- else
- samples2sound_data(beg, pframes, false, 0, data)
- end
- if block_given? then yield(data) end
- mus_audio_write(audio_fd, data, pframes)
- end
- mus_audio_close(audio_fd)
- end
- end
-end
-# play_sound do |data| data.map! do |val| val * 2.0 end end
# play sound n times -- play_often(3) for example
add_help(:play_often,
- "play_often(n) plays the selected sound 'n' times (interruptible via C-g)")
+ "play_often(n) \
+Plays the selected sound N times (interruptible via C-g).")
def play_often(n)
plays = n - 1
play_once = lambda do |reason|
if plays > 0 and reason == 0
plays -= 1
- play(selected_sound, :wait, play_once)
+ play(selected_sound(), :start, 0, :stop, play_once)
end
end
- play(selected_sound, :wait, play_once)
+ play(selected_sound(), :start, 0, :stop, play_once)
end
# bind_key(?p, 0, lambda do |n| play_often([1, n].max) end, false, "play often")
# play region over and over until C-g typed
add_help(:play_region_forever,
- "play_region_forever(reg) plays region 'reg' until you interrupt it via C-g")
+ "play_region_forever(reg) \
+Plays region REG until you interrupt it via C-g.")
def play_region_forever(reg)
+ if integer?(reg)
+ reg = integer2region(reg)
+ end
play_region_again = lambda do |reason|
if reason == 0
- play(reg, :stop, play_region_again)
+ play(reg, :wait, false, :stop, play_region_again)
end
end
- play(reg, :stop, play_region_again)
+ play(reg, :wait, false, :stop, play_region_again)
end
# bind_key(?p, 0,
# lambda do |n| play_region_forever(Snd.regions[[0, n].max]) end,
@@ -103,223 +53,65 @@ end
# play while looping continuously between two movable marks
-add_help(:loop_between_marks,
- "loop_between_marks(mark1, mark2, buffersize) \plays while looping between two marks")
-def loop_between_marks(m1, m2, bufsize)
- pos1 = make_sample(m1)
- pos2 = make_sample(m2)
- beg = [pos1, pos2].min
- last = [pos1, pos2].max
- all_data = samples2sound_data
- audio_data = SoundData.new(1, bufsize)
- bytes = 2 * bufsize
- audio_fd = mus_audio_open_output(0, srate, 1, Mus_lshort, bytes)
- if audio_fd != -1
- loop do
- bufsize.times do |i|
- audio_data[0, i] = all_data[0, beg]
- beg += 1
- if beg == last
- pos1 = make_sample(m1)
- pos2 = make_sample(m2)
- beg = [pos1, pos2].min
- last = [pos1, pos2].max
- end
- end
- mus_audio_write(audio_fd, audio_data, bufsize)
- end
- mus_audio_close(audio_fd)
- end
-end
-# loop_between_marks(0, 1, 512)
-
# hold DAC open and play sounds via keyboard
-#
-# if for some reason you want the DAC to run continuously in the
-# background, use the "end" argument to the first player seen upon
-# starting the dac:
-add_help(:start_dac, "start_dac() starts the DAC running continuously in the background")
-def start_dac
- hidden_player = make_player
- set_amp_control(0.0, hidden_player)
- add_player(hidden_player, 0, 123456789)
- start_playing(1, 22050)
+add_help(:start_dac,
+ "start_dac(srate=44100, chans=1) \
+Starts the DAC running continuously in the background.")
+def start_dac(sr = 44100, chans = 1)
+ play(false, :srate, sr, :channels, chans)
end
alias stop_dac stop_playing
-# bind_key(?o, 0, lambda do | | play("oboe.snd") end, false, "play oboe")
-# bind_key(?p, 0, lambda do | | play("pistol.snd") end, false, "play pistol")
-
-# in this particular case, there's no need to hold the DAC open but
-# maybe this will come in handy someday
-
-# "vector synthesis"
-#
-# this idea (and the weird name) from linux-audio-development mailing
-# list discussion apparently some commercial synths (or software?)
-# provide this
-
-add_help(:vector_synthesis,
- "vector_synthesis(files, read_even_when_not_playing, &driver) \
-uses 'driver', a function of two args (the number of files, \
-and the number of samples between calls) to decide which file to play. \
-If 'read_even_when_not_playing' is true (default is false), \
-the input files are constantly read, even if not playing. \
-'files' is a list of files to be played.")
-def vector_synthesis(files, read_even_when_not_playing, &driver)
- if (files_len = files.length) > 0
- bufsize = 256
- sr = mus_sound_srate(files.first)
- chns = files.map do |f| mus_sound_chans(f) end.max
- readers = files.map do |f| make_file2frame(f) end
- locs = Array.new(files_len, 0)
- current_file = 0
- reading = true
- if (out_port = mus_audio_open_output(0, sr, chns, Mus_lshort, bufsize * 2)) < 0
- Snd.raise(:snd_error, "can\'t open audio port! %s", out_port)
- else
- pframes = Array.new(files_len) do |i| mus_sound_frames(files[i]) end
- Snd.catch(:all, lambda do |arg| Snd.display("%s: error %s", get_func_name, arg) end) do
- while reading
- if (next_file = driver.call(files_len, bufsize)) != current_file
- ramp_down = 1.0
- ramp = 1.0 / bufsize
- current = readers[current_file]
- current_loc = locs[current_file]
- nxt = readers[next_file]
- next_loc = locs[next_file]
- downs = current.channels
- ups = nxt.channels
- up = make_frame(ups)
- down = make_frame(downs)
- bufsize.times do |i|
- file2frame(nxt, next_loc + i, up)
- file2frame(current, current_loc + i, down)
- chans.times do |j|
- val1 = if j < downs
- ramp_down * frame_ref(down, j)
- else
- 0.0
- end
- val2 = if j < ups
- (1.0 - ramp_down) * frame_ref(up, j)
- else
- 0.0
- end
- data[j, i] = val1 + val2
- end
- ramp_down -= ramp
- end
- if read_even_when_not_playing
- locs.map! do |val| val += bufsize end
- else
- locs[current_file] += bufsize
- locs[next_file] += bufsize
- end
- current_file = next_file
- else
- current = readers[current_file]
- current_loc = locs[current_file]
- ons = current.channels
- on = make_frame(ons)
- bufsize.times do |i|
- file2frame(current, current_loc + i, on)
- chans.times do |j|
- data[j, i] = if j < ons
- frame_ref(on, j)
- else
- 0.0
- end
- end
- end
- if read_even_when_not_playing
- locs.map! do |val| val += bufsize end
- else
- locs[current_file] += bufsize
- end
- end
- mus_audio_write(out_port, data, bufsize)
- reading = (0...files_len).detect do |i| locs[i] < pframes[i] end
- end
- end
- mus_audio_close(out_port)
- end
- end
-end
-# let(0, 0) do |ctr, file|
-# vector_synthesis(["oboe.snd", "pistol.snd"], true) do |files, bufsize|
-# if ctr > 4
-# file += 1
-# ctr = 0
-# if file >= files then file = 0 end
-# else
-# ctr += 1
-# end
-# file
-# end
-# end
# play_with_amps -- play channels with individually settable amps
add_help(:play_with_amps,
"play_with_amps(snd, *amps) \
-plays snd with each channel scaled by the corresponding amp: \
-play_with_amps(0, 1.0, 0.5) plays channel 2 of stereo sound at half amplitude")
+Plays snd with each channel scaled by the corresponding amp: \
+play_with_amps(0, 1.0, 0.5) plays channel 2 of stereo sound at half amplitude.")
def play_with_amps(snd, *amps)
- channels(snd).times do |chn|
+ chns = channels(snd)
+ chns.times do |chn|
player = make_player(snd, chn)
set_amp_control(amps[chn], player)
add_player(player)
end
- start_playing(channels(snd), srate(snd))
+ start_playing(chns, srate(snd))
end
# play_sine and play_sines
-add_help(:play_sine, "play_sine(freq, amp) plays a 1 second sinewave at freq and amp")
+add_help(:play_sine,
+ "play_sine(freq, amp) \
+Plays a 1 second sinewave at freq and amp.")
def play_sine(freq, amp)
- audio_fd, outchans, pframes = open_play_output(1, 22050, false, 256)
- if audio_fd != -1
- len = 22050
- osc = make_oscil(:frequency, freq)
- data = SoundData.new(outchans, pframes)
- 0.step(len, pframes) do |beg|
- data.map!(0) do |val| amp * oscil(osc) end
- mus_audio_write(audio_fd, data, pframes)
- end
- mus_audio_close(audio_fd)
- else
- false
- end
+ len = 44100
+ osc = make_oscil(freq)
+ play(lambda do
+ (len -= 1).positive? and (amp * oscil(osc))
+ end)
end
-add_help(:play_sine, "play_sine(freq_and_amps) \
-produces a tone given its spectrum: play_sines([[440, 0.4], [660, 0.3]])")
-def play_sines(freq_and_amps)
- audio_fd, outchans, pframes = open_play_output(1, 22050, false, 256)
- if audio_fd != -1
- len = 22050
- oscs = freq_and_amps.map do |freq, amp| make_oscil(:frequency, freq) end
- amps = freq_and_amps.map do |freq, amp| amp end
- data = SoundData.new(outchans, pframes)
- 0.step(len, pframes) do |beg|
- data.map!(0) do |val|
- val = 0.0
- oscs.zip(amps) do |o, a|
- val = val + a * oscil(o)
- end
- val
- end
- mus_audio_write(audio_fd, data, pframes)
- end
- mus_audio_close(audio_fd)
- else
- false
+add_help(:play_sines,
+ "play_sines(*freq_and_amps) \
+Produces a tone given its spectrum: play_sines([[440, 0.4], [660, 0.3]])")
+def play_sines(*freq_and_amps)
+ len = 44100
+ num_oscs = freq_and_amps.length
+ frqs = Vct.new(num_oscs)
+ amps = Vct.new(num_oscs)
+ freq_and_amps.each_with_index do |fa, i|
+ frqs[i] = hz2radians(fa[0])
+ amps[i] = fa[1]
end
+ ob = make_oscil_bank(frqs, Vct.new(num_oscs, 0.0), amps)
+ play(lambda do
+ (len -= 1).positive? and oscil_bank(ob)
+ end)
end
-# play_sines([[425, 0.05], [450, 0.01],
-# [470, 0.01], [546, 0.02],
-# [667, 0.01], [789, 0.034],
-# [910, 0.032]])
+# play_sines([425, 0.05], [450, 0.01],
+# [470, 0.01], [546, 0.02],
+# [667, 0.01], [789, 0.034],
+# [910, 0.032])
# play.rb ends here
diff --git a/play.scm b/play.scm
index f3da652..20e0148 100644
--- a/play.scm
+++ b/play.scm
@@ -1,7 +1,9 @@
+;;; most of this file is obsolete.
+;;;
;;; playing-related examples previously scattered around at random
;;;
;;; play-sound func -- play current sound, calling (func data) on each buffer if func is passed
-;;; play-often, play-until-c-g -- play sound n times or until c-g
+;;; play-often, play-until-c-g -- play sound n times or until C-g is typed
;;; play-region-forever -- play region over and over until C-g typed
;;; loop-between-marks -- play while looping continuously between two movable marks
;;; start-dac -- hold DAC open and play sounds via keyboard
@@ -13,18 +15,11 @@
(provide 'snd-play.scm)
-
-(define* (samples->sound-data (beg 0) num snd chn obj pos (sd-chan 0))
- (vct->sound-data
- (channel->vct beg num snd chn pos)
- (or obj (make-sound-data 1 (or num (frames snd chn))))
- sd-chan))
-
-
+#|
(define* (open-play-output out-chans out-srate out-format out-bufsize)
;; returns (list audio-fd chans frames)
(let* ((outchans (or out-chans 1))
- (cur-srate (or out-srate (and (not (null? (sounds))) (srate)) 22050))
+ (cur-srate (or out-srate (and (pair? (sounds)) (srate)) 22050))
(pframes (or out-bufsize 256))
(frm (or out-format (if (little-endian?) mus-lshort mus-bshort)))
(outbytes (* pframes 2)) ; 2 here since we'll first try to send short (16-bit) data to the DAC
@@ -33,302 +28,172 @@
;; so we turn off the "error" printout, catch the error itself, and toss it
(let ((no-error (null? (hook-functions mus-error-hook))))
(if no-error
- (hook-push mus-error-hook (lambda (typ msg) #t)))
+ (hook-push mus-error-hook (lambda (hook) (set! (hook 'result) #t))))
(let ((val (catch #t
- (lambda ()
- (mus-audio-open-output 0 cur-srate outchans frm outbytes))
- (lambda args -1)))) ; -1 returned in case of error
+ (lambda ()
+ (mus-audio-open-output 0 cur-srate outchans frm outbytes))
+ (lambda args -1)))) ; -1 returned in case of error
(if no-error
- (set! (hook-functions mus-error-hook) '()))
+ (set! (hook-functions mus-error-hook) ()))
val))))
(if (not (= audio-fd -1))
(set! (dac-size) outbytes))
(list audio-fd outchans pframes)))
-(define* (play-sound func)
- "(play-sound func) plays the currently selected sound, calling func on each data buffer, if func exists"
- (if (not (null? (sounds)))
- (let* ((filechans (chans))
- (audio-info (open-play-output filechans (srate) #f 256))
- (audio-fd (car audio-info))
- (outchans (cadr audio-info))
- (pframes (caddr audio-info)))
- (if (not (= audio-fd -1))
- (let ((len (frames))
- (data (make-sound-data outchans pframes))) ; the data buffer passed to the function (func above), then to mus-audio-write
- (do ((beg 0 (+ beg pframes)))
- ((> beg len))
- (if (and (> outchans 1) (> filechans 1))
- (do ((k 0 (+ 1 k)))
- ((= k (min outchans filechans)))
- (samples->sound-data beg pframes #f k data current-edit-position k))
- (samples->sound-data beg pframes #f 0 data))
- (if func
- (func data))
- (mus-audio-write audio-fd data pframes))
- (mus-audio-close audio-fd))
- (snd-print ";could not open dac")))
- (snd-print ";no sounds open")))
-
-#|
-(play-sound
- (lambda (data)
- (let ((len (length data)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (sound-data-set! data 0 i (* 2.0 (sound-data-ref data 0 i)))))))
+(define play-sound
+ (let ((documentation "(play-sound func) plays the currently selected sound, calling func on each data buffer, if func exists (mono only)"))
+ (lambda* (func)
+ (if (pair? (sounds))
+ (let* ((filechans (chans))
+ (audio-info (open-play-output filechans (srate) #f 256))
+ (audio-fd (car audio-info))
+ ;; (outchans (cadr audio-info))
+ (pframes (caddr audio-info)))
+ (if (not (= audio-fd -1))
+ (let ((len (framples)))
+ (do ((beg 0 (+ beg pframes)))
+ ((> beg len))
+ (mus-audio-write audio-fd (make-shared-vector (func (channel->float-vector beg pframes)) (list 1 pframes)) pframes))
+ (mus-audio-close audio-fd))
+ (snd-print ";could not open dac")))
+ (snd-print ";no sounds open")))))
+
+;; (play-sound (lambda (data) (float-vector-scale! data 2.0) data))
+
+;; this could also be done with a function argument to the play function -- get a
+;; sampler for the sound, call it on each invocation of the argument function etc
|#
-;;; this could also be done with a function argument to the play function -- get a
-;;; sampler for the sound, call it on each invocation of the argument function etc
-
;;; -------- play sound n times -- (play-often 3) for example.
-(define (play-often n)
- "(play-often n) plays the selected sound 'n' times (interruptible via C-g)"
- (let ((plays (- n 1)))
- (define (play-once reason)
- (if (and (> plays 0)
- (= reason 0))
- (begin
- (set! plays (- plays 1))
- (play (selected-sound) :start 0 :stop play-once))))
- (play (selected-sound) :start 0 :stop play-once)))
+(define play-often
+ (let ((documentation "(play-often n) plays the selected sound 'n' times (interruptible via C-g)"))
+ (lambda (n)
+ (let ((plays (- n 1)))
+ (define (play-once reason)
+ (if (and (> plays 0)
+ (= reason 0))
+ (begin
+ (set! plays (- plays 1))
+ (play (selected-sound) :start 0 :stop play-once))))
+ (play (selected-sound) :start 0 :stop play-once)))))
-;(bind-key #\p 0 (lambda (n) "play often" (play-often (max 1 n))))
+;;(bind-key #\p 0 (lambda (n) "play often" (play-often (max 1 n))))
;;; -------- play sound until c-g
-(define (play-until-c-g)
- "(play-until-c-g) plays the selected sound until you interrupt it via C-g"
- (define (play-once reason)
- (if (= reason 0)
- (play (selected-sound) :start 0 :stop play-once)))
- (play (selected-sound) :start 0 :stop play-once))
+(define play-until-c-g
+ (let ((documentation "(play-until-c-g) plays the selected sound until you interrupt it via C-g"))
+ (lambda ()
+ (define (play-once reason)
+ (if (= reason 0)
+ (play (selected-sound) :start 0 :stop play-once)))
+ (play (selected-sound) :start 0 :stop play-once))))
;;; -------- play region over and over until C-g typed
-(define (play-region-forever reg1)
- "(play-region-forever reg) plays region 'reg' until you interrupt it via C-g"
-
- (let ((reg (if (integer? reg1) (integer->region reg1) reg1)))
+(define play-region-forever
+ (let ((documentation "(play-region-forever reg) plays region 'reg' until you interrupt it via C-g"))
+ (lambda (reg1)
+ (let ((reg (if (integer? reg1) (integer->region reg1) reg1)))
+ (define (play-region-again reason)
+ (if (= reason 0) ; 0=play completed normally
+ (play reg :wait #f :stop play-region-again)))
+ (play reg :wait #f :stop play-region-again)))))
- (define (play-region-again reason)
- (if (= reason 0) ; 0=play completed normally
- (play reg :wait #f :stop play-region-again)))
-
- (play reg :wait #f :stop play-region-again)))
-
-;(bind-key #\p 0 (lambda (n) "play region forever" (play-region-forever (list-ref (regions) (max 0 n)))))
+ ;(bind-key #\p 0 (lambda (n) "play region forever" (play-region-forever ((regions) (max 0 n)))))
+#|
;;; -------- play while looping continuously between two movable marks
-(define (loop-between-marks m1 m2 bufsize)
- "(loop-between-marks mark1 mark2 buffersize) plays while looping between two marks. x typed in the graph, or C-g in the listener exits the loop."
- (let* ((pos1 (mark-sample m1))
- (pos2 (mark-sample m2))
- (beg (min pos1 pos2))
- (end (max pos1 pos2))
- (all-data (samples->sound-data)) ; for simplicity, just grab all the data
- (audio-data (make-sound-data 1 bufsize))
- (bytes (* bufsize 2)) ; mus-audio-write handles the translation to short (and takes frames, not bytes as 3rd arg)
- (audio-fd (mus-audio-open-output 0 (srate) 1 mus-lshort bytes))
- (stop-looping #f))
- (if (not (= audio-fd -1))
- (begin
- (bind-key #\space 0 (lambda () (set! stop-looping #t))) ; type space in the graph to stop this loop
- (do ()
- (stop-looping
- (mus-audio-close audio-fd)
- (unbind-key #\space 0))
- (do ((i 0 (+ 1 i)))
- ((= i bufsize)
- (begin
- (set! i 0)
- (mus-audio-write audio-fd audio-data bufsize)))
- (sound-data-set! audio-data 0 i (sound-data-ref all-data 0 beg))
- (set! beg (+ 1 beg))
- (if (= beg end)
- (begin
- (set! pos1 (mark-sample m1)) ; get current mark positions (can change while looping)
- (set! pos2 (mark-sample m2))
- (set! beg (min pos1 pos2))
- (set! end (max pos1 pos2))))))))))
-
-;;; m1 and m2 are marks
-;;; (loop-between-marks (caaar (marks)) (cadaar (marks)) 512)
-
+(define loop-between-marks
+ (let ((documentation "(loop-between-marks mark1 mark2 buffersize) plays while looping between two marks. \
+x typed in the graph, or C-g in the listener exits the loop."))
+ (lambda (m1 m2 bufsize)
+ (let* ((pos1 (mark-sample m1))
+ (pos2 (mark-sample m2))
+ (beg (min pos1 pos2))
+ (end (max pos1 pos2))
+ (bytes (* bufsize 2)) ; mus-audio-write handles the translation to short (and takes frames, not bytes as 3rd arg)
+ (audio-fd (mus-audio-open-output 0 (srate) 1 mus-lshort bytes))
+ (stop-looping #f))
+ (if (not (= audio-fd -1))
+ (begin
+ (bind-key #\space 0 (lambda () (set! stop-looping #t))) ; type space in the graph to stop this loop
+ (do ()
+ (stop-looping
+ (mus-audio-close audio-fd)
+ (unbind-key #\space 0))
+ (mus-audio-write audio-fd (make-shared-vector (channel->float-vector beg bufsize) (list 1 bufsize)) bufsize)
+ (set! beg (+ beg bufsize))
+ (if (>= beg end)
+ (begin
+ (set! pos1 (mark-sample m1)) ; get current mark positions (can change while looping)
+ (set! pos2 (mark-sample m2))
+ (set! beg (min pos1 pos2))
+ (set! end (max pos1 pos2)))))))))))
+
+;; m1 and m2 are marks
+;; (loop-between-marks (caaar (marks)) (cadaar (marks)) 512)
+|#
;;; -------- hold DAC open and play sounds via keyboard
-(define* (start-dac (sr 44100) (chans 1))
- "(start-dac) starts the DAC running continuously in the background"
- (play #f :srate sr :channels chans))
+(define start-dac
+ (let ((documentation "(start-dac (srate 44100) (chans 1)) starts the DAC running continuously in the background"))
+ (lambda* ((sr 44100) (chans 1))
+ (play #f :srate sr :channels chans))))
(define stop-dac stop-playing)
-;;; -------- "vector synthesis"
-;;;
-;;; this idea (and the weird name) from linux-audio-development mailing list discussion
-;;; apparently some commercial synths (or software?) provide this
-
-(define (vector-synthesis driver files read-even-when-not-playing)
-
- "(vector-synthesis driver files read-even-when-not-playing) uses 'driver', a
-function of two args (the number of files, and the number of samples between calls) to decide which file to play. If
-'read-even-when-not-playing' is #t (default is #f), the input files are constantly
-read, even if not playing. 'files' is a list of files to be played."
-
- (let ((files-len (length files)))
- (if (> files-len 0)
- (let* ((bufsize 256)
- (srate (srate (car files)))
- (chans (apply max (map channels files)))
- (data (make-sound-data chans bufsize))
- (readers (map make-file->frame files))
- (locs (make-vector files-len 0))
- (pframes (make-vector files-len 0))
- (current-file 0)
- (reading #t)
- (out-port (mus-audio-open-output 0 srate chans mus-lshort (* bufsize 2))))
- (if (< out-port 0)
- (format #t "can't open audio port! ~A" out-port)
- (begin
- (do ((i 0 (+ 1 i)))
- ((= i files-len))
- (set! (pframes i) (frames (list-ref files i))))
- (catch #t
- (lambda ()
- (while reading
- (let ((next-file (driver files-len bufsize)))
- (if (not (= next-file current-file))
- (let* ((ramp-down 1.0)
- (ramp (/ 1.0 bufsize))
- (current (list-ref readers current-file))
- (current-loc (locs current-file))
- (next (list-ref readers next-file))
- (next-loc (locs next-file))
- (downs (channels current))
- (ups (channels next))
- (up (make-frame ups))
- (down (make-frame downs)))
- (do ((i 0 (+ 1 i)))
- ((= i bufsize))
- (file->frame next (+ next-loc i) up)
- (file->frame current (+ current-loc i) down)
- (do ((j 0 (+ 1 j)))
- ((= j chans))
- (sound-data-set! data j i
- (+ (if (< j downs)
- (* ramp-down (frame-ref down j))
- 0.0)
- (if (< j ups)
- (* (- 1.0 ramp-down) (frame-ref up j))
- 0.0))))
- (set! ramp-down (- ramp-down ramp)))
- (if read-even-when-not-playing
- (do ((i 0 (+ 1 i)))
- ((= i files-len))
- (set! (locs i) (+ (locs i) bufsize)))
- (begin
- (set! (locs current-file) (+ (locs current-file) bufsize))
- (set! (locs next-file) (+ (locs next-file) bufsize))))
- (set! current-file next-file))
- (let* ((current (list-ref readers current-file))
- (current-loc (locs current-file))
- (ons (channels current))
- (on (make-frame ons)))
- (do ((i 0 (+ 1 i)))
- ((= i bufsize))
- (file->frame current (+ current-loc i) on)
- (do ((k 0 (+ 1 k)))
- ((= k chans))
- (sound-data-set! data k i (if (< k ons) (frame-ref on k) 0.0))))
- (if read-even-when-not-playing
- (do ((i 0 (+ 1 i)))
- ((= i files-len))
- (set! (locs i) (+ (locs i) bufsize)))
- (set! (locs current-file) (+ (locs current-file) bufsize)))))
- (mus-audio-write out-port data bufsize)
- (set! reading (letrec ((any-data-left
- (lambda (f)
- (if (= f files-len)
- #f
- (or (< (locs f) (pframes f))
- (any-data-left (+ 1 f)))))))
- (any-data-left 0))))))
- (lambda args (begin (snd-print (format #f "error ~A" args)) (car args))))
- (mus-audio-close out-port)))))))
-
-#|
-(vector-synthesis (let ((ctr 0) (file 0))
- (lambda (files bufsize)
- (if (> ctr 4)
- (begin
- (set! file (+ 1 file))
- (set! ctr 0)
- (if (>= file files)
- (set! file 0)))
- (set! ctr (+ 1 ctr)))
- file))
- (list "oboe.snd" "pistol.snd") #t)
-|#
-
-
-;;; play-with-amps -- play channels with individually settable amps
+;; play-with-amps -- play channels with individually settable amps
(define play-with-amps
- (lambda (sound . amps)
- "(play-with-amps snd :rest amps) plays snd with each channel scaled by the corresponding
-amp: (play-with-amps 0 1.0 0.5) plays channel 2 of stereo sound at half amplitude"
- (let ((chans (channels sound)))
- (do ((chan 0 (+ 1 chan)))
- ((= chan chans))
- (let ((player (make-player sound chan)))
- (set! (amp-control player) (list-ref amps chan))
- (add-player player)))
- (start-playing chans (srate sound)))))
-
+ (let ((documentation "(play-with-amps snd :rest amps) plays snd with each channel scaled by the corresponding
+amp: (play-with-amps 0 1.0 0.5) plays channel 2 of stereo sound at half amplitude"))
+ (lambda (sound . amps)
+ (let ((chans (channels sound)))
+ (do ((chan 0 (+ 1 chan)))
+ ((= chan chans))
+ (let ((player (make-player sound chan)))
+ (set! (amp-control player) (amps chan))
+ (add-player player)))
+ (start-playing chans (srate sound))))))
;;; play-sine and play-sines
-(define (play-sine freq amp)
- "(play-sine freq amp) plays a 1 second sinewave at freq and amp"
- (let* ((len 22050)
- (osc (make-oscil freq)))
- (play (lambda ()
- (set! len (- len 1))
- (if (<= len 0)
- #f
- (* amp (oscil osc)))))))
-
-
-(define (play-sines freqs-and-amps)
- "(play-sines freqs-and-amps) produces a tone given its spectrum: (play-sines '((440 .4) (660 .3)))"
- (let* ((len 22050)
- (num-oscs (length freqs-and-amps))
- (oscs (make-vector num-oscs))
- (amps (make-vector num-oscs)))
- (do ((i 0 (+ 1 i)))
- ((= i num-oscs))
- (set! (oscs i) (make-oscil (car (list-ref freqs-and-amps i))))
- (set! (amps i) (cadr (list-ref freqs-and-amps i))))
- (play (lambda ()
- (set! len (- len 1))
- (if (<= len 0)
- #f
- (let ((sum 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i num-oscs))
- (set! sum (+ sum (* (amps i) (oscil (oscs i))))))
- sum))))))
-
-;(play-sines '((425 .05) (450 .01) (470 .01) (546 .02) (667 .01) (789 .034) (910 .032)))
+(define play-sine
+ (let ((documentation "(play-sine freq amp) plays a 1 second sinewave at freq and amp"))
+ (lambda (freq amp)
+ (let ((len 44100)
+ (osc (make-oscil freq)))
+ (play (lambda ()
+ (and (positive? (set! len (- len 1)))
+ (* amp (oscil osc)))))))))
+
+
+(define play-sines
+ (let ((documentation "(play-sines freqs-and-amps) produces a tone given its spectrum: (play-sines '((440 .4) (660 .3)))"))
+ (lambda (freqs-and-amps)
+ (let* ((len 44100)
+ (num-oscs (length freqs-and-amps))
+ (frqs (make-float-vector num-oscs))
+ (amps (make-float-vector num-oscs)))
+ (do ((i 0 (+ i 1)))
+ ((= i num-oscs))
+ (set! (frqs i) (hz->radians (car (freqs-and-amps i))))
+ (set! (amps i) (cadr (freqs-and-amps i))))
+ (let ((ob (make-oscil-bank frqs (make-float-vector num-oscs 0.0) amps #t)))
+ (play (lambda ()
+ (and (positive? (set! len (- len 1)))
+ (oscil-bank ob)))))))))
+
+;; (play-sines '((425 .05) (450 .01) (470 .01) (546 .02) (667 .01) (789 .034) (910 .032)))
diff --git a/poly.rb b/poly.rb
index 7ae7d97..4a6186e 100644
--- a/poly.rb
+++ b/poly.rb
@@ -1,11 +1,9 @@
-# poly.rb -- polynomial-related stuff; poly.scm --> poly.rb -*- snd-ruby -*-
+# poly.rb -- polynomial-related stuff; poly.scm --> poly.rb
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Sat Apr 09 23:55:07 CEST 2005
-# Changed: Mon Nov 22 13:27:11 CET 2010
+# Created: 05/04/09 23:55:07
+# Changed: 14/11/21 05:06:17
-# Commentary: (see poly.scm)
-#
# class Complex
# to_f
# to_f_or_c
@@ -49,11 +47,10 @@
# poly_derivative(obj)
# poly_gcd(obj1, obj2)
# poly_roots(obj)
-#
-# Code:
require "clm"
require "mix"
+include Math
class Complex
attr_writer :real, :imag
@@ -153,20 +150,30 @@ class Poly < Vec
nv = other.length - 1
(n - nv).downto(0) do |i|
q[i] = r[nv + i] / other[nv]
- (nv + i - 1).downto(i) do |j| r[j] = r[j] - q[i] * other[j - i] end
+ (nv + i - 1).downto(i) do |j|
+ r[j] = r[j] - q[i] * other[j - i]
+ end
+ end
+ nv.upto(n) do |i|
+ r[i] = 0.0
end
- nv.upto(n) do |i| r[i] = 0.0 end
[q, r]
end
end
end
alias / poly_div
- # poly(-1.0, 0.0, 1.0) / poly(1.0, 1.0) ==> [poly(-1.0, 1.0, 0.0), poly(0.0, 0.0, 0.0)]
- # poly(-15, -32, -3, 2) / poly(-5, 1) ==> [poly(3.0, 7.0, 2.0, 0.0), poly(0.0, 0.0, 0.0, 0.0)]
- # poly(-15, -32, -3, 2) / poly(3, 1) ==> [poly(-5.0, -9.0, 2.0, 0.0), poly(0.0, 0.0, 0.0, 0.0)]
- # poly(-15, -32, -3, 2) / poly(0.5, 1) ==> [poly(-30.0, -4.0, 2.0, 0.0), poly(0.0, 0.0, 0.0, 0.0)]
- # poly(-15, -32, -3, 2) / poly(3, 7, 2) ==> [poly(-5.0, 1.0, 0.0, 0.0), poly(0.0, 0.0, 0.0, 0.0)]
- # poly(-15, -32, -3, 2) / 2.0 ==> [poly(-7.5, -16.0, -1.5, 1.0), poly(0.0)]
+ # poly(-1.0, 0.0, 1.0) / poly(1.0, 1.0)
+ # ==> [poly(-1.0, 1.0, 0.0), poly(0.0, 0.0, 0.0)]
+ # poly(-15, -32, -3, 2) / poly(-5, 1)
+ # ==> [poly(3.0, 7.0, 2.0, 0.0), poly(0.0, 0.0, 0.0, 0.0)]
+ # poly(-15, -32, -3, 2) / poly(3, 1)
+ # ==> [poly(-5.0, -9.0, 2.0, 0.0), poly(0.0, 0.0, 0.0, 0.0)]
+ # poly(-15, -32, -3, 2) / poly(0.5, 1)
+ # ==> [poly(-30.0, -4.0, 2.0, 0.0), poly(0.0, 0.0, 0.0, 0.0)]
+ # poly(-15, -32, -3, 2) / poly(3, 7, 2)
+ # ==> [poly(-5.0, 1.0, 0.0, 0.0), poly(0.0, 0.0, 0.0, 0.0)]
+ # poly(-15, -32, -3, 2) / 2.0
+ # ==> [poly(-7.5, -16.0, -1.5, 1.0), poly(0.0)]
def derivative
len = self.length - 1
@@ -180,24 +187,26 @@ class Poly < Vec
end
# poly(0.5, 1.0, 2.0, 4.0).derivative ==> poly(1.0, 4.0, 12.0)
- include Mixer_matrix
def resultant(other)
m = self.length
m1 = m - 1
n = other.length
n1 = n - 1
- mat = make_mixer(n1 + m1)
+ d = n1 + m1
+ mat = Array.new(d) do
+ Vct.new(d, 0.0)
+ end
n1.times do |i|
m.times do |j|
- mixer_set!(mat, i, i + j, self[m1 - j])
+ mat[i][i + j] = self[m1 - j]
end
end
m1.times do |i|
n.times do |j|
- mixer_set!(mat, i + n1, i + j, other[n1 - j])
+ mat[i + n1][i + j] = other[n1 - j]
end
end
- mixer_determinant(mat)
+ determinant(mat)
end
# poly(-1, 0, 1).resultant([1, -2, 1]) ==> 0.0
# poly(-1, 0, 2).resultant([1, -2, 1]) ==> 1.0
@@ -209,17 +218,24 @@ class Poly < Vec
end
# poly(-1, 0, 1).discriminant ==> -4.0
# poly(1, -2, 1).discriminant ==> 0.0
- # (poly(-1, 1) * poly(-1, 1) * poly(3, 1)).reduce.discriminant ==> 0.0
- # (poly(-1, 1) * poly(-1, 1) * poly(3, 1) * poly(2, 1)).reduce.discriminant ==> 0.0
- # (poly(1, 1) * poly(-1, 1) * poly(3, 1) * poly(2, 1)).reduce.discriminant ==> 2304.0
- # (poly(1, 1) * poly(-1, 1) * poly(3, 1) * poly(3, 1)).reduce.discriminant ==> 0.0
+ # (poly(-1, 1) * poly(-1, 1) * poly(3, 1)).reduce.discriminant
+ # ==> 0.0
+ # (poly(-1, 1) * poly(-1, 1) * poly(3, 1) * poly(2, 1)).reduce.discriminant
+ # ==> 0.0
+ # (poly(1, 1) * poly(-1, 1) * poly(3, 1) * poly(2, 1)).reduce.discriminant
+ # ==> 2304.0
+ # (poly(1, 1) * poly(-1, 1) * poly(3, 1) * poly(3, 1)).reduce.discriminant
+ # ==> 0.0
def gcd(other)
- assert_type((array?(other) or vct?(other)), other, 0, "a poly, a vct or an array")
+ assert_type((array?(other) or vct?(other)), other, 0,
+ "a poly, a vct or an array")
if self.length < other.length
poly(0.0)
else
- qr = self.poly_div(other).map do |m| m.reduce end
+ qr = self.poly_div(other).map do |m|
+ m.reduce
+ end
if qr[1].length == 1
if qr[1][0].zero?
Poly(other)
@@ -231,15 +247,23 @@ class Poly < Vec
end
end
end
- # (poly(2, 1) * poly(-3, 1)).reduce.gcd(poly(2, 1)) ==> poly(2.0, 1.0)
- # (poly(2, 1) * poly(-3, 1)).reduce.gcd(poly(3, 1)) ==> poly(0.0)
- # (poly(2, 1) * poly(-3, 1)).reduce.gcd(poly(-3, 1)) ==> poly(-3.0, 1.0)
- # (poly(8, 1) * poly(2, 1) * poly(-3, 1)).reduce.gcd(poly(-3, 1)) ==> poly(-3.0, 1.0)
- # (poly(8, 1) * poly(2, 1) * poly(-3, 1)).reduce.gcd((poly(8, 1) * poly(-3, 1)).reduce)
- # ==> poly(-24.0, 5.0, 1.0)
- # poly(-1, 0, 1).gcd(poly(2, -2, -1, 1)) ==> poly(0.0)
- # poly(2, -2, -1, 1).gcd(poly(-1, 0, 1)) ==> poly(1.0, -1.0)
- # poly(2, -2, -1, 1).gcd(poly(-2.5, 1)) ==> poly(0.0)
+ # (poly(2, 1) * poly(-3, 1)).reduce.gcd(poly(2, 1))
+ # ==> poly(2.0, 1.0)
+ # (poly(2, 1) * poly(-3, 1)).reduce.gcd(poly(3, 1))
+ # ==> poly(0.0)
+ # (poly(2, 1) * poly(-3, 1)).reduce.gcd(poly(-3, 1))
+ # ==> poly(-3.0, 1.0)
+ # (poly(8, 1) * poly(2, 1) * poly(-3, 1)).reduce.gcd(poly(-3, 1))
+ # ==> poly(-3.0, 1.0)
+ # (poly(8, 1) * poly(2, 1) *
+ # poly(-3, 1)).reduce.gcd((poly(8, 1) * poly(-3, 1)).reduce)
+ # ==> poly(-24.0, 5.0, 1.0)
+ # poly(-1, 0, 1).gcd(poly(2, -2, -1, 1))
+ # ==> poly(0.0)
+ # poly(2, -2, -1, 1).gcd(poly(-1, 0, 1))
+ # ==> poly(1.0, -1.0)
+ # poly(2, -2, -1, 1).gcd(poly(-2.5, 1))
+ # ==> poly(0.0)
def roots
rts = poly()
@@ -250,7 +274,9 @@ class Poly < Vec
if deg == 1
poly(0.0)
else
- Poly.new(deg) do |i| self[i + 1] end.roots.unshift(0.0)
+ Poly.new(deg) do |i|
+ self[i + 1]
+ end.roots.unshift(0.0)
end
else
if deg == 1
@@ -259,14 +285,21 @@ class Poly < Vec
if deg == 2
quadratic_root(self[2], self[1], self[0])
else
- if deg == 3 and (rts = cubic_root(self[3], self[2], self[1], self[0]))
+ if deg == 3 and
+ (rts = cubic_root(self[3], self[2], self[1], self[0]))
rts
else
- if deg == 4 and (rts = quartic_root(self[4], self[3], self[2], self[1], self[0]))
+ if deg == 4 and
+ (rts = quartic_root(self[4], self[3],
+ self[2], self[1], self[0]))
rts
else
ones = 0
- 1.upto(deg) do |i| if self[i].nonzero? then ones += 1 end end
+ 1.upto(deg) do |i|
+ if self[i].nonzero?
+ ones += 1
+ end
+ end
if ones == 1
nth_root(self[deg], self[0], deg)
else
@@ -283,7 +316,10 @@ class Poly < Vec
self[deg / 3].nonzero? and
self[(deg * 2) / 3].nonzero?
n = deg / 3
- poly(self[0],self[deg / 3],self[(deg * 2) / 3],self[deg]).roots.each do |qr|
+ poly(self[0],
+ self[deg / 3],
+ self[(deg * 2) / 3],
+ self[deg]).roots.each do |qr|
rts.push(*nth_root(1.0, -qr, n.to_f))
end
rts
@@ -296,9 +332,13 @@ class Poly < Vec
v = q.eval(x)
m = v.abs * v.abs
20.times do # until c_g?
- if (dx = v / qp.eval(x)).abs <= Poly_roots_epsilon then break end
+ if (dx = v / qp.eval(x)).abs <= Poly_roots_epsilon
+ break
+ end
20.times do
- if dx.abs <= Poly_roots_epsilon then break end
+ if dx.abs <= Poly_roots_epsilon
+ break
+ end
y = x - dx
v1 = q.eval(y)
if (m1 = v1.abs * v1.abs) < m
@@ -307,7 +347,7 @@ class Poly < Vec
m = m1
break
else
- dx /= 4.0 # /: slash to fool Emacs' indentation commands
+ dx /= 4.0
end
end
end
@@ -320,7 +360,12 @@ class Poly < Vec
q = q.poly_div(poly(x.abs, 0.0, 1.0))
n -= 2
end
- rts = ((n > 0) ? q.car.reduce.roots : poly()) << x.to_f_or_c
+ rts = if n > 0
+ q.car.reduce.roots
+ else
+ poly()
+ end
+ rts << x.to_f_or_c
rts
end
end
@@ -335,11 +380,63 @@ class Poly < Vec
def eval(x)
sum = self.last
- self.reverse[1..-1].each do |val| sum = sum * x + val end
+ self.reverse[1..-1].each do |val|
+ sum = sum * x + val
+ end
sum
end
private
+ def submatrix(mx, row, col)
+ nmx = Array.new(mx.length - 1) do
+ Vct.new(mx.length - 1, 0.0)
+ end
+ ni = 0
+ mx.length.times do |i|
+ if i != row
+ nj = 0
+ mx.length.times do |j|
+ if j != col
+ nmx[ni][nj] = mx[i][j]
+ nj += 1
+ end
+ end
+ ni += 1
+ end
+ end
+ nmx
+ end
+
+ def determinant(mx)
+ if mx.length == 1
+ mx[0][0]
+ else
+ if mx.length == 2
+ mx[0][0] * mx[1][1] - mx[0][1] * mx[1][0]
+ else
+ if mx.length == 3
+ ((mx[0][0] * mx[1][1] * mx[2][2] +
+ mx[0][1] * mx[1][2] * mx[2][0] +
+ mx[0][2] * mx[1][0] * mx[2][1]) -
+ (mx[0][0] * mx[1][2] * mx[2][1] +
+ mx[0][1] * mx[1][0] * mx[2][2] +
+ mx[0][2] * mx[1][1] * mx[2][0]))
+ else
+ sum = 0.0
+ sign = 1
+ mx.length.times do |i|
+ mult = mx[0][i]
+ if mult != 0.0
+ sum = sum + sign * mult * determinant(submatrix(mx, 0, i))
+ end
+ sign = -sign
+ end
+ sum
+ end
+ end
+ end
+ end
+
# ax + b
def linear_root(a, b)
poly(-b / a)
@@ -371,9 +468,13 @@ class Poly < Vec
s2 = r2 * exp(j * incr)
z1 = simplify_complex((s1 + s2) - (a2 / 3))
if pl.eval(z1).abs < Poly_roots_epsilon
- z2 = simplify_complex((-0.5 * (s1 + s2)) + (a2 / -3) + ((s1 - s2) * 0.5 * sqrt3))
+ z2 = simplify_complex((-0.5 * (s1 + s2)) +
+ (a2 / -3) +
+ ((s1 - s2) * 0.5 * sqrt3))
if pl.eval(z2).abs < Poly_roots_epsilon
- z3 = simplify_complex((-0.5 * (s1 + s2)) + (a2 / -3) + ((s1 - s2) * -0.5 * sqrt3))
+ z3 = simplify_complex((-0.5 * (s1 + s2)) +
+ (a2 / -3) +
+ ((s1 - s2) * -0.5 * sqrt3))
if pl.eval(z3).abs < Poly_roots_epsilon
return poly(z1, z2, z3)
end
@@ -398,16 +499,21 @@ class Poly < Vec
yroot.each do |y1|
r = sqrt((0.25 * a3 * a3) + (-a2 + y1))
dd = if r.zero?
- sqrt((0.75 * a3 * a3) + (-2 * a2) + (2 * sqrt(y1 * y1 - 4 * a0)))
+ sqrt((0.75 * a3 * a3) +
+ (-2 * a2) +
+ (2 * sqrt(y1 * y1 - 4 * a0)))
else
sqrt((0.75 * a3 * a3) + (-2 * a2) + (-(r * r)) +
(0.25 * ((4 * a3 * a2) + (-8 * a1) + (-(a3 * a3 * a3)))) / r)
end
ee = if r.zero?
- sqrt((0.75 * a3 * a3) + (-2 * a2) + (-2 * sqrt((y1 * y1) - (4 * a0))))
+ sqrt((0.75 * a3 * a3) +
+ (-2 * a2) +
+ (-2 * sqrt((y1 * y1) - (4 * a0))))
else
sqrt((0.75 * a3 * a3) + (-2 * a2) + (-(r * r)) +
- (-0.25 * ((4 * a3 * a2) + (-8 * a1) + (-(a3 * a3 * a3)))) / r)
+ (-0.25 *
+ ((4 * a3 * a2) + (-8 * a1) + (-(a3 * a3 * a3)))) / r)
end
z1 = (-0.25 * a3) + ( 0.5 * r) + ( 0.5 * dd)
z2 = (-0.25 * a3) + ( 0.5 * r) + (-0.5 * dd)
@@ -426,7 +532,9 @@ class Poly < Vec
n = (-b / a) ** (1.0 / deg)
incr = (TWO_PI * Complex::I) / deg
rts = poly()
- deg.to_i.times do |i| rts.unshift(simplify_complex(exp(i * incr) * n)) end
+ deg.to_i.times do |i|
+ rts.unshift(simplify_complex(exp(i * incr) * n))
+ end
rts
end
@@ -435,7 +543,9 @@ class Poly < Vec
if a.imag.abs < Poly_roots_epsilon2
(a.real.abs < Poly_roots_epsilon2) ? 0.0 : a.real.to_f
else
- if a.real.abs < Poly_roots_epsilon2 then a.real = 0.0 end
+ if a.real.abs < Poly_roots_epsilon2
+ a.real = 0.0
+ end
a
end
end
@@ -506,9 +616,11 @@ class Vct
end
def Poly(obj)
- if obj.nil? then obj = [] end
+ if obj.nil?
+ obj = []
+ end
assert_type(obj.respond_to?(:to_poly), obj, 0,
- "an object containing method 'to_poly' (Vct, String, Array and subclasses)")
+ "an object containing method 'to_poly'")
obj.to_poly
end
@@ -531,52 +643,62 @@ def poly(*vals)
end
def poly_reduce(obj)
- assert_type(obj.respond_to?(:to_poly), obj, 0, "an object containing method 'to_poly'")
+ assert_type(obj.respond_to?(:to_poly), obj, 0,
+ "an object containing method 'to_poly'")
Poly(obj).reduce
end
def poly_add(obj1, obj2)
if number?(obj1)
- assert_type(obj2.respond_to?(:to_poly), obj2, 1, "an object containing method 'to_poly'")
+ assert_type(obj2.respond_to?(:to_poly), obj2, 1,
+ "an object containing method 'to_poly'")
Float(obj1) + Poly(obj2)
else
- assert_type(obj1.respond_to?(:to_poly), obj1, 0, "an object containing method 'to_poly'")
+ assert_type(obj1.respond_to?(:to_poly), obj1, 0,
+ "an object containing method 'to_poly'")
Poly(obj1) + obj2
end
end
def poly_multiply(obj1, obj2)
if number?(obj1)
- assert_type(obj2.respond_to?(:to_poly), obj2, 1, "an object containing method 'to_poly'")
+ assert_type(obj2.respond_to?(:to_poly), obj2, 1,
+ "an object containing method 'to_poly'")
Float(obj1) * Poly(obj2)
else
- assert_type(obj1.respond_to?(:to_poly), obj1, 0, "an object containing method 'to_poly'")
+ assert_type(obj1.respond_to?(:to_poly), obj1, 0,
+ "an object containing method 'to_poly'")
Poly(obj1) * obj2
end
end
def poly_div(obj1, obj2)
if number?(obj1)
- assert_type(obj2.respond_to?(:to_poly), obj2, 1, "an object containing method 'to_poly'")
+ assert_type(obj2.respond_to?(:to_poly), obj2, 1,
+ "an object containing method 'to_poly'")
Float(obj1) / Poly(obj2)
else
- assert_type(obj1.respond_to?(:to_poly), obj1, 0, "an object containing method 'to_poly'")
+ assert_type(obj1.respond_to?(:to_poly), obj1, 0,
+ "an object containing method 'to_poly'")
Poly(obj1) / obj2
end
end
def poly_derivative(obj)
- assert_type(obj.respond_to?(:to_poly), obj, 0, "an object containing method 'to_poly'")
+ assert_type(obj.respond_to?(:to_poly), obj, 0,
+ "an object containing method 'to_poly'")
Poly(obj).derivative
end
def poly_gcd(obj1, obj2)
- assert_type(obj.respond_to?(:to_poly), obj, 0, "an object containing method 'to_poly'")
+ assert_type(obj.respond_to?(:to_poly), obj, 0,
+ "an object containing method 'to_poly'")
Poly(obj1).gcd(obj2)
end
def poly_roots(obj)
- assert_type(obj.respond_to?(:to_poly), obj, 0, "an object containing method 'to_poly'")
+ assert_type(obj.respond_to?(:to_poly), obj, 0,
+ "an object containing method 'to_poly'")
Poly(obj).roots
end
diff --git a/poly.scm b/poly.scm
index 1bc1071..7bffd98 100644
--- a/poly.scm
+++ b/poly.scm
@@ -2,226 +2,291 @@
;;;
;;; poly+ poly* poly/ poly-gcd poly-reduce poly-roots poly-derivative poly-resultant poly-discriminant
;;;
-;;; this file really needs doubles (--with-doubles in configure, double as s7_Double in s7.h)
+;;; this file really needs doubles (--with-doubles in configure, double as s7_double in s7.h)
(provide 'snd-poly.scm)
-(if (not (provided? 'snd-mixer.scm)) (load "mixer.scm")) ; need matrix determinant for poly-resultant
+
+(when (provided? 'pure-s7)
+ (define (make-polar mag ang)
+ (if (and (real? mag) (real? ang))
+ (complex (* mag (cos ang)) (* mag (sin ang)))
+ (error 'wrong-type-arg "make-polar args should be real"))))
+
+(define (vector->float-vector v) (copy v (make-float-vector (length v) 0.0)))
+(define (float-vector->vector v) (copy v (make-vector (length v) 0.0)))
+
;;; using lists and vectors internally for complex intermediates
-(define (vector-add! p1 p2)
- "(vector-add! p1 p2) adds (elementwise) the vectors p1 and p2"
- (let ((len (min (length p1) (length p2))))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (p1 i) (+ (p1 i) (p2 i))))
- p1))
-
-(define (vector-scale! p1 scl)
- "(vector-scale! p1 scl) scales each element of the vector p1 by scl"
- (let ((len (length p1)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (p1 i) (* scl (p1 i))))
- p1))
-
-(define (vector-copy p1)
- "(vector-copy p1) returnns a copy of the vector p1"
- (let* ((len (length p1))
- (v (make-vector len)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (v i) (p1 i)))
- v))
-
-(define (poly-as-vector-eval v x)
- "(poly-as-vector-eval v x) treats 'v' as a vector of polynomial coefficients, returning the value of the polynomial at x"
- (let ((sum (v (- (length v) 1))))
- (do ((i (- (length v) 2) (- i 1)))
- ((< i 0) sum)
- (set! sum (+ (* sum x) (v i))))))
-
-
-(define (poly-as-vector-reduce p1)
- "(poly-as-vector-reduce p1) removes trailing (high-degree) zeros from the vector p1"
- ;; always return at least a 0 coeff (rather than return #f=0 polynomial)
- (let ((new-len (do ((i (- (length p1) 1) (- i 1)))
- ((or (= i 0)
- (not (= (p1 i) 0.0)))
- (+ i 1)))))
- (if (= new-len (length p1))
- p1
- (let ((np (make-vector new-len)))
- (do ((i 0 (+ i 1)))
- ((= i new-len))
- (set! (np i) (p1 i)))
- np))))
-
-(define (poly-reduce p1)
- "(poly-reduce p1) removes trailing (high-degree) zeros from the vct p1"
- (if (= (vct-ref p1 (- (length p1) 1)) 0.0)
- (vector->vct (poly-as-vector-reduce (vct->vector p1)))
- p1))
-
-;;; (poly-reduce (vct 1 2 3)) -> #<vct[len=3]: 1.000 2.000 3.000>
-;;; (poly-reduce (vct 1 2 3 0 0 0)) -> #<vct[len=3]: 1.000 2.000 3.000>
-;;; (poly-reduce (vct 0 0 0 0 1 0)) -> #<vct[len=5]: 0.000 0.000 0.000 0.000 1.000>
-
-
-(define (poly-as-vector+ p1 p2)
- "(poly-as-vector+ p1 p2) adds vectors p1 and p2"
- (if (vector? p1)
- (if (vector? p2)
- (if (> (length p1) (length p2))
- (vector-add! (vector-copy p1) p2)
- (vector-add! (vector-copy p2) p1))
- (let ((v (vector-copy p1)))
- (set! (v 0) (+ (v 0) p2))
- v))
- (let ((v (vector-copy p2)))
- (set! (v 0) (+ (v 0) p1))
- v)))
-
-(define (poly+ p1 p2)
- "(poly+ p1 p2) adds vectors or vcts p1 and p2"
- (vector->vct
- (poly-as-vector+
- (if (vct? p1) (vct->vector p1) p1)
- (if (vct? p2) (vct->vector p2) p2))))
-
-;;; (poly+ (vct .1 .2 .3) (vct 0.0 1.0 2.0 3.0 4.0)) -> #<vct[len=5]: 0.100 1.200 2.300 3.000 4.000>
-;;; (poly+ (vct .1 .2 .3) .5) -> #<vct[len=3]: 0.600 0.200 0.300>
-;;; (poly+ .5 (vct .1 .2 .3)) -> #<vct[len=3]: 0.600 0.200 0.300>
-
-
-(define (poly-as-vector* p1 p2)
- "(poly-as-vector* p1 p2) multiplies (as polynomials) the vectors p1 and p2"
- (if (vector? p1)
- (if (vector? p2)
- (let* ((p1len (length p1))
- (p2len (length p2))
- (len (+ p1len p2len))
- (m (make-vector len 0)))
- (do ((i 0 (+ i 1)))
- ((= i p1len))
- (do ((j 0 (+ 1 j)))
- ((= j p2len))
- (set! (m (+ i j)) (+ (m (+ i j)) (* (p1 i) (p2 j))))))
- m)
- (vector-scale! (vector-copy p1) p2))
- (vector-scale! (vector-copy p2) p1)))
-
-(define (poly* p1 p2)
- "(poly* p1 p2) multiplies the polynomials (vcts or vectors) p1 and p2"
- (vector->vct
- (poly-as-vector*
- (if (vct? p1) (vct->vector p1) p1)
- (if (vct? p2) (vct->vector p2) p2))))
-
-;;; (poly* (vct 1 1) (vct -1 1)) -> #<vct[len=4]: -1.000 0.000 1.000 0.000>
-;;; (poly* (vct -5 1) (vct 3 7 2)) -> #<vct[len=5]: -15.000 -32.000 -3.000 2.000 0.000>
-;;; (poly* (vct -30 -4 2) (vct 0.5 1)) -> #<vct[len=5]: -15.000 -32.000 -3.000 2.000 0.000>
-;;; (poly* (vct -30 -4 2) 0.5) -> #<vct[len=3]: -15.000 -2.000 1.000>
-;;; (poly* 2.0 (vct -30 -4 2)) -> #<vct[len=3]: -60.000 -8.000 4.000>
-
-
-(define (poly-as-vector/ p1 p2)
- "(poly-as-vector/ p1 p2) divides the polynomial p1 by p2 (both vectors)"
- (if (vector? p1)
- (if (vector? p2)
- ;; Numerical Recipes poldiv
- (let ((p1len (length p1))
- (p2len (length p2)))
- (if (> p2len p1len)
- (list (vector 0) p2)
- (let* ((len (max p1len p2len))
- (r (make-vector len 0))
- (q (make-vector len 0)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (r i) (p1 i)))
- (let ((n (- p1len 1))
- (nv (- p2len 1)))
- (do ((k (- n nv) (- k 1)))
- ((< k 0))
- (set! (q k) (/ (r (+ nv k)) (p2 nv)))
- (do ((j (+ nv k -1) (- j 1)))
- ((< j k))
- (set! (r j) (- (r j) (* (q k) (p2 (- j k)))))))
- (do ((j nv (+ 1 j)))
- ((> j n))
- (set! (r j) 0))
- (list q r)))))
- (list (poly-as-vector* p1 (/ 1 p2)) (vector 0)))
- (list (vector 0) p2)))
-
-(define (poly/ p1 p2)
- "(poly/ p1 p2) divides p1 by p2, both polynomials either vcts or vectors"
- (map vector->vct (poly-as-vector/ (if (vct? p1) (vct->vector p1) p1)
- (if (vct? p2) (vct->vector p2) p2))))
-
-;;; (poly/ (vct -1.0 -0.0 1.0) (vector 1.0 1.0)) -> (#<vct[len=3]: -1.000 1.000 0.000> #<vct[len=3]: 0.000 0.000 0.000>)
-;;; (poly/ (vct -15 -32 -3 2) (vector -5 1)) -> (#<vct[len=4]: 3.000 7.000 2.000 0.000> #<vct[len=4]: 0.000 0.000 0.000 0.000>)
-;;; (poly/ (vct -15 -32 -3 2) (vector 3 1)) -> (#<vct[len=4]: -5.000 -9.000 2.000 0.000> #<vct[len=4]: 0.000 0.000 0.000 0.000>)
-;;; (poly/ (vct -15 -32 -3 2) (vector .5 1)) -> (#<vct[len=4]: -30.000 -4.000 2.000 0.000> #<vct[len=4]: 0.000 0.000 0.000 0.000>)
-;;; (poly/ (vct -15 -32 -3 2) (vector 3 7 2)) -> (#<vct[len=4]: -5.000 1.000 0.000 0.000> #<vct[len=4]: 0.000 0.000 0.000 0.000>)
-;;; (poly/ (vct -15 -32 -3 2) 2.0) -> (#<vct[len=4]: -7.500 -16.000 -1.500 1.000> #<vct[len=1]: 0.0>)
-
-
-(define (poly-as-vector-derivative p1)
- "(poly-as-vector-derivative p1) returns the derivative or polynomial p1 (as a vector)"
- (let* ((len (- (length p1) 1))
- (v (make-vector len)))
- (do ((i (- len 1) (- i 1))
- (j len (- j 1)))
- ((< i 0) v)
- (set! (v i) (* j (p1 j))))))
-
-(define (poly-derivative p1)
- "(poly-derivative p1) returns the derivative of p1, either a vct or vector"
- (vector->vct
- (poly-as-vector-derivative
- (vct->vector p1))))
-
-;;; (poly-derivative (vct 0.5 1.0 2.0 4.0)) -> #<vct[len=3]: 1.000 4.000 12.000>
+(define vector-add!
+ (let ((documentation "(vector-add! p1 p2) adds (elementwise) the vectors p1 and p2"))
+ (lambda (p1 p2)
+ (let ((len (min (length p1) (length p2))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (p1 i) (+ (p1 i) (p2 i))))
+ p1))))
+
+(define vector-scale!
+ (let ((documentation "(vector-scale! p1 scl) scales each element of the vector p1 by scl"))
+ (lambda (p1 scl)
+ (let ((len (length p1)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (p1 i) (* scl (p1 i))))
+ p1))))
+
+(define poly-as-vector-eval
+ (let ((documentation "(poly-as-vector-eval v x) treats 'v' as a vector of polynomial coefficients, returning the value of the polynomial at x"))
+ (lambda (v x)
+ (let ((top (- (length v) 1)))
+ (let ((sum (v top)))
+ (do ((i (- top 1) (- i 1)))
+ ((< i 0) sum)
+ (set! sum (+ (* sum x) (v i)))))))))
+
+
+(define poly-as-vector-reduce
+ (let ((documentation "(poly-as-vector-reduce p1) removes trailing (high-degree) zeros from the vector p1"))
+ (lambda (p1)
+ ;; always return at least a 0 coeff (rather than return #f=0 polynomial)
+ (let ((new-len (do ((i (- (length p1) 1) (- i 1)))
+ ((or (= i 0)
+ (not (= (p1 i) 0.0)))
+ (+ i 1)))))
+ (if (= new-len (length p1))
+ p1
+ (let ((np (make-vector new-len)))
+ (do ((i 0 (+ i 1)))
+ ((= i new-len))
+ (set! (np i) (p1 i)))
+ np))))))
+
+(define poly-reduce
+ (let ((documentation "(poly-reduce p1) removes trailing (high-degree) zeros from the float-vector p1"))
+ (lambda (p1)
+ (if (= (p1 (- (length p1) 1)) 0.0)
+ (vector->float-vector (poly-as-vector-reduce (float-vector->vector p1)))
+ p1))))
+
+;;; (poly-reduce (float-vector 1 2 3)) -> #<float-vector[len=3]: 1.000 2.000 3.000>
+;;; (poly-reduce (float-vector 1 2 3 0 0 0)) -> #<float-vector[len=3]: 1.000 2.000 3.000>
+;;; (poly-reduce (float-vector 0 0 0 0 1 0)) -> #<float-vector[len=5]: 0.000 0.000 0.000 0.000 1.000>
+
+
+(define poly-as-vector+
+ (let ((documentation "(poly-as-vector+ p1 p2) adds vectors p1 and p2"))
+ (lambda (p1 p2)
+ (if (vector? p1)
+ (if (vector? p2)
+ (if (> (length p1) (length p2))
+ (vector-add! (copy p1) p2)
+ (vector-add! (copy p2) p1))
+ (let ((v (copy p1)))
+ (set! (v 0) (+ (v 0) p2))
+ v))
+ (let ((v (copy p2)))
+ (set! (v 0) (+ (v 0) p1))
+ v)))))
+
+(define poly+
+ (let ((documentation "(poly+ p1 p2) adds vectors or float-vectors p1 and p2"))
+ (lambda (p1 p2)
+ (vector->float-vector
+ (poly-as-vector+
+ (if (float-vector? p1) (float-vector->vector p1) p1)
+ (if (float-vector? p2) (float-vector->vector p2) p2))))))
+
+;;; (poly+ (float-vector .1 .2 .3) (float-vector 0.0 1.0 2.0 3.0 4.0)) -> #<float-vector[len=5]: 0.100 1.200 2.300 3.000 4.000>
+;;; (poly+ (float-vector .1 .2 .3) .5) -> #<float-vector[len=3]: 0.600 0.200 0.300>
+;;; (poly+ .5 (float-vector .1 .2 .3)) -> #<float-vector[len=3]: 0.600 0.200 0.300>
+
+
+(define poly-as-vector*
+ (let ((documentation "(poly-as-vector* p1 p2) multiplies (as polynomials) the vectors p1 and p2"))
+ (lambda (p1 p2)
+ (if (vector? p1)
+ (if (vector? p2)
+ (let* ((p1len (length p1))
+ (p2len (length p2))
+ (len (+ p1len p2len))
+ (m (make-vector len 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i p1len))
+ (do ((j 0 (+ j 1)))
+ ((= j p2len))
+ (set! (m (+ i j)) (+ (m (+ i j)) (* (p1 i) (p2 j))))))
+ m)
+ (vector-scale! (copy p1) p2))
+ (vector-scale! (copy p2) p1)))))
+
+(define poly*
+ (let ((documentation "(poly* p1 p2) multiplies the polynomials (float-vectors or vectors) p1 and p2"))
+ (lambda (p1 p2)
+ (vector->float-vector
+ (poly-as-vector*
+ (if (float-vector? p1) (float-vector->vector p1) p1)
+ (if (float-vector? p2) (float-vector->vector p2) p2))))))
+
+;;; (poly* (float-vector 1 1) (float-vector -1 1)) -> #<float-vector[len=4]: -1.000 0.000 1.000 0.000>
+;;; (poly* (float-vector -5 1) (float-vector 3 7 2)) -> #<float-vector[len=5]: -15.000 -32.000 -3.000 2.000 0.000>
+;;; (poly* (float-vector -30 -4 2) (float-vector 0.5 1)) -> #<float-vector[len=5]: -15.000 -32.000 -3.000 2.000 0.000>
+;;; (poly* (float-vector -30 -4 2) 0.5) -> #<float-vector[len=3]: -15.000 -2.000 1.000>
+;;; (poly* 2.0 (float-vector -30 -4 2)) -> #<float-vector[len=3]: -60.000 -8.000 4.000>
+
+
+(define poly-as-vector/
+ (let ((documentation "(poly-as-vector/ p1 p2) divides the polynomial p1 by p2 (both vectors)"))
+ (lambda (p1 p2)
+ (if (vector? p1)
+ (if (vector? p2)
+ ;; Numerical Recipes poldiv
+ (let ((p1len (length p1))
+ (p2len (length p2)))
+ (if (> p2len p1len)
+ (list (vector 0) p2)
+ (let* ((len (max p1len p2len))
+ (r (make-vector len 0))
+ (q (make-vector len 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (r i) (p1 i)))
+ (let ((n (- p1len 1))
+ (nv (- p2len 1)))
+ (do ((k (- n nv) (- k 1)))
+ ((< k 0))
+ (set! (q k) (/ (r (+ nv k)) (p2 nv)))
+ (do ((j (+ nv k -1) (- j 1)))
+ ((< j k))
+ (set! (r j) (- (r j) (* (q k) (p2 (- j k)))))))
+ (do ((j nv (+ j 1)))
+ ((> j n))
+ (set! (r j) 0))
+ (list q r)))))
+ (list (poly-as-vector* p1 (/ p2)) (vector 0)))
+ (list (vector 0) p2)))))
+
+(define poly/
+ (let ((documentation "(poly/ p1 p2) divides p1 by p2, both polynomials either float-vectors or vectors"))
+ (lambda (p1 p2)
+ (map vector->float-vector (poly-as-vector/ (if (float-vector? p1) (float-vector->vector p1) p1)
+ (if (float-vector? p2) (float-vector->vector p2) p2))))))
+
+;;; (poly/ (float-vector -1.0 -0.0 1.0) (vector 1.0 1.0)) -> (#<float-vector[len=3]: -1.000 1.000 0.000> #<float-vector[len=3]: 0.000 0.000 0.000>)
+;;; (poly/ (float-vector -15 -32 -3 2) (vector -5 1)) -> (#<float-vector[len=4]: 3.000 7.000 2.000 0.000> #<float-vector[len=4]: 0.000 0.000 0.000 0.000>)
+;;; (poly/ (float-vector -15 -32 -3 2) (vector 3 1)) -> (#<float-vector[len=4]: -5.000 -9.000 2.000 0.000> #<float-vector[len=4]: 0.000 0.000 0.000 0.000>)
+;;; (poly/ (float-vector -15 -32 -3 2) (vector .5 1)) -> (#<float-vector[len=4]: -30.000 -4.000 2.000 0.000> #<float-vector[len=4]: 0.000 0.000 0.000 0.000>)
+;;; (poly/ (float-vector -15 -32 -3 2) (vector 3 7 2)) -> (#<float-vector[len=4]: -5.000 1.000 0.000 0.000> #<float-vector[len=4]: 0.000 0.000 0.000 0.000>)
+;;; (poly/ (float-vector -15 -32 -3 2) 2.0) -> (#<float-vector[len=4]: -7.500 -16.000 -1.500 1.000> #<float-vector[len=1]: 0.0>)
+
+
+(define poly-as-vector-derivative
+ (let ((documentation "(poly-as-vector-derivative p1) returns the derivative or polynomial p1 (as a vector)"))
+ (lambda (p1)
+ (let* ((len (- (length p1) 1))
+ (v (make-vector len)))
+ (do ((i (- len 1) (- i 1))
+ (j len (- j 1)))
+ ((< i 0) v)
+ (set! (v i) (* j (p1 j))))))))
+
+(define poly-derivative
+ (let ((documentation "(poly-derivative p1) returns the derivative of p1, either a float-vector or vector"))
+ (lambda (p1)
+ (vector->float-vector
+ (poly-as-vector-derivative
+ (float-vector->vector p1))))))
+
+;;; (poly-derivative (float-vector 0.5 1.0 2.0 4.0)) -> #<float-vector[len=3]: 1.000 4.000 12.000>
;;; poly-antiderivative with random number as constant? or max of all coeffs? -- 0.0 seems like a bad idea -- maybe an optional arg
;;; then poly-integrate: (let ((integral (poly-antiderivative p1))) (- (poly-as-vector-eval integral end) (poly-as-vector-eval integral beg)))
-(define (poly-as-vector-resultant p1 p2)
- "(poly-as-vector-resultant p1 p2) returns the resultant of polynomials p1 and p2 (vectors)"
- (let* ((m (length p1))
- (n (length p2))
- (mat (make-mixer (+ n m -2))))
- ;; load matrix with n-1 rows of m's coeffs then m-1 rows of n's coeffs (reversed in sense), return determinant
- (do ((i 0 (+ i 1)))
- ((= i (- n 1)))
- (do ((j 0 (+ 1 j)))
- ((= j m))
- (mixer-set! mat i (+ i j) (p1 (- m j 1)))))
- (do ((i 0 (+ i 1)))
- ((= i (- m 1)))
- (do ((j 0 (+ 1 j)))
- ((= j n))
- (mixer-set! mat (+ i n -1) (+ i j) (p2 (- n j 1)))))
- (mixer-determinant mat)))
-
-(define (poly-resultant p1 p2)
- "(poly-resultant p1 p2) returns the resultant of polynomials p1 and p2 (vcts or vectors)"
- (poly-as-vector-resultant
- (if (vct? p1) (vct->vector p1) p1)
- (if (vct? p2) (vct->vector p2) p2)))
-
-
-(define (poly-as-vector-discriminant p1)
- "(poly-as-vector-discriminant p1) returns the discriminant of polynomial p1 (a vector)"
- (poly-as-vector-resultant p1 (poly-as-vector-derivative p1)))
+(define (submatrix mx row col)
+ (let* ((old-n (car (vector-dimensions mx)))
+ (new-n (- old-n 1))
+ (nmx (make-float-vector (list new-n new-n) 0.0)))
+ (do ((i 0 (+ i 1))
+ (ni 0))
+ ((= i old-n))
+ (if (not (= i row))
+ (begin
+ (do ((j 0 (+ j 1))
+ (nj 0))
+ ((= j old-n))
+ (if (not (= j col))
+ (begin
+ (set! (nmx ni nj) (mx i j))
+ (set! nj (+ nj 1)))))
+ (set! ni (+ 1 ni)))))
+ nmx))
+
+(define (determinant mx)
+ (if (not (float-vector? mx))
+ (error 'wrong-type-arg "determinant argument should be a float-vector")
+ (let ((n (car (vector-dimensions mx))))
+ (if (= n 1)
+ (mx 0 0)
+ (if (= n 2)
+ (- (* (mx 0 0) (mx 1 1))
+ (* (mx 0 1) (mx 1 0)))
+ (if (= n 3)
+ (- (+ (* (mx 0 0) (mx 1 1) (mx 2 2))
+ (* (mx 0 1) (mx 1 2) (mx 2 0))
+ (* (mx 0 2) (mx 1 0) (mx 2 1)))
+ (+ (* (mx 0 0) (mx 1 2) (mx 2 1))
+ (* (mx 0 1) (mx 1 0) (mx 2 2))
+ (* (mx 0 2) (mx 1 1) (mx 2 0))))
+ (let ((sum 0.0)
+ (sign 1))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((mult (mx 0 i)))
+ (if (not (= mult 0.0))
+ (set! sum (+ sum (* sign mult (determinant (submatrix mx 0 i))))))
+ (set! sign (- sign))))
+ sum)))))))
-(define (poly-discriminant p1)
- "(poly-discriminant p1) returns the discriminant of polynomial p1 (either a vct or a vector)"
- (poly-as-vector-discriminant
- (if (vct? p1) (vct->vector p1) p1)))
+(define (poly-as-vector-resultant p1 p2)
+ (if (or (not (vector? p1))
+ (not (vector? p2)))
+ (error 'wrong-type-arg "poly-as-vector-resultant arguments should be vectors")
+ (let* ((m (length p1))
+ (n (length p2))
+ (d (+ n m -2))
+ (mat (make-float-vector (list d d) 0.0)))
+ ;; load matrix with n-1 rows of m's coeffs then m-1 rows of n's coeffs (reversed in sense), return determinant
+ (do ((i 0 (+ i 1)))
+ ((= i (- n 1)))
+ (do ((j 0 (+ j 1)))
+ ((= j m))
+ (set! (mat i (+ i j)) (p1 (- m j 1)))))
+ (do ((i 0 (+ i 1)))
+ ((= i (- m 1)))
+ (do ((j 0 (+ j 1)))
+ ((= j n))
+ (set! (mat (+ i n -1) (+ i j)) (p2 (- n j 1)))))
+ (determinant mat))))
+
+(define poly-resultant
+ (let ((documentation "(poly-resultant p1 p2) returns the resultant of polynomials p1 and p2 (float-vectors or vectors)"))
+ (lambda (p1 p2)
+ (poly-as-vector-resultant
+ (if (float-vector? p1) (float-vector->vector p1) p1)
+ (if (float-vector? p2) (float-vector->vector p2) p2)))))
+
+
+(define poly-as-vector-discriminant
+ (let ((documentation "(poly-as-vector-discriminant p1) returns the discriminant of polynomial p1 (a vector)"))
+ (lambda (p1)
+ (poly-as-vector-resultant p1 (poly-as-vector-derivative p1)))))
+
+(define poly-discriminant
+ (let ((documentation "(poly-discriminant p1) returns the discriminant of polynomial p1 (either a float-vector or a vector)"))
+ (lambda (p1)
+ (poly-as-vector-discriminant
+ (if (float-vector? p1) (float-vector->vector p1) p1)))))
;;; (poly-as-vector-resultant (vector -1 0 1) (vector 1 -2 1)) 0.0 (x=1 is the intersection)
@@ -232,70 +297,71 @@
;;; (poly-as-vector-discriminant (vector -1 0 1)) -4.0
;;; (poly-as-vector-discriminant (vector 1 -2 1)) 0.0
-;;; (poly-discriminant (poly-reduce (poly* (poly* (vct -1 1) (vct -1 1)) (vct 3 1)))) 0.0
-;;; (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct -1 1) (vct -1 1)) (vct 3 1)) (vct 2 1)))) 0.0
-;;; (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct 1 1) (vct -1 1)) (vct 3 1)) (vct 2 1)))) 2304
-;;; (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct 1 1) (vct -1 1)) (vct 3 1)) (vct 3 1)))) 0.0
+;;; (poly-discriminant (poly-reduce (poly* (poly* (float-vector -1 1) (float-vector -1 1)) (float-vector 3 1)))) 0.0
+;;; (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector -1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 2 1)))) 0.0
+;;; (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector 1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 2 1)))) 2304
+;;; (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector 1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 3 1)))) 0.0
(define poly-roots-epsilon 1.0e-7)
-(define (simplify-complex a)
- "(simplify-complex a) sets to 0.0 real or imaginary parts of 'a' that are less than poly-roots-epsilon"
- (if (< (abs (imag-part a)) poly-roots-epsilon)
- (if (< (abs (real-part a)) poly-roots-epsilon)
- 0.0
- (real-part a))
- (if (< (abs (real-part a)) poly-roots-epsilon)
- (make-rectangular 0.0 (imag-part a))
- a)))
-
-
-(define (poly-gcd p1 p2)
- "(poly-gcd p1 p2) returns the GCD of polynomials p1 and p2 (both vcts)"
- (if (< (length p1) (length p2))
- (vct 0.0)
- (let ((qr (map poly-reduce (poly/ p1 p2))))
- ;(display (format #f ";poly-gcd ~A ~A -> ~A~%" p1 p2 qr))
- (if (= (length (cadr qr)) 1)
- (if (= (vct-ref (cadr qr) 0) 0.0)
- p2
- (vct 0.0))
- (apply poly-gcd qr)))))
-
-(define (poly-as-vector-gcd p1 p2)
- "(poly-as-vector-gcd p1 p2) returns the GCD of polynomials p1 and p2 (both vectors)"
- (if (< (length p1) (length p2))
- (vector 0)
- (let ((qr (map poly-as-vector-reduce (poly-as-vector/ p1 p2))))
- ;(display (format #f ";poly-as-vector-gcd ~A ~A ->~A ~%" p1 p2 qr))
- (if (= (length (cadr qr)) 1)
- (if (= ((cadr qr) 0) 0.0)
- p2
- (vector 0))
- (apply poly-as-vector-gcd qr)))))
-
-;;; (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct 2 1)) -> #<vct[len=2]: 2.000 1.000>
-;;; (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct 3 1)) -> #<vct[len=1]: 6.000>
-;;; (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct -3 1)) -> #<vct[len=2]: -3.000 1.000>
-;;; (poly-gcd (poly-reduce (poly* (vct 8 1) (poly* (vct 2 1) (vct -3 1)))) (vct -3 1)) -> #<vct[len=2]: -3.000 1.000>
-;;; (poly-gcd (poly-reduce (poly* (vct 8 1) (poly* (vct 2 1) (vct -3 1)))) (poly-reduce (poly* (vct 8 1) (vct -3 1)))) -> #<vct[len=3]: -24.000 5.000 1.000>
-;;; (poly-gcd (vct -1 0 1) (vct 2 -2 -1 1)) -> #<vct[len=1]: 0.000>
-;;; (poly-gcd (vct 2 -2 -1 1) (vct -1 0 1)) -> #<vct[len=2]: 1.000 -1.000>
-;;; (poly-gcd (vct 2 -2 -1 1) (vct -2.5 1)) -> #<vct[len=1]: 0.000>
+(define simplify-complex
+ (let ((documentation "(simplify-complex a) sets to 0.0 real or imaginary parts of 'a' that are less than poly-roots-epsilon"))
+ (lambda (a)
+ (if (< (abs (imag-part a)) poly-roots-epsilon)
+ (if (< (abs (real-part a)) poly-roots-epsilon)
+ 0.0
+ (real-part a))
+ (if (< (abs (real-part a)) poly-roots-epsilon)
+ (complex 0.0 (imag-part a))
+ a)))))
+
+
+(define poly-gcd
+ (let ((documentation "(poly-gcd p1 p2) returns the GCD of polynomials p1 and p2 (both float-vectors)"))
+ (lambda (p1 p2)
+ (if (< (length p1) (length p2))
+ (float-vector 0.0)
+ (let ((qr (map poly-reduce (poly/ p1 p2))))
+ (if (= (length (cadr qr)) 1)
+ (if (= (float-vector-ref (cadr qr) 0) 0.0)
+ p2
+ (float-vector 0.0))
+ (apply poly-gcd qr)))))))
+
+(define poly-as-vector-gcd
+ (let ((documentation "(poly-as-vector-gcd p1 p2) returns the GCD of polynomials p1 and p2 (both vectors)"))
+ (lambda (p1 p2)
+ (if (< (length p1) (length p2))
+ (vector 0)
+ (let ((qr (map poly-as-vector-reduce (poly-as-vector/ p1 p2))))
+ (if (= (length (cadr qr)) 1)
+ (if (= ((cadr qr) 0) 0.0)
+ p2
+ (vector 0))
+ (apply poly-as-vector-gcd qr)))))))
+
+;;; (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector 2 1)) -> #<float-vector[len=2]: 2.000 1.000>
+;;; (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector 3 1)) -> #<float-vector[len=1]: 6.000>
+;;; (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector -3 1)) -> #<float-vector[len=2]: -3.000 1.000>
+;;; (poly-gcd (poly-reduce (poly* (float-vector 8 1) (poly* (float-vector 2 1) (float-vector -3 1)))) (float-vector -3 1)) -> #<float-vector[len=2]: -3.000 1.000>
+;;; (poly-gcd (poly-reduce (poly* (float-vector 8 1) (poly* (float-vector 2 1) (float-vector -3 1)))) (poly-reduce (poly* (float-vector 8 1) (float-vector -3 1)))) -> #<float-vector[len=3]: -24.000 5.000 1.000>
+;;; (poly-gcd (float-vector -1 0 1) (float-vector 2 -2 -1 1)) -> #<float-vector[len=1]: 0.000>
+;;; (poly-gcd (float-vector 2 -2 -1 1) (float-vector -1 0 1)) -> #<float-vector[len=2]: 1.000 -1.000>
+;;; (poly-gcd (float-vector 2 -2 -1 1) (float-vector -2.5 1)) -> #<float-vector[len=1]: 0.000>
(define (poly-as-vector-roots p1)
(define (linear-root a b) ; ax + b
(list (/ (- b) a)))
-
+
(define (quadratic-roots a b c) ; ax^2 + bx + c
(let ((d (sqrt (- (* b b) (* 4 a c)))))
(list (/ (+ (- b) d) (* 2 a))
(/ (- (- b) d) (* 2 a)))))
-
+
(define (cubic-roots a b c d) ; ax^3 + bx^2 + cx + d
;; Abramowitz & Stegun 3.8.2
(let* ((a0 (/ d a))
@@ -305,14 +371,14 @@
(r (- (/ (- (* a1 a2) (* 3 a0)) 6) (/ (* a2 a2 a2) 27)))
(q3r2 (+ (* q q q) (* r r)))
(sq3r2 (sqrt q3r2))
- (r1 (expt (+ r sq3r2) (/ 1 3)))
- (r2 (expt (- r sq3r2) (/ 1 3)))
+ (r1 (expt (+ r sq3r2) 1/3))
+ (r2 (expt (- r sq3r2) 1/3))
(incr (/ (* 2 pi 0+i) 3)))
(call-with-exit
(lambda (return)
(do ((i 0 (+ i 1))) ; brute force! this can almost certainly be optimized
((= i 3))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((= j 3))
(let* ((s1 (* r1 (exp (* i incr))))
(s2 (* r2 (exp (* j incr))))
@@ -328,7 +394,7 @@
(if (< (magnitude (poly-as-vector-eval (vector a0 a1 a2 1) z3)) poly-roots-epsilon)
(return (list z1 z2 z3))))))))))
#f))))
-
+
(define (quartic-roots a b c d e) ; ax^4 + bx^3 + cx^2 + dx + e
;; Weisstein, "Encyclopedia of Mathematics"
(call-with-exit
@@ -342,11 +408,11 @@
(- a2)
1.0))))
(if (and yroot
- (list? yroot)
+ (pair? yroot)
(= (length yroot) 4))
(do ((i 0 (+ i 1)))
((= i 3))
- (let* ((y1 (list-ref yroot i))
+ (let* ((y1 (yroot i))
(R (sqrt (+ (* 0.25 a3 a3) (- a2) y1)))
(D (if (= R 0)
(sqrt (+ (* 0.75 a3 a3) (* -2 a2) (* 2 (sqrt (- (* y1 y1) (* 4 a0))))))
@@ -360,25 +426,25 @@
(z2 (+ (* -0.25 a3) (* 0.5 R) (* -0.5 D)))
(z3 (+ (* -0.25 a3) (* -0.5 R) (* 0.5 E)))
(z4 (+ (* -0.25 a3) (* -0.5 R) (* -0.5 E))))
-
+
(if (< (magnitude (poly-as-vector-eval (vector e d c b a) z1)) poly-roots-epsilon)
(return (list z1 z2 z3 z4))))))
#f))))
-
+
(define (nth-roots a b deg) ; ax^n + b
- (let* ((n (expt (/ (- b) a) (/ 1.0 deg)))
- (incr (/ (* 2 pi 0+i) deg))
- (roots '()))
+ (let ((n (expt (/ (- b) a) (/ 1.0 deg)))
+ (incr (/ (* 2 pi 0+i) deg))
+ (roots ()))
(do ((i 0 (+ i 1)))
((= i deg))
(set! roots (cons (simplify-complex (* n (exp (* i incr)))) roots)))
roots))
-
+
(let ((deg (- (length p1) 1)))
-
+
(if (= deg 0) ; just constant
- '()
-
+ ()
+
(if (= (p1 0) 0.0) ; constant=0.0, divide through by x, recurse on new
(if (= deg 1)
(list 0.0)
@@ -387,157 +453,158 @@
((> i deg))
(set! (pnew (- i 1)) (p1 i)))
(append (list 0.0) (poly-as-vector-roots pnew))))
-
+
(if (= deg 1) ; ax + b -> -b/a
(linear-root (p1 1) (p1 0))
-
+
(if (= deg 2) ; ax^2 + bx + c -> -b +/- sqrt(b^2 - 4ac) / 2a
(quadratic-roots (p1 2) (p1 1) (p1 0))
-
+
(or (and (= deg 3)
- ;; it may be better to fall into Newton's method here
+ ;; it may be better to fall into Newton's method here
(cubic-roots (p1 3) (p1 2) (p1 1) (p1 0)))
(and (= deg 4)
(quartic-roots (p1 4) (p1 3) (p1 2) (p1 1) (p1 0)))
-
+
;; degree>4 (or trouble above), use Newton's method unless some simple case pops up
(let ((ones 0))
- (do ((i 1 (+ i 1)))
- ((> i deg))
- (if (not (= (p1 i) 0.0))
- (set! ones (+ 1 ones))))
-
- (if (= ones 1) ; x^n + b -- "linear" in x^n
- (nth-roots (p1 deg) (p1 0) deg)
-
- (if (and (= ones 2)
- (even? deg)
- (not (= (p1 (/ deg 2)) 0.0)))
- (let ((roots '()) ; quadratic in x^(n/2)
- (n (/ deg 2)))
+ (do ((i 1 (+ i 1)))
+ ((> i deg))
+ (if (not (= (p1 i) 0.0))
+ (set! ones (+ 1 ones))))
+
+ (if (= ones 1) ; x^n + b -- "linear" in x^n
+ (nth-roots (p1 deg) (p1 0) deg)
+
+ (if (and (= ones 2)
+ (even? deg)
+ (not (= (p1 (/ deg 2)) 0.0)))
+ (let ((roots ()) ; quadratic in x^(n/2)
+ (n (/ deg 2)))
+ (for-each
+ (lambda (r)
+ (set! roots (append roots (nth-roots 1.0 (- r) n))))
+ (poly-as-vector-roots (vector (p1 0)
+ (p1 (/ deg 2))
+ (p1 deg))))
+ roots)
+
+ (if (and (> deg 3)
+ (= ones 3)
+ (= (modulo deg 3) 0)
+ (not (= (p1 (/ deg 3)) 0.0))
+ (not (= (p1 (/ (* 2 deg) 3)) 0.0)))
+ (let ((roots ()) ; cubic in x^(n/3)
+ (n (/ deg 3)))
(for-each
(lambda (r)
(set! roots (append roots (nth-roots 1.0 (- r) n))))
(poly-as-vector-roots (vector (p1 0)
- (p1 (/ deg 2))
+ (p1 (/ deg 3))
+ (p1 (/ (* 2 deg) 3))
(p1 deg))))
roots)
-
- (if (and (> deg 3)
- (= ones 3)
- (= (modulo deg 3) 0)
- (not (= (p1 (/ deg 3)) 0.0))
- (not (= (p1 (/ (* 2 deg) 3)) 0.0)))
- (let ((roots '()) ; cubic in x^(n/3)
- (n (/ deg 3)))
- (for-each
- (lambda (r)
- (set! roots (append roots (nth-roots 1.0 (- r) n))))
- (poly-as-vector-roots (vector (p1 0)
- (p1 (/ deg 3))
- (p1 (/ (* 2 deg) 3))
- (p1 deg))))
- roots)
-
- ;; perhaps get derivative roots, plug in main -- need to get nth derivative to be safe in this
- ;; from Cohen, "Computational Algebraic Number Theory"
- (let* ((roots '())
- (q (vector-copy p1))
- (pp (poly-as-vector-derivative p1))
- (qp (vector-copy pp))
- (n deg)
- (x 1.3+0.314159i)
- (v (poly-as-vector-eval q x))
- (m (* (magnitude v) (magnitude v)))
- (dx 0.0)
- (last-dx 1.0) ; guard against infinite loop
- (happy #f))
- (do ()
- (happy)
- (set! dx (/ v (poly-as-vector-eval qp x)))
- (if (or (<= (magnitude dx) poly-roots-epsilon)
- (= dx last-dx))
- (set! happy #t)
- (begin
- (set! last-dx dx)
- (do ((c 0 (+ 1 c))
- (step3 #f))
- ((or (>= c 20)
- step3
- (<= (magnitude dx) poly-roots-epsilon)))
- (let* ((y (- x dx))
- (v1 (poly-as-vector-eval q y))
- (m1 (* (magnitude v1) (magnitude v1))))
- (if (< m1 m)
- (begin
- (set! x y)
- (set! v v1)
- (set! m m1)
- (set! step3 #t))
- (set! dx (/ dx 4.0))))))))
- (set! x (- x (/ (poly-as-vector-eval p1 x) (poly-as-vector-eval pp x))))
- (set! x (- x (/ (poly-as-vector-eval p1 x) (poly-as-vector-eval pp x))))
- (if (< (imag-part x) poly-roots-epsilon)
- (begin
- (set! x (real-part x))
- (set! q (poly-as-vector/ q (vector (- x) 1.0)))
- (set! n (- n 1)))
- (begin
- (set! q (poly-as-vector/ q (vector (magnitude x) 0.0 1.0)))
- (set! n (- n 2))))
- (set! roots (cons x roots))
- (if (> n 0)
- (set! roots (append (poly-as-vector-roots (poly-as-vector-reduce (car q))) roots)))
- roots))))))))))))
-
-(define (poly-roots p1)
- "(poly-roots p1) returns the roots of polynomial p1"
- (let* ((v1 (vct->vector (poly-reduce p1)))
- (roots (poly-as-vector-roots v1)))
- (for-each
- (lambda (q)
- (let ((dx (magnitude (poly-as-vector-eval v1 q))))
- (if (> dx poly-roots-epsilon) (format #t ";poly.scm 502: (poly-roots ~A) numerical trouble (polynomial root is not very good): ~A at ~A: ~A" p1 v1 q dx))))
- roots)
- roots))
+
+ ;; perhaps get derivative roots, plug in main -- need to get nth derivative to be safe in this
+ ;; from Cohen, "Computational Algebraic Number Theory"
+ (let* ((roots ())
+ (q (copy p1))
+ (pp (poly-as-vector-derivative p1))
+ (qp (copy pp))
+ (n deg)
+ (x 1.3+0.314159i)
+ (v (poly-as-vector-eval q x))
+ (m (* (magnitude v) (magnitude v)))
+ (dx 0.0)
+ (last-dx 1.0) ; guard against infinite loop
+ (happy #f))
+ (do ()
+ (happy)
+ (set! dx (/ v (poly-as-vector-eval qp x)))
+ (if (or (<= (magnitude dx) poly-roots-epsilon)
+ (= dx last-dx))
+ (set! happy #t)
+ (begin
+ (set! last-dx dx)
+ (do ((c 0 (+ 1 c))
+ (step3 #f))
+ ((or (>= c 20)
+ step3
+ (<= (magnitude dx) poly-roots-epsilon)))
+ (let* ((y (- x dx))
+ (v1 (poly-as-vector-eval q y))
+ (m1 (* (magnitude v1) (magnitude v1))))
+ (if (< m1 m)
+ (begin
+ (set! x y)
+ (set! v v1)
+ (set! m m1)
+ (set! step3 #t))
+ (set! dx (/ dx 4.0))))))))
+ (set! x (- x (/ (poly-as-vector-eval p1 x) (poly-as-vector-eval pp x))))
+ (set! x (- x (/ (poly-as-vector-eval p1 x) (poly-as-vector-eval pp x))))
+ (if (< (imag-part x) poly-roots-epsilon)
+ (begin
+ (set! x (real-part x))
+ (set! q (poly-as-vector/ q (vector (- x) 1.0)))
+ (set! n (- n 1)))
+ (begin
+ (set! q (poly-as-vector/ q (vector (magnitude x) 0.0 1.0)))
+ (set! n (- n 2))))
+ (set! roots (cons x roots))
+ (if (> n 0)
+ (set! roots (append (poly-as-vector-roots (poly-as-vector-reduce (car q))) roots)))
+ roots))))))))))))
+
+(define poly-roots
+ (let ((documentation "(poly-roots p1) returns the roots of polynomial p1"))
+ (lambda (p1)
+ (let* ((v1 (float-vector->vector (poly-reduce p1)))
+ (roots (poly-as-vector-roots v1)))
+ (for-each
+ (lambda (q)
+ (let ((dx (magnitude (poly-as-vector-eval v1 q))))
+ (if (> dx poly-roots-epsilon) (format #t ";poly.scm 502: (poly-roots ~A) numerical trouble (polynomial root is not very good): ~A at ~A: ~A" p1 v1 q dx))))
+ roots)
+ roots))))
#|
(do ((i 0 (+ i 1))) ((= i 10))
- (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
+ (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0)))))
(do ((i 0 (+ i 1))) ((= i 10))
- (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
+ (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0)))))
(do ((i 0 (+ i 1))) ((= i 10))
- (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
+ (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
(do ((i 0 (+ i 1))) ((= i 10))
- (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
+ (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0)))))
(do ((i 0 (+ i 1))) ((= i 10))
- (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
+ (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
(do ((i 0 (+ i 1))) ((= i 10))
- (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
+ (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0)))))
(do ((i 3 (+ i 1))) ((= i 20))
- (let ((v (make-vct i 0.0)))
+ (let ((v (make-float-vector i 0.0)))
(set! (v 0) (mus-random 1.0))
(set! (v (- i 1)) 1.0)
(poly-roots v)))
(do ((i 3 (+ i 2))) ((= i 21))
- (let ((v (make-vct i 0.0)))
+ (let ((v (make-float-vector i 0.0)))
(set! (v 0) (mus-random 1.0))
(set! (v (- i 1)) 1.0)
(set! (v (/ (- i 1) 2)) 1.0)
@@ -546,23 +613,23 @@
;;; these can be off by a lot!
(do ((i 0 (+ i 1))) ((= i 10))
- (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
+ (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
-(poly-roots (poly* (poly* (poly* (vct -1 1) (vct 1 1)) (poly* (vct -2 1) (vct 2 1))) (poly* (vct -3 1) (vct 3 1)))) -> (-3.0 3.0 -1.0 1.0 -2.0 2.0)
-(poly-roots (poly* (poly* (vct -1 1) (vct 1 1)) (poly* (vct -2 1) (poly* (vct 2 1) (vct 3 1))))) -> (2.0 -1.0 -2.0 -3.0 1.0)
+(poly-roots (poly* (poly* (poly* (float-vector -1 1) (float-vector 1 1)) (poly* (float-vector -2 1) (float-vector 2 1))) (poly* (float-vector -3 1) (float-vector 3 1)))) -> (-3.0 3.0 -1.0 1.0 -2.0 2.0)
+(poly-roots (poly* (poly* (float-vector -1 1) (float-vector 1 1)) (poly* (float-vector -2 1) (poly* (float-vector 2 1) (float-vector 3 1))))) -> (2.0 -1.0 -2.0 -3.0 1.0)
;;; numerical trouble:
-(poly-roots (vct 1000 .01 0 1))
-
- ;; failed to find a root within poly-roots-epsilon -- get the best available
- (let ((s1 backup-s1)
- (s2 backup-s2))
- (list (simplify-complex (- (+ s1 s2) (/ a2 3.0)))
- (simplify-complex (+ (* -0.5 (+ s1 s2))
- (/ a2 -3.0)
- (* (- s1 s2) 0.5 (sqrt -3.0))))
- (simplify-complex (+ (* -0.5 (+ s1 s2))
- (/ a2 -3.0)
- (* (- s1 s2) -0.5 (sqrt -3.0))))))))))
+(poly-roots (float-vector 1000 .01 0 1))
+
+;; failed to find a root within poly-roots-epsilon -- get the best available
+(let ((s1 backup-s1)
+ (s2 backup-s2))
+ (list (simplify-complex (- (+ s1 s2) (/ a2 3.0)))
+ (simplify-complex (+ (* -0.5 (+ s1 s2))
+ (/ a2 -3.0)
+ (* (- s1 s2) 0.5 (sqrt -3.0))))
+ (simplify-complex (+ (* -0.5 (+ s1 s2))
+ (/ a2 -3.0)
+ (* (- s1 s2) -0.5 (sqrt -3.0))))))))))
|#
diff --git a/popup.fs b/popup.fs
index 0a7806c..a81bb00 100644
--- a/popup.fs
+++ b/popup.fs
@@ -1,769 +1,894 @@
-\ -*- snd-forth -*-
\ popup.fs -- popup.scm|rb --> popup.fs
\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Fri Dec 23 00:28:28 CET 2005
-\ Changed: Thu Oct 21 12:17:07 CEST 2010
-
-\ Commentary:
-
-\
-\ Motif and Gtk:
+\ Created: 05/12/23 00:28:28
+\ Changed: 14/11/11 00:07:54
\
+\ @(#)popup.fs 1.42 11/11/14
+
\ selection-popup-menu
\ graph-popup-menu
\ fft-popup-menu
-\
-\ add-popups ( -- )
-\
-\ Motif only:
-\
\ edit-history-menu
\ listener-popup-menu
\
-\ edhist-help-edits ( w c i -- )
-\ change-menu-color ( menu new-color -- )
-\ change-selection-popup-color ( new-color -- )
-\ change-graph-popup-color ( new-color -- )
-\ change-fft-popup-color ( new-color -- )
-\ change-edhist-popup-color ( new-color -- )
-\ change-listener-popup-color ( new-color -- )
-
-\ Code:
+\ add-popups ( -- )
+\
+\ edhist-help-edits ( w c i -- )
+\ change-menu-color ( menu new-color -- )
+\ change-selection-popup-color ( new-color -- )
+\ change-graph-popup-color ( new-color -- )
+\ change-fft-popup-color ( new-color -- )
+\ change-edhist-popup-color ( new-color -- )
+\ change-listener-popup-color ( new-color -- )
-'snd-nogui provided? [if] skip-file [then]
+'snd-motif provided? [unless] skip-file [then]
require snd-xm
require extensions
-\ if not configured --with-static-xm|g
-'snd-motif provided? 'xm provided? not && [if] dl-load libxm Init_libxm [then]
-'snd-gtk provided? 'xg provided? not && [if] dl-load libxg Init_libxg [then]
-
\ for prefs
: edhist-help-edits <{ w c info -- }>
- $" Edit History Functions"
- $" This popup menu gives access to the edit-list function handlers in Snd. \
-At any time you can backup in the edit list, 'save' the current trailing edits, make some \
-new set of edits, then 'reapply' the saved edits. The 'apply' choice gives access to all \
-currently saved edit lists -- any such list can be applied to any channel. 'Clear' deletes \
-all saved edit lists."
- #( $" {edit lists}" $" {edit-list->function}" )
- #( $" extsnd.html#editlists" $" extsnd.html#editlist_to_function" )
- help-dialog drop
+ "Edit History Functions"
+ "This popup menu gives access to the edit-list \
+function handlers in Snd. \
+At any time you can backup in the edit list, \
+'save' the current trailing edits, make some \
+new set of edits, then 'reapply' the saved edits. \
+The 'apply' choice gives access to all \
+currently saved edit lists -- any such list can be applied to any channel. \
+'Clear' deletes all saved edit lists."
+ #( "{edit lists}" "{edit-list->function}" )
+ #( "extsnd.html#editlists" "extsnd.html#editlist_to_function" )
+ help-dialog drop
;
+1 "PROC is the only argument." create-hook edhist-save-hook
+
hide
#() value cascade-popup-cb-list
-'snd-gtk provided? [if]
- #{} value popup-widget-names
- : widget->name ( w -- s ) popup-widget-names swap hash-ref ;
-
- : popup-post-it { menu info -- }
- menu Fgtk_widget_show drop
- menu FGTK_MENU #f #f #f #f 2 info Fgdk_event_get_time Fgtk_menu_popup drop
- ;
-
- \ --- make-simple-popdown-menu for fft-popup-menu ---
- \ cb: ( w d unused -- val )
- \ so we can use existing motif callbacks
- : popup-menu-cb ( cb -- proc ; w d self -- val )
- { cb }
- 2 proc-create cb , ( proc )
- does> { w d self -- val }
- self @ ( cb ) #( w d #f ) run-proc ( val )
- d Fgtk_widget_hide drop
- ;
-
- : make-simple-popdown-menu { top popdown-labels cascade-cb -- }
- Fgtk_menu_new { menu }
- top FGTK_MENU_ITEM menu Fgtk_menu_item_set_submenu drop
- #() { children }
- \ popdown-labels #( #( name cb ) ... )
- popdown-labels each { poplab }
- poplab 0 array-ref Fgtk_menu_item_new_with_label { child }
- menu FGTK_MENU_SHELL child Fgtk_menu_shell_append drop
- child Fgtk_widget_show drop
- child "activate" poplab 1 array-ref popup-menu-cb menu Fg_signal_connect drop
- children child array-push drop
- end-each
- cascade-popup-cb-list #( cascade-cb children ) array-push drop
- ;
-
- \ general entries:
- \ entries: #( #( name type cb func ) ... )
- : make-popup-menu ( name parent entries -- menu )
- { name parent entries }
- Fgtk_menu_new { menu }
- entries each { entry }
- entry 0 array-ref { label } \ string
- entry 1 array-ref { typ } \ symbols 'label, 'separator, 'cascade, or #f
- typ 'separator = if Fgtk_menu_item_new else label Fgtk_menu_item_new_with_label then { wid }
- menu FGTK_MENU_SHELL wid Fgtk_menu_shell_append drop
- typ 'cascade = if \ fft menu
- \ entry: #( label type labels cascade-cb )
- wid entry 2 array-ref entry 3 array-ref make-simple-popdown-menu
- else
- \ cb: proc of 3 args or #f
- entry 2 array-ref ?dup-if wid "activate" rot popup-menu-cb menu Fg_signal_connect drop then
- \ func: proc of 1 arg or #f
- entry 3 array-ref ?dup-if #( wid ) run-proc drop then
- then
- wid Fgtk_widget_show drop
- popup-widget-names wid label hash-set!
- end-each
- menu
- ;
-[else]
- : widget->name ( w -- s ) FXtName ;
-
- : popup-post-it { menu info -- }
- info menu Fset_menuToPost drop
- ;
-
- \ --- make-simple-popdown-menu for fft-popup-menu ---
- : popup-cascade-cb { children cb -- prc; w c i self -- }
- 3 proc-create cb , children ,
- does> { w c info self -- }
- self @ { cb }
- self cell+ @ { children }
- cb #( children ) run-proc drop
- ;
-
- : make-simple-popdown-menu { label popdown-labels parent cascade-cb -- }
- parent label #( FXmNbackground highlight-color ) undef FXmCreatePulldownMenu { top }
- label FxmCascadeButtonWidgetClass parent
- #( FXmNbackground highlight-color FXmNsubMenuId top ) undef FXtCreateManagedWidget { menu }
- #() { children }
- popdown-labels proc? if
- \ edhist sends a proc to set TOP to edhist-widgets
- popdown-labels #( top ) run-proc drop
- else
- \ else arrays of #(name proc) lists
- popdown-labels each { poplab }
- poplab 0 array-ref FxmPushButtonWidgetClass top
- #( FXmNbackground highlight-color ) undef FXtCreateManagedWidget { child }
- child FXmNactivateCallback poplab 1 array-ref undef FXtAddCallback drop
- children child array-push drop
- end-each
- then
- cascade-cb if
- menu FXmNcascadingCallback children cascade-cb popup-cascade-cb undef FXtAddCallback drop
- then
- ;
-
- \ --- make-popdown-entry for listener-popup-menu ---
- #() value listener-values
-
- : collector-cb { func collector -- prc; w c i self -- val }
- 3 proc-create func , collector ,
- does> { w c info self -- val }
- self @ { func }
- self cell+ @ { collector }
- collector #( sounds ) run-proc ( lst ) 0 array-ref 1 >array func swap run-proc
- ;
-
- : cas-cb ( func -- prc; w c i self -- val )
- 3 proc-create swap ,
- does> { w c info self -- val }
- self @ ( func ) #( w current-label 0 find-sound ) run-proc
- ;
-
- : popdown-cascade-cb { func collector menu children -- prc; w c i self -- }
- 3 proc-create func , collector , menu , children ,
- does> { w c info self -- }
- self @ { func }
- self cell+ @ { collector }
- self 2 cells + @ { menu }
- self 3 cells + @ { children }
- children each FXtUnmanageChild drop end-each
- collector #( sounds ) run-proc { snds }
- children length { clen }
- snds length { slen }
- clen slen < if
- slen clen ?do
- "" FxmPushButtonWidgetClass menu
- #( FXmNbackground highlight-color ) undef FXtCreateManagedWidget { child }
- child FXmNactivateCallback func cas-cb undef FXtAddCallback drop
- children child array-push drop
- loop
- then
- slen if
- children each { child }
- snds i array-ref { snd }
- child snd short-file-name change-label
- child FXtManageChild drop
- end-each
- then
- ;
-
- : make-popdown-entry { label parent func collector with-one -- values }
- #f { widget }
- #() { children }
- with-one if
- label FxmPushButtonWidgetClass parent
- #( FXmNbackground highlight-color ) undef FXtCreateManagedWidget to widget
- widget FXmNactivateCallback func collector collector-cb undef FXtAddCallback drop
- then
- parent label #( FXmNbackground highlight-color ) undef FXmCreatePulldownMenu { menu }
- label FxmCascadeButtonWidgetClass parent
- #( FXmNbackground highlight-color FXmNsubMenuId menu ) undef FXtCreateManagedWidget { cas-wid }
- cas-wid FXmNcascadingCallback
- func collector menu children popdown-cascade-cb undef FXtAddCallback drop
- listener-values #( widget menu cas-wid collector ) array-push drop
- ;
-
- \ --- make-popup-menu for graph-, fft-, and listener-menu ---
- \
- \ general entries:
- \ entries: #( #( name type cb func ) ... )
- \
- \ simple popdown (fft-menu)
- \ entries: #( #( name type labels-array cb ) ... )
- \
- \ special popdown (listener)
- \ entries: #( #( name type func collector with-one ) ... )
- : make-popup-menu ( name parent entries -- menu )
- { name parent entries }
- parent name
- #( FXmNpopupEnabled FXmPOPUP_AUTOMATIC
- FXmNbackground highlight-color ) undef FXmCreatePopupMenu { menu }
- entries each { entry }
- #f { casc }
- entry 0 array-ref { label } \ string
- entry 1 array-ref { typ } \ symbols 'label, 'separator, 'cascade, or #f
- typ 'label = if
- FxmLabelWidgetClass
- else
- typ 'separator = if
- FxmSeparatorWidgetClass
+: widget->name ( w -- s )
+ FXtName
+;
+
+: popup-post-it { menu info -- }
+ info menu Fset_menuToPost drop
+;
+
+\ --- make-simple-popdown-menu for fft-popup-menu ---
+: popup-cascade-cb { children cb -- prc; w c i self -- }
+ 3 proc-create ( prc )
+ cb , children ,
+ does> { w c info self -- }
+ self @ { cb }
+ self cell+ @ { children }
+ cb #( children ) run-proc drop
+;
+
+: make-simple-popdown-menu { label popdown-labels parent cascade-cb -- }
+ parent label #( FXmNbackground highlight-color )
+ undef FXmCreatePulldownMenu { top }
+ label FxmCascadeButtonWidgetClass parent
+ #( FXmNbackground highlight-color FXmNsubMenuId top )
+ undef FXtCreateManagedWidget { menu }
+ #() { children }
+ nil { c }
+ popdown-labels proc? if
+ \ edhist sends a proc to set TOP to edhist-widgets
+ popdown-labels #( top ) run-proc drop
else
- FxmPushButtonWidgetClass
+ \ else arrays of #( name proc ) lists
+ popdown-labels each { poplab }
+ poplab 0 array-ref FxmPushButtonWidgetClass top
+ #( FXmNbackground highlight-color )
+ undef FXtCreateManagedWidget to c
+ c FXmNactivateCallback poplab 1 array-ref
+ undef FXtAddCallback drop
+ children c array-push drop
+ end-each
+ then
+ cascade-cb if
+ menu FXmNcascadingCallback
+ children cascade-cb popup-cascade-cb
+ undef FXtAddCallback drop
then
- then { class }
- typ 'cascade = if
- entry length 4 = if \ fft menu
- label
- entry 2 array-ref ( labels )
- menu
- entry 3 array-ref ( prc ) make-simple-popdown-menu
- else \ listener menu
- label menu
- entry 2 array-ref ( func )
- entry 3 array-ref ( collector )
- entry 4 array-ref ( with-one ) make-popdown-entry
+;
+
+\ --- make-popdown-entry for listener-popup-menu ---
+#() value listener-values
+
+: collector-cb { func collector -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ func , collector ,
+ does> { w c info self -- val }
+ self @ { func }
+ self cell+ @ { collector }
+ collector #( sounds ) run-proc ( lst )
+ 0 array-ref 1 >array func swap run-proc
+;
+
+: cas-cb ( func -- prc; w c i self -- val )
+ { func }
+ 3 proc-create ( prc )
+ func ,
+ does> { w c info self -- val }
+ self @ ( func ) #( w current-label 0 find-sound ) run-proc
+;
+
+: popdown-cascade-cb { func coll menu children -- prc; w c i self -- }
+ 3 proc-create ( prc )
+ func , coll , menu , children ,
+ does> { w c info self -- }
+ self @ { func }
+ self cell+ @ { collector }
+ self 2 cells + @ { menu }
+ self 3 cells + @ { children }
+ children each ( child )
+ FXtUnmanageChild drop
+ end-each
+ collector #( sounds ) run-proc { snds }
+ children length { clen }
+ snds length { slen }
+ clen slen < if
+ slen clen ?do
+ "" FxmPushButtonWidgetClass menu
+ #( FXmNbackground highlight-color )
+ undef FXtCreateManagedWidget { c }
+ c FXmNactivateCallback
+ func cas-cb
+ undef FXtAddCallback drop
+ children c array-push drop
+ loop
then
- else
- label class menu #( FXmNbackground highlight-color ) undef FXtCreateManagedWidget { wid }
- entry 2 array-ref if \ cb: proc of 3 args or #f
- wid FXmNactivateCallback entry 2 array-ref undef FXtAddCallback drop
+ slen if
+ children each { child }
+ snds i array-ref { snd }
+ child snd short-file-name change-label
+ child FXtManageChild drop
+ end-each
then
- entry 3 array-ref if \ func: proc of 1 arg or #f
- entry 3 array-ref #( wid ) run-proc drop
+;
+
+: make-popdown-entry { label parent func collector with-one -- values }
+ #f { widget }
+ #() { children }
+ with-one if
+ label FxmPushButtonWidgetClass parent
+ #( FXmNbackground highlight-color )
+ undef FXtCreateManagedWidget to widget
+ widget FXmNactivateCallback
+ func collector collector-cb
+ undef FXtAddCallback drop
then
- then
- end-each
- menu
- ;
-[then]
+ parent label #( FXmNbackground highlight-color )
+ undef FXmCreatePulldownMenu { menu }
+ label FxmCascadeButtonWidgetClass parent
+ #( FXmNbackground highlight-color
+ FXmNsubMenuId menu )
+ undef FXtCreateManagedWidget { cas-wid }
+ cas-wid FXmNcascadingCallback
+ func collector menu children popdown-cascade-cb
+ undef FXtAddCallback drop
+ listener-values #( widget menu cas-wid collector )
+ array-push drop
+;
+
+\ --- make-popup-menu for graph-, fft-, and listener-menu ---
+\
+\ general entries:
+\ entries: #( #( name type cb func ) ... )
+\
+\ simple popdown (fft-menu)
+\ entries: #( #( name type labels-array cb ) ... )
+\
+\ special popdown (listener)
+\ entries: #( #( name type func collector with-one ) ... )
+: make-popup-menu ( name parent entries -- menu )
+ { name parent entries }
+ parent name
+ #( FXmNpopupEnabled FXmPOPUP_AUTOMATIC
+ FXmNbackground highlight-color )
+ undef FXmCreatePopupMenu { menu }
+ entries each { entry }
+ #f { casc }
+ \ string
+ entry 0 array-ref { label }
+ \ 'label|'separator|'cascade|#f
+ entry 1 array-ref { typ }
+ typ 'label = if
+ FxmLabelWidgetClass
+ else
+ typ 'separator = if
+ FxmSeparatorWidgetClass
+ else
+ FxmPushButtonWidgetClass
+ then
+ then { class }
+ typ 'cascade = if
+ entry length 4 = if \ fft menu
+ label
+ entry 2 array-ref ( labels )
+ menu
+ entry 3 array-ref ( prc )
+ make-simple-popdown-menu
+ else \ listener menu
+ label
+ menu
+ entry 2 array-ref ( func )
+ entry 3 array-ref ( collector )
+ entry 4 array-ref ( with-one )
+ make-popdown-entry
+ then
+ else
+ label class menu
+ #( FXmNbackground highlight-color )
+ undef FXtCreateManagedWidget { wid }
+ entry 2 array-ref if \ cb: 3 args or #f
+ wid FXmNactivateCallback
+ entry 2 array-ref
+ undef FXtAddCallback drop
+ then
+ entry 3 array-ref if \ func: 1 arg or #f
+ entry 3 array-ref #( wid ) run-proc drop
+ then
+ then
+ end-each
+ menu
+;
\ --- selection popup ---
-: sel-stop-play-cb { vars -- prc; self -- }
- 0 proc-create vars ,
- does> { self -- }
- self @ { vars }
- vars :stopping array-assoc-ref if
- vars :stopping #f array-assoc-set!
- ( vars ) :stop-widget array-assoc-ref { w }
- w widget? if w "Play" change-label then
- then
-;
-
-: sel-play-again-cb ( -- ) selection play drop ;
-
-: sel-play-cb { vars -- prc; w c i self -- }
- 3 proc-create vars ,
- does> { w c info self -- }
- self @ { vars }
- vars :stopping array-assoc-ref if
- w "Play" change-label
- vars :stopping #f array-assoc-set!
- ( vars ) :stopping1 array-assoc-ref if
- vars :stopping1 #f array-assoc-set!
- ( vars ) :stop-widget1 array-assoc-ref $" Loop play" change-label
- stop-playing-selection-hook <'> sel-play-again-cb remove-hook! drop
- then
- undef stop-playing drop
- else
- w "Stop" change-label
- vars :stop-widget w array-assoc-set!
- ( vars ) :stopping #t array-assoc-set! drop
- selection play drop
- then
-;
-
-: sel-loop-cb { vars -- prc; w c i self -- }
- 3 proc-create vars ,
- does> { w c info self -- }
- self @ { vars }
- vars :stopping1 array-assoc-ref if
- w $" Loop play" change-label
- vars :stopping1 #f array-assoc-set!
- ( vars ) :stopping array-assoc-ref if
- vars :stopping #f array-assoc-set!
- ( vars ) :stop-widget array-assoc-ref "Play" change-label
- then
- stop-playing-selection-hook <'> sel-play-again-cb remove-hook! drop
- undef stop-playing drop
- else
- w "Stop!" change-label
- vars :stop-widget1 w array-assoc-set!
- ( vars ) :stopping1 #t array-assoc-set! drop
- stop-playing-selection-hook <'> sel-play-again-cb add-hook!
- selection play drop
- then
-;
-
-: as-one-edit-thunk { sel -- prc; self -- }
- 0 proc-create sel ,
- does> { self -- }
- self @ { sel }
- sel 0 array-ref { snd }
- sel 1 array-ref { chn }
- snd chn selection-position { beg }
- snd chn selection-frames { len }
- beg 0> if 0 beg snd chn delete-samples drop then
- snd chn #f frames { frms }
- len frms < if len 1+ frms len - snd chn delete-samples drop then
-;
-
-: sel-del <{ w c info -- val }> delete-selection ;
-
-: sel-zero <{ w c info -- val }> 0.0 scale-selection-by ;
-
-: sel-crop <{ w c info -- }>
- selection-members each ( sel ) as-one-edit-thunk "" as-one-edit drop end-each
-;
-
-: sel-save-as <{ w c info -- val }> #t save-selection-dialog ;
-
-: sel-copy <{ w c info -- }>
- snd-tempnam { new-file-name }
- new-file-name save-selection drop
- new-file-name open-sound drop
+: sel-stop-play-cb { vars -- prc; self -- val }
+ 0 proc-create ( prc )
+ vars ,
+ does> { self -- val }
+ self @ { vars }
+ vars :stopping array-assoc-ref if
+ vars :stopping #f array-assoc-set!
+ ( vars ) :stop-widget array-assoc-ref { w }
+ w widget? if
+ w "Play" change-label
+ then
+ then
+ #f
+;
+
+: sel-play-again-cb ( -- val )
+ selection play
+;
+
+: sel-play-cb { vars -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ vars ,
+ does> { w c info self -- val }
+ self @ { vars }
+ vars :stopping array-assoc-ref if
+ w "Play" change-label
+ vars :stopping #f array-assoc-set!
+ ( vars ) :stopping1 array-assoc-ref if
+ vars :stopping1 #f array-assoc-set!
+ ( vars ) :stop-widget1 array-assoc-ref
+ "Loop play" change-label
+ stop-playing-selection-hook
+ <'> sel-play-again-cb remove-hook! drop
+ then
+ undef stop-playing
+ else
+ w "Stop" change-label
+ vars :stop-widget w array-assoc-set!
+ ( vars ) :stopping #t array-assoc-set! drop
+ selection play
+ then
+;
+
+: sel-loop-cb { vars -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ vars ,
+ does> { w c info self -- val }
+ self @ { vars }
+ vars :stopping1 array-assoc-ref if
+ w "Loop play" change-label
+ vars :stopping1 #f array-assoc-set!
+ ( vars ) :stopping array-assoc-ref if
+ vars :stopping #f array-assoc-set!
+ ( vars ) :stop-widget array-assoc-ref "Play" change-label
+ then
+ stop-playing-selection-hook
+ <'> sel-play-again-cb remove-hook! drop
+ undef stop-playing
+ else
+ w "Stop!" change-label
+ vars :stop-widget1 w array-assoc-set!
+ ( vars ) :stopping1 #t array-assoc-set! drop
+ stop-playing-selection-hook <'> sel-play-again-cb add-hook!
+ selection play
+ then
+;
+
+: as-one-edit-thunk { sel -- prc; self -- val }
+ 0 proc-create ( prc )
+ sel ,
+ does> { self -- val }
+ self @ { sel }
+ sel 0 array-ref { snd }
+ sel 1 array-ref { chn }
+ snd chn selection-position { beg }
+ snd chn selection-framples { len }
+ beg 0> if
+ 0 beg snd chn delete-samples drop
+ then
+ snd chn #f framples { frms }
+ len frms < if
+ len 1+ frms len - snd chn delete-samples drop
+ then
+ #f
+;
+
+: sel-del <{ w c info -- val }>
+ delete-selection
+;
+
+: sel-zero <{ w c info -- val }>
+ 0.0 scale-selection-by
+;
+
+: sel-crop <{ w c info -- val }>
+ selection-members each ( sel )
+ as-one-edit-thunk "" as-one-edit drop
+ end-each
+ #f
+;
+
+: sel-save-as <{ w c info -- val }>
+ #t save-selection-dialog
+;
+
+: sel-copy <{ w c info -- val }>
+ snd-tempnam { new-file-name }
+ new-file-name save-selection drop
+ new-file-name open-sound
;
: sel-cut <{ w c info -- val }>
- snd-tempnam { new-file-name }
- new-file-name save-selection drop
- delete-selection drop
- new-file-name open-sound
+ snd-tempnam { new-file-name }
+ new-file-name save-selection drop
+ delete-selection drop
+ new-file-name open-sound
;
-: sel-marks <{ w c info -- }>
- selection-members each { select }
- select 0 array-ref { snd }
- select 1 array-ref { chn }
- snd chn selection-position { pos }
- snd chn selection-frames 1- { len }
- pos snd chn #f 0 add-mark drop
- pos len d+ snd chn #f 0 add-mark drop
- end-each
+: sel-marks <{ w c info -- val }>
+ selection-members each { select }
+ select 0 array-ref { snd }
+ select 1 array-ref { chn }
+ snd chn selection-position { pos }
+ snd chn selection-framples 1- { len }
+ pos snd chn #f 0 add-mark drop
+ pos len d+ snd chn #f 0 add-mark drop
+ end-each
+ #f
;
: sel-info <{ w c info -- val }>
- #f #f selection-position { beg }
- #f #f selection-frames { len }
- $" start: %d, %.3f\n" #( beg beg #f srate f/ ) string-format { str }
- $" end: %d, %.3f\n" #( beg len + dup #f srate f/ ) string-format str swap << to str
- $" duration: %d, %.3f\n" #( len len #f srate f/ ) string-format str swap << to str
- $" chans: %d\n" selection-chans string-format str swap << to str
- $" maxamp: %.3f\n" #f #f selection-maxamp string-format str swap << to str
- $" Selection Info" str info-dialog drop
+ #f #f selection-position { beg }
+ #f #f selection-framples { len }
+ " start: %d, %.3f\n" #( beg beg #f srate f/ ) string-format ( str )
+ " end: %d, %.3f\n" #( beg len + dup #f srate f/ ) string-format $+
+ " duration: %d, %.3f\n" #( len len #f srate f/ ) string-format $+
+ " chans: %d\n" #( selection-chans ) string-format $+
+ " maxamp: %.3f\n" #( #f #f selection-maxamp ) string-format $+ { str }
+ "Selection Info" str info-dialog
;
\ choice 2 == selection
-: sel-appcnt <{ w c info -- val }> #f 2 0 undef apply-controls ;
-: sel-rescnt <{ w c info -- val }> #f reset-controls ;
-: sel-unsel <{ w c info -- val }> #f #t set-selection-member? ;
-: sel-rev <{ w c info -- val }> reverse-selection ;
-: sel-mix <{ w c info -- val }> #f #f #f cursor mix-selection ;
-: sel-invert <{ w c info -- val }> -1.0 scale-selection-by ;
+: sel-appcnt <{ w c info -- val }>
+ #f 2 0 undef apply-controls
+;
+
+: sel-rescnt <{ w c info -- val }>
+ #f reset-controls
+;
+
+: sel-unsel <{ w c info -- val }>
+ #f #t set-selection-member?
+;
+
+: sel-rev <{ w c info -- val }>
+ reverse-selection
+;
+
+: sel-mix <{ w c info -- val }>
+ #f #f #f cursor mix-selection
+;
+
+: sel-invert <{ w c info -- val }>
+ -1.0 scale-selection-by
+;
let: ( -- menu )
- #a( :stopping #f :stopping1 #f :stop-widget #f :stop-widget1 #f ) { vars }
- stop-playing-selection-hook vars sel-stop-play-cb add-hook!
- "selection-popup" main-widgets 2 array-ref
- #( #( $" Selection" 'label #f #f )
- #( $" sep" 'separator #f #f )
- #( $" Play" #f vars sel-play-cb #f )
- #( $" Loop play" #f vars sel-loop-cb #f )
- #( $" Delete" #f <'> sel-del #f )
- #( $" Zero" #f <'> sel-zero #f )
- #( $" Crop" #f <'> sel-crop #f )
- #( $" Save as" #f <'> sel-save-as #f )
- #( $" Copy->New" #f <'> sel-copy #f )
- #( $" Cut->New" #f <'> sel-cut #f )
- #( $" Snap marks" #f <'> sel-marks #f )
- #( $" Selection Info" #f <'> sel-info #f )
- #( $" Apply controls" #f <'> sel-appcnt #f )
- #( $" Reset controls" #f <'> sel-rescnt #f )
- #( $" Unselect" #f <'> sel-unsel #f )
- #( $" Reverse" #f <'> sel-rev #f )
- #( $" Mix" #f <'> sel-mix #f )
- #( $" Invert" #f <'> sel-invert #f ) ) make-popup-menu
+ #a( :stopping #f
+ :stopping1 #f
+ :stop-widget #f
+ :stop-widget1 #f ) { vars }
+ stop-playing-selection-hook vars sel-stop-play-cb add-hook!
+ "selection-popup" main-widgets 2 array-ref
+ #( #( "Selection" 'label #f #f )
+ #( "sep" 'separator #f #f )
+ #( "Play" #f vars sel-play-cb #f )
+ #( "Loop play" #f vars sel-loop-cb #f )
+ #( "Delete" #f <'> sel-del #f )
+ #( "Zero" #f <'> sel-zero #f )
+ #( "Crop" #f <'> sel-crop #f )
+ #( "Save as" #f <'> sel-save-as #f )
+ #( "Copy->New" #f <'> sel-copy #f )
+ #( "Cut->New" #f <'> sel-cut #f )
+ #( "Snap marks" #f <'> sel-marks #f )
+ #( "Selection Info" #f <'> sel-info #f )
+ #( "Apply controls" #f <'> sel-appcnt #f )
+ #( "Reset controls" #f <'> sel-rescnt #f )
+ #( "Unselect" #f <'> sel-unsel #f )
+ #( "Reverse" #f <'> sel-rev #f )
+ #( "Mix" #f <'> sel-mix #f )
+ #( "Invert" #f <'> sel-invert #f )
+ ) make-popup-menu
;let constant selection-popup-menu
\ --- time domain popup ---
#f value graph-popup-snd
#f value graph-popup-chn
-: stop-playing-cb ( vars -- prc; snd self -- )
- 1 proc-create swap ,
- does> { snd self -- }
- self @ { vars }
- vars :stopping array-assoc-ref if
- vars :stopping #f array-assoc-set!
- ( vars ) :stop-widget array-assoc-ref ?dup-if "Play" change-label then
- then
-;
-
-: play-cb ( vars -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ { vars }
- vars :stopping array-assoc-ref if
- vars :stopping #f array-assoc-set! drop
- w "Play" change-label
- undef stop-playing drop
- else
- w "Stop" change-label
- vars :stopping #t array-assoc-set! drop
- graph-popup-snd play drop
- then
-;
-
-: stop-cb ( vars -- prc; widget self -- )
- 1 proc-create swap ,
- does> { w self -- }
- self @ ( vars ) :stop-widget w array-assoc-set! drop
-;
-
-: pchan-cb ( vars -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( vars ) :stopping #t array-assoc-set!
- ( vars ) :stop-widget array-assoc-ref "Stop" change-label
- graph-popup-snd :channel graph-popup-chn play drop
-;
-
-: pcur-cb ( vars -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( vars ) :stopping #t array-assoc-set!
- ( vars ) :stop-widget array-assoc-ref "Stop" change-label
- graph-popup-snd :start graph-popup-snd graph-popup-chn #f cursor play drop
-;
-
-: pprev-cb ( vars -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( vars ) :stopping #t array-assoc-set!
- ( vars ) :stop-widget array-assoc-ref "Stop" change-label
- graph-popup-snd
- :channel graph-popup-chn
- :edit-position graph-popup-snd graph-popup-chn edit-position 1- play drop
-;
-
-: porig-cb ( vars -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( vars ) :stopping #t array-assoc-set!
- ( vars ) :stop-widget array-assoc-ref "Stop" change-label
- graph-popup-snd
- :channel graph-popup-chn
- :edit-position 0 play drop
-;
-
-: pundo-cb <{ w c info -- val }> 1 graph-popup-snd graph-popup-chn undo ;
-: predo-cb <{ w c info -- val }> 1 graph-popup-snd graph-popup-chn redo ;
-: prev-cb <{ w c info -- val }> graph-popup-snd revert-sound ;
-: popen-cb <{ w c info -- val }> #t open-file-dialog ;
-: psave-cb <{ w c info -- val }> graph-popup-snd save-sound ;
-: psaveas-cb <{ w c info -- val }> graph-popup-snd select-sound drop #t save-sound-dialog ;
-: pupdate-cb <{ w c info -- val }> graph-popup-snd update-sound ;
-: pclose-cb <{ w c info -- val }> graph-popup-snd close-sound-extend #f ;
+: stop-playing-cb { vars -- prc; snd self -- val }
+ 1 proc-create ( prc )
+ vars ,
+ does> { snd self -- val }
+ self @ { vars }
+ vars :stopping array-assoc-ref if
+ vars :stopping #f array-assoc-set!
+ ( vars ) :stop-widget array-assoc-ref ?dup-if
+ "Play" change-label
+ then
+ then
+ #f
+;
+
+: play-cb { vars -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ vars ,
+ does> { w c info self -- val }
+ self @ { vars }
+ vars :stopping array-assoc-ref if
+ vars :stopping #f array-assoc-set! drop
+ w "Play" change-label
+ undef stop-playing
+ else
+ w "Stop" change-label
+ vars :stopping #t array-assoc-set! drop
+ graph-popup-snd play
+ then
+;
+
+: stop-cb { vars -- prc; widget self -- val }
+ 1 proc-create ( prc )
+ vars ,
+ does> { w self -- val }
+ self @ ( vars ) :stop-widget w array-assoc-set!
+;
+
+: pchan-cb { vars -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ vars ,
+ does> { w c info self -- val }
+ self @ ( vars ) :stopping #t array-assoc-set!
+ ( vars ) :stop-widget array-assoc-ref "Stop" change-label
+ graph-popup-snd :channel graph-popup-chn play
+;
+
+: pcur-cb { vars -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ vars ,
+ does> { w c info self -- val }
+ self @ ( vars ) :stopping #t array-assoc-set!
+ ( vars ) :stop-widget array-assoc-ref "Stop" change-label
+ graph-popup-snd
+ :start graph-popup-snd graph-popup-chn #f cursor
+ play
+;
+
+: pprev-cb { vars -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ vars ,
+ does> { w c info self -- val }
+ self @ ( vars ) :stopping #t array-assoc-set!
+ ( vars ) :stop-widget array-assoc-ref "Stop" change-label
+ graph-popup-snd
+ :channel graph-popup-chn
+ :edit-position graph-popup-snd graph-popup-chn edit-position 1-
+ play
+;
+
+: porig-cb { vars -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ vars ,
+ does> { w c info self -- val }
+ self @ ( vars ) :stopping #t array-assoc-set!
+ ( vars ) :stop-widget array-assoc-ref "Stop" change-label
+ graph-popup-snd :channel graph-popup-chn :edit-position 0 play
+;
+
+: pundo-cb <{ w c info -- val }>
+ 1 graph-popup-snd graph-popup-chn undo
+;
+
+: predo-cb <{ w c info -- val }>
+ 1 graph-popup-snd graph-popup-chn redo
+;
+
+: prev-cb <{ w c info -- val }>
+ graph-popup-snd revert-sound
+;
+
+: popen-cb <{ w c info -- val }>
+ #t open-file-dialog
+;
+
+: psave-cb <{ w c info -- val }>
+ graph-popup-snd save-sound
+;
+
+: psaveas-cb <{ w c info -- val }>
+ graph-popup-snd select-sound drop #t save-sound-dialog
+;
+
+: pupdate-cb <{ w c info -- val }>
+ graph-popup-snd update-sound
+;
+
+: pclose-cb <{ w c info -- val }>
+ graph-popup-snd close-sound-extend
+ #f
+;
: pmixsel-cb <{ w c info -- val }>
- graph-popup-snd graph-popup-chn #f cursor
- graph-popup-snd graph-popup-chn mix-selection
+ graph-popup-snd graph-popup-chn #f cursor
+ graph-popup-snd graph-popup-chn mix-selection
;
: pinssel-cb <{ w c info -- val }>
- graph-popup-snd graph-popup-chn #f cursor
- graph-popup-snd graph-popup-chn insert-selection
+ graph-popup-snd graph-popup-chn #f cursor
+ graph-popup-snd graph-popup-chn insert-selection
;
: prepsel-cb <{ w c info -- val }>
- graph-popup-snd { snd }
- graph-popup-chn { chn }
- snd chn #f cursor { beg }
- snd chn selection-frames { len }
- snd chn selection-position { sbeg }
- snd chn selection-member? not
- beg len + sbeg < ||
- beg sbeg len + > || if
- beg len snd chn #f delete-samples drop
- beg snd chn insert-selection
- else
- beg sbeg < if beg sbeg beg - snd chn #f delete-samples then
- then
-;
-
-: pselall-cb <{ w c info -- val }> graph-popup-snd graph-popup-chn select-all ;
-: punsel-cb <{ w c info -- val }> #f #t set-selection-member? ;
-: papcnt-cb <{ w c info -- val }> #f 0 0 undef apply-controls ;
-: precnt-cb <{ w c info -- val }> #f reset-controls ;
+ graph-popup-snd { snd }
+ graph-popup-chn { chn }
+ snd chn #f cursor { beg }
+ snd chn selection-framples { len }
+ snd chn selection-position { sbeg }
+ snd chn selection-member? not
+ beg len + sbeg < ||
+ beg sbeg len + > || if
+ beg len snd chn #f delete-samples drop
+ beg snd chn insert-selection
+ else
+ beg sbeg < if
+ beg sbeg beg - snd chn #f delete-samples
+ else
+ #f
+ then
+ then
+;
+
+: pselall-cb <{ w c info -- val }>
+ graph-popup-snd graph-popup-chn select-all
+;
+
+: punsel-cb <{ w c info -- val }>
+ #f #t set-selection-member?
+;
+
+: papcnt-cb <{ w c info -- val }>
+ #f 0 0 undef apply-controls
+;
+
+: precnt-cb <{ w c info -- val }>
+ #f reset-controls
+;
: print-props { props -- str }
- "" { str }
- object-print-length { old-len }
- print-length { old-vct-len }
- 3 set-object-print-length
- 3 set-print-length drop
- props each { prop } \ ( key . val )
- str $" %s: %s\n" #( prop 0 array-ref prop 1 array-ref ) string-format << to str
- end-each
- old-len set-object-print-length
- old-vct-len set-print-length drop
- str
+ object-print-length { old-len }
+ print-length { old-vct-len }
+ 3 set-object-print-length
+ 3 set-print-length drop
+ "" ( str )
+ props each { prop } \ ( key . val )
+ ( str )
+ " %s: %s\n"
+ #( prop 0 array-ref prop 1 array-ref ) string-format $+
+ end-each
+ ( str )
+ old-len set-object-print-length
+ old-vct-len set-print-length drop
+ ( str )
;
: pinfo-cb <{ w c info -- val }>
- graph-popup-snd { snd }
- graph-popup-chn { chn }
- snd chn #f frames { frms }
- snd srate { sr }
- $" chans: %d, srate: %d\n" #( snd channels sr ) string-format { str }
- $" format: %s [%s]\n"
- #( snd data-format mus-data-format-name snd header-type mus-header-type-name )
- string-format str swap << to str
- $" length: %.3f (%d frames)\n" #( frms sr f/ frms ) string-format str swap << to str
- snd #t #f maxamp each { mx }
- $" %6s %c: %.3f\n" #( "maxamp" [char] A i + mx ) string-format str swap << to str
- end-each
- snd comment empty? unless
- $" comment: %S\n" #( snd comment ) string-format str swap << to str
- then
- snd file-name mus-sound-loop-info { loops }
- loops nil? unless
- $" loop: %s\n" #( loops ) string-format str swap << to str
- then
- snd header-type mus-soundfont = if
- $" sounds: %s\n" #( snd soundfont-info ) string-format str swap << to str
- then
- snd sound-properties { props }
- props nil? unless
- str "properties:\n" << to str
- str props print-props << to str
- then
- snd channels 0 ?do
- snd i channel-properties to props
- props nil? unless
- $" chan %d properties:\n" #( i ) string-format str swap << to str
- str props print-props << to str
- then
- loop
- snd file-name $" info" $+ str info-dialog
+ graph-popup-snd { snd }
+ graph-popup-chn { chn }
+ snd chn #f framples { frms }
+ snd srate { sr }
+ " chans: %d, srate: %d\n" #( snd channels sr ) string-format ( str )
+ " format: %s [%s]\n"
+ #( snd sample-type mus-sample-type-name
+ snd header-type mus-header-type-name ) string-format $+
+ " length: %.3f (%d frames)\n" #( frms sr f/ frms ) string-format $+
+ snd #t #f maxamp each { mx }
+ "%6s %c: %.3f\n" #( "maxamp" [char] A i + mx ) string-format $+
+ end-each
+ snd comment empty? unless
+ " comment: %S\n" #( snd comment ) string-format $+
+ then
+ snd file-name mus-sound-loop-info { loops }
+ loops nil? unless
+ " loop: %s\n" #( loops ) string-format $+
+ then
+ snd header-type mus-soundfont = if
+ " sounds: %s\n" #( snd soundfont-info ) string-format $+
+ then
+ snd sound-properties { props }
+ props nil? unless
+ "properties:\n" $+
+ props print-props $+
+ then
+ snd channels 0 ?do
+ snd i channel-properties to props
+ props nil? unless
+ "chan %d properties:\n" #( i ) string-format $+
+ props print-props $+
+ then
+ loop { str }
+ snd file-name " info" $+ str info-dialog
;
: paddmrk-cb <{ w c info -- val }>
- graph-popup-snd graph-popup-chn #f cursor ( samp )
- graph-popup-snd graph-popup-chn #f ( name ) 0 ( sync ) add-mark
+ graph-popup-snd graph-popup-chn #f cursor ( samp )
+ graph-popup-snd graph-popup-chn #f ( name ) 0 ( sync ) add-mark
;
: pdelmrk-cb <{ w c info -- val }>
- graph-popup-snd graph-popup-chn #f marks { ms }
- ms nil? if
- #f
- else
- ms length 1 = if
- ms 0 array-ref delete-mark drop
- else
- graph-popup-snd graph-popup-chn #f cursor { loc }
- ms 0 array-ref { id }
- loc id undef mark-sample - abs { cur-min }
- ms each { m }
- loc m undef mark-sample - abs { this-min }
- this-min cur-min < if
- this-min to cur-min
- m to id
+ graph-popup-snd graph-popup-chn #f marks { ms }
+ ms nil? unless
+ ms length 1 = if
+ ms 0 array-ref delete-mark drop
+ else
+ graph-popup-snd graph-popup-chn #f cursor { loc }
+ ms 0 array-ref { id }
+ loc id undef mark-sample - abs { cur-min }
+ ms each { m }
+ loc m undef mark-sample - abs { this-min }
+ this-min cur-min < if
+ this-min to cur-min
+ m to id
+ then
+ end-each
+ id delete-mark
+ then
then
- end-each
- id delete-mark
- then
- then
+ #f
+;
+
+: pdelamrk-cb <{ w c info -- val }>
+ graph-popup-snd graph-popup-chn delete-marks
;
-: pdelamrk-cb <{ w c info -- val }> graph-popup-snd graph-popup-chn delete-marks ;
-: pnextmrk-cb <{ w c info -- val }> [char] j 4 graph-popup-snd graph-popup-chn key ; \ C-j
+: pnextmrk-cb <{ w c info -- val }>
+ [char] j 4 graph-popup-snd graph-popup-chn key \ C-j
+;
: plastmrk-cb <{ w c info -- val }>
- [char] - 4 graph-popup-snd graph-popup-chn key drop \ C--
- [char] j 4 graph-popup-snd graph-popup-chn key \ C-j
+ [char] - 4 graph-popup-snd graph-popup-chn key drop \ C--
+ [char] j 4 graph-popup-snd graph-popup-chn key \ C-j
;
-: exit-cb <{ w c info -- val }> 0 snd-exit ;
+: exit-cb <{ w c info -- val }>
+ 0 snd-exit
+;
let: ( -- menu )
- #a( :stopping #f :stop-widget #f ) { vars }
- stop-playing-hook vars stop-playing-cb add-hook!
- "graph-popup" main-widgets 2 array-ref
- #( #( $" Snd" 'label #f #f )
- #( $" sep" 'separator #f #f )
- #( $" Play" #f vars play-cb vars stop-cb )
- #( $" Play channel" #f vars pchan-cb #f )
- #( $" Play from cursor" #f vars pcur-cb #f )
- #( $" Play previous" #f vars pprev-cb #f )
- #( $" Play original" #f vars porig-cb #f )
- #( $" Undo" #f <'> pundo-cb #f )
- #( $" Redo" #f <'> predo-cb #f )
- #( $" Revert" #f <'> prev-cb #f )
- #( $" Open" #f <'> popen-cb #f )
- #( $" Save" #f <'> psave-cb #f )
- #( $" Save as" #f <'> psaveas-cb #f )
- #( $" Update" #f <'> pupdate-cb #f )
- #( $" Close" #f <'> pclose-cb #f )
- #( $" Mix selection" #f <'> pmixsel-cb #f )
- #( $" Insert selection" #f <'> pinssel-cb #f )
- #( $" Replace with selection" #f <'> prepsel-cb #f )
- #( $" Select all" #f <'> pselall-cb #f )
- #( $" Unselect" #f <'> punsel-cb #f )
- #( $" Apply controls" #f <'> papcnt-cb #f )
- #( $" Reset controls" #f <'> precnt-cb #f )
- #( $" Info" #f <'> pinfo-cb #f )
- #( $" Add mark" #f <'> paddmrk-cb #f )
- #( $" Delete mark" #f <'> pdelmrk-cb #f )
- #( $" Delete all marks" #f <'> pdelamrk-cb #f )
- #( $" To next mark" #f <'> pnextmrk-cb #f )
- #( $" To last mark" #f <'> plastmrk-cb #f )
- #( $" sep" 'separator #f #f )
- #( $" Exit" #f <'> exit-cb #f ) ) make-popup-menu
+ #a( :stopping #f :stop-widget #f ) { vars }
+ stop-playing-hook vars stop-playing-cb add-hook!
+ "graph-popup" main-widgets 2 array-ref
+ #( #( "Snd" 'label #f #f )
+ #( "sep" 'separator #f #f )
+ #( "Play" #f vars play-cb vars stop-cb )
+ #( "Play channel" #f vars pchan-cb #f )
+ #( "Play from cursor" #f vars pcur-cb #f )
+ #( "Play previous" #f vars pprev-cb #f )
+ #( "Play original" #f vars porig-cb #f )
+ #( "Undo" #f <'> pundo-cb #f )
+ #( "Redo" #f <'> predo-cb #f )
+ #( "Revert" #f <'> prev-cb #f )
+ #( "Open" #f <'> popen-cb #f )
+ #( "Save" #f <'> psave-cb #f )
+ #( "Save as" #f <'> psaveas-cb #f )
+ #( "Update" #f <'> pupdate-cb #f )
+ #( "Close" #f <'> pclose-cb #f )
+ #( "Mix selection" #f <'> pmixsel-cb #f )
+ #( "Insert selection" #f <'> pinssel-cb #f )
+ #( "Replace with selection" #f <'> prepsel-cb #f )
+ #( "Select all" #f <'> pselall-cb #f )
+ #( "Unselect" #f <'> punsel-cb #f )
+ #( "Apply controls" #f <'> papcnt-cb #f )
+ #( "Reset controls" #f <'> precnt-cb #f )
+ #( "Info" #f <'> pinfo-cb #f )
+ #( "Add mark" #f <'> paddmrk-cb #f )
+ #( "Delete mark" #f <'> pdelmrk-cb #f )
+ #( "Delete all marks" #f <'> pdelamrk-cb #f )
+ #( "To next mark" #f <'> pnextmrk-cb #f )
+ #( "To last mark" #f <'> plastmrk-cb #f )
+ #( "sep" 'separator #f #f )
+ #( "Exit" #f <'> exit-cb #f )
+ ) make-popup-menu
;let constant graph-popup-menu
: graph-popup-cb { snd chn -- prc; w self -- }
- 1 proc-create chn , snd , ( prc )
- does> { w self -- }
- self @ { chn }
- self cell+ @ { snd }
- snd chn edits { eds }
- w widget->name { name }
- name $" Snd" string= if
- snd channels 1 > if
- $" %s[%d]" #( snd short-file-name chn ) string-format w swap change-label
- else
- w snd short-file-name change-label
- then
- else
- name $" Save" string=
- name $" Undo" string= ||
- name $" Revert" string= ||
- name $" Play previous" string= || if
- w eds 0 array-ref 0> if show-widget else hide-widget then drop
- else
- name $" Play channel" string= if
- w snd channels 1 > if show-widget else hide-widget then drop
- else
- name $" Redo" string= if
- w eds 1 array-ref 0> if show-widget else hide-widget then drop
- else
- name $" Mix selection" string=
- name $" Insert selection" string= ||
- name $" Unselect" string= ||
- name $" Replace with selection" string= || if
- w undef selection? if show-widget else hide-widget then drop
- else
- name $" Play from cursor" string= if
- w snd chn #f cursor 0> if show-widget else hide-widget then drop
- else
- name $" Play original" string= if
- w eds 0 array-ref 1 > if show-widget else hide-widget then drop
- else
- name $" Delete mark" string=
- name $" Delete all marks" string= ||
- name $" To next mark" string= ||
- name $" To last mark" string= || if
- w snd chn #f marks nil? unless show-widget else hide-widget then drop
+ 1 proc-create ( prc )
+ chn , snd ,
+ does> { w self -- }
+ self @ { chn }
+ self cell+ @ { snd }
+ snd chn edits { eds }
+ w widget->name { name }
+ name "Snd" string= if
+ snd channels 1 > if
+ "%s[%d]"
+ #( snd short-file-name chn )
+ string-format w swap change-label
+ else
+ w snd short-file-name change-label
+ then
+ #f
+ exit
+ then
+ name "Save" string=
+ name "Undo" string= ||
+ name "Revert" string= ||
+ name "Play previous" string= || if
+ w eds 0 array-ref 0> if
+ show-widget
+ else
+ hide-widget
+ then
+ exit
+ then
+ name "Play channel" string= if
+ w snd channels 1 > if
+ show-widget
+ else
+ hide-widget
+ then
+ exit
+ then
+ name "Redo" string= if
+ w eds 1 array-ref 0> if
+ show-widget
+ else
+ hide-widget
then
- then
- then
- then
+ exit
+ then
+ name "Mix selection" string=
+ name "Insert selection" string= ||
+ name "Unselect" string= ||
+ name "Replace with selection" string= || if
+ w undef selection? if
+ show-widget
+ else
+ hide-widget
+ then
+ exit
+ then
+ name "Play from cursor" string= if
+ w snd chn #f cursor 0> if
+ show-widget
+ else
+ hide-widget
+ then
+ exit
+ then
+ name "Play original" string= if
+ w eds 0 array-ref 1 > if
+ show-widget
+ else
+ hide-widget
+ then
+ exit
+ then
+ name "Delete mark" string=
+ name "Delete all marks" string= ||
+ name "To next mark" string= ||
+ name "To last mark" string= || if
+ w snd chn #f marks nil? unless
+ show-widget
+ else
+ hide-widget
+ then
+ else
+ #f
then
- then
- then
- then
;
\ --- fft popup ---
: choose-chan ( -- chn )
- graph-popup-snd channel-style channels-separate = if graph-popup-chn else #t then
+ graph-popup-snd channel-style channels-separate = if
+ graph-popup-chn
+ else
+ #t
+ then
;
: fft-peaks-cb <{ w c info -- val }>
- graph-popup-snd graph-popup-chn show-transform-peaks not
- graph-popup-snd choose-chan set-show-transform-peaks
+ graph-popup-snd graph-popup-chn show-transform-peaks not
+ graph-popup-snd choose-chan set-show-transform-peaks
;
: fft-db-cb <{ w c info -- val }>
- graph-popup-snd graph-popup-chn fft-log-magnitude not
- graph-popup-snd choose-chan set-fft-log-magnitude
+ graph-popup-snd graph-popup-chn fft-log-magnitude not
+ graph-popup-snd choose-chan set-fft-log-magnitude
;
: fft-frq-cb <{ w c info -- val }>
- graph-popup-snd graph-popup-chn fft-log-frequency not
- graph-popup-snd choose-chan set-fft-log-frequency
+ graph-popup-snd graph-popup-chn fft-log-frequency not
+ graph-popup-snd choose-chan set-fft-log-frequency
;
: fft-norm-cb <{ w c info -- val }>
- graph-popup-snd graph-popup-chn transform-normalization dont-normalize = if
- normalize-by-channel graph-popup-snd choose-chan set-transform-normalization
- else
- dont-normalize graph-popup-snd choose-chan set-transform-normalization
- then
+ graph-popup-snd graph-popup-chn
+ transform-normalization dont-normalize = if
+ normalize-by-channel graph-popup-snd choose-chan
+ else
+ dont-normalize graph-popup-snd choose-chan
+ then set-transform-normalization
;
-: grp-lst-cb ( val -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( val ) graph-popup-snd choose-chan set-transform-graph-type drop
+: grp-lst-cb { val -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ val ,
+ does> { w c info self -- val }
+ self @ ( val ) graph-popup-snd choose-chan set-transform-graph-type
;
: grp-labs ( -- ary )
- #( #( "once" graph-once grp-lst-cb )
- #( "sonogram" graph-as-sonogram grp-lst-cb )
- #( "spectrogram" graph-as-spectrogram grp-lst-cb ) )
+ #( #( "once" graph-once grp-lst-cb )
+ #( "sonogram" graph-as-sonogram grp-lst-cb )
+ #( "spectrogram" graph-as-spectrogram grp-lst-cb ) )
;
: grp-set <{ lst -- }>
- graph-popup-snd graph-popup-chn transform-graph-type { tp }
- lst each ( child ) i tp <> set-sensitive end-each
+ graph-popup-snd graph-popup-chn transform-graph-type { tp }
+ lst each ( child )
+ i tp <> set-sensitive
+ end-each
;
-#( 16 64 256 1024 4096 16384 65536 262144 1048576 ) constant fft-siz-sizes
-: siz-lst-cb ( val -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( val ) graph-popup-snd choose-chan set-transform-size drop
+#( 16 64 256 512 1024 4096 16384 65536 262144 1048576 ) constant fft-siz-sizes
+
+: siz-lst-cb { val -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ val ,
+ does> { w c info self -- val }
+ self @ ( val ) graph-popup-snd choose-chan set-transform-size
;
: siz-labs ( -- ary )
- fft-siz-sizes map #( *key* object->string *key* siz-lst-cb ) end-map ( ary )
+ fft-siz-sizes map
+ #( *key* object->string *key* siz-lst-cb )
+ end-map ( ary )
;
: siz-set <{ lst -- }>
- graph-popup-snd graph-popup-chn transform-size { siz }
- lst each ( child ) fft-siz-sizes i array-ref siz <> set-sensitive end-each
+ graph-popup-snd graph-popup-chn transform-size { siz }
+ lst each ( child )
+ fft-siz-sizes i array-ref siz <> set-sensitive
+ end-each
;
#( rectangular-window
@@ -796,47 +921,54 @@ let: ( -- menu )
bartlett-hann-window
bohman-window
flat-top-window ) constant fft-win-windows
-: win-lst-cb ( val -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( val ) graph-popup-snd choose-chan set-fft-window drop
+
+: win-lst-cb { val -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ val ,
+ does> { w c info self -- val }
+ self @ ( val ) graph-popup-snd choose-chan set-fft-window
;
: win-labs ( -- ary )
- #( "Rectangular"
- "Hann"
- "Welch"
- "Parzen"
- "Bartlett"
- "Hamming"
- "Blackman2"
- "Blackman3"
- "Blackman4"
- "Blackman5"
- "Blackman6"
- "Blackman7"
- "Blackman8"
- "Blackman9"
- "Blackman10"
- "Exponential"
- "Riemann"
- "Kaiser"
- "Cauchy"
- "Poisson"
- "Gaussian"
- "Tukey"
- "Dolph-Chebyshev"
- "Hann-Poisson"
- "Connes"
- "Samaraki"
- "Ultraspherical"
- "Bartlett-Hann"
- "Bohman"
- "Flat-top" ) map #( *key* fft-win-windows i array-ref win-lst-cb ) end-map
+ #( "Rectangular"
+ "Hann"
+ "Welch"
+ "Parzen"
+ "Bartlett"
+ "Hamming"
+ "Blackman2"
+ "Blackman3"
+ "Blackman4"
+ "Blackman5"
+ "Blackman6"
+ "Blackman7"
+ "Blackman8"
+ "Blackman9"
+ "Blackman10"
+ "Exponential"
+ "Riemann"
+ "Kaiser"
+ "Cauchy"
+ "Poisson"
+ "Gaussian"
+ "Tukey"
+ "Dolph-Chebyshev"
+ "Hann-Poisson"
+ "Connes"
+ "Samaraki"
+ "Ultraspherical"
+ "Bartlett-Hann"
+ "Bohman"
+ "Flat-top" ) map
+ #( *key* fft-win-windows i array-ref win-lst-cb )
+ end-map
;
+
: win-set <{ lst -- }>
- graph-popup-snd graph-popup-chn fft-window { win }
- lst each ( child ) fft-win-windows i array-ref win <> set-sensitive end-each
+ graph-popup-snd graph-popup-chn fft-window { win }
+ lst each ( child )
+ fft-win-windows i array-ref win <> set-sensitive
+ end-each
;
#( fourier-transform
@@ -845,478 +977,581 @@ let: ( -- menu )
cepstrum
walsh-transform
haar-transform ) value fft-trn-transform
-: trn-lst-cb ( val -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( val ) graph-popup-snd choose-chan set-transform-type drop
+
+: trn-lst-cb { val -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ val ,
+ does> { w c info self -- }
+ self @ ( val ) graph-popup-snd choose-chan set-transform-type
;
: trn-labs ( -- ary )
- #( "Fourier" "Wavelet" "Autocorrelate" "Cepstrum" "Walsh" "Haar" ) map
- #( *key* fft-trn-transform i array-ref trn-lst-cb )
- end-map ( ary )
+ #( "Fourier" "Wavelet" "Autocorrelate" "Cepstrum" "Walsh" "Haar" ) map
+ #( *key* fft-trn-transform i array-ref trn-lst-cb )
+ end-map ( ary )
;
: trn-set <{ lst -- }>
- graph-popup-snd graph-popup-chn transform-type { trn }
- lst each ( child ) fft-trn-transform i array-ref trn equal? not set-sensitive end-each
+ graph-popup-snd graph-popup-chn transform-type { trn }
+ lst each ( child )
+ fft-trn-transform i array-ref trn equal? not set-sensitive
+ end-each
;
-: typ-lst-cb ( val -- prc; w c i self -- )
- 3 proc-create swap ,
- does> { w c info self -- }
- self @ ( val ) graph-popup-snd choose-chan set-wavelet-type drop
+: typ-lst-cb { val -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ val ,
+ does> { w c info self -- val }
+ self @ ( val ) graph-popup-snd choose-chan set-wavelet-type
;
: typ-labs ( -- ary )
- #( "doub4"
- "doub6"
- "doub8"
- "doub10"
- "doub12"
- "doub14"
- "doub16"
- "doub18"
- "doub20"
- "battle_lemarie"
- "burt_adelson"
- "beylkin"
- "coif2"
- "coif4"
- "coif6"
- "sym2"
- "sym3"
- "sym4"
- "sym5"
- "sym6" ) map #( *key* i typ-lst-cb ) end-map
+ #( "doub4"
+ "doub6"
+ "doub8"
+ "doub10"
+ "doub12"
+ "doub14"
+ "doub16"
+ "doub18"
+ "doub20"
+ "battle_lemarie"
+ "burt_adelson"
+ "beylkin"
+ "coif2"
+ "coif4"
+ "coif6"
+ "sym2"
+ "sym3"
+ "sym4"
+ "sym5"
+ "sym6" ) map
+ #( *key* i typ-lst-cb )
+ end-map
;
: typ-set <{ lst -- }>
- graph-popup-snd graph-popup-chn wavelet-type { tp }
- lst each ( child ) i tp <> set-sensitive end-each
+ graph-popup-snd graph-popup-chn wavelet-type { tp }
+ lst each ( child )
+ i tp <> set-sensitive
+ end-each
;
-: fft-color <{ w c info -- val }> #t color-orientation-dialog ;
+: fft-color <{ w c info -- val }>
+ #t color-orientation-dialog
+;
let: ( -- menu )
- $" fft-popup" main-widgets 2 array-ref
- #( #( $" Transform" 'label #f #f )
- #( $" sep" 'separator #f #f )
- #( $" Peaks" #f <'> fft-peaks-cb #f )
- #( $" dB" #f <'> fft-db-cb #f )
- #( $" Log freq" #f <'> fft-frq-cb #f )
- #( $" Normalize" #f <'> fft-norm-cb #f )
- #( $" Graph type" 'cascade grp-labs <'> grp-set )
- #( $" Size" 'cascade siz-labs <'> siz-set )
- #( $" Window" 'cascade win-labs <'> win-set )
- #( $" Transform type" 'cascade trn-labs <'> trn-set )
- #( $" Wavelet type" 'cascade typ-labs <'> typ-set )
- #( $" Color/Orientation" #f <'> fft-color #f ) ) make-popup-menu
+ "fft-popup" main-widgets 2 array-ref
+ #( #( "Transform" 'label #f #f )
+ #( "sep" 'separator #f #f )
+ #( "Peaks" #f <'> fft-peaks-cb #f )
+ #( "dB" #f <'> fft-db-cb #f )
+ #( "Log freq" #f <'> fft-frq-cb #f )
+ #( "Normalize" #f <'> fft-norm-cb #f )
+ #( "Graph type" 'cascade grp-labs <'> grp-set )
+ #( "Size" 'cascade siz-labs <'> siz-set )
+ #( "Window" 'cascade win-labs <'> win-set )
+ #( "Transform type" 'cascade trn-labs <'> trn-set )
+ #( "Wavelet type" 'cascade typ-labs <'> typ-set )
+ #( "Color/Orientation" #f <'> fft-color #f )
+ ) make-popup-menu
;let constant fft-popup-menu
-: fft-popup-cb { snd chn -- prc; w self -- }
- 1 proc-create chn , snd , ( prc )
- does> { w self -- }
- self @ { chn }
- self cell+ @ { snd }
- w widget->name { name }
- name $" Peaks" string= if
- w snd chn show-transform-peaks if $" No peaks" else $" Peaks" then change-label
- else
- name $" dB" string= if
- w snd chn fft-log-magnitude if $" Linear" else $" dB" then change-label
- else
- name $" Log freq" string= if
- w snd chn fft-log-frequency if $" Linear freq" else $" Log freq" then change-label
- then
- then
- then
- cascade-popup-cb-list each { entry }
- entry 0 array-ref #( entry 1 array-ref ) run-proc drop
- end-each
+: fft-popup-cb { snd chn -- prc; w self -- val }
+ 1 proc-create ( prc )
+ chn , snd ,
+ does> { w self -- val }
+ self @ { chn }
+ self cell+ @ { snd }
+ w widget->name { name }
+ name "Peaks" string= if
+ w snd chn show-transform-peaks if
+ "No peaks"
+ else
+ "Peaks"
+ then change-label
+ else
+ name "dB" string= if
+ w snd chn fft-log-magnitude if
+ "Linear"
+ else
+ "dB"
+ then change-label
+ else
+ name "Log freq" string= if
+ w snd chn fft-log-frequency if
+ "Linear freq"
+ else
+ "Log freq"
+ then change-label
+ then
+ then
+ then
+ cascade-popup-cb-list each { entry }
+ entry 0 array-ref #( entry 1 array-ref ) run-proc drop
+ end-each
+ #f
;
: popup-install { snd chn xe ye info -- }
- snd to graph-popup-snd
- chn to graph-popup-chn
- snd channel-style channels-combined = if
- #t \ flag
- snd channels 0 ?do
- ye snd i undef axis-info 14 array-ref < if
- i 1- to graph-popup-chn
- not \ toggle flag
- leave
- then
- loop ( flag ) if snd channels 1- to graph-popup-chn then
- then
- snd chn transform-graph? if snd chn transform-graph axis-info else #f then { fax }
- snd chn lisp-graph? if snd chn lisp-graph axis-info else #f then { lax }
- fax if
- xe fax 10 array-ref >=
- xe fax 12 array-ref <= && if
- \ in fft
- fft-popup-menu snd chn fft-popup-cb for-each-child
- fft-popup-menu info popup-post-it
- #f
- else
- #t
- then
- else
- #t
- then if
- lax if
- xe lax 10 array-ref >=
- xe lax 12 array-ref <= && if
- \ in lisp
+ snd to graph-popup-snd
+ chn to graph-popup-chn
+ snd channel-style channels-combined = if
+ #t \ flag
+ snd channels 0 ?do
+ ye snd i undef axis-info 14 array-ref < if
+ i 1- to graph-popup-chn
+ not \ toggle flag
+ leave
+ then
+ loop ( flag ) if
+ snd channels 1- to graph-popup-chn
+ then
+ then
+ snd chn transform-graph? if
+ snd chn transform-graph axis-info
+ else
+ #f
+ then { fax }
+ snd chn lisp-graph? if
+ snd chn lisp-graph axis-info
+ else
+ #f
+ then { lax }
+ fax if
+ xe fax 10 array-ref >=
+ xe fax 12 array-ref <= && if
+ \ in fft
+ fft-popup-menu snd chn fft-popup-cb for-each-child
+ fft-popup-menu info popup-post-it
+ #f
+ else
+ #t
+ then
+ else
+ #t
+ then if
+ lax if
+ xe lax 10 array-ref >=
+ xe lax 12 array-ref <= && if
+ \ in lisp
+ #f
+ else
+ #t
+ then
+ else
+ #t
+ then if
+ undef selection? if
+ snd graph-popup-chn selection-position { pos }
+ snd srate { sr }
+ \ BEG and END should be floats
+ pos sr f/ { beg }
+ pos snd graph-popup-chn selection-framples f+
+ sr f/ { end }
+ xe beg snd chn undef x->position >=
+ xe end snd chn undef x->position <= && if
+ selection-popup-menu info popup-post-it
+ #f
+ else
+ #t
+ then
+ else
+ #t
+ then if
+ graph-popup-menu
+ graph-popup-snd graph-popup-chn
+ graph-popup-cb for-each-child
+ graph-popup-menu info popup-post-it
+ then
+ then
+ then
+;
+
+\ --- edit history popup ---
+#() value edhist-funcs
+#() value edhist-widgets
+#f value edhist-snd
+#f value edhist-chn
+
+: edhist-clear-edits <{ w c info -- #f }>
+ #() to edhist-funcs
#f
- else
- #t
- then
- else
- #t
- then if
- undef selection? if
- snd graph-popup-chn selection-position { pos }
- snd srate { sr }
- pos sr f/ { beg } \ BEG and END should be floats
- pos snd graph-popup-chn selection-frames f+ sr f/ { end }
- xe beg snd chn undef x->position >=
- xe end snd chn undef x->position <= && if
- selection-popup-menu info popup-post-it
- #f
+;
+
+: edhist-save-edits <{ w c info -- val }>
+ edhist-funcs #( edhist-snd edhist-chn )
+ array-assoc-ref { old-proc }
+ edhist-snd edhist-chn edits { cur-edits }
+ edhist-snd edhist-chn cur-edits 0 array-ref
+ 1+ 0 cur-edits each
+ +
+ end-each edit-list->function { proc }
+ edhist-save-hook #( proc ) run-hook drop
+ old-proc proc? if
+ edhist-funcs
+ #( edhist-snd edhist-chn )
+ proc
+ array-assoc-set!
else
- #t
+ edhist-funcs
+ #( #( edhist-snd edhist-chn ) proc )
+ array-push
+ then to edhist-funcs
+;
+
+: edhist-reapply-edits <{ w c info -- val }>
+ edhist-funcs #( edhist-snd edhist-chn ) array-assoc-ref
+ #( edhist-snd edhist-chn ) run-proc
+;
+
+: edhist-set-wid <{ widget -- }>
+ edhist-widgets widget array-push to edhist-widgets
+;
+
+: edhist-apply <{ w c info -- }>
+ edhist-funcs c range? if
+ edhist-funcs c array-ref 1 array-ref ( proc )
+ #( edhist-snd edhist-chn ) run-proc drop
+ then
+;
+
+: edhist-apply-edits <{ lst -- }>
+ edhist-widgets 0 array-ref { parent }
+ edhist-widgets 1 nil array-subarray { wids }
+ edhist-funcs each 0 array-ref { label }
+ nil { button }
+ wids nil? if
+ "wid" FxmPushButtonWidgetClass parent
+ #( FXmNbackground highlight-color )
+ undef FXtCreateManagedWidget to button
+ edhist-widgets #( button )
+ array-append to edhist-widgets
+ button FXmNactivateCallback
+ <'> edhist-apply i FXtAddCallback drop
+ else
+ wids 0 array-ref to button
+ wids 1 nil array-subarray to wids
+ button FXtManageChild drop
+ then
+ label array? if
+ \ label: #(snd chn)
+ button "%s[%s]"
+ #( label 0 array-ref short-file-name
+ label 1 array-ref )
+ string-format change-label
+ else
+ \ label: "file-name[chn]"
+ button label change-label
+ then
+ button #( FXmNuserData i ) FXtVaSetValues drop
+ end-each
+ wids each ( w )
+ FXtUnmanageChild drop
+ end-each
+;
+
+: edhist-close-hook-cb <{ snd -- }>
+ snd channels 0 ?do
+ edhist-funcs #( snd i ) array-assoc { old-val }
+ old-val array? if
+ old-val 0 "%s[%d]"
+ #( snd short-file-name i ) string-format array-set!
+ then
+ loop
+;
+
+let: ( -- menu )
+ close-hook <'> edhist-close-hook-cb add-hook!
+ "edhist-popup" main-widgets 2 array-ref
+ #( #( "Edits" 'label #f #f )
+ #( "sep" 'separator #f #f )
+ #( "Save" #f <'> edhist-save-edits #f )
+ #( "Reapply" #f <'> edhist-reapply-edits #f )
+ #( "Apply" 'cascade <'> edhist-set-wid <'> edhist-apply-edits )
+ #( "Clear" #f <'> edhist-clear-edits #f )
+ #( "sep" 'separator #f #f )
+ #( "Help" #f <'> edhist-help-edits #f )
+ ) make-popup-menu
+;let constant edit-history-menu
+
+: edhist-popup-cb { snd chn -- prc; w self -- val }
+ 1 proc-create ( prc )
+ chn , snd ,
+ does> { w self -- val }
+ self @ { chn }
+ self cell+ @ { snd }
+ w FXtName { name }
+ name "Clear" string=
+ name "Apply" string= || if
+ w edhist-funcs empty? not set-sensitive
+ #f
+ exit
+ then
+ name "Save" string= if
+ w 0 snd chn edits each ( eds )
+ +
+ end-each 0> set-sensitive
+ #f
+ exit
then
- else
- #t
- then if
- graph-popup-menu graph-popup-snd graph-popup-chn graph-popup-cb for-each-child
- graph-popup-menu info popup-post-it
- then
- then
- then
-;
-
-'snd-gtk provided? [if]
- : add-popup <{ widget event data snd chn -- f }>
- event FGDK_EVENT { ev }
- ev Fgdk_event_get_coords { coords }
- coords 1 array-ref f>s { xe }
- coords 2 array-ref f>s { ye }
- snd if snd chn xe ye ev popup-install #t else #f then
- ;
- set-current
-
- : add-popups
- gtk-popup-hook <'> add-popup add-hook!
- ;
-[else]
- \ --- edit history popup ---
- 1 $" edhist-save-edits calls it with PROC as its only argument." create-hook edhist-save-hook
-
- #() value edhist-funcs
- #() value edhist-widgets
- #f value edhist-snd
- #f value edhist-chn
-
- : edhist-clear-edits <{ w c info -- #f }> #() to edhist-funcs #f ;
-
- : edhist-save-edits <{ w c info -- val }>
- edhist-funcs #( edhist-snd edhist-chn ) array-assoc-ref { old-proc }
- edhist-snd edhist-chn edits { cur-edits }
- edhist-snd edhist-chn cur-edits 0 array-ref 1+ 0 cur-edits each
- +
- end-each edit-list->function { proc }
- edhist-save-hook #( proc ) run-hook drop
- old-proc proc? if
- edhist-funcs #( edhist-snd edhist-chn ) proc array-assoc-set!
- else
- edhist-funcs #( #( edhist-snd edhist-chn ) proc ) array-push
- then to edhist-funcs
- ;
-
- : edhist-reapply-edits <{ w c info -- val }>
- edhist-funcs #( edhist-snd edhist-chn ) array-assoc-ref #( edhist-snd edhist-chn ) run-proc
- ;
-
- : edhist-set-wid <{ widget -- }> edhist-widgets widget array-push to edhist-widgets ;
-
- : edhist-apply <{ w c info -- }>
- edhist-funcs c range? if
- edhist-funcs c array-ref 1 array-ref ( proc ) #( edhist-snd edhist-chn ) run-proc drop
- then
- ;
-
- : edhist-apply-edits <{ lst -- }>
- edhist-widgets 0 array-ref { parent }
- edhist-widgets 1 nil array-subarray { wids }
- edhist-funcs each 0 array-ref { label }
- nil { button }
- wids nil? if
- $" wid" FxmPushButtonWidgetClass parent
- #( FXmNbackground highlight-color ) undef FXtCreateManagedWidget to button
- edhist-widgets #( button ) array-append to edhist-widgets
- button FXmNactivateCallback <'> edhist-apply i FXtAddCallback drop
- else
- wids 0 array-ref to button
- wids 1 nil array-subarray to wids
- button FXtManageChild drop
- then
- label array? if
- \ label: #(snd chn)
- button $" %s[%s]" #(
- label 0 array-ref short-file-name
- label 1 array-ref ) format change-label
- else
- \ label: "file-name[chn]"
- button label change-label
- then
- button #( FXmNuserData i ) FXtVaSetValues drop
- end-each
- wids each FXtUnmanageChild drop end-each
- ;
-
- : edhist-close-hook-cb <{ snd -- }>
- snd channels 0 ?do
- edhist-funcs #( snd i ) array-assoc { old-val }
- old-val array? if
- old-val 0 $" %s[%d]" #( snd short-file-name i ) string-format array-set!
- then
- loop
- ;
-
- let: ( -- menu )
- close-hook <'> edhist-close-hook-cb add-hook!
- "edhist-popup" main-widgets 2 array-ref
- #( #( "Edits" 'label #f #f )
- #( "sep" 'separator #f #f )
- #( "Save" #f <'> edhist-save-edits #f )
- #( "Reapply" #f <'> edhist-reapply-edits #f )
- #( "Apply" 'cascade <'> edhist-set-wid <'> edhist-apply-edits )
- #( "Clear" #f <'> edhist-clear-edits #f )
- #( "sep" 'separator #f #f )
- #( "Help" #f <'> edhist-help-edits #f ) ) make-popup-menu
- ;let constant edit-history-menu
-
- : edhist-popup-cb { snd chn -- cb; w self -- }
- 1 proc-create chn , snd ,
- does> { w self -- }
- self @ { chn }
- self cell+ @ { snd }
- w FXtName { name }
- name "Clear" string= name "Apply" string= || if
- w edhist-funcs empty? not set-sensitive
- else
- name "Save" string= if
- w 0 snd chn edits each + end-each 0> set-sensitive
- else
name "Reapply" string= if
- w edhist-funcs #( snd chn ) array-assoc-ref set-sensitive
+ w edhist-funcs #( snd chn )
+ array-assoc-ref set-sensitive
+ then
+ #f
+;
+
+: edhist-popup-handler-cb { snd chn -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ chn , snd ,
+ does> { w c info self -- val }
+ self @ { chn }
+ self cell+ @ { snd }
+ info Fevent { ev }
+ FButtonPress ev Ftype = if
+ snd to edhist-snd
+ chn to edhist-chn
+ edit-history-menu snd chn edhist-popup-cb for-each-child
+ edit-history-menu info popup-post-it
+ then
+ #f
+;
+
+: popup-handler-cb { snd chn -- prc; w c i self -- val }
+ 3 proc-create ( prc )
+ chn , snd ,
+ does> { w c info self -- val }
+ self @ { chn }
+ self cell+ @ { snd }
+ info Fevent { ev }
+ ev Fx_root w 0 0 FXtTranslateCoords 0 array-ref - { xe }
+ ev Fy { ye }
+ FButtonPress ev Ftype = if
+ snd chn xe ye info popup-install
+ then
+ #f
+;
+
+\ --- listener popup ---
+: identity-cb <{ snds -- lst }>
+ snds
+;
+
+: edited-cb <{ snds -- lst }>
+ snds each { snd }
+ snd channels 0 ?do
+ snd i edits 0 array-ref 0= if
+ snds snd array-delete-key drop
+ then
+ loop
+ end-each
+ snds
+;
+
+: focused-cb <{ snds -- lst }>
+ snds length 1 > if
+ snds
+ else
+ #()
+ then
+;
+
+: list-play-cb <{ snd -- val }>
+ snd play
+;
+
+: list-focus-cb <{ us -- val }>
+ \ 5 == notebook-outer-pane
+ main-widgets 5 array-ref FWidget? if
+ us set-selected-sound
+ else
+ us sound-widgets 0 array-ref { pane }
+ main-widgets 1 array-ref #( FXmNallowShellResize #f )
+ FXtVaSetValues drop
+ sounds each ( them )
+ sound-widgets 0 array-ref FXtUnmanageChild drop
+ end-each
+ pane FXtManageChild drop
+ main-widgets 1 array-ref
+ #( FXmNallowShellResize auto-resize )
+ FXtVaSetValues
+ then
+;
+
+: list-help-cb <{ w c info -- val }>
+ listener-selection { selected }
+ selected if
+ selected undef snd-help { help }
+ help if
+ selected help undef undef help-dialog
+ then
then
- then
- then
- ;
-
- : edhist-popup-handler-cb { snd chn -- prc; w c i self -- }
- 3 proc-create chn , snd ,
- does> { w c info self -- }
- self @ { chn }
- self cell+ @ { snd }
- info Fevent { ev }
- FButtonPress ev Ftype = if
- snd to edhist-snd
- chn to edhist-chn
- edit-history-menu snd chn edhist-popup-cb for-each-child
- edit-history-menu info popup-post-it
- then
- ;
-
- : popup-handler-cb { snd chn -- prc; w c i self -- }
- 3 proc-create chn , snd ,
- does> { w c info self -- }
- self @ { chn }
- self cell+ @ { snd }
- info Fevent { ev }
- ev Fx_root w 0 0 FXtTranslateCoords 0 array-ref - { xe }
- ev Fy { ye }
- FButtonPress ev Ftype = if snd chn xe ye info popup-install then
- ;
-
- \ --- listener popup ---
- : identity-cb <{ snds -- lst }> snds ;
-
- : edited-cb <{ snds -- lst }>
- snds each { snd }
- snd channels 0 ?do
- snd i edits 0 array-ref 0= if snds snd array-delete-key drop then
- loop
- end-each
- snds
- ;
-
- : focused-cb <{ snds -- lst }> snds length 1 > if snds else #() then ;
-
- : list-play-cb <{ snd -- val }> snd play ;
-
- : list-focus-cb <{ us -- val }>
- \ 5 == notebook-outer-pane
- main-widgets 5 array-ref FWidget? if
- us set-selected-sound
- else
- us sound-widgets 0 array-ref { pane }
- main-widgets 1 array-ref #( FXmNallowShellResize #f ) FXtVaSetValues drop
- sounds each ( them ) sound-widgets 0 array-ref FXtUnmanageChild drop end-each
- pane FXtManageChild drop
- main-widgets 1 array-ref #( FXmNallowShellResize auto-resize ) FXtVaSetValues
- then
- ;
-
- : list-help-cb <{ w c info -- val }>
- listener-selection { selected }
- selected if
- selected undef snd-help { help }
- help if
- selected help undef undef help-dialog
- then
- then
- ;
-
- : list-clear-cb <{ w c info -- val }> clear-listener ;
-
- : listener-edit <{ w -- }>
- w FXtName "Help" string= if
- listener-selection ?dup-if
- 1 >list w $" Help on %S" rot string-format change-label
- w FXtManageChild drop
- else
- w FXtUnmanageChild drop
- then
- then
- ;
-
- : listener-popup-cb <{ w c info -- }>
- c { menu }
- FButtonPress info Fevent Ftype = if
- listener-values each { vals }
- vals array? if
- vals 0 array-ref { top-one }
- vals 1 array-ref { top-two }
- vals 2 array-ref { top-two-cascade }
- vals 3 array-ref #( sounds ) run-proc length { len }
- top-two FXtUnmanageChild drop
- top-two-cascade FXtUnmanageChild drop
- top-one if top-one FXtUnmanageChild drop then
- len 1 > if
- top-two-cascade FXtManageChild drop
- top-two FXtManageChild drop
- then
- top-one FWidget? len 1 = && if top-one FXtManageChild drop then
+;
+
+: list-clear-cb <{ w c info -- val }>
+ clear-listener
+;
+
+: listener-edit <{ w -- }>
+ w FXtName "Help" string= if
+ listener-selection ?dup-if
+ 1 >list w "Help on %S" rot
+ string-format change-label
+ w FXtManageChild
+ else
+ w FXtUnmanageChild
+ then drop
then
- end-each
- menu <'> listener-edit for-each-child
- info menu Fset_menuToPost drop
- then
- ;
-
- let: ( -- )
- main-widgets 4 array-ref ?dup-if
- else
- #t set-show-listener drop
- #f set-show-listener drop
- main-widgets 4 array-ref
- then { parent }
- "listener-popup" parent
- #( #( $" Listener" 'label #f #f )
- #( $" sep" 'separator #f #f )
- #( $" Play" 'cascade <'> list-play-cb <'> identity-cb #t )
- #( $" Help" #f <'> list-help-cb #f )
- #( $" Open" #f <'> popen-cb #f )
- #( $" Clear listener" #f <'> list-clear-cb #f )
- #( $" Close" 'cascade <'> close-sound-extend <'> identity-cb #t )
- #( $" Save" 'cascade <'> save-sound <'> edited-cb #t )
- #( $" Revert" 'cascade <'> revert-sound <'> edited-cb #t )
- #( $" Focus" 'cascade <'> list-focus-cb <'> focused-cb #f )
- #( $" sep" 'separator #f #f )
- #( $" Exit" #f <'> exit-cb #f ) ) make-popup-menu { menu }
- parent FXmNpopupHandlerCallback <'> listener-popup-cb menu FXtAddCallback drop
- menu
- ;let constant listener-popup-menu
-
- #() constant popups
- : add-popup <{ snd -- }>
- snd channels 0 ?do
- popups #( snd i ) array-member? unless
- popups #( snd i ) array-push drop
- snd i channel-widgets 7 array-ref ( chn-edhist )
- FXmNpopupHandlerCallback snd i edhist-popup-handler-cb undef FXtAddCallback drop
- snd i channel-widgets 0 array-ref ( chn-grf )
- FXmNpopupHandlerCallback snd i popup-handler-cb undef FXtAddCallback drop
- then
- loop
- ;
-
- : change-color-col-cb ( col -- prc; w self -- )
- 1 proc-create swap ,
- does> { w self -- }
- w self @ FXmChangeColor drop
- ;
- set-current
-
- : change-menu-color ( menu new-color -- )
- doc" Changes the color of MENU to NEW-COLOR. \
- NEW-COLOR can be the color name, an xm Pixel, a snd color, or a list of rgb values \
- (as in Snd's make-color)."
- { menu new-color }
- new-color string? if \ assuming X11 color names here
- main-widgets 1 array-ref { shell }
- shell FXtDisplay { dpy }
- dpy FDefaultScreen { scr }
- dpy scr FDefaultColormap { cmap }
- FXColor { col }
- dpy cmap new-color col col FXAllocNamedColor 0= if
- $" can't allocate %S" #( new-color ) string-format snd-error
- else
- col Fpixel
- then
- else
- new-color color? if
- new-color
- else
- new-color each end-each make-color
- then
- then ( color-pixel ) menu swap change-color-col-cb for-each-child
- ;
-
- : change-selection-popup-color ( new-color -- )
- doc" Changes the selection popup menu's color: \"red\" change-selection-popup-color"
- selection-popup-menu swap change-menu-color
- ;
-
- : change-graph-popup-color ( new-color -- )
- doc" Changes the time-domain popup menu's color: basic-color change-graph-popup-color"
- selection-popup-menu swap change-menu-color
- ;
-
- : change-fft-popup-color ( new-color -- )
- doc" Changes the fft popup menu's color: #(0.5 0.5 0.5) change-fft-popup-color"
- fft-popup-menu swap change-menu-color
- ;
-
- : change-edhist-popup-color ( new-color -- )
- doc" Changes the time-domain popup menu's color: basic-color change-graph-popup-color"
- edit-history-menu swap change-menu-color
- ;
-
- : change-listener-popup-color ( new-color -- )
- doc" Changes the listener popup menu's color."
- listener-popup-menu swap change-menu-color
- ;
-
- : add-popups ( -- )
- after-open-hook <'> add-popup add-hook!
- sounds each add-popup end-each
- ;
-[then]
+;
+
+: listener-popup-cb <{ w c info -- }>
+ c { menu }
+ FButtonPress info Fevent Ftype = if
+ listener-values each { vals }
+ vals array? if
+ vals 0 array-ref { top-one }
+ vals 1 array-ref { top-two }
+ vals 2 array-ref { top-two-cascade }
+ vals 3 array-ref #( sounds )
+ run-proc length { len }
+ top-two FXtUnmanageChild drop
+ top-two-cascade FXtUnmanageChild drop
+ top-one if
+ top-one FXtUnmanageChild drop
+ then
+ len 1 > if
+ top-two-cascade
+ FXtManageChild drop
+ top-two FXtManageChild drop
+ then
+ top-one FWidget?
+ len 1 = && if
+ top-one FXtManageChild drop
+ then
+ then
+ end-each
+ menu <'> listener-edit for-each-child
+ info menu Fset_menuToPost drop
+ then
+;
+
+let: ( -- menu )
+ main-widgets 4 array-ref ?dup-if
+ ( parent )
+ else
+ #t set-show-listener drop
+ #f set-show-listener drop
+ main-widgets 4 array-ref
+ then { parent }
+ "listener-popup" parent
+ #( #( "Listener" 'label #f #f )
+ #( "sep" 'separator #f #f )
+ #( "Play" 'cascade <'> list-play-cb <'> identity-cb #t )
+ #( "Help" #f <'> list-help-cb #f )
+ #( "Open" #f <'> popen-cb #f )
+ #( "Clear listener" #f <'> list-clear-cb #f )
+ #( "Close" 'cascade <'> close-sound-extend <'> identity-cb #t )
+ #( "Save" 'cascade <'> save-sound <'> edited-cb #t )
+ #( "Revert" 'cascade <'> revert-sound <'> edited-cb #t )
+ #( "Focus" 'cascade <'> list-focus-cb <'> focused-cb #f )
+ #( "sep" 'separator #f #f )
+ #( "Exit" #f <'> exit-cb #f )
+ ) make-popup-menu { menu }
+ parent FXmNpopupHandlerCallback <'> listener-popup-cb menu
+ FXtAddCallback drop
+ menu
+;let constant listener-popup-menu
+
+#() constant popups
+: add-popup <{ snd -- }>
+ snd channels 0 ?do
+ popups #( snd i ) array-member? unless
+ popups #( snd i ) array-push drop
+ snd i channel-widgets 7 array-ref ( chn-edhist )
+ FXmNpopupHandlerCallback
+ snd i edhist-popup-handler-cb
+ undef FXtAddCallback drop
+ snd i channel-widgets 0 array-ref ( chn-grf )
+ FXmNpopupHandlerCallback snd i popup-handler-cb
+ undef FXtAddCallback drop
+ then
+ loop
+;
+
+: change-color-col-cb { col -- prc; w self -- val }
+ 1 proc-create ( prc )
+ col ,
+ does> { w self -- val }
+ w self @ ( col ) FXmChangeColor
+;
+set-current
+
+: change-menu-color ( menu new-color -- )
+ doc" Change the color of MENU to NEW-COLOR. \
+NEW-COLOR can be the color name, an xm Pixel, a snd color, \
+or a list of rgb values (as in Snd's make-color)."
+ { menu new-color }
+ new-color string? if \ assuming X11 color names here
+ main-widgets 1 array-ref { shell }
+ shell FXtDisplay { dpy }
+ dpy FDefaultScreen { scr }
+ dpy scr FDefaultColormap { cmap }
+ FXColor { col }
+ dpy cmap new-color col col FXAllocNamedColor 0= if
+ "can't allocate %S"
+ #( new-color ) string-format snd-error
+ else
+ col Fpixel
+ then
+ else
+ new-color color? if
+ new-color
+ else
+ new-color each
+ ( vals-to-stack )
+ end-each make-color
+ then
+ then ( color-pixel ) menu swap
+ change-color-col-cb for-each-child
+;
+
+: change-selection-popup-color ( new-color -- )
+ doc" Change the selection popup menu's color: \
+\"red\" change-selection-popup-color."
+ selection-popup-menu swap change-menu-color
+;
+
+: change-graph-popup-color ( new-color -- )
+ doc" Change the time-domain popup menu's color: \
+basic-color change-graph-popup-color."
+ selection-popup-menu swap change-menu-color
+;
+
+: change-fft-popup-color ( new-color -- )
+ doc" Change the fft popup menu's color: \
+#(0.5 0.5 0.5) change-fft-popup-color."
+ fft-popup-menu swap change-menu-color
+;
+
+: change-edhist-popup-color ( new-color -- )
+ doc" Change the time-domain popup menu's color: \
+basic-color change-graph-popup-color."
+ edit-history-menu swap change-menu-color
+;
+
+: change-listener-popup-color ( new-color -- )
+ doc" Change the listener popup menu's color."
+ listener-popup-menu swap change-menu-color
+;
+
+: add-popups ( -- )
+ after-open-hook <'> add-popup add-hook!
+ sounds each ( snd )
+ add-popup
+ end-each
+;
previous
\ install all popups
diff --git a/popup.rb b/popup.rb
index 8f211bf..cae4173 100644
--- a/popup.rb
+++ b/popup.rb
@@ -1,14 +1,14 @@
-# popup.rb -- Specialize Popup Menus converted from Guile to Ruby. -*- snd-ruby -*-
+# popup.rb -- Specialize Popup Menus converted from Scheme to Ruby.
# Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Thu Sep 05 22:28:49 CEST 2002
-# Changed: Wed Nov 17 22:55:49 CET 2010
+# Created: 02/09/05 22:28:49
+# Changed: 14/11/09 01:52:47
-# Commentary:
-#
-# Requires --with-motif|gtk and module libxm.so|libxg.so or --with-static-xm|xg!
+# Requires --with-motif
#
-# Tested with Snd 11, Motif 2.2.3, Gtk+ 2.20.1, Ruby 1.8.0/7, 1.9.2/3.
+# Tested with Snd 15.x
+# Ruby 2.x.x
+# Motif 2.3.3 X11R6
#
# $info_comment_hook: lambda do |file, info_string| ...; new_info_string; end
# $edhist_save_hook: lambda do |prc| ... end
@@ -28,11 +28,14 @@
# initialize(name, parent, args)
# values
# # listener
-# children(set_cb, rest = false) do |snd| ... end set_cb.arity == -1 or 0
+# children(set_cb, rest = false) do |snd| ... end
+# ==> set_cb.arity == -1 or 0
# # edhist
-# children(set_cb, rest = false) do |snd, chn, idx| ... end set_cb.arity == -1 or 0
+# children(set_cb, rest = false) do |snd, chn, idx| ... end
+# ==> set_cb.arity == -1 or 0
# # transform
-# children(set_cb, rest = false) do |snd, chn, val| ... end set_cb.arity == 3 (snd, chn, val)
+# children(set_cb, rest = false) do |snd, chn, val| ... end
+# ==> set_cb.arity == 3 (snd, chn, val)
#
# Usage:
#
@@ -94,12 +97,14 @@
# Change the appearance of menu entries with `before_popup_hook', a
# hook per instance. The example menus below may help.
-# Code:
-
require "hooks"
require "snd-xm"
include Snd_XM
+unless provided?(:snd_motif)
+ Snd.raise(:runtime_error, __FILE__, "--with-motif required")
+end
+
$edhist_help_edits = false # for prefs
$info_comment_hook = Hook.new("$info_comment_hook", 2, "\
@@ -134,21 +139,19 @@ class Hook
end
end
-add_help(:make_snd_popup, "make_snd_popup(name, *rest) do ... end
- name # menu name
- :parent, main_widgets[Main_pane] # e.g. listener popup takes main_widgets[Listener_pane]
- :target, :channels # :channels, :edhist, :widget, :event
- :args, [RXmNbackground, highlight_color] # Motif arguments")
+add_help(:make_snd_popup,
+ "make_snd_popup(name, *rest) do ... end
+ NAME # menu name
+ :parent, main_widgets[Main_pane] # e.g. listener popup takes
+ # main_widgets[Listener_pane]
+ :target, :channels # :channels, :edhist, :widget, :event
+ :args, [RXmNbackground, highlight_color] # Motif arguments")
def make_snd_popup(name, *rest, &body)
parent, target = nil
optkey(rest, binding,
[:parent, main_widgets[Main_pane_shell]],
- [:target, :channels]) # Motif :channels, :edhist, :widget, :event, Gtk :channels
- args = if provided? :xm
- get_args(rest, :args, [RXmNbackground, highlight_color])
- else
- []
- end
+ [:target, :channels]) # targets :channels, :edhist, :widget, :event
+ args = get_args(rest, :args, [RXmNbackground, highlight_color])
Snd_popup_menu.new(name, parent, args, target, &body)
end
@@ -181,34 +184,18 @@ If it returns non-nil or non-false, the menu will be posted.")
def entry(name, *rest, &body)
procedure = optkey(rest, :procedure)
- if provided? :xm
- args = get_args(rest, :args, @args)
- child = RXtCreateManagedWidget(name, RxmPushButtonWidgetClass, @menu, args)
- if block_given?
- RXtAddCallback(child, RXmNactivateCallback,
- lambda do |w, c, i|
- chn = if snd = selected_sound
- selected_channel
- else
- false
- end
- body.call(snd, chn, w)
- end)
- end
- else
- child = Rgtk_menu_item_new_with_label(name)
- Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), child)
- Rgtk_widget_show(child)
- if block_given?
- add_callback(child, "activate") do |w, d|
- chn = if snd = selected_sound
- selected_channel
- else
- false
- end
- body.call(snd, chn, w)
- end
- end
+ args = get_args(rest, :args, @args)
+ child = RXtCreateManagedWidget(name, RxmPushButtonWidgetClass, @menu, args)
+ if block_given?
+ RXtAddCallback(child, RXmNactivateCallback,
+ lambda do |w, c, i|
+ chn = if snd = selected_sound()
+ selected_channel()
+ else
+ false
+ end
+ body.call(snd, chn, w)
+ end)
end
@widget_names[child] = name
proc?(procedure) and procedure.call(child)
@@ -238,11 +225,8 @@ If it returns non-nil or non-false, the menu will be posted.")
private
def create(&body)
- @menu = if provided? :xm
- RXmCreatePopupMenu(@parent, @label, [RXmNpopupEnabled, RXmPOPUP_AUTOMATIC] + @args)
- else
- Rgtk_menu_new()
- end
+ @menu = RXmCreatePopupMenu(@parent, @label,
+ [RXmNpopupEnabled, RXmPOPUP_AUTOMATIC] + @args)
unless @label.empty?
label(@label)
separator
@@ -250,14 +234,13 @@ If it returns non-nil or non-false, the menu will be posted.")
instance_eval(&body) if block_given?
case @target
when :channels, :edhist
- if provided?(:xm)
- Snd.sounds.each do |snd| set_channel_popup(snd) end
- hook_name = format("%s-popup", (@label or "channels").downcase.tr(" ", "-"))
- $after_open_hook.add_hook!(hook_name) do |snd| set_channel_popup(snd) end
- else # gtk :channels
- unless @target == :edhist
- set_gtk_channel_popup
- end
+ Snd.sounds.each do |snd|
+ set_channel_popup(snd)
+ end
+ hook_name = format("%s-popup",
+ (@label or "channels").downcase.tr(" ", "-"))
+ $after_open_hook.add_hook!(hook_name) do |snd|
+ set_channel_popup(snd)
end
when :widget
set_widget_popup
@@ -268,7 +251,10 @@ If it returns non-nil or non-false, the menu will be posted.")
def set_channel_popup(snd)
channels(snd).times do |chn|
- unless @popups.detect do |c| c == [snd, chn] end
+ res = @popups.detect do |c|
+ c == [snd, chn]
+ end
+ unless res
@popups.push([snd, chn])
if @target == :edhist
RXtAddCallback(channel_widgets(snd, chn)[Edhist],
@@ -285,7 +271,8 @@ If it returns non-nil or non-false, the menu will be posted.")
RXmNpopupHandlerCallback,
lambda do |w, c, i|
if Rtype(e = Revent(i)) == RButtonPress
- if @target == :channels and @before_popup_hook.empty?
+ if @target == :channels and
+ @before_popup_hook.empty?
Rset_menuToPost(i, @menu)
else
xe = Rx_root(e) - RXtTranslateCoords(w, 0, 0)[0]
@@ -293,17 +280,16 @@ If it returns non-nil or non-false, the menu will be posted.")
ye = Ry(e)
if channel_style(snd) == Channels_combined
ye = Ry(e)
- chn = if (cn = (0...channels(snd)).detect do |cc|
- ye < axis_info(snd, cc)[14]
- end)
- cn - 1
- else
- channels(snd) - 1
- end
+ cn = (0...channels(snd)).detect do |cc|
+ ye < axis_info(snd, cc)[14]
+ end
+ chn = cn ? cn : channels(snd)
+ chn -= 1
end
unless chn.between?(0, channels(snd) - 1)
# in case of chans(new-snd) < chans(old-snd)
- # and new-snd has the same index like closed old-snd
+ # and new-snd has the same index like closed
+ # old-snd
chn = channels(snd) - 1
end
end
@@ -317,78 +303,40 @@ If it returns non-nil or non-false, the menu will be posted.")
end
end
end
-
- def set_gtk_channel_popup
- $gtk_popup_hook.add_hook!("popup-rb-hook") do |widget, event, data, snd, chn|
- if snd
- e = RGDK_EVENT(event)
- time = Rgdk_event_get_time(e)
- if @before_popup_hook.empty?
- Rgtk_widget_show(@menu)
- Rgtk_menu_popup(RGTK_MENU(@menu), false, false, false, false, 2, time)
- else
- coords = Rgdk_event_get_coords(e)
- x = coords[1]
- y = coords[2]
- if channel_style(snd) == Channels_combined
- chn = if (cn = (0...channels(snd)).detect do |cc| y < axis_info(snd, cc)[14] end)
- cn - 1
- else
- channels(snd) - 1
- end
- end
- if @before_popup_hook.run_hook_bool(snd, chn, x)
- Rgtk_widget_show(@menu)
- Rgtk_menu_popup(RGTK_MENU(@menu), false, false, false, false, 2, time)
- end
- end
- true
- else
- false
- end
- end
- end
- if provided? :xm
- # e.g. on listener
- def set_widget_popup
- RXtAddCallback(@parent, RXmNpopupHandlerCallback,
- lambda do |w, c, i|
- if Rtype(Revent(i)) == RButtonPress
- @before_popup_hook.call(selected_sound, selected_channel, w)
- Rset_menuToPost(i, @menu)
- end
- end)
- end
+ # e.g. on listener
+ def set_widget_popup
+ RXtAddCallback(@parent, RXmNpopupHandlerCallback,
+ lambda do |w, c, i|
+ if Rtype(Revent(i)) == RButtonPress
+ @before_popup_hook.call(selected_sound(),
+ selected_channel(),
+ w)
+ Rset_menuToPost(i, @menu)
+ end
+ end)
+ end
- # see nb.rb for an example
- def set_event_popup
- RXtAddEventHandler(@parent, RButtonPressMask, false,
- lambda do |w, c, i, f|
- if Rbutton(i) == 3
- if @before_popup_hook.run_hook_bool(w, c, i)
- RXmMenuPosition(@menu, i)
- RXtManageChild(@menu)
- end
+ # see nb.rb for an example
+ def set_event_popup
+ RXtAddEventHandler(@parent, RButtonPressMask, false,
+ lambda do |w, c, i, f|
+ if Rbutton(i) == 3
+ if @before_popup_hook.run_hook_bool(w, c, i)
+ RXmMenuPosition(@menu, i)
+ RXtManageChild(@menu)
end
- end)
- end
+ end
+ end)
end
class Cascade < Snd_popup_menu
def initialize(name, parent, args, target)
super(name, parent, args, nil)
- if provided? :xm
- @menu = RXmCreatePulldownMenu(@parent, @label, @args)
- @cascade = RXtCreateManagedWidget(@label, RxmCascadeButtonWidgetClass, @parent,
- [RXmNsubMenuId, @menu] + @args)
- else
- @cascade = Rgtk_menu_item_new_with_label(@label)
- Rgtk_menu_shell_append(RGTK_MENU_SHELL(@parent), @cascade)
- Rgtk_widget_show(@cascade)
- @menu = Rgtk_menu_new()
- Rgtk_menu_item_set_submenu(RGTK_MENU_ITEM(@cascade), @menu)
- end
+ @menu = RXmCreatePulldownMenu(@parent, @label, @args)
+ @cascade = RXtCreateManagedWidget(@label,
+ RxmCascadeButtonWidgetClass, @parent,
+ [RXmNsubMenuId, @menu] + @args)
@children = []
@target = target
end
@@ -409,161 +357,93 @@ If it returns non-nil or non-false, the menu will be posted.")
# listener: set_cb.arity == 0|-1, body.arity == 1 (snd)
# edhist: set_cb.arity == 0|-1, body.arity == 3 (snd, chn, index)
def add_with_arity_1(no_widget, set_cb, &body)
- if provided? :xm
- if no_widget
- widget = false
- else
- widget = RXtCreateManagedWidget(@label, RxmPushButtonWidgetClass, @parent, @args)
- RXtAddCallback(widget, RXmNactivateCallback,
- lambda do |w, c, i| body.call(set_cb.call.first) end)
- end
- RXtAddCallback(@cascade, RXmNcascadingCallback,
+ if no_widget
+ widget = false
+ else
+ widget = RXtCreateManagedWidget(@label, RxmPushButtonWidgetClass,
+ @parent, @args)
+ RXtAddCallback(widget, RXmNactivateCallback,
lambda do |w, c, i|
- @children.each do |child| RXtUnmanageChild(child) end
- snds = set_cb.call.reverse
- clen = @children.length
- slen = snds.length
- if clen < slen
- (clen...slen).each do |numb|
- child = RXtCreateManagedWidget(numb.to_s,
- RxmPushButtonWidgetClass,
- @menu, @args)
- RXtAddCallback(child, RXmNactivateCallback,
- lambda do |ww, cc, ii|
- if @target == :edhist
- body.call(selected_sound,
- selected_channel,
- RXtVaGetValues(ww,[RXmNuserData, 0]).cadr)
- else
- body.call(find_sound(current_label(ww)))
- end
- end)
- RXtVaSetValues(child, [RXmNuserData, @children.length])
- @children.push(child)
- end
- end
- if slen.nonzero?
- if @target == :edhist
- @children.zip(snds) do |child, label|
- break unless label
- if string?(label)
- change_label(child, label)
+ body.call(set_cb.call.first)
+ end)
+ end
+ RXtAddCallback(@cascade, RXmNcascadingCallback,
+ lambda do |w, c, i|
+ @children.each do |child|
+ RXtUnmanageChild(child)
+ end
+ snds = set_cb.call.reverse
+ clen = @children.length
+ slen = snds.length
+ if clen < slen
+ (clen...slen).each do |numb|
+ child = RXtCreateManagedWidget(numb.to_s,
+ RxmPushButtonWidgetClass, @menu, @args)
+ RXtAddCallback(child, RXmNactivateCallback,
+ lambda do |ww, cc, ii|
+ if @target == :edhist
+ body.call(selected_sound,
+ selected_channel,
+ RXtVaGetValues(ww,[RXmNuserData, 0]).cadr)
else
- change_label(child,
- format("%s[%d]",
- short_file_name(label.car), label.cadr))
+ body.call(find_sound(current_label(ww)))
end
- RXtManageChild(child)
- end
- else
- @children.zip(snds) do |child, snd|
- break unless snd
- change_label(child, short_file_name(snd))
- RXtManageChild(child)
+ end)
+ RXtVaSetValues(child,
+ [RXmNuserData, @children.length])
+ @children.push(child)
+ end
+ end
+ if slen.nonzero?
+ if @target == :edhist
+ @children.zip(snds) do |child, label|
+ break unless label
+ if string?(label)
+ change_label(child, label)
+ else
+ change_label(child,
+ format("%s[%d]",
+ short_file_name(label.car), label.cadr))
end
+ RXtManageChild(child)
+ end
+ else
+ @children.zip(snds) do |child, snd|
+ break unless snd
+ change_label(child, short_file_name(snd))
+ RXtManageChild(child)
end
end
- end)
- else # gtk
- if no_widget
- widget = false
- else
- widget = Rgtk_menu_item_new_with_label(@label)
- Rgtk_menu_shell_append(RGTK_MENU_SHELL(@parent), widget)
- Rgtk_widget_show(widget)
- add_callback(widget, "activate") do |w, d|
- body.call(body.call(set_cb.call.first))
- end
- end
- add_callback(@cascade, "activate") do |w, c|
- @children.each do |child| Rgtk_widget_hide(child) end
- snds = set_cb.call.reverse
- clen = @children.length
- slen = snds.length
- if clen < slen
- (clen...slen).each do |numb|
- child = Rgtk_menu_item_new_with_label(numb.to_s)
- Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), child)
- add_callback(child, "activate") do |ww, d|
- if @target == :edhist
- body.call(selected_sound, selected_channel, clen) # @children.length before push
- else
- body.call(find_sound(current_label(ww)))
- end
- end
- @children.push(child)
- end
- end
- if slen.nonzero?
- if @target == :edhist
- @children.zip(snds) do |child, label|
- break unless label
- if string?(label)
- change_label(child, label)
- else
- change_label(child,
- format("%s[%d]",
- short_file_name(label.car), label.cadr))
- end
- Rgtk_widget_show(child)
- end
- else
- @children.zip(snds) do |child, snd|
- break unless snd
- change_label(child, short_file_name(snd))
- Rgtk_widget_show(child)
- end
- end
- end
- false
- end
- end
+ end
+ end)
@values = [widget, @menu, @cascade, set_cb]
end
# transform: set_cb.arity and body.arity == 3 (snd, chn, val)
def add_with_arity_3(list, set_cb, &body)
list.each do |name, val|
- if provided? :xm
- wid = RXtCreateManagedWidget(name.to_s, RxmPushButtonWidgetClass, @menu, @args)
- RXtAddCallback(wid, RXmNactivateCallback,
- lambda do |w, c, i|
- body.call(selected_sound, selected_channel, val)
- end)
- else
- wid = Rgtk_menu_item_new_with_label(name.to_s)
- Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), wid)
- Rgtk_widget_show(wid)
- add_callback(wid, "activate") do |w, d|
- body.call(selected_sound, selected_channel, val)
- end
- end
- @values.push(val)
- @children.push(wid)
- end
- if provided? :xm
- RXtAddCallback(@cascade, RXmNcascadingCallback,
+ wid = RXtCreateManagedWidget(name.to_s,
+ RxmPushButtonWidgetClass, @menu, @args)
+ RXtAddCallback(wid, RXmNactivateCallback,
lambda do |w, c, i|
- @children.each_with_index do |child, idx|
- RXtSetSensitive(child,
- set_cb.call(selected_sound,
- selected_channel,
- @values[idx]))
- end
+ body.call(selected_sound, selected_channel, val)
end)
- else
- add_callback(@cascade, "activate") do |w, d|
- @children.each_with_index do |child, idx|
- set_sensitive(child, set_cb.call(selected_sound, selected_channel, @values[idx]))
- end
- end
+ @values.push(val)
+ @children.push(wid)
end
+ RXtAddCallback(@cascade, RXmNcascadingCallback,
+ lambda do |w, c, i|
+ @children.each_with_index do |child, idx|
+ RXtSetSensitive(child,
+ set_cb.call(selected_sound,
+ selected_channel,
+ @values[idx]))
+ end
+ end)
end
end
end
-# Example menus; Selection, Graph, Transform, and Edhist popup work with Motif
-# as well as with Gtk, Listener popup works only with Motif.
unless defined? $__private_popup_menu__ and $__private_popup_menu__
#
# Selection Popup
@@ -615,8 +495,12 @@ unless defined? $__private_popup_menu__ and $__private_popup_menu__
play(selection())
end
end
- entry("Delete") do |snd, chn, w| delete_selection end
- entry("Zero") do |snd, chn, w| scale_selection_by(0.0) end
+ entry("Delete") do |snd, chn, w|
+ delete_selection
+ end
+ entry("Zero") do |snd, chn, w|
+ scale_selection_by(0.0)
+ end
entry("Crop") do |snd, chn, w|
sndlist = []
Snd.sounds.each do |s|
@@ -627,16 +511,20 @@ unless defined? $__private_popup_menu__ and $__private_popup_menu__
sndlist.each do |selection|
snd, chn = selection
beg = selection_position(snd, chn)
- len = selection_frames(snd, chn)
+ len = selection_framples(snd, chn)
as_one_edit(lambda do | |
delete_samples(0, beg, snd, chn) if beg > 0
- if len < frames(snd, chn)
- delete_samples(len + 1, frames(snd, chn) - len, snd, chn)
+ if len < framples(snd, chn)
+ delete_samples(len + 1,
+ framples(snd, chn) - len,
+ snd, chn)
end
end)
end
end
- entry("Save as") do |snd, chn, w| save_selection_dialog end
+ entry("Save as") do |snd, chn, w|
+ save_selection_dialog
+ end
entry("Copy->New") do |snd, chn, w|
new_file_name = format("newf-%d.snd", selctr)
selctr += 1
@@ -653,14 +541,14 @@ unless defined? $__private_popup_menu__ and $__private_popup_menu__
entry("Snap marks") do |snd, chn, w|
selection_members.each do |s, c|
pos = selection_position(s, c)
- len = selection_frames(s, c) - 1
+ len = selection_framples(s, c) - 1
add_mark(pos, s, c)
add_mark(pos + len, s, c)
end
end
entry("Selection Info") do |snd, chn, w|
- beg = selection_position
- len = selection_frames
+ beg = selection_position()
+ len = selection_framples()
sr = srate.to_f
str = format(" start: %d, %.3f", beg, beg / sr)
str += format(" end: %d, %.3f", beg + len, (beg + len) / sr)
@@ -668,12 +556,25 @@ unless defined? $__private_popup_menu__ and $__private_popup_menu__
str += format(" chans: %d", selection_chans)
str += format(" maxamp: %.3f", selection_maxamp)
end
- entry("Apply controls") do |snd, chn, w| apply_controls(snd, 2) end # 2 == selection
- entry("Reset controls") do |snd, chn, w| reset_controls end
- entry("Unselect") do |snd, chn, w| set_selection_member?(false, true) end
- entry("Revert") do |snd, chn, w| reverse_selection end
- entry("Mix") do |snd, chn, w| mix_selection(cursor()) end
- entry("Invert") do |snd, chn, w| scale_selection_by(-1) end
+ # 2 == selection
+ entry("Apply controls") do |snd, chn, w|
+ apply_controls(snd, 2)
+ end
+ entry("Reset controls") do |snd, chn, w|
+ reset_controls()
+ end
+ entry("Unselect") do |snd, chn, w|
+ set_selection_member?(false, true)
+ end
+ entry("Revert") do |snd, chn, w|
+ reverse_selection()
+ end
+ entry("Mix") do |snd, chn, w|
+ mix_selection(cursor())
+ end
+ entry("Invert") do |snd, chn, w|
+ scale_selection_by(-1)
+ end
before_popup_hook.add_hook!("selection popup") do |snd, chn, xe|
fax = if transform_graph?(snd, chn)
axis_info(snd, chn, Transform_graph)
@@ -693,10 +594,13 @@ unless defined? $__private_popup_menu__ and $__private_popup_menu__
else
if selection?
sr = srate(snd).to_f
- beg = selection_position(snd, chn) / sr
- fin = (selection_position(snd, chn) + selection_frames(snd, chn)) / sr
+ pos = selection_position(snd, chn)
+ beg = pos / sr
+ fin = (pos + selection_framples(snd, chn)) / sr
end
- if selection? and xe >= x2position(beg, snd, chn) and xe <= x2position(fin, snd, chn)
+ if selection? and
+ xe >= x2position(beg, snd, chn) and
+ xe <= x2position(fin, snd, chn)
true
else
false
@@ -718,7 +622,11 @@ unless defined? $__private_popup_menu__ and $__private_popup_menu__
change_label(stop_widget, "Play") if widget?(stop_widget)
end
end
- entry("Play", :procedure, lambda do |w| stop_widget = w end) do |snd, chn, w|
+ entry("Play",
+ :procedure,
+ lambda do |w|
+ stop_widget = w
+ end) do |snd, chn, w|
if stopping
stopping = false
change_label(w, "Play")
@@ -749,59 +657,99 @@ unless defined? $__private_popup_menu__ and $__private_popup_menu__
change_label(stop_widget, "Stop")
play(snd, :channel, chn, :edit_position, 0)
end
- entry("Undo") do |snd, chn, w| undo_edit(1, snd, chn) end if defined? undo_edit
- entry("Redo") do |snd, chn, w| redo_edit(1, snd, chn) end if defined? redo_edit
- entry("Revert") do |snd, chn, w| revert_sound(snd) end
- entry("Open") do |snd, chn, w| open_file_dialog end
- entry("Save") do |snd, chn, w| save_sound(snd) end
+ entry("Undo") do |snd, chn, w|
+ undo_edit(1, snd, chn)
+ end if defined? undo_edit
+ entry("Redo") do |snd, chn, w|
+ redo_edit(1, snd, chn)
+ end if defined? redo_edit
+ entry("Revert") do |snd, chn, w|
+ revert_sound(snd)
+ end
+ entry("Open") do |snd, chn, w|
+ open_file_dialog
+ end
+ entry("Save") do |snd, chn, w|
+ save_sound(snd)
+ end
entry("Save as") do |snd, chn, w|
select_sound(snd)
save_sound_dialog
end
- entry("Update") do |snd, chn, w| update_sound(snd) end
- entry("Close") do |snd, chn, w| close_sound_extend(snd) end
- entry("Mix selection") do |snd, chn, w| mix_selection(cursor(snd, chn), snd, chn) end
- entry("Insert selection") do |snd, chn, w| insert_selection(cursor(snd, chn), snd, chn) end
+ entry("Update") do |snd, chn, w|
+ update_sound(snd)
+ end
+ entry("Close") do |snd, chn, w|
+ close_sound_extend(snd)
+ end
+ entry("Mix selection") do |snd, chn, w|
+ mix_selection(cursor(snd, chn), snd, chn)
+ end
+ entry("Insert selection") do |snd, chn, w|
+ insert_selection(cursor(snd, chn), snd, chn)
+ end
entry("Replace with selection") do |snd, chn, w|
beg = cursor(snd, chn)
- len = selection_frames
- sbeg = selection_position
- if (not selection_member?(snd, chn)) or ((beg + len) < sbeg) or (beg > (sbeg + len))
+ len = selection_framples()
+ sbeg = selection_position()
+ if (not selection_member?(snd, chn)) or
+ ((beg + len) < sbeg) or
+ (beg > (sbeg + len))
delete_samples(beg, len, snd, chn)
insert_selection(beg, snd, chn)
elsif beg < sbeg
delete_samples(beg, sbeg - beg, snd, chn)
end
end
- entry("Select all") do |snd, chn, w| select_all(snd, chn) end
- entry("Unselect") do |snd, chn, w| set_selection_member?(false, true) end
- entry("Apply controls") do |snd, chn, w| apply_controls end
- entry("Reset controls") do |snd, chn, w| reset_controls end
+ entry("Select all") do |snd, chn, w|
+ select_all(snd, chn)
+ end
+ entry("Unselect") do |snd, chn, w|
+ set_selection_member?(false, true)
+ end
+ entry("Apply controls") do |snd, chn, w|
+ apply_controls()
+ end
+ entry("Reset controls") do |snd, chn, w|
+ reset_controls()
+ end
entry("Info") do |snd, chn, w|
file = file_name(snd)
- date = Time.at(mus_sound_write_date(file)).localtime.strftime("%a %d-%b-%y %H:%M %Z")
+ fdate = Time.at(mus_sound_write_date(file))
+ date = fdate.localtime.strftime("%a %d-%b-%y %H:%M %z")
info_string = format("\
chans: %d, srate: %d
- length: %1.3f (%d frames)
+ length: %1.3f (%d frms)
format: %s [%s]
maxamp: %s
-written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
- frames(snd), mus_data_format_name(data_format(snd)),
+written: %s\n",
+ channels(snd), srate(snd),
+ framples(snd) / srate(snd).to_f, framples(snd),
+ mus_sample_type_name(sample_type(snd)),
mus_header_type_name(header_type(snd)),
- maxamp(snd, true).to_string, date)
+ maxamp(snd, true).to_string,
+ date)
if $info_comment_hook.empty?
if s = comment(snd)
info_string += format("comment: %s\n", s)
end
else
- $info_comment_hook.run_hook do |prc| info_string = prc.call(file, info_string) end
+ $info_comment_hook.run_hook do |prc|
+ info_string = prc.call(file, info_string)
+ end
end
- if defined? XM_NB and defined? Kernel.xm_nb and Kernel.xm_nb.kind_of?(XM_NB)
- Kernel.xm_nb.popup_nb_hook.run_hook do |prc| info_string = prc.call(snd, info_string) end
+ if defined? XM_NB and
+ defined? Kernel.xm_nb and
+ Kernel.xm_nb.kind_of?(XM_NB)
+ Kernel.xm_nb.popup_nb_hook.run_hook do |prc|
+ info_string = prc.call(snd, info_string)
+ end
end
info_dialog(file + " info", info_string)
end
- entry("Add mark") do |snd, chn, w| add_mark(cursor(snd, chn), snd, chn) end
+ entry("Add mark") do |snd, chn, w|
+ add_mark(cursor(snd, chn), snd, chn)
+ end
entry("Delete mark") do |snd, chn, w|
if (ms = marks(snd, chn)).nil? or ms.empty?
false
@@ -820,14 +768,20 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
delete_mark(id)
end
end
- entry("Delete all marks") do |snd, chn, w| delete_marks(snd, chn) end
- entry("To next mark") do |snd, chn, w| key(?j, 4, snd, chn) end
+ entry("Delete all marks") do |snd, chn, w|
+ delete_marks(snd, chn)
+ end
+ entry("To next mark") do |snd, chn, w|
+ key(?j, 4, snd, chn)
+ end
entry("To last mark") do |snd, chn, w|
key(?\-, 4, snd, chn)
key(?j, 4, snd, chn)
end
separator(:double)
- entry("Exit") do |snd, chn, w| exit(0) end
+ entry("Exit") do |snd, chn, w|
+ exit(0)
+ end
before_popup_hook.add_hook!("graph popup") do |snd, chn, xe|
fax = if transform_graph?(snd, chn)
axis_info(snd, chn, Transform_graph)
@@ -848,8 +802,9 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
else
if selection?
sr = srate(snd).to_f
- beg = selection_position(snd, chn) / sr
- fin = (selection_position(snd, chn) + selection_frames(snd, chn)) / sr
+ pos = selection_position(snd, chn)
+ beg = pos / sr
+ fin = (pos + selection_framples(snd, chn)) / sr
end
if selection? and
xe >= x2position(beg, snd, chn) and
@@ -878,7 +833,8 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
channels(snd) > 1 ? show_widget(w) : hide_widget(w)
when "Redo"
eds[1] > 0 ? show_widget(w) : hide_widget(w)
- when "Mix selection", "Insert selection", "Unselect", "Replace with selection"
+ when "Mix selection", "Insert selection", "Unselect",
+ "Replace with selection"
selection? ? show_widget(w) : hide_widget(w)
when "Play from cursor"
cursor(snd, chn) > 0 ? show_widget(w) : hide_widget(w)
@@ -887,7 +843,7 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
when "Delete mark", "To next mark", "To last mark"
marks(snd, chn) ? show_widget(w) : hide_widget(w)
when "Delete all marks"
- (marks(snd, chn) or []).length > 1 ? show_widget(w) : hide_widget(w)
+ Snd.marks(snd, chn).length > 1 ? show_widget(w) : hide_widget(w)
end
end
end
@@ -907,19 +863,24 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
end
end
entry("Peaks") do |snd, chn, w|
- set_show_transform_peaks(!show_transform_peaks(snd, chn), snd, choose_chan.call(snd, chn))
+ set_show_transform_peaks(!show_transform_peaks(snd, chn), snd,
+ choose_chan.call(snd, chn))
end
entry("dB") do |snd, chn, w|
- set_fft_log_magnitude(!fft_log_magnitude(snd, chn), snd, choose_chan.call(snd, chn))
+ set_fft_log_magnitude(!fft_log_magnitude(snd, chn), snd,
+ choose_chan.call(snd, chn))
end
entry("Log freq") do |snd, chn, w|
- set_fft_log_frequency(!fft_log_frequency(snd, chn), snd, choose_chan.call(snd, chn))
+ set_fft_log_frequency(!fft_log_frequency(snd, chn), snd,
+ choose_chan.call(snd, chn))
end
entry("Normalize") do |snd, chn, w|
if transform_normalization(snd, chn) == Dont_normalize
- set_transform_normalization(Normalize_by_channel, snd, choose_chan.call(snd, chn))
+ set_transform_normalization(Normalize_by_channel, snd,
+ choose_chan.call(snd, chn))
else
- set_transform_normalization(Dont_normalize, snd, choose_chan.call(snd, chn))
+ set_transform_normalization(Dont_normalize, snd,
+ choose_chan.call(snd, chn))
end
end
cascade("Graph type") do
@@ -964,7 +925,8 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
["Hann-Poisson", Hann_poisson_window],
["Connes", Connes_window],
["Samaraki", Samaraki_window],
- ["Ultraspherical", Ultraspherical_window]]) do |snd, chn, val|
+ ["Ultraspherical",
+ Ultraspherical_window]]) do |snd, chn, val|
set_fft_window(val, snd, choose_chan.call(snd, chn))
end
end
@@ -979,21 +941,24 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
["Wavelet", $wavelet_transform]]) do |snd, chn, val|
set_transform_type(val, snd, choose_chan.call(snd, chn))
end
- cascade("Wavelet type") do
- children(lambda do |snd, chn, val|
- wavelet_type(snd, chn) != val
- end, ["daub4", "daub6", "daub8", "daub10",
- "daub12", "daub14", "daub16", "daub18",
- "daub20", "battle-lemarie", "burt-adelson",
- "beylkin", "coif2", "coif4", "coif6",
- "sym2", "sym3", "sym4", "sym5", "sym6"].map_with_index do |v, idx|
- [v, idx]
- end) do |snd, chn, val|
- set_wavelet_type(val, snd, choose_chan.call(snd, chn))
- end
+ end
+ cascade("Wavelet type") do
+ children(lambda do |snd, chn, val|
+ wavelet_type(snd, chn) != val
+ end, ["daub4", "daub6", "daub8", "daub10",
+ "daub12", "daub14", "daub16", "daub18",
+ "daub20", "battle-lemarie", "burt-adelson",
+ "beylkin", "coif2", "coif4", "coif6",
+ "sym2", "sym3",
+ "sym4", "sym5", "sym6"].map_with_index do |v, idx|
+ [v, idx]
+ end) do |snd, chn, val|
+ set_wavelet_type(val, snd, choose_chan.call(snd, chn))
end
end
- entry("Color/Orientation") do |snd, chn, w| color_orientation_dialog end
+ entry("Color/Orientation") do |snd, chn, w|
+ color_orientation_dialog()
+ end
before_popup_hook.add_hook!("transform popup") do |snd, chn, xe|
fax = if transform_graph?(snd, chn)
axis_info(snd, chn, Transform_graph)
@@ -1004,14 +969,19 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
each_entry do |w|
case widget_name(w)
when "Peaks"
- change_label(w, (show_transform_peaks(snd, chn) ? "No peaks" : "Peaks"))
+ change_label(w,
+ show_transform_peaks(snd, chn) ? "No peaks" : "Peaks")
when "dB"
- change_label(w, (fft_log_magnitude(snd, chn) ? "Linear" : "dB"))
+ change_label(w,
+ fft_log_magnitude(snd, chn) ? "Linear" : "dB")
when "Log freq"
- change_label(w, (fft_log_frequency(snd, chn) ? "Linear freq" : "Log freq"))
+ change_label(w,
+ fft_log_frequency(snd, chn) ?
+ "Linear freq" : "Log freq")
when "Normalize"
- change_label(w, (transform_normalization(snd, chn) == Dont_normalize ?
- "Normalize" : "Original"))
+ change_label(w,
+ transform_normalization(snd, chn) == Dont_normalize ?
+ "Normalize" : "Original")
end
end
true
@@ -1028,8 +998,11 @@ written: %s\n", channels(snd), srate(snd), frames(snd) / srate(snd).to_f,
funcs = []
make_hook("$edhist_save_hook", 1,
"lambda do |prc| ... end: for debugging; \
-called in menu entry Save with new delivered PROC from edit_list2function as only argument, e.g.\n\
-$edhist_save_hook.add_hook!(\"edhist save\") do |prc| Snd.display(prc.source) end")
+Called in menu entry Save with new delivered PROC \
+from edit_list2function as only argument, e.g.
+$edhist_save_hook.add_hook!(\"edhist save\") do |prc|
+ Snd.display(prc.source)
+end")
$close_hook.add_hook!("edhist-close") do |snd|
name = short_file_name(snd)
channels(snd).times do |chn|
@@ -1038,9 +1011,10 @@ $edhist_save_hook.add_hook!(\"edhist save\") do |prc| Snd.display(prc.source) en
end
end
end
- entry("Save") do |snd, chn, w|
+ entry("Save") do |snd, chn, w|
cur_edits = edits(snd, chn)
- new_func = edit_list2function(snd, chn, cur_edits.car + 1, cur_edits.apply(:+))
+ new_func = edit_list2function(snd, chn,
+ cur_edits.car + 1, cur_edits.apply(:+))
$edhist_save_hook.call(new_func)
if old_val = funcs.assoc([snd, chn])
old_val.cadr = new_func
@@ -1049,39 +1023,58 @@ $edhist_save_hook.add_hook!(\"edhist save\") do |prc| Snd.display(prc.source) en
end
end
entry("Reapply") do |snd, chn, w|
- (val = funcs.assoc([snd, chn])) and proc?(prc = val.cadr) and prc.call(snd, chn)
+ val = funcs.assoc([snd, chn])
+ if val
+ prc = val.cadr
+ if proc?(prc)
+ prc.call(snd, chn)
+ end
+ end
end
cascade("Apply") do
- children(lambda do | | funcs.map do |vals| vals.car end end, true) do |snd, chn, index|
+ children(lambda do | |
+ funcs.map do |vals|
+ vals.car
+ end
+ end, true) do |snd, chn, index|
index.between?(0, funcs.length - 1) and funcs[index].cadr.call(snd, chn)
end
end
- entry("Clear") do |snd, chn, w| funcs = [] end
+ entry("Clear") do |snd, chn, w|
+ funcs = []
+ end
separator
- entry("Help") do |snd, chn, w|
+ entry("Help") do |snd, chn, w|
help_dialog("Edit History Functions",
- "This popup menu gives access to the edit-list function handlers in Snd. \
-At any time you can backup in the edit list, 'save' the current trailing edits, make some \
-new set of edits, then 'reapply' the saved edits. The 'apply' choice gives access to all \
-currently saved edit lists -- any such list can be applied to any channel. 'Clear' deletes \
-all saved edit lists.",
+ "This popup menu gives access to the \
+edit-list function handlers in Snd. \
+At any time you can backup in the edit list, \
+'save' the current trailing edits, make some \
+new set of edits, then 'reapply' the saved edits. \
+The 'apply' choice gives access to all \
+currently saved edit lists---any such list can be applied to any channel. \
+'Clear' deletes all saved edit lists.",
["{edit lists}" "{edit-list->function}"],
["extsnd.html#editlists" "extsnd.html#editlist_to_function"])
end
before_popup_hook.add_hook!("edhist popup") do |snd, chn, wid|
- each_value do |val| funcs.empty? ? hide_widget(val.caddr) : show_widget(val.caddr) end
+ each_value do |val|
+ funcs.empty? ? hide_widget(val.caddr) : show_widget(val.caddr)
+ end
each_entry do |w|
- set_sensitive(w, case widget_name(w)
- when "Save"
- (edits(snd,
- (main_widgets[Notebook_outer_pane] ? false : chn)).apply(:+) > 0)
- when "Reapply"
- (not funcs.assoc([snd, chn]).nil?)
- when "Clear"
- (not funcs.empty?)
- else
- true
- end)
+ set_sensitive(w,
+ case widget_name(w)
+ when "Save"
+ (edits(snd,
+ (main_widgets[Notebook_outer_pane] ?
+ false : chn)).apply(:+) > 0)
+ when "Reapply"
+ (not funcs.assoc([snd, chn]).nil?)
+ when "Clear"
+ (not funcs.empty?)
+ else
+ true
+ end)
end
true
end
@@ -1090,7 +1083,7 @@ all saved edit lists.",
#
# Listener Popup (only with Motif)
#
- if provided? :xm
+ if $with_motif
make_snd_popup("Listener",
:target, :widget,
:parent, if widget?(ww = main_widgets[Listener_pane])
@@ -1100,26 +1093,45 @@ all saved edit lists.",
set_show_listener(false)
main_widgets[Listener_pane]
end) do
- identity = lambda do | | Snd.sounds end
+ identity = lambda do | |
+ Snd.sounds
+ end
edited = lambda do | |
Snd.sounds.delete_if do |snd|
- (0...channels(snd)).detect do |chn| edits(snd, chn).first.zero? end
+ (0...channels(snd)).detect do |chn|
+ edits(snd, chn).first.zero?
+ end
end
end
- focused = lambda do | | (snds = Snd.sounds).length > 1 ? snds : [] end
+ focused = lambda do | |
+ snds = Snd.sounds
+ snds.length > 1 ? snds : []
+ end
cascade("Play") do
- children(identity) do |snd| play(snd, 0) end
+ children(identity) do |snd|
+ play(snd, 0)
+ end
+ end
+ entry("Open") do |snd, chn, w|
+ open_file_dialog
+ end
+ entry("Clear listener") do |snd, chn, w|
+ clear_listener
end
- entry("Open") do |snd, chn, w| open_file_dialog end
- entry("Clear listener") do |snd, chn, w| clear_listener end
cascade("Close") do
- children(identity) do |snd| close_sound_extend(snd) end
+ children(identity) do |snd|
+ close_sound_extend(snd)
+ end
end
cascade("Save") do
- children(edited) do |snd| save_sound(snd) end
+ children(edited) do |snd|
+ save_sound(snd)
+ end
end
cascade("Revert") do
- children(edited) do |snd| revert_sound(snd) end
+ children(edited) do |snd|
+ revert_sound(snd)
+ end
end
cascade("Focus") do
children(focused, true) do |snd|
@@ -1127,22 +1139,32 @@ all saved edit lists.",
set_selected_sound(snd)
else
pane = sound_widgets(snd)[Main_pane]
- RXtVaSetValues(main_widgets[Top_level_shell], [RXmNallowShellResize, false])
- Snd.sounds.each do |them| hide_widget(sound_widgets(them)[Main_pane]) end
+ RXtVaSetValues(main_widgets[Top_level_shell],
+ [RXmNallowShellResize, false])
+ Snd.sounds.each do |them|
+ hide_widget(sound_widgets(them)[Main_pane])
+ end
show_widget(pane)
- RXtVaSetValues(main_widgets[Top_level_shell], [RXmNallowShellResize, auto_resize])
+ RXtVaSetValues(main_widgets[Top_level_shell],
+ [RXmNallowShellResize, auto_resize])
end
end
end
entry("Help") do |snd, chn, w|
- if help = (selected = listener_selection and snd_help(selected))
- help_dialog(selected, help)
- else
- snd_warning(format("%s: no help found", selected.inspect))
+ selected = listener_selection()
+ if selected
+ help = snd_help(selected)
+ if help
+ help_dialog(selected, help)
+ else
+ snd_warning(format("%p: no help found", selected))
+ end
end
end
separator(:double)
- entry("Exit") do |snd, chn, w| exit(0) end
+ entry("Exit") do |snd, chn, w|
+ exit(0)
+ end
before_popup_hook.add_hook!("listener popup") do |d1, d2, d3|
each_value do |val|
w = val[0]
@@ -1157,16 +1179,21 @@ all saved edit lists.",
end
end
if len > 1
- cas.each do |wid| show_widget(wid) end
+ cas.each do |wid|
+ show_widget(wid)
+ end
else
- cas.each do |wid| hide_widget(wid) end
+ cas.each do |wid|
+ hide_widget(wid)
+ end
end
end
each_entry do |w1|
if widget?(w1)
if widget_name(w1) == "Help"
- if subject = listener_selection
- change_label(w1, format("Help on %s", subject.inspect))
+ subject = listener_selection()
+ if subject
+ change_label(w1, format("Help on %p", subject))
show_widget(w1)
else
hide_widget(w1)
diff --git a/prc95.scm b/prc95.scm
index 01b8606..c366484 100644
--- a/prc95.scm
+++ b/prc95.scm
@@ -2,23 +2,25 @@
;;; of Perry Cook's Physical Modelling Toolkit.
(provide 'snd-prc95.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
(define* (make-reed (offset 0.6) (slope -0.8))
- (vct offset slope))
+ (float-vector offset slope))
-(define (reedtable r sample)
- (min 1.0 (+ (vct-ref r 0) (* (vct-ref r 1) sample))))
+(define (reedtable r samp)
+ (min 1.0 (+ (r 0) (* (r 1) samp))))
(define* (make-bowtable (offset 0.0) (slope 1.0))
- (vct offset slope))
+ (float-vector offset slope))
-(define (bowtable b sample)
- (max 0.0 (- 1.0 (abs (* (vct-ref b 1) (+ sample (vct-ref b 0)))))))
+(define (bowtable b samp)
+ (max 0.0 (- 1.0 (abs (* (b 1) (+ samp (b 0)))))))
-(define (jettable sample)
- (max -1.0 (min 1.0 (* sample (- (* sample sample) 1.0)))))
+(define (jettable samp)
+ (max -1.0 (min 1.0 (* samp (- (* samp samp) 1.0)))))
(define* (make-onezero (gain 0.5) (zerocoeff 1.0))
(make-one-zero gain (* gain zerocoeff)))
@@ -44,254 +46,241 @@
(define (make-dc-block)
- (vct 0.0 0.0))
+ (float-vector 0.0 0.0))
-(define (dc-block b sample)
- (vct-set! b 1 (+ sample (- (* 0.99 (vct-ref b 1)) (vct-ref b 0))))
- (vct-set! b 0 sample)
- (vct-ref b 1))
-;; we could also use a filter generator here: (make-filter 2 (vct 1 -1) (vct 0 -0.99))
+(define (dc-block b samp)
+ (set! (b 1) (+ samp (- (* 0.99 (b 1)) (b 0))))
+ (set! (b 0) samp)
+ (b 1))
+;; we could also use a filter generator here: (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))
-;;; these are 0-based versions of the clm delays
-(defgenerator dlya (outp 0 :type float) (input #f :type clm))
-
-(define (make-delaya len lag)
- (make-dlya :input (make-delay len :type mus-interp-all-pass :max-size (ceiling (+ len lag 1)))
- :outp (- lag (+ len 1))))
-
-(define (delaya d sample)
- (delay-tick (dlya-input d) sample)
- (tap (dlya-input d) (dlya-outp d)))
+;;; this ia a 0-based versions of the clm delays
+(defgenerator dlya (outp 0) (input #f))
(define (make-delayl len lag)
;; Perry's original had linear interp bug, I think -- this form is more in tune
(make-dlya :input (make-delay len :max-size (ceiling (+ len lag 1)))
:outp (- lag len)))
-(define (delayl d sample)
- (delay-tick (dlya-input d) sample)
- (tap (dlya-input d) (dlya-outp d)))
+(define (delayl d samp)
+ (delay-tick (d 'input) samp)
+ (tap (d 'input) (d 'outp)))
;;; now some example instruments
(definstrument (plucky beg dur freq amplitude maxa)
+ ;; (with-sound () (plucky 0 .3 440 .2 1.0))
+
(let* ((lowestfreq 100.0)
- (len (+ 1 (floor (/ (mus-srate) lowestfreq))))
- (delayline (make-delaya len (- (/ (mus-srate) freq) 0.5)))
- (filter (make-onezero))
- (start (seconds->samples beg))
- (durlen (seconds->samples dur))
- (end (+ start durlen))
- (dout 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (set! dout (delaya delayline (+ (* 0.99 dout)
- (* maxa (- 1.0 (random 2.0)))))))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (set! dout (delaya delayline (one-zero filter dout)))
- (outa i (* amplitude dout))))))
+ (len (+ 1 (floor (/ *clm-srate* lowestfreq)))))
+ (let ((delayline (make-delayl len (- (/ *clm-srate* freq) 0.5)))
+ (filt (make-onezero))
+ (start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (dout 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! dout (delayl delayline (+ (* 0.99 dout) (mus-random maxa)))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (set! dout (delayl delayline (one-zero filt dout)))
+ (outa i (* amplitude dout))))))
;;; freq is off in this one (in prc's original also)
(definstrument (bowstr beg dur frq amplitude maxa)
+ ;; (with-sound () (bowstr 0 .3 220 .2 1.0))
+
(let* ((lowestfreq 100.0)
- (len (+ 1 (floor (/ (mus-srate) lowestfreq))))
- (ratio 0.8317)
- (temp (- (/ (mus-srate) frq) 4.0))
- (neckdelay (make-delayl len (* temp ratio)))
- (bridgedelay (make-delayl (floor (/ len 2)) (* temp (- 1.0 ratio))))
- (bowtab (make-bowtable :slope 3.0))
- (filt (make-onep))
- (rate .001)
- (bowing #t)
- (bowvelocity rate)
- (maxvelocity maxa)
- (attackrate rate)
- (st (seconds->samples beg))
- (durlen (seconds->samples dur))
- (end (+ st durlen))
- (out-data (make-vct durlen))
- (ctr 0)
- (release (floor (* .8 durlen)))
- (bridgeout 0.0)
- (neckout 0.0))
- (set-pole filt 0.6)
- (set-gain filt 0.3)
- (run
- (do ((i st (+ 1 i)))
- ((= i end))
- (let* ((bridgerefl 0.0)
- (nutrefl 0.0)
- (veldiff 0.0)
- (stringvel 0.0)
- (bowtemp 0.0))
- (if bowing
- (if (not (= maxvelocity bowvelocity))
- (if (< bowvelocity maxvelocity)
- (set! bowvelocity (+ bowvelocity attackrate))
- (set! bowvelocity (- bowvelocity attackrate))))
- (if (> bowvelocity 0.0)
- (set! bowvelocity (- bowvelocity attackrate))))
- (set! bowtemp (* 0.3 bowvelocity))
- (let ((filt-output (one-pole filt bridgeout)))
- (set! bridgerefl (- filt-output))
- (set! nutrefl (- neckout))
- (set! stringvel (+ bridgerefl nutrefl))
- (set! veldiff (- bowtemp stringvel))
- (set! veldiff (* veldiff (bowtable bowtab veldiff)))
- (set! neckout (delayl neckdelay (+ bridgerefl veldiff)))
- (set! bridgeout (delayl bridgedelay (+ nutrefl veldiff)))
- (let ((result (* amplitude 10.0 filt-output)))
- (if (= ctr release)
- (begin
- (set! bowing #f)
- (set! attackrate .0005)))
- (set! ctr (+ ctr 1))
- (outa i result))))))))
+ (len (+ 1 (floor (/ *clm-srate* lowestfreq)))))
+ (let ((ratio 0.8317)
+ (rate .001)
+ (bowing #t)
+ (temp (- (/ *clm-srate* frq) 4.0)))
+ (let ((neckdelay (make-delayl len (* temp ratio)))
+ (bridgedelay (make-delayl (floor (/ len 2)) (* temp (- 1.0 ratio))))
+ (bowtab (make-bowtable :slope 3.0))
+ (filt (make-onep))
+ (bowvelocity rate)
+ (maxvelocity maxa)
+ (attackrate rate)
+ (st (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (release (seconds->samples (* .8 dur)))
+ (ctr 0)
+ (bridgeout 0.0)
+ (neckout 0.0))
+
+ (set-pole filt 0.6)
+ (set-gain filt 0.3)
+
+ (do ((i st (+ i 1)))
+ ((= i end))
+ (let ((bridgerefl 0.0)
+ (nutrefl 0.0)
+ (veldiff 0.0)
+ (stringvel 0.0)
+ (bowtemp 0.0))
+ (if bowing
+ (if (not (= maxvelocity bowvelocity))
+ (if (< bowvelocity maxvelocity)
+ (set! bowvelocity (+ bowvelocity attackrate))
+ (set! bowvelocity (- bowvelocity attackrate))))
+ (if (> bowvelocity 0.0)
+ (set! bowvelocity (- bowvelocity attackrate))))
+ (set! bowtemp (* 0.3 bowvelocity))
+ (let ((filt-output (one-pole filt bridgeout)))
+ (set! bridgerefl (- filt-output))
+ (set! nutrefl (- neckout))
+ (set! stringvel (+ bridgerefl nutrefl))
+ (set! veldiff (- bowtemp stringvel))
+ (set! veldiff (* veldiff (bowtable bowtab veldiff)))
+ (set! neckout (delayl neckdelay (+ bridgerefl veldiff)))
+ (set! bridgeout (delayl bridgedelay (+ nutrefl veldiff)))
+ (outa i (* amplitude 10.0 filt-output))
+ (if (= ctr release)
+ (begin
+ (set! bowing #f)
+ (set! attackrate .0005)))
+ (set! ctr (+ ctr 1)))))))))
(definstrument (brass beg dur freq amplitude maxa)
+ ;; does this work at all?
(let* ((lowestfreq 100.0)
- (len (+ 1 (floor (/ (mus-srate) lowestfreq))))
- (delayline (make-delaya len (+ 1.0 (/ (mus-srate) freq))))
- (lipfilter (make-formant freq))
- (dcblocker (make-dc-block))
- (blowing #t)
- (rate .001)
- (breathpressure 0.0) ; 0.1 ?
- (maxpressure maxa)
- (attackrate rate)
- (st (seconds->samples beg))
- (durlen (seconds->samples dur))
- (end (+ st durlen))
- (release (floor (* .8 durlen)))
- (ctr 0)
- (dout 0.0))
- (run
- (do ((i st (+ 1 i)))
- ((= i end))
- (if blowing
- (if (not (= maxpressure breathpressure))
- (if (< breathpressure maxpressure)
- (set! breathpressure (+ breathpressure attackrate))
- (set! breathpressure (- breathpressure attackrate))))
- (if (> breathpressure 0.0)
- (set! breathpressure (- breathpressure attackrate))))
- (set! dout (delaya delayline (dc-block dcblocker
- (lip lipfilter
- (* 0.3 breathpressure)
- (* 0.9 dout)))))
- (let ((result (* amplitude dout)))
- (if (= ctr release)
- (begin
- (set! blowing #f)
- (set! attackrate .0005)))
- (set! ctr (+ ctr 1))
- (outa i result))))))
+ (len (+ 1 (floor (/ *clm-srate* lowestfreq)))))
+ (let ((blowing #t)
+ (rate .001)
+ (breathpressure 0.0)) ; 0.1 ?
+ (let ((delayline (make-delayl len (+ 1.0 (/ *clm-srate* freq))))
+ (lipfilter (make-formant freq))
+ (dcblocker (make-dc-block))
+ (maxpressure maxa)
+ (attackrate rate)
+ (st (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (release (seconds->samples (* .8 dur)))
+ (ctr 0)
+ (dout 0.0))
+ (do ((i st (+ i 1)))
+ ((= i end))
+ (if blowing
+ (if (not (= maxpressure breathpressure))
+ (if (< breathpressure maxpressure)
+ (set! breathpressure (+ breathpressure attackrate))
+ (set! breathpressure (- breathpressure attackrate))))
+ (if (> breathpressure 0.0)
+ (set! breathpressure (- breathpressure attackrate))))
+ (set! dout (delayl delayline (dc-block dcblocker
+ (lip lipfilter
+ (* 0.3 breathpressure)
+ (* 0.9 dout)))))
+ (outa i (* amplitude dout))
+ (if (= ctr release)
+ (begin
+ (set! blowing #f)
+ (set! attackrate .0005)))
+ (set! ctr (+ ctr 1)))))))
(definstrument (clarinet beg dur freq amplitude maxa)
+ ;; (with-sound () (clarinet 0 .3 440 .2 1.0))
+
(let* ((lowestfreq 100.0)
- (len (+ 1 (floor (/ (mus-srate) lowestfreq))))
- (delayline (make-delayl len (- (* 0.5 (/ (mus-srate) freq)) 1.0)))
- (rtable (make-reed :offset 0.7 :slope -0.3))
- (filter (make-onezero))
- (blowing #t)
- (breathpressure 0.0) ; 0.1 ?
- (rate .001)
- (maxpressure maxa)
- (attackrate rate)
- (st (seconds->samples beg))
- (durlen (seconds->samples dur))
- (end (+ st durlen))
- (ctr 0)
- (release (floor (* .8 durlen)))
- (dlyout 0.0))
- (run
- (do ((i st (+ 1 i)))
- ((= i end))
- (let ((pressurediff 0.0))
- (if blowing
- (if (not (= maxpressure breathpressure))
- (if (< breathpressure maxpressure)
- (set! breathpressure (+ breathpressure attackrate))
- (set! breathpressure (- breathpressure attackrate))))
- (if (> breathpressure 0.0)
- (set! breathpressure (- breathpressure attackrate))))
- (set! pressurediff (- (one-zero filter (* -0.95 dlyout)) breathpressure))
- (set! dlyout (delayl delayline
- (+ breathpressure
- (* pressurediff
- (reedtable rtable pressurediff)))))
- (let ((result (* amplitude dlyout)))
- (if (= ctr release)
- (begin
- (set! blowing #f)
- (set! attackrate .0005)))
- (set! ctr (+ ctr 1))
- (outa i result)))))))
+ (len (+ 1 (floor (/ *clm-srate* lowestfreq)))))
+ (let ((blowing #t)
+ (breathpressure 0.0) ; 0.1 ?
+ (rate .001))
+ (let ((delayline (make-delayl len (- (* 0.5 (/ *clm-srate* freq)) 1.0)))
+ (rtable (make-reed :offset 0.7 :slope -0.3))
+ (filt (make-onezero))
+ (maxpressure maxa)
+ (attackrate rate)
+ (st (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (ctr 0)
+ (release (seconds->samples (* .8 dur)))
+ (dlyout 0.0))
+ (do ((i st (+ i 1)))
+ ((= i end))
+ (let ((pressurediff 0.0))
+ (if blowing
+ (if (not (= maxpressure breathpressure))
+ (if (< breathpressure maxpressure)
+ (set! breathpressure (+ breathpressure attackrate))
+ (set! breathpressure (- breathpressure attackrate))))
+ (if (> breathpressure 0.0)
+ (set! breathpressure (- breathpressure attackrate))))
+ (set! pressurediff (- (one-zero filt (* -0.95 dlyout)) breathpressure))
+ (set! dlyout (delayl delayline
+ (+ breathpressure
+ (* pressurediff
+ (reedtable rtable pressurediff)))))
+ (outa i (* amplitude dlyout))
+ (if (= ctr release)
+ (begin
+ (set! blowing #f)
+ (set! attackrate .0005)))
+ (set! ctr (+ ctr 1))))))))
(definstrument (flute beg dur freq amplitude maxa)
+ ;; (with-sound () (flute 0 .3 440 .2 1.0))
+
(let* ((lowestfreq 100.0)
- (len (+ 1 (floor (/ (mus-srate) lowestfreq))))
- (ratio 0.8)
- (temp (- (/ (mus-srate) freq) 5.0))
- (jetdelay (make-delayl (floor (/ len 2)) (* temp (- 1.0 ratio))))
- (boredelay (make-delayl len (* ratio temp)))
- (filter (make-onep))
- (dcblocker (make-dc-block))
- (jetrefl 0.6)
- (endrefl 0.6)
- (sinphase 0.0)
- (blowing #t)
- (rate .0005)
- (breathpressure 0.0) ; 0.1 ?
- (maxpressure maxa)
- (attackrate rate)
- (st (seconds->samples beg))
- (durlen (seconds->samples dur))
- (end (+ st durlen))
- (ctr 0)
- (release (floor (* .8 durlen)))
- (boreout 0.0))
- (set-pole filter 0.8)
- (set-gain filter -1.0)
- (run
- (do ((i st (+ 1 i)))
- ((= i end))
- (let ((randpressure (* 0.1 breathpressure (random 1.0)))
- (temp 0.0)
- (pressurediff 0.0))
- (set! sinphase (+ sinphase 0.0007)) ;5 hz vibrato?
- (if (> sinphase 6.28) (set! sinphase (- sinphase 6.28)))
- (set! randpressure (+ randpressure (* 0.05 breathpressure (sin sinphase))))
- (if blowing
- (if (not (= maxpressure breathpressure))
- (if (< breathpressure maxpressure)
- (set! breathpressure (+ breathpressure attackrate))
- (set! breathpressure (- breathpressure attackrate))))
- (if (> breathpressure 0.0)
- (set! breathpressure (- breathpressure attackrate))))
- (set! temp (dc-block dcblocker (one-pole filter boreout)))
- (set! pressurediff (+ (jettable
- (delayl jetdelay
- (+ breathpressure
- (- randpressure (* jetrefl temp)))))
- (* endrefl temp)))
- (set! boreout (delayl boredelay pressurediff))
- (let ((result (* 0.3 amplitude boreout)))
- (if (= ctr release)
- (begin
- (set! blowing #f)
- (set! attackrate .0005)))
- (set! ctr (+ ctr 1))
- (outa i result)))))))
+ (len (+ 1 (floor (/ *clm-srate* lowestfreq)))))
+ (let ((jetrefl 0.6)
+ (endrefl 0.6)
+ (sinphase 0.0)
+ (blowing #t)
+ (rate .0005)
+ (breathpressure 0.0) ; 0.1 ?
+ (ratio 0.8)
+ (temp (- (/ *clm-srate* freq) 5.0)))
+ (let ((jetdelay (make-delayl (floor (/ len 2)) (* temp (- 1.0 ratio))))
+ (boredelay (make-delayl len (* ratio temp)))
+ (filt (make-onep))
+ (dcblocker (make-dc-block))
+ (maxpressure maxa)
+ (attackrate rate)
+ (st (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (ctr 0)
+ (release (seconds->samples (* .8 dur)))
+ (boreout 0.0))
+ (set-pole filt 0.8)
+ (set-gain filt -1.0)
+ (do ((i st (+ i 1)))
+ ((= i end))
+ (let ((randpressure (random (* 0.1 breathpressure)))
+ (temp 0.0)
+ (pressurediff 0.0))
+ (set! sinphase (+ sinphase 0.0007)) ;5 hz vibrato?
+ (if (> sinphase 6.28) (set! sinphase (- sinphase 6.28)))
+ (set! randpressure (+ randpressure (* 0.05 breathpressure (sin sinphase))))
+ (if blowing
+ (if (not (= maxpressure breathpressure))
+ (if (< breathpressure maxpressure)
+ (set! breathpressure (+ breathpressure attackrate))
+ (set! breathpressure (- breathpressure attackrate))))
+ (if (> breathpressure 0.0)
+ (set! breathpressure (- breathpressure attackrate))))
+ (set! temp (dc-block dcblocker (one-pole filt boreout)))
+ (set! pressurediff (+ (jettable
+ (delayl jetdelay
+ (+ breathpressure
+ (- randpressure (* jetrefl temp)))))
+ (* endrefl temp)))
+ (set! boreout (delayl boredelay pressurediff))
+ (outa i (* 0.3 amplitude boreout))
+ (if (= ctr release)
+ (begin
+ (set! blowing #f)
+ (set! attackrate .0005)))
+ (set! ctr (+ ctr 1))))))))
#|
(with-sound ()
diff --git a/pretty-print.scm b/pretty-print.scm
deleted file mode 100644
index 37660ab..0000000
--- a/pretty-print.scm
+++ /dev/null
@@ -1,300 +0,0 @@
-;;;; -*-scheme-*-
-;;;;
-;;;; Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
-;;;;
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library 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
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;;
-
-;; From SLIB.
-
-;;"genwrite.scm" generic write used by pretty-print and truncated-print.
-;; Copyright (c) 1991, Marc Feeley
-;; Author: Marc Feeley (feeley at iro.umontreal.ca)
-;; Distribution restrictions: none
-
-
-;; from Guile (modules/ice-9/pretty-print.scm) with a few changes for s7
-
-
-(define genwrite:newline-str (make-string 1 #\newline))
-
-(define (generic-write obj display? width per-line-prefix output)
-
- (define (read-macro? l)
- (define (length1? l) (and (pair? l) (null? (cdr l))))
- (let ((head (car l)) (tail (cdr l)))
- (case head
- ((quote quasiquote unquote unquote-splicing) (length1? tail))
- (else #f))))
-
- (define (read-macro-body l)
- (cadr l))
-
- (define (read-macro-prefix l)
- (let ((head (car l)))
- (case head
- ((quote) "'")
- ((quasiquote) "`")
- ((unquote) ",")
- ((unquote-splicing) ",@"))))
-
- (define (out str col)
- (and col (output str) (+ col (string-length str))))
-
- (define (wr obj col)
- (cond ((and (pair? obj)
- (read-macro? obj))
- (wr (read-macro-body obj)
- (out (read-macro-prefix obj) col)))
- (else
- (out (if display? (format #f "~A" obj) (format #f "~S" obj)) col))))
-
- (define (pp obj col)
-
- (define (spaces n col)
- (if (> n 0)
- (if (> n 7)
- (spaces (- n 8) (out " " col))
- (out (substring " " 0 n) col))
- col))
-
- (define (indent to col)
- (and col
- (if (< to col)
- (and (out genwrite:newline-str col)
- (out per-line-prefix 0)
- (spaces to 0))
- (spaces (- to col) col))))
-
- (define (pr obj col extra pp-pair)
- (if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines
- (let ((result '())
- (left (min (+ (- (- width col) extra) 1) max-expr-width)))
- (generic-write obj display? #f ""
- (lambda (str)
- (set! result (cons str result))
- (set! left (- left (string-length str)))
- (> left 0)))
- (if (> left 0) ; all can be printed on one line
- (out (reverse-string-append result) col)
- (if (pair? obj)
- (pp-pair obj col extra)
- (pp-list (vector->list obj) (out "#" col) extra pp-expr))))
- (wr obj col)))
-
- (define (pp-expr expr col extra)
- (if (read-macro? expr)
- (pr (read-macro-body expr)
- (out (read-macro-prefix expr) col)
- extra
- pp-expr)
- (let ((head (car expr)))
- (if (symbol? head)
- (let ((proc (style head)))
- (if proc
- (proc expr col extra)
- (if (> (string-length (symbol->string head))
- max-call-head-width)
- (pp-general expr col extra #f #f #f pp-expr)
- (pp-call expr col extra pp-expr))))
- (pp-list expr col extra pp-expr)))))
-
- ; (head item1
- ; item2
- ; item3)
- (define (pp-call expr col extra pp-item)
- (let ((col* (wr (car expr) (out "(" col))))
- (and col
- (pp-down (cdr expr) col* (+ col* 1) extra pp-item))))
-
- ; (item1
- ; item2
- ; item3)
- (define (pp-list l col extra pp-item)
- (let ((col (out "(" col)))
- (pp-down l col col extra pp-item)))
-
- (define (pp-down l col1 col2 extra pp-item)
- (let loop ((l l) (col col1))
- (and col
- (cond ((pair? l)
- (let ((rest (cdr l)))
- (let ((extra (if (null? rest) (+ extra 1) 0)))
- (loop rest
- (pr (car l) (indent col2 col) extra pp-item)))))
- ((null? l)
- (out ")" col))
- (else
- (out ")"
- (pr l
- (indent col2 (out "." (indent col2 col)))
- (+ extra 1)
- pp-item)))))))
-
- (define (pp-general expr col extra named? pp-1 pp-2 pp-3)
-
- (define (tail1 rest col1 col2 col3)
- (if (and pp-1 (pair? rest))
- (let* ((val1 (car rest))
- (rest (cdr rest))
- (extra (if (null? rest) (+ extra 1) 0)))
- (tail2 rest col1 (pr val1 (indent col3 col2) extra pp-1) col3))
- (tail2 rest col1 col2 col3)))
-
- (define (tail2 rest col1 col2 col3)
- (if (and pp-2 (pair? rest))
- (let* ((val1 (car rest))
- (rest (cdr rest))
- (extra (if (null? rest) (+ extra 1) 0)))
- (tail3 rest col1 (pr val1 (indent col3 col2) extra pp-2)))
- (tail3 rest col1 col2)))
-
- (define (tail3 rest col1 col2)
- (pp-down rest col2 col1 extra pp-3))
-
- (let* ((head (car expr))
- (rest (cdr expr))
- (col* (wr head (out "(" col))))
- (if (and named? (pair? rest))
- (let* ((name (car rest))
- (rest (cdr rest))
- (col** (wr name (out " " col*))))
- (tail1 rest (+ col indent-general) col** (+ col** 1)))
- (tail1 rest (+ col indent-general) col* (+ col* 1)))))
-
- (define (pp-expr-list l col extra)
- (pp-list l col extra pp-expr))
-
- (define (pp-LAMBDA expr col extra)
- (pp-general expr col extra #f pp-expr-list #f pp-expr))
-
- (define (pp-IF expr col extra)
- (pp-general expr col extra #f pp-expr #f pp-expr))
-
- (define (pp-COND expr col extra)
- (pp-call expr col extra pp-expr-list))
-
- (define (pp-CASE expr col extra)
- (pp-general expr col extra #f pp-expr #f pp-expr-list))
-
- (define (pp-AND expr col extra)
- (pp-call expr col extra pp-expr))
-
- (define (pp-LET expr col extra)
- (let* ((rest (cdr expr))
- (named? (and (pair? rest) (symbol? (car rest)))))
- (pp-general expr col extra named? pp-expr-list #f pp-expr)))
-
- (define (pp-BEGIN expr col extra)
- (pp-general expr col extra #f #f #f pp-expr))
-
- (define (pp-DO expr col extra)
- (pp-general expr col extra #f pp-expr-list pp-expr-list pp-expr))
-
- ; define formatting style (change these to suit your style)
-
- (define indent-general 2)
-
- (define max-call-head-width 5)
-
- (define max-expr-width 50)
-
- (define (style head)
- (case head
- ((lambda let* letrec define lambda* define* letrec*) pp-LAMBDA)
- ((if set!) pp-IF)
- ((cond) pp-COND)
- ((case) pp-CASE)
- ((and or) pp-AND)
- ((let) pp-LET)
- ((begin) pp-BEGIN)
- ((do) pp-DO)
- (else #f)))
-
- (pr obj col 0 pp-expr))
-
- (out per-line-prefix 0)
- (if width
- (out genwrite:newline-str (pp obj 0))
- (wr obj 0))
- ;; Return `unspecified'
- (if #f #f))
-
-; (reverse-string-append l) = (apply string-append (reverse l))
-
-(define (reverse-string-append l)
-
- (define (rev-string-append l i)
- (if (pair? l)
- (let* ((str (car l))
- (len (string-length str))
- (result (rev-string-append (cdr l) (+ i len))))
- (let loop ((j 0) (k (- (- (string-length result) i) len)))
- (if (< j len)
- (begin
- (string-set! result k (string-ref str j))
- (loop (+ j 1) (+ k 1)))
- result)))
- (make-string i)))
-
- (rev-string-append l 0))
-
-(define (pretty-print obj . opts)
- "pprint OBJ on PORT, which is a keyword argument defaulting to
-the current output port. Formatting can be controlled by a number of
-keyword arguments: Each line in the output is preceded by the string
-PER-LINE-PREFIX, which is empty by default. The output lines will be
-at most WIDTH characters wide; the default is 79. If DISPLAY? is
-true, display rather than write representation will be used.
-
-Instead of with a keyword argument, you can also specify the output
-port directly after OBJ: (pprint OBJ PORT)"
- (if (pair? opts)
- (if (keyword? (car opts))
- (apply pretty-print-with-keys obj opts)
- (apply pretty-print-with-keys obj :port (car opts) (cdr opts)))
- (pretty-print-with-keys obj)))
-
-(define* (pretty-print-with-keys obj
- (port #f)
- (width 79)
- (display? #f)
- (per-line-prefix ""))
- (generic-write obj display?
- (- width (string-length per-line-prefix))
- per-line-prefix
- (lambda (s) (if (not port) (display s) (display s port)) #t)))
-
-
-(define pprint pretty-print)
-
-
-#|
-(with-output-to-string
- (lambda ()
- (pprint (procedure-source all-chans))))
-
-"(lambda ()
- (let ((sndlist (quote ())) (chnlist (quote ())))
- (for-each
- (lambda (snd)
- (do ((i (- (channels snd) 1) (- i 1)))
- ((< i 0))
- (set! sndlist (cons snd sndlist))
- (set! chnlist (cons i chnlist))))
- (sounds))
- (list sndlist chnlist)))
-"
-|#
diff --git a/primes.scm b/primes.scm
index d958615..e09b93e 100644
--- a/primes.scm
+++ b/primes.scm
@@ -1,6 +1,6 @@
;(load "t.scm")
-(define primes (list 1
+(define primes (vector 1
2 3 5 7 11 13 17 19 23
29 31 37 41 43 47 53 59 61
67 71 73 79 83 89 97 101 103
@@ -4618,10 +4618,12 @@
499819 499853 499879 499883 499897 499903 499927 499943 499957
499969 499973 499979 500009 500029 500041 500057 500069 500083
))
+
+
;;; length = 41544
(define (factorize num)
- (let ((factors '()))
+ (let ((factors ()))
(call-with-exit
(lambda (return)
(for-each
@@ -4652,10 +4654,10 @@
;(factorize (* 98947 98947))
;(factorize (* 499523 499549 499559 499571 499591 499601 499607 499621 499633))
-#!
+#|
(define (factorize-1 num)
;; much slower in Scheme!
- (let ((factors '()))
+ (let ((factors ()))
(call-with-exit
(lambda (return)
(for-each
@@ -4688,9 +4690,9 @@
(if (= num 1)
(return (reverse factors)))))))))
(reverse factors))
-!#
+|#
-#!
+#|
(do ((i 0 (+ 1 i)))
((= i 10))
(let ((num (random (* 75000 75000))))
@@ -4701,5 +4703,5 @@
(display (format #f "~A " val2))
(if (not (equal? val1 val2)) (display "oops"))
(display (format #f "~%"))))))
-!#
+|#
diff --git a/pvoc.rb b/pvoc.rb
index d71afe9..615cd2c 100644
--- a/pvoc.rb
+++ b/pvoc.rb
@@ -1,11 +1,9 @@
# pvoc.rb -- pvoc.scm -> pvoc.rb
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Sat Mar 27 00:19:51 CET 2004
-# Changed: Sat Feb 19 17:21:21 CET 2011
+# Created: 04/03/27 00:19:51
+# Changed: 14/11/14 08:58:16
-# Comment:
-#
# versions of the Moore-Klingbeil-Trevisani-Edwards phase-vocoder
#
# class Pvocoder
@@ -22,8 +20,6 @@
# test_pv_4(gate)
#
# pvoc(*rest)
-#
-# Code:
require "ws"
@@ -34,7 +30,8 @@ class Pvocoder
@hop = overlap
@filptr = 0
@N = fftsize
- @window = vct_scale!(make_fft_window(Hamming_window, fftsize), 2.0 / (0.54 * fftsize))
+ @window = make_fft_window(Hamming_window, fftsize)
+ @window.scale!(2.0 / (0.54 * fftsize))
@D = fftsize / overlap
@in_data = nil
@ampinc = make_vct(fftsize)
@@ -49,8 +46,9 @@ class Pvocoder
end
def inspect
- format("#<%s outctr: %d, interp: %d, filptr: %d, N: %d, D: %d, in_data: %s>",
- self.class, @output, @interp, @filptr, @N, @D, @in_data.inspect)
+ format("#<%s outctr: %d, interp: %d, \
+filptr: %d, N: %d, D: %d, in_data: %p>",
+ self.class, @output, @interp, @filptr, @N, @D, @in_data)
end
def pvocoder(input)
@@ -61,10 +59,14 @@ class Pvocoder
vct_fill!(@freqs, 0.0)
@output = 0
if (not vct?(@in_data))
- @in_data = make_vct!(@N) do input.call end
+ @in_data = make_vct!(@N) do
+ input.call
+ end
else
vct_move!(@in_data, 0, @D)
- ((@N - @D)... at N).each do |i| @in_data[i] = input.call end
+ ((@N - @D)... at N).each do |i|
+ @in_data[i] = input.call
+ end
end
buf = @filptr % @N
if buf.zero?
@@ -120,8 +122,9 @@ class Pvocoder
end
add_help(:make_pvocoder,
- "make_pvocoder(fftsize, overlap, interp, [analyze=false, [edit=false, [synthesize=false]]])
-makes a new (Ruby-based, not CLM) phase-vocoder generator")
+ "make_pvocoder(fftsize, overlap, interp, analyze=false, \
+edit=false, synthesize=false) \
+Makes a new (Ruby-based, not CLM) phase-vocoder generator.")
def make_pvocoder(fftsize = 512,
overlap = 4,
interp = 128,
@@ -132,7 +135,8 @@ def make_pvocoder(fftsize = 512,
end
add_help(:pvocoder,
- "pvocoder(pv, input) is the phase-vocoder generator associated with make_pvocoder")
+ "pvocoder(pv, input) \
+Is the phase-vocoder generator associated with make_pvocoder.")
def pvocoder(pv, input)
pv.pvocoder(input)
end
@@ -153,22 +157,38 @@ end
def test_pv_1
pv = make_phase_vocoder(false, 512, 4, 128, 1.0, false, false, false)
rd = make_sampler(0)
- map_channel(lambda do |y| phase_vocoder(pv, lambda do |dir| next_sample(rd) end) end)
+ map_channel(lambda do |y|
+ phase_vocoder(pv,
+ lambda do |dir|
+ next_sample(rd)
+ end)
+ end)
free_sampler(rd)
end
def test_pv_2(freq)
pv = make_phase_vocoder(false, 512, 4, 128, freq, false, false, false)
rd = make_sampler(0)
- map_channel(lambda do |y| phase_vocoder(pv, lambda do |dir| next_sample(rd) end) end)
+ map_channel(lambda do |y|
+ phase_vocoder(pv,
+ lambda do |dir|
+ next_sample(rd)
+ end)
+ end)
free_sampler(rd)
end
def test_pv_3(time)
- pv = make_phase_vocoder(false, 512, 4, (time * 128.0).floor, 1.0, false, false, false)
+ pv = make_phase_vocoder(false, 512, 4, (time * 128.0).floor,
+ 1.0, false, false, false)
rd = make_sampler(0)
- len = (time * frames).floor
- data = make_vct!(len) do phase_vocoder(pv, lambda do |dir| next_sample(rd) end) end
+ len = (time * framples()).floor
+ data = make_vct!(len) do
+ phase_vocoder(pv,
+ lambda do |dir|
+ next_sample(rd)
+ end)
+ end
free_sampler(rd)
vct2channel(data, 0, len)
end
@@ -177,7 +197,7 @@ def test_pv_4(gate)
pv = make_phase_vocoder(false,
512, 4, 128, 1.0,
false,
- lambda { |v|
+ lambda do |v|
phase_vocoder_amp_increments(v).map! do |val|
if val < gate
0.0
@@ -186,21 +206,36 @@ def test_pv_4(gate)
end
true
end
- }, false)
+ end, false)
rd = make_sampler(0)
- map_channel(lambda do |y| phase_vocoder(pv, lambda do |dir| next_sample(rd) end) end)
+ map_channel(lambda do |y|
+ phase_vocoder(pv,
+ lambda do |dir|
+ next_sample(rd)
+ end)
+ end)
free_sampler(rd)
end
# another version of the phase vocoder
add_help(:pvoc,
- "(pvoc, *rest) [fftsize, overlap, time, pitch, gate, hoffset, snd, chn] \
-applies the phase vocoder algorithm to the current sound (i.e. fft analysis, \
-oscil bank resynthesis). 'pitch' specifies the pitch transposition ratio, 'time' - \
-specifies the time dilation ratio, 'gate' specifies a resynthesis gate in dB (partials \
-with amplitudes lower than the gate value will not be synthesized), \
-'hoffset is a pitch offset in Hz.")
+ "pvoc(*rest)
+ :fftsize = 512
+ :overlap = 4
+ :time = 1.0
+ :pitch = 1.0
+ :gate = 0.0
+ :hoffset = 0.0
+ :snd = false
+ :chn = false
+Applies the phase vocoder algorithm to the current sound (i.e. fft analysis, \
+oscil bank resynthesis). \
+TIME specifies the time dilation ratio, \
+PITCH specifies the pitch transposition ratio, \
+GATE specifies a resynthesis gate in dB (partials with \
+amplitudes lower than the gate value will not be synthesized), \
+HOFFSET is a pitch offset in Hz.")
def pvoc(*rest)
fftsize, overlap, time, pitch, gate, hoffset, snd, chn = nil
optkey(rest, binding,
@@ -212,10 +247,10 @@ def pvoc(*rest)
[:hoffset, 0.0],
[:snd, false],
[:chn, false])
- len = frames(snd, chn)
+ len = framples(snd, chn)
filptr = 0
sr = srate(snd)
- fftsize2 = fftsize / 2
+ fftsize2 = (fftsize / 2.0).floor
d = fftsize / overlap
interp = d * time
syngate = gate.zero? ? 0.0 : (10 ** (-gate.abs / 20.0))
@@ -230,11 +265,14 @@ def pvoc(*rest)
freqinc = make_vct(fftsize2)
fundamental = TWO_PI / fftsize
output = interp
- resynth_oscils = make_array(fftsize2) do make_oscil(:frequency, 0) end
+ # resynth_oscils = make_array(fftsize2) do
+ # make_oscil(:frequency, 0)
+ # end
outlen = (time * len).floor
in_data = channel2vct(0, fftsize * 2, snd, chn)
in_data_beg = 0
vct_scale!(window, 2.0 / (0.54 * fftsize))
+ obank = make_oscil_bank(lastfreq, make_vct(fftsize2, 0.0), lastamp)
out_data = make_vct([len, outlen].max)
out_data.length.times do |i|
if output >= interp
@@ -277,7 +315,8 @@ def pvoc(*rest)
phasediff += TWO_PI
end
end
- fdi[k] = pitch * ((phasediff * sr) / (d * sr) + k * fundamental + poffset)
+ fdi[k] = pitch *
+ ((phasediff * sr) / (d * sr) + k * fundamental + poffset)
if fdr[k] < syngate
fdr[k] = 0.0
end
@@ -288,7 +327,9 @@ def pvoc(*rest)
output += 1
vct_add!(lastamp, ampinc)
vct_add!(lastfreq, freqinc)
- out_data[i] = oscil_bank(lastamp, resynth_oscils, lastfreq)
+ # old_oscil_bank from extensions.rb
+ # out_data[i] = old_oscil_bank(lastamp, resynth_oscils, lastfreq)
+ out_data[i] = oscil_bank(obank)
end
vct2channel(out_data, 0, out_data.length)
end
diff --git a/pvoc.scm b/pvoc.scm
index a419f70..d6c8fce 100644
--- a/pvoc.scm
+++ b/pvoc.scm
@@ -2,44 +2,45 @@
(provide 'snd-pvoc.scm)
-(define* (make-pvocoder fftsize overlap interp analyze edit synthesize)
- "(make-pvocoder fftsize overlap interp analyze edit synthesize) makes a new (Scheme-based, not CLM) phase-vocoder generator"
+(define make-pvocoder
+ (let ((documentation "(make-pvocoder fftsize overlap interp analyze edit synthesize) makes a new (Scheme-based, not CLM) phase-vocoder generator"))
- (let* ((N (or fftsize 512))
- (N2 (floor (/ N 2)))
- (hop (or overlap 4))
- (D (floor (/ N hop))))
-
- ;; basic: fftsize overlap
- ;; everything else via closures (interp in particular)
- ;; pv: counter ("output" here)
- ;; interp
- ;; fftsize ("N"), hop ("D")
- ;; in-counter ("filptr")
- ;; hamming window scaled
- ;; slot for in-coming data ("in-data") (created on first call)
- ;; vcts: ampinc amp freqinc phaseinc phase lastphase
- ;; funcs: analysize, edit, resynthesize
-
- (list
- interp ;output
- interp ;interp
- 0 ;filptr
- N ;N
- (let ((window (make-fft-window hamming-window fftsize)))
- (vct-scale! window (/ 2.0 (* 0.54 fftsize))) ;den = hamming window integrated
- window) ; window
- D ;D
- #f ;in-data (created in pvocoder gen)
- (make-vct fftsize) ;ampinc
- (make-vct fftsize) ;freqs
- (make-vct N2) ;amps
- (make-vct N2) ;phaseinc
- (make-vct N2) ;phases
- (make-vct N2) ;lastphaseinc
- analyze
- edit
- synthesize)))
+ (lambda* (fftsize overlap interp analyze edit synthesize)
+ (let* ((N (or fftsize 512))
+ (N2 (floor (/ N 2)))
+ (hop (or overlap 4))
+ (D (floor (/ N hop))))
+
+ ;; basic: fftsize overlap
+ ;; everything else via closures (interp in particular)
+ ;; pv: counter ("output" here)
+ ;; interp
+ ;; fftsize ("N"), hop ("D")
+ ;; in-counter ("filptr")
+ ;; hamming window scaled
+ ;; slot for in-coming data ("in-data") (created on first call)
+ ;; float-vectors: ampinc amp freqinc phaseinc phase lastphase
+ ;; funcs: analysize, edit, resynthesize
+
+ (list
+ interp ;output
+ interp ;interp
+ 0 ;filptr
+ N ;N
+ (let ((window (make-fft-window hamming-window fftsize)))
+ (float-vector-scale! window (/ 2.0 (* 0.54 fftsize))) ;den = hamming window integrated
+ window) ; window
+ D ;D
+ #f ;in-data (created in pvocoder gen)
+ (make-float-vector fftsize) ;ampinc
+ (make-float-vector fftsize) ;freqs
+ (make-float-vector N2) ;amps
+ (make-float-vector N2) ;phaseinc
+ (make-float-vector N2) ;phases
+ (make-float-vector N2) ;lastphaseinc
+ analyze
+ edit
+ synthesize)))))
;;; pvocoder generator:
;; input data func
@@ -47,315 +48,301 @@
;; editing func with fallback
;; resynthesis func with fallback
-(define (pvocoder pv input)
- "(pvocoder pv input) is the phase-vocoder generator associated with make-pvocoder"
-
- ;; pvocoder list accessors
- (define (pvoc-output pv) (list-ref pv 0))
- (define (set-pvoc-output pv val) (list-set! pv 0 val))
- (define (pvoc-interp pv) (list-ref pv 1))
- (define (set-pvoc-interp pv val) (list-set! pv 1 val))
- (define (pvoc-filptr pv) (list-ref pv 2))
- (define (set-pvoc-filptr pv val) (list-set! pv 2 val))
- (define (pvoc-N pv) (list-ref pv 3))
- (define (pvoc-window pv) (list-ref pv 4))
- (define (pvoc-D pv) (list-ref pv 5))
- (define (pvoc-in-data pv) (list-ref pv 6))
- (define (set-pvoc-in-data pv val) (list-set! pv 6 val))
- (define (pvoc-ampinc pv) (list-ref pv 7))
- (define (pvoc-freqs pv) (list-ref pv 8))
- (define (pvoc-amps pv) (list-ref pv 9))
- (define (pvoc-phaseinc pv) (list-ref pv 10))
- (define (pvoc-phases pv) (list-ref pv 11))
- (define (pvoc-lastphase pv) (list-ref pv 12))
- (define (pvoc-analyze pv) (list-ref pv 13))
- (define (pvoc-edit pv) (list-ref pv 14))
- (define (pvoc-synthesize pv) (list-ref pv 15))
-
- (let* ((pi2 (* 2 pi)))
-
- (if (>= (pvoc-output pv) (pvoc-interp pv))
- ;; get next block of amp/phase info
- (let* ((N (pvoc-N pv))
- (D (pvoc-D pv))
- (amps (pvoc-ampinc pv))
- (freqs (pvoc-freqs pv))
- (filptr (pvoc-filptr pv)))
-
- (if (pvoc-analyze pv)
- ((pvoc-analyze pv) pv input)
- ;; if no analysis func:
- (begin
- (vct-fill! freqs 0.0)
- (set-pvoc-output pv 0)
- (if (not (pvoc-in-data pv))
- (begin
- (set-pvoc-in-data pv (make-vct N))
- (vct-map! (pvoc-in-data pv) input))
- (let ((indat (pvoc-in-data pv)))
- ;; extra loop here since I find the optimized case confusing (we could dispense with the data move)
- (vct-move! indat 0 D)
- (do ((i (- N D) (+ 1 i)))
- ((= i N))
- (vct-set! indat i (input)))))
- (let ((buf (modulo filptr N)))
- (if (= buf 0)
- (begin
- (vct-fill! amps 0.0)
- (vct-add! amps (pvoc-in-data pv))
- (vct-multiply! amps (pvoc-window pv)))
- (begin
- (do ((k 0 (+ 1 k)))
- ((= k N))
- (vct-set! amps buf (* (vct-ref (pvoc-window pv) k) (vct-ref (pvoc-in-data pv) k)))
- (set! buf (+ 1 buf))
- (if (= buf N) (set! buf 0))))))
- (set-pvoc-filptr pv (+ filptr D))
- (mus-fft amps freqs N 1)
- (rectangular->polar amps freqs)))
- (if (pvoc-edit pv)
- ((pvoc-edit pv) pv)
- (begin
- ;; if no editing func:
- (do ((k 0 (+ 1 k))
- (pscl (/ 1.0 D))
- (kscl (/ pi2 N)))
- ((= k (floor (/ N 2))))
- (let ((phasediff (- (vct-ref freqs k) (vct-ref (pvoc-lastphase pv) k))))
- (vct-set! (pvoc-lastphase pv) k (vct-ref freqs k))
- (if (> phasediff pi) (do () ((<= phasediff pi)) (set! phasediff (- phasediff pi2))))
- (if (< phasediff (- pi)) (do () ((>= phasediff (- pi))) (set! phasediff (+ phasediff pi2))))
- (vct-set! freqs k (+ (* pscl phasediff) (* k kscl)))))))
-
- (let ((scl (/ 1.0 (pvoc-interp pv))))
- (vct-subtract! amps (pvoc-amps pv))
- (vct-subtract! freqs (pvoc-phaseinc pv))
- (vct-scale! amps scl)
- (vct-scale! freqs scl)
- )))
-
- (set-pvoc-output pv (+ 1 (pvoc-output pv)))
+(define* (sine-bank amps phases size)
+ (let ((len (or size (length amps)))
+ (sum 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! sum (+ sum (* (amps i) (sin (phases i))))))
+ sum))
- (if (pvoc-synthesize pv)
- ((pvoc-synthesize pv) pv)
- ;; if no synthesis func:
- ;; synthesize next sample
- (begin
- (vct-add! (pvoc-amps pv) (pvoc-ampinc pv))
- (vct-add! (pvoc-phaseinc pv) (pvoc-freqs pv))
- (vct-add! (pvoc-phases pv) (pvoc-phaseinc pv))
- (sine-bank (pvoc-amps pv) (pvoc-phases pv))))
- ))
-;;; (let* ((ind (open-sound "oboe.snd"))
-;;; (pv (make-pvocoder 256 4 64))
-;;; (rd (make-sampler 0)))
-;;; (map-channel (lambda (y) (pvocoder pv (lambda () (rd)))))
+(define pvocoder
+ (let ((documentation "(pvocoder pv input) is the phase-vocoder generator associated with make-pvocoder"))
+ (lambda (pv input)
+ ;; pvocoder list accessors
+ (define (pvoc-output pv) (pv 0))
+ (define (set-pvoc-output pv val) (set! (pv 0) val))
+ (define (pvoc-interp pv) (pv 1))
+ (define (set-pvoc-interp pv val) (set! (pv 1) val))
+ (define (pvoc-filptr pv) (pv 2))
+ (define (set-pvoc-filptr pv val) (set! (pv 2) val))
+ (define (pvoc-N pv) (pv 3))
+ (define (pvoc-window pv) (pv 4))
+ (define (pvoc-D pv) (pv 5))
+ (define (pvoc-in-data pv) (pv 6))
+ (define (set-pvoc-in-data pv val) (set! (pv 6) val))
+ (define (pvoc-ampinc pv) (pv 7))
+ (define (pvoc-freqs pv) (pv 8))
+ (define (pvoc-amps pv) (pv 9))
+ (define (pvoc-phaseinc pv) (pv 10))
+ (define (pvoc-phases pv) (pv 11))
+ (define (pvoc-lastphase pv) (pv 12))
+ (define (pvoc-analyze pv) (pv 13))
+ (define (pvoc-edit pv) (pv 14))
+ (define (pvoc-synthesize pv) (pv 15))
+
+ (let ((pi2 (* 2.0 pi)))
+
+ (if (>= (pvoc-output pv) (pvoc-interp pv))
+ ;; get next block of amp/phase info
+ (let ((N (pvoc-N pv))
+ (D (pvoc-D pv))
+ (amps (pvoc-ampinc pv))
+ (freqs (pvoc-freqs pv))
+ (filptr (pvoc-filptr pv)))
+
+ (if (pvoc-analyze pv)
+ ((pvoc-analyze pv) pv input)
+ ;; if no analysis func:
+ (begin
+ (fill! freqs 0.0)
+ (set-pvoc-output pv 0)
+ (if (not (pvoc-in-data pv))
+ (begin
+ (set-pvoc-in-data pv (make-float-vector N))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (set! ((pvoc-in-data pv) i) (input))))
+ (let ((indat (pvoc-in-data pv)))
+ ;; extra loop here since I find the optimized case confusing (we could dispense with the data move)
+ (float-vector-move! indat 0 D)
+ (do ((i (- N D) (+ i 1)))
+ ((= i N))
+ (set! (indat i) (input)))))
+ (let ((buf (modulo filptr N)))
+ (if (= buf 0)
+ (begin
+ (fill! amps 0.0)
+ (float-vector-add! amps (pvoc-in-data pv))
+ (float-vector-multiply! amps (pvoc-window pv)))
+ (begin
+ (do ((k 0 (+ k 1)))
+ ((= k N))
+ (set! (amps buf) (* ((pvoc-window pv) k) ((pvoc-in-data pv) k)))
+ (set! buf (+ 1 buf))
+ (if (= buf N) (set! buf 0))))))
+ (set-pvoc-filptr pv (+ filptr D))
+ (mus-fft amps freqs N 1)
+ (rectangular->polar amps freqs)))
+
+ (if (pvoc-edit pv)
+ ((pvoc-edit pv) pv)
+ (let ((lp (pvoc-lastphase pv))
+ (pscl (/ 1.0 D))
+ (kscl (/ pi2 N))
+ (lim (floor (/ N 2))))
+ ;; if no editing func:
+ (do ((k 0 (+ k 1)))
+ ((= k lim))
+ (let ((phasediff (remainder (- (freqs k) (lp k)) pi2)))
+ (float-vector-set! lp k (freqs k))
+ (if (> phasediff pi) (set! phasediff (- phasediff pi2))
+ (if (< phasediff (- pi)) (set! phasediff (+ phasediff pi2))))
+ (set! (freqs k) (+ (* pscl phasediff) (* k kscl)))))))
+
+ (let ((scl (/ 1.0 (pvoc-interp pv))))
+ (float-vector-subtract! amps (pvoc-amps pv))
+ (float-vector-subtract! freqs (pvoc-phaseinc pv))
+ (float-vector-scale! amps scl)
+ (float-vector-scale! freqs scl)
+ )))
+
+ (set-pvoc-output pv (+ 1 (pvoc-output pv)))
+
+ (if (pvoc-synthesize pv)
+ ((pvoc-synthesize pv) pv)
+ ;; if no synthesis func:
+ ;; synthesize next sample
+ (begin
+ (float-vector-add! (pvoc-amps pv) (pvoc-ampinc pv))
+ (float-vector-add! (pvoc-phaseinc pv) (pvoc-freqs pv))
+ (float-vector-add! (pvoc-phases pv) (pvoc-phaseinc pv))
+ (sine-bank (pvoc-amps pv) (pvoc-phases pv))))
+ ))))
+#|
+(let* ((ind (open-sound "oboe.snd"))
+ (pv (make-pvocoder 256 4 64))
+ (rd (make-sampler 0)))
+ (map-channel (lambda (y) (pvocoder pv (lambda () (rd))))))
+|#
#|
;;; ---------------- same thing using phase-vocoder gen
(define test-pv-1
(lambda (freq)
- (let ((pv (make-phase-vocoder #f
- 512 4 128 1.0
- #f ;no change to analysis
- #f ;no change to edits
- #f ;no change to synthesis
- ))
- (reader (make-sampler 0)))
- (map-channel (lambda (val)
- (phase-vocoder pv (lambda (dir)
- (next-sample reader)))))
- (free-sampler reader))))
+ (let* ((reader (make-sampler 0))
+ (pv (make-phase-vocoder (lambda (dir) (next-sample reader))
+ 512 4 128 1.0
+ #f ;no change to analysis
+ #f ;no change to edits
+ #f ;no change to synthesis
+ )))
+ (map-channel (lambda (val) (phase-vocoder pv))))))
(define test-pv-2
(lambda (freq)
- (let ((pv (make-phase-vocoder #f
- 512 4 128 freq
- #f ;no change to analysis
- #f
- #f ; no change to synthesis
- ))
- (reader (make-sampler 0)))
- (map-channel (lambda (val)
- (phase-vocoder pv (lambda (dir)
- (next-sample reader)))))
- (free-sampler reader))))
+ (let* ((reader (make-sampler 0))
+ (pv (make-phase-vocoder (lambda (dir) (next-sample reader))
+ 512 4 128 freq
+ #f ;no change to analysis
+ #f
+ #f ; no change to synthesis
+ )))
+ (map-channel (lambda (val) (phase-vocoder pv))))))
(define test-pv-3
(lambda (time)
- (let* ((pv (make-phase-vocoder #f
+ (let* ((reader (make-sampler 0))
+ (pv (make-phase-vocoder (lambda (dir) (next-sample reader))
512 4 (floor (* 128 time)) 1.0
#f ;no change to analysis
#f ;no change to edits
#f ;no change to synthesis
))
- (reader (make-sampler 0))
- (len (floor (* time (frames))))
- (data (make-vct len))
- )
- (vct-map! data
- (lambda ()
- (phase-vocoder pv (lambda (dir) (next-sample reader)))))
+ (len (floor (* time (framples))))
+ (data (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (data i) (phase-vocoder pv)))
(free-sampler reader)
- (vct->channel data 0 len))))
+ (float-vector->channel data 0 len))))
(define test-pv-4
(lambda (gate)
- (let ((pv (make-phase-vocoder #f
- 512 4 128 1.0
- #f ;no change to analysis
- (lambda (v)
- (let ((N (mus-length v)))
- (do ((i 0 (+ 1 i)))
- ((= i N))
- (if (< (vct-ref (phase-vocoder-amp-increments v) i) gate)
- (vct-set! (phase-vocoder-amp-increments v) i 0.0)))
- #t))
- #f ;no change to synthesis
- ))
- (reader (make-sampler 0))
- )
- (map-channel (lambda (val)
- (phase-vocoder pv (lambda (dir)
- (next-sample reader)))))
- (free-sampler reader))))
+ (let* ((reader (make-sampler 0))
+ (pv (make-phase-vocoder (lambda (dir) (next-sample reader))
+ 512 4 128 1.0
+ #f ;no change to analysis
+ (lambda (v)
+ (let ((N (mus-length v)))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (if (< ((phase-vocoder-amp-increments v) i) gate)
+ (float-vector-set! (phase-vocoder-amp-increments v) i 0.0)))
+ #t))
+ #f ;no change to synthesis
+ )))
+ (map-channel (lambda (val) (phase-vocoder pv))))))
|#
;;; -------- another version of the phase vocoder --------
-(define (oscil-bank amps1 gens fms)
- "(oscil-bank amps1 gens fms) sums a vector of oscils"
- (declare (gens clm-vector))
- (let* ((len (vector-length gens))
- (sum 0.0)
- (amps (if (vector? amps1) (vector->vct amps1) amps1))
- (inp1 (if (vector? fms) (vector->vct fms) (or fms (make-vct len 0.0)))))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (set! sum (+ sum (* (vct-ref amps i) (oscil (vector-ref gens i) (vct-ref inp1 i))))))
- sum))
-
-
(define pvoc
- (lambda* (:key
- (fftsize 512) (overlap 4) (time 1.0)
- (pitch 1.0) (gate 0.0) (hoffset 0.0)
- (snd 0) (chn 0))
- "(pvoc &key fftsize overlap time pitch gate hoffset) applies the phase vocoder
+ (let ((documentation "(pvoc fftsize overlap time pitch gate hoffset snd chn) applies the phase vocoder
algorithm to the current sound (i.e. fft analysis, oscil bank resynthesis). 'pitch'
specifies the pitch transposition ratio, 'time' - specifies the time dilation ratio,
'gate' specifies a resynthesis gate in dB (partials with amplitudes lower than
- the gate value will not be synthesized), 'hoffset is a pitch offset in Hz."
-
- (let* ((len (frames))
- (filptr 0) ; index into the file
- (pi2 (* 2 pi)) ; handy constant
- (sr (srate))
- (N fftsize) ; fft size
- (N2 (floor (/ N 2)))
- ;; (Nw fftsize) ;; window size -- currently restricted to the fftsize
- (D (floor (/ fftsize overlap))) ; decimation factor (how often do we take an fft)
- (interp (* (floor (/ fftsize overlap)) time)) ; interpolation factor how often do we synthesize
- ;; take a resynthesis gate specificed in dB, convert to linear amplitude
- (syngate (if (= 0.0 gate) 0.0 (expt 10 (/ (- (abs gate)) 20))))
- (poffset (hz->radians hoffset))
- (window (make-fft-window hamming-window fftsize))
- (fdr (make-vct N)) ; buffer for real fft data
- (fdi (make-vct N)) ; buffer for imaginary fft data
- (lastphase (make-vct N2)) ;; last phase change
- (lastamp (make-vct N2)) ;; last sampled amplitude
- (lastfreq (make-vct N2)) ;; last sampled frequency
- (ampinc (make-vct N2)) ;; amplitude interpolation increment
- (freqinc (make-vct N2)) ;; frequency interpolation increments
- ;; expresses the fundamental in terms of radians per output sample
- (fundamental (/ pi2 N))
- (output interp) ; count of samples that have been output
- (resynth-oscils (make-vector N2)) ; synthesis oscillators
- ;; (nextpct 10.0) ; how often to print out the percentage complete message
- (outlen (floor (* time len)))
- (out-data (make-vct (max len outlen)))
- (in-data (channel->vct 0 (* N 2) snd chn))
- (in-data-beg 0))
- ;; setup oscillators
- (do ((i 0 (+ 1 i)))
- ((= i N2))
- (vector-set! resynth-oscils i (make-oscil :frequency 0)))
- (vct-scale! window (/ 2.0 (* 0.54 fftsize))) ;den = hamming window integrated
- (call-with-exit
- (lambda (break)
- (do ((i 0 (+ 1 i)))
- ((>= i outlen))
- (if (>= output interp) ;; if all the samples have been output then do the next frame
- (let ((buffix (modulo filptr N)))
+ the gate value will not be synthesized), 'hoffset is a pitch offset in Hz."))
+
+ (lambda* ((fftsize 512) (overlap 4) (time 1.0)
+ (pitch 1.0) (gate 0.0) (hoffset 0.0)
+ (snd 0) (chn 0))
+
+ (let* ((len (framples))
+ (filptr 0) ; index into the file
+ (pi2 (* 2 pi)) ; handy constant
+ (sr (srate))
+ (N fftsize) ; fft size
+ (N2 (floor (/ N 2)))
+ ;; (Nw fftsize) ;; window size -- currently restricted to the fftsize
+ (D (floor (/ fftsize overlap))) ; decimation factor (how often do we take an fft)
+ (interp (* (floor (/ fftsize overlap)) time)) ; interpolation factor how often do we synthesize
+ ;; take a resynthesis gate specificed in dB, convert to linear amplitude
+ (syngate (if (= 0.0 gate) 0.0 (expt 10 (/ (- (abs gate)) 20))))
+ (poffset (hz->radians hoffset))
+ (window (make-fft-window hamming-window fftsize))
+ (fdr (make-float-vector N)) ; buffer for real fft data
+ (fdi (make-float-vector N)) ; buffer for imaginary fft data
+ (lastphase (make-float-vector N2)) ;; last phase change
+ (lastamp (make-float-vector N2)) ;; last sampled amplitude
+ (lastfreq (make-float-vector N2)) ;; last sampled frequency
+ (ampinc (make-float-vector N2)) ;; amplitude interpolation increment
+ (freqinc (make-float-vector N2)) ;; frequency interpolation increments
+ ;; expresses the fundamental in terms of radians per output sample
+ (fundamental (/ pi2 N))
+ (output interp) ; count of samples that have been output
+ ;; (nextpct 10.0) ; how often to print out the percentage complete message
+ (outlen (floor (* time len)))
+ (out-data (make-float-vector (max len outlen)))
+ (in-data (channel->float-vector 0 (* N 2) snd chn))
+ (in-data-beg 0)
+ (obank (make-oscil-bank lastfreq (make-float-vector N2 0.0) lastamp)))
+
+ (set! window (float-vector-scale! window (/ 2.0 (* 0.54 fftsize)))) ;den = hamming window integrated
+
+ (do ((i 0 (+ i 1)))
+ ((>= i outlen))
+ (if (>= output interp) ;; if all the samples have been output then do the next frame
+ (let ((buffix (modulo filptr N)))
; buffix is the index into the input buffer
; it wraps around circularly as time increases in the input
- (set! output 0) ; reset the output sample counter
- ;; save the old amplitudes and frequencies
- (vct-fill! lastamp 0.0)
- (vct-fill! lastfreq 0.0)
- (vct-add! lastamp fdr)
- (vct-add! lastfreq fdi)
- (do ((k 0 (+ 1 k)))
- ((= k N))
- ;; apply the window and then stuff into the input array
- (vct-set! fdr buffix (* (vct-ref window k) (vct-ref in-data (- filptr in-data-beg))))
- (set! filptr (+ 1 filptr))
- ;; increment the buffer index with wrap around
- (set! buffix (+ 1 buffix))
- (if (>= buffix N) (set! buffix 0)))
- ;; rewind the file for the next hop
- (set! filptr (- filptr (- N D)))
- (if (> filptr (+ in-data-beg N))
- (begin
- (set! in-data-beg filptr)
- (set! in-data (channel->vct in-data-beg (* N 2) snd chn))))
- ;; no imaginary component input so zero out fdi
- (vct-fill! fdi 0.0)
- ;; compute the fft
- (mus-fft fdr fdi N 1)
- ;; now convert into magnitude and interpolated frequency
- (do ((k 0 (+ 1 k)))
- ((= k N2))
- (let* ((a (vct-ref fdr k))
- (b (vct-ref fdi k))
- (mag (* (sqrt (+ (* a a) (* b b)))))
- (phase 0)
- (phasediff 0))
- (vct-set! fdr k mag) ;; current amp stored in fdr
- ;; mag is always positive
- ;; if it is zero then the phase difference is zero
- (if (> mag 0)
- (begin
+ (set! output 0) ; reset the output sample counter
+ ;; save the old amplitudes and frequencies
+ (fill! lastamp 0.0)
+ (fill! lastfreq 0.0)
+ (float-vector-add! lastamp fdr)
+ (float-vector-add! lastfreq fdi)
+ (do ((k 0 (+ k 1)))
+ ((= k N))
+ ;; apply the window and then stuff into the input array
+ (set! (fdr buffix) (* (window k) (in-data (- filptr in-data-beg))))
+ (set! filptr (+ 1 filptr))
+ ;; increment the buffer index with wrap around
+ (set! buffix (+ 1 buffix))
+ (if (>= buffix N) (set! buffix 0)))
+ ;; rewind the file for the next hop
+ (set! filptr (- filptr (- N D)))
+ (if (> filptr (+ in-data-beg N))
+ (begin
+ (set! in-data-beg filptr)
+ (set! in-data (channel->float-vector in-data-beg (* N 2) snd chn))))
+ ;; no imaginary component input so zero out fdi
+ (fill! fdi 0.0)
+ ;; compute the fft
+ (mus-fft fdr fdi N 1)
+ ;; now convert into magnitude and interpolated frequency
+ (do ((k 0 (+ k 1)))
+ ((= k N2))
+ (let* ((a (fdr k))
+ (b (fdi k))
+ (mag (sqrt (+ (* a a) (* b b))))
+ (phase 0)
+ (phasediff 0))
+ (set! (fdr k) mag) ;; current amp stored in fdr
+ ;; mag is always positive
+ ;; if it is zero then the phase difference is zero
+ (if (> mag 0)
+ (begin
(set! phase (- (atan b a)))
- (set! phasediff (- phase (vct-ref lastphase k)))
- (vct-set! lastphase k phase)
+ (set! phasediff (- phase (lastphase k)))
+ (set! (lastphase k) phase)
;; frequency wrapping from Moore p. 254
(if (> phasediff pi) (do () ((<= phasediff pi)) (set! phasediff (- phasediff pi2))))
(if (< phasediff (- pi)) (do () ((>= phasediff (- pi))) (set! phasediff (+ phasediff pi2))))))
- ;; current frequency stored in fdi
- ;; scale by the pitch transposition
- (vct-set! fdi k
- (* pitch (+ (/ (* phasediff sr) (* D sr))
- (* k fundamental)
- poffset)))
- ;; resynthesis gating
- (if (< (vct-ref fdr k) syngate) (vct-set! fdr k 0.0))
- ;; take (vct-ref lastamp k) and count up to (vct-ref fdr k)
- ;; interpolating by ampinc
- (vct-set! ampinc k (/ (- (vct-ref fdr k) (vct-ref lastamp k)) interp))
- ;; take (vct-ref lastfreq k) and count up to (vct-ref fdi k)
- ;; interpolating by freqinc
- (vct-set! freqinc k (/ (- (vct-ref fdi k) (vct-ref lastfreq k)) interp))))))
- ;; loop over the partials interpolate frequency and amplitude
- (vct-add! lastamp ampinc)
- (vct-add! lastfreq freqinc)
- (vct-set! out-data i (oscil-bank lastamp resynth-oscils lastfreq))
- (set! output (+ 1 output)))
- (vct->channel out-data 0 (max len outlen)))))))
+ ;; current frequency stored in fdi
+ ;; scale by the pitch transposition
+ (set! (fdi k)
+ (* pitch (+ (/ (* phasediff sr) (* D sr))
+ (* k fundamental)
+ poffset)))
+ ;; resynthesis gating
+ (if (< (fdr k) syngate) (set! (fdr k) 0.0))
+ ;; take (lastamp k) and count up to (fdr k)
+ ;; interpolating by ampinc
+ (set! (ampinc k) (/ (- (fdr k) (lastamp k)) interp))
+ ;; take (lastfreq k) and count up to (fdi k)
+ ;; interpolating by freqinc
+ (set! (freqinc k) (/ (- (fdi k) (lastfreq k)) interp))))))
+ ;; loop over the partials interpolate frequency and amplitude
+ (float-vector-add! lastamp ampinc)
+ (float-vector-add! lastfreq freqinc)
+ (float-vector-set! out-data i (oscil-bank obank))
+ (set! output (+ 1 output)))
+ (float-vector->channel out-data 0 (max len outlen))))))
diff --git a/quick.html b/quick.html
deleted file mode 100644
index c6869ae..0000000
--- a/quick.html
+++ /dev/null
@@ -1,661 +0,0 @@
-<html>
-<head>
-<title>Snd Quick Overview</title>
-<style type="text/css">
-<!--
- EM.red {color:red; font-style: normal}
- EM.error {color:chocolate; font-style: normal}
- EM.narg {color:darkgreen; font-style: normal}
- EM.typing {color:maroon; font-style: normal}
- EM.listener {color:darkblue; font-style: normal}
- H1 {text-align: center}
- UL {list-style-type: none}
- EM.emdef {font-weight: bold; font-style: normal}
-
- A {text-decoration:none}
- A:hover {text-decoration:underline}
- A.quiet {color:black; text-decoration:none}
- A.quiet:hover {text-decoration:underline}
- A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black}
--->
-</style>
-</head>
-<body bgcolor=white>
-
-<table width="100%" border=1><tr><td bgcolor="beige" align="center" valign="middle"><h1>Snd Quick Overview</h1></td></tr></table>
-<br>
-<center>
-<table border=1><tr><td>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html">snd.html</a></small></td>
-<td><small><a href="extsnd.html">extsnd.html</a></small></td>
-<td><small><a href="grfsnd.html">grfsnd.html</a></small></td>
-<td><small><a href="sndclm.html">sndclm.html</a></small></td>
-<td><small><a href="sndlib.html">sndlib.html</a></small></td>
-<td><small><a href="sndscm.html">sndscm.html</a></small></td>
-<td><small><a href="libxm.html">libxm.html</a></small></td>
-<td><small><a href="index.html">index.html</a></small></td>
-</tr></table>
-</td></tr></table>
-</center>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen"><a class=quiet href="extsnd.html#colors">Colors</a></th><tr><td>
-<blockquote><small><br>
-Other color-related stuff:<br>
-Color names: <a href="sndscm.html#rgbdoc">rgb.scm, rgb.rb</a><br>
-colors in the file dialogs: install-searcher-with-colors in snd-motif.scm<br>
-color-orientation-dialog: <a href="extsnd.html#colororientationdialog">color-orientation-dialog</a><br>
-colored samples: <a href="sndscm.html#drawdoc">display-colored-samples</a> and others in draw.scm<br>
-colored edits: <a href="sndscm.html#drawdoc">display-previous-edits</a> in draw.scm<br>
-colored marks: mark-sync-color in snd-motif.scm<br>
-colors in rxvt: red-text et al in examp.scm<br>
-flashing colors: flash-selected-data in examp.scm<br>
-openGL: snd-gl.scm, <a href="grfsnd.html#sndandgl">Snd and OpenGL</a><br>
-fancy widget backgrounds: new-backgrounds.scm in the tutorial<br>
-color hook: <a href="extsnd.html#colorhook">color-hook</a><br>
-Snd graphics contexts: <a href="extsnd.html#sndgcs">snd-gcs</a><br>
-<br></small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Conversions</th><tr><td>
-<table border=0 cellspacing=0 cellpadding=0><tr>
-<td>
-<blockquote><small><br>
-<a href="sndclm.html#arraytofile">array->file</a><br>
-<a href="extsnd.html#channeltovct">channel->vct</a><br>
-<a href="extsnd.html#colortolist">color->list</a><br>
-<a href="sndclm.html#dbtolinear">db->linear</a><br>
-<a href="sndclm.html#degreestoradians">degrees->radians</a><br>
-<a href="extsnd.html#editlisttofunction">edit-list->function</a><br>
-<a href="sndclm.html#filetoarray">file->array</a><br>
-<a href="sndclm.html#filetoframe">file->frame</a><br>
-<a href="sndclm.html#filetosample">file->sample</a><br>
-<a href="sndscm.html#filetosounddata">file->sound-data</a><br>
-<a href="sndscm.html#filetovct">file->vct</a><br>
-<a href="sndclm.html#frametofile">frame->file</a><br>
-<a href="sndclm.html#frametolist">frame->list</a><br>
-</small></blockquote>
-</td><td>
-<blockquote><small><br>
-<a href="sndclm.html#frametosample">frame->sample</a><br>
-<a href="sndscm.html#frametosound">frame->sound</a><br>
-<a href="sndscm.html#frametosounddata">frame->sound-data</a><br>
-<a href="sndscm.html#frametovct">frame->vct</a><br>
-<a href="extsnd.html#glgraphtops">gl-graph->ps</a><br>
-<a href="extsnd.html#graphtops">graph->ps</a><br>
-<a href="sndclm.html#hztoradians">hz->radians</a><br>
-<a href="sndclm.html#lineartodb">linear->db</a><br>
-<a href="extsnd.html#listtovct">list->vct</a><br>
-<a href="sndscm.html#mixtovct">mix->vct</a><br>
-<a href="sndscm.html#monotostereo">mono->stereo</a><br>
-<a href="sndclm.html#partialstopolynomial">partials->polynomial</a><br>
-<a href="sndclm.html#polartorectangular">polar->rectangular</a><br>
-</small></blockquote>
-</td><td>
-<blockquote><small><br>
-<a href="sndclm.html#radianstodegrees">radians->degrees</a><br>
-<a href="sndclm.html#radianstohz">radians->hz</a><br>
-<a href="sndclm.html#rectangulartopolar">rectangular->polar</a><br>
-<a href="sndscm.html#regiontoframe">region->frame</a><br>
-<a href="sndscm.html#regiontosounddata">region->sound-data</a><br>
-<a href="extsnd.html#regiontovct">region->vct</a><br>
-<a href="sndclm.html#samplestoseconds">samples->seconds</a><br>
-<a href="sndclm.html#secondstosamples">seconds->samples</a><br>
-<a href="sndscm.html#soundtoframe">sound->frame</a><br>
-<a href="sndscm.html#soundtosounddata">sound->sound-data</a><br>
-<a href="sndscm.html#sounddatatofile">sound-data->file</a><br>
-<a href="sndscm.html#sounddatatoframe">sound-data->frame</a><br>
-<a href="sndscm.html#sounddatatosound">sound-data->sound</a><br>
-</small></blockquote>
-</td><td>
-<blockquote><small><br>
-<a href="extsnd.html#sounddatatovct">sound-data->vct</a><br>
-<a href="sndscm.html#stereotomono">strero->mono</a><br>
-<a href="extsnd.html#transformtovct">transform->vct</a><br>
-<a href="sndscm.html#vcttofile">vct->file</a><br>
-<a href="sndscm.html#vcttoframe">vct->frame</a><br>
-<a href="extsnd.html#vcttolist">vct->list</a><br>
-<a href="extsnd.html#vcttosounddata">vct->sound-data</a><br>
-<a href="extsnd.html#vcttostring">vct->string</a><br>
-<a href="extsnd.html#vcttovector">vct->vector</a><br>
-<a href="extsnd.html#vectortovct">vector->vct</a><br>
-</small></blockquote>
-</td></tr></table>
-</td></tr></table>
-
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Copying</th><tr><td>
-<blockquote><small>
-<br>
-copy file: in Ruby: File.copy or File.syscopy<br>
-copy vct: <a href="extsnd.html#vctcopy">vct-copy</a>, <a href="extsnd.html#vcttovector">vct->vector</a>, <a href="sndscm.html#vcttoframe">vct->frame</a><br>
-copy mix: <a href="sndscm.html#mixtovct">mix->vct</a><br>
-copy sampler: <a href="extsnd.html#copysampler">copy-sampler</a><br>
-copy (clone) current sound edit state: <a href="extsnd.html#clonesoundas">clone-sound-as</a><br>
-copy channel data: <a href="extsnd.html#channeltovct">channel->vct</a>, or <a href="extsnd.html#savesoundas">save-sound-as</a><br>
-copy selection data: <a href="extsnd.html#selection2vct">selection->vct</a> or <a href="extsnd.html#saveselection">save-selection</a><br>
-copy region data: <a href="extsnd.html#regiontovct">region->vct</a>, <a href="extsnd.html#regiontovct">region->vct</a>, <a href="extsnd.html#saveregion">save-region</a>, or <a href="sndscm.html#regiontosounddata">region->sound-data</a><br>
-copy transform data: <a href="extsnd.html#transformtovct">transform->vct</a><br>
-copy sound-data: <a href="extsnd.html#sounddatatovct">sound-data->vct</a><br>
-copy a frame: <a href="sndscm.html#framecopy">frame-copy</a>, <a href="sndscm.html#frametovct">frame->vct</a><br>
-copy vector: <a href="extsnd.html#vectortovct">vector->vct</a><br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Cursor</th><tr><td>
-<blockquote><small>
-<br>
-Tracking cursor: <a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a><br>
-Change cursor shape or size: <a href="extsnd.html#cursorstyle">cursor-style</a>, <a href="extsnd.html#cursorsize">cursor-size</a><br>
-Cursor moving keys: <a href="snd.html#movecursor">Moving the Cursor</a><br>
-Display data about sample under cursor: <a href="extsnd.html#withverbosecursor">with-verbose cursor</a><br>
-play from the current cursor position with a tracking cursor: <a href="extsnd.html#pfc">pfc</a><br>
-display tracking cursor as a full height vertical line: <a href="extsnd.html#trackingcursorstyle">tracking-cursor-style</a><br>
-track play once: control-click 'play'. (You can add a mark at the current tracking cursor location during the play with C-m)<br>
-leave the cursor at the final position after tracking play: if-cursor-follows-play-it-stays-where-play-stopped in examp.scm<br>
-tracking cursor accuracy: <a href="extsnd.html#cursorlocationoffset">cursor-location-offset</a><br>
-tracking cursor updating: <a href="extsnd.html#cursorupdateinterval">cursor-update-interval</a><br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Deletions</th><tr><td>
-<small><blockquote>
-delete a file: in scheme delete-file or Ruby's File.delete<br>
-delete a region: <a href="extsnd.html#forgetregion">forget-region</a><br>
-delete the currently selected samples: <a href="extsnd.html#deleteselection">delete-selection</a><br>
-delete the selection and smooth the splice: <a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
-delete a mark or all marks: <a href="extsnd.html#deletemark">delete-mark</a><br>
-delete a colormap: <a href="extsnd.html#deletecolormap">delete-colormap</a><br>
-delete samples: <a href="extsnd.html#deletesamples">delete-samples</a><br>
-remove a file from the sound cache: <a href="extsnd.html#mussoundforget">mus-sound-forget</a><br>
-remove a menu item: <a href="extsnd.html#removefrommenu">remove-from-menu</a> or remove-main-menu in snd-motif.scm<br>
-delete a mix or all mixes: <a href="sndscm.html#silenceallmixes">silence-mixes</a><br>
-add a 'delete' option to the file selection dialog: <a href="sndscm.html#adddeleteoption">add-delete-option</a><br>
-Scheme delete funcs: remove-if assoc-remove! hash-remove! delete-if! delete! string-delete<br>
-<br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Envelopes</th><tr><td>
-<blockquote><small>
-<br>
-envelope sound: <a href="extsnd.html#envchannel">env-channel</a>, <a href="extsnd.html#envsound">env-sound</a><br>
-other enveloping functions: <a href="extsnd.html#rampchannel">ramp-channel</a>, <a href="extsnd.html#xrampchannel">xramp-channel</a>, <a href="extsnd.html#smoothchannel">smooth-channel</a><br>
-The CLM env generator: <a href="sndclm.html#make-env">env</a>, many examples in examp.scm, new-effects.scm, etc<br>
-Various operations on envelopes: <a href="sndscm.html#envdoc">env.scm</a><br>
-The envelope editor: <a href="snd.html#editenvelope">Edit or View and Envelope</a><br>
-Panning: place-sound in examp.scm<br>
-Envelope over mix: <a href="sndscm.html#envelopedmix">enveloped-mix</a><br>
-Local envelope editor: <a href="sndscm.html#enveddoc">enved.scm</a>, xm-enved.scm<br>
-Read sound indexed through envelope: <a href="sndscm.html#envsoundinterp">env-sound-interp</a><br>
-repeating envelope: <a href="sndclm.html#pulsedenv">pulsed-env</a><br>
-Cosine as envelope: <a href="extsnd.html#cosinechannel">cosine-channel</a>, <a href="extsnd.html#cosinechannelviaptree">cosine-channel-via-ptree</a>, <a href="sndclm.html#bellcurve">bell-curve</a><br>
-envelope with sinusoidal connections between points: <a href="sndscm.html#sineenvchannel">sine-env-channel</a><br>
-envelope with separate base for each segment: <a href="extsnd.html#powenvchannel">powenv-channel</a><br>
-envelope with x^2 connections: <a href="sndscm.html#envsquaredchannel">env-squared-channel</a><br>
-envelope with x^n connections: <a href="sndscm.html#envexptchannel">env-expt-channel</a><br>
-envelope with <a href="sndclm.html#ncos">ncos</a> connections: <a href="sndscm.html#blackman4envchannel">blackman4-env-channel</a><br>
-Customizing the envelope editor: <a href="extsnd.html#envedhook">enved-hook</a><br>
-peak amp follower: <a href="sndclm.html#moving-max">moving-max</a><br>
-step envelope in pitch: <a href="sndclm.html#rxyk!cos">brassy</a> in generators.scm<br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">FFTs</th><tr><td>
-<small><blockquote>
-Snd fft function: <a href="extsnd.html#fft">fft</a><br>
-CLM fft function: <a href="sndclm.html#fft">mus-fft</a><br>
-CLM spectrum: <a href="sndclm.html#spectrum">spectrum</a><br>
-Snd spectrum: <a href="extsnd.html#sndspectrum">snd-spectrum</a><br>
-autocorrelation: <a href="sndclm.html#autocorrelate">autocorrelate</a><br>
-cross correlation: <a href="sndclm.html#correlate">correlate</a>, <a href="sndscm.html#displaycorrelation">display-correlation</a><br>
-FFT window: <a href="sndclm.html#make-fft-window">make-fft-window</a><br>
-Dolph-Chebyshev window in Scheme: <a href="sndscm.html#dolph">dolph</a><br>
-Hartley transform in Scheme: <a href="sndscm.html#dht">dht</a><br>
-Spectral edit dialog: <a href="snd.html#editenvelope">Envelope Editor</a><br>
-<br>
-fft-based filter: <a href="sndscm.html#fftedit">fft-edit</a>, <a href="sndscm.html#fftenvedit">fft-env-edit</a>, <a href="sndscm.html#fftenvinterp">fft-env-interp</a>, <a href="sndscm.html#fftsquelch">fft-squelch</a>, <a href="sndscm.html#fftcancel">fft-cancel</a><br>
-phase-vocoder: <a href="sndclm.html#phase-vocoder">phase-vocoder</a>. <a href="sndscm.html#pvocdoc">pvoc</a><br>
-transposition via fft: <a href="sndscm.html#downoct">down-oct</a><br>
-phase rotation via fft: <a href="sndscm.html#zerophase">zero-phase, rotate-phase</a><br>
-duration change via autocorrelation: <a href="sndscm.html#rubberdoc">rubber-sound</a><br>
-smoothing via fft: <a href="sndscm.html#fftsmoother">fft-smoother</a><br>
-cross-synthesis: <a href="sndscm.html#crosssynthesis">cross-synthesis</a><br>
-voiced->unvoiced effect: <a href="sndscm.html#voicedtounvoiced">voiced->unvoiced</a><br>
-noise reduction: <a href="sndscm.html#cleanchannel">clean-channel</a>, <a href="sndscm.html#clminsdoc">anoi</a><br>
-spectral modeling: <a href="sndscm.html#clminsdoc">pins</a><br>
-power spectral density: green.scm<br>
-polynomial approach to spectral multiplies (convolution): <a href="sndscm.html#spectralpolynomial">spectral-polynomial</a><br>
-<br>
-Superimpose ffts: <a href="sndscm.html#superimposeffts">superimpose-ffts</a><br>
-Waterfall real-time spectrograph: <a href="sndscm.html#startwaterfall">start-waterfall</a><br>
-Simple rt spectrum: <a href="sndscm.html#showinputfft">show-input-fft</a>, <a href="sndscm.html#showdraggableinputfft">show-draggable-input-fft</a><br>
-More transforms: <a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a>, <a href="sndscm.html#ztransform">z-transform</a> in dsp.scm<br>
-3D (single) fft display: <a href="sndscm.html#complexify">complexify</a><br>
-bark, mel, erb scale display: <a href="sndscm.html#displaybarkfft">display-bark-fft</a><br>
-apply function to spectrum, inverse fft: <a href="sndscm.html#filterfft">filter-fft</a><br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Filters</th><tr><td>
-<blockquote><small>
-<br>
-filter a sound: <a href="extsnd.html#filtersound">filter-sound</a>, <a href="extsnd.html#filterchannel">filter-channel</a>, and <a href="extsnd.html#clmchannel">clm-channel</a><br>
-filter the selection: <a href="extsnd.html#filterselection">filter-selection</a>, <a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a><br>
-CLM filter generators: <a href="sndclm.html#filterdoc">filter, one-pole, formant, comb, notch, all-pass, etc</a><br>
-lowpass filter: <a href="sndscm.html#makelowpass">make-lowpass</a> in dsp.scm<br>
-highpass filter: <a href="sndscm.html#makehighpass">make-highpass</a> in dsp.scm<br>
-bandpass filter: <a href="sndscm.html#makebandpass">make-bandpass</a> in dsp.scm<br>
-bandstop filter: <a href="sndscm.html#makebandstop">make-bandstop</a> in dsp.scm<br>
-the usual analog filters (Butterworth, Chebyshev, Bessel, Elliptic): <a href="sndscm.html#analogfilterdoc">analog-filter.scm</a><br>
-Butterworth filters: <a href="sndscm.html#makebutter">make-butter-high-pass</a>, make-butter-low etc in dsp.scm, used in new-effects.scm<br>
-IIR filters of various orders/kinds: <a href="sndscm.html#IIRfilters">dsp.scm</a><br>
-Hilbert transform: <a href="sndscm.html#makehilberttransform">make-hilbert-transform</a> in dsp.scm<br>
-differentiator: <a href="sndscm.html#makedifferentiator">make-differentiator</a> in dsp.scm<br>
-block DC: see example above, dc-block in prc95.scm, or stereo-flute in clm-ins.scm<br>
-hum elimination: see <a href="sndscm.html#IIRfilters">eliminate-hum</a> and <a href="sndscm.html#notchchannel">notch-channel</a> in dsp.scm<br>
-hiss elimination: <a href="sndscm.html#notchoutrumbleandhiss">notch-out-rumble-and-hiss</a><br>
-smoothing filters: <a href="sndclm.html#moving-average">moving-average</a>, <a href="sndclm.html#weighted-moving-average">weighted-moving-average</a>, exponentially-weighted-moving-average<br>
-notch-filters: <a href="sndscm.html#notchchannel">notch-channel</a> and <a href="sndscm.html#notchselection">notch-selection</a><br>
-arbitrary spectrum via FIR filter: <a href="sndscm.html#spectrumtocoeffs">spectrum->coeffs</a> in dsp.scm<br>
-invert an FIR filter: <a href="sndscm.html#invertfilter">invert-filter</a> in dsp.scm<br>
-filtered echo sound effect: <a href="sndscm.html#zecho">flecho</a> in examp.scm<br>
-time varying filter: fltit in examp.scm<br>
-draw frequency response: use <a href="snd.html#editenvelope">envelope editor</a> or <a href="snd.html#filtercontrol">filter control</a> in control panel<br>
-Moog filter: <a href="sndscm.html#moogdoc">moog.scm</a><br>
-Savitzky-Golay filter: <a href="sndscm.html#sgfilter">savitzky-golay-filter</a><br>
-Click reduction: <a href="sndscm.html#removeclicks">remove-clicks</a>, <a href="sndscm.html#cleanchannel">clean-channel</a><br>
-FIR filter as virtual edit: <a href="sndscm.html#virtualfilterchannel">virtual-filter-channel</a><br>
-Max Mathews resonator: <a href="sndclm.html#firmant">firmant</a>, <a href="sndscm.html#maxfdoc">maxf.scm, maxf.rb</a><br>
-Spectral edit dialog: <a href="snd.html#editenvelope">Envelope Editor</a><br>
-graphical equalizer filter bank: <a href="sndscm.html#clminsdoc">graphEq</a><br>
-nonlinear (Volterra) filter: <a href="sndscm.html#volterrafilter">volterra-filter</a><br>
-Kalman filter: <a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a><br>
-see also convolution, physical modeling, reverb, and <a href="sndscm.html#ssffts">fft-based filtering</a><br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Insertions</th><tr><td>
-<small><blockquote>
-insert some portion of a channel: <a href="sndscm.html#insertchannel">insert-channel</a><br>
-insert a silence: <a href="extsnd.html#padchannel">pad-channel</a>, <a href="extsnd.html#insertsilence">insert-silence</a>, <a href="sndscm.html#padsound">pad-sound</a><br>
-insert a region: <a href="extsnd.html#insertregion">insert-region</a><br>
-insert the selection: <a href="extsnd.html#insertselection">insert-selection</a><br>
-insert a vct of samples: <a href="extsnd.html#insertsamples">insert-samples</a>, <a href="sndscm.html#insertvct">insert-vct</a><br>
-insert a sound: <a href="extsnd.html#insertsound">insert-sound</a><br>
-append a sound and silence: <a href="extsnd.html#appendsound">append-sound</a><br>
-insert a frame: <a href="sndscm.html#insertframe">insert-frame</a><br>
-insert sound-data: <a href="sndscm.html#insertsounddata">insert-sound-data</a><br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen"><a class=quiet href="extsnd.html#sndmarks">Marks</a></th><tr><td>
-<blockquote><small>
-<br>
-global find-mark: <a href="sndscm.html#marknametoid">mark-name->id</a><br>
-mark history: <a href="sndscm.html#describemark">describe-mark</a><br>
-synchronize marks by inserting silences: <a href="sndscm.html#syncup">syncup</a><br>
-squeeze selection between marks: <a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a><br>
-insert silence before marks: <a href="sndscm.html#padmarks">pad-marks</a><br>
-move syncd marks: <a href="sndscm.html#movesyncdmarks">move-syncd-marks</a><br>
-play starting from syncd marks: <a href="sndscm.html#playsyncdmarks">play-syncd-marks</a><br>
-evaluate function between marks: <a href="sndscm.html#evalbetweenmarks">eval-between-marks</a><br>
-place marks at selection start and end: <a href="sndscm.html#snapmarks">snap-marks</a><br>
-define selection via marks: <a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a><br>
-force dragged mark to land on a beat: <a href="sndscm.html#snapmarktobeat">snap-mark-to-beat</a><br>
-loop continuously between the two specified marks: <a href="sndscm.html#loopbetweenmarks">loop-between-marks</a><br>
-split sound into separate files based on mark placement: <a href="sndscm.html#markexplode">mark-explode</a><br>
-mark property lists: <a href="extsnd.html#markproperty">mark-property</a><br>
-save mark properties in saved state file: <a href="sndscm.html#savemarkproperties">save-mark-properties</a><br>
-show mark properties upon click: <a href="sndscm.html#markclickinfo">mark-click-info</a><br>
-</small></blockquote>
-<br>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Maxamps</th><tr><td>
-<blockquote><small>
-<br>
-Sound file maxamp: <a href="extsnd.html#mussoundmaxamp">mus-sound-maxamp</a><br>
-Region maxamp: <a href="extsnd.html#regionmaxamp">region-maxamp</a><br>
-Selection maxamp: <a href="extsnd.html#selectionmaxamp">selection-maxamp</a><br>
-Sound data object maxamp: <a href="extsnd.html#sounddatamaxamp">sound-data-maxamp</a><br>
-Vct maxamp: <a href="extsnd.html#vctpeak">vct-peak</a><br>
-To set the y axis bounds to reflect the channel's maxamp: <a href="extsnd.html#ybounds">y-bounds</a><br>
-Mix maxamp: <a href="sndscm.html#mixmaxamp">mix-maxamp</a><br>
-maxamp locations: <a href="extsnd.html#maxampposition">maxamp-position</a>, <a href="extsnd.html#regionmaxampposition">region-maxamp-position</a>, <a href="extsnd.html#selectionmaxampposition">selection-maxamp-position</a>
-<br><br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen"><a class=quiet href="extsnd.html#sndmixes">Mixing</a></th><tr><td>
-<blockquote><small>
-<br>
-mix sound file: <a href="extsnd.html#mix">mix</a> or drag-and-drop it where you want it mixed<br>
-mix channel: see <a href="sndscm.html#mixchannel">mix-channel</a> in extensions.scm<br>
-mix region: <a href="extsnd.html#mixregion">mix-region</a><br>
-mix selection: <a href="extsnd.html#mixselection">mix-selection</a><br>
-mix vct: <a href="extsnd.html#mixvct">mix-vct</a><br>
-mix sound-data: <a href="sndscm.html#mixsounddata">mix-sound-data</a><br>
-mix a frame: <a href="sndscm.html#mixframe">mix-frame</a><br>
-enveloped mix: see <a href="sndscm.html#envelopedmix">enveloped-mix</a> in extensions.scm<br>
-read mix samples: <a href="extsnd.html#makemixsampler">make-mix-sampler</a><br>
-mix data maxamp: <a href="sndscm.html#mixmaxamp">mix-maxamp</a><br>
-mix data to vct: <a href="sndscm.html#mixtovct">mix->vct</a><br>
-save mix data in file: <a href="extsnd.html#savemix">save-mix</a><br>
-mix property list: <a href="extsnd.html#mixproperty">mix-property</a> in mix.scm<br>
-pan mono sound into stereo: see <a href="sndscm.html#placesound">place-sound</a> in examp.scm<br>
-move a mixed sound via dlocsig: <a href="extsnd.html#mixmovesound">mix-move-sound</a><br>
-the mix dialog: <a href="snd.html#mixdialog">Mix Dialog</a><br>
-cross-fade in frequency: <i>cross-fade</i> and <i>dissolve-fade</i> in <a href="sndscm.html#fadedoc">fade.scm</a><br>
-zipper cross-fade: <a href="sndscm.html#zipdoc">zipper.scm</a><br>
-snap mix to beat after drag: <a href="sndscm.html#snapmixtobeat">snap-mix-to-beat</a><br>
-delete all mixes: <a href="sndscm.html#silenceallmixes">silence-all-mixes</a><br>
-with-sound (a notelist) expanded into mixes: <a href="sndscm.html#withmixedsound">with-mixed-sound</a><br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Play</th><tr><td>
-<small><blockquote>
-play from cursor: C-q and example above<br>
-play from cursor with tracking cursor: <a href="extsnd.html#pfc">pfc</a> above<br>
-play the selection: (play (selection)), <a href="snd.html#cxp">C-x p</a><br>
-play a region: (play region-object), <a href="snd.html#cxp">C-x p</a>, play button in Region dialog<br>
-play a mix: (play mix-object), play button in Mix dialog<br>
-play a sequence of mixes: <a href="sndscm.html#playmixes">play-mixes</a><br>
-play from mark: click or drag triangle (control-click for all chans)<br>
-play continuously between two marks: <a href="sndscm.html#loopbetweenmarks">loop-it</a><br>
-stop playing: C-g, C-t, <a href="extsnd.html#stopplaying">stop-playing</a>, set <a href="extsnd.html#playing">playing</a> to #f<br>
-pause or resume playback: space, set <a href="extsnd.html#pausing">pausing</a><br>
-play repeatedly: <a href="sndscm.html#playoften">play-often</a><br>
-play repeatedly until C-g: <a href="sndscm.html#playuntilcg">play-until-c-g</a><br>
-play region repeatedly: <a href="sndscm.html#playregionforever">play-region-forever</a><br>
-play a file upon a keystroke: <a href="extsnd.html#extendedpiano">bind-key</a><br>
-play using an external program: (system "sndplay wood16.wav")<br>
-play a sine-wave or spectrum: <a href="sndscm.html#playsine">play-sine</a> and <a href="sndscm.html#playsines">play-sines</a><br>
-play arbitrary mixtures of things: <a href="extsnd.html#makeplayer">make-player</a> and related functions, <a href="sndscm.html#playsyncdmarks">play-syncd-marks</a><br>
-send arbitrary data to the DAC: <a href="extsnd.html#musaudiowrite">mus-audio-write</a>, <a href="sndscm.html#startdac">start-dac</a><br>
-play after sending the data through some function: <a href="sndscm.html#playsound">play-sound</a><br>
-play with applied amplitude envelope: <a href="sndscm.html#playwithenvs">play-with-envs</a>, <a href="sndscm.html#playpanned">play-panned</a><br>
-play an external file: (play "file")<br>
-<br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Random numbers</th><tr><td>
-<blockquote><small>
-<br>
-generators, arbitrary distributions, fractals, 1/f: <a href="sndclm.html#randdoc">rand and rand-interp</a>, <a href="sndclm.html#round-interp">round-interp</a><br>
-dithering: <a href="sndscm.html#ditherchannel">dither-channel</a>, <a href="sndscm.html#dithersound">dither-sound</a><br>
-noise-making instrument: <a href="sndscm.html#noisedoc">noise.scm, noise.rb</a><br>
-physical modeling of noisy instruments: <a href="sndscm.html#maracadoc">maraca.scm</a><br>
-arbitrary distribution via rejection method: <a href="sndscm.html#anyrandom">any-random</a><br>
-CL: random, *random-state*, make-random-state*: random number between 0 and arg, arg can't be 0!<br>
-Ruby: kernel_rand (alias for Ruby's rand), srand: random integer between 0 and arg, or float between 0 and 1<br>
-<a href="sndclm.html#mus-random">mus-random, mus_random</a>: random float between -arg and arg<br>
-mus-rand-seed (settable)<br>
-bounded brownian noise: <a href="sndclm.html#green-noise">green-noise</a><br>
-brown and pink noise: <a href="sndclm.html#brown-noise">brown-noise</a><br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen"><a class=quiet href="extsnd.html#sndregions">Regions</a></th><tr><td>
-<small><blockquote>
-Max length of region list: <a href="extsnd.html#maxregions">max-regions</a><br>
-Whether selection creates a region: <a href="extsnd.html#selectioncreatesregion">selection-creates-region</a><br>
-To play region repeatedly: <a href="sndscm.html#playregionforever">play-region-forever</a><br>
-Start region browser from Scheme: <a href="extsnd.html#viewregionsdialog">view-regions-dialog</a><br>
-All about regions: <a href="snd.html#regions">regions</a><br>
-The region dialog: <a href="snd.html#regionbrowser">region browser</a><br>
-Region rms amp: <a href="sndscm.html#regionrms">region-rms</a><br>
-region-play-list and region-play-sequence in examp.scm<br>
-<a href="sndscm.html#regiontoframe">region->frame</a><br>
-<a href="sndscm.html#regiontosounddata">region->sound-data</a><br>
-<a href="sndscm.html#makeregionframereader">make-region-frame-reader</a><br>
-<br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Resampling</th><tr><td>
-<small><blockquote>
-resample channel: <a href="extsnd.html#srcchannel">src-channel</a><br>
-resample all chans: <a href="extsnd.html#srcsound">src-sound</a><br>
-resample selection: <a href="extsnd.html#srcsoundselection">src-selection</a><br>
-resample mix: speed control in <a href="snd.html#mixdialog">Mix dialog</a> (also <a href="extsnd.html#applycontrols">apply-controls</a>)<br>
-resample via drawn envelope: srate in <a href="snd.html#editenvelope">Envelope editor</a><br>
-resample via CLM gen: <a href="sndclm.html#src">src</a><br>
-resample with independent time control (ssb-am): <a href="sndscm.html#ssbbank">ssb-bank</a> in dsp.scm<br>
-resample with independent time control (granulate): expand in <a href="extsnd.html#customcontrols">control panel</a>, <a href="sndscm.html#expsrc">expsrc</a> and <a href="sndscm.html#expsnd">expsnd</a><br>
-resample with independent time control (vocoder): <a href="sndclm.html#phase-vocoder">phase-vocoder</a> (this never works)<br>
-another time stretcher (autocorrelation):<a href="sndscm.html#rubbersound">rubber-sound</a> (this takes forever and rarely works)<br>
-resampling-based sound effects: <a href="sndscm.html#hellodentist">hello-dentist</a>, <a href="sndscm.html#fp">fp</a>, flange and chorus in dsp.scm and new-effects.scm<br>
-the digital zipper: <a href="sndscm.html#zipdoc">zipper</a><br>
-resample via FFT: <a href="sndscm.html#downoct">down-oct</a><br>
-resample through env: <a href="sndscm.html#soundinterp">sound-interp</a> and <a href="sndscm.html#envsoundinterp">env-sound-interp</a><br>
-resample through list: <a href="sndscm.html#scratch">scratch</a><br>
-resample step-size through a function: <a href="extsnd.html#setsamples">step-src</a><br>
-predict duration of resampled sound: <a href="sndscm.html#srcduration">src-duration</a><br>
-linear src: linear-src-channel in dsp.scm<br>
-<br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Reverbs</th><tr><td>
-<blockquote><small>
-<br>
-freeverb: <a href="sndscm.html#freeverbdoc">freeverb.scm, freeverb.rb</a><br>
-jc-reverb: <a href="sndscm.html#jcrevdoc">jcrev.scm</a><br>
-jl-reverb: <a href="sndscm.html#clminsdoc">clm-ins.scm</a><br>
-nrev: <a href="sndscm.html#clminsdoc">clm-ins.scm</a><br>
-control panel reverb: <a href="snd.html#reverb">Reverb</a>, <a href="extsnd.html#reverbdecay">control variables</a><br>
-convolution reverb: <a href="extsnd.html#convolvewith">conrev</a><br>
-*reverb*: <a href="sndscm.html#wsdoc">with-sound</a><br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Reversing</th><tr><td>
-<blockquote><small>
-<br>
-reverse channel: <a href="extsnd.html#reversechannel">reverse-channel</a>, <a href="extsnd.html#reversesound">reverse-sound</a><br>
-reverse selected portion: <a href="extsnd.html#reverseselection">reverse-selection</a><br>
-read samples in reverse: use <a href="extsnd.html#makesampler">make-sampler</a> with direction -1<br>
-reverse at new sampling rate: use <a href="extsnd.html#srcchannel">src-channel</a> with a negative ratio<br>
-Reverse in control panel: <a href="snd.html#speed">control panel</a> and <a href="extsnd.html#speedcontrol">speed-control</a> variable<br>
-reverse an envelope: <a href="sndscm.html#reverseenvelope">reverse-envelope</a><br>
-reverse block-wise: <a href="sndscm.html#reversebyblocks">reverse-by-blocks and reverse-within-blocks</a><br>
-reverse via FFT: <a href="extsnd.html#sillyreverse">silly-reverse</a><br>
-reverse order of channels: <a href="extsnd.html#reversechannels">reverse-channels</a><br>
-reverse a list: reverse and reverse!<br>
-reverse a string: in Ruby: reverse<br>
-reverse vct: <a href="extsnd.html#vctreverse">vct-reverse!</a><br>
-reverse a frame: <a href="sndscm.html#framereverse">frame-reverse</a><br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Saving</th><tr><td>
-<small><blockquote>
-save sound: <a href="extsnd.html#savesound">save-sound</a><br>
-save all sounds: <code>(for-each save-sound (sounds))</code><br>
-save a sound under a different name: <a href="extsnd.html#savesoundas">save-sound-as</a><br>
-extract one channel from a sound: <a href="extsnd.html#extractchannel">extract-channel</a><br>
-extract a set of channels from a sound: <a href="extsnd.html#extractchannels">extract-channels</a><br>
-save a sound in a different format or header: <a href="extsnd.html#savesoundas">save-sound-as</a><br>
-backup edits automatically: <a href="sndscm.html#autosave">autosave</a><br>
-check first for unsaved edits: <a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a><br>
-save Snd's complete state (unsaved edits and all): <a href="extsnd.html#savestate">save-state</a>, <a href="extsnd.html#savedir">save-dir</a>, <a href="extsnd.html#savestatehook">save-state-hook</a>, <a href="extsnd.html#savestatefile">save-state-file</a><br>
-save the selection: <a href="extsnd.html#saveselection">save-selection</a><br>
-save a region: <a href="extsnd.html#saveregion">save-region</a><br>
-save a mix: <a href="extsnd.html#savemix">save-mix</a><br>
-save the control panel state: <a href="extsnd.html#savecontrols">save-controls</a><br>
-save currently defined envelopes (envelope editor): <a href="extsnd.html#saveenvelopes">save-envelopes</a><br>
-start the file save dialog: <a href="extsnd.html#savesounddialog">save-sound-dialog</a><br>
-start the selection save dialog: <a href="extsnd.html#saveselectiondialog">save-selection-dialog</a><br>
-start the region save dialog: <a href="extsnd.html#saveregiondialog">save-region-dialog</a><br>
-save the current listener text: <a href="extsnd.html#savelistener">save-listener</a><br>
-save keyboard macros: <a href="extsnd.html#savemacros">save-macros</a><br>
-save marks: <a href="extsnd.html#savemarks">save-marks</a><br>
-save just the edit history: <a href="extsnd.html#saveedithistory">save-edit-history</a><br>
-take some action upon a window manager save-yourself signal: <a href="sndscm.html#uponsaveyourself">upon-save-yourself</a><br>
-save the current sound setup for a later reopen: <a href="extsnd.html#remembersoundstate">remember-sound-state</a><br>
-save the current fft peak info: <a href="extsnd.html#peaks">peaks</a><br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Searches</th><tr><td>
-<blockquote><small>
-<br>
-find a mark: <a href="extsnd.html#findmark">find-mark</a><br>
-find a mix: <a href="sndscm.html#findmix">find-mix</a><br>
-find a sound: <a href="extsnd.html#findsound">find-sound</a><br>
-Example find procedures: <a href="sndscm.html#searchforclick">search-for-click, zero+, next-peak, find-pitch</a><br>
-find in reverse: <a href="extsnd.html#findchannelinreverse">find-channel-in-reverse</a><br>
-Search via continuation: <a href="extsnd.html#scanagain">scan-again</a><br>
-Explicit access to search procedures: <a href="extsnd.html#searchprocedure">search-procedure</a><br>
-The Find dialog: <a href="snd.html#editoperations">Find</a> or <a href="extsnd.html#finddialog">find-dialog</a><br>
-find silence: <a href="extsnd.html#mapsilence">map-silence</a>, scramble-channel in examp.scm<br>
-find any difference between two chans: <a href="sndscm.html#channelsequal">channels-equal</a><br>
-see also <a href="extsnd.html#countmatches">count-matches</a> and <a href="extsnd.html#scanchannel">scan-channel</a><br>
-search a multichannel sound: <a href="sndscm.html#scansound">scan-sound</a><br>
-find a widget: find-child in snd-motif.scm<br>
-add C-s and C-r to the listener key bindings: add-find-to-listener in snd-motif.scm<br>
-Scheme find: find-if<br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen"><a class=quiet href="extsnd.html#sndregions">Selections</a></th><tr><td>
-<small><blockquote>
-show the current selection: <a href="extsnd.html#showselection">show-selection</a><br>
-color of selected portion: <a href="extsnd.html#selectioncolor">selection-color</a><br>
-set whether creating a selection creates a region: <a href="extsnd.html#selectioncreatesregion">selection-creates-region</a><br>
-fft graph refers to the selection: <a href="extsnd.html#showselectiontransform">show-selection-transform</a><br>
-hook called when selection stops playing: <a href="extsnd.html#stopplayingselectionhook">stop-playing-selection-hook</a><br>
-swap chans in selected portion: <a href="sndscm.html#swapselectionchannels">swap-selection-channels</a><br>
-replace portion with selection: <a href="sndscm.html#replacewithselection">replace-with-selection</a><br>
-select portion via function: <a href="sndscm.html#makeselection">make-selection</a><br>
-evaluate func on each sample of selection: <a href="sndscm.html#evaloverselection">eval-over-selection</a> (map-selection in effect)<br>
-selection members as list of lists of sound indices and channels: <a href="sndscm.html#selectionmembers">selection-members</a><br>
-rms of selection data: <a href="sndscm.html#selectionrms">selection-rms</a><br>
-delete selection and smooth the splice: <a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
-select portion between two marks: <a href="sndscm.html#defineselectionviamarks">define-selection-via-marks</a><br>
-place marks at selection start and end: <a href="sndscm.html#snapmarks">snap-marks</a><br>
-squeeze selection between marks: <a href="sndscm.html#fitselectionbetweenmarks">fit-selection-between-marks</a><br>
-delete selection and write it to a file: <a href="sndscm.html#menusdoc">cut-selection->new</a><br>
-append selection: <a href="sndscm.html#menusdoc">append-selection</a><br>
-write selection to a file: <a href="sndscm.html#menusdoc">selection->new</a><br>
-notch filter selection: <a href="sndscm.html#notchselection">notch-selection</a><br>
-undo select-all.: <a href="sndscm.html#menusdoc">deselect-all</a><br>
-filter the selection: <a href="extsnd.html#filterselection">filter-selection</a>, <a href="sndscm.html#filterselectionandsmooth">filter-selection-and-smooth</a><br>
-turn the selection into a mix: <a href="extsnd.html#selectiontomix">selection->mix</a><br>
-unselect everything: <a href="extsnd.html#unselectall">unselect-all</a><br>
-<br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Smoothing</th><tr><td>
-<small><blockquote>
-smooth channel: <a href="extsnd.html#smoothchannel">smooth-channel</a><br>
-smooth all channels: <a href="extsnd.html#smoothsound">smooth-sound</a><br>
-smooth selection: <a href="extsnd.html#smoothselection">smooth-selection</a><br>
-delete the selection and smooth the splice: <a href="extsnd.html#deleteselectionandsmooth">delete-selection-and-smooth</a><br>
-smoothing as virtual op: smooth-channel-via-ptree in examp.scm<br>
-smoothing via fft: <a href="sndscm.html#fftsmoother">fft-smoother</a><br>
-smooth via low-pass <a href="extsnd.html#filtersinsnd">filter</a><br>
-smooth over click: <a href="sndscm.html#removeclicks">remove-clicks</a> in examp.scm<br>
-</blockquote></small>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Time Domain Display</th><tr><td>
-<blockquote><small>
-<br>
-Built-in keyboard commands: <a href="snd.html#movewindow">Moving the Window</a><br>
-Specialized keyboard commands: <a href="extsnd.html#bindkey">bind-key</a><br>
-Window size: <a href="extsnd.html#xzoomslider">x-zoom-slider</a>, <a href="extsnd.html#zoomonepixel">zoom-one-pixel</a>, <br>
-Window position: <a href="extsnd.html#xpositionslider">x-position-slider</a>, <a href="extsnd.html#moveonepixel">move-one-pixel</a><br>
-Window left edge: <a href="extsnd.html#leftsample">left-sample</a><br>
-Window right edge: <a href="extsnd.html#rightsample">right-sample</a><br>
-<br>
-fft window:<br>
-window size: drag x axis, <a href="extsnd.html#spectrumend">spectrum-end</a><br>
-window start: <a href="extsnd.html#spectrumstart">spectrum-start</a><br>
-relation to time domain: <a href="extsnd.html#beforetransformhook">before-transform-hook</a><br>
-selection fft: <a href="extsnd.html#showselectiontransform">show-selection-transform</a><br>
-<br>
-general info:<br>
-Axis description: <a href="extsnd.html#axisinfo">axis-info</a><br>
-<br>
-</small></blockquote>
-</td></tr></table>
-
-
-<br>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="lightgreen">Undo</th><tr><td>
-<small><blockquote>
-undo edit: <a href="extsnd.html#undo">undo</a> and <a href="extsnd.html#undochannel">undo-channel</a><br>
-undo all edits: <a href="extsnd.html#revertsound">revert-sound</a><br>
-specialize undo: <a href="extsnd.html#undohook">undo-hook</a><br>
-protect against undo: <a href="extsnd.html#edithook">edit-hook</a><br>
-redo edit: <a href="extsnd.html#redo">redo</a> and <a href="extsnd.html#redochannel">redo-channel</a><br>
-move around in edit list: <a href="extsnd.html#editposition">edit-position</a> and <a href="extsnd.html#currenteditposition">current-edit-position</a><br>
-About edit lists: <a href="extsnd.html#editlists">Edit lists</a><br><br>
-</blockquote></small>
-</td></tr></table>
-
-
-
-</body></html>
diff --git a/r7rs.scm b/r7rs.scm
new file mode 100644
index 0000000..f3471b8
--- /dev/null
+++ b/r7rs.scm
@@ -0,0 +1,439 @@
+;;; r7rs compatibility
+
+(require cload.scm libc.scm stuff.scm)
+(provide 'r7rs.scm)
+
+
+(define (vector-map p . args) (apply vector (apply map p args)))
+(define (string-map p . args) (apply string (apply map p args)))
+(define vector-for-each for-each)
+(define string-for-each for-each)
+
+
+(define* (vector->string v (start 0) end)
+ (let ((stop (or end (length v))))
+ (copy v (make-string (- stop start)) start stop)))
+
+(define* (string->vector s (start 0) end)
+ (let ((stop (or end (length s))))
+ (copy s (make-vector (- stop start)) start stop)))
+
+(define list-copy copy)
+
+(define* (vector-copy v (start 0) end)
+ (let ((stop (or end (length v))))
+ (copy v (make-vector (- stop start)) start stop)))
+
+(define* (r7rs-string-copy s (start 0) end)
+ (let ((stop (or end (length s))))
+ (copy s (make-string (- stop start)) start stop)))
+
+(define r7rs-vector-fill! fill!) ; or do these return the sequence, not the filler?
+(define r7rs-string-fill! fill!)
+
+(define* (vector-copy! dest at src (start 0) end) ; apparently end is exclusive here?
+ (let ((len (or end (length src))))
+ (if (or (not (eq? dest src))
+ (<= at start))
+ (do ((i at (+ i 1))
+ (k start (+ k 1)))
+ ((= k len) dest)
+ (set! (dest i) (src k)))
+ (do ((i (+ at (- len start 1)) (- i 1))
+ (k (- len 1) (- k 1)))
+ ((< k start) dest)
+ (set! (dest i) (src k))))))
+
+(define (r7rs-make-hash-table . args)
+ (if (null? args)
+ (#_make-hash-table)
+ (if (procedure? (car args))
+ (#_make-hash-table (if (null? (cdr args)) 511 (cadr args)) (car args))
+ (apply #_make-hash-table args))))
+
+(define bytevector byte-vector)
+(define ->bytevector ->byte-vector)
+(define bytevector? byte-vector?)
+(define make-bytevector make-byte-vector)
+
+(define bytevector-copy! vector-copy!)
+(define string-copy! vector-copy!)
+(define (bytevector->list bv) (map values bv))
+
+
+(define (boolean=? . args)
+ (or (null? args)
+ (and (boolean? (car args))
+ (or (null? (cdr args))
+ (every? (lambda (obj) (eq? (car args) obj)) (cdr args))))))
+
+(define (symbol=? . args)
+ (or (null? args)
+ (and (symbol? (car args))
+ (or (null? (cdr args))
+ (every? (lambda (obj) (eq? (car args) obj)) (cdr args))))))
+
+
+(define char-foldcase char-downcase)
+(define string-foldcase string-downcase)
+;;; these and the string functions in s7 are not unicode-aware. To get true unicode
+;;; handling of the bytes, use the glib functions in libxg or use cload (see xgdata.scm).
+(define (digit-value c) (and (char-numeric? c) (- (char->integer c) (char->integer #\0))))
+
+
+(define +inf.0 inf.0)
+(define +nan.0 nan.0)
+(define (finite? n) (and (number? n) (not (nan? n)) (not (infinite? n))))
+
+(define exact-integer? integer?)
+(define (exact-integer-sqrt i) (let ((sq (floor (sqrt i)))) (values sq (- i (* sq sq)))))
+(define inexact exact->inexact)
+(define exact inexact->exact)
+(define (square x) (* x x))
+(define truncate-quotient quotient)
+(define truncate-remainder remainder)
+(define floor-remainder modulo)
+(define (floor-quotient x y) (floor (/ x y)))
+
+
+(define (input-port-open? p) (not (port-closed? p)))
+(define (output-port-open? p) (not (port-closed? p)))
+(define (port? p) (or (input-port? p) (output-port? p)))
+(define binary-port? port?)
+(define textual-port? port?)
+(define (close-port p) (if (input-port? p) (close-input-port p) (close-output-port p)))
+(define open-binary-input-file open-input-file)
+(define open-binary-output-file open-output-file)
+(define (call-with-port port proc)
+ ((if (input-port? port) call-with-input-file call-with-output-file) port proc))
+
+
+(define (bytevector-u8-ref b k) (b k))
+(define (bytevector-u8-set! b k c) (set! (b k) c))
+(define bytevector-length length)
+(define (bytevector-copy . args) (->byte-vector (apply string-copy args)))
+(define (bytevector-append . args) (->byte-vector (apply string-append args)))
+(define write-bytevector write-string)
+(define* (read-bytevector! bv port (start 0) end)
+ (let ((lim (or end (length bv)))
+ (pt (or port (current-input-port))))
+ (do ((i start (+ i 1))
+ (c (read-byte pt) (read-byte pt)))
+ ((or (>= i lim)
+ (eof-object? c))
+ bv)
+ (set! (bv i) c))))
+(define* (read-bytevector k port)
+ (read-bytevector! (->byte-vector (make-string k)) port))
+(define (get-output-bytevector port) (->byte-vector (get-output-string port)))
+(define open-input-bytevector open-input-string)
+(define open-output-bytevector open-output-string)
+(define read-u8 read-byte)
+(define write-u8 write-byte)
+(define u8-ready? char-ready?)
+(define peek-u8 peek-char)
+(define* (utf8->string v (start 0) end) (substring v start (or end (length v))))
+(define* (string->utf8 s (start 0) end) (->byte-vector (substring s start (or end (length s)))))
+(define write-simple write)
+
+(define (eof-object) #<eof>)
+(define (features) *features*)
+
+
+(define (with-exception-handler handler thunk) (catch #t thunk handler))
+(define raise error)
+(define raise-continuable error)
+
+(define-macro (guard results . body)
+ `(let ((,(car results) (catch #t (lambda () , at body) (lambda args (car args)))))
+ (cond ,@(cdr results))))
+
+(define (read-error? obj) (eq? (car obj) 'read-error))
+(define (file-error? obj) (eq? (car obj) 'io-error))
+(define (error-message obj) (apply format #f (cadr obj)))
+(define error-irritants cdadr)
+
+
+(define interaction-environment curlet)
+(define-macro (include . files)
+ `(begin
+ ,@(map (lambda (file)
+ `(load ,file (outlet (curlet))))
+ files)))
+
+(set! *#readers* (cons (cons #\; (lambda (s) (read) (values))) *#readers*))
+;; I prefer (define-expansion (comment . stuff) (reader-cond (#t (values))))
+;; or (format #f "~^ this is a comment ")
+
+
+(define-macro (define-values vars . body)
+ `(apply begin (map (lambda (var val) `(define ,var ,val)) ',vars (list (begin , at body)))))
+
+(define-macro (let*-values vars . body)
+ `(let ()
+ ,@(map (lambda (nvars . nbody)
+ `(apply define-values ',nvars ', at nbody))
+ (map car vars)
+ (map cdr vars))
+ , at body))
+
+
+;; case-lambda
+(define-macro (case-lambda . choices)
+ `(lambda args
+ (case (length args)
+ ,@(map (lambda (choice)
+ (if (or (symbol? (car choice))
+ (negative? (length (car choice))))
+ `(else (apply (lambda ,(car choice) ,@(cdr choice)) args))
+ `((,(length (car choice)))
+ (apply (lambda ,(car choice) ,@(cdr choice)) args))))
+ choices))))
+
+
+;; parameters
+(define* (make-parameter init converter)
+ (let* ((convert (or converter (lambda (x) x)))
+ (old-values ()) ; see below -- this is part of the funclet
+ (value (convert init)))
+ (lambda () value)))
+
+(define-macro (parameterize vars . body)
+ `(dynamic-wind
+ (lambda ()
+ ,@(map (lambda (var)
+ `(with-let (funclet ,(car var))
+ (set! old-values (cons value old-values))
+ (set! value (convert ,(cadr var)))))
+ vars))
+ (lambda ()
+ , at body)
+ (lambda ()
+ ,@(map (lambda (var)
+ `(with-let (funclet ,(car var))
+ (set! value (car old-values))
+ (set! old-values (cdr old-values))))
+ vars))))
+
+
+;; libraries
+(apply define (symbol (object->string '(scheme base))) (inlet) ()) ; ignore (scheme base)
+(apply define (symbol (object->string '(scheme read))) (inlet) ()) ; and so on... what a pile of baloney
+(apply define (symbol (object->string '(scheme write))) (inlet) ())
+(apply define (symbol (object->string '(scheme time))) (inlet) ())
+(apply define (symbol (object->string '(scheme file))) (inlet) ())
+(apply define (symbol (object->string '(scheme cxr))) (inlet) ())
+(apply define (symbol (object->string '(scheme inexact))) (inlet) ())
+(apply define (symbol (object->string '(scheme char))) (inlet) ())
+(apply define (symbol (object->string '(scheme complex))) (inlet) ())
+
+(define-macro (define-library libname . body) ; |(lib name)| -> environment
+ `(define ,(symbol (object->string libname))
+ (with-let (sublet (unlet)
+ (cons 'import (symbol->value 'import))
+ (cons '*export* ())
+ (cons 'export (symbol->value
+ (define-macro (,(gensym) . names)
+ `(set! *export* (append ',names *export*))))))
+ , at body
+ (apply inlet
+ (map (lambda (entry)
+ (if (or (member (car entry) '(*export* export import))
+ (and (pair? *export*)
+ (not (member (car entry) *export*))))
+ (values)
+ entry))
+ (curlet))))))
+
+(define-macro (import . libs)
+ `(varlet (curlet)
+ ,@(map (lambda (lib)
+ (case (car lib)
+ ((only)
+ `((lambda (e names)
+ (apply inlet
+ (map (lambda (name)
+ (cons name (e name)))
+ names)))
+ (symbol->value (symbol (object->string (cadr ',lib))))
+ (cddr ',lib)))
+
+ ((except)
+ `((lambda (e names)
+ (apply inlet
+ (map (lambda (entry)
+ (if (member (car entry) names)
+ (values)
+ entry))
+ e)))
+ (symbol->value (symbol (object->string (cadr ',lib))))
+ (cddr ',lib)))
+
+ ((prefix)
+ `((lambda (e prefx)
+ (apply inlet
+ (map (lambda (entry)
+ (cons (string->symbol
+ (string-append (symbol->string prefx)
+ (symbol->string (car entry))))
+ (cdr entry)))
+ e)))
+ (symbol->value (symbol (object->string (cadr ',lib))))
+ (caddr ',lib)))
+
+ ((rename)
+ `((lambda (e names)
+ (apply inlet
+ (map (lambda (entry)
+ (let ((info (assoc (car entry) names)))
+ (if info
+ (cons (cadr info) (cdr entry))
+ entry))) ; I assume the un-renamed ones are included
+ e)))
+ (symbol->value (symbol (object->string (cadr ',lib))))
+ (cddr ',lib)))
+
+ (else
+ `(let ((sym (symbol (object->string ',lib))))
+ (if (not (defined? sym))
+ (format #t "~A not loaded~%" sym)
+ (symbol->value sym))))))
+ libs)))
+
+
+;; delay and force: ugh
+;; this implementation is based on the r7rs spec
+(define-macro (delay-force expr)
+ `(make-promise #f (lambda () ,expr)))
+(define-macro (r7rs-delay expr) ; "delay" is taken damn it
+ `(delay-force (make-promise #t (lambda () ,expr))))
+(define (make-promise done? proc)
+ (list (cons done? proc)))
+(define (force promise)
+ (if (caar promise)
+ ((cdar promise))
+ (let ((promise* ((cdar promise))))
+ (if (not (caar promise))
+ (begin
+ (set-car! (car promise) (caar promise*))
+ (set-cdr! (car promise) (cdar promise*))))
+ (force promise))))
+
+
+;; floor/ and truncate/ can't work as intended: they assume that multiple values
+;; are not spliced. The "division library" is a trivial, pointless micro-optimization.
+;; and why no euclidean-rationalize or exact-integer-expt?
+;; (imagine what will happen when r8rs stumbles on the zoo of continued fraction algorithms!)
+
+(let ((e (curlet)))
+ (c-define
+ '((in-C "static int g_time(void) {return((int)time(NULL));} \n\
+ static struct timeval overall_start_time; \n\
+ static bool time_set_up = false; \n\
+ static double get_internal_real_time(void) \n\
+ { \n\
+ struct timezone z0; \n\
+ struct timeval t0; \n\
+ double secs; \n\
+ if (!time_set_up) {gettimeofday(&overall_start_time, &z0); time_set_up = true;} \n\
+ gettimeofday(&t0, &z0); \n\
+ secs = difftime(t0.tv_sec, overall_start_time.tv_sec);\n\
+ return(secs + 0.000001 * (t0.tv_usec - overall_start_time.tv_usec)); \n\
+ }")
+ (double get_internal_real_time (void))
+ (int g_time (void)))
+ "" '("time.h" "sys/time.h"))
+ (varlet e
+ (cons 'jiffies-per-second (lambda () 1000))
+ (cons 'current-jiffy (lambda () (round (* (get_internal_real_time) 1000.0))))
+ (cons 'current-second g_time)))
+
+
+(define get-environment-variable (*libc* 'getenv))
+(define get-environment-variables (*libc* 'getenvs))
+(define (r7rs-file-exists? arg) (= ((*libc* 'access) arg (*libc* 'F_OK)) 0))
+(define r7rs-delete-file (*libc* 'unlink))
+
+(define (os-type) (car ((*libc* 'uname))))
+(define (cpu-architecture) (cadr ((*libc* 'uname))))
+(define (machine-name) (caddr ((*libc* 'uname))))
+(define (os-version) (string-append (list-ref ((*libc* 'uname)) 3) " " (list-ref ((*libc* 'uname)) 4)))
+(define (implementation-name) "s7")
+(define (implementation-version) (substring (s7-version) 3 7))
+
+;; command-line is problematic: s7 has no access to the caller's "main" function, and
+;; outside Windows, there's no reasonable way to get these arguments.
+;; in Linux, you might win with:
+
+(define (command-line)
+ (let ((lst ()))
+ (with-input-from-file "/proc/self/cmdline"
+ (lambda ()
+ (do ((c (read-char) (read-char))
+ (s ""))
+ ((eof-object? c)
+ (reverse lst))
+ (if (char=? c #\null)
+ (begin
+ (set! lst (cons s lst))
+ (set! s ""))
+ (set! s (string-append s (string c)))))))))
+
+
+;; other minor differences:
+;; in s7, single-quote can occur in a name
+;; s7 doesn't currently implement #\xxxx characters
+
+
+;; records
+(define-macro (define-record-type type make ? . fields)
+ (let ((new-type (if (pair? type) (car type) type))
+ (inherited (if (pair? type) `(list ,@(cdr type)) ())))
+ `(begin
+ (define-class ,new-type ,inherited
+ (map (lambda (f) (if (pair? f) (car f) f)) ',fields))
+
+ (define (,? obj) ; perhaps the define-class type predicate should use this
+ (define (search-inherited obj type)
+ (define (search-inheritors objs type)
+ (and (pair? objs)
+ (or (search-inherited (car objs) type)
+ (search-inheritors (cdr objs) type))))
+ (or (eq? (obj 'class-name) type)
+ (search-inheritors (obj 'inherited) type)))
+ (and (let? obj)
+ (search-inherited obj ',new-type)))
+
+ (define ,make
+ (let ((new-obj (copy ,new-type)))
+ ,@(map (lambda (slot)
+ `(set! (new-obj ',slot) ,slot))
+ (cdr make))
+ new-obj))
+
+ ,@(map
+ (lambda (field)
+ (if (pair? field)
+ (if (null? (cdr field))
+ (values)
+ (if (null? (cddr field))
+ `(define (,(cadr field) obj)
+ (if (not (,? obj))
+ (error 'wrong-type-arg "~S should be a ~A" obj ',type))
+ (obj ',(car field)))
+ `(begin
+ (define (,(cadr field) obj)
+ (if (not (,? obj))
+ (error 'wrong-type-arg "~S should be a ~A" obj ',type))
+ (obj ',(car field)))
+ (define (,(caddr field) obj val)
+ (if (not (,? obj))
+ (error 'wrong-type-arg "~S should be a ~A" obj ',type))
+ (set! (obj ',(car field)) val)))))))
+ fields)
+ ',new-type)))
+
+;;; srfi 111:
+(define-record-type box-type (box value) box? (value unbox set-box!))
+
+
diff --git a/repl.scm b/repl.scm
new file mode 100644
index 0000000..4ad7944
--- /dev/null
+++ b/repl.scm
@@ -0,0 +1,1513 @@
+;;; a repl
+;;;
+;;; (load "repl.scm") ((*repl* 'run))
+
+(provide 'repl.scm)
+(require libc.scm)
+
+(unless (defined? '*repl*)
+ (define *repl* ; environment that holds the REPL functions
+ (let ((prompt #f) ; function to get/set prompt
+ (keymap #f) ; function to get/set keymap entries
+ (history #f) ; function to get/set history buffer entries
+ (history-size #f) ; function to get/set history buffer size
+ (save-history #f) ; function to save the current history buffer entries in a file
+ (restore-history #f) ; function to restore history buffer entries from a file
+ (helpers ()) ; list of functions displaying help strings
+ (run #f) ; function that fires up a REPL
+ (top-level-let (sublet (rootlet) :** #f)) ; environment in which evaluation takes place
+ (repl-let ; environment for keymap functions to access all the REPL innards (cursor-position etc)
+
+ (with-let (sublet *libc*)
+
+ ;; -------- completion --------
+ (define (symbol-completion text)
+ (let ((st (symbol-table))
+ (text-len (length text))
+ (match #f))
+ (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (symbol)
+ (let* ((sym (symbol->string symbol))
+ (sym-len (length sym)))
+ (when (and (>= sym-len text-len)
+ (string=? text (substring sym 0 text-len)))
+ (if match
+ (return text)
+ (set! match sym)))))
+ st)
+ (or match text)))))
+
+ (define (filename-completion text)
+ (let ((g (glob.make)))
+ (glob (string-append text "*")
+ (logior (if (and (defined? 'GLOB_TILDE)
+ (char=? (text 0) #\~))
+ GLOB_TILDE
+ 0)
+ GLOB_MARK)
+ g)
+ (let ((files (map (lambda (f) ; get rid of emacs' *~ files
+ (if (and (> (length f) 1)
+ (char=? #\~ (f (- (length f) 1))))
+ (values)
+ f))
+ (glob.gl_pathv g))))
+ (globfree g)
+ (if (or (null? files)
+ (not (null? (cdr files))))
+ text
+ (car files)))))
+
+
+ ;; -------- history --------
+ (let ((histbuf (make-vector 100 ""))
+ (histsize 100)
+ (histpos 0)
+ (m-p-pos 0)
+ (histtop ())
+ (histtail ()))
+
+ (define (push-line line)
+ (if (null? histtop)
+ (begin
+ (set! histtop (list line))
+ (set! histtail histtop))
+ (begin
+ (set-cdr! histtail (list line))
+ (set! histtail (cdr histtail)))))
+
+ (define (history-member line)
+ (do ((i 0 (+ i 1)))
+ ((or (= i histsize)
+ (string=? (vector-ref histbuf i) line))
+ (and (< i histsize) i))))
+
+ (define history-size (dilambda
+ (lambda ()
+ histsize)
+ (lambda (new-size)
+ (unless (= new-size histsize)
+ (if (<= new-size 0)
+ (error 'out-of-range "new history buffer size must be positive")
+ (let ((new-hist (make-vector new-size ""))
+ (new-end (min (- new-size 1) histpos)))
+ (let loop ((oldpos histpos)
+ (newpos new-end))
+ (set! (new-hist newpos) (histbuf oldpos))
+ (if (zero? newpos)
+ (set! newpos (- new-size 1))
+ (set! newpos (- newpos 1)))
+ (unless (= newpos new-end)
+ (if (zero? oldpos)
+ (set! oldpos (- histsize 1))
+ (set! oldpos (- oldpos 1)))
+ (unless (= oldpos histpos)
+ (loop oldpos newpos))))
+ (set! histsize new-size)
+ (set! histpos new-end)
+ (set! histbuf new-hist)
+ new-size))))))
+
+ (define history (dilambda
+ (lambda (back)
+ (let ((i (+ histpos back)))
+ (if (< i 0)
+ (histbuf (+ histsize i))
+ (if (>= i histsize)
+ (histbuf (- i histsize))
+ (histbuf i)))))
+
+ (lambda (new-line)
+ (let ((pos (history-member new-line)))
+ (when (integer? pos) ; remove the earlier case, circularly compress the buffer
+ (when (>= pos histpos)
+ (do ((i pos (+ i 1)))
+ ((>= i (- histsize 1)))
+ (set! (histbuf i) (histbuf (+ i 1))))
+ (set! (histbuf (- histsize 1)) (histbuf 0))
+ (set! pos 0))
+
+ (do ((i pos (+ i 1)))
+ ((>= i (- histpos 1)))
+ (set! (histbuf i) (histbuf (+ i 1))))
+ (set! histpos (- histpos 1)))
+
+ (set! (histbuf histpos) new-line)
+ (set! histpos (+ histpos 1))
+ (if (= histpos histsize)
+ (set! histpos 0))))))
+
+ (define (history-help)
+ (set! (*repl* 'helpers)
+ (list
+ (lambda (c)
+ (format #f "size: ~A, pos: ~A" histsize histpos))
+ (lambda (c)
+ (format #f "buf: ~A ~A ~A" (history -1) (history -2) (history -3)))
+ (lambda (c)
+ (format #f "line: ~A" histtop)))))
+
+ (define (pop-history) ; throw away most recent addition
+ (set! histpos (- histpos 1))
+ (if (negative? histpos)
+ (set! histpos (- histsize 1))))
+
+ (define* (write-history port (spaces 0))
+ (format port "~NC(set! histpos ~D)~%" spaces #\space histpos)
+ (format port "~NC(set! histsize ~D)~%" spaces #\space histsize)
+ (let ((pl (*s7* 'print-length)))
+ (set! (*s7* 'print-length) (* 2 histsize))
+ (format port "~NC(set! histbuf ~A)" spaces #\space (object->string histbuf))
+ (set! (*s7* 'print-length) pl)))
+
+ (define* (save-history (file "repl-history.scm"))
+ (call-with-output-file file
+ write-history))
+
+ (define* (restore-history (file "repl-history.scm"))
+ (load file (curlet)))
+
+
+ (let ((prompt-string "<1> ") ; this doesn't look very good, but I can't find anything better
+ (prompt-length 4) ; perhaps the line number could go in the terminal's right margin?
+ (cur-line "") ; current expression (can contain newlines)
+ (prev-line ()) ; for undo via C-_
+ (selection #f) ; for C-y
+ (cursor-pos 0) ; cursor-pos is the logical position (index into cur-line)
+ (cur-row 0) ; catch window scrolling
+ (red-par-pos #f) ; paren match position (index into cur-line)
+ (prompt-row 0) ; need to tie everything to prompt position (it can move in media res if window scrolls)
+ (prompt-col 0)
+ (last-row 0) ; these hold the window bounds when we start
+ (last-col 0)
+ (input-fd (fileno stdin)) ; source of chars, either tty input or file input
+ (terminal-fd (fileno stdin))
+ (tab-as-space (make-string 6 #\space))
+ (next-char #f)
+ (chars 0) ; (sigh) a kludge to try to distinguish tab-as-space from tab-as-completion/indentation
+ (unbound-case #f)
+ (all-done #f)) ; if #t, repl returns to its caller, if any
+
+
+ ;; -------- evaluation ---------
+ (define (badexpr h) ; *missing-close-paren-hook* function for Enter command
+ (set! (h 'result) 'string-read-error))
+
+ (define (shell? h) ; *unbound-variable-hook* function, also for Enter
+ ;; examine cur-line -- only call system if the unbound variable matches the first non-whitespace chars
+ ;; of cur-line, and command -v name returns 0 (indicating the shell thinks it is an executable command)
+ (do ((i 0 (+ i 1)))
+ ((or (= i (length cur-line))
+ (not (char-whitespace? (cur-line i))))
+ (let ((var-name (symbol->string (h 'variable))))
+ (when (and (>= (- (length cur-line) i) (length var-name)) ; var-name might be unrelated to cur-line
+ (string=? var-name (substring cur-line i (+ i (length var-name))))
+ (zero? (system (string-append "command -v " var-name " >/dev/null"))))
+ (set! unbound-case #t)
+ (if (procedure? ((rootlet) 'system))
+ (begin
+ (set! ((*repl* 'top-level-let) '**) (((rootlet) 'system) cur-line #t))
+ (display ((*repl* 'top-level-let) '**) *stderr*))
+ (set! ((*repl* 'top-level-let) '**) (system cur-line)))
+ (set! (h 'result) (symbol " ")))))))
+
+ (define (with-repl-let body)
+ ;; for multiline edits, we will use *missing-close-paren-hook* rather than try to parse the input ourselves.
+ (let ((old-badexpr-hook (hook-functions *missing-close-paren-hook*))
+ (old-unbound-var-hook (hook-functions *unbound-variable-hook*))
+ (old-eval #f)
+ (old-eval-string #f)
+ (old-load #f))
+
+ ;; if the repl's top-level-let is not rootlet, and we load some file into rootlet
+ ;; that (for example) defines a function at its top level, that function's definition
+ ;; env is rootlet. If we then define something in the repl, it is in the
+ ;; repl's top level. If we now call the function asking is the new thing defined,
+ ;; it looks in rootlet, not the repl top-level, and says no.
+ ;; so, locally redefine these three to use the repl top-level while we're in the repl.
+ ;; in addition, for each of these, we need to report missing close parens and so on
+
+ (define (repl-hooks)
+ (set! (hook-functions *missing-close-paren-hook*) (cons badexpr old-badexpr-hook))
+ (set! (hook-functions *unbound-variable-hook*) (cons shell? old-unbound-var-hook)))
+
+ (define (original-hooks)
+ (set! unbound-case #f)
+ (set! (hook-functions *missing-close-paren-hook*) old-badexpr-hook)
+ (set! (hook-functions *unbound-variable-hook*) old-unbound-var-hook))
+
+ (define new-load (let ((documentation "this is the repl's load replacement; its default is to use the repl's top-level-let.")
+ (signature '(values string? let?)))
+ (lambda* (file (e (*repl* 'top-level-let)))
+ (dynamic-wind original-hooks (lambda () (load file e)) repl-hooks))))
+
+ (define new-eval (let ((documentation "this is the repl's eval replacement; its default is to use the repl's top-level-let.")
+ (signature '(values list? let?)))
+ (lambda* (form (e (*repl* 'top-level-let)))
+ (dynamic-wind original-hooks (lambda () (eval form e)) repl-hooks))))
+
+ (define new-eval-string (let ((documentation "this is the repl's eval-string replacement; its default is to use the repl's top-level-let.")
+ (signature '(values string? let?)))
+ (lambda* (str (e (*repl* 'top-level-let)))
+ (dynamic-wind original-hooks (lambda () (eval-string str e)) repl-hooks))))
+ (dynamic-wind
+ (lambda ()
+ (repl-hooks)
+ (set! eval new-eval)
+ (set! eval-string new-eval-string)
+ (set! load new-load))
+ body
+ (lambda ()
+ (set! eval old-eval)
+ (set! eval-string old-eval-string)
+ (set! load old-load)
+ (original-hooks)))))
+
+
+ ;; -------- match parens --------
+ (define (char-constant? pos)
+ (and (> pos 2)
+ (char=? (cur-line (- pos 1)) #\\)
+ (char=? (cur-line (- pos 2)) #\#)))
+
+ (define (check-parens)
+ (let ((endpos (- cursor-pos 1)))
+ (if (and (> cursor-pos 1)
+ (char=? (cur-line endpos) #\)) ; ")" on left of cursor
+ (not (char-constant? endpos))) ; it's not "#\)"
+ (let ((oparens ())
+ (new-red-pos #f))
+ (do ((i 0 (+ i 1)))
+ ((>= i endpos))
+ (case (cur-line i)
+ ((#\()
+ (set! oparens (cons i oparens)))
+
+ ((#\))
+ (if (pair? oparens)
+ (set! oparens (cdr oparens))))
+
+ ((#\;)
+ (do ((k (+ i 1) (+ k 1)))
+ ((or (>= k endpos)
+ (char=? (cur-line k) #\newline))
+ (set! i k)
+ (if (>= i endpos) ; (f1 "(+ 1 3) should not show first paren as a match (similarly below)
+ (set! oparens ())))))
+
+ ((#\")
+ (do ((k (+ i 1) (+ k 1)))
+ ((or (>= k endpos)
+ (and (char=? (cur-line k) #\")
+ (not (char=? (cur-line (- k 1)) #\\))))
+ (set! i k)
+ (if (>= i endpos)
+ (set! oparens ())))))
+
+ ((#\#)
+ (if (char=? (cur-line (+ i 1)) #\|)
+ (do ((k (+ i 1) (+ k 1)))
+ ((or (>= k endpos)
+ (and (char=? (cur-line k) #\|)
+ (char=? (cur-line (+ k 1)) #\#)))
+ (set! i (+ k 1))
+ (if (>= i endpos)
+ (set! oparens ()))))))))
+
+ (if (pair? oparens)
+ (set! new-red-pos (car oparens)))
+ (unless (equal? new-red-pos red-par-pos)
+ (if (number? new-red-pos)
+ (set! red-par-pos new-red-pos)
+ (set! red-par-pos #f))))
+ (if (number? red-par-pos)
+ (set! red-par-pos #f)))))
+
+
+ ;; -------- indentation --------
+ (define (indent pos)
+ (let ((old-red red-par-pos)
+ (old-line (copy cur-line))
+ (old-cursor cursor-pos))
+ (set! cur-line (string-append (substring cur-line 0 cursor-pos) ")"))
+ (set! cursor-pos (length cur-line))
+ (check-parens)
+ (set! cur-line old-line)
+ (set! cursor-pos old-cursor)
+ (let ((new-red red-par-pos))
+ (set! red-par-pos old-red)
+ (let ((col 0))
+ (do ((i 0 (+ i 1)))
+ ((= i new-red))
+ (if (char=? (cur-line i) #\newline)
+ (set! col 0)
+ (set! col (+ col 1))))
+ (let ((sym (do ((i (+ new-red 1) (+ i 1)))
+ ((not (char-alphabetic? (cur-line i)))
+ (substring cur-line (+ new-red 1) i)))))
+
+ (let ((spaces (+ col (if (member sym '("or" "and" "cond" "if"))
+ (+ (length sym) 2)
+ 2))))
+ (if (= cursor-pos (length cur-line))
+ (begin
+ (set! cur-line (format #f "~A~NC" cur-line spaces #\space))
+ (set! cursor-pos (length cur-line)))
+ (begin
+ (set! cur-line (format #f "~A~NC~A"
+ (substring cur-line 0 cursor-pos)
+ spaces #\space
+ (substring cur-line (+ cursor-pos 1))))
+ (set! cursor-pos (+ cursor-pos spaces))))))))))
+
+
+ ;; -------- prompt --------
+ (define (original-prompt num)
+ (set! prompt-string (format #f "<~D> " num))
+ (set! prompt-length (length prompt-string)))
+
+
+ ;; -------- vt100 --------
+ (define (bold text) (format #f "~C[1m~A~C[0m" #\escape text #\escape))
+ (define (red text) (format #f "~C[31m~A~C[0m" #\escape text #\escape)) ; black=30, green=32, yellow=33, blue=34
+
+ (define* (rgb text (r 0) (g 0) (b 0) all-colors)
+ (if all-colors
+ (format #f "~C[38;5;~Dm~A~C[0m" #\escape (+ 16 (* 36 (round (* r 5))) (* 6 (round (* g 5))) (round (* b 5))) text #\escape)
+ (format #f "~C[~Dm~A~C[0m" #\escape (+ 30 (ash (round b) 2) (ash (round g) 1) (round r)) text #\escape)))
+
+ (define (move-cursor y x)
+ (format *stderr* "~C[~D;~DH" #\escape y x))
+
+ (define (cursor-coords)
+ (let* ((c (string #\null #\null))
+ (cc (string->c-pointer c))
+ (terminal-fd (fileno stdin)))
+ (format *stderr* "~C[6n" #\escape)
+ (do ((b (read terminal-fd cc 1) (read terminal-fd cc 1)))
+ ((char=? (c 0) #\escape)))
+ (read terminal-fd cc 1)
+ (and (char=? (c 0) #\[)
+ (let ((y 0)
+ (x 0))
+ (do ((b (read terminal-fd cc 1) (read terminal-fd cc 1)))
+ ((not (char-numeric? (c 0))))
+ (set! y (+ (* 10 y) (- (char->integer (c 0)) (char->integer #\0)))))
+ (and (char=? (c 0) #\;)
+ (do ((b (read terminal-fd cc 1) (read terminal-fd cc 1)))
+ ((not (char-numeric? (c 0)))
+ (and (char=? (c 0) #\R)
+ (cons x y)))
+ (set! x (+ (* 10 x) (- (char->integer (c 0)) (char->integer #\0))))))))))
+
+ (define (cursor-bounds)
+ (let ((coords (cursor-coords)))
+ (set! prompt-col (car coords))
+ (set! prompt-row (cdr coords))
+ (move-cursor 4000 4000)
+ (let ((bounds (cursor-coords)))
+ (move-cursor (cdr coords) (car coords))
+ (set! last-col (car bounds))
+ (set! last-row (cdr bounds)))))
+
+ ;; to enable mouse click coords (in xterm anyway), (format *stderr* "~C[?9h" #\escape)
+ ;; disable: (format *stderr* "~C[?9l" #\escape)
+ ;; while enabled, mouse selection instead sends coords to repl (so it's annoying)
+ ;; also it's sticky! exit repl does not clear this flag so mouse is effectively dead
+ ;; upon click, we get ESC [ M bxy -- need to poll for this?
+
+
+ ;; -------- display --------
+ (define (display-prompt)
+ (format *stderr* "~A" prompt-string))
+
+ (define (new-prompt)
+ (set! cur-line "")
+ (set! cursor-pos 0)
+ (set! cur-row 0)
+ (set! prev-line ())
+ ((*repl* 'prompt) (+ (length histtop) 1))
+ (display-prompt)
+ (cursor-bounds))
+
+ (define (display-line start end)
+
+ ;; if a line wraps, it will confuse the redisplay/cursor positioning code. so truncate the display
+ (let ((line-len (+ (- end start) 1 prompt-length)))
+ (if (>= line-len last-col)
+ (set! end (- end (- line-len last-col)))))
+
+ (if (and red-par-pos
+ (<= start red-par-pos)
+ (< red-par-pos end))
+ (string-append
+ (if (zero? start)
+ (format #f "~A" prompt-string)
+ (format #f "~NC" prompt-length #\space))
+ (if (= start red-par-pos)
+ (format #f "~A~A"
+ (bold (red "("))
+ (substring cur-line (+ start 1) end))
+ (format #f "~A~A~A"
+ (substring cur-line start red-par-pos)
+ (bold (red "("))
+ (substring cur-line (+ red-par-pos 1) end))))
+ (if (zero? start)
+ (format #f "~A~A" prompt-string (substring cur-line 0 end))
+ (format #f "~NC~A" prompt-length #\space (substring cur-line start end)))))
+
+ (define (display-cursor)
+ (let ((row 0)
+ (start 0)
+ (len (length cur-line)))
+ (do ((i 0 (+ i 1)))
+ ((or (= i len)
+ (= i cursor-pos))
+ (move-cursor (+ prompt-row row) (+ prompt-col (- cursor-pos start))))
+ (when (char=? (cur-line i) #\newline)
+ (set! row (+ row 1))
+ (set! start (+ i 1))))))
+
+ (define (display-lines)
+ (move-cursor prompt-row 0)
+ (format *stderr* "~C[J" #\escape)
+ (let ((len (length cur-line))
+ (new-line ""))
+ (let ((line-end 0))
+ (do ((i 0 (+ line-end 2)))
+ ((> i len))
+ (set! line-end (end-of-line i))
+ (set! new-line (string-append new-line (display-line i (min (+ line-end 2) len))))))
+ (format *stderr* "~A" new-line)
+ (display-cursor)))
+
+
+ ;; -------- help/debugging --------
+ (define (one-line text)
+ (if (string? text)
+ (let ((ntext (copy text)))
+ (do ((i 0 (+ i 1)))
+ ((= i (length ntext))
+ ntext)
+ (if (char=? (ntext i) #\newline) (set! (ntext i) #\|))))
+ text))
+
+ (define (help c)
+ (when (pair? (*repl* 'helpers))
+ (let ((coords (cursor-coords))
+ (col (floor (/ last-col 2))))
+ (move-cursor 1 col)
+ (format *stderr* "+~NC" (- col 2) #\-)
+
+ (do ((i 2 (+ i 1)) ; put box in top right corner so we don't get trailing output as we scroll
+ (lst (*repl* 'helpers) (cdr lst)))
+ ((null? lst))
+ (let ((str ((car lst) c)))
+ (move-cursor i col)
+ (format *stderr* "~C[K| ~A" #\escape (if (> (length str) col) (substring str 0 (- col 1)) str))))
+
+ (move-cursor (+ 2 (length (*repl* 'helpers))) col)
+ (format *stderr* "+~NC" (- col 2) #\-)
+ (move-cursor (cdr coords) (car coords)))))
+
+ (define (debug-help)
+ (set! (*repl* 'helpers)
+ (list
+ (lambda (c)
+ (format #f "cursor: ~A, ~C, line: ~S"
+ cursor-pos
+ (if (> (length cur-line) 0)
+ (let ((c (cur-line (max 0 (min cursor-pos (- (length cur-line) 1))))))
+ (if (char=? c #\newline) #\| c))
+ #\space)
+ (one-line cur-line)))
+ (lambda (c)
+ (format #f "len: ~D, selection: ~S, previous: ~S"
+ (length cur-line)
+ (one-line selection)
+ (if (pair? prev-line) (one-line (cdar prev-line)) ())))
+ (lambda (c)
+ (format #f "cur-row: ~A, prompt-row: ~A"
+ cur-row
+ prompt-row))
+ (lambda (c)
+ (format #f "c: ~S ~D, start: ~A, end: ~A"
+ (object->string c #t)
+ (char->integer c)
+ (start-of-line cursor-pos)
+ (end-of-line cursor-pos))))))
+
+
+ ;; -------- keymap(s) --------
+ (define meta-keymap-functions (make-vector 256))
+ (define keymap-functions (make-vector 256 #f))
+
+ (define keymap (dilambda
+ (lambda (c)
+ (cond ((char? c)
+ (keymap-functions (char->integer c)))
+ ((integer? c)
+ (keymap-functions c))
+ ((string? c)
+ (if (= (length c) 1)
+ (keymap-functions (char->integer (c 0)))
+ (if (and (= (length c) 2)
+ (char=? (c 0) #\escape))
+ (meta-keymap-functions (char->integer (c 1)))
+ (lambda (c) #t))))
+ (else (error 'wrong-type-arg "keymap takes a character or string argument"))))
+
+ (lambda (c f)
+ (cond ((char? c)
+ (set! (keymap-functions (char->integer c)) f))
+ ((integer? c)
+ (set! (keymap-functions c) f))
+ ((string? c)
+ (if (= (length c) 1)
+ (set! (keymap-functions (char->integer (c 0))) f)
+ (if (and (= (length c) 2)
+ (char=? (c 0) #\escape))
+ (set! (meta-keymap-functions (char->integer (c 1))) f))))
+ (else (error 'wrong-type-arg "set! keymap takes a character or string first argument"))))))
+
+ (define C-a 1) ; #\x01 etc
+ (define C-b 2)
+ (define C-d 4)
+ (define C-e 5)
+ (define C-f 6)
+ (define C-h 8)
+ (define C-k 11)
+ (define C-l 12)
+ ;(define C-m 13) ; #\return -- Enter handles this case (crlf?)
+ (define C-n 14)
+ (define C-o 15)
+ (define C-p 16)
+ ;(define C-r 18)
+ (define C-t 20)
+ (define C-y 25)
+ (define C-_ 31)
+ (define Tab 9)
+ (define Enter 10) ; #\linefeed
+ (define Backspace 127)
+ (define Escape 27) ; #\escape
+
+ (define (end-of-line pos) ; prompt or #\newline mark the line boundary
+ (let ((len (length cur-line)))
+ (do ((i (max 0 (min pos len)) (+ i 1)))
+ ((or (>= i len)
+ (char=? (cur-line i) #\newline))
+ (if (>= i len) len (max 0 (- i 1)))))))
+
+ (define (start-of-line pos)
+ (if (<= pos 0)
+ 0
+ (do ((i (min pos (- (length cur-line) 1)) (- i 1)))
+ ((or (zero? i)
+ (char=? (cur-line i) #\newline))
+ (if (zero? i) 0 (+ i 1))))))
+
+ (define (count-newlines line)
+ (let ((len (length line))
+ (newlines 0))
+ (do ((i 0 (+ i 1)))
+ ((= i len) newlines)
+ (if (char=? (cur-line i) #\newline)
+ (set! newlines (+ newlines 1))))))
+
+ (define (append-newline)
+ (set! cur-line (string-append cur-line (string #\space #\newline)))
+ (set! cursor-pos (length cur-line))
+ (when (= last-row (+ prompt-row cur-row))
+ (format *stderr* "~%")
+ (set! prompt-row (- prompt-row 1)))
+ (set! cur-row (+ cur-row 1)))
+
+ (define (word-break pos) ; assume we're at the start of a word
+ (let ((len (length cur-line)))
+ (let loop ((i pos))
+ (if (or (>= i len)
+ (not (or (char-alphabetic? (cur-line i))
+ (char-numeric? (cur-line i)))))
+ i
+ (loop (+ i 1))))))
+
+ (define (save-line)
+ (set! prev-line (cons (cons cursor-pos (copy cur-line)) prev-line)))
+
+ (let ((main-keyfunc (lambda (c)
+ (if (<= chars 1) (save-line))
+ (if (= cursor-pos (length cur-line))
+ (set! cur-line (string-append cur-line (string c)))
+ (if (= cursor-pos 0)
+ (set! cur-line (string-append (string c) cur-line))
+ (set! cur-line (string-append
+ (substring cur-line 0 cursor-pos)
+ (string c)
+ (substring cur-line cursor-pos)))))
+ (set! cursor-pos (+ cursor-pos 1))
+ (set! m-p-pos 0)))
+ (no-op-keyfunc (lambda (c) #t)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 32))
+ (set! (keymap-functions i) no-op-keyfunc))
+
+ (do ((i 32 (+ i 1)))
+ ((= i 256))
+ (set! (keymap-functions i) main-keyfunc))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (set! (meta-keymap-functions i) no-op-keyfunc)))
+
+
+ ;; -------- cursor movement
+ (set! (keymap-functions C-a)
+ (lambda (c)
+ (set! cursor-pos (start-of-line cursor-pos))
+ 'just-cursor))
+
+ (set! (keymap-functions C-e)
+ (lambda (c)
+ (set! cursor-pos (end-of-line cursor-pos))
+ 'just-cursor))
+
+ (set! (keymap-functions C-b)
+ (lambda (c)
+ (when (> cursor-pos 0)
+ (set! cursor-pos (- cursor-pos 1))
+ (if (char=? (cur-line cursor-pos) #\newline)
+ (set! cursor-pos (- cursor-pos 1))))
+ 'just-cursor))
+
+ (set! (keymap-functions C-f)
+ (lambda (c)
+ (let ((len (length cur-line)))
+ (when (< cursor-pos len)
+ (set! cursor-pos (+ cursor-pos 1))
+ (if (and (< cursor-pos len)
+ (char=? (cur-line cursor-pos) #\newline))
+ (set! cursor-pos (+ cursor-pos 1)))))
+ 'just-cursor))
+
+ (set! (keymap-functions C-p)
+ (lambda (c)
+ ;; try to find corresponding column in previous line
+ (let ((start (start-of-line cursor-pos)))
+ (when (positive? start)
+ (let ((upstart (start-of-line (- start 2)))
+ (upend (end-of-line (- start 2)))
+ (line-pos (- cursor-pos start)))
+ (set! cursor-pos (min (+ upstart line-pos) upend)))))
+ 'just-cursor))
+
+ (set! (keymap-functions C-n)
+ (lambda (c)
+ ;; try to find corresponding column in next line
+ (let ((start (start-of-line cursor-pos))
+ (len (length cur-line))
+ (next-start (+ (end-of-line cursor-pos) 1))) ; should be at #\newline (if any)
+ (if (> len next-start) ; not already at last line
+ (let ((next-end (end-of-line (+ next-start 1)))
+ (line-pos (- cursor-pos start)))
+ (set! cursor-pos (min (+ next-start 1 line-pos) next-end)))))
+ 'just-cursor))
+
+ (set! (keymap-functions C-l)
+ (lambda (c)
+ (format *stderr* "~C[H~C[J" #\escape #\escape)
+ (new-prompt)))
+
+ ;; -------- deletion
+ (set! (keymap-functions C-d)
+ (lambda (c)
+ (let ((len (length cur-line)))
+ (when (< cursor-pos len)
+ (save-line)
+ (do ((i cursor-pos (+ i 1)))
+ ((>= i (- len 1)))
+ (set! (cur-line i) (cur-line (+ i 1))))
+ (set! cur-line (substring cur-line 0 (- len 1)))))))
+
+ (set! (keymap-functions C-h)
+ (lambda (c)
+ (when (positive? cursor-pos)
+ (save-line)
+ (let ((len (length cur-line)))
+ (set! cursor-pos (- cursor-pos 1))
+ (do ((i cursor-pos (+ i 1)))
+ ((>= i (- len 1)))
+ (set! (cur-line i) (cur-line (+ i 1))))
+ (set! cur-line (substring cur-line 0 (- len 1)))))))
+
+ (set! (keymap-functions Backspace)
+ (keymap-functions C-h))
+
+ (set! (keymap-functions C-k)
+ (lambda (c)
+ (let ((len (length cur-line)))
+ (when (< cursor-pos len)
+ (save-line)
+ (let ((end (end-of-line cursor-pos)))
+ (if (= end len)
+ (begin
+ (set! selection (substring cur-line cursor-pos))
+ (set! cur-line (substring cur-line 0 cursor-pos)))
+ (if (or (= cursor-pos end) ; delete following newline
+ (char=? (cur-line cursor-pos) #\newline))
+ (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+ (substring cur-line (+ cursor-pos 1))))
+ (begin
+ (set! selection (substring cur-line cursor-pos (+ end 1)))
+ (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+ (substring cur-line (+ end 1))))
+ ))))))))
+
+ ;; -------- undo/selection
+ (set! (keymap-functions C-y)
+ (lambda (c)
+ (when selection
+ (save-line)
+ (if (zero? cursor-pos)
+ (set! cur-line (string-append selection cur-line))
+ (if (>= cursor-pos (length cur-line))
+ (set! cur-line (string-append cur-line selection))
+ (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+ selection
+ (substring cur-line cursor-pos)))))
+ (set! cursor-pos (+ cursor-pos (length selection))))))
+
+ (set! (keymap-functions C-_)
+ (lambda (c)
+ (when (pair? prev-line)
+ (set! cur-line (cdar prev-line))
+ (set! cursor-pos (caar prev-line))
+ (set! prev-line (cdr prev-line)))))
+
+ ;; -------- add newline
+ (set! (keymap-functions C-o)
+ (lambda (c)
+ (if (= cursor-pos 0)
+ (set! cur-line (string-append (string #\space #\newline) cur-line))
+ (if (>= cursor-pos (length cur-line))
+ (set! cur-line (string-append cur-line (string #\space #\newline)))
+ (if (char=? (cur-line (- cursor-pos 1)) #\newline)
+ (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+ (string #\space #\newline)
+ (substring cur-line cursor-pos)))
+ (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+ (if (char=? (cur-line (+ cursor-pos 1)) #\newline)
+ (string #\space #\newline #\space)
+ (string #\space #\newline))
+ (substring cur-line (+ cursor-pos 1)))))))
+ (when (= last-row (+ prompt-row cur-row))
+ (set! prompt-row (- prompt-row 1))
+ (display-lines))))
+
+ ;; -------- transpose
+ (set! (keymap-functions C-t)
+ (lambda (c)
+ (let ((end (end-of-line cursor-pos)))
+ (save-line)
+ (let ((cur (if (>= cursor-pos end)
+ (- cursor-pos 1)
+ cursor-pos)))
+ (if (positive? cur)
+ (let ((tmp-c (cur-line (- cur 1))))
+ (set! (cur-line (- cur 1)) (cur-line cur))
+ (set! (cur-line cur) tmp-c)
+ (set! cursor-pos (+ cur 1))))))))
+
+ ;; -------- indentation/completion
+ (set! (keymap-functions Tab)
+ (lambda (c)
+ ;; if user pastes in a selection, it may have embedded tabs which are just spacing,
+ ;; not requests for filename completion! We'll try to catch this case by assuming
+ ;; that a selection will not be the single character #\tab
+ (if (> chars 1)
+ (begin
+ (set! cur-line (string-append cur-line " "))
+ (set! cursor-pos (+ cursor-pos 4)))
+ (let ((start (start-of-line cursor-pos))
+ (end (end-of-line cursor-pos))
+ (completion #f))
+ (if (and (positive? start)
+ (= end start))
+ (indent start)
+ (if (= cursor-pos end)
+ (let ((loc (do ((i (- end 1) (- i 1)))
+ ((or (< i 0)
+ (char-whitespace? (cur-line i))
+ (member (cur-line i) '(#\( #\' #\" #\)) eqv?))
+ i))))
+ (if (< loc 0)
+ (set! completion (symbol-completion cur-line))
+ (if (char=? (cur-line loc) #\")
+ (set! completion (filename-completion (substring cur-line (+ loc 1))))
+ (set! completion (symbol-completion (substring cur-line (+ loc 1))))))
+ (when (and completion
+ (> (length completion) (- end loc 1)))
+ (save-line)
+ (if (= end (length cur-line))
+ (set! cur-line (string-append (substring cur-line 0 (+ loc 1)) completion))
+ (set! cur-line (string-append (substring cur-line 0 (+ loc 1))
+ completion
+ (substring cur-line (+ end 1)))))
+ (set! cursor-pos (end-of-line cursor-pos))))))))))
+
+ ;; -------- evaluation/multiline
+ (set! (keymap-functions Enter)
+ (lambda (c)
+
+ (call-with-exit
+ (lambda (return)
+ (let ((len (length cur-line)))
+
+ (do ((i 0 (+ i 1))) ; check for just whitespace
+ ((or (= i len)
+ (not (char-whitespace? (cur-line i))))
+ (when (= i len)
+ (append-newline)
+ (return))))
+
+ (set! red-par-pos #f)
+ (if (or (= chars 1)
+ (not (= input-fd terminal-fd)))
+ (display-lines))
+
+ (catch #t
+ (lambda ()
+
+ ;; we want to add cur-line (copied) to the history buffer
+ ;; unless it is an on-going edit (missing close paren)
+ (catch 'string-read-error
+
+ (lambda ()
+ (set! cursor-pos len)
+ (if (or (= chars 1)
+ (not (= input-fd terminal-fd)))
+ (display-lines))
+ (set! (history) (copy cur-line))
+ (set! m-p-pos 0)
+
+ (with-repl-let
+ (lambda ()
+ ;; get the newline out if the expression does not involve a read error
+ (let ((form (with-input-from-string cur-line #_read))) ; not libc's read
+ (newline *stderr*)
+ (let ((val (eval form (*repl* 'top-level-let))))
+ (if unbound-case
+ (set! unbound-case #f)
+ (begin
+ (format *stderr* "~S~%" val)
+ (set! ((*repl* 'top-level-let) '**) val))))))))
+
+ (lambda (type info)
+ (pop-history) ; remove last history entry
+ (append-newline)
+ (return))))
+
+ (lambda (type info)
+ (format *stderr* "~A: " (red "error"))
+ (apply format *stderr* info)
+ (newline *stderr*)))
+
+ (push-line (copy cur-line))
+ (new-prompt))))))
+
+ ;; -------- escaped (Meta/Alt/arrow) keys
+ (set! (keymap-functions Escape)
+ (lambda (esc)
+ (let ((chr (next-char)))
+ ((meta-keymap-functions (char->integer chr)) chr))))
+
+ (set! (meta-keymap-functions (char->integer #\[))
+ (lambda (c)
+ (let ((chr (next-char)))
+ (case chr
+ ((#\A) ((keymap-functions C-p) C-p)) ; arrow keys
+ ((#\B) ((keymap-functions C-n) C-n))
+ ((#\C) ((keymap-functions C-f) C-f))
+ ((#\D) ((keymap-functions C-b) C-b))))))
+
+ (let ()
+ ;; Meta key is a problem on the Mac, so I'll package these for easier disposal
+
+ (define (fixup-new-line)
+ (set! cursor-pos (length cur-line))
+ (let ((newlines (count-newlines cur-line)))
+ (when (< last-row (+ prompt-row newlines))
+ (format *stderr* "~NC" (- (+ prompt-row newlines) last-row) #\newline)
+ (set! prompt-row (- prompt-row newlines)))
+ (set! cur-row newlines)))
+
+ (define (get-previous-line c) ; get earlier line indexed by numeric arg
+ (let ((len (length histtop)))
+ (let ((pos (or (string->number cur-line) len)))
+ (set! pos (min len (max pos 1)))
+ (set! cur-line (histtop (- pos 1)))
+ (fixup-new-line))))
+
+ (define (move-forward-in-history c)
+ (set! m-p-pos (min 0 (+ m-p-pos 1)))
+ (when (positive? (length (history m-p-pos)))
+ (set! cur-line (history m-p-pos))
+ (fixup-new-line)))
+
+ (define (move-backward-in-history c)
+ (let ((old-index m-p-pos))
+ (when (and (zero? m-p-pos)
+ (> (length cur-line) 0))
+ (set! (history) cur-line)
+ (set! m-p-pos -1))
+ (set! m-p-pos (max (- m-p-pos 1) (- histsize)))
+ (if (positive? (length (history m-p-pos)))
+ (begin
+ (set! cur-line (history m-p-pos))
+ (fixup-new-line))
+ (set! m-p-pos old-index))))
+
+ (define (go-to-start c)
+ (set! cursor-pos 0)
+ 'just-cursor)
+
+ (define (go-to-end c)
+ (set! cursor-pos (length cur-line))
+ 'just-cursor)
+
+ (define (capitalize c)
+ (let ((len (length cur-line)))
+ (let loop ((i cursor-pos))
+ (if (< i len)
+ (if (char-alphabetic? (cur-line i))
+ (begin
+ (save-line)
+ (set! (cur-line i) (char-upcase (cur-line i)))
+ (set! cursor-pos (word-break i)))
+ (loop (+ i 1)))))))
+
+ (define (upper-case c)
+ (let ((len (length cur-line)))
+ (do ((i cursor-pos (+ i 1)))
+ ((or (= i len)
+ (char-alphabetic? (cur-line i)))
+ (when (< i len)
+ (save-line)
+ (do ((k i (+ k 1)))
+ ((or (= k len)
+ (not (char-alphabetic? (cur-line k))))
+ (set! cursor-pos k))
+ (set! (cur-line k) (char-upcase (cur-line k)))))))))
+
+ (define (lower-case c)
+ (let ((len (length cur-line)))
+ (do ((i cursor-pos (+ i 1)))
+ ((or (= i len)
+ (char-alphabetic? (cur-line i)))
+ (when (< i len)
+ (save-line)
+ (do ((k i (+ k 1)))
+ ((or (= k len)
+ (not (char-alphabetic? (cur-line k))))
+ (set! cursor-pos k))
+ (set! (cur-line k) (char-downcase (cur-line k)))))))))
+
+ (set! (meta-keymap-functions (char->integer #\p)) move-backward-in-history)
+ (set! (meta-keymap-functions (char->integer #\n)) move-forward-in-history)
+ (set! (meta-keymap-functions (char->integer #\.)) get-previous-line)
+ (set! (meta-keymap-functions (char->integer #\<)) go-to-start)
+ (set! (meta-keymap-functions (char->integer #\>)) go-to-end)
+ (set! (meta-keymap-functions (char->integer #\c)) capitalize)
+ (set! (meta-keymap-functions (char->integer #\u)) upper-case)
+ (set! (meta-keymap-functions (char->integer #\l)) lower-case)
+ )
+
+ ;; -------- terminal setup --------
+ (define* (run file)
+ (let ((saved #f)
+ (tty #t))
+
+ ;; we're in libc here, so exit is libc's exit!
+ (define (tty-reset no)
+ (if tty (tcsetattr terminal-fd TCSAFLUSH saved))
+ (if (not (equal? input-fd terminal-fd)) (close input-fd))
+ (#_exit))
+
+ (varlet (*repl* 'top-level-let)
+ :exit (let ((documentation "(exit) resets the repl tty and exits the repl"))
+ (lambda ()
+ (newline *stderr*)
+ (tty-reset 0))))
+
+ ;; check for dumb terminal
+ (if (or (zero? (isatty terminal-fd)) ; not a terminal -- input from pipe probably
+ (string=? (getenv "TERM") "dumb")) ; no vt100 codes -- emacs shell for example
+ (let ((buf (c-pointer->string (calloc 512 1) 512)))
+ (set! tty #f)
+ (format *stderr* "> ")
+ (do ((b (fgets buf 512 stdin) (fgets buf 512 stdin)))
+ ((zero? (length b))
+ (#_exit))
+ (let ((len (strlen buf)))
+ (when (positive? len)
+ (do ((i 0 (+ i 1)))
+ ((or (not (char-whitespace? (buf i)))
+ (= i len))
+ (when (< i len)
+ (with-repl-let
+ (lambda ()
+ (catch #t
+ (lambda ()
+ (format *stderr* "~S~%" (eval-string (substring buf 0 (- (strlen buf) 1)) (*repl* 'top-level-let))))
+ (lambda (type info)
+ (format *stderr* "error: ")
+ (apply format *stderr* info)
+ (newline *stderr*)))))
+ (format *stderr* "> ")))))))))
+
+ ;; not a pipe or a dumb terminal -- hopefully all others accept vt100 codes
+ (let ((buf (termios.make))
+ (read-size 128))
+
+ (set! next-char ; this indirection is needed if user pastes the selection into the repl
+ (let* ((c (make-string read-size #\null))
+ (cc (string->c-pointer c))
+ (ctr 0))
+ (lambda ()
+ (call-with-exit
+ (lambda (return)
+ (when (>= ctr chars)
+ (set! ctr 0)
+ (set! chars (read input-fd cc read-size))
+ (if (= chars 0)
+ (tty-reset terminal-fd))
+
+ (when (= chars read-size)
+ ;; concatenate buffers until we get the entire selection
+ (let ((str (substring c 0 read-size)))
+ (let reading ((num (read input-fd cc read-size)))
+ (set! str (string-append str (substring c 0 num)))
+ (set! chars (+ chars num))
+ (if (= num read-size)
+ (reading (read input-fd cc read-size))))
+
+ ;; look for simple cut/paste -- no control chars etc
+ (when (= input-fd terminal-fd)
+ (let ((bcksp (integer->char 127))
+ (ok-chars (list #\newline #\linefeed #\return #\tab)))
+ (do ((i 0 (+ i 1)))
+ ((or (= i chars)
+ (char>=? (str i) bcksp)
+ (and (char<? (str i) #\space)
+ (not (member (str i) ok-chars eq?))))
+
+ (when (= i chars)
+ (let ((search-chars (string #\tab #\return #\newline))
+ (old-pos 0)
+ (start 0)
+ (max-cols 0))
+ (do ((pos (char-position search-chars str 0) (char-position search-chars str (+ pos 1))))
+ ((not pos))
+ (set! cur-line (string-append cur-line
+ (substring str old-pos pos)
+ (if (char=? (str pos) #\tab)
+ tab-as-space
+ (string #\space #\newline))))
+ (set! old-pos (+ pos 1))
+ (unless (char=? (str pos) #\tab)
+ (set! max-cols (max max-cols (- pos start)))
+ (set! start pos)))
+ (if (< (+ old-pos 1) (length str))
+ (set! cur-line (string-append cur-line (substring str (+ old-pos 1)))))
+
+ ;; if the line is too long, the cursor gets confused, so try to reformat over-long strings
+ ;; this still messes up sometimes
+
+ (when (> max-cols (- last-col prompt-length))
+ (let ((old-len ((funclet pretty-print) '*pretty-print-length*)))
+ (set! ((funclet pretty-print) '*pretty-print-length*) (- last-col prompt-length 2))
+ (set! cur-line (with-output-to-string
+ (lambda ()
+ (pretty-print (with-input-from-string cur-line #_read)))))
+ (set! ((funclet pretty-print) '*pretty-print-length*) old-len)))
+
+ (set! cursor-pos (length cur-line))
+ (set! chars 0)
+ (set! ctr 1)
+ (display-lines)
+ (return #\newline)))))))
+
+ (set! c str)
+ (set! cc (string->c-pointer c))
+ ;; avoid time-consuming redisplays. We need to use a recursive call on next-char here
+ ;; since we might have multi-char commands (embedded #\escape -> meta, etc)
+ ;; actually, the time is not the repl's fault -- xterm seems to be waiting
+ ;; for the window manager or someone to poke it -- if I move the mouse,
+ ;; I get immediate output. I also get immediate output in any case in OSX.
+ ;; valgrind and ps say we're not computing, we're just sitting there.
+ (catch #t
+ (lambda ()
+ (do ((ch (next-char) (next-char)))
+ ((= ctr (- chars 1))
+ (set! chars 0)
+ (display-lines)
+ (return ch))
+ ((keymap-functions (char->integer ch)) ch)))
+
+ (lambda (type info)
+ (set! chars 0)
+ (move-cursor prompt-row prompt-col)
+ (format *stderr* "internal error: ")
+ (apply format *stderr* info)
+ (newline *stderr*)
+ (format *stderr* "line ~A: ~A~%" ((owlet) 'error-line) ((owlet) 'error-code))
+ (set! chars 0)
+ (set! ctr 0)
+ (new-prompt)
+ (return #\null))))))
+
+ (let ((result (c ctr)))
+ (set! ctr (+ ctr 1))
+ result))))))
+
+ (set! input-fd (if (not file)
+ terminal-fd
+ (open file O_RDONLY 0)))
+
+ (set! saved (termios.make))
+ (tcgetattr terminal-fd saved)
+
+ (tcgetattr terminal-fd buf)
+ (termios.set_c_lflag buf (logand (termios.c_lflag buf) (lognot (logior ECHO ICANON))))
+ (termios.set_c_cc buf VMIN 1)
+ (termios.set_c_cc buf VTIME 0)
+ (when (negative? (tcsetattr terminal-fd TCSAFLUSH buf))
+ (tty-reset terminal-fd))
+
+
+ ;; -------- the repl --------
+ (display-prompt)
+ (cursor-bounds)
+ ;; (debug-help)
+ ;; (history-help)
+
+ (do ()
+ (all-done
+ (set! all-done #f)) ; clear for next call
+ (catch #t
+ (lambda ()
+ (let ((chr (next-char)))
+ (let ((res ((keymap-functions (char->integer chr)) chr))
+ (last-pos red-par-pos))
+ (check-parens)
+ (if (or last-pos red-par-pos
+ (not (eq? res 'just-cursor)))
+ (display-lines)
+ (display-cursor)))
+ (help chr)))
+
+ (lambda (type info)
+ (move-cursor prompt-row prompt-col)
+ (format *stderr* "internal error: ")
+ (apply format *stderr* info)
+ (format *stderr* "~%line ~A: ~A~%" ((owlet) 'error-line) ((owlet) 'error-code))
+ (set! chars 0)
+ (new-prompt)))))))
+
+ (curlet))))))
+
+ (define (save-repl)
+ (call-with-output-file "save.repl"
+ (lambda (p)
+ (format p "(for-each~%~NC~
+ (lambda (f)~%~NC~
+ (if (not (provided? f))~%~NC~
+ (let ((autofile (*autoload* f)))~%~NC~
+ (if (and autofile (file-exists? autofile))~%~NC(load autofile)))))~%~NC~W)~%~%"
+ 2 #\space 4 #\space 8 #\space 10 #\space 14 #\space 2 #\space
+ *features*)
+ (format p "(with-let (*repl* 'repl-let)~%")
+ (((*repl* 'repl-let) 'write-history) p 2)
+ (format p ")~%~%")
+ (format p "~W" (*repl* 'top-level-let)))))
+
+ (define (restore-repl)
+ (set! (*repl* 'top-level-let) (load "save.repl")))
+ ;; I think this could be a merge rather than a reset by using (with-let top-level-let (load ...))
+
+
+ (set! keymap (repl-let 'keymap))
+ (set! history (repl-let 'history))
+ (set! history-size (repl-let 'history-size))
+ (set! save-history (repl-let 'save-history))
+ (set! restore-history (repl-let 'restore-history))
+ (set! prompt (repl-let 'original-prompt))
+ (set! run (repl-let 'run))
+
+ (curlet))))
+
+;; ((*repl* 'run))
+
+
+;;; --------------------------------------------------------------------------------
+
+(autoload 'lint "lint.scm")
+(autoload 'pretty-print "write.scm")
+(autoload '*libm* "libm.scm")
+(autoload '*libgsl* "libgsl.scm")
+
+#|
+(define pwd
+ (let ((pd (lambda args
+ ((*libc* 'getcwd)
+ (make-string 256 #\null) 256))))
+ (openlet (inlet 'object->string pd ; pwd (repl calls object->string)
+ 'let-ref-fallback pd)))) ; (pwd) (repl calls let-ref-fallback method)
+;; > pwd
+;; /home/bil/cl
+
+(define date
+ (let ((pd (lambda args
+ (with-let (sublet *libc*)
+ (let ((timestr (make-string 128)))
+ (let ((len (strftime timestr 128 "%a %d-%b-%Y %H:%M:%S %Z"
+ (localtime
+ (time.make (time (c-pointer 0)))))))
+ (substring timestr 0 len)))))))
+ (openlet (inlet 'object->string pd 'let-ref-fallback pd))))
+|#
+
+;; cd needs to be implemented
+(define cd
+ (openlet (inlet 'object->string (lambda args
+ (let ((line ((*repl* 'repl-let) 'cur-line)))
+ ((*libc* 'chdir)
+ (do ((i 3 (+ i 1)))
+ ((or (not (char-whitespace? (line i)))
+ (= i (length line)))
+ (substring ((*repl* 'repl-let) 'cur-line) i))))
+ ((*libc* 'getcwd) (make-string 256 #\null) 256)))
+ 'let-ref-fallback (lambda (obj str) ; let-ref-fallback's first arg will be cd: (cd "..")
+ ((*libc* 'chdir) str)
+ ((*libc* 'getcwd) (make-string 256 #\null) 256)))))
+;; > cd ..
+;; /home/bil
+;; > cd cl
+;; /home/bil/cl
+
+#|
+(define-macro (make-command name)
+ `(define ,name
+ (openlet
+ (inlet 'object->string (lambda args
+ (system ((*repl* 'repl-let) 'cur-line) #t))))))
+;; (make-command ls)
+|#
+
+
+(define-macro (time expr)
+ (let ((start (gensym)))
+ `(let ((,start ((*libc* 'gettimeofday))))
+ ,expr
+ (let ((end ((*libc* 'gettimeofday))))
+ (+ (- (car end) (car ,start)) ; seconds
+ (* 0.000001 (- (cadr end) (cadr ,start))))))))
+
+
+(define* (apropos name (e (*repl* 'top-level-let)))
+
+ (define (levenshtein s1 s2)
+ (let ((l1 (length s1))
+ (l2 (length s2)))
+ (cond ((zero? l1) l2)
+ ((zero? l2) l1)
+ (else (let ((distance (make-vector (list (+ l2 1) (+ l1 1)) 0)))
+ (do ((i 0 (+ i 1)))
+ ((> i l1))
+ (set! (distance 0 i) i))
+ (do ((i 0 (+ i 1)))
+ ((> i l2))
+ (set! (distance i 0) i))
+ (do ((i 1 (+ i 1)))
+ ((> i l2))
+ (do ((j 1 (+ j 1)))
+ ((> j l1))
+ (let ((c1 (+ (distance i (- j 1)) 1))
+ (c2 (+ (distance (- i 1) j) 1))
+ (c3 (+ (distance (- i 1) (- j 1))
+ (if (char=? (s2 (- i 1)) (s1 (- j 1))) 0 1))))
+ (set! (distance i j) (min c1 c2 c3)))))
+ (distance l2 l1))))))
+
+ (define* (make-full-let-iterator lt (stop (rootlet))) ; walk the entire let chain
+ (if (eq? stop lt)
+ (make-iterator lt)
+ (letrec ((iterloop
+ (let ((iter (make-iterator lt))
+ (iterator? #t))
+ (lambda ()
+ (let ((result (iter)))
+ (if (and (eof-object? result)
+ (iterator-at-end? iter))
+ (if (eq? stop (iterator-sequence iter))
+ result
+ (begin
+ (set! iter (make-iterator (outlet (iterator-sequence iter))))
+ (iterloop)))
+ result))))))
+ (make-iterator iterloop))))
+
+ (let ((ap-name (if (string? name) name
+ (if (symbol? name) (symbol->string name)
+ (error 'wrong-type-arg "apropos argument 1 should be a string or a symbol"))))
+ (ap-env (if (let? e) e
+ (error 'wrong-type-arg "apropos argument 2 should be an environment"))))
+ (let ((strs ())
+ (min2 (floor (log (length ap-name) 2)))
+ (have-orange (string=? ((*libc* 'getenv) "TERM") "xterm-256color")))
+ (for-each
+ (lambda (binding)
+ (if (pair? binding)
+ (let ((symbol-name (symbol->string (car binding))))
+ (if (string-position ap-name symbol-name)
+ (set! strs (cons (cons binding 0) strs))
+ (let ((distance (levenshtein ap-name symbol-name)))
+ (if (< distance min2)
+ (set! strs (cons (cons binding distance) strs))))))))
+ (make-full-let-iterator ap-env))
+
+ (if (pair? strs)
+ (begin
+ (for-each (lambda (b)
+ (format *stderr*
+ (if (zero? (cdr b)) "~C[1m~A~C[0m: ~S~%" ; black if exact match somewhere
+ (if (or (< (cdr b) 2) (not have-orange)) "~C[31m~A~C[0m: ~S~%" ; red for near miss
+ "~C[38;5;208m~A~C[0m: ~S~%")) ; orange for less likely choices
+ #\escape (caar b) #\escape
+ (if (procedure? (cdar b))
+ (let ((doc (procedure-documentation (cdar b))))
+ (if (and (string? doc)
+ (positive? (length doc)))
+ doc
+ 'procedure))
+ (cdar b))))
+ (sort! strs (lambda (a b)
+ (string<? (symbol->string (caar a)) (symbol->string (caar b))))))
+ '----)
+ 'no-match))))
+
+
+;;; --------------------------------------------------------------------------------
+#|
+to work in a particular environment:
+ (set! (*repl* 'top-level-let) (sublet (rootlet) :** #f)) ; or any other like *libc*
+now (define g 43) puts g in the new top-level-let, so ((rootlet) 'g) -> #<undefined>, and ((*repl* 'top-level-let) 'g) -> 43 (= g in repl of course)
+to start with a fresh top-level, just set top-level-let to (sublet (rootlet)) again.
+
+to add/change keymap entry (using sublet here to protect against inadvertent changes to the repl).
+ (set! ((*repl* 'keymap) (integer->char 17)) ; C-q to quit and return to caller
+ (lambda (c)
+ (set! ((*repl* 'repl-let) 'all-done) #t)))
+
+(set! ((*repl* 'keymap) (integer->char 12)) ; C-l will expand to "(lambda " at the cursor
+ (lambda (c)
+ (with-let (sublet (*repl* 'repl-let))
+ (if (zero? cursor-pos)
+ (set! cur-line (string-append "(lambda " cur-line))
+ (if (>= cursor-pos (length cur-line))
+ (set! cur-line (string-append cur-line "(lambda "))
+ (set! cur-line (string-append (substring cur-line 0 cursor-pos)
+ "(lambda "
+ (substring cur-line cursor-pos)))))
+ (set! cursor-pos (+ cursor-pos (length "(lambda "))))))
+
+change the prompt:
+(set! (*repl* 'prompt) (lambda (num)
+ (with-let (*repl* 'repl-let)
+ (set! prompt-string "scheme> ")
+ (set! prompt-length (length prompt-string)))))
+
+red lambda prompt:
+(set! (*repl* 'prompt)
+ (lambda (num)
+ (with-let (*repl* 'repl-let)
+ (set! prompt-string (bold (red (string #\xce #\xbb #\> #\space))))
+ (set! prompt-length 3)))) ; until we get unicode length calc
+
+
+to post a help string (kinda tedious, but the helper list is aimed more at posting variable values):
+(set! (*repl* 'helpers)
+ (list (lambda (c)
+ (let ((sym (with-let (sublet (*repl* 'repl-let))
+ (let ((len (length cur-line)))
+ (let loop ((i (min (- len 1) cursor-pos)))
+ (and (not (negative? i))
+ (if (char=? (cur-line i) #\()
+ (let loop1 ((k (+ i 1)))
+ (and (< k len)
+ (if (not (char-alphabetic? (cur-line k)))
+ (and (> k (+ i 1))
+ (string->symbol (substring cur-line (+ i 1) k)))
+ (loop1 (+ k 1)))))
+ (loop (- i 1)))))))))
+ (if sym
+ (let ((str (help sym)))
+ (if str
+ (substring (help sym) 0 (min (length str) 40))
+ ""))
+ "")))))
+
+;; function keys:
+(set! ((*repl* 'keymap) (string #\escape #\[))
+ (lambda (c)
+ (with-let (sublet (*repl* 'repl-let))
+ (let ((next (next-char)))
+ (case next
+ ((#\A) ((keymap-functions C-p) C-p))
+ ((#\B) ((keymap-functions C-n) C-n))
+ ((#\C) ((keymap-functions C-f) C-f))
+ ((#\D) ((keymap-functions C-b) C-b))
+ ((#\1) ; on my system F1 is esc [ 1 1 ~, F2 esc [ 1 2 ~, etc (but they skip F6?)
+ (let ((n (- (char->integer (next-char)) (char->integer #\0))))
+ (next-char) ; throw away the tilde
+ (set! cur-line (string-append cur-line (format #f "--F~D!--" n))))))))))
+
+;; this actually works but doesn't echo the filename correctly and the cursor is off during the filename processing
+(set! ((*repl* 'keymap) (integer->char 24)) ; C-x
+ (lambda (c)
+ (with-let (sublet (*repl* 'repl-let))
+ (let ((next (next-char)))
+ (when (char=? next (integer->char 6)) ; C-f
+ (format *stderr* "~%load: ")
+ ;; now recursive call: prompt="load: "
+ (let ((old-prompt (*repl* 'prompt))
+ (old-cur-line cur-line)
+ (old-cursor-pos cursor-pos)
+ (old-enter-func (keymap-functions 10))
+ (filename #f))
+ (set! (*repl 'prompt) (lambda (num)
+ (with-let (*repl* 'repl-let)
+ (set! prompt-string "load: ")
+ (set! prompt-length 6))))
+ (set! cur-line "")
+ (set! cursor-pos 0)
+ (set! (keymap-functions 10) (lambda (c)
+ (set! filename cur-line)
+ (set! (*repl* 'prompt) old-prompt)
+ (set! cur-line old-cur-line)
+ (set! cursor-pos old-cursor-pos)
+ (set! (keymap-functions 10) old-enter-func)))
+ (do ((c (next-char) (next-char)))
+ ((string? filename))
+ ((keymap-functions (char->integer c)) c)
+ (display-lines))
+ (load filename)))))))
+
+|#
+
+;; unicode someday: I think all we need is unicode_string_length and index into unicode string (set/ref)
+;; scroll past top line?
+
+*repl*
diff --git a/rgb.fs b/rgb.fs
index e86ad79..a35f8a2 100644
--- a/rgb.fs
+++ b/rgb.fs
@@ -1,9 +1,8 @@
-\ -*- snd-forth -*-
\ rgb.fs -- rgb.scm|rb --> rgb.fs
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
\ Created: Fri Aug 18 16:57:43 CEST 2006
-\ Changed: Wed Nov 25 01:22:08 CET 2009
+\ Changed: Fri Mar 23 22:50:07 CET 2012
\ Commentary:
\
diff --git a/rtio.rb b/rtio.rb
deleted file mode 100644
index 69ce0bc..0000000
--- a/rtio.rb
+++ /dev/null
@@ -1,361 +0,0 @@
-# rtio.rb -- Translation of Snd/Guile's rtio.scm.
-
-# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Tue May 20 08:35:13 CEST 2003
-# Changed: Sat Feb 19 17:21:58 CET 2011
-
-# Commentary:
-#
-# make_rtio(*args) or RTIO.new(*args)
-#
-# default args (all args are get- and settable properties)
-# :chans 1
-# :srate 22050
-# :in_sys 0 (card #)
-# :out_sys 1 (card #)
-# :fmt Mus_lshort or Mus_bshort depending on little_endian?
-# :bytes 512
-# :shorts 256
-# :func nil (function of one arg: lambda do |data| ... end)
-#
-# RTIO methods:
-# rt = make_rtio
-# rt.help
-# rt.close(unlink_tmpfile = true)
-#
-# rt.show_input(in_sys = @in_sys)
-# rt.show_input_fft(in_sys = @in_sys)
-# rt.show_draggable_input_fft(in_sys = @in_sys) alias show_drag(in_sys = @in_sys)
-#
-# rt.in_out(in_sys = @in_sys, out_sys = @out_sys, func = nil)
-# rt.amplify(amp)
-# rt.lp
-# rt.hp(freq)
-
-# make_rtio, RTIO.new and chans= look for an open sound with the
-# corresponding number of channels, save its state of time-,
-# transform-, and lisp_graph? and set the first two of them to false.
-# If no appropriate sound is found, a temporary one will be opened
-# with the required channels.
-#
-# rt.close resets the saved states of time-, transform- and
-# lisp_graph? to their old values and closes and removes temporary
-# opened sounds.
-
-# Code:
-
-require "hooks"
-
-def make_rtio(*args)
- RTIO.new(*args)
-end
-
-class RTIO
- class RTIO_Error < StandardError
- end
-
- def error(*args)
- str = format(*args)
- str += format(": %s\n%s", $!, $@.join("\n")) if $!
- raise(RTIO_Error, str, caller(1)[0])
- end
- private :error
-
- def initialize(*args)
- @sound_properties = []
- set_chans(get_args(args, :chans, 1))
- @srate = get_args(args, :srate, 22050)
- @in_sys = get_args(args, :in_sys, 0)
- @out_sys = get_args(args, :out_sys, 1)
- @fmt = get_args(args, :fmt, little_endian? ? Mus_lshort : Mus_bshort)
- @bytes = get_args(args, :bytes, 512)
- @shorts = get_args(args, :shorts, 256)
- @func = get_args(args, :func, nil)
- end
- attr_accessor :srate, :in_sys, :out_sys, :fmt, :bytes, :shorts
- attr_reader :chans, :sound_properties
-
- def inspect
- format("#<%s: chans: %d, srate: %d, in_sys: %d, out_sys: %d, \
-fmt: %d, bytes: %d, shorts: %d, func: %s>",
- self.class, @chans, @srate, @in_sys, @out_sys,
- @fmt, @bytes, @shorts, @func.inspect)
- end
-
- def help
- str = <<HELP
-# You can set the following properties:
-#{self.inspect}
-# e.g.
-# rt = RTIO.new
-# rt.chans = 2
-# rt.srate = 44100
-# or even
-# rt = RTIO.new(:srate, 44100, :chans, 2)
-#
-# make_rtio(*args) or RTIO.new(*args)
-#
-# default args (all args are get- and settable properties)
-# :chans 1
-# :srate 22050
-# :in_sys 0 (card #)
-# :out_sys 1 (card #)
-# :fmt Mus_lshort or Mus_bshort depending on little_endian?
-# :bytes 512
-# :shorts 256
-# :func nil (function of one arg: lambda do |data| ... end)
-#
-# RTIO methods:
-# rt = make_rtio
-# rt.help
-# rt.close(unlink_tmpfile = true)
-#
-# rt.show_input(in_sys = @in_sys)
-# rt.show_input_fft(in_sys = @in_sys)
-# rt.show_draggable_input_fft(in_sys = @in_sys) alias show_drag(in_sys = @in_sys)
-#
-# rt.in_out(in_sys = @in_sys, out_sys = @out_sys, func = nil)
-# rt.amplify(amp)
-# rt.lp
-# rt.hp(freq)
-#
-# examples:
-# rt.show_drag
-# rt.amplify(2.0).in_out(1, 0)
-# rt.lp.in_out
-# rt.hp(1200).in_out
-HELP
- ENV["EMACS"] ? puts(str) : str
- end
-
- def chans=(val)
- props = {}
- unless (snd = sounds.detect do |s| channels(s) == val end)
- snd = new_sound(snd_tempnam, default_output_header_type, default_output_data_format,
- default_output_srate, val)
- props[:new?] = true
- end
- props[:snd] = select_sound(snd)
- props[:time_graph?] = Range.new(0, channels(snd) - 1).map do |chn|
- time_graph?(snd, chn)
- end
- props[:transform_graph?] = Range.new(0, channels(snd) - 1).map do |chn|
- transform_graph?(snd, chn)
- end
- props[:lisp_graph?] = Range.new(0, channels(snd) - 1).map do |chn|
- lisp_graph?(snd, chn)
- end
- @sound_properties << props
- Range.new(0, channels(snd) - 1).map do |chn|
- set_time_graph?(false, snd, chn)
- set_transform_graph?(false, snd, chn)
- set_lisp_graph?(true, snd, chn)
- end
- @chans = val
- end
- alias set_chans chans=
-
- def close(unlink_tmpfile = true)
- @sound_properties.each do |props|
- if props[:new?]
- file = file_name(props[:snd])
- close_sound(props[:snd])
- File.unlink(file) if unlink_tmpfile
- else
- props[:time_graph?].each_with_index do |flag, chn|
- set_time_graph?(flag, props[:snd], chn)
- end
- props[:transform_graph?].each_with_index do |flag, chn|
- set_transform_graph?(flag, props[:snd], chn)
- end
- props[:lisp_graph?].each_with_index do |flag, chn|
- set_lisp_graph?(flag, props[:snd], chn)
- end
- end
- end
- @sound_properties = nil
- end
-
- def show_input(in_sys = @in_sys)
- in_port = audio_open(in_sys)
- data = make_sound_data(@chans, @shorts)
- vobj = make_vct(@shorts)
- loop do
- mus_audio_read(in_port, data, @shorts)
- @chans.times do |chn|
- begin
- graph(sound_data2vct(data, chn, vobj), "input", 0.0, 1.0, -1.0, 1.0, false, chn)
- rescue
- error(get_func_name())
- end
- end
- end
- audio_close(in_port)
- end
-
- def show_input_fft(in_sys = @in_sys)
- in_port = audio_open(in_sys)
- data = make_sound_data(@chans, @shorts)
- vobj = make_vct(@shorts)
- loop do
- mus_audio_read(in_port, data, @shorts)
- @chans.times do |chn|
- begin
- graph(snd_spectrum(sound_data2vct(data, chn, vobj), Blackman2_window, @shorts, true),
- "input fft", 0.0, 1.0, 0.0, 1.0, false, chn)
- rescue
- error(get_func_name())
- end
- end
- end
- audio_close(in_port)
- end
-
- def show_draggable_input_fft(in_sys = @in_sys)
- mouse_down = 0.0
- mouse_pos = 0.0
- x1 = 1.0
- in_port = audio_open(in_sys)
- data = make_sound_data(@chans, @shorts)
- vobj = make_vct(@shorts)
- $mouse_drag_hook.add_hook!("rtio_hook") do |snd, chn, button, state, x, y|
- xnew = x / x1.to_f
- lim = [1.0, [0.1, mouse_down + (mouse_pos - xnew)].max].min
- x1 = lim
- end
- $mouse_press_hook.add_hook!("rtio_hook") do |snd, chn, button, state, x, y|
- mouse_pos = x / x1.to_f
- mouse_down = x1
- end
- loop do
- mus_audio_read(in_port, data, @shorts)
- maxpt = (x1 == 1.0 ? @shorts : (x1 * @shorts).round)
- @chans.times do |chn|
- begin
- graph(snd_spectrum(vct_subseq(sound_data2vct(data, chn, vobj), 0, maxpt),
- Blackman2_window, maxpt, true),
- "spectrum", 0.0, x1, 0.0, 1.0, false, chn)
- rescue
- error(get_func_name())
- end
- end
- end
- $mouse_drag_hook.remove_hook!("rtio_hook")
- $mouse_press_hook.remove_hook!("rtio_hook")
- audio_close(in_port)
- end
- alias show_drag show_draggable_input_fft
-
- # rt.amplify(2.0).in_out
- # rt.amplify(2.0).in_out(1, 0)
- # rt.in_out(0, 1, lambda do |data| ... end)
- # rt.in_out(1, 0, method(:my_func).to_proc) with def my_func(data) ... end
- def in_out(in_sys = @in_sys, out_sys = @out_sys, func = nil)
- out_port = audio_open(out_sys, true)
- in_port = audio_open(in_sys)
- data = make_sound_data(@chans, @shorts)
- f = (func or @func)
- loop do
- mus_audio_read(in_port, data, @shorts)
- begin
- f.call(data)
- rescue
- error(get_func_name())
- end
- mus_audio_write(out_port, data, @shorts)
- end
- audio_close(in_port, out_port)
- end
-
- # These are usable by in_out
- # amplify(amp)
- # lp
- # hp(freq)
- def amplify(amp)
- vobj = make_vct(@shorts)
- @func = lambda do |data|
- @shorts.times do |i|
- @chans.times do |chn|
- sound_data_set!(data, chn, i, sound_data_ref(data, chn, i) * amp)
- end
- end
- @chans.times do |chn|
- begin
- graph(snd_spectrum(sound_data2vct(data, chn, vobj), Blackman2_window, @shorts, true),
- "amplify(%.1f)" % amp,
- 0.0, 1.0, 0.0, 1.0, false, chn)
- rescue
- error(get_func_name())
- end
- end
- end
- self
- end
-
- def lp
- val = 0.0
- vobj = make_vct(@shorts)
- @func = lambda do |data|
- @shorts.times do |i|
- @chans.times do |chn|
- curval = sound_data_ref(data, chn, i)
- sound_data_set!(data, chn, i, 0.5 * (curval + val))
- val = curval
- end
- end
- @chans.times do |chn|
- begin
- graph(snd_spectrum(sound_data2vct(data, chn, vobj), Blackman2_window, @shorts, true),
- "lp",
- 0.0, 1.0, 0.0, 1.0, false, chn)
- rescue
- error(get_func_name())
- end
- end
- end
- self
- end
-
- def hp(freq)
- flt = make_formant(freq, 0.99)
- vobj = make_vct(@shorts)
- @func = lambda do |data|
- @shorts.times do |i|
- @chans.times do |chn|
- curval = sound_data_ref(data, chn, i)
- sound_data_set!(data, chn, i, formant(flt, curval))
- end
- end
- @chans.times do |chn|
- begin
- graph(snd_spectrum(sound_data2vct(data, chn, vobj), Blackman2_window, @shorts, true),
- "hp(%.1f)" % freq,
- 0.0, 1.0, 0.0, 1.0, false, chn)
- rescue
- error(get_func_name())
- end
- end
- end
- self
- end
-
- def audio_open(sys, output = false)
- device = sys << 16 | 0
- port = if output
- mus_audio_open_output(device, @srate, @chans, @fmt, @bytes)
- else
- mus_audio_open_input(device, @srate, @chans, @fmt, @bytes)
- end
-
- error("can't open %s_sys %d", output ? "out" : "in", sys) if port < 0
- port
- end
- private :audio_open
-
- def audio_close(*ports)
- ports.each do |prt| error("can't close port %d", prt) if mus_audio_close(prt) < 0 end
- end
- private :audio_close
-end
-
-# rtio.rb ends here
diff --git a/rtio.scm b/rtio.scm
deleted file mode 100644
index f0fc7a1..0000000
--- a/rtio.scm
+++ /dev/null
@@ -1,167 +0,0 @@
-;;; various low-level IO and "real-time" functions/examples
-
-(provide 'snd-rtio.scm)
-
-(define (card+device card device)
- ;; sndlib (for dubious historical reasons) packs the sound card number into the same parameter as the device number
- (logior (ash card 16) device))
-
-(define our-short (if (little-endian?) mus-lshort mus-bshort))
-(define our-srate 22050)
-(define our-dac-buffer-size-in-bytes 512)
-(define our-dac-buffer-size-in-shorts 256)
-(define our-chans 1)
-(define our-chan 0)
-(define our-default-card-number 0)
-
-
-(define (show-input . arg)
- ;; show (as time domain graph) whatever is being seen from input port
- ;; this needs a dummy file open to get a place to put the lisp graph
- (let* ((in-sys (if (not (null? arg))
- (car arg)
- our-default-card-number))
- (in-port (mus-audio-open-input
- (card+device in-sys mus-audio-default)
- our-srate our-chans our-short our-dac-buffer-size-in-bytes))
- (data (make-sound-data our-chans our-dac-buffer-size-in-shorts))
- (vobj (make-vct our-dac-buffer-size-in-shorts))
- (stop #f))
- (bind-key #\space 0 (lambda () (set! stop #t))) ; type space in the graph to stop this loop
- (do ()
- (stop
- (unbind-key #\space 0))
- (mus-audio-read in-port data our-dac-buffer-size-in-shorts)
- (graph (sound-data->vct data our-chan vobj)))
- (mus-audio-close in-port)))
-
-
-(define (show-input-fft . arg)
- ;; show (as spectrum) whatever is being seen from input port
- (let* ((in-sys (if (not (null? arg))
- (car arg)
- our-default-card-number))
- (in-port (mus-audio-open-input
- (card+device in-sys mus-audio-default)
- our-srate our-chans our-short our-dac-buffer-size-in-bytes))
- (data (make-sound-data our-chans our-dac-buffer-size-in-shorts))
- (vobj (make-vct our-dac-buffer-size-in-shorts))
- (stop #f))
- (bind-key #\space 0 (lambda () (set! stop #t))) ; type space in the graph to stop this loop
- (do ()
- (stop
- (unbind-key #\space 0))
- (mus-audio-read in-port data our-dac-buffer-size-in-shorts)
- (sound-data->vct data our-chan vobj)
- (graph (snd-spectrum vobj blackman2-window our-dac-buffer-size-in-shorts #t))) ;probably better to have bounds here
- (mus-audio-close in-port)))
-
-
-(define (in-out func in-sys out-sys)
- ;; read audio data from in-sys (a sound card), pass it to func for processing, write it to out-sys
- (let ((out-port (mus-audio-open-output
- (card+device out-sys mus-audio-default)
- our-srate our-chans our-short our-dac-buffer-size-in-bytes))
- (in-port (mus-audio-open-input
- (card+device in-sys mus-audio-default)
- our-srate our-chans our-short our-dac-buffer-size-in-bytes))
- (data (make-sound-data our-chans our-dac-buffer-size-in-shorts))
- (vobj (make-vct our-dac-buffer-size-in-shorts))
- (stop #f))
- (bind-key #\space 0 (lambda () (set! stop #t))) ; type space in the graph to stop this loop
- (catch #t ; try to make sure we close the audio ports upon an error
- (lambda ()
- (do ()
- (stop)
- (mus-audio-read in-port data our-dac-buffer-size-in-shorts)
- ;; now process the sound...
- (func data)
- (mus-audio-write out-port data our-dac-buffer-size-in-shorts)))
- (lambda args
- (display (format #f ";in-out error: ~A" args))))
- (unbind-key #\space 0)
- (mus-audio-close in-port)
- (mus-audio-close out-port)))
-
-;;; now some "func"s for in-out above
-(define (amplify amp)
- (lambda (data)
- (do ((i 0 (+ 1 i)))
- ((= i our-dac-buffer-size-in-shorts))
- (sound-data-set! data our-chan i (* (sound-data-ref data our-chan i) amp)))))
-
-;;; (in-out (amplify 2.0) 1 0)
-
-(define (lp)
- (let ((val 0.0))
- (lambda (data)
- (do ((i 0 (+ 1 i)))
- ((= i our-dac-buffer-size-in-shorts))
- (let ((curval (sound-data-ref data our-chan i)))
- (sound-data-set! data our-chan i (* .5 (+ curval val)))
- (set! val curval))))))
-
-;;; (in-out (lp) 1 0)
-
-(define (hp frq)
- (let ((flt (make-formant frq .99))
- (vobj (make-vct our-dac-buffer-size-in-shorts)))
- (lambda (data)
- (do ((i 0 (+ 1 i)))
- ((= i our-dac-buffer-size-in-shorts))
- (let ((curval (sound-data-ref data our-chan i)))
- (sound-data-set! data our-chan i (formant flt curval))))
- (graph (snd-spectrum (sound-data->vct data our-chan vobj) blackman2-window our-dac-buffer-size-in-shorts #t)))))
-
-;;; (in-out (hp 1200) 1 0)
-
-
-(define (show-draggable-input-fft . arg)
- ;; show (as draggable spectrum) whatever is being seen from input port
- (let ((mouse-down 0)
- (mouse-pos 0.0)
- ( x1 1.0))
-
- (define (mouse-press chn snd button state x y)
- (set! mouse-pos (/ x x1))
- (set! mouse-down x1))
-
- (define (mouse-drag snd chn button state x y)
- (let* ((xnew (/ x x1))
- (lim (min 1.0 (max 0.1 (+ mouse-down (- mouse-pos xnew))))))
- (set! x1 lim)))
-
- (let* ((in-sys (if (not (null? arg))
- (car arg)
- our-default-card-number))
- (in-port (mus-audio-open-input
- (card+device in-sys mus-audio-default)
- our-srate our-chans our-short our-dac-buffer-size-in-bytes))
- (data (make-sound-data our-chans our-dac-buffer-size-in-shorts))
- (vobj (make-vct our-dac-buffer-size-in-shorts))
- (stop #f))
- (hook-push mouse-drag-hook mouse-drag)
- (hook-push mouse-press-hook mouse-press)
- (bind-key #\space 0 (lambda () (set! stop #t))) ; type space in the graph to stop this loop
- (do ()
- (stop)
- (mus-audio-read in-port data our-dac-buffer-size-in-shorts)
- (if (= x1 1.0)
- (graph
- (snd-spectrum
- (sound-data->vct data our-chan vobj)
- blackman2-window our-dac-buffer-size-in-shorts #t)
- "spectrum"
- 0.0 x1)
- (let ((maxpt (floor (* x1 our-dac-buffer-size-in-shorts))))
- (graph
- (snd-spectrum
- (vct-subseq (sound-data->vct data our-chan vobj) 0 maxpt)
- blackman2-window maxpt #t)
- "spectrum"
- 0.0 x1))))
- (unbind-key #\space 0)
- (hook-remove mouse-drag-hook mouse-drag)
- (hook-remove mouse-press-hook mouse-press)
- (mus-audio-close in-port))))
-
diff --git a/rubber.fs b/rubber.fs
index d6c1ce1..6af645d 100644
--- a/rubber.fs
+++ b/rubber.fs
@@ -1,19 +1,17 @@
\ rubber.fs -- rubber.scm --> rubber.fs
\ Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Fri Jan 06 05:32:57 CET 2006
-\ Changed: Fri Nov 06 00:35:16 CET 2009
-
-\ Commentary:
+\ Created: 06/01/06 05:32:57
+\ Changed: 14/04/28 03:52:17
\
+\ @(#)rubber.fs 1.15 4/28/14
+
\ original comments are taken from rubber.scm [ms]
\
\ ;;; rubber.scm: rubber-sound stretches or contracts a sound (in time)
\ ;;; (rubber-sound 1.5) makes it 50% longer
-\ ;;; rubber-sound looks for stable portions and either inserts or deletes periods
-\ ;;; period length is determined via autocorrelation
-\
-\ Code:
+\ ;;; rubber-sound looks for stable portions and either inserts or deletes
+\ ;;; periods period length is determined via autocorrelation
require clm
require marks
@@ -29,248 +27,295 @@ hide
\ ;;; collect weights for each across next zeros-checked crossings
\ ;;; sort by least weight
\ ;;; ramp (out or in) and check if done
-: derumble-sound ( snd chn -- )
- \ ;; remove rumbles and DC etc (since we're using zero crossings to find period starts)
- { snd chn }
- snd chn #f frames { old-len }
- #( 0.0 0.0 16.0 f2* snd srate f/ 0.0 20.0 f2* snd srate f/ 1.0 1.0 1.0 ) ( flt-lst )
- 2.0 old-len snd srate min flog 2.0 flog f/ fceil ( pow2 ) f** f>s ( fftlen )
- snd chn #f undef filter-sound drop
- old-len snd chn set-frames drop
+
+: derumble-sound { snd chn -- }
+ \ ;; remove rumbles and DC etc (since we're using zero crossings
+ \ ;; to find period starts)
+ snd chn #f framples { old-len }
+ snd srate { sr }
+ #( 0.0 0.0
+ 16.0 f2* sr f/ 0.0
+ 20.0 f2* sr f/ 1.0
+ 1.0 1.0 ) ( flt-lst )
+ 2.0 old-len sr min flog 2.0 flog f/ fceil ( pow2 )
+ f** f>s ( fftlen ) snd chn #f undef filter-sound drop
+ old-len snd chn set-framples drop
;
-: sample-sound ( snd chn -- )
- \ ;; prepare sound for analysis by interpolating samples
- { snd chn }
- extension 1.0 f<> if extension 1/f 1.0 snd chn #f src-sound drop then
+
+: sample-sound { snd chn -- }
+ \ ;; prepare sound for analysis by interpolating samples
+ extension 1.0 f<> if
+ extension 1/f 1.0 snd chn #f src-sound drop
+ then
;
-: unsample-sound ( snd chn -- )
- \ ;; undo earlier interpolation
- { snd chn }
- extension 1.0 f<> if extension 1.0 snd chn #f src-sound drop then
+
+: unsample-sound { snd chn -- }
+ \ ;; undo earlier interpolation
+ extension 1.0 f<> if
+ extension 1.0 snd chn #f src-sound drop
+ then
;
-: crossings ( snd chn -- n )
- \ ;; return number of upward zero crossings that don't look like silence
- { snd chn }
- 0 0 { crosses last-cross }
- 0 snd chn 1 #f make-sampler { sr0 }
- sr0 next-sample { samp0 }
- 0.0 { sum }
- extension 0.001 f* { silence }
- snd chn #f frames 0 ?do
- sr0 next-sample { samp1 }
- samp0 f0<=
- samp1 f0> &&
- i last-cross - 4 > &&
- sum silence f> && if
- crosses 1+ to crosses
- i to last-cross
- 0.0 to sum
- then
- samp0 fabs sum f+ to sum
- samp1 to samp0
- loop
- crosses
+
+: crossings { snd chn -- n }
+ \ ;; return number of upward zero crossings that don't look like silence
+ 0 0 { crosses last-cross }
+ 0 snd chn 1 #f make-sampler { sr0 }
+ sr0 next-sample { samp0 }
+ 0.0 { sum }
+ extension 0.001 f* { silence }
+ snd chn #f framples 0 ?do
+ sr0 next-sample { samp1 }
+ samp0 f0<=
+ samp1 f0> &&
+ i last-cross - 4 > &&
+ sum silence f> && if
+ crosses 1+ to crosses
+ i to last-cross
+ 0.0 to sum
+ then
+ samp0 fabs sum f+ to sum
+ samp1 to samp0
+ loop
+ crosses
;
-: env-add ( s0 s1 samps snd chn -- vct )
- { s0 s1 samps snd chn }
- 1.0 { x }
- samps 1/f { xinc }
- s0 snd chn 1 #f make-sampler { sr0 }
- s1 snd chn 1 #f make-sampler { sr1 }
- samps 0.0 make-vct map!
- sr0 next-sample x f*
- sr1 next-sample 1.0 x f- f* f+ ( val )
- x xinc f+ to x
- end-map ( data )
+: env-add { s0 s1 samps snd chn -- vct }
+ 1.0 { x }
+ samps 1/f { xinc }
+ s0 snd chn 1 #f make-sampler { sr0 }
+ s1 snd chn 1 #f make-sampler { sr1 }
+ samps 0.0 make-vct map!
+ sr0 next-sample x f*
+ sr1 next-sample 1.0 x f- f* f+ ( val )
+ x xinc f+ to x
+ ( val )
+ end-map ( data )
;
-: rubber-cb { stretch snd chn -- proc; self -- }
- 0 proc-create chn , snd , stretch ,
- does> ( self -- )
- { self }
- self @ { chn }
- self cell+ @ { snd }
- self 2 cells + @ { stretch }
- \ ;; prepare sound (get rid of low freqs, resample)
- snd chn derumble-sound
- snd chn sample-sound
- snd chn crossings { crosses }
- crosses :initial-element 0 make-array { cross-samples }
- crosses :initial-element 0 make-array { cross-weights }
- crosses :initial-element 0 make-array { cross-marks }
- crosses :initial-element 0 make-array { cross-periods }
- 0 snd chn 1 #f make-sampler { sr0 } \ ;; get cross points (sample numbers)
- sr0 next-sample { samp0 }
- 0.0 { sum }
- 0 { last-cross }
- extension 0.001 f* { silence }
- snd chn #f frames 0 ?do
- sr0 next-sample { samp1 }
- samp0 f0<=
- samp1 f0> &&
- i last-cross - 40 > &&
- sum silence f> && if
- i to last-cross
- 0.0 to sum
- cross-samples i cycle-set!
- then
- samp0 fabs sum f+ to sum
- samp1 to samp0
- loop
- \ ;; now run through crosses getting period match info
- crosses 1- 0 ?do
- cross-samples i array-ref { start }
- 0 { autolen }
- 2.0 extension snd srate 40.0 f/ f* flog 2.0 flog f/ fceil ( pow2 ) f** f>s { fftlen }
- fftlen 4 / { len4 }
- start snd chn 1 #f make-sampler { rd }
- fftlen 0.0 make-vct map! rd next-sample end-map { data }
- data autocorrelate drop
- len4 1 ?do
- data i vct-ref data i 1+ vct-ref f<
- data i 1+ vct-ref data i 2 + vct-ref f> && if
- i 2* to autolen
- leave
- then
- loop
- start autolen + { next-start }
- i 1+ { min-i }
- cross-samples min-i array-ref next-start - abs { min-samps }
- crosses i zeros-checked + min i 2 + ?do
- cross-samples i array-ref next-start - abs { dist }
- dist min-samps < if
- dist to min-samps
- i to min-i
- then
- loop
- min-i { current-mark }
- 0.0 { current-min }
- cross-samples current-mark array-ref { s1 }
- start snd chn 1 #f make-sampler { sr0 }
- s1 snd chn 1 #f make-sampler { sr1 }
- 0.0 0.0 { ampsum diffsum }
- autolen 0 ?do
- sr0 next-sample { samp0 }
- sr1 next-sample { samp1 }
- samp0 fabs ampsum f+ to ampsum
- samp1 samp0 f- fabs diffsum f+ to diffsum
- loop
- diffsum f0= if 0.0 else diffsum ampsum f/ then to current-min
- current-min f2/ fround->s to min-samps
- current-mark zeros-checked i + min crosses 1- min { top }
- top i 1+ ?do
- 0.0 { wgt }
- cross-samples i array-ref { s1 }
- start snd chn 1 #f make-sampler { sr0 }
- s1 snd chn 1 #f make-sampler { sr1 }
- 0.0 0.0 { ampsum diffsum }
- autolen 0 ?do
+
+: rubber-cb { stretch snd chn -- prc; self -- }
+ 0 proc-create ( prc ) chn , snd , stretch ,
+ does> { self -- }
+ self @ { chn }
+ self cell+ @ { snd }
+ self 2 cells + @ { stretch }
+ \ ;; prepare sound (get rid of low freqs, resample)
+ snd chn derumble-sound
+ snd chn sample-sound
+ snd chn crossings { crosses }
+ crosses :initial-element 0 make-array { cross-samples }
+ crosses :initial-element 0 make-array { cross-weights }
+ crosses :initial-element 0 make-array { cross-marks }
+ crosses :initial-element 0 make-array { cross-periods }
+ \ ;; get cross points (sample numbers)
+ 0 snd chn 1 #f make-sampler { sr0 }
sr0 next-sample { samp0 }
- sr1 next-sample { samp1 }
- samp0 fabs ampsum f+ to ampsum
- samp1 samp0 f- fabs diffsum f+ to diffsum
- loop
- diffsum f0= if 0.0 else diffsum ampsum f/ then to wgt
- wgt min-samps f< if
- wgt f>s to min-samps
- i to min-i
- then
- loop
- current-mark min-i <> if
- \ ;; these are confused, so effectively erase them
- cross-weights i 1000.0 array-set!
- else
- cross-weights i current-min array-set!
- cross-marks i current-mark array-set!
- cross-periods i cross-samples current-mark array-ref cross-samples i array-ref - array-set!
- then
- loop
- \ ;; now sort weights to scatter the changes as evenly as possible
- snd chn #f frames { len }
- stretch 1.0 f> { adding }
- stretch 1.0 f- fabs len f* floor f>s { samps }
- adding if samps else len samps 2* min then { needed-samps }
- 0 { handled }
- #() { edits }
- begin
- \ ;; need to find (more than) enough splice points to delete samps
- -1 { best-mark }
- handled { old-handled }
- 0 { cur }
- cross-weights 0 array-ref { curmin }
- cross-weights each { val }
- val curmin f< if
- i to cur
- val to curmin
- then
- end-each
- cur to best-mark
- cross-periods best-mark array-ref handled + to handled
- handled needed-samps <
- handled needed-samps - needed-samps old-handled - < || if
- edits best-mark array-push drop
- then
- cross-weights best-mark 1000.0 array-set!
- edits length crosses = handled needed-samps >= ||
- until
- edits length crosses >= if needed-samps handled f/ fceil f>s else 1 then { mult }
- 0 { changed-len }
- edits each { best-mark }
- changed-len samps > ?leave
- cross-samples best-mark array-ref { beg }
- cross-samples cross-marks best-mark array-ref array-ref { next-beg }
- cross-periods best-mark array-ref { len }
- len 0> if
- adding if
- beg next-beg len snd chn env-add { new-samps }
- show-details if
- beg $" %d:%d" #( i len extension f/ f>s ) string-format snd chn add-named-mark drop
- then
- beg len new-samps snd chn #f insert-samples drop
- mult 1 ?do
- beg len i * + len new-samps snd chn #f insert-samples drop
+ 0.0 { sum }
+ 0 { last-cross }
+ extension 0.001 f* { silence }
+ snd chn #f framples 0 ?do
+ sr0 next-sample { samp1 }
+ samp0 f0<=
+ samp1 f0> &&
+ i last-cross - 40 > &&
+ sum silence f> && if
+ i to last-cross
+ 0.0 to sum
+ cross-samples i cycle-set!
+ then
+ samp0 fabs sum f+ to sum
+ samp1 to samp0
loop
- len mult * changed-len + to changed-len
- cross-samples each { curbeg }
- curbeg beg > if cross-samples i curbeg len + array-set! then
+ \ ;; now run through crosses getting period match info
+ crosses 1- 0 ?do
+ cross-samples i array-ref { start }
+ 0 { autolen }
+ 2.0 extension snd srate 40.0 f/ f*
+ flog 2.0 flog f/ fceil ( pow2 ) f** f>s { fftlen }
+ fftlen 4 / { len4 }
+ start snd chn 1 #f make-sampler { rd }
+ fftlen 0.0 make-vct map! rd next-sample end-map { data }
+ data autocorrelate drop
+ len4 1 ?do
+ data i vct-ref data i 1+ vct-ref f<
+ data i 1+ vct-ref data i 2 + vct-ref f> && if
+ i 2* to autolen
+ leave
+ then
+ loop
+ start autolen + { next-start }
+ i 1+ { min-i }
+ cross-samples min-i array-ref next-start - abs { min-samps }
+ crosses i zeros-checked + min i 2 + ?do
+ cross-samples i array-ref next-start - abs { dist }
+ dist min-samps < if
+ dist to min-samps
+ i to min-i
+ then
+ loop
+ min-i { current-mark }
+ 0.0 { current-min }
+ cross-samples current-mark array-ref { s1 }
+ start snd chn 1 #f make-sampler { sr0 }
+ s1 snd chn 1 #f make-sampler { sr1 }
+ 0.0 0.0 { ampsum diffsum }
+ autolen 0 ?do
+ sr0 next-sample { samp0 }
+ sr1 next-sample { samp1 }
+ samp0 fabs ampsum f+ to ampsum
+ samp1 samp0 f- fabs diffsum f+ to diffsum
+ loop
+ diffsum f0= if
+ 0.0
+ else
+ diffsum ampsum f/
+ then to current-min
+ current-min f2/ fround->s to min-samps
+ current-mark zeros-checked i + min crosses 1- min { top }
+ top i 1+ ?do
+ 0.0 { wgt }
+ cross-samples i array-ref { s1 }
+ start snd chn 1 #f make-sampler { sr0 }
+ s1 snd chn 1 #f make-sampler { sr1 }
+ 0.0 0.0 { ampsum diffsum }
+ autolen 0 ?do
+ sr0 next-sample { samp0 }
+ sr1 next-sample { samp1 }
+ samp0 fabs ampsum f+ to ampsum
+ samp1 samp0 f- fabs diffsum f+ to diffsum
+ loop
+ diffsum f0= if
+ 0.0
+ else
+ diffsum ampsum f/
+ then to wgt
+ wgt min-samps f< if
+ wgt f>s to min-samps
+ i to min-i
+ then
+ loop
+ current-mark min-i <> if
+ \ ;; these are confused, so effectively erase them
+ cross-weights i 1000.0 array-set!
+ else
+ cross-weights i current-min array-set!
+ cross-marks i current-mark array-set!
+ cross-periods i cross-samples current-mark array-ref
+ cross-samples i array-ref - array-set!
+ then
+ loop
+ \ ;; now sort weights to scatter the changes as evenly as possible
+ snd chn #f framples { len }
+ stretch 1.0 f> { adding }
+ stretch 1.0 f- fabs len f* floor f>s { samps }
+ adding if
+ samps
+ else
+ len samps 2* min
+ then { needed-samps }
+ 0 { handled }
+ #() { edits }
+ begin
+ \ ;; need to find (more than) enough splice pts to delete samps
+ -1 { best-mark }
+ handled { old-handled }
+ 0 { cur }
+ cross-weights 0 array-ref { curmin }
+ cross-weights each { val }
+ val curmin f< if
+ i to cur
+ val to curmin
+ then
+ end-each
+ cur to best-mark
+ cross-periods best-mark array-ref handled + to handled
+ handled needed-samps <
+ handled needed-samps - needed-samps old-handled - < || if
+ edits best-mark array-push drop
+ then
+ cross-weights best-mark 1000.0 array-set!
+ edits length crosses =
+ handled needed-samps >= ||
+ until
+ edits length crosses >= if
+ needed-samps handled f/ fceil f>s
+ else
+ 1
+ then { mult }
+ 0 { changed-len }
+ edits each { best-mark }
+ changed-len samps > ?leave
+ cross-samples best-mark array-ref { beg }
+ cross-samples
+ cross-marks best-mark array-ref
+ array-ref { next-beg }
+ cross-periods best-mark array-ref { len }
+ len 0> if
+ adding if
+ beg next-beg len snd chn env-add { new-samps }
+ show-details if
+ beg "%d:%d" #( i len extension f/ f>s )
+ string-format
+ snd chn add-named-mark drop
+ then
+ beg len new-samps snd chn #f insert-samples drop
+ mult 1 ?do
+ beg len i * + len new-samps
+ snd chn #f insert-samples drop
+ loop
+ len mult * changed-len + to changed-len
+ cross-samples each { curbeg }
+ curbeg beg > if
+ cross-samples i
+ curbeg len + array-set!
+ then
+ end-each
+ else
+ beg snd chn #f framples >= if
+ "trouble at %d: %d of %d"
+ #( i beg snd chn #f framples )
+ clm-message
+ then
+ show-details if
+ beg 1- "%d:%d"
+ #( i len extension f/ f>s )
+ string-format
+ snd chn add-named-mark drop
+ then
+ beg len snd chn #f delete-samples drop
+ changed-len len + to changed-len
+ beg len + { end }
+ cross-samples each { curbeg }
+ curbeg beg > if
+ curbeg end < if
+ cross-periods i 0
+ array-set!
+ else
+ cross-samples i
+ curbeg len -
+ array-set!
+ then
+ then
+ end-each
+ then
+ then
end-each
- else
- beg snd chn #f frames >= if
- $" trouble at %d: %d of %d" #( i beg snd chn #f frames ) clm-message
+ show-details if
+ "wanted: %d, got %d" #( samps changed-len ) clm-message
then
+ \ ;; and return to original srate
+ snd chn unsample-sound
show-details if
- beg 1- $" %d:%d" #( i len extension f/ f>s ) string-format snd chn add-named-mark drop
+ snd chn 0 framples { frms0 }
+ snd chn undef framples { frms }
+ "%d -> %d (%d)"
+ #( frms0 frms frms0 stretch f* floor f>s ) clm-message
then
- beg len snd chn #f delete-samples drop
- changed-len len + to changed-len
- beg len + { end }
- cross-samples each { curbeg }
- curbeg beg > if
- curbeg end < if
- cross-periods i 0 array-set!
- else
- cross-samples i curbeg len - array-set!
- then
- then
- end-each
- then
- then
- end-each
- show-details if
- $" wanted: %d, got %d" #( samps changed-len ) clm-message
- then
- \ ;; and return to original srate
- snd chn unsample-sound
- show-details if
- snd chn 0 frames { frms0 }
- snd chn undef frames { frms }
- $" %d -> %d (%d)" #( frms0 frms frms0 stretch f* floor f>s ) clm-message
- then
;
set-current
-: rubber-sound ( stretch snd chn -- res )
- { stretch snd chn }
- stretch snd chn rubber-cb $" %s %s" #( stretch get-func-name ) string-format as-one-edit
+
+: rubber-sound { stretch snd chn -- res }
+ "%s %s" #( stretch get-func-name ) string-format { origin }
+ stretch snd chn rubber-cb origin as-one-edit
;
previous
diff --git a/rubber.rb b/rubber.rb
index 087b1c3..7181d77 100644
--- a/rubber.rb
+++ b/rubber.rb
@@ -1,17 +1,17 @@
# rubber.rb -- Translation of rubber.scm
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Fri Feb 28 03:04:03 CET 2003
-# Changed: Mon Nov 22 13:29:07 CET 2010
+# Created: 03/02/28 03:04:03
+# Changed: 14/11/23 06:14:52
# module Rubber (see rubber.scm)
# add_named_mark(samp, name, snd, chn)
-# derumble_sound(*args)
-# sample_sound(*args)
-# unsample_sound(*args)
+# derumble_sound(snd, chn)
+# sample_sound(snd, chn)
+# unsample_sound(snd, chn)
# crossings()
# env_add(s0, s1, samps)
-# rubber_sound(*args)
+# rubber_sound(stretch, snd, chn)
require "clm"
@@ -28,40 +28,42 @@ module Rubber
m
end
- def derumble_sound(*args)
- snd = (args[0] or false)
- chn = (args[1] or false)
- old_length = frames(snd, chn)
+ def derumble_sound(snd = false, chn = false)
+ old_length = framples(snd, chn)
pow2 = (log([old_length, srate(snd)].min) / log(2)).ceil
fftlen = (2 ** pow2).round
- flt_env = [0.0, 0.0, 32.0 / srate(snd), 0.0, 40.0 / srate(snd), 1.0, 1.0, 1.0]
+ flt_env = [0.0, 0.0, 32.0 / srate(snd), 0.0,
+ 40.0 / srate(snd), 1.0, 1.0, 1.0]
filter_sound(flt_env, fftlen, snd, chn)
- set_frames(old_length, snd, chn)
+ set_framples(old_length, snd, chn)
end
- def sample_sound(*args)
- snd = (args[0] or false)
- chn = (args[1] or false)
- src_sound(1.0 / $extension, 1.0, snd, chn) unless $extension == 1.0
+ def sample_sound(snd = false, chn = false)
+ if $extension != 1.0
+ src_sound(1.0 / $extension, 1.0, snd, chn)
+ end
end
- def unsample_sound(*args)
- snd = (args[0] or false)
- chn = (args[1] or false)
- src_sound($extension, 1.0, snd, chn) unless $extension == 1.0
+ def unsample_sound(snd = false, chn = false)
+ if $extension != 1.0
+ src_sound($extension, 1.0, snd, chn)
+ end
end
def crossings
crosses = 0
sr0 = make_sampler(0)
samp0 = next_sample(sr0)
- len = frames()
+ len = framples()
sum = 0.0
last_cross = 0
silence = $extension * 0.001
(0...len).each do |i|
samp1 = next_sample(sr0)
- if samp0 <= 0.0 and samp1 > 0.0 and (i - last_cross) > 4 and sum > silence
+ if samp0 <= 0.0 and
+ samp1 > 0.0 and
+ (i - last_cross) > 4 and
+ sum > silence
crosses += 1
last_cross = i
sum = 0.0
@@ -85,10 +87,7 @@ module Rubber
data
end
- def rubber_sound(*args)
- stretch = args[0]
- snd = (args[1] or false)
- chn = (args[2] or false)
+ def rubber_sound(stretch, snd = false, chn = false)
as_one_edit(lambda do | |
derumble_sound(snd, chn)
sample_sound(snd, chn)
@@ -99,14 +98,17 @@ module Rubber
cross_periods = make_vct(crosses)
sr0 = make_sampler(0, snd, chn)
samp0 = next_sample(sr0)
- len = frames()
+ len = framples()
sum = 0.0
last_cross = 0
cross = 0
silence = $extension * 0.001
(0...len).each do |i|
samp1 = next_sample(sr0)
- if samp0 <= 0.0 and samp1 > 0.0 and (i - last_cross) > 4 and sum > silence
+ if samp0 <= 0.0 and
+ samp1 > 0.0 and
+ (i - last_cross) > 4 and
+ sum > silence
last_cross = i
sum = 0.0
cross_samples[cross] = i
@@ -124,7 +126,9 @@ module Rubber
len4 = fftlen / 4
data = make_vct(fftlen)
reader = make_sampler(s0.round)
- (0...fftlen).each do |j| data[j] = next_sample(reader) end
+ (0...fftlen).each do |j|
+ data[j] = next_sample(reader)
+ end
autocorrelate(data)
autolen = 0
(1...len4).detect do |j|
@@ -195,12 +199,13 @@ module Rubber
else
cross_weights[i] = current_min
cross_marks[i] = current_mark
- cross_periods[i] = cross_samples[current_mark] - cross_samples[i]
+ cross_periods[i] = cross_samples[current_mark] -
+ cross_samples[i]
end
end
- len = frames(snd, chn)
+ len = framples(snd, chn)
adding = (stretch > 1.0)
- samps = ((stretch - 1.0).abs * len).round
+ samps = ((stretch - 1.0).abs * len).round
needed_samps = (adding ? samps : [len, samps * 2].min)
handled = 0
mult = 1
@@ -232,18 +237,22 @@ module Rubber
weights = cross_weights.length
(0...curs).detect do |i|
best_mark = edits[i].round
- beg = cross_samples[best_mark]
+ beg = cross_samples[best_mark].to_i
next_beg = cross_samples[cross_marks[best_mark].round]
- len = cross_periods[best_mark]
+ len = cross_periods[best_mark].to_i
if len > 0
if adding
new_samps = env_add(beg, next_beg, len)
if $show_details
- add_named_mark(beg, format("%d:%d", i, (len / $extension).round))
+ add_named_mark(beg,
+ format("%d:%d",
+ i, (len / $extension).round))
end
insert_samples(beg, len, new_samps)
if mult > 1
- (1...mult).each do |k| insert_samples(beg + k * len, len, new_samps) end
+ (1...mult).each do |k|
+ insert_samples(beg + k * len, len, new_samps)
+ end
end
changed_len = changed_len + mult * len
(0...weights).each do |j|
@@ -253,9 +262,14 @@ module Rubber
end
end
else
- Snd.display("trouble at %d: %d of %d", i, beg, frames()) if beg >= frames()
+ frms = framples()
+ if beg >= frms
+ Snd.display("trouble at %d: %d of %d", i, beg, frms)
+ end
if $show_details
- add_named_mark(beg - 1, format("%d:%d", i, (len / $extension).round))
+ add_named_mark(beg - 1,
+ format("%d:%d",
+ i, (len / $extension).round))
end
delete_samples(beg, len)
changed_len += len
@@ -274,14 +288,20 @@ module Rubber
end
changed_len > samps
end
- Snd.display("wanted: %d, got %d", samps.round, changed_len.round) if $show_details
+ if $show_details
+ Snd.display("wanted: %d, got %d",
+ samps.round, changed_len.round)
+ end
unsample_sound(snd, chn)
if $show_details
+ frms0 = framples(snd, chn, 0)
Snd.display("%f -> %f (%f)",
- frames(snd, chn, 0), frames(snd,chn),
- (stretch * frames(snd, chn, 0)).round)
+ frms0,
+ framples(snd,chn),
+ (stretch * frms0).round)
end
- end, "(rubber_sound(#{args.join(', ')})")
+ end,
+ format("rubber_sound(%f, %p, %p,", stretch, snd, chn))
end
end
diff --git a/rubber.scm b/rubber.scm
index 02c80a3..970e536 100644
--- a/rubber.scm
+++ b/rubber.scm
@@ -25,12 +25,12 @@
m))
(define* (derumble-sound snd chn)
- (let* ((old-length (frames snd chn))
- (pow2 (ceiling (/ (log (min old-length (srate snd))) (log 2))))
+ (let* ((old-length (framples snd chn))
+ (pow2 (ceiling (log (min old-length (srate snd)) 2)))
(fftlen (floor (expt 2 pow2)))
(flt-env (list 0.0 0.0 (/ (* 2 16.0) (srate snd)) 0.0 (/ (* 2 20.0) (srate snd)) 1.0 1.0 1.0)))
(filter-sound flt-env fftlen snd chn)
- (set! (frames snd chn) old-length)))
+ (set! (framples snd chn) old-length)))
(define* (sample-sound snd chn)
(if (not (= extension 1.0))
@@ -46,38 +46,36 @@
(let* ((crosses 0)
(sr0 (make-sampler 0))
(samp0 (next-sample sr0))
- (len (frames))
+ (len (framples))
(sum 0.0)
(last-cross 0)
(silence (* extension .001)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
(let ((samp1 (next-sample sr0)))
(if (and (<= samp0 0.0)
- (> samp1 0.0))
- (if (and (> (- i last-cross) 4)
- (> sum silence))
- (begin
- (set! crosses (+ crosses 1))
- (set! last-cross i)
- (set! sum 0.0))))
+ (> samp1 0.0)
+ (> (- i last-cross) 4)
+ (> sum silence))
+ (begin
+ (set! crosses (+ crosses 1))
+ (set! last-cross i)
+ (set! sum 0.0)))
(set! sum (+ sum (abs samp0)))
- (set! samp0 samp1))))
+ (set! samp0 samp1)))
crosses))
(define (env-add s0 s1 samps)
- (let ((data (make-vct samps))
+ (let ((data (make-float-vector samps))
(x 1.0)
(xinc (/ 1.0 samps))
(sr0 (make-sampler (floor s0)))
(sr1 (make-sampler (floor s1))))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
- (vct-set! data i (+ (* x (next-sample sr0))
- (* (- 1.0 x) (next-sample sr1))))
- (set! x (+ x xinc))))
+ (set! (data i) (+ (* x (next-sample sr0))
+ (* (- 1.0 x) (next-sample sr1))))
+ (set! x (+ x xinc)))
data))
(as-one-edit
@@ -86,20 +84,18 @@
(sample-sound snd chn)
(let* ((crosses (crossings))
- (cross-samples (make-vct crosses))
- (cross-weights (make-vct crosses))
- (cross-marks (make-vct crosses))
- (cross-periods (make-vct crosses)))
- (run
+ (cross-samples (make-float-vector crosses))
+ (cross-weights (make-float-vector crosses))
+ (cross-marks (make-float-vector crosses))
+ (cross-periods (make-float-vector crosses)))
(let* ((sr0 (make-sampler 0 snd chn)) ;; get cross points (sample numbers)
(samp0 (next-sample sr0))
- (len (frames))
+ (len (framples))
(sum 0.0)
(last-cross 0)
(cross 0)
- (silences 0)
(silence (* extension .001)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
(let ((samp1 (next-sample sr0)))
(if (and (<= samp0 0.0)
@@ -109,83 +105,82 @@
(begin
(set! last-cross i)
(set! sum 0.0)
- (vct-set! cross-samples cross i)
+ (set! (cross-samples cross) i)
(set! cross (+ cross 1))))
(set! sum (+ sum (abs samp0)))
- (set! samp0 samp1)))))
+ (set! samp0 samp1))))
;; now run through crosses getting period match info
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (- crosses 1)))
- (let* ((start (floor (vct-ref cross-samples i)))
- (autolen 0))
+ (let ((start (floor (cross-samples i)))
+ (autolen 0))
(let* ((s0 start)
- (pow2 (ceiling (/ (log (* extension (/ (srate snd) 40.0))) (log 2))))
+ (pow2 (ceiling (log (* extension (/ (srate snd) 40.0)) 2)))
(fftlen (floor (expt 2 pow2)))
(len4 (/ fftlen 4))
- (data (make-vct fftlen))
- (reader (make-sampler (floor s0))))
- (do ((j 0 (+ 1 j)))
- ((= j fftlen))
- (let ((val (next-sample reader)))
- (vct-set! data j val)))
+ (data (samples (floor s0) fftlen)))
(autocorrelate data)
(set! autolen 0)
(let ((happy #f))
(do ((j 1 (+ 1 j)))
((or happy (= j len4)))
- (if (and (< (vct-ref data j) (vct-ref data (+ j 1)))
- (> (vct-ref data (+ j 1)) (vct-ref data (+ j 2))))
+ (if (and (< (data j) (data (+ j 1)))
+ (> (data (+ j 1)) (data (+ j 2))))
(begin
(set! autolen (* j 2))
(set! happy #t))))))
(let* ((next-start (+ start autolen))
(min-i (+ i 1))
- (min-samps (floor (abs (- (vct-ref cross-samples min-i) next-start)))))
- (do ((k (+ i 2) (+ 1 k)))
- ((= k (min crosses (+ i zeros-checked))))
- (let ((dist (floor (abs (- (vct-ref cross-samples k) next-start)))))
+ (min-samps (floor (abs (- (cross-samples min-i) next-start))))
+ (mink (min crosses (+ i zeros-checked))))
+ (do ((k (+ i 2) (+ k 1)))
+ ((= k mink))
+ (let ((dist (floor (abs (- (cross-samples k) next-start)))))
(if (< dist min-samps)
(begin
(set! min-samps dist)
(set! min-i k)))))
- (let* ((current-mark min-i)
- (current-min 0.0))
+ (let ((current-mark min-i)
+ (current-min 0.0))
(let* ((s0 start)
- (s1 (floor (vct-ref cross-samples current-mark)))
+ (s1 (floor (cross-samples current-mark)))
(len autolen)
(sr0 (make-sampler (floor s0)))
(sr1 (make-sampler (floor s1)))
- (ampsum 0.0)
- (diffsum 0.0))
- (do ((i 0 (+ 1 i)))
+ (ampsum (make-one-pole 1.0 -1.0))
+ (diffsum (make-one-pole 1.0 -1.0))
+ (samp0 0.0))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((samp0 (next-sample sr0))
- (samp1 (next-sample sr1)))
- (set! ampsum (+ ampsum (abs samp0)))
- (set! diffsum (+ diffsum (abs (- samp1 samp0))))))
+ (set! samp0 (next-sample sr0))
+ (one-pole ampsum (abs samp0))
+ (one-pole diffsum (abs (- (next-sample sr1) samp0))))
+ (set! diffsum (one-pole diffsum 0.0))
+ (set! ampsum (one-pole ampsum 0.0))
(if (= diffsum 0.0)
(set! current-min 0.0)
(set! current-min (/ diffsum ampsum))))
(set! min-samps (round (* 0.5 current-min)))
(let ((top (min (- crosses 1) current-mark (+ i zeros-checked))))
- (do ((k (+ i 1) (+ 1 k)))
+ (do ((k (+ i 1) (+ k 1)))
((= k top))
(let ((wgt 0.0))
(let* ((s0 start)
- (s1 (floor (vct-ref cross-samples k)))
+ (s1 (floor (cross-samples k)))
(len autolen)
(sr0 (make-sampler (floor s0)))
(sr1 (make-sampler (floor s1)))
- (ampsum 0.0)
- (diffsum 0.0))
- (do ((i 0 (+ 1 i)))
+ (ampsum (make-one-pole 1.0 -1.0))
+ (diffsum (make-one-pole 1.0 -1.0))
+ (samp0 0.0))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((samp0 (next-sample sr0))
- (samp1 (next-sample sr1)))
- (set! ampsum (+ ampsum (abs samp0)))
- (set! diffsum (+ diffsum (abs (- samp1 samp0))))))
+ (set! samp0 (next-sample sr0))
+ (one-pole ampsum (abs samp0))
+ (one-pole diffsum (abs (- (next-sample sr1) samp0))))
+ (set! diffsum (one-pole diffsum 0.0))
+ (set! ampsum (one-pole ampsum 0.0))
(if (= diffsum 0.0)
(set! wgt 0.0)
(set! wgt (/ diffsum ampsum))))
@@ -194,19 +189,16 @@
(set! min-samps (floor wgt))
(set! min-i k))))))
(if (not (= current-mark min-i))
+ (set! (cross-weights i) 1000.0) ; these are confused, so effectively erase them
(begin
- ;; these are confused, so effectively erase them
- (vct-set! cross-weights i 1000.0)
- )
- (begin
- (vct-set! cross-weights i current-min)
- (vct-set! cross-marks i current-mark)
- (vct-set! cross-periods i (- (vct-ref cross-samples current-mark) (vct-ref cross-samples i)))
+ (set! (cross-weights i) current-min)
+ (set! (cross-marks i) current-mark)
+ (set! (cross-periods i) (- (cross-samples current-mark) (cross-samples i)))
))
))
- )))
+ ))
;; now sort weights to scatter the changes as evenly as possible
- (let* ((len (frames snd chn))
+ (let* ((len (framples snd chn))
(adding (> stretch 1.0))
(samps (floor (* (abs (- stretch 1.0)) len)))
(needed-samps (if adding samps (min len (* samps 2))))
@@ -214,42 +206,41 @@
(mult 1)
(curs 0)
(weights (length cross-weights))
- (edits (make-vct weights)))
- (run
+ (edits (make-float-vector weights)))
(do ()
((or (= curs weights) (>= handled needed-samps)))
;; need to find (more than) enough splice points to delete samps
(let ((best-mark -1)
(old-handled handled))
(let ((cur 0)
- (curmin (vct-ref cross-weights 0))
+ (curmin (cross-weights 0))
(len (length cross-weights)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (if (< (vct-ref cross-weights i) curmin)
+ (if (< (cross-weights i) curmin)
(begin
(set! cur i)
- (set! curmin (vct-ref cross-weights i)))))
+ (set! curmin (cross-weights i)))))
(set! best-mark cur))
- (set! handled (+ handled (floor (vct-ref cross-periods best-mark))))
+ (set! handled (+ handled (floor (cross-periods best-mark))))
(if (or (< handled needed-samps)
(< (- handled needed-samps) (- needed-samps old-handled)))
(begin
- (vct-set! edits curs best-mark)
+ (set! (edits curs) best-mark)
(set! curs (+ 1 curs))))
- (vct-set! cross-weights best-mark 1000.0)))
- )
+ (set! (cross-weights best-mark) 1000.0)))
+
(if (>= curs weights)
(set! mult (ceiling (/ needed-samps handled))))
(let ((changed-len 0)
(weights (length cross-weights)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (= i curs) (> changed-len samps)))
- (let* ((best-mark (floor (vct-ref edits i)))
- (beg (floor (vct-ref cross-samples best-mark)))
- (next-beg (floor (vct-ref cross-samples (floor (vct-ref cross-marks best-mark)))))
- (len (floor (vct-ref cross-periods best-mark))))
+ (let* ((best-mark (floor (edits i)))
+ (beg (floor (cross-samples best-mark)))
+ (next-beg (floor (cross-samples (floor (cross-marks best-mark)))))
+ (len (floor (cross-periods best-mark))))
(if (> len 0)
(if adding
(let ((new-samps
@@ -258,18 +249,18 @@
(add-named-mark beg (format #f "~D:~D" i (floor (/ len extension)))))
(insert-samples beg len new-samps)
(if (> mult 1)
- (do ((k 1 (+ 1 k)))
+ (do ((k 1 (+ k 1)))
((= k mult))
(insert-samples (+ beg (* k len)) len new-samps)))
(set! changed-len (+ changed-len (* mult len)))
(do ((j 0 (+ 1 j)))
((= j weights))
- (let ((curbeg (floor (vct-ref cross-samples j))))
+ (let ((curbeg (floor (cross-samples j))))
(if (> curbeg beg)
- (vct-set! cross-samples j (+ curbeg len))))))
+ (set! (cross-samples j) (+ curbeg len))))))
(begin
- (if (>= beg (frames))
- (snd-print (format #f "trouble at ~D: ~D of ~D~%" i beg (frames))))
+ (if (>= beg (framples))
+ (snd-print (format #f "trouble at ~D: ~D of ~D~%" i beg (framples))))
(if show-details
(add-named-mark (- beg 1) (format #f "~D:~D" i (floor (/ len extension)))))
(delete-samples beg len)
@@ -277,17 +268,17 @@
(let ((end (+ beg len)))
(do ((j 0 (+ 1 j)))
((= j weights))
- (let ((curbeg (floor (vct-ref cross-samples j))))
+ (let ((curbeg (floor (cross-samples j))))
(if (> curbeg beg)
(if (< curbeg end)
- (vct-set! cross-periods j 0)
- (vct-set! cross-samples j (- curbeg len))))))))))))
+ (set! (cross-periods j) 0)
+ (set! (cross-samples j) (- curbeg len))))))))))))
(if show-details
(snd-print (format #f "wanted: ~D, got ~D~%" (floor samps) (floor changed-len)))))
))
;; and return to original srate
(unsample-sound snd chn)
(if show-details
- (snd-print (format #f "~A -> ~A (~A)~%" (frames snd chn 0) (frames snd chn) (floor (* stretch (frames snd chn 0))))))
+ (snd-print (format #f "~A -> ~A (~A)~%" (framples snd chn 0) (framples snd chn) (floor (* stretch (framples snd chn 0))))))
) ; end of as-one-edit thunk
(format #f "rubber-sound ~A" stretch)))
diff --git a/run.c b/run.c
deleted file mode 100644
index 0af2cd5..0000000
--- a/run.c
+++ /dev/null
@@ -1,17372 +0,0 @@
-/* run macro
- *
- * Rather than write/compile (via gcc) a C source file, as in CL/CLM, this
- * produces the intermediate "triples" on the fly, packaging them into
- * a "program" (a list of triples), and precomputing all function, program,
- * and data addresses.
- *
- * The evaluator is eval_ptree. The code walker is walk. A program
- * is a list of triples. Each triple has a function pointer and a
- * pointer to addresses of arguments and data. There are two special addresses:
- * the program counter (PC) and the termination flag (pt->all_done).
- *
- * Snd optimization flag determines how safe we try to be:
- * 0: no use of ptrees at all (fallback on Scheme)
- * 6: all opts
- *
- *
- * exported:
- * (static struct ptree *form_to_ptree(s7_pointer code) parse code, returning pointer to tree (a list) or null if code has something we can't handle)
- * struct ptree *form_to_ptree_1_f(s7_pointer code) -- (1 arg) adds type check that result is mus_float_t
- * struct ptree *form_to_ptree_0_f(s7_pointer code) -- (no args) adds type check that result is mus_float_t
- * struct ptree *form_to_ptree_1_b(s7_pointer code) -- (1 arg) adds type check that result is boolean
- * mus_float_t evaluate_ptree_1f2f(struct ptree *tree, mus_float_t arg)
- * evaluate ptree passing it the single mus_float_t arg, returning a mus_float_t result
- * mus_float_t evaluate_ptree_0f2f(struct ptree *tree, mus_float_t arg)
- * evaluate ptree (no args), returning a mus_float_t result
- * mus_float_t evaluate_ptree_1f2b(struct ptree *tree, mus_float_t arg)
- * evaluate ptree passing it the single mus_float_t arg, returning a boolean result
- * void free_ptree(struct ptree *pt)
- * release resources allocated to ptree
- *
- *
- * currently handled, at least partially:
- *
- * types: float int char string boolean symbol keyword vct snd_fd mus_any vector function list
- *
- * lambda (use 'declare' to set arg types)
- * call-with-current-continuation call/cc
- * if begin or and not let let* set! cond do define case[int keys]
- * * + - / > < >= <= = max min 1+ 1-
- * sin cos tan abs log exp expt acos asin atan sqrt cosh sinh tanh j0 j1 jn y0 y1 yn i0 erf erfc lgamma asinh acosh atanh
- * boolean? exact? inexact? integer? real? number? quote
- * odd? even? zero? positive? negative? eq? eqv? equal? symbol? symbol->string
- * round truncate floor ceiling exact->inexact inexact->exact
- * gcd lcm logand logior logxor lognot ash modulo remainder quotient random
- * char? char=? char<? char>? char<=? char>=? and char-ci*
- * char-alphabetic? char-numeric? char-lower-case? char-upper-case? char-whitespace?
- * char-upcase char-downcase char->integer integer->char
- * string? string string-length string-copy string-fill! string-ref string-set!
- * make-string substring string-append string=? string<=? string>=? string<? string>? and string-ci*
- * display number->string format
- * make-vector if 2nd arg exists and is float
- * list ops that reference constant lists and return something we can handle (like a number)
- * throw with just the 1st arg (experimental...)
- *
- * various sndlib, clm, snd, and s7 functions
- *
- * limitations:
- * variables can have only one type, the type has to be ascertainable somehow at run time (similarly for vector elements)
- * some variables (imported from outside our context) cannot be set
- * no recursion (could be added with some pain)
- * no complex, ratio, bignum (but we use 64-bit ints)
- * no pointer aliasing (i.e. vct var set to alias another vct var etc -- GC confusion otherwise)
- * no apply or eval (we need to know at parse time what we are trying to do -- actually these might be doable)
- * no map or for-each (these need lists, but for-each's lists aren't changing...)
- *
- * whenever the code-walker or tree initializer finds something it is unhappy about,
- * it returns an error indication, and the caller should fallback on Scheme's evaluator.
- *
- * so where does the speed-up come from? We're not getting/freeing any Scheme memory so the gc is (well, almost) never
- * triggered, we're doing math ops direct, no function args are cons'd, no run-time types are checked, no values are boxed/unboxed,
- * no symbols are looked-up in the current environment, wherever possible we pre-convert
- * args to same type (i.e. int->float done just once, if possible)
- *
- * (add-hook! optimization-hook (lambda (n) (snd-display "opt: ~A~%" n)))
- */
-
-/* make-env needs vct args because '(...) and (list...) return #f (') or a parser complaint (list).
- * currently make-rand|-interp distribution arg (an env) can't be a vct
- */
-
-/* complex number support for run
- * 3+4i real-part imag-part make-rectangular make-polar angle magnitude complex? real? declare case
- * complex.h: ccos csin ctan cacos casin catan ccosh csinh ctanh cacosh casinh catanh cexp clog cabs cpow csqrt
- * carg[angle] creal cimag, complex double _Complex_I
- * all arithmetic needs extra complex checks etc
- * would be nice to have gens accept/return complex values, but outa? Jn? [as arg=>In]
- *
- * would it simplify variable handling to store everything as xen_value?
- *
- * TODO: this doesn't get optimized yet: (set! ((mus-data gen) 123) .1)
- * but the ref side does work: (let ((fr (frame .1 .2 .3))) (run (lambda () ((mus-data fr) 0))))
- * set! needs to look down a level if caar is a list
- * an example is sample-pvoc3 in clm23.scm: (vct-set! (phase-vocoder-amps sr) k ...)
- *
- * TODO: run doesn't always warn about a closure (explicit gen basically) -- if it's used directly,
- * there's no warning, but it doesn't handle the closed-over variables correctly
- * SOMEDAY: generics like length
- * SOMEDAY: *stderr* in run format
- * TODO: we miss shadowed funcs: (spectrum k) where spectrum is a vct complains about args to func spectrum
- * can this be fixed by checking symbol-value before using the built-in walker?
- * perhaps we can access s7 globals directly -- no need to copy each way for ints/dbls/strings (if default types are used in s7)
- */
-
-
-/* some timings (I keep losing these stats, so I'll put them here for safekeeping, "*"=not optimizable)
- * valgrind --tool=callgrind snd ws.scm [etc -- no stats, not to snd, *clm-output-safety*=1]
- *
- * test 10.4 (10.7?) 11.4 11.10
- *
- * (with-sound () (fm-violin 0 20 440 .1)) 1068 642 561 528
- * (with-sound (:channels 2) (fm-violin 0 20 440 .1 :degree 45)) 1228 764 687 570
- * (with-sound (:reverb jc-reverb) (fm-violin 0 20 440 .1)) 2577 1455 1335 1153
- * (with-sound (:reverb nrev) (fm-violin 0 20 440 .1)) 2983 1812 1685 1503
- * (with-sound () (p 0 3)) 91020* 3011 2828 2817
- * (with-sound () (expandn 0 10 "oboe.snd" 1 :expand 4)) 1228 526 464 456
- * (with-sound () (calling-all-animals)) 16359 11684 10306 9841
- * (with-sound () (pins 0 3 "oboe.snd" 1.0 :max-peaks 8)) 1207 783 660 700
- * (load "popi.scm") 11042 6391 5923 4756
- *
- * (with-sound () 1015 641 562 674
- * (singer 0 .1
- * (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01)
- * (list .6 oo.shp test.glt 523.0 .7 .1 .01))))
- *
- * (with-sound (:channels 2) 206 139 93 107
- * (let ((file "oboe.snd"))
- * (grani 0 1 .5 "oboe.snd"
- * :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0))))
- *
- * (with-sound () 7120 5069 4064 3996
- * (do ((i 0 (+ i 1)))
- * ((= i 10000))
- * (fm-violin (* i .001) .01 440 .001)))
- *
- * (with-sound (:channels 2) 283 220 158 167
- * (fullmix "pistol.snd" 0 2 0 #f .5)
- * (fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5)))))
- *
- * 1st case in clm-ins.scm: 12201 1138 1043 968
- */
-
-#include <mus-config.h>
-
-#if (defined(__GNUC__)) && (!(defined(__cplusplus)))
- #define _GNU_SOURCE
- /* this is needed to get the vasprintf declaration */
-#endif
-
-#if HAVE_SCHEME
-/* (almost) entire file is on this switch */
-
-#define WITH_COUNTERS 0
-
-#if USE_SND
- #include "snd.h"
-#endif
-
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <ctype.h>
-
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
-#else
- #if (!(defined(_MSC_VER)))
- #include <unistd.h>
- #endif
-#endif
-#if HAVE_STRING_H
- #include <string.h>
-#endif
-#include <stdarg.h>
-#if HAVE_PTHREAD_H
- #include <pthread.h>
-#endif
-
-#include "_sndlib.h"
-#include "xen.h"
-#include "clm.h"
-#include "sndlib2xen.h"
-#include "vct.h"
-#include "clm2xen.h"
-#include "clm-strings.h"
-#include "sndlib-strings.h"
-
-#define NOT_A_GC_LOC -1
-
-static int safe_strcmp(const char *s1, const char *s2)
-{
- int val;
- if (s1 == NULL)
- {
- if (s2 == NULL)
- return(0);
- return(-1);
- }
- if (s2 == NULL)
- return(1);
-
- val = strcmp(s1, s2); /* strcmp can return stuff like -97, but we want -1, 0, or 1 */
-
- if (val <= -1)
- return(-1);
- if (val >= 1)
- return(1);
- return(val);
-}
-
-
-static int safe_strcasecmp(const char *s1, const char *s2)
-{
- int len1, len2, len;
- int i;
- if (s1 == NULL)
- {
- if (s2 == NULL)
- return(0);
- return(-1);
- }
-
- if (s2 == NULL)
- return(1);
-
- len1 = strlen(s1);
- len2 = strlen(s2);
- len = len1;
- if (len1 > len2)
- len = len2;
-
- for (i = 0; i < len; i++)
- if (toupper(s1[i]) < toupper(s2[i]))
- return(-1);
- else
- {
- if (toupper(s1[i]) > toupper(s2[i]))
- return(1);
- }
-
- if (len1 < len2)
- return(-1);
- if (len1 > len2)
- return(1);
-
- return(0);
-}
-
-
-#define MAX_OPTIMIZATION 6
-static int current_optimization = MAX_OPTIMIZATION;
-
-static s7_pointer scheme_false, scheme_true, scheme_nil, scheme_undefined, scheme_zero;
-
-#define scheme_to_c_bool(Arg) ((Arg == scheme_true) ? true : false)
-#define scheme_cadr(Arg) s7_car(s7_cdr(Arg))
-#define scheme_caddr(Arg) s7_car(s7_cdr(s7_cdr(Arg)))
-#define scheme_cadddr(Arg) s7_car(s7_cdr(s7_cdr(s7_cdr(Arg))))
-#define scheme_cddr(Arg) s7_cdr(s7_cdr(Arg))
-#define scheme_cdddr(Arg) s7_cdr(s7_cdr(s7_cdr(Arg)))
-#define scheme_caar(a) s7_car(s7_car(a))
-#define scheme_cdar(a) s7_cdr(s7_car(a))
-#define scheme_cdadr(a) s7_cdr(s7_car(s7_cdr(a)))
-#define scheme_list_1(Arg) s7_cons(s7, Arg, scheme_nil)
-#define scheme_list_2(Arg1, Arg2) s7_cons(s7, Arg1, s7_cons(s7, Arg2, scheme_nil))
-
-static s7_pointer scheme_make_string(const char *str)
-{
- return((str) ? s7_make_string(s7, str) : scheme_false);
-}
-
-static s7_pointer optimization_hook;
-#define S_optimization_hook "optimization-hook"
-
-#define Int mus_long_t
-#define Double double
-
-#define DONT_OPTIMIZE 0
-#define COMPLEX_OK 2 /* this currently actually means "complex ignored" */
-#define GLOBAL_OK 3
-#define GLOBAL_SET_OK 5
-#define SOURCE_OK 6
-
-#define INTEGER_TO_STRING(a) s7_number_to_string(s7, s7_make_integer(s7, a), 10)
-#define INTEGER_TO_STRING_WITH_RADIX(a, b) s7_number_to_string(s7, s7_make_integer(s7, a), b)
-#define DOUBLE_TO_STRING(a) s7_number_to_string(s7, s7_make_real(s7, a), 10)
-#define DOUBLE_TO_STRING_WITH_RADIX(a, b) s7_number_to_string(s7, s7_make_real(s7, a), b)
-
-static s7_pointer walker_hash_table;
-#define scheme_walker(Obj) s7_hash_table_ref(s7, walker_hash_table, Obj)
-#define scheme_set_walker(Obj, Val) s7_hash_table_set(s7, walker_hash_table, Obj, Val)
-
-
-#define UNLIMITED_ARGS -1
-static s7_pointer walk_sym;
-
-/* find and set (Scheme) variable values */
-static void xen_symbol_name_set_value(const char *a, s7_pointer b)
-{
- s7_pointer var = scheme_false;
- var = s7_make_symbol(s7, a);
- if (var != scheme_false)
- s7_symbol_set_value(s7, var, b);
-}
-
-/* (define ho (let ((b 2)) (lambda (a) (+ a b))))
- * (run (lambda () (+ (ho 1) 2)))
- */
-
-static s7_pointer symbol_to_value(s7_pointer code, s7_pointer sym, bool *local)
-{
- /* local_var here is a check against GLOBAL_SET_OK -- not a big deal! */
- (*local) = false; /* just a guess... */
-
- return(s7_symbol_local_value(s7, sym, s7_cdr(code)));
-}
-
-static void symbol_set_value(s7_pointer code, s7_pointer sym, s7_pointer new_val)
-{
- s7_symbol_set_value(s7, sym, new_val);
-}
-
-
-/* -------------------------------------------------------------------------------- */
-
-
-enum {R_UNSPECIFIED, R_INT, R_FLOAT, R_BOOL, R_CHAR, R_STRING, R_LIST,
- R_SYMBOL, R_KEYWORD, R_FUNCTION, R_GOTO, R_VCT,
-#if USE_SND
- R_SAMPLER, R_SOUND, R_MIX, R_MARK, R_REGION,
-#endif
- R_SOUND_DATA, R_CLM,
- R_FLOAT_VECTOR, R_INT_VECTOR, R_VCT_VECTOR, R_LIST_VECTOR, R_CLM_VECTOR,
-
- /* next 8 are for walker arg checks, generator=built-in or defgenerator */
- R_NUMBER, R_VECTOR, R_XEN, R_NUMBER_CLM, R_NUMBER_VCT,
- R_NUMBER_SOUND_DATA, R_GENERATOR,
- R_ANY};
-
-#if USE_SND
-#define BUILT_IN_TYPES 33
-#else
-#define BUILT_IN_TYPES 27
-#endif
-
-static int last_type = R_ANY;
-static int type_names_size = BUILT_IN_TYPES;
-static const char **type_names = NULL;
-static const char *basic_type_names[BUILT_IN_TYPES] = {"unspecified", "int", "float", "boolean", "char", "string", "list",
- "symbol", "keyword", "function", "continuation", "vct",
-#if USE_SND
- "sampler", "sound", "mix", "mark", "region",
-#endif
- "sound-data", "clm",
- "float-vector", "int-vector", "vct-vector", "list-vector", "clm-vector",
- "number", "vector", "xen", "number or clm", "number or vct",
- "number or sound-data", "generator", "any"};
-
-static void init_type_names(void)
-{
- int i;
- type_names = (const char **)malloc(BUILT_IN_TYPES * sizeof(char *));
- for (i = 0; i < BUILT_IN_TYPES; i++)
- type_names[i] = basic_type_names[i];
-}
-
-
-static const char *type_name(int id)
-{
- if ((id >= R_UNSPECIFIED) && (id <= last_type))
- return(type_names[id]);
- return("unknown");
-}
-
-#if HAVE_PTHREADS
- static mus_lock_t new_type_lock = MUS_LOCK_INITIALIZER;
-#endif
-
-static int add_new_type(const char *new_type)
-{
- MUS_LOCK(&new_type_lock);
- if (last_type == (type_names_size - 1))
- {
- int i;
- type_names_size += 8;
- type_names = (const char **)realloc(type_names, type_names_size * sizeof(const char *));
- for (i = last_type + 1; i < type_names_size; i++) type_names[i] = NULL;
- }
- last_type++;
- type_names[last_type] = mus_strdup(new_type);
- MUS_UNLOCK(&new_type_lock);
-
- return(last_type);
-}
-
-
-static int name_to_type(const char *name)
-{
- int i;
- for (i = 0; i <= last_type; i++)
- if (mus_strcmp(name, type_names[i]))
- return(i);
- return(R_UNSPECIFIED);
-}
-
-
-#define POINTER_P(Type) (((Type) >= R_VCT) && ((Type) <= R_CLM_VECTOR)) /* exclude R_ANY */
-#define VECTOR_P(Type) (((Type) >= R_FLOAT_VECTOR) && ((Type) <= R_CLM_VECTOR))
-#define CLM_STRUCT_P(Type) ((Type) > R_ANY)
-
-typedef enum {R_VARIABLE, R_CONSTANT, R_TEMPORARY} xen_value_constant_t;
-typedef enum {DONT_NEED_RESULT, NEED_ANY_RESULT, NEED_INT_RESULT} walk_result_t;
-
-static bool run_warned = false;
-
-typedef struct {
- int type;
- int addr;
- xen_value_constant_t constant;
- bool gc;
-} xen_value;
-
-typedef struct {
- const char *name;
- xen_value *v;
- bool global, unclean, unsettable;
-} xen_var;
-
-typedef struct {
- char *name;
- xen_value *result, *jump;
- int loc;
-} continuation;
-
-typedef struct {
- int len, type; /* type is either clm-struct ref or a single type */
- xen_value **vals;
-} list;
-
-typedef struct {
- int length;
- union {
- Int *ints;
- mus_any **gens;
- vct **vcts;
- list **lists;
- } data;
-} vect;
-
-
-typedef struct ptree {
- bool all_done;
- struct triple **pc;
- struct triple **program;
- Int *ints;
- Double *dbls;
- int program_size, ints_size, dbls_size, triple_ctr, int_ctr, dbl_ctr;
- xen_var **vars;
- int vars_size, var_ctr;
- xen_var **global_vars;
- int global_vars_size, global_var_ctr;
- xen_value *result;
- int *args;
- int *default_args;
- int *arg_types;
- int arity;
- continuation **gotos;
- int goto_ctr, gotos_size;
- xen_value **gcs;
- int gc_ctr, gcs_size;
- int *gc_protected;
- int gc_protected_ctr, gc_protected_size;
- struct triple **initial_pc;
- s7_pointer code, form;
- int form_loc;
- int str_ctr, strs_size;
- char **strs;
- int vct_ctr, vcts_size;
- vct **vcts;
- int sd_ctr, sds_size;
- sound_data **sds;
- int clm_ctr, clms_size;
- mus_any **clms;
- int *clm_locs;
- int vect_ctr, vects_size;
- vect **vects;
- int list_ctr, lists_size;
- list **lists;
-#if USE_SND
- int sampler_ctr, samplers_size;
- snd_fd **samplers;
-#endif
- int fnc_ctr, fncs_size;
- struct ptree **fncs;
- int xen_ctr, xens_size;
- s7_pointer *xens;
- int xen_vars_size, xen_var_ctr;
- xen_value ***xen_vars;
- struct ptree *outer_tree;
- /* next needed by tree builders (temps) */
- int constants;
- bool float_result;
- walk_result_t walk_result;
- int *lambda_arg_types;
- int lambda_args;
- bool got_lambda; /* a temporary kludge?? */
-} ptree;
-
-/*
- * if we know in advance the arg types, it is cleaner to pass that as an automatic declare list to lambda_form,
- * rather than insisting on a declare form, but rewriting the lambda form to insert the declare seems clumsy.
- * Adding two or three extra args to walk is even clumsier, since this is a very rare special case, and using
- * global variables is prone to trouble if we have nested lambdas, so... we use the ptree fields lambda_arg_types
- * and lambda_args to pass this info in during the arg parsing in walk. An embedded lambda will have its
- * own embedded ptree, so we get the local variable effect from the ptree structure.
- */
-
-typedef struct triple {
- void (*function)(int *arg_addrs, ptree *pt);
- int *args, *types;
- bool no_opt;
- const char *op_name;
- int num_args;
-#if WITH_COUNTERS
- int func_loc;
-#endif
-} triple;
-
-
-typedef struct {
- void (*func)(int *args, ptree *pt);
- const char *func_name;
- void (*mult_func)(int *args, ptree *pt);
- const char *mult_func_name;
- void (*env_func)(int *args, ptree *pt);
- const char *env_func_name;
-} opt_ops;
-
-
-
-static int allocate_xen_vars(ptree *pt, int size)
-{
- int cur;
- cur = pt->xen_var_ctr;
- if (cur >= pt->xen_vars_size)
- {
- pt->xen_vars_size += 4;
- if (pt->xen_vars)
- {
- int i;
- pt->xen_vars = (xen_value ***)realloc(pt->xen_vars, pt->xen_vars_size * sizeof(xen_value **));
- for (i = cur; i < pt->xen_vars_size; i++)
- pt->xen_vars[i] = NULL;
- }
- else pt->xen_vars = (xen_value ***)calloc(pt->xen_vars_size, sizeof(xen_value **));
- }
- pt->xen_vars[pt->xen_var_ctr++] = (xen_value **)calloc(size, sizeof(xen_value *));
- return(cur);
-}
-
-
-static triple *free_triple(triple *trp)
-{
- if (trp->args) free(trp->args);
- trp->args = NULL;
- if (trp->types) free(trp->types);
- trp->types = NULL;
- free(trp);
- return(NULL);
-}
-
-static xen_value *make_xen_value(int typ, int address, xen_value_constant_t constant)
-{
- xen_value *v;
- v = (xen_value *)malloc(sizeof(xen_value));
- v->type = typ;
- v->addr = address;
- v->constant = constant;
- v->gc = false;
- return(v);
-}
-
-
-#if (!USE_SND)
-
-/* copy run_hook from snd-xen.c */
-XEN run_hook(s7_pointer hook, s7_pointer args, const char *caller)
-{
- int gc_loc;
- s7_pointer procs = XEN_HOOK_PROCEDURES(hook);
- gc_loc = s7_gc_protect(s7, args);
-
- while (procs != scheme_nil)
- {
- if (!(s7_is_eq(args, scheme_nil)))
- s7_call(s7, s7_car(procs), args);
- else s7_call(s7, s7_car(procs), scheme_nil);
- procs = s7_cdr(procs);
- }
-
- s7_gc_unprotect_at(s7, gc_loc);
- return(scheme_false);
-}
-
-#endif
-
-
-#if (!HAVE_VASPRINTF)
- #define OPTIMIZER_WARNING_BUFFER_SIZE 1024
- static char *optimizer_warning_buffer = NULL;
-#endif
-
-#ifdef __GNUC__
-static xen_value *run_warn(const char *format, ...) __attribute ((format (printf, 1, 2)));
-#endif
-
-static xen_value *run_warn(const char *format, ...)
-{
- run_warned = true;
- if (XEN_HOOKED(optimization_hook))
- {
- va_list ap;
- char *result;
-
- va_start(ap, format);
-
-#if HAVE_VASPRINTF
- if (vasprintf(&result, format, ap) == -1)
- result = NULL;
-#else
-
- if (!optimizer_warning_buffer)
- optimizer_warning_buffer = (char *)calloc(OPTIMIZER_WARNING_BUFFER_SIZE, sizeof(char));
-#if HAVE_VSNPRINTF
- vsnprintf(optimizer_warning_buffer, OPTIMIZER_WARNING_BUFFER_SIZE, format, ap);
-#else
- vsprintf(optimizer_warning_buffer, format, ap);
-#endif
-
- result = optimizer_warning_buffer;
-#endif
-
- va_end(ap);
-
- run_hook(optimization_hook,
- scheme_list_1(scheme_make_string(result)),
- S_optimization_hook);
-
-#if HAVE_VASPRINTF
- free(result);
-#endif
- }
- return(NULL); /* this is so we can insert the call into the error return call chain */
-}
-
-
-static xen_value *run_warn_with_free(char *str)
-{
- s7_pointer msg;
- run_warned = true;
- msg = scheme_make_string(str);
- free(str);
-
- if (XEN_HOOKED(optimization_hook))
- run_hook(optimization_hook,
- scheme_list_1(msg),
- S_optimization_hook);
-
- return(NULL);
-}
-
-
-static xen_value *copy_xen_value(xen_value *v)
-{
- return(make_xen_value(v->type, v->addr, v->constant));
-}
-
-
-static char *describe_xen_value(xen_value *v, ptree *pt);
-static char *describe_xen_value_1(int type, int addr, ptree *pt);
-static char *describe_xen_value_with_var_name(int type, int addr, ptree *pt);
-
-static char *describe_xen_var(xen_var *var, ptree *pt)
-{
- char *buf, *temp;
- if (var == NULL) return(mus_strdup("#<xen_var: null>"));
- temp = describe_xen_value_1(var->v->type, var->v->addr, pt);
- if (temp)
- {
- buf = (char *)calloc(strlen(var->name) + strlen(temp) + 32, sizeof(char));
- sprintf(buf, "%s: %s (%s%s%s)",
- var->name, temp,
- (var->global) ? "global" : "local",
- (var->unclean) ? " set" : "",
- (var->unsettable) ? " unsettable" : "");
- free(temp);
- }
- else buf = mus_strdup(var->name);
- return(buf);
-}
-
-
-static continuation *free_goto(continuation *c)
-{
- if (c)
- {
- if (c->name) free(c->name);
- if (c->result) free(c->result);
- if (c->jump) free(c->jump);
- free(c);
- }
- return(NULL);
-}
-
-
-static xen_var *find_var_in_ptree(ptree *pt, const char *name)
-{
- /* search backwards for shadowing */
- int i;
- for (i = pt->var_ctr - 1; i >= 0; i--)
- if ((pt->vars[i]) &&
- (mus_strcmp(pt->vars[i]->name, name)))
- return(pt->vars[i]);
- for (i = 0; i < pt->global_var_ctr; i++)
- if ((pt->global_vars[i]) &&
- (mus_strcmp(pt->global_vars[i]->name, name)))
- return(pt->global_vars[i]);
- return(NULL);
-}
-
-
-static xen_var *find_var_in_ptree_via_addr(ptree *pt, int type, int addr)
-{
- /* search backwards for shadowing */
- int i;
- for (i = pt->var_ctr - 1; i >= 0; i--)
- if ((pt->vars[i]) &&
- (pt->vars[i]->v->addr == addr) &&
- (pt->vars[i]->v->type == type))
- return(pt->vars[i]);
- for (i = 0; i < pt->global_var_ctr; i++)
- if ((pt->global_vars[i]) &&
- (pt->global_vars[i]->v->addr == addr) &&
- (pt->global_vars[i]->v->type == type))
- return(pt->global_vars[i]);
- return(NULL);
-}
-
-
-static char *str_append(char *oldstr, int *oldsize, char *newstr)
-{
- oldstr = mus_strcat(oldstr, newstr, oldsize);
- free(newstr);
- return(oldstr);
-}
-
-
-XEN mus_run_ptree_code(struct ptree *pt)
-{
- return(pt->form);
-}
-
-
-#if (SIZEOF_INT64_T == SIZEOF_LONG)
- #define INT_PT "i%d(%ld)"
- #define INT_STR "%ld"
-#else
- #define INT_PT "i%d(%lld)"
- #define INT_STR "%lld"
-#endif
-#define B2S(Arg) ((Arg) ? "#t" : "#f")
-#define GO_PT "cont%d(continuation)"
-
-
-static char *describe_triple(triple *trp, ptree *pt)
-{
- char *str = NULL;
- if (trp)
- {
- if (trp->args)
- {
- int i, size = 0;
- char **descrs;
- descrs = (char **)malloc(trp->num_args * sizeof(char *));
- for (i = 0; i < trp->num_args; i++)
- {
- descrs[i] = describe_xen_value_with_var_name(trp->types[i], trp->args[i], pt);
- size += (mus_strlen(descrs[i]) + 2);
- }
- str = (char *)calloc(size + mus_strlen(trp->op_name) + 8, sizeof(char));
- str = strcat(str, descrs[0]);
- str = strcat(str, " = ");
- str = strcat(str, trp->op_name);
- str = strcat(str, "(");
- for (i = 1; i < (trp->num_args - 1); i++)
- {
- str = strcat(str, descrs[i]);
- str = strcat(str, ", ");
- }
- if (trp->num_args > 1)
- str = strcat(str, descrs[trp->num_args - 1]);
- str = strcat(str, ")");
- for (i = 0; i < trp->num_args; i++)
- free(descrs[i]);
- free(descrs);
- }
- else
- {
- str = mus_strdup(trp->op_name);
- }
- }
- return(str);
-}
-
-
-static char *describe_ptree(ptree *pt, const char *space)
-{
- #define INT_STR_SIZE 32
- int i, size;
- char *temp = NULL;
- char *buf;
- Int *inner_ints;
- Double *inner_dbls;
- char **inner_strs;
- vct **inner_vcts;
- sound_data **inner_sds;
- mus_any **inner_clms;
- vect **inner_vects;
- list **inner_lists;
-#if USE_SND
- snd_fd **inner_samplers;
-#endif
- ptree **inner_fncs;
- s7_pointer *inner_xens;
- xen_value ***inner_xen_vars;
-
- size = 1024;
- buf = (char *)calloc(size, sizeof(char));
-
- inner_ints = pt->ints;
- inner_dbls = pt->dbls;
- inner_xen_vars = pt->xen_vars;
- inner_strs = pt->strs;
- inner_vcts = pt->vcts;
- inner_sds = pt->sds;
- inner_clms = pt->clms;
- inner_vects = pt->vects;
- inner_lists = pt->lists;
- inner_fncs = (ptree **)(pt->fncs);
- inner_xens = pt->xens;
-#if USE_SND
- inner_samplers = pt->samplers;
-#endif
- if (pt->outer_tree)
- {
- pt->ints = pt->outer_tree->ints;
- pt->dbls = pt->outer_tree->dbls;
- pt->strs = pt->outer_tree->strs;
- pt->vcts = pt->outer_tree->vcts;
- pt->sds = pt->outer_tree->sds;
- pt->clms = pt->outer_tree->clms;
- pt->vects = pt->outer_tree->vects;
- pt->lists = pt->outer_tree->lists;
- pt->fncs = pt->outer_tree->fncs;
- pt->xens = pt->outer_tree->xens;
-#if USE_SND
- pt->samplers = pt->outer_tree->samplers;
-#endif
- pt->xen_vars = pt->outer_tree->xen_vars;
- }
-
- buf = str_append(buf, &size, mus_format("\n%sints: %d, dbls: %d, triples: %d, vars: %d", space, pt->int_ctr, pt->dbl_ctr, pt->triple_ctr, pt->var_ctr));
- if (pt->strs_size > 0) buf = str_append(buf, &size, mus_format(", strs: %d", pt->str_ctr));
- if (pt->vcts_size > 0) buf = str_append(buf, &size, mus_format(", vcts: %d", pt->vct_ctr));
- if (pt->sds_size > 0) buf = str_append(buf, &size, mus_format(", sds: %d", pt->sd_ctr));
- if (pt->clms_size > 0) buf = str_append(buf, &size, mus_format(", clms: %d", pt->clm_ctr));
- if (pt->vects_size > 0) buf = str_append(buf, &size, mus_format(", vects: %d", pt->vect_ctr));
- if (pt->lists_size > 0) buf = str_append(buf, &size, mus_format(", lists: %d", pt->list_ctr));
- if (pt->fncs_size > 0) buf = str_append(buf, &size, mus_format(", fncs: %d", pt->fnc_ctr));
- if (pt->xens_size > 0) buf = str_append(buf, &size, mus_format(", xens: %d", pt->xen_ctr));
-#if USE_SND
- if (pt->samplers_size > 0) buf = str_append(buf, &size, mus_format(", rds: %d", pt->sampler_ctr));
-#endif
- if (pt->xen_vars_size > 0) buf = str_append(buf, &size, mus_format(", xenvars: %d", pt->xen_var_ctr));
-
- buf = str_append(buf, &size, mus_format("\n%s[", space));
-
- if (pt->int_ctr > 0)
- {
- for (i = 0; i < pt->int_ctr - 1; i++)
- {
- temp = (char *)calloc(INT_STR_SIZE, sizeof(char));
- mus_snprintf(temp, INT_STR_SIZE, INT_STR ", ", pt->ints[i]);
- buf = str_append(buf, &size, temp);
- }
- temp = (char *)calloc(INT_STR_SIZE, sizeof(char));
- mus_snprintf(temp, INT_STR_SIZE, INT_STR "]%s",
- pt->ints[pt->int_ctr - 1],
- (pt->dbl_ctr > 0) ? ", [" : "\n");
- buf = str_append(buf, &size, temp);
- }
-
- if (pt->dbl_ctr > 0)
- {
- for (i = 0; i < pt->dbl_ctr - 1; i++)
- {
- temp = (char *)calloc(INT_STR_SIZE, sizeof(char));
- mus_snprintf(temp, INT_STR_SIZE, "%.4f, ", pt->dbls[i]);
- buf = str_append(buf, &size, temp);
- }
- temp = (char *)calloc(INT_STR_SIZE, sizeof(char));
- mus_snprintf(temp, INT_STR_SIZE, "%.4f]\n", pt->dbls[pt->dbl_ctr - 1]);
- buf = str_append(buf, &size, temp);
- }
-
- buf = str_append(buf, &size, mus_strdup("\n"));
-
- for (i = 0; i < pt->var_ctr; i++)
- {
- temp = describe_xen_var(pt->vars[i], pt);
- buf = str_append(buf, &size, mus_format("%s[var %d]: %s\n", space, i, temp));
- free(temp);
- }
-
- for (i = 0; i < pt->global_var_ctr; i++)
- {
- temp = describe_xen_var(pt->global_vars[i], pt);
- buf = str_append(buf, &size, mus_format("%s%s\n", space, temp));
- free(temp);
- }
-
- if (pt->result)
- {
- temp = describe_xen_value_with_var_name(pt->result->type, pt->result->addr, pt);
- if (temp)
- {
- buf = str_append(buf, &size, mus_format("%sresult: %s\n\n", space, temp));
- free(temp);
- }
- }
-
- for (i = 0; i < pt->triple_ctr; i++)
- {
- temp = describe_triple(((triple **)(pt->program))[i], pt);
- if (temp)
- {
- buf = str_append(buf, &size, mus_format("%s%d: %s\n", space, i, temp));
- free(temp);
- }
- }
-
- pt->ints = inner_ints;
- pt->dbls = inner_dbls;
- pt->xen_vars = inner_xen_vars;
- pt->strs = inner_strs;
- pt->vcts = inner_vcts;
- pt->sds = inner_sds;
- pt->clms = inner_clms;
- pt->vects = inner_vects;
- pt->lists = inner_lists;
- pt->fncs = (struct ptree **)(inner_fncs);
- pt->xens = inner_xens;
-#if USE_SND
- pt->samplers = inner_samplers;
-#endif
- return(buf);
-}
-
-
-static char *describe_xen_value_1(int type, int addr, ptree *pt)
-{
- switch (type)
- {
- case R_BOOL: return(mus_format("b%d(%s)", addr, B2S(pt->ints[addr]))); break;
- case R_INT: return(mus_format(INT_PT , addr, pt->ints[addr])); break;
- case R_CHAR: return(mus_format("chr%d(#\\%c)", addr, (char)(pt->ints[addr]))); break;
- case R_STRING: return(mus_format("s%d(\"%s\")", addr, pt->strs[addr])); break;
- case R_FLOAT: return(mus_format("d%d(%.4f)", addr, pt->dbls[addr])); break;
- case R_GOTO: return(mus_format("continuation: " INT_PT , addr, pt->ints[addr])); break;
- case R_LIST: return(mus_format("list%d(%p)", addr, pt->lists[addr])); break;
-
- case R_SYMBOL:
- case R_KEYWORD:
- {
- char *temp = NULL, *str;
- if ((pt->xens) &&
- (pt->xens[addr] != scheme_undefined))
- str = mus_format("%s%d(%s)", (type == R_SYMBOL) ? "sym" : "key", addr, temp = s7_object_to_c_string(s7, pt->xens[addr]));
- else str = mus_format("%s%d=0", (type == R_SYMBOL) ? "sym" : "key", addr);
- if (temp) free(temp);
- return(str);
- }
-
- break;
-
- case R_FLOAT_VECTOR:
- case R_VCT:
- if ((pt->vcts) && (pt->vcts[addr]))
- {
- char *buf = NULL, *vstr = NULL;
- vstr = mus_vct_to_string(pt->vcts[addr]);
- buf = mus_format("vct%d(%p)", addr, vstr);
- if (vstr) free(vstr);
- return(buf);
- }
- else return(mus_format("vct%d(null)", addr));
- break;
-
- case R_SOUND_DATA:
- if ((pt->sds) && (pt->sds[addr]))
- {
- char *buf = NULL, *vstr = NULL;
- vstr = sound_data_to_string(pt->sds[addr]);
- buf = mus_format("sd%d(%p)", addr, vstr);
- if (vstr) free(vstr);
- return(buf);
- }
- else return(mus_format("sd%d(null)", addr));
- break;
-
-#if USE_SND
- case R_SAMPLER:
- if ((pt->samplers) && (pt->samplers[addr]))
- {
- char *buf = NULL, *vstr = NULL;
- vstr = sampler_to_string(pt->samplers[addr]);
- buf = mus_format("rd%d(%s)", addr, vstr);
- if (vstr) free(vstr);
- return(buf);
- }
- else return(mus_strdup("null"));
- break;
-#endif
-
- case R_CLM:
- if ((pt->clms) && (pt->clms[addr]))
- {
- char *str1, *str2;
- str1 = mus_describe(pt->clms[addr]);
- str2 = mus_format("clm%d(%s)", addr, str1);
- if (str1) free(str1);
- return(str2);
- }
- else return(mus_format("clm%d(null)", addr));
- break;
-
- case R_FUNCTION:
- if ((pt->fncs) && (pt->fncs[addr]))
- return(describe_ptree(((ptree **)(pt->fncs))[addr], " "));
- else return(mus_strdup("internal lambda?"));
- break;
-
- case R_LIST_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- case R_CLM_VECTOR:
- return(mus_format("vect%d(%p)", addr, pt->vects[addr]));
- break;
-
- case R_UNSPECIFIED:
- return(mus_strdup("#<unspecified>"));
- break;
-
- case R_XEN:
- return(mus_strdup("#<xen (scheme) value>"));
- break;
-
- default:
- if (CLM_STRUCT_P(type))
- return(mus_format("clm-struct%d(%s: %p)", addr, type_name(type), (pt->lists) ? pt->lists[addr] : NULL));
- else return(mus_format("?%d(unknown type: %d)", addr, type));
- break;
-
- }
- return(NULL);
-}
-
-
-static char *describe_xen_value_with_var_name(int type, int addr, ptree *pt)
-{
- xen_var *xv;
- xv = find_var_in_ptree_via_addr(pt, type, addr);
- if (xv)
- {
- char *temp, *res;
- temp = describe_xen_value_1(type, addr, pt);
- res = mus_format("[%s] %s", xv->name, temp);
- free(temp);
- return(res);
- }
-
- return(describe_xen_value_1(type, addr, pt));
-}
-
-
-static char *describe_xen_value(xen_value *v, ptree *pt)
-{
- return(describe_xen_value_1(v->type, v->addr, pt));
-}
-
-
-static ptree *make_ptree(int initial_data_size)
-{
- ptree *pt;
- pt = (ptree *)calloc(1, sizeof(ptree));
- pt->got_lambda = false;
- if (initial_data_size > 0)
- {
- pt->ints = (Int *)calloc(initial_data_size, sizeof(Int));
- pt->dbls = (Double *)calloc(initial_data_size, sizeof(Double));
- }
- pt->ints_size = initial_data_size;
- pt->dbls_size = initial_data_size;
- pt->int_ctr = 0;
- pt->code = scheme_false;
- pt->form = scheme_undefined;
- pt->form_loc = NOT_A_GC_LOC;
- return(pt);
-}
-
-
-static ptree *attach_to_ptree(ptree *pt)
-{
- /* share all environment tables -- memcpy? */
- ptree *new_tree;
- new_tree = (ptree *)calloc(1, sizeof(ptree));
- memcpy((void *)new_tree, (void *)pt, sizeof(ptree));
- new_tree->program_size = 0;
- new_tree->triple_ctr = 0;
- new_tree->result = NULL;
- new_tree->arity = 0;
- new_tree->code = scheme_false;
- new_tree->form = scheme_undefined;
- new_tree->form_loc = NOT_A_GC_LOC;
- if (pt->outer_tree)
- new_tree->outer_tree = pt->outer_tree;
- else new_tree->outer_tree = pt;
- new_tree->program = NULL;
- new_tree->constants = 0;
- new_tree->args = NULL;
- new_tree->default_args = NULL;
- new_tree->arg_types = NULL;
- new_tree->initial_pc = NULL;
- return(new_tree);
-}
-
-
-static void unattach_ptree(ptree *inner, ptree *outer)
-{
- /* these may have been created while in the embedded lambda */
- outer->ints = inner->ints;
- outer->dbls = inner->dbls;
- outer->vars = inner->vars;
- outer->global_vars = inner->global_vars;
- outer->gcs = inner->gcs;
- outer->gotos = inner->gotos;
- outer->strs = inner->strs;
- outer->vcts = inner->vcts;
- outer->sds = inner->sds;
- outer->clms = inner->clms;
- outer->clm_locs = inner->clm_locs;
- outer->vects = inner->vects;
- outer->lists = inner->lists;
- outer->fncs = inner->fncs;
- outer->xens = inner->xens;
-#if USE_SND
- outer->samplers = inner->samplers;
-#endif
- outer->xen_vars = inner->xen_vars;
-
- /* outer->gc_protected = inner->gc_protected; */
- /* not this one -- we always work back to the outermost tree in add_loc_to_protected_list, and
- * if we happen to need a reallocation of gc_protected during the inner ptree evaluation,
- * the outermost gc_protected is realloc'd, leaving the inner ptree's pointer invalid.
- */
-
- inner->ints = NULL;
- inner->dbls = NULL;
- inner->vars = NULL;
- inner->global_vars = NULL;
- inner->gcs = NULL;
- inner->gotos = NULL;
- inner->strs = NULL;
- inner->vcts = NULL;
- inner->sds = NULL;
- inner->clms = NULL;
- inner->clm_locs = NULL;
- inner->vects = NULL;
- inner->lists = NULL;
- inner->fncs = NULL;
- inner->xens = NULL;
-#if USE_SND
- inner->samplers = NULL;
-#endif
- inner->xen_vars = NULL;
- inner->gc_protected = NULL;
-
- outer->ints_size = inner->ints_size;
- outer->dbls_size = inner->dbls_size;
- outer->int_ctr = inner->int_ctr;
- outer->dbl_ctr = inner->dbl_ctr;
- outer->vars_size = inner->vars_size;
- outer->var_ctr = inner->var_ctr;
- outer->global_vars_size = inner->global_vars_size;
- outer->global_var_ctr = inner->global_var_ctr;
- outer->goto_ctr = inner->goto_ctr;
- outer->gotos_size = inner->gotos_size;
- outer->gc_ctr = inner->gc_ctr;
- outer->gcs_size = inner->gcs_size;
- outer->str_ctr = inner->str_ctr;
- outer->vct_ctr = inner->vct_ctr;
- outer->sd_ctr = inner->sd_ctr;
- outer->clm_ctr = inner->clm_ctr;
- outer->list_ctr = inner->list_ctr;
- outer->vect_ctr = inner->vect_ctr;
- outer->fnc_ctr = inner->fnc_ctr;
- outer->xen_ctr = inner->xen_ctr;
-#if USE_SND
- outer->sampler_ctr = inner->sampler_ctr;
-#endif
- outer->strs_size = inner->strs_size;
- outer->vcts_size = inner->vcts_size;
- outer->sds_size = inner->sds_size;
- outer->clms_size = inner->clms_size;
- outer->vects_size = inner->vects_size;
- outer->lists_size = inner->lists_size;
- outer->fncs_size = inner->fncs_size;
- outer->xens_size = inner->xens_size;
-#if USE_SND
- outer->samplers_size = inner->samplers_size;
-#endif
- outer->xen_var_ctr = inner->xen_var_ctr;
- outer->xen_vars_size = inner->xen_vars_size;
-
- inner->ints_size = 0;
- inner->dbls_size = 0;
- inner->int_ctr = 0;
- inner->dbl_ctr = 0;
- inner->vars_size = 0;
- inner->var_ctr = 0;
- inner->global_vars_size = 0;
- inner->global_var_ctr = 0;
- inner->goto_ctr = 0;
- inner->gotos_size = 0;
- inner->gc_ctr = 0;
- inner->gcs_size = 0;
- inner->str_ctr = 0;
- inner->vct_ctr = 0;
- inner->sd_ctr = 0;
- inner->clm_ctr = 0;
- inner->list_ctr = 0;
- inner->vect_ctr = 0;
- inner->fnc_ctr = 0;
- inner->xen_ctr = 0;
-#if USE_SND
- inner->sampler_ctr = 0;
-#endif
- inner->strs_size = 0;
- inner->vcts_size = 0;
- inner->sds_size = 0;
- inner->clms_size = 0;
- inner->vects_size = 0;
- inner->lists_size = 0;
- inner->fncs_size = 0;
- inner->xens_size = 0;
-#if USE_SND
- inner->samplers_size = 0;
-#endif
- inner->xen_var_ctr = 0;
- inner->xen_vars_size = 0;
-}
-
-static xen_value *add_empty_var_to_ptree(ptree *prog, int type);
-static xen_value *add_temporary_var_to_ptree(ptree *prog, int type);
-static s7_pointer xen_value_to_xen(ptree *pt, xen_value *v);
-static int def_clm_struct_field_type(int def_clm_struct_type, int field);
-static xen_value *add_value_to_ptree(ptree *prog, s7_pointer val, int type);
-
-
-static void list_into_list(ptree *pt, list *xl, s7_pointer lst)
-{
- /* load list from ptree back into its xen original */
- int i;
-
- /* fprintf(stderr,"set global %d to %s\n", xl->len, s7_object_to_c_string(s7, lst)); */
-
- for (i = 0; i < xl->len; i++)
- if (xl->vals[i])
- s7_list_set(s7, lst, i, xen_value_to_xen(pt, xl->vals[i]));
-}
-
-
-static void free_list(list *xl)
-{
- int i;
- if (xl->len > 0)
- {
- if (xl->vals)
- {
- for (i = 0; i < xl->len; i++)
- if (xl->vals[i])
- free(xl->vals[i]);
- free(xl->vals);
- xl->vals = NULL;
- }
- }
- xl->len = 0;
- free(xl);
-}
-
-static list *xen_to_list_with_type(ptree *pt, s7_pointer lst, int type) /* list element type or clm-struct */
-{
- list *xl = NULL;
-
- /* fprintf(stderr,"type: %s\n", type_name(type)); */
-
- xl = (list *)calloc(1, sizeof(list));
- xl->len = s7_list_length(s7, lst);
- xl->type = type;
-
- if (xl->len > 0)
- {
- int i;
- xl->vals = (xen_value **)calloc(xl->len, sizeof(xen_value *));
- for (i = 0; i < xl->len; i++)
- {
- s7_pointer val;
- val = s7_list_ref(s7, lst, i);
- /* fprintf(stderr, "load %s at %d\n", s7_object_to_c_string(s7, val), i); */
-
- if (s7_is_list(s7, val))
- {
- xl->len = i;
- /* fprintf(stderr, "reset len to %d\n", i); */
- break;
- }
-
- if (CLM_STRUCT_P(type))
- {
- int local_type;
- if (i == 0)
- local_type = R_SYMBOL;
- else local_type = def_clm_struct_field_type(type, i);
- if ((val != scheme_false) ||
- (local_type == R_BOOL))
- xl->vals[i] = add_value_to_ptree(pt, val, local_type);
- else xl->vals[i] = add_empty_var_to_ptree(pt, local_type);
- }
- else
- {
- if ((val != scheme_false) ||
- (type == R_BOOL))
- xl->vals[i] = add_value_to_ptree(pt, val, type);
- else xl->vals[i] = add_empty_var_to_ptree(pt, type);
- }
- }
- }
-
- /* fprintf(stderr,"return list "); */
-
- return(xl);
-}
-
-
-static list *xen_to_list(ptree *pt, s7_pointer lst)
-{
- /* load xen original into its list shadow */
- /* if first element of list is a clm-struct ref, use those types, else make sure all types are the same */
-
- int i, len, type = R_UNSPECIFIED; /* possible null list */
-
- len = s7_list_length(s7, lst);
-
- /* fprintf(stderr,"got list: %s %d\n", s7_object_to_c_string(s7, lst), len); */
-
- if (len > 0)
- {
- if ((s7_is_symbol(s7_car(lst))) &&
- (!(s7_is_keyword(s7_car(lst))))) /* keywords are symbols in s7 */
- {
- type = name_to_type(s7_symbol_name(s7_car(lst)));
-
- if (type == R_UNSPECIFIED)
- type = R_SYMBOL;
- }
- else type = mus_run_xen_to_run_type(s7_car(lst));
-
- if ((type == R_UNSPECIFIED) ||
- (type == R_LIST))
- {
- /* fprintf(stderr, "null because %s\n", type_name(type)); */
- return(NULL);
- }
-
- if (!(CLM_STRUCT_P(type)))
- {
- for (i = 1; i < len; i++)
- if (type != mus_run_xen_to_run_type(s7_list_ref(s7, lst, i)))
- return(NULL); /* we have to be able to predict each element type */
- }
- }
-
- return(xen_to_list_with_type(pt, lst, type));
-}
-
-
-static void list_vect_into_vector(ptree *prog, vect *v, s7_pointer vectr)
-{
- int len, i;
- len = s7_vector_length(vectr);
- for (i = 0; i < len; i++)
- list_into_list(prog, v->data.lists[i], s7_vector_ref(s7, vectr, i));
-}
-
-
-static void int_vect_into_vector(vect *v, s7_pointer vectr)
-{
- int len, i;
- len = s7_vector_length(vectr);
- for (i = 0; i < len; i++)
- s7_vector_set(s7, vectr, i, s7_make_integer(s7, v->data.ints[i]));
-}
-
-
-static void free_vect(vect *v, int type)
-{
- if (v)
- {
- switch (type)
- {
- case R_INT_VECTOR: if (v->data.ints) free(v->data.ints); break;
- case R_CLM_VECTOR: if (v->data.gens) free(v->data.gens); break;
- case R_VCT_VECTOR: if (v->data.vcts) free(v->data.vcts); break;
- case R_LIST_VECTOR: if (v->data.lists) free(v->data.lists); break;
- }
- free(v);
- }
-}
-
-
-static vct *vector_to_vct(s7_pointer vectr)
-{
- int len, i;
- vct *v;
- len = s7_vector_length(vectr);
- if (len == 0) return(NULL);
- v = mus_vct_make(len);
- for (i = 0; i < len; i++)
- if (s7_is_real(s7_vector_ref(s7, vectr, i)))
- v->data[i] = (mus_float_t)s7_number_to_real(s7_vector_ref(s7, vectr, i));
- else return(mus_vct_free(v));
- return(v);
-}
-
-
-static void vct_into_vector(vct *v, s7_pointer vectr)
-{
- int len, i;
- len = s7_vector_length(vectr);
- for (i = 0; i < len; i++)
- s7_vector_set(s7, vectr, i, s7_make_real(s7, v->data[i]));
-}
-
-
-static xen_var *free_xen_var(ptree *prog, xen_var *var)
-{
- s7_pointer val;
- bool local_var;
- if (var)
- {
- /* fprintf(stderr, "free var %s %s (global: %d, unclean: %d, opt: %d)\n", var->name, type_name(var->v->type), var->global, var->unclean, current_optimization); */
-
- /* if var->global, reflect new value into outer level version of the variable upon quit */
- if ((var->global) &&
- (var->unclean))
- {
- if (current_optimization < GLOBAL_SET_OK)
- {
- switch (var->v->type)
- {
- case R_FLOAT: xen_symbol_name_set_value(var->name, s7_make_real(s7, prog->dbls[var->v->addr])); break;
- case R_INT: xen_symbol_name_set_value(var->name, s7_make_integer(s7, prog->ints[var->v->addr])); break;
- case R_BOOL: xen_symbol_name_set_value(var->name, s7_make_boolean(s7, prog->ints[var->v->addr])); break;
- case R_STRING: xen_symbol_name_set_value(var->name, scheme_make_string(prog->strs[var->v->addr])); break;
- case R_CHAR: xen_symbol_name_set_value(var->name, s7_make_character(s7, (char)(prog->ints[var->v->addr]))); break;
-
- case R_KEYWORD:
- case R_SYMBOL: xen_symbol_name_set_value(var->name, prog->xens[var->v->addr]); break;
-
- case R_FLOAT_VECTOR:
- val = symbol_to_value(prog->code, s7_make_symbol(s7, var->name), &local_var);
- if (s7_is_vector(val))
- vct_into_vector(prog->vcts[var->v->addr], val);
- break;
-
- case R_INT_VECTOR:
- val = symbol_to_value(prog->code, s7_make_symbol(s7, var->name), &local_var);
- if (s7_is_vector(val))
- int_vect_into_vector(prog->vects[var->v->addr], val);
- break;
-
- default:
- /* if no global set, surely we shouldn't do anything? */
- break;
- }
- }
- else
- {
- switch (var->v->type)
- {
- case R_FLOAT: symbol_set_value(prog->code, s7_make_symbol(s7, var->name), s7_make_real(s7, prog->dbls[var->v->addr])); break;
- case R_INT: symbol_set_value(prog->code, s7_make_symbol(s7, var->name), s7_make_integer(s7, prog->ints[var->v->addr])); break;
- case R_BOOL: symbol_set_value(prog->code, s7_make_symbol(s7, var->name), s7_make_boolean(s7, prog->ints[var->v->addr])); break;
- case R_STRING: symbol_set_value(prog->code, s7_make_symbol(s7, var->name), scheme_make_string(prog->strs[var->v->addr])); break;
- case R_CHAR: symbol_set_value(prog->code, s7_make_symbol(s7, var->name), s7_make_character(s7, (char)(prog->ints[var->v->addr]))); break;
-
- case R_KEYWORD:
- case R_SYMBOL: symbol_set_value(prog->code, s7_make_symbol(s7, var->name), prog->xens[var->v->addr]); break;
-
- case R_FLOAT_VECTOR:
- val = symbol_to_value(prog->code, s7_make_symbol(s7, var->name), &local_var);
- if (s7_is_vector(val))
- vct_into_vector(prog->vcts[var->v->addr], val);
- break;
-
- case R_INT_VECTOR:
- val = symbol_to_value(prog->code, s7_make_symbol(s7, var->name), &local_var);
- if (s7_is_vector(val))
- int_vect_into_vector(prog->vects[var->v->addr], val);
- break;
-
- /* not clm_vector because it is already accessing the generators directly */
-
- case R_LIST_VECTOR:
- /* not yet functional because the unclean flag is not set (we're setting elements of lists within the vector) */
- val = symbol_to_value(prog->code, s7_make_symbol(s7, var->name), &local_var);
- if (s7_is_vector(val))
- list_vect_into_vector(prog, prog->vects[var->v->addr], val);
- break;
-
- default:
- if ((var->v->type == R_LIST) ||
- (CLM_STRUCT_P(var->v->type)))
- {
- val = symbol_to_value(prog->code, s7_make_symbol(s7, var->name), &local_var);
- if (s7_is_list(s7, val))
- list_into_list(prog, prog->lists[var->v->addr], val);
- }
- break;
-
- }
- }
- }
- if (var->v) free(var->v);
- free(var);
- }
- return(NULL);
-}
-
-
-static ptree *free_embedded_ptree(ptree *pt)
-{
- if (pt)
- {
- if (pt->program)
- {
- int i;
- for (i = 0; i < pt->program_size; i++)
- if (pt->program[i])
- ((triple **)(pt->program))[i] = free_triple(((triple **)(pt->program))[i]);
- free(pt->program);
- }
- if (pt->args) free(pt->args);
- if (pt->default_args) free(pt->default_args);
- if (pt->arg_types) free(pt->arg_types);
- if (pt->result) free(pt->result);
- free(pt);
- }
- return(NULL);
-}
-
-
-void mus_run_free_ptree(struct ptree *pt)
-{
- if (pt)
- {
- int i;
-
- /* free_xen_var depends (in vector case) on finding current (unfreed) data */
- if (pt->form != scheme_undefined) s7_gc_unprotect_at(s7, pt->form_loc);
- if (pt->vars)
- {
- for (i = 0; i < pt->var_ctr; i++)
- free_xen_var(pt, pt->vars[i]);
- free(pt->vars);
- }
- if (pt->global_vars)
- {
- for (i = 0; i < pt->global_var_ctr; i++)
- free_xen_var(pt, pt->global_vars[i]);
- free(pt->global_vars);
- }
- /* now it's safe to free stuff */
- if (pt->gc_ctr > 0)
- {
- /* if we allocated it, we free it */
- for (i = 0; i < pt->gc_ctr; i++)
- {
- xen_value *v;
- v = pt->gcs[i];
- if (v)
- {
- if (v->gc)
- {
- switch (v->type)
- {
- case R_FLOAT_VECTOR:
- case R_VCT:
- if (pt->vcts[v->addr])
- {
- int k;
- for (k = 0; k < pt->vct_ctr; k++)
- if ((k != v->addr) && (pt->vcts[k] == pt->vcts[v->addr]))
- pt->vcts[k] = NULL;
- pt->vcts[v->addr] = mus_vct_free(pt->vcts[v->addr]);
- }
- break;
-
- case R_SOUND_DATA:
- if (pt->sds[v->addr])
- {
- int k;
- for (k = 0; k < pt->sd_ctr; k++)
- if ((k != v->addr) && (pt->sds[k] == pt->sds[v->addr]))
- pt->sds[k] = NULL;
- sound_data_free(pt->sds[v->addr]);
- pt->sds[v->addr] = NULL;
- }
- break;
-#if USE_SND
- case R_SAMPLER:
- if (pt->samplers[v->addr])
- {
- int k;
- for (k = 0; k < pt->sampler_ctr; k++)
- if ((k != v->addr) && (pt->samplers[k] == pt->samplers[v->addr]))
- pt->samplers[k] = NULL;
- pt->samplers[v->addr] = free_snd_fd(pt->samplers[v->addr]);
- }
- break;
-#endif
- case R_FUNCTION:
- if (pt->fncs[v->addr])
- {
- int k;
- for (k = 0; k < pt->fnc_ctr; k++)
- if ((k != v->addr) && (pt->fncs[k] == pt->fncs[v->addr]))
- pt->fncs[k] = NULL;
- free_embedded_ptree(((ptree **)(pt->fncs))[v->addr]);
- pt->fncs[v->addr] = NULL;
- }
- break;
-
- case R_CLM:
- /* this currently can't happen -- all locally created gens are handled via xen */
-#if 0
- if (pt->clms[v->addr])
- {
- int k;
- for (k = 0; k < pt->clm_ctr; k++)
- if ((k != v->addr) && (pt->clms[k] == pt->clms[v->addr]))
- pt->clms[k] = NULL;
- mus_free(pt->clms[v->addr]);
- pt->clms[v->addr] = NULL;
- }
-#endif
- break;
-
- case R_LIST:
- if (pt->lists[v->addr])
- {
- int k;
- for (k = 0; k < pt->list_ctr; k++)
- if ((k != v->addr) && (pt->lists[k] == pt->lists[v->addr]))
- pt->lists[k] = NULL;
- free_list(pt->lists[v->addr]);
- pt->lists[v->addr] = NULL;
- }
- break;
-
- case R_LIST_VECTOR:
- if (pt->vects[v->addr])
- {
- int k;
- vect *vt;
- vt = pt->vects[v->addr];
- for (k = 0; k < pt->vect_ctr; k++)
- if ((k != v->addr) &&
- (pt->vects[k] == vt))
- pt->vects[k] = NULL;
- for (k = 0; k < vt->length; k++)
- if (vt->data.lists[k])
- free_list(vt->data.lists[k]);
- free_vect(vt, v->type);
- pt->vects[v->addr] = NULL;
- }
- break;
-
- case R_INT_VECTOR:
- case R_CLM_VECTOR:
- case R_VCT_VECTOR:
- if (pt->vects[v->addr])
- {
- int k;
- for (k = 0; k < pt->vect_ctr; k++)
- if ((k != v->addr) && (pt->vects[k] == pt->vects[v->addr]))
- pt->vects[k] = NULL;
- free_vect(pt->vects[v->addr], v->type);
- pt->vects[v->addr] = NULL;
- }
- break;
-
- case R_STRING:
- /* I don' think this currently can happen */
- if (pt->strs[v->addr])
- {
- free(pt->strs[v->addr]);
- pt->strs[v->addr] = NULL;
- }
- break;
-
- default:
- if (CLM_STRUCT_P(v->type))
- {
- if (pt->lists[v->addr])
- {
- int k;
- for (k = 0; k < pt->list_ctr; k++)
- if ((k != v->addr) && (pt->lists[k] == pt->lists[v->addr]))
- pt->lists[k] = NULL;
- free_list(pt->lists[v->addr]);
- pt->lists[v->addr] = NULL;
- }
- }
- break;
-
- }
- v->gc = false;
- }
- free(v);
- pt->gcs[i] = NULL;
- }
- }
- }
- if (pt->strs)
- {
- for (i = 0; i < pt->str_ctr; i++)
- if (pt->strs[i])
- {
- free(pt->strs[i]);
- pt->strs[i] = NULL;
- }
- free(pt->strs);
- pt->strs = NULL;
- }
- if (pt->xen_vars)
- {
- for (i = 0; i < pt->xen_var_ctr; i++)
- if (pt->xen_vars[i])
- {
- free(pt->xen_vars[i]); /* free the containing array */
- pt->xen_vars[i] = NULL;
- }
- free(pt->xen_vars);
- }
- if (pt->vcts)
- {
- free(pt->vcts);
- pt->vcts = NULL;
- }
- if (pt->sds)
- {
- free(pt->sds);
- pt->sds = NULL;
- }
- if (pt->clms)
- {
- free(pt->clms);
- pt->clms = NULL;
- }
- if (pt->clm_locs)
- {
- free(pt->clm_locs);
- pt->clm_locs = NULL;
- }
- if (pt->vects)
- {
- free(pt->vects);
- pt->vects = NULL;
- }
- if (pt->lists)
- {
- free(pt->lists);
- pt->lists = NULL;
- }
- if (pt->fncs)
- {
- free(pt->fncs);
- pt->fncs = NULL;
- }
- if (pt->xens)
- {
- free(pt->xens);
- pt->xens = NULL;
- }
-#if USE_SND
- if (pt->samplers)
- {
- free(pt->samplers);
- pt->samplers = NULL;
- }
-#endif
- if (pt->gc_protected)
- {
- for (i = 0; i < pt->gc_protected_ctr; i++)
- s7_gc_unprotect_at(s7, pt->gc_protected[i]);
- free(pt->gc_protected);
- pt->gc_protected = NULL;
- }
- if (pt->program)
- {
- for (i = 0; i < pt->program_size; i++)
- if (pt->program[i])
- ((triple **)(pt->program))[i] = free_triple(((triple **)(pt->program))[i]);
- free(pt->program);
- }
- if (pt->gcs) free(pt->gcs);
- if (pt->args) free(pt->args);
- if (pt->default_args) free(pt->default_args);
- if (pt->arg_types) free(pt->arg_types);
- if (pt->gotos)
- {
- for (i = 0; i < pt->gotos_size; i++)
- if (pt->gotos[i])
- free_goto(pt->gotos[i]);
- free(pt->gotos);
- }
- if (pt->result) free(pt->result);
- if (pt->ints) free(pt->ints);
- if (pt->dbls) free(pt->dbls);
- free(pt);
- }
-}
-
-
-static triple *add_triple_to_ptree(ptree *pt, triple *trp)
-{
- if (pt->triple_ctr >= pt->program_size)
- {
- if (pt->program_size == 0)
- {
- pt->program = (triple **)calloc(8, sizeof(triple *));
- pt->program_size = 8;
- }
- else
- {
- int i, old_size;
- old_size = pt->program_size;
- pt->program_size += 8;
- pt->program = (triple **)realloc(pt->program, pt->program_size * sizeof(triple *));
- for (i = old_size; i < pt->program_size; i++) pt->program[i] = NULL;
- }
- pt->pc = pt->program;
- pt->initial_pc = pt->program;
- }
- pt->program[pt->triple_ctr++] = trp;
- return(trp);
-}
-
-
-static int add_int_to_ptree(ptree *pt, Int value)
-{
- int cur;
- cur = pt->int_ctr++;
- if (cur >= pt->ints_size)
- {
- pt->ints_size += 8;
- pt->ints = (Int *)realloc(pt->ints, pt->ints_size * sizeof(Int));
- }
- pt->ints[cur] = value;
- return(cur);
-}
-
-
-static int add_dbl_to_ptree(ptree *pt, Double value)
-{
- int cur;
- cur = pt->dbl_ctr++;
- if (cur >= pt->dbls_size)
- {
- pt->dbls_size += 8;
- pt->dbls = (Double *)realloc(pt->dbls, pt->dbls_size * sizeof(Double));
- }
- pt->dbls[cur] = value;
- return(cur);
-}
-
-
-static int add_vct_to_ptree(ptree *pt, vct *value)
-{
- int cur;
- cur = pt->vct_ctr++;
- if (cur >= pt->vcts_size)
- {
- pt->vcts_size += 8;
- if (pt->vcts)
- {
- int i;
- pt->vcts = (vct **)realloc(pt->vcts, pt->vcts_size * sizeof(vct *));
- for (i = cur; i < pt->vcts_size; i++) pt->vcts[i] = NULL;
- }
- else pt->vcts = (vct **)calloc(pt->vcts_size, sizeof(vct *));
- }
- pt->vcts[cur] = value;
- return(cur);
-}
-
-
-static int add_sound_data_to_ptree(ptree *pt, sound_data *value)
-{
- int cur;
- cur = pt->sd_ctr++;
- if (cur >= pt->sds_size)
- {
- pt->sds_size += 8;
- if (pt->sds)
- {
- int i;
- pt->sds = (sound_data **)realloc(pt->sds, pt->sds_size * sizeof(sound_data *));
- for (i = cur; i < pt->sds_size; i++) pt->sds[i] = NULL;
- }
- else pt->sds = (sound_data **)calloc(pt->sds_size, sizeof(sound_data *));
- }
- pt->sds[cur] = value;
- return(cur);
-}
-
-
-static int add_loc_to_protected_list(ptree *pt, int loc);
-
-static int add_clm_to_ptree(ptree *pt, mus_any *value, s7_pointer orig)
-{
- int cur;
- cur = pt->clm_ctr++;
- if (cur >= pt->clms_size)
- {
- int i;
- pt->clms_size += 8;
- if (pt->clms)
- {
- pt->clms = (mus_any **)realloc(pt->clms, pt->clms_size * sizeof(mus_any *));
- pt->clm_locs = (int *)realloc(pt->clm_locs, pt->clms_size * sizeof(int));
- for (i = cur; i < pt->clms_size; i++) {pt->clms[i] = NULL; pt->clm_locs[i] = -1;}
- }
- else
- {
- pt->clms = (mus_any **)calloc(pt->clms_size, sizeof(mus_any *));
- pt->clm_locs = (int *)calloc(pt->clms_size, sizeof(int));
- for (i = 0; i < pt->clms_size; i++) pt->clm_locs[i] = -1;
- }
- }
- pt->clms[cur] = value;
- if (mus_xen_p(orig))
- {
- if (pt->clm_locs[cur] >= 0) s7_gc_unprotect_at(s7, pt->clm_locs[cur]);
- pt->clm_locs[cur] = add_loc_to_protected_list(pt, s7_gc_protect(s7, orig));
- }
- return(cur);
-}
-
-
-static int add_list_to_ptree(ptree *pt, list *value)
-{
- int cur;
-
- cur = pt->list_ctr++;
-
- /* fprintf(stderr, "add list %p at %d\n", value, cur); */
-
- if (cur >= pt->lists_size)
- {
- pt->lists_size += 8;
- if (pt->lists)
- {
- int i;
- pt->lists = (list **)realloc(pt->lists, pt->lists_size * sizeof(list *));
- for (i = cur; i < pt->lists_size; i++) pt->lists[i] = NULL;
- }
- else pt->lists = (list **)calloc(pt->lists_size, sizeof(list *));
- }
- pt->lists[cur] = value;
- return(cur);
-}
-
-
-static int add_vect_to_ptree(ptree *pt, vect *value)
-{
- int cur;
- cur = pt->vect_ctr++;
- if (cur >= pt->vects_size)
- {
- pt->vects_size += 8;
- if (pt->vects)
- {
- int i;
- pt->vects = (vect **)realloc(pt->vects, pt->vects_size * sizeof(vect *));
- for (i = cur; i < pt->vects_size; i++) pt->vects[i] = NULL;
- }
- else pt->vects = (vect **)calloc(pt->vects_size, sizeof(vect *));
- }
- pt->vects[cur] = value;
- return(cur);
-}
-
-
-static int add_fnc_to_ptree(ptree *pt, ptree *value)
-{
- int cur;
- cur = pt->fnc_ctr++;
- if (cur >= pt->fncs_size)
- {
- pt->fncs_size += 8;
- if (pt->fncs)
- {
- int i;
- pt->fncs = (struct ptree **)realloc(pt->fncs, pt->fncs_size * sizeof(ptree *));
- for (i = cur; i < pt->fncs_size; i++) pt->fncs[i] = NULL;
- }
- else pt->fncs = (struct ptree **)calloc(pt->fncs_size, sizeof(ptree *));
- }
- ((ptree **)(pt->fncs))[cur] = value;
- return(cur);
-}
-
-
-static int add_xen_to_ptree(ptree *pt, s7_pointer value)
-{
- int cur;
- cur = pt->xen_ctr++;
- if (cur >= pt->xens_size)
- {
- int i;
- pt->xens_size += 8;
- if (pt->xens)
- pt->xens = (s7_pointer *)realloc(pt->xens, pt->xens_size * sizeof(s7_pointer));
- else pt->xens = (s7_pointer *)calloc(pt->xens_size, sizeof(s7_pointer));
- for (i = cur; i < pt->xens_size; i++) pt->xens[i] = scheme_undefined;
- }
- pt->xens[cur] = value;
- return(cur);
-}
-
-#if USE_SND
-static int add_sampler_to_ptree(ptree *pt, snd_fd *value)
-{
- int cur;
- cur = pt->sampler_ctr++;
- if (cur >= pt->samplers_size)
- {
- pt->samplers_size += 8;
- if (pt->samplers)
- {
- int i;
- pt->samplers = (snd_fd **)realloc(pt->samplers, pt->samplers_size * sizeof(snd_fd *));
- for (i = cur; i < pt->samplers_size; i++) pt->samplers[i] = NULL;
- }
- else pt->samplers = (snd_fd **)calloc(pt->samplers_size, sizeof(snd_fd *));
- }
- pt->samplers[cur] = value;
- return(cur);
-}
-#endif
-
-
-static xen_var *new_xen_var(const char *name, xen_value *v)
-{
- xen_var *var;
- var = (xen_var *)calloc(1, sizeof(xen_var));
- var->name = name; /* this s7_symbol_name isn't going to be deallocated during a run */
- var->v = copy_xen_value(v);
- var->unclean = false;
- var->global = false;
- var->unsettable = false;
- return(var);
-}
-
-
-static void add_var_to_ptree(ptree *pt, const char *name, xen_value *v)
-{
- int cur;
- cur = pt->var_ctr;
- if (cur >= pt->vars_size)
- {
- pt->vars_size += 8;
- if (pt->vars)
- {
- int i;
- pt->vars = (xen_var **)realloc(pt->vars, pt->vars_size * sizeof(xen_var *));
- for (i = cur; i < pt->vars_size; i++) pt->vars[i] = NULL;
- }
- else pt->vars = (xen_var **)calloc(pt->vars_size, sizeof(xen_var *));
- }
- pt->vars[pt->var_ctr++] = new_xen_var(name, v);
-}
-
-
-static int add_outer_var_to_ptree(ptree *pt, const char *name, xen_value *v)
-{
- int cur;
- xen_var *var;
- cur = pt->global_var_ctr++;
- if (cur >= pt->global_vars_size)
- {
- pt->global_vars_size += 8;
- if (pt->global_vars)
- {
- int i;
- pt->global_vars = (xen_var **)realloc(pt->global_vars, pt->global_vars_size * sizeof(xen_var *));
- for (i = cur; i < pt->global_vars_size; i++) pt->global_vars[i] = NULL;
- }
- else pt->global_vars = (xen_var **)calloc(pt->global_vars_size, sizeof(xen_var *));
- }
- var = new_xen_var(name, v);
- var->global = true;
- pt->global_vars[cur] = var;
- return(cur);
-}
-
-
-static int add_string_to_ptree(ptree *pt, char *str)
-{
- int cur;
- cur = pt->str_ctr++;
- if (cur >= pt->strs_size)
- {
- pt->strs_size += 8;
- if (pt->strs)
- {
- int i;
- pt->strs = (char **)realloc(pt->strs, pt->strs_size * sizeof(char *));
- for (i = cur; i < pt->strs_size; i++)
- pt->strs[i] = NULL;
- }
- else pt->strs = (char **)calloc(pt->strs_size, sizeof(char *));
- }
- pt->strs[cur] = str;
- return(cur);
-}
-
-
-static xen_value *add_some_var_to_ptree(ptree *prog, int type, xen_value_constant_t ctype)
-{
- switch (type)
- {
- case R_BOOL: return(make_xen_value(type, add_int_to_ptree(prog, false), ctype)); break;
- case R_FLOAT: return(make_xen_value(type, add_dbl_to_ptree(prog, 0.0), ctype)); break;
- case R_STRING: return(make_xen_value(type, add_string_to_ptree(prog, NULL), ctype)); break;
- case R_CLM: return(make_xen_value(type, add_clm_to_ptree(prog, NULL, scheme_false), ctype)); break;
- case R_FUNCTION: return(make_xen_value(type, add_fnc_to_ptree(prog, NULL), ctype)); break;
-#if USE_SND
- case R_SAMPLER: return(make_xen_value(type, add_sampler_to_ptree(prog, NULL), ctype)); break;
- case R_SOUND:
- case R_MIX:
- case R_MARK:
- case R_REGION: return(make_xen_value(type, add_int_to_ptree(prog, 0), ctype)); break;
-#endif
- case R_SOUND_DATA: return(make_xen_value(type, add_sound_data_to_ptree(prog, NULL), ctype)); break;
- case R_FLOAT_VECTOR:
- case R_VCT: return(make_xen_value(type, add_vct_to_ptree(prog, NULL), ctype)); break;
- case R_SYMBOL:
- case R_KEYWORD: return(make_xen_value(type, add_xen_to_ptree(prog, scheme_false), ctype)); break;
- case R_LIST_VECTOR:
- case R_CLM_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR: return(make_xen_value(type, add_vect_to_ptree(prog, NULL), ctype)); break;
- default:
- if ((type == R_LIST) ||
- (CLM_STRUCT_P(type))) /* this can happen if we're declaring a function (or outer lambda) arg */
- return(make_xen_value(type, add_list_to_ptree(prog, NULL), ctype));
- break;
- }
- return(make_xen_value(type, add_int_to_ptree(prog, 0), ctype));
-}
-
-
-static xen_value *add_empty_var_to_ptree(ptree *prog, int type)
-{
- return(add_some_var_to_ptree(prog, type, R_VARIABLE));
-}
-
-
-static xen_value *add_temporary_var_to_ptree(ptree *prog, int type)
-{
- return(add_some_var_to_ptree(prog, type, R_TEMPORARY));
-}
-
-
-static xen_value *transfer_value(ptree *prog, xen_value *v)
-{
- /* if ((v->type == R_LIST) || (CLM_STRUCT_P(v->type))) fprintf(stderr,"transfer %s\n", type_name(v->type)); */
-
- switch (v->type)
- {
- case R_FLOAT:
- return(make_xen_value(v->type, add_dbl_to_ptree(prog, prog->dbls[v->addr]), R_VARIABLE));
- break;
-
- case R_STRING:
- return(make_xen_value(v->type, add_string_to_ptree(prog, mus_strdup(prog->strs[v->addr])), R_VARIABLE));
- break;
-
- case R_INT:
- case R_BOOL:
- case R_CHAR:
- case R_GOTO:
- return(make_xen_value(v->type, add_int_to_ptree(prog, prog->ints[v->addr]), R_VARIABLE));
- break;
-
- default:
- return(make_xen_value(v->type, v->addr, R_VARIABLE));
- break;
- }
- /* can't get here? */
- return(make_xen_value(v->type, add_int_to_ptree(prog, prog->ints[v->addr]), R_VARIABLE));
-}
-
-
-static void add_xen_value_to_gcs(ptree *pt, xen_value *v)
-{
- if (pt->gc_ctr >= pt->gcs_size)
- {
- int old_size;
- old_size = pt->gcs_size;
- pt->gcs_size += 4;
- if (old_size == 0)
- pt->gcs = (xen_value **)calloc(pt->gcs_size, sizeof(xen_value *));
- else
- {
- int i;
- pt->gcs = (xen_value **)realloc(pt->gcs, pt->gcs_size * sizeof(xen_value *));
- for (i = old_size; i < pt->gcs_size; i++) pt->gcs[i] = NULL;
- }
- }
- pt->gcs[pt->gc_ctr++] = v;
-}
-
-
-static void add_obj_to_gcs(ptree *pt, int type, int addr)
-{
- xen_value *v;
- v = make_xen_value(type, addr, R_VARIABLE);
- v->gc = true;
- add_xen_value_to_gcs(pt, v);
-}
-
-
-static int add_loc_to_protected_list(ptree *pt, int loc)
-{
- /* here the protected entities (clm gens and fft windows created within run) are created at eval time.
- * since we don't have an explicit list of such trees in the outer tree, we need to put the
- * protected loc in the outer-most tree.
- */
- int i;
- if (loc == NOT_A_GC_LOC) return(-1);
- while (pt->outer_tree) pt = pt->outer_tree;
- if (pt->gc_protected_ctr >= pt->gc_protected_size)
- {
- int old_size;
- old_size = pt->gc_protected_size;
- pt->gc_protected_size += 8;
- if (old_size == 0)
- pt->gc_protected = (int *)calloc(pt->gc_protected_size, sizeof(int));
- else pt->gc_protected = (int *)realloc(pt->gc_protected, pt->gc_protected_size * sizeof(int));
- for (i = old_size; i < pt->gc_protected_size; i++) pt->gc_protected[i] = NOT_A_GC_LOC;
- }
- pt->gc_protected[pt->gc_protected_ctr++] = loc;
- return(loc);
-}
-
-
-static vect *read_int_vector(s7_pointer vectr)
-{
- int len, i;
- vect *v;
- len = s7_vector_length(vectr);
- if (len == 0) return(NULL);
- v = (vect *)calloc(1, sizeof(vect));
- v->length = len;
- v->data.ints = (Int *)calloc(len, sizeof(Int));
- for (i = 0; i < len; i++)
- {
- s7_pointer datum;
- datum = s7_vector_ref(s7, vectr, i);
- if (s7_is_integer(datum))
- v->data.ints[i] = s7_number_to_integer(datum);
- else
- {
- char *temp = NULL;
- run_warn("initial int vector value at %d is %s: will try to abort ptree evaluation...", i, temp = s7_object_to_c_string(s7, datum));
- if (temp) free(temp);
- free(v->data.ints);
- free(v);
- return(NULL);
- }
- }
- return(v);
-}
-
-
-static vect *read_vct_vector(s7_pointer vectr)
-{
- int len, i;
- vect *v;
- len = s7_vector_length(vectr);
- if (len == 0) return(NULL);
- v = (vect *)calloc(1, sizeof(vect));
- v->length = len;
- v->data.vcts = (vct **)calloc(len, sizeof(vct *));
- for (i = 0; i < len; i++)
- {
- s7_pointer datum;
- datum = s7_vector_ref(s7, vectr, i);
- if (MUS_VCT_P(datum))
- v->data.vcts[i] = xen_to_vct(datum);
- else
- {
- char *temp = NULL;
- run_warn("initial vct vector value at %d is %s: will try to abort ptree evaluation...", i, temp = s7_object_to_c_string(s7, datum));
- if (temp) free(temp);
- free(v->data.vcts);
- free(v);
- return(NULL);
- }
- }
- return(v);
-}
-
-
-static vect *read_clm_vector(s7_pointer vectr)
-{
- int len, i;
- vect *v;
- len = s7_vector_length(vectr);
- if (len == 0) return(NULL);
- v = (vect *)calloc(1, sizeof(vect));
- v->length = len;
- v->data.gens = (mus_any **)calloc(len, sizeof(mus_any *));
- for (i = 0; i < len; i++)
- {
- s7_pointer datum;
- datum = s7_vector_ref(s7, vectr, i);
- if (mus_xen_p(datum))
- v->data.gens[i] = XEN_TO_MUS_ANY(datum);
- else
- {
- if (datum != scheme_false)
- {
- char *temp = NULL;
- run_warn("initial clm vector value at %d is %s: will try to abort ptree evaluation...", i, temp = s7_object_to_c_string(s7, datum));
- if (temp) free(temp);
- free(v->data.gens);
- free(v);
- return(NULL);
- }
- }
- }
- return(v);
-}
-
-
-static vect *read_list_vector(ptree *pt, s7_pointer vectr)
-{
- int len, i;
- vect *v;
- len = s7_vector_length(vectr);
- if (len == 0) return(NULL);
- v = (vect *)calloc(1, sizeof(vect));
- v->length = len;
- v->data.lists = (list **)calloc(len, sizeof(list *));
- for (i = 0; i < len; i++)
- {
- s7_pointer datum;
- datum = s7_vector_ref(s7, vectr, i);
- if (s7_is_list(s7, datum))
- {
- v->data.lists[i] = xen_to_list(pt, datum);
- add_list_to_ptree(pt, v->data.lists[i]);
- }
- else
- {
- char *temp = NULL;
- run_warn("initial list vector value at %d is %s: will try to abort ptree evaluation...", i, temp = s7_object_to_c_string(s7, datum));
- if (temp) free(temp);
- free(v->data.lists);
- free(v);
- return(NULL);
- }
- }
- return(v);
-}
-
-
-static vect *read_vector(ptree *pt, s7_pointer vector, int type)
-{
- switch (type)
- {
- case R_LIST_VECTOR: return(read_list_vector(pt, vector)); break;
- case R_INT_VECTOR: return(read_int_vector(vector)); break;
- case R_CLM_VECTOR: return(read_clm_vector(vector)); break;
- case R_VCT_VECTOR: return(read_vct_vector(vector)); break;
- }
- return(NULL);
-}
-
-
-int mus_run_xen_to_run_type(s7_pointer val)
-{
- /* fprintf(stderr, "get type of %s\n", s7_object_to_c_string(s7, val)); */
-
- if (s7_is_real(val))
- {
- if ((s7_is_exact(val)) && (s7_is_integer(val)))
- return(R_INT);
- return(R_FLOAT);
- }
-
- if (s7_is_boolean(val)) return(R_BOOL);
- if (MUS_VCT_P(val)) return(R_VCT);
- if (sound_data_p(val)) return(R_SOUND_DATA);
- if (mus_xen_p(val)) return(R_CLM);
- if (s7_is_character(val)) return(R_CHAR);
- if (s7_is_string(val)) return(R_STRING);
- if (s7_is_keyword(val)) return(R_KEYWORD);
- if (s7_is_symbol(val)) return(R_SYMBOL);
-
- if (s7_is_list(s7, val))
- {
- if ((val != scheme_nil) &&
- (s7_is_symbol(s7_car(val))))
- {
- int type;
- type = name_to_type(s7_symbol_name(s7_car(val)));
- if (CLM_STRUCT_P(type))
- return(type); /* might be a list of symbols?? */
- }
- if (s7_list_length(s7, val) >= 0) /* no dotted lists here */
- return(R_LIST);
- }
-
- if (s7_is_vector(val))
- {
- s7_pointer val0;
- val0 = s7_vector_ref(s7, val, 0);
- if (s7_is_real(val0))
- {
- if (s7_is_exact(val0))
- return(R_INT_VECTOR);
- return(R_FLOAT_VECTOR);
- }
- if (MUS_VCT_P(val0)) return(R_VCT_VECTOR);
- if ((mus_xen_p(val0)) || (val0 == scheme_false)) return(R_CLM_VECTOR);
- if (s7_is_list(s7, val0)) return(R_LIST_VECTOR);
- }
-
-#if USE_SND
- if (sampler_p(val)) return(R_SAMPLER);
- if (xen_sound_p(val)) return(R_SOUND);
- if (xen_region_p(val)) return(R_REGION);
- if (xen_mix_p(val)) return(R_MIX);
- if (xen_mark_p(val)) return(R_MARK);
-#endif
-
- return(R_UNSPECIFIED);
-}
-
-
-static xen_value *add_value_to_ptree(ptree *prog, s7_pointer val, int type)
-{
- xen_value *v = NULL;
- /* fprintf(stderr, "add %s as %s\n", s7_object_to_c_string(s7, val), type_name(type)); */
-
- switch (type)
- {
- case R_INT: v = make_xen_value(R_INT, add_int_to_ptree(prog, s7_number_to_integer(val)), R_VARIABLE); break;
- case R_FLOAT: v = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, s7_number_to_real(val)), R_VARIABLE); break;
- case R_BOOL: v = make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)scheme_to_c_bool(val)), R_VARIABLE); break;
- case R_VCT: v = make_xen_value(R_VCT, add_vct_to_ptree(prog, xen_to_vct(val)), R_VARIABLE); break;
- case R_SOUND_DATA: v = make_xen_value(R_SOUND_DATA, add_sound_data_to_ptree(prog, XEN_TO_SOUND_DATA(val)), R_VARIABLE); break;
-#if USE_SND
- case R_SAMPLER: v = make_xen_value(R_SAMPLER, add_sampler_to_ptree(prog, xen_to_sampler(val)), R_VARIABLE); break;
- case R_MIX: v = make_xen_value(R_MIX, add_int_to_ptree(prog, XEN_MIX_TO_C_INT(val)), R_VARIABLE); break;
- case R_MARK: v = make_xen_value(R_MARK, add_int_to_ptree(prog, XEN_MARK_TO_C_INT(val)), R_VARIABLE); break;
- case R_REGION: v = make_xen_value(R_REGION, add_int_to_ptree(prog, XEN_REGION_TO_C_INT(val)), R_VARIABLE); break;
- case R_SOUND: v = make_xen_value(R_SOUND, add_int_to_ptree(prog, XEN_SOUND_TO_C_INT(val)), R_VARIABLE); break;
-#endif
- case R_CHAR: v = make_xen_value(R_CHAR, add_int_to_ptree(prog, (Int)(s7_character(val))), R_VARIABLE); break;
- case R_STRING: v = make_xen_value(R_STRING, add_string_to_ptree(prog, mus_strdup(s7_string(val))), R_VARIABLE); break;
- case R_SYMBOL: v = make_xen_value(R_SYMBOL, add_xen_to_ptree(prog, val), R_VARIABLE); break;
- case R_KEYWORD: v = make_xen_value(R_KEYWORD, add_xen_to_ptree(prog, val), R_VARIABLE); break;
- case R_CLM: v = make_xen_value(R_CLM, add_clm_to_ptree(prog, XEN_TO_MUS_ANY(val), val), R_VARIABLE); break;
-
- case R_LIST:
- {
- list *lst;
- lst = xen_to_list(prog, val);
- /* fprintf(stderr, "add %p\n", lst); */
- if (!lst)
- {
- xen_value *v1;
- v1 = add_empty_var_to_ptree(prog, R_LIST);
- v = make_xen_value(R_LIST, v1->addr, R_VARIABLE);
- free(v1);
- }
- else v = make_xen_value(R_LIST, add_list_to_ptree(prog, lst), R_VARIABLE);
- if (v) add_obj_to_gcs(prog, R_LIST, v->addr);
- }
- break;
-
- case R_FLOAT_VECTOR:
- {
- vct *vc;
- vc = vector_to_vct(val);
- if (vc == NULL)
- return(run_warn("non-number in float vector -- will try to abort ptree evaluation"));
- v = make_xen_value(R_FLOAT_VECTOR, add_vct_to_ptree(prog, vc), R_VARIABLE);
- if (v) add_obj_to_gcs(prog, R_FLOAT_VECTOR, v->addr);
- }
- break;
-
- case R_LIST_VECTOR:
- case R_VCT_VECTOR:
- case R_CLM_VECTOR:
- case R_INT_VECTOR:
- {
- vect *iv;
- iv = read_vector(prog, val, type);
- if (iv == NULL) return(NULL);
- v = make_xen_value(type, add_vect_to_ptree(prog, iv), R_VARIABLE);
- if (v) add_obj_to_gcs(prog, type, v->addr); /* this makes its own xen_value with true gc field */
- }
- break;
- default:
- if (CLM_STRUCT_P(type))
- {
- list *lst;
- lst = xen_to_list_with_type(prog, val, type);
- v = make_xen_value(type, add_list_to_ptree(prog, lst), R_VARIABLE);
- /* fprintf(stderr, "add value to ptree: %s\n", describe_xen_value(v, prog)); */
- if (v) add_obj_to_gcs(prog, type, v->addr);
- }
- break;
- }
-
- return(v);
-}
-
-
-static xen_value *add_global_var_to_ptree(ptree *prog, s7_pointer form, s7_pointer *rtn)
-{
- s7_pointer val = scheme_undefined;
- xen_var *var;
- int type;
- bool local_var = false;
- xen_value *v = NULL;
- const char *varname;
-
- varname = s7_symbol_name(form);
- var = find_var_in_ptree(prog, varname);
- if (var)
- return(copy_xen_value(var->v));
-
- if (current_optimization < GLOBAL_OK) return(NULL);
-
- val = symbol_to_value(prog->code, form, &local_var);
- (*rtn) = val;
- if (val == scheme_undefined)
- {
- ptree *upper = NULL;
- upper = prog;
- while ((val == scheme_undefined) && (upper->outer_tree))
- {
- upper = upper->outer_tree;
- val = symbol_to_value(upper->code, form, &local_var);
- }
- if (val == scheme_undefined)
- return(run_warn("can't find %s", varname));
- }
- type = mus_run_xen_to_run_type(val);
- if (type == R_UNSPECIFIED)
- return(NULL);
-
- /* fprintf(stderr, "add global %s %s %s\n",varname, type_name(type), s7_object_to_c_string(s7, val)); */
-
- v = add_value_to_ptree(prog, val, type);
-
- if (v)
- {
- int var_loc;
- var_loc = add_outer_var_to_ptree(prog, varname, v);
- if (current_optimization < GLOBAL_SET_OK)
- prog->global_vars[var_loc]->unsettable = local_var;
- }
- return(v);
-}
-
-
-static continuation *add_goto_to_ptree(ptree *pt, const char *name)
-{
- continuation *c;
- c = (continuation *)calloc(1, sizeof(continuation));
- c->name = (char *)calloc(256, sizeof(char)); /* c->name is used within the call/cc to identify the continuation */
- mus_snprintf(c->name, 256, "%s", name);
- c->jump = make_xen_value(R_GOTO, add_int_to_ptree(pt, 0), R_VARIABLE); /* c->jump->addr will be the continuation PC */
- c->result = NULL; /* c->result is the returned value address */
- if (pt->gotos_size <= pt->goto_ctr)
- {
- int old_size;
- old_size = pt->gotos_size;
- pt->gotos_size += 4;
- if (old_size == 0)
- pt->gotos = (continuation **)calloc(pt->gotos_size, sizeof(continuation *));
- else
- {
- int i;
- pt->gotos = (continuation **)realloc(pt->gotos, pt->gotos_size * sizeof(continuation *));
- for (i = old_size; i < pt->gotos_size; i++) pt->gotos[i] = NULL;
- }
- }
- c->loc = pt->goto_ctr;
- pt->gotos[pt->goto_ctr++] = c;
- add_var_to_ptree(pt, name, c->jump);
- return(c);
-}
-
-
-static void erase_goto(ptree *prog, const char *name)
-{
- int i;
- for (i = prog->goto_ctr - 1; i >= 0; i--)
- {
- continuation *c = NULL;
- c = prog->gotos[i];
- if ((c) &&
- (mus_strcmp(c->name, name)))
- {
- free(c->name);
- c->name = NULL;
- break;
- }
- }
-}
-
-#if WITH_COUNTERS
-
-#define COUNTER_NUM 1024
-static int top_counter = 1;
-static mus_long_t counts[COUNTER_NUM][COUNTER_NUM];
-
-typedef void (*trip_func)(int *args, ptree *pt);
-static trip_func funcs[COUNTER_NUM];
-static const char *func_names[COUNTER_NUM];
-
-static void quit(int *args, ptree *pt);
-
-static void clear_counts(void)
-{
- int i, j;
- for (i = 0; i < COUNTER_NUM; i++)
- for (j = 0; j < COUNTER_NUM; j++)
- counts[i][j] = 0;
- func_names[0] = "start";
- funcs[0] = NULL;
-}
-
-static int get_func_loc(trip_func func, const char *name)
-{
- int i;
- for (i = 0; i < top_counter; i++)
- if (funcs[i] == func)
- return(i);
- func_names[top_counter] = name;
- funcs[top_counter++] = func;
- return(top_counter - 1);
-}
-
-static s7_pointer g_report_counts(void)
-{
- int i, j, rpt, imax, jmax;
- mus_long_t cmax;
- mus_long_t *totals;
-
- fprintf(stderr, "most used:\n");
- totals = (mus_long_t *)calloc(top_counter, sizeof(mus_long_t));
- for (i = 0; i < top_counter; i++)
- for (j = 0; j < top_counter; j++)
- totals[j] += counts[i][j];
- for (rpt = 0; rpt < 200; rpt++)
- {
- cmax = 0;
- for (i = 0; i < top_counter; i++)
- if (totals[i] > cmax)
- {
- cmax = totals[i];
- imax = i;
- }
- if (totals[imax] == 0) break;
- fprintf(stderr, " %s %lld\n", func_names[imax], totals[imax]);
- totals[imax] = 0;
- }
- free(totals);
-
- fprintf(stderr, "funcs: %d\n", top_counter - 1);
- for (rpt = 0; rpt < 200; rpt++)
- {
- cmax = 0;
- for (i = 0; i < top_counter; i++)
- for (j = 0; j < top_counter; j++)
- if (counts[i][j] > cmax)
- {
- cmax = counts[i][j];
- imax = i;
- jmax = j;
- }
- if (cmax == 0) break;
- if ((imax != 0) &&
- (funcs[jmax] != quit))
- fprintf(stderr, "%lld: %s\n %s\n", cmax, func_names[imax], func_names[jmax]);
- counts[imax][jmax] = 0;
- }
- return(scheme_true);
-}
-
-static s7_pointer g_clear_counts(void)
-{
- clear_counts();
- return(scheme_true);
-}
-#endif
-
-
-static void eval_ptree(ptree *pt)
-{
- /* evaluates program, result in prog->result,
- * assumes args already passed in addrs given by prog->addrs
- */
-#if WITH_COUNTERS
- int last_loc = 0, this_loc = 0;
-#endif
-
- pt->all_done = false;
- while (!(pt->all_done))
- {
- triple *cpc;
- cpc = (*pt->pc++);
-#if WITH_COUNTERS
- this_loc = cpc->func_loc;
- counts[last_loc][this_loc]++;
- last_loc = this_loc;
-#endif
- (*(cpc->function))(cpc->args, pt);
- }
- pt->pc = pt->initial_pc; /* don't reset closure junk after initial evaluation */
-}
-
-
-static void eval_embedded_ptree(ptree *prog, ptree *pt)
-{
- triple **old_pc;
- old_pc = pt->pc;
-
- prog->ints = pt->ints;
- prog->dbls = pt->dbls;
- prog->xen_vars = pt->xen_vars;
- prog->strs = pt->strs;
- prog->vcts = pt->vcts;
- prog->sds = pt->sds;
- prog->clms = pt->clms;
- prog->clm_locs = pt->clm_locs;
- prog->vects = pt->vects;
- prog->lists = pt->lists;
- prog->fncs = pt->fncs;
- prog->xens = pt->xens;
-#if USE_SND
- prog->samplers = pt->samplers;
-#endif
-
- eval_ptree(prog);
-
- pt->pc = old_pc;
- pt->all_done = false;
-}
-
-
-static triple *make_triple(void (*function)(int *arg_addrs, ptree *pt),
- const char *op_name,
- xen_value **typed_args, int args)
-{
- triple *trp;
- int *addrs = NULL, *types = NULL;
- if (args > 0)
- {
- int i;
- addrs = (int *)calloc(args, sizeof(int));
- types = (int *)calloc(args, sizeof(int));
- for (i = 0; i < args; i++)
- {
- addrs[i] = typed_args[i]->addr;
- types[i] = typed_args[i]->type;
- }
- }
- trp = (triple *)calloc(1, sizeof(triple));
- trp->function = function;
- trp->args = addrs;
- trp->types = types;
- trp->num_args = args;
- trp->op_name = op_name;
-#if WITH_COUNTERS
- trp->func_loc = get_func_loc(function, op_name);
-#endif
- return(trp);
-}
-
-
-static triple *va_make_triple(void (*function)(int *arg_addrs, ptree *pt),
- const char *op_name,
- int args, ...)
-{
- triple *trp;
- int *addrs = NULL, *types = NULL;
- if (args > 0)
- {
- va_list ap;
- int i;
- va_start(ap, args);
- addrs = (int *)calloc(args, sizeof(int));
- types = (int *)calloc(args, sizeof(int));
- for (i = 0; i < args; i++)
- {
- xen_value *v;
- v = va_arg(ap, xen_value *);
- if (v)
- {
- addrs[i] = v->addr;
- types[i] = v->type;
- }
- }
- va_end(ap);
- }
- trp = (triple *)calloc(1, sizeof(triple));
- trp->function = function;
- trp->args = addrs;
- trp->types = types;
- trp->num_args = args;
- trp->op_name = op_name;
-#if WITH_COUNTERS
- trp->func_loc = get_func_loc(function, op_name);
-#endif
- return(trp);
-}
-
-
-#define BOOL_RESULT pt->ints[args[0]]
-#define BOOL_ARG_1 ((bool)(pt->ints[args[1]]))
-#define BOOL_ARG_3 ((bool)(pt->ints[args[3]]))
-
-#define INT_RESULT pt->ints[args[0]]
-#define INT_ARG_1 pt->ints[args[1]]
-#define INT_ARG_2 pt->ints[args[2]]
-#define INT_ARG_3 pt->ints[args[3]]
-#define INT_ARG_4 pt->ints[args[4]]
-#define INT_ARG_5 pt->ints[args[5]]
-#define INT_ARG_6 pt->ints[args[6]]
-#define INT_ARG_7 pt->ints[args[7]]
-#define INT_ARG_8 pt->ints[args[8]]
-#define INT_ARG_9 pt->ints[args[9]]
-
-#define FLOAT_RESULT pt->dbls[args[0]]
-#define FLOAT_ARG_1 pt->dbls[args[1]]
-#define FLOAT_ARG_2 pt->dbls[args[2]]
-#define FLOAT_ARG_3 pt->dbls[args[3]]
-#define FLOAT_ARG_4 pt->dbls[args[4]]
-#define FLOAT_ARG_5 pt->dbls[args[5]]
-#define FLOAT_ARG_6 pt->dbls[args[6]]
-#define FLOAT_ARG_7 pt->dbls[args[7]]
-#define FLOAT_ARG_8 pt->dbls[args[8]]
-#define FLOAT_ARG_9 pt->dbls[args[9]]
-
-#define VCT_RESULT pt->vcts[args[0]]
-#define VCT_ARG_1 pt->vcts[args[1]]
-#define VCT_ARG_2 pt->vcts[args[2]]
-#define VCT_ARG_3 pt->vcts[args[3]]
-#define VCT_ARG_4 pt->vcts[args[4]]
-
-#define SOUND_DATA_RESULT pt->sds[args[0]]
-#define SOUND_DATA_ARG_1 pt->sds[args[1]]
-#define SOUND_DATA_ARG_2 pt->sds[args[2]]
-#define SOUND_DATA_ARG_3 pt->sds[args[3]]
-#define SOUND_DATA_ARG_4 pt->sds[args[4]]
-
-#define STRING_RESULT pt->strs[args[0]]
-#define STRING_ARG_1 pt->strs[args[1]]
-#define STRING_ARG_2 pt->strs[args[2]]
-#define STRING_ARG_3 pt->strs[args[3]]
-
-#define CHAR_RESULT pt->ints[args[0]]
-#define CHAR_ARG_1 ((char)(INT_ARG_1))
-#define CHAR_ARG_2 ((char)(INT_ARG_2))
-#define CHAR_ARG_3 ((char)(INT_ARG_3))
-
-#define CLM_RESULT pt->clms[args[0]]
-#define CLM_LOC pt->clm_locs[args[0]]
-#define CLM_ARG_1 pt->clms[args[1]]
-#define CLM_ARG_2 pt->clms[args[2]]
-#define CLM_ARG_3 pt->clms[args[3]]
-#define CLM_ARG_4 pt->clms[args[4]]
-#define CLM_ARG_5 pt->clms[args[5]]
-#define CLM_ARG_6 pt->clms[args[6]]
-#define CLM_ARG_7 pt->clms[args[7]]
-#define CLM_ARG_8 pt->clms[args[8]]
-
-#if USE_SND
-#define SAMPLER_RESULT pt->samplers[args[0]]
-#define SAMPLER_ARG_1 pt->samplers[args[1]]
-#define SAMPLER_ARG_2 pt->samplers[args[2]]
-#define SAMPLER_ARG_3 pt->samplers[args[3]]
-
-#define SOUND_RESULT pt->ints[args[0]]
-#define SOUND_ARG_1 pt->ints[args[1]]
-#define MIX_RESULT pt->ints[args[0]]
-#define MIX_ARG_1 pt->ints[args[1]]
-#define MARK_RESULT pt->ints[args[0]]
-#define MARK_ARG_1 pt->ints[args[1]]
-#define REGION_RESULT pt->ints[args[0]]
-#define REGION_ARG_1 pt->ints[args[1]]
-#endif
-
-#define FNC_RESULT ((ptree **)(pt->fncs))[args[0]]
-#define FNC_ARG_1 ((ptree **)(pt->fncs))[args[1]]
-#define FNC_ARG_2 ((ptree **)(pt->fncs))[args[2]]
-#define FNC_ARG_3 ((ptree **)(pt->fncs))[args[3]]
-#define FNC_ARG_4 ((ptree **)(pt->fncs))[args[4]]
-#define FNC_ARG_5 ((ptree **)(pt->fncs))[args[5]]
-#define FNC_ARG_6 ((ptree **)(pt->fncs))[args[6]]
-
-#define SCHEME_RESULT pt->xens[args[0]]
-#define SCHEME_ARG_1 pt->xens[args[1]]
-#define SCHEME_ARG_2 pt->xens[args[2]]
-#define SCHEME_ARG_3 pt->xens[args[3]]
-
-#define VECT_RESULT pt->vects[args[0]]
-#define VECT_ARG_1 pt->vects[args[1]]
-#define VECT_ARG_2 pt->vects[args[2]]
-#define VECT_ARG_3 pt->vects[args[3]]
-
-#define LIST_RESULT pt->lists[args[0]]
-#define LIST_ARG_1 pt->lists[args[1]]
-#define LIST_ARG_2 pt->lists[args[2]]
-#define LIST_ARG_3 pt->lists[args[3]]
-
-
-static void quit(int *args, ptree *pt) {pt->all_done = true;}
-
-static void jump(int *args, ptree *pt) {pt->pc += pt->ints[args[0]];}
-
-static void jump_abs(int *args, ptree *pt) {pt->pc = pt->program + pt->ints[args[0]];}
-static void jump_indirect(int *args, ptree *pt) {pt->pc = pt->program + pt->ints[pt->ints[args[0]]];}
-static void jump_if_abs(int *args, ptree *pt) {if (INT_ARG_1 != 0) pt->pc = pt->program + pt->ints[args[0]];}
-static void jump_if_not_abs(int *args, ptree *pt) {if (INT_ARG_1 == 0) pt->pc = pt->program + pt->ints[args[0]];}
-
-static void jump_if_equal(int *args, ptree *pt) {if (INT_ARG_1 == INT_ARG_2) pt->pc = pt->program + pt->ints[args[0]];}
-static void jump_if_not_equal(int *args, ptree *pt) {if (INT_ARG_1 != INT_ARG_2) pt->pc = pt->program + pt->ints[args[0]];}
-
-static void inc_and_jump_if_not_equal(int *args, ptree *pt)
-{
- (INT_ARG_1)++; /* i++ */
- if (INT_ARG_1 != INT_ARG_2) /* (= i lim) */
- pt->pc = pt->program + pt->ints[args[0]]; /* jump back to start of loop body */
- else pt->pc++; /* else skip redundant end test */
-}
-
-static void jump_if(int *args, ptree *pt) {if (INT_ARG_1 != 0) pt->pc += pt->ints[args[0]];}
-static void jump_if_not(int *args, ptree *pt) {if (INT_ARG_1 == 0) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_equal_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 == INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_equal_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 != INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_gt_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 > INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_gt_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 <= INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_lt_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 < INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_lt_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 >= INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_geq_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 >= INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_geq_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 < INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_leq_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 <= INT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_leq_i2_rel(int *args, ptree *pt) {if (INT_ARG_1 > INT_ARG_2) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_equal_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 == FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_equal_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 != FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_gt_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 > FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_gt_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 <= FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_lt_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 < FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_lt_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 >= FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_geq_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 >= FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_geq_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 < FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_leq_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 <= FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_leq_f2_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 > FLOAT_ARG_2) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_equal_i3_rel(int *args, ptree *pt) {if ((INT_ARG_1 == INT_ARG_2) && (INT_ARG_2 == INT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_equal_i3_rel(int *args, ptree *pt) {if (!((INT_ARG_1 == INT_ARG_2) && (INT_ARG_2 == INT_ARG_3))) pt->pc += pt->ints[args[0]];}
-static void jump_if_gt_i3_rel(int *args, ptree *pt) {if ((INT_ARG_1 > INT_ARG_2) && (INT_ARG_2 > INT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_gt_i3_rel(int *args, ptree *pt) {if (!((INT_ARG_1 > INT_ARG_2) && (INT_ARG_2 > INT_ARG_3))) pt->pc += pt->ints[args[0]];}
-static void jump_if_lt_i3_rel(int *args, ptree *pt) {if ((INT_ARG_1 < INT_ARG_2) && (INT_ARG_2 < INT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_lt_i3_rel(int *args, ptree *pt) {if (!((INT_ARG_1 < INT_ARG_2) && (INT_ARG_2 < INT_ARG_3))) pt->pc += pt->ints[args[0]];}
-static void jump_if_geq_i3_rel(int *args, ptree *pt) {if ((INT_ARG_1 >= INT_ARG_2) && (INT_ARG_2 >= INT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_geq_i3_rel(int *args, ptree *pt) {if (!((INT_ARG_1 >= INT_ARG_2) && (INT_ARG_2 >= INT_ARG_3))) pt->pc += pt->ints[args[0]];}
-static void jump_if_leq_i3_rel(int *args, ptree *pt) {if ((INT_ARG_1 <= INT_ARG_2) && (INT_ARG_2 <= INT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_leq_i3_rel(int *args, ptree *pt) {if (!((INT_ARG_1 <= INT_ARG_2) && (INT_ARG_2 <= INT_ARG_3))) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_equal_f3_rel(int *args, ptree *pt) {if ((FLOAT_ARG_1 == FLOAT_ARG_2) && (FLOAT_ARG_2 == FLOAT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_equal_f3_rel(int *args, ptree *pt) {if (!((FLOAT_ARG_1 == FLOAT_ARG_2) && (FLOAT_ARG_2 == FLOAT_ARG_3))) pt->pc += pt->ints[args[0]];}
-static void jump_if_gt_f3_rel(int *args, ptree *pt) {if ((FLOAT_ARG_1 > FLOAT_ARG_2) && (FLOAT_ARG_2 > FLOAT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_gt_f3_rel(int *args, ptree *pt) {if (!((FLOAT_ARG_1 > FLOAT_ARG_2) && (FLOAT_ARG_2 > FLOAT_ARG_3))) pt->pc += pt->ints[args[0]];}
-static void jump_if_lt_f3_rel(int *args, ptree *pt) {if ((FLOAT_ARG_1 < FLOAT_ARG_2) && (FLOAT_ARG_2 < FLOAT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_lt_f3_rel(int *args, ptree *pt) {if (!((FLOAT_ARG_1 < FLOAT_ARG_2) && (FLOAT_ARG_2 < FLOAT_ARG_3))) pt->pc += pt->ints[args[0]];}
-static void jump_if_geq_f3_rel(int *args, ptree *pt) {if ((FLOAT_ARG_1 >= FLOAT_ARG_2) && (FLOAT_ARG_2 >= FLOAT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_geq_f3_rel(int *args, ptree *pt) {if (!((FLOAT_ARG_1 >= FLOAT_ARG_2) && (FLOAT_ARG_2 >= FLOAT_ARG_3))) pt->pc += pt->ints[args[0]];}
-static void jump_if_leq_f3_rel(int *args, ptree *pt) {if ((FLOAT_ARG_1 <= FLOAT_ARG_2) && (FLOAT_ARG_2 <= FLOAT_ARG_3)) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_leq_f3_rel(int *args, ptree *pt) {if (!((FLOAT_ARG_1 <= FLOAT_ARG_2) && (FLOAT_ARG_2 <= FLOAT_ARG_3))) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_odd_i_rel(int *args, ptree *pt) {if (INT_ARG_1 & 1) pt->pc += pt->ints[args[0]];}
-static void jump_if_even_i_rel(int *args, ptree *pt) {if (!(INT_ARG_1 & 1)) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_zero_i_rel(int *args, ptree *pt) {if (INT_ARG_1 == 0) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_zero_i_rel(int *args, ptree *pt) {if (INT_ARG_1 != 0) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_negative_i_rel(int *args, ptree *pt) {if (INT_ARG_1 < 0) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_negative_i_rel(int *args, ptree *pt) {if (INT_ARG_1 >= 0) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_positive_i_rel(int *args, ptree *pt) {if (INT_ARG_1 > 0) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_positive_i_rel(int *args, ptree *pt) {if (INT_ARG_1 <= 0) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_zero_f_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 == 0.0) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_zero_f_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 != 0.0) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_negative_f_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 < 0.0) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_negative_f_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 >= 0.0) pt->pc += pt->ints[args[0]];}
-
-static void jump_if_positive_f_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 > 0.0) pt->pc += pt->ints[args[0]];}
-static void jump_if_not_positive_f_rel(int *args, ptree *pt) {if (FLOAT_ARG_1 <= 0.0) pt->pc += pt->ints[args[0]];}
-
-
-static void store_i(int *args, ptree *pt) {INT_RESULT = INT_ARG_1;}
-
-
-static void store_f(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_1;}
-
-
-static void store_f_i(int *args, ptree *pt) {INT_RESULT = (Int)FLOAT_ARG_1;}
-
-
-static void store_i_f(int *args, ptree *pt) {FLOAT_RESULT = (Double)INT_ARG_1;}
-
-
-static void store_false(int *args, ptree *pt) {BOOL_RESULT = (Int)false;}
-
-
-static void store_true(int *args, ptree *pt) {BOOL_RESULT = (Int)true;}
-
-
-static void store_b_b(int *args, ptree *pt) {BOOL_RESULT = BOOL_ARG_1;}
-
-
-static void store_b_clm(int *args, ptree *pt) {BOOL_RESULT = (bool)(CLM_ARG_1 != NULL);} /* != NULLs are for MS C++ */
-
-
-static void store_b_vct(int *args, ptree *pt) {BOOL_RESULT = (bool)(VCT_ARG_1 != NULL);}
-
-#if USE_SND
-static void store_b_sampler(int *args, ptree *pt) {BOOL_RESULT = (bool)(SAMPLER_ARG_1);}
-#endif
-
-static void store_b_sd(int *args, ptree *pt) {BOOL_RESULT = (bool)(SOUND_DATA_ARG_1 != NULL);}
-
-
-static void store_c(int *args, ptree *pt) {CHAR_RESULT = (int)CHAR_ARG_1;}
-
-
-static void store_x(int *args, ptree *pt) {SCHEME_RESULT = SCHEME_ARG_1;}
-
-
-static void store_s(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(STRING_ARG_1);
-}
-
-static void inc_i_1(int *args, ptree *pt);
-static void add_i2(int *args, ptree *pt);
-static void equal_i2(int *args, ptree *pt);
-static void gt_i2(int *args, ptree *pt);
-static void lt_i2(int *args, ptree *pt);
-static void geq_i2(int *args, ptree *pt);
-static void leq_i2(int *args, ptree *pt);
-
-static void equal_f2(int *args, ptree *pt);
-static void gt_f2(int *args, ptree *pt);
-static void lt_f2(int *args, ptree *pt);
-static void geq_f2(int *args, ptree *pt);
-static void leq_f2(int *args, ptree *pt);
-
-static void equal_i3(int *args, ptree *pt);
-static void gt_i3(int *args, ptree *pt);
-static void lt_i3(int *args, ptree *pt);
-static void geq_i3(int *args, ptree *pt);
-static void leq_i3(int *args, ptree *pt);
-
-static void equal_f3(int *args, ptree *pt);
-static void gt_f3(int *args, ptree *pt);
-static void lt_f3(int *args, ptree *pt);
-static void geq_f3(int *args, ptree *pt);
-static void leq_f3(int *args, ptree *pt);
-
-static void not_b(int *args, ptree *pt);
-
-static void odd_i(int *args, ptree *pt);
-static void even_i(int *args, ptree *pt);
-static void zero_i(int *args, ptree *pt);
-static void negative_i(int *args, ptree *pt);
-static void positive_i(int *args, ptree *pt);
-static void zero_f(int *args, ptree *pt);
-static void negative_f(int *args, ptree *pt);
-static void positive_f(int *args, ptree *pt);
-
-static void add_f2_mult(int *args, ptree *pt);
-static void add_f2(int *args, ptree *pt);
-static void add_f3_mult(int *args, ptree *pt);
-static void add_f3(int *args, ptree *pt);
-static void subtract_f2(int *args, ptree *pt);
-static void subtract_f2_mult(int *args, ptree *pt);
-static void subtract_f3(int *args, ptree *pt);
-static void subtract_f3_mult(int *args, ptree *pt);
-static void multiply_add_f2(int *args, ptree *pt);
-static void multiply_add_f2_mult(int *args, ptree *pt);
-static void oscil_0f_1(int *args, ptree *pt);
-static void oscil_0f_1_env(int *args, ptree *pt);
-static void oscil_0f_1_mult(int *args, ptree *pt);
-static void oscil_1f_1(int *args, ptree *pt);
-static void oscil_1f_1_env(int *args, ptree *pt);
-static void oscil_1f_1_mult(int *args, ptree *pt);
-static void oscil_1f_2(int *args, ptree *pt);
-static void oscil_1f_2_env(int *args, ptree *pt);
-static void oscil_1f_2_mult(int *args, ptree *pt);
-static void oscil_1f_2m(int *args, ptree *pt);
-static void oscil_1f_2m_env(int *args, ptree *pt);
-static void oscil_1f_2m_mult(int *args, ptree *pt);
-static void oscil_1f_3ma(int *args, ptree *pt);
-static void oscil_1f_3ma_mult(int *args, ptree *pt);
-static void oscil_1f_3ma_env(int *args, ptree *pt);
-static void oscil_1f_3(int *args, ptree *pt);
-static void oscil_1f_3_mult(int *args, ptree *pt);
-static void oscil_1f_3_env(int *args, ptree *pt);
-static void polywave_0f_env(int *args, ptree *pt);
-static void polywave_0f_mult(int *args, ptree *pt);
-static void polywave_0f(int *args, ptree *pt);
-static void polywave_1f_env(int *args, ptree *pt);
-static void polywave_1f_mult(int *args, ptree *pt);
-static void polywave_1f(int *args, ptree *pt);
-static void polywave_1f_2_env(int *args, ptree *pt);
-static void polywave_1f_2_mult(int *args, ptree *pt);
-static void polywave_1f_2(int *args, ptree *pt);
-static void random_f(int *args, ptree *pt);
-static void random_f_mult(int *args, ptree *pt);
-static void sin_f(int *args, ptree *pt);
-static void sin_f_mult(int *args, ptree *pt);
-static void cos_f(int *args, ptree *pt);
-static void cos_f_mult(int *args, ptree *pt);
-static void abs_f(int *args, ptree *pt);
-static void abs_f_mult(int *args, ptree *pt);
-static void sqrt_f(int *args, ptree *pt);
-static void sqrt_f_mult(int *args, ptree *pt);
-static void env_linear_0f_mult(int *args, ptree *pt);
-static void env_linear_0f_env(int *args, ptree *pt);
-static void env_linear_0f(int *args, ptree *pt);
-static void rand_0f(int *args, ptree *pt);
-static void rand_0f_env(int *args, ptree *pt);
-static void rand_0f_mult(int *args, ptree *pt);
-static void rand_interp_0f(int *args, ptree *pt);
-static void rand_interp_0f_env(int *args, ptree *pt);
-static void rand_interp_0f_mult(int *args, ptree *pt);
-static void vct_constant_ref_0(int *args, ptree *pt);
-static void vct_constant_ref_0_mult(int *args, ptree *pt);
-static void vct_ref_f(int *args, ptree *pt);
-static void vct_ref_f_mult(int *args, ptree *pt);
-static void vector_ref_f(int *args, ptree *pt);
-static void delay_1f(int *args, ptree *pt);
-static void delay_1f_env(int *args, ptree *pt);
-static void delay_1f_mult(int *args, ptree *pt);
-static void delay_1f_noz(int *args, ptree *pt);
-static void delay_1f_noz_env(int *args, ptree *pt);
-static void delay_1f_noz_mult(int *args, ptree *pt);
-static void granulate_0f_env(int *args, ptree *pt);
-static void granulate_0f_mult(int *args, ptree *pt);
-static void granulate_0f(int *args, ptree *pt);
-static void formant_1f(int *args, ptree *pt);
-static void formant_1f_mult(int *args, ptree *pt);
-static void formant_1f_env(int *args, ptree *pt);
-static void firmant_1f(int *args, ptree *pt);
-static void firmant_1f_mult(int *args, ptree *pt);
-static void firmant_1f_env(int *args, ptree *pt);
-static void firmant_2f(int *args, ptree *pt);
-static void firmant_2f_mult(int *args, ptree *pt);
-static void firmant_2f_env(int *args, ptree *pt);
-static void polyshape_1fn(int *args, ptree *pt);
-static void polyshape_1fn_mult(int *args, ptree *pt);
-static void polyshape_1fn_env(int *args, ptree *pt);
-static void oscil_0f_vect(int *args, ptree *pt);
-static void oscil_0f_vect_mult(int *args, ptree *pt);
-static void oscil_0f_vect_env(int *args, ptree *pt);
-static void oscil_1f_vect(int *args, ptree *pt);
-static void oscil_1f_vect_mult(int *args, ptree *pt);
-static void oscil_1f_vect_env(int *args, ptree *pt);
-static void formant_1f_vect(int *args, ptree *pt);
-static void formant_1f_vect_mult(int *args, ptree *pt);
-static void formant_1f_vect_env(int *args, ptree *pt);
-static void firmant_1f_vect(int *args, ptree *pt);
-static void firmant_1f_vect_mult(int *args, ptree *pt);
-static void firmant_1f_vect_env(int *args, ptree *pt);
-static void vct_set_f_add(int *args, ptree *pt);
-static void vct_set_f_mult(int *args, ptree *pt);
-
-static void rand_interp_0f_add(int *args, ptree *pt);
-static void formant_1f_add(int *args, ptree *pt);
-static void abs_f_add(int *args, ptree *pt);
-static void sin_f_add(int *args, ptree *pt);
-static void cos_f_add(int *args, ptree *pt);
-static void abs_f_mult_add(int *args, ptree *pt);
-static void mus_random_f_add(int *args, ptree *pt);
-static void mus_random_f(int *args, ptree *pt);
-static void random_f_add(int *args, ptree *pt);
-static void subtract_f2_add(int *args, ptree *pt);
-static void sin_f_mult_add(int *args, ptree *pt);
-static void cos_f_mult_add(int *args, ptree *pt);
-static void subtract_f2_mult_add(int *args, ptree *pt);
-static void vct_ref_f_add(int *args, ptree *pt);
-
-static void locsig_3f_mono_no_rev(int *args, ptree *pt);
-static void locsig_v_mono_no_rev(int *args, ptree *pt);
-static void locsig_v_stereo(int *args, ptree *pt);
-static void locsig_v_mono(int *args, ptree *pt);
-static void outa_3f(int *args, ptree *pt);
-static void outa_multiply_f2(int *args, ptree *pt);
-static void outa_multiply_f3(int *args, ptree *pt);
-static void frame_set_0r(int *args, ptree *pt);
-static void set_scaler_f(int *args, ptree *pt);
-static void vct_set_f(int *args, ptree *pt);
-static void outa_polywave_1_mult(int *args, ptree *pt);
-static void outa_oscil_1_mult(int *args, ptree *pt);
-static void outa_add_f2_mult(int *args, ptree *pt);
-static void outa_add_f3_mult(int *args, ptree *pt);
-static void sound_data_set_f(int *args, ptree *pt);
-
-static xen_value *convert_int_to_dbl(ptree *prog, xen_value *i)
-{
- xen_value *val;
- val = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), i->constant);
- if (i->constant == R_CONSTANT)
- prog->dbls[val->addr] = (Double)(prog->ints[i->addr]);
- else add_triple_to_ptree(prog, va_make_triple(store_i_f, "int_to_double", 2, val, i));
- return(val);
-}
-
-
-static xen_value *convert_dbl_to_int(ptree *prog, xen_value *i, bool exact)
-{
- xen_value *v;
- Double val;
- val = prog->dbls[i->addr];
- if ((exact) && ((int)(floor(val)) != (int)val)) return(NULL);
- v = make_xen_value(R_INT, add_int_to_ptree(prog, 0), i->constant);
- if (i->constant == R_CONSTANT)
- prog->ints[v->addr] = (Int)val;
- else add_triple_to_ptree(prog, va_make_triple(store_f_i, "dbl_to_int", 2, v, i));
- return(v);
-}
-
-
-static triple *set_var(ptree *pt, xen_value *var, xen_value *init_val)
-{
- /* this also affects return types of things like "if" */
- switch (var->type)
- {
- case R_FLOAT:
- return(add_triple_to_ptree(pt, va_make_triple(store_f, "store_f", 2, var, init_val)));
- break;
-
- case R_STRING:
- return(add_triple_to_ptree(pt, va_make_triple(store_s, "store_s", 2, var, init_val)));
- break;
-
- case R_INT:
- return(add_triple_to_ptree(pt, va_make_triple(store_i, "store_i", 2, var, init_val)));
- break;
-
- case R_BOOL:
- {
- /* null pointers can only come as explicitly type-declared args in run/run-eval */
- switch (init_val->type)
- {
- case R_BOOL: return(add_triple_to_ptree(pt, va_make_triple(store_b_b, "set_bool", 2, var, init_val))); break;
- case R_VCT: return(add_triple_to_ptree(pt, va_make_triple(store_b_vct, "set_vct", 2, var, init_val))); break;
- case R_SOUND_DATA: return(add_triple_to_ptree(pt, va_make_triple(store_b_sd, "set_sd", 2, var, init_val))); break;
- case R_CLM: return(add_triple_to_ptree(pt, va_make_triple(store_b_clm, "set_clm", 2, var, init_val))); break;
-#if USE_SND
- case R_SAMPLER: return(add_triple_to_ptree(pt, va_make_triple(store_b_sampler, "set_rd", 2, var, init_val))); break;
-#endif
- default:
- {
- xen_value *temp_v = NULL;
- triple *trp;
- /* nearly everything is true in Scheme -- these are not pointers, or can't be created within run */
- temp_v = make_xen_value(R_BOOL, add_int_to_ptree(pt, (Int)true), R_CONSTANT);
- trp = add_triple_to_ptree(pt, va_make_triple(store_b_b, "set_b", 2, var, temp_v));
- /* temp_v is used only as a way to pass in an address, so it should be freed */
- if (temp_v) free(temp_v);
- return(trp);
- }
- break;
- }
- }
- break;
-
- case R_CHAR:
- return(add_triple_to_ptree(pt, va_make_triple(store_c, "set_chr", 2, var, init_val)));
- break;
-
- case R_SYMBOL: case R_KEYWORD:
- return(add_triple_to_ptree(pt, va_make_triple(store_x, "set_xen", 2, var, init_val)));
- break;
- }
- /* this is not necessarily an error as long as we don't actually allow
- * explicit set! of the unhandled types -- a let binding simply
- * passes the reference through, which should be ok since it's read-only.
- */
- /*
- fprintf(stderr, "set: %s(%s. %d) %s(%s, %d) failed\n",
- describe_xen_value(var, pt), type_name(var->type), var->type,
- describe_xen_value(init_val, pt), type_name(init_val->type), init_val->type);
- */
- return(NULL);
-}
-
-
-static triple *set_var_no_opt(ptree *pt, xen_value *var, xen_value *init_val)
-{
- triple *trp;
- trp = set_var(pt, var, init_val);
- if (trp) trp->no_opt = true;
- return(trp);
-}
-
-
-static xen_value *walk(ptree *prog, s7_pointer form, walk_result_t walk_result);
-
-static xen_value *walk_sequence(ptree *prog, s7_pointer body, walk_result_t need_result, const char *name)
-{
- xen_value *v = NULL;
- int i, body_forms;
- s7_pointer lbody;
-
- if (body == scheme_undefined) return(NULL);
-
- body_forms = s7_list_length(s7, body);
- if (body_forms == 0)
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT));
-
- lbody = body;
- for (i = 0; i < body_forms; i++, lbody = s7_cdr(lbody))
- {
- if (v) free(v);
- v = walk(prog,
- s7_car(lbody),
- ((need_result != DONT_NEED_RESULT) &&
- (i == (body_forms - 1))) ?
- NEED_ANY_RESULT : DONT_NEED_RESULT);
- if (v == NULL)
- {
- char *temp = NULL;
- xen_value *v1;
- v1 = run_warn("%s: can't handle %s", name, temp = s7_object_to_c_string(s7, s7_car(lbody)));
- if (temp) free(temp);
- return(v1);
- }
- }
-
- return(v);
-}
-
-
-static xen_value *lambda_form(ptree *prog, s7_pointer form, bool separate, xen_value **args, int num_args, s7_pointer local_proc);
-
-static char *define_form(ptree *prog, s7_pointer form)
-{
- /* behaves here just like a sequential bind (let*) */
- s7_pointer var, val;
- xen_value *v, *vs;
-
- if ((!(s7_is_list(s7, form))) || (form == scheme_nil)) return(NULL);
-
- var = scheme_cadr(form);
- if (!(s7_is_symbol(var)))
- {
- if (s7_is_list(s7, var))
- {
- v = lambda_form(prog, form, false, NULL, 0, scheme_false);
- if (v == NULL)
- {
- char *temp = NULL, *str;
- str = mus_format("can't handle this define: %s", temp = s7_object_to_c_string(s7, form));
- if (temp) free(temp);
- return(str);
- }
- add_var_to_ptree(prog, s7_symbol_name(s7_car(var)), v);
- free(v);
- return(NULL);
- }
- else
- {
- char *temp = NULL, *str;
- str = mus_format("can't handle this definition: %s", temp = s7_object_to_c_string(s7, var));
- if (temp) free(temp);
- return(str);
- }
- }
-
- val = scheme_caddr(form);
- v = walk(prog, val, NEED_ANY_RESULT);
- if (v == NULL)
- {
- char *temp = NULL, *str;
- str = mus_format("can't handle this define value: %s", temp = s7_object_to_c_string(s7, val));
- if (temp) free(temp);
- return(str);
- }
-
- if (v->constant == R_TEMPORARY)
- {
- v->constant = R_VARIABLE;
- add_var_to_ptree(prog, s7_symbol_name(var), v);
- }
- else
- {
- vs = transfer_value(prog, v);
- add_var_to_ptree(prog, s7_symbol_name(var), vs);
- set_var(prog, vs, v);
- free(vs);
- }
- free(v);
- return(NULL);
-}
-
-
-static s7_pointer handle_defines(ptree *prog, s7_pointer forms)
-{
- if (!(s7_is_list(s7, forms))) return(forms);
- while (forms != scheme_nil)
- {
- s7_pointer form;
- char *temp = NULL;
- form = s7_car(forms);
- if ((s7_is_list(s7, form)) &&
- (form != scheme_nil) &&
- (safe_strcmp("define", temp = s7_object_to_c_string(s7, s7_car(form))) == 0))
- {
- char *err;
- if (temp) free(temp);
- err = define_form(prog, form);
- if (err != NULL)
- {
- run_warn("%s", err);
- free(err);
- return(scheme_undefined);
- }
- forms = s7_cdr(forms);
- }
- else
- {
- if (temp) free(temp);
- return(forms);
- }
- }
- return(forms);
-}
-
-
-static char *parallel_binds(ptree *prog, s7_pointer old_lets, const char *name)
-{
- s7_pointer lets;
- int vars;
-
- lets = old_lets;
- vars = s7_list_length(s7, lets);
- if (vars > 0)
- {
- s7_pointer var;
- xen_value *v = NULL;
- xen_value **vs, **old_vs;
- int i;
-
- vs = (xen_value **)calloc(vars, sizeof(xen_value *));
- old_vs = (xen_value **)calloc(vars, sizeof(xen_value *));
-
- for (i = 0; i < vars; i++, lets = s7_cdr(lets))
- {
- var = s7_car(lets);
- v = walk(prog, scheme_cadr(var), NEED_ANY_RESULT);
- if (v == NULL)
- {
- int j;
- char *temp = NULL, *str;
- for (j = 0; j < i; j++)
- {
- if (old_vs[j]) free(old_vs[j]);
- if (vs[j]) free(vs[j]);
- }
- free(vs);
- free(old_vs);
- str = mus_format("can't handle %s var: %s", name, temp = s7_object_to_c_string(s7, lets));
- if (temp) free(temp);
- return(str);
- }
- old_vs[i] = v;
-
- /* fprintf(stderr, "%s walk in let: %s %d\n", s7_object_to_c_string(s7, scheme_cadr(var)), describe_xen_value(v, prog), v->constant); */
-
- if (v->constant != R_TEMPORARY)
- vs[i] = transfer_value(prog, v);
- }
-
- lets = old_lets;
- for (i = 0; i < vars; i++, lets = s7_cdr(lets))
- {
- var = s7_car(lets);
- if (old_vs[i]->constant == R_TEMPORARY)
- {
- old_vs[i]->constant = R_VARIABLE;
- add_var_to_ptree(prog, s7_symbol_name(s7_car(var)), old_vs[i]);
- }
- else
- {
- add_var_to_ptree(prog, s7_symbol_name(s7_car(var)), vs[i]);
- set_var(prog, vs[i], old_vs[i]); /* establish let binding */
- /* (run-eval '(do ((i 0 (1+ i))) ((= i 3)) (let ((a 1)) (set! a (+ a 1)) (display a)))) */
- free(vs[i]);
- }
- free(old_vs[i]);
- }
- free(old_vs);
- free(vs);
- }
- return(NULL);
-}
-
-
-static char *sequential_binds(ptree *prog, s7_pointer old_lets, const char *name)
-{
- s7_pointer lets;
- int vars;
-
- lets = old_lets;
- vars = s7_list_length(s7, lets);
- if (vars > 0)
- {
- int i;
- for (i = 0; i < vars; i++, lets = s7_cdr(lets))
- {
- xen_value *v = NULL, *vs;
- s7_pointer var;
- var = s7_car(lets);
- v = walk(prog, scheme_cadr(var), NEED_ANY_RESULT);
-
- /* fprintf(stderr, "walk in let*: %s %d\n", describe_xen_value(v, prog), v->constant); */
-
- if (v == NULL)
- {
- char *temp = NULL, *str;
- str = mus_format("can't handle %s var: %s", name, temp = s7_object_to_c_string(s7, lets));
- if (temp) free(temp);
- return(str);
- }
-
- if (v->constant == R_TEMPORARY)
- {
- v->constant = R_VARIABLE;
- add_var_to_ptree(prog, s7_symbol_name(s7_car(var)), v);
- }
- else
- {
- vs = transfer_value(prog, v);
- add_var_to_ptree(prog, s7_symbol_name(s7_car(var)), vs);
- set_var(prog, vs, v);
- free(vs);
- }
- free(v);
- }
- }
- return(NULL);
-}
-
-
-static char *declare_args(ptree *prog, s7_pointer form, int default_arg_type, bool separate, xen_value **cur_args, int num_passed_args)
-{
- /* need function arg types for funcall. We have 3 sources of info:
- * the passed args, the possible "(declare ...)" form, and
- * the default values in the closure's arg list (if optional args)
- * The latter is called the "template" here, "passed" = what we
- * see in the current call, "declared" = what declare tells us.
- * All this needs to be merged, and default values set.
- * The declare form can be (declare (arg1 type1)...) or (snd-declare (quote ((arg1 type1...))))
- * -- see snd-xen.c for an explanation of snd-declare.
- * The template might contain noise entries like ":optional, so
- * its length is not the same as the number of template arguments.
- *
- * num_passed_args can also be off -- it includes the argument keywords if any
- */
-
- s7_pointer template_args, declarations = scheme_false;
- int i, num_template_args = 0, template_args_len = 0;
-
- /* !separate apparently means an embedded define: (lambda (y) (define (a) 3) (+ y (a))) */
- if (separate)
- template_args = scheme_cadr(form);
- else template_args = scheme_cdadr(form);
- /* template_args is the arglist as found in the function's closure */
-
- /* fprintf(stderr, "template_args: %s, list?: %s\n", s7_object_to_c_string(s7, template_args), (s7_is_list(s7, template_args)) ? "#t" : "#f"); */
-
- if (!(s7_is_list(s7, template_args)))
- return(mus_format("can't handle this argument declaration: %s", s7_object_to_c_string(s7, template_args)));
-
-
- /* get number of actual template args (ignoring :key and so on) */
- template_args_len = s7_list_length(s7, template_args);
- num_template_args = template_args_len;
- for (i = 0; i < template_args_len; i++)
- if ((s7_is_symbol(s7_list_ref(s7, template_args, i))) &&
- ((safe_strcmp(s7_symbol_name(s7_list_ref(s7, template_args, i)), ":optional") == 0) ||
- (safe_strcmp(s7_symbol_name(s7_list_ref(s7, template_args, i)), ":key") == 0) ||
- (safe_strcmp(s7_symbol_name(s7_list_ref(s7, template_args, i)), ":rest") == 0)))
- num_template_args--;
-
- if (num_passed_args > num_template_args)
- {
- /* in this context, we're not trying to handle :rest args */
- bool got_keyword = false;
- for (i = 1; i <= num_passed_args; i++)
- if (cur_args[i]->type == R_KEYWORD)
- {
- got_keyword = true;
- break;
- }
- if (!got_keyword)
- {
- char *temp = NULL, *str;
- str = mus_format("got too many args: %d passed, but %s declared", num_passed_args, temp = s7_object_to_c_string(s7, template_args));
- if (temp) free(temp);
- return(str);
- }
- }
-
- prog->arity = num_template_args;
- if (num_template_args == 0)
- return(NULL); /* no args expected, none passed, nothing to check */
-
- if (num_passed_args < num_template_args)
- {
- declarations = scheme_caddr(form); /* either declare or snd-declare */
- if ((s7_is_string(declarations)) && /* possible doc string */
- (scheme_cdddr(form) != scheme_nil))
- declarations = scheme_cadddr(form);
-
- if ((s7_is_list(s7, declarations)) &&
- (declarations != scheme_nil) &&
- (s7_is_symbol(s7_car(declarations))) &&
- ((safe_strcmp(s7_symbol_name(s7_car(declarations)), "declare") == 0) ||
- (safe_strcmp(s7_symbol_name(s7_car(declarations)), "snd-declare") == 0)))
- {
- if (safe_strcmp(s7_symbol_name(s7_car(declarations)), "declare") == 0)
- declarations = s7_cdr(declarations);
- else declarations = scheme_cadr(scheme_cadr(declarations));
- }
- else declarations = scheme_false; /* not a "declare" form after all */
- }
-
- /* fprintf(stderr, "num_args: %d, template_args: %s, declarations: %s\n", num_template_args, s7_object_to_c_string(s7, template_args), s7_object_to_c_string(s7, declarations)); */
-
- /* prepare the prog's local arg list */
- prog->args = (int *)calloc(num_template_args, sizeof(int)); /* value address */
- prog->default_args = (int *)calloc(num_template_args, sizeof(int)); /* default value address */
- prog->arg_types = (int *)calloc(num_template_args, sizeof(int)); /* value type */
-
- for (i = 0; i < num_template_args; i++, template_args = s7_cdr(template_args))
- {
- s7_pointer template_arg, template_arg_symbol;
- int arg_type;
- xen_value *v = NULL;
-
- template_arg = s7_car(template_args);
- if ((s7_is_keyword(template_arg)) &&
- ((safe_strcmp(s7_symbol_name(template_arg), ":optional") == 0) ||
- (safe_strcmp(s7_symbol_name(template_arg), ":key") == 0) ||
- (safe_strcmp(s7_symbol_name(template_arg), ":rest") == 0)))
- {
- template_args = s7_cdr(template_args); /* skip this one */
- template_arg = s7_car(template_args);
- }
-
- /* fprintf(stderr, "template arg: %s\n", s7_object_to_c_string(s7, template_arg)); */
- if (s7_is_list(s7, template_arg))
- template_arg_symbol = s7_car(template_arg);
- else template_arg_symbol = template_arg;
-
- arg_type = default_arg_type;
- /* first look for a declared type */
-
- if ((s7_is_list(s7, declarations)) &&
- (declarations != scheme_nil))
- {
- s7_pointer declaration;
- /* (declare (x real) (a integer) (b string) ... */
-
- declaration = s7_car(declarations);
- declarations = s7_cdr(declarations);
-
- if ((s7_is_list(s7, declaration)) &&
- (s7_is_eq(s7_car(declaration), template_arg_symbol)) &&
- (s7_is_symbol(scheme_cadr(declaration))))
- {
- const char *type;
- type = s7_symbol_name(scheme_cadr(declaration));
- arg_type = name_to_type(type);
-
- if (arg_type == R_UNSPECIFIED) /* not a predefined type name like "float" */
- {
- if (safe_strcmp(type, "integer") == 0)
- arg_type = R_INT;
- else
- {
- if (safe_strcmp(type, "real") == 0)
- arg_type = R_FLOAT;
- else
- {
- char *temp = NULL, *str;
- str = mus_format("unknown type in declare: %s in %s", type, temp = s7_object_to_c_string(s7, form));
- if (temp) free(temp);
- return(str);
- }
- }
- }
- }
- else
- {
- /* declaration doesn't match template? */
- char *temp1 = NULL, *temp2 = NULL, *temp3 = NULL, *str;
- str = mus_format("unrecognized arg in declare: %s (for %s?) in %s",
- temp1 = s7_object_to_c_string(s7, declaration),
- temp2 = s7_object_to_c_string(s7, template_arg),
- temp3 = s7_object_to_c_string(s7, form));
- if (temp1) free(temp1);
- if (temp2) free(temp2);
- if (temp3) free(temp3);
- return(str);
- }
- }
- else
- {
- /* no applicable declaration -- look at passed arg (if any) first */
-
- if ((i < num_passed_args) &&
- (cur_args) &&
- (cur_args[i + 1]))
- arg_type = cur_args[i + 1]->type;
- else
- {
- if (prog->lambda_args > i)
- arg_type = prog->lambda_arg_types[i];
- else
- {
- /* look at template default, if any */
- if (s7_is_list(s7, template_arg))
- {
- s7_pointer template_default;
- template_default = scheme_cadr(template_arg);
- arg_type = mus_run_xen_to_run_type(template_default);
- }
- }
- }
- }
-
- /* make a ptree slot for default arg value (copied later if needed) */
- if (s7_is_list(s7, template_arg))
- {
- s7_pointer template_default;
- template_default = scheme_cadr(template_arg);
-
- switch (arg_type)
- {
- case R_INT:
- v = make_xen_value(arg_type, add_int_to_ptree(prog, s7_number_to_integer(template_default)), R_CONSTANT);
- break;
-
- case R_FLOAT:
- v = make_xen_value(arg_type, add_dbl_to_ptree(prog, s7_number_to_real(template_default)), R_CONSTANT);
- break;
-
- case R_STRING:
- v = make_xen_value(arg_type, add_string_to_ptree(prog, mus_strdup(s7_string(template_default))), R_CONSTANT);
- break;
-
- case R_CHAR:
- v = make_xen_value(arg_type, add_int_to_ptree(prog, (Int)(s7_character(template_default))), R_CONSTANT);
- break;
-
- case R_BOOL:
- v = make_xen_value(arg_type, add_int_to_ptree(prog, (template_default == scheme_false) ? 0 : 1), R_CONSTANT);
- break;
-
- default:
- return(mus_format("unimplemented argument default value: %s\n", s7_object_to_c_string(s7, template_default)));
- }
-
- /* fprintf(stderr, "add default arg %d: %s\n", i, describe_xen_value(v, prog)); */
- prog->default_args[i] = v->addr;
- free(v);
- v = NULL;
- }
-
- add_var_to_ptree(prog,
- s7_symbol_name(template_arg_symbol),
- v = add_empty_var_to_ptree(prog, arg_type));
- prog->args[i] = v->addr;
- prog->arg_types[i] = v->type;
- free(v);
- }
-
- return(NULL);
-}
-
-
-static void undefine_locals(ptree *prog, int locals_loc)
-{
- int i;
- for (i = locals_loc; i < prog->var_ctr; i++)
- if (prog->vars[i]) prog->vars[i] = free_xen_var(prog, prog->vars[i]);
- prog->var_ctr = locals_loc;
-}
-
-
-static xen_value *walk_then_undefine(ptree *prog, s7_pointer form, walk_result_t need_result, const char *name, int locals_loc)
-{
- xen_value *v;
- v = walk_sequence(prog, handle_defines(prog, form), need_result, name);
- undefine_locals(prog, locals_loc);
- return(v);
-}
-
-
-static xen_value *lambda_form(ptree *prog, s7_pointer form, bool separate, xen_value **args, int num_args, s7_pointer local_proc)
-{
- /* (lambda (args...) | args etc followed by forms */
- /* as args are declared as vars, put addrs in prog->args list */
- char *err = NULL;
- int locals_loc;
-
- if (prog->got_lambda)
- {
- /* start a new ptree, walk body, return ptree as R_FUNCTION variable */
- ptree *new_tree;
- int outer_locals;
- new_tree = attach_to_ptree(prog);
- new_tree->code = local_proc;
- outer_locals = prog->var_ctr;
- /* inner level default arg type is int(?) */
- err = declare_args(new_tree, form, R_INT, separate, args, num_args);
- if (err)
- {
- unattach_ptree(new_tree, prog);
- free_embedded_ptree(new_tree);
- return(run_warn_with_free(err));
- }
- else
- {
- new_tree->result = walk_then_undefine(new_tree, scheme_cddr(form), NEED_ANY_RESULT, "lambda", prog->var_ctr);
- if (new_tree->result)
- {
- int i;
- xen_value *v;
- add_triple_to_ptree(new_tree, make_triple(quit, "quit", NULL, 0));
- unattach_ptree(new_tree, prog);
-
- for (i = outer_locals; i < prog->var_ctr; i++)
- if (prog->vars[i]) prog->vars[i] = free_xen_var(prog, prog->vars[i]);
-
- prog->var_ctr = outer_locals;
- v = make_xen_value(R_FUNCTION, add_fnc_to_ptree(prog, new_tree), R_VARIABLE);
- add_obj_to_gcs(prog, R_FUNCTION, v->addr);
- return(v);
- }
- }
- /* we get here if walk failed, so clean up */
- unattach_ptree(new_tree, prog); /* needed in case we realloc'd during failed tree walk */
- free_embedded_ptree(new_tree);
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("can't handle this embedded lambda: %s", temp = s7_object_to_c_string(s7, form));
- if (temp) free(temp);
- return(rv);
- }
- }
-
- /* outer level default arg type is float(?) */
- prog->got_lambda = true;
- locals_loc = prog->var_ctr;
- err = declare_args(prog, form, R_FLOAT, separate, args, num_args);
- if (err) return(run_warn_with_free(err));
- return(walk_then_undefine(prog, scheme_cddr(form), NEED_ANY_RESULT, "lambda", locals_loc));
-}
-
-
-static xen_value *begin_form(ptree *prog, s7_pointer form, walk_result_t need_result)
-{
- return(walk_then_undefine(prog, s7_cdr(form), need_result, "begin", prog->var_ctr));
-}
-
-
-static xen_value *let_star_form(ptree *prog, s7_pointer form, walk_result_t need_result)
-{
- int locals_loc;
- char *err = NULL;
- locals_loc = prog->var_ctr; /* lets can be nested */
- err = sequential_binds(prog, scheme_cadr(form), "let*");
- if (err) return(run_warn_with_free(err));
- if (!(prog->got_lambda)) prog->initial_pc = prog->program + prog->triple_ctr;
- return(walk_then_undefine(prog, scheme_cddr(form), need_result, "let*", locals_loc));
-}
-
-
-static xen_value *let_form(ptree *prog, s7_pointer form, walk_result_t need_result)
-{
- /* keep vars until end of var section */
- s7_pointer lets;
- char *trouble = NULL;
- int locals_loc;
- lets = scheme_cadr(form);
- locals_loc = prog->var_ctr; /* lets can be nested */
- trouble = parallel_binds(prog, lets, "let");
- if (trouble) return(run_warn_with_free(trouble));
- if (!(prog->got_lambda)) prog->initial_pc = prog->program + prog->triple_ctr;
- return(walk_then_undefine(prog, scheme_cddr(form), need_result, "let", locals_loc));
-}
-
-
-static xen_value *coerce_to_boolean(ptree *prog, xen_value *v)
-{
- xen_value *temp;
- temp = add_temporary_var_to_ptree(prog, R_BOOL);
- set_var_no_opt(prog, temp, v);
- free(v);
- return(temp);
-}
-
-
-#define NUM_IF_OPS 29
-
-static opt_ops if_ops[NUM_IF_OPS] = {
- {not_b, "not_b", jump_if, "jump_if", jump_if_not, "jump_if_not"},
-
- {equal_i2, "equal_i2", jump_if_not_equal_i2_rel, "jump_if_not_equal_i2_rel", jump_if_equal_i2_rel, "jump_if_equal_i2_rel"},
- {gt_i2, "gt_i2", jump_if_not_gt_i2_rel, "jump_if_not_gt_i2_rel", jump_if_gt_i2_rel, "jump_if_gt_i2_rel"},
- {lt_i2, "lt_i2", jump_if_not_lt_i2_rel, "jump_if_not_lt_i2_rel", jump_if_lt_i2_rel, "jump_if_lt_i2_rel"},
- {geq_i2, "geq_i2", jump_if_not_geq_i2_rel, "jump_if_not_geq_i2_rel", jump_if_geq_i2_rel, "jump_if_geq_i2_rel"},
- {leq_i2, "leq_i2", jump_if_not_leq_i2_rel, "jump_if_not_leq_i2_rel", jump_if_leq_i2_rel, "jump_if_leq_i2_rel"},
-
- {equal_f2, "equal_f2", jump_if_not_equal_f2_rel, "jump_if_not_equal_f2_rel", jump_if_equal_f2_rel, "jump_if_equal_f2_rel"},
- {gt_f2, "gt_f2", jump_if_not_gt_f2_rel, "jump_if_not_gt_f2_rel", jump_if_gt_f2_rel, "jump_if_gt_f2_rel"},
- {lt_f2, "lt_f2", jump_if_not_lt_f2_rel, "jump_if_not_lt_f2_rel", jump_if_lt_f2_rel, "jump_if_lt_f2_rel"},
- {geq_f2, "geq_f2", jump_if_not_geq_f2_rel, "jump_if_not_geq_f2_rel", jump_if_geq_f2_rel, "jump_if_geq_f2_rel"},
- {leq_f2, "leq_f2", jump_if_not_leq_f2_rel, "jump_if_not_leq_f2_rel", jump_if_leq_f2_rel, "jump_if_leq_f2_rel"},
-
- {equal_i3, "equal_i3", jump_if_not_equal_i3_rel, "jump_if_not_equal_i3_rel", jump_if_equal_i3_rel, "jump_if_equal_i3_rel"},
- {gt_i3, "gt_i3", jump_if_not_gt_i3_rel, "jump_if_not_gt_i3_rel", jump_if_gt_i3_rel, "jump_if_gt_i3_rel"},
- {lt_i3, "lt_i3", jump_if_not_lt_i3_rel, "jump_if_not_lt_i3_rel", jump_if_lt_i3_rel, "jump_if_lt_i3_rel"},
- {geq_i3, "geq_i3", jump_if_not_geq_i3_rel, "jump_if_not_geq_i3_rel", jump_if_geq_i3_rel, "jump_if_geq_i3_rel"},
- {leq_i3, "leq_i3", jump_if_not_leq_i3_rel, "jump_if_not_leq_i3_rel", jump_if_leq_i3_rel, "jump_if_leq_i3_rel"},
-
- {equal_f3, "equal_f3", jump_if_not_equal_f3_rel, "jump_if_not_equal_f3_rel", jump_if_equal_f3_rel, "jump_if_equal_f3_rel"},
- {gt_f3, "gt_f3", jump_if_not_gt_f3_rel, "jump_if_not_gt_f3_rel", jump_if_gt_f3_rel, "jump_if_gt_f3_rel"},
- {lt_f3, "lt_f3", jump_if_not_lt_f3_rel, "jump_if_not_lt_f3_rel", jump_if_lt_f3_rel, "jump_if_lt_f3_rel"},
- {geq_f3, "geq_f3", jump_if_not_geq_f3_rel, "jump_if_not_geq_f3_rel", jump_if_geq_f3_rel, "jump_if_geq_f3_rel"},
- {leq_f3, "leq_f3", jump_if_not_leq_f3_rel, "jump_if_not_leq_f3_rel", jump_if_leq_f3_rel, "jump_if_leq_f3_rel"},
-
- {odd_i, "odd_i", jump_if_even_i_rel, "jump_if_even_i_rel", jump_if_odd_i_rel, "jump_if_odd_i_rel"},
- {even_i, "even_i", jump_if_odd_i_rel, "jump_if_odd_i_rel", jump_if_even_i_rel, "jump_if_even_i_rel"},
-
- {zero_i, "zero_i", jump_if_not_zero_i_rel, "jump_if_not_zero_i_rel", jump_if_zero_i_rel, "jump_if_zero_i_rel"},
- {zero_f, "zero_f", jump_if_not_zero_f_rel, "jump_if_not_zero_f_rel", jump_if_zero_f_rel, "jump_if_zero_f_rel"},
- {negative_i, "negative_i", jump_if_not_negative_i_rel, "jump_if_not_negative_i_rel", jump_if_negative_i_rel, "jump_if_negative_i_rel"},
- {negative_f, "negative_f", jump_if_not_negative_f_rel, "jump_if_not_negative_f_rel", jump_if_negative_f_rel, "jump_if_negative_f_rel"},
- {positive_i, "positive_i", jump_if_not_positive_i_rel, "jump_if_not_positive_i_rel", jump_if_positive_i_rel, "jump_if_positive_i_rel"},
- {positive_f, "positive_f", jump_if_not_positive_f_rel, "jump_if_not_positive_f_rel", jump_if_positive_f_rel, "jump_if_positive_f_rel"},
-};
-
-
-static int find_if_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_IF_OPS; i++)
- if (prev_op->function == if_ops[i].func)
- return(i);
- return(-1);
-}
-
-#define JUMP_IF_FALSE false
-#define JUMP_IF_TRUE true
-
-static int if_jump_opt(ptree *prog, xen_value *jump_to_false, xen_value *if_value, bool jump_choice)
-{
- bool jumped = false;
- int current_pc;
- current_pc = prog->triple_ctr;
-
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- int loc;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (prev_op->args[0] == if_value->addr)
- {
- loc = find_if_op(prev_op);
- if (loc >= 0)
- {
- /* if it's "not", look at preceding op as well */
- if ((prev_op->function == not_b) &&
- (prog->triple_ctr > 1))
- {
- triple *p2_op;
- int not_loc;
- p2_op = prog->program[prog->triple_ctr - 2];
-
- if (p2_op->args[0] == prev_op->args[1])
- {
- not_loc = find_if_op(p2_op);
- if ((not_loc >= 0) &&
- (p2_op->function != not_b) &&
- (p2_op->args[0] == prev_op->args[1]))
- {
- if (jump_choice == JUMP_IF_FALSE)
- {
- p2_op->function = if_ops[not_loc].env_func;
- p2_op->op_name = if_ops[not_loc].env_func_name;
- }
- else
- {
- p2_op->function = if_ops[not_loc].mult_func;
- p2_op->op_name = if_ops[not_loc].mult_func_name;
- }
- p2_op->args[0] = jump_to_false->addr;
- p2_op->types[0] = R_INT;
-#if WITH_COUNTERS
- p2_op->func_loc = get_func_loc(p2_op->function, p2_op->op_name);
-#endif
- free_triple(prev_op);
- prog->triple_ctr--;
- prog->program[prog->triple_ctr] = NULL;
- current_pc = prog->triple_ctr - 1;
- jumped = true;
- }
- }
- }
-
- if (!jumped)
- {
- if (jump_choice == JUMP_IF_FALSE)
- {
- prev_op->function = if_ops[loc].mult_func;
- prev_op->op_name = if_ops[loc].mult_func_name;
- }
- else
- {
- prev_op->function = if_ops[loc].env_func;
- prev_op->op_name = if_ops[loc].env_func_name;
- }
- prev_op->args[0] = jump_to_false->addr;
- prev_op->types[0] = R_INT;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- current_pc = prog->triple_ctr - 1;
- jumped = true;
- }
- }
- }
- }
-
- if (!jumped)
- {
- current_pc = prog->triple_ctr;
- if (jump_choice == JUMP_IF_FALSE)
- add_triple_to_ptree(prog, va_make_triple(jump_if_not, "jump_if_not", 2, jump_to_false, if_value));
- else add_triple_to_ptree(prog, va_make_triple(jump_if, "jump_if", 2, jump_to_false, if_value));
- }
-
- return(current_pc);
-}
-
-
-static xen_value *if_form(ptree *prog, s7_pointer form, walk_result_t need_result)
-{
- /* form: (if selector true [false]) */
- xen_value *result = NULL, *true_result = NULL, *false_result = NULL;
- xen_value *jump_to_end = NULL, *jump_to_false, *if_value;
- int current_pc, false_pc = 0;
- bool has_false;
-
- has_false = (s7_list_length(s7, form) == 4);
- if_value = walk(prog, scheme_cadr(form), NEED_ANY_RESULT); /* walk selector */
-
- if (if_value == NULL)
- {
- if (run_warned) /* must have been some error in walk, passing it back to us */
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("if: bad selector? %s", temp = s7_object_to_c_string(s7, scheme_cadr(form)));
- if (temp) free(temp);
- return(rv);
- }
- /* else whatever it is, it has to be true? */
- /* (let ((pr (cons 1 2))) (run (lambda () (if pr 1 2)))) */
- if_value = make_xen_value(R_BOOL, add_int_to_ptree(prog, true), R_CONSTANT);
- }
-
- if (if_value->type != R_BOOL) /* all ints are true */
- if_value = coerce_to_boolean(prog, if_value);
- if (if_value->constant == R_CONSTANT)
- {
- /* just ignore branch that can't be evaluated anyway */
- if (prog->ints[if_value->addr])
- {
- free(if_value);
- return(walk(prog, scheme_caddr(form), need_result));
- }
- if (has_false)
- {
- free(if_value);
- return(walk(prog, scheme_cadddr(form), need_result));
- }
- return(if_value);
- }
-
- jump_to_false = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- current_pc = if_jump_opt(prog, jump_to_false, if_value, JUMP_IF_FALSE);
- free(if_value);
-
- true_result = walk(prog, scheme_caddr(form), need_result); /* walk true branch */
- if (true_result == NULL)
- {
- xen_value *rv;
- char *temp = NULL;
- free(jump_to_false);
- rv = run_warn("if: can't handle true branch %s", temp = s7_object_to_c_string(s7, scheme_caddr(form)));
- if (temp) free(temp);
- return(rv);
- }
- if (need_result != DONT_NEED_RESULT)
- {
- result = add_temporary_var_to_ptree(prog, true_result->type);
- set_var_no_opt(prog, result, true_result);
- }
- if (has_false)
- {
- false_pc = prog->triple_ctr;
- jump_to_end = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(jump, "jump", 1, jump_to_end)); /* jump to end (past false) */
- }
- prog->ints[jump_to_false->addr] = prog->triple_ctr - current_pc - 1; /* fixup jump-to-false addr */
- free(jump_to_false);
-
- if (has_false)
- {
- false_result = walk(prog, scheme_cadddr(form), need_result); /* walk false branch */
- /* if false_result is null, that is an error even if need_result is DONT_NEED_RESULT (since the false branch does exist) */
- if (false_result == NULL)
- {
- char *temp = NULL;
- run_warn("if: can't handle false branch %s", temp = s7_object_to_c_string(s7, scheme_cadddr(form)));
- if (temp) free(temp);
- if (result) free(result);
- if (jump_to_end) free(jump_to_end);
- if (true_result) free(true_result);
- return(NULL);
- }
-
- if (need_result != DONT_NEED_RESULT)
- {
- if (false_result->type != true_result->type)
- {
- /* #f is ok as null pointer so fixup if needed */
-#if USE_SND
- if ((false_result->type == R_BOOL) &&
- ((true_result->type == R_CLM) ||
- (true_result->type == R_SAMPLER)))
-#else
- if ((false_result->type == R_BOOL) &&
- (true_result->type == R_CLM))
-#endif
- false_result->type = true_result->type;
- else
- {
-#if USE_SND
- if ((true_result->type == R_BOOL) &&
- ((false_result->type == R_CLM) ||
- (false_result->type == R_SAMPLER)))
-#else
- if ((true_result->type == R_BOOL) &&
- (false_result->type == R_CLM))
-#endif
- true_result->type = false_result->type;
- }
- }
-
- if (false_result->type != true_result->type)
- {
- run_warn("if branch types differ incompatibly: %s and %s", type_name(true_result->type), type_name(false_result->type));
- if (result) free(result);
- if (false_result) free(false_result);
- if (jump_to_end) free(jump_to_end);
- if (true_result) free(true_result);
- return(NULL);
- }
- if (result) set_var_no_opt(prog, result, false_result);
- }
-
- prog->ints[jump_to_end->addr] = prog->triple_ctr - false_pc - 1; /* fixup jump-past-false addr */
- free(jump_to_end);
- }
- else
- {
- if (jump_to_end) free(jump_to_end);
- if (result) free(result);
- return(true_result);
- }
- if (true_result) free(true_result);
- if (false_result) free(false_result);
- if (result)
- return(result);
- return(make_xen_value(R_UNSPECIFIED, -1, R_CONSTANT));
-}
-
-
-static xen_value *cond_form(ptree *prog, s7_pointer form, walk_result_t need_result)
-{
- xen_value *result = NULL, *test_value = NULL, *clause_value = NULL, *jump_to_next_clause = NULL;
- xen_value **fixups = NULL;
- int current_pc = 0, len, clause_ctr, i = 0, local_len;
- s7_pointer clauses, clause, local_clauses;
-
- clauses = s7_cdr(form);
- len = s7_list_length(s7, clauses);
- if (len == 0) return(run_warn("empty cond?"));
- fixups = (xen_value **)calloc(len, sizeof(xen_value *));
-
- for (clause_ctr = 0; clause_ctr < len; clause_ctr++, clauses = s7_cdr(clauses))
- {
- clause = s7_car(clauses);
- /* check car -- if #t evaluate rest */
- if ((s7_is_symbol(s7_car(clause))) &&
- (safe_strcmp("else", s7_symbol_name(s7_car(clause))) == 0))
- test_value = make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)true), R_CONSTANT);
- else test_value = walk(prog, s7_car(clause), NEED_ANY_RESULT);
- if (test_value == NULL)
- {
- xen_value *rv;
- char *temp = NULL;
- for (i = 0; i < clause_ctr; i++)
- if (fixups[i]) free(fixups[i]);
- free(fixups);
- rv = run_warn("cond test: %s", temp = s7_object_to_c_string(s7, s7_car(clause)));
- if (temp) free(temp);
- return(rv);
- }
-
- /* this coercion clobbers the result if there are no clauses:
- if (test_value->type != R_BOOL)
- test_value = coerce_to_boolean(prog, test_value);
- */
-
- /* test was not #f */
- local_clauses = s7_cdr(clause); /* can be null */
- local_len = s7_list_length(s7, local_clauses);
- if (local_len > 0)
- {
- jump_to_next_clause = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- current_pc = if_jump_opt(prog, jump_to_next_clause, test_value, JUMP_IF_FALSE);
-
- clause_value = walk_sequence(prog, local_clauses, need_result, "cond");
- if (clause_value == NULL)
- {
- free(test_value);
- free(jump_to_next_clause);
- for (i = 0; i < clause_ctr; i++)
- if (fixups[i]) free(fixups[i]);
- free(fixups);
- return(NULL);
- }
- }
- else clause_value = copy_xen_value(test_value);
- /* now at end of this cond clause block -- fixup the jump if false above, add jump past rest if true */
- if (need_result != DONT_NEED_RESULT)
- {
- if (result == NULL)
- result = add_temporary_var_to_ptree(prog, clause_value->type);
- else
- {
- if (result->type != clause_value->type)
- {
- run_warn("cond clause types differ: %s %s", type_name(clause_value->type), type_name(result->type));
- free(clause_value);
- free(result);
- if (jump_to_next_clause) free(jump_to_next_clause);
- for (i = 0; i < clause_ctr; i++)
- if (fixups[i]) free(fixups[i]);
- free(fixups);
- return(NULL);
- }
- }
- set_var(prog, result, clause_value);
- }
- fixups[clause_ctr] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(jump_abs, "jump_abs", 1, fixups[clause_ctr]));
- /* we jump to here is test was false */
- if (jump_to_next_clause)
- {
- prog->ints[jump_to_next_clause->addr] = prog->triple_ctr - current_pc - 1;
- free(jump_to_next_clause);
- jump_to_next_clause = NULL;
- }
- free(clause_value);
- clause_value = NULL;
- free(test_value);
- test_value = NULL;
- }
-
- /* all the fixups are absolute jumps */
- for (i = 0; i < len; i++)
- if (fixups[i])
- {
- prog->ints[fixups[i]->addr] = prog->triple_ctr;
- free(fixups[i]);
- }
- if (fixups) free(fixups);
- if (need_result != DONT_NEED_RESULT)
- return(result);
- if (result) free(result);
- return(make_xen_value(R_UNSPECIFIED, -1, R_CONSTANT));
-}
-
-
-static xen_value *case_form(ptree *prog, s7_pointer form, walk_result_t need_result)
-{
- /* only int (constant) selectors here */
- /* (case selector ((...) exp ...) ...) with possible 'else' */
- s7_pointer selector, body, keys, key;
- int i, j, body_len, num_keys, cur_key;
- xen_value *selval = NULL, *jump_to_selection = NULL, *v = NULL, *result = NULL, *keyval = NULL, *locval = NULL, *elseval = NULL;
- int *locations = NULL;
- xen_value **fixups = NULL;
-
- selector = scheme_cadr(form);
- selval = walk(prog, selector, NEED_ANY_RESULT);
-
- if (selval == NULL)
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("can't handle case selector: %s", temp = s7_object_to_c_string(s7, selector));
- if (temp) free(temp);
- return(rv);
- }
-
- if (selval->type != R_INT)
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("case only with ints: %s", temp = s7_object_to_c_string(s7, selector));
- if (temp) free(temp);
- return(rv);
- }
-
- jump_to_selection = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(jump_abs, "jump_abs", 1, jump_to_selection));
- body = scheme_cddr(form);
- body_len = s7_list_length(s7, body);
- fixups = (xen_value **)calloc(body_len, sizeof(xen_value *));
- locations = (int *)calloc(body_len, sizeof(int));
-
- for (i = 0; i < body_len; i++, body = s7_cdr(body))
- {
- /* ignore keys for now */
- locations[i] = prog->triple_ctr;
- v = walk_sequence(prog, scheme_cdar(body), need_result, "case");
- if (v == NULL) goto CASE_ERROR;
- if (need_result != DONT_NEED_RESULT)
- {
- if (result == NULL)
- result = add_temporary_var_to_ptree(prog, v->type);
- else
- if (result->type != v->type)
- {
- run_warn("case clause types differ: %s %s", type_name(v->type), type_name(result->type));
- free(v); v = NULL;
- }
- if (v) set_var(prog, result, v);
- }
- if (v == NULL) goto CASE_ERROR;
- free(v); v = NULL;
- fixups[i] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(jump_abs, "jump_abs", 1, fixups[i]));
- }
-
- /* fixup jump from selector to table of keys (here) */
- prog->ints[jump_to_selection->addr] = prog->triple_ctr;
- free(jump_to_selection); jump_to_selection = NULL;
- /* now make the selection */
- body = scheme_cddr(form);
- for (i = 0; i < body_len; i++, body = s7_cdr(body))
- {
- keys = scheme_caar(body);
- if (s7_is_symbol(keys))
- {
- if ((s7_is_symbol(keys)) &&
- (safe_strcmp(s7_symbol_name(keys), "else") == 0))
- elseval = make_xen_value(R_INT, i, R_CONSTANT);
- else
- {
- char *temp = NULL;
- run_warn("bad case key: %s", temp = s7_object_to_c_string(s7, keys));
- if (temp) free(temp);
- goto CASE_ERROR;
- }
- }
- else
- {
- num_keys = s7_list_length(s7, keys);
- for (j = 0; j < num_keys; j++, keys = s7_cdr(keys))
- {
- key = s7_car(keys);
- if (!(s7_is_integer(key)))
- {
- char *temp = NULL;
- run_warn("case only accepts integer selectors: %s", temp = s7_object_to_c_string(s7, key));
- if (temp) free(temp);
- goto CASE_ERROR;
- }
- cur_key = s7_number_to_integer(key);
- keyval = make_xen_value(R_INT, add_int_to_ptree(prog, cur_key), R_CONSTANT);
- locval = make_xen_value(R_INT, add_int_to_ptree(prog, locations[i]), R_CONSTANT);
- add_triple_to_ptree(prog, va_make_triple(jump_if_equal, "jump_if_equal", 3, locval, selval, keyval));
- free(keyval); keyval = NULL;
- free(locval); locval = NULL;
- }
- }
- }
-
- /* now check for else clause */
- if (elseval)
- {
- locval = make_xen_value(R_INT, add_int_to_ptree(prog, locations[elseval->addr]), R_CONSTANT);
- add_triple_to_ptree(prog, va_make_triple(jump_abs, "jump_abs", 1, locval));
- free(locval);
- free(elseval);
- }
- free(locations);
- if (fixups)
- {
- for (i = 0; i < body_len; i++)
- if (fixups[i])
- {
- prog->ints[fixups[i]->addr] = prog->triple_ctr;
- free(fixups[i]);
- }
- free(fixups);
- }
- if (selval) free(selval);
- if (need_result != DONT_NEED_RESULT)
- return(result);
- return(make_xen_value(R_UNSPECIFIED, -1, R_CONSTANT));
-
- CASE_ERROR:
- /* try to avoid endless repetition of cleanup code */
- if (selval) free(selval);
- if (fixups)
- {
- for (j = 0; j < body_len; j++)
- if (fixups[j])
- free(fixups[j]);
- free(fixups);
- }
- if (locations) free(locations);
- if (result) free(result);
- if (jump_to_selection) free(jump_to_selection);
- return(NULL);
-}
-
-
-static bool list_member(s7_pointer symb, s7_pointer varlst)
-{
- s7_pointer lst;
- for (lst = varlst; lst != scheme_nil; lst = s7_cdr(lst))
- if (s7_is_eq(symb, s7_car(lst)))
- return(true);
- return(false);
-}
-
-
-static bool tree_member(s7_pointer varlst, s7_pointer expr)
-{
- /* is any member of varlst found in expr */
- /* search expr (assumed to be a list here) for reference to any member of varlst */
- s7_pointer symb;
- if (expr == scheme_nil) return(false);
- symb = s7_car(expr);
- if (s7_is_symbol(symb))
- {
- if (list_member(symb, varlst))
- return(true);
- }
- else
- {
- if ((s7_is_list(s7, symb)) && (tree_member(varlst, symb)))
- return(true);
- }
- return(tree_member(varlst, s7_cdr(expr)));
-}
-
-
-static xen_value *do_warn_of_type_trouble(int var_type, int expr_type, s7_pointer form)
-{
- /*
- * do (or parallel_bind) var that's initialized to int, then treated as float truncates
- * so (do ((i 0 (+ i 0.5)))...) i is always 0
- * (run (lambda () (do ((i 0 (+ i 0.5)) (j 0 (1+ j))) ((>= j 3)) (display i)))) -> 000
- */
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("do variable init and step types differ: %s, init = %s, step = %s",
- temp = s7_object_to_c_string(s7, form),
- type_name(var_type),
- type_name(expr_type));
- if (temp) free(temp);
- return(rv);
-}
-
-#define INC_AND_JUMP_MAYBE() \
- (INT_ARG_1)++; \
- if (INT_ARG_1 != INT_ARG_2) \
- pt->pc = pt->program + pt->ints[args[0]]; \
- else pt->pc += 2;
-
-
-static void add_f2_inc_and_jump_maybe(int *args, ptree *pt)
-{
- FLOAT_ARG_3 = (FLOAT_ARG_4 + FLOAT_ARG_5); /* all add 3 */
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void locsig_3f_mono_no_rev_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_locsig_mono_no_reverb(CLM_ARG_4, INT_ARG_5, FLOAT_ARG_6);
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void locsig_v_mono_no_rev_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_locsig_mono_no_reverb(CLM_ARG_8, INT_ARG_9, FLOAT_ARG_7 * mus_oscil_fm(CLM_ARG_4, FLOAT_ARG_5 + FLOAT_ARG_6));
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void sin_f_add_inc_and_jump_maybe(int *args, ptree *pt)
-{
- FLOAT_ARG_3 = FLOAT_ARG_5 + sin(FLOAT_ARG_4);
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void locsig_v_stereo_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_locsig_stereo(CLM_ARG_8, INT_ARG_9, FLOAT_ARG_7 * mus_oscil_fm(CLM_ARG_4, FLOAT_ARG_5 + FLOAT_ARG_6));
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void outa_3f_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_out_any_to_file(CLM_ARG_6, INT_ARG_4, 0, FLOAT_ARG_5);
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void outa_multiply_f3_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_out_any_to_file(CLM_ARG_6, INT_ARG_4, 0, FLOAT_ARG_5 * FLOAT_ARG_7 * FLOAT_ARG_8);
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void frame_set_0r_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_frame_set(CLM_ARG_4, INT_ARG_5, FLOAT_ARG_6);
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void vct_set_f_inc_and_jump_maybe(int *args, ptree *pt)
-{
- VCT_ARG_4->data[INT_ARG_5] = FLOAT_ARG_6; FLOAT_ARG_3 = FLOAT_ARG_6;
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void set_scaler_f_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_set_scaler(CLM_ARG_3, FLOAT_ARG_4);
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void outa_multiply_f2_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_out_any_to_file(CLM_ARG_6, INT_ARG_4, 0, FLOAT_ARG_5 * FLOAT_ARG_7);
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void outa_polywave_1_mult_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_out_any_to_file(CLM_ARG_6, INT_ARG_4, 0, FLOAT_ARG_8 * mus_polywave(CLM_ARG_7, FLOAT_ARG_5));
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void outa_oscil_1_mult_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_out_any_to_file(CLM_ARG_6, INT_ARG_4, 0, FLOAT_ARG_8 * mus_oscil_fm(CLM_ARG_7, FLOAT_ARG_5));
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void outa_add_f2_mult_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_out_any_to_file(CLM_ARG_6, INT_ARG_4, 0, FLOAT_ARG_8 * (FLOAT_ARG_5 + FLOAT_ARG_7));
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void sound_data_set_f_inc_and_jump_maybe(int *args, ptree *pt)
-{
- SOUND_DATA_ARG_4->data[INT_ARG_5][INT_ARG_6] = FLOAT_ARG_7;
- FLOAT_ARG_3 = FLOAT_ARG_7;
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void outa_add_f3_mult_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_out_any_to_file(CLM_ARG_6, INT_ARG_4, 0, FLOAT_ARG_7 * (FLOAT_ARG_5 + FLOAT_ARG_8 + FLOAT_ARG_9));
- INC_AND_JUMP_MAYBE();
-}
-
-
-static void locsig_v_mono_inc_and_jump_maybe(int *args, ptree *pt)
-{
- mus_locsig_mono(CLM_ARG_8, INT_ARG_9, FLOAT_ARG_7 * mus_oscil_fm(CLM_ARG_4, FLOAT_ARG_5 + FLOAT_ARG_6));
-}
-
-
-
-#define NUM_DO_OPS 17
-
-static opt_ops do_ops[NUM_DO_OPS] = {
- {locsig_v_mono_no_rev, "locsig_v_mono_no_rev", locsig_v_mono_no_rev_inc_and_jump_maybe, "locsig_v_mono_no_rev_inc_and_jump_maybe", NULL, NULL},
- {add_f2, "add_f2", add_f2_inc_and_jump_maybe, "add_f2_inc_and_jump_maybe", NULL, NULL},
- {locsig_3f_mono_no_rev, "locsig_3f_mono_no_rev", locsig_3f_mono_no_rev_inc_and_jump_maybe, "locsig_3f_mono_no_rev_inc_and_jump_maybe", NULL, NULL},
- {sin_f_add, "sin_f_add", sin_f_add_inc_and_jump_maybe, "sin_f_add_inc_and_jump_maybe", NULL, NULL},
- {locsig_v_stereo, "locsig_v_stereo", locsig_v_stereo_inc_and_jump_maybe, "locsig_v_stereo_inc_and_jump_maybe", NULL, NULL},
- {locsig_v_mono, "locsig_v_mono", locsig_v_mono_inc_and_jump_maybe, "locsig_v_mono_inc_and_jump_maybe", NULL, NULL},
- {outa_3f, "outa_3f", outa_3f_inc_and_jump_maybe, "outa_3f_inc_and_jump_maybe", NULL, NULL},
- {outa_multiply_f3, "outa_multiply_f3", outa_multiply_f3_inc_and_jump_maybe, "outa_multiply_f3_inc_and_jump_maybe", NULL, NULL},
- {outa_multiply_f2, "outa_multiply_f2", outa_multiply_f2_inc_and_jump_maybe, "outa_multiply_f2_inc_and_jump_maybe", NULL, NULL},
- {frame_set_0r, "frame_set_0r", frame_set_0r_inc_and_jump_maybe, "frame_set_0r_inc_and_jump_maybe", NULL, NULL},
- {vct_set_f, "vct_set_f(1)", vct_set_f_inc_and_jump_maybe, "vct_set_f_inc_and_jump_maybe", NULL, NULL},
- {set_scaler_f, "set_scaler_f", set_scaler_f_inc_and_jump_maybe, "set_scaler_f_inc_and_jump_maybe", NULL, NULL},
- {outa_polywave_1_mult, "outa_polywave_1_mult", outa_polywave_1_mult_inc_and_jump_maybe, "outa_polywave_1_mult_inc_and_jump_maybe", NULL, NULL},
- {outa_oscil_1_mult, "outa_oscil_1_mult", outa_oscil_1_mult_inc_and_jump_maybe, "outa_oscil_1_mult_inc_and_jump_maybe", NULL, NULL},
- {outa_add_f2_mult, "outa_add_f2_mult", outa_add_f2_mult_inc_and_jump_maybe, "outa_add_f2_mult_inc_and_jump_maybe", NULL, NULL},
- {outa_add_f3_mult, "outa_add_f3_mult", outa_add_f3_mult_inc_and_jump_maybe, "outa_add_f3_mult_inc_and_jump_maybe", NULL, NULL},
- {sound_data_set_f, "sound_data_set_f", sound_data_set_f_inc_and_jump_maybe, "sound_data_set_f_inc_and_jump_maybe", NULL, NULL},
-};
-
-
-static int find_do_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_DO_OPS; i++)
- if (prev_op->function == do_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-static xen_value *do_form(ptree *prog, s7_pointer form, walk_result_t need_result)
-{
- /* (do ([(var val [up])...]) (test [res ...]) [exp ...]): (do () (#t)) */
-
- xen_value *result = NULL, *test, *expr, *jump_to_test, *jump_to_body, **exprs = NULL;
- s7_pointer var, vars, done, body, results, test_form;
- xen_var *vr;
- int i, locals_loc, varlen, body_loc;
- char *trouble;
-
- vars = scheme_cadr(form);
- done = scheme_caddr(form);
- if (done == scheme_nil) return(run_warn("do: null test"));
- body = scheme_cdddr(form);
- test_form = s7_car(done);
- results = s7_cdr(done);
-
- /* init step vars */
- locals_loc = prog->var_ctr; /* lets can be nested */
- trouble = parallel_binds(prog, vars, "do");
- if (trouble) return(run_warn_with_free(trouble));
-
- /* jump to end test (location fixed up later) */
- jump_to_test = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(jump_abs, "jump_abs", 1, jump_to_test));
-
- /* walk the do body */
- body_loc = prog->triple_ctr;
- expr = walk_sequence(prog, body, DONT_NEED_RESULT, "do");
- if (expr == NULL) /* if do body is empty, expr => #f (not NULL) -- shouldn't NULL trigger run_warn? */
- {
- free(jump_to_test);
- return(NULL);
- }
- free(expr);
- expr = NULL;
-
- /* now increment the vars (if step-val exists) -- increments are done first (the norm in Scheme) */
- varlen = s7_list_length(s7, vars);
- if (varlen > 0)
- {
- bool sequential = true;
- if (varlen > 1) /* 0=doesn't matter, 1=no possible non-sequential ref */
- /* the step expr can refer to a previous do local var, but it is to the previous value -- very weird semantics */
- {
- int loc;
- s7_pointer varlst = scheme_nil, update = scheme_false;
- loc = s7_gc_protect(s7, varlst);
- vars = scheme_cadr(form);
- varlst = s7_cons(s7, scheme_caar(vars), varlst);
- for (vars = s7_cdr(vars), i = 1; i < varlen; i++, vars = s7_cdr(vars))
- {
- var = s7_car(vars);
- /* current var is CAR(var), init can be ignored (it would refer to outer var), update is CADDR(var) */
- /* we'll scan CADDR for any member of varlst */
- if ((scheme_cddr(var) != scheme_nil) &&
- (scheme_caddr(var) != scheme_nil))
- {
- /* if update null, can't be ref */
- update = scheme_caddr(var);
- if (((s7_is_list(s7, update)) && (tree_member(varlst, update))) ||
- ((s7_is_symbol(update)) && (list_member(update, varlst))))
- {
- /* fprintf(stderr, "found seq ref %s\n", s7_object_to_c_string(s7, vars)); */
- sequential = false;
- break;
- }
- }
- varlst = s7_cons(s7, s7_car(var), varlst);
- }
- s7_gc_unprotect_at(s7, loc);
- if (!sequential)
- exprs = (xen_value **)calloc(varlen, sizeof(xen_value *));
- }
- for (vars = scheme_cadr(form), i = 0; i < varlen; i++, vars = s7_cdr(vars))
- {
- var = s7_car(vars);
- if ((scheme_cddr(var) != scheme_nil) &&
- (scheme_caddr(var) != scheme_nil))
- {
- if ((sequential) && (expr)) free(expr);
- expr = walk(prog, scheme_caddr(var), NEED_ANY_RESULT);
- /* (run-eval '(do ((i 0 (1+ i)) (j 0 (1+ i)) (k 0 (hiho k))) ((= i 3)) 0)) */
- if (expr == NULL)
- {
- if (exprs)
- {
- int k;
- for (k = 0; k < i; k++) if (exprs[k]) free(exprs[k]);
- free(exprs);
- }
- free(jump_to_test);
- return(NULL);
- }
-
- if (sequential)
- {
- vr = find_var_in_ptree(prog, s7_symbol_name(s7_car(var)));
-
- if (vr->v->type != expr->type)
- {
- if (exprs)
- {
- int k;
- for (k = 0; k < i; k++) if (exprs[k]) free(exprs[k]);
- free(exprs);
- }
- free(jump_to_test);
- return(do_warn_of_type_trouble(vr->v->type, expr->type, var));
- }
-
- if (((expr->type == R_FLOAT) || (expr->type == R_INT)) &&
- (s7_is_list(s7, scheme_caddr(var))) && /* otherwise no intermediate was generated */
- (prog->triple_ctr > 0))
- {
- /* as in set!, if possible, simply redirect the previous store to us (implicit set) */
- triple *prev_op;
- int *addrs;
- prev_op = prog->program[prog->triple_ctr - 1];
- addrs = prev_op->args;
- if ((addrs) &&
- (addrs[0] == expr->addr))
- {
- addrs[0] = vr->v->addr; /* redirect the store to us */
- /* look for simple increment cases */
- if ((prev_op->function == add_i2) &&
- (((addrs[1] != addrs[0]) && (prev_op->types[1] == R_CONSTANT) && (prog->ints[addrs[1]] == 1)) ||
- ((addrs[2] != addrs[0]) && (prev_op->types[2] == R_CONSTANT) && (prog->ints[addrs[2]] == 1))))
- {
- prev_op->function = inc_i_1;
- prev_op->op_name = "inc_i_1";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- }
- }
- else set_var(prog, vr->v, expr);
- }
- else set_var(prog, vr->v, expr);
- }
- else
- {
- /* here if expr is a variable reference (not a temp or a constant), we need to sequester it,
- * since the variable in question may be updated before we re-reference it
- */
- if (s7_is_symbol(scheme_caddr(var)))
- {
- xen_value *temp;
- vr = find_var_in_ptree(prog, s7_symbol_name(scheme_caddr(var)));
- temp = add_empty_var_to_ptree(prog, vr->v->type);
-
- if (temp->type != expr->type)
- {
- free(jump_to_test);
- return(do_warn_of_type_trouble(temp->type, expr->type, var));
- }
- set_var(prog, temp, expr);
- free(expr);
- expr = NULL;
- exprs[i] = temp;
- }
- else exprs[i] = expr;
- }
- }
- }
- if ((sequential) && (expr)) free(expr);
- if (!sequential)
- {
- for (vars = scheme_cadr(form), i = 0; i < varlen; i++, vars = s7_cdr(vars))
- if (exprs[i])
- {
- var = s7_car(vars);
- vr = find_var_in_ptree(prog, s7_symbol_name(s7_car(var)));
-
- if (vr->v->type != exprs[i]->type)
- {
- free(jump_to_test);
- return(do_warn_of_type_trouble(vr->v->type, exprs[i]->type, var));
- }
- set_var(prog, vr->v, exprs[i]);
- free(exprs[i]);
- }
- free(exprs);
- }
- }
-
- /* test for repeat */
- prog->ints[jump_to_test->addr] = prog->triple_ctr;
- free(jump_to_test);
- jump_to_test = NULL;
-
- test = walk(prog, test_form, NEED_ANY_RESULT);
- if (test == NULL)
- return(NULL);
-
- if (test->type != R_BOOL)
- {
- xen_value *rv;
- char *temp = NULL;
- free(test);
- rv = run_warn("do test must be boolean: %s", temp = s7_object_to_c_string(s7, test_form));
- if (temp) free(temp);
- return(rv);
- }
-
- jump_to_body = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- prog->ints[jump_to_body->addr] = body_loc;
-
- /* the other cases, such as geq_i2, don't happen very often in current instruments */
-
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (prev_op->function == equal_i2) /* BOOL_RESULT = (INT_ARG_1 == INT_ARG_2) */
- {
- if (prog->triple_ctr > 1)
- {
- triple *p_op;
- p_op = prog->program[prog->triple_ctr - 2];
- if ((p_op->function == inc_i_1) && /* INT_RESULT++ (op->args[0]) */
- (p_op->args[0] == prev_op->args[1]))
- {
- /* p_op is inc i0++, prev_op is equal i1 i2, where one of the args is the same as the inc result
- * we want the inc'd arg in i1, the other in i2, jump loc in arg0
- */
- p_op->args[1] = prev_op->args[1];
- p_op->args[2] = prev_op->args[2];
- p_op->args[0] = jump_to_body->addr;
- p_op->types[0] = R_INT;
-
- p_op->function = inc_and_jump_if_not_equal;
- p_op->op_name = "inc_and_jump_if_not_equal";
-#if WITH_COUNTERS
- p_op->func_loc = get_func_loc(p_op->function, p_op->op_name);
-#endif
- /* prev_op has to be left in place -- it is the target of the original (pre increment) jump */
-
- if (prog->triple_ctr > 1)
- {
- triple *p2_op;
- int loc;
- p2_op = prog->program[prog->triple_ctr - 3];
- loc = find_do_op(p2_op);
- if (loc >= 0)
- {
- int k, p2_args;
- p2_args = p2_op->num_args;
-
- p2_op->types = (int *)realloc(p2_op->types, (p2_args + 3) * sizeof(int));
- p2_op->args = (int *)realloc(p2_op->args, (p2_args + 3) * sizeof(int));
- for (k = p2_args - 1; k >= 0; k--)
- {
- p2_op->args[k + 3] = p2_op->args[k];
- p2_op->types[k + 3] = p2_op->types[k];
- }
- for (k = 0; k < 3; k++)
- {
- p2_op->args[k] = p_op->args[k];
- p2_op->types[k] = p_op->types[k];
- }
- p2_op->num_args = p2_args + 3;
- p2_op->function = do_ops[loc].mult_func;
- p2_op->op_name = do_ops[loc].mult_func_name;
-#if WITH_COUNTERS
- p2_op->func_loc = get_func_loc(p2_op->function, p2_op->op_name);
-#endif
- }
- }
- }
- }
- /* change previous instruction to jump_if_not_equal */
- prev_op->function = jump_if_not_equal; /* if (INT_ARG_1 != INT_ARG_2) goto pt->ints[args[0]] */
- prev_op->args[0] = jump_to_body->addr;
- prev_op->types[0] = R_INT;
- prev_op->op_name = "jump_if_not_equal";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- }
- else
- {
- if (prev_op->function == not_b)
- {
- /* change previous instruction to jump_if_abs */
- prev_op->function = jump_if_abs;
- prev_op->args[0] = jump_to_body->addr;
- prev_op->types[0] = R_INT;
- prev_op->op_name = "jump_if_abs";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- }
- else
- {
- add_triple_to_ptree(prog, va_make_triple(jump_if_not_abs, "jump_if_not_abs", 2, jump_to_body, test));
- }
- }
- }
- free(jump_to_body);
- free(test);
-
- /* now the result block */
- if (results != scheme_nil)
- result = walk_sequence(prog, results, NEED_ANY_RESULT, "do");
- else result = make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT);
- undefine_locals(prog, locals_loc);
- return(result);
-}
-
-
-static xen_value *callcc_form(ptree *prog, s7_pointer form, walk_result_t need_result)
-{
- s7_pointer func_form, continuation_name;
- continuation *c;
- xen_value *v = NULL;
-
- func_form = scheme_cadr(form);
- continuation_name = s7_car(scheme_cadr(func_form));
- c = add_goto_to_ptree(prog, s7_symbol_name(continuation_name));
-
- v = walk_sequence(prog, scheme_cddr(func_form), need_result, "call/cc");
- if (v == NULL) return(NULL);
-
- if (c->result)
- {
- if (v->type != c->result->type)
- {
- free(v);
- return(run_warn("call/cc: types differ"));
- }
- if (need_result != DONT_NEED_RESULT)
- set_var(prog, c->result, v);
- }
- if (v) free(v);
-
- /* fixup the continuation jump, etc */
- prog->ints[c->jump->addr] = prog->triple_ctr;
- if (c->result)
- v = copy_xen_value(c->result);
- else v = make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT);
- erase_goto(prog, c->name); /* now access to this depends on a set! somewhere */
- return(v);
-}
-
-
-static xen_value *or_form(ptree *prog, s7_pointer form, walk_result_t ignored)
-{
- /* (or ...) returning as soon as not #f seen */
- s7_pointer body;
- xen_value *v = NULL, *result = NULL, *jump_to_end;
- xen_value **fixups;
- int i, j, body_forms;
-
- body = s7_cdr(form);
- body_forms = s7_list_length(s7, body);
- if (body_forms == 0) /* (or) -> #f */
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, 0), R_CONSTANT));
- fixups = (xen_value **)calloc(body_forms, sizeof(xen_value *));
-
- for (i = 0; i < body_forms; i++, body = s7_cdr(body))
- {
- v = walk(prog, s7_car(body), NEED_ANY_RESULT);
- if (v == NULL)
- {
- xen_value *rv;
- char *temp = NULL;
- for (j = 0; j < i; j++)
- if (fixups[j]) free(fixups[j]);
- free(fixups);
- rv = run_warn("or: can't handle %s", temp = s7_object_to_c_string(s7, s7_car(body)));
- if (temp) free(temp);
- return(rv);
- }
-
- if ((i == 0) &&
- (v->constant == R_CONSTANT) &&
- ((v->type != R_BOOL) || (prog->ints[v->addr] != 0)))
- {
- free(fixups);
- return(v);
- }
-
- if (v->type != R_BOOL)
- v = coerce_to_boolean(prog, v);
-
- fixups[i] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- prog->ints[fixups[i]->addr] = if_jump_opt(prog, fixups[i], v, JUMP_IF_TRUE);
-
- free(v);
- }
-
- /* if we fall through, return #f */
- result = make_xen_value(R_BOOL, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(store_false, "store_false", 1, result));
- jump_to_end = make_xen_value(R_INT, add_int_to_ptree(prog, prog->triple_ctr), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(jump, "jump", 1, jump_to_end));
-
- /* now fixup all the jumps to end up here */
- for (i = 0; i < body_forms; i++)
- {
- prog->ints[fixups[i]->addr] = prog->triple_ctr - prog->ints[fixups[i]->addr] - 1;
- free(fixups[i]);
- }
-
- add_triple_to_ptree(prog, va_make_triple(store_true, "store_true", 1, result));
- prog->ints[jump_to_end->addr] = prog->triple_ctr - prog->ints[jump_to_end->addr] - 1;
- free(jump_to_end);
- free(fixups);
- return(result);
-}
-
-
-static xen_value *and_form(ptree *prog, s7_pointer form, walk_result_t ignored)
-{
- /* (and ...) returning as soon as #f seen */
- s7_pointer body;
- xen_value *v = NULL, *result = NULL, *jump_to_end;
- xen_value **fixups;
- int i, j, body_forms;
-
- body = s7_cdr(form);
- body_forms = s7_list_length(s7, body);
- if (body_forms == 0) /* (and) -> #t */
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, 1), R_CONSTANT));
- fixups = (xen_value **)calloc(body_forms, sizeof(xen_value *));
-
- for (i = 0; i < body_forms; i++, body = s7_cdr(body))
- {
- v = walk(prog, s7_car(body), NEED_ANY_RESULT);
- if (v == NULL)
- {
- xen_value *rv;
- char *temp = NULL;
- for (j = 0; j < i; j++)
- if (fixups[j]) free(fixups[j]);
- free(fixups);
- rv = run_warn("and: can't handle %s", temp = s7_object_to_c_string(s7, s7_car(body)));
- if (temp) free(temp);
- return(rv);
- }
-
- if ((i == 0) &&
- (v->constant == R_CONSTANT) &&
- (v->type == R_BOOL) &&
- (prog->ints[v->addr] == 0))
- {
- free(fixups);
- return(v);
- }
-
- if (v->type != R_BOOL)
- v = coerce_to_boolean(prog, v);
- fixups[i] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- prog->ints[fixups[i]->addr] = if_jump_opt(prog, fixups[i], v, JUMP_IF_FALSE);
-
- free(v);
- }
-
- result = make_xen_value(R_BOOL, add_int_to_ptree(prog, 1), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(store_true, "store_true", 1, result));
- jump_to_end = make_xen_value(R_INT, add_int_to_ptree(prog, prog->triple_ctr), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(jump, "jump", 1, jump_to_end));
-
- /* now fixup all the jumps to end up here */
- for (i = 0; i < body_forms; i++)
- {
- prog->ints[fixups[i]->addr] = prog->triple_ctr - prog->ints[fixups[i]->addr] - 1;
- free(fixups[i]);
- }
-
- add_triple_to_ptree(prog, va_make_triple(store_false, "store_false", 1, result));
- prog->ints[jump_to_end->addr] = prog->triple_ctr - prog->ints[jump_to_end->addr] - 1;
- free(jump_to_end);
- free(fixups);
- return(result);
-}
-
-
-static xen_value *lookup_generalized_set(ptree *prog, s7_pointer accessor, xen_value *arg0, xen_value *arg1, xen_value *arg2, xen_value *new_value);
-
-static xen_value *generalized_set_form(ptree *prog, s7_pointer form)
-{
- /* (set! (mus-phase gen) 0.0) */
- s7_pointer settee, setval;
- s7_pointer in_settee;
- xen_value *in_v0 = NULL, *in_v1 = NULL, *in_v2 = NULL, *v = NULL;
-
- settee = scheme_cadr(form);
- setval = scheme_caddr(form);
-
- if ((s7_is_list(s7, settee)) &&
- (s7_is_symbol(s7_car(settee))) &&
- (s7_list_length(s7, settee) <= 4))
- {
- v = walk(prog, setval, NEED_ANY_RESULT);
- if (v == NULL)
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("set!: can't handle: %s", temp = s7_object_to_c_string(s7, setval));
- if (temp) free(temp);
- return(rv);
- }
-
- in_settee = s7_car(settee);
- if (s7_cdr(settee) != scheme_nil)
- {
- in_v0 = walk(prog, scheme_cadr(settee), NEED_ANY_RESULT);
- if ((in_v0) &&
- (in_v0->type != R_UNSPECIFIED))
- {
- if (scheme_cddr(settee) != scheme_nil)
- {
- in_v1 = walk(prog, scheme_caddr(settee), NEED_ANY_RESULT);
- if ((in_v1) &&
- (in_v1->type != R_UNSPECIFIED))
- {
- if (scheme_cdddr(settee) != scheme_nil)
- {
- in_v2 = walk(prog, scheme_cadddr(settee), NEED_ANY_RESULT);
- if ((in_v2) &&
- (in_v2->type != R_UNSPECIFIED))
- return(lookup_generalized_set(prog, in_settee, in_v0, in_v1, in_v2, v));
- }
- else return(lookup_generalized_set(prog, in_settee, in_v0, in_v1, NULL, v));
- }
- else return(lookup_generalized_set(prog, in_settee, in_v0, NULL, NULL, v));
- }
- else return(lookup_generalized_set(prog, in_settee, in_v0, NULL, NULL, v));
- }
- }
- else return(lookup_generalized_set(prog, in_settee, NULL, NULL, NULL, v));
-
- if (v) free(v);
- if (in_v0) free(in_v0);
- if (in_v1) free(in_v1);
- if (in_v2) free(in_v2);
- }
-
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("generalized set! for %s not implemented yet", temp = s7_object_to_c_string(s7, settee));
- if (temp) free(temp);
- return(rv);
- }
-}
-
-
-static xen_value *set_form(ptree *prog, s7_pointer form, walk_result_t ignore)
-{
- const char *varname = NULL;
- xen_var *var;
- xen_value *v;
- s7_pointer settee, setval, rtnval;
-
- settee = scheme_cadr(form);
- setval = scheme_caddr(form);
-
- if (!(s7_is_symbol(settee)))
- return(generalized_set_form(prog, form));
- varname = s7_symbol_name(settee);
- var = find_var_in_ptree(prog, varname);
- if (var == NULL)
- {
- v = add_global_var_to_ptree(prog, settee, &rtnval);
- if (v)
- {
- var = find_var_in_ptree(prog, varname);
- free(v);
- v = NULL;
- }
- }
-
- if ((var) && (!(var->unsettable)))
- {
- int val_type, var_type;
- v = walk(prog, setval, NEED_ANY_RESULT);
- if (v == NULL)
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("set!: can't handle: %s", temp = s7_object_to_c_string(s7, setval));
- if (temp) free(temp);
- return(rv);
- }
-
- if ((var->v->addr == v->addr) &&
- (var->v->type == v->type))
- return(v); /* a no-op: (set! a a) */
- val_type = v->type;
- var_type = var->v->type;
-
- /* two problematic cases: types differ and aren't compatible, or pointer aliasing */
- if (POINTER_P(val_type))
- {
- free(v);
- return(run_warn("can't set pointer var (%s) to alias other such var", varname));
- }
- if (val_type != var_type)
- {
- char *str = NULL, *temp = NULL;
- /* here #f is ok for pointer val */
- if ((val_type == R_GOTO) &&
- (var_type == R_BOOL))
- {
- var->v->type = R_GOTO;
- add_triple_to_ptree(prog, va_make_triple(store_i, "store_i", 2, var->v, v));
- return(v);
- }
- if ((val_type == R_BOOL) &&
- (POINTER_P(var_type)))
- {
- add_triple_to_ptree(prog, va_make_triple(store_i, "store_i", 2, var->v, v));
- var->unclean = true;
- return(v);
- }
-
- /* variables have only one type in this context */
- run_warn("set! can't change var's type (%s (%s) = %s (%s)): %s",
- var->name,
- type_name(var->v->type),
- str = describe_xen_value(v, prog),
- type_name(v->type),
- temp = s7_object_to_c_string(s7, form));
- if (str) free(str);
- if (temp) free(temp);
- free(v);
- return(NULL);
- /* this limitation could be removed, but is it worth the bother? */
- }
-
- /* optimize out redundant sets (can be cancelled via trp->no_opt) */
- if (((v->type == R_FLOAT) || (v->type == R_INT)) &&
- (s7_is_list(s7, setval)) && /* this by itself assumes that any list represents an expression (i.e. a temp in effect)
- * but clm-def-struct field references are lists that can be the target of a set
- * so we set the no_opt flag when producing the set
- */
- (prog->triple_ctr > 0) &&
- (((triple **)(prog->program))[prog->triple_ctr - 1]->no_opt == false))
- {
- /* if possible, simply redirect the previous store to us (implicit set) */
- /* (run '(let ((a 2) (b 1)) (set! a (+ b 1)))) */
- /* but don't try to optimize increments here: */
- /* (let ((a 0)) (run (lambda () (and (let ((b 32)) (if (< a 0) (set! a b) (set! a (+ 1 b))) #t) #f))) a) */
- triple *prev_op;
- int *addrs;
- prev_op = prog->program[prog->triple_ctr - 1];
- addrs = prev_op->args;
- if ((addrs) &&
- (addrs[0] == v->addr))
- {
- addrs[0] = var->v->addr; /* redirect the store to us */
- var->unclean = true;
- free(v);
- return(copy_xen_value(var->v));
-
- }
- }
- set_var(prog, var->v, v);
- var->unclean = true;
- return(v);
- }
-
- {
- xen_value *rv;
- char *temp = NULL;
- if ((var) &&
- (var->unsettable))
- rv = run_warn("set!: can't set: %s", temp = s7_object_to_c_string(s7, settee));
- else rv = run_warn("set! variable problem: %s", temp = s7_object_to_c_string(s7, form));
- if (temp) free(temp);
- return(rv);
- }
-}
-
-
-static xen_value *package(ptree *prog,
- int type,
- void (*function)(int *arg_addrs, ptree *pt),
- const char *descr,
- xen_value **args,
- int num_args)
-{
- args[0] = add_temporary_var_to_ptree(prog, type);
- add_triple_to_ptree(prog, make_triple(function, descr, args, num_args + 1));
- return(args[0]);
-}
-
-
-static xen_value *package_n(ptree *prog,
- int type,
- void (*function)(int *arg_addrs, ptree *pt),
- const char *descr,
- xen_value **args,
- int num_args)
-{
- int i;
- xen_value **new_args;
- new_args = (xen_value **)calloc(num_args + 2, sizeof(xen_value *));
- for (i = 1; i <= num_args; i++)
- new_args[i + 1] = args[i];
- new_args[1] = make_xen_value(R_INT, add_int_to_ptree(prog, num_args), R_CONSTANT);
- new_args[0] = add_temporary_var_to_ptree(prog, type);
- args[0] = new_args[0];
- add_triple_to_ptree(prog, make_triple(function, descr, new_args, num_args + 2));
- free(new_args[1]);
- free(new_args);
- return(args[0]);
-}
-
-
-static int float_all_args(ptree *prog, int num_args, xen_value **args, bool float_result)
-{
- int i, j;
- for (i = 1, j = 1; i <= num_args; i++)
- if (args[i])
- {
- if ((float_result) && (args[i]->type == R_INT))
- {
- xen_value *old_loc;
- old_loc = args[i];
- args[i] = NULL;
- args[j] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(store_i_f, "store_i_f", 2, args[j], old_loc));
- free(old_loc);
- j++;
- }
- else
- {
- args[j] = args[i];
- if (j != i) args[i] = NULL;
- j++;
- }
- }
- return(j - 1);
-}
-
-
-/* ---------------- multiply ---------------- */
-
-static void multiply_f2(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 * FLOAT_ARG_2);}
-
-
-static void multiply_f2_i(int *args, ptree *pt) {INT_RESULT = (Int)(FLOAT_ARG_1 * FLOAT_ARG_2);}
-
-
-static void multiply_f3(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 * FLOAT_ARG_2 * FLOAT_ARG_3);}
-
-
-static void multiply_f4(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 * FLOAT_ARG_2 * FLOAT_ARG_3 * FLOAT_ARG_4);}
-static void multiply_f5(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 * FLOAT_ARG_2 * FLOAT_ARG_3 * FLOAT_ARG_4 * FLOAT_ARG_5);}
-
-
-static void multiply_fn(int *args, ptree *pt)
-{
- int i, n;
- n = INT_ARG_1;
- FLOAT_RESULT = FLOAT_ARG_2;
- for (i = 1; i < n; i++) FLOAT_RESULT *= pt->dbls[args[i + 2]];
-}
-
-
-static void multiply_i2(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 * INT_ARG_2);}
-
-
-static void multiply_i3(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 * INT_ARG_2 * INT_ARG_3);}
-
-
-static void multiply_i4(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 * INT_ARG_2 * INT_ARG_3 * INT_ARG_4);}
-static void multiply_i5(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 * INT_ARG_2 * INT_ARG_3 * INT_ARG_4 * INT_ARG_5);}
-
-
-static void multiply_in(int *args, ptree *pt)
-{
- int i, n;
- n = INT_ARG_1;
- INT_RESULT = INT_ARG_2;
- for (i = 1; i < n; i++) INT_RESULT *= pt->ints[args[i + 2]];
-}
-
-
-static void multiply_i_f(int *args, ptree *pt) {FLOAT_RESULT = (INT_ARG_1 * FLOAT_ARG_2);}
-
-
-static void multiply_f_i(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 * INT_ARG_2);}
-
-
-static void multiply_f_i_i(int *args, ptree *pt) {INT_RESULT = (Int)(FLOAT_ARG_1 * INT_ARG_2);}
-
-
-
-
-/* 2 arg ops that can be combined into a multiply */
-#define NUM_M2_OPS 12
-
-static opt_ops m2_ops[NUM_M2_OPS] = {
- {oscil_0f_1, "oscil_0f", oscil_0f_1_mult, "oscil_0f_mult", oscil_0f_1_env, "oscil_0f_env"},
- {polywave_0f, "polywave_0f", polywave_0f_mult, "polywave_0f_mult", polywave_0f_env, "polywave_0f_env"},
- {env_linear_0f, "env_linear_0f", env_linear_0f_mult, "env_linear_0f_mult", env_linear_0f_env, "env_linear_0f_env"},
- {sin_f, "sin_f", sin_f_mult, "sin_f_mult", NULL, NULL},
- {cos_f, "cos_f", cos_f_mult, "cos_f_mult", NULL, NULL},
- {rand_0f, "rand_0f", rand_0f_mult, "rand_0f_mult", rand_0f_env, "rand_0f_env"},
- {rand_interp_0f, "rand_interp_0f", rand_interp_0f_mult, "rand_interp_0f_mult", rand_interp_0f_env, "rand_interp_0f_env"},
- {abs_f, "abs_f", abs_f_mult, "abs_f_mult", NULL, NULL},
- {sqrt_f, "sqrt_f", sqrt_f_mult, "sqrt_f_mult", NULL, NULL},
- {random_f, "random_f", random_f_mult, "random_f_mult", NULL, NULL},
- {vct_constant_ref_0, "vct_constant_ref_0", vct_constant_ref_0_mult, "vct_constant_ref_0_mult", NULL, NULL},
- {granulate_0f, "granulate_0f", granulate_0f_mult, "granulate_0f_mult", granulate_0f_env, "granulate_0f_env"},
-};
-
-
-static int find_m2_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_M2_OPS; i++)
- if (prev_op->function == m2_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-/* (let ((v (vector (make-oscil 330)))) (run (* 0.5 (oscil (vector-ref v 0))))) */
-
-/* 3 arg ops that can be combined into a multiply */
-#define NUM_M3_OPS 12
-
-static opt_ops m3_ops[NUM_M3_OPS] = {
- {oscil_1f_1, "oscil_1f_1", oscil_1f_1_mult, "oscil_1f_1_mult", oscil_1f_1_env, "oscil_1f_1_env"},
- {polywave_1f, "polywave_1f", polywave_1f_mult, "polywave_1f_mult", polywave_1f_env, "polywave_1f_env"},
- {delay_1f, "delay_1f", delay_1f_mult, "delay_1f_mult", delay_1f_env, "delay_1f_env"},
- {delay_1f_noz, "delay_1f_noz", delay_1f_noz_mult, "delay_1f_noz_mult", delay_1f_noz_env, "delay_1f_noz_env"},
- {add_f2, "add_f2", add_f2_mult, "add_f2_mult", NULL, NULL},
- {subtract_f2, "subtract_f2", subtract_f2_mult, "subtract_f2_mult", NULL, NULL},
- {vct_ref_f, "vct_ref_f", vct_ref_f_mult, "vct_ref_f_mult", NULL, NULL},
- {vector_ref_f, "vector_ref_f", vct_ref_f_mult, "vct_ref_f_mult", NULL, NULL},
- {formant_1f, "formant_1f", formant_1f_mult, "formant_1f_mult", formant_1f_env, "formant_1f_env"},
- {firmant_1f, "firmant_1f", firmant_1f_mult, "firmant_1f_mult", firmant_1f_env, "firmant_1f_env"},
- {multiply_f2, "multiply_f2", multiply_f3, "multiply_f3", NULL, NULL},
- {oscil_0f_vect, "oscil_0f_vect", oscil_0f_vect_mult, "oscil_0f_vect_mult", oscil_0f_vect_env, "oscil_0f_vect_env"},
-};
-
-
-static int find_m3_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_M3_OPS; i++)
- if (prev_op->function == m3_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-/* 4 arg ops that can be combined into a multiply */
-#define NUM_M4_OPS 12
-
-static opt_ops m4_ops[NUM_M4_OPS] = {
- {multiply_add_f2, "multiply_add_f2", multiply_add_f2_mult, "multiply_add_f2_mult", NULL, NULL},
- {add_f3, "add_f3", add_f3_mult, "add_f3_mult", NULL, NULL},
- {oscil_1f_2, "oscil_1f_2", oscil_1f_2_mult, "oscil_1f_2_mult", oscil_1f_2_env, "oscil_1f_2_env"},
- {oscil_1f_2m, "oscil_1f_2m", oscil_1f_2m_mult, "oscil_1f_2m_mult", oscil_1f_2m_env, "oscil_1f_2m_env"},
- {polywave_1f_2, "polywave_1f_2", polywave_1f_2_mult, "polywave_1f_2_mult", polywave_1f_2_env, "polywave_1f_2_env"},
- {polyshape_1fn, "polyshape_1fn", polyshape_1fn_mult, "polyshape_1fn_mult", polyshape_1fn_env, "polyshape_1fn_env"},
- {subtract_f3, "subtract_f3", subtract_f3_mult, "subtract_f3_mult", NULL, NULL},
- {multiply_f3, "multiply_f3", multiply_f4, "multiply_f4", NULL, NULL},
- {firmant_2f, "firmant_2f", firmant_2f_mult, "firmant_2f_mult", firmant_2f_env, "firmant_2f_env"},
- {oscil_1f_vect, "oscil_1f_vect", oscil_1f_vect_mult, "oscil_1f_vect_mult", oscil_1f_vect_env, "oscil_1f_vect_env"},
- {formant_1f_vect, "formant_1f_vect", formant_1f_vect_mult, "formant_1f_vect_mult", formant_1f_vect_env, "formant_1f_vect_env"},
- {firmant_1f_vect, "firmant_1f_vect", firmant_1f_vect_mult, "firmant_1f_vect_mult", firmant_1f_vect_env, "firmant_1f_vect_env"},
-};
-
-
-static int find_m4_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_M4_OPS; i++)
- if (prev_op->function == m4_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-
-/* 5 arg ops that can be combined into a multiply */
-#define NUM_M5_OPS 3
-
-static opt_ops m5_ops[NUM_M5_OPS] = {
- {oscil_1f_3ma, "oscil_1f_3ma", oscil_1f_3ma_mult, "oscil_1f_3ma_mult", oscil_1f_3ma_env, "oscil_1f_3ma_env"},
- {oscil_1f_3, "oscil_1f_3", oscil_1f_3_mult, "oscil_1f_3_mult", oscil_1f_3_env, "oscil_1f_3_env"},
- {multiply_f4, "multiply_f4", multiply_f5, "multiply_f5", NULL, NULL},
-
-};
-
-/* (let ((gen (make-oscil 100)) (e (make-env '(0 0 1 1) :end 10)) (x 2.0) (y 3.0) (z 4.0)) (run (lambda () (* (env e) (oscil gen (+ x y z))))) gen) */
-
-static int find_m5_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_M5_OPS; i++)
- if (prev_op->function == m5_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-
-static xen_value *multiply(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 0) return(make_xen_value(R_INT, add_int_to_ptree(prog, 1), R_CONSTANT));
- if (num_args == 1) return(copy_xen_value(args[1]));
-
- if (prog->constants > 0)
- {
- int i, cons_loc = 0;
- Int iscl = 1;
- Double fscl = 1.0;
-
- for (i = 1; i <= num_args; i++)
- if (args[i]->constant == R_CONSTANT)
- {
- cons_loc = i;
- if (args[i]->type == R_INT)
- iscl *= prog->ints[args[i]->addr];
- else fscl *= prog->dbls[args[i]->addr];
- free(args[i]);
- args[i] = NULL;
- }
-
- if ((iscl != 1) || (fscl != 1.0))
- {
- if (prog->float_result)
- args[cons_loc] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, fscl * iscl), R_CONSTANT);
- else args[cons_loc] = make_xen_value(R_INT, add_int_to_ptree(prog, iscl), R_CONSTANT);
- if ((iscl == 0) || (fscl == 0.0))
- return(copy_xen_value(args[cons_loc]));
- }
-
- if (prog->constants == num_args)
- {
- if (args[cons_loc])
- return(copy_xen_value(args[cons_loc]));
- else return(make_xen_value(R_INT, add_int_to_ptree(prog, 1), R_CONSTANT));
- }
- }
- else
- {
- if ((num_args == 2) &&
- (prog->float_result))
- {
- if (args[1]->type == R_INT)
- return(package(prog, R_FLOAT, multiply_i_f, "multiply_i_f", args, num_args));
- if (args[2]->type == R_INT)
- return(package(prog, R_FLOAT, multiply_f_i, "multiply_f_i", args, num_args));
- }
- }
-
- num_args = float_all_args(prog, num_args, args, prog->float_result);
- if (num_args == 1) return(copy_xen_value(args[1]));
-
- if (prog->float_result)
- {
- if (num_args == 2)
- {
- /* in instruments, this is the most common operation, coupled with things like envelopes, so it's worth some optimization */
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (((prev_op->args[0] == args[1]->addr) ||
- (prev_op->args[0] == args[2]->addr)) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- int loc;
- switch (prev_op->num_args)
- {
-
- /* -------- 2 args -------- */
- case 2:
- loc = find_m2_op(prev_op);
- if (loc >= 0)
- {
- /* its output is either arg1 or arg2, we can use its output loc */
- if ((prog->triple_ctr > 1) &&
- (m2_ops[loc].env_func)) /* env is a possibility */
- {
- triple *p2_op;
- p2_op = prog->program[prog->triple_ctr - 2];
- if ((p2_op->function == env_linear_0f) &&
- (((p2_op->args[0] == args[1]->addr) && (prev_op->args[0] == args[2]->addr)) ||
- ((p2_op->args[0] == args[2]->addr) && (prev_op->args[0] == args[1]->addr))) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, p2_op->args[0])) == NULL))
- {
- p2_op->types = (int *)realloc(p2_op->types, 3 * sizeof(int));
- p2_op->args = (int *)realloc(p2_op->args, 3 * sizeof(int));
- /* env becomes arg 2 */
- p2_op->args[2] = p2_op->args[1];
- p2_op->types[2] = p2_op->types[1];
- p2_op->args[1] = prev_op->args[1];
- p2_op->types[1] = prev_op->types[1];
- p2_op->num_args = 3;
- p2_op->function = m2_ops[loc].env_func;
- p2_op->op_name = m2_ops[loc].env_func_name;
-#if WITH_COUNTERS
- p2_op->func_loc = get_func_loc(p2_op->function, p2_op->op_name);
-#endif
- free_triple(prev_op);
- prog->triple_ctr--;
- prog->program[prog->triple_ctr] = NULL;
- return(make_xen_value(R_FLOAT, p2_op->args[0], R_TEMPORARY));
- }
- }
- prev_op->types = (int *)realloc(prev_op->types, 3 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 3 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[2] = args[2]->addr;
- else prev_op->args[2] = args[1]->addr;
- prev_op->num_args = 3;
- prev_op->function = m2_ops[loc].mult_func;
- prev_op->op_name = m2_ops[loc].mult_func_name;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[2] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
-
- /* -------- 3 args -------- */
- case 3:
- loc = find_m3_op(prev_op);
- if (loc >= 0)
- {
- if ((prog->triple_ctr > 1) &&
- (m3_ops[loc].env_func)) /* env is a possibility */
- {
- triple *p2_op;
- p2_op = prog->program[prog->triple_ctr - 2];
- if ((p2_op->function == env_linear_0f) &&
- (((p2_op->args[0] == args[1]->addr) && (prev_op->args[0] == args[2]->addr)) ||
- ((p2_op->args[0] == args[2]->addr) && (prev_op->args[0] == args[1]->addr))) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, p2_op->args[0])) == NULL))
- {
- p2_op->types = (int *)realloc(p2_op->types, 4 * sizeof(int));
- p2_op->args = (int *)realloc(p2_op->args, 4 * sizeof(int));
- /* env becomes arg 3 */
- p2_op->args[3] = p2_op->args[1];
- p2_op->types[3] = p2_op->types[1];
- p2_op->args[1] = prev_op->args[1];
- p2_op->types[1] = prev_op->types[1];
- p2_op->args[2] = prev_op->args[2];
- p2_op->types[2] = prev_op->types[2];
- p2_op->num_args = 4;
- p2_op->function = m3_ops[loc].env_func;
- p2_op->op_name = m3_ops[loc].env_func_name;
-#if WITH_COUNTERS
- p2_op->func_loc = get_func_loc(p2_op->function, p2_op->op_name);
-#endif
- free_triple(prev_op);
- prog->triple_ctr--;
- prog->program[prog->triple_ctr] = NULL;
- return(make_xen_value(R_FLOAT, p2_op->args[0], R_TEMPORARY));
- }
- }
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[3] = args[2]->addr;
- else prev_op->args[3] = args[1]->addr;
- prev_op->num_args = 4;
- prev_op->function = m3_ops[loc].mult_func;
- prev_op->op_name = m3_ops[loc].mult_func_name;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[3] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
-
- /* -------- 4 args -------- */
- case 4:
- loc = find_m4_op(prev_op);
- if (loc >= 0)
- {
- if ((prog->triple_ctr > 1) &&
- (m4_ops[loc].env_func)) /* env is a possibility */
- {
- triple *p2_op;
- p2_op = prog->program[prog->triple_ctr - 2];
- if ((p2_op->function == env_linear_0f) &&
- (((p2_op->args[0] == args[1]->addr) && (prev_op->args[0] == args[2]->addr)) ||
- ((p2_op->args[0] == args[2]->addr) && (prev_op->args[0] == args[1]->addr))) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, p2_op->args[0])) == NULL))
- {
- int k;
- p2_op->types = (int *)realloc(p2_op->types, 5 * sizeof(int));
- p2_op->args = (int *)realloc(p2_op->args, 5 * sizeof(int));
- /* env becomes arg 4 */
- p2_op->args[4] = p2_op->args[1];
- p2_op->types[4] = p2_op->types[1];
- for (k = 1; k < 4; k++)
- {
- p2_op->args[k] = prev_op->args[k];
- p2_op->types[k] = prev_op->types[k];
- }
- p2_op->num_args = 5;
- p2_op->function = m4_ops[loc].env_func;
- p2_op->op_name = m4_ops[loc].env_func_name;
-#if WITH_COUNTERS
- p2_op->func_loc = get_func_loc(p2_op->function, p2_op->op_name);
-#endif
- free_triple(prev_op);
- prog->triple_ctr--;
- prog->program[prog->triple_ctr] = NULL;
- return(make_xen_value(R_FLOAT, p2_op->args[0], R_TEMPORARY));
- }
- /* (let ((gen (make-polyshape)) (e (make-env '(0 0 1 1)))) (run (lambda () (* (env e) (polyshape gen 1.0 1.5))))) */
- }
- prev_op->types = (int *)realloc(prev_op->types, 5 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 5 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[4] = args[2]->addr;
- else prev_op->args[4] = args[1]->addr;
- prev_op->num_args = 5;
- prev_op->function = m4_ops[loc].mult_func;
- prev_op->op_name = m4_ops[loc].mult_func_name;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[4] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
-
- /* -------- 5 args -------- */
- case 5:
- loc = find_m5_op(prev_op);
- if (loc >= 0)
- {
- if ((prog->triple_ctr > 1) &&
- (m5_ops[loc].env_func)) /* env is a possibility */
- {
- triple *p2_op;
- p2_op = prog->program[prog->triple_ctr - 2];
- if ((p2_op->function == env_linear_0f) &&
- (((p2_op->args[0] == args[1]->addr) && (prev_op->args[0] == args[2]->addr)) ||
- ((p2_op->args[0] == args[2]->addr) && (prev_op->args[0] == args[1]->addr))) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, p2_op->args[0])) == NULL))
- {
- int k;
- p2_op->types = (int *)realloc(p2_op->types, 6 * sizeof(int));
- p2_op->args = (int *)realloc(p2_op->args, 6 * sizeof(int));
- /* env becomes arg 5 */
- p2_op->args[5] = p2_op->args[1];
- p2_op->types[5] = p2_op->types[1];
- for (k = 1; k < 5; k++)
- {
- p2_op->args[k] = prev_op->args[k];
- p2_op->types[k] = prev_op->types[k];
- }
- p2_op->num_args = 6;
- p2_op->function = m5_ops[loc].env_func;
- p2_op->op_name = m5_ops[loc].env_func_name;
-#if WITH_COUNTERS
- p2_op->func_loc = get_func_loc(p2_op->function, p2_op->op_name);
-#endif
- free_triple(prev_op);
- prog->triple_ctr--;
- prog->program[prog->triple_ctr] = NULL;
- return(make_xen_value(R_FLOAT, p2_op->args[0], R_TEMPORARY));
- }
- /* (let ((gen (make-polyshape)) (e (make-env '(0 0 1 1)))) (run (lambda () (* (env e) (polyshape gen 1.0 1.5))))) */
- }
-
-
- prev_op->types = (int *)realloc(prev_op->types, 6 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 6 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[5] = args[2]->addr;
- else prev_op->args[5] = args[1]->addr;
- prev_op->num_args = 6;
- prev_op->function = m5_ops[loc].mult_func;
- prev_op->op_name = m5_ops[loc].mult_func_name;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[5] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
- }
- }
- }
- return(package(prog, R_FLOAT, multiply_f2, "multiply_f2", args, num_args));
- }
- if (num_args == 3) return(package(prog, R_FLOAT, multiply_f3, "multiply_f3", args, num_args));
- if (num_args == 4) return(package(prog, R_FLOAT, multiply_f4, "multiply_f4", args, num_args));
- if (num_args == 5) return(package(prog, R_FLOAT, multiply_f5, "multiply_f5", args, num_args));
- return(package_n(prog, R_FLOAT, multiply_fn, "multiply_fn", args, num_args));
- }
-
- if (num_args == 2) return(package(prog, R_INT, multiply_i2, "multiply_i2", args, num_args));
- if (num_args == 3) return(package(prog, R_INT, multiply_i3, "multiply_i3", args, num_args));
- if (num_args == 4) return(package(prog, R_INT, multiply_i4, "multiply_i4", args, num_args));
- if (num_args == 5) return(package(prog, R_INT, multiply_i5, "multiply_i5", args, num_args));
- return(package_n(prog, R_INT, multiply_in, "multiply_in", args, num_args));
-}
-
-
-/* ---------------- add ---------------- */
-
-static void add_f2(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 + FLOAT_ARG_2);}
-static void add_f2_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * (FLOAT_ARG_1 + FLOAT_ARG_2);}
-
-
-static void add_f2_i(int *args, ptree *pt) {INT_RESULT = (Int)(FLOAT_ARG_1 + FLOAT_ARG_2);}
-
-
-static void add_f3(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 + FLOAT_ARG_2 + FLOAT_ARG_3);}
-static void add_f3_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * (FLOAT_ARG_1 + FLOAT_ARG_2 + FLOAT_ARG_3);}
-
-
-static void add_f4(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 + FLOAT_ARG_2 + FLOAT_ARG_3 + FLOAT_ARG_4);}
-
-
-static void add_f5(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 + FLOAT_ARG_2 + FLOAT_ARG_3 + FLOAT_ARG_4 + FLOAT_ARG_5);}
-
-
-static void multiply_add_f2(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 * FLOAT_ARG_2) + FLOAT_ARG_3;}
-static void multiply_add_f2_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * ((FLOAT_ARG_1 * FLOAT_ARG_2) + FLOAT_ARG_3);}
-
-
-static void add_fn(int *args, ptree *pt)
-{
- int i, n;
- n = INT_ARG_1;
- FLOAT_RESULT = FLOAT_ARG_2;
- for (i = 1; i < n; i++) FLOAT_RESULT += pt->dbls[args[i + 2]];
-}
-
-
-static void add_i2(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 + INT_ARG_2);}
-static void add_multiply_i2(int *args, ptree *pt) {INT_RESULT = INT_ARG_3 + (INT_ARG_1 * INT_ARG_2);}
-
-static void inc_i_1(int *args, ptree *pt) {(INT_RESULT)++;}
-
-
-static void add_i3(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 + INT_ARG_2 + INT_ARG_3);}
-
-
-static void add_i4(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 + INT_ARG_2 + INT_ARG_3 + INT_ARG_4);}
-
-
-static void add_in(int *args, ptree *pt)
-{
- int i, n;
- n = INT_ARG_1;
- INT_RESULT = INT_ARG_2;
- for (i = 1; i < n; i++) INT_RESULT += pt->ints[args[i + 2]];
-}
-
-
-static void add_i_f(int *args, ptree *pt) {FLOAT_RESULT = (INT_ARG_1 + FLOAT_ARG_2);}
-
-
-static void add_f_i(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 + INT_ARG_2);}
-
-
-#define NUM_A2_OPS 7
-
-static opt_ops a2_ops[NUM_A2_OPS] = {
- {rand_interp_0f, "rand_interp_0f", rand_interp_0f_add, "rand_interp_0f_add", NULL, NULL},
- {abs_f, "abs_f", abs_f_add, "abs_f_add", NULL, NULL},
- {sin_f, "sin_f", sin_f_add, "sin_f_add", NULL, NULL},
- {cos_f, "cos_f", cos_f_add, "cos_f_add", NULL, NULL},
- {random_f, "random_f", random_f_add, "random_f_add", NULL, NULL},
- {mus_random_f, "mus_random_f", mus_random_f_add, "mus_random_f_add", NULL, NULL},
-};
-
-
-static int find_a2_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_A2_OPS; i++)
- if (prev_op->function == a2_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-#define NUM_A3_OPS 9
-
-static opt_ops a3_ops[NUM_A3_OPS] = {
- {multiply_f2, "multiply_f2", multiply_add_f2, "multiply_add_f2", NULL, NULL},
- {subtract_f2, "subtract_f2", subtract_f2_add, "subtract_f2_add", NULL, NULL},
- {add_f2, "add_f2", add_f3, "add_f3", NULL, NULL},
- {sin_f_mult, "sin_f_mult", sin_f_mult_add, "sin_f_mult_add", NULL, NULL},
- {cos_f_mult, "cos_f_mult", cos_f_mult_add, "cos_f_mult_add", NULL, NULL},
- {abs_f_mult, "abs_f_mult", abs_f_mult_add, "abs_f_mult_add", NULL, NULL},
- {formant_1f, "formant_1f", formant_1f_add, "formant_1f_add", NULL, NULL},
- {vct_ref_f, "vct_ref_f", vct_ref_f_add, "vct_ref_f_add", NULL, NULL},
- {vector_ref_f, "vector_ref_f", vct_ref_f_add, "vct_ref_f_add", NULL, NULL},
-};
-
-
-static int find_a3_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_A3_OPS; i++)
- if (prev_op->function == a3_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-#define NUM_A4_OPS 2
-
-static opt_ops a4_ops[NUM_A4_OPS] = {
- {subtract_f2_mult, "subtract_f2_mult", subtract_f2_mult_add, "subtract_f2_mult_add", NULL, NULL},
- {add_f3, "add_f3", add_f4, "add_f4", NULL, NULL},
-};
-
-
-static int find_a4_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_A4_OPS; i++)
- if (prev_op->function == a4_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-static xen_value *add(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 0) return(make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT));
- if (num_args == 1) return(copy_xen_value(args[1]));
-
- if (prog->constants > 0)
- {
- Int iscl = 0;
- Double fscl = 0.0;
- int i, cons_loc = 0;
-
- for (i = 1; i <= num_args; i++)
- if (args[i]->constant == R_CONSTANT)
- {
- cons_loc = i;
- if (args[i]->type == R_INT)
- iscl += prog->ints[args[i]->addr];
- else fscl += prog->dbls[args[i]->addr];
- free(args[i]);
- args[i] = NULL;
- }
-
- if ((iscl != 0) || (fscl != 0.0))
- {
- if (prog->float_result)
- args[cons_loc] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, fscl + iscl), R_CONSTANT);
- else args[cons_loc] = make_xen_value(R_INT, add_int_to_ptree(prog, iscl), R_CONSTANT);
- }
-
- if (prog->constants == num_args)
- {
- if (args[cons_loc])
- return(copy_xen_value(args[cons_loc]));
- else return(make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT));
- }
- }
- else
- {
- if ((num_args == 2) &&
- (prog->float_result))
- {
- if (args[1]->type == R_INT)
- return(package(prog, R_FLOAT, add_i_f, "add_i_f", args, num_args));
- if (args[2]->type == R_INT)
- return(package(prog, R_FLOAT, add_f_i, "add_f_i", args, num_args));
- }
- }
-
- num_args = float_all_args(prog, num_args, args, prog->float_result);
- if (num_args == 1) return(copy_xen_value(args[1]));
-
- if (prog->float_result)
- {
- if (num_args == 2)
- {
- /* (run (lambda () (let ((y 1.5) (z 2.3)) (let ((x (* y z))) (+ x 1.0)))))
- * (run (lambda () (let ((y 1.5) (z 2.3)) (let ((x (* y z))) (+ (* x y) z)))))
- */
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (((prev_op->args[0] == args[1]->addr) ||
- (prev_op->args[0] == args[2]->addr)) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- int loc;
- switch (prev_op->num_args)
- {
- /* -------- 2 args -------- */
- case 2:
- loc = find_a2_op(prev_op);
- if (loc >= 0)
- {
- prev_op->types = (int *)realloc(prev_op->types, 3 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 3 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[2] = args[2]->addr;
- else prev_op->args[2] = args[1]->addr;
- prev_op->num_args = 3;
- prev_op->function = a2_ops[loc].mult_func; /* " mult" means "add" in this context */
- prev_op->op_name = a2_ops[loc].mult_func_name;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[2] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
-
- /* -------- 3 args -------- */
- case 3:
- loc = find_a3_op(prev_op);
- if (loc >= 0)
- {
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[3] = args[2]->addr;
- else prev_op->args[3] = args[1]->addr;
- prev_op->num_args = 4;
- prev_op->function = a3_ops[loc].mult_func;
- prev_op->op_name = a3_ops[loc].mult_func_name;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[3] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
-
- /* -------- 4 args -------- */
- case 4:
- loc = find_a4_op(prev_op);
- if (loc >= 0)
- {
- prev_op->types = (int *)realloc(prev_op->types, 5 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 5 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[4] = args[2]->addr;
- else prev_op->args[4] = args[1]->addr;
- prev_op->num_args = 5;
- prev_op->function = a4_ops[loc].mult_func;
- prev_op->op_name = a4_ops[loc].mult_func_name;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[4] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
-
- break;
- }
- }
-#if 0
- if (((prev_op->args[0] == args[1]->addr) ||
- (prev_op->args[0] == args[2]->addr)) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- fprintf(stderr, "add skip %s\n", prev_op->op_name);
-#endif
- }
- return(package(prog, R_FLOAT, add_f2, "add_f2", args, num_args));
- }
- if (num_args == 3) return(package(prog, R_FLOAT, add_f3, "add_f3", args, num_args));
- if (num_args == 4) return(package(prog, R_FLOAT, add_f4, "add_f4", args, num_args));
- if (num_args == 5) return(package(prog, R_FLOAT, add_f5, "add_f5", args, num_args));
- return(package_n(prog, R_FLOAT, add_fn, "add_fn", args, num_args));
- }
-
- if (num_args == 2)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->function == multiply_i2) &&
- ((prev_op->args[0] == args[1]->addr) ||
- (prev_op->args[0] == args[2]->addr)) &&
- ((find_var_in_ptree_via_addr(prog, R_INT, prev_op->args[0])) == NULL))
- {
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[3] = args[2]->addr;
- else prev_op->args[3] = args[1]->addr;
- prev_op->num_args = 4;
- prev_op->function = add_multiply_i2;
- prev_op->op_name = "add_multiply_i2";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[3] = R_INT;
- return(make_xen_value(R_INT, prev_op->args[0], R_TEMPORARY));
- }
- }
-
- return(package(prog, R_INT, add_i2, "add_i2", args, num_args));
- }
- if (num_args == 3) return(package(prog, R_INT, add_i3, "add_i3", args, num_args));
- if (num_args == 4) return(package(prog, R_INT, add_i4, "add_i4", args, num_args));
- return(package_n(prog, R_INT, add_in, "add_in", args, num_args));
-}
-
-
-/* ---------------- subtract ---------------- */
-
-static void subtract_f1(int *args, ptree *pt) {FLOAT_RESULT = -(FLOAT_ARG_1);}
-
-
-static void subtract_f2(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 - FLOAT_ARG_2);}
-static void subtract_f2_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * (FLOAT_ARG_1 - FLOAT_ARG_2);}
-static void subtract_f2_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 + (FLOAT_ARG_1 - FLOAT_ARG_2);}
-
-static void subtract_f2_mult_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 + FLOAT_ARG_3 * (FLOAT_ARG_1 - FLOAT_ARG_2);}
-
-static void subtract_f2_i(int *args, ptree *pt) {INT_RESULT = (Int)(FLOAT_ARG_1 - FLOAT_ARG_2);}
-
-
-static void subtract_f3(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 - FLOAT_ARG_2 - FLOAT_ARG_3);}
-static void subtract_f3_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * (FLOAT_ARG_1 - FLOAT_ARG_2 - FLOAT_ARG_3);}
-
-static void subtract_f4(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 - FLOAT_ARG_2 - FLOAT_ARG_3 - FLOAT_ARG_4);}
-
-static void subtract_fn(int *args, ptree *pt)
-{
- int i, n;
- n = INT_ARG_1;
- FLOAT_RESULT = FLOAT_ARG_2;
- for (i = 1; i < n; i++) FLOAT_RESULT -= pt->dbls[args[i + 2]];
-}
-
-
-static void subtract_i1(int *args, ptree *pt) {INT_RESULT = -(INT_ARG_1);}
-
-
-static void subtract_i2(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 - INT_ARG_2);}
-
-
-static void subtract_i3(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 - INT_ARG_2 - INT_ARG_3);}
-static void subtract_i4(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 - INT_ARG_2 - INT_ARG_3 - INT_ARG_4);}
-
-
-static void subtract_in(int *args, ptree *pt)
-{
- int i, n;
- n = INT_ARG_1;
- INT_RESULT = INT_ARG_2;
- for (i = 1; i < n; i++) INT_RESULT -= pt->ints[args[i + 2]];
-}
-
-
-static void subtract_i_f(int *args, ptree *pt) {FLOAT_RESULT = (INT_ARG_1 - FLOAT_ARG_2);}
-
-
-static void subtract_f_i(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 - INT_ARG_2);}
-
-static void subtract_mult_1f(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 * FLOAT_ARG_2) - FLOAT_ARG_3;}
-/* (let ((x 1.0) (y 2.0) (z 3.0)) (run (lambda () (- (* y z) x)))) */
-static void subtract_mult_2f(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 - (FLOAT_ARG_1 * FLOAT_ARG_2);}
-/* (let ((x 1.0) (y 2.0) (z 3.0)) (run (lambda () (- x (* y z))))) */
-
-
-static xen_value *subtract(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args == 1) && (args[1]->constant == R_CONSTANT))
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, -(prog->ints[args[1]->addr])), R_CONSTANT));
- else return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, -(prog->dbls[args[1]->addr])), R_CONSTANT));
- }
-
- if (prog->constants > 0)
- {
- Int iscl = 0;
- Double fscl = 0.0;
- int i, cons_loc = 0;
-
- for (i = 2; i <= num_args; i++)
- if (args[i]->constant == R_CONSTANT)
- {
- cons_loc = i;
- if (args[i]->type == R_INT)
- iscl += prog->ints[args[i]->addr];
- else fscl += prog->dbls[args[i]->addr];
- free(args[i]);
- args[i] = NULL;
- }
-
- if ((iscl != 0) || (fscl != 0.0))
- {
- if (prog->float_result)
- args[cons_loc] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, fscl + iscl), R_CONSTANT);
- else args[cons_loc] = make_xen_value(R_INT, add_int_to_ptree(prog, iscl), R_CONSTANT);
- }
- else
- {
- if ((num_args == 2) && (args[1]->constant != R_CONSTANT)) /* (- arg 0) */
- return(copy_xen_value(args[1]));
- }
-
- if (prog->constants == num_args)
- {
- if (prog->float_result)
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, prog->ints[args[1]->addr] - (fscl + iscl)), R_CONSTANT));
- else return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, prog->dbls[args[1]->addr] - (fscl + iscl)), R_CONSTANT));
- }
- else return(make_xen_value(R_INT, add_int_to_ptree(prog, prog->ints[args[1]->addr] - iscl), R_CONSTANT));
- }
- }
- else
- {
- if ((num_args == 2) &&
- (prog->float_result))
- {
- if (args[1]->type == R_INT)
- return(package(prog, R_FLOAT, subtract_i_f, "subtract_i_f", args, num_args));
- if (args[2]->type == R_INT)
- return(package(prog, R_FLOAT, subtract_f_i, "subtract_f_i", args, num_args));
- }
- }
-
- num_args = float_all_args(prog, num_args, args, prog->float_result);
- if (prog->float_result)
- {
- if (num_args == 1) return(package(prog, R_FLOAT, subtract_f1, "subtract_f1", args, num_args));
- if (num_args == 2)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->function == multiply_f2) &&
- ((prev_op->args[0] == args[1]->addr) || (prev_op->args[0] == args[2]->addr)) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->num_args = 4;
- if (prev_op->args[0] == args[1]->addr)
- {
- prev_op->function = subtract_mult_1f;
- prev_op->op_name = "subtract_mult_1f";
- prev_op->args[3] = args[2]->addr;
- }
- else
- {
- prev_op->function = subtract_mult_2f;
- prev_op->op_name = "subtract_mult_2f";
- prev_op->args[3] = args[1]->addr;
- }
- prev_op->types[3] = R_FLOAT;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- }
-
- return(package(prog, R_FLOAT, subtract_f2, "subtract_f2", args, num_args));
- }
- if (num_args == 3) return(package(prog, R_FLOAT, subtract_f3, "subtract_f3", args, num_args));
- if (num_args == 4) return(package(prog, R_FLOAT, subtract_f4, "subtract_f4", args, num_args));
- return(package_n(prog, R_FLOAT, subtract_fn, "subtract_fn", args, num_args));
- }
-
- if (num_args == 1) return(package(prog, R_INT, subtract_i1, "subtract_i1", args, num_args));
- if (num_args == 2) return(package(prog, R_INT, subtract_i2, "subtract_i2", args, num_args));
- if (num_args == 3) return(package(prog, R_INT, subtract_i3, "subtract_i3", args, num_args));
- if (num_args == 4) return(package(prog, R_INT, subtract_i4, "subtract_i4", args, num_args));
- return(package_n(prog, R_INT, subtract_in, "subtract_in", args, num_args));
-}
-
-
-/* ---------------- 1+ 1- ---------------- */
-
-static void one_minus_f(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_1 - 1.0;}
-
-
-static void one_minus_i(int *args, ptree *pt) {INT_RESULT = INT_ARG_1 - 1;}
-
-
-static xen_value *one_minus(ptree *prog, xen_value **args, int num_args)
-{
- if (prog->constants == 1)
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, prog->ints[args[1]->addr] - 1), R_CONSTANT));
- else return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, prog->dbls[args[1]->addr] - 1.0), R_CONSTANT));
- }
- if (args[1]->type == R_INT)
- return(package(prog, R_INT, one_minus_i, "one_minus_i", args, 1));
- else return(package(prog, R_FLOAT, one_minus_f, "one_minus_f", args, 1));
-}
-
-
-static void one_plus_f(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_1 + 1.0;}
-
-
-static void one_plus_i(int *args, ptree *pt) {INT_RESULT = INT_ARG_1 + 1;}
-
-
-static xen_value *one_plus(ptree *prog, xen_value **args, int num_args)
-{
- if (prog->constants == 1)
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, prog->ints[args[1]->addr] + 1), R_CONSTANT));
- else return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, prog->dbls[args[1]->addr] + 1.0), R_CONSTANT));
- }
- if (args[1]->type == R_INT)
- return(package(prog, R_INT, one_plus_i, "one_plus_i", args, 1));
- else return(package(prog, R_FLOAT, one_plus_f, "one_plus_f", args, 1));
-}
-
-
-/* ---------------- divide ---------------- */
-
-static void divide_f1(int *args, ptree *pt) {FLOAT_RESULT = (1.0 / FLOAT_ARG_1);}
-
-
-static void divide_if1(int *args, ptree *pt) {INT_RESULT = (Int)(1.0 / FLOAT_ARG_1);}
-
-
-static void divide_f2(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 / FLOAT_ARG_2);}
-
-
-static void divide_f2_i(int *args, ptree *pt) {INT_RESULT = (Int)(FLOAT_ARG_1 / FLOAT_ARG_2);}
-
-
-static void divide_if2(int *args, ptree *pt) {INT_RESULT = (Int)(FLOAT_ARG_1 / FLOAT_ARG_2);}
-
-
-static void divide_f3(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 / (FLOAT_ARG_2 * FLOAT_ARG_3));}
-
-
-static void divide_fn(int *args, ptree *pt)
-{
- int i, n;
- Double divisor = 1.0;
- n = INT_ARG_1;
- for (i = 1; i < n; i++) divisor *= pt->dbls[args[i + 2]];
- FLOAT_RESULT = FLOAT_ARG_2 / divisor;
-}
-
-
-static void divide_i_f(int *args, ptree *pt) {FLOAT_RESULT = (INT_ARG_1 / FLOAT_ARG_2);}
-
-
-static void divide_f_i(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 / INT_ARG_2);}
-
-
-static xen_value *divide(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args == 1) && (args[1]->constant == R_CONSTANT))
- {
- if (prog->walk_result == NEED_INT_RESULT)
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT));
- else return(make_xen_value(R_INT, add_int_to_ptree(prog, (Int)((double)1.0 / (prog->dbls[args[1]->addr]))), R_CONSTANT));
- }
- else
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, (1.0 / (Double)(prog->ints[args[1]->addr]))), R_CONSTANT));
- else return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, (1.0 / (prog->dbls[args[1]->addr]))), R_CONSTANT));
- }
- }
-
- if (prog->constants > 0)
- {
- int cons_loc = 0;
- Double fscl = 1.0;
- int i;
- for (i = 2; i <= num_args; i++)
- if (args[i]->constant == R_CONSTANT)
- {
- cons_loc = i;
- if (args[i]->type == R_INT)
- fscl *= (Double)(prog->ints[args[i]->addr]);
- else fscl *= prog->dbls[args[i]->addr];
- free(args[i]);
- args[i] = NULL;
- }
-
- if (fscl != 1.0)
- args[cons_loc] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, fscl), R_CONSTANT);
- if (prog->constants == num_args)
- {
- if (prog->walk_result == NEED_INT_RESULT)
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (Int)((Double)(prog->ints[args[1]->addr]) / fscl)), R_CONSTANT));
- else return(make_xen_value(R_INT, add_int_to_ptree(prog, (Int)(prog->dbls[args[1]->addr] / fscl)), R_CONSTANT));
- }
- else
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, (Double)(prog->ints[args[1]->addr]) / fscl), R_CONSTANT));
- else return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, prog->dbls[args[1]->addr] / fscl), R_CONSTANT));
- }
- }
-
- if ((prog->constants == (num_args - 1)) && (args[1]->constant != R_CONSTANT))
- {
- /* divisor is a constant */
- if (fscl == 1.0) return(copy_xen_value(args[1]));
- if (fscl == 0.0) return(run_warn("division by zero"));
- if (prog->walk_result == NEED_ANY_RESULT)
- {
- /* invert here and use multiply */
- if (args[cons_loc]) free(args[cons_loc]);
- args[2] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, (Double)(1.0 / fscl)), R_CONSTANT);
- if (args[1]->type == R_INT) float_all_args(prog, num_args, args, true);
- return(package(prog, R_FLOAT, multiply_f2, "multiply_f2", args, 2));
- }
- }
- }
- {
- if ((num_args == 2) &&
- (prog->float_result))
- {
- if (args[1]->type == R_INT)
- return(package(prog, R_FLOAT, divide_i_f, "divide_i_f", args, num_args));
- if (args[2]->type == R_INT)
- return(package(prog, R_FLOAT, divide_f_i, "divide_f_i", args, num_args));
- }
- }
-
- num_args = float_all_args(prog, num_args, args, true);
- if (num_args == 1)
- {
- if (prog->walk_result == NEED_INT_RESULT)
- return(package(prog, R_INT, divide_if1, "divide_if1", args, num_args));
- else return(package(prog, R_FLOAT, divide_f1, "divide_f1", args, num_args));
- }
-
- if (num_args == 2)
- {
- if (prog->walk_result == NEED_INT_RESULT)
- return(package(prog, R_INT, divide_if2, "divide_if2", args, num_args));
- else return(package(prog, R_FLOAT, divide_f2, "divide_f2", args, num_args));
- }
-
- if (num_args == 3) return(package(prog, R_FLOAT, divide_f3, "divide_f3", args, num_args));
- return(package_n(prog, R_FLOAT, divide_fn, "divide_fn", args, num_args));
-}
-
-
-/* ---------------- rel ops ---------------- */
-
-static void float_rel_constant_args(ptree *prog, int num_args, xen_value **args)
-{
- int i;
- for (i = 1; i <= num_args; i++)
- if ((args[i]->constant == R_CONSTANT) && (args[i]->type == R_INT))
- {
- xen_value *old_loc;
- old_loc = args[i];
- args[i] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, (Double)(prog->ints[args[i]->addr])), R_CONSTANT);
- free(old_loc);
- }
-}
-
-
-static void float_rel_args(ptree *prog, int num_args, xen_value **args)
-{
- int i;
- for (i = 1; i <= num_args; i++)
- if (args[i]->type == R_INT)
- {
- xen_value *old_loc;
- old_loc = args[i];
- args[i] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(store_i_f, "store_i_f", 2, args[i], old_loc));
- free(old_loc);
- }
-}
-
-
-#define REL_OP(CName, SName, COp, FOp) \
-static void CName ## _f2(int *args, ptree *pt) {BOOL_RESULT = (Int)(FLOAT_ARG_1 COp FLOAT_ARG_2);} \
-static void CName ## _f3(int *args, ptree *pt) {BOOL_RESULT = (Int)((FLOAT_ARG_1 COp FLOAT_ARG_2) && (FLOAT_ARG_2 COp FLOAT_ARG_3));} \
-static void CName ## _f4(int *args, ptree *pt) {BOOL_RESULT = (Int)((FLOAT_ARG_1 COp FLOAT_ARG_2) && (FLOAT_ARG_2 COp FLOAT_ARG_3) && (FLOAT_ARG_3 COp FLOAT_ARG_4));} \
-static void CName ## _fn(int *args, ptree *pt) \
-{ \
- int i, n; \
- n = INT_ARG_1; \
- for (i = 2; i <= n; i++) \
- { \
- BOOL_RESULT = (pt->dbls[args[i]] COp pt->dbls[args[i + 1]]); \
- if (!BOOL_RESULT) break; \
- } \
-} \
-static void CName ## _i2(int *args, ptree *pt) {BOOL_RESULT = (Int)(INT_ARG_1 COp INT_ARG_2);} \
-static void CName ## _i3(int *args, ptree *pt) {BOOL_RESULT = (Int)((INT_ARG_1 COp INT_ARG_2) && (INT_ARG_2 COp INT_ARG_3));} \
-static void CName ## _i4(int *args, ptree *pt) {BOOL_RESULT = (Int)((INT_ARG_1 COp INT_ARG_2) && (INT_ARG_2 COp INT_ARG_3) && (INT_ARG_3 COp INT_ARG_4));} \
-static void CName ## _in(int *args, ptree *pt) \
-{ \
- int i, n; \
- n = INT_ARG_1; \
- for (i = 2; i <= n; i++) \
- { \
- BOOL_RESULT = (Int)(pt->ints[args[i]] COp pt->ints[args[i + 1]]); \
- if (!BOOL_RESULT) break; \
- } \
-} \
-static xen_value * SName(ptree *prog, bool float_result, xen_value **args, int num_args) \
-{ \
- if ((prog->walk_result == DONT_NEED_RESULT) || (num_args <= 1)) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)true), R_CONSTANT)); \
- if ((prog->constants > 0) && (float_result)) \
- float_rel_constant_args(prog, num_args, args); \
- if (prog->constants > 1) \
- { \
- int i; \
- Int lasti = 0; \
- Double lastf = 0.0; \
- for (i = 1; i < num_args; i++) \
- if (args[i]->constant == R_CONSTANT) \
- { \
- if (float_result) \
- lastf = prog->dbls[args[i]->addr]; \
- else lasti = prog->ints[args[i]->addr]; \
- break; \
- } \
- for (i = i + 1; i <= num_args; i++) \
- if (args[i]->constant == R_CONSTANT) \
- { \
- if (float_result) \
- { \
- if (lastf FOp prog->dbls[args[i]->addr]) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT)); \
- lastf = prog->dbls[args[i]->addr]; \
- } \
- else \
- { \
- if (lasti FOp prog->ints[args[i]->addr]) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT)); \
- lasti = prog->ints[args[i]->addr]; \
- } \
- } \
- if (prog->constants == num_args) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)true), R_CONSTANT)); \
- } \
- if (float_result) \
- { \
- float_rel_args(prog, num_args, args); \
- if (num_args == 2) return(package(prog, R_BOOL, CName ## _f2, #CName "_f2", args, num_args)); \
- if (num_args == 3) return(package(prog, R_BOOL, CName ## _f3, #CName "_f3", args, num_args)); \
- if (num_args == 4) return(package(prog, R_BOOL, CName ## _f4, #CName "_f4", args, num_args)); \
- return(package_n(prog, R_BOOL, CName ## _fn, #CName "_fn", args, num_args)); \
- } \
- else \
- { \
- if (num_args == 2) return(package(prog, R_BOOL, CName ## _i2, #CName "_i2", args, num_args)); \
- if (num_args == 3) return(package(prog, R_BOOL, CName ## _i3, #CName "_i3", args, num_args)); \
- if (num_args == 4) return(package(prog, R_BOOL, CName ## _i4, #CName "_i4", args, num_args)); \
- return(package_n(prog, R_BOOL, CName ## _in, #CName "_in", args, num_args)); \
- } \
- return(run_warn(#COp " trouble")); \
-}
-
-REL_OP(gt, greater_than, >, <=)
-REL_OP(geq, greater_than_or_equal, >=, <)
-REL_OP(lt, less_than, <, >=)
-REL_OP(leq, less_than_or_equal, <=, >)
-REL_OP(equal, numbers_equal, ==, !=)
-
-
-/* ---------------- max ---------------- */
-
-static void max_f2(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 > FLOAT_ARG_2) ? FLOAT_ARG_1 : FLOAT_ARG_2;}
-
-static void max_f3(int *args, ptree *pt)
-{
- FLOAT_RESULT = (FLOAT_ARG_1 > FLOAT_ARG_2) ? FLOAT_ARG_1 : FLOAT_ARG_2;
- if (FLOAT_ARG_3 > FLOAT_RESULT) FLOAT_RESULT = FLOAT_ARG_3;
-}
-
-
-static void min_f2(int *args, ptree *pt);
-
-
-static void min_max_f2(int *args, ptree *pt)
-{
- FLOAT_RESULT = (FLOAT_ARG_1 > FLOAT_ARG_2) ? FLOAT_ARG_1 : FLOAT_ARG_2;
- if (FLOAT_ARG_3 < FLOAT_RESULT) FLOAT_RESULT = FLOAT_ARG_3;
-
- /* (let ((x -2.0) (y 1.0)) (run (lambda () (max (- x) (min x y))))) */
-}
-
-
-static void max_min_f2(int *args, ptree *pt)
-{
- FLOAT_RESULT = (FLOAT_ARG_1 > FLOAT_ARG_2) ? FLOAT_ARG_2 : FLOAT_ARG_1;
- if (FLOAT_ARG_3 > FLOAT_RESULT) FLOAT_RESULT = FLOAT_ARG_3;
-
- /* (let ((x -2.0) (y 1.0)) (run (lambda () (min (- x) (max x y))))) */
-}
-
-
-
-static void max_fn(int *args, ptree *pt)
-{
- int i, n;
- Double mx;
- n = INT_ARG_1;
- mx = FLOAT_ARG_2;
- for (i = 2; i <= n; i++)
- if (pt->dbls[args[i + 1]] > mx) mx = pt->dbls[args[i + 1]];
- FLOAT_RESULT = mx;
-}
-
-
-static void max_i2(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 > INT_ARG_2) ? INT_ARG_1 : INT_ARG_2;}
-
-static void max_i3(int *args, ptree *pt)
-{
- INT_RESULT = (INT_ARG_1 > INT_ARG_2) ? INT_ARG_1 : INT_ARG_2;
- if (INT_ARG_3 > INT_RESULT) INT_RESULT = INT_ARG_3;
-}
-
-
-static void max_in(int *args, ptree *pt)
-{
- int i, n;
- Int mx;
- n = INT_ARG_1;
- mx = INT_ARG_2;
- for (i = 2; i <= n; i++)
- if (pt->ints[args[i + 1]] > mx) mx = pt->ints[args[i + 1]];
- INT_RESULT = mx;
-}
-
-
-static xen_value *max_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 1) return(copy_xen_value(args[1]));
- if ((prog->constants > 0) && (prog->float_result)) float_rel_constant_args(prog, num_args, args);
- if (prog->constants == num_args)
- {
- int i;
- Double fmx;
- Int imx;
- if (prog->float_result)
- {
- fmx = prog->dbls[args[1]->addr];
- for (i = 2; i <= num_args; i++)
- if (prog->dbls[args[i]->addr] > fmx) fmx = prog->dbls[args[i]->addr];
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, fmx), R_CONSTANT));
- }
- else
- {
- imx = prog->ints[args[1]->addr];
- for (i = 2; i <= num_args; i++)
- if (prog->ints[args[i]->addr] > imx) imx = prog->ints[args[i]->addr];
- return(make_xen_value(R_INT, add_int_to_ptree(prog, imx), R_CONSTANT));
- }
- }
- if (prog->float_result)
- {
- float_rel_args(prog, num_args, args);
- if (num_args == 2)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->function == min_f2) &&
- ((prev_op->args[0] == args[1]->addr) ||
- (prev_op->args[0] == args[2]->addr)) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[3] = args[2]->addr;
- else prev_op->args[3] = args[1]->addr;
- prev_op->num_args = 4;
- prev_op->function = max_min_f2;
- prev_op->op_name = "max_min_f2";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[3] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- }
- return(package(prog, R_FLOAT, max_f2, "max_f2", args, num_args));
- }
- if (num_args == 3) return(package(prog, R_FLOAT, max_f3, "max_f3", args, num_args));
- return(package_n(prog, R_FLOAT, max_fn, "max_fn", args, num_args));
- }
- if (num_args == 2) return(package(prog, R_INT, max_i2, "max_i2", args, num_args));
- if (num_args == 3) return(package(prog, R_INT, max_i3, "max_i3", args, num_args));
- return(package_n(prog, R_INT, max_in, "max_in", args, num_args));
-}
-
-
-/* ---------------- min ---------------- */
-
-static void min_f2(int *args, ptree *pt) {FLOAT_RESULT = (FLOAT_ARG_1 > FLOAT_ARG_2) ? FLOAT_ARG_2 : FLOAT_ARG_1;}
-
-static void min_f3(int *args, ptree *pt)
-{
- FLOAT_RESULT = (FLOAT_ARG_1 > FLOAT_ARG_2) ? FLOAT_ARG_2 : FLOAT_ARG_1;
- if (FLOAT_ARG_3 < FLOAT_RESULT) FLOAT_RESULT = FLOAT_ARG_3;
-}
-
-
-static void min_fn(int *args, ptree *pt)
-{
- int i, n;
- Double mx;
- n = INT_ARG_1;
- mx = FLOAT_ARG_2;
- for (i = 2; i <= n; i++)
- if (pt->dbls[args[i + 1]] < mx) mx = pt->dbls[args[i + 1]];
- FLOAT_RESULT = mx;
-}
-
-
-static void min_i2(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 > INT_ARG_2) ? INT_ARG_2 : INT_ARG_1;}
-
-static void min_i3(int *args, ptree *pt)
-{
- INT_RESULT = (INT_ARG_1 > INT_ARG_2) ? INT_ARG_2 : INT_ARG_1;
- if (INT_ARG_3 < INT_RESULT) INT_RESULT = INT_ARG_3;
-}
-
-
-static void min_in(int *args, ptree *pt)
-{
- int i, n;
- Int mx;
- n = INT_ARG_1;
- mx = INT_ARG_2;
- for (i = 2; i <= n; i++)
- if (pt->ints[args[i + 1]] < mx) mx = pt->ints[args[i + 1]];
- INT_RESULT = mx;
-}
-
-
-static xen_value *min_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 1) return(copy_xen_value(args[1]));
- if ((prog->constants > 0) && (prog->float_result)) float_rel_constant_args(prog, num_args, args);
- if (prog->constants == num_args)
- {
- int i;
- Double fmx;
- Int imx;
- if (prog->float_result)
- {
- fmx = prog->dbls[args[1]->addr];
- for (i = 2; i <= num_args; i++)
- if (prog->dbls[args[i]->addr] < fmx) fmx = prog->dbls[args[i]->addr];
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, fmx), R_CONSTANT));
- }
- else
- {
- imx = prog->ints[args[1]->addr];
- for (i = 2; i <= num_args; i++)
- if (prog->ints[args[i]->addr] < imx) imx = prog->ints[args[i]->addr];
- return(make_xen_value(R_INT, add_int_to_ptree(prog, imx), R_CONSTANT));
- }
- }
- if (prog->float_result)
- {
- float_rel_args(prog, num_args, args);
- if (num_args == 2)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->function == max_f2) &&
- ((prev_op->args[0] == args[1]->addr) ||
- (prev_op->args[0] == args[2]->addr)) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- if (prev_op->args[0] == args[1]->addr)
- prev_op->args[3] = args[2]->addr;
- else prev_op->args[3] = args[1]->addr;
- prev_op->num_args = 4;
- prev_op->function = min_max_f2;
- prev_op->op_name = "min_max_f2";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[3] = R_FLOAT;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- }
- return(package(prog, R_FLOAT, min_f2, "min_f2", args, num_args));
- }
- if (num_args == 3) return(package(prog, R_FLOAT, min_f3, "min_f3", args, num_args));
- return(package_n(prog, R_FLOAT, min_fn, "min_fn", args, num_args));
- }
- if (num_args == 2) return(package(prog, R_INT, min_i2, "min_i2", args, num_args));
- if (num_args == 3) return(package(prog, R_INT, min_i3, "min_i3", args, num_args));
- return(package_n(prog, R_INT, min_in, "min_in", args, num_args));
-}
-
-
-/* ---------------- not ---------------- */
-
-static void not_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(!(INT_ARG_1));}
-
-
-static xen_value *not_p(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type != R_BOOL)
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT)); /* only #f is false so (not anything)->false */
- if (prog->constants == 1)
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, !(prog->ints[args[1]->addr])), R_CONSTANT));
- return(package(prog, R_BOOL, not_b, "not_b", args, 1));
-}
-
-
-/* ---------------- eq?, eqv?, equal? ---------------- */
-
-static void eq_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(INT_ARG_1 == INT_ARG_2);} /* safe because float arg -> #f below */
-
-static void vct_eq_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(VCT_ARG_1 == VCT_ARG_2);}
-
-static void list_eq_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(LIST_ARG_1 == LIST_ARG_2);}
-
-static void sd_eq_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(SOUND_DATA_ARG_1 == SOUND_DATA_ARG_2);}
-
-static void xen_eq_b(int *args, ptree *pt) {BOOL_RESULT = (Int)s7_is_eq(SCHEME_ARG_1, SCHEME_ARG_2);}
-
-static void clm_eq_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(CLM_ARG_1 == CLM_ARG_2);}
-
-#if USE_SND
-static void sampler_eq_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(SAMPLER_ARG_1 == SAMPLER_ARG_2);} /* safe because float arg -> #f below */
-#endif
-
-static xen_value *eq_p(ptree *prog, xen_value **args, int num_args)
-{
- if ((args[1]->type != args[2]->type) ||
- ((args[1]->type == R_FLOAT) && (prog->constants > 0)) ||
- (args[1]->type == R_STRING) ||
- (args[1]->type == R_FUNCTION))
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT));
- if ((args[1]->type == args[2]->type) &&
- (args[1]->addr == args[2]->addr))
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)true), R_CONSTANT)); /* addr same if (eq? var var) -> always #t */
- if (prog->constants == 2) /* this can include xen vals */
- {
- if ((args[1]->type == R_INT) || (args[1]->type == R_BOOL))
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, prog->ints[args[1]->addr] == prog->ints[args[2]->addr]), R_CONSTANT));
- }
- switch (args[1]->type)
- {
- case R_VCT: return(package(prog, R_BOOL, vct_eq_b, "vct_eq_b", args, 2)); break;
- case R_SOUND_DATA: return(package(prog, R_BOOL, sd_eq_b, "sd_eq_b", args, 2)); break;
- case R_CLM: return(package(prog, R_BOOL, clm_eq_b, "clm_eq_b", args, 2)); break;
-#if USE_SND
- case R_SAMPLER: return(package(prog, R_BOOL, sampler_eq_b, "sampler_eq_b", args, 2)); break;
-#endif
- case R_KEYWORD:
- case R_SYMBOL: return(package(prog, R_BOOL, xen_eq_b, "xen_eq_b", args, 2)); break;
- /* R_FLOAT and R_FUNCTION -> false above */
-
- default:
- if ((args[1]->type == R_LIST) ||
- (CLM_STRUCT_P(args[1]->type)))
- return(package(prog, R_BOOL, list_eq_b, "list_eq_b", args, 2));
- break;
- }
- return(package(prog, R_BOOL, eq_b, "eq_b", args, 2));
-}
-
-
-/* -------- eqv/equal -------- */
-
-static void vct_eqv_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(mus_vct_equalp(VCT_ARG_1, VCT_ARG_2));}
-
-static void sd_eqv_b(int *args, ptree *pt) {BOOL_RESULT = (Int)(sound_data_equalp(SOUND_DATA_ARG_1, SOUND_DATA_ARG_2));}
-
-static void xen_eqv_b(int *args, ptree *pt) {BOOL_RESULT = (Int)s7_is_eqv(SCHEME_ARG_1, SCHEME_ARG_2);}
-
-static void eqv_fb(int *args, ptree *pt) {BOOL_RESULT = (Int)(FLOAT_ARG_1 == FLOAT_ARG_2);}
-
-static void eqv_clm(int *args, ptree *pt) {BOOL_RESULT = (Int)mus_equalp(CLM_ARG_1, CLM_ARG_2);}
-
-
-static xen_value *eqv_p(ptree *prog, xen_value **args, int num_args)
-{
- if ((args[1]->type != args[2]->type) ||
- (args[1]->type == R_STRING) ||
- (args[1]->type == R_FUNCTION))
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT));
- if (prog->constants == 2)
- {
- if (args[1]->type == R_FLOAT)
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, prog->dbls[args[1]->addr] == prog->dbls[args[2]->addr]), R_CONSTANT));
- else
- if ((args[1]->type == R_INT) || (args[1]->type == R_BOOL))
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, prog->ints[args[1]->addr] == prog->ints[args[2]->addr]), R_CONSTANT));
- }
- switch (args[1]->type)
- {
- case R_FLOAT: return(package(prog, R_BOOL, eqv_fb, "eqv_fb", args, 2)); break;
- case R_CLM: return(package(prog, R_BOOL, eqv_clm, "eqv_clm", args, 2)); break;
-#if USE_SND
- case R_SAMPLER: return(package(prog, R_BOOL, sampler_eq_b, "sampler_eq_b", args, 2)); break;
-#endif
- case R_VCT: return(package(prog, R_BOOL, vct_eqv_b, "vct_eqv_b", args, 2)); break;
- case R_SOUND_DATA: return(package(prog, R_BOOL, sd_eqv_b, "sd_eqv_b", args, 2)); break;
- case R_KEYWORD:
- case R_SYMBOL: return(package(prog, R_BOOL, xen_eqv_b, "xen_eqv_b", args, 2)); break;
- default:
- if ((args[1]->type == R_LIST) ||
- (CLM_STRUCT_P(args[1]->type)))
- return(package(prog, R_BOOL, list_eq_b, "list_eqv_b", args, 2));
- break;
- }
- return(package(prog, R_BOOL, eq_b, "eq_b", args, 2));
-}
-
-
-static void xen_equal_b(int *args, ptree *pt) {BOOL_RESULT = (Int)s7_is_equal(s7, SCHEME_ARG_1, SCHEME_ARG_2);}
-
-static void xen_equal_s(int *args, ptree *pt) {BOOL_RESULT = mus_strcmp(STRING_ARG_1, STRING_ARG_2);}
-
-
-static void list_equal_p(int *args, ptree *pt)
-{
- BOOL_RESULT = (Int)(LIST_ARG_1 == LIST_ARG_2);
-
- if ((!(BOOL_RESULT)) &&
- (LIST_ARG_1->len == LIST_ARG_2->len) &&
- (LIST_ARG_1->type == LIST_ARG_2->type))
- {
- int i;
- if (LIST_ARG_1->len == 0)
- BOOL_RESULT = true;
- else
- {
- for (i = 0; i < LIST_ARG_1->len; i++)
- {
- int addr1, addr2;
- addr1 = LIST_ARG_1->vals[i]->addr;
- addr2 = LIST_ARG_2->vals[i]->addr;
-
- switch (LIST_ARG_1->type)
- {
- case R_INT:
- case R_CHAR:
- case R_BOOL:
- if (pt->ints[addr1] != pt->ints[addr2])
- return;
- break;
-
- case R_FLOAT:
- if (pt->dbls[addr1] != pt->dbls[addr2])
- return;
- break;
-
- case R_STRING:
- if (!(mus_strcmp(pt->strs[addr1], pt->strs[addr2])))
- return;
- break;
-
- case R_SYMBOL:
- case R_KEYWORD:
- if (!(s7_is_equal(s7, pt->xens[addr1], pt->xens[addr2])))
- return;
- break;
-
- default:
- return;
- break;
- }
- }
- BOOL_RESULT = true;
- }
- }
-}
-
-
-static xen_value *equal_p(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == args[2]->type)
- switch (args[1]->type)
- {
- case R_KEYWORD:
- case R_SYMBOL:
- return(package(prog, R_BOOL, xen_equal_b, "xen_equal_b", args, 2));
- break;
-
- case R_STRING:
- return(package(prog, R_BOOL, xen_equal_s, "xen_equal_s", args, 2));
- break;
-
- case R_LIST:
- /* eqv? == eq? here, but equal? is different, apparently -- this part of Scheme is really ugly! */
- return(package(prog, R_BOOL, list_equal_p, "list_equal?", args, 2));
- break;
-
- }
- return(eqv_p(prog, args, num_args));
-}
-
-
-/* ---------------- odd?, even?, zero?, positive?, negative? ---------------- */
-
-static xen_value *convert_to_int(ptree *pt, xen_value *v)
-{
- xen_value *newv;
- if (v->type == R_FLOAT)
- {
- newv = convert_dbl_to_int(pt, v, true);
- free(v);
- return(newv);
- }
- return(v);
-}
-
-static void odd_i(int *args, ptree *pt) {BOOL_RESULT = (Int)(INT_ARG_1 & 1);}
-
-
-static xen_value *odd_p(ptree *prog, xen_value **args, int num_args)
-{
- args[1] = convert_to_int(prog, args[1]);
- if (args[1] == NULL) return(run_warn("odd? can't convert arg"));
- if (prog->constants == 1)
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, prog->ints[args[1]->addr] & 1), R_CONSTANT));
- return(package(prog, R_BOOL, odd_i, "odd_i", args, 1));
-}
-
-
-static void even_i(int *args, ptree *pt) {BOOL_RESULT = (Int)(!(INT_ARG_1 & 1));}
-
-
-static xen_value *even_p(ptree *prog, xen_value **args, int num_args)
-{
- args[1] = convert_to_int(prog, args[1]);
- if (args[1] == NULL) return(run_warn("even? can't convert arg"));
- if (prog->constants == 1)
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (!(prog->ints[args[1]->addr] & 1))), R_CONSTANT));
- return(package(prog, R_BOOL, even_i, "even_i", args, 1));
-}
-
-
-#define INT_POS_P(CName, SName, COp) \
-static void CName ## _i(int *args, ptree *pt) {BOOL_RESULT = (Int)(INT_ARG_1 COp 0);} \
-static void CName ## _f(int *args, ptree *pt) {BOOL_RESULT = (Int)(FLOAT_ARG_1 COp 0.0);} \
-static xen_value *CName ## _p(ptree *prog, xen_value **args, int num_args) \
-{ \
- if (prog->constants == 1) \
- { \
- if (args[1]->type == R_INT) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (prog->ints[args[1]->addr] COp 0)), R_CONSTANT)); \
- else \
- { \
- if (args[1]->type == R_FLOAT) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (prog->dbls[args[1]->addr] COp 0.0)), R_CONSTANT)); \
- } \
- } \
- if (args[1]->type == R_FLOAT) \
- return(package(prog, R_BOOL, CName ## _f, #CName "_f", args, 1)); \
- return(package(prog, R_BOOL, CName ## _i, #CName "_i", args, 1)); \
-}
-
-INT_POS_P(zero, zero?, ==)
-INT_POS_P(positive, positive?, >)
-INT_POS_P(negative, negative?, <)
-
-
-static void single_to_float(ptree *prog, xen_value **args, int num)
-{
- xen_value *old_loc;
- old_loc = args[num];
- args[num] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(store_i_f, "store_i_f", 2, args[num], old_loc));
- free(old_loc);
-}
-
-
-/* ---------------- sin, cos, tan ---------------- */
-
-#define FL_OP(CName) \
-static void CName ## _f(int *args, ptree *pt) {FLOAT_RESULT = CName(FLOAT_ARG_1);} \
-static void CName ## _f_i(int *args, ptree *pt) {FLOAT_RESULT = CName((double)(INT_ARG_1));} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- if (prog->constants == 1) \
- { \
- if (args[1]->type == R_INT) \
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, CName((Double)(prog->ints[args[1]->addr]))), R_CONSTANT)); \
- else return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, CName(prog->dbls[args[1]->addr])), R_CONSTANT)); \
- } \
- if (args[1]->type == R_INT) return(package(prog, R_FLOAT, CName ## _f_i, #CName "_f_i", args, 1)); \
- return(package(prog, R_FLOAT, CName ## _f, #CName "_f", args, 1)); \
-}
-
-/* only collapsible funcs here -- if constant arg, constant val (not random!) */
-
-#ifdef _MSC_VER
-double asinh(double x);
-double acosh(double x);
-double atanh(double x);
-#endif
-
-FL_OP(mus_radians_to_hz)
-FL_OP(mus_hz_to_radians)
-FL_OP(mus_degrees_to_radians)
-FL_OP(mus_radians_to_degrees)
-FL_OP(mus_db_to_linear)
-FL_OP(mus_linear_to_db)
-FL_OP(sin)
-FL_OP(cos)
-FL_OP(tan)
-FL_OP(atan)
-FL_OP(asin)
-FL_OP(acos)
-FL_OP(sqrt)
-FL_OP(log)
-FL_OP(exp)
-FL_OP(cosh)
-FL_OP(sinh)
-FL_OP(tanh)
-FL_OP(acosh)
-FL_OP(asinh)
-FL_OP(atanh)
-
-#if HAVE_SPECIAL_FUNCTIONS
- FL_OP(erf)
- FL_OP(lgamma)
- FL_OP(erfc)
- FL_OP(j0)
- FL_OP(j1)
- FL_OP(y0)
- FL_OP(y1)
-#endif
-FL_OP(mus_bessi0)
-
-static void sin_f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * sin(FLOAT_ARG_1);}
-static void cos_f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * cos(FLOAT_ARG_1);}
-static void sqrt_f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * sqrt(FLOAT_ARG_1);}
-
-static void sin_f_mult_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 + FLOAT_ARG_2 * sin(FLOAT_ARG_1);}
-static void cos_f_mult_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 + FLOAT_ARG_2 * cos(FLOAT_ARG_1);}
-
-static void sin_f_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 + sin(FLOAT_ARG_1);}
-static void cos_f_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 + cos(FLOAT_ARG_1);}
-
-static void atan2_f(int *args, ptree *pt) {FLOAT_RESULT = atan2(FLOAT_ARG_1, FLOAT_ARG_2);}
-
-
-static xen_value *atan2_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[1]->type == R_INT)
- {
- temp = args[1];
- args[1] = convert_int_to_dbl(prog, args[1]);
- free(temp);
- }
- if (args[2]->type == R_INT)
- {
- temp = args[2];
- args[2] = convert_int_to_dbl(prog, args[2]);
- free(temp);
- }
- if (prog->constants == 2)
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, atan2(prog->dbls[args[1]->addr], prog->dbls[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_FLOAT, atan2_f, "atan2_f", args, 2));
-}
-
-
-static void fmod_f(int *args, ptree *pt)
-{
- FLOAT_RESULT = fmod(FLOAT_ARG_1, FLOAT_ARG_2);
- if (((FLOAT_ARG_2 > 0.0) && (FLOAT_RESULT < 0.0)) ||
- ((FLOAT_ARG_2 < 0.0) && (FLOAT_RESULT > 0.0)))
- FLOAT_RESULT += FLOAT_ARG_2;
-}
-
-
-static xen_value *fmod_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[1]->type == R_INT)
- {
- temp = args[1];
- args[1] = convert_int_to_dbl(prog, args[1]);
- free(temp);
- }
- if (args[2]->type == R_INT)
- {
- temp = args[2];
- args[2] = convert_int_to_dbl(prog, args[2]);
- free(temp);
- }
- if (prog->constants == 2)
- {
- double x, y, val;
- x = prog->dbls[args[1]->addr];
- y = prog->dbls[args[2]->addr];
- val = fmod(x, y);
- if (((y > 0.0) && (val < 0.0)) ||
- ((y < 0.0) && (val > 0.0)))
- val += y;
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, val), R_CONSTANT));
- }
- return(package(prog, R_FLOAT, fmod_f, "fmod_f", args, 2));
-}
-
-
-#if HAVE_SPECIAL_FUNCTIONS
-static void jn_f(int *args, ptree *pt) {FLOAT_RESULT = jn(INT_ARG_1, FLOAT_ARG_2);}
-
-
-static xen_value *jn_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[2]->type == R_INT)
- {
- temp = args[2];
- args[2] = convert_int_to_dbl(prog, args[2]);
- free(temp);
- }
- if (prog->constants == 2)
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, jn(prog->ints[args[1]->addr], prog->dbls[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_FLOAT, jn_f, "jn_f", args, 2));
-}
-
-
-static void yn_f(int *args, ptree *pt) {FLOAT_RESULT = yn(INT_ARG_1, FLOAT_ARG_2);}
-
-
-static xen_value *yn_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[2]->type == R_INT)
- {
- temp = args[2];
- args[2] = convert_int_to_dbl(prog, args[2]);
- free(temp);
- }
- if (prog->constants == 2)
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, yn(prog->ints[args[1]->addr], prog->dbls[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_FLOAT, yn_f, "yn_f", args, 2));
-}
-#endif
-
-
-
-static void seconds_to_samples_i(int *args, ptree *pt) {INT_RESULT = mus_seconds_to_samples(FLOAT_ARG_1);}
-
-
-static xen_value *seconds_to_samples_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (prog->constants == 1)
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, mus_seconds_to_samples((mus_float_t)(prog->ints[args[1]->addr]))), R_CONSTANT));
- return(make_xen_value(R_INT, add_int_to_ptree(prog, mus_seconds_to_samples(prog->dbls[args[1]->addr])), R_CONSTANT));
- }
-
- if (args[1]->type == R_INT)
- {
- temp = args[1];
- args[1] = convert_int_to_dbl(prog, args[1]);
- free(temp);
- }
- return(package(prog, R_INT, seconds_to_samples_i, "seconds_to_samples_i", args, 1));
-}
-
-
-
-
-/* ---------------- round ---------------- */
-
-static Double f_round(Double x)
-{
- /* tricky here -- if .5 diff, need to round to nearest even int */
- double plus_half = x + 0.5;
- double result = floor(plus_half);
- return((plus_half == result) && ((plus_half / 2) != floor(plus_half / 2)) ? result - 1 : result);
-}
-
-static void round_i(int *args, ptree *pt) {INT_RESULT = (Int)f_round(FLOAT_ARG_1);}
-
-static xen_value *round_1(ptree *prog, xen_value **args, int num_args)
-{
- /* (round 1) -> 1.0! */
- if (args[1]->type == R_INT)
- return(copy_xen_value(args[1]));
-
- if (prog->constants == 1)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (Int)f_round(prog->dbls[args[1]->addr])), R_CONSTANT));
- return(package(prog, R_INT, round_i, "round_i", args, 1));
-}
-
-
-/* ---------------- truncate ---------------- */
-
-static Double f_truncate(Double x)
-{
- if (x < 0.0)
- return(-floor(-x));
- return(floor(x));
-}
-
-static void truncate_i(int *args, ptree *pt) {INT_RESULT = (Int)f_truncate(FLOAT_ARG_1);}
-
-
-static xen_value *truncate_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT)
- return(copy_xen_value(args[1]));
- if (prog->constants == 1)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (Int)f_truncate(prog->dbls[args[1]->addr])), R_CONSTANT));
- return(package(prog, R_INT, truncate_i, "truncate_i", args, 1));
-}
-
-/* ---------------- floor ---------------- */
-
-static void floor_i(int *args, ptree *pt) {INT_RESULT = (Int)floor(FLOAT_ARG_1);}
-
-
-static xen_value *floor_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT)
- return(copy_xen_value(args[1]));
-
- if (prog->constants == 1)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (Int)floor(prog->dbls[args[1]->addr])), R_CONSTANT));
-
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- bool happy = false;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->args[0] == args[1]->addr) &&
- (prev_op->types[0] == R_FLOAT) &&
- (find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL)
- {
- if (prev_op->function == multiply_f2)
- {
- prev_op->function = multiply_f2_i;
- prev_op->op_name = "multiply_f2_i";
- happy = true;
- }
- else
- {
- if (prev_op->function == multiply_f_i)
- {
- prev_op->function = multiply_f_i_i;
- prev_op->op_name = "multiply_f_i_i";
- happy = true;
- }
- else
- {
- if (prev_op->function == divide_f2)
- {
- prev_op->function = divide_f2_i;
- prev_op->op_name = "divide_f2_i";
- happy = true;
- }
- else
- {
- if (prev_op->function == subtract_f2)
- {
- prev_op->function = subtract_f2_i;
- prev_op->op_name = "subtract_f2_i";
- happy = true;
- }
- else
- {
- if (prev_op->function == add_f2)
- {
- prev_op->function = add_f2_i;
- prev_op->op_name = "add_f2_i";
- happy = true;
- }}}}}
- if (happy)
- {
- args[0] = add_temporary_var_to_ptree(prog, R_INT);
- prev_op->types[0] = R_INT;
- prev_op->args[0] = args[0]->addr;
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(args[0]);
- }
- }
- }
-
- return(package(prog, R_INT, floor_i, "floor_i", args, 1));
-}
-
-
-/* ---------------- ceiling ---------------- */
-
-static void ceiling_i(int *args, ptree *pt) {INT_RESULT = (Int)ceil(FLOAT_ARG_1);}
-
-
-static xen_value *ceiling_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT)
- return(copy_xen_value(args[1]));
- if (prog->constants == 1)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (Int)ceil(prog->dbls[args[1]->addr])), R_CONSTANT));
- return(package(prog, R_INT, ceiling_i, "ceiling_i", args, 1));
-}
-
-
-/* ---------------- exact->inexact ---------------- */
-
-static xen_value *exact2inexact_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_FLOAT)
- return(copy_xen_value(args[1]));
- if (prog->constants == 1)
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, (Double)(prog->ints[args[1]->addr])), R_CONSTANT));
- return(package(prog, R_FLOAT, store_i_f, "store_i_f", args, 1));
-}
-
-
-static void i2e_i(int *args, ptree *pt) {INT_RESULT = (Int)floor(FLOAT_ARG_1 + 0.5);}
-
-
-static xen_value *inexact2exact_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT)
- return(copy_xen_value(args[1]));
- if (prog->constants == 1)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (Int)floor(prog->dbls[args[1]->addr] + 0.5)), R_CONSTANT));
- return(package(prog, R_INT, i2e_i, "i2e_i", args, 1));
-}
-
-
-/* ---------------- gcd, lcm ---------------- */
-
-static Int c_mod(Int x, Int y)
-{
- mus_long_t z;
- if (y == 0) return(x); /* else arithmetic exception */
- z = x % y;
- if (((y < 0) && (z > 0)) ||
- ((y > 0) && (z < 0)))
- return(z + y);
- return(z);
-}
-
-static mus_long_t c_gcd(mus_long_t a, mus_long_t b)
-{
- while (b != 0)
- {
- mus_long_t temp;
- temp = b;
- b = a % b;
- a = temp;
- }
- if (a < 0)
- return(-a);
- return(a);
-}
-
-static Int c_lcm(Int a, Int b)
-{
- if ((a == 0) || (b == 0)) return(0);
- if (a < 0) a = -a;
- if (b < 0) b = -b;
- return((a * b) / c_gcd(a, b));
-}
-
-
-static void gcd_in(int *args, ptree *pt)
-{
- int i, n;
- Int mx;
- n = INT_ARG_1;
- mx = c_gcd(INT_ARG_2, INT_ARG_3);
- /* this could be optimized... */
- for (i = 3; i <= n; i++)
- {
- if (mx == 1) break;
- mx = c_gcd(mx, pt->ints[args[i + 1]]);
- }
- INT_RESULT = mx;
-}
-
-
-static void gcd_i(int *args, ptree *pt) {INT_RESULT = c_gcd(INT_ARG_1, INT_ARG_2);}
-
-
-static xen_value *gcd_1(ptree *prog, xen_value **args, int num_args)
-{
- int i;
- if (num_args == 0)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT)); /* (gcd) -> 0 */
-
- for (i = 1; i <= num_args; i++)
- {
- args[i] = convert_to_int(prog, args[i]);
- if (args[i] == NULL) return(run_warn("gcd can't convert to int"));
- }
-
- if (num_args == 1)
- {
- if (args[1]->constant == R_CONSTANT)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, abs(prog->ints[args[1]->addr])), R_CONSTANT)); /* (gcd n) -> (abs n) */
- else
- {
- args[0] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, make_triple(store_i, "store_i", args, 2));
- return(args[0]);
- }
- }
-
- if (prog->constants == num_args)
- {
- Int mx;
- mx = c_gcd(prog->ints[args[1]->addr], prog->ints[args[2]->addr]);
- for (i = 3; i <= num_args; i++)
- {
- if (mx == 1) break;
- mx = c_gcd(mx, prog->ints[args[i]->addr]);
- }
- return(make_xen_value(R_INT, add_int_to_ptree(prog, mx), R_CONSTANT));
- }
-
- if (num_args == 2)
- return(package(prog, R_INT, gcd_i, "gcd_i", args, 2));
- return(package_n(prog, R_INT, gcd_in, "gcd_in", args, num_args));
-}
-
-
-static void lcm_i(int *args, ptree *pt) {INT_RESULT = c_lcm(INT_ARG_1, INT_ARG_2);}
-
-
-static void lcm_in(int *args, ptree *pt)
-{
- int i, n;
- Int mx;
- n = INT_ARG_1;
- mx = c_lcm(INT_ARG_2, INT_ARG_3);
- /* this could be optimized... */
- for (i = 3; i <= n; i++)
- {
- if (mx == 0) break;
- mx = c_lcm(mx, pt->ints[args[i + 1]]);
- }
- INT_RESULT = mx;
-}
-
-
-static xen_value *lcm_1(ptree *prog, xen_value **args, int num_args)
-{
- int i;
- Int mx;
- if (num_args == 0)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, 1), R_CONSTANT)); /* (lcm) -> 1 */
-
- for (i = 1; i <= num_args; i++)
- {
- args[i] = convert_to_int(prog, args[i]);
- if (args[i] == NULL) return(run_warn("lcm can't convert to int"));
- }
-
- if (num_args == 1)
- {
- if (args[1]->constant == R_CONSTANT)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, abs(prog->ints[args[1]->addr])), R_CONSTANT)); /* (lcm n) -> (abs n) */
- else
- {
- args[0] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, make_triple(store_i, "store_i", args, 2));
- return(args[0]);
- }
- }
-
- if (prog->constants == num_args)
- {
- mx = c_lcm(prog->ints[args[1]->addr], prog->ints[args[2]->addr]);
- for (i = 3; i <= num_args; i++)
- {
- if (mx == 0) break;
- mx = c_lcm(mx, prog->ints[args[i]->addr]);
- }
- return(make_xen_value(R_INT, add_int_to_ptree(prog, mx), R_CONSTANT));
- }
-
- if (num_args == 2)
- return(package(prog, R_INT, lcm_i, "lcm_i", args, 2));
- return(package_n(prog, R_INT, lcm_in, "lcm_in", args, num_args));
-}
-
-
-/* ---------------- remainder, quotient, modulo ---------------- */
-
-static void modulo_i(int *args, ptree *pt) {INT_RESULT = c_mod(INT_ARG_1, INT_ARG_2);}
-
-
-static xen_value *modulo_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((args[1]->type == R_FLOAT) ||
- (args[2]->type == R_FLOAT))
- return(fmod_1(prog, args, num_args));
-
- args[1] = convert_to_int(prog, args[1]);
- if (args[1] == NULL) return(run_warn("modulo arg1 can't convert to int"));
- args[2] = convert_to_int(prog, args[2]);
- if (args[2] == NULL) return(run_warn("modulo arg2 can't convert to int"));
- if (prog->constants == 2)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, c_mod(prog->ints[args[1]->addr], prog->ints[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_INT, modulo_i, "modulo_i", args, 2));
-}
-
-
-static void remainder_i(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 % INT_ARG_2);}
-
-
-static xen_value *remainder_1(ptree *prog, xen_value **args, int num_args)
-{
- args[1] = convert_to_int(prog, args[1]);
- if (args[1] == NULL) return(run_warn("remainder arg1 can't convert to int"));
- args[2] = convert_to_int(prog, args[2]);
- if (args[2] == NULL) return(run_warn("remainder arg2 can't convert to int"));
- if (prog->constants == 2)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (prog->ints[args[1]->addr] % prog->ints[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_INT, remainder_i, "remainder_i", args, 2));
-}
-
-
-static void quotient_i(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 / INT_ARG_2);}
-
-
-static xen_value *quotient_1(ptree *prog, xen_value **args, int num_args)
-{
- args[1] = convert_to_int(prog, args[1]);
- if (args[1] == NULL) return(run_warn("quotient arg1 can't convert to int"));
- args[2] = convert_to_int(prog, args[2]);
- if (args[2] == NULL) return(run_warn("quotient arg2 can't convert to int"));
- if (prog->constants == 2)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (prog->ints[args[1]->addr] / prog->ints[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_INT, quotient_i, "quotient_i", args, 2));
-}
-
-
-
-/* ---------------- logand, logior, logxor, lognot, ash ---------------- */
-
-static void logand_i(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 & INT_ARG_2);}
-
-
-static xen_value *logand_1(ptree *prog, xen_value **args, int num_args)
-{
- if (prog->constants == 2)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (prog->ints[args[1]->addr] & prog->ints[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_INT, logand_i, "logand_i", args, 2));
-}
-
-
-static void logior_i(int *args, ptree *pt) {INT_RESULT = (INT_ARG_1 | INT_ARG_2);}
-
-
-static xen_value *logior_1(ptree *prog, xen_value **args, int num_args)
-{
- if (prog->constants == 2)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, (prog->ints[args[1]->addr] | prog->ints[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_INT, logior_i, "logior_i", args, 2));
-}
-
-
-#ifndef XOR
- #define XOR(a, b) ((~((a) & (b))) & ((a) | (b)))
-#endif
-
-static void logxor_i(int *args, ptree *pt) {INT_RESULT = XOR(INT_ARG_1, INT_ARG_2);}
-
-
-static xen_value *logxor_1(ptree *prog, xen_value **args, int num_args)
-{
- if (prog->constants == 2)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, XOR(prog->ints[args[1]->addr], prog->ints[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_INT, logxor_i, "logxor_i", args, 2));
-}
-
-
-static void lognot_i(int *args, ptree *pt) {INT_RESULT = ~INT_ARG_1;}
-
-
-static xen_value *lognot_1(ptree *prog, xen_value **args, int num_args)
-{
- if (prog->constants == 1)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, ~(prog->ints[args[1]->addr])), R_CONSTANT));
- return(package(prog, R_INT, lognot_i, "lognot_i", args, 1));
-}
-
-
-static Int c_ash(Int arg1, Int arg2)
-{
- if (arg2 >= 0)
- return(arg1 << arg2);
- return(arg1 >> -arg2);
-}
-
-static void ash_i(int *args, ptree *pt) {INT_RESULT = c_ash(INT_ARG_1, INT_ARG_2);}
-
-
-static xen_value *ash_1(ptree *prog, xen_value **args, int num_args)
-{
- if (prog->constants == 2)
- return(make_xen_value(R_INT, add_int_to_ptree(prog, c_ash(prog->ints[args[1]->addr], prog->ints[args[2]->addr])), R_CONSTANT));
- return(package(prog, R_INT, ash_i, "ash_i", args, 2));
-}
-
-
-/* ---------------- expt ---------------- */
-
-static void expt_f(int *args, ptree *pt) {FLOAT_RESULT = pow(FLOAT_ARG_1, FLOAT_ARG_2);}
-static void expt_f_i(int *args, ptree *pt) {FLOAT_RESULT = pow(FLOAT_ARG_1, (double)(INT_ARG_2));}
-static void expt_i_f(int *args, ptree *pt) {FLOAT_RESULT = pow((double)(INT_ARG_1), FLOAT_ARG_2);}
-static void expt_i_i(int *args, ptree *pt) {FLOAT_RESULT = pow((double)(INT_ARG_1), (double)(INT_ARG_2));}
-
-static xen_value *expt_1(ptree *prog, xen_value **args, int num_args)
-{
- if (current_optimization < COMPLEX_OK) return(NULL);
- if (prog->constants == 2)
- {
- Double f1, f2;
- if (args[1]->type == R_INT) f1 = (Double)(prog->ints[args[1]->addr]); else f1 = prog->dbls[args[1]->addr];
- if (args[2]->type == R_INT) f2 = (Double)(prog->ints[args[2]->addr]); else f2 = prog->dbls[args[2]->addr];
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, pow(f1, f2)), R_CONSTANT));
- }
- if (args[1]->type == R_INT)
- {
- if (args[2]->type == R_INT)
- return(package(prog, R_FLOAT, expt_i_i, "expt_i_i", args, 2));
- return(package(prog, R_FLOAT, expt_i_f, "expt_i_f", args, 2));
- }
- else
- {
- if (args[2]->type == R_INT)
- return(package(prog, R_FLOAT, expt_f_i, "expt_f_i", args, 2));
- }
- return(package(prog, R_FLOAT, expt_f, "expt_f", args, 2));
-}
-
-
-/* ---------------- abs ---------------- */
-
-static void abs_f(int *args, ptree *pt) {FLOAT_RESULT = fabs(FLOAT_ARG_1);}
-static void abs_f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * fabs(FLOAT_ARG_1);}
-static void abs_f_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 + fabs(FLOAT_ARG_1);}
-static void abs_f_mult_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 + FLOAT_ARG_2 * fabs(FLOAT_ARG_1);}
-static void abs_subtract_f2(int *args, ptree *pt) {FLOAT_RESULT = fabs(FLOAT_ARG_1 - FLOAT_ARG_2);}
-
-static void abs_i(int *args, ptree *pt) {INT_RESULT = ((INT_ARG_1 >= 0) ? INT_ARG_1 : (-INT_ARG_1));} /* not abs=32 bit truncation */
-
-
-static xen_value *abs_1(ptree *prog, xen_value **args, int num_args)
-{
- if (prog->constants == 1)
- {
- if (args[1]->type == R_INT)
- {
- Int val;
- val = prog->ints[args[1]->addr];
- return(make_xen_value(R_INT, add_int_to_ptree(prog, ((val >= 0) ? val : (-val))), R_CONSTANT));
- }
- else return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, fabs(prog->dbls[args[1]->addr])), R_CONSTANT));
- }
- if (args[1]->type == R_INT)
- return(package(prog, R_INT, abs_i, "abs_i", args, 1));
-
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->args[0] == args[1]->addr) &&
- (prev_op->function == subtract_f2) &&
- ((find_var_in_ptree_via_addr(prog, R_INT, prev_op->args[0])) == NULL))
- {
- prev_op->function = abs_subtract_f2;
- prev_op->op_name = "abs_subtract_f2";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- }
- return(package(prog, R_FLOAT, abs_f, "abs_f", args, 1));
-}
-
-
-
-/* ---------------- random ---------------- */
-
-/* random is 0..arg, mus_random is -arg..arg,
- * random arg determines return type, mus_random returns float
- */
-
-static void mus_random_f(int *args, ptree *pt) {FLOAT_RESULT = mus_random(FLOAT_ARG_1);}
-static void mus_random_f_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 + mus_random(FLOAT_ARG_1);}
-static void mus_random_f_1(int *args, ptree *pt) {FLOAT_RESULT = mus_random_no_input();}
-
-/* (run (lambda () (+ (mus-random 1.0) 1.0))) */
-
-static xen_value *mus_random_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT) single_to_float(prog, args, 1);
- if ((prog->constants == 1) &&
- (prog->dbls[args[1]->addr] == 1.0))
- return(package(prog, R_FLOAT, mus_random_f_1, "mus_random_f_1", args, 0));
- return(package(prog, R_FLOAT, mus_random_f, "mus_random_f", args, 1));
-}
-
-
-static void random_f(int *args, ptree *pt) {FLOAT_RESULT = s7_random(s7, NULL) * FLOAT_ARG_1;}
-static void random_f_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 + s7_random(s7, NULL) * FLOAT_ARG_1;}
-static void random_f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * s7_random(s7, NULL) * FLOAT_ARG_1;}
-static void random_i(int *args, ptree *pt) {INT_RESULT = (Int)(s7_random(s7, NULL) * INT_ARG_1);}
-
-static xen_value *random_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT)
- return(package(prog, R_INT, random_i, "random_i", args, 1));
- return(package(prog, R_FLOAT, random_f, "random_f", args, 1));
-}
-
-
-
-/* ---------------- chars ---------------- */
-
-#define CHARP(SName, CName) \
-static void char_ ## CName ## _c(int *args, ptree *pt) {BOOL_RESULT = (Int)CName((int)(INT_ARG_1));} \
-static xen_value * SName(ptree *pt, xen_value **args, int num_args) \
-{ \
- if (pt->constants == 1) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(pt, CName((int)(pt->ints[args[1]->addr]))), R_CONSTANT)); \
- return(package(pt, R_BOOL, char_## CName ## _c, #CName "_c", args, 1)); \
-}
-
-CHARP(char_alphabetic_p, isalpha)
-CHARP(char_numeric_p, isdigit)
-CHARP(char_lower_case_p, islower)
-CHARP(char_upper_case_p, isupper)
-CHARP(char_whitespace_p, isspace)
-
-#define CHARC(SName, CName) \
-static void char_ ## CName ## _c(int *args, ptree *pt) {INT_RESULT = (int)CName(CHAR_ARG_1);} \
-static xen_value * SName(ptree *pt, xen_value **args, int num_args) \
-{ \
- if (pt->constants == 1) \
- return(make_xen_value(R_CHAR, add_int_to_ptree(pt, CName((char)(pt->ints[args[1]->addr]))), R_CONSTANT)); \
- return(package(pt, R_CHAR, char_## CName ## _c, #CName "_c", args, 1)); \
-}
-
-CHARC(char_upcase, toupper)
-CHARC(char_downcase, tolower)
-
-
-static xen_value *char_to_integer(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *newv;
- newv = copy_xen_value(args[1]);
- newv->type = R_INT;
- return(newv);
-}
-
-
-static xen_value **upcase_args(ptree *pt, xen_value **args, int num_args)
-{
- int i;
- for (i = 1; i <= num_args; i++)
- if (args[i])
- {
- xen_value *old_loc;
- old_loc = args[i];
- if (args[i]->constant == R_CONSTANT)
- args[i] = make_xen_value(R_CHAR, add_int_to_ptree(pt, toupper((char)(pt->ints[args[i]->addr]))), R_CONSTANT);
- else
- {
- args[i] = make_xen_value(R_CHAR, add_int_to_ptree(pt, 0), R_VARIABLE);
- add_triple_to_ptree(pt, va_make_triple(char_toupper_c, "toupper_c", 2, args[i], old_loc));
- }
- free(old_loc);
- }
- return(args);
-}
-
-
-/* ---------------- strings ---------------- */
-
-static void string_n(int *args, ptree *pt)
-{
- int i, n;
- n = INT_ARG_1;
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = (char *)calloc(n + 1, sizeof(char));
- for (i = 1; i <= n; i++) STRING_RESULT[i - 1] = (char)(pt->ints[args[i + 1]]);
-}
-
-static xen_value *string_1(ptree *pt, xen_value **args, int num_args)
-{
- if (pt->constants == num_args)
- {
- int i;
- char *str;
- str = (char *)calloc(num_args + 1, sizeof(char));
- for (i = 1; i <= num_args; i++)
- str[i - 1] = (char)(pt->ints[args[i]->addr]);
- return(make_xen_value(R_STRING, add_string_to_ptree(pt, str), R_CONSTANT));
- }
- return(package_n(pt, R_STRING, string_n, "string_n", args, num_args));
-}
-
-
-static void strlen_1(int *args, ptree *pt) {INT_RESULT = mus_strlen(STRING_ARG_1);}
-
-
-static xen_value *string_length_1(ptree *pt, xen_value **args, int num_args)
-{
- if (args[1]->constant == R_CONSTANT)
- return(make_xen_value(R_INT, add_int_to_ptree(pt, mus_strlen(pt->strs[args[1]->addr])), R_CONSTANT));
- return(package(pt, R_INT, strlen_1, "strlen_1", args, 1));
-}
-
-
-static void strcpy_1(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(STRING_ARG_1);
-}
-
-
-static xen_value *string_copy_1(ptree *pt, xen_value **args, int num_args)
-{
- if (args[1]->constant == R_CONSTANT)
- return(make_xen_value(R_STRING, add_string_to_ptree(pt, mus_strdup(pt->strs[args[1]->addr])), R_CONSTANT));
- return(package(pt, R_STRING, strcpy_1, "strcpy_1", args, 1));
-}
-
-
-static void strfill_1(int *args, ptree *pt)
-{
- int len;
- len = mus_strlen(STRING_RESULT);
- if (len > 0)
- memset((void *)(STRING_RESULT), (char)(CHAR_ARG_1), len);
-}
-
-
-static xen_value *string_fill_1(ptree *pt, xen_value **args, int num_args)
-{
- if (args[1]->constant == R_CONSTANT)
- return(run_warn("constant 1st arg to string-fill!"));
- add_triple_to_ptree(pt, va_make_triple(strfill_1, "strfill_1", 2, args[1], args[2])); /* shifts back one */
- return(make_xen_value(R_UNSPECIFIED, -1, R_CONSTANT));
-}
-
-
-static void strset_1(int *args, ptree *pt) {STRING_RESULT[INT_ARG_1] = (char)(CHAR_ARG_2);}
-
-
-static xen_value *string_set_1(ptree *pt, xen_value **args, int num_args)
-{
- if (args[1]->constant == R_CONSTANT)
- return(run_warn("constant 1st arg to string-set!"));
- add_triple_to_ptree(pt, va_make_triple(strset_1, "strset_1", 3, args[1], args[2], args[3])); /* shifts back one */
- return(make_xen_value(R_UNSPECIFIED, -1, R_CONSTANT));
-}
-
-
-static void strref_1(int *args, ptree *pt) {CHAR_RESULT = (char)(STRING_ARG_1[INT_ARG_2]);}
-
-
-static xen_value *string_ref_1(ptree *pt, xen_value **args, int num_args)
-{
- if ((args[1]->constant == R_CONSTANT) && (args[2]->constant == R_CONSTANT))
- return(make_xen_value(R_CHAR, add_int_to_ptree(pt, (int)(pt->strs[args[1]->addr][pt->ints[args[2]->addr]])), R_CONSTANT));
- return(package(pt, R_CHAR, strref_1, "strref_1", args, 2));
-}
-
-
-static char *vect_to_string(vect *v, int type)
-{
- #define VECT_STRING_SIZE 32
- int len, slen;
- char *buf;
-
- if (v == NULL)
- return(mus_strdup("#<vect: null>"));
-
- len = 8;
- if (len > v->length) len = v->length;
- slen = 64 + len * VECT_STRING_SIZE;
- buf = (char *)calloc(slen, sizeof(char));
- sprintf(buf, "#<vect[len=%d]:", v->length);
-
- if (len > 0)
- {
- int i;
- char flt[VECT_STRING_SIZE];
- for (i = 0; i < len; i++)
- {
- switch (type)
- {
- case R_INT_VECTOR:
- mus_snprintf(flt, VECT_STRING_SIZE, " " INT_STR, v->data.ints[i]);
- break;
-
- case R_VCT_VECTOR:
- if (v->data.vcts[i])
- mus_snprintf(flt, VECT_STRING_SIZE, " #<vct[len=" MUS_LD "]>", (v->data.vcts[i])->length);
- else mus_snprintf(flt, VECT_STRING_SIZE, " %s", "#f");
- break;
-
- case R_CLM_VECTOR:
- if (v->data.gens[i])
- mus_snprintf(flt, VECT_STRING_SIZE, " #<%s>", mus_name(v->data.gens[i]));
- else mus_snprintf(flt, VECT_STRING_SIZE, " %s", "#f");
- break;
-
- case R_LIST_VECTOR:
- if (v->data.lists[i])
- mus_snprintf(flt, VECT_STRING_SIZE, " #<list[len=%d]>", v->data.lists[i]->len);
- else mus_snprintf(flt, VECT_STRING_SIZE, " '()");
- break;
- }
- buf = mus_strcat(buf, flt, &slen);
- }
-
- if (v->length > 8)
- buf = mus_strcat(buf, " ...", &slen);
- }
-
- buf = mus_strcat(buf, ">", &slen);
- return(buf);
-}
-
-
-static char *int_vect_to_string(vect *v) {return(vect_to_string(v, R_INT_VECTOR));}
-
-
-static char *clm_vect_to_string(vect *v) {return(vect_to_string(v, R_CLM_VECTOR));}
-
-
-static char *list_vect_to_string(vect *v) {return(vect_to_string(v, R_LIST_VECTOR));}
-
-
-static char *vct_vect_to_string(vect *v) {return(vect_to_string(v, R_VCT_VECTOR));}
-
-
-static void display_str(int *args, ptree *pt) {fprintf(stdout, "%s", STRING_ARG_1);}
-
-
-static void display_int(int *args, ptree *pt) {fprintf(stdout, INT_STR, INT_ARG_1);}
-
-
-static void display_flt(int *args, ptree *pt) {fprintf(stdout, "%.6f", FLOAT_ARG_1);}
-
-
-static void display_symbol(int *args, ptree *pt)
-{
- char *temp = NULL;
- fprintf(stdout, "%s", temp = s7_object_to_c_string(s7, SCHEME_ARG_1));
- if (temp) free(temp);
-}
-
-
-static void display_key(int *args, ptree *pt)
-{
- char *temp = NULL;
- fprintf(stdout, "%s", temp = s7_object_to_c_string(s7, SCHEME_ARG_1));
- if (temp) free(temp);
-}
-
-
-static void display_clm(int *args, ptree *pt)
-{
- char *str;
- fprintf(stdout, "%s", str = mus_describe(CLM_ARG_1));
- if (str) free(str);
-}
-
-
-static void display_vct(int *args, ptree *pt)
-{
- char *v = NULL;
- v = mus_vct_to_string(VCT_ARG_1);
- if (v)
- {
- fprintf(stdout, "%s", v);
- free(v);
- }
-}
-
-
-
-static void display_int_vect(int *args, ptree *pt)
-{
- char *buf = NULL;
- buf = int_vect_to_string(VECT_ARG_1);
- if (buf) {fprintf(stdout, "%s", buf); free(buf); }
-}
-
-
-
-static void display_clm_vect(int *args, ptree *pt)
-{
- char *buf = NULL;
- buf = clm_vect_to_string(VECT_ARG_1);
- if (buf) {fprintf(stdout, "%s", buf); free(buf); }
-}
-
-
-static void display_list_vect(int *args, ptree *pt)
-{
- char *buf = NULL;
- buf = list_vect_to_string(VECT_ARG_1);
- if (buf) {fprintf(stdout, "%s", buf); free(buf); }
-}
-
-
-static void display_vct_vect(int *args, ptree *pt)
-{
- char *buf = NULL;
- buf = vct_vect_to_string(VECT_ARG_1);
- if (buf) {fprintf(stdout, "%s", buf); free(buf); }
-}
-
-
-#if USE_SND
-static void display_rd(int *args, ptree *pt) {char *buf = NULL; fprintf(stdout, "%s", buf = sampler_to_string(SAMPLER_ARG_1)); free(buf);}
-#endif
-
-static void display_sd(int *args, ptree *pt) {char *buf = NULL; fprintf(stdout, "%s", buf = sound_data_to_string(SOUND_DATA_ARG_1)); free(buf);}
-
-
-static void display_chr(int *args, ptree *pt) {fprintf(stdout, "%c", (char)(INT_ARG_1));}
-
-
-static void display_bool(int *args, ptree *pt) {fprintf(stdout, "%s", B2S(INT_ARG_1));}
-
-
-static void display_con(int *args, ptree *pt) {fprintf(stdout, GO_PT, args[1]);}
-
-
-static void display_func(int *args, ptree *pt)
-{
- char *p = NULL;
- p = describe_ptree(FNC_ARG_1, "");
- if (p)
- {
- fprintf(stdout, "%s", p);
- free(p);
- }
-}
-
-
-static xen_value *display_1(ptree *pt, xen_value **args, int num_args)
-{
- switch (args[1]->type)
- {
- case R_STRING: return(package(pt, R_BOOL, display_str, "display_str", args, 1)); break;
- case R_INT: return(package(pt, R_BOOL, display_int, "display_int", args, 1)); break;
- case R_FLOAT: return(package(pt, R_BOOL, display_flt, "display_flt", args, 1)); break;
- case R_CLM: return(package(pt, R_BOOL, display_clm, "display_clm", args, 1)); break;
- case R_SYMBOL: return(package(pt, R_BOOL, display_symbol, "display_symbol", args, 1)); break;
- case R_KEYWORD: return(package(pt, R_BOOL, display_key, "display_key", args, 1)); break;
-#if USE_SND
- case R_SAMPLER: return(package(pt, R_BOOL, display_rd, "display_rd", args, 1)); break;
-#endif
- case R_FLOAT_VECTOR:
- case R_VCT: return(package(pt, R_BOOL, display_vct, "display_vct", args, 1)); break;
- case R_SOUND_DATA: return(package(pt, R_BOOL, display_sd, "display_sd", args, 1)); break;
- case R_BOOL: return(package(pt, R_BOOL, display_bool, "display_bool", args, 1)); break;
- case R_CHAR: return(package(pt, R_BOOL, display_chr, "display_chr", args, 1)); break;
- case R_GOTO: return(package(pt, R_BOOL, display_con, "display_con", args, 1)); break;
- case R_FUNCTION: return(package(pt, R_BOOL, display_func, "display_func", args, 1)); break;
- case R_VCT_VECTOR: return(package(pt, R_BOOL, display_vct_vect, "display_vect", args, 1)); break;
- case R_INT_VECTOR: return(package(pt, R_BOOL, display_int_vect, "display_vect", args, 1)); break;
- case R_CLM_VECTOR: return(package(pt, R_BOOL, display_clm_vect, "display_vect", args, 1)); break;
- case R_LIST_VECTOR: return(package(pt, R_BOOL, display_list_vect, "display_vect", args, 1)); break;
- }
- return(NULL);
-}
-
-
-static xen_value *symbol2string_1(ptree *pt, xen_value **args, int num_args)
-{
- return(make_xen_value(R_STRING,
- add_string_to_ptree(pt, mus_strdup(s7_symbol_name(pt->xens[args[1]->addr]))),
- R_CONSTANT));
-}
-
-#if USE_SND
-static void snd_print_s(int *args, ptree *pt) {fprintf(stderr, STRING_ARG_1);}
-
-
-static xen_value *snd_print_1(ptree *pt, xen_value **args, int num_args) {return(package(pt, R_BOOL, snd_print_s, "snd_print_s", args, 1));}
-
-
-static void snd_warning_s(int *args, ptree *pt) {snd_warning("%s", STRING_ARG_1);}
-
-
-static xen_value *snd_warning_1(ptree *pt, xen_value **args, int num_args) {return(package(pt, R_BOOL, snd_warning_s, "snd_warning_s", args, 1));}
-#endif
-
-static void strmake_c(int *args, ptree *pt, char c)
-{
- int i, n;
- n = INT_ARG_1;
- if (STRING_RESULT) free(STRING_RESULT);
- /* this should be safe because we don't allow (set! str str1) aliasing */
- STRING_RESULT = (char *)calloc(n + 1, sizeof(char));
- for (i = 1; i <= n; i++) STRING_RESULT[i - 1] = c;
-}
-
-
-static void strmake_1(int *args, ptree *pt) {strmake_c(args, pt, ' ');}
-
-
-static void strmake_2(int *args, ptree *pt) {strmake_c(args, pt, CHAR_ARG_2);}
-
-
-static xen_value *make_string_1(ptree *pt, xen_value **args, int num_args)
-{
- if (num_args == 1)
- return(package(pt, R_STRING, strmake_1, "strmake_1", args, 1));
- return(package(pt, R_STRING, strmake_2, "strmake_2", args, 2));
-}
-
-
-static char *substring(const char *str, int start, int end)
-{
- int i, len;
- char *newstr;
- len = end - start;
- if (len <= 0) return((char *)calloc(1, sizeof(char)));
- newstr = (char *)calloc(len + 1, sizeof(char));
- for (i = 0; i < len; i++) newstr[i] = str[i + start];
- return(newstr);
-}
-
-static void substr_1(int *args, ptree *pt)
-{
- int start, end, len, arg_len;
- start = INT_ARG_2;
- end = INT_ARG_3;
- arg_len = mus_strlen(STRING_ARG_1);
- if (arg_len < end) end = arg_len; /* should throw run-time error technically */
- len = end - start;
- if (STRING_RESULT) free(STRING_RESULT);
- if (len <= 0)
- STRING_RESULT = (char *)calloc(1, sizeof(char));
- else
- {
- int i;
- STRING_RESULT = (char *)calloc(len + 1, sizeof(char));
- for (i = 0; i < len; i++)
- STRING_RESULT[i] = STRING_ARG_1[i + start];
- }
-}
-
-
-static xen_value *substring_1(ptree *pt, xen_value **args, int num_args)
-{
- if (pt->constants == 3)
- {
- /* parse time substring -- can check bounds here */
- int beg, end, len;
- len = mus_strlen(pt->strs[args[1]->addr]);
- beg = pt->ints[args[2]->addr];
- end = pt->ints[args[3]->addr];
- if ((beg <= len) && (end <= len))
- return(make_xen_value(R_STRING,
- add_string_to_ptree(pt, substring(pt->strs[args[1]->addr], beg, end)),
- R_CONSTANT));
- return(run_warn("substring: args out of range"));
- }
- return(package(pt, R_STRING, substr_1, "substr_1", args, 3));
-}
-
-
-static char *string_append(ptree *pt, xen_value **args, int num_args)
-{
- int i, len = 0;
- char *str;
- for (i = 0; i < num_args; i++)
- len += mus_strlen(pt->strs[args[i + 1]->addr]);
- str = (char *)calloc(len + 1, sizeof(char));
- for (i = 0; i < num_args; i++)
- if (pt->strs[args[i + 1]->addr])
- strcat(str, pt->strs[args[i + 1]->addr]);
- return(str);
-}
-
-static void appendstr_n(int *args, ptree *pt)
-{
- int i, n, len = 0;
- if (STRING_RESULT) free(STRING_RESULT);
- n = INT_ARG_1;
- for (i = 1; i <= n; i++) len += mus_strlen(pt->strs[args[i + 1]]);
- STRING_RESULT = (char *)calloc(len + 1, sizeof(char));
- for (i = 1; i <= n; i++)
- if (pt->strs[args[i + 1]])
- strcat(STRING_RESULT, pt->strs[args[i + 1]]);
-}
-
-
-static xen_value *string_append_1(ptree *pt, xen_value **args, int num_args)
-{
- if (num_args == 0)
- return(make_xen_value(R_STRING, add_string_to_ptree(pt, (char *)calloc(1, sizeof(char))), R_CONSTANT));
- if (num_args == pt->constants)
- return(make_xen_value(R_STRING, add_string_to_ptree(pt, string_append(pt, args, num_args)), R_CONSTANT));
- if (num_args == 1)
- return(copy_xen_value(args[1]));
- return(package_n(pt, R_STRING, appendstr_n, "appendstr_n", args, num_args));
-}
-
-
-#define STR_REL_OP(CName, SName, COp) \
-static bool str_ ## CName ## _n(ptree *pt, xen_value **args, int num_args) \
-{ \
- int i; \
- for (i = 2; i <= num_args; i++) \
- if (safe_strcmp(pt->strs[args[i - 1]->addr], pt->strs[args[i]->addr]) COp 0) \
- return(false); \
- return(true); \
-} \
-static void string_ ## CName ## _2(int *args, ptree *pt) {BOOL_RESULT = (!(safe_strcmp(STRING_ARG_1, STRING_ARG_2) COp 0));} \
-static void string_ ## CName ## _n(int *args, ptree *pt) \
-{ \
- int i, n; \
- n = INT_ARG_1; \
- BOOL_RESULT = (Int)true; \
- for (i = 2; i <= n; i++) \
- if (safe_strcmp(pt->strs[args[i]], pt->strs[args[i + 1]]) COp 0) \
- { \
- BOOL_RESULT = (Int)false; \
- break; \
- } \
-} \
-static xen_value *string_ ## CName ## _1(ptree *pt, xen_value **args, int num_args) \
-{ \
- int i; \
- char *lasts = NULL; \
- if (num_args <= 1) return(make_xen_value(R_BOOL, add_int_to_ptree(pt, (Int)true), R_CONSTANT)); \
- if (num_args == pt->constants) return(make_xen_value(R_BOOL, add_int_to_ptree(pt, str_ ## CName ## _n(pt, args, num_args)), R_CONSTANT)); \
- if (pt->constants > 1) \
- for (i = 1; i <= num_args; i++) \
- if (args[i]->constant == R_CONSTANT) \
- { \
- if ((lasts) && (safe_strcmp(lasts, pt->strs[args[i]->addr]) COp 0)) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(pt, (Int)false), R_CONSTANT)); \
- lasts = pt->strs[args[i]->addr]; \
- } \
- if (num_args == 2) return(package(pt, R_BOOL, string_ ## CName ## _2, "string_" #CName "_2", args, num_args)); \
- return(package_n(pt, R_BOOL, string_ ## CName ## _n, "string_" #CName "_n", args, num_args)); \
-}
-
-STR_REL_OP(eq, string=?, !=)
-STR_REL_OP(geq, string>=?, <)
-STR_REL_OP(leq, string<=?, >)
-STR_REL_OP(gt, string>?, <=)
-STR_REL_OP(lt, string<?, >=)
-
-
-#define STR_CI_REL_OP(CName, SName, COp) \
-static bool str_ci_ ## CName ## _n(ptree *pt, xen_value **args, int num_args) \
-{ \
- int i; \
- for (i = 2; i <= num_args; i++) \
- if (safe_strcasecmp(pt->strs[args[i - 1]->addr], pt->strs[args[i]->addr]) COp 0) \
- return(false); \
- return(true); \
-} \
-static void string_ci_ ## CName ## _n(int *args, ptree *pt) \
-{ \
- int i, n; \
- n = INT_ARG_1; \
- BOOL_RESULT = (Int)true; \
- for (i = 2; i <= n; i++) \
- if (safe_strcasecmp(pt->strs[args[i]], pt->strs[args[i + 1]]) COp 0) \
- { \
- BOOL_RESULT = (Int)false; \
- break; \
- } \
-} \
-static xen_value *string_ci_ ## CName ## _1(ptree *pt, xen_value **args, int num_args) \
-{ \
- if (num_args <= 1) return(make_xen_value(R_BOOL, add_int_to_ptree(pt, (Int)true), R_CONSTANT)); \
- if (num_args == pt->constants) return(make_xen_value(R_BOOL, add_int_to_ptree(pt, str_ci_ ## CName ## _n(pt, args, num_args)), R_CONSTANT)); \
- return(package_n(pt, R_BOOL, string_ci_ ## CName ## _n, "string_ci_" #CName "_n", args, num_args)); \
-}
-
-STR_CI_REL_OP(eq, string=?, !=)
-STR_CI_REL_OP(geq, string>=?, <)
-STR_CI_REL_OP(leq, string<=?, >)
-STR_CI_REL_OP(gt, string>?, <=)
-STR_CI_REL_OP(lt, string<?, >=)
-
-
-/* ---------------- number->string ---------------- */
-
-static char *f2s_1(Double n) {return(DOUBLE_TO_STRING(n));}
-static char *f2s_2(Double n, int rad) {return(DOUBLE_TO_STRING_WITH_RADIX(n, rad));}
-static char *i2s_1(Int n) {return(INTEGER_TO_STRING(n));}
-static char *i2s_2(Int n, int rad) {return(INTEGER_TO_STRING_WITH_RADIX(n, rad));}
-
-static void number2string_f1(int *args, ptree *pt) {if (STRING_RESULT) free(STRING_RESULT); STRING_RESULT = f2s_1(FLOAT_ARG_1);}
-
-static void number2string_f2(int *args, ptree *pt) {if (STRING_RESULT) free(STRING_RESULT); STRING_RESULT = f2s_2(FLOAT_ARG_1, INT_ARG_2);}
-
-static void number2string_i1(int *args, ptree *pt) {if (STRING_RESULT) free(STRING_RESULT); STRING_RESULT = i2s_1(INT_ARG_1);}
-
-static void number2string_i2(int *args, ptree *pt) {if (STRING_RESULT) free(STRING_RESULT); STRING_RESULT = i2s_2(INT_ARG_1, INT_ARG_2);}
-
-static xen_value *number2string_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((args[1]->type == R_INT) || (args[1]->type == R_FLOAT))
- {
- if (num_args == 1)
- {
- if (prog->constants == 1)
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_STRING, add_string_to_ptree(prog, i2s_1(prog->ints[args[1]->addr])), R_CONSTANT));
- else return(make_xen_value(R_STRING, add_string_to_ptree(prog, f2s_1(prog->dbls[args[1]->addr])), R_CONSTANT));
- }
- if (args[1]->type == R_INT)
- return(package(prog, R_STRING, number2string_i1, "number2string_i1", args, 1));
- return(package(prog, R_STRING, number2string_f1, "number2string_f1", args, 1));
- }
- else
- {
- if (args[2]->type == R_INT)
- {
- if (prog->constants == 2)
- {
- if (args[1]->type == R_INT)
- return(make_xen_value(R_STRING, add_string_to_ptree(prog, i2s_2(prog->ints[args[1]->addr], prog->ints[args[2]->addr])), R_CONSTANT));
- else return(make_xen_value(R_STRING, add_string_to_ptree(prog, f2s_2(prog->dbls[args[1]->addr], prog->ints[args[2]->addr])), R_CONSTANT));
- }
- if (args[1]->type == R_INT)
- return(package(prog, R_STRING, number2string_i2, "number2string_i2", args, 2));
- return(package(prog, R_STRING, number2string_f2, "number2string_f2", args, 2));
- }
- }
- }
- return(NULL);
-}
-
-/* ---------------- user-defined function call ---------------- */
-
-static void funcall_i1(int *args, ptree *pt)
-{
- /* 1 int arg, int result */
- ptree *func;
- func = ((ptree **)(pt->fncs))[args[1]];
- pt->ints[func->args[0]] = pt->ints[args[2]];
- eval_embedded_ptree(func, pt);
- INT_RESULT = pt->ints[func->result->addr];
-}
-
-
-static void funcall_f1(int *args, ptree *pt)
-{
- /* 1 float arg, float result */
- ptree *func;
- func = ((ptree **)(pt->fncs))[args[1]];
- pt->dbls[func->args[0]] = pt->dbls[args[2]];
- eval_embedded_ptree(func, pt);
- FLOAT_RESULT = pt->dbls[func->result->addr];
-}
-
-
-static void funcall_f2(int *args, ptree *pt)
-{
- /* 2 float args, float result */
- ptree *func;
- func = ((ptree **)(pt->fncs))[args[1]];
- pt->dbls[func->args[0]] = pt->dbls[args[2]];
- pt->dbls[func->args[1]] = pt->dbls[args[3]];
- eval_embedded_ptree(func, pt);
- FLOAT_RESULT = pt->dbls[func->result->addr];
-}
-
-
-static void funcall_f2b(int *args, ptree *pt)
-{
- /* 2 float args, boolean result */
- ptree *func;
- func = ((ptree **)(pt->fncs))[args[1]];
- pt->dbls[func->args[0]] = pt->dbls[args[2]];
- pt->dbls[func->args[1]] = pt->dbls[args[3]];
- eval_embedded_ptree(func, pt);
- BOOL_RESULT = pt->ints[func->result->addr];
-}
-
-
-static void funcall_cf2(int *args, ptree *pt)
-{
- /* clm struct and float arg, float result -- very common case! */
- ptree *func;
- func = ((ptree **)(pt->fncs))[args[1]];
- pt->lists[func->args[0]] = pt->lists[args[2]];
- pt->dbls[func->args[1]] = pt->dbls[args[3]];
- eval_embedded_ptree(func, pt);
- FLOAT_RESULT = pt->dbls[func->result->addr];
-}
-
-
-static void outa_funcall_cf2(int *args, ptree *pt)
-{
- ptree *func;
- func = ((ptree **)(pt->fncs))[args[4]];
- pt->lists[func->args[0]] = pt->lists[args[2]];
- pt->dbls[func->args[1]] = pt->dbls[args[5]];
- eval_embedded_ptree(func, pt);
- mus_out_any(INT_ARG_1, pt->dbls[func->result->addr], 0, CLM_ARG_3);
-}
-
-
-static void outb_funcall_cf2(int *args, ptree *pt)
-{
- ptree *func;
- func = ((ptree **)(pt->fncs))[args[4]];
- pt->lists[func->args[0]] = pt->lists[args[2]];
- pt->dbls[func->args[1]] = pt->dbls[args[5]];
- eval_embedded_ptree(func, pt);
- mus_out_any(INT_ARG_1, pt->dbls[func->result->addr], 1, CLM_ARG_3);
-}
-
-
-static void funcall_nf(int *args, ptree *pt)
-{
- int i;
- ptree *func;
- xen_value *fres;
- func = ((ptree **)(pt->fncs))[args[1]];
- fres = func->result;
-
- /* we might be passed fewer args than func->arity has room for, but we'll fix up in funcall_n */
-
- /* fprintf(stderr, "funcall %d args\n", func->arity); */
-
- for (i = 0; i < func->arity; i++)
- switch (func->arg_types[i])
- {
- case R_BOOL:
- case R_CHAR:
- case R_INT:
- pt->ints[func->args[i]] = pt->ints[args[i + 2]];
- break;
-
- case R_FLOAT:
- /* fprintf(stderr, "float arg %d from %d at %d: %f\n", i, args[i + 2], func->args[1 + 2], pt->dbls[args[i + 2]]); */
- pt->dbls[func->args[i]] = pt->dbls[args[i + 2]];
- break;
-
- case R_STRING:
- if (pt->strs[func->args[i]]) free(pt->strs[func->args[i]]);
- pt->strs[func->args[i]] = mus_strdup(pt->strs[args[i + 2]]);
- break;
-
- case R_FLOAT_VECTOR:
- case R_VCT:
- pt->vcts[func->args[i]] = pt->vcts[args[i + 2]];
- break;
-
- case R_SOUND_DATA:
- pt->sds[func->args[i]] = pt->sds[args[i + 2]];
- break;
-
- case R_CLM:
- pt->clms[func->args[i]] = pt->clms[args[i + 2]];
- break;
-
- case R_LIST_VECTOR:
- case R_CLM_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- pt->vects[func->args[i]] = pt->vects[args[i + 2]];
- break;
-
- case R_LIST:
- /* fprintf(stderr,"got list %d as arg %d\n", args[i + 2], i); */
- pt->lists[func->args[i]] = pt->lists[args[i + 2]];
- break;
-
- case R_FUNCTION:
- pt->fncs[func->args[i]] = pt->fncs[args[i + 2]];
- break;
-
- case R_SYMBOL:
- case R_KEYWORD:
- pt->xens[func->args[i]] = pt->xens[args[i + 2]];
- break;
-
-#if USE_SND
- case R_SAMPLER:
- pt->samplers[func->args[i]] = pt->samplers[args[i + 2]];
- break;
-#endif
-
- default:
- if (CLM_STRUCT_P(func->arg_types[i]))
- pt->lists[func->args[i]] = pt->lists[args[i + 2]];
- break;
- }
-
- eval_embedded_ptree(func, pt);
-
- switch (fres->type)
- {
- case R_BOOL:
- case R_CHAR:
- case R_INT:
- INT_RESULT = pt->ints[fres->addr];
- break;
-
- case R_FLOAT:
- FLOAT_RESULT = pt->dbls[fres->addr];
- break;
-
- case R_STRING:
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = pt->strs[fres->addr];
- pt->strs[fres->addr] = NULL;
- break;
-
- case R_FLOAT_VECTOR:
- case R_VCT:
- VCT_RESULT = pt->vcts[fres->addr];
- break;
-
- case R_SOUND_DATA:
- SOUND_DATA_RESULT = pt->sds[fres->addr];
- break;
-
- case R_CLM:
- CLM_RESULT = pt->clms[fres->addr];
- break;
-
- case R_LIST:
- LIST_RESULT = pt->lists[fres->addr];
- break;
-
- case R_LIST_VECTOR:
- case R_CLM_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- VECT_RESULT = pt->vects[fres->addr];
- break;
-
- case R_SYMBOL:
- case R_KEYWORD:
- SCHEME_RESULT = pt->xens[fres->addr];
- break;
-
- case R_FUNCTION:
- FNC_RESULT = ((ptree **)(pt->fncs))[fres->addr];
- break;
-
-#if USE_SND
- case R_SAMPLER:
- SAMPLER_RESULT = pt->samplers[fres->addr];
- break;
-#endif
-
- default:
- if (CLM_STRUCT_P(fres->type))
- LIST_RESULT = pt->lists[fres->addr];
- break;
- }
-}
-
-
-static xen_value *funcall_n(ptree *prog, xen_value **args, int num_args, xen_value *sf)
-{
- ptree *func;
- int i, total_args;
- xen_value **new_args;
- xen_value *fres;
-
- func = ((ptree **)(prog->fncs))[sf->addr];
- if (!func)
- return(run_warn("inner lambda lost!"));
-
- if (func->arity < num_args)
- return(run_warn("not enough args for func (got %d, wants %d)", num_args, func->arity));
-
- /* if func_arity > num_args, pass in the extras explicitly */
-
- if (func->arity > num_args)
- total_args = func->arity;
- else total_args = num_args;
-
- fres = func->result;
- new_args = (xen_value **)calloc(total_args + 2, sizeof(xen_value *));
-
- for (i = 1; i <= num_args; i++)
- {
- new_args[i + 1] = args[i];
-
- if (CLM_STRUCT_P(args[i]->type))
- {
- xen_var *var;
- var = find_var_in_ptree_via_addr(prog, args[i]->type, args[i]->addr);
- if (var) var->unclean = true;
- }
- }
-
- if (total_args > num_args)
- {
- for (i = num_args + 1; i <= total_args; i++)
- {
- /* pick up (copy) default values */
- xen_value *v = NULL;
-
- switch (func->arg_types[i - 1])
- {
- case R_INT:
- case R_CHAR:
- case R_BOOL:
- v = make_xen_value(func->arg_types[i - 1], add_int_to_ptree(prog, prog->ints[func->default_args[i - 1]]), R_CONSTANT);
- break;
-
- case R_FLOAT:
- v = make_xen_value(func->arg_types[i - 1], add_dbl_to_ptree(prog, prog->dbls[func->default_args[i - 1]]), R_CONSTANT);
- break;
-
- case R_STRING:
- v = make_xen_value(func->arg_types[i - 1], add_string_to_ptree(prog, mus_strdup(prog->strs[func->default_args[i - 1]])), R_CONSTANT);
- break;
- }
-
- /* fprintf(stderr, "default arg %d from %d: %s\n", i - 1, func->default_args[i - 1], describe_xen_value(v, prog)); */
- new_args[i + 1] = v;
- }
- }
-
- new_args[1] = sf;
- new_args[0] = add_temporary_var_to_ptree(prog, fres->type);
- args[0] = new_args[0];
-
- if (total_args == 1)
- {
- if ((func->arg_types[0] == R_FLOAT) &&
- (fres->type == R_FLOAT))
- add_triple_to_ptree(prog, make_triple(funcall_f1, "funcall_f1", new_args, total_args + 2));
- else
- {
- if ((func->arg_types[0] == R_INT) &&
- (fres->type == R_INT))
- add_triple_to_ptree(prog, make_triple(funcall_i1, "funcall_i1", new_args, total_args + 2));
- else add_triple_to_ptree(prog, make_triple(funcall_nf, "funcall_nf", new_args, total_args + 2));
- }
- }
- else
- {
- if (total_args == 2)
- {
- if ((func->arg_types[0] == R_FLOAT) &&
- (func->arg_types[1] == R_FLOAT))
- {
- if (fres->type == R_FLOAT)
- add_triple_to_ptree(prog, make_triple(funcall_f2, "funcall_f2", new_args, total_args + 2));
- else
- {
- if (fres->type == R_BOOL)
- add_triple_to_ptree(prog, make_triple(funcall_f2b, "funcall_f2b", new_args, total_args + 2));
- else add_triple_to_ptree(prog, make_triple(funcall_nf, "funcall_nf", new_args, total_args + 2));
- }
- }
- else
- {
- if ((CLM_STRUCT_P(func->arg_types[0])) &&
- (func->arg_types[1] == R_FLOAT) &&
- (fres->type == R_FLOAT))
- add_triple_to_ptree(prog, make_triple(funcall_cf2, "funcall_cf2", new_args, total_args + 2));
- else add_triple_to_ptree(prog, make_triple(funcall_nf, "funcall_nf", new_args, total_args + 2));
- }
- }
- else add_triple_to_ptree(prog, make_triple(funcall_nf, "funcall_nf", new_args, total_args + 2));
- }
-
- free(new_args);
- return(args[0]);
-}
-
-
-/* ---------------- non-local goto via continuation ---------------- */
-
-static xen_value *goto_0(ptree *prog, xen_value **args, xen_value *sf)
-{
- if (args[0]) free(args[0]);
- args[0] = make_xen_value(R_BOOL, add_int_to_ptree(prog, sf->addr), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(jump_indirect, "jump_indirect", 1, args[0]));
- return(args[0]);
-}
-
-
-#define INT_INT_OP(CName) \
-static void CName ## _i(int *args, ptree *pt) {INT_RESULT = CName(INT_ARG_1);} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_INT, CName ## _i, #CName "_i", args, 1));}
-
-
-INT_INT_OP(mus_bytes_per_sample)
-
-
-
-static xen_value *vct_length_1(ptree *prog, xen_value **args, int num_args);
-static xen_value *mus_length_0(ptree *prog, xen_value **args, int num_args);
-static xen_value *sound_data_length_1(ptree *prog, xen_value **args, int num_args);
-
-#if USE_SND
-static void sound_length_0(int *args, ptree *pt) {INT_RESULT = CURRENT_SAMPLES(ss->sounds[SOUND_ARG_1]->chans[0]);}
-static xen_value *sound_length_1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_INT, sound_length_0, "length", args, 1));}
-
-static void mix_length_0(int *args, ptree *pt) {INT_RESULT = mix_length_from_id(MIX_ARG_1);}
-static xen_value *mix_length_1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_INT, mix_length_0, "length", args, 1));}
-
-static void region_length_0(int *args, ptree *pt) {INT_RESULT = region_len(REGION_ARG_1);}
-static xen_value *region_length_1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_INT, region_length_0, "length", args, 1));}
-#endif
-
-
-
-#if USE_SND
-/* ---------------- simple snd ops ---------------- */
-
-#define BOOL_INT_OP(CName) \
-static void CName ## _i(int *args, ptree *pt) {BOOL_RESULT = CName(INT_ARG_1);} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_BOOL, CName ## _i, #CName "_i", args, 1));}
-
-
-#define INT_VOID_OP(CName) \
-static void CName ## _i(int *args, ptree *pt) {INT_RESULT = CName();} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_INT, CName ## _i, #CName "_i", args, 0));}
-
-
-/* must copy string here because mus_run_free_ptree will free all temp strings */
-#define STR_VOID_OP(CName) \
-static void CName ## _i(int *args, ptree *pt) {if (STRING_RESULT) free(STRING_RESULT); STRING_RESULT = mus_strdup(CName());} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_STRING, CName ## _i, #CName "_i", args, 0));}
-
-
-bool r_sound_p(int i);
-BOOL_INT_OP(r_sound_p);
-INT_VOID_OP(selection_chans);
-static char *r_temp_dir(void) {return(temp_dir(ss));}
-static char *r_save_dir(void) {return(save_dir(ss));}
-STR_VOID_OP(r_temp_dir);
-STR_VOID_OP(r_save_dir);
-
-
-
-/* ---------------- snd utils ---------------- */
-
-static snd_info *run_get_sp(int offset, int *args, Int *ints)
-{
- int spint;
- spint = ints[args[offset]];
- if (spint == -1)
- return(any_selected_sound());
- else
- if ((spint < ss->max_sounds) &&
- (snd_ok(ss->sounds[spint])))
- return(ss->sounds[spint]);
- fprintf(stderr, "no such sound: %d\n", spint);
- return(NULL);
-}
-
-
-static chan_info *run_get_cp(int offset, int *args, Int *ints)
-{
- snd_info *sp;
- sp = run_get_sp(offset, args, ints);
- if (sp)
- {
- int cpint;
- cpint = ints[args[offset + 1]];
- if (cpint == -1)
- return(any_selected_channel(sp));
- else
- if (cpint < sp->nchans)
- return(sp->chans[cpint]);
- fprintf(stderr, "no such channel: %d\n", cpint);
- }
- return(NULL);
-}
-
-
-static void run_opt_arg(ptree *pt, xen_value **args, int num_args, int i, xen_value **true_args)
-{
- if (num_args < i)
- true_args[i] = make_xen_value(R_INT, add_int_to_ptree(pt, -1), R_CONSTANT);
- else
- {
- if (args[i]->type == R_BOOL)
- pt->ints[args[i]->addr] = -1;
- true_args[i] = args[i];
- }
-}
-
-
-/* ---------------- edit-position ---------------- */
-
-static void edit_position_i(int *args, ptree *pt)
-{
- chan_info *cp;
- cp = run_get_cp(1, args, pt->ints);
- if (cp) INT_RESULT = cp->edit_ctr;
-}
-
-
-static xen_value *edit_position_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[3];
- xen_value *rtn;
- int k;
- run_opt_arg(pt, args, num_args, 1, true_args);
- run_opt_arg(pt, args, num_args, 2, true_args);
- true_args[0] = args[0];
- rtn = package(pt, R_INT, edit_position_i, "edit_position_i", true_args, 2);
- for (k = num_args + 1; k <= 2; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-/* ---------------- cursor ---------------- */
-
-static void cursor_i(int *args, ptree *pt)
-{
- chan_info *cp;
- cp = run_get_cp(1, args, pt->ints);
- if (cp) INT_RESULT = CURSOR(cp);
-}
-
-
-static xen_value *cursor_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[3];
- xen_value *rtn;
- int k;
- run_opt_arg(pt, args, num_args, 1, true_args);
- run_opt_arg(pt, args, num_args, 2, true_args);
- true_args[0] = args[0];
- rtn = package(pt, R_INT, cursor_i, "cursor_i", true_args, 2);
- for (k = num_args + 1; k <= 2; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-/* ---------------- maxamp ---------------- */
-
-static void maxamp_f(int *args, ptree *pt)
-{
- chan_info *cp;
- cp = run_get_cp(1, args, pt->ints);
- if (cp) FLOAT_RESULT = channel_maxamp(cp, INT_ARG_3);
-}
-
-static void region_maxamp_f(int *args, ptree *pt) {FLOAT_RESULT = region_maxamp(REGION_ARG_1);}
-static void mix_maxamp_f(int *args, ptree *pt) {FLOAT_RESULT = mix_maxamp(MIX_ARG_1);}
-static xen_value *vct_peak_1(ptree *prog, xen_value **args, int num_args);
-
-static xen_value *maxamp_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[4];
- xen_value *rtn;
- int k;
-
- if (num_args == 1)
- {
- switch (args[1]->type)
- {
- case R_FLOAT_VECTOR:
- case R_VCT: return(vct_peak_1(pt, args, num_args));
- case R_MIX: return(package(pt, R_FLOAT, mix_maxamp_f, "mix_maxamp", args, 1));
- case R_REGION: return(package(pt, R_FLOAT, region_maxamp_f, "region_maxamp", args, 1));
- }
- }
-
- run_opt_arg(pt, args, num_args, 1, true_args);
- run_opt_arg(pt, args, num_args, 2, true_args);
- run_opt_arg(pt, args, num_args, 3, true_args);
- true_args[0] = args[0];
-
- rtn = package(pt, R_FLOAT, maxamp_f, "maxamp_f", true_args, 3);
-
- for (k = num_args + 1; k <= 3; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-/* ---------------- sample ---------------- */
-
-static void sample_f(int *args, ptree *pt)
-{
- chan_info *cp;
- cp = run_get_cp(2, args, pt->ints);
- if (cp)
- FLOAT_RESULT = chn_sample(INT_ARG_1, cp, (INT_ARG_4 == AT_CURRENT_EDIT_POSITION) ? cp->edit_ctr : INT_ARG_4);
-}
-
-
-static xen_value *sample_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[5];
- xen_value *rtn;
- int k;
- run_opt_arg(pt, args, num_args, 2, true_args);
- run_opt_arg(pt, args, num_args, 3, true_args);
- run_opt_arg(pt, args, num_args, 4, true_args);
- true_args[0] = args[0];
- true_args[1] = args[1];
- rtn = package(pt, R_FLOAT, sample_f, "sample_f", true_args, 4);
- for (k = num_args + 1; k <= 4; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-/* ---------------- samples ---------------- */
-
-static void samples_f(int *args, ptree *pt)
-{
- chan_info *cp;
- cp = run_get_cp(3, args, pt->ints);
- if (cp)
- {
- if (VCT_RESULT) mus_vct_free(VCT_RESULT);
- VCT_RESULT = run_samples_to_vct(INT_ARG_1, INT_ARG_2, cp, (INT_ARG_5 == AT_CURRENT_EDIT_POSITION) ? cp->edit_ctr : INT_ARG_5);
- }
-}
-
-
-static xen_value *samples_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[6];
- xen_value *rtn;
- int k;
-
- args[0] = make_xen_value(R_VCT, add_vct_to_ptree(pt, NULL), R_VARIABLE);
- add_obj_to_gcs(pt, R_VCT, args[0]->addr);
-
- run_opt_arg(pt, args, num_args, 3, true_args);
- run_opt_arg(pt, args, num_args, 4, true_args);
- run_opt_arg(pt, args, num_args, 5, true_args);
- true_args[0] = args[0];
- true_args[1] = args[1];
- true_args[2] = args[2];
-
- rtn = package(pt, R_VCT, samples_f, "samples_f", true_args, 5);
- for (k = num_args + 1; k <= 5; k++) free(true_args[k]);
-
- return(rtn);
-}
-
-
-/* ---------------- srate ---------------- */
-
-static void sound_srate_i(int *args, ptree *pt)
-{
- snd_info *sp;
- sp = run_get_sp(1, args, pt->ints);
- if (sp) INT_RESULT = SND_SRATE(sp);
-}
-
-
-static void file_srate_i(int *args, ptree *pt)
-{
- INT_RESULT = mus_sound_srate(STRING_ARG_1);
-}
-
-
-static void region_srate_i(int *args, ptree *pt)
-{
- INT_RESULT = region_srate(REGION_ARG_1);
-}
-
-
-static xen_value *srate_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[2];
- xen_value *rtn = NULL;
- int k;
-
- run_opt_arg(pt, args, num_args, 1, true_args);
- /* this adds an arg (of -1) if 0 passed, then run_get_sp treats the -1 as "use current sound" */
- true_args[0] = args[0];
-
- switch (true_args[1]->type)
- {
- case R_STRING:
- rtn = package(pt, R_INT, file_srate_i, "file_srate_i", true_args, 1);
- break;
-
- case R_SOUND:
- rtn = package(pt, R_INT, sound_srate_i, "sound_srate_i", true_args, 1);
- break;
-
- case R_REGION:
- rtn = package(pt, R_INT, region_srate_i, "region_srate_i", true_args, 1);
- break;
-
- case R_INT:
- case R_BOOL:
- rtn = package(pt, R_INT, sound_srate_i, "sound_srate_i", true_args, 1);
- break;
-
- default:
- run_warn("unsupported arg type for srate");
- break;
- }
-
- for (k = num_args + 1; k <= 1; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-/* ---------------- channels ---------------- */
-
-static void sound_channels_i(int *args, ptree *pt)
-{
- snd_info *sp;
- sp = run_get_sp(1, args, pt->ints);
- if (sp) INT_RESULT = sp->nchans;
-}
-
-
-static void file_channels_i(int *args, ptree *pt) {INT_RESULT = mus_sound_chans(STRING_ARG_1);}
-static void region_channels_i(int *args, ptree *pt) {INT_RESULT = region_chans(REGION_ARG_1);}
-static void sound_data_channels_i(int *args, ptree *pt) {INT_RESULT = SOUND_DATA_ARG_1->chans;}
-static xen_value *mus_channels_0(ptree *prog, xen_value **args, int num_args);
-
-
-static xen_value *channels_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[2];
- xen_value *rtn = NULL;
- int k;
- run_opt_arg(pt, args, num_args, 1, true_args);
- true_args[0] = args[0];
-
- switch (true_args[1]->type)
- {
-
- case R_STRING:
- rtn = package(pt, R_INT, file_channels_i, "file_channels_i", true_args, 1);
- break;
-
- case R_SOUND:
- rtn = package(pt, R_INT, sound_channels_i, "sound_channels_i", true_args, 1);
- break;
-
- case R_REGION:
- rtn = package(pt, R_INT, region_channels_i, "region_channels_i", true_args, 1);
- break;
-
- case R_INT:
- case R_BOOL:
- rtn = package(pt, R_INT, sound_channels_i, "sound_channels_i", true_args, 1);
- break;
-
- case R_SOUND_DATA:
- rtn = package(pt, R_INT, sound_data_channels_i, "sound_data_channels_i", true_args, 1);
- break;
-
- case R_CLM:
- rtn = mus_channels_0(pt, true_args, 1);
- break;
-
- default:
- if (CLM_STRUCT_P(args[1]->type))
- rtn = mus_channels_0(pt, true_args, 1);
- else rtn = make_xen_value(R_INT, add_int_to_ptree(pt, 1), R_CONSTANT);
- break;
- }
-
- for (k = num_args + 1; k <= 1; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-/* --------------- file-name ---------------- */
-
-static void sound_file_name_s(int *args, ptree *pt)
-{
- snd_info *sp;
- sp = run_get_sp(1, args, pt->ints);
- if (sp)
- {
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(sp->filename);
- }
-}
-
-
-static void string_file_name_s(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_expand_filename(STRING_ARG_1);
-}
-
-
-static void region_file_name_s(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(region_file_name(REGION_ARG_1));
-}
-
-
-static void mix_file_name_s(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(mix_file_name(REGION_ARG_1));
-}
-
-static xen_value *mus_file_name_0(ptree *prog, xen_value **args, int num_args);
-
-static xen_value *file_name_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[2];
- xen_value *rtn = NULL;
- int k;
-
- run_opt_arg(pt, args, num_args, 1, true_args);
- /* this adds an arg (of -1) if 0 passed, then run_get_sp treats the -1 as "use current sound" */
- true_args[0] = args[0];
-
- switch (true_args[1]->type)
- {
- case R_STRING:
- rtn = package(pt, R_STRING, string_file_name_s, "file_name", true_args, 1);
- break;
-
- case R_SOUND:
- rtn = package(pt, R_STRING, sound_file_name_s, "file_name", true_args, 1);
- break;
-
- case R_REGION:
- rtn = package(pt, R_STRING, region_file_name_s, "file_name", true_args, 1);
- break;
-
- case R_MIX:
- rtn = package(pt, R_STRING, mix_file_name_s, "file_name", true_args, 1);
- break;
-
- case R_INT:
- case R_BOOL:
- rtn = package(pt, R_STRING, sound_file_name_s, "file_name", true_args, 1);
- break;
-
- case R_CLM:
- rtn = mus_file_name_0(pt, true_args, 1);
- break;
-
- default:
- if (CLM_STRUCT_P(args[1]->type))
- rtn = mus_file_name_0(pt, true_args, 1);
- else run_warn("unsupported arg type for file-name");
- break;
- }
-
- for (k = num_args + 1; k <= 1; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-
-/* ---------------- c-g? ---------------- */
-
-static void c_g_p(int *args, ptree *pt)
-{
- check_for_event();
- if ((ss->cg_seen) || (ss->stopped_explicitly))
- {
- ss->stopped_explicitly = false;
- ss->cg_seen = false;
- BOOL_RESULT = (Int)true;
- }
- else BOOL_RESULT = (Int)false;
-}
-
-
-static xen_value *c_g_p_1(ptree *pt, xen_value **args, int num_args)
-{
- return(package(pt, R_BOOL, c_g_p, "c_g_p", args, 0));
-}
-
-
-/* ---------------- exit ---------------- */
-
-static void exit_0(int *args, ptree *pt)
-{
- if (snd_exit_cleanly(EXIT_NOT_FORCED))
- snd_exit(1);
-}
-
-static xen_value *exit_1(ptree *pt, xen_value **args, int num_args)
-{
- return(package(pt, R_BOOL, exit_0, "exit_0", args, 0));
-}
-
-
-
-/* ---------------- frames ---------------- */
-
-static void frames_i(int *args, ptree *pt)
-{
- chan_info *cp;
- cp = run_get_cp(1, args, pt->ints);
- if (cp)
- {
- int pos;
- if (INT_ARG_3 == AT_CURRENT_EDIT_POSITION)
- pos = cp->edit_ctr;
- else pos = INT_ARG_3;
- INT_RESULT = cp->edits[pos]->samples;
- }
-}
-
-
-static xen_value *mus_sound_frames_1(ptree *pt, xen_value **args, int num_args);
-
-static xen_value *frames_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[4];
- xen_value *rtn;
- int k;
-
- if (num_args == 1)
- {
- switch (args[1]->type)
- {
- case R_STRING: return(mus_sound_frames_1(pt, args, num_args));
- case R_CLM: return(mus_length_0(pt, args, num_args));
- case R_VCT: return(vct_length_1(pt, args, num_args));
- case R_SOUND_DATA: return(sound_data_length_1(pt, args, num_args));
-
- case R_SOUND: return(sound_length_1(pt, args, num_args)); /* (let ((snd (integer->sound 0))) (run (lambda () (frames snd)))) */
- case R_MIX: return(mix_length_1(pt, args, num_args));
- case R_REGION: return(region_length_1(pt, args, num_args));
- /* else drop into regular frames code */
- }
- }
-
- if (num_args < 3)
- true_args[3] = make_xen_value(R_INT, add_int_to_ptree(pt, AT_CURRENT_EDIT_POSITION), R_CONSTANT);
- else true_args[3] = args[3];
-
- run_opt_arg(pt, args, num_args, 1, true_args);
- run_opt_arg(pt, args, num_args, 2, true_args);
- true_args[0] = args[0];
-
- rtn = package(pt, R_INT, frames_i, "frames_i", true_args, 3);
- for (k = num_args + 1; k <= 3; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-/* ---------------- report-in-minibuffer ---------------- */
-
-static void report_in_minibuffer_s(int *args, ptree *pt)
-{
- snd_info *sp;
- sp = run_get_sp(2, args, pt->ints);
- if (sp)
- string_to_minibuffer(sp, STRING_ARG_1);
-}
-
-
-static xen_value *report_in_minibuffer_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[3];
- xen_value *rtn;
- int k;
- run_opt_arg(pt, args, num_args, 2, true_args);
- true_args[1] = args[1];
- true_args[0] = args[0];
- rtn = package(pt, R_BOOL, report_in_minibuffer_s, "report_in_minibuffer_s", true_args, 2);
- for (k = num_args + 1; k <= 2; k++) free(true_args[k]);
- return(rtn);
-}
-
-
-/* ---------------- sampler stuff ---------------- */
-
-static void sampler_f(int *args, ptree *pt) {FLOAT_RESULT = read_sample(SAMPLER_ARG_1);}
-
-
-static xen_value *sampler_0(ptree *prog, xen_value **args, xen_value *sf)
-{
- if (args[0]) free(args[0]);
- args[0] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(sampler_f, "sampler_f", 2, args[0], sf));
- return(args[0]);
-}
-
-static xen_value *sampler_1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_FLOAT, sampler_f, "sampler_f", args, 1));}
-
-
-static void next_sampler_f(int *args, ptree *pt) {FLOAT_RESULT = protected_next_sample(SAMPLER_ARG_1);}
-
-static xen_value *next_sample_1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_FLOAT, next_sampler_f, "next_sampler_f", args, 1));}
-
-
-static void previous_sampler_f(int *args, ptree *pt) {FLOAT_RESULT = protected_previous_sample(SAMPLER_ARG_1);}
-
-static xen_value *previous_sample_1(ptree *prog, xen_value **args, int num_args) {return(package(prog, R_FLOAT, previous_sampler_f, "previous_sampler_f", args, 1));}
-
-
-static void sampler_at_end_b_s(int *args, ptree *pt) {BOOL_RESULT = SAMPLER_ARG_1->at_eof;}
-
-static xen_value *sampler_at_end_p_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_SAMPLER)
- return(package(prog, R_BOOL, sampler_at_end_b_s, "sampler_at_end_b_s", args, 1));
- return(NULL);
-}
-
-
-static void make_sampler_r(int *args, ptree *pt)
-{
- chan_info *cp = NULL;
- cp = run_get_cp(2, args, pt->ints);
- if (cp)
- {
- int pos;
- read_direction_t direction = READ_FORWARD;
- if (INT_ARG_5 == -1)
- pos = cp->edit_ctr;
- else pos = INT_ARG_5;
- free_snd_fd(SAMPLER_RESULT);
- if (INT_ARG_4 == -1) direction = READ_BACKWARD;
- SAMPLER_RESULT = init_sample_read_any(INT_ARG_1, cp, direction, pos);
- }
-}
-
-static xen_value *make_sampler_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[6];
- int k;
- xen_value *rtn;
- bool free_true_args_1 = false;
-
- if (num_args < 5)
- true_args[5] = make_xen_value(R_INT, add_int_to_ptree(pt, AT_CURRENT_EDIT_POSITION), R_CONSTANT);
- else true_args[5] = args[5];
- if (num_args < 4)
- true_args[4] = make_xen_value(R_INT, add_int_to_ptree(pt, 1), R_CONSTANT);
- else true_args[4] = args[4];
- run_opt_arg(pt, args, num_args, 2, true_args);
- run_opt_arg(pt, args, num_args, 3, true_args);
- if (num_args == 0)
- true_args[1] = make_xen_value(R_INT, add_int_to_ptree(pt, 0), R_CONSTANT);
- else
- {
- if (args[1]->type == R_FLOAT)
- {
- free_true_args_1 = true;
- true_args[1] = convert_dbl_to_int(pt, args[1], true);
- }
- else true_args[1] = args[1];
- }
- true_args[0] = args[0];
- rtn = package(pt, R_SAMPLER, make_sampler_r, "make_sampler_r", true_args, 5);
- add_obj_to_gcs(pt, R_SAMPLER, rtn->addr);
- for (k = num_args + 1; k <= 5; k++) free(true_args[k]);
- if (free_true_args_1) free(true_args[1]);
- return(rtn);
-}
-#endif
-/* end USE_SND */
-
-
-
-/* ---------------- autocorrelate ---------------- */
-
-static void autocorrelate_0(int *args, ptree *pt)
-{
- mus_autocorrelate(VCT_ARG_1->data, VCT_ARG_1->length);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static xen_value *autocorrelate_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_VCT, autocorrelate_0, "autocorrelate_0", args, 1));
-}
-
-
-
-/* ---------------- correlate ---------------- */
-
-static void correlate_0(int *args, ptree *pt)
-{
- mus_long_t size;
- if (VCT_ARG_1->length < VCT_ARG_2->length)
- size = VCT_ARG_1->length;
- else size = VCT_ARG_2->length;
- mus_correlate(VCT_ARG_1->data, VCT_ARG_2->data, size);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static xen_value *correlate_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_VCT, correlate_0, "correlate_0", args, 2));
-}
-
-
-
-/* ---------------- mus-audio stuff ---------------- */
-
-INT_INT_OP(mus_audio_close)
-
-
-static char *audio_write_obuf = NULL;
-static int audio_write_obuf_size = 0;
-int mus_audio_io_format(int line);
-
-static void mus_audio_write_0(int *args, ptree *pt)
-{
- #define audio_io_write_format(Line) (mus_audio_io_format(Line) >> 16)
-
- sound_data *sd;
- int outbytes, frms, fmt, fd;
-
- sd = SOUND_DATA_ARG_2;
- frms = INT_ARG_3;
- fd = INT_ARG_1;
-
- fmt = audio_io_write_format(fd);
- outbytes = frms * sd->chans * mus_bytes_per_sample(fmt);
-
- if (outbytes > audio_write_obuf_size)
- {
- if (audio_write_obuf) free(audio_write_obuf);
- audio_write_obuf_size = outbytes;
- audio_write_obuf = (char *)calloc(outbytes, sizeof(char));
- }
-
-#if SNDLIB_USE_FLOATS
- mus_file_write_buffer(fmt, 0, frms - 1, sd->chans, sd->data, audio_write_obuf, true); /* true -> clipped */
-#else
- {
- mus_sample_t **sdata;
- int i;
- mus_long_t j;
- sdata = (mus_sample_t **)calloc(sd->chans, sizeof(mus_sample_t *));
- for (i = 0; i < sd->chans; i++)
- sdata[i] = (mus_sample_t *)calloc(sd->length, sizeof(mus_sample_t));
- for (i = 0; i < sd->chans; i++)
- for (j = 0; j < sd->length; j++)
- sdata[i][j] = MUS_DOUBLE_TO_SAMPLE(sd->data[i][j]);
- mus_file_write_buffer(fmt, 0, frms - 1, sd->chans, sdata, audio_write_obuf, true);
- for (i = 0; i < sd->chans; i++)
- free(sdata[i]);
- free(sdata);
- }
-#endif
- INT_RESULT = mus_audio_write(fd, audio_write_obuf, outbytes);
-
-}
-
-
-static xen_value *mus_audio_write_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_INT, mus_audio_write_0, "mus_audio_write_0", args, 3));
-}
-
-
-
-
-/* ---------------- list ---------------- */
-
-static void float_list_ref(int *args, ptree *pt) {FLOAT_RESULT = pt->dbls[LIST_ARG_1->vals[INT_ARG_2]->addr];}
-
-
-static void float_list_ref_0(int *args, ptree *pt) {FLOAT_RESULT = pt->dbls[LIST_ARG_1->vals[0]->addr];}
-static void float_list_ref_1(int *args, ptree *pt) {FLOAT_RESULT = pt->dbls[LIST_ARG_1->vals[1]->addr];}
-static void float_list_ref_2(int *args, ptree *pt) {FLOAT_RESULT = pt->dbls[LIST_ARG_1->vals[2]->addr];}
-static void float_list_ref_3(int *args, ptree *pt) {FLOAT_RESULT = pt->dbls[LIST_ARG_1->vals[3]->addr];}
-static void float_list_ref_4(int *args, ptree *pt) {FLOAT_RESULT = pt->dbls[LIST_ARG_1->vals[4]->addr];}
-
-
-static void int_list_ref(int *args, ptree *pt) {INT_RESULT = pt->ints[LIST_ARG_1->vals[INT_ARG_2]->addr];}
-
-
-static void list_ref(int *args, ptree *pt)
-{
- xen_value *v;
- int addr;
-
- v = LIST_ARG_1->vals[INT_ARG_2];
- addr = v->addr;
-
- switch (v->type)
- {
- case R_INT:
- INT_RESULT = pt->ints[addr];
- break;
-
- case R_BOOL:
- BOOL_RESULT = pt->ints[addr];
- break;
-
- case R_CHAR:
- CHAR_RESULT = (char)(pt->ints[addr]);
- break;
-
- case R_FLOAT:
- FLOAT_RESULT = pt->dbls[addr];
- break;
-
- case R_STRING:
- if (STRING_RESULT) free(STRING_RESULT);
- /* (let ((val (list "l1" "l2" "l3"))) (run (lambda () (let ((str (list-ref val 1))) (do ((i 0 (1+ i))) ((= i 2)) (set! str (list-ref val i))))))) */
- STRING_RESULT = mus_strdup(pt->strs[addr]);
- break;
-
- case R_FLOAT_VECTOR:
- case R_VCT:
- VCT_RESULT = pt->vcts[addr];
- break;
-
- case R_SOUND_DATA:
- SOUND_DATA_RESULT = pt->sds[addr];
- break;
-
- case R_CLM:
- CLM_RESULT = pt->clms[addr];
- break;
-
- case R_LIST_VECTOR:
- case R_CLM_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- VECT_RESULT = pt->vects[addr];
- break;
-
- case R_SYMBOL:
- case R_KEYWORD:
- SCHEME_RESULT = pt->xens[addr];
- break;
-
- case R_FUNCTION:
- FNC_RESULT = ((ptree **)(pt->fncs))[addr];
- break;
-
-#if USE_SND
- case R_SAMPLER:
- SAMPLER_RESULT = pt->samplers[addr];
- break;
-#endif
- }
-}
-
-
-static char *def_clm_struct_field_name(int def_clm_struct_type, int field);
-
-static xen_value *package_clm_struct(ptree *prog, int struct_type, xen_value **args, int num_args)
-{
- int type;
- char *name;
- type = def_clm_struct_field_type(struct_type, prog->ints[args[2]->addr]);
- name = def_clm_struct_field_name(struct_type, prog->ints[args[2]->addr]);
- if (type == R_FLOAT)
- {
- switch (prog->ints[args[2]->addr])
- {
- case 0: return(package(prog, type, float_list_ref_0, name, args, num_args));
- case 1: return(package(prog, type, float_list_ref_1, name, args, num_args));
- case 2: return(package(prog, type, float_list_ref_2, name, args, num_args));
- case 3: return(package(prog, type, float_list_ref_3, name, args, num_args));
- case 4: return(package(prog, type, float_list_ref_4, name, args, num_args));
- default: return(package(prog, type, float_list_ref, name, args, num_args));
- }
- }
- if (type == R_INT)
- return(package(prog, type, int_list_ref, name, args, num_args));
- return(package(prog, type, list_ref, name, args, num_args));
-}
-
-
-static xen_value *list_ref_1(ptree *prog, xen_value **args, int num_args)
-{
- list *xl;
- /* these are list constants, we know in advance what all element types are */
-
- if (CLM_STRUCT_P(args[1]->type))
- return(package_clm_struct(prog, args[1]->type, args, num_args));
-
- xl = prog->lists[args[1]->addr];
- if (xl)
- {
- if (CLM_STRUCT_P(xl->type))
- return(package_clm_struct(prog, xl->type, args, num_args));
-
- if (xl->type == R_FLOAT)
- return(package(prog, xl->type, float_list_ref, "float_list_ref", args, 2));
- if (xl->type == R_INT)
- return(package(prog, xl->type, int_list_ref, "int_list_ref", args, 2));
-
- return(package(prog, xl->type, list_ref, "list_ref", args, 2));
- }
-
- return(package(prog, R_FLOAT, float_list_ref, "float_list_ref", args, 2));
-}
-
-
-static xen_value *cxr_1(ptree *prog, xen_value **args, int num_args, int loc)
-{
- xen_value *true_args[3];
- xen_value *rtn;
- true_args[0] = args[0];
- true_args[1] = args[1];
- true_args[2] = make_xen_value(R_INT, add_int_to_ptree(prog, loc), R_CONSTANT);
- rtn = list_ref_1(prog, true_args, 2);
- free(true_args[2]);
- return(rtn);
-}
-
-static xen_value *car_1(ptree *prog, xen_value **args, int num_args) {return(cxr_1(prog, args, num_args, 0));}
-
-static xen_value *cadr_1(ptree *prog, xen_value **args, int num_args) {return(cxr_1(prog, args, num_args, 1));}
-
-static xen_value *caddr_1(ptree *prog, xen_value **args, int num_args) {return(cxr_1(prog, args, num_args, 2));}
-
-static xen_value *cadddr_1(ptree *prog, xen_value **args, int num_args) {return(cxr_1(prog, args, num_args, 3));}
-
-
-static void float_list_set(int *args, ptree *pt) {pt->dbls[LIST_ARG_1->vals[INT_ARG_2]->addr] = FLOAT_ARG_3;}
-
-
-static void float_list_set_0(int *args, ptree *pt) {pt->dbls[LIST_ARG_1->vals[0]->addr] = FLOAT_ARG_3;}
-static void float_list_set_1(int *args, ptree *pt) {pt->dbls[LIST_ARG_1->vals[1]->addr] = FLOAT_ARG_3;}
-static void float_list_set_2(int *args, ptree *pt) {pt->dbls[LIST_ARG_1->vals[2]->addr] = FLOAT_ARG_3;}
-static void float_list_set_3(int *args, ptree *pt) {pt->dbls[LIST_ARG_1->vals[3]->addr] = FLOAT_ARG_3;}
-static void float_list_set_4(int *args, ptree *pt) {pt->dbls[LIST_ARG_1->vals[4]->addr] = FLOAT_ARG_3;}
-
-
-static void int_list_set(int *args, ptree *pt) {pt->ints[LIST_ARG_1->vals[INT_ARG_2]->addr] = INT_ARG_3;}
-
-
-static void list_set(int *args, ptree *pt)
-{
- xen_value *v;
- int addr;
-
- v = LIST_ARG_1->vals[INT_ARG_2];
- addr = v->addr;
-
- /* fprintf(stderr,"list set %s (%d %f)\n", describe_xen_value(v, pt), (int)(INT_ARG_2), FLOAT_ARG_3); */
-
- switch (v->type)
- {
- case R_INT: pt->ints[addr] = INT_ARG_3; break;
- case R_BOOL: pt->ints[addr] = BOOL_ARG_3; break;
- case R_CHAR: pt->ints[addr] = (Int)(CHAR_ARG_3); break;
- case R_FLOAT: pt->dbls[addr] = FLOAT_ARG_3; break;
- case R_CLM: pt->clms[addr] = CLM_ARG_3; break;
- case R_STRING: pt->strs[addr] = mus_strdup(STRING_ARG_3); break;
- case R_KEYWORD:
- case R_SYMBOL: pt->xens[addr] = SCHEME_ARG_3; break;
- case R_FLOAT_VECTOR:
- case R_VCT: pt->vcts[addr] = VCT_ARG_3; break;
- case R_SOUND_DATA: pt->sds[addr] = SOUND_DATA_ARG_3; break;
-#if USE_SND
- case R_SAMPLER: pt->samplers[addr] = SAMPLER_ARG_3; break;
-#endif
- case R_LIST: pt->lists[addr] = LIST_ARG_3; break;
- case R_LIST_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- case R_CLM_VECTOR: pt->vects[addr] = VECT_ARG_3; break;
- }
-}
-
-
-static xen_value *package_clm_struct_set(ptree *prog, int struct_type, xen_value **args, int num_args)
-{
- int type;
- char *name;
- type = def_clm_struct_field_type(struct_type, prog->ints[args[2]->addr]);
- name = def_clm_struct_field_name(struct_type, prog->ints[args[2]->addr]);
- if (type == R_FLOAT)
- {
- switch (prog->ints[args[2]->addr])
- {
- case 0: return(package(prog, type, float_list_set_0, name, args, num_args));
- case 1: return(package(prog, type, float_list_set_1, name, args, num_args));
- case 2: return(package(prog, type, float_list_set_2, name, args, num_args));
- case 3: return(package(prog, type, float_list_set_3, name, args, num_args));
- case 4: return(package(prog, type, float_list_set_4, name, args, num_args));
- default: return(package(prog, type, float_list_set, name, args, num_args));
- }
- }
- if (type == R_INT)
- return(package(prog, type, int_list_set, name, args, num_args));
- return(package(prog, type, list_set, name, args, num_args));
-}
-
-
-static xen_value *list_set_1(ptree *prog, xen_value **args, int num_args)
-{
- list *xl;
- xen_var *var;
- var = find_var_in_ptree_via_addr(prog, args[1]->type, args[1]->addr);
- if (var)
- var->unclean = true;
-
- if (CLM_STRUCT_P(args[1]->type))
- return(package_clm_struct_set(prog, args[1]->type, args, num_args));
-
- xl = prog->lists[args[1]->addr];
- if (xl)
- {
- if (CLM_STRUCT_P(xl->type)) /* INT_ARG_2 is a constant in this case */
- return(package_clm_struct_set(prog, xl->type, args, num_args));
-
- if (xl->type == R_FLOAT)
- return(package(prog, xl->type, float_list_set, "float_list_set", args, num_args));
- if (xl->type == R_INT)
- return(package(prog, xl->type, int_list_set, "int_list_set", args, num_args));
- return(package(prog, xl->type, list_set, "list_set", args, num_args));
- }
-
- /* else assume float */
- return(package(prog, R_FLOAT, float_list_set, "float_list_set", args, num_args));
-}
-
-
-static xen_value *set_car_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *true_args[4];
- xen_value *rtn;
- true_args[0] = args[0];
- true_args[1] = args[1];
- true_args[2] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT);
- true_args[3] = args[2];
- rtn = list_set_1(prog, true_args, 3);
- free(true_args[2]);
- return(rtn);
-}
-
-
-/* ---------------------------------------- length ---------------------------------------- */
-
-static void length_0(int *args, ptree *pt)
-{
- INT_RESULT = LIST_ARG_1->len;
-}
-
-static xen_value *vector_length_1(ptree *prog, xen_value **args, int num_args);
-
-static xen_value *length_1(ptree *prog, xen_value **args, int num_args)
-{
- switch (args[1]->type)
- {
- case R_LIST: return(package(prog, R_INT, length_0, "length", args, 1));
- case R_VCT: return(vct_length_1(prog, args, num_args));
- case R_STRING: return(string_length_1(prog, args, num_args));
- case R_CLM: return(mus_length_0(prog, args, num_args));
- case R_SOUND_DATA: return(sound_data_length_1(prog, args, num_args));
-
- case R_FLOAT_VECTOR:
- case R_LIST_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- case R_CLM_VECTOR:
- return(vector_length_1(prog, args, num_args));
-
-#if USE_SND
- case R_SOUND: return(sound_length_1(prog, args, num_args)); /* (let ((snd (integer->sound 0))) (run (lambda () (length snd)))) */
- case R_MIX: return(mix_length_1(prog, args, num_args));
- case R_REGION: return(region_length_1(prog, args, num_args));
- /* not R_SAMPLER because it has no clear length (read dir can change etc) */
-#endif
- }
- return(run_warn("unsupported arg type for length"));
-}
-
-
-/* TODO fill and copy
- static xen_value *string_fill_1(ptree *pt, xen_value **args, int num_args)
- static xen_value *vct_fill_1(ptree *pt, xen_value **args, int num_args)
- static xen_value *vector_fill_1(ptree *prog, xen_value **args, int num_args)
- but no list_fill and clm cases are handled specially
-
- string_copy_1 vct_copy_v sound_data_copy_f perhaps xen_value_to_xen?
-*/
-
-
-/* -------------------------------------------------------------------------------- */
-
-static void null_0(int *args, ptree *pt)
-{
- BOOL_RESULT = ((!(LIST_ARG_1)) || (LIST_ARG_1->len == 0));
-}
-
-
-static xen_value *null_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, null_0, "null?", args, 1));
-}
-
-
-static void clm_struct_field_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- /* in_v = args[1], new_v has int_arg[2] for addr, v is new_val */
- xen_value *args[4];
- xen_value *rtn;
- args[0] = NULL;
- args[1] = in_v;
- args[2] = make_xen_value(R_INT, add_int_to_ptree(prog, in_v2->addr), R_CONSTANT);
- args[3] = v;
- rtn = list_set_1(prog, args, 3);
- free(rtn);
- free(args[2]);
-}
-
-
-
-/* ---------------- vector stuff ---------------- */
-
-/* float vectors are handled as vcts
- */
-
-/* length */
-
-static void vector_length_f(int *args, ptree *pt) {INT_RESULT = (VCT_ARG_1) ? VCT_ARG_1->length : 0;}
-
-static void vector_length_i(int *args, ptree *pt) {INT_RESULT = (VECT_ARG_1) ? VECT_ARG_1->length : 0;}
-
-
-static xen_value *vector_length_1(ptree *prog, xen_value **args, int num_args)
-{
- switch (args[1]->type)
- {
- case R_FLOAT_VECTOR:
- return(package(prog, R_INT, vector_length_f, "vector_length_f", args, 1));
- break;
-
- case R_LIST_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- case R_CLM_VECTOR:
- return(package(prog, R_INT, vector_length_i, "vector_length", args, 1));
- break;
- }
- return(NULL);
-}
-
-
-/* ref */
-
-static void vector_ref_f(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[INT_ARG_2];}
-static void vector_ref_f0(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[0];}
-static void vector_ref_f1(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[1];}
-static void vector_ref_f2(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[2];}
-
-static void vector_ref_i(int *args, ptree *pt) {INT_RESULT = VECT_ARG_1->data.ints[INT_ARG_2];}
-
-static void vector_ref_v(int *args, ptree *pt) {VCT_RESULT = VECT_ARG_1->data.vcts[INT_ARG_2];}
-
-static void vector_ref_c(int *args, ptree *pt) {CLM_RESULT = VECT_ARG_1->data.gens[INT_ARG_2];}
-
-static void vector_ref_l(int *args, ptree *pt) {LIST_RESULT = VECT_ARG_1->data.lists[INT_ARG_2];}
-
-static void vector_add_i2(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[INT_ARG_2 + INT_ARG_3];}
-static void vector_subtract_i2(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[INT_ARG_3 - INT_ARG_2];}
-
-static xen_value *vector_ref_1(ptree *prog, xen_value **args, int num_args)
-{
- switch (args[1]->type)
- {
- case R_FLOAT_VECTOR:
- if (args[2]->constant == R_CONSTANT)
- {
- if (prog->ints[args[2]->addr] == 0)
- return(package(prog, R_FLOAT, vector_ref_f0, "vector_ref_f0", args, 2));
- if (prog->ints[args[2]->addr] == 1)
- return(package(prog, R_FLOAT, vector_ref_f1, "vector_ref_f1", args, 2));
- if (prog->ints[args[2]->addr] == 2)
- return(package(prog, R_FLOAT, vector_ref_f2, "vector_ref_f2", args, 2));
- }
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->args[0] == args[2]->addr) &&
- ((prev_op->function == add_i2) || (prev_op->function == subtract_i2)) &&
- ((find_var_in_ptree_via_addr(prog, R_INT, prev_op->args[0])) == NULL))
- {
- xen_value *new0;
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->args[3] = prev_op->args[1];
- prev_op->types[3] = prev_op->types[1];
- prev_op->args[1] = args[1]->addr;
- prev_op->types[1] = R_FLOAT_VECTOR;
- prev_op->num_args = 4;
- prev_op->args[0] = new0->addr;
- prev_op->types[0] = R_FLOAT;
- if (prev_op->function == add_i2)
- {
- prev_op->function = vector_add_i2;
- prev_op->op_name = "vector_add_i2";
- }
- else
- {
- prev_op->function = vector_subtract_i2;
- prev_op->op_name = "vector_subtract_i2";
- }
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(new0);
- }
- }
- return(package(prog, R_FLOAT, vector_ref_f, "vector_ref_f", args, 2));
- break;
-
- case R_INT_VECTOR: return(package(prog, R_INT, vector_ref_i, "vector_ref_i", args, 2)); break;
- case R_VCT_VECTOR: return(package(prog, R_VCT, vector_ref_v, "vector_ref_v", args, 2)); break;
- case R_CLM_VECTOR: return(package(prog, R_CLM, vector_ref_c, "vector_ref_c", args, 2)); break;
- case R_LIST_VECTOR:
- {
- vect *v;
- v = prog->vects[args[1]->addr]; /* has to exist, I think */
- /* vector of lists other than generators will not work because the element type isn't passed with the list */
- /* also currently I think the changes to gen fields are not reflected externally */
- return(package(prog, (CLM_STRUCT_P(v->data.lists[0]->type)) ? v->data.lists[0]->type : R_LIST, vector_ref_l, "vector_ref_l", args, 2));
- }
- break;
- }
- return(NULL);
-}
-
-
-/* set */
-
-static void vector_set_f(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] = FLOAT_ARG_3;}
-static void vector_set_f0(int *args, ptree *pt) {VCT_ARG_1->data[0] = FLOAT_ARG_3;}
-static void vector_set_f1(int *args, ptree *pt) {VCT_ARG_1->data[1] = FLOAT_ARG_3;}
-static void vector_set_f2(int *args, ptree *pt) {VCT_ARG_1->data[2] = FLOAT_ARG_3;}
-
-static void vector_set_i(int *args, ptree *pt) {VECT_ARG_1->data.ints[INT_ARG_2] = INT_ARG_3;}
-
-static void vector_set_v(int *args, ptree *pt) {VECT_ARG_1->data.vcts[INT_ARG_2] = VCT_ARG_3;}
-
-static void vector_set_c(int *args, ptree *pt) {VECT_ARG_1->data.gens[INT_ARG_2] = CLM_ARG_3;}
-
-static void int_vector_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- xen_var *var;
- var = find_var_in_ptree_via_addr(prog, in_v->type, in_v->addr);
- if (var) var->unclean = true;
- add_triple_to_ptree(prog, va_make_triple(vector_set_i, "vector_set_i", 4, NULL, in_v, in_v1, v));
-}
-
-static xen_value *vector_set_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_var *var;
- var = find_var_in_ptree_via_addr(prog, args[1]->type, args[1]->addr);
- if (var) var->unclean = true;
- switch (args[1]->type)
- {
- case R_FLOAT_VECTOR:
- if (args[3]->type != R_FLOAT) return(run_warn("wrong new val type for float vector set"));
- if (args[2]->constant == R_CONSTANT)
- {
- if (prog->ints[args[2]->addr] == 0)
- return(package(prog, R_FLOAT, vector_set_f0, "vector_set_f0", args, 3));
- if (prog->ints[args[2]->addr] == 1)
- return(package(prog, R_FLOAT, vector_set_f1, "vector_set_f1", args, 3));
- if (prog->ints[args[2]->addr] == 2)
- return(package(prog, R_FLOAT, vector_set_f2, "vector_set_f2", args, 3));
- }
-
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (((prev_op->function == vct_ref_f_add) || (prev_op->function == vct_ref_f_mult)) &&
- (prev_op->args[1] == args[1]->addr) &&
- (prev_op->args[2] == args[2]->addr) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- /* (let ((v (vct 1 2 3)) (i 2)) (run (vct-set! v i (+ (vct-ref v i) 3.0)))) */
- if (prev_op->function == vct_ref_f_add)
- {
- prev_op->function = vct_set_f_add;
- prev_op->op_name = "vct_set_f_add";
- }
- else
- {
- prev_op->function = vct_set_f_mult;
- prev_op->op_name = "vct_set_f_mult";
- }
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- }
-
- return(package(prog, R_FLOAT, vector_set_f, "vector_set_f", args, 3));
- break;
-
- case R_INT_VECTOR:
- if (args[3]->type != R_INT) return(run_warn("wrong new val type for int vector set"));
- return(package(prog, R_INT, vector_set_i, "vector_set_i", args, 3));
- break;
-
- case R_VCT_VECTOR:
- if (args[3]->type != R_VCT) return(run_warn("wrong new val type for vct vector set"));
- return(package(prog, R_VCT, vector_set_v, "vector_set_v", args, 3));
- break;
-
- case R_CLM_VECTOR:
- if (args[3]->type != R_CLM) return(run_warn("wrong new val type for clm vector set"));
- return(package(prog, R_CLM, vector_set_c, "vector_set_c", args, 3));
- break;
- }
- return(NULL);
-}
-
-
-/* fill */
-
-static void vector_fill_f(int *args, ptree *pt)
-{
- int i; for (i = 0; i < VCT_ARG_1->length; i++) VCT_ARG_1->data[i] = FLOAT_ARG_2;
-}
-
-static void vector_fill_i(int *args, ptree *pt)
-{
- int i; for (i = 0; i < VECT_ARG_1->length; i++) VECT_ARG_1->data.ints[i] = INT_ARG_2;
-}
-
-static void vector_fill_v(int *args, ptree *pt)
-{
- int i; for (i = 0; i < VECT_ARG_1->length; i++) VECT_ARG_1->data.vcts[i] = VCT_ARG_2;
-}
-
-
-static void vector_fill_c(int *args, ptree *pt)
-{
- int i; for (i = 0; i < VECT_ARG_1->length; i++) VECT_ARG_1->data.gens[i] = CLM_ARG_2;
-}
-
-
-static xen_value *vector_fill_1(ptree *prog, xen_value **args, int num_args)
-{
- switch (args[1]->type)
- {
- case R_FLOAT_VECTOR:
- if (args[2]->type != R_FLOAT) return(run_warn("wrong new val type for float vector fill"));
- return(package(prog, R_BOOL, vector_fill_f, "vector_fill_f", args, 2));
- break;
-
- case R_INT_VECTOR:
- if (args[2]->type != R_INT) return(run_warn("wrong new val type for int vector fill"));
- return(package(prog, R_BOOL, vector_fill_i, "vector_fill_i", args, 2));
- break;
-
- case R_VCT_VECTOR:
- if (args[2]->type != R_VCT) return(run_warn("wrong new val type for vct vector fill"));
- return(package(prog, R_BOOL, vector_fill_v, "vector_fill_v", args, 2));
- break;
-
- case R_CLM_VECTOR:
- if (args[2]->type != R_CLM) return(run_warn("wrong new val type for clm vector fill"));
- return(package(prog, R_BOOL, vector_fill_c, "vector_fill_c", args, 2));
- break;
- }
- return(NULL);
-}
-
-
-
-/* ---------------- vct stuff ---------------- */
-
-static void vct_length_i(int *args, ptree *pt) {INT_RESULT = VCT_ARG_1->length;}
-
-
-static xen_value *vct_length_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_INT, vct_length_i, "vct_length_i", args, 1));
-}
-
-
-static void vct_constant_ref_0(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[0];}
-static void vct_constant_ref_0_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * VCT_ARG_1->data[0];}
-static void vct_constant_ref_1(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[1];}
-static void vct_constant_ref_2(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[2];}
-static void vct_constant_ref_3(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[3];}
-
-
-static void vct_ref_f(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[INT_ARG_2];}
-static void vct_ref_f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * VCT_ARG_1->data[INT_ARG_2];}
-static void vct_ref_f_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 + VCT_ARG_1->data[INT_ARG_2];}
-
-static void vct_add_i2(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[INT_ARG_2 + INT_ARG_3];}
-static void vct_subtract_i2(int *args, ptree *pt) {FLOAT_RESULT = VCT_ARG_1->data[INT_ARG_3 - INT_ARG_2];}
-
-static xen_value *vct_ref_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[2]->constant == R_CONSTANT)
- {
- if (prog->ints[args[2]->addr] == 0)
- return(package(prog, R_FLOAT, vct_constant_ref_0, "vct_constant_ref_0", args, 1));
- if (prog->ints[args[2]->addr] == 1)
- return(package(prog, R_FLOAT, vct_constant_ref_1, "vct_constant_ref_1", args, 1));
- if (prog->ints[args[2]->addr] == 2)
- return(package(prog, R_FLOAT, vct_constant_ref_2, "vct_constant_ref_2", args, 1));
- if (prog->ints[args[2]->addr] == 3)
- return(package(prog, R_FLOAT, vct_constant_ref_3, "vct_constant_ref_3", args, 1));
- }
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->args[0] == args[2]->addr) &&
- ((prev_op->function == add_i2) || (prev_op->function == subtract_i2)) &&
- ((find_var_in_ptree_via_addr(prog, R_INT, prev_op->args[0])) == NULL))
- {
- xen_value *new0;
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->args[3] = prev_op->args[1];
- prev_op->types[3] = prev_op->types[1];
- prev_op->args[1] = args[1]->addr;
- prev_op->types[1] = R_VCT;
- prev_op->args[0] = new0->addr;
- prev_op->types[0] = R_FLOAT;
- prev_op->num_args = 4;
- if (prev_op->function == add_i2)
- {
- prev_op->function = vct_add_i2;
- prev_op->op_name = "vct_add_i2";
- }
- else
- {
- prev_op->function = vct_subtract_i2;
- prev_op->op_name = "vct_subtract_i2";
- }
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(new0);
- }
- }
- return(package(prog, R_FLOAT, vct_ref_f, "vct_ref_f", args, 2));
-}
-
-
-static void vct_nf(int *args, ptree *pt) {if (VCT_ARG_1) FLOAT_RESULT = VCT_ARG_1->data[INT_ARG_2];}
-
-static xen_value *vct_n(ptree *prog, xen_value **args, int num_args, xen_value *sf)
-{
- /* this is handling the vct-as-applicable-func stuff (v ind) = (vct-ref v ind) */
- /* (let ((v (make-vct 3 1.0))) (run (lambda () (v 0))))
- * (run ((make-vct 3 1.0) 1))
- */
-
- if (args[0]) free(args[0]);
- if (args[1]->type != R_INT)
- return(run_warn("vct index should be an integer"));
-
- args[0] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(vct_nf, "vct_nf", 3, args[0], sf, args[1]));
- return(args[0]);
-}
-
-
-static void vct_constant_set_0(int *args, ptree *pt) {VCT_ARG_1->data[0] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-static void vct_constant_set_1(int *args, ptree *pt) {VCT_ARG_1->data[1] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-static void vct_constant_set_2(int *args, ptree *pt) {VCT_ARG_1->data[2] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-static void vct_constant_set_3(int *args, ptree *pt) {VCT_ARG_1->data[3] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-
-static void vct_set_f(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] = FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-static void vct_set_f_add(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] += FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-static void vct_set_f_mult(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] *= FLOAT_ARG_3; /* FLOAT_RESULT = FLOAT_ARG_3; */}
-
-static void vct_set_i(int *args, ptree *pt) {VCT_ARG_1->data[INT_ARG_2] = (mus_float_t)INT_ARG_3; /* FLOAT_RESULT = (Double)INT_ARG_3; */}
-
-
-static void vct_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- /* set! vct-ref */
- xen_var *var;
- xen_value *arg0 = NULL;
- arg0 = add_temporary_var_to_ptree(prog, R_FLOAT);
-
- var = find_var_in_ptree_via_addr(prog, in_v->type, in_v->addr);
- if (var) var->unclean = true;
-
- if (v->type == R_INT)
- {
- add_triple_to_ptree(prog, va_make_triple(vct_set_i, "vct_set_i(2)", 4, arg0, in_v, in_v1, v));
- return;
- }
-
- if (in_v1->constant == R_CONSTANT)
- {
- if (prog->ints[in_v1->addr] == 0)
- add_triple_to_ptree(prog, va_make_triple(vct_constant_set_0, "vct_constant_set_0(1)", 4, arg0, in_v, in_v1, v));
- else if (prog->ints[in_v1->addr] == 1)
- add_triple_to_ptree(prog, va_make_triple(vct_constant_set_1, "vct_constant_set_1(1)", 4, arg0, in_v, in_v1, v));
- else if (prog->ints[in_v1->addr] == 2)
- add_triple_to_ptree(prog, va_make_triple(vct_constant_set_2, "vct_constant_set_2(1)", 4, arg0, in_v, in_v1, v));
- else if (prog->ints[in_v1->addr] == 3)
- add_triple_to_ptree(prog, va_make_triple(vct_constant_set_3, "vct_constant_set_3(1)", 4, arg0, in_v, in_v1, v));
- else add_triple_to_ptree(prog, va_make_triple(vct_set_f, "vct_set_f(2)", 4, arg0, in_v, in_v1, v));
- }
- else add_triple_to_ptree(prog, va_make_triple(vct_set_f, "vct_set_f(3)", 4, arg0, in_v, in_v1, v));
-}
-
-
-static xen_value *vct_set_2(ptree *prog, xen_value **args, int num_args)
-{
- /* vct-set! */
- xen_var *var;
- var = find_var_in_ptree_via_addr(prog, args[1]->type, args[1]->addr);
- if (var) var->unclean = true;
- if (args[3]->type == R_FLOAT)
- {
- if (args[2]->constant == R_CONSTANT)
- {
- if (prog->ints[args[2]->addr] == 0)
- return(package(prog, R_FLOAT, vct_constant_set_0, "vct_constant_set_0(0)", args, 3));
- if (prog->ints[args[2]->addr] == 1)
- return(package(prog, R_FLOAT, vct_constant_set_1, "vct_constant_set_1(0)", args, 3));
- if (prog->ints[args[2]->addr] == 2)
- return(package(prog, R_FLOAT, vct_constant_set_2, "vct_constant_set_2(0)", args, 3));
- if (prog->ints[args[2]->addr] == 3)
- return(package(prog, R_FLOAT, vct_constant_set_3, "vct_constant_set_3(0)", args, 3));
- }
-
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (((prev_op->function == vct_ref_f_add) || (prev_op->function == vct_ref_f_mult)) &&
- (prev_op->args[1] == args[1]->addr) &&
- (prev_op->args[2] == args[2]->addr) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- /* (let ((v (vct 1 2 3)) (i 2)) (run (vct-set! v i (+ (vct-ref v i) 3.0)))) */
- if (prev_op->function == vct_ref_f_add)
- {
- prev_op->function = vct_set_f_add;
- prev_op->op_name = "vct_set_f_add";
- }
- else
- {
- prev_op->function = vct_set_f_mult;
- prev_op->op_name = "vct_set_f_mult";
- }
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- }
-
- return(package(prog, R_FLOAT, vct_set_f, "vct_set_f(4)", args, 3));
- }
- return(package(prog, R_FLOAT, vct_set_i, "vct_set_i", args, 3));
-}
-
-
-static void make_vct_v(int *args, ptree *pt)
-{
- if (VCT_RESULT) mus_vct_free(VCT_RESULT);
- VCT_RESULT = mus_vct_make(INT_ARG_1);
-}
-
-
-static void make_vct_v2(int *args, ptree *pt)
-{
- vct *v;
- mus_long_t i;
- if (VCT_RESULT) mus_vct_free(VCT_RESULT);
- v = mus_vct_make(INT_ARG_1);
- VCT_RESULT = v;
- for (i = 0; i < v->length; i++) v->data[i] = FLOAT_ARG_2;
-}
-
-
-static void make_int_vector(int *args, ptree *pt)
-{
- vect *v = NULL;
- if (VECT_RESULT) free_vect(VECT_RESULT, R_INT_VECTOR);
- if (INT_ARG_1 > 0)
- {
- mus_long_t i;
- v = (vect *)calloc(1, sizeof(vect));
- v->length = INT_ARG_1;
- v->data.ints = (Int *)calloc(v->length, sizeof(Int));
- for (i = 0; i < v->length; i++) v->data.ints[i] = INT_ARG_2;
- }
- VECT_RESULT = v;
-}
-
-
-static xen_value *make_vct_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_VCT, add_vct_to_ptree(prog, NULL), R_VARIABLE);
- add_obj_to_gcs(prog, R_VCT, args[0]->addr);
- if (num_args == 1)
- add_triple_to_ptree(prog, va_make_triple(make_vct_v, "make_vct_v", 2, args[0], args[1]));
- else add_triple_to_ptree(prog, va_make_triple(make_vct_v2, "make_vct_v2", 3, args[0], args[1], args[2]));
- return(args[0]);
-}
-
-
-static xen_value *make_vector_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args == 2) && (args[2]->type == R_INT))
- {
- args[0] = make_xen_value(R_INT_VECTOR, add_vect_to_ptree(prog, NULL), R_VARIABLE);
- add_obj_to_gcs(prog, R_INT_VECTOR, args[0]->addr);
- add_triple_to_ptree(prog, va_make_triple(make_int_vector, "make_int_vector", 3, args[0], args[1], args[2]));
- }
- else
- {
- args[0] = make_xen_value(R_FLOAT_VECTOR, add_vct_to_ptree(prog, NULL), R_VARIABLE);
- add_obj_to_gcs(prog, R_FLOAT_VECTOR, args[0]->addr);
- if (num_args == 1)
- add_triple_to_ptree(prog, va_make_triple(make_vct_v, "make_vct_v", 2, args[0], args[1]));
- else add_triple_to_ptree(prog, va_make_triple(make_vct_v2, "make_vct_v2", 3, args[0], args[1], args[2]));
- }
- return(args[0]);
-}
-
-
-static void vct_v(int *args, ptree *pt)
-{
- mus_long_t i;
- vct *v;
- if (VCT_RESULT) VCT_RESULT = mus_vct_free(VCT_RESULT);
- v = mus_vct_make(INT_ARG_1);
- for (i = 0; i < v->length; i++)
- v->data[i] = pt->dbls[args[i + 2]];
- VCT_RESULT = v;
-}
-
-
-static xen_value *vct_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *rtn;
- float_all_args(prog, num_args, args, true);
- rtn = package_n(prog, R_VCT, vct_v, "vct_v", args, num_args);
- /* rtn is args[0] */
- add_obj_to_gcs(prog, R_VCT, rtn->addr);
- return(rtn);
-}
-
-
-static void vct_copy_v(int *args, ptree *pt)
-{
- if (VCT_RESULT) mus_vct_free(VCT_RESULT);
- VCT_RESULT = mus_vct_copy(VCT_ARG_1);
-}
-
-
-static xen_value *vct_copy_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_VCT, add_vct_to_ptree(prog, NULL), R_VARIABLE);
- add_obj_to_gcs(prog, R_VCT, args[0]->addr);
- add_triple_to_ptree(prog, va_make_triple(vct_copy_v, "vct_copy_v", 2, args[0], args[1]));
- return(args[0]);
-}
-
-
-#define VCT_OP_1(SName, CName, COp) \
-static void vct_ ## CName ## _f(int *args, ptree *pt) \
-{ \
- mus_long_t i; \
- vct *v = VCT_ARG_1; \
- if (v) for (i = 0; i < v->length; i++) v->data[i] COp FLOAT_ARG_2; \
- VCT_RESULT = VCT_ARG_1; \
-} \
-static xen_value *vct_ ## CName ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- xen_value *temp; \
- if (args[2]->type == R_INT) \
- { \
- temp = args[2]; \
- args[2] = convert_int_to_dbl(prog, args[2]); \
- free(temp); \
- } \
- return(package(prog, R_VCT, vct_ ## CName ## _f, "vct_" #CName "_f", args, 2)); \
-}
-
-VCT_OP_1(fill!, fill, =)
-VCT_OP_1(scale!, scale, *=)
-VCT_OP_1(offset!, offset, +=)
-
-
-#define VCT_OP_2(SName, CName, COp) \
-static void vct_ ## CName ## _f(int *args, ptree *pt) \
-{ \
- mus_long_t i, len; \
- vct *v0 = VCT_ARG_1; \
- vct *v1 = VCT_ARG_2; \
- if ((v0) && (v1)) \
- { \
- len = v0->length; \
- if (v1->length < len) len = v1->length; \
- for (i = 0; i < len; i++) v0->data[i] COp v1->data[i]; \
- } \
- VCT_RESULT = v0; \
-} \
-static xen_value *vct_ ## CName ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- return(package(prog, R_VCT, vct_ ## CName ## _f, "vct_" #CName "_f", args, 2)); \
-}
-
-VCT_OP_2(add!, add, +=)
-VCT_OP_2(multiply!, multiply, *=)
-VCT_OP_2(subtract!, subtract, -=)
-
-
-static void vct_reverse_v(vct *v, mus_long_t len)
-{
- mus_long_t i, j;
- if ((v) && (len > 1))
- {
- for (i = 0, j = len - 1; i < j; i++, j--)
- {
- mus_float_t temp;
- temp = v->data[i];
- v->data[i] = v->data[j];
- v->data[j] = temp;
- }
- }
-}
-
-static void vct_reverse_0(int *args, ptree *pt)
-{
- vct *v;
- v = VCT_ARG_1;
- vct_reverse_v(v, v->length);
- VCT_RESULT = v;
-}
-
-
-static void vct_reverse_1(int *args, ptree *pt)
-{
- vct_reverse_v(VCT_ARG_1, INT_ARG_2);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static xen_value *vct_reverse_2(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 1)
- return(package(prog, R_VCT, vct_reverse_0, "vct_reverse_0", args, 1));
- return(package(prog, R_VCT, vct_reverse_1, "vct_reverse_1", args, 2));
-}
-
-
-static xen_value *vct_times_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[1]->type == R_VCT)
- {
- if (args[2]->type == R_VCT)
- return(vct_multiply_1(prog, args, num_args));
- return(vct_scale_1(prog, args, num_args));
- }
- /* reorder args for vct_scale_1 */
- temp = args[1];
- args[1] = args[2];
- args[2] = temp;
- return(vct_scale_1(prog, args, num_args));
-}
-
-
-static xen_value *vct_plus_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[1]->type == R_VCT)
- {
- if (args[2]->type == R_VCT)
- return(vct_add_1(prog, args, num_args));
- return(vct_offset_1(prog, args, num_args));
- }
- /* reorder args for vct_offset_1 */
- temp = args[1];
- args[1] = args[2];
- args[2] = temp;
- return(vct_offset_1(prog, args, num_args));
-}
-
-
-/* ---------------- vct-move! ---------------- */
-
-static void vct_move_0(int *args, ptree *pt)
-{
- vct *v;
- mus_long_t i, j;
- v = VCT_ARG_1;
- for (i = INT_ARG_2, j = INT_ARG_3; (j < v->length) && (i < v->length); i++, j++)
- v->data[i] = v->data[j];
- VCT_RESULT = v;
-}
-
-
-static xen_value *vct_move_3(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_VCT, vct_move_0, "vct_move_0", args, 3));
-}
-
-
-/* ---------------- vct-peak ---------------- */
-
-
-static void vct_peak_v(int *args, ptree *pt)
-{
- mus_long_t i;
- Double val = 0.0;
- vct *v;
- v = VCT_ARG_1;
- val = fabs(v->data[0]);
- for (i = 1; i < v->length; i++)
- {
- mus_float_t absv;
- absv = fabs(v->data[i]);
- if (absv > val) val = absv;
- }
- FLOAT_RESULT = val;
-}
-
-static xen_value *vct_peak_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, vct_peak_v, "vct_peak_v", args, 1));
-}
-
-
-#if USE_SND
-/* ---------------- vct->channel ---------------- */
-
-static void vct_to_channel_v(int *args, ptree *pt)
-{
- chan_info *cp;
- cp = run_get_cp(4, args, pt->ints);
- if (cp)
- {
- vct *v;
- mus_long_t beg, dur;
- v = VCT_ARG_1;
- beg = INT_ARG_2;
- dur = INT_ARG_3;
-#if SNDLIB_USE_FLOATS
- change_samples(beg, dur, v->data, cp, S_vct_to_channel, cp->edit_ctr);
-#else
- {
- mus_long_t i;
- mus_sample_t *data;
- data = (mus_sample_t *)calloc(dur, sizeof(mus_sample_t));
- for (i = 0; i < dur; i++) data[i] = MUS_FLOAT_TO_SAMPLE(v->data[i]);
- change_samples(beg, dur, data, cp, S_vct_to_channel, cp->edit_ctr);
- free(data);
- }
-#endif
- }
-}
-
-
-static xen_value *vct_to_channel_1(ptree *pt, xen_value **args, int num_args)
-{
- xen_value *true_args[6];
- xen_value *rtn;
- int k;
- for (k = 0; k < 4; k++) true_args[k] = args[k];
- run_opt_arg(pt, args, num_args, 4, true_args);
- run_opt_arg(pt, args, num_args, 5, true_args);
- rtn = package(pt, R_BOOL, vct_to_channel_v, "vct_to_channel_v", true_args, 5);
- for (k = num_args + 1; k <= 5; k++) free(true_args[k]);
- return(rtn);
-}
-#endif
-
-
-
-/* ---------------- sound-data ---------------- */
-
-static void sound_data_length_i(int *args, ptree *pt) {INT_RESULT = SOUND_DATA_ARG_1->length;}
-
-
-static xen_value *sound_data_length_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_INT, sound_data_length_i, "sound_data_length_i", args, 1));
-}
-
-
-static void sound_data_chans_i(int *args, ptree *pt) {INT_RESULT = SOUND_DATA_ARG_1->chans;}
-
-
-static xen_value *sound_data_chans_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_INT, sound_data_chans_i, "sound_data_chans_i", args, 1));
-}
-
-
-static void sound_data_peak_f(int *args, ptree *pt) {FLOAT_RESULT = sound_data_peak(SOUND_DATA_ARG_1);}
-
-
-static xen_value *sound_data_peak_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, sound_data_peak_f, "sound_data_peak_f", args, 1));
-}
-
-
-static void sound_data_copy_f(int *args, ptree *pt)
-{
- if (SOUND_DATA_RESULT) sound_data_free(SOUND_DATA_RESULT); /* this is how make works, so I guess we should be consistent */
- SOUND_DATA_RESULT = sound_data_copy(SOUND_DATA_ARG_1);
-}
-
-
-static xen_value *sound_data_copy_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_SOUND_DATA, add_sound_data_to_ptree(prog, NULL), R_VARIABLE);
- add_obj_to_gcs(prog, R_SOUND_DATA, args[0]->addr);
- add_triple_to_ptree(prog, va_make_triple(sound_data_copy_f, "sound_data_copy_f", 2, args[0], args[1]));
- return(args[0]);
-}
-
-
-static void sound_data_reverse_f(int *args, ptree *pt) {SOUND_DATA_RESULT = sound_data_reverse(SOUND_DATA_ARG_1);}
-
-
-static xen_value *sound_data_reverse_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_SOUND_DATA, sound_data_reverse_f, "sound_data_reverse_f", args, 1));
-}
-
-
-static void sound_data_ref_f(int *args, ptree *pt) {FLOAT_RESULT = SOUND_DATA_ARG_1->data[INT_ARG_2][INT_ARG_3];}
-
-
-static xen_value *sound_data_ref_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, sound_data_ref_f, "sound_data_ref_f", args, 3));
-}
-
-
-static void sound_data_nf(int *args, ptree *pt) {FLOAT_RESULT = SOUND_DATA_ARG_1->data[INT_ARG_2][INT_ARG_3];}
-
-
-static xen_value *sound_data_n(ptree *prog, xen_value **args, int num_args, xen_value *sf)
-{
- /* this is handling the sound-data-as-applicable-func stuff */
- /* (let ((sd (make-sound-data 2 2))) (run (lambda () (sd 0 0)))) */
- if (args[0]) free(args[0]);
- args[0] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(sound_data_nf, "sound_data_nf", 4, args[0], sf, args[1], args[2]));
- return(args[0]);
-}
-
-
-static void sound_data_set_f(int *args, ptree *pt)
-{
- SOUND_DATA_ARG_1->data[INT_ARG_2][INT_ARG_3] = FLOAT_ARG_4;
- /* FLOAT_RESULT = FLOAT_ARG_4; */
-}
-
-static void sound_data_set_i(int *args, ptree *pt)
-{
- SOUND_DATA_ARG_1->data[INT_ARG_2][INT_ARG_3] = (mus_float_t)INT_ARG_4;
- /* FLOAT_RESULT = (Double)INT_ARG_4; */
-}
-
-
-static void sound_data_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- xen_var *var;
- var = find_var_in_ptree_via_addr(prog, in_v->type, in_v->addr);
- if (var) var->unclean = true;
- /* v->type known to be R_FLOAT (generalized set insists) */
- add_triple_to_ptree(prog, va_make_triple(sound_data_set_f, "sound_data_set_f", 5, NULL, in_v, in_v1, in_v2, v));
-}
-
-
-static xen_value *sound_data_set_2(ptree *prog, xen_value **args, int num_args)
-{
- xen_var *var;
- var = find_var_in_ptree_via_addr(prog, args[1]->type, args[1]->addr);
- if (var) var->unclean = true;
- if (args[4]->type == R_FLOAT)
- return(package(prog, R_FLOAT, sound_data_set_f, "sound_data_set_f", args, 4));
- return(package(prog, R_FLOAT, sound_data_set_i, "sound_data_set_i", args, 4));
-}
-
-
-static void make_sound_data_v(int *args, ptree *pt)
-{
- if (SOUND_DATA_RESULT) sound_data_free(SOUND_DATA_RESULT);
- SOUND_DATA_RESULT = c_make_sound_data(INT_ARG_1, INT_ARG_2);
-}
-
-
-static xen_value *make_sound_data_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_SOUND_DATA, add_sound_data_to_ptree(prog, NULL), R_VARIABLE);
- add_obj_to_gcs(prog, R_SOUND_DATA, args[0]->addr);
- add_triple_to_ptree(prog, va_make_triple(make_sound_data_v, "make_sound_data_v", 3, args[0], args[1], args[2]));
- return(args[0]);
-}
-
-
-static void sound_data_scale_f(int *args, ptree *pt) {SOUND_DATA_RESULT = sound_data_scale(SOUND_DATA_ARG_1, FLOAT_ARG_2);}
-
-
-static xen_value *sound_data_scale_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[2]->type == R_INT)
- {
- temp = args[2];
- args[2] = convert_int_to_dbl(prog, args[2]);
- free(temp);
- }
- return(package(prog, R_SOUND_DATA, sound_data_scale_f, "sound_data_scale_f", args, 2));
-}
-
-
-static void sound_data_offset_f(int *args, ptree *pt) {SOUND_DATA_RESULT = sound_data_offset(SOUND_DATA_ARG_1, FLOAT_ARG_2);}
-
-
-static xen_value *sound_data_offset_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[2]->type == R_INT)
- {
- temp = args[2];
- args[2] = convert_int_to_dbl(prog, args[2]);
- free(temp);
- }
- return(package(prog, R_SOUND_DATA, sound_data_offset_f, "sound_data_offset_f", args, 2));
-}
-
-
-static void sound_data_fill_f(int *args, ptree *pt) {SOUND_DATA_RESULT = sound_data_fill(SOUND_DATA_ARG_1, FLOAT_ARG_2);}
-
-
-static xen_value *sound_data_fill_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[2]->type == R_INT)
- {
- temp = args[2];
- args[2] = convert_int_to_dbl(prog, args[2]);
- free(temp);
- }
- return(package(prog, R_SOUND_DATA, sound_data_fill_f, "sound_data_fill_f", args, 2));
-}
-
-
-static void sound_data_add_f(int *args, ptree *pt) {SOUND_DATA_RESULT = sound_data_add(SOUND_DATA_ARG_1, SOUND_DATA_ARG_2);}
-
-
-static xen_value *sound_data_add_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_SOUND_DATA, sound_data_add_f, "sound_data_add_f", args, 2));
-}
-
-
-static void sound_data_multiply_f(int *args, ptree *pt) {SOUND_DATA_RESULT = sound_data_multiply(SOUND_DATA_ARG_1, SOUND_DATA_ARG_2);}
-
-static xen_value *sound_data_multiply_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_SOUND_DATA, sound_data_multiply_f, "sound_data_multiply_f", args, 2));
-}
-
-
-static xen_value *sound_data_times_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[1]->type == R_SOUND_DATA)
- {
- if (args[2]->type == R_SOUND_DATA)
- return(sound_data_multiply_1(prog, args, num_args));
- return(sound_data_scale_1(prog, args, num_args));
- }
- /* reorder args for sound_data_scale_1 */
- temp = args[1];
- args[1] = args[2];
- args[2] = temp;
- return(sound_data_scale_1(prog, args, num_args));
-}
-
-
-static xen_value *sound_data_plus_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *temp;
- if (args[1]->type == R_SOUND_DATA)
- {
- if (args[2]->type == R_SOUND_DATA)
- return(sound_data_add_1(prog, args, num_args));
- return(sound_data_offset_1(prog, args, num_args));
- }
- /* reorder args for sound_data_offset_1 */
- temp = args[1];
- args[1] = args[2];
- args[2] = temp;
- return(sound_data_offset_1(prog, args, num_args));
-}
-
-
-static void sound_data_to_vct_v(int *args, ptree *pt)
-{
- vct *v;
- sound_data *sd;
- int chan;
- mus_long_t len;
- v = VCT_ARG_3;
- sd = SOUND_DATA_ARG_1;
- chan = INT_ARG_2;
- if (sd->length < v->length)
- len = sd->length;
- else len = v->length;
- memcpy((void *)(v->data), (void *)(sd->data[chan]), len * sizeof(mus_float_t));
- VCT_RESULT = v;
-}
-
-
-static xen_value *sound_data_to_vct_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_VCT, sound_data_to_vct_v, "sound_data_to_vct_v", args, 3));
-}
-
-static void vct_to_sound_data_v(int *args, ptree *pt)
-{
- vct *v;
- sound_data *sd;
- int chan;
- mus_long_t len;
- v = VCT_ARG_1;
- sd = SOUND_DATA_ARG_2;
- chan = INT_ARG_3;
- if (sd->length < v->length)
- len = sd->length;
- else len = v->length;
- memcpy((void *)(sd->data[chan]), (void *)(v->data), len * sizeof(mus_float_t));
- SOUND_DATA_RESULT = sd;
-}
-
-
-static xen_value *vct_to_sound_data_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_SOUND_DATA, vct_to_sound_data_v, "vct_to_sound_data_v", args, 3));
-}
-
-
-
-/* ---------------- CLM stuff ---------------- */
-
-
-static xen_value *mus_generator_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (args[1]->type == R_CLM) || (CLM_STRUCT_P(args[1]->type))), R_CONSTANT));
-}
-
-
-#define GEN_P(Name) \
- static void Name ## _0p(int *args, ptree *pt) {BOOL_RESULT = (Int)mus_ ## Name ## _p(CLM_ARG_1);} \
- static xen_value * Name ## _p(ptree *prog, xen_value **args, int num_args) \
- { \
- if (args[1]->type == R_CLM) \
- { \
- if (mus_ ## Name ## _p(prog->clms[args[1]->addr])) \
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)true), R_CONSTANT)); \
- return(package(prog, R_BOOL, Name ## _0p, #Name "_0p", args, 1)); \
- } \
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (Int)false), R_CONSTANT)); \
- }
-
-
-#define GEN2_0(Name) \
- static void Name ## _0f(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name (CLM_ARG_1, 0.0);}
-
-#define GEN1_0(Name) \
- static void Name ## _0f(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name (CLM_ARG_1);}
-
-#define GEN2_1(Name) \
- static void Name ## _1f(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name (CLM_ARG_1, FLOAT_ARG_2);}
-
-#define mus_comb_no_input(Ptr) mus_comb_unmodulated(Ptr, 0.0)
-#define mus_filtered_comb_no_input(Ptr) mus_filtered_comb_unmodulated(Ptr, 0.0)
-#define mus_notch_no_input(Ptr) mus_notch_unmodulated(Ptr, 0.0)
-#define mus_all_pass_no_input(Ptr) mus_all_pass_unmodulated(Ptr, 0.0)
-#define mus_ssb_am_no_input(Ptr) mus_ssb_am_unmodulated(Ptr, 0.0)
-
-#define GEN3(Name) \
- static void Name ## _0f(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name ## _no_input(CLM_ARG_1);} \
- static void Name ## _1f(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name ## _unmodulated(CLM_ARG_1, FLOAT_ARG_2);} \
- static void Name ## _2f(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name (CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);} \
- GEN_P(Name) \
- static xen_value * Name ## _1(ptree *prog, xen_value **args, int num_args) \
- { \
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2); \
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3); \
- if (num_args == 1) return(package(prog, R_FLOAT, Name ## _0f, #Name "_0f", args, 1)); \
- if (num_args == 2) return(package(prog, R_FLOAT, Name ## _1f, #Name "_1f", args, 2)); \
- return(package(prog, R_FLOAT, Name ## _2f, #Name "_2f", args, 3)); \
- }
-
-
-
-static void polyshape_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_polyshape_no_input(CLM_ARG_1);}
-static void polyshape_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_polyshape_unmodulated(CLM_ARG_1, FLOAT_ARG_2);}
-static void polyshape_1fn(int *args, ptree *pt) {FLOAT_RESULT = mus_polyshape_fm(CLM_ARG_1, FLOAT_ARG_3);}
-static void polyshape_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_polyshape(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static void polyshape_1fn_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * mus_polyshape_fm(CLM_ARG_1, FLOAT_ARG_3);}
-static void polyshape_1fn_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_4) * mus_polyshape_fm(CLM_ARG_1, FLOAT_ARG_3);}
-
-GEN_P(polyshape)
-
-static xen_value *polyshape_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3);
- if (num_args == 1) return(package(prog, R_FLOAT, polyshape_0f, "polyshape_0f", args, 1));
- if (num_args == 2) return(package(prog, R_FLOAT, polyshape_1f, "polyshape_1f", args, 2));
- if ((args[2]->constant == R_CONSTANT) && (prog->dbls[args[2]->addr] == 1.0)) return(package(prog, R_FLOAT, polyshape_1fn, "polyshape_1fn", args, 3));
- return(package(prog, R_FLOAT, polyshape_2f, "polyshape_2f", args, 3));
-}
-
-
-static void oscil_0f_1(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_unmodulated(CLM_ARG_1);}
-
-static void oscil_0f_1_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_2) * mus_oscil_unmodulated(CLM_ARG_1);}
-
-static void oscil_0f_1_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * mus_oscil_unmodulated(CLM_ARG_1);}
-
-static void oscil_1f_1(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2);}
-
-static void oscil_1f_1_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_3) * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2);}
-
-static void oscil_1f_1_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2);}
-
-static void oscil_1f_2(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3);}
-static void oscil_1f_2m(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 * FLOAT_ARG_3);}
-
-static void oscil_1f_2_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_4) * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3);}
-static void oscil_1f_2m_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_4) * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 * FLOAT_ARG_3);}
-
-static void oscil_1f_2_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3);}
-static void oscil_1f_2m_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 * FLOAT_ARG_3);}
-
-static void oscil_1f_3(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3 + FLOAT_ARG_4);}
-static void oscil_1f_3ma(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_fm(CLM_ARG_1, (FLOAT_ARG_2 * FLOAT_ARG_3) + FLOAT_ARG_4);}
-static void oscil_1f_3ma_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_5 * mus_oscil_fm(CLM_ARG_1, (FLOAT_ARG_2 * FLOAT_ARG_3) + FLOAT_ARG_4);}
-static void oscil_1f_3ma_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_5) * mus_oscil_fm(CLM_ARG_1, (FLOAT_ARG_2 * FLOAT_ARG_3) + FLOAT_ARG_4);}
-/* (let ((gen (make-oscil 100)) (x 2.0) (y 3.0) (z 4.0)) (run (lambda () (oscil gen (+ x (* y z))))) gen) */
-static void oscil_1f_3_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_5 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3 + FLOAT_ARG_4);}
-static void oscil_1f_3_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_5) * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3 + FLOAT_ARG_4);}
-
-static void oscil_2f_1(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_pm(CLM_ARG_1, FLOAT_ARG_3);}
-
-static void oscil_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static void oscil_0f_vect(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_unmodulated(VECT_ARG_1->data.gens[INT_ARG_2]);}
-static void oscil_0f_vect_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * mus_oscil_unmodulated(VECT_ARG_1->data.gens[INT_ARG_2]);}
-static void oscil_0f_vect_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_3) * mus_oscil_unmodulated(VECT_ARG_1->data.gens[INT_ARG_2]);}
-
-static void oscil_1f_vect(int *args, ptree *pt) {FLOAT_RESULT = mus_oscil_fm(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-static void oscil_1f_vect_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * mus_oscil_fm(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-static void oscil_1f_vect_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_4) * mus_oscil_fm(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-
-GEN_P(oscil)
-
-static xen_value *oscil_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3);
-
- if ((num_args == 1) ||
- ((num_args == 2) &&
- (args[2]->constant == R_CONSTANT) &&
- (prog->dbls[args[2]->addr] == 0.0)))
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->function == vector_ref_c) &&
- (prev_op->types[0] == R_CLM) &&
- (prev_op->args[0] == args[1]->addr) &&
- ((find_var_in_ptree_via_addr(prog, R_CLM, prev_op->args[0])) == NULL))
- {
- xen_value *new0;
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->args[0] = new0->addr;
- prev_op->types[0] = R_FLOAT;
- prev_op->function = oscil_0f_vect;
- prev_op->op_name = "oscil_0f_vect";
- return(new0);
- }
- }
- return(package(prog, R_FLOAT, oscil_0f_1, "oscil_0f_1", args, 1));
- }
-
- if ((num_args == 2) ||
- ((num_args == 3) &&
- (args[3]->constant == R_CONSTANT) &&
- (prog->dbls[args[3]->addr] == 0.0)))
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (((prev_op->function == add_f2) ||
- (prev_op->function == multiply_f2) ||
- (prev_op->function == multiply_add_f2) ||
- (prev_op->function == add_f3)) &&
- (prev_op->args[0] == args[2]->addr) &&
- (find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL)
- {
- if ((prev_op->function == add_f2) ||
- (prev_op->function == multiply_f2))
- {
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->args[3] = prev_op->args[2];
- prev_op->args[2] = prev_op->args[1];
- prev_op->types[3] = R_FLOAT;
- prev_op->args[1] = args[1]->addr;
- prev_op->types[1] = R_CLM;
- prev_op->num_args = 4;
- if (prev_op->function == add_f2)
- {
- prev_op->function = oscil_1f_2;
- prev_op->op_name = "oscil_1f_2";
- }
- else
- {
- prev_op->function = oscil_1f_2m;
- prev_op->op_name = "oscil_1f_2m";
- }
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- /* else it's add_f3 or multiply_add_f2 */
- prev_op->types = (int *)realloc(prev_op->types, 5 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 5 * sizeof(int));
- prev_op->args[4] = prev_op->args[3];
- prev_op->args[3] = prev_op->args[2];
- prev_op->args[2] = prev_op->args[1];
- prev_op->types[4] = R_FLOAT;
- prev_op->args[1] = args[1]->addr;
- prev_op->types[1] = R_CLM;
- prev_op->num_args = 5;
- if (prev_op->function == add_f3)
- {
- prev_op->function = oscil_1f_3;
- prev_op->op_name = "oscil_1f_3";
- }
- else
- {
- prev_op->function = oscil_1f_3ma;
- prev_op->op_name = "oscil_1f_3ma";
- }
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
-
- if ((prev_op->function == vector_ref_c) &&
- (prev_op->types[0] == R_CLM) &&
- (prev_op->args[0] == args[1]->addr) &&
- ((find_var_in_ptree_via_addr(prog, R_CLM, prev_op->args[0])) == NULL))
- {
- xen_value *new0;
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->num_args = 4;
- prev_op->args[0] = new0->addr;
- prev_op->types[0] = R_FLOAT;
- prev_op->function = oscil_1f_vect;
- prev_op->op_name = "oscil_1f_vect";
- prev_op->args[3] = args[2]->addr;
- prev_op->types[3] = R_FLOAT;
- return(new0);
- }
-
- }
- return(package(prog, R_FLOAT, oscil_1f_1, "oscil_1f_1", args, 2));
- }
-
- if ((num_args == 3) && (args[2]->constant == R_CONSTANT) && (prog->dbls[args[2]->addr] == 0.0))
- return(package(prog, R_FLOAT, oscil_2f_1, "oscil_2f_1", args, 3));
-
- return(package(prog, R_FLOAT, oscil_2f, "oscil_2f", args, 3));
-}
-
-
-static void formant_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_formant(CLM_ARG_1, 0.0);}
-
-static void formant_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_formant(CLM_ARG_1, FLOAT_ARG_2);}
-static void formant_1f_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 + mus_formant(CLM_ARG_1, FLOAT_ARG_2);}
-static void formant_1f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * mus_formant(CLM_ARG_1, FLOAT_ARG_2);}
-static void formant_1f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_3) * mus_formant(CLM_ARG_1, FLOAT_ARG_2);}
-
-static void formant_1f_vect(int *args, ptree *pt) {FLOAT_RESULT = mus_formant(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-static void formant_1f_vect_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * mus_formant(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-static void formant_1f_vect_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_4) * mus_formant(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-
-static void formant_1f_sma(int *args, ptree *pt) {FLOAT_RESULT = mus_formant(CLM_ARG_5, FLOAT_ARG_4 + FLOAT_ARG_3 * (FLOAT_ARG_1 - FLOAT_ARG_2));}
-
-static void formant_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_formant_with_frequency(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-GEN_P(formant)
-
-static xen_value *formant_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3);
- if (num_args == 1)
- return(package(prog, R_FLOAT, formant_0f, "formant_0f", args, 1));
-
- if (num_args == 2)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->function == subtract_f2_mult_add) &&
- (prev_op->args[0] == args[2]->addr) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- prev_op->types = (int *)realloc(prev_op->types, 6 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 6 * sizeof(int));
- prev_op->num_args = 6;
- prev_op->function = formant_1f_sma;
- prev_op->op_name = "formant_1f_sma";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- prev_op->types[5] = R_CLM;
- prev_op->args[5] = args[1]->addr;
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
-
- if ((prev_op->function == vector_ref_c) &&
- (prev_op->types[0] == R_CLM) &&
- (prev_op->args[0] == args[1]->addr) &&
- ((find_var_in_ptree_via_addr(prog, R_CLM, prev_op->args[0])) == NULL))
- {
- /* (let ((v (vector (make-formant 330)))) (run (* 0.5 (formant (vector-ref v 0) .1)))) */
- xen_value *new0;
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->num_args = 4;
- prev_op->args[0] = new0->addr;
- prev_op->types[0] = R_FLOAT;
- prev_op->function = formant_1f_vect;
- prev_op->op_name = "formant_1f_vect";
- prev_op->args[3] = args[2]->addr;
- prev_op->types[3] = R_FLOAT;
- return(new0);
- }
- }
-
- return(package(prog, R_FLOAT, formant_1f, "formant_1f", args, 2));
- }
- return(package(prog, R_FLOAT, formant_2f, "formant_2f", args, 3));
-}
-
-
-static void firmant_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_firmant(CLM_ARG_1, 0.0);}
-
-static void firmant_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_firmant(CLM_ARG_1, FLOAT_ARG_2);}
-static void firmant_1f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * mus_firmant(CLM_ARG_1, FLOAT_ARG_2);}
-static void firmant_1f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_3) * mus_firmant(CLM_ARG_1, FLOAT_ARG_2);}
-
-static void firmant_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_firmant_with_frequency(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-static void firmant_2f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * mus_firmant_with_frequency(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-static void firmant_2f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_4) * mus_firmant_with_frequency(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static void firmant_1f_vect(int *args, ptree *pt) {FLOAT_RESULT = mus_firmant(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-static void firmant_1f_vect_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * mus_firmant(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-static void firmant_1f_vect_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_4) * mus_firmant(VECT_ARG_1->data.gens[INT_ARG_2], FLOAT_ARG_3);}
-
-GEN_P(firmant)
-
-static xen_value *firmant_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3);
-
- if (num_args == 1)
- return(package(prog, R_FLOAT, firmant_0f, "firmant_0f", args, 1));
-
- if (num_args == 2)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
-
- if ((prev_op->function == vector_ref_c) &&
- (prev_op->types[0] == R_CLM) &&
- (prev_op->args[0] == args[1]->addr) &&
- ((find_var_in_ptree_via_addr(prog, R_CLM, prev_op->args[0])) == NULL))
- {
- /* (let ((v (vector (make-firmant 330)))) (run (* 0.5 (formant (vector-ref v 0) .1)))) */
- xen_value *new0;
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->num_args = 4;
- prev_op->args[0] = new0->addr;
- prev_op->types[0] = R_FLOAT;
- prev_op->function = firmant_1f_vect;
- prev_op->op_name = "firmant_1f_vect";
- prev_op->args[3] = args[2]->addr;
- prev_op->types[3] = R_FLOAT;
- return(new0);
- }
- }
- return(package(prog, R_FLOAT, firmant_1f, "firmant_1f", args, 2));
- }
- return(package(prog, R_FLOAT, firmant_2f, "firmant_2f", args, 3));
-}
-
-
-#define GEN2(Name) \
- GEN2_0(Name) \
- GEN2_1(Name) \
- GEN_P(Name) \
- static xen_value * Name ## _1(ptree *prog, xen_value **args, int num_args) \
- { \
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2); \
- if (num_args == 1) return(package(prog, R_FLOAT, Name ## _0f, #Name "_0f", args, 1)); \
- return(package(prog, R_FLOAT, Name ## _1f, #Name "_1f", args, 2)); \
- }
-
-#define GEN2_OPT(Name) \
- static void Name ## _0f(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name ## _unmodulated (CLM_ARG_1);} \
- GEN2_1(Name) \
- GEN_P(Name) \
- static xen_value * Name ## _1(ptree *prog, xen_value **args, int num_args) \
- { \
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2); \
- if (num_args == 1) return(package(prog, R_FLOAT, Name ## _0f, #Name "_0f", args, 1)); \
- return(package(prog, R_FLOAT, Name ## _1f, #Name "_1f", args, 2)); \
- }
-
-#define GEN1(Name) \
- GEN1_0(Name) \
- GEN_P(Name) \
- static xen_value * Name ## _1(ptree *prog, xen_value **args, int num_args) \
- { \
- return(package(prog, R_FLOAT, Name ## _0f, #Name "_0f", args, 1)); \
- }
-
-
-/* GEN1(env) */
-
-static bool env_is_constant(mus_any *e)
-{
- mus_float_t *data;
- if (mus_env_breakpoints(e) == 1) return(true);
- if (mus_env_breakpoints(e) > 2) return(false);
- data = mus_data(e);
- return(data[1] == data[3]);
-}
-
-
-GEN_P(env)
-
-static void env_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_env(CLM_ARG_1);}
-static void env_linear_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_1);}
-static void env_linear_0f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * mus_env_linear(CLM_ARG_1);}
-static void env_linear_0f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_2) * mus_env_linear(CLM_ARG_1);}
-static void env_exponential_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_env_exponential(CLM_ARG_1);}
-
-static void env_linear_2f(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_env_linear(CLM_ARG_1); /* the original (prev_op) */
- FLOAT_ARG_2 = mus_env_linear(CLM_ARG_3); /* 2nd (independent, arg[0] -> arg[2], arg[1] -> arg[3]) */
-}
-
-
-static xen_value *env_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((args[1]->type == R_CLM) &&
- (mus_env_p(prog->clms[args[1]->addr])))
- {
- /* this sort of optimization assumes the ptree is not saved,
- * and that run-time make-env values are not already set?!?
- */
- mus_env_t style;
- mus_any *e;
- e = prog->clms[args[1]->addr];
- style = mus_env_type(e);
-
- /* if it's a constant, return its value as in (+ 1 2) */
- if (env_is_constant(e))
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, mus_env(e)), R_CONSTANT)); /* this assumes no set scaler/offset etc */
-
- if (style == MUS_ENV_LINEAR)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (prev_op->function == env_linear_0f)
- {
- xen_value *new0;
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->num_args = 4;
- prev_op->function = env_linear_2f;
- prev_op->op_name = "env_linear_2f";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->args[2] = new0->addr;
- prev_op->types[2] = R_FLOAT;
- prev_op->args[3] = args[1]->addr;
- prev_op->types[3] = R_CLM;
- return(new0);
- }
- }
-
- return(package(prog, R_FLOAT, env_linear_0f, "env_linear_0f", args, 1));
- }
-
- if (style == MUS_ENV_EXPONENTIAL)
- return(package(prog, R_FLOAT, env_exponential_0f, "env_exponential_0f", args, 1));
- }
-
- return(package(prog, R_FLOAT, env_0f, "env_0f", args, 1));
-}
-
-
-GEN1(readin)
-GEN3(filtered_comb)
-
-
-static void delay_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_delay_unmodulated(CLM_ARG_1, 0.0);}
-static void delay_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_delay_unmodulated(CLM_ARG_1, FLOAT_ARG_2);}
-static void delay_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_delay(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-static void delay_1f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_3) * mus_delay_unmodulated(CLM_ARG_1, FLOAT_ARG_2);}
-static void delay_1f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * mus_delay_unmodulated(CLM_ARG_1, FLOAT_ARG_2);}
-
-static void delay_0f_noz(int *args, ptree *pt) {FLOAT_RESULT = mus_delay_unmodulated_noz(CLM_ARG_1, 0.0);}
-static void delay_1f_noz(int *args, ptree *pt) {FLOAT_RESULT = mus_delay_unmodulated_noz(CLM_ARG_1, FLOAT_ARG_2);}
-static void delay_1f_noz_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * mus_delay_unmodulated_noz(CLM_ARG_1, FLOAT_ARG_2);}
-static void delay_1f_noz_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_3) * mus_delay_unmodulated_noz(CLM_ARG_1, FLOAT_ARG_2);}
-
-GEN_P(delay)
-
-static xen_value *delay_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3);
-
- if ((args[1]->type == R_CLM) &&
- (mus_delay_p(prog->clms[args[1]->addr])) &&
- (mus_safety(prog->clms[args[1]->addr]) == 0))
- {
- if (num_args == 1) return(package(prog, R_FLOAT, delay_0f_noz, "delay_0f_noz", args, 1));
- if (num_args == 2) return(package(prog, R_FLOAT, delay_1f_noz, "delay_1f_noz", args, 2));
- }
-
- if (num_args == 1) return(package(prog, R_FLOAT, delay_0f, "delay_0f", args, 1));
- if (num_args == 2) return(package(prog, R_FLOAT, delay_1f, "delay_1f", args, 2));
- return(package(prog, R_FLOAT, delay_2f, "delay_2f", args, 3));
-}
-
-
-static void comb_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_comb_unmodulated(CLM_ARG_1, 0.0);}
-static void comb_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_comb_unmodulated(CLM_ARG_1, FLOAT_ARG_2);}
-static void comb_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_comb(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static void comb_0f_noz(int *args, ptree *pt) {FLOAT_RESULT = mus_comb_unmodulated_noz(CLM_ARG_1, 0.0);}
-static void comb_1f_noz(int *args, ptree *pt) {FLOAT_RESULT = mus_comb_unmodulated_noz(CLM_ARG_1, FLOAT_ARG_2);}
-
-static void comb_2_noz(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_comb_unmodulated_noz(CLM_ARG_1, FLOAT_ARG_2);
- FLOAT_ARG_3 = mus_comb_unmodulated_noz(CLM_ARG_4, FLOAT_ARG_5);
-}
-
-GEN_P(comb)
-
-static xen_value *comb_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3);
-
- if ((args[1]->type == R_CLM) &&
- (mus_comb_p(prog->clms[args[1]->addr])) &&
- (mus_safety(prog->clms[args[1]->addr]) == 0))
- {
- if (num_args == 1) return(package(prog, R_FLOAT, comb_0f_noz, "comb_0f_noz", args, 1));
- if (num_args == 2)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- xen_value *new0;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (prev_op->function == comb_1f_noz)
- {
- prev_op->types = (int *)realloc(prev_op->types, 6 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 6 * sizeof(int));
- prev_op->num_args = 6;
- prev_op->function = comb_2_noz;
- prev_op->op_name = "comb_2_noz";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->args[3] = new0->addr;
- prev_op->types[3] = R_FLOAT;
- prev_op->args[4] = args[1]->addr;
- prev_op->types[4] = R_CLM;
- prev_op->args[5] = args[2]->addr;
- prev_op->types[5] = R_FLOAT;
- return(new0);
- }
- }
- return(package(prog, R_FLOAT, comb_1f_noz, "comb_1f_noz", args, 2));
- }
- }
- if (num_args == 1) return(package(prog, R_FLOAT, comb_0f, "comb_0f", args, 1));
- if (num_args == 2) return(package(prog, R_FLOAT, comb_1f, "comb_1f", args, 2));
- return(package(prog, R_FLOAT, comb_2f, "comb_2f", args, 3));
-}
-
-
-static void notch_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_notch_unmodulated(CLM_ARG_1, 0.0);}
-static void notch_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_notch_unmodulated(CLM_ARG_1, FLOAT_ARG_2);}
-static void notch_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_notch(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static void notch_0f_noz(int *args, ptree *pt) {FLOAT_RESULT = mus_notch_unmodulated_noz(CLM_ARG_1, 0.0);}
-static void notch_1f_noz(int *args, ptree *pt) {FLOAT_RESULT = mus_notch_unmodulated_noz(CLM_ARG_1, FLOAT_ARG_2);}
-
-GEN_P(notch)
-
-static xen_value *notch_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3);
-
- if ((args[1]->type == R_CLM) &&
- (mus_notch_p(prog->clms[args[1]->addr])) &&
- (mus_safety(prog->clms[args[1]->addr]) == 0))
- {
- if (num_args == 1) return(package(prog, R_FLOAT, notch_0f_noz, "notch_0f_noz", args, 1));
- if (num_args == 2) return(package(prog, R_FLOAT, notch_1f_noz, "notch_1f_noz", args, 2));
- }
-
- if (num_args == 1) return(package(prog, R_FLOAT, notch_0f, "notch_0f", args, 1));
- if (num_args == 2) return(package(prog, R_FLOAT, notch_1f, "notch_1f", args, 2));
- return(package(prog, R_FLOAT, notch_2f, "notch_2f", args, 3));
-}
-
-
-static void all_pass_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_all_pass_unmodulated(CLM_ARG_1, 0.0);}
-static void all_pass_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_all_pass_unmodulated(CLM_ARG_1, FLOAT_ARG_2);}
-static void all_pass_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_all_pass(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static void all_pass_0f_noz(int *args, ptree *pt) {FLOAT_RESULT = mus_all_pass_unmodulated_noz(CLM_ARG_1, 0.0);}
-static void all_pass_1f_noz(int *args, ptree *pt) {FLOAT_RESULT = mus_all_pass_unmodulated_noz(CLM_ARG_1, FLOAT_ARG_2);}
-
-static void all_pass_2_noz(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_all_pass_unmodulated_noz(CLM_ARG_1, FLOAT_ARG_2);
- FLOAT_ARG_3 = mus_all_pass_unmodulated_noz(CLM_ARG_4, FLOAT_ARG_5);
-}
-
-GEN_P(all_pass)
-
-static xen_value *all_pass_1(ptree *prog, xen_value **args, int num_args)
-{
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if ((num_args > 2) && (args[3]->type == R_INT)) single_to_float(prog, args, 3);
-
- if ((args[1]->type == R_CLM) &&
- (mus_all_pass_p(prog->clms[args[1]->addr])) &&
- (mus_safety(prog->clms[args[1]->addr]) == 0))
- {
- if (num_args == 1) return(package(prog, R_FLOAT, all_pass_0f_noz, "all_pass_0f_noz", args, 1));
- if (num_args == 2)
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- xen_value *new0;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (prev_op->function == all_pass_1f_noz)
- {
- prev_op->types = (int *)realloc(prev_op->types, 6 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 6 * sizeof(int));
- prev_op->num_args = 6;
- prev_op->function = all_pass_2_noz;
- prev_op->op_name = "all_pass_2_noz";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- new0 = add_temporary_var_to_ptree(prog, R_FLOAT);
- prev_op->args[3] = new0->addr;
- prev_op->types[3] = R_FLOAT;
- prev_op->args[4] = args[1]->addr;
- prev_op->types[4] = R_CLM;
- prev_op->args[5] = args[2]->addr;
- prev_op->types[5] = R_FLOAT;
- return(new0);
- }
- }
- return(package(prog, R_FLOAT, all_pass_1f_noz, "all_pass_1f_noz", args, 2));
- }
- }
-
- if (num_args == 1) return(package(prog, R_FLOAT, all_pass_0f, "all_pass_0f", args, 1));
- if (num_args == 2) return(package(prog, R_FLOAT, all_pass_1f, "all_pass_1f", args, 2));
- return(package(prog, R_FLOAT, all_pass_2f, "all_pass_2f", args, 3));
-}
-
-
-static void rand_0f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_2) * mus_rand(CLM_ARG_1, 0.0);}
-static void rand_0f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * mus_rand(CLM_ARG_1, 0.0);}
-static void rand_interp_0f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_2) * mus_rand_interp(CLM_ARG_1, 0.0);}
-static void rand_interp_0f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * mus_rand_interp(CLM_ARG_1, 0.0);}
-static void rand_interp_0f_add(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 + mus_rand_interp(CLM_ARG_1, 0.0);}
-
-/* mus_safety = zdly setting internally, if 0 we could call simplified delay and friends */
-
-GEN3(ssb_am)
-GEN3(asymmetric_fm)
-
-GEN2(moving_average)
-GEN2(rand)
-GEN2(rand_interp)
-GEN2(ncos)
-GEN2(nsin)
-GEN2(sawtooth_wave)
-GEN2(pulse_train)
-GEN2(square_wave)
-GEN2(triangle_wave)
-GEN2(nrxysin)
-GEN2(nrxycos)
-GEN2(one_zero)
-GEN2(one_pole)
-GEN2(two_zero)
-GEN2(two_pole)
-GEN2(filter)
-GEN2(fir_filter)
-GEN2(iir_filter)
-
-GEN2_OPT(wave_train)
-GEN2_OPT(table_lookup)
-
-
-GEN_P(frame)
-GEN_P(mixer)
-GEN_P(file_to_sample)
-GEN_P(sample_to_file)
-GEN_P(file_to_frame)
-GEN_P(frame_to_file)
-GEN_P(input)
-GEN_P(output)
-GEN_P(locsig)
-GEN_P(move_sound)
-
-
-static void polywave_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_polywave_unmodulated(CLM_ARG_1);}
-static void polywave_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_polywave(CLM_ARG_1, FLOAT_ARG_2);}
-static void polywave_1f_2(int *args, ptree *pt) {FLOAT_RESULT = mus_polywave(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3);}
-static void polywave_1f_3(int *args, ptree *pt) {FLOAT_RESULT = mus_polywave(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3 + FLOAT_ARG_4);}
-
-GEN_P(polywave)
-
-static xen_value *polywave_1(ptree *prog, xen_value **args, int num_args)
-{
- bool one_arg;
- one_arg = ((num_args == 1) || ((num_args == 2) && (args[2]->constant == R_CONSTANT) && (prog->dbls[args[2]->addr] == 0.0)));
-
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
-
- if ((!one_arg) &&
- (prog->triple_ctr > 0))
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if (((prev_op->function == add_f2) ||
- (prev_op->function == add_f3)) &&
- (prev_op->args[0] == args[2]->addr) &&
- (find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL)
- {
- if (prev_op->function == add_f2)
- {
- prev_op->types = (int *)realloc(prev_op->types, 4 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 4 * sizeof(int));
- prev_op->args[3] = prev_op->args[2];
- prev_op->args[2] = prev_op->args[1];
- prev_op->types[3] = R_FLOAT;
- prev_op->args[1] = args[1]->addr;
- prev_op->types[1] = R_CLM;
- prev_op->num_args = 4;
- prev_op->function = polywave_1f_2;
- prev_op->op_name = "polywave_1f_2";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- /* else it's add_f3 */
- prev_op->types = (int *)realloc(prev_op->types, 5 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 5 * sizeof(int));
- prev_op->args[4] = prev_op->args[3];
- prev_op->args[3] = prev_op->args[2];
- prev_op->args[2] = prev_op->args[1];
- prev_op->types[4] = R_FLOAT;
- prev_op->args[1] = args[1]->addr;
- prev_op->types[1] = R_CLM;
- prev_op->num_args = 5;
- prev_op->function = polywave_1f_3;
- prev_op->op_name = "polywave_1f_3";
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- }
-
- /* splitting out the "kind" check does not help (I tried this three times and still can't believe it) */
- if (one_arg)
- return(package(prog, R_FLOAT, polywave_0f, "polywave_0f", args, 1));
- return(package(prog, R_FLOAT, polywave_1f, "polywave_1f", args, 2));
-}
-
-static void polywave_0f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_2) * mus_polywave_unmodulated(CLM_ARG_1);}
-static void polywave_0f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * mus_polywave_unmodulated(CLM_ARG_1);}
-static void polywave_1f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_3) * mus_polywave(CLM_ARG_1, FLOAT_ARG_2);}
-static void polywave_1f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_3 * mus_polywave(CLM_ARG_1, FLOAT_ARG_2);}
-static void polywave_1f_2_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_4) * mus_polywave(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3);}
-static void polywave_1f_2_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_4 * mus_polywave(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3);}
-
-
-
-static void tap_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_tap_unmodulated(CLM_ARG_1);}
-
-static void tap_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_tap(CLM_ARG_1, FLOAT_ARG_2);}
-
-static xen_value *tap_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 1)
- return(package(prog, R_FLOAT, tap_0f, "tap_0f", args, 1));
- if (args[2]->type == R_INT) single_to_float(prog, args, 2);
- return(package(prog, R_FLOAT, tap_1f, "tap_1f", args, 2));
-}
-
-
-static void delay_tick_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_delay_tick(CLM_ARG_1, FLOAT_ARG_2);}
-static void delay_tick_noz_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_delay_tick_noz(CLM_ARG_1, FLOAT_ARG_2);}
-
-static xen_value *delay_tick_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[2]->type == R_INT) single_to_float(prog, args, 2);
-
- if ((args[1]->type == R_CLM) &&
- (mus_delay_p(prog->clms[args[1]->addr])) &&
- (mus_safety(prog->clms[args[1]->addr]) == 0))
- return(package(prog, R_FLOAT, delay_tick_noz_1f, "delay_tick_noz_1f", args, 2));
-
- return(package(prog, R_FLOAT, delay_tick_1f, "delay_tick_1f", args, 2));
-}
-
-static void move_locsig_2f(int *args, ptree *pt) {mus_move_locsig(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static xen_value *move_locsig_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, move_locsig_2f, "move_locsig_2f", args, 3));
-}
-
-
-static void mixer_ref_0(int *args, ptree *pt) {FLOAT_RESULT = mus_mixer_ref(CLM_ARG_1, INT_ARG_2, INT_ARG_3);}
-
-static xen_value *mixer_ref_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, mixer_ref_0, "mixer_ref_0", args, 3));
-}
-
-
-static void mixer_set_0(int *args, ptree *pt)
-{
- mus_mixer_set(CLM_ARG_1, INT_ARG_2, INT_ARG_3, FLOAT_ARG_4);
-}
-
-static void mixer_set_i(int *args, ptree *pt)
-{
- mus_mixer_set(CLM_ARG_1, INT_ARG_2, INT_ARG_3, (mus_float_t)INT_ARG_4);
-}
-
-static xen_value *mixer_set_2(ptree *prog, xen_value **args, int num_args)
-{
- /* mixer-set! */
- if (args[4]->type == R_FLOAT)
- return(package(prog, R_FLOAT, mixer_set_0, "mixer_set_0", args, 4));
- return(package(prog, R_FLOAT, mixer_set_i, "mixer_set_i", args, 4));
-}
-
-static void mixer_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- /* set! mixer-ref */
- add_triple_to_ptree(prog, va_make_triple(mixer_set_0, "mixer_set_0", 5, NULL, in_v, in_v1, in_v2, v));
-}
-
-#define REF_GEN0(Name, SName) \
- static void Name ## _0r(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name (CLM_ARG_1, INT_ARG_2);} \
- static xen_value * Name ## _0(ptree *prog, xen_value **args, int num_args) \
- { \
- return(package(prog, R_FLOAT, Name ## _0r, #Name "_0r", args, 2)); \
- }
-
-REF_GEN0(frame_ref, frame)
-REF_GEN0(locsig_ref, locsig)
-REF_GEN0(locsig_reverb_ref, locsig)
-
-
-#define SET_GEN0(Name, SName) \
- static void Name ## _0r(int *args, ptree *pt) {mus_ ## Name (CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);} \
- static void Name ## _ir(int *args, ptree *pt) {mus_ ## Name (CLM_ARG_1, INT_ARG_2, (mus_float_t)(INT_ARG_3));} \
- static xen_value * Name ## _2(ptree *prog, xen_value **args, int num_args) \
- { \
- if (args[3]->type == R_FLOAT) \
- return(package(prog, R_FLOAT, Name ## _0r, #Name "_0r", args, 3)); \
- return(package(prog, R_FLOAT, Name ## _ir, #Name "_ir", args, 3)); \
- } \
- static void Name ## _1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v) \
- { \
- add_triple_to_ptree(prog, va_make_triple( Name ## _0r, #Name "_0r", 4, NULL, in_v, in_v1, v)); \
- }
-
-SET_GEN0(frame_set, frame)
-/* often preceded by (set:)add_f2 all_pass_1f (ref):add_multiply_i2 vector_ref_c */
-SET_GEN0(locsig_set, locsig)
-SET_GEN0(locsig_reverb_set, locsig)
-
-
-
-/* ---------------------------------------- generic funcs ---------------------------------------- */
-
-/* formerly, the local methods for defgenerator generators were only in the generator list,
- * but if we have a function taking such args, we might need to expand the method
- * before any such gen has been created. To call the method in Scheme (via call_get_method
- * in clm2xen.c) requires that the original gen list be saved alongside the list as read
- * by xen_to_list_with_type, then if another arg exists, xenify it and pass into Scheme.
- * But this will surely involve the GC and requires elaborate error checking here.
- * So, the local methods are now in the defgenerator declaration, and are
- * accessible through <name>-methods. We can assume that we have the type;
- * the method expansion (via lambda_form) uses the passed-in arg types.
- */
-
-typedef enum {USE_SET_METHOD, USE_GET_METHOD} method_choice_t;
-
-static xen_value *clean_up(xen_value *result, xen_value **args, int args_size);
-
-static xen_value *splice_in_function_body(ptree *prog, s7_pointer proc, xen_value **args, int num_args, const char *funcname)
-{
- s7_pointer func_form;
- func_form = s7_car(s7_procedure_source(s7, proc));
- /* fprintf(stderr,"splice in %s\n", s7_object_to_c_string(s7, func_form)); */
-
- if ((s7_is_list(s7, func_form)) &&
- (s7_is_symbol(s7_car(func_form))) &&
- (strncmp("lambda", s7_symbol_name(s7_car(func_form)), 6) == 0)) /* might be lambda* */
- {
- /* look for procedure source, use current arg types as auto-declaration */
- bool old_got_lambda;
- xen_value *v;
- old_got_lambda = prog->got_lambda;
- prog->got_lambda = true;
- v = lambda_form(prog, func_form, true, args, num_args, proc);
- prog->got_lambda = old_got_lambda;
- if (v)
- {
- xen_value *result;
- if (funcname) add_var_to_ptree(prog, funcname, v);
- result = funcall_n(prog, args, num_args, v);
- free(v);
- /* return(clean_up(result, args, num_args)); */
- return(result);
- }
- }
- return(NULL); /* not an error */
-}
-
-
-static xen_value *splice_in_method(ptree *prog, xen_value **args, int num_args, const char *method_name, method_choice_t use_getter)
-{
- s7_pointer methods, pair;
- int methods_loc;
- char *method_str;
- xen_value *result = NULL;
-
- /* fprintf(stderr, "splice in method %s (%s)\n", method_name, (use_getter == USE_GET_METHOD) ? "getter" : "setter"); */
-
- method_str = mus_format("%s-methods", type_name(args[1]->type));
- methods = s7_call(s7, s7_name_to_value(s7, method_str), xen_nil);
- methods_loc = s7_gc_protect(s7, methods);
- free(method_str);
-
- /* fprintf(stderr, "methods: %s\n", s7_object_to_c_string(s7, methods)); */
-
- if (s7_is_list(s7, methods))
- {
- pair = s7_assoc(s7, s7_make_symbol(s7, method_name),
- methods);
- if (s7_is_list(s7, pair))
- {
- if (use_getter == USE_GET_METHOD)
- {
- if (s7_is_procedure_with_setter(scheme_cadr(pair)))
- result = splice_in_function_body(prog, s7_procedure_with_setter_getter(scheme_cadr(pair)), args, num_args, NULL);
- else result = splice_in_function_body(prog, scheme_cadr(pair), args, num_args, NULL);
- }
- else
- {
- if (s7_is_procedure_with_setter(scheme_cadr(pair)))
- result = splice_in_function_body(prog, s7_procedure_with_setter_setter(scheme_cadr(pair)), args, num_args, NULL);
- else result = splice_in_function_body(prog, scheme_caddr(pair), args, num_args, NULL);
- }
- }
- }
-
- s7_gc_unprotect_at(s7, methods_loc);
- return(result);
-}
-
-
-static void splice_in_set_method(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v, const char *method_name)
-{
- xen_value *args[3];
- xen_value *tmp;
- args[1] = in_v;
- args[2] = v;
- tmp = splice_in_method(prog, args, 2, method_name, USE_SET_METHOD);
- if (tmp) free(tmp);
-}
-
-
-/* (let ((hi (make-rxycos 440.0))) (run (lambda () (mus-scaler hi)))) */
-/* (let ((gen (make-nssb 440)) (x 0.0)) (run (lambda () (set! x (mus-frequency gen)) x))) */
-
-#define GEN0(Name) \
- static void Name ## _0f(int *args, ptree *pt) {FLOAT_RESULT = mus_ ## Name (CLM_ARG_1);} \
- static xen_value * mus_ ## Name ## _0(ptree *prog, xen_value **args, int num_args) \
- { \
- if (args[1]->type == R_CLM) return(package(prog, R_FLOAT, Name ## _0f, #Name "_0f", args, 1)); \
- if (CLM_STRUCT_P(args[1]->type)) {return(splice_in_method(prog, args, num_args, "mus-" #Name, USE_GET_METHOD));} \
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_CONSTANT)); \
- }
-
-GEN0(increment)
-GEN0(frequency)
-GEN0(phase)
-GEN0(scaler)
-GEN0(width)
-GEN0(offset)
-GEN0(feedforward)
-GEN0(feedback)
-
-
-#define INT_GEN0(Name) \
- static void Name ## _0i(int *args, ptree *pt) {INT_RESULT = mus_ ## Name (CLM_ARG_1);} \
- static xen_value * mus_ ## Name ## _0(ptree *prog, xen_value **args, int num_args) \
- { \
- if (args[1]->type == R_CLM) return(package(prog, R_INT, Name ## _0i, #Name "_0i", args, 1)); \
- if (CLM_STRUCT_P(args[1]->type)) {return(splice_in_method(prog, args, num_args, "mus-" #Name, USE_GET_METHOD));} \
- return(make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT)); \
- }
-
-INT_GEN0(hop)
-INT_GEN0(location)
-INT_GEN0(ramp)
-INT_GEN0(order)
-INT_GEN0(length)
-INT_GEN0(channel)
-INT_GEN0(safety)
-
-
-/* set methods have two (3?) args: (lambda (g val)...) so splice in method with args built on the spot */
-
-#define SET_INT_GEN0(Name) \
- static void set_ ## Name ## _i(int *args, ptree *pt) {mus_set_ ## Name (CLM_RESULT, INT_ARG_1);} \
- static void mus_set_ ## Name ## _1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v) \
- { \
- if (in_v->type == R_CLM) \
- add_triple_to_ptree(prog, va_make_triple(set_ ## Name ## _i, "set_" #Name "_i", 2, in_v, v)); \
- else \
- { \
- if (CLM_STRUCT_P(in_v->type)) \
- splice_in_set_method(prog, in_v, in_v1, in_v2, v, "mus-" #Name); \
- } \
- }
-
-SET_INT_GEN0(location)
-SET_INT_GEN0(ramp)
-SET_INT_GEN0(hop)
-SET_INT_GEN0(length)
-SET_INT_GEN0(safety)
-
-
-#define SET_DBL_GEN0(Name) \
- static void set_ ## Name ## _f(int *args, ptree *pt) {mus_set_ ## Name (CLM_RESULT, FLOAT_ARG_1);} \
- static void mus_set_ ## Name ## _1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v) \
- { \
- if (in_v->type == R_CLM) \
- add_triple_to_ptree(prog, va_make_triple(set_ ## Name ## _f, "set_" #Name "_f", 2, in_v, v)); \
- else \
- { \
- if (CLM_STRUCT_P(in_v->type)) \
- splice_in_set_method(prog, in_v, in_v1, in_v2, v, "mus-" #Name); \
- } \
- }
-
-SET_DBL_GEN0(increment)
-SET_DBL_GEN0(scaler)
-SET_DBL_GEN0(offset)
-SET_DBL_GEN0(width)
-SET_DBL_GEN0(feedback)
-SET_DBL_GEN0(feedforward)
-SET_DBL_GEN0(phase)
-SET_DBL_GEN0(frequency)
-
-
-#define STR_GEN0(Name) \
- static void Name ## _0s(int *args, ptree *pt) \
- { \
- if (STRING_RESULT) free(STRING_RESULT); \
- STRING_RESULT = mus_strdup(mus_ ## Name (CLM_ARG_1)); \
- } \
- static xen_value * mus_ ## Name ## _0(ptree *prog, xen_value **args, int num_args) \
- { \
- if (args[1]->type == R_CLM) return(package(prog, R_STRING, Name ## _0s, #Name "_0s", args, 1)); \
- if (CLM_STRUCT_P(args[1]->type)) {return(splice_in_method(prog, args, num_args, "mus-" #Name, USE_GET_METHOD));} \
- return(make_xen_value(R_STRING, add_string_to_ptree(prog, NULL), R_CONSTANT)); \
- }
-
-STR_GEN0(name)
-STR_GEN0(describe)
-STR_GEN0(file_name)
-
-
-static void set_name_s(int *args, ptree *pt) {mus_set_name(CLM_RESULT, STRING_ARG_1);}
-
-static void mus_set_name_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- if (in_v->type == R_CLM)
- add_triple_to_ptree(prog, va_make_triple(set_name_s, "set_name_s", 2, in_v, v));
- else
- {
- /* currently this doesn't work because the defgenerator set method uses stuff like set-car! */
- if (CLM_STRUCT_P(in_v->type))
- splice_in_set_method(prog, in_v, in_v1, in_v2, v, "mus-name");
- }
-}
-
-
-
-/* -------- mus-channels --------
- *
- * this is special because *output* can be a vct or sound-data object
- */
-
-static void mus_channels_i(int *args, ptree *pt) {INT_RESULT = mus_channels(CLM_ARG_1);}
-
-static void mus_channels_v(int *args, ptree *pt) {INT_RESULT = 1;}
-
-static void mus_channels_f(int *args, ptree *pt) {INT_RESULT = 0;}
-
-static void mus_channels_s(int *args, ptree *pt) {INT_RESULT = SOUND_DATA_ARG_1->chans;}
-
-
-static xen_value *mus_channels_0(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_CLM)
- return(package(prog, R_INT, mus_channels_i, "mus_channels", args, 1));
- if (args[1]->type == R_VCT)
- return(package(prog, R_INT, mus_channels_v, "mus_channels_vct", args, 1));
- if (args[1]->type == R_SOUND_DATA)
- return(package(prog, R_INT, mus_channels_s, "mus_channels_sound_data", args, 1));
- if (CLM_STRUCT_P(args[1]->type))
- return(splice_in_method(prog, args, num_args, "mus-channels", USE_GET_METHOD));
- return(package(prog, R_INT, mus_channels_f, "mus_channels_f", args, 1));
-}
-
-
-static void close_0(int *args, ptree *pt) {INT_RESULT = mus_close_file(CLM_ARG_1);}
-
-static void close_0_noop(int *args, ptree *pt) {INT_RESULT = 0;}
-
-static xen_value *mus_close_0(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_CLM)
- return(package(prog, R_INT, close_0, "mus_close_0", args, 1));
- if (CLM_STRUCT_P(args[1]->type))
- return(splice_in_method(prog, args, num_args, "mus-close", USE_GET_METHOD));
- return(package(prog, R_INT, close_0_noop, "mus_close_0_noop", args, 1));
-}
-
-
-static void reset_0(int *args, ptree *pt) {mus_reset(CLM_ARG_1);}
-
-static xen_value *mus_reset_0(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_CLM)
- return(package(prog, R_CLM, reset_0, "mus_reset_0", args, 1));
- if (CLM_STRUCT_P(args[1]->type))
- return(splice_in_method(prog, args, num_args, "mus-reset", USE_GET_METHOD));
- return(make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT));
-}
-
-
-static void set_formant_radius_and_frequency_2f(int *args, ptree *pt)
-{
- mus_set_formant_radius_and_frequency(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);
-}
-
-static xen_value *set_formant_radius_and_frequency_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[2]->type == R_INT) single_to_float(prog, args, 2);
- if (args[3]->type == R_INT) single_to_float(prog, args, 3);
- return(package(prog, R_BOOL, set_formant_radius_and_frequency_2f, "mus_set_formant_radius_and_frequency_2f", args, 3));
-}
-
-
-static void mus_run_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_run(CLM_ARG_1, 0.0, 0.0);}
-static void mus_run_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_run(CLM_ARG_1, FLOAT_ARG_2, 0.0);}
-static void mus_run_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_run(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static xen_value *mus_run_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_CLM)
- {
- if (num_args == 1)
- return(package(prog, R_FLOAT, mus_run_0f, "mus_run_0f", args, 1));
- if (args[2]->type == R_INT) single_to_float(prog, args, 2);
- if (num_args == 2)
- return(package(prog, R_FLOAT, mus_run_1f, "mus_run_1f", args, 2));
- if (args[3]->type == R_INT) single_to_float(prog, args, 3);
- return(package(prog, R_FLOAT, mus_run_2f, "mus_run_2f", args, 3));
- }
- return(splice_in_method(prog, args, num_args, S_mus_run, USE_GET_METHOD));
-}
-
-
-/* ---------------- xcoeff/ycoeff ---------------- */
-
-
-static void xcoeff_0(int *args, ptree *pt) {FLOAT_RESULT = mus_xcoeff(CLM_ARG_1, INT_ARG_2);}
-
-static xen_value *mus_xcoeff_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_CLM)
- return(package(prog, R_FLOAT, xcoeff_0, "xcoeff_0", args, 2));
- if (CLM_STRUCT_P(args[1]->type))
- return(splice_in_method(prog, args, num_args, "mus-xcoeff", USE_GET_METHOD));
- return(make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT));
-}
-
-
-static void set_xcoeff_0(int *args, ptree *pt) {mus_set_xcoeff(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-
-static void mus_set_xcoeff_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- add_triple_to_ptree(prog, va_make_triple(set_xcoeff_0, "set_xcoeff_0", 4, NULL, in_v, in_v1, v));
-}
-
-
-static void ycoeff_0(int *args, ptree *pt) {FLOAT_RESULT = mus_ycoeff(CLM_ARG_1, INT_ARG_2);}
-
-static xen_value *mus_ycoeff_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_CLM)
- return(package(prog, R_FLOAT, ycoeff_0, "ycoeff_0", args, 2));
- if (CLM_STRUCT_P(args[1]->type))
- return(splice_in_method(prog, args, num_args, "mus-ycoeff", USE_GET_METHOD));
- return(make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_CONSTANT));
-}
-
-
-static void set_ycoeff_0(int *args, ptree *pt) {mus_set_ycoeff(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-
-static void mus_set_ycoeff_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- add_triple_to_ptree(prog, va_make_triple(set_ycoeff_0, "set_ycoeff_0", 4, NULL, in_v, in_v1, v));
-}
-
-
-/* ---------------- mus-data, xcoeffs, ycoeffs ---------------- */
-
-#define MUS_VCT_1(Name, Position) \
-static void Name ## _1(int *args, ptree *pt) \
-{ \
- if (!VCT_RESULT) \
- { \
- s7_pointer res; \
- res = xen_make_vct_wrapper(mus_length(CLM_ARG_1), mus_ ## Name (CLM_ARG_1)); \
- add_loc_to_protected_list(pt, s7_gc_protect(s7, res)); \
- VCT_RESULT = xen_to_vct(res); \
- } \
-} \
-static xen_value *mus_ ## Name ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- if (args[1]->type == R_CLM) \
- return(package(prog, R_VCT, Name ## _1, #Name "_1", args, 1)); \
- if (CLM_STRUCT_P(args[1]->type)) \
- return(splice_in_method(prog, args, num_args, "mus-" #Name, USE_GET_METHOD)); \
- return(run_warn("wrong type arg (%s) to mus-" #Name , type_name(args[1]->type))); \
-}
-
-/* (let ((gen (make-polyoid 100.0 (vct 1 1 0.0)))) (run (lambda () (mus-ycoeffs gen)))) */
-
-MUS_VCT_1(data, 0)
-MUS_VCT_1(xcoeffs, 1)
-MUS_VCT_1(ycoeffs, 2)
-
-
-
-/* ---------------- polynomial ---------------- */
-
-
-static void polynomial_1f(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_polynomial(VCT_ARG_1->data, FLOAT_ARG_2, VCT_ARG_1->length);
-}
-
-static xen_value *polynomial_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, polynomial_1f, "polynomial_1f", args, 2));
-}
-
-
-
-/* ---------------- mus-fft ---------------- */
-
-
-static void mus_fft_2v(int *args, ptree *pt)
-{
- mus_fft(VCT_ARG_1->data, VCT_ARG_2->data, VCT_ARG_1->length, 1);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static void mus_fft_2v_1(int *args, ptree *pt)
-{
- mus_fft(VCT_ARG_1->data, VCT_ARG_2->data, INT_ARG_3, 1);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static void mus_fft_2v_2(int *args, ptree *pt)
-{
- mus_fft(VCT_ARG_1->data, VCT_ARG_2->data, INT_ARG_3, INT_ARG_4);
- VCT_RESULT = VCT_ARG_1;
-}
-
-static xen_value *mus_fft_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2) return(package(prog, R_VCT, mus_fft_2v, "mus_fft_2v", args, 2));
- if (num_args == 3) return(package(prog, R_VCT, mus_fft_2v_1, "mus_fft_2v_1", args, 3));
- return(package(prog, R_VCT, mus_fft_2v_2, "mus_fft_2v_2", args, 4));
-}
-
-
-/* ----------------fft ---------------- */
-
-
-static void fft_2v(int *args, ptree *pt)
-{
- mus_fft(VCT_ARG_1->data, VCT_ARG_2->data, VCT_ARG_1->length, 1);
- VCT_RESULT = VCT_ARG_1;
-}
-
-static void fft_2v_1(int *args, ptree *pt)
-{
- mus_fft(VCT_ARG_1->data, VCT_ARG_2->data, VCT_ARG_1->length, INT_ARG_3);
- VCT_RESULT = VCT_ARG_1;
-}
-
-static xen_value *fft_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2) return(package(prog, R_VCT, fft_2v, "fft_2v", args, 2));
- return(package(prog, R_VCT, fft_2v_1, "fft_2v_1", args, 3));
-}
-
-
-/* ---------------- file->sample ---------------- */
-
-static void file_to_sample_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_file_to_sample(CLM_ARG_1, INT_ARG_2, 0);}
-
-static void file_to_sample_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_file_to_sample(CLM_ARG_1, INT_ARG_2, INT_ARG_3);}
-
-static xen_value *file_to_sample_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2) return(package(prog, R_FLOAT, file_to_sample_1f, "file_to_sample_1f", args, 2));
- return(package(prog, R_FLOAT, file_to_sample_2f, "file_to_sample_2f", args, 3));
-}
-
-
-#if USE_SND
-/* ---------------- snd->sample ---------------- */
-
-static void snd_to_sample_1f(int *args, ptree *pt) {FLOAT_RESULT = snd_to_sample_read(CLM_ARG_1, INT_ARG_2, 0);}
-
-static void snd_to_sample_2f(int *args, ptree *pt) {FLOAT_RESULT = snd_to_sample_read(CLM_ARG_1, INT_ARG_2, INT_ARG_3);}
-
-static xen_value *snd_to_sample_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2) return(package(prog, R_FLOAT, snd_to_sample_1f, "snd_to_sample_1f", args, 2));
- return(package(prog, R_FLOAT, snd_to_sample_2f, "snd_to_sample_2f", args, 3));
-}
-
-
-static void snd_to_sample_0p(int *args, ptree *pt) {BOOL_RESULT = (Int)snd_to_sample_p(CLM_ARG_1);}
-
-static xen_value *snd_to_sample_1p(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, snd_to_sample_0p, "snd_to_sample_0p", args, 1));
-}
-#endif
-
-
-
-/* ---------------- sample->file ---------------- */
-
-static void sample_to_file_4(int *args, ptree *pt) {FLOAT_RESULT = mus_sample_to_file(CLM_ARG_1, INT_ARG_2, INT_ARG_3, FLOAT_ARG_4);}
-
-static xen_value *sample_to_file_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, sample_to_file_4, "sample_to_file_4", args, 4));
-}
-
-
-/* ---------------- locsig ---------------- */
-
-static void locsig_3(int *args, ptree *pt)
-{
- mus_xen *gn;
- gn = (mus_xen *)mus_locsig_closure(CLM_ARG_1); /* skip the gen check in mus_environ */
- if (!gn)
- FLOAT_RESULT = mus_locsig(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);
- else
- {
- mus_locsig(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);
- /* now parcel out results based on gn->vcts state and mus_locsig_outf|revf */
- FLOAT_RESULT = mus_locsig_or_move_sound_to_vct_or_sound_data(gn, CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3, true);
- }
-}
-
-
-static void locsig_3f(int *args, ptree *pt) {mus_locsig(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-
-static void locsig_3f_mono_no_rev(int *args, ptree *pt) {mus_locsig_mono_no_reverb (CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-static void locsig_3f_mono(int *args, ptree *pt) {mus_locsig_mono (CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-static void locsig_3f_stereo_no_rev(int *args, ptree *pt) {mus_locsig_stereo_no_reverb (CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-static void locsig_3f_stereo(int *args, ptree *pt) {mus_locsig_stereo (CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-static void locsig_3f_safe_mono_no_rev(int *args, ptree *pt) {mus_locsig_safe_mono_no_reverb (CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-static void locsig_3f_safe_mono(int *args, ptree *pt) {mus_locsig_safe_mono (CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-static void locsig_3f_safe_stereo_no_rev(int *args, ptree *pt) {mus_locsig_safe_stereo_no_reverb(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-static void locsig_3f_safe_stereo(int *args, ptree *pt) {mus_locsig_safe_stereo (CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);}
-
-static void locsig_v_mono_no_rev(int *args, ptree *pt)
-{
- mus_locsig_mono_no_reverb(CLM_ARG_5, INT_ARG_6, FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3));
-}
-
-static void locsig_v_mono(int *args, ptree *pt)
-{
- mus_locsig_mono(CLM_ARG_5, INT_ARG_6, FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3));
-}
-
-static void locsig_v_stereo_no_rev(int *args, ptree *pt)
-{
- mus_locsig_stereo_no_reverb(CLM_ARG_5, INT_ARG_6, FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3));
-}
-
-static void locsig_v_stereo(int *args, ptree *pt)
-{
- mus_locsig_stereo(CLM_ARG_5, INT_ARG_6, FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3));
-}
-
-static void locsig_v_safe_mono_no_rev(int *args, ptree *pt)
-{
- mus_locsig_safe_mono_no_reverb(CLM_ARG_5, INT_ARG_6, FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3));
-}
-
-static void locsig_v_safe_mono(int *args, ptree *pt)
-{
- mus_locsig_safe_mono(CLM_ARG_5, INT_ARG_6, FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3));
-}
-
-static void locsig_v_safe_stereo_no_rev(int *args, ptree *pt)
-{
- mus_locsig_safe_stereo_no_reverb(CLM_ARG_5, INT_ARG_6, FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3));
-}
-
-static void locsig_v_safe_stereo(int *args, ptree *pt)
-{
- mus_locsig_safe_stereo(CLM_ARG_5, INT_ARG_6, FLOAT_ARG_4 * mus_oscil_fm(CLM_ARG_1, FLOAT_ARG_2 + FLOAT_ARG_3));
-}
-
-
-static xen_value *locsig_1(ptree *prog, xen_value **args, int num_args)
-{
- /* choose output func based on the locsig output and reverb fields */
-
- if ((args[1]->type == R_CLM) &&
- (mus_locsig_p(prog->clms[args[1]->addr])) &&
- (prog->walk_result == DONT_NEED_RESULT))
- {
- mus_any *g;
- mus_xen *gn;
- g = prog->clms[args[1]->addr];
- gn = (mus_xen *)mus_locsig_closure(g); /* same as mus_environ(g) but skip the gen check in mus_environ */
- if (!gn)
- {
- bool direct;
- /* locsig "environ" not set (clm2xen.c) so there's nothing special about the outputs */
- direct = (mus_locsig_safety(g) == 1);
-
- /* oscil_1f_2_mult|env (5) (fmv), multiply_f3(4) f2(3), add_f4(5) f3(4) f2(3), = 48 procs! */
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->args[0] == args[3]->addr) &&
- (prev_op->function == oscil_1f_2_mult) &&
- (mus_locsig_channels(g) <= 2) &&
- (mus_locsig_reverb_channels(g) <= 1) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- /* an experiment */
-
- prev_op->types = (int *)realloc(prev_op->types, 7 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 7 * sizeof(int));
- prev_op->num_args = 7;
- prev_op->types[5] = R_CLM;
- prev_op->args[5] = args[1]->addr;
- prev_op->types[6] = R_INT;
- prev_op->args[6] = args[2]->addr;
-
- if (mus_locsig_channels(g) == 1)
- {
- if (mus_locsig_reverb_channels(g) == 0)
- {
- prev_op->function = (direct) ? locsig_v_safe_mono_no_rev : locsig_v_mono_no_rev;
- prev_op->op_name = (direct) ? "locsig_v_safe_mono_no_rev" : "locsig_v_mono_no_rev";
- }
- else
- {
- prev_op->function = (direct) ? locsig_v_safe_mono : locsig_v_mono;
- prev_op->op_name = (direct) ? "locsig_v_safe_mono" : "locsig_v_mono";
- }
- }
- else
- {
- if (mus_locsig_reverb_channels(g) == 0)
- {
- prev_op->function = (direct) ? locsig_v_safe_stereo_no_rev : locsig_v_stereo_no_rev;
- prev_op->op_name = (direct) ? "locsig_v_safe_stereo_no_rev" : "locsig_v_stereo_no_rev";
- }
- else
- {
- prev_op->function = (direct) ? locsig_v_safe_stereo : locsig_v_stereo;
- prev_op->op_name = (direct) ? "locsig_v_safe_stereo" : "locsig_v_stereo";
- }
- }
-
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- }
-
- if (mus_locsig_channels(g) == 1)
- {
- if (mus_locsig_reverb_channels(g) == 0)
- return(package(prog, R_FLOAT,
- (direct) ? locsig_3f_safe_mono_no_rev : locsig_3f_mono_no_rev,
- (direct) ? "locsig_3f_safe_mono_no_rev" : "locsig_3f_mono_no_rev", args, 3));
- if (mus_locsig_reverb_channels(g) == 1)
- return(package(prog, R_FLOAT,
- (direct) ? locsig_3f_safe_mono : locsig_3f_mono,
- (direct) ? "locsig_3f_safe_mono" : "locsig_3f_mono", args, 3));
- }
- else
- {
- if (mus_locsig_channels(g) == 2)
- {
- if (mus_locsig_reverb_channels(g) == 0)
- return(package(prog, R_FLOAT,
- (direct) ? locsig_3f_safe_stereo_no_rev : locsig_3f_stereo_no_rev,
- (direct) ? "locsig_3f_safe_stereo_no_rev" : "locsig_3f_stereo_no_rev", args, 3));
- if (mus_locsig_reverb_channels(g) == 1)
- return(package(prog, R_FLOAT,
- (direct) ? locsig_3f_safe_stereo : locsig_3f_stereo,
- (direct) ? "locsig_3f_safe_stereo" : "locsig_3f_stereo", args, 3));
- }
- }
- return(package(prog, R_FLOAT, locsig_3f, "locsig_3f", args, 3));
- }
- }
- return(package(prog, R_FLOAT, locsig_3, "locsig_3", args, 3));
-}
-
-
-/* ---------------- move_sound ---------------- */
-
-static void move_sound_3(int *args, ptree *pt)
-{
- mus_xen *gn;
- gn = (mus_xen *)mus_move_sound_closure(CLM_ARG_1); /* skip the gen check in mus_environ */
- if (!gn)
- FLOAT_RESULT = mus_move_sound(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);
- else
- {
- mus_move_sound(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3);
- FLOAT_RESULT = mus_locsig_or_move_sound_to_vct_or_sound_data(gn, CLM_ARG_1, INT_ARG_2, FLOAT_ARG_3, false);
- }
-}
-
-static xen_value *move_sound_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, move_sound_3, "move_sound_3", args, 3));
-}
-
-
-/* ---------------- env-interp ---------------- */
-
-static void env_interp_2(int *args, ptree *pt) {FLOAT_RESULT = mus_env_interp(FLOAT_ARG_1, CLM_ARG_2);}
-
-static xen_value *env_interp_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, env_interp_2, "env_interp_2", args, 2));
-}
-
-
-/* ---------------- env-any ---------------- */
-
-#if (!HAVE_NESTED_FUNCTIONS) || __cplusplus
-static ptree *env_any_outer_pt, *env_any_connect_pt;
-
-static mus_float_t env_any_connect(mus_float_t y)
-{
- ptree *outer, *inner;
- mus_float_t result;
-
- outer = env_any_outer_pt;
- inner = env_any_connect_pt;
-
- outer->dbls[inner->args[0]] = y;
- eval_embedded_ptree(inner, outer);
-
- env_any_outer_pt = outer;
- env_any_connect_pt = inner;
-
- result = outer->dbls[inner->result->addr];
-
- return(result);
-}
-
-
-static void env_any_2(int *args, ptree *pt)
-{
- env_any_outer_pt = pt;
- env_any_connect_pt = FNC_ARG_2;
- FLOAT_RESULT = mus_env_any(CLM_ARG_1, env_any_connect);
-}
-
-#else
-
-static void env_any_2(int *args, ptree *pt)
-{
- auto mus_float_t env_any_connect(mus_float_t y); /* see comment in clm2xen */
- mus_float_t env_any_connect(mus_float_t y)
- {
- pt->dbls[FNC_ARG_2->args[0]] = y;
- eval_embedded_ptree(FNC_ARG_2, pt);
- return(pt->dbls[FNC_ARG_2->result->addr]);
- }
-
- FLOAT_RESULT = mus_env_any(CLM_ARG_1, env_any_connect);
-}
-
-#endif
-
-
-static xen_value *env_any_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, env_any_2, "env_any_2", args, 2));
-}
-
-
-/* ---------------- frame+ etc ---------------- */
-
-#define FRAME_OP(CName, SName, cfName) \
-static void CName ## _2cc(int *args, ptree *pt) {if (CLM_RESULT) mus_free(CLM_RESULT); CLM_RESULT = CName(CLM_ARG_1, CLM_ARG_2, NULL);} \
-static void CName ## _2cf(int *args, ptree *pt) {if (CLM_RESULT) mus_free(CLM_RESULT); CLM_RESULT = cfName(CLM_ARG_1, FLOAT_ARG_2, NULL);} \
-static void CName ## _2fc(int *args, ptree *pt) {if (CLM_RESULT) mus_free(CLM_RESULT); CLM_RESULT = cfName(CLM_ARG_2, FLOAT_ARG_1, NULL);} \
-static void CName ## _3cc(int *args, ptree *pt) {CLM_RESULT = CName(CLM_ARG_1, CLM_ARG_2, CLM_ARG_3);} \
-static void CName ## _3cf(int *args, ptree *pt) {CLM_RESULT = cfName(CLM_ARG_1, FLOAT_ARG_2, CLM_ARG_3);} \
-static void CName ## _3fc(int *args, ptree *pt) {CLM_RESULT = cfName(CLM_ARG_2, FLOAT_ARG_1, CLM_ARG_3);} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- xen_value *temp; \
- if (args[1]->type == R_INT) {temp = args[1]; args[1] = convert_int_to_dbl(prog, args[1]); free(temp);} \
- if (args[2]->type == R_INT) {temp = args[2]; args[2] = convert_int_to_dbl(prog, args[2]); free(temp);} \
- if (args[1]->type == R_FLOAT) \
- { \
- if (args[2]->type == R_FLOAT) return(run_warn("no mixer or frame passed to " #SName)); \
- if (num_args == 2) \
- return(package(prog, R_CLM, CName ## _2fc, #CName "_2fc", args, 2)); \
- return(package(prog, R_CLM, CName ## _3fc, #CName "_3fc", args, 3)); \
- } \
- if (args[2]->type == R_FLOAT) \
- { \
- if (num_args == 2) \
- return(package(prog, R_CLM, CName ## _2cf, #CName "_2cf", args, 2)); \
- return(package(prog, R_CLM, CName ## _3cf, #CName "_3cf", args, 3)); \
- } \
- if (num_args == 2) \
- return(package(prog, R_CLM, CName ## _2cc, #CName "_2cc", args, 2)); \
- return(package(prog, R_CLM, CName ## _3cc, #CName "_3cc", args, 3)); \
-}
-
-FRAME_OP(mus_frame_add, frame+, mus_frame_offset)
-FRAME_OP(mus_frame_multiply, frame*, mus_frame_scale)
-FRAME_OP(mus_mixer_multiply, mixer*, mus_mixer_scale)
-FRAME_OP(mus_mixer_add, mixer+, mus_mixer_offset)
-
-
-static void frame_v(int *args, ptree *pt)
-{
- int i;
- mus_any *v;
- if (CLM_RESULT) {mus_free(CLM_RESULT); CLM_RESULT = NULL;}
- v = mus_make_frame(INT_ARG_1);
- for (i = 0; i < INT_ARG_1; i++)
- mus_frame_set(v, i, pt->dbls[args[i + 2]]);
- CLM_RESULT = v;
-}
-
-
-static xen_value *frame_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *rtn;
- float_all_args(prog, num_args, args, true);
- rtn = package_n(prog, R_CLM, frame_v, "frame_v", args, num_args);
- add_obj_to_gcs(prog, R_CLM, rtn->addr);
- return(rtn);
-}
-
-
-static void mixer_v(int *args, ptree *pt)
-{
- int len;
- mus_any *v;
- if (CLM_RESULT) {mus_free(CLM_RESULT); CLM_RESULT = NULL;}
- len = (int)ceil(sqrt(INT_ARG_1));
- v = mus_make_empty_mixer((len == 0) ? 1 : len);
- if (len > 0)
- {
- int i, j = 0, k = 0;
- for (i = 0; i < INT_ARG_1; i++)
- {
- mus_mixer_set(v, j, k, pt->dbls[args[i + 2]]);
- k++;
- if (k == len)
- {
- j++;
- k = 0;
- }
- }
- }
- CLM_RESULT = v;
-}
-
-
-static xen_value *mixer_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *rtn;
- float_all_args(prog, num_args, args, true);
- rtn = package_n(prog, R_CLM, mixer_v, "mixer_v", args, num_args);
- add_obj_to_gcs(prog, R_CLM, rtn->addr);
- return(rtn);
-}
-
-
-
-
-/* ---------------- frame->frame ---------------- */
-
-static void frame_to_frame_2(int *args, ptree *pt)
-{
- if (CLM_RESULT) mus_free(CLM_RESULT);
- CLM_RESULT = mus_frame_to_frame(CLM_ARG_1, CLM_ARG_2, NULL);
-}
-
-static void frame_to_frame_3(int *args, ptree *pt)
-{
- CLM_RESULT = mus_frame_to_frame(CLM_ARG_1, CLM_ARG_2, CLM_ARG_3);
-}
-
-static void frame_to_frame_mono(int *args, ptree *pt)
-{
- CLM_RESULT = mus_frame_to_frame_mono(CLM_ARG_1, CLM_ARG_2, CLM_ARG_3);
-}
-
-static void frame_to_frame_mono_to_stereo(int *args, ptree *pt)
-{
- CLM_RESULT = mus_frame_to_frame_mono_to_stereo(CLM_ARG_1, CLM_ARG_2, CLM_ARG_3);
-}
-
-static void frame_to_frame_stereo(int *args, ptree *pt)
-{
- CLM_RESULT = mus_frame_to_frame_stereo(CLM_ARG_1, CLM_ARG_2, CLM_ARG_3);
-}
-
-static xen_value *frame_to_frame_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2) return(package(prog, R_CLM, frame_to_frame_2, "frame_to_frame_2", args, 2));
-
- if ((args[1]->type == R_CLM) &&
- (mus_frame_p(prog->clms[args[1]->addr])) &&
- (args[2]->type == R_CLM) &&
- (mus_mixer_p(prog->clms[args[2]->addr])) &&
- (args[3]->type == R_CLM) &&
- (mus_frame_p(prog->clms[args[3]->addr])))
- {
- if ((mus_channels(prog->clms[args[1]->addr]) == 1) &&
- (mus_channels(prog->clms[args[2]->addr]) >= 1) &&
- (mus_channels(prog->clms[args[3]->addr]) == 1))
- return(package(prog, R_CLM, frame_to_frame_mono, "frame_to_frame_mono", args, 3));
-
- if ((mus_channels(prog->clms[args[1]->addr]) == 2) &&
- (mus_channels(prog->clms[args[2]->addr]) >= 2) &&
- (mus_channels(prog->clms[args[3]->addr]) == 2))
- return(package(prog, R_CLM, frame_to_frame_stereo, "frame_to_frame_stereo", args, 3));
-
- if ((mus_channels(prog->clms[args[1]->addr]) == 1) &&
- (mus_channels(prog->clms[args[2]->addr]) >= 2) &&
- (mus_channels(prog->clms[args[3]->addr]) == 2))
- return(package(prog, R_CLM, frame_to_frame_mono_to_stereo, "frame_to_frame_mono_to_stereo", args, 3));
-
- }
-
- return(package(prog, R_CLM, frame_to_frame_3, "frame_to_frame_3", args, 3));
-}
-
-/* frame_to_frame_via_mixer chans ok, out already allocated, if 1 chan just mult etc, arg1=frame, arg2=mixer, arg3=frame */
-
-
-/* ---------------- frame->sample ---------------- */
-
-static void frame_to_sample_2(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_frame_to_sample(CLM_ARG_1, CLM_ARG_2);
-}
-
-static xen_value *frame_to_sample_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, frame_to_sample_2, "frame_to_sample_2", args, 2));
-}
-
-
-/* ---------------- sample->frame ---------------- */
-
-static void sample_to_frame_2(int *args, ptree *pt) {CLM_RESULT = mus_sample_to_frame(CLM_ARG_1, FLOAT_ARG_2, CLM_RESULT);}
-
-/* there may be a memory leak here -- how does the possibly new frame get gc'd? */
-
-static void sample_to_frame_3(int *args, ptree *pt)
-{
- CLM_RESULT = mus_sample_to_frame(CLM_ARG_1, FLOAT_ARG_2, CLM_ARG_3);
-}
-
-static xen_value *sample_to_frame_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2) return(package(prog, R_CLM, sample_to_frame_2, "sample_to_frame_2", args, 2));
- return(package(prog, R_CLM, sample_to_frame_3, "sample_to_frame_3", args, 3));
-}
-
-
-/* ---------------- frame->file ---------------- */
-
-static void frame_to_file_3(int *args, ptree *pt)
-{
- CLM_RESULT = mus_frame_to_file(CLM_ARG_1, INT_ARG_2, CLM_ARG_3);
-}
-
-static xen_value *frame_to_file_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_CLM, frame_to_file_3, "frame_to_file_3", args, 3));
-}
-
-
-/* ---------------- file->frame ---------------- */
-
-static void file_to_frame_3(int *args, ptree *pt)
-{
- CLM_RESULT = mus_file_to_frame(CLM_ARG_1, INT_ARG_2, CLM_ARG_3);
-}
-
-static void file_to_frame_2(int *args, ptree *pt)
-{
- if (CLM_RESULT) mus_free(CLM_RESULT);
- CLM_RESULT = mus_file_to_frame(CLM_ARG_1, INT_ARG_2, NULL);
-}
-
-static xen_value *file_to_frame_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2)
- return(package(prog, R_CLM, file_to_frame_2, "file_to_frame_2", args, 2));
- return(package(prog, R_CLM, file_to_frame_3, "file_to_frame_3", args, 3));
-}
-
-
-/* ---------------- out-any ---------------- */
-
-/* see env_any for R_FUNCTION as arg */
-
-static void outa_3(int *args, ptree *pt) {FLOAT_RESULT = mus_out_any(INT_ARG_1, FLOAT_ARG_2, 0, CLM_ARG_3);}
-static void outa_3f(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_2);}
-static void outa_oscil_0_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_2 * mus_oscil_unmodulated(CLM_ARG_4));}
-static void outa_add_f2(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_2 + FLOAT_ARG_4);}
-static void outa_add_f3(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_2 + FLOAT_ARG_4 + FLOAT_ARG_5);}
-static void outa_add_f4(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_2 + FLOAT_ARG_4 + FLOAT_ARG_5 + FLOAT_ARG_6);}
-static void outa_multiply_f2(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_2 * FLOAT_ARG_4);}
-static void outa_multiply_f3(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_2 * FLOAT_ARG_4 * FLOAT_ARG_5);}
-static void outa_multiply_f4(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_2 * FLOAT_ARG_4 * FLOAT_ARG_5 * FLOAT_ARG_6);}
-static void outa_oscil_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_5 * mus_oscil_fm(CLM_ARG_4, FLOAT_ARG_2));}
-static void outa_polywave_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_5 * mus_polywave(CLM_ARG_4, FLOAT_ARG_2));}
-static void outa_delay_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_5 * mus_delay_unmodulated_noz(CLM_ARG_4, FLOAT_ARG_2));}
-static void outa_add_f2_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_5 * (FLOAT_ARG_2 + FLOAT_ARG_4));}
-static void outa_add_f3_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_4 * (FLOAT_ARG_2 + FLOAT_ARG_5 + FLOAT_ARG_6));}
-static void outa_formant_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_5 * mus_formant(CLM_ARG_4, FLOAT_ARG_2));}
-static void outa_firmant_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 0, FLOAT_ARG_5 * mus_firmant(CLM_ARG_4, FLOAT_ARG_2));}
-
-static void outb_3(int *args, ptree *pt) {FLOAT_RESULT = mus_out_any(INT_ARG_1, FLOAT_ARG_2, 1, CLM_ARG_3);}
-static void outb_3f(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_2);}
-static void outb_oscil_0_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_2 * mus_oscil_unmodulated(CLM_ARG_4));}
-static void outb_add_f2(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_2 + FLOAT_ARG_4);}
-static void outb_add_f3(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_2 + FLOAT_ARG_4 + FLOAT_ARG_5);}
-static void outb_add_f4(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_2 + FLOAT_ARG_4 + FLOAT_ARG_5 + FLOAT_ARG_6);}
-static void outb_multiply_f2(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_2 * FLOAT_ARG_4);}
-static void outb_multiply_f3(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_2 * FLOAT_ARG_4 * FLOAT_ARG_5);}
-static void outb_multiply_f4(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_2 * FLOAT_ARG_4 * FLOAT_ARG_5 * FLOAT_ARG_6);}
-static void outb_oscil_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_5 * mus_oscil_fm(CLM_ARG_4, FLOAT_ARG_2));}
-static void outb_polywave_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_5 * mus_polywave(CLM_ARG_4, FLOAT_ARG_2));}
-static void outb_delay_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_5 * mus_delay_unmodulated_noz(CLM_ARG_4, FLOAT_ARG_2));}
-static void outb_add_f2_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_5 * (FLOAT_ARG_2 + FLOAT_ARG_4));}
-static void outb_add_f3_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_4 * (FLOAT_ARG_2 + FLOAT_ARG_5 + FLOAT_ARG_6));}
-static void outb_formant_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_5 * mus_formant(CLM_ARG_4, FLOAT_ARG_2));}
-static void outb_firmant_1_mult(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 1, FLOAT_ARG_5 * mus_firmant(CLM_ARG_4, FLOAT_ARG_2));}
-
-static void outc_3(int *args, ptree *pt) {FLOAT_RESULT = mus_out_any(INT_ARG_1, FLOAT_ARG_2, 2, CLM_ARG_3);}
-static void outc_3f(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 2, FLOAT_ARG_2);}
-
-static void outd_3(int *args, ptree *pt) {FLOAT_RESULT = mus_out_any(INT_ARG_1, FLOAT_ARG_2, 3, CLM_ARG_3);}
-static void outd_3f(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_3, INT_ARG_1, 3, FLOAT_ARG_2);}
-
-static void out_any_4(int *args, ptree *pt) {FLOAT_RESULT = mus_out_any(INT_ARG_1, FLOAT_ARG_2, INT_ARG_3, CLM_ARG_4);}
-static void out_any_4f(int *args, ptree *pt) {mus_out_any_to_file(CLM_ARG_4, INT_ARG_1, INT_ARG_3, FLOAT_ARG_2);}
-
-
-static void out_f_3(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2;}
-
-static void out_any_f_4(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2;}
-
-
-static mus_float_t call_out_any_function(ptree *pt, Int loc, mus_float_t val, Int chan, ptree *function)
-{
- pt->ints[function->args[0]] = loc;
- pt->dbls[function->args[1]] = val;
- pt->ints[function->args[2]] = chan;
- eval_embedded_ptree(function, pt);
- return(pt->dbls[function->result->addr]);
-}
-
-static void outa_function_3(int *args, ptree *pt)
-{
- FLOAT_RESULT = call_out_any_function(pt, INT_ARG_1, FLOAT_ARG_2, 0, FNC_ARG_3);
-}
-
-static void outb_function_3(int *args, ptree *pt)
-{
- FLOAT_RESULT = call_out_any_function(pt, INT_ARG_1, FLOAT_ARG_2, 1, FNC_ARG_3);
-}
-
-static void outc_function_3(int *args, ptree *pt)
-{
- FLOAT_RESULT = call_out_any_function(pt, INT_ARG_1, FLOAT_ARG_2, 2, FNC_ARG_3);
-}
-
-static void outd_function_3(int *args, ptree *pt)
-{
- FLOAT_RESULT = call_out_any_function(pt, INT_ARG_1, FLOAT_ARG_2, 3, FNC_ARG_3);
-}
-
-static void out_any_function_4(int *args, ptree *pt)
-{
- FLOAT_RESULT = call_out_any_function(pt, INT_ARG_1, FLOAT_ARG_2, INT_ARG_3, FNC_ARG_4);
-}
-
-
-static void out_vct_3(int *args, ptree *pt)
-{
- if ((INT_ARG_1 < VCT_ARG_3->length) && (INT_ARG_1 >= 0))
- VCT_ARG_3->data[INT_ARG_1] += FLOAT_ARG_2;
- FLOAT_RESULT = FLOAT_ARG_2;
-}
-
-static void out_any_vct_4(int *args, ptree *pt)
-{
- if ((INT_ARG_1 < VCT_ARG_4->length) && (INT_ARG_1 >= 0))
- VCT_ARG_4->data[INT_ARG_1] += FLOAT_ARG_2;
- FLOAT_RESULT = FLOAT_ARG_2;
-}
-
-static void outa_sound_data_3(int *args, ptree *pt)
-{
- if ((INT_ARG_1 < SOUND_DATA_ARG_3->length) && (INT_ARG_1 >= 0))
- SOUND_DATA_ARG_3->data[0][INT_ARG_1] += FLOAT_ARG_2;
- FLOAT_RESULT = FLOAT_ARG_2;
-}
-
-static void outb_sound_data_3(int *args, ptree *pt)
-{
- if ((INT_ARG_1 < SOUND_DATA_ARG_3->length) && (SOUND_DATA_ARG_3->chans > 1) && (INT_ARG_1 >= 0))
- SOUND_DATA_ARG_3->data[1][INT_ARG_1] += FLOAT_ARG_2;
- FLOAT_RESULT = FLOAT_ARG_2;
-}
-
-static void outc_sound_data_3(int *args, ptree *pt)
-{
- if ((INT_ARG_1 < SOUND_DATA_ARG_3->length) && (SOUND_DATA_ARG_3->chans > 2) && (INT_ARG_1 >= 0))
- SOUND_DATA_ARG_3->data[2][INT_ARG_1] += FLOAT_ARG_2;
- FLOAT_RESULT = FLOAT_ARG_2;
-}
-
-static void outd_sound_data_3(int *args, ptree *pt)
-{
- if ((INT_ARG_1 < SOUND_DATA_ARG_3->length) && (SOUND_DATA_ARG_3->chans > 3) && (INT_ARG_1 >= 0))
- SOUND_DATA_ARG_3->data[3][INT_ARG_1] += FLOAT_ARG_2;
- FLOAT_RESULT = FLOAT_ARG_2;
-}
-
-static void out_any_sound_data_4(int *args, ptree *pt)
-{
- if ((INT_ARG_1 < SOUND_DATA_ARG_4->length) && (SOUND_DATA_ARG_4->chans > INT_ARG_3) && (INT_ARG_1 >= 0))
- SOUND_DATA_ARG_4->data[INT_ARG_3][INT_ARG_1] += FLOAT_ARG_2;
- FLOAT_RESULT = FLOAT_ARG_2;
-}
-
-
-/* outa optimizations */
-
-#define NUM_O3_OPS 3
-
-static opt_ops o3_ops[NUM_O3_OPS] = {
- {add_f2, "add_f2", outa_add_f2, "outa_add_f2", outb_add_f2, "outb_add_f2"},
- {multiply_f2, "multiply_f2", outa_multiply_f2, "outa_multiply_f2", outb_multiply_f2, "outb_multiply_f2"},
- {oscil_0f_1_mult, "oscil_0f_mult", outa_oscil_0_mult, "outa_oscil_0_mult", outb_oscil_0_mult, "outb_oscil_0_mult"},
-};
-
-
-static int find_o3_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_O3_OPS; i++)
- if (prev_op->function == o3_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-#define NUM_O4_OPS 9
-
-static opt_ops o4_ops[NUM_O4_OPS] = {
- {add_f3, "add_f3", outa_add_f3, "outa_add_f3", outb_add_f3, "outb_add_f3"},
- {multiply_f3, "multiply_f3", outa_multiply_f3, "outa_multiply_f3", outb_multiply_f3, "outb_multiply_f3"},
- {add_f2_mult, "add_f2_mult", outa_add_f2_mult, "outa_add_f2_mult", outb_add_f2_mult, "outb_add_f2_mult"},
- {oscil_1f_1_mult, "oscil_1f_1_mult", outa_oscil_1_mult, "outa_oscil_1_mult", outb_oscil_1_mult, "outb_oscil_1_mult"},
- {polywave_1f_mult, "polywave_1f_mult", outa_polywave_1_mult, "outa_polywave_1_mult", outb_polywave_1_mult, "outb_polywave_1_mult"},
- {delay_1f_noz_mult, "delay_1f_noz_mult", outa_delay_1_mult, "outa_delay_1_mult", outb_delay_1_mult, "outb_delay_1_mult"},
- {funcall_cf2, "funcall_cf2", outa_funcall_cf2, "outa_funcall_cf2", outb_funcall_cf2, "outb_funcall_cf2"},
- {formant_1f_mult, "formant_1f_mult", outa_formant_1_mult, "outa_formant_1_mult", outb_formant_1_mult, "outb_formant_1_mult"},
- {firmant_1f_mult, "firmant_1f_mult", outa_firmant_1_mult, "outa_firmant_1_mult", outb_firmant_1_mult, "outb_firmant_1_mult"},
-};
-
-
-static int find_o4_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_O4_OPS; i++)
- if (prev_op->function == o4_ops[i].func)
- return(i);
- return(-1);
-}
-
-#define NUM_O5_OPS 3
-
-static opt_ops o5_ops[NUM_O5_OPS] = {
- {add_f4, "add_f4", outa_add_f4, "outa_add_f4", outb_add_f4, "outb_add_f4"},
- {multiply_f4, "multiply_f4", outa_multiply_f4, "outa_multiply_f4", outb_multiply_f4, "outb_multiply_f4"},
- {add_f3_mult, "add_f3_mult", outa_add_f3_mult, "outa_add_f3_mult", outb_add_f3_mult, "outb_add_f3_mult"},
-};
-
-
-/* polywave_1f_env */
-
-
-static int find_o5_op(triple *prev_op)
-{
- int i;
- for (i = 0; i < NUM_O5_OPS; i++)
- if (prev_op->function == o5_ops[i].func)
- return(i);
- return(-1);
-}
-
-
-static xen_value *out_opt(ptree *prog, xen_value **args, int num_args, int channel)
-{
- if ((prog->walk_result == DONT_NEED_RESULT) &&
- (mus_output_p(prog->clms[args[3]->addr])))
- {
- if (prog->triple_ctr > 0)
- {
- triple *prev_op;
- prev_op = prog->program[prog->triple_ctr - 1];
- if ((prev_op->args[0] == args[2]->addr) &&
- ((find_var_in_ptree_via_addr(prog, R_FLOAT, prev_op->args[0])) == NULL))
- {
- int loc;
- switch (prev_op->num_args)
- {
-
- /* -------- 3 args -------- */
- case 3:
- loc = find_o3_op(prev_op);
- /* (with-sound () (let ((x 1.0) (y 2.0)) (run (lambda () (do ((i 0 (+ i 1))) ((= i 2)) (outa i (+ x y) )))))) */
- if (loc >= 0)
- {
- /* 1 -> 4 */
- prev_op->types = (int *)realloc(prev_op->types, 5 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 5 * sizeof(int));
- prev_op->num_args = 5;
- /* reshuffle args in prev_op so that arg1 -> arg4, (arg2 can stay), then arg1 <- cur1, arg3 <- cur3 */
-
- prev_op->types[4] = prev_op->types[1]; /* transfer 1 -> 4 */
- prev_op->args[4] = prev_op->args[1]; /* new arg1 is the sample loc */
- prev_op->types[1] = R_INT; /* sample location */
- prev_op->args[1] = args[1]->addr;
-
- /* args[2]->addr is the old output which we ignore, using the old arg2 as it is */
-
- prev_op->types[3] = R_CLM; /* output writer */
- prev_op->args[3] = args[3]->addr;
-
- if (channel == 0)
- {
- prev_op->function = o3_ops[loc].mult_func;
- prev_op->op_name = o3_ops[loc].mult_func_name;
- }
- else
- {
- prev_op->function = o3_ops[loc].env_func;
- prev_op->op_name = o3_ops[loc].env_func_name;
- }
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
-
- /* -------- 4 args -------- */
- case 4:
- loc = find_o4_op(prev_op);
- if (loc >= 0)
- {
- /* move old 1 to 4, old 3 to 5, leave 2, fixup old 1 as loc, old 3 as output gen */
- /* (with-sound () (let ((gen (make-oscil 100.0)) (x 0.5) (y 0.25)) (run (lambda () (do ((i 0 (+ i 1))) ((= i 2)) (outa i (* y (oscil gen x)))))))) */
-
- prev_op->types = (int *)realloc(prev_op->types, 6 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 6 * sizeof(int));
- prev_op->num_args = 6;
-
- prev_op->types[4] = prev_op->types[1]; /* transfer 1 -> 4 */
- prev_op->args[4] = prev_op->args[1]; /* new arg1 is the sample loc */
- prev_op->types[1] = R_INT; /* sample location */
- prev_op->args[1] = args[1]->addr;
-
- /* args[2]->addr is the old output which we ignore, using the old arg2 as it is */
-
- prev_op->types[5] = prev_op->types[3]; /* transfer 3 -> 5 */
- prev_op->args[5] = prev_op->args[3]; /* new arg3 is the writer gen */
- prev_op->types[3] = R_CLM; /* output writer */
- prev_op->args[3] = args[3]->addr;
-
- if (channel == 0)
- {
- prev_op->function = o4_ops[loc].mult_func;
- prev_op->op_name = o4_ops[loc].mult_func_name;
- }
- else
- {
- prev_op->function = o4_ops[loc].env_func;
- prev_op->op_name = o4_ops[loc].env_func_name;
- }
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
-
- /* -------- 5 args -------- */
- case 5:
- loc = find_o5_op(prev_op);
- if (loc >= 0)
- {
- /* move old 1 to 5, old 3 to 6, leave 2 and 4, fixup old 1 as loc, old 3 as output gen */
- prev_op->types = (int *)realloc(prev_op->types, 7 * sizeof(int));
- prev_op->args = (int *)realloc(prev_op->args, 7 * sizeof(int));
- prev_op->num_args = 7;
-
- prev_op->types[5] = prev_op->types[1]; /* transfer 1 -> 5 */
- prev_op->args[5] = prev_op->args[1]; /* new arg1 is the sample loc */
- prev_op->types[1] = R_INT; /* sample location */
- prev_op->args[1] = args[1]->addr;
-
- /* 2 and 4 can stay */
-
- prev_op->types[6] = prev_op->types[3]; /* transfer 3 -> 6 */
- prev_op->args[6] = prev_op->args[3]; /* new arg3 is the writer gen */
- prev_op->types[3] = R_CLM; /* output writer */
- prev_op->args[3] = args[3]->addr;
-
- if (channel == 0)
- {
- prev_op->function = o5_ops[loc].mult_func;
- prev_op->op_name = o5_ops[loc].mult_func_name;
- }
- else
- {
- prev_op->function = o5_ops[loc].env_func;
- prev_op->op_name = o5_ops[loc].env_func_name;
- }
-#if WITH_COUNTERS
- prev_op->func_loc = get_func_loc(prev_op->function, prev_op->op_name);
-#endif
- return(make_xen_value(R_FLOAT, prev_op->args[0], R_TEMPORARY));
- }
- break;
- }
- }
- }
- if (channel == 0)
- return(package(prog, R_FLOAT, outa_3f, "outa_3f", args, 3));
- return(package(prog, R_FLOAT, outb_3f, "outb_3f", args, 3));
- }
- if (channel == 0)
- return(package(prog, R_FLOAT, outa_3, "outa_3", args, 3));
- return(package(prog, R_FLOAT, outb_3, "outb_3", args, 3));
-}
-
-
-static xen_value *outa_2(ptree *prog, xen_value **args, int num_args)
-{
- if (args[3]->type == R_CLM)
- return(out_opt(prog, args, num_args, 0));
- if (args[3]->type == R_VCT)
- return(package(prog, R_FLOAT, out_vct_3, "outa_vct_3", args, 3));
- if (args[3]->type == R_SOUND_DATA)
- return(package(prog, R_FLOAT, outa_sound_data_3, "outa_sound_data_3", args, 3));
- if (args[3]->type == R_FUNCTION)
- return(package(prog, R_FLOAT, outa_function_3, "outa_function_3", args, 3));
- return(package(prog, R_FLOAT, out_f_3, "out_f_3", args, 3));
-}
-
-/* output to a vct can only be mono, so outb to vct doesn't make sense */
-
-static xen_value *outb_2(ptree *prog, xen_value **args, int num_args)
-{
- if (args[3]->type == R_CLM)
- return(out_opt(prog, args, num_args, 1));
- if (args[3]->type == R_SOUND_DATA)
- return(package(prog, R_FLOAT, outb_sound_data_3, "outb_sound_data_3", args, 3));
- if (args[3]->type == R_FUNCTION)
- return(package(prog, R_FLOAT, outb_function_3, "outb_function_3", args, 3));
- return(package(prog, R_FLOAT, out_f_3, "out_f_3", args, 3));
-}
-
-static xen_value *outc_2(ptree *prog, xen_value **args, int num_args)
-{
- if (args[3]->type == R_CLM)
- {
- if ((prog->walk_result == DONT_NEED_RESULT) &&
- (mus_output_p(prog->clms[args[3]->addr])))
- return(package(prog, R_FLOAT, outc_3f, "outc_3f", args, 3));
- return(package(prog, R_FLOAT, outc_3, "outc_3", args, 3));
- }
- if (args[3]->type == R_SOUND_DATA)
- return(package(prog, R_FLOAT, outc_sound_data_3, "outc_sound_data_3", args, 3));
- if (args[3]->type == R_FUNCTION)
- return(package(prog, R_FLOAT, outc_function_3, "outc_function_3", args, 3));
- return(package(prog, R_FLOAT, out_f_3, "out_f_3", args, 3));
-}
-
-
-static xen_value *outd_2(ptree *prog, xen_value **args, int num_args)
-{
- if (args[3]->type == R_CLM)
- {
- if ((prog->walk_result == DONT_NEED_RESULT) &&
- (mus_output_p(prog->clms[args[3]->addr])))
- return(package(prog, R_FLOAT, outd_3f, "outd_3f", args, 3));
- return(package(prog, R_FLOAT, outd_3, "outd_3", args, 3));
- }
- if (args[3]->type == R_SOUND_DATA)
- return(package(prog, R_FLOAT, outd_sound_data_3, "outd_sound_data_3", args, 3));
- if (args[3]->type == R_FUNCTION)
- return(package(prog, R_FLOAT, outd_function_3, "outd_function_3", args, 3));
- return(package(prog, R_FLOAT, out_f_3, "out_f_3", args, 3));
-}
-
-
-static xen_value *out_any_2(ptree *prog, xen_value **args, int num_args)
-{
- if (args[4]->type == R_CLM)
- {
- /* if arg[3] is a constant, go to the explicit cases that are more highly optimized */
- if ((args[3]->constant == R_CONSTANT) &&
- (args[3]->type == R_INT) &&
- (prog->ints[args[3]->addr] < 2))
- {
- int chan;
- chan = prog->ints[args[3]->addr];
- args[3]->type = R_CLM;
- args[3]->addr = args[4]->addr;
- return(out_opt(prog, args, num_args - 1, chan));
- }
-
- if ((prog->walk_result == DONT_NEED_RESULT) &&
- (mus_output_p(prog->clms[args[4]->addr])))
- return(package(prog, R_FLOAT, out_any_4f, "out_any_4f", args, 4));
- return(package(prog, R_FLOAT, out_any_4, "out_any_4", args, 4));
- }
-
- if (args[4]->type == R_VCT)
- return(package(prog, R_FLOAT, out_any_vct_4, "out_any_vct_4", args, 4));
- if (args[4]->type == R_SOUND_DATA)
- return(package(prog, R_FLOAT, out_any_sound_data_4, "out_any_sound_data_4", args, 4));
- if (args[4]->type == R_FUNCTION)
- return(package(prog, R_FLOAT, out_any_function_4, "out_any_function_4", args, 4));
- return(package(prog, R_FLOAT, out_any_f_4, "out_any_f_4", args, 4));
-}
-
-
-static xen_value *out_any_function_body(ptree *prog, s7_pointer proc, xen_value **args, int num_args, const char *funcname)
-{
- s7_pointer func_form;
- func_form = s7_car(s7_procedure_source(s7, proc));
-
- if ((s7_is_list(s7, func_form)) &&
- (s7_is_symbol(s7_car(func_form))) &&
- (strncmp("lambda", s7_symbol_name(s7_car(func_form)), 6) == 0))
- {
- bool old_got_lambda;
- xen_value *v;
- old_got_lambda = prog->got_lambda;
- prog->got_lambda = true;
- /* normally when we're plugging in a separate function body the args are already
- * processed, and we're looking at the name at the start of that list, so we
- * can pass the current args and let lambda_form use them in lieu of the declare
- * list to get the arg types. In this case we might be outside any such call,
- * (with-sound (:output (lambda ...))), or some of the args might be defaulted (outa),
- * so we first get the lambda form parsed insisting on a declare (hence the 0 num_args),
- * then pass in the actual args so that the funcall works.
- */
- v = lambda_form(prog, func_form, true, args, 0, proc); /* must have "declare" here */
- prog->got_lambda = old_got_lambda;
- if (v)
- {
- xen_value *result;
- if (funcname) add_var_to_ptree(prog, funcname, v);
- result = funcall_n(prog, args, num_args, v);
- free(v);
- return(result);
- }
- }
- return(NULL); /* not an error */
-}
-
-
-/* here if num_args == 2 *output* is used by default */
-
-static xen_value *outn_1(ptree *prog, int chan, xen_value **args, int num_args, xen_value *(*out_func)(ptree *prog, xen_value **args, int num_args))
-{
- if (num_args == 2)
- {
- xen_value *true_args[4];
- xen_value *rtn;
- int k;
- s7_pointer output;
- bool protect_ptree = false;
-
- output = mus_clm_output();
-
- if (mus_xen_p(output))
- true_args[3] = make_xen_value(R_CLM, add_clm_to_ptree(prog, XEN_TO_MUS_ANY(output), scheme_false), R_VARIABLE);
- else
- {
- if (mus_vct_p(output))
- true_args[3] = make_xen_value(R_VCT, add_vct_to_ptree(prog, XEN_TO_VCT(output)), R_VARIABLE);
- else
- {
- if (sound_data_p(output))
- true_args[3] = make_xen_value(R_SOUND_DATA, add_sound_data_to_ptree(prog, XEN_TO_SOUND_DATA(output)), R_VARIABLE);
- else
- {
- if (s7_is_procedure(output))
- {
- xen_value *func_args[5];
- for (k = 0; k < 3; k++) func_args[k] = args[k];
- func_args[3] = make_xen_value(R_INT, add_int_to_ptree(prog, chan), R_VARIABLE);
- true_args[3] = out_any_function_body(prog, output, func_args, 3, NULL);
- protect_ptree = true;
- free(func_args[3]);
- if (true_args[3] == NULL) return(NULL);
- }
- else true_args[3] = make_xen_value(R_XEN, add_xen_to_ptree(prog, output), R_VARIABLE);
- }
- }
- }
-
- for (k = 0; k < 3; k++) true_args[k] = args[k];
- rtn = out_func(prog, true_args, 3);
- if (!protect_ptree) free(true_args[3]); /* otherwise the embedded ptree is gc'd twice */
- return(rtn);
- }
- return(out_func(prog, args, num_args));
-}
-
-static xen_value *outa_1(ptree *prog, xen_value **args, int num_args)
-{
- return(outn_1(prog, 0, args, num_args, outa_2));
-}
-
-static xen_value *outb_1(ptree *prog, xen_value **args, int num_args)
-{
- return(outn_1(prog, 1, args, num_args, outb_2));
-}
-
-static xen_value *outc_1(ptree *prog, xen_value **args, int num_args)
-{
- return(outn_1(prog, 2, args, num_args, outc_2));
-}
-
-static xen_value *outd_1(ptree *prog, xen_value **args, int num_args)
-{
- return(outn_1(prog, 3, args, num_args, outd_2));
-}
-
-static xen_value *out_any_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 3)
- {
- xen_value *true_args[5];
- xen_value *rtn;
- int k;
- s7_pointer output;
- bool protect_ptree = false;
-
- output = mus_clm_output();
- if (mus_xen_p(output))
- true_args[4] = make_xen_value(R_CLM, add_clm_to_ptree(prog, XEN_TO_MUS_ANY(output), scheme_false), R_VARIABLE);
- else
- {
- if (mus_vct_p(output))
- true_args[4] = make_xen_value(R_VCT, add_vct_to_ptree(prog, XEN_TO_VCT(output)), R_VARIABLE);
- else
- {
- if (sound_data_p(output))
- true_args[4] = make_xen_value(R_SOUND_DATA, add_sound_data_to_ptree(prog, XEN_TO_SOUND_DATA(output)), R_VARIABLE);
- else
- {
- if (s7_is_procedure(output))
- {
- for (k = 0; k < 4; k++) true_args[k] = args[k];
- true_args[4] = out_any_function_body(prog, output, true_args, 3, NULL);
- if (true_args[4] == NULL) return(NULL);
- protect_ptree = true;
- }
- else true_args[4] = make_xen_value(R_XEN, add_xen_to_ptree(prog, output), R_VARIABLE);
- }
- }
- }
- for (k = 0; k < 4; k++) true_args[k] = args[k];
- rtn = out_any_2(prog, true_args, 4);
- if (!protect_ptree) free(true_args[4]);
- return(rtn);
- }
- return(out_any_2(prog, args, num_args));
-}
-
-
-/* ---------------- in-any ---------------- */
-
-static void ina_2(int *args, ptree *pt) {FLOAT_RESULT = mus_in_any(INT_ARG_1, 0, CLM_ARG_2);}
-static void ina_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_in_any_from_file(CLM_ARG_2, INT_ARG_1, 0);}
-
-static void inb_2(int *args, ptree *pt) {FLOAT_RESULT = mus_in_any(INT_ARG_1, 1, CLM_ARG_2);}
-static void inb_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_in_any_from_file(CLM_ARG_2, INT_ARG_1, 1);}
-
-static void in_any_3(int *args, ptree *pt) {FLOAT_RESULT = mus_in_any(INT_ARG_1, INT_ARG_2, CLM_ARG_3);}
-static void in_any_3f(int *args, ptree *pt) {FLOAT_RESULT = mus_in_any_from_file(CLM_ARG_3, INT_ARG_1, INT_ARG_2);}
-
-
-static void in_f_2(int *args, ptree *pt) {FLOAT_RESULT = 0.0;}
-
-static void in_any_f_3(int *args, ptree *pt) {FLOAT_RESULT = 0.0;}
-
-
-static void in_vct_2(int *args, ptree *pt)
-{
- if ((VCT_ARG_2->length > INT_ARG_1) && (INT_ARG_1 >= 0))
- FLOAT_RESULT = VCT_ARG_2->data[INT_ARG_1];
- else FLOAT_RESULT = 0.0;
-}
-
-static void in_any_vct_3(int *args, ptree *pt)
-{
- if ((VCT_ARG_3->length > INT_ARG_1) && (INT_ARG_1 >= 0))
- FLOAT_RESULT = VCT_ARG_3->data[INT_ARG_1];
- else FLOAT_RESULT = 0.0;
-}
-
-
-static void ina_sound_data_2(int *args, ptree *pt)
-{
- if ((SOUND_DATA_ARG_2->length > INT_ARG_1) && (INT_ARG_1 >= 0))
- FLOAT_RESULT = SOUND_DATA_ARG_2->data[0][INT_ARG_1];
- else FLOAT_RESULT = 0.0;
-}
-
-static void inb_sound_data_2(int *args, ptree *pt)
-{
- if ((SOUND_DATA_ARG_2->length > INT_ARG_1) &&
- (SOUND_DATA_ARG_2->chans > 1) &&
- (INT_ARG_1 >= 0))
- FLOAT_RESULT = SOUND_DATA_ARG_2->data[1][INT_ARG_1];
- else FLOAT_RESULT = 0.0;
-}
-
-static void in_any_sound_data_3(int *args, ptree *pt)
-{
- if ((SOUND_DATA_ARG_3->length > INT_ARG_1) &&
- (SOUND_DATA_ARG_3->chans > INT_ARG_2) &&
- (INT_ARG_1 >= 0))
- FLOAT_RESULT = SOUND_DATA_ARG_3->data[INT_ARG_2][INT_ARG_1];
- else FLOAT_RESULT = 0.0;
-}
-
-
-static mus_float_t call_in_any_function(ptree *pt, Int loc, Int chan, ptree *function)
-{
- pt->ints[function->args[0]] = loc;
- pt->ints[function->args[1]] = chan;
- eval_embedded_ptree(function, pt);
- return(pt->dbls[function->result->addr]);
-}
-
-static void ina_function_2(int *args, ptree *pt)
-{
- FLOAT_RESULT = call_in_any_function(pt, INT_ARG_1, 0, FNC_ARG_2);
-}
-
-static void inb_function_2(int *args, ptree *pt)
-{
- FLOAT_RESULT = call_in_any_function(pt, INT_ARG_1, 1, FNC_ARG_2);
-}
-
-static void in_any_function_3(int *args, ptree *pt)
-{
- FLOAT_RESULT = call_in_any_function(pt, INT_ARG_1, INT_ARG_2, FNC_ARG_3);
-}
-
-
-static xen_value *ina_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[2]->type == R_CLM)
- {
- if (mus_file_to_sample_p(prog->clms[args[2]->addr]))
- return(package(prog, R_FLOAT, ina_2f, "ina_2f", args, 2));
- return(package(prog, R_FLOAT, ina_2, "ina_2", args, 2));
- }
- if (args[2]->type == R_VCT)
- return(package(prog, R_FLOAT, in_vct_2, "ina_vct_2", args, 2));
- if (args[2]->type == R_SOUND_DATA)
- return(package(prog, R_FLOAT, ina_sound_data_2, "ina_sound_data_2", args, 2));
- if (args[2]->type == R_FUNCTION)
- return(package(prog, R_FLOAT, ina_function_2, "ina_function_2", args, 2));
- return(package(prog, R_FLOAT, in_f_2, "ina_f_2", args, 2));
-}
-
-static xen_value *inb_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[2]->type == R_CLM)
- {
- if (mus_file_to_sample_p(prog->clms[args[2]->addr]))
- return(package(prog, R_FLOAT, inb_2f, "inb_2f", args, 2));
- return(package(prog, R_FLOAT, inb_2, "inb_2", args, 2));
- }
- if (args[2]->type == R_SOUND_DATA)
- return(package(prog, R_FLOAT, inb_sound_data_2, "inb_sound_data_2", args, 2));
- if (args[2]->type == R_FUNCTION)
- return(package(prog, R_FLOAT, inb_function_2, "inb_function_2", args, 2));
- return(package(prog, R_FLOAT, in_f_2, "inb_f_2", args, 2));
-}
-
-static xen_value *in_any_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[3]->type == R_CLM)
- {
- if (mus_file_to_sample_p(prog->clms[args[3]->addr]))
- return(package(prog, R_FLOAT, in_any_3f, "in_any_3f", args, 3));
- return(package(prog, R_FLOAT, in_any_3, "in_any_3", args, 3));
- }
- if (args[3]->type == R_VCT)
- return(package(prog, R_FLOAT, in_any_vct_3, "in_any_vct_3", args, 3));
- if (args[3]->type == R_SOUND_DATA)
- return(package(prog, R_FLOAT, in_any_sound_data_3, "in_any_sound_data_3", args, 3));
- if (args[3]->type == R_FUNCTION)
- return(package(prog, R_FLOAT, in_any_function_3, "in_any_function_3", args, 3));
- return(package(prog, R_FLOAT, in_any_f_3, "in_any_f_3", args, 3));
-}
-
-
-
-
-/* ---------------- array-interp ---------------- */
-
-static void array_interp_1f(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_array_interp(VCT_ARG_1->data, FLOAT_ARG_2, VCT_ARG_1->length);
-}
-
-
-static void array_interp_2f(int *args, ptree *pt) {FLOAT_RESULT = mus_array_interp(VCT_ARG_1->data, FLOAT_ARG_2, INT_ARG_3);}
-
-static xen_value *array_interp_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2) return(package(prog, R_FLOAT, array_interp_1f, "array_interp_1f", args, 2));
- return(package(prog, R_FLOAT, array_interp_2f, "array_interp_2f", args, 3));
-}
-
-
-/* ---------------- mus-interpolate ---------------- */
-
-
-static void mus_interpolate_3f(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_interpolate((mus_interp_t)(INT_ARG_1), FLOAT_ARG_2, VCT_ARG_3->data, VCT_ARG_3->length, 0.0);
-}
-
-static void mus_interpolate_4f(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_interpolate((mus_interp_t)(INT_ARG_1), FLOAT_ARG_2, VCT_ARG_3->data, INT_ARG_4, 0.0);
-}
-
-static void mus_interpolate_5f(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_interpolate((mus_interp_t)(INT_ARG_1), FLOAT_ARG_2, VCT_ARG_3->data, INT_ARG_4, FLOAT_ARG_5);
-}
-
-static xen_value *mus_interpolate_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 3) return(package(prog, R_FLOAT, mus_interpolate_3f, "mus_interpolate_3f", args, 3));
- if (num_args == 4) return(package(prog, R_FLOAT, mus_interpolate_4f, "mus_interpolate_4f", args, 4));
- return(package(prog, R_FLOAT, mus_interpolate_5f, "mus_interpolate_5f", args, 5));
-}
-
-
-/* ---------------- clear_array ---------------- */
-
-static void clear_array_1f(int *args, ptree *pt)
-{
- mus_clear_array(VCT_ARG_1->data, VCT_ARG_1->length);
- VCT_RESULT = VCT_ARG_1;
-}
-
-static xen_value *clear_array_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_VCT, clear_array_1f, "clear_array_1f", args, 1));
-}
-
-
-/* ---------------- dot-product etc ---------------- */
-
-#define VCT_2_I(CName, SName) \
-static void CName ## _2f(int *args, ptree *pt) \
-{ \
- mus_ ## CName(VCT_ARG_1->data, VCT_ARG_2->data, VCT_ARG_1->length); \
- VCT_RESULT = VCT_ARG_1; \
-} \
-static void CName ## _3f(int *args, ptree *pt) \
-{ \
- mus_ ## CName(VCT_ARG_1->data, VCT_ARG_2->data, INT_ARG_3); \
- VCT_RESULT = VCT_ARG_1; \
-} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- if (num_args == 2) \
- return(package(prog, R_VCT, CName ## _2f, #CName "_2f", args, 2)); \
- else return(package(prog, R_VCT, CName ## _3f, #CName "_3f", args, 3)); \
-}
-
-VCT_2_I(rectangular_to_magnitudes, rectangular->magnitudes)
-VCT_2_I(rectangular_to_polar, rectangular->polar)
-VCT_2_I(polar_to_rectangular, polar->rectangular)
-VCT_2_I(multiply_arrays, multiply-arrays)
-VCT_2_I(convolution, convolution)
-
-
-#define VCT_2_F(CName, SName) \
-static void CName ## _2f(int *args, ptree *pt) \
-{ \
- FLOAT_RESULT = mus_ ## CName(VCT_ARG_1->data, VCT_ARG_2->data, VCT_ARG_1->length); \
-} \
-static void CName ## _3f(int *args, ptree *pt) \
-{ \
- FLOAT_RESULT = mus_ ## CName(VCT_ARG_1->data, VCT_ARG_2->data, INT_ARG_3); \
-} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- if (num_args == 2) \
- return(package(prog, R_FLOAT, CName ## _2f, #CName "_2f", args, 2)); \
- else return(package(prog, R_FLOAT, CName ## _3f, #CName "_3f", args, 3)); \
-}
-
-VCT_2_F(dot_product, dot-product)
-
-
-static void clm_0f(int *args, ptree *pt) {if (CLM_ARG_1) FLOAT_RESULT = MUS_RUN(CLM_ARG_1, 0.0, 0.0);}
-
-static void clm_1f(int *args, ptree *pt) {if (CLM_ARG_1) FLOAT_RESULT = MUS_RUN(CLM_ARG_1, FLOAT_ARG_2, 0.0);}
-
-static void clm_2f(int *args, ptree *pt) {if (CLM_ARG_1) FLOAT_RESULT = MUS_RUN(CLM_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-static xen_value *clm_n(ptree *prog, xen_value **args, int num_args, xen_value *sf)
-{
- /* this is handling the gen-as-applicable-func stuff (gen fm) = (oscil gen fm) etc */
- xen_value *temp;
- if (args[0]) free(args[0]);
- args[0] = make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, 0.0), R_VARIABLE);
- if ((num_args > 0) && (args[1]->type == R_INT))
- {
- temp = args[1];
- args[1] = convert_int_to_dbl(prog, args[1]);
- free(temp);
- }
- if ((num_args > 1) && (args[2]->type == R_INT))
- {
- temp = args[2];
- args[2] = convert_int_to_dbl(prog, args[2]);
- free(temp);
- }
- switch (num_args)
- {
- case 0: add_triple_to_ptree(prog, va_make_triple(clm_0f, "clm_0f", 2, args[0], sf)); break;
- case 1: add_triple_to_ptree(prog, va_make_triple(clm_1f, "clm_1f", 3, args[0], sf, args[1])); break;
- case 2: add_triple_to_ptree(prog, va_make_triple(clm_2f, "clm_2f", 4, args[0], sf, args[1], args[2])); break;
- default: if (sf) free(sf); return(NULL); break;
- }
- return(args[0]);
-}
-
-
-static void clm_set_f(int *args, ptree *pt)
-{
- if (CLM_ARG_1)
- {
- if (mus_frame_p(CLM_ARG_1))
- mus_frame_set(CLM_ARG_1, INT_ARG_2, FLOAT_ARG_4);
- else
- {
- if (mus_mixer_p(CLM_ARG_1))
- mus_mixer_set(CLM_ARG_1, INT_ARG_2, INT_ARG_3, FLOAT_ARG_4);
- }
- }
- /* FLOAT_RESULT = FLOAT_ARG_4; */
-}
-
-static void clm_set_1(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- xen_var *var;
- var = find_var_in_ptree_via_addr(prog, in_v->type, in_v->addr);
- if (var) var->unclean = true;
- /* v->type known to be R_FLOAT (generalized set insists) */
- add_triple_to_ptree(prog, va_make_triple(clm_set_f, "clm_set_f", 5, NULL, in_v, in_v1, in_v2, v));
-}
-
-
-
-
-
-/* ---------------- spectrum ---------------- */
-
-static void mus_spectrum_3v_f(int *args, ptree *pt)
-{
- mus_spectrum(VCT_ARG_1->data, VCT_ARG_2->data, NULL, VCT_ARG_1->length, MUS_SPECTRUM_NORMALIZED);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static void mus_spectrum_3v(int *args, ptree *pt)
-{
- mus_spectrum(VCT_ARG_1->data, VCT_ARG_2->data, (VCT_ARG_3) ? (VCT_ARG_3->data) : NULL, VCT_ARG_1->length, MUS_SPECTRUM_NORMALIZED);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static void mus_spectrum_4v(int *args, ptree *pt)
-{
- mus_spectrum(VCT_ARG_1->data, VCT_ARG_2->data, (VCT_ARG_3) ? (VCT_ARG_3->data) : NULL, VCT_ARG_1->length, (mus_spectrum_t)INT_ARG_4);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static void mus_spectrum_4v_f(int *args, ptree *pt)
-{
- mus_spectrum(VCT_ARG_1->data, VCT_ARG_2->data, NULL, VCT_ARG_1->length, (mus_spectrum_t)INT_ARG_4);
- VCT_RESULT = VCT_ARG_1;
-}
-
-
-static xen_value *mus_spectrum_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 3)
- {
- if (args[3]->type == R_VCT)
- return(package(prog, R_VCT, mus_spectrum_3v, "mus_spectrum_3v", args, 3));
- return(package(prog, R_VCT, mus_spectrum_3v_f, "mus_spectrum_3v_f", args, 3));
- }
- if (args[3]->type == R_VCT)
- return(package(prog, R_VCT, mus_spectrum_4v, "mus_spectrum_4v", args, 4));
- return(package(prog, R_VCT, mus_spectrum_4v_f, "mus_spectrum_4v_f", args, 4));
-}
-
-
-/* ---------------- partials->polynomial ---------------- */
-
-/* (partials->polynomial amps kind) which doesn't match the C level mus_partials_to_polynomial(int npartials, mus_float_t *partials, mus_polynomial_t kind)
- */
-
-static void partials_to_polynomial_n(int *args, ptree *pt, mus_polynomial_t kind)
-{
- int npartials = 0, error = 0;
- mus_float_t *partials = NULL;
- vct *v;
- if (VCT_RESULT) mus_vct_free(VCT_RESULT);
- partials = mus_vct_to_partials(VCT_ARG_1, &npartials, &error);
- mus_partials_to_polynomial(npartials, partials, kind);
- v = (vct *)malloc(sizeof(vct));
- v->length = npartials;
- v->data = partials;
- v->dont_free = false;
- VCT_RESULT = v;
-}
-
-static void partials_to_polynomial_no_kind(int *args, ptree *pt)
-{
- partials_to_polynomial_n(args, pt, MUS_CHEBYSHEV_FIRST_KIND);
-}
-
-static void partials_to_polynomial_with_kind(int *args, ptree *pt)
-{
- partials_to_polynomial_n(args, pt, (mus_polynomial_t)INT_ARG_2);
-}
-
-
-static xen_value *partials_to_polynomial_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_VCT, add_vct_to_ptree(prog, NULL), R_VARIABLE);
- add_obj_to_gcs(prog, R_VCT, args[0]->addr);
- if (num_args == 1)
- add_triple_to_ptree(prog, va_make_triple(partials_to_polynomial_no_kind, "partials_to_polynomial_0", 2, args[0], args[1]));
- else add_triple_to_ptree(prog, va_make_triple(partials_to_polynomial_with_kind, "partials_to_polynomial_1", 3, args[0], args[1], args[2]));
- return(args[0]);
-}
-
-
-
-/* ---------------- normalize-partials ---------------- */
-
-static void normalize_partials_0(int *args, ptree *pt)
-{
- vct *v;
- v = VCT_ARG_1;
- mus_normalize_partials(v->length / 2, v->data);
- VCT_RESULT = v;
-}
-
-
-static xen_value *normalize_partials_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_VCT, normalize_partials_0, "normalize_partials_0", args, 1));
-}
-
-
-
-/* ---------------- mus-chebyshev-tu-sum ---------------- */
-
-static void mus_chebyshev_tu_sum_0(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_chebyshev_tu_sum(FLOAT_ARG_1, VCT_ARG_2->length, VCT_ARG_2->data, VCT_ARG_3->data);
-}
-
-
-static xen_value *mus_chebyshev_tu_sum_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, mus_chebyshev_tu_sum_0, "mus-chebyshev-tu-sum-0", args, 3));
-}
-
-
-static void mus_chebyshev_t_sum_0(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_chebyshev_t_sum(FLOAT_ARG_1, VCT_ARG_2->length, VCT_ARG_2->data);
-}
-
-
-static xen_value *mus_chebyshev_t_sum_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, mus_chebyshev_t_sum_0, "mus-chebyshev-t-sum-0", args, 2));
-}
-
-
-static void mus_chebyshev_u_sum_0(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_chebyshev_u_sum(FLOAT_ARG_1, VCT_ARG_2->length, VCT_ARG_2->data);
-}
-
-
-static xen_value *mus_chebyshev_u_sum_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, mus_chebyshev_u_sum_0, "mus-chebyshev-u-sum-0", args, 2));
-}
-
-
-
-/* ---------------- src ---------------- */
-
-GEN_P(src)
-GEN_P(convolve)
-GEN_P(granulate)
-GEN_P(phase_vocoder)
-
-static mus_float_t src_input(void *arg, int direction)
-{
- mus_xen *gn = (mus_xen *)arg;
- ptree *pt, *outer;
- pt = gn->input_ptree;
- outer = pt->outer_tree;
- outer->ints[pt->args[0]] = direction;
- eval_embedded_ptree(pt, outer);
- return(outer->dbls[pt->result->addr]);
-}
-
-
-static void src_2f(int *args, ptree *pt)
-{
- ((mus_xen *)mus_environ(CLM_ARG_1))->input_ptree = FNC_ARG_3;
- FLOAT_RESULT = mus_src(CLM_ARG_1, FLOAT_ARG_2, src_input);
-}
-
-
-static void src_1f(int *args, ptree *pt) {FLOAT_RESULT = mus_src(CLM_ARG_1, FLOAT_ARG_2, NULL);}
-
-
-static void src_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_src(CLM_ARG_1, 0.0, NULL);}
-
-static xen_value *src_1(ptree *prog, xen_value **args, int num_args)
-{
- /* input function arg may be #f */
- if ((num_args > 1) && (args[2]->type == R_INT)) single_to_float(prog, args, 2);
- if (num_args == 3)
- {
- if (args[3]->type == R_FUNCTION)
- {
- ptree *pt;
- pt = ((ptree **)(prog->fncs))[args[3]->addr];
- if (pt->arity != 1) return(run_warn("src: wrong number of args to input function"));
- }
- else num_args = 2;
- }
- switch (num_args)
- {
- case 1: return(package(prog, R_FLOAT, src_0f, "src_0f", args, 1)); break;
- case 2: return(package(prog, R_FLOAT, src_1f, "src_1f", args, 2)); break;
- default: return(package(prog, R_FLOAT, src_2f, "src_2f", args, 3)); break;
- }
-}
-
-
-/* ---------------- convolve ---------------- */
-
-
-static void convolve_1f(int *args, ptree *pt)
-{
- ((mus_xen *)mus_environ(CLM_ARG_1))->input_ptree = FNC_ARG_2;
- FLOAT_RESULT = mus_convolve(CLM_ARG_1, src_input);
-}
-
-
-static void convolve_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_convolve(CLM_ARG_1, NULL);}
-
-static xen_value *convolve_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 2)
- {
- if (args[2]->type == R_FUNCTION)
- {
- ptree *pt;
- pt = ((ptree **)(prog->fncs))[args[2]->addr];
- if (pt->arity != 1) return(run_warn("convolve: wrong number of args to input function"));
- }
- else num_args = 1;
- }
- if (num_args == 1)
- return(package(prog, R_FLOAT, convolve_0f, "convolve_0f", args, 1));
- return(package(prog, R_FLOAT, convolve_1f, "convolve_1f", args, 2));
-}
-
-
-/* ---------------- granulate ---------------- */
-
-static int grn_edit(void *arg)
-{
- mus_xen *gn = (mus_xen *)arg;
- ptree *pt, *outer;
- pt = gn->edit_ptree;
- outer = pt->outer_tree;
- outer->clms[pt->args[0]] = gn->gen;
- eval_embedded_ptree(pt, outer);
- return(outer->ints[pt->result->addr]);
-}
-
-
-static void granulate_2f(int *args, ptree *pt)
-{
- mus_xen *gn = (mus_xen *)mus_environ(CLM_ARG_1);
- gn->input_ptree = FNC_ARG_2;
- gn->edit_ptree = FNC_ARG_3;
- FLOAT_RESULT = mus_granulate_with_editor(CLM_ARG_1, src_input, grn_edit);
-}
-
-
-static void granulate_2f_split(int *args, ptree *pt)
-{
- mus_xen *gn = (mus_xen *)mus_environ(CLM_ARG_1);
- gn->edit_ptree = FNC_ARG_3;
- FLOAT_RESULT = mus_granulate_with_editor(CLM_ARG_1, NULL, grn_edit);
-}
-
-
-static void granulate_1f(int *args, ptree *pt)
-{
- ((mus_xen *)mus_environ(CLM_ARG_1))->input_ptree = FNC_ARG_2;
- FLOAT_RESULT = mus_granulate_with_editor(CLM_ARG_1, src_input, NULL);
-}
-
-
-static void granulate_0f(int *args, ptree *pt) {FLOAT_RESULT = mus_granulate_with_editor(CLM_ARG_1, NULL, NULL);}
-static void granulate_0f_mult(int *args, ptree *pt) {FLOAT_RESULT = FLOAT_ARG_2 * mus_granulate_with_editor(CLM_ARG_1, NULL, NULL);}
-static void granulate_0f_env(int *args, ptree *pt) {FLOAT_RESULT = mus_env_linear(CLM_ARG_2) * mus_granulate_with_editor(CLM_ARG_1, NULL, NULL);}
-
-
-static xen_value *granulate_1(ptree *prog, xen_value **args, int num_args)
-{
- bool got_input = false;
-
- if (num_args >= 2)
- {
- if (num_args == 3)
- {
- if (args[3]->type == R_FUNCTION)
- {
- ptree *pt;
- pt = ((ptree **)(prog->fncs))[args[3]->addr];
- if (pt->arity != 1) return(run_warn("granulate: wrong number of args to edit function"));
- }
- else num_args = 2;
- }
-
- if (args[2]->type == R_FUNCTION)
- {
- ptree *pt;
- pt = ((ptree **)(prog->fncs))[args[2]->addr];
- if (pt->arity != 1) return(run_warn("granulate: wrong number of args to input function"));
- got_input = true;
- }
- else
- {
- if (num_args == 2)
- num_args = 1;
- }
- }
-
- if (num_args == 1)
- return(package(prog, R_FLOAT, granulate_0f, "granulate_0f", args, 1));
-
- if (num_args == 2)
- return(package(prog, R_FLOAT, granulate_1f, "granulate_1f", args, 2));
-
- if (got_input)
- return(package(prog, R_FLOAT, granulate_2f, "granulate_2f", args, 3));
- return(package(prog, R_FLOAT, granulate_2f_split, "granulate_2f_split", args, 3));
-}
-
-
-
-/* ---------------- phase-vocoder ---------------- */
-
-static bool pv_analyze(void *arg, mus_float_t (*input)(void *arg1, int direction))
-{
- mus_xen *gn = (mus_xen *)arg;
- ptree *pt, *outer;
- pt = gn->analyze_ptree;
- outer = pt->outer_tree;
- outer->clms[pt->args[0]] = gn->gen;
- /* I think the input function is handled by mus_phase_vocoder */
- eval_embedded_ptree(pt, outer);
- return(outer->ints[pt->result->addr]);
-}
-
-static mus_float_t pv_synthesize(void *arg)
-{
- mus_xen *gn = (mus_xen *)arg;
- ptree *pt, *outer;
- pt = gn->synthesize_ptree;
- outer = pt->outer_tree;
- outer->clms[pt->args[0]] = gn->gen;
- eval_embedded_ptree(pt, outer);
- return(outer->dbls[pt->result->addr]);
-}
-
-
-static void phase_vocoder_5f(int *args, ptree *pt)
-{
- /* in-coming arg1 is descr of which funcs are active -- all arg ctrs are shifted over one to make room */
- mus_xen *gn = (mus_xen *)mus_environ(CLM_ARG_2);
-
- if (INT_ARG_1 & 1) gn->input_ptree = FNC_ARG_3;
- if (INT_ARG_1 & 2) gn->analyze_ptree = FNC_ARG_4;
- if (INT_ARG_1 & 4) gn->edit_ptree = FNC_ARG_5;
- if (INT_ARG_1 & 8) gn->synthesize_ptree = FNC_ARG_6;
- FLOAT_RESULT = mus_phase_vocoder_with_editors(CLM_ARG_2,
- (INT_ARG_1 & 1) ? src_input : NULL,
- (INT_ARG_1 & 2) ? pv_analyze : NULL,
- (INT_ARG_1 & 4) ? grn_edit : NULL,
- (INT_ARG_1 & 8) ? pv_synthesize : NULL);
-}
-
-
-static void phase_vocoder_1f(int *args, ptree *pt)
-{
- ((mus_xen *)mus_environ(CLM_ARG_1))->input_ptree = FNC_ARG_2;
- FLOAT_RESULT = mus_phase_vocoder(CLM_ARG_1, src_input);
-}
-
-
-static void phase_vocoder_0f(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_phase_vocoder(CLM_ARG_1, NULL);
-}
-
-
-static xen_value *phase_vocoder_1(ptree *prog, xen_value **args, int num_args)
-{
- bool got_input = false, got_edit = false, got_analyze = false, got_synthesize = false;
-
- if (num_args == 5)
- {
- if (args[5]->type == R_FUNCTION)
- {
- ptree *pt;
- pt = ((ptree **)(prog->fncs))[args[5]->addr];
- if (pt->arity != 1) return(run_warn("phase-vocoder: wrong number of args to synthesize function"));
- got_synthesize = true;
- }
- else num_args = 4;
- }
-
- if (num_args >= 4)
- {
- if (args[4]->type == R_FUNCTION)
- {
- ptree *pt;
- pt = ((ptree **)(prog->fncs))[args[4]->addr];
- if (pt->arity != 1) return(run_warn("phase-vocoder: wrong number of args to edit function"));
- got_edit = true;
- }
- else
- {
- if (num_args == 4)
- num_args = 3;
- }
- }
-
- if (num_args >= 3)
- {
- if (args[3]->type == R_FUNCTION)
- {
- ptree *pt;
- pt = ((ptree **)(prog->fncs))[args[3]->addr];
- if (pt->arity != 2) return(run_warn("phase-vocoder: wrong number of args to analyze function"));
- got_analyze = true;
- }
- else
- {
- if (num_args == 3)
- num_args = 2;
- }
- }
-
- if (num_args >= 2)
- {
- if (args[2]->type == R_FUNCTION)
- {
- ptree *pt;
- pt = ((ptree **)(prog->fncs))[args[2]->addr];
- if (pt->arity != 1) return(run_warn("phase-vocoder: wrong number of args to input function"));
- got_input = true;
- }
- else
- {
- if (num_args == 2)
- num_args = 1;
- }
- }
-
- if (num_args == 1)
- return(package(prog, R_FLOAT, phase_vocoder_0f, "phase_vocoder_0f", args, 1));
-
- if (num_args == 2)
- return(package(prog, R_FLOAT, phase_vocoder_1f, "phase_vocoder_1f", args, 2));
-
- /* rather than make 16 different callers, I'll pass along which args are functions in an inserted arg1 */
- {
- int i;
- xen_value **new_args;
- new_args = (xen_value **)calloc(num_args + 2, sizeof(xen_value *));
- for (i = 1; i <= num_args; i++)
- new_args[i + 1] = args[i];
- new_args[1] = make_xen_value(R_INT,
- add_int_to_ptree(prog,
- ((got_input) ? 1 : 0) +
- ((got_analyze) ? 2: 0) +
- ((got_edit) ? 4 : 0) +
- ((got_synthesize) ? 8 : 0)),
- R_CONSTANT);
- new_args[0] = add_temporary_var_to_ptree(prog, R_FLOAT);
- args[0] = new_args[0];
- add_triple_to_ptree(prog, make_triple(phase_vocoder_5f, "phase_vocoder_5f", new_args, num_args + 2));
- free(new_args[1]);
- free(new_args);
- return(args[0]);
- }
-}
-
-
-#define PV_VCT_1(Name) \
-static void pv_ ## Name ## _1(int *args, ptree *pt) \
-{ \
- if (!VCT_RESULT) \
- { \
- s7_pointer res; \
- res = xen_make_vct_wrapper(mus_length(CLM_ARG_1), mus_phase_vocoder_ ## Name (CLM_ARG_1)); \
- add_loc_to_protected_list(pt, s7_gc_protect(s7, res)); \
- VCT_RESULT = xen_to_vct(res); \
- } \
-} \
-static xen_value *phase_vocoder_ ## Name ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- if (args[1]->type == R_CLM) \
- return(package(prog, R_VCT, pv_ ## Name ## _1, "pv_" #Name "_1", args, 1)); \
- return(run_warn("wrong type arg (%s) to mus_phase_vocoder_ " #Name , type_name(args[1]->type))); \
-}
-
-
-PV_VCT_1(amps)
-PV_VCT_1(amp_increments)
-PV_VCT_1(freqs)
-PV_VCT_1(phases)
-PV_VCT_1(phase_increments)
-
-
-
-
-/* ---------------- contrast_enhancement ---------------- */
-
-static void contrast_enhancement_f(int *args, ptree *pt) {FLOAT_RESULT = mus_contrast_enhancement(FLOAT_ARG_1, FLOAT_ARG_2);}
-
-
-static xen_value *contrast_enhancement_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT) single_to_float(prog, args, 1);
- if (args[2]->type == R_INT) single_to_float(prog, args, 2);
- return(package(prog, R_FLOAT, contrast_enhancement_f, "contrast_enhancement_f", args, 2));
-}
-
-
-/* ---------------- ring_modulate ---------------- */
-
-static void ring_modulate_f(int *args, ptree *pt) {FLOAT_RESULT = mus_ring_modulate(FLOAT_ARG_1, FLOAT_ARG_2);}
-
-
-static xen_value *ring_modulate_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT) single_to_float(prog, args, 1);
- if (args[2]->type == R_INT) single_to_float(prog, args, 2);
- return(package(prog, R_FLOAT, ring_modulate_f, "ring_modulate_f", args, 2));
-}
-
-
-/* ---------------- amplitude_modulate ---------------- */
-
-static void amplitude_modulate_f(int *args, ptree *pt) {FLOAT_RESULT = mus_amplitude_modulate(FLOAT_ARG_1, FLOAT_ARG_2, FLOAT_ARG_3);}
-
-
-static xen_value *amplitude_modulate_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[1]->type == R_INT) single_to_float(prog, args, 1);
- if (args[2]->type == R_INT) single_to_float(prog, args, 2);
- if (args[3]->type == R_INT) single_to_float(prog, args, 3);
- return(package(prog, R_FLOAT, amplitude_modulate_f, "amplitude_modulate_f", args, 3));
-}
-
-
-#define SND_STR_OP(CName) \
-static void CName ## _f(int *args, ptree *pt) {INT_RESULT = (Int)CName(STRING_ARG_1);} \
-static xen_value * CName ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- return(package(prog, R_INT, CName ## _f, #CName "_f", args, 1)); \
-}
-
-SND_STR_OP(mus_sound_samples)
-SND_STR_OP(mus_sound_frames)
-SND_STR_OP(mus_sound_datum_size)
-SND_STR_OP(mus_sound_data_location)
-SND_STR_OP(mus_sound_chans)
-SND_STR_OP(mus_sound_srate)
-SND_STR_OP(mus_sound_header_type)
-SND_STR_OP(mus_sound_data_format)
-SND_STR_OP(mus_sound_length)
-SND_STR_OP(mus_sound_type_specifier)
-SND_STR_OP(mus_sound_forget)
-
-
-static void mus_sound_duration_f(int *args, ptree *pt) {FLOAT_RESULT = mus_sound_duration(STRING_ARG_1);}
-
-
-static xen_value *mus_sound_duration_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_FLOAT, mus_sound_duration_f, "mus_sound_duration_f", args, 1));
-}
-
-
-static void mus_sound_comment_f(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_sound_comment(STRING_ARG_1);
-}
-
-
-static xen_value *mus_sound_comment_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_STRING, mus_sound_comment_f, "mus_sound_comment_f", args, 1));
-}
-
-
-static void mus_header_type_name_f(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(mus_header_type_name(INT_ARG_1));
-}
-
-
-static xen_value *mus_header_type_name_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_STRING, mus_header_type_name_f, "mus_header_type_name_f", args, 1));
-}
-
-
-static void mus_data_format_name_f(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(mus_data_format_name(INT_ARG_1));
-}
-
-
-static xen_value *mus_data_format_name_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_STRING, mus_data_format_name_f, "mus_data_format_name_f", args, 1));
-}
-
-
-static void mus_header_type_to_string_f(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(mus_header_type_to_string(INT_ARG_1));
-}
-
-
-static xen_value *mus_header_type_to_string_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_STRING, mus_header_type_to_string_f, "mus_header_type_to_string_f", args, 1));
-}
-
-
-static void mus_data_format_to_string_f(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(mus_data_format_to_string(INT_ARG_1));
-}
-
-
-static xen_value *mus_data_format_to_string_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_STRING, mus_data_format_to_string_f, "mus_data_format_to_string_f", args, 1));
-}
-
-
-/* ---------------- formant-bank ---------------- */
-
-
-static void formant_bank_f(int *args, ptree *pt)
-{
- FLOAT_RESULT = mus_formant_bank(VCT_ARG_1->data,
- VECT_ARG_2->data.gens,
- FLOAT_ARG_3,
- VCT_ARG_1->length);
-}
-
-static xen_value *formant_bank_1(ptree *prog, xen_value **args, int num_args)
-{
- if (args[3]->type == R_INT) single_to_float(prog, args, 3);
- return(package(prog, R_FLOAT, formant_bank_f, "formant_bank_f", args, 3));
-}
-
-
-/* ---------------- mus-srate ---------------- */
-
-static xen_value *mus_srate_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, mus_srate()), R_CONSTANT));
-}
-
-
-
-
-static xen_value *boolean_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_BOOL), R_CONSTANT));
-}
-
-
-static xen_value *number_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (args[1]->type == R_INT) || (args[1]->type == R_FLOAT)), R_CONSTANT));
-}
-
-
-static xen_value *integer_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_INT), R_CONSTANT));
-}
-
-
-static xen_value *inexact_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_FLOAT), R_CONSTANT));
-}
-
-
-static xen_value *exact_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_INT), R_CONSTANT));
-}
-
-
-static xen_value *real_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (args[1]->type == R_INT) || (args[1]->type == R_FLOAT)), R_CONSTANT));
-}
-
-
-static xen_value *char_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_CHAR), R_CONSTANT));
-}
-
-
-static xen_value *string_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_STRING), R_CONSTANT));
-}
-
-#if USE_SND
-static xen_value *sampler_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_SAMPLER), R_CONSTANT));
-}
-#endif
-
-
-static xen_value *keyword_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_KEYWORD), R_CONSTANT));
-}
-
-
-static xen_value *symbol_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_SYMBOL), R_CONSTANT));
-}
-
-
-static xen_value *vct_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_VCT), R_CONSTANT));
-}
-
-
-static xen_value *sound_data_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_SOUND_DATA), R_CONSTANT));
-}
-
-
-static xen_value *vector_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, VECTOR_P(args[1]->type)), R_CONSTANT));
-}
-
-
-static xen_value *list_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(make_xen_value(R_BOOL, add_int_to_ptree(prog, args[1]->type == R_LIST), R_CONSTANT));
-}
-
-
-static xen_value *char_ge_1(ptree *prog, xen_value **args, int num_args)
-{
- return(greater_than_or_equal(prog, false, args, num_args));
-}
-
-
-static xen_value *char_gt_1(ptree *prog, xen_value **args, int num_args)
-{
- return(greater_than(prog, false, args, num_args));
-}
-
-
-static xen_value *char_le_1(ptree *prog, xen_value **args, int num_args)
-{
- return(less_than_or_equal(prog, false, args, num_args));
-}
-
-
-static xen_value *char_lt_1(ptree *prog, xen_value **args, int num_args)
-{
- return(less_than(prog, false, args, num_args));
-}
-
-
-static xen_value *char_eq_1(ptree *prog, xen_value **args, int num_args)
-{
- return(numbers_equal(prog, false, args, num_args));
-}
-
-
-static xen_value *char_ci_ge_1(ptree *prog, xen_value **args, int num_args)
-{
- return(greater_than_or_equal(prog, false, upcase_args(prog, args, num_args), num_args));
-}
-
-
-static xen_value *char_ci_gt_1(ptree *prog, xen_value **args, int num_args)
-{
- return(greater_than(prog, false, upcase_args(prog, args, num_args), num_args));
-}
-
-
-static xen_value *char_ci_le_1(ptree *prog, xen_value **args, int num_args)
-{
- return(less_than_or_equal(prog, false, upcase_args(prog, args, num_args), num_args));
-}
-
-
-static xen_value *char_ci_lt_1(ptree *prog, xen_value **args, int num_args)
-{
- return(less_than(prog, false, upcase_args(prog, args, num_args), num_args));
-}
-
-
-static xen_value *char_ci_eq_1(ptree *prog, xen_value **args, int num_args)
-{
- return(numbers_equal(prog, false, upcase_args(prog, args, num_args), num_args));
-}
-
-
-static xen_value *ge_1(ptree *prog, xen_value **args, int num_args)
-{
- return(greater_than_or_equal(prog, prog->float_result, args, num_args));
-}
-
-
-static xen_value *gt_1(ptree *prog, xen_value **args, int num_args)
-{
- return(greater_than(prog, prog->float_result, args, num_args));
-}
-
-
-static xen_value *le_1(ptree *prog, xen_value **args, int num_args)
-{
- return(less_than_or_equal(prog, prog->float_result, args, num_args));
-}
-
-
-static xen_value *lt_1(ptree *prog, xen_value **args, int num_args)
-{
- return(less_than(prog, prog->float_result, args, num_args));
-}
-
-
-static xen_value *eq_1(ptree *prog, xen_value **args, int num_args)
-{
- return(numbers_equal(prog, prog->float_result, args, num_args));
-}
-
-
-static xen_value *atanx_1(ptree *prog, xen_value **args, int num_args)
-{
- if (num_args == 1)
- return(atan_1(prog, args, num_args));
- return(atan2_1(prog, args, num_args));
-}
-
-
-static xen_value *integer_to_char_1(ptree *prog, xen_value **args, int num_args)
-{
- xen_value *newv;
- newv = copy_xen_value(args[1]);
- newv->type = R_CHAR;
- return(newv);
-}
-
-
-static xen_value *declare_1(ptree *prog, s7_pointer form, walk_result_t ignore) {return(make_xen_value(R_UNSPECIFIED, -1, R_VARIABLE));}
-
-static xen_value *lambda_preform(ptree *prog, s7_pointer form, walk_result_t ignore) {return(lambda_form(prog, form, true, NULL, 0, scheme_false));}
-
-
-
-/* clm-print and xen args support */
-
-static bool xenable(xen_value *v) /* see xen_value_to_xen */
-{
- switch (v->type)
- {
- case R_FLOAT: case R_INT: case R_CHAR: case R_STRING: case R_BOOL: case R_XEN:
- case R_FLOAT_VECTOR: case R_VCT: case R_SOUND_DATA:
- case R_INT_VECTOR:
- case R_KEYWORD: case R_SYMBOL:
- case R_CLM: case R_LIST:
- return(true);
- break;
- default:
- return(CLM_STRUCT_P(v->type));
- break;
- }
- return(false);
-}
-
-
-static s7_pointer wrap_generator(ptree *pt, int addr)
-{
- mus_any *gen;
- gen = pt->clms[addr];
-
-#if USE_SND
- if (pt->clm_locs[addr] >= 0)
- {
- s7_pointer val;
- val = snd_protected_at(pt->clm_locs[addr]); /* try to use the original s7_pointer value holding this generator */
- if ((mus_xen_p(val)) &&
- (gen == XEN_TO_MUS_ANY(val)))
- return(val);
- }
-#else
- if (pt->clm_locs[addr] >= 0)
- {
- s7_pointer val;
- val = s7_gc_protected_at(s7, pt->clm_locs[addr]);
- if ((mus_xen_p(val)) &&
- (gen == XEN_TO_MUS_ANY(val)))
- return(val);
- }
-#endif
-
- /* desperate fallback */
- {
- mus_xen *gn;
- gn = mus_any_to_mus_xen(gen);
- gn->dont_free_gen = true;
- return(mus_xen_to_object(gn));
- }
-}
-
-
-static s7_pointer xen_value_to_xen(ptree *pt, xen_value *v)
-{
- s7_pointer val = scheme_false;
-
- /* fprintf(stderr, "xen_value_to_xen: %s %s\n", type_name(v->type), describe_xen_value(v, pt)); */
-
- switch (v->type)
- {
- case R_FLOAT: return(s7_make_real(s7, pt->dbls[v->addr])); break;
- case R_INT: return(s7_make_integer(s7, pt->ints[v->addr])); break;
- case R_CHAR: return(s7_make_character(s7, (char)(pt->ints[v->addr]))); break;
- case R_STRING: return(scheme_make_string(pt->strs[v->addr])); break;
- case R_BOOL: return(s7_make_boolean(s7, pt->ints[v->addr])); break;
- case R_XEN: return(pt->xens[v->addr]); break;
-
- case R_SYMBOL:
- case R_KEYWORD: return(pt->xens[v->addr]); break;
-
- case R_FLOAT_VECTOR:
- case R_VCT:
- if ((pt->vcts) && (pt->vcts[v->addr]))
- {
- vct *vtemp;
- /* it is necessary to copy the data here to protect it from mus_run_free_ptree:
- *
- * (defgenerator hiho2 (v #f :type vct))
- * (define val (make-hiho2))
- * (run (lambda () (set! (hiho2-v val) (make-vct 32 .1))))
- */
- vtemp = mus_vct_copy(pt->vcts[v->addr]);
- val = xen_make_vct(vtemp->length, vtemp->data);
- free(vtemp);
- }
- break;
-
- case R_INT_VECTOR:
- if (pt->vects[v->addr])
- {
- /* (let ((hi (vector 1 2 3))) (run (lambda () (vector-set! hi 2 4) hi))) */
- /* (run (lambda () (let ((v (make-vector 3 0))) (vector-set! v 1 2) v))) */
- val = s7_make_and_fill_vector(s7, pt->vects[v->addr]->length, scheme_false);
- int_vect_into_vector(pt->vects[v->addr], val);
- }
- break;
-
- /* if xen_value_to_xen for R_CLM|VCT|LIST_VECTOR SAMPLER also in free_xen_var */
- /* clm_vector data.gens=mus_any direct from scheme obj: is it safe to simply repackage? */
-
- case R_SOUND_DATA:
- if ((pt->sds) && (pt->sds[v->addr]))
- {
- sound_data *sd;
- sd = sound_data_copy(pt->sds[v->addr]);
- val = wrap_sound_data(sd->chans, sd->length, sd->data);
- free(sd);
- sd = XEN_TO_SOUND_DATA(val);
- sd->wrapped = false;
- }
- break;
-
- case R_CLM:
- if ((pt->clms) && (pt->clms[v->addr]))
- return(wrap_generator(pt, v->addr)); /* here a mus_copy might be safer */
- break;
-
- default:
- if ((pt->lists) &&
- ((v->type == R_LIST) ||
- (CLM_STRUCT_P(v->type))) &&
- (pt->lists[v->addr]))
- {
- list *xl;
- int i, loc;
- val = scheme_nil;
- loc = s7_gc_protect(s7, val);
- xl = pt->lists[v->addr];
- for (i = 0; i < xl->len; i++)
- val = s7_cons(s7, xen_value_to_xen(pt, xl->vals[i]), val);
- val = s7_reverse(s7, val);
- s7_gc_unprotect_at(s7, loc);
- }
- }
- return(val);
-}
-
-
-static triple *make_xen_arg_triple(ptree *pt,
- void (*function)(int *arg_addrs, ptree *pt),
- const char *op_name,
- xen_value **typed_args, int args)
-{
- triple *trp;
- int *addrs = NULL, *types = NULL;
- addrs = (int *)calloc((args > 3) ? args : 3, sizeof(int));
- types = (int *)calloc((args > 3) ? args : 3, sizeof(int));
- if (args > 0)
- {
- xen_value **xaddrs = NULL;
- int i, xloc = -1;
- xloc = allocate_xen_vars(pt, args);
- xaddrs = pt->xen_vars[xloc];
- addrs[0] = typed_args[0]->addr; /* string result */
- addrs[1] = typed_args[1]->addr; /* num args */
- addrs[2] = xloc; /* addr of indirect arg list */
-
- types[0] = typed_args[0]->type;
- types[1] = typed_args[1]->type;
-
- for (i = 2; i < args; i++)
- {
- xaddrs[i] = typed_args[i];
- types[i] = typed_args[i]->type;
- }
- }
- else addrs[2] = -1;
- trp = (triple *)calloc(1, sizeof(triple));
- trp->function = function;
- trp->args = addrs;
- trp->types = types;
- trp->num_args = args;
- trp->op_name = op_name;
-#if WITH_COUNTERS
- trp->func_loc = get_func_loc(function, op_name);
-#endif
- return(trp);
-}
-
-
-static xen_value *package_n_xen_args(ptree *prog,
- int type,
- void (*function)(int *arg_addrs, ptree *pt),
- const char *descr,
- xen_value **args,
- int num_args)
-{
- int i;
- xen_value **new_args;
- xen_value *rtn;
- new_args = (xen_value **)calloc(num_args + 2, sizeof(xen_value *));
- for (i = 1; i <= num_args; i++)
- {
- new_args[i + 1] = copy_xen_value(args[i]); /* copy so that w->walker can be used (and cleanup args) */
- add_xen_value_to_gcs(prog, new_args[i + 1]);
- }
- new_args[1] = make_xen_value(R_INT, add_int_to_ptree(prog, num_args), R_CONSTANT);
- new_args[0] = add_temporary_var_to_ptree(prog, type);
- add_triple_to_ptree(prog, make_xen_arg_triple(prog, function, descr, new_args, num_args + 2));
- rtn = new_args[0];
- free(new_args[1]);
- free(new_args);
- return(rtn);
-}
-
-
-static s7_pointer xen_values_to_list(ptree *pt, int *args)
-{
- s7_pointer lst = scheme_nil;
- if (args[2] >= 0)
- {
- int i;
- xen_value **xargs = NULL;
- xargs = pt->xen_vars[args[2]];
- for (i = (int)(INT_ARG_1 + 1); i >= 2; i--)
- lst = s7_cons(s7, xen_value_to_xen(pt, xargs[i]), lst);
- }
- return(lst);
-}
-
-
-static void format_s(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(s7_format(s7, xen_values_to_list(pt, args)));
-}
-
-
-static void clm_print_s(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(s7_format(s7, xen_values_to_list(pt, args)));
- fprintf(stderr, "%s", STRING_RESULT);
-}
-
-
-static void s7_version_s(int *args, ptree *pt)
-{
- if (STRING_RESULT) free(STRING_RESULT);
- STRING_RESULT = mus_strdup(S7_VERSION);
-}
-
-static xen_value *s7_version_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_STRING, s7_version_s, "s7_version_s", args, 0));
-}
-
-
-static void open_output_file_s2(int *args, ptree *pt)
-{
- SCHEME_RESULT = s7_open_output_file(s7, STRING_ARG_1, STRING_ARG_2);
-}
-
-static void open_output_file_s1(int *args, ptree *pt)
-{
- SCHEME_RESULT = s7_open_output_file(s7, STRING_ARG_1, "w");
-}
-
-static xen_value *open_output_file_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_XEN, add_xen_to_ptree(prog, s7_nil(s7)), R_VARIABLE);
- if (num_args == 1)
- add_triple_to_ptree(prog, va_make_triple(open_output_file_s1, "open_output_file_s1", 2, args[0], args[1]));
- else add_triple_to_ptree(prog, va_make_triple(open_output_file_s2, "open_output_file_s2", 3, args[0], args[1], args[2]));
- return(args[0]);
-}
-
-
-static void close_output_port_s(int *args, ptree *pt)
-{
- s7_close_output_port(s7, SCHEME_ARG_1);
- BOOL_RESULT = false;
-}
-
-static xen_value *close_output_port_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, close_output_port_s, "close_output_port_s", args, 1));
-}
-
-
-static void close_input_port_s(int *args, ptree *pt)
-{
- s7_close_input_port(s7, SCHEME_ARG_1);
- BOOL_RESULT = false;
-}
-
-static xen_value *close_input_port_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, close_input_port_s, "close_input_port_s", args, 1));
-}
-
-
-static void is_output_port_s(int *args, ptree *pt)
-{
- BOOL_RESULT = s7_is_output_port(s7, SCHEME_ARG_1);
-}
-
-static xen_value *is_output_port_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, is_output_port_s, "is_output_port_s", args, 1));
-}
-
-
-static void is_input_port_s(int *args, ptree *pt)
-{
- BOOL_RESULT = s7_is_input_port(s7, SCHEME_ARG_1);
-}
-
-static xen_value *is_input_port_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, is_input_port_s, "is_input_port_s", args, 1));
-}
-
-
-static void current_output_port_x(int *args, ptree *pt)
-{
- SCHEME_RESULT = s7_current_output_port(s7);
-}
-
-static xen_value *current_output_port_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_XEN, add_xen_to_ptree(prog, s7_nil(s7)), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(current_output_port_x, "current_output_port_x", 1, args[0]));
- return(args[0]);
-}
-
-
-static void current_input_port_x(int *args, ptree *pt)
-{
- SCHEME_RESULT = s7_current_input_port(s7);
-}
-
-static xen_value *current_input_port_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_XEN, add_xen_to_ptree(prog, s7_nil(s7)), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(current_input_port_x, "current_input_port_x", 1, args[0]));
- return(args[0]);
-}
-
-
-static void current_error_port_x(int *args, ptree *pt)
-{
- SCHEME_RESULT = s7_current_error_port(s7);
-}
-
-static xen_value *current_error_port_1(ptree *prog, xen_value **args, int num_args)
-{
- args[0] = make_xen_value(R_XEN, add_xen_to_ptree(prog, s7_nil(s7)), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(current_error_port_x, "current_error_port_x", 1, args[0]));
- return(args[0]);
-}
-
-
-static void file_exists_p(int *args, ptree *pt)
-{
- BOOL_RESULT = mus_file_probe(STRING_ARG_1);
-}
-
-static xen_value *file_exists_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, file_exists_p, "file_exists_p", args, 1));
-}
-
-
-static void getpid_i(int *args, ptree *pt)
-{
- INT_RESULT = getpid();
-}
-
-static xen_value *getpid_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_INT, getpid_i, "getpid_i", args, 0));
-}
-
-
-static xen_value *format_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package_n_xen_args(prog, R_STRING, format_s, "format_s", args, num_args));
-}
-
-
-static xen_value *clm_print_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package_n_xen_args(prog, R_STRING, clm_print_s, "clm_print_s", args, num_args));
-}
-
-
-
-static int saw_mus_error = 0;
-
-static void throw_s_1(int *args, ptree *pt)
-{
- s7_pointer res;
- res = pt->xens[args[1]];
- mus_run_free_ptree(pt);
- /* mus_run_free_ptree handles cleanup/global resets -- can we safely call it here? (i.e. no possible catch within run itself),
- */
- saw_mus_error = 0;
- pt = NULL;
- s7_error(s7, res, scheme_false);
-}
-
-static xen_value *throw_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, throw_s_1, "throw_s_1", args, 1));
-}
-
-
-typedef struct {
- int *lambda_arg_types;
- int lambda_args;
-} lambda_arg_info;
-
-typedef struct {
- int args;
- lambda_arg_info **arg_data;
-} lambda_info;
-
-typedef struct {
- xen_value *(*walker)(ptree *prog, xen_value **args, int num_args);
- xen_value *(*special_walker)(ptree *prog, s7_pointer form, walk_result_t need_result);
- void (*set_walker)(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v);
- int required_args, max_args, result_type, num_arg_types;
- bool need_int_result;
- int *arg_types;
- int data;
- lambda_info *linfo;
-} walk_info;
-
-static walk_info *make_walker(xen_value *(*walker)(ptree *prog, xen_value **args, int num_args),
- xen_value *(*special_walker)(ptree *prog, s7_pointer form, walk_result_t need_result),
- void (*set_walker)(ptree *prog, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v),
- int required_args,
- int max_args,
- int result_type,
- bool need_int_result,
- int num_arg_types,
- ...) /* arg type list, R_NUMBER=int or float, R_ANY=unchecked */
-{
- walk_info *w;
- w = (walk_info *)malloc(sizeof(walk_info));
- w->walker = walker;
- w->special_walker = special_walker;
- w->set_walker = set_walker;
- w->required_args = required_args;
- w->max_args = max_args;
- w->result_type = result_type;
- w->need_int_result = need_int_result;
- w->num_arg_types = num_arg_types;
- w->data = 0;
- w->linfo = NULL;
- if (num_arg_types > 0)
- {
- va_list ap;
- int i;
- va_start(ap, num_arg_types);
- w->arg_types = (int *)calloc(num_arg_types, sizeof(int));
- for (i = 0; i < num_arg_types; i++)
- w->arg_types[i] = (int)(va_arg(ap, int));
- va_end(ap);
- }
- return(w);
-}
-
-static walk_info *walker_with_declare(walk_info *w, int arg, int args, ...)
-{
- lambda_info *li;
- lambda_arg_info *larg;
-
- if (!(w->linfo))
- w->linfo = (lambda_info *)calloc(1, sizeof(lambda_info));
- li = w->linfo;
-
- if (li->args <= arg)
- {
- if (li->args == 0)
- li->arg_data = (lambda_arg_info **)calloc(arg + 1, sizeof(lambda_arg_info *));
- else li->arg_data = (lambda_arg_info **)realloc(li->arg_data, (arg + 1) * sizeof(lambda_arg_info *));
- li->args = arg + 1;
- }
- li->arg_data[arg] = (lambda_arg_info *)calloc(1, sizeof(lambda_arg_info));
-
- larg = li->arg_data[arg];
- larg->lambda_args = args;
- if (args > 0)
- {
- int i;
- va_list ap;
- larg->lambda_arg_types = (int *)calloc(args, sizeof(int));
- va_start(ap, args);
- for (i = 0; i < args; i++)
- larg->lambda_arg_types[i] = (int)(va_arg(ap, int));
- va_end(ap);
- }
-
- return(w);
-}
-
-
-
-/* -------- CLM make functions -------- */
-
-#define CLM_MAKE_FUNC(Name) \
-static void make_ ## Name ## _0(int *args, ptree *pt) \
-{ \
- s7_pointer res; \
- res = s7_call(s7, s7_symbol_value(s7, s7_make_symbol(s7, S_make_ ## Name)), xen_values_to_list(pt, args)); \
- if (mus_xen_p(res)) \
- { \
- if (CLM_LOC >= 0) s7_gc_unprotect_at(s7, CLM_LOC); \
- add_loc_to_protected_list(pt, CLM_LOC = s7_gc_protect(s7, res)); \
- CLM_RESULT = XEN_TO_MUS_ANY(res); \
- } \
- else CLM_RESULT = NULL; \
-} \
-static xen_value *make_ ## Name ## _1(ptree *prog, xen_value **args, int num_args) \
-{ \
- return(package_n_xen_args(prog, R_CLM, make_ ## Name ## _0, "make_" #Name "_0", args, num_args)); \
-}
-
-CLM_MAKE_FUNC(all_pass)
-CLM_MAKE_FUNC(moving_average)
-CLM_MAKE_FUNC(asymmetric_fm)
-CLM_MAKE_FUNC(comb)
-CLM_MAKE_FUNC(filtered_comb)
-CLM_MAKE_FUNC(convolve)
-CLM_MAKE_FUNC(delay)
-CLM_MAKE_FUNC(env)
-CLM_MAKE_FUNC(file_to_frame)
-CLM_MAKE_FUNC(file_to_sample)
-CLM_MAKE_FUNC(filter)
-CLM_MAKE_FUNC(fir_filter)
-CLM_MAKE_FUNC(firmant)
-CLM_MAKE_FUNC(formant)
-CLM_MAKE_FUNC(frame)
-CLM_MAKE_FUNC(frame_to_file)
-CLM_MAKE_FUNC(granulate)
-CLM_MAKE_FUNC(iir_filter)
-CLM_MAKE_FUNC(locsig)
-CLM_MAKE_FUNC(mixer)
-CLM_MAKE_FUNC(notch)
-CLM_MAKE_FUNC(one_pole)
-CLM_MAKE_FUNC(one_zero)
-CLM_MAKE_FUNC(oscil)
-CLM_MAKE_FUNC(phase_vocoder)
-CLM_MAKE_FUNC(pulse_train)
-CLM_MAKE_FUNC(rand)
-CLM_MAKE_FUNC(rand_interp)
-CLM_MAKE_FUNC(readin)
-CLM_MAKE_FUNC(sample_to_file)
-CLM_MAKE_FUNC(sawtooth_wave)
-CLM_MAKE_FUNC(nrxysin)
-CLM_MAKE_FUNC(nrxycos)
-CLM_MAKE_FUNC(square_wave)
-CLM_MAKE_FUNC(src)
-CLM_MAKE_FUNC(ncos)
-CLM_MAKE_FUNC(nsin)
-CLM_MAKE_FUNC(ssb_am)
-CLM_MAKE_FUNC(table_lookup)
-CLM_MAKE_FUNC(triangle_wave)
-CLM_MAKE_FUNC(two_pole)
-CLM_MAKE_FUNC(two_zero)
-CLM_MAKE_FUNC(wave_train)
-CLM_MAKE_FUNC(polyshape)
-CLM_MAKE_FUNC(polywave)
-
-
-static void make_fft_window_0(int *args, ptree *pt)
-{
- s7_pointer res;
- res = s7_call(s7, s7_symbol_value(s7, s7_make_symbol(s7, S_make_fft_window)), xen_values_to_list(pt, args));
- add_loc_to_protected_list(pt, s7_gc_protect(s7, res));
- VCT_RESULT = xen_to_vct(res);
-}
-
-
-static xen_value *make_fft_window_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package_n_xen_args(prog, R_VCT, make_fft_window_0, "make_fft_window_0", args, num_args));
-}
-
-
-#define XEN_TO_ADDR_ERROR -1
-
-static int xen_to_addr(ptree *pt, s7_pointer arg, int type, int addr)
-{
- /* this includes handling args to the outer lambda */
-
- /* fprintf(stderr, "xen to addr: %s %d (%s) %d\n", s7_object_to_c_string(s7, arg), type, type_name(type), addr); */
-
- if ((mus_run_xen_to_run_type(arg) != type) &&
- ((!(s7_is_real(arg))) || ((type != R_FLOAT) && (type != R_INT))))
- {
- /* fprintf(stderr, "types differ "); */
-
- if ((arg == scheme_false) &&
- (POINTER_P(type)))
- {
- /* passed null pointer -- probably won't be what caller intends */
- switch (type)
- {
- /* these special cases we handle in set_var (line 2474) */
- case R_FLOAT_VECTOR:
- case R_VCT: pt->vcts[addr] = NULL; break;
- case R_SOUND_DATA: pt->sds[addr] = NULL; break;
- case R_CLM: pt->clms[addr] = NULL; break;
-#if USE_SND
- case R_SAMPLER: pt->samplers[addr] = NULL; break;
-#endif
- case R_LIST: pt->lists[addr] = NULL; break;
- case R_LIST_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- case R_CLM_VECTOR: pt->vects[addr] = NULL; break;
- default:
- {
- char *temp = NULL;
- run_warn("run: xen_to_addr: %s %s", temp = s7_object_to_c_string(s7, arg), type_name(type));
- if (temp) free(temp);
- return(XEN_TO_ADDR_ERROR);
- }
- break;
- }
- return(addr);
- }
- {
- char *temp = NULL;
- run_warn("run: xen_to_addr 2: %s %s", temp = s7_object_to_c_string(s7, arg), type_name(type));
- if (temp) free(temp);
- }
- return(XEN_TO_ADDR_ERROR);
- }
- switch (type)
- {
- case R_FLOAT: pt->dbls[addr] = (Double)s7_number_to_real(arg); break;
- case R_INT: pt->ints[addr] = s7_number_to_integer(arg); break;
- case R_CHAR: pt->ints[addr] = (Int)s7_character(arg); break;
- case R_BOOL: pt->ints[addr] = (Int)scheme_to_c_bool(arg); break;
- case R_VCT: pt->vcts[addr] = xen_to_vct(arg); break;
- case R_SOUND_DATA: pt->sds[addr] = XEN_TO_SOUND_DATA(arg); break;
- case R_CLM: pt->clms[addr] = XEN_TO_MUS_ANY(arg); break;
-#if USE_SND
- case R_SAMPLER: pt->samplers[addr] = xen_to_sampler(arg); break;
- case R_MARK: pt->ints[addr] = XEN_MARK_TO_C_INT(arg); break;
- case R_MIX: pt->ints[addr] = XEN_MIX_TO_C_INT(arg); break;
- case R_REGION: pt->ints[addr] = XEN_REGION_TO_C_INT(arg); break;
- case R_SOUND: pt->ints[addr] = XEN_SOUND_TO_C_INT(arg); break;
-#endif
- case R_SYMBOL:
- case R_KEYWORD: pt->xens[addr] = arg; break;
-
- case R_STRING:
- if (!(pt->strs[addr]))
- pt->strs[addr] = mus_strdup(s7_string(arg));
- break;
-
- case R_FLOAT_VECTOR:
- if (!(pt->vcts[addr]))
- {
- pt->vcts[addr] = vector_to_vct(arg);
- add_obj_to_gcs(pt, R_FLOAT_VECTOR, addr);
- }
- break;
-
- case R_LIST_VECTOR:
- case R_INT_VECTOR:
- case R_VCT_VECTOR:
- case R_CLM_VECTOR:
- if (!(pt->vects[addr]))
- {
- pt->vects[addr] = read_vector(pt, arg, type);
- add_obj_to_gcs(pt, type, addr);
- }
- break;
-
- default:
- if ((type == R_LIST) ||
- (CLM_STRUCT_P(type)))
- {
- /* fprintf(stderr,"adding arg list..."); */
- pt->lists[addr] = xen_to_list_with_type(pt, arg, (type == R_LIST) ? R_FLOAT : type);
- add_obj_to_gcs(pt, type, addr);
- /* fprintf(stderr,"!\n"); */
- }
- break;
- }
- return(addr);
-}
-
-
-static xen_value *quote_form(ptree *prog, s7_pointer form, walk_result_t ignore)
-{
- xen_value *v;
-
- v = add_value_to_ptree(prog, scheme_cadr(form), mus_run_xen_to_run_type(scheme_cadr(form)));
- if (v == NULL)
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("quote can't handle %s", temp = s7_object_to_c_string(s7, form));
- if (temp) free(temp);
- return(rv);
- }
- v->constant = R_CONSTANT;
- return(v);
-}
-
-
-
-/* defgenerator support */
-
-static void clm_struct_p(int *args, ptree *pt)
-{
- BOOL_RESULT = (INT_ARG_2 == LIST_ARG_1->type);
-}
-
-
-static xen_value *clm_struct_p_1(ptree *prog, xen_value **args, int num_args)
-{
- return(package(prog, R_BOOL, clm_struct_p, "clm_struct_p", args, num_args));
-}
-
-
-static int add_clm_type(s7_pointer name)
-{
- char *type_predicate_name;
- int run_type;
- walk_info *w;
-
- run_type = add_new_type(s7_string(name));
- type_predicate_name = (char *)calloc(strlen(type_name(run_type)) + 2, sizeof(char));
- sprintf(type_predicate_name, "%s?", type_name(run_type));
-
- w = make_walker(clm_struct_p_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY);
- w->data = run_type;
-
- scheme_set_walker((s7_pointer)(s7_make_symbol(s7, type_predicate_name)),
- s7_make_c_pointer(s7, (void *)w));
-
- return(run_type);
-}
-
-
-typedef struct {
- int fields;
- int *field_types;
- char **field_names;
-} dcs;
-
-static dcs **def_clm_structs = NULL;
-static int def_clm_structs_size = 0;
-
-
-#define S_add_clm_field "add-clm-field"
-
-static s7_pointer g_add_clm_field(s7_pointer struct_name, s7_pointer name, s7_pointer offset, s7_pointer type)
-{
- #define H_add_clm_field "defgenerator tie-in to run optimizer"
- const char *field_name;
- int field_offset, clm_struct_type, field_type;
- dcs *d;
- walk_info *w;
-
- XEN_ASSERT_TYPE(s7_is_string(struct_name), struct_name, 1, S_add_clm_field, "string");
- XEN_ASSERT_TYPE(s7_is_string(name), name, 2, S_add_clm_field, "string");
- XEN_ASSERT_TYPE(s7_is_integer(offset), offset, 3, S_add_clm_field, "int");
- XEN_ASSERT_TYPE(s7_is_symbol(type), type, 4, S_add_clm_field, "symbol");
-
- clm_struct_type = name_to_type(s7_string(struct_name));
- if (clm_struct_type == R_UNSPECIFIED)
- clm_struct_type = add_clm_type(struct_name);
-
- field_name = s7_string(name);
- field_type = name_to_type(s7_symbol_name(type));
- field_offset = s7_number_to_integer(offset);
-
- /* fprintf(stderr, "add %s to %s (%d) at %d type %s\n", field_name, s7_string(struct_name), clm_struct_type, field_offset, type_name(field_type)); */
-
- if (clm_struct_type >= def_clm_structs_size)
- {
- def_clm_structs_size = clm_struct_type + 1;
- if (!def_clm_structs)
- def_clm_structs = (dcs **)calloc(def_clm_structs_size, sizeof(dcs *));
- else def_clm_structs = (dcs **)realloc(def_clm_structs, def_clm_structs_size * sizeof(dcs *));
- def_clm_structs[clm_struct_type] = (dcs *)calloc(1, sizeof(dcs));
- }
-
- d = def_clm_structs[clm_struct_type];
- if (field_offset >= d->fields)
- {
- if (d->fields == 0)
- {
- d->fields = 8;
- d->field_types = (int *)calloc(d->fields, sizeof(int));
- d->field_names = (char **)calloc(d->fields, sizeof(char *));
- }
- else
- {
- d->fields *= 2;
- d->field_types = (int *)realloc(d->field_types, d->fields * sizeof(int));
- d->field_names = (char **)realloc(d->field_names, d->fields * sizeof(char *));
- }
- }
- d->field_types[field_offset] = field_type;
- d->field_names[field_offset] = mus_strdup(field_name);
-
- /* now declare the get and set walkers */
-
- w = make_walker(list_ref_1, NULL, clm_struct_field_set_1, 1, 1, field_type, false, 1, R_LIST);
- w->data = field_offset;
-
- scheme_set_walker((s7_pointer)(s7_make_symbol(s7, field_name)),
- s7_make_c_pointer(s7, (void *)w));
-
- return(name);
-}
-
-
-static int def_clm_struct_field_type(int def_clm_struct_type, int field)
-{
- dcs *d;
- d = def_clm_structs[def_clm_struct_type];
- if ((d) &&
- (field < d->fields))
- return(d->field_types[field]); /* there are trailing empty field slots, so this just guards against reading off the end of the array */
- return(R_UNSPECIFIED);
-}
-
-
-static char *def_clm_struct_field_name(int def_clm_struct_type, int field)
-{
- dcs *d;
- d = def_clm_structs[def_clm_struct_type];
- if ((d) &&
- (field < d->fields))
- return(d->field_names[field]);
- return(mus_strdup("unknown clm-struct field"));
-}
-
-
-
-
-
-/* ---------------- the code walker ---------------- */
-
-static xen_value *clean_up(xen_value *result, xen_value **args, int args_size)
-{
- int i;
- /* args[0] is special */
- if ((args[0]) && (args[0] != result)) free(args[0]);
- for (i = 1; i <= args_size; i++)
- if (args[i])
- {
- free(args[i]);
- args[i] = NULL;
- }
- free(args);
- return(result);
-}
-
-
-static bool vowel_p(char b)
-{
- return((b == 'a') || (b == 'e') || (b == 'i') || (b == 'o') || (b == 'u'));
-}
-
-
-static xen_value *arg_warn(ptree *prog, const char *funcname, int arg_num, xen_value **args, const char *correct_type)
-{
- char *xb;
- const char *tb;
- xb = describe_xen_value_with_var_name(args[arg_num]->type, args[arg_num]->addr, prog);
- tb = type_name(args[arg_num]->type);
- if (xb)
- {
- run_warn("%s argument %d (%s) is a%s %s, not a%s %s?",
- funcname, arg_num, xb,
- (vowel_p(tb[0])) ? "n" : "", tb,
- (vowel_p(correct_type[0])) ? "n" : "", correct_type);
- free(xb);
- }
- else
- run_warn("%s argument %d is a%s %s, not a%s %s?",
- funcname, arg_num,
- (vowel_p(tb[0])) ? "n" : "", tb,
- (vowel_p(correct_type[0])) ? "n" : "", correct_type);
- return(NULL);
-}
-
-
-static xen_value *walk(ptree *prog, s7_pointer form, walk_result_t walk_result)
-{
- /* walk form, storing vars, making program entries for operators etc */
- s7_pointer rtnval = scheme_false;
-
- /* fprintf(stderr, "walk %s\n", s7_object_to_c_string(s7, form)); */
-
- if (current_optimization == DONT_OPTIMIZE) return(NULL);
-
- if (s7_is_list(s7, form))
- {
- s7_pointer function, all_args;
- const char *funcname = "not-a-function";
- xen_value **args = NULL;
- int i, num_args, constants = 0;
- bool float_result = false;
- xen_var *var;
- xen_value *v = NULL;
- s7_pointer walker;
- walk_info *w = NULL;
-
- function = s7_car(form);
- all_args = s7_cdr(form);
- num_args = s7_list_length(s7, all_args);
- if (s7_is_symbol(function))
- {
-#if 0
- /* this is slow for some reason -- perhaps move it down? */
- if (s7_is_macro(s7, function))
- {
- /* if it's a macro we want to apply its procedure-source to the form, then walk the result
- */
- s7_pointer new_form;
- new_form = s7_apply_function(s7, function, form);
- /* fprintf(stderr, "macro-> %s\n", s7_object_to_c_string(s7, new_form)); */
- return(walk(prog, new_form, walk_result));
- }
-#endif
- walker = scheme_walker(function);
- if (s7_is_c_pointer(walker))
- {
- w = (walk_info *)(s7_c_pointer(walker));
- if ((w) && (w->special_walker))
- {
- if (num_args < w->required_args)
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("missing expression for %s: %s", s7_symbol_name(function), temp = s7_object_to_c_string(s7, form));
- if (temp) free(temp);
- return(rv);
- }
-
- if ((w->max_args != UNLIMITED_ARGS) &&
- (num_args > w->max_args))
- {
- xen_value *rv;
- char *temp = NULL;
- rv = run_warn("too many expressions for %s: %s", s7_symbol_name(function), temp = s7_object_to_c_string(s7, form));
- if (temp) free(temp);
- return(rv);
- }
-
- return((*(w->special_walker))(prog, form, walk_result));
- }
- }
- funcname = s7_symbol_name(function);
- }
- /* check for ((setter ...) ...) before messing up the args */
- if (s7_is_list(s7, function))
- {
- s7_pointer caar;
- const char *caar_name;
- caar = s7_car(function);
- if (s7_is_symbol(caar))
- {
- caar_name = s7_symbol_name(caar);
- if (safe_strcmp(caar_name, "setter") == 0)
- {
- /* should be clm-struct ref: ((setter moog-y) gen .1) for example */
- /* transform (back) to (set! (moog-y gen) .1) */
- /* fprintf(stderr, "got setter: %s\n", s7_object_to_c_string(s7, form)); */
- return(generalized_set_form(prog,
- s7_append(s7, scheme_list_2(s7_make_symbol(s7, "set!"),
- scheme_list_2(scheme_cadr(function),
- s7_car(all_args))),
- s7_cdr(all_args))));
- /* should this be all but last in accessor, then last as set value? */
- }
- }
- }
-
- args = (xen_value **)calloc(num_args + 1, sizeof(xen_value *));
- if (num_args > 0)
- {
- walk_result_t arg_result = NEED_ANY_RESULT;
- for (i = 0; i < num_args; i++, all_args = s7_cdr(all_args))
- {
- arg_result = NEED_ANY_RESULT;
- if (w)
- {
- if ((w->need_int_result) ||
- ((i < w->num_arg_types) && (w->arg_types[i] == R_INT)))
- arg_result = NEED_INT_RESULT;
-
- /* if arg might be a function, check for auto-declare */
- if ((w->linfo) &&
- (w->linfo->args > i) &&
- (w->linfo->arg_data[i]) &&
- (i < w->num_arg_types) &&
- ((w->arg_types[i] == R_FUNCTION) || (w->arg_types[i] == R_ANY)))
- {
- prog->lambda_args = w->linfo->arg_data[i]->lambda_args;
- prog->lambda_arg_types = w->linfo->arg_data[i]->lambda_arg_types;
- }
- }
-
- args[i + 1] = walk(prog, s7_car(all_args), arg_result);
-
- if (prog->lambda_args > 0)
- {
- prog->lambda_args = 0;
- prog->lambda_arg_types = NULL;
- }
-
- /*
- fprintf(stderr,"%s ->", s7_object_to_c_string(s7, s7_car(all_args)));
- if (args[i+1])
- fprintf(stderr," %d %d\n", args[i+1]->type, args[i+1]->addr);
- else fprintf(stderr,"null\n");
- */
-
- if (args[i + 1] == NULL)
- return(clean_up(NULL, args, num_args)); /* no run_warn here so that reported error includes enclosing form */
- if (args[i + 1]->constant == R_CONSTANT) constants++;
- if (args[i + 1]->type == R_FLOAT) float_result = true; /* for "*" et al */
- }
- }
-
- if (w == NULL) /* we're in a list, looking at car, and we don't optimize locally defined functions, so this should be ok */
- {
- /* check user-defined stuff */
- var = find_var_in_ptree(prog, funcname); /* can be "not-a-function" if function is not a symbol (an expression normally) */
- if (var == NULL)
- {
- /* add_global_var will find things like *, but ignores functions and returns null */
- if (s7_is_symbol(function))
- {
- /* fprintf(stderr,"no walker, add %s\n", s7_object_to_c_string(s7, function)); */
-
- v = add_global_var_to_ptree(prog, function, &rtnval);
- /* if all else fails, we'll check rtnval later for externally defined functions */
- }
- /* (let ((gen (make-oscil 440))) (vct-map! v (lambda () (gen 0.0)))) */
- else
- {
- if (s7_is_list(s7, function))
- v = walk(prog, function, NEED_ANY_RESULT);
- }
- /* trying to support stuff like ((vector-ref gens 0) 0.0) here */
- }
- else v = var->v;
-
- if (v)
- {
- xen_value *res = NULL;
- switch (v->type)
- {
-#if USE_SND
- case R_SAMPLER:
- if (num_args == 0) res = sampler_0(prog, args, v);
- break;
-#endif
- case R_CLM:
- res = clm_n(prog, args, num_args, v);
- /* this calls mus_run so it also handles (in a kludgey way) frame and mixer refs */
- break;
-
- case R_BOOL:
- case R_GOTO:
- if (num_args == 0) res = goto_0(prog, args, v);
- break;
-
- case R_FUNCTION:
- res = funcall_n(prog, args, num_args, v);
- break;
-
- case R_VCT:
- case R_FLOAT_VECTOR:
- res = vct_n(prog, args, num_args, v);
- break;
-
- case R_CLM_VECTOR:
- args[0] = make_xen_value(R_CLM, add_clm_to_ptree(prog, NULL, scheme_false), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(vector_ref_c, "clm_vector_ref", 3, args[0], v, args[1]));
- res = args[0];
- break;
-
- case R_INT_VECTOR:
- args[0] = make_xen_value(R_INT, add_int_to_ptree(prog, 0), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(vector_ref_i, "int_vector_ref", 3, args[0], v, args[1]));
- res = args[0];
- break;
-
- case R_VCT_VECTOR:
- args[0] = make_xen_value(R_VCT, add_vct_to_ptree(prog, NULL), R_VARIABLE);
- add_triple_to_ptree(prog, va_make_triple(vector_ref_v, "vct_vector_ref", 3, args[0], v, args[1]));
- res = args[0];
- break;
-
- case R_SOUND_DATA:
- res = sound_data_n(prog, args, num_args, v);
- break;
-
- /* fall through here if unknown function encountered (will give up later) */
- }
- if (var == NULL) {free(v); v = NULL;}
- if (res) return(clean_up(res, args, num_args));
- }
-
- if (prog->goto_ctr > 0)
- {
- /* possibly continuation procedure */
- continuation *c = NULL;
- for (i = prog->goto_ctr - 1; i >= 0; i--)
- {
- c = prog->gotos[i];
- if ((c) &&
- (mus_strcmp(c->name, funcname)))
- {
- if (num_args > 0)
- {
- if (c->result)
- {
- if (c->result->type != args[1]->type)
- return(clean_up(run_warn("continuation types differ"), args, num_args));
- }
- else c->result = add_empty_var_to_ptree(prog, args[1]->type);
- set_var(prog, c->result, args[1]);
- }
- add_triple_to_ptree(prog, va_make_triple(jump_abs, "jump_abs", 1, c->jump));
- return(clean_up(copy_xen_value((c->result) ? c->result : c->jump), args, num_args));
- }
- }
- }
- }
-
- if (w)
- {
- int i, args_to_check, true_type;
- if (num_args < w->required_args)
- return(clean_up(run_warn("not enough args (%d) for %s", num_args, funcname), args, num_args));
-
- if ((w->max_args != UNLIMITED_ARGS) &&
- (num_args > w->max_args))
- return(clean_up(run_warn("too many args (%d) for %s", num_args, funcname), args, num_args));
-
- args_to_check = num_args;
- /* neg type = all args are this type */
-
- if ((w->num_arg_types == 1) &&
- (w->arg_types[0] < 0))
- {
- /* check all :rest args */
- true_type = -(w->arg_types[0]);
-
- for (i = 1; i <= num_args; i++)
- if ((args[i]->type != true_type) &&
- (((true_type != R_NUMBER) ||
- ((args[i]->type != R_INT) &&
- (args[i]->type != R_FLOAT))) &&
- ((true_type != R_XEN) ||
- (!(xenable(args[i]))))))
- return(clean_up(arg_warn(prog, funcname, i, args, type_name(true_type)), args, num_args));
- }
- else
- {
- if (w->num_arg_types < args_to_check) args_to_check = w->num_arg_types;
- for (i = 0; i < args_to_check; i++)
- {
- /* fprintf(stderr, "check %d: %s %s\n", i + 1, type_name(w->arg_types[i]), type_name(args[i + 1]->type)); */
-
- if ((w->arg_types[i] != args[i + 1]->type) &&
- (w->arg_types[i] != R_ANY) &&
- (!(((POINTER_P(w->arg_types[i])) || (w->arg_types[i] == R_FUNCTION)) && (args[i + 1]->type == R_BOOL))))
- {
- switch (w->arg_types[i])
- {
- case R_NUMBER:
- if ((args[i + 1]->type != R_INT) &&
- (args[i + 1]->type != R_FLOAT))
- return(clean_up(arg_warn(prog, funcname, i + 1, args, "number"), args, num_args));
- break;
-
- case R_VECTOR:
- if (!(VECTOR_P(args[i + 1]->type)))
- return(clean_up(arg_warn(prog, funcname, i + 1, args, "vector"), args, num_args));
- break;
-
- case R_XEN:
- if (!(xenable(args[i + 1])))
- return(clean_up(arg_warn(prog, funcname, i + 1, args, "indirect"), args, num_args));
- break;
-
- case R_NUMBER_CLM:
- if ((args[i + 1]->type != R_INT) &&
- (args[i + 1]->type != R_FLOAT) &&
- (args[i + 1]->type != R_CLM))
- return(clean_up(arg_warn(prog, funcname, i + 1, args, "clm or number"), args, num_args));
- break;
-
- case R_NUMBER_VCT:
- if ((args[i + 1]->type != R_INT) &&
- (args[i + 1]->type != R_FLOAT) &&
- (args[i + 1]->type != R_VCT))
- return(clean_up(arg_warn(prog, funcname, i + 1, args, "vct or number"), args, num_args));
- break;
-
- case R_NUMBER_SOUND_DATA:
- if ((args[i + 1]->type != R_INT) &&
- (args[i + 1]->type != R_FLOAT) &&
- (args[i + 1]->type != R_SOUND_DATA))
- return(clean_up(arg_warn(prog, funcname, i + 1, args, "sound_data or number"), args, num_args));
- break;
-
- case R_LIST:
- if ((args[i + 1]->type != R_LIST) &&
- (!(CLM_STRUCT_P(args[i + 1]->type))))
- return(clean_up(arg_warn(prog, funcname, i + 1, args, "list"), args, num_args));
- break;
-
- case R_GENERATOR:
- if ((args[i + 1]->type != R_CLM) &&
- (!(CLM_STRUCT_P(args[i + 1]->type))) &&
- (args[i + 1]->type != R_BOOL))
- return(clean_up(arg_warn(prog, funcname, i + 1, args, "generator"), args, num_args));
- break;
-
- default:
- return(clean_up(arg_warn(prog, funcname, i + 1, args, type_name(w->arg_types[i])), args, num_args));
- }
- }
- }
- }
-
- if (w->walker)
- {
- prog->constants = constants;
- prog->float_result = float_result;
- prog->walk_result = walk_result;
- if (w->data != 0)
- {
- args = (xen_value **)realloc(args, (num_args + 2) * sizeof(xen_value *));
- args[num_args + 1] = make_xen_value(R_INT, add_int_to_ptree(prog, w->data), R_CONSTANT);
- num_args++;
- }
- return(clean_up((*(w->walker))(prog, args, num_args), args, num_args));
- }
- }
-
- /* check for function defined elsewhere, get source, splice in if possible */
- if ((v == NULL) &&
- (current_optimization >= SOURCE_OK) &&
- (s7_is_procedure(rtnval)) &&
- (!(s7_is_procedure_with_setter(rtnval)))
- )
- {
- /* fprintf(stderr, "look for %s\n", s7_object_to_c_string(s7, rtnval)); */
-
- v = splice_in_function_body(prog, rtnval, args, num_args, funcname);
- if (v)
- return(clean_up(v, args, num_args));
- }
-
- if ((walk_result) || (s7_is_list(s7, form)))
- /* need the list check as well because the called function might have side-effects */
- return(clean_up(NULL, args, num_args));
-
- return(clean_up(make_xen_value(R_UNSPECIFIED, -1, R_CONSTANT), args, num_args));
- }
- else /* not a list */
- {
- int type;
-
- if ((s7_is_symbol(form)) &&
- (s7_is_constant(form)))
- {
- /* fprintf(stderr, "constant form: %s\n", s7_object_to_c_string(s7, form)); */
- form = s7_symbol_local_value(s7, form, s7_cdr(prog->code));
- }
-
- type = mus_run_xen_to_run_type(form);
- /* fprintf(stderr, "line 15924 %s %s\n", s7_object_to_c_string(s7, form), type_name(type)); */
-
- switch (type)
- {
- case R_INT: return(make_xen_value(R_INT, add_int_to_ptree(prog, s7_number_to_integer(form)), R_CONSTANT)); break;
- case R_FLOAT: return(make_xen_value(R_FLOAT, add_dbl_to_ptree(prog, s7_number_to_real(form)), R_CONSTANT)); break;
- case R_STRING: return(make_xen_value(R_STRING, add_string_to_ptree(prog, mus_strdup(s7_string(form))), R_CONSTANT)); break;
- case R_CHAR: return(make_xen_value(R_CHAR, add_int_to_ptree(prog, (Int)(s7_character(form))), R_CONSTANT)); break;
- case R_BOOL: return(make_xen_value(R_BOOL, add_int_to_ptree(prog, (form == scheme_false) ? 0 : 1), R_CONSTANT)); break;
- case R_KEYWORD: return(make_xen_value(R_KEYWORD, add_xen_to_ptree(prog, form), R_CONSTANT)); break;
-#if USE_SND
- case R_SOUND: return(make_xen_value(R_SOUND, add_int_to_ptree(prog, XEN_SOUND_TO_C_INT(form)), R_CONSTANT)); break;
- case R_MIX: return(make_xen_value(R_MIX, add_int_to_ptree(prog, XEN_MIX_TO_C_INT(form)), R_CONSTANT)); break;
- case R_MARK: return(make_xen_value(R_MARK, add_int_to_ptree(prog, XEN_MARK_TO_C_INT(form)), R_CONSTANT)); break;
- case R_REGION: return(make_xen_value(R_REGION, add_int_to_ptree(prog, XEN_REGION_TO_C_INT(form)), R_CONSTANT)); break;
-#endif
- }
-
- if (s7_is_symbol(form))
- {
- s7_pointer ignore = scheme_false;
- prog->walk_result = walk_result;
- return(add_global_var_to_ptree(prog, form, &ignore)); /* misleading name -- this handles any variable reference */
- }
- /* things like complex numbers fall through here */
- }
-
- if (!run_warned)
- {
- xen_value *rv;
- char *temp1 = NULL, *temp2 = NULL;
- /* fprintf(stderr, "walker can't handle %s\n", s7_object_to_c_string(s7, form)); */
- rv = run_warn("can't handle: %s (%s)", temp1 = s7_object_to_c_string(s7, form), temp2 = s7_object_to_c_string(s7, s7_procedure_source(s7, prog->code)));
- if (temp1) free(temp1);
- if (temp2) free(temp2);
- return(rv);
- }
-
- return(NULL);
-}
-
-
-static xen_value *lookup_generalized_set(ptree *prog, s7_pointer acc_form, xen_value *in_v, xen_value *in_v1, xen_value *in_v2, xen_value *v)
-{
- int happy = 0;
- s7_pointer walker;
- walk_info *w = NULL;
-
- walker = scheme_walker(acc_form);
- if (s7_is_c_pointer(walker))
- {
- w = (walk_info *)(s7_c_pointer(walker));
- if (w)
- {
- if ((w->set_walker) &&
- ((v->type == w->result_type) ||
- ((w->result_type == R_NUMBER) &&
- ((v->type == R_FLOAT) || (v->type == R_INT)))))
- {
- if (w->data != 0)
- in_v2 = make_xen_value(R_INT, w->data, R_CONSTANT);
- (*(w->set_walker))(prog, in_v, in_v1, in_v2, v);
- happy = 1;
- }
- else
- {
- char *xb;
- const char *tb, *vb;
- xb = describe_xen_value(v, prog);
- tb = type_name(w->result_type);
- vb = type_name(v->type);
- run_warn("can't set %s (a%s %s) to %s (a%s %s)",
- s7_symbol_name(acc_form),
- (vowel_p(tb[0])) ? "n" : "", tb,
- xb,
- (vowel_p(vb[0])) ? "n" : "", vb);
- if (xb) free(xb);
- happy = 2;
- }
- }
- }
-
- {
- xen_value *val;
- val = walk(prog, acc_form, DONT_NEED_RESULT);
- /*
- fprintf(stderr, "val: %s, v: %s, in_v: %s, in_v1: %s, in_v2: %s\n",
- (val) ? describe_xen_value(val, prog) : "null",
- (v) ? describe_xen_value(v, prog) : "null",
- (in_v) ? describe_xen_value(in_v, prog) : "null",
- (in_v1) ? describe_xen_value(in_v1, prog) : "null",
- (in_v2) ? describe_xen_value(in_v2, prog) : "null");
- */
- /* val is the gen, v is the new value, in_v is the 1st index, in_v1 is 2nd index if it exists */
- if (val)
- {
- if ((val->type == R_VCT) ||
- (val->type == R_FLOAT_VECTOR))
- {
- /* (let ((v (vct 1.0 2.0 3.0))) (run (lambda () (set! (v 1) 0.5)))) */
- vct_set_1(prog, val, in_v, NULL, v);
- happy = 1;
- }
- else
- {
- if (val->type == R_SOUND_DATA)
- {
- /* (let ((sd (make-sound-data 2 2))) (run (lambda () (set! (sd 1 0) 1.0))) sd) */
- sound_data_set_1(prog, val, in_v, in_v1, v);
- happy = 1;
- }
- else
- {
- if (val->type == R_CLM)
- {
- /* (let ((mx (make-mixer 2))) (run (lambda () (set! (mx 0 1) 1.0))) mx) */
- /* (let ((fr (make-frame 2))) (run (lambda () (set! (fr 1) 1.0))) fr) */
- clm_set_1(prog, val, in_v, in_v1, v);
- happy = 1;
- }
- else
- {
- if (val->type == R_INT_VECTOR)
- {
- /* (let ((v (vector 1 2 3))) (run (set! (v 1) 32) (v 1))) */
- int_vector_set_1(prog, val, in_v, NULL, v);
- happy = 1;
- }
- }
- }
- }
- free(val);
- }
- }
-
- if (in_v) free(in_v);
- if (in_v1) free(in_v1);
- if (in_v2) free(in_v2);
- if (happy == 1) return(v);
- if (v) free(v);
- if (happy == 0) run_warn("can't set %s", s7_symbol_name(acc_form));
-
- return(NULL);
-}
-
-
-typedef enum {NO_PTREE_DISPLAY, STDERR_PTREE_DISPLAY, LISTENER_PTREE_DISPLAY, GCAT_PTREE_WITHOUT_DISPLAY} ptree_display_t;
-
-#ifndef DESCRIBE_PTREE_INIT
- static ptree_display_t ptree_on = NO_PTREE_DISPLAY;
-#else
- static ptree_display_t ptree_on = DESCRIBE_PTREE_INIT;
-#endif
-
-
-static s7_pointer g_show_ptree(s7_pointer on)
-{
- #define S_show_ptree "show-ptree"
- #define H_show_ptree "(show-ptree arg): if arg is not 0, the optimizer's parse tree is displayed. \
-arg = 1 sends it to stderr, 2 to the listener, 3 is for gcat's use. "
-
- ptree_on = (ptree_display_t)s7_number_to_integer(on);
- return(on);
-}
-
-static struct ptree *form_to_ptree_1(s7_pointer code, int decls, int *types)
-{
- ptree *prog;
- s7_pointer form;
- run_warned = false;
-
-#if USE_SND
- current_optimization = optimization(ss);
-#endif
- if (current_optimization == DONT_OPTIMIZE) return(NULL);
- if (code == scheme_nil) return(NULL);
-
- form = s7_car(code);
- /* env is cdr in s7 */
-
- prog = make_ptree(8);
-
- prog->lambda_args = decls;
- prog->lambda_arg_types = types;
- prog->code = code;
- if (s7_is_symbol(form))
- {
- mus_run_free_ptree(prog);
- return(NULL);
- }
-
- /* fprintf(stderr, "form->ptree: %s\n", s7_object_to_c_string(s7, form)); */
-
- prog->result = walk(prog, form, NEED_ANY_RESULT);
- if (prog->result)
- {
- add_triple_to_ptree(prog, make_triple(quit, "quit", NULL, 0));
-
- if (ptree_on != NO_PTREE_DISPLAY)
- {
- char *msg;
- msg = describe_ptree(prog, " ");
- if (ptree_on == STDERR_PTREE_DISPLAY) fprintf(stderr, "%s", msg);
-#if USE_SND
- else if (ptree_on == LISTENER_PTREE_DISPLAY) listener_append(msg);
-#endif
- free(msg);
- }
-
- prog->form = form;
- prog->form_loc = s7_gc_protect(s7, prog->form);
- return(prog);
- }
-
- mus_run_free_ptree(prog);
- if (!run_warned)
- {
- char *temp = NULL;
- run_warn("can't optimize: %s\n", temp = s7_object_to_c_string(s7, form));
- if (temp) free(temp);
- }
- return(NULL);
-}
-
-
-static struct ptree *form_to_ptree(s7_pointer code)
-{
- return(form_to_ptree_1(code, 0, NULL));
-}
-
-
-static struct ptree *form_to_ptree_with_predeclarations(s7_pointer code, int decls, ...)
-{
- ptree *result;
- int *types = NULL;
-
- if (decls > 0)
- {
- int i;
- va_list ap;
-
- types = (int *)calloc(decls, sizeof(int));
- va_start(ap, decls);
- for (i = 0; i < decls; i++)
- types[i] = va_arg(ap, int);
- va_end(ap);
- }
-
- result = form_to_ptree_1(code, decls, types);
- free(types);
- return(result);
-}
-
-
-
-
-
-/* ---------------- various tree-building wrappers ---------------- */
-
-struct ptree *mus_run_form_to_ptree_1_f(s7_pointer code)
-{
- /* map-channel and simple form of ptree-channel */
- ptree *pt;
- pt = form_to_ptree_with_predeclarations(code, 1, R_FLOAT);
- if (pt)
- {
- if ((pt->result->type == R_FLOAT) && (pt->arity == 1))
- return(pt);
- mus_run_free_ptree(pt);
- }
- return(NULL);
-}
-
-
-struct ptree *mus_run_form_to_ptree_3_f(s7_pointer code)
-{
- /* ptree-channel, snd-sig.c */
- ptree *pt;
- pt = form_to_ptree_with_predeclarations(code, 3, R_FLOAT, R_VCT, R_BOOL);
- if (pt)
- {
- if ((pt->result->type == R_FLOAT) && (pt->arity == 3))
- return(pt);
- mus_run_free_ptree(pt);
- }
- return(NULL);
-}
-
-
-struct ptree *mus_run_form_to_ptree_0_f(s7_pointer code)
-{
- /* vct-map! */
- ptree *pt;
- pt = form_to_ptree(code);
- if (pt)
- {
- if ((pt->result->type == R_FLOAT) && (pt->arity == 0))
- return(pt);
- mus_run_free_ptree(pt);
- }
- return(NULL);
-}
-
-
-struct ptree *mus_run_form_to_ptree_1_b(s7_pointer code)
-{
- /* find */
- ptree *pt;
- pt = form_to_ptree_with_predeclarations(code, 1, R_FLOAT);
- if (pt)
- {
- if ((pt->result->type == R_BOOL) && (pt->arity == 1))
- return(pt);
- mus_run_free_ptree(pt);
- }
- return(NULL);
-}
-
-
-struct ptree *mus_run_form_to_ptree_1_b_without_env(s7_pointer code)
-{
- /* find */
- return(mus_run_form_to_ptree_1_b(s7_procedure_source(s7, code)));
-}
-
-
-/* ---------------- various evaluator wrappers ---------------- */
-
-mus_float_t mus_run_evaluate_ptree_1f2f(struct ptree *pt, mus_float_t arg)
-{
- pt->dbls[pt->args[0]] = arg;
- eval_ptree(pt);
- return(pt->dbls[pt->result->addr]);
-}
-
-
-mus_float_t mus_run_evaluate_ptree_1f1v1b2f(struct ptree *pt, mus_float_t arg, vct *v, bool dir)
-{
- pt->dbls[pt->args[0]] = arg;
- pt->vcts[pt->args[1]] = v;
- pt->ints[pt->args[2]] = (Int)dir;
- eval_ptree(pt);
- return(pt->dbls[pt->result->addr]);
-}
-
-
-mus_float_t mus_run_evaluate_ptree_0f2f(struct ptree *pt)
-{
- eval_ptree(pt);
- return(pt->dbls[pt->result->addr]);
-}
-
-
-int mus_run_evaluate_ptree_1f2b(struct ptree *pt, mus_float_t arg)
-{
- pt->dbls[pt->args[0]] = arg;
- eval_ptree(pt);
- return(pt->ints[pt->result->addr]);
-}
-
-
-mus_float_t mus_run_evaluate_ptreec(struct ptree *pt, mus_float_t arg, s7_pointer object, bool dir, int type)
-{
- /* set the "val" (current sample) arg */
-
- /* this assumes the init func returns the correct type of "data". This will segfault:
- * (define (tp) (ptree-channel (lambda (y data forward) (declare (y real)) (+ y .1)) 0 10 0 0 1 #f (lambda (b d) #f)))
- */
-
- pt->dbls[pt->args[0]] = arg;
- if (pt->arity > 1)
- {
- int addr;
-
- /* set the "dir" (read direction) arg */
- pt->ints[pt->args[2]] = (Int)dir;
-
- /* set the "state" (init-func return value) arg -- "type" is decided when init-func is evaluated */
- addr = pt->args[1];
-
- switch (type)
- {
- case R_FLOAT: pt->dbls[addr] = (Double)s7_number_to_real(object); break;
- case R_INT: pt->ints[addr] = s7_number_to_integer(object); break;
- case R_CHAR: pt->ints[addr] = (Int)s7_character(object); break;
- case R_BOOL: pt->ints[addr] = (Int)scheme_to_c_bool(object); break;
- case R_VCT: if (pt->vcts) pt->vcts[addr] = XEN_TO_VCT(object); break;
- /* dumb cases force the pt->vcts check -- vct returned, but never used for example */
- case R_SOUND_DATA: if (pt->sds) pt->sds[addr] = XEN_TO_SOUND_DATA(object); break;
- case R_CLM: if (pt->clms) pt->clms[addr] = XEN_TO_MUS_ANY(object); break;
-#if USE_SND
- case R_SAMPLER: if (pt->samplers) pt->samplers[addr] = xen_to_sampler(object); break;
- case R_MIX: pt->ints[addr] = XEN_MIX_TO_C_INT(object); break;
- case R_MARK: pt->ints[addr] = XEN_MARK_TO_C_INT(object); break;
- case R_REGION: pt->ints[addr] = XEN_REGION_TO_C_INT(object); break;
- case R_SOUND: pt->ints[addr] = XEN_SOUND_TO_C_INT(object); break;
-#endif
- case R_STRING:
- if (pt->strs)
- {
- if (pt->strs[addr]) free(pt->strs[addr]);
- pt->strs[addr] = mus_strdup(s7_string(object));
- }
- break;
- case R_SYMBOL:
- case R_KEYWORD: if (pt->xens) pt->xens[addr] = object; break;
- default:
- /* disaster -- init-func returned something we can't handle, so we're heading for a segfault
- * unless the overly-clever user forgot to refer to it. Not sure how to exit completely...
- */
-#if USE_SND
- snd_error("ptree-channel init-func returned a %s which we can't handle", type_name(type));
-#else
- mus_error(MUS_WRONG_TYPE_ARG, "ptree-channel init-func returned a %s which we can't handle", type_name(type));
-#endif
- return(0.0);
- break;
- }
- }
-
- eval_ptree(pt);
- return(pt->dbls[pt->result->addr]);
-}
-
-
-static ptree *last_ptree = NULL, *last_error_ptree = NULL;
-
-#if USE_SND
-static XEN watch_for_mus_error_in_run(s7_scheme *sc, XEN args)
-{
- /* called from snd.c if mus_error called, saw_mus_error set to 0 if throw (see above) */
- if (saw_mus_error == 1)
- {
- saw_mus_error = 2;
- last_error_ptree = last_ptree;
- }
- return(XEN_FALSE); /* don't report the error at the hook level */
-}
-#endif
-
-
-static s7_pointer eval_ptree_to_xen(ptree *pt)
-{
- s7_pointer result = scheme_false;
- int gc_loc;
-
- if ((saw_mus_error == 2) && (last_ptree) && (last_ptree == last_error_ptree))
- mus_run_free_ptree(last_ptree);
- last_ptree = pt;
- last_error_ptree = NULL;
- saw_mus_error = 1;
-#if USE_SND
- ss->cg_seen = false;
-#endif
- eval_ptree(pt);
-#if USE_SND
- ss->cg_seen = false;
-#endif
- result = xen_value_to_xen(pt, pt->result);
- gc_loc = s7_gc_protect(s7, result);
-
- mus_run_free_ptree(pt);
-
- last_ptree = NULL;
- saw_mus_error = 0;
-
- s7_gc_unprotect_at(s7, gc_loc);
- return(result);
-}
-
-
-static void init_walkers(void)
-{
- #define INIT_WALKER(Name, Val) scheme_set_walker((s7_pointer)(s7_make_symbol(s7, Name)), s7_make_c_pointer(s7, (void *)Val))
-
- walk_sym = s7_make_symbol(s7, "snd-walk");
- s7_gc_protect(s7, walk_sym);
-
- /* make_walker: walker, special walker, set walker, req args, max args, result type, need int, num arg types, ... */
-
- /* -------- special forms */
- INIT_WALKER("let", make_walker(NULL, let_form, NULL, 2, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("let*", make_walker(NULL, let_star_form, NULL, 2, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("do", make_walker(NULL, do_form, NULL, 2, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("begin", make_walker(NULL, begin_form, NULL, 0, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("if", make_walker(NULL, if_form, NULL, 2, 3, R_ANY, false, 0));
- INIT_WALKER("cond", make_walker(NULL, cond_form, NULL, 1, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("case", make_walker(NULL, case_form, NULL, 2, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("call-with-current-continuation", make_walker(NULL, callcc_form, NULL, 1, 1, R_ANY, false, 0));
- INIT_WALKER("call-with-exit", make_walker(NULL, callcc_form, NULL, 1, 1, R_ANY, false, 0));
- INIT_WALKER("or", make_walker(NULL, or_form, NULL, 0, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("and", make_walker(NULL, and_form, NULL, 0, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("set!", make_walker(NULL, set_form, NULL, 2, 2, R_ANY, false, 0)); /* Scheme set! does not take &rest args */
- INIT_WALKER("call/cc", make_walker(NULL, callcc_form, NULL, 1, 1, R_ANY, false, 0));
- INIT_WALKER("lambda", make_walker(NULL, lambda_preform, NULL, 1, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("declare", make_walker(NULL, declare_1, NULL, 0, UNLIMITED_ARGS, R_ANY, false, 0));
- INIT_WALKER("snd-declare", make_walker(NULL, declare_1, NULL, 0, UNLIMITED_ARGS, R_ANY, false, 0));
-
- /* -------- basic stuff */
- INIT_WALKER("eq?", make_walker(eq_p, NULL, NULL, 2, 2, R_BOOL, false, 0));
- INIT_WALKER("eqv?", make_walker(eqv_p, NULL, NULL, 2, 2, R_BOOL, false, 0));
- INIT_WALKER("equal?", make_walker(equal_p, NULL, NULL, 2, 2, R_BOOL, false, 0));
- INIT_WALKER("boolean?", make_walker(boolean_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("number?", make_walker(number_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("integer?", make_walker(integer_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("inexact?", make_walker(inexact_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("exact?", make_walker(exact_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("real?", make_walker(real_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("char?", make_walker(char_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("string?", make_walker(string_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("keyword?", make_walker(keyword_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("symbol?", make_walker(symbol_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("vector?", make_walker(vector_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER("list?", make_walker(list_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER(">=", make_walker(ge_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_NUMBER));
- INIT_WALKER(">", make_walker(gt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_NUMBER));
- INIT_WALKER("<=", make_walker(le_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_NUMBER));
- INIT_WALKER("<", make_walker(lt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_NUMBER));
- INIT_WALKER("=", make_walker(eq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_NUMBER));
-
- INIT_WALKER("*", make_walker(multiply, NULL, NULL, 0, UNLIMITED_ARGS, R_ANY, false, 1, -R_NUMBER));
- INIT_WALKER("+", make_walker(add, NULL, NULL, 0, UNLIMITED_ARGS, R_NUMBER, false, 1, -R_NUMBER));
- INIT_WALKER("-", make_walker(subtract, NULL, NULL, 1, UNLIMITED_ARGS, R_NUMBER, false, 1, -R_NUMBER));
- INIT_WALKER("/", make_walker(divide, NULL, NULL, 1, UNLIMITED_ARGS, R_NUMBER, false, 1, -R_NUMBER));
- INIT_WALKER("max", make_walker(max_1, NULL, NULL, 1, UNLIMITED_ARGS, R_NUMBER, false, 1, -R_NUMBER));
- INIT_WALKER("min", make_walker(min_1, NULL, NULL, 1, UNLIMITED_ARGS, R_NUMBER, false, 1, -R_NUMBER));
- INIT_WALKER("1+", make_walker(one_plus, NULL, NULL, 1, 1, R_NUMBER, false, 1, R_NUMBER));
- INIT_WALKER("1-", make_walker(one_minus, NULL, NULL, 1, 1, R_NUMBER, false, 1, R_NUMBER));
-
- INIT_WALKER("inexact->exact", make_walker(inexact2exact_1, NULL, NULL, 1, 1, R_INT, true, 1, R_NUMBER));
- INIT_WALKER("exact->inexact", make_walker(exact2inexact_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("modulo", make_walker(modulo_1, NULL, NULL, 2, 2, R_INT, true, 2, R_NUMBER, R_NUMBER));
- INIT_WALKER("remainder", make_walker(remainder_1, NULL, NULL, 2, 2, R_INT, true, 2, R_NUMBER, R_NUMBER));
- INIT_WALKER("quotient", make_walker(quotient_1, NULL, NULL, 2, 2, R_INT, true, 2, R_NUMBER, R_NUMBER));
- INIT_WALKER("logand", make_walker(logand_1, NULL, NULL, 2, 2, R_INT, true, 2, R_INT, R_INT));
- INIT_WALKER("logxor", make_walker(logxor_1, NULL, NULL, 2, 2, R_INT, true, 2, R_INT, R_INT));
- INIT_WALKER("logior", make_walker(logior_1, NULL, NULL, 2, 2, R_INT, true, 2, R_INT, R_INT));
- INIT_WALKER("lognot", make_walker(lognot_1, NULL, NULL, 1, 1, R_INT, true, 1, R_INT));
- INIT_WALKER("ash", make_walker(ash_1, NULL, NULL, 2, 2, R_INT, true, 2, R_INT, R_INT));
- INIT_WALKER("integer->char", make_walker(integer_to_char_1, NULL, NULL, 1, 1, R_CHAR, true, 1, R_INT));
- INIT_WALKER("gcd", make_walker(gcd_1, NULL, NULL, 0, UNLIMITED_ARGS, R_INT, true, 1, -R_NUMBER));
- INIT_WALKER("lcm", make_walker(lcm_1, NULL, NULL, 0, UNLIMITED_ARGS, R_INT, true, 1, -R_NUMBER));
- INIT_WALKER("expt", make_walker(expt_1, NULL, NULL, 2, 2, R_NUMBER, false, 2, R_NUMBER, R_NUMBER));
- INIT_WALKER("atan", make_walker(atanx_1, NULL, NULL, 1, 2, R_NUMBER, false, 2, R_NUMBER, R_NUMBER));
- INIT_WALKER("sin", make_walker(sin_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("cos", make_walker(cos_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("tan", make_walker(tan_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("abs", make_walker(abs_1, NULL, NULL, 1, 1, R_NUMBER, false, 1, R_NUMBER));
- INIT_WALKER("random", make_walker(random_1, NULL, NULL, 1, 1, R_NUMBER, false, 1, R_NUMBER));
- INIT_WALKER("log", make_walker(log_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("exp", make_walker(exp_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("asin", make_walker(asin_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("acos", make_walker(acos_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("sqrt", make_walker(sqrt_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("cosh", make_walker(cosh_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("sinh", make_walker(sinh_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("tanh", make_walker(tanh_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("acosh", make_walker(acosh_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("asinh", make_walker(asinh_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("atanh", make_walker(atanh_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("bes-i0", make_walker(mus_bessi0_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("fmod", make_walker(fmod_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_NUMBER, R_NUMBER));
-#if HAVE_SPECIAL_FUNCTIONS
- INIT_WALKER("bes-j0", make_walker(j0_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("bes-j1", make_walker(j1_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("bes-jn", make_walker(jn_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_INT, R_NUMBER));
- INIT_WALKER("bes-y0", make_walker(y0_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("bes-y1", make_walker(y1_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("bes-yn", make_walker(yn_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_INT, R_NUMBER));
- INIT_WALKER("erf", make_walker(erf_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("erfc", make_walker(erfc_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER("lgamma", make_walker(lgamma_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
-#endif
-
- INIT_WALKER("round", make_walker(round_1, NULL, NULL, 1, 1, R_INT, false, 1, R_NUMBER));
- INIT_WALKER("truncate", make_walker(truncate_1, NULL, NULL, 1, 1, R_INT, false, 1, R_NUMBER));
- INIT_WALKER("floor", make_walker(floor_1, NULL, NULL, 1, 1, R_INT, false, 1, R_NUMBER));
- INIT_WALKER("ceiling", make_walker(ceiling_1, NULL, NULL, 1, 1, R_INT, false, 1, R_NUMBER));
- INIT_WALKER("odd?", make_walker(odd_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_NUMBER));
- INIT_WALKER("even?", make_walker(even_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_NUMBER));
- INIT_WALKER("zero?", make_walker(zero_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_NUMBER));
- INIT_WALKER("positive?", make_walker(positive_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_NUMBER));
- INIT_WALKER("negative?", make_walker(negative_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_NUMBER));
- INIT_WALKER("not", make_walker(not_p, NULL, NULL, 1, 1, R_BOOL, false, 0)); /* ?? */
-
- INIT_WALKER("throw", make_walker(throw_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_SYMBOL));
-
- /* -------- char funcs */
- INIT_WALKER("char-alphabetic?", make_walker(char_alphabetic_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_CHAR));
- INIT_WALKER("char-numeric?", make_walker(char_numeric_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_CHAR));
- INIT_WALKER("char-lower-case?", make_walker(char_lower_case_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_CHAR));
- INIT_WALKER("char-upper-case?", make_walker(char_upper_case_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_CHAR));
- INIT_WALKER("char-whitespace?", make_walker(char_whitespace_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_CHAR));
- INIT_WALKER("char-upcase", make_walker(char_upcase, NULL, NULL, 1, 1, R_CHAR, false, 1, R_CHAR));
- INIT_WALKER("char-downcase", make_walker(char_downcase, NULL, NULL, 1, 1, R_CHAR, false, 1, R_CHAR));
- INIT_WALKER("char->integer", make_walker(char_to_integer, NULL, NULL, 1, 1, R_INT, false, 1, R_CHAR));
- INIT_WALKER("char>=?", make_walker(char_ge_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char>?", make_walker(char_gt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char<=?", make_walker(char_le_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char<?", make_walker(char_lt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char=?", make_walker(char_eq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char-ci>=?", make_walker(char_ci_ge_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char-ci>?", make_walker(char_ci_gt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char-ci<=?", make_walker(char_ci_le_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char-ci<?", make_walker(char_ci_lt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("char-ci=?", make_walker(char_ci_eq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_CHAR));
- INIT_WALKER("string", make_walker(string_1, NULL, NULL, 0, UNLIMITED_ARGS, R_STRING, false, 1, -R_CHAR));
-
- /* -------- string funcs */
- INIT_WALKER("string=?", make_walker(string_eq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string>=?", make_walker(string_geq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string<=?", make_walker(string_leq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string>?", make_walker(string_gt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string<?", make_walker(string_lt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string-ci=?", make_walker(string_ci_eq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string-ci>=?", make_walker(string_ci_geq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string-ci<=?", make_walker(string_ci_leq_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string-ci>?", make_walker(string_ci_gt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string-ci<?", make_walker(string_ci_lt_1, NULL, NULL, 0, UNLIMITED_ARGS, R_BOOL, false, 1, -R_STRING));
- INIT_WALKER("string-length", make_walker(string_length_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER("string-copy", make_walker(string_copy_1, NULL, NULL, 1, 1, R_STRING, false, 1, R_STRING));
- INIT_WALKER("string-ref", make_walker(string_ref_1, NULL, NULL, 2, 2, R_CHAR, false, 2, R_STRING, R_INT));
- INIT_WALKER("substring", make_walker(substring_1, NULL, NULL, 3, 3, R_STRING, false, 3, R_STRING, R_INT, R_INT));
- INIT_WALKER("string-fill!", make_walker(string_fill_1, NULL, NULL, 2, 2, R_STRING, false, 2, R_STRING, R_CHAR));
- INIT_WALKER("string-set!", make_walker(string_set_1, NULL, NULL, 3, 3, R_STRING, false, 3, R_STRING, R_INT, R_CHAR));
- INIT_WALKER("string-append", make_walker(string_append_1, NULL, NULL, 0, UNLIMITED_ARGS, R_STRING, false, 1, -R_STRING));
-
- INIT_WALKER("display", make_walker(display_1, NULL, NULL, 1, 1, R_STRING, false, 0));
- INIT_WALKER("make-string", make_walker(make_string_1, NULL, NULL, 1, 2, R_STRING, false, 2, R_INT, R_CHAR));
- INIT_WALKER("number->string", make_walker(number2string_1, NULL, NULL, 1, 2, R_STRING, false, 2, R_NUMBER, R_INT));
- INIT_WALKER("symbol->string", make_walker(symbol2string_1, NULL, NULL, 1, 1, R_STRING, false, 1, R_SYMBOL));
-
- /* -------- vector funcs */
- INIT_WALKER("vector-ref", make_walker(vector_ref_1, NULL, NULL, 2, 2, R_ANY, false, 2, R_VECTOR, R_INT));
- INIT_WALKER("vector-length", make_walker(vector_length_1, NULL, NULL, 1, 1, R_INT, false, 1, R_VECTOR));
- INIT_WALKER("vector-fill!", make_walker(vector_fill_1, NULL, NULL, 2, 2, R_INT, false, 1, R_VECTOR));
- INIT_WALKER("vector-set!", make_walker(vector_set_1, NULL, NULL, 3, 3, R_ANY, false, 2, R_VECTOR, R_INT));
- INIT_WALKER("make-vector", make_walker(make_vector_1, NULL, NULL, 1, 2, R_ANY, false, 2, R_INT, R_NUMBER));
- INIT_WALKER(S_vct_to_vector, make_walker(vct_copy_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_VCT));
- INIT_WALKER(S_vector_to_vct, make_walker(vct_copy_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_VECTOR));
-
- /* -------- list funcs */
- INIT_WALKER("list-ref", make_walker(list_ref_1, NULL, NULL, 2, 2, R_ANY, false, 2, R_LIST, R_INT));
- INIT_WALKER("list-set!", make_walker(list_set_1, NULL, NULL, 3, 3, R_ANY, false, 2, R_LIST, R_INT));
- INIT_WALKER("car", make_walker(car_1, NULL, NULL, 1, 1, R_ANY, false, 1, R_LIST));
- INIT_WALKER("cadr", make_walker(cadr_1, NULL, NULL, 1, 1, R_ANY, false, 1, R_LIST));
- INIT_WALKER("caddr", make_walker(caddr_1, NULL, NULL, 1, 1, R_ANY, false, 1, R_LIST));
- INIT_WALKER("cadddr", make_walker(cadddr_1, NULL, NULL, 1, 1, R_ANY, false, 1, R_LIST));
- INIT_WALKER("set-car!", make_walker(set_car_1, NULL, NULL, 2, 2, R_ANY, false, 1, R_LIST));
- INIT_WALKER("length", make_walker(length_1, NULL, NULL, 1, 1, R_INT, false, 1, R_ANY));
- INIT_WALKER("null?", make_walker(null_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_LIST));
- INIT_WALKER("quote", make_walker(NULL, quote_form, NULL, 1, 1, R_ANY, false, 0));
-
- INIT_WALKER("format", make_walker(format_1, NULL, NULL, 0, UNLIMITED_ARGS, R_STRING, false, 1, -R_XEN));
- INIT_WALKER("clm-print", make_walker(clm_print_1, NULL, NULL, 0, UNLIMITED_ARGS, R_STRING, false, 1, -R_XEN));
-
- INIT_WALKER("open-output-file", make_walker(open_output_file_1, NULL, NULL, 1, 2, R_XEN, false, 1, -R_STRING));
- INIT_WALKER("close-output-port", make_walker(close_output_port_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_XEN));
- INIT_WALKER("close-input-port", make_walker(close_input_port_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_XEN));
- INIT_WALKER("output-port?", make_walker(is_output_port_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_XEN));
- INIT_WALKER("input-port?", make_walker(is_input_port_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_XEN));
- INIT_WALKER("file-exists?", make_walker(file_exists_p_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_STRING));
- INIT_WALKER("getpid", make_walker(getpid_1, NULL, NULL, 0, 0, R_INT, false, 0));
-
- INIT_WALKER("current-output-port", make_walker(current_output_port_1, NULL, NULL, 0, 0, R_XEN, false, 0));
- INIT_WALKER("current-input-port", make_walker(current_input_port_1, NULL, NULL, 0, 0, R_XEN, false, 0));
- INIT_WALKER("current-error-port", make_walker(current_error_port_1, NULL, NULL, 0, 0, R_XEN, false, 0));
-
- INIT_WALKER("s7-version", make_walker(s7_version_1, NULL, NULL, 0, 0, R_STRING, false, 0));
-
-
- /* -------- clm funcs */
- INIT_WALKER(S_mus_generator_p, make_walker(mus_generator_p_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_oscil_p, make_walker(oscil_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_env_p, make_walker(env_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_notch_p, make_walker(notch_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_comb_p, make_walker(comb_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_filtered_comb_p, make_walker(filtered_comb_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_delay_p, make_walker(delay_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_all_pass_p, make_walker(all_pass_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_moving_average_p, make_walker(moving_average_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_rand_p, make_walker(rand_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_rand_interp_p, make_walker(rand_interp_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_ncos_p, make_walker(ncos_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_ssb_am_p, make_walker(ssb_am_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_nsin_p, make_walker(nsin_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_table_lookup_p, make_walker(table_lookup_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_sawtooth_wave_p, make_walker(sawtooth_wave_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_pulse_train_p, make_walker(pulse_train_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_square_wave_p, make_walker(square_wave_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_triangle_wave_p, make_walker(triangle_wave_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_asymmetric_fm_p, make_walker(asymmetric_fm_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_nrxysin_p, make_walker(nrxysin_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_nrxycos_p, make_walker(nrxycos_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_one_zero_p, make_walker(one_zero_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_one_pole_p, make_walker(one_pole_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_two_zero_p, make_walker(two_zero_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_two_pole_p, make_walker(two_pole_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_firmant_p, make_walker(firmant_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_formant_p, make_walker(formant_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_wave_train_p, make_walker(wave_train_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_polyshape_p, make_walker(polyshape_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_polywave_p, make_walker(polywave_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_filter_p, make_walker(filter_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_fir_filter_p, make_walker(fir_filter_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_iir_filter_p, make_walker(iir_filter_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_readin_p, make_walker(readin_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_src_p, make_walker(src_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_granulate_p, make_walker(granulate_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_phase_vocoder_p, make_walker(phase_vocoder_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_convolve_p, make_walker(convolve_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_frame_p, make_walker(frame_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_mixer_p, make_walker(mixer_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_file_to_sample_p, make_walker(file_to_sample_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_sample_to_file_p, make_walker(sample_to_file_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_file_to_frame_p, make_walker(file_to_frame_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_frame_to_file_p, make_walker(frame_to_file_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_locsig_p, make_walker(locsig_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_move_sound_p, make_walker(move_sound_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_mus_input_p, make_walker(input_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
- INIT_WALKER(S_mus_output_p, make_walker(output_p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
-#if USE_SND
- INIT_WALKER(S_snd_to_sample_p, make_walker(snd_to_sample_1p, NULL, NULL, 1, 1, R_BOOL, false, 1, R_ANY));
-#endif
-
- INIT_WALKER(S_mus_increment, make_walker(mus_increment_0, NULL, mus_set_increment_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_frequency, make_walker(mus_frequency_0, NULL, mus_set_frequency_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_phase, make_walker(mus_phase_0, NULL, mus_set_phase_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_width, make_walker(mus_width_0, NULL, mus_set_width_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_scaler, make_walker(mus_scaler_0, NULL, mus_set_scaler_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_safety, make_walker(mus_safety_0, NULL, mus_set_safety_1, 1, 1, R_INT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_reset, make_walker(mus_reset_0, NULL, NULL, 1, 1, R_CLM, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_offset, make_walker(mus_offset_0, NULL, mus_set_offset_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR));
- INIT_WALKER("mus-formant-radius", make_walker(mus_scaler_0, NULL, mus_set_scaler_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR)); /* backwards compatibility... */
- INIT_WALKER(S_mus_data, make_walker(mus_data_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_xcoeffs, make_walker(mus_xcoeffs_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_ycoeffs, make_walker(mus_ycoeffs_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_xcoeff, make_walker(mus_xcoeff_1, NULL, mus_set_xcoeff_1, 2, 2, R_FLOAT, false, 2, R_GENERATOR, R_INT));
- INIT_WALKER(S_mus_ycoeff, make_walker(mus_ycoeff_1, NULL, mus_set_ycoeff_1, 2, 2, R_FLOAT, false, 2, R_GENERATOR, R_INT));
- INIT_WALKER(S_mus_feedforward, make_walker(mus_feedforward_0, NULL, mus_set_feedforward_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_feedback, make_walker(mus_feedback_0, NULL, mus_set_feedback_1, 1, 1, R_FLOAT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_hop, make_walker(mus_hop_0, NULL, mus_set_hop_1, 1, 1, R_INT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_channels, make_walker(mus_channels_0, NULL, NULL, 1, 1, R_INT, false, 1, R_ANY)); /* *output* can be a vct or sound-data object */
- INIT_WALKER(S_mus_channel, make_walker(mus_channel_0, NULL, NULL, 1, 1, R_INT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_location, make_walker(mus_location_0, NULL, mus_set_location_1, 1, 1, R_INT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_ramp, make_walker(mus_ramp_0, NULL, mus_set_ramp_1, 1, 1, R_INT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_order, make_walker(mus_order_0, NULL, NULL, 1, 1, R_INT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_length, make_walker(mus_length_0, NULL, mus_set_length_1, 1, 1, R_INT, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_name, make_walker(mus_name_0, NULL, mus_set_name_1, 1, 1, R_STRING, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_file_name, make_walker(mus_file_name_0, NULL, NULL, 1, 1, R_STRING, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_describe, make_walker(mus_describe_0, NULL, NULL, 1, 1, R_STRING, false, 1, R_GENERATOR));
- INIT_WALKER(S_mus_close, make_walker(mus_close_0, NULL, NULL, 1, 1, R_INT, false, 1, R_ANY)); /* *output* again */
- INIT_WALKER(S_mus_run, make_walker(mus_run_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_GENERATOR, R_NUMBER, R_NUMBER));
-
- INIT_WALKER(S_oscil, make_walker(oscil_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_one_zero, make_walker(one_zero_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_one_pole, make_walker(one_pole_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_out_any, walker_with_declare(make_walker(out_any_1, NULL, NULL, 3, 4, R_FLOAT, false, 4, R_NUMBER, R_NUMBER, R_INT, R_ANY), 3, 3, R_INT, R_FLOAT, R_INT));
- INIT_WALKER(S_outa, walker_with_declare(make_walker(outa_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_NUMBER, R_NUMBER, R_ANY), 2, 3, R_INT, R_FLOAT, R_INT));
- INIT_WALKER(S_outb, walker_with_declare(make_walker(outb_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_NUMBER, R_NUMBER, R_ANY), 2, 3, R_INT, R_FLOAT, R_INT));
- INIT_WALKER(S_outc, walker_with_declare(make_walker(outc_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_NUMBER, R_NUMBER, R_ANY), 2, 3, R_INT, R_FLOAT, R_INT));
- INIT_WALKER(S_outd, walker_with_declare(make_walker(outd_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_NUMBER, R_NUMBER, R_ANY), 2, 3, R_INT, R_FLOAT, R_INT));
- INIT_WALKER(S_env, make_walker(env_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_CLM));
- INIT_WALKER(S_env_interp, make_walker(env_interp_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_FLOAT, R_CLM));
- INIT_WALKER(S_env_any, walker_with_declare(make_walker(env_any_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_CLM, R_FUNCTION), 1, 1, R_FLOAT));
- INIT_WALKER(S_notch, make_walker(notch_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_comb, make_walker(comb_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_filtered_comb, make_walker(filtered_comb_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_convolve, walker_with_declare(make_walker(convolve_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_FUNCTION), 2, 1, R_INT));
- INIT_WALKER(S_delay, make_walker(delay_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_all_pass, make_walker(all_pass_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_moving_average, make_walker(moving_average_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_asymmetric_fm, make_walker(asymmetric_fm_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_rand, make_walker(rand_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_rand_interp, make_walker(rand_interp_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_readin, make_walker(readin_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_CLM));
- INIT_WALKER(S_src, walker_with_declare(make_walker(src_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_FUNCTION), 2, 1, R_INT));
- INIT_WALKER(S_ncos, make_walker(ncos_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_nsin, make_walker(nsin_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_ssb_am, make_walker(ssb_am_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_sawtooth_wave, make_walker(sawtooth_wave_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_square_wave, make_walker(square_wave_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_nrxysin, make_walker(nrxysin_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_nrxycos, make_walker(nrxycos_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_sample_to_file, make_walker(sample_to_file_1, NULL, NULL, 4, 4, R_FLOAT, false, 4, R_CLM, R_NUMBER, R_INT, R_NUMBER));
- INIT_WALKER(S_table_lookup, make_walker(table_lookup_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_triangle_wave, make_walker(triangle_wave_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_two_zero, make_walker(two_zero_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_two_pole, make_walker(two_pole_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_tap, make_walker(tap_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_delay_tick, make_walker(delay_tick_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_pulse_train, make_walker(pulse_train_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_phase_vocoder,
- walker_with_declare(
- walker_with_declare(
- walker_with_declare(
- walker_with_declare(
- make_walker(phase_vocoder_1, NULL, NULL, 1, 5, R_FLOAT, false, 5, R_CLM, R_FUNCTION, R_FUNCTION, R_FUNCTION, R_FUNCTION),
- 4, 1, R_CLM),
- 3, 1, R_CLM),
- 2, 2, R_CLM, R_FUNCTION),
- 1, 1, R_INT));
- INIT_WALKER(S_phase_vocoder_amps, make_walker(phase_vocoder_amps_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_CLM));
- INIT_WALKER(S_phase_vocoder_amp_increments, make_walker(phase_vocoder_amp_increments_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_CLM));
- INIT_WALKER(S_phase_vocoder_freqs, make_walker(phase_vocoder_freqs_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_CLM));
- INIT_WALKER(S_phase_vocoder_phases, make_walker(phase_vocoder_phases_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_CLM));
- INIT_WALKER(S_phase_vocoder_phase_increments, make_walker(phase_vocoder_phase_increments_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_CLM));
-
- INIT_WALKER(S_firmant, make_walker(firmant_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_formant, make_walker(formant_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_filter, make_walker(filter_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_fir_filter, make_walker(fir_filter_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_file_to_sample, make_walker(file_to_sample_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_INT));
-#if USE_SND
- INIT_WALKER(S_snd_to_sample, make_walker(snd_to_sample_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_INT));
-#endif
- INIT_WALKER(S_frame_ref, make_walker(frame_ref_0, NULL, frame_set_1, 2, 2, R_FLOAT, false, 2, R_CLM, R_INT));
- INIT_WALKER(S_frame_set, make_walker(frame_set_2, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_CLM, R_INT, R_NUMBER));
- INIT_WALKER(S_frame, make_walker(frame_1, NULL, NULL, 1, UNLIMITED_ARGS, R_CLM, false, 1, -R_NUMBER));
- INIT_WALKER(S_wave_train, make_walker(wave_train_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_polyshape, make_walker(polyshape_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_polywave, make_walker(polywave_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_iir_filter, make_walker(iir_filter_1, NULL, NULL, 1, 2, R_FLOAT, false, 2, R_CLM, R_NUMBER));
- INIT_WALKER(S_ina, walker_with_declare(make_walker(ina_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_NUMBER, R_ANY), 1, 2, R_INT, R_INT));
- INIT_WALKER(S_inb, walker_with_declare(make_walker(inb_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_NUMBER, R_ANY), 1, 2, R_INT, R_INT));
- INIT_WALKER(S_in_any, walker_with_declare(make_walker(in_any_1, NULL, NULL, 3, 3, R_FLOAT, false, 2, R_NUMBER, R_INT, R_ANY), 2, 2, R_INT, R_INT));
- INIT_WALKER(S_granulate,
- walker_with_declare(
- walker_with_declare(
- make_walker(granulate_1, NULL, NULL, 1, 3, R_FLOAT, false, 3, R_CLM, R_FUNCTION, R_FUNCTION),
- 2, 1, R_CLM),
- 1, 1, R_INT));
- INIT_WALKER(S_move_locsig, make_walker(move_locsig_1, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_mus_set_formant_radius_and_frequency, make_walker(set_formant_radius_and_frequency_1, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_mixer_set, make_walker(mixer_set_2, NULL, NULL, 4, 4, R_FLOAT, false, 4, R_CLM, R_INT, R_INT, R_NUMBER));
- INIT_WALKER(S_mixer_ref, make_walker(mixer_ref_1, NULL, mixer_set_1, 3, 3, R_FLOAT, false, 3, R_CLM, R_INT, R_INT));
- INIT_WALKER(S_mixer, make_walker(mixer_1, NULL, NULL, 1, UNLIMITED_ARGS, R_CLM, false, 1, -R_NUMBER));
- INIT_WALKER(S_locsig_ref, make_walker(locsig_ref_0, NULL, locsig_set_1, 2, 2, R_FLOAT, false, 2, R_CLM, R_INT));
- INIT_WALKER(S_locsig_reverb_ref, make_walker(locsig_reverb_ref_0, NULL, locsig_reverb_set_1, 2, 2, R_FLOAT, false, 2, R_CLM, R_INT));
- INIT_WALKER(S_locsig_set, make_walker(locsig_set_2, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_CLM, R_INT, R_NUMBER));
- INIT_WALKER(S_locsig_reverb_set, make_walker(locsig_reverb_set_2, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_CLM, R_INT, R_NUMBER));
- INIT_WALKER(S_polynomial, make_walker(polynomial_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_VCT, R_NUMBER));
- INIT_WALKER(S_clear_array, make_walker(clear_array_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_VCT));
- INIT_WALKER(S_array_interp, make_walker(array_interp_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_VCT, R_FLOAT, R_INT));
- INIT_WALKER(S_mus_interpolate, make_walker(mus_interpolate_1, NULL, NULL, 3, 5, R_FLOAT, false, 3, R_INT, R_FLOAT, R_VCT, R_INT, R_FLOAT));
- INIT_WALKER(S_mus_srate, make_walker(mus_srate_1, NULL, NULL, 0, 0, R_NUMBER, false, 0));
- INIT_WALKER(S_ring_modulate, make_walker(ring_modulate_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_amplitude_modulate, make_walker(amplitude_modulate_1, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_NUMBER, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_contrast_enhancement, make_walker(contrast_enhancement_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_dot_product, make_walker(dot_product_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_VCT, R_VCT, R_INT));
- INIT_WALKER(S_polar_to_rectangular, make_walker(polar_to_rectangular_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_VCT));
- INIT_WALKER(S_rectangular_to_magnitudes, make_walker(rectangular_to_magnitudes_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_VCT));
- INIT_WALKER(S_rectangular_to_polar, make_walker(rectangular_to_polar_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_VCT));
- INIT_WALKER(S_multiply_arrays, make_walker(multiply_arrays_1, NULL, NULL, 2, 3, R_VCT, false, 3, R_VCT, R_VCT, R_INT));
- INIT_WALKER(S_mus_fft, make_walker(mus_fft_1, NULL, NULL, 2, 4, R_VCT, false, 4, R_VCT, R_VCT, R_INT, R_INT));
- INIT_WALKER(S_spectrum, make_walker(mus_spectrum_1, NULL, NULL, 3, 4, R_VCT, false, 4, R_VCT, R_VCT, R_VCT, R_INT));
- INIT_WALKER(S_convolution, make_walker(convolution_1, NULL, NULL, 2, 3, R_VCT, false, 3, R_VCT, R_VCT, R_INT));
- INIT_WALKER(S_formant_bank, make_walker(formant_bank_1,NULL, NULL, 3, 3, R_FLOAT, false, 2, R_VCT, R_CLM_VECTOR));
- INIT_WALKER(S_frame_add, make_walker(mus_frame_add_1, NULL, NULL, 2, 3, R_CLM, false, 3, R_NUMBER_CLM, R_NUMBER_CLM, R_CLM));
- INIT_WALKER(S_frame_multiply, make_walker(mus_frame_multiply_1, NULL, NULL, 2, 3, R_CLM, false, 3, R_NUMBER_CLM, R_NUMBER_CLM, R_CLM));
- INIT_WALKER(S_mixer_multiply, make_walker(mus_mixer_multiply_1, NULL, NULL, 2, 3, R_CLM, false, 3, R_NUMBER_CLM, R_NUMBER_CLM, R_CLM));
- INIT_WALKER(S_mixer_add, make_walker(mus_mixer_add_1, NULL, NULL, 2, 3, R_CLM, false, 3, R_NUMBER_CLM, R_NUMBER_CLM, R_CLM));
- INIT_WALKER(S_frame_to_frame, make_walker(frame_to_frame_1, NULL, NULL, 2, 3, R_CLM, false, 3, R_CLM, R_CLM, R_CLM));
- INIT_WALKER(S_frame_to_sample, make_walker(frame_to_sample_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_CLM, R_CLM));
- INIT_WALKER(S_sample_to_frame, make_walker(sample_to_frame_1, NULL, NULL, 2, 3, R_FLOAT, false, 3, R_CLM, R_FLOAT, R_CLM));
- INIT_WALKER(S_locsig, make_walker(locsig_1, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_move_sound, make_walker(move_sound_1, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_CLM, R_NUMBER, R_NUMBER));
- INIT_WALKER(S_frame_to_file, make_walker(frame_to_file_1, NULL, NULL, 3, 3, R_CLM, false, 3, R_CLM, R_NUMBER, R_CLM));
- INIT_WALKER(S_file_to_frame, make_walker(file_to_frame_1, NULL, NULL, 2, 3, R_CLM, false, 3, R_CLM, R_NUMBER, R_CLM));
-
- INIT_WALKER(S_radians_to_hz, make_walker(mus_radians_to_hz_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER(S_hz_to_radians, make_walker(mus_hz_to_radians_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER(S_degrees_to_radians, make_walker(mus_degrees_to_radians_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER(S_radians_to_degrees, make_walker(mus_radians_to_degrees_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER(S_db_to_linear, make_walker(mus_db_to_linear_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER(S_linear_to_db, make_walker(mus_linear_to_db_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
- INIT_WALKER(S_seconds_to_samples, make_walker(seconds_to_samples_1, NULL, NULL, 1, 1, R_INT, false, 1, R_NUMBER));
- INIT_WALKER(S_mus_random, make_walker(mus_random_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_NUMBER));
-
- INIT_WALKER(S_make_all_pass, make_walker(make_all_pass_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_moving_average, make_walker(make_moving_average_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_asymmetric_fm, make_walker(make_asymmetric_fm_1, NULL, NULL, 0, 8, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_comb, make_walker(make_comb_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_filtered_comb, make_walker(make_filtered_comb_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_convolve, make_walker(make_convolve_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_delay, make_walker(make_delay_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_env, make_walker(make_env_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_fft_window, make_walker(make_fft_window_1, NULL, NULL, 2, 3, R_VCT, false, 1, -R_XEN));
- INIT_WALKER(S_make_file_to_frame, make_walker(make_file_to_frame_1, NULL, NULL, 0, 1, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_file_to_sample, make_walker(make_file_to_sample_1, NULL, NULL, 0, 1, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_filter, make_walker(make_filter_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_fir_filter, make_walker(make_fir_filter_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_firmant, make_walker(make_firmant_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_formant, make_walker(make_formant_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_frame, make_walker(make_frame_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_frame_to_file, make_walker(make_frame_to_file_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_granulate, make_walker(make_granulate_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_iir_filter, make_walker(make_iir_filter_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_locsig, make_walker(make_locsig_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN)); /* no move-sound -- way too complex */
- INIT_WALKER(S_make_mixer, make_walker(make_mixer_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_notch, make_walker(make_notch_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_one_pole, make_walker(make_one_pole_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_one_zero, make_walker(make_one_zero_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_oscil, make_walker(make_oscil_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_phase_vocoder, make_walker(make_phase_vocoder_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_pulse_train, make_walker(make_pulse_train_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_rand, make_walker(make_rand_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_rand_interp, make_walker(make_rand_interp_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_readin, make_walker(make_readin_1, NULL, NULL, 0, 8, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_sample_to_file, make_walker(make_sample_to_file_1, NULL, NULL, 4, 5, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_sawtooth_wave, make_walker(make_sawtooth_wave_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_nrxysin, make_walker(make_nrxysin_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_nrxycos, make_walker(make_nrxycos_1, NULL, NULL, 0, UNLIMITED_ARGS, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_square_wave, make_walker(make_square_wave_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_src, make_walker(make_src_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_ncos, make_walker(make_ncos_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_nsin, make_walker(make_nsin_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_ssb_am, make_walker(make_ssb_am_1, NULL, NULL, 0, 4, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_table_lookup, make_walker(make_table_lookup_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_triangle_wave, make_walker(make_triangle_wave_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_two_pole, make_walker(make_two_pole_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_two_zero, make_walker(make_two_zero_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_wave_train, make_walker(make_wave_train_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_polyshape, make_walker(make_polyshape_1, NULL, NULL, 0, 8, R_CLM, false, 1, -R_XEN));
- INIT_WALKER(S_make_polywave, make_walker(make_polywave_1, NULL, NULL, 0, 6, R_CLM, false, 1, -R_XEN));
-
- INIT_WALKER(S_partials_to_polynomial, make_walker(partials_to_polynomial_1, NULL, NULL, 1, 2, R_VCT, false, 2, R_VCT, R_INT));
- INIT_WALKER(S_normalize_partials, make_walker(normalize_partials_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_VCT));
- INIT_WALKER(S_mus_chebyshev_t_sum, make_walker(mus_chebyshev_t_sum_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_FLOAT, R_VCT));
- INIT_WALKER(S_mus_chebyshev_u_sum, make_walker(mus_chebyshev_u_sum_1, NULL, NULL, 2, 2, R_FLOAT, false, 2, R_FLOAT, R_VCT));
- INIT_WALKER(S_mus_chebyshev_tu_sum, make_walker(mus_chebyshev_tu_sum_1, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_FLOAT, R_VCT, R_VCT));
-
-
- /* -------- sndlib funcs */
- INIT_WALKER(S_mus_sound_samples, make_walker(mus_sound_samples_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_frames, make_walker(mus_sound_frames_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_datum_size, make_walker(mus_sound_datum_size_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_data_location, make_walker(mus_sound_data_location_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_chans, make_walker(mus_sound_chans_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_srate, make_walker(mus_sound_srate_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_header_type, make_walker(mus_sound_header_type_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_data_format, make_walker(mus_sound_data_format_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_length, make_walker(mus_sound_length_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_duration, make_walker(mus_sound_duration_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_comment, make_walker(mus_sound_comment_1, NULL, NULL, 1, 1, R_STRING, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_forget, make_walker(mus_sound_forget_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
- INIT_WALKER(S_mus_sound_type_specifier, make_walker(mus_sound_type_specifier_1, NULL, NULL, 1, 1, R_INT, false, 1, R_STRING));
-
- INIT_WALKER(S_mus_header_type_name, make_walker(mus_header_type_name_1, NULL, NULL, 1, 1, R_STRING, false, 1, R_INT));
- INIT_WALKER(S_mus_data_format_name, make_walker(mus_data_format_name_1, NULL, NULL, 1, 1, R_STRING, false, 1, R_INT));
- INIT_WALKER(S_mus_header_type_to_string, make_walker(mus_header_type_to_string_1, NULL, NULL, 1, 1, R_STRING, false, 1, R_INT));
- INIT_WALKER(S_mus_data_format_to_string, make_walker(mus_data_format_to_string_1, NULL, NULL, 1, 1, R_STRING, false, 1, R_INT));
- INIT_WALKER(S_mus_bytes_per_sample, make_walker(mus_bytes_per_sample_1, NULL, NULL, 1, 1, R_INT, false, 1, R_INT));
-
- INIT_WALKER(S_mus_audio_close, make_walker(mus_audio_close_1, NULL, NULL, 1, 1, R_INT, false, 1, R_INT));
- INIT_WALKER(S_mus_audio_write, make_walker(mus_audio_write_1, NULL, NULL, 3, 3, R_INT, false, 3, R_INT, R_SOUND_DATA, R_INT));
-
- INIT_WALKER(S_vct_ref, make_walker(vct_ref_1, NULL, vct_set_1, 2, 2, R_FLOAT, false, 2, R_VCT, R_INT));
- INIT_WALKER(S_vct_length, make_walker(vct_length_1, NULL, NULL, 1, 1, R_INT, false, 1, R_VCT));
- INIT_WALKER(S_vct_fillB, make_walker(vct_fill_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_NUMBER));
- INIT_WALKER(S_vct_scaleB, make_walker(vct_scale_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_NUMBER));
- INIT_WALKER(S_vct_offsetB, make_walker(vct_offset_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_NUMBER));
- INIT_WALKER(S_vct_addB, make_walker(vct_add_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_VCT));
- INIT_WALKER(S_vct_subtractB, make_walker(vct_subtract_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_VCT));
- INIT_WALKER(S_vct_multiplyB, make_walker(vct_multiply_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_VCT));
- INIT_WALKER(S_vct_copy, make_walker(vct_copy_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_VCT));
- INIT_WALKER(S_vct_peak, make_walker(vct_peak_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_VCT));
- INIT_WALKER(S_vct_setB, make_walker(vct_set_2, NULL, NULL, 3, 3, R_FLOAT, false, 3, R_VCT, R_INT, R_NUMBER));
- INIT_WALKER(S_make_vct, make_walker(make_vct_1, NULL, NULL, 1, 2, R_VCT, false, 2, R_INT, R_FLOAT));
- INIT_WALKER(S_vct, make_walker(vct_1, NULL, NULL, 1, UNLIMITED_ARGS, R_VCT, false, 1, -R_NUMBER));
- INIT_WALKER(S_vct_p, make_walker(vct_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER(S_vct_reverse, make_walker(vct_reverse_2, NULL, NULL, 1, 2, R_VCT, false, 2, R_VCT, R_INT));
- INIT_WALKER(S_vct_moveB, make_walker(vct_move_3, NULL, NULL, 3, 3, R_VCT, false, 3, R_VCT, R_INT, R_INT));
- INIT_WALKER(S_vct_times, make_walker(vct_times_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_NUMBER_VCT, R_NUMBER_VCT));
- INIT_WALKER(S_vct_plus, make_walker(vct_plus_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_NUMBER_VCT, R_NUMBER_VCT));
-
- INIT_WALKER(S_sound_data_length, make_walker(sound_data_length_1, NULL, NULL, 1, 1, R_INT, false, 1, R_SOUND_DATA));
- INIT_WALKER(S_sound_data_chans, make_walker(sound_data_chans_1, NULL, NULL, 1, 1, R_INT, false, 1, R_SOUND_DATA));
- INIT_WALKER(S_sound_data_peak, make_walker(sound_data_peak_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_SOUND_DATA));
- INIT_WALKER(S_sound_data_copy, make_walker(sound_data_copy_1, NULL, NULL, 1, 1, R_SOUND_DATA, false, 1, R_SOUND_DATA));
- INIT_WALKER(S_sound_data_reverseB, make_walker(sound_data_reverse_1, NULL, NULL, 1, 1, R_SOUND_DATA, false, 1, R_SOUND_DATA));
- INIT_WALKER(S_sound_data_p, make_walker(sound_data_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER(S_sound_data_ref, make_walker(sound_data_ref_1, NULL, sound_data_set_1, 3, 3, R_FLOAT, false, 3, R_SOUND_DATA, R_INT, R_INT));
- INIT_WALKER(S_sound_data_setB, make_walker(sound_data_set_2, NULL, NULL, 4, 4, R_FLOAT, false, 4, R_SOUND_DATA, R_INT, R_INT, R_NUMBER));
- INIT_WALKER(S_make_sound_data, make_walker(make_sound_data_1, NULL, NULL, 2, 2, R_SOUND_DATA, false, 2, R_INT, R_INT));
- INIT_WALKER(S_sound_data_scaleB, make_walker(sound_data_scale_1, NULL, NULL, 2, 2, R_SOUND_DATA, false, 2, R_SOUND_DATA, R_NUMBER));
- INIT_WALKER(S_sound_data_offsetB, make_walker(sound_data_offset_1, NULL, NULL, 2, 2, R_SOUND_DATA, false, 2, R_SOUND_DATA, R_NUMBER));
- INIT_WALKER(S_sound_data_fillB, make_walker(sound_data_fill_1, NULL, NULL, 2, 2, R_SOUND_DATA, false, 2, R_SOUND_DATA, R_NUMBER));
- INIT_WALKER(S_sound_data_addB, make_walker(sound_data_add_1, NULL, NULL, 2, 2, R_SOUND_DATA, false, 2, R_SOUND_DATA, R_SOUND_DATA));
- INIT_WALKER(S_sound_data_multiplyB, make_walker(sound_data_multiply_1, NULL, NULL, 2, 2, R_SOUND_DATA, false, 2, R_SOUND_DATA, R_SOUND_DATA));
- INIT_WALKER(S_sound_data_multiply, make_walker(sound_data_times_1, NULL, NULL, 2, 2, R_SOUND_DATA, false, 2, R_NUMBER_SOUND_DATA, R_NUMBER_SOUND_DATA));
- INIT_WALKER(S_sound_data_add, make_walker(sound_data_plus_1, NULL, NULL, 2, 2, R_SOUND_DATA, false, 2, R_NUMBER_SOUND_DATA, R_NUMBER_SOUND_DATA));
- INIT_WALKER(S_sound_data_to_vct, make_walker(sound_data_to_vct_1, NULL, NULL, 3, 3, R_VCT, false, 3, R_SOUND_DATA, R_INT, R_VCT));
- INIT_WALKER(S_vct_to_sound_data, make_walker(vct_to_sound_data_1, NULL, NULL, 3, 3, R_SOUND_DATA, false, 3, R_VCT, R_SOUND_DATA, R_INT));
-
- INIT_WALKER(S_autocorrelate, make_walker(autocorrelate_1, NULL, NULL, 1, 1, R_VCT, false, 1, R_VCT));
- INIT_WALKER(S_correlate, make_walker(correlate_1, NULL, NULL, 2, 2, R_VCT, false, 2, R_VCT, R_VCT));
-
-#if USE_SND
- /* -------- snd funcs */
- INIT_WALKER(S_next_sample, make_walker(next_sample_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_SAMPLER));
- INIT_WALKER(S_previous_sample, make_walker(previous_sample_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_SAMPLER));
- INIT_WALKER(S_read_sample, make_walker(sampler_1, NULL, NULL, 1, 1, R_FLOAT, false, 1, R_SAMPLER));
- INIT_WALKER(S_make_sampler, make_walker(make_sampler_1, NULL, NULL, 0, 5, R_SAMPLER, false, 1, R_NUMBER));
- INIT_WALKER(S_sampler_p, make_walker(sampler_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER(S_sampler_at_end_p, make_walker(sampler_at_end_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
-
- INIT_WALKER(S_edit_position, make_walker(edit_position_1, NULL, NULL, 0, 2, R_INT, false, 0));
- INIT_WALKER(S_frames, make_walker(frames_1, NULL, NULL, 0, 3, R_INT, false, 0));
- INIT_WALKER(S_cursor, make_walker(cursor_1, NULL, NULL, 0, 2, R_INT, false, 0));
- INIT_WALKER(S_maxamp, make_walker(maxamp_1, NULL, NULL, 0, 3, R_FLOAT, false, 0));
- INIT_WALKER(S_sample, make_walker(sample_1, NULL, NULL, 1, 4, R_FLOAT, false, 1, R_INT));
- INIT_WALKER(S_samples, make_walker(samples_1, NULL, NULL, 2, 5, R_VCT, false, 2, R_INT, R_INT));
- INIT_WALKER(S_channel_to_vct, make_walker(samples_1, NULL, NULL, 2, 5, R_VCT, false, 2, R_INT, R_INT));
- INIT_WALKER(S_srate, make_walker(srate_1, NULL, NULL, 0, 1, R_INT, false, 0));
- INIT_WALKER(S_channels, make_walker(channels_1, NULL, NULL, 0, 1, R_INT, false, 0));
- INIT_WALKER(S_file_name, make_walker(file_name_1, NULL, NULL, 0, 1, R_STRING, false, 0));
- INIT_WALKER(S_c_g, make_walker(c_g_p_1, NULL, NULL, 0, 0, R_BOOL, false, 0));
- INIT_WALKER(S_vct_to_channel, make_walker(vct_to_channel_1, NULL, NULL, 3, 5, R_BOOL, false, 3, R_VCT, R_INT, R_INT));
- INIT_WALKER(S_exit, make_walker(exit_1, NULL, NULL, 0, 0, R_BOOL, false, 0));
-
- INIT_WALKER(S_snd_print, make_walker(snd_print_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_STRING));
- INIT_WALKER(S_snd_warning, make_walker(snd_warning_1, NULL, NULL, 1, 1, R_BOOL, false, 1, R_STRING));
- INIT_WALKER(S_report_in_minibuffer, make_walker(report_in_minibuffer_1, NULL, NULL, 1, 2, R_BOOL, false, 1, R_STRING));
-
- INIT_WALKER(S_sound_p, make_walker(r_sound_p_1, NULL, NULL, 1, 1, R_BOOL, false, 0));
- INIT_WALKER(S_selection_chans, make_walker(selection_chans_1, NULL, NULL, 0, 0, R_INT, false, 0));
- INIT_WALKER(S_temp_dir, make_walker(r_temp_dir_1, NULL, NULL, 0, 0, R_STRING, false, 0));
- INIT_WALKER(S_save_dir, make_walker(r_save_dir_1, NULL, NULL, 0, 0, R_STRING, false, 0));
- INIT_WALKER(S_fft, make_walker(fft_1, NULL, NULL, 2, 3, R_VCT, false, 3, R_VCT, R_VCT, R_INT));
-#endif
-}
-
-
-static s7_pointer g_run_eval(s7_pointer code, s7_pointer arg, s7_pointer arg1, s7_pointer arg2)
-{
- ptree *pt;
- s7_pointer cl;
- int gc_loc;
-
-#if USE_SND
- current_optimization = SOURCE_OK;
-#endif
-
- cl = s7_make_closure(s7, code, xen_nil);
- gc_loc = s7_gc_protect(s7, cl);
-
- pt = make_ptree(8);
- pt->code = cl;
- pt->result = walk(pt, code, NEED_ANY_RESULT);
-
- s7_gc_unprotect_at(s7, gc_loc);
-
- /* fprintf(stderr, "run-eval: %s: %s -> %s\n", s7_object_to_c_string(s7, code), s7_object_to_c_string(s7, arg), (pt->result) ? describe_xen_value(pt->result, pt) : "no result"); */
-
- if (pt->result)
- {
- add_triple_to_ptree(pt, make_triple(quit, "quit", NULL, 0));
-
- if (ptree_on != NO_PTREE_DISPLAY)
- {
- char *msg;
- fprintf(stderr, "\n-------- optimize %s\n", s7_object_to_c_string(s7, code));
- msg = describe_ptree(pt, " ");
- if (ptree_on == STDERR_PTREE_DISPLAY) fprintf(stderr, "%s", msg);
-#if USE_SND
- else if (ptree_on == LISTENER_PTREE_DISPLAY) listener_append(msg);
-#endif
- free(msg);
- fprintf(stderr, "%s", "--------\n");
- }
-
- if (pt->args)
- {
- bool arity_err = false;
- int err = 0;
- if (pt->arity > 3)
- arity_err = true;
- else
- {
- if (pt->arity > 0)
- {
- if (arg != scheme_undefined)
- {
- /* fprintf(stderr, "arg: %s (%s %d)\n", s7_object_to_c_string(s7, arg), type_name(pt->arg_types[0]), pt->args[0]); */
-
- err = xen_to_addr(pt, arg, pt->arg_types[0], pt->args[0]);
- if ((err != XEN_TO_ADDR_ERROR) && (pt->arity > 1))
- {
- if (arg1 != scheme_undefined)
- {
- err = xen_to_addr(pt, arg1, pt->arg_types[1], pt->args[1]);
- if ((err != XEN_TO_ADDR_ERROR) && (pt->arity > 2))
- {
- if (arg2 != scheme_undefined)
- err = xen_to_addr(pt, arg2, pt->arg_types[2], pt->args[2]);
- else arity_err = true;
- }
- }
- else arity_err = true;
- }
- }
- else arity_err = true;
- }
- }
- if (err == XEN_TO_ADDR_ERROR)
- {
- mus_run_free_ptree(pt);
- return(scheme_false); /* already warned, I think */
- }
- if (arity_err)
- {
- mus_run_free_ptree(pt);
- s7_error(s7, s7_make_symbol(s7, "wrong-number-of-args"),
- scheme_list_2(scheme_make_string("run-eval: wrong number of args for function: ~A"),
- code));
- return(scheme_false);
- }
- }
- return(eval_ptree_to_xen(pt));
- }
- if (pt) mus_run_free_ptree(pt);
-
- s7_error(s7, s7_make_symbol(s7, "cannot-parse"),
- scheme_list_2(scheme_make_string("run-eval: can't parse ~A"),
- code));
-
- return(scheme_false);
-}
-
-#ifndef S_run
- #define S_run "run"
-#endif
-
-static s7_pointer g_run(s7_pointer proc_and_code)
-{
- #define H_run "(" S_run " thunk): try to optimize the procedure passed as its argument, \
-then evaluate it; if the optimizer can't handle something in the procedure, it is passed \
-to Scheme and is equivalent to (thunk)."
-
- s7_pointer code;
- ptree *pt = NULL;
- s7_pointer result;
- int gc_loc;
-
- XEN_ASSERT_TYPE(s7_is_procedure(proc_and_code) && (XEN_REQUIRED_ARGS_OK(proc_and_code, 0)), proc_and_code, 1, S_run, "a thunk");
-
- code = s7_cons(s7, s7_append(s7, s7_cons(s7, s7_make_symbol(s7, "lambda"),
- scheme_nil),
- s7_car(proc_and_code)),
- s7_cdr(proc_and_code));
- gc_loc = s7_gc_protect(s7, code);
-
- pt = form_to_ptree(code);
- if (pt)
- result = eval_ptree_to_xen(pt);
- else result = s7_call(s7, proc_and_code, scheme_nil);
-
- s7_gc_unprotect_at(s7, gc_loc);
- return(result);
-}
-
-
-#if USE_SND
-static s7_pointer g_optimization(void) {return(s7_make_integer(s7, optimization(ss)));}
-
-static s7_pointer g_set_optimization(s7_pointer val)
-{
- #define H_optimization "(" S_optimization "): the current 'run' optimization level (default 6 is the max, 0 = no optimization)"
- XEN_ASSERT_TYPE(s7_is_integer(val), val, 1, S_setB S_optimization, "an integer");
- set_optimization(mus_iclamp(0, (int)s7_number_to_integer(val), MAX_OPTIMIZATION));
- return(s7_make_integer(s7, optimization(ss)));
-}
-
-#else
-
-#define S_optimization "optimization"
-
-static s7_pointer g_optimization(void) {return(s7_make_integer(s7, current_optimization));}
-
-static s7_pointer g_set_optimization(s7_pointer val)
-{
- #define H_optimization "(" S_optimization "): the current 'run' optimization level (default 6 is the max, 0 = no optimization)"
- XEN_ASSERT_TYPE(s7_is_integer(val), val, 1, S_setB S_optimization, "an integer");
- current_optimization = mus_iclamp(0, (int)s7_number_to_integer(val), MAX_OPTIMIZATION);
- return(s7_make_integer(s7, current_optimization));
-}
-
-#endif
-
-
-#define S_snd_declare "snd-declare"
-
-static s7_pointer g_snd_declare(s7_pointer args)
-{
- #define H_snd_declare "this is an internal kludge aimed mainly at backwards compatibility"
- return(scheme_false);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_optimization_w, g_optimization)
-XEN_NARGIFY_1(g_set_optimization_w, g_set_optimization)
-XEN_NARGIFY_1(g_snd_declare_w, g_snd_declare)
-XEN_NARGIFY_1(g_run_w, g_run)
-XEN_NARGIFY_1(g_show_ptree_w, g_show_ptree)
-XEN_NARGIFY_4(g_add_clm_field_w, g_add_clm_field)
-XEN_ARGIFY_4(g_run_eval_w, g_run_eval)
-#if WITH_COUNTERS
-XEN_NARGIFY_0(g_report_counts_w, g_report_counts)
-XEN_NARGIFY_0(g_clear_counts_w, g_clear_counts)
-#endif
-#else
-#define g_optimization_w g_optimization
-#define g_set_optimization_w g_set_optimization
-#define g_snd_declare_w g_snd_declare
-#define g_run_w g_run
-#define g_show_ptree_w g_show_ptree
-#define g_add_clm_field_w g_add_clm_field
-#define g_run_eval_w g_run_eval
-#if WITH_COUNTERS
-#define g_report_counts_w, g_report_counts
-#define g_clear_counts_w, g_clear_counts
-#endif
-#endif
-
-
-void mus_init_run(void)
-{
- static bool run_inited = false;
- if (run_inited) fprintf(stderr, "redundant run initialization?");
- run_inited = true;
-
- scheme_false = s7_f(s7);
- scheme_true = s7_t(s7);
- scheme_nil = s7_nil(s7);
- scheme_undefined = s7_undefined(s7);
- scheme_zero = s7_make_integer(s7, 0);
-
- s7_define_function(s7, "__run__", g_run_w, 1, 0, 0, H_run);
- s7_define_function(s7, "run-eval", g_run_eval_w, 1, 3, 0, H_run);
-
- s7_eval_c_string(s7, "(define-macro (run . code) \n\
- (if (eq? (caar code) 'lambda) \n\
- `(__run__ , at code) \n\
- `(__run__ (lambda () , at code))))");
-
- walker_hash_table = s7_make_hash_table(s7, 1031);
- s7_gc_protect(s7, walker_hash_table);
-
- s7_define_function(s7, S_add_clm_field, g_add_clm_field_w, 4, 0, 0, H_add_clm_field);
- s7_define_function(s7, S_show_ptree, g_show_ptree_w, 1, 0, 0, H_show_ptree);
-
-#if WITH_COUNTERS
- s7_define_function(s7, "run-report-counts", g_report_counts_w, 0, 0, 0, "run stats");
- s7_define_function(s7, "run-clear-counts", g_clear_counts_w, 0, 0, 0, "clear run stats");
-#endif
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_optimization, g_optimization_w, H_optimization, S_setB S_optimization, g_set_optimization_w, 0, 0, 1, 0);
- s7_define_function(s7, S_snd_declare, g_snd_declare_w, 1, 0, 0, H_snd_declare);
-
- s7_eval_c_string(s7, "(defmacro declare args `(snd-declare ',args))");
- /* declare has to be a macro, else it evaluates its arguments in the fallback-on-scheme case
- * however, we want it to still be findable on an external function (when using procedure-source to splice in the body)
- * so in the optimizer case, it sees the original "declare" form, but in the scheme case, the snd-declare (a no-op),
- * and in the optimizer-splicing-source case, the snd-declare, I hope.
- */
-
-#if USE_SND
- XEN_ADD_HOOK(ss->mus_error_hook, watch_for_mus_error_in_run, "run-mus-error-handler", "run macro's mus-error handler");
-#endif
-
- #define H_optimization_hook S_optimization_hook " (msg): called if the run macro encounters \
-something it can't optimize. 'msg' is a string description of the offending form:\n\
- (add-hook! " S_optimization_hook " (lambda (msg) (display (format #f \"run trouble: ~A~%\" msg))))\n\
-You can often slightly rewrite the form to make run happy."
-
- optimization_hook = XEN_DEFINE_HOOK(S_optimization_hook, 1, H_optimization_hook); /* arg = message */
-
-#if (!USE_SND)
- current_optimization = MAX_OPTIMIZATION;
-#endif
-
- init_walkers();
- init_type_names();
-
- {
- int i;
- s7_pointer *vals;
- vals = s7_vector_elements(walker_hash_table);
- for (i = 0; i < s7_vector_length(walker_hash_table); i++)
- s7_remove_from_heap(s7, vals[i]);
- /* removing the hash table itself is problematic because (for example) add_clm_field adds new entries */
- }
-
-}
-
-
-/* -------------------------------------------------------------------------------- */
-/* not s7, make some no-ops so other languages have some hope of compiling */
-
-#else
-
-#include "_sndlib.h"
-#include "xen.h"
-#include "vct.h"
-
-#define S_run "run"
-
-/* XEN here, not s7_pointer in case no s7 */
-struct ptree *mus_run_form_to_ptree_1_b(XEN code) {return(NULL);}
-struct ptree *mus_run_form_to_ptree_1_f(XEN code) {return(NULL);}
-mus_float_t mus_run_evaluate_ptree_1f1v1b2f(struct ptree *pt, mus_float_t arg, vct *v, bool dir) {return(0.0);}
-mus_float_t mus_run_evaluate_ptree_1f2f(struct ptree *pt, mus_float_t arg) {return(0.0);}
-int mus_run_evaluate_ptree_1f2b(struct ptree *pt, mus_float_t arg) {return(0);}
-void mus_run_free_ptree(struct ptree *pt) {}
-XEN mus_run_ptree_code(struct ptree *pt) {return(XEN_FALSE);}
-mus_float_t mus_run_evaluate_ptreec(struct ptree *pt, mus_float_t arg, XEN object, bool dir, int type) {return(0.0);}
-int mus_run_xen_to_run_type(XEN val) {return(0);}
-
-#define S_optimization "optimization"
-static XEN g_optimization(void) {return(XEN_ZERO);}
-static XEN g_set_optimization(XEN val) {return(XEN_ZERO);}
-
-static XEN optimization_hook;
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_optimization_w, g_optimization)
-XEN_NARGIFY_1(g_set_optimization_w, g_set_optimization)
-#else
-#define g_optimization_w g_optimization
-#define g_set_optimization_w g_set_optimization
-#endif
-
-void mus_init_run(void)
-{
- XEN_DEFINE_PROCEDURE_WITH_SETTER("optimization", g_optimization_w, "a no-op", S_setB S_optimization, g_set_optimization_w, 0, 0, 1, 0);
- optimization_hook = XEN_DEFINE_HOOK("optimization-hook", 1, "a no-op");
-}
-
-#endif
diff --git a/s7-slib-init.scm b/s7-slib-init.scm
index b69b429..c89f2e9 100644
--- a/s7-slib-init.scm
+++ b/s7-slib-init.scm
@@ -90,7 +90,7 @@
(else
(slib:warn "require.scm" 'unknown 'software-type (software-type))
"/"))))
- (lambda (chr) (and (memv chr suffi) #t))))
+ (lambda (chr) (memv chr suffi))))
;@
(define (pathname->vicinity pathname)
(let loop ((i (- (string-length pathname) 1)))
@@ -285,7 +285,7 @@
`(set! *defmacros* (cons (cons ',name (lambda ,parms , at body))
*defmacros*))))))
;@
-(define (defmacro? m) (and (assq m *defmacros*) #t))
+(define (defmacro? m) (assq m *defmacros*))
;@
(define (macroexpand-1 e)
(if (pair? e)
@@ -316,7 +316,7 @@
(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
(define (defmacro:expand* x)
- (slib:require 'defmacroexpand) (apply defmacro:expand* x '()))
+ (slib:require 'defmacroexpand) (apply defmacro:expand* x ()))
;@
(define (defmacro:load <pathname>)
(slib:eval-load <pathname> defmacro:eval))
@@ -330,11 +330,8 @@
(newline cep))))
;;@ define an error procedure for the library
-(define slib:error
- (let ((error error))
- (lambda args
- (if (provided? 'trace) (print-call-stack (current-error-port)))
- (apply error args))))
+(define slib:error error)
+
;@
(define (make-exchanger obj)
(lambda (rep) (let ((old obj)) (set! obj rep) old)))
@@ -384,7 +381,7 @@
;;@ Define SLIB:EXIT to be the implementation procedure to exit or
;;; return if exiting not supported.
-(define slib:exit quit)
+(define slib:exit exit)
;;@ Here for backward compatability
(define scheme-file-suffix
@@ -414,3 +411,20 @@
;;(define syncase:load slib:load-source)
(slib:load (in-vicinity (library-vicinity) "require"))
+
+
+;;; --------------------------------------------------------------------------------
+;;; for wttree.scm
+
+(set! *#readers*
+ (cons (cons #\F (lambda (str)
+ (not (string=? str ""))))
+ *#readers*))
+
+;;; for r4syn.scm
+
+(set! *#readers*
+ (cons (cons #\T (lambda (str)
+ (string=? str "")))
+ *#readers*))
+
diff --git a/s7.c b/s7.c
index 7ce53d7..aecf195 100644
--- a/s7.c
+++ b/s7.c
@@ -1,9 +1,9 @@
/* s7, a Scheme interpreter
*
* derived from:
- */
-
-/* T I N Y S C H E M E 1 . 3 9
+ *
+ * --------------------------------------------------------------------------------
+ * T I N Y S C H E M E 1 . 3 9
* Dimitrios Souflis (dsouflis at acm.org)
* Based on MiniScheme (original credits follow)
* (MINISCM) coded by Atsushi Moriwaki (11/5/1989)
@@ -14,172 +14,166 @@
* (MINISCM)
* (MINISCM) This is a revised and modified version by Akira KIDA.
* (MINISCM) current version is 0.85k4 (15 May 1994)
- */
-
-
-/* s7, Bill Schottstaedt, Aug-08
+ * --------------------------------------------------------------------------------
*
- * changes from tinyScheme:
- * just two files: s7.c and s7.h, source-level embeddable (no library, no run-time init files)
- * full continuations, call-with-exit for goto or return, dynamic-wind
- * ratios and complex numbers (and ints are 64-bit by default)
- * optional multiprecision arithmetic for all numeric types and functions
- * generalized set!, procedure-with-setter, applicable objects
- * defmacro and define-macro
- * keywords, hash tables, block comments, define*
- * format
- * error handling using error and catch
- * in sndlib, the run macro works giving s7 a (somewhat limited) byte compiler
- * no invidious distinction between built-in and "foreign"
- * (this makes it easy to extend built-in operators like "+" -- see s7.html for a simple example)
- * lists, strings, vectors, and hash-tables are (set-)applicable objects
- * true multiple-values
- * threads (optional)
- * multidimensional vectors
- * hooks (conditions)
+ * apparently tinyScheme is under the BSD license, so I guess s7 is too.
+ * Here is Snd's verbiage which can apply here:
*
- * differences from r5rs:
- * no syntax-rules or any of its friends
- * no force or delay
- * no inexact integer or ratio (so, for example, truncate returns an exact integer), no exact complex or exact real
- * (exact? has no obvious meaning in regard to complex numbers anyway -- are we referring to the polar or
- * the rectangular form, and are both real and imaginary parts included? -- why can't they be separate?)
- * In s7, exact? is a synonym for rational?, inexact->exact is a synonym for rationalize.
- * '#' does not stand for an unknown digit, and the '@' complex number notation is ignored
- * I also choose not to include numbers such as +i (= 0+i) -- include the real part!
- * modulo, remainder, and quotient take integer, ratio, or real args
- * lcm and gcd can take integer or ratio args
- * continuation? function to distinguish a continuation from a procedure
- * log takes an optional 2nd arg (base)
- * '.' and an exponent can occur in a number in any base -- they do not mean "base 10"!
- * However, the exponent itself is always in base 10 (this follows gmp usage).
+ * The authors hereby grant permission to use, copy, modify, distribute,
+ * and license this software and its documentation for any purpose. No
+ * written agreement, license, or royalty fee is required. Modifications
+ * to this software may be copyrighted by their authors and need not
+ * follow the licensing terms described here.
*
- * other additions:
- * random for any numeric type and any numeric argument, including 0 ferchrissake!
- * sinh, cosh, tanh, asinh, acosh, atanh
- * read-line, read-byte, write-byte, *stdin*, *stdout*, and *stderr*
- * logior, logxor, logand, lognot, ash, integer-length, integer-decode-float, nan?, infinite?
- * procedure-source, procedure-arity, procedure-documentation, help
- * if the initial expression in a function body is a string constant, it is assumed to be a documentation string
- * symbol-table, symbol->value, global-environment, current-environment, procedure-environment, initial-environment, environment?
- * provide, provided?, defined?
- * port-line-number, port-filename
- * object->string, eval-string
- * reverse!, list-set!, sort!, make-list
- * gc, *load-hook*, *error-hook*, *error-info*, *unbound-variable-hook*
- * *features*, *load-path*, *vector-print-length*, *#readers*
- * define-constant, pi, most-positive-fixnum, most-negative-fixnum, constant?
- * symbol-calls if profiling is enabled
- * stacktrace, trace and untrace, *trace-hook*, __func__, macroexpand
- * length, copy, fill!, reverse, map, for-each are generic
- * make-type creates a new scheme type
- * symbol-access modifies symbol value lookup
- * member and assoc accept an optional 3rd argument, the comparison function
+ * followed by the usual all-caps shouting about liability.
*
+ * --------------------------------------------------------------------------------
+ *
+ * s7, Bill Schottstaedt, Aug-08, bil at ccrma.stanford.edu
*
* Mike Scholz provided the FreeBSD support (complex trig funcs, etc)
- * Rick Taube and Andrew Burnson provided the MS Visual C++ support
+ * Rick Taube, Andrew Burnson, Donny Ward, and Greg Santucci provided the MS Visual C++ support
*
+ * Documentation is in s7.h and s7.html.
+ * s7test.scm is a regression test.
+ * glistener.c is a gtk-based listener.
+ * repl.scm is a vt100-based listener.
+ * cload.scm and lib*.scm tie in various C libraries.
+ * lint.scm checks Scheme code for infelicities.
+ * r7rs.scm implements some of r7rs (small).
+ * write.scm currrenly has pretty-print.
+ * mockery.scm has the mock-data definitions.
+ * stuff.scm has some stuff.
*
- * Documentation is in s7.h and s7.html. s7test.scm is a regression test.
+ * s7.c is organized as follows:
+ *
+ * structs and type flags
+ * constants
+ * GC
+ * stacks
+ * symbols and keywords
+ * environments
+ * continuations
+ * numbers
+ * characters
+ * strings
+ * ports
+ * format
+ * lists
+ * vectors
+ * hash-tables
+ * c-objects
+ * functions
+ * equal?
+ * generic length, copy, reverse, fill!, append
+ * error handlers
+ * sundry leftovers
+ * multiple-values, quasiquote
+ * eval
+ * multiprecision arithmetic
+ * *s7* environment
+ * initialization
+ * repl
*
+ * naming conventions: s7_* usually are C accessible (s7.h), g_* are scheme accessible (FFI),
+ * H_* are documentation strings, Q_* are procedure signatures,
+ * *_1 are auxilliary functions, big_* refer to gmp,
+ * scheme "?" corresponds to C "is_", scheme "->" to C "_to_".
*
- * ---------------- compile time switches ----------------
+ * ---------------- compile time switches ----------------
*/
-#include <mus-config.h>
+#include "mus-config.h"
-/*
+/*
* Your config file goes here, or just replace that #include line with the defines you need.
- * The compile-time switches involve booleans, threads, complex numbers, multiprecision arithmetic, profiling, and sort!.
+ * The compile-time switches involve booleans, complex numbers, and multiprecision arithmetic.
* Currently we assume we have setjmp.h (used by the error handlers).
*
- * If pthreads are available:
- *
- * #define HAVE_PTHREADS 1
- *
- * s7.h includes stdbool.h if HAVE_STDBOOL_H is 1 and we're not in C++.
- *
- * The *gc-stats* output includes timing info if HAVE_GETTIMEOFDAY. In this
- * case we also assume we can load <time.h> and <sys/time.h>.
- *
- *
- * Complex number support (which is problematic in C++, Solaris, and netBSD)
- * is on the WITH_COMPLEX switch. On a Mac, or in Linux, if you're not using C++,
- * you can use:
+ * Complex number support which is problematic in C++, Solaris, and netBSD
+ * is on the HAVE_COMPLEX_NUMBERS switch. In OSX or Linux, if you're not using C++,
*
- * #define WITH_COMPLEX 1
+ * #define HAVE_COMPLEX_NUMBERS 1
* #define HAVE_COMPLEX_TRIG 1
*
- * Define the first if your compiler has any support for complex numbers.
- * Define the second if functions like csin are defined in the math library.
+ * In C++ I use:
*
- * In C++ use:
- *
- * #define WITH_COMPLEX 1
+ * #define HAVE_COMPLEX_NUMBERS 1
* #define HAVE_COMPLEX_TRIG 0
*
- * Some systems (freeBSD) have complex.h, but not the trig funcs, so
- * WITH_COMPLEX means we can find
+ * In windows, both are 0.
*
+ * Some systems (FreeBSD) have complex.h, but some random subset of the trig funcs, so
+ * HAVE_COMPLEX_NUMBERS means we can find
* cimag creal cabs csqrt carg conj
- *
* and HAVE_COMPLEX_TRIG means we have
- *
* cacos cacosh casin casinh catan catanh ccos ccosh cexp clog cpow csin csinh ctan ctanh
*
- * When WITH_COMPLEX is 0 or undefined, the complex functions are stubs that simply return their
+ * When HAVE_COMPLEX_NUMBERS is 0, the complex functions are stubs that simply return their
* argument -- this will be very confusing for the s7 user because, for example, (sqrt -2)
* will return something bogus (it will not signal an error).
*
- * Snd's configure.ac has m4 code to handle WITH_COMPLEX and HAVE_COMPLEX_TRIG.
- *
+ * so the incoming (non-s7-specific) compile-time switches are
+ * HAVE_COMPLEX_NUMBERS, HAVE_COMPLEX_TRIG, SIZEOF_VOID_P
+ * if SIZEOF_VOID_P is not defined, we look for __SIZEOF_POINTER__ instead
+ * the default is to assume that we're running on a 64-bit machine.
*
* To get multiprecision arithmetic, set WITH_GMP to 1.
* You'll also need libgmp, libmpfr, and libmpc (version 0.8.0 or later)
+ * In highly numerical contexts, the gmp version of s7 is about 50(!) times slower than the non-gmp version.
+ *
+ * and we use these predefined macros: __cplusplus, _MSC_VER, __GNUC__, __clang__, __ANDROID__
+ *
+ * if WITH_SYSTEM_EXTRAS is 1 (default is 1 unless _MSC_VER), various OS and file related functions are included.
+ * in openBSD I think you need to include -ftrampolines in CFLAGS.
+ * if you want this file to compile into a stand-alone interpreter, define WITH_MAIN
+ *
+ * -O3 is sometimes slower, sometimes faster
+ * -march=native -fomit-frame-pointer -m64 -funroll-loops gains about .1%
+ * -ffast-math makes a mess of NaNs, and does not appear to be faster
+ * for timing tests, I use: -O2 -DINITIAL_HEAP_SIZE=1024000 -march=native -fomit-frame-pointer -funroll-loops
*/
/* ---------------- initial sizes ---------------- */
+#ifndef INITIAL_HEAP_SIZE
#define INITIAL_HEAP_SIZE 128000
-/* the heap grows as needed, this is its initial size.
- *
- * this size is not very important (it can be 32 or maybe smaller):
- * 8k: 2432, 32k: 2419, 128k: 2401, 512k: 2394, 8192k: 2417
- * (valgrind timings from 23-Feb-10 running s7test.scm)
+/* the heap grows as needed, this is its initial size.
+ * If the initial heap is small, s7 can run in about 2.5 Mbytes of memory. There are (many) cases where a bigger heap is faster.
+ * The heap size must be a multiple of 32. Each object takes about 50 bytes.
*
- * If the initial heap is small, s7 can run in less than 1 Mbyte of memory.
+ * repl runs in 4Mb (18v) (64bit) if heap is 8192
+ * 11Mb (25v) if 128k heap
+ * snd (no gui) 15Mb (151v)
+ * snd (motif) 12Mb (285v)
+ * snd (gtk) 32Mb (515v!)
*/
+#endif
-#define SYMBOL_TABLE_SIZE 2207
-/* names are hashed into the symbol table (a vector) and collisions are chained as lists.
- *
- * this number probably does not matter (most global references are direct):
- * 509: 2407, 1049: 2401, 2207: 2401, 4397: 2398, 9601: 2401, 19259: 2404, 39233: 2408
- * (valgrind timings are from 23-Feb-10 running s7test.scm), it was 9601 for a long time.
+#ifndef SYMBOL_TABLE_SIZE
+#define SYMBOL_TABLE_SIZE 13567
+/* names are hashed into the symbol table (a vector) and collisions are chained as lists.
*/
+#endif
-#define INITIAL_STACK_SIZE 2048
+#define INITIAL_STACK_SIZE 512
/* the stack grows as needed, each frame takes 4 entries, this is its initial size.
- * this needs to be big enough to handle the eval_c_string's at startup (ca 100)
+ * this needs to be big enough to handle the eval_c_string's at startup (ca 100)
* In s7test.scm, the maximum stack size is ca 440. In snd-test.scm, it's ca 200.
+ * This number matters only because call/cc copies the stack, which requires filling
+ * the unused portion of the new stack, which requires memcpy of #<unspecified>'s.
*/
-#define INITIAL_PROTECTED_OBJECTS_SIZE 16
+#define INITIAL_PROTECTED_OBJECTS_SIZE 16
/* a vector of objects that are (semi-permanently) protected from the GC, grows as needed */
-#define GC_TEMPS_SIZE 128
-/* the number of recent objects that are temporarily gc-protected; 8 works for s7test and snd-test.
+#define GC_TEMPS_SIZE 256
+/* the number of recent objects that are temporarily gc-protected; 8 works for s7test and snd-test.
* For the FFI, this sets the lag between a call on s7_cons and the first moment when its result
- * might be vulnerable to the GC.
+ * might be vulnerable to the GC.
*/
-#define INITIAL_TRACE_LIST_SIZE 2
-/* a list of currently-traced functions */
-
-
-
/* ---------------- scheme choices ---------------- */
@@ -187,7 +181,7 @@
#define WITH_GMP 0
/* this includes multiprecision arithmetic for all numeric types and functions, using gmp, mpfr, and mpc
* WITH_GMP adds the following functions: bignum, bignum?, bignum-precision
- * using gmp with precision=128 is about 3 times slower than using C doubles and long long ints
+ * using gmp with precision=128 is about 50 times slower than using C doubles and long long ints.
*/
#endif
@@ -195,91 +189,112 @@
#define DEFAULT_BIGNUM_PRECISION 128
#endif
-#ifndef WITH_PROFILING
- #define WITH_PROFILING 0
- /* this includes a simple profiler -- see the profile function in Snd's extensions.scm
- * added function: symbol-calls
+#ifndef WITH_PURE_S7
+ #define WITH_PURE_S7 0
+#endif
+#if WITH_PURE_S7
+ #define WITH_EXTRA_EXPONENT_MARKERS 0
+ #define WITH_IMMUTABLE_UNQUOTE 1
+ #define WITH_QUASIQUOTE_VECTOR 0
+ /* also omitted: *-ci* functions, char-ready?, cond-expand, multiple-values-bind|set!, call-with-values, defmacro(*)
+ * and a lot more (inexact/exact, integer-length, etc) -- see s7.html.
*/
#endif
#ifndef WITH_EXTRA_EXPONENT_MARKERS
- #define WITH_EXTRA_EXPONENT_MARKERS 1
- /* if 1, s7 recognizes "d", "f", "l", and "s" as exponent markers, in addition to "e" (also "D", "F", "L", "S")
- */
+ #define WITH_EXTRA_EXPONENT_MARKERS 0
+ /* if 1, s7 recognizes "d", "f", "l", and "s" as exponent markers, in addition to "e" (also "D", "F", "L", "S") */
#endif
-#ifndef WITH_UNQUOTE_SPLICING
- #define WITH_UNQUOTE_SPLICING 0
- /* backwards compatibility */
+#ifndef WITH_SYSTEM_EXTRAS
+ #define WITH_SYSTEM_EXTRAS (!_MSC_VER)
+ /* this adds several functions that access file info, directories, times, etc
+ * this may be replaced by the cload business below
+ */
#endif
-
-#ifndef DEBUGGING
- #define DEBUGGING 0
+#ifndef WITH_IMMUTABLE_UNQUOTE
+ #define WITH_IMMUTABLE_UNQUOTE 0
+ /* this removes the name "unquote" */
#endif
+#ifndef WITH_QUASIQUOTE_VECTOR
+ #define WITH_QUASIQUOTE_VECTOR 0
+ /* this determines whether we include support for quasiquoted vector constants `#(...) */
+#endif
+#ifndef WITH_C_LOADER
+ #define WITH_C_LOADER WITH_GCC
+ /* (load file.so [e]) looks for (e 'init_func) and if found, calls it
+ * as the shared object init function. If WITH_SYSTEM_EXTRAS is 0, the caller
+ * needs to supply system and delete-file so that cload.scm works.
+ */
+#endif
-/* -------------------------------------------------------------------------------- */
-
-/* s7.c is organized as follows:
- *
- * structs and type flags
- * constants
- * GC
- * stacks
- * symbols
- * environments
- * keywords
- * continuations
- * numbers
- * characters
- * strings
- * ports
- * lists
- * vectors and hash-tables
- * objects and functions
- * hooks
- * eq?
- * generic length, copy, fill!
- * format
- * error handlers, stacktrace, trace
- * sundry leftovers
- * multiple-values, quasiquote
- * eval
- * threads
- * multiprecision arithmetic
- * initialization
- *
- * naming conventions: s7_* usually are C accessible (s7.h), g_* are scheme accessible (FFI), H_* are documentation strings,
- * *_1 are auxilliary functions, big_* refer to gmp and friends, scheme "?" corresponds to C "_is_", scheme "->" to C "_to_".
- */
+#define WITH_GCC (defined(__GNUC__) || defined(__clang__))
-#if __cplusplus
- #ifndef WITH_COMPLEX
- #define WITH_COMPLEX 1
+/* in case mus-config.h forgets these */
+#ifdef _MSC_VER
+ #ifndef HAVE_COMPLEX_NUMBERS
+ #define HAVE_COMPLEX_NUMBERS 0
#endif
#ifndef HAVE_COMPLEX_TRIG
#define HAVE_COMPLEX_TRIG 0
#endif
+#else
+ #ifndef HAVE_COMPLEX_NUMBERS
+ #define HAVE_COMPLEX_NUMBERS 1
+ #endif
+ #if __cplusplus
+ #ifndef HAVE_COMPLEX_TRIG
+ #define HAVE_COMPLEX_TRIG 0
+ #endif
+ #else
+ #ifndef HAVE_COMPLEX_TRIG
+ #define HAVE_COMPLEX_TRIG 1
+ #endif
+ #endif
#endif
+/* -------------------------------------------------------------------------------- */
-#ifndef _MSC_VER
- #include <unistd.h>
+#ifndef DEBUGGING
+ #define DEBUGGING 0
#endif
-#include <limits.h>
-/* #include <float.h> */
-#include <ctype.h>
+#ifndef OP_NAMES
+ #define OP_NAMES 0
+#endif
+
+#define WITH_ADD_PF 0
+
#ifndef _MSC_VER
+ #include <unistd.h>
+ #include <sys/param.h>
#include <strings.h>
#include <errno.h>
+ #include <locale.h>
+#else
+ /* in Snd these are in mus-config.h */
+ #ifndef MUS_CONFIG_H_LOADED
+ #define snprintf _snprintf
+ #if _MSC_VER > 1200
+ #define _CRT_SECURE_NO_DEPRECATE 1
+ #define _CRT_NONSTDC_NO_DEPRECATE 1
+ #define _CRT_SECURE_CPP_OVERLOAD_STANDARD_NAMES 1
+ #endif
+ #endif
+ #include <io.h>
+ #pragma warning(disable: 4244)
#endif
+
+#include <limits.h>
+#include <ctype.h>
#include <string.h>
#include <stdlib.h>
#include <sys/types.h>
#include <time.h>
#include <stdarg.h>
+#include <stddef.h>
#if __cplusplus
#include <cmath>
@@ -287,19 +302,24 @@
#include <math.h>
#endif
-#if WITH_COMPLEX
+#if HAVE_COMPLEX_NUMBERS
#if __cplusplus
#include <complex>
#else
#include <complex.h>
+ #if defined(__sun) && defined(__SVR4)
+ #undef _Complex_I
+ #define _Complex_I 1.0fi
+ #endif
#endif
+#ifndef CMPLX
+ /* c11 addition? */
+ #define CMPLX(r, i) ((r) + ((i) * _Complex_I))
+#endif
#endif
#include <setjmp.h>
-
-#if HAVE_PTHREADS || HAVE_PTHREAD_H
- #include <pthread.h>
-#endif
+/* currently longjmps in s7_call, s7_error, g_throw, eval at OP_ERROR_HOOK_QUIT */
#include "s7.h"
@@ -309,534 +329,1522 @@
#ifndef INFINITY
#define INFINITY (-log(0.0))
+ /* 1.0 / 0.0 is also used, there is sometimes a function, infinity(), MSC apparently uses HUGE_VALF */
#endif
#ifndef NAN
#define NAN (INFINITY / INFINITY)
#endif
-typedef enum {OP_READ_INTERNAL, OP_EVAL, OP_EVAL_ARGS, OP_EVAL_ARGS1, OP_APPLY, OP_EVAL_MACRO, OP_LAMBDA, OP_QUOTE,
- OP_DEFINE, OP_DEFINE1, OP_BEGIN, OP_IF, OP_IF1, OP_SET, OP_SET1, OP_SET2,
- OP_LET, OP_LET1, OP_LET2, OP_LET_STAR, OP_LET_STAR1,
- OP_LETREC, OP_LETREC1, OP_LETREC2, OP_COND, OP_COND1,
- OP_AND, OP_AND1, OP_OR, OP_OR1, OP_DEFMACRO, OP_DEFMACRO_STAR,
- OP_MACRO, OP_DEFINE_MACRO, OP_DEFINE_MACRO_STAR, OP_DEFINE_EXPANSION, OP_EXPANSION,
- OP_CASE, OP_CASE1, OP_CASE2, OP_READ_LIST, OP_READ_DOT, OP_READ_QUOTE,
- OP_READ_QUASIQUOTE, OP_READ_QUASIQUOTE_VECTOR, OP_READ_UNQUOTE, OP_READ_APPLY_VALUES,
- OP_READ_VECTOR, OP_READ_DONE,
- OP_LOAD_RETURN_IF_EOF, OP_LOAD_CLOSE_AND_POP_IF_EOF, OP_EVAL_STRING, OP_EVAL_DONE,
- OP_CATCH, OP_DYNAMIC_WIND, OP_DEFINE_CONSTANT, OP_DEFINE_CONSTANT1,
- OP_DO, OP_DO_END, OP_DO_END1, OP_DO_STEP, OP_DO_STEP2, OP_DO_INIT,
- OP_DEFINE_STAR, OP_LAMBDA_STAR, OP_ERROR_QUIT, OP_UNWIND_INPUT, OP_UNWIND_OUTPUT,
- OP_TRACE_RETURN, OP_ERROR_HOOK_QUIT, OP_TRACE_HOOK_QUIT, OP_WITH_ENV, OP_WITH_ENV1,
- OP_FOR_EACH, OP_MAP, OP_BARRIER, OP_DEACTIVATE_GOTO,
- OP_DEFINE_BACRO, OP_DEFINE_BACRO_STAR, OP_BACRO,
- OP_GET_OUTPUT_STRING, OP_SORT, OP_SORT1, OP_SORT2, OP_SORT3, OP_SORT4, OP_SORT_TWO,
- OP_EVAL_STRING_1, OP_EVAL_STRING_2, OP_SET_ACCESS, OP_HOOK_APPLY,
- OP_MEMBER_IF, OP_ASSOC_IF, OP_MEMBER_IF1, OP_ASSOC_IF1,
- OP_MAX_DEFINED} opcode_t;
-
-static const char *op_names[OP_MAX_DEFINED] =
- {"read-internal", "eval", "eval-args", "eval-args", "apply", "eval-macro", "lambda",
- "quote", "define", "define", "begin", "if", "if", "set!", "set!", "set!",
- "let", "let", "let", "let*", "let*", "letrec", "letrec", "letrec",
- "cond", "cond", "and", "and", "or", "or", "defmacro", "defmacro*", "macro",
- "define-macro", "define-macro*", "define-expansion", "expansion", "case", "case",
- "case", "read-list", "read-dot", "read-quote", "read-quasiquote", "read-quasiquote-vector",
- "read-unquote", "read-apply-values", "read-vector", "read-done",
- "load-return-if-eof", "load-close-and-stop-if-eof", "eval-string", "eval-done", "catch",
- "dynamic-wind", "define-constant", "define-constant", "do", "do", "do",
- "do", "do", "do", "define*", "lambda*",
- "error-quit", "unwind-input", "unwind-output", "trace-return", "error-hook-quit",
- "trace-hook-quit", "with-environment", "with-environment", "for-each", "map",
- "barrier", "deactivate-goto", "define-bacro", "define-bacro*", "bacro",
- "get-output-string", "sort", "sort", "sort", "sort", "sort", "sort",
- "eval-string", "eval-string", "set-access", "hook-apply",
- "member-if", "assoc-if", "member-if", "assoc-if"
-};
-
+#define BOLD_TEXT "\033[1m"
+#define UNBOLD_TEXT "\033[22m"
-#define NUM_SMALL_INTS 256
-/* this needs to be at least OP_MAX_DEFINED = 95 max num chars (256) */
-/* going up to 1024 gives very little improvement */
+#define WRITE_REAL_PRECISION 16
+static int float_format_precision = WRITE_REAL_PRECISION;
-typedef enum {TOKEN_EOF, TOKEN_LEFT_PAREN, TOKEN_RIGHT_PAREN, TOKEN_DOT, TOKEN_ATOM, TOKEN_QUOTE, TOKEN_DOUBLE_QUOTE,
- TOKEN_BACK_QUOTE, TOKEN_COMMA, TOKEN_AT_MARK, TOKEN_SHARP_CONST, TOKEN_VECTOR} token_t;
+#if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L))))
+ #define __func__ __FUNCTION__
+#endif
+#define DISPLAY(Obj) s7_object_to_c_string(sc, Obj)
+#define DISPLAY_80(Obj) object_to_truncated_string(sc, Obj, 80)
+
+#if (((defined(SIZEOF_VOID_P)) && (SIZEOF_VOID_P == 4)) || ((defined(__SIZEOF_POINTER__)) && (__SIZEOF_POINTER__ == 4)))
+ #define opcode_t unsigned int
+ #define PRINT_NAME_PADDING 8
+ #define PRINT_NAME_SIZE (20 - PRINT_NAME_PADDING - 2)
+ #define ptr_int unsigned int
+ #define INT_FORMAT "%u"
+ #ifndef WITH_OPTIMIZATION
+ #define WITH_OPTIMIZATION 0
+ /* 32-bit optimized case gets inexplicable NaNs in float-vector ops.
+ * only the rf cases are faulty, so it is possible to set this flag to 1, then make s7_rf_set_function a no-op,
+ * and comment out the 2 syntax_rp cases.
+ * In standard scheme code, this flag does not matter much, but it makes CLM run about 3 times as fast.
+ */
+ #endif
+#else
+ #define opcode_t unsigned long long int
+ #define ptr_int unsigned long long int
+ #define INT_FORMAT "%llu"
+ #define PRINT_NAME_PADDING 16
+ #define PRINT_NAME_SIZE (40 - PRINT_NAME_PADDING - 2)
+ #ifndef WITH_OPTIMIZATION
+ #define WITH_OPTIMIZATION 1
+ #endif
+#endif
-typedef struct s7_num_t {
- int type;
- union {
-
- s7_Int integer_value;
-
- s7_Double real_value;
-
- struct {
- s7_Int numerator;
- s7_Int denominator;
- } fraction_value;
-
- struct {
- s7_Double real;
- s7_Double imag;
- } complex_value;
-
- unsigned long ul_value; /* these two are not used by s7 in any way */
- unsigned long long ull_value;
- } value;
-} s7_num_t;
+/* types */
+#define T_FREE 0
+#define T_PAIR 1
+#define T_NIL 2
+#define T_UNIQUE 3
+#define T_UNSPECIFIED 4
+#define T_BOOLEAN 5
+#define T_CHARACTER 6
+#define T_SYMBOL 7
+#define T_SYNTAX 8
+
+#define T_INTEGER 9
+#define T_RATIO 10
+#define T_REAL 11
+#define T_COMPLEX 12
+
+#define T_BIG_INTEGER 13 /* these four used only if WITH_GMP -- order matters */
+#define T_BIG_RATIO 14
+#define T_BIG_REAL 15
+#define T_BIG_COMPLEX 16
+
+#define T_STRING 17
+#define T_C_OBJECT 18
+#define T_VECTOR 19
+#define T_INT_VECTOR 20
+#define T_FLOAT_VECTOR 21
+
+#define T_CATCH 22
+#define T_DYNAMIC_WIND 23
+#define T_HASH_TABLE 24
+#define T_LET 25
+#define T_ITERATOR 26
+#define T_STACK 27
+#define T_COUNTER 28
+#define T_SLOT 29
+#define T_C_POINTER 30
+#define T_OUTPUT_PORT 31
+#define T_INPUT_PORT 32
+#define T_BAFFLE 33
+#define T_RANDOM_STATE 34
+
+#define T_GOTO 35
+#define T_CONTINUATION 36
+#define T_CLOSURE 37
+#define T_CLOSURE_STAR 38
+#define T_C_MACRO 39
+#define T_MACRO 40
+#define T_MACRO_STAR 41
+#define T_BACRO 42
+#define T_BACRO_STAR 43
+#define T_C_FUNCTION_STAR 44
+#define T_C_FUNCTION 45
+#define T_C_ANY_ARGS_FUNCTION 46
+#define T_C_OPT_ARGS_FUNCTION 47
+#define T_C_RST_ARGS_FUNCTION 48
+
+#define NUM_TYPES 49
+
+/* T_STACK, T_SLOT, T_BAFFLE, T_DYNAMIC_WIND, and T_COUNTER are internal
+ * I tried T_CASE_SELECTOR that turned a case statement into an array, but it was slower!
+ */
+typedef enum {TOKEN_EOF, TOKEN_LEFT_PAREN, TOKEN_RIGHT_PAREN, TOKEN_DOT, TOKEN_ATOM, TOKEN_QUOTE, TOKEN_DOUBLE_QUOTE,
+ TOKEN_BACK_QUOTE, TOKEN_COMMA, TOKEN_AT_MARK, TOKEN_SHARP_CONST,
+ TOKEN_VECTOR, TOKEN_BYTE_VECTOR} token_t;
typedef enum {FILE_PORT, STRING_PORT, FUNCTION_PORT} port_type_t;
-typedef struct s7_port_t {
- bool is_closed;
- port_type_t type;
+typedef struct {
bool needs_free;
FILE *file;
- int line_number;
- int file_number;
char *filename;
- char *value;
- int size, point; /* these limit the in-core portion of a string-port to 2^31 bytes */
+ int filename_length, gc_loc;
+ void *next;
s7_pointer (*input_function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port);
void (*output_function)(s7_scheme *sc, unsigned char c, s7_pointer port);
- void *data;
/* a version of string ports using a pointer to the current location and a pointer to the end
* (rather than an integer for both, indexing from the base string) was not faster.
*/
-} s7_port_t;
+ s7_pointer orig_str; /* GC protection for string port string */
+ int (*read_character)(s7_scheme *sc, s7_pointer port); /* function to read a character */
+ void (*write_character)(s7_scheme *sc, int c, s7_pointer port); /* function to write a character */
+ void (*write_string)(s7_scheme *sc, const char *str, int len, s7_pointer port); /* function to write a string of known length */
+ token_t (*read_semicolon)(s7_scheme *sc, s7_pointer port); /* internal skip-to-semicolon reader */
+ int (*read_white_space)(s7_scheme *sc, s7_pointer port); /* internal skip white space reader */
+ s7_pointer (*read_name)(s7_scheme *sc, s7_pointer pt); /* internal get-next-name reader */
+ s7_pointer (*read_sharp)(s7_scheme *sc, s7_pointer pt); /* internal get-next-sharp-constant reader */
+ s7_pointer (*read_line)(s7_scheme *sc, s7_pointer pt, bool eol_case, bool copied); /* function to read a string up to \n */
+ void (*display)(s7_scheme *sc, const char *s, s7_pointer pt);
+} port_t;
-typedef struct s7_func_t {
- s7_function ff;
+typedef struct {
const char *name;
+ int name_length;
+ unsigned int id;
char *doc;
- int required_args, optional_args, all_args;
- bool rest_arg;
- s7_pointer setter;
-} s7_func_t;
+ s7_pointer generic_ff;
+ s7_pointer signature;
+ s7_pointer (*chooser)(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr);
+ s7_pointer *arg_defaults, *arg_names;
+ s7_pointer call_args;
+ s7_rp_t rp;
+ s7_ip_t ip;
+ s7_pp_t pp, gp;
+} c_proc_t;
+
+
+typedef struct { /* call/cc */
+ unsigned int stack_size, op_stack_loc, op_stack_size;
+ int local_key; /* for with-baffle */
+} continuation_t;
+
+
+typedef struct vdims_t {
+ unsigned int ndims;
+ bool elements_allocated, dimensions_allocated; /* these are allocated as bytes, not ints, so the struct size is 32 */
+ s7_int *dims, *offsets;
+ s7_pointer original;
+} vdims_t;
-typedef struct s7_vdims_t {
- int ndims;
- s7_Int *dims, *offsets;
- s7_pointer original;
-} s7_vdims_t;
+typedef struct {
+ int type;
+ unsigned int outer_type;
+ const char *name;
+ s7_pointer scheme_name;
+ char *(*print)(s7_scheme *sc, void *value);
+ void (*free)(void *value);
+ bool (*equal)(void *val1, void *val2);
+ void (*gc_mark)(void *val);
+ s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
+ s7_pointer (*length)(s7_scheme *sc, s7_pointer obj);
+ s7_pointer (*copy)(s7_scheme *sc, s7_pointer args);
+ s7_pointer (*reverse)(s7_scheme *sc, s7_pointer obj);
+ s7_pointer (*fill)(s7_scheme *sc, s7_pointer args);
+ char *(*print_readably)(s7_scheme *sc, void *value);
+ s7_pointer (*direct_ref)(s7_scheme *sc, s7_pointer obj, s7_int index);
+ s7_pointer (*direct_set)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val);
+ s7_ip_t ip, set_ip;
+ s7_rp_t rp, set_rp;
+} c_object_t;
+
+
+typedef struct hash_entry_t {
+ s7_pointer key, value;
+ struct hash_entry_t *next;
+ unsigned int raw_hash;
+} hash_entry_t;
+
+typedef unsigned int (*hash_map_t)(s7_scheme *sc, s7_pointer table, s7_pointer key); /* hash-table object->location mapper */
+typedef hash_entry_t *(*hash_check_t)(s7_scheme *sc, s7_pointer table, s7_pointer key); /* hash-table object equality function */
+static hash_map_t *default_hash_map;
/* cell structure */
typedef struct s7_cell {
- unsigned int flag;
-#if DEBUGGING
- unsigned int saved_flag;
-#endif
+ union {
+ unsigned int flag;
+ unsigned char type_field;
+ unsigned short sflag;
+ } tf;
int hloc;
-#if WITH_PROFILING
- long long int calls;
- int *data;
-#endif
union {
-
+
+ union {
+ s7_int integer_value;
+ s7_double real_value;
+
+ struct {
+ char padding[PRINT_NAME_PADDING];
+ char name[PRINT_NAME_SIZE + 2];
+ } pval;
+
+ struct {
+ s7_int numerator;
+ s7_int denominator;
+ } fraction_value;
+
+ struct {
+ s7_double rl;
+ s7_double im;
+ } complex_value;
+
+ unsigned long ul_value; /* these two are not used by s7 in any way */
+ unsigned long long ull_value;
+
+#if WITH_GMP
+ mpz_t big_integer;
+ mpq_t big_ratio;
+ mpfr_t big_real;
+ mpc_t big_complex;
+ /* using free_lists here was not faster, and avoiding the extra init/clear too tricky. These make up
+ * no more than ca. 5% of the gmp computation -- it is totally dominated by stuff like __gmpz_mul,
+ * so I can't see much point in optimizing the background noise. In a very numerical context,
+ * gmp slows us down by a factor of 50.
+ */
+#endif
+ } number;
+
struct {
+ port_t *port;
+ unsigned char *data;
+ unsigned int size, point; /* these limit the in-core portion of a string-port to 2^31 bytes */
+ unsigned int line_number, file_number;
+ bool is_closed;
+ port_type_t ptype;
+ } prt;
+
+ struct{
+ unsigned char c, up_c;
int length;
- int location;
- char *svalue;
- s7_pointer global_slot; /* for strings that represent symbol names, this is the global slot */
- } string;
-
- s7_num_t number;
-
- s7_port_t *port;
-
- unsigned char cvalue;
-
+ bool alpha_c, digit_c, space_c, upper_c, lower_c;
+ char c_name[12];
+ } chr;
+
void *c_pointer;
-
+
+ int baffle_key;
+
struct {
- s7_Int length;
- s7_pointer *elements;
+ s7_int length;
union {
- s7_vdims_t *dim_info;
- int entries;
- /* was s7_Int but that costs us 4 bytes per object everywhere in the 32-bit case
- * on 64-bit machines, it could be s7_Int without problem.
- */
- } vextra;
- int hash_func;
+ s7_pointer *objects;
+ s7_int *ints;
+ s7_double *floats;
+ } elements;
+ vdims_t *dim_info;
+ s7_pointer (*vget)(s7_scheme *sc, s7_pointer vec, s7_int loc);
+ s7_pointer (*vset)(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val);
} vector;
-
- s7_func_t *ffptr;
-
+
struct {
- s7_pointer car, cdr, csr;
- /* this could be made available to callers -- doubly linked lists? nets?
- * I'm told this idea was once called a "hunk" and was considered a disaster.
- * Due to the s7_num_t size, there is unused space in several of these union fields,
- * so csr currently holds the symbol-access lists.
- */
- int line;
+ s7_int length;
+ s7_pointer *objects;
+ vdims_t *dim_info;
+ int top;
+ } stk;
+
+ struct {
+ unsigned int mask, entries;
+ hash_entry_t **elements;
+ hash_check_t hash_func;
+ hash_map_t *loc;
+ s7_pointer dproc;
+ } hasher;
+
+ struct {
+ s7_pointer obj, cur;
+ union {
+ s7_int loc;
+ s7_pointer lcur;
+ } lc;
+ union {
+ s7_int len;
+ s7_pointer slow;
+ hash_entry_t *hcur;
+ } lw;
+ s7_pointer (*next)(s7_scheme *sc, s7_pointer iterator);
+ } iter;
+
+ struct {
+ c_proc_t *c_proc; /* C functions, macros */
+ s7_function ff;
+ s7_pointer setter;
+ unsigned int required_args, optional_args, all_args;
+ bool rest_arg;
+ } fnc;
+
+ struct { /* pairs */
+ s7_pointer car, cdr, opt1, opt2, opt3;
} cons;
-
+
+ struct {
+ s7_pointer sym_car, sym_cdr;
+ unsigned long long int hash;
+ const char *fstr;
+ unsigned int op, line;
+ } sym_cons;
+
+ struct {
+ s7_pointer args, body, env, setter;
+ int arity;
+ } func;
+
+ struct {
+ unsigned int length;
+ union {
+ bool needs_free;
+ int accessor;
+ } str_ext;
+ char *svalue;
+ unsigned long long int hash; /* string hash-index */
+ s7_pointer initial_slot;
+ union {
+ char *documentation;
+ s7_pointer ksym;
+ } doc;
+ } string;
+
+ struct { /* symbols */
+ s7_pointer name, global_slot, local_slot;
+ long long int id;
+ unsigned int op, tag;
+ } sym;
+
+ struct { /* syntax */
+ s7_pointer symbol;
+ int op;
+ short min_args, max_args;
+ s7_rp_t rp;
+ s7_ip_t ip;
+ s7_pp_t pp;
+ } syn;
+
+ struct { /* slots (bindings) */
+ s7_pointer sym, val, nxt, pending_value, expr;
+ } slt;
+
+ struct { /* environments (frames) */
+ s7_pointer slots, nxt;
+ long long int id; /* id of rootlet is -1 */
+ union {
+ struct {
+ s7_pointer function; /* __func__ (code) if this is a funclet */
+ unsigned int line, file; /* __func__ location if it is known */
+ } efnc;
+ struct {
+ s7_pointer dox1, dox2; /* do loop variables */
+ } dox;
+ struct { /* (catch #t ...) opts */
+ s7_pointer result;
+ unsigned int op_stack_loc, goto_loc;
+ } ctall;
+ } edat;
+ } envr;
+
+ struct {
+ /* these 3 are just place-holders */
+ s7_pointer unused_slots, unused_nxt;
+ long long int unused_id;
+ /* these two fields are for some special case objects like #<unspecified> */
+ const char *name;
+ int len;
+ } unq;
+
+ struct { /* counter (internal) */
+ s7_pointer result, list, env; /* env = counter_let (curlet after map/for-each frame created) */
+ unsigned long long int cap; /* sc->capture_let_counter for frame reuse */
+ } ctr;
+
struct {
+#if WITH_GMP
+ gmp_randstate_t state;
+#else
+ unsigned long long int seed, carry;
+#endif
+ } rng;
+
+ struct { /* additional object types (C) */
int type;
- void *value;
- } fobj;
-
- struct { /* call/cc */
+ void *value; /* the value the caller associates with the object */
+ s7_pointer e; /* the method list, if any (openlet) */
+ s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_int pos);
+ } c_obj;
+
+ struct {
+ continuation_t *continuation;
s7_pointer stack;
- s7_pointer *stack_start, *stack_end;
- int stack_size;
- } continuation;
-
+ s7_pointer *stack_start, *stack_end, *op_stack;
+ } cwcc;
+
struct { /* call-with-exit */
- int goto_loc;
+ unsigned int goto_loc, op_stack_loc;
bool active;
} rexit;
-
+
struct { /* catch */
- int goto_loc;
+ unsigned int goto_loc, op_stack_loc;
s7_pointer tag;
s7_pointer handler;
} rcatch; /* C++ reserves "catch" I guess */
-
+
struct { /* dynamic-wind */
s7_pointer in, out, body;
- int state;
+ unsigned int state;
} winder;
+ } object;
- struct { /* hook */
- s7_pointer functions, arity, documentation;
- } hook;
+#if DEBUGGING
+ int current_alloc_line, previous_alloc_line, current_alloc_type, previous_alloc_type, debugger_bits, gc_line, clear_line, alloc_line, uses;
+ const char *current_alloc_func, *previous_alloc_func, *gc_func, *alloc_func;
+#endif
- } object;
} s7_cell;
-/* on 32 bit machines, s7_cell is 28 bytes because vector and s7_num_t are 20 + 8 overhead (flag + hloc)
- * on 64 bit machines, it is 40 (28 for continuation + 8 overhead + 4 pad bytes in the continuation struct)
- */
+
+typedef struct {
+ s7_pointer *objs;
+ int size, top, ref;
+ bool has_hits;
+ int *refs;
+} shared_info;
-#if HAVE_PTHREADS
typedef struct {
- s7_scheme *sc;
- s7_pointer func;
- pthread_t *thread;
- void *data;
-} thred;
-#endif
+ int loc, curly_len, ctr;
+ char *curly_str;
+ s7_pointer args, orig_str, curly_arg;
+ s7_pointer port, strport;
+} format_data;
+
+
+typedef struct gc_obj {
+ s7_pointer p;
+ struct gc_obj *nxt;
+} gc_obj;
+
+
+typedef struct xf_t {
+ s7_pointer *data, *cur, *end;
+ s7_pointer e;
+ int size;
+ gc_obj *gc_list;
+ struct xf_t *next;
+} xf_t;
+
+static s7_pointer *small_ints, *chars;
+static s7_pointer real_zero, real_NaN, real_pi, real_one, arity_not_set, max_arity, real_infinity, real_minus_infinity, minus_one, minus_two;
+
+
+struct s7_scheme {
+ opcode_t op; /* making this global is much slower! */
+ s7_pointer value;
+ s7_pointer args; /* arguments of current function */
+ s7_pointer code, cur_code; /* current code */
+ s7_pointer envir; /* curlet */
+ token_t tok;
+
+ s7_pointer stack; /* stack is a vector */
+ unsigned int stack_size;
+ s7_pointer *stack_start, *stack_end, *stack_resize_trigger;
-static s7_pointer *small_ints, *small_negative_ints, *chars;
-static s7_pointer real_zero, real_one; /* -1.0 as constant gains us almost nothing in run time */
+ s7_pointer *op_stack, *op_stack_now, *op_stack_end;
+ unsigned int op_stack_size, max_stack_size;
-struct s7_scheme {
- s7_cell **heap, **free_heap, **free_heap_top, **free_heap_trigger;
+ s7_cell **heap, **free_heap, **free_heap_top, **free_heap_trigger, **previous_free_heap_top;
unsigned int heap_size;
+ int gc_freed;
/* "int" or "unsigned int" seems safe here:
- * sizeof(s7_cell) = 28 in 32-bit machines, 32 in 64
- * so to get more than 2^32 actual objects would require ca 140 GBytes RAM
+ * sizeof(s7_cell) = 48 bytes
+ * so to get more than 2^32 actual objects would require ca 206 GBytes RAM
* vectors might be full of the same object (sc->NIL for example), so there
* we need ca 38 GBytes RAM (8 bytes per pointer).
*/
-
- s7_pointer args; /* arguments of current function */
- s7_pointer envir; /* current environment */
- s7_pointer code, cur_code; /* current code */
- s7_pointer stack; /* stack is a vector */
- int stack_size;
- s7_pointer *stack_start, *stack_end, *stack_resize_trigger;
-
- s7_pointer protected_objects; /* a vector of gc-protected objects */
- int *protected_objects_size, *protected_objects_loc; /* pointers so they're global across threads */
+ gc_obj *permanent_objects;
+
+ s7_pointer protected_objects, protected_accessors; /* a vector of gc-protected objects */
+ unsigned int protected_objects_size, protected_objects_loc, protected_accessors_size, protected_accessors_loc;
- struct s7_cell _NIL;
s7_pointer NIL; /* empty list */
-
- struct s7_cell _T;
s7_pointer T; /* #t */
-
- struct s7_cell _F;
s7_pointer F; /* #f */
-
- struct s7_cell _EOF_OBJECT;
s7_pointer EOF_OBJECT; /* #<eof> */
-
- struct s7_cell _UNDEFINED;
s7_pointer UNDEFINED; /* #<undefined> */
-
- struct s7_cell _UNSPECIFIED;
s7_pointer UNSPECIFIED; /* #<unspecified> */
-
- struct s7_cell _NO_VALUE;
s7_pointer NO_VALUE; /* the (values) value */
+ s7_pointer ELSE; /* else */
+ s7_pointer GC_NIL; /* a marker for an unoccupied slot in sc->protected_objects (and other similar stuff) */
- struct s7_cell _ELSE;
- s7_pointer ELSE; /* else */
-
s7_pointer symbol_table; /* symbol table */
- s7_pointer global_env; /* global environment */
- s7_pointer initial_env; /* original bindings of predefined functions */
-
- s7_pointer LAMBDA, LAMBDA_STAR, QUOTE, UNQUOTE, MACROEXPAND;
- s7_pointer APPLY, VECTOR, CDR, SET, QQ_VALUES, QQ_LIST, QQ_APPLY, QQ_APPEND, MULTIVECTOR;
- s7_pointer ERROR, WRONG_TYPE_ARG, WRONG_TYPE_ARG_INFO, OUT_OF_RANGE, OUT_OF_RANGE_INFO;
- s7_pointer SIMPLE_WRONG_TYPE_ARG_INFO, SIMPLE_OUT_OF_RANGE_INFO;
- s7_pointer FORMAT_ERROR, WRONG_NUMBER_OF_ARGS, READ_ERROR, SYNTAX_ERROR, TOO_MANY_ARGUMENTS, NOT_ENOUGH_ARGUMENTS;
- s7_pointer KEY_KEY, KEY_OPTIONAL, KEY_REST, KEY_ALLOW_OTHER_KEYS;
- s7_pointer __FUNC__;
- s7_pointer OBJECT_SET; /* applicable object set method */
- s7_pointer FEED_TO; /* => */
- s7_pointer VECTOR_SET, STRING_SET, LIST_SET, HASH_TABLE_SET, HASH_TABLE_ITERATE;
- s7_pointer S_IS_TYPE, S_TYPE_MAKE, S_TYPE_REF, S_TYPE_ARG;
- s7_pointer s_function_args;
-#if WITH_UNQUOTE_SPLICING
- s7_pointer UNQUOTE_SPLICING;
-#endif
-
+ s7_pointer rootlet, shadow_rootlet; /* rootlet */
+ s7_int rootlet_entries;
+ s7_pointer unlet; /* original bindings of predefined functions */
+
s7_pointer input_port; /* current-input-port */
s7_pointer input_port_stack; /* input port stack (load and read internally) */
s7_pointer output_port; /* current-output-port */
s7_pointer error_port; /* current-error-port */
- s7_pointer error_info; /* the vector bound to *error-info* */
- bool input_is_file;
+ s7_pointer owlet; /* owlet */
+ s7_pointer error_type, error_data, error_code, error_line, error_file; /* owlet slots */
s7_pointer standard_input, standard_output, standard_error;
s7_pointer sharp_readers; /* the binding pair for the global *#readers* list */
- s7_pointer vector_print_length; /* same for *vector-print-length* */
- s7_pointer trace_hook; /* *trace-hook* hook object */
s7_pointer load_hook; /* *load-hook* hook object */
s7_pointer unbound_variable_hook; /* *unbound-variable-hook* hook object */
+ s7_pointer missing_close_paren_hook;
s7_pointer error_hook; /* *error-hook* hook object */
-
- /* these 6 are pointers so that all thread refs are to the same thing */
- bool *gc_off, *gc_stats; /* gc_off: if true, the GC won't run, gc_stats: if true, print stats during GC */
- bool *tracing, *trace_all; /* if tracing, each function on the *trace* list prints its args upon application */
- long *gensym_counter;
- bool *symbol_table_is_locked; /* this also needs to be global across threads */
+ s7_pointer direct_str;
+
+ bool gc_off; /* gc_off: if true, the GC won't run */
+ unsigned int gc_stats;
+ unsigned int gensym_counter, cycle_counter, f_class, add_class, multiply_class, subtract_class, equal_class;
+ int format_column;
+ unsigned long long int capture_let_counter;
+ bool symbol_table_is_locked;
+ long long int let_number;
+ double default_rationalize_error, morally_equal_float_epsilon, hash_table_float_epsilon;
+ s7_int default_hash_table_length, initial_string_port_length, print_length, max_vector_length, max_string_length, max_list_length, max_vector_dimensions;
+ s7_pointer stacktrace_defaults;
+ vdims_t *wrap_only;
+
+ char *typnam;
+ int typnam_len;
+ char *help_arglist;
+ int print_width;
+ s7_pointer *singletons;
+
+ #define INITIAL_TMP_STR_SIZE 16
+ s7_pointer *tmp_strs;
+
+ #define INITIAL_FILE_NAMES_SIZE 8
+ s7_pointer *file_names;
+ int file_names_size, file_names_top;
#define INITIAL_STRBUF_SIZE 1024
- int strbuf_size;
- char *strbuf;
-
- char *read_line_buf;
- int read_line_buf_size;
+ unsigned int strbuf_size;
+ #define TMPBUF_SIZE 1024
+ char *strbuf, *tmpbuf;
- token_t tok;
- s7_pointer value;
- opcode_t op;
- s7_pointer w, x, y, z; /* evaluator local vars */
+ char *read_line_buf;
+ unsigned int read_line_buf_size;
- s7_pointer *temps; /* short-term gc protection */
- int temps_ctr, temps_size;
- struct s7_cell _TEMP_CELL, _TEMP_CELL_1;
- s7_pointer TEMP_CELL, TEMP_CELL_1;
+ s7_pointer v, w, x, y, z; /* evaluator local vars */
+ s7_pointer temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8, temp9, temp10;
+ s7_pointer temp_cell, temp_cell_1, temp_cell_2;
+ s7_pointer d1, d2, d3, d4;
+ s7_pointer T1_1, T2_1, T2_2, T3_1, T3_2, T3_3, Z2_1, Z2_2;
+ s7_pointer A1_1, A2_1, A2_2, A3_1, A3_2, A3_3, A4_1, A4_2, A4_3, A4_4;
jmp_buf goto_start;
bool longjmp_ok;
- void (*error_exiter)(void);
- bool (*begin_hook)(s7_scheme *sc);
-
-#if HAVE_PTHREADS
- struct s7_scheme *orig_sc;
- s7_pointer key_values;
- int thread_id;
- int *thread_ids; /* global current top thread_id */
-#endif
+ void (*begin_hook)(s7_scheme *sc, bool *val);
- s7_pointer *trace_list;
- int trace_list_size, trace_top, trace_depth;
int no_values, current_line, s7_call_line, safety;
const char *current_file, *s7_call_file, *s7_call_name;
- void *default_rng;
+ shared_info *circle_info;
+ format_data **fdats;
+ int num_fdats;
+ s7_pointer elist_1, elist_2, elist_3, elist_4, elist_5, plist_1, plist_2, plist_3;
+
+ s7_pointer *strings, *vectors, *input_ports, *output_ports, *continuations, *c_objects, *hash_tables, *gensyms, *setters;
+ unsigned int strings_size, vectors_size, input_ports_size, output_ports_size, continuations_size, c_objects_size, hash_tables_size, gensyms_size, setters_size;
+ unsigned int strings_loc, vectors_loc, input_ports_loc, output_ports_loc, continuations_loc, c_objects_loc, hash_tables_loc, gensyms_loc, setters_loc;
+
+ unsigned int syms_tag;
+ int ht_iter_tag, baffle_ctr, bignum_precision;
+ s7_pointer default_rng;
+
#if WITH_GMP
- void *default_big_rng;
+ s7_pointer *bigints, *bigratios, *bigreals, *bignumbers;
+ int bigints_size, bigratios_size, bigreals_size, bignumbers_size;
+ int bigints_loc, bigratios_loc, bigreals_loc, bignumbers_loc;
#endif
+
+ /* these are symbols, primarily for the generic function search */
+ s7_pointer SUBTRACT, MULTIPLY, ADD, DIVIDE, LT, LEQ, EQ, GT, GEQ, ABS, ACOS, ACOSH;
+ s7_pointer ANGLE, APPEND, APPLY, IS_ARITABLE, ARITY, ASH, ASIN, ASINH, ASSOC, ASSQ, ASSV, ATAN, ATANH;
+ s7_pointer SUBLET, VARLET, UNLET, CUTLET, AUTOLOAD, AUTOLOADER, IS_BOOLEAN, BYTE_VECTOR, IS_BYTE_VECTOR, CAAAAR, CAAADR, CAAAR, CAADAR, CAADDR;
+ s7_pointer CAADR, CAAR, CADAAR, CADADR, CADAR, CADDAR, CADDDR, CADDR, CADR, CALL_CC, CALL_WITH_CURRENT_CONTINUATION, CALL_WITH_EXIT, COVERLET;
+ s7_pointer CALL_WITH_INPUT_FILE, CALL_WITH_INPUT_STRING, CALL_WITH_OUTPUT_FILE, CALL_WITH_OUTPUT_STRING, CAR, CATCH, CDAAAR;
+ s7_pointer CDAADR, CDAAR, CDADAR, CDADDR, CDADR, CDAR, CDDAAR, CDDADR, CDDAR, CDDDAR, CDDDDR, CDDDR, CDDR, CDR, CEILING, CURLET;
+ s7_pointer CHAR_LEQ, CHAR_LT, CHAR_EQ, CHAR_GEQ, CHAR_GT, IS_CHAR, CHAR_POSITION, CHAR_TO_INTEGER, IS_CHAR_ALPHABETIC;
+ s7_pointer CHAR_DOWNCASE, IS_CHAR_LOWER_CASE, IS_CHAR_NUMERIC, CHAR_UPCASE, IS_CHAR_UPPER_CASE;
+ s7_pointer IS_CHAR_WHITESPACE, CLOSE_INPUT_PORT, CLOSE_OUTPUT_PORT, IS_COMPLEX, CONS, IS_CONSTANT, IS_CONTINUATION, COPY, COS, COSH;
+ s7_pointer CURRENT_INPUT_PORT, CURRENT_OUTPUT_PORT, CURRENT_ERROR_PORT, C_POINTER, IS_C_POINTER, IS_C_OBJECT;
+ s7_pointer IS_DEFINED, DENOMINATOR, DISPLAY, DYNAMIC_WIND, IS_LET, INLET, LET_REF, LET_REF_FALLBACK, LET_SET, LET_SET_FALLBACK;
+ s7_pointer IS_EOF_OBJECT, IS_EQ, IS_EQUAL, IS_EQV, ERROR, EVAL, EVAL_STRING, IS_EVEN, IS_EXACT;
+ s7_pointer EXACT_TO_INEXACT, EXP, EXPT, FILL, INT_VECTOR_REF, INT_VECTOR_SET;
+ s7_pointer MAKE_FLOAT_VECTOR, FLOAT_VECTOR, IS_FLOAT_VECTOR, FLOAT_VECTOR_REF, FLOAT_VECTOR_SET, MAKE_INT_VECTOR, INT_VECTOR, IS_INT_VECTOR;
+ s7_pointer FLOOR, FLUSH_OUTPUT_PORT, FORMAT, FOR_EACH, GC, GCD, GENSYM, IS_GENSYM, GET_OUTPUT_STRING, HASH_TABLE, HASH_TABLE_STAR;
+ s7_pointer IS_HASH_TABLE, HASH_TABLE_REF, HASH_TABLE_SET, HASH_TABLE_ENTRIES, HELP, IMAG_PART, IS_INEXACT, INEXACT_TO_EXACT;
+ s7_pointer IS_INFINITE, IS_INPUT_PORT, IS_INTEGER, INTEGER_TO_CHAR, INTEGER_DECODE_FLOAT, IS_KEYWORD, KEYWORD_TO_SYMBOL;
+ s7_pointer LCM, LENGTH, IS_SEQUENCE, IS_ITERATOR, MAKE_ITERATOR, ITERATE, ITERATOR_SEQUENCE, ITERATOR_IS_AT_END;
+ s7_pointer LIST, IS_LIST, LIST_REF, LIST_SET, LIST_TAIL, LOAD, LOG, LOGAND, LOGBIT, LOGIOR, LOGNOT, LOGXOR;
+ s7_pointer IS_MACRO, MAKE_BYTE_VECTOR, MAKE_HASH_TABLE, MAKE_KEYWORD, MAKE_LIST, RANDOM_STATE;
+ s7_pointer MAKE_STRING, MAKE_SHARED_VECTOR, MAKE_VECTOR, MAP, MAX, MEMBER, MEMQ, MEMV, MIN, MODULO, IS_MORALLY_EQUAL, IS_NAN, IS_NEGATIVE, NEWLINE;
+ s7_pointer NOT, IS_NULL, IS_NUMBER, NUMBER_TO_STRING, NUMERATOR, OBJECT_TO_STRING, IS_ODD, OPENLET, IS_OPENLET, OPEN_INPUT_FILE;
+ s7_pointer OPEN_INPUT_STRING, OPEN_OUTPUT_FILE, OUTLET, IS_OUTPUT_PORT, OWLET, IS_PAIR, PAIR_LINE_NUMBER, PEEK_CHAR;
+ s7_pointer IS_PORT_CLOSED, PORT_FILENAME, PORT_LINE_NUMBER, IS_PROPER_LIST;
+ s7_pointer IS_POSITIVE, IS_PROCEDURE, PROCEDURE_DOCUMENTATION, PROCEDURE_SIGNATURE, FUNCLET, PROCEDURE_SOURCE;
+ s7_pointer IS_DILAMBDA, PROVIDE, ROOTLET;
+ s7_pointer IS_PROVIDED, QUOTIENT, RANDOM, IS_RANDOM_STATE, RANDOM_STATE_TO_LIST, RATIONALIZE, IS_RATIONAL, READ, READ_BYTE, READ_CHAR, READ_LINE, IS_REAL;
+ s7_pointer READ_STRING, REAL_PART, REMAINDER, REQUIRE, REVERSE, REVERSEB, ROUND, SET_CAR, SET_CDR, SIN, SINH, SORT, SQRT, STACKTRACE;
+ s7_pointer STRING, STRING_DOWNCASE, STRING_UPCASE, STRING_LEQ, STRING_LT, STRING_EQ;
+ s7_pointer STRING_GEQ, STRING_GT, IS_STRING, STRING_POSITION, STRING_TO_NUMBER, STRING_TO_SYMBOL, STRING_APPEND;
+ s7_pointer STRING_FILL, STRING_REF, STRING_SET, SUBSTRING, SYMBOL;
+ s7_pointer SYMBOL_ACCESS, IS_SYMBOL, SYMBOL_TO_KEYWORD, SYMBOL_TO_STRING, SYMBOL_TO_DYNAMIC_VALUE, SYMBOL_TO_VALUE;
+ s7_pointer TAN, TANH, THROW, TO_BYTE_VECTOR, TRUNCATE, VALUES, VECTOR, VECTOR_APPEND, VECTOR_FILL;
+ s7_pointer IS_VECTOR, VECTOR_DIMENSIONS, VECTOR_REF, VECTOR_SET, WITH_INPUT_FROM_FILE;
+ s7_pointer WITH_INPUT_FROM_STRING, WITH_OUTPUT_TO_FILE, WITH_OUTPUT_TO_STRING, WRITE, WRITE_BYTE, WRITE_CHAR, WRITE_STRING, IS_ZERO;
+ s7_pointer S7_FEATURES, LOAD_PATH, PI, MAGNITUDE, COMPLEX;
+#if (!WITH_PURE_S7)
+ s7_pointer IS_CHAR_READY, CHAR_CI_LEQ, CHAR_CI_LT, CHAR_CI_EQ, CHAR_CI_GEQ, CHAR_CI_GT, LET_TO_LIST, INTEGER_LENGTH;
+ s7_pointer STRING_CI_LEQ, STRING_CI_LT, STRING_CI_EQ, STRING_CI_GEQ, STRING_CI_GT, STRING_TO_LIST, VECTOR_TO_LIST;
+ s7_pointer STRING_LENGTH, STRING_COPY, LIST_TO_STRING, LIST_TO_VECTOR, VECTOR_LENGTH, MAKE_POLAR, MAKE_RECTANGULAR;
+#endif
+
+#if WITH_GMP
+ s7_pointer BIGNUM, IS_BIGNUM;
+#endif
+#if WITH_SYSTEM_EXTRAS
+ s7_pointer IS_DIRECTORY, FILE_EXISTS, DELETE_FILE, GETENV, SYSTEM, DIRECTORY_TO_LIST, FILE_MTIME;
+#endif
+
+ /* these are the associated functions, not symbols */
+ s7_pointer Vector_Set, String_Set, List_Set, Hash_Table_Set, Let_Set; /* Cons (see the setter stuff at the end) */
+
+ s7_pointer LAMBDA, LAMBDA_STAR, LET, QUOTE, UNQUOTE, MACROEXPAND, DEFINE_EXPANSION, BAFFLE, WITH_LET, DOCUMENTATION, SIGNATURE;
+ s7_pointer IF, WHEN, UNLESS, BEGIN, COND, CASE, AND, OR, DO, DEFINE, DEFINE_STAR, DEFINE_CONSTANT, WITH_BAFFLE;
+ s7_pointer DEFINE_MACRO, DEFINE_MACRO_STAR, DEFINE_BACRO, DEFINE_BACRO_STAR;
+ s7_pointer LETREC, LETREC_STAR, LET_STAR;
+ s7_pointer SET, QQ_List, QQ_Apply_Values, QQ_Append, Multivector;
+ s7_pointer Apply, Vector;
+ s7_pointer WRONG_TYPE_ARG, wrong_type_arg_info, OUT_OF_RANGE, out_of_range_info;
+ s7_pointer simple_wrong_type_arg_info, simple_out_of_range_info, DIVISION_BY_ZERO, DIVISION_BY_ZERO_ERROR, NO_CATCH, IO_ERROR, INVALID_ESCAPE_FUNCTION;
+ s7_pointer FORMAT_ERROR, WRONG_NUMBER_OF_ARGS, READ_ERROR, STRING_READ_ERROR, SYNTAX_ERROR, TOO_MANY_ARGUMENTS, NOT_ENOUGH_ARGUMENTS;
+ s7_pointer KEY_REST, KEY_ALLOW_OTHER_KEYS, KEY_READABLE, BAFFLED;
+ s7_pointer __FUNC__;
+ s7_pointer Object_Set; /* applicable object set method */
+ s7_pointer FEED_TO; /* => */
+ s7_pointer BODY, CLASS_NAME, IS_FLOAT, IS_INTEGER_OR_REAL_AT_END, IS_INTEGER_OR_ANY_AT_END;
+ s7_pointer QUOTE_UNCHECKED, BEGIN_UNCHECKED, CASE_UNCHECKED, SET_UNCHECKED, LAMBDA_UNCHECKED, LET_UNCHECKED, WITH_LET_UNCHECKED, WITH_LET_S;
+ s7_pointer LET_STAR_UNCHECKED, LETREC_UNCHECKED, LETREC_STAR_UNCHECKED, COND_UNCHECKED, COND_SIMPLE, WITH_BAFFLE_UNCHECKED;
+ s7_pointer SET_SYMBOL_C, SET_SYMBOL_S, SET_SYMBOL_Q, SET_SYMBOL_P, SET_SYMBOL_Z, SET_SYMBOL_A;
+ s7_pointer SET_SYMBOL_opSq, SET_SYMBOL_opSSq, SET_SYMBOL_opSSSq, SET_SYMBOL_opCq;
+ s7_pointer SET_NORMAL, SET_PAIR, SET_PAIR_Z, SET_PAIR_A, SET_PAIR_ZA, SET_PAIR_P, SET_PWS, SET_LET_S, SET_LET_ALL_X, SET_PAIR_C, SET_PAIR_C_P;
+ s7_pointer LAMBDA_STAR_UNCHECKED, DO_UNCHECKED, DEFINE_UNCHECKED, DEFINE_FUNCHECKED, DEFINE_STAR_UNCHECKED, DEFINE_CONSTANT_UNCHECKED;
+ s7_pointer CASE_SIMPLE, CASE_SIMPLER, CASE_SIMPLER_1, CASE_SIMPLER_SS, CASE_SIMPLEST, CASE_SIMPLEST_SS;
+ s7_pointer LET_C, LET_S, LET_ALL_C, LET_ALL_S, LET_ALL_X;
+ s7_pointer LET_STAR_ALL_X, LET_opCq, LET_opSSq;
+ s7_pointer LET_NO_VARS, NAMED_LET, NAMED_LET_NO_VARS, NAMED_LET_STAR, LET_STAR2, IF_UNCHECKED, AND_UNCHECKED, AND_P, AND_P2, OR_UNCHECKED, OR_P, OR_P2;
+ s7_pointer IF_P_P_P, IF_P_P, IF_S_P_P, IF_S_P, IF_P_FEED;
+ s7_pointer IF_Z_P, IF_Z_P_P, IF_A_P, IF_A_P_P, IF_ANDP_P, IF_ANDP_P_P, IF_ORP_P, IF_ORP_P_P, IF_CC_P_P;
+ s7_pointer IF_CS_P_P, IF_CC_P, IF_CS_P, IF_AND2_P, IF_AND2_P_P;
+ s7_pointer IF_CSQ_P, IF_CSQ_P_P, IF_CSS_P, IF_CSS_P_P, IF_CSC_P, IF_CSC_P_P;
+ s7_pointer IF_IS_PAIR_P, IF_IS_PAIR_P_P, IF_opSSq_P, IF_opSSq_P_P, IF_S_opCq_P, IF_S_opCq_P_P;
+ s7_pointer IF_IS_SYMBOL_P, IF_IS_SYMBOL_P_P, IF_NOT_S_P, IF_NOT_S_P_P;
+ s7_pointer WHEN_UNCHECKED, UNLESS_UNCHECKED, WHEN_S, UNLESS_S;
+ s7_pointer COND_ALL_X, COND_ALL_X_2, COND_S;
+ s7_pointer INCREMENT_1, DECREMENT_1, SET_CONS, INCREMENT_SS, INCREMENT_SSS, INCREMENT_SZ, INCREMENT_SA, INCREMENT_SAA;
+ s7_pointer LET_opSq, LET_ALL_opSq, LET_opSq_P, LET_ONE, LET_Z;
+ s7_pointer SIMPLE_DO, SAFE_DOTIMES, SAFE_DO, SIMPLE_DO_P, DOTIMES_P, SIMPLE_DO_A, SIMPLE_DO_E;
+ s7_pointer DOX, dox_slot_symbol, else_symbol;
+
+ s7_pointer *safe_lists, *syn_docs; /* prebuilt evaluator arg lists, syntax doc strings */
+
+ s7_pointer autoload_table, libraries;
+ const char ***autoload_names;
+ int *autoload_names_sizes;
+ bool **autoloaded_already;
+ int autoload_names_loc, autoload_names_top;
+ port_t *port_heap;
+
+ int format_depth;
+ int slash_str_size;
+ char *slash_str;
+
+ xf_t *cur_rf;
+ xf_t *rf_free_list, *rf_stack;
+
+ /* s7 env symbols */
+ s7_pointer stack_top_symbol, symbol_table_is_locked_symbol, heap_size_symbol, gc_freed_symbol, gc_protected_objects_symbol;
+ s7_pointer free_heap_size_symbol, file_names_symbol, symbol_table_symbol, cpu_time_symbol, c_objects_symbol, float_format_precision_symbol;
+ s7_pointer stack_size_symbol, rootlet_size_symbol, c_types_symbol, safety_symbol, max_stack_size_symbol, gc_stats_symbol;
+ s7_pointer strings_symbol, vectors_symbol, input_ports_symbol, output_ports_symbol, continuations_symbol, hash_tables_symbol, gensyms_symbol;
+ s7_pointer catches_symbol, exits_symbol, stack_symbol, default_rationalize_error_symbol, max_string_length_symbol, default_random_state_symbol;
+ s7_pointer max_list_length_symbol, max_vector_length_symbol, max_vector_dimensions_symbol, default_hash_table_length_symbol;
+ s7_pointer hash_table_float_epsilon_symbol, morally_equal_float_epsilon_symbol, initial_string_port_length_symbol, memory_usage_symbol;
+ s7_pointer undefined_identifier_warnings_symbol, print_length_symbol, bignum_precision_symbol, stacktrace_defaults_symbol;
+ bool undefined_identifier_warnings;
};
+typedef enum {USE_DISPLAY, USE_WRITE, USE_READABLE_WRITE, USE_WRITE_WRONG} use_write_t;
-#define T_UNTYPED 0
-#define T_NIL 1
-#define T_STRING 2
-#define T_NUMBER 3
-#define T_SYMBOL 4
-#define T_PAIR 5
-#define T_CLOSURE 6
-#define T_CLOSURE_STAR 7
-#define T_CONTINUATION 8
-#define T_CHARACTER 9
-#define T_INPUT_PORT 10
-#define T_VECTOR 11
-#define T_MACRO 12
-#define T_BACRO 13
-#define T_C_OBJECT 14
-#define T_S_OBJECT 15
-#define T_GOTO 16
-#define T_OUTPUT_PORT 17
-#define T_CATCH 18
-#define T_DYNAMIC_WIND 19
-#define T_HASH_TABLE 20
-#define T_BOOLEAN 21
-#define T_HOOK 22
-#define T_C_MACRO 23
-#define T_C_POINTER 24
-#define T_C_FUNCTION 25
-#define T_C_ANY_ARGS_FUNCTION 26
-#define T_C_OPT_ARGS_FUNCTION 27
-#define T_C_RST_ARGS_FUNCTION 28
-#define T_C_LST_ARGS_FUNCTION 29
-#define BUILT_IN_TYPES 30
+#define NUM_SAFE_LISTS 16
+#define INITIAL_AUTOLOAD_NAMES_SIZE 4
-#define TYPE_BITS 8
-#define T_MASKTYPE 0xff
-#define typeflag(p) ((p)->flag)
-#define type(p) (typeflag(p) & T_MASKTYPE)
-/* set_type below -- needs to maintain mark setting */
+static s7_pointer prepackaged_type_names[NUM_TYPES];
+
+static bool t_number_p[NUM_TYPES], t_real_p[NUM_TYPES], t_rational_p[NUM_TYPES];
+static bool t_simple_p[NUM_TYPES];
+static bool t_big_number_p[NUM_TYPES];
+static bool t_structure_p[NUM_TYPES];
+static bool t_any_macro_p[NUM_TYPES];
+static bool t_any_closure_p[NUM_TYPES];
+static bool t_has_closure_let[NUM_TYPES];
+static bool t_sequence_p[NUM_TYPES];
+static bool t_vector_p[NUM_TYPES];
+static bool t_applicable_p[NUM_TYPES];
+
+static void init_types(void)
+{
+ int i;
+ for (i = 0; i < NUM_TYPES; i++)
+ {
+ t_number_p[i] = false;
+ t_real_p[i] = false;
+ t_rational_p[i] = false;
+ t_simple_p[i] = false;
+ t_structure_p[i] = false;
+ t_any_macro_p[i] = false;
+ t_any_closure_p[i] = false;
+ t_has_closure_let[i] = false;
+ t_sequence_p[i] = false;
+ t_vector_p[i] = false;
+ t_applicable_p[i] = false;
+ }
+ t_number_p[T_INTEGER] = true;
+ t_number_p[T_RATIO] = true;
+ t_number_p[T_REAL] = true;
+ t_number_p[T_COMPLEX] = true;
+
+ t_rational_p[T_INTEGER] = true;
+ t_rational_p[T_RATIO] = true;
+
+ t_real_p[T_INTEGER] = true;
+ t_real_p[T_RATIO] = true;
+ t_real_p[T_REAL] = true;
+
+ t_big_number_p[T_BIG_INTEGER] = true;
+ t_big_number_p[T_BIG_RATIO] = true;
+ t_big_number_p[T_BIG_REAL] = true;
+ t_big_number_p[T_BIG_COMPLEX] = true;
+
+ t_structure_p[T_PAIR] = true;
+ t_structure_p[T_VECTOR] = true;
+ t_structure_p[T_HASH_TABLE] = true;
+ t_structure_p[T_SLOT] = true;
+ t_structure_p[T_LET] = true;
+ t_structure_p[T_ITERATOR] = true;
+
+ t_sequence_p[T_NIL] = true;
+ t_sequence_p[T_PAIR] = true;
+ t_sequence_p[T_STRING] = true;
+ t_sequence_p[T_VECTOR] = true;
+ t_sequence_p[T_INT_VECTOR] = true;
+ t_sequence_p[T_FLOAT_VECTOR] = true;
+ t_sequence_p[T_HASH_TABLE] = true;
+ t_sequence_p[T_LET] = true;
+ t_sequence_p[T_C_OBJECT] = true;
+
+ t_vector_p[T_VECTOR] = true;
+ t_vector_p[T_INT_VECTOR] = true;
+ t_vector_p[T_FLOAT_VECTOR] = true;
+
+ t_applicable_p[T_PAIR] = true;
+ t_applicable_p[T_STRING] = true;
+ t_applicable_p[T_VECTOR] = true;
+ t_applicable_p[T_INT_VECTOR] = true;
+ t_applicable_p[T_FLOAT_VECTOR] = true;
+ t_applicable_p[T_HASH_TABLE] = true;
+ t_applicable_p[T_ITERATOR] = true;
+ t_applicable_p[T_LET] = true;
+ t_applicable_p[T_C_OBJECT] = true;
+ t_applicable_p[T_C_MACRO] = true;
+ t_applicable_p[T_MACRO] = true;
+ t_applicable_p[T_BACRO] = true;
+ t_applicable_p[T_MACRO_STAR] = true;
+ t_applicable_p[T_BACRO_STAR] = true;
+ t_applicable_p[T_SYNTAX] = true;
+ t_applicable_p[T_C_FUNCTION] = true;
+ t_applicable_p[T_C_FUNCTION_STAR] = true;
+ t_applicable_p[T_C_ANY_ARGS_FUNCTION] = true;
+ t_applicable_p[T_C_OPT_ARGS_FUNCTION] = true;
+ t_applicable_p[T_C_RST_ARGS_FUNCTION] = true;
+ t_applicable_p[T_CLOSURE] = true;
+ t_applicable_p[T_CLOSURE_STAR] = true;
+ t_applicable_p[T_GOTO] = true;
+ t_applicable_p[T_CONTINUATION] = true;
+
+ t_any_macro_p[T_C_MACRO] = true;
+ t_any_macro_p[T_MACRO] = true;
+ t_any_macro_p[T_BACRO] = true;
+ t_any_macro_p[T_MACRO_STAR] = true;
+ t_any_macro_p[T_BACRO_STAR] = true;
+
+ t_any_closure_p[T_CLOSURE] = true;
+ t_any_closure_p[T_CLOSURE_STAR] = true;
+
+ t_has_closure_let[T_MACRO] = true;
+ t_has_closure_let[T_BACRO] = true;
+ t_has_closure_let[T_MACRO_STAR] = true;
+ t_has_closure_let[T_BACRO_STAR] = true;
+ t_has_closure_let[T_CLOSURE] = true;
+ t_has_closure_let[T_CLOSURE_STAR] = true;
+
+ t_simple_p[T_NIL] = true;
+ t_simple_p[T_UNIQUE] = true;
+ t_simple_p[T_BOOLEAN] = true;
+ t_simple_p[T_CHARACTER] = true;
+ t_simple_p[T_SYMBOL] = true;
+ t_simple_p[T_SYNTAX] = true;
+ t_simple_p[T_C_MACRO] = true;
+ t_simple_p[T_C_FUNCTION] = true;
+ t_simple_p[T_C_FUNCTION_STAR] = true;
+ t_simple_p[T_C_ANY_ARGS_FUNCTION] = true;
+ t_simple_p[T_C_OPT_ARGS_FUNCTION] = true;
+ t_simple_p[T_C_RST_ARGS_FUNCTION] = true;
+ /* not completely sure about the next ones */
+ t_simple_p[T_LET] = true;
+ t_simple_p[T_INPUT_PORT] = true;
+ t_simple_p[T_OUTPUT_PORT] = true;
+}
+
+
+#define typeflag(p) ((p)->tf.flag)
+#define typesflag(p) ((p)->tf.sflag)
+
+static s7_scheme *hidden_sc = NULL;
+
#if DEBUGGING
-#define saved_typeflag(p) ((p)->saved_flag)
-#define saved_type(p) (saved_typeflag(p) & T_MASKTYPE)
-#endif
+ static bool check_types = true;
+ static const char *check_name(int typ);
+ static s7_pointer check_seti(s7_scheme *sc, s7_pointer x, const char *func, int line);
+ static s7_pointer check_ref(s7_pointer p, int expected_type, const char *func, int line, const char *func1, const char *func2);
+ static s7_pointer check_ref2(s7_pointer p, int expected_type, int other_type, const char *func, int line, const char *func1, const char *func2);
+ static s7_pointer check_ref3(s7_pointer p, const char *func, int line);
+ static s7_pointer check_ref4(s7_pointer p, const char *func, int line);
+ static s7_pointer check_ref5(s7_pointer p, const char *func, int line);
+ static s7_pointer check_ref6(s7_pointer p, const char *func, int line);
+ static s7_pointer check_ref7(s7_pointer p, const char *func, int line);
+ static s7_pointer check_ref8(s7_pointer p, const char *func, int line);
+ static s7_pointer check_ref9(s7_pointer p, const char *func, int line);
+ static s7_pointer check_nref(s7_pointer p, const char *func, int line);
+ static void print_gc_info(s7_pointer obj, int line);
+
+ static s7_pointer opt1_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line);
+ static s7_pointer set_opt1_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line);
+ static s7_pointer opt2_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line);
+ static void set_opt2_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line);
+ static s7_pointer opt3_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line);
+ static void set_opt3_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line);
+
+ static unsigned long long int s_hash_1(s7_scheme *sc, s7_pointer p, const char *func, int line);
+ static void set_s_hash_1(s7_scheme *sc, s7_pointer p, unsigned long long int x, const char *func, int line);
+ static const char *s_name_1(s7_scheme *sc, s7_pointer p, const char *func, int line);
+ static void set_s_name_1(s7_scheme *sc, s7_pointer p, const char *str, const char *func, int line);
+ static unsigned int s_line_1(s7_scheme *sc, s7_pointer p, const char *func, int line);
+ static void set_s_line_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line);
+ static unsigned int s_len_1(s7_scheme *sc, s7_pointer p, const char *func, int line);
+ static void set_s_len_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line);
+ static unsigned int s_op_1(s7_scheme *sc, s7_pointer p, const char *func, int line);
+ static void set_s_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line);
+ static unsigned int s_syn_op_1(s7_scheme *sc, s7_pointer p, const char *func, int line);
+ static void set_s_syn_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line);
+
+ #define unchecked_type(p) ((p)->tf.type_field)
+ #define type(p) ({unsigned char _t_; _t_ = (p)->tf.type_field; if (((check_types) && (_t_ == T_FREE)) || (_t_ >= NUM_TYPES)) print_gc_info(p, __LINE__); _t_;})
+
+ #define set_type(p, f) \
+ do { \
+ p->previous_alloc_line = p->current_alloc_line; \
+ p->previous_alloc_func = p->current_alloc_func; \
+ p->previous_alloc_type = p->current_alloc_type; \
+ p->current_alloc_line = __LINE__; \
+ p->current_alloc_func = __func__; \
+ p->current_alloc_type = f; \
+ p->uses++; p->clear_line = 0; \
+ if ((((f) & 0xff) == T_FREE) || (((f) & 0xff) >= NUM_TYPES)) \
+ fprintf(stderr, "%d: set free %p type to %x\n", __LINE__, p, f); \
+ else \
+ { \
+ if (((typeflag(p) & T_IMMUTABLE) != 0) && ((typeflag(p) != (f)))) \
+ fprintf(stderr, "%d: set immutable %p type %x to %x\n", __LINE__, p, unchecked_type(p), f); \
+ } \
+ typeflag(p) = f; \
+ } while (0)
-#define T_SYNTAX (1 << (TYPE_BITS + 1))
-#define is_syntax(p) ((typeflag(p) & T_SYNTAX) != 0) /* the != 0 business is for MS C++'s benefit */
-#define syntax_opcode(x) ((x)->hloc)
+ #define clear_type(p) do {p->clear_line = __LINE__; typeflag(p) = T_FREE;} while (0)
+
+ /* these check most s7cell field references (and many type bits) for consistency */
+ #define _TI(P) check_ref(P, T_INTEGER, __func__, __LINE__, NULL, NULL)
+ #define _TR(P) check_ref(P, T_REAL, __func__, __LINE__, NULL, NULL)
+ #define _TF(P) check_ref2(P, T_RATIO, T_INTEGER, __func__, __LINE__, NULL, NULL)
+ #define _TZ(P) check_ref(P, T_COMPLEX, __func__, __LINE__, NULL, NULL)
+ #define _TBgi(P) check_ref(P, T_BIG_INTEGER, __func__, __LINE__, "sweep", NULL)
+ #define _TBgr(P) check_ref(P, T_BIG_REAL, __func__, __LINE__, "sweep", NULL)
+ #define _TBgf(P) check_ref(P, T_BIG_RATIO, __func__, __LINE__, "sweep", NULL)
+ #define _TBgz(P) check_ref(P, T_BIG_COMPLEX, __func__, __LINE__, "sweep", NULL)
+
+ #define _TChr(P) check_ref(P, T_CHARACTER, __func__, __LINE__, NULL, NULL)
+ #define _TCtr(P) check_ref(P, T_COUNTER, __func__, __LINE__, NULL, NULL)
+ #define _TPtr(P) check_ref(P, T_C_POINTER, __func__, __LINE__, NULL, NULL)
+ #define _TBfl(P) check_ref(P, T_BAFFLE, __func__, __LINE__, NULL, NULL)
+ #define _TGot(P) check_ref(P, T_GOTO, __func__, __LINE__, NULL, NULL)
+ #define _TStk(P) check_ref(P, T_STACK, __func__, __LINE__, NULL, NULL)
+ #define _TLst(P) check_ref(P, T_PAIR, __func__, __LINE__, NULL, NULL)
+ #define _TCat(P) check_ref(P, T_CATCH, __func__, __LINE__, NULL, NULL)
+ #define _TDyn(P) check_ref(P, T_DYNAMIC_WIND, __func__, __LINE__, NULL, NULL)
+ #define _TSlt(P) check_ref(P, T_SLOT, __func__, __LINE__, NULL, NULL)
+ #define _TSlp(P) check_ref2(P, T_SLOT, T_PAIR, __func__, __LINE__, NULL, NULL)
+ #define _TSyn(P) check_ref(P, T_SYNTAX, __func__, __LINE__, NULL, NULL)
+ #define _TMac(P) check_ref(P, T_C_MACRO, __func__, __LINE__, NULL, NULL)
+ #define _TLet(P) check_ref(P, T_LET, __func__, __LINE__, NULL, NULL)
+ #define _TLid(P) check_ref2(P, T_LET, T_NIL, __func__, __LINE__, NULL, NULL)
+ #define _TRan(P) check_ref(P, T_RANDOM_STATE, __func__, __LINE__, NULL, NULL)
+ #define _TCdr(P) check_ref2(P, T_PAIR, T_NIL, __func__, __LINE__, "gc", NULL)
+ #define _TStr(P) check_ref(P, T_STRING, __func__, __LINE__, "sweep", NULL)
+ #define _TObj(P) check_ref(P, T_C_OBJECT, __func__, __LINE__, "free_object", NULL)
+ #define _THsh(P) check_ref(P, T_HASH_TABLE, __func__, __LINE__, "sweep", "free_hash_table")
+ #define _TItr(P) check_ref(P, T_ITERATOR, __func__, __LINE__, "sweep", NULL)
+ #define _TCon(P) check_ref(P, T_CONTINUATION, __func__, __LINE__, "sweep", NULL)
+ #define _TFvc(P) check_ref(P, T_FLOAT_VECTOR, __func__, __LINE__, "sweep", NULL)
+ #define _TIvc(P) check_ref(P, T_INT_VECTOR, __func__, __LINE__, "sweep", NULL)
+ #define _TSym(P) check_ref(P, T_SYMBOL, __func__, __LINE__, "sweep", "remove_gensym_from_symbol_table")
+
+ #define _TPrt(P) check_ref3(P, __func__, __LINE__) /* input|output_port, or free */
+ #define _TVec(P) check_ref4(P, __func__, __LINE__) /* any vector or free */
+ #define _TClo(P) check_ref5(P, __func__, __LINE__) /* has closure let */
+ #define _TFnc(P) check_ref6(P, __func__, __LINE__) /* any c_function|c_macro */
+ #define _TNum(P) check_ref7(P, __func__, __LINE__) /* any number (not bignums I think) */
+ #define _TSeq(P) check_ref8(P, __func__, __LINE__) /* any sequence or structure */
+ #define _TMet(P) check_ref9(P, __func__, __LINE__) /* anything that might contain a method */
+ #define _NFre(P) check_nref(P, __func__, __LINE__) /* not free */
+ #define _TSet(P) check_seti(sc, P, __func__, __LINE__) /* set of immutable value */
-#define T_IMMUTABLE (1 << (TYPE_BITS + 2))
-#define is_immutable(p) ((typeflag(p) & T_IMMUTABLE) != 0)
-#define set_immutable(p) typeflag(p) |= (T_IMMUTABLE | T_DONT_COPY)
-/* immutable means the value can't be changed via set! or bind -- this is separate from the symbol access stuff
- */
+#else
+ #define unchecked_type(p) ((p)->tf.type_field)
+ #define type(p) ((p)->tf.type_field)
+ #define set_type(p, f) typeflag(p) = f
+ #define clear_type(p) typeflag(p) = T_FREE
+ #define _TSet(P) P
+ #define _TI(P) P
+ #define _TR(P) P
+ #define _TF(P) P
+ #define _TZ(P) P
+ #define _TBgi(P) P
+ #define _TBgr(P) P
+ #define _TBgf(P) P
+ #define _TBgz(P) P
+ #define _TStr(P) P
+ #define _TSyn(P) P
+ #define _TChr(P) P
+ #define _TObj(P) P
+ #define _TCtr(P) P
+ #define _THsh(P) P
+ #define _TItr(P) P
+ #define _TPtr(P) P
+ #define _TBfl(P) P
+ #define _TGot(P) P
+ #define _TCon(P) P
+ #define _TStk(P) P
+ #define _TPrt(P) P
+ #define _TIvc(P) P
+ #define _TFvc(P) P
+ #define _TVec(P) P
+ #define _TLst(P) P
+ #define _TRan(P) P
+ #define _TDyn(P) P
+ #define _TCat(P) P
+ #define _TClo(P) P
+ #define _TFnc(P) P
+ #define _TSlt(P) P
+ #define _TSlp(P) P
+ #define _TSym(P) P
+ #define _TLet(P) P
+ #define _TLid(P) P
+ #define _TCdr(P) P
+ #define _TNum(P) P
+ #define _TSeq(P) P
+ #define _TMet(P) P
+ #define _TMac(P) P
+ #define _NFre(P) P
+#endif
-#define T_GC_MARK (1 << (TYPE_BITS + 4))
-#define is_marked(p) ((typeflag(p) & T_GC_MARK) != 0)
-#define set_mark(p) typeflag(p) |= T_GC_MARK
-#define clear_mark(p) typeflag(p) &= (~T_GC_MARK)
-/* making this a separate bool field in the cell struct slightly speeds up the mark function,
- * but at the cost of 4 (or 8!) bytes per object. Since the speedup was about .5% overall,
- * the size increase is more important.
+#define is_number(P) t_number_p[type(P)]
+#define is_integer(P) (type(P) == T_INTEGER)
+#define is_real(P) t_real_p[type(P)]
+#define is_rational(P) t_rational_p[type(P)]
+#define is_big_number(p) t_big_number_p[type(p)]
+#define is_t_integer(p) (type(p) == T_INTEGER)
+#define is_t_ratio(p) (type(p) == T_RATIO)
+#define is_t_real(p) (type(p) == T_REAL)
+#define is_t_complex(p) (type(p) == T_COMPLEX)
+#define is_t_big_integer(p) (type(p) == T_BIG_INTEGER)
+#define is_t_big_ratio(p) (type(p) == T_BIG_RATIO)
+#define is_t_big_real(p) (type(p) == T_BIG_REAL)
+#define is_t_big_complex(p) (type(p) == T_BIG_COMPLEX)
+
+#define is_free(p) (type(p) == T_FREE)
+#define is_free_and_clear(p) (typeflag(p) == T_FREE)
+#define is_simple(P) t_simple_p[type(P)]
+#define has_structure(P) t_structure_p[type(P)]
+
+#define is_any_macro(P) t_any_macro_p[type(P)]
+#define is_any_closure(P) t_any_closure_p[type(P)]
+#define is_procedure_or_macro(P) ((t_any_macro_p[type(P)]) || ((typeflag(P) & T_PROCEDURE) != 0))
+#define has_closure_let(P) t_has_closure_let[type(P)]
+
+#define is_simple_sequence(P) (t_sequence_p[type(P)])
+#define is_sequence(P) ((t_sequence_p[type(P)]) || (has_methods(P)))
+#define is_applicable(P) (t_applicable_p[type(P)])
+/* this misses #() which actually is not applicable to anything, probably "" also, and inapplicable c-objects like random-state */
+
+
+/* the layout of these bits does matter in several cases -- in particular, don't use the second byte for anything
+ * that might shadow SYNTACTIC_PAIR and OPTIMIZED_PAIR.
*/
+#define TYPE_BITS 8
-#define T_FINALIZABLE (1 << (TYPE_BITS + 7))
-#define is_finalizable(p) ((typeflag(p) & T_FINALIZABLE) != 0)
-/* finalizable means some action may need to be taken when the cell is GC'd */
-
-#define T_SIMPLE (1 << (TYPE_BITS + 8))
-#define is_simple(p) ((typeflag(p) & T_SIMPLE) != 0)
-/* a simple object has no markable subfields and no special mark actions */
-
-#define T_DONT_COPY (1 << (TYPE_BITS + 9))
-#define dont_copy(p) ((typeflag(p) & T_DONT_COPY) != 0)
-/* dont_copy means the object is not copied when saved in a continuation */
-
-#define T_PROCEDURE (1 << (TYPE_BITS + 10))
-#define is_procedure(p) ((typeflag(p) & T_PROCEDURE) != 0)
-/* closure, macro, c_function, procedure-with-setter, settable object, goto or continuation */
-
-#define T_ANY_MACRO (1 << (TYPE_BITS + 12))
-#define is_any_macro(p) ((typeflag(p) & T_ANY_MACRO) != 0)
-/* this marks scheme and C-defined macros */
-#define is_any_macro_or_syntax(p) ((typeflag(p) & (T_ANY_MACRO | T_SYNTAX)) != 0)
-
-#define T_EXPANSION (1 << (TYPE_BITS + 13))
-#define is_expansion(p) ((typeflag(p) & T_EXPANSION) != 0)
-/* this marks macros from define-expansion */
-
-#define T_LOCAL (1 << (TYPE_BITS + 14))
-#define is_not_local(p) ((typeflag(p) & T_LOCAL) == 0)
-#define is_local(p) ((typeflag(p) & T_LOCAL) != 0)
-#define set_local(p) typeflag(p) |= T_LOCAL
-/* this marks a symbol that has been used at some time as a local variable */
-
-#define T_ENVIRONMENT (1 << (TYPE_BITS + 15))
-#define is_environment(p) ((typeflag(p) & T_ENVIRONMENT) != 0)
-/* this marks a pair that is also an environment */
-
-#define T_DONT_COPY_CDR (1 << (TYPE_BITS + 17))
-#define dont_copy_cdr(p) ((typeflag(p) & T_DONT_COPY_CDR) != 0)
-/* copy_object (continuations) optimization */
-
-#define T_SYMBOL_HAS_ACCESSOR (1 << (TYPE_BITS + 18))
-#define symbol_has_accessor(p) ((typeflag(p) & T_SYMBOL_HAS_ACCESSOR) != 0)
-#define symbol_set_has_accessor(p) typeflag(p) |= T_SYMBOL_HAS_ACCESSOR
-#define symbol_clear_has_accessor(p) typeflag(p) &= ~(T_SYMBOL_HAS_ACCESSOR)
-/* has_accessor means that at least one of the 3 accessor functions is active on this binding.
- * this is a type bit for the pair (symbol . current-value), not for either the symbol or value themselves
+#define T_KEYWORD (1 << (TYPE_BITS + 0))
+#define is_keyword(p) ((typesflag(_NFre(p)) & T_KEYWORD) != 0)
+/* this bit distinguishes a symbol from a symbol that is also a keyword
+ * this should be ok in the second byte because keywords are constants in s7 (never syntax)
*/
-#define T_SYMBOL_ACCESSED (1 << (TYPE_BITS + 5))
-#define symbol_accessed(p) ((typeflag(p) & T_SYMBOL_ACCESSED) != 0)
-#define is_immutable_or_accessed(p) ((typeflag(p) & (T_IMMUTABLE | T_SYMBOL_ACCESSED)) != 0)
-#define symbol_set_accessed(p) typeflag(p) |= T_SYMBOL_ACCESSED
-/* this marks a symbol globally as one that has at some time had its accessors set.
- * since it can be combined with the immutable checks we were already doing, we can
- * implement the symbol-access stuff at almost no additional cost (the csr field used
- * for the list was already available, and the only additional run-time cost is that
- * it needs to be marked during GC -- this adds less .1% total time).
+#define T_SYNTACTIC (1 << (TYPE_BITS + 1))
+#define is_syntactic(p) ((typesflag(_NFre(p)) & T_SYNTACTIC) != 0)
+#define is_syntactic_symbol(p) ((typesflag(_NFre(p)) & (T_SYNTACTIC | 0xff)) == (T_SYMBOL | T_SYNTACTIC))
+#define SYNTACTIC_TYPE (unsigned short)(T_SYMBOL | T_DONT_EVAL_ARGS | T_SYNTACTIC)
+#define SYNTACTIC_PAIR (unsigned short)(T_PAIR | T_SYNTACTIC)
+/* this marks symbols that represent syntax objects, it should be in the second byte */
+
+#define T_PROCEDURE (1 << (TYPE_BITS + 2))
+#define is_procedure(p) ((typesflag(_NFre(p)) & T_PROCEDURE) != 0)
+/* closure, c_function, applicable object, goto or continuation, should be in second byte */
+
+#define T_OPTIMIZED (1 << (TYPE_BITS + 3))
+#define set_optimized(p) typesflag(_TLst(p)) |= T_OPTIMIZED
+#define clear_optimized(p) typesflag(_TLst(p)) &= (~T_OPTIMIZED)
+#define OPTIMIZED_PAIR (unsigned short)(T_PAIR | T_OPTIMIZED)
+#define is_optimized(p) (typesflag(p) == OPTIMIZED_PAIR)
+/* this is faster than the bit extraction above and the same speed as xor */
+/* optimizer flag for an expression that has optimization info, it should be in the second byte
*/
-#define T_STRUCTURE (1 << (TYPE_BITS + 19))
-#define has_structure(p) ((typeflag(p) & T_STRUCTURE) != 0)
-/* for quick recognition of lists, vectors, hash-tables in print.
- * This flag does not buy us much, so if a bit is ever needed, flush this first.
+#define T_SAFE_CLOSURE (1 << (TYPE_BITS + 4))
+#define is_safe_closure(p) ((typesflag(_NFre(p)) & T_SAFE_CLOSURE) != 0)
+#define set_safe_closure(p) typesflag(p) |= T_SAFE_CLOSURE
+#define clear_safe_closure(p) typesflag(p) &= (~T_SAFE_CLOSURE)
+/* optimizer flag for a closure body that is completely simple (every expression is safe)
+ * set_safe_closure happens only in optimize_lambda, clear only in procedure_source, bits only here
+ * this has to be separate from T_SAFE_PROCEDURE, and should be in the second byte.
+ * It can be set on either the body (a pair) or the closure itself.
*/
-#define T_MULTIPLE_VALUE (1 << (TYPE_BITS + 20))
-#define is_multiple_value(p) ((typeflag(p) & T_MULTIPLE_VALUE) != 0)
-#define set_multiple_value(p) typeflag(p) |= T_MULTIPLE_VALUE
+#define T_DONT_EVAL_ARGS (1 << (TYPE_BITS + 5))
+#define dont_eval_args(p) ((typesflag(_NFre(p)) & T_DONT_EVAL_ARGS) != 0)
+/* this marks things that don't evaluate their arguments */
+
+#define T_EXPANSION (1 << (TYPE_BITS + 6))
+#define is_expansion(p) ((typesflag(_NFre(p)) & T_EXPANSION) != 0)
+#define clear_expansion(p) typesflag(_TSym(p)) &= (~T_EXPANSION)
+/* this marks the symbol associated with a run-time macro and distinguishes the value from an ordinary macro */
+
+#define T_MULTIPLE_VALUE (1 << (TYPE_BITS + 7))
+#define is_multiple_value(p) ((typesflag(_NFre(p)) & T_MULTIPLE_VALUE) != 0)
+#define set_multiple_value(p) typesflag(_TLst(p)) |= T_MULTIPLE_VALUE
+#define clear_multiple_value(p) typesflag(_TLst(p)) &= (~T_MULTIPLE_VALUE)
#define multiple_value(p) p
/* this bit marks a list (from "values") that is waiting for a
* chance to be spliced into its caller's argument list. It is normally
* on only for a very short time.
*/
-#define T_PENDING_REMOVAL (1 << (TYPE_BITS + 21))
-#define is_pending_removal(p) ((typeflag(p) & T_PENDING_REMOVAL) != 0)
-#define set_pending_removal(p) typeflag(p) |= T_PENDING_REMOVAL
-#define clear_pending_removal(p) typeflag(p) &= ~(T_PENDING_REMOVAL)
-/* this bit is for circle checks during removal of a global function from the heap
+#define T_MATCHED T_MULTIPLE_VALUE
+#define is_matched_pair(p) ((typesflag(_TLst(p)) & T_MATCHED) != 0)
+#define set_match_pair(p) typesflag(_TLst(p)) |= T_MATCHED
+#define clear_match_pair(p) typesflag(_TLst(p)) &= (~T_MATCHED)
+#define is_matched_symbol(p) ((typesflag(_TSym(p)) & T_MATCHED) != 0)
+#define set_match_symbol(p) typesflag(_TSym(p)) |= T_MATCHED
+#define clear_match_symbol(p) typesflag(_TSym(p)) &= (~T_MATCHED)
+
+#define T_GLOBAL (1 << (TYPE_BITS + 8))
+#define is_global(p) ((typeflag(_TSym(p)) & T_GLOBAL) != 0)
+#define set_global(p) typeflag(_TSym(p)) |= T_GLOBAL
+#if 0
+ /* to find who is stomping on our symbols: */
+ static char *object_to_truncated_string(s7_scheme *sc, s7_pointer p, int len);
+
+ static void set_local_1(s7_scheme *sc, s7_pointer symbol, const char *func, int line)
+ {
+ if ((is_global(symbol)) || (is_syntactic(symbol)))
+ fprintf(stderr, "%s[%d]: %s%s%s in %s\n", func, line, BOLD_TEXT, DISPLAY(symbol), UNBOLD_TEXT, DISPLAY_80(sc->cur_code));
+ typeflag(symbol) = (typeflag(symbol) & ~(T_DONT_EVAL_ARGS | T_GLOBAL | T_SYNTACTIC));
+ }
+ #define set_local(Symbol) set_local_1(sc, Symbol, __func__, __LINE__)
+#else
+#define set_local(p) typeflag(_TSym(p)) &= ~(T_DONT_EVAL_ARGS | T_GLOBAL | T_SYNTACTIC)
+#endif
+/* this marks something defined (bound) at the top-level, and never defined locally */
+
+#define T_UNSAFE_DO T_GLOBAL
+#define is_unsafe_do(p) ((typeflag(_TLst(p)) & T_UNSAFE_DO) != 0)
+#define set_unsafe_do(p) typeflag(_TLst(p)) |= T_UNSAFE_DO
+#define is_unsafe_sort(p) is_unsafe_do(p)
+#define set_unsafe_sort(p) set_unsafe_do(p)
+/* marks do-loops (and sort functions) that resist optimization */
+
+#define T_COLLECTED (1 << (TYPE_BITS + 9))
+#define is_collected(p) ((typeflag(_TSeq(p)) & T_COLLECTED) != 0)
+#define set_collected(p) typeflag(_TSeq(p)) |= T_COLLECTED
+/* #define clear_collected(p) typeflag(_TSeq(p)) &= (~T_COLLECTED) */
+/* this is a transient flag used by the printer to catch cycles. It affects only objects that have structure.
+ * We can't use a low bit (bit 7 for example), because collect_shared_info inspects the object's type.
*/
-#define T_KEYWORD (1 << (TYPE_BITS + 22))
-#define is_keyword(p) ((typeflag(p) & T_KEYWORD) != 0)
-/* this bit distinguishes a symbol from a symbol that is also a keyword
+#define T_LINE_NUMBER (1 << (TYPE_BITS + 10))
+#define has_line_number(p) ((typeflag(_TLst(p)) & T_LINE_NUMBER) != 0)
+#define set_has_line_number(p) typeflag(_TLst(p)) |= T_LINE_NUMBER
+/* pair in question has line/file info added during read, or the environment has function placement info */
+
+#define T_LOADER_PORT T_LINE_NUMBER
+#define is_loader_port(p) ((typeflag(_TPrt(p)) & T_LOADER_PORT) != 0)
+#define set_loader_port(p) typeflag(_TPrt(p)) |= T_LOADER_PORT
+#define clear_loader_port(p) typeflag(_TPrt(p)) &= (~T_LOADER_PORT)
+/* to block random load-time reads from screwing up the load process, this bit marks a port used by the loader */
+
+#define T_HAS_ACCESSOR T_LINE_NUMBER
+#define symbol_has_accessor(p) ((typeflag(_TSym(p)) & T_HAS_ACCESSOR) != 0)
+#define symbol_set_has_accessor(p) typeflag(_TSym(p)) |= T_HAS_ACCESSOR
+#define slot_has_accessor(p) ((typeflag(_TSlt(p)) & T_HAS_ACCESSOR) != 0)
+#define slot_set_has_accessor(p) typeflag(_TSlt(p)) |= T_HAS_ACCESSOR
+/* marks a slot or symbol that has a setter */
+
+#define T_WITH_LET_LET T_LINE_NUMBER
+#define is_with_let_let(p) ((typeflag(_TLet(p)) & T_WITH_LET_LET) != 0)
+#define set_with_let_let(p) typeflag(_TLet(p)) |= T_WITH_LET_LET
+/* marks a let that is the argument to with-let */
+
+#define T_SIMPLE_DEFAULTS T_LINE_NUMBER
+#define has_simple_defaults(p) ((typeflag(_TFnc(p)) & T_SIMPLE_DEFAULTS) != 0)
+#define set_simple_defaults(p) typeflag(_TFnc(p)) |= T_SIMPLE_DEFAULTS
+#define clear_simple_defaults(p) typeflag(_TFnc(p)) &= (~T_SIMPLE_DEFAULTS)
+/* flag c_func_star arg defaults that need GC protection */
+
+#define T_SHARED (1 << (TYPE_BITS + 11))
+#define is_shared(p) ((typeflag(_TSeq(p)) & T_SHARED) != 0)
+#define set_shared(p) typeflag(_TSeq(p)) |= T_SHARED
+/* #define clear_shared(p) typeflag(_TSeq(p)) &= (~T_SHARED) */
+#define clear_collected_and_shared(p) typeflag(p) &= (~(T_COLLECTED | T_SHARED)) /* this can clear free cells = calloc */
+
+#define T_OVERLAY (1 << (TYPE_BITS + 12))
+#define set_overlay(p) typeflag(_TLst(p)) |= T_OVERLAY
+#define is_overlaid(p) ((typeflag(_TLst(p)) & T_OVERLAY) != 0)
+/* optimizer flag that marks a cell whose opt_back [ie opt1] points to the previous cell in a list */
+
+#define T_SAFE_PROCEDURE (1 << (TYPE_BITS + 13))
+#define is_safe_procedure(p) ((typeflag(_NFre(p)) & T_SAFE_PROCEDURE) != 0)
+/* applicable objects that do not return or modify their arg list directly (no :rest arg in particular),
+ * and that can't call apply themselves either directly or via s7_call, and that don't mess with the stack.
*/
-#define UNUSED_BITS 0x81084800
+#define T_CHECKED (1 << (TYPE_BITS + 14))
+#define set_checked(p) typeflag(_TLst(p)) |= T_CHECKED
+#define is_checked(p) ((typeflag(_TLst(p)) & T_CHECKED) != 0)
+#define clear_checked(p) typeflag(_TLst(p)) &= (~T_CHECKED)
+
+#define set_checked_slot(p) typeflag(_TSlt(p)) |= T_CHECKED
+#define is_checked_slot(p) ((typeflag(_TSlt(p)) & T_CHECKED) != 0)
+#define is_not_checked_slot(p) ((typeflag(_TSlt(p)) & T_CHECKED) == 0)
+
+
+#define T_UNSAFE (1 << (TYPE_BITS + 15))
+#define set_unsafe(p) typeflag(_TLst(p)) |= T_UNSAFE
+#define set_unsafely_optimized(p) typeflag(_TLst(p)) |= (T_UNSAFE | T_OPTIMIZED)
+#define is_unsafe(p) ((typeflag(_TLst(p)) & T_UNSAFE) != 0)
+#define clear_unsafe(p) typeflag(_TLst(p)) &= (~T_UNSAFE)
+#define is_safely_optimized(p) ((typeflag(p) & (T_OPTIMIZED | T_UNSAFE)) == T_OPTIMIZED)
+/* optimizer flag saying "this expression is not completely self-contained. It might involve the stack, etc" */
+
+#define T_CLEAN_SYMBOL T_UNSAFE
+#define is_clean_symbol(p) ((typeflag(_TSym(p)) & T_CLEAN_SYMBOL) != 0)
+#define set_clean_symbol(p) typeflag(_TSym(p)) |= T_CLEAN_SYMBOL
+/* set if we know the symbol name can be printed without quotes (slashification) */
+
+#define T_IMMUTABLE (1 << (TYPE_BITS + 16))
+#define is_immutable(p) ((typeflag(_NFre(p)) & T_IMMUTABLE) != 0)
+#define is_immutable_port(p) ((typeflag(_TPrt(p)) & T_IMMUTABLE) != 0)
+#define is_immutable_symbol(p) ((typeflag(_TSym(p)) & T_IMMUTABLE) != 0)
+#define is_immutable_integer(p) ((typeflag(_TI(p)) & T_IMMUTABLE) != 0)
+#define is_immutable_real(p) ((typeflag(_TR(p)) & T_IMMUTABLE) != 0)
+#define set_immutable(p) typeflag(_TSym(p)) |= T_IMMUTABLE
+/* immutable means the value can't be changed via set! or bind -- this is separate from the symbol access stuff
+ * this bit can't be in the second byte -- with-let, for example, is immutable, but we use SYNTACTIC_TYPE to
+ * recognize syntax in do loop optimizations.
+ */
+
+#define T_SETTER (1 << (TYPE_BITS + 17))
+#define set_setter(p) typeflag(_TSym(p)) |= T_SETTER
+#define is_setter(p) ((typeflag(_TSym(p)) & T_SETTER) != 0)
+/* optimizer flag for a procedure that sets some variable (set-car! for example). */
+
+#define T_ALLOW_OTHER_KEYS T_SETTER
+#define set_allow_other_keys(p) typeflag(_TLst(p)) |= T_ALLOW_OTHER_KEYS
+#define allows_other_keys(p) ((typeflag(_TLst(p)) & T_ALLOW_OTHER_KEYS) != 0)
+/* marks arglist that allows keyword args other than those in the parameter list; can't allow
+ * (define* (f :allow-other-keys)...) because there's only one nil, and besides, it does say "other".
+ */
-/* TYPE_BITS could be 5
- * TYPE_BITS + 3, 6, 11, 16 and 23 are currently unused
+#define T_MUTABLE (1 << (TYPE_BITS + 18))
+#define is_mutable(p) ((typeflag(_TNum(p)) & T_MUTABLE) != 0)
+/* #define set_mutable(p) typeflag(_TNum(p)) |= T_MUTABLE */
+/* used for mutable numbers */
+
+#define T_MARK_SEQ T_MUTABLE
+#define is_mark_seq(p) ((typeflag(_TItr(p)) & T_MARK_SEQ) != 0)
+#define set_mark_seq(p) typeflag(_TItr(p)) |= T_MARK_SEQ
+/* used in iterators for GC mark of sequence */
+
+#define T_BYTE_VECTOR T_MUTABLE
+#define is_byte_vector(p) ((typeflag(_TStr(p)) & T_BYTE_VECTOR) != 0)
+#define set_byte_vector(p) typeflag(_TStr(p)) |= T_BYTE_VECTOR
+/* marks a string that the caller considers a byte_vector */
+
+#define T_STEPPER T_MUTABLE
+#define is_stepper(p) ((typeflag(_TSlt(p)) & T_STEPPER) != 0)
+#define set_stepper(p) typeflag(_TSlt(p)) |= T_STEPPER
+bool s7_is_stepper(s7_pointer p) {return(is_stepper(p));}
+/* marks a slot that holds a do-loop's step variable (if int, can be numerator=current, denominator=end) */
+
+#define T_SAFE_STEPPER (1 << (TYPE_BITS + 19))
+#define is_safe_stepper(p) ((typeflag(_TSlp(p)) & T_SAFE_STEPPER) != 0)
+#define set_safe_stepper(p) typeflag(_TSlp(p)) |= T_SAFE_STEPPER
+#define is_unsafe_stepper(p) ((typeflag(_TSlp(p)) & (T_STEPPER | T_SAFE_STEPPER)) == T_STEPPER)
+/* an experiment */
+
+#define T_PRINT_NAME T_SAFE_STEPPER
+#define has_print_name(p) ((typeflag(_TNum(p)) & T_PRINT_NAME) != 0)
+#define set_has_print_name(p) typeflag(_TNum(p)) |= T_PRINT_NAME
+/* marks numbers that have a saved version of their string representation */
+
+#define T_POSSIBLY_SAFE T_SAFE_STEPPER
+#define is_possibly_safe(p) ((typeflag(_TFnc(p)) & T_POSSIBLY_SAFE) != 0)
+#define set_is_possibly_safe(p) typeflag(_TFnc(p)) |= T_POSSIBLY_SAFE
+/* marks c_functions that are not always unsafe -- this bit didn't work out as intended */
+
+#define T_HAS_SET_FALLBACK T_SAFE_STEPPER
+#define T_HAS_REF_FALLBACK T_MUTABLE
+#define has_ref_fallback(p) ((typeflag(_TLid(p)) & T_HAS_REF_FALLBACK) != 0)
+#define has_set_fallback(p) ((typeflag(_TLid(p)) & T_HAS_SET_FALLBACK) != 0)
+#define set_has_ref_fallback(p) typeflag(_TLet(p)) |= T_HAS_REF_FALLBACK
+#define set_has_set_fallback(p) typeflag(_TLet(p)) |= T_HAS_SET_FALLBACK
+#define set_all_methods(p, e) typeflag(_TLet(p)) |= (typeflag(e) & (T_HAS_METHODS | T_HAS_REF_FALLBACK | T_HAS_SET_FALLBACK))
+
+
+#define T_COPY_ARGS (1 << (TYPE_BITS + 20))
+#define needs_copied_args(p) ((typeflag(_NFre(p)) & T_COPY_ARGS) != 0)
+/* this marks something that might mess with its argument list, it should not be in the second byte */
+
+#define T_GENSYM (1 << (TYPE_BITS + 21))
+#define is_gensym(p) ((typeflag(_TSym(p)) & T_GENSYM) != 0)
+/* symbol is from gensym (GC-able etc) */
+
+#define T_SIMPLE_ARGS T_GENSYM
+#define has_simple_args(p) ((typeflag(_TLst(p)) & T_SIMPLE_ARGS) != 0)
+#define set_simple_args(p) typeflag(_TLst(p)) |= T_SIMPLE_ARGS
+/* are all lambda* default values simple? */
+
+#define T_LIST_IN_USE T_GENSYM
+#define list_is_in_use(p) ((typeflag(_TLst(p)) & T_LIST_IN_USE) != 0)
+#define set_list_in_use(p) typeflag(_TLst(p)) |= T_LIST_IN_USE
+#define clear_list_in_use(p) typeflag(_TLst(p)) &= (~T_LIST_IN_USE)
+/* these could all be one permanent list, indexed from inside, and this bit is never actually protecting anything across a call */
+
+#define T_FUNCTION_ENV T_GENSYM
+#define is_function_env(p) ((typeflag(_TLet(p)) & T_FUNCTION_ENV) != 0)
+#define set_function_env(p) typeflag(_TLet(p)) |= T_FUNCTION_ENV
+/* this marks a funclet */
+
+#define T_DOCUMENTED T_GENSYM
+#define is_documented(p) ((typeflag(_TStr(p)) & T_DOCUMENTED) != 0)
+#define set_documented(p) typeflag(_TStr(p)) |= T_DOCUMENTED
+/* this marks a symbol that has documentation (bit is set on name cell) */
+
+#define T_HAS_METHODS (1 << (TYPE_BITS + 22))
+#define has_methods(p) ((typeflag(_NFre(p)) & T_HAS_METHODS) != 0)
+#define set_has_methods(p) typeflag(_TMet(p)) |= T_HAS_METHODS
+#define clear_has_methods(p) typeflag(_TMet(p)) &= (~T_HAS_METHODS)
+/* this marks an environment or closure that is "opened" up to generic functions etc
+ * don't reuse this bit if possible
*/
+#define T_GC_MARK 0x80000000 /* (1 << (TYPE_BITS + 23)) but that makes gcc unhappy */
+#define is_marked(p) ((typeflag(p) & T_GC_MARK) != 0)
+#define set_mark(p) typeflag(_NFre(p)) |= T_GC_MARK
+#define clear_mark(p) typeflag(p) &= (~T_GC_MARK)
+/* using bit 23 for this makes a big difference in the GC */
-#if HAVE_PTHREADS
-#define set_type(p, f) typeflag(p) = ((typeflag(p) & T_GC_MARK) | (f))
-/* the gc call can be interrupted, leaving mark bits set -- we better not clear those bits */
-#else
-#define set_type(p, f) typeflag(p) = f
-#endif
-#define is_true(Sc, p) ((p) != Sc->F)
-#define is_false(Sc, p) ((p) == Sc->F)
+static int not_heap = -1;
+#define heap_location(p) (p)->hloc
+#define not_in_heap(p) ((_NFre(p))->hloc < 0)
+#define unheap(p) (p)->hloc = not_heap--
+
+#define is_eof(p) (_NFre(p) == sc->EOF_OBJECT)
+#define is_true(Sc, p) ((_NFre(p)) != Sc->F)
+#define is_false(Sc, p) ((_NFre(p)) == Sc->F)
+
#ifdef _MSC_VER
- #define make_boolean(sc, Val) (((Val) & 0xff) ? sc->T : sc->F)
+ #define MS_WINDOWS 1
+ static s7_pointer make_boolean(s7_scheme *sc, bool val) {if (val) return(sc->T); return(sc->F);}
#else
+ #define MS_WINDOWS 0
#define make_boolean(sc, Val) ((Val) ? sc->T : sc->F)
#endif
#define is_pair(p) (type(p) == T_PAIR)
-/* using a bit here, rather than a type number) was much slower */
-#define car(p) ((p)->object.cons.car)
-#define cdr(p) ((p)->object.cons.cdr)
+#define is_null(p) ((_NFre(p)) == sc->NIL)
+#define is_not_null(p) ((_NFre(p)) != sc->NIL)
+
+
+#if (!DEBUGGING)
+
+#define opt1(p, r) ((p)->object.cons.opt1)
+#define set_opt1(p, x, r) (p)->object.cons.opt1 = x
+#define opt2(p, r) ((p)->object.cons.opt2)
+#define set_opt2(p, x, r) (p)->object.cons.opt2 = (s7_pointer)(x)
+#define opt3(p, r) ((p)->object.cons.opt3)
+#define set_opt3(p, x, r) do {(p)->object.cons.opt3 = x; typeflag(p) &= ~(T_OPTIMIZED | T_LINE_NUMBER);} while (0)
+
+#define pair_line(p) (p)->object.sym_cons.line
+#define pair_set_line(p, X) (p)->object.sym_cons.line = X
+#define pair_raw_hash(p) (p)->object.sym_cons.hash
+#define pair_set_raw_hash(p, X) (p)->object.sym_cons.hash = X
+#define pair_raw_len(p) (p)->object.sym_cons.op
+#define pair_set_raw_len(p, X) (p)->object.sym_cons.op = X
+#define pair_raw_name(p) (p)->object.sym_cons.fstr
+#define pair_set_raw_name(p, X) (p)->object.sym_cons.fstr = X
+
+/* opt1 == raw_hash, opt2 == raw_name, opt3 == line+op|len, but hash/name/len only apply to the symbol table so there's no collision */
+
+#else
+
+/* these 3 fields (or 8 counting sym_cons) hold most of the varigated optimizer info, so they are used in many conflicting ways.
+ * the bits and funcs here try to track each such use, and report any cross-talk or collisions.
+ * all of this machinery vanishes if debugging is turned off.
+ */
+#define S_NAME (1 << 26)
+#define S_HASH (1 << 27)
+#define S_OP (1 << 28)
+#define S_LINE (1 << 29)
+#define S_LEN (1 << 30)
+#define S_SYNOP 0x80000000 /* (1 << 31) */
+
+#define E_SET (1 << 0)
+#define E_FAST (1 << 6) /* fast list in member/assoc circular list check */
+#define E_CFUNC (1 << 7) /* c-function */
+#define E_CLAUSE (1 << 8) /* case clause */
+#define E_BACK (1 << 9) /* back pointer for doubly-linked list */
+#define E_LAMBDA (1 << 10) /* lambda(*) */
+#define E_SYM (1 << 11) /* symbol */
+#define E_PAIR (1 << 12) /* pair */
+#define E_CON (1 << 13) /* constant from eval's point of view */
+#define E_GOTO (1 << 14) /* call-with-exit exit func */
+#define E_VECTOR (1 << 15) /* vector (any kind) */
+#define E_ANY (1 << 16) /* anything -- deliberate unchecked case */
+#define E_SLOT (1 << 17) /* slot */
+#define E_MASK (E_FAST | E_CFUNC | E_CLAUSE | E_BACK | E_LAMBDA | E_SYM | E_PAIR | E_CON | E_GOTO | E_VECTOR | E_ANY | E_SLOT | S_HASH)
+
+#define opt1_is_set(p) (((p)->debugger_bits & E_SET) != 0)
+#define set_opt1_is_set(p) (p)->debugger_bits |= E_SET
+#define opt1_role_matches(p, Role) (((p)->debugger_bits & E_MASK) == Role)
+#define set_opt1_role(p, Role) (p)->debugger_bits = (Role | ((p)->debugger_bits & ~E_MASK))
+#define opt1(p, Role) opt1_1(hidden_sc, _TLst(p), Role, __func__, __LINE__)
+#define set_opt1(p, x, Role) set_opt1_1(hidden_sc, _TLst(p), x, Role, __func__, __LINE__)
+
+#define F_SET (1 << 1)
+#define F_C_CALL (1 << 18) /* c_function invocation */
+#define F_KEY (1 << 19) /* case key */
+#define F_SLOW (1 << 20) /* slow list in member/assoc circular list check */
+#define F_SYM (1 << 21) /* symbol */
+#define F_PAIR (1 << 22) /* pair */
+#define F_CON (1 << 23) /* constant as above */
+#define F_CALL (1 << 24) /* c-func */
+#define F_LAMBDA (1 << 25) /* lambda form */
+#define F_MASK (F_C_CALL | F_KEY | F_SLOW | F_SYM | F_PAIR | F_CON | F_CALL | F_LAMBDA | S_NAME)
+
+#define opt2_is_set(p) (((p)->debugger_bits & F_SET) != 0)
+#define set_opt2_is_set(p) (p)->debugger_bits |= F_SET
+#define opt2_role_matches(p, Role) (((p)->debugger_bits & F_MASK) == Role)
+#define set_opt2_role(p, Role) (p)->debugger_bits = (Role | ((p)->debugger_bits & ~F_MASK))
+#define opt2(p, Role) opt2_1(hidden_sc, _TLst(p), Role, __func__, __LINE__)
+#define set_opt2(p, x, Role) set_opt2_1(hidden_sc, _TLst(p), (s7_pointer)x, Role, __func__, __LINE__)
+
+/* opt3 collides with optimization and line number stuff (T_LINE_NUMBER, T_OPTIMIZED) */
+#define G_SET (1 << 2)
+#define G_ARGLEN (1 << 3) /* arglist length */
+#define G_SYM (1 << 4) /* expression symbol access */
+#define G_AND (1 << 5) /* and second clause */
+#define G_MASK (G_ARGLEN | G_SYM | G_AND | S_OP | S_LINE | S_LEN | S_SYNOP)
+
+#define opt3_is_set(p) (((p)->debugger_bits & G_SET) != 0)
+#define set_opt3_is_set(p) (p)->debugger_bits |= G_SET
+#define opt3_role_matches(p, Role) (((p)->debugger_bits & G_MASK) == Role)
+#define set_opt3_role(p, Role) (p)->debugger_bits = (Role | ((p)->debugger_bits & ~G_MASK))
+#define opt3(p, Role) opt3_1(hidden_sc, _TLst(p), Role, __func__, __LINE__)
+#define set_opt3(p, x, Role) set_opt3_1(hidden_sc, _TLst(p), x, Role, __func__, __LINE__)
+
+/* opt1 == s_hash, opt2 == s_fstr, opt3 == s_op|len|line and op==len so they are contradictory (but only op/line|opt3 actually collide)
+ * line|len|op: unsigned int set G_SET and S_* if S_LEN -> not op and vice versa
+ * another collider: pair_syntax_op|optimize_op below. Both need bits: S_SYNOP?
+ */
+
+#define pair_line(p) s_line_1(sc, _TLst(p), __func__, __LINE__)
+#define pair_set_line(p, X) set_s_line_1(sc, _TLst(p), X, __func__, __LINE__)
+#define pair_raw_hash(p) s_hash_1(sc, _TLst(p), __func__, __LINE__)
+#define pair_set_raw_hash(p, X) set_s_hash_1(sc, _TLst(p), X, __func__, __LINE__)
+#define pair_raw_len(p) s_len_1(sc, _TLst(p), __func__, __LINE__)
+#define pair_set_raw_len(p, X) set_s_len_1(sc, _TLst(p), X, __func__, __LINE__)
+#define pair_raw_name(p) s_name_1(sc, _TLst(p), __func__, __LINE__)
+#define pair_set_raw_name(p, X) set_s_name_1(sc, _TLst(p), X, __func__, __LINE__)
+#endif
+
+#define opt_fast(P) _TCdr(opt1(P, E_FAST))
+#define set_opt_fast(P, X) set_opt1(P, _TLst(X), E_FAST)
+#define opt_back(P) _TLst(opt1(P, E_BACK))
+#define set_opt_back(P) set_opt1(cdr(P), _TLst(P), E_BACK)
+#define has_opt_back(P) (cdr(opt_back(P)) == P )
+#define opt_cfunc(P) opt1(P, E_CFUNC)
+#define set_opt_cfunc(P, X) set_opt1(P, X, E_CFUNC)
+#define opt_lambda(P) _TClo(opt1(P, E_LAMBDA))
+#define set_opt_lambda(P, X) set_opt1(P, X, E_LAMBDA)
+#define opt_goto(P) _TGot(opt1(P, E_GOTO))
+#define set_opt_goto(P, X) set_opt1(P, _TGot(X), E_GOTO)
+#define opt_vector(P) _TVec(opt1(P, E_VECTOR))
+#define set_opt_vector(P, X) set_opt1(P, _TVec(X), E_VECTOR)
+#define opt_clause(P) opt1(P, E_CLAUSE)
+#define set_opt_clause(P, X) set_opt1(P, X, E_CLAUSE)
+#define opt_sym1(P) _TSym(opt1(P, E_SYM))
+#define set_opt_sym1(P, X) set_opt1(P, _TSym(X), E_SYM)
+#define opt_pair1(P) _TCdr(opt1(P, E_PAIR))
+#define set_opt_pair1(P, X) set_opt1(P, _TCdr(X), E_PAIR)
+#define opt_con1(P) opt1(P, E_CON)
+#define set_opt_con1(P, X) set_opt1(P, X, E_CON)
+#define opt_any1(P) opt1(P, E_ANY)
+#define opt_slot1(P) _TSlt(opt1(P, E_SLOT))
+#define set_opt_slot1(P, X) set_opt1(P, _TSlt(X), E_SLOT)
+
+#define c_callee(f) ((s7_function)opt2(f, F_CALL))
+#define c_call(f) ((s7_function)opt2(f, F_CALL))
+#define set_c_call(f, X) set_opt2(f, (s7_pointer)X, F_CALL)
+#define opt_key(P) opt2(P, F_KEY)
+#define set_opt_key(P, X) set_opt2(P, X, F_KEY)
+#define opt_slow(P) _TCdr(opt2(P, F_SLOW))
+#define set_opt_slow(P, X) set_opt2(P, _TLst(X), F_SLOW)
+#define opt_sym2(P) _TSym(opt2(P, F_SYM))
+#define set_opt_sym2(P, X) set_opt2(P, _TSym(X), F_SYM)
+#define opt_pair2(P) _TCdr(opt2(P, F_PAIR))
+#define set_opt_pair2(P, X) set_opt2(P, _TCdr(X), F_PAIR)
+#define opt_con2(P) opt2(P, F_CON)
+#define set_opt_con2(P, X) set_opt2(P, X, F_CON)
+#define opt_lambda2(P) _TLst(opt2(P, F_LAMBDA))
+#define set_opt_lambda2(P, X) set_opt2(P, _TLst(X), F_LAMBDA)
+
+#define arglist_length(P) _TI(opt3(cdr(P), G_ARGLEN))
+#define set_arglist_length(P, X) set_opt3(cdr(P), _TI(X), G_ARGLEN)
+#define opt_sym3(P) _TSym(opt3(P, G_SYM))
+#define set_opt_sym3(P, X) set_opt3(P, _TSym(X), G_SYM)
+#define opt_and_2_test(P) _TLst(opt3(P, G_AND))
+#define set_opt_and_2_test(P, X) set_opt3(P, _TLst(X), G_AND)
+
+
+#define car(p) (_TCdr(p))->object.cons.car
+#define cdr(p) (_TCdr(p))->object.cons.cdr
+#define unchecked_car(p) (_NFre(p))->object.cons.car
+#define unchecked_cdr(p) (_NFre(p))->object.cons.cdr
+
#define caar(p) car(car(p))
#define cadr(p) car(cdr(p))
#define cdar(p) cdr(car(p))
#define cddr(p) cdr(cdr(p))
+
#define caaar(p) car(car(car(p)))
#define cadar(p) car(cdr(car(p)))
#define cdadr(p) cdr(car(cdr(p)))
@@ -845,7 +1853,9 @@ struct s7_scheme {
#define cdaar(p) cdr(car(car(p)))
#define cdddr(p) cdr(cdr(cdr(p)))
#define cddar(p) cdr(cdr(car(p)))
+
#define caaadr(p) car(car(car(cdr(p))))
+#define caadar(p) car(car(cdr(car(p))))
#define cadaar(p) car(cdr(car(car(p))))
#define cadddr(p) car(cdr(cdr(cdr(p))))
#define caaddr(p) car(car(cdr(cdr(p))))
@@ -853,159 +1863,435 @@ struct s7_scheme {
#define caddar(p) car(cdr(cdr(car(p))))
#define cdadar(p) cdr(car(cdr(car(p))))
#define cdaddr(p) cdr(car(cdr(cdr(p))))
-#define pair_line_number(p) (p)->object.cons.line
-#define port_file_number(p) (p)->object.port->file_number
-
-#define csr(p) ((p)->object.cons.csr)
+#define caaaar(p) car(car(car(car(p))))
+#define cadadr(p) car(cdr(car(cdr(p))))
+#define cdaadr(p) cdr(car(car(cdr(p))))
+#define cdaaar(p) cdr(car(car(car(p))))
+#define cdddar(p) cdr(cdr(cdr(car(p))))
+#define cddadr(p) cdr(cdr(car(cdr(p))))
+#define cddaar(p) cdr(cdr(car(car(p))))
+
+#if WITH_GCC
+ /* slightly tricky because cons can be called recursively */
+ #define cons(Sc, A, B) ({s7_pointer _X_, _A_, _B_; _A_ = A; _B_ = B; new_cell(sc, _X_, T_PAIR | T_SAFE_PROCEDURE); car(_X_) = _A_; cdr(_X_) = _B_; _X_;})
+#else
+ #define cons(Sc, A, B) s7_cons(Sc, A, B)
+#endif
-#define string_value(p) ((p)->object.string.svalue)
-#define string_length(p) ((p)->object.string.length)
-#define character(p) ((p)->object.cvalue)
+#define list_1(Sc, A) cons(Sc, A, sc->NIL)
+#define list_2(Sc, A, B) cons_unchecked(Sc, A, cons(Sc, B, sc->NIL))
+#define list_3(Sc, A, B, C) cons_unchecked(Sc, A, cons_unchecked(Sc, B, cons(Sc, C, sc->NIL)))
+#define list_4(Sc, A, B, C, D) cons_unchecked(Sc, A, cons_unchecked(Sc, B, cons_unchecked(Sc, C, cons(Sc, D, sc->NIL))))
+
+#define is_string(p) (type(p) == T_STRING)
+#define string_value(p) (_TStr(p))->object.string.svalue
+#define string_length(p) (_TStr(p))->object.string.length
+#define string_hash(p) (_TStr(p))->object.string.hash
+#define string_needs_free(p) (_TStr(p))->object.string.str_ext.needs_free
+#define string_temp_true_length(p) (_TStr(p))->object.string.str_ext.accessor
+
+#define tmpbuf_malloc(P, Len) do {if ((Len) < TMPBUF_SIZE) P = sc->tmpbuf; else P = (char *)malloc((Len) * sizeof(char));} while (0)
+#define tmpbuf_calloc(P, Len) do {if ((Len) < TMPBUF_SIZE) {P = sc->tmpbuf; memset((void *)P, 0, Len);} else P = (char *)calloc(Len, sizeof(char));} while (0)
+#define tmpbuf_free(P, Len) do {if ((Len) >= TMPBUF_SIZE) free(P);} while (0)
+
+#define character(p) (_TChr(p))->object.chr.c
+#define upper_character(p) (_TChr(p))->object.chr.up_c
+#define is_char_alphabetic(p) (_TChr(p))->object.chr.alpha_c
+#define is_char_numeric(p) (_TChr(p))->object.chr.digit_c
+#define is_char_whitespace(p) (_TChr(p))->object.chr.space_c
+#define is_char_uppercase(p) (_TChr(p))->object.chr.upper_c
+#define is_char_lowercase(p) (_TChr(p))->object.chr.lower_c
+#define character_name(p) (_TChr(p))->object.chr.c_name
+#define character_name_length(p) (_TChr(p))->object.chr.length
+
+#if (!DEBUGGING)
+ #define optimize_op(p) (_TLst(p))->object.sym_cons.op
+ #define set_optimize_op(P, Op) optimize_op(P) = Op
+#else
+ #define optimize_op(p) s_op_1(hidden_sc, _TLst(p), __func__, __LINE__)
+ #define set_optimize_op(p, Op) set_s_op_1(hidden_sc, _TLst(p), Op, __func__, __LINE__)
+#endif
-#define symbol_location(p) (car(p))->object.string.location
- /* presumably the symbol table size will fit in an int, so this is safe */
-#define symbol_name(p) string_value(car(p))
-#define symbol_name_length(p) string_length(car(p))
-#define symbol_value(Sym) cdr(Sym)
-#define set_symbol_value(Sym, Val) cdr(Sym) = (Val)
-#if WITH_PROFILING
- #define symbol_calls(p) (p)->calls
- #define symbol_data(p) (p)->data
+#define optimize_op_match(P, Q) ((is_optimized(P)) && ((optimize_op(P) & 0xfffe) == Q))
+#define op_no_hop(P) (optimize_op(P) & 0xfffe)
+#define clear_hop(P) set_optimize_op(P, op_no_hop(P))
+#define clear_optimize_op(P) set_optimize_op(P, 0)
+#define set_safe_optimize_op(P, Q) do {set_optimized(P); set_optimize_op(P, Q);} while (0)
+#define set_unsafe_optimize_op(P, Q) do {set_unsafely_optimized(P); set_optimize_op(P, Q);} while (0)
+
+#define is_symbol(p) (type(p) == T_SYMBOL)
+#define symbol_name_cell(p) _TStr((_TSym(p))->object.sym.name)
+#define set_symbol_name_cell(p, S) (_TSym(p))->object.sym.name = _TStr(S)
+#define symbol_name(p) string_value(symbol_name_cell(p))
+#define symbol_name_length(p) string_length(symbol_name_cell(p))
+#define symbol_hmap(p) s7_int_abs(heap_location(p))
+#define symbol_global_accessor_index(p) (symbol_name_cell(p))->object.string.str_ext.accessor
+#define symbol_id(p) (_TSym(p))->object.sym.id
+#define symbol_set_id(p, X) (_TSym(p))->object.sym.id = X
+/* we need 64-bits here, since we don't want this thing to wrap around, and frames are created at a great rate
+ * callgrind says this is faster than an unsigned int!
+ */
+#define symbol_syntax_op(p) (_TSym(p))->object.sym.op
+
+#define global_slot(p) (_TSym(p))->object.sym.global_slot
+#define initial_slot(p) (symbol_name_cell(p))->object.string.initial_slot
+#define local_slot(p) (_TSym(p))->object.sym.local_slot
+#define keyword_symbol(p) (symbol_name_cell(p))->object.string.doc.ksym
+#define symbol_help(p) (symbol_name_cell(p))->object.string.doc.documentation
+#define symbol_tag(p) (_TSym(p))->object.sym.tag
+#define symbol_has_help(p) (is_documented(symbol_name_cell(p)))
+#define symbol_set_has_help(p) set_documented(symbol_name_cell(p))
+
+#define symbol_set_local(Symbol, Id, Slot) do {local_slot(Symbol) = Slot; symbol_set_id(Symbol, Id);} while (0)
+/* set slot before id in case Slot is an expression that tries to find the current Symbol slot (using its old Id obviously) */
+
+#define is_slot(p) (type(p) == T_SLOT)
+#define slot_value(p) _NFre((_TSlt(p))->object.slt.val)
+#define slot_set_value(p, Val) (_TSlt(p))->object.slt.val = _NFre(Val)
+#define slot_symbol(p) _TSym((_TSlt(p))->object.slt.sym)
+#define slot_set_symbol(p, Sym) (_TSlt(p))->object.slt.sym = _TSym(Sym)
+#define next_slot(p) (_TSlt(p))->object.slt.nxt
+#define slot_pending_value(p) (_TSlt(p))->object.slt.pending_value
+#define slot_expression(p) (_TSlt(p))->object.slt.expr
+#define slot_accessor(p) slot_expression(p)
+
+#define is_syntax(p) (type(p) == T_SYNTAX)
+#define syntax_symbol(p) (_TSyn(p))->object.syn.symbol
+#define syntax_opcode(p) (_TSyn(p))->object.syn.op
+#define syntax_min_args(p) (_TSyn(p))->object.syn.min_args
+#define syntax_max_args(p) (_TSyn(p))->object.syn.max_args
+#define syntax_documentation(p) sc->syn_docs[syntax_opcode(p)]
+#define syntax_rp(p) (_TSyn(p))->object.syn.rp
+#define syntax_ip(p) (_TSyn(p))->object.syn.ip
+#define syntax_pp(p) (_TSyn(p))->object.syn.pp
+
+#if (!DEBUGGING)
+ #define pair_syntax_op(p) (p)->object.sym_cons.op
+ #define pair_set_syntax_op(p, X) (p)->object.sym_cons.op = X
+#else
+ #define pair_syntax_op(p) s_syn_op_1(hidden_sc, _TLst(p), __func__, __LINE__)
+ #define pair_set_syntax_op(p, Op) set_s_syn_op_1(hidden_sc, _TLst(p), Op, __func__, __LINE__)
#endif
-#define symbol_global_slot(p) (car(p))->object.string.global_slot
+#define pair_syntax_symbol(P) car(opt_back(P))
+static void pair_set_syntax_symbol(s7_pointer p, s7_pointer op) {pair_syntax_symbol(p) = op; pair_set_syntax_op(opt_back(p), symbol_syntax_op(op));}
+
+#define ROOTLET_SIZE 512
+#define let_id(p) (_TLid(p))->object.envr.id
+#define is_let(p) (type(p) == T_LET)
+#define let_slots(p) (_TLet(p))->object.envr.slots
+#define let_set_slots(p, Slot) (_TLet(p))->object.envr.slots = Slot
+#define outlet(p) (_TLet(p))->object.envr.nxt
+#define set_outlet(p, ol) (_TLet(p))->object.envr.nxt = _TLid(ol)
+#define funclet_function(p) _TSym((_TLet(p))->object.envr.edat.efnc.function)
+#define funclet_set_function(p, F) (_TLet(p))->object.envr.edat.efnc.function = _TSym(F)
+#define let_line(p) (_TLet(p))->object.envr.edat.efnc.line
+#define let_set_line(p, L) (_TLet(p))->object.envr.edat.efnc.line = L
+#define let_file(p) (_TLet(p))->object.envr.edat.efnc.file
+#define let_set_file(p, F) (_TLet(p))->object.envr.edat.efnc.file = F
+#define dox_slot1(p) _TSlt((_TLet(p))->object.envr.edat.dox.dox1)
+#define dox_set_slot1(p, S) (_TLet(p))->object.envr.edat.dox.dox1 = _TSlt(S)
+#define dox_slot2(p) _TSlt((_TLet(p))->object.envr.edat.dox.dox2)
+#define dox_set_slot2(p, S) (_TLet(p))->object.envr.edat.dox.dox2 = _TSlt(S)
+
+#define unique_name(p) (p)->object.unq.name
+#define unique_name_length(p) (p)->object.unq.len
+#define is_unspecified(p) (type(p) == T_UNSPECIFIED)
+#define unique_cdr(p) (p)->object.unq.unused_nxt
#define vector_length(p) ((p)->object.vector.length)
-#define vector_element(p, i) ((p)->object.vector.elements[i])
-#define vector_elements(p) (p)->object.vector.elements
-
-#define vector_dimension(p, i) ((p)->object.vector.vextra.dim_info->dims[i])
-#define vector_ndims(p) ((p)->object.vector.vextra.dim_info->ndims)
-#define vector_offset(p, i) ((p)->object.vector.vextra.dim_info->offsets[i])
-#define vector_is_multidimensional(p) ((p)->object.vector.vextra.dim_info)
-#define shared_vector(p) ((p)->object.vector.vextra.dim_info->original)
-
-#define hash_table_length(p) (p)->object.vector.length
-#define hash_table_elements(p) (p)->object.vector.elements
-#define hash_table_entries(p) (p)->object.vector.vextra.entries
-#define hash_table_function(p) (p)->object.vector.hash_func
-
-#define small_int(Val) small_ints[Val]
-#define opcode(Op) small_ints[(int)Op]
-
-#define is_input_port(p) (type(p) == T_INPUT_PORT)
+#define vector_element(p, i) ((p)->object.vector.elements.objects[i])
+#define vector_elements(p) (p)->object.vector.elements.objects
+#define vector_getter(p) (_TVec(p))->object.vector.vget
+#define vector_setter(p) (_TVec(p))->object.vector.vset
+#define int_vector_element(p, i) ((_TIvc(p))->object.vector.elements.ints[i])
+#define int_vector_elements(p) (_TIvc(p))->object.vector.elements.ints
+#define float_vector_element(p, i) ((_TFvc(p))->object.vector.elements.floats[i])
+#define float_vector_elements(p) (_TFvc(p))->object.vector.elements.floats
+#define is_normal_vector(p) (type(p) == T_VECTOR)
+#define is_int_vector(p) (type(p) == T_INT_VECTOR)
+#define is_float_vector(p) (type(p) == T_FLOAT_VECTOR)
+
+#define vector_ndims(p) ((_TVec(p))->object.vector.dim_info->ndims)
+#define vector_dimension(p, i) ((_TVec(p))->object.vector.dim_info->dims[i])
+#define vector_dimensions(p) ((_TVec(p))->object.vector.dim_info->dims)
+#define vector_offset(p, i) ((_TVec(p))->object.vector.dim_info->offsets[i])
+#define vector_offsets(p) ((_TVec(p))->object.vector.dim_info->offsets)
+#define vector_dimension_info(p) ((_TVec(p))->object.vector.dim_info)
+#define shared_vector(p) ((_TVec(p))->object.vector.dim_info->original)
+#define vector_rank(p) ((vector_dimension_info(p)) ? vector_ndims(p) : 1)
+#define vector_has_dimensional_info(p) (vector_dimension_info(p))
+#define vector_elements_allocated(p) ((_TVec(p))->object.vector.dim_info->elements_allocated)
+#define vector_dimensions_allocated(p) ((_TVec(p))->object.vector.dim_info->dimensions_allocated)
+
+#define is_hash_table(p) (type(p) == T_HASH_TABLE)
+#define hash_table_mask(p) (_THsh(p))->object.hasher.mask
+#define hash_table_element(p, i) ((_THsh(p))->object.hasher.elements[i])
+#define hash_table_elements(p) (_THsh(p))->object.hasher.elements
+#define hash_table_entries(p) (_THsh(p))->object.hasher.entries
+#define hash_table_checker(p) (_THsh(p))->object.hasher.hash_func
+#define hash_table_mapper(p) (_THsh(p))->object.hasher.loc
+#define hash_table_checker_locked(p) (hash_table_mapper(p) != default_hash_map)
+#define hash_table_procedures(p) (_THsh(p))->object.hasher.dproc
+#define hash_table_procedures_checker(p) car(hash_table_procedures(p))
+#define hash_table_procedures_mapper(p) cdr(hash_table_procedures(p))
+
+#define is_iterator(p) (type(p) == T_ITERATOR)
+#define iterator_sequence(p) (_TItr(p))->object.iter.obj
+#define iterator_position(p) (_TItr(p))->object.iter.lc.loc
+#define iterator_length(p) (_TItr(p))->object.iter.lw.len
+#define iterator_slow(p) (_TItr(p))->object.iter.lw.slow
+#define iterator_hash_current(p) (_TItr(p))->object.iter.lw.hcur
+#define iterator_current(p) (_TItr(p))->object.iter.cur
+#define iterator_let_current(p) (_TItr(p))->object.iter.lc.lcur
+#define iterator_let_cons(p) (_TItr(p))->object.iter.cur
+#define iterator_next(p) (_TItr(p))->object.iter.next
+#define iterator_is_at_end(p) (iterator_next(p) == iterator_finished)
+
+#define ITERATOR_END EOF_OBJECT
+#define ITERATOR_END_NAME "#<eof>"
+
+#define is_input_port(p) (type(p) == T_INPUT_PORT)
#define is_output_port(p) (type(p) == T_OUTPUT_PORT)
-#define is_string_port(p) ((p)->object.port->type == STRING_PORT)
-#define is_file_port(p) ((p)->object.port->type == FILE_PORT)
-#define is_function_port(p) ((p)->object.port->type == FUNCTION_PORT)
-#define port_type(p) (p)->object.port->type
-#define port_line_number(p) (p)->object.port->line_number
-#define port_filename(p) (p)->object.port->filename
-#define port_file(p) (p)->object.port->file
-#define port_is_closed(p) (p)->object.port->is_closed
-#define port_string(p) (p)->object.port->value
-#define port_string_length(p) (p)->object.port->size
-#define port_string_point(p) (p)->object.port->point
-#define port_needs_free(p) (p)->object.port->needs_free
-#define port_output_function(p) (p)->object.port->output_function
-#define port_input_function(p) (p)->object.port->input_function
-#define port_data(p) (p)->object.port->data
+#define port_port(p) (_TPrt(p))->object.prt.port
+#define port_type(p) (_TPrt(p))->object.prt.ptype
+#define is_string_port(p) (port_type(p) == STRING_PORT)
+#define is_file_port(p) (port_type(p) == FILE_PORT)
+#define is_function_port(p) (port_type(p) == FUNCTION_PORT)
+#define port_line_number(p) (_TPrt(p))->object.prt.line_number
+#define port_file_number(p) (_TPrt(p))->object.prt.file_number
+#define port_filename(p) port_port(p)->filename
+#define port_filename_length(p) port_port(p)->filename_length
+#define port_file(p) port_port(p)->file
+#define port_is_closed(p) (_TPrt(p))->object.prt.is_closed
+#define port_data(p) (_TPrt(p))->object.prt.data
+#define port_data_size(p) (_TPrt(p))->object.prt.size
+#define port_position(p) (_TPrt(p))->object.prt.point
+#define port_needs_free(p) port_port(p)->needs_free
+#define port_output_function(p) port_port(p)->output_function
+#define port_input_function(p) port_port(p)->input_function
+#define port_original_input_string(p) port_port(p)->orig_str
+#define port_read_character(p) port_port(p)->read_character
+#define port_read_line(p) port_port(p)->read_line
+#define port_display(p) port_port(p)->display
+#define port_write_character(p) port_port(p)->write_character
+#define port_write_string(p) port_port(p)->write_string
+#define port_read_semicolon(p) port_port(p)->read_semicolon
+#define port_read_white_space(p) port_port(p)->read_white_space
+#define port_read_name(p) port_port(p)->read_name
+#define port_read_sharp(p) port_port(p)->read_sharp
+#define port_gc_loc(p) port_port(p)->gc_loc
#define is_c_function(f) (type(f) >= T_C_FUNCTION)
-#define c_function(f) (f)->object.ffptr
-#define c_function_call(f) (f)->object.ffptr->ff
-#define c_function_name(f) (f)->object.ffptr->name
-#define c_function_documentation(f) (f)->object.ffptr->doc
-#define c_function_required_args(f) (f)->object.ffptr->required_args
-#define c_function_optional_args(f) (f)->object.ffptr->optional_args
-#define c_function_has_rest_arg(f) (f)->object.ffptr->rest_arg
-#define c_function_all_args(f) (f)->object.ffptr->all_args
-#define c_function_setter(f) (f)->object.ffptr->setter
+#define is_c_function_star(f) (type(f) == T_C_FUNCTION_STAR)
+#define is_any_c_function(f) (type(f) >= T_C_FUNCTION_STAR)
+#define c_function_data(f) (_TFnc(f))->object.fnc.c_proc
+#define c_function_call(f) (_TFnc(f))->object.fnc.ff
+#define c_function_required_args(f) (_TFnc(f))->object.fnc.required_args
+#define c_function_optional_args(f) (_TFnc(f))->object.fnc.optional_args
+#define c_function_has_rest_arg(f) (_TFnc(f))->object.fnc.rest_arg
+#define c_function_all_args(f) (_TFnc(f))->object.fnc.all_args
+#define c_function_setter(f) (_TFnc(f))->object.fnc.setter
+#define c_function_name(f) c_function_data(f)->name
+#define c_function_name_length(f) c_function_data(f)->name_length
+#define c_function_documentation(f) c_function_data(f)->doc
+#define c_function_signature(f) c_function_data(f)->signature
+#define c_function_class(f) c_function_data(f)->id
+#define c_function_chooser(f) c_function_data(f)->chooser
+#define c_function_base(f) c_function_data(f)->generic_ff
+#define c_function_arg_defaults(f) c_function_data(f)->arg_defaults
+#define c_function_call_args(f) c_function_data(f)->call_args
+#define c_function_arg_names(f) c_function_data(f)->arg_names
+#define c_function_rp(f) c_function_data(f)->rp
+#define c_function_ip(f) c_function_data(f)->ip
+#define c_function_pp(f) c_function_data(f)->pp
+#define c_function_gp(f) c_function_data(f)->gp
+#define set_c_function(f, X) do {set_opt_cfunc(f, X); set_c_call(f, c_function_call(opt_cfunc(f)));} while (0)
#define is_c_macro(p) (type(p) == T_C_MACRO)
-#define c_macro_call(f) (f)->object.ffptr->ff
-#define c_macro_name(f) (f)->object.ffptr->name
-#define c_macro_required_args(f) (f)->object.ffptr->required_args
-#define c_macro_all_args(f) (f)->object.ffptr->all_args
-
-#define continuation_stack(p) (p)->object.continuation.stack
-#define continuation_stack_end(p) (p)->object.continuation.stack_end
-#define continuation_stack_start(p) (p)->object.continuation.stack_start
-#define continuation_stack_size(p) (p)->object.continuation.stack_size
+#define c_macro_data(f) (_TMac(f))->object.fnc.c_proc
+#define c_macro_call(f) (_TMac(f))->object.fnc.ff
+#define c_macro_name(f) c_macro_data(f)->name
+#define c_macro_name_length(f) c_macro_data(f)->name_length
+#define c_macro_required_args(f) (_TMac(f))->object.fnc.required_args
+#define c_macro_all_args(f) (_TMac(f))->object.fnc.all_args
+#define c_macro_setter(f) (_TMac(f))->object.fnc.setter
+
+#define is_random_state(p) (type(p) == T_RANDOM_STATE)
+#if WITH_GMP
+#define random_gmp_state(p) (_TRan(p))->object.rng.state
+#else
+#define random_seed(p) (_TRan(p))->object.rng.seed
+#define random_carry(p) (_TRan(p))->object.rng.carry
+#endif
+
+#define continuation_data(p) (_TCon(p))->object.cwcc.continuation
+#define continuation_stack(p) (_TCon(p))->object.cwcc.stack
+#define continuation_stack_end(p) (_TCon(p))->object.cwcc.stack_end
+#define continuation_stack_start(p) (_TCon(p))->object.cwcc.stack_start
+#define continuation_stack_size(p) (_TCon(p))->object.cwcc.continuation->stack_size
#define continuation_stack_top(p) (continuation_stack_end(p) - continuation_stack_start(p))
+#define continuation_op_stack(p) (_TCon(p))->object.cwcc.op_stack
+#define continuation_op_loc(p) (_TCon(p))->object.cwcc.continuation->op_stack_loc
+#define continuation_op_size(p) (_TCon(p))->object.cwcc.continuation->op_stack_size
+#define continuation_key(p) (_TCon(p))->object.cwcc.continuation->local_key
-#define call_exit_goto_loc(p) (p)->object.rexit.goto_loc
-#define call_exit_active(p) (p)->object.rexit.active
+#define call_exit_goto_loc(p) (_TGot(p))->object.rexit.goto_loc
+#define call_exit_op_loc(p) (_TGot(p))->object.rexit.op_stack_loc
+#define call_exit_active(p) (_TGot(p))->object.rexit.active
+#define temp_stack_top(p) (_TStk(p))->object.stk.top
#define s7_stack_top(Sc) ((Sc)->stack_end - (Sc)->stack_start)
#define is_continuation(p) (type(p) == T_CONTINUATION)
#define is_goto(p) (type(p) == T_GOTO)
#define is_macro(p) (type(p) == T_MACRO)
-#define is_bacro(p) (type(p) == T_BACRO)
+/* #define is_bacro(p) (type(p) == T_BACRO) */
+#define is_macro_star(p) (type(p) == T_MACRO_STAR)
+#define is_bacro_star(p) (type(p) == T_BACRO_STAR)
#define is_closure(p) (type(p) == T_CLOSURE)
#define is_closure_star(p) (type(p) == T_CLOSURE_STAR)
-#define closure_source(Obj) car(Obj)
-#define closure_args(Obj) car(closure_source(Obj))
-#define closure_body(Obj) cdr(closure_source(Obj))
-#define closure_environment(Obj) cdr(Obj)
-
-#define catch_tag(p) (p)->object.rcatch.tag
-#define catch_goto_loc(p) (p)->object.rcatch.goto_loc
-#define catch_handler(p) (p)->object.rcatch.handler
+#define closure_args(p) (_TClo(p))->object.func.args
+#define closure_body(p) (_TClo(p))->object.func.body
+#define closure_let(p) _TLid((_TClo(p))->object.func.env)
+#define closure_set_let(p, L) (_TClo(p))->object.func.env = _TLid(L)
+#define closure_setter(p) (_TClo(p))->object.func.setter
+#define closure_arity(p) (_TClo(p))->object.func.arity
+#define CLOSURE_ARITY_NOT_SET 0x40000000
+#define MAX_ARITY 0x20000000
+#define closure_arity_unknown(p) (closure_arity(p) == CLOSURE_ARITY_NOT_SET)
+#define is_thunk(Sc, Fnc) ((type(Fnc) >= T_GOTO) && (s7_is_aritable(Sc, Fnc, 0)))
+
+#define catch_tag(p) (_TCat(p))->object.rcatch.tag
+#define catch_goto_loc(p) (_TCat(p))->object.rcatch.goto_loc
+#define catch_op_loc(p) (_TCat(p))->object.rcatch.op_stack_loc
+#define catch_handler(p) (_TCat(p))->object.rcatch.handler
+
+#define catch_all_goto_loc(p) (_TLet(p))->object.envr.edat.ctall.goto_loc
+#define catch_all_set_goto_loc(p, L) (_TLet(p))->object.envr.edat.ctall.goto_loc = L
+#define catch_all_op_loc(p) (_TLet(p))->object.envr.edat.ctall.op_stack_loc
+#define catch_all_set_op_loc(p, L) (_TLet(p))->object.envr.edat.ctall.op_stack_loc = L
+#define catch_all_result(p) _NFre((_TLet(p))->object.envr.edat.ctall.result)
+#define catch_all_set_result(p, R) (_TLet(p))->object.envr.edat.ctall.result = R
enum {DWIND_INIT, DWIND_BODY, DWIND_FINISH};
-#define dynamic_wind_state(p) (p)->object.winder.state
-#define dynamic_wind_in(p) (p)->object.winder.in
-#define dynamic_wind_out(p) (p)->object.winder.out
-#define dynamic_wind_body(p) (p)->object.winder.body
+#define dynamic_wind_state(p) (_TDyn(p))->object.winder.state
+#define dynamic_wind_in(p) (_TDyn(p))->object.winder.in
+#define dynamic_wind_out(p) (_TDyn(p))->object.winder.out
+#define dynamic_wind_body(p) (_TDyn(p))->object.winder.body
#define is_c_object(p) (type(p) == T_C_OBJECT)
-#define c_object_type(p) (p)->object.fobj.type
-#define c_object_value(p) (p)->object.fobj.value
+#define c_object_value(p) (_TObj(p))->object.c_obj.value
+#define c_object_type(p) (_TObj(p))->object.c_obj.type
+#define c_object_let(p) _TLid((_TObj(p))->object.c_obj.e)
+#define c_object_set_let(p, L) (_TObj(p))->object.c_obj.e = _TLid(L)
+#define c_object_cref(p) (_TObj(p))->object.c_obj.ref
+
+static c_object_t **object_types = NULL;
+static int object_types_size = 0;
+static int num_object_types = 0;
+
+#define c_object_info(p) object_types[c_object_type(p)]
+#define c_object_ref(p) c_object_info(p)->ref
+#define c_object_set(p) c_object_info(p)->set
+#define c_object_print(p) c_object_info(p)->print
+#define c_object_print_readably(p) c_object_info(p)->print_readably
+#define c_object_length(p) c_object_info(p)->length
+#define c_object_eql(p) c_object_info(p)->equal
+#define c_object_fill(p) c_object_info(p)->fill
+#define c_object_copy(p) c_object_info(p)->copy
+#define c_object_free(p) c_object_info(p)->free
+#define c_object_mark(p) c_object_info(p)->gc_mark
+#define c_object_reverse(p) c_object_info(p)->reverse
+#define c_object_direct_ref(p) c_object_info(p)->direct_ref
+#define c_object_direct_set(p) c_object_info(p)->direct_set
+#define c_object_ip(p) c_object_info(p)->ip
+#define c_object_rp(p) c_object_info(p)->rp
+#define c_object_set_ip(p) c_object_info(p)->set_ip
+#define c_object_set_rp(p) c_object_info(p)->set_rp
+/* #define c_object_outer_type(p) c_object_info(p)->outer_type */
+
+#define raw_pointer(p) (_TPtr(p))->object.c_pointer
+
+#define is_counter(p) (type(p) == T_COUNTER)
+#define counter_result(p) (_TCtr(p))->object.ctr.result
+#define counter_list(p) (_TCtr(p))->object.ctr.list
+#define counter_capture(p) (_TCtr(p))->object.ctr.cap
+#define counter_let(p) _TLid((_TCtr(p))->object.ctr.env)
+#define counter_set_let(p, L) (_TCtr(p))->object.ctr.env = _TLid(L)
+
+#define is_baffle(p) (type(p) == T_BAFFLE)
+#define baffle_key(p) (_TBfl(p))->object.baffle_key
+
+#if __cplusplus && HAVE_COMPLEX_NUMBERS
+ using namespace std; /* the code has to work in C as well as C++, so we can't scatter std:: all over the place */
+ typedef complex<s7_double> s7_complex;
+ static s7_double Real(complex<s7_double> x) {return(real(x));} /* protect the C++ name */
+ static s7_double Imag(complex<s7_double> x) {return(imag(x));}
+#endif
+
+#define integer(p) (_TI(p))->object.number.integer_value
+#define real(p) (_TR(p))->object.number.real_value
+#define set_real(p, x) real(p) = x
+#define numerator(p) (_TF(p))->object.number.fraction_value.numerator
+#define denominator(p) (_TF(p))->object.number.fraction_value.denominator
+#define fraction(p) (((long double)numerator(p)) / ((long double)denominator(p)))
+#define inverted_fraction(p) (((long double)denominator(p)) / ((long double)numerator(p)))
+#define real_part(p) (_TZ(p))->object.number.complex_value.rl
+#define set_real_part(p, x) real_part(p) = x
+#define imag_part(p) (_TZ(p))->object.number.complex_value.im
+#define set_imag_part(p, x) imag_part(p) = x
+#if HAVE_COMPLEX_NUMBERS
+ #define as_c_complex(p) CMPLX(real_part(p), imag_part(p))
+#endif
-#define is_s_object(p) (type(p) == T_S_OBJECT)
-#define s_object_type(p) (p)->object.fobj.type
-#define s_object_value(p) (p)->object.fobj.value
+#if WITH_GMP
+#define big_integer(p) ((_TBgi(p))->object.number.big_integer)
+#define big_ratio(p) ((_TBgf(p))->object.number.big_ratio)
+#define big_real(p) ((_TBgr(p))->object.number.big_real)
+#define big_complex(p) ((_TBgz(p))->object.number.big_complex)
+#endif
-#define is_hook(p) (type(p) == T_HOOK)
-#define hook_arity(p) (p)->object.hook.arity
-#define hook_functions(p) (p)->object.hook.functions
-#define hook_documentation(p) (p)->object.hook.documentation
+#define NUM_SMALL_INTS 2048
+#define small_int(Val) small_ints[Val]
+#define is_small(n) ((n & ~(NUM_SMALL_INTS - 1)) == 0)
-#define raw_pointer(p) (p)->object.c_pointer
+#define print_name(p) (char *)((_TNum(p))->object.number.pval.name + 1)
+#define print_name_length(p) (_TNum(p))->object.number.pval.name[0]
+static void set_print_name(s7_pointer p, const char *name, int len)
+{
+ if ((len < PRINT_NAME_SIZE) &&
+ (!is_mutable(p)))
+ {
+ set_has_print_name(p);
+ print_name_length(p) = (unsigned char)(len & 0xff);
+ memcpy((void *)print_name(p), (void *)name, len);
+ }
+}
-#define NUM_INT 0
-#define NUM_RATIO 1
-#define NUM_REAL 2
-#define NUM_REAL2 3
-#define NUM_COMPLEX 4
-#define NO_NUM 8
-#define NO_NUM_SHIFT 3
-#define IS_NUM(n) (n < NO_NUM)
+#if WITH_GCC
+#define make_integer(Sc, N) \
+ ({ s7_int _N_; _N_ = (N); (is_small(_N_) ? small_int(_N_) : ({ s7_pointer _X_; new_cell(Sc, _X_, T_INTEGER); integer(_X_) = _N_; _X_;}) ); })
-#if WITH_GMP
-#define T_BIG_INTEGER 0
-#define T_BIG_RATIO 1
-#define T_BIG_REAL 2
-#define T_BIG_COMPLEX 3
-#endif
+#define make_real(Sc, X) \
+ ({ s7_double _N_ = (X); ((_N_ == 0.0) ? real_zero : ({ s7_pointer _X_; new_cell(Sc, _X_, T_REAL); set_real(_X_, _N_); _X_;}) ); })
+ /* the x == 0.0 check saves more than it costs */
-#define number(p) (p)->object.number
-#define number_type(p) (p)->object.number.type
-#define num_type(n) (n.type)
+#define make_complex(Sc, R, I) \
+ ({ s7_double im; im = (I); ((im == 0.0) ? make_real(Sc, R) : ({ s7_pointer _X_; new_cell(Sc, _X_, T_COMPLEX); set_real_part(_X_, R); set_imag_part(_X_, im); _X_;}) ); })
-#define numerator(n) n.value.fraction_value.numerator
-#define denominator(n) n.value.fraction_value.denominator
-#define fraction(n) (((long double)numerator(n)) / ((long double)denominator(n)))
+#define real_to_double(Sc, X, Caller) ({ s7_pointer _x_; _x_ = (X); ((type(_x_) == T_REAL) ? real(_x_) : s7_number_to_real_with_caller(sc, _x_, Caller)); })
+#define rational_to_double(Sc, X) ({ s7_pointer _x_; _x_ = (X); ((type(_x_) == T_INTEGER) ? (s7_double)integer(_x_) : fraction(_x_)); })
-#define real_part(n) n.value.complex_value.real
-#define imag_part(n) n.value.complex_value.imag
-#define integer(n) n.value.integer_value
-#define complex_real_part(p) real_part(number(p))
-#define complex_imag_part(p) imag_part(number(p))
+#else
+#define make_integer(Sc, N) s7_make_integer(Sc, N)
+#define make_real(Sc, X) s7_make_real(Sc, X)
+#define make_complex(Sc, R, I) s7_make_complex(Sc, R, I)
+#define real_to_double(Sc, X, Caller) s7_number_to_real_with_caller(Sc, X, Caller)
+#define rational_to_double(Sc, X) s7_number_to_real(Sc, X)
+#endif
#define S7_LLONG_MAX 9223372036854775807LL
#define S7_LLONG_MIN (-S7_LLONG_MAX - 1LL)
@@ -1016,9 +2302,9 @@ enum {DWIND_INIT, DWIND_BODY, DWIND_FINISH};
#define S7_SHORT_MAX 32767
#define S7_SHORT_MIN -32768
-static s7_Int s7_Int_max = 0, s7_Int_min = 0;
+static s7_int s7_int_max = 0, s7_int_min = 0;
-/* 9007199254740991LL is where a truncated double starts to skip integers (expt 2 53) = ca 1e16
+/* 9007199254740991LL is where a truncated double starts to skip integers (expt 2 53) = ca 1e16
* :(ceiling (+ 1e16 1))
* 10000000000000000
* :(> 9007199254740993.0 9007199254740992.0)
@@ -1049,27 +2335,34 @@ static s7_Int s7_Int_max = 0, s7_Int_min = 0;
*/
-#if __cplusplus
- using namespace std;
- typedef complex<s7_Double> s7_Complex;
- static s7_Double Real(complex<s7_Double> x) {return(real(x));} /* protect the C++ name */
- static s7_Double Imag(complex<s7_Double> x) {return(imag(x));}
-#endif
-
-#define real(n) n.value.real_value
-
+/* --------------------------------------------------------------------------------
+ * local versions of some standard C library functions
+ * timing tests involving these are very hard to interpret -- pervasive inconsistency!
+ */
static int safe_strlen(const char *str)
{
/* this is safer than strlen, and slightly faster */
char *tmp = (char *)str;
- if (!tmp) return(0);
+ if ((!tmp) || (!(*tmp))) return(0);
while (*tmp++) {};
return(tmp - str - 1);
}
-static char *copy_string_with_len(const char *str, int len)
+static int safe_strlen5(const char *str)
+{
+ /* safe_strlen but we quit counting if len>5 */
+ char *tmp = (char *)str;
+ char *end;
+ if ((!tmp) || (!(*tmp))) return(0);
+ end = (char *)(tmp + 6);
+ while ((*tmp++) && (tmp < end)) {};
+ return(tmp - str - 1);
+}
+
+
+static char *copy_string_with_length(const char *str, int len)
{
char *newstr;
newstr = (char *)malloc((len + 1) * sizeof(char));
@@ -1082,25076 +2375,65073 @@ static char *copy_string_with_len(const char *str, int len)
static char *copy_string(const char *str)
{
- return(copy_string_with_len(str, safe_strlen(str)));
+ return(copy_string_with_length(str, safe_strlen(str)));
}
-#define strings_are_equal(Str1, Str2) (strcmp(Str1, Str2) == 0)
-/* newlib code here was slower -- this should only be used for internal strings -- scheme
- * strings can have embedded nulls.
- */
+static bool local_strcmp(const char *s1, const char *s2)
+{
+ while (true)
+ {
+ if (*s1 != *s2++) return(false);
+ if (*s1++ == 0) return(true);
+ }
+ return(true);
+}
-#define scheme_strings_are_equal(Str1, Str2) (scheme_strcmp(Str1, Str2) == 0)
-/* here Str1 and Str2 are s7_pointers
- */
+#define strings_are_equal(Str1, Str2) (local_strcmp(Str1, Str2))
+/* this should only be used for internal strings -- scheme strings can have embedded nulls. */
+
+static bool safe_strcmp(const char *s1, const char *s2)
+{
+ if ((!s1) || (!s2)) return(s1 == s2);
+ return(local_strcmp(s1, s2));
+}
-static int safe_strcmp(const char *s1, const char *s2)
+static bool local_strncmp(const char *s1, const char *s2, unsigned int n)
{
- int val;
- if (s1 == NULL)
+#if defined(__x86_64__) || defined(__i386__) /* unaligned accesses are safe on i386 hardware, sez everyone */
+ if (n >= 4)
{
- if (s2 == NULL)
- return(0);
- return(-1);
+ int *is1, *is2;
+ int n4 = n >> 2;
+ is1 = (int *)s1;
+ is2 = (int *)s2;
+ do {if (*is1++ != *is2++) return(false);} while (--n4 > 0);
+ s1 = (const char *)is1;
+ s2 = (const char *)is2;
+ n &= 3;
}
- if (s2 == NULL)
- return(1);
+#endif
+ while (n > 0)
+ {
+ if (*s1++ != *s2++) return(false);
+ n--;
+ }
+ return(true);
+}
- val = strcmp(s1, s2); /* strcmp can return stuff like -97, but we want -1, 0, or 1 */
+#define strings_are_equal_with_length(Str1, Str2, Len) (local_strncmp(Str1, Str2, Len))
- if (val <= -1)
- return(-1);
- if (val >= 1)
- return(1);
- return(val);
+
+ static void memclr(void *s, size_t n)
+{
+ unsigned char *s2;
+#if defined(__x86_64__) || defined(__i386__)
+ if (n >= 4)
+ {
+ int *s1 = (int *)s;
+ size_t n4 = n >> 2;
+ do {*s1++ = 0;} while (--n4 > 0);
+ n &= 3;
+ s2 = (unsigned char *)s1;
+ }
+ else s2 = (unsigned char *)s;
+#else
+ s2 = (unsigned char *)s;
+#endif
+ while (n > 0)
+ {
+ *s2++ = 0;
+ n--;
+ }
}
+/* ---------------- forward decls ---------------- */
+
+static char *number_to_string_base_10(s7_pointer obj, int width, int precision, char float_choice, int *nlen, use_write_t choice);
static bool is_proper_list(s7_scheme *sc, s7_pointer lst);
-static void mark_embedded_objects(s7_pointer a); /* called by gc, calls fobj's mark func */
+static s7_pointer iterator_finished(s7_scheme *sc, s7_pointer iterator);
+static bool is_all_x_safe(s7_scheme *sc, s7_pointer p);
+static void annotate_args(s7_scheme *sc, s7_pointer args, s7_pointer e);
+static void annotate_arg(s7_scheme *sc, s7_pointer arg, s7_pointer e);
static s7_pointer eval(s7_scheme *sc, opcode_t first_op);
-static s7_pointer division_by_zero_error(s7_scheme *sc, const char *caller, s7_pointer arg);
+static s7_pointer division_by_zero_error(s7_scheme *sc, s7_pointer caller, s7_pointer arg);
static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *descr, const char *name);
+static s7_pointer prepackaged_type_name(s7_scheme *sc, s7_pointer x);
+static void s7_warn(s7_scheme *sc, int len, const char *ctrl, ...);
static s7_pointer safe_reverse_in_place(s7_scheme *sc, s7_pointer list);
-static s7_pointer immutable_cons(s7_scheme *sc, s7_pointer a, s7_pointer b);
+static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b);
+static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, unsigned int type);
+static s7_pointer permanent_list(s7_scheme *sc, int len);
static void free_object(s7_pointer a);
-static char *describe_object(s7_scheme *sc, s7_pointer a);
-static s7_pointer make_atom(s7_scheme *sc, char *q, int radix, bool want_symbol);
-static bool object_is_applicable(s7_pointer x);
-static s7_pointer make_list_1(s7_scheme *sc, s7_pointer a);
-static s7_pointer make_list_2(s7_scheme *sc, s7_pointer a, s7_pointer b);
-static s7_pointer make_list_3(s7_scheme *sc, s7_pointer a, s7_pointer b, s7_pointer c);
-static s7_pointer make_list_4(s7_scheme *sc, s7_pointer a, s7_pointer b, s7_pointer c, s7_pointer d);
-static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, int type);
-static void write_string(s7_scheme *sc, const char *s, s7_pointer pt);
-static s7_pointer eval_symbol(s7_scheme *sc, s7_pointer sym);
-static s7_pointer eval_error(s7_scheme *sc, const char *errmsg, s7_pointer obj);
+static s7_pointer make_atom(s7_scheme *sc, char *q, int radix, bool want_symbol, bool with_error);
static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args);
-static bool is_thunk(s7_scheme *sc, s7_pointer x);
static int remember_file_name(s7_scheme *sc, const char *file);
-static const char *type_name(s7_pointer arg);
-static s7_pointer make_string_uncopied(s7_scheme *sc, char *str);
-static s7_pointer make_protected_string(s7_scheme *sc, const char *str);
-static s7_pointer call_symbol_bind(s7_scheme *sc, s7_pointer symbol, s7_pointer new_value);
-static s7_pointer s7_copy(s7_scheme *sc, s7_pointer obj);
+static const char *type_name(s7_scheme *sc, s7_pointer arg, int article);
+static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, unsigned int typ);
+static s7_pointer make_string_uncopied_with_length(s7_scheme *sc, char *str, int len);
+static s7_pointer make_string_wrapper_with_length(s7_scheme *sc, const char *str, int len);
+static s7_pointer make_string_wrapper(s7_scheme *sc, const char *str);
+static void check_for_substring_temp(s7_scheme *sc, s7_pointer expr);
static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args);
-static s7_pointer vector_copy(s7_scheme *sc, s7_pointer old_vect);
static void pop_input_port(s7_scheme *sc);
-static bool s7_is_negative(s7_pointer obj);
-static bool s7_is_positive(s7_pointer obj);
-static s7_pointer apply_list_star(s7_scheme *sc, s7_pointer d);
-static bool args_match(s7_scheme *sc, s7_pointer x, int args);
-static s7_pointer read_error(s7_scheme *sc, const char *errmsg);
+static char *object_to_truncated_string(s7_scheme *sc, s7_pointer p, int len);
+static token_t token(s7_scheme *sc);
+static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indices);
+static bool s7_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y);
+static void remove_gensym_from_symbol_table(s7_scheme *sc, s7_pointer sym);
+static s7_pointer find_symbol_unchecked(s7_scheme *sc, s7_pointer symbol);
+static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym);
+static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer func, s7_pointer args, s7_pointer body);
+static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_pointer e);
+static s7_pointer optimize(s7_scheme *sc, s7_pointer code, int hop, s7_pointer e);
+static void free_hash_table(s7_pointer table);
+#if WITH_GMP
+static s7_int big_integer_to_s7_int(mpz_t n);
+#else
+static double next_random(s7_pointer r);
+#endif
+#if WITH_GCC
+#define find_symbol_checked(Sc, Sym) ({s7_pointer _x_; _x_ = find_symbol_unchecked(Sc, Sym); ((_x_) ? _x_ : unbound_variable(Sc, Sym));})
+#else
+#define find_symbol_checked(Sc, Sym) find_symbol_unchecked(Sc, Sym)
+#endif
+static s7_pointer find_method(s7_scheme *sc, s7_pointer env, s7_pointer symbol);
+static s7_pointer find_let(s7_scheme *sc, s7_pointer obj);
+static bool call_begin_hook(s7_scheme *sc);
+static s7_pointer default_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val);
+static s7_pointer default_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc);
-/* -------------------------------- constants -------------------------------- */
+static s7_pointer simple_wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer typnam, s7_pointer descr);
+static s7_pointer wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer typnam, s7_pointer descr);
+static s7_pointer out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer descr);
+static s7_pointer simple_out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer descr);
-s7_pointer s7_f(s7_scheme *sc)
-{
- return(sc->F);
-}
+/* putting off the type description until s7_error via the sc->GC_NIL marker below makes it possible
+ * for gcc to speed up the functions that call these as tail-calls. 1-2% overall speedup!
+ */
+#define simple_wrong_type_argument(Sc, Caller, Arg, Desired_Type) \
+ simple_wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), Arg, sc->GC_NIL, prepackaged_type_names[Desired_Type])
+#define wrong_type_argument(Sc, Caller, Num, Arg, Desired_Type) \
+ wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), make_integer(Sc, Num), Arg, sc->GC_NIL, prepackaged_type_names[Desired_Type])
-s7_pointer s7_t(s7_scheme *sc)
-{
- return(sc->T);
-}
+#define simple_wrong_type_argument_with_type(Sc, Caller, Arg, Type) \
+ simple_wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), Arg, sc->GC_NIL, Type)
+#define wrong_type_argument_with_type(Sc, Caller, Num, Arg, Type) \
+ wrong_type_arg_error_prepackaged(Sc, symbol_name_cell(Caller), make_integer(Sc, Num), Arg, sc->GC_NIL, Type)
-s7_pointer s7_nil(s7_scheme *sc)
-{
- return(sc->NIL);
-}
+#define simple_out_of_range(Sc, Caller, Arg, Description) \
+ simple_out_of_range_error_prepackaged(Sc, symbol_name_cell(Caller), Arg, Description)
-s7_pointer s7_undefined(s7_scheme *sc)
-{
- return(sc->UNDEFINED);
-}
+#define out_of_range(Sc, Caller, Arg_Num, Arg, Description) \
+ out_of_range_error_prepackaged(Sc, symbol_name_cell(Caller), Arg_Num, Arg, Description)
-s7_pointer s7_unspecified(s7_scheme *sc)
-{
- return(sc->UNSPECIFIED);
-}
+static s7_pointer CAR_A_LIST, CDR_A_LIST;
+static s7_pointer CAAR_A_LIST, CADR_A_LIST, CDAR_A_LIST, CDDR_A_LIST;
+static s7_pointer CAAAR_A_LIST, CAADR_A_LIST, CADAR_A_LIST, CADDR_A_LIST, CDAAR_A_LIST, CDADR_A_LIST, CDDAR_A_LIST, CDDDR_A_LIST;
+static s7_pointer A_LIST, AN_ASSOCIATION_LIST, AN_OUTPUT_PORT, AN_INPUT_PORT, AN_OPEN_PORT, A_NORMAL_REAL, A_RATIONAL, A_BOOLEAN;
+static s7_pointer A_NUMBER, A_LET, A_PROCEDURE, A_PROPER_LIST, A_THUNK, SOMETHING_APPLICABLE, A_SYMBOL, A_NON_NEGATIVE_INTEGER;
+static s7_pointer A_FORMAT_PORT, AN_UNSIGNED_BYTE, A_BINDING, A_NON_CONSTANT_SYMBOL, AN_EQ_FUNC, A_SEQUENCE, ITS_TOO_SMALL, A_NORMAL_PROCEDURE;
+static s7_pointer ITS_TOO_LARGE, ITS_NEGATIVE, RESULT_IS_TOO_LARGE, ITS_NAN, ITS_INFINITE, TOO_MANY_INDICES, A_VALID_RADIX;
+static s7_pointer AN_INPUT_STRING_PORT, AN_INPUT_FILE_PORT, AN_OUTPUT_STRING_PORT, AN_OUTPUT_FILE_PORT, A_RANDOM_STATE_OBJECT;
+#if (!HAVE_COMPLEX_NUMBERS)
+static s7_pointer NO_COMPLEX_NUMBERS;
+#endif
-bool s7_is_unspecified(s7_scheme *sc, s7_pointer val)
-{
- return((val == sc->UNSPECIFIED) || (val == sc->NO_VALUE));
-}
+/* ---------------- evaluator ops ---------------- */
+
+enum {OP_NO_OP,
+ OP_READ_INTERNAL, OP_EVAL,
+ OP_EVAL_ARGS, OP_EVAL_ARGS1, OP_EVAL_ARGS2, OP_EVAL_ARGS3, OP_EVAL_ARGS4, OP_EVAL_ARGS5,
+ OP_APPLY, OP_EVAL_MACRO, OP_LAMBDA, OP_QUOTE, OP_MACROEXPAND,
+ OP_DEFINE, OP_DEFINE1, OP_BEGIN, OP_BEGIN_UNCHECKED, OP_BEGIN1,
+ OP_IF, OP_IF1, OP_WHEN, OP_WHEN1, OP_UNLESS, OP_UNLESS1, OP_SET, OP_SET1, OP_SET2,
+ OP_LET, OP_LET1, OP_LET_STAR, OP_LET_STAR1, OP_LET_STAR2,
+ OP_LETREC, OP_LETREC1, OP_LETREC_STAR, OP_LETREC_STAR1, OP_COND, OP_COND1, OP_COND_SIMPLE, OP_COND1_SIMPLE,
+ OP_AND, OP_AND1, OP_OR, OP_OR1,
+ OP_DEFINE_MACRO, OP_DEFINE_MACRO_STAR, OP_DEFINE_EXPANSION,
+ OP_CASE, OP_CASE1, OP_READ_LIST, OP_READ_NEXT, OP_READ_DOT, OP_READ_QUOTE,
+ OP_READ_QUASIQUOTE, OP_READ_QUASIQUOTE_VECTOR, OP_READ_UNQUOTE, OP_READ_APPLY_VALUES,
+ OP_READ_VECTOR, OP_READ_BYTE_VECTOR, OP_READ_DONE,
+ OP_LOAD_RETURN_IF_EOF, OP_LOAD_CLOSE_AND_POP_IF_EOF, OP_EVAL_STRING, OP_EVAL_DONE,
+ OP_CATCH, OP_DYNAMIC_WIND, OP_DEFINE_CONSTANT, OP_DEFINE_CONSTANT1,
+ OP_DO, OP_DO_END, OP_DO_END1, OP_DO_STEP, OP_DO_STEP2, OP_DO_INIT,
+ OP_DEFINE_STAR, OP_LAMBDA_STAR, OP_LAMBDA_STAR_DEFAULT, OP_ERROR_QUIT, OP_UNWIND_INPUT, OP_UNWIND_OUTPUT,
+ OP_ERROR_HOOK_QUIT,
+ OP_WITH_LET, OP_WITH_LET1, OP_WITH_LET_UNCHECKED, OP_WITH_LET_S,
+ OP_WITH_BAFFLE, OP_WITH_BAFFLE_UNCHECKED, OP_EXPANSION,
+ OP_FOR_EACH, OP_FOR_EACH_1, OP_FOR_EACH_2, OP_FOR_EACH_3,
+ OP_MAP, OP_MAP_1, OP_MAP_GATHER, OP_MAP_GATHER_1, OP_BARRIER, OP_DEACTIVATE_GOTO,
+
+ OP_DEFINE_BACRO, OP_DEFINE_BACRO_STAR,
+ OP_GET_OUTPUT_STRING, OP_GET_OUTPUT_STRING_1,
+ OP_SORT, OP_SORT1, OP_SORT2, OP_SORT3, OP_SORT_PAIR_END, OP_SORT_VECTOR_END, OP_SORT_STRING_END,
+ OP_EVAL_STRING_1, OP_EVAL_STRING_2,
+ OP_MEMBER_IF, OP_ASSOC_IF, OP_MEMBER_IF1, OP_ASSOC_IF1,
+
+ OP_QUOTE_UNCHECKED, OP_LAMBDA_UNCHECKED, OP_LET_UNCHECKED, OP_CASE_UNCHECKED, OP_WHEN_UNCHECKED, OP_UNLESS_UNCHECKED,
+
+ OP_SET_UNCHECKED, OP_SET_SYMBOL_C, OP_SET_SYMBOL_S, OP_SET_SYMBOL_Q, OP_SET_SYMBOL_P, OP_SET_SYMBOL_Z, OP_SET_SYMBOL_A,
+ OP_SET_SYMBOL_opSq, OP_SET_SYMBOL_opCq, OP_SET_SYMBOL_opSSq, OP_SET_SYMBOL_opSSSq,
+ OP_SET_NORMAL, OP_SET_PAIR, OP_SET_PAIR_Z, OP_SET_PAIR_A, OP_SET_PAIR_P, OP_SET_PAIR_ZA,
+ OP_SET_PAIR_P_1, OP_SET_WITH_ACCESSOR, OP_SET_PWS, OP_SET_LET_S, OP_SET_LET_ALL_X,
+ OP_SET_PAIR_C, OP_SET_PAIR_C_P, OP_SET_PAIR_C_P_1, OP_SET_SAFE,
+ OP_INCREMENT_1, OP_DECREMENT_1, OP_SET_CONS,
+ OP_INCREMENT_SS, OP_INCREMENT_SSS, OP_INCREMENT_SZ, OP_INCREMENT_SA, OP_INCREMENT_SAA,
+
+ OP_LET_STAR_UNCHECKED, OP_LETREC_UNCHECKED, OP_LETREC_STAR_UNCHECKED, OP_COND_UNCHECKED,
+ OP_LAMBDA_STAR_UNCHECKED, OP_DO_UNCHECKED, OP_DEFINE_UNCHECKED, OP_DEFINE_STAR_UNCHECKED, OP_DEFINE_FUNCHECKED, OP_DEFINE_CONSTANT_UNCHECKED,
+ OP_DEFINE_WITH_ACCESSOR, OP_DEFINE_MACRO_WITH_ACCESSOR,
+
+ OP_LET_NO_VARS, OP_NAMED_LET, OP_NAMED_LET_NO_VARS, OP_NAMED_LET_STAR,
+ OP_LET_C, OP_LET_S, OP_LET_ALL_C, OP_LET_ALL_S, OP_LET_ALL_X,
+ OP_LET_STAR_ALL_X, OP_LET_opCq, OP_LET_opSSq,
+ OP_LET_opSq, OP_LET_ALL_opSq, OP_LET_opSq_P, OP_LET_ONE, OP_LET_ONE_1, OP_LET_Z, OP_LET_Z_1,
+
+ OP_CASE_SIMPLE, OP_CASE_SIMPLER, OP_CASE_SIMPLER_1, OP_CASE_SIMPLER_SS, OP_CASE_SIMPLEST, OP_CASE_SIMPLEST_SS,
+ OP_IF_UNCHECKED, OP_AND_UNCHECKED, OP_AND_P, OP_AND_P1, OP_AND_P2, OP_OR_UNCHECKED, OP_OR_P, OP_OR_P1, OP_OR_P2,
+ OP_IF_P_FEED, OP_IF_P_FEED_1, OP_WHEN_S, OP_UNLESS_S,
+
+ OP_IF_S_P, OP_IF_S_P_P, OP_IF_NOT_S_P, OP_IF_NOT_S_P_P, OP_IF_CC_P, OP_IF_CC_P_P,
+ OP_IF_CS_P, OP_IF_CS_P_P, OP_IF_CSQ_P, OP_IF_CSQ_P_P, OP_IF_CSS_P, OP_IF_CSS_P_P,
+ OP_IF_CSC_P, OP_IF_CSC_P_P, OP_IF_IS_PAIR_P, OP_IF_IS_PAIR_P_P, OP_IF_opSSq_P, OP_IF_opSSq_P_P, OP_IF_S_opCq_P, OP_IF_S_opCq_P_P,
+ OP_IF_IS_SYMBOL_P, OP_IF_IS_SYMBOL_P_P, OP_IF_A_P, OP_IF_A_P_P, OP_IF_AND2_P, OP_IF_AND2_P_P,
+ OP_IF_Z_P, OP_IF_Z_P_P, OP_IF_P_P_P, OP_IF_P_P, OP_IF_ANDP_P, OP_IF_ANDP_P_P, OP_IF_ORP_P, OP_IF_ORP_P_P,
+ OP_IF_PPP, OP_IF_PP,
+
+ OP_CATCH_1, OP_CATCH_2, OP_CATCH_ALL, OP_COND_ALL_X, OP_COND_ALL_X_2, OP_COND_S,
+ OP_SIMPLE_DO, OP_SIMPLE_DO_STEP, OP_SAFE_DOTIMES, OP_SAFE_DOTIMES_STEP, OP_SAFE_DOTIMES_STEP_P, OP_SAFE_DOTIMES_STEP_O, OP_SAFE_DOTIMES_STEP_A,
+ OP_SAFE_DO, OP_SAFE_DO_STEP, OP_SIMPLE_DO_P, OP_SIMPLE_DO_STEP_P, OP_DOX, OP_DOX_STEP, OP_DOX_STEP_P,
+ OP_DOTIMES_P, OP_DOTIMES_STEP_P, OP_SIMPLE_DO_A, OP_SIMPLE_DO_STEP_A, OP_SIMPLE_DO_E, OP_SIMPLE_DO_STEP_E,
+
+ OP_SAFE_C_P_1, OP_SAFE_C_PP_1, OP_SAFE_C_PP_2, OP_SAFE_C_PP_3, OP_SAFE_C_PP_4, OP_SAFE_C_PP_5, OP_SAFE_C_PP_6,
+ OP_EVAL_ARGS_P_2, OP_EVAL_ARGS_P_2_MV, OP_EVAL_ARGS_P_3, OP_EVAL_ARGS_P_4, OP_EVAL_ARGS_P_3_MV, OP_EVAL_ARGS_P_4_MV,
+ OP_EVAL_ARGS_SSP_1, OP_EVAL_ARGS_SSP_MV, OP_EVAL_MACRO_MV, OP_MACROEXPAND_1,
+
+ OP_SAFE_C_ZZ_1, OP_SAFE_C_ZZ_2, OP_SAFE_C_ZC_1, OP_SAFE_C_SZ_1, OP_SAFE_C_ZA_1, OP_INCREMENT_SZ_1, OP_SAFE_C_SZ_SZ,
+ OP_SAFE_C_ZAA_1, OP_SAFE_C_AZA_1, OP_SAFE_C_AAZ_1, OP_SAFE_C_SSZ_1,
+ OP_SAFE_C_ZZA_1, OP_SAFE_C_ZZA_2, OP_SAFE_C_ZAZ_1, OP_SAFE_C_ZAZ_2, OP_SAFE_C_AZZ_1, OP_SAFE_C_AZZ_2,
+ OP_SAFE_C_ZZZ_1, OP_SAFE_C_ZZZ_2, OP_SAFE_C_ZZZ_3,
+ OP_SAFE_C_opSq_P_1, OP_SAFE_C_opSq_P_MV, OP_C_P_1, OP_C_P_2, OP_C_SP_1, OP_C_SP_2,
+ OP_CLOSURE_P_1, OP_CLOSURE_P_2, OP_SAFE_CLOSURE_P_1,
+ OP_MAX_DEFINED_1};
+
+#define OP_MAX_DEFINED (OP_MAX_DEFINED_1 + 1)
+
+typedef enum{E_C_P, E_C_PP, E_C_CP, E_C_SP, E_C_PC, E_C_PS} combine_op_t;
+
+enum {OP_SAFE_C_C, HOP_SAFE_C_C, OP_SAFE_C_S, HOP_SAFE_C_S,
+ OP_SAFE_C_SS, HOP_SAFE_C_SS, OP_SAFE_C_SC, HOP_SAFE_C_SC, OP_SAFE_C_CS, HOP_SAFE_C_CS,
+ OP_SAFE_C_Q, HOP_SAFE_C_Q, OP_SAFE_C_SQ, HOP_SAFE_C_SQ, OP_SAFE_C_QS, HOP_SAFE_C_QS, OP_SAFE_C_QQ, HOP_SAFE_C_QQ,
+ OP_SAFE_C_CQ, HOP_SAFE_C_CQ, OP_SAFE_C_QC, HOP_SAFE_C_QC,
+ OP_SAFE_C_SSS, HOP_SAFE_C_SSS, OP_SAFE_C_SCS, HOP_SAFE_C_SCS, OP_SAFE_C_SSC, HOP_SAFE_C_SSC, OP_SAFE_C_CSS, HOP_SAFE_C_CSS,
+ OP_SAFE_C_SCC, HOP_SAFE_C_SCC, OP_SAFE_C_CSC, HOP_SAFE_C_CSC,
+ OP_SAFE_C_ALL_S, HOP_SAFE_C_ALL_S, OP_SAFE_C_ALL_X, HOP_SAFE_C_ALL_X, OP_SAFE_C_SSA, HOP_SAFE_C_SSA, OP_SAFE_C_SAS, HOP_SAFE_C_SAS,
+ OP_SAFE_C_CSA, HOP_SAFE_C_CSA, OP_SAFE_C_SCA, HOP_SAFE_C_SCA, OP_SAFE_C_CAS, HOP_SAFE_C_CAS,
+ OP_SAFE_C_A, HOP_SAFE_C_A, OP_SAFE_C_AA, HOP_SAFE_C_AA, OP_SAFE_C_AAA, HOP_SAFE_C_AAA, OP_SAFE_C_AAAA, HOP_SAFE_C_AAAA,
+ OP_SAFE_C_SQS, HOP_SAFE_C_SQS, OP_SAFE_C_opAq, HOP_SAFE_C_opAq, OP_SAFE_C_opAAq, HOP_SAFE_C_opAAq, OP_SAFE_C_opAAAq, HOP_SAFE_C_opAAAq,
+ OP_SAFE_C_S_opAq, HOP_SAFE_C_S_opAq, OP_SAFE_C_S_opAAq, HOP_SAFE_C_S_opAAq, OP_SAFE_C_S_opAAAq, HOP_SAFE_C_S_opAAAq,
+
+ OP_SAFE_C_opCq, HOP_SAFE_C_opCq, OP_SAFE_C_opSq, HOP_SAFE_C_opSq,
+ OP_SAFE_C_opSSq, HOP_SAFE_C_opSSq, OP_SAFE_C_opSCq, HOP_SAFE_C_opSCq, OP_SAFE_C_opSQq, HOP_SAFE_C_opSQq,
+ OP_SAFE_C_opCSq, HOP_SAFE_C_opCSq, OP_SAFE_C_S_opSq, HOP_SAFE_C_S_opSq,
+ OP_SAFE_C_C_opSCq, HOP_SAFE_C_C_opSCq,
+ OP_SAFE_C_S_opSCq, HOP_SAFE_C_S_opSCq, OP_SAFE_C_S_opCSq, HOP_SAFE_C_S_opCSq,
+ OP_SAFE_C_opSq_S, HOP_SAFE_C_opSq_S, OP_SAFE_C_opSq_C, HOP_SAFE_C_opSq_C,
+ OP_SAFE_C_opSq_opSq, HOP_SAFE_C_opSq_opSq, OP_SAFE_C_S_opSSq, HOP_SAFE_C_S_opSSq, OP_SAFE_C_C_opSq, HOP_SAFE_C_C_opSq,
+ OP_SAFE_C_C_opCSq, HOP_SAFE_C_C_opCSq, OP_SAFE_C_opCSq_C, HOP_SAFE_C_opCSq_C,
+ OP_SAFE_C_S_opCq, HOP_SAFE_C_S_opCq, OP_SAFE_C_opSSq_C, HOP_SAFE_C_opSSq_C, OP_SAFE_C_C_opSSq, HOP_SAFE_C_C_opSSq,
+ OP_SAFE_C_C_opCq, HOP_SAFE_C_C_opCq, OP_SAFE_C_opCq_S, HOP_SAFE_C_opCq_S,
+ OP_SAFE_C_opCq_opCq, HOP_SAFE_C_opCq_opCq, OP_SAFE_C_opCq_C, HOP_SAFE_C_opCq_C,
+ OP_SAFE_C_opSCq_opSCq, HOP_SAFE_C_opSCq_opSCq, OP_SAFE_C_opSSq_opSSq, HOP_SAFE_C_opSSq_opSSq,
+ OP_SAFE_C_opSSq_opCq, HOP_SAFE_C_opSSq_opCq, OP_SAFE_C_opSSq_opSq, HOP_SAFE_C_opSSq_opSq, OP_SAFE_C_opSq_opSSq, HOP_SAFE_C_opSq_opSSq,
+ OP_SAFE_C_opSSq_S, HOP_SAFE_C_opSSq_S, OP_SAFE_C_opSCq_S, HOP_SAFE_C_opSCq_S, OP_SAFE_C_opCSq_S, HOP_SAFE_C_opCSq_S,
+ OP_SAFE_C_opSCq_C, HOP_SAFE_C_opSCq_C, OP_SAFE_C_opCq_opSSq, HOP_SAFE_C_opCq_opSSq,
+ OP_SAFE_C_S_op_opSSq_Sq, HOP_SAFE_C_S_op_opSSq_Sq, OP_SAFE_C_S_op_S_opSSqq, HOP_SAFE_C_S_op_S_opSSqq,
+ OP_SAFE_C_op_opSSq_q_C, HOP_SAFE_C_op_opSSq_q_C, OP_SAFE_C_op_opSq_q_C, HOP_SAFE_C_op_opSq_q_C,
+ OP_SAFE_C_op_opSSq_q_S, HOP_SAFE_C_op_opSSq_q_S, OP_SAFE_C_op_opSq_q_S, HOP_SAFE_C_op_opSq_q_S,
+ OP_SAFE_C_S_op_opSSq_opSSqq, HOP_SAFE_C_S_op_opSSq_opSSqq,
+ OP_SAFE_C_op_opSq_q, HOP_SAFE_C_op_opSq_q, OP_SAFE_C_C_op_S_opCqq, HOP_SAFE_C_C_op_S_opCqq,
+ OP_SAFE_C_op_S_opSq_q, HOP_SAFE_C_op_S_opSq_q,
+
+ OP_SAFE_C_Z, HOP_SAFE_C_Z, OP_SAFE_C_ZZ, HOP_SAFE_C_ZZ, OP_SAFE_C_SZ, HOP_SAFE_C_SZ, OP_SAFE_C_ZS, HOP_SAFE_C_ZS,
+ OP_SAFE_C_CZ, HOP_SAFE_C_CZ, OP_SAFE_C_ZC, HOP_SAFE_C_ZC,
+ OP_SAFE_C_opCq_Z, HOP_SAFE_C_opCq_Z, OP_SAFE_C_S_opSZq, HOP_SAFE_C_S_opSZq,
+ OP_SAFE_C_AZ, HOP_SAFE_C_AZ, OP_SAFE_C_ZA, HOP_SAFE_C_ZA,
+ OP_SAFE_C_ZAA, HOP_SAFE_C_ZAA, OP_SAFE_C_AZA, HOP_SAFE_C_AZA, OP_SAFE_C_AAZ, HOP_SAFE_C_AAZ, OP_SAFE_C_SSZ, HOP_SAFE_C_SSZ,
+ OP_SAFE_C_ZZA, HOP_SAFE_C_ZZA, OP_SAFE_C_ZAZ, HOP_SAFE_C_ZAZ, OP_SAFE_C_AZZ, HOP_SAFE_C_AZZ,
+ OP_SAFE_C_ZZZ, HOP_SAFE_C_ZZZ,
+
+ OP_THUNK, HOP_THUNK,
+ OP_CLOSURE_S, HOP_CLOSURE_S, OP_CLOSURE_C, HOP_CLOSURE_C, OP_CLOSURE_Q, HOP_CLOSURE_Q,
+ OP_CLOSURE_SS, HOP_CLOSURE_SS, OP_CLOSURE_SC, HOP_CLOSURE_SC, OP_CLOSURE_CS, HOP_CLOSURE_CS,
+ OP_CLOSURE_A, HOP_CLOSURE_A, OP_CLOSURE_AA, HOP_CLOSURE_AA,
+ OP_CLOSURE_ALL_X, HOP_CLOSURE_ALL_X, OP_CLOSURE_ALL_S, HOP_CLOSURE_ALL_S,
+
+ OP_GLOSURE_A, HOP_GLOSURE_A, OP_GLOSURE_S, HOP_GLOSURE_S, OP_GLOSURE_P, HOP_GLOSURE_P,
+
+ OP_CLOSURE_STAR_S, HOP_CLOSURE_STAR_S, OP_CLOSURE_STAR_SX, HOP_CLOSURE_STAR_SX,
+ OP_CLOSURE_STAR, HOP_CLOSURE_STAR, OP_CLOSURE_STAR_ALL_X, HOP_CLOSURE_STAR_ALL_X,
+
+ OP_SAFE_THUNK, HOP_SAFE_THUNK, OP_SAFE_THUNK_E, HOP_SAFE_THUNK_E, OP_SAFE_THUNK_P, HOP_SAFE_THUNK_P,
+ OP_SAFE_CLOSURE_S, HOP_SAFE_CLOSURE_S, OP_SAFE_CLOSURE_C, HOP_SAFE_CLOSURE_C, OP_SAFE_CLOSURE_Q, HOP_SAFE_CLOSURE_Q,
+ OP_SAFE_CLOSURE_SS, HOP_SAFE_CLOSURE_SS, OP_SAFE_CLOSURE_SC, HOP_SAFE_CLOSURE_SC, OP_SAFE_CLOSURE_CS, HOP_SAFE_CLOSURE_CS,
+ OP_SAFE_CLOSURE_A, HOP_SAFE_CLOSURE_A, OP_SAFE_CLOSURE_SA, HOP_SAFE_CLOSURE_SA, OP_SAFE_CLOSURE_S_P, HOP_SAFE_CLOSURE_S_P,
+ OP_SAFE_CLOSURE_SAA, HOP_SAFE_CLOSURE_SAA,
+ OP_SAFE_CLOSURE_ALL_X, HOP_SAFE_CLOSURE_ALL_X, OP_SAFE_CLOSURE_AA, HOP_SAFE_CLOSURE_AA,
+
+ OP_SAFE_GLOSURE_A, HOP_SAFE_GLOSURE_A, OP_SAFE_GLOSURE_S, HOP_SAFE_GLOSURE_S, OP_SAFE_GLOSURE_S_E, HOP_SAFE_GLOSURE_S_E,
+ OP_SAFE_GLOSURE_P, HOP_SAFE_GLOSURE_P,
+
+ OP_SAFE_CLOSURE_STAR_S, HOP_SAFE_CLOSURE_STAR_S, OP_SAFE_CLOSURE_STAR_SS, HOP_SAFE_CLOSURE_STAR_SS,
+ OP_SAFE_CLOSURE_STAR_SC, HOP_SAFE_CLOSURE_STAR_SC, OP_SAFE_CLOSURE_STAR_SA, HOP_SAFE_CLOSURE_STAR_SA, OP_SAFE_CLOSURE_STAR_S0, HOP_SAFE_CLOSURE_STAR_S0,
+ OP_SAFE_CLOSURE_STAR, HOP_SAFE_CLOSURE_STAR, OP_SAFE_CLOSURE_STAR_ALL_X, HOP_SAFE_CLOSURE_STAR_ALL_X,
+
+ /* these can't be embedded, and have to be the last thing called */
+ OP_APPLY_SS, HOP_APPLY_SS,
+ OP_C_ALL_X, HOP_C_ALL_X, OP_CALL_WITH_EXIT, HOP_CALL_WITH_EXIT, OP_C_CATCH, HOP_C_CATCH, OP_C_CATCH_ALL, HOP_C_CATCH_ALL,
+ OP_C_S_opSq, HOP_C_S_opSq, OP_C_S_opCq, HOP_C_S_opCq, OP_C_SS, HOP_C_SS,
+ OP_C_S, HOP_C_S, OP_READ_S, HOP_READ_S, OP_C_P, HOP_C_P, OP_C_Z, HOP_C_Z, OP_C_SP, HOP_C_SP,
+ OP_C_SZ, HOP_C_SZ, OP_C_A, HOP_C_A, OP_C_SCS, HOP_C_SCS,
+
+ OP_GOTO, HOP_GOTO, OP_GOTO_C, HOP_GOTO_C, OP_GOTO_S, HOP_GOTO_S, OP_GOTO_A, HOP_GOTO_A,
+
+ OP_VECTOR_C, HOP_VECTOR_C, OP_VECTOR_S, HOP_VECTOR_S, OP_VECTOR_A, HOP_VECTOR_A, OP_VECTOR_CC, HOP_VECTOR_CC,
+ OP_STRING_C, HOP_STRING_C, OP_STRING_S, HOP_STRING_S, OP_STRING_A, HOP_STRING_A,
+ OP_C_OBJECT, HOP_C_OBJECT, OP_C_OBJECT_C, HOP_C_OBJECT_C, OP_C_OBJECT_S, HOP_C_OBJECT_S, OP_C_OBJECT_A, HOP_C_OBJECT_A,
+ OP_PAIR_C, HOP_PAIR_C, OP_PAIR_S, HOP_PAIR_S, OP_PAIR_A, HOP_PAIR_A,
+ OP_HASH_TABLE_C, HOP_HASH_TABLE_C, OP_HASH_TABLE_S, HOP_HASH_TABLE_S, OP_HASH_TABLE_A, HOP_HASH_TABLE_A,
+ OP_ENVIRONMENT_S, HOP_ENVIRONMENT_S, OP_ENVIRONMENT_Q, HOP_ENVIRONMENT_Q, OP_ENVIRONMENT_A, HOP_ENVIRONMENT_A, OP_ENVIRONMENT_C, HOP_ENVIRONMENT_C,
+
+ OP_UNKNOWN, HOP_UNKNOWN, OP_UNKNOWN_ALL_S, HOP_UNKNOWN_ALL_S, OP_UNKNOWN_ALL_X, HOP_UNKNOWN_ALL_X,
+ OP_UNKNOWN_G, HOP_UNKNOWN_G, OP_UNKNOWN_GG, HOP_UNKNOWN_GG, OP_UNKNOWN_A, HOP_UNKNOWN_A, OP_UNKNOWN_AA, HOP_UNKNOWN_AA,
+
+ OP_SAFE_C_PP, HOP_SAFE_C_PP,
+ OP_SAFE_C_opSq_P, HOP_SAFE_C_opSq_P,
+ OP_SAFE_C_SP, HOP_SAFE_C_SP, OP_SAFE_C_CP, HOP_SAFE_C_CP, OP_SAFE_C_QP, HOP_SAFE_C_QP, OP_SAFE_C_AP, HOP_SAFE_C_AP,
+ OP_SAFE_C_PS, HOP_SAFE_C_PS, OP_SAFE_C_PC, HOP_SAFE_C_PC, OP_SAFE_C_PQ, HOP_SAFE_C_PQ,
+ OP_SAFE_C_SSP, HOP_SAFE_C_SSP,
+ OPT_MAX_DEFINED
+};
+#if DEBUGGING || OP_NAMES
+
+static const char *op_names[OP_MAX_DEFINED_1] = {
+ "no_op",
+ "read_internal", "eval",
+ "eval_args", "eval_args1", "eval_args2", "eval_args3", "eval_args4", "eval_args5",
+ "apply", "eval_macro", "lambda", "quote", "macroexpand",
+ "define", "define1", "begin", "begin_unchecked", "begin1",
+ "if", "if1", "when", "when1", "unless", "unless1", "set", "set1", "set2",
+ "let", "let1", "let_star", "let_star1", "let_star2",
+ "letrec", "letrec1", "letrec_star", "letrec_star1", "cond", "cond1", "cond_simple", "cond1_simple",
+ "and", "and1", "or", "or1",
+ "define_macro", "define_macro_star", "define_expansion",
+ "case", "case1", "read_list", "read_next", "read_dot", "read_quote",
+ "read_quasiquote", "read_quasiquote_vector", "read_unquote", "read_apply_values",
+ "read_vector", "read_byte_vector", "read_done",
+ "load_return_if_eof", "load_close_and_pop_if_eof", "eval_string", "eval_done",
+ "catch", "dynamic_wind", "define_constant", "define_constant1",
+ "do", "do_end", "do_end1", "do_step", "do_step2", "do_init",
+ "define_star", "lambda_star", "lambda_star_default", "error_quit", "unwind_input", "unwind_output",
+ "error_hook_quit",
+ "with_let", "with_let1", "with_let_unchecked", "with_let_s",
+ "with_baffle", "with_baffle_unchecked", "expansion",
+ "for_each", "for_each_1", "for_each_2", "for_each_3",
+ "map", "map_1", "map_gather", "map_gather_1", "barrier", "deactivate_goto",
+
+ "define_bacro", "define_bacro_star",
+ "get_output_string", "get_output_string_1",
+ "sort", "sort1", "sort2", "sort3", "sort_pair_end", "sort_vector_end", "sort_string_end",
+ "eval_string_1", "eval_string_2",
+ "member_if", "assoc_if", "member_if1", "assoc_if1",
+
+ "quote_unchecked", "lambda_unchecked", "let_unchecked", "case_unchecked", "when_unchecked", "unless_unchecked",
+
+ "set_unchecked", "set_symbol_c", "set_symbol_s", "set_symbol_q", "set_symbol_p", "set_symbol_z", "set_symbol_a",
+ "set_symbol_opsq", "set_symbol_opcq", "set_symbol_opssq", "set_symbol_opsssq",
+ "set_normal", "set_pair", "set_pair_z", "set_pair_a", "set_pair_p", "set_pair_za",
+ "set_pair_p_1", "set_with_accessor", "set_pws", "set_let_s", "set_let_all_x",
+ "set_pair_c", "set_pair_c_p", "set_pair_c_p_1", "set_safe",
+ "increment_1", "decrement_1", "set_cons",
+ "increment_ss", "increment_sss", "increment_sz", "increment_sa", "increment_saa",
+
+ "let_star_unchecked", "letrec_unchecked", "letrec_star_unchecked", "cond_unchecked",
+ "lambda_star_unchecked", "do_unchecked", "define_unchecked", "define_star_unchecked", "define_funchecked", "define_constant_unchecked",
+ "define_with_accessor", "define_macro_with_accessor",
+
+ "let_no_vars", "named_let", "named_let_no_vars", "named_let_star",
+ "let_c", "let_s", "let_all_c", "let_all_s", "let_all_x",
+ "let_star_all_x", "let_opcq", "let_opssq",
+ "let_opsq", "let_all_opsq", "let_opsq_p", "let_one", "let_one_1", "let_z", "let_z_1",
+
+ "case_simple", "case_simpler", "case_simpler_1", "case_simpler_ss", "case_simplest", "case_simplest_ss",
+ "if_unchecked", "and_unchecked", "and_p", "and_p1", "and_p2", "or_unchecked", "or_p", "or_p1", "or_p2",
+ "if_p_feed", "if_p_feed_1", "when_s", "unless_s",
+
+ "if_s_p", "if_s_p_p", "if_not_s_p", "if_not_s_p_p", "if_cc_p", "if_cc_p_p",
+ "if_cs_p", "if_cs_p_p", "if_csq_p", "if_csq_p_p", "if_css_p", "if_css_p_p",
+ "if_csc_p", "if_csc_p_p", "if_is_pair_p", "if_is_pair_p_p", "if_opssq_p", "if_opssq_p_p", "if_s_opcq_p", "if_s_opcq_p_p",
+ "if_is_symbol_p", "if_is_symbol_p_p", "if_a_p", "if_a_p_p", "if_and2_p", "if_and2_p_p",
+ "if_z_p", "if_z_p_p", "if_p_p_p", "if_p_p", "if_andp_p", "if_andp_p_p", "if_orp_p", "if_orp_p_p",
+ "if_ppp", "if_pp",
+
+ "catch_1", "catch_2", "catch_all", "cond_all_x", "cond_all_x_2", "cond_s",
+ "simple_do", "simple_do_step", "safe_dotimes", "safe_dotimes_step", "safe_dotimes_step_p", "safe_dotimes_step_o", "safe_dotimes_step_a",
+ "safe_do", "safe_do_step", "simple_do_p", "simple_do_step_p", "dox", "dox_step", "dox_step_p",
+ "dotimes_p", "dotimes_step_p", "simple_do_a", "simple_do_step_a", "simple_do_e", "simple_do_step_e",
+
+ "safe_c_p_1", "safe_c_pp_1", "safe_c_pp_2", "safe_c_pp_3", "safe_c_pp_4", "safe_c_pp_5", "safe_c_pp_6",
+ "eval_args_p_2", "eval_args_p_2_mv", "eval_args_p_3", "eval_args_p_4", "eval_args_p_3_mv", "eval_args_p_4_mv",
+ "eval_args_ssp_1", "eval_args_ssp_mv", "eval_macro_mv", "macroexpand_1",
+
+ "safe_c_zz_1", "safe_c_zz_2", "safe_c_zc_1", "safe_c_sz_1", "safe_c_za_1", "increment_sz_1", "safe_c_sz_sz",
+ "safe_c_zaa_1", "safe_c_aza_1", "safe_c_aaz_1", "safe_c_ssz_1",
+ "safe_c_zza_1", "safe_c_zza_2", "safe_c_zaz_1", "safe_c_zaz_2", "safe_c_azz_1", "safe_c_azz_2",
+ "safe_c_zzz_1", "safe_c_zzz_2", "safe_c_zzz_3",
+
+ "safe_c_opsq_p_1", "safe_c_opsq_p_mv", "c_p_1", "c_p_2", "c_sp_1", "c_sp_2",
+ "closure_p_1", "closure_p_2", "safe_closure_p_1",
+};
-s7_pointer s7_eof_object(s7_scheme *sc) /* returns #<eof> -- not equivalent to "eof-object?" */
-{
- return(sc->EOF_OBJECT);
-}
+static const char* opt_names[OPT_MAX_DEFINED] =
+ {"safe_c_c", "h_safe_c_c", "safe_c_s", "h_safe_c_s",
+ "safe_c_ss", "h_safe_c_ss", "safe_c_sc", "h_safe_c_sc", "safe_c_cs", "h_safe_c_cs",
+ "safe_c_q", "h_safe_c_q", "safe_c_sq", "h_safe_c_sq", "safe_c_qs", "h_safe_c_qs", "safe_c_qq", "h_safe_c_qq",
+ "safe_c_cq", "h_safe_c_cq", "safe_c_qc", "h_safe_c_qc",
+ "safe_c_sss", "h_safe_c_sss", "safe_c_scs", "h_safe_c_scs", "safe_c_ssc", "h_safe_c_ssc", "safe_c_css", "h_safe_c_css",
+ "safe_c_scc", "h_safe_c_scc", "safe_c_csc", "h_safe_c_csc",
+ "safe_c_all_s", "h_safe_c_all_s", "safe_c_all_x", "h_safe_c_all_x", "safe_c_ssa", "h_safe_c_ssa", "safe_c_sas", "h_safe_c_sas",
+ "safe_c_csa", "h_safe_c_csa", "safe_c_sca", "h_safe_c_sca", "safe_c_cas", "h_safe_c_cas",
+ "safe_c_a", "h_safe_c_a", "safe_c_aa", "h_safe_c_aa", "safe_c_aaa", "h_safe_c_aaa", "safe_c_aaaa", "h_safe_c_aaaa",
+ "safe_c_sqs", "h_safe_c_sqs", "safe_c_opaq", "h_safe_c_opaq", "safe_c_opaaq", "h_safe_c_opaaq", "safe_c_opaaaq", "h_safe_c_opaaaq",
+ "safe_c_s_opaq", "h_safe_c_s_opaq", "safe_c_s_opaaq", "h_safe_c_s_opaaq", "safe_c_s_opaaaq", "h_safe_c_s_opaaaq",
+
+ "safe_c_opcq", "h_safe_c_opcq", "safe_c_opsq", "h_safe_c_opsq",
+ "safe_c_opssq", "h_safe_c_opssq", "safe_c_opscq", "h_safe_c_opscq", "safe_c_opsqq", "h_safe_c_opsqq",
+ "safe_c_opcsq", "h_safe_c_opcsq", "safe_c_s_opsq", "h_safe_c_s_opsq",
+ "safe_c_c_opscq", "h_safe_c_c_opscq",
+ "safe_c_s_opscq", "h_safe_c_s_opscq", "safe_c_s_opcsq", "h_safe_c_s_opcsq",
+ "safe_c_opsq_s", "h_safe_c_opsq_s", "safe_c_opsq_c", "h_safe_c_opsq_c",
+ "safe_c_opsq_opsq", "h_safe_c_opsq_opsq", "safe_c_s_opssq", "h_safe_c_s_opssq", "safe_c_c_opsq", "h_safe_c_c_opsq",
+ "safe_c_c_opcsq", "h_safe_c_c_opcsq", "safe_c_opcsq_c", "h_safe_c_opcsq_c",
+ "safe_c_s_opcq", "h_safe_c_s_opcq", "safe_c_opssq_c", "h_safe_c_opssq_c", "safe_c_c_opssq", "h_safe_c_c_opssq",
+ "safe_c_c_opcq", "h_safe_c_c_opcq", "safe_c_opcq_s", "h_safe_c_opcq_s",
+ "safe_c_opcq_opcq", "h_safe_c_opcq_opcq", "safe_c_opcq_c", "h_safe_c_opcq_c",
+ "safe_c_opscq_opscq", "h_safe_c_opscq_opscq", "safe_c_opssq_opssq", "h_safe_c_opssq_opssq",
+ "safe_c_opssq_opcq", "h_safe_c_opssq_opcq", "safe_c_opssq_opsq", "h_safe_c_opssq_opsq", "safe_c_opsq_opssq", "h_safe_c_opsq_opssq",
+ "safe_c_opssq_s", "h_safe_c_opssq_s", "safe_c_opscq_s", "h_safe_c_opscq_s", "safe_c_opcsq_s", "h_safe_c_opcsq_s",
+ "safe_c_opscq_c", "h_safe_c_opscq_c", "safe_c_opcq_opssq", "h_safe_c_opcq_opssq",
+ "safe_c_s_op_opssq_sq", "h_safe_c_s_op_opssq_sq", "safe_c_s_op_s_opssqq", "h_safe_c_s_op_s_opssqq",
+ "safe_c_op_opssq_q_c", "h_safe_c_op_opssq_q_c", "safe_c_op_opsq_q_c", "h_safe_c_op_opsq_q_c",
+ "safe_c_op_opssq_q_s", "h_safe_c_op_opssq_q_s", "safe_c_op_opsq_q_s", "h_safe_c_op_opsq_q_s",
+ "safe_c_s_op_opssq_opssqq", "h_safe_c_s_op_opssq_opssqq",
+ "safe_c_op_opsq_q", "h_safe_c_op_opsq_q", "safe_c_c_op_s_opcqq", "h_safe_c_c_op_s_opcqq",
+ "safe_c_op_s_opsq_q", "h_safe_c_op_s_opsq_q",
+
+ "safe_c_z", "h_safe_c_z", "safe_c_zz", "h_safe_c_zz", "safe_c_sz", "h_safe_c_sz", "safe_c_zs", "h_safe_c_zs",
+ "safe_c_cz", "h_safe_c_cz", "safe_c_zc", "h_safe_c_zc",
+ "safe_c_opcq_z", "h_safe_c_opcq_z", "safe_c_s_opszq", "h_safe_c_s_opszq",
+ "safe_c_az", "h_safe_c_az", "safe_c_za", "h_safe_c_za",
+ "safe_c_zaa", "h_safe_c_zaa", "safe_c_aza", "h_safe_c_aza", "safe_c_aaz", "h_safe_c_aaz", "safe_c_ssz", "h_safe_c_ssz",
+ "safe_c_zza", "h_safe_c_zza", "safe_c_zaz", "h_safe_c_zaz", "safe_c_azz", "h_safe_c_azz",
+ "safe_c_zzz", "h_safe_c_zzz",
+
+ "thunk", "h_thunk",
+ "closure_s", "h_closure_s", "closure_c", "h_closure_c", "closure_q", "h_closure_q",
+ "closure_ss", "h_closure_ss", "closure_sc", "h_closure_sc", "closure_cs", "h_closure_cs",
+ "closure_a", "h_closure_a", "closure_aa", "h_closure_aa",
+ "closure_all_x", "h_closure_all_x", "closure_all_s", "h_closure_all_s",
+
+ "glosure_a", "h_glosure_a", "glosure_s", "h_glosure_s", "glosure_p", "h_glosure_p",
+
+ "closure_star_s", "h_closure_star_s", "closure_star_sx", "h_closure_star_sx",
+ "closure_star", "h_closure_star", "closure_star_all_x", "h_closure_star_all_x",
+
+ "safe_thunk", "h_safe_thunk", "safe_thunk_e", "h_safe_thunk_e", "safe_thunk_p", "h_safe_thunk_p",
+ "safe_closure_s", "h_safe_closure_s", "safe_closure_c", "h_safe_closure_c", "safe_closure_q", "h_safe_closure_q",
+ "safe_closure_ss", "h_safe_closure_ss", "safe_closure_sc", "h_safe_closure_sc", "safe_closure_cs", "h_safe_closure_cs",
+ "safe_closure_a", "h_safe_closure_a", "safe_closure_sa", "h_safe_closure_sa", "safe_closure_s_p", "h_safe_closure_s_p",
+ "safe_closure_saa", "h_safe_closure_saa",
+ "safe_closure_all_x", "h_safe_closure_all_x", "safe_closure_aa", "h_safe_closure_aa",
+
+ "safe_glosure_a", "h_safe_glosure_a", "safe_glosure_s", "h_safe_glosure_s", "safe_glosure_s_e", "h_safe_glosure_s_e",
+ "safe_glosure_p", "h_safe_glosure_p",
+
+ "safe_closure_star_s", "h_safe_closure_star_s", "safe_closure_star_ss", "h_safe_closure_star_ss",
+ "safe_closure_star_sc", "h_safe_closure_star_sc", "safe_closure_star_sa", "h_safe_closure_star_sa", "safe_closure_star_s0", "h_safe_closure_star_s0",
+ "safe_closure_star", "h_safe_closure_star", "safe_closure_star_all_x", "h_safe_closure_star_all_x",
+
+ "apply_ss", "h_apply_ss",
+ "c_all_x", "h_c_all_x", "call_with_exit", "h_call_with_exit", "c_catch", "h_c_catch", "c_catch_all", "h_c_catch_all",
+ "c_s_opsq", "h_c_s_opsq", "c_s_opcq", "h_c_s_opcq", "c_ss", "h_c_ss",
+ "c_s", "h_c_s", "read_s", "h_read_s", "c_p", "h_c_p", "c_z", "h_c_z", "c_sp", "h_c_sp",
+ "c_sz", "h_c_sz", "c_a", "h_c_a", "c_scs", "h_c_scs",
+
+ "goto", "h_goto", "goto_c", "h_goto_c", "goto_s", "h_goto_s", "goto_a", "h_goto_a",
+ "vector_c", "h_vector_c", "vector_s", "h_vector_s", "vector_a", "h_vector_a", "vector_cc", "h_vector_cc",
+ "string_c", "h_string_c", "string_s", "h_string_s", "string_a", "h_string_a",
+ "c_object", "h_c_object", "c_object_c", "h_c_object_c", "c_object_s", "h_c_object_s", "c_object_a", "h_c_object_a",
+ "pair_c", "h_pair_c", "pair_s", "h_pair_s", "pair_a", "h_pair_a",
+ "hash_table_c", "h_hash_table_c", "hash_table_s", "h_hash_table_s", "hash_table_a", "h_hash_table_a",
+ "environment_s", "h_environment_s", "environment_q", "h_environment_q", "environment_a", "h_environment_a", "environment_c", "h_environment_c",
+
+ "unknown", "h_unknown", "unknown_all_s", "h_unknown_all_s", "unknown_all_x", "h_unknown_all_x",
+ "unknown_g", "h_unknown_g", "unknown_gg", "h_unknown_gg", "unknown_a", "h_unknown_a", "unknown_aa", "h_unknown_aa",
+
+ "safe_c_pp", "h_safe_c_pp",
+ "safe_c_opsq_p", "h_safe_c_opsq_p",
+ "safe_c_sp", "h_safe_c_sp", "safe_c_cp", "h_safe_c_cp", "safe_c_qp", "h_safe_c_qp", "safe_c_ap", "h_safe_c_ap",
+ "safe_c_ps", "h_safe_c_ps", "safe_c_pc", "h_safe_c_pc", "safe_c_pq", "h_safe_c_pq",
+ "safe_c_ssp", "h_safe_c_ssp",
+};
+#endif
+#define is_safe_c_op(op) (op < OP_THUNK) /* used only in safe_stepper */
+#define is_unknown_op(op) ((op >= OP_UNKNOWN) && (op < OP_SAFE_C_PP))
+#define is_callable_c_op(op) ((op < OP_THUNK) || (op > OP_UNKNOWN_AA)) /* used only in check_set */
-static s7_pointer g_not(s7_scheme *sc, s7_pointer args)
+static bool is_h_optimized(s7_pointer p)
{
- #define H_not "(not obj) returns #t if obj is #f, otherwise #t: (not '()) -> #f"
- return(make_boolean(sc, is_false(sc, car(args))));
+ return((is_optimized(p)) &&
+ ((optimize_op(p) & 1) != 0) &&
+ (!is_unknown_op(optimize_op(p))));
}
-
-bool s7_boolean(s7_scheme *sc, s7_pointer x)
-{
- return(x != sc->F);
-}
+#define is_h_safe_c_c(P) ((is_optimized(P)) && (optimize_op(P) == HOP_SAFE_C_C))
+#define is_h_safe_c_s(P) ((is_optimized(P)) && (optimize_op(P) == HOP_SAFE_C_S))
+#define is_safe_c_s(P) ((is_optimized(P)) && (op_no_hop(P) == OP_SAFE_C_S))
-bool s7_is_boolean(s7_pointer x)
-{
- return(type(x) == T_BOOLEAN);
-}
+#define WITH_COUNTS 0
+#if WITH_COUNTS
+ #include "profile.h"
+#endif
-s7_pointer s7_make_boolean(s7_scheme *sc, bool x)
+static int position_of(s7_pointer p, s7_pointer args)
{
- return(make_boolean(sc, x));
+ int i;
+ for (i = 1; p != args; i++, args = cdr(args));
+ return(i);
}
-
-static s7_pointer g_is_boolean(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_method(s7_scheme *sc, s7_pointer obj, s7_pointer method)
{
- #define H_is_boolean "(boolean? obj) returns #t if obj is #f or #t: (boolean? '()) -> #f"
- return(s7_make_boolean(sc, s7_is_boolean(car(args))));
+ if (has_methods(obj))
+ return(find_method(sc, find_let(sc, obj), method));
+ return(sc->UNDEFINED);
}
-bool s7_is_constant(s7_pointer p)
-{
- /* this means "always evaluates to the same thing", sort of
- * not "evaluates to itself":
- * (let ((x 'x)) (and (not (constant? x)) (equal? x (eval x))))
- * (and (constant? (list + 1)) (not (equal? (list + 1) (eval (list + 1)))))
- */
- return((type(p) != T_SYMBOL) ||
- ((typeflag(p) & (T_KEYWORD | T_IMMUTABLE)) != 0));
-}
+/* if a method is shadowing a built-in like abs, it should expect the same args as abs and
+ * behave the same -- no multiple values etc.
+ */
+#define check_method(Sc, Obj, Method, Args) \
+ { \
+ s7_pointer func; \
+ if ((has_methods(Obj)) && ((func = find_method(Sc, find_let(Sc, Obj), Method)) != Sc->UNDEFINED)) \
+ return(s7_apply_function(Sc, func, Args)); \
+ }
+#define check_two_methods(Sc, Obj, Method1, Method2, Args) \
+ if (has_methods(Obj)) \
+ { \
+ s7_pointer func; \
+ func = find_method(Sc, find_let(Sc, Obj), Method1); \
+ if ((func == Sc->UNDEFINED) && (Method1 != Method2) && (Method2)) func = find_method(Sc, find_let(Sc, Obj), Method2); \
+ if (func != Sc->UNDEFINED) return(s7_apply_function(Sc, func, Args)); \
+ }
-static s7_pointer g_is_constant(s7_scheme *sc, s7_pointer args)
+static s7_pointer check_values(s7_scheme *sc, s7_pointer obj, s7_pointer args)
{
- #define H_is_constant "(constant? obj) returns #t if obj is a constant (unsettable): (constant? pi) -> #t"
- return(s7_make_boolean(sc, s7_is_constant(car(args))));
+ check_method(sc, obj, sc->VALUES, args);
+ return(sc->GC_NIL);
}
+/* unfortunately, in the simplest cases, where a function (like number?) accepts any argument,
+ * this costs about a factor of 1.5 in speed (we're doing the normal check like s7_is_number,
+ * but then have to check has_methods before returning #f). We can't use the old form until
+ * openlet is seen because the prior code might use #_number? which gets the value
+ * before the switch. These simple functions normally do not dominate timing info, so I'll
+ * go ahead. It's mostly boilerplate:
+ */
+#define check_boolean_method(Sc, Checker, Method, Args) \
+ { \
+ s7_pointer p; \
+ p = car(Args); \
+ if (Checker(p)) return(Sc->T); \
+ check_method(Sc, p, Method, Args); \
+ return(Sc->F); \
+ }
+#define check_boolean_not_method(Sc, Checker, Method, Args) \
+ { \
+ s7_pointer p, func; \
+ p = find_symbol_checked(Sc, cadar(Args)); \
+ if (Checker(p)) return(Sc->F); \
+ if ((has_methods(p)) && ((func = find_method(Sc, find_let(Sc, p), Method)) != Sc->UNDEFINED) && \
+ (s7_apply_function(Sc, func, list_1(Sc, p)) != Sc->F)) \
+ return(Sc->F); \
+ return(Sc->T); \
+ }
-/* -------------------------------- GC -------------------------------- */
-
-#if HAVE_PTHREADS
-static pthread_mutex_t protected_objects_lock = PTHREAD_MUTEX_INITIALIZER;
-#endif
+ #define method_or_bust(Sc, Obj, Method, Args, Type, Num) \
+ { \
+ s7_pointer func; \
+ if ((has_methods(Obj)) && ((func = find_method(Sc, find_let(Sc, Obj), Method)) != Sc->UNDEFINED)) \
+ return(s7_apply_function(Sc, func, Args)); \
+ if (Num == 0) return(simple_wrong_type_argument(Sc, Method, Obj, Type)); \
+ return(wrong_type_argument(Sc, Method, Num, Obj, Type)); \
+ }
+#define method_or_bust_with_type(Sc, Obj, Method, Args, Type, Num) \
+ { \
+ s7_pointer func; \
+ if ((has_methods(Obj)) && ((func = find_method(Sc, find_let(Sc, Obj), Method)) != Sc->UNDEFINED)) \
+ return(s7_apply_function(Sc, func, Args)); \
+ if (Num == 0) return(simple_wrong_type_argument_with_type(Sc, Method, Obj, Type)); \
+ return(wrong_type_argument_with_type(Sc, Method, Num, Obj, Type)); \
+ }
-int s7_gc_protect(s7_scheme *sc, s7_pointer x)
-{
- int i, loc, new_size;
-
-#if HAVE_PTHREADS
- pthread_mutex_lock(&protected_objects_lock);
-#endif
- if (vector_element(sc->protected_objects, (*(sc->protected_objects_loc))) == sc->NIL)
- {
- vector_element(sc->protected_objects, (*(sc->protected_objects_loc))) = x;
- loc = (*(sc->protected_objects_loc))++;
- if ((*(sc->protected_objects_loc)) >= (*(sc->protected_objects_size)))
- (*(sc->protected_objects_loc)) = 0;
- {
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&protected_objects_lock);
-#endif
- return(loc);
- }
- }
-
- loc = (*(sc->protected_objects_size));
- for (i = 0; i < loc; i++)
- if (vector_element(sc->protected_objects, i) == sc->NIL)
- {
- vector_element(sc->protected_objects, i) = x;
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&protected_objects_lock);
-#endif
- return(i);
- }
-
- new_size = 2 * loc;
+#define eval_error_any(Sc, ErrType, ErrMsg, Obj) \
+ do {static s7_pointer _Err_ = NULL; if (!_Err_) _Err_ = s7_make_permanent_string(ErrMsg); \
+ return(s7_error(Sc, ErrType, set_elist_2(Sc, _Err_, Obj)));} while (0)
- vector_elements(sc->protected_objects) = (s7_pointer *)realloc(vector_elements(sc->protected_objects), new_size * sizeof(s7_pointer));
- for (i = loc; i < new_size; i++)
- vector_element(sc->protected_objects, i) = sc->NIL;
- vector_length(sc->protected_objects) = new_size;
- (*(sc->protected_objects_size)) = new_size;
+#define eval_error(Sc, ErrMsg, Obj) eval_error_any(Sc, Sc->SYNTAX_ERROR, ErrMsg, Obj)
+#define eval_type_error(Sc, ErrMsg, Obj) eval_error_any(Sc, Sc->WRONG_TYPE_ARG, ErrMsg, Obj)
+#define eval_range_error(Sc, ErrMsg, Obj) eval_error_any(Sc, Sc->OUT_OF_RANGE, ErrMsg, Obj)
- vector_element(sc->protected_objects, loc) = x;
-
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&protected_objects_lock);
-#endif
- return(loc);
-}
+#define eval_error_no_return(Sc, ErrType, ErrMsg, Obj) \
+ do {static s7_pointer _Err_ = NULL; \
+ if (!_Err_) _Err_ = s7_make_permanent_string(ErrMsg); \
+ s7_error(Sc, ErrType, set_elist_2(Sc, _Err_, Obj));} while (0)
+#define eval_error_with_caller(Sc, ErrMsg, Caller, Obj) \
+ do {static s7_pointer _Err_ = NULL; \
+ if (!_Err_) _Err_ = s7_make_permanent_string(ErrMsg); \
+ return(s7_error(Sc, Sc->SYNTAX_ERROR, set_elist_3(Sc, _Err_, Caller, Obj)));} while (0)
-void s7_gc_unprotect(s7_scheme *sc, s7_pointer x)
+static s7_pointer set_elist_1(s7_scheme *sc, s7_pointer x1)
{
- int i;
+ car(sc->elist_1) = x1;
+ return(sc->elist_1);
+}
-#if HAVE_PTHREADS
- pthread_mutex_lock(&protected_objects_lock);
-#endif
+static s7_pointer set_elist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
+{
+ car(sc->elist_2) = x1;
+ cadr(sc->elist_2) = x2;
+ return(sc->elist_2);
+}
- for (i = 0; i < (*(sc->protected_objects_size)); i++)
- if (vector_element(sc->protected_objects, i) == x)
- {
- vector_element(sc->protected_objects, i) = sc->NIL;
- (*(sc->protected_objects_loc)) = i;
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&protected_objects_lock);
-#endif
- return;
- }
+static s7_pointer set_elist_3(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3)
+{
+ s7_pointer p;
+ p = sc->elist_3;
+ car(p) = x1; p = cdr(p);
+ car(p) = x2; p = cdr(p);
+ car(p) = x3;
+ return(sc->elist_3);
+}
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&protected_objects_lock);
-#endif
-}
+static s7_pointer set_elist_4(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4)
+{
+ s7_pointer p;
+ p = sc->elist_4;
+ car(p) = x1; p = cdr(p);
+ car(p) = x2; p = cdr(p);
+ car(p) = x3; p = cdr(p);
+ car(p) = x4;
+ return(sc->elist_4);
+}
+static s7_pointer set_elist_5(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4, s7_pointer x5)
+{
+ s7_pointer p;
+ p = sc->elist_5;
+ car(p) = x1; p = cdr(p);
+ car(p) = x2; p = cdr(p);
+ car(p) = x3; p = cdr(p);
+ car(p) = x4; p = cdr(p);
+ car(p) = x5;
+ return(sc->elist_5);
+}
-void s7_gc_unprotect_at(s7_scheme *sc, int loc)
+static s7_pointer set_wlist_3(s7_scheme *sc, s7_pointer lst, s7_pointer x1, s7_pointer x2, s7_pointer x3)
{
-#if HAVE_PTHREADS
- pthread_mutex_lock(&protected_objects_lock);
-#endif
+ s7_pointer p;
+ p = lst;
+ car(p) = x1; p = cdr(p);
+ car(p) = x2; p = cdr(p);
+ car(p) = x3;
+ return(lst);
+}
- if ((loc >= 0) &&
- (loc < (*(sc->protected_objects_size))))
- {
- vector_element(sc->protected_objects, loc) = sc->NIL;
- (*(sc->protected_objects_loc)) = loc;
- }
+static s7_pointer set_wlist_4(s7_scheme *sc, s7_pointer lst, s7_pointer x1, s7_pointer x2, s7_pointer x3, s7_pointer x4)
+{
+ s7_pointer p;
+ p = lst;
+ car(p) = x1; p = cdr(p);
+ car(p) = x2; p = cdr(p);
+ car(p) = x3; p = cdr(p);
+ car(p) = x4;
+ return(lst);
+}
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&protected_objects_lock);
-#endif
-}
+static s7_pointer set_plist_1(s7_scheme *sc, s7_pointer x1)
+{
+ car(sc->plist_1) = x1;
+ return(sc->plist_1);
+}
+static s7_pointer set_plist_2(s7_scheme *sc, s7_pointer x1, s7_pointer x2)
+{
+ car(sc->plist_2) = x1;
+ cadr(sc->plist_2) = x2;
+ return(sc->plist_2);
+}
-s7_pointer s7_gc_protected_at(s7_scheme *sc, int loc)
+static s7_pointer set_plist_3(s7_scheme *sc, s7_pointer x1, s7_pointer x2, s7_pointer x3)
{
- s7_pointer obj;
- obj = sc->UNSPECIFIED;
+ return(set_wlist_3(sc, sc->plist_3, x1, x2, x3));
+}
-#if HAVE_PTHREADS
- pthread_mutex_lock(&protected_objects_lock);
-#endif
+/* an experiment */
+s7_pointer s7_set_plist_1(s7_scheme *sc, s7_pointer x1) {return(set_plist_1(sc, x1));}
- if ((loc >= 0) &&
- (loc < (*(sc->protected_objects_size))))
- obj = vector_element(sc->protected_objects, loc);
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&protected_objects_lock);
-#endif
+/* -------------------------------- constants -------------------------------- */
- return(obj);
+s7_pointer s7_f(s7_scheme *sc)
+{
+ return(sc->F);
}
-static void finalize_s7_cell(s7_scheme *sc, s7_pointer a)
+s7_pointer s7_t(s7_scheme *sc)
{
- switch (type(a))
- {
- case T_STRING:
- free(string_value(a)); /* calloc'd in make-*-string */
- break;
-
- case T_INPUT_PORT:
- if (port_needs_free(a))
- {
- if (port_string(a))
- {
- free(port_string(a));
- port_string(a) = NULL;
- }
- port_needs_free(a) = false;
- }
+ return(sc->T);
+}
- if (port_filename(a))
- {
- free(port_filename(a));
- port_filename(a) = NULL;
- }
-
- free(a->object.port);
- break;
-
- case T_OUTPUT_PORT:
- s7_close_output_port(sc, a);
- free(a->object.port);
- break;
-
- case T_C_OBJECT:
- case T_S_OBJECT:
- free_object(a);
- break;
-
- case T_VECTOR:
- if (vector_length(a) > 0)
- {
- if (vector_is_multidimensional(a))
- {
- if (shared_vector(a) == sc->F)
- {
- free(a->object.vector.vextra.dim_info->dims);
- free(a->object.vector.vextra.dim_info->offsets);
- free(vector_elements(a));
- }
- free(a->object.vector.vextra.dim_info);
- }
- else free(vector_elements(a));
- }
- break;
- case T_HASH_TABLE:
- if (hash_table_length(a) > 0)
- free(hash_table_elements(a));
- break;
-
- default:
- break;
- }
+s7_pointer s7_nil(s7_scheme *sc)
+{
+ return(sc->NIL);
}
-static void s7_mark_object_1(s7_pointer p);
+bool s7_is_null(s7_scheme *sc, s7_pointer p)
+{
+ return(is_null(p));
+}
+
-#if defined(__GNUC__) && (!(defined(__cplusplus)))
- #define S7_MARK(Obj) ({ s7_pointer _p_; _p_ = Obj; if (!is_marked(_p_)) {set_mark(_p_); if (!is_simple(_p_)) s7_mark_object_1(_p_);}})
-#else
- #define S7_MARK(Obj) do {if (!is_marked(Obj)) {set_mark(Obj); if (!is_simple(Obj)) s7_mark_object_1(Obj);}} while (0)
-#endif
-/* this is slightly faster than if we first call s7_mark_object, then check the mark bit */
+s7_pointer s7_undefined(s7_scheme *sc)
+{
+ return(sc->UNDEFINED);
+}
-static void mark_vector(s7_pointer p, s7_Int top)
+s7_pointer s7_unspecified(s7_scheme *sc)
{
- s7_pointer *tp, *tend;
+ return(sc->UNSPECIFIED);
+}
- set_mark(p); /* might be called outside s7_mark_object */
- tp = (s7_pointer *)(vector_elements(p));
- if (!tp) return;
- tend = (s7_pointer *)(tp + top);
+bool s7_is_unspecified(s7_scheme *sc, s7_pointer val)
+{
+ return(is_unspecified(val));
+}
- while (tp < tend)
- {
- s7_pointer tmp;
- tmp = (*tp++);
- S7_MARK(tmp);
- }
+
+s7_pointer s7_eof_object(s7_scheme *sc) /* returns #<eof> -- not equivalent to "eof-object?" */
+{
+ return(sc->EOF_OBJECT);
}
-static void s7_mark_object_1(s7_pointer p)
+static s7_pointer g_not(s7_scheme *sc, s7_pointer args)
{
- switch (type(p))
- {
- case T_UNTYPED: /* 0 actually -- a cell still being set up when the GC was triggered */
- return;
+ #define H_not "(not obj) returns #t if obj is #f, otherwise #t: (not ()) -> #f"
+ #define Q_not pl_bt
+ return(make_boolean(sc, is_false(sc, car(args))));
+}
- case T_PAIR:
- if (symbol_has_accessor(p))
- S7_MARK(csr(p));
- S7_MARK(car(p));
- S7_MARK(cdr(p));
- break;
- case T_VECTOR:
- /* mark_vector(p, vector_length(p)); */
-
- /* If a subvector (an inner dimension) of a vector is the only remaining reference
- * to the main vector, we want to make sure the main vector is not GC'd until
- * the subvector is also GC-able. The shared_vector field either points to the
- * parent vector, or it is sc->F, so we need to check for a vector parent if
- * the current is multidimensional (this will include 1-dim slices). We need
- * to keep the parent case separate (i.e. sc->F means the current is the original)
- * so that we only free once (or remove_from_heap once).
- */
+bool s7_boolean(s7_scheme *sc, s7_pointer x)
+{
+ return(x != sc->F);
+}
- if ((vector_is_multidimensional(p)) &&
- (s7_is_vector(shared_vector(p))))
- {
- S7_MARK(shared_vector(p));
- }
- mark_vector(p, vector_length(p));
- return;
- case T_HASH_TABLE:
- mark_vector(p, hash_table_length(p));
- return;
-
- case T_C_OBJECT:
- case T_S_OBJECT:
- mark_embedded_objects(p);
- return;
+bool s7_is_boolean(s7_pointer x)
+{
+ return(type(x) == T_BOOLEAN);
+}
- case T_HOOK:
- S7_MARK(hook_functions(p));
- S7_MARK(hook_arity(p));
- S7_MARK(hook_documentation(p));
- return;
- case T_CONTINUATION:
- mark_vector(continuation_stack(p), continuation_stack_top(p));
- return;
+s7_pointer s7_make_boolean(s7_scheme *sc, bool x)
+{
+ return(make_boolean(sc, x));
+}
- case T_CATCH:
- S7_MARK(catch_tag(p));
- S7_MARK(catch_handler(p));
- return;
- case T_DYNAMIC_WIND:
- S7_MARK(dynamic_wind_in(p));
- S7_MARK(dynamic_wind_out(p));
- S7_MARK(dynamic_wind_body(p));
- return;
+static s7_pointer g_is_boolean(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_boolean "(boolean? obj) returns #t if obj is #f or #t: (boolean? ()) -> #f"
+ #define Q_is_boolean pl_bt
+ check_boolean_method(sc, s7_is_boolean, sc->IS_BOOLEAN, args);
+}
- default:
- /* closures of various kinds primarily */
- S7_MARK(car(p));
- S7_MARK(cdr(p));
- break;
- }
+
+bool s7_is_constant(s7_pointer p)
+{
+ /* this means "always evaluates to the same thing", sort of, not "evaluates to itself":
+ * (let ((x 'x)) (and (not (constant? x)) (equal? x (eval x))))
+ * (and (constant? (list + 1)) (not (equal? (list + 1) (eval (list + 1)))))
+ */
+ return((type(p) != T_SYMBOL) || (is_immutable_symbol(p)));
}
-void s7_mark_object(s7_pointer p)
+static s7_pointer g_is_constant(s7_scheme *sc, s7_pointer args)
{
- S7_MARK(p);
+ #define H_is_constant "(constant? obj) returns #t if obj is a constant (unsettable): (constant? pi) -> #t"
+ #define Q_is_constant pl_bt
+ check_boolean_method(sc, s7_is_constant, sc->IS_CONSTANT, args);
}
-#if HAVE_GETTIMEOFDAY && (!_MSC_VER)
- #include <time.h>
- #include <sys/time.h>
- static struct timeval start_time;
- static struct timezone z0;
-#endif
+/* -------------------------------- GC -------------------------------- */
+/* instead of saving the last released location, why not have a free list?
+ * (an int array growable, with a current top and size or whatever)
+ */
-static int gc(s7_scheme *sc)
+#define is_gc_nil(p) ((p) == sc->GC_NIL)
+
+unsigned int s7_gc_protect(s7_scheme *sc, s7_pointer x)
{
- int i;
- s7_cell **old_free_heap_top;
- /* mark all live objects (the symbol table is in permanent memory, not the heap) */
+ unsigned int i, loc, size, new_size;
- if (*(sc->gc_stats))
- {
- fprintf(stdout, "gc ");
-#if HAVE_GETTIMEOFDAY && (!_MSC_VER)
- gettimeofday(&start_time, &z0);
-#endif
- }
+ loc = sc->protected_objects_loc++;
+ size = sc->protected_objects_size;
- S7_MARK(sc->global_env);
- S7_MARK(sc->args);
- S7_MARK(sc->envir);
- S7_MARK(sc->code);
- S7_MARK(sc->cur_code);
- mark_vector(sc->stack, s7_stack_top(sc));
- /* splitting out the stack case saves about 1/2000 total time (we can skip the op etc) */
- S7_MARK(sc->w);
- S7_MARK(sc->x);
- S7_MARK(sc->y);
- S7_MARK(sc->z);
- S7_MARK(sc->value);
+ if (sc->protected_objects_loc >= size)
+ sc->protected_objects_loc = 0;
- S7_MARK(sc->input_port);
- S7_MARK(sc->input_port_stack);
- S7_MARK(sc->output_port);
- S7_MARK(sc->error_port);
+ if (is_gc_nil(vector_element(sc->protected_objects, loc)))
+ {
+ vector_element(sc->protected_objects, loc) = x;
+ return(loc);
+ }
- S7_MARK(sc->protected_objects);
- {
- s7_pointer *tmps;
- tmps = sc->temps;
- for (i = 0; i < sc->temps_size; i++)
- S7_MARK(tmps[i]);
- }
+ for (i = 0; i < size; i++)
+ {
+ if (is_gc_nil(vector_element(sc->protected_objects, i)))
+ {
+ vector_element(sc->protected_objects, i) = x;
+ return(i);
+ }
+ }
- /* free up all unmarked objects */
- old_free_heap_top = sc->free_heap_top;
+ new_size = 2 * size;
+ vector_elements(sc->protected_objects) = (s7_pointer *)realloc(vector_elements(sc->protected_objects), new_size * sizeof(s7_pointer));
+ vector_length(sc->protected_objects) = new_size;
+ for (i = size; i < new_size; i++)
+ vector_element(sc->protected_objects, i) = sc->GC_NIL;
+ sc->protected_objects_size = new_size;
+ sc->protected_objects_loc = size;
- {
- s7_pointer *fp, *tp, *heap_top;
- fp = sc->free_heap_top;
+ vector_element(sc->protected_objects, size) = x;
+ return(size);
+}
- tp = sc->heap;
- heap_top = (s7_pointer *)(sc->heap + sc->heap_size);
+void s7_gc_unprotect(s7_scheme *sc, s7_pointer x)
+{
+ unsigned int i;
- while (tp < heap_top) /* != here or ^ makes no difference */
+ for (i = 0; i < sc->protected_objects_size; i++)
+ if (vector_element(sc->protected_objects, i) == x)
{
- s7_pointer p;
- p = (*tp++);
-
- if (is_marked(p))
- clear_mark(p);
- else
- {
- if (typeflag(p) != 0) /* an already-free object? */
- {
- if (is_finalizable(p))
- finalize_s7_cell(sc, p);
-#if DEBUGGING
- saved_typeflag(p) = typeflag(p);
-#endif
- typeflag(p) = 0; /* (this is needed -- otherwise we try to free some objects twice) */
- (*fp++) = p;
- }
- }
+ vector_element(sc->protected_objects, i) = sc->GC_NIL;
+ sc->protected_objects_loc = i;
+ return;
}
- sc->free_heap_top = fp;
- }
+}
- if (*(sc->gc_stats))
+
+void s7_gc_unprotect_at(s7_scheme *sc, unsigned int loc)
+{
+ if (loc < sc->protected_objects_size)
{
-#if HAVE_GETTIMEOFDAY && (!_MSC_VER)
- struct timeval t0;
- double secs;
- gettimeofday(&t0, &z0);
- secs = (t0.tv_sec - start_time.tv_sec) + 0.000001 * (t0.tv_usec - start_time.tv_usec);
- fprintf(stdout, "freed %d/%d, time: %f\n", (int)(sc->free_heap_top - old_free_heap_top), sc->heap_size, secs);
-#else
- fprintf(stdout, "freed %d/%d\n", (int)(sc->free_heap_top - old_free_heap_top), sc->heap_size);
-#endif
+ vector_element(sc->protected_objects, loc) = sc->GC_NIL;
+ sc->protected_objects_loc = loc;
}
-
- return(sc->free_heap_top - old_free_heap_top); /* needed by cell allocator to decide when to increase heap size */
}
-#define WITH_DUMP_HEAP 0
-#if WITH_DUMP_HEAP
-static s7_pointer g_dump_heap(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_gc_protected_at(s7_scheme *sc, unsigned int loc)
{
- FILE *fd;
- s7_pointer *tp;
- int i;
-
- gc(sc);
+ s7_pointer obj;
- fd = fopen("heap.data", "w");
- for (tp = sc->heap; (*tp); tp++)
- {
- s7_pointer p;
- p = (*tp);
- if (typeflag(p) != 0)
- fprintf(fd, "%s\n", s7_object_to_c_string(sc, p));
- }
+ obj = sc->UNSPECIFIED;
+ if (loc < sc->protected_objects_size)
+ obj = vector_element(sc->protected_objects, loc);
- fprintf(fd, "-------------------------------- temps --------------------------------\n");
- for (i = 0; i < sc->temps_size; i++)
- if (typeflag(sc->temps[i]) != 0)
- fprintf(fd, "%s\n", s7_object_to_c_string(sc, sc->temps[i]));
+ if (obj == sc->GC_NIL)
+ return(sc->UNSPECIFIED);
- fflush(fd);
- fclose(fd);
- return(sc->NIL);
+ return(obj);
}
-#endif
+#define gc_protected_at(Sc, Loc) vector_element(Sc->protected_objects, Loc)
+/* #define gc_reprotect(Sc, Loc, Val) vector_element(Sc->protected_objects, Loc) = Val */
-#if HAVE_PTHREADS
- #define NEW_CELL(Sc, Obj) Obj = new_cell(Sc)
-#else
- #define NEW_CELL(Sc, Obj) \
- do { \
- if (Sc->free_heap_top > Sc->free_heap_trigger) \
- Obj = (*(--(Sc->free_heap_top))); \
- else Obj = new_cell(Sc); \
- } while (0)
-/* not faster:
- #define NEW_CELL(Sc, Obj) do {Obj = ((Sc->free_heap_top > Sc->free_heap_trigger) ? (*(--(Sc->free_heap_top))) : new_cell(Sc);} while (0)
-*/
-#endif
+static void (*mark_function[NUM_TYPES])(s7_pointer p);
-#if HAVE_PTHREADS
-static pthread_mutex_t alloc_lock = PTHREAD_MUTEX_INITIALIZER;
+#define S7_MARK(Obj) do {s7_pointer _p_; _p_ = Obj; if (!is_marked(_p_)) (*mark_function[unchecked_type(_p_)])(_p_);} while (0)
-static s7_pointer new_cell(s7_scheme *nsc)
-#else
-static s7_pointer new_cell(s7_scheme *sc)
-#endif
+static void mark_symbol(s7_pointer p)
{
- s7_pointer p;
-
-#if HAVE_PTHREADS
- s7_scheme *sc;
- pthread_mutex_lock(&alloc_lock);
- /* this is not good. A lot of time can be spent setting this dumb lock.
+ if (is_gensym(p))
+ set_mark(p);
+ /* don't set the mark bit of a normal symbol! It wrecks the check against SYNTACTIC_TYPE,
+ * slowing everything down by a large amount.
*/
- sc = nsc->orig_sc;
-#endif
-
- if (sc->free_heap_top == sc->free_heap)
- {
- /* no free heap */
- unsigned int k, old_size, freed_heap = 0;
-
- if (!(*(sc->gc_off)))
- freed_heap = gc(sc);
- /* when threads, the gc function can be interrupted at any point and resumed later -- mark bits need to be preserved during this interruption */
-
- if (freed_heap < sc->heap_size / 4) /* was 1000, setting it to 2 made no difference in run time */
- {
- /* alloc more heap */
- old_size = sc->heap_size;
-
- if (sc->heap_size < 512000)
- sc->heap_size *= 2;
- else sc->heap_size += 512000;
-
- sc->heap = (s7_cell **)realloc(sc->heap, sc->heap_size * sizeof(s7_cell *));
- if (!(sc->heap))
- fprintf(stderr, "heap reallocation failed! tried to get %lu bytes\n", (unsigned long)(sc->heap_size * sizeof(s7_cell *)));
+}
- sc->free_heap = (s7_cell **)realloc(sc->free_heap, sc->heap_size * sizeof(s7_cell *));
- if (!(sc->free_heap))
- fprintf(stderr, "free heap reallocation failed! tried to get %lu bytes\n", (unsigned long)(sc->heap_size * sizeof(s7_cell *)));
+static void mark_noop(s7_pointer p) {}
- sc->free_heap_trigger = (s7_cell **)(sc->free_heap + GC_TEMPS_SIZE);
- sc->free_heap_top = sc->free_heap;
+/* ports can be alloc'd and freed at a frightening pace, so I think I'll make a special free_list for them. */
- {
- /* optimization suggested by K Matheussen */
- s7_cell *cells = (s7_cell *)calloc(sc->heap_size - old_size, sizeof(s7_cell));
- for (k = old_size; k < sc->heap_size; k++)
- {
- sc->heap[k] = &cells[k - old_size];
- (*sc->free_heap_top++) = sc->heap[k];
- sc->heap[k]->hloc = k;
- }
- }
- }
+static port_t *alloc_port(s7_scheme *sc)
+{
+ if (sc->port_heap)
+ {
+ port_t *p;
+ p = sc->port_heap;
+ sc->port_heap = (port_t *)(p->next);
+ return(p);
}
+ return((port_t *)calloc(1, sizeof(port_t)));
+}
- p = (*(--(sc->free_heap_top)));
-#if HAVE_PTHREADS
- set_type(p, T_SIMPLE);
- /* currently the overall allocation of an object is not locked, so we could
- * return a new cell from new_cell without its fields set yet, set_type to
- * something non-simple, then before setting the fields, be interrupted.
- * The mark/gc stuff then sees a typed object (T_PAIR for example), and
- * tries to mark its cdr (for example) which is probably 0 (not a valid
- * scheme object). So set the type temporarily to T_SIMPLE to avoid that.
- * Ideally, I think, we'd set the type last in all the allocations.
- *
- * I think this is no longer needed.
- */
+static void free_port(s7_scheme *sc, port_t *p)
+{
+ p->next = (void *)(sc->port_heap);
+ sc->port_heap = p;
+}
-#if 0
- /* I don't think this is safe */
- if (sc->free_heap_top <= sc->free_heap_trigger)
-#endif
+static void close_output_port(s7_scheme *sc, s7_pointer p);
+
+static void sweep(s7_scheme *sc)
+{
+ unsigned int i, j;
+ if (sc->strings_loc > 0)
{
- nsc->temps[nsc->temps_ctr++] = p;
- if (nsc->temps_ctr >= nsc->temps_size)
- nsc->temps_ctr = 0;
+ /* unrolling this loop is not an improvement */
+ for (i = 0, j = 0; i < sc->strings_loc; i++)
+ {
+ s7_pointer s1;
+ s1 = sc->strings[i];
+ if (is_free_and_clear(s1))
+ {
+ if (string_needs_free(s1))
+ free(string_value(s1));
+ }
+ else sc->strings[j++] = s1;
+ }
+ sc->strings_loc = j;
}
- pthread_mutex_unlock(&alloc_lock);
-#else
- if (sc->free_heap_top <= sc->free_heap_trigger)
+
+ if (sc->gensyms_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->gensyms_loc; i++)
+ {
+ s7_pointer s1;
+ s1 = sc->gensyms[i];
+ if (is_free_and_clear(s1))
+ {
+ remove_gensym_from_symbol_table(sc, s1); /* this uses symbol_name_cell data */
+ free(symbol_name(s1));
+ if ((is_documented(s1)) &&
+ (symbol_help(s1)))
+ {
+ free(symbol_help(s1));
+ symbol_help(s1) = NULL;
+ }
+ free(symbol_name_cell(s1));
+ }
+ else sc->gensyms[j++] = s1;
+ }
+ sc->gensyms_loc = j;
+ if (j == 0) mark_function[T_SYMBOL] = mark_noop;
+ }
+
+ if (sc->c_objects_loc > 0)
{
- sc->temps[sc->temps_ctr++] = p;
- if (sc->temps_ctr >= sc->temps_size)
- sc->temps_ctr = 0;
+ for (i = 0, j = 0; i < sc->c_objects_loc; i++)
+ {
+ if (is_free_and_clear(sc->c_objects[i]))
+ free_object(sc->c_objects[i]);
+ else sc->c_objects[j++] = sc->c_objects[i];
+ }
+ sc->c_objects_loc = j;
}
-#endif
- /* originally I tried to mark each temporary value until I was done with it, but
- * that way madness lies... By delaying GC of _every_ %$^#%@ pointer, I can dispense
- * with hundreds of individual protections. Using this array of temps is much faster
- * than using a type bit to say "newly allocated" because that protects so many cells
- * betweeen gc calls that we end up calling the gc twice as often overall.
- */
- return(p);
-}
+ if (sc->vectors_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->vectors_loc; i++)
+ {
+ if (is_free_and_clear(sc->vectors[i]))
+ {
+ s7_pointer a;
+ a = sc->vectors[i];
+ /* a multidimensional empty vector can have dimension info, wrapped vectors always have dimension info */
+ if (vector_dimension_info(a))
+ {
+ if (vector_dimensions_allocated(a))
+ {
+ free(vector_dimensions(a));
+ free(vector_offsets(a));
+ }
+ if (vector_elements_allocated(a))
+ free(vector_elements(a)); /* I think this will work for any vector (int/float too) */
+ if (vector_dimension_info(a) != sc->wrap_only)
+ free(vector_dimension_info(a));
+ }
+ else
+ {
+ if (vector_length(a) != 0)
+ free(vector_elements(a));
+ }
+ }
+ else sc->vectors[j++] = sc->vectors[i];
+ /* here (in the else branch) if a vector constant in a global function has been removed from the heap,
+ * not_in_heap(heap_location(v)), and we'll never see it freed, so if there were a lot of these, they might
+ * glom up this loop. Surely not a big deal!?
+ */
+ }
+ sc->vectors_loc = j;
+ }
-static s7_pointer g_gc(s7_scheme *sc, s7_pointer args)
-{
- #define H_gc "(gc (on #t)) runs the garbage collector. If 'on' is supplied, it turns the GC on or off. \
-Evaluation produces a surprising amount of garbage, so don't leave the GC off for very long!"
+ if (sc->hash_tables_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->hash_tables_loc; i++)
+ {
+ if (is_free_and_clear(sc->hash_tables[i]))
+ {
+ if (hash_table_mask(sc->hash_tables[i]) > 0)
+ free_hash_table(sc->hash_tables[i]);
+ }
+ else sc->hash_tables[j++] = sc->hash_tables[i];
+ }
+ sc->hash_tables_loc = j;
+ }
- if (args != sc->NIL)
+ if (sc->input_ports_loc > 0)
{
- if (!s7_is_boolean(car(args)))
- return(s7_wrong_type_arg_error(sc, "gc", 0, car(args), "#f (turn GC off) or #t (turn it on)"));
+ for (i = 0, j = 0; i < sc->input_ports_loc; i++)
+ {
+ if (is_free_and_clear(sc->input_ports[i]))
+ {
+ s7_pointer a;
+ a = sc->input_ports[i];
+ if (port_needs_free(a))
+ {
+ if (port_data(a))
+ {
+ free(port_data(a));
+ port_data(a) = NULL;
+ port_data_size(a) = 0;
+ }
+ port_needs_free(a) = false;
+ }
+
+ if (port_filename(a))
+ {
+ free(port_filename(a));
+ port_filename(a) = NULL;
+ }
+ free_port(sc, port_port(a));
+ }
+ else sc->input_ports[j++] = sc->input_ports[i];
+ }
+ sc->input_ports_loc = j;
+ }
- (*(sc->gc_off)) = (car(args) == sc->F);
- if (*(sc->gc_off)) return(sc->F);
+ if (sc->output_ports_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->output_ports_loc; i++)
+ {
+ if (is_free_and_clear(sc->output_ports[i]))
+ {
+ close_output_port(sc, sc->output_ports[i]); /* needed for free filename, etc */
+ free_port(sc, port_port(sc->output_ports[i]));
+ }
+ else sc->output_ports[j++] = sc->output_ports[i];
+ }
+ sc->output_ports_loc = j;
}
-#if HAVE_PTHREADS
- pthread_mutex_lock(&alloc_lock);
- gc(sc->orig_sc);
- pthread_mutex_unlock(&alloc_lock);
-#else
- {
- int i;
- for (i = 0; i < sc->temps_size; i++)
- sc->temps[i] = sc->NIL;
- }
- gc(sc);
+ if (sc->continuations_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->continuations_loc; i++)
+ {
+ if (is_free_and_clear(sc->continuations[i]))
+ {
+ s7_pointer c;
+ c = sc->continuations[i];
+ if (continuation_op_stack(c))
+ {
+ free(continuation_op_stack(c));
+ continuation_op_stack(c) = NULL;
+ }
+ free(continuation_data(c));
+ }
+ else sc->continuations[j++] = sc->continuations[i];
+ }
+ sc->continuations_loc = j;
+ }
+
+#if WITH_GMP
+ if (sc->bigints_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->bigints_loc; i++)
+ {
+ s7_pointer s1;
+ s1 = sc->bigints[i];
+ if (is_free_and_clear(s1))
+ mpz_clear(big_integer(s1));
+ else sc->bigints[j++] = s1;
+ }
+ sc->bigints_loc = j;
+ }
+
+ if (sc->bigratios_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->bigratios_loc; i++)
+ {
+ s7_pointer s1;
+ s1 = sc->bigratios[i];
+ if (is_free_and_clear(s1))
+ mpq_clear(big_ratio(s1));
+ else sc->bigratios[j++] = s1;
+ }
+ sc->bigratios_loc = j;
+ }
+
+ if (sc->bigreals_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->bigreals_loc; i++)
+ {
+ s7_pointer s1;
+ s1 = sc->bigreals[i];
+ if (is_free_and_clear(s1))
+ mpfr_clear(big_real(s1));
+ else sc->bigreals[j++] = s1;
+ }
+ sc->bigreals_loc = j;
+ }
+
+ if (sc->bignumbers_loc > 0)
+ {
+ for (i = 0, j = 0; i < sc->bignumbers_loc; i++)
+ {
+ s7_pointer s1;
+ s1 = sc->bignumbers[i];
+ if (is_free_and_clear(s1))
+ mpc_clear(big_complex(s1));
+ else sc->bignumbers[j++] = s1;
+ }
+ sc->bignumbers_loc = j;
+ }
#endif
-
- return(sc->UNSPECIFIED);
}
-s7_pointer s7_gc_on(s7_scheme *sc, bool on)
+static void add_string(s7_scheme *sc, s7_pointer p)
{
- (*(sc->gc_off)) = !on;
- return(s7_make_boolean(sc, on));
+ if (sc->strings_loc == sc->strings_size)
+ {
+ sc->strings_size *= 2;
+ sc->strings = (s7_pointer *)realloc(sc->strings, sc->strings_size * sizeof(s7_pointer));
+ }
+ sc->strings[sc->strings_loc++] = p;
}
+#define Add_String(Str) if (sc->strings_loc == sc->strings_size) add_string(sc, Str); else sc->strings[sc->strings_loc++] = Str
+
-static s7_pointer g_gc_stats_set(s7_scheme *sc, s7_pointer args)
+static void add_gensym(s7_scheme *sc, s7_pointer p)
{
- if (s7_is_boolean(cadr(args)))
+ if (sc->gensyms_loc == sc->gensyms_size)
{
- (*(sc->gc_stats)) = (cadr(args) != sc->F);
- return(cadr(args));
+ sc->gensyms_size *= 2;
+ sc->gensyms = (s7_pointer *)realloc(sc->gensyms, sc->gensyms_size * sizeof(s7_pointer));
}
- return(sc->ERROR);
+ sc->gensyms[sc->gensyms_loc++] = p;
+ mark_function[T_SYMBOL] = mark_symbol;
}
-void s7_gc_stats(s7_scheme *sc, bool on)
+static void add_c_object(s7_scheme *sc, s7_pointer p)
{
- (*(sc->gc_stats)) = on;
- s7_symbol_set_value(sc, s7_make_symbol(sc, "*gc-stats*"), (on) ? sc->T : sc->F);
+ if (sc->c_objects_loc == sc->c_objects_size)
+ {
+ sc->c_objects_size *= 2;
+ sc->c_objects = (s7_pointer *)realloc(sc->c_objects, sc->c_objects_size * sizeof(s7_pointer));
+ }
+ sc->c_objects[sc->c_objects_loc++] = p;
}
-static s7_pointer g_safety_set(s7_scheme *sc, s7_pointer args)
+static void add_hash_table(s7_scheme *sc, s7_pointer p)
{
- if (s7_is_integer(cadr(args)))
+ if (sc->hash_tables_loc == sc->hash_tables_size)
{
- sc->safety = s7_integer(cadr(args));
- return(cadr(args));
+ sc->hash_tables_size *= 2;
+ sc->hash_tables = (s7_pointer *)realloc(sc->hash_tables, sc->hash_tables_size * sizeof(s7_pointer));
}
- return(sc->ERROR);
+ sc->hash_tables[sc->hash_tables_loc++] = p;
}
-static s7_pointer g_safety_bind(s7_scheme *sc, s7_pointer args)
+static void add_vector(s7_scheme *sc, s7_pointer p)
{
- return(sc->ERROR);
+ if (sc->vectors_loc == sc->vectors_size)
+ {
+ sc->vectors_size *= 2;
+ sc->vectors = (s7_pointer *)realloc(sc->vectors, sc->vectors_size * sizeof(s7_pointer));
+ }
+ sc->vectors[sc->vectors_loc++] = p;
}
+#define Add_Vector(Vec) if (sc->vectors_loc == sc->vectors_size) add_vector(sc, Vec); else sc->vectors[sc->vectors_loc++] = Vec
-#define NOT_IN_HEAP -1
-
-void s7_remove_from_heap(s7_scheme *sc, s7_pointer x)
+static void add_input_port(s7_scheme *sc, s7_pointer p)
{
- int loc;
- /* global functions are very rarely redefined, so we can remove the function body from
- * the heap when it is defined. If redefined, we currently lose the memory held by the
- * old definition. (It is not trivial to recover this memory because it is allocated
- * in blocks, not by the pointer, I think, but s7_define is the point to try).
- *
- * There is at least one problem with this: if, for example, a function has
- * a quoted (constant) list, then uses list-set! to change an element of it,
- * then a GC happens, and the new element is GC'd because no one in the heap
- * points to it, then we call the function again, and it tries to access
- * that element. I wonder if removal should be on a switch, so the user can
- * choose a "safety" level.
- *
- * (define (bad-idea)
- * (let ((lst '(1 2 3))) ; or #(1 2 3) and vector-ref|set
- * (let ((result (list-ref lst 1)))
- * (list-set! lst 1 (* 2.0 16.6))
- * (gc)
- * result)))
- *
- * put that in a file, load it (to force removal), than call bad-idea a few times.
- * so... if *safety* is not 0, remove-from-heap is disabled.
- */
-
- /* (catch #t (lambda () (set! *safety* "hi")) (lambda args args)) */
-
- if (is_pending_removal(x)) return;
- set_pending_removal(x);
+ if (sc->input_ports_loc == sc->input_ports_size)
+ {
+ sc->input_ports_size *= 2;
+ sc->input_ports = (s7_pointer *)realloc(sc->input_ports, sc->input_ports_size * sizeof(s7_pointer));
+ }
+ sc->input_ports[sc->input_ports_loc++] = p;
+}
- /* the procedure body being removed can be circular, so we need this bit to warn us
- * that we've already seen this node. We have to go out to the leaves and remove
- * nodes in reverse order because the GC might be called while we're at it. The
- * top node is globally accessible, so the GC will not move anything if we work
- * backwards. But working backwards means we have to watch out for circles explicitly.
- * The bit is unset later since the caller might change a removed procedure's body
- * directly, and we want the subsequent redefinition to see anything new in the
- * otherwise removed nodes.
- */
- switch (type(x))
+static void add_output_port(s7_scheme *sc, s7_pointer p)
+{
+ if (sc->output_ports_loc == sc->output_ports_size)
{
- case T_PAIR:
- s7_remove_from_heap(sc, car(x));
- s7_remove_from_heap(sc, cdr(x));
- break;
+ sc->output_ports_size *= 2;
+ sc->output_ports = (s7_pointer *)realloc(sc->output_ports, sc->output_ports_size * sizeof(s7_pointer));
+ }
+ sc->output_ports[sc->output_ports_loc++] = p;
+}
- case T_UNTYPED:
- case T_NIL:
- case T_BOOLEAN:
- return;
- /* not break! */
- case T_STRING:
- case T_NUMBER:
- case T_CHARACTER:
- case T_S_OBJECT:
- case T_C_OBJECT:
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- case T_C_LST_ARGS_FUNCTION:
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_FUNCTION:
- case T_C_MACRO:
- case T_C_POINTER:
- case T_HOOK:
- break;
+static void add_continuation(s7_scheme *sc, s7_pointer p)
+{
+ if (sc->continuations_loc == sc->continuations_size)
+ {
+ sc->continuations_size *= 2;
+ sc->continuations = (s7_pointer *)realloc(sc->continuations, sc->continuations_size * sizeof(s7_pointer));
+ }
+ sc->continuations[sc->continuations_loc++] = p;
+}
- case T_SYMBOL:
- /* here hloc is usually NOT_IN_HEAP, but in the syntax case can be the syntax op code */
- return;
+#if WITH_GMP
+static void add_bigint(s7_scheme *sc, s7_pointer p)
+{
+ if (sc->bigints_loc == sc->bigints_size)
+ {
+ sc->bigints_size *= 2;
+ sc->bigints = (s7_pointer *)realloc(sc->bigints, sc->bigints_size * sizeof(s7_pointer));
+ }
+ sc->bigints[sc->bigints_loc++] = p;
+}
- case T_CLOSURE:
- case T_CLOSURE_STAR:
- case T_MACRO:
- case T_BACRO:
- s7_remove_from_heap(sc, closure_source(x));
- break;
- /* not sure any of these can exist as code-level constants */
- case T_CONTINUATION:
- case T_GOTO:
- case T_INPUT_PORT:
- case T_OUTPUT_PORT:
- case T_CATCH:
- case T_DYNAMIC_WIND:
- break;
+static void add_bigratio(s7_scheme *sc, s7_pointer p)
+{
+ if (sc->bigratios_loc == sc->bigratios_size)
+ {
+ sc->bigratios_size *= 2;
+ sc->bigratios = (s7_pointer *)realloc(sc->bigratios, sc->bigratios_size * sizeof(s7_pointer));
+ }
+ sc->bigratios[sc->bigratios_loc++] = p;
+}
- case T_HASH_TABLE:
- {
- s7_Int i;
- for (i = 0; i < hash_table_length(x); i++)
- if (hash_table_elements(x)[i] != sc->NIL)
- s7_remove_from_heap(sc, hash_table_elements(x)[i]);
- }
- break;
- case T_VECTOR:
- {
- s7_Int i;
- if ((!vector_is_multidimensional(x)) ||
- (shared_vector(x) == sc->F))
- {
- for (i = 0; i < vector_length(x); i++)
- s7_remove_from_heap(sc, vector_element(x, i));
- }
- }
- break;
+static void add_bigreal(s7_scheme *sc, s7_pointer p)
+{
+ if (sc->bigreals_loc == sc->bigreals_size)
+ {
+ sc->bigreals_size *= 2;
+ sc->bigreals = (s7_pointer *)realloc(sc->bigreals, sc->bigreals_size * sizeof(s7_pointer));
}
+ sc->bigreals[sc->bigreals_loc++] = p;
+}
- clear_pending_removal(x);
- loc = x->hloc;
- if (loc != NOT_IN_HEAP)
+
+static void add_bignumber(s7_scheme *sc, s7_pointer p)
+{
+ if (sc->bignumbers_loc == sc->bignumbers_size)
{
- x->hloc = NOT_IN_HEAP;
- sc->heap[loc] = (s7_cell *)calloc(1, sizeof(s7_cell));
- (*sc->free_heap_top++) = sc->heap[loc];
- sc->heap[loc]->hloc = loc;
+ sc->bignumbers_size *= 2;
+ sc->bignumbers = (s7_pointer *)realloc(sc->bignumbers, sc->bignumbers_size * sizeof(s7_pointer));
}
+ sc->bignumbers[sc->bignumbers_loc++] = p;
}
+#endif
+
+#define INIT_GC_CACHE_SIZE 64
+static void init_gc_caches(s7_scheme *sc)
+{
+ sc->strings_size = INIT_GC_CACHE_SIZE * 16;
+ sc->strings_loc = 0;
+ sc->strings = (s7_pointer *)malloc(sc->strings_size * sizeof(s7_pointer));
+ sc->gensyms_size = INIT_GC_CACHE_SIZE;
+ sc->gensyms_loc = 0;
+ sc->gensyms = (s7_pointer *)malloc(sc->gensyms_size * sizeof(s7_pointer));
+ sc->vectors_size = INIT_GC_CACHE_SIZE * 8;
+ sc->vectors_loc = 0;
+ sc->vectors = (s7_pointer *)malloc(sc->vectors_size * sizeof(s7_pointer));
+ sc->hash_tables_size = INIT_GC_CACHE_SIZE;
+ sc->hash_tables_loc = 0;
+ sc->hash_tables = (s7_pointer *)malloc(sc->hash_tables_size * sizeof(s7_pointer));
+ sc->input_ports_size = INIT_GC_CACHE_SIZE;
+ sc->input_ports_loc = 0;
+ sc->input_ports = (s7_pointer *)malloc(sc->input_ports_size * sizeof(s7_pointer));
+ sc->output_ports_size = INIT_GC_CACHE_SIZE;
+ sc->output_ports_loc = 0;
+ sc->output_ports = (s7_pointer *)malloc(sc->output_ports_size * sizeof(s7_pointer));
+ sc->continuations_size = INIT_GC_CACHE_SIZE;
+ sc->continuations_loc = 0;
+ sc->continuations = (s7_pointer *)malloc(sc->continuations_size * sizeof(s7_pointer));
+ sc->c_objects_size = INIT_GC_CACHE_SIZE;
+ sc->c_objects_loc = 0;
+ sc->c_objects = (s7_pointer *)malloc(sc->c_objects_size * sizeof(s7_pointer));
+#if WITH_GMP
+ sc->bigints_size = INIT_GC_CACHE_SIZE;
+ sc->bigints_loc = 0;
+ sc->bigints = (s7_pointer *)malloc(sc->bigints_size * sizeof(s7_pointer));
+ sc->bigratios_size = INIT_GC_CACHE_SIZE;
+ sc->bigratios_loc = 0;
+ sc->bigratios = (s7_pointer *)malloc(sc->bigratios_size * sizeof(s7_pointer));
+ sc->bigreals_size = INIT_GC_CACHE_SIZE;
+ sc->bigreals_loc = 0;
+ sc->bigreals = (s7_pointer *)malloc(sc->bigreals_size * sizeof(s7_pointer));
+ sc->bignumbers_size = INIT_GC_CACHE_SIZE;
+ sc->bignumbers_loc = 0;
+ sc->bignumbers = (s7_pointer *)malloc(sc->bignumbers_size * sizeof(s7_pointer));
+#endif
-/* permanent memory for objects that we know will not (normally) be deallocated */
+ /* slightly unrelated... */
+ sc->setters_size = 4;
+ sc->setters_loc = 0;
+ sc->setters = (s7_pointer *)malloc(sc->c_objects_size * sizeof(s7_pointer));
+}
-#define PERMANENT_HEAP_SIZE 65536
-static unsigned char *permanent_heap = NULL, *permanent_heap_top = NULL;
-static unsigned char *permanent_calloc(int bytes)
+static void add_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter)
{
- unsigned char *cur;
- if (bytes >= PERMANENT_HEAP_SIZE)
+ /* procedure-setters GC-protected. The c_function_setter field can't be used because the built-in functions
+ * are often removed from the heap and never thereafter marked.
+ */
+ unsigned int i;
+ for (i = 0; i < sc->setters_loc; i++)
{
- /* this actually can happen! I wrote a file unwittingly that had gmp's output from (ash 1 92233720360)
- * or some big number like that -- 16 million digits. During a subsequent load, s7 decided it was a
- * symbol name(!) and tried to store it permanently in the symbol table. segfault.
- */
- return((unsigned char *)calloc(bytes, sizeof(unsigned char)));
+ s7_pointer x;
+ x = sc->setters[i];
+ if (car(x) == p)
+ {
+ cdr(x) = setter;
+ return;
+ }
}
- if ((permanent_heap + bytes) >= permanent_heap_top)
+ if (sc->setters_loc == sc->setters_size)
{
- permanent_heap = (unsigned char *)calloc(PERMANENT_HEAP_SIZE, sizeof(unsigned char));
- permanent_heap_top = (unsigned char *)(permanent_heap + PERMANENT_HEAP_SIZE);
+ sc->setters_size *= 2;
+ sc->setters = (s7_pointer *)realloc(sc->setters, sc->setters_size * sizeof(s7_pointer));
}
- cur = permanent_heap;
- permanent_heap += bytes;
- return(cur);
+ sc->setters[sc->setters_loc++] = permanent_cons(p, setter, T_PAIR | T_IMMUTABLE);
}
+static void mark_vector_1(s7_pointer p, s7_int top)
+{
+ s7_pointer *tp, *tend, *tend4;
+ set_mark(p);
-/* -------------------------------- stack -------------------------------- */
-
-static void stack_reset(s7_scheme *sc)
-{
- sc->stack_end = sc->stack_start;
-}
+ tp = (s7_pointer *)(vector_elements(p));
+ if (!tp) return;
+ tend = (s7_pointer *)(tp + top);
+ tend4 = (s7_pointer *)(tend - 4);
+ while (tp <= tend4)
+ {
+ S7_MARK(*tp++);
+ S7_MARK(*tp++);
+ S7_MARK(*tp++);
+ S7_MARK(*tp++);
+ }
-#define stack_code(Stack, Loc) vector_element(Stack, Loc - 3)
-#define stack_environment(Stack, Loc) vector_element(Stack, Loc - 2)
-#define stack_args(Stack, Loc) vector_element(Stack, Loc - 1)
-#define stack_op(Stack, Loc) integer(number(vector_element(Stack, Loc)))
+ while (tp < tend)
+ S7_MARK(*tp++);
+}
+static void mark_slot(s7_pointer p)
+{
+ set_mark(p);
+ S7_MARK(slot_value(p));
+ if (slot_has_accessor(p))
+ S7_MARK(slot_accessor(p));
-static void pop_stack(s7_scheme *sc)
-{
- /* avoid "if..then" here and in push_stack -- these 2 are called a zillion times */
- sc->stack_end -= 4;
- sc->op = (opcode_t)integer(number(sc->stack_end[3]));
- sc->args = sc->stack_end[2];
- sc->envir = sc->stack_end[1];
- sc->code = sc->stack_end[0];
-}
+ if (is_gensym(slot_symbol(p))) /* (let () (apply define (gensym) (list 32)) (gc) (gc) (curlet)) */
+ set_mark(slot_symbol(p));
+}
+static void mark_let(s7_pointer env)
+{
+ s7_pointer x;
+ for (x = env; is_let(x) && (!is_marked(x)); x = outlet(x))
+ {
+ s7_pointer y;
+ set_mark(x);
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (!is_marked(y)) /* slot value might be the enclosing let */
+ mark_slot(y);
+ }
+}
-static void push_stack(s7_scheme *sc, s7_pointer int_op, s7_pointer args, s7_pointer code)
-{
- sc->stack_end[0] = code;
- sc->stack_end[1] = sc->envir;
- sc->stack_end[2] = args;
- sc->stack_end[3] = int_op;
- sc->stack_end += 4;
+static void just_mark(s7_pointer p)
+{
+ set_mark(p);
}
+static void mark_c_proc_star(s7_pointer p)
+{
+ set_mark(p);
+ if (!has_simple_defaults(p))
+ {
+ s7_pointer arg;
+ for (arg = c_function_call_args(p); is_pair(arg); arg = cdr(arg))
+ S7_MARK(car(arg));
+ }
+}
-static void increase_stack_size(s7_scheme *sc)
+static void mark_pair(s7_pointer p)
{
- int i, new_size, loc;
+ s7_pointer x;
+ set_mark(p);
+ S7_MARK(car(p));
+ /* if the list is huge, recursion to cdr(p) is problematic when there are strict limits on the stack size
+ * so I'll try something else... (This form is faster according to callgrind).
+ *
+ * in snd-14 or so through 15.3, sc->temp_cell_2|3 were used for trailing args in eval, but that meant
+ * the !is_marked check below (which is intended to catch cyclic lists) caused cells to be missed;
+ * since sc->args could contain permanently marked cells, if these were passed to g_vector, for example, and
+ * make_vector_1 triggered a GC call, we needed to mark both the permanent (always marked) cell and its contents,
+ * and continue through the rest of the list. But adding temp_cell_2|3 to sc->permanent_objects was not enough.
+ * Now I've already forgotten the rest of the story, and it was just an hour ago! -- the upshot is that temp_cell_2|3
+ * are not now used as arg list members.
+ */
+ for (x = cdr(p); is_pair(x) && (!is_marked(x)); x = cdr(x))
+ {
+ set_mark(x);
+ S7_MARK(car(x));
+ }
+ S7_MARK(x);
+}
- loc = s7_stack_top(sc);
- new_size = sc->stack_size * 2;
+static void mark_counter(s7_pointer p)
+{
+ set_mark(p);
+ S7_MARK(counter_result(p));
+ S7_MARK(counter_list(p));
+ S7_MARK(counter_let(p));
+}
- vector_elements(sc->stack) = (s7_pointer *)realloc(vector_elements(sc->stack), new_size * sizeof(s7_pointer));
- for (i = sc->stack_size; i < new_size; i++)
- vector_element(sc->stack, i) = sc->NIL;
- vector_length(sc->stack) = new_size;
- sc->stack_size = new_size;
+static void mark_closure(s7_pointer p)
+{
+ set_mark(p);
+ S7_MARK(closure_args(p));
+ S7_MARK(closure_body(p));
+ mark_let(closure_let(p));
+ S7_MARK(closure_setter(p));
+}
- sc->stack_start = vector_elements(sc->stack);
- sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
- sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2);
-}
+static void mark_stack_1(s7_pointer p, s7_int top)
+{
+ s7_pointer *tp, *tend;
+ set_mark(p);
+ tp = (s7_pointer *)(vector_elements(p));
+ if (!tp) return;
+ tend = (s7_pointer *)(tp + top);
-static s7_pointer g_stack_size(s7_scheme *sc, s7_pointer args)
-{
- return(s7_make_integer(sc, (sc->stack_end - sc->stack_start) / 4));
+ while (tp < tend)
+ {
+ S7_MARK(*tp++);
+ S7_MARK(*tp++);
+ S7_MARK(*tp++);
+ tp++;
+ }
}
+static void mark_stack(s7_pointer p)
+{
+ /* we can have a bare stack awaiting a continuation to hold it if the new_cell for the continuation
+ * triggers the GC! But we need a top-of-stack??
+ */
+ mark_stack_1(p, temp_stack_top(p));
+}
+static void mark_continuation(s7_pointer p)
+{
+ unsigned int i;
+ set_mark(p);
+ mark_stack_1(continuation_stack(p), continuation_stack_top(p));
+ for (i = 0; i < continuation_op_loc(p); i++)
+ S7_MARK(continuation_op_stack(p)[i]);
+}
+static void mark_vector(s7_pointer p)
+{
+ mark_vector_1(p, vector_length(p));
+}
-/* -------------------------------- symbols -------------------------------- */
-
-static int symbol_table_hash(const char *key)
-{
- unsigned int hashed = 0;
- const char *c;
- for (c = key; *c; c++)
- hashed = *c + hashed * 37;
- return(hashed % SYMBOL_TABLE_SIZE);
-
- /* using ints here is much faster, and the symbol table will not be enormous, so it's worth splitting out this case */
- /* precomputing the * 37 and so on only saved about 10% compute time -- 1/2260 overall time */
-
- /* chain lengths (after s7test):
- * all chars: 43 159 329 441 395 349 217 152 69 35 12 4 1 0 0 1 max: 15
- * 4 chars: 572 528 307 183 128 90 50 48 41 35 34 23 21 ... max: 182!
- * 8 chars: 114 307 404 411 301 197 146 98 77 35 28 18 11 16 ... max: 79
- * 16 chars: 44 160 344 400 435 348 206 143 72 31 16 4 0 1 0 0 0 2 1... max: 18
+static void mark_vector_possibly_shared(s7_pointer p)
+{
+ /* If a subvector (an inner dimension) of a vector is the only remaining reference
+ * to the main vector, we want to make sure the main vector is not GC'd until
+ * the subvector is also GC-able. The shared_vector field either points to the
+ * parent vector, or it is sc->F, so we need to check for a vector parent if
+ * the current is multidimensional (this will include 1-dim slices). We need
+ * to keep the parent case separate (i.e. sc->F means the current is the original)
+ * so that we only free once (or remove_from_heap once).
*
- * currently the hash calculation is ca 8 (s7test) and the find_by_name process 3,
- * if we use 4 chars, this calc goes to 6/7 but the find calc to 8/9
+ * If we have a shared-vector of a shared-vector, and the middle and original are not otherwise
+ * in use, we mark the middle one, but (since it itself is not in use anywhere else)
+ * we don't mark the original! So we need to follow the share-vector chain marking every one.
*/
-}
-
+ if ((vector_has_dimensional_info(p)) &&
+ (s7_is_vector(shared_vector(p))))
+ mark_vector_possibly_shared(shared_vector(p));
-#if HAVE_PTHREADS
-static pthread_mutex_t symtab_lock = PTHREAD_MUTEX_INITIALIZER;
-#endif
+ mark_vector_1(p, vector_length(p));
+}
-static s7_pointer symbol_table_add_by_name_at_location(s7_scheme *sc, const char *name, int location)
-{
- s7_pointer x, str;
-
- str = s7_make_permanent_string(name);
- x = permanent_cons(str, sc->NIL, T_SYMBOL | T_SIMPLE | T_DONT_COPY);
- symbol_location(x) = location; /* accesses car(x) */
- symbol_global_slot(x) = sc->NIL; /* same */
+static void mark_int_or_float_vector(s7_pointer p)
+{
+ set_mark(p);
+}
- if ((symbol_name_length(x) > 1) && /* not 0, otherwise : is a keyword */
- ((name[0] == ':') ||
- (name[symbol_name_length(x) - 1] == ':')))
- typeflag(x) |= (T_IMMUTABLE | T_KEYWORD);
+static void mark_int_or_float_vector_possibly_shared(s7_pointer p)
+{
+ if ((vector_has_dimensional_info(p)) &&
+ (s7_is_vector(shared_vector(p))))
+ mark_int_or_float_vector_possibly_shared(shared_vector(p));
-#if HAVE_PTHREADS
- pthread_mutex_lock(&symtab_lock);
-#endif
+ set_mark(p);
+}
- vector_element(sc->symbol_table, location) = permanent_cons(x, vector_element(sc->symbol_table, location),
- T_PAIR | T_SIMPLE | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&symtab_lock);
-#endif
-
- return(x);
-}
+static void mark_c_object(s7_pointer p)
+{
+ set_mark(p);
+ (*(c_object_mark(p)))(c_object_value(p));
+}
+static void mark_catch(s7_pointer p)
+{
+ set_mark(p);
+ S7_MARK(catch_tag(p));
+ S7_MARK(catch_handler(p));
+}
-static s7_pointer symbol_table_find_by_name(s7_scheme *sc, const char *name, int location)
-{
- s7_pointer x;
- /* in the pthreads case, I don't think any lock is needed here -- we're simply
- * scanning the symbol table for a name. If we had a lock here, it would not solve
- * the race condition: thread1 looks for symbol in make_symbol, does not find it,
- * gets set to add it, but thread2 which is also looking for symbol, gets the lock and
- * does not find it, thread1 adds it, thread2 adds it. The look-and-add code in
- * make_symbol needs to be atomic -- we can't handle the problem here. I doubt
- * this is actually a problem (two threads loading the same file at the same time?).
- */
- for (x = vector_element(sc->symbol_table, location); x != sc->NIL; x = cdr(x))
- {
- const char *s;
- s = symbol_name(car(x));
- if ((s) && (*s == *name) && (strings_are_equal(name, s)))
- return(car(x));
- }
- return(sc->NIL);
-}
+static void mark_dynamic_wind(s7_pointer p)
+{
+ set_mark(p);
+ S7_MARK(dynamic_wind_in(p));
+ S7_MARK(dynamic_wind_out(p));
+ S7_MARK(dynamic_wind_body(p));
+}
+static void mark_hash_table(s7_pointer p)
+{
+ set_mark(p);
+ S7_MARK(hash_table_procedures(p));
+ if (hash_table_entries(p) > 0)
+ {
+ unsigned int i, len;
+ hash_entry_t **entries;
+ entries = hash_table_elements(p);
+ len = hash_table_mask(p) + 1;
+ for (i = 0; i < len; i++)
+ {
+ hash_entry_t *xp;
+ for (xp = entries[i++]; xp; xp = xp->next)
+ {
+ S7_MARK(xp->key);
+ S7_MARK(xp->value);
+ }
+ for (xp = entries[i]; xp; xp = xp->next)
+ {
+ S7_MARK(xp->key);
+ S7_MARK(xp->value);
+ }
+ }
+ }
+}
-static s7_pointer g_symbol_table(s7_scheme *sc, s7_pointer args)
+static void mark_iterator(s7_pointer p)
+{
+ set_mark(p);
+ S7_MARK(iterator_sequence(p));
+ if (is_mark_seq(p))
+ S7_MARK(iterator_current(p));
+}
+
+static void mark_input_port(s7_pointer p)
+{
+ set_mark(p);
+ set_mark(port_original_input_string(p));
+}
+
+static void gf_mark(s7_scheme *sc)
+{
+ gc_obj *p;
+ if (sc->cur_rf)
+ for (p = sc->cur_rf->gc_list; p; p = p->nxt)
+ S7_MARK(p->p);
+}
+
+
+static void init_mark_functions(void)
+{
+ mark_function[T_FREE] = mark_noop;
+ mark_function[T_UNIQUE] = mark_noop;
+ mark_function[T_UNSPECIFIED] = mark_noop;
+ mark_function[T_NIL] = mark_noop;
+ mark_function[T_BOOLEAN] = mark_noop;
+ mark_function[T_STRING] = just_mark;
+ mark_function[T_INTEGER] = just_mark;
+ mark_function[T_RATIO] = just_mark;
+ mark_function[T_REAL] = just_mark;
+ mark_function[T_COMPLEX] = just_mark;
+ mark_function[T_BIG_INTEGER] = just_mark;
+ mark_function[T_BIG_RATIO] = just_mark;
+ mark_function[T_BIG_REAL] = just_mark;
+ mark_function[T_BIG_COMPLEX] = just_mark;
+ mark_function[T_SYMBOL] = mark_noop; /* this changes to mark_symbol when gensyms are in the heap */
+ mark_function[T_PAIR] = mark_pair;
+ mark_function[T_CLOSURE] = mark_closure;
+ mark_function[T_CLOSURE_STAR] = mark_closure;
+ mark_function[T_CONTINUATION] = mark_continuation;
+ mark_function[T_CHARACTER] = mark_noop;
+ mark_function[T_INPUT_PORT] = mark_input_port;
+ mark_function[T_VECTOR] = mark_vector; /* this changes if shared vector created (similarly below) */
+ mark_function[T_INT_VECTOR] = mark_int_or_float_vector;
+ mark_function[T_FLOAT_VECTOR] = mark_int_or_float_vector;
+ mark_function[T_MACRO] = mark_closure;
+ mark_function[T_BACRO] = mark_closure;
+ mark_function[T_MACRO_STAR] = mark_closure;
+ mark_function[T_BACRO_STAR] = mark_closure;
+ mark_function[T_C_OBJECT] = mark_c_object;
+ mark_function[T_RANDOM_STATE] = just_mark;
+ mark_function[T_GOTO] = just_mark;
+ mark_function[T_OUTPUT_PORT] = just_mark;
+ mark_function[T_CATCH] = mark_catch;
+ mark_function[T_DYNAMIC_WIND] = mark_dynamic_wind;
+ mark_function[T_HASH_TABLE] = mark_hash_table;
+ mark_function[T_ITERATOR] = mark_iterator;
+ mark_function[T_SYNTAX] = mark_noop;
+ mark_function[T_LET] = mark_let;
+ mark_function[T_STACK] = mark_stack;
+ mark_function[T_COUNTER] = mark_counter;
+ mark_function[T_SLOT] = mark_slot;
+ mark_function[T_BAFFLE] = just_mark;
+ mark_function[T_C_MACRO] = just_mark;
+ mark_function[T_C_POINTER] = just_mark;
+ mark_function[T_C_FUNCTION] = just_mark;
+ mark_function[T_C_FUNCTION_STAR] = just_mark; /* changes to mark_c_proc_star if defaults involve an expression */
+ mark_function[T_C_ANY_ARGS_FUNCTION] = just_mark;
+ mark_function[T_C_OPT_ARGS_FUNCTION] = just_mark;
+ mark_function[T_C_RST_ARGS_FUNCTION] = just_mark;
+}
+
+
+static void mark_op_stack(s7_scheme *sc)
+{
+ s7_pointer *p, *tp;
+ tp = sc->op_stack_now;
+ p = sc->op_stack;
+ while (p < tp)
+ S7_MARK(*p++);
+}
+
+static void mark_rootlet(s7_scheme *sc)
{
- #define H_symbol_table "(symbol-table) returns the s7 symbol table (a vector)"
- return(vector_copy(sc, sc->symbol_table));
+ s7_pointer ge;
+ s7_pointer *tmp, *top;
- /* (vector-fill! (symbol-table) #()) leads to a segfault -- this is similar to symbol->string
- * in that we have to protect against inadvertently clobbering the symbol table.
- * The table is normally not too big (default size 2207), and vector_copy is very fast.
- * but it's still possible to screw up -- get one of the symbol lists, and clobber it or a member of it.
- */
+ ge = sc->rootlet;
+ tmp = vector_elements(ge);
+ top = (s7_pointer *)(tmp + sc->rootlet_entries);
+
+ set_mark(ge);
+ while (tmp < top)
+ S7_MARK(slot_value(*tmp++));
}
+void s7_mark_object(s7_pointer p)
+{
+ S7_MARK(p);
+}
-void s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
+static void mark_permanent_objects(s7_scheme *sc)
{
- int i;
- s7_pointer x;
+ gc_obj *g;
+ for (g = sc->permanent_objects; g; g = (gc_obj *)(g->nxt))
+ S7_MARK(g->p);
+}
-#if HAVE_PTHREADS
- pthread_mutex_lock(&symtab_lock);
-#endif
+static void unmark_permanent_objects(s7_scheme *sc)
+{
+ gc_obj *g;
+ for (g = sc->permanent_objects; g; g = (gc_obj *)(g->nxt))
+ clear_mark(g->p);
+}
- for (i = 0; i < vector_length(sc->symbol_table); i++)
- for (x = vector_element(sc->symbol_table, i); x != sc->NIL; x = cdr(x))
- if (symbol_func(symbol_name(car(x)), data))
- {
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&symtab_lock);
+
+#ifndef _MSC_VER
+ #include <time.h>
+ #include <sys/time.h>
+ static struct timeval start_time;
+ static struct timezone z0;
#endif
- return;
- }
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&symtab_lock);
+
+#if DEBUGGING
+static int last_gc_line = 0;
+static const char *last_gc_func = NULL;
#endif
-}
+#define GC_STATS 1
+#define HEAP_STATS 2
+#define STACK_STATS 4
-void s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, s7_pointer value, void *data), void *data)
-{
- int i;
- s7_pointer x;
+#define show_gc_stats(Sc) ((Sc->gc_stats & GC_STATS) != 0)
+#define show_stack_stats(Sc) ((Sc->gc_stats & STACK_STATS) != 0)
+#define show_heap_stats(Sc) ((Sc->gc_stats & HEAP_STATS) != 0)
-#if HAVE_PTHREADS
- pthread_mutex_lock(&symtab_lock);
-#endif
- for (i = 0; i < vector_length(sc->symbol_table); i++)
- for (x = vector_element(sc->symbol_table, i); x != sc->NIL; x = cdr(x))
- if (symbol_func(symbol_name(car(x)), cdr(x), data))
- {
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&symtab_lock);
+static int gc(s7_scheme *sc)
+{
+ s7_cell **old_free_heap_top;
+ /* mark all live objects (the symbol table is in permanent memory, not the heap) */
+#if DEBUGGING
+ #define gc_call(P, Tp) \
+ p = (*tp++); \
+ if (is_marked(p)) \
+ clear_mark(p); \
+ else \
+ { \
+ if (!is_free_and_clear(p)) \
+ { \
+ p->debugger_bits = 0; p->gc_line = last_gc_line; p->gc_func = last_gc_func; \
+ clear_type(p); \
+ (*fp++) = p;\
+ }}
+#else
+ #define gc_call(P, Tp) p = (*tp++); if (is_marked(p)) clear_mark(p); else {if (!is_free_and_clear(p)) {clear_type(p); (*fp++) = p;}}
#endif
- return;
- }
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&symtab_lock);
+ if (show_gc_stats(sc))
+ {
+ fprintf(stdout, "gc ");
+#if DEBUGGING
+ fprintf(stdout, "line %s[%d] ", last_gc_func, last_gc_line);
#endif
-}
-
-/* (for-each
- (lambda (lst)
- (for-each
- (lambda (sym)
- (format #t "~A ~S~%" sym (symbol->value sym)))
- lst))
- (symbol-table))
-
- at normal motif-snd startup there are 5699 globals (2583 of them constant), and 411 other undefined symbols
-*/
+#ifndef _MSC_VER
+ /* this is apparently deprecated in favor of clock_gettime -- what compile-time switch to use here?
+ * _POSIX_TIMERS, or perhaps use CLOCK_REALTIME, but clock_gettime requires -lrt -- no thanks.
+ */
+ gettimeofday(&start_time, &z0);
+#endif
+ }
+ mark_rootlet(sc);
+ S7_MARK(sc->args);
+ mark_let(sc->envir);
+#if DEBUGGING
+ check_types = false;
+#endif
+ mark_let(sc->owlet);
+#if DEBUGGING
+ check_types = true;
+#endif
+ S7_MARK(sc->code);
+ S7_MARK(sc->cur_code);
+ mark_stack_1(sc->stack, s7_stack_top(sc));
+ S7_MARK(sc->v);
+ S7_MARK(sc->w);
+ S7_MARK(sc->x);
+ S7_MARK(sc->y);
+ S7_MARK(sc->z);
+ S7_MARK(sc->value);
-static s7_pointer g_symbol_table_is_locked(s7_scheme *sc, s7_pointer args)
-{
- #define H_symbol_table_is_locked "set (-s7-symbol-table-locked?) to #t to prohibit the creation of any new symbols"
- return(make_boolean(sc, (*(sc->symbol_table_is_locked))));
-}
+ S7_MARK(sc->temp1);
+ S7_MARK(sc->temp2);
+ S7_MARK(sc->temp3);
+ S7_MARK(sc->temp4);
+ S7_MARK(sc->temp5);
+ S7_MARK(sc->temp6);
+ S7_MARK(sc->temp7);
+ S7_MARK(sc->temp8);
+ S7_MARK(sc->temp9);
+ S7_MARK(sc->temp10);
+ gf_mark(sc);
+
+ set_mark(sc->input_port);
+ S7_MARK(sc->input_port_stack);
+ set_mark(sc->output_port);
+ set_mark(sc->error_port);
+ S7_MARK(sc->stacktrace_defaults);
+ S7_MARK(sc->autoload_table);
+ S7_MARK(sc->default_rng);
+
+ mark_pair(sc->temp_cell_1);
+ mark_pair(sc->temp_cell_2);
+ S7_MARK(car(sc->T1_1));
+ S7_MARK(car(sc->T2_1));
+ S7_MARK(car(sc->T2_2));
+ S7_MARK(car(sc->T3_1));
+ S7_MARK(car(sc->T3_2));
+ S7_MARK(car(sc->T3_3));
+
+ S7_MARK(car(sc->A4_1));
+ S7_MARK(car(sc->A4_2));
+ S7_MARK(car(sc->A4_3));
+ S7_MARK(car(sc->A4_4));
+
+ S7_MARK(car(sc->plist_1));
+ S7_MARK(car(sc->plist_2));
+ S7_MARK(cadr(sc->plist_2));
+ S7_MARK(car(sc->plist_3));
+ S7_MARK(cadr(sc->plist_3));
+ S7_MARK(caddr(sc->plist_3));
+ {
+ unsigned int i;
+ s7_pointer p;
+ for (i = 1; i < NUM_SAFE_LISTS; i++)
+ if (list_is_in_use(sc->safe_lists[i]))
+ for (p = sc->safe_lists[i]; is_pair(p); p = cdr(p))
+ S7_MARK(car(p));
+ for (i = 0; i < sc->setters_loc; i++)
+ S7_MARK(cdr(sc->setters[i]));
+ }
+ {
+ int i;
+ for (i = 0; i < sc->num_fdats; i++)
+ if (sc->fdats[i])
+ S7_MARK(sc->fdats[i]->curly_arg);
+ }
+ S7_MARK(sc->protected_objects);
+ S7_MARK(sc->protected_accessors);
-static s7_pointer g_set_symbol_table_is_locked(s7_scheme *sc, s7_pointer args)
-{
- (*(sc->symbol_table_is_locked)) = (car(args) != sc->F);
- return(car(args));
-}
+ /* now protect recent allocations using the free_heap cells above the current free_heap_top (if any).
+ *
+ * cells above sc->free_heap_top might be malloc'd garbage (after heap reallocation), so we keep track of
+ * where the last actually freed cells were after the previous GC call. We're trying to
+ * GC protect the previous GC_TEMPS_SIZE allocated pointers so that the caller doesn't have
+ * to gc-protect every temporary cell.
+ *
+ * There's one remaining possible problem. s7_remove_from_heap frees cells outside
+ * the GC and might push free_heap_top beyond its previous_free_heap_top, then
+ * an immediate explicit gc call might not see those temp cells.
+ */
+ {
+ s7_pointer *tmps, *tmps_top;
+ tmps = sc->free_heap_top;
+ tmps_top = tmps + GC_TEMPS_SIZE;
+ if (tmps_top > sc->previous_free_heap_top)
+ tmps_top = sc->previous_free_heap_top;
-static s7_pointer make_symbol(s7_scheme *sc, const char *name)
-{
- s7_pointer x;
- int location;
+ while (tmps < tmps_top)
+ S7_MARK(*tmps++);
+ }
+ mark_op_stack(sc);
+ mark_permanent_objects(sc);
- location = symbol_table_hash(name);
- x = symbol_table_find_by_name(sc, name, location);
- if (x != sc->NIL)
- return(x);
+ /* free up all unmarked objects */
+ old_free_heap_top = sc->free_heap_top;
- if (*(sc->symbol_table_is_locked))
- return(s7_error(sc, sc->ERROR, sc->NIL));
+ {
+ s7_pointer *fp, *tp, *heap_top;
+ fp = sc->free_heap_top;
- return(symbol_table_add_by_name_at_location(sc, name, location));
-}
+ tp = sc->heap;
+ heap_top = (s7_pointer *)(sc->heap + sc->heap_size);
+ while (tp < heap_top) /* != here or ^ makes no difference */
+ {
+ s7_pointer p;
+ /* from here down is gc_call, but I wanted one case explicit for readability */
+ p = (*tp++);
-s7_pointer s7_make_symbol(s7_scheme *sc, const char *name)
-{
- if (!name) return(sc->F);
- return(make_symbol(sc, name));
-}
+ if (is_marked(p)) /* this order is faster than checking typeflag(p) != T_FREE first */
+ clear_mark(p);
+ else
+ {
+ if (!is_free_and_clear(p)) /* if T_FREE, it's an already-free object -- the free_heap is usually not empty when we call the GC */
+ {
+#if DEBUGGING
+ p->debugger_bits = 0;
+#endif
+ clear_type(p); /* (this is needed -- otherwise we try to free some objects twice) */
+ (*fp++) = p;
+ }
+ }
+ /* this looks crazy, but it speeds up the entire GC process by 25%!
+ * going from 16 to 32 saves .2% so it may not matter.
+ */
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+ gc_call(p, tp);
+ }
-s7_pointer s7_gensym(s7_scheme *sc, const char *prefix)
-{
- char *name;
- int len, location;
- s7_pointer x;
-
- len = safe_strlen(prefix) + 32;
- name = (char *)calloc(len, sizeof(char));
-
- for (; (*(sc->gensym_counter)) < S7_LONG_MAX; )
- {
- snprintf(name, len, "{%s}-%ld", prefix, (*(sc->gensym_counter))++);
- location = symbol_table_hash(name);
- x = symbol_table_find_by_name(sc, name, location);
- if (x != sc->NIL)
- {
- if (s7_symbol_value(sc, x) != sc->UNDEFINED)
- continue;
- free(name);
- return(x);
- }
-
- x = symbol_table_add_by_name_at_location(sc, name, location);
- free(name);
- return(x);
- }
- free(name);
- return(sc->NIL);
-}
+ sc->free_heap_top = fp;
+ sweep(sc);
+ }
+ unmark_permanent_objects(sc);
+ sc->gc_freed = (int)(sc->free_heap_top - old_free_heap_top);
-static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args)
-{
- #define H_gensym "(gensym (prefix \"gensym\")) returns a new, unused symbol"
- if (args != sc->NIL)
+ if (show_gc_stats(sc))
{
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "gensym prefix,", 0, car(args), "a string"));
- return(s7_gensym(sc, string_value(car(args))));
+#ifndef _MSC_VER
+ struct timeval t0;
+ double secs;
+ gettimeofday(&t0, &z0);
+ secs = (t0.tv_sec - start_time.tv_sec) + 0.000001 * (t0.tv_usec - start_time.tv_usec);
+#if (PRINT_NAME_PADDING == 8)
+ fprintf(stdout, "freed %d/%u (free: %d), time: %f\n", sc->gc_freed, sc->heap_size, sc->free_heap_top - sc->free_heap, secs);
+#else
+ fprintf(stdout, "freed %d/%u (free: %ld), time: %f\n", sc->gc_freed, sc->heap_size, sc->free_heap_top - sc->free_heap, secs);
+#endif
+#else
+ fprintf(stdout, "freed %d/%u\n", sc->gc_freed, sc->heap_size);
+#endif
}
- return(s7_gensym(sc, "gensym"));
+
+ /* if (sc->begin_hook) call_begin_hook(sc); */
+ sc->previous_free_heap_top = sc->free_heap_top;
+ return(sc->gc_freed); /* needed by cell allocator to decide when to increase heap size */
}
+void s7_gc_stats(s7_scheme *sc, bool on) {sc->gc_stats = (on) ? GC_STATS : 0;}
+unsigned int s7_heap_size(s7_scheme *sc) {return(sc->heap_size);}
+int s7_gc_freed(s7_scheme *sc) {return(sc->gc_freed);}
-s7_pointer s7_name_to_value(s7_scheme *sc, const char *name)
-{
- return(s7_symbol_value(sc, make_symbol(sc, name)));
-}
+#define GC_TRIGGER_SIZE 64
-bool s7_is_symbol(s7_pointer p)
-{
- return(type(p) == T_SYMBOL);
-}
+/* new_cell has to include the new cell's type. In the free list, it is 0 (T_FREE). If we remove it here,
+ * but then hit some error before setting the type, the GC sweep thinks it is a free cell already and
+ * does not return it to the free list: a memory leak.
+ */
+#if (!DEBUGGING)
+#define new_cell(Sc, Obj, Type) \
+ do { \
+ if (Sc->free_heap_top <= Sc->free_heap_trigger) try_to_call_gc(Sc); \
+ Obj = (*(--(Sc->free_heap_top))); \
+ set_type(Obj, Type); \
+ } while (0)
-static s7_pointer g_is_symbol(s7_scheme *sc, s7_pointer args)
+#define new_cell_no_check(Sc, Obj, Type) do {Obj = (*(--(Sc->free_heap_top))); set_type(Obj, Type);} while (0)
+ /* since sc->free_heap_trigger is GC_TRIGGER_SIZE above the free heap base, we don't need
+ * to check it repeatedly after the first such check.
+ */
+#else
+static bool for_any_other_reason(s7_scheme *sc, int line)
{
- #define H_is_symbol "(symbol? obj) returns #t if obj is a symbol"
- return(make_boolean(sc, (typeflag(car(args)) & (T_MASKTYPE | T_SYNTAX)) == T_SYMBOL)); /* i.e. (symbol? begin) is #f */
+#if 0
+ static int ctr = 0;
+ if ((sc->default_rng) &&
+ (!sc->gc_off) &&
+ (ctr > GC_TRIGGER_SIZE))
+ {
+ s7_double x;
+ x = next_random(sc->default_rng);
+ if (x > .995)
+ {
+ ctr = 0;
+ return(true);
+ }
+ }
+ ctr++;
+#endif
+ return(false);
}
+#define new_cell(Sc, Obj, Type) \
+ do { \
+ if ((Sc->free_heap_top <= Sc->free_heap_trigger) || (for_any_other_reason(sc, __LINE__))) {last_gc_line = __LINE__; last_gc_func = __func__; try_to_call_gc(Sc);} \
+ Obj = (*(--(Sc->free_heap_top))); \
+ Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; \
+ set_type(Obj, Type); \
+ } while (0)
-const char *s7_symbol_name(s7_pointer p)
-{
- return(symbol_name(p));
-}
+#define new_cell_no_check(Sc, Obj, Type) \
+ do { \
+ if ((Sc->free_heap_top + 16) < Sc->free_heap_trigger) fprintf(stderr, "[%d: cell %d] ", __LINE__, (int)(sc->free_heap_top - sc->free_heap)); \
+ Obj = (*(--(Sc->free_heap_top))); \
+ Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; \
+ set_type(Obj, Type); \
+ } while (0)
+#endif
-static s7_pointer g_symbol_to_string(s7_scheme *sc, s7_pointer args)
+static void resize_heap(s7_scheme *sc)
{
- #define H_symbol_to_string "(symbol->string sym) returns the symbol sym converted to a string"
- s7_pointer sym;
+ /* alloc more heap */
+ unsigned int old_size, old_free, k;
+ s7_cell *cells;
+ s7_pointer p;
- sym = car(args);
- if (!s7_is_symbol(sym))
- return(s7_wrong_type_arg_error(sc, "symbol->string", 0, sym, "a symbol"));
-
- /* s7_make_string uses strlen which stops at an embedded null
- */
- return(s7_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym))); /* return a copy */
-}
+ old_size = sc->heap_size;
+ old_free = sc->free_heap_top - sc->free_heap;
+ if (sc->heap_size < 512000)
+ sc->heap_size *= 2;
+ else sc->heap_size += 512000;
-static s7_pointer g_string_to_symbol_1(s7_scheme *sc, s7_pointer args, const char *caller)
-{
- s7_pointer str;
- str = car(args);
+ sc->heap = (s7_cell **)realloc(sc->heap, sc->heap_size * sizeof(s7_cell *));
+ if (!(sc->heap))
+ s7_warn(sc, 256, "heap reallocation failed! tried to get %lu bytes\n", (unsigned long)(sc->heap_size * sizeof(s7_cell *)));
- if (!s7_is_string(str))
- return(s7_wrong_type_arg_error(sc, caller, 0, str, "a string"));
+ sc->free_heap = (s7_cell **)realloc(sc->free_heap, sc->heap_size * sizeof(s7_cell *));
+ if (!(sc->free_heap))
+ s7_warn(sc, 256, "free heap reallocation failed! tried to get %lu bytes\n", (unsigned long)(sc->heap_size * sizeof(s7_cell *)));
- /* currently if the string has an embedded null, it marks the end of the new symbol name.
- * I wonder if this is a bug...
- */
- return(make_symbol(sc, string_value(str)));
+ sc->free_heap_trigger = (s7_cell **)(sc->free_heap + GC_TRIGGER_SIZE);
+ sc->free_heap_top = sc->free_heap + old_free; /* incremented below, added old_free 21-Aug-12?!? */
- /* This can return symbols that can't be used as, for example, variable names.
- * apparently the idea is to allow any string to be converted to a symbol for fast comparisons
- * (i.e. it's an ugly optimization hack).
- */
-}
+ /* optimization suggested by K Matheussen */
+ cells = (s7_cell *)calloc(sc->heap_size - old_size, sizeof(s7_cell));
+ for (p = cells, k = old_size; k < sc->heap_size;)
+ {
+ sc->heap[k] = p;
+ heap_location(p) = k++;
+ (*sc->free_heap_top++) = p++;
+ sc->heap[k] = p;
+ heap_location(p) = k++;
+ (*sc->free_heap_top++) = p++;
+ sc->heap[k] = p;
+ heap_location(p) = k++;
+ (*sc->free_heap_top++) = p++;
+ sc->heap[k] = p;
+ heap_location(p) = k++;
+ (*sc->free_heap_top++) = p++;
+ }
+ sc->previous_free_heap_top = sc->free_heap_top;
+ if (show_heap_stats(sc))
+ fprintf(stderr, "heap grows to %u\n", sc->heap_size);
+}
-static s7_pointer g_string_to_symbol(s7_scheme *sc, s7_pointer args)
+static void try_to_call_gc(s7_scheme *sc)
{
- #define H_string_to_symbol "(string->symbol str) returns the string str converted to a symbol"
- return(g_string_to_symbol_1(sc, args, "string->symbol"));
+ /* called only from new_cell and cons */
+ if (sc->gc_off)
+ {
+ /* we can't just return here! Someone needs a new cell, and once the heap free list is exhausted, segfault */
+ resize_heap(sc);
+ }
+ else
+ {
+#if (!DEBUGGING)
+ unsigned int freed_heap;
+ freed_heap = gc(sc);
+ if ((freed_heap < sc->heap_size / 2) &&
+ (freed_heap < 1000000)) /* if huge heap */
+ resize_heap(sc);
+#else
+ gc(sc);
+ if ((unsigned int)(sc->free_heap_top - sc->free_heap) < sc->heap_size / 2)
+ resize_heap(sc);
+#endif
+ }
}
+ /* originally I tried to mark each temporary value until I was done with it, but
+ * that way madness lies... By delaying GC of _every_ %$^#%@ pointer, I can dispense
+ * with hundreds of individual protections. So the free_heap's last GC_TEMPS_SIZE
+ * allocated pointers are protected during the mark sweep.
+ */
-static s7_pointer g_symbol(s7_scheme *sc, s7_pointer args)
-{
- #define H_symbol "(symbol str) returns the string str converted to a symbol"
- return(g_string_to_symbol_1(sc, args, "symbol"));
-}
-
-#if WITH_PROFILING
-static s7_pointer g_symbol_calls(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_gc(s7_scheme *sc, s7_pointer args)
{
- #define H_symbol_calls "(symbol-calls sym) returns the number of times sym was called (applied)"
- s7_pointer sym, vect;
- int i;
+ #define H_gc "(gc (on #t)) runs the garbage collector. If 'on' is supplied, it turns the GC on or off. \
+Evaluation produces a surprising amount of garbage, so don't leave the GC off for very long!"
+ #define Q_gc s7_make_signature(sc, 2, sc->T, sc->IS_BOOLEAN)
- if (!s7_is_symbol(car(args)))
- return(s7_wrong_type_arg_error(sc, "symbol-calls", 0, car(args), "a symbol"));
-
- sym = eval_symbol(sc, car(args));
- vect = s7_make_vector(sc, 100);
- if (symbol_data(sym))
- {
- for (i = 0; i < 100; i++)
- vector_element(vect, i) = s7_make_integer(sc, symbol_data(sym)[i]);
- }
- else
+ if (is_not_null(args))
{
- for (i = 0; i < 100; i++)
- vector_element(vect, i) = small_int(0);
+ if (!s7_is_boolean(car(args)))
+ method_or_bust(sc, car(args), sc->GC, args, T_BOOLEAN, 0);
+ sc->gc_off = (car(args) == sc->F);
+ if (sc->gc_off)
+ return(sc->F);
}
- return(make_list_2(sc, s7_make_integer(sc, symbol_calls(sym)), vect));
+
+ gc(sc);
+ return(sc->UNSPECIFIED);
}
-static void tick_args(int *data, s7_pointer args)
+s7_pointer s7_gc_on(s7_scheme *sc, bool on)
{
- s7_pointer x;
- int i, base;
-
- for (i = 0, base = 0, x = args; (i < 3) && (is_pair(x)); x = cdr(x), i++, base += 32)
- {
- int typ;
-
- typ = type(car(x));
- if (typ > 27) typ = 27;
- data[base + typ]++;
-
- if (typ == T_NUMBER)
- {
- switch (number_type(car(x)))
- {
- case NUM_INT:
- data[base + 28]++;
- break;
+ sc->gc_off = !on;
+ return(s7_make_boolean(sc, on));
+}
- case NUM_RATIO:
- data[base + 29]++;
- break;
- case NUM_REAL:
- case NUM_REAL2:
- data[base + 30]++;
- break;
+static int permanent_cells = 0;
+#if (!WITH_THREADS)
+static s7_cell *alloc_pointer(void)
+{
+ #define ALLOC_SIZE 256
+ static unsigned int alloc_k = ALLOC_SIZE;
+ static s7_cell *alloc_cells = NULL;
- default:
- data[base + 31]++;
- break;
- }
- }
+ if (alloc_k == ALLOC_SIZE) /* if either no current block or the block is used up */
+ { /* make a new block */
+ permanent_cells += ALLOC_SIZE;
+ alloc_cells = (s7_cell *)calloc(ALLOC_SIZE, sizeof(s7_cell));
+ alloc_k = 0;
}
+ return(&alloc_cells[alloc_k++]);
}
+#else
+#define alloc_pointer() (s7_cell *)calloc(1, sizeof(s7_cell))
#endif
-
-/* -------------------------------- environments -------------------------------- */
-
-#define NEW_FRAME(Sc, Old_Env, New_Env) \
- do { \
- s7_pointer x; \
- NEW_CELL(Sc, x); \
- car(x) = Sc->NIL; \
- cdr(x) = Old_Env; \
- set_type(x, T_PAIR | T_STRUCTURE | T_ENVIRONMENT); \
- New_Env = x; \
- } while (0)
-
-
-static s7_pointer new_frame_in_env(s7_scheme *sc, s7_pointer old_env)
-{
- /* return(s7_cons(sc, sc->NIL, old_env)); */
- s7_pointer x;
- NEW_CELL(sc, x);
- car(x) = sc->NIL;
- cdr(x) = old_env;
- set_type(x, T_PAIR | T_STRUCTURE | T_ENVIRONMENT);
- return(x);
-}
+static void add_permanent_object(s7_scheme *sc, s7_pointer obj)
+{
+ gc_obj *g;
+ g = (gc_obj *)malloc(sizeof(gc_obj));
+ g->p = obj;
+ g->nxt = sc->permanent_objects;
+ sc->permanent_objects = g;
+}
-static s7_pointer g_is_environment(s7_scheme *sc, s7_pointer args)
+static void free_cell(s7_scheme *sc, s7_pointer p)
{
- #define H_is_environment "(environment? obj) returns #t if obj is an environment."
- return(make_boolean(sc, is_environment(car(args))));
+#if DEBUGGING
+ p->debugger_bits = 0;
+#endif
+ clear_type(p);
+ (*(sc->free_heap_top++)) = p;
}
-static s7_pointer add_to_environment(s7_scheme *sc, s7_pointer env, s7_pointer variable, s7_pointer value)
-{
- s7_pointer slot, e;
+static void s7_remove_from_heap(s7_scheme *sc, s7_pointer x)
+{
+ int loc;
+ s7_pointer p;
- e = car(env);
- slot = immutable_cons(sc, variable, value);
+ /* global functions are very rarely redefined, so we can remove the function body from
+ * the heap when it is defined. If redefined, we currently lose the memory held by the
+ * old definition. (It is not trivial to recover this memory because it is allocated
+ * in blocks, not by the pointer, I think, but s7_define is the point to try).
+ *
+ * There is at least one problem with this: if, for example, a function has
+ * a quoted (constant) list, then uses list-set! to change an element of it,
+ * then a GC happens, and the new element is GC'd because no one in the heap
+ * points to it, then we call the function again, and it tries to access
+ * that element.
+ *
+ * (define (bad-idea)
+ * (let ((lst '(1 2 3)))
+ * (let ((result (list-ref lst 1)))
+ * (list-set! lst 1 (* 2.0 16.6))
+ * (gc)
+ * result)))
+ *
+ * put that in a file, load it (to force removal), than call bad-idea a few times.
+ * so... if (*s7* 'safety) is not 0, remove-from-heap is disabled.
+ */
+ loc = heap_location(x);
+ if (not_in_heap(x)) return;
- if (s7_is_vector(e))
+ switch (type(x))
{
- int loc;
-
- if ((sc->safety == 0) &&
- ((is_closure(value)) ||
- (is_closure_star(value)) ||
- (is_macro(value)) ||
- (is_bacro(value))))
-#if HAVE_PTHREADS
+ case T_PAIR:
+ unheap(x);
+ p = alloc_pointer();
+ sc->heap[loc] = p;
+ (*sc->free_heap_top++) = p;
+ heap_location(p) = loc;
+#if 0
+ /* this code fixes the problem above, but at some cost (gc + mark_pair up by about 2% in the worst case (snd-test.scm)) */
+ if ((car(x) == sc->QUOTE) &&
+ (is_pair(cadr(x))))
+ {
+ add_permanent_object(sc, cdr(x));
+ }
+ else
{
- pthread_mutex_lock(&alloc_lock);
- s7_remove_from_heap(sc, closure_source(value));
- pthread_mutex_unlock(&alloc_lock);
+ s7_remove_from_heap(sc, car(x));
+ s7_remove_from_heap(sc, cdr(x));
}
#else
- s7_remove_from_heap(sc, closure_source(value));
+ s7_remove_from_heap(sc, car(x));
+ s7_remove_from_heap(sc, cdr(x));
#endif
+ return;
- loc = symbol_location(variable);
- vector_element(e, loc) = s7_cons(sc, slot, vector_element(e, loc));
- symbol_global_slot(variable) = slot;
-
- /* so if we (define hi "hiho") at the top level, "hi" hashes to 1746 with symbol table size 2207
- * s7->symbol_table->object.vector.elements[1746]->object.cons.car->object.cons.car->object.string.global_slot is (hi . \"hiho\")
- */
- }
- else
- {
- s7_pointer x;
- NEW_CELL(sc, x);
- car(x) = slot;
- cdr(x) = e;
- set_type(x, T_PAIR | T_STRUCTURE);
- car(env) = x;
- set_local(variable);
-
- /* currently any top-level value is in symbol_global_slot
- * if never a local binding, is_local bit is off, so we go straight to the global binding
- * if any local binding, local bit is set and never cleared, so even if we
- * later define the same symbol at top-level, then go back to the local env case,
- * the local bit protects us from accidentally grabbing the global value.
+ case T_HASH_TABLE:
+ case T_LET:
+ case T_VECTOR:
+ /* not int|float_vector or string because none of their elements are GC-able (so unheap below is ok)
+ * but hash-table and let seem like they need protection? And let does happen via define-class.
*/
+ add_permanent_object(sc, x);
+ return;
- /* I tried adding a unique_local bit for symbols defined locally only once, but
- * there's no way to be sure the frame originally holding it is active (it might have been
- * GC'd, then reallocated as a frame that is currently active!).
- *
- * this will hit the problem:
-
- (do ((i 0 (+ i 1))) ((= i 1000))
- (let ((str (format #f "(let ((v~D ~D)) v~D)" i i i)))
- (eval-string str)
- (gc)
- (do ((k 0 (+ k 1))) ((= k i))
- (let ((str (format #f "(let ((a 1) (b 2) (c 3) (d 4)) \
- (if (defined? 'v~D) (format #t \"v~D is defined? ~~A~~%\" v~D)))" k k k)))
- (eval-string str)))))
- */
- }
+ case T_SYNTAX:
+ return;
- return(slot); /* csr(slot) might be used at some point by symbol_access */
-}
+ case T_SYMBOL:
+ if (is_gensym(x))
+ {
+ unsigned int i;
+ sc->heap[loc] = alloc_pointer();
+ free_cell(sc, sc->heap[loc]);
+ heap_location(sc->heap[loc]) = loc;
+
+ /* unheap(x); */
+ heap_location(x) = -heap_location(x);
+ /* if gensym is a hash-table key, then is removed from the heap, we need to be sure the hash-table map to it
+ * continues to be valid. symbol_hmap is abs(heap_location), and the possible overlap with other not-in-heap
+ * ints is not problematic (they'll just hash to the same location).
+ */
+ for (i = 0; i < sc->gensyms_loc; i++)
+ if (sc->gensyms[i] == x)
+ {
+ unsigned int j;
+ for (j = i + 1; i < sc->gensyms_loc; i++, j++)
+ sc->gensyms[i] = sc->gensyms[j];
+ sc->gensyms_loc--;
+ if (sc->gensyms_loc == 0) mark_function[T_SYMBOL] = mark_noop;
+ break;
+ }
+ }
+ return;
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ unheap(x);
+ p = alloc_pointer();
+ free_cell(sc, p);
+ sc->heap[loc] = p;
+ heap_location(p) = loc;
+
+ s7_remove_from_heap(sc, closure_args(x));
+ s7_remove_from_heap(sc, closure_body(x));
+ return;
-static s7_pointer add_to_current_environment(s7_scheme *sc, s7_pointer variable, s7_pointer value)
-{
- if (is_immutable_or_accessed(variable))
- {
- if (is_immutable(variable)) /* (let ((pi 3)) pi) */
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "can't bind an immutable object: ~S"), variable)));
- value = call_symbol_bind(sc, variable, value);
+ default:
+ break;
}
- return(add_to_environment(sc, sc->envir, variable, value));
-}
-
-
-static s7_pointer add_to_local_environment(s7_scheme *sc, s7_pointer variable, s7_pointer value)
-{
- /* this is called when it is guaranteed that there is a local environment */
- s7_pointer x, y;
+ unheap(x);
+ p = alloc_pointer();
+ free_cell(sc, p);
+ sc->heap[loc] = p;
+ heap_location(p) = loc;
+}
- if (is_immutable_or_accessed(variable))
- {
- if (is_immutable(variable))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "can't bind an immutable object: ~S"), variable)));
- value = call_symbol_bind(sc, variable, value);
- }
- NEW_CELL(sc, y);
- car(y) = variable;
- cdr(y) = value;
- set_type(y, T_PAIR | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
- NEW_CELL(sc, x);
- /* car(x) = immutable_cons(sc, variable, value); */
- car(x) = y;
- cdr(x) = car(sc->envir);
- set_type(x, T_PAIR | T_STRUCTURE);
- car(sc->envir) = x;
- set_local(variable);
+/* -------------------------------- stacks -------------------------------- */
- return(y);
-}
+#define OP_STACK_INITIAL_SIZE 32
+#if DEBUGGING
+#define stop_at_error true
-static void save_initial_environment(s7_scheme *sc)
+static void push_op_stack(s7_scheme *sc, s7_pointer op)
{
- /* there are ca 270 predefined functions (and another 30 or so other things)
- */
- #define INITIAL_ENV_ENTRIES 300
- int i, k = 0, len;
- s7_pointer ge;
- s7_pointer *lsts, *inits;
-
- sc->initial_env = (s7_pointer)calloc(1, sizeof(s7_cell));
- set_type(sc->initial_env, T_VECTOR | T_FINALIZABLE | T_DONT_COPY | T_STRUCTURE);
- vector_length(sc->initial_env) = INITIAL_ENV_ENTRIES;
- vector_elements(sc->initial_env) = (s7_pointer *)malloc(INITIAL_ENV_ENTRIES * sizeof(s7_pointer));
- inits = vector_elements(sc->initial_env);
- s7_vector_fill(sc, sc->initial_env, sc->NIL);
- sc->initial_env->hloc = NOT_IN_HEAP;
-
- ge = car(sc->global_env);
- len = vector_length(ge);
- lsts = vector_elements(ge);
-
- for (i = 0; i < len; i++)
- if (lsts[i] != sc->NIL)
- {
- s7_pointer slot;
- for (slot = car(lsts[i]); is_pair(slot); slot = cdr(slot))
- if (is_procedure(symbol_value(slot)))
- {
- inits[k++] = permanent_cons(car(slot), cdr(slot), T_PAIR | T_SIMPLE | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
- if (k >= INITIAL_ENV_ENTRIES)
- break;
- }
- }
+ (*sc->op_stack_now++) = _NFre(op);
+ if (sc->op_stack_now > (sc->op_stack + sc->op_stack_size))
+ {
+ fprintf(stderr, "%sop_stack overflow%s\n", BOLD_TEXT, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
}
-
-static s7_pointer g_initial_environment(s7_scheme *sc, s7_pointer args)
+static s7_pointer pop_op_stack(s7_scheme *sc)
{
- /* add sc->initial_env bindings to the current environment */
- #define H_initial_environment "(initial-environment) establishes the original bindings of all the predefined functions"
-
- /* maybe this should be named with-initial-environment or something -- it currently looks
- * like it simply returns the initial env
- */
+ s7_pointer op;
+ op = (*(--(sc->op_stack_now)));
+ if (sc->op_stack_now < sc->op_stack)
+ {
+ fprintf(stderr, "%sop_stack underflow%s\n", BOLD_TEXT, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(_NFre(op));
+}
+#else
+#define push_op_stack(Sc, Op) (*Sc->op_stack_now++) = Op
+#define pop_op_stack(Sc) (*(--(Sc->op_stack_now)))
+#endif
+static void initialize_op_stack(s7_scheme *sc)
+{
int i;
- s7_pointer *inits;
- s7_pointer x;
-
- sc->w = new_frame_in_env(sc, sc->envir);
- inits = vector_elements(sc->initial_env);
-
- for (i = 0; (i < INITIAL_ENV_ENTRIES) && (inits[i] != sc->NIL); i++)
- if ((is_local(car(inits[i]))) || /* it's shadowed locally */
- (cdr(inits[i]) != symbol_value(symbol_global_slot(car(inits[i]))))) /* it's not shadowed, but has been changed globally */
- add_to_environment(sc, sc->w, car(inits[i]), cdr(inits[i]));
-
- /* if (set! + -) then + needs to be overridden, but the local bit isn't set,
- * so we have to check the actual values in the non-local case.
- * (define (f x) (with-environment (initial-environment) (+ x 1)))
- */
-
- x = sc->w;
- sc->w = sc->NIL;
- return(x);
+ sc->op_stack = (s7_pointer *)malloc(OP_STACK_INITIAL_SIZE * sizeof(s7_pointer));
+ sc->op_stack_size = OP_STACK_INITIAL_SIZE;
+ sc->op_stack_now = sc->op_stack;
+ sc->op_stack_end = (s7_pointer *)(sc->op_stack + sc->op_stack_size);
+ for (i = 0; i < OP_STACK_INITIAL_SIZE; i++)
+ sc->op_stack[i] = sc->NIL;
}
-static s7_pointer g_augment_environment_direct(s7_scheme *sc, s7_pointer args)
+static void resize_op_stack(s7_scheme *sc)
{
- #define H_augment_environment_direct "(augment-environment! env ...) adds its \
-arguments (each a cons: symbol . value) directly to the environment env, and returns the \
-environment."
+ int i, loc, new_size;
+ loc = (int)(sc->op_stack_now - sc->op_stack);
+ new_size = sc->op_stack_size * 2;
+ sc->op_stack = (s7_pointer *)realloc((void *)(sc->op_stack), new_size * sizeof(s7_pointer));
+ for (i = sc->op_stack_size; i < new_size; i++)
+ sc->op_stack[i] = sc->NIL;
+ sc->op_stack_size = new_size;
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + loc);
+ sc->op_stack_end = (s7_pointer *)(sc->op_stack + sc->op_stack_size);
+}
- s7_pointer x, e;
- int i, gc_loc = -1;
- e = car(args);
+#define stack_code(Stack, Loc) vector_element(_TStk(Stack), Loc - 3)
+#define stack_let(Stack, Loc) vector_element(_TStk(Stack), Loc - 2)
+#define stack_args(Stack, Loc) vector_element(_TStk(Stack), Loc - 1)
+#define stack_op(Stack, Loc) ((opcode_t)(vector_element(_TStk(Stack), Loc)))
- if (!is_environment(e))
+#if DEBUGGING
+static void pop_stack(s7_scheme *sc)
+{
+ sc->stack_end -= 4;
+ if (sc->stack_end < sc->stack_start)
{
- if (e == sc->NIL) /* the empty environment */
- {
- e = new_frame_in_env(sc, sc->NIL);
- gc_loc = s7_gc_protect(sc, e);
- }
- else return(s7_wrong_type_arg_error(sc, "augment-environment!", 1, e, "an environment"));
+ fprintf(stderr, "%sstack underflow%s\n", BOLD_TEXT, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ sc->code = sc->stack_end[0];
+ sc->envir = _TLid(sc->stack_end[1]);
+ sc->args = sc->stack_end[2];
+ sc->op = (opcode_t)(sc->stack_end[3]);
+ if (sc->op > OP_MAX_DEFINED)
+ {
+ fprintf(stderr, "%sinvalid opcode: " INT_FORMAT "%s\n", BOLD_TEXT, sc->op, UNBOLD_TEXT);
+ if (stop_at_error) abort();
}
-
- for (i = 2, x = cdr(args); x != sc->NIL; x = cdr(x), i++)
- if ((!is_pair(car(x))) ||
- (!s7_is_symbol(caar(x))))
- {
- if (gc_loc != -1)
- s7_gc_unprotect_at(sc, gc_loc);
- return(s7_wrong_type_arg_error(sc, "augment-environment!", i, car(x), "a pair: '(symbol . value)"));
- }
-
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
- add_to_environment(sc, e, caar(x), cdar(x));
-
- if (gc_loc != -1)
- s7_gc_unprotect_at(sc, gc_loc);
-
- return(e);
}
-
-s7_pointer s7_augment_environment(s7_scheme *sc, s7_pointer e, s7_pointer bindings)
+static void pop_stack_no_op(s7_scheme *sc)
{
- s7_pointer x, new_e;
- int gc_loc;
-
- new_e = new_frame_in_env(sc, e);
- gc_loc = s7_gc_protect(sc, new_e);
-
- for (x = bindings; x != sc->NIL; x = cdr(x))
- add_to_environment(sc, new_e, caar(x), cdar(x));
-
- s7_gc_unprotect_at(sc, gc_loc);
- return(new_e);
+ sc->stack_end -= 4;
+ if (sc->stack_end < sc->stack_start)
+ {
+ fprintf(stderr, "%sstack underflow%s\n", BOLD_TEXT, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ sc->code = sc->stack_end[0];
+ sc->envir = _TLid(sc->stack_end[1]);
+ sc->args = sc->stack_end[2];
}
-
-static s7_pointer g_augment_environment(s7_scheme *sc, s7_pointer args)
+static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer code)
{
- #define H_augment_environment "(augment-environment env ...) adds its \
-arguments (each a cons: symbol . value) to the environment env, and returns the \
-new environment."
-
- s7_pointer e, x;
- int i, gc_loc = -1;
-
- e = car(args);
- if (!is_environment(e))
+ if (sc->stack_end >= sc->stack_start + sc->stack_size)
{
- if (e == sc->NIL) /* the empty environment */
- {
- e = new_frame_in_env(sc, sc->NIL);
- gc_loc = s7_gc_protect(sc, e);
- }
- else return(s7_wrong_type_arg_error(sc, "augment-environment", 1, e, "an environment"));
+ fprintf(stderr, "%sstack overflow%s\n", BOLD_TEXT, UNBOLD_TEXT);
+ if (stop_at_error) abort();
}
-
- for (i = 2, x = cdr(args); x != sc->NIL; x = cdr(x), i++)
- if ((!is_pair(car(x))) ||
- (!s7_is_symbol(caar(x))))
- {
- if (gc_loc != -1)
- s7_gc_unprotect_at(sc, gc_loc);
- return(s7_wrong_type_arg_error(sc, "augment-environment", i, car(x), "a pair: '(symbol . value)"));
- }
-
- if (gc_loc != -1)
- s7_gc_unprotect_at(sc, gc_loc);
-
- return(s7_augment_environment(sc, e, cdr(args)));
+ if (code) sc->stack_end[0] = code;
+ sc->stack_end[1] = _TLid(sc->envir);
+ if (args) sc->stack_end[2] = args;
+ sc->stack_end[3] = (s7_pointer)op;
+ sc->stack_end += 4;
}
+#define push_stack_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, NULL)
+#define push_stack_no_args(Sc, Op, Code) push_stack(Sc, Op, NULL, Code)
-static s7_pointer find_symbol(s7_scheme *sc, s7_pointer env, s7_pointer hdl)
-{
- s7_pointer x;
- /* this is a list (of alists, each representing a frame) ending with a vector (the global environment).
- * max linear search in s7test: 351! average search len in s7test: 9. Although this takes about 10%
- * the total compute time in s7test.scm, in snd-test it is around 1% -- s7test is a special case.
- * The longest searches are in the huge let ca line 12638 (each variable in let has a new frame),
- * and push/pop in the CLisms section.
- */
+#else
+/* these macros are faster than the equivalent simple function calls. If the s7_scheme struct is set up to reflect the
+ * stack order [code envir args op], we can use memcpy here:
+ * #define pop_stack(Sc) do {Sc->stack_end -= 4; memcpy((void *)Sc, (void *)(Sc->stack_end), 4 * sizeof(s7_pointer));} while (0)
+ * but it is only slightly faster (.2% at best)!
+ */
- for (x = env; is_pair(x); x = cdr(x))
- if (car(x) != sc->NIL)
- {
- s7_pointer y;
- /* using csr to hold the last found entity in each frame was much slower!
- * using csr for caar makes no difference.
- * I also tried using csr as the logand of all the lognots of the hdls (car slot) in the env alist
- * logand(hdl, csr(car(env))) != 0 then means hdl is not in the current env, so we can skip the search.
- * the timings reported by callgrind indicate that this saves almost exactly as much time as it costs!
- * Similarly for max (nil==0 etc).
- */
+#define pop_stack(Sc) \
+ do { \
+ Sc->stack_end -= 4; \
+ Sc->code = Sc->stack_end[0]; \
+ Sc->envir = Sc->stack_end[1]; \
+ Sc->args = Sc->stack_end[2]; \
+ Sc->op = (opcode_t)(Sc->stack_end[3]); \
+ } while (0)
+
+#define pop_stack_no_op(Sc) \
+ do { \
+ Sc->stack_end -= 4; \
+ Sc->code = Sc->stack_end[0]; \
+ Sc->envir = Sc->stack_end[1]; \
+ Sc->args = Sc->stack_end[2]; \
+ } while (0)
+
+#define push_stack(Sc, Op, Args, Code) \
+ do { \
+ Sc->stack_end[0] = Code; \
+ Sc->stack_end[1] = Sc->envir; \
+ Sc->stack_end[2] = Args; \
+ Sc->stack_end[3] = (s7_pointer)Op; \
+ Sc->stack_end += 4; \
+ } while (0)
+
+#define push_stack_no_code(Sc, Op, Args) \
+ do { \
+ Sc->stack_end[2] = Args; \
+ Sc->stack_end[3] = (s7_pointer)Op; \
+ Sc->stack_end += 4; \
+ } while (0)
+
+#define push_stack_no_args(Sc, Op, Code) \
+ do { \
+ Sc->stack_end[0] = Code; \
+ Sc->stack_end[1] = Sc->envir; \
+ Sc->stack_end[3] = (s7_pointer)Op; \
+ Sc->stack_end += 4; \
+ } while (0)
+#endif
+/* since we don't GC mark the stack past the stack_top, push_stack_no_args and friends can cause pop_stack to set
+ * sc->code and sc->args to currently free objects.
+ */
- y = car(x);
+#define main_stack_op(Sc) ((opcode_t)(Sc->stack_end[-1]))
+/* #define main_stack_args(Sc) (Sc->stack_end[-2]) */
+/* #define main_stack_let(Sc) (Sc->stack_end[-3]) */
+/* #define main_stack_code(Sc) (Sc->stack_end[-4]) */
+/* #define pop_main_stack(Sc) Sc->stack_end -= 4 */
- if (s7_is_vector(y))
- return(symbol_global_slot(hdl));
+/* beware of main_stack_code! If a function has a tail-call, the main_stack_code that form sees
+ * if main_stack_op==op-begin1 can change from call to call -- the begin actually refers
+ * to the caller, which is dependent on where the current function was called, so we can't hard-wire
+ * any optimizations based on that sequence.
+ */
- if (caar(y) == hdl)
- return(car(y));
-
- for (y = cdr(y); is_pair(y); y = cdr(y))
- if (caar(y) == hdl)
- return(car(y));
- }
- return(sc->NIL);
-}
+static void stack_reset(s7_scheme *sc)
+{
+ sc->stack_end = sc->stack_start;
+ push_stack(sc, OP_BARRIER, sc->NIL, sc->NIL);
+}
-static s7_pointer find_local_symbol(s7_scheme *sc, s7_pointer env, s7_pointer hdl)
-{
- s7_pointer y;
+static void resize_stack(s7_scheme *sc)
+{
+ unsigned int i, new_size, loc; /* long long ints?? sc->stack_size also is an unsigned int */
- y = car(env);
- if (y == sc->NIL) return(sc->NIL);
+ loc = s7_stack_top(sc);
+ new_size = sc->stack_size * 2;
- if (s7_is_vector(y))
- return(symbol_global_slot(hdl));
+ /* how can we trap infinite recursions? Is a warning in order here?
+ * I think I'll add 'max-stack-size
+ * size currently reaches 8192 in s7test
+ */
+ if (new_size > sc->max_stack_size)
+ s7_error(sc, s7_make_symbol(sc, "stack-too-big"), set_elist_1(sc, make_string_wrapper(sc, "stack has grown past (*s7* 'max-stack-size)")));
- if (caar(y) == hdl)
- return(car(y));
-
- for (y = cdr(y); is_pair(y); y = cdr(y))
- if (caar(y) == hdl)
- return(car(y));
+ vector_elements(sc->stack) = (s7_pointer *)realloc(vector_elements(sc->stack), new_size * sizeof(s7_pointer));
+ if (vector_elements(sc->stack) == NULL)
+ s7_error(sc, s7_make_symbol(sc, "stack-too-big"), set_elist_1(sc, make_string_wrapper(sc, "no room to expand stack?")));
- return(sc->NIL);
-}
+ for (i = sc->stack_size; i < new_size; i++)
+ vector_element(sc->stack, i) = sc->NIL;
+ vector_length(sc->stack) = new_size;
+ sc->stack_size = new_size;
+ sc->stack_start = vector_elements(sc->stack);
+ sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
+ sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2);
-s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym) /* was searching just the global environment? */
-{
- s7_pointer x;
- x = find_symbol(sc, sc->envir, sym);
- if (x != sc->NIL)
- return(symbol_value(x));
- if (is_keyword(sym))
- return(sym);
- return(sc->UNDEFINED);
+ if (show_stack_stats(sc))
+ fprintf(stderr, "stack grows to %u\n", new_size);
}
-
-s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer local_env)
-{
- s7_pointer x;
- x = find_symbol(sc, local_env, sym);
- if (x != sc->NIL)
- return(symbol_value(x));
- return(s7_symbol_value(sc, sym)); /* try sc->envir */
-}
+#define check_stack_size(Sc) \
+ if (Sc->stack_end >= Sc->stack_resize_trigger) \
+ { \
+ if ((Sc->begin_hook) && (call_begin_hook(Sc))) return(Sc->F); \
+ resize_stack(Sc); \
+ }
-static s7_pointer g_symbol_to_value(s7_scheme *sc, s7_pointer args)
-{
- #define H_symbol_to_value "(symbol->value sym (env (current-environment))) returns the binding of (the value associated with) the \
-symbol sym in the given environment: (let ((x 32)) (symbol->value 'x)) -> 32"
- s7_pointer local_env;
+/* -------------------------------- symbols -------------------------------- */
- if (!s7_is_symbol(car(args)))
- return(s7_wrong_type_arg_error(sc, "symbol->value", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "a symbol"));
+static unsigned long long int raw_string_hash(const unsigned char *key, unsigned int len)
+{
+ unsigned long long int x;
+ unsigned char *cx = (unsigned char *)&x;
- if (cdr(args) != sc->NIL)
+ x = 0;
+ if (len <= 8)
+ memcpy((void *)cx, (void *)key, len);
+ else
{
- if (!is_environment(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "symbol->value", 2, cadr(args), "an environment"));
- local_env = cadr(args);
- }
- else local_env = sc->envir;
+ unsigned long long int y;
+ unsigned char *cy = (unsigned char *)&y;
- return(s7_symbol_local_value(sc, car(args), local_env));
+ memcpy((void *)cx, (void *)key, 8);
+ y = 0;
+ len -= 8;
+ memcpy((void *)cy, (void *)(key + 8), (len > 8) ? 8 : len);
+ x |= y;
+ }
+ return(x);
}
-s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+static s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, unsigned int len);
+
+static s7_pointer new_symbol(s7_scheme *sc, const char *name, unsigned int len, unsigned long long int hash, unsigned int location)
{
- s7_pointer x;
- /* if immutable should this return an error? */
- x = find_symbol(sc, sc->envir, sym);
- if (x != sc->NIL)
- set_symbol_value(x, val);
- return(val);
-}
+ s7_pointer x, str, p;
+ unsigned char *base, *val;
+
+ if (sc->symbol_table_is_locked)
+ return(s7_error(sc, sc->ERROR, sc->NIL));
+ base = (unsigned char *)malloc(sizeof(s7_cell) * 3 + len + 1);
+ x = (s7_pointer)base;
+ str = (s7_pointer)(base + sizeof(s7_cell));
+ p = (s7_pointer)(base + 2 * sizeof(s7_cell));
+ val = (unsigned char *)(base + 3 * sizeof(s7_cell));
+ memcpy((void *)val, (void *)name, len);
+ val[len] = '\0';
+
+ unheap(str);
+ typeflag(str) = T_STRING | T_IMMUTABLE; /* avoid debugging confusion involving set_type (also below) */
+ string_length(str) = len;
+ string_value(str) = (char *)val;
+ string_hash(str) = hash;
+ string_needs_free(str) = false;
+
+ unheap(x);
+ typeflag(x) = T_SYMBOL;
+ set_symbol_name_cell(x, str);
+ global_slot(x) = sc->UNDEFINED; /* was sc->NIL; */
+ initial_slot(x) = sc->UNDEFINED;
+ symbol_set_local(x, 0LL, sc->NIL);
+ symbol_tag(x) = 0;
+
+ if (symbol_name_length(x) > 1) /* not 0, otherwise : is a keyword */
+ {
+ if (name[0] == ':')
+ {
+ typeflag(x) |= (T_IMMUTABLE | T_KEYWORD);
+ keyword_symbol(x) = make_symbol_with_length(sc, (char *)(name + 1), len - 1);
+ global_slot(x) = s7_make_slot(sc, sc->NIL, x, x);
+ }
+ else
+ {
+ char c;
+ c = name[symbol_name_length(x) - 1];
+ if (c == ':')
+ {
+ char *kstr;
+ unsigned int klen;
+ klen = symbol_name_length(x) - 1;
+ /* can't used tmpbuf_* here (or not safely I think) because name is already using tmpbuf */
+ kstr = (char *)malloc((klen + 1) * sizeof(char));
+ memcpy((void *)kstr, (void *)name, klen);
+ kstr[klen] = 0;
+ typeflag(x) |= (T_IMMUTABLE | T_KEYWORD);
+ keyword_symbol(x) = make_symbol_with_length(sc, kstr, klen);
+ global_slot(x) = s7_make_slot(sc, sc->NIL, x, x);
+ free(kstr);
+ }
+ }
+ }
-typedef enum {LSTAR_NO_SUCH_KEY, LSTAR_OK, LSTAR_ALREADY_SET, LSTAR_TOO_MANY_ARGS} lstar_err_t;
+ unheap(p);
+ typeflag(p) = T_PAIR | T_IMMUTABLE;
+ car(p) = x;
+ cdr(p) = vector_element(sc->symbol_table, location);
+ vector_element(sc->symbol_table, location) = p;
+ pair_set_raw_hash(p, hash);
+ pair_set_raw_len(p, len);
+ pair_set_raw_name(p, string_value(str));
+ return(x);
+}
-static lstar_err_t lambda_star_argument_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+static s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, unsigned int len)
{
s7_pointer x;
+ unsigned long long int hash;
+ unsigned int location;
- for (x = car(sc->envir) /* presumably the arglist */; is_pair(x); x = cdr(x))
- if (caar(x) == sym) /* car(x) won't be sc->NIL here even if no args and no locals because we at least have __func__ */
- {
- /* car(x) is our binding (symbol . value) */
- if (is_not_local(car(x)))
- set_local(car(x)); /* this is a special use of this bit, I think */
- else return(LSTAR_ALREADY_SET);
- cdar(x) = val;
- return(LSTAR_OK);
- }
+ hash = raw_string_hash((const unsigned char *)name, len);
+ location = hash % SYMBOL_TABLE_SIZE;
- return(LSTAR_NO_SUCH_KEY);
+ if (len <= 8)
+ {
+ for (x = vector_element(sc->symbol_table, location); is_pair(x); x = cdr(x))
+ if ((hash == pair_raw_hash(x)) &&
+ (len == pair_raw_len(x)))
+ return(car(x));
+ }
+ else
+ {
+ for (x = vector_element(sc->symbol_table, location); is_pair(x); x = cdr(x))
+ if ((hash == pair_raw_hash(x)) &&
+ (len == pair_raw_len(x)) &&
+ (strings_are_equal_with_length(name, pair_raw_name(x), len))) /* length here because name might not be null-terminated */
+ return(car(x));
+ }
+ return(new_symbol(sc, name, len, hash, location));
}
-static s7_pointer lambda_star_argument_default_value(s7_scheme *sc, s7_pointer val)
+static s7_pointer make_symbol(s7_scheme *sc, const char *name)
{
- /* if val is an expression, it needs to be evaluated in the definition environment
- * (let ((c 1)) (define* (a (b (+ c 1))) b) (set! c 2) (a)) -> 3
- */
+ return(make_symbol_with_length(sc, name, safe_strlen(name)));
+}
- s7_pointer x;
- if (s7_is_symbol(val))
- {
- x = find_symbol(sc, sc->envir, val);
- if (x != sc->NIL)
- return(symbol_value(x));
- }
-
- if (is_pair(val))
- {
- if (car(val) == sc->QUOTE)
- return(cadr(val));
- x = sc->z;
+s7_pointer s7_make_symbol(s7_scheme *sc, const char *name)
+{
+ if (!name) return(sc->F);
+ return(make_symbol_with_length(sc, name, safe_strlen(name)));
+}
- if (s7_stack_top(sc) < 12)
- push_stack(sc, opcode(OP_BARRIER), sc->args, sc->code);
- /* If this barrier is omitted, we get a segfault from
- * (call-with-exit (lambda (quit) ((lambda* ((a (quit 32))) a))))
- * when typed to the listener's prompt (it's ok in other situations).
- */
+static s7_pointer symbol_table_find_by_name(s7_scheme *sc, const char *name, unsigned long long int hash, unsigned int location)
+{
+ s7_pointer x;
+ for (x = vector_element(sc->symbol_table, location); is_not_null(x); x = cdr(x))
+ if ((hash == pair_raw_hash(x)) &&
+ (strings_are_equal(name, pair_raw_name(x))))
+ return(car(x));
+ return(sc->NIL);
+}
- push_stack(sc, opcode(OP_EVAL_DONE), sc->args, sc->code);
- sc->args = sc->NIL;
- sc->code = val;
- eval(sc, OP_EVAL);
- /* ideally we'd drop into the evaluator here, not call it as a procedure. This way
- * of getting the value is only safe for a C-side call like s7_read; for s7-internal
- * calls, error handling assumes we're using the s7 stack, not the C stack. So,
- * we better not get an error while evaluating the argument default value!
- */
+s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name)
+{
+ unsigned long long int hash;
+ unsigned int location;
+ s7_pointer result;
- sc->z = x;
- return(sc->value);
- }
+ hash = raw_string_hash((const unsigned char *)name, safe_strlen(name));
+ location = hash % SYMBOL_TABLE_SIZE;
+ result = symbol_table_find_by_name(sc, name, hash, location);
+ if (is_null(result))
+ return(NULL);
- return(val);
+ return(result);
}
-static s7_pointer g_global_environment(s7_scheme *sc, s7_pointer ignore)
+#define FILLED true
+#define NOT_FILLED false
+
+static s7_pointer g_symbol_table(s7_scheme *sc, s7_pointer args)
{
- #define H_global_environment "(global-environment) returns the current top-level definitions (symbol bindings). \
-It is a list ending with a hash-table."
- return(sc->global_env);
-}
+ #define H_symbol_table "(symbol-table) returns a vector containing the current symbol-table symbols"
+ #define Q_symbol_table s7_make_signature(sc, 1, sc->IS_VECTOR)
-/* as with the symbol-table, this function can lead to disaster -- user could
- * clobber the environment etc. But we want it to be editable and augmentable,
- * so I guess I'll leave it alone. (See current|procedure-environment as well).
- */
+ s7_pointer lst, x;
+ s7_pointer *els;
+ int i, j, syms = 0;
+ /* this can't be optimized by returning the actual symbol-table (a vector of lists), because
+ * gensyms can cause the table's lists and symbols to change at any time. This wreaks havoc
+ * on traversals like for-each. So, symbol-table returns a snap-shot of the table contents
+ * at the time it is called, and we call gc before making the list. I suppose the next step
+ * is to check that we have room, and increase the heap here if necessary!
+ *
+ * (define (for-each-symbol func num) (for-each (lambda (sym) (if (> num 0) (for-each-symbol func (- num 1)) (func sym))) (symbol-table)))
+ * (for-each-symbol (lambda (sym) (gensym) 1))
+ */
-#if HAVE_PTHREADS
-static s7_pointer thread_environment(s7_scheme *sc, s7_pointer obj);
-#define CURRENT_ENVIRONMENT_OPTARGS 1
-#else
-#define CURRENT_ENVIRONMENT_OPTARGS 0
-#endif
+ for (i = 0; i < vector_length(sc->symbol_table); i++)
+ for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+ syms++;
+ sc->w = make_vector_1(sc, syms, NOT_FILLED, T_VECTOR);
+ els = vector_elements(sc->w);
-static s7_pointer g_current_environment(s7_scheme *sc, s7_pointer args)
-{
-#if HAVE_PTHREADS
- #define H_current_environment "(current-environment (thread #f)) returns the current definitions (symbol bindings)"
- if (args != sc->NIL)
- {
- if (!(s7_is_thread(car(args))))
- return(s7_wrong_type_arg_error(sc, "current-environment", 0, car(args), "a thread object"));
- return(thread_environment(sc, car(args)));
- }
-#else
- #define H_current_environment "(current-environment) returns the current definitions (symbol bindings)"
-#endif
- return(sc->envir);
+ for (i = 0, j = 0; i < vector_length(sc->symbol_table); i++)
+ for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+ els[j++] = car(x);
+
+ lst = sc->w;
+ sc->w = sc->NIL;
+ return(lst);
}
-static s7_pointer make_closure(s7_scheme *sc, s7_pointer code, s7_pointer environment, int type)
+bool s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
{
- /* this is called every time a lambda form is evaluated, or during letrec, etc */
-
+ /* this includes the special constants #<unspecified> and so on for simplicity -- are there any others? */
+ int i;
s7_pointer x;
- NEW_CELL(sc, x);
- car(x) = code;
- cdr(x) = environment;
- set_type(x, type | T_PROCEDURE | T_DONT_COPY_CDR | T_DONT_COPY);
- return(x);
-}
+ for (i = 0; i < vector_length(sc->symbol_table); i++)
+ for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+ if (symbol_func(symbol_name(car(x)), data))
+ return(true);
-s7_pointer s7_make_closure(s7_scheme *sc, s7_pointer c, s7_pointer e)
-{
- /* c is a list: args code, so
- * (define (proc a b) (+ a b)) becomes
- * make_closure ((a b) (+ a b)) e
- */
- return(make_closure(sc, c, e, T_CLOSURE));
+ return((symbol_func("#t", data)) ||
+ (symbol_func("#f", data)) ||
+ (symbol_func("#<unspecified>", data)) ||
+ (symbol_func("#<undefined>", data)) ||
+ (symbol_func("#<eof>", data)) ||
+ (symbol_func("#true", data)) ||
+ (symbol_func("#false", data)));
}
-s7_pointer s7_global_environment(s7_scheme *sc)
+bool s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, s7_pointer value, void *data), void *data)
{
- return(sc->global_env);
-}
+ int i;
+ s7_pointer x;
+ for (i = 0; i < vector_length(sc->symbol_table); i++)
+ for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+ if (symbol_func(symbol_name(car(x)), cdr(x), data))
+ return(true);
-s7_pointer s7_current_environment(s7_scheme *sc)
-{
- return(sc->envir);
+ return(false);
}
-static s7_pointer g_is_defined(s7_scheme *sc, s7_pointer args)
+static void remove_gensym_from_symbol_table(s7_scheme *sc, s7_pointer sym)
{
- #define H_is_defined "(defined? obj (env (current-environment))) returns #t if obj has a binding (a value) in the environment env"
- s7_pointer x;
+ /* sym is a free cell at this point (we're called after the GC), but the name_cell is still intact */
+ s7_pointer x, name;
+ unsigned int location;
- if (!s7_is_symbol(car(args)))
- return(s7_wrong_type_arg_error(sc, "defined?", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "a symbol"));
-
- if (cdr(args) != sc->NIL)
+ name = symbol_name_cell(sym);
+ location = string_hash(name) % SYMBOL_TABLE_SIZE;
+ x = vector_element(sc->symbol_table, location);
+
+ if (car(x) == sym)
{
- if (!is_environment(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "defined?", 2, cadr(args), "an environment"));
- x = cadr(args);
+ vector_element(sc->symbol_table, location) = cdr(x);
+ free(x);
+ }
+ else
+ {
+ s7_pointer y;
+ for (y = x, x = cdr(x); is_pair(x); y = x, x = cdr(x))
+ {
+ if (car(x) == sym)
+ {
+ cdr(y) = cdr(x);
+ free(x);
+ return;
+ }
+ }
+#if DEBUGGING
+ fprintf(stderr, "could not remove %s?\n", string_value(name));
+#endif
}
- else x = sc->envir;
-
- if (is_syntax(car(args))) /* put env check first, else (defined? 'lambda car) -> #t */
- return(sc->T);
-
- x = find_symbol(sc, x, car(args));
- return(make_boolean(sc, (x != sc->NIL) && (x != sc->UNDEFINED)));
}
-bool s7_is_defined(s7_scheme *sc, const char *name)
+s7_pointer s7_gensym(s7_scheme *sc, const char *prefix)
{
+ char *name;
+ unsigned int len, location;
+ unsigned long long int hash;
s7_pointer x;
- x = find_symbol(sc, sc->envir, make_symbol(sc, name));
- return((x != sc->NIL) && (x != sc->UNDEFINED));
+
+ len = safe_strlen(prefix) + 32;
+ tmpbuf_malloc(name, len);
+ /* there's no point in heroic efforts here to avoid name collisions -- the user can screw up no matter what we do */
+ len = snprintf(name, len, "{%s}-%d", prefix, sc->gensym_counter++);
+ hash = raw_string_hash((const unsigned char *)name, len);
+ location = hash % SYMBOL_TABLE_SIZE;
+ x = new_symbol(sc, name, len, hash, location); /* not T_GENSYM -- might be called from outside */
+ tmpbuf_free(name, len);
+ return(x);
}
-void s7_define(s7_scheme *sc, s7_pointer envir, s7_pointer symbol, s7_pointer value)
+static bool s7_is_gensym(s7_pointer g) {return((is_symbol(g)) && (is_gensym(g)));}
+
+static s7_pointer g_is_gensym(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- x = find_local_symbol(sc, envir, symbol);
- if (x != sc->NIL)
- set_symbol_value(x, value);
- else add_to_environment(sc, envir, symbol, value); /* I think this means C code can override "constant" defs */
+ #define H_is_gensym "(gensym? sym) returns #t if sym is a gensym"
+ #define Q_is_gensym pl_bt
+
+ check_boolean_method(sc, s7_is_gensym, sc->IS_GENSYM, args);
}
-void s7_define_variable(s7_scheme *sc, const char *name, s7_pointer value)
+static char *pos_int_to_str(s7_int num, unsigned int *len, char endc)
{
- s7_pointer sym;
+ #define INT_TO_STR_SIZE 32
+ static char itos[INT_TO_STR_SIZE];
+ char *p, *op;
- sym = make_symbol(sc, name);
- s7_define(sc, s7_global_environment(sc), sym, value);
+ p = (char *)(itos + INT_TO_STR_SIZE - 1);
+ op = p;
+ *p-- = '\0';
+ if (endc != '\0') *p-- = endc;
+ do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
+ (*len) = op - p; /* this includes the trailing #\null */
+ return((char *)(p + 1));
}
-
-void s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value)
+static s7_pointer g_gensym(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x, sym;
-
- sym = make_symbol(sc, name);
- s7_define(sc, s7_global_environment(sc), sym, value);
- x = symbol_global_slot(sym);
- set_immutable(car(x));
-
- /* We could move constants (x here) and function slots to a separate "heap" or the gc_protected table.
- * They need to be marked (pi for example can change its value in the gmp case),
- * but will never be freed, and in the Xm case there are several thousand
- * constants sitting in the heap. In the simple (non Xm) case, this reduces
- * the initial heap from 800 to ca 400 objects, and saves ca 9/2400 in overall
- * compute time (all the savings are in s7_mark_object which strikes me as weird).
- * In the Xm case we go from 12000 to 6000 initial objects. I decided not to
- * do this since it makes me feel uneasy. The basic idea is:
- * s7_remove_from_heap(sc, x);
- * s7_gc_protect(sc, x);
- * and in the function case, save the symbol table pointer as sym and
- * x = symbol_global_slot(sym);
- * etc
- * big_pi must be handled specially:
- * s7_symbol_set_value(sc, make_symbol(sc, "pi"), tmp = big_pi(sc));
- * s7_gc_protect(sc, tmp);
- */
+ #define H_gensym "(gensym (prefix \"gensym\")) returns a new, unused symbol"
+ #define Q_gensym s7_make_signature(sc, 2, sc->IS_GENSYM, sc->IS_STRING)
+
+ const char *prefix;
+ char *name, *p;
+ unsigned int len, plen, nlen, location;
+ unsigned long long int hash;
+ s7_pointer x, str, stc;
+
+ /* get symbol name */
+ if (is_not_null(args))
+ {
+ s7_pointer name;
+ name = car(args);
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->GENSYM, args, T_STRING, 0);
+ prefix = string_value(name);
+ }
+ else prefix = "gensym";
+ plen = safe_strlen(prefix);
+ len = plen + 32;
+ name = (char *)malloc(len * sizeof(char));
+ name[0] = '{';
+ if (plen > 0) memcpy((void *)(name + 1), prefix, plen);
+ name[plen + 1] = '}';
+ name[plen + 2] = '-';
+
+ p = pos_int_to_str(sc->gensym_counter++, &len, '\0');
+ memcpy((void *)(name + plen + 3), (void *)p, len);
+ nlen = len + plen + 2;
+
+ hash = raw_string_hash((const unsigned char *)name, nlen);
+ location = hash % SYMBOL_TABLE_SIZE;
+
+ /* make-string for symbol name */
+ str = (s7_cell *)malloc(sizeof(s7_cell)); /* was calloc? */
+ unheap(str);
+#if DEBUGGING
+ typeflag(str) = 0;
+#endif
+ set_type(str, T_STRING | T_IMMUTABLE);
+ string_length(str) = nlen;
+ string_value(str) = name;
+ string_needs_free(str) = false;
+ string_hash(str) = hash;
+
+ /* allocate the symbol in the heap so GC'd when inaccessible */
+ new_cell(sc, x, T_SYMBOL | T_GENSYM);
+ set_symbol_name_cell(x, str);
+ global_slot(x) = sc->UNDEFINED;
+ initial_slot(x) = sc->UNDEFINED;
+ symbol_set_local(x, 0LL, sc->NIL);
+
+ /* place new symbol in symbol-table, but using calloc so we can easily free it (remove it from the table) in GC sweep */
+ stc = (s7_cell *)malloc(sizeof(s7_cell)); /* was calloc? */
+#if DEBUGGING
+ typeflag(stc) = 0;
+#endif
+ unheap(stc);
+ set_type(stc, T_PAIR | T_IMMUTABLE);
+ car(stc) = x;
+ cdr(stc) = vector_element(sc->symbol_table, location);
+ vector_element(sc->symbol_table, location) = stc;
+ pair_set_raw_hash(stc, hash);
+ pair_set_raw_len(stc, string_length(str));
+ pair_set_raw_name(stc, string_value(str));
+
+ add_gensym(sc, x);
+ return(x);
}
-/* (define (func a) (let ((cvar (+ a 1))) cvar))
- * (define-constant cvar 23)
- * (func 1)
- * ;can't bind an immutable object: cvar
- */
-
-
+s7_pointer s7_name_to_value(s7_scheme *sc, const char *name)
+{
+ return(s7_symbol_value(sc, make_symbol(sc, name)));
+}
-/* -------- keywords -------- */
-bool s7_is_keyword(s7_pointer obj)
+bool s7_is_symbol(s7_pointer p)
{
- return(is_keyword(obj));
+ return(is_symbol(p));
}
-static s7_pointer g_is_keyword(s7_scheme *sc, s7_pointer args)
+bool s7_is_syntax(s7_pointer p)
{
- #define H_is_keyword "(keyword? obj) returns #t if obj is a keyword, (keyword? :key) -> #t"
- return(make_boolean(sc, is_keyword(car(args))));
+ return(is_syntax(p));
}
-s7_pointer s7_make_keyword(s7_scheme *sc, const char *key)
+static s7_pointer g_is_symbol(s7_scheme *sc, s7_pointer args)
{
- s7_pointer sym, x;
- char *name;
-
- name = (char *)malloc((safe_strlen(key) + 2) * sizeof(char));
- sprintf(name, ":%s", key); /* prepend ":" */
- sym = make_symbol(sc, name);
- typeflag(sym) |= (T_IMMUTABLE | T_DONT_COPY);
- free(name);
-
- x = find_symbol(sc, sc->envir, sym); /* is it already defined? */
- if (x == sc->NIL)
- add_to_environment(sc, sc->envir, sym, sym); /* its value is itself, skip the immutable check in add_to_current_environment */
+ #define H_is_symbol "(symbol? obj) returns #t if obj is a symbol"
+ #define Q_is_symbol pl_bt
- return(sym);
+ check_boolean_method(sc, is_symbol, sc->IS_SYMBOL, args);
}
-static s7_pointer g_make_keyword(s7_scheme *sc, s7_pointer args)
+const char *s7_symbol_name(s7_pointer p)
{
- #define H_make_keyword "(make-keyword str) prepends ':' to str and defines that as a keyword"
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "make-keyword", 0, car(args), "a string"));
- return(s7_make_keyword(sc, string_value(car(args))));
+ return(symbol_name(p));
}
-static s7_pointer g_keyword_to_symbol(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_symbol_to_string(s7_scheme *sc, s7_pointer args)
{
- #define H_keyword_to_symbol "(keyword->symbol key) returns a symbol with the same name as key but no prepended colon"
- const char *name;
+ #define H_symbol_to_string "(symbol->string sym) returns the symbol sym converted to a string"
+ #define Q_symbol_to_string s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_SYMBOL)
+ s7_pointer sym;
- if (!is_keyword(car(args)))
- return(s7_wrong_type_arg_error(sc, "keyword->symbol", 0, car(args), "a keyword"));
+ sym = car(args);
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->SYMBOL_TO_STRING, args, T_SYMBOL, 0);
+ /* s7_make_string uses strlen which stops at an embedded null */
+ return(s7_make_string_with_length(sc, symbol_name(sym), symbol_name_length(sym))); /* return a copy */
+}
- name = symbol_name(car(args));
- if (name[0] == ':')
- return(make_symbol(sc, (const char *)(name + 1)));
+static s7_pointer symbol_to_string_uncopied;
+static s7_pointer g_symbol_to_string_uncopied(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer sym;
- /* else it ends in ":", (keyword->symbol foo:) */
- {
- char *temp;
- s7_pointer res;
- temp = copy_string(name);
- temp[strlen(temp) - 1] = '\0';
- res = make_symbol(sc, (const char *)temp);
- free(temp);
- return(res);
- }
+ sym = car(args);
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->SYMBOL_TO_STRING, args, T_SYMBOL, 0);
+ return(symbol_name_cell(sym));
}
-static s7_pointer g_symbol_to_keyword(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_to_symbol_1(s7_scheme *sc, s7_pointer str, s7_pointer caller)
{
- #define H_symbol_to_keyword "(symbol->keyword sym) returns a keyword with the same name as sym, but with a colon prepended"
- if (!s7_is_symbol(car(args)))
- return(s7_wrong_type_arg_error(sc, "symbol->keyword", 0, car(args), "a symbol"));
- return(s7_make_keyword(sc, symbol_name(car(args))));
-}
+ if (!is_string(str))
+ method_or_bust(sc, str, caller, list_1(sc, str), T_STRING, 0);
+ if (string_length(str) == 0)
+ return(simple_wrong_type_argument_with_type(sc, caller, str, make_string_wrapper(sc, "a non-null string")));
+ /* currently if the string has an embedded null, it marks the end of the new symbol name. */
+ return(make_symbol_with_length(sc, string_value(str), string_length(str)));
+}
-/* for uninterpreted pointers */
-bool s7_is_c_pointer(s7_pointer arg)
+static s7_pointer g_string_to_symbol(s7_scheme *sc, s7_pointer args)
{
- return(type(arg) == T_C_POINTER);
+ #define H_string_to_symbol "(string->symbol str) returns the string str converted to a symbol"
+ #define Q_string_to_symbol s7_make_signature(sc, 2, sc->IS_SYMBOL, sc->IS_STRING)
+ return(g_string_to_symbol_1(sc, car(args), sc->STRING_TO_SYMBOL));
}
-void *s7_c_pointer(s7_pointer p)
+static s7_pointer g_symbol(s7_scheme *sc, s7_pointer args)
{
- if ((type(p) == T_NUMBER) && (s7_integer(p) == 0))
- return(NULL); /* special case where the null pointer has been cons'd up by hand */
-
- if (type(p) != T_C_POINTER)
- {
- fprintf(stderr, "s7_c_pointer argument is not a c pointer?");
- return(NULL);
- }
-
- return(raw_pointer(p));
+ #define H_symbol "(symbol str) returns the string str converted to a symbol"
+ #define Q_symbol s7_make_signature(sc, 2, sc->IS_SYMBOL, sc->IS_STRING)
+ return(g_string_to_symbol_1(sc, car(args), sc->SYMBOL));
}
-s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr)
+static s7_pointer add_sym_to_list(s7_scheme *sc, s7_pointer sym)
{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_C_POINTER | T_SIMPLE | T_DONT_COPY);
- raw_pointer(x) = ptr;
- return(x);
+ symbol_tag(sym) = sc->syms_tag;
+ return(sym);
}
+#define clear_syms_in_list(Sc) Sc->syms_tag++
-/* -------------------------------- continuations and gotos -------------------------------- */
+/* -------------------------------- environments -------------------------------- */
-bool s7_is_continuation(s7_pointer p)
-{
- return(is_continuation(p));
+#define new_frame(Sc, Old_Env, New_Env) \
+ do { \
+ s7_pointer _x_; \
+ new_cell(Sc, _x_, T_LET); \
+ let_id(_x_) = ++sc->let_number; \
+ let_set_slots(_x_, Sc->NIL); \
+ set_outlet(_x_, Old_Env); \
+ New_Env = _x_; \
+ } while (0)
+
+
+static s7_pointer new_frame_in_env(s7_scheme *sc, s7_pointer old_env)
+{
+ /* return(cons(sc, sc->NIL, old_env)); */
+ s7_pointer x;
+ new_cell(sc, x, T_LET);
+ let_id(x) = ++sc->let_number;
+ let_set_slots(x, sc->NIL);
+ set_outlet(x, old_env);
+ return(x);
}
-static s7_pointer g_is_continuation(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_simple_let(s7_scheme *sc)
{
- #define H_is_continuation "(continuation? obj) returns #t if obj is a continuation"
- return(make_boolean(sc, is_continuation(car(args))));
+ s7_pointer frame;
+ new_cell(sc, frame, T_LET);
+ let_id(frame) = sc->let_number + 1;
+ let_set_slots(frame, sc->NIL);
+ set_outlet(frame, sc->envir);
+ return(frame);
}
-/* is this the right thing? It returns #f for call-with-exit ("goto") because
- * that form of continuation can't continue (via a jump back to its context).
+
+/* in all these macros, symbol_set_local should follow slot_set_value so that we can evaluate the
+ * slot's value in its old state.
*/
+#define add_slot(Frame, Symbol, Value) \
+ do { \
+ s7_pointer _slot_, _sym_, _val_; \
+ _sym_ = Symbol; _val_ = Value; \
+ new_cell_no_check(sc, _slot_, T_SLOT);\
+ slot_set_symbol(_slot_, _sym_); \
+ slot_set_value(_slot_, _val_); \
+ symbol_set_local(_sym_, let_id(Frame), _slot_); \
+ next_slot(_slot_) = let_slots(Frame); \
+ let_set_slots(Frame, _slot_); \
+ } while (0)
+
+#define add_slot_checked(Frame, Symbol, Value) \
+ do { \
+ s7_pointer _slot_, _sym_, _val_; \
+ _sym_ = Symbol; _val_ = Value; \
+ new_cell(sc, _slot_, T_SLOT); \
+ slot_set_symbol(_slot_, _sym_); \
+ slot_set_value(_slot_, _val_); \
+ symbol_set_local(_sym_, let_id(Frame), _slot_); \
+ next_slot(_slot_) = let_slots(Frame); \
+ let_set_slots(Frame, _slot_); \
+ } while (0)
+
+/* no set_local here -- presumably done earlier in check_* */
+
+#define new_frame_with_slot(Sc, Old_Env, New_Env, Symbol, Value) \
+ do { \
+ s7_pointer _x_, _slot_, _sym_, _val_; \
+ _sym_ = Symbol; _val_ = Value; \
+ new_cell(Sc, _x_, T_LET); \
+ let_id(_x_) = ++sc->let_number; \
+ set_outlet(_x_, Old_Env); \
+ New_Env = _x_; \
+ new_cell_no_check(Sc, _slot_, T_SLOT); \
+ slot_set_symbol(_slot_, _sym_); \
+ slot_set_value(_slot_, _val_); \
+ symbol_set_local(_sym_, sc->let_number, _slot_); \
+ next_slot(_slot_) = sc->NIL; \
+ let_set_slots(_x_, _slot_); \
+ } while (0)
+
+
+#define new_frame_with_two_slots(Sc, Old_Env, New_Env, Symbol1, Value1, Symbol2, Value2) \
+ do { \
+ s7_pointer _x_, _slot_, _sym1_, _val1_, _sym2_, _val2_; \
+ _sym1_ = Symbol1; _val1_ = Value1; \
+ _sym2_ = Symbol2; _val2_ = Value2; \
+ new_cell(Sc, _x_, T_LET); \
+ let_id(_x_) = ++sc->let_number; \
+ set_outlet(_x_, Old_Env); \
+ New_Env = _x_; \
+ new_cell_no_check(Sc, _slot_, T_SLOT); \
+ slot_set_symbol(_slot_, _sym1_); \
+ slot_set_value(_slot_, _val1_); \
+ symbol_set_local(_sym1_, sc->let_number, _slot_); \
+ let_set_slots(_x_, _slot_); \
+ new_cell_no_check(Sc, _x_, T_SLOT); \
+ slot_set_symbol(_x_, _sym2_); \
+ slot_set_value(_x_, _val2_); \
+ symbol_set_local(_sym2_, sc->let_number, _x_); \
+ next_slot(_x_) = sc->NIL; \
+ next_slot(_slot_) = _x_; \
+ } while (0)
+
+
+static s7_pointer old_frame_in_env(s7_scheme *sc, s7_pointer frame, s7_pointer next_frame)
+{
+ set_type(frame, T_LET);
+ let_set_slots(frame, sc->NIL);
+ set_outlet(frame, next_frame);
+ let_id(frame) = ++sc->let_number;
+ return(frame);
+}
+
+
+static s7_pointer old_frame_with_slot(s7_scheme *sc, s7_pointer env, s7_pointer val)
+{
+ s7_pointer x, sym;
+ unsigned long long int id;
+ id = ++sc->let_number;
+ let_id(env) = id;
+ x = let_slots(env);
+ slot_set_value(x, val);
+ sym = slot_symbol(x);
+ symbol_set_local(sym, id, x);
-static s7_pointer copy_list(s7_scheme *sc, s7_pointer lst)
-{
- if (lst == sc->NIL)
- return(sc->NIL);
- return(s7_cons(sc, car(lst), copy_list(sc, cdr(lst))));
+ return(env);
}
-static s7_pointer copy_object(s7_scheme *sc, s7_pointer obj)
+static s7_pointer old_frame_with_two_slots(s7_scheme *sc, s7_pointer env, s7_pointer val1, s7_pointer val2)
{
- s7_pointer nobj;
- int nloc;
+ s7_pointer x, sym;
+ unsigned long long int id;
- NEW_CELL(sc, nobj);
- nloc = nobj->hloc;
- memcpy((void *)nobj, (void *)obj, sizeof(s7_cell));
- nobj->hloc = nloc;
-
- /* nobj is safe here because the gc is off */
- if (dont_copy(car(obj)))
- car(nobj) = car(obj);
- else car(nobj) = copy_object(sc, car(obj));
-
- if ((dont_copy(cdr(obj))) || (dont_copy_cdr(obj)))
- cdr(nobj) = cdr(obj); /* closure_environment in func cases */
- else cdr(nobj) = copy_object(sc, cdr(obj));
-
- return(nobj);
+ id = ++sc->let_number;
+ let_id(env) = id;
+ x = let_slots(env);
+ slot_set_value(x, val1);
+ sym = slot_symbol(x);
+ symbol_set_local(sym, id, x);
+ x = next_slot(x);
+ slot_set_value(x, val2);
+ sym = slot_symbol(x);
+ symbol_set_local(sym, id, x);
+
+ return(env);
}
-static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int top)
+static s7_pointer old_frame_with_three_slots(s7_scheme *sc, s7_pointer env, s7_pointer val1, s7_pointer val2, s7_pointer val3)
{
- int i;
- s7_pointer new_v;
- s7_pointer *nv, *ov;
+ s7_pointer x, sym;
+ unsigned long long int id;
- new_v = s7_make_vector(sc, vector_length(old_v));
- /* we can't leave the upper stuff simply malloc-garbage because this object could be in the
- * temps array for a nanosecond or two, and we're sure to call the GC at that moment.
- * We also can't just copy the vector since that seems to confuse the gc mark process.
- */
+ id = ++sc->let_number;
+ let_id(env) = id;
+ x = let_slots(env);
- nv = vector_elements(new_v);
- ov = vector_elements(old_v);
-
- s7_gc_on(sc, false);
+ slot_set_value(x, val1);
+ sym = slot_symbol(x);
+ symbol_set_local(sym, id, x);
+ x = next_slot(x);
- for (i = 0; i < top; i += 4)
- {
- if (dont_copy(ov[i]))
- nv[i] = ov[i];
- else nv[i] = copy_object(sc, ov[i]); /* code */
- nv[i + 1] = ov[i + 1]; /* environment pointer */
- if (is_pair(ov[i + 2])) /* args need not be a list (it can be a port or #f, etc) */
- nv[i + 2] = copy_list(sc, ov[i + 2]); /* args (copy is needed -- see s7test.scm) */
- else nv[i + 2] = ov[i + 2]; /* is this a safe assumption? */
- nv[i + 3] = ov[i + 3]; /* op (constant int) */
- }
-
- s7_gc_on(sc, true);
- return(new_v);
+ slot_set_value(x, val2);
+ sym = slot_symbol(x);
+ symbol_set_local(sym, id, x);
+ x = next_slot(x);
+
+ slot_set_value(x, val3);
+ sym = slot_symbol(x);
+ symbol_set_local(sym, id, x);
+
+ return(env);
}
-static s7_pointer make_goto(s7_scheme *sc)
+static s7_pointer permanent_slot(s7_pointer symbol, s7_pointer value)
{
s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_GOTO | T_SIMPLE | T_DONT_COPY | T_PROCEDURE);
- call_exit_goto_loc(x) = s7_stack_top(sc);
- call_exit_active(x) = true;
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_SLOT);
+ slot_set_symbol(x, symbol);
+ slot_set_value(x, value);
return(x);
}
-s7_pointer s7_make_continuation(s7_scheme *sc)
+static s7_pointer find_let(s7_scheme *sc, s7_pointer obj)
{
- s7_pointer x;
- int loc;
+ if (is_let(obj)) return(obj);
+ switch (type(obj))
+ {
+ case T_LET:
+ return(obj);
- /* if pthreads, the heap vars are actually in the main thread's s7_scheme object, and the gc process needs to be protected */
-#if HAVE_PTHREADS
- {
- s7_scheme *orig_sc;
- orig_sc = sc->orig_sc;
- if ((int)(orig_sc->free_heap_top - orig_sc->free_heap) < (int)(orig_sc->heap_size / 4))
- {
- pthread_mutex_lock(&alloc_lock); /* mimic g_gc */
- gc(orig_sc);
- pthread_mutex_unlock(&alloc_lock);
- }
- }
-#else
- if ((int)(sc->free_heap_top - sc->free_heap) < (int)(sc->heap_size / 4))
- gc(sc);
-#endif
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ return(closure_let(obj));
- /* this gc call is needed if there are lots of call/cc's -- by pure bad luck
- * we can end up hitting the end of the gc free list time after time while
- * in successive copy_stack's below, causing s7 to core up until it runs out of memory.
- */
+ case T_C_OBJECT:
+ return(c_object_let(obj));
+ }
+ return(sc->NIL);
+}
- loc = s7_stack_top(sc);
- NEW_CELL(sc, x);
- continuation_stack_size(x) = sc->stack_size;
- continuation_stack(x) = copy_stack(sc, sc->stack, s7_stack_top(sc));
- continuation_stack_start(x) = vector_elements(continuation_stack(x));
- continuation_stack_end(x) = (s7_pointer *)(continuation_stack_start(x) + loc);
- set_type(x, T_CONTINUATION | T_DONT_COPY | T_PROCEDURE);
- return(x);
+static s7_pointer free_let(s7_scheme *sc, s7_pointer e)
+{
+ s7_pointer p;
+#if DEBUGGING
+ for (p = let_slots(e); is_slot(p);)
+ {
+ s7_pointer n;
+ n = next_slot(p); /* grab it before we free p, or the type check stuff will complain */
+ free_cell(sc, p);
+ p = n;
+ }
+#else
+ for (p = let_slots(e); is_slot(p); p = next_slot(p))
+ free_cell(sc, p);
+#endif
+ free_cell(sc, e);
+ return(sc->NIL);
}
-static bool check_for_dynamic_winds(s7_scheme *sc, s7_pointer c)
+static s7_pointer find_method(s7_scheme *sc, s7_pointer env, s7_pointer symbol)
{
- int i, s_base = 0, c_base = -1;
- opcode_t op;
-
- for (i = s7_stack_top(sc) - 1; i > 0; i -= 4)
- {
- s7_pointer x;
-
- op = (opcode_t)stack_op(sc->stack, i);
+ s7_pointer x;
+ if (symbol_id(symbol) == 0) /* this means the symbol has never been used locally, so how can it be a method? */
+ return(sc->UNDEFINED);
- switch (op)
- {
- case OP_DYNAMIC_WIND:
- {
- int j;
- x = stack_code(sc->stack, i);
- for (j = 3; j < continuation_stack_top(c); j += 4)
- if (((opcode_t)stack_op(continuation_stack(c), j) == OP_DYNAMIC_WIND) &&
- (x == stack_code(continuation_stack(c), j)))
- {
- s_base = i;
- c_base = j;
- break;
- }
-
- if (s_base != 0)
- break;
-
- if (dynamic_wind_state(x) == DWIND_BODY)
- {
- dynamic_wind_state(x) = DWIND_FINISH;
- push_stack(sc, opcode(OP_EVAL_DONE), sc->args, sc->code);
- sc->args = sc->NIL;
- sc->code = dynamic_wind_out(x);
- eval(sc, OP_APPLY);
- }
- }
- break;
+ /* I think the symbol_id is in sync with let_id, so the standard search should work */
+ if (let_id(env) == symbol_id(symbol))
+ return(slot_value(local_slot(symbol)));
- case OP_BARRIER:
- if (i > continuation_stack_top(c)) /* otherwise it's some unproblematic outer eval-string? */
- return(false);
- break;
+ for (x = env; symbol_id(symbol) < let_id(x); x = outlet(x));
- case OP_DEACTIVATE_GOTO: /* here we're jumping out of an unrelated call-with-exit block */
- if (i > continuation_stack_top(c))
- call_exit_active(stack_args(sc->stack, i)) = false;
- break;
+ if (let_id(x) == symbol_id(symbol))
+ return(slot_value(local_slot(symbol)));
- case OP_TRACE_RETURN:
- if (i > continuation_stack_top(c))
- {
- sc->trace_depth--;
- if (sc->trace_depth < 0) sc->trace_depth = 0;
- }
- break;
-
- default:
- break;
- }
- }
-
- for (i = c_base + 4; i < continuation_stack_top(c); i += 4)
+ for (; is_let(x); x = outlet(x))
{
- op = ((opcode_t)stack_op(continuation_stack(c), i));
-
- if (op == OP_DYNAMIC_WIND)
- {
- s7_pointer x;
- x = stack_code(continuation_stack(c), i);
- push_stack(sc, opcode(OP_EVAL_DONE), sc->args, sc->code);
- sc->args = sc->NIL;
- sc->code = dynamic_wind_in(x);
- eval(sc, OP_APPLY);
- dynamic_wind_state(x) = DWIND_BODY;
- }
- else
- {
- if (op == OP_DEACTIVATE_GOTO)
- call_exit_active(stack_args(continuation_stack(c), i)) = true;
- }
+ s7_pointer y;
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(slot_value(y));
}
- return(true);
+ return(sc->UNDEFINED);
}
-static void call_with_current_continuation(s7_scheme *sc)
+static int let_length(s7_scheme *sc, s7_pointer e)
{
- if (!check_for_dynamic_winds(sc, sc->code))
- return;
+ /* used by length, applicable_length, and some length optimizations */
+ int i;
+ s7_pointer p;
- sc->stack = copy_stack(sc, continuation_stack(sc->code), continuation_stack_top(sc->code));
- sc->stack_size = continuation_stack_size(sc->code);
- sc->stack_start = vector_elements(sc->stack);
- sc->stack_end = (s7_pointer *)(sc->stack_start + continuation_stack_top(sc->code));
- sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2);
+ if (e == sc->rootlet)
+ return(sc->rootlet_entries);
- if (sc->args == sc->NIL)
- sc->value = sc->NIL;
- else
+ if (has_methods(e))
{
- if (cdr(sc->args) == sc->NIL)
- sc->value = car(sc->args);
- else sc->value = splice_in_values(sc, sc->args);
+ s7_pointer length_func;
+ length_func = find_method(sc, e, sc->LENGTH);
+ if (length_func != sc->UNDEFINED)
+ {
+ p = s7_apply_function(sc, length_func, list_1(sc, e));
+ if (s7_is_integer(p))
+ return((int)s7_integer(p));
+ return(-1); /* ?? */
+ }
}
+
+ for (i = 0, p = let_slots(e); is_slot(p); i++, p = next_slot(p));
+ return(i);
}
-static void call_with_exit(s7_scheme *sc)
+static s7_pointer make_slot_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value)
{
- int i, new_stack_top;
-
- if (!call_exit_active(sc->code))
- s7_error(sc, make_symbol(sc, "invalid-escape-function"),
- make_list_1(sc, make_protected_string(sc, "call-with-exit escape procedure called outside its block")));
- call_exit_active(sc->code) = false;
- new_stack_top = call_exit_goto_loc(sc->code);
+ /* env is not rootlet and is a let */
+ s7_pointer slot;
+ new_cell(sc, slot, T_SLOT);
+ slot_set_symbol(slot, symbol);
+ slot_set_value(slot, value);
+ next_slot(slot) = let_slots(env);
+ let_set_slots(env, slot);
+ set_local(symbol);
+ /* this is called by varlet so we have to be careful about the resultant let_id
+ * check for greater to ensure shadowing stays in effect, and equal to do updates (set! in effect)
+ */
+ if (let_id(env) >= symbol_id(symbol))
+ symbol_set_local(symbol, let_id(env), slot);
+ return(slot);
+}
- /* look for dynamic-wind in the stack section that we are jumping out of */
- for (i = s7_stack_top(sc) - 1; i > new_stack_top; i -= 4)
+
+s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value)
+{
+ if ((!is_let(env)) ||
+ (env == sc->rootlet))
{
- opcode_t op;
+ s7_pointer ge, slot;
- op = (opcode_t)stack_op(sc->stack, i);
- switch (op)
+ if ((sc->safety == 0) && (has_closure_let(value)))
{
- case OP_DYNAMIC_WIND:
- {
- sc->z = stack_code(sc->stack, i);
- if (dynamic_wind_state(sc->z) == DWIND_BODY)
- {
- dynamic_wind_state(sc->z) = DWIND_FINISH;
- push_stack(sc, opcode(OP_EVAL_DONE), sc->args, sc->code);
- sc->args = sc->NIL;
- sc->code = dynamic_wind_out(sc->z);
- sc->z = sc->NIL;
- eval(sc, OP_APPLY);
- }
- }
- break;
-
- case OP_EVAL_STRING_2:
- s7_close_input_port(sc, sc->input_port);
- pop_input_port(sc);
- break;
-
- case OP_BARRIER: /* oops -- we almost certainly went too far */
- return;
-
- case OP_DEACTIVATE_GOTO: /* here we're jumping into an unrelated call-with-exit block */
- call_exit_active(stack_args(sc->stack, i)) = false;
- break;
-
- case OP_TRACE_RETURN:
- sc->trace_depth--;
- if (sc->trace_depth < 0) sc->trace_depth = 0;
- break;
-
- /* call/cc does not close files, but I think call-with-exit should */
- case OP_UNWIND_OUTPUT:
- {
- s7_pointer x;
- x = stack_code(sc->stack, i); /* "code" = port that we opened */
- s7_close_output_port(sc, x);
- x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #f */
- if (x != sc->F)
- sc->output_port = x;
- }
- break;
+ s7_remove_from_heap(sc, closure_args(value));
+ s7_remove_from_heap(sc, closure_body(value));
+ }
- case OP_UNWIND_INPUT:
- s7_close_input_port(sc, stack_code(sc->stack, i)); /* "code" = port that we opened */
- sc->input_port = stack_args(sc->stack, i); /* "args" = port that we shadowed */
- sc->input_is_file = (is_file_port(sc->input_port));
- break;
+ /* first look for existing slot -- this is not always checked before calling s7_make_slot */
+ if (is_slot(global_slot(symbol)))
+ {
+ slot = global_slot(symbol);
+ slot_set_value(slot, value);
+ return(slot);
+ }
- default:
- break;
+ ge = sc->rootlet;
+ slot = permanent_slot(symbol, value);
+ vector_element(ge, sc->rootlet_entries++) = slot;
+ if (sc->rootlet_entries >= vector_length(ge))
+ {
+ int i;
+ vector_length(ge) *= 2;
+ vector_elements(ge) = (s7_pointer *)realloc(vector_elements(ge), vector_length(ge) * sizeof(s7_pointer));
+ for (i = sc->rootlet_entries; i < vector_length(ge); i++)
+ vector_element(ge, i) = sc->NIL;
}
+ global_slot(symbol) = slot;
+
+ if (symbol_id(symbol) == 0) /* never defined locally? */
+ {
+ if (initial_slot(symbol) == sc->UNDEFINED)
+ initial_slot(symbol) = permanent_slot(symbol, value);
+ local_slot(symbol) = slot;
+ set_global(symbol);
+ }
+ if (is_gensym(symbol))
+ s7_remove_from_heap(sc, symbol);
+ return(slot);
}
-
- sc->stack_end = (s7_pointer *)(sc->stack_start + new_stack_top);
- /* the return value should have an implicit values call, just as in call/cc */
- if (sc->args == sc->NIL)
- sc->value = sc->NIL;
- else
- {
- if (cdr(sc->args) == sc->NIL)
- sc->value = car(sc->args);
- else sc->value = splice_in_values(sc, sc->args);
- }
+ return(make_slot_1(sc, env, symbol, value));
+ /* there are about the same number of frames as local variables -- this
+ * strikes me as surprising, but it holds up across a lot of code.
+ */
}
-static s7_pointer g_call_cc(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_slot(s7_scheme *sc, s7_pointer variable, s7_pointer value)
{
- #define H_call_cc "(call-with-current-continuation func) needs more than a one sentence explanation"
- s7_pointer proc_args;
-
- /* car(args) is the procedure passed to call/cc */
-
- if (!is_procedure(car(args))) /* this includes continuations */
- return(s7_wrong_type_arg_error(sc, "call/cc", 0, car(args), "a procedure"));
-
- proc_args = s7_procedure_arity(sc, car(args));
- if ((s7_integer(car(proc_args)) > 1) ||
- ((s7_integer(car(proc_args)) == 0) &&
- (s7_integer(cadr(proc_args)) == 0) &&
- (caddr(proc_args) == sc->F)))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "call/cc procedure, ~A, should take one argument"), car(args))));
-
- sc->code = car(args);
- sc->args = make_list_1(sc, s7_make_continuation(sc));
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->NIL);
+ /* this is for a do-loop optimization -- an unattached slot */
+ s7_pointer y;
+ new_cell(sc, y, T_SLOT);
+ slot_set_symbol(y, variable);
+ if (!is_symbol(variable)) abort();
+ slot_set_value(y, value);
+ return(y);
}
-static s7_pointer g_call_with_exit(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- let? -------------------------------- */
+bool s7_is_let(s7_pointer e)
{
- #define H_call_with_exit "(call-with-exit func) is call/cc without the ability to jump back into a previous computation."
-
- /* (call-with-exit (lambda (return) ...)) */
- /* perhaps "call/exit"? */
-
- if (!is_procedure(car(args))) /* this includes continuations */
- return(s7_wrong_type_arg_error(sc, "call-with-exit", 0, car(args), "a procedure"));
+ return(is_let(e));
+}
- sc->code = car(args); /* the lambda form */
- sc->args = make_list_1(sc, make_goto(sc)); /* the argument to the lambda (the goto = "return" above) */
+static s7_pointer g_is_let(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_let "(let? obj) returns #t if obj is a let (an environment)."
+ #define Q_is_let pl_bt
- push_stack(sc, opcode(OP_DEACTIVATE_GOTO), car(sc->args), sc->NIL); /* this means call-with-exit is not tail-recursive */
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code); /* apply looks at sc->code to decide what to do (it will see the lambda) */
-
- /* if the lambda body calls the argument as a function,
- * it is applied to its arguments, apply notices that it is a goto, and...
- *
- * (conceptually...) sc->stack_top = call_exit_goto_loc(sc->code);
- * s_pop(sc, sc->args != sc->NIL ? car(sc->args) : sc->NIL);
- *
- * which jumps to the point of the goto returning car(args).
- *
- * There is one gotcha: we can't jump back in from outside, so if the caller saves the goto
- * and tries to invoke it outside the call-with-exit block, we have to
- * make sure it triggers an error. So, if the escape is called, it then
- * deactivates itself. Otherwise the block returns, we pop to OP_DEACTIVATE_GOTO,
- * and it finds the goto in sc->args.
- * Even worse:
- *
- (let ((cc #f))
- (call-with-exit
- (lambda (c3)
- (call/cc (lambda (ret) (set! cc ret)))
- (c3)))
- (cc))
- *
- * where we jump back into a call-with-exit body via call/cc, the goto has to be
- * re-established.
- */
-
- return(sc->NIL);
+ check_boolean_method(sc, is_let, sc->IS_LET, args);
}
+/* -------------------------------- unlet -------------------------------- */
+#define UNLET_ENTRIES 400
-/* -------------------------------- numbers -------------------------------- */
+static void save_unlet(s7_scheme *sc)
+{
+ /* there are ca 374 predefined functions and whatnot */
+ int i, k = 0;
+ s7_pointer x;
+ s7_pointer *inits;
-#if WITH_GMP
- static char *big_number_to_string_with_radix(s7_pointer p, int radix, int width);
- static bool big_numbers_are_eqv(s7_pointer a, s7_pointer b);
- static s7_pointer string_to_either_integer(s7_scheme *sc, const char *str, int radix);
- static s7_pointer string_to_either_ratio(s7_scheme *sc, const char *nstr, const char *dstr, int radix);
- static s7_pointer string_to_either_real(s7_scheme *sc, const char *str, int radix);
- static s7_pointer string_to_either_complex(s7_scheme *sc,
- char *q, char *slash1, char *ex1, bool has_dec_point1,
- char *plus, char *slash2, char *ex2, bool has_dec_point2,
- int radix, int has_plus_or_minus);
- static s7_pointer big_add(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_subtract(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_multiply(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_divide(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_random(s7_scheme *sc, s7_pointer args);
- static s7_pointer s7_Int_to_big_integer(s7_scheme *sc, s7_Int val);
- static s7_pointer s7_ratio_to_big_ratio(s7_scheme *sc, s7_Int num, s7_Int den);
- static s7_pointer s7_number_to_big_real(s7_scheme *sc, s7_pointer p);
- static s7_pointer promote_number(s7_scheme *sc, int type, s7_pointer x);
- static s7_pointer big_negate(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_invert(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_inexact_to_exact(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_exact_to_inexact(s7_scheme *sc, s7_pointer args);
- static s7_pointer big_is_zero_1(s7_scheme *sc, s7_pointer x);
+ sc->unlet = (s7_pointer)calloc(1, sizeof(s7_cell));
+ set_type(sc->unlet, T_VECTOR);
+ vector_length(sc->unlet) = UNLET_ENTRIES;
+ vector_elements(sc->unlet) = (s7_pointer *)malloc(UNLET_ENTRIES * sizeof(s7_pointer));
+ vector_getter(sc->unlet) = default_vector_getter;
+ vector_setter(sc->unlet) = default_vector_setter;
+ inits = vector_elements(sc->unlet);
+ s7_vector_fill(sc, sc->unlet, sc->NIL);
+ unheap(sc->unlet);
+
+ for (i = 0; i < vector_length(sc->symbol_table); i++)
+ for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+ {
+ s7_pointer sym;
+ sym = car(x);
+ if (is_slot(initial_slot(sym)))
+ {
+ s7_pointer val;
+ val = slot_value(initial_slot(sym));
+ if ((is_procedure(val)) || (is_syntax(val)))
+ inits[k++] = initial_slot(sym);
+
+ /* (let ((begin +)) (with-let (unlet) (begin 1 2))) */
+#if DEBUGGING
+ if (k >= UNLET_ENTRIES)
+ fprintf(stderr, "unlet overflow\n");
#endif
+ }
+ }
+}
+static s7_pointer g_unlet(s7_scheme *sc, s7_pointer args)
+{
+ /* add sc->unlet bindings to the current environment */
+ #define H_unlet "(unlet) establishes the original bindings of all the predefined functions"
+ #define Q_unlet s7_make_signature(sc, 1, sc->IS_LET)
-#define s7_Int_abs(x) ((x) >= 0 ? (x) : -(x))
-/* can't use abs even in gcc -- it doesn't work with long long ints! */
-#define s7_Double_abs(x) fabs(x)
-#define s7_fabsl(x) (((x) < 0.0) ? -(x) : (x))
-/* fabsl doesn't exist in netBSD! */
+ /* slightly confusing:
+ * :((unlet) 'abs)
+ * #<undefined>
+ * :(defined? 'abs (unlet))
+ * #t
+ * this is because unlet sets up a local environment of unshadowed symbols,
+ * and s7_let_ref below only looks at the local env chain (that is, if env is not
+ * the global env, then the global env is not searched).
+ *
+ * Also (define hi 3) #_hi => 3, (set! hi 4), #_hi -> 3 but (with-let (unlet) hi) -> 4!
+ */
+ int i;
+ s7_pointer *inits;
+ s7_pointer x;
+ sc->w = new_frame_in_env(sc, sc->envir);
+ inits = vector_elements(sc->unlet);
-#ifdef _MSC_VER
-/* need to provide inverse hyperbolic trig funcs and cbrt */
+ for (i = 0; (i < UNLET_ENTRIES) && (is_slot(inits[i])); i++)
+ {
+ s7_pointer sym;
+ x = slot_value(inits[i]);
+ sym = slot_symbol(inits[i]);
+ if (is_procedure(x))
+ {
+ if (((!is_global(sym)) && /* it might be shadowed locally */
+ (s7_symbol_local_value(sc, sym, sc->envir) != slot_value(global_slot(sym)))) ||
+ (x != slot_value(global_slot(sym)))) /* it's not shadowed, but has been changed globally */
+ make_slot_1(sc, sc->w, sym, x);
+ }
+ else
+ {
+ if ((is_syntax(x)) &&
+ (local_slot(sym) != sc->NIL))
+ make_slot_1(sc, sc->w, sym, x);
+ }
+ }
+ /* if (set! + -) then + needs to be overridden, but the local bit isn't set,
+ * so we have to check the actual values in the non-local case.
+ * (define (f x) (with-let (unlet) (+ x 1)))
+ */
-double asinh(double x);
-double asinh(double x)
-{
- return(log(x + sqrt(1.0 + x * x)));
-}
+ x = sc->w;
+ sc->w = sc->NIL;
+ return(x);
+}
-double acosh(double x);
-double acosh(double x)
-{
- return(log(x + sqrt(x * x - 1.0)));
- /* perhaps less prone to numerical troubles (untested):
- * 2.0 * log(sqrt(0.5 * (x + 1.0)) + sqrt(0.5 * (x - 1.0)))
- */
-}
+/* -------------------------------- openlet? -------------------------------- */
+bool s7_is_openlet(s7_pointer e)
+{
+ return(has_methods(e));
+}
+static s7_pointer g_is_openlet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_openlet "(openlet? obj) returns #t is 'obj' has methods."
+ #define Q_is_openlet pl_bt
-double atanh(double x);
-double atanh(double x)
-{
- return(log((1.0 + x) / (1.0 - x)) / 2.0);
-}
+ /* if car(args) is not a let (or possibly have one), should this raise an error? */
+ check_method(sc, car(args), sc->IS_OPENLET, args);
+ return(make_boolean(sc, has_methods(car(args))));
+}
-double cbrt(double x);
-double cbrt(double x)
+/* -------------------------------- openlet -------------------------------- */
+s7_pointer s7_openlet(s7_scheme *sc, s7_pointer e)
{
- if (x >= 0.0)
- return(pow(x, 1.0 / 3.0));
- return(-pow(-x, 1.0 / 3.0));
+ set_has_methods(e);
+ return(e);
}
-static bool isnan(s7_Double x) {return(x != x);}
-/* isnan shows up prominently in callgrind output for s7test, but it's not due to anything
- * in this file. If I replace all the local isnan's with is_nan based on this function,
- * the callgrind value scarcely changes -- I guess the math library is calling it a lot.
- */
-
-static bool isinf(s7_Double x) {return((x == x) && (isnan(x - x)));}
+static s7_pointer g_openlet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_openlet "(openlet e) tells the built-in generic functions that the environment 'e might have an over-riding method."
+ #define Q_openlet pcl_t
+ s7_pointer e;
-#endif
+ e = car(args);
+ check_method(sc, e, sc->OPENLET, args);
+ if (((is_let(e)) && (e != sc->rootlet)) ||
+ (has_closure_let(e)) ||
+ ((is_c_object(e)) && (c_object_let(e) != sc->NIL)))
+ {
+ set_has_methods(e);
+ return(e);
+ }
+ return(simple_wrong_type_argument_with_type(sc, sc->OPENLET, e, A_LET));
+}
-#if WITH_COMPLEX
-#if __cplusplus
- #define _Complex_I (complex<s7_Double>(0.0, 1.0))
- #define creal(x) Real(x)
- #define cimag(x) Imag(x)
- #define carg(x) arg(x)
- #define cabs(x) abs(x)
- #define csqrt(x) sqrt(x)
- #define cpow(x, y) pow(x, y)
- #define clog(x) log(x)
- #define cexp(x) exp(x)
- #define csin(x) sin(x)
- #define ccos(x) cos(x)
- #define csinh(x) sinh(x)
- #define ccosh(x) cosh(x)
-#else
- typedef double complex s7_Complex;
-#endif
+/* -------------------------------- coverlet -------------------------------- */
+static s7_pointer c_coverlet(s7_scheme *sc, s7_pointer e)
+{
+ sc->temp3 = e;
+ check_method(sc, e, sc->COVERLET, list_1(sc, e));
+ if (((is_let(e)) && (e != sc->rootlet)) ||
+ (has_closure_let(e)) ||
+ ((is_c_object(e)) && (c_object_let(e) != sc->NIL)))
+ {
+ clear_has_methods(e);
+ return(e);
+ }
+ return(simple_wrong_type_argument_with_type(sc, sc->COVERLET, e, A_LET));
+}
-/* Trigonometric functions. FreeBSD's math library does not include the complex form of the trig funcs. */
+static s7_pointer g_coverlet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_coverlet "(coverlet e) undoes an earlier openlet."
+ #define Q_coverlet pcl_t
+ return(c_coverlet(sc, car(args)));
+}
-/* FreeBSD supplies cabs carg cimag creal conj csqrt, so can we assume those exist if complex.h exists?
- */
-#if 0
-static s7_Double carg(s7_Complex z)
-{
- return(atan2(cimag(z), creal(z)));
-}
+/* -------------------------------- varlet -------------------------------- */
+static void append_let(s7_scheme *sc, s7_pointer new_e, s7_pointer old_e)
+{
+ s7_pointer x;
+ if (old_e == sc->rootlet)
+ return;
-static s7_Double cabs(s7_Complex z)
-{
- return(hypot(creal(z), cimag(z)));
-}
+ if (new_e != sc->rootlet)
+ {
+ for (x = let_slots(old_e); is_slot(x); x = next_slot(x))
+ make_slot_1(sc, new_e, slot_symbol(x), slot_value(x)); /* not add_slot here because we might run off the free heap end */
+ }
+ else
+ {
+ for (x = let_slots(old_e); is_slot(x); x = next_slot(x))
+ {
+ s7_pointer sym, val;
+ sym = slot_symbol(x);
+ val = slot_value(x);
+ if (is_slot(global_slot(sym)))
+ slot_set_value(global_slot(sym), val);
+ else s7_make_slot(sc, new_e, sym, val);
+ }
+ }
+}
+static s7_pointer check_c_obj_env(s7_scheme *sc, s7_pointer old_e, s7_pointer caller)
+{
+ if (is_c_object(old_e))
+ old_e = c_object_let(old_e);
+ if (!is_let(old_e))
+ return(simple_wrong_type_argument_with_type(sc, caller, old_e, A_LET));
+ return(old_e);
+}
-static s7_Complex conj(s7_Complex z)
-{
- return(~z);
-}
+static s7_pointer g_varlet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_varlet "(varlet env ...) adds its arguments (an environment, a cons: symbol . value, or a pair of arguments, the symbol and its value) \
+to the environment env, and returns the environment."
+ #define Q_varlet s7_make_circular_signature(sc, 2, 3, sc->IS_LET, sc->IS_LET, sc->T)
+ s7_pointer x, e, sym, val, p;
-static s7_Complex csqrt(s7_Complex z)
-{
- if (cimag(z) < 0.0)
- return(conj(csqrt(conj(z))));
- else
- {
- s7_Double r = cabs(z);
- s7_Double x = creal(z);
-
- return(sqrt((r + x) / 2.0) + sqrt((r - x) / 2.0) * _Complex_I);
- }
-}
-#endif
+ e = car(args);
+ if (is_null(e))
+ e = sc->rootlet;
+ else
+ {
+ check_method(sc, e, sc->VARLET, args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->VARLET, 1, e, A_LET));
+ }
+ for (x = cdr(args); is_pair(x); x = cdr(x))
+ {
+ p = car(x);
+ switch (type(p))
+ {
+ case T_SYMBOL:
+ if (is_keyword(p))
+ sym = keyword_symbol(p);
+ else sym = p;
+ if (!is_pair(cdr(x)))
+ return(wrong_type_argument_with_type(sc, sc->VARLET, position_of(x, args), p, A_BINDING));
+ x = cdr(x);
+ val = car(x);
+ break;
-#if (!HAVE_COMPLEX_TRIG)
+ case T_PAIR:
+ sym = car(p);
+ if (!is_symbol(sym))
+ return(wrong_type_argument_with_type(sc, sc->VARLET, position_of(x, args), p, A_SYMBOL));
+ val = cdr(p);
+ break;
-#if (!__cplusplus)
-static s7_Complex csin(s7_Complex z)
-{
- return(sin(creal(z)) * cosh(cimag(z)) + (cos(creal(z)) * sinh(cimag(z))) * _Complex_I);
-}
+ case T_LET:
+ append_let(sc, e, check_c_obj_env(sc, p, sc->VARLET));
+ continue;
+ default:
+ return(wrong_type_argument_with_type(sc, sc->VARLET, position_of(x, args), p, A_SYMBOL));
+ }
-static s7_Complex ccos(s7_Complex z)
-{
- return(cos(creal(z)) * cosh(cimag(z)) + (-sin(creal(z)) * sinh(cimag(z))) * _Complex_I);
-}
+ if (is_immutable_symbol(sym))
+ return(wrong_type_argument_with_type(sc, sc->VARLET, position_of(x, args), sym, A_NON_CONSTANT_SYMBOL));
+ if (e == sc->rootlet)
+ {
+ if (is_slot(global_slot(sym)))
+ {
+ if (is_syntax(slot_value(global_slot(sym))))
+ return(wrong_type_argument_with_type(sc, sc->VARLET, position_of(x, args), p, make_string_wrapper(sc, "a non-syntactic keyword")));
+ /* without this check we can end up turning our code into gibberish:
+ * :(set! quote 1)
+ * ;can't set! quote
+ * :(varlet (rootlet) '(quote . 1))
+ * :quote
+ * 1
+ * or worse set quote to a function of one arg that tries to quote something -- infinite loop
+ */
+ slot_set_value(global_slot(sym), val);
+ }
+ else s7_make_slot(sc, e, sym, val);
+ }
+ else make_slot_1(sc, e, sym, val);
+ /* this used to check for sym already defined, and set its value, but that greatly slows down
+ * the most common use (adding a slot), and makes it hard to shadow explicitly. Don't use
+ * varlet as a substitute for set!/let-set!.
+ */
+ }
+ return(e);
+}
-static s7_Complex csinh(s7_Complex z)
-{
- return(sinh(creal(z)) * cos(cimag(z)) + (cosh(creal(z)) * sin(cimag(z))) * _Complex_I);
-}
+/* -------------------------------- cutlet -------------------------------- */
+static s7_pointer g_cutlet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cutlet "(cutlet e symbol ...) removes symbols from the environment e."
+ #define Q_cutlet s7_make_circular_signature(sc, 2, 3, sc->IS_LET, sc->IS_LET, sc->IS_SYMBOL)
-static s7_Complex ccosh(s7_Complex z)
-{
- return(cosh(creal(z)) * cos(cimag(z)) + (sinh(creal(z)) * sin(cimag(z))) * _Complex_I);
-}
-#endif
+ s7_pointer e, syms;
+ #define THE_UN_ID ++sc->let_number
+ e = car(args);
+ if (is_null(e))
+ e = sc->rootlet;
+ else
+ {
+ check_method(sc, e, sc->CUTLET, args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->CUTLET, 1, e, A_LET));
+ }
+ /* besides removing the slot we have to make sure the symbol_id does not match else
+ * let-ref and others will use the old slot! What's the un-id? Perhaps the next one?
+ * (let ((b 1)) (let ((b 2)) (cutlet (curlet) 'b)) b)
+ */
+ for (syms = cdr(args); is_pair(syms); syms = cdr(syms))
+ {
+ s7_pointer sym, slot;
+ sym = car(syms);
+ if (!is_symbol(sym))
+ return(wrong_type_argument_with_type(sc, sc->CUTLET, position_of(syms, args), sym, A_SYMBOL));
+ if (e == sc->rootlet)
+ {
+ if (is_slot(global_slot(sym)))
+ {
+ symbol_set_id(sym, THE_UN_ID);
+ slot_set_value(global_slot(sym), sc->UNDEFINED);
+ }
+ }
+ else
+ {
+ slot = let_slots(e);
+ if (is_slot(slot))
+ {
+ if (slot_symbol(slot) == sym)
+ {
+ let_set_slots(e, next_slot(let_slots(e)));
+ symbol_set_id(sym, THE_UN_ID);
+ }
+ else
+ {
+ s7_pointer last_slot;
+ last_slot = slot;
+ for (slot = next_slot(let_slots(e)); is_slot(slot); last_slot = slot, slot = next_slot(slot))
+ {
+ if (slot_symbol(slot) == sym)
+ {
+ symbol_set_id(sym, THE_UN_ID);
+ next_slot(last_slot) = next_slot(slot);
+ break;
+ }
+ }
+ }
+ }
+ }
+ }
+ return(e);
+}
-static s7_Complex ctan(s7_Complex z)
-{
- return(csin(z) / ccos(z));
-}
+/* -------------------------------- sublet -------------------------------- */
+static s7_pointer sublet_1(s7_scheme *sc, s7_pointer e, s7_pointer bindings, s7_pointer caller)
+{
+ s7_pointer new_e;
-static s7_Complex ctanh(s7_Complex z)
-{
- return(csinh(z) / ccosh(z));
-}
+ if (e == sc->rootlet)
+ new_e = new_frame_in_env(sc, sc->NIL);
+ else new_e = new_frame_in_env(sc, e);
+ set_all_methods(new_e, e);
+ if (!is_null(bindings))
+ {
+ s7_pointer x;
+ sc->temp3 = new_e;
-#if (!__cplusplus)
-static s7_Complex cexp(s7_Complex z)
-{
- return(exp(creal(z)) * cos(cimag(z)) + (exp(creal(z)) * sin(cimag(z))) * _Complex_I);
-}
+ for (x = bindings; is_not_null(x); x = cdr(x))
+ {
+ s7_pointer p, sym, val;
+ p = car(x);
+ switch (type(p))
+ {
+ case T_SYMBOL:
+ if (is_keyword(p))
+ sym = keyword_symbol(p);
+ else sym = p;
+ if (!is_pair(cdr(x)))
+ return(wrong_type_argument_with_type(sc, caller, position_of(x, bindings), p, A_BINDING));
+ x = cdr(x);
+ val = car(x);
+ break;
-static s7_Complex clog(s7_Complex z)
-{
- return(log(s7_Double_abs(cabs(z))) + carg(z) * _Complex_I);
-}
+ case T_PAIR:
+ sym = car(p);
+ if (!is_symbol(sym))
+ return(wrong_type_argument_with_type(sc, caller, position_of(x, bindings), p, A_SYMBOL));
+ val = cdr(p);
+ break;
+ case T_LET:
+ append_let(sc, new_e, check_c_obj_env(sc, p, caller));
+ continue;
-static s7_Complex cpow(s7_Complex x, s7_Complex y)
-{
- s7_Double r = cabs(x);
- s7_Double theta = carg(x);
- s7_Double yre = creal(y);
- s7_Double yim = cimag(y);
- s7_Double nr = exp(yre * log(r) - yim * theta);
- s7_Double ntheta = yre * theta + yim * log(r);
-
- return(nr * cos(ntheta) + (nr * sin(ntheta)) * _Complex_I); /* make-polar */
-}
-#endif
+ default:
+ return(wrong_type_argument_with_type(sc, caller, position_of(x, bindings), p, A_SYMBOL));
+ }
+ if (is_immutable_symbol(sym))
+ return(wrong_type_argument_with_type(sc, caller, position_of(x, bindings), sym, A_NON_CONSTANT_SYMBOL));
-static s7_Complex casin(s7_Complex z)
-{
- return(-_Complex_I * clog(_Complex_I * z + csqrt(1.0 - z * z)));
-}
+ /* here we know new_e is a let and is not rootlet */
+ make_slot_1(sc, new_e, sym, val);
+ if (sym == sc->LET_REF_FALLBACK)
+ set_has_ref_fallback(new_e);
+ else
+ {
+ if (sym == sc->LET_SET_FALLBACK)
+ set_has_set_fallback(new_e);
+ }
+ }
+ sc->temp3 = sc->NIL;
+ }
+ return(new_e);
+}
+s7_pointer s7_sublet(s7_scheme *sc, s7_pointer e, s7_pointer bindings)
+{
+ return(sublet_1(sc, e, bindings, sc->SUBLET));
+}
-static s7_Complex cacos(s7_Complex z)
-{
- return(-_Complex_I * clog(z + _Complex_I * csqrt(1.0 - z * z)));
-}
+static s7_pointer g_sublet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_sublet "(sublet env ...) adds its \
+arguments (each an environment or a cons: symbol . value) to the environment env, and returns the \
+new environment."
+ #define Q_sublet s7_make_circular_signature(sc, 2, 3, sc->IS_LET, s7_make_signature(sc, 2, sc->IS_LET, sc->IS_NULL), sc->T)
+ s7_pointer e;
-static s7_Complex catan(s7_Complex z)
-{
- return(_Complex_I * clog((_Complex_I + z) / (_Complex_I - z)) / 2.0);
-}
+ e = car(args);
+ if (is_null(e))
+ e = sc->rootlet;
+ else
+ {
+ check_method(sc, e, sc->SUBLET, args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->SUBLET, 1, e, A_LET));
+ }
+ return(sublet_1(sc, e, cdr(args), sc->SUBLET));
+}
-static s7_Complex casinh(s7_Complex z)
-{
- return(clog(z + csqrt(1.0 + z * z)));
-}
+/* -------------------------------- inlet -------------------------------- */
+s7_pointer s7_inlet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_inlet "(inlet ...) adds its \
+arguments, each an environment, a cons: '(symbol . value), or a keyword/value pair, to a new environment, and returns the \
+new environment."
+ #define Q_inlet s7_make_circular_signature(sc, 1, 2, sc->IS_LET, sc->T)
+ return(sublet_1(sc, sc->rootlet, args, sc->INLET));
+}
-static s7_Complex cacosh(s7_Complex z)
-{
- return(clog(z + csqrt(z * z - 1.0)));
- /* perhaps less prone to numerical troubles (untested):
- * 2.0 * clog(csqrt(0.5 * (z + 1.0)) + csqrt(0.5 * (z - 1.0)))
- */
-}
+#define g_inlet s7_inlet
-static s7_Complex catanh(s7_Complex z)
-{
- return(clog((1.0 + z) / (1.0 - z)) / 2.0);
-}
-#endif
+/* -------------------------------- let->list -------------------------------- */
+s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer env)
+{
+ s7_pointer x;
-#else
-/* not WITH_COMPLEX */
- typedef double s7_Complex;
- #define _Complex_I 1
- #define creal(x) x
- #define cimag(x) x
- #define csin(x) sin(x)
- #define casin(x) x
- #define ccos(x) cos(x)
- #define cacos(x) x
- #define ctan(x) x
- #define catan(x) x
- #define csinh(x) x
- #define casinh(x) x
- #define ccosh(x) x
- #define cacosh(x) x
- #define ctanh(x) x
- #define catanh(x) x
- #define cexp(x) exp(x)
- #define cpow(x, y) pow(x, y)
- #define clog(x) log(x)
- #define csqrt(x) sqrt(x)
- #define conj(x) x
-#endif
+ sc->temp3 = sc->w;
+ sc->w = sc->NIL;
+ if (env == sc->rootlet)
+ {
+ unsigned int i, lim2;
+ s7_pointer *entries;
-#if (!WITH_GMP)
+ entries = vector_elements(env);
+ lim2 = sc->rootlet_entries;
+ if (lim2 & 1) lim2--;
-bool s7_is_number(s7_pointer p)
-{
- return(type(p) == T_NUMBER);
-}
+ for (i = 0; i < lim2; )
+ {
+ sc->w = cons_unchecked(sc, cons(sc, slot_symbol(entries[i]), slot_value(entries[i])), sc->w); i++;
+ sc->w = cons_unchecked(sc, cons_unchecked(sc, slot_symbol(entries[i]), slot_value(entries[i])), sc->w); i++;
+ }
+ if (lim2 < sc->rootlet_entries)
+ sc->w = cons_unchecked(sc, cons(sc, slot_symbol(entries[i]), slot_value(entries[i])), sc->w);
+ }
+ else
+ {
+ s7_pointer iter, func;
+ /* need to check make-iterator method before dropping into let->list */
+ if ((has_methods(env)) && ((func = find_method(sc, env, sc->MAKE_ITERATOR)) != sc->UNDEFINED))
+ iter = s7_apply_function(sc, func, list_1(sc, env));
+ else iter = sc->NIL;
-bool s7_is_integer(s7_pointer p)
-{
- if (!(s7_is_number(p)))
- return(false);
-
- return(number_type(p) == NUM_INT);
+ if (is_null(iter))
+ {
+ for (x = let_slots(env); is_slot(x); x = next_slot(x))
+ sc->w = cons_unchecked(sc, cons(sc, slot_symbol(x), slot_value(x)), sc->w);
+ }
+ else
+ {
+ /* (begin (load "mockery.scm") (let ((lt ((*mock-pair* 'mock-pair) 1 2 3))) (format *stderr* "~{~A ~}" lt))) */
+ while (true)
+ {
+ x = s7_iterate(sc, iter);
+ if (iterator_is_at_end(iter)) break;
+ sc->w = cons(sc, x, sc->w);
+ }
+ sc->w = safe_reverse_in_place(sc, sc->w);
+ }
+ }
+ x = sc->w;
+ sc->w = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(x);
}
+#if (!WITH_PURE_S7)
+static s7_pointer g_let_to_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_let_to_list "(let->list env) returns env's bindings as a list of cons's: '(symbol . value)."
+ #define Q_let_to_list s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_LET)
-bool s7_is_real(s7_pointer p)
-{
- if (!(s7_is_number(p)))
- return(false);
-
- return(number_type(p) < NUM_COMPLEX);
+ s7_pointer env;
+ env = car(args);
+ check_method(sc, env, sc->LET_TO_LIST, args);
+ if (!is_let(env))
+ {
+ if (is_c_object(env))
+ env = c_object_let(env);
+ if (!is_let(env))
+ return(simple_wrong_type_argument_with_type(sc, sc->LET_TO_LIST, env, A_LET));
+ }
+ return(s7_let_to_list(sc, env));
}
+#endif
-bool s7_is_rational(s7_pointer p)
+/* -------------------------------- let-ref -------------------------------- */
+static s7_pointer let_ref_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol)
{
- if (!(s7_is_number(p)))
- return(false);
-
- return(number_type(p) <= NUM_RATIO);
-}
+ s7_pointer x, y;
+ /* (let ((a 1)) ((curlet) 'a))
+ * ((rootlet) 'abs)
+ */
+ if (env == sc->rootlet)
+ {
+ y = global_slot(symbol);
+ if (is_slot(y))
+ return(slot_value(y));
+ return(sc->UNDEFINED);
+ }
+ if (let_id(env) == symbol_id(symbol))
+ return(slot_value(local_slot(symbol))); /* this obviously has to follow the global-env check */
-bool s7_is_ratio(s7_pointer p)
-{
- if (!(s7_is_number(p)))
- return(false);
-
- return(number_type(p) == NUM_RATIO);
-}
+ for (x = env; is_let(x); x = outlet(x))
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(slot_value(y));
+ /* now for a horrible kludge. If a let is a mock-hash-table (for example), implicit
+ * indexing of the hash-table collides with the same thing for the let (field names
+ * versus keys), and we can't just try again here because that makes it too easy to
+ * get into infinite recursion. So, 'let-ref-fallback...
+ */
+ if (has_ref_fallback(env))
+ check_method(sc, env, sc->LET_REF_FALLBACK, sc->w = list_2(sc, env, symbol));
-bool s7_is_complex(s7_pointer p)
-{
- return(s7_is_number(p));
+ return(sc->UNDEFINED);
}
-#endif
-/* !WITH_GMP */
-
-
-bool s7_is_exact(s7_pointer p)
+s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer symbol)
{
- return(s7_is_rational(p));
+ if (!is_let(env))
+ return(wrong_type_argument_with_type(sc, sc->LET_REF, 1, env, A_LET));
+
+ if (!is_symbol(symbol))
+ {
+ check_method(sc, env, sc->LET_REF, sc->w = list_2(sc, env, symbol));
+ if (has_ref_fallback(env))
+ check_method(sc, env, sc->LET_REF_FALLBACK, sc->w = list_2(sc, env, symbol));
+ return(wrong_type_argument_with_type(sc, sc->LET_REF, 2, symbol, A_SYMBOL));
+ }
+ return(let_ref_1(sc, env, symbol));
}
-
-bool s7_is_inexact(s7_pointer p)
+static s7_pointer g_let_ref(s7_scheme *sc, s7_pointer args)
{
- return(!s7_is_rational(p));
-}
+ #define H_let_ref "(let-ref env sym) returns the value of the symbol sym in the environment env"
+ #define Q_let_ref s7_make_signature(sc, 3, sc->T, sc->IS_LET, sc->IS_SYMBOL)
+ s7_pointer e, s;
+ e = car(args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->LET_REF, 1, e, A_LET));
-static s7_Int c_gcd(s7_Int u, s7_Int v)
-{
- s7_Int a, b, temp;
-
- a = s7_Int_abs(u); /* trouble if either is most-negative-fixnum... */
- b = s7_Int_abs(v);
- while (b != 0)
+ s = cadr(args);
+ if (!is_symbol(s))
{
- temp = a % b;
- a = b;
- b = temp;
+ check_method(sc, e, sc->LET_REF, args);
+ if (has_ref_fallback(e))
+ check_method(sc, e, sc->LET_REF_FALLBACK, args);
+ return(wrong_type_argument_with_type(sc, sc->LET_REF, 2, s, A_SYMBOL));
}
- if (a < 0)
- return(-a);
- return(a);
+ return(let_ref_1(sc, e, s));
}
-static bool c_rationalize(s7_Double ux, s7_Double error, s7_Int *numer, s7_Int *denom)
+/* -------------------------------- let-set! -------------------------------- */
+static s7_pointer call_accessor(s7_scheme *sc, s7_pointer slot, s7_pointer old_value)
{
- /*
- (define* (rat ux (err 0.0000001))
- ;; translated from CL code in Canny, Donald, Ressler, "A Rational Rotation Method for Robust Geometric Algorithms"
- (let ((x0 (- ux error))
- (x1 (+ ux error)))
- (let ((i (ceiling x0))
- (i0 (floor x0))
- (i1 (ceiling x1))
- (r 0))
- (if (>= x1 i)
- i
- (do ((p0 i0 (+ p1 (* r p0)))
- (q0 1 (+ q1 (* r q0)))
- (p1 i1 p0)
- (q1 1 q0)
- (e0 (- i1 x0) e1p)
- (e1 (- x0 i0) (- e0p (* r e1p)))
- (e0p (- i1 x1) e1)
- (e1p (- x1 i0) (- e0 (* r e1))))
- ((<= x0 (/ p0 q0) x1)
- (/ p0 q0))
- (set! r (min (floor (/ e0 e1))
- (ceiling (/ e0p e1p)))))))))
- */
-
- double x0, x1, val;
- s7_Int i, i0, i1, r, r1, p0, q0, p1, q1;
- double e0, e1, e0p, e1p;
- s7_Int old_p1, old_q1;
- double old_e0, old_e1, old_e0p;
- /* don't use s7_Double here; if it is "long double", the loop below will hang */
+ s7_pointer func, new_value;
- /* #e1e19 is a killer -- it's bigger than most-positive-fixnum, but if we ceil(ux) below
- * it turns into most-negative-fixnum. 1e19 is trouble in many places.
- */
- if ((ux > s7_Int_max) || (ux < s7_Int_min))
- {
- /* can't return false here because that confuses some of the callers!
- */
- if (ux > s7_Int_min) (*numer) = s7_Int_max; else (*numer) = s7_Int_min;
- (*denom) = 1;
- return(true);
- }
+ new_value = sc->ERROR;
+ func = slot_accessor(slot);
- if (error < 0.0) error = -error;
- x0 = ux - error;
- x1 = ux + error;
- i = (s7_Int)ceil(x0);
-
- if (error >= 1.0) /* aw good grief! */
+ if (is_procedure_or_macro(func))
{
- if (x0 < 0)
+ if (is_c_function(func))
{
- if (x1 < 0)
- (*numer) = (s7_Int)floor(x1);
- else (*numer) = 0;
+ car(sc->T2_1) = slot_symbol(slot);
+ car(sc->T2_2) = old_value;
+ new_value = c_function_call(func)(sc, sc->T2_1);
}
else
{
- (*numer) = i;
+ bool old_off;
+ old_off = sc->gc_off;
+ sc->gc_off = true;
+ new_value = s7_apply_function(sc, func, list_2(sc, slot_symbol(slot), old_value));
+ sc->gc_off = old_off;
}
- (*denom) = 1;
- return(true);
- }
-
- if (x1 >= i)
- {
- if (i >= 0)
- (*numer) = i;
- else (*numer) = (s7_Int)floor(x1);
- (*denom) = 1;
- return(true);
}
+ else return(old_value);
- i0 = (s7_Int)floor(x0);
- i1 = (s7_Int)ceil(x1);
+ if (new_value == sc->ERROR)
+ return(s7_error(sc, sc->ERROR, set_elist_3(sc, make_string_wrapper(sc, "can't set! ~S to ~S"), slot_symbol(slot), old_value)));
+ return(new_value);
+}
- p0 = i0;
- q0 = 1;
- p1 = i1;
- q1 = 1;
- e0 = i1 - x0;
- e1 = x0 - i0;
- e0p = i1 - x1;
- e1p = x1 - i0;
+static s7_pointer let_set_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value)
+{
+ s7_pointer x, y;
- while (true)
+ if (env == sc->rootlet)
{
- val = (double)p0 / (double)q0;
-
- if (((x0 <= val) && (val <= x1)) ||
- (e1 == 0) ||
- (e1p == 0))
+ if (is_immutable_symbol(symbol)) /* (let-set! (rootlet) :key #f) */
+ return(wrong_type_argument_with_type(sc, sc->LET_SET, 2, symbol, A_NON_CONSTANT_SYMBOL));
+ y = global_slot(symbol);
+ if (is_slot(y))
{
- (*numer) = p0;
- (*denom) = q0;
- return(true);
+ if (slot_has_accessor(y))
+ slot_set_value(y, call_accessor(sc, y, value));
+ else slot_set_value(y, value);
+ return(slot_value(y));
}
-
- r = (s7_Int)floor(e0 / e1);
- r1 = (s7_Int)ceil(e0p / e1p);
- if (r1 < r) r = r1;
-
- /* Scheme "do" handles all step vars in parallel */
- old_p1 = p1;
- p1 = p0;
- old_q1 = q1;
- q1 = q0;
- old_e0 = e0;
- e0 = e1p;
- old_e0p = e0p;
- e0p = e1;
- old_e1 = e1;
-
- p0 = old_p1 + r * p0;
- q0 = old_q1 + r * q0;
- e1 = old_e0p - r * e1p;
- /* if the error is set too low, we can get e1 = 0 here: (rationalize (/ pi) 1e-17) */
- e1p = old_e0 - r * old_e1;
+ return(sc->UNDEFINED);
}
- return(false);
-}
-#if 0
-/* there is another way to rationalize. Here is a scheme version of
- * Bill Gosper's farint:
+ for (x = env; is_let(x); x = outlet(x))
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ {
+ if (slot_has_accessor(y))
+ slot_set_value(y, call_accessor(sc, y, value));
+ else slot_set_value(y, value);
+ return(slot_value(y));
+ }
-(define* (farint x (err 1/1000000))
-
- (define* (farint-1 x nhi dhi (ln 0) (ld 1) (hn 1) (hd 0))
- (if (> (+ ln hn) (* (+ ld hd) x))
- (let* ((m (min (if (= 0 ln)
- nhi
- (floor (/ (- nhi hn) ln)))
- (floor (/ (- dhi hd) ld))))
- (d (- (* x ld) ln))
- (k (if (= 0 d)
- m
- (ceiling (/ (- hn (* x hd)) d)))))
- (if (< k m)
- (let ((hn1 (+ (* k ln) hn))
- (hd1 (+ (* k ld) hd)))
- (farint-1 x nhi dhi hn1 hd1 (- hn1 ln) (- hd1 ld)))
-
- (let* ((n (+ (* m ln) hn)) (d (+ (* m ld) hd)))
- (if (< (* 2 d ld x) (+ (* ld n) (* ln d)))
- (/ ln ld)
- (/ n d)))))
-
- (let* ((m (min (floor (/ (- nhi ln) hn))
- (if (= 0 hd)
- dhi
- (floor (/ (- dhi ld) hd)))))
- (d (- hn (* x hd)))
- (k (if (= 0 d)
- m
- (ceiling (/ (- (* x ld) ln) d)))))
- (if (< k m)
- (let ((ln1 (+ (* k hn) ln))
- (ld1 (+ (* k hd) ld)))
- (farint-1 x nhi dhi (- ln1 hn) (- ld1 hd) ln1 ld1))
- (let* ((n (+ (* m hn) ln)) (d (+ (* m hd) ld)))
- (if (< (* 2 d hd x) (+ (* hd n) (* hn d)))
- (/ n d)
- (/ hn hd)))))))
-
- (farint-1 x (/ err) (/ err)))
-*/
-#endif
-
-
-s7_pointer s7_rationalize(s7_scheme *sc, s7_Double x, s7_Double error)
-{
- s7_Int numer = 0, denom = 1;
- if (c_rationalize(x, error, &numer, &denom))
- return(s7_make_ratio(sc, numer, denom));
- return(s7_make_real(sc, x));
+ if (has_set_fallback(env))
+ check_method(sc, env, sc->LET_SET_FALLBACK, sc->w = list_3(sc, env, symbol, value));
+ return(sc->UNDEFINED);
}
-
-static s7_Double num_to_real(s7_num_t n)
+s7_pointer s7_let_set(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value)
{
- if (n.type >= NUM_REAL)
- return(real(n));
- if (n.type == NUM_INT)
- return((s7_Double)integer(n));
- return(fraction(n));
-}
+ if (!is_let(env))
+ return(wrong_type_argument_with_type(sc, sc->LET_SET, 1, env, A_LET));
+ if (!is_symbol(symbol))
+ {
+ check_method(sc, env, sc->LET_SET, sc->w = list_3(sc, env, symbol, value));
+ if (has_set_fallback(env))
+ check_method(sc, env, sc->LET_SET_FALLBACK, sc->w = list_3(sc, env, symbol, value));
+ return(wrong_type_argument_with_type(sc, sc->LET_SET, 2, symbol, A_SYMBOL));
+ }
-static s7_Int num_to_numerator(s7_num_t n)
-{
- if (n.type == NUM_RATIO)
- return(numerator(n));
- return(integer(n));
+ return(let_set_1(sc, env, symbol, value));
}
-
-static s7_Int num_to_denominator(s7_num_t n)
+static s7_pointer g_let_set(s7_scheme *sc, s7_pointer args)
{
- if (n.type == NUM_RATIO)
- return(denominator(n));
- return(1);
+ /* (let ((a 1)) (set! ((curlet) 'a) 32) a) */
+ #define H_let_set "(let-set! env sym val) sets the symbol sym's value in the environment env to val"
+ #define Q_let_set s7_make_signature(sc, 4, sc->T, sc->IS_LET, sc->IS_SYMBOL, sc->T)
+
+ return(s7_let_set(sc, car(args), cadr(args), caddr(args)));
}
-static s7_Double num_to_real_part(s7_num_t n)
+
+static s7_pointer reverse_slots(s7_scheme *sc, s7_pointer list)
{
- /* no bignum parallel */
- switch (n.type)
+ s7_pointer p = list, result, q;
+ result = sc->NIL;
+
+ while (is_slot(p))
{
- case NUM_INT: return((s7_Double)integer(n));
- case NUM_RATIO: return(fraction(n));
- case NUM_REAL:
- case NUM_REAL2: return(real(n));
- default: return(real_part(n));
+ q = next_slot(p);
+ next_slot(p) = result;
+ result = p;
+ p = q;
}
+ return(result);
}
-static s7_Double num_to_imag_part(s7_num_t n)
+static s7_pointer let_copy(s7_scheme *sc, s7_pointer env)
{
- if (n.type >= NUM_COMPLEX)
- return(imag_part(n));
- return(0.0);
-}
+ if (is_let(env))
+ {
+ s7_pointer new_e;
+ if (env == sc->rootlet) /* (copy (rootlet)) or (copy (funclet abs)) etc */
+ return(sc->rootlet);
-static s7_num_t make_ratio(s7_Int numer, s7_Int denom)
-{
- s7_num_t ret;
- s7_Int divisor;
+ /* we can't make copy handle environments-as-objects specially because the
+ * make-object function in define-class uses copy to make a new object!
+ * So if it is present, we get it here, and then there's almost surely trouble.
+ */
+ new_e = new_frame_in_env(sc, outlet(env));
+ set_all_methods(new_e, env);
+ sc->temp3 = new_e;
+ if (is_slot(let_slots(env)))
+ {
+ s7_int id;
+ s7_pointer x, y = NULL;
- if (numer == 0)
- {
- ret.type = NUM_INT;
- integer(ret) = 0;
- return(ret);
- }
-
- if (denom < 0)
- {
- numer = -numer;
- denom = -denom;
- /* this doesn't work in the case (/ most-positive-fixnum most-negative-fixnum)
- * because (= (- most-negative-fixnum) most-negative-fixnum) is #t.
+ id = let_id(new_e);
+ for (x = let_slots(env); is_slot(x); x = next_slot(x))
+ {
+ s7_pointer z;
+ new_cell(sc, z, T_SLOT);
+ slot_set_symbol(z, slot_symbol(x));
+ slot_set_value(z, slot_value(x));
+ if (symbol_id(slot_symbol(z)) != id) /* keep shadowing intact */
+ symbol_set_local(slot_symbol(x), id, z);
+ if (is_slot(let_slots(new_e)))
+ next_slot(y) = z;
+ else let_set_slots(new_e, z);
+ next_slot(z) = sc->NIL; /* in case GC runs during this loop */
+ y = z;
+ }
+ }
+ /* We can't do a (normal) loop here then reverse the slots later because the symbol's local_slot has to
+ * match the unshadowed slot, not the last in the list:
+ * (let ((e1 (inlet 'a 1 'a 2))) (let ((e2 (copy e1))) (list (equal? e1 e2) (equal? (e1 'a) (e2 'a)))))
*/
+ sc->temp3 = sc->NIL;
+ return(new_e);
}
-
- divisor = c_gcd(numer, denom);
- if (divisor != 1)
- {
- numer /= divisor;
- denom /= divisor;
- }
-
- if (denom == 1)
- {
- ret.type = NUM_INT;
- integer(ret) = numer;
- }
- else
- {
- ret.type = NUM_RATIO;
- numerator(ret) = numer;
- denominator(ret) = denom;
- }
- return(ret);
+ return(sc->NIL);
}
-s7_pointer s7_make_integer(s7_scheme *sc, s7_Int n)
+/* -------------------------------- rootlet -------------------------------- */
+static s7_pointer g_rootlet(s7_scheme *sc, s7_pointer ignore)
{
- s7_pointer x;
- if (n < NUM_SMALL_INTS)
- {
- if (n >= 0)
- return(small_ints[n]);
- if (n > (-NUM_SMALL_INTS))
- return(small_negative_ints[-n]);
- }
- NEW_CELL(sc, x);
- set_type(x, T_NUMBER | T_SIMPLE | T_DONT_COPY);
- number_type(x) = NUM_INT;
- integer(number(x)) = n;
+ #define H_rootlet "(rootlet) returns the current top-level definitions (symbol bindings)."
+ #define Q_rootlet s7_make_signature(sc, 1, sc->IS_LET)
+ return(sc->rootlet);
+}
+/* as with the symbol-table, this function can lead to disaster -- user could
+ * clobber the environment etc. But we want it to be editable and augmentable,
+ * so I guess I'll leave it alone. (See curlet|funclet as well).
+ */
- return(x);
+s7_pointer s7_rootlet(s7_scheme *sc)
+{
+ return(sc->rootlet);
}
+s7_pointer s7_shadow_rootlet(s7_scheme *sc)
+{
+ return(sc->shadow_rootlet);
+}
-static s7_pointer make_mutable_integer(s7_scheme *sc, s7_Int n)
+s7_pointer s7_set_shadow_rootlet(s7_scheme *sc, s7_pointer let)
{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_NUMBER | T_SIMPLE | T_DONT_COPY);
- number_type(x) = NUM_INT;
- integer(number(x)) = n;
- return(x);
+ sc->shadow_rootlet = let;
+ return(let);
}
-s7_pointer s7_make_real(s7_scheme *sc, s7_Double n)
+/* -------------------------------- curlet -------------------------------- */
+static s7_pointer g_curlet(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- if (n == 0.0)
- return(real_zero);
- if (n == 1.0)
- return(real_one);
+ #define H_curlet "(curlet) returns the current definitions (symbol bindings)"
+ #define Q_curlet s7_make_signature(sc, 1, sc->IS_LET)
- NEW_CELL(sc, x);
- set_type(x, T_NUMBER | T_SIMPLE | T_DONT_COPY);
- number_type(x) = NUM_REAL;
- real(number(x)) = n;
-
- return(x);
+ sc->capture_let_counter++;
+ if (is_let(sc->envir))
+ return(sc->envir);
+ return(sc->rootlet);
}
-
-s7_pointer s7_make_complex(s7_scheme *sc, s7_Double a, s7_Double b)
+s7_pointer s7_curlet(s7_scheme *sc)
{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_NUMBER | T_SIMPLE | T_DONT_COPY);
- if (b == 0.0)
- {
- number_type(x) = NUM_REAL;
- real(number(x)) = a;
- }
- else
- {
- number_type(x) = NUM_COMPLEX;
- real_part(number(x)) = a;
- imag_part(number(x)) = b;
- }
- return(x);
+ sc->capture_let_counter++;
+ return(sc->envir);
}
-
-s7_pointer s7_make_ratio(s7_scheme *sc, s7_Int a, s7_Int b)
+s7_pointer s7_set_curlet(s7_scheme *sc, s7_pointer e)
{
- s7_pointer x;
- s7_Int divisor;
-
- if (b == 0)
- return(division_by_zero_error(sc, "make-ratio", make_list_2(sc, s7_make_integer(sc, a), small_ints[0])));
- if (a == 0)
- return(small_ints[0]);
- if (b == 1)
- return(s7_make_integer(sc, a));
+ s7_pointer p, old_e;
+ old_e = sc->envir;
+ sc->envir = e;
-#if (!WITH_GMP)
- if (b == S7_LLONG_MIN)
+ if ((is_let(e)) && (let_id(e) > 0)) /* might be () [id=-1] or rootlet [id=0] etc */
{
- if (a == b)
- return(small_int(1));
-
- /* we've got a problem... This should not trigger an error during reading -- we might have the
- * ratio on a switch with-bignums or whatever, so its mere occurrence is just an annoyance.
- * We'll try to do something...
- */
- if (a & 1)
- {
- if (a == 1)
- return(s7_make_real(sc, NAN));
- /* not an error here because 1/9223372036854775808 might be in a block of unevaluated code */
- b = b + 1;
- }
- else
+ let_id(e) = ++sc->let_number;
+ for (p = let_slots(e); is_slot(p); p = next_slot(p))
{
- a /= 2;
- b /= 2;
+ s7_pointer sym;
+ sym = slot_symbol(p);
+ if (symbol_id(sym) != sc->let_number)
+ symbol_set_local(sym, sc->let_number, p);
}
}
-#endif
-
- if (b < 0)
- {
- a = -a;
- b = -b;
- }
- divisor = c_gcd(a, b);
- if (divisor != 1)
- {
- a /= divisor;
- b /= divisor;
- }
- if (b == 1)
- return(s7_make_integer(sc, a));
-
- NEW_CELL(sc, x);
- set_type(x, T_NUMBER | T_SIMPLE | T_DONT_COPY);
- number_type(x) = NUM_RATIO;
- numerator(number(x)) = a;
- denominator(number(x)) = b;
- return(x);
+ return(old_e);
}
-
-static s7_pointer exact_to_inexact(s7_scheme *sc, s7_pointer x)
+/* -------------------------------- outlet -------------------------------- */
+s7_pointer s7_outlet(s7_scheme *sc, s7_pointer e)
{
- /* this is tricky because a big int can mess up when turned into a double:
- * (truncate (exact->inexact most-positive-fixnum)) -> -9223372036854775808
- */
- if (s7_is_rational(x))
- return(s7_make_real(sc, s7_number_to_real(x)));
- return(x);
+ return(outlet(e));
}
+static s7_pointer g_outlet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_outlet "(outlet env) is the environment that contains env."
+ #define Q_outlet s7_make_signature(sc, 2, sc->IS_LET, sc->IS_LET)
+ s7_pointer env;
+ env = car(args);
+ if (!is_let(env))
+ method_or_bust_with_type(sc, env, sc->OUTLET, args, A_LET, 0);
-static double default_rationalize_error = 1.0e-12;
+ if ((env == sc->rootlet) ||
+ (is_null(outlet(env))))
+ return(sc->rootlet);
+ return(outlet(env));
+}
-static s7_pointer inexact_to_exact(s7_scheme *sc, s7_pointer x)
+static s7_pointer g_set_outlet(s7_scheme *sc, s7_pointer args)
{
- switch (number_type(x))
- {
- case NUM_INT:
- case NUM_RATIO:
- return(x);
+ /* (let ((a 1)) (let ((b 2)) (set! (outlet (curlet)) (rootlet)) ((curlet) 'a))) */
+ s7_pointer env, new_outer;
- case NUM_REAL:
- case NUM_REAL2:
- {
- s7_Int numer = 0, denom = 1;
- s7_Double val;
+ env = car(args);
+ if (!is_let(env))
+ method_or_bust_with_type(sc, env, sc->OUTLET, args, A_LET, 0);
- val = s7_real(x);
- if ((isinf(val)) || (isnan(val)))
- return(s7_wrong_type_arg_error(sc, "inexact->exact", 0, x, "a normal real"));
+ new_outer = cadr(args);
+ if (!is_let(new_outer))
+ return(wrong_type_argument_with_type(sc, sc->OUTLET, 2, new_outer, A_LET));
+ if (new_outer == sc->rootlet)
+ new_outer = sc->NIL;
- if ((val > S7_LLONG_MAX) ||
- (val < S7_LLONG_MIN))
- return(s7_out_of_range_error(sc, "inexact->exact", 0, x, "too large to express as an integer"));
+ if (env != sc->rootlet)
+ set_outlet(env, new_outer);
+ return(new_outer);
+}
- if (c_rationalize(val, default_rationalize_error, &numer, &denom))
- return(s7_make_ratio(sc, numer, denom));
- }
- default:
- return(s7_wrong_type_arg_error(sc, "inexact->exact", 0, x, "a real"));
- }
- return(x);
-}
+static s7_pointer find_symbol(s7_scheme *sc, s7_pointer symbol)
+{
+ s7_pointer x;
+ if (let_id(sc->envir) == symbol_id(symbol))
+ return(local_slot(symbol));
-#if (!WITH_GMP)
-s7_Double s7_number_to_real(s7_pointer x)
-{
- if (!s7_is_number(x))
- return(0.0);
- /* what to do?? -- to return #f or throw an error, we need the s7_scheme pointer
- * some sort of check is needed for FFI calls -- not a number -> segfault
- */
+ for (x = sc->envir; symbol_id(symbol) < let_id(x); x = outlet(x));
+
+ if (let_id(x) == symbol_id(symbol))
+ return(local_slot(symbol));
- switch (number_type(x))
+ for (; is_let(x); x = outlet(x))
{
- case NUM_INT: return((s7_Double)s7_integer(x));
- case NUM_RATIO: return((s7_Double)s7_numerator(x) / (s7_Double)s7_denominator(x));
- case NUM_REAL:
- case NUM_REAL2: return(s7_real(x));
- default: return(complex_real_part(x));
+ s7_pointer y;
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(y);
}
+
+ return(global_slot(symbol));
}
-s7_Int s7_number_to_integer(s7_pointer x)
+static s7_pointer find_symbol_unchecked(s7_scheme *sc, s7_pointer symbol) /* find_symbol_checked includes the unbound_variable call */
{
- switch (number_type(x))
+ s7_pointer x;
+
+ if (let_id(sc->envir) == symbol_id(symbol))
+ return(slot_value(local_slot(symbol)));
+
+ for (x = sc->envir; symbol_id(symbol) < let_id(x); x = outlet(x));
+
+ /* this looks redundant, but every attempt to improve it is much slower! */
+ if (let_id(x) == symbol_id(symbol))
+ return(slot_value(local_slot(symbol)));
+
+ for (; is_let(x); x = outlet(x))
{
- case NUM_INT: return(s7_integer(x));
- case NUM_RATIO: return((s7_Int)((s7_Double)s7_numerator(x) / (s7_Double)s7_denominator(x)));
- case NUM_REAL:
- case NUM_REAL2: return((s7_Int)s7_real(x));
- default: return((s7_Int)complex_real_part(x));
+ s7_pointer y;
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(slot_value(y));
}
+
+ x = global_slot(symbol);
+ if (is_slot(x))
+ return(slot_value(x));
+
+#if WITH_GCC
+ return(NULL);
+#else
+ return(unbound_variable(sc, symbol));
+#endif
}
-s7_Int s7_numerator(s7_pointer x)
+s7_pointer s7_slot(s7_scheme *sc, s7_pointer symbol)
{
- if (number_type(x) == NUM_RATIO)
- return(numerator(number(x)));
- return(integer(number(x)));
+ return(find_symbol(sc, symbol));
}
-s7_Int s7_denominator(s7_pointer x)
+s7_pointer s7_slot_value(s7_pointer slot)
{
- if (number_type(x) == NUM_RATIO)
- return(denominator(number(x)));
- return(1);
+ return(slot_value(slot));
}
-s7_Double s7_real_part(s7_pointer x)
+s7_pointer s7_slot_set_value(s7_scheme *sc, s7_pointer slot, s7_pointer value)
{
- return(num_to_real_part(number(x)));
+ slot_set_value(slot, value);
+ return(value);
}
-s7_Double s7_imag_part(s7_pointer x)
+void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value)
{
- return(num_to_imag_part(number(x)));
+ set_real(slot_value(slot), value);
}
-s7_Int s7_integer(s7_pointer p)
+s7_double s7_slot_real_value(s7_scheme *sc, s7_pointer slot, const char *caller)
{
- return(integer(number(p)));
+ return(real_to_double(sc, slot_value(slot), caller));
}
-
-s7_Double s7_real(s7_pointer p)
+s7_int s7_slot_integer_value(s7_pointer slot)
{
- return(real(number(p)));
+ return(integer(slot_value(slot)));
}
-static s7_Complex s7_complex(s7_pointer p)
+static s7_pointer find_local_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer e)
{
- return(num_to_real_part(number(p)) + num_to_imag_part(number(p)) * _Complex_I);
+ if (!is_let(e))
+ return(global_slot(symbol));
+
+ if (symbol_id(symbol) != 0)
+ {
+ s7_pointer y;
+ for (y = let_slots(e); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(y);
+ }
+ return(sc->UNDEFINED);
}
-static s7_pointer s7_from_c_complex(s7_scheme *sc, s7_Complex z)
+static s7_pointer s7_local_slot(s7_scheme *sc, s7_pointer symbol)
{
- return(s7_make_complex(sc, creal(z), cimag(z)));
+ s7_pointer y;
+ for (y = let_slots(sc->envir); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(y);
+ return(NULL);
}
-#endif
-static int integer_length(s7_Int a)
+s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym)
{
- static int bits[256] =
- {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
- 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8};
+ s7_pointer x;
- #define I_8 256LL
- #define I_16 65536LL
- #define I_24 16777216LL
- #define I_32 4294967296LL
- #define I_40 1099511627776LL
- #define I_48 281474976710656LL
- #define I_56 72057594037927936LL
+ x = find_symbol(sc, sym);
+ if (is_slot(x))
+ return(slot_value(x));
- if (a < 0) a = -a;
- if (a < I_8) return(bits[a]);
- if (a < I_16) return(8 + bits[a >> 8]);
- if (a < I_24) return(16 + bits[a >> 16]);
- if (a < I_32) return(24 + bits[a >> 24]);
- if (a < I_40) return(32 + bits[a >> 32]);
- if (a < I_48) return(40 + bits[a >> 40]);
- if (a < I_56) return(48 + bits[a >> 48]);
- return(56 + bits[a >> 56]);
+ return(sc->UNDEFINED);
}
-static int s7_int_max = 0, s7_int_min = 0, s7_int_bits = 0, s7_int_digits = 0; /* initialized later */
-static int s7_int_digits_by_radix[17];
-
-static s7_pointer s7_negate(s7_scheme *sc, s7_pointer p) /* can't use "negate" because it confuses C++! */
+s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer local_env)
{
- s7_num_t a;
- a = number(p);
-
- switch (a.type)
+ if (is_let(local_env))
{
- case NUM_INT:
-#if WITH_GMP
- if (integer(a) == S7_LLONG_MIN)
- return(big_negate(sc, make_list_1(sc, promote_number(sc, T_BIG_INTEGER, p))));
-#endif
- return(s7_make_integer(sc, -integer(a)));
-
- case NUM_RATIO:
- return(s7_make_ratio(sc, -numerator(a), denominator(a)));
-
- case NUM_REAL2:
- case NUM_REAL:
- return(s7_make_real(sc, -real(a)));
-
- default:
- return(s7_make_complex(sc, -real_part(a), -imag_part(a)));
+ s7_pointer x;
+ for (x = local_env; is_let(x); x = outlet(x))
+ {
+ s7_pointer y;
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == sym)
+ return(slot_value(y));
+ }
}
+ return(s7_symbol_value(sc, sym));
}
-static s7_pointer s7_invert(s7_scheme *sc, s7_pointer p) /* s7_ to be consistent... */
+/* -------------------------------- symbol->value -------------------------------- */
+
+#define find_global_symbol_checked(Sc, Sym) ((is_global(Sym)) ? slot_value(global_slot(Sym)) : find_symbol_checked(Sc, Sym))
+
+static s7_pointer g_symbol_to_value(s7_scheme *sc, s7_pointer args)
{
- s7_num_t a;
- a = number(p);
+ #define H_symbol_to_value "(symbol->value sym (env (curlet))) returns the binding of (the value associated with) the \
+symbol sym in the given environment: (let ((x 32)) (symbol->value 'x)) -> 32"
+ #define Q_symbol_to_value s7_make_signature(sc, 3, sc->T, sc->IS_SYMBOL, sc->IS_LET)
+
+ s7_pointer sym;
+ sym = car(args);
+
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->SYMBOL_TO_VALUE, args, T_SYMBOL, 1);
- switch (a.type)
+ if (is_not_null(cdr(args)))
{
- case NUM_INT:
-#if WITH_GMP
- if (integer(a) == S7_LLONG_MIN)
- return(big_invert(sc, make_list_1(sc, promote_number(sc, T_BIG_INTEGER, p))));
-#endif
- return(s7_make_ratio(sc, 1, integer(a))); /* a already checked, not 0 */
-
- case NUM_RATIO:
- return(s7_make_ratio(sc, denominator(a), numerator(a)));
+ s7_pointer local_env;
- case NUM_REAL:
- case NUM_REAL2:
- return(s7_make_real(sc, 1.0 / real(a)));
+ local_env = cadr(args);
+ if (local_env == sc->UNLET)
+ return((is_slot(initial_slot(sym))) ? slot_value(initial_slot(sym)) : sc->UNDEFINED);
- default:
- {
- s7_Double r2, i2, den;
- r2 = num_to_real_part(a);
- i2 = num_to_imag_part(a);
- den = (r2 * r2 + i2 * i2);
- return(s7_make_complex(sc, r2 / den, -i2 / den));
- }
+ if (!is_let(local_env))
+ method_or_bust_with_type(sc, local_env, sc->SYMBOL_TO_VALUE, args, A_LET, 2);
+
+ if (local_env == sc->rootlet)
+ {
+ s7_pointer x;
+ x = global_slot(sym);
+ if (is_slot(x))
+ return(slot_value(x));
+ return(sc->UNDEFINED);
+ }
+ return(s7_symbol_local_value(sc, sym, local_env));
}
+
+ if (is_global(sym))
+ return(slot_value(global_slot(sym)));
+
+ return(s7_symbol_value(sc, sym));
}
-#if (!WITH_GMP)
-static bool s7_is_negative(s7_pointer obj)
+s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val)
{
- switch (number_type(obj))
- {
- case NUM_INT: return(s7_integer(obj) < 0);
- case NUM_RATIO: return(s7_numerator(obj) < 0);
- default: return(s7_real(obj) < 0);
- }
+ s7_pointer x;
+ /* if immutable should this return an error? */
+ x = find_symbol(sc, sym);
+ if (is_slot(x))
+ slot_set_value(x, val);
+ return(val);
}
-static bool s7_is_positive(s7_pointer x)
+/* -------------------------------- symbol->dynamic-value -------------------------------- */
+
+static s7_pointer find_dynamic_value(s7_scheme *sc, s7_pointer x, s7_pointer sym, long long int *id)
{
- switch (number_type(x))
+ for (; symbol_id(sym) < let_id(x); x = outlet(x));
+
+ if (let_id(x) == symbol_id(sym))
{
- case NUM_INT: return(s7_integer(x) > 0);
- case NUM_RATIO: return(s7_numerator(x) > 0);
- default: return(s7_real(x) > 0.0);
+ (*id) = let_id(x);
+ return(slot_value(local_slot(sym)));
}
+ for (; (is_let(x)) && (let_id(x) > (*id)); x = outlet(x))
+ {
+ s7_pointer y;
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == sym)
+ {
+ (*id) = let_id(x);
+ return(slot_value(y));
+ }
+ }
+ return(sc->GC_NIL);
}
-#endif
-static bool s7_is_zero(s7_pointer x)
+static s7_pointer g_symbol_to_dynamic_value(s7_scheme *sc, s7_pointer args)
{
- switch (number_type(x))
+ #define H_symbol_to_dynamic_value "(symbol->dynamic-value sym) returns the dynamic binding of the symbol sym"
+ #define Q_symbol_to_dynamic_value s7_make_signature(sc, 2, sc->T, sc->IS_SYMBOL)
+
+ s7_pointer sym, val;
+ long long int top_id;
+ int i;
+
+ sym = car(args);
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->SYMBOL_TO_DYNAMIC_VALUE, args, T_SYMBOL, 1);
+
+ if (is_global(sym))
+ return(slot_value(global_slot(sym)));
+
+ if (let_id(sc->envir) == symbol_id(sym))
+ return(slot_value(local_slot(sym)));
+
+ top_id = -1;
+ val = find_dynamic_value(sc, sc->envir, sym, &top_id);
+ if (top_id == symbol_id(sym))
+ return(val);
+
+ for (i = s7_stack_top(sc) - 1; i > 0; i -= 4)
{
- case NUM_INT: return(s7_integer(x) == 0);
- case NUM_REAL2:
- case NUM_REAL: return(s7_real(x) == 0.0);
- default: return(false); /* ratios and complex numbers here are already collapsed into integers and reals */
+ s7_pointer cur_val;
+ cur_val = find_dynamic_value(sc, stack_let(sc->stack, i), sym, &top_id);
+ if (cur_val != sc->GC_NIL)
+ val = cur_val;
+ if (top_id == symbol_id(sym))
+ return(val);
}
+
+ if (val == sc->GC_NIL)
+ return(s7_symbol_value(sc, sym));
+ return(val);
}
-static bool s7_is_one(s7_pointer x)
- {
- switch (number_type(x))
+typedef bool (safe_sym_t)(s7_scheme *sc, s7_pointer sym, s7_pointer e);
+static s7_function all_x_eval(s7_scheme *sc, s7_pointer arg, s7_pointer e, safe_sym_t *checker);
+
+static bool direct_memq(s7_pointer symbol, s7_pointer symbols)
+{
+ s7_pointer x;
+ for (x = symbols; is_pair(x); x = unchecked_cdr(x))
{
- case NUM_INT: return(s7_integer(x) == 1);
- case NUM_REAL2:
- case NUM_REAL: return(s7_real(x) == 1.0);
- default: return(false);
+ if (car(x) == symbol)
+ return(true);
+ x = cdr(x);
+ if (unchecked_car(x) == symbol)
+ return(true);
}
+ return(false);
}
+static bool indirect_memq(s7_pointer symbol, s7_pointer symbols)
+{ /* used only below in do_symbol_is_safe */
+ s7_pointer x;
+ for (x = symbols; is_pair(x); x = cdr(x))
+ if (caar(x) == symbol)
+ return(true);
+ return(false);
+}
-/* optimize exponents */
-#define MAX_POW 32
-static double pepow[17][MAX_POW], mepow[17][MAX_POW];
+static bool do_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
+{
+ return((is_slot(global_slot(sym))) ||
+ (indirect_memq(sym, e)) ||
+ (is_slot(find_symbol(sc, sym))));
+}
-static void initialize_pows(void)
+static bool let_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
{
- int i, j;
- for (i = 2; i < 17; i++) /* radix between 2 and 16 */
- for (j = 0; j < MAX_POW; j++) /* saved exponent between 0 and +/- MAX_POW */
- {
- pepow[i][j] = pow((double)i, (double)j);
- mepow[i][j] = pow((double)i, (double)(-j));
- }
+ return((is_slot(global_slot(sym))) || ((!is_with_let_let(e)) && (is_slot(find_symbol(sc, sym)))));
}
-static double ipow(int x, int y)
+static bool pair_symbol_is_safe(s7_scheme *sc, s7_pointer sym, s7_pointer e)
{
- if ((y < MAX_POW) && (y > (-MAX_POW)))
- {
- if (y >= 0)
- return(pepow[x][y]);
- return(mepow[x][-y]);
- }
- return(pow((double)x, (double)y));
+ return((is_slot(global_slot(sym))) || (direct_memq(sym, e)));
}
-static void s7_Int_to_string(char *p, s7_Int n, int radix, int width)
+
+/* make macros and closures */
+
+static s7_pointer make_macro(s7_scheme *sc)
{
- static char dignum[] = "0123456789abcdef";
- int i = 2, len, start = 0, end = 0;
- s7_Int pown = (s7_Int)1;
- bool sign;
+ s7_pointer cx, mac;
+ unsigned int typ;
- if ((radix < 2) || (radix > 16))
- return;
- if (n == 0)
+ if (sc->op == OP_DEFINE_MACRO)
+ typ = T_MACRO | T_DONT_EVAL_ARGS | T_COPY_ARGS;
+ else
{
- if (width <= 1)
- {
- p[0] = '0';
- p[1] = '\0';
- }
+ if (sc->op == OP_DEFINE_MACRO_STAR)
+ typ = T_MACRO_STAR | T_DONT_EVAL_ARGS | T_COPY_ARGS;
else
{
- for (i = 0; i < width - 1; i++)
- p[i] = ' ';
- p[width - 1] = '0';
- p[width] = '\0';
+ if (sc->op == OP_DEFINE_BACRO)
+ typ = T_BACRO | T_DONT_EVAL_ARGS | T_COPY_ARGS;
+ else
+ {
+ if (sc->op == OP_DEFINE_BACRO_STAR)
+ typ = T_BACRO_STAR | T_DONT_EVAL_ARGS | T_COPY_ARGS;
+ else
+ {
+ if (sc->op == OP_DEFINE_EXPANSION)
+ typ = T_MACRO | T_EXPANSION | T_DONT_EVAL_ARGS | T_COPY_ARGS;
+ else typ = T_MACRO | T_DONT_EVAL_ARGS | T_COPY_ARGS;
+ }
+ }
}
- return;
}
- if (n == S7_LLONG_MIN)
+ new_cell_no_check(sc, mac, typ);
+ sc->temp6 = mac;
+ closure_args(mac) = cdar(sc->code);
+ closure_body(mac) = cdr(sc->code);
+ closure_setter(mac) = sc->F;
+ closure_set_let(mac, sc->envir);
+ closure_arity(mac) = CLOSURE_ARITY_NOT_SET;
+
+ sc->capture_let_counter++;
+ sc->code = caar(sc->code);
+ if (sc->op == OP_DEFINE_EXPANSION)
+ set_type(sc->code, T_EXPANSION | T_SYMBOL); /* see comment under READ_TOK */
+
+ /* symbol? macro name has already been checked, find name in environment, and define it */
+ cx = find_local_symbol(sc, sc->code, sc->envir);
+ if (is_slot(cx))
+ slot_set_value(cx, mac);
+ else s7_make_slot(sc, sc->envir, sc->code, mac); /* was current but we've checked immutable already */
+
+ optimize(sc, closure_body(mac), 0, sc->NIL);
+ sc->temp6 = sc->NIL;
+ return(mac);
+}
+
+
+static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code, int type)
+{
+ /* this is called every time a lambda form is evaluated, or during letrec, etc */
+
+ s7_pointer x;
+ unsigned int typ;
+
+ if (is_safe_closure(code))
{
- /* a special case -- we can't use abs on this because it goes to 0, we won't get here if gmp.
- * (number->string most-negative-fixnum 2) -> "-0" unless we do something special
- */
- int j;
- p[0] = '-';
- /* build it backwards (will reverse digits below) */
- p[1] = dignum[-(n % (s7_Int)radix)];
- n /= (s7_Int)radix;
- n = -n;
- for (i = 2; n >= (s7_Int)radix; i++)
- {
- p[i] = dignum[n % (s7_Int)radix];
- n /= (s7_Int)radix;
- }
- p[i] = dignum[n];
- len = i;
- /* reverse digits (leave sign alone) */
- for (i = 1, j = len; i < j; i++, j--)
- {
- char tmp;
- tmp = p[i];
- p[i] = p[j];
- p[j] = tmp;
- }
- p[len + 1] = 0;
- return;
- /* there has to be a better way... */
+ if (type == T_CLOSURE)
+ typ = T_CLOSURE | T_PROCEDURE | T_SAFE_CLOSURE | T_COPY_ARGS;
+ else typ = T_CLOSURE_STAR | T_PROCEDURE | T_SAFE_CLOSURE;
+ }
+ else
+ {
+ if (type == T_CLOSURE)
+ typ = T_CLOSURE | T_PROCEDURE | T_COPY_ARGS;
+ else typ = T_CLOSURE_STAR | T_PROCEDURE;
}
-
- sign = (n < 0);
- n = s7_Int_abs(n);
- /* the previous version that counted up to n, rather than dividing down below n, as here,
- * could be confused by large ints on 64 bit machines
+ new_cell(sc, x, typ);
+ closure_args(x) = args;
+ closure_body(x) = code;
+ closure_setter(x) = sc->F;
+ if (is_null(args))
+ closure_arity(x) = 0;
+ else closure_arity(x) = CLOSURE_ARITY_NOT_SET;
+ closure_set_let(x, sc->envir);
+ sc->capture_let_counter++;
+ return(x);
+}
+
+
+#define make_closure_with_let(Sc, X, Args, Code, Env) \
+ do { \
+ unsigned int _T_; \
+ if (is_safe_closure(Code)) \
+ _T_ = T_CLOSURE | T_PROCEDURE | T_SAFE_CLOSURE | T_COPY_ARGS; \
+ else _T_ = T_CLOSURE | T_PROCEDURE | T_COPY_ARGS; \
+ new_cell(Sc, X, _T_); \
+ closure_args(X) = Args; \
+ closure_body(X) = Code; \
+ closure_setter(X) = sc->F; \
+ if (is_null(Args)) closure_arity(X) = 0; else closure_arity(X) = CLOSURE_ARITY_NOT_SET; \
+ closure_set_let(X, Env); \
+ sc->capture_let_counter++; \
+ } while (0)
+
+
+#define make_closure_without_capture(Sc, X, Args, Code, Env) \
+ do { \
+ unsigned int _T_; \
+ if (is_safe_closure(Code)) \
+ _T_ = T_CLOSURE | T_PROCEDURE | T_SAFE_CLOSURE | T_COPY_ARGS; \
+ else _T_ = T_CLOSURE | T_PROCEDURE | T_COPY_ARGS; \
+ new_cell(Sc, X, _T_); \
+ closure_args(X) = Args; \
+ closure_body(X) = Code; \
+ closure_setter(X) = sc->F; \
+ if (is_null(Args)) closure_arity(X) = 0; else closure_arity(X) = CLOSURE_ARITY_NOT_SET; \
+ closure_set_let(X, Env); \
+ } while (0)
+
+
+static int closure_length(s7_scheme *sc, s7_pointer e)
+{
+ /* we can't use let_length(sc, closure_let(e)) because the closure_let(closure)
+ * changes. So the open bit is not always on. Besides, the fallbacks need to be for closures, not environments.
*/
- pown = n;
- for (i = 1; i < 100; i++)
- {
- if (pown < radix)
- break;
- pown /= (s7_Int)radix;
+ s7_pointer length_func;
+ length_func = find_method(sc, closure_let(e), sc->LENGTH);
+ if (length_func != sc->UNDEFINED)
+ return((int)s7_integer(s7_apply_function(sc, length_func, list_1(sc, e))));
+
+ /* there are cases where this should raise a wrong-type-arg error, but for now... */
+ return(-1);
+}
+
+#define check_closure_for(Sc, Fnc, Sym) \
+ if ((has_closure_let(Fnc)) && (is_let(closure_let(Fnc)))) \
+ { \
+ s7_pointer val; \
+ val = find_local_symbol(Sc, Sym, closure_let(Fnc)); \
+ if ((!is_slot(val)) && (is_let(outlet(closure_let(Fnc))))) \
+ val = find_local_symbol(Sc, Sym, outlet(closure_let(Fnc))); \
+ if (is_slot(val)) \
+ return(slot_value(val)); \
}
- len = i - 1;
- if (sign) len++;
- if (width > len) /* (format #f "~10B" 123) */
+static s7_pointer copy_tree(s7_scheme *sc, s7_pointer tree)
+{
+#if WITH_GCC
+ #define COPY_TREE(P) ({s7_pointer _p; _p = P; cons_unchecked(sc, (is_pair(car(_p))) ? copy_tree(sc, car(_p)) : car(_p), (is_pair(cdr(_p))) ? copy_tree(sc, cdr(_p)) : cdr(_p));})
+#else
+ #define COPY_TREE(P) copy_tree(sc, P)
+#endif
+
+ return(cons_unchecked(sc,
+ (is_pair(car(tree))) ? COPY_TREE(car(tree)) : car(tree),
+ (is_pair(cdr(tree))) ? COPY_TREE(cdr(tree)) : cdr(tree)));
+}
+
+static void annotate_expansion(s7_pointer p)
+{
+ if ((is_symbol(car(p))) &&
+ (is_pair(cdr(p))))
{
- start = width - len - 1;
- end += start;
- memset((void *)p, (int)' ', start);
- /*
- for (i = 0; i < start; i++)
- p[i] = ' ';
- */
+ set_opt_back(p);
+ set_overlay(cdr(p));
}
-
- if (sign)
+ else
{
- p[start] = '-';
- end++;
+ if (is_pair(car(p)))
+ annotate_expansion(car(p));
}
+ for (p = cdr(p); is_pair(p); p = cdr(p))
+ if (is_pair(car(p)))
+ annotate_expansion(car(p));
+}
- for (i = start + len; i >= end; i--)
+static s7_pointer copy_body(s7_scheme *sc, s7_pointer p)
+{
+ if (8192 >= (sc->free_heap_top - sc->free_heap))
{
- p[i] = dignum[n % (s7_Int)radix];
- n /= (s7_Int)radix;
+ gc(sc);
+ while (8192 >= (sc->free_heap_top - sc->free_heap))
+ resize_heap(sc);
}
- p[len + start + 1] = '\0';
+ sc->w = copy_tree(sc, p);
+ annotate_expansion(sc->w);
+ p = sc->w;
+ sc->w = sc->NIL;
+ return(p);
}
-
-static char *pad_number(const char *p, int len, int width)
+static s7_pointer copy_closure(s7_scheme *sc, s7_pointer fnc)
{
- char *p1;
- int spaces;
- spaces = width - len;
- p1 = (char *)malloc((width + 1) * sizeof(char));
- p1[width] = '\0';
- memset((void *)p1, (int)' ', spaces);
- memcpy((void *)(p1 + spaces), (void *)p, len);
- return(p1);
-}
+ /* copy the source tree annotating (for eventual optimization), return a thing of the same type as fnc */
+ s7_pointer x, body;
+ body = closure_body(fnc);
+ if (is_pair(body))
+ body = copy_body(sc, body);
-#define BASE_10 10
+ new_cell(sc, x, typeflag(fnc));
+ closure_args(x) = closure_args(fnc);
+ closure_body(x) = body;
+ closure_setter(x) = closure_setter(fnc);
+ closure_arity(x) = closure_arity(fnc);
+ closure_set_let(x, closure_let(fnc));
+ return(x);
+}
-static char *number_to_string_base_10(s7_pointer obj, int width, int precision, char float_choice)
+/* -------------------------------- defined? -------------------------------- */
+static s7_pointer g_is_defined(s7_scheme *sc, s7_pointer args)
{
- char *p;
- int len;
+ #define H_is_defined "(defined? obj (env (curlet)) ignore-globals) returns #t if obj has a binding (a value) in the environment env"
+ #define Q_is_defined s7_make_signature(sc, 4, sc->IS_BOOLEAN, sc->IS_SYMBOL, sc->IS_LET, sc->IS_BOOLEAN)
-#if WITH_GMP
- if (is_c_object(obj))
- return(big_number_to_string_with_radix(obj, BASE_10, width));
- /* this ignores precision because it's way too hard to get the mpfr string to look like
- * C's output -- we either have to call mpfr_get_str twice (the first time just to
- * find out what the exponent is and how long the string actually is), or we have
- * to do messy string manipulations. So (format #f "",3F" pi) ignores the "3" and
- * prints the full string.
+ s7_pointer sym;
+
+ /* is this correct?
+ * (defined? '_x) #f (symbol->value '_x) #<undefined>
+ * (define x #<undefined>) (defined? 'x) #t
*/
-#endif
- switch (number_type(obj))
+ sym = car(args);
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->IS_DEFINED, args, T_SYMBOL, 1);
+
+ if (is_pair(cdr(args)))
{
- case NUM_INT:
- len = 64 + width;
- p = (char *)malloc(len * sizeof(char));
- snprintf(p, len,
- (sizeof(int) >= sizeof(s7_Int)) ? "%*d" : "%*lld",
- width, s7_integer(obj));
- break;
-
- case NUM_RATIO:
- p = (char *)malloc(128 * sizeof(char));
- len = snprintf(p, 128,
- (sizeof(int) >= sizeof(s7_Int)) ? "%d/%d" : "%lld/%lld",
- s7_numerator(obj), s7_denominator(obj));
- if (width > len)
+ s7_pointer e, b, x;
+ e = cadr(args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->IS_DEFINED, 2, e, A_LET));
+
+ if (is_pair(cddr(args)))
{
- char *p1;
- p1 = pad_number(p, len, width);
- free(p);
- return(p1);
+ b = caddr(args);
+ if (!s7_is_boolean(b))
+ method_or_bust_with_type(sc, b, sc->IS_DEFINED, args, A_BOOLEAN, 3);
}
- break;
-
- case NUM_REAL2:
- case NUM_REAL:
- {
- int i, loc = -1;
- const char *frmt;
- p = (char *)malloc((256 + width) * sizeof(char));
+ else b = sc->F;
- if (sizeof(double) >= sizeof(s7_Double))
- frmt = (float_choice == 'g') ? "%*.*g" : ((float_choice == 'f') ? "%*.*f" : "%*.*e");
- else frmt = (float_choice == 'g') ? "%*.*Lg" : ((float_choice == 'f') ? "%*.*Lf" : "%*.*Le");
+ if (e == sc->rootlet)
+ return(make_boolean(sc, is_slot(global_slot(sym)))); /* new_symbol and gensym initialize global_slot to #<undefined> */
- len = snprintf(p, 256 + width, frmt, width, precision, s7_real(obj));
- for (i = 0; i < len; i++) /* does it have an exponent (if so, it's already a float) */
- if (p[i] == 'e')
- {
- loc = i;
- break;
- }
- if (loc == -1) /* no, so make it explicitly a float! */
- {
- for (i = 0; i < len; i++)
- if (p[i] == '.') break;
- if (i == len)
- {
- p[i]='.';
- p[i+1]='0';
- p[i+2]='\0';
- }
- }
- }
- break;
-
- default:
- {
- const char *frmt;
- p = (char *)malloc(256 * sizeof(char));
+ x = find_local_symbol(sc, sym, e);
+ if (is_slot(x))
+ return(sc->T);
- if (sizeof(double) >= sizeof(s7_Double))
- {
- if (complex_imag_part(obj) >= 0.0)
- frmt = (float_choice == 'g') ? "%.*g+%.*gi" : ((float_choice == 'f') ? "%.*f+%.*fi" : "%.*e+%.*ei");
- else frmt = (float_choice == 'g') ? "%.*g%.*gi" : ((float_choice == 'f') ? "%.*f-%.*fi" :"%.*e-%.*ei");
- }
- else
- {
- if (complex_imag_part(obj) >= 0.0)
- frmt = (float_choice == 'g') ? "%.*Lg+%.*Lgi" : ((float_choice == 'f') ? "%.*Lf+%.*Lfi" : "%.*Le+%.*Lei");
- else frmt = (float_choice == 'g') ? "%.*Lg%.*Lgi" : ((float_choice == 'f') ? "%.*Lf-%.*Lfi" : "%.*Le-%.*Lei");
- }
+ if (b == sc->T)
+ return(sc->F);
- len = snprintf(p, 256, frmt, precision, complex_real_part(obj), precision, complex_imag_part(obj));
- if (width > len)
- { /* (format #f "~20g" 1+i) */
- char *p1;
- p1 = pad_number(p, len, width);
- free(p);
- return(p1);
- }
- }
- break;
+ /* here we can't fall back on find_symbol:
+ * (let ((b 2))
+ * (let ((e (curlet)))
+ * (let ((a 1))
+ * (if (defined? 'a e)
+ * (format #t "a: ~A in ~{~A ~}" (symbol->value 'a e) e))))
+ * "a: 1 in (b . 2)"
+ *
+ * but we also can't just return #f:
+ * (let ((b 2))
+ * (let ((e (curlet)))
+ * (let ((a 1))
+ * (format #t "~A: ~A" (defined? 'abs e) (eval '(abs -1) e)))))
+ * "#f: 1"
+ */
+ return(make_boolean(sc, is_slot(global_slot(sym))));
}
- return(p);
+ else
+ {
+ if (is_global(sym))
+ return(sc->T);
+ }
+ return(make_boolean(sc, is_slot(find_symbol(sc, sym))));
}
-static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, int radix, int width, int precision, char float_choice)
+bool s7_is_defined(s7_scheme *sc, const char *name)
{
- char *p, *n, *d;
- int len;
-
-#if WITH_GMP
- if (is_c_object(obj))
- return(big_number_to_string_with_radix(obj, radix, width));
-#endif
+ s7_pointer x;
+ x = s7_symbol_table_find_name(sc, name);
+ if (x)
+ {
+ x = find_symbol(sc, x);
+ return(is_slot(x));
+ }
+ return(false);
+}
- if (radix == 10)
- return(number_to_string_base_10(obj, width, precision, float_choice));
- switch (number_type(obj))
+void s7_define(s7_scheme *sc, s7_pointer envir, s7_pointer symbol, s7_pointer value)
+{
+ s7_pointer x;
+ if ((envir == sc->NIL) ||
+ (envir == sc->rootlet))
+ envir = sc->shadow_rootlet;
+ x = find_local_symbol(sc, symbol, envir);
+ if (is_slot(x))
+ slot_set_value(x, value);
+ else
{
- case NUM_INT:
- p = (char *)malloc((128 + width) * sizeof(char));
- s7_Int_to_string(p, s7_integer(obj), radix, width);
- return(p);
- break;
-
- case NUM_RATIO:
- {
- char n[128], d[128];
- s7_Int_to_string(n, s7_numerator(obj), radix, 0);
- s7_Int_to_string(d, s7_denominator(obj), radix, 0);
- p = (char *)malloc(256 * sizeof(char));
- len = snprintf(p, 256, "%s/%s", n, d);
- }
- break;
-
- case NUM_REAL2:
- case NUM_REAL:
- {
- int i;
- s7_Int int_part;
- s7_Double x, frac_part, min_frac, base;
- bool sign = false;
- char n[128], d[256];
+ s7_make_slot(sc, envir, symbol, value); /* I think this means C code can override "constant" defs */
+ if ((envir == sc->shadow_rootlet) &&
+ (!is_slot(global_slot(symbol))))
+ {
+ set_global(symbol); /* is_global => global_slot is usable */
+ global_slot(symbol) = local_slot(symbol);
+ }
+ }
+}
- x = s7_real(obj);
- if (isnan(x))
- return(copy_string("nan.0"));
- if (isinf(x))
- {
- if (x < 0.0)
- return(copy_string("-inf.0"));
- return(copy_string("inf.0"));
- }
+s7_pointer s7_define_variable(s7_scheme *sc, const char *name, s7_pointer value)
+{
+ s7_pointer sym;
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->NIL, sym, value);
+ return(sym);
+}
- if (x < 0.0)
- {
- sign = true;
- x = -x;
- }
- int_part = (s7_Int)floor(x);
- frac_part = x - int_part;
- s7_Int_to_string(n, int_part, radix, 0);
- min_frac = (s7_Double)ipow(radix, -precision);
+s7_pointer s7_define_variable_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help)
+{
+ s7_pointer sym;
+ sym = s7_define_variable(sc, name, value);
+ symbol_set_has_help(sym);
+ symbol_help(sym) = copy_string(help);
+ return(sym);
+}
- for (i = 0, base = radix; (i < precision) && (frac_part > min_frac); i++, base *= radix)
- {
- s7_Int ipart;
- ipart = (int)(frac_part * base);
- if (ipart >= radix) /* rounding confusion */
- ipart = radix - 1;
- frac_part -= (ipart / base);
- if (ipart < 10)
- d[i] = (char)('0' + ipart);
- else d[i] = (char)('a' + ipart - 10);
- }
- if (i == 0)
- d[i++] = '0';
- d[i] = '\0';
- p = (char *)malloc(256 * sizeof(char));
- len = snprintf(p, 256, "%s%s.%s", (sign) ? "-" : "", n, d);
- }
- break;
- default:
- p = (char *)malloc(512 * sizeof(char));
- n = number_to_string_with_radix(sc, s7_make_real(sc, complex_real_part(obj)), radix, 0, precision, float_choice);
- d = number_to_string_with_radix(sc, s7_make_real(sc, complex_imag_part(obj)), radix, 0, precision, float_choice);
- len = snprintf(p, 512, "%s%s%si", n, (complex_imag_part(obj) < 0.0) ? "" : "+", d);
- free(n);
- free(d);
- break;
- }
+s7_pointer s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value)
+{
+ s7_pointer sym;
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->NIL, sym, value);
+ set_immutable(sym);
+ return(sym);
+}
- if (width > len)
- {
- char *p1;
- p1 = pad_number(p, len, width);
- free(p);
- return(p1);
- }
- return(p);
+/* (define (func a) (let ((cvar (+ a 1))) cvar)) (define-constant cvar 23) (func 1) -> ;can't bind an immutable object: cvar
+ * (let ((aaa 1)) (define-constant aaa 32) (set! aaa 3)) -> set!: can't alter immutable object: aaa
+ */
+
+s7_pointer s7_define_constant_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help)
+{
+ s7_pointer sym;
+ sym = s7_define_constant(sc, name, value);
+ symbol_set_has_help(sym);
+ symbol_help(sym) = copy_string(help);
+ return(value);
}
-char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, int radix)
+char *s7_symbol_documentation(s7_scheme *sc, s7_pointer sym)
{
- return(number_to_string_with_radix(sc, obj, radix, 0, 20, 'g'));
- /* (log top 10) so we get all the digits in base 10 (??) */
+ if (is_keyword(sym)) return(NULL);
+ if ((is_symbol(sym)) &&
+ (symbol_has_help(sym)))
+ return(symbol_help(sym));
+ return(NULL);
}
-static s7_pointer g_number_to_string(s7_scheme *sc, s7_pointer args)
+char *s7_symbol_set_documentation(s7_scheme *sc, s7_pointer sym, const char *new_doc)
{
- #define H_number_to_string "(number->string num (radix 10)) converts the number num into a string."
- s7_Int radix = 10;
- int size = 20;
- char *res;
- s7_pointer x;
+ if (is_keyword(sym)) return(NULL);
+ if ((is_symbol(sym)) &&
+ (symbol_has_help(sym)) &&
+ (symbol_help(sym)))
+ free(symbol_help(sym));
+ symbol_set_has_help(sym);
+ symbol_help(sym) = copy_string(new_doc);
+ return(symbol_help(sym));
+}
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "number->string", (cdr(args) == sc->NIL) ? 0 : 1, x, "a number"));
- if (is_pair(cdr(args)))
- {
- s7_pointer y;
- y = cadr(args);
- if (s7_is_integer(y))
- radix = s7_integer(y);
- else return(s7_wrong_type_arg_error(sc, "number->string radix,", 2, y, "an integer"));
- if ((radix < 2) || (radix > 16))
- return(s7_out_of_range_error(sc, "number->string radix,", 2, y, "should be between 2 and 16"));
- }
+/* -------------------------------- keyword? -------------------------------- */
-#if WITH_GMP
- if (s7_is_bignum(x))
- return(make_string_uncopied(sc, big_number_to_string_with_radix(x, radix, 0)));
-#endif
+bool s7_is_keyword(s7_pointer obj)
+{
+ return(is_keyword(obj));
+}
- if (number_type(x) > NUM_RATIO)
- {
- /* if size = 20, (number->string .1) gives "0.10000000000000000555", but if it's less than 20,
- * large numbers (or very small numbers) mess up the less significant digits.
- */
- if (number_type(x) < NUM_COMPLEX)
- {
- s7_Double val;
- val = s7_Double_abs(s7_real(x));
- if ((val < (S7_LONG_MAX / 4)) && (val > 1.0e-6))
- size = 14;
- }
- else
- {
- s7_Double rl, im;
- rl = s7_Double_abs(s7_real_part(x));
- if ((rl < (S7_LONG_MAX / 4)) && (rl > 1.0e-6))
- {
- im = s7_Double_abs(s7_imag_part(x));
- if ((im < (S7_LONG_MAX / 4)) && (im > 1.0e-6))
- size = 14;
- }
- }
- }
- if (radix != 10)
- res = number_to_string_with_radix(sc, x, radix, 0, (radix == 10) ? size : 20, 'g');
- else res = number_to_string_base_10(x, 0, size, 'g');
-
- return(make_string_uncopied(sc, res));
+static s7_pointer g_is_keyword(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_keyword "(keyword? obj) returns #t if obj is a keyword, (keyword? :key) -> #t"
+ #define Q_is_keyword pl_bt
+ check_boolean_method(sc, is_keyword, sc->IS_KEYWORD, args);
}
-#define CTABLE_SIZE 256
-static bool *exponent_table, *slashify_table, *char_ok_in_a_name, *white_space;
-static int *digits;
+/* -------------------------------- make-keyword -------------------------------- */
+s7_pointer s7_make_keyword(s7_scheme *sc, const char *key)
+{
+ s7_pointer sym;
+ char *name;
+ unsigned int slen;
+ slen = safe_strlen(key);
+ tmpbuf_malloc(name, slen + 2);
+ name[0] = ':'; /* prepend ":" */
+ name[1] = '\0';
+ memcpy((void *)(name + 1), (void *)key, slen);
+ sym = make_symbol_with_length(sc, name, slen + 1); /* keyword slot etc taken care of here (in new_symbol actually) */
+ tmpbuf_free(name, slen + 2);
+ return(sym);
+}
-static void init_ctables(void)
+
+static s7_pointer g_make_keyword(s7_scheme *sc, s7_pointer args)
{
- int i;
+ #define H_make_keyword "(make-keyword str) prepends ':' to str and defines that as a keyword"
+ #define Q_make_keyword s7_make_signature(sc, 2, sc->IS_KEYWORD, sc->IS_STRING)
- exponent_table = (bool *)permanent_calloc(CTABLE_SIZE * sizeof(bool));
- slashify_table = (bool *)permanent_calloc(CTABLE_SIZE * sizeof(bool));
- char_ok_in_a_name = (bool *)permanent_calloc(CTABLE_SIZE * sizeof(bool));
- white_space = (bool *)permanent_calloc(CTABLE_SIZE * sizeof(bool));
-
- for (i = 1; i < CTABLE_SIZE; i++)
- char_ok_in_a_name[i] = true;
- char_ok_in_a_name[0] = false;
- char_ok_in_a_name['('] = false;
- char_ok_in_a_name[')'] = false;
- char_ok_in_a_name[';'] = false;
- char_ok_in_a_name['\t'] = false;
- char_ok_in_a_name['\n'] = false;
- char_ok_in_a_name['\r'] = false;
- char_ok_in_a_name[' '] = false;
- char_ok_in_a_name['"'] = false;
- /* double-quote is recent, but I want '(1 ."hi") to be parsed as '(1 . "hi")
- * what about stuff like vertical tab? or comma?
- */
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->MAKE_KEYWORD, args, T_STRING, 0);
+ return(s7_make_keyword(sc, string_value(car(args))));
+}
- for (i = 0; i < CTABLE_SIZE; i++)
- white_space[i] = false;
- white_space['\t'] = true;
- white_space['\n'] = true;
- white_space['\r'] = true;
- white_space['\f'] = true;
- white_space['\v'] = true;
- white_space[' '] = true;
+static s7_pointer c_make_keyword(s7_scheme *sc, s7_pointer x)
+{
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->MAKE_KEYWORD, list_1(sc, x), T_STRING, 0);
+ return(s7_make_keyword(sc, string_value(x)));
+}
- /* surely only 'e' is needed... */
- exponent_table['e'] = true; exponent_table['E'] = true;
-#if WITH_EXTRA_EXPONENT_MARKERS
- exponent_table['s'] = true; exponent_table['S'] = true;
- exponent_table['f'] = true; exponent_table['F'] = true;
- exponent_table['d'] = true; exponent_table['D'] = true;
- exponent_table['l'] = true; exponent_table['L'] = true;
-#endif
- for (i = 0; i < 32; i++)
- slashify_table[i] = true;
- for (i = 127; i < 160; i++)
- slashify_table[i] = true;
- slashify_table['\\'] = true;
- slashify_table['"'] = true;
- slashify_table['\n'] = false;
+/* -------------------------------- keyword->symbol -------------------------------- */
+static s7_pointer g_keyword_to_symbol(s7_scheme *sc, s7_pointer args)
+{
+ #define H_keyword_to_symbol "(keyword->symbol key) returns a symbol with the same name as key but no prepended colon"
+ #define Q_keyword_to_symbol s7_make_signature(sc, 2, sc->IS_SYMBOL, sc->IS_KEYWORD)
- digits = (int *)permanent_calloc(CTABLE_SIZE * sizeof(int));
- for (i = 0; i < CTABLE_SIZE; i++)
- digits[i] = 256;
+ s7_pointer sym;
+ sym = car(args);
+ if (!is_keyword(sym))
+ method_or_bust_with_type(sc, sym, sc->KEYWORD_TO_SYMBOL, args, make_string_wrapper(sc, "a keyword"), 0);
+ return(keyword_symbol(sym));
+}
- digits['0'] = 0; digits['1'] = 1; digits['2'] = 2; digits['3'] = 3; digits['4'] = 4;
- digits['5'] = 5; digits['6'] = 6; digits['7'] = 7; digits['8'] = 8; digits['9'] = 9;
- digits['a'] = 10; digits['A'] = 10;
- digits['b'] = 11; digits['B'] = 11;
- digits['c'] = 12; digits['C'] = 12;
- digits['d'] = 13; digits['D'] = 13;
- digits['e'] = 14; digits['E'] = 14;
- digits['f'] = 15; digits['F'] = 15;
+static s7_pointer c_keyword_to_symbol(s7_scheme *sc, s7_pointer sym)
+{
+ if (!is_keyword(sym))
+ method_or_bust_with_type(sc, sym, sc->KEYWORD_TO_SYMBOL, list_1(sc, sym), make_string_wrapper(sc, "a keyword"), 0);
+ return(keyword_symbol(sym));
}
-static bool is_white_space(int c)
+/* -------------------------------- symbol->keyword -------------------------------- */
+static s7_pointer g_symbol_to_keyword(s7_scheme *sc, s7_pointer args)
{
- /* this is much faster than C's isspace, and does not depend on the current locale */
- return((c >= 0) && (white_space[c]));
-}
+ #define H_symbol_to_keyword "(symbol->keyword sym) returns a keyword with the same name as sym, but with a colon prepended"
+ #define Q_symbol_to_keyword s7_make_signature(sc, 2, sc->IS_KEYWORD, sc->IS_SYMBOL)
+ if (!is_symbol(car(args)))
+ method_or_bust(sc, car(args), sc->SYMBOL_TO_KEYWORD, args, T_SYMBOL, 0);
+ return(s7_make_keyword(sc, symbol_name(car(args))));
+}
-static s7_pointer check_sharp_readers(s7_scheme *sc, const char *name)
+static s7_pointer c_symbol_to_keyword(s7_scheme *sc, s7_pointer sym)
{
- s7_pointer reader, value, args;
- int args_loc = -1;
- value = sc->F;
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->SYMBOL_TO_KEYWORD, list_1(sc, sym), T_SYMBOL, 0);
+ return(s7_make_keyword(sc, symbol_name(sym)));
+}
- /* *#reader* is assumed to be an alist of (char . proc)
- * where each proc takes one argument, the string from just beyond the "#" to the next delimiter.
- * The procedure can call read-char to read ahead in the current-input-port.
- * If it returns anything other than #f, that is the value of the sharp expression.
- * This search happens after #|, #!, #t, and #f.
- */
- for (reader = symbol_value(sc->sharp_readers); reader != sc->NIL; reader = cdr(reader))
- {
- if (name[0] == s7_character(caar(reader)))
- {
- if (args_loc == -1)
- {
- args = make_list_1(sc, s7_make_string(sc, name));
- args_loc = s7_gc_protect(sc, args);
- }
- value = s7_call(sc, cdar(reader), args);
- if (value != sc->F)
- break;
- }
- }
- if (args_loc != -1)
- s7_gc_unprotect_at(sc, args_loc);
- return(value);
+/* ---------------- uninterpreted pointers ---------------- */
+
+bool s7_is_c_pointer(s7_pointer arg)
+{
+ return(type(arg) == T_C_POINTER);
}
-static s7_pointer g_sharp_readers_set(s7_scheme *sc, s7_pointer args)
+void *s7_c_pointer(s7_pointer p)
{
- /* new value must be either '() or a proper list of conses (char . func) */
- if (cadr(args) == sc->NIL) return(cadr(args));
- if (is_pair(cadr(args)))
- {
- s7_pointer x;
- for (x = cadr(args); is_pair(x); x = cdr(x))
- {
- if ((!is_pair(car(x))) ||
- (!s7_is_character(caar(x))) ||
- (!s7_is_procedure(cdar(x))))
- return(sc->ERROR);
- }
- if (x == sc->NIL)
- return(cadr(args));
- }
- return(sc->ERROR);
+ if ((is_number(p)) &&
+ (s7_integer(p) == 0))
+ return(NULL); /* special case where the null pointer has been cons'd up by hand */
+
+ if (type(p) != T_C_POINTER)
+ return(NULL);
+
+ return(raw_pointer(p));
}
-static bool is_abnormal(s7_pointer x)
+s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr)
{
- return((!s7_is_number(x)) ||
- (isinf(s7_real_part(x))) ||
- (isinf(s7_imag_part(x))) ||
- (isnan(s7_real_part(x))) ||
- (isnan(s7_imag_part(x))));
+ s7_pointer x;
+ new_cell(sc, x, T_C_POINTER);
+ raw_pointer(x) = ptr;
+ return(x);
}
-#define NESTED_SHARP false
-#define UNNESTED_SHARP true
+static s7_pointer g_is_c_pointer(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_c_pointer "(c-pointer? obj) returns #t if obj is a C pointer being held in s7."
+ #define Q_is_c_pointer pl_bt
+
+ check_boolean_method(sc, s7_is_c_pointer, sc->IS_C_POINTER, args);
+}
-#define SYMBOL_OK true
-#define NO_SYMBOLS false
-static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, bool at_top, int radix)
+static s7_pointer c_c_pointer(s7_scheme *sc, s7_pointer arg)
{
- /* name is the stuff after the '#', return sc->NIL if not a recognized #... entity */
- int len;
- s7_pointer x;
+ ptr_int p;
+ if (!s7_is_integer(arg))
+ method_or_bust(sc, arg, sc->C_POINTER, list_1(sc, arg), T_INTEGER, 1);
+ p = (ptr_int)s7_integer(arg); /* (c-pointer (bignum "1234")) */
+ return(s7_make_c_pointer(sc, (void *)p));
+}
- if ((name[0] == 't') && (name[1] == '\0'))
- return(sc->T);
-
- if ((name[0] == 'f') && (name[1] == '\0'))
- return(sc->F);
+static s7_pointer g_c_pointer(s7_scheme *sc, s7_pointer args)
+{
+ #define H_c_pointer "(c-pointer int) returns a c-pointer object."
+ #define Q_c_pointer s7_make_signature(sc, 2, sc->IS_C_POINTER, sc->IS_INTEGER)
+ return(c_c_pointer(sc, car(args)));
+}
- if (symbol_value(sc->sharp_readers) != sc->NIL)
- {
- x = check_sharp_readers(sc, name);
- if (x != sc->F)
- return(x);
- }
-
- len = safe_strlen(name);
- if (len < 2)
- return(sc->NIL);
-
- switch (name[0])
- {
- /* -------- #< ... > -------- */
- case '<':
- if (strings_are_equal(name, "<unspecified>"))
- return(sc->UNSPECIFIED);
- if (strings_are_equal(name, "<undefined>"))
- return(sc->UNDEFINED);
- if (strings_are_equal(name, "<eof>"))
- return(sc->EOF_OBJECT);
+/* --------------------------------- rf (CLM optimizer) ----------------------------------------------- */
- return(sc->NIL);
- break;
-
+s7_pointer *s7_xf_start(s7_scheme *sc)
+{
+ sc->cur_rf->cur = sc->cur_rf->data;
+ return(sc->cur_rf->cur);
+}
- /* -------- #o #d #x #b -------- */
- case 'o': /* #o (octal) */
- case 'd': /* #d (decimal) */
- case 'x': /* #x (hex) */
- case 'b': /* #b (binary) */
- {
- bool to_inexact = false, to_exact = false;
- int num_at = 1;
-
- if (name[1] == '#')
- {
- if (!at_top)
- return(sc->NIL);
- if ((len > 2) && ((name[2] == 'e') || (name[2] == 'i'))) /* r6rs includes caps here */
- {
- if ((len > 3) && (name[3] == '#'))
- return(sc->NIL);
- to_inexact = (name[2] == 'i');
- to_exact = (name[2] == 'e');
- num_at = 3;
- }
- else return(sc->NIL);
- }
- /* the #b or whatever overrides any radix passed in earlier */
- x = make_atom(sc, (char *)(name + num_at), (name[0] == 'o') ? 8 : ((name[0] == 'x') ? 16 : ((name[0] == 'b') ? 2 : 10)), NO_SYMBOLS);
+static void resize_xf(s7_scheme *sc, xf_t *rc)
+{
+ /* if we're saving pointers into this array (for later fill-in), this realloc
+ * means earlier (backfill) pointers are not valid, so we have to save the position to be
+ * filled, not the pointer to it.
+ */
+ s7_int loc;
+ loc = rc->cur - rc->data;
- /* #x#i1 apparently makes sense, so #x1.0 should also be accepted.
- * here we can get #b#e0/0 or #b#e+1/0 etc.
- * surely if #e1+i is an error (or #f), and #e#x1+i is an error,
- * #x#e1+i should also be an error, but #e1+0i is not an error I guess since there actually isn't any imaginary part
- */
- if (is_abnormal(x))
- return(sc->NIL);
+#if DEBUGGING
+ int i;
+ s7_pointer *old;
+ old = rc->data;
+ rc->data = (s7_pointer *)calloc(rc->size * 2, sizeof(s7_pointer));
+ for (i = 0; i < rc->size; i++)
+ {
+ rc->data[i] = old[i];
+ old[i] = NULL;
+ }
+#else
+ rc->data = (s7_pointer *)realloc(rc->data, rc->size * 2 * sizeof(s7_pointer));
+#endif
+ rc->cur = (s7_pointer *)(rc->data + loc);
+ rc->size *= 2;
+ rc->end = (s7_pointer *)(rc->data + rc->size);
+}
- if ((!to_exact) && (!to_inexact))
- return(x);
+#define rc_loc(sc) (ptr_int)(sc->cur_rf->cur - sc->cur_rf->data)
+#define rc_go(sc, loc) (s7_pointer *)(sc->cur_rf->data + loc)
- if ((s7_imag_part(x) != 0.0) && (to_exact)) /* #x#e1+i */
- return(sc->NIL);
+#define xf_init(N) do {rc = sc->cur_rf; if ((rc->cur + N) >= rc->end) resize_xf(sc, rc);} while (0)
+#define xf_store(Val) do {(*(rc->cur)) = Val; rc->cur++;} while (0)
+#define xf_save_loc(Loc) do {Loc = rc->cur - rc->data; rc->cur++;} while (0)
+#define xf_save_loc2(Loc1, Loc2) do {Loc1 = rc->cur - rc->data; Loc2 = Loc1 + 1; rc->cur += 2;} while (0)
+#define xf_save_loc3(Loc1, Loc2, Loc3) do {Loc1 = rc->cur - rc->data; Loc2 = Loc1 + 1; Loc3 = Loc2 + 1; rc->cur += 3;} while (0)
+#define xf_store_at(Loc, Val) rc->data[Loc] = Val
+#define xf_go(loc) rc->cur = (s7_pointer *)(rc->data + loc)
+/* #define xf_loc() (ptr_int)(rc->cur - rc->data) */
-#if WITH_GMP
- if (s7_is_bignum(x))
- {
- if (to_exact)
- return(big_inexact_to_exact(sc, make_list_1(sc, x)));
- return(big_exact_to_inexact(sc, make_list_1(sc, x)));
- }
-#endif
- if (to_exact)
- return(inexact_to_exact(sc, x));
- return(exact_to_inexact(sc, x));
- }
- break;
+s7_int s7_xf_store(s7_scheme *sc, s7_pointer val)
+{
+ s7_pointer *cur;
+ xf_t *rc;
+ rc = sc->cur_rf;
+ if (rc->cur == rc->end)
+ resize_xf(sc, rc);
+ cur = rc->cur++;
+ (*cur) = val;
+ return(cur - rc->data);
+}
+void s7_xf_store_at(s7_scheme *sc, s7_int index, s7_pointer val)
+{
+ sc->cur_rf->data[index] = val;
+}
- /* -------- #i -------- */
- case 'i': /* #i<num> = ->inexact (see token for table of choices here) */
- if (name[1] == '#')
- {
- /* there are special cases here: "#e0/0" or "#e#b0/0" -- all infs are complex:
- * #i1/0=nan.0 but #i1/0+i=inf+1i so e->i is a no-op but i->e is not
- *
- * even trickier: a *#reader* like #t<num> could be used as #e#t13.25 so make_sharp_constant
- * needs to be willing to call the readers even when not at_top (i.e. when NESTED_SHARP).
- */
+void *s7_xf_new(s7_scheme *sc, s7_pointer e)
+{
+ xf_t *result;
+ if (sc->rf_free_list)
+ {
+ result = sc->rf_free_list;
+ sc->rf_free_list = sc->rf_free_list->next;
+ }
+ else
+ {
+ result = (xf_t *)malloc(sizeof(xf_t));
+ result->size = 8;
+ result->data = (s7_pointer *)calloc(result->size, sizeof(s7_pointer));
+ result->end = (s7_pointer *)(result->data + result->size);
+ }
+ if (sc->cur_rf)
+ {
+ sc->cur_rf->next = sc->rf_stack;
+ sc->rf_stack = sc->cur_rf;
+ }
+ sc->cur_rf = result;
+ result->cur = result->data;
+ result->e = e; /* set only here? */
+ result->gc_list = NULL;
+ return((void *)result);
+}
- if ((name[2] == 'e') || /* #i#e1 -- assume these aren't redefinable? */
- (name[2] == 'i'))
- return(sc->NIL);
+static void s7_xf_clear(s7_scheme *sc)
+{
+ while (sc->cur_rf) {s7_xf_free(sc);}
+}
- x = make_sharp_constant(sc, (char *)(name + 2), NESTED_SHARP, radix);
- if (s7_is_number(x))
- {
- if (is_abnormal(x))
- return(sc->NIL);
-#if WITH_GMP
- if (s7_is_bignum(x)) /* (string->number "#b#e-11e+111") */
- return(big_exact_to_inexact(sc, make_list_1(sc, x)));
-#endif
- return(exact_to_inexact(sc, x));
- }
- return(sc->NIL);
- }
- x = make_atom(sc, (char *)(name + 1), radix, NO_SYMBOLS);
- if (!s7_is_number(x)) /* not is_abnormal(x) -- #i0/0 -> nan etc */
- return(sc->NIL);
-#if WITH_GMP
- if (s7_is_bignum(x))
- return(big_exact_to_inexact(sc, make_list_1(sc, x)));
-#endif
- return(exact_to_inexact(sc, x));
- break;
-
+bool s7_xf_is_stepper(s7_scheme *sc, s7_pointer sym)
+{
+ s7_pointer e, p;
+ e = sc->cur_rf->e;
+ if (!e) return(false);
+ for (p = let_slots(e); is_slot(p); p = next_slot(p))
+ if (slot_symbol(p) == sym)
+ return(true);
+ return(false);
+}
- /* -------- #e -------- */
- case 'e': /* #e<num> = ->exact */
- if (name[1] == '#')
- {
- if ((name[2] == 'e') || /* #e#e1 */
- (name[2] == 'i'))
- return(sc->NIL);
- x = make_sharp_constant(sc, (char *)(name + 2), NESTED_SHARP, radix);
- if (s7_is_number(x))
- {
- if (is_abnormal(x)) /* (string->number "#e#b0/0") */
- return(sc->NIL);
- if (!s7_is_real(x)) /* (string->number "#e#b1+i") */
- return(sc->NIL);
-#if WITH_GMP
- return(big_inexact_to_exact(sc, make_list_1(sc, x)));
-#endif
- return(inexact_to_exact(sc, x));
- }
- return(sc->NIL);
- }
+static void xf_clear_list(s7_scheme *sc, xf_t *r)
+{
+ gc_obj *p, *op;
+ for (p = r->gc_list; p; p = op)
+ {
+ op = p->nxt;
+ free(p);
+ }
+ r->gc_list = NULL;
+}
- x = make_atom(sc, (char *)(name + 1), radix, NO_SYMBOLS);
-#if WITH_GMP
- /* #e1e310 is a simple case */
- if (s7_is_bignum(x))
- return(big_inexact_to_exact(sc, make_list_1(sc, x)));
-#endif
- if (is_abnormal(x)) /* (string->number "#e0/0") */
- return(sc->NIL);
- if (!s7_is_real(x)) /* (string->number "#e1+i") */
- return(sc->NIL);
-
-#if WITH_GMP
- /* there are non-big floats that are greater than most-positive-fixnum:
- * :(> .1e20 most-positive-fixnum) -> #t
- * :(bignum? .1e20) -> #f
- * so we have to check that, not just is it a bignum.
- */
- return(big_inexact_to_exact(sc, make_list_1(sc, x)));
+void *s7_xf_detach(s7_scheme *sc)
+{
+ xf_t *r;
+ r = sc->cur_rf;
+ sc->cur_rf = sc->rf_stack;
+ if (sc->rf_stack)
+ sc->rf_stack = sc->rf_stack->next;
+ return((void *)r);
+}
+
+void s7_xf_attach(s7_scheme *sc, void *ur)
+{
+ xf_t *r = (xf_t *)ur;
+ r->next = sc->rf_free_list;
+ sc->rf_free_list = r;
+ xf_clear_list(sc, r);
+}
+
+s7_pointer *s7_xf_top(s7_scheme *sc, void *ur)
+{
+ xf_t *r = (xf_t *)ur;
+ return(r->data);
+}
+
+
+static s7_pointer xf_push(s7_scheme *sc, s7_pointer obj)
+{
+ gc_obj *p;
+ p = (gc_obj *)malloc(sizeof(gc_obj));
+ p->nxt = sc->cur_rf->gc_list;
+ sc->cur_rf->gc_list = p;
+ p->p = obj;
+ return(obj);
+}
+
+#if WITH_ADD_PF
+static s7_pointer xf_pop(s7_scheme *sc)
+{
+ if ((sc->cur_rf) &&
+ (sc->cur_rf->gc_list))
+ {
+ s7_pointer p;
+ gc_obj *g;
+ g = sc->cur_rf->gc_list;
+ p = g->p;
+ sc->cur_rf->gc_list = g->nxt;
+ free(g);
+ return(p);
+ }
+ return(NULL);
+}
#endif
- return(inexact_to_exact(sc, x));
- break;
+void s7_xf_free(s7_scheme *sc)
+{
+ sc->cur_rf->next = sc->rf_free_list;
+ sc->rf_free_list = sc->cur_rf;
+ xf_clear_list(sc, sc->cur_rf);
+ sc->cur_rf = sc->rf_stack;
+ if (sc->rf_stack)
+ sc->rf_stack = sc->rf_stack->next;
+}
- /* -------- #\... -------- */
- case '\\':
- if (name[2] == 0) /* the most common case: #\a */
- return(chars[(unsigned char)(name[1])]);
- /* not unsigned int here! (unsigned int)255 (as a char) returns -1!! */
+static s7_if_t implicit_int_vector_ref(s7_scheme *sc, s7_pointer expr);
+static s7_rf_t implicit_float_vector_ref(s7_scheme *sc, s7_pointer expr);
+static s7_pf_t implicit_pf_sequence_ref(s7_scheme *sc, s7_pointer expr);
+static s7_pf_t implicit_gf_sequence_ref(s7_scheme *sc, s7_pointer expr);
- if (strings_are_equal(name + 1, "space"))
- return(chars[' ']);
+#if WITH_OPTIMIZATION
+static s7_pf_t implicit_pf_sequence_set(s7_scheme *sc, s7_pointer v, s7_pointer ind, s7_pointer val);
+static s7_pf_t implicit_gf_sequence_set(s7_scheme *sc, s7_pointer v, s7_pointer ind, s7_pointer val);
+#endif
- if ((strings_are_equal(name + 1, "newline")) ||
- (strings_are_equal(name + 1, "linefeed")))
- return(chars['\n']);
+/* set cases are via set_if/set_rf -- but set_gp|pf would need to be restricted to non-symbol settees */
- if (strings_are_equal(name + 1, "return"))
- return(chars['\r']);
+/* need to make sure sequence is not a step var, also set cases */
- if (strings_are_equal(name + 1, "tab"))
- return(chars['\t']);
+static s7_rp_t rf_function(s7_pointer f)
+{
+ switch (type(f))
+ {
+ case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ return(c_function_rp(f));
- if ((strings_are_equal(name + 1, "null")) ||
- (strings_are_equal(name + 1, "nul")))
- return(chars[0]);
+ case T_FLOAT_VECTOR:
+ return(implicit_float_vector_ref);
- if (name[1] == 'x') /* #\x is just x, but apparently #\x<num> is int->char? #\x65 -> #\e -- Guile doesn't have this
- * (it is from r6rs -- perhaps it is a bad idea...)
- */
- {
- /* sscanf here misses errors like #\x1.4, but make_atom misses #\x6/3,
- * #\x#b0, #\x#e0.0, #\x-0, #\x#e0e100 etc, so we have to do it at
- * an even lower level.
- */
- bool happy = true;
- char *tmp;
- int lval = 0;
+ case T_C_OBJECT:
+ return(c_object_rp(f));
- tmp = (char *)(name + 2);
- while ((*tmp) && (happy))
- {
- int dig;
- dig = digits[(int)(*tmp++)];
- if (dig < 16)
- lval = dig + (lval * 16);
- else happy = false;
- }
- if ((happy) &&
- (lval < 256))
- return(chars[lval]);
- }
+ case T_SYNTAX:
+ return(syntax_rp(f));
}
- return(sc->NIL);
+ return(NULL);
}
-
-static s7_Int string_to_integer(const char *str, int radix, bool *overflow)
+static s7_ip_t if_function(s7_pointer f)
{
- bool negative = false;
- s7_Int lval = 0;
- int dig;
- char *tmp = (char *)str;
- char *tmp1;
-
- if (str[0] == '+')
- tmp++;
- else
+ switch (type(f))
{
- if (str[0] == '-')
- {
- negative = true;
- tmp++;
- }
+ case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ return(c_function_ip(f));
+
+ case T_INT_VECTOR:
+ return(implicit_int_vector_ref);
+
+ case T_C_OBJECT:
+ return(c_object_ip(f));
+
+ case T_SYNTAX:
+ return(syntax_ip(f));
}
- while (*tmp == '0') {tmp++;};
- tmp1 = tmp;
+ return(NULL);
+}
- if (radix == 10)
+static s7_pp_t pf_function(s7_pointer f)
+{
+ switch (type(f))
{
- while (true)
- {
- dig = digits[(unsigned char)(*tmp++)];
- if (dig < 10)
- lval = dig + (lval * 10);
- else break;
- }
+ case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ return(c_function_pp(f));
+
+ case T_PAIR: case T_STRING: case T_VECTOR: case T_HASH_TABLE: case T_LET:
+ return(implicit_pf_sequence_ref);
+
+ case T_SYNTAX:
+ return(syntax_pp(f));
}
- else
+ return(NULL);
+}
+
+static s7_pp_t gf_function(s7_pointer f)
+{
+ switch (type(f))
{
- while (true)
- {
- dig = digits[(unsigned char)(*tmp++)];
- if (dig < radix)
- lval = dig + (lval * radix);
- else break;
- }
+ case T_C_FUNCTION_STAR: case T_C_FUNCTION: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ return(c_function_gp(f));
+
+ case T_PAIR: case T_STRING: case T_VECTOR: case T_HASH_TABLE: case T_LET: case T_C_OBJECT: case T_INT_VECTOR: case T_FLOAT_VECTOR:
+ return(implicit_gf_sequence_ref);
}
+ return(NULL);
+}
-#if WITH_GMP
- (*overflow) = ((lval > S7_LONG_MAX) ||
- ((tmp - tmp1) > s7_int_digits_by_radix[radix]));
- /* this tells the string->number readers to create a bignum. We need to be very
- * conservative here to catch contexts such as (/ 1/524288 19073486328125)
- */
+s7_rp_t s7_rf_function(s7_scheme *sc, s7_pointer func) {return(rf_function(func));}
+s7_ip_t s7_if_function(s7_scheme *sc, s7_pointer func) {return(if_function(func));}
+s7_pp_t s7_pf_function(s7_scheme *sc, s7_pointer func) {return(pf_function(func));}
+s7_pp_t s7_gf_function(s7_scheme *sc, s7_pointer func) {return(gf_function(func));}
+
+void s7_rf_set_function(s7_pointer f, s7_rp_t rp)
+{
+#if WITH_OPTIMIZATION
+ if (!is_c_function(f)) return;
+ c_function_rp(f) = rp;
#else
- if ((tmp - tmp1 - 2) > s7_int_digits_by_radix[radix])
- {
- /* I can't decide what to do with these non-gmp overflows. Perhaps NAN in all cases?
- * overflow: 9223372036854775810 -> -9223372036854775806 -- this is not caught currently
- */
- (*overflow) = true;
- if (negative)
- return(s7_Int_min); /* or INFINITY? */
- return(s7_Int_max); /* 0/100000000000000000000000000000000000000000000000000000000000000000000 */
- }
+ return;
#endif
+}
- if (negative)
- return(-lval);
- return(lval);
+void s7_if_set_function(s7_pointer f, s7_ip_t ip)
+{
+#if WITH_OPTIMIZATION
+ if (!is_c_function(f)) return;
+ c_function_ip(f) = ip;
+#else
+ return;
+#endif
}
+void s7_pf_set_function(s7_pointer f, s7_pp_t pp)
+{
+#if WITH_OPTIMIZATION
+ if (!is_c_function(f)) return;
+ c_function_pp(f) = pp;
+#else
+ return;
+#endif
+}
-/* 9223372036854775807 9223372036854775807
- * -9223372036854775808 -9223372036854775808
- * 0000000000000000000000000001.0 1.0
- * 1.0000000000000000000000000000 1.0
- * 1000000000000000000000000000.0e-40 1.0e-12
- * 0.0000000000000000000000000001e40 1.0e12
- * 1.0e00000000000000000001 10.0
- */
+void s7_gf_set_function(s7_pointer f, s7_pp_t gp)
+{
+#if WITH_OPTIMIZATION
+ if (!is_c_function(f)) return;
+ c_function_gp(f) = gp;
+#else
+ return;
+#endif
+}
-static s7_Double string_to_double_with_radix(const char *ur_str, int radix, bool *overflow)
+static s7_rp_t pair_to_rp(s7_scheme *sc, s7_pointer expr)
{
- /* strtod follows LANG which is not what we want (only "." is decimal point in Scheme).
- * To overcome LANG in strtod would require screwing around with setlocale which never works
- * and isn't thread safe. So we use our own code -- according to valgrind,
- * this function is much faster than strtod.
- *
- * comma as decimal point causes ambiguities: `(+ ,1 2) etc
- */
+ s7_pointer val_sym, val;
+ val_sym = car(expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ if (s7_local_slot(sc, val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ return(s7_rf_function(sc, val));
+}
- int i, sign = 1, frac_len, int_len, dig, max_len, exponent = 0;
- long long int int_part = 0, frac_part = 0;
- char *str;
- char *ipart, *fpart;
- s7_Double dval = 0.0;
+static s7_ip_t pair_to_ip(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer val_sym, val;
+ val_sym = car(expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ if (s7_local_slot(sc, val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ return(s7_if_function(sc, val));
+}
- /* there's an ambiguity in number notation here if we allow "1e1" or "1.e1" in base 16 (or 15) -- is e a digit or an exponent marker?
- * but 1e+1, for example disambiguates it -- kind of messy! -- the scheme spec says "e" can only occur in base 10.
- * mpfr says "e" as exponent only in bases <= 10 -- else use '@' which works in any base. This can only cause confusion
- * in scheme, unfortunately, due to the idiotic scheme polar notation. But we accept "s" and "l" as exponent markers
- * so, perhaps for radix > 10, the exponent, if any, has to use one of S s L l? Not "l"! And "s" originally meant "short".
- *
- * Another slight ambiguity: 1+1/2i is parsed as 1 + 0.5i, not 1+1/(2i), or (1+1)/(2i) or (1+1/2)i etc
- */
+static s7_pp_t pair_to_pp(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer val_sym, val;
+ val_sym = car(expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ if (s7_local_slot(sc, val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ return(s7_pf_function(sc, val));
+}
- max_len = s7_int_digits_by_radix[radix];
- str = (char *)ur_str;
+static s7_pp_t pair_to_gp(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer val_sym, val;
+ val_sym = car(expr);
+ if (!s7_is_symbol(val_sym)) return(NULL);
+ if (s7_local_slot(sc, val_sym)) return(NULL);
+ val = s7_symbol_value(sc, val_sym);
+ return(s7_gf_function(sc, val));
+}
- if (*str == '+')
- str++;
- else
+static s7_pf_t xf_opt(s7_scheme *sc, s7_pointer lp)
+{
+ s7_int loc;
+ s7_pointer f;
+ s7_rp_t rp;
+ s7_ip_t xp;
+ s7_pp_t pp;
+ xf_t *rc;
+
+ f = find_symbol(sc, car(lp));
+ if (!is_slot(f)) return(NULL);
+ f = slot_value(f);
+
+ xf_init(3);
+ xf_save_loc(loc);
+
+ xp = if_function(f);
+ if (xp)
{
- if (*str == '-')
+ s7_if_t xf;
+ xf = xp(sc, lp);
+ if (xf)
{
- str++;
- sign = -1;
+ xf_store_at(loc, (s7_pointer)xf);
+ return((s7_pf_t)xf);
}
+ xf_go(loc + 1);
}
- while (*str == '0') {str++;};
-
- ipart = str;
- while (digits[(int)(*str)] < radix) str++;
- int_len = str - ipart;
- if (*str == '.') str++;
- fpart = str;
- while (digits[(int)(*str)] < radix) str++;
- frac_len = str - fpart;
-
- if ((*str) && (exponent_table[(unsigned char)(*str)]))
+ rp = rf_function(f);
+ if (rp)
{
- int exp_negative = false;
- str++;
- if (*str == '+')
- str++;
- else
+ s7_rf_t rf;
+ rf = rp(sc, lp);
+ if (rf)
{
- if (*str == '-')
- {
- str++;
- exp_negative = true;
- }
+ xf_store_at(loc, (s7_pointer)rf);
+ return((s7_pf_t)rf);
}
- while ((dig = digits[(int)(*str++)]) < 10) /* exponent is always base 10 */
- exponent = dig + (exponent * 10);
- if (exp_negative) exponent = -exponent;
+ xf_go(loc + 1);
}
-#if WITH_GMP
- /* 9007199254740995.0 */
-
- if (int_len + frac_len >= max_len)
+ pp = pf_function(f);
+ if (pp)
{
- (*overflow) = true;
- return(0.0);
+ s7_pf_t pf;
+ pf = pp(sc, lp);
+ if (pf)
+ {
+ xf_store_at(loc, (s7_pointer)pf);
+ return(pf);
+ }
+ xf_go(loc + 1);
}
-#endif
-
- str = ipart;
- if ((int_len + exponent) > max_len)
- {
- /* 12341234.56789e12 12341234567889999872.0 1.234123456789e+19
- * -1234567890123456789.0 -1234567890123456768.0 -1.2345678901235e+18
- * 12345678901234567890.0 12345678901234567168.0 1.2345678901235e+19
- * 123.456e30 123456000000000012741097792995328.0 1.23456e+32
- * 12345678901234567890.0e12 12345678901234569054409354903552.0 1.2345678901235e+31
- * 1.234567890123456789012e30 1234567890123456849145940148224.0 1.2345678901235e+30
- * 1e20 100000000000000000000.0 1e+20
- * 1234567890123456789.0 1234567890123456768.0 1.2345678901235e+18
- * 123.456e16 1234560000000000000.0 1.23456e+18
- * 98765432101234567890987654321.0e-5 987654321012345728401408.0 9.8765432101235e+23
- * 98765432101234567890987654321.0e-10 9876543210123456512.0 9.8765432101235e+18
- * 0.00000000000000001234e20 1234.0
- * 0.000000000000000000000000001234e30 1234.0
- * 0.0000000000000000000000000000000000001234e40 1234.0
- * 0.000000000012345678909876543210e15 12345.678909877
- * 0e1000 0.0
- */
- for (i = 0; i < max_len; i++)
+ pp = gf_function(f);
+ if (pp)
+ {
+ s7_pf_t pf;
+ pf = pp(sc, lp);
+ if (pf)
{
- dig = digits[(int)(*str++)];
- if (dig < radix)
- int_part = dig + (int_part * radix);
- else break;
+ xf_store_at(loc, (s7_pointer)pf);
+ return(pf);
}
+ }
+ return(NULL);
+}
- /* if the exponent is huge, check for 0 int_part and frac_part before complaining (0e1000 or 0.0e1000) */
- if ((int_part == 0) &&
- (exponent > max_len))
- {
- /* if frac_part is also 0, return 0.0 */
- if (frac_len == 0)
- return(0.0);
+#if 0
+static s7_pointer if_to_pf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_if_t xf;
+ s7_int x;
+ xf = (s7_if_t)(**p); (*p)++;
+ x = xf(sc, p);
+ return(make_integer(sc, x));
+}
- str = fpart;
- while ((dig = digits[(int)(*str++)]) < radix)
- frac_part = dig + (frac_part * radix);
- if (frac_part == 0)
- return(0.0);
+static s7_pointer rf_to_pf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t rf;
+ s7_double x;
+ rf = (s7_rf_t)(**p); (*p)++;
+ x = rf(sc, p);
+ return(make_real(sc, x));
+}
-#if WITH_GMP
- (*overflow) = true;
-#endif
- }
-
-#if WITH_GMP
- (*overflow) = ((int_part > 0) || (exponent > 20)); /* .1e310 is a tricky case */
-#endif
-
- if (int_part != 0) /* 0.<310 zeros here>1e310 for example --
- * pow (via ipow) thinks it has to be too big, returns Nan,
- * then Nan * 0 -> Nan and the NaN progogates
- */
- {
- if (int_len <= max_len)
- dval = int_part * ipow(radix, exponent);
- else dval = int_part * ipow(radix, exponent + int_len - max_len);
- }
- else dval = 0.0;
+static s7_pf_t pf_opt(s7_scheme *sc, s7_pointer lp)
+{
+ s7_int loc, loc1;
+ s7_pointer f;
+ s7_rp_t rp;
+ s7_ip_t xp;
+ s7_pp_t pp;
+ xf_t *rc;
- /* shift by exponent, but if int_len > max_len then we assumed (see below) int_len - max_len 0's on the left */
- /* using int_to_int or table lookups here instead of pow did not make any difference in speed */
+ f = find_symbol(sc, car(lp));
+ if (!is_slot(f)) return(NULL);
+ f = slot_value(f);
- if (int_len < max_len)
- {
- int k, flen;
- str = fpart;
-
- for (k = 0; (frac_len > 0) && (k < exponent); k += max_len)
- {
- if (frac_len > max_len) flen = max_len; else flen = frac_len;
- frac_len -= max_len;
+ xf_init(3);
+ xf_save_loc(loc);
- frac_part = 0;
- for (i = 0; i < flen; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ xp = if_function(f);
+ if (xp)
+ {
+ s7_if_t xf;
+ xf_save_loc(loc1);
+ xf = xp(sc, lp);
+ if (xf)
+ {
+ xf_store_at(loc, (s7_pointer)if_to_pf);
+ xf_store_at(loc1, (s7_pointer)xf);
+ return((s7_pf_t)if_to_pf);
+ }
+ xf_go(loc + 1);
+ }
- if (frac_part != 0) /* same pow->NaN problem as above can occur here */
- dval += frac_part * ipow(radix, exponent - flen - k);
- }
+ rp = rf_function(f);
+ if (rp)
+ {
+ s7_rf_t rf;
+ xf_save_loc(loc1);
+ rf = rp(sc, lp);
+ if (rf)
+ {
+ xf_store_at(loc, (s7_pointer)rf_to_pf);
+ xf_store_at(loc1, (s7_pointer)rf);
+ return((s7_pf_t)rf_to_pf);
}
- else
+ xf_go(loc + 1);
+ }
+
+ pp = pf_function(f);
+ if (pp)
+ {
+ s7_pf_t pf;
+ pf = pp(sc, lp);
+ if (pf)
{
- /* some of the fraction is in the integer part before the negative exponent shifts it over */
- if (int_len > max_len)
- {
- int ilen;
- /* str should be at the last digit we read */
- ilen = int_len - max_len; /* we read these above */
- if (ilen > max_len)
- ilen = max_len;
+ xf_store_at(loc, (s7_pointer)pf);
+ return(pf);
+ }
+ }
+ return(NULL);
+}
+#endif
- for (i = 0; i < ilen; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+static s7_double rf_c(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double x;
+ x = s7_number_to_real(sc, **p); (*p)++;
+ return(x);
+}
- dval += frac_part * ipow(radix, exponent - ilen);
- }
- }
+static s7_double rf_s(s7_scheme *sc, s7_pointer **p)
+{
+ s7_double x;
+ x = s7_number_to_real(sc, slot_value(**p)); (*p)++;
+ return(x);
+}
- return(sign * dval);
- }
+static bool arg_to_rf(s7_scheme *sc, s7_pointer a1, s7_int in_loc)
+{
+ s7_int loc;
+ xf_t *rc;
- /* int_len + exponent <= max_len */
+ xf_init(2);
+ if (in_loc == -1)
+ xf_save_loc(loc);
+ else loc = in_loc;
- if (int_len <= max_len)
+ if (is_pair(a1))
{
- char *iend;
- int int_exponent;
-
- /* a better algorithm (since the inaccuracies are in the radix^exponent portion):
- * strip off leading zeros and possible sign,
- * strip off digits beyond max_len, then remove any trailing zeros.
- * (maybe fiddle with the lowest order digit here for rounding, but I doubt it matters)
- * read digits until end of number or max_len reached, ignoring the decimal point
- * get exponent and use it and decimal point location to position the current result integer
- * this always combines the same integer and the same exponent no matter how the number is expressed.
- */
+ s7_rp_t rp;
+ s7_rf_t rf;
+ rp = pair_to_rp(sc, a1);
+ if (!rp) return(false);
+ rf = rp(sc, a1);
+ if (!rf) return(false);
+ xf_store_at(loc, (s7_pointer)rf);
+ return(true);
+ }
- int_exponent = exponent;
- if (int_len > 0)
+ if (is_symbol(a1))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, a1);
+ if ((is_slot(slot)) &&
+ (is_real(slot_value(slot))))
{
- iend = (char *)(str + int_len - 1);
- while ((*iend == '0') && (iend != str)) {iend--; int_exponent++;}
-
- while (str <= iend)
- int_part = digits[(int)(*str++)] + (int_part * radix);
+ xf_store(slot);
+ xf_store_at(loc, (s7_pointer)rf_s);
+ return(true);
}
- if (int_exponent != 0)
- dval = int_part * ipow(radix, int_exponent);
- else dval = (s7_Double)int_part;
+ return(false);
}
- else
+
+ if (is_real(a1))
{
- int len, flen;
- long long int fpart = 0;
+ xf_store(a1);
+ xf_store_at(loc, (s7_pointer)rf_c);
+ return(true);
+ }
- /* 98765432101234567890987654321.0e-20 987654321.012346
- * 98765432101234567890987654321.0e-29 0.98765432101235
- * 98765432101234567890987654321.0e-30 0.098765432101235
- * 98765432101234567890987654321.0e-28 9.8765432101235
- */
+ return(false);
+}
- len = int_len + exponent;
- for (i = 0; i < len; i++)
- int_part = digits[(int)(*str++)] + (int_part * radix);
-
- flen = -exponent;
- if (flen > max_len)
- flen = max_len;
+bool s7_arg_to_rf(s7_scheme *sc, s7_pointer a1)
+{
+ return(arg_to_rf(sc, a1, -1));
+}
- for (i = 0; i < flen; i++)
- fpart = digits[(int)(*str++)] + (fpart * radix);
+static s7_int if_c(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer i;
+ i = **p; (*p)++;
+ return(integer(i));
+}
- if (len <= 0)
- dval = int_part + fpart * ipow(radix, len - flen);
- else dval = int_part + fpart * ipow(radix, -flen);
+static s7_int if_s(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer x;
+ x = slot_value(**p); (*p)++;
+ if (!is_integer(x)) s7_wrong_type_arg_error(sc, "", 0, x, "an integer");
+ return(integer(x));
+}
+
+static bool arg_to_if(s7_scheme *sc, s7_pointer a1, s7_int in_loc)
+{
+ s7_int loc;
+ xf_t *rc;
+
+ xf_init(2);
+ if (in_loc == -1)
+ xf_save_loc(loc);
+ else loc = in_loc;
+
+ if (is_pair(a1))
+ {
+ s7_ip_t ip;
+ s7_if_t xf;
+ ip = pair_to_ip(sc, a1);
+ if (!ip) return(false);
+ xf = ip(sc, a1);
+ if (!xf) return(false);
+ xf_store_at(loc, (s7_pointer)xf);
+ return(true);
}
- if (frac_len > 0)
+ if (is_symbol(a1))
{
- str = fpart;
- if (frac_len <= max_len)
+ s7_pointer slot;
+ slot = s7_slot(sc, a1);
+ if ((is_slot(slot)) &&
+ (is_integer(slot_value(slot))))
{
- /* splitting out base 10 case saves very little here */
- /* this ignores trailing zeros, so that 0.3 equals 0.300 */
- char *fend;
-
- fend = (char *)(str + frac_len - 1);
- while ((*fend == '0') && (fend != str)) {fend--; frac_len--;} /* (= .6 0.6000) */
-
- while (str <= fend)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
- dval += frac_part * ipow(radix, exponent - frac_len);
-
- /* fprintf(stderr, "frac: %lld, exp: (%d %d) %.20f, val: %.20f\n", frac_part, exponent, frac_len, ipow(radix, exponent - frac_len), dval);
- * 0.6: frac: 6, exp: 0.10000000000000000555, val: 0.60000000000000008882
- * 0.60: frac: 60, exp: 0.01000000000000000021, val: 0.59999999999999997780
- * 0.6000: frac: 6000, exp: 0.00010000000000000000, val: 0.59999999999999997780
- * :(= 0.6 0.60)
- * #f
- * :(= #i3/5 0.6)
- * #f
- * so (string->number (number->string num)) == num only if both num's are the same text (or you get lucky)
- * :(= 0.6 6e-1) ; but not 60e-2
- * #t
- *
- * to fix the 0.60 case, we need to ignore trailing post-dot zeros.
- */
+ xf_store(slot);
+ xf_store_at(loc, (s7_pointer)if_s);
+ return(true);
}
- else
+ return(false);
+ }
+
+ if (is_integer(a1))
+ {
+ xf_store(a1);
+ xf_store_at(loc, (s7_pointer)if_c);
+ return(true);
+ }
+
+ return(false);
+}
+
+bool s7_arg_to_if(s7_scheme *sc, s7_pointer a1)
+{
+ return(arg_to_if(sc, a1, -1));
+}
+
+static s7_pointer pf_c(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer x;
+ x = **p; (*p)++;
+ return(x);
+}
+
+static s7_pointer pf_s(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer x;
+ x = slot_value(**p); (*p)++;
+ return(x);
+}
+
+static bool arg_to_pf(s7_scheme *sc, s7_pointer a1, s7_int in_loc)
+{
+ s7_int loc;
+ xf_t *rc;
+
+ xf_init(2);
+ if (in_loc == -1)
+ xf_save_loc(loc);
+ else loc = in_loc;
+
+ if (is_pair(a1))
+ {
+ s7_pp_t pp;
+ s7_pf_t pf;
+ pp = pair_to_pp(sc, a1);
+ if (!pp) return(false);
+ pf = pp(sc, a1);
+ if (!pf) return(false);
+ xf_store_at(loc, (s7_pointer)pf);
+ return(true);
+ }
+
+ if (is_symbol(a1))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, a1);
+ if (is_slot(slot))
{
- if (exponent <= 0)
- {
- for (i = 0; i < max_len; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
-
- dval += frac_part * ipow(radix, exponent - max_len);
- }
- else
+ xf_store(slot);
+ xf_store_at(loc, (s7_pointer)pf_s);
+ return(true);
+ }
+ return(false);
+ }
+
+ xf_store(a1);
+ xf_store_at(loc, (s7_pointer)pf_c);
+ return(true);
+}
+
+bool s7_arg_to_pf(s7_scheme *sc, s7_pointer a1)
+{
+ return(arg_to_pf(sc, a1, -1));
+}
+
+static bool arg_to_gf(s7_scheme *sc, s7_pointer a1, s7_int in_loc)
+{
+ if (is_pair(a1))
+ {
+ s7_pp_t gp;
+ gp = pair_to_gp(sc, a1);
+ if (gp)
+ {
+ xf_t *rc;
+ s7_pf_t gf;
+ s7_int loc;
+
+ xf_init(1);
+ if (in_loc == -1)
+ xf_save_loc(loc);
+ else loc = in_loc;
+ gf = gp(sc, a1);
+ if (gf)
{
- /* 1.0123456789876543210e1 10.12345678987654373771
- * 1.0123456789876543210e10 10123456789.87654304504394531250
- * 0.000000010000000000000000e10 100.0
- * 0.000000010000000000000000000000000000000000000e10 100.0
- * 0.000000012222222222222222222222222222222222222e10 122.22222222222222
- * 0.000000012222222222222222222222222222222222222e17 1222222222.222222
- */
-
- int_part = 0;
- for (i = 0; i < exponent; i++)
- int_part = digits[(int)(*str++)] + (int_part * radix);
-
- frac_len -= exponent;
- if (frac_len > max_len)
- frac_len = max_len;
-
- for (i = 0; i < frac_len; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
-
- dval += int_part + frac_part * ipow(radix, -frac_len);
+ xf_store_at(loc, (s7_pointer)gf);
+ return(true);
}
}
}
+ return(false);
+}
-#if WITH_GMP
- if ((int_part == 0) &&
- (frac_part == 0))
- return(0.0);
- (*overflow) = ((frac_len - exponent) > max_len);
-#endif
-
- return(sign * dval);
+bool s7_arg_to_gf(s7_scheme *sc, s7_pointer a1)
+{
+ return(arg_to_gf(sc, a1, -1));
+}
+
+static s7_rf_t pair_to_rf(s7_scheme *sc, s7_pointer a1, s7_rf_t x)
+{
+ if (s7_arg_to_rf(sc, a1))
+ return(x);
+ return(NULL);
}
+static s7_rf_t pair_to_rf_via_if(s7_scheme *sc, s7_pointer a1, s7_rf_t x)
+{
+ if (s7_arg_to_if(sc, a1))
+ return(x);
+ return(NULL);
+}
-/* make symbol or number atom from string */
-static s7_pointer make_atom(s7_scheme *sc, char *q, int radix, bool want_symbol)
+s7_rf_t s7_rf_1(s7_scheme *sc, s7_pointer expr, s7_rf_t r, s7_rf_t s, s7_rf_t x)
{
- #define ISDIGIT(Chr, Rad) (digits[(unsigned char)Chr] < Rad)
+ s7_pointer a1;
+ xf_t *rc;
- char c, *p;
- bool has_dec_point1 = false;
+ if ((is_null(cdr(expr))) || (!is_null(cddr(expr)))) return(NULL);
+ a1 = cadr(expr);
- p = q;
- c = *p++;
-
- /* a number starts with + - . or digit, but so does 1+ for example */
-
- switch (c)
+ xf_init(1);
+ if (is_real(a1))
{
- case '#':
- return(make_sharp_constant(sc, p, UNNESTED_SHARP, radix)); /* make_sharp_constant expects the '#' to be removed */
+ xf_store(a1);
+ return(r);
+ }
- case '+':
- case '-':
- c = *p++;
- if (c == '.')
- {
- has_dec_point1 = true;
- c = *p++;
- }
- if ((!c) || (!ISDIGIT(c, radix)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- break;
+ if (is_symbol(a1))
+ {
+ a1 = s7_slot(sc, a1);
+ if ((!is_slot(a1)) || (is_t_complex(slot_value(a1)))) return(NULL);
+ xf_store(a1);
+ return(s);
+ }
- case '.':
- has_dec_point1 = true;
- c = *p++;
+ if (is_pair(a1))
+ return(pair_to_rf(sc, a1, x));
- if ((!c) || (!ISDIGIT(c, radix)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- break;
+ return(NULL);
+}
- case '0': /* these two are always digits */
- case '1':
- break;
+s7_rf_t s7_rf_2(s7_scheme *sc, s7_pointer expr, s7_rf_t rr, s7_rf_t sr, s7_rf_t xr, s7_rf_t rs, s7_rf_t ss, s7_rf_t xs, s7_rf_t rx, s7_rf_t sx, s7_rf_t xx)
+{
+ s7_pointer a1, a2;
+ xf_t *rc;
- default:
- if (!ISDIGIT(c, radix))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- break;
+ if ((is_null(cdr(expr))) || (!is_null(cdddr(expr)))) return(NULL);
+ a1 = cadr(expr);
+ a2 = caddr(expr);
+
+ xf_init(2);
+ if (is_real(a1))
+ {
+ xf_store(a1);
+ if (is_real(a2))
+ {
+ xf_store(a2);
+ return(rr);
+ }
+ if (is_symbol(a2))
+ {
+ a2 = s7_slot(sc, a2);
+ if ((!is_slot(a2)) || (is_t_complex(slot_value(a2)))) return(NULL);
+ xf_store(a2);
+ return(rs);
+ }
+ if (is_pair(a2))
+ return(pair_to_rf(sc, a2, rx));
+ return(NULL);
+ }
+
+ if (is_symbol(a1))
+ {
+ a1 = s7_slot(sc, a1);
+ if ((!is_slot(a1)) || (is_t_complex(slot_value(a1)))) return(NULL);
+ xf_store(a1);
+ if (is_real(a2))
+ {
+ xf_store(a2);
+ return(sr);
+ }
+ if (is_symbol(a2))
+ {
+ a2 = s7_slot(sc, a2);
+ if ((!is_slot(a2)) || (is_t_complex(slot_value(a2)))) return(NULL);
+ xf_store(a2);
+ return(ss);
+ }
+ if (is_pair(a2))
+ return(pair_to_rf(sc, a2, sx));
+ return(NULL);
}
- /* now it's possibly a number -- the 1st character(s) could be part of a number in the current radix */
+ if (is_pair(a1))
+ {
+ s7_int loc;
+ s7_rp_t rp;
+ s7_rf_t rf;
- {
- char *slash1 = NULL, *slash2 = NULL, *plus = NULL, *ex1 = NULL, *ex2 = NULL;
- bool has_i = false, has_dec_point2 = false;
- int has_plus_or_minus = 0, current_radix;
+ xf_save_loc(loc);
+ rp = pair_to_rp(sc, a1);
+ if (!rp) return(NULL);
+ rf = rp(sc, a1);
+ if (!rf) return(NULL);
+ xf_store_at(loc, (s7_pointer)rf);
+
+ if (is_real(a2))
+ {
+ xf_store(a2);
+ return(xr);
+ }
+ if (is_symbol(a2))
+ {
+ a2 = s7_slot(sc, a2);
+ if ((!is_slot(a2)) || (is_t_complex(slot_value(a2)))) return(NULL);
+ xf_store(a2);
+ return(xs);
+ }
+ if (is_pair(a2))
+ return(pair_to_rf(sc, a2, xx));
+ return(NULL);
+ }
+ return(NULL);
+}
#if (!WITH_GMP)
- bool overflow = false;
-#endif
- current_radix = radix; /* current_radix is 10 for the exponent portions, but radix for all the rest */
+typedef struct {s7_rf_t none, r, s, p, rs, rp, ss, sp, pp, rss, rsp, rpp, sss, ssp, spp, ppp;} rf_ops;
+static rf_ops *add_r_ops, *multiply_r_ops;
+
+static s7_rf_t com_rf_2(s7_scheme *sc, s7_pointer expr, rf_ops *a)
+{
+ /* expr len is assumed to be 3 (2 args) */
+ s7_pointer a1, a2, p1 = NULL, p2 = NULL, s1 = NULL, s2 = NULL, c1 = NULL, c2 = NULL;
+ xf_t *rc;
+
+ a1 = cadr(expr);
+ if (is_pair(a1)) p1 = a1; else {if (is_symbol(a1)) s1 = a1; else {if (is_real(a1)) c1 = a1; else return(NULL);}}
+ a2 = caddr(expr);
+ if (is_pair(a2)) p2 = a2; else {if (is_symbol(a2)) s2 = a2; else {if (is_real(a2)) c2 = a2; else return(NULL);}}
- for ( ; (c = *p) != 0; ++p)
- {
- /* what about embedded null? (string->number (string #\1 (integer->char 0) #\0))
- * currently we stop and return 1, but Guile returns #f
- */
- if (!ISDIGIT(c, current_radix)) /* moving this inside the switch statement was much slower */
- {
- current_radix = radix;
-
- switch (c)
- {
- /* -------- decimal point -------- */
- case '.':
- if (((has_dec_point1) ||
- (slash1)) &&
- (has_plus_or_minus == 0)) /* 1.. or 1/2. */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if (((has_dec_point2) ||
- (slash2)) &&
- (has_plus_or_minus != 0)) /* 1+1.. or 1+1/2. */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if ((!ISDIGIT(p[1], current_radix)) &&
- (!ISDIGIT(p[-1], current_radix)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if (has_plus_or_minus == 0)
- has_dec_point1 = true;
- else has_dec_point2 = true;
- continue;
+ xf_init(2);
+ if (!c1) {c1 = c2; c2 = NULL;}
+ if (c2)
+ {
+ if ((is_t_real(c1)) || (is_t_real(c2)))
+ {
+ s7_pointer x;
+ s7_double x1, x2;
+ x1 = real_to_double(sc, c1, (a == add_r_ops) ? "+" : "*");
+ x2 = real_to_double(sc, c2, (a == add_r_ops) ? "+" : "*");
+ if (a == add_r_ops)
+ x = make_real(sc, x1 + x2);
+ else x = make_real(sc, x1 * x2);
+ if (!is_immutable_real(x))
+ xf_push(sc, x);
+ xf_store(x);
+ return(a->r);
+ }
+ return(NULL);
+ }
+ if (!s1) {s1 = s2; s2 = NULL;}
+ if (!p1) {p1 = p2; p2 = NULL;}
+
+ if (s1)
+ {
+ bool s1_real;
+ s1 = s7_slot(sc, s1);
+ if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (is_t_complex(slot_value(s1)))) return(NULL);
+ s1_real = (is_t_real(slot_value(s1)));
+ xf_store(s1);
+ if (s2)
+ {
+ s2 = s7_slot(sc, s2);
+ if ((!is_slot(s2)) || (is_unsafe_stepper(s2)) || (is_t_complex(slot_value(s2)))) return(NULL);
+
+ if ((s1_real) || /* TODO: look at step etc */
+ (is_t_real(slot_value(s2))))
+ {
+ xf_store(s2);
+ return(a->ss);
+ }
+ return(NULL);
+ }
+ if (c1)
+ {
+ if ((s1_real) || (is_t_real(c1)))
+ {
+ xf_store(c1);
+ return(a->rs);
+ }
+ return(NULL);
+ }
+ if (s7_arg_to_rf(sc, p1))
+ return(a->sp);
+ return(NULL);
+ }
-
- /* -------- exponent marker -------- */
- case 'e': case 'E':
-#if WITH_EXTRA_EXPONENT_MARKERS
- case 's': case 'S':
- case 'd': case 'D':
- case 'f': case 'F':
- case 'l': case 'L':
-#endif
- if (current_radix > 10)
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- /* see note above */
-
- current_radix = 10;
-
- if (((ex1) ||
- (slash1)) &&
- (has_plus_or_minus == 0)) /* ee */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if (((ex2) ||
- (slash2)) &&
- (has_plus_or_minus != 0)) /* 1+1.0ee */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if ((!ISDIGIT(p[-1], current_radix)) &&
- (p[-1] != '.'))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if (has_plus_or_minus == 0)
- {
- ex1 = p;
- has_dec_point1 = true; /* decimal point illegal from now on */
- }
- else
- {
- ex2 = p;
- has_dec_point2 = true;
- }
- p++;
- if ((*p == '-') || (*p == '+')) p++;
- if (ISDIGIT(*p, current_radix))
- continue;
- break;
+ /* must be p1 here, c1 or p2 */
+ if (c1)
+ {
+ xf_store(c1);
+ if (s7_arg_to_rf(sc, p1))
+ return(a->rp);
+ return(NULL);
+ }
+
+ if ((s7_arg_to_rf(sc, p1)) &&
+ (s7_arg_to_rf(sc, p2)))
+ return(a->pp);
+ return(NULL);
+}
- /* -------- internal + or - -------- */
- case '+':
- case '-':
- if (has_plus_or_minus != 0) /* already have the separator */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if (c == '+') has_plus_or_minus = 1; else has_plus_or_minus = -1;
- plus = (char *)(p + 1);
- continue;
-
- /* ratio marker */
- case '/':
- if ((has_plus_or_minus == 0) &&
- ((ex1) ||
- (slash1) ||
- (has_dec_point1)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if ((has_plus_or_minus != 0) &&
- ((ex2) ||
- (slash2) ||
- (has_dec_point2)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- if (has_plus_or_minus == 0)
- slash1 = (char *)(p + 1);
- else slash2 = (char *)(p + 1);
-
- if ((!ISDIGIT(p[1], current_radix)) ||
- (!ISDIGIT(p[-1], current_radix)))
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- continue;
-
-
- /* -------- i for the imaginary part -------- */
- case 'i':
- if ((has_plus_or_minus != 0) &&
- (!has_i))
- {
- has_i = true;
- continue;
- }
- break;
+static s7_rf_t com_rf_3(s7_scheme *sc, s7_pointer expr, rf_ops *a)
+{
+ /* expr len is assumed to be 4 (3 args) */
+ s7_pointer a1, a2, a3, p1 = NULL, p2 = NULL, p3 = NULL, s1 = NULL, s2 = NULL, s3 = NULL, c1 = NULL, c2 = NULL, c3 = NULL;
+ bool s1_real = false;
+ xf_t *rc;
+
+ a1 = cadr(expr);
+ if (is_pair(a1)) p1 = a1; else {if (is_symbol(a1)) s1 = a1; else {if (is_real(a1)) c1 = a1; else return(NULL);}}
+ a2 = caddr(expr);
+ if (is_pair(a2)) p2 = a2; else {if (is_symbol(a2)) s2 = a2; else {if (is_real(a2)) c2 = a2; else return(NULL);}}
+ a3 = cadddr(expr);
+ if (is_pair(a3)) p3 = a3; else {if (is_symbol(a3)) s3 = a3; else {if (is_real(a3)) c3 = a3; else return(NULL);}}
+
+ if (!s2) {s2 = s3; s3 = NULL;}
+ if (!s1) {s1 = s2; s2 = s3; s3 = NULL;}
- default:
- break;
- }
+ xf_init(3);
+ if (s1)
+ {
+ s1 = s7_slot(sc, s1);
+ if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (is_t_complex(slot_value(s1)))) return(NULL);
+ s1_real = (is_t_real(slot_value(s1)));
+ xf_store(s1);
+ }
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
- }
- }
-
- if ((has_plus_or_minus != 0) && /* that is, we have an internal + or - */
- (!has_i)) /* but no i for the imaginary part */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ if (!p2) {p2 = p3; p3 = NULL;}
+ if (!p1) {p1 = p2; p2 = p3; p3 = NULL;}
- if (has_i)
- {
-#if (!WITH_GMP)
- s7_Double rl = 0.0, im = 0.0;
-#else
- char e1 = 0, e2 = 0;
-#endif
- s7_pointer result;
- int len;
- char ql1, pl1;
-
- len = safe_strlen(q);
-
- if (q[len - 1] != 'i')
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
- /* save original string */
- ql1 = q[len - 1];
- pl1 = (*(plus - 1));
-#if WITH_GMP
- if (ex1) {e1 = *ex1; (*ex1) = 'e';} /* for mpfr */
- if (ex2) {e2 = *ex2; (*ex2) = 'e';}
-#endif
-
- /* look for cases like 1+i */
- if ((q[len - 2] == '+') || (q[len - 2] == '-'))
- q[len - 1] = '1';
- else q[len - 1] = '\0'; /* remove 'i' */
-
- (*((char *)(plus - 1))) = '\0';
-
- /* there is a slight inconsistency here:
- 1/0 -> nan.0
- 1/0+0i -> inf.0 (0/1+0i is 0.0)
- #i1/0+0i -> inf.0
- 0/0 -> nan.0
- 0/0+0i -> -nan.0
- */
+ if (!c2) {c2 = c3; c3 = NULL;}
+ if (!c1) {c1 = c2; c2 = c3; c3 = NULL;}
+ if (c2)
+ {
+ if ((is_t_real(c1)) || (is_t_real(c2)) || ((c3) && (is_t_real(c3))))
+ {
+ s7_pointer x;
+ s7_double x1, x2, x3;
+ x1 = real_to_double(sc, c1, (a == add_r_ops) ? "+" : "*");
+ x2 = real_to_double(sc, c2, (a == add_r_ops) ? "+" : "*");
+ if (c3) x3 = real_to_double(sc, c3, (a == add_r_ops) ? "+" : "*"); else x3 = ((a == add_r_ops) ? 0.0 : 1.0);
+ if (a == add_r_ops)
+ x = make_real(sc, x1 + x2 + x3);
+ else x = make_real(sc, x1 * x2 * x3);
+ if (!is_immutable_real(x))
+ xf_push(sc, x);
+ xf_store(x);
+ if (c3) return(a->r);
+ if (s1) return(a->rs);
+ if (s7_arg_to_rf(sc, p1))
+ return(a->rp);
+ }
+ return(NULL);
+ }
-#if (!WITH_GMP)
- if ((has_dec_point1) ||
- (ex1))
- {
- /* (string->number "1100.1+0.11i" 2) -- need to split into 2 honest reals before passing to non-base-10 str->dbl */
- rl = string_to_double_with_radix(q, radix, &overflow);
- }
- else
- {
- if (slash1)
- {
- /* here the overflow could be innocuous if it's in the denominator and the numerator is 0
- * 0/100000000000000000000000000000000000000-0i
- */
- s7_Int num, den;
- num = string_to_integer(q, radix, &overflow);
- den = string_to_integer(slash1, radix, &overflow);
-
- if ((num == 0) && (den != 0))
- {
- rl = 0.0;
- overflow = false;
- }
- else rl = (s7_Double)num / (s7_Double)den;
- }
- else rl = (s7_Double)string_to_integer(q, radix, &overflow);
- if (overflow) return(s7_make_real(sc, NAN));
- }
- if (rl == -0.0) rl = 0.0;
-
- if ((has_dec_point2) ||
- (ex2))
- im = string_to_double_with_radix(plus, radix, &overflow);
- else
- {
- if (slash2)
- {
- /* same as above: 0-0/100000000000000000000000000000000000000i
- */
- s7_Int num, den;
- num = string_to_integer(plus, radix, &overflow);
- den = string_to_integer(slash2, radix, &overflow);
- if ((num == 0) && (den != 0))
- {
- im = 0.0;
- overflow = false;
- }
- else im = (s7_Double)num / (s7_Double)den;
- }
- else im = (s7_Double)string_to_integer(plus, radix, &overflow);
- if (overflow) return(s7_make_real(sc, NAN));
- }
- if ((has_plus_or_minus == -1) &&
- (im != 0.0))
- im = -im;
- result = s7_make_complex(sc, rl, im);
-#else
- result = string_to_either_complex(sc, q, slash1, ex1, has_dec_point1, plus, slash2, ex2, has_dec_point2, radix, has_plus_or_minus);
-#endif
-
- /* restore original string */
- q[len - 1] = ql1;
- (*((char *)(plus - 1))) = pl1;
-#if WITH_GMP
- if (ex1) (*ex1) = e1;
- if (ex2) (*ex2) = e2;
-#endif
-
- return(result);
- }
-
- /* not complex */
- if ((has_dec_point1) ||
- (ex1))
- {
- s7_pointer result;
-
- if (slash1) /* not complex, so slash and "." is not a number */
- return((want_symbol) ? make_symbol(sc, q) : sc->F);
-
-#if (!WITH_GMP)
- result = s7_make_real(sc, string_to_double_with_radix(q, radix, &overflow));
-#else
+ if (s1)
+ {
+ if (s2)
{
- char old_e = 0;
- if (ex1)
+ bool s2_real;
+ s2 = s7_slot(sc, s2);
+ if ((!is_slot(s2)) || (is_unsafe_stepper(s2)) || (is_t_complex(slot_value(s2)))) return(NULL);
+ s2_real = (is_t_real(slot_value(s2)));
+ xf_store(s2);
+ if (s3)
{
- old_e = (*ex1);
- (*ex1) = 'e';
+ s3 = s7_slot(sc, s3);
+ if ((!is_slot(s3)) || (is_unsafe_stepper(s3)) || (is_t_complex(slot_value(s3)))) return(NULL);
+ if ((s1_real) || (s2_real) || (is_t_real(slot_value(s3))))
+ {
+ xf_store(s3);
+ return(a->sss);
+ }
+ return(NULL);
}
- result = string_to_either_real(sc, q, radix);
- if (ex1)
- (*ex1) = old_e;
+ if (c1)
+ {
+ if ((s1_real) || (s2_real) || (is_t_real(c1)))
+ {
+ xf_store(c1);
+ return(a->rss);
+ }
+ return(NULL);
+ }
+ if (s7_arg_to_rf(sc, p1))
+ return(a->ssp);
+ return(NULL);
}
-#endif
- return(result);
- }
-
- /* not real */
- if (slash1)
-#if (!WITH_GMP)
- {
- s7_Int n, d;
-
- n = string_to_integer(q, radix, &overflow);
- d = string_to_integer(slash1, radix, &overflow);
-
- if ((n == 0) && (d != 0)) /* 0/100000000000000000000000000000000000000 */
- return(small_int(0));
- if ((d == 0) || (overflow))
- return(s7_make_real(sc, NAN));
- /* it would be neat to return 1 from 10000000000000000000000000000/10000000000000000000000000000
- * but q is the entire number ('/' included) and slash1 is the stuff after the '/', and every
- * big number comes through here, so there's no clean and safe way to check that q == slash1.
- */
- return(s7_make_ratio(sc, n, d));
- }
-#else
- return(string_to_either_ratio(sc, q, slash1, radix));
-#endif
-
- /* integer */
-#if (!WITH_GMP)
+ if (c1)
+ {
+ xf_store(c1);
+ if (s7_arg_to_rf(sc, p1))
+ return(a->rsp);
+ return(NULL);
+ }
+ if ((s7_arg_to_rf(sc, p1)) &&
+ (s7_arg_to_rf(sc, p2)))
+ return(a->spp);
+ return(NULL);
+ }
+
+ if (c1)
{
- s7_Int x;
- x = string_to_integer(q, radix, &overflow);
- if (overflow)
- return(s7_make_real(sc, (q[0] == '-') ? -INFINITY : INFINITY)); /* was NaN */
- return(s7_make_integer(sc, x));
+ xf_store(c1);
+ if ((s7_arg_to_rf(sc, p1)) &&
+ (s7_arg_to_rf(sc, p2)))
+ return(a->rpp);
+ return(NULL);
}
-#else
- return(string_to_either_integer(sc, q, radix));
-#endif
- }
-}
-
-static s7_pointer s7_string_to_number(s7_scheme *sc, char *str, int radix)
-{
- s7_pointer x;
- x = make_atom(sc, str, radix, NO_SYMBOLS);
- if (s7_is_number(x)) /* only needed because str might start with '#' and not be a number (#t for example) */
- return(x);
- return(sc->F);
+ if ((s7_arg_to_rf(sc, p1)) &&
+ (s7_arg_to_rf(sc, p2)) &&
+ (s7_arg_to_rf(sc, p3)))
+ return(a->ppp);
+ return(NULL);
}
+typedef struct {s7_if_t none, r, s, p, rs, rp, ss, sp, pp, rss, rsp, rpp, sss, ssp, spp, ppp;} if_ops;
+static if_ops *add_i_ops, *multiply_i_ops;
-static s7_pointer g_string_to_number_1(s7_scheme *sc, s7_pointer args, const char *caller)
+static s7_if_t com_if_2(s7_scheme *sc, s7_pointer expr, if_ops *a)
{
- #define H_string_to_number "(string->number str (radix 10)) converts str into a number. \
-If str does not represent a number, string->number returns #f. If 'str' has an embedded radix, \
-the 'radix' argument is ignored: (string->number \"#x11\" 2) -> 17 not 3."
-
- s7_Int radix = 0;
- char *str;
+ /* expr len is assumed to be 3 (2 args) */
+ s7_pointer a1, a2, p1 = NULL, p2 = NULL, s1 = NULL, s2 = NULL, c1 = NULL, c2 = NULL;
+ xf_t *rc;
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, caller, (cdr(args) == sc->NIL) ? 0 : 1, car(args), "a string"));
-
- str = (char *)string_value(car(args));
- if ((!str) || (!(*str)))
- return(sc->F);
-
- if (is_pair(cdr(args)))
+ a1 = cadr(expr);
+ if (is_pair(a1)) p1 = a1; else {if (is_symbol(a1)) s1 = a1; else {if (is_real(a1)) c1 = a1; else return(NULL);}}
+ a2 = caddr(expr);
+ if (is_pair(a2)) p2 = a2; else {if (is_symbol(a2)) s2 = a2; else {if (is_real(a2)) c2 = a2; else return(NULL);}}
+
+ xf_init(2);
+ if (!c1) {c1 = c2; c2 = NULL;}
+ if ((c1) && (!is_t_integer(c1))) return(NULL);
+ if (c2)
{
- if (!s7_is_integer(cadr(args)))
- return(s7_wrong_type_arg_error(sc, caller, 2, cadr(args), "an integer"));
-
- if (s7_is_integer(cadr(args)))
- radix = s7_integer(cadr(args));
- if ((radix < 2) || /* what about negative int as base (Knuth), reals such as phi, and some complex like -1+i */
- (radix > 16)) /* the only problem here is printing the number; perhaps put each digit in "()" in base 10: (123)(0)(34) */
- return(s7_out_of_range_error(sc, caller, 2, cadr(args), "should be between 2 and 16"));
+ s7_pointer x;
+ if (!(is_t_integer(c2))) return(NULL);
+ if (a == add_i_ops)
+ x = make_integer(sc, integer(c1) + integer(c2));
+ else x = make_integer(sc, integer(c1) * integer(c2));
+ if (!is_immutable_integer(x))
+ xf_push(sc, x);
+ xf_store(x);
+ return(a->r);
+ }
+ if (!s1) {s1 = s2; s2 = NULL;}
+ if (!p1) {p1 = p2; p2 = NULL;}
+
+ if (s1)
+ {
+ s1 = s7_slot(sc, s1);
+ if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (!is_t_integer(slot_value(s1)))) return(NULL);
+ xf_store(s1);
+ if (s2)
+ {
+ s2 = s7_slot(sc, s2);
+ if ((!is_slot(s2)) || (is_unsafe_stepper(s2)) || (!is_t_integer(slot_value(s2)))) return(NULL);
+ xf_store(s2);
+ return(a->ss);
+ }
+ if (c1)
+ {
+ xf_store(c1);
+ return(a->rs);
+ }
+ if (s7_arg_to_if(sc, p1))
+ return(a->sp);
+ return(NULL);
}
- else radix = 10;
- switch (str[0])
+ /* must be p1 here, c1 or p2 */
+ if (c1)
{
- case 'n':
- if (safe_strcmp(str, "nan.0") == 0)
- return(s7_make_real(sc, NAN));
- break;
+ xf_store(c1);
+ if (s7_arg_to_if(sc, p1))
+ return(a->rp);
+ return(NULL);
+ }
+
+ if ((s7_arg_to_if(sc, p1)) &&
+ (s7_arg_to_if(sc, p2)))
+ return(a->pp);
- case 'i':
- if (safe_strcmp(str, "inf.0") == 0)
- return(s7_make_real(sc, INFINITY));
- break;
+ return(NULL);
+}
- case '-':
- if ((str[1] == 'i') && (safe_strcmp((const char *)(str + 1), "inf.0") == 0))
- return(s7_make_real(sc, -INFINITY));
- break;
+static s7_if_t com_if_3(s7_scheme *sc, s7_pointer expr, if_ops *a)
+{
+ /* expr len is assumed to be 4 (3 args) */
+ s7_pointer a1, a2, a3, p1 = NULL, p2 = NULL, p3 = NULL, s1 = NULL, s2 = NULL, s3 = NULL, c1 = NULL, c2 = NULL, c3 = NULL;
+ xf_t *rc;
- case '+':
- if ((str[1] == 'i') && (safe_strcmp((const char *)(str + 1), "inf.0") == 0))
- return(s7_make_real(sc, INFINITY));
- break;
+ a1 = cadr(expr);
+ if (is_pair(a1)) p1 = a1; else {if (is_symbol(a1)) s1 = a1; else {if (is_real(a1)) c1 = a1; else return(NULL);}}
+ a2 = caddr(expr);
+ if (is_pair(a2)) p2 = a2; else {if (is_symbol(a2)) s2 = a2; else {if (is_real(a2)) c2 = a2; else return(NULL);}}
+ a3 = cadddr(expr);
+ if (is_pair(a3)) p3 = a3; else {if (is_symbol(a3)) s3 = a3; else {if (is_real(a3)) c3 = a3; else return(NULL);}}
+
+ xf_init(3);
+ if (!s2) {s2 = s3; s3 = NULL;}
+ if (!s1) {s1 = s2; s2 = s3; s3 = NULL;}
+ if (s1)
+ {
+ s1 = s7_slot(sc, s1);
+ if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (!is_t_integer(slot_value(s1)))) return(NULL);
+ xf_store(s1);
}
- return(s7_string_to_number(sc, str, radix));
+ if (!p2) {p2 = p3; p3 = NULL;}
+ if (!p1) {p1 = p2; p2 = p3; p3 = NULL;}
+
+ if (!c2) {c2 = c3; c3 = NULL;}
+ if (!c1) {c1 = c2; c2 = c3; c3 = NULL;}
+ if (c1)
+ {
+ if (!is_t_integer(c1)) return(NULL);
+ if (c2)
+ {
+ s7_pointer x;
+ if (!is_t_integer(c2)) return(NULL);
+ if ((c3) && (!is_t_integer(c3))) return(NULL);
+ if (a == add_i_ops)
+ x = make_integer(sc, integer(c1) + integer(c2) + ((c3) ? integer(c3) : 0));
+ else x = make_integer(sc, integer(c1) * integer(c2) * ((c3) ? integer(c3) : 1));
+ if (!is_immutable_integer(x))
+ xf_push(sc, x);
+ xf_store(x);
+ if (c3) return(a->r);
+ if (s1) return(a->rs);
+ if (s7_arg_to_if(sc, p1))
+ return(a->rp);
+ }
+ return(NULL);
+ }
+
+ if (s1)
+ {
+ if (s2)
+ {
+ s2 = s7_slot(sc, s2);
+ if ((!is_slot(s2)) || (is_unsafe_stepper(s2)) || (!is_t_integer(slot_value(s2)))) return(NULL);
+ xf_store(s2);
+ if (s3)
+ {
+ s3 = s7_slot(sc, s3);
+ if ((!is_slot(s3)) || (is_unsafe_stepper(s3)) || (!is_t_integer(slot_value(s3)))) return(NULL);
+ xf_store(s3);
+ return(a->sss);
+ }
+ if (c1)
+ {
+ xf_store(c1);
+ return(a->rss);
+ }
+ if (s7_arg_to_if(sc, p1))
+ return(a->ssp);
+ return(NULL);
+ }
+ if (c1)
+ {
+ xf_store(c1);
+ if (s7_arg_to_if(sc, p1))
+ return(a->rsp);
+ return(NULL);
+ }
+ if ((s7_arg_to_if(sc, p1)) &&
+ (s7_arg_to_if(sc, p2)))
+ return(a->spp);
+ return(NULL);
+ }
+
+ if (c1)
+ {
+ xf_store(c1);
+ if ((s7_arg_to_if(sc, p1)) &&
+ (s7_arg_to_if(sc, p2)))
+ return(a->rpp);
+ return(NULL);
+ }
+
+ if ((s7_arg_to_if(sc, p1)) &&
+ (s7_arg_to_if(sc, p2)) &&
+ (s7_arg_to_if(sc, p3)))
+ return(a->ppp);
+ return(NULL);
+}
+#endif
+
+#if WITH_OPTIMIZATION
+static s7_double set_rf_sr(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, c1;
+ s7_double x;
+ s1 = (**p); (*p)++;
+ c1 = (**p); (*p)++;
+ x = real(c1);
+ slot_set_value(s1, make_real(sc, x));
+ return(x);
}
+#if 0
+static s7_double set_rf_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s7_double x;
+ s1 = (**p); (*p)++;
+ s2 = (**p); (*p)++;
+ x = real_to_double(sc, slot_value(s2), "set!");
+ slot_set_value(s1, make_real(sc, x));
+ return(x);
+}
+#endif
-static s7_pointer g_string_to_number(s7_scheme *sc, s7_pointer args)
+static s7_double set_rf_sx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_double x;
+ s7_rf_t r1;
+ s1 = (**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ slot_set_value(s1, make_real(sc, x));
+ return(x);
+}
+
+static s7_int set_if_sx(s7_scheme *sc, s7_pointer **p)
{
- return(g_string_to_number_1(sc, args, "string->number"));
+ s7_pointer s1;
+ s7_int x;
+ s7_if_t i1;
+ s1 = (**p); (*p)++;
+ i1 = (s7_if_t)(**p); (*p)++;
+ x = i1(sc, p);
+ slot_set_value(s1, make_integer(sc, x));
+ return(x);
}
+static s7_rf_t float_vector_set_rf_expanded(s7_scheme *sc, s7_pointer fv, s7_pointer ind_sym, s7_pointer val_expr);
+static s7_if_t int_vector_set_if_expanded(s7_scheme *sc, s7_pointer iv, s7_pointer ind_sym, s7_pointer val_expr);
-static bool numbers_are_eqv(s7_pointer a, s7_pointer b)
+static s7_rf_t set_rf(s7_scheme *sc, s7_pointer expr)
{
- if (number_type(a) != number_type(b)) /* (eqv? 1 1.0) -> #f! */
- return(false);
+ s7_pointer slot, a1;
+ xf_t *rc;
- switch (number_type(a))
+ if (is_pair(cdddr(expr))) return(NULL);
+ a1 = cadr(expr);
+ if (!is_symbol(a1)) /* look for implicit index case */
{
- case NUM_INT:
- return((integer(number(a)) == integer(number(b))));
-
- case NUM_RATIO:
- return((numerator(number(a)) == numerator(number(b))) &&
- (denominator(number(a)) == denominator(number(b))));
+ s7_pointer fv;
+ if ((!is_pair(a1)) || (!is_symbol(car(a1))) || (!is_null(cddr(a1)))) return(NULL);
+ fv = s7_symbol_value(sc, car(a1));
+ if (is_float_vector(fv))
+ return(float_vector_set_rf_expanded(sc, fv, cadr(a1), caddr(expr)));
+ if ((is_c_object(fv)) &&
+ (c_object_set_rp(fv)))
+ return(c_object_set_rp(fv)(sc, expr));
+ return(NULL);
+ }
- case NUM_REAL:
- case NUM_REAL2:
- return(real(number(a)) == real(number(b)));
-
- default:
- return((real_part(number(a)) == real_part(number(b))) &&
- (imag_part(number(a)) == imag_part(number(b))));
+ /* if sym has real value and new val is real, we're ok */
+ slot = s7_slot(sc, a1);
+ if (!is_slot(slot)) return(NULL);
+
+ xf_init(2);
+ if (is_t_real(slot_value(slot)))
+ {
+ s7_pointer a2;
+ xf_store(slot);
+ a2 = caddr(expr);
+ if (is_t_real(a2))
+ {
+ xf_store(a2);
+ return(set_rf_sr);
+ }
+#if 0
+ if (is_symbol(a2))
+ {
+ s7_pointer a2_slot;
+ a2_slot = s7_slot(sc, a2);
+ if (!is_slot(a2_slot)) return(NULL);
+ if (type(slot_value(a2_slot)) != T_REAL) return(NULL);
+ xf_store(a2_slot);
+ return(set_rf_ss);
+ }
+#endif
+ if (is_pair(a2))
+ {
+ s7_rp_t rp;
+ s7_rf_t rf;
+ s7_int loc;
+ xf_save_loc(loc);
+ rp = pair_to_rp(sc, a2);
+ if (!rp) return(NULL);
+ rf = rp(sc, a2);
+ if (!rf) return(NULL);
+ xf_store_at(loc, (s7_pointer)rf);
+ return(set_rf_sx);
+ }
}
-
- return(false);
+ return(NULL);
}
-
-#if (!WITH_GMP)
-static s7_pointer g_abs(s7_scheme *sc, s7_pointer args)
+static s7_if_t set_if(s7_scheme *sc, s7_pointer expr)
{
- #define H_abs "(abs x) returns the absolute value of the real number x"
- s7_num_t n;
+ s7_pointer slot, a1;
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, "abs", 0, car(args), "a real"));
+ if (is_pair(cdddr(expr))) return(NULL);
+ a1 = cadr(expr);
- n = number(car(args));
- switch (num_type(n))
+ if (!is_symbol(a1)) /* look for implicit index case */
{
- case NUM_INT:
- /* as in exact->inexact, (abs most-negative-fixnum) is a bother */
- return(s7_make_integer(sc, s7_Int_abs(integer(n))));
+ s7_pointer fv;
+ if ((!is_pair(a1)) || (!is_symbol(car(a1))) || (!is_null(cddr(a1)))) return(NULL);
+ fv = s7_symbol_value(sc, car(a1));
+ if (is_int_vector(fv))
+ return(int_vector_set_if_expanded(sc, fv, cadr(a1), caddr(expr)));
+ if ((is_c_object(fv)) &&
+ (c_object_set_ip(fv)))
+ return(c_object_set_ip(fv)(sc, expr));
+ return(NULL);
+ }
- case NUM_RATIO:
- return(s7_make_ratio(sc, s7_Int_abs(numerator(n)), denominator(n)));
+ if (!is_symbol(a1)) return(NULL);
+ slot = s7_slot(sc, a1);
+ if (!is_slot(slot)) return(NULL);
- case NUM_REAL2:
- case NUM_REAL:
- return(s7_make_real(sc, s7_Double_abs(real(n))));
+ if (is_t_integer(slot_value(slot)))
+ {
+ s7_pointer a2;
+ xf_t *rc;
+ xf_init(1);
+ xf_store(slot);
+ a2 = caddr(expr);
+ if ((is_pair(a2)) &&
+ (s7_arg_to_if(sc, a2)))
+ return(set_if_sx);
}
- return(sc->NIL); /* make compiler happy */
+ return(NULL);
}
-
-static s7_pointer g_magnitude(s7_scheme *sc, s7_pointer args)
+static s7_pf_t set_pf(s7_scheme *sc, s7_pointer expr)
{
- #define H_magnitude "(magnitude z) returns the magnitude of z"
- s7_num_t n;
-
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "magnitude", 0, car(args), "a number"));
+ s7_pointer a1;
+ if (is_pair(cdddr(expr))) return(NULL);
+ a1 = cadr(expr);
+ if (is_pair(a1)) /* look for implicit index case */
+ {
+ s7_pointer v;
+ if ((!is_symbol(car(a1))) || (!is_pair(cdr(a1))) || (!is_null(cddr(a1)))) return(NULL);
+ v = s7_slot(sc, car(a1));
+ if (!is_slot(v)) return(NULL);
+ switch (type(slot_value(v)))
+ {
+ case T_PAIR: case T_STRING: case T_VECTOR: case T_HASH_TABLE: case T_LET:
+ return(implicit_pf_sequence_set(sc, v, cadr(a1), caddr(expr)));
- n = number(car(args));
- if (num_type(n) < NUM_COMPLEX)
- return(g_abs(sc, args));
-
- return(s7_make_real(sc, hypot(imag_part(n), real_part(n))));
+ case T_INT_VECTOR: case T_FLOAT_VECTOR:
+ return(implicit_gf_sequence_set(sc, v, cadr(a1), caddr(expr)));
+ }
+ }
+ return(NULL);
}
+#endif
+typedef s7_pointer (*p0_pf_t)(s7_scheme *sc);
+static s7_pointer p0_pf_1(s7_scheme *sc, s7_pointer **p, p0_pf_t fnc)
+{
+ return(fnc(sc));
+}
-static s7_pointer g_angle(s7_scheme *sc, s7_pointer args)
+static s7_pf_t pf_0(s7_scheme *sc, s7_pointer expr, s7_pf_t fnc)
{
- #define H_angle "(angle z) returns the angle of z"
- s7_pointer x;
- s7_Double f;
+ if (!is_null(cdr(expr))) return(NULL);
+ return(fnc);
+}
- /* (angle inf+infi) -> 0.78539816339745 ? */
+#define PF_0(CName, Pfnc) \
+ static s7_pointer CName ## _pf_0(s7_scheme *sc, s7_pointer **rp) {return(p0_pf_1(sc, rp, Pfnc));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pf_0(sc, expr, CName ## _pf_0));}
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "angle", 0, x, "a number"));
+PF_0(curlet, s7_curlet)
+PF_0(rootlet, s7_rootlet)
+PF_0(current_input_port, s7_current_input_port)
+PF_0(current_output_port, s7_current_output_port)
+PF_0(current_error_port, s7_current_error_port)
- if (!s7_is_real(x))
- return(s7_make_real(sc, atan2(complex_imag_part(x), complex_real_part(x))));
+static s7_pointer c_unlet(s7_scheme *sc) {return(g_unlet(sc, sc->NIL));}
+PF_0(unlet, c_unlet)
+static s7_pointer c_gc(s7_scheme *sc) {return(g_gc(sc, sc->NIL));}
+PF_0(gc, c_gc)
- f = num_to_real(number(x));
- if (isnan(f)) return(x);
- if (f < 0.0)
- return(s7_make_real(sc, M_PI));
- if (number_type(x) <= NUM_RATIO)
- return(small_int(0));
+/* -------- PF_TO_PF -------- */
+typedef s7_pointer (*pf_pf_t)(s7_scheme *sc, s7_pointer x);
+static s7_pointer pf_pf_1(s7_scheme *sc, s7_pointer **p, pf_pf_t fnc)
+{
+ s7_pf_t f;
+ s7_pointer x;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(fnc(sc, x));
+}
+
+static s7_pointer pf_pf_s(s7_scheme *sc, s7_pointer **p, pf_pf_t fnc)
+{
+ s7_pointer x;
+ (*p)++; x = slot_value(**p); (*p)++;
+ return(fnc(sc, x));
+}
- return(real_zero);
+static s7_pf_t pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ {
+ ptr_int loc;
+ s7_pointer a1;
+ a1 = cadr(expr);
+ loc = rc_loc(sc);
+ if (s7_arg_to_pf(sc, a1)) return((is_symbol(a1)) ? f2 : f1);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_gf(sc, a1)) return((is_symbol(a1)) ? f2 : f1);
+ }
+ return(NULL);
}
+#define PF_TO_PF(CName, Pfnc) \
+ static s7_pointer CName ## _pf_p(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_1(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_s(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_s(sc, rp, Pfnc));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pf_1(sc, expr, CName ## _pf_p, CName ## _pf_s));}
+
+static s7_pointer c_symbol_to_value(s7_scheme *sc, s7_pointer x) {return(g_symbol_to_value(sc, set_plist_1(sc, x)));}
+PF_TO_PF(symbol_to_value, c_symbol_to_value)
+static s7_pointer c_symbol_to_string(s7_scheme *sc, s7_pointer p) {return(g_symbol_to_string(sc, set_plist_1(sc, p)));}
+PF_TO_PF(symbol_to_string, c_symbol_to_string)
+static s7_pointer c_gensym(s7_scheme *sc, s7_pointer p) {return(g_gensym(sc, set_plist_1(sc, p)));}
+PF_TO_PF(gensym, c_gensym)
+
+static s7_pointer c_not(s7_scheme *sc, s7_pointer x) {return((x == sc->F) ? sc->T : sc->F);}
+PF_TO_PF(not, c_not)
+PF_TO_PF(outlet, s7_outlet)
+PF_TO_PF(openlet, s7_openlet)
+PF_TO_PF(funclet, s7_funclet)
+PF_TO_PF(coverlet, c_coverlet)
+
+#define bool_with_method(Name, Checker, Method) \
+ static s7_pointer c_ ## Name (s7_scheme *sc, s7_pointer p) \
+ { \
+ s7_pointer func; \
+ if (Checker(p)) return(sc->T); \
+ if ((has_methods(p)) && \
+ ((func = find_method(sc, find_let(sc, p), Method)) != sc->UNDEFINED)) \
+ return(s7_apply_function(sc, func, list_1(sc, p))); \
+ return(sc->F); \
+ } \
+ PF_TO_PF(Name, c_ ## Name)
+
+bool_with_method(is_char, s7_is_character, sc->IS_CHAR)
+bool_with_method(is_boolean, s7_is_boolean, sc->IS_BOOLEAN)
+bool_with_method(is_byte_vector, is_byte_vector, sc->IS_BYTE_VECTOR)
+bool_with_method(is_complex, is_number, sc->IS_COMPLEX)
+bool_with_method(is_constant, s7_is_constant, sc->IS_CONSTANT)
+bool_with_method(is_continuation, is_continuation, sc->IS_CONTINUATION)
+bool_with_method(is_c_pointer, s7_is_c_pointer, sc->IS_C_POINTER)
+bool_with_method(is_dilambda, s7_is_dilambda, sc->IS_DILAMBDA)
+bool_with_method(is_eof_object, is_eof, sc->IS_EOF_OBJECT)
+bool_with_method(is_float_vector, is_float_vector, sc->IS_FLOAT_VECTOR)
+bool_with_method(is_gensym, is_gensym, sc->IS_GENSYM)
+bool_with_method(is_hash_table, is_hash_table, sc->IS_HASH_TABLE)
+bool_with_method(is_input_port, is_input_port, sc->IS_INPUT_PORT)
+bool_with_method(is_integer, is_integer, sc->IS_INTEGER)
+bool_with_method(is_int_vector, is_int_vector, sc->IS_INT_VECTOR)
+bool_with_method(is_iterator, is_iterator, sc->IS_ITERATOR)
+bool_with_method(is_keyword, is_keyword, sc->IS_KEYWORD)
+bool_with_method(is_let, is_let, sc->IS_LET)
+bool_with_method(is_macro, is_macro, sc->IS_MACRO)
+bool_with_method(is_null, is_null, sc->IS_NULL)
+bool_with_method(is_number, is_number, sc->IS_NUMBER)
+bool_with_method(is_openlet, s7_is_openlet, sc->IS_OPENLET)
+bool_with_method(is_output_port, is_output_port, sc->IS_OUTPUT_PORT)
+bool_with_method(is_pair, is_pair, sc->IS_PAIR)
+bool_with_method(is_procedure, is_procedure, sc->IS_PROCEDURE)
+bool_with_method(is_rational, is_rational, sc->IS_RATIONAL)
+bool_with_method(is_real, is_real, sc->IS_REAL)
+bool_with_method(is_string, is_string, sc->IS_STRING)
+bool_with_method(is_symbol, is_symbol, sc->IS_SYMBOL)
+bool_with_method(is_vector, s7_is_vector, sc->IS_VECTOR)
+#define opt_is_list(p) s7_is_list(sc, p)
+bool_with_method(is_list, opt_is_list, sc->IS_LIST)
+bool_with_method(iterator_is_at_end, iterator_is_at_end, sc->ITERATOR_IS_AT_END)
+bool_with_method(is_random_state, is_random_state, sc->IS_RANDOM_STATE)
+
+PF_TO_PF(make_keyword, c_make_keyword)
+PF_TO_PF(keyword_to_symbol, c_keyword_to_symbol)
+PF_TO_PF(symbol_to_keyword, c_symbol_to_keyword)
+
+static s7_pointer c_symbol(s7_scheme *sc, s7_pointer x) {return(g_string_to_symbol_1(sc, x, sc->SYMBOL));}
+PF_TO_PF(symbol, c_symbol)
-static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args)
+#if 0
+static s7_pointer symbol_pf_p(s7_scheme *sc, s7_pointer **p)
{
- #define H_rationalize "(rationalize x err) returns the ratio with lowest denominator within err of x"
- s7_Double err, rat;
- s7_Int numer = 0, denom = 1;
+ s7_pf_t f;
s7_pointer x;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(g_string_to_symbol_1(sc, x, sc->SYMBOL));
+}
+#endif
- x = car(args);
- if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "rationalize", (cdr(args) == sc->NIL) ? 0 : 1, x, "a real"));
+/* an experiment -- we need a temp pointer per func? */
+static s7_pointer string_to_symbol_pf_p(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t f;
+ s7_pointer x;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(g_string_to_symbol_1(sc, x, sc->STRING_TO_SYMBOL));
+}
- if (cdr(args) != sc->NIL)
- {
- if (!s7_is_real(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "rationalize error limit,", 2, cadr(args), "a real"));
- err = s7_number_to_real(cadr(args));
- if (isnan(err))
- return(s7_out_of_range_error(sc, "rationalize", 2, cadr(args), "error term is NaN"));
- if (err < 0.0) err = -err;
- }
- else err = default_rationalize_error;
+static s7_pointer number_to_string_pf_p(s7_scheme *sc, s7_pointer **p);
+static s7_pointer number_to_string_pf_s(s7_scheme *sc, s7_pointer **p);
+static s7_pointer number_to_string_pf_temp(s7_scheme *sc, s7_pointer **p);
+static s7_pointer number_to_string_pf_s_temp(s7_scheme *sc, s7_pointer **p);
- if (s7_is_integer(x))
+static s7_pf_t string_to_symbol_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
{
- s7_Int a, b, pa;
- if (err < 1.0) return(x);
- a = s7_integer(x);
- if (a < 0) pa = -a; else pa = a;
- if (err >= pa) return(small_int(0));
- b = (s7_Int)err;
- pa -= b;
- if (a < 0)
- return(s7_make_integer(sc, -pa));
- return(s7_make_integer(sc, pa));
+ ptr_int loc;
+ loc = rc_loc(sc);
+ if (s7_arg_to_pf(sc, cadr(expr)))
+ return(string_to_symbol_pf_p);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_gf(sc, cadr(expr)))
+ {
+ if (sc->cur_rf->data[loc] == (s7_pointer)number_to_string_pf_p)
+ sc->cur_rf->data[loc] = (s7_pointer)number_to_string_pf_temp;
+ if (sc->cur_rf->data[loc] == (s7_pointer)number_to_string_pf_s)
+ sc->cur_rf->data[loc] = (s7_pointer)number_to_string_pf_s_temp;
+ return(string_to_symbol_pf_p);
+ }
}
+ return(NULL);
+}
- if ((err == 0.0) && /* (rationalize (/ 1 most-positive-fixnum) 0) */
- (s7_is_ratio(x)))
- return(x);
-
- rat = s7_number_to_real(x);
+#if (!WITH_PURE_S7)
+PF_TO_PF(let_to_list, s7_let_to_list)
+#endif
- if ((isnan(rat)) || (isinf(rat)))
- return(s7_wrong_type_arg_error(sc, "rationalize", (cdr(args) == sc->NIL) ? 0 : 1, x, "a normal real"));
- if (isnan(err))
- return(s7_wrong_type_arg_error(sc, "rationalize error limit,", 2, cadr(args), "a normal real"));
- if (err >= s7_Double_abs(rat)) return(small_int(0));
- if ((rat > 9.2233720368548e+18) || (rat < -9.2233720368548e+18))
- return(s7_out_of_range_error(sc, "rationalize", 1, x, "a real between most-negative-fixnum and most-positive-fixnum"));
+/* -------- PF2_TO_PF -------- */
+typedef s7_pointer (*pf2_pf_t)(s7_scheme *sc, s7_pointer x, s7_pointer y);
+static s7_pointer pf2_pf_1(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+{
+ s7_pf_t f;
+ s7_pointer x, y;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ f = (s7_pf_t)(**p); (*p)++;
+ y = f(sc, p);
+ return(fnc(sc, x, y));
+}
- if ((s7_Double_abs(rat) + s7_Double_abs(err)) < 1.0e-18)
- err = 1.0e-18;
- /* (/ 1.0 most-positive-fixnum) is 1.0842021e-19, so if we let err be less than that,
- * (rationalize 1e-19 1e-20) hangs, but this only affects the initial ceiling, I believe.
- */
+static s7_pointer pf2_pf_sp(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+{
+ s7_pf_t f;
+ s7_pointer x, y;
+ x = slot_value(**p); (*p)++;
+ f = (s7_pf_t)(**p); (*p)++;
+ y = f(sc, p);
+ return(fnc(sc, x, y));
+}
- if (s7_Double_abs(rat) < s7_Double_abs(err))
- return(small_int(0));
+static s7_pointer pf2_pf_ss(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+{
+ s7_pointer x, y;
+ x = slot_value(**p); (*p)++;
+ y = slot_value(**p); (*p)++;
+ return(fnc(sc, x, y));
+}
- if (c_rationalize(rat, err, &numer, &denom))
- return(s7_make_ratio(sc, numer, denom));
- return(sc->F);
+static s7_pointer pf2_pf_sc(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+{
+ s7_pointer x, y;
+ x = slot_value(**p); (*p)++;
+ y = (**p); (*p)++;
+ return(fnc(sc, x, y));
}
+static s7_pointer pf2_pf_pc(s7_scheme *sc, s7_pointer **p, pf2_pf_t fnc)
+{
+ s7_pf_t f;
+ s7_pointer x, y;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ y = (**p); (*p)++;
+ return(fnc(sc, x, y));
+}
-static s7_pointer g_make_polar(s7_scheme *sc, s7_pointer args)
+static s7_pf_t pf_2(s7_scheme *sc, s7_pointer expr, s7_pf_t fpp, s7_pf_t fsp, s7_pf_t fss, s7_pf_t fsc, s7_pf_t fpc)
{
- s7_Double ang, mag;
- #define H_make_polar "(make-polar mag ang) returns a complex number with magnitude mag and angle ang"
-
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, "make-polar magnitude,", 1, car(args), "a real"));
- if (!s7_is_real(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "make-polar angle,", 2, cadr(args), "a real"));
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ {
+ s7_pointer a1, a2;
+ xf_t *rc;
- if ((car(args) == small_int(0)) && /* (make-polar 0 1) -> 0 */
- (number_type(cadr(args)) < NUM_REAL))
- return(small_int(0));
+ xf_init(2);
+ a1 = cadr(expr);
+ a2 = caddr(expr);
+ if (is_symbol(a1))
+ {
+ a1 = s7_slot(sc, a1);
+ if (!is_slot(a1)) return(NULL);
+ xf_store(a1);
+ if (is_symbol(a2))
+ {
+ a2 = s7_slot(sc, a2);
+ if (!is_slot(a2)) return(NULL);
+ xf_store(a2);
+ return(fss);
+ }
+ if (is_pair(a2))
+ {
+ if (!s7_arg_to_pf(sc, a2)) return(NULL);
+ return(fsp);
+ }
+ xf_store(a2);
+ return(fsc);
+ }
+ if (s7_arg_to_pf(sc, a1))
+ {
+ if ((!is_pair(a2)) && (!is_symbol(a2)))
+ {
+ xf_store(a2);
+ return(fpc);
+ }
+ if (s7_arg_to_pf(sc, a2))
+ return(fpp);
+ }
+ }
+ return(NULL);
+}
- ang = num_to_real(number(cadr(args)));
+#define PF2_TO_PF(CName, Pfnc) \
+ static s7_pointer CName ## _pf_p2(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_p2_sp(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_sp(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_p2_ss(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_ss(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_p2_sc(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_sc(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_p2_pc(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_pc(sc, rp, Pfnc));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ return(pf_2(sc, expr, CName ## _pf_p2, CName ## _pf_p2_sp, CName ## _pf_p2_ss, CName ## _pf_p2_sc, CName ## _pf_p2_pc));\
+ }
- if (ang == 0.0)
- return(car(args)); /* (make-polar 1 0) -> 1 */
- if ((ang == M_PI) || (ang == -M_PI))
- return(s7_negate(sc, car(args)));
- mag = num_to_real(number(car(args)));
- if ((isnan(mag)) || (isnan(ang)) || (isinf(ang)))
- return(s7_make_real(sc, NAN));
+static s7_pf_t pf_2_x(s7_scheme *sc, s7_pointer expr, bool (*checker)(s7_scheme *sc, s7_pointer obj),
+ s7_pf_t fpp, s7_pf_t fpp_x, s7_pf_t fsp, s7_pf_t fss, s7_pf_t fsc, s7_pf_t fpc, s7_pf_t fpc_x)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ {
+ s7_pointer a1, a2;
+ xf_t *rc;
- return(s7_make_complex(sc, mag * cos(ang), mag * sin(ang)));
- /* since sin is inaccurate for large arguments, so is make-polar:
- * (make-polar 1.0 1e40) -> -0.76267273202438+0.64678458842683i, not 8.218988919070239214448025364432557517335E-1-5.696334009536363273080341815735687231337E-1i
- */
+ xf_init(2);
+ a1 = cadr(expr);
+ a2 = caddr(expr);
+ if (is_symbol(a1))
+ {
+ a1 = s7_slot(sc, a1);
+ if (!is_slot(a1)) return(NULL);
+ xf_store(a1);
+ if (is_symbol(a2))
+ {
+ a2 = s7_slot(sc, a2);
+ if (!is_slot(a2)) return(NULL);
+ xf_store(a2);
+ return(fss);
+ }
+ if (is_pair(a2))
+ {
+ if (!s7_arg_to_pf(sc, a2)) return(NULL);
+ return(fsp);
+ }
+ xf_store(a2);
+ return(fsc);
+ }
+ if (s7_arg_to_pf(sc, a1))
+ {
+ if ((!is_pair(a2)) && (!is_symbol(a2)))
+ {
+ xf_store(a2);
+ if ((checker(sc, a1)) && (checker(sc, a2)))
+ return(fpc_x);
+ return(fpc);
+ }
+ if (s7_arg_to_pf(sc, a2))
+ {
+ if ((checker(sc, a1)) && (checker(sc, a2)))
+ return(fpp_x);
+ return(fpp);
+ }
+ }
+ }
+ return(NULL);
}
+#define PF2_TO_PF_X(CName, Checker, Pfnc1, Pfnc2) \
+ static s7_pointer CName ## _pf_p2_pp(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, Pfnc1));} \
+ static s7_pointer CName ## _pf_p2_ppx(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, Pfnc2));} \
+ static s7_pointer CName ## _pf_p2_pc(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_pc(sc, rp, Pfnc1));} \
+ static s7_pointer CName ## _pf_p2_pcx(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_pc(sc, rp, Pfnc2));} \
+ static s7_pointer CName ## _pf_p2_sp(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_sp(sc, rp, Pfnc1));} \
+ static s7_pointer CName ## _pf_p2_ss(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_ss(sc, rp, Pfnc1));} \
+ static s7_pointer CName ## _pf_p2_sc(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_sc(sc, rp, Pfnc1));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
+ {\
+ return(pf_2_x(sc, expr, Checker, \
+ CName ## _pf_p2_pp, CName ## _pf_p2_ppx, \
+ CName ## _pf_p2_sp, CName ## _pf_p2_ss, CName ## _pf_p2_sc, \
+ CName ## _pf_p2_pc, CName ## _pf_p2_pcx)); \
+ }
+
+
+static s7_pointer c_is_eq(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, x == y));}
+PF2_TO_PF(is_eq, c_is_eq)
+static s7_pointer c_is_eqv(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, s7_is_eqv(x, y)));}
+PF2_TO_PF(is_eqv, c_is_eqv)
+static s7_pointer c_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, s7_is_equal(sc, x, y)));}
+PF2_TO_PF(is_equal, c_is_equal)
+static s7_pointer c_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(make_boolean(sc, s7_is_morally_equal(sc, x, y)));}
+PF2_TO_PF(is_morally_equal, c_is_morally_equal)
+PF2_TO_PF(let_ref, s7_let_ref)
+
+static s7_pointer c_cutlet(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_cutlet(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(cutlet, c_cutlet)
+static s7_pointer c_inlet(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(s7_inlet(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(inlet, c_inlet)
+
+
+/* -------- PF3_TO_PF -------- */
+typedef s7_pointer (*pf3_pf_t)(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_pointer z);
+static s7_pointer pf3_pf_1(s7_scheme *sc, s7_pointer **p, pf3_pf_t fnc)
+{
+ s7_pf_t f;
+ s7_pointer x, y, z;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ f = (s7_pf_t)(**p); (*p)++;
+ y = f(sc, p);
+ f = (s7_pf_t)(**p); (*p)++;
+ z = f(sc, p);
+ return(fnc(sc, x, y, z));
+}
-static s7_pointer g_make_rectangular(s7_scheme *sc, s7_pointer args)
+static s7_pointer pf3_pf_s(s7_scheme *sc, s7_pointer **p, pf3_pf_t fnc)
{
- s7_Double imag;
- #define H_make_rectangular "(make-rectangular x1 x2) returns a complex number with real-part x1 and imaginary-part x2"
-
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, "make-rectangular real part,", 1, car(args), "a real"));
- if (!s7_is_real(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "make-rectangular imaginary part,", 2, cadr(args), "a real"));
-
- imag = num_to_real(number(cadr(args)));
- if (imag == 0.0)
- return(car(args)); /* this preserves type: (make-rectangular 1 0) -> 1 */
+ s7_pf_t f;
+ s7_pointer x, y, z;
+ x = slot_value(**p); (*p)++;
+ f = (s7_pf_t)(**p); (*p)++;
+ y = f(sc, p);
+ f = (s7_pf_t)(**p); (*p)++;
+ z = f(sc, p);
+ return(fnc(sc, x, y, z));
+}
+
+static s7_pf_t pf_3(s7_scheme *sc, s7_pointer expr, s7_pf_t fp, s7_pf_t fs)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_pair(cdddr(expr))) && (is_null(cddddr(expr))))
+ {
+ s7_pointer a1;
- return(s7_make_complex(sc,
- num_to_real(number(car(args))),
- imag));
+ a1 = cadr(expr);
+ if (is_symbol(a1))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, a1);
+ if (!is_slot(slot)) return(NULL);
+ s7_xf_store(sc, slot);
+ }
+ else
+ {
+ if (!s7_arg_to_pf(sc, a1)) return(NULL);
+ }
+ if ((s7_arg_to_pf(sc, caddr(expr))) &&
+ (s7_arg_to_pf(sc, cadddr(expr))))
+ return((is_symbol(a1)) ? fs : fp);
+ }
+ return(NULL);
}
+#define PF3_TO_PF(CName, Pfnc) \
+ static s7_pointer CName ## _pf_p3(s7_scheme *sc, s7_pointer **rp) {return(pf3_pf_1(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_p3_s(s7_scheme *sc, s7_pointer **rp) {return(pf3_pf_s(sc, rp, Pfnc));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pf_3(sc, expr, CName ## _pf_p3, CName ## _pf_p3_s));}
-static s7_pointer g_exp(s7_scheme *sc, s7_pointer args)
+PF3_TO_PF(let_set, s7_let_set)
+static s7_pointer c_varlet(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_pointer z) {return(g_varlet(sc, set_plist_3(sc, x, y, z)));}
+PF3_TO_PF(varlet, c_varlet)
+PF_TO_PF(c_pointer, c_c_pointer)
+
+
+/* -------- PIF_TO_PF -------- */
+typedef s7_pointer (*pif_pf_t)(s7_scheme *sc, s7_pointer x, s7_int y);
+static s7_pointer pif_pf_1(s7_scheme *sc, s7_pointer **p, pif_pf_t fnc)
{
- #define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459"
+ s7_pf_t pf;
+ s7_if_t xf;
s7_pointer x;
+ s7_int y;
+ pf = (s7_pf_t)(**p); (*p)++;
+ x = pf(sc, p);
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ return(fnc(sc, x, y));
+}
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "exp", 0, x, "a number"));
- if (x == small_int(0)) return(small_int(1)); /* (exp 0) -> 1 */
+static s7_pointer pif_pf_s(s7_scheme *sc, s7_pointer **p, pif_pf_t fnc)
+{
+ s7_if_t xf;
+ s7_pointer x;
+ s7_int y;
+ x = slot_value(**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ return(fnc(sc, x, y));
+}
- if (s7_is_real(x))
- return(s7_make_real(sc, exp(num_to_real(number(x)))));
- return(s7_from_c_complex(sc, cexp(s7_complex(x))));
- /* this is inaccurate for large arguments:
- * (exp 0+1e20i) -> -0.66491178990701-0.74692189125949i, not 7.639704044417283004001468027378811228331E-1-6.45251285265780844205811711312523007406E-1i
- */
+static s7_pointer pif_pf_pp(s7_scheme *sc, s7_pointer **p, pif_pf_t fnc)
+{
+ s7_pf_t pf;
+ s7_pointer x, y;
+ pf = (s7_pf_t)(**p); (*p)++;
+ x = pf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ y = pf(sc, p);
+ if (!is_integer(y))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "~A should be an integer"), y)));
+ return(fnc(sc, x, integer(y)));
}
+static s7_pointer pif_pf_sp(s7_scheme *sc, s7_pointer **p, pif_pf_t fnc)
+{
+ s7_pf_t pf;
+ s7_pointer x, y;
+ x = slot_value(**p); (*p)++;
+ pf = (s7_pf_t)(**p); (*p)++;
+ y = pf(sc, p);
+ if (!is_integer(y))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "~A should be an integer"), y)));
+ return(fnc(sc, x, integer(y)));
+}
-static s7_pointer g_log(s7_scheme *sc, s7_pointer args)
+static s7_pf_t pif_1(s7_scheme *sc, s7_pointer expr, s7_pf_t fpi, s7_pf_t fsi, s7_pf_t fpp, s7_pf_t fsp)
{
- #define H_log "(log z1 (z2 e)) returns log(z1) / log(z2) where z2 (the base) defaults to e: (log 8 2) = 3"
- s7_pointer x;
-
- x = car(args);
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ {
+ s7_pointer a1, a2;
+ ptr_int loc;
+ a1 = cadr(expr);
+ a2 = caddr(expr);
+ if (is_symbol(a1))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, a1);
+ if (!is_slot(slot)) return(NULL);
+ s7_xf_store(sc, slot);
+ }
+ else
+ {
+ if (!s7_arg_to_pf(sc, a1))
+ return(NULL);
+ }
+ loc = rc_loc(sc);
+ if (s7_arg_to_if(sc, a2))
+ return((is_symbol(a1)) ? fsi : fpi);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "log", (cdr(args) == sc->NIL) ? 0 : 1, x, "a number"));
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_pf(sc, a2))
+ return((is_symbol(a1)) ? fsp : fpp);
+ }
+ return(NULL);
+}
- if ((is_pair(cdr(args))) &&
- (!(s7_is_number(cadr(args)))))
- return(s7_wrong_type_arg_error(sc, "log base,", 2, cadr(args), "a number"));
+#define PIF_TO_PF(CName, Pfnc) \
+ static s7_pointer CName ## _pf_pi(s7_scheme *sc, s7_pointer **rp) {return(pif_pf_1(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_si(s7_scheme *sc, s7_pointer **rp) {return(pif_pf_s(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_pp(s7_scheme *sc, s7_pointer **rp) {return(pif_pf_pp(sc, rp, Pfnc));} \
+ static s7_pointer CName ## _pf_sp(s7_scheme *sc, s7_pointer **rp) {return(pif_pf_sp(sc, rp, Pfnc));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pif_1(sc, expr, CName ## _pf_pi, CName ## _pf_si, CName ## _pf_pp, CName ## _pf_sp));}
- if (is_pair(cdr(args)))
- {
- s7_pointer y;
- y = cadr(args);
- if ((x == small_int(1)) && (y == small_int(1))) /* (log 1 1) -> 0 (this is NaN in the bignum case) */
- return(small_int(0));
+/* -------- PPIF_TO_PF -------- */
+typedef s7_pointer (*ppif_pf_t)(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_int z);
+static s7_pointer ppif_pf_1(s7_scheme *sc, s7_pointer **p, ppif_pf_t fnc) /* other case is pf2_pf_1, type pf2_pf_t */
+{
+ s7_pf_t pf;
+ s7_if_t xf;
+ s7_pointer x, y;
+ s7_int z;
+ pf = (s7_pf_t)(**p); (*p)++;
+ x = pf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ y = pf(sc, p);
+ xf = (s7_if_t)(**p); (*p)++;
+ z = xf(sc, p);
+ return(fnc(sc, x, y, z));
+}
- /* (log 1 0) must be 0 since everyone says (expt 0 0) is 1 */
- if (s7_is_zero(y))
+static s7_pf_t ppif_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))))
+ {
+ ptr_int loc;
+ if (!s7_arg_to_pf(sc, cadr(expr))) return(NULL);
+ loc = rc_loc(sc);
+ if (!s7_arg_to_pf(sc, caddr(expr)))
{
- if ((y == small_int(0)) &&
- (x == small_int(1)))
- return(y);
- return(s7_out_of_range_error(sc, "log base,", 2, y, "can't be 0"));
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (!s7_arg_to_gf(sc, caddr(expr))) return(NULL);
}
+ if (is_null(cdddr(expr))) return(f1);
+ if (!is_null(cddddr(expr))) return(NULL);
+ if (s7_arg_to_if(sc, cadddr(expr))) return(f2);
+ }
+ return(NULL);
+}
- if (s7_is_one(y)) /* this used to raise an error, but the bignum case is simpler if we return inf */
+#define PPIF_TO_PF(CName, Pfnc1, Pfnc2) \
+ static s7_pointer CName ## _pf_pp(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, Pfnc1));} \
+ static s7_pointer CName ## _pf_ppi(s7_scheme *sc, s7_pointer **rp) {return(ppif_pf_1(sc, rp, Pfnc2));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(ppif_1(sc, expr, CName ## _pf_pp, CName ## _pf_ppi));}
+
+
+/* -------- PIPF_TO_PF -------- */
+typedef s7_pointer (*pipf_pf_t)(s7_scheme *sc, s7_pointer x, s7_int y, s7_pointer z);
+static s7_pointer pipf_pf_slot(s7_scheme *sc, s7_pointer **p, pipf_pf_t fnc)
+{
+ s7_pf_t pf;
+ s7_pointer x, z;
+ s7_int y;
+ x = (s7_pointer)(**p); (*p)++;
+ y = s7_integer(slot_value(**p)); (*p)++;
+ pf = (s7_pf_t)(**p); (*p)++;
+ z = pf(sc, p);
+ return(fnc(sc, x, y, z));
+}
+
+static s7_pointer pipf_pf_s(s7_scheme *sc, s7_pointer **p, pipf_pf_t fnc)
+{
+ s7_pf_t pf;
+ s7_if_t xf;
+ s7_pointer x, z;
+ s7_int y;
+ x = (s7_pointer)(**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ z = pf(sc, p);
+ return(fnc(sc, x, y, z));
+}
+
+static s7_pointer pipf_pf_seq(s7_scheme *sc, s7_pointer **p, pipf_pf_t fnc) /* used in implicit_sequence_set */
+{
+ s7_pf_t pf;
+ s7_if_t xf;
+ s7_pointer x, z;
+ s7_int y;
+ x = slot_value(**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ z = pf(sc, p);
+ return(fnc(sc, x, y, z));
+}
+
+static s7_pointer pipf_pf_a(s7_scheme *sc, s7_pointer **p, pipf_pf_t fnc)
+{
+ s7_pf_t pf;
+ s7_if_t xf;
+ s7_pointer x, z;
+ s7_int y;
+ pf = (s7_pf_t)(**p); (*p)++;
+ x = pf(sc, p);
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ z = pf(sc, p);
+ return(fnc(sc, x, y, z));
+}
+
+enum {TEST_NO_S, TEST_SS, TEST_SI, TEST_SQ}; /* si = sym ind, ss = sym sym for first two */
+typedef int (*pf_i_t)(s7_scheme *sc, s7_pointer x);
+static s7_pf_t pipf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2, s7_pf_t f3, pf_i_t tester)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_pair(cdddr(expr))) && (is_null(cddddr(expr))))
+ {
+ int choice;
+ choice = tester(sc, expr);
+ if ((choice == TEST_SS) || (choice == TEST_SI) ||
+ ((choice == TEST_NO_S) &&
+ (s7_arg_to_pf(sc, cadr(expr))) &&
+ (s7_arg_to_if(sc, caddr(expr)))))
{
- if (s7_is_one(x)) /* but (log 1.0 1.0) -> 0.0 */
- return(real_zero);
- return(s7_make_real(sc, INFINITY));
+ ptr_int loc;
+ loc = rc_loc(sc);
+ if (s7_arg_to_pf(sc, cadddr(expr)))
+ return((choice == TEST_SS) ? f1 : ((choice == TEST_SI) ? f2 : f3));
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_gf(sc, cadddr(expr)))
+ return((choice == TEST_SS) ? f1 : ((choice == TEST_SI) ? f2 : f3));
}
+ }
+ return(NULL);
+}
- if ((s7_is_real(x)) &&
- (s7_is_real(y)) &&
- (s7_is_positive(x)) &&
- (s7_is_positive(y)))
- {
- if ((s7_is_rational(x)) &&
- (s7_is_rational(y)))
- {
- s7_Double res;
- s7_Int ires;
- res = log(num_to_real(number(x))) / log(num_to_real(number(y)));
- ires = (s7_Int)res;
- if (res - ires == 0.0)
- return(s7_make_integer(sc, ires)); /* (log 8 2) -> 3 or (log 1/8 2) -> -3 */
- return(s7_make_real(sc, res)); /* perhaps use rationalize here? (log 2 8) -> 1/3 */
- }
- return(s7_make_real(sc, log(num_to_real(number(x))) / log(num_to_real(number(y)))));
- }
- return(s7_from_c_complex(sc, clog(s7_complex(x)) / clog(s7_complex(y))));
- }
-
- if (s7_is_real(x))
- {
- if (s7_is_positive(x))
- return(s7_make_real(sc, log(num_to_real(number(x)))));
- return(s7_make_complex(sc, log(-num_to_real(number(x))), M_PI));
- }
+#define PIPF_TO_PF(CName, F1, F2, Tester) \
+ static s7_pointer CName ## _pf_slot(s7_scheme *sc, s7_pointer **rp) {return(pipf_pf_slot(sc, rp, F1));} \
+ static s7_pointer CName ## _pf_s(s7_scheme *sc, s7_pointer **rp) {return(pipf_pf_s(sc, rp, F1));} \
+ static s7_pointer CName ## _pf_seq(s7_scheme *sc, s7_pointer **rp) {return(pipf_pf_seq(sc, rp, F1));} \
+ static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **rp) {return(pipf_pf_a(sc, rp, F2));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(pipf_1(sc, expr, CName ## _pf_slot, CName ## _pf_s, CName ## _pf_a, Tester));}
- return(s7_from_c_complex(sc, clog(s7_complex(x))));
-}
+/* -------- IF_TO_IF -------- */
+typedef s7_int (*if_if_t)(s7_scheme *sc, s7_int x);
+static s7_int if_if_1(s7_scheme *sc, s7_pointer **p, if_if_t fnc)
+{
+ s7_if_t f;
+ s7_int x;
+ f = (s7_if_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(fnc(sc, x));
+}
-static s7_pointer g_sin(s7_scheme *sc, s7_pointer args)
+static s7_if_t if_1(s7_scheme *sc, s7_pointer expr, s7_if_t f)
{
- #define H_sin "(sin z) returns sin(z)"
- s7_pointer x;
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_if(sc, cadr(expr))))
+ return(f);
+ return(NULL);
+}
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "sin", 0, x, "a number"));
- if (x == small_int(0)) return(x); /* (sin 0) -> 0 */
+#define IF_TO_IF(CName, Ifnc) \
+ static s7_int CName ## _if_i(s7_scheme *sc, s7_pointer **rp) {return(if_if_1(sc, rp, Ifnc));} \
+ static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(if_1(sc, expr, CName ## _if_i));}
- if (s7_is_real(x))
- return(s7_make_real(sc, sin(num_to_real(number(x)))));
+#if (!WITH_GMP)
- /* sin is totally inaccurate over about 1e18. There's a way to get true results,
- * but it involves fancy "range reduction" techniques.
- * This mean lots of things are inaccurate:
- * (sin (remainder 1e22 (* 2 pi)))
- * -0.57876806033477
- * but it should be -8.522008497671888065747423101326159661908E-1
- * ---
- * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22 !!
- * it should be 5.263007914620499494429139986095833592117E0
- */
+/* -------- IF2_TO_IF -------- */
+typedef s7_int (*if2_if_t)(s7_scheme *sc, s7_int x, s7_int y);
+static s7_int if2_if_1(s7_scheme *sc, s7_pointer **p, if2_if_t fnc)
+{
+ s7_if_t f;
+ s7_int x, y;
+ f = (s7_if_t)(**p); (*p)++;
+ x = f(sc, p);
+ f = (s7_if_t)(**p); (*p)++;
+ y = f(sc, p);
+ return(fnc(sc, x, y));
+}
- return(s7_from_c_complex(sc, csin(s7_complex(x))));
+static s7_if_t if_2(s7_scheme *sc, s7_pointer expr, s7_if_t f)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))) &&
+ (s7_arg_to_if(sc, cadr(expr))) &&
+ (s7_arg_to_if(sc, caddr(expr))))
+ return(f);
+ return(NULL);
}
+#define IF2_TO_IF(CName, Ifnc) \
+ static s7_int CName ## _if_i2(s7_scheme *sc, s7_pointer **rp) {return(if2_if_1(sc, rp, Ifnc));} \
+ static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(if_2(sc, expr, CName ## _if_i2));}
-static s7_pointer g_cos(s7_scheme *sc, s7_pointer args)
+
+/* -------- IF_3_TO_IF -------- */
+
+typedef s7_int (*if3_if_t)(s7_scheme *sc, s7_int x, s7_int y, s7_int z);
+static s7_int if3_if_1(s7_scheme *sc, s7_pointer **p, if3_if_t fnc)
{
- #define H_cos "(cos z) returns cos(z)"
- s7_pointer x;
+ s7_if_t f;
+ s7_int x, y, z;
+ f = (s7_if_t)(**p); (*p)++;
+ x = f(sc, p);
+ f = (s7_if_t)(**p); (*p)++;
+ y = f(sc, p);
+ f = (s7_if_t)(**p); (*p)++;
+ z = f(sc, p);
+ return(fnc(sc, x, y, z));
+}
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "cos", 0, x, "a number"));
- if (x == small_int(0)) return(small_int(1)); /* (cos 0) -> 1 */
+static s7_if_t if_3(s7_scheme *sc, s7_pointer expr, s7_if_t f1, s7_if_t f2, s7_if_t f3)
+{
+ if (!is_pair(cdr(expr))) return(NULL);
+ if (!s7_arg_to_if(sc, cadr(expr))) return(NULL);
+ if (is_null(cddr(expr))) return(f1);
+ if (!s7_arg_to_if(sc, caddr(expr))) return(NULL);
+ if (is_null(cdddr(expr))) return(f2);
+ if (!s7_arg_to_if(sc, cadddr(expr))) return(NULL);
+ if (is_null(cddddr(expr))) return(f3);
+ return(NULL);
+}
- if (s7_is_real(x))
- return(s7_make_real(sc, cos(num_to_real(number(x)))));
- return(s7_from_c_complex(sc, ccos(s7_complex(x))));
+#define IF_3_TO_IF(CName, Ifnc1, Ifnc2, Ifnc3) \
+ static s7_int CName ## _if_i1(s7_scheme *sc, s7_pointer **rp) {return(if_if_1(sc, rp, Ifnc1));} \
+ static s7_int CName ## _if_i2(s7_scheme *sc, s7_pointer **rp) {return(if2_if_1(sc, rp, Ifnc2));} \
+ static s7_int CName ## _if_i3(s7_scheme *sc, s7_pointer **rp) {return(if3_if_1(sc, rp, Ifnc3));} \
+ static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(if_3(sc, expr, CName ## _if_i1, CName ## _if_i2, CName ## _if_i3));}
+#endif /* gmp */
+
+
+/* -------- IF_TO_PF -------- */
+typedef s7_pointer (*if_pf_t)(s7_scheme *sc, s7_int x);
+static s7_pointer if_p_1(s7_scheme *sc, s7_pointer **p, if_pf_t fnc)
+{
+ s7_if_t f;
+ s7_int x;
+ f = (s7_if_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(fnc(sc, x));
}
+static s7_pf_t if_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_if(sc, cadr(expr))))
+ return(f);
+ return(NULL);
+}
-static s7_pointer g_tan(s7_scheme *sc, s7_pointer args)
+#define IF_TO_PF(CName, Ifnc) \
+ static s7_pointer CName ## _pf_i(s7_scheme *sc, s7_pointer **rp) {return(if_p_1(sc, rp, Ifnc));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(if_pf_1(sc, expr, CName ## _pf_i));}
+
+
+/* -------- PF_TO_IF -------- */
+typedef s7_int (*pf_if_t)(s7_scheme *sc, s7_pointer x);
+static s7_int pf_i_1(s7_scheme *sc, s7_pointer **p, pf_if_t fnc)
{
- #define H_tan "(tan z) returns tan(z)"
+ s7_pf_t f;
s7_pointer x;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(fnc(sc, x));
+}
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "tan", 0, x, "a number"));
- if (x == small_int(0)) return(x); /* (tan 0) -> 0 */
+static s7_if_t pf_if_1(s7_scheme *sc, s7_pointer expr, s7_if_t f)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_pf(sc, cadr(expr))))
+ return(f);
+ return(NULL);
+}
- if (s7_is_real(x))
- return(s7_make_real(sc, tan(num_to_real(number(x)))));
+#define PF_TO_IF(CName, Pfnc) \
+ static s7_int CName ## _if_p(s7_scheme *sc, s7_pointer **rp) {return(pf_i_1(sc, rp, Pfnc));} \
+ static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(pf_if_1(sc, expr, CName ## _if_p));}
- if (complex_imag_part(x) > 350.0)
- return(s7_make_complex(sc, 0.0, 1.0));
- if (complex_imag_part(x) < -350.0)
- return(s7_make_complex(sc, 0.0, -1.0));
- return(s7_from_c_complex(sc, ctan(s7_complex(x))));
+/* -------- PF_TO_RF -------- */
+typedef s7_double (*pf_rf_t)(s7_scheme *sc, s7_pointer x);
+static s7_double pf_r_1(s7_scheme *sc, s7_pointer **p, pf_rf_t fnc)
+{
+ s7_pf_t f;
+ s7_pointer x;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(fnc(sc, x));
+}
+
+static s7_rf_t pf_rf_1(s7_scheme *sc, s7_pointer expr, s7_rf_t f)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_rf(sc, cadr(expr))))
+ return(f);
+ return(NULL);
}
+#define PF_TO_RF(CName, Pfnc) \
+ static s7_double CName ## _rf_p(s7_scheme *sc, s7_pointer **rp) {return(pf_r_1(sc, rp, Pfnc));} \
+ static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {return(pf_rf_1(sc, expr, CName ## _rf_p));}
-static s7_pointer g_asin(s7_scheme *sc, s7_pointer args)
+
+#if (!WITH_GMP)
+
+/* -------- RF_TO_IF -------- */
+typedef s7_int (*rf_if_t)(s7_scheme *sc, s7_double x);
+static s7_int rf_i_1(s7_scheme *sc, s7_pointer **p, rf_if_t fnc)
{
- #define H_asin "(asin z) returns asin(z); (sin (asin 1)) = 1"
- s7_pointer n;
+ s7_rf_t f;
+ s7_double x;
+ f = (s7_rf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(fnc(sc, x));
+}
- n = car(args);
- if (!s7_is_number(n))
- return(s7_wrong_type_arg_error(sc, "asin", 0, n, "a number"));
- if (n == small_int(0)) return(n);
+static s7_if_t rf_if_1(s7_scheme *sc, s7_pointer expr, s7_if_t f)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_rf(sc, cadr(expr))))
+ return(f);
+ return(NULL);
+}
- if (s7_is_real(n))
- {
- s7_Double x, absx, recip;
- s7_Complex result;
- x = num_to_real(number(n));
- absx = s7_Double_abs(x);
- if (absx <= 1.0)
- return(s7_make_real(sc, asin(x)));
-
- /* otherwise use maxima code: */
- recip = 1.0 / absx;
- result = (M_PI / 2.0) - (_Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip)))));
- if (x < 0.0)
- return(s7_from_c_complex(sc, -result));
- return(s7_from_c_complex(sc, result));
- }
+#define RF_TO_IF(CName, Rfnc) \
+ static s7_int CName ## _if_r(s7_scheme *sc, s7_pointer **rp) {return(rf_i_1(sc, rp, Rfnc));} \
+ static s7_if_t CName ## _if(s7_scheme *sc, s7_pointer expr) {return(rf_if_1(sc, expr, CName ## _if_r));}
-#if WITH_COMPLEX
- /* if either real or imag part is very large, use explicit formula, not casin */
- /* this code taken from sbcl's src/code/irrat.lisp */
- /* break is around x+70000000i */
+#endif /* gmp */
- if ((s7_Double_abs(complex_real_part(n)) > 1.0e7) ||
- (s7_Double_abs(complex_imag_part(n)) > 1.0e7))
- {
- s7_Complex sq1mz, sq1pz, z;
+/* -------- RF_TO_PF -------- */
+typedef s7_pointer (*rf_pf_t)(s7_scheme *sc, s7_double x);
+static s7_pointer rf_p_1(s7_scheme *sc, s7_pointer **p, rf_pf_t fnc)
+{
+ s7_rf_t f;
+ s7_double x;
+ f = (s7_rf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(fnc(sc, x));
+}
- z = s7_complex(n);
- sq1mz = csqrt(1.0 - z);
- sq1pz = csqrt(1.0 + z);
- return(s7_make_complex(sc,
- atan(complex_real_part(n) / creal(sq1mz * sq1pz)),
- asinh(cimag(sq1pz * conj(sq1mz)))));
- }
-#endif
+#if (!WITH_GMP)
- return(s7_from_c_complex(sc, casin(s7_complex(n))));
+static s7_pf_t rf_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_rf(sc, cadr(expr))))
+ return(f);
+ return(NULL);
}
+#define RF_TO_PF(CName, Pfnc) \
+ static s7_pointer CName ## _pf_r(s7_scheme *sc, s7_pointer **rp) {return(rf_p_1(sc, rp, Pfnc));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(rf_pf_1(sc, expr, CName ## _pf_r));}
-static s7_pointer g_acos(s7_scheme *sc, s7_pointer args)
+
+/* -------- RF_TO_RF -------- */
+typedef s7_double (*rf_rf_t)(s7_scheme *sc, s7_double x);
+static s7_double rf_rf_1(s7_scheme *sc, s7_pointer **p, rf_rf_t fnc)
{
- #define H_acos "(acos z) returns acos(z); (cos (acos 1)) = 1"
- s7_pointer n;
+ s7_rf_t f;
+ s7_double x;
+ f = (s7_rf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(fnc(sc, x));
+}
- n = car(args);
- if (!s7_is_number(n))
- return(s7_wrong_type_arg_error(sc, "acos", 0, n, "a number"));
- if (n == small_int(1)) return(small_int(0));
+static s7_rf_t rf_1(s7_scheme *sc, s7_pointer expr, s7_rf_t f)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) && (s7_arg_to_rf(sc, cadr(expr))))
+ return(f);
+ return(NULL);
+}
- if (s7_is_real(n))
- {
- s7_Double x, absx, recip;
- s7_Complex result;
- x = num_to_real(number(n));
- absx = s7_Double_abs(x);
- if (absx <= 1.0)
- return(s7_make_real(sc, acos(x)));
-
- /* else follow maxima again: */
- recip = 1.0 / absx;
- if (x > 0.0)
- result = _Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
- else result = M_PI - _Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
- return(s7_from_c_complex(sc, result));
- }
+#define RF_TO_RF(CName, Rfnc) \
+ static s7_double CName ## _rf_r(s7_scheme *sc, s7_pointer **rp) {return(rf_rf_1(sc, rp, Rfnc));} \
+ static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {return(rf_1(sc, expr, CName ## _rf_r));}
-#if WITH_COMPLEX
- /* if either real or imag part is very large, use explicit formula, not cacos */
- /* this code taken from sbcl's src/code/irrat.lisp */
+#define DIRECT_RF_TO_RF(CName) \
+ static s7_double CName ## _rf_r(s7_scheme *sc, s7_pointer **p) {s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(CName(x));} \
+ static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {if (s7_arg_to_rf(sc, s7_cadr(expr))) return(CName ## _rf_r); return(NULL);}
- if ((s7_Double_abs(complex_real_part(n)) > 1.0e7) ||
- (s7_Double_abs(complex_imag_part(n)) > 1.0e7))
- {
- s7_Complex sq1mz, sq1pz, z;
- z = s7_complex(n);
- sq1mz = csqrt(1.0 - z);
- sq1pz = csqrt(1.0 + z);
- return(s7_make_complex(sc,
- 2.0 * atan(creal(sq1mz) / creal(sq1pz)),
- asinh(cimag(sq1mz * conj(sq1pz)))));
- }
-#endif
- return(s7_from_c_complex(sc, cacos(s7_complex(n))));
+/* -------- RF2_TO_RF -------- */
+typedef s7_double (*rf2_rf_t)(s7_scheme *sc, s7_double x, s7_double y);
+static s7_double rf2_rf_1(s7_scheme *sc, s7_pointer **p, rf2_rf_t fnc)
+{
+ s7_rf_t f;
+ s7_double x, y;
+ f = (s7_rf_t)(**p); (*p)++;
+ x = f(sc, p);
+ f = (s7_rf_t)(**p); (*p)++;
+ y = f(sc, p);
+ return(fnc(sc, x, y));
}
-
-static s7_pointer g_atan(s7_scheme *sc, s7_pointer args)
+static s7_rf_t rf_2(s7_scheme *sc, s7_pointer expr, s7_rf_t f)
{
- #define H_atan "(atan z) returns atan(z), (atan y x) returns atan(y/x)"
- s7_pointer x, y;
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))) &&
+ (s7_arg_to_rf(sc, cadr(expr))) &&
+ (s7_arg_to_rf(sc, caddr(expr))))
+ return(f);
+ return(NULL);
+}
- /* currently (atan inf.0 inf.0) -> 0.78539816339745, and (atan inf.0 -inf.0) -> 2.3561944901923 (etc) */
+#define RF2_TO_RF(CName, Rfnc) \
+ static s7_double CName ## _rf_r2(s7_scheme *sc, s7_pointer **rp) {return(rf2_rf_1(sc, rp, Rfnc));} \
+ static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {return(rf_2(sc, expr, CName ## _rf_r2));}
- x = car(args);
- if (!is_pair(cdr(args)))
- {
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "atan", 0, x, "a number"));
- if (x == small_int(0)) return(x); /* (atan 0) -> 0 */
- if (s7_is_real(x))
- return(s7_make_real(sc, atan(num_to_real(number(x)))));
+/* -------- RF_3_TO_RF -------- */
- return(s7_from_c_complex(sc, catan(s7_complex(x))));
- }
+typedef s7_double (*rf3_rf_t)(s7_scheme *sc, s7_double x, s7_double y, s7_double z);
+static s7_double rf3_rf_1(s7_scheme *sc, s7_pointer **p, rf3_rf_t fnc)
+{
+ s7_rf_t f;
+ s7_double x, y, z;
+ f = (s7_rf_t)(**p); (*p)++;
+ x = f(sc, p);
+ f = (s7_rf_t)(**p); (*p)++;
+ y = f(sc, p);
+ f = (s7_rf_t)(**p); (*p)++;
+ z = f(sc, p);
+ return(fnc(sc, x, y, z));
+}
- y = cadr(args);
- if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "atan", 1, x, "a real"));
- if (!s7_is_real(y))
- return(s7_wrong_type_arg_error(sc, "atan", 2, y, "a real"));
+static s7_rf_t rf_3(s7_scheme *sc, s7_pointer expr, s7_rf_t f1, s7_rf_t f2, s7_rf_t f3)
+{
+ if (!is_pair(cdr(expr))) return(NULL);
+ if (!s7_arg_to_rf(sc, cadr(expr))) return(NULL);
+ if (is_null(cddr(expr))) return(f1);
+ if (!s7_arg_to_rf(sc, caddr(expr))) return(NULL);
+ if (is_null(cdddr(expr))) return(f2);
+ if (!s7_arg_to_rf(sc, cadddr(expr))) return(NULL);
+ if (is_null(cddddr(expr))) return(f3);
+ return(NULL);
+}
- return(s7_make_real(sc, atan2(num_to_real(number(x)),
- num_to_real(number(y)))));
-}
+#define RF_3_TO_RF(CName, Rfnc1, Rfnc2, Rfnc3) \
+ static s7_double CName ## _rf_r1(s7_scheme *sc, s7_pointer **rp) {return(rf_rf_1(sc, rp, Rfnc1));} \
+ static s7_double CName ## _rf_r2(s7_scheme *sc, s7_pointer **rp) {return(rf2_rf_1(sc, rp, Rfnc2));} \
+ static s7_double CName ## _rf_r3(s7_scheme *sc, s7_pointer **rp) {return(rf3_rf_1(sc, rp, Rfnc3));} \
+ static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) {return(rf_3(sc, expr, CName ## _rf_r1, CName ## _rf_r2, CName ## _rf_r3));}
-static s7_pointer g_sinh(s7_scheme *sc, s7_pointer args)
+/* -------- R_P_F_TO_PF -------- */
+static s7_pf_t rpf_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t fnc1, s7_pf_t fnc2, s7_pf_t fnc3)
{
- #define H_sinh "(sinh z) returns sinh(z)"
- s7_pointer x;
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ {
+ ptr_int loc;
+ loc = rc_loc(sc);
+ if (s7_arg_to_rf(sc, cadr(expr))) return(fnc1);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_pf(sc, cadr(expr))) return(fnc2);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_gf(sc, cadr(expr))) return(fnc3);
+ }
+ return(NULL);
+}
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "sinh", 0, x, "a number"));
- if (x == small_int(0)) return(x); /* (sinh 0) -> 0 */
+#define R_P_F_TO_PF(CName, PFnc1, PFnc2, PFnc3) \
+ static s7_pointer CName ## _pf_r(s7_scheme *sc, s7_pointer **rp) {return(rf_p_1(sc, rp, PFnc1));} \
+ static s7_pointer CName ## _pf_p(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_1(sc, rp, PFnc2));} \
+ static s7_pointer CName ## _pf_g(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_1(sc, rp, PFnc3));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(rpf_pf_1(sc, expr, CName ## _pf_r, CName ## _pf_p, CName ## _pf_g));}
- if (s7_is_real(x))
- return(s7_make_real(sc, sinh(num_to_real(number(x)))));
- return(s7_from_c_complex(sc, csinh(s7_complex(x))));
+#endif /* gmp */
+
+/* -------- XF_TO_PF -------- */
+static s7_pf_t xf_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2, s7_pf_t f3)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ {
+ ptr_int loc;
+ loc = rc_loc(sc);
+ if (s7_arg_to_if(sc, cadr(expr))) return(f1);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_rf(sc, cadr(expr))) return(f2);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_pf(sc, cadr(expr))) return(f3);
+ }
+ return(NULL);
}
+#define XF_TO_PF(CName, PFnc1, PFnc2, PFnc3) \
+ static s7_pointer CName ## _pf_i(s7_scheme *sc, s7_pointer **rp) {return(if_p_1(sc, rp, PFnc1));} \
+ static s7_pointer CName ## _pf_r(s7_scheme *sc, s7_pointer **rp) {return(rf_p_1(sc, rp, PFnc2));} \
+ static s7_pointer CName ## _pf_p(s7_scheme *sc, s7_pointer **rp) {return(pf_pf_1(sc, rp, PFnc3));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) {return(xf_pf_1(sc, expr, CName ## _pf_i, CName ## _pf_r, CName ## _pf_p));}
-static s7_pointer g_cosh(s7_scheme *sc, s7_pointer args)
-{
- #define H_cosh "(cosh z) returns cosh(z)"
- s7_pointer x;
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "cosh", 0, x, "a number"));
- if (x == small_int(0)) return(small_int(1)); /* (cosh 0) -> 1 */
+/* -------- XF2_TO_PF -------- */
+typedef s7_pointer (*if2_pf_t)(s7_scheme *sc, s7_int x, s7_int y);
+typedef s7_pointer (*rf2_pf_t)(s7_scheme *sc, s7_double x, s7_double y);
+static s7_pointer if2_pf_1(s7_scheme *sc, s7_pointer **p, if2_pf_t fnc)
+{
+ s7_if_t f;
+ s7_int x, y;
+ f = (s7_if_t)(**p); (*p)++; x = f(sc, p);
+ f = (s7_if_t)(**p); (*p)++; y = f(sc, p);
+ return(fnc(sc, x, y));
+}
- if (s7_is_real(x))
- return(s7_make_real(sc, cosh(num_to_real(number(x)))));
- return(s7_from_c_complex(sc, ccosh(s7_complex(x))));
+static s7_pointer rf2_pf_1(s7_scheme *sc, s7_pointer **p, rf2_pf_t fnc)
+{
+ s7_rf_t f;
+ s7_double x, y;
+ f = (s7_rf_t)(**p); (*p)++; x = f(sc, p);
+ f = (s7_rf_t)(**p); (*p)++; y = f(sc, p);
+ return(fnc(sc, x, y));
}
+static s7_pointer rf2_pf_sc(s7_scheme *sc, s7_pointer **p, rf2_pf_t fnc)
+{
+ s7_pointer xp, yp;
+ (*p)++;
+ xp = slot_value(**p); (*p) += 2;
+ yp = (**p); (*p)++;
+ if ((is_t_real(xp)) && (is_t_real(yp)))
+ return(fnc(sc, real(xp), real(yp)));
+ return(fnc(sc, s7_number_to_real(sc, xp), s7_number_to_real(sc, yp)));
+}
-static s7_pointer g_tanh(s7_scheme *sc, s7_pointer args)
+static s7_pf_t xf2_pf_1(s7_scheme *sc, s7_pointer expr, s7_pf_t f1, s7_pf_t f2, s7_pf_t f3, s7_pf_t f4, s7_pf_t f5)
{
- #define H_tanh "(tanh z) returns tanh(z)"
- s7_pointer x;
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ {
+ ptr_int loc;
+ s7_pointer a1, a2;
+ a1 = cadr(expr);
+ a2 = caddr(expr);
+ if ((is_symbol(a1)) && (is_symbol(a2)))
+ {
+ a1 = s7_slot(sc, a1);
+ if (!is_slot(a1)) return(NULL);
+ s7_xf_store(sc, a1);
+ a2 = s7_slot(sc, a2);
+ if (!is_slot(a2)) return(NULL);
+ s7_xf_store(sc, a2);
+ return(f5);
+ }
+ loc = rc_loc(sc);
+ if ((s7_arg_to_if(sc, a1)) && (s7_arg_to_if(sc, a2))) return(f1);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if ((s7_arg_to_rf(sc, a1)) && (s7_arg_to_rf(sc, a2))) return(((is_symbol(a1)) && (is_real(a2))) ? f3 : f2);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if ((s7_arg_to_pf(sc, a1)) && (s7_arg_to_pf(sc, a2))) return(f4);
+ }
+ return(NULL);
+}
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "tanh", 0, x, "a number"));
+#define XF2_TO_PF(CName, PFnc1, PFnc2, PFnc3) \
+ static s7_pointer CName ## _pf_i2(s7_scheme *sc, s7_pointer **rp) {return(if2_pf_1(sc, rp, PFnc1));} \
+ static s7_pointer CName ## _pf_r2(s7_scheme *sc, s7_pointer **rp) {return(rf2_pf_1(sc, rp, PFnc2));} \
+ static s7_pointer CName ## _pf_r2_sc(s7_scheme *sc, s7_pointer **rp) {return(rf2_pf_sc(sc, rp, PFnc2));} \
+ static s7_pointer CName ## _pf_p2(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_1(sc, rp, PFnc3));} \
+ static s7_pointer CName ## _pf_ss(s7_scheme *sc, s7_pointer **rp) {return(pf2_pf_ss(sc, rp, PFnc3));} \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
+ {\
+ return(xf2_pf_1(sc, expr, CName ## _pf_i2, CName ## _pf_r2, CName ## _pf_r2_sc, CName ## _pf_p2, CName ## _pf_ss)); \
+ }
- if (x == small_int(0)) return(x); /* (tanh 0) -> 0 */
- if (s7_is_real(x))
- return(s7_make_real(sc, tanh(num_to_real(number(x)))));
+#if WITH_OPTIMIZATION
+static s7_pointer if_pf_xx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t test, t;
+ s7_pointer val;
+ ptr_int e1;
+
+ test = (s7_pf_t)(**p); (*p)++;
+ t = (s7_pf_t)(**p); (*p)++;
+ e1 = (ptr_int)(**p); (*p)++;
- if (complex_real_part(x) > 350.0)
- return(real_one); /* closer than 0.0 which is what ctanh is about to return! */
- if (complex_real_part(x) < -350.0)
- return(s7_make_real(sc, -1.0)); /* closer than -0.0 which is what ctanh is about to return! */
+ val = test(sc, p);
+ if (val != sc->F)
+ val = t(sc, p);
+ else val = sc->UNSPECIFIED;
+ (*p) = rc_go(sc, e1);
- return(s7_from_c_complex(sc, ctanh(s7_complex(x))));
+ return(val);
}
-
-static s7_pointer g_asinh(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_pf_not_xx(s7_scheme *sc, s7_pointer **p)
{
- #define H_asinh "(asinh z) returns asinh(z)"
- s7_pointer x;
+ s7_pf_t test, t;
+ s7_pointer val;
+ ptr_int e1;
+
+ test = (s7_pf_t)(**p); (*p)++;
+ t = (s7_pf_t)(**p); (*p)++;
+ e1 = (ptr_int)(**p); (*p)++;
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "asinh", 0, x, "a number"));
- if (x == small_int(0)) return(x);
+ val = test(sc, p);
+ if (val == sc->F)
+ val = t(sc, p);
+ else val = sc->UNSPECIFIED;
+ (*p) = rc_go(sc, e1);
- if (s7_is_real(x))
- return(s7_make_real(sc, asinh(num_to_real(number(x)))));
- return(s7_from_c_complex(sc, casinh(s7_complex(x))));
+ return(val);
}
+#if (!WITH_GMP)
+static s7_pointer equal_p2(s7_scheme *sc, s7_pointer **p);
+#endif
+static s7_pointer c_equal_2(s7_scheme *sc, s7_pointer x, s7_pointer y);
-static s7_pointer g_acosh(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_pf_not_equal_2(s7_scheme *sc, s7_pointer **p)
{
- #define H_acosh "(acosh z) returns acosh(z)"
- s7_pointer x;
+ s7_pf_t t, eq2;
+ s7_pointer val, x, y;
+ ptr_int e1;
+
+ (*p)++;
+ t = (s7_pf_t)(**p); (*p)++;
+ e1 = (ptr_int)(**p); (*p)++;
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "acosh", 0, x, "a number"));
- if (x == small_int(1)) return(small_int(0));
+ eq2 = (s7_pf_t)(**p); (*p)++;
+ x = eq2(sc, p);
+ eq2 = (s7_pf_t)(**p); (*p)++;
+ y = eq2(sc, p);
- if ((s7_is_real(x)) &&
- (num_to_real(number(x)) >= 1.0))
- return(s7_make_real(sc, acosh(num_to_real(number(x)))));
- return(s7_from_c_complex(sc, cacosh(s7_complex(x))));
-}
+ if (c_equal_2(sc, x, y) == sc->F)
+ val = t(sc, p);
+ else val = sc->UNSPECIFIED;
+ (*p) = rc_go(sc, e1);
+ return(val);
+}
-static s7_pointer g_atanh(s7_scheme *sc, s7_pointer args)
+static s7_pointer if_pf_xxx(s7_scheme *sc, s7_pointer **p)
{
- #define H_atanh "(atanh z) returns atanh(z)"
s7_pointer x;
+ s7_pf_t r1, r2;
+ s7_pf_t pf;
+ s7_pointer val;
+ ptr_int e1, e2;
- x = car(args);
- if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "atanh", 0, x, "a number"));
+ pf = (s7_pf_t)(**p); (*p)++;
+ r1 = (s7_pf_t)(**p); (*p)++;
+ e1 = (ptr_int)(**p); (*p)++;
+ r2 = (s7_pf_t)(**p); (*p)++;
+ e2 = (ptr_int)(**p); (*p)++;
- if (x == small_int(0)) return(x); /* (atanh 0) -> 0 */
- if ((s7_is_real(x)) &&
- (s7_Double_abs(num_to_real(number(x))) < 1.0))
- return(s7_make_real(sc, atanh(num_to_real(number(x)))));
+ val = pf(sc, p);
+ if (val != sc->F)
+ {
+ x = r1(sc, p);
+ (*p) = rc_go(sc, e2);
+ }
+ else
+ {
+ (*p) = rc_go(sc, e1);
+ x = r2(sc, p);
+ }
+ return(x);
+}
- /* if we can't distinguish x from 1.0 even with long doubles, we'll get inf.0:
- * (atanh 9223372036854775/9223372036854776) -> 18.714973875119
- * (atanh 92233720368547758/92233720368547757) -> inf.0
- */
+static s7_pf_t if_pf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer test, t, f = NULL;
+ s7_int test_loc, t_loc, f_loc = 0, e1_loc, e2_loc = 0;
+ bool not_case = false;
+ ptr_int loc;
+ xf_t *rc;
- return(s7_from_c_complex(sc, catanh(s7_complex(x))));
-}
+ if ((is_null(cdr(expr))) || (is_null(cddr(expr)))) return(NULL);
+ test = cadr(expr);
+ if ((is_pair(test)) && (car(test) == sc->NOT))
+ {
+ not_case = true;
+ test = cadr(test);
+ }
+ t = caddr(expr);
+ xf_init(5);
+ xf_save_loc3(test_loc, t_loc, e1_loc);
-static s7_pointer g_sqrt(s7_scheme *sc, s7_pointer args)
-{
- #define H_sqrt "(sqrt z) returns the square root of z"
- s7_pointer n;
+ if (is_pair(cdddr(expr)))
+ {
+ f = cadddr(expr);
+ xf_save_loc2(f_loc, e2_loc);
+ }
- n = car(args);
- if (!s7_is_number(n))
- return(s7_wrong_type_arg_error(sc, "sqrt", 0, n, "a number"));
+ if (!arg_to_pf(sc, test, test_loc)) return(NULL);
+ loc = rc_loc(sc);
+ if (!arg_to_pf(sc, t, t_loc))
+ {
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (!arg_to_if(sc, t, t_loc)) return(NULL);
+ }
+ xf_store_at(e1_loc, (s7_pointer)rc_loc(sc));
+
+ if (f)
+ {
+ if (!arg_to_pf(sc, f, f_loc)) return(NULL);
+ xf_store_at(e2_loc, (s7_pointer)rc_loc(sc));
+ }
- if (s7_is_real(n))
+ if (!f)
{
- s7_Double x, sqx;
- x = num_to_real(number(n));
- if (x >= 0.0)
+ if (not_case)
{
- sqx = sqrt(x);
- if (s7_is_integer(n))
- {
- s7_Int ix;
- ix = (s7_Int)sqx;
- if ((ix * ix) == integer(number(n)))
- return(s7_make_integer(sc, ix));
- }
- if (s7_is_ratio(n))
- {
- s7_Int nm = 0, dn = 1;
- if (c_rationalize(sqx, 1.0e-16, &nm, &dn)) /* 1e-16 so that (sqrt 1/1099511627776) returns 1/1048576 */
- {
- if ((nm * nm == s7_numerator(n)) &&
- (dn * dn == s7_denominator(n)))
- return(s7_make_ratio(sc, nm, dn));
- }
- }
- return(s7_make_real(sc, sqx));
+#if (!WITH_GMP)
+ if ((s7_pointer)equal_p2 == sc->cur_rf->data[test_loc])
+ return(if_pf_not_equal_2);
+#endif
+ return(if_pf_not_xx);
}
+ return(if_pf_xx);
}
- return(s7_from_c_complex(sc, csqrt(s7_complex(n))));
+ return(if_pf_xxx);
}
-static s7_Int int_to_int(s7_Int x, s7_Int n)
+static s7_double if_rf_xxx(s7_scheme *sc, s7_pointer **p)
{
- /* from GSL */
- s7_Int value = 1;
- do {
- if (n & 1) value *= x;
- n >>= 1;
- x *= x;
- } while (n);
- return(value);
-}
-
-
-static long long int nth_roots[63] = {
- S7_LLONG_MAX, S7_LLONG_MAX, 3037000499LL, 2097151, 55108, 6208, 1448, 511, 234, 127, 78, 52, 38, 28, 22,
- 18, 15, 13, 11, 9, 8, 7, 7, 6, 6, 5, 5, 5, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2,
- 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
+ s7_double x;
+ s7_rf_t r1, r2;
+ s7_pf_t pf;
+ s7_pointer val;
+ ptr_int e1, e2;
+
+ pf = (s7_pf_t)(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ r2 = (s7_rf_t)(**p); (*p)++;
+ e1 = (ptr_int)(**p); (*p)++;
+ e2 = (ptr_int)(**p); (*p)++;
-static long int_nth_roots[31] = {
- S7_LONG_MAX, S7_LONG_MAX, 46340, 1290, 215, 73, 35, 21, 14, 10, 8, 7, 5, 5, 4, 4, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
-
-static bool int_pow_ok(s7_Int x, s7_Int y)
-{
- if (s7_int_bits > 31)
- return((y < 63) &&
- (nth_roots[y] >= s7_Int_abs(x)));
- return((y < 31) &&
- (int_nth_roots[y] >= s7_Int_abs(x)));
+ val = pf(sc, p);
+ if (val != sc->F)
+ {
+ x = r1(sc, p);
+ (*p) = rc_go(sc, e2);
+ }
+ else
+ {
+ (*p) = rc_go(sc, e1);
+ x = r2(sc, p);
+ }
+ return(x);
}
-
-static s7_pointer g_expt(s7_scheme *sc, s7_pointer args)
+static s7_rf_t if_rf(s7_scheme *sc, s7_pointer expr)
{
- #define H_expt "(expt z1 z2) returns z1^z2"
- s7_pointer n, pw;
-
- n = car(args);
- pw = cadr(args);
+ s7_pointer test, t, f;
+ s7_int test_loc, t_loc, f_loc = 0, e1_loc = 0, e2_loc;
+ xf_t *rc;
- if (!s7_is_number(n))
- return(s7_wrong_type_arg_error(sc, "expt", 1, n, "a number"));
- if (!s7_is_number(pw))
- return(s7_wrong_type_arg_error(sc, "expt power,", 2, pw, "a number"));
+ if ((is_null(cdr(expr))) || (is_null(cddr(expr))) || (is_null(cdddr(expr)))) return(NULL);
+ test = cadr(expr);
+ t = caddr(expr);
+ f = cadddr(expr);
+ xf_init(5);
- /* this provides more than 2 args to expt:
- * if (cddr(args) != sc->NIL)
- * return(g_expt(sc, make_list_2(sc, car(args), g_expt(sc, cdr(args)))));
- *
- * but it's unusual in scheme to process args in reverse order, and the
- * syntax by itself is ambiguous (does (expt 2 2 3) = 256 or 64?)
- */
+ xf_save_loc3(test_loc, t_loc, f_loc);
+ xf_save_loc2(e1_loc, e2_loc);
- if (s7_is_zero(n))
- {
- if (s7_is_zero(pw))
- {
- if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* (expt 0 0) -> 1 */
- return(small_int(1));
- return(real_zero); /* (expt 0.0 0) -> 0.0 */
- }
+ if (!arg_to_pf(sc, test, test_loc)) return(NULL);
+ if (!arg_to_rf(sc, t, t_loc)) return(NULL);
+ xf_store_at(e1_loc, (s7_pointer)rc_loc(sc));
+ if (!arg_to_rf(sc, f, f_loc)) return(NULL);
+ xf_store_at(e2_loc, (s7_pointer)rc_loc(sc));
- if (s7_is_real(pw))
- {
- if (s7_is_negative(pw)) /* (expt 0 -1) */
- return(division_by_zero_error(sc, "expt", args));
- /* (Clisp gives divide-by-zero error here, Guile returns inf.0) */
+ return(if_rf_xxx);
+}
- if ((!s7_is_rational(pw)) && /* (expt 0 most-positive-fixnum) */
- (isnan(s7_real(pw)))) /* (expt 0 +nan.0) */
- return(pw);
- }
- else
- { /* (expt 0 a+bi) */
- if (complex_real_part(pw) < 0.0) /* (expt 0 -1+i) */
- return(division_by_zero_error(sc, "expt", args));
- }
+static s7_pointer quote_pf_s(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s;
+ s = **p; (*p)++;
+ return(s);
+}
- if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* pw != 0, (expt 0 2312) */
- return(small_int(0));
- return(real_zero); /* (expt 0.0 123123) */
+static s7_pf_t quote_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if (is_symbol(cadr(expr)))
+ {
+ xf_t *rc;
+ xf_init(1);
+ xf_store(cadr(expr));
+ return(quote_pf_s);
}
+ return(NULL);
+}
- if (s7_is_one(pw))
+static s7_pointer or_pf_xx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t pf1, pf2;
+ ptr_int e1;
+ s7_pointer val;
+
+ pf1 = (s7_pf_t)(**p); (*p)++;
+ pf2 = (s7_pf_t)(**p); (*p)++;
+ e1 = (ptr_int)(**p); (*p)++;
+
+ val = pf1(sc, p);
+ if (val != sc->F)
{
- if (s7_is_integer(pw))
- return(n);
- if (number_type(n) <= NUM_RATIO)
- return(s7_make_real(sc, num_to_real(number(n))));
- return(n);
+ (*p) = rc_go(sc, e1);
+ return(val);
}
-
- if (number_type(pw) == NUM_INT)
+ return(pf2(sc, p));
+}
+
+static s7_pf_t or_pf(s7_scheme *sc, s7_pointer expr)
+{
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len == 3)
{
- s7_Int y;
- y = s7_integer(pw);
- if (y == 0)
- {
- /* (expt +nan.0 0) ?? */
- if ((number_type(n) == NUM_INT) || (number_type(n) == NUM_RATIO))
- return(small_int(1));
- return(real_one);
- }
+ int loc1, loc2, eloc;
+ xf_t *rc;
+ xf_init(3);
+ xf_save_loc3(loc1, loc2, eloc);
- if (number_type(n) == NUM_INT)
- {
- s7_Int x;
- x = s7_integer(n);
- if (x == 1)
- return(n);
-
- if (x == -1)
- {
- if (s7_Int_abs(y) & 1)
- return(n);
- return(small_int(1));
- }
+ if (!arg_to_pf(sc, cadr(expr), loc1)) return(NULL);
+ if (!arg_to_pf(sc, caddr(expr), loc2)) return(NULL);
+ xf_store_at(eloc, (s7_pointer)rc_loc(sc));
- if (y == S7_LLONG_MIN)
- return(small_int(0)); /* (expt x most-negative-fixnum) !! */
+ return(or_pf_xx);
+ }
+ return(NULL);
+}
- if (int_pow_ok(x, s7_Int_abs(y)))
- {
- if (y > 0)
- return(s7_make_integer(sc, int_to_int(x, y)));
- return(s7_make_ratio(sc, 1, int_to_int(x, -y)));
- }
- }
- else
- {
- if (number_type(n) == NUM_RATIO)
- {
- s7_Int nm, dn;
-
- nm = numerator(number(n));
- dn = denominator(number(n));
+static s7_pointer and_pf_xx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t pf1, pf2;
+ ptr_int e1;
- if ((int_pow_ok(nm, s7_Int_abs(y))) &&
- (int_pow_ok(dn, s7_Int_abs(y))))
- {
- if (y > 0)
- return(s7_make_ratio(sc, int_to_int(nm, y), int_to_int(dn, y)));
- return(s7_make_ratio(sc, int_to_int(dn, -y), int_to_int(nm, -y)));
- }
- }
- /* occasionally int^rat can be int but it happens so infrequently it's probably not worth checking
- * one possibly easy case: (expt 1 1/2) -> 1 etc
- */
- }
- }
+ pf1 = (s7_pf_t)(**p); (*p)++;
+ pf2 = (s7_pf_t)(**p); (*p)++;
+ e1 = (ptr_int)(**p); (*p)++;
- if ((s7_is_real(n)) &&
- (s7_is_real(pw)))
+ if (pf1(sc, p) == sc->F)
{
- s7_Double x, y;
-
- if ((number_type(pw) == NUM_RATIO) &&
- (numerator(number(pw)) == 1))
- {
- if (denominator(number(pw)) == 2)
- return(g_sqrt(sc, args));
- if (denominator(number(pw)) == 3)
- return(s7_make_real(sc, cbrt(num_to_real(number(n))))); /* (expt 27 1/3) should be 3, not 3.0... */
-
- /* but: (expt 512/729 1/3) -> 0.88888888888889
- */
- /* and 4 -> sqrt(sqrt...) etc? */
- }
+ (*p) = rc_go(sc, e1);
+ return(sc->F);
+ }
+ return(pf2(sc, p));
+}
- x = num_to_real(number(n));
- y = num_to_real(number(pw));
+static s7_pf_t and_pf(s7_scheme *sc, s7_pointer expr)
+{
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len == 3)
+ {
+ s7_int loc1, loc2, eloc;
+ xf_t *rc;
+ xf_init(3);
+ xf_save_loc3(loc1, loc2, eloc);
- if (isnan(x)) return(n);
- if (isnan(y)) return(pw);
- if (y == 0.0) return(real_one);
+ if (!arg_to_pf(sc, cadr(expr), loc1)) return(NULL);
+ if (!arg_to_pf(sc, caddr(expr), loc2)) return(NULL);
+ xf_store_at(eloc, (s7_pointer)rc_loc(sc));
- if ((x > 0.0) ||
- ((y - floor(y)) < 1.0e-16))
- return(s7_make_real(sc, pow(x, y)));
+ return(and_pf_xx);
}
-
- /* (expt 0+i 1e+16) = 0.98156860153485-0.19111012657867i ?
- * (expt 0+i 1+1/0i) = 0.0 ??
- */
- return(s7_from_c_complex(sc, cpow(s7_complex(n), s7_complex(pw))));
+ return(NULL);
}
+#endif
+
+/* -------------------------------- continuations and gotos -------------------------------- */
-static s7_Int c_lcm(s7_Int a, s7_Int b)
+static s7_pointer g_is_continuation(s7_scheme *sc, s7_pointer args)
{
- if ((a == 0) || (b == 0)) return(0);
- if (a < 0) a = -a;
- if (b < 0) b = -b;
- return((a / c_gcd(a, b)) * b);
+ #define H_is_continuation "(continuation? obj) returns #t if obj is a continuation"
+ #define Q_is_continuation pl_bt
+
+ check_boolean_method(sc, is_continuation, sc->IS_CONTINUATION, args);
+ /* is this the right thing? It returns #f for call-with-exit ("goto") because
+ * that form of continuation can't continue (via a jump back to its context).
+ * how to recognize the call-with-exit function? "goto" is an internal name.
+ */
}
-static s7_pointer g_lcm(s7_scheme *sc, s7_pointer args)
+static s7_pointer protected_list_copy(s7_scheme *sc, s7_pointer a)
{
- #define H_lcm "(lcm ...) returns the least common multiple of its rational arguments"
- int i;
- s7_Int n = 1, d = 0;
- bool rats = false;
- s7_pointer x;
+ s7_pointer slow, fast, p;
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_rational(car(x)))
- return(s7_wrong_type_arg_error(sc, "lcm", i, car(x), "an integer or ratio"));
- else rats = ((rats) || (number_type(car(x)) == NUM_RATIO));
+ sc->w = cons(sc, car(a), sc->NIL);
+ p = sc->w;
- if (!rats)
+ slow = fast = cdr(a);
+ while (true)
{
- for (x = args; x != sc->NIL; x = cdr(x))
+ if (!is_pair(fast))
{
- n = c_lcm(n, s7_integer(car(x)));
- if (n < 0) return(s7_out_of_range_error(sc, "lcm from", 0, args, "result is too large"));
- if (n == 0)
- return(small_int(0));
+ if (is_null(fast))
+ return(sc->w);
+ cdr(p) = fast;
+ return(sc->w);
}
- return(s7_make_integer(sc, n));
- }
- /* from A Jaffer */
- for (x = args; x != sc->NIL; x = cdr(x))
- {
- n = c_lcm(n, s7_numerator(car(x)));
- if (n < 0) return(s7_out_of_range_error(sc, "lcm from", 0, args, "result is too large"));
- if (n == 0)
- return(small_int(0));
- d = c_gcd(d, s7_denominator(car(x)));
+ cdr(p) = cons(sc, car(fast), sc->NIL);
+ p = cdr(p);
+
+ fast = cdr(fast);
+ if (!is_pair(fast))
+ {
+ if (is_null(fast))
+ return(sc->w);
+ cdr(p) = fast;
+ return(sc->w);
+ }
+ /* if unrolled further, it's a lot slower? */
+ cdr(p) = cons(sc, car(fast), sc->NIL);
+ p = cdr(p);
+
+ fast = cdr(fast);
+ slow = cdr(slow);
+ if (fast == slow)
+ {
+ /* try to preserve the original cyclic structure */
+ s7_pointer p1, f1, p2, f2;
+ set_match_pair(a);
+ for (p1 = sc->w, f1 = a; !(is_matched_pair(cdr(f1))); f1 = cdr(f1), p1 = cdr(p1))
+ set_match_pair(f1);
+ for (p2 = sc->w, f2 = a; cdr(f1) != f2; f2 = cdr(f2), p2 = cdr(p2))
+ clear_match_pair(f2);
+ for (f1 = f2; is_pair(f1); f1 = cdr(f1), f2 = cdr(f2))
+ {
+ clear_match_pair(f1);
+ f1 = cdr(f1);
+ clear_match_pair(f1);
+ if (f1 == f2) break;
+ }
+ if (is_null(p1))
+ cdr(p2) = p2;
+ else cdr(p1) = p2;
+ return(sc->w);
+ }
}
- return(s7_make_ratio(sc, n, d));
+ return(sc->w);
}
-static s7_pointer g_gcd(s7_scheme *sc, s7_pointer args)
+static s7_pointer copy_counter(s7_scheme *sc, s7_pointer obj)
{
- #define H_gcd "(gcd ...) returns the greatest common divisor of its rational arguments"
- int i;
- bool rats = false;
- s7_Int n = 0, d = 1;
- s7_pointer x;
+ s7_pointer nobj;
+ new_cell(sc, nobj, T_COUNTER);
+ counter_result(nobj) = counter_result(obj);
+ counter_list(nobj) = counter_list(obj);
+ counter_capture(nobj) = counter_capture(obj);
+ counter_set_let(nobj, counter_let(obj));
+ return(nobj);
+}
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_rational(car(x)))
- return(s7_wrong_type_arg_error(sc, "gcd", i, car(x), "an integer"));
- else rats = ((rats) || (number_type(car(x)) == NUM_RATIO));
-
- if (!rats)
+
+static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int top)
+{
+ #define CC_INITIAL_STACK_SIZE 256 /* 128 is too small here */
+ int i, len;
+ s7_pointer new_v;
+ s7_pointer *nv, *ov;
+
+ /* stacks can grow temporarily, so sc->stack_size grows, but we don't normally need all that
+ * leftover space here, so choose the original stack size if it's smaller.
+ */
+ len = vector_length(old_v);
+ if (len > CC_INITIAL_STACK_SIZE)
{
- for (x = args; x != sc->NIL; x = cdr(x))
- {
- n = c_gcd(n, s7_integer(car(x)));
- if (n < 0) return(s7_out_of_range_error(sc, "gcd from", 0, args, "intermediate result is too large"));
- if (n == 1) return(small_int(1));
- }
- return(s7_make_integer(sc, n));
+ if (top < CC_INITIAL_STACK_SIZE / 4)
+ len = CC_INITIAL_STACK_SIZE;
}
+ else
+ {
+ if (len < CC_INITIAL_STACK_SIZE)
+ len = CC_INITIAL_STACK_SIZE;
+ }
+ if ((int)(sc->free_heap_top - sc->free_heap) < (int)(sc->heap_size / 4)) gc(sc);
+ /* this gc call is needed if there are lots of call/cc's -- by pure bad luck
+ * we can end up hitting the end of the gc free list time after time while
+ * in successive copy_stack's below, causing s7 to core up until it runs out of memory.
+ */
+
+ new_v = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ set_type(new_v, T_STACK);
+ temp_stack_top(new_v) = top;
+ nv = vector_elements(new_v);
+ ov = vector_elements(old_v);
+ if (len > 0)
+ memcpy((void *)nv, (void *)ov, len * sizeof(s7_pointer));
- /* from A Jaffer */
- for (x = args; x != sc->NIL; x = cdr(x))
+ s7_gc_on(sc, false);
+#if DEBUGGING
+ check_types = false;
+#endif
+ for (i = 2; i < top; i += 4)
{
- n = c_gcd(n, s7_numerator(car(x)));
- if (n < 0) return(s7_out_of_range_error(sc, "gcd from", 0, args, "intermediate result is too large"));
- d = c_lcm(d, s7_denominator(car(x)));
- if (d < 0) return(s7_out_of_range_error(sc, "gcd from", 0, args, "intermediate result is too large"));
+ s7_pointer p;
+ p = ov[i]; /* args */
+ if (is_pair(p)) /* args need not be a list (it can be a port or #f, etc) */
+ nv[i] = protected_list_copy(sc, p); /* args (copy is needed -- see s7test.scm) */
+ /* lst can be dotted or circular here. The circular list only happens in a case like:
+ * (dynamic-wind (lambda () (eq? (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (call/cc (lambda (k) k)))) (lambda () #f) (lambda () #f))
+ */
+ else
+ {
+ if (is_counter(p)) /* these can only occur in this context */
+ nv[i] = copy_counter(sc, p);
+ }
}
- return(s7_make_ratio(sc, n, d));
+#if DEBUGGING
+ check_types = true;
+#endif
+ s7_gc_on(sc, true);
+ return(new_v);
}
-static s7_pointer s7_truncate(s7_scheme *sc, const char *caller, s7_Double xf) /* can't use "truncate" -- it's in unistd.h */
+static s7_pointer make_goto(s7_scheme *sc)
{
- if ((xf > S7_LLONG_MAX) ||
- (xf < S7_LLONG_MIN))
- return(s7_out_of_range_error(sc, caller, 0, s7_make_real(sc, xf), "too large to express as an integer"));
-
- if (xf > 0.0)
- return(s7_make_integer(sc, (s7_Int)floor(xf)));
- return(s7_make_integer(sc, (s7_Int)ceil(xf)));
+ s7_pointer x;
+ new_cell(sc, x, T_GOTO | T_PROCEDURE);
+ call_exit_goto_loc(x) = s7_stack_top(sc);
+ call_exit_op_loc(x) = (int)(sc->op_stack_now - sc->op_stack);
+ call_exit_active(x) = true;
+ return(x);
}
-static s7_pointer quotient(s7_scheme *sc, const char *caller, s7_num_t a, s7_num_t b)
+static s7_pointer *copy_op_stack(s7_scheme *sc)
{
- /* (define (quo x1 x2) (truncate (/ x1 x2))) ; slib */
+ int len;
+ s7_pointer *ops;
+ ops = (s7_pointer *)malloc(sc->op_stack_size * sizeof(s7_pointer));
+ len = (int)(sc->op_stack_now - sc->op_stack);
+ if (len > 0)
+ memcpy((void *)ops, (void *)(sc->op_stack), len * sizeof(s7_pointer));
+ return(ops);
+}
- switch (a.type | b.type)
- {
- case NUM_INT:
- return(s7_make_integer(sc, integer(a) / integer(b)));
- case NUM_RATIO:
- {
- s7_Int d1, d2, n1, n2;
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
- if (d1 == d2)
- return(s7_make_integer(sc, n1 / n2)); /* (quotient 3/9223372036854775807 1/9223372036854775807) */
- if (n1 == n2)
- return(s7_make_integer(sc, d2 / d1)); /* (quotient 9223372036854775807/2 9223372036854775807/8) */
-
- if ((integer_length(n1) + integer_length(d2) >= s7_int_bits) ||
- (integer_length(n2) + integer_length(d1) >= s7_int_bits))
- return(s7_truncate(sc, caller, num_to_real(a) / num_to_real(b)));
- /* this can lose:
- * (quotient 1 2305843009213693952/4611686018427387903) -> 2, not 1
- * (quotient 21053343141/6701487259 3587785776203/1142027682075) -> 1, not 0
- */
+/* (with-baffle . body) calls body guaranteeing that there can be no jumps into the
+ * middle of it from outside -- no outer evaluation of a continuation can jump across this
+ * barrier: The flip-side of call-with-exit.
+ * It sets a T_BAFFLE var in a new env, that has a unique key. Call/cc then always
+ * checks the env chain for any such variable, saving the localmost. Apply of a continuation
+ * looks for such a saved variable, if none, go ahead, else check the current env (before the
+ * jump) for that variable. If none, error, else go ahead. This is different from a delimited
+ * continuation which simply delimits the extent of the continuation (why not use lambda?) -- we want to block it
+ * from coming at us from some unknown place.
+ */
- return(s7_make_integer(sc, (n1 * d2) / (n2 * d1))); /* (quotient 922337203685477580 1/3) */
- }
-
- default:
- return(s7_truncate(sc, caller, num_to_real(a) / num_to_real(b)));
- }
+static s7_pointer make_baffle(s7_scheme *sc)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_BAFFLE);
+ baffle_key(x) = sc->baffle_ctr++;
+ return(x);
}
-static s7_pointer g_quotient(s7_scheme *sc, s7_pointer args)
+static bool find_baffle(s7_scheme *sc, int key)
{
- #define H_quotient "(quotient x1 x2) returns the integer quotient of x1 and x2; (quotient 4 3) = 1"
-
+ /* search backwards through sc->envir for sc->BAFFLE with key as value
+ */
s7_pointer x, y;
- x = car(args);
- y = cadr(args);
+ for (x = sc->envir; is_let(x); x = outlet(x))
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if ((slot_symbol(y) == sc->BAFFLE) &&
+ (baffle_key(slot_value(y)) == key))
+ return(true);
- if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "quotient", 1, x, "a real"));
- if (!s7_is_real(y))
- return(s7_wrong_type_arg_error(sc, "quotient", 2, y, "a real"));
+ if ((is_slot(global_slot(sc->BAFFLE))) &&
+ (is_baffle(slot_value(global_slot(sc->BAFFLE)))))
+ return(baffle_key(slot_value(global_slot(sc->BAFFLE))) == key);
- if (s7_is_zero(y))
- return(division_by_zero_error(sc, "quotient", args));
+ return(false);
+}
- if (number_type(x) > NUM_RATIO)
- {
- s7_Double rx;
- rx = real(number(x));
- if ((isinf(rx)) || (isnan(rx)))
- return(s7_wrong_type_arg_error(sc, "quotient", 1, x, "a normal real"));
- }
- if (number_type(y) > NUM_RATIO)
+static int find_any_baffle(s7_scheme *sc)
+{
+ /* search backwards through sc->envir for any sc->BAFFLE
+ */
+ if (sc->baffle_ctr > 0)
{
- s7_Double ry;
- ry = real(number(y));
- if ((isinf(ry)) || (isnan(ry)))
- return(s7_wrong_type_arg_error(sc, "quotient", 2, y, "a normal real"));
+ s7_pointer x, y;
+ for (x = sc->envir; is_let(x); x = outlet(x))
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == sc->BAFFLE)
+ return(baffle_key(slot_value(y)));
- /* if infs allowed we need to return infs/nans, else:
- * (quotient inf.0 1e-309) -> -9223372036854775808
- * (quotient inf.0 inf.0) -> -9223372036854775808
- */
+ if ((is_slot(global_slot(sc->BAFFLE))) &&
+ (is_baffle(slot_value(global_slot(sc->BAFFLE)))))
+ return(baffle_key(slot_value(global_slot(sc->BAFFLE))));
}
-
- return(quotient(sc, "quotient", number(car(args)), number(cadr(args))));
+ return(-1);
}
-static s7_pointer g_remainder(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_make_continuation(s7_scheme *sc)
{
- #define H_remainder "(remainder x1 x2) returns the integer remainder of x1 and x2; (remainder 10 3) = 1"
- /* (define (rem x1 x2) (- x1 (* x2 (quo x1 x2)))) ; slib */
+ s7_pointer x, stack;
+ int loc;
- s7_pointer ap, bp;
- s7_num_t a, b;
-
- ap = car(args);
- if (!s7_is_real(ap))
- return(s7_wrong_type_arg_error(sc, "remainder", 1, ap, "a real"));
+ loc = s7_stack_top(sc);
+ stack = copy_stack(sc, sc->stack, loc);
+ sc->temp8 = stack;
- bp = cadr(args);
- if (!s7_is_real(bp))
- return(s7_wrong_type_arg_error(sc, "remainder", 2, bp, "a real"));
+ new_cell(sc, x, T_CONTINUATION | T_PROCEDURE);
+ continuation_data(x) = (continuation_t *)malloc(sizeof(continuation_t));
+ continuation_stack(x) = stack;
+ continuation_stack_size(x) = vector_length(continuation_stack(x)); /* copy_stack can return a smaller stack than the current one */
+ continuation_stack_start(x) = vector_elements(continuation_stack(x));
+ continuation_stack_end(x) = (s7_pointer *)(continuation_stack_start(x) + loc);
+ continuation_op_stack(x) = copy_op_stack(sc); /* no heap allocation here */
+ continuation_op_loc(x) = (int)(sc->op_stack_now - sc->op_stack);
+ continuation_op_size(x) = sc->op_stack_size;
+ continuation_key(x) = find_any_baffle(sc);
- if (s7_is_zero(bp))
- return(division_by_zero_error(sc, "remainder", args));
+ add_continuation(sc, x);
+ return(x);
+}
- if ((number_type(ap) > NUM_RATIO) &&
- (isnan(real(number(ap))))) /* (remainder 1 (string->number "nan.0")) */
- return(s7_wrong_type_arg_error(sc, "remainder", 1, ap, "a normal real"));
- if ((number_type(bp) > NUM_RATIO) &&
- (isnan(real(number(bp)))))
- return(s7_wrong_type_arg_error(sc, "remainder", 2, bp, "a normal real"));
- a = number(ap);
- b = number(bp);
+static bool check_for_dynamic_winds(s7_scheme *sc, s7_pointer c)
+{
+ int i, s_base = 0, c_base = -1;
+ opcode_t op;
- switch (num_type(a) | num_type(b))
+ for (i = s7_stack_top(sc) - 1; i > 0; i -= 4)
{
- case NUM_INT:
- return(s7_make_integer(sc, integer(a) % integer(b)));
-
- case NUM_RATIO:
- {
- /* as usual with ratios, there are lots of tricky cases */
- s7_Int quo, n1, n2, d1, d2;
+ op = stack_op(sc->stack, i);
+ switch (op)
+ {
+ case OP_DYNAMIC_WIND:
+ {
+ s7_pointer x;
+ int j;
+ x = stack_code(sc->stack, i);
+ for (j = 3; j < continuation_stack_top(c); j += 4)
+ if ((stack_op(continuation_stack(c), j) == OP_DYNAMIC_WIND) &&
+ (x == stack_code(continuation_stack(c), j)))
+ {
+ s_base = i;
+ c_base = j;
+ break;
+ }
- quo = s7_integer(quotient(sc, "remainder", a, b));
- if (quo == 0)
- return(ap);
+ if (s_base != 0)
+ break;
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
+ if (dynamic_wind_state(x) == DWIND_BODY)
+ {
+ dynamic_wind_state(x) = DWIND_FINISH;
+ if (dynamic_wind_out(x) != sc->F)
+ {
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = sc->NIL;
+ sc->code = dynamic_wind_out(x);
+ eval(sc, OP_APPLY);
+ }
+ }
+ }
+ break;
- if ((d1 == d2) &&
- ((integer_length(n2) + integer_length(quo)) < s7_int_bits))
- return(s7_make_ratio(sc, n1 - n2 * quo, d1));
-
- if ((integer_length(n1) + integer_length(d2) < s7_int_bits) &&
- (integer_length(d1) + integer_length(d2) < s7_int_bits) &&
- (integer_length(n2) + integer_length(d1) + integer_length(quo) < s7_int_bits))
- return(s7_make_ratio(sc, n1 * d2 - n2 * d1 * quo, d1 * d2));
+ case OP_BARRIER:
+ if (i > continuation_stack_top(c)) /* otherwise it's some unproblematic outer eval-string? */
+ return(false); /* but what if we've already evaluated a dynamic-wind closer? */
+ break;
- return(s7_out_of_range_error(sc, "remainder", 0, ap, "intermediate (a/b) is too large"));
- }
+ case OP_DEACTIVATE_GOTO: /* here we're jumping out of an unrelated call-with-exit block */
+ if (i > continuation_stack_top(c))
+ call_exit_active(stack_args(sc->stack, i)) = false;
+ break;
- default:
- {
- s7_Int quo;
- quo = s7_integer(quotient(sc, "remainder", a, b));
- if (quo == 0)
- return(ap);
-
- return(s7_make_real(sc, num_to_real(a) - num_to_real(b) * quo));
-
- /* see under sin -- this calculation is completely bogus if "a" is large
- * (quotient 1e22 (* 2 pi)) -> -9223372036854775808 -- should this return arithmetic-overflow?
- * but it should be 1591549430918953357688,
- * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22
- * -- the "remainder" is greater than the original argument!
- * Clisp gives 0.0 here, as does sbcl
- * currently s7 throws an error (out-of-range).
- */
- }
+ default:
+ break;
+ }
}
-}
-
-
-static s7_pointer g_floor(s7_scheme *sc, s7_pointer args)
-{
- #define H_floor "(floor x) returns the integer closest to x toward -inf"
- s7_pointer x;
-
- x = car(args);
- if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "floor", 0, x, "a real"));
- switch (number_type(x))
+ for (i = c_base + 4; i < continuation_stack_top(c); i += 4)
{
- case NUM_INT:
- return(x);
-
- case NUM_RATIO:
- {
- s7_Int val;
- val = numerator(number(x)) / denominator(number(x));
- /* C "/" truncates? -- C spec says "truncation toward 0" */
- /* we're avoiding "floor" here because the int->double conversion introduces inaccuracies for big numbers */
- if (numerator(number(x)) < 0) /* not "val" because it might be truncated to 0 */
- return(s7_make_integer(sc, val - 1));
- return(s7_make_integer(sc, val));
- }
+ op = stack_op(continuation_stack(c), i);
- default:
- {
- s7_Double z;
- z = real(number(x));
- if (isnan(z))
- return(s7_out_of_range_error(sc, "floor", 0, x, "argument is NaN"));
- if (isinf(z))
- return(s7_out_of_range_error(sc, "floor", 0, x, "argument is infinite"));
-
- /* I used to check for a big real arg here and throw and error, but that
- * can't work in general (see s7test), and gives the programmer a false
- * sense of security.
- */
- return(s7_make_integer(sc, (s7_Int)floor(real(number(x)))));
- }
+ if (op == OP_DYNAMIC_WIND)
+ {
+ s7_pointer x;
+ x = stack_code(continuation_stack(c), i);
+ if (dynamic_wind_in(x) != sc->F)
+ {
+ /* this can cause an infinite loop if the call/cc is trying to jump back into
+ * a dynamic-wind init function -- it's even possible to trick with-baffle!
+ * I can't find any fool-proof way to catch this problem.
+ */
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = sc->NIL;
+ sc->code = dynamic_wind_in(x);
+ eval(sc, OP_APPLY);
+ }
+ dynamic_wind_state(x) = DWIND_BODY;
+ }
+ else
+ {
+ if (op == OP_DEACTIVATE_GOTO)
+ call_exit_active(stack_args(continuation_stack(c), i)) = true;
+ }
}
+ return(true);
}
-static s7_pointer g_ceiling(s7_scheme *sc, s7_pointer args)
+static bool call_with_current_continuation(s7_scheme *sc)
{
- #define H_ceiling "(ceiling x) returns the integer closest to x toward inf"
- s7_pointer x;
-
- x = car(args);
- if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "ceiling", 0, x, "a real"));
-
- switch (number_type(x))
- {
- case NUM_INT:
- return(x);
-
- case NUM_RATIO:
- {
- s7_Int val;
- val = numerator(number(x)) / denominator(number(x));
- if (numerator(number(x)) < 0)
- return(s7_make_integer(sc, val));
- return(s7_make_integer(sc, val + 1));
- }
+ s7_pointer c;
+ c = sc->code;
- default:
- {
- s7_Double z;
- z = real(number(x));
- if (isnan(z))
- return(s7_out_of_range_error(sc, "ceiling", 0, x, "argument is NaN"));
- if (isinf(z))
- return(s7_out_of_range_error(sc, "ceiling", 0, x, "argument is infinite"));
- return(s7_make_integer(sc, (s7_Int)ceil(real(number(x)))));
- }
- }
-}
+ /* check for (baffle ...) blocking the current attempt to continue */
+ if ((continuation_key(c) >= 0) &&
+ (!(find_baffle(sc, continuation_key(c))))) /* should this raise an error? */
+ return(false);
+ if (!check_for_dynamic_winds(sc, c)) /* if OP_BARRIER on stack deeper than continuation top(?), but can this happen? (it doesn't in s7test) */
+ return(true);
-static s7_pointer g_truncate(s7_scheme *sc, s7_pointer args)
-{
- #define H_truncate "(truncate x) returns the integer closest to x toward 0"
- s7_pointer x;
+ /* we push_stack sc->code before calling an embedded eval above, so sc->code should still be c here, etc
+ */
+ sc->stack = copy_stack(sc, continuation_stack(c), continuation_stack_top(c));
+ sc->stack_size = continuation_stack_size(c);
+ sc->stack_start = vector_elements(sc->stack);
+ sc->stack_end = (s7_pointer *)(sc->stack_start + continuation_stack_top(c));
+ sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2);
- x = car(args);
- if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "truncate", 0, x, "a real"));
+ {
+ int i, top;
+ top = continuation_op_loc(c);
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + top);
+ sc->op_stack_size = continuation_op_size(c);
+ sc->op_stack_end = (s7_pointer *)(sc->op_stack + sc->op_stack_size);
+ for (i = 0; i < top; i++)
+ sc->op_stack[i] = continuation_op_stack(c)[i];
+ }
- switch (number_type(x))
+ if (is_null(sc->args))
+ sc->value = sc->NIL;
+ else
{
- case NUM_INT:
- return(x);
-
- case NUM_RATIO:
- return(s7_make_integer(sc, (s7_Int)(numerator(number(x)) / denominator(number(x))))); /* C "/" already truncates */
-
- default:
- {
- s7_Double z;
- z = real(number(x));
- if (isnan(z))
- return(s7_out_of_range_error(sc, "truncate", 0, x, "argument is NaN"));
- if (isinf(z))
- return(s7_out_of_range_error(sc, "truncate", 0, x, "argument is infinite"));
- return(s7_truncate(sc, "truncate", real(number(x))));
- }
+ if (is_null(cdr(sc->args)))
+ sc->value = car(sc->args);
+ else sc->value = splice_in_values(sc, sc->args);
}
+ return(true);
}
-static s7_Double round_per_R5RS(s7_Double x)
-{
- s7_Double fl = floor(x);
- s7_Double ce = ceil(x);
- s7_Double dfl = x - fl;
- s7_Double dce = ce - x;
-
- if (dfl > dce) return(ce);
- if (dfl < dce) return(fl);
- if (fmod(fl, 2.0) == 0.0) return(fl);
- return(ce);
-}
-
-
-static s7_pointer g_round(s7_scheme *sc, s7_pointer args)
+static void call_with_exit(s7_scheme *sc)
{
- #define H_round "(round x) returns the integer closest to x"
- s7_pointer x;
-
- x = car(args);
- if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "round", 0, x, "a real"));
+ int i, new_stack_top, quit = 0;
- switch (number_type(x))
+ if (!call_exit_active(sc->code))
{
- case NUM_INT:
- return(x);
+ static s7_pointer call_with_exit_error = NULL;
+ if (!call_with_exit_error)
+ call_with_exit_error = s7_make_permanent_string("call-with-exit escape procedure called outside its block");
+ s7_error(sc, sc->INVALID_ESCAPE_FUNCTION, set_elist_1(sc, call_with_exit_error));
+ }
- case NUM_RATIO:
- {
- s7_Int truncated, remains;
- long double frac;
+ call_exit_active(sc->code) = false;
+ new_stack_top = call_exit_goto_loc(sc->code);
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + call_exit_op_loc(sc->code));
- truncated = numerator(number(x)) / denominator(number(x));
- remains = numerator(number(x)) % denominator(number(x));
- frac = s7_fabsl((long double)remains / (long double)denominator(number(x)));
+ /* look for dynamic-wind in the stack section that we are jumping out of */
+ for (i = s7_stack_top(sc) - 1; i > new_stack_top; i -= 4)
+ {
+ opcode_t op;
- if ((frac > 0.5) ||
- ((frac == 0.5) &&
- (truncated % 2 != 0)))
+ op = stack_op(sc->stack, i);
+ switch (op)
+ {
+ case OP_DYNAMIC_WIND:
{
- if (numerator(number(x)) < 0)
- return(s7_make_integer(sc, truncated - 1));
- return(s7_make_integer(sc, truncated + 1));
+ s7_pointer lx;
+ lx = stack_code(sc->stack, i);
+ if (dynamic_wind_state(lx) == DWIND_BODY)
+ {
+ dynamic_wind_state(lx) = DWIND_FINISH;
+ if (dynamic_wind_out(lx) != sc->F)
+ {
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = sc->NIL;
+ sc->code = dynamic_wind_out(lx);
+ eval(sc, OP_APPLY);
+ }
+ }
}
- return(s7_make_integer(sc, truncated));
- }
+ break;
- default:
- {
- s7_Double z;
- z = real(number(x));
- if (isnan(z))
- return(s7_out_of_range_error(sc, "round", 0, x, "argument is NaN"));
- if (isinf(z))
- return(s7_out_of_range_error(sc, "round", 0, x, "argument is infinite"));
- return(s7_make_integer(sc, (s7_Int)round_per_R5RS(real(number(x)))));
- }
- }
-}
+ case OP_EVAL_STRING_2:
+ s7_close_input_port(sc, sc->input_port);
+ pop_input_port(sc);
+ break;
+ case OP_BARRIER: /* oops -- we almost certainly went too far */
+ return;
-static s7_Int c_mod(s7_Int x, s7_Int y)
-{
- s7_Int z;
- if (y == 0) return(x); /* else arithmetic exception */
- z = x % y;
- if (((y < 0) && (z > 0)) ||
- ((y > 0) && (z < 0)))
- return(z + y);
- return(z);
-}
+ case OP_DEACTIVATE_GOTO: /* here we're jumping into an unrelated call-with-exit block */
+ call_exit_active(stack_args(sc->stack, i)) = false;
+ break;
+ /* call/cc does not close files, but I think call-with-exit should */
+ case OP_GET_OUTPUT_STRING_1:
+ case OP_UNWIND_OUTPUT:
+ {
+ s7_pointer x;
+ x = stack_code(sc->stack, i); /* "code" = port that we opened */
+ s7_close_output_port(sc, x);
+ x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #f */
+ if (x != sc->F)
+ sc->output_port = x;
+ }
+ break;
-static s7_pointer g_modulo(s7_scheme *sc, s7_pointer args)
-{
- #define H_modulo "(modulo x1 x2) returns x1 mod x2; (modulo 4 3) = 1. The arguments can be real numbers."
- s7_pointer ap, bp;
- s7_num_t a, b;
- /* (define (mod x1 x2) (- x1 (* x2 (floor (/ x1 x2))))) ; slib */
+ case OP_UNWIND_INPUT:
+ s7_close_input_port(sc, stack_code(sc->stack, i)); /* "code" = port that we opened */
+ sc->input_port = stack_args(sc->stack, i); /* "args" = port that we shadowed */
+ break;
- ap = car(args);
- if (!s7_is_real(ap))
- return(s7_wrong_type_arg_error(sc, "modulo", 1, ap, "a real"));
+ case OP_EVAL_DONE: /* goto called in a method -- put off the inner eval return(s) until we clean up the stack */
+ quit++;
+ break;
- bp = cadr(args);
- if (!s7_is_real(bp))
- return(s7_wrong_type_arg_error(sc, "modulo", 2, bp, "a real"));
+ default:
+ break;
+ }
+ }
- if (s7_is_zero(bp))
- return(ap); /* (mod x 0) = x according to "Concrete Mathematics" */
-
- a = number(ap);
- b = number(bp);
+ sc->stack_end = (s7_pointer *)(sc->stack_start + new_stack_top);
- switch (num_type(a) | num_type(b))
+ /* the return value should have an implicit values call, just as in call/cc */
+ if (is_null(sc->args))
+ sc->value = sc->NIL;
+ else
{
- case NUM_INT:
- return(s7_make_integer(sc, c_mod(integer(a), integer(b))));
-
- case NUM_RATIO: /* a or b might be integer here, hence the num_to_* */
- {
- s7_Int n1, n2, d1, d2;
-
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
-
- if (d1 == d2)
- return(s7_make_ratio(sc, c_mod(n1, n2), d1));
-
- if ((n1 == n2) &&
- (d1 > d2))
- return(ap); /* signs match so this should be ok */
-
- if ((integer_length(n1) + integer_length(d2) < s7_int_bits) &&
- (integer_length(n2) + integer_length(d1) < s7_int_bits) &&
- (integer_length(d1) + integer_length(d2) < s7_int_bits))
- {
- s7_Int n1d2, n2d1, fl;
- n1d2 = n1 * d2;
- n2d1 = n2 * d1;
-
- if (n2d1 == 1)
- return(small_int(0));
-
- /* can't use "floor" here (int->float ruins everything) */
- fl = (s7_Int)(n1d2 / n2d1);
- if (((n1 < 0) && (n2 > 0)) ||
- ((n1 > 0) && (n2 < 0)))
- fl -= 1;
-
- if (fl == 0)
- return(ap);
-
- if (integer_length(n2d1) + integer_length(fl) < s7_int_bits)
- return(s7_make_ratio(sc, n1d2 - (n2d1 * fl), d1 * d2));
- }
+ if (is_null(cdr(sc->args)))
+ sc->value = car(sc->args);
+ else sc->value = splice_in_values(sc, sc->args);
+ }
- /* there are cases here we might want to catch:
- * (modulo 1/9223372036 9223372036) -> error, not 1/9223372036?
- * (modulo 9223372036 1/9223372036) -> error, not 0?
- * (modulo 1 1/9223372036854775807) -> error, not 0?
- * (modulo 1/9223372036854775807 9223372036854775807) -> error, not 1/9223372036854775807?
- */
- return(s7_out_of_range_error(sc, "modulo", 0, ap, "intermediate (a/b) is too large"));
- }
+ if (quit > 0)
+ {
+ if (sc->longjmp_ok)
+ {
+ pop_stack(sc);
+ longjmp(sc->goto_start, 1);
+ }
+ for (i = 0; i < quit; i++)
+ push_stack(sc, OP_EVAL_DONE, sc->NIL, sc->NIL);
+ }
+}
- default:
- {
- s7_Double ax, bx, cx;
- ax = num_to_real(a);
- if (isnan(ax)) return(ap);
+static s7_pointer g_call_cc(s7_scheme *sc, s7_pointer args)
+{
+ #define H_call_cc "(call-with-current-continuation func) is always a mistake!"
+ #define Q_call_cc s7_make_signature(sc, 2, sc->VALUES, sc->IS_PROCEDURE)
+ /* I think the intent is that sc->VALUES as the proc-sig return type indicates multiple values are possible (otherwise use #t). */
- bx = num_to_real(b);
- if (isnan(bx)) return(bp);
+ s7_pointer p;
+ p = car(args); /* this is the procedure passed to call/cc */
+ if (!is_procedure(p)) /* this includes continuations */
+ {
+ check_two_methods(sc, p, sc->CALL_CC, sc->CALL_WITH_CURRENT_CONTINUATION, args);
+ return(simple_wrong_type_argument_with_type(sc, sc->CALL_CC, p, A_PROCEDURE));
+ }
+ if (!s7_is_aritable(sc, p, 1))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "call/cc procedure, ~A, should take one argument"), p)));
- if ((isinf(ax)) || (isinf(bx)))
- return(s7_make_real(sc, NAN));
+ sc->w = s7_make_continuation(sc);
+ push_stack(sc, OP_APPLY, list_1(sc, sc->w), p);
+ sc->w = sc->NIL;
- cx = ax / bx;
- return(s7_make_real(sc, ax - bx * (s7_Int)floor(cx)));
- }
- }
+ return(sc->NIL);
}
-#endif
-/* !WITH_GMP */
+/* we can't naively optimize call/cc to call-with-exit if the continuation is only
+ * used as a function in the call/cc body because it might (for example) be wrapped
+ * in a lambda form that is being exported. See b-func in s7test for an example.
+ */
-static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_call_with_exit(s7_scheme *sc, s7_pointer args)
{
- #define H_add "(+ ...) adds its arguments"
- int i, ret_type;
- s7_pointer x;
- s7_num_t a, b;
+ #define H_call_with_exit "(call-with-exit func) is call/cc without the ability to jump back into a previous computation."
+ #define Q_call_with_exit s7_make_signature(sc, 2, sc->VALUES, sc->IS_PROCEDURE)
-#if (!WITH_GMP)
- if (args == sc->NIL)
- return(small_int(0));
+ s7_pointer p, x;
+ /* (call-with-exit (lambda (return) ...)) */
+ p = car(args);
+ if (!is_procedure(p)) /* this includes continuations */
+ method_or_bust_with_type(sc, p, sc->CALL_WITH_EXIT, args, A_PROCEDURE, 0);
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "+", 1, car(args), "a number"));
-#endif
-
- x = cdr(args);
- if (x == sc->NIL)
- return(car(args));
+ x = make_goto(sc);
+ push_stack(sc, OP_DEACTIVATE_GOTO, x, p); /* this means call-with-exit is not tail-recursive */
+ push_stack(sc, OP_APPLY, cons_unchecked(sc, x, sc->NIL), p);
+
+ /* if the lambda body calls the argument as a function,
+ * it is applied to its arguments, apply notices that it is a goto, and...
+ *
+ * (conceptually...) sc->stack_top = call_exit_goto_loc(sc->code);
+ * s_pop(sc, (is_not_null(sc->args)) ? car(sc->args) : sc->NIL);
+ *
+ * which jumps to the point of the goto returning car(args).
+ *
+ * There is one gotcha: we can't jump back in from outside, so if the caller saves the goto
+ * and tries to invoke it outside the call-with-exit block, we have to
+ * make sure it triggers an error. So, if the escape is called, it then
+ * deactivates itself. Otherwise the block returns, we pop to OP_DEACTIVATE_GOTO,
+ * and it finds the goto in sc->args.
+ * Even worse:
+ *
+ (let ((cc #f))
+ (call-with-exit
+ (lambda (c3)
+ (call/cc (lambda (ret) (set! cc ret)))
+ (c3)))
+ (cc))
+ *
+ * where we jump back into a call-with-exit body via call/cc, the goto has to be
+ * re-established.
+ *
+ * I think call-with-exit could be based on catch, but it's a simpler notion,
+ * and certainly at the source level it is easier to read.
+ */
+ return(sc->NIL);
+}
+
+
+
+/* -------------------------------- numbers -------------------------------- */
- i = 2;
- a = number(car(args));
- while (true)
- {
#if WITH_GMP
- switch (a.type)
- {
- case NUM_INT:
- if ((integer(a) > S7_LONG_MAX) ||
- (integer(a) < S7_LONG_MIN))
- return(big_add(sc, s7_cons(sc, s7_Int_to_big_integer(sc, integer(a)), x)));
- break;
+ static char *big_number_to_string_with_radix(s7_pointer p, int radix, int width, int *nlen, use_write_t use_write);
+ static bool big_numbers_are_eqv(s7_pointer a, s7_pointer b);
+ static s7_pointer string_to_either_integer(s7_scheme *sc, const char *str, int radix);
+ static s7_pointer string_to_either_ratio(s7_scheme *sc, const char *nstr, const char *dstr, int radix);
+ static s7_pointer string_to_either_real(s7_scheme *sc, const char *str, int radix);
+ static s7_pointer string_to_either_complex(s7_scheme *sc, char *q, char *slash1, char *ex1, bool has_dec_point1,
+ char *plus, char *slash2, char *ex2, bool has_dec_point2, int radix, int has_plus_or_minus);
+ static s7_pointer big_add(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_subtract(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_multiply(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_divide(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_random(s7_scheme *sc, s7_pointer args);
+ static s7_pointer s7_int_to_big_integer(s7_scheme *sc, s7_int val);
+ static s7_pointer s7_ratio_to_big_ratio(s7_scheme *sc, s7_int num, s7_int den);
+ static s7_pointer s7_number_to_big_real(s7_scheme *sc, s7_pointer p);
+ static s7_pointer promote_number(s7_scheme *sc, int type, s7_pointer x);
+ static s7_pointer big_equal(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_negate(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_invert(s7_scheme *sc, s7_pointer args);
+#if (!WITH_PURE_S7)
+ static s7_pointer big_inexact_to_exact(s7_scheme *sc, s7_pointer args);
+ static s7_pointer big_exact_to_inexact(s7_scheme *sc, s7_pointer args);
+#endif
+ static s7_pointer mpz_to_big_integer(s7_scheme *sc, mpz_t val);
+ static s7_pointer mpq_to_big_ratio(s7_scheme *sc, mpq_t val);
+ static s7_pointer mpfr_to_big_real(s7_scheme *sc, mpfr_t val);
+ static s7_pointer mpc_to_big_complex(s7_scheme *sc, mpc_t val);
+#endif
- case NUM_RATIO:
- if ((numerator(a) > S7_LONG_MAX) ||
- (denominator(a) > S7_LONG_MAX) ||
- (numerator(a) < S7_LONG_MIN))
- return(big_add(sc, s7_cons(sc, s7_ratio_to_big_ratio(sc, (numerator(a)), denominator(a)), x)));
- break;
- }
+#define HAVE_OVERFLOW_CHECKS ((defined(__clang__) && ((__clang_major__ > 3) || (__clang_major__ == 3 && __clang_minor__ >= 4))) || \
+ (defined(__GNUC__) && __GNUC__ >= 5))
+
+#if (defined(__clang__) && ((__clang_major__ > 3) || (__clang_major__ == 3 && __clang_minor__ >= 4)))
+ #define subtract_overflow(A, B, C) __builtin_ssubll_overflow(A, B, C)
+ #define add_overflow(A, B, C) __builtin_saddll_overflow(A, B, C)
+ #define multiply_overflow(A, B, C) __builtin_smulll_overflow(A, B, C)
+ #define int_subtract_overflow(A, B, C) __builtin_ssub_overflow(A, B, C)
+ #define int_add_overflow(A, B, C) __builtin_sadd_overflow(A, B, C)
+ #define int_multiply_overflow(A, B, C) __builtin_smul_overflow(A, B, C)
#else
- if (!s7_is_number(car(x)))
- return(s7_wrong_type_arg_error(sc, "+", i, car(x), "a number"));
+#if (defined(__GNUC__) && __GNUC__ >= 5)
+ #define subtract_overflow(A, B, C) __builtin_sub_overflow(A, B, C)
+ #define add_overflow(A, B, C) __builtin_add_overflow(A, B, C)
+ #define multiply_overflow(A, B, C) __builtin_mul_overflow(A, B, C)
+ #define int_subtract_overflow(A, B, C) __builtin_sub_overflow(A, B, C)
+ #define int_add_overflow(A, B, C) __builtin_add_overflow(A, B, C)
+ #define int_multiply_overflow(A, B, C) __builtin_mul_overflow(A, B, C)
#endif
-
- b = number(car(x));
- ret_type = a.type | b.type;
- x = cdr(x);
-
- switch (ret_type)
- {
- case NUM_INT:
- if (x == sc->NIL)
- return(s7_make_integer(sc, integer(a) + integer(b)));
- integer(a) += integer(b);
- break;
-
- case NUM_RATIO:
- {
- s7_Int d1, d2, n1, n2;
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
- if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 + n2, d1));
- a = make_ratio(n1 + n2, d1); /* d1 can't be zero */
- }
- else
- {
-#if (!WITH_GMP)
- if ((d1 > s7_int_max) || (d2 > s7_int_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int_max) || (n2 > s7_int_max) ||
- (n1 < s7_int_min) || (n2 < s7_int_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- {
- if (x == sc->NIL)
- return(s7_make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
- a.type = NUM_REAL;
- real(a) = ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2);
- /* this can lose:
- * (+ 1 1/9223372036854775807 -1) -> 0.0 not 1/9223372036854775807
- */
- }
- else
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 * d2 + n2 * d1, d1 * d2));
- a = make_ratio(n1 * d2 + n2 * d1, d1 * d2);
- }
- }
- else
#endif
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 * d2 + n2 * d1, d1 * d2));
- a = make_ratio(n1 * d2 + n2 * d1, d1 * d2);
- }
- }
- }
- break;
-
- case NUM_REAL2:
- case NUM_REAL:
- if (x == sc->NIL)
- return(s7_make_real(sc, num_to_real(a) + num_to_real(b)));
- real(a) = num_to_real(a) + num_to_real(b);
- a.type = NUM_REAL;
- break;
-
- default:
- /* NUM_COMPLEX is 4 separate types */
- if (x == sc->NIL)
- return(s7_make_complex(sc, num_to_real_part(a) + num_to_real_part(b), num_to_imag_part(a) + num_to_imag_part(b)));
- real_part(a) = num_to_real_part(a) + num_to_real_part(b);
- imag_part(a) = num_to_imag_part(a) + num_to_imag_part(b);
- if (imag_part(a) == 0.0)
- a.type = NUM_REAL;
- else a.type = NUM_COMPLEX;
- break;
- }
- i++;
- }
- return(s7_error(sc, make_symbol(sc, "internal-error"),
- make_list_2(sc, make_protected_string(sc, "s7 mishandled addition: ~S\n"), args)));
-}
+#define s7_int_abs(x) ((x) >= 0 ? (x) : -(x))
+/* can't use abs even in gcc -- it doesn't work with long long ints! */
-static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
-{
- #define H_subtract "(- x1 ...) subtracts its trailing arguments from the first, or negates the first if only one argument is given"
- int i, ret_type;
- s7_pointer x;
- s7_num_t a, b;
+#if (!__NetBSD__)
+ #define s7_fabsl(X) fabsl(X)
+#else
+ static double s7_fabsl(long double x) {if (x < 0.0) return(-x); return(x);}
+#endif
-#if (!WITH_GMP)
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "-", 1, car(args), "a number"));
- if (cdr(args) == sc->NIL)
- return(s7_negate(sc, car(args)));
-#endif
+static bool is_NaN(s7_double x) {return(x != x);}
+/* callgrind says this is faster than isnan, I think (very confusing data...) */
- a = number(car(args));
- i = 2;
- x = cdr(args);
+#if defined(__sun) && defined(__SVR4)
+ static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* there's no isinf in Solaris */
+#else
+#if (!MS_WINDOWS)
- while (true)
- {
-#if WITH_GMP
- switch (a.type)
- {
- case NUM_INT:
- if ((integer(a) > S7_LONG_MAX) ||
- (integer(a) < S7_LONG_MIN))
- return(big_subtract(sc, s7_cons(sc, s7_Int_to_big_integer(sc, integer(a)), x)));
- break;
+ #if __cplusplus
+ #define is_inf(x) std::isinf(x)
+ #else
+ #define is_inf(x) isinf(x)
+ #endif
- case NUM_RATIO:
- if ((numerator(a) > S7_LONG_MAX) ||
- (denominator(a) > S7_LONG_MAX) ||
- (numerator(a) < S7_LONG_MIN))
- return(big_subtract(sc, s7_cons(sc, s7_ratio_to_big_ratio(sc, (numerator(a)), denominator(a)), x)));
- break;
- }
#else
- if (!s7_is_number(car(x)))
- return(s7_wrong_type_arg_error(sc, "-", i, car(x), "a number"));
-#endif
+ static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* Another possibility: (x * 0) != 0 */
- b = number(car(x));
- ret_type = a.type | b.type;
- x = cdr(x);
-
- switch (ret_type)
- {
- case NUM_INT:
- if (x == sc->NIL)
- return(s7_make_integer(sc, integer(a) - integer(b)));
- integer(a) -= integer(b);
- break;
-
- case NUM_RATIO:
- {
- s7_Int d1, d2, n1, n2;
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
+ /* in MS C, we need to provide inverse hyperbolic trig funcs and cbrt */
+ static double asinh(double x) {return(log(x + sqrt(1.0 + x * x)));}
+ static double acosh(double x) {return(log(x + sqrt(x * x - 1.0)));}
+ /* perhaps less prone to numerical troubles (untested): 2.0 * log(sqrt(0.5 * (x + 1.0)) + sqrt(0.5 * (x - 1.0))) */
+ static double atanh(double x) {return(log((1.0 + x) / (1.0 - x)) / 2.0);}
+ static double cbrt(double x) {if (x >= 0.0) return(pow(x, 1.0 / 3.0)); return(-pow(-x, 1.0 / 3.0));}
+#endif /* windows */
+#endif /* sun */
- if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 - n2, d1));
- a = make_ratio(n1 - n2, d1);
- }
- else
- {
-#if (!WITH_GMP)
- if ((d1 > s7_int_max) || (d2 > s7_int_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int_max) || (n2 > s7_int_max) ||
- (n1 < s7_int_min) || (n2 < s7_int_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- {
- if (x == sc->NIL)
- return(s7_make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
- a.type = NUM_REAL;
- real(a) = ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2);
- }
- else
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 * d2 - n2 * d1, d1 * d2));
- a = make_ratio(n1 * d2 - n2 * d1, d1 * d2);
- }
- }
- else
+
+/* for g_log, we also need round. this version is from stackoverflow, see also round_per_R5RS below */
+double s7_round(double number) {return((number < 0.0) ? ceil(number - 0.5) : floor(number + 0.5));}
+
+#if HAVE_COMPLEX_NUMBERS
+#if __cplusplus
+ #define _Complex_I (complex<s7_double>(0.0, 1.0))
+ #define creal(x) Real(x)
+ #define cimag(x) Imag(x)
+ #define carg(x) arg(x)
+ #define cabs(x) abs(x)
+ #define csqrt(x) sqrt(x)
+ #define cpow(x, y) pow(x, y)
+ #define clog(x) log(x)
+ #define cexp(x) exp(x)
+ #define csin(x) sin(x)
+ #define ccos(x) cos(x)
+ #define csinh(x) sinh(x)
+ #define ccosh(x) cosh(x)
+#else
+ typedef double complex s7_complex;
#endif
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 * d2 - n2 * d1, d1 * d2));
- a = make_ratio(n1 * d2 - n2 * d1, d1 * d2);
- }
- }
- }
- break;
-
- case NUM_REAL2:
- case NUM_REAL:
- if (x == sc->NIL)
- return(s7_make_real(sc, num_to_real(a) - num_to_real(b)));
- real(a) = num_to_real(a) - num_to_real(b);
- a.type = NUM_REAL;
- break;
-
- default:
- if (x == sc->NIL)
- return(s7_make_complex(sc, num_to_real_part(a) - num_to_real_part(b), num_to_imag_part(a) - num_to_imag_part(b)));
- real_part(a) = num_to_real_part(a) - num_to_real_part(b);
- imag_part(a) = num_to_imag_part(a) - num_to_imag_part(b);
- if (imag_part(a) == 0.0)
- a.type = NUM_REAL;
- else a.type = NUM_COMPLEX;
- break;
- }
- i++;
- }
- return(s7_error(sc, make_symbol(sc, "internal-error"),
- make_list_2(sc, make_protected_string(sc, "s7 mishandled subtraction: ~S\n"), args)));
-}
+#if (!HAVE_COMPLEX_TRIG)
+#if (__cplusplus)
+
+ static s7_complex ctan(s7_complex z) {return(csin(z) / ccos(z));}
+ static s7_complex ctanh(s7_complex z) {return(csinh(z) / ccosh(z));}
+ static s7_complex casin(s7_complex z) {return(-_Complex_I * clog(_Complex_I * z + csqrt(1.0 - z * z)));}
+ static s7_complex cacos(s7_complex z) {return(-_Complex_I * clog(z + _Complex_I * csqrt(1.0 - z * z)));}
+ static s7_complex catan(s7_complex z) {return(_Complex_I * clog((_Complex_I + z) / (_Complex_I - z)) / 2.0);}
+ static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+ static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+ static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+#else
-static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
+/* still not in FreeBSD! */
+static s7_complex clog(s7_complex z) {return(log(fabs(cabs(z))) + carg(z) * _Complex_I);}
+static s7_complex cpow(s7_complex x, s7_complex y)
{
- #define H_multiply "(* ...) multiplies its arguments"
+ s7_double r = cabs(x);
+ s7_double theta = carg(x);
+ s7_double yre = creal(y);
+ s7_double yim = cimag(y);
+ s7_double nr = exp(yre * log(r) - yim * theta);
+ s7_double ntheta = yre * theta + yim * log(r);
+ return(nr * cos(ntheta) + (nr * sin(ntheta)) * _Complex_I); /* make-polar */
+}
- int i, ret_type;
- s7_pointer x;
- s7_num_t a, b;
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 9) /* untested -- this orignally looked at __FreeBSD_version which apparently no longer exists */
+ static s7_complex cexp(s7_complex z) {return(exp(creal(z)) * cos(cimag(z)) + (exp(creal(z)) * sin(cimag(z))) * _Complex_I);}
+#endif
-#if (!WITH_GMP)
- if (args == sc->NIL)
- return(small_int(1));
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 10)
+ static s7_complex csin(s7_complex z) {return(sin(creal(z)) * cosh(cimag(z)) + (cos(creal(z)) * sinh(cimag(z))) * _Complex_I);}
+ static s7_complex ccos(s7_complex z) {return(cos(creal(z)) * cosh(cimag(z)) + (-sin(creal(z)) * sinh(cimag(z))) * _Complex_I);}
+ static s7_complex csinh(s7_complex z) {return(sinh(creal(z)) * cos(cimag(z)) + (cosh(creal(z)) * sin(cimag(z))) * _Complex_I);}
+ static s7_complex ccosh(s7_complex z) {return(cosh(creal(z)) * cos(cimag(z)) + (sinh(creal(z)) * sin(cimag(z))) * _Complex_I);}
+ static s7_complex ctan(s7_complex z) {return(csin(z) / ccos(z));}
+ static s7_complex ctanh(s7_complex z) {return(csinh(z) / ccosh(z));}
+ static s7_complex casin(s7_complex z) {return(-_Complex_I * clog(_Complex_I * z + csqrt(1.0 - z * z)));}
+ static s7_complex cacos(s7_complex z) {return(-_Complex_I * clog(z + _Complex_I * csqrt(1.0 - z * z)));}
+ static s7_complex catan(s7_complex z) {return(_Complex_I * clog((_Complex_I + z) / (_Complex_I - z)) / 2.0);}
+ static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+ static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+ static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+ /* perhaps less prone to numerical troubles (untested): 2.0 * clog(csqrt(0.5 * (z + 1.0)) + csqrt(0.5 * (z - 1.0))) */
+#endif /* not FreeBSD 10 */
+#endif /* not c++ */
+#endif /* not HAVE_COMPLEX_TRIG */
+
+#else /* not HAVE_COMPLEX_NUMBERS */
+ typedef double s7_complex;
+ #define _Complex_I 1
+ #define creal(x) x
+ #define cimag(x) x
+ #define csin(x) sin(x)
+ #define casin(x) x
+ #define ccos(x) cos(x)
+ #define cacos(x) x
+ #define ctan(x) x
+ #define catan(x) x
+ #define csinh(x) x
+ #define casinh(x) x
+ #define ccosh(x) x
+ #define cacosh(x) x
+ #define ctanh(x) x
+ #define catanh(x) x
+ #define cexp(x) exp(x)
+ #define cpow(x, y) pow(x, y)
+ #define clog(x) log(x)
+ #define csqrt(x) sqrt(x)
+ #define conj(x) x
+#endif
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "*", 1, car(args), "a number"));
+#ifdef __OpenBSD__
+ /* openbsd's builtin versions of these functions are not usable */
+ static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+ static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+ static s7_complex cacosh_1(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+#endif
+#ifdef __NetBSD__
+ static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+ static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
#endif
- x = cdr(args);
- if (x == sc->NIL)
- return(car(args));
- a = number(car(args));
- i = 2;
+bool s7_is_number(s7_pointer p)
+{
+#if WITH_GMP
+ return((is_number(p)) || (is_big_number(p)));
+#else
+ return(is_number(p));
+#endif
+}
+
- while (true)
- {
+bool s7_is_integer(s7_pointer p)
+{
#if WITH_GMP
- s7_pointer old_x;
- old_x = x;
- switch (a.type)
- {
- case NUM_INT:
- if ((integer(a) > S7_LONG_MAX) ||
- (integer(a) < S7_LONG_MIN))
- return(big_multiply(sc, s7_cons(sc, s7_Int_to_big_integer(sc, integer(a)), x)));
- break;
+ return((is_t_integer(p)) ||
+ (is_t_big_integer(p)));
+#else
+ return(is_integer(p));
+#endif
+}
- case NUM_RATIO:
- if ((numerator(a) > S7_LONG_MAX) ||
- (denominator(a) > S7_LONG_MAX) ||
- (numerator(a) < S7_LONG_MIN))
- return(big_multiply(sc, s7_cons(sc, s7_ratio_to_big_ratio(sc, (numerator(a)), denominator(a)), x)));
- break;
- }
+bool s7_is_real(s7_pointer p)
+{
+#if WITH_GMP
+ return((is_real(p)) ||
+ (is_t_big_integer(p)) ||
+ (is_t_big_ratio(p)) ||
+ (is_t_big_real(p)));
#else
- if (!s7_is_number(car(x)))
- return(s7_wrong_type_arg_error(sc, "*", i, car(x), "a number"));
+ return(is_real(p)); /* in GSL, a NaN or inf is not a real, or perhaps better, finite = not (nan or inf) */
#endif
+}
- b = number(car(x));
- ret_type = a.type | b.type;
- x = cdr(x);
-
- switch (ret_type)
- {
- case NUM_INT:
+
+bool s7_is_rational(s7_pointer p)
+{
#if WITH_GMP
- if ((integer(b) > S7_LONG_MAX) ||
- (integer(b) < S7_LONG_MIN))
- return(big_multiply(sc, s7_cons(sc, s7_Int_to_big_integer(sc, integer(a)), old_x)));
+ return((is_rational(p)) ||
+ (is_t_big_integer(p)) ||
+ (is_t_big_ratio(p)));
+#else
+ return(is_rational(p));
+#endif
+}
+
- if (x == sc->NIL)
- return(s7_make_integer(sc, integer(a) * integer(b)));
- integer(a) *= integer(b);
+bool s7_is_ratio(s7_pointer p)
+{
+#if WITH_GMP
+ return((is_t_ratio(p)) ||
+ (is_t_big_ratio(p)));
#else
- if (sc->safety != 0)
- {
- bool a_signed; /* (* 524288 19073486328125) -> -8446744073709551616 */
- a_signed = (((integer(a) < 0) && (integer(b) > 0)) ||
- ((integer(a) > 0) && (integer(b) < 0)));
- integer(a) *= integer(b);
- if (a_signed != (integer(a) < 0))
- return(s7_out_of_range_error(sc, "* with ", 0, args, "result is too large"));
- if (x == sc->NIL)
- return(s7_make_integer(sc, integer(a)));
- }
- else
- {
- if (x == sc->NIL)
- return(s7_make_integer(sc, integer(a) * integer(b)));
- integer(a) *= integer(b);
- }
+ return(is_t_ratio(p));
#endif
- break;
-
- case NUM_RATIO:
- {
- s7_Int d1, d2, n1, n2;
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
-#if (!WITH_GMP)
- if ((d1 > s7_int_max) || (d2 > s7_int_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int_max) || (n2 > s7_int_max) || /* (* 1/524288 1/19073486328125) for example */
- (n1 < s7_int_min) || (n2 < s7_int_min))
- {
- if ((integer_length(d1) + integer_length(d2) > s7_int_bits) ||
- (integer_length(n1) + integer_length(n2) > s7_int_bits))
- {
- if (x == sc->NIL)
- return(s7_make_real(sc, ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2)));
- a.type = NUM_REAL;
- real(a) = ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2);
- }
- else
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 * n2, d1 * d2));
- a = make_ratio(n1 * n2, d1 * d2);
- }
- }
- else
-#endif
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 * n2, d1 * d2));
- a = make_ratio(n1 * n2, d1 * d2);
- }
- }
- break;
-
- case NUM_REAL2:
- case NUM_REAL:
- if (x == sc->NIL)
- return(s7_make_real(sc, num_to_real(a) * num_to_real(b)));
- real(a) = num_to_real(a) * num_to_real(b);
- a.type = NUM_REAL;
- break;
-
- default:
- {
- s7_Double r1, r2, i1, i2;
- r1 = num_to_real_part(a);
- r2 = num_to_real_part(b);
- i1 = num_to_imag_part(a);
- i2 = num_to_imag_part(b);
- if (x == sc->NIL)
- return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
- real_part(a) = r1 * r2 - i1 * i2;
- imag_part(a) = r1 * i2 + r2 * i1;
- if (imag_part(a) == 0.0)
- a.type = NUM_REAL;
- else a.type = NUM_COMPLEX;
- }
- break;
- }
-
- i++;
- }
- return(s7_error(sc, make_symbol(sc, "internal-error"),
- make_list_2(sc, make_protected_string(sc, "s7 mishandled multiplication: ~S\n"), args)));
}
-static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
+bool s7_is_complex(s7_pointer p)
{
- #define H_divide "(/ x1 ...) divides its first argument by the rest, or inverts the first if there is only one argument"
- int i, ret_type;
- s7_pointer x;
- s7_num_t a, b;
-
-#if (!WITH_GMP)
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "/", 1, car(args), "a number"));
-
- if (cdr(args) == sc->NIL)
- {
- if (s7_is_zero(car(args)))
- return(division_by_zero_error(sc, "/", args));
- return(s7_invert(sc, car(args)));
- }
-#endif
-
- a = number(car(args));
- i = 2;
- x = cdr(args);
-
- while (true)
- {
#if WITH_GMP
- s7_pointer old_x;
- old_x = x;
+ return((is_number(p)) || (is_big_number(p)));
#else
- if (!s7_is_number(car(x)))
- return(s7_wrong_type_arg_error(sc, "/", i, car(x), "a number"));
+ return(is_number(p));
#endif
+}
- if (s7_is_zero(car(x)))
- return(division_by_zero_error(sc, "/", args));
- /* to be consistent, I suppose we should search first for NaNs in the divisor list.
- * (* 0 0/0) is NaN, so (/ 1 0 0/0) should equal (/ 1 0/0) = NaN. But the whole
- * thing is ridiculous.
- */
-#if WITH_GMP
- switch (a.type)
- {
- case NUM_INT:
- if ((integer(a) > S7_LONG_MAX) ||
- (integer(a) < S7_LONG_MIN))
- return(big_divide(sc, s7_cons(sc, s7_Int_to_big_integer(sc, integer(a)), x)));
- break;
+static s7_int c_gcd(s7_int u, s7_int v)
+{
+ s7_int a, b;
- case NUM_RATIO:
- if ((numerator(a) > S7_LONG_MAX) ||
- (denominator(a) > S7_LONG_MAX) ||
- (numerator(a) < S7_LONG_MIN))
- return(big_divide(sc, s7_cons(sc, s7_ratio_to_big_ratio(sc, (numerator(a)), denominator(a)), x)));
- break;
- }
-#endif
-
- b = number(car(x));
- ret_type = a.type | b.type;
- x = cdr(x);
-
- switch (ret_type)
+ if ((u == s7_int_min) || (v == s7_int_min))
+ {
+ /* can't take abs of these (below) so do it by hand */
+ s7_int divisor = 1;
+ if (u == v) return(u);
+ while (((u & 1) == 0) && ((v & 1) == 0))
{
- case NUM_INT:
-#if (!WITH_GMP)
- if (integer(b) == S7_LLONG_MIN)
- {
- if (integer(a) == integer(b))
- {
- if (x == sc->NIL)
- return(small_ints[1]);
- integer(a) = 1;
- }
- else
- {
- if (x == sc->NIL)
- {
- if (integer(a) & 1)
- return(s7_make_ratio(sc, integer(a), integer(b) + 1));
- else return(s7_make_ratio(sc, integer(a) / 2, integer(b) / 2));
- }
- else
- {
- if (integer(a) & 1)
- a = make_ratio(integer(a), integer(b) + 1);
- else a = make_ratio(integer(a) / 2, integer(b) / 2);
- }
- }
- }
- else
-#endif
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, integer(a), integer(b)));
- a = make_ratio(integer(a), integer(b)); /* b checked for 0 above */
- }
- break;
-
- case NUM_RATIO:
- {
- s7_Int d1, d2, n1, n2;
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
-
- if (d1 == d2)
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1, n2));
- a = make_ratio(n1, n2);
- }
- else
- {
-#if (!WITH_GMP)
- if ((d1 > s7_int_max) || (d2 > s7_int_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int_max) || (n2 > s7_int_max) ||
- (n1 < s7_int_min) || (n2 < s7_int_min))
- {
- if ((integer_length(d1) + integer_length(n2) > s7_int_bits) ||
- (integer_length(d2) + integer_length(n1) > s7_int_bits))
- {
- if (x == sc->NIL)
- return(s7_make_real(sc, ((long double)n1 / (long double)d1) / ((long double)n2 / (long double)d2)));
- a.type = NUM_REAL;
- real(a) = ((long double)n1 / (long double)d1) / ((long double)n2 / (long double)d2);
- }
- else
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 * d2, d1 * n2));
- a = make_ratio(n1 * d2, d1 * n2);
- }
- }
- else
-#endif
- {
- if (x == sc->NIL)
- return(s7_make_ratio(sc, n1 * d2, d1 * n2));
- a = make_ratio(n1 * d2, d1 * n2);
- }
- }
- }
- break;
-
- case NUM_REAL2:
- case NUM_REAL:
- if (x == sc->NIL)
- return(s7_make_real(sc, num_to_real(a) / num_to_real(b)));
- real(a) = num_to_real(a) / num_to_real(b);
- a.type = NUM_REAL; /* must follow num_to_real */
- break;
-
- default:
- {
- s7_Double r1, r2, i1, i2, den;
- r1 = num_to_real_part(a);
- r2 = num_to_real_part(b);
- i1 = num_to_imag_part(a);
- i2 = num_to_imag_part(b);
- den = (r2 * r2 + i2 * i2);
-
- /* we could avoid the squaring (see Knuth II p613 16)
- * not a big deal: (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) => nan
- * (gmp case is ok here)
- */
- if (x == sc->NIL)
- return(s7_make_complex(sc, (r1 * r2 + i1 * i2) / den, (r2 * i1 - r1 * i2) / den));
-
- real_part(a) = (r1 * r2 + i1 * i2) / den;
- imag_part(a) = (r2 * i1 - r1 * i2) / den;
- if (imag_part(a) == 0.0)
- a.type = NUM_REAL;
- else a.type = NUM_COMPLEX;
- }
- break;
+ u /= 2;
+ v /= 2;
+ divisor *= 2;
}
+ return(divisor);
+ }
- i++;
+ a = s7_int_abs(u);
+ b = s7_int_abs(v);
+ while (b != 0)
+ {
+ s7_int temp;
+ temp = a % b;
+ a = b;
+ b = temp;
}
- return(s7_error(sc, make_symbol(sc, "internal-error"),
- make_list_2(sc, make_protected_string(sc, "s7 mishandled division: ~S\n"), args)));
+ if (a < 0)
+ return(-a);
+ return(a);
}
-static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
+static bool c_rationalize(s7_double ux, s7_double error, s7_int *numer, s7_int *denom)
{
- #define H_max "(max ...) returns the maximum of its arguments"
- int i;
- s7_pointer x, ap, bp, result;
- s7_num_t a, b;
+ /*
+ (define* (rat ux (err 0.0000001))
+ ;; translated from CL code in Canny, Donald, Ressler, "A Rational Rotation Method for Robust Geometric Algorithms"
+ (let ((x0 (- ux error))
+ (x1 (+ ux error)))
+ (let ((i (ceiling x0))
+ (i0 (floor x0))
+ (i1 (ceiling x1))
+ (r 0))
+ (if (>= x1 i)
+ i
+ (do ((p0 i0 (+ p1 (* r p0)))
+ (q0 1 (+ q1 (* r q0)))
+ (p1 i1 p0)
+ (q1 1 q0)
+ (e0 (- i1 x0) e1p)
+ (e1 (- x0 i0) (- e0p (* r e1p)))
+ (e0p (- i1 x1) e1)
+ (e1p (- x1 i0) (- e0 (* r e1))))
+ ((<= x0 (/ p0 q0) x1)
+ (/ p0 q0))
+ (set! r (min (floor (/ e0 e1))
+ (ceiling (/ e0p e1p)))))))))
+ */
+
+ double x0, x1;
+ s7_int i, i0, i1, p0, q0, p1, q1;
+ double e0, e1, e0p, e1p;
+ int tries = 0;
+ /* don't use s7_double here; if it is "long double", the loop below will hang */
- ap = car(args);
- if (!s7_is_real(ap))
- return(s7_wrong_type_arg_error(sc, "max", (cdr(args) == sc->NIL) ? 0 : 1, ap, "a real"));
+ /* #e1e19 is a killer -- it's bigger than most-positive-fixnum, but if we ceil(ux) below
+ * it turns into most-negative-fixnum. 1e19 is trouble in many places.
+ */
+ if ((ux > s7_int_max) || (ux < s7_int_min))
+ {
+ /* can't return false here because that confuses some of the callers!
+ */
+ if (ux > s7_int_min) (*numer) = s7_int_max; else (*numer) = s7_int_min;
+ (*denom) = 1;
+ return(true);
+ }
- x = cdr(args);
- if (x == sc->NIL)
- return(ap);
+ if (error < 0.0) error = -error;
+ x0 = ux - error;
+ x1 = ux + error;
+ i = (s7_int)ceil(x0);
- result = ap;
- a = number(ap);
- if ((a.type > NUM_RATIO) && (isnan(real(a))))
+ if (error >= 1.0) /* aw good grief! */
{
- for (i = 2, x = cdr(args); x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, "max", i, car(x), "a real"));
- return(s7_make_real(sc, NAN));
+ if (x0 < 0)
+ {
+ if (x1 < 0)
+ (*numer) = (s7_int)floor(x1);
+ else (*numer) = 0;
+ }
+ else (*numer) = i;
+ (*denom) = 1;
+ return(true);
}
- i = 2;
- while (true)
+ if (x1 >= i)
{
- bp = car(x);
- if (!s7_is_real(bp))
- return(s7_wrong_type_arg_error(sc, "max", i, bp, "a real"));
+ if (i >= 0)
+ (*numer) = i;
+ else (*numer) = (s7_int)floor(x1);
+ (*denom) = 1;
+ return(true);
+ }
- b = number(bp);
+ i0 = (s7_int)floor(x0);
+ i1 = (s7_int)ceil(x1);
- switch (a.type | b.type)
- {
- case NUM_INT:
- if (integer(a) < integer(b))
- {
- a = b;
- result = bp;
- }
- break;
-
- case NUM_RATIO:
- {
- s7_Int num_a, num_b, den_a, den_b;
- num_a = num_to_numerator(a);
- num_b = num_to_numerator(b);
- den_a = num_to_denominator(a);
- den_b = num_to_denominator(b);
-
- /* there are tricky cases here where long ints outrun doubles:
- * (max 92233720368547758/9223372036854775807 92233720368547757/9223372036854775807)
- * which should be 92233720368547758/9223372036854775807) but 1st the fraction gets reduced
- * to 13176245766935394/1317624576693539401, so we fall into the double comparison, and
- * there we should be comparing
- * 9.999999999999999992410584792601468961145E-3 and
- * 9.999999999999999883990367544051025548645E-3
- * but if using doubles we get
- * 0.010000000000000000208166817117 and
- * 0.010000000000000000208166817117
- * that is, we can't distinguish these two fractions once they're coerced to doubles.
- *
- * Even long doubles fail in innocuous-looking cases:
- * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- *
- * Another consequence: outside gmp, we can't handle cases like
- * (max 9223372036854776/9223372036854775807 #i9223372036854775/9223372036854775000)
- * (max #i9223372036854776/9223372036854775807 9223372036854775/9223372036854775000)
- * I guess if the user is using "inexact" numbers (#i...), he accepts their inexactness.
- */
+ p0 = i0;
+ q0 = 1;
+ p1 = i1;
+ q1 = 1;
+ e0 = i1 - x0;
+ e1 = x0 - i0;
+ e0p = i1 - x1;
+ e1p = x1 - i0;
- if (den_a == den_b)
- {
- if (num_a < num_b)
- {
- a = b;
- result = bp;
- }
- }
- else
- {
- if (num_a == num_b)
- {
- if (((num_a >= 0) &&
- (den_a > den_b)) ||
- ((num_a < 0) &&
- (den_a < den_b)))
- {
- a = b;
- result = bp;
- }
- }
- else
- {
- s7_Int vala, valb;
- vala = num_a / den_a;
- valb = num_b / den_b;
+ while (true)
+ {
+ s7_int old_p1, old_q1;
+ double old_e0, old_e1, old_e0p, val, r, r1;
+ val = (double)p0 / (double)q0;
- if (!((vala > valb) ||
- ((vala == valb) && (b.type == NUM_INT))))
- {
- if ((valb > vala) ||
- ((vala == valb) && (a.type == NUM_INT)) ||
- /* sigh -- both are ratios and the int parts are equal */
- (((long double)(num_a % den_a) / (long double)den_a) <= ((long double)(num_b % den_b) / (long double)den_b)))
- {
- a = b;
- result = bp;
- }
- }
- }
- }
- }
- break;
-
- default:
- if ((b.type > NUM_RATIO) && (isnan(real(b))))
- {
- for (i++, x = cdr(x); x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, "max", i, car(x), "a real"));
- return(s7_make_real(sc, NAN));
- }
- if (num_to_real(a) < num_to_real(b))
- {
- a = b;
- result = bp;
- }
- break;
+ if (((x0 <= val) && (val <= x1)) ||
+ (e1 == 0) ||
+ (e1p == 0) ||
+ (tries > 100))
+ {
+ (*numer) = p0;
+ (*denom) = q0;
+ return(true);
}
+ tries++;
- x = cdr(x);
- if (x == sc->NIL)
- return(result);
+ r = (s7_int)floor(e0 / e1);
+ r1 = (s7_int)ceil(e0p / e1p);
+ if (r1 < r) r = r1;
+
+ /* do handles all step vars in parallel */
+ old_p1 = p1;
+ p1 = p0;
+ old_q1 = q1;
+ q1 = q0;
+ old_e0 = e0;
+ e0 = e1p;
+ old_e0p = e0p;
+ e0p = e1;
+ old_e1 = e1;
- i++;
+ p0 = old_p1 + r * p0;
+ q0 = old_q1 + r * q0;
+ e1 = old_e0p - r * e1p;
+ /* if the error is set too low, we can get e1 = 0 here: (rationalize (/ pi) 1e-17) */
+ e1p = old_e0 - r * old_e1;
}
- return(result);
+ return(false);
}
-static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_rationalize(s7_scheme *sc, s7_double x, s7_double error)
{
- #define H_min "(min ...) returns the minimum of its arguments"
- int i;
- s7_pointer x, ap, bp, result;
- s7_num_t a, b;
-
- ap = car(args);
- if (!s7_is_real(ap))
- return(s7_wrong_type_arg_error(sc, "min", (cdr(args) == sc->NIL) ? 0 : 1, ap, "a real"));
+ s7_int numer = 0, denom = 1;
+ if (c_rationalize(x, error, &numer, &denom))
+ return(s7_make_ratio(sc, numer, denom));
+ return(make_real(sc, x));
+}
- x = cdr(args);
- if (x == sc->NIL)
- return(ap);
- result = ap;
- a = number(ap);
- if ((a.type > NUM_RATIO) && (isnan(real(a))))
- {
- for (i = 2, x = cdr(args); x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, "min", i, car(x), "a real"));
- return(s7_make_real(sc, NAN));
- }
- i = 2;
- while (true)
- {
- bp = car(x);
- if (!s7_is_real(bp))
- return(s7_wrong_type_arg_error(sc, "min", i, bp, "a real"));
-
- b = number(bp);
+static s7_int number_to_numerator(s7_pointer n)
+{
+ if (is_t_ratio(n))
+ return(numerator(n));
+ return(integer(n));
+}
- switch (a.type | b.type)
- {
- case NUM_INT:
- if (integer(a) > integer(b))
- {
- a = b;
- result = bp;
- }
- break;
-
- case NUM_RATIO:
- {
- s7_Int num_a, num_b, den_a, den_b;
- num_a = num_to_numerator(a);
- num_b = num_to_numerator(b);
- den_a = num_to_denominator(a);
- den_b = num_to_denominator(b);
- /* there are tricky cases here where long ints outrun doubles */
- if (den_a == den_b)
- {
- if (num_a > num_b)
- {
- a = b;
- result = bp;
- }
- }
- else
- {
- if (num_a == num_b)
- {
- if (((num_a >= 0) &&
- (den_a < den_b)) ||
- ((num_a < 0) &&
- (den_a > den_b)))
- {
- a = b;
- result = bp;
- }
- }
- else
- {
- s7_Int vala, valb;
- vala = num_a / den_a;
- valb = num_b / den_b;
- if (!((vala < valb) ||
- ((vala == valb) && (a.type == NUM_INT))))
- {
- if ((valb < vala) ||
- ((vala == valb) && (b.type == NUM_INT)) ||
- /* sigh -- both are ratios and the int parts are equal (see comment under g_max above) */
- (((long double)(num_a % den_a) / (long double)den_a) >= ((long double)(num_b % den_b) / (long double)den_b)))
- {
- a = b;
- result = bp;
- }
- }
- }
- }
- }
- break;
+static s7_int number_to_denominator(s7_pointer n)
+{
+ if (is_t_ratio(n))
+ return(denominator(n));
+ return(1);
+}
- default:
- if ((b.type > NUM_RATIO) && (isnan(real(b))))
- {
- for (i++, x = cdr(x); x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, "min", i, car(x), "a real"));
- return(s7_make_real(sc, NAN));
- }
- if (num_to_real(a) > num_to_real(b))
- {
- a = b;
- result = bp;
- }
- break;
- }
- x = cdr(x);
- if (x == sc->NIL)
- return(result);
+s7_pointer s7_make_integer(s7_scheme *sc, s7_int n)
+{
+ s7_pointer x;
+ if (is_small(n)) /* ((n >= 0) && (n < NUM_SMALL_INTS)) is slower */
+ return(small_int(n));
- i++;
- }
- return(result);
+ new_cell(sc, x, T_INTEGER);
+ integer(x) = n;
+ return(x);
}
-static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_mutable_integer(s7_scheme *sc, s7_int n)
{
- #define H_equal "(= z1 ...) returns #t if all its arguments are equal"
- int i, type_a, type_b;
s7_pointer x;
- s7_num_t a, b;
+ new_cell(sc, x, T_INTEGER | T_MUTABLE);
+ integer(x) = n;
+ return(x);
+}
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "=", 1, car(args), "a number"));
-
- a = number(car(args));
- type_a = num_type(a);
- x = cdr(args);
- i = 2;
- while (true)
- {
- s7_pointer tmp;
- bool equal = true;
+static s7_pointer make_permanent_integer_unchecked(s7_int i)
+{
+ s7_pointer p;
+ p = (s7_pointer)calloc(1, sizeof(s7_cell));
+ typeflag(p) = T_IMMUTABLE | T_INTEGER;
+ unheap(p);
+ integer(p) = i;
+ return(p);
+}
- tmp = car(x);
- if (!s7_is_number(tmp))
- return(s7_wrong_type_arg_error(sc, "=", i, tmp, "a number"));
+static s7_pointer make_permanent_integer(s7_int i)
+{
+ if (is_small(i)) return(small_int(i));
- b = number(tmp);
- type_b = num_type(b);
+ if (i == MAX_ARITY) return(max_arity);
+ if (i == CLOSURE_ARITY_NOT_SET) return(arity_not_set);
+ if (i == -1) return(minus_one);
+ if (i == -2) return(minus_two);
- switch (type_a)
- {
- case NUM_INT:
- switch (type_b)
- {
- case NUM_INT:
- equal = (integer(a) == integer(b));
- break;
+ /* a few -3 */
- case NUM_RATIO:
- equal = false;
- break;
+ return(make_permanent_integer_unchecked(i));
+}
- case NUM_REAL:
- case NUM_REAL2:
- equal = (integer(a) == real(b));
- break;
- default:
- equal = ((imag_part(b) == 0.0) &&
- (real_part(b) == integer(a)));
- break;
- }
- break;
-
- case NUM_RATIO:
- switch (type_b)
- {
- case NUM_RATIO:
- equal = ((numerator(a) == numerator(b)) &&
- (denominator(a) == denominator(b)));
- break;
+s7_pointer s7_make_real(s7_scheme *sc, s7_double n)
+{
+ s7_pointer x;
+ /* in snd-test this is called about 40000000 times, primarily test 8/18/22 */
- case NUM_REAL:
- case NUM_REAL2:
- equal = (fraction(a) == real(b));
- break;
+ if (n == 0.0)
+ return(real_zero);
- default:
- equal = false;
- break;
- }
- break;
-
- case NUM_REAL2:
- case NUM_REAL:
- switch (type_b)
- {
- case NUM_INT:
- equal = (real(a) == integer(b));
- break;
+ new_cell(sc, x, T_REAL);
+ set_real(x, n);
- case NUM_RATIO:
- equal = (real(a) == fraction(b));
- break;
+ return(x);
+}
- case NUM_REAL:
- case NUM_REAL2:
- equal = (real(a) == real(b));
- break;
- default:
- equal = ((imag_part(b) == 0.0) &&
- (real_part(b) == real(a)));
- break;
- }
- break;
-
- default:
- switch (type_b)
- {
- case NUM_INT:
- equal = ((imag_part(a) == 0.0) &&
- (real_part(a) == integer(b)));
- break;
+s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_REAL | T_MUTABLE);
+ set_real(x, n);
+ return(x);
+}
- case NUM_RATIO:
- equal = ((imag_part(a) == 0.0) &&
- (real_part(a) == fraction(b)));
- break;
- case NUM_REAL:
- case NUM_REAL2:
- equal = ((imag_part(a) == 0.0) &&
- (real_part(a) == real(b)));
- break;
+static s7_pointer make_permanent_real(s7_double n)
+{
+ s7_pointer x;
+ int nlen = 0;
+ char *str;
- default:
- equal = ((real_part(a) == real_part(b)) &&
- (imag_part(a) == imag_part(b)));
- break;
- }
- break;
- }
+ x = (s7_pointer)calloc(1, sizeof(s7_cell));
+ set_type(x, T_IMMUTABLE | T_REAL);
+ unheap(x);
+ set_real(x, n);
- if (!equal)
- {
- for (i++, x = cdr(x); x != sc->NIL; i++, x = cdr(x)) /* check trailing args for bad type */
- if (!s7_is_number(car(x)))
- return(s7_wrong_type_arg_error(sc, "=", i, car(x), "a number"));
-
- return(sc->F);
- }
+ str = number_to_string_base_10(x, 0, float_format_precision, 'g', &nlen, USE_WRITE);
+ set_print_name(x, str, nlen);
+ return(x);
+}
- x = cdr(x);
- if (x == sc->NIL)
- return(sc->T);
- a = b;
- type_a = type_b;
- i++;
+s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b)
+{
+ s7_pointer x;
+ if (b == 0.0)
+ {
+ new_cell(sc, x, T_REAL);
+ set_real(x, a);
}
-
- return(sc->T);
+ else
+ {
+ new_cell(sc, x, T_COMPLEX);
+ set_real_part(x, a);
+ set_imag_part(x, b);
+ }
+ return(x);
}
-#if (!WITH_GMP)
-static s7_pointer g_less_1(s7_scheme *sc, bool reversed, s7_pointer args)
+s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b)
{
- int i, type_a, type_b;
s7_pointer x;
- s7_num_t a, b;
-
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, (reversed) ? ">=" : "<", 1, car(args), "a real"));
+ s7_int divisor;
- a = number(car(args));
- type_a = num_type(a);
-
- if ((type_a > NUM_RATIO) && (isnan(real(a))))
- {
- for (i = 2, x = cdr(args); x != sc->NIL; i++, x = cdr(x)) /* check trailing args for bad type */
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, (reversed) ? ">=" : "<", i, car(x), "a real"));
- return(sc->F);
- }
+ if (b == 0)
+ return(division_by_zero_error(sc, make_string_wrapper(sc, "make-ratio"), set_elist_2(sc, make_integer(sc, a), small_int(0))));
+ if (a == 0)
+ return(small_int(0));
+ if (b == 1)
+ return(make_integer(sc, a));
- i = 2;
- x = cdr(args);
- while (true)
+#if (!WITH_GMP)
+ if (b == s7_int_min)
{
- s7_pointer tmp;
- bool less = true;
-
- tmp = car(x);
- if (!s7_is_real(tmp))
- return(s7_wrong_type_arg_error(sc, (reversed) ? ">=" : "<", i, tmp, "a real"));
+ if (a == b)
+ return(small_int(1));
- b = number(tmp);
- type_b = num_type(b);
- if ((type_b > NUM_RATIO) && (isnan(real(b))))
+ /* we've got a problem... This should not trigger an error during reading -- we might have the
+ * ratio on a switch with-bignums or whatever, so its mere occurrence is just an annoyance.
+ * We'll try to do something...
+ */
+ if (a & 1)
{
- for (i++, x = cdr(x); x != sc->NIL; i++, x = cdr(x)) /* check trailing args for bad type */
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, (reversed) ? ">=" : "<", i, car(x), "a real"));
- return(sc->F);
+ if (a == 1)
+ return(real_NaN);
+ /* not an error here? we can't get this in the ratio reader, I think, because the denominator is negative */
+ b = b + 1;
+ /* so (/ -1 most-negative-fixnum) -> 1/9223372036854775807 -- not ideal, but ... */
}
-
- switch (type_a)
+ else
{
- case NUM_INT:
- switch (type_b)
- {
- case NUM_INT:
- less = (integer(a) < integer(b));
- break;
+ a /= 2;
+ b /= 2;
+ }
+ }
+#endif
- case NUM_RATIO:
- /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
- */
- if ((integer(a) >= 0) && (numerator(b) < 0))
- less = false;
- else
- {
- if ((integer(a) <= 0) && (numerator(b) > 0))
- less = true;
- else
- {
- if ((integer(a) < S7_LONG_MAX) &&
- (integer(a) > S7_LONG_MIN) &&
- (denominator(b) < S7_LONG_MAX) &&
- (denominator(b) > S7_LONG_MIN))
- less = ((integer(a) * denominator(b)) < numerator(b));
- else less = (integer(a) < fraction(b));
- }
- }
- break;
+ if (b < 0)
+ {
+ a = -a;
+ b = -b;
+ }
+ divisor = c_gcd(a, b);
+ if (divisor != 1)
+ {
+ a /= divisor;
+ b /= divisor;
+ }
+ if (b == 1)
+ return(make_integer(sc, a));
- default:
- less = (integer(a) < real(b));
- break;
- }
- break;
+ new_cell(sc, x, T_RATIO);
+ numerator(x) = a;
+ denominator(x) = b;
- case NUM_RATIO:
- switch (type_b)
- {
- case NUM_INT:
- /* same case as above (sigh) */
- if ((integer(b) >= 0) && (numerator(a) < 0))
- less = true;
- else
- {
- if ((integer(b) <= 0) && (numerator(a) > 0))
- less = false;
- else
- {
- if ((integer(b) < S7_LONG_MAX) &&
- (integer(b) > S7_LONG_MIN) &&
- (denominator(a) < S7_LONG_MAX) &&
- (denominator(a) > S7_LONG_MIN))
- less = (numerator(a) < (integer(b) * denominator(a)));
- else less = (fraction(a) < integer(b));
- }
- }
- break;
+ return(x);
+}
+/* in fc19 as a guest running in virtualbox on OSX, the line a /= divisor can abort with an arithmetic exception (SIGFPE)
+ * if leastfix/mostfix -- apparently this is a bug in virtualbox.
+ */
- case NUM_RATIO:
- /* conversion to real and < is not safe here (see comment under g_greater) */
- {
- s7_Int d1, d2, n1, n2;
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
-
- if (d1 == d2)
- less = (n1 < n2);
- else
- {
- if ((d1 > s7_int_max) || (d2 > s7_int_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int_max) || (n2 > s7_int_max) ||
- (n1 < s7_int_min) || (n2 < s7_int_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- less = (fraction(a) < fraction(b));
-
- /* (< 21053343141/6701487259 3587785776203/1142027682075) -> #f because even long doubles aren't enough here
- * (= 21053343141/6701487259 3587785776203/1142027682075) is #f because it checks the actual ints and
- * (> 21053343141/6701487259 3587785776203/1142027682075) is #f just like the < case.
- * similarly
- * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
- *
- * if we print the long double results as integers, both are -3958705157555305931
- * so there's not a lot I can do in the non-gmp case.
- */
- else less = ((n1 * d2) < (n2 * d1));
- }
- else
- less = ((n1 * d2) < (n2 * d1));
- }
- }
- break;
- default:
- less = (fraction(a) < real(b));
- break;
- }
- break;
+#define WITH_OVERFLOW_ERROR true
+#define WITHOUT_OVERFLOW_ERROR false
- default:
- switch (type_b)
- {
- case NUM_INT:
- less = (real(a) < integer(b));
- break;
+#if (!WITH_PURE_S7)
+static s7_pointer exact_to_inexact(s7_scheme *sc, s7_pointer x)
+{
+ /* this is tricky because a big int can mess up when turned into a double:
+ * (truncate (exact->inexact most-positive-fixnum)) -> -9223372036854775808
+ */
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, (s7_double)(integer(x))));
+ case T_RATIO: return(make_real(sc, (s7_double)(fraction(x))));
+ case T_REAL:
+ case T_COMPLEX: return(x); /* apparently (exact->inexact 1+i) is not an error */
+ default:
+ method_or_bust_with_type(sc, x, sc->EXACT_TO_INEXACT, list_1(sc, x), A_NUMBER, 0);
+ }
+}
- case NUM_RATIO:
- less = (real(a) < fraction(b)); /* (< 1.0 9223372036854775806/9223372036854775807) */
- break;
+static s7_pointer inexact_to_exact(s7_scheme *sc, s7_pointer x, bool with_error)
+{
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ return(x);
- default:
- less = (real(a) < real(b));
- break;
- }
- break;
- }
-
- if (reversed) less = !less;
- if (!less)
- {
- for (i++, x = cdr(x); x != sc->NIL; i++, x = cdr(x)) /* check trailing args for bad type */
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, (reversed) ? ">=" : "<", i, car(x), "a real"));
-
- return(sc->F);
- }
-
- x = cdr(x);
- if (x == sc->NIL)
- return(sc->T);
-
- i++;
- a = b;
- type_a = type_b;
- }
-
- return(sc->T);
-}
+ case T_REAL:
+ {
+ s7_int numer = 0, denom = 1;
+ s7_double val;
+ val = s7_real(x);
+ if ((is_inf(val)) || (is_NaN(val)))
+ {
+ if (with_error)
+ return(simple_wrong_type_argument_with_type(sc, sc->INEXACT_TO_EXACT, x, A_NORMAL_REAL));
+ return(sc->NIL);
+ }
-static s7_pointer g_less(s7_scheme *sc, s7_pointer args)
-{
- #define H_less "(< x1 ...) returns #t if its arguments are in increasing order"
- return(g_less_1(sc, false, args));
-}
+ if ((val > s7_int_max) ||
+ (val < s7_int_min))
+ {
+ if (with_error)
+ return(simple_out_of_range(sc, sc->INEXACT_TO_EXACT, x, ITS_TOO_LARGE));
+ return(sc->NIL);
+ }
+ if (c_rationalize(val, sc->default_rationalize_error, &numer, &denom))
+ return(s7_make_ratio(sc, numer, denom));
+ }
-static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args)
-{
- #define H_greater_or_equal "(>= x1 ...) returns #t if its arguments are in decreasing order"
- return(g_less_1(sc, true, args));
+ default:
+ if (with_error)
+ method_or_bust(sc, x, sc->INEXACT_TO_EXACT, list_1(sc, x), T_REAL, 0);
+ return(sc->NIL);
+ }
+ return(x);
}
+#endif
-
-static s7_pointer g_greater_1(s7_scheme *sc, bool reversed, s7_pointer args)
+s7_double s7_number_to_real_with_caller(s7_scheme *sc, s7_pointer x, const char *caller)
{
- int i, type_a, type_b;
- s7_pointer x;
- s7_num_t a, b;
-
- /* (>= nan.0 inf.0) returns #t, but in Guile it's #f (and others similar) */
-
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, (reversed) ? "<=" : ">", 1, car(args), "a real"));
-
- a = number(car(args));
- type_a = num_type(a);
- if ((type_a > NUM_RATIO) && (isnan(real(a))))
- {
- for (i = 2, x = cdr(args); x != sc->NIL; i++, x = cdr(x)) /* check trailing args for bad type */
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, (reversed) ? "<=" : ">", i, car(x), "a real"));
- return(sc->F);
- }
+ if (is_t_real(x))
+ return(real(x));
+ /* this is nearly always the case in current usage, so by avoiding the "switch" we can go twice as fast */
- i = 2;
- x = cdr(args);
- while (true)
+ switch (type(x))
{
- s7_pointer tmp;
- bool greater = true;
-
- tmp = car(x);
- if (!s7_is_real(tmp))
- return(s7_wrong_type_arg_error(sc, (reversed) ? "<=" : ">", i, tmp, "a real"));
-
- b = number(tmp);
- type_b = num_type(b);
- if ((type_b > NUM_RATIO) && (isnan(real(b))))
- {
- for (i++, x = cdr(x); x != sc->NIL; i++, x = cdr(x)) /* check trailing args for bad type */
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, (reversed) ? "<=" : ">", i, car(x), "a real"));
- return(sc->F);
- }
-
- /* the ">" operator here is a problem.
- * we get different results depending on the gcc optimization level for cases like (< 1234/11 1234/11)
- * so, to keep ratios honest, we'll subtract and compare against 0. But that can cause problems:
- * :(> 0 most-negative-fixnum)
- * #f
- */
- switch (type_a)
- {
- case NUM_INT:
- switch (type_b)
- {
- case NUM_INT:
- greater = (integer(a) > integer(b));
- break;
-
- case NUM_RATIO:
- /* see comment above */
- if ((integer(a) >= 0) && (numerator(b) < 0))
- greater = true;
- else
- {
- if ((integer(a) <= 0) && (numerator(b) > 0))
- greater = false;
- else
- {
- if ((integer(a) < S7_LONG_MAX) &&
- (integer(a) > S7_LONG_MIN) &&
- (denominator(b) < S7_LONG_MAX) &&
- (denominator(b) > S7_LONG_MIN))
- greater = ((integer(a) * denominator(b)) > numerator(b));
- else greater = (integer(a) > fraction(b));
- }
- }
- break;
-
- default:
- greater = (integer(a) > real(b));
- break;
- }
- break;
-
- case NUM_RATIO:
- switch (type_b)
- {
- case NUM_INT:
- if ((integer(b) >= 0) && (numerator(a) < 0))
- greater = false;
- else
- {
- if ((integer(b) <= 0) && (numerator(a) > 0))
- greater = true;
- else
- {
- if ((integer(b) < S7_LONG_MAX) &&
- (integer(b) > S7_LONG_MIN) &&
- (denominator(a) < S7_LONG_MAX) &&
- (denominator(a) > S7_LONG_MIN))
- greater = (numerator(a) > (integer(b) * denominator(a)));
- else greater = (fraction(a) > integer(b));
- }
- }
- break;
-
- case NUM_RATIO:
- {
- s7_Int d1, d2, n1, n2;
- d1 = num_to_denominator(a);
- n1 = num_to_numerator(a);
- d2 = num_to_denominator(b);
- n2 = num_to_numerator(b);
-
- if (d1 == d2)
- greater = (n1 > n2);
- else
- {
- if ((d1 > s7_int_max) || (d2 > s7_int_max) || /* before counting bits, check that overflow is possible */
- (n1 > s7_int_max) || (n2 > s7_int_max) ||
- (n1 < s7_int_min) || (n2 < s7_int_min))
- {
- int d1bits, d2bits;
- d1bits = integer_length(d1);
- d2bits = integer_length(d2);
- if (((d1bits + d2bits) > s7_int_bits) ||
- ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
- ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
- greater = (fraction(a) > fraction(b));
- else greater = ((n1 * d2) > (n2 * d1));
- }
- else
- greater = ((n1 * d2) > (n2 * d1));
- }
- }
- break;
-
- default:
- greater = (fraction(a) > real(b));
- break;
- }
- break;
-
- default:
- switch (type_b)
- {
- case NUM_INT:
- greater = (real(a) > integer(b));
- break;
-
- case NUM_RATIO:
- greater = (real(a) > fraction(b));
- /* as always fraction is trouble: (> (* 4201378396/6659027209 1.0) 6189245291/9809721694) got #f but expected #t
- */
- break;
-
- default:
- greater = (real(a) > real(b));
- break;
- }
- break;
- }
-
- if (reversed) greater = !greater;
- if (!greater)
- {
- for (i++, x = cdr(x); x != sc->NIL; i++, x = cdr(x)) /* check trailing args for bad type */
- if (!s7_is_real(car(x)))
- return(s7_wrong_type_arg_error(sc, (reversed) ? "<=" : ">", i, car(x), "a real"));
-
- return(sc->F);
- }
-
- x = cdr(x);
- if (x == sc->NIL)
- return(sc->T);
-
- i++;
- a = b;
- type_a = type_b;
+ case T_INTEGER: return((s7_double)integer(x));
+ case T_RATIO: return((s7_double)numerator(x) / (s7_double)denominator(x));
+ case T_REAL: return(real(x));
+#if WITH_GMP
+ case T_BIG_INTEGER: return((s7_double)big_integer_to_s7_int(big_integer(x)));
+ case T_BIG_RATIO: return((s7_double)((long double)big_integer_to_s7_int(mpq_numref(big_ratio(x))) / (long double)big_integer_to_s7_int(mpq_denref(big_ratio(x)))));
+ case T_BIG_REAL: return((s7_double)mpfr_get_d(big_real(x), GMP_RNDN));
+#endif
}
-
- return(sc->T);
+ s7_wrong_type_arg_error(sc, caller, 0, x, "a real number");
+ return(0.0);
}
-static s7_pointer g_greater(s7_scheme *sc, s7_pointer args)
+s7_double s7_number_to_real(s7_scheme *sc, s7_pointer x)
{
- #define H_greater "(> x1 ...) returns #t if its arguments are in decreasing order"
- return(g_greater_1(sc, false, args));
+ return(s7_number_to_real_with_caller(sc, x, "s7_number_to_real"));
}
-static s7_pointer g_less_or_equal(s7_scheme *sc, s7_pointer args)
+s7_int s7_number_to_integer_with_caller(s7_scheme *sc, s7_pointer x, const char *caller) /* currently unused */
{
- #define H_less_or_equal "(<= x1 ...) returns #t if its arguments are in increasing order"
- return(g_greater_1(sc, true, args));
+ if (type(x) != T_INTEGER)
+ s7_wrong_type_arg_error(sc, caller, 0, x, "an integer");
+ return(integer(x));
}
-#endif
-
-
-static s7_pointer g_real_part(s7_scheme *sc, s7_pointer args)
+s7_int s7_number_to_integer(s7_scheme *sc, s7_pointer x) /* currently unused */
{
- #define H_real_part "(real-part num) returns the real part of num"
- s7_pointer p;
- p = car(args);
- if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "real-part", 0, p, "a number"));
- if (number_type(p) < NUM_COMPLEX)
- return(p); /* if num is real, real-part should return it as is (not exact->inexact) */
- return(s7_make_real(sc, real_part(number(p))));
+ return(s7_number_to_integer_with_caller(sc, x, "s7_number_to_integer"));
}
-static s7_pointer g_imag_part(s7_scheme *sc, s7_pointer args)
+s7_int s7_numerator(s7_pointer x)
{
- #define H_imag_part "(imag-part num) returns the imaginary part of num"
- s7_pointer p;
-
- p = car(args);
- if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "imag-part", 0, p, "a number"));
+ switch (type(x))
+ {
+ case T_INTEGER: return(integer(x));
+ case T_RATIO: return(numerator(x));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(big_integer_to_s7_int(big_integer(x)));
+ case T_BIG_RATIO: return(big_integer_to_s7_int(mpq_numref(big_ratio(x))));
+#endif
+ }
+ return(0);
+}
- /* currently (imag-part nan.0) -> 0.0 ? it's true but maybe confusing */
- switch (number_type(p))
+s7_int s7_denominator(s7_pointer x)
+{
+ switch (type(x))
{
- case NUM_INT:
- case NUM_RATIO: return(small_int(0));
- case NUM_REAL:
- case NUM_REAL2: return(real_zero);
- default: return(s7_make_real(sc, complex_imag_part(p)));
+ case T_RATIO: return(denominator(x));
+#if WITH_GMP
+ case T_BIG_RATIO: return(big_integer_to_s7_int(mpq_denref(big_ratio(x))));
+#endif
}
+ return(1);
}
-static s7_pointer g_numerator(s7_scheme *sc, s7_pointer args)
+s7_int s7_integer(s7_pointer p)
{
- #define H_numerator "(numerator rat) returns the numerator of the rational number rat"
- if (!s7_is_rational(car(args)))
- return(s7_wrong_type_arg_error(sc, "numerator", 0, car(args), "a rational"));
- return(s7_make_integer(sc, num_to_numerator(number(car(args)))));
+#if WITH_GMP
+ if (is_t_big_integer(p))
+ return(big_integer_to_s7_int(big_integer(p)));
+#endif
+ return(integer(p));
}
-static s7_pointer g_denominator(s7_scheme *sc, s7_pointer args)
+s7_double s7_real(s7_pointer p)
{
- #define H_denominator "(denominator rat) returns the denominator of the rational number rat"
- if (!s7_is_rational(car(args)))
- return(s7_wrong_type_arg_error(sc, "denominator", 0, car(args), "a rational"));
- return(s7_make_integer(sc, num_to_denominator(number(car(args)))));
+#if WITH_GMP
+ if (is_t_big_real(p))
+ return((s7_double)mpfr_get_d(big_real(p), GMP_RNDN));
+#endif
+ return(real(p));
}
#if (!WITH_GMP)
-static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args)
+static s7_complex s7_to_c_complex(s7_pointer p)
{
- #define H_is_nan "(nan? obj) returns #t if obj is a NaN"
- s7_pointer x;
-
- x = car(args);
- if (s7_is_number(x))
- {
- switch (number_type(x))
- {
- case NUM_INT:
- case NUM_RATIO:
- return(sc->F);
-
- case NUM_REAL:
- case NUM_REAL2:
- return(make_boolean(sc, isnan(real(number(x)))));
-
- default:
-#ifndef _MSC_VER
- return(make_boolean(sc, (isnan(complex_real_part(x))) || (isnan(complex_imag_part(x)))));
+#if HAVE_COMPLEX_NUMBERS
+ return(CMPLX(s7_real_part(p), s7_imag_part(p)));
#else
- if (isnan(complex_real_part(x)) || isnan(complex_imag_part(x)))
- return(sc->T);
- else return(sc->F);
+ return(0.0);
#endif
- }
- }
- return(sc->F);
}
-static s7_pointer g_is_infinite(s7_scheme *sc, s7_pointer args)
+static s7_pointer s7_from_c_complex(s7_scheme *sc, s7_complex z)
{
- #define H_is_infinite "(infinite? obj) returns #t if obj is an infinite real"
- s7_pointer x;
- x = car(args);
- if (!s7_is_number(x))
- return(sc->F);
- return(make_boolean(sc, (isinf(s7_real_part(x))) || (isinf(s7_imag_part(x)))));
+ return(s7_make_complex(sc, creal(z), cimag(z)));
}
#endif
-static s7_pointer g_is_number(s7_scheme *sc, s7_pointer args)
+#if ((!WITH_PURE_S7) || (!HAVE_OVERFLOW_CHECKS))
+static int integer_length(s7_int a)
{
- #define H_is_number "(number? obj) returns #t if obj is a number"
- return(make_boolean(sc, s7_is_number(car(args))));
-}
+ static const int bits[256] =
+ {0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
+ 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
+ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8};
+ #define I_8 256LL
+ #define I_16 65536LL
+ #define I_24 16777216LL
+ #define I_32 4294967296LL
+ #define I_40 1099511627776LL
+ #define I_48 281474976710656LL
+ #define I_56 72057594037927936LL
-static s7_pointer g_is_integer(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_integer "(integer? obj) returns #t if obj is an integer"
- return(make_boolean(sc, s7_is_integer(car(args))));
+ /* a might be most-negative-fixnum! in Clisp: (integer-length -9223372036854775808) -> 63
+ */
+ if (a < 0)
+ {
+ if (a == s7_int_min) return(63);
+ a = -a;
+ }
+ if (a < I_8) return(bits[a]);
+ if (a < I_16) return(8 + bits[a >> 8]);
+ if (a < I_24) return(16 + bits[a >> 16]);
+ if (a < I_32) return(24 + bits[a >> 24]);
+ if (a < I_40) return(32 + bits[a >> 32]);
+ if (a < I_48) return(40 + bits[a >> 40]);
+ if (a < I_56) return(48 + bits[a >> 48]);
+ return(56 + bits[a >> 56]);
}
+#endif
+
+static int s7_int32_max = 0, s7_int32_min = 0, s7_int_bits = 0, s7_int_digits = 0; /* initialized later */
+static int s7_int_digits_by_radix[17];
-static s7_pointer g_is_real(s7_scheme *sc, s7_pointer args)
+#if (!WITH_GMP)
+static s7_pointer s7_negate(s7_scheme *sc, s7_pointer p) /* can't use "negate" because it confuses C++! */
{
- #define H_is_real "(real? obj) returns #t if obj is a real number"
- return(make_boolean(sc, s7_is_real(car(args))));
+ switch (type(p))
+ {
+ case T_INTEGER: return(make_integer(sc, -integer(p)));
+ case T_RATIO: return(s7_make_ratio(sc, -numerator(p), denominator(p)));
+ case T_REAL: return(make_real(sc, -real(p)));
+ default: return(s7_make_complex(sc, -real_part(p), -imag_part(p)));
+ }
}
+#endif
-static s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args)
+static s7_pointer s7_invert(s7_scheme *sc, s7_pointer p) /* s7_ to be consistent... */
{
- #define H_is_complex "(complex? obj) returns #t if obj is a number"
- return(make_boolean(sc, s7_is_complex(car(args))));
+ switch (type(p))
+ {
+ case T_INTEGER:
+ return(s7_make_ratio(sc, 1, integer(p))); /* a already checked, not 0 */
- /* complex? is currently the same as number? */
-}
+ case T_RATIO:
+ return(s7_make_ratio(sc, denominator(p), numerator(p)));
+ case T_REAL:
+ return(make_real(sc, 1.0 / real(p)));
-static s7_pointer g_is_rational(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_rational "(rational? obj) returns #t if obj is a rational number (either an integer or a ratio)"
- return(make_boolean(sc, s7_is_rational(car(args))));
+ case T_COMPLEX:
+ {
+ s7_double r2, i2, den;
+ r2 = real_part(p);
+ i2 = imag_part(p);
+ den = (r2 * r2 + i2 * i2);
+ return(s7_make_complex(sc, r2 / den, -i2 / den));
+ }
- /* in the non-gmp case, (rational? 455702434782048082459/86885567283849955830) -> #f, not #t
- * and similarly for exact? etc.
- */
+ default:
+ return(wrong_type_argument_with_type(sc, sc->DIVIDE, 1, p, A_NUMBER));
+ }
}
-static s7_pointer g_is_even(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_ratios(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- #define H_is_even "(even? int) returns #t if the integer int is even"
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "even?", 0, car(args), "an integer"));
- return(make_boolean(sc, (s7_integer(car(args)) & 1) == 0));
-
- /* extension to gaussian integers: odd if a+b is odd? */
-}
+ s7_int d1, d2, n1, n2;
+ d1 = number_to_denominator(x);
+ n1 = number_to_numerator(x);
+ d2 = number_to_denominator(y);
+ n2 = number_to_numerator(y);
+ if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ return(s7_make_ratio(sc, n1 - n2, d1));
-static s7_pointer g_is_odd(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_odd "(odd? int) returns #t if the integer int is odd"
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "odd?", 0, car(args), "an integer"));
- return(make_boolean(sc, (s7_integer(car(args)) & 1) == 1));
+#if (!WITH_GMP)
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int n1d2, n2d1, d1d2, dn;
+ if ((multiply_overflow(d1, d2, &d1d2)) ||
+ (multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)) ||
+ (subtract_overflow(n1d2, n2d1, &dn)))
+ return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
+ return(s7_make_ratio(sc, dn, d1d2));
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ int d1bits, d2bits;
+ d1bits = integer_length(d1);
+ d2bits = integer_length(d2);
+ if (((d1bits + d2bits) > s7_int_bits) ||
+ ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
+ ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
+ return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
+ return(s7_make_ratio(sc, n1 * d2 - n2 * d1, d1 * d2));
+ }
+#endif
+#endif
+ return(s7_make_ratio(sc, n1 * d2 - n2 * d1, d1 * d2));
}
-#if (!WITH_GMP)
-static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args)
+static bool s7_is_negative(s7_pointer obj)
{
- #define H_is_zero "(zero? num) returns #t if the number num is zero"
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "zero?", 0, car(args), "a number"));
- return(make_boolean(sc, s7_is_zero(car(args))));
+ switch (type(obj))
+ {
+ case T_INTEGER: return(integer(obj) < 0);
+ case T_RATIO: return(numerator(obj) < 0);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(obj), 0) < 0);
+ case T_BIG_RATIO: return(mpq_cmp_ui(big_ratio(obj), 0, 1) < 0);
+ case T_BIG_REAL: return(mpfr_cmp_ui(big_real(obj), 0) < 0);
+#endif
+ default: return(real(obj) < 0);
+ }
}
-static s7_pointer g_is_positive(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_positive "(positive? num) returns #t if the real number num is positive (greater than 0)"
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, "positive?", 0, car(args), "a real"));
- return(make_boolean(sc, s7_is_positive(car(args))));
-}
-
-
-static s7_pointer g_is_negative(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_negative "(negative? num) returns #t if the real number num is negative (less than 0)"
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, "negative?", 0, car(args), "a real"));
- return(make_boolean(sc, s7_is_negative(car(args))));
-}
-
-
-static s7_pointer g_exact_to_inexact(s7_scheme *sc, s7_pointer args)
+static bool s7_is_positive(s7_pointer x)
{
- #define H_exact_to_inexact "(exact->inexact num) converts num to an inexact number; (exact->inexact 3/2) = 1.5"
-
- if (!s7_is_number(car(args))) /* apparently (exact->inexact 1+i) is not an error */
- return(s7_wrong_type_arg_error(sc, "exact->inexact", 0, car(args), "a number"));
-
- if (s7_is_rational(car(args)))
- return(exact_to_inexact(sc, car(args)));
-
- return(car(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(integer(x) > 0);
+ case T_RATIO: return(numerator(x) > 0);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) > 0);
+ case T_BIG_RATIO: return(mpq_cmp_ui(big_ratio(x), 0, 1) > 0);
+ case T_BIG_REAL: return(mpfr_cmp_ui(big_real(x), 0) > 0);
+#endif
+ default: return(real(x) > 0.0);
+ }
}
-static s7_pointer g_inexact_to_exact(s7_scheme *sc, s7_pointer args)
+static bool s7_is_zero(s7_pointer x)
{
- #define H_inexact_to_exact "(inexact->exact num) converts num to an exact number; (inexact->exact 1.5) = 3/2"
- s7_Double x;
-
- if (s7_is_rational(car(args))) /* (inexact->exact -2305843009213693952/4611686018427387903) which will confuse s7_real below */
- return(car(args));
-
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, "inexact->exact", 0, car(args), "a real number"));
-
- x = s7_real(car(args));
- return(inexact_to_exact(sc, car(args)));
-}
+ switch (type(x))
+ {
+ case T_INTEGER: return(integer(x) == 0);
+ case T_REAL: return(real(x) == 0.0);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(mpz_cmp_ui(big_integer(x), 0) == 0);
+ case T_BIG_REAL: return(mpfr_zero_p(big_real(x)));
#endif
-/* (!WITH_GMP) */
-
-
-static s7_pointer g_is_exact(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_exact "(exact? num) returns #t if num is exact (an integer or a ratio)"
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "exact?", 0, car(args), "a number"));
- return(make_boolean(sc, s7_is_exact(car(args))));
+ default: return(false); /* ratios and complex numbers here are already collapsed into integers and reals */
+ }
}
-static s7_pointer g_is_inexact(s7_scheme *sc, s7_pointer args)
+static bool s7_is_one(s7_pointer x)
{
- #define H_is_inexact "(inexact? num) returns #t if num is inexact (neither an integer nor a ratio)"
- if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "inexact?", 0, car(args), "a number"));
- return(make_boolean(sc, s7_is_inexact(car(args))));
+ return(((is_integer(x)) && (integer(x) == 1)) ||
+ ((is_t_real(x)) && (real(x) == 1.0)));
}
-bool s7_is_ulong(s7_pointer arg)
-{
- return(s7_is_integer(arg));
-}
-
+/* optimize exponents */
+#define MAX_POW 32
+static double pepow[17][MAX_POW], mepow[17][MAX_POW];
-unsigned long s7_ulong(s7_pointer p)
+static void init_pows(void)
{
- return(number(p).value.ul_value);
+ int i, j;
+ for (i = 2; i < 17; i++) /* radix between 2 and 16 */
+ for (j = 0; j < MAX_POW; j++) /* saved exponent between 0 and +/- MAX_POW */
+ {
+ pepow[i][j] = pow((double)i, (double)j);
+ mepow[i][j] = pow((double)i, (double)(-j));
+ }
}
-
-s7_pointer s7_make_ulong(s7_scheme *sc, unsigned long n)
+static double ipow(int x, int y)
{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_NUMBER | T_SIMPLE | T_DONT_COPY);
-
- number_type(x) = NUM_INT;
- number(x).value.ul_value = n;
- return(x);
+ if ((y < MAX_POW) && (y > (-MAX_POW)))
+ {
+ if (y >= 0)
+ return(pepow[x][y]);
+ return(mepow[x][-y]);
+ }
+ return(pow((double)x, (double)y));
}
-bool s7_is_ulong_long(s7_pointer arg)
+static int s7_int_to_string(char *p, s7_int n, int radix, int width)
{
- return(s7_is_integer(arg));
-}
+ static const char dignum[] = "0123456789abcdef";
+ int i, len, start, end;
+ bool sign;
+ s7_int pown;
+ if ((radix < 2) || (radix > 16))
+ return(0);
-unsigned long long s7_ulong_long(s7_pointer p)
-{
- return(number(p).value.ull_value);
-}
+ if (n == s7_int_min) /* can't negate this, so do it by hand */
+ {
+ static const char *mnfs[17] = {"","",
+ "-1000000000000000000000000000000000000000000000000000000000000000", "-2021110011022210012102010021220101220222",
+ "-20000000000000000000000000000000", "-1104332401304422434310311213", "-1540241003031030222122212",
+ "-22341010611245052052301", "-1000000000000000000000", "-67404283172107811828", "-9223372036854775808",
+ "-1728002635214590698", "-41a792678515120368", "-10b269549075433c38", "-4340724c6c71dc7a8", "-160e2ad3246366808", "-8000000000000000"};
+
+ len = safe_strlen(mnfs[radix]);
+ if (width > len)
+ {
+ start = width - len - 1;
+ memset((void *)p, (int)' ', start);
+ }
+ else start = 0;
+ for (i = 0; i < len; i++)
+ p[start + i] = mnfs[radix][i];
+ p[len + start] = '\0';
+ return(len + start);
+ }
+ sign = (n < 0);
+ if (sign) n = -n;
-s7_pointer s7_make_ulong_long(s7_scheme *sc, unsigned long long n)
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_NUMBER | T_SIMPLE | T_DONT_COPY);
-
- number_type(x) = NUM_INT;
- number(x).value.ull_value = n;
- return(x);
-}
+ /* the previous version that counted up to n, rather than dividing down below n, as here,
+ * could be confused by large ints on 64 bit machines
+ */
+ pown = n;
+ for (i = 1; i < 100; i++)
+ {
+ if (pown < radix)
+ break;
+ pown /= (s7_int)radix;
+ }
+ len = i - 1;
+ if (sign) len++;
+ end = 0;
+ if (width > len) /* (format #f "~10B" 123) */
+ {
+ start = width - len - 1;
+ end += start;
+ memset((void *)p, (int)' ', start);
+ }
+ else
+ {
+ start = 0;
+ end = 0;
+ }
+ if (sign)
+ {
+ p[start] = '-';
+ end++;
+ }
-static s7_pointer g_integer_length(s7_scheme *sc, s7_pointer args)
-{
- #define H_integer_length "(integer-length arg) returns the number of bits required to represent the integer 'arg': (ceiling (log (abs arg) 2))"
- s7_Int x;
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "integer-length", 0, car(args), "an integer"));
-
- x = s7_integer(car(args));
- if (x < 0)
- return(s7_make_integer(sc, integer_length(-(x + 1))));
- return(s7_make_integer(sc, integer_length(x)));
+ for (i = start + len; i >= end; i--)
+ {
+ p[i] = dignum[n % radix];
+ n /= radix;
+ }
+ p[len + start + 1] = '\0';
+ return(len + start + 1);
}
-static s7_pointer g_integer_decode_float(s7_scheme *sc, s7_pointer args)
+static char *integer_to_string_base_10_no_width(s7_pointer obj, int *nlen) /* do not free the returned string */
{
- #define H_integer_decode_float "(integer-decode-float x) returns a list containing the significand, exponent, and \
-sign of 'x' (1 = positive, -1 = negative). (integer-decode-float 0.0): (0 0 1)"
-
- s7_Int ix;
- s7_pointer arg;
- arg = car(args);
+ long long int num;
+ char *p, *op;
+ bool sign;
+ static char int_to_str[INT_TO_STR_SIZE];
- /* frexp doesn't work in edge cases. Since the double and long long int fields are equivalenced
- * in the s7_num struct, we can get the actual bits of the double from the int. The problem with doing this
- * is that bignums don't use that struct. Assume IEEE 754 and double = s7_Double.
+ if (has_print_name(obj))
+ {
+ (*nlen) = print_name_length(obj);
+ return((char *)print_name(obj));
+ }
+ /* (*nlen) = snprintf(int_to_str, INT_TO_STR_SIZE, "%lld", (long long int)integer(obj));
+ * but that is very slow -- the following code is 6 times faster
*/
+ num = (long long int)integer(obj);
+ if (num == s7_int_min)
+ {
+ (*nlen) = 20;
+ return((char *)"-9223372036854775808");
+ }
+ p = (char *)(int_to_str + INT_TO_STR_SIZE - 1);
+ op = p;
+ *p-- = '\0';
- if ((!s7_is_real(arg)) ||
- (s7_is_rational(arg)))
- return(s7_wrong_type_arg_error(sc, "integer-decode-float", 0, arg, "a non-rational real"));
-
- if (s7_real(arg) == 0.0)
- return(make_list_3(sc, small_int(0), small_int(0), small_int(1)));
-
-#if WITH_GMP
- if (is_c_object(arg))
+ sign = (num < 0);
+ if (sign) num = -num; /* we need a positive index below */
+ do {*p-- = "0123456789"[num % 10]; num /= 10;} while (num);
+ if (sign)
{
- s7_num_t num;
- real(num) = s7_number_to_real(arg); /* need s7_num_t here for the equivalence */
- if ((isnan(real(num))) || (isinf(real(num)))) /* (integer-decode-float (bignum "1e310")) */
- return(s7_out_of_range_error(sc, "integer-decode-float", 0, arg, "a real that s7_Double can handle"));
- ix = integer(num);
+ *p = '-';
+ (*nlen) = op - p;
+ return(p);
}
- else
-#endif
- ix = integer(number(arg));
- return(make_list_3(sc,
- s7_make_integer(sc, (s7_Int)((ix & 0xfffffffffffffLL) | 0x10000000000000LL)),
- s7_make_integer(sc, (s7_Int)(((ix & 0x7fffffffffffffffLL) >> 52) - 1023 - 52)),
- s7_make_integer(sc, ((ix & 0x8000000000000000LL) != 0) ? -1 : 1)));
+ (*nlen) = op - p - 1;
+ return(++p);
}
-static s7_pointer g_logior(s7_scheme *sc, s7_pointer args)
-{
- #define H_logior "(logior i1 ...) returns the bitwise OR of its integer arguments (the bits that are on in any of the arguments)"
- s7_Int result = 0;
- int i;
- s7_pointer x;
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_integer(car(x)))
- return(s7_wrong_type_arg_error(sc, "logior", i, car(x), "an integer"));
- else result |= s7_integer(car(x));
+#define BASE_10 10
+static int num_to_str_size = -1;
+static char *num_to_str = NULL;
+static const char *float_format_g = NULL;
- return(s7_make_integer(sc, result));
+static char *floatify(char *str, int *nlen)
+{
+ if ((strchr(str, 'e') == NULL) &&
+ (strchr(str, '.') == NULL))
+ {
+ /* this assumes there is room in str for 2 more chars */
+ int len;
+ len = *nlen;
+ str[len]='.';
+ str[len + 1]='0';
+ str[len + 2]='\0';
+ (*nlen) = len + 2;
+ }
+ return(str);
}
-
-static s7_pointer g_logxor(s7_scheme *sc, s7_pointer args)
+static char *number_to_string_base_10(s7_pointer obj, int width, int precision, char float_choice, int *nlen, use_write_t choice) /* don't free result */
{
- #define H_logxor "(logxor i1 ...) returns the bitwise XOR of its integer arguments (the bits that are on in an odd number of the arguments)"
- s7_Int result = 0;
- int i;
- s7_pointer x;
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_integer(car(x)))
- return(s7_wrong_type_arg_error(sc, "logxor", i, car(x), "an integer"));
- else result ^= s7_integer(car(x));
+ /* the rest of s7 assumes nlen is set to the correct length
+ * a tricky case: (format #f "~f" 1e308) -- tries to print 308 digits! so 256 as default len is too small.
+ * but then even worse: (format #f "~F" 1e308+1e308i)!
+ */
+ int len;
+ len = 1024;
+ if (width > len) len = 2 * width;
+ if (len > num_to_str_size)
+ {
+ if (!num_to_str)
+ num_to_str = (char *)malloc(len * sizeof(char));
+ else num_to_str = (char *)realloc(num_to_str, len * sizeof(char));
+ num_to_str_size = len;
+ }
- return(s7_make_integer(sc, result));
-}
+ /* bignums can't happen here */
+ switch (type(obj))
+ {
+ case T_INTEGER:
+ if (width == 0)
+ return(integer_to_string_base_10_no_width(obj, nlen));
+ (*nlen) = snprintf(num_to_str, num_to_str_size, "%*lld", width, (long long int)integer(obj));
+ break;
+ case T_RATIO:
+ len = snprintf(num_to_str, num_to_str_size, "%lld/%lld", (long long int)numerator(obj), (long long int)denominator(obj));
+ if (width > len)
+ {
+ int spaces;
+ if (width >= num_to_str_size)
+ {
+ num_to_str_size = width + 1;
+ num_to_str = (char *)realloc(num_to_str, num_to_str_size * sizeof(char));
+ }
+ spaces = width - len;
+ num_to_str[width] = '\0';
+ memmove((void *)(num_to_str + spaces), (void *)num_to_str, len);
+ memset((void *)num_to_str, (int)' ', spaces);
+ (*nlen) = width;
+ }
+ else (*nlen) = len;
+ break;
-static s7_pointer g_logand(s7_scheme *sc, s7_pointer args)
-{
- #define H_logand "(logand i1 ...) returns the bitwise AND of its integer arguments (the bits that are on in every argument)"
- s7_Int result = -1;
- int i;
- s7_pointer x;
+ case T_REAL:
+ {
+ const char *frmt;
+ if (sizeof(double) >= sizeof(s7_double))
+ frmt = (float_choice == 'g') ? "%*.*g" : ((float_choice == 'f') ? "%*.*f" : "%*.*e");
+ else frmt = (float_choice == 'g') ? "%*.*Lg" : ((float_choice == 'f') ? "%*.*Lf" : "%*.*Le");
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_integer(car(x)))
- return(s7_wrong_type_arg_error(sc, "logand", i, car(x), "an integer"));
- else result &= s7_integer(car(x));
+ len = snprintf(num_to_str, num_to_str_size - 4, frmt, width, precision, s7_real(obj)); /* -4 for floatify */
+ (*nlen) = len;
+ floatify(num_to_str, nlen);
+ }
+ break;
- return(s7_make_integer(sc, result));
-}
+ default:
+ {
+ if ((choice == USE_READABLE_WRITE) &&
+ ((is_NaN(real_part(obj))) || (is_NaN(imag_part(obj))) || ((is_inf(real_part(obj))) || (is_inf(imag_part(obj))))))
+ {
+ char rbuf[128], ibuf[128];
+ char *rp, *ip;
+ if (is_NaN(real_part(obj)))
+ rp = (char *)"nan.0";
+ else
+ {
+ if (is_inf(real_part(obj)))
+ {
+ if (real_part(obj) < 0.0)
+ rp = (char *)"-inf.0";
+ else rp = (char *)"inf.0";
+ }
+ else
+ {
+ snprintf(rbuf, 128, float_format_g, precision, real_part(obj));
+ rp = rbuf;
+ }
+ }
+ if (is_NaN(imag_part(obj)))
+ ip = (char *)"nan.0";
+ else
+ {
+ if (is_inf(imag_part(obj)))
+ {
+ if (imag_part(obj) < 0.0)
+ ip = (char *)"-inf.0";
+ else ip = (char *)"inf.0";
+ }
+ else
+ {
+ snprintf(ibuf, 128, float_format_g, precision, imag_part(obj));
+ ip = ibuf;
+ }
+ }
+ len = snprintf(num_to_str, num_to_str_size, "(complex %s %s)", rp, ip);
+ }
+ else
+ {
+ const char *frmt;
+ if (sizeof(double) >= sizeof(s7_double))
+ {
+ if (imag_part(obj) >= 0.0)
+ frmt = (float_choice == 'g') ? "%.*g+%.*gi" : ((float_choice == 'f') ? "%.*f+%.*fi" : "%.*e+%.*ei");
+ else frmt = (float_choice == 'g') ? "%.*g%.*gi" : ((float_choice == 'f') ? "%.*f%.*fi" :"%.*e%.*ei"); /* minus sign comes with the imag_part */
+ }
+ else
+ {
+ if (imag_part(obj) >= 0.0)
+ frmt = (float_choice == 'g') ? "%.*Lg+%.*Lgi" : ((float_choice == 'f') ? "%.*Lf+%.*Lfi" : "%.*Le+%.*Lei");
+ else frmt = (float_choice == 'g') ? "%.*Lg%.*Lgi" : ((float_choice == 'f') ? "%.*Lf%.*Lfi" : "%.*Le%.*Lei");
+ }
+ len = snprintf(num_to_str, num_to_str_size, frmt, precision, real_part(obj), precision, imag_part(obj));
+ }
-static s7_pointer g_lognot(s7_scheme *sc, s7_pointer args)
-{
- #define H_lognot "(lognot num) returns the bitwise negation (the complement, the bits that are not on) in num: (lognot 0) -> -1"
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "lognot", 0, car(args), "an integer"));
- return(s7_make_integer(sc, ~s7_integer(car(args))));
+ if (width > len) /* (format #f "~20g" 1+i) */
+ {
+ int spaces;
+ if (width >= num_to_str_size)
+ {
+ num_to_str_size = width + 1;
+ num_to_str = (char *)realloc(num_to_str, num_to_str_size * sizeof(char));
+ }
+ spaces = width - len;
+ num_to_str[width] = '\0';
+ memmove((void *)(num_to_str + spaces), (void *)num_to_str, len);
+ memset((void *)num_to_str, (int)' ', spaces);
+ (*nlen) = width;
+ }
+ else (*nlen) = len;
+ }
+ break;
+ }
+ return(num_to_str);
}
-static s7_pointer g_ash(s7_scheme *sc, s7_pointer args)
+static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, int radix, int width, int precision, char float_choice, int *nlen)
{
- #define H_ash "(ash i1 i2) returns i1 shifted right or left i2 times, i1 << i2, (ash 1 3) -> 8, (ash 8 -3) -> 1"
- s7_Int arg1, arg2;
+ /* the rest of s7 assumes nlen is set to the correct length */
+ char *p;
+ int len, str_len;
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "ash", 1, car(args), "an integer"));
- if (!s7_is_integer(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "ash", 2, cadr(args), "an integer"));
-
- arg1 = s7_integer(car(args));
- if (arg1 == 0) return(small_int(0));
+#if WITH_GMP
+ if (s7_is_bignum(obj))
+ return(big_number_to_string_with_radix(obj, radix, width, nlen, USE_WRITE));
+ /* this ignores precision because it's way too hard to get the mpfr string to look like
+ * C's output -- we either have to call mpfr_get_str twice (the first time just to
+ * find out what the exponent is and how long the string actually is), or we have
+ * to do messy string manipulations. So (format #f "",3F" pi) ignores the "3" and
+ * prints the full string.
+ */
+#endif
- arg2 = s7_integer(cadr(args));
- if (arg2 >= s7_int_bits)
- return(s7_out_of_range_error(sc, "ash", 2, cadr(args), "shift is too large"));
- if (arg2 < -s7_int_bits)
+ if (radix == 10)
{
- if (arg1 < 0) /* (ash -31 -100) */
- return(small_negative_ints[1]);
- return(small_int(0));
+ p = number_to_string_base_10(obj, width, precision, float_choice, nlen, USE_WRITE);
+ return(copy_string_with_length(p, *nlen));
}
- /* I can't see any point in protecting this:
- * (ash 9223372036854775807 1) -> -2
- * but anyone using ash must know something about bits...
- */
- if (arg2 >= 0)
- return(s7_make_integer(sc, arg1 << arg2));
- return(s7_make_integer(sc, arg1 >> -arg2));
-}
+ switch (type(obj))
+ {
+ case T_INTEGER:
+ p = (char *)malloc((128 + width) * sizeof(char));
+ *nlen = s7_int_to_string(p, s7_integer(obj), radix, width);
+ return(p);
+ case T_RATIO:
+ {
+ char n[128], d[128];
+ s7_int_to_string(n, numerator(obj), radix, 0);
+ s7_int_to_string(d, denominator(obj), radix, 0);
+ p = (char *)malloc(256 * sizeof(char));
+ len = snprintf(p, 256, "%s/%s", n, d);
+ str_len = 256;
+ }
+ break;
-/* random numbers. The simple version used in clm.c is probably adequate,
- * but here I'll use Marsaglia's MWC algorithm as an experiment.
- * (random num) -> a number (0..num), if num == 0 return 0, use global default state
- * (random num state) -> same but use this state
- * (make-random-state seed) -> make a new state
- * (make-random-state seed type) ??
- * to save the current seed, use copy
- * to save it across load, random-state->list and list->random-state.
- */
-
-typedef struct {
- unsigned long long int ran_seed, ran_carry;
-} s7_rng_t;
-
-static int rng_tag = 0;
-
-#if WITH_GMP
-static int big_rng_tag = 0;
-#endif
-
-static char *print_rng(s7_scheme *sc, void *val)
-{
- char *buf;
- s7_rng_t *r = (s7_rng_t *)val;
- buf = (char *)malloc(64 * sizeof(char));
- snprintf(buf, 64, "#<rng %d %d>", (unsigned int)(r->ran_seed), (unsigned int)(r->ran_carry));
- return(buf);
-}
+ case T_REAL:
+ {
+ int i;
+ s7_int int_part;
+ s7_double x, frac_part, min_frac, base;
+ bool sign = false;
+ char n[128], d[256];
+ x = s7_real(obj);
-static void free_rng(void *val)
-{
- free(val);
-}
+ if (is_NaN(x))
+ return(copy_string_with_length("nan.0", *nlen = 5));
+ if (is_inf(x))
+ {
+ if (x < 0.0)
+ return(copy_string_with_length("-inf.0", *nlen = 6));
+ return(copy_string_with_length("inf.0", *nlen = 5));
+ }
+ if (x < 0.0)
+ {
+ sign = true;
+ x = -x;
+ }
-static bool equal_rng(void *val1, void *val2)
-{
- return(val1 == val2);
-}
+ if (x > 1.0e18) /* i.e. close to or greater than most-positive-fixnum (9.22e18), so the code below is unlikely to work, (format #f "~X" 1e19) */
+ {
+ int ep;
+ char *p1;
+ s7_pointer r;
+
+ len = 0;
+ ep = (int)floor(log(x) / log((double)radix));
+ r = make_real(sc, x / pow((double)radix, (double)ep)); /* divide it down to one digit, then the fractional part */
+ p1 = number_to_string_with_radix(sc, r, radix, width, precision, float_choice, &len);
+ p = (char *)malloc((len + 8) * sizeof(char));
+ (*nlen) = snprintf(p, len + 8, "%s%se%d", (sign) ? "-" : "", p1, ep);
+ free(p1);
+ return(p);
+ }
+ int_part = (s7_int)floor(x);
+ frac_part = x - int_part;
+ s7_int_to_string(n, int_part, radix, 0);
+ min_frac = (s7_double)ipow(radix, -precision);
-s7_pointer s7_make_random_state(s7_scheme *sc, s7_pointer args)
-{
- #define H_make_random_state "(make-random-state seed) returns a new random number state initialized with 'seed'. \
-Pass this as the second argument to 'random' to get a repeatable random number sequence:\n\
- (let ((seed (make-random-state 1234))) (random 1.0 seed))"
+ /* doesn't this assume precision < 128/256 and that we can fit in 256 digits (1e308)? */
- s7_rng_t *r;
+ for (i = 0, base = radix; (i < precision) && (frac_part > min_frac); i++, base *= radix)
+ {
+ s7_int ipart;
+ ipart = (s7_int)(frac_part * base);
+ if (ipart >= radix) /* rounding confusion */
+ ipart = radix - 1;
+ frac_part -= (ipart / base);
+ if (ipart < 10)
+ d[i] = (char)('0' + ipart);
+ else d[i] = (char)('a' + ipart - 10);
+ }
+ if (i == 0)
+ d[i++] = '0';
+ d[i] = '\0';
+ p = (char *)malloc(256 * sizeof(char));
+ len = snprintf(p, 256, "%s%s.%s", (sign) ? "-" : "", n, d);
+ str_len = 256;
+ }
+ break;
- if (!(s7_is_integer(car(args))))
- return(s7_wrong_type_arg_error(sc, "make-random-state,", 1, car(args), "an integer"));
+ default:
+ {
+ char *n, *d;
+ p = (char *)malloc(512 * sizeof(char));
+ n = number_to_string_with_radix(sc, make_real(sc, real_part(obj)), radix, 0, precision, float_choice, &len);
+ d = number_to_string_with_radix(sc, make_real(sc, imag_part(obj)), radix, 0, precision, float_choice, &len);
+ len = snprintf(p, 512, "%s%s%si", n, (imag_part(obj) < 0.0) ? "" : "+", d);
+ str_len = 512;
+ free(n);
+ free(d);
+ }
+ break;
+ }
- if (cdr(args) == sc->NIL)
+ if (width > len)
{
- r = (s7_rng_t *)calloc(1, sizeof(s7_rng_t));
- r->ran_seed = s7_integer(car(args));
- r->ran_carry = 1675393560; /* should this be dependent on the seed? */
- return(s7_make_object(sc, rng_tag, (void *)r));
+ int spaces;
+ if (width >= str_len)
+ {
+ str_len = width + 1;
+ p = (char *)realloc(p, str_len * sizeof(char));
+ }
+ spaces = width - len;
+ p[width] = '\0';
+ memmove((void *)(p + spaces), (void *)p, len);
+ memset((void *)p, (int)' ', spaces);
+ (*nlen) = width;
}
+ else (*nlen) = len;
+ return(p);
+}
- if (!(s7_is_integer(cadr(args))))
- return(s7_wrong_type_arg_error(sc, "make-random-state,", 2, cadr(args), "an integer"));
-
- r = (s7_rng_t *)calloc(1, sizeof(s7_rng_t));
- r->ran_seed = s7_integer(car(args));
- r->ran_carry = s7_integer(cadr(args));
- return(s7_make_object(sc, rng_tag, (void *)r));
+
+char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, int radix)
+{
+ int nlen = 0;
+ return(number_to_string_with_radix(sc, obj, radix, 0, 20, 'g', &nlen));
+ /* (log top 10) so we get all the digits in base 10 (??) */
}
-static s7_pointer copy_random_state(s7_scheme *sc, s7_pointer obj)
+static void prepare_temporary_string(s7_scheme *sc, int len, int which)
{
- if (c_object_type(obj) == rng_tag)
+ s7_pointer p;
+ p = sc->tmp_strs[which];
+ if (len > string_temp_true_length(p))
{
- s7_rng_t *r, *new_r;
- r = (s7_rng_t *)s7_object_value(obj);
- new_r = (s7_rng_t *)calloc(1, sizeof(s7_rng_t));
- new_r->ran_seed = r->ran_seed;
- new_r->ran_carry = r->ran_carry;
- return(s7_make_object(sc, rng_tag, (void *)new_r));
+ string_value(p) = (char *)realloc(string_value(p), len * sizeof(char));
+ string_temp_true_length(p) = len;
}
- /* I can't find a way to copy a gmp random generator */
- return(sc->F);
}
-
-#if HAVE_PTHREADS
-static pthread_mutex_t rng_lock = PTHREAD_MUTEX_INITIALIZER;
-#endif
-
-
-static double next_random(s7_rng_t *r)
+static s7_pointer g_number_to_string_1(s7_scheme *sc, s7_pointer args, bool temporary)
{
- /* The multiply-with-carry generator for 32-bit integers:
- * x(n)=a*x(n-1) + carry mod 2^32
- * Choose multiplier a from this list:
- * 1791398085 1929682203 1683268614 1965537969 1675393560
- * 1967773755 1517746329 1447497129 1655692410 1606218150
- * 2051013963 1075433238 1557985959 1781943330 1893513180
- * 1631296680 2131995753 2083801278 1873196400 1554115554
- * ( or any 'a' for which both a*2^32-1 and a*2^31-1 are prime)
- */
- double result;
- unsigned long long int temp;
- #define RAN_MULT 2131995753UL
+ #define H_number_to_string "(number->string num (radix 10)) converts the number num into a string."
+ #define Q_number_to_string s7_make_signature(sc, 3, sc->IS_STRING, sc->IS_NUMBER, sc->IS_INTEGER)
-#if HAVE_PTHREADS
- pthread_mutex_lock(&rng_lock);
-#endif
+ s7_int radix = 10;
+ int size, nlen = 0;
+ char *res;
+ s7_pointer x;
- temp = r->ran_seed * RAN_MULT + r->ran_carry;
- r->ran_seed = (temp & 0xffffffffUL);
- r->ran_carry = (temp >> 32);
- result = (double)((unsigned int)(r->ran_seed)) / 4294967295.5;
- /* divisor was 2^32-1 = 4294967295.0, but somehow this can round up once in a billion tries?
- * do we want the double just less than 2^32?
- */
+ x = car(args);
+ if (!s7_is_number(x))
+ method_or_bust_with_type(sc, x, sc->NUMBER_TO_STRING, args, A_NUMBER, 1);
- /* (let ((mx 0) (mn 1000)) (do ((i 0 (+ i 1))) ((= i 10000)) (let ((val (random 123))) (set! mx (max mx val)) (set! mn (min mn val)))) (list mn mx)) */
+ if (is_pair(cdr(args)))
+ {
+ s7_pointer y;
+ y = cadr(args);
+ if (s7_is_integer(y))
+ radix = s7_integer(y);
+ else method_or_bust(sc, y, sc->NUMBER_TO_STRING, args, T_INTEGER, 2);
+ if ((radix < 2) || (radix > 16))
+ return(out_of_range(sc, sc->NUMBER_TO_STRING, small_int(2), y, A_VALID_RADIX));
+ }
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&rng_lock);
+#if WITH_GMP
+ if (s7_is_bignum(x))
+ {
+ res = big_number_to_string_with_radix(x, radix, 0, &nlen, USE_WRITE);
+ return(make_string_uncopied_with_length(sc, res, nlen));
+ }
#endif
- return(result);
-}
-
-
-static s7_rng_t *s7_default_rng(s7_scheme *sc)
-{
- if (!sc->default_rng)
+ size = float_format_precision;
+ if (!is_rational(x))
{
- sc->default_rng = (s7_rng_t *)calloc(1, sizeof(s7_rng_t));
- ((s7_rng_t *)(sc->default_rng))->ran_seed = (unsigned int)time(NULL);
- ((s7_rng_t *)(sc->default_rng))->ran_carry = 1675393560;
+ /* if size = 20, (number->string .1) gives "0.10000000000000000555", but if it's less than 20,
+ * large numbers (or very small numbers) mess up the less significant digits.
+ */
+ if (radix == 10)
+ {
+ if (is_real(x))
+ {
+ s7_double val;
+ val = fabs(s7_real(x));
+ if ((val > (s7_int32_max / 4)) || (val < 1.0e-6))
+ size += 4;
+ }
+ else
+ {
+ s7_double rl;
+ rl = fabs(s7_real_part(x));
+ if ((rl > (s7_int32_max / 4)) || (rl < 1.0e-6))
+ {
+ s7_double im;
+ im = fabs(s7_imag_part(x));
+ if ((im > (s7_int32_max / 4)) || (im < 1.0e-6))
+ size += 4;
+ }
+ }
+ }
}
- return((s7_rng_t *)(sc->default_rng));
-}
-
-
-s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args)
-{
- #define H_random_state_to_list "(random-state->list r) returns the random state object as a list.\
-You can later apply make-random-state to this list to continue a random number sequence from any point."
-
- s7_rng_t *r = NULL;
- s7_pointer obj;
- if (args == sc->NIL)
- r = s7_default_rng(sc);
- else
+ if (radix != 10)
{
- obj = car(args);
- if (c_object_type(obj) == rng_tag)
- r = (s7_rng_t *)s7_object_value(obj);
+ res = number_to_string_with_radix(sc, x, radix, 0, size, 'g', &nlen);
+ return(make_string_uncopied_with_length(sc, res, nlen));
}
-
- if (r)
- return(make_list_2(sc,
- s7_make_integer(sc, r->ran_seed),
- s7_make_integer(sc, r->ran_carry)));
- return(sc->F);
+ res = number_to_string_base_10(x, 0, size, 'g', &nlen, USE_WRITE);
+ if (temporary)
+ {
+ s7_pointer p;
+ prepare_temporary_string(sc, nlen + 1, 1);
+ p = sc->tmp_strs[1];
+ string_length(p) = nlen;
+ memcpy((void *)(string_value(p)), (void *)res, nlen);
+ string_value(p)[nlen] = 0;
+ return(p);
+ }
+ return(s7_make_string_with_length(sc, res, nlen));
}
-
-void s7_set_default_random_state(s7_scheme *sc, s7_Int seed, s7_Int carry)
+static s7_pointer g_number_to_string(s7_scheme *sc, s7_pointer args)
{
- sc->default_rng = (s7_rng_t *)calloc(1, sizeof(s7_rng_t));
- ((s7_rng_t *)(sc->default_rng))->ran_seed = (unsigned long long)seed;
- ((s7_rng_t *)(sc->default_rng))->ran_carry = (unsigned long long)carry;
+ return(g_number_to_string_1(sc, args, false));
}
-
-s7_Double s7_random(s7_scheme *sc, s7_pointer state)
+static s7_pointer number_to_string_temp;
+static s7_pointer g_number_to_string_temp(s7_scheme *sc, s7_pointer args)
{
- if (!state)
- return(next_random(s7_default_rng(sc)));
- return(next_random((s7_rng_t *)s7_object_value(state)));
+ return(g_number_to_string_1(sc, args, true));
}
-
-static s7_pointer g_random(s7_scheme *sc, s7_pointer args)
+static s7_pointer number_to_string_pf_temp(s7_scheme *sc, s7_pointer **p)
{
- #define H_random "(random num (state #f)) returns a random number between 0 and num (0 if num=0)."
- s7_pointer num, state;
- s7_rng_t *r;
-
- num = car(args);
- if (!s7_is_number(num))
- return(s7_wrong_type_arg_error(sc, "random bounds,", (cdr(args) == sc->NIL) ? 0 : 1, num, "a number"));
+ s7_pf_t f;
+ s7_pointer x;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(g_number_to_string_1(sc, set_plist_1(sc, x), true));
+}
- if (cdr(args) != sc->NIL)
- {
- state = cadr(args);
- if (!is_c_object(state))
- return(s7_wrong_type_arg_error(sc, "random state,", 2, state, "a random state as returned by make-random-state"));
+static s7_pointer number_to_string_pf_s_temp(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer x;
+ (*p)++; x = slot_value(**p); (*p)++;
+ return(g_number_to_string_1(sc, set_plist_1(sc, x), true));
+}
- if (c_object_type(state) == rng_tag)
- r = (s7_rng_t *)s7_object_value(state);
- else
- {
-#if WITH_GMP
- if (c_object_type(state) == big_rng_tag)
- return(big_random(sc, args));
-#endif
- return(s7_wrong_type_arg_error(sc, "random state,", 2, state, "a random state as returned by make-random-state"));
- }
- }
- else r = s7_default_rng(sc);
+static s7_pointer c_number_to_string(s7_scheme *sc, s7_pointer n) {return(g_number_to_string_1(sc, set_plist_1(sc, n), false));}
+PF_TO_PF(number_to_string, c_number_to_string)
- switch (number_type(num))
- {
- case NUM_INT:
- return(s7_make_integer(sc, (s7_Int)(s7_integer(num) * next_random(r))));
- case NUM_RATIO:
- {
- s7_Double x, error;
- s7_Int numer = 0, denom = 1;
+#define CTABLE_SIZE 256
+static bool *exponent_table, *slashify_table, *char_ok_in_a_name, *white_space, *number_table, *symbol_slashify_table;
+static int *digits;
- /* the error here needs to take the size of the fraction into account. Otherwise, if
- * error is (say) 1e-6 and the fraction is (say) 9000000/9223372036854775807,
- * c_rationalize will always return 0.
- */
- x = (s7_Double)s7_numerator(num) / (s7_Double)s7_denominator(num);
+static void init_ctables(void)
+{
+ int i;
- error = 1e-6 * s7_Double_abs(x);
- if (error > 1e-6)
- error = 1e-6;
- else
- {
- if (error < 1e-18)
- error = 1e-18;
- }
- c_rationalize(x * next_random(r), error, &numer, &denom);
- return(s7_make_ratio(sc, numer, denom));
- }
+ exponent_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ slashify_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ symbol_slashify_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ char_ok_in_a_name = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
+ white_space = (bool *)calloc(CTABLE_SIZE + 1, sizeof(bool));
+ white_space++; /* leave white_space[-1] false for white_space[EOF] */
+ number_table = (bool *)calloc(CTABLE_SIZE, sizeof(bool));
- case NUM_REAL:
- case NUM_REAL2:
- return(s7_make_real(sc, s7_real(num) * next_random(r)));
+ for (i = 1; i < CTABLE_SIZE; i++)
+ char_ok_in_a_name[i] = true;
+ char_ok_in_a_name[0] = false;
+ char_ok_in_a_name[(unsigned char)'('] = false; /* idiotic cast is for C++'s benefit */
+ char_ok_in_a_name[(unsigned char)')'] = false;
+ char_ok_in_a_name[(unsigned char)';'] = false;
+ char_ok_in_a_name[(unsigned char)'\t'] = false;
+ char_ok_in_a_name[(unsigned char)'\n'] = false;
+ char_ok_in_a_name[(unsigned char)'\r'] = false;
+ char_ok_in_a_name[(unsigned char)' '] = false;
+ char_ok_in_a_name[(unsigned char)'"'] = false;
+ /* what about stuff like vertical tab? or comma? */
- default:
- return(s7_make_complex(sc, complex_real_part(num) * next_random(r), complex_imag_part(num) * next_random(r)));
- }
+ for (i = 0; i < CTABLE_SIZE; i++)
+ white_space[i] = false;
+ white_space[(unsigned char)'\t'] = true;
+ white_space[(unsigned char)'\n'] = true;
+ white_space[(unsigned char)'\r'] = true;
+ white_space[(unsigned char)'\f'] = true;
+ white_space[(unsigned char)'\v'] = true;
+ white_space[(unsigned char)' '] = true;
+ white_space[(unsigned char)'\205'] = true; /* 133 */
+ white_space[(unsigned char)'\240'] = true; /* 160 */
- return(sc->F);
-}
+ /* surely only 'e' is needed... */
+ exponent_table[(unsigned char)'e'] = true; exponent_table[(unsigned char)'E'] = true;
+ exponent_table[(unsigned char)'@'] = true;
+#if WITH_EXTRA_EXPONENT_MARKERS
+ exponent_table[(unsigned char)'s'] = true; exponent_table[(unsigned char)'S'] = true;
+ exponent_table[(unsigned char)'f'] = true; exponent_table[(unsigned char)'F'] = true;
+ exponent_table[(unsigned char)'d'] = true; exponent_table[(unsigned char)'D'] = true;
+ exponent_table[(unsigned char)'l'] = true; exponent_table[(unsigned char)'L'] = true;
+#endif
+ for (i = 0; i < 32; i++)
+ slashify_table[i] = true;
+ for (i = 127; i < 160; i++)
+ slashify_table[i] = true;
+ slashify_table[(unsigned char)'\\'] = true;
+ slashify_table[(unsigned char)'"'] = true;
+ slashify_table[(unsigned char)'\n'] = false;
+ for (i = 0; i < CTABLE_SIZE; i++)
+ symbol_slashify_table[i] = ((slashify_table[i]) || (!char_ok_in_a_name[i]));
+ digits = (int *)calloc(CTABLE_SIZE, sizeof(int));
+ for (i = 0; i < CTABLE_SIZE; i++)
+ digits[i] = 256;
-/* -------------------------------- characters -------------------------------- */
+ digits[(unsigned char)'0'] = 0; digits[(unsigned char)'1'] = 1; digits[(unsigned char)'2'] = 2; digits[(unsigned char)'3'] = 3; digits[(unsigned char)'4'] = 4;
+ digits[(unsigned char)'5'] = 5; digits[(unsigned char)'6'] = 6; digits[(unsigned char)'7'] = 7; digits[(unsigned char)'8'] = 8; digits[(unsigned char)'9'] = 9;
+ digits[(unsigned char)'a'] = 10; digits[(unsigned char)'A'] = 10;
+ digits[(unsigned char)'b'] = 11; digits[(unsigned char)'B'] = 11;
+ digits[(unsigned char)'c'] = 12; digits[(unsigned char)'C'] = 12;
+ digits[(unsigned char)'d'] = 13; digits[(unsigned char)'D'] = 13;
+ digits[(unsigned char)'e'] = 14; digits[(unsigned char)'E'] = 14;
+ digits[(unsigned char)'f'] = 15; digits[(unsigned char)'F'] = 15;
-static s7_pointer g_char_to_integer(s7_scheme *sc, s7_pointer args)
-{
- #define H_char_to_integer "(char->integer c) converts the character c to an integer"
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "char->integer", 0, car(args), "a character"));
- return(small_int(character(car(args))));
-}
+ for (i = 0; i < CTABLE_SIZE; i++)
+ number_table[i] = false;
+ number_table[(unsigned char)'0'] = true;
+ number_table[(unsigned char)'1'] = true;
+ number_table[(unsigned char)'2'] = true;
+ number_table[(unsigned char)'3'] = true;
+ number_table[(unsigned char)'4'] = true;
+ number_table[(unsigned char)'5'] = true;
+ number_table[(unsigned char)'6'] = true;
+ number_table[(unsigned char)'7'] = true;
+ number_table[(unsigned char)'8'] = true;
+ number_table[(unsigned char)'9'] = true;
+ number_table[(unsigned char)'.'] = true;
+ number_table[(unsigned char)'+'] = true;
+ number_table[(unsigned char)'-'] = true;
+ number_table[(unsigned char)'#'] = true;
+}
+
+
+#define is_white_space(C) white_space[C]
+ /* this is much faster than C's isspace, and does not depend on the current locale.
+ * if c == EOF (-1), it indexes into the empty (0) slot we preallocated below white_space
+ */
-static s7_pointer g_integer_to_char(s7_scheme *sc, s7_pointer args)
+static s7_pointer check_sharp_readers(s7_scheme *sc, const char *name)
{
- #define H_integer_to_char "(integer->char i) converts the non-negative integer i to a character"
- s7_pointer x;
- s7_Int ind; /* not int here! (integer->char (expt 2 32)) -> #\null */
- x = car(args);
-
- if (!s7_is_integer(x))
- return(s7_wrong_type_arg_error(sc, "integer->char", 0, x, "an integer"));
- ind = s7_integer(x);
- if ((ind < 0) || (ind > 255))
- return(s7_wrong_type_arg_error(sc, "integer->char", 0, x, "an integer between 0 and 255"));
+ s7_pointer reader, value, args;
+ bool need_loader_port;
+ value = sc->F;
+ args = sc->F;
- return(s7_make_character(sc, (unsigned char)ind));
-}
+ /* *#reader* is assumed to be an alist of (char . proc)
+ * where each proc takes one argument, the string from just beyond the "#" to the next delimiter.
+ * The procedure can call read-char to read ahead in the current-input-port.
+ * If it returns anything other than #f, that is the value of the sharp expression.
+ * Since #f means "nothing found", it is tricky to handle #F:
+ * (cons #\F (lambda (str) (and (string=? str "F") (list 'not #t))))
+ * This search happens after #|, #t, and #f (and #nD for multivectors?). #! has a fallback.
+ */
+ need_loader_port = is_loader_port(sc->input_port);
+ if (need_loader_port)
+ clear_loader_port(sc->input_port);
-static s7_pointer g_char_upcase(s7_scheme *sc, s7_pointer args)
-{
- #define H_char_upcase "(char-upcase c) converts the character c to upper case"
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "char-upcase", 0, car(args), "a character"));
- return(s7_make_character(sc, (unsigned char)toupper(character(car(args)))));
+ /* normally read* can't read from sc->input_port if it is in use by the loader,
+ * but here we are deliberately making that possible.
+ */
+ for (reader = slot_value(sc->sharp_readers); is_not_null(reader); reader = cdr(reader))
+ {
+ if (name[0] == s7_character(caar(reader)))
+ {
+ if (args == sc->F)
+ args = list_1(sc, s7_make_string(sc, name));
+ /* args is GC protected by s7_apply_function (placed on the stack */
+ value = s7_apply_function(sc, cdar(reader), args); /* this is much less error-safe than s7_call */
+ if (value != sc->F)
+ break;
+ }
+ }
+ if (need_loader_port)
+ set_loader_port(sc->input_port);
+ return(value);
}
-static s7_pointer g_char_downcase(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_sharp_readers_set(s7_scheme *sc, s7_pointer args)
{
- #define H_char_downcase "(char-downcase c) converts the character c to lower case"
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "char-downcase", 0, car(args), "a character"));
- return(s7_make_character(sc, (unsigned char)tolower(character(car(args)))));
+ /* new value must be either () or a proper list of conses (char . func) */
+ if (is_null(cadr(args))) return(cadr(args));
+ if (is_pair(cadr(args)))
+ {
+ s7_pointer x;
+ for (x = cadr(args); is_pair(x); x = cdr(x))
+ {
+ if ((!is_pair(car(x))) ||
+ (!s7_is_character(caar(x))) ||
+ (!s7_is_procedure(cdar(x))))
+ return(sc->ERROR);
+ }
+ if (is_null(x))
+ return(cadr(args));
+ }
+ return(sc->ERROR);
}
-static s7_pointer g_is_char_alphabetic(s7_scheme *sc, s7_pointer args)
+static bool is_abnormal(s7_pointer x)
{
- #define H_is_char_alphabetic "(char-alphabetic? c) returns #t if the character c is alphabetic"
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "char-alphabetic?", 0, car(args), "a character"));
- return(make_boolean(sc, isalpha(character(car(args)))));
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ return(false);
- /* isalpha returns #t for (integer->char 226) and others in that range */
-}
+ case T_REAL:
+ return(is_inf(real(x)) ||
+ is_NaN(real(x)));
+ case T_COMPLEX:
+ return(((is_inf(s7_real_part(x))) ||
+ (is_inf(s7_imag_part(x))) ||
+ (is_NaN(s7_real_part(x))) ||
+ (is_NaN(s7_imag_part(x)))));
-static s7_pointer g_is_char_numeric(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_numeric "(char-numeric? c) returns #t if the character c is a digit"
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "char-numeric?", 0, car(args), "a character"));
- return(make_boolean(sc, isdigit(character(car(args)))));
-}
-
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ return(false);
-static s7_pointer g_is_char_whitespace(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_whitespace "(char-whitespace? c) returns #t if the character c is non-printing character"
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "char-whitespace?", 0, car(args), "a character"));
- return(make_boolean(sc, white_space[character(car(args))]));
-}
+ case T_BIG_REAL:
+ return((is_inf(s7_real_part(x))) ||
+ (is_NaN(s7_real_part(x))));
+ case T_BIG_COMPLEX:
+ return((is_inf(s7_real_part(x))) ||
+ (is_inf(s7_imag_part(x))) ||
+ (is_NaN(s7_real_part(x))) ||
+ (is_NaN(s7_imag_part(x))));
+#endif
-static s7_pointer g_is_char_upper_case(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_upper_case "(char-upper-case? c) returns #t if the character c is in upper case"
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "char-upper-case?", 0, car(args), "a character"));
- return(make_boolean(sc, isupper(character(car(args)))));
+ default:
+ return(true);
+ }
}
-static s7_pointer g_is_char_lower_case(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_lower_case "(char-lower-case? c) returns #t if the character c is in lower case"
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "char-lower-case?", 0, car(args), "a character"));
- return(make_boolean(sc, islower(character(car(args)))));
-}
+#define NESTED_SHARP false
+#define UNNESTED_SHARP true
+#define SYMBOL_OK true
+#define NO_SYMBOLS false
-static s7_pointer g_is_char(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, bool at_top, int radix, bool with_error)
{
- #define H_is_char "(char? obj) returns #t if obj is a character"
- return(make_boolean(sc, s7_is_character(car(args))));
-}
+ /* name is the stuff after the '#', return sc->NIL if not a recognized #... entity */
+ int len;
+ s7_pointer x;
+ if ((name[0] == 't') &&
+ ((name[1] == '\0') || (strings_are_equal(name, "true"))))
+ return(sc->T);
-s7_pointer s7_make_character(s7_scheme *sc, unsigned int c)
-{
- return(chars[c]);
-}
+ if ((name[0] == 'f') &&
+ ((name[1] == '\0') || (strings_are_equal(name, "false"))))
+ return(sc->F);
+ if (is_not_null(slot_value(sc->sharp_readers)))
+ {
+ x = check_sharp_readers(sc, name);
+ if (x != sc->F)
+ return(x);
+ }
-bool s7_is_character(s7_pointer p)
-{
- return(type(p) == T_CHARACTER);
-}
+ len = safe_strlen5(name); /* just count up to 5 */
+ if (len < 2)
+ return(sc->NIL);
+ switch (name[0])
+ {
+ /* -------- #< ... > -------- */
+ case '<':
+ if (strings_are_equal(name, "<unspecified>"))
+ return(sc->UNSPECIFIED);
-char s7_character(s7_pointer p)
-{
- return(character(p));
-}
+ if (strings_are_equal(name, "<undefined>"))
+ return(sc->UNDEFINED);
+ if (strings_are_equal(name, "<eof>"))
+ return(sc->EOF_OBJECT);
-static int charcmp(unsigned char c1, unsigned char c2, bool ci)
-{
- if (ci)
- return(charcmp(toupper(c1), toupper(c2), false));
- /* not tolower here -- the single case is apparently supposed to be upper case
- * this matters in a case like (char-ci<? #\_ #\e) which Guile and Gauche say is #f
- * although (char<? #\_ #\e) is #t -- the spec does not say how to interpret this!
- */
- if (c1 == c2)
- return(0);
- if (c1 < c2)
- return(-1);
- return(1);
-}
+ return(sc->NIL);
-static s7_pointer g_char_cmp(s7_scheme *sc, s7_pointer args, int val, const char *name, bool ci)
-{
- int i;
- s7_pointer x;
- unsigned char last_chr;
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_character(car(x)))
- return(s7_wrong_type_arg_error(sc, name, i, car(x), "a character"));
-
- last_chr = character(car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
- {
- if (charcmp(last_chr, character(car(x)), ci) != val)
- return(sc->F);
- last_chr = character(car(x));
- }
- return(sc->T);
-}
+ /* -------- #o #d #x #b -------- */
+ case 'o': /* #o (octal) */
+ case 'd': /* #d (decimal) */
+ case 'x': /* #x (hex) */
+ case 'b': /* #b (binary) */
+ {
+ int num_at = 1;
+#if (!WITH_PURE_S7)
+ bool to_inexact = false, to_exact = false;
+ if (name[1] == '#')
+ {
+ if (!at_top)
+ return(sc->NIL);
+ if ((len > 2) && ((name[2] == 'e') || (name[2] == 'i'))) /* r6rs includes caps here */
+ {
+ if ((len > 3) && (name[3] == '#'))
+ return(sc->NIL);
+ to_inexact = (name[2] == 'i');
+ to_exact = (name[2] == 'e');
+ num_at = 3;
+ }
+ else return(sc->NIL);
+ }
+#endif
+ /* the #b or whatever overrides any radix passed in earlier */
+ x = make_atom(sc, (char *)(name + num_at), (name[0] == 'o') ? 8 : ((name[0] == 'x') ? 16 : ((name[0] == 'b') ? 2 : 10)), NO_SYMBOLS, with_error);
-static s7_pointer g_char_cmp_not(s7_scheme *sc, s7_pointer args, int val, const char *name, bool ci)
-{
- int i;
- s7_pointer x;
- unsigned char last_chr;
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_character(car(x)))
- return(s7_wrong_type_arg_error(sc, name, i, car(x), "a character"));
-
- last_chr = character(car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
- {
- if (charcmp(last_chr, character(car(x)), ci) == val)
- return(sc->F);
- last_chr = character(car(x));
- }
- return(sc->T);
-}
+ /* #x#i1 apparently makes sense, so #x1.0 should also be accepted.
+ * here we can get #b#e0/0 or #b#e+1/0 etc.
+ * surely if #e1+i is an error (or #f), and #e#x1+i is an error,
+ * #x#e1+i should also be an error, but #e1+0i is not an error I guess since there actually isn't any imaginary part
+ */
+ if (is_abnormal(x))
+ return(sc->NIL);
+#if (!WITH_PURE_S7)
+ if ((!to_exact) && (!to_inexact))
+ return(x);
-static s7_pointer g_chars_are_equal(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_equal "(char=? chr...) returns #t if all the character arguments are equal"
- return(g_char_cmp(sc, args, 0, "char=?", false));
-}
+ if ((s7_imag_part(x) != 0.0) && (to_exact)) /* #x#e1+i */
+ return(sc->NIL);
+#if WITH_GMP
+ if (s7_is_bignum(x))
+ {
+ if (to_exact)
+ return(big_inexact_to_exact(sc, set_plist_1(sc, x)));
+ return(big_exact_to_inexact(sc, set_plist_1(sc, x)));
+ }
+#endif
+ if (to_exact)
+ return(inexact_to_exact(sc, x, with_error));
+ return(exact_to_inexact(sc, x));
+#else
+ return(x);
+#endif
+ }
+ break;
-static s7_pointer g_chars_are_less(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_less "(char<? chr...) returns #t if all the character arguments are increasing"
- return(g_char_cmp(sc, args, -1, "char<?", false));
-}
+#if (!WITH_PURE_S7)
+ /* -------- #i -------- */
+ case 'i': /* #i<num> = ->inexact (see token for table of choices here) */
+ if (name[1] == '#')
+ {
+ /* there are special cases here: "#e0/0" or "#e#b0/0" -- all infs are complex:
+ * #i1/0=nan.0 but #i1/0+i=inf+1i so e->i is a no-op but i->e is not
+ *
+ * even trickier: a *#reader* like #t<num> could be used as #e#t13.25 so make_sharp_constant
+ * needs to be willing to call the readers even when not at_top (i.e. when NESTED_SHARP).
+ */
+ if ((name[2] == 'e') || /* #i#e1 -- assume these aren't redefinable? */
+ (name[2] == 'i'))
+ return(sc->NIL);
-static s7_pointer g_chars_are_greater(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_greater "(char>? chr...) returns #t if all the character arguments are decreasing"
- return(g_char_cmp(sc, args, 1, "char>?", false));
-}
+ x = make_sharp_constant(sc, (char *)(name + 2), NESTED_SHARP, radix, with_error);
+ if (s7_is_number(x))
+ {
+ if (is_abnormal(x))
+ return(sc->NIL);
+#if WITH_GMP
+ if (s7_is_bignum(x)) /* (string->number "#b#e-11e+111") */
+ return(big_exact_to_inexact(sc, set_plist_1(sc, x)));
+#endif
+ return(exact_to_inexact(sc, x));
+ }
+ return(sc->NIL);
+ }
+ x = make_atom(sc, (char *)(name + 1), radix, NO_SYMBOLS, with_error);
+ if (!s7_is_number(x)) /* not is_abnormal(x) -- #i0/0 -> nan etc */
+ return(sc->NIL);
+#if WITH_GMP
+ if (s7_is_bignum(x))
+ return(big_exact_to_inexact(sc, set_plist_1(sc, x)));
+#endif
+ return(exact_to_inexact(sc, x));
-static s7_pointer g_chars_are_geq(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_geq "(char>=? chr...) returns #t if all the character arguments are equal or decreasing"
- return(g_char_cmp_not(sc, args, -1, "char>=?", false));
-}
+ /* -------- #e -------- */
+ case 'e': /* #e<num> = ->exact */
+ if (name[1] == '#')
+ {
+ if ((name[2] == 'e') || /* #e#e1 */
+ (name[2] == 'i'))
+ return(sc->NIL);
+ x = make_sharp_constant(sc, (char *)(name + 2), NESTED_SHARP, radix, with_error);
+ if (s7_is_number(x))
+ {
+ if (is_abnormal(x)) /* (string->number "#e#b0/0") */
+ return(sc->NIL);
+ if (!s7_is_real(x)) /* (string->number "#e#b1+i") */
+ return(sc->NIL);
+#if WITH_GMP
+ return(big_inexact_to_exact(sc, set_plist_1(sc, x)));
+#endif
+ return(inexact_to_exact(sc, x, with_error));
+ }
+ return(sc->NIL);
+ }
-static s7_pointer g_chars_are_leq(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_leq "(char<=? chr...) returns #t if all the character arguments are equal or increasing"
- return(g_char_cmp_not(sc, args, 1, "char<=?", false));
-}
+ x = make_atom(sc, (char *)(name + 1), radix, NO_SYMBOLS, with_error);
+#if WITH_GMP
+ /* #e1e310 is a simple case */
+ if (s7_is_bignum(x))
+ return(big_inexact_to_exact(sc, set_plist_1(sc, x)));
+#endif
+ if (is_abnormal(x)) /* (string->number "#e0/0") */
+ return(sc->NIL);
+ if (!s7_is_real(x)) /* (string->number "#e1+i") */
+ return(sc->NIL);
+#if WITH_GMP
+ /* there are non-big floats that are greater than most-positive-fixnum:
+ * :(> .1e20 most-positive-fixnum) -> #t
+ * :(bignum? .1e20) -> #f
+ * so we have to check that, not just is it a bignum.
+ */
+ return(big_inexact_to_exact(sc, set_plist_1(sc, x)));
+#endif
+ return(inexact_to_exact(sc, x, with_error));
+#endif /* !WITH_PURE_S7 */
-static s7_pointer g_chars_are_ci_equal(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_ci_equal "(char-ci=? chr...) returns #t if all the character arguments are equal, ignoring case"
- return(g_char_cmp(sc, args, 0, "char-ci=?", true));
-}
+ /* -------- #_... -------- */
+ case '_':
+ {
+ s7_pointer sym;
+ sym = make_symbol(sc, (char *)(name + 1));
+ if (is_slot(initial_slot(sym)))
+ return(slot_value(initial_slot(sym)));
+ return(s7_error(sc, sc->SYNTAX_ERROR, set_elist_2(sc, make_string_wrapper(sc, "#~A is undefined"), make_string_wrapper(sc, name))));
+ /* return(sc->UNDEFINED); */
+ }
-static s7_pointer g_chars_are_ci_less(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_ci_less "(char-ci<? chr...) returns #t if all the character arguments are increasing, ignoring case"
- return(g_char_cmp(sc, args, -1, "char-ci<?", true));
-}
+ /* -------- #\... -------- */
+ case '\\':
+ if (name[2] == 0) /* the most common case: #\a */
+ return(chars[(unsigned char)(name[1])]);
+ /* not unsigned int here! (unsigned int)255 (as a char) returns -1!! */
+ switch (name[1])
+ {
+ case 'n':
+ if ((strings_are_equal(name + 1, "null")) ||
+ (strings_are_equal(name + 1, "nul")))
+ return(chars[0]);
-static s7_pointer g_chars_are_ci_greater(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_ci_greater "(char-ci>? chr...) returns #t if all the character arguments are decreasing, ignoring case"
- return(g_char_cmp(sc, args, 1, "char-ci>?", true));
-}
+ if (strings_are_equal(name + 1, "newline"))
+ return(chars[(unsigned char)'\n']);
+ break;
+ case 's':
+ if (strings_are_equal(name + 1, "space"))
+ return(chars[(unsigned char)' ']);
+ break;
-static s7_pointer g_chars_are_ci_geq(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_ci_geq "(char-ci>=? chr...) returns #t if all the character arguments are equal or decreasing, ignoring case"
- return(g_char_cmp_not(sc, args, -1, "char-ci>=?", true));
-}
+ case 'r':
+ if (strings_are_equal(name + 1, "return"))
+ return(chars[(unsigned char)'\r']);
+ break;
+ case 'l':
+ if (strings_are_equal(name + 1, "linefeed"))
+ return(chars[(unsigned char)'\n']);
+ break;
-static s7_pointer g_chars_are_ci_leq(s7_scheme *sc, s7_pointer args)
-{
- #define H_chars_are_ci_leq "(char-ci<=? chr...) returns #t if all the character arguments are equal or increasing, ignoring case"
- return(g_char_cmp_not(sc, args, 1, "char-ci<=?", true));
-}
+ case 't':
+ if (strings_are_equal(name + 1, "tab"))
+ return(chars[(unsigned char)'\t']);
+ break;
+ case 'a':
+ /* the next 4 are for r7rs */
+ if (strings_are_equal(name + 1, "alarm"))
+ return(chars[7]);
+ break;
+ case 'b':
+ if (strings_are_equal(name + 1, "backspace"))
+ return(chars[8]);
+ break;
-/* -------------------------------- strings -------------------------------- */
+ case 'e':
+ if (strings_are_equal(name + 1, "escape"))
+ return(chars[0x1b]);
+ break;
+ case 'd':
+ if (strings_are_equal(name + 1, "delete"))
+ return(chars[0x7f]);
+ break;
-s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, int len)
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_STRING | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY); /* should this follow the malloc? */
- string_value(x) = (char *)malloc((len + 1) * sizeof(char));
- if (len != 0) /* memcpy can segfault if string_value(x) is NULL */
- memcpy((void *)string_value(x), (void *)str, len + 1);
- else string_value(x)[0] = 0;
- string_length(x) = len;
- return(x);
-}
-
-
-static s7_pointer s7_make_terminated_string_with_length(s7_scheme *sc, const char *str, int len)
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_STRING | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY); /* should this follow the malloc? */
- string_value(x) = (char *)malloc((len + 1) * sizeof(char));
- if (len != 0) /* memcpy can segfault if string_value(x) is NULL */
- memcpy((void *)string_value(x), (void *)str, len);
- string_value(x)[len] = 0;
- string_length(x) = len;
- return(x);
-}
-
+ case 'x':
+ /* #\x is just x, but apparently #\x<num> is int->char? #\x65 -> #\e -- Guile doesn't have this
+ *
+ * r7rs has 2/3/4-byte "characters" of the form #\xcebb but this is not compatible with
+ * make-string, string-length, and so on. We'd either have to have 2-byte chars
+ * so (string-length (make-string 3 #\xcebb)) = 3, or accept 6 here for number of chars.
+ * Then substring and string-set! and so on have to use utf8 encoding throughout or
+ * risk changing the string length unexpectedly.
+ */
+ {
+ /* sscanf here misses errors like #\x1.4, but make_atom misses #\x6/3,
+ * #\x#b0, #\x#e0.0, #\x-0, #\x#e0e100 etc, so we have to do it at
+ * an even lower level.
+ * another problem: #\xbdca2cbec overflows so lval is -593310740 -> segfault unless caught
+ */
+ bool happy = true;
+ char *tmp;
+ int lval = 0;
-static s7_pointer make_string_uncopied_with_length(s7_scheme *sc, char *str, int len)
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_STRING | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
- string_value(x) = str;
- string_length(x) = len;
- return(x);
+ tmp = (char *)(name + 2);
+ while ((*tmp) && (happy) && (lval >= 0))
+ {
+ int dig;
+ dig = digits[(int)(*tmp++)];
+ if (dig < 16)
+ lval = dig + (lval * 16);
+ else happy = false;
+ }
+ if ((happy) &&
+ (lval < 256) &&
+ (lval >= 0))
+ return(chars[lval]);
+ }
+ break;
+ }
+ }
+ return(sc->NIL);
}
-static s7_pointer make_protected_string(s7_scheme *sc, const char *str)
+static s7_int string_to_integer(const char *str, int radix, bool *overflow)
{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_STRING | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- string_value(x) = (char *)str;
- string_length(x) = safe_strlen(str);
- return(x);
-}
-
+ bool negative = false;
+ s7_int lval = 0;
+ int dig;
+ char *tmp = (char *)str;
+ char *tmp1;
-static s7_pointer make_empty_string(s7_scheme *sc, int len, char fill)
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_STRING | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
-
- if (fill == 0)
- string_value(x) = (char *)calloc((len + 1), sizeof(char));
+ if (str[0] == '+')
+ tmp++;
else
{
- string_value(x) = (char *)malloc((len + 1) * sizeof(char));
- memset((void *)(string_value(x)), fill, len);
+ if (str[0] == '-')
+ {
+ negative = true;
+ tmp++;
+ }
}
- string_value(x)[len] = 0;
-
- string_length(x) = len;
- return(x);
-}
-
-
-s7_pointer s7_make_string(s7_scheme *sc, const char *str)
-{
- return(s7_make_string_with_length(sc, str, safe_strlen(str)));
-}
-
-
-static s7_pointer make_string_uncopied(s7_scheme *sc, char *str)
-{
- return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
-}
-
-
-static char *make_permanent_string(const char *str)
-{
- char *x;
- int len;
- len = safe_strlen(str);
- x = (char *)permanent_calloc((len + 1) * sizeof(char));
- memcpy((void *)x, (void *)str, len);
- return(x);
-}
-
+ while (*tmp == '0') {tmp++;};
+ tmp1 = tmp;
-s7_pointer s7_make_permanent_string(const char *str)
-{
- /* for the symbol table which is never GC'd */
- s7_pointer x;
- x = (s7_cell *)permanent_calloc(sizeof(s7_cell));
- x->hloc = NOT_IN_HEAP;
- set_type(x, T_STRING | T_SIMPLE | T_IMMUTABLE | T_DONT_COPY);
- if (str)
+ if (radix == 10)
{
- string_length(x) = safe_strlen(str);
- string_value(x) = (char *)permanent_calloc((string_length(x) + 1) * sizeof(char));
- memcpy((void *)string_value(x), (void *)str, string_length(x));
+ while (true)
+ {
+ dig = digits[(unsigned char)(*tmp++)];
+ if (dig > 9) break;
+#if HAVE_OVERFLOW_CHECKS
+ if (multiply_overflow(lval, (s7_int)10, &lval)) break;
+ if (add_overflow(lval, (s7_int)dig, &lval)) break;
+#else
+ lval = dig + (lval * 10);
+ dig = digits[(unsigned char)(*tmp++)];
+ if (dig > 9) break;
+ lval = dig + (lval * 10);
+#endif
+ }
}
- else
+ else
{
- string_value(x) = NULL;
- string_length(x) = 0;
+ while (true)
+ {
+ dig = digits[(unsigned char)(*tmp++)];
+ if (dig >= radix) break;
+#if HAVE_OVERFLOW_CHECKS
+ if (multiply_overflow(lval, (s7_int)radix, &lval)) break;
+ if (add_overflow(lval, (s7_int)dig, &lval)) break;
+#else
+ lval = dig + (lval * radix);
+ dig = digits[(unsigned char)(*tmp++)];
+ if (dig >= radix) break;
+ lval = dig + (lval * radix);
+#endif
+ }
}
- return(x);
-}
-
-
-bool s7_is_string(s7_pointer p)
-{
- return((type(p) == T_STRING));
-}
-
-
-const char *s7_string(s7_pointer p)
-{
- return(string_value(p));
-}
-
-
-static s7_pointer g_is_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_string "(string? obj) returns #t if obj is a string"
- return(make_boolean(sc, s7_is_string(car(args))));
-}
-
-
-#define MAX_STRING_LENGTH 1073741824
-
-static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_make_string "(make-string len (val #\\space)) makes a string of length len filled with the character val (default: space)"
- s7_Int len;
- char fill = ' ';
-
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "make-string length,", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "an integer"));
-
- len = s7_integer(car(args));
- if (len < 0)
- return(s7_out_of_range_error(sc, "make-string length,", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "a non-negative integer"));
- if (len > MAX_STRING_LENGTH)
- return(s7_out_of_range_error(sc, "make-string length,", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "a reasonable integer!"));
- if (cdr(args) != sc->NIL)
+#if WITH_GMP
+ (*overflow) = ((lval > s7_int32_max) ||
+ ((tmp - tmp1) > s7_int_digits_by_radix[radix]));
+ /* this tells the string->number readers to create a bignum. We need to be very
+ * conservative here to catch contexts such as (/ 1/524288 19073486328125)
+ */
+#else
+ if ((tmp - tmp1 - 2) > s7_int_digits_by_radix[radix])
{
- if (!s7_is_character(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "make-string filler,", 2, cadr(args), "a character"));
- fill = s7_character(cadr(args));
+ /* I can't decide what to do with these non-gmp overflows. Perhaps NAN in all cases?
+ * overflow: 9223372036854775810 -> -9223372036854775806 -- this is not caught currently
+ */
+ (*overflow) = true;
+ if (negative)
+ return(s7_int_min); /* or INFINITY? */
+ return(s7_int_max); /* 0/100000000000000000000000000000000000000000000000000000000000000000000 */
}
- return(make_empty_string(sc, (int)len, fill));
-}
-
+#endif
-static s7_pointer g_string_length(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_length "(string-length str) returns the length of the string str"
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "string-length", 0, car(args), "string"));
- return(s7_make_integer(sc, string_length(car(args))));
+ if (negative)
+ return(-lval);
+ return(lval);
}
-static s7_pointer string_ref_1(s7_scheme *sc, s7_pointer strng, s7_pointer index)
-{
- char *str;
- s7_Int ind;
-
- if (!s7_is_integer(index))
- return(s7_wrong_type_arg_error(sc, "string-ref", 2, index, "an integer"));
-
- ind = s7_integer(index);
-
- if (ind < 0)
- return(s7_wrong_type_arg_error(sc, "string-ref index,", 2, index, "a non-negative integer"));
- if (ind >= string_length(strng))
- return(s7_out_of_range_error(sc, "string-ref index,", 2, index, "should be less than string length"));
-
- str = string_value(strng);
- return(s7_make_character(sc, ((unsigned char *)str)[ind]));
-}
-
+/* 9223372036854775807 9223372036854775807
+ * -9223372036854775808 -9223372036854775808
+ * 0000000000000000000000000001.0 1.0
+ * 1.0000000000000000000000000000 1.0
+ * 1000000000000000000000000000.0e-40 1.0e-12
+ * 0.0000000000000000000000000001e40 1.0e12
+ * 1.0e00000000000000000001 10.0
+ */
-static s7_pointer g_string_ref(s7_scheme *sc, s7_pointer args)
+static s7_double string_to_double_with_radix(const char *ur_str, int radix, bool *overflow)
{
- #define H_string_ref "(string-ref str index) returns the character at the index-th element of the string str"
-
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "string-ref", 1, car(args), "a string"));
-
- return(string_ref_1(sc, car(args), cadr(args)));
-}
-
+ /* strtod follows LANG which is not what we want (only "." is decimal point in Scheme).
+ * To overcome LANG in strtod would require screwing around with setlocale which never works.
+ * So we use our own code -- according to valgrind, this function is much faster than strtod.
+ *
+ * comma as decimal point causes ambiguities: `(+ ,1 2) etc
+ */
-static s7_pointer g_string_set(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_set "(string-set! str index chr) sets the index-th element of the string str to the character chr"
-
- s7_pointer x, index;
+ int i, sign = 1, frac_len, int_len, dig, max_len, exponent = 0;
+ long long int int_part = 0, frac_part = 0;
char *str;
- s7_Int ind;
-
- x = car(args);
- index = cadr(args);
-
- if (!s7_is_string(x))
- return(s7_wrong_type_arg_error(sc, "string-set!", 1, x, "a string"));
- if (!s7_is_character(caddr(args)))
- return(s7_wrong_type_arg_error(sc, "string-set!", 3, caddr(args), "a character"));
- if (!s7_is_integer(index))
- return(s7_wrong_type_arg_error(sc, "string-set! index,", 2, index, "an integer"));
-
- ind = s7_integer(index);
-
- if (ind < 0)
- return(s7_wrong_type_arg_error(sc, "string-set! index,", 2, index, "a non-negative integer"));
- if (ind >= string_length(x))
- return(s7_out_of_range_error(sc, "string-set! index,", 2, index, "should be less than string length"));
+ char *ipart, *fpart;
+ s7_double dval = 0.0;
- /* I believe this does not need a lock in the multithread case -- local vars are specific
- * to each thread, and it should be obvious to anyone writing such code that a global
- * variable needs its lock (caller-supplied) -- it's not s7's job to protect even the
- * caller's (scheme) variables.
+ /* there's an ambiguity in number notation here if we allow "1e1" or "1.e1" in base 16 (or 15) -- is e a digit or an exponent marker?
+ * but 1e+1, for example disambiguates it -- kind of messy! -- the scheme spec says "e" can only occur in base 10.
+ * mpfr says "e" as exponent only in bases <= 10 -- else use '@' which works in any base. This can only cause confusion
+ * in scheme, unfortunately, due to the idiotic scheme polar notation. But we accept "s" and "l" as exponent markers
+ * so, perhaps for radix > 10, the exponent, if any, has to use one of S s L l? Not "l"! And "s" originally meant "short".
+ *
+ * '@' can now be used as the exponent marker (26-Mar-12).
+ * Another slight ambiguity: 1+1/2i is parsed as 1 + 0.5i, not 1+1/(2i), or (1+1)/(2i) or (1+1/2)i etc
*/
- str = string_value(x);
- str[ind] = (char)s7_character(caddr(args));
- return(caddr(args));
-}
+ max_len = s7_int_digits_by_radix[radix];
+ str = (char *)ur_str;
-static s7_pointer g_string_append_1(s7_scheme *sc, s7_pointer args, const char *name)
-{
- int i, len = 0;
- s7_pointer x, newstr;
- char *pos;
-
- if (args == sc->NIL)
- return(s7_make_string_with_length(sc, "", 0));
-
- /* get length for new string */
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
+ if (*str == '+')
+ str++;
+ else
{
- if (!s7_is_string(car(x)))
- return(s7_wrong_type_arg_error(sc, name, i, car(x), "a string"));
- len += string_length(car(x));
+ if (*str == '-')
+ {
+ str++;
+ sign = -1;
+ }
}
-
- /* store the contents of the argument strings into the new string */
- newstr = make_empty_string(sc, len, 0);
- for (pos = string_value(newstr), x = args; x != sc->NIL; pos += string_length(car(x)), x = cdr(x))
- memcpy(pos, string_value(car(x)), string_length(car(x)));
-
- return(newstr);
-}
-
-
-static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_append "(string-append str1 ...) appends all its string arguments into one string"
- return(g_string_append_1(sc, args, "string-append"));
-}
-
+ while (*str == '0') {str++;};
-static s7_pointer g_string_copy(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_copy "(string-copy str) returns a copy of its string argument"
- if (args == sc->NIL)
- return(s7_wrong_type_arg_error(sc, "string-copy", 0, car(args), "a string"));
-
- return(g_string_append_1(sc, args, "string-copy"));
-}
+ ipart = str;
+ while (digits[(int)(*str)] < radix) str++;
+ int_len = str - ipart;
+ if (*str == '.') str++;
+ fpart = str;
+ while (digits[(int)(*str)] < radix) str++;
+ frac_len = str - fpart;
-static s7_pointer g_substring(s7_scheme *sc, s7_pointer args)
-{
- #define H_substring "(substring str start (end (length str))) returns the portion of the string str between start and \
-end: (substring \"01234\" 1 2) -> \"1\""
-
- s7_pointer x, start, end, str;
- s7_Int i0, i1;
- int len;
- char *s;
-
- str = car(args);
- start = cadr(args);
-
- if (!s7_is_string(str))
- return(s7_wrong_type_arg_error(sc, "substring", 1, str, "a string"));
-
- if (!s7_is_integer(start))
- return(s7_wrong_type_arg_error(sc, "substring start point,", 2, start, "an integer"));
- i0 = s7_integer(start);
- if (i0 < 0)
- return(s7_wrong_type_arg_error(sc, "substring start point,", 2, start, "a non-negative integer"));
- if (i0 > string_length(str)) /* (substring "012" 10) */
- return(s7_out_of_range_error(sc, "substring start point,", 2, start, "start <= string length"));
- /* this is how guile handles it: (substring "012" 3) -> "" */
-
- if (cddr(args) != sc->NIL)
- {
- end = caddr(args);
- if (!s7_is_integer(end))
- return(s7_wrong_type_arg_error(sc, "substring end point,", 3, end, "an integer"));
- i1 = s7_integer(end);
- if (i1 < i0)
- return(s7_wrong_type_arg_error(sc, "substring end point,", 3, end, "an integer >= start"));
- if (i1 > string_length(str))
- return(s7_out_of_range_error(sc, "substring end point,", 3, end, "end <= string length"));
- }
- else i1 = string_length(str);
-
- s = string_value(str);
- len = i1 - i0;
- x = make_empty_string(sc, len, 0);
- memcpy(string_value(x), s + i0, len);
- string_value(x)[len] = 0;
- return(x);
-}
-
-/* (set! (substring...) ...)? -- might require allocation
- */
-
-
-#define USE_WRITE true
-#define USE_DISPLAY false
+ if ((*str) && (exponent_table[(unsigned char)(*str)]))
+ {
+ int exp_negative = false;
+ str++;
+ if (*str == '+')
+ str++;
+ else
+ {
+ if (*str == '-')
+ {
+ str++;
+ exp_negative = true;
+ }
+ }
+ while ((dig = digits[(int)(*str++)]) < 10) /* exponent itself is always base 10 */
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((int_multiply_overflow(exponent, 10, &exponent)) ||
+ (int_add_overflow(exponent, dig, &exponent)))
+ {
+ exponent = 1000000; /* see below */
+ break;
+ }
+#else
+ exponent = dig + (exponent * 10);
+#endif
+ }
+#if (!defined(__GNUC__)) || (__GNUC__ < 5)
+ if (exponent < 0) /* we overflowed, so make sure we notice it below (need to check for 0.0e... first) (Brian Damgaard) */
+ exponent = 1000000; /* see below for examples -- this number needs to be very big but not too big for add */
+#endif
+ if (exp_negative)
+ exponent = -exponent;
+
+ /* 2e12341234123123123123213123123123 -> 0.0
+ * but exp len is not the decider: 2e00000000000000000000000000000000000000001 -> 20.0
+ * first zero: 2e123412341231231231231
+ * then: 2e12341234123123123123123123 -> inf
+ * then: 2e123412341231231231231231231231231231 -> 0.0
+ * 2e-123412341231231231231 -> inf
+ * but: 0e123412341231231231231231231231231231
+ */
+ }
-static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_object_to_string "(object->string obj (write true)) returns a string representation of obj."
-
- if (cdr(args) != sc->NIL)
+#if WITH_GMP
+ /* 9007199254740995.0 */
+ if (int_len + frac_len >= max_len)
{
- if (s7_is_boolean(cadr(args)))
- return(s7_object_to_string(sc, car(args), s7_boolean(sc, cadr(args))));
- return(s7_wrong_type_arg_error(sc, "object->string", 2, cadr(args), "a boolean"));
+ (*overflow) = true;
+ return(0.0);
}
- return(s7_object_to_string(sc, car(args), USE_WRITE));
-}
+#endif
+ str = ipart;
+ if ((int_len + exponent) > max_len)
+ {
+ /* 12341234.56789e12 12341234567889999872.0 1.234123456789e+19
+ * -1234567890123456789.0 -1234567890123456768.0 -1.2345678901235e+18
+ * 12345678901234567890.0 12345678901234567168.0 1.2345678901235e+19
+ * 123.456e30 123456000000000012741097792995328.0 1.23456e+32
+ * 12345678901234567890.0e12 12345678901234569054409354903552.0 1.2345678901235e+31
+ * 1.234567890123456789012e30 1234567890123456849145940148224.0 1.2345678901235e+30
+ * 1e20 100000000000000000000.0 1e+20
+ * 1234567890123456789.0 1234567890123456768.0 1.2345678901235e+18
+ * 123.456e16 1234560000000000000.0 1.23456e+18
+ * 98765432101234567890987654321.0e-5 987654321012345728401408.0 9.8765432101235e+23
+ * 98765432101234567890987654321.0e-10 9876543210123456512.0 9.8765432101235e+18
+ * 0.00000000000000001234e20 1234.0
+ * 0.000000000000000000000000001234e30 1234.0
+ * 0.0000000000000000000000000000000000001234e40 1234.0
+ * 0.000000000012345678909876543210e15 12345.678909877
+ * 0e1000 0.0
+ */
-static int scheme_strcmp(s7_pointer s1, s7_pointer s2)
-{
- /* tricky here because str[i] must be treated as unsigned
- * (string<? (string (integer->char #xf0)) (string (integer->char #x70)))
- */
- int i, len, len1, len2;
- char *str1, *str2;
+ for (i = 0; i < max_len; i++)
+ {
+ dig = digits[(int)(*str++)];
+ if (dig < radix)
+ int_part = dig + (int_part * radix);
+ else break;
+ }
- len1 = string_length(s1);
- len2 = string_length(s2);
- if (len1 > len2)
- len = len2;
- else len = len1;
+ /* if the exponent is huge, check for 0 int_part and frac_part before complaining (0e1000 or 0.0e1000)
+ */
+ if ((int_part == 0) &&
+ (exponent > max_len))
+ {
+ /* if frac_part is also 0, return 0.0 */
+ if (frac_len == 0)
+ return(0.0);
- str1 = string_value(s1);
- str2 = string_value(s2);
+ str = fpart;
+ while ((dig = digits[(int)(*str++)]) < radix)
+ frac_part = dig + (frac_part * radix);
+ if (frac_part == 0)
+ return(0.0);
- for (i = 0; i < len; i++)
- if ((unsigned char)(str1[i]) < (unsigned char )(str2[i]))
- return(-1);
- else
- {
- if ((unsigned char)(str1[i]) > (unsigned char)(str2[i]))
- return(1);
- }
+#if WITH_GMP
+ (*overflow) = true;
+#endif
+ }
- if (len1 < len2)
- return(-1);
- if (len1 > len2)
- return(1);
- return(0);
-}
+#if WITH_GMP
+ (*overflow) = ((int_part > 0) || (exponent > 20)); /* .1e310 is a tricky case */
+#endif
+ if (int_part != 0) /* 0.<310 zeros here>1e310 for example --
+ * pow (via ipow) thinks it has to be too big, returns Nan,
+ * then Nan * 0 -> Nan and the NaN propogates
+ */
+ {
+ if (int_len <= max_len)
+ dval = int_part * ipow(radix, exponent);
+ else dval = int_part * ipow(radix, exponent + int_len - max_len);
+ }
+ else dval = 0.0;
-static s7_pointer g_string_cmp(s7_scheme *sc, s7_pointer args, int val, const char *name)
-{
- int i;
- s7_pointer x, y;
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_string(car(x)))
- return(s7_wrong_type_arg_error(sc, name, i, car(x), "a string"));
-
- y = car(args);
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
- {
- if (scheme_strcmp(y, car(x)) != val)
- return(sc->F);
- y = car(x);
- }
- return(sc->T);
-}
+ /* shift by exponent, but if int_len > max_len then we assumed (see below) int_len - max_len 0's on the left */
+ /* using int_to_int or table lookups here instead of pow did not make any difference in speed */
+ if (int_len < max_len)
+ {
+ int k, flen;
+ str = fpart;
-static s7_pointer g_string_cmp_not(s7_scheme *sc, s7_pointer args, int val, const char *name)
-{
- int i;
- s7_pointer x, y;
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_string(car(x)))
- return(s7_wrong_type_arg_error(sc, name, i, car(x), "a string"));
-
- y = car(args);
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
- {
- if (scheme_strcmp(y, car(x)) == val)
- return(sc->F);
- y = car(x);
- }
- return(sc->T);
-}
+ for (k = 0; (frac_len > 0) && (k < exponent); k += max_len)
+ {
+ if (frac_len > max_len) flen = max_len; else flen = frac_len;
+ frac_len -= max_len;
+ frac_part = 0;
+ for (i = 0; i < flen; i++)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
-static s7_pointer g_strings_are_equal(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_equal "(string=? str...) returns #t if all the string arguments are equal"
+ if (frac_part != 0) /* same pow->NaN problem as above can occur here */
+ dval += frac_part * ipow(radix, exponent - flen - k);
+ }
+ }
+ else
+ {
+ /* some of the fraction is in the integer part before the negative exponent shifts it over */
+ if (int_len > max_len)
+ {
+ int ilen;
+ /* str should be at the last digit we read */
+ ilen = int_len - max_len; /* we read these above */
+ if (ilen > max_len)
+ ilen = max_len;
- /* C-based check stops at null, but we can have embedded nulls. We can't
- * just look at string-length because we need to check past the nulls.
- * (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2))
- * hence scheme_strcmp above.
- */
- return(g_string_cmp(sc, args, 0, "string=?"));
-}
+ for (i = 0; i < ilen; i++)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ dval += frac_part * ipow(radix, exponent - ilen);
+ }
+ }
-static s7_pointer g_strings_are_less(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_less "(string<? str...) returns #t if all the string arguments are increasing"
- return(g_string_cmp(sc, args, -1, "string<?"));
-}
+ return(sign * dval);
+ }
+ /* int_len + exponent <= max_len */
-static s7_pointer g_strings_are_greater(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_greater "(string>? str...) returns #t if all the string arguments are decreasing"
- return(g_string_cmp(sc, args, 1, "string>?"));
-}
+ if (int_len <= max_len)
+ {
+ int int_exponent;
+ /* a better algorithm (since the inaccuracies are in the radix^exponent portion):
+ * strip off leading zeros and possible sign,
+ * strip off digits beyond max_len, then remove any trailing zeros.
+ * (maybe fiddle with the lowest order digit here for rounding, but I doubt it matters)
+ * read digits until end of number or max_len reached, ignoring the decimal point
+ * get exponent and use it and decimal point location to position the current result integer
+ * this always combines the same integer and the same exponent no matter how the number is expressed.
+ */
-static s7_pointer g_strings_are_geq(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_geq "(string>=? str...) returns #t if all the string arguments are equal or decreasing"
- return(g_string_cmp_not(sc, args, -1, "string>=?"));
-}
+ int_exponent = exponent;
+ if (int_len > 0)
+ {
+ char *iend;
+ iend = (char *)(str + int_len - 1);
+ while ((*iend == '0') && (iend != str)) {iend--; int_exponent++;}
+ while (str <= iend)
+ int_part = digits[(int)(*str++)] + (int_part * radix);
+ }
+ if (int_exponent != 0)
+ dval = int_part * ipow(radix, int_exponent);
+ else dval = (s7_double)int_part;
+ }
+ else
+ {
+ int len, flen;
+ long long int frpart = 0;
-static s7_pointer g_strings_are_leq(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_leq "(string<=? str...) returns #t if all the string arguments are equal or increasing"
- return(g_string_cmp_not(sc, args, 1, "string<=?"));
-}
+ /* 98765432101234567890987654321.0e-20 987654321.012346
+ * 98765432101234567890987654321.0e-29 0.98765432101235
+ * 98765432101234567890987654321.0e-30 0.098765432101235
+ * 98765432101234567890987654321.0e-28 9.8765432101235
+ */
+ len = int_len + exponent;
+ for (i = 0; i < len; i++)
+ int_part = digits[(int)(*str++)] + (int_part * radix);
-static int scheme_strcasecmp(s7_pointer s1, s7_pointer s2)
-{
- /* same as scheme_strcmp -- watch out for unwanted sign! */
- int i, len, len1, len2;
- char *str1, *str2;
+ flen = -exponent;
+ if (flen > max_len)
+ flen = max_len;
- len1 = string_length(s1);
- len2 = string_length(s2);
- if (len1 > len2)
- len = len2;
- else len = len1;
+ for (i = 0; i < flen; i++)
+ frpart = digits[(int)(*str++)] + (frpart * radix);
- str1 = string_value(s1);
- str2 = string_value(s2);
+ if (len <= 0)
+ dval = int_part + frpart * ipow(radix, len - flen);
+ else dval = int_part + frpart * ipow(radix, -flen);
+ }
- for (i = 0; i < len; i++)
- if (toupper((unsigned char)(str1[i])) < toupper((unsigned char)(str2[i])))
- return(-1);
- else
- {
- if (toupper((unsigned char)(str1[i])) > toupper((unsigned char)(str2[i])))
- return(1);
- }
-
- if (len1 < len2)
- return(-1);
- if (len1 > len2)
- return(1);
- return(0);
-}
-
-
-static s7_pointer g_string_ci_cmp(s7_scheme *sc, s7_pointer args, int val, const char *name)
-{
- int i;
- s7_pointer x, y;
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_string(car(x)))
- return(s7_wrong_type_arg_error(sc, name, i, car(x), "a string"));
-
- y = car(args);
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
- {
- if (scheme_strcasecmp(y, car(x)) != val)
- return(sc->F);
- y = car(x);
- }
- return(sc->T);
-}
-
-
-static s7_pointer g_string_ci_cmp_not(s7_scheme *sc, s7_pointer args, int val, const char *name)
-{
- int i;
- s7_pointer x, y;
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_string(car(x)))
- return(s7_wrong_type_arg_error(sc, name, i, car(x), "a string"));
-
- y = car(args);
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ if (frac_len > 0)
{
- if (scheme_strcasecmp(y, car(x)) == val)
- return(sc->F);
- y = car(x);
- }
- return(sc->T);
-}
+ str = fpart;
+ if (frac_len <= max_len)
+ {
+ /* splitting out base 10 case saves very little here */
+ /* this ignores trailing zeros, so that 0.3 equals 0.300 */
+ char *fend;
+ fend = (char *)(str + frac_len - 1);
+ while ((*fend == '0') && (fend != str)) {fend--; frac_len--;} /* (= .6 0.6000) */
-static s7_pointer g_strings_are_ci_equal(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_equal "(string-ci=? str...) returns #t if all the string arguments are equal, ignoring case"
- return(g_string_ci_cmp(sc, args, 0, "string-ci=?"));
-}
+ while (str <= fend)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ dval += frac_part * ipow(radix, exponent - frac_len);
+ /* fprintf(stderr, "frac: %lld, exp: (%d %d) %.20f, val: %.20f\n", frac_part, exponent, frac_len, ipow(radix, exponent - frac_len), dval);
+ * 0.6: frac: 6, exp: 0.10000000000000000555, val: 0.60000000000000008882
+ * 0.60: frac: 60, exp: 0.01000000000000000021, val: 0.59999999999999997780
+ * 0.6000: frac: 6000, exp: 0.00010000000000000000, val: 0.59999999999999997780
+ * :(= 0.6 0.60)
+ * #f
+ * :(= #i3/5 0.6)
+ * #f
+ * so (string->number (number->string num)) == num only if both num's are the same text (or you get lucky)
+ * :(= 0.6 6e-1) ; but not 60e-2
+ * #t
+ *
+ * to fix the 0.60 case, we need to ignore trailing post-dot zeros.
+ */
+ }
+ else
+ {
+ if (exponent <= 0)
+ {
+ for (i = 0; i < max_len; i++)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
-static s7_pointer g_strings_are_ci_less(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_less "(string-ci<? str...) returns #t if all the string arguments are increasing, ignoring case"
- return(g_string_ci_cmp(sc, args, -1, "string-ci<?"));
-}
+ dval += frac_part * ipow(radix, exponent - max_len);
+ }
+ else
+ {
+ /* 1.0123456789876543210e1 10.12345678987654373771
+ * 1.0123456789876543210e10 10123456789.87654304504394531250
+ * 0.000000010000000000000000e10 100.0
+ * 0.000000010000000000000000000000000000000000000e10 100.0
+ * 0.000000012222222222222222222222222222222222222e10 122.22222222222222
+ * 0.000000012222222222222222222222222222222222222e17 1222222222.222222
+ */
+ int_part = 0;
+ for (i = 0; i < exponent; i++)
+ int_part = digits[(int)(*str++)] + (int_part * radix);
-static s7_pointer g_strings_are_ci_greater(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_greater "(string-ci>? str...) returns #t if all the string arguments are decreasing, ignoring case"
- return(g_string_ci_cmp(sc, args, 1, "string-ci>?"));
-}
+ frac_len -= exponent;
+ if (frac_len > max_len)
+ frac_len = max_len;
+ for (i = 0; i < frac_len; i++)
+ frac_part = digits[(int)(*str++)] + (frac_part * radix);
-static s7_pointer g_strings_are_ci_geq(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_geq "(string-ci>=? str...) returns #t if all the string arguments are equal or decreasing, ignoring case"
- return(g_string_ci_cmp_not(sc, args, -1, "string-ci>=?"));
-}
+ dval += int_part + frac_part * ipow(radix, -frac_len);
+ }
+ }
+ }
+#if WITH_GMP
+ if ((int_part == 0) &&
+ (frac_part == 0))
+ return(0.0);
+ (*overflow) = ((frac_len - exponent) > max_len);
+#endif
-static s7_pointer g_strings_are_ci_leq(s7_scheme *sc, s7_pointer args)
-{
- #define H_strings_are_ci_leq "(string-ci<=? str...) returns #t if all the string arguments are equal or increasing, ignoring case"
- return(g_string_ci_cmp_not(sc, args, 1, "string-ci<=?"));
-}
+ return(sign * dval);
+}
-static s7_pointer g_string_fill(s7_scheme *sc, s7_pointer args)
+static s7_pointer make_atom(s7_scheme *sc, char *q, int radix, bool want_symbol, bool with_error)
{
- #define H_string_fill "(string-fill! str chr) fills the string str with the character chr"
- s7_pointer x;
- x = car(args);
+ /* make symbol or number from string */
+ #define IS_DIGIT(Chr, Rad) (digits[(unsigned char)Chr] < Rad)
- if (!s7_is_string(x))
- return(s7_wrong_type_arg_error(sc, "string-fill!", 1, x, "a string"));
- if (!s7_is_character(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "string-fill! filler,", 2, cadr(args), "a character"));
+ char c, *p;
+ bool has_dec_point1 = false;
- /* strlen and so on here is probably not right -- a scheme string has a length
- * set when it is created, and (apparently) can contain an embedded 0, so its
- * print length is not its length.
- * char *str; char c; str = string_value(car(args)); c = character(cadr(args));
- * int i, len = 0; if (str) len = safe_strlen(str); if (len > 0) for (i = 0; i < len; i++) str[i] = c;
- */
- if (string_length(x) > 0)
- memset((void *)(string_value(x)), (int)character(cadr(args)), string_length(x));
- return(cadr(args));
-}
+ p = q;
+ c = *p++;
+ /* a number starts with + - . or digit, but so does 1+ for example */
-static s7_pointer g_string_1(s7_scheme *sc, s7_pointer args, const char *name)
-{
- int i, len;
- s7_pointer x, newstr;
-
- /* get length for new string and check arg types */
- for (len = 0, x = args; x != sc->NIL; len++, x = cdr(x))
- if (!s7_is_character(car(x)))
- return(s7_wrong_type_arg_error(sc, name, len + 1, car(x), "a character"));
-
- newstr = make_empty_string(sc, len, 0);
- for (i = 0, x = args; x != sc->NIL; i++, x = cdr(x))
- string_value(newstr)[i] = character(car(x));
-
- return(newstr);
-}
+ switch (c)
+ {
+ case '#':
+ return(make_sharp_constant(sc, p, UNNESTED_SHARP, radix, with_error)); /* make_sharp_constant expects the '#' to be removed */
+ case '+':
+ case '-':
+ c = *p++;
+ if (c == '.')
+ {
+ has_dec_point1 = true;
+ c = *p++;
+ }
+ if ((!c) || (!IS_DIGIT(c, radix)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ break;
-static s7_pointer g_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_string "(string chr...) appends all its character arguments into one string"
- if (args == sc->NIL) /* (string) but not (string '()) */
- return(s7_make_string_with_length(sc, "", 0));
- return(g_string_1(sc, args, "string"));
-}
+ case '.':
+ has_dec_point1 = true;
+ c = *p++;
+ if ((!c) || (!IS_DIGIT(c, radix)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ break;
-static s7_pointer g_list_to_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_list_to_string "(list->string lst) appends all the list's characters into one string; (apply string lst)"
- if (car(args) == sc->NIL)
- return(s7_make_string_with_length(sc, "", 0));
-
- if (!is_proper_list(sc, car(args)))
- return(s7_wrong_type_arg_error(sc, "list->string", 0, car(args), "a (proper, non-circular) list of characters"));
-
- return(g_string_1(sc, car(args), "list->string"));
-}
+ case '0': /* these two are always digits */
+ case '1':
+ break;
+ default:
+ if (!IS_DIGIT(c, radix))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ break;
+ }
-static s7_pointer s7_string_to_list(s7_scheme *sc, const char *str, int len)
-{
- int i;
- s7_pointer p;
+ /* now it's possibly a number -- the first character(s) could be part of a number in the current radix */
+ {
+ char *slash1 = NULL, *slash2 = NULL, *plus = NULL, *ex1 = NULL, *ex2 = NULL;
+ bool has_i = false, has_dec_point2 = false;
+ int has_plus_or_minus = 0, current_radix;
- if (len == 0)
- return(sc->NIL);
+#if (!WITH_GMP)
+ bool overflow = false;
+#endif
+ current_radix = radix; /* current_radix is 10 for the exponent portions, but radix for all the rest */
- sc->w = sc->NIL;
- for (i = 0; i < len; i++)
- sc->w = s7_cons(sc, s7_make_character(sc, ((unsigned char)str[i])), sc->w);
- p = sc->w;
- sc->w = sc->NIL;
+ for ( ; (c = *p) != 0; ++p)
+ {
+ /* what about embedded null? (string->number (string #\1 (integer->char 0) #\0))
+ * currently we stop and return 1, but Guile returns #f
+ */
+ if (!IS_DIGIT(c, current_radix)) /* moving this inside the switch statement was much slower */
+ {
+ current_radix = radix;
- return(safe_reverse_in_place(sc, p));
-}
+ switch (c)
+ {
+ /* -------- decimal point -------- */
+ case '.':
+ if ((!IS_DIGIT(p[1], current_radix)) &&
+ (!IS_DIGIT(p[-1], current_radix)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ if (has_plus_or_minus == 0)
+ {
+ if ((has_dec_point1) || (slash1))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ has_dec_point1 = true;
+ }
+ else
+ {
+ if ((has_dec_point2) || (slash2))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ has_dec_point2 = true;
+ }
+ continue;
-static s7_pointer g_string_to_list(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_to_list "(string->list str) returns the elements of the string str in a list; (map values str)"
- s7_pointer str;
- str = car(args);
- if (!s7_is_string(str))
- return(s7_wrong_type_arg_error(sc, "string->list", 0, str, "a string"));
+ /* -------- exponent marker -------- */
+ case 'e': case 'E':
+#if WITH_EXTRA_EXPONENT_MARKERS
+ case 's': case 'S':
+ case 'd': case 'D':
+ case 'f': case 'F':
+ case 'l': case 'L':
+#endif
+ if (current_radix > 10)
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ /* see note above */
+ /* fall through -- if '@' used, radices>10 are ok */
- return(s7_string_to_list(sc, string_value(str), string_length(str)));
-}
+ case '@':
+ current_radix = 10;
+ if (((ex1) ||
+ (slash1)) &&
+ (has_plus_or_minus == 0)) /* ee */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ if (((ex2) ||
+ (slash2)) &&
+ (has_plus_or_minus != 0)) /* 1+1.0ee */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ if ((!IS_DIGIT(p[-1], radix)) && /* was current_radix but that's always 10! */
+ (p[-1] != '.'))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-/* -------------------------------- ports --------------------------------
- *
- * originally nil served as stdin and friends, but that made it impossible to catch an error
- * like (read-line (current-output-port)) when the latter was stdout. So we now have
- * the built-in constant ports *stdin*, *stdout*, and *stderr*. Some way is needed to
- * refer to these directly so that (read-line *stdin*) for example can insist on reading
- * from the terminal, or whatever stdin is.
- */
+ if (has_plus_or_minus == 0)
+ {
+ ex1 = p;
+ has_dec_point1 = true; /* decimal point illegal from now on */
+ }
+ else
+ {
+ ex2 = p;
+ has_dec_point2 = true;
+ }
+ p++;
+ if ((*p == '-') || (*p == '+')) p++;
+ if (IS_DIGIT(*p, current_radix))
+ continue;
+ break;
-static char *describe_port(s7_scheme *sc, s7_pointer p)
-{
- char *desc;
- if ((p == sc->standard_input) || (p == sc->standard_output) || (p == sc->standard_error))
- return(copy_string(port_filename(p)));
- desc = (char *)malloc(64 * sizeof(char));
- snprintf(desc, 64, "<port%s%s%s>",
- (is_file_port(p)) ? " file" : ((is_string_port(p)) ? " string" : " function"),
- (is_input_port(p)) ? " input" : " output",
- (port_is_closed(p)) ? " (closed)" : "");
- return(desc);
-}
+ /* -------- internal + or - -------- */
+ case '+':
+ case '-':
+ if (has_plus_or_minus != 0) /* already have the separator */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ if (c == '+') has_plus_or_minus = 1; else has_plus_or_minus = -1;
+ plus = (char *)(p + 1);
+ continue;
-static s7_pointer g_is_port_closed(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_port_closed "(port-closed? p) returns #t if the port p is closed."
- s7_pointer x;
+ /* ratio marker */
+ case '/':
+ if ((has_plus_or_minus == 0) &&
+ ((ex1) ||
+ (slash1) ||
+ (has_dec_point1)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
- x = car(args);
- if ((is_input_port(x)) || (is_output_port(x)))
- return(make_boolean(sc, port_is_closed(x)));
+ if ((has_plus_or_minus != 0) &&
+ ((ex2) ||
+ (slash2) ||
+ (has_dec_point2)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
- return(s7_wrong_type_arg_error(sc, "port-closed?", 0, x, "a port"));
-}
+ if (has_plus_or_minus == 0)
+ slash1 = (char *)(p + 1);
+ else slash2 = (char *)(p + 1);
+ if ((!IS_DIGIT(p[1], current_radix)) ||
+ (!IS_DIGIT(p[-1], current_radix)))
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-static s7_pointer g_port_line_number(s7_scheme *sc, s7_pointer args)
-{
- #define H_port_line_number "(port-line-number input-file-port) returns the current read line number of port"
- s7_pointer x;
+ continue;
- if (args == sc->NIL)
- x = sc->input_port;
- else x = car(args);
- if ((!(is_input_port(x))) ||
- (port_is_closed(x)))
- return(s7_wrong_type_arg_error(sc, "port-line-number", 0, x, "an open input port"));
+ /* -------- i for the imaginary part -------- */
+ case 'i':
+ if ((has_plus_or_minus != 0) &&
+ (!has_i))
+ {
+ has_i = true;
+ continue;
+ }
+ break;
- return(s7_make_integer(sc, port_line_number(x)));
-}
+ default:
+ break;
+ }
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
+ }
+ }
+ if ((has_plus_or_minus != 0) && /* that is, we have an internal + or - */
+ (!has_i)) /* but no i for the imaginary part */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-const char *s7_port_filename(s7_pointer x)
-{
- if (((is_input_port(x)) ||
- (is_output_port(x))) &&
- (!port_is_closed(x)))
- return(port_filename(x));
- return(NULL);
-}
+ if (has_i)
+ {
+#if (!WITH_GMP)
+ s7_double rl = 0.0, im = 0.0;
+#else
+ char e1 = 0, e2 = 0;
+#endif
+ s7_pointer result;
+ int len;
+ char ql1, pl1;
+ len = safe_strlen(q);
-static s7_pointer g_port_filename(s7_scheme *sc, s7_pointer args)
-{
- #define H_port_filename "(port-filename file-port) returns the filename associated with port"
- s7_pointer x;
+ if (q[len - 1] != 'i')
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
- if (args == sc->NIL)
- x = sc->input_port;
- else x = car(args);
+ /* save original string */
+ ql1 = q[len - 1];
+ pl1 = (*(plus - 1));
+#if WITH_GMP
+ if (ex1) {e1 = *ex1; (*ex1) = '@';} /* for mpfr */
+ if (ex2) {e2 = *ex2; (*ex2) = '@';}
+#endif
- if (((is_input_port(x)) ||
- (is_output_port(x))) &&
- (!port_is_closed(x)))
- {
- if (port_filename(x))
- return(make_protected_string(sc, port_filename(x)));
- return(s7_make_string_with_length(sc, "", 0));
- /* otherwise (eval-string (port-filename)) and (string->symbol (port-filename)) segfault */
- }
+ /* look for cases like 1+i */
+ if ((q[len - 2] == '+') || (q[len - 2] == '-'))
+ q[len - 1] = '1';
+ else q[len - 1] = '\0'; /* remove 'i' */
- return(s7_wrong_type_arg_error(sc, "port-filename", 0, x, "an open port"));
-}
+ (*((char *)(plus - 1))) = '\0';
+ /* there is a slight inconsistency here:
+ 1/0 -> nan.0
+ 1/0+0i -> inf.0 (0/1+0i is 0.0)
+ #i1/0+0i -> inf.0
+ 0/0 -> nan.0
+ 0/0+0i -> -nan.0
+ */
-bool s7_is_input_port(s7_scheme *sc, s7_pointer p)
-{
- return(is_input_port(p));
-}
+#if (!WITH_GMP)
+ if ((has_dec_point1) ||
+ (ex1))
+ {
+ /* (string->number "1100.1+0.11i" 2) -- need to split into 2 honest reals before passing to non-base-10 str->dbl */
+ rl = string_to_double_with_radix(q, radix, &overflow);
+ }
+ else
+ {
+ if (slash1)
+ {
+ /* here the overflow could be innocuous if it's in the denominator and the numerator is 0
+ * 0/100000000000000000000000000000000000000-0i
+ */
+ s7_int num, den;
+ num = string_to_integer(q, radix, &overflow);
+ den = string_to_integer(slash1, radix, &overflow);
+ if (den == 0)
+ rl = NAN;
+ else
+ {
+ if (num == 0)
+ {
+ rl = 0.0;
+ overflow = false;
+ }
+ else rl = (s7_double)num / (s7_double)den;
+ }
+ }
+ else rl = (s7_double)string_to_integer(q, radix, &overflow);
+ if (overflow) return(real_NaN);
+ }
+ if (rl == -0.0) rl = 0.0;
+ if ((has_dec_point2) ||
+ (ex2))
+ im = string_to_double_with_radix(plus, radix, &overflow);
+ else
+ {
+ if (slash2)
+ {
+ /* same as above: 0-0/100000000000000000000000000000000000000i
+ */
+ s7_int num, den;
+ num = string_to_integer(plus, radix, &overflow);
+ den = string_to_integer(slash2, radix, &overflow);
+ if (den == 0)
+ im = NAN;
+ else
+ {
+ if (num == 0)
+ {
+ im = 0.0;
+ overflow = false;
+ }
+ else im = (s7_double)num / (s7_double)den;
+ }
+ }
+ else im = (s7_double)string_to_integer(plus, radix, &overflow);
+ if (overflow) return(real_NaN);
+ }
+ if ((has_plus_or_minus == -1) &&
+ (im != 0.0))
+ im = -im;
+ result = s7_make_complex(sc, rl, im);
+#else
+ result = string_to_either_complex(sc, q, slash1, ex1, has_dec_point1, plus, slash2, ex2, has_dec_point2, radix, has_plus_or_minus);
+#endif
-static s7_pointer g_is_input_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_input_port "(input-port? p) returns #t if p is an input port"
- return(make_boolean(sc, is_input_port(car(args))));
-}
+ /* restore original string */
+ q[len - 1] = ql1;
+ (*((char *)(plus - 1))) = pl1;
+#if WITH_GMP
+ if (ex1) (*ex1) = e1;
+ if (ex2) (*ex2) = e2;
+#endif
+ return(result);
+ }
-bool s7_is_output_port(s7_scheme *sc, s7_pointer p)
-{
- return(is_output_port(p));
-}
+ /* not complex */
+ if ((has_dec_point1) ||
+ (ex1))
+ {
+ s7_pointer result;
+ if (slash1) /* not complex, so slash and "." is not a number */
+ return((want_symbol) ? make_symbol(sc, q) : sc->F);
-static s7_pointer g_is_output_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_output_port "(output-port? p) returns #t if p is an output port"
- return(make_boolean(sc, is_output_port(car(args))));
-}
+#if (!WITH_GMP)
+ result = make_real(sc, string_to_double_with_radix(q, radix, &overflow));
+#else
+ {
+ char old_e = 0;
+ if (ex1)
+ {
+ old_e = (*ex1);
+ (*ex1) = '@';
+ }
+ result = string_to_either_real(sc, q, radix);
+ if (ex1)
+ (*ex1) = old_e;
+ }
+#endif
+ return(result);
+ }
+ /* not real */
+ if (slash1)
+#if (!WITH_GMP)
+ {
+ s7_int n, d;
-s7_pointer s7_current_input_port(s7_scheme *sc)
-{
- return(sc->input_port);
-}
+ n = string_to_integer(q, radix, &overflow);
+ d = string_to_integer(slash1, radix, &overflow);
+ if ((n == 0) && (d != 0)) /* 0/100000000000000000000000000000000000000 */
+ return(small_int(0));
+ if ((d == 0) || (overflow))
+ return(real_NaN);
+ /* it would be neat to return 1 from 10000000000000000000000000000/10000000000000000000000000000
+ * but q is the entire number ('/' included) and slash1 is the stuff after the '/', and every
+ * big number comes through here, so there's no clean and safe way to check that q == slash1.
+ */
+ return(s7_make_ratio(sc, n, d));
+ }
+#else
+ return(string_to_either_ratio(sc, q, slash1, radix));
+#endif
-static s7_pointer g_current_input_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_current_input_port "(current-input-port) returns the current input port"
- return(sc->input_port);
+ /* integer */
+#if (!WITH_GMP)
+ {
+ s7_int x;
+ x = string_to_integer(q, radix, &overflow);
+ if (overflow)
+ return((q[0] == '-') ? real_minus_infinity : real_infinity);
+ return(make_integer(sc, x));
+ }
+#else
+ return(string_to_either_integer(sc, q, radix));
+#endif
+ }
}
-static s7_pointer g_set_current_input_port(s7_scheme *sc, s7_pointer args)
+static s7_pointer s7_string_to_number(s7_scheme *sc, char *str, int radix)
{
- #define H_set_current_input_port "(set-current-input-port port) sets the current-input port to port and returns the previous value of the input port"
- s7_pointer old_port, port;
-
- old_port = sc->input_port;
- port = car(args);
- if ((is_input_port(port)) &&
- (!port_is_closed(port)))
- sc->input_port = port;
- else return(s7_wrong_type_arg_error(sc, "set-current-input-port", 0, port, "an open input port"));
- sc->input_is_file = (is_file_port(sc->input_port));
-
- return(old_port);
+ s7_pointer x;
+ x = make_atom(sc, str, radix, NO_SYMBOLS, WITHOUT_OVERFLOW_ERROR);
+ if (s7_is_number(x)) /* only needed because str might start with '#' and not be a number (#t for example) */
+ return(x);
+ return(sc->F);
}
-s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer port)
+static s7_pointer g_string_to_number_1(s7_scheme *sc, s7_pointer args, s7_pointer caller)
{
- s7_pointer old_port;
- old_port = sc->input_port;
- sc->input_port = port;
- sc->input_is_file = (is_file_port(sc->input_port));
- return(old_port);
-}
-
+ #define H_string_to_number "(string->number str (radix 10)) converts str into a number. \
+If str does not represent a number, string->number returns #f. If 'str' has an embedded radix, \
+the 'radix' it is ignored: (string->number \"#x11\" 2) -> 17 not 3."
+ #define Q_string_to_number s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->IS_NUMBER, sc->IS_BOOLEAN), sc->IS_STRING, sc->IS_INTEGER)
-s7_pointer s7_current_output_port(s7_scheme *sc)
-{
- return(sc->output_port);
-}
+ s7_int radix = 0;
+ char *str;
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), caller, args, T_STRING, 1);
-s7_pointer s7_set_current_output_port(s7_scheme *sc, s7_pointer port)
-{
- s7_pointer old_port;
- old_port = sc->output_port;
- sc->output_port = port;
- return(old_port);
-}
-
+ if (is_pair(cdr(args)))
+ {
+ s7_pointer rad, p;
+ rad = cadr(args);
+ if (!s7_is_integer(rad))
+ {
+ if (!s7_is_integer(p = check_values(sc, rad, cdr(args))))
+ method_or_bust(sc, rad, caller, args, T_INTEGER, 2);
+ rad = p;
+ }
+ radix = s7_integer(rad);
+ if ((radix < 2) || /* what about negative int as base (Knuth), reals such as phi, and some complex like -1+i */
+ (radix > 16)) /* the only problem here is printing the number; perhaps put each digit in "()" in base 10: (123)(0)(34) */
+ return(out_of_range(sc, caller, small_int(2), rad, A_VALID_RADIX));
+ }
+ else radix = 10;
-static s7_pointer g_current_output_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_current_output_port "(current-output-port) returns the current output port"
- return(sc->output_port);
-}
+ str = (char *)string_value(car(args));
+ if ((!str) || (!(*str)))
+ return(sc->F);
+ switch (str[0])
+ {
+ case 'n':
+ if (safe_strcmp(str, "nan.0"))
+ return(real_NaN);
+ break;
-static s7_pointer g_set_current_output_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_set_current_output_port "(set-current-output-port port) sets the current-output port to port and returns the previous value of the output port"
- s7_pointer old_port, port;
+ case 'i':
+ if (safe_strcmp(str, "inf.0"))
+ return(real_infinity);
+ break;
- old_port = sc->output_port;
- port = car(args);
- if ((is_output_port(port)) &&
- (!port_is_closed(port)))
- sc->output_port = port;
- else return(s7_wrong_type_arg_error(sc, "set-current-output-port", 0, port, "an open output port"));
+ case '-':
+ if ((str[1] == 'i') && (safe_strcmp((const char *)(str + 1), "inf.0")))
+ return(real_minus_infinity);
+ break;
- return(old_port);
+ case '+':
+ if ((str[1] == 'i') && (safe_strcmp((const char *)(str + 1), "inf.0")))
+ return(real_infinity);
+ break;
+ }
+ return(s7_string_to_number(sc, str, radix));
}
-s7_pointer s7_current_error_port(s7_scheme *sc)
+static s7_pointer g_string_to_number(s7_scheme *sc, s7_pointer args)
{
- return(sc->error_port);
+ return(g_string_to_number_1(sc, args, sc->STRING_TO_NUMBER));
}
-
-s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port)
+static s7_pointer c_string_to_number(s7_scheme *sc, s7_pointer n)
{
- s7_pointer old_port;
- old_port = sc->error_port;
- sc->error_port = port;
- return(old_port);
+ return(g_string_to_number_1(sc, set_plist_1(sc, n), sc->STRING_TO_NUMBER));
}
-
-static s7_pointer g_current_error_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_current_error_port "(current-error-port) returns the current error port"
- return(sc->error_port);
-}
+PF_TO_PF(string_to_number, c_string_to_number)
-static s7_pointer g_set_current_error_port(s7_scheme *sc, s7_pointer args)
+static bool numbers_are_eqv(s7_pointer a, s7_pointer b)
{
- #define H_set_current_error_port "(set-current-error-port port) sets the current-error port to port and returns the previous value of the error port"
- s7_pointer old_port, port;
+ if (type(a) != type(b)) /* (eqv? 1 1.0) -> #f! */
+ return(false);
- old_port = sc->error_port;
- port = car(args);
- if ((is_output_port(port)) &&
- (!port_is_closed(port)))
- sc->error_port = port;
- else return(s7_wrong_type_arg_error(sc, "set-current-error-port", 0, port, "an open output port"));
+ switch (type(a))
+ {
+ case T_INTEGER:
+ return((integer(a) == integer(b)));
- return(old_port);
-}
+ case T_RATIO:
+ return((numerator(a) == numerator(b)) &&
+ (denominator(a) == denominator(b)));
+ case T_REAL:
+ if (is_NaN(real(a)))
+ return(false);
+ return(real(a) == real(b));
-static s7_pointer g_is_char_ready(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_char_ready "(char-ready? (port (current-input-port))) returns #t if a character is ready for input on the given port"
- if (args != sc->NIL)
- {
- s7_pointer pt = car(args);
- if (!is_input_port(pt))
- return(s7_wrong_type_arg_error(sc, "char-ready?", 0, pt, "an input port"));
- if (port_is_closed(pt))
- return(s7_wrong_type_arg_error(sc, "char-ready?", 0, pt, "an open input port"));
+ case T_COMPLEX:
+ if ((is_NaN(real_part(a))) ||
+ (is_NaN(imag_part(a))))
+ return(false);
+ return((real_part(a) == real_part(b)) &&
+ (imag_part(a) == imag_part(b)));
- if (is_function_port(pt))
- return((*(port_input_function(pt)))(sc, S7_IS_CHAR_READY, pt));
- return(make_boolean(sc, is_string_port(pt)));
+ default:
+#if WITH_GMP
+ if ((is_big_number(a)) || (is_big_number(b))) /* this can happen if (member bignum ...) -> memv */
+ return(big_numbers_are_eqv(a, b));
+#endif
+ break;
}
- return(make_boolean(sc, (is_input_port(sc->input_port)) && (is_string_port(sc->input_port))));
-}
-
-
-static s7_pointer g_is_eof_object(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_eof_object "(eof-object? val) returns #t if val is the end-of-file object"
- return(make_boolean(sc, car(args) == sc->EOF_OBJECT));
+ return(false);
}
-void s7_close_input_port(s7_scheme *sc, s7_pointer p)
+static bool is_rational_via_method(s7_scheme *sc, s7_pointer p)
{
- if ((is_immutable(p)) ||
- ((is_input_port(p)) && (port_is_closed(p))))
- return;
-
- if (port_filename(p))
- {
- free(port_filename(p));
- port_filename(p) = NULL;
- }
-
- if ((is_file_port(p)) &&
- (port_file(p)))
- {
- fclose(port_file(p));
- port_file(p) = NULL;
- }
-
- if (port_needs_free(p))
+ if (s7_is_rational(p))
+ return(true);
+ if (has_methods(p))
{
- if (port_string(p))
- {
- free(port_string(p));
- port_string(p) = NULL;
- }
- port_needs_free(p) = false;
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->IS_RATIONAL);
+ if (f != sc->UNDEFINED)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL))));
}
-
- /* if input string, someone else is dealing with GC */
- port_is_closed(p) = true;
+ return(false);
}
-static s7_pointer g_close_input_port(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- abs -------------------------------- */
+#if (!WITH_GMP)
+static s7_pointer g_abs(s7_scheme *sc, s7_pointer args)
{
- #define H_close_input_port "(close-input-port port) closes the port"
- s7_pointer pt;
- pt = car(args);
- if (!is_input_port(pt))
- return(s7_wrong_type_arg_error(sc, "close-input-port", 0, pt, "an input port"));
- if (!is_immutable(pt))
- s7_close_input_port(sc, pt);
- return(sc->UNSPECIFIED);
-}
-
+ #define H_abs "(abs x) returns the absolute value of the real number x"
+ #define Q_abs s7_make_signature(sc, 2, sc->IS_REAL, sc->IS_REAL)
-void s7_close_output_port(s7_scheme *sc, s7_pointer p)
-{
- if ((is_immutable(p)) ||
- ((is_output_port(p)) && (port_is_closed(p))))
- return;
-
- if (port_filename(p))
- {
- free(port_filename(p));
- port_filename(p) = NULL;
- }
-
- if (is_file_port(p))
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
{
- if (port_file(p))
+ case T_INTEGER:
+ if (integer(x) < 0)
{
- fflush(port_file(p));
- fclose(port_file(p));
- port_file(p) = NULL;
+ if (integer(x) == s7_int_min)
+ return(make_integer(sc, s7_int_max));
+ return(make_integer(sc, -integer(x)));
}
- }
- else
- {
- if ((is_string_port(p)) && (port_string(p)))
+ return(x);
+
+ case T_RATIO:
+ if (numerator(x) < 0)
{
- free(port_string(p));
- port_string(p) = NULL;
- port_needs_free(p) = false;
+ if (numerator(x) == s7_int_min)
+ return(s7_make_ratio(sc, s7_int_max, denominator(x)));
+ return(s7_make_ratio(sc, -numerator(x), denominator(x)));
}
+ return(x);
+
+ case T_REAL:
+ if (is_NaN(real(x))) /* (abs -nan.0) -> nan.0, not -nan.0 */
+ return(real_NaN);
+ if (real(x) < 0.0)
+ return(make_real(sc, -real(x)));
+ return(x);
+
+ default:
+ method_or_bust(sc, x, sc->ABS, args, T_REAL, 0);
}
- port_is_closed(p) = true;
}
+static s7_int c_abs_i(s7_scheme *sc, s7_int arg) {return((arg < 0) ? (-arg) : arg);}
+IF_TO_IF(abs, c_abs_i)
-static s7_pointer g_close_output_port(s7_scheme *sc, s7_pointer args)
-{
- #define H_close_output_port "(close-output-port port) closes the port"
- s7_pointer pt;
- pt = car(args);
- if (!is_output_port(pt))
- return(s7_wrong_type_arg_error(sc, "close-output-port", 0, pt, "an output port"));
- if (!(is_immutable(pt)))
- s7_close_output_port(sc, pt);
- return(sc->UNSPECIFIED);
-}
+static s7_double c_abs_r(s7_scheme *sc, s7_double arg) {return((arg < 0.0) ? (-arg) : arg);}
+DIRECT_RF_TO_RF(fabs)
-static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, long max_size, const char *caller)
-{
- s7_pointer port;
- long size;
- int port_loc;
- char *content = NULL;
+/* -------------------------------- magnitude -------------------------------- */
- NEW_CELL(sc, port);
- set_type(port, T_INPUT_PORT | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
- port_loc = s7_gc_protect(sc, port);
- port->object.port = (s7_port_t *)calloc(1, sizeof(s7_port_t));
- port_is_closed(port) = false;
+static s7_pointer g_magnitude(s7_scheme *sc, s7_pointer args)
+{
+ #define H_magnitude "(magnitude z) returns the magnitude of z"
+ #define Q_magnitude s7_make_signature(sc, 2, sc->IS_REAL, sc->IS_NUMBER)
+ s7_pointer x;
+ x = car(args);
- /* if we're constantly opening files, and each open saves the file name in permanent
- * memory, we gradually core-up.
- */
- port_filename(port) = copy_string(name);
- port_line_number(port) = 1; /* 1st line is numbered 1 */
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == s7_int_min)
+ return(make_integer(sc, s7_int_max));
+ /* (magnitude -9223372036854775808) -> -9223372036854775808
+ * same thing happens in abs, lcm and gcd: (gcd -9223372036854775808) -> -9223372036854775808
+ */
+ if (integer(x) < 0)
+ return(make_integer(sc, -integer(x)));
+ return(x);
- fseek(fp, 0, SEEK_END);
- size = ftell(fp);
- rewind(fp);
+ case T_RATIO:
+ if (numerator(x) < 0)
+ return(s7_make_ratio(sc, -numerator(x), denominator(x)));
+ return(x);
- /* pseudo files (under /proc for example) have size=0, but we can read them, so don't assume a 0 length file is empty */
+ case T_REAL:
+ if (is_NaN(real(x))) /* (magnitude -nan.0) -> nan.0, not -nan.0 */
+ return(real_NaN);
+ if (real(x) < 0.0)
+ return(make_real(sc, -real(x)));
+ return(x);
- if ((size != 0) &&
- ((max_size < 0) || (size < max_size)))
- {
- size_t bytes;
- content = (char *)malloc((size + 2) * sizeof(char));
- bytes = fread(content, sizeof(char), size, fp);
- if (bytes != (size_t)size)
- {
- char tmp[256];
- snprintf(tmp, 256, "(%s \"%s\") read %ld bytes of an expected %ld?", caller, name, (long)bytes, size);
- write_string(sc, tmp, sc->output_port);
- }
- content[size] = '\0';
- content[size + 1] = '\0';
- fclose(fp);
+ case T_COMPLEX:
+ return(make_real(sc, hypot(imag_part(x), real_part(x))));
- port_type(port) = STRING_PORT;
- port_string(port) = content;
- port_string_length(port) = size;
- port_string_point(port) = 0;
- port_needs_free(port) = true;
- }
- else
- {
- port_file(port) = fp;
- port_type(port) = FILE_PORT;
- port_needs_free(port) = false;
+ default:
+ method_or_bust_with_type(sc, x, sc->MAGNITUDE, args, A_NUMBER, 0);
}
-
- s7_gc_unprotect_at(sc, port_loc);
- return(port);
}
+IF_TO_IF(magnitude, c_abs_i)
+RF_TO_RF(magnitude, c_abs_r)
-static s7_pointer make_input_file(s7_scheme *sc, const char *name, FILE *fp)
-{
- #define MAX_SIZE_FOR_STRING_PORT 1000000
- return(read_file(sc, fp, name, MAX_SIZE_FOR_STRING_PORT, "open"));
-}
-static s7_pointer open_input_file_1(s7_scheme *sc, const char *name, const char *mode, const char *caller)
+/* -------------------------------- rationalize -------------------------------- */
+static s7_pointer g_rationalize(s7_scheme *sc, s7_pointer args)
{
- FILE *fp;
- /* see if we can open this file before allocating a port */
+ #define H_rationalize "(rationalize x err) returns the ratio with lowest denominator within err of x"
+ #define Q_rationalize s7_make_signature(sc, 3, sc->IS_RATIONAL, sc->IS_REAL, sc->IS_REAL)
+ s7_double err;
+ s7_pointer x;
- errno = 0;
- fp = fopen(name, mode);
- if (!fp)
+ x = car(args);
+ if (!s7_is_real(x))
+ method_or_bust(sc, x, sc->RATIONALIZE, args, T_REAL, 1);
+
+ if (is_not_null(cdr(args)))
{
-#ifndef _MSC_VER
- if (errno == EINVAL)
- return(file_error(sc, caller, "invalid mode", mode));
-#endif
- return(file_error(sc, caller, strerror(errno), name));
+ s7_pointer ex;
+ ex = cadr(args);
+ if (!s7_is_real(ex))
+ method_or_bust(sc, ex, sc->RATIONALIZE, args, T_REAL, 2);
+
+ err = real_to_double(sc, ex, "rationalize");
+ if (is_NaN(err))
+ return(out_of_range(sc, sc->RATIONALIZE, small_int(2), cadr(args), ITS_NAN));
+ if (err < 0.0) err = -err;
}
+ else err = sc->default_rationalize_error;
- return(make_input_file(sc, name, fp));
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ {
+ s7_int a, b, pa;
+ if (err < 1.0) return(x);
+ a = s7_integer(x);
+ if (a < 0) pa = -a; else pa = a;
+ if (err >= pa) return(small_int(0));
+ b = (s7_int)err;
+ pa -= b;
+ if (a < 0)
+ return(make_integer(sc, -pa));
+ return(make_integer(sc, pa));
+ }
+ case T_RATIO:
+ if (err == 0.0)
+ return(x);
-s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode)
-{
- return(open_input_file_1(sc, name, mode, "open-input-file"));
-}
+ case T_REAL:
+ {
+ s7_double rat;
+ s7_int numer = 0, denom = 1;
+ rat = real_to_double(sc, x, "rationalize");
-static s7_pointer g_open_input_file(s7_scheme *sc, s7_pointer args)
-{
- #define H_open_input_file "(open-input-file filename (mode \"r\")) opens filename for reading"
- s7_pointer name = car(args);
+ if ((is_NaN(rat)) || (is_inf(rat)))
+ return(wrong_type_argument_with_type(sc, sc->RATIONALIZE, 1, x, A_NORMAL_REAL));
- if (!s7_is_string(name))
- return(s7_wrong_type_arg_error(sc, "open-input-file filename,", (cdr(args) == sc->NIL) ? 0 : 1, name, "a string"));
-
- if (is_pair(cdr(args)))
- {
- if (!s7_is_string(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "open-input-file mode,", 2, cadr(args), "a string (a mode such as \"r\")"));
- return(open_input_file_1(sc, s7_string(name), s7_string(cadr(args)), "open-input-file"));
- }
- return(open_input_file_1(sc, s7_string(name), "r", "open-input-file"));
-}
-
-
-static void make_standard_ports(s7_scheme *sc)
-{
- s7_pointer x;
+ if (err >= fabs(rat))
+ return(small_int(0));
- /* standard output */
- x = (s7_cell *)permanent_calloc(sizeof(s7_cell));
- x->hloc = NOT_IN_HEAP;
- set_type(x, T_OUTPUT_PORT | T_SIMPLE | T_IMMUTABLE | T_DONT_COPY);
- x->object.port = (s7_port_t *)permanent_calloc(sizeof(s7_port_t));
- port_type(x) = FILE_PORT;
- port_is_closed(x) = false;
- port_filename(x) = copy_string("*stdout*");
- port_file_number(x) = remember_file_name(sc, port_filename(x)); /* these numbers need to be correct for the evaluator (__FUNC__ data) */
- port_line_number(x) = 0;
- port_file(x) = stdout;
- port_needs_free(x) = false;
- sc->standard_output = x;
+ if ((rat > 9.2233720368548e+18) || (rat < -9.2233720368548e+18))
+ return(out_of_range(sc, sc->RATIONALIZE, small_int(1), x, ITS_TOO_LARGE));
- /* standard error */
- x = (s7_cell *)permanent_calloc(sizeof(s7_cell));
- x->hloc = NOT_IN_HEAP;
- set_type(x, T_OUTPUT_PORT | T_SIMPLE | T_IMMUTABLE | T_DONT_COPY);
- x->object.port = (s7_port_t *)permanent_calloc(sizeof(s7_port_t));
- port_type(x) = FILE_PORT;
- port_is_closed(x) = false;
- port_filename(x) = copy_string("*stderr*");
- port_file_number(x) = remember_file_name(sc, port_filename(x));
- port_line_number(x) = 0;
- port_file(x) = stderr;
- port_needs_free(x) = false;
- sc->standard_error = x;
+ if ((fabs(rat) + fabs(err)) < 1.0e-18)
+ err = 1.0e-18;
+ /* (/ 1.0 most-positive-fixnum) is 1.0842021e-19, so if we let err be less than that,
+ * (rationalize 1e-19 1e-20) hangs, but this only affects the initial ceiling, I believe.
+ */
- /* standard input */
- x = (s7_cell *)permanent_calloc(sizeof(s7_cell));
- x->hloc = NOT_IN_HEAP;
- set_type(x, T_INPUT_PORT | T_SIMPLE | T_IMMUTABLE | T_DONT_COPY);
- x->object.port = (s7_port_t *)permanent_calloc(sizeof(s7_port_t));
- port_type(x) = FILE_PORT;
- port_is_closed(x) = false;
- port_filename(x) = copy_string("*stdin*");
- port_file_number(x) = remember_file_name(sc, port_filename(x));
- port_line_number(x) = 0;
- port_file(x) = stdin;
- port_needs_free(x) = false;
- sc->standard_input = x;
+ if (fabs(rat) < fabs(err))
+ return(small_int(0));
- s7_define_constant(sc, "*stdin*", sc->standard_input);
- s7_define_constant(sc, "*stdout*", sc->standard_output);
- s7_define_constant(sc, "*stderr*", sc->standard_error);
+ if (c_rationalize(rat, err, &numer, &denom))
+ return(s7_make_ratio(sc, numer, denom));
- sc->input_port = sc->standard_input;
- sc->output_port = sc->standard_output;
- sc->error_port = sc->standard_error;
- sc->current_file = NULL;
- sc->current_line = -1;
+ return(sc->F);
+ }
+ }
+ return(sc->F); /* make compiler happy */
}
+static s7_pointer c_rats(s7_scheme *sc, s7_pointer x) {return(g_rationalize(sc, set_plist_1(sc, x)));}
+PF_TO_PF(rationalize, c_rats)
-s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode)
+
+/* -------------------------------- angle -------------------------------- */
+static s7_pointer g_angle(s7_scheme *sc, s7_pointer args)
{
- FILE *fp;
+ #define H_angle "(angle z) returns the angle of z"
+ #define Q_angle s7_make_signature(sc, 2, sc->IS_REAL, sc->IS_NUMBER)
s7_pointer x;
- /* see if we can open this file before allocating a port */
-
- errno = 0;
- fp = fopen(name, mode);
- if (!fp)
+ /* (angle inf+infi) -> 0.78539816339745 ?
+ * I think this should be -pi < ang <= pi
+ */
+
+ x = car(args);
+ switch (type(x))
{
-#ifndef _MSC_VER
- if (errno == EINVAL)
- return(file_error(sc, "open-output-file", "invalid mode", mode));
-#endif
- return(file_error(sc, "open-output-file", strerror(errno), name));
- }
+ case T_INTEGER:
+ if (integer(x) < 0)
+ return(real_pi);
+ return(small_int(0));
- NEW_CELL(sc, x);
- set_type(x, T_OUTPUT_PORT | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
-
- x->object.port = (s7_port_t *)calloc(1, sizeof(s7_port_t));
- port_type(x) = FILE_PORT;
- port_is_closed(x) = false;
- port_filename(x) = copy_string(name);
- port_line_number(x) = 1;
- port_file(x) = fp;
- port_needs_free(x) = false;
- return(x);
-}
+ case T_RATIO:
+ if (numerator(x) < 0)
+ return(real_pi);
+ return(small_int(0));
+ case T_REAL:
+ if (is_NaN(real(x))) return(x);
+ if (real(x) < 0.0)
+ return(real_pi);
+ return(real_zero);
-static s7_pointer g_open_output_file(s7_scheme *sc, s7_pointer args)
-{
- #define H_open_output_file "(open-output-file filename (mode \"w\")) opens filename for writing"
- s7_pointer name = car(args);
+ case T_COMPLEX:
+ return(make_real(sc, atan2(imag_part(x), real_part(x))));
- if (!s7_is_string(name))
- return(s7_wrong_type_arg_error(sc, "open-output-file filename,", (cdr(args) == sc->NIL) ? 0 : 1, name, "a string"));
-
- if (is_pair(cdr(args)))
- {
- if (!s7_is_string(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "open-output-file mode,", 2, cadr(args), "a string (a mode such as \"w\")"));
- return(s7_open_output_file(sc, s7_string(name), s7_string(cadr(args))));
+ default:
+ method_or_bust_with_type(sc, x, sc->ANGLE, args, A_NUMBER, 0);
}
- return(s7_open_output_file(sc, s7_string(name), "w"));
-}
-
-
-s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string)
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_INPUT_PORT | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
-
- x->object.port = (s7_port_t *)calloc(1, sizeof(s7_port_t));
- port_type(x) = STRING_PORT;
- port_is_closed(x) = false;
- port_string(x) = (char *)input_string;
- port_string_length(x) = safe_strlen(input_string);
- port_string_point(x) = 0;
- port_filename(x) = NULL;
- port_file_number(x) = -1;
- port_needs_free(x) = false;
-
- return(x);
}
-static s7_pointer g_open_input_string(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- make-polar -------------------------------- */
+#if (!WITH_PURE_S7)
+static s7_pointer g_make_polar(s7_scheme *sc, s7_pointer args)
{
- #define H_open_input_string "(open-input-string str) opens an input port reading str"
- s7_pointer input_string = car(args);
+ s7_pointer x, y;
+ s7_double ang, mag;
+ #define H_make_polar "(make-polar mag ang) returns a complex number with magnitude mag and angle ang"
+ #define Q_make_polar s7_make_signature(sc, 3, sc->IS_NUMBER, sc->IS_REAL, sc->IS_REAL)
- if (!s7_is_string(input_string))
- return(s7_wrong_type_arg_error(sc, "open-input-string", 0, input_string, "a string"));
-
- return(s7_open_input_string(sc, s7_string(input_string))); /* presumably the caller is protecting the input string?? */
-}
+ x = car(args);
+ y = cadr(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(x); /* (make-polar 0 1) -> 0 */
+ if (integer(y) == 0) return(x); /* (make-polar 1 0) -> 1 */
+ mag = (s7_double)integer(x);
+ ang = (s7_double)integer(y);
+ break;
-#define STRING_PORT_INITIAL_LENGTH 128
+ case T_RATIO:
+ if (integer(x) == 0) return(x);
+ mag = (s7_double)integer(x);
+ ang = (s7_double)fraction(y);
+ break;
-s7_pointer s7_open_output_string(s7_scheme *sc)
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_OUTPUT_PORT | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
-
- x->object.port = (s7_port_t *)calloc(1, sizeof(s7_port_t));
- port_type(x) = STRING_PORT;
- port_is_closed(x) = false;
- port_string_length(x) = STRING_PORT_INITIAL_LENGTH;
- port_string(x) = (char *)calloc(STRING_PORT_INITIAL_LENGTH, sizeof(char));
- port_string_point(x) = 0;
- port_needs_free(x) = true;
- return(x);
-}
+ case T_REAL:
+ ang = real(y);
+ if (ang == 0.0) return(x);
+ if (is_NaN(ang)) return(y);
+ if (is_inf(ang)) return(real_NaN);
+ if ((ang == M_PI) || (ang == -M_PI)) return(make_integer(sc, -integer(x)));
+ mag = (s7_double)integer(x);
+ break;
+ default:
+ method_or_bust(sc, y, sc->MAKE_POLAR, args, T_REAL, 2);
+ }
+ break;
-static s7_pointer g_open_output_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_open_output_string "(open-output-string) opens an output string port"
- return(s7_open_output_string(sc));
-}
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0) return(x);
+ mag = (s7_double)fraction(x);
+ ang = (s7_double)integer(y);
+ break;
+ case T_RATIO:
+ mag = (s7_double)fraction(x);
+ ang = (s7_double)fraction(y);
+ break;
-const char *s7_get_output_string(s7_scheme *sc, s7_pointer p)
-{
- return(port_string(p));
-}
+ case T_REAL:
+ ang = real(y);
+ if (ang == 0.0) return(x);
+ if (is_NaN(ang)) return(y);
+ if (is_inf(ang)) return(real_NaN);
+ if ((ang == M_PI) || (ang == -M_PI)) return(s7_make_ratio(sc, -numerator(x), denominator(x)));
+ mag = (s7_double)fraction(x);
+ break;
+ default:
+ method_or_bust(sc, y, sc->MAKE_POLAR, args, T_REAL, 2);
+ }
+ break;
-static s7_pointer g_get_output_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_get_output_string "(get-output-string port) returns the output accumulated in port"
- s7_pointer p = car(args);
+ case T_REAL:
+ mag = real(x);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (is_NaN(mag)) return(x);
+ if (integer(y) == 0) return(x);
+ ang = (s7_double)integer(y);
+ break;
- if ((!is_output_port(p)) ||
- (!is_string_port(p)))
- return(s7_wrong_type_arg_error(sc, "get-output-string", 0, p, "an output string port"));
- if (port_is_closed(p))
- return(s7_wrong_type_arg_error(sc, "get-output-string", 0, p, "an active (open) string port"));
+ case T_RATIO:
+ if (is_NaN(mag)) return(x);
+ ang = (s7_double)fraction(y);
+ break;
- return(s7_make_string(sc, s7_get_output_string(sc, p)));
-}
+ case T_REAL:
+ if (is_NaN(mag)) return(x);
+ ang = real(y);
+ if (ang == 0.0) return(x);
+ if (is_NaN(ang)) return(y);
+ if (is_inf(ang)) return(real_NaN);
+ break;
+ default:
+ method_or_bust(sc, y, sc->MAKE_POLAR, args, T_REAL, 2);
+ }
+ break;
-s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port))
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_INPUT_PORT | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
-
- x->object.port = (s7_port_t *)calloc(1, sizeof(s7_port_t));
- port_type(x) = FUNCTION_PORT;
- port_is_closed(x) = false;
- port_needs_free(x) = false;
- port_input_function(x) = function;
- return(x);
-}
+ default:
+ method_or_bust(sc, x, sc->MAKE_POLAR, args, T_REAL, 1);
+ }
+ return(s7_make_complex(sc, mag * cos(ang), mag * sin(ang)));
-s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, unsigned char c, s7_pointer port))
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- set_type(x, T_OUTPUT_PORT | T_FINALIZABLE | T_SIMPLE | T_DONT_COPY);
-
- x->object.port = (s7_port_t *)calloc(1, sizeof(s7_port_t));
- port_type(x) = FUNCTION_PORT;
- port_is_closed(x) = false;
- port_needs_free(x) = false;
- port_output_function(x) = function;
- return(x);
+ /* since sin is inaccurate for large arguments, so is make-polar:
+ * (make-polar 1.0 1e40) -> -0.76267273202438+0.64678458842683i, not 8.218988919070239214448025364432557517335E-1-5.696334009536363273080341815735687231337E-1i
+ */
}
-
-void *s7_port_data(s7_pointer port)
-{
- return(port_data(port));
-}
+static s7_pointer c_make_polar_2(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_make_polar(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(make_polar, c_make_polar_2)
+#endif
-void *s7_port_set_data(s7_pointer port, void *stuff)
+/* -------------------------------- complex -------------------------------- */
+static s7_pointer g_complex(s7_scheme *sc, s7_pointer args)
{
- port_data(port) = stuff;
- return(stuff);
-}
+ s7_pointer x, y;
+ #define H_complex "(complex x1 x2) returns a complex number with real-part x1 and imaginary-part x2"
+ #define Q_complex s7_make_signature(sc, 3, sc->IS_NUMBER, sc->IS_REAL, sc->IS_REAL)
+ x = car(args);
+ y = cadr(args);
-static void push_input_port(s7_scheme *sc, s7_pointer new_port)
-{
- sc->input_port_stack = s7_cons(sc, sc->input_port, sc->input_port_stack);
- sc->input_port = new_port;
- sc->input_is_file = (is_file_port(sc->input_port));
-}
+ switch (type(y))
+ {
+ case T_INTEGER:
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0) return(x);
+ return(s7_make_complex(sc, (s7_double)integer(x), (s7_double)integer(y)));
+ case T_RATIO:
+ if (integer(y) == 0) return(x);
+ return(s7_make_complex(sc, (s7_double)fraction(x), (s7_double)integer(y)));
-static void pop_input_port(s7_scheme *sc)
-{
- if (is_pair(sc->input_port_stack))
- {
- sc->input_port = car(sc->input_port_stack);
- sc->input_port_stack = cdr(sc->input_port_stack);
- }
- else sc->input_port = sc->standard_input;
- sc->input_is_file = (is_file_port(sc->input_port));
-}
+ case T_REAL:
+ if (integer(y) == 0) return(x);
+ return(s7_make_complex(sc, real(x), (s7_double)integer(y)));
+ default:
+ method_or_bust(sc, x, sc->COMPLEX, args, T_REAL, 1);
+ }
-static int inchar(s7_pointer pt)
-{
- int c;
- if (is_file_port(pt))
- c = fgetc(port_file(pt)); /* not unsigned char! -- could be EOF */
- else
- {
- if ((!(port_string(pt))) ||
- (port_string_length(pt) <= port_string_point(pt)))
- return(EOF);
- c = (unsigned char)port_string(pt)[port_string_point(pt)++];
- }
+ case T_RATIO:
+ switch (type(x))
+ {
+ case T_INTEGER: return(s7_make_complex(sc, (s7_double)integer(x), (s7_double)fraction(y)));
+ case T_RATIO: return(s7_make_complex(sc, (s7_double)fraction(x), (s7_double)fraction(y)));
+ case T_REAL: return(s7_make_complex(sc, real(x), (s7_double)fraction(y)));
+ default:
+ method_or_bust(sc, x, sc->COMPLEX, args, T_REAL, 1);
+ }
- if (c == '\n')
- port_line_number(pt)++;
+ case T_REAL:
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (real(y) == 0.0) return(x);
+ return(s7_make_complex(sc, (s7_double)integer(x), real(y)));
- return(c);
-}
+ case T_RATIO:
+ if (real(y) == 0.0) return(x);
+ return(s7_make_complex(sc, (s7_double)fraction(x), real(y)));
+ case T_REAL:
+ if (real(y) == 0.0) return(x);
+ return(s7_make_complex(sc, real(x), real(y)));
-static void backchar(char c, s7_pointer pt)
-{
- if (c == '\n')
- port_line_number(pt)--;
+ default:
+ method_or_bust(sc, x, sc->COMPLEX, args, T_REAL, 1);
+ }
- if (is_file_port(pt))
- ungetc(c, port_file(pt));
- else
- {
- if (port_string_point(pt) > 0)
- port_string_point(pt)--;
+ default:
+ method_or_bust(sc, (is_let(x)) ? x : y, sc->COMPLEX, args, T_REAL, 2);
}
}
+static s7_pointer c_make_complex_2(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_complex(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(make_complex, c_make_complex_2)
-static int s7_read_char_1(s7_scheme *sc, s7_pointer port, s7_read_t read_choice)
+
+/* -------------------------------- exp -------------------------------- */
+static s7_pointer g_exp(s7_scheme *sc, s7_pointer args)
{
- int c; /* needs to be an int so EOF=-1, but not 255 */
+ #define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459"
+ #define Q_exp pcl_n
- if (is_function_port(port))
- return(character((*(port_input_function(port)))(sc, read_choice, port)));
+ s7_pointer x;
- if (is_file_port(port))
- c = fgetc(port_file(port)); /* not unsigned char! -- could be EOF */
- else
+ x = car(args);
+ switch (type(x))
{
- if ((!(port_string(port))) ||
- (port_string_length(port) <= port_string_point(port)))
- return(EOF);
- c = (unsigned char)port_string(port)[port_string_point(port)++];
- }
-
- if ((read_choice == S7_PEEK_CHAR) && (c != EOF))
- backchar(c, port);
- return(c);
-}
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(1)); /* (exp 0) -> 1 */
+ return(make_real(sc, exp((s7_double)(integer(x)))));
+ case T_RATIO:
+ return(make_real(sc, exp((s7_double)fraction(x))));
-int s7_read_char(s7_scheme *sc, s7_pointer port)
-{
- return(s7_read_char_1(sc, port, S7_READ_CHAR));
-}
+ case T_REAL:
+ return(make_real(sc, exp(real(x))));
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, cexp(as_c_complex(x))));
+ /* this is inaccurate for large arguments:
+ * (exp 0+1e20i) -> -0.66491178990701-0.74692189125949i, not 7.639704044417283004001468027378811228331E-1-6.45251285265780844205811711312523007406E-1i
+ */
+#else
+ return(out_of_range(sc, sc->EXP, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
-int s7_peek_char(s7_scheme *sc, s7_pointer port)
-{
- return(s7_read_char_1(sc, port, S7_PEEK_CHAR));
+ default:
+ method_or_bust_with_type(sc, x, sc->EXP, args, A_NUMBER, 0);
+ }
}
+DIRECT_RF_TO_RF(exp)
-static s7_pointer g_read_char_1(s7_scheme *sc, s7_pointer args, bool peek)
-{
- int c;
- s7_pointer port;
-
- if (args != sc->NIL)
- port = car(args);
- else port = sc->input_port;
-
- if (!is_input_port(port))
- return(s7_wrong_type_arg_error(sc, (peek) ? "peek-char" : "read-char", 0, port, "an input port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, (peek) ? "peek-char" : "read-char", 0, port, "an open input port"));
-
- c = s7_read_char_1(sc, port, (peek) ? S7_PEEK_CHAR : S7_READ_CHAR);
- if (c == EOF)
- return(sc->EOF_OBJECT);
-
- return(s7_make_character(sc, (unsigned char)c));
-}
-
-
-static s7_pointer g_read_char(s7_scheme *sc, s7_pointer args)
-{
- #define H_read_char "(read-char (port (current-input-port))) returns the next character in the input port"
- return(g_read_char_1(sc, args, false));
-}
+/* -------------------------------- log -------------------------------- */
-static s7_pointer g_peek_char(s7_scheme *sc, s7_pointer args)
-{
- #define H_peek_char "(peek-char (port (current-input-port))) returns the next character in the input port, but does not remove it from the input stream"
- return(g_read_char_1(sc, args, true));
-}
-
+#if __cplusplus
+#define LOG_2 1.4426950408889634074
+#else
+#define LOG_2 1.4426950408889634073599246810018921L /* (/ (log 2.0)) */
+#endif
-static s7_pointer g_read_line(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_log(s7_scheme *sc, s7_pointer args)
{
- #define H_read_line "(read-line port (with-eol #f)) returns the next line from port, or #<eof> (use the function eof-object?).\
-If 'with-eol' is not #f, read-line includes the trailing end-of-line character."
+ #define H_log "(log z1 (z2 e)) returns log(z1) / log(z2) where z2 (the base) defaults to e: (log 8 2) = 3"
+ #define Q_log pcl_n
- s7_pointer port;
- int i;
- bool with_eol = false;
+ s7_pointer x;
+ x = car(args);
+ if (!s7_is_number(x))
+ method_or_bust_with_type(sc, x, sc->LOG, args, A_NUMBER, 1);
- if (args != sc->NIL)
+ if (is_pair(cdr(args)))
{
- port = car(args);
- if (!is_input_port(port))
- return(s7_wrong_type_arg_error(sc, "read-line", (cdr(args) == sc->NIL) ? 0 : 1, port, "an input port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "read-line", (cdr(args) == sc->NIL) ? 0 : 1, port, "an open input port"));
-
- if (cdr(sc->args) != sc->NIL)
- {
- /* support (read-line fp 'concat) for compatibility with guile */
- if ((!s7_is_boolean(cadr(sc->args))) &&
- (!s7_is_symbol(cadr(sc->args))))
- return(s7_wrong_type_arg_error(sc, "read-line", 2, cadr(sc->args), "#f or #t"));
- if (cadr(sc->args) != sc->F)
- with_eol = true;
- }
- }
- else port = sc->input_port;
-
- if (is_function_port(port))
- return((*(port_input_function(port)))(sc, S7_READ_LINE, port));
+ s7_pointer y;
- if (sc->read_line_buf == NULL)
- {
- sc->read_line_buf_size = 256;
- sc->read_line_buf = (char *)malloc(sc->read_line_buf_size * sizeof(char));
- }
+ y = cadr(args);
+ if (!(s7_is_number(y)))
+ method_or_bust_with_type(sc, y, sc->LOG, args, A_NUMBER, 2);
- for (i = 0; ; i++)
- {
- int c;
- if (i + 1 >= sc->read_line_buf_size)
+ if (y == small_int(2))
{
- sc->read_line_buf_size *= 2;
- sc->read_line_buf = (char *)realloc(sc->read_line_buf, sc->read_line_buf_size * sizeof(char));
+ /* (define (2^n? x) (and (not (zero? x)) (zero? (logand x (- x 1))))) */
+ if (is_integer(x))
+ {
+ s7_int ix;
+ ix = s7_integer(x);
+ if (ix > 0)
+ {
+ s7_double fx;
+#if (__ANDROID__) || (MS_WINDOWS) || ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ <= 4))))
+ /* just a guess -- log2 gets a warning in gcc 4.3.2, but not in 4.4.4 */
+ fx = log((double)ix) / log(2.0);
+#else
+ fx = log2((double)ix);
+#endif
+ /* (s7_int)fx rounds (log 8 2) to 2 in FreeBSD! */
+#if ((__GNUC__) && ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 4))))
+ return(make_real(sc, fx));
+#else
+ if ((ix & (ix - 1)) == 0)
+ return(make_integer(sc, (s7_int)s7_round(fx)));
+ return(make_real(sc, fx));
+#endif
+ }
+ }
+ if ((s7_is_real(x)) &&
+ (s7_is_positive(x)))
+ return(make_real(sc, log(real_to_double(sc, x, "log")) * LOG_2));
+ return(s7_from_c_complex(sc, clog(s7_to_c_complex(x)) * LOG_2));
}
- if (port == sc->standard_input)
+ if ((x == small_int(1)) && (y == small_int(1))) /* (log 1 1) -> 0 (this is NaN in the bignum case) */
+ return(small_int(0));
+
+ /* (log 1 0) must be 0 since everyone says (expt 0 0) is 1 */
+ if (s7_is_zero(y))
{
- if (fgets(sc->read_line_buf, sc->read_line_buf_size, stdin) != NULL)
- return(s7_make_string(sc, sc->read_line_buf)); /* fgets adds the trailing '\0' */
- return(s7_make_string_with_length(sc, NULL, 0));
+ if ((y == small_int(0)) &&
+ (x == small_int(1)))
+ return(y);
+ return(out_of_range(sc, sc->LOG, small_int(2), y, make_string_wrapper(sc, "can't be 0")));
}
- else c = inchar(port);
- if (c == EOF)
+ if (s7_is_one(y)) /* this used to raise an error, but the bignum case is simpler if we return inf */
{
- if (i == 0)
- return(sc->EOF_OBJECT);
- return(s7_make_terminated_string_with_length(sc, sc->read_line_buf, i));
+ if (s7_is_one(x)) /* but (log 1.0 1.0) -> 0.0 */
+ return(real_zero);
+ return(real_infinity); /* currently (log 1/0 1) is inf? */
}
- sc->read_line_buf[i] = (char)c;
- if (c == '\n')
+ if ((s7_is_real(x)) &&
+ (s7_is_real(y)) &&
+ (s7_is_positive(x)) &&
+ (s7_is_positive(y)))
{
- if (!with_eol) i--;
- return(s7_make_terminated_string_with_length(sc, sc->read_line_buf, i + 1));
+ if ((s7_is_rational(x)) &&
+ (s7_is_rational(y)))
+ {
+ s7_double res;
+ s7_int ires;
+ res = log(rational_to_double(sc, x)) / log(rational_to_double(sc, y));
+ ires = (s7_int)res;
+ if (res - ires == 0.0)
+ return(make_integer(sc, ires)); /* (log 8 2) -> 3 or (log 1/8 2) -> -3 */
+ return(make_real(sc, res)); /* perhaps use rationalize here? (log 2 8) -> 1/3 */
+ }
+ return(make_real(sc, log(real_to_double(sc, x, "log")) / log(real_to_double(sc, y, "log"))));
}
+ return(s7_from_c_complex(sc, clog(s7_to_c_complex(x)) / clog(s7_to_c_complex(y))));
}
- return(sc->EOF_OBJECT);
-}
-
-
-s7_pointer s7_read(s7_scheme *sc, s7_pointer port)
-{
- if (is_input_port(port))
+ if (s7_is_real(x))
{
- bool old_longjmp;
- old_longjmp = sc->longjmp_ok;
- if (!sc->longjmp_ok)
- {
- sc->longjmp_ok = true;
- if (setjmp(sc->goto_start) != 0)
- return(sc->value);
- }
- push_input_port(sc, port);
- push_stack(sc, opcode(OP_EVAL_DONE), port, sc->NIL);
- eval(sc, OP_READ_INTERNAL);
- sc->longjmp_ok = old_longjmp;
- pop_input_port(sc);
- return(sc->value);
+ if (s7_is_positive(x))
+ return(make_real(sc, log(real_to_double(sc, x, "log"))));
+ return(s7_make_complex(sc, log(-real_to_double(sc, x, "log")), M_PI));
}
- return(s7_wrong_type_arg_error(sc, "read", 0, port, "an input port"));
+ return(s7_from_c_complex(sc, clog(s7_to_c_complex(x))));
}
-static s7_pointer g_read(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- sin -------------------------------- */
+static s7_pointer g_sin(s7_scheme *sc, s7_pointer args)
{
- #define H_read "(read (port (current-input-port))) returns the next object in the input port"
- s7_pointer port;
-
- if (args != sc->NIL)
- port = car(args);
- else port = sc->input_port;
-
- if (!is_input_port(port)) /* was also not stdin */
- return(s7_wrong_type_arg_error(sc, "read", 0, port, "an input port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "read", 0, port, "an open input port"));
-
- if (is_function_port(port))
- return((*(port_input_function(port)))(sc, S7_READ, port));
-
- if ((is_string_port(port)) &&
- (port_string_length(port) <= port_string_point(port)))
- return(sc->EOF_OBJECT);
-
- push_input_port(sc, port);
+ #define H_sin "(sin z) returns sin(z)"
+ #define Q_sin pcl_n
- push_stack(sc, opcode(OP_READ_DONE), sc->NIL, sc->NIL); /* this stops the internal read process so we only get one form */
- push_stack(sc, opcode(OP_READ_INTERNAL), sc->NIL, sc->NIL);
- return(port);
-}
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_REAL:
+ return(make_real(sc, sin(real(x))));
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (sin 0) -> 0 */
+ return(make_real(sc, sin((s7_double)integer(x))));
-static FILE *search_load_path(s7_scheme *sc, const char *name)
-{
- int i, len, name_len;
- s7_pointer lst;
+ case T_RATIO:
+ return(make_real(sc, sin((s7_double)(fraction(x)))));
- lst = s7_load_path(sc);
- len = s7_list_length(sc, lst);
- name_len = safe_strlen(name);
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, csin(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->SIN, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
- for (i = 0; i < len; i++)
- {
- const char *new_dir;
- int size;
- new_dir = s7_string(s7_list_ref(sc, lst, i));
- if (new_dir)
- {
- char *new_name;
- FILE *fp;
- size = name_len + safe_strlen(new_dir) + 2;
- new_name = (char *)malloc(size * sizeof(char));
- snprintf(new_name, size, "%s/%s", new_dir, name);
- fp = fopen(new_name, "r");
- free(new_name);
- if (fp) return(fp);
- }
+ default:
+ method_or_bust_with_type(sc, x, sc->SIN, args, A_NUMBER, 0);
}
- return(NULL);
+ /* sin is totally inaccurate over about 1e18. There's a way to get true results,
+ * but it involves fancy "range reduction" techniques.
+ * This means that lots of things are inaccurate:
+ * (sin (remainder 1e22 (* 2 pi)))
+ * -0.57876806033477
+ * but it should be -8.522008497671888065747423101326159661908E-1
+ * ---
+ * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22 !!
+ * it should be 5.263007914620499494429139986095833592117E0
+ */
}
+DIRECT_RF_TO_RF(sin)
+
-static s7_pointer load_file(s7_scheme *sc, FILE *fp, const char *name)
+/* -------------------------------- cos -------------------------------- */
+static s7_pointer g_cos(s7_scheme *sc, s7_pointer args)
{
- return(read_file(sc, fp, name, -1, "load")); /* -1 means always read its contents into a local string */
-}
+ #define H_cos "(cos z) returns cos(z)"
+ #define Q_cos pcl_n
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_REAL:
+ return(make_real(sc, cos(real(x))));
-s7_pointer s7_load(s7_scheme *sc, const char *filename)
-{
- bool old_longjmp;
- s7_pointer port;
- FILE *fp;
-
- fp = fopen(filename, "r");
- if (!fp)
- fp = search_load_path(sc, filename);
- if (!fp)
- return(file_error(sc, "load", "can't open", filename));
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(1)); /* (cos 0) -> 1 */
+ return(make_real(sc, cos((s7_double)integer(x))));
- if (is_pair(hook_functions(sc->load_hook)))
- s7_hook_apply(sc, sc->load_hook, make_list_1(sc, s7_make_string(sc, filename)));
+ case T_RATIO:
+ return(make_real(sc, cos((s7_double)(fraction(x)))));
- port = load_file(sc, fp, filename);
- port_file_number(port) = remember_file_name(sc, filename);
- push_input_port(sc, port);
-
- /* it's possible to call this recursively (s7_load is XEN_LOAD_FILE which can be invoked via s7_call)
- * but in that case, we actually want it to behave like g_load and continue the evaluation upon completion
- */
- sc->envir = s7_global_environment(sc);
-
- if (!sc->longjmp_ok)
- {
- push_stack(sc, opcode(OP_LOAD_RETURN_IF_EOF), port, sc->NIL);
-
- old_longjmp = sc->longjmp_ok;
- if (!sc->longjmp_ok)
- {
- sc->longjmp_ok = true;
- if (setjmp(sc->goto_start) != 0)
- eval(sc, sc->op);
- else eval(sc, OP_READ_INTERNAL);
- }
- sc->longjmp_ok = old_longjmp;
- pop_input_port(sc);
- s7_close_input_port(sc, port);
- }
- else
- {
- /* caller here is assuming the load will be complete before this function returns */
- push_stack(sc, opcode(OP_LOAD_RETURN_IF_EOF), sc->args, sc->code);
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, ccos(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->COS, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
- eval(sc, OP_READ_INTERNAL);
- pop_input_port(sc);
- s7_close_input_port(sc, port);
+ default:
+ method_or_bust_with_type(sc, x, sc->COS, args, A_NUMBER, 0);
}
-
- return(sc->UNSPECIFIED);
}
+DIRECT_RF_TO_RF(cos)
-#include <sys/stat.h>
-static bool is_directory(const char *filename)
+/* -------------------------------- tan -------------------------------- */
+static s7_pointer g_tan(s7_scheme *sc, s7_pointer args)
{
-#if HAVE_WINDOZE
- return(false);
+ #define H_tan "(tan z) returns tan(z)"
+ #define Q_tan pcl_n
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_REAL:
+ return(make_real(sc, tan(real(x))));
+
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (tan 0) -> 0 */
+ return(make_real(sc, tan((s7_double)(integer(x)))));
+
+ case T_RATIO:
+ return(make_real(sc, tan((s7_double)(fraction(x)))));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ if (imag_part(x) > 350.0)
+ return(s7_make_complex(sc, 0.0, 1.0));
+ if (imag_part(x) < -350.0)
+ return(s7_make_complex(sc, 0.0, -1.0));
+ return(s7_from_c_complex(sc, ctan(as_c_complex(x))));
#else
- /* from snd-file.c */
-#ifdef S_ISDIR
- struct stat statbuf;
-#if HAVE_LSTAT
- return((lstat(filename, &statbuf) >= 0) &&
- (S_ISDIR(statbuf.st_mode)));
- return(false);
-#else
- return((stat(filename, &statbuf) == 0) &&
- (S_ISDIR(statbuf.st_mode)));
-#endif
-#endif
+ return(out_of_range(sc, sc->TAN, small_int(1), x, NO_COMPLEX_NUMBERS));
#endif
+
+ default:
+ method_or_bust_with_type(sc, x, sc->TAN, args, A_NUMBER, 0);
+ }
}
+DIRECT_RF_TO_RF(tan)
-static s7_pointer g_load(s7_scheme *sc, s7_pointer args)
+
+/* -------------------------------- asin -------------------------------- */
+static s7_pointer c_asin(s7_scheme *sc, s7_double x)
{
- #define H_load "(load file (env (global-environment))) loads the scheme file 'file'. The 'env' argument \
-defaults to the global environment. To load into the current environment instead, pass (current-environment)."
+ s7_double absx, recip;
+ s7_complex result;
- FILE *fp = NULL;
- s7_pointer name, port;
- const char *fname;
-
- name = car(args);
- if (!s7_is_string(name))
- return(s7_wrong_type_arg_error(sc, "load filename,", (cdr(args) == sc->NIL) ? 0 : 1, name, "a string"));
+ absx = fabs(x);
+ if (absx <= 1.0)
+ return(make_real(sc, asin(x)));
- if (cdr(args) != sc->NIL)
- {
- if (!is_environment(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "load", 2, cadr(args), "an environment"));
- sc->envir = cadr(args);
- }
- else sc->envir = s7_global_environment(sc);
-
- fname = s7_string(name);
- if ((!fname) || (!(*fname))) /* fopen("", "r") returns a file pointer?? */
- return(s7_error(sc, sc->OUT_OF_RANGE,
- make_list_2(sc,
- make_protected_string(sc, "load's first argument, ~S, should be a filename"),
- name)));
+ /* otherwise use maxima code: */
+ recip = 1.0 / absx;
+ result = (M_PI / 2.0) - (_Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip)))));
+ if (x < 0.0)
+ return(s7_from_c_complex(sc, -result));
+ return(s7_from_c_complex(sc, result));
+}
- if (is_directory(fname))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "load argument, ~S, is a directory"), name)));
+static s7_pointer g_asin_1(s7_scheme *sc, s7_pointer n)
+{
+ switch (type(n))
+ {
+ case T_INTEGER:
+ if (integer(n) == 0) return(small_int(0)); /* (asin 0) -> 0 */
+ /* in netBSD, (asin 2) returns 0.25383842987008+0.25383842987008i according to Peter Bex */
+ return(c_asin(sc, (s7_double)integer(n)));
- fp = fopen(fname, "r");
- if (!fp)
- fp = search_load_path(sc, fname);
- if (!fp)
- return(file_error(sc, "load", "can't open", fname));
-
- port = load_file(sc, fp, fname);
- port_file_number(port) = remember_file_name(sc, fname);
- push_input_port(sc, port);
+ case T_RATIO:
+ return(c_asin(sc, (s7_double)numerator(n) / (s7_double)denominator(n)));
- push_stack(sc, opcode(OP_LOAD_CLOSE_AND_POP_IF_EOF), sc->NIL, sc->NIL); /* was pushing args and code, but I don't think they're used later */
- push_stack(sc, opcode(OP_READ_INTERNAL), sc->NIL, sc->NIL);
-
- /* now we've opened and moved to the file to be loaded, and set up the stack to return
- * to where we were when it is read. Call *load-hook* if it is a procedure.
- */
-
- if (hook_functions(sc->load_hook) != sc->NIL)
- {
- sc->args = make_list_1(sc, s7_make_string(sc, fname));
- sc->code = hook_functions(sc->load_hook);
- push_stack(sc, opcode(OP_HOOK_APPLY), sc->args, sc->code);
- }
+ case T_REAL:
+ return(c_asin(sc, real(n)));
- return(sc->UNSPECIFIED);
-}
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ /* if either real or imag part is very large, use explicit formula, not casin */
+ /* this code taken from sbcl's src/code/irrat.lisp */
+ /* break is around x+70000000i */
+ if ((fabs(real_part(n)) > 1.0e7) ||
+ (fabs(imag_part(n)) > 1.0e7))
+ {
+ s7_complex sq1mz, sq1pz, z;
+ z = as_c_complex(n);
+ sq1mz = csqrt(1.0 - z);
+ sq1pz = csqrt(1.0 + z);
+ return(s7_make_complex(sc, atan(real_part(n) / creal(sq1mz * sq1pz)), asinh(cimag(sq1pz * conj(sq1mz)))));
+ }
+ return(s7_from_c_complex(sc, casin(as_c_complex(n))));
+#else
+ return(out_of_range(sc, sc->ASIN, small_int(1), n, NO_COMPLEX_NUMBERS));
+#endif
-s7_pointer s7_load_path(s7_scheme *sc)
-{
- return(s7_symbol_value(sc, make_symbol(sc, "*load-path*")));
+ default:
+ method_or_bust_with_type(sc, n, sc->ASIN, list_1(sc, n), A_NUMBER, 0);
+ }
}
-
-s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir)
+static s7_pointer g_asin(s7_scheme *sc, s7_pointer args)
{
- s7_pointer load_path;
- load_path = make_symbol(sc, "*load-path*");
+ #define H_asin "(asin z) returns asin(z); (sin (asin x)) = x"
+ #define Q_asin pcl_n
- s7_symbol_set_value(sc,
- load_path,
- s7_cons(sc,
- s7_make_string(sc, dir),
- s7_symbol_value(sc, load_path)));
- return(s7_load_path(sc));
+ return(g_asin_1(sc, car(args)));
}
+R_P_F_TO_PF(asin, c_asin, g_asin_1, g_asin_1)
+/* g_asin_1 is safe for the gf case because it won't trigger the GC before it is done with its argument */
-static s7_pointer g_load_path_set(s7_scheme *sc, s7_pointer args)
+
+/* -------------------------------- acos -------------------------------- */
+static s7_pointer c_acos(s7_scheme *sc, s7_double x)
{
- /* new value must be either '() or a proper list of strings */
- if (cadr(args) == sc->NIL) return(cadr(args));
- if (is_pair(cadr(args)))
+ s7_double absx, recip;
+ s7_complex result;
+
+ absx = fabs(x);
+ if (absx <= 1.0)
+ return(make_real(sc, acos(x)));
+
+ /* else follow maxima again: */
+ recip = 1.0 / absx;
+ if (x > 0.0)
+ result = _Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
+ else result = M_PI - _Complex_I * clog(absx * (1.0 + (sqrt(1.0 + recip) * csqrt(1.0 - recip))));
+ return(s7_from_c_complex(sc, result));
+}
+
+static s7_pointer g_acos_1(s7_scheme *sc, s7_pointer n)
+{
+ switch (type(n))
{
- s7_pointer x;
- for (x = cadr(args); is_pair(x); x = cdr(x))
- if (!s7_is_string(car(x)))
- return(sc->ERROR);
- if (x == sc->NIL)
- return(cadr(args));
+ case T_INTEGER:
+ if (integer(n) == 1) return(small_int(0));
+ return(c_acos(sc, (s7_double)integer(n)));
+
+ case T_RATIO:
+ return(c_acos(sc, (s7_double)numerator(n) / (s7_double)denominator(n)));
+
+ case T_REAL:
+ return(c_acos(sc, real(n)));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ /* if either real or imag part is very large, use explicit formula, not cacos */
+ /* this code taken from sbcl's src/code/irrat.lisp */
+
+ if ((fabs(real_part(n)) > 1.0e7) ||
+ (fabs(imag_part(n)) > 1.0e7))
+ {
+ s7_complex sq1mz, sq1pz, z;
+ z = as_c_complex(n);
+ sq1mz = csqrt(1.0 - z);
+ sq1pz = csqrt(1.0 + z);
+ return(s7_make_complex(sc, 2.0 * atan(creal(sq1mz) / creal(sq1pz)), asinh(cimag(sq1mz * conj(sq1pz)))));
+ }
+ return(s7_from_c_complex(sc, cacos(s7_to_c_complex(n))));
+#else
+ return(out_of_range(sc, sc->ACOS, small_int(1), n, NO_COMPLEX_NUMBERS));
+#endif
+
+ default:
+ method_or_bust_with_type(sc, n, sc->ACOS, list_1(sc, n), A_NUMBER, 0);
}
- return(sc->ERROR);
}
-
-static s7_pointer eval_string_1(s7_scheme *sc, const char *str)
+static s7_pointer g_acos(s7_scheme *sc, s7_pointer args)
{
- s7_pointer port;
+ #define H_acos "(acos z) returns acos(z); (cos (acos 1)) = 1"
+ #define Q_acos pcl_n
+ return(g_acos_1(sc, car(args)));
+}
- port = s7_open_input_string(sc, str);
- push_input_port(sc, port);
+R_P_F_TO_PF(acos, c_acos, g_acos_1, g_acos_1)
- push_stack(sc, opcode(OP_BARRIER), port, sc->NIL);
- /* we're being called directly from C here, not as part of a scheme program.
- * Use this op to protect the port, I guess.
- */
- push_stack(sc, opcode(OP_EVAL_STRING), sc->args, sc->code);
- /* eval-string is not tail-recursive because it pushes markers in eval to catch
- * multiple statements in one eval-string call.
- */
- eval(sc, OP_READ_INTERNAL);
- pop_input_port(sc);
- s7_close_input_port(sc, port);
- if (is_multiple_value(sc->value)) /* (+ 1 (eval-string "(values 2 3)")) */
- sc->value = splice_in_values(sc, multiple_value(sc->value));
+/* -------------------------------- atan -------------------------------- */
- return(sc->value);
+static s7_double c_atan(s7_scheme *sc, s7_double x, s7_double y)
+{
+ return(atan2(x, y));
}
-
-s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str)
+static s7_pointer g_atan(s7_scheme *sc, s7_pointer args)
{
- bool old_longjmp;
- s7_pointer port, old_envir;
- /* this can be called recursively via s7_call */
+ #define H_atan "(atan z) returns atan(z), (atan y x) returns atan(y/x)"
+ #define Q_atan s7_make_signature(sc, 3, sc->IS_NUMBER, sc->IS_NUMBER, sc->IS_REAL)
+ /* actually if there are two args, both should be real, but how to express that in the signature? */
+ s7_pointer x, y;
+ s7_double x1, x2;
- old_envir = sc->envir;
- sc->envir = sc->global_env; /* C call assumes top level, I think. This is needed in any case
- * by dlinit -- the init function will be called in some local environment,
- * but the library entities it defines should obviously be top level,
- * as if via load.
- */
- if (sc->longjmp_ok)
+ /* currently (atan inf.0 inf.0) -> 0.78539816339745, and (atan inf.0 -inf.0) -> 2.3561944901923 (etc) */
+
+ x = car(args);
+ if (!is_pair(cdr(args)))
{
- s7_pointer result;
- result = eval_string_1(sc, str);
- sc->envir = old_envir;
- return(result);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (atan 0) -> 0 */
+
+ case T_RATIO:
+ case T_REAL:
+ return(make_real(sc, atan(real_to_double(sc, x, "atan"))));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, catan(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->ATAN, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
+
+ default:
+ method_or_bust_with_type(sc, x, sc->ATAN, args, A_NUMBER, 0);
+ }
}
-
- stack_reset(sc);
- push_stack(sc, opcode(OP_EVAL_STRING), old_envir, sc->NIL); /* GC protect envir */
- port = s7_open_input_string(sc, str);
- push_input_port(sc, port);
+ if (!s7_is_real(x))
+ method_or_bust(sc, x, sc->ATAN, args, T_REAL, 1);
+
+ y = cadr(args);
+ if (!s7_is_real(y))
+ method_or_bust(sc, y, sc->ATAN, args, T_REAL, 2);
- old_longjmp = sc->longjmp_ok;
- if (!sc->longjmp_ok)
+ x1 = real_to_double(sc, x, "atan");
+ x2 = real_to_double(sc, y, "atan");
+ return(make_real(sc, atan2(x1, x2)));
+}
+
+RF2_TO_RF(atan, c_atan)
+
+
+/* -------------------------------- sinh -------------------------------- */
+static s7_pointer g_sinh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_sinh "(sinh z) returns sinh(z)"
+ #define Q_sinh pcl_n
+
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
{
- sc->longjmp_ok = true;
- if (setjmp(sc->goto_start) != 0)
- eval(sc, sc->op);
- else eval(sc, OP_READ_INTERNAL);
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (sinh 0) -> 0 */
+
+ case T_REAL:
+ case T_RATIO:
+ return(make_real(sc, sinh(real_to_double(sc, x, "sinh"))));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, csinh(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->SINH, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
+
+ default:
+ method_or_bust_with_type(sc, x, sc->SINH, args, A_NUMBER, 0);
}
-
- sc->longjmp_ok = old_longjmp;
- pop_input_port(sc);
- s7_close_input_port(sc, port);
- sc->envir = old_envir;
- return(sc->value);
}
+DIRECT_RF_TO_RF(sinh)
-#if DEBUGGING
- static char *eval_string_string = NULL;
-#endif
-static s7_pointer g_eval_string(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- cosh -------------------------------- */
+static s7_pointer g_cosh(s7_scheme *sc, s7_pointer args)
{
- #define H_eval_string "(eval-string str (env (current-environment))) returns the result of evaluating the string str as Scheme code"
- s7_pointer old_port, port;
-
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "eval-string", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "a string"));
-
- if (cdr(args) != sc->NIL)
+ #define H_cosh "(cosh z) returns cosh(z)"
+ #define Q_cosh pcl_n
+
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
{
- if (!is_environment(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "eval-string", 2, cadr(args), "an environment"));
- sc->envir = cadr(args);
- }
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(1)); /* (cosh 0) -> 1 */
+
+ case T_REAL:
+ case T_RATIO:
+ /* this is not completely correct when optimization kicks in.
+ * :(define (hi) (do ((i 0 (+ i 1))) ((= i 1)) (display (cosh i))))
+ * hi
+ * :(hi)
+ * 1.0()
+ * :(cosh 0)
+ * 1
+ */
+ return(make_real(sc, cosh(real_to_double(sc, x, "cosh"))));
-#if DEBUGGING
- eval_string_string = (char *)s7_string(car(args));
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, ccosh(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->COSH, small_int(1), x, NO_COMPLEX_NUMBERS));
#endif
-
- old_port = sc->input_port;
- port = s7_open_input_string(sc, s7_string(car(args)));
- push_input_port(sc, port);
-
- push_stack(sc, opcode(OP_EVAL_STRING_1), sc->args, sc->code);
- push_stack(sc, opcode(OP_READ_INTERNAL), sc->NIL, sc->NIL);
-
- return(sc->F);
+
+ default:
+ method_or_bust_with_type(sc, x, sc->COSH, args, A_NUMBER, 0);
+ }
}
+DIRECT_RF_TO_RF(cosh)
-static s7_pointer call_with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
+/* -------------------------------- tanh -------------------------------- */
+static s7_pointer g_tanh(s7_scheme *sc, s7_pointer args)
{
- push_stack(sc, opcode(OP_UNWIND_INPUT), sc->input_port, port);
- sc->code = cadr(args);
- sc->args = make_list_1(sc, port);
+ #define H_tanh "(tanh z) returns tanh(z)"
+ #define Q_tanh pcl_n
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (tanh 0) -> 0 */
+
+ case T_REAL:
+ case T_RATIO:
+ return(make_real(sc, tanh(real_to_double(sc, x, "tanh"))));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ if (real_part(x) > 350.0)
+ return(real_one); /* closer than 0.0 which is what ctanh is about to return! */
+ if (real_part(x) < -350.0)
+ return(make_real(sc, -1.0)); /* closer than ctanh's -0.0 */
+ return(s7_from_c_complex(sc, ctanh(as_c_complex(x))));
+#else
+ return(out_of_range(sc, sc->TANH, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
+
+ default:
+ method_or_bust_with_type(sc, x, sc->TANH, args, A_NUMBER, 0);
+ }
}
+DIRECT_RF_TO_RF(tanh)
-static s7_pointer g_call_with_input_string(s7_scheme *sc, s7_pointer args)
+
+/* -------------------------------- asinh -------------------------------- */
+static s7_pointer c_asinh_1(s7_scheme *sc, s7_pointer x)
{
- #define H_call_with_input_string "(call-with-input-string str proc) opens a string port for str and applies proc to it"
-
- /* (call-with-input-string "44" (lambda (p) (+ 1 (read p)))) -> 45
- */
-
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-input-string", 1, car(args), "a string"));
- if (!is_procedure(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-input-string", 2, cadr(args), "a procedure"));
- if ((is_continuation(cadr(args))) || is_goto(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-input-string", 2, cadr(args), "a normal procedure (not a continuation)"));
-
- return(call_with_input(sc, s7_open_input_string(sc, s7_string(car(args))), args));
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0));
+ return(make_real(sc, asinh((s7_double)integer(x))));
+
+ case T_RATIO:
+ return(make_real(sc, asinh((s7_double)numerator(x) / (s7_double)denominator(x))));
+
+ case T_REAL:
+ return(make_real(sc, asinh(real(x))));
+
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ #if (defined(__OpenBSD__)) || (defined(__NetBSD__))
+ return(s7_from_c_complex(sc, casinh_1(as_c_complex(x))));
+ #else
+ return(s7_from_c_complex(sc, casinh(as_c_complex(x))));
+ #endif
+#else
+ return(out_of_range(sc, sc->ASINH, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
+
+ default:
+ method_or_bust_with_type(sc, x, sc->ASINH, list_1(sc, x), A_NUMBER, 0);
+ }
}
+static s7_pointer g_asinh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_asinh "(asinh z) returns asinh(z)"
+ #define Q_asinh pcl_n
+
+ return(c_asinh_1(sc, car(args)));
+}
-static s7_pointer g_call_with_input_file(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_asinh(s7_scheme *sc, s7_double x)
{
- #define H_call_with_input_file "(call-with-input-file filename proc) opens filename and calls proc with the input port as its argument"
-
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-input-file", 1, car(args), "a string (a filename)"));
- if (!is_procedure(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-input-file", 2, cadr(args), "a procedure"));
- if ((is_continuation(cadr(args))) || is_goto(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-input-file", 2, cadr(args), "a normal procedure (not a continuation)"));
-
- return(call_with_input(sc, open_input_file_1(sc, s7_string(car(args)), "r", "call-with-input-file"), args));
+ return(make_real(sc, asinh(x)));
}
+R_P_F_TO_PF(asinh, c_asinh, c_asinh_1, c_asinh_1)
-static s7_pointer with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
+
+/* -------------------------------- acosh -------------------------------- */
+static s7_pointer c_acosh_1(s7_scheme *sc, s7_pointer x)
{
- s7_pointer old_input_port;
- old_input_port = sc->input_port;
- sc->input_port = port;
- sc->input_is_file = (is_file_port(sc->input_port));
-
- push_stack(sc, opcode(OP_UNWIND_INPUT), old_input_port, port);
- sc->code = cadr(args);
- sc->args = sc->NIL;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 1) return(small_int(0));
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
-}
+ case T_REAL:
+ case T_RATIO:
+ {
+ double x1;
+ x1 = real_to_double(sc, x, "acosh");
+ if (x1 >= 1.0)
+ return(make_real(sc, acosh(x1)));
+ }
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ #ifdef __OpenBSD__
+ return(s7_from_c_complex(sc, cacosh_1(s7_to_c_complex(x))));
+ #else
+ return(s7_from_c_complex(sc, cacosh(s7_to_c_complex(x)))); /* not as_c_complex because x might not be complex */
+ #endif
+#else
+ /* since we can fall through to this branch, we need a better error message than "must be a number, not 0.0" */
+ return(out_of_range(sc, sc->ACOSH, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
-static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_with_input_from_string "(with-input-from-string str thunk) opens str as the temporary current-input-port and calls thunk"
-
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "with-input-from-string", 1, car(args), "a string"));
- if (!is_thunk(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, "with-input-from-string", 2, cadr(args), "a thunk"));
-
- /* since the arguments are evaluated before we get here, we can get some confusing situations:
- * (with-input-from-string "#x2.1" (read))
- * (read) -> whatever it can get from the current input port!
- * ";with-input-from-string argument 2, #<eof>, is untyped but should be a thunk"
- */
-
- return(with_input(sc, s7_open_input_string(sc, s7_string(car(args))), args));
+ default:
+ method_or_bust_with_type(sc, x, sc->ACOSH, list_1(sc, x), A_NUMBER, 0);
+ }
}
+static s7_pointer g_acosh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_acosh "(acosh z) returns acosh(z)"
+ #define Q_acosh pcl_n
+ return(c_acosh_1(sc, car(args)));
+}
-static s7_pointer g_with_input_from_file(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_acosh(s7_scheme *sc, s7_double x)
{
- #define H_with_input_from_file "(with-input-from-file filename thunk) opens filename as the temporary current-input-port and calls thunk"
-
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "with-input-from-file", 1, car(args), "a string (a filename)"));
- if (!is_thunk(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, "with-input-from-file", 2, cadr(args), "a thunk"));
-
- return(with_input(sc, open_input_file_1(sc, s7_string(car(args)), "r", "with-input-from-file"), args));
+ if (x >= 1.0)
+ return(make_real(sc, acosh(x)));
+ return(c_acosh_1(sc, set_plist_1(sc, make_real(sc, x))));
}
+R_P_F_TO_PF(acosh, c_acosh, c_acosh_1, c_acosh_1)
-static void char_to_string_port(char c, s7_pointer pt)
+/* -------------------------------- atanh -------------------------------- */
+static s7_pointer c_atanh_1(s7_scheme *sc, s7_pointer x)
{
- if (port_string_point(pt) >= port_string_length(pt))
+ switch (type(x))
{
- int loc;
- loc = port_string_length(pt);
- port_string_length(pt) *= 2;
- port_string(pt) = (char *)realloc(port_string(pt), port_string_length(pt) * sizeof(char));
- memset((void *)(port_string(pt) + loc), 0, loc);
+ case T_INTEGER:
+ if (integer(x) == 0) return(small_int(0)); /* (atanh 0) -> 0 */
+
+ case T_REAL:
+ case T_RATIO:
+ {
+ double x1;
+ x1 = real_to_double(sc, x, "atanh");
+ if (fabs(x1) < 1.0)
+ return(make_real(sc, atanh(x1)));
+ }
+
+ /* if we can't distinguish x from 1.0 even with long doubles, we'll get inf.0:
+ * (atanh 9223372036854775/9223372036854776) -> 18.714973875119
+ * (atanh 92233720368547758/92233720368547757) -> inf.0
+ */
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ #if (defined(__OpenBSD__)) || (defined(__NetBSD__))
+ return(s7_from_c_complex(sc, catanh_1(s7_to_c_complex(x))));
+ #else
+ return(s7_from_c_complex(sc, catanh(s7_to_c_complex(x))));
+ #endif
+#else
+ return(out_of_range(sc, sc->ATANH, small_int(1), x, NO_COMPLEX_NUMBERS));
+#endif
+
+ default:
+ method_or_bust_with_type(sc, x, sc->ATANH, list_1(sc, x), A_NUMBER, 0);
}
- port_string(pt)[port_string_point(pt)++] = c;
}
+static s7_pointer g_atanh(s7_scheme *sc, s7_pointer args)
+{
+ #define H_atanh "(atanh z) returns atanh(z)"
+ #define Q_atanh pcl_n
+ return(c_atanh_1(sc, car(args)));
+}
-static void write_char(s7_scheme *sc, int c, s7_pointer pt)
+static s7_pointer c_atanh(s7_scheme *sc, s7_double x)
{
- if (pt == sc->standard_error)
- fputc(c, stderr);
- else
+ if (fabs(x) < 1.0)
+ return(make_real(sc, atanh(x)));
+ return(c_atanh_1(sc, set_plist_1(sc, make_real(sc, x))));
+}
+
+R_P_F_TO_PF(atanh, c_atanh, c_atanh_1, c_atanh_1)
+
+
+/* -------------------------------- sqrt -------------------------------- */
+static s7_pointer g_sqrt(s7_scheme *sc, s7_pointer args)
+{
+ #define H_sqrt "(sqrt z) returns the square root of z"
+ #define Q_sqrt pcl_n
+
+ s7_pointer n;
+ s7_double sqx;
+
+ n = car(args);
+ switch (type(n))
{
- if (pt == sc->standard_output)
- fputc(c, stdout);
- else
+ case T_INTEGER:
+ if (integer(n) >= 0)
{
- if (port_is_closed(pt))
- return;
- if (is_file_port(pt))
- {
- if (fputc(c, port_file(pt)) == EOF)
- fprintf(stderr, "write to %s: %s\n", port_filename(pt), strerror(errno));
- }
- else
+ s7_int ix;
+ sqx = sqrt((s7_double)integer(n));
+ ix = (s7_int)sqx;
+ if ((ix * ix) == integer(n))
+ return(make_integer(sc, ix));
+ return(make_real(sc, sqx));
+ /* Mark Weaver notes that
+ * (zero? (- (sqrt 9007199136250226) 94906265.0)) -> #t
+ * but (* 94906265 94906265) -> 9007199136250225 -- oops
+ * at least we return a real here, not an incorrect integer and
+ * (sqrt 9007199136250225) -> 94906265
+ */
+ }
+ sqx = (s7_double)integer(n); /* we're trying to protect against (sqrt -9223372036854775808) where we can't negate the integer argument */
+ return(s7_make_complex(sc, 0.0, sqrt((s7_double)(-sqx))));
+
+ case T_RATIO:
+ sqx = (s7_double)fraction(n);
+ if (sqx > 0.0) /* else it's complex, so it can't be a ratio */
+ {
+ s7_int nm = 0, dn = 1;
+ if (c_rationalize(sqx, 1.0e-16, &nm, &dn)) /* 1e-16 so that (sqrt 1/1099511627776) returns 1/1048576 */
{
- if (is_string_port(pt))
- char_to_string_port(c, pt);
- else (*(port_output_function(pt)))(sc, c, pt);
+#if HAVE_OVERFLOW_CHECKS
+ s7_int nm2, dn2;
+ if ((multiply_overflow(nm, nm, &nm2)) ||
+ (multiply_overflow(dn, dn, &dn2)))
+ return(make_real(sc, sqrt(sqx)));
+ if ((nm2 == numerator(n)) &&
+ (dn2 == denominator(n)))
+ return(s7_make_ratio(sc, nm, dn));
+#else
+ if ((nm * nm == numerator(n)) &&
+ (dn * dn == denominator(n)))
+ return(s7_make_ratio(sc, nm, dn));
+#endif
}
+ return(make_real(sc, sqrt(sqx)));
}
+ return(s7_make_complex(sc, 0.0, sqrt(-sqx)));
+
+ case T_REAL:
+ if (is_NaN(real(n)))
+ return(real_NaN);
+ if (real(n) >= 0.0)
+ return(make_real(sc, sqrt(real(n))));
+ return(s7_make_complex(sc, 0.0, sqrt(-real(n))));
+
+ case T_COMPLEX:
+ /* (* inf.0 (sqrt -1)) -> -nan+infi, but (sqrt -inf.0) -> 0+infi */
+#if HAVE_COMPLEX_NUMBERS
+ return(s7_from_c_complex(sc, csqrt(as_c_complex(n))));
+#else
+ return(out_of_range(sc, sc->SQRT, small_int(1), n, NO_COMPLEX_NUMBERS));
+#endif
+
+ default:
+ method_or_bust_with_type(sc, n, sc->SQRT, args, A_NUMBER, 0);
}
}
-static void write_string(s7_scheme *sc, const char *s, s7_pointer pt)
+/* -------------------------------- expt -------------------------------- */
+
+static s7_int int_to_int(s7_int x, s7_int n)
{
- if (!s) return;
-
- if (pt == sc->standard_error)
- fputs(s, stderr);
- else
- {
- if (pt == sc->standard_output)
- fputs(s, stdout);
- else
- {
- if (port_is_closed(pt))
- return;
-
- if (is_file_port(pt))
- {
- if (fputs(s, port_file(pt)) == EOF)
- fprintf(stderr, "write to %s: %s\n", port_filename(pt), strerror(errno));
- }
- else
- {
- if (is_string_port(pt))
- {
- for (; *s; s++)
- char_to_string_port(*s, pt);
- }
- else
- {
- for (; *s; s++)
- (*(port_output_function(pt)))(sc, *s, pt);
- }
- }
- }
- }
+ /* from GSL */
+ s7_int value = 1;
+ do {
+ if (n & 1) value *= x;
+ n >>= 1;
+#if HAVE_OVERFLOW_CHECKS
+ if (multiply_overflow(x, x, &x))
+ break;
+#else
+ x *= x;
+#endif
+ } while (n);
+ return(value);
}
-#define IN_QUOTES true
-#define NOT_IN_QUOTES false
+static const long long int nth_roots[63] = {
+ S7_LLONG_MAX, S7_LLONG_MAX, 3037000499LL, 2097151, 55108, 6208, 1448, 511, 234, 127, 78, 52, 38, 28, 22,
+ 18, 15, 13, 11, 9, 8, 7, 7, 6, 6, 5, 5, 5, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
-static char *slashify_string(const char *p, int len, bool quoted, bool *slashified)
+static const long int_nth_roots[31] = {
+ S7_LONG_MAX, S7_LONG_MAX, 46340, 1290, 215, 73, 35, 21, 14, 10, 8, 7, 5, 5, 4, 4, 3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2};
+
+static bool int_pow_ok(s7_int x, s7_int y)
{
- int i, j = 0, cur_size;
- char *s;
+ if (s7_int_bits > 31)
+ return((y < 63) &&
+ (nth_roots[y] >= s7_int_abs(x)));
+ return((y < 31) &&
+ (int_nth_roots[y] >= s7_int_abs(x)));
+}
- cur_size = len + 256;
- s = (char *)calloc(cur_size + 2, sizeof(char));
- /* this can be non-null even if there's not enough memory, but I think I'll check in the caller */
- if (quoted) s[j++] = '"';
- for (i = 0; i < len; i++)
+static s7_pointer g_expt(s7_scheme *sc, s7_pointer args)
+{
+ #define H_expt "(expt z1 z2) returns z1^z2"
+ #define Q_expt pcl_n
+ s7_pointer n, pw;
+
+ n = car(args);
+ if (!s7_is_number(n))
+ method_or_bust_with_type(sc, n, sc->EXPT, args, A_NUMBER, 1);
+
+ pw = cadr(args);
+ if (!s7_is_number(pw))
+ method_or_bust_with_type(sc, pw, sc->EXPT, args, A_NUMBER, 2);
+
+ /* this provides more than 2 args to expt:
+ * if (is_not_null(cddr(args)))
+ * return(g_expt(sc, list_2(sc, car(args), g_expt(sc, cdr(args)))));
+ *
+ * but it's unusual in scheme to process args in reverse order, and the
+ * syntax by itself is ambiguous (does (expt 2 2 3) = 256 or 64?)
+ */
+
+ if (s7_is_zero(n))
{
- if (slashify_table[((unsigned char)(p[i]))])
+ if (s7_is_zero(pw))
{
- s[j++] = '\\';
- (*slashified) = true;
- switch (p[i])
- {
- case '"':
- s[j++] = '"';
- break;
-
- case '\\':
- s[j++] = '\\';
- break;
-
- default: /* this is the "\x01" stuff */
- {
- unsigned int n;
- static char dignum[] = "0123456789abcdef";
- s[j++] = 'x';
- n = (unsigned int)(p[i]);
- if (n < 16)
- s[j++] = '0';
- else s[j++] = dignum[(n / 16) % 16];
- s[j++] = dignum[n % 16];
- }
- break;
- }
+ if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* (expt 0 0) -> 1 */
+ return(small_int(1));
+ return(real_zero); /* (expt 0.0 0) -> 0.0 */
}
- else s[j++] = p[i];
- if (j >= cur_size) /* even with 256 extra, we can overflow (for example, inordinately many tabs in ALSA output) */
+
+ if (s7_is_real(pw))
{
- int k;
- cur_size *= 2;
- s = (char *)realloc(s, (cur_size + 2) * sizeof(char));
- for (k = j; k < cur_size + 2; k++) s[k] = 0;
- }
- }
- if (quoted) s[j++] = '"';
- return(s);
-}
+ if (s7_is_negative(pw)) /* (expt 0 -1) */
+ return(division_by_zero_error(sc, sc->EXPT, args));
+ /* (Clisp gives divide-by-zero error here, Guile returns inf.0) */
+ if ((!s7_is_rational(pw)) && /* (expt 0 most-positive-fixnum) */
+ (is_NaN(s7_real(pw)))) /* (expt 0 +nan.0) */
+ return(pw);
+ }
+ else
+ { /* (expt 0 a+bi) */
+ if (real_part(pw) < 0.0) /* (expt 0 -1+i) */
+ return(division_by_zero_error(sc, sc->EXPT, args));
+ if ((is_NaN(real_part(pw))) || /* (expt 0 0+1/0i) */
+ (is_NaN(imag_part(pw))))
+ return(real_NaN);
+ }
-static const char *c_closure_name(s7_scheme *sc, s7_pointer closure)
-{
- s7_pointer x;
+ if ((s7_is_integer(n)) && (s7_is_integer(pw))) /* pw != 0, (expt 0 2312) */
+ return(small_int(0));
+ return(real_zero); /* (expt 0.0 123123) */
+ }
- x = find_local_symbol(sc, closure_environment(closure), sc->__FUNC__); /* returns nil if no __func__ */
- if (is_pair(x))
+ if (s7_is_one(pw))
{
- x = symbol_value(x);
- if (s7_is_symbol(x))
- return(symbol_name(x));
- if ((is_pair(x)) &&
- (s7_is_symbol(car(x))))
- return(symbol_name(car(x)));
+ if (s7_is_integer(pw))
+ return(n);
+ if (is_rational(n))
+ return(make_real(sc, rational_to_double(sc, n)));
+ return(n);
}
- return("#<closure>");
-}
-
-
-#define WITH_ELLIPSES false
-static char *atom_to_c_string(s7_scheme *sc, s7_pointer obj, bool use_write)
-{
- switch (type(obj))
+ if (is_t_integer(pw))
{
- case T_BOOLEAN:
- if (obj == sc->T)
- return(copy_string("#t"));
- return(copy_string("#f"));
+ s7_int y;
+ y = integer(pw);
+ if (y == 0)
+ {
+ if (is_rational(n)) /* (expt 3 0) */
+ return(small_int(1));
+ if ((is_NaN(s7_real_part(n))) || /* (expt 1/0 0) -> NaN */
+ (is_NaN(s7_imag_part(n)))) /* (expt (complex 0 1/0) 0) -> NaN */
+ return(n);
+ return(real_one); /* (expt 3.0 0) */
+ }
- case T_NIL:
- return(copy_string("()"));
-
- case T_UNTYPED:
- if (obj == sc->EOF_OBJECT)
- return(copy_string("#<eof>"));
-
- if (obj == sc->UNDEFINED)
- return(copy_string("#<undefined>"));
-
- if ((obj == sc->UNSPECIFIED) || (obj == sc->NO_VALUE))
- return(copy_string("#<unspecified>"));
+ switch (type(n))
+ {
+ case T_INTEGER:
+ {
+ s7_int x;
+ x = s7_integer(n);
+ if (x == 1) /* (expt 1 y) */
+ return(n);
- if (obj == sc->ELSE)
- return(copy_string("else"));
- break;
+ if (x == -1)
+ {
+ if (y == s7_int_min) /* (expt -1 most-negative-fixnum) */
+ return(small_int(1));
- case T_INPUT_PORT:
- case T_OUTPUT_PORT:
- return(describe_port(sc, obj));
+ if (s7_int_abs(y) & 1) /* (expt -1 odd-int) */
+ return(n);
+ return(small_int(1)); /* (expt -1 even-int) */
+ }
- case T_HOOK:
- return(copy_string("#<hook>"));
+ if (y == s7_int_min) /* (expt x most-negative-fixnum) */
+ return(small_int(0));
+ if (x == s7_int_min) /* (expt most-negative-fixnum y) */
+ return(make_real(sc, pow((double)x, (double)y)));
- case T_NUMBER:
- return(number_to_string_base_10(obj, 0, 14, 'g')); /* 20 digits is excessive in this context */
-
- case T_SYMBOL:
- {
- bool slashified = false;
- char *str;
- /* I think this is the only place we print a symbol's name */
- /* return(copy_string_with_len(symbol_name(obj), symbol_name_length(obj))); */
+ if (int_pow_ok(x, s7_int_abs(y)))
+ {
+ if (y > 0)
+ return(make_integer(sc, int_to_int(x, y)));
+ return(s7_make_ratio(sc, 1, int_to_int(x, -y)));
+ }
+ }
+ break;
- str = slashify_string(symbol_name(obj), symbol_name_length(obj), NOT_IN_QUOTES, &slashified);
- if (slashified)
+ case T_RATIO:
{
- char *symstr;
- int len;
- len = safe_strlen(str) + 16;
- symstr = (char *)calloc(len, sizeof(char));
- snprintf(symstr, len, "(symbol \"%s\")", str);
- free(str);
- return(symstr);
- }
- return(str);
- }
+ s7_int nm, dn;
- case T_STRING:
- if (string_length(obj) > 0)
- {
- /* if string_length is enormous, this can cause an eventual segfault.
- * for now, print enough chars to make anyone happy
- */
- int len;
- bool slashified = false;
- len = string_length(obj);
- if (len > (1 << 24))
- len = (1 << 24);
- if (!use_write)
- return(copy_string_with_len(string_value(obj), len));
- return(slashify_string(string_value(obj), len, IN_QUOTES, &slashified));
- }
- if (!use_write)
- return(NULL);
- else return(copy_string("\"\""));
+ nm = numerator(n);
+ dn = denominator(n);
- case T_CHARACTER:
- {
- #define P_SIZE 16
- char *p;
- unsigned char c;
- p = (char *)malloc(P_SIZE * sizeof(char));
- c = (unsigned char)s7_character(obj); /* if not unsigned, (write (integer->char 212) -> #\xffffffd4! */
- if (!use_write)
- {
- p[0]= c;
- p[1]= 0;
- }
- else
- {
- switch (c)
+ if (y == s7_int_min)
{
- case ' ':
- snprintf(p, P_SIZE, "#\\space");
- break;
+ if (s7_int_abs(nm) > dn)
+ return(small_int(0)); /* (expt 4/3 most-negative-fixnum) -> 0? */
+ return(real_infinity); /* (expt 3/4 most-negative-fixnum) -> inf? */
+ }
- case '\n':
- snprintf(p, P_SIZE, "#\\newline");
- break;
+ if ((int_pow_ok(nm, s7_int_abs(y))) &&
+ (int_pow_ok(dn, s7_int_abs(y))))
+ {
+ if (y > 0)
+ return(s7_make_ratio(sc, int_to_int(nm, y), int_to_int(dn, y)));
+ return(s7_make_ratio(sc, int_to_int(dn, -y), int_to_int(nm, -y)));
+ }
+ }
+ break;
+ /* occasionally int^rat can be int but it happens so infrequently it's probably not worth checking
+ * one possibly easy case: (expt 1 1/2) -> 1 (-1?) etc
+ */
- case '\r':
- snprintf(p, P_SIZE, "#\\return");
- break;
+ case T_REAL:
+ /* (expt -1.0 most-positive-fixnum) should be -1.0
+ * (expt -1.0 (+ (expt 2 53) 1)) -> -1.0
+ * (expt -1.0 (- 1 (expt 2 54))) -> -1.0
+ */
+ if (real(n) == -1.0)
+ {
+ if (y == s7_int_min)
+ return(real_one);
- case '\t':
- snprintf(p, P_SIZE, "#\\tab");
- break;
+ if (s7_int_abs(y) & 1)
+ return(n);
+ return(real_one);
+ }
+ break;
- case '\0':
- snprintf(p, P_SIZE, "#\\null");
- break;
+ case T_COMPLEX:
+#if HAVE_COMPLEX_NUMBERS
+ if ((s7_real_part(n) == 0.0) &&
+ ((s7_imag_part(n) == 1.0) ||
+ (s7_imag_part(n) == -1.0)))
+ {
+ bool yp, np;
+ yp = (y > 0);
+ np = (s7_imag_part(n) > 0.0);
+ switch (s7_int_abs(y) % 4)
+ {
+ case 0: return(real_one);
+ case 1: return(s7_make_complex(sc, 0.0, (yp == np) ? 1.0 : -1.0));
+ case 2: return(make_real(sc, -1.0));
+ case 3: return(s7_make_complex(sc, 0.0, (yp == np) ? -1.0 : 1.0));
+ }
+ }
+#else
+ return(out_of_range(sc, sc->EXPT, small_int(2), n, NO_COMPLEX_NUMBERS));
+#endif
+ break;
+ }
+ }
- default:
- if ((c < 32) || (c >= 127))
- snprintf(p, P_SIZE, "#\\x%x", c);
- else snprintf(p, P_SIZE, "#\\%c", c);
- break;
- }
- }
- return(p);
- }
+ if ((s7_is_real(n)) &&
+ (s7_is_real(pw)))
+ {
+ s7_double x, y;
- case T_MACRO:
- case T_BACRO:
- return(copy_string("#<macro>"));
-
- case T_CLOSURE:
- case T_CLOSURE_STAR:
- return(copy_string(c_closure_name(sc, obj)));
-
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- case T_C_LST_ARGS_FUNCTION:
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_FUNCTION:
- return(copy_string(c_function_name(obj)));
+ if ((is_t_ratio(pw)) &&
+ (numerator(pw) == 1))
+ {
+ if (denominator(pw) == 2)
+ return(g_sqrt(sc, args));
+ if (denominator(pw) == 3)
+ return(make_real(sc, cbrt(real_to_double(sc, n, "expt")))); /* (expt 27 1/3) should be 3, not 3.0... */
- case T_C_MACRO:
- return(copy_string(c_macro_name(obj)));
-
- case T_C_POINTER:
- {
- char *str;
- str = (char *)calloc(32, sizeof(char));
- snprintf(str, 32, "#<c_pointer %p>", raw_pointer(obj));
- return(str);
- }
-
- case T_CONTINUATION:
- return(copy_string("#<continuation>"));
-
- case T_GOTO:
- return(copy_string("#<goto>"));
-
- case T_CATCH: /* this can't happen */
- return(copy_string("#<catch>"));
-
- case T_DYNAMIC_WIND: /* this can't happen */
- return(copy_string("#<dynamic-wind>"));
-
- case T_S_OBJECT:
- case T_C_OBJECT:
- return(describe_object(sc, obj)); /* this allocates already */
+ /* but: (expt 512/729 1/3) -> 0.88888888888889
+ */
+ /* and 4 -> sqrt(sqrt...) etc? */
+ }
-#if DEBUGGING
- case T_VECTOR:
- return(copy_string("#<vector>"));
+ x = real_to_double(sc, n, "expt");
+ y = real_to_double(sc, pw, "expt");
- case T_PAIR:
- if (is_environment(obj))
- return(copy_string("#<environment>"));
- return(copy_string("#<pair>"));
-#endif
+ if (is_NaN(x)) return(n);
+ if (is_NaN(y)) return(pw);
+ if (y == 0.0) return(real_one);
- default:
- break;
+ if (x > 0.0)
+ return(make_real(sc, pow(x, y)));
+ /* tricky cases abound here: (expt -1 1/9223372036854775807)
+ */
}
- {
- char *buf;
- buf = (char *)calloc(512, sizeof(char));
- snprintf(buf, 512, "<unknown object! type: %d (%s), flags: %x%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s>",
- type(obj),
- type_name(obj),
- typeflag(obj),
- is_simple(obj) ? " simple" : "",
- is_procedure(obj) ? " procedure" : "",
- is_marked(obj) ? " gc-marked" : "",
- is_immutable(obj) ? " immutable" : "",
- is_syntax(obj) ? " syntax" : "",
- dont_copy(obj) ? " dont-copy" : "",
- dont_copy_cdr(obj) ? " dont-copy-cdr" : "",
- is_finalizable(obj) ? " gc-finalize" : "",
- is_any_macro(obj) ? " anymac" : "",
- is_expansion(obj) ? " expansion" : "",
- is_local(obj) ? " local" : "",
- symbol_accessed(obj) ? " accessed" : "",
- symbol_has_accessor(obj) ? " accessor" : "",
- has_structure(obj) ? " structure" : "",
- is_multiple_value(obj) ? " values" : "",
- is_keyword(obj) ? " keyword" : "",
- is_environment(obj) ? " environment" : "",
- ((typeflag(obj) & UNUSED_BITS) != 0) ? " bad bits!" : "");
-#if DEBUGGING
- if ((saved_typeflag(obj) != typeflag(obj)) &&
- (saved_typeflag(obj) > 0) &&
- (saved_type(obj) < BUILT_IN_TYPES))
- {
- char *descr, *new_buf;
- int old_flag;
- old_flag = typeflag(obj);
- typeflag(obj) = saved_typeflag(obj);
- descr = atom_to_c_string(sc, obj, WITH_ELLIPSES);
- typeflag(obj) = old_flag;
- if (descr)
- {
- int len;
- len = strlen(descr) + strlen(buf) + 32;
- new_buf = (char *)calloc(len, sizeof(char));
- snprintf(new_buf, len, "%s (possibly: %s)", buf, descr);
- free(descr);
- free(buf);
- return(new_buf);
- }
- }
-#endif
- return(buf);
- }
+ /* (expt 0+i 1e+16) = 0.98156860153485-0.19111012657867i ?
+ * (expt 0+i 1+1/0i) = 0.0 ??
+ */
+ return(s7_from_c_complex(sc, cpow(s7_to_c_complex(n), s7_to_c_complex(pw))));
}
-bool s7_is_valid_pointer(s7_pointer arg)
+#if (!WITH_GMP)
+static s7_pointer c_expt_i(s7_scheme *sc, s7_int x, s7_int y)
{
- return((arg) &&
- (type(arg) > T_UNTYPED) && (type(arg) < BUILT_IN_TYPES));
+ if (y == 0) return(small_int(1));
+ if (y == 1) return(make_integer(sc, x));
+ return(g_expt(sc, set_plist_2(sc, make_integer(sc, x), make_integer(sc, y))));
}
+static s7_pointer c_expt_r(s7_scheme *sc, s7_double x, s7_double y)
+{
+ if (y > 0.0)
+ return(make_real(sc, pow(x, y)));
+ return(g_expt(sc, set_plist_2(sc, make_real(sc, x), make_real(sc, y))));
+}
-static int display_multivector(s7_scheme *sc, s7_pointer vec, int out_len, int flat_ref, int dimension, int dimensions, char *out_str, char **elements, char *last)
+static s7_pointer c_expt_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- int i;
+ return(g_expt(sc, set_plist_2(sc, x, y)));
+}
- if (*last == ')')
- strcat(out_str, " ");
+XF2_TO_PF(expt, c_expt_i, c_expt_r, c_expt_2)
+#endif
- strcat(out_str, "(");
- (*last) = '(';
- for (i = 0; i < vector_dimension(vec, dimension); i++)
+/* -------------------------------- lcm -------------------------------- */
+static s7_pointer g_lcm(s7_scheme *sc, s7_pointer args)
+{
+ #define H_lcm "(lcm ...) returns the least common multiple of its rational arguments"
+ #define Q_lcm pcl_f
+
+ s7_int n = 1, d = 0;
+ s7_pointer p;
+
+ if (!is_pair(args))
+ return(small_int(1));
+
+ if (!is_pair(cdr(args)))
{
- if (dimension == (dimensions - 1))
+ if (!is_rational(car(args)))
+ method_or_bust_with_type(sc, car(args), sc->LCM, args, A_RATIONAL, 1);
+ return(g_abs(sc, args));
+ }
+
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ s7_int b;
+ x = car(p);
+ switch (type(x))
{
- if (flat_ref < out_len)
- strcat(out_str, elements[flat_ref++]);
- else
+ case T_INTEGER:
+ if (integer(x) == 0)
+ n = 0;
+ else
{
- strcat(out_str, "...)");
- return(flat_ref);
+ b = integer(x);
+ if (b < 0) b = -b;
+ n = (n / c_gcd(n, b)) * b;
}
- if (i < (vector_dimension(vec, dimension) - 1))
- strcat(out_str, " ");
- }
- else
- {
- if (flat_ref < out_len)
- flat_ref = display_multivector(sc, vec, out_len, flat_ref, dimension + 1, dimensions, out_str, elements, last);
- else
+ if (d != 0) d = 1;
+ break;
+
+ case T_RATIO:
+ b = numerator(x);
+ if (b < 0) b = -b;
+ n = (n / c_gcd(n, b)) * b;
+ if (d == 0)
{
- strcat(out_str, "...)");
- return(flat_ref);
+ if (p == args)
+ d = s7_denominator(x);
+ else d = 1;
}
+ else d = c_gcd(d, s7_denominator(x));
+ break;
+
+ default:
+ method_or_bust_with_type(sc, x, sc->LCM, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), A_RATIONAL, position_of(p, args));
+ }
+ if (n < 0) return(simple_out_of_range(sc, sc->LCM, args, RESULT_IS_TOO_LARGE));
+ if (n == 0)
+ {
+ for (p = cdr(p); is_pair(p); p = cdr(p))
+ if (!is_rational_via_method(sc, car(p)))
+ return(wrong_type_argument_with_type(sc, sc->LCM, position_of(p, args), x, A_RATIONAL));
+ return(small_int(0));
}
}
- strcat(out_str, ")");
- (*last) = ')';
- return(flat_ref);
-}
-
-
-typedef struct {
- s7_pointer *objs;
- int size, top, ref;
- int *refs;
-} shared_info;
-
-#define INITIAL_SHARED_INFO_SIZE 8
-static shared_info *free_shared_info(shared_info *ci)
-{
- if (ci)
- {
- if (ci->objs) free(ci->objs);
- if (ci->refs) free(ci->refs);
- ci->objs = NULL;
- free(ci);
- }
- return(NULL);
+ if (d <= 1)
+ return(make_integer(sc, n));
+ return(s7_make_ratio(sc, n, d));
}
-
-static int shared_ref(shared_info *ci, s7_pointer p)
+static s7_int c_lcm(s7_scheme *sc, s7_int a, s7_int b)
{
- int i;
- for (i = 0; i < ci->top; i++)
- if (ci->objs[i] == p)
- {
- int val;
- val = ci->refs[i];
- if (val > 0)
- ci->refs[i] = -ci->refs[i];
- return(val);
- }
- return(0);
+ if ((a == 0) || (b == 0)) return(0);
+ if (a < 0) a = -a;
+ if (b < 0) b = -b;
+ return((a / c_gcd(a, b)) * b);
}
+IF2_TO_IF(lcm, c_lcm)
-static int peek_shared_ref(shared_info *ci, s7_pointer p)
+
+/* -------------------------------- gcd -------------------------------- */
+static s7_pointer g_gcd(s7_scheme *sc, s7_pointer args)
{
- /* returns 0 if not found, otherwise the ref value for p */
- int i;
- for (i = 0; i < ci->top; i++)
- if (ci->objs[i] == p)
- return(ci->refs[i]);
- return(0);
-}
+ #define H_gcd "(gcd ...) returns the greatest common divisor of its rational arguments"
+ #define Q_gcd pcl_f
+ s7_int n = 0, d = 1;
+ s7_pointer p;
+ if (!is_pair(args))
+ return(small_int(0));
-static void check_shared_info_size(shared_info *ci)
-{
- if (ci->top == ci->size)
+ if (!is_pair(cdr(args)))
{
- int i;
- ci->size *= 2;
- ci->objs = (s7_pointer *)realloc(ci->objs, ci->size * sizeof(s7_pointer));
- ci->refs = (int *)realloc(ci->refs, ci->size * sizeof(int));
- for (i = ci->top; i < ci->size; i++)
+ if (!is_rational(car(args)))
+ method_or_bust_with_type(sc, car(args), sc->GCD, args, A_RATIONAL, 1);
+ return(g_abs(sc, args));
+ }
+
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ s7_int b;
+ x = car(p);
+ switch (type(x))
{
- ci->refs[i] = 0;
- ci->objs[i] = NULL;
+ case T_INTEGER:
+ n = c_gcd(n, integer(x));
+ break;
+
+ case T_RATIO:
+ n = c_gcd(n, s7_numerator(x));
+ b = s7_denominator(x);
+ if (b < 0) b = -b;
+ d = (d / c_gcd(d, b)) * b;
+ if (d < 0) return(simple_out_of_range(sc, sc->GCD, args, RESULT_IS_TOO_LARGE));
+ break;
+
+ default:
+ method_or_bust_with_type(sc, x, sc->GCD, cons(sc, (d <= 1) ? make_integer(sc, n) : s7_make_ratio(sc, n, d), p), A_RATIONAL, position_of(p, args));
}
+ if (n < 0) return(simple_out_of_range(sc, sc->GCD, args, RESULT_IS_TOO_LARGE));
}
+
+ if (d <= 1)
+ return(make_integer(sc, n));
+ return(s7_make_ratio(sc, n, d));
}
+static s7_int c_gcd_1(s7_scheme *sc, s7_int a, s7_int b) {return(c_gcd(a, b));}
-static void add_equal_ref(shared_info *ci, s7_pointer x, s7_pointer y)
-{
- /* assume neither x nor y is in the table, and that they should share a ref value */
- check_shared_info_size(ci);
- ci->ref++;
- ci->objs[ci->top] = x;
- ci->refs[ci->top++] = ci->ref;
- check_shared_info_size(ci);
- ci->objs[ci->top] = y;
- ci->refs[ci->top++] = ci->ref;
-}
+IF2_TO_IF(gcd, c_gcd_1)
-static void add_shared_ref(shared_info *ci, s7_pointer x, int ref_x)
+static s7_pointer s7_truncate(s7_scheme *sc, s7_pointer caller, s7_double xf) /* can't use "truncate" -- it's in unistd.h */
{
- check_shared_info_size(ci);
- ci->objs[ci->top] = x;
- ci->refs[ci->top++] = ref_x;
+ if ((xf > s7_int_max) ||
+ (xf < s7_int_min))
+ return(simple_out_of_range(sc, caller, make_real(sc, xf), ITS_TOO_LARGE));
+
+ if (xf > 0.0)
+ return(make_integer(sc, (s7_int)floor(xf)));
+ return(make_integer(sc, (s7_int)ceil(xf)));
}
+static s7_int c_quo_int(s7_scheme *sc, s7_int x, s7_int y)
+{
+ if (y == 0)
+ division_by_zero_error(sc, sc->QUOTIENT, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)));
+ if ((y == -1) && (x == s7_int_min)) /* (quotient most-negative-fixnum -1) */
+ simple_out_of_range(sc, sc->QUOTIENT, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)), ITS_TOO_LARGE);
+ return(x / y);
+}
-static shared_info *collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top)
+static s7_double c_quo_dbl(s7_scheme *sc, s7_double x, s7_double y)
{
- int i, ref = -1;
+ s7_double xf;
- /* look for top in current list */
- for (i = 0; i < ci->top; i++)
- if (ci->objs[i] == top)
- {
- if (ci->refs[i] == 0)
- ci->refs[i] = ++ci->ref; /* if found, set the ref number */
- ref = ci->refs[i];
- break;
- }
+ if (y == 0.0)
+ division_by_zero_error(sc, sc->QUOTIENT, set_elist_2(sc, make_real(sc, x), make_real(sc, y)));
+ if ((is_inf(y)) || (is_NaN(y)))
+ wrong_type_argument_with_type(sc, sc->QUOTIENT, 2, make_real(sc, y), A_NORMAL_REAL);
- if (ref == -1)
- {
- /* top not found -- add it to the list */
- check_shared_info_size(ci);
- ci->objs[ci->top++] = top;
+ xf = x / y;
+ if ((xf > s7_int_max) ||
+ (xf < s7_int_min))
+ simple_out_of_range(sc, sc->QUOTIENT, make_real(sc, xf), ITS_TOO_LARGE);
- /* now search the rest of this structure */
- if (is_pair(top))
- {
- if (has_structure(car(top)))
- collect_shared_info(sc, ci, car(top));
- if (has_structure(cdr(top)))
- collect_shared_info(sc, ci, cdr(top));
- }
- else
- {
- int i, plen;
- plen = s7_vector_print_length(sc);
- if (plen > vector_length(top))
- plen = vector_length(top);
- for (i = 0; i < plen; i++)
- if (has_structure(vector_element(top, i)))
- collect_shared_info(sc, ci, vector_element(top, i));
- }
- }
- return(ci);
+ if (xf > 0.0)
+ return(floor(xf));
+ return(ceil(xf));
}
-
-static shared_info *new_shared_info(void)
+static s7_pointer g_quotient(s7_scheme *sc, s7_pointer args)
{
- shared_info *ci;
- ci = (shared_info *)calloc(1, sizeof(shared_info));
- ci->top = 0;
- ci->ref = 0;
- ci->size = INITIAL_SHARED_INFO_SIZE;
- ci->objs = (s7_pointer *)malloc(ci->size * sizeof(s7_pointer));
- ci->refs = (int *)calloc(ci->size, sizeof(int)); /* finder expects 0 = unseen previously */
- return(ci);
-}
+ #define H_quotient "(quotient x1 x2) returns the integer quotient of x1 and x2; (quotient 4 3) = 1"
+ #define Q_quotient pcl_r
+ /* (define (quo x1 x2) (truncate (/ x1 x2))) ; slib
+ */
+ s7_pointer x, y;
+ s7_int d1, d2, n1, n2;
+ x = car(args);
+ y = cadr(args);
-static shared_info *make_shared_info(s7_scheme *sc, s7_pointer top)
-{
- shared_info *ci;
- int i, refs;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ return(make_integer(sc, c_quo_int(sc, integer(x), integer(y))));
+
+ case T_RATIO:
+ n1 = integer(x);
+ d1 = 1;
+ n2 = numerator(y);
+ d2 = denominator(y);
+ goto RATIO_QUO_RATIO;
+
+ case T_REAL:
+ if (real(y) == 0.0)
+ return(division_by_zero_error(sc, sc->QUOTIENT, args));
+ if ((is_inf(real(y))) || (is_NaN(real(y))))
+ return(wrong_type_argument_with_type(sc, sc->QUOTIENT, 2, y, A_NORMAL_REAL));
+ return(s7_truncate(sc, sc->QUOTIENT, (s7_double)integer(x) / real(y)));
- ci = new_shared_info();
+ default:
+ method_or_bust(sc, y, sc->QUOTIENT, args, T_REAL, 2);
+ }
- /* collect all pointers associated with top */
- collect_shared_info(sc, ci, top);
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0)
+ return(division_by_zero_error(sc, sc->QUOTIENT, args));
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = integer(y);
+ d2 = 1;
+ goto RATIO_QUO_RATIO;
+ /* this can lose:
+ * (quotient 1 2305843009213693952/4611686018427387903) -> 2, not 1
+ * (quotient 21053343141/6701487259 3587785776203/1142027682075) -> 1, not 0
+ */
- /* find if any were referenced twice */
- for (i = 0, refs = 0; i < ci->top; i++)
- if (ci->refs[i] > 0)
- {
- if (i == refs)
- refs++;
- else
+ case T_RATIO:
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = numerator(y);
+ d2 = denominator(y);
+ RATIO_QUO_RATIO:
+ if (d1 == d2)
+ return(make_integer(sc, n1 / n2)); /* (quotient 3/9223372036854775807 1/9223372036854775807) */
+ if (n1 == n2)
+ return(make_integer(sc, d2 / d1)); /* (quotient 9223372036854775807/2 9223372036854775807/8) */
+#if HAVE_OVERFLOW_CHECKS
{
- ci->objs[refs] = ci->objs[i];
- ci->refs[refs++] = ci->refs[i];
+ s7_int n1d2, n2d1;
+ if ((multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)))
+ return(s7_truncate(sc, sc->QUOTIENT, ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1)));
+ return(make_integer(sc, n1d2 / n2d1));
}
- }
- ci->top = refs;
+#else
+ if ((integer_length(n1) + integer_length(d2) >= s7_int_bits) ||
+ (integer_length(n2) + integer_length(d1) >= s7_int_bits))
+ return(s7_truncate(sc, sc->QUOTIENT, ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1)));
+ return(make_integer(sc, (n1 * d2) / (n2 * d1)));
+#endif
- if (refs == 0)
- {
- free_shared_info(ci);
- return(NULL);
- }
- return(ci);
-}
+ case T_REAL:
+ if (real(y) == 0.0)
+ return(division_by_zero_error(sc, sc->QUOTIENT, args));
+ if ((is_inf(real(y))) || (is_NaN(real(y))))
+ return(wrong_type_argument_with_type(sc, sc->QUOTIENT, 2, y, A_NORMAL_REAL));
+ return(s7_truncate(sc, sc->QUOTIENT, (s7_double)fraction(x) / real(y)));
+
+ default:
+ method_or_bust(sc, y, sc->QUOTIENT, args, T_REAL, 2);
+ }
+ case T_REAL:
+ if ((is_inf(real(x))) || (is_NaN(real(x))))
+ return(wrong_type_argument_with_type(sc, sc->QUOTIENT, 1, x, A_NORMAL_REAL));
+ /* if infs allowed we need to return infs/nans, else:
+ * (quotient inf.0 1e-309) -> -9223372036854775808
+ * (quotient inf.0 inf.0) -> -9223372036854775808
+ */
-static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, bool to_file, shared_info *ci);
-static char *hash_table_to_c_string(s7_scheme *sc, s7_pointer hash, bool to_file, shared_info *ci);
-static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, shared_info *ci);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0)
+ return(division_by_zero_error(sc, sc->QUOTIENT, args));
+ return(s7_truncate(sc, sc->QUOTIENT, real(x) / (s7_double)integer(y)));
-static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, bool use_write, bool to_file, shared_info *ci)
-{
- if (s7_is_vector(obj))
- return(vector_to_c_string(sc, obj, to_file, ci));
+ case T_RATIO:
+ return(s7_truncate(sc, sc->QUOTIENT, real(x) / (s7_double)fraction(y)));
- if (s7_is_hash_table(obj))
- return(hash_table_to_c_string(sc, obj, to_file, ci));
+ case T_REAL:
+ return(make_real(sc, c_quo_dbl(sc, real(x), real(y))));
- if (is_pair(obj))
- return(list_to_c_string(sc, obj, ci));
+ default:
+ method_or_bust(sc, y, sc->QUOTIENT, args, T_REAL, 2);
+ }
- return(atom_to_c_string(sc, obj, use_write));
+ default:
+ method_or_bust(sc, x, sc->QUOTIENT, args, T_REAL, 2);
+ }
}
-static char *object_to_c_string_with_circle_check(s7_scheme *sc, s7_pointer vr, bool use_write, bool to_file, shared_info *ci)
+IF2_TO_IF(quotient, c_quo_int)
+RF2_TO_RF(quotient, c_quo_dbl)
+
+
+static s7_int c_rem_int(s7_scheme *sc, s7_int x, s7_int y)
{
- if (ci)
- {
- int ref;
- ref = shared_ref(ci, vr);
- if (ref != 0)
- {
- char *name;
- if (ref > 0)
- {
- char *element;
- element = s7_object_to_c_string_1(sc, vr, USE_WRITE, WITH_ELLIPSES, ci);
- name = (char *)calloc(strlen(element) + 32, sizeof(char));
- sprintf(name, "#%d=%s", ref, element);
- free(element);
- return(name);
- }
- else
- {
- name = (char *)calloc(32, sizeof(char));
- snprintf(name, 32, "#%d#", -ref);
- return(name);
- }
- }
- }
- return(s7_object_to_c_string_1(sc, vr, use_write, to_file, ci));
+ if (y == 0)
+ division_by_zero_error(sc, sc->REMAINDER, set_elist_2(sc, make_integer(sc, x), make_integer(sc, y)));
+ if ((y == 1) || (y == -1)) /* (remainder most-negative-fixnum -1) will segfault with arithmetic exception */
+ return(0);
+ return(x % y);
}
+static s7_double c_rem_dbl(s7_scheme *sc, s7_double x, s7_double y)
+{
+ s7_int quo;
+ s7_double pre_quo;
+ if (y == 0.0)
+ division_by_zero_error(sc, sc->REMAINDER, set_elist_2(sc, make_real(sc, x), make_real(sc, y)));
+ if ((is_inf(y)) || (is_NaN(y)))
+ wrong_type_argument_with_type(sc, sc->REMAINDER, 2, set_elist_1(sc, make_real(sc, y)), A_NORMAL_REAL);
+
+ pre_quo = x / y;
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ simple_out_of_range(sc, sc->REMAINDER, set_elist_2(sc, make_real(sc, x), make_real(sc, y)), ITS_TOO_LARGE);
+ if (pre_quo > 0.0)
+ quo = (s7_int)floor(pre_quo);
+ else quo = (s7_int)ceil(pre_quo);
+ return(x - (y * quo));
+}
-static char *vector_to_c_string(s7_scheme *sc, s7_pointer vect, bool to_file, shared_info *ci)
+static s7_pointer g_remainder(s7_scheme *sc, s7_pointer args)
{
- s7_Int i, len, bufsize = 0;
- bool too_long = false;
- char **elements = NULL;
- char *buf;
-
- len = vector_length(vect);
- if (len == 0)
+ #define H_remainder "(remainder x1 x2) returns the remainder of x1/x2; (remainder 10 3) = 1"
+ #define Q_remainder pcl_r
+ /* (define (rem x1 x2) (- x1 (* x2 (quo x1 x2)))) ; slib */
+
+ s7_pointer x, y;
+ s7_int quo, d1, d2, n1, n2;
+ s7_double pre_quo;
+
+ x = car(args);
+ y = cadr(args);
+
+ switch (type(x))
{
- if (vector_is_multidimensional(vect))
+ case T_INTEGER:
+ switch (type(y))
{
- buf = (char *)calloc(16, sizeof(char));
- snprintf(buf, 16, "#%dD()", vector_ndims(vect));
- return(buf);
- }
- else return(copy_string("#()"));
- }
-
- if (!to_file)
- {
- int plen;
- /* if to_file we ignore *vector-print-length* so a subsequent read will be ok
- *
- * (with-output-to-file "test.test"
- * (lambda ()
- * (let ((vect (make-vector (+ *vector-print-length* 2) 1.0)))
- * (write vect))))
- */
+ case T_INTEGER:
+ return(make_integer(sc, c_rem_int(sc, integer(x), integer(y))));
+
+ case T_RATIO:
+ n1 = integer(x);
+ d1 = 1;
+ n2 = numerator(y);
+ d2 = denominator(y);
+ goto RATIO_REM_RATIO;
+
+ case T_REAL:
+ if (real(y) == 0.0)
+ return(division_by_zero_error(sc, sc->REMAINDER, args));
+ if ((is_inf(real(y))) || (is_NaN(real(y))))
+ return(wrong_type_argument_with_type(sc, sc->REMAINDER, 2, y, A_NORMAL_REAL));
+
+ pre_quo = (s7_double)integer(x) / real(y);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->REMAINDER, args, ITS_TOO_LARGE));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ return(make_real(sc, integer(x) - real(y) * quo));
- plen = s7_vector_print_length(sc);
- if (plen <= 0)
- return(copy_string("#(...)"));
+ default:
+ method_or_bust(sc, y, sc->REMAINDER, args, T_REAL, 2);
+ }
- if (len > plen)
+ case T_RATIO:
+ switch (type(y))
{
- too_long = true;
- len = plen;
- }
- }
+ case T_INTEGER:
+ n2 = integer(y);
+ if (n2 == 0)
+ return(division_by_zero_error(sc, sc->REMAINDER, args));
+ n1 = numerator(x);
+ d1 = denominator(x);
+ d2 = 1;
+ goto RATIO_REM_RATIO;
+
+ case T_RATIO:
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = numerator(y);
+ d2 = denominator(y);
+ RATIO_REM_RATIO:
+ if (d1 == d2)
+ quo = (s7_int)(n1 / n2);
+ else
+ {
+ if (n1 == n2)
+ quo = (s7_int)(d2 / d1);
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ s7_int n1d2, n2d1;
+ if ((multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)))
+ {
+ pre_quo = ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->REMAINDER, args, ITS_TOO_LARGE));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ }
+ else quo = n1d2 / n2d1;
+#else
+ if ((integer_length(n1) + integer_length(d2) >= s7_int_bits) ||
+ (integer_length(n2) + integer_length(d1) >= s7_int_bits))
+ {
+ pre_quo = ((long double)n1 / (long double)n2) * ((long double)d2 / (long double)d1);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->REMAINDER, args, ITS_TOO_LARGE));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ }
+ else quo = (n1 * d2) / (n2 * d1);
+#endif
+ }
+ }
+ if (quo == 0)
+ return(x);
- elements = (char **)malloc(len * sizeof(char *));
- for (i = 0; i < len; i++)
- {
- elements[i] = object_to_c_string_with_circle_check(sc, vector_element(vect, i), USE_WRITE, WITH_ELLIPSES, ci);
- bufsize += safe_strlen(elements[i]);
- }
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int dn, nq;
+ if (!multiply_overflow(n2, quo, &nq))
+ {
+ if ((d1 == d2) &&
+ (!subtract_overflow(n1, nq, &dn)))
+ return(s7_make_ratio(sc, dn, d1));
+
+ if ((!multiply_overflow(n1, d2, &dn)) &&
+ (!multiply_overflow(nq, d1, &nq)) &&
+ (!subtract_overflow(dn, nq, &nq)) &&
+ (!multiply_overflow(d1, d2, &d1)))
+ return(s7_make_ratio(sc, nq, d1));
+ }
+ }
+#else
+ if ((d1 == d2) &&
+ ((integer_length(n2) + integer_length(quo)) < s7_int_bits))
+ return(s7_make_ratio(sc, n1 - n2 * quo, d1));
+
+ if ((integer_length(n1) + integer_length(d2) < s7_int_bits) &&
+ (integer_length(d1) + integer_length(d2) < s7_int_bits) &&
+ (integer_length(n2) + integer_length(d1) + integer_length(quo) < s7_int_bits))
+ return(s7_make_ratio(sc, n1 * d2 - n2 * d1 * quo, d1 * d2));
+#endif
+ return(simple_out_of_range(sc, sc->REMAINDER, args, make_string_wrapper(sc, "intermediate (a/b) is too large")));
- if (vector_is_multidimensional(vect))
- {
- char c;
+ case T_REAL:
+ {
+ s7_double frac;
+ if (real(y) == 0.0)
+ return(division_by_zero_error(sc, sc->REMAINDER, args));
+ if ((is_inf(real(y))) || (is_NaN(real(y))))
+ return(wrong_type_argument_with_type(sc, sc->REMAINDER, 2, y, A_NORMAL_REAL));
+ frac = (s7_double)fraction(x);
+ pre_quo = frac / real(y);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->REMAINDER, args, ITS_TOO_LARGE));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ return(make_real(sc, frac - real(y) * quo));
+ }
- bufsize += (len * 4 * vector_ndims(vect) + 256);
- buf = (char *)malloc(bufsize * sizeof(char));
+ default:
+ method_or_bust(sc, y, sc->REMAINDER, args, T_REAL, 2);
+ }
- c = '#';
- if (vector_ndims(vect) > 1)
- snprintf(buf, bufsize, "#%dD", vector_ndims(vect));
- else snprintf(buf, bufsize, "#");
+ case T_REAL:
+ if ((is_inf(real(x))) || (is_NaN(real(x))))
+ return(wrong_type_argument_with_type(sc, sc->REMAINDER, 1, x, A_NORMAL_REAL));
- display_multivector(sc, vect, len, 0, 0, vector_ndims(vect), buf, elements, &c);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0)
+ return(division_by_zero_error(sc, sc->REMAINDER, args));
+ pre_quo = real(x) / (s7_double)integer(y);
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->REMAINDER, args, ITS_TOO_LARGE));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ return(make_real(sc, real(x) - integer(y) * quo));
+ /* but... (remainder 1e+18 9223372036854775807) -> 1e+18 */
+
+ case T_RATIO:
+ {
+ /* bad cases here start around 1e16: (remainder 1e15 3/13) -> 0.0 with loss of digits earlier
+ * would long double help?
+ */
+ s7_double frac;
+ frac = (s7_double)fraction(y);
+ pre_quo = real(x) / frac;
+ if ((pre_quo > s7_int_max) || (pre_quo < s7_int_min))
+ return(simple_out_of_range(sc, sc->REMAINDER, args, ITS_TOO_LARGE));
+ if (pre_quo > 0.0) quo = (s7_int)floor(pre_quo); else quo = (s7_int)ceil(pre_quo);
+ return(make_real(sc, real(x) - frac * quo));
+ }
- for (i = 0; i < len; i++)
- free(elements[i]);
- free(elements);
- return(buf);
- }
+ case T_REAL:
+ return(make_real(sc, c_rem_dbl(sc, real(x), real(y))));
- bufsize += (len * 4 + 256); /* might be 2 parens per element + space, so at least len*4 here */
- buf = (char *)malloc(bufsize * sizeof(char));
+ /* see under sin -- this calculation is completely bogus if "a" is large
+ * (quotient 1e22 (* 2 pi)) -> -9223372036854775808 -- should this return arithmetic-overflow?
+ * but it should be 1591549430918953357688,
+ * (remainder 1e22 (* 2 pi)) -> 1.0057952155665e+22
+ * -- the "remainder" is greater than the original argument!
+ * Clisp gives 0.0 here, as does sbcl
+ * currently s7 throws an error (out-of-range).
+ */
- sprintf(buf, "#(");
- for (i = 0; i < len - 1; i++)
- {
- if (elements[i])
- {
- strcat(buf, elements[i]);
- free(elements[i]);
- strcat(buf, " ");
+ default:
+ method_or_bust(sc, y, sc->REMAINDER, args, T_REAL, 2);
}
- }
- if (elements[len - 1])
- {
- strcat(buf, elements[len - 1]);
- free(elements[len - 1]);
+ default:
+ method_or_bust(sc, x, sc->REMAINDER, args, T_REAL, 1);
}
-
- free(elements);
- if (too_long)
- strcat(buf, " ...");
- strcat(buf, ")");
- return(buf);
}
+IF2_TO_IF(remainder, c_rem_int)
+RF2_TO_RF(remainder, c_rem_dbl)
-static s7_pointer vector_or_hash_table_to_string(s7_scheme *sc, s7_pointer vect)
-{
- s7_pointer result;
- shared_info *ci = NULL;
- ci = make_shared_info(sc, vect);
- result = make_string_uncopied(sc, object_to_c_string_with_circle_check(sc, vect, USE_WRITE, WITH_ELLIPSES, ci));
- if (ci) free_shared_info(ci);
- return(result);
-}
+/* -------------------------------- floor -------------------------------- */
+
+#define REAL_TO_INT_LIMIT 9.2233727815085e+18
+/* unfortunately, this limit is only a max in a sense: (ceiling 9223372036854770.9) => 9223372036854770
+ * see s7test for more examples
+ */
+
+static s7_pointer g_floor(s7_scheme *sc, s7_pointer args)
+{
+ #define H_floor "(floor x) returns the integer closest to x toward -inf"
+ #define Q_floor s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_REAL)
-static int circular_list_entries(s7_pointer lst)
-{
- int i;
s7_pointer x;
- for (i = 1, x = cdr(lst); ; i++, x = cdr(x))
+
+ x = car(args);
+ switch (type(x))
{
- int j;
- s7_pointer y;
- for (y = lst, j = 0; j < i; y = cdr(y), j++)
- if (x == y)
- return(i + 1);
+ case T_INTEGER:
+ return(x);
+
+ case T_RATIO:
+ {
+ s7_int val;
+ val = numerator(x) / denominator(x);
+ /* C "/" truncates? -- C spec says "truncation toward 0" */
+ /* we're avoiding "floor" here because the int->double conversion introduces inaccuracies for big numbers */
+ if (numerator(x) < 0) /* not "val" because it might be truncated to 0 */
+ return(make_integer(sc, val - 1));
+ return(make_integer(sc, val));
+ }
+
+ case T_REAL:
+ {
+ s7_double z;
+ z = real(x);
+ if (is_NaN(z))
+ return(simple_out_of_range(sc, sc->FLOOR, x, ITS_NAN));
+ if (fabs(z) > REAL_TO_INT_LIMIT)
+ return(simple_out_of_range(sc, sc->FLOOR, x, ITS_TOO_LARGE));
+ return(make_integer(sc, (s7_int)floor(z)));
+ /* floor here rounds down, whereas a straight int<=real coercion apparently rounds towards 0 */
+ }
+
+ case T_COMPLEX:
+ default:
+ method_or_bust(sc, x, sc->FLOOR, args, T_REAL, 0);
}
}
+static s7_int c_floor(s7_scheme *sc, s7_double x) {return((s7_int)floor(x));}
+RF_TO_IF(floor, c_floor)
-static char *list_to_c_string(s7_scheme *sc, s7_pointer lst, shared_info *ci)
+
+/* -------------------------------- ceiling -------------------------------- */
+static s7_pointer g_ceiling(s7_scheme *sc, s7_pointer args)
{
+ #define H_ceiling "(ceiling x) returns the integer closest to x toward inf"
+ #define Q_ceiling s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_REAL)
+
s7_pointer x;
- int i, len, true_len, bufsize = 0, start = 0;
- char **elements = NULL;
- char *buf;
- true_len = s7_list_length(sc, lst);
- if (true_len < 0) /* a dotted list -- handle cars, then final cdr */
- len = (-true_len + 1);
- else
+ x = car(args);
+ switch (type(x))
{
- if (true_len == 0) /* either '() or a circular list */
- {
- if (lst != sc->NIL)
- len = circular_list_entries(lst);
- else return(copy_string("()"));
- }
- else len = true_len;
- }
+ case T_INTEGER:
+ return(x);
- elements = (char **)calloc(len, sizeof(char *));
+ case T_RATIO:
+ {
+ s7_int val;
+ val = numerator(x) / denominator(x);
+ if (numerator(x) < 0)
+ return(make_integer(sc, val));
+ return(make_integer(sc, val + 1));
+ }
- for (x = lst, i = 0; (x != sc->NIL) && (i < len); i++, x = cdr(x))
- {
- if (is_pair(x))
- {
- if ((ci) && (i != 0) && (peek_shared_ref(ci, x) != 0))
- {
- elements[i] = object_to_c_string_with_circle_check(sc, x, USE_WRITE, WITH_ELLIPSES, ci);
- len = i + 1;
- bufsize += safe_strlen(elements[i]);
- break;
- }
- else elements[i] = object_to_c_string_with_circle_check(sc, car(x), USE_WRITE, WITH_ELLIPSES, ci);
- }
- else
- {
- elements[i] = object_to_c_string_with_circle_check(sc, x, USE_WRITE, WITH_ELLIPSES, ci);
- len = i + 1;
- bufsize += safe_strlen(elements[i]);
- break;
- }
- bufsize += safe_strlen(elements[i]);
- }
-
- bufsize += (256 + len * 2); /* len spaces */
- if (ci) bufsize += (ci->top * 16);
- buf = (char *)malloc(bufsize * sizeof(char));
-
- if ((car(lst) == sc->QUOTE) &&
- (true_len == 2))
- {
- /* len == 1 is important, otherwise (list 'quote 1 2) -> '1 2 which looks weird
- * or (object->string (apply . `''1)) -> "'quote 1"
- * so (quote x) = 'x but (quote x y z) should be left alone (if evaluated, it's an error)
- *
- * in CL:
- * [2]> (list 'quote 1 2)
- * (QUOTE 1 2)
- * [3]> (list 'quote 1)
- * '1
- * [4]> (cons 'quote 1)
- * (QUOTE . 1)
- *
- * in s7:
- * :(list 'quote 1 2)
- * (quote 1 2)
- * :(list 'quote 1)
- * '1
- * :(cons 'quote 1)
- * (quote . 1)
- */
- sprintf(buf, "'");
- start = 1;
- }
- else sprintf(buf, "(");
- if (is_multiple_value(lst))
- strcat(buf, "values ");
+ case T_REAL:
+ {
+ s7_double z;
+ z = real(x);
+ if (is_NaN(z))
+ return(simple_out_of_range(sc, sc->CEILING, x, ITS_NAN));
+ if ((is_inf(z)) ||
+ (z > REAL_TO_INT_LIMIT) ||
+ (z < -REAL_TO_INT_LIMIT))
+ return(simple_out_of_range(sc, sc->CEILING, x, ITS_TOO_LARGE));
+ return(make_integer(sc, (s7_int)ceil(real(x))));
+ }
- for (i = start; i < len - 1; i++)
- {
- if (elements[i])
- {
- strcat(buf, elements[i]);
- strcat(buf, " ");
- }
+ case T_COMPLEX:
+ default:
+ method_or_bust(sc, x, sc->CEILING, args, T_REAL, 0);
}
+}
+
+static s7_int c_ceiling(s7_scheme *sc, s7_double x) {return((s7_int)ceil(x));}
+RF_TO_IF(ceiling, c_ceiling)
+
- if (x != sc->NIL)
- strcat(buf, ". ");
+/* -------------------------------- truncate -------------------------------- */
+static s7_pointer g_truncate(s7_scheme *sc, s7_pointer args)
+{
+ #define H_truncate "(truncate x) returns the integer closest to x toward 0"
+ #define Q_truncate s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_REAL)
- if (elements[len - 1])
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
{
- strcat(buf, elements[len - 1]);
- if ((car(lst) != sc->QUOTE) ||
- (true_len != 2))
- strcat(buf, ")");
- }
+ case T_INTEGER:
+ return(x);
- for (i = 0; i < len; i++)
- if (elements[i])
- free(elements[i]);
- free(elements);
- return(buf);
-}
+ case T_RATIO:
+ return(make_integer(sc, (s7_int)(numerator(x) / denominator(x)))); /* C "/" already truncates */
+ case T_REAL:
+ {
+ s7_double z;
+ z = real(x);
+ if (is_NaN(z))
+ return(simple_out_of_range(sc, sc->TRUNCATE, x, ITS_NAN));
+ if (is_inf(z))
+ return(simple_out_of_range(sc, sc->TRUNCATE, x, ITS_INFINITE));
+ return(s7_truncate(sc, sc->TRUNCATE, real(x)));
+ }
-static s7_pointer list_as_string(s7_scheme *sc, s7_pointer lst)
-{
- s7_pointer result;
- shared_info *ci;
- ci = make_shared_info(sc, lst);
- result = make_string_uncopied(sc, object_to_c_string_with_circle_check(sc, lst, USE_WRITE, WITH_ELLIPSES, ci));
- if (ci) free_shared_info(ci);
- return(result);
+ case T_COMPLEX:
+ default:
+ method_or_bust(sc, x, sc->TRUNCATE, args, T_REAL, 0);
+ }
}
-
-char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj)
+static s7_int c_trunc(s7_scheme *sc, s7_double x)
{
- char *result;
- shared_info *ci = NULL;
- if (has_structure(obj))
- ci = make_shared_info(sc, obj);
- result = object_to_c_string_with_circle_check(sc, obj, USE_WRITE, WITH_ELLIPSES, ci);
- if (ci) free_shared_info(ci);
- return(result);
+ if ((x > s7_int_max) || (x < s7_int_min))
+ simple_out_of_range(sc, sc->TRUNCATE, make_real(sc, x), ITS_TOO_LARGE);
+ if (x > 0.0)
+ return((s7_int)floor(x));
+ return((s7_int)ceil(x));
}
+RF_TO_IF(truncate, c_trunc)
+
-s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer obj, bool use_write)
+/* -------------------------------- round -------------------------------- */
+static s7_double round_per_R5RS(s7_double x)
{
- char *str;
- if ((s7_is_vector(obj)) ||
- (s7_is_hash_table(obj)))
- return(vector_or_hash_table_to_string(sc, obj));
+ s7_double fl, ce, dfl, dce;
- if (is_pair(obj))
- return(list_as_string(sc, obj));
+ fl = floor(x);
+ ce = ceil(x);
+ dfl = x - fl;
+ dce = ce - x;
- str = atom_to_c_string(sc, obj, use_write);
- if (str)
- return(make_string_uncopied(sc, str));
- return(s7_make_string_with_length(sc, "", 0));
- /* else segfault in (string->symbol (object->string "" #f))
- * this can't be optimized to make_string_uncopied -- gc trouble (attempt to free unallocated pointer)
- */
+ if (dfl > dce) return(ce);
+ if (dfl < dce) return(fl);
+ if (fmod(fl, 2.0) == 0.0) return(fl);
+ return(ce);
}
-
-void s7_newline(s7_scheme *sc, s7_pointer port)
+static s7_pointer g_round(s7_scheme *sc, s7_pointer args)
{
- write_char(sc, '\n', port);
-}
-
+ #define H_round "(round x) returns the integer closest to x"
+ #define Q_round s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_REAL)
-static s7_pointer g_newline(s7_scheme *sc, s7_pointer args)
-{
- #define H_newline "(newline (port (current-output-port))) writes a carriage return to the port"
- s7_pointer port;
-
- if (args != sc->NIL)
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
{
- port = car(args);
- if (!is_output_port(port))
- return(s7_wrong_type_arg_error(sc, "newline", 0, port, "an output port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "newline", 0, port, "an open output port"));
- }
- else port = sc->output_port;
-
- s7_newline(sc, port);
- return(sc->UNSPECIFIED);
-}
+ case T_INTEGER:
+ return(x);
+ case T_RATIO:
+ {
+ s7_int truncated, remains;
+ long double frac;
-void s7_write_char(s7_scheme *sc, int c, s7_pointer port)
-{
- write_char(sc, c, port);
-}
+ truncated = numerator(x) / denominator(x);
+ remains = numerator(x) % denominator(x);
+ frac = s7_fabsl((long double)remains / (long double)denominator(x));
+ if ((frac > 0.5) ||
+ ((frac == 0.5) &&
+ (truncated % 2 != 0)))
+ {
+ if (numerator(x) < 0)
+ return(make_integer(sc, truncated - 1));
+ return(make_integer(sc, truncated + 1));
+ }
+ return(make_integer(sc, truncated));
+ }
-static s7_pointer g_write_char(s7_scheme *sc, s7_pointer args)
-{
- #define H_write_char "(write-char char (port (current-output-port))) writes char to the output port"
- s7_pointer port;
-
- if (!s7_is_character(car(args)))
- return(s7_wrong_type_arg_error(sc, "write-char", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "a character"));
-
- if (is_pair(cdr(args)))
- {
- port = cadr(args);
- if (!is_output_port(port))
- return(s7_wrong_type_arg_error(sc, "write-char port", 2, port, "an output port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "write-char port", 2, port, "an open output port"));
+ case T_REAL:
+ {
+ s7_double z;
+ z = real(x);
+ if (is_NaN(z))
+ return(simple_out_of_range(sc, sc->ROUND, x, ITS_NAN));
+ if ((is_inf(z)) ||
+ (z > REAL_TO_INT_LIMIT) ||
+ (z < -REAL_TO_INT_LIMIT))
+ return(simple_out_of_range(sc, sc->ROUND, x, ITS_TOO_LARGE));
+ return(make_integer(sc, (s7_int)round_per_R5RS(z)));
+ }
+
+ case T_COMPLEX:
+ default:
+ method_or_bust(sc, x, sc->ROUND, args, T_REAL, 0);
}
- else port = sc->output_port;
- s7_write_char(sc, s7_character(car(args)), port);
- return(sc->UNSPECIFIED);
}
+static s7_int c_round(s7_scheme *sc, s7_double x) {return((s7_int)round_per_R5RS(x));}
+RF_TO_IF(round, c_round)
+
-static void write_or_display(s7_scheme *sc, s7_pointer obj, s7_pointer port, bool use_write)
+static s7_int c_mod(s7_scheme *sc, s7_int x, s7_int y)
{
- char *val;
- shared_info *ci = NULL;
- if (has_structure(obj))
- ci = make_shared_info(sc, obj);
- val = object_to_c_string_with_circle_check(sc, obj, use_write, is_file_port(port), ci);
- write_string(sc, val, port);
- if (ci) free_shared_info(ci);
- if (val) free(val);
+ s7_int z;
+ /* if (y == 0) return(x); */ /* else arithmetic exception, but we're checking for this elsewhere */
+ z = x % y;
+ if (((y < 0) && (z > 0)) ||
+ ((y > 0) && (z < 0)))
+ return(z + y);
+ return(z);
}
-
-void s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+static s7_pointer g_modulo(s7_scheme *sc, s7_pointer args)
{
- write_or_display(sc, obj, port, USE_WRITE);
-}
+ #define H_modulo "(modulo x1 x2) returns x1 mod x2; (modulo 4 3) = 1. The arguments can be real numbers."
+ #define Q_modulo pcl_r
+ /* (define (mod x1 x2) (- x1 (* x2 (floor (/ x1 x2))))) from slib
+ * (mod x 0) = x according to "Concrete Mathematics"
+ */
+ s7_pointer x, y;
+ s7_double a, b;
+ s7_int n1, n2, d1, d2;
+ x = car(args);
+ y = cadr(args);
-static s7_pointer g_write(s7_scheme *sc, s7_pointer args)
-{
- #define H_write "(write str (port (current-output-port))) writes str (a string) to the output port"
- s7_pointer port;
-
- if (is_pair(cdr(args)))
+ switch (type(x))
{
- port = cadr(args);
- if (!is_output_port(port))
- return(s7_wrong_type_arg_error(sc, "write port", 2, port, "an output port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "write port", 2, port, "an open output port"));
- }
- else port = sc->output_port;
- write_or_display(sc, car(args), port, USE_WRITE);
- return(sc->UNSPECIFIED);
-}
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0)
+ return(x);
+ if ((integer(y) == 1) || (integer(y) == -1))
+ return(small_int(0));
+ /* (modulo most-negative-fixnum -1) will segfault with arithmetic exception */
+ return(make_integer(sc, c_mod(sc, integer(x), integer(y))));
+
+ case T_RATIO:
+ n1 = integer(x);
+ d1 = 1;
+ n2 = numerator(y);
+ d2 = denominator(y);
+ goto RATIO_MOD_RATIO;
+
+ case T_REAL:
+ b = real(y);
+ if (b == 0.0) return(x);
+ if (is_NaN(b)) return(y);
+ if (is_inf(b)) return(real_NaN);
+ a = (s7_double)integer(x);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
+ default:
+ method_or_bust(sc, y, sc->MODULO, args, T_REAL, 2);
+ }
-void s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port)
-{
- write_or_display(sc, obj, port, USE_DISPLAY);
-}
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(y) == 0) return(x);
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = integer(y);
+
+ if ((n2 > 0) && (n1 > 0) && (n2 > n1)) return(x);
+ if ((n2 < 0) && (n1 < 0) && (n2 < n1)) return(x);
+
+ if (n2 == s7_int_min)
+ return(simple_out_of_range(sc, sc->MODULO, y, make_string_wrapper(sc, "intermediate (a/b) is too large")));
+ /* the problem here is that (modulo 3/2 most-negative-fixnum)
+ * will segfault with signal SIGFPE, Arithmetic exception, so try to trap it.
+ */
+ d2 = 1;
+ goto RATIO_MOD_RATIO;
-static s7_pointer g_display(s7_scheme *sc, s7_pointer args)
-{
- #define H_display "(display str (port (current-output-port))) writes str (a string) to the output port"
- s7_pointer port;
-
- if (is_pair(cdr(args)))
- {
- port = cadr(args);
- if (!is_output_port(port))
- return(s7_wrong_type_arg_error(sc, "display port", 2, port, "an output port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "display port", 2, port, "an open output port"));
+ case T_RATIO:
+ n1 = numerator(x);
+ d1 = denominator(x);
+ n2 = numerator(y); /* can't be 0 */
+ d2 = denominator(y);
+ if (d1 == d2)
+ return(s7_make_ratio(sc, c_mod(sc, n1, n2), d1));
+
+ RATIO_MOD_RATIO:
+
+ if ((n1 == n2) &&
+ (d1 > d2))
+ return(x); /* signs match so this should be ok */
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int n2d1, n1d2, d1d2, fl;
+ if (!multiply_overflow(n2, d1, &n2d1))
+ {
+ if (n2d1 == 1)
+ return(small_int(0));
+
+ if (!multiply_overflow(n1, d2, &n1d2))
+ {
+ /* can't use "floor" here (int->float ruins everything) */
+ fl = (s7_int)(n1d2 / n2d1);
+ if (((n1 < 0) && (n2 > 0)) ||
+ ((n1 > 0) && (n2 < 0)))
+ fl -= 1;
+
+ if (fl == 0)
+ return(x);
+
+ if ((!multiply_overflow(d1, d2, &d1d2)) &&
+ (!multiply_overflow(fl, n2d1, &fl)) &&
+ (!subtract_overflow(n1d2, fl, &fl)))
+ return(s7_make_ratio(sc, fl, d1d2));
+ }
+ }
+ }
+#else
+ if ((integer_length(n1) + integer_length(d2) < s7_int_bits) &&
+ (integer_length(n2) + integer_length(d1) < s7_int_bits) &&
+ (integer_length(d1) + integer_length(d2) < s7_int_bits))
+ {
+ s7_int n1d2, n2d1, fl;
+ n1d2 = n1 * d2;
+ n2d1 = n2 * d1;
+
+ if (n2d1 == 1)
+ return(small_int(0));
+
+ /* can't use "floor" here (int->float ruins everything) */
+ fl = (s7_int)(n1d2 / n2d1);
+ if (((n1 < 0) && (n2 > 0)) ||
+ ((n1 > 0) && (n2 < 0)))
+ fl -= 1;
+
+ if (fl == 0)
+ return(x);
+
+ if (integer_length(n2d1) + integer_length(fl) < s7_int_bits)
+ return(s7_make_ratio(sc, n1d2 - (n2d1 * fl), d1 * d2));
+ }
+#endif
+
+ /* there are cases here we might want to catch:
+ * (modulo 9223372036 1/9223372036) -> error, not 0?
+ * (modulo 1 1/9223372036854775807) -> error, not 0?
+ */
+ return(simple_out_of_range(sc, sc->MODULO, x, make_string_wrapper(sc, "intermediate (a/b) is too large")));
+
+ case T_REAL:
+ b = real(y);
+ if (b == 0.0) return(x);
+ if (is_NaN(b)) return(y);
+ if (is_inf(b)) return(real_NaN);
+ a = fraction(x);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
+
+ default:
+ method_or_bust(sc, y, sc->MODULO, args, T_REAL, 2);
+ }
+
+ case T_REAL:
+ a = real(x);
+
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (is_NaN(a)) return(x);
+ if (is_inf(a)) return(real_NaN);
+ if (integer(y) == 0) return(x);
+ b = (s7_double)integer(y);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
+
+ case T_RATIO:
+ if (is_NaN(a)) return(x);
+ if (is_inf(a)) return(real_NaN);
+ b = fraction(y);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
+
+ case T_REAL:
+ if (is_NaN(a)) return(x);
+ if (is_inf(a)) return(real_NaN);
+ b = real(y);
+ if (b == 0.0) return(x);
+ if (is_NaN(b)) return(y);
+ if (is_inf(b)) return(real_NaN);
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
+
+ default:
+ method_or_bust(sc, y, sc->MODULO, args, T_REAL, 2);
+ }
+
+ default:
+ method_or_bust(sc, x, sc->MODULO, args, T_REAL, 1);
}
- else port = sc->output_port;
- write_or_display(sc, car(args), port, USE_DISPLAY);
- return(sc->UNSPECIFIED);
}
+IF2_TO_IF(modulo, c_mod)
+static s7_double c_mod_r(s7_scheme *sc, s7_double x, s7_double y) {return(x - y * (s7_int)floor(x / y));}
+RF2_TO_RF(modulo, c_mod_r)
-static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args)
+static s7_pointer mod_si;
+static s7_pointer g_mod_si(s7_scheme *sc, s7_pointer args)
{
- #define H_read_byte "(read-byte (port (current-input-port))): reads a byte from the input port"
- s7_pointer port;
-
- if (args != sc->NIL)
- port = car(args);
- else port = sc->input_port;
+ s7_pointer x;
+ s7_int y;
- if (!is_input_port(port))
- return(s7_wrong_type_arg_error(sc, "read-byte", 0, port, "an input port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "read-byte", 0, port, "an open input port"));
+ x = find_symbol_checked(sc, car(args));
+ y = integer(cadr(args));
- if (is_string_port(port))
+ if (is_integer(x))
{
- if ((!(port_string(port))) ||
- (port_string_length(port) <= port_string_point(port)))
- return(sc->EOF_OBJECT);
- return(small_int((int)((unsigned char)(port_string(port)[port_string_point(port)++]))));
+ s7_int z;
+ /* here we know y is positive */
+ z = integer(x) % y;
+ if (z < 0)
+ return(make_integer(sc, z + y));
+ return(make_integer(sc, z));
}
- if (is_file_port(port))
+ if (is_t_real(x))
{
- int c;
- c = fgetc(port_file(port));
- if (c == EOF)
- return(sc->EOF_OBJECT);
- return(small_int((unsigned char)c));
+ s7_double a, b;
+ a = real(x);
+ if (is_NaN(a)) return(x);
+ if (is_inf(a)) return(real_NaN);
+ b = (s7_double)y;
+ return(make_real(sc, a - b * (s7_int)floor(a / b)));
}
- return((*(port_input_function(port)))(sc, S7_READ_BYTE, port));
-}
+ if (s7_is_ratio(x))
+ return(g_modulo(sc, set_plist_2(sc, x, cadr(args))));
+ method_or_bust(sc, x, sc->MODULO, list_2(sc, x, cadr(args)), T_REAL, 1);
+}
-static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args);
+static s7_pointer mod_si_is_zero;
+static s7_pointer g_mod_si_is_zero(s7_scheme *sc, s7_pointer args)
{
- #define H_write_byte "(write-byte byte (port (current-output-port))): writes byte to the output port"
- s7_pointer port;
-
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "write-byte", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "an integer"));
-
- if (is_pair(cdr(args)))
- port = cadr(args);
- else port = sc->output_port;
- if ((!is_output_port(port)) ||
- (is_string_port(port)))
- return(s7_wrong_type_arg_error(sc, "write-byte port", 2, port, "an output file or function port"));
- if (port_is_closed(port))
- return(s7_wrong_type_arg_error(sc, "write-byte port", 2, port, "an open output port"));
-
- if (is_file_port(port))
- {
- if (fputc((unsigned char)s7_integer(car(args)), port_file(port)) == EOF)
- fprintf(stderr, "write to %s: %s\n", port_filename(port), strerror(errno));
- }
- else (*(port_output_function(port)))(sc, (char)s7_integer(car(args)), port);
+ s7_pointer x;
+ s7_int y;
- return(car(args));
-}
+ /* car is (modulo symbol integer), cadr is 0 or not present (if zero?) */
+ x = find_symbol_checked(sc, cadar(args));
+ y = integer(caddar(args));
+ if (is_integer(x))
+ return(make_boolean(sc, (integer(x) % y) == 0));
-static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args)
-{
- #define H_call_with_output_string "(call-with-output-string proc) opens a string port applies proc to it, then returns the collected output"
- s7_pointer port;
+ if (is_t_real(x))
+ return(make_boolean(sc, (fmod(real(x), (s7_double)y) == 0.0)));
- if (!is_procedure(car(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-output-string", 1, car(args), "a procedure"));
- if ((is_continuation(car(args))) || is_goto(car(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-output-string", 2, car(args), "a normal procedure (not a continuation)"));
- if (is_thunk(sc, car(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-output-string", 2, car(args), "a procedure of one argument (the port)"));
-
- port = s7_open_output_string(sc);
- push_stack(sc, opcode(OP_UNWIND_OUTPUT), sc->F, port);
- push_stack(sc, opcode(OP_GET_OUTPUT_STRING), sc->F, port);
+ if (s7_is_ratio(x))
+ return(sc->F);
- sc->code = car(args);
- sc->args = make_list_1(sc, port);
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
+ {
+ s7_pointer func;
+ if ((func = find_method(sc, find_let(sc, x), sc->MODULO)) != sc->UNDEFINED)
+ return(g_is_zero(sc, set_plist_1(sc, s7_apply_function(sc, func, list_2(sc, x, caddar(args))))));
+ }
+ return(wrong_type_argument(sc, sc->MODULO, 1, x, T_REAL));
}
+#endif
+/* !WITH_GMP */
-static s7_pointer g_call_with_output_file(s7_scheme *sc, s7_pointer args)
+static int reduce_fraction(s7_scheme *sc, s7_int *numer, s7_int *denom)
{
- #define H_call_with_output_file "(call-with-output-file filename proc) opens filename and calls proc with the output port as its argument"
- s7_pointer port;
-
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-output-file filename,", 1, car(args), "a string"));
- if (!is_procedure(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-output-file", 2, cadr(args), "a procedure"));
- if ((is_continuation(cadr(args))) || is_goto(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-output-file", 2, cadr(args), "a normal procedure (not a continuation)"));
- if (is_thunk(sc, car(args)))
- return(s7_wrong_type_arg_error(sc, "call-with-output-file", 2, car(args), "a procedure of one argument (the port)"));
-
- port = s7_open_output_file(sc, s7_string(car(args)), "w");
- push_stack(sc, opcode(OP_UNWIND_OUTPUT), sc->F, port);
+ /* we're assuming in several places that we have a normal s7 rational after returning,
+ * so the denominator needs to be positive.
+ */
+ s7_int divisor;
- sc->code = cadr(args);
- sc->args = make_list_1(sc, port);
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
+ if (*numer == 0)
+ {
+ *denom = 1;
+ return(T_INTEGER);
+ }
+ if (*denom < 0)
+ {
+ if (*denom == *numer)
+ {
+ *denom = 1;
+ *numer = 1;
+ return(T_INTEGER);
+ }
+ if (*denom == s7_int_min)
+ {
+ if (*numer & 1)
+ return(T_RATIO);
+ *denom /= 2;
+ *numer /= 2;
+ }
+ else
+ {
+ if (*numer == s7_int_min)
+ {
+ if (*denom & 1)
+ return(T_RATIO);
+ *denom /= 2;
+ *numer /= 2;
+ }
+ }
+ *denom = -*denom;
+ *numer = -*numer;
+ }
+ divisor = c_gcd(*numer, *denom);
+ if (divisor != 1)
+ {
+ *numer /= divisor;
+ *denom /= divisor;
+ }
+ if (*denom == 1)
+ return(T_INTEGER);
+ return(T_RATIO);
}
-static s7_pointer g_with_output_to_string(s7_scheme *sc, s7_pointer args)
+
+/* ---------------------------------------- add ---------------------------------------- */
+
+static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
{
- #define H_with_output_to_string "(with-output-to-string thunk) opens a string as a temporary current-output-port, calls thunk, then returns the collected output"
- s7_pointer old_output_port;
+ #define H_add "(+ ...) adds its arguments"
+ #define Q_add pcl_n
+ s7_pointer x, p;
+ s7_int num_a, den_a, dn;
+ s7_double rl_a, im_a;
- if (!is_thunk(sc, car(args)))
- return(s7_wrong_type_arg_error(sc, "with-output-to-string", 1, car(args), "a thunk"));
-
- old_output_port = sc->output_port;
- sc->output_port = s7_open_output_string(sc);
- push_stack(sc, opcode(OP_UNWIND_OUTPUT), old_output_port, sc->output_port);
- push_stack(sc, opcode(OP_GET_OUTPUT_STRING), sc->F, sc->output_port);
+#if (!WITH_GMP)
+ if (is_null(args))
+ return(small_int(0));
+#endif
- sc->code = car(args);
- sc->args = sc->NIL;
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
-}
+ x = car(args);
+ p = cdr(args);
+ if (is_null(p))
+ {
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->ADD, args, A_NUMBER, 0);
+ return(x);
+ }
-/* (string-ref (with-output-to-string (lambda () (write "1234") (values (get-output-string) 1)))) */
+ switch (type(x))
+ {
+ case T_INTEGER:
+ num_a = integer(x);
+ ADD_INTEGERS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_add(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
-static s7_pointer g_with_output_to_file(s7_scheme *sc, s7_pointer args)
-{
- #define H_with_output_to_file "(with-output-to-file filename thunk) opens filename as the temporary current-output-port and calls thunk"
- s7_pointer old_output_port;
-
- if (!s7_is_string(car(args)))
- return(s7_wrong_type_arg_error(sc, "with-output-to-file filename,", 1, car(args), "a string"));
- if (!is_thunk(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, "with-output-to-file", 2, cadr(args), "a thunk"));
-
- old_output_port = sc->output_port;
- sc->output_port = s7_open_output_file(sc, s7_string(car(args)), "w");
- push_stack(sc, opcode(OP_UNWIND_OUTPUT), old_output_port, sc->output_port);
+ switch (type(x))
+ {
+ case T_INTEGER:
+#if HAVE_OVERFLOW_CHECKS
+ if (add_overflow(num_a, integer(x), &den_a))
+ {
+ rl_a = (s7_double)num_a + (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto ADD_REALS;
+ }
+#else
+ den_a = num_a + integer(x);
+ if (den_a < 0)
+ {
+ if ((num_a > 0) && (integer(x) > 0))
+ {
+ rl_a = (s7_double)num_a + (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto ADD_REALS;
+ }
+ }
+ else
+ {
+ if ((num_a < 0) && (integer(x) < 0))
+ {
+ rl_a = (s7_double)num_a + (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+
+ /* this is not ideal! piano.scm has its own noise generator that wants integer
+ * arithmetic to overflow as an integer. Perhaps 'safety==0 would not check
+ * anywhere?
+ */
+ goto ADD_REALS;
+ }
+ }
+#endif
+ if (is_null(p)) return(make_integer(sc, den_a));
+ num_a = den_a;
+ /* (+ 4611686018427387904 4611686018427387904) -> -9223372036854775808
+ * (+ most-positive-fixnum most-positive-fixnum) -> -2
+ * (+ most-negative-fixnum most-negative-fixnum) -> 0
+ * can't check result - arg: (- 0 most-negative-fixnum) -> most-negative-fixnum
+ */
+ goto ADD_INTEGERS;
- sc->code = cadr(args);
- sc->args = sc->NIL;
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
-}
+ case T_RATIO:
+ den_a = denominator(x);
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(den_a, num_a, &dn)) ||
+ (add_overflow(dn, numerator(x), &dn)))
+#else
+ if ((integer_length(num_a) + integer_length(den_a) + integer_length(numerator(x))) < s7_int_bits)
+ dn = numerator(x) + (num_a * den_a);
+ else
+#endif
+ {
+ if (is_null(p))
+ {
+ if (num_a == 0) /* (+ 0 1/9223372036854775807) */
+ return(x);
+ return(make_real(sc, num_a + fraction(x)));
+ }
+ rl_a = (s7_double)num_a + fraction(x);
+ goto ADD_REALS;
+ }
+ if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
+ num_a = dn;
+ /* overflow examples:
+ * (+ 100000 1/142857142857140) -> -832205957599110323/28571428571428
+ * (+ 4611686018427387904 3/4) -> 3/4
+ * see s7test for more
+ */
+ goto ADD_RATIOS;
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, num_a + real(x)));
+ rl_a = (s7_double)num_a + real(x);
+ goto ADD_REALS;
-/* -------------------------------- lists -------------------------------- */
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, num_a + real_part(x), imag_part(x)));
+ rl_a = (s7_double)num_a + real_part(x);
+ im_a = imag_part(x);
+ goto ADD_COMPLEX;
-static s7_pointer immutable_cons(s7_scheme *sc, s7_pointer a, s7_pointer b)
-{
- s7_pointer x;
- NEW_CELL(sc, x); /* might trigger gc, expansion here does not help */
- car(x) = a;
- cdr(x) = b;
- set_type(x, T_PAIR | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
- return(x);
-}
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, cons(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ ADD_RATIOS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (den_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_add(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
-s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b)
-{
- s7_pointer x;
- NEW_CELL(sc, x);
- car(x) = a;
- cdr(x) = b;
- set_type(x, T_PAIR | T_STRUCTURE);
- return(x);
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(den_a, integer(x), &dn)) ||
+ (add_overflow(dn, num_a, &dn)))
+#else
+ if ((integer_length(integer(x)) + integer_length(den_a) + integer_length(num_a)) < s7_int_bits)
+ dn = num_a + (integer(x) * den_a);
+ else
+#endif
+ {
+ /* (+ 3/4 4611686018427387904) -> 3/4
+ * (+ 1/17179869184 1073741824) -> 1/17179869184
+ * (+ 1/8589934592 1073741824) -> -9223372036854775807/8589934592
+ */
+ if (is_null(p))
+ return(make_real(sc, (s7_double)integer(x) + ((long double)num_a / (long double)den_a)));
+ rl_a = (s7_double)integer(x) + ((long double)num_a / (long double)den_a);
+ goto ADD_REALS;
+ }
+ if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
+ num_a = dn;
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto ADD_INTEGERS;
+ goto ADD_RATIOS;
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = den_a;
+ n1 = num_a;
+ d2 = denominator(x);
+ n2 = numerator(x);
+ if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ {
+ if (is_null(p))
+ return(s7_make_ratio(sc, n1 + n2, d1));
+ num_a += n2; /* d1 can't be zero */
+ }
+ else
+ {
+#if (!WITH_GMP)
+#if HAVE_OVERFLOW_CHECKS
+ s7_int n1d2, n2d1;
+ if ((multiply_overflow(d1, d2, &den_a)) ||
+ (multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)) ||
+ (add_overflow(n1d2, n2d1, &num_a)))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2);
+ goto ADD_REALS;
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ int d1bits, d2bits;
+ d1bits = integer_length(d1);
+ d2bits = integer_length(d2);
+ if (((d1bits + d2bits) > s7_int_bits) ||
+ ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
+ ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2);
+ /* this can lose:
+ * (+ 1 1/9223372036854775807 -1) -> 0.0 not 1/9223372036854775807
+ */
+ goto ADD_REALS;
+ }
+ }
+ num_a = n1 * d2 + n2 * d1;
+ den_a = d1 * d2;
+#endif
+#else
+ num_a = n1 * d2 + n2 * d1;
+ den_a = d1 * d2;
+#endif
+ if (is_null(p))
+ return(s7_make_ratio(sc, num_a, den_a));
+ }
+ /* (+ 1/100 99/100 (- most-positive-fixnum 2)) should not be converted to real
+ */
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto ADD_INTEGERS;
+ goto ADD_RATIOS;
+ }
-static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, int type)
-{
- /* for the symbol table which is never GC'd (and its contents aren't marked) */
- s7_pointer x;
- x = (s7_cell *)permanent_calloc(sizeof(s7_cell));
- x->hloc = NOT_IN_HEAP;
- car(x) = a;
- cdr(x) = b;
- set_type(x, type);
- return(x);
-}
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) + real(x)));
+ rl_a = ((long double)num_a / (long double)den_a) + real(x);
+ goto ADD_REALS;
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, ((long double)num_a / (long double)den_a) + real_part(x), imag_part(x)));
+ rl_a = ((long double)num_a / (long double)den_a) + real_part(x);
+ im_a = imag_part(x);
+ goto ADD_COMPLEX;
-bool s7_is_pair(s7_pointer p)
-{
- return(is_pair(p));
-}
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
+ case T_REAL:
+ rl_a = real(x);
-s7_pointer s7_car(s7_pointer p)
-{
- return(car(p));
-}
+ ADD_REALS:
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(make_real(sc, rl_a + integer(x)));
+ rl_a += (s7_double)integer(x);
+ goto ADD_REALS;
+
+ case T_RATIO:
+ if (is_null(p)) return(make_real(sc, rl_a + fraction(x)));
+ rl_a += (s7_double)fraction(x);
+ goto ADD_REALS;
+
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, rl_a + real(x)));
+ rl_a += real(x);
+ goto ADD_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + real_part(x), imag_part(x)));
+ rl_a += real_part(x);
+ im_a = imag_part(x);
+ goto ADD_COMPLEX;
-s7_pointer s7_cdr(s7_pointer p)
-{
- return(cdr(p));
-}
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
-s7_pointer s7_set_car(s7_pointer p, s7_pointer q)
-{
- car(p) = q;
- return(p);
-}
+ ADD_COMPLEX:
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + integer(x), im_a));
+ rl_a += (s7_double)integer(x);
+ goto ADD_COMPLEX;
+
+ case T_RATIO:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + fraction(x), im_a));
+ rl_a += (s7_double)fraction(x);
+ goto ADD_COMPLEX;
+
+ case T_REAL:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + real(x), im_a));
+ rl_a += real(x);
+ goto ADD_COMPLEX;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a + real_part(x), im_a + imag_part(x)));
+ rl_a += real_part(x);
+ im_a += imag_part(x);
+ if (im_a == 0.0)
+ goto ADD_REALS;
+ goto ADD_COMPLEX;
-s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q)
-{
- cdr(p) = q;
- return(p);
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
+
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, args, A_NUMBER, 1);
+ }
}
-static s7_pointer make_list_1(s7_scheme *sc, s7_pointer a)
+static s7_pointer add_2, add_1s, add_s1, add_cs1, add_si, add_sf, add_fs;
+
+static s7_pointer add_ratios(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- s7_pointer x;
- NEW_CELL(sc, x);
- car(x) = a;
- cdr(x) = sc->NIL;
- set_type(x, T_PAIR | T_STRUCTURE);
- return(x);
+ s7_int d1, d2, n1, n2;
+ d1 = number_to_denominator(x);
+ n1 = number_to_numerator(x);
+ d2 = number_to_denominator(y);
+ n2 = number_to_numerator(y);
+
+ if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ return(s7_make_ratio(sc, n1 + n2, d1));
+
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int n1d2, n2d1, d1d2, dn;
+ if ((multiply_overflow(d1, d2, &d1d2)) ||
+ (multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)) ||
+ (add_overflow(n1d2, n2d1, &dn)))
+ return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
+ return(s7_make_ratio(sc, dn, d1d2));
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ int d1bits, d2bits;
+ d1bits = integer_length(d1);
+ d2bits = integer_length(d2);
+ if (((d1bits + d2bits) > s7_int_bits) ||
+ ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
+ ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
+ return(make_real(sc, ((long double)n1 / (long double)d1) + ((long double)n2 / (long double)d2)));
+ }
+ return(s7_make_ratio(sc, n1 * d2 + n2 * d1, d1 * d2));
+#endif
}
-static s7_pointer make_list_2(s7_scheme *sc, s7_pointer a, s7_pointer b)
+static s7_pointer g_add_2(s7_scheme *sc, s7_pointer args)
{
s7_pointer x, y;
- NEW_CELL(sc, y);
- car(y) = b;
- cdr(y) = sc->NIL;
- set_type(y, T_PAIR | T_STRUCTURE);
- NEW_CELL(sc, x); /* order matters because the GC will see "y" and expect it to have legit car/cdr */
- car(x) = a;
- cdr(x) = y;
- set_type(x, T_PAIR | T_STRUCTURE);
- return(x);
-}
+ x = car(args);
+ y = cadr(args);
+
+ if (type(x) == type(y))
+ {
+ if (is_t_real(x))
+ return(make_real(sc, real(x) + real(y)));
+ else
+ {
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (add_overflow(integer(x), integer(y), &val))
+ return(make_real(sc, (double)integer(x) + (double)integer(y)));
+ return(make_integer(sc, val));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) + integer(y)));
+#endif
+ case T_RATIO: return(add_ratios(sc, x, y));
+ case T_REAL: return(make_real(sc, real(x) + real(y)));
+ case T_COMPLEX: return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y)));
+ default:
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->ADD, args, A_NUMBER, 1);
+ method_or_bust_with_type(sc, y, sc->ADD, args, A_NUMBER, 2);
+ }
+ }
+ }
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) + integer(y)));
+ case T_RATIO: return(add_ratios(sc, x, y));
+ case T_REAL: return(make_real(sc, integer(x) + real(y)));
+ case T_COMPLEX: return(make_complex(sc, integer(x) + real_part(y), imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->ADD, args, A_NUMBER, 2);
+ }
-static s7_pointer make_list_3(s7_scheme *sc, s7_pointer a, s7_pointer b, s7_pointer c)
-{
- s7_pointer x, y, z;
- NEW_CELL(sc, z);
- car(z) = c;
- cdr(z) = sc->NIL;
- set_type(z, T_PAIR | T_STRUCTURE);
- NEW_CELL(sc, y);
- car(y) = b;
- cdr(y) = z;
- set_type(y, T_PAIR | T_STRUCTURE);
- NEW_CELL(sc, x);
- car(x) = a;
- cdr(x) = y;
- set_type(x, T_PAIR | T_STRUCTURE);
- return(x);
-}
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ case T_RATIO: return(add_ratios(sc, x, y));
+ case T_REAL: return(make_real(sc, fraction(x) + real(y)));
+ case T_COMPLEX: return(s7_make_complex(sc, fraction(x) + real_part(y), imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->ADD, args, A_NUMBER, 2);
+ }
+ case T_REAL:
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_real(sc, real(x) + integer(y)));
+ case T_RATIO: return(make_real(sc, real(x) + fraction(y)));
+ case T_REAL: return(make_real(sc, real(x) + real(y)));
+ case T_COMPLEX: return(make_complex(sc, real(x) + real_part(y), imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->ADD, args, A_NUMBER, 2);
+ }
-static s7_pointer make_list_4(s7_scheme *sc, s7_pointer a, s7_pointer b, s7_pointer c, s7_pointer d)
-{
- s7_pointer x, y, z, zz;
- NEW_CELL(sc, zz);
- car(zz) = d;
- cdr(zz) = sc->NIL;
- set_type(zz, T_PAIR | T_STRUCTURE);
- NEW_CELL(sc, z);
- car(z) = c;
- cdr(z) = zz;
- set_type(z, T_PAIR | T_STRUCTURE);
- NEW_CELL(sc, y);
- car(y) = b;
- cdr(y) = z;
- set_type(y, T_PAIR | T_STRUCTURE);
- NEW_CELL(sc, x);
- car(x) = a;
- cdr(x) = y;
- set_type(x, T_PAIR | T_STRUCTURE);
+ case T_COMPLEX:
+ switch (type(y))
+ {
+ case T_INTEGER: return(s7_make_complex(sc, real_part(x) + integer(y), imag_part(x)));
+ case T_RATIO: return(s7_make_complex(sc, real_part(x) + fraction(y), imag_part(x)));
+ case T_REAL: return(s7_make_complex(sc, real_part(x) + real(y), imag_part(x)));
+ case T_COMPLEX: return(make_complex(sc, real_part(x) + real_part(y), imag_part(x) + imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->ADD, args, A_NUMBER, 2);
+ }
+
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, args, A_NUMBER, 1);
+ }
return(x);
}
-
-s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, int num)
+static s7_pointer g_add_s1_1(s7_scheme *sc, s7_pointer x, s7_pointer args)
{
- int i;
- s7_pointer x;
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (add_overflow(integer(x), 1, &val))
+ return(make_real(sc, (double)integer(x) + 1.0));
+ return(make_integer(sc, val));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) + 1));
+#endif
+ case T_RATIO: return(add_ratios(sc, x, small_int(1)));
+ case T_REAL: return(make_real(sc, real(x) + 1.0));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + 1.0, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, cons(sc, x, cdr(args)), A_NUMBER, 1);
+ }
+ return(x);
+}
- for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
- if ((i == num) && (is_pair(x)))
- return(car(x));
+static s7_pointer g_add_s1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
+ x = car(args);
+ if (is_t_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, args));
+}
- return(sc->NIL);
+static s7_pointer c_add_s1(s7_scheme *sc, s7_pointer x)
+{
+ if (is_t_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, set_plist_1(sc, x)));
}
+static s7_pointer g_add_cs1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
+ x = find_symbol_checked(sc, car(args));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, args));
+}
-s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, int num, s7_pointer val)
+static s7_pointer g_add_1s(s7_scheme *sc, s7_pointer args)
{
- int i;
s7_pointer x;
- for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
- if ((i == num) &&
- (is_pair(x)))
- car(x) = val;
+ x = cadr(args);
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + 1));
- return(val);
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) + 1));
+ case T_RATIO: return(add_ratios(sc, x, small_int(1)));
+ case T_REAL: return(make_real(sc, real(x) + 1.0));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + 1.0, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, args, A_NUMBER, 2);
+ }
+ return(x);
}
-
-s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+static s7_pointer g_add_si(s7_scheme *sc, s7_pointer args)
{
s7_pointer x;
+ s7_int n;
- for (x = lst; is_pair(x); x = cdr(x))
- if (s7_is_equal(sc, sym, car(x)))
- return(x);
-
- return(sc->F);
+ x = find_symbol_checked(sc, car(args));
+ n = integer(cadr(args));
+ if (is_integer(x))
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int val;
+ if (add_overflow(integer(x), n, &val))
+ return(make_real(sc, (double)integer(x) + (double)n));
+ return(make_integer(sc, val));
+ }
+#else
+ return(make_integer(sc, integer(x) + n));
+#endif
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) + n));
+ case T_RATIO: return(add_ratios(sc, x, cadr(args)));
+ case T_REAL: return(make_real(sc, real(x) + n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, list_2(sc, x, cadr(args)), A_NUMBER, 1);
+ }
+ return(x);
}
-
-static bool symbol_is_in_list(s7_pointer sym, s7_pointer lst)
+static s7_pointer g_add_sf(s7_scheme *sc, s7_pointer args)
{
s7_pointer x;
- for (x = lst; is_pair(x); x = cdr(x))
- if (is_pair(car(x)))
- {
- if (sym == caar(x))
- return(true);
- }
- else
- {
- if (sym == car(x))
- return(true);
- }
- if (sym == x)
- return(true);
+ s7_double n;
- return(false);
+ x = find_symbol_checked(sc, car(args));
+ n = real(cadr(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) + n));
+ case T_RATIO: return(make_real(sc, fraction(x) + n));
+ case T_REAL: return(make_real(sc, real(x) + n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, list_2(sc, x, cadr(args)), A_NUMBER, 1);
+ }
+ return(x);
}
-
-s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+static s7_pointer g_add_fs(s7_scheme *sc, s7_pointer args)
{
s7_pointer x;
+ s7_double n;
- for (x = lst; is_pair(x); x = cdr(x))
- if ((is_pair(s7_car(x))) &&
- (s7_is_equal(sc, sym, car(car(x)))))
- return(car(x));
-
- return(sc->F);
+ x = find_symbol_checked(sc, cadr(args));
+ n = real(car(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) + n));
+ case T_RATIO: return(make_real(sc, fraction(x) + n));
+ case T_REAL: return(make_real(sc, real(x) + n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) + n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->ADD, list_2(sc, x, car(args)), A_NUMBER, 2);
+ }
+ return(x);
}
-
-s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a)
+static s7_pointer add_f_sf;
+static s7_pointer g_add_f_sf(s7_scheme *sc, s7_pointer args)
{
- /* reverse list -- produce new list (other code assumes this function does not return the original!) */
- s7_pointer x, p;
+ /* (+ x (* s y)) */
+ s7_pointer vargs, s;
+ s7_double x, y;
- if (a == sc->NIL) return(a);
+ x = real(car(args));
+ vargs = cdadr(args);
+ s = find_symbol_checked(sc, car(vargs));
+ y = real(cadr(vargs));
- if (!is_pair(cdr(a)))
+ if (is_t_real(s))
+ return(make_real(sc, x + (real(s) * y)));
+
+ switch (type(s))
{
- if (cdr(a) != sc->NIL)
- return(s7_cons(sc, cdr(a), car(a)));
- return(s7_cons(sc, car(a), sc->NIL)); /* don't return 'a' itself */
+ case T_INTEGER: return(make_real(sc, x + (integer(s) * y)));
+ case T_RATIO: return(make_real(sc, x + (fraction(s) * y)));
+ case T_REAL: return(make_real(sc, x + real(s) * y));
+ case T_COMPLEX: return(s7_make_complex(sc, x + (real_part(s) * y), imag_part(s) * y));
+ default:
+ {
+ s7_pointer func;
+ if ((func = find_method(sc, find_let(sc, s), sc->MULTIPLY)) != sc->UNDEFINED)
+ return(g_add_2(sc, set_plist_2(sc, car(args), s7_apply_function(sc, func, list_2(sc, s, cadr(vargs))))));
+ return(wrong_type_argument_with_type(sc, sc->MULTIPLY, 1, s, A_NUMBER));
+ }
}
+ return(s);
+}
- sc->w = make_list_1(sc, car(a));
- for (x = cdr(a), p = a; is_pair(x); x = cdr(x), p = cdr(p))
- {
- sc->w = s7_cons(sc, car(x), sc->w);
- if (is_pair(cdr(x)))
- {
- x = cdr(x);
- sc->w = s7_cons(sc, car(x), sc->w);
- }
- if (x == p) /* this can take awhile to notice there's a cycle, but what does the caller expect? */
- break;
- }
+static s7_pointer add_ss_1ss_1(s7_scheme *sc, s7_pointer s1, s7_pointer s2, s7_pointer s3)
+{
+ s7_double r1, r2, r3, loc, i1, i2, i3, is1;
+ if ((is_t_real(s1)) &&
+ (is_t_real(s2)) &&
+ (is_t_real(s3)))
+ return(make_real(sc, (real(s1) * real(s2)) + ((1.0 - real(s1)) * real(s3))));
+
+ if ((is_real(s1)) &&
+ (is_real(s2)) &&
+ (is_real(s3)))
+ {
+ r1 = real_to_double(sc, s1, "*");
+ r2 = real_to_double(sc, s2, "*");
+ r3 = real_to_double(sc, s3, "*");
+ return(make_real(sc, (r1 * r2) + ((1.0 - r1) * r3)));
+ }
+
+ r1 = s7_real_part(s1);
+ loc = 1.0 - r1;
+ r2 = s7_real_part(s2);
+ r3 = s7_real_part(s3);
+ i1 = s7_imag_part(s1);
+ is1 = -i1;
+ i2 = s7_imag_part(s2);
+ i3 = s7_imag_part(s3);
+ return(s7_make_complex(sc,
+ (r1 * r2 - i1 * i2) + (loc * r3 - is1 * i3),
+ (r1 * i2 + r2 * i1) + (loc * i3 + r3 * is1)));
+ /* (let ()
+ * (define (hi a b c) (+ (* a b) (* (- 1.0 a) c)))
+ * (define (hi1 a b c) (+ (* b a) (* c (- 1 a))))
+ * (define (ho a b c) (list (hi a b c) (hi1 a b c)))
+ * (ho 1.4 2.5+i 3.1))
+ */
+}
- if (x != sc->NIL)
- p = s7_cons(sc, x, sc->w); /* ?? this means that (reverse '(1 2 . 3)) returns '(3 2 1) -- we used to return '() here */
- else p = sc->w;
+static s7_pointer add_ss_1ss;
+static s7_pointer g_add_ss_1ss(s7_scheme *sc, s7_pointer args)
+{
+ /* (+ (* s1 s2) (* (- 1.0 s1) s3)) */
+ s7_pointer s1, s2, s3;
+ s1 = find_symbol_checked(sc, cadr(car(args)));
+ s2 = find_symbol_checked(sc, opt_sym1(args)); /* caddr(car(args))) */
+ s3 = find_symbol_checked(sc, opt_sym2(args)); /* caddr(cadr(args))) */
- sc->w = sc->NIL;
- return(p);
+ return(add_ss_1ss_1(sc, s1, s2, s3));
}
-/* s7_reverse sometimes tacks extra nodes on the end of a reversed circular list (it detects the cycle too late)
- * (let ((lst (list 0))) (set! (cdr lst) lst) (reverse lst)) -> (#1=(0 . #1#) 0 0 0)
- */
+#if (!WITH_GMP)
+static s7_double add_rf_xx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t r1, r2;
+ s7_double x, y;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_rf_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x + y);
+}
-static s7_pointer reverse_in_place(s7_scheme *sc, s7_pointer term, s7_pointer list)
+static s7_double add_rf_rx(s7_scheme *sc, s7_pointer **p)
{
- s7_pointer p = list, result = term, q;
+ s7_pointer s1;
+ s7_rf_t r1;
+ s1 = **p; (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ return(r1(sc, p) + real_to_double(sc, s1, "+"));
+}
- while (p != sc->NIL)
- {
- q = cdr(p);
- if ((!is_pair(q)) &&
- (q != sc->NIL))
- return(sc->NIL); /* improper list? */
- cdr(p) = result;
- result = p;
- p = q;
- }
+static s7_double add_rf_sx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_rf_t r1;
+ s1 = slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ return(r1(sc, p) + real_to_double(sc, s1, "+"));
+}
- return(result);
+static s7_double add_rf_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s7_double x1;
+ s1 = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, s1, "+");
+ s2 = slot_value(**p); (*p)++;
+ return(x1 + real_to_double(sc, s2, "+"));
+}
+
+static s7_double add_rf_rs(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1, s1;
+ s7_double x1;
+ s1 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ x1 = real_to_double(sc, c1, "+");
+ return(x1 + real_to_double(sc, s1, "+"));
}
-static s7_pointer safe_reverse_in_place(s7_scheme *sc, s7_pointer list) /* "safe" here means we guarantee this list is unproblematic */
+static s7_double add_rf_xxx(s7_scheme *sc, s7_pointer **p)
{
- s7_pointer p = list, result, q;
- result = sc->NIL;
+ s7_rf_t r1, r2, r3;
+ s7_double x, y, z;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_rf_t)(**p); (*p)++;
+ y = r2(sc, p);
+ r3 = (s7_rf_t)(**p); (*p)++;
+ z = r3(sc, p);
+ return(x + y + z);
+}
- while (p != sc->NIL)
- {
- q = cdr(p);
- /* also if (list == sc->NIL) || (cdr(list) == sc->NIL) return(list) */
- cdr(p) = result;
- result = p;
- p = q;
- }
+static s7_double add_rf_rxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1;
+ s7_rf_t r1, r2;
+ s7_double x, y;
+ c1 = **p; (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_rf_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x + y + real_to_double(sc, c1, "+"));
+}
- return(result);
+static s7_double add_rf_sxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_rf_t r1, r2;
+ s7_double x, y;
+ s1 = slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_rf_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x + y + real_to_double(sc, s1, "+"));
}
+static s7_double add_rf_rsx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1, s1;
+ s7_rf_t r1;
+ s7_double x, x1, x2;
+ s1 = slot_value(**p); (*p)++;
+ x2 = real_to_double(sc, s1, "+");
+ c1 = **p; (*p)++;
+ x1 = real_to_double(sc, c1, "+");
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x + x1 + x2);
+}
-/* is this correct? (let ((x (list 1 2))) (eq? x (append '() x))) -> #t
- */
+static s7_double add_rf_ssx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s7_rf_t r1;
+ s7_double x, x1;
+ s1 = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, s1, "+");
+ s2 = slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x + x1 + real_to_double(sc, s2, "+"));
+}
-s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b)
+static s7_double add_rf_sss(s7_scheme *sc, s7_pointer **p)
{
- s7_pointer p = b, q;
-
- if (a != sc->NIL)
+ s7_pointer s1, s2, s3;
+ s7_double x1, x2;
+ s1 = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, s1, "+");
+ s2 = slot_value(**p); (*p)++;
+ x2 = real_to_double(sc, s2, "+");
+ s3 = slot_value(**p); (*p)++;
+ return(x1 + x2 + real_to_double(sc, s3, "+"));
+}
+
+static s7_double add_rf_rss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1, s1, s2;
+ s7_double x1, x2;
+ s1 = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, s1, "+");
+ s2 = slot_value(**p); (*p)++;
+ x2 = real_to_double(sc, s2, "+");
+ c1 = **p; (*p)++;
+ return(real_to_double(sc, c1, "+") + x1 + x2);
+}
+
+static s7_rf_t add_rf_1(s7_scheme *sc, s7_pointer expr, int len)
+{
+ if (len == 3)
+ return(com_rf_2(sc, expr, add_r_ops));
+ if (len == 4)
+ return(com_rf_3(sc, expr, add_r_ops));
+
+ if (len > 4)
{
- a = s7_reverse(sc, a);
- while (a != sc->NIL)
+ s7_rf_t rf;
+ ptr_int loc;
+ int first_len;
+ xf_t *rc;
+
+ first_len = (int)(len / 2);
+ xf_init(2);
+ xf_save_loc(loc);
+ rf = add_rf_1(sc, expr, first_len + 1);
+ if (rf)
{
- q = cdr(a);
- cdr(a) = p;
- p = a;
- a = q;
+ int i;
+ s7_pointer p;
+ xf_store_at(loc, (s7_pointer)rf);
+ xf_save_loc(loc);
+ for (i = 0, p = expr; i < first_len; i++, p = cdr(p));
+ rf = add_rf_1(sc, p, len - first_len);
+ if (rf)
+ {
+ xf_store_at(loc, (s7_pointer)rf);
+ return(add_rf_xx);
+ }
+ else return(NULL);
}
+ else return(NULL);
}
- return(p);
+ return(NULL);
+}
+
+static s7_rf_t add_rf(s7_scheme *sc, s7_pointer expr)
+{
+ return(add_rf_1(sc, expr, s7_list_length(sc, expr)));
}
-static int safe_list_length(s7_scheme *sc, s7_pointer a)
+static s7_int add_if_xx(s7_scheme *sc, s7_pointer **p)
{
- /* assume that "a" is a proper list */
- int i = 0;
- s7_pointer b;
- for (b = a; b != sc->NIL; i++, b = cdr(b)) {};
- return(i);
+ s7_if_t r1, r2;
+ s7_int x, y;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_if_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x + y);
}
+static s7_int add_if_rx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_if_t r1;
+ s1 = **p; (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ return(r1(sc, p) + integer(s1));
+}
-int s7_list_length(s7_scheme *sc, s7_pointer a)
+static s7_int add_if_sx(s7_scheme *sc, s7_pointer **p)
{
- /* returns -len if list is dotted, 0 if it's (directly) circular */
- int i;
- s7_pointer slow, fast;
+ s7_pointer s1;
+ s7_if_t r1;
+ s1 = slot_value(**p); (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ return(r1(sc, p) + integer(s1));
+}
- slow = fast = a;
- for (i = 0; ; i += 2)
- {
- if (!is_pair(fast))
- {
- if (fast == sc->NIL)
- return(i);
- return(-i);
- }
-
- fast = cdr(fast);
- if (!is_pair(fast))
- {
- if (fast == sc->NIL)
- return(i + 1);
- return(-i - 1);
- }
-
- fast = cdr(fast);
- slow = cdr(slow);
- if (fast == slow)
- return(0);
- }
- return(0);
+static s7_int add_if_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ return(integer(s1) + integer(s2));
+}
+
+static s7_int add_if_rs(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1, s1;
+ s1 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ return(integer(c1) + integer(s1));
}
-static s7_pointer g_is_null(s7_scheme *sc, s7_pointer args)
+static s7_int add_if_xxx(s7_scheme *sc, s7_pointer **p)
{
- #define H_is_null "(null? obj) returns #t if obj is the empty list"
- return(make_boolean(sc, car(args) == sc->NIL));
+ s7_if_t r1, r2, r3;
+ s7_int x, y, z;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_if_t)(**p); (*p)++;
+ y = r2(sc, p);
+ r3 = (s7_if_t)(**p); (*p)++;
+ z = r3(sc, p);
+ return(x + y + z);
+}
- /* as a generic this could be: has_structure and length == 0 */
+static s7_int add_if_rxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1;
+ s7_if_t r1, r2;
+ s7_int x, y;
+ c1 = **p; (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_if_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x + y + integer(c1));
}
+static s7_int add_if_sxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_if_t r1, r2;
+ s7_int x, y;
+ s1 = slot_value(**p); (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_if_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x + y + integer(s1));
+}
-static s7_pointer g_is_pair(s7_scheme *sc, s7_pointer args)
+static s7_int add_if_rsx(s7_scheme *sc, s7_pointer **p)
{
- #define H_is_pair "(pair? obj) returns #t if obj is a pair (a non-empty list)"
- return(make_boolean(sc, is_pair(car(args))));
+ s7_pointer c1, s1;
+ s7_if_t r1;
+ s7_int x;
+ s1 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x + integer(c1) + integer(s1));
}
+static s7_int add_if_ssx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s7_if_t r1;
+ s7_int x;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x + integer(s1) + integer(s2));
+}
-bool s7_is_list(s7_scheme *sc, s7_pointer p)
+static s7_int add_if_sss(s7_scheme *sc, s7_pointer **p)
{
- return((p == sc->NIL) ||
- (is_pair(p)));
+ s7_pointer s1, s2, s3;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ s3 = slot_value(**p); (*p)++;
+ return(integer(s1) + integer(s2) + integer(s3));
}
+static s7_int add_if_rss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1, s1, s2;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ return(integer(c1) + integer(s1) + integer(s2));
+}
-static bool is_proper_list(s7_scheme *sc, s7_pointer lst)
+static s7_if_t add_if_1(s7_scheme *sc, s7_pointer expr, int len)
{
- s7_pointer slow, fast;
+ if (len == 3)
+ return(com_if_2(sc, expr, add_i_ops));
+ if (len == 4)
+ return(com_if_3(sc, expr, add_i_ops));
- slow = fast = lst;
- while (true)
+ if (len > 4)
{
- if (!is_pair(fast))
- return(fast == sc->NIL); /* else it's an improper list */
-
- fast = cdr(fast);
- if (!is_pair(fast))
- return(fast == sc->NIL);
+ s7_if_t xf;
+ ptr_int loc;
+ int first_len;
+ xf_t *rc;
- fast = cdr(fast);
- slow = cdr(slow);
- if (fast == slow)
- return(false);
+ xf_init(2);
+ xf_save_loc(loc);
+ first_len = (int)(len / 2);
+ xf = add_if_1(sc, expr, first_len + 1);
+ if (xf)
+ {
+ int i;
+ s7_pointer p;
+ xf_store_at(loc, (s7_pointer)xf);
+ xf_save_loc(loc);
+ for (i = 0, p = expr; i < first_len; i++, p = cdr(p));
+ xf = add_if_1(sc, p, len - first_len);
+ if (xf)
+ {
+ xf_store_at(loc, (s7_pointer)xf);
+ return(add_if_xx);
+ }
+ else return(NULL);
+ }
+ else return(NULL);
}
- return(true);
+ return(NULL);
}
-
-static s7_pointer g_is_list(s7_scheme *sc, s7_pointer args)
+static s7_if_t add_if(s7_scheme *sc, s7_pointer expr)
{
- #define H_is_list "(list? obj) returns #t if obj is a list"
- return(make_boolean(sc, is_proper_list(sc, car(args))));
+ return(add_if_1(sc, expr, s7_list_length(sc, expr)));
}
-#define MAX_LIST_LENGTH 1073741824
-
-static s7_pointer g_make_list(s7_scheme *sc, s7_pointer args)
+static void init_add_ops(void)
{
- #define H_make_list "(make-list length (initial-element #f)) returns a list of 'length' elements whose value is 'initial-element'."
+ add_r_ops = (rf_ops *)calloc(1, sizeof(rf_ops));
+ add_r_ops->r = rf_c;
+ add_r_ops->s = rf_s;
- s7_pointer init, p;
- int i, ilen;
- s7_Int len;
-
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "make-list", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "an integer"));
+ add_r_ops->rs = add_rf_rs;
+ add_r_ops->rp = add_rf_rx;
+ add_r_ops->sp = add_rf_sx;
+ add_r_ops->ss = add_rf_ss;
+ add_r_ops->pp = add_rf_xx;
- len = s7_integer(car(args)); /* needs to be s7_Int here so that (make-list most-negative-fixnum) is handled correctly */
- if (len < 0)
- return(s7_out_of_range_error(sc, "make-list length,", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "should be non-negative"));
- if (len == 0) return(sc->NIL); /* what about (make-list 0 123)? */
- if (len > MAX_LIST_LENGTH)
- return(s7_out_of_range_error(sc, "make-list length,", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "should be a reasonable integer"));
+ add_r_ops->rss = add_rf_rss;
+ add_r_ops->rsp = add_rf_rsx;
+ add_r_ops->rpp = add_rf_rxx;
+ add_r_ops->sss = add_rf_sss;
+ add_r_ops->ssp = add_rf_ssx;
+ add_r_ops->spp = add_rf_sxx;
+ add_r_ops->ppp = add_rf_xxx;
- if (is_pair(cdr(args)))
- init = cadr(args);
- else init = sc->F;
+ add_i_ops = (if_ops *)calloc(1, sizeof(if_ops));
+ add_i_ops->r = if_c;
+ add_i_ops->s = if_s;
- sc->w = sc->NIL;
- ilen = (int)len;
- for (i = 0; i < ilen; i++)
- sc->w = s7_cons(sc, init, sc->w);
- p = sc->w;
- sc->w = sc->NIL;
+ add_i_ops->rs = add_if_rs;
+ add_i_ops->rp = add_if_rx;
+ add_i_ops->sp = add_if_sx;
+ add_i_ops->ss = add_if_ss;
+ add_i_ops->pp = add_if_xx;
- return(p);
+ add_i_ops->rss = add_if_rss;
+ add_i_ops->rsp = add_if_rsx;
+ add_i_ops->rpp = add_if_rxx;
+ add_i_ops->sss = add_if_sss;
+ add_i_ops->ssp = add_if_ssx;
+ add_i_ops->spp = add_if_sxx;
+ add_i_ops->ppp = add_if_xxx;
}
+#if WITH_ADD_PF
+static s7_pointer c_add_pf2(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t pf;
+ s7_pointer x, y;
+ pf = (s7_pf_t)(**p); (*p)++;
+ x = pf(sc, p);
+ xf_push(sc, x);
+ pf = (s7_pf_t)(**p); (*p)++;
+ y = pf(sc, p);
+ x = g_add_2(sc, set_plist_2(sc, x, y));
+ xf_pop(sc);
+ return(x);
+}
-static s7_pointer list_ref_1(s7_scheme *sc, s7_pointer lst, s7_pointer ind)
+static s7_pf_t add_pf(s7_scheme *sc, s7_pointer expr)
{
- s7_Int i, index;
- s7_pointer p;
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len == 3)
+ {
+ if ((s7_arg_to_pf(sc, cadr(expr))) &&
+ (s7_arg_to_pf(sc, caddr(expr))))
+ return(c_add_pf2);
+ }
+ return(NULL);
+}
+#endif
- if (!s7_is_integer(ind))
- return(s7_wrong_type_arg_error(sc, "list-ref index,", 2, ind, "an integer"));
-
- index = s7_integer(ind);
- if (index < 0)
- return(s7_out_of_range_error(sc, "list-ref index,", 2, ind, "should be non-negative"));
- if (index > MAX_LIST_LENGTH)
- return(s7_out_of_range_error(sc, "list-ref index,", 2, ind, "should be a reasonable integer"));
-
- for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
-
- if (p == sc->NIL)
- return(s7_out_of_range_error(sc, "list-ref index,", 2, ind, "should be less than list length"));
- if (!is_pair(p))
- return(s7_wrong_type_arg_error(sc, "list-ref", 1, lst, "a proper list"));
-
- return(car(p));
-}
+#endif
-static s7_pointer g_list_ref(s7_scheme *sc, s7_pointer args)
+/* ---------------------------------------- subtract ---------------------------------------- */
+
+static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
{
- #define H_list_ref "(list-ref lst i ...) returns the i-th element (0-based) of the list"
-
- /* (let ((L '((1 2 3) (4 5 6)))) (list-ref L 1 2))
+ #define H_subtract "(- x1 ...) subtracts its trailing arguments from the first, or negates the first if only one it is given"
+ #define Q_subtract pcl_n
- (define (lref L . args)
- (if (null? (cdr args))
- (list-ref L (car args))
- (apply lref (list-ref L (car args)) (cdr args))))
- */
+ s7_pointer x, p;
+ s7_int num_a, den_a;
+ s7_double rl_a, im_a;
- s7_pointer lst, inds;
- lst = car(args);
+ x = car(args);
+ p = cdr(args);
- inds = cdr(args);
- while (true)
+#if (!WITH_GMP)
+ if (is_null(p))
{
- if (!is_pair(lst))
- return(s7_wrong_type_arg_error(sc, "list-ref", 1, lst, "a pair"));
-
- if (cdr(inds) == sc->NIL)
- return(list_ref_1(sc, lst, car(inds)));
- lst = list_ref_1(sc, lst, car(inds));
- inds = cdr(inds);
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, args, A_NUMBER, 0);
+ return(s7_negate(sc, x));
}
-}
+#endif
+ switch (type(x))
+ {
+ case T_INTEGER:
+ num_a = integer(x);
-static s7_pointer g_list_set_1(s7_scheme *sc, s7_pointer lst, s7_pointer args, int arg_num)
-{
- #define H_list_set "(list-set! lst i ... val) sets the i-th element (0-based) of the list to val"
-
- int i;
- s7_Int index;
- s7_pointer p, ind;
+ SUBTRACT_INTEGERS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_subtract(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
- /* (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 2 32) L) */
- if (!is_pair(lst))
- return(s7_wrong_type_arg_error(sc, "list-set!", 1, lst, "a pair"));
+ switch (type(x))
+ {
+ case T_INTEGER:
+#if HAVE_OVERFLOW_CHECKS
+ if (subtract_overflow(num_a, integer(x), &den_a))
+ {
+ rl_a = (s7_double)num_a - (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto SUBTRACT_REALS;
+ }
+#else
+ den_a = num_a - integer(x);
+ if (den_a < 0)
+ {
+ if ((num_a > 0) && (integer(x) < 0))
+ {
+ rl_a = (s7_double)num_a - (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto SUBTRACT_REALS;
+ }
+ /* (- most-positive-fixnum most-negative-fixnum) -> -1 (1.8446744073709551615E19)
+ */
+ }
+ else
+ {
+ if ((num_a < 0) && (integer(x) > 0))
+ {
+ rl_a = (s7_double)num_a - (s7_double)integer(x);
+ if (is_null(p)) return(make_real(sc, rl_a));
+ goto SUBTRACT_REALS;
+ }
+ /* (- most-negative-fixnum most-positive-fixnum) -> 1 (-1.8446744073709551615E19)
+ */
+ }
+#endif
+ if (is_null(p)) return(make_integer(sc, den_a));
+ num_a = den_a;
+ goto SUBTRACT_INTEGERS;
- ind = car(args);
- if (!s7_is_integer(ind))
- return(s7_wrong_type_arg_error(sc, "list-set! index,", arg_num, ind, "an integer"));
-
- index = s7_integer(ind);
- if (index < 0)
- return(s7_out_of_range_error(sc, "list-set!", arg_num, ind, "index should be non-negative"));
- if (index > MAX_LIST_LENGTH)
- return(s7_out_of_range_error(sc, "list-set! index,", arg_num, ind, "should be a reasonable integer"));
-
- for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
-
- if (p == sc->NIL)
- return(s7_out_of_range_error(sc, "list-set! index,", arg_num, ind, "should be less than list length"));
- if (!is_pair(p))
- return(s7_wrong_type_arg_error(sc, "list-set!", 1, lst, "a proper list"));
-
- if (cddr(args) == sc->NIL)
- car(p) = cadr(args);
- else return(g_list_set_1(sc, car(p), cdr(args), arg_num + 1));
- return(cadr(args));
-}
+ case T_RATIO:
+ {
+ s7_int dn;
+ den_a = denominator(x);
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(num_a, den_a, &dn)) ||
+ (subtract_overflow(dn, numerator(x), &dn)))
+ {
+ if (is_null(p)) return(make_real(sc, num_a - fraction(x)));
+ rl_a = (s7_double)num_a - fraction(x);
+ goto SUBTRACT_REALS;
+ }
+#else
+ if ((integer_length(num_a) + integer_length(den_a) + integer_length(numerator(x))) > s7_int_bits)
+ {
+ if (is_null(p)) return(make_real(sc, num_a - fraction(x)));
+ rl_a = (s7_double)num_a - fraction(x);
+ goto SUBTRACT_REALS;
+ }
+ dn = (num_a * den_a) - numerator(x);
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, dn, den_a));
+ num_a = dn;
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto SUBTRACT_INTEGERS;
+ goto SUBTRACT_RATIOS;
+ }
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, num_a - real(x)));
+ rl_a = (s7_double)num_a - real(x);
+ goto SUBTRACT_REALS;
-static s7_pointer g_list_set(s7_scheme *sc, s7_pointer args)
-{
- return(g_list_set_1(sc, car(args), cdr(args), 2));
-}
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, num_a - real_part(x), -imag_part(x)));
+ rl_a = (s7_double)num_a - real_part(x);
+ im_a = -imag_part(x);
+ goto SUBTRACT_COMPLEX;
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, cons(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
-static s7_pointer g_list_tail(s7_scheme *sc, s7_pointer args)
-{
- #define H_list_tail "(list-tail lst i) returns the list from the i-th element on"
-
- int i;
- s7_Int index;
- s7_pointer p;
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ SUBTRACT_RATIOS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (den_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_subtract(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
- if ((!is_pair(car(args))) &&
- (car(args) != sc->NIL))
- return(s7_wrong_type_arg_error(sc, "list-tail", 1, car(args), "a list"));
- if (!s7_is_integer(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "list-tail", 2, cadr(args), "an integer"));
-
- index = s7_integer(cadr(args));
- if (index < 0)
- return(s7_out_of_range_error(sc, "list-tail index,", 2, cadr(args), "should be non-negative"));
- if (index > MAX_LIST_LENGTH)
- return(s7_out_of_range_error(sc, "list-tail index,", 2, cadr(args), "should be a reasonable integer"));
-
- for (i = 0, p = car(args); (i < index) && (is_pair(p)); i++, p = cdr(p)) {}
-
- if (i < index)
- return(s7_out_of_range_error(sc, "list-tail", 2, cadr(args), "index should be less than list length"));
+ switch (type(x))
+ {
+ case T_INTEGER:
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int di;
+ if ((multiply_overflow(den_a, integer(x), &di)) ||
+ (subtract_overflow(num_a, di, &di)))
+ {
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) - integer(x)));
+ rl_a = ((long double)num_a / (long double)den_a) - integer(x);
+ goto SUBTRACT_REALS;
+ }
+ if (is_null(p)) return(s7_make_ratio(sc, di, den_a));
+ num_a = di;
+ }
+#else
+ if ((integer_length(integer(x)) + integer_length(num_a) + integer_length(den_a)) > s7_int_bits)
+ {
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) - integer(x)));
+ rl_a = ((long double)num_a / (long double)den_a) - integer(x);
+ goto SUBTRACT_REALS;
+ }
+ if (is_null(p)) return(s7_make_ratio(sc, num_a - (den_a * integer(x)), den_a));
+ num_a -= (den_a * integer(x));
+#endif
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto SUBTRACT_INTEGERS;
+ goto SUBTRACT_RATIOS;
- /* I guess this would make sense with more than one index, but I'm not sure it's very important */
-
- return(p);
-}
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = den_a;
+ n1 = num_a;
+ d2 = denominator(x);
+ n2 = numerator(x);
+ if (d1 == d2) /* the easy case -- if overflow here, it matches the int case */
+ {
+ if (is_null(p))
+ return(s7_make_ratio(sc, n1 - n2, d1));
+ num_a -= n2; /* d1 can't be zero */
+ }
+ else
+ {
+#if (!WITH_GMP)
+#if HAVE_OVERFLOW_CHECKS
+ s7_int n1d2, n2d1;
+ if ((multiply_overflow(d1, d2, &den_a)) ||
+ (multiply_overflow(n1, d2, &n1d2)) ||
+ (multiply_overflow(n2, d1, &n2d1)) ||
+ (subtract_overflow(n1d2, n2d1, &num_a)))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2);
+ goto SUBTRACT_REALS;
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ int d1bits, d2bits;
+ d1bits = integer_length(d1);
+ d2bits = integer_length(d2);
+ if (((d1bits + d2bits) > s7_int_bits) ||
+ ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
+ ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) - ((long double)n2 / (long double)d2);
+ goto SUBTRACT_REALS;
+ }
+ }
+ num_a = n1 * d2 - n2 * d1;
+ den_a = d1 * d2;
+#endif
+#else
+ num_a = n1 * d2 - n2 * d1;
+ den_a = d1 * d2;
+#endif
+ if (is_null(p))
+ return(s7_make_ratio(sc, num_a, den_a));
+ }
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto SUBTRACT_INTEGERS;
+ goto SUBTRACT_RATIOS;
+ }
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) - real(x)));
+ rl_a = ((long double)num_a / (long double)den_a) - real(x);
+ goto SUBTRACT_REALS;
-static s7_pointer g_car(s7_scheme *sc, s7_pointer args)
-{
- #define H_car "(car pair) returns the first element of the pair"
- if (!is_pair(car(args))) return(s7_wrong_type_arg_error(sc, "car", 0, car(args), "a pair"));
-
- return(caar(args));
-}
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, ((long double)num_a / (long double)den_a) - real_part(x), -imag_part(x)));
+ rl_a = ((long double)num_a / (long double)den_a) - real_part(x);
+ im_a = -imag_part(x);
+ goto SUBTRACT_COMPLEX;
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
-static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args)
-{
- #define H_cdr "(cdr pair) returns the second element of the pair"
- if (!is_pair(car(args))) return(s7_wrong_type_arg_error(sc, "cdr", 0, car(args), "a pair"));
-
- return(cdar(args));
-}
+ case T_REAL:
+ rl_a = real(x);
+ SUBTRACT_REALS:
+ x = car(p);
+ p = cdr(p);
-static s7_pointer g_cons(s7_scheme *sc, s7_pointer args)
-{
- /* n-ary cons could be the equivalent of CL's list*? */
- /* it would be neater to have a single cons cell able to contain (directly) any number of elements */
- /* (set! (cadr (cons 1 2 3)) 4) -> (1 4 . 3) */
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(make_real(sc, rl_a - integer(x)));
+ rl_a -= (s7_double)integer(x);
+ goto SUBTRACT_REALS;
+
+ case T_RATIO:
+ if (is_null(p)) return(make_real(sc, rl_a - fraction(x)));
+ rl_a -= (s7_double)fraction(x);
+ goto SUBTRACT_REALS;
+
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, rl_a - real(x)));
+ rl_a -= real(x);
+ goto SUBTRACT_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - real_part(x), -imag_part(x)));
+ rl_a -= real_part(x);
+ im_a = -imag_part(x);
+ goto SUBTRACT_COMPLEX;
- #define H_cons "(cons a b) returns a pair containing a and b"
-
- /* cdr(args) = cadr(args);
- * this is not safe -- it changes a variable's value directly:
- * (let ((lst (list 1 2))) (list (apply cons lst) lst)) -> '((1 . 2) (1 . 2))
- */
- s7_pointer x;
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
- NEW_CELL(sc, x);
- car(x) = car(args);
- cdr(x) = cadr(args);
- set_type(x, T_PAIR | T_STRUCTURE);
- return(x);
-}
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
+ SUBTRACT_COMPLEX:
+ x = car(p);
+ p = cdr(p);
-static s7_pointer g_set_car(s7_scheme *sc, s7_pointer args)
-{
- #define H_set_car "(set-car! pair val) sets the pair's first element to val"
-
- if (!is_pair(car(args)))
- return(s7_wrong_type_arg_error(sc, "set-car!", 1, car(args), "a pair"));
-
- caar(args) = cadr(args);
- return(cadr(args));
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - integer(x), im_a));
+ rl_a -= (s7_double)integer(x);
+ goto SUBTRACT_COMPLEX;
+
+ case T_RATIO:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - fraction(x), im_a));
+ rl_a -= (s7_double)fraction(x);
+ goto SUBTRACT_COMPLEX;
+
+ case T_REAL:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - real(x), im_a));
+ rl_a -= real(x);
+ goto SUBTRACT_COMPLEX;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a - real_part(x), im_a - imag_part(x)));
+ rl_a -= real_part(x);
+ im_a -= imag_part(x);
+ if (im_a == 0.0)
+ goto SUBTRACT_REALS;
+ goto SUBTRACT_COMPLEX;
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
-static s7_pointer g_set_cdr(s7_scheme *sc, s7_pointer args)
-{
- #define H_set_cdr "(set-cdr! pair val) sets the pair's second element to val"
-
- if (!is_pair(car(args)))
- return(s7_wrong_type_arg_error(sc, "set-cdr!", 1, car(args), "a pair"));
-
- cdar(args) = cadr(args);
- return(cadr(args));
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, args, A_NUMBER, 1);
+ }
}
-static s7_pointer g_caar(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_1, subtract_s1, subtract_cs1, subtract_2, subtract_csn;
+static s7_pointer g_subtract_1(s7_scheme *sc, s7_pointer args)
{
- #define H_caar "(caar lst) returns (car (car lst)): (caar '((1 2))) -> 1"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "caar", 0, lst, "a list whose car is also a list"));
+ s7_pointer p;
- return(car(car(lst)));
-}
+ p = car(args);
+ switch (type(p))
+ {
+ case T_INTEGER:
+ if (integer(p) == s7_int_min)
+#if WITH_GMP
+ return(big_negate(sc, set_plist_1(sc, promote_number(sc, T_BIG_INTEGER, p))));
+#else
+ return(make_integer(sc, s7_int_max));
+#endif
+ return(make_integer(sc, -integer(p)));
+ case T_RATIO:
+ return(s7_make_ratio(sc, -numerator(p), denominator(p)));
-static s7_pointer g_cadr(s7_scheme *sc, s7_pointer args)
-{
- #define H_cadr "(cadr lst) returns (car (cdr lst)): (cadr '(1 2 3)) -> 2"
- s7_pointer lst = car(args);
+ case T_REAL:
+ return(make_real(sc, -real(p)));
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cadr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cadr", 0, lst, "a list whose cdr is also a list"));
+ case T_COMPLEX:
+ return(s7_make_complex(sc, -real_part(p), -imag_part(p)));
- return(car(cdr(lst)));
+ default:
+ method_or_bust_with_type(sc, p, sc->SUBTRACT, args, A_NUMBER, 1);
+ }
}
-
-static s7_pointer g_cdar(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_subtract_2(s7_scheme *sc, s7_pointer args)
{
- #define H_cdar "(cdar lst) returns (cdr (car lst)): (cdar '((1 2 3))) -> '(2 3)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cdar", 0, lst, "a list whose car is also a list"));
-
- return(cdr(car(lst)));
-}
-
+ s7_pointer x, y;
-static s7_pointer g_cddr(s7_scheme *sc, s7_pointer args)
-{
- #define H_cddr "(cddr lst) returns (cdr (cdr lst)): (cddr '(1 2 3 4)) -> '(3 4)"
- s7_pointer lst = car(args);
+ x = car(args);
+ y = cadr(args);
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cddr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cddr", 0, lst, "a list whose cdr is also a list"));
+ if (type(x) == type(y))
+ {
+ if (is_t_real(x))
+ return(make_real(sc, real(x) - real(y)));
+ else
+ {
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (subtract_overflow(integer(x), integer(y), &val))
+ return(make_real(sc, (double)integer(x) - (double)integer(y)));
+ return(make_integer(sc, val));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) - integer(y)));
+#endif
+ case T_RATIO: return(g_subtract(sc, args));
+ case T_REAL: return(make_real(sc, real(x) - real(y)));
+ case T_COMPLEX: return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y)));
+ default:
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, args, A_NUMBER, 1);
+ method_or_bust_with_type(sc, y, sc->SUBTRACT, args, A_NUMBER, 2);
+ }
+ }
+ }
- return(cdr(cdr(lst)));
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) - integer(y)));
+ case T_RATIO: return(g_subtract(sc, args));
+ case T_REAL: return(make_real(sc, integer(x) - real(y)));
+ case T_COMPLEX: return(make_complex(sc, integer(x) - real_part(y), -imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->SUBTRACT, args, A_NUMBER, 2);
+ }
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ case T_RATIO: return(g_subtract(sc, args));
+ case T_REAL: return(make_real(sc, fraction(x) - real(y)));
+ case T_COMPLEX: return(s7_make_complex(sc, fraction(x) - real_part(y), -imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->SUBTRACT, args, A_NUMBER, 2);
+ }
-static s7_pointer g_caaar(s7_scheme *sc, s7_pointer args)
-{
- #define H_caaar "(caaar lst) returns (car (car (car lst))): (caaar '(((1 2)))) -> 1"
- s7_pointer lst = car(args);
+ case T_REAL:
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_real(sc, real(x) - integer(y)));
+ case T_RATIO: return(make_real(sc, real(x) - fraction(y)));
+ case T_REAL: return(make_real(sc, real(x) - real(y)));
+ case T_COMPLEX: return(make_complex(sc, real(x) - real_part(y), -imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->SUBTRACT, args, A_NUMBER, 2);
+ }
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caaar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "caaar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(car(car(lst)))) return(s7_wrong_type_arg_error(sc, "caaar", 0, lst, "a list whose caar is also a list"));
+ case T_COMPLEX:
+ switch (type(y))
+ {
+ case T_INTEGER: return(s7_make_complex(sc, real_part(x) - integer(y), imag_part(x)));
+ case T_RATIO: return(s7_make_complex(sc, real_part(x) - fraction(y), imag_part(x)));
+ case T_REAL: return(s7_make_complex(sc, real_part(x) - real(y), imag_part(x)));
+ case T_COMPLEX: return(make_complex(sc, real_part(x) - real_part(y), imag_part(x) - imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->SUBTRACT, args, A_NUMBER, 2);
+ }
- return(car(car(car(lst))));
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, args, A_NUMBER, 1);
+ }
+ return(x);
}
-static s7_pointer g_caadr(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_subtract_cs1(s7_scheme *sc, s7_pointer args)
{
- #define H_caadr "(caadr lst) returns (car (car (cdr lst))): (caadr '(1 (2 3))) -> 2"
- s7_pointer lst = car(args);
+ s7_pointer x;
+ x = find_symbol_checked(sc, car(args));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) - 1));
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caadr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "caadr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(car(cdr(lst)))) return(s7_wrong_type_arg_error(sc, "caadr", 0, lst, "a list whose cadr is also a list"));
-
- return(car(car(cdr(lst))));
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (subtract_overflow(integer(x), 1, &val))
+ return(make_real(sc, (double)integer(x) - 1.0));
+ return(make_integer(sc, val));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) - 1));
+#endif
+ case T_RATIO: return(subtract_ratios(sc, x, small_int(1)));
+ case T_REAL: return(make_real(sc, real(x) - 1.0));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - 1.0, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, list_2(sc, x, small_int(1)), A_NUMBER, 1);
+ }
+ return(x);
}
-
-static s7_pointer g_cadar(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_subtract_s1(s7_scheme *sc, s7_pointer args)
{
- #define H_cadar "(cadar lst) returns (car (cdr (car lst))): (cadar '((1 2 3))) -> 2"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cadar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cadar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(cdr(car(lst)))) return(s7_wrong_type_arg_error(sc, "cadar", 0, lst, "a list whose cdar is also a list"));
-
- return(car(cdr(car(lst))));
+ s7_pointer x;
+ x = car(args);
+ /* this one seems to hit reals as often as integers */
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (subtract_overflow(integer(x), 1, &val))
+ return(make_real(sc, (double)integer(x) - 1.0));
+ return(make_integer(sc, val));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) - 1));
+#endif
+ case T_RATIO: return(subtract_ratios(sc, x, small_int(1)));
+ case T_REAL: return(make_real(sc, real(x) - 1.0));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - 1.0, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, args, A_NUMBER, 1);
+ }
+ return(x);
}
-
-static s7_pointer g_cdaar(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_subtract_csn(s7_scheme *sc, s7_pointer args)
{
- #define H_cdaar "(cdaar lst) returns (cdr (car (car lst))): (cdaar '(((1 2 3)))) -> '(2 3)"
- s7_pointer lst = car(args);
+ s7_pointer x;
+ s7_int n;
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdaar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cdaar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(car(car(lst)))) return(s7_wrong_type_arg_error(sc, "cdaar", 0, lst, "a list whose caar is also a list"));
+ x = find_symbol_checked(sc, car(args));
+ n = s7_integer(cadr(args));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) - n));
- return(cdr(car(car(lst))));
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (subtract_overflow(integer(x), n, &val))
+ return(make_real(sc, (double)integer(x) - (double)n));
+ return(make_integer(sc, val));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) - n));
+#endif
+ case T_RATIO: return(subtract_ratios(sc, x, cadr(args)));
+ case T_REAL: return(make_real(sc, real(x) - n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, list_2(sc, x, cadr(args)), A_NUMBER, 1);
+ }
+ return(x);
}
-
-static s7_pointer g_caddr(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_sf;
+static s7_pointer g_subtract_sf(s7_scheme *sc, s7_pointer args)
{
- #define H_caddr "(caddr lst) returns (car (cdr (cdr lst))): (caddr '(1 2 3 4)) -> 3"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caddr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "caddr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cdr(cdr(lst)))) return(s7_wrong_type_arg_error(sc, "caddr", 0, lst, "a list whose cddr is also a list"));
+ s7_pointer x;
+ s7_double n;
- return(car(cdr(cdr(lst))));
+ x = find_symbol_checked(sc, car(args));
+ n = real(cadr(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) - n));
+ case T_RATIO: return(make_real(sc, fraction(x) - n));
+ case T_REAL: return(make_real(sc, real(x) - n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, list_2(sc, x, cadr(args)), A_NUMBER, 1);
+ }
+ return(x);
}
-
-static s7_pointer g_cdddr(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_2f;
+static s7_pointer g_subtract_2f(s7_scheme *sc, s7_pointer args)
{
- #define H_cdddr "(cdddr lst) returns (cdr (cdr (cdr lst))): (cdddr '(1 2 3 4)) -> '(4)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdddr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cdddr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cdr(cdr(lst)))) return(s7_wrong_type_arg_error(sc, "cdddr", 0, lst, "a list whose cddr is also a list"));
+ s7_pointer x;
+ s7_double n;
- return(cdr(cdr(cdr(lst))));
+ x = car(args);
+ n = real(cadr(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) - n));
+ case T_RATIO: return(make_real(sc, fraction(x) - n));
+ case T_REAL: return(make_real(sc, real(x) - n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) - n, imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, args, A_NUMBER, 1);
+ }
+ return(x);
}
-
-static s7_pointer g_cdadr(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_fs;
+static s7_pointer g_subtract_fs(s7_scheme *sc, s7_pointer args)
{
- #define H_cdadr "(cdadr lst) returns (cdr (car (cdr lst))): (cdadr '(1 (2 3 4))) -> '(3 4)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdadr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cdadr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(car(cdr(lst)))) return(s7_wrong_type_arg_error(sc, "cdadr", 0, lst, "a list whose cadr is also a list"));
+ s7_pointer x;
+ s7_double n;
- return(cdr(car(cdr(lst))));
+ x = find_symbol_checked(sc, cadr(args));
+ n = real(car(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, n - integer(x)));
+ case T_RATIO: return(make_real(sc, n - fraction(x)));
+ case T_REAL: return(make_real(sc, n - real(x)));
+ case T_COMPLEX: return(s7_make_complex(sc, n - real_part(x), -imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->SUBTRACT, list_2(sc, car(args), x), A_NUMBER, 2);
+ }
+ return(x);
}
-
-static s7_pointer g_cddar(s7_scheme *sc, s7_pointer args)
+static s7_pointer subtract_f_sqr;
+static s7_pointer g_subtract_f_sqr(s7_scheme *sc, s7_pointer args)
{
- #define H_cddar "(cddar lst) returns (cdr (cdr (car lst))): (cddar '((1 2 3 4))) -> '(3 4)"
- s7_pointer lst = car(args);
+ s7_pointer x;
+ s7_double y;
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cddar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cddar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(cdr(car(lst)))) return(s7_wrong_type_arg_error(sc, "cddar", 0, lst, "a list whose cdar is also a list"));
+ y = real(car(args));
+ x = find_symbol_checked(sc, cadr(cadr(args)));
+ if (is_t_real(x))
+ return(make_real(sc, y - (real(x) * real(x))));
- return(cdr(cdr(car(lst))));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, y - (integer(x) * integer(x))));
+ case T_RATIO: return(make_real(sc, y - (fraction(x) * fraction(x))));
+ case T_REAL: return(make_real(sc, y - (real(x) * real(x))));
+ case T_COMPLEX: return(s7_make_complex(sc, y - real_part(x) * real_part(x) + imag_part(x) * imag_part(x), 2.0 * real_part(x) * imag_part(x)));
+ default:
+ /* complicated -- look for * method, if any get (* x x), then go to g_subtract_2 with that and the original y
+ * can't use check_method here because it returns from the caller.
+ */
+ {
+ s7_pointer func;
+ if ((func = find_method(sc, find_let(sc, x), sc->MULTIPLY)) != sc->UNDEFINED)
+ return(g_subtract_2(sc, set_plist_2(sc, car(args), s7_apply_function(sc, func, list_2(sc, x, x)))));
+ return(wrong_type_argument_with_type(sc, sc->MULTIPLY, 1, x, A_NUMBER));
+ }
+ }
+ return(x);
}
-
-static s7_pointer g_caaaar(s7_scheme *sc, s7_pointer args)
+#if (!WITH_GMP)
+/* (define (hi) (- (random 100) 50)) (define (ho) (- (random 1.0) 0.5)) */
+static s7_pointer sub_random_ic, sub_random_rc;
+static s7_pointer g_sub_random_ic(s7_scheme *sc, s7_pointer args)
{
- #define H_caaaar "(caaaar lst) returns (car (car (car (car lst)))): (caaaar '((((1 2))))) -> 1"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caaaar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "caaaar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(caar(lst))) return(s7_wrong_type_arg_error(sc, "caaaar", 0, lst, "a list whose caar is also a list"));
- if (!is_pair(caaar(lst))) return(s7_wrong_type_arg_error(sc, "caaaar", 0, lst, "a list whose caaar is also a list"));
-
- return(car(car(car(car(lst)))));
+ return(make_integer(sc, ((s7_int)(integer(cadar(args)) * next_random(sc->default_rng))) - integer(cadr(args))));
}
-
-static s7_pointer g_caaadr(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_sub_random_rc(s7_scheme *sc, s7_pointer args)
{
- #define H_caaadr "(caaadr lst) returns (car (car (car (cdr lst)))): (caaadr '(1 ((2 3)))) -> 2"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caaadr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "caaadr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cadr(lst))) return(s7_wrong_type_arg_error(sc, "caaadr", 0, lst, "a list whose cadr is also a list"));
- if (!is_pair(caadr(lst))) return(s7_wrong_type_arg_error(sc, "caaadr", 0, lst, "a list whose caadr is also a list"));
-
- return(car(car(car(cdr(lst)))));
+ return(make_real(sc, real(cadar(args)) * next_random(sc->default_rng) - real(cadr(args))));
}
-static s7_pointer g_caadar(s7_scheme *sc, s7_pointer args)
-{
- #define H_caadar "(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caadar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "caadar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(cdar(lst))) return(s7_wrong_type_arg_error(sc, "caadar", 0, lst, "a list whose cdar is also a list"));
- if (!is_pair(cadar(lst))) return(s7_wrong_type_arg_error(sc, "caadar", 0, lst, "a list whose cadar is also a list"));
-
- return(car(car(cdr(car(lst)))));
-}
+static s7_int negate_if_c(s7_scheme *sc, s7_pointer **p) {s7_pointer x; x = (**p); (*p)++; return(-integer(x));}
+static s7_int negate_if_s(s7_scheme *sc, s7_pointer **p) {s7_pointer x; x = slot_value(**p); (*p)++; return(-integer(x));}
+static s7_int negate_if_p(s7_scheme *sc, s7_pointer **p) {s7_if_t f; f = (s7_if_t)(**p); (*p)++; return(f(sc, p));}
+static s7_int sub_if_cc(s7_scheme *sc, s7_pointer **p) {s7_pointer x, y; x = (**p); (*p)++; y = (**p); (*p)++; return(integer(x) - integer(y));}
+static s7_int sub_if_cs(s7_scheme *sc, s7_pointer **p) {s7_pointer x, y; x = (**p); (*p)++; y = slot_value(**p); (*p)++; return(integer(x) - integer(y));}
+static s7_int sub_if_ss(s7_scheme *sc, s7_pointer **p) {s7_pointer x, y; x = slot_value(**p); (*p)++; y = slot_value(**p); (*p)++; return(integer(x) - integer(y));}
+static s7_int sub_if_sc(s7_scheme *sc, s7_pointer **p) {s7_pointer x, y; x = slot_value(**p); (*p)++; y = (**p); (*p)++; return(integer(x) - integer(y));}
-static s7_pointer g_cadaar(s7_scheme *sc, s7_pointer args)
+static s7_int sub_if_cp(s7_scheme *sc, s7_pointer **p)
{
- #define H_cadaar "(cadaar lst) returns (car (cdr (car (car lst)))): (cadaar '(((1 2 3)))) -> 2"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cadaar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cadaar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(caar(lst))) return(s7_wrong_type_arg_error(sc, "cadaar", 0, lst, "a list whose caar is also a list"));
- if (!is_pair(cdaar(lst))) return(s7_wrong_type_arg_error(sc, "cadaar", 0, lst, "a list whose cdaar is also a list"));
-
- return(car(cdr(car(car(lst)))));
+ s7_if_t xf;
+ s7_pointer x;
+ x = (**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ return(integer(x) - xf(sc, p));
}
-
-static s7_pointer g_caaddr(s7_scheme *sc, s7_pointer args)
+static s7_int sub_if_pc(s7_scheme *sc, s7_pointer **p)
{
- #define H_caaddr "(caaddr lst) returns (car (car (cdr (cdr lst)))): (caaddr '(1 2 (3 4))) -> 3"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caaddr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "caaddr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cddr(lst))) return(s7_wrong_type_arg_error(sc, "caaddr", 0, lst, "a list whose cddr is also a list"));
- if (!is_pair(caddr(lst))) return(s7_wrong_type_arg_error(sc, "caaddr", 0, lst, "a list whose caddr is also a list"));
-
- return(car(car(cdr(cdr(lst)))));
+ s7_if_t xf;
+ s7_int x;
+ s7_pointer y;
+ xf = (s7_if_t)(**p); (*p)++; x = xf(sc,p);
+ y = (**p); (*p)++;
+ return(x - integer(y));
}
-
-static s7_pointer g_cadddr(s7_scheme *sc, s7_pointer args)
+static s7_int sub_if_sp(s7_scheme *sc, s7_pointer **p)
{
- #define H_cadddr "(cadddr lst) returns (car (cdr (cdr (cdr lst)))): (cadddr '(1 2 3 4 5)) -> 4"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cadddr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cadddr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cddr(lst))) return(s7_wrong_type_arg_error(sc, "cadddr", 0, lst, "a list whose cddr is also a list"));
- if (!is_pair(cdddr(lst))) return(s7_wrong_type_arg_error(sc, "cadddr", 0, lst, "a list whose cdddr is also a list"));
-
- return(car(cdr(cdr(cdr(lst)))));
+ s7_if_t xf;
+ s7_pointer x;
+ x = slot_value(**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ return(integer(x) - xf(sc, p));
}
-
-static s7_pointer g_cadadr(s7_scheme *sc, s7_pointer args)
+static s7_int sub_if_ps(s7_scheme *sc, s7_pointer **p)
{
- #define H_cadadr "(cadadr lst) returns (car (cdr (car (cdr lst)))): (cadadr '(1 (2 3 4))) -> 3"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cadadr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cadadr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cadr(lst))) return(s7_wrong_type_arg_error(sc, "cadadr", 0, lst, "a list whose cadr is also a list"));
- if (!is_pair(cdadr(lst))) return(s7_wrong_type_arg_error(sc, "cadadr", 0, lst, "a list whose cdadr is also a list"));
-
- return(car(cdr(car(cdr(lst)))));
+ s7_if_t xf;
+ s7_int x;
+ s7_pointer y;
+ xf = (s7_if_t)(**p); (*p)++; x = xf(sc,p);
+ y = slot_value(**p); (*p)++;
+ return(x - integer(y));
}
-
-static s7_pointer g_caddar(s7_scheme *sc, s7_pointer args)
+static s7_int sub_if_pp(s7_scheme *sc, s7_pointer **p)
{
- #define H_caddar "(caddar lst) returns (car (cdr (cdr (car lst)))): (caddar '((1 2 3 4))) -> 3"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "caddar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "caddar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(cdar(lst))) return(s7_wrong_type_arg_error(sc, "caddar", 0, lst, "a list whose cdar is also a list"));
- if (!is_pair(cddar(lst))) return(s7_wrong_type_arg_error(sc, "caddar", 0, lst, "a list whose cddar is also a list"));
-
- return(car(cdr(cdr(car(lst)))));
+ s7_if_t xf;
+ s7_int x, y;
+ xf = (s7_if_t)(**p); (*p)++; x = xf(sc,p);
+ xf = (s7_if_t)(**p); (*p)++; y = xf(sc,p);
+ return(x - y);
}
-static s7_pointer g_cdaaar(s7_scheme *sc, s7_pointer args)
+static s7_if_t subtract_if(s7_scheme *sc, s7_pointer expr)
{
- #define H_cdaaar "(cdaaar lst) returns (cdr (car (car (car lst)))): (cdaaar '((((1 2 3))))) -> '(2 3)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdaaar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cdaaar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(caar(lst))) return(s7_wrong_type_arg_error(sc, "cdaaar", 0, lst, "a list whose caar is also a list"));
- if (!is_pair(caaar(lst))) return(s7_wrong_type_arg_error(sc, "cdaaar", 0, lst, "a list whose caaar is also a list"));
-
- return(cdr(car(car(car(lst)))));
+ s7_pointer a1, a2, slot;
+ xf_t *rc;
+ if (!is_pair(cdr(expr))) return(NULL);
+
+ xf_init(2);
+ a1 = cadr(expr);
+ if (is_null(cddr(expr)))
+ {
+ if (is_t_integer(a1))
+ {
+ xf_store(a1);
+ return(negate_if_c);
+ }
+ if (is_symbol(a1))
+ {
+ s7_pointer s1;
+ s1 = s7_slot(sc, a1);
+ if ((!is_slot(s1)) || (is_unsafe_stepper(s1)) || (!is_t_integer(slot_value(s1)))) return(NULL);
+ xf_store(s1);
+ return(negate_if_s);
+ }
+ if ((is_pair(a1)) &&
+ (s7_arg_to_if(sc, a1)))
+ return(negate_if_p);
+ return(NULL);
+ }
+
+ a2 = caddr(expr);
+ if (is_null(cdddr(expr)))
+ {
+ if (is_t_integer(a1))
+ {
+ xf_store(a1);
+ if (is_t_integer(a2))
+ {
+ xf_store(a2);
+ return(sub_if_cc);
+ }
+ if (is_symbol(a2))
+ {
+ slot = s7_slot(sc, a2);
+ if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
+ xf_store(slot);
+ return(sub_if_cs);
+ }
+ if ((is_pair(a2)) &&
+ (s7_arg_to_if(sc, a2)))
+ return(sub_if_cp);
+ return(NULL);
+ }
+ if (is_symbol(a1))
+ {
+ slot = s7_slot(sc, a1);
+ if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
+ xf_store(slot);
+ if (is_t_integer(a2))
+ {
+ xf_store(a2);
+ return(sub_if_sc);
+ }
+ if (is_symbol(a2))
+ {
+ slot = s7_slot(sc, a2);
+ if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
+ xf_store(slot);
+ return(sub_if_ss);
+ }
+ if ((is_pair(a2)) &&
+ (s7_arg_to_if(sc, a2)))
+ return(sub_if_sp);
+ return(NULL);
+ }
+ if (is_pair(a1) &&
+ (s7_arg_to_if(sc, a1)))
+ {
+ if (is_t_integer(a2))
+ {
+ xf_store(a2);
+ return(sub_if_pc);
+ }
+ if (is_symbol(a2))
+ {
+ slot = s7_slot(sc, a2);
+ if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
+ xf_store(slot);
+ return(sub_if_ps);
+ }
+ if ((is_pair(a2)) &&
+ (s7_arg_to_if(sc, a2)))
+ return(sub_if_pp);
+ }
+ return(NULL);
+ }
+
+ {
+ s7_if_t xf, res;
+ ptr_int loc;
+
+ if (is_t_integer(a1))
+ {
+ xf_store(a1);
+ res = sub_if_cp;
+ }
+ else
+ {
+ if (is_symbol(a1))
+ {
+ slot = s7_slot(sc, a1);
+ if ((!slot) || (!is_t_integer(slot_value(slot))) || (is_unsafe_stepper(slot))) return(NULL);
+ xf_store(slot);
+ res = sub_if_sp;
+ }
+ else
+ {
+ if ((!is_pair(a1)) || (!s7_arg_to_if(sc, a1))) return(NULL);
+ res = sub_if_pp;
+ }
+ }
+
+ xf_save_loc(loc);
+ xf = add_if(sc, cdr(expr));
+ if (xf)
+ {
+ xf_store_at(loc, (s7_pointer)xf);
+ return(res);
+ }
+ }
+ return(NULL);
}
-static s7_pointer g_cdaadr(s7_scheme *sc, s7_pointer args)
-{
- #define H_cdaadr "(cdaadr lst) returns (cdr (car (car (cdr lst)))): (cdaadr '(1 ((2 3 4)))) -> '(3 4)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdaadr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cdaadr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cadr(lst))) return(s7_wrong_type_arg_error(sc, "cdaadr", 0, lst, "a list whose cadr is also a list"));
- if (!is_pair(caadr(lst))) return(s7_wrong_type_arg_error(sc, "cdaadr", 0, lst, "a list whose caadr is also a list"));
+static s7_double negate_rf_c(s7_scheme *sc, s7_pointer **p) {s7_pointer x; x = (**p); (*p)++; return(-(real_to_double(sc, x, "-")));}
+static s7_double negate_rf_s(s7_scheme *sc, s7_pointer **p) {s7_pointer x; x = slot_value(**p); (*p)++; return(-(real_to_double(sc, x, "-")));}
+static s7_double negate_rf_p(s7_scheme *sc, s7_pointer **p) {s7_rf_t f; f = (s7_rf_t)(**p); (*p)++; return(f(sc, p));}
- return(cdr(car(car(cdr(lst)))));
+static s7_double sub_rf_cc(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer x, y;
+ x = (**p); (*p)++;
+ y = (**p); (*p)++;
+ return(real(x) - real_to_double(sc, y, "-"));
}
-
-static s7_pointer g_cdadar(s7_scheme *sc, s7_pointer args)
+static s7_double sub_rf_cs(s7_scheme *sc, s7_pointer **p)
{
- #define H_cdadar "(cdadar lst) returns (cdr (car (cdr (car lst)))): (cdadar '((1 (2 3 4)))) -> '(3 4)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdadar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cdadar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(cdar(lst))) return(s7_wrong_type_arg_error(sc, "cdadar", 0, lst, "a list whose cdar is also a list"));
- if (!is_pair(cadar(lst))) return(s7_wrong_type_arg_error(sc, "cdadar", 0, lst, "a list whose cadar is also a list"));
-
- return(cdr(car(cdr(car(lst)))));
+ s7_pointer x, y;
+ x = (**p); (*p)++;
+ y = slot_value(**p); (*p)++;
+ return(real(x) - real_to_double(sc, y, "-"));
}
-
-static s7_pointer g_cddaar(s7_scheme *sc, s7_pointer args)
+static s7_double sub_rf_ss(s7_scheme *sc, s7_pointer **p)
{
- #define H_cddaar "(cddaar lst) returns (cdr (cdr (car (car lst)))): (cddaar '(((1 2 3 4)))) -> '(3 4)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cddaar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cddaar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(caar(lst))) return(s7_wrong_type_arg_error(sc, "cddaar", 0, lst, "a list whose caar is also a list"));
- if (!is_pair(cdaar(lst))) return(s7_wrong_type_arg_error(sc, "cddaar", 0, lst, "a list whose cdaar is also a list"));
-
- return(cdr(cdr(car(car(lst)))));
+ s7_pointer x, y;
+ s7_double x1;
+ x = slot_value(**p); (*p)++;
+ y = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, x, "-");
+ return(x1 - real_to_double(sc, y, "-"));
}
-
-static s7_pointer g_cdaddr(s7_scheme *sc, s7_pointer args)
+static s7_double sub_rf_sc(s7_scheme *sc, s7_pointer **p)
{
- #define H_cdaddr "(cdaddr lst) returns (cdr (car (cdr (cdr lst)))): (cdaddr '(1 2 (3 4 5))) -> '(4 5)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdaddr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cdaddr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cddr(lst))) return(s7_wrong_type_arg_error(sc, "cdaddr", 0, lst, "a list whose cddr is also a list"));
- if (!is_pair(caddr(lst))) return(s7_wrong_type_arg_error(sc, "cdaddr", 0, lst, "a list whose caddr is also a list"));
-
- return(cdr(car(cdr(cdr(lst)))));
+ s7_pointer x, y;
+ x = slot_value(**p); (*p)++;
+ y = (**p); (*p)++;
+ return(real_to_double(sc, x, "-") - real(y));
}
-
-static s7_pointer g_cddddr(s7_scheme *sc, s7_pointer args)
+static s7_double sub_rf_cp(s7_scheme *sc, s7_pointer **p)
{
- #define H_cddddr "(cddddr lst) returns (cdr (cdr (cdr (cdr lst)))): (cddddr '(1 2 3 4 5)) -> '(5)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cddddr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cddddr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cddr(lst))) return(s7_wrong_type_arg_error(sc, "cddddr", 0, lst, "a list whose cddr is also a list"));
- if (!is_pair(cdddr(lst))) return(s7_wrong_type_arg_error(sc, "cddddr", 0, lst, "a list whose cdddr is also a list"));
-
- return(cdr(cdr(cdr(cdr(lst)))));
+ s7_rf_t rf;
+ s7_pointer x;
+ x = (**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ return(real_to_double(sc, x, "-") - rf(sc, p));
}
-
-static s7_pointer g_cddadr(s7_scheme *sc, s7_pointer args)
+static s7_double sub_rf_pc(s7_scheme *sc, s7_pointer **p)
{
- #define H_cddadr "(cddadr lst) returns (cdr (cdr (car (cdr lst)))): (cddadr '(1 (2 3 4 5))) -> '(4 5)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cddadr", 0, lst, "a pair"));
- if (!is_pair(cdr(lst))) return(s7_wrong_type_arg_error(sc, "cddadr", 0, lst, "a list whose cdr is also a list"));
- if (!is_pair(cadr(lst))) return(s7_wrong_type_arg_error(sc, "cddadr", 0, lst, "a list whose cadr is also a list"));
- if (!is_pair(cdadr(lst))) return(s7_wrong_type_arg_error(sc, "cddadr", 0, lst, "a list whose cdadr is also a list"));
-
- return(cdr(cdr(car(cdr(lst)))));
+ s7_rf_t rf;
+ s7_double x;
+ s7_pointer y;
+ rf = (s7_rf_t)(**p); (*p)++; x = rf(sc,p);
+ y = (**p); (*p)++;
+ return(x - real_to_double(sc, y, "-"));
}
-
-static s7_pointer g_cdddar(s7_scheme *sc, s7_pointer args)
+static s7_double sub_rf_sp(s7_scheme *sc, s7_pointer **p)
{
- #define H_cdddar "(cdddar lst) returns (cdr (cdr (cdr (car lst)))): (cdddar '((1 2 3 4 5))) -> '(4 5)"
- s7_pointer lst = car(args);
-
- if (!is_pair(lst)) return(s7_wrong_type_arg_error(sc, "cdddar", 0, lst, "a pair"));
- if (!is_pair(car(lst))) return(s7_wrong_type_arg_error(sc, "cdddar", 0, lst, "a list whose car is also a list"));
- if (!is_pair(cdar(lst))) return(s7_wrong_type_arg_error(sc, "cdddar", 0, lst, "a list whose cdar is also a list"));
- if (!is_pair(cddar(lst))) return(s7_wrong_type_arg_error(sc, "cdddar", 0, lst, "a list whose cddar is also a list"));
-
- return(cdr(cdr(cdr(car(lst)))));
+ s7_rf_t rf;
+ s7_pointer x;
+ x = slot_value(**p); (*p)++;
+ rf = (s7_rf_t)(**p); (*p)++;
+ return(real_to_double(sc, x, "-") - rf(sc, p));
}
-
-/* reverse is in the generic function section */
-static s7_pointer g_reverse_in_place(s7_scheme *sc, s7_pointer args)
+static s7_double sub_rf_ps(s7_scheme *sc, s7_pointer **p)
{
- #define H_reverse_in_place "(reverse! lst) reverses lst in place"
- s7_pointer p, np;
-
- p = car(args);
- if (p == sc->NIL)
- return(sc->NIL);
-
- if (!is_pair(p))
- return(s7_wrong_type_arg_error(sc, "reverse!", 0, p, "a list"));
-
- np = reverse_in_place(sc, sc->NIL, p);
- if (np == sc->NIL)
- return(s7_wrong_type_arg_error(sc, "reverse!", 0, p, "a proper list"));
-
- return(np);
+ s7_rf_t rf;
+ s7_double x;
+ s7_pointer y;
+ rf = (s7_rf_t)(**p); (*p)++; x = rf(sc,p);
+ y = slot_value(**p); (*p)++;
+ return(x - real_to_double(sc, y, "-"));
}
-
-#if 0
-s7_pointer s7_remq(s7_scheme *sc, s7_pointer a, s7_pointer obj)
+static s7_double sub_rf_pp(s7_scheme *sc, s7_pointer **p)
{
- s7_pointer p;
-
- sc->w = sc->NIL;
- for ( ; is_pair(a); a = cdr(a))
- if (car(a) != obj) /* use s7_is_eqv here for remv */
- sc->w = s7_cons(sc, car(a), sc->w);
- p = sc->w;
- sc->w = sc->NIL;
-
- return(s7_reverse(sc, p));
+ s7_rf_t rf;
+ s7_double x, y;
+ rf = (s7_rf_t)(**p); (*p)++; x = rf(sc,p);
+ rf = (s7_rf_t)(**p); (*p)++; y = rf(sc,p);
+ return(x - y);
}
-#endif
-
-static s7_pointer g_assq(s7_scheme *sc, s7_pointer args)
+static s7_rf_t subtract_rf(s7_scheme *sc, s7_pointer expr)
{
- #define H_assq "(assq obj alist) returns the key-value pair associated (via eq?) with the key obj in the association list alist"
- /* this version accepts any kind of list
- * my little essay: the scheme standard should not unnecessarily restrict the kinds of arguments
- * a function can take (such as saying memq only accepts proper lists). It is
- * trivial for the programmer to add such a check to a built-in function, but
- * not trivial to re-invent the built-in function with that restriction removed.
- * If some structure exists as a normal scheme object (a dotted or circular list),
- * every built-in function should be able to deal with it, if it makes sense at all.
- */
-
- s7_pointer x, y, obj;
-
- x = cadr(args);
- if (x == sc->NIL) return(sc->F);
- if (!is_pair(x))
- return(s7_wrong_type_arg_error(sc, "assq", 2, x, "a list"));
-
- y = x;
- obj = car(args);
-
- while (true)
+ s7_pointer a1, a2, slot1, slot2;
+ xf_t *rc;
+ if (!is_pair(cdr(expr))) return(NULL);
+
+ xf_init(2);
+ a1 = cadr(expr);
+ if (is_null(cddr(expr)))
{
- if ((is_pair(car(x))) && (obj == caar(x))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- if ((is_pair(car(x))) && (obj == caar(x))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- y = cdr(y);
- if (x == y) return(sc->F);
+ if (is_t_real(a1))
+ {
+ xf_store(a1);
+ return(negate_rf_c);
+ }
+ if (is_symbol(a1))
+ {
+ slot1 = s7_slot(sc, a1);
+ if ((!is_slot(slot1)) || (is_unsafe_stepper(slot1)) || (!(is_real(slot_value(slot1))))) return(NULL);
+ xf_store(slot1);
+ return(negate_rf_s);
+ }
+ if ((is_pair(a1)) &&
+ (s7_arg_to_if(sc, a1)))
+ return(negate_rf_p);
+ return(NULL);
}
- return(sc->F); /* not reached */
+
+ a2 = caddr(expr);
+ if (is_null(cdddr(expr)))
+ {
+ if (is_t_real(a1))
+ {
+ xf_store(a1);
+ if (is_real(a2))
+ {
+ xf_store(a2);
+ return(sub_rf_cc);
+ }
+ if (is_symbol(a2))
+ {
+ slot2 = s7_slot(sc, a2);
+ if ((!slot2) || (!is_real(slot_value(slot2))) || (is_unsafe_stepper(slot2))) return(NULL);
+ xf_store(slot2);
+ return(sub_rf_cs);
+ }
+ if ((is_pair(a2)) &&
+ (s7_arg_to_if(sc, a2)))
+ return(sub_rf_cp);
+ return(NULL);
+ }
+ if (is_symbol(a1))
+ {
+ slot1 = s7_slot(sc, a1);
+ if ((!slot1) || (!is_real(slot_value(slot1))) || (is_unsafe_stepper(slot1))) return(NULL);
+ xf_store(slot1);
+ if (is_t_real(a2))
+ {
+ xf_store(a2);
+ return(sub_rf_sc);
+ }
+ if (is_symbol(a2))
+ {
+ slot2 = s7_slot(sc, a2);
+ if ((!slot2) || (!is_real(slot_value(slot2))) || (is_unsafe_stepper(slot2))) return(NULL);
+ if ((!is_t_real(slot_value(slot1))) && (!is_t_real(slot_value(slot2)))) return(NULL);
+ xf_store(slot2);
+ return(sub_rf_ss);
+ }
+ if ((is_pair(a2)) &&
+ (s7_arg_to_rf(sc, a2)))
+ return(sub_rf_sp);
+ return(NULL);
+ }
+ if (is_pair(a1) &&
+ (s7_arg_to_rf(sc, a1)))
+ {
+ if (is_real(a2))
+ {
+ xf_store(a2);
+ return(sub_rf_pc);
+ }
+ if (is_symbol(a2))
+ {
+ slot2 = s7_slot(sc, a2);
+ if ((!slot2) || (!is_real(slot_value(slot2))) || (is_unsafe_stepper(slot2))) return(NULL);
+ xf_store(slot2);
+ return(sub_rf_ps);
+ }
+ if ((is_pair(a2)) &&
+ (s7_arg_to_rf(sc, a2)))
+ return(sub_rf_pp);
+ }
+ return(NULL);
+ }
+
+ {
+ s7_rf_t rf, res;
+ ptr_int loc;
+
+ if (is_real(a1))
+ {
+ xf_store(a1);
+ res = sub_rf_cp;
+ }
+ else
+ {
+ if (is_symbol(a1))
+ {
+ slot1 = s7_slot(sc, a1);
+ if ((!slot1) || (!is_t_integer(slot_value(slot1))) || (is_unsafe_stepper(slot1))) return(NULL);
+ xf_store(slot1);
+ res = sub_rf_sp;
+ }
+ else
+ {
+ if ((!is_pair(a1)) || (!s7_arg_to_rf(sc, a1))) return(NULL);
+ res = sub_rf_pp;
+ }
+ }
+
+ xf_save_loc(loc);
+ rf = add_rf(sc, cdr(expr));
+ if (rf)
+ {
+ xf_store_at(loc, (s7_pointer)rf);
+ return(res);
+ }
+ }
+ return(NULL);
}
-
-static s7_pointer g_assv(s7_scheme *sc, s7_pointer args)
+#if WITH_ADD_PF
+static s7_pointer c_subtract_pf2(s7_scheme *sc, s7_pointer **p)
{
- #define H_assv "(assv obj alist) returns the key-value pair associated (via eqv?) with the key obj in the association list alist"
- s7_pointer x, y, obj;
-
- x = cadr(args);
- if (x == sc->NIL) return(sc->F);
- if (!is_pair(x))
- return(s7_wrong_type_arg_error(sc, "assv", 2, x, "a list"));
-
- y = x;
- obj = car(args);
+ s7_pf_t pf;
+ s7_pointer x, y;
+ pf = (s7_pf_t)(**p); (*p)++;
+ x = pf(sc, p);
+ xf_push(sc, x);
+ pf = (s7_pf_t)(**p); (*p)++;
+ y = pf(sc, p);
+ x = g_subtract_2(sc, set_plist_2(sc, x, y));
+ xf_pop(sc);
+ return(x);
+}
- while (true)
+static s7_pf_t subtract_pf(s7_scheme *sc, s7_pointer expr)
+{
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len == 3)
{
- if ((is_pair(car(x))) && (s7_is_eqv(obj, caar(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- if ((is_pair(car(x))) && (s7_is_eqv(obj, caar(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
-
- y = cdr(y);
- if (x == y) return(sc->F);
+ if ((s7_arg_to_pf(sc, cadr(expr))) &&
+ (s7_arg_to_pf(sc, caddr(expr))))
+ return(c_subtract_pf2);
}
- return(sc->F); /* not reached */
+ return(NULL);
}
+#endif
+#endif
-static s7_pointer g_assoc(s7_scheme *sc, s7_pointer args)
-{
- #define H_assoc "(assoc obj alist (func #f)) returns the key-value pair associated (via equal?) with the key obj in the association list alist.\
-If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
-
- s7_pointer x, y, obj;
+/* ---------------------------------------- multiply ---------------------------------------- */
- if (cddr(args) != sc->NIL)
- {
- s7_pointer eq_func;
- /* check 3rd arg before 2nd (trailing arg error check) */
+static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
+{
+ #define H_multiply "(* ...) multiplies its arguments"
+ #define Q_multiply pcl_n
- eq_func = caddr(args);
- if (!is_procedure(eq_func))
- return(s7_wrong_type_arg_error(sc, "assoc function,", 3, eq_func, "a function"));
- if (!args_match(sc, eq_func, 2))
- return(s7_wrong_type_arg_error(sc, "assoc", 3, eq_func, "a procedure that can take 2 arguments"));
+ s7_pointer x, p;
+ s7_int num_a, den_a;
+ s7_double rl_a, im_a;
- x = cadr(args);
- if (x == sc->NIL) return(sc->F);
- if (!is_pair(x))
- return(s7_wrong_type_arg_error(sc, "assoc", 2, x, "a list"));
- if (!is_pair(car(x)))
- return(s7_wrong_type_arg_error(sc, "assoc", 2, x, "an a-list")); /* we're assuming caar below so it better exist */
-
- sc->code = eq_func;
- sc->args = make_list_3(sc, make_list_2(sc, car(args), caar(x)), x, x);
- sc->value = sc->F;
- push_stack(sc, opcode(OP_ASSOC_IF), sc->args, sc->code);
+#if (!WITH_GMP)
+ if (is_null(args))
+ return(small_int(1));
+#endif
- sc->args = car(sc->args);
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->UNSPECIFIED);
+ x = car(args);
+ p = cdr(args);
+ if (is_null(p))
+ {
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, args, A_NUMBER, 0);
+ return(x);
}
- x = cadr(args);
- if (x == sc->NIL) return(sc->F);
- if (!is_pair(x))
- return(s7_wrong_type_arg_error(sc, "assoc", 2, x, "a list"));
+ switch (type(x))
+ {
+ case T_INTEGER:
+ num_a = integer(x);
- y = x;
- obj = car(args);
+ MULTIPLY_INTEGERS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_multiply(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+#if WITH_GMP
+ if ((integer(x) > s7_int32_max) ||
+ (integer(x) < s7_int32_min))
+ return(big_multiply(sc, cons(sc, s7_int_to_big_integer(sc, num_a), cons(sc, x, p))));
+#endif
- while (true)
- {
- if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int dn;
+ if (multiply_overflow(num_a, integer(x), &dn))
+ {
+ if (is_null(p)) return(make_real(sc, (s7_double)num_a * (s7_double)integer(x)));
+ rl_a = (s7_double)num_a * (s7_double)integer(x);
+ goto MULTIPLY_REALS;
+ }
+ num_a = dn;
+ }
+#else
+ /* perhaps put all the math-safety stuff on the 'safety switch?
+ * (* 256 17179869184 4194304) -> 0 which is annoying
+ * (* 134217728 137438953472) -> 0
+ */
+ if ((integer_length(num_a) + integer_length(integer(x))) >= s7_int_bits)
+ {
+ if (is_null(p)) return(make_real(sc, (s7_double)num_a * (s7_double)integer(x)));
+ rl_a = (s7_double)num_a * (s7_double)integer(x);
+ goto MULTIPLY_REALS;
+ }
+ num_a *= integer(x);
+#endif
+ if (is_null(p)) return(make_integer(sc, num_a));
+ goto MULTIPLY_INTEGERS;
- if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ case T_RATIO:
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int dn;
+ if (multiply_overflow(numerator(x), num_a, &dn))
+ {
+ if (is_null(p))
+ return(make_real(sc, (s7_double)num_a * fraction(x)));
+ rl_a = (s7_double)num_a * fraction(x);
+ goto MULTIPLY_REALS;
+ }
+ num_a = dn;
+ }
+#else
+ if ((integer_length(num_a) + integer_length(numerator(x))) >= s7_int_bits)
+ {
+ if (is_null(p))
+ return(make_real(sc, (s7_double)num_a * fraction(x)));
+ rl_a = (s7_double)num_a * fraction(x);
+ goto MULTIPLY_REALS;
+ }
+ num_a *= numerator(x);
+#endif
+ den_a = denominator(x);
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto MULTIPLY_INTEGERS;
+ goto MULTIPLY_RATIOS;
+
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, num_a * real(x)));
+ rl_a = num_a * real(x);
+ goto MULTIPLY_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, num_a * real_part(x), num_a * imag_part(x)));
+ rl_a = num_a * real_part(x);
+ im_a = num_a * imag_part(x);
+ goto MULTIPLY_COMPLEX;
- y = cdr(y);
- if (x == y) return(sc->F);
- }
- return(sc->F); /* not reached */
-}
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, cons(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ MULTIPLY_RATIOS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (den_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_multiply(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ /* as in +, this can overflow:
+ * (* 8 -9223372036854775807 8) -> 64
+ * (* 3/4 -9223372036854775807 8) -> 6
+ * (* 8 -9223372036854775808 8) -> 0
+ * (* -1 9223372036854775806 8) -> 16
+ * (* -9223372036854775808 8 1e+308) -> 0.0
+ */
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int dn;
+ if (multiply_overflow(integer(x), num_a, &dn))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a));
+ rl_a = ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a;
+ goto MULTIPLY_REALS;
+ }
+ num_a = dn;
+ }
+#else
+ if ((integer_length(num_a) + integer_length(integer(x))) >= s7_int_bits)
+ {
+ if (is_null(p))
+ return(make_real(sc, ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a));
+ rl_a = ((s7_double)integer(x) / (s7_double)den_a) * (s7_double)num_a;
+ goto MULTIPLY_REALS;
+ }
+ num_a *= integer(x);
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto MULTIPLY_INTEGERS;
+ goto MULTIPLY_RATIOS;
-static s7_pointer g_memq(s7_scheme *sc, s7_pointer args)
-{
- #define H_memq "(memq obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memq uses eq?"
+ case T_RATIO:
+ {
+#if (!WITH_GMP)
+ s7_int d1, n1;
+#endif
+ s7_int d2, n2;
+ d2 = denominator(x);
+ n2 = numerator(x);
+#if (!WITH_GMP)
+ d1 = den_a;
+ n1 = num_a;
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, n2, &num_a)) ||
+ (multiply_overflow(d1, d2, &den_a)))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2);
+ goto MULTIPLY_REALS;
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) || /* (* 1/524288 1/19073486328125) for example */
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ if ((integer_length(d1) + integer_length(d2) > s7_int_bits) ||
+ (integer_length(n1) + integer_length(n2) > s7_int_bits))
+ {
+ if (is_null(p))
+ return(make_real(sc, ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2)));
+ rl_a = ((long double)n1 / (long double)d1) * ((long double)n2 / (long double)d2);
+ goto MULTIPLY_REALS;
+ }
+ }
+ num_a *= n2;
+ den_a *= d2;
+#endif
+#else
+ num_a *= n2;
+ den_a *= d2;
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto MULTIPLY_INTEGERS;
+ goto MULTIPLY_RATIOS;
+ }
- /* this version accepts any kind of list (the previous one insisted on proper lists for some reason) */
- s7_pointer x, y, obj;
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, ((long double)num_a / (long double)den_a) * real(x)));
+ rl_a = ((long double)num_a / (long double)den_a) * real(x);
+ goto MULTIPLY_REALS;
- x = cadr(args);
- if (x == sc->NIL) return(sc->F);
- if (!is_pair(x))
- return(s7_wrong_type_arg_error(sc, "memq", 2, x, "a list"));
+ case T_COMPLEX:
+ {
+ s7_double frac;
+ frac = ((long double)num_a / (long double)den_a);
+ if (is_null(p)) return(s7_make_complex(sc, frac * real_part(x), frac * imag_part(x)));
+ rl_a = frac * real_part(x);
+ im_a = frac * imag_part(x);
+ goto MULTIPLY_COMPLEX;
+ }
- y = x;
- obj = car(args);
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
- while (true)
- {
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ case T_REAL:
+ rl_a = real(x);
- /* I think (memq 'c '(a b . c)) should return #f because otherwise
- * (memq '() ...) would return the '() at the end.
- */
+ MULTIPLY_REALS:
+ x = car(p);
+ p = cdr(p);
- if (obj == car(x)) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(make_real(sc, rl_a * integer(x)));
+ rl_a *= integer(x);
+ goto MULTIPLY_REALS;
+
+ case T_RATIO:
+ if (is_null(p)) return(make_real(sc, rl_a * fraction(x)));
+ rl_a *= (s7_double)fraction(x);
+ goto MULTIPLY_REALS;
+
+ case T_REAL:
+ if (is_null(p)) return(make_real(sc, rl_a * real(x)));
+ rl_a *= real(x);
+ goto MULTIPLY_REALS;
+
+ case T_COMPLEX:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * real_part(x), rl_a * imag_part(x)));
+ im_a = rl_a * imag_part(x);
+ rl_a *= real_part(x);
+ goto MULTIPLY_COMPLEX;
- y = cdr(y);
- if (x == y) return(sc->F);
- }
- return(sc->F); /* not reached */
-}
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
-static s7_pointer g_memv(s7_scheme *sc, s7_pointer args)
-{
- #define H_memv "(memv obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memv uses eqv?"
- s7_pointer x, y, obj;
+ MULTIPLY_COMPLEX:
+ x = car(p);
+ p = cdr(p);
- x = cadr(args);
- if (x == sc->NIL) return(sc->F);
- if (!is_pair(x))
- return(s7_wrong_type_arg_error(sc, "memv", 2, x, "a list"));
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * integer(x), im_a * integer(x)));
+ rl_a *= integer(x);
+ im_a *= integer(x);
+ goto MULTIPLY_COMPLEX;
- y = x;
- obj = car(args);
+ case T_RATIO:
+ {
+ s7_double frac;
+ frac = fraction(x);
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * frac, im_a * frac));
+ rl_a *= frac;
+ im_a *= frac;
+ goto MULTIPLY_COMPLEX;
+ }
- while (true)
- {
- if (s7_is_eqv(obj, car(x))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ case T_REAL:
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * real(x), im_a * real(x)));
+ rl_a *= real(x);
+ im_a *= real(x);
+ goto MULTIPLY_COMPLEX;
- if (s7_is_eqv(obj, car(x))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ case T_COMPLEX:
+ {
+ s7_double r1, r2, i1, i2;
+ r1 = rl_a;
+ i1 = im_a;
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ if (is_null(p))
+ return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
+ rl_a = r1 * r2 - i1 * i2;
+ im_a = r1 * i2 + r2 * i1;
+ if (im_a == 0.0)
+ goto MULTIPLY_REALS;
+ goto MULTIPLY_COMPLEX;
+ }
- y = cdr(y);
- if (x == y) return(sc->F);
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
+
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, args, A_NUMBER, 1);
}
- return(sc->F); /* not reached */
}
+#if (!WITH_GMP)
+static s7_pointer multiply_2, multiply_fs, multiply_sf, multiply_is, multiply_si;
-static s7_pointer g_member(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_multiply_2(s7_scheme *sc, s7_pointer args)
{
- #define H_member "(member obj list (func #f)) looks for obj in list and returns the list from that point if it is found, otherwise #f. \
-member uses equal? If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
+ s7_pointer x, y;
+ x = car(args);
+ y = cadr(args);
- s7_pointer x, y, obj;
+ if (type(x) == type(y))
+ {
+ if (is_t_real(x))
+ return(make_real(sc, real(x) * real(y)));
+ else
+ {
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int n;
+ if (multiply_overflow(integer(x), integer(y), &n))
+ return(make_real(sc, ((s7_double)integer(x)) * ((s7_double)integer(y))));
+ return(make_integer(sc, n));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) * integer(y)));
+#endif
+ case T_RATIO: return(g_multiply(sc, args));
+ case T_REAL: return(make_real(sc, real(x) * real(y)));
+ case T_COMPLEX:
+ {
+ s7_double r1, r2, i1, i2;
+ r1 = real_part(x);
+ r2 = real_part(y);
+ i1 = imag_part(x);
+ i2 = imag_part(y);
+ return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
+ }
+ default:
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, args, A_NUMBER, 1);
+ method_or_bust_with_type(sc, y, sc->MULTIPLY, args, A_NUMBER, 2);
+ }
+ }
+ }
- if (cddr(args) != sc->NIL)
+ switch (type(x))
{
- s7_pointer eq_func;
- /* check 3rd arg before 2nd (trailing arg error check) */
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_integer(sc, integer(x) * integer(y)));
+ case T_RATIO: return(g_multiply(sc, args));
+ case T_REAL: return(make_real(sc, integer(x) * real(y)));
+ case T_COMPLEX: return(s7_make_complex(sc, integer(x) * real_part(y), integer(x) * imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->MULTIPLY, args, A_NUMBER, 2);
+ }
- eq_func = caddr(args);
- if (!is_procedure(eq_func))
- return(s7_wrong_type_arg_error(sc, "member function,", 3, eq_func, "a function"));
- if (!args_match(sc, eq_func, 2))
- return(s7_wrong_type_arg_error(sc, "member", 3, eq_func, "a procedure that can take 2 arguments"));
+ case T_RATIO:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ case T_RATIO: return(g_multiply(sc, args));
+ case T_REAL: return(make_real(sc, fraction(x) * real(y)));
+ case T_COMPLEX:
+ {
+ s7_double frac;
+ frac = fraction(x);
+ return(s7_make_complex(sc, frac * real_part(y), frac * imag_part(y)));
+ }
+ default:
+ method_or_bust_with_type(sc, y, sc->MULTIPLY, args, A_NUMBER, 2);
+ }
- x = cadr(args);
- if (x == sc->NIL) return(sc->F);
- if (!is_pair(x))
- return(s7_wrong_type_arg_error(sc, "member", 2, x, "a list"));
-
- sc->code = eq_func;
- sc->args = make_list_3(sc, make_list_2(sc, car(args), car(x)), x, x);
- sc->value = sc->F;
- push_stack(sc, opcode(OP_MEMBER_IF), sc->args, sc->code);
+ case T_REAL:
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_real(sc, real(x) * integer(y)));
+ case T_RATIO: return(make_real(sc, real(x) * fraction(y)));
+ case T_REAL: return(make_real(sc, real(x) * real(y)));
+ case T_COMPLEX: return(s7_make_complex(sc, real(x) * real_part(y), real(x) * imag_part(y)));
+ default:
+ method_or_bust_with_type(sc, y, sc->MULTIPLY, args, A_NUMBER, 2);
+ }
- sc->args = car(sc->args);
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->UNSPECIFIED);
+ case T_COMPLEX:
+ switch (type(y))
+ {
+ case T_INTEGER: return(s7_make_complex(sc, real_part(x) * integer(y), imag_part(x) * integer(y)));
+ case T_RATIO:
+ {
+ s7_double frac;
+ frac = fraction(y);
+ return(s7_make_complex(sc, real_part(x) * frac, imag_part(x) * frac));
+ }
+ case T_REAL: return(s7_make_complex(sc, real_part(x) * real(y), imag_part(x) * real(y)));
+ case T_COMPLEX:
+ {
+ s7_double r1, r2, i1, i2;
+ r1 = real_part(x);
+ r2 = real_part(y);
+ i1 = imag_part(x);
+ i2 = imag_part(y);
+ return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
+ }
+ default:
+ method_or_bust_with_type(sc, y, sc->MULTIPLY, args, A_NUMBER, 2);
+ }
+
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, args, A_NUMBER, 1);
}
+ return(x);
+}
- x = cadr(args);
- if (x == sc->NIL) return(sc->F);
- if (!is_pair(x))
- return(s7_wrong_type_arg_error(sc, "member", 2, x, "a list"));
-
- y = x;
- obj = car(args);
+/* all of these mess up if overflows occur
+ * (let () (define (f x) (* x 9223372036854775806)) (f -63)) -> -9223372036854775682, but (* -63 9223372036854775806) -> -5.810724383218509e+20
+ * how to catch this? (affects * - +)
+ */
- while (true)
- {
- if (s7_is_equal(sc, obj, car(x))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+static s7_pointer g_multiply_si(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x;
+ s7_int n;
- if (s7_is_equal(sc, obj, car(x))) return(x);
- x = cdr(x);
- if (!is_pair(x)) return(sc->F);
+ x = find_symbol_checked(sc, car(args));
+ n = integer(cadr(args));
- y = cdr(y);
- if (x == y) return(sc->F);
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (multiply_overflow(integer(x), n, &val))
+ return(make_real(sc, (double)integer(x) * (double)n));
+ return(make_integer(sc, val));
+ }
+ case T_RATIO:
+ {
+ s7_int val;
+ if (multiply_overflow(numerator(x), n, &val))
+ return(make_real(sc, fraction(x) * (double)n));
+ return(s7_make_ratio(sc, val, denominator(x)));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) * n));
+ case T_RATIO: return(s7_make_ratio(sc, numerator(x) * n, denominator(x)));
+#endif
+ case T_REAL: return(make_real(sc, real(x) * n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * n, imag_part(x) * n));
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, list_2(sc, x, cadr(args)), A_NUMBER, 1);
}
- return(sc->F); /* not reached */
+ return(x);
}
-
-
-static bool is_member(s7_pointer sym, s7_pointer lst)
+static s7_pointer g_multiply_is(s7_scheme *sc, s7_pointer args)
{
s7_pointer x;
- for (x = lst; is_pair(x); x = cdr(x))
- if (sym == car(x))
- return(true);
- return(false);
-}
-
+ s7_int n;
-static s7_pointer g_is_provided(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_provided "(provided? symbol) returns #t if symbol is a member of the *features* list"
- if (!s7_is_symbol(car(args)))
- return(s7_wrong_type_arg_error(sc, "provided?", 0, car(args), "a symbol"));
+ x = find_symbol_checked(sc, cadr(args));
+ n = integer(car(args));
- return(make_boolean(sc, is_member(car(args), s7_name_to_value(sc, "*features*"))));
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (multiply_overflow(integer(x), n, &val))
+ return(make_real(sc, (double)integer(x) * (double)n));
+ return(make_integer(sc, val));
+ }
+ case T_RATIO:
+ {
+ s7_int val;
+ if (multiply_overflow(numerator(x), n, &val))
+ return(make_real(sc, fraction(x) * (double)n));
+ return(s7_make_ratio(sc, val, denominator(x)));
+ }
+#else
+ case T_INTEGER: return(make_integer(sc, integer(x) * n));
+ case T_RATIO: return(s7_make_ratio(sc, numerator(x) * n, denominator(x)));
+#endif
+ case T_REAL: return(make_real(sc, real(x) * n));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * n, imag_part(x) * n));
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, list_2(sc, car(args), x), A_NUMBER, 2);
+ }
+ return(x);
}
-
-static s7_pointer g_provide(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_multiply_fs(s7_scheme *sc, s7_pointer args)
{
- #define H_provide "(provide symbol) adds symbol to the *features* list"
- s7_pointer features;
+ s7_pointer x;
+ s7_double scl;
- if ((typeflag(car(args)) & (T_MASKTYPE | T_SYNTAX)) != T_SYMBOL)
- return(s7_wrong_type_arg_error(sc, "provide", 0, car(args), "a symbol"));
+ scl = real(car(args));
+ x = find_symbol_checked(sc, cadr(args));
- features = make_symbol(sc, "*features*");
- if (!is_member(car(args), s7_symbol_value(sc, features)))
- s7_symbol_set_value(sc,
- features,
- s7_cons(sc,
- car(args),
- s7_symbol_value(sc, features)));
- return(car(args));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) * scl));
+ case T_RATIO: return(make_real(sc, numerator(x) * scl / denominator(x)));
+ case T_REAL: return(make_real(sc, real(x) * scl));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * scl, imag_part(x) * scl));
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, list_2(sc, car(args), x), A_NUMBER, 1);
+ }
+ return(x);
}
-
-void s7_provide(s7_scheme *sc, const char *feature)
+static s7_pointer g_multiply_sf(s7_scheme *sc, s7_pointer args)
{
- g_provide(sc, s7_cons(sc, s7_make_symbol(sc, feature), sc->NIL));
-}
+ s7_pointer x;
+ s7_double scl;
+ scl = real(cadr(args));
+ x = find_symbol_checked(sc, car(args));
-static s7_pointer g_features_set(s7_scheme *sc, s7_pointer args)
-{
- if ((is_pair(cadr(args))) ||
- (cadr(args) == sc->NIL))
- return(cadr(args));
- return(sc->ERROR);
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_real(sc, integer(x) * scl));
+ case T_RATIO: return(make_real(sc, numerator(x) * scl / denominator(x)));
+ case T_REAL: return(make_real(sc, real(x) * scl));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * scl, imag_part(x) * scl));
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, list_2(sc, x, cadr(args)), A_NUMBER, 2);
+ }
+ return(x);
}
-
-
-static s7_pointer g_list(s7_scheme *sc, s7_pointer args)
+static s7_pointer sqr_ss;
+static s7_pointer g_sqr_ss(s7_scheme *sc, s7_pointer args)
{
- #define H_list "(list ...) returns its arguments in a list"
+ s7_pointer x;
+ x = find_symbol_checked(sc, car(args));
- return(args);
+ switch (type(x))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ case T_INTEGER:
+ {
+ s7_int val;
+ if (multiply_overflow(integer(x), integer(x), &val))
+ return(make_real(sc, (double)integer(x) * (double)integer(x)));
+ return(make_integer(sc, val));
+ }
+ case T_RATIO:
+ {
+ s7_int num, den;
+ if ((multiply_overflow(numerator(x), numerator(x), &num)) ||
+ (multiply_overflow(denominator(x), denominator(x), &den)))
+ return(make_real(sc, fraction(x) * fraction(x)));
+ return(s7_make_ratio(sc, num, den));
+ }
+#else
+ case T_INTEGER: return(s7_make_integer(sc, integer(x) * integer(x)));
+ case T_RATIO: return(s7_make_ratio(sc, numerator(x) * numerator(x), denominator(x) * denominator(x)));
+#endif
+ case T_REAL: return(make_real(sc, real(x) * real(x)));
+ case T_COMPLEX: return(s7_make_complex(sc, real_part(x) * real_part(x) - imag_part(x) * imag_part(x), 2.0 * real_part(x) * imag_part(x)));
+ default:
+ method_or_bust_with_type(sc, x, sc->MULTIPLY, list_2(sc, x, x), A_NUMBER, 1);
+ }
+ return(x);
}
-
-static s7_pointer g_append(s7_scheme *sc, s7_pointer args)
+static s7_pointer mul_1ss;
+static s7_pointer g_mul_1ss(s7_scheme *sc, s7_pointer args)
{
- #define H_append "(append ...) returns its argument lists appended into one list"
- /* but weirdly (append '() 1) returns 1 */
+ /* (* (- 1.0 x) y) */
s7_pointer x, y;
- int i;
- if (args == sc->NIL)
- return(sc->NIL);
-
- if (cdr(args) == sc->NIL)
- return(car(args));
-
- x = sc->NIL;
- for (i = 1, y = args; y != sc->NIL; i++, y = cdr(y))
- {
- /* the original version used s7_append but that copies the arguments too many times if there are 3 or more lists */
- s7_pointer p;
- if (cdr(y) == sc->NIL)
- return(reverse_in_place(sc, car(y), x)); /* i.e. tack car(y) onto end of x copied and reversed */
+ x = find_symbol_checked(sc, caddr(car(args)));
+ y = find_symbol_checked(sc, cadr(args));
- p = car(y);
- if (!is_proper_list(sc, p))
- return(s7_wrong_type_arg_error(sc, "append", i, p, "a proper list"));
+ if ((is_t_real(x)) &&
+ (is_t_real(y)))
+ return(make_real(sc, real(y) * (1.0 - real(x))));
- while (p != sc->NIL)
+ if ((is_real(x)) &&
+ (is_real(y)))
+ {
+ s7_double x1;
+ x1 = real_to_double(sc, y, "*");
+ return(make_real(sc, x1 * (1.0 - real_to_double(sc, x, "*"))));
+ }
+ else
+ {
+ s7_double r1, r2, i1, i2;
+ if (!is_number(x))
{
- x = s7_cons(sc, car(p), x);
- p = cdr(p);
+ s7_pointer func;
+ if ((func = find_method(sc, find_let(sc, x), sc->SUBTRACT)) != sc->UNDEFINED)
+ return(g_multiply_2(sc, set_plist_2(sc, s7_apply_function(sc, func, list_2(sc, real_one, x)), y)));
+ return(wrong_type_argument_with_type(sc, sc->SUBTRACT, 2, x, A_NUMBER));
+ }
+ if (!is_number(y))
+ {
+ s7_pointer func;
+ if ((func = find_method(sc, find_let(sc, y), sc->MULTIPLY)) != sc->UNDEFINED)
+ return(s7_apply_function(sc, func, list_2(sc, g_subtract(sc, list_2(sc, real_one, x)), y)));
+ return(wrong_type_argument_with_type(sc, sc->MULTIPLY, 2, y, A_NUMBER));
}
+
+ r1 = 1.0 - s7_real_part(x);
+ r2 = s7_real_part(y);
+ i1 = -s7_imag_part(x);
+ i2 = s7_imag_part(y);
+ return(s7_make_complex(sc, r1 * r2 - i1 * i2, r1 * i2 + r2 * i1));
}
- return(x);
}
-
-static s7_pointer append_in_place(s7_scheme *sc, s7_pointer a, s7_pointer b)
+static s7_pointer multiply_cs_cos;
+static s7_pointer g_multiply_cs_cos(s7_scheme *sc, s7_pointer args)
{
- /* tack b onto the end of a without copying either -- 'a' is changed! */
- s7_pointer p;
- if (a == sc->NIL)
- return(b);
- p = a;
- while (cdr(p) != sc->NIL) p = cdr(p);
- cdr(p) = b;
- return(a);
-}
+ /* ([*] -2.0 r (cos x)) */
+ s7_pointer r, x;
+ r = find_symbol_checked(sc, cadr(args));
+ x = find_symbol_checked(sc, cadr(caddr(args)));
+ if ((is_t_real(r)) &&
+ (is_t_real(x)))
+ return(make_real(sc, real(car(args)) * real(r) * cos(real(x))));
-/* -------------------------------- vectors -------------------------------- */
-
-bool s7_is_vector(s7_pointer p)
-{
- return(type(p) == T_VECTOR);
+ if ((is_real(r)) &&
+ (is_real(x)))
+ return(make_real(sc, real(car(args)) * real_to_double(sc, r, "*") * cos(real_to_double(sc, x, "*"))));
+ return(g_multiply(sc, set_plist_3(sc, car(args), r, g_cos(sc, set_plist_1(sc, x)))));
}
-#define FILLED true
-#define NOT_FILLED false
-
-static s7_pointer make_vector_1(s7_scheme *sc, s7_Int len, bool filled)
+static s7_pointer mul_s_sin_s, mul_s_cos_s;
+static s7_pointer g_mul_s_sin_s(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- if (len > 0)
- {
- /* len is an "int" currently */
- float ilog2;
+ /* (* s (sin s)) */
+ s7_pointer x, y;
- ilog2 = log((double)len) / log(2.0);
- if (sizeof(size_t) > 4)
- {
- if (ilog2 > 56.0)
- return(s7_out_of_range_error(sc, "make-vector length,", 1, s7_make_integer(sc, len), "should be less than about 2^56 probably"));
- }
- else
- {
- if (ilog2 > 28.0)
- return(s7_out_of_range_error(sc, "make-vector length,", 1, s7_make_integer(sc, len), "should be less than about 2^28 probably"));
- }
- }
+ x = find_symbol_checked(sc, car(args));
+ y = find_symbol_checked(sc, cadadr(args));
- /* this has to follow the error checks! (else garbage in temps array confuses GC when "vector" is finalized) */
+ if ((is_real(x)) && (is_real(y)))
+ return(make_real(sc, real_to_double(sc, x, "*") * sin(real_to_double(sc, y, "sin"))));
- NEW_CELL(sc, x);
- vector_length(x) = 0;
- vector_elements(x) = NULL;
- set_type(x, T_VECTOR | T_FINALIZABLE | T_DONT_COPY | T_STRUCTURE);
+ return(g_multiply(sc, set_plist_2(sc, x, g_sin(sc, set_plist_1(sc, y)))));
+}
- /* in the multithread case, we can be interrupted here, and a subsequent GC mark sweep can see
- * this half-allocated vector. If length>0, and a non-null "elements" field is left over
- * from some previous use, the mark_vector function segfaults.
- */
+static s7_pointer g_mul_s_cos_s(s7_scheme *sc, s7_pointer args)
+{
+ /* (* s (cos s)) */
+ s7_pointer x, y;
- if (len > 0)
- {
- vector_elements(x) = (s7_pointer *)malloc(len * sizeof(s7_pointer));
- if (!(vector_elements(x)))
- return(s7_error(sc, make_symbol(sc, "out-of-memory"), make_protected_string(sc, "make-vector allocation failed!")));
+ x = find_symbol_checked(sc, car(args));
+ y = find_symbol_checked(sc, cadadr(args));
- vector_length(x) = len;
- if (filled) s7_vector_fill(sc, x, sc->NIL); /* make_hash_table assumes nil as the default value */
- }
+ if ((is_real(x)) && (is_real(y)))
+ return(make_real(sc, real_to_double(sc, x, "*") * cos(real_to_double(sc, y, "cos"))));
- x->object.vector.vextra.dim_info = NULL;
- return(x);
+ return(g_multiply(sc, set_plist_2(sc, x, g_cos(sc, set_plist_1(sc, y)))));
}
-s7_pointer s7_make_vector(s7_scheme *sc, s7_Int len)
+static s7_double multiply_rf_xx(s7_scheme *sc, s7_pointer **p)
{
- return(make_vector_1(sc, len, FILLED));
+ s7_rf_t r1, r2;
+ s7_double x, y;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_rf_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x * y);
}
+static s7_double multiply_rf_rx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1;
+ s7_rf_t r1;
+ s7_double x;
+ c1 = **p; (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x * real_to_double(sc, c1, "*"));
+}
-s7_Int s7_vector_length(s7_pointer vec)
+static s7_double multiply_rf_sx(s7_scheme *sc, s7_pointer **p)
{
- return(vector_length(vec));
+ s7_pointer s1;
+ s7_rf_t r1;
+ s7_double x;
+ s1 = slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x * real_to_double(sc, s1, "*"));
}
+static s7_double multiply_rf_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s7_double x1;
+ s1 = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, s1, "*");
+ s2 = slot_value(**p); (*p)++;
+ return(x1 * real_to_double(sc, s2, "*"));
+}
-s7_Int s7_vector_print_length(s7_scheme *sc)
+static s7_double multiply_rf_rs(s7_scheme *sc, s7_pointer **p)
{
- return(s7_integer(symbol_value(sc->vector_print_length)));
+ s7_pointer c1, s1;
+ s7_double x1;
+ s1 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ x1 = real_to_double(sc, c1, "*");
+ return(x1 * real_to_double(sc, s1, "*"));
}
-s7_Int s7_set_vector_print_length(s7_scheme *sc, s7_Int new_len)
+static s7_double multiply_rf_xxx(s7_scheme *sc, s7_pointer **p)
{
- s7_Int old_len;
- old_len = s7_integer(symbol_value(sc->vector_print_length));
- set_symbol_value(sc->vector_print_length, s7_make_integer(sc, new_len));
- return(old_len);
+ s7_rf_t r1, r2, r3;
+ s7_double x, y, z;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_rf_t)(**p); (*p)++;
+ y = r2(sc, p);
+ r3 = (s7_rf_t)(**p); (*p)++;
+ z = r3(sc, p);
+ return(x * y * z);
}
+static s7_double multiply_rf_rxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1;
+ s7_rf_t r1, r2;
+ s7_double x, y;
+ c1 = **p; (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_rf_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x * y * real_to_double(sc, c1, "*"));
+}
-static s7_pointer g_vector_print_length_set(s7_scheme *sc, s7_pointer args)
+static s7_double multiply_rf_sxx(s7_scheme *sc, s7_pointer **p)
{
- if (s7_is_integer(cadr(args)))
- {
- s7_Int len;
- len = s7_integer(cadr(args));
- if (len >= 0)
- return(cadr(args));
- }
- return(sc->ERROR);
+ s7_pointer s1;
+ s7_rf_t r1, r2;
+ s7_double x, y;
+ s1 = slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_rf_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x * y * real_to_double(sc, s1, "*"));
}
+static s7_double multiply_rf_rsx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1, s1;
+ s7_rf_t r1;
+ s7_double x, x1;
+ s1 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ x1 = real_to_double(sc, c1, "*");
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x * x1 * real_to_double(sc, s1, "*"));
+}
-#if (!WITH_GMP)
-void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
-#else
-static void vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
-#endif
+static s7_double multiply_rf_ssx(s7_scheme *sc, s7_pointer **p)
{
- s7_Int len, i = 1, left;
- s7_pointer *orig, *cur;
+ s7_pointer s1, s2;
+ s7_rf_t r1;
+ s7_double x, x1;
+ s1 = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, s1, "*");
+ s2 = slot_value(**p); (*p)++;
+ r1 = (s7_rf_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x * x1 * real_to_double(sc, s2, "*"));
+}
- len = vector_length(vec);
- if (len == 0) return;
+static s7_double multiply_rf_sss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2, s3;
+ s7_double x1, x2, x3;
+ s1 = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, s1, "*");
+ s2 = slot_value(**p); (*p)++;
+ x2 = real_to_double(sc, s2, "*");
+ s3 = slot_value(**p); (*p)++;
+ x3 = real_to_double(sc, s3, "*");
+ return(x1 * x2 * x3);
+}
- orig = vector_elements(vec);
- orig[0] = obj;
+static s7_double multiply_rf_rss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1, s1, s2;
+ s7_double x1, x2, x3;
+ s1 = slot_value(**p); (*p)++;
+ x1 = real_to_double(sc, s1, "*");
+ s2 = slot_value(**p); (*p)++;
+ x2 = real_to_double(sc, s2, "*");
+ c1 = **p; (*p)++;
+ x3 = real_to_double(sc, c1, "*");
+ return(x1 * x2 * x3);
+}
+
+static s7_rf_t multiply_rf_1(s7_scheme *sc, s7_pointer expr, int len)
+{
+ if (len == 3)
+ return(com_rf_2(sc, expr, multiply_r_ops));
+ if (len == 4)
+ return(com_rf_3(sc, expr, multiply_r_ops));
- while (i < len)
- {
- cur = (s7_pointer *)(orig + i);
- left = len - i;
- if (left < i)
- memcpy((void *)cur, (void *)orig, sizeof(s7_pointer) * left);
- else memcpy((void *)cur, (void *)orig, sizeof(s7_pointer) * i);
- i *= 2;
+ if (len > 4)
+ {
+ s7_rf_t rf;
+ ptr_int loc;
+ xf_t *rc;
+ int first_len;
+
+ xf_init(2);
+ first_len = (int)(len / 2);
+ xf_save_loc(loc);
+ rf = multiply_rf_1(sc, expr, first_len + 1);
+ if (rf)
+ {
+ int i;
+ s7_pointer p;
+ xf_store_at(loc, (s7_pointer)rf);
+ xf_save_loc(loc);
+ for (i = 0, p = expr; i < first_len; i++, p = cdr(p));
+ rf = multiply_rf_1(sc, p, len - first_len);
+ if (rf)
+ {
+ xf_store_at(loc, (s7_pointer)rf);
+ return(multiply_rf_xx);
+ }
+ else return(NULL);
+ }
+ else return(NULL);
}
+ return(NULL);
}
-
-static s7_pointer g_vector_fill(s7_scheme *sc, s7_pointer args)
+static s7_rf_t multiply_rf(s7_scheme *sc, s7_pointer expr)
{
- #define H_vector_fill "(vector-fill! v val) sets all elements of the vector v to val"
- s7_pointer x;
- x = car(args);
-
- if (!s7_is_vector(x))
- return(s7_wrong_type_arg_error(sc, "vector-fill!", 1, x, "a vector"));
-
- s7_vector_fill(sc, x, cadr(args));
- return(cadr(args));
+ return(multiply_rf_1(sc, expr, s7_list_length(sc, expr)));
}
-s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_Int index)
+static s7_int multiply_if_xx(s7_scheme *sc, s7_pointer **p)
{
- if (index >= vector_length(vec))
- return(s7_out_of_range_error(sc, "vector-ref index,", 2, s7_make_integer(sc, index), "should be less than vector length"));
-
- return(vector_element(vec, index));
+ s7_if_t r1, r2;
+ s7_int x, y;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_if_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x * y);
}
-
-s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_Int index, s7_pointer a)
+static s7_int multiply_if_rx(s7_scheme *sc, s7_pointer **p)
{
- if (index >= vector_length(vec))
- return(s7_out_of_range_error(sc, "vector-set! index,", 2, s7_make_integer(sc, index), "should be less than vector length"));
-
- vector_element(vec, index) = a;
- return(a);
+ s7_pointer c1;
+ s7_if_t r1;
+ s7_int x;
+ c1 = **p; (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x * integer(c1));
}
-
-s7_pointer *s7_vector_elements(s7_pointer vec)
+static s7_int multiply_if_sx(s7_scheme *sc, s7_pointer **p)
{
- return(vector_elements(vec));
+ s7_pointer s1;
+ s7_if_t r1;
+ s7_int x;
+ s1 = slot_value(**p); (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x * integer(s1));
}
+static s7_int multiply_if_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ return(integer(s1) * integer(s2));
+}
-s7_Int *s7_vector_dimensions(s7_pointer vec)
+static s7_int multiply_if_rs(s7_scheme *sc, s7_pointer **p)
{
- s7_Int *dims;
- if (vector_is_multidimensional(vec))
- return(vec->object.vector.vextra.dim_info->dims);
- dims = (s7_Int *)malloc(sizeof(s7_Int));
- dims[0] = vector_length(vec);
- return(dims);
+ s7_pointer c1, s1;
+ s1 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ return(integer(c1) * integer(s1));
}
-s7_Int *s7_vector_offsets(s7_pointer vec)
+static s7_int multiply_if_xxx(s7_scheme *sc, s7_pointer **p)
{
- s7_Int *offs;
- if (vector_is_multidimensional(vec))
- return(vec->object.vector.vextra.dim_info->offsets);
- offs = (s7_Int *)malloc(sizeof(s7_Int));
- offs[0] = 1;
- return(offs);
+ s7_if_t r1, r2, r3;
+ s7_int x, y, z;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_if_t)(**p); (*p)++;
+ y = r2(sc, p);
+ r3 = (s7_if_t)(**p); (*p)++;
+ z = r3(sc, p);
+ return(x * y * z);
}
+static s7_int multiply_if_rxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1;
+ s7_if_t r1, r2;
+ s7_int x, y;
+ c1 = **p; (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_if_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x * y * integer(c1));
+}
-s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect)
+static s7_int multiply_if_sxx(s7_scheme *sc, s7_pointer **p)
{
- s7_Int i, len;
- s7_pointer p;
- len = vector_length(vect);
- sc->w = sc->NIL;
- for (i = len - 1; i >= 0; i--)
- sc->w = s7_cons(sc, vector_element(vect, i), sc->w);
- p = sc->w;
- sc->w = sc->NIL;
- return(p);
+ s7_pointer s1;
+ s7_if_t r1, r2;
+ s7_int x, y;
+ s1 = slot_value(**p); (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ r2 = (s7_if_t)(**p); (*p)++;
+ y = r2(sc, p);
+ return(x * y * integer(s1));
}
+static s7_int multiply_if_rsx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer c1, s1;
+ s7_if_t r1;
+ s7_int x;
+ s1 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x * integer(c1) * integer(s1));
+}
-static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args)
+static s7_int multiply_if_ssx(s7_scheme *sc, s7_pointer **p)
{
- #define H_vector_to_list "(vector->list v) returns the elements of the vector v as a list; (map values v)"
- if (!s7_is_vector(car(args)))
- return(s7_wrong_type_arg_error(sc, "vector->list", 0, car(args), "a vector"));
- return(s7_vector_to_list(sc, car(args)));
+ s7_pointer s1, s2;
+ s7_if_t r1;
+ s7_int x;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ r1 = (s7_if_t)(**p); (*p)++;
+ x = r1(sc, p);
+ return(x * integer(s1) * integer(s2));
}
+static s7_int multiply_if_sss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2, s3;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ s3 = slot_value(**p); (*p)++;
+ return(integer(s1) * integer(s2) * integer(s3));
+}
-s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_Int len, s7_pointer fill)
+static s7_int multiply_if_rss(s7_scheme *sc, s7_pointer **p)
{
- s7_pointer vect;
- vect = make_vector_1(sc, len, NOT_FILLED);
- s7_vector_fill(sc, vect, fill);
- return(vect);
+ s7_pointer c1, s1, s2;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ c1 = **p; (*p)++;
+ return(integer(c1) * integer(s1) * integer(s2));
}
-static s7_pointer g_vector(s7_scheme *sc, s7_pointer args)
+static s7_if_t multiply_if_1(s7_scheme *sc, s7_pointer expr, int len)
{
- #define H_vector "(vector ...) returns a vector whose elements are the arguments"
- s7_Int i, len;
- s7_pointer vec;
-
- len = s7_list_length(sc, args);
- vec = make_vector_1(sc, len, NOT_FILLED);
- if (len > 0)
+ if (len == 3)
+ return(com_if_2(sc, expr, multiply_i_ops));
+ if (len == 4)
+ return(com_if_3(sc, expr, multiply_i_ops));
+
+ if (len > 4)
{
- s7_pointer x;
- for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
- vector_element(vec, i) = car(x);
+ s7_if_t xf;
+ xf_t *rc;
+ ptr_int loc;
+ int first_len;
+
+ xf_init(2);
+ first_len = (int)(len / 2);
+ xf_save_loc(loc);
+ xf = multiply_if_1(sc, expr, first_len + 1);
+ if (xf)
+ {
+ int i;
+ s7_pointer p;
+ xf_store_at(loc, (s7_pointer)xf);
+ xf_save_loc(loc);
+ for (i = 0, p = expr; i < first_len; i++, p = cdr(p));
+ xf = multiply_if_1(sc, p, len - first_len);
+ if (xf)
+ {
+ xf_store_at(loc, (s7_pointer)xf);
+ return(multiply_if_xx);
+ }
+ else return(NULL);
+ }
+ else return(NULL);
}
- return(vec);
+ return(NULL);
}
-
-static s7_pointer g_list_to_vector(s7_scheme *sc, s7_pointer args)
+static s7_if_t multiply_if(s7_scheme *sc, s7_pointer expr)
{
- #define H_list_to_vector "(list->vector lst) returns a vector containing the elements of lst; (apply vector lst)"
-
- if (car(args) == sc->NIL)
- return(s7_make_vector(sc, 0));
- if (!is_proper_list(sc, car(args)))
- return(s7_wrong_type_arg_error(sc, "list->vector", 0, car(args), "a proper list"));
- return(g_vector(sc, car(args)));
+ return(multiply_if_1(sc, expr, s7_list_length(sc, expr)));
}
-static s7_pointer g_vector_length(s7_scheme *sc, s7_pointer args)
+static void init_multiply_ops(void)
{
- #define H_vector_length "(vector-length v) returns the length of vector v"
- if (!s7_is_vector(car(args)))
- return(s7_wrong_type_arg_error(sc, "vector-length", 0, car(args), "a vector"));
- return(s7_make_integer(sc, vector_length(car(args))));
-}
+ multiply_r_ops = (rf_ops *)calloc(1, sizeof(rf_ops));
+ multiply_r_ops->r = rf_c;
+ multiply_r_ops->s = rf_s;
+ multiply_r_ops->rs = multiply_rf_rs;
+ multiply_r_ops->rp = multiply_rf_rx;
+ multiply_r_ops->sp = multiply_rf_sx;
+ multiply_r_ops->ss = multiply_rf_ss;
+ multiply_r_ops->pp = multiply_rf_xx;
-static s7_pointer make_shared_vector(s7_scheme *sc, s7_pointer vect, int skip_dims, s7_Int index)
-{
- s7_pointer x;
- s7_vdims_t *v;
+ multiply_r_ops->rss = multiply_rf_rss;
+ multiply_r_ops->rsp = multiply_rf_rsx;
+ multiply_r_ops->rpp = multiply_rf_rxx;
+ multiply_r_ops->sss = multiply_rf_sss;
+ multiply_r_ops->ssp = multiply_rf_ssx;
+ multiply_r_ops->spp = multiply_rf_sxx;
+ multiply_r_ops->ppp = multiply_rf_xxx;
- /* (let ((v #2d((1 2) (3 4)))) (v 1))
- * (let ((v (make-vector '(2 3 4) 0))) (v 1 2))
- * (let ((v #3d(((0 1 2 3) (4 5 6 7) (8 9 10 11)) ((12 13 14 15) (16 17 18 19) (20 21 22 23))))) (v 0 1))
- */
+ multiply_i_ops = (if_ops *)calloc(1, sizeof(if_ops));
+ multiply_i_ops->r = if_c;
+ multiply_i_ops->s = if_s;
- NEW_CELL(sc, x);
- vector_length(x) = 0;
- vector_elements(x) = NULL;
- set_type(x, T_VECTOR | T_FINALIZABLE | T_DONT_COPY | T_STRUCTURE);
+ multiply_i_ops->rs = multiply_if_rs;
+ multiply_i_ops->rp = multiply_if_rx;
+ multiply_i_ops->sp = multiply_if_sx;
+ multiply_i_ops->ss = multiply_if_ss;
+ multiply_i_ops->pp = multiply_if_xx;
- v = (s7_vdims_t *)malloc(sizeof(s7_vdims_t));
-
- v->ndims = vector_ndims(vect) - skip_dims;
- v->dims = (s7_Int *)((vect)->object.vector.vextra.dim_info->dims + skip_dims);
- v->offsets = (s7_Int *)((vect)->object.vector.vextra.dim_info->offsets + skip_dims);
- v->original = vect;
- x->object.vector.vextra.dim_info = v;
+ multiply_i_ops->rss = multiply_if_rss;
+ multiply_i_ops->rsp = multiply_if_rsx;
+ multiply_i_ops->rpp = multiply_if_rxx;
+ multiply_i_ops->sss = multiply_if_sss;
+ multiply_i_ops->ssp = multiply_if_ssx;
+ multiply_i_ops->spp = multiply_if_sxx;
+ multiply_i_ops->ppp = multiply_if_xxx;
+}
- vector_length(x) = vector_offset(vect, skip_dims - 1);
- vector_elements(x) = (s7_pointer *)(vector_elements(vect) + index);
+#if WITH_ADD_PF
+static s7_pointer c_mul_pf2(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t pf;
+ s7_pointer x, y;
+ pf = (s7_pf_t)(**p); (*p)++;
+ x = pf(sc, p);
+ xf_push(sc, x);
+ pf = (s7_pf_t)(**p); (*p)++;
+ y = pf(sc, p);
+ x = g_multiply_2(sc, set_plist_2(sc, x, y));
+ xf_pop(sc);
return(x);
}
-
-static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices)
+static s7_pf_t multiply_pf(s7_scheme *sc, s7_pointer expr)
{
- s7_Int index = 0;
- if (vector_length(vect) == 0)
- return(s7_out_of_range_error(sc, "vector-ref", 1, vect, "this vector has no elements, so vector-ref is hopeless"));
-
- if (vector_is_multidimensional(vect))
+ int len;
+ len = s7_list_length(sc, expr);
+ if (len == 3)
{
- int i;
- s7_pointer x;
- for (x = indices, i = 0; (x != sc->NIL) && (i < vector_ndims(vect)); x = cdr(x), i++)
- {
- s7_Int n;
- if (!s7_is_integer(car(x)))
- return(s7_wrong_type_arg_error(sc, "vector-ref index,", i + 2, car(x), "an integer"));
-
- n = s7_integer(car(x));
- if ((n < 0) ||
- (n >= vector_dimension(vect, i)))
- return(s7_out_of_range_error(sc, "vector-ref", i + 2, car(x), "index should be between 0 and the dimension size"));
+ if ((s7_arg_to_pf(sc, cadr(expr))) &&
+ (s7_arg_to_pf(sc, caddr(expr))))
+ return(c_mul_pf2);
+ }
+ return(NULL);
+}
+#endif
- index += n * vector_offset(vect, i);
- }
- if (x != sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "too many indices for vector-ref: ~A", indices));
+#endif /* with-gmp */
- /* if not enough indices, return a shared vector covering whatever is left */
- if (i < vector_ndims(vect))
- return(make_shared_vector(sc, vect, i, index));
- }
- else
- {
- /* (let ((hi (make-vector 3 0.0)) (sum 0.0)) (do ((i 0 (+ i 1))) ((= i 3)) (set! sum (+ sum (hi i)))) sum) */
- if (!s7_is_integer(car(indices)))
- return(s7_wrong_type_arg_error(sc, "vector-ref index,", 2, car(indices), "an integer"));
- index = s7_integer(car(indices));
- if ((index < 0) ||
- (index >= vector_length(vect)))
- return(s7_out_of_range_error(sc, "vector-ref index,", 2, car(indices), "should be between 0 and the vector length"));
-
- if (cdr(indices) != sc->NIL) /* (let ((L '#(#(1 2 3) #(4 5 6)))) (vector-ref L 1 2)) */
- {
- s7_pointer new_vect;
- new_vect = vector_element(vect, index);
- if (!s7_is_vector(new_vect)) /* (vector-ref #(1) 0 0) */
- return(s7_wrong_type_arg_error(sc, "vector-ref", 1, new_vect, "a vector"));
+/* ---------------------------------------- divide ---------------------------------------- */
- return(vector_ref_1(sc, new_vect, cdr(indices)));
- }
+static bool is_number_via_method(s7_scheme *sc, s7_pointer p)
+{
+ if (s7_is_number(p))
+ return(true);
+ if (has_methods(p))
+ {
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->IS_NUMBER);
+ if (f != sc->UNDEFINED)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL))));
}
-
- return(vector_element(vect, index));
+ return(false);
}
-
-static s7_pointer g_vector_ref(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
{
- #define H_vector_ref "(vector-ref v ... i) returns the i-th element of vector v. If v \
-is a multidimensional vector, you can also use (vector-ref v ...) where the trailing args \
-are the indices, or omit 'vector-ref': (v ...)."
-
- s7_pointer vec;
+ #define H_divide "(/ x1 ...) divides its first argument by the rest, or inverts the first if there is only one argument"
+ #define Q_divide pcl_n
- vec = car(args);
- if (!s7_is_vector(vec))
- return(s7_wrong_type_arg_error(sc, "vector-ref", 1, vec, "a vector"));
+ s7_pointer x, p;
+ s7_int num_a, den_a;
+ s7_double rl_a, im_a;
- return(vector_ref_1(sc, vec, cdr(args)));
-}
+ x = car(args);
+ p = cdr(args);
+ if (is_null(p))
+ {
+ if (!is_number(x))
+ method_or_bust_with_type(sc, x, sc->DIVIDE, args, A_NUMBER, 0);
+ if (s7_is_zero(x))
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ return(s7_invert(sc, x));
+ }
+ switch (type(x))
+ {
+ case T_INTEGER:
+ num_a = integer(x);
+ if (num_a == 0)
+ {
+ bool return_nan = false, return_real_zero = false;
+ for (; is_pair(p); p = cdr(p))
+ {
+ s7_pointer n;
+ n = car(p);
+ if (!s7_is_number(n))
+ {
+ n = check_values(sc, n, p);
+ if (!s7_is_number(n))
+ return(wrong_type_argument_with_type(sc, sc->DIVIDE, position_of(p, args), n, A_NUMBER));
+ }
+ if (s7_is_zero(n))
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ if (type(n) > T_RATIO)
+ {
+ return_real_zero = true;
+ if (is_NaN(s7_real_part(n)))
+ return_nan = true;
+ }
+ }
+ if (return_nan)
+ return(real_NaN);
+ if (return_real_zero)
+ return(real_zero);
+ return(small_int(0));
+ }
-static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args)
-{
- #define H_vector_set "(vector-set! v i ... value) sets the i-th element of vector v to value. If 'v' is \
-multidimensional you can also use (vector-set! v ... val) where the ellipsis refers to the indices. You \
-can also use 'set!' instead of 'vector-set!': (set! (v ...) val) -- I find this form much easier to read."
+ DIVIDE_INTEGERS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_divide(sc, cons(sc, s7_int_to_big_integer(sc, num_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
- s7_pointer vec, val;
- s7_Int index;
-
- vec = car(args);
- if (!s7_is_vector(vec))
- return(s7_wrong_type_arg_error(sc, "vector-set!", 1, vec, "a vector"));
- if (vector_length(vec) == 0)
- return(s7_out_of_range_error(sc, "vector-set!", 1, vec, "this vector has no elements, so vector-set! is hopeless"));
-
- if (vector_is_multidimensional(vec))
- {
- int i;
- s7_pointer x;
- index = 0;
- for (x = cdr(args), i = 0; (cdr(x) != sc->NIL) && (i < vector_ndims(vec)); x = cdr(x), i++)
+ switch (type(x))
{
- s7_Int n;
- if (!s7_is_integer(car(x)))
- return(s7_wrong_type_arg_error(sc, "vector-set! index,", i + 2, car(x), "an integer"));
+ case T_INTEGER:
+ if (integer(x) == 0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
- n = s7_integer(car(x));
- if ((n < 0) ||
- (n >= vector_dimension(vec, i)))
- return(s7_out_of_range_error(sc, "vector-set!", i, car(x), "index should be between 0 and the dimension size"));
+ /* to be consistent, I suppose we should search first for NaNs in the divisor list.
+ * (* 0 0/0) is NaN, so (/ 1 0 0/0) should equal (/ 1 0/0) = NaN. But the whole
+ * thing is ridiculous.
+ */
+ if (is_null(p))
+ return(s7_make_ratio(sc, num_a, integer(x)));
- index += n * vector_offset(vec, i);
+ den_a = integer(x);
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto DIVIDE_INTEGERS;
+ goto DIVIDE_RATIOS;
+
+ case T_RATIO:
+ den_a = denominator(x);
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int dn;
+ if (multiply_overflow(num_a, den_a, &dn))
+ {
+ if (is_null(p)) return(make_real(sc, num_a * inverted_fraction(x)));
+ rl_a = (s7_double)num_a * inverted_fraction(x);
+ goto DIVIDE_REALS;
+ }
+ num_a = dn;
+ }
+#else
+ if ((integer_length(num_a) + integer_length(den_a)) > s7_int_bits)
+ {
+ if (is_null(p)) return(make_real(sc, num_a * inverted_fraction(x)));
+ rl_a = (s7_double)num_a * inverted_fraction(x);
+ goto DIVIDE_REALS;
+ }
+ num_a *= den_a;
+#endif
+ den_a = numerator(x);
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto DIVIDE_INTEGERS;
+ goto DIVIDE_RATIOS;
+
+ case T_REAL:
+ rl_a = (s7_double)num_a;
+ if (real(x) == 0.0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ if (is_null(p)) return(make_real(sc, rl_a / real(x)));
+ rl_a /= real(x);
+ goto DIVIDE_REALS;
+
+ case T_COMPLEX:
+ {
+ s7_double i2, r2, den;
+ rl_a = (s7_double)num_a;
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ den = 1.0 / (r2 * r2 + i2 * i2);
+ /* we could avoid the squaring (see Knuth II p613 16)
+ * not a big deal: (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) => nan
+ * (gmp case is ok here)
+ */
+ if (is_null(p))
+ return(s7_make_complex(sc, rl_a * r2 * den, -(rl_a * i2 * den)));
+ im_a = -rl_a * i2 * den;
+ rl_a *= r2 * den;
+ goto DIVIDE_COMPLEX;
+ }
+
+ default:
+ method_or_bust_with_type(sc, x, sc->DIVIDE, cons(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
}
+ break;
- if (cdr(x) != sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "too many args for vector-set!: ~A", args));
- if (i != vector_ndims(vec))
- return(s7_wrong_number_of_args_error(sc, "not enough args for vector-set!: ~A", args));
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ DIVIDE_RATIOS:
+#if WITH_GMP
+ if ((num_a > s7_int32_max) ||
+ (den_a > s7_int32_max) ||
+ (num_a < s7_int32_min))
+ return(big_divide(sc, cons(sc, s7_ratio_to_big_ratio(sc, num_a, den_a), p)));
+#endif
+ x = car(p);
+ p = cdr(p);
- val = car(x);
- }
- else
- {
- if (!s7_is_integer(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "vector-set! index,", 2, cadr(args), "an integer"));
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+#if HAVE_OVERFLOW_CHECKS
+ {
+ s7_int dn;
+ if (multiply_overflow(den_a, integer(x), &dn))
+ {
+ if (is_null(p)) return(make_real(sc, (long double)num_a / ((long double)den_a * (s7_double)integer(x))));
+ rl_a = (long double)num_a / ((long double)den_a * (s7_double)integer(x));
+ goto DIVIDE_REALS;
+ }
+ den_a = dn;
+ }
+#else
+ if ((integer_length(integer(x)) + integer_length(den_a)) > s7_int_bits)
+ {
+ if (is_null(p)) return(make_real(sc, (long double)num_a / ((long double)den_a * (s7_double)integer(x))));
+ rl_a = (long double)num_a / ((long double)den_a * (s7_double)integer(x));
+ goto DIVIDE_REALS;
+ }
+ den_a *= integer(x);
+#endif
+ if (is_null(p)) return(s7_make_ratio(sc, num_a, den_a));
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto DIVIDE_INTEGERS;
+ goto DIVIDE_RATIOS;
- index = s7_integer(cadr(args));
- if ((index < 0) ||
- (index >= vector_length(vec)))
- return(s7_out_of_range_error(sc, "vector-set! index,", 2, cadr(args), "should be between 0 and the vector length"));
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = den_a;
+ n1 = num_a;
+ d2 = denominator(x);
+ n2 = numerator(x);
+ if (d1 == d2)
+ {
+ if (is_null(p))
+ return(s7_make_ratio(sc, n1, n2));
+ den_a = n2;
+ }
+ else
+ {
+#if (!WITH_GMP)
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &d1)))
+ {
+ s7_double r1, r2;
+ r1 = ((long double)num_a / (long double)den_a);
+ r2 = inverted_fraction(x);
+ if (is_null(p)) return(make_real(sc, r1 * r2));
+ rl_a = r1 * r2;
+ goto DIVIDE_REALS;
+ }
+ num_a = n1;
+ den_a = d1;
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ if ((integer_length(d1) + integer_length(n2) > s7_int_bits) ||
+ (integer_length(d2) + integer_length(n1) > s7_int_bits))
+ {
+ s7_double r1, r2;
+ r1 = ((long double)num_a / (long double)den_a);
+ r2 = inverted_fraction(x);
+ if (is_null(p)) return(make_real(sc, r1 * r2));
+ rl_a = r1 * r2;
+ goto DIVIDE_REALS;
+ }
+ }
+ num_a *= d2;
+ den_a *= n2;
+#endif
+#else
+ num_a *= d2;
+ den_a *= n2;
+#endif
+ if (is_null(p))
+ return(s7_make_ratio(sc, num_a, den_a));
+ }
+ if (reduce_fraction(sc, &num_a, &den_a) == T_INTEGER)
+ goto DIVIDE_INTEGERS;
+ goto DIVIDE_RATIOS;
+ }
- if (cdddr(args) != sc->NIL)
- return(g_vector_set(sc, s7_cons(sc, vector_element(vec, index), cddr(args))));
+ case T_REAL:
+ {
+ s7_double r1;
+ if (real(x) == 0.0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ r1 = ((long double)num_a / (long double)den_a);
+ if (is_null(p)) return(make_real(sc, r1 / real(x)));
+ rl_a = r1 / real(x);
+ goto DIVIDE_REALS;
+ }
- val = caddr(args);
- }
-
- vector_element(vec, index) = val;
- return(val);
-}
+ case T_COMPLEX:
+ {
+ s7_double den, i2, r2;
+ rl_a = ((long double)num_a / (long double)den_a);
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ den = 1.0 / (r2 * r2 + i2 * i2);
+ if (is_null(p))
+ return(s7_make_complex(sc, rl_a * r2 * den, -rl_a * i2 * den));
+ im_a = -rl_a * i2 * den;
+ rl_a *= r2 * den;
+ goto DIVIDE_COMPLEX;
+ }
+
+ default:
+ method_or_bust_with_type(sc, x, sc->DIVIDE, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
+ case T_REAL:
+ rl_a = real(x);
+ if (rl_a == 0)
+ {
+ bool return_nan = false;
+ for (; is_pair(p); p = cdr(p))
+ {
+ s7_pointer n;
+ n = car(p);
+ if (!s7_is_number(n))
+ {
+ n = check_values(sc, n, p);
+ if (!s7_is_number(n))
+ return(wrong_type_argument_with_type(sc, sc->DIVIDE, position_of(p, args), n, A_NUMBER));
+ }
+ if (s7_is_zero(n))
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ if ((is_t_real(n)) &&
+ (is_NaN(real(n))))
+ return_nan = true;
+ }
+ if (return_nan)
+ return(real_NaN);
+ return(real_zero);
+ }
-#define MAX_VECTOR_DIMENSIONS 512
+ DIVIDE_REALS:
+ x = car(p);
+ p = cdr(p);
-static s7_pointer g_make_vector(s7_scheme *sc, s7_pointer args)
-{
- #define H_make_vector "(make-vector len (value #f)) returns a vector of len elements initialized to value. \
-To create a multidimensional vector, put the dimension bounds in a list (this is to avoid ambiguities such as \
-(make-vector 1 2) where it's not clear whether the '2' is an initial value or a dimension size). (make-vector '(2 3) 1.0) \
-returns a 2 dimensional vector of 6 total elements, all initialized to 1.0."
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (integer(x) == 0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ if (is_null(p)) return(make_real(sc, rl_a / integer(x)));
+ rl_a /= (s7_double)integer(x);
+ goto DIVIDE_REALS;
+
+ case T_RATIO:
+ if (is_null(p)) return(make_real(sc, rl_a * inverted_fraction(x)));
+ rl_a *= (s7_double)inverted_fraction(x);
+ goto DIVIDE_REALS;
+
+ case T_REAL:
+ if (real(x) == 0.0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ if (is_null(p)) return(make_real(sc, rl_a / real(x)));
+ rl_a /= real(x);
+ goto DIVIDE_REALS;
+
+ case T_COMPLEX:
+ {
+ s7_double den, r2, i2;
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ den = 1.0 / (r2 * r2 + i2 * i2);
+ if (is_null(p))
+ return(s7_make_complex(sc, rl_a * r2 * den, -rl_a * i2 * den));
+ im_a = -rl_a * i2 * den;
+ rl_a *= r2 * den;
+ goto DIVIDE_COMPLEX;
+ }
- s7_Int len;
- s7_pointer x, fill, vec;
- fill = sc->UNSPECIFIED;
+ default:
+ method_or_bust_with_type(sc, x, sc->DIVIDE, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ break;
- x = car(args);
- if (s7_is_integer(x))
- {
- len = s7_integer(x);
- if (len < 0)
- return(s7_wrong_type_arg_error(sc, "make-vector length,", (cdr(args) == sc->NIL) ? 0 : 1, x, "a non-negative integer"));
- }
- else
- {
- s7_pointer y;
- if (!(is_pair(x)))
- return(s7_wrong_type_arg_error(sc, "make-vector", (cdr(args) == sc->NIL) ? 0 : 1, x, "an integer or a list of integers"));
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
- if (!s7_is_integer(car(x)))
- return(s7_wrong_type_arg_error(sc, "make-vector", (cdr(args) == sc->NIL) ? 0 : 1, car(x), "each dimension should be an integer"));
+ DIVIDE_COMPLEX:
+ x = car(p);
+ p = cdr(p);
- if (cdr(x) == sc->NIL)
- len = s7_integer(car(x));
- else
+ switch (type(x))
{
- int i, dims;
+ case T_INTEGER:
+ {
+ s7_double r1;
+ if (integer(x) == 0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ r1 = 1.0 / (s7_double)integer(x);
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * r1, im_a * r1));
+ rl_a *= r1;
+ im_a *= r1;
+ goto DIVIDE_COMPLEX;
+ }
- dims = s7_list_length(sc, x);
- if (dims <= 0) /* 0 if circular, negative if dotted */
- return(s7_wrong_type_arg_error(sc, "make-vector", (cdr(args) == sc->NIL) ? 0 : 1, x, "a proper list of dimensions"));
- if (dims > MAX_VECTOR_DIMENSIONS)
- return(s7_out_of_range_error(sc, "make-vector dimension list,", (cdr(args) == sc->NIL) ? 0 : 1, x, "less than 512 dimensions"));
+ case T_RATIO:
+ {
+ s7_double frac;
+ frac = inverted_fraction(x);
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * frac, im_a * frac));
+ rl_a *= frac;
+ im_a *= frac;
+ goto DIVIDE_COMPLEX;
+ }
- for (i = 1, len = 1, y = x; y != sc->NIL; y = cdr(y), i++)
- {
- if (!s7_is_integer(car(y)))
- return(s7_wrong_type_arg_error(sc, "make-vector", i, car(y), "an integer"));
- len *= s7_integer(car(y));
- if (len < 0)
- return(s7_wrong_type_arg_error(sc, "make-vector", i, car(y), "a non-negative integer"));
- }
+ case T_REAL:
+ {
+ s7_double r1;
+ if (real(x) == 0.0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ r1 = 1.0 / real(x);
+ if (is_null(p)) return(s7_make_complex(sc, rl_a * r1, im_a * r1));
+ rl_a *= r1;
+ im_a *= r1;
+ goto DIVIDE_COMPLEX;
+ }
+
+ case T_COMPLEX:
+ {
+ s7_double r1, r2, i1, i2, den;
+ r1 = rl_a;
+ i1 = im_a;
+ r2 = real_part(x);
+ i2 = imag_part(x);
+ den = 1.0 / (r2 * r2 + i2 * i2);
+ if (is_null(p))
+ return(s7_make_complex(sc, (r1 * r2 + i1 * i2) * den, (r2 * i1 - r1 * i2) * den));
+ rl_a = (r1 * r2 + i1 * i2) * den;
+ im_a = (r2 * i1 - r1 * i2) * den;
+ goto DIVIDE_COMPLEX;
+ }
+
+ default:
+ method_or_bust_with_type(sc, x, sc->DIVIDE, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
}
+ break;
+
+ default:
+ method_or_bust_with_type(sc, x, sc->DIVIDE, args, A_NUMBER, 1);
}
-
- if (cdr(args) != sc->NIL)
- fill = cadr(args);
+}
- vec = make_vector_1(sc, len, NOT_FILLED);
- if (len > 0) s7_vector_fill(sc, vec, fill);
- if ((is_pair(x)) &&
- (is_pair(cdr(x))))
+#if (!WITH_GMP)
+static s7_pointer invert_1;
+
+static s7_pointer g_invert_1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ p = car(args);
+ switch (type(p))
{
- int i;
- s7_Int offset = 1;
- s7_pointer y;
- s7_vdims_t *v;
+ case T_INTEGER:
+ if (integer(p) != 0)
+ return(s7_make_ratio(sc, 1, integer(p))); /* a already checked, not 0 */
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
- v = (s7_vdims_t *)malloc(sizeof(s7_vdims_t));
- v->ndims = safe_list_length(sc, x);
- v->dims = (s7_Int *)malloc(v->ndims * sizeof(s7_Int));
- v->offsets = (s7_Int *)malloc(v->ndims * sizeof(s7_Int));
- v->original = sc->F;
+ case T_RATIO:
+ return(s7_make_ratio(sc, denominator(p), numerator(p)));
- for (i = 0, y = x; y != sc->NIL; i++, y = cdr(y))
- v->dims[i] = s7_integer(car(y));
+ case T_REAL:
+ if (real(p) != 0.0)
+ return(make_real(sc, 1.0 / real(p)));
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
- for (i = v->ndims - 1; i >= 0; i--)
- {
- v->offsets[i] = offset;
- offset *= v->dims[i];
- }
+ case T_COMPLEX:
+ {
+ s7_double r2, i2, den;
+ r2 = real_part(p);
+ i2 = imag_part(p);
+ den = (r2 * r2 + i2 * i2);
+ return(s7_make_complex(sc, r2 / den, -i2 / den));
+ }
- vec->object.vector.vextra.dim_info = v;
+ default:
+ method_or_bust_with_type(sc, p, sc->DIVIDE, args, A_NUMBER, 1);
}
-
- return(vec);
}
-static s7_pointer g_is_vector(s7_scheme *sc, s7_pointer args)
+static s7_pointer divide_1r;
+static s7_pointer g_divide_1r(s7_scheme *sc, s7_pointer args)
{
- #define H_is_vector "(vector? obj) returns #t if obj is a vector"
- return(make_boolean(sc, s7_is_vector(car(args))));
+ if (s7_is_real(cadr(args)))
+ {
+ s7_double rl;
+ rl = real_to_double(sc, cadr(args), "/");
+ if (rl == 0.0)
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+ return(make_real(sc, 1.0 / rl));
+ }
+ return(g_divide(sc, args));
}
-int s7_vector_rank(s7_pointer vect)
+static s7_double c_dbl_invert(s7_scheme *sc, s7_double x)
{
- if (vector_is_multidimensional(vect))
- return(vector_ndims(vect));
- return(1);
+ if (x == 0.0) division_by_zero_error(sc, sc->DIVIDE, set_elist_1(sc, real_zero));
+ return(1.0 / x);
}
+static s7_double c_dbl_divide_2(s7_scheme *sc, s7_double x, s7_double y)
+{
+ if (y == 0.0) division_by_zero_error(sc, sc->DIVIDE, set_elist_2(sc, make_real(sc, x), real_zero));
+ return(x / y);
+}
-static s7_pointer g_vector_dimensions(s7_scheme *sc, s7_pointer args)
+static s7_double c_dbl_divide_3(s7_scheme *sc, s7_double x, s7_double y, s7_double z)
{
- #define H_vector_dimensions "(vector-dimensions vect) returns a list of vect's dimensions. In srfi-63 terms:\n\
- (define array-dimensions vector-dimensions)\n\
- (define (array-rank v) (length (vector-dimensions v)))"
+ s7_double d;
+ d = y * z;
+ if (d == 0.0) division_by_zero_error(sc, sc->DIVIDE, set_elist_3(sc, make_real(sc, x), make_real(sc, y), make_real(sc, z)));
+ return(x / d);
+}
- s7_pointer x;
+RF_3_TO_RF(divide, c_dbl_invert, c_dbl_divide_2, c_dbl_divide_3)
+#endif
- x = car(args);
- if (!s7_is_vector(x))
- return(s7_wrong_type_arg_error(sc, "vector-dimensions", 0, x, "a vector"));
- if (vector_is_multidimensional(x))
- {
- int i;
- sc->w = sc->NIL;
- for (i = vector_ndims(x) - 1; i >= 0; i--)
- sc->w = s7_cons(sc, s7_make_integer(sc, vector_dimension(x, i)), sc->w);
- x = sc->w;
- sc->w = sc->NIL;
- return(x);
- }
-
- return(make_list_1(sc, s7_make_integer(sc, vector_length(x))));
+/* ---------------------------------------- max/min ---------------------------------------- */
+
+static bool is_real_via_method_1(s7_scheme *sc, s7_pointer p)
+{
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->IS_REAL);
+ if (f != sc->UNDEFINED)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL))));
+ return(false);
}
+#define is_real_via_method(sc, p) ((s7_is_real(p)) || ((has_methods(p)) && (is_real_via_method_1(sc, p))))
-#define MV_TOO_MANY_ELEMENTS -1
-#define MV_NOT_ENOUGH_ELEMENTS -2
-static int traverse_vector_data(s7_scheme *sc, s7_pointer vec, int flat_ref, int dimension, int dimensions, int *sizes, s7_pointer lst)
+static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
{
- /* we're filling vec, we're currently looking for element (flat-wise) flat_ref,
- * we're at ref in dimension of dimensions, where sizes gives the bounds, and lst is our data
- * #3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))
- */
- int i;
- s7_pointer x;
+ #define H_max "(max ...) returns the maximum of its arguments"
+ #define Q_max pcl_r
- for (i = 0, x = lst; i < sizes[dimension]; i++, x = cdr(x))
+ s7_pointer x, y, p;
+ s7_int num_a, num_b, den_a, den_b;
+
+ x = car(args);
+ p = cdr(args);
+
+ switch (type(x))
{
- if (!is_pair(x))
- return(MV_NOT_ENOUGH_ELEMENTS);
+ case T_INTEGER:
+ MAX_INTEGERS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
- if (dimension == (dimensions - 1))
- vector_element(vec, flat_ref++) = car(x);
- else
+ switch (type(y))
{
- flat_ref = traverse_vector_data(sc, vec, flat_ref, dimension + 1, dimensions, sizes, car(x));
- if (flat_ref < 0) return(flat_ref);
+ case T_INTEGER:
+ if (integer(x) < integer(y)) x = y;
+ goto MAX_INTEGERS;
+
+ case T_RATIO:
+ num_a = integer(x);
+ den_a = 1;
+ num_b = numerator(y);
+ den_b = denominator(y);
+ goto RATIO_MAX_RATIO;
+
+ case T_REAL:
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->MAX, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (integer(x) < real(y))
+ {
+ x = y;
+ goto MAX_REALS;
+ }
+ goto MAX_INTEGERS;
+
+ default:
+ method_or_bust(sc, y, sc->MAX, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
- }
- if (x != sc->NIL)
- return(MV_TOO_MANY_ELEMENTS);
- return(flat_ref);
-}
+ case T_RATIO:
+ MAX_RATIOS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
-static s7_pointer s7_multivector_error(s7_scheme *sc, const char *message, s7_pointer data)
-{
- return(s7_error(sc, sc->READ_ERROR,
- make_list_3(sc,
- make_protected_string(sc, "reading constant vector, ~A: ~A"),
- make_protected_string(sc, message),
- data)));
-}
+ switch (type(y))
+ {
+ case T_INTEGER:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ num_b = integer(y);
+ den_b = 1;
+ goto RATIO_MAX_RATIO;
+
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ num_b = numerator(y);
+ den_b = denominator(y);
+
+ RATIO_MAX_RATIO:
+ /* there are tricky cases here where long ints outrun doubles:
+ * (max 92233720368547758/9223372036854775807 92233720368547757/9223372036854775807)
+ * which should be 92233720368547758/9223372036854775807) but first the fraction gets reduced
+ * to 13176245766935394/1317624576693539401, so we fall into the double comparison, and
+ * there we should be comparing
+ * 9.999999999999999992410584792601468961145E-3 and
+ * 9.999999999999999883990367544051025548645E-3
+ * but if using doubles we get
+ * 0.010000000000000000208166817117 and
+ * 0.010000000000000000208166817117
+ * that is, we can't distinguish these two fractions once they're coerced to doubles.
+ *
+ * Even long doubles fail in innocuous-looking cases:
+ * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
+ * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
+ *
+ * Another consequence: outside gmp, we can't handle cases like
+ * (max 9223372036854776/9223372036854775807 #i9223372036854775/9223372036854775000)
+ * (max #i9223372036854776/9223372036854775807 9223372036854775/9223372036854775000)
+ * I guess if the user is using "inexact" numbers (#i...), he accepts their inexactness.
+ */
+ if (den_a == den_b)
+ {
+ if (num_a < num_b)
+ x = y;
+ }
+ else
+ {
+ if (num_a == num_b)
+ {
+ if (((num_a >= 0) &&
+ (den_a > den_b)) ||
+ ((num_a < 0) &&
+ (den_a < den_b)))
+ x = y;
+ }
+ else
+ {
+ s7_int vala, valb;
+ vala = num_a / den_a;
+ valb = num_b / den_b;
-static s7_pointer g_multivector(s7_scheme *sc, int dims, s7_pointer data)
-{
- /* get the dimension bounds from data, make the new vector, fill it from data */
- s7_pointer vec, x;
- int i, total_size = 1, vec_loc, err;
- int *sizes;
-
- /* (#2d((1 2 3) (4 5 6)) 0 0) -> 1
- * (#2d((1 2 3) (4 5 6)) 0 1) -> 2
- * (#2d((1 2 3) (4 5 6)) 1 1) -> 5
- * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 0 0 0) -> 1
- * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) -> 7
- * #3D(((1 2) (3 4)) ((5 6) (7))) -> error, #3D(((1 2) (3 4)) ((5 6) (7 8 9))), #3D(((1 2) (3 4)) (5 (7 8 9))) etc
- *
- * but a special case: #nD() is an n-dimensional empty vector
- */
+ if (!((vala > valb) ||
+ ((vala == valb) && (is_t_integer(y)))))
+ {
+ if ((valb > vala) ||
+ ((vala == valb) && (is_t_integer(x))) ||
+ /* sigh -- both are ratios and the int parts are equal */
+ (((long double)(num_a % den_a) / (long double)den_a) <= ((long double)(num_b % den_b) / (long double)den_b)))
+ x = y;
+ }
+ }
+ }
+ if (is_t_ratio(x))
+ goto MAX_RATIOS;
+ goto MAX_INTEGERS;
- if (dims <= 0) /* #0d(...) */
- return(s7_out_of_range_error(sc, "#nD(...) dimensions,", 1, s7_make_integer(sc, dims), "must be 1 or more"));
+ case T_REAL:
+ /* (max 3/4 nan.0) should probably return NaN */
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->MAX, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
- sc->w = sc->NIL;
- if (data == sc->NIL) /* dims are already 0 (calloc above) */
- return(g_make_vector(sc, make_list_1(sc, g_make_list(sc, make_list_2(sc, s7_make_integer(sc, dims), small_int(0))))));
+ if (fraction(x) < real(y))
+ {
+ x = y;
+ goto MAX_REALS;
+ }
+ goto MAX_RATIOS;
- sizes = (int *)calloc(dims, sizeof(int));
- for (x = data, i = 0; i < dims; i++)
- {
- sizes[i] = safe_list_length(sc, x);
- total_size *= sizes[i];
- sc->w = s7_cons(sc, s7_make_integer(sc, sizes[i]), sc->w);
- x = car(x);
- if ((i < (dims - 1)) &&
- (!is_pair(x)))
+ default:
+ method_or_bust(sc, y, sc->MAX, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
+
+
+ case T_REAL:
+ if (is_NaN(real(x)))
{
- free(sizes);
- return(s7_multivector_error(sc, "we need a list that fully specifies the vector's elements", data));
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->MAX, position_of(p, args), car(p), T_REAL));
+ return(x);
}
- }
- vec = g_make_vector(sc, make_list_1(sc, safe_reverse_in_place(sc, sc->w)));
- vec_loc = s7_gc_protect(sc, vec);
- sc->w = sc->NIL;
+ MAX_REALS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
- /* now fill the vector checking that all the lists match */
- err = traverse_vector_data(sc, vec, 0, 0, dims, sizes, data);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (real(x) < integer(y))
+ {
+ x = y;
+ goto MAX_INTEGERS;
+ }
+ goto MAX_REALS;
- free(sizes);
- s7_gc_unprotect_at(sc, vec_loc);
- if (err < 0)
- return(s7_multivector_error(sc, (err == MV_TOO_MANY_ELEMENTS) ? "found too many elements" : "not enough elements found", data));
+ case T_RATIO:
+ if (real(x) < fraction(y))
+ {
+ x = y;
+ goto MAX_RATIOS;
+ }
+ goto MAX_REALS;
- return(vec);
-}
+ case T_REAL:
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->MAX, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (real(x) < real(y)) x = y;
+ goto MAX_REALS;
+ default:
+ method_or_bust(sc, y, sc->MAX, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-static s7_pointer g_qq_multivector(s7_scheme *sc, s7_pointer args)
-{
- /* `#2d((1 2) ,(list 3 4)) */
- #define H_qq_multivector "quasiquote internal support for multidimensional vector constants"
- return(g_multivector(sc, s7_integer(car(args)), cdr(args)));
+ default:
+ method_or_bust(sc, x, sc->MAX, cons(sc, x, p), T_REAL, 1);
+ }
}
+#if (!WITH_GMP)
+static s7_pointer max_f2;
+static s7_pointer g_max_f2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, y;
+ x = car(args);
+ y = cadr(args);
+ if (is_t_real(y))
+ return((real(x) >= real(y)) ? x : y);
+ if (is_real(y))
+ return((real(x) >= real_to_double(sc, y, "max")) ? x : y);
+ method_or_bust(sc, y, sc->MAX, args, T_REAL, 2);
+}
+#endif
-static s7_pointer vector_copy(s7_scheme *sc, s7_pointer old_vect)
+static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
{
- s7_Int len;
- s7_pointer new_vect;
+ #define H_min "(min ...) returns the minimum of its arguments"
+ #define Q_min pcl_r
- len = vector_length(old_vect);
+ s7_pointer x, y, p;
+ s7_int num_a, num_b, den_a, den_b;
- if (vector_is_multidimensional(old_vect))
- new_vect = g_make_vector(sc, make_list_1(sc, g_vector_dimensions(sc, make_list_1(sc, old_vect))));
- else new_vect = make_vector_1(sc, len, NOT_FILLED);
+ x = car(args);
+ p = cdr(args);
- /* here and in vector-fill! we have a problem with bignums -- should new bignums be allocated? (copy_list also) */
+ switch (type(x))
+ {
+ case T_INTEGER:
+ MIN_INTEGERS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
- memcpy((void *)(vector_elements(new_vect)), (void *)(vector_elements(old_vect)), len * sizeof(s7_pointer));
- return(new_vect);
-}
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) > integer(y)) x = y;
+ goto MIN_INTEGERS;
+
+ case T_RATIO:
+ num_a = integer(x);
+ den_a = 1;
+ num_b = numerator(y);
+ den_b = denominator(y);
+ goto RATIO_MIN_RATIO;
+
+ case T_REAL:
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->MIN, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (integer(x) > real(y))
+ {
+ x = y;
+ goto MIN_REALS;
+ }
+ goto MIN_INTEGERS;
+ default:
+ method_or_bust(sc, y, sc->MIN, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
+ case T_RATIO:
+ MIN_RATIOS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ num_b = integer(y);
+ den_b = 1;
+ goto RATIO_MIN_RATIO;
+
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ num_b = numerator(y);
+ den_b = denominator(y);
+
+ RATIO_MIN_RATIO:
+ if (den_a == den_b)
+ {
+ if (num_a > num_b)
+ x = y;
+ }
+ else
+ {
+ if (num_a == num_b)
+ {
+ if (((num_a >= 0) &&
+ (den_a < den_b)) ||
+ ((num_a < 0) &&
+ (den_a > den_b)))
+ x = y;
+ }
+ else
+ {
+ s7_int vala, valb;
+ vala = num_a / den_a;
+ valb = num_b / den_b;
-/* -------- sort! -------- */
+ if (!((vala < valb) ||
+ ((vala == valb) && (is_t_integer(x)))))
+ {
+ if ((valb < vala) ||
+ ((vala == valb) && (is_t_integer(y))) ||
+ (((long double)(num_a % den_a) / (long double)den_a) >= ((long double)(num_b % den_b) / (long double)den_b)))
+ x = y;
+ }
+ }
+ }
+ if (is_t_ratio(x))
+ goto MIN_RATIOS;
+ goto MIN_INTEGERS;
-static s7_pointer g_sort(s7_scheme *sc, s7_pointer args)
-{
- #define H_sort "(sort! list-or-vector less?) sorts a list or vector using the function 'less?' to compare elements.\
-If its first argument is a list, the list is copied (despite the '!')."
+ case T_REAL:
+ /* (min 3/4 nan.0) should probably return NaN */
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->MIN, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (fraction(x) > real(y))
+ {
+ x = y;
+ goto MIN_REALS;
+ }
+ goto MIN_RATIOS;
- s7_pointer data, lessp;
- s7_Int len, n, k;
+ default:
+ method_or_bust(sc, y, sc->MIN, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
- data = car(args);
- if (data == sc->NIL) return(sc->NIL);
- if ((!is_pair(data)) && (!s7_is_vector(data)))
- return(s7_wrong_type_arg_error(sc, "sort! data,", 1, data, "a vector or a list"));
- lessp = cadr(args);
- if (!is_procedure(lessp))
- return(s7_wrong_type_arg_error(sc, "sort! function,", 2, lessp, "a function"));
- if ((is_continuation(lessp)) || is_goto(lessp))
- return(s7_wrong_type_arg_error(sc, "sort!", 2, lessp, "a normal procedure (not a continuation)"));
- if (!args_match(sc, lessp, 2))
- return(s7_wrong_type_arg_error(sc, "sort!", 2, lessp, "a procedure that can take 2 arguments"));
+ case T_REAL:
+ if (is_NaN(real(x)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->MIN, position_of(p, args), car(p), T_REAL));
+ return(x);
+ }
- if (is_pair(data))
- {
- len = s7_list_length(sc, data); /* nil disposed of above, so 0 here == infinite */
- if (len <= 0)
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "sort! argument 1 should be a proper list: ~S"), data)));
- }
- else
- {
- if (is_immutable(data))
- return(s7_wrong_type_arg_error(sc, "sort!", 1, data, "a mutable vector"));
- len = vector_length(data);
- }
- if (len < 2)
- return(data);
+ MIN_REALS:
+ if (is_null(p)) return(x);
+ y = car(p);
+ p = cdr(p);
- /* what about other applicable objects? (sort string|s_object etc) -- sort hash-table|hook isn't sensible.
- * but if we have copy_object + set/ref/len?
- */
- if (is_pair(data))
- {
- if (len == 2)
+ switch (type(y))
{
- push_stack(sc, opcode(OP_SORT_TWO), data, sc->args);
- push_stack(sc, opcode(OP_APPLY), data, lessp);
- return(sc->F);
- }
- push_stack(sc, opcode(OP_SORT4), sc->args, sc->code); /* gc protect the original list */
- car(args) = g_list_to_vector(sc, sc->x = make_list_1(sc, data));
- }
+ case T_INTEGER:
+ if (real(x) > integer(y))
+ {
+ x = y;
+ goto MIN_INTEGERS;
+ }
+ goto MIN_REALS;
- n = len - 1;
- k = ((int)(n / 2)) + 1;
+ case T_RATIO:
+ if (real(x) > fraction(y))
+ {
+ x = y;
+ goto MIN_RATIOS;
+ }
+ goto MIN_REALS;
- sc->x = s7_make_vector(sc, (sc->safety == 0) ? 5 : 7);
- vector_element(sc->x, 0) = make_mutable_integer(sc, n);
- vector_element(sc->x, 1) = make_mutable_integer(sc, k);
- vector_element(sc->x, 2) = make_mutable_integer(sc, 0);
- vector_element(sc->x, 3) = make_mutable_integer(sc, 0);
- vector_element(sc->x, 4) = make_list_2(sc, sc->F, sc->F);
- if (sc->safety != 0)
- {
- vector_element(sc->x, 5) = make_mutable_integer(sc, 0);
- vector_element(sc->x, 6) = s7_make_integer(sc, n * n);
- }
+ case T_REAL:
+ if (is_NaN(real(y)))
+ {
+ for (; is_not_null(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->MIN, position_of(p, args), car(p), T_REAL));
+ return(y);
+ }
+ if (real(x) > real(y)) x = y;
+ goto MIN_REALS;
- push_stack(sc, opcode(OP_SORT), args, sc->x);
- sc->x = sc->NIL;
- return(sc->F);
-
- /* if the comparison function waffles, sort! can hang: (sort! '(1 2 3) =)
- * but (sort! '(1 2) =) is ok, as is (sort! (list 1/0 1/0 1/0) =)
- * given NaNs and infs, it seems no numerical sort is completely safe.
- * set *safety* to 1 to add a check for this loop.
- */
+ default:
+ method_or_bust(sc, y, sc->MIN, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
+
+ default:
+ method_or_bust(sc, x, sc->MIN, cons(sc, x, p), T_REAL, 1);
+ }
}
+#if (!WITH_GMP)
+static s7_pointer min_f2;
+static s7_pointer g_min_f2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, y;
+ x = car(args);
+ y = cadr(args);
+ if (is_t_real(y))
+ return((real(x) <= real(y)) ? x : y);
+ if (is_real(y))
+ return((real(x) <= real_to_double(sc, y, "min")) ? x : y);
+ method_or_bust(sc, y, sc->MIN, args, T_REAL, 2);
+}
+
+static s7_int c_max_i1(s7_scheme *sc, s7_int x) {return(x);}
+static s7_int c_max_i2(s7_scheme *sc, s7_int x, s7_int y) {return((x >= y) ? x : y);}
+static s7_int c_max_i3(s7_scheme *sc, s7_int x, s7_int y, s7_int z) {return(((x >= y) ? ((x >= z) ? x : z) : ((y >= z) ? y : z)));}
+IF_3_TO_IF(max, c_max_i1, c_max_i2, c_max_i3)
+
+static s7_int c_min_i1(s7_scheme *sc, s7_int x) {return(x);}
+static s7_int c_min_i2(s7_scheme *sc, s7_int x, s7_int y) {return((x <= y) ? x : y);}
+static s7_int c_min_i3(s7_scheme *sc, s7_int x, s7_int y, s7_int z) {return(((x <= y) ? ((x <= z) ? x : z) : ((y <= z) ? y : z)));}
+IF_3_TO_IF(min, c_min_i1, c_min_i2, c_min_i3)
+
+static s7_double c_max_r1(s7_scheme *sc, s7_double x) {return(x);}
+static s7_double c_max_r2(s7_scheme *sc, s7_double x, s7_double y) {return((x >= y) ? x : y);}
+static s7_double c_max_r3(s7_scheme *sc, s7_double x, s7_double y, s7_double z) {return(((x >= y) ? ((x >= z) ? x : z) : ((y >= z) ? y : z)));}
+RF_3_TO_RF(max, c_max_r1, c_max_r2, c_max_r3)
+
+static s7_double c_min_r1(s7_scheme *sc, s7_double x) {return(x);}
+static s7_double c_min_r2(s7_scheme *sc, s7_double x, s7_double y) {return((x <= y) ? x : y);}
+static s7_double c_min_r3(s7_scheme *sc, s7_double x, s7_double y, s7_double z) {return(((x <= y) ? ((x <= z) ? x : z) : ((y <= z) ? y : z)));}
+RF_3_TO_RF(min, c_min_r1, c_min_r2, c_min_r3)
+#endif
-/* -------- hash tables -------- */
+/* ---------------------------------------- = > < >= <= ---------------------------------------- */
-bool s7_is_hash_table(s7_pointer p)
+static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
{
- return(type(p) == T_HASH_TABLE);
-}
+ #define H_equal "(= z1 ...) returns #t if all its arguments are equal"
+ #define Q_equal s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_NUMBER)
+ s7_pointer x, p;
+ s7_int num_a, den_a;
+ s7_double rl_a, im_a;
+ x = car(args);
+ p = cdr(args);
-static s7_pointer g_is_hash_table(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_hash_table "(hash-table? obj) returns #t if obj is a hash-table"
- return(make_boolean(sc, s7_is_hash_table(car(args))));
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ num_a = integer(x);
+ while (true)
+ {
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (num_a != integer(x)) goto NOT_EQUAL;
+ break;
+ case T_RATIO:
+ case T_COMPLEX:
+ goto NOT_EQUAL;
-static s7_pointer g_hash_table_size(s7_scheme *sc, s7_pointer args)
-{
- #define H_hash_table_size "(hash-table-size obj) returns the size of the hash-table obj"
- if (!s7_is_hash_table(car(args)))
- return(s7_wrong_type_arg_error(sc, "hash-table-size", 0, car(args), "a hash-table"));
- return(s7_make_integer(sc, hash_table_length(car(args))));
-}
+ case T_REAL:
+ if (num_a != real(x)) goto NOT_EQUAL;
+ break;
+ default:
+ method_or_bust_with_type(sc, x, sc->EQ, cons(sc, make_integer(sc, num_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ if (is_null(p))
+ return(sc->T);
+ }
-#define HASH_EMPTY 0
-#define HASH_EQUAL 1
-#define HASH_INT 2
-#define HASH_STRING 3
-#define HASH_SYMBOL 4
-#define HASH_CHAR 5
-#define HASH_FLOAT 6
+ case T_RATIO:
+ num_a = numerator(x);
+ den_a = denominator(x);
+ rl_a = 0.0;
+ while (true)
+ {
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_COMPLEX:
+ goto NOT_EQUAL;
-#define DEFAULT_HASH_TABLE_SIZE 511
+ case T_RATIO:
+ if ((num_a != numerator(x)) || (den_a != denominator(x))) goto NOT_EQUAL; /* hidden cast here */
+ break;
+ case T_REAL:
+ if (rl_a == 0.0)
+ rl_a = ((long double)num_a) / ((long double)den_a);
+ if (rl_a != real(x)) goto NOT_EQUAL;
+ break;
-s7_pointer s7_make_hash_table(s7_scheme *sc, s7_Int size)
-{
- s7_pointer table;
- /* size is rounded up to the next power of 2 */
+ default:
+ method_or_bust_with_type(sc, x, sc->EQ, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ if (is_null(p))
+ return(sc->T);
+ }
- if ((size & (size + 1)) != 0) /* already 2^n - 1 ? */
- {
- size--;
- size |= (size >> 1);
- size |= (size >> 2);
- size |= (size >> 4);
- size |= (size >> 8);
- size |= (size >> 16);
- if (s7_int_bits > 31) /* this is either 31 or 63 */
- size |= (size >> 32);
- }
-
- table = s7_make_vector(sc, size + 1); /* nil is the default value */
- /* size + 1 can be fooled if we don't catch most-positive-fixnum */
+ case T_REAL:
+ rl_a = real(x);
+ while (true)
+ {
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ if (rl_a != integer(x)) goto NOT_EQUAL;
+ break;
- set_type(table, T_HASH_TABLE | T_FINALIZABLE | T_DONT_COPY | T_STRUCTURE);
- hash_table_function(table) = HASH_EMPTY;
- hash_table_entries(table) = 0;
+ case T_RATIO:
+ if (rl_a != (double)fraction(x)) goto NOT_EQUAL;
+ /* the cast to double is needed because rl_a is s7_double and we want (= ratio real) to be the same as (= real ratio):
+ * (= 1.0 9223372036854775807/9223372036854775806)
+ * (= 9223372036854775807/9223372036854775806 1.0)
+ */
+ break;
- return(table);
-}
+ case T_REAL:
+ if (rl_a != real(x)) goto NOT_EQUAL;
+ break;
+ case T_COMPLEX:
+ goto NOT_EQUAL;
-static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args)
-{
- #define H_make_hash_table "(make-hash-table (size 511)) returns a new hash table"
- s7_Int size = DEFAULT_HASH_TABLE_SIZE;
+ default:
+ method_or_bust_with_type(sc, x, sc->EQ, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ if (is_null(p))
+ return(sc->T);
+ }
- if (args != sc->NIL)
- {
- if (s7_is_integer(car(args)))
+ case T_COMPLEX:
+ rl_a = real_part(x);
+ im_a = imag_part(x);
+ while (true)
{
- size = s7_integer(car(args));
- if (size <= 0)
- return(s7_out_of_range_error(sc, "make-hash-table size,", 0, car(args), "should be a positive integer"));
- if (size > MAX_LIST_LENGTH)
- return(s7_out_of_range_error(sc, "make-hash-table size,", 0, car(args), "should be a reasonable integer"));
+ x = car(p);
+ p = cdr(p);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ case T_REAL:
+ goto NOT_EQUAL;
+ break;
+
+ case T_COMPLEX:
+ if ((rl_a != real_part(x)) || (im_a != imag_part(x)))
+ goto NOT_EQUAL;
+ break;
+
+ default:
+ method_or_bust_with_type(sc, x, sc->EQ, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), A_NUMBER, position_of(p, args) - 1);
+ }
+ if (is_null(p))
+ return(sc->T);
}
- else return(s7_wrong_type_arg_error(sc, "make-hash-table size,", 0, car(args), "an integer"));
+
+ default:
+ method_or_bust_with_type(sc, x, sc->EQ, args, A_NUMBER, 1);
}
-
- return(s7_make_hash_table(sc, size));
-}
+ NOT_EQUAL:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_number_via_method(sc, car(p)))
+ return(wrong_type_argument_with_type(sc, sc->EQ, position_of(p, args), car(p), A_NUMBER));
-static bool hash_key_fits(s7_pointer table, s7_pointer key)
-{
- switch (hash_table_function(table))
- {
- case HASH_EMPTY:
- return(false);
+ return(sc->F);
+}
- case HASH_EQUAL:
- return(true);
- case HASH_INT:
- return(s7_is_integer(key));
+static s7_pointer equal_s_ic, equal_2;
+static s7_pointer g_equal_s_ic(s7_scheme *sc, s7_pointer args)
+{
+ s7_int y;
+ s7_pointer val;
- case HASH_STRING:
- return(s7_is_string(key));
+ val = find_symbol_checked(sc, car(args));
+ y = s7_integer(cadr(args));
+ if (is_integer(val))
+ return(make_boolean(sc, integer(val) == y));
- case HASH_SYMBOL:
- return(s7_is_symbol(key));
+ switch (type(val))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(val) == y));
+ case T_RATIO: return(sc->F);
+ case T_REAL: return(make_boolean(sc, real(val) == y));
+ case T_COMPLEX: return(sc->F);
+ default:
+ method_or_bust_with_type(sc, val, sc->EQ, list_2(sc, val, cadr(args)), A_NUMBER, 1);
+ }
+ return(sc->T);
+}
- case HASH_CHAR:
- return(s7_is_character(key));
+static s7_int object_length_to_int(s7_scheme *sc, s7_pointer obj);
+#if (!WITH_GMP)
+static s7_pointer equal_length_ic;
+static s7_pointer g_equal_length_ic(s7_scheme *sc, s7_pointer args)
+{
+ /* avoid make_integer (and telescope opts), we get here with car=length expr, cadr=int */
+ s7_int ilen;
+ s7_pointer val;
- case HASH_FLOAT:
- return(s7_is_real(key) && (!s7_is_rational(key)));
+ val = find_symbol_checked(sc, cadar(args));
+ ilen = s7_integer(cadr(args));
+
+ switch (type(val))
+ {
+ case T_PAIR: return(make_boolean(sc, s7_list_length(sc, val) == ilen));
+ case T_NIL: return(make_boolean(sc, ilen == 0));
+ case T_STRING: return(make_boolean(sc, string_length(val) == ilen));
+ case T_HASH_TABLE: return(make_boolean(sc, (hash_table_mask(val) + 1) == ilen));
+ case T_ITERATOR: return(make_boolean(sc, iterator_length(val) == ilen));
+ case T_C_OBJECT: return(make_boolean(sc, object_length_to_int(sc, val) == ilen));
+ case T_LET: return(make_boolean(sc, let_length(sc, val) == ilen));
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR: return(make_boolean(sc, vector_length(val) == ilen));
+ case T_CLOSURE:
+ case T_CLOSURE_STAR: if (has_methods(val)) return(make_boolean(sc, closure_length(sc, val) == ilen));
+ default: return(simple_wrong_type_argument_with_type(sc, sc->LENGTH, val, A_SEQUENCE));
+ /* here we already lost because we checked for the length above */
}
-
- return(false);
+ return(sc->F);
}
+#endif
-static s7_Int hash_loc(s7_pointer key)
+static s7_pointer c_equal_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- s7_Int loc = 0;
- const char *c;
-
- switch (type(key))
+ switch (type(x))
{
- case T_STRING:
- for (c = string_value(key); *c; c++)
- loc = *c + loc * 37;
- return(loc);
-
- case T_NUMBER:
- if (number_type(key) == NUM_INT)
+ case T_INTEGER:
+ switch (type(y))
{
- loc = s7_integer(key);
- if (loc < 0) return(-loc);
- return(loc);
+ case T_INTEGER: return(make_boolean(sc, integer(x) == integer(y)));
+ case T_RATIO: return(sc->F);
+ case T_REAL: return(make_boolean(sc, integer(x) == real(y)));
+ case T_COMPLEX: return(sc->F);
+ default:
+ method_or_bust_with_type(sc, y, sc->EQ, list_2(sc, x, y), A_NUMBER, 2);
}
-
- if ((number_type(key) == NUM_REAL) ||
- (number_type(key) == NUM_REAL2))
+ break;
+
+ case T_RATIO:
+ switch (type(y))
{
- loc = (s7_Int)floor(s7_real(key));
- if (loc < 0) loc = -loc;
- return(loc);
+ case T_INTEGER: return(sc->F);
+ case T_RATIO: return(make_boolean(sc, (numerator(x) == numerator(y)) && (denominator(x) == denominator(y))));
+ case T_REAL: return(make_boolean(sc, fraction(x) == real(y))); /* this could avoid the divide via numerator == denominator * x */
+ case T_COMPLEX: return(sc->F);
+ default:
+ method_or_bust_with_type(sc, y, sc->EQ, list_2(sc, x, y), A_NUMBER, 2);
}
-
- /* ratio or complex -- use type */
break;
- case T_SYMBOL:
- for (c = symbol_name(key); *c; c++)
- loc = *c + loc * 37;
- return(loc);
+ case T_REAL:
+ switch (type(y))
+ {
+ case T_INTEGER: return(make_boolean(sc, real(x) == integer(y)));
+ case T_RATIO: return(make_boolean(sc, real(x) == fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) == real(y)));
+ case T_COMPLEX: return(sc->F);
+ default:
+ method_or_bust_with_type(sc, y, sc->EQ, list_2(sc, x, y), A_NUMBER, 2);
+ }
+ break;
- case T_CHARACTER:
- return((s7_Int)character(key));
+ case T_COMPLEX:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ case T_REAL:
+ return(sc->F);
- case T_VECTOR:
- return(vector_length(key));
+#if (!MS_WINDOWS)
+ case T_COMPLEX:
+ return(make_boolean(sc, (real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))));
+#else
+ case T_COMPLEX:
+ if ((real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))) return(sc->T); else return(sc->F);
+#endif
+ default:
+ method_or_bust_with_type(sc, y, sc->EQ, list_2(sc, x, y), A_NUMBER, 2);
+ }
+ break;
default:
- break;
+ method_or_bust_with_type(sc, x, sc->EQ, list_2(sc, x, y), A_NUMBER, 1);
}
-
- return(type(key));
+ return(sc->F);
}
-static s7_pointer hash_table_binding(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer c_equal_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- #define HASH_FLOAT_EPSILON 1.0e-12
-
- if (hash_key_fits(table, key))
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- s7_pointer x;
- s7_Int hash_len, loc;
- hash_len = hash_table_length(table) - 1;
- loc = hash_loc(key) & hash_len;
-
- switch (hash_table_function(table))
+ if (is_integer(x))
+ return(make_boolean(sc, integer(x) == integer(y)));
+ switch (type(x))
{
- case HASH_EMPTY:
- break;
-
- case HASH_INT:
- {
- s7_Int keyval;
- keyval = s7_integer(key);
- for (x = hash_table_elements(table)[loc]; x != sc->NIL; x = cdr(x))
- if (s7_integer(caar(x)) == keyval)
- return(car(x));
- }
- break;
-
- case HASH_CHAR:
- for (x = hash_table_elements(table)[loc]; x != sc->NIL; x = cdr(x))
- if (character(caar(x)) == character(key))
- return(car(x));
- break;
-
- case HASH_STRING:
- for (x = hash_table_elements(table)[loc]; x != sc->NIL; x = cdr(x))
- if (strings_are_equal(string_value(caar(x)), string_value(key)))
- return(car(x));
- break;
-
- case HASH_SYMBOL:
- for (x = hash_table_elements(table)[loc]; x != sc->NIL; x = cdr(x))
- if (caar(x) == key)
- return(car(x));
- break;
-
- case HASH_FLOAT:
- {
- /* give the equality check some room */
- s7_Double keyval;
- keyval = s7_real(key);
- for (x = hash_table_elements(table)[loc]; x != sc->NIL; x = cdr(x))
- if (fabs(s7_real(caar(x)) - keyval) < HASH_FLOAT_EPSILON)
- return(car(x));
- }
- break;
-
- case HASH_EQUAL:
- for (x = hash_table_elements(table)[loc]; x != sc->NIL; x = cdr(x))
- if (s7_is_equal(sc, caar(x), key))
- return(car(x));
- break;
+ case T_INTEGER: return(make_boolean(sc, integer(x) == integer(y)));
+ case T_RATIO: return(make_boolean(sc, (numerator(x) == numerator(y)) && (denominator(x) == denominator(y))));
+ case T_REAL: return(make_boolean(sc, real(x) == real(y)));
+ case T_COMPLEX: return(make_boolean(sc, (real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))));
}
}
- return(sc->NIL);
+#endif
+ return(c_equal_2_1(sc, x, y));
}
-s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key)
+static s7_pointer g_equal_2(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- x = hash_table_binding(sc, table, key);
-
- if (x != sc->NIL)
- return(cdr(x));
- return(sc->F);
-}
-
+ s7_pointer x, y;
-s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value)
-{
- s7_pointer x;
- x = hash_table_binding(sc, table, key);
+ x = car(args);
+ y = cadr(args);
- if (x != sc->NIL)
- cdr(x) = value;
- else
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- s7_Int hash_len, loc;
-
- hash_len = hash_table_length(table) - 1;
- loc = hash_loc(key) & hash_len;
- hash_table_entries(table)++;
-
- if (hash_table_function(table) == HASH_EMPTY)
- {
- switch (type(key))
- {
- case T_STRING:
- hash_table_function(table) = HASH_STRING;
- break;
-
- case T_NUMBER:
- if (number_type(key) == NUM_INT)
- hash_table_function(table) = HASH_INT;
- else
- {
- if ((number_type(key) == NUM_REAL) ||
- (number_type(key) == NUM_REAL2))
- hash_table_function(table) = HASH_FLOAT;
- else hash_table_function(table) = HASH_EQUAL;
- }
- break;
-
- case T_SYMBOL:
- hash_table_function(table) = HASH_SYMBOL;
- break;
-
- case T_CHARACTER:
- hash_table_function(table) = HASH_CHAR;
- break;
-
- default:
- hash_table_function(table) = HASH_EQUAL;
- break;
- }
- }
- else
+ if (is_integer(x))
+ return(make_boolean(sc, integer(x) == integer(y)));
+ switch (type(x))
{
- if (!hash_key_fits(table, key))
- hash_table_function(table) = HASH_EQUAL;
+ case T_INTEGER: return(make_boolean(sc, integer(x) == integer(y)));
+ case T_RATIO: return(make_boolean(sc, (numerator(x) == numerator(y)) && (denominator(x) == denominator(y))));
+ case T_REAL: return(make_boolean(sc, real(x) == real(y)));
+ case T_COMPLEX: return(make_boolean(sc, (real_part(x) == real_part(y)) && (imag_part(x) == imag_part(y))));
}
-
- hash_table_elements(table)[loc] = s7_cons(sc, s7_cons(sc, key, value), hash_table_elements(table)[loc]);
}
- return(value);
+#endif
+ return(c_equal_2_1(sc, x, y));
}
-
-static s7_pointer g_hash_table_ref(s7_scheme *sc, s7_pointer args)
+#if (!WITH_GMP)
+static s7_pointer equal_i2(s7_scheme *sc, s7_pointer **p)
{
- /* basically the same layout as the global symbol table */
- #define H_hash_table_ref "(hash-table-ref table key) returns the value associated with key (a string or symbol) in the hash table"
- s7_pointer table;
-
- table = car(args);
-
- if (!s7_is_hash_table(table))
- return(s7_wrong_type_arg_error(sc, "hash-table-ref", 1, table, "a hash-table"));
-
- /*
- (define (href H . args)
- (if (null? (cdr args))
- (hash-table-ref H (car args))
- (apply href (hash-table-ref H (car args)) (cdr args))))
- */
-
- if (cddr(args) == sc->NIL)
- return(s7_hash_table_ref(sc, table, cadr(args)));
- return(g_hash_table_ref(sc, s7_cons(sc, s7_hash_table_ref(sc, table, cadr(args)), cddr(args))));
+ s7_if_t f;
+ s7_int x, y;
+ f = (s7_if_t)(**p); (*p)++; x = f(sc, p);
+ f = (s7_if_t)(**p); (*p)++; y = f(sc, p);
+ return(make_boolean(sc, x == y));
}
-
-static s7_pointer g_hash_table_set(s7_scheme *sc, s7_pointer args)
+static s7_pointer equal_i2_ic(s7_scheme *sc, s7_pointer **p)
{
- #define H_hash_table_set "(hash-table-set! table key value) sets the value associated with key (a string or symbol) in the hash table to value"
- s7_pointer table;
-
- table = car(args);
-
- if (!s7_is_hash_table(table))
- return(s7_wrong_type_arg_error(sc, "hash-table-set!", 1, table, "a hash-table"));
-
- /* how would (set! (ht a b) c) choose the inner table if (ht a b) is not found?
- * I'm not sure the multi-index case makes sense here
- */
+ s7_pointer x, y;
+ (*p)++;
+ x = slot_value(**p); (*p) += 2;
+ y = (**p); (*p)++;
+ if (!is_integer(x))
+ return(c_equal_2_1(sc, x, y));
+ return(make_boolean(sc, integer(x) == integer(y)));
+}
- return(s7_hash_table_set(sc, table, cadr(args), caddr(args)));
+static s7_pointer equal_i2_ii(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer x, y;
+ (*p)++;
+ x = slot_value(**p); (*p) += 2;
+ y = slot_value(**p); (*p)++;
+ if (!is_integer(x))
+ return(c_equal_2_1(sc, x, y));
+ return(make_boolean(sc, integer(x) == integer(y)));
}
+static s7_pointer equal_r2(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t f;
+ s7_double x, y;
+ f = (s7_rf_t)(**p); (*p)++; x = f(sc, p);
+ f = (s7_rf_t)(**p); (*p)++; y = f(sc, p);
+ return(make_boolean(sc, x == y));
+}
-static s7_pointer g_hash_table(s7_scheme *sc, s7_pointer args)
+static s7_pointer equal_p2(s7_scheme *sc, s7_pointer **p)
{
- #define H_hash_table "(hash-table ...) returns a hash-table containing the cons's passed as its arguments. \
-That is, (hash-table '(\"hi\" . 3) (\"ho\" . 32)) returns a new hash-table with the two key/value pairs preinstalled."
+ s7_pf_t f;
+ s7_pointer x, y;
+ f = (s7_pf_t)(**p); (*p)++; x = f(sc, p);
+ f = (s7_pf_t)(**p); (*p)++; y = f(sc, p);
+ return(c_equal_2(sc, x, y));
+}
- int i, len;
- s7_pointer x, ht;
-
- len = s7_list_length(sc, args);
- ht = s7_make_hash_table(sc, (len > 512) ? 4095 : 511);
- if (args != sc->NIL)
+static s7_pf_t equal_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
{
- for (x = args, i = 1; i <= len; x = cdr(x), i++)
+ ptr_int loc;
+ s7_pointer a1, a2;
+ a1 = cadr(expr);
+ a2 = caddr(expr);
+ loc = rc_loc(sc);
+ if ((s7_arg_to_if(sc, cadr(expr))) && (s7_arg_to_if(sc, caddr(expr))))
{
- if (is_pair(car(x)))
- s7_hash_table_set(sc, ht, caar(x), cdar(x));
- else
+ if (is_symbol(a1))
{
- if (car(x) != sc->NIL)
- return(s7_wrong_type_arg_error(sc, "hash-table", i, car(x), "a pair: (key value)"));
+ if (is_integer(a2)) return(equal_i2_ic);
+ if (is_symbol(a2)) return(equal_i2_ii);
}
+ return(equal_i2);
}
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if ((s7_arg_to_rf(sc, cadr(expr))) && (s7_arg_to_rf(sc, caddr(expr)))) return(equal_r2);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if ((s7_arg_to_pf(sc, cadr(expr))) && (s7_arg_to_pf(sc, caddr(expr)))) return(equal_p2);
}
- return(ht);
-}
-
-
-static s7_pointer hash_list_copy(s7_scheme *sc, s7_pointer obj)
-{
- if (is_pair(obj))
- return(s7_cons(sc, s7_copy(sc, car(obj)), hash_list_copy(sc, cdr(obj))));
- return(obj);
-}
-
-
-static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash)
-{
- /* this has to copy not only the lists but the cons's in the lists! */
- s7_Int i, len;
- s7_pointer new_hash;
- s7_pointer *old_lists, *new_lists;
- int gc_loc;
-
- len = vector_length(old_hash);
- new_hash = s7_make_hash_table(sc, len);
- gc_loc = s7_gc_protect(sc, new_hash);
-
- old_lists = vector_elements(old_hash);
- new_lists = vector_elements(new_hash);
-
- for (i = 0; i < len; i++)
- if (old_lists[i] != sc->NIL)
- new_lists[i] = hash_list_copy(sc, old_lists[i]);
-
- hash_table_entries(new_hash) = hash_table_entries(old_hash);
- hash_table_function(new_hash) = hash_table_function(old_hash);
-
- s7_gc_unprotect_at(sc, gc_loc);
- return(new_hash);
+ return(NULL);
}
-static s7_pointer hash_table_reverse(s7_scheme *sc, s7_pointer old_hash)
+static s7_pointer g_less(s7_scheme *sc, s7_pointer args)
{
- s7_Int i, len;
- s7_pointer new_hash;
- s7_pointer *old_lists;
- int gc_loc;
+ #define H_less "(< x1 ...) returns #t if its arguments are in increasing order"
+ #define Q_less s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_REAL)
- len = vector_length(old_hash);
- new_hash = s7_make_hash_table(sc, len);
- gc_loc = s7_gc_protect(sc, new_hash);
+ s7_pointer x, y, p;
- old_lists = vector_elements(old_hash);
- /* don't set entries or function -- s7_hash_table_set below will handle those */
+ x = car(args);
+ p = cdr(args);
- for (i = 0; i < len; i++)
+ switch (type(x))
{
- s7_pointer x;
- for (x = old_lists[i]; x != sc->NIL; x = cdr(x))
- s7_hash_table_set(sc, new_hash, cdar(x), caar(x));
- }
-
- s7_gc_unprotect_at(sc, gc_loc);
- return(new_hash);
-}
+ case T_INTEGER:
+ INTEGER_LESS:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) >= integer(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LESS;
+
+ case T_RATIO:
+ /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
+ */
+ if ((integer(x) >= 0) && (numerator(y) < 0)) goto NOT_LESS; /* (< 1 -1/2), ratio numerator can't be 0 */
+ if ((integer(x) <= 0) && (numerator(y) > 0)) /* (< 0 1/2) */
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LESS;
+ }
+ if ((integer(x) < s7_int32_max) &&
+ (integer(x) > s7_int32_min) &&
+ (denominator(y) < s7_int32_max))
+ {
+ if ((integer(x) * denominator(y)) >= numerator(y)) goto NOT_LESS;
+ }
+ else
+ {
+ if (integer(x) >= fraction(y)) goto NOT_LESS;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LESS;
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LESS;
+ if (integer(x) >= real(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LESS;
-static s7_pointer hash_table_clear(s7_scheme *sc, s7_pointer table)
-{
- int i, len;
- len = vector_length(table);
- for (i = 0; i < len; i++)
- vector_element(table, i) = sc->NIL;
- hash_table_entries(table) = 0;
- hash_table_function(table) = HASH_EMPTY;
- return(table);
-}
+ default:
+ method_or_bust(sc, y, sc->LT, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-static s7_pointer g_hash_table_iterate(s7_scheme *sc, s7_pointer args)
-{
- /* internal func pointed to by sc->HASH_TABLE_ITERATE */
- s7_pointer lst, loc, table;
- s7_Int vloc, len;
- s7_pointer *elements;
+ case T_RATIO:
+ RATIO_LESS:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if ((numerator(x) > 0) && (integer(y) <= 0)) goto NOT_LESS;
+ if ((numerator(x) < 0) && (integer(y) >= 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LESS;
+ }
+ if ((integer(y) < s7_int32_max) &&
+ (integer(y) > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ {
+ if (numerator(x) >= (integer(y) * denominator(x))) goto NOT_LESS;
+ }
+ else
+ {
+ if (fraction(x) >= integer(y)) goto NOT_LESS;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LESS;
- lst = caar(args);
- if (is_pair(lst))
- {
- caar(args) = cdr(lst);
- return(car(lst));
- }
+ case T_RATIO:
+ /* conversion to real and >= is not safe here (see comment under g_greater) */
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = denominator(x);
+ n1 = numerator(x);
+ d2 = denominator(y);
+ n2 = numerator(y);
+ if (d1 == d2)
+ {
+ if (n1 >= n2) goto NOT_LESS;
+ }
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &n2)))
+ {
+ if (fraction(x) >= fraction(y)) goto NOT_LESS;
+ }
+ else
+ {
+ if (n1 >= n2) goto NOT_LESS;
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ int d1bits, d2bits;
+ d1bits = integer_length(d1);
+ d2bits = integer_length(d2);
+ if (((d1bits + d2bits) > s7_int_bits) ||
+ ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
+ ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
+ {
+ if (fraction(x) >= fraction(y)) goto NOT_LESS;
+
+ /* (< 21053343141/6701487259 3587785776203/1142027682075) -> #f because even long doubles aren't enough here
+ * (= 21053343141/6701487259 3587785776203/1142027682075) is #f because it checks the actual ints and
+ * (> 21053343141/6701487259 3587785776203/1142027682075) is #f just like the < case.
+ * similarly
+ * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
+ * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
+ *
+ * if we print the long double results as integers, both are -3958705157555305931
+ * so there's not a lot I can do in the non-gmp case.
+ */
+ }
+ else
+ {
+ if ((n1 * d2) >= (n2 * d1)) goto NOT_LESS;
+ }
+ }
+ else
+ {
+ if ((n1 * d2) >= (n2 * d1)) goto NOT_LESS;
+ }
+#endif
+ }
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LESS;
- table = cadar(args);
- len = hash_table_length(table);
- elements = hash_table_elements(table);
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LESS;
+ if (fraction(x) >= real(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LESS;
- loc = caddar(args);
- for (vloc = integer(number(loc)) + 1; vloc < len; vloc++)
- {
- s7_pointer x;
- x = elements[vloc];
- if (x != sc->NIL)
+ default:
+ method_or_bust(sc, y, sc->LT, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
+
+
+ case T_REAL:
+ if (is_NaN(real(x))) goto NOT_LESS;
+
+ REAL_LESS:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
{
- integer(number(loc)) = vloc;
- caar(args) = cdr(x);
- return(car(x));
+ case T_INTEGER:
+ if (real(x) >= integer(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LESS;
+
+ case T_RATIO:
+ if (real(x) >= fraction(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LESS;
+
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LESS;
+ if (real(x) >= real(y)) goto NOT_LESS;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LESS;
+
+ default:
+ method_or_bust(sc, y, sc->LT, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
+
+ default:
+ method_or_bust(sc, x, sc->LT, args, T_REAL, 1);
}
- integer(number(loc)) = len;
- return(sc->NIL);
+ NOT_LESS:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->LT, position_of(p, args), car(p), T_REAL));
+
+ return(sc->F);
}
-static s7_pointer g_make_hash_table_iterator(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_less_or_equal(s7_scheme *sc, s7_pointer args)
{
- #define H_make_hash_table_iterator "(make-hash-table-iterator table) returns a function of no arguments that \
-returns the next (key . value) pair in the hash-table each time it is called. When there are no more pairs, it returns nil."
+ #define H_less_or_equal "(<= x1 ...) returns #t if its arguments are in increasing order"
+ #define Q_less_or_equal s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_REAL)
- if (!s7_is_hash_table(car(args)))
- return(s7_wrong_type_arg_error(sc, "make-hash-table-iterator", 0, car(args), "a hash-table"));
+ s7_pointer x, y, p;
- return(make_closure(sc, make_list_2(sc, sc->NIL, /* no args to the new function */
- make_list_2(sc, sc->HASH_TABLE_ITERATE,
- make_list_2(sc, sc->QUOTE,
- make_list_3(sc, sc->NIL, car(args), make_mutable_integer(sc, -1))))),
- sc->envir,
- T_CLOSURE));
-}
+ x = car(args);
+ p = cdr(args);
+
+ switch (type(x))
+ {
+ case T_INTEGER:
+ INTEGER_LEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) > integer(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LEQ;
+
+ case T_RATIO:
+ /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
+ */
+ if ((integer(x) >= 0) && (numerator(y) < 0)) goto NOT_LEQ; /* (< 1 -1/2), ratio numerator can't be 0 */
+ if ((integer(x) <= 0) && (numerator(y) > 0)) /* (< 0 1/2) */
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LEQ;
+ }
+ if ((integer(x) < s7_int32_max) &&
+ (integer(x) > s7_int32_min) &&
+ (denominator(y) < s7_int32_max))
+ {
+ if ((integer(x) * denominator(y)) > numerator(y)) goto NOT_LEQ;
+ }
+ else
+ {
+ if (integer(x) > fraction(y)) goto NOT_LEQ;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LEQ;
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LEQ;
+ if (integer(x) > real(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LEQ;
-static char *hash_table_to_c_string(s7_scheme *sc, s7_pointer hash, bool to_file, shared_info *ci)
-{
- s7_Int i, len, bufsize = 0, gc_iter;
- bool too_long = false;
- char **elements = NULL;
- char *buf;
- s7_pointer iterator, iter_loc;
-
- len = hash_table_entries(hash);
- if (len == 0)
- return(copy_string("#<hash-table>"));
+ default:
+ method_or_bust(sc, y, sc->LEQ, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
- if (!to_file)
- {
- int plen;
- plen = s7_vector_print_length(sc);
- if (plen <= 0)
- return(copy_string("#<hash-table ...>"));
- if (len > plen)
+ case T_RATIO:
+ RATIO_LEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
{
- too_long = true;
- len = plen;
- }
- }
+ case T_INTEGER:
+ if ((numerator(x) > 0) && (integer(y) <= 0)) goto NOT_LEQ;
+ if ((numerator(x) < 0) && (integer(y) >= 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LEQ;
+ }
+ if ((integer(y) < s7_int32_max) &&
+ (integer(y) > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ {
+ if (numerator(x) > (integer(y) * denominator(x))) goto NOT_LEQ;
+ }
+ else
+ {
+ if (fraction(x) > integer(y)) goto NOT_LEQ;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LEQ;
- iterator = g_make_hash_table_iterator(sc, make_list_1(sc, hash));
- gc_iter = s7_gc_protect(sc, iterator);
- iter_loc = cdadar(closure_body(iterator));
- elements = (char **)malloc(len * sizeof(char *));
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = denominator(x);
+ n1 = numerator(x);
+ d2 = denominator(y);
+ n2 = numerator(y);
+ if (d1 == d2)
+ {
+ if (n1 > n2) goto NOT_LEQ;
+ }
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &n2)))
+ {
+ if (fraction(x) > fraction(y)) goto NOT_LEQ;
+ }
+ else
+ {
+ if (n1 > n2) goto NOT_LEQ;
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ int d1bits, d2bits;
+ d1bits = integer_length(d1);
+ d2bits = integer_length(d2);
+ if (((d1bits + d2bits) > s7_int_bits) ||
+ ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
+ ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
+ {
+ if (fraction(x) > fraction(y)) goto NOT_LEQ;
+ }
+ else
+ {
+ if ((n1 * d2) > (n2 * d1)) goto NOT_LEQ;
+ }
+ }
+ else
+ {
+ if ((n1 * d2) > (n2 * d1)) goto NOT_LEQ;
+ }
+#endif
+ }
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LEQ;
- for (i = 0; i < len; i++)
- {
- elements[i] = object_to_c_string_with_circle_check(sc, g_hash_table_iterate(sc, iter_loc), USE_WRITE, WITH_ELLIPSES, ci);
- bufsize += safe_strlen(elements[i]);
- }
- s7_gc_unprotect_at(sc, gc_iter);
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LEQ;
+ if (fraction(x) > real(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LEQ;
- bufsize += (len * 4 + 256); /* might be 2 parens per element + space + quote, so at least len*4 here */
- buf = (char *)malloc(bufsize * sizeof(char));
+ default:
+ method_or_bust(sc, y, sc->LEQ, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
- sprintf(buf, "#<hash-table ");
- for (i = 0; i < len - 1; i++)
- {
- if (elements[i])
+
+ case T_REAL:
+ if (is_NaN(real(x))) goto NOT_LEQ;
+
+ REAL_LEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
{
- /* strcat(buf, "'"); -- it's a constant so do we need a quote? #(0 (1 2)) for example */
- strcat(buf, elements[i]);
- free(elements[i]);
- strcat(buf, " ");
+ case T_INTEGER:
+ if (real(x) > integer(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_LEQ;
+
+ case T_RATIO:
+ if (real(x) > fraction(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_LEQ;
+
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_LEQ;
+ if (real(x) > real(y)) goto NOT_LEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_LEQ;
+
+ default:
+ method_or_bust(sc, y, sc->LEQ, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
- }
- if (elements[len - 1])
- {
- /* strcat(buf, "'"); */
- strcat(buf, elements[len - 1]);
- free(elements[len - 1]);
+ default:
+ method_or_bust(sc, x, sc->LEQ, args, T_REAL, 1);
}
- free(elements);
- if (too_long)
- strcat(buf, " ...");
- strcat(buf, ">");
- return(buf);
+ NOT_LEQ:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->LEQ, position_of(p, args), car(p), T_REAL));
+
+ return(sc->F);
}
+static s7_pointer g_greater(s7_scheme *sc, s7_pointer args)
+{
+ #define H_greater "(> x1 ...) returns #t if its arguments are in decreasing order"
+ #define Q_greater s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_REAL)
+ s7_pointer x, y, p;
+ x = car(args);
+ p = cdr(args);
-/* -------------------------------- objects and functions -------------------------------- */
+ switch (type(x))
+ {
+ case T_INTEGER:
+ INTEGER_GREATER:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) <= integer(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GREATER;
+
+ case T_RATIO:
+ /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
+ */
+ if ((integer(x) <= 0) && (numerator(y) > 0)) goto NOT_GREATER;
+ if ((integer(x) >= 0) && (numerator(y) < 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GREATER;
+ }
+ if ((integer(x) < s7_int32_max) &&
+ (integer(x) > s7_int32_min) &&
+ (denominator(y) < s7_int32_max))
+ {
+ if ((integer(x) * denominator(y)) <= numerator(y)) goto NOT_GREATER;
+ }
+ else
+ {
+ if (integer(x) <= fraction(y)) goto NOT_GREATER;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GREATER;
-bool s7_is_function(s7_pointer p)
-{
- return(is_c_function(p));
-}
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GREATER;
+ if (integer(x) <= real(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GREATER;
+ default:
+ method_or_bust(sc, y, sc->GT, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-bool s7_is_object(s7_pointer p)
-{
- return((is_c_object(p)) || (is_s_object(p)));
-}
+ case T_RATIO:
+ RATIO_GREATER:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if ((numerator(x) < 0) && (integer(y) >= 0)) goto NOT_GREATER;
+ if ((numerator(x) > 0) && (integer(y) <= 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GREATER;
+ }
+ if ((integer(y) < s7_int32_max) &&
+ (integer(y) > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ {
+ if (numerator(x) <= (integer(y) * denominator(x))) goto NOT_GREATER;
+ }
+ else
+ {
+ if (fraction(x) <= integer(y)) goto NOT_GREATER;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GREATER;
-s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function f, int required_args, int optional_args, bool rest_arg, const char *doc)
-{
- s7_func_t *ptr;
- int ftype = T_C_FUNCTION;
- s7_pointer x;
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = denominator(x);
+ n1 = numerator(x);
+ d2 = denominator(y);
+ n2 = numerator(y);
+ if (d1 == d2)
+ {
+ if (n1 <= n2) goto NOT_GREATER;
+ }
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &n2)))
+ {
+ if (fraction(x) <= fraction(y)) goto NOT_GREATER;
+ }
+ else
+ {
+ if (n1 <= n2) goto NOT_GREATER;
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ int d1bits, d2bits;
+ d1bits = integer_length(d1);
+ d2bits = integer_length(d2);
+ if (((d1bits + d2bits) > s7_int_bits) ||
+ ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
+ ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
+ {
+ if (fraction(x) <= fraction(y)) goto NOT_GREATER;
+
+ /* (< 21053343141/6701487259 3587785776203/1142027682075) -> #f because even long doubles aren't enough here
+ * (= 21053343141/6701487259 3587785776203/1142027682075) is #f because it checks the actual ints and
+ * (> 21053343141/6701487259 3587785776203/1142027682075) is #f just like the < case.
+ * similarly
+ * (min 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
+ * (max 21053343141/6701487259 3587785776203/1142027682075) -> 3587785776203/1142027682075
+ *
+ * if we print the long double results as integers, both are -3958705157555305931
+ * so there's not a lot I can do in the non-gmp case.
+ */
+ }
+ else
+ {
+ if ((n1 * d2) <= (n2 * d1)) goto NOT_GREATER;
+ }
+ }
+ else
+ {
+ if ((n1 * d2) <= (n2 * d1)) goto NOT_GREATER;
+ }
+#endif
+ }
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GREATER;
- x = (s7_cell *)permanent_calloc(sizeof(s7_cell));
- x->hloc = NOT_IN_HEAP;
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GREATER;
+ if (fraction(x) <= real(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GREATER;
- ptr = (s7_func_t *)permanent_calloc(sizeof(s7_func_t));
- if (required_args == 0)
- {
- if (rest_arg)
- ftype = T_C_ANY_ARGS_FUNCTION;
- else
- {
- if (optional_args != 0)
- ftype = T_C_OPT_ARGS_FUNCTION;
- /* a thunk needs to check for no args passed */
+ default:
+ method_or_bust(sc, y, sc->GT, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
- }
- else
- {
- if (rest_arg)
- ftype = T_C_RST_ARGS_FUNCTION;
- }
-
- set_type(x, ftype | T_SIMPLE | T_DONT_COPY | T_PROCEDURE | T_DONT_COPY_CDR);
- c_function(x) = ptr;
- c_function_call(x) = f;
- c_function_setter(x) = sc->F;
- c_function_name(x) = name; /* (procedure-name proc) => (format #f "~A" proc); perhaps add this as a built-in function? */
- if (doc)
- c_function_documentation(x) = make_permanent_string(doc);
- c_function_required_args(x) = required_args;
- c_function_optional_args(x) = optional_args;
- c_function_has_rest_arg(x) = rest_arg;
- if (rest_arg)
- c_function_all_args(x) = 10000000;
- else c_function_all_args(x) = required_args + optional_args;
+ case T_REAL:
+ if (is_NaN(real(x))) goto NOT_GREATER;
- return(x);
-}
+ REAL_GREATER:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (real(x) <= integer(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GREATER;
+
+ case T_RATIO:
+ if (real(x) <= fraction(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GREATER;
+
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GREATER;
+ if (real(x) <= real(y)) goto NOT_GREATER;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GREATER;
+ default:
+ method_or_bust(sc, y, sc->GT, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args)
-{
- if (s7_is_symbol(fnc))
- fnc = s7_symbol_value(sc, fnc);
+ default:
+ method_or_bust(sc, x, sc->GT, args, T_REAL, 1);
+ }
- if (is_c_function(fnc))
- return(c_function_call(fnc)(sc, args));
+ NOT_GREATER:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->GT, position_of(p, args), car(p), T_REAL));
- push_stack(sc, opcode(OP_EVAL_DONE), sc->args, sc->code);
- sc->args = make_list_1(sc, args);
- sc->code = fnc;
- eval(sc, OP_APPLY);
- return(sc->value);
+ return(sc->F);
}
-bool s7_is_procedure(s7_pointer x)
+static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args)
{
- return(is_procedure(x)); /* this returns "is applicable" so it is true for applicable c|s_objects, macros, etc */
-}
+ #define H_greater_or_equal "(>= x1 ...) returns #t if its arguments are in decreasing order"
+ #define Q_greater_or_equal s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_REAL)
+ /* (>= 1+i 1+i) is an error which seems unfortunate */
+ s7_pointer x, y, p;
+ x = car(args);
+ p = cdr(args);
-static s7_pointer g_is_procedure(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_procedure "(procedure? obj) returns #t if obj is a procedure"
- s7_pointer x;
- int typ;
+ switch (type(x))
+ {
+ case T_INTEGER:
+ INTEGER_GEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (integer(x) < integer(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GEQ;
+
+ case T_RATIO:
+ /* no gmp here, but this can overflow: (< 9223372036 1/9223372036), but conversion to real is also problematic
+ */
+ if ((integer(x) <= 0) && (numerator(y) > 0)) goto NOT_GEQ;
+ if ((integer(x) >= 0) && (numerator(y) < 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GEQ;
+ }
+ if ((integer(x) < s7_int32_max) &&
+ (integer(x) > s7_int32_min) &&
+ (denominator(y) < s7_int32_max))
+ {
+ if ((integer(x) * denominator(y)) < numerator(y)) goto NOT_GEQ;
+ }
+ else
+ {
+ if (integer(x) < fraction(y)) goto NOT_GEQ;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GEQ;
- x = car(args);
- if (!is_procedure(x)) return(sc->F);
- typ = type(x);
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GEQ;
+ if (integer(x) < real(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GEQ;
- /* make_object sets the T_PROCEDURE bit if the object has an apply function,
- * but we currently return (procedure? "hi") -> #f, so we can't simply use
- * is_procedure.
- *
- * Unfortunately much C code depends on s7_is_procedure treating applicable
- * objects and macros as procedures. Ideally we'd have s7_is_applicable.
- */
- return(make_boolean(sc,
- (typ == T_CLOSURE) ||
- (typ == T_CLOSURE_STAR) ||
- (typ >= T_C_FUNCTION) ||
- (typ == T_GOTO) ||
- (typ == T_CONTINUATION) ||
- (s7_is_procedure_with_setter(x))));
-}
+ default:
+ method_or_bust(sc, y, sc->GEQ, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-static void s7_function_set_setter(s7_scheme *sc, const char *getter, const char *setter)
-{
- /* perhaps these functions should be procedure-with-setter's? */
- c_function_setter(s7_name_to_value(sc, getter)) = s7_name_to_value(sc, setter);
-}
+ case T_RATIO:
+ RATIO_GEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if ((numerator(x) < 0) && (integer(y) >= 0)) goto NOT_GEQ;
+ if ((numerator(x) > 0) && (integer(y) <= 0))
+ {
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GEQ;
+ }
+ if ((integer(y) < s7_int32_max) &&
+ (integer(y) > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ {
+ if (numerator(x) < (integer(y) * denominator(x))) goto NOT_GEQ;
+ }
+ else
+ {
+ if (fraction(x) < integer(y)) goto NOT_GEQ;
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GEQ;
+
+ case T_RATIO:
+ {
+ s7_int d1, d2, n1, n2;
+ d1 = denominator(x);
+ n1 = numerator(x);
+ d2 = denominator(y);
+ n2 = numerator(y);
+ if (d1 == d2)
+ {
+ if (n1 < n2) goto NOT_GEQ;
+ }
+ else
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((multiply_overflow(n1, d2, &n1)) ||
+ (multiply_overflow(n2, d1, &n2)))
+ {
+ if (fraction(x) < fraction(y)) goto NOT_GEQ;
+ }
+ else
+ {
+ if (n1 < n2) goto NOT_GEQ;
+ }
+#else
+ if ((d1 > s7_int32_max) || (d2 > s7_int32_max) || /* before counting bits, check that overflow is possible */
+ (n1 > s7_int32_max) || (n2 > s7_int32_max) ||
+ (n1 < s7_int32_min) || (n2 < s7_int32_min))
+ {
+ int d1bits, d2bits;
+ d1bits = integer_length(d1);
+ d2bits = integer_length(d2);
+ if (((d1bits + d2bits) > s7_int_bits) ||
+ ((d1bits + integer_length(n2)) > (s7_int_bits - 1)) ||
+ ((d2bits + integer_length(n1)) > (s7_int_bits - 1)))
+ {
+ if (fraction(x) < fraction(y)) goto NOT_GEQ;
+ }
+ else
+ {
+ if ((n1 * d2) < (n2 * d1)) goto NOT_GEQ;
+ }
+ }
+ else
+ {
+ if ((n1 * d2) < (n2 * d1)) goto NOT_GEQ;
+ }
+#endif
+ }
+ }
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GEQ;
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GEQ;
+ if (fraction(x) < real(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GEQ;
-static char *pws_documentation(s7_pointer x);
-static s7_pointer pws_source(s7_scheme *sc, s7_pointer x);
-static s7_pointer pws_arity(s7_scheme *sc, s7_pointer obj);
+ default:
+ method_or_bust(sc, y, sc->GEQ, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-s7_pointer s7_procedure_source(s7_scheme *sc, s7_pointer p)
-{
- /* make it look like an internal lambda form */
-
- /* in this context, there's no way to distinguish between:
- * (procedure-source (let ((b 1)) (lambda (a) (+ a b))))
- * and
- * (let ((b 1)) (procedure-source (lambda (a) (+ a b))))
- * both become:
- * ((a) (+ a b)) (((b . 1)) #(() () () () () ((make-filtered-comb . make-filtered-comb)) () () ...))
- */
-
- if (is_closure(p) || is_closure_star(p) || is_macro(p) || is_bacro(p))
- {
- return(s7_cons(sc,
- append_in_place(sc,
- make_list_2(sc,
- (is_closure_star(p)) ? sc->LAMBDA_STAR : sc->LAMBDA,
- closure_args(p)),
- closure_body(p)),
- closure_environment(p)));
- }
-
- if (s7_is_procedure_with_setter(p))
- return(pws_source(sc, p));
- return(sc->NIL);
-}
+ case T_REAL:
+ if (is_NaN(real(x))) goto NOT_GEQ;
+ REAL_GEQ:
+ y = car(p);
+ p = cdr(p);
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (real(x) < integer(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto INTEGER_GEQ;
+
+ case T_RATIO:
+ if (real(x) < fraction(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto RATIO_GEQ;
+
+ case T_REAL:
+ if (is_NaN(real(y))) goto NOT_GEQ;
+ if (real(x) < real(y)) goto NOT_GEQ;
+ if (is_null(p)) return(sc->T);
+ x = y;
+ goto REAL_GEQ;
-static s7_pointer g_procedure_source(s7_scheme *sc, s7_pointer args)
-{
- /* make it look like a scheme-level lambda */
- s7_pointer p;
-
- #define H_procedure_source "(procedure-source func) tries to return the definition of func"
-
- p = car(args);
- if (s7_is_symbol(p))
- {
- if (is_syntax(p))
- return(s7_error(sc, sc->WRONG_TYPE_ARG, make_list_2(sc, make_protected_string(sc, "procedure-source arg, ~S, is not a procedure"), p)));
- p = s7_symbol_value(sc, p);
- if (p == sc->UNDEFINED)
- return(s7_error(sc, sc->WRONG_TYPE_ARG, make_list_2(sc, make_protected_string(sc, "procedure-source arg, '~S, is unbound"), car(args))));
- }
+ default:
+ method_or_bust(sc, y, sc->GEQ, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ }
-#if HAVE_PTHREADS
- if (s7_is_thread(p))
- {
- thred *f;
- f = (thred *)s7_object_value(p);
- p = f->func;
+ default:
+ method_or_bust(sc, x, sc->GEQ, args, T_REAL, 1);
}
-#endif
- if (is_c_macro(p))
- return(s7_wrong_type_arg_error(sc, "procedure-source", 0, p, "a scheme macro"));
- if ((!is_procedure(p)) &&
- (!is_macro(p)) &&
- (!is_bacro(p)))
- return(s7_wrong_type_arg_error(sc, "procedure-source", 0, car(args), "a procedure or a macro"));
-
- if (is_closure(p) || is_closure_star(p) || is_macro(p) || is_bacro(p))
- return(append_in_place(sc,
- make_list_2(sc,
- (is_closure_star(p)) ? sc->LAMBDA_STAR : sc->LAMBDA,
- closure_args(p)),
- closure_body(p)));
-
- if (s7_is_procedure_with_setter(p))
- return(pws_source(sc, p));
- return(sc->NIL);
-}
+ NOT_GEQ:
+ for (; is_pair(p); p = cdr(p))
+ if (!is_real_via_method(sc, car(p)))
+ return(wrong_type_argument(sc, sc->GEQ, position_of(p, args), car(p), T_REAL));
+ return(sc->F);
-s7_pointer s7_procedure_environment(s7_pointer p)
-{
- return(closure_environment(p));
}
-static s7_pointer g_procedure_environment(s7_scheme *sc, s7_pointer args)
+static s7_pointer less_s_ic, less_s0;
+static s7_pointer g_less_s0(s7_scheme *sc, s7_pointer args)
{
- s7_pointer p;
- #define H_procedure_environment "(procedure-environment func) tries to return func's environment"
-
- /* this procedure gives direct access to a function's closure -- see s7test.scm
- * for some wild examples. At least it provides a not-too-kludgey way for several functions
- * to share a closure.
- */
-
- p = car(args);
- if (s7_is_symbol(p))
- {
- if (is_syntax(p))
- return(s7_error(sc, sc->WRONG_TYPE_ARG, make_list_2(sc, make_protected_string(sc, "procedure-environment arg, ~S, is not a procedure"), p)));
- p = s7_symbol_value(sc, p);
- if (p == sc->UNDEFINED)
- return(s7_error(sc, sc->WRONG_TYPE_ARG, make_list_2(sc, make_protected_string(sc, "procedure-environment arg, '~S, is unbound"), car(args))));
- }
-
- if ((!is_procedure(p)) &&
- (!is_macro(p)) &&
- (!is_bacro(p)))
- return(s7_wrong_type_arg_error(sc, "procedure-environment", 0, car(args), "a procedure or a macro"));
-
- if (is_closure(p) || is_closure_star(p) || is_macro(p) || is_bacro(p))
- return(closure_environment(p));
- return(sc->global_env);
+ s7_pointer x;
+ x = car(args);
+ if (is_integer(x))
+ return(make_boolean(sc, integer(x) < 0));
+ if (is_real(x))
+ return(make_boolean(sc, s7_is_negative(x)));
+ method_or_bust(sc, x, sc->LT, args, T_REAL, 1);
}
-
-void s7_define_function(s7_scheme *sc, const char *name, s7_function fnc, int required_args, int optional_args, bool rest_arg, const char *doc)
+static s7_pointer g_less_s_ic(s7_scheme *sc, s7_pointer args)
{
- s7_pointer func;
- func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
- s7_define(sc, s7_global_environment(sc), make_symbol(sc, name), func);
-}
+ s7_int y;
+ s7_pointer x;
+ x = car(args);
+ y = integer(cadr(args));
+ if (is_integer(x))
+ return(make_boolean(sc, integer(x) < y));
-static void s7_define_constant_function(s7_scheme *sc, const char *name, s7_function fnc, int required_args, int optional_args, bool rest_arg, const char *doc)
-{
- s7_pointer func, sym;
- sym = make_symbol(sc, name);
- func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
- s7_define(sc, s7_global_environment(sc), sym, func);
- set_immutable(car(symbol_global_slot(sym)));
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) < y));
+ case T_RATIO:
+ if ((y >= 0) && (numerator(x) < 0))
+ return(sc->T);
+ if ((y <= 0) && (numerator(x) > 0))
+ return(sc->F);
+ if (denominator(x) < s7_int32_max)
+ return(make_boolean(sc, (numerator(x) < (y * denominator(x)))));
+ return(make_boolean(sc, fraction(x) < y));
-void s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, int required_args, int optional_args, bool rest_arg, const char *doc)
-{
- s7_pointer func;
- func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
- set_type(func, T_C_MACRO | T_SIMPLE | T_DONT_COPY | T_ANY_MACRO | T_DONT_COPY_CDR); /* this used to include T_PROCEDURE */
- s7_define(sc, s7_global_environment(sc), make_symbol(sc, name), func);
-}
+ case T_REAL:
+ return(make_boolean(sc, real(x) < y));
+ case T_COMPLEX:
+ default:
+ method_or_bust(sc, x, sc->LT, args, T_REAL, 1);
+ }
+ return(sc->T);
+}
-bool s7_is_macro(s7_scheme *sc, s7_pointer x)
+static s7_pointer less_length_ic;
+static s7_pointer g_less_length_ic(s7_scheme *sc, s7_pointer args)
{
- if ((is_macro(x)) || (is_bacro(x)) || (is_c_macro(x)))
- return(true);
+ s7_int ilen;
+ s7_pointer val;
- if (s7_is_symbol(x))
- {
- x = s7_symbol_local_value(sc, x, sc->envir);
- return(is_macro(x) || is_bacro(x) || is_c_macro(x));
+ val = find_symbol_checked(sc, cadar(args));
+ ilen = s7_integer(cadr(args));
+
+ switch (type(val))
+ {
+ case T_PAIR: return(make_boolean(sc, s7_list_length(sc, val) < ilen));
+ case T_NIL: return(make_boolean(sc, ilen > 0));
+ case T_STRING: return(make_boolean(sc, string_length(val) < ilen));
+ case T_HASH_TABLE: return(make_boolean(sc, hash_table_mask(val) <= ilen));
+ case T_ITERATOR: return(make_boolean(sc, iterator_length(val) < ilen));
+ case T_C_OBJECT: return(make_boolean(sc, object_length_to_int(sc, val) < ilen));
+ case T_LET: return(make_boolean(sc, let_length(sc, val) < ilen)); /* this works because let_length handles the length method itself! */
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR: return(make_boolean(sc, vector_length(val) < ilen));
+ case T_CLOSURE:
+ case T_CLOSURE_STAR: if (has_methods(val)) return(make_boolean(sc, closure_length(sc, val) < ilen));
+ default: return(simple_wrong_type_argument_with_type(sc, sc->LENGTH, val, A_SEQUENCE)); /* no check method here because we checked above */
}
- return(false);
+ return(sc->F);
}
-
-static s7_pointer g_is_macro(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_less_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- #define H_is_macro "(macro? arg) returns #t if 'arg' is a macro"
- return(make_boolean(sc, s7_is_macro(sc, car(args))));
- /* it would be more consistent (with procedure? for example) if this returned #f for a symbol,
- * but fully-expand expects this version.
- */
-}
-
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) < integer(y)));
-void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
-{
- /* make an internal function of any args that calls fnc, then wrap it in define* and use eval_c_string */
- /* should (does) this ignore :key and other such noise? */
+ case T_RATIO:
+ return(g_less(sc, list_2(sc, x, y)));
- char *internal_function, *internal_arglist;
- int arglist_len, len, args;
- const char *local_sym;
- s7_pointer local_args;
-
- arglist_len = safe_strlen(arglist);
- internal_arglist = (char *)calloc(arglist_len + 64, sizeof(char));
- snprintf(internal_arglist, arglist_len + 64, "(map (lambda (arg) (if (symbol? arg) arg (car arg))) '(%s))", arglist);
- local_args = s7_eval_c_string(sc, internal_arglist);
- free(internal_arglist);
-
- args = safe_list_length(sc, local_args); /* since local_args is from map (above), I think it can't be improper */
- internal_arglist = s7_object_to_c_string(sc, local_args);
- /* this has an opening paren which we don't want */
- internal_arglist[0] = ' ';
+ case T_REAL:
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, integer(x) < real(y)));
- local_sym = symbol_name(s7_gensym(sc, "define*"));
- s7_define_function(sc, local_sym, fnc, args, 0, 0, NULL);
+ default:
+ method_or_bust(sc, y, sc->LT, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
- len = 32 + 2 * arglist_len + safe_strlen(doc) + safe_strlen(name) + safe_strlen(local_sym);
- internal_function = (char *)calloc(len, sizeof(char));
- snprintf(internal_function, len, "(define* (%s %s) \"%s\" (%s %s)", name, arglist, doc, local_sym, internal_arglist);
- s7_eval_c_string(sc, internal_function);
+ case T_RATIO:
+ return(g_less(sc, list_2(sc, x, y)));
- free(internal_function);
- free(internal_arglist);
-}
+ case T_REAL:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) < integer(y)));
+ case T_RATIO:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) < fraction(y)));
-const char *s7_procedure_documentation(s7_scheme *sc, s7_pointer x)
-{
- if (s7_is_symbol(x))
- x = s7_symbol_value(sc, x); /* this is needed by Snd */
+ case T_REAL:
+ if (is_NaN(real(x))) return(sc->F);
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, real(x) < real(y)));
- if ((s7_is_function(x)) ||
- (is_c_macro(x)))
- return((char *)c_function_documentation(x));
-
- if (((is_closure(x)) ||
- (is_closure_star(x))) &&
- (s7_is_string(car(closure_body(x)))))
- return(s7_string(car(closure_body(x))));
-
- if (s7_is_procedure_with_setter(x))
- return(pws_documentation(x));
-
- if ((s7_is_macro(sc, x)) &&
- (s7_is_string(caddr(cadr(car(closure_body(x)))))))
- return(s7_string(caddr(cadr(car(closure_body(x))))));
+ default:
+ method_or_bust(sc, y, sc->LT, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
- return(""); /* not NULL here so that (string=? "" (procedure-documentation no-doc-func)) -> #t */
+ default:
+ method_or_bust(sc, x, sc->LT, list_2(sc, x, y), T_REAL, 1);
+ }
+ return(sc->T);
}
+static s7_pointer c_less_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
+ {
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) < integer(y)));
+ case T_RATIO: return(make_boolean(sc, fraction(x) < fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) < real(y)));
+ }
+ }
+#endif
+ return(c_less_2_1(sc, x, y));
+}
-/* perhaps this should be settable? I think it is in sbcl */
-
-static s7_pointer g_procedure_documentation_1(s7_scheme *sc, s7_pointer args, const char *caller)
+static s7_pointer less_2;
+static s7_pointer g_less_2(s7_scheme *sc, s7_pointer args)
{
- s7_pointer p;
+ s7_pointer x, y;
- p = car(args);
- if (s7_is_symbol(p))
+ x = car(args);
+ y = cadr(args);
+
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- if (is_syntax(p))
- return(s7_wrong_type_arg_error(sc, caller, 0, p, "a procedure"));
- p = s7_symbol_value(sc, p);
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) < integer(y)));
+ case T_RATIO: return(make_boolean(sc, fraction(x) < fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) < real(y)));
+ }
}
-
- if ((!is_procedure(p)) &&
- (!s7_is_macro(sc, p)))
- return(s7_wrong_type_arg_error(sc, caller, 0, car(args), "a procedure"));
- return(s7_make_string(sc, s7_procedure_documentation(sc, p)));
+#endif
+ return(c_less_2_1(sc, x, y));
}
+static s7_pointer c_less_i(s7_scheme *sc, s7_int x, s7_int y) {return(make_boolean(sc, x < y));}
+static s7_pointer c_less_r(s7_scheme *sc, s7_double x, s7_double y) {return(make_boolean(sc, x < y));}
+XF2_TO_PF(less, c_less_i, c_less_r, c_less_2)
-static s7_pointer g_procedure_documentation(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer leq_s_ic;
+static s7_pointer g_leq_s_ic(s7_scheme *sc, s7_pointer args)
{
- #define H_procedure_documentation "(procedure-documentation func) returns func's documentation string"
- return(g_procedure_documentation_1(sc, args, "procedure-documentation"));
-}
+ s7_int y;
+ s7_pointer x;
+ x = car(args);
+ y = s7_integer(cadr(args));
-static s7_pointer g_help(s7_scheme *sc, s7_pointer args)
-{
- #define H_help "(help func) returns func's documentation string"
- return(g_procedure_documentation_1(sc, args, "help"));
+ switch (type(x))
+ {
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) <= y));
+
+ case T_RATIO:
+ if ((y >= 0) && (numerator(x) <= 0))
+ return(sc->T);
+ if ((y <= 0) && (numerator(x) > 0))
+ return(sc->F);
+ if (denominator(x) < s7_int32_max)
+ return(make_boolean(sc, (numerator(x) <= (y * denominator(x)))));
+ return(make_boolean(sc, fraction(x) <= y));
+
+ case T_REAL:
+ return(make_boolean(sc, real(x) <= y));
+
+ default:
+ method_or_bust(sc, x, sc->LEQ, args, T_REAL, 1);
+ }
+ return(sc->T);
}
-s7_pointer s7_procedure_arity(s7_scheme *sc, s7_pointer x)
+static s7_pointer c_leq_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- if (s7_is_function(x))
- return(make_list_3(sc,
- s7_make_integer(sc, c_function_required_args(x)),
- s7_make_integer(sc, c_function_optional_args(x)),
- (c_function_has_rest_arg(x)) ? sc->T : sc->F));
-
- if ((is_closure(x)) ||
- (is_closure_star(x)) ||
- (is_pair(x)))
+ switch (type(x))
{
- int len;
-
- if (is_pair(x))
- len = s7_list_length(sc, car(x));
- else
+ case T_INTEGER:
+ switch (type(y))
{
- if (s7_is_symbol(closure_args(x)))
- return(make_list_3(sc, small_int(0), small_int(0), sc->T));
- len = s7_list_length(sc, closure_args(x));
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) <= integer(y)));
+
+ case T_RATIO:
+ return(g_less_or_equal(sc, list_2(sc, x, y)));
+
+ case T_REAL:
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, integer(x) <= real(y)));
+
+ default:
+ method_or_bust(sc, y, sc->LEQ, list_2(sc, x, y), T_REAL, 2);
}
+ break;
+
+ case T_RATIO:
+ return(g_less_or_equal(sc, list_2(sc, x, y)));
- if (is_closure_star(x))
+ case T_REAL:
+ switch (type(y))
{
- s7_pointer tmp; /* make sure we aren't counting :optional and friends as arguments */
- int opts = 0;
+ case T_INTEGER:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) <= integer(y)));
- if (is_pair(x))
- tmp = car(x);
- else tmp = closure_args(x);
+ case T_RATIO:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) <= fraction(y)));
- for (; is_pair(tmp); tmp = cdr(tmp))
- {
- if ((car(tmp) == sc->KEY_KEY) ||
- (car(tmp) == sc->KEY_OPTIONAL) ||
- (car(tmp) == sc->KEY_ALLOW_OTHER_KEYS))
- opts++;
- if (car(tmp) == sc->KEY_REST)
- {
- opts += 2; /* both :rest and the arg name are not counted as optional args */
- if (len > 0) len = -len;
- }
- }
- return(make_list_3(sc, small_int(0), s7_make_integer(sc, abs(len) - opts), make_boolean(sc, len < 0)));
+ case T_REAL:
+ if (is_NaN(real(x))) return(sc->F);
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, real(x) <= real(y)));
+
+ default:
+ method_or_bust(sc, y, sc->LEQ, list_2(sc, x, y), T_REAL, 2);
}
+ break;
- return(make_list_3(sc, s7_make_integer(sc, abs(len)), small_int(0), make_boolean(sc, len < 0)));
+ default:
+ method_or_bust(sc, x, sc->LEQ, list_2(sc, x, y), T_REAL, 1);
}
-
- if (s7_is_procedure_with_setter(x))
- {
- if (s7_procedure_with_setter_getter(x) != sc->NIL)
- return(append_in_place(sc,
- s7_procedure_arity(sc, s7_procedure_with_setter_getter(x)),
- s7_procedure_arity(sc, s7_procedure_with_setter_setter(x))));
+ return(sc->T);
+}
- return(pws_arity(sc, x));
+static s7_pointer c_leq_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
+ {
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) <= integer(y)));
+ case T_RATIO: return(make_boolean(sc, fraction(x) <= fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) <= real(y)));
+ }
}
-
- if ((object_is_applicable(x)) ||
- (s7_is_continuation(x)) ||
- (is_goto(x)))
- return(make_list_3(sc, small_int(0), small_int(0), sc->T));
-
- /* it's not straightforward to add support for macros here -- the arity from the
- * user's point of view refers to the embedded lambda, not the outer lambda.
- */
- return(sc->NIL);
+#endif
+ return(c_leq_2_1(sc, x, y));
}
-
-static s7_pointer g_procedure_arity(s7_scheme *sc, s7_pointer args)
+static s7_pointer leq_2;
+static s7_pointer g_leq_2(s7_scheme *sc, s7_pointer args)
{
- #define H_procedure_arity "(procedure-arity func) returns a list '(required optional rest)"
- s7_pointer p;
+ s7_pointer x, y;
- p = car(args);
- if (s7_is_symbol(p))
+ x = car(args);
+ y = cadr(args);
+
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- if (is_syntax(p))
- return(s7_error(sc, sc->WRONG_TYPE_ARG, make_list_2(sc, make_protected_string(sc, "procedure-arity arg, ~S, is not a procedure"), p)));
- p = s7_symbol_value(sc, p);
- if (p == sc->UNDEFINED)
- return(s7_error(sc, sc->WRONG_TYPE_ARG, make_list_2(sc, make_protected_string(sc, "procedure-arity arg, '~S, is unbound"), car(args))));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) <= integer(y)));
+ case T_RATIO: return(make_boolean(sc, fraction(x) <= fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) <= real(y)));
+ }
}
-
- if (!is_procedure(p))
- return(s7_wrong_type_arg_error(sc, "procedure-arity", 0, car(args), "a procedure"));
- return(s7_procedure_arity(sc, p));
+#endif
+ return(c_leq_2_1(sc, x, y));
}
+static s7_pointer c_leq_i(s7_scheme *sc, s7_int x, s7_int y) {return(make_boolean(sc, x <= y));}
+static s7_pointer c_leq_r(s7_scheme *sc, s7_double x, s7_double y) {return(make_boolean(sc, x <= y));}
+XF2_TO_PF(leq, c_leq_i, c_leq_r, c_leq_2)
-static s7_pointer closure_name(s7_scheme *sc, s7_pointer closure)
+
+static s7_pointer greater_s_ic, greater_s_fc;
+static s7_pointer g_greater_s_ic(s7_scheme *sc, s7_pointer args)
{
+ s7_int y;
s7_pointer x;
- x = find_local_symbol(sc, closure_environment(closure), sc->__FUNC__); /* returns nil if no __func__ */
- if (is_pair(x))
+ x = car(args);
+ y = integer(cadr(args));
+ switch (type(x))
{
- x = symbol_value(x);
- if (s7_is_symbol(x))
- return(x);
- if ((is_pair(x)) &&
- (s7_is_symbol(car(x))))
- return(car(x));
- }
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) > y));
- if (is_pair(sc->cur_code))
- return(sc->cur_code);
+ case T_RATIO:
+ if (denominator(x) < s7_int32_max) /* y has already been checked for range */
+ return(make_boolean(sc, (numerator(x) > (y * denominator(x)))));
+ return(make_boolean(sc, fraction(x) > y));
+
+ case T_REAL:
+ return(make_boolean(sc, real(x) > y));
- return(caar(closure)); /* desperation -- this is the parameter list */
+ default:
+ method_or_bust_with_type(sc, x, sc->GT, args, A_NUMBER, 1);
+ }
+ return(sc->T);
}
-/* (define* (hi (a 1) (b 2)) a) (hi :b 1 2) */
-/* (let ((x (lambda* ((a 1) (b 2)) a))) (x :b 1 2)) */
+static s7_pointer g_greater_s_fc(s7_scheme *sc, s7_pointer args)
+{
+ s7_double y;
+ s7_pointer x;
+ x = car(args);
+ y = real(cadr(args));
+ if (is_t_real(x))
+ return(make_boolean(sc, real(x) > y));
-/* -------------------------------- new types -------------------------------- */
+ switch (type(x))
+ {
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) > y));
-typedef struct {
- int type;
- const char *name;
- char *(*print)(s7_scheme *sc, void *value);
- void (*free)(void *value);
- bool (*equal)(void *val1, void *val2);
- void (*gc_mark)(void *val);
- s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
- s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
- s7_pointer (*length)(s7_scheme *sc, s7_pointer obj);
- s7_pointer (*copy)(s7_scheme *sc, s7_pointer obj);
- s7_pointer (*fill)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
- s7_pointer print_func, equal_func, getter_func, setter_func, length_func, copy_func, fill_func;
-} s7_c_object_t;
+ case T_RATIO:
+ /* (> 9223372036854775807/9223372036854775806 1.0) */
+ if (denominator(x) < s7_int32_max) /* y range check was handled in greater_chooser */
+ return(make_boolean(sc, (numerator(x) > (y * denominator(x)))));
+ return(make_boolean(sc, fraction(x) > y));
+ case T_REAL:
+ return(make_boolean(sc, real(x) > y));
-static s7_c_object_t *object_types = NULL;
-static int object_types_size = 0;
-static int num_types = 0;
+ default:
+ method_or_bust_with_type(sc, x, sc->GT, args, A_NUMBER, 1);
+ }
+ return(sc->T);
+}
-int s7_new_type(const char *name,
- char *(*print)(s7_scheme *sc, void *value),
- void (*free)(void *value),
- bool (*equal)(void *val1, void *val2),
- void (*gc_mark)(void *val),
- s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
- s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args))
+
+static s7_pointer c_greater_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- int tag;
- tag = num_types++;
- if (tag >= object_types_size)
+ switch (type(x))
{
- if (object_types_size == 0)
- {
- object_types_size = 8;
- object_types = (s7_c_object_t *)calloc(object_types_size, sizeof(s7_c_object_t));
- }
- else
+ case T_INTEGER:
+ switch (type(y))
{
- object_types_size = tag + 8;
- object_types = (s7_c_object_t *)realloc((void *)object_types, object_types_size * sizeof(s7_c_object_t));
- }
- }
- object_types[tag].type = tag;
- object_types[tag].name = copy_string(name);
- object_types[tag].free = free;
- object_types[tag].print = print;
- object_types[tag].equal = equal;
- object_types[tag].gc_mark = gc_mark;
- object_types[tag].apply = apply;
- object_types[tag].set = set;
- object_types[tag].length = NULL;
- object_types[tag].copy = NULL;
- object_types[tag].fill = NULL;
- return(tag);
-}
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) > integer(y)));
+ case T_RATIO:
+ return(g_greater(sc, list_2(sc, x, y)));
-int s7_new_type_x(const char *name,
- char *(*print)(s7_scheme *sc, void *value),
- void (*free)(void *value),
- bool (*equal)(void *val1, void *val2),
- void (*gc_mark)(void *val),
- s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
- s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
- s7_pointer (*length)(s7_scheme *sc, s7_pointer obj),
- s7_pointer (*copy)(s7_scheme *sc, s7_pointer obj),
- s7_pointer (*fill)(s7_scheme *sc, s7_pointer obj, s7_pointer val))
-{
- int tag;
- tag = s7_new_type(name, print, free, equal, gc_mark, apply, set);
- object_types[tag].length = length;
- object_types[tag].copy = copy;
- object_types[tag].fill = fill;
- return(tag);
-}
+ case T_REAL:
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, integer(x) > real(y)));
+ default:
+ method_or_bust(sc, y, sc->GT, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
-static char *describe_object(s7_scheme *sc, s7_pointer a)
-{
- int tag;
- tag = c_object_type(a);
- if (object_types[tag].print)
- return((*(object_types[tag].print))(sc, c_object_value(a))); /* assume allocation here (so we'll free the string later) */
- return(copy_string(object_types[tag].name));
-}
+ case T_RATIO:
+ return(g_greater(sc, list_2(sc, x, y)));
+ case T_REAL:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) > integer(y)));
-static void free_object(s7_pointer a)
-{
- int tag;
- tag = c_object_type(a);
- if (object_types[tag].free)
- (*(object_types[tag].free))(c_object_value(a));
-}
+ case T_RATIO:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) > fraction(y)));
+ case T_REAL:
+ if (is_NaN(real(x))) return(sc->F);
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, real(x) > real(y)));
-static bool objects_are_equal(s7_pointer a, s7_pointer b)
-{
- if (c_object_type(a) == c_object_type(b))
- {
- int tag;
- tag = c_object_type(a);
- if (object_types[tag].equal)
- return((*(object_types[tag].equal))(c_object_value(a), c_object_value(b)));
- return(a == b);
+ default:
+ method_or_bust(sc, y, sc->GT, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
+
+ default:
+ method_or_bust(sc, x, sc->GT, list_2(sc, x, y), T_REAL, 1);
}
- return(false);
+ return(sc->T);
}
-
-static void mark_embedded_objects(s7_pointer a) /* called by gc, calls fobj's mark func */
+static s7_pointer c_greater_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- int tag;
- tag = c_object_type(a);
- if (tag < num_types)
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- if (object_types[tag].gc_mark)
- (*(object_types[tag].gc_mark))(c_object_value(a));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) > integer(y)));
+ case T_RATIO: return(make_boolean(sc, fraction(x) > fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) > real(y)));
+ }
}
+#endif
+ return(c_greater_2_1(sc, x, y));
}
-
-static bool object_is_applicable(s7_pointer x)
-{
- return(((is_c_object(x)) || (is_s_object(x))) &&
- (object_types[c_object_type(x)].apply));
-}
-
-
-static s7_pointer apply_object(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+static s7_pointer greater_2;
+static s7_pointer g_greater_2(s7_scheme *sc, s7_pointer args)
{
- int tag;
- tag = c_object_type(obj);
- if (object_types[tag].apply)
- return((*(object_types[tag].apply))(sc, obj, args));
-
- return(apply_error(sc, obj, args));
-}
-
-
-#define object_set_function(Obj) object_types[c_object_type(Obj)].set
+ s7_pointer x, y;
-static s7_pointer object_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
-{
- int tag;
- tag = c_object_type(obj);
- if (object_types[tag].set)
- return((*(object_types[tag].set))(sc, obj, args));
+ x = car(args);
+ y = cadr(args);
- return(eval_error(sc, "attempt to set ~A?", obj));
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
+ {
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) > integer(y)));
+ case T_RATIO: return(make_boolean(sc, fraction(x) > fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) > real(y)));
+ }
+ }
+#endif
+ return(c_greater_2_1(sc, x, y));
}
-
-void *s7_object_value(s7_pointer obj)
-{
- return(c_object_value(obj));
-}
+static s7_pointer c_gt_i(s7_scheme *sc, s7_int x, s7_int y) {return(make_boolean(sc, x > y));}
+static s7_pointer c_gt_r(s7_scheme *sc, s7_double x, s7_double y) {return(make_boolean(sc, x > y));}
+XF2_TO_PF(gt, c_gt_i, c_gt_r, c_greater_2)
-int s7_object_type(s7_pointer obj)
+static s7_pointer greater_2_f;
+static s7_pointer g_greater_2_f(s7_scheme *sc, s7_pointer args)
{
- if (is_c_object(obj))
- return(c_object_type(obj));
- if (is_s_object(obj))
- return(s_object_type(obj));
- return(-1);
+ return(make_boolean(sc, real(car(args)) > real(cadr(args))));
}
-s7_pointer s7_make_object(s7_scheme *sc, int type, void *value)
+static s7_pointer c_geq_2_1(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- s7_pointer x;
- NEW_CELL(sc, x);
- c_object_type(x) = type;
- c_object_value(x) = value;
- set_type(x, T_C_OBJECT | T_FINALIZABLE | T_DONT_COPY);
- if (object_types[type].apply)
- typeflag(x) |= T_PROCEDURE;
- return(x);
-}
+ switch (type(x))
+ {
+ case T_INTEGER:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) >= integer(y)));
+ case T_RATIO:
+ return(g_greater_or_equal(sc, list_2(sc, x, y)));
-static s7_pointer object_length(s7_scheme *sc, s7_pointer obj)
-{
- int tag;
- tag = c_object_type(obj);
- if (object_types[tag].length)
- return((*(object_types[tag].length))(sc, obj));
+ case T_REAL:
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, integer(x) >= real(y)));
- return(eval_error(sc, "attempt to get length of ~A?", obj));
-}
+ default:
+ method_or_bust(sc, y, sc->GEQ, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
+ case T_RATIO:
+ return(g_greater_or_equal(sc, list_2(sc, x, y)));
-static s7_pointer object_copy(s7_scheme *sc, s7_pointer obj)
-{
- int tag;
- tag = c_object_type(obj);
- if (object_types[tag].copy)
- return((*(object_types[tag].copy))(sc, obj));
+ case T_REAL:
+ switch (type(y))
+ {
+ case T_INTEGER:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) >= integer(y)));
- return(eval_error(sc, "attempt to copy ~A?", obj));
-}
+ case T_RATIO:
+ if (is_NaN(real(x))) return(sc->F);
+ return(make_boolean(sc, real(x) >= fraction(y)));
+ case T_REAL:
+ if (is_NaN(real(x))) return(sc->F);
+ if (is_NaN(real(y))) return(sc->F);
+ return(make_boolean(sc, real(x) >= real(y)));
-static s7_pointer object_fill(s7_scheme *sc, s7_pointer obj, s7_pointer val)
-{
- int tag;
- tag = c_object_type(obj);
- if (object_types[tag].fill)
- return((*(object_types[tag].fill))(sc, obj, val));
+ default:
+ method_or_bust(sc, y, sc->GEQ, list_2(sc, x, y), T_REAL, 2);
+ }
+ break;
- return(eval_error(sc, "attempt to fill ~A?", obj));
+ default:
+ method_or_bust(sc, x, sc->GEQ, list_2(sc, x, y), T_REAL, 1);
+ }
+ return(sc->T);
}
-
-#define SAVE_X_Y_Z(X, Y, Z) \
- do { \
- X = s7_gc_protect(sc, sc->x); \
- Y = s7_gc_protect(sc, sc->y); \
- Z = s7_gc_protect(sc, sc->z); \
- } while (0)
-
-#define RESTORE_X_Y_Z(X, Y, Z) \
- do { \
- sc->x = s7_gc_protected_at(sc, save_x); \
- sc->y = s7_gc_protected_at(sc, save_y); \
- sc->z = s7_gc_protected_at(sc, save_z); \
- s7_gc_unprotect_at(sc, save_x); \
- s7_gc_unprotect_at(sc, save_y); \
- s7_gc_unprotect_at(sc, save_z); \
- } while (0)
-
-
-static s7_pointer object_reverse(s7_scheme *sc, s7_pointer obj)
+static s7_pointer c_geq_2(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- /* someday this should be embedded in the evaluator
- * it's called only in g_reverse.
- */
- int tag;
- tag = c_object_type(obj);
- if ((object_types[tag].copy) &&
- (object_types[tag].length) &&
- (object_types[tag].set) &&
- (object_types[tag].apply))
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
{
- s7_pointer new_obj, i_args, j_args, i_set_args, j_set_args;
- int new_obj_gc_loc, i_gc_loc, j_gc_loc, i_set_gc_loc, j_set_gc_loc;
- s7_Int i, j, len;
- int save_x, save_y, save_z;
-
- if (is_s_object(obj))
- SAVE_X_Y_Z(save_x, save_y, save_z);
-
- new_obj = object_copy(sc, obj);
- new_obj_gc_loc = s7_gc_protect(sc, new_obj);
- len = s7_integer(object_length(sc, obj));
-
- i_args = make_list_1(sc, make_mutable_integer(sc, 0));
- i_gc_loc = s7_gc_protect(sc, i_args);
- j_args = make_list_1(sc, make_mutable_integer(sc, len - 1));
- j_gc_loc = s7_gc_protect(sc, j_args);
- i_set_args = make_list_2(sc, car(i_args), sc->NIL);
- i_set_gc_loc = s7_gc_protect(sc, i_set_args);
- j_set_args = make_list_2(sc, car(j_args), sc->NIL);
- j_set_gc_loc = s7_gc_protect(sc, j_set_args);
- /* all that to reduce consing during the loop! */
-
- for (i = 0, j = len - 1; i < j; i++, j--)
+ switch (type(x))
{
- s7_pointer tmp;
- integer(number(car(i_args))) = i;
- integer(number(car(j_args))) = j;
-
- tmp = apply_object(sc, obj, i_args); /* tmp = obj[i] */
- cadr(i_set_args) = apply_object(sc, obj, j_args);
- object_set(sc, new_obj, i_set_args); /* obj[i] = obj[j] */
- cadr(j_set_args) = tmp;
- object_set(sc, new_obj, j_set_args); /* obj[j] = tmp */
+ case T_INTEGER: return(make_boolean(sc, integer(x) >= integer(y)));
+ case T_RATIO: return(make_boolean(sc, fraction(x) >= fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) >= real(y)));
}
-
- s7_gc_unprotect_at(sc, i_gc_loc);
- s7_gc_unprotect_at(sc, j_gc_loc);
- s7_gc_unprotect_at(sc, i_set_gc_loc);
- s7_gc_unprotect_at(sc, j_set_gc_loc);
- s7_gc_unprotect_at(sc, new_obj_gc_loc);
- if (is_s_object(obj))
- RESTORE_X_Y_Z(save_x, save_y, save_z);
-
- return(new_obj);
}
-
- return(s7_wrong_type_arg_error(sc, "reverse", 0, obj, "a reversible object"));
+#endif
+ return(c_geq_2_1(sc, x, y));
}
+#endif
+static s7_pointer geq_2 = NULL;
-
-/* ---------------- scheme-level new types ---------------- */
-
-typedef struct {
- int type;
- s7_pointer value;
-} s_type_t;
-
-
-static char *call_s_object_print(s7_scheme *sc, void *value)
+#if (!WITH_GMP)
+static s7_pointer g_geq_2(s7_scheme *sc, s7_pointer args)
{
- /* value here is the s_type_t object, the (scheme) function to call is object_types[tag].print_func */
- /* it will be passed the value, not the original object */
+ s7_pointer x, y;
- s_type_t *obj = (s_type_t *)value;
- car(sc->s_function_args) = obj->value;
- return(copy_string((char *)s7_string(s7_call(sc, object_types[obj->type].print_func, sc->s_function_args))));
+ x = car(args);
+ y = cadr(args);
- /* describe_object assumes the value returned here can be freed */
+#if (!MS_WINDOWS)
+ if (type(x) == type(y))
+ {
+ if (is_integer(x))
+ return(make_boolean(sc, integer(x) >= integer(y)));
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) >= integer(y)));
+ case T_RATIO: return(make_boolean(sc, fraction(x) >= fraction(y)));
+ case T_REAL: return(make_boolean(sc, real(x) >= real(y)));
+ }
+ }
+#endif
+ return(c_geq_2_1(sc, x, y));
}
+static s7_pointer c_geq_i(s7_scheme *sc, s7_int x, s7_int y) {return(make_boolean(sc, x >= y));}
+static s7_pointer c_geq_r(s7_scheme *sc, s7_double x, s7_double y) {return(make_boolean(sc, x >= y));}
+XF2_TO_PF(geq, c_geq_i, c_geq_r, c_geq_2)
-static bool call_s_object_equal(s7_scheme *sc, s7_pointer a, s7_pointer b)
-{
- s_type_t *obj1, *obj2;
- if (s_object_type(a) != s_object_type(b))
- return(false);
- obj1 = (s_type_t *)s7_object_value(a);
- obj2 = (s_type_t *)s7_object_value(b);
+static s7_pointer geq_s_fc;
+static s7_pointer g_geq_s_fc(s7_scheme *sc, s7_pointer args)
+{
+ s7_double y;
+ s7_pointer x;
- if (object_types[obj1->type].equal_func != sc->F)
- return(s7_boolean(sc, s7_call(sc, object_types[obj1->type].equal_func, make_list_2(sc, obj1->value, obj2->value))));
+ x = car(args);
+ y = real(cadr(args));
- return(s7_is_equal(sc, obj1->value, obj2->value));
+ if (is_t_real(x))
+ return(make_boolean(sc, real(x) >= y));
+ return(g_geq_2(sc, args));
}
-static s7_pointer call_s_object_getter(s7_scheme *sc, s7_pointer a, s7_pointer args)
+static s7_pointer geq_length_ic;
+static s7_pointer g_geq_length_ic(s7_scheme *sc, s7_pointer args)
{
- /* still accessible via for-each */
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(a);
- return(s7_call(sc, object_types[obj->type].getter_func, s7_cons(sc, obj->value, args))); /* ?? */
+ return(make_boolean(sc, is_false(sc, g_less_length_ic(sc, args))));
}
-static s7_pointer call_s_object_setter(s7_scheme *sc, s7_pointer a, s7_pointer args)
+static s7_pointer geq_s_ic;
+static s7_pointer g_geq_s_ic(s7_scheme *sc, s7_pointer args)
{
- /* still accessible via reverse, for-each */
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(a);
- return(s7_call(sc, object_types[obj->type].setter_func, s7_cons(sc, obj->value, args))); /* ?? */
-}
+ s7_int y;
+ s7_pointer x;
+ x = car(args);
+ y = s7_integer(cadr(args));
-/* generalized set! calls g_object_set which then calls the object's set function */
+ switch (type(x))
+ {
+ case T_INTEGER:
+ return(make_boolean(sc, integer(x) >= y));
-static s7_pointer g_object_set(s7_scheme *sc, s7_pointer args)
-{
- int tag;
- s_type_t *obj;
+ case T_RATIO:
+ if ((y >= 0) && (numerator(x) < 0))
+ return(sc->F);
+ if ((y <= 0) && (numerator(x) >= 0))
+ return(sc->T);
+ if ((y < s7_int32_max) &&
+ (y > s7_int32_min) &&
+ (denominator(x) < s7_int32_max))
+ return(make_boolean(sc, (numerator(x) >= (y * denominator(x)))));
+ return(make_boolean(sc, fraction(x) >= y));
- if (is_c_object(car(args)))
- return(object_set(sc, car(args), cdr(args)));
+ case T_REAL:
+ return(make_boolean(sc, real(x) >= y));
- tag = s_object_type(car(args));
- obj = (s_type_t *)s7_object_value(car(args));
- car(args) = obj->value; /* this should be safe -- we cons up this list in OP_SET */
- push_stack(sc, opcode(OP_APPLY), args, object_types[tag].setter_func);
- return(sc->UNSPECIFIED);
+ default:
+ method_or_bust(sc, x, sc->GEQ, args, T_REAL, 1);
+ }
+ return(sc->T);
}
+#endif
+/* end (!WITH_GMP) */
-static s7_pointer call_s_object_length(s7_scheme *sc, s7_pointer a)
+/* ---------------------------------------- real-part imag-part ---------------------------------------- */
+
+s7_double s7_real_part(s7_pointer x)
{
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(a);
- car(sc->s_function_args) = obj->value;
- return(s7_call(sc, object_types[obj->type].length_func, sc->s_function_args));
+ switch(type(x))
+ {
+ case T_INTEGER: return((s7_double)integer(x));
+ case T_RATIO: return(fraction(x));
+ case T_REAL: return(real(x));
+ case T_COMPLEX: return(real_part(x));
+#if WITH_GMP
+ case T_BIG_INTEGER: return((s7_double)big_integer_to_s7_int(big_integer(x)));
+ case T_BIG_RATIO: return((s7_double)((long double)big_integer_to_s7_int(mpq_numref(big_ratio(x))) / (long double)big_integer_to_s7_int(mpq_denref(big_ratio(x)))));
+ case T_BIG_REAL: return((s7_double)mpfr_get_d(big_real(x), GMP_RNDN));
+ case T_BIG_COMPLEX: return((s7_double)mpfr_get_d(mpc_realref(big_complex(x)), GMP_RNDN));
+#endif
+ }
+ return(0.0);
}
-/* s7_call in this context can lead to segfaults:
- *
- * (call-with-exit (lambda (exit) (length ((cadr (make-type :length (lambda (a) (exit 32)))) 1))))
- * [partly fixed; still callable via object_reverse and applicable_length]
- *
- * (call-with-exit (lambda (exit) (object->string ((cadr (make-type :print (lambda (a) (exit 32)))) 1))))
- * [hard to fix -- very low level access to the method (atom_to_c_string)]
- *
- * (call-with-exit (lambda (exit) (copy ((cadr (make-type :copy (lambda (a) (exit 32)))) 1))))
- * [called in object_reverse and s7_copy, g_copy calls s7_copy]
- * [hard to fix because hash-tables use s7_copy -- needs at least expansion of g_copy]
- * [ and in g_copy we'd need another operator OP_MAKE_S_OBJECT maybe, to handle the ]
- * [ result = make_s_object(sc, new_obj->type, (void *)new_obj) business after the ]
- * [ value has been copied.]
- *
- * (call-with-exit (lambda (exit) (fill! ((cadr (make-type :fill (lambda (a n) (exit 32)))) 1) 0)))
- * [fixed]
- *
- * (call-with-exit (lambda (exit) (let ((typ (make-type :equal (lambda (a n) (exit 32))))) (equal? ((cadr typ) 1) ((cadr typ) 1)))))
- * [callable via s7_is_equal and s7_is_equal_ci]
- * [hard to fix: g_is_equal calls s7_is_equal, but here I think we could split out s_object_equal if equal_func exists]
- *
- * reverse uses length and copy
- *
- * the *#readers*, *unbound-variable-hook* funcs have the same problem [symbol-bind, thread func?]
- * [reader funcs are s7_call'ed in check_sharp_readers called from make_sharp_constant]
- */
-
-static s7_pointer make_s_object(s7_scheme *sc, int type, void *value)
+s7_double s7_imag_part(s7_pointer x)
{
- s7_pointer x;
-
- NEW_CELL(sc, x);
- s_object_type(x) = type;
- s_object_value(x) = value;
- set_type(x, T_S_OBJECT | T_FINALIZABLE | T_DONT_COPY);
- if (object_types[type].apply)
- typeflag(x) |= T_PROCEDURE;
-
- return(x);
+ switch (type(x))
+ {
+ case T_COMPLEX: return(imag_part(x));
+#if WITH_GMP
+ case T_BIG_COMPLEX: return((s7_double)mpfr_get_d(mpc_imagref(big_complex(x)), GMP_RNDN));
+#endif
+ }
+ return(0.0);
}
-
-static s7_pointer call_s_object_copy(s7_scheme *sc, s7_pointer a)
+static s7_pointer g_real_part(s7_scheme *sc, s7_pointer args)
{
- s_type_t *obj, *new_obj;
+ #define H_real_part "(real-part num) returns the real part of num"
+ #define Q_real_part s7_make_signature(sc, 2, sc->IS_REAL, sc->IS_NUMBER)
- obj = (s_type_t *)s7_object_value(a);
- car(sc->s_function_args) = obj->value;
+ s7_pointer p;
+ p = car(args);
+ switch (type(p))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ case T_REAL:
+ return(p);
- new_obj = (s_type_t *)calloc(1, sizeof(s_type_t));
- new_obj->type = obj->type;
+ case T_COMPLEX:
+ return(make_real(sc, real_part(p)));
- new_obj->value = s7_call(sc, object_types[new_obj->type].copy_func, sc->s_function_args);
- return(make_s_object(sc, new_obj->type, (void *)new_obj));
-}
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ case T_BIG_REAL:
+ return(p);
+ case T_BIG_COMPLEX:
+ {
+ s7_pointer x;
-static s7_pointer call_s_object_fill(s7_scheme *sc, s7_pointer a, s7_pointer val)
-{
- /* I think this is no longer accessible */
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(a);
- return(s7_call(sc, object_types[obj->type].fill_func, make_list_2(sc, obj->value, val)));
-}
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init(big_real(x));
+ mpc_real(big_real(x), big_complex(p), GMP_RNDN);
+ return(x);
+ }
+#endif
-static char *s_type_print(s7_scheme *sc, void *val)
-{
- /* describe_object assumes the string is allocated here */
- s_type_t *obj = (s_type_t *)val;
- char *str, *full_str;
- int len, tag;
-
- tag = obj->type;
- str = s7_object_to_c_string(sc, obj->value);
- len = safe_strlen(str) + safe_strlen(object_types[tag].name) + 16;
- full_str = (char *)calloc(len, sizeof(char));
- snprintf(full_str, len, "#<%s %s>", object_types[tag].name, str);
- free(str);
- return(full_str);
+ default:
+ method_or_bust_with_type(sc, p, sc->REAL_PART, args, A_NUMBER, 0);
+ }
}
-
-static void s_type_free(void *val)
-{
- free(val);
-}
+#if (!WITH_GMP)
+static s7_double c_real_part(s7_scheme *sc, s7_pointer x) {return(real(g_real_part(sc, set_plist_1(sc, x))));}
+PF_TO_RF(real_part, c_real_part)
+#endif
-static bool s_type_equal(void *val1, void* val2)
+static s7_pointer g_imag_part(s7_scheme *sc, s7_pointer args)
{
- return(val1 == val2);
-}
+ #define H_imag_part "(imag-part num) returns the imaginary part of num"
+ #define Q_imag_part s7_make_signature(sc, 2, sc->IS_REAL, sc->IS_NUMBER)
+ s7_pointer p;
+ /* currently (imag-part nan.0) -> 0.0 ? it's true but maybe confusing */
+ p = car(args);
+ switch (type(p))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ return(small_int(0));
-static void s_type_gc_mark(void *val)
-{
- s_type_t *obj = (s_type_t *)val;
- s7_mark_object(obj->value);
-}
+ case T_REAL:
+ return(real_zero);
+ case T_COMPLEX:
+ return(make_real(sc, imag_part(p)));
-static s7_pointer s_is_type(s7_scheme *sc, s7_pointer args)
-{
- if (is_s_object(cadr(args)))
- {
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(cadr(args));
- return(s7_make_boolean(sc, obj->type == s7_integer(car(args))));
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ return(small_int(0));
+
+ case T_BIG_REAL:
+ return(real_zero);
+
+ case T_BIG_COMPLEX:
+ {
+ s7_pointer x;
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init(big_real(x));
+ mpc_imag(big_real(x), big_complex(p), GMP_RNDN);
+
+ return(x);
+ }
+#endif
+
+ default:
+ method_or_bust_with_type(sc, p, sc->IMAG_PART, args, A_NUMBER, 0);
}
- return(sc->F);
}
+#if (!WITH_GMP)
+static s7_double c_imag_part(s7_scheme *sc, s7_pointer x) {return(real(g_imag_part(sc, set_plist_1(sc, x))));}
+PF_TO_RF(imag_part, c_imag_part)
+#endif
-static s7_pointer s_type_make(s7_scheme *sc, s7_pointer args)
-{
- s_type_t *obj;
- obj = (s_type_t *)calloc(1, sizeof(s_type_t));
- obj->type = s7_integer(car(args));
- obj->value = cadr(args);
- return(make_s_object(sc, obj->type, (void *)obj));
-}
+/* ---------------------------------------- numerator denominator ---------------------------------------- */
-static s7_pointer s_type_ref(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_numerator(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
- int tag;
+ #define H_numerator "(numerator rat) returns the numerator of the rational number rat"
+ #define Q_numerator s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_RATIONAL)
- tag = s7_integer(car(args));
- x = cadr(args);
- if (is_s_object(x))
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
{
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(x);
- if (obj->type == tag)
- return(obj->value);
+ case T_RATIO: return(make_integer(sc, numerator(x)));
+ case T_INTEGER: return(x);
+#if WITH_GMP
+ case T_BIG_INTEGER: return(x);
+ case T_BIG_RATIO: return(mpz_to_big_integer(sc, mpq_numref(big_ratio(x))));
+#endif
+ default: method_or_bust_with_type(sc, x, sc->NUMERATOR, args, A_RATIONAL, 0);
}
-
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_4(sc,
- make_protected_string(sc, "~A type's 'ref' function argument, ~S, is ~A?"),
- make_protected_string(sc, object_types[tag].name),
- x,
- make_protected_string(sc, type_name(x)))));
}
+#if (!WITH_GMP)
+static s7_int c_numerator(s7_scheme *sc, s7_pointer x) {return(s7_numerator(x));}
+PF_TO_IF(numerator, c_numerator)
+#endif
-static s7_pointer g_make_type(s7_scheme *sc, s7_pointer args)
-{
- #define H_make_type "(make-type print equal getter setter length name copy fill) returns a new type object, \
-a list of three functions: ?, make, and ref. The '?' function returns #t if passed an argument of the new type, \
-the 'make' function creates a new object of that type, and the 'ref' function returns the value of that object.\
-The optional arguments to make-type are functions that specify how objects of the new type display themselves (print, 1 argument), \
-check for equality (equal, 2 args, both will be of the new type), apply themselves to arguments, (getter, any number \
-of args, see vector for an example), respond to the generalized set! and length generic functions, and finally, \
-one special case: name sets the type name (a string), which only matters if you're not specifying the print function. \
-In each case, the argument is the value of the object, not the object itself."
-
- int tag;
- tag = s7_new_type("anonymous-type", s_type_print, s_type_free, s_type_equal, s_type_gc_mark, NULL, NULL);
- object_types[tag].equal_func = sc->F; /* see call_s_object_equal */
+static s7_pointer g_denominator(s7_scheme *sc, s7_pointer args)
+{
+ #define H_denominator "(denominator rat) returns the denominator of the rational number rat"
+ #define Q_denominator s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_RATIONAL)
- if (args != sc->NIL)
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
{
- int i, args_loc;
- s7_pointer x;
+ case T_RATIO: return(make_integer(sc, denominator(x)));
+ case T_INTEGER: return(small_int(1));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(small_int(1));
+ case T_BIG_RATIO: return(mpz_to_big_integer(sc, mpq_denref(big_ratio(x))));
+#endif
+ default: method_or_bust_with_type(sc, x, sc->DENOMINATOR, args, A_RATIONAL, 0);
+ }
+}
- args_loc = s7_gc_protect(sc, args);
+#if (!WITH_GMP)
+static s7_int c_denominator(s7_scheme *sc, s7_pointer x) {return(s7_denominator(x));}
+PF_TO_IF(denominator, c_denominator)
+#endif
- /* if any of the special functions are specified, store them in the type object so we can find them later.
- * they also need to be GC-protected:
- * (let ((ctr ((cadr (make-type :getter (lambda (a b) b))))))
- * (gc)
- * ;; any reference here to the getter is likely to fail if it hasn't been protected
- */
- for (i = 0, x = args; x != sc->NIL; i++, x = cdr(x))
- {
- s7_pointer func, proc_args;
- int nargs = 0;
- bool rest_arg = false;
- /* the closure_star mechanism passes the args in declaration order */
- func = car(x);
- if (func != sc->F) /* #f means arg was not set */
- {
- if (i != 5)
- {
- if (!is_procedure(func))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc,
- make_protected_string(sc, "make-type arg, ~A, should be a function"),
- func)));
- s7_gc_protect(sc, func); /* this ought to be faster in the mark phase than checking every function field of every scheme type(?) */
- proc_args = s7_procedure_arity(sc, func);
- nargs = s7_integer(car(proc_args)) + s7_integer(cadr(proc_args));
- rest_arg = (caddr(proc_args) != sc->F);
- }
+/* ---------------------------------------- nan? infinite? ---------------------------------------- */
- switch (i)
- {
- case 0: /* print, ((cadr (make-type :print (lambda (a) (format #f "#<typo: ~S>" a)))) "gypo") -> #<typo: "gypo"> */
- if ((s7_integer(car(proc_args)) > 1) ||
- ((nargs == 0) && (!rest_arg)))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "make-type :print procedure, ~A, should take one argument"), func)));
+static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_nan "(nan? obj) returns #t if obj is a NaN"
+ #define Q_is_nan pl_bn
- object_types[tag].print_func = func;
- object_types[tag].print = call_s_object_print;
- break;
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ return(sc->F);
- case 1: /* equal */
- /* (let ((typo (make-type :equal (lambda (a b) (equal? a b))))) (let ((a ((cadr typo) 123)) (b ((cadr typo) 321))) (equal? a b))) */
- if ((s7_integer(car(proc_args)) > 2) ||
- ((nargs < 2) && (!rest_arg)))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "make-type :equal procedure, ~A, should take two arguments"), func)));
+ case T_REAL:
+ return(make_boolean(sc, is_NaN(real(x))));
- object_types[tag].equal_func = func;
- break;
+ case T_COMPLEX:
+ return(make_boolean(sc, (is_NaN(real_part(x))) || (is_NaN(imag_part(x)))));
- case 2: /* getter: (((cadr (make-type :getter (lambda (a b) (vector-ref a b)))) (vector 1 2 3)) 1) -> 2 */
- if ((nargs == 0) && (!rest_arg))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "make-type :getter procedure, ~A, should take at least one argument"), func)));
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ return(sc->F);
- object_types[tag].getter_func = func;
- object_types[tag].apply = call_s_object_getter;
- break;
+ case T_BIG_REAL:
+ return(make_boolean(sc, is_NaN(s7_real_part(x))));
- case 3: /* setter: (set! (((cadr (make-type :setter (lambda (a b c) (vector-set! a b c)))) (vector 1 2 3)) 1) 23) */
- if ((nargs < 2) && (!rest_arg))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "make-type :setter procedure, ~A, should take at least two arguments"), func)));
+ case T_BIG_COMPLEX:
+ return(make_boolean(sc, (is_NaN(s7_real_part(x))) || (is_NaN(s7_imag_part(x)))));
+#endif
- object_types[tag].setter_func = func;
- object_types[tag].set = call_s_object_setter;
- break;
+ default:
+ method_or_bust_with_type(sc, x, sc->IS_NAN, list_1(sc, x), A_NUMBER, 0);
+ }
+}
- case 4: /* length: (length ((cadr (make-type :length (lambda (a) (vector-length a)))) (vector 1 2 3))) -> 3 */
- if ((s7_integer(car(proc_args)) > 1) ||
- ((nargs == 0) && (!rest_arg)))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "make-type :length procedure, ~A, should take at one argument"), func)));
+#if (!WITH_GMP)
+static s7_pointer c_is_nan(s7_scheme *sc, s7_double x) {return((is_NaN(x)) ? sc->T : sc->F);}
+RF_TO_PF(is_nan, c_is_nan)
+#endif
- object_types[tag].length_func = func;
- object_types[tag].length = call_s_object_length;
- break;
- case 5: /* name, ((cadr (make-type :name "hiho")) 123) -> #<hiho 123> */
- if (!s7_is_string(func))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "make-type :name arg, ~S, should be a string"), func)));
+static s7_pointer g_is_infinite(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_infinite "(infinite? obj) returns #t if obj is an infinite real"
+ #define Q_is_infinite pl_bn
- object_types[tag].name = copy_string(s7_string(func));
- break;
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ return(sc->F);
- case 6: /* copy */
- if ((s7_integer(car(proc_args)) > 1) ||
- ((nargs == 0) && (!rest_arg)))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "make-type :copy procedure, ~A, should take at one argument"), func)));
+ case T_REAL:
+ return(make_boolean(sc, is_inf(real(x))));
- object_types[tag].copy_func = func;
- object_types[tag].copy = call_s_object_copy;
- break;
+ case T_COMPLEX:
+ return(make_boolean(sc, (is_inf(real_part(x))) || (is_inf(imag_part(x)))));
- case 7: /* fill */
- if ((s7_integer(car(proc_args)) > 2) ||
- ((nargs < 2) && (!rest_arg)))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "make-type :fill procedure, ~A, should take at two arguments"), func)));
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ return(sc->F);
- object_types[tag].fill_func = func;
- object_types[tag].fill = call_s_object_fill;
- break;
- }
- }
- }
- s7_gc_unprotect_at(sc, args_loc);
- }
+ case T_BIG_REAL:
+ return(make_boolean(sc, mpfr_inf_p(big_real(x)) != 0));
- {
- s7_pointer result;
- int result_loc;
- result = make_list_3(sc, sc->NIL, sc->NIL, sc->NIL);
- result_loc = s7_gc_protect(sc, result);
+ case T_BIG_COMPLEX:
+ return(make_boolean(sc,
+ (mpfr_inf_p(big_real(g_real_part(sc, list_1(sc, x)))) != 0) ||
+ (mpfr_inf_p(big_real(g_imag_part(sc, list_1(sc, x)))) != 0)));
+#endif
- /* ? method: (lambda (arg) (s_is_type tag arg))
- * returns #t if arg is of the new type
- */
- car(result) = make_closure(sc, make_list_2(sc,
- make_list_1(sc, sc->S_TYPE_ARG),
- make_list_3(sc, sc->S_IS_TYPE, s7_make_integer(sc, tag), sc->S_TYPE_ARG)),
- sc->envir,
- T_CLOSURE);
-
- /* make method: (lambda* (arg) (s_type_make tag arg))
- * returns an object of the new type with its value specified by arg (defaults to #f)
- */
- cadr(result) = make_closure(sc, make_list_2(sc,
- make_list_1(sc, sc->S_TYPE_ARG),
- make_list_3(sc, sc->S_TYPE_MAKE, s7_make_integer(sc, tag), sc->S_TYPE_ARG)),
- sc->envir,
- T_CLOSURE_STAR);
-
- /* ref method: (lambda (arg) (s_type_ref arg))
- * returns the value passed to make above
- */
- caddr(result) = make_closure(sc, make_list_2(sc,
- make_list_1(sc, sc->S_TYPE_ARG),
- make_list_3(sc, sc->S_TYPE_REF, s7_make_integer(sc, tag), sc->S_TYPE_ARG)),
- sc->envir,
- T_CLOSURE);
- s7_gc_unprotect_at(sc, result_loc);
- return(result);
- }
+ default:
+ method_or_bust_with_type(sc, x, sc->IS_INFINITE, list_1(sc, x), A_NUMBER, 0);
+ }
}
-/* here it would be neat if we allowed any keywords, and those not handled explicitly could
- * be added to the methods list under the key-word->symbol name. define* without the need
- * to state in advance what keys -- undeclared key would be bound in the func env under its
- * name and value -- define+? -- the extra args would be in an alist accessible under
- * the rest arg name?
- */
-
-
-
-
-/* -------- procedure-with-setter -------- */
-
-static int pws_tag;
+#if (!WITH_GMP)
+static s7_pointer c_is_infinite(s7_scheme *sc, s7_double x) {return((is_inf(x)) ? sc->T : sc->F);}
+RF_TO_PF(is_infinite, c_is_infinite)
+#endif
-typedef struct {
- s7_pointer (*getter)(s7_scheme *sc, s7_pointer args);
- int get_req_args, get_opt_args;
- s7_pointer (*setter)(s7_scheme *sc, s7_pointer args);
- int set_req_args, set_opt_args;
- s7_pointer scheme_getter;
- s7_pointer scheme_setter;
- char *documentation;
- char *name;
-} s7_pws_t;
+/* ---------------------------------------- number? complex? integer? rational? real? ---------------------------------------- */
-s7_pointer s7_make_procedure_with_setter(s7_scheme *sc,
- const char *name,
- s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
- int get_req_args, int get_opt_args,
- s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
- int set_req_args, int set_opt_args,
- const char *documentation)
+static s7_pointer g_is_number(s7_scheme *sc, s7_pointer args)
{
- s7_pws_t *f;
- s7_pointer obj;
- f = (s7_pws_t *)calloc(1, sizeof(s7_pws_t));
- f->getter = getter;
- f->get_req_args = get_req_args;
- f->get_opt_args = get_opt_args;
- f->setter = setter;
- f->set_req_args = set_req_args;
- f->set_opt_args = set_opt_args;
- if (documentation)
- f->documentation = copy_string(documentation);
- else f->documentation = NULL;
- if (name)
- f->name = copy_string(name);
- else f->name = NULL;
- f->scheme_getter = sc->NIL;
- f->scheme_setter = sc->NIL;
- obj = s7_make_object(sc, pws_tag, (void *)f);
- typeflag(obj) |= T_PROCEDURE;
- return(obj);
+ #define H_is_number "(number? obj) returns #t if obj is a number"
+ #define Q_is_number pl_bt
+ check_boolean_method(sc, s7_is_number, sc->IS_NUMBER, args); /* we need the s7_* versions here for the GMP case */
}
-static char *pws_print(s7_scheme *sc, void *obj)
+static s7_pointer g_is_integer(s7_scheme *sc, s7_pointer args)
{
- s7_pws_t *f = (s7_pws_t *)obj;
- if (f->name)
- return(copy_string(f->name));
- return(copy_string((char *)"#<procedure-with-setter>"));
+ #define H_is_integer "(integer? obj) returns #t if obj is an integer"
+ #define Q_is_integer pl_bt
+ check_boolean_method(sc, s7_is_integer, sc->IS_INTEGER, args);
}
-static void pws_free(void *obj)
+static s7_pointer g_is_real(s7_scheme *sc, s7_pointer args)
{
- s7_pws_t *f = (s7_pws_t *)obj;
- if (f)
- {
- if (f->documentation)
- free(f->documentation);
- if (f->name)
- free(f->name);
- free(f);
- }
+ #define H_is_real "(real? obj) returns #t if obj is a real number"
+ #define Q_is_real pl_bt
+ check_boolean_method(sc, s7_is_real, sc->IS_REAL, args);
}
-static void pws_mark(void *val)
+static s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args)
{
- s7_pws_t *f = (s7_pws_t *)val;
- S7_MARK(f->scheme_getter);
- S7_MARK(f->scheme_setter);
+ #define H_is_complex "(complex? obj) returns #t if obj is a number"
+ #define Q_is_complex pl_bt
+ check_boolean_method(sc, s7_is_number, sc->IS_COMPLEX, args);
}
-static bool pws_equal(void *obj1, void *obj2)
+static s7_pointer g_is_rational(s7_scheme *sc, s7_pointer args)
{
- return(obj1 == obj2);
+ #define H_is_rational "(rational? obj) returns #t if obj is a rational number (either an integer or a ratio)"
+ #define Q_is_rational pl_bt
+ check_boolean_method(sc, s7_is_rational, sc->IS_RATIONAL, args);
+ /* in the non-gmp case, (rational? 455702434782048082459/86885567283849955830) -> #f, not #t
+ * and similarly for exact? etc.
+ */
}
-static s7_pointer pws_apply(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+/* ---------------------------------------- even? odd?---------------------------------------- */
+
+static s7_pointer g_is_even(s7_scheme *sc, s7_pointer args)
{
- /* this is called as the pws object apply method, not as the actual getter */
- s7_pws_t *f;
- f = (s7_pws_t *)s7_object_value(obj);
- if (f->getter != NULL)
+ #define H_is_even "(even? int) returns #t if the integer int is even"
+ #define Q_is_even s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_INTEGER)
+
+ s7_pointer p;
+ p = car(args);
+ switch (type(p))
{
- /* this is the c_function case */
- int len;
+ case T_INTEGER: return(make_boolean(sc, ((integer(p) & 1) == 0)));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, mpz_even_p(big_integer(p))));
+#endif
+ default: method_or_bust(sc, p, sc->IS_EVEN, list_1(sc, p), T_INTEGER, 0);
+ }
+}
+
+#if (!WITH_GMP)
+static s7_pointer c_is_even(s7_scheme *sc, s7_int arg) {return(((arg & 1) == 0) ? sc->T : sc->F);}
+IF_TO_PF(is_even, c_is_even)
+#endif
- len = safe_list_length(sc, args);
- if (len < f->get_req_args)
- return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->NOT_ENOUGH_ARGUMENTS, obj, args)));
- if (len > (f->get_req_args + f->get_opt_args))
- return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->TOO_MANY_ARGUMENTS, obj, args)));
+static s7_pointer g_is_odd(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_odd "(odd? int) returns #t if the integer int is odd"
+ #define Q_is_odd s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_INTEGER)
- return((*(f->getter))(sc, args));
+ s7_pointer p;
+ p = car(args);
+ switch (type(p))
+ {
+ case T_INTEGER: return(make_boolean(sc, ((integer(p) & 1) == 1)));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, mpz_odd_p(big_integer(p))));
+#endif
+ default: method_or_bust(sc, p, sc->IS_ODD, list_1(sc, p), T_INTEGER, 0);
}
-
- sc->args = args;
- sc->code = f->scheme_getter;
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
}
+#if (!WITH_GMP)
+static s7_pointer c_is_odd(s7_scheme *sc, s7_int arg) {return(((arg & 1) == 0) ? sc->F : sc->T);}
+IF_TO_PF(is_odd, c_is_odd)
+#endif
+
-static s7_pointer pws_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+/* ---------------------------------------- zero? ---------------------------------------- */
+static s7_pointer c_is_zero(s7_scheme *sc, s7_pointer x)
{
- /* this is the pws set method, not the actual setter */
- s7_pws_t *f;
- f = (s7_pws_t *)s7_object_value(obj);
- if (f->setter != NULL)
+ switch (type(x))
{
- /* this is the c_function case */
- int len;
+ case T_INTEGER: return(make_boolean(sc, integer(x) == 0));
+ case T_REAL: return(make_boolean(sc, real(x) == 0.0));
+ case T_RATIO:
+ case T_COMPLEX: return(sc->F); /* ratios and complex numbers are already collapsed into integers and reals */
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, mpz_cmp_ui(big_integer(x), 0) == 0));
+ case T_BIG_REAL: return(make_boolean(sc, mpfr_zero_p(big_real(x))));
+ case T_BIG_RATIO:
+ case T_BIG_COMPLEX: return(sc->F);
+#endif
+ default:
+ method_or_bust_with_type(sc, x, sc->IS_ZERO, list_1(sc, x), A_NUMBER, 0);
+ }
+}
- len = safe_list_length(sc, args);
- if (len < f->set_req_args)
- return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->NOT_ENOUGH_ARGUMENTS, obj, args)));
+static s7_pointer g_is_zero(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_zero "(zero? num) returns #t if the number num is zero"
+ #define Q_is_zero pl_bn
- if (len > (f->set_req_args + f->set_opt_args))
- return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->TOO_MANY_ARGUMENTS, obj, args)));
+ return(c_is_zero(sc, car(args)));
+}
- return((*(f->setter))(sc, args));
- }
+static s7_pointer c_is_zero_i(s7_scheme *sc, s7_int x) {return(make_boolean(sc, x == 0));}
+static s7_pointer c_is_zero_r(s7_scheme *sc, s7_double x) {return(make_boolean(sc, x == 0.0));}
+XF_TO_PF(is_zero, c_is_zero_i, c_is_zero_r, c_is_zero)
- sc->args = args;
- sc->code = f->scheme_setter;
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
-}
+/* -------------------------------- positive? -------------------------------- */
+static s7_pointer c_is_positive(s7_scheme *sc, s7_pointer x)
+{
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) > 0));
+ case T_RATIO: return(make_boolean(sc, numerator(x) > 0));
+ case T_REAL: return(make_boolean(sc, real(x) > 0.0));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, (mpz_cmp_ui(big_integer(x), 0) > 0)));
+ case T_BIG_RATIO: return(make_boolean(sc, (mpq_cmp_ui(big_ratio(x), 0, 1) > 0)));
+ case T_BIG_REAL: return(make_boolean(sc, (mpfr_cmp_ui(big_real(x), 0) > 0)));
+#endif
+ default:
+ method_or_bust(sc, x, sc->IS_POSITIVE, list_1(sc, x), T_REAL, 0);
+ }
+}
-static s7_pointer pws_arity(s7_scheme *sc, s7_pointer obj)
+static s7_pointer g_is_positive(s7_scheme *sc, s7_pointer args)
{
- s7_pws_t *f;
- f = (s7_pws_t *)s7_object_value(obj);
+ #define H_is_positive "(positive? num) returns #t if the real number num is positive (greater than 0)"
+ #define Q_is_positive s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_REAL)
- return(s7_cons(sc, s7_make_integer(sc, f->get_req_args),
- s7_cons(sc, s7_make_integer(sc, f->get_opt_args),
- s7_cons(sc, sc->F,
- s7_cons (sc, s7_make_integer(sc, f->set_req_args),
- s7_cons(sc, s7_make_integer(sc, f->set_opt_args),
- s7_cons(sc, sc->F, sc->NIL)))))));
+ return(c_is_positive(sc, car(args)));
}
+static s7_pointer c_is_positive_i(s7_scheme *sc, s7_int x) {return(make_boolean(sc, x > 0));}
+static s7_pointer c_is_positive_r(s7_scheme *sc, s7_double x) {return(make_boolean(sc, x > 0.0));}
+XF_TO_PF(is_positive, c_is_positive_i, c_is_positive_r, c_is_positive)
+
+
+/* -------------------------------- negative? -------------------------------- */
+static s7_pointer c_is_negative(s7_scheme *sc, s7_pointer x)
+{
+ switch (type(x))
+ {
+ case T_INTEGER: return(make_boolean(sc, integer(x) < 0));
+ case T_RATIO: return(make_boolean(sc, numerator(x) < 0));
+ case T_REAL: return(make_boolean(sc, real(x) < 0.0));
+#if WITH_GMP
+ case T_BIG_INTEGER: return(make_boolean(sc, (mpz_cmp_ui(big_integer(x), 0) < 0)));
+ case T_BIG_RATIO: return(make_boolean(sc, (mpq_cmp_ui(big_ratio(x), 0, 1) < 0)));
+ case T_BIG_REAL: return(make_boolean(sc, (mpfr_cmp_ui(big_real(x), 0) < 0)));
+#endif
+ default:
+ method_or_bust(sc, x, sc->IS_NEGATIVE, list_1(sc, x), T_REAL, 0);
+ }
+}
-static s7_pointer g_make_procedure_with_setter(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_negative(s7_scheme *sc, s7_pointer args)
{
- #define H_make_procedure_with_setter "(make-procedure-with-setter getter setter) combines its \
-two function arguments as a procedure-with-setter. The 'getter' is called unless the procedure \
-occurs as the object of set!."
+ #define H_is_negative "(negative? num) returns #t if the real number num is negative (less than 0)"
+ #define Q_is_negative s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_REAL)
- s7_pointer p, getter, setter, arity;
- s7_pws_t *f;
- /* the two args should be functions, the setter taking one more arg than the getter */
+ return(c_is_negative(sc, car(args)));
+}
- getter = car(args);
- if (!is_procedure(getter))
- return(s7_wrong_type_arg_error(sc, "make-procedure-with-setter getter,", 1, getter, "a procedure"));
- setter = cadr(args);
- if (!is_procedure(setter))
- return(s7_wrong_type_arg_error(sc, "make-procedure-with-setter setter,", 2, setter, "a procedure"));
+static s7_pointer c_is_negative_i(s7_scheme *sc, s7_int x) {return(make_boolean(sc, x < 0));}
+static s7_pointer c_is_negative_r(s7_scheme *sc, s7_double x) {return(make_boolean(sc, x < 0.0));}
+XF_TO_PF(is_negative, c_is_negative_i, c_is_negative_r, c_is_negative)
- p = s7_make_procedure_with_setter(sc, NULL, NULL, -1, 0, NULL, -1, 0, NULL);
- f = (s7_pws_t *)s7_object_value(p);
- f->scheme_getter = getter;
- arity = s7_procedure_arity(sc, getter);
- if (is_pair(arity))
- f->get_req_args = s7_integer(car(arity));
- f->documentation = copy_string(s7_procedure_documentation(sc, getter)); /* pws might be GC'd whereupon the doc string is freed */
-
- f->scheme_setter = setter;
- arity = s7_procedure_arity(sc, setter);
- if (is_pair(arity))
- f->set_req_args = s7_integer(car(arity));
-
- return(p);
+bool s7_is_ulong(s7_pointer arg)
+{
+ return(is_integer(arg));
}
-bool s7_is_procedure_with_setter(s7_pointer obj)
+unsigned long s7_ulong(s7_pointer p)
{
- return((is_c_object(obj)) &&
- (c_object_type(obj) == pws_tag));
+ return((_NFre(p))->object.number.ul_value);
}
-s7_pointer s7_procedure_with_setter_getter(s7_pointer obj)
+s7_pointer s7_make_ulong(s7_scheme *sc, unsigned long n)
{
- s7_pws_t *f;
- f = (s7_pws_t *)s7_object_value(obj);
- return(f->scheme_getter);
+ s7_pointer x;
+ new_cell(sc, x, T_INTEGER);
+ x->object.number.ul_value = n;
+ return(x);
}
-s7_pointer s7_procedure_with_setter_setter(s7_pointer obj)
+bool s7_is_ulong_long(s7_pointer arg)
{
- s7_pws_t *f;
- f = (s7_pws_t *)s7_object_value(obj);
- return(f->scheme_setter);
+ return(is_integer(arg));
}
-static s7_pointer g_is_procedure_with_setter(s7_scheme *sc, s7_pointer args)
+unsigned long long s7_ulong_long(s7_pointer p)
{
- #define H_is_procedure_with_setter "(procedure-with-setter? obj) returns #t if obj is a procedure-with-setter"
- return(make_boolean(sc, s7_is_procedure_with_setter(car(args))));
+ return((_NFre(p))->object.number.ull_value);
}
-static char *pws_documentation(s7_pointer x)
+s7_pointer s7_make_ulong_long(s7_scheme *sc, unsigned long long n)
{
- s7_pws_t *f = (s7_pws_t *)s7_object_value(x);
- return(f->documentation);
+ s7_pointer x;
+ new_cell(sc, x, T_INTEGER);
+ x->object.number.ull_value = n;
+ return(x);
}
-static s7_pointer pws_source(s7_scheme *sc, s7_pointer x)
+#if (!WITH_PURE_S7)
+#if (!WITH_GMP)
+/* ---------------------------------------- exact<->inexact exact? inexact? ---------------------------------------- */
+
+static s7_pointer g_exact_to_inexact(s7_scheme *sc, s7_pointer args)
{
- s7_pws_t *f;
- f = (s7_pws_t *)s7_object_value(x);
- if ((is_closure(f->scheme_getter)) ||
- (is_closure_star(f->scheme_getter)))
- return(append_in_place(sc,
- make_list_2(sc,
- (is_closure(f->scheme_getter)) ? sc->LAMBDA : sc->LAMBDA_STAR,
- closure_args(f->scheme_getter)),
- closure_body(f->scheme_getter)));
- return(sc->NIL);
+ #define H_exact_to_inexact "(exact->inexact num) converts num to an inexact number; (exact->inexact 3/2) = 1.5"
+ #define Q_exact_to_inexact pcl_r
+ return(exact_to_inexact(sc, car(args)));
}
-void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc, s7_function set_fnc, int req_args, int opt_args, const char *doc)
+static s7_pointer g_inexact_to_exact(s7_scheme *sc, s7_pointer args)
{
- s7_define_variable(sc, name,
- s7_make_procedure_with_setter(sc, name, get_fnc, req_args, opt_args, set_fnc, req_args + 1, opt_args, doc));
+ #define H_inexact_to_exact "(inexact->exact num) converts num to an exact number; (inexact->exact 1.5) = 3/2"
+ #define Q_inexact_to_exact s7_make_signature(sc, 2, sc->IS_RATIONAL, sc->IS_REAL)
+ return(inexact_to_exact(sc, car(args), WITH_OVERFLOW_ERROR));
}
+#endif
+/* (!WITH_GMP) */
-static bool args_match(s7_scheme *sc, s7_pointer x, int args)
+static s7_pointer g_is_exact(s7_scheme *sc, s7_pointer args)
{
+ #define H_is_exact "(exact? num) returns #t if num is exact (an integer or a ratio)"
+ #define Q_is_exact pl_bn
+
+ s7_pointer x;
+ x = car(args);
switch (type(x))
{
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- case T_C_LST_ARGS_FUNCTION:
- case T_C_FUNCTION:
- return((c_function_required_args(x) <= args) &&
- (c_function_all_args(x) >= args));
+ case T_INTEGER:
+ case T_RATIO: return(sc->T);
+ case T_REAL:
+ case T_COMPLEX: return(sc->F);
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO: return(sc->T);
+ case T_BIG_REAL:
+ case T_BIG_COMPLEX: return(sc->F);
+#endif
+ default:
+ method_or_bust_with_type(sc, x, sc->IS_EXACT, args, A_NUMBER, 0);
+ }
+}
- case T_CLOSURE:
- return((s7_is_symbol(closure_args(x))) ||
- (safe_list_length(sc, closure_args(x)) == args));
- case T_CLOSURE_STAR:
- return((s7_is_symbol(closure_args(x))) ||
- (safe_list_length(sc, closure_args(x)) >= args));
+static s7_pointer g_is_inexact(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_inexact "(inexact? num) returns #t if num is inexact (neither an integer nor a ratio)"
+ #define Q_is_inexact pl_bn
- case T_C_OBJECT:
- if (c_object_type(x) == pws_tag)
- {
- s7_pws_t *f;
- if (s7_procedure_with_setter_getter(x) != sc->NIL) /* a scheme function in this case */
- return(args_match(sc, s7_procedure_with_setter_getter(x), 2));
-
- f = (s7_pws_t *)s7_object_value(x);
- return((f->get_req_args <= args) &&
- ((f->get_req_args + f->get_opt_args) >= args));
- }
-
- /* pws is a special case because the direct value is the getter procedure -- I don't think
- * T_S_OBJECT object value should be included here???
- * (let ((p (make-procedure-with-setter < > ))) (procedure? p)) -> #t
- * (procedure? ((cadr (make-type)) (lambda () 1))) -> #f
- * other T_C_OBJECTs can't mimic pws because only is is recognized specially by procedure?
- */
+ s7_pointer x;
+ x = car(args);
+ switch (type(x))
+ {
+ case T_INTEGER:
+ case T_RATIO: return(sc->F);
+ case T_REAL:
+ case T_COMPLEX: return(sc->T);
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO: return(sc->F);
+ case T_BIG_REAL:
+ case T_BIG_COMPLEX: return(sc->T);
+#endif
+ default:
+ method_or_bust_with_type(sc, x, sc->IS_INEXACT, args, A_NUMBER, 0);
}
- return(false);
}
-static bool is_thunk(s7_scheme *sc, s7_pointer x)
+/* ---------------------------------------- integer-length, integer-decode-float ---------------------------------------- */
+
+static s7_pointer g_integer_length(s7_scheme *sc, s7_pointer args)
{
- switch (type(x))
- {
- case T_C_FUNCTION:
- return(c_function_all_args(x) == 0);
+ #define H_integer_length "(integer-length arg) returns the number of bits required to represent the integer 'arg': (ceiling (log (abs arg) 2))"
+ #define Q_integer_length pcl_i
- case T_CLOSURE:
- case T_CLOSURE_STAR:
- return(caar(x) == sc->NIL);
+ s7_int x;
+ s7_pointer p;
- case T_C_OBJECT:
- if (c_object_type(x) == pws_tag)
- {
- s7_pws_t *f;
- if (s7_procedure_with_setter_getter(x) != sc->NIL) /* a scheme function in this case */
- return(is_thunk(sc, s7_procedure_with_setter_getter(x)));
+ p = car(args);
+ if (!s7_is_integer(p))
+ method_or_bust(sc, p, sc->INTEGER_LENGTH, args, T_INTEGER, 0);
- f = (s7_pws_t *)s7_object_value(x);
- return((f->get_req_args == 0) &&
- (f->get_opt_args == 0));
- }
- }
- return(false);
+
+ x = s7_integer(p);
+ if (x < 0)
+ return(make_integer(sc, integer_length(-(x + 1))));
+ return(make_integer(sc, integer_length(x)));
}
+#if (!WITH_GMP)
+static s7_int c_integer_length(s7_scheme *sc, s7_int arg) {return((arg < 0) ? integer_length(-(arg + 1)) : integer_length(arg));}
+IF_TO_IF(integer_length, c_integer_length)
+#endif
+#endif /* !pure s7 */
+static s7_pointer g_integer_decode_float(s7_scheme *sc, s7_pointer args)
+{
+ #define H_integer_decode_float "(integer-decode-float x) returns a list containing the significand, exponent, and \
+sign of 'x' (1 = positive, -1 = negative). (integer-decode-float 0.0): (0 0 1)"
+ #define Q_integer_decode_float s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_FLOAT)
-/* -------------------------------- symbol-access ------------------------------------------------ */
-/*
- * originally in Snd I wanted notification when a variable was set, and it's not very pretty
- * to have to use pws's everywhere. Here (s7) we have constants and tracing.
- *
- * these are in the same realm:
- * typed var: restrict set! to the desired type or do auto-conversions
- * constant: disallow set!
- * traced var: report either read/write
- * keywords: can't set or bind, always return self as value
- *
- * and related (but much messier to implement):
- * fluid-let: dynamic until exit (call/cc error normal)
- * dynamic variables: insist any ref is to the current binding [dynamic-let]
- *
- * a value wrapper or transparent object won't work:
- * (define-macro (trace sym)
- * `(set! ,sym (wrap ,sym :setter (lambda (binding a) (format #t "~A set to ~A~%" (car binding) a)))))
- *
- * (define-macro (untrace sym)
- * `(set! ,sym ,sym) ??? -- oops...
- *
- * (symbol-access sym) -- a pws, if set! it affects the current binding actions.
- * the actions are local to the current environment, so
- * we automatically undo the local accessors when leaving the current scope.
- * a list of 3 funcs: getter setter binder -- rest is ignored so that
- * trace can save the current accessors in cadddr of the symbol-access list,
- * untrace uses that to restore the old form, etc
- *
- * (define (notify-if-set var notifier) ; returns #t if it's ok to set
- * (set! (symbol-access)
- * (list #f (lambda (symbol new-value) (or (notifier symbol new-value) new-value)) #f)))
- */
+ /* no matter what s7_double is, integer-decode-float acts as if x is a C double */
+ typedef struct decode_float_t {
+ union {
+ long long int ix;
+ double fx;
+ } value;
+ } decode_float_t;
-s7_pointer s7_symbol_access(s7_scheme *sc, s7_pointer sym)
-{
+ decode_float_t num;
s7_pointer x;
- x = find_symbol(sc, sc->envir, sym);
- if (x != sc->NIL)
+ x = car(args);
+
+ switch (type(x))
{
- if (symbol_has_accessor(x))
- return(csr(x));
+ case T_REAL:
+ num.value.fx = (double)real(x);
+ break;
+
+#if WITH_GMP
+ case T_BIG_REAL:
+ num.value.fx = (double)real_to_double(sc, x, "integer-decode-float");
+ break;
+#endif
+
+ default:
+ method_or_bust_with_type(sc, x, sc->INTEGER_DECODE_FLOAT, args, make_string_wrapper(sc, "a non-rational real"), 0);
}
- return(sc->F);
-}
+ if (num.value.fx == 0.0)
+ return(list_3(sc, small_int(0), small_int(0), small_int(1)));
-s7_pointer s7_symbol_set_access(s7_scheme *sc, s7_pointer symbol, s7_pointer funcs)
-{
- s7_pointer x;
- x = find_symbol(sc, sc->envir, symbol);
- if (x == sc->NIL)
- x = add_to_current_environment(sc, symbol, sc->F);
- csr(x) = funcs;
- symbol_set_accessed(symbol);
- if ((is_pair(funcs)) &&
- (s7_list_length(sc, funcs) >= 3) &&
- ((is_procedure(car(funcs))) ||
- (is_procedure(cadr(funcs))) ||
- (is_procedure(caddr(funcs)))))
- symbol_set_has_accessor(x);
- else symbol_clear_has_accessor(x);
- return(x);
+ return(list_3(sc,
+ make_integer(sc, (s7_int)((num.value.ix & 0xfffffffffffffLL) | 0x10000000000000LL)),
+ make_integer(sc, (s7_int)(((num.value.ix & 0x7fffffffffffffffLL) >> 52) - 1023 - 52)),
+ make_integer(sc, ((num.value.ix & 0x8000000000000000LL) != 0) ? -1 : 1)));
}
-static s7_pointer g_symbol_get_access(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- logior -------------------------------- */
+static s7_pointer g_logior(s7_scheme *sc, s7_pointer args)
{
- #define H_symbol_access "(symbol-access sym) is a procedure-with-setter that adds or removes controls on how a \
-symbol accesses its current binding."
+ #define H_logior "(logior int ...) returns the bitwise OR of its integer arguments (the bits that are on in any of the arguments)"
+ #define Q_logior pcl_i
+ s7_int result = 0;
+ s7_pointer x;
- if (!s7_is_symbol(car(args)))
- return(s7_wrong_type_arg_error(sc, "symbol-access,", 0, car(args), "a symbol"));
- return(s7_symbol_access(sc, car(args)));
+ for (x = args; is_not_null(x); x = cdr(x))
+ {
+ if (!s7_is_integer(car(x)))
+ method_or_bust(sc, car(x), sc->LOGIOR, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
+ result |= s7_integer(car(x));
+ }
+ return(make_integer(sc, result));
}
+#if (!WITH_GMP)
+static s7_int c_logior(s7_scheme *sc, s7_int x, s7_int y) {return(x | y);}
+IF2_TO_IF(logior, c_logior)
+#endif
+
-static s7_pointer g_symbol_set_access(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- logxor -------------------------------- */
+static s7_pointer g_logxor(s7_scheme *sc, s7_pointer args)
{
- s7_pointer sym, funcs;
- sym = car(args);
- if (!s7_is_symbol(sym))
- return(s7_wrong_type_arg_error(sc, "set! symbol-access,", 1, sym, "a symbol"));
+ #define H_logxor "(logxor int ...) returns the bitwise XOR of its integer arguments (the bits that are on in an odd number of the arguments)"
+ #define Q_logxor pcl_i
+ s7_int result = 0;
+ s7_pointer x;
- funcs = cadr(args);
- if (funcs != sc->F)
+ for (x = args; is_not_null(x); x = cdr(x))
{
- if ((!is_pair(funcs)) ||
- (s7_list_length(sc, funcs) != 3))
- return(s7_wrong_type_arg_error(sc, "set! symbol-access,", 2, funcs, "a list of 3 settings"));
- if ((is_procedure(car(funcs))) && (!args_match(sc, car(funcs), 2)))
- return(s7_wrong_type_arg_error(sc, "set! symbol-access get function,", 2, car(funcs), "a procedure of 2 arguments"));
- if ((is_procedure(cadr(funcs))) && (!args_match(sc, cadr(funcs), 2)))
- return(s7_wrong_type_arg_error(sc, "set! symbol-access set function,", 2, cadr(funcs), "a procedure of 2 arguments"));
- if ((is_procedure(caddr(funcs))) && (!args_match(sc, caddr(funcs), 2)))
- return(s7_wrong_type_arg_error(sc, "set! symbol-access bind function,", 2, caddr(funcs), "a procedure of 2 arguments"));
+ if (!s7_is_integer(car(x)))
+ method_or_bust(sc, car(x), sc->LOGXOR, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
+ result ^= s7_integer(car(x));
}
- return(s7_symbol_set_access(sc, sym, funcs));
+ return(make_integer(sc, result));
}
+#if (!WITH_GMP)
+static s7_int c_logxor(s7_scheme *sc, s7_int x, s7_int y) {return(x ^ y);}
+IF2_TO_IF(logxor, c_logxor)
+#endif
+
-static s7_pointer call_symbol_bind(s7_scheme *sc, s7_pointer symbol, s7_pointer new_value)
+/* -------------------------------- logand -------------------------------- */
+static s7_pointer g_logand(s7_scheme *sc, s7_pointer args)
{
- /* this happens in contexts that are tricky to implement with a clean use of the evaluator stack (as in
- * the parallel symbol set case -- see OP_SET_ACCESS), so we need to use s7_call. But if an uncaught error
- * occurs in s7_call, the error handler marches up the stack looking for a catch, unwinding the stack
- * past the point of the call. In the worst case, we can segfault because any subsequent pop_stack
- * (i.e. an unchecked goto START), walks off the start of the stack.
- */
-
+ #define H_logand "(logand int ...) returns the bitwise AND of its integer arguments (the bits that are on in every argument)"
+ #define Q_logand pcl_i
+ s7_int result = -1;
s7_pointer x;
- x = find_symbol(sc, sc->envir, symbol);
- if (symbol_has_accessor(x))
+
+ for (x = args; is_not_null(x); x = cdr(x))
{
- s7_pointer func;
- func = caddr(csr(x));
- if (is_procedure(func))
- {
- int save_x, save_y, save_z;
- s7_pointer original_value;
- original_value = new_value;
- SAVE_X_Y_Z(save_x, save_y, save_z);
- new_value = s7_call(sc, func, make_list_2(sc, symbol, new_value));
- RESTORE_X_Y_Z(save_x, save_y, save_z);
- if (new_value == sc->ERROR)
- return(s7_error(sc, sc->ERROR,
- make_list_3(sc, make_protected_string(sc, "can't bind ~S to ~S"), symbol, original_value)));
- }
+ if (!s7_is_integer(car(x)))
+ method_or_bust(sc, car(x), sc->LOGAND, cons(sc, make_integer(sc, result), x), T_INTEGER, position_of(x, args));
+ result &= s7_integer(car(x));
}
- return(new_value);
+ return(make_integer(sc, result));
}
+#if (!WITH_GMP)
+static s7_int c_logand(s7_scheme *sc, s7_int x, s7_int y) {return(x & y);}
+IF2_TO_IF(logand, c_logand)
+#endif
+/* -------------------------------- lognot -------------------------------- */
-/* -------------------------------- hooks -------------------------------- */
-
-
-static bool is_function_with_arity(s7_pointer x)
+static s7_pointer g_lognot(s7_scheme *sc, s7_pointer args)
{
- /* hook function lists are more restrictive than s7_is_procedure which accepts things like continuations */
- int typ;
- typ = type(x);
- return((typ == T_CLOSURE) ||
- (typ == T_CLOSURE_STAR) ||
- (typ >= T_C_FUNCTION) ||
- (s7_is_procedure_with_setter(x)));
+ #define H_lognot "(lognot num) returns the bitwise negation (the complement, the bits that are not on) in num: (lognot 0) -> -1"
+ #define Q_lognot pcl_i
+ if (!s7_is_integer(car(args)))
+ method_or_bust(sc, car(args), sc->LOGNOT, args, T_INTEGER, 0);
+ return(make_integer(sc, ~s7_integer(car(args))));
}
+#if (!WITH_GMP)
+static s7_int c_lognot(s7_scheme *sc, s7_int arg) {return(~arg);}
+IF_TO_IF(lognot, c_lognot)
+#endif
+
+
+/* -------------------------------- logbit? -------------------------------- */
+/* logbit? CL is (logbitp index int) using 2^index, but that order strikes me as backwards
+ * at least gmp got the arg order right!
+ */
-static bool function_arity_ok(s7_scheme *sc, s7_pointer hook, s7_pointer func)
+static s7_pointer g_logbit(s7_scheme *sc, s7_pointer args)
{
- /* when a function is added to a hook, we need to check that its arity is compatible
- * with the hook arity. The function must accept the hook's required number of
- * arguments, and optionally accept any optional hook arguments. If the hook
- * has a rest argument, the function must have one too.
- */
- s7_pointer func_args, hook_args;
- int hook_req = 0, hook_opt = 0, func_req = 0, func_opt = 0;
- bool hook_rst = false, func_rst = false;
+ #define H_logbit "(logbit? int index) returns #t if the index-th bit is on in int, otherwise #f. The argument \
+order here follows gmp, and is the opposite of the CL convention. (logbit? int bit) is the same as (not (zero? (logand int (ash 1 bit))))."
+ #define Q_logbit s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_INTEGER)
+
+ s7_pointer x, y;
+ s7_int index; /* index in gmp is mp_bitcnt which is an unsigned long int */
- func_args = s7_procedure_arity(sc, func);
- func_req = s7_integer(car(func_args));
+ x = car(args);
+ y = cadr(args);
- hook_args = hook_arity(hook);
- hook_req = s7_integer(car(hook_args));
+ if (!s7_is_integer(x))
+ method_or_bust(sc, x, sc->LOGBIT, args, T_INTEGER, 1);
+ if (!s7_is_integer(y))
+ method_or_bust(sc, y, sc->LOGBIT, args, T_INTEGER, 2);
- if (hook_req < func_req) return(false); /* func requires too many args */
+ index = s7_integer(y);
+ if (index < 0)
+ return(out_of_range(sc, sc->LOGBIT, small_int(2), y, ITS_NEGATIVE));
- func_rst = is_true(sc, caddr(func_args));
- hook_rst = is_true(sc, caddr(hook_args));
+#if WITH_GMP
+ if (is_t_big_integer(x))
+ return(make_boolean(sc, (mpz_tstbit(big_integer(x), index) != 0)));
+#endif
- if (func_rst) return(true); /* func required args are ok, and it has a rest arg, so it matches */
- if (hook_rst) return(false); /* func has no rest, hook has rest -- can't be safe */
+ if (index >= s7_int_bits) /* not sure about the >: (logbit? -1 64) ?? */
+ return(make_boolean(sc, integer(x) < 0));
- /* both rest args are false, hook-req >= func-req */
- func_opt = s7_integer(cadr(func_args));
- hook_opt = s7_integer(cadr(hook_args));
+ /* :(zero? (logand most-positive-fixnum (ash 1 63)))
+ * -> ash argument 2, 63, is out of range (shift is too large)
+ * so logbit? has a wider range than the logand/ash shuffle above.
+ */
- /* most args hook handles must be <= most func handles */
- if ((hook_req + hook_opt) <= (func_req + func_opt)) return(true);
- return(false);
+ /* all these long long ints are necessary, else C turns it into an int, gets confused about signs etc */
+ return(make_boolean(sc, ((((long long int)(1LL << (long long int)index)) & (long long int)integer(x)) != 0)));
}
-
-bool s7_is_hook(s7_pointer p)
+/* -------------------------------- ash -------------------------------- */
+static s7_int c_ash(s7_scheme *sc, s7_int arg1, s7_int arg2)
{
- return(is_hook(p));
-}
+ if (arg1 == 0) return(0);
+ if (arg2 >= s7_int_bits)
+ out_of_range(sc, sc->ASH, small_int(2), make_integer(sc, arg2), ITS_TOO_LARGE);
-s7_pointer s7_hook_functions(s7_pointer hook)
-{
- return(hook_functions(hook));
-}
+ if (arg2 < -s7_int_bits)
+ {
+ if (arg1 < 0) /* (ash -31 -100) */
+ return(-1);
+ return(0);
+ }
+ /* I can't see any point in protecting this: (ash 9223372036854775807 1) -> -2, but anyone using ash must know something about bits */
+ if (arg2 >= 0)
+ {
+ if (arg1 < 0)
+ {
+ unsigned long long int z;
+ z = (unsigned long long int)arg1;
+ return((s7_int)(z << arg2));
+ }
+ return(arg1 << arg2);
+ }
+ return(arg1 >> -arg2);
+}
-s7_pointer s7_hook_set_functions(s7_pointer hook, s7_pointer functions)
+static s7_pointer g_ash(s7_scheme *sc, s7_pointer args)
{
- if (is_pair(functions))
- hook_functions(hook) = functions;
- return(hook_functions(hook));
-}
+ #define H_ash "(ash i1 i2) returns i1 shifted right or left i2 times, i1 << i2, (ash 1 3) -> 8, (ash 8 -3) -> 1"
+ #define Q_ash pcl_i
+ s7_pointer x, y;
+ x = car(args);
+ if (!s7_is_integer(x))
+ method_or_bust(sc, x, sc->ASH, args, T_INTEGER, 1);
-s7_pointer s7_hook_arity(s7_pointer hook)
-{
- return(hook_arity(hook));
+ y = cadr(args);
+ if (!s7_is_integer(y))
+ method_or_bust(sc, y, sc->ASH, args, T_INTEGER, 2);
+
+ return(make_integer(sc, c_ash(sc, s7_integer(x), s7_integer(y))));
}
+#if (!WITH_GMP)
+IF2_TO_IF(ash, c_ash)
+#endif
-const char *s7_hook_documentation(s7_pointer hook)
-{
- return(string_value(hook_documentation(hook)));
-}
+/* ---------------------------------------- random ---------------------------------------- */
+
+/* random numbers. The simple version used in clm.c is probably adequate,
+ * but here I'll use Marsaglia's MWC algorithm.
+ * (random num) -> a number (0..num), if num == 0 return 0, use global default state
+ * (random num state) -> same but use this state
+ * (random-state seed) -> make a new state
+ * to save the current seed, use copy
+ * to save it across load, random-state->list and list->random-state.
+ * random-state? returns #t if its arg is one of these guys
+ */
-s7_pointer s7_make_hook(s7_scheme *sc, int required_args, int optional_args, bool rest_arg, const char *documentation)
+#if (!WITH_GMP)
+s7_pointer s7_random_state(s7_scheme *sc, s7_pointer args)
{
- /* arg order follows s7_make_function */
- s7_pointer x;
- NEW_CELL(sc, x);
- hook_arity(x) = make_list_3(sc,
- s7_make_integer(sc, required_args),
- s7_make_integer(sc, optional_args),
- make_boolean(sc, rest_arg));
- hook_functions(x) = sc->NIL;
- hook_documentation(x) = s7_make_string(sc, documentation);
- set_type(x, T_HOOK | T_DONT_COPY); /* not sure about this */
- return(x);
-}
+ #define H_random_state "(random-state seed (carry plausible-default)) returns a new random number state initialized with 'seed'. \
+Pass this as the second argument to 'random' to get a repeatable random number sequence:\n\
+ (let ((seed (random-state 1234))) (random 1.0 seed))"
+ #define Q_random_state s7_make_circular_signature(sc, 1, 2, sc->IS_RANDOM_STATE, sc->IS_INTEGER)
+ s7_pointer r1, r2, p;
+ s7_int i1, i2;
-static s7_pointer hook_copy(s7_scheme *sc, s7_pointer hook)
-{
- s7_pointer new_hook, arity;
- int gc_loc;
+ r1 = car(args);
+ if (!s7_is_integer(r1))
+ method_or_bust(sc, r1, sc->RANDOM_STATE, args, T_INTEGER, 1);
+ i1 = s7_integer(r1);
+ if (i1 < 0)
+ return(out_of_range(sc, sc->RANDOM_STATE, small_int(1), r1, ITS_NEGATIVE));
+
+ if (is_null(cdr(args)))
+ {
+ new_cell(sc, p, T_RANDOM_STATE);
+ random_seed(p) = (unsigned long long int)i1;
+ random_carry(p) = 1675393560; /* should this be dependent on the seed? */
+ return(p);
+ }
- arity = hook_arity(hook);
- new_hook = s7_make_hook(sc, s7_integer(car(arity)), s7_integer(cadr(arity)), s7_boolean(sc, caddr(arity)), s7_string(hook_documentation(hook)));
- if (hook_functions(hook) == sc->NIL)
- return(new_hook);
+ r2 = cadr(args);
+ if (!s7_is_integer(r2))
+ method_or_bust(sc, r2, sc->RANDOM_STATE, args, T_INTEGER, 2);
+ i2 = s7_integer(r2);
+ if (i2 < 0)
+ return(out_of_range(sc, sc->RANDOM_STATE, small_int(2), r2, ITS_NEGATIVE));
- gc_loc = s7_gc_protect(sc, new_hook);
- hook_functions(new_hook) = copy_list(sc, hook_functions(hook));
- s7_gc_unprotect_at(sc, gc_loc);
- return(new_hook);
+ new_cell(sc, p, T_RANDOM_STATE);
+ random_seed(p) = (unsigned long long int)i1;
+ random_carry(p) = (unsigned long long int)i2;
+ return(p);
}
+#define g_random_state s7_random_state
+
+static s7_pointer c_random_state(s7_scheme *sc, s7_pointer x) {return(s7_random_state(sc, set_plist_1(sc, x)));}
+PF_TO_PF(random_state, c_random_state)
+#endif
-s7_pointer s7_hook_apply(s7_scheme *sc, s7_pointer hook, s7_pointer args)
+static s7_pointer rng_copy(s7_scheme *sc, s7_pointer args)
{
- if (is_pair(hook_functions(hook)))
+#if WITH_GMP
+ return(sc->F); /* I can't find a way to copy a gmp random generator */
+#else
+ s7_pointer obj;
+ obj = car(args);
+ if (is_random_state(obj))
{
- int gc_loc;
- s7_pointer x;
- gc_loc = s7_gc_protect(sc, args);
- for (x = hook_functions(hook); x != sc->NIL; x = cdr(x))
- s7_call(sc, car(x), args);
- s7_gc_unprotect_at(sc, gc_loc);
+ s7_pointer new_r;
+ new_cell(sc, new_r, T_RANDOM_STATE);
+ random_seed(new_r) = random_seed(obj);
+ random_carry(new_r) = random_carry(obj);
+ return(new_r);
}
- return(sc->UNSPECIFIED);
+ return(sc->F);
+#endif
}
-static s7_pointer g_is_hook(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_random_state(s7_scheme *sc, s7_pointer args)
{
- #define H_is_hook "(hook? obj) returns #t if obj is a hook"
- return(make_boolean(sc, is_hook(car(args))));
+ #define H_is_random_state "(random-state? obj) returns #t if obj is a random-state object (from random-state)."
+ #define Q_is_random_state pl_bt
+ check_boolean_method(sc, is_random_state, sc->IS_RANDOM_STATE, args);
}
-
-static s7_pointer g_make_hook(s7_scheme *sc, s7_pointer args)
+s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args)
{
- #define H_make_hook "(make-hook (arity (1 0 #f)) (doc \"\")) returns a new hook. 'arity' is a list \
-describing the argument list that the hook-functions will see: (list required optional rest). \
-It defaults to no arguments: '(0 0 #f). Any function added to the hook's list has to be compatible \
-with the hook arity. 'doc' is a documentation string."
-
- s7_pointer x;
- NEW_CELL(sc, x);
-
- if (args != sc->NIL)
- {
- s7_pointer arity;
- arity = car(args);
- if (is_pair(arity))
- {
- s7_Int req, opt;
- if ((s7_list_length(sc, arity) != 3) ||
- (!s7_is_integer(car(arity))) ||
- (!s7_is_integer(cadr(arity))) ||
- (!s7_is_boolean(caddr(arity))))
- return(s7_wrong_type_arg_error(sc, "make-hook", (cdr(args) == sc->NIL) ? 0 : 1, arity, "an arity list: (required optional rest)"));
- req = s7_integer(car(arity));
- opt = s7_integer(cadr(arity));
- if ((req < 0) ||
- (opt < 0))
- return(s7_wrong_type_arg_error(sc, "make-hook", (cdr(args) == sc->NIL) ? 0 : 1, arity, "number of args can't be negative"));
- hook_arity(x) = arity;
- }
- else
- {
- /* backwards compatibility -- this used to be just an integer => required args */
- if (s7_is_integer(arity))
- {
- if (s7_integer(arity) < 0)
- return(s7_wrong_type_arg_error(sc, "make-hook", (cdr(args) == sc->NIL) ? 0 : 1, arity, "a non-negative integer, or an arity list: (required optional rest)"));
- hook_arity(x) = make_list_3(sc, arity, small_int(0), sc->F);
- }
- else return(s7_wrong_type_arg_error(sc, "make-hook", (cdr(args) == sc->NIL) ? 0 : 1, arity, "an arity list: (required optional rest)"));
- }
+ #define H_random_state_to_list "(random-state->list r) returns the random state object as a list.\
+You can later apply random-state to this list to continue a random number sequence from any point."
+ #define Q_random_state_to_list s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_RANDOM_STATE)
- if (cdr(args) != sc->NIL)
- {
- s7_pointer doc;
- doc = cadr(args);
- if (s7_is_string(doc))
- hook_documentation(x) = doc;
- else return(s7_wrong_type_arg_error(sc, "make-hook", 2, doc, "a string"));
- }
- else hook_documentation(x) = s7_make_string(sc, "");
- }
- else
+#if WITH_GMP
+ if ((is_pair(args)) &&
+ (!is_random_state(car(args))))
+ method_or_bust_with_type(sc, car(args), sc->RANDOM_STATE_TO_LIST, args, A_RANDOM_STATE_OBJECT, 1);
+ return(sc->NIL);
+#else
+ s7_pointer r;
+ if (is_null(args))
+ r = sc->default_rng;
+ else
{
- hook_arity(x) = make_list_3(sc, small_int(0), small_int(0), sc->F);
- hook_documentation(x) = s7_make_string(sc, "");
+ r = car(args);
+ if (!is_random_state(r))
+ method_or_bust_with_type(sc, r, sc->RANDOM_STATE_TO_LIST, args, A_RANDOM_STATE_OBJECT, 1);
}
+ return(list_2(sc, make_integer(sc, random_seed(r)), make_integer(sc, random_carry(r))));
+#endif
+}
- hook_functions(x) = sc->NIL;
+#define g_random_state_to_list s7_random_state_to_list
- set_type(x, T_HOOK | T_DONT_COPY);
- return(x);
-}
+s7_pointer c_random_state_to_list(s7_scheme *sc, s7_pointer x) {return(s7_random_state_to_list(sc, set_plist_1(sc, x)));}
+PF_TO_PF(random_state_to_list, c_random_state_to_list)
-static s7_pointer g_hook(s7_scheme *sc, s7_pointer args)
+void s7_set_default_random_state(s7_scheme *sc, s7_int seed, s7_int carry)
{
- #define H_hook "(hook ...) returns a new hook object with its arguments (all functions) \
-as the initial hook-functions list, and taking its arity from those functions. This is a \
-convenient short-hand similar to (vector ...) or (list ...). The hook arity is that of the \
-first function in the list, or '(0 0 #f) if there are no functions. All the other functions \
-must be compatible with the arity of the first."
-
- s7_pointer x, hook;
- int i, gc_loc;
-
- if (args == sc->NIL)
- return(s7_make_hook(sc, 0, 0, false, NULL));
+#if (!WITH_GMP)
+ s7_pointer p;
+ new_cell(sc, p, T_RANDOM_STATE);
+ random_seed(p) = (unsigned long long int)seed;
+ random_carry(p) = (unsigned long long int)carry;
+ sc->default_rng = p;
+#endif
+}
- for (i = 1, x = args; is_pair(x); x = cdr(x), i++)
- if (!is_function_with_arity(car(x)))
- return(s7_wrong_type_arg_error(sc, "hook", i, car(x), "a function"));
+#if (!WITH_GMP)
+/* -------------------------------- random -------------------------------- */
+
+static double next_random(s7_pointer r)
+{
+ /* The multiply-with-carry generator for 32-bit integers:
+ * x(n)=a*x(n-1) + carry mod 2^32
+ * Choose multiplier a from this list:
+ * 1791398085 1929682203 1683268614 1965537969 1675393560
+ * 1967773755 1517746329 1447497129 1655692410 1606218150
+ * 2051013963 1075433238 1557985959 1781943330 1893513180
+ * 1631296680 2131995753 2083801278 1873196400 1554115554
+ * ( or any 'a' for which both a*2^32-1 and a*2^31-1 are prime)
+ */
+ double result;
+ unsigned long long int temp;
+ #define RAN_MULT 2131995753UL
- hook = g_make_hook(sc, s7_cons(sc, s7_procedure_arity(sc, car(args)), sc->NIL));
- hook_functions(hook) = args;
- gc_loc = s7_gc_protect(sc, hook);
-
- for (i = 2, x = cdr(args); is_pair(x); x = cdr(x), i++)
- if (!function_arity_ok(sc, hook, car(x)))
- return(s7_wrong_type_arg_error(sc, "hook", i, car(x), "compatible function"));
+ temp = random_seed(r) * RAN_MULT + random_carry(r);
+ random_seed(r) = (temp & 0xffffffffUL);
+ random_carry(r) = (temp >> 32);
+ result = (double)((unsigned int)(random_seed(r))) / 4294967295.5;
+ /* divisor was 2^32-1 = 4294967295.0, but somehow this can round up once in a billion tries?
+ * do we want the double just less than 2^32?
+ */
- s7_gc_unprotect_at(sc, gc_loc);
- return(hook);
+ /* (let ((mx 0) (mn 1000)) (do ((i 0 (+ i 1))) ((= i 10000)) (let ((val (random 123))) (set! mx (max mx val)) (set! mn (min mn val)))) (list mn mx)) */
+ return(result);
}
-static s7_pointer g_hook_functions(s7_scheme *sc, s7_pointer args)
+s7_double s7_random(s7_scheme *sc, s7_pointer state)
{
- #define H_hook_functions "(hook-functions hook) returns the list of functions on the hook. \
-It is settable; (set! (hook-functions hook) (cons func (hook-functions hook))) adds func \
-to the current list."
-
- if (!is_hook(car(args)))
- return(s7_wrong_type_arg_error(sc, "hook-functions", 0, car(args), "a hook"));
-
- return(hook_functions(car(args)));
+ if (!state)
+ return(next_random(sc->default_rng));
+ return(next_random(state));
}
-static s7_pointer g_hook_set_functions(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_random(s7_scheme *sc, s7_pointer args)
{
- s7_pointer hook, funcs;
- hook = car(args);
-
- if (!is_hook(hook))
- return(s7_wrong_type_arg_error(sc, "hook-functions", 1, hook, "a hook"));
+ #define H_random "(random num (state #f)) returns a random number between 0 and num (0 if num=0)."
+ #define Q_random s7_make_signature(sc, 3, sc->IS_NUMBER, sc->IS_NUMBER, sc->IS_RANDOM_STATE)
+ s7_pointer r, num;
- funcs = cadr(args);
- if ((!is_pair(funcs)) &&
- (funcs != sc->NIL))
- return(s7_wrong_type_arg_error(sc, "hook-functions", 2, funcs, "a list of functions or '()"));
+ num = car(args);
+ if (!s7_is_number(num))
+ method_or_bust_with_type(sc, num, sc->RANDOM, args, A_NUMBER, 1);
- if (is_pair(funcs))
+ if (is_not_null(cdr(args)))
{
- s7_pointer x, y;
- for (x = funcs, y = funcs; is_pair(x); x = cdr(x), y = cdr(y))
- {
- if (!is_function_with_arity(car(x)))
- return(s7_wrong_type_arg_error(sc, "hook-functions", 2, funcs, "a list of functions"));
- if (!function_arity_ok(sc, hook, car(x)))
- return(s7_wrong_type_arg_error(sc, "hook-functions", 2, funcs, "a list of functions of the correct arity"));
- if (is_pair(y))
- {
- y = cdr(y);
- if (x == y)
- return(s7_wrong_type_arg_error(sc, "hook-functions", 2, funcs, "a proper (non-circular) list of functions"));
- }
- }
- if (x != sc->NIL)
- return(s7_wrong_type_arg_error(sc, "hook-functions", 2, funcs, "a proper list of functions"));
+ r = cadr(args);
+ if (!is_random_state(r))
+ method_or_bust_with_type(sc, r, sc->RANDOM, args, A_RANDOM_STATE_OBJECT, 2);
}
+ else r = sc->default_rng;
- hook_functions(hook) = funcs;
- return(funcs);
-}
-
+ switch (type(num))
+ {
+ case T_INTEGER:
+ return(make_integer(sc, (s7_int)(integer(num) * next_random(r))));
-static s7_pointer g_hook_arity(s7_scheme *sc, s7_pointer args)
-{
- #define H_hook_arity "(hook-arity hook) returns the hook's arity, a list giving the number \
-of required arguments, optional arguments, and whether there is a rest argument. Each function \
-on the hook's function list has to be compatible with this description."
+ case T_RATIO:
+ {
+ s7_double x, error;
+ s7_int numer = 0, denom = 1;
+ /* the error here needs to take the size of the fraction into account. Otherwise, if
+ * error is (say) 1e-6 and the fraction is (say) 9000000/9223372036854775807,
+ * c_rationalize will always return 0. But even that isn't foolproof:
+ * (random 1/562949953421312) -> 1/376367230475000
+ */
+ x = fraction(num);
+ if ((x < 1.0e-10) && (x > -1.0e-10))
+ {
+ /* 1e-12 is not tight enough:
+ * (random 1/2251799813685248) -> 1/2250240579436280
+ * (random -1/4503599627370496) -> -1/4492889778435526
+ * (random 1/140737488355328) -> 1/140730223985746
+ * (random -1/35184372088832) -> -1/35183145492420
+ * (random -1/70368744177664) -> -1/70366866392738
+ * (random 1/4398046511104) -> 1/4398033095756
+ * (random 1/137438953472) -> 1/137438941127
+ */
+ if (numerator(num) < -10)
+ numer = -(s7_int)(floor(-numerator(num) * next_random(r)));
+ else
+ {
+ if (numerator(num) > 10)
+ numer = (s7_int)floor(numerator(num) * next_random(r));
+ else
+ {
+ long long int diff;
+ numer = numerator(num);
+ diff = s7_int_max - denominator(num);
+ if (diff < 100)
+ return(s7_make_ratio(sc, numer, denominator(num)));
+ denom = denominator(num) + (s7_int)floor(diff * next_random(r));
+ return(s7_make_ratio(sc, numer, denom));
+ }
+ }
+ return(s7_make_ratio(sc, numer, denominator(num)));
+ }
+ if ((x < 1e-6) && (x > -1e-6))
+ error = 1e-18;
+ else error = 1e-12;
+ c_rationalize(x * next_random(r), error, &numer, &denom);
+ return(s7_make_ratio(sc, numer, denom));
+ }
- if (!is_hook(car(args)))
- return(s7_wrong_type_arg_error(sc, "hook-arity", 0, car(args), "a hook"));
+ case T_REAL:
+ return(make_real(sc, real(num) * next_random(r)));
- return(hook_arity(car(args)));
+ case T_COMPLEX:
+ return(s7_make_complex(sc, real_part(num) * next_random(r), imag_part(num) * next_random(r)));
+ }
+ return(sc->F);
}
+static s7_int c_random_i(s7_scheme *sc, s7_int arg) {return((s7_int)(arg * next_random(sc->default_rng)));} /* not round! */
+IF_TO_IF(random, c_random_i)
+static s7_double c_random_r(s7_scheme *sc, s7_double arg) {return(arg * next_random(sc->default_rng));}
+RF_TO_RF(random, c_random_r)
-static s7_pointer g_hook_documentation(s7_scheme *sc, s7_pointer args)
-{
- #define H_hook_documentation "(hook-documentation hook) returns the documentation associated \
-with the hook."
-
- if (!is_hook(car(args)))
- return(s7_wrong_type_arg_error(sc, "hook-documentation", 0, car(args), "a hook"));
+static s7_pointer random_ic, random_rc, random_i;
- return(hook_documentation(car(args)));
+static s7_pointer g_random_ic(s7_scheme *sc, s7_pointer args)
+{
+ return(make_integer(sc, (s7_int)(integer(car(args)) * next_random(sc->default_rng))));
}
-
-static s7_pointer g_hook_apply(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_random_i(s7_scheme *sc, s7_pointer args)
{
- #define H_hook_apply "(hook-apply hook ...) applies each function in the hook's function \
-list to the trailing arguments of hook-apply."
-
- s7_pointer hook, hook_args;
+ return(make_integer(sc, (s7_int)(integer(slot_value(global_slot(car(args)))) * next_random(sc->default_rng))));
+}
- hook = car(args);
- if (!is_hook(hook))
- return(s7_wrong_type_arg_error(sc, "hook-apply", 1, hook, "a hook"));
+static s7_pointer g_random_rc(s7_scheme *sc, s7_pointer args)
+{
+ return(make_real(sc, real(car(args)) * next_random(sc->default_rng)));
+}
- if (cdr(args) == sc->NIL)
- hook_args = sc->NIL;
- else
+static s7_pointer random_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 1)
{
- hook_args = apply_list_star(sc, cdr(args));
-
- if (!is_proper_list(sc, hook_args)) /* (hook-apply + #f) etc */
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc,
- make_protected_string(sc, "hook-apply's last argument should be a proper list: ~A"),
- hook_args)));
+ s7_pointer arg1;
+ arg1 = cadr(expr);
+ if (s7_is_integer(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(random_ic);
+ }
+ if ((is_real(arg1)) &&
+ (!is_rational(arg1)))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(random_rc);
+ }
+ if ((is_symbol(arg1)) &&
+ (is_immutable_symbol(arg1)) &&
+ (is_global(arg1)) &&
+ (is_integer(slot_value(global_slot(arg1)))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(random_i);
+ }
}
+ return(f);
+}
+#endif /* gmp */
- if (caddr(hook_arity(hook)) == sc->F)
- {
- int arg_num;
- arg_num = safe_list_length(sc, hook_args);
- if ((arg_num < s7_integer(car(hook_arity(hook)))) ||
- (arg_num > (s7_integer(car(hook_arity(hook))) + s7_integer(cadr(hook_arity(hook))))))
- return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc,
- make_protected_string(sc, "hook passed wrong number of args: ~A (arity: ~A)"),
- hook_args,
- hook_arity(hook))));
- }
- if (is_pair(hook_functions(hook)))
- {
- sc->args = hook_args;
- sc->code = hook_functions(hook);
- push_stack(sc, opcode(OP_HOOK_APPLY), sc->args, sc->code);
- }
- return(sc->UNSPECIFIED);
+/* -------------------------------- characters -------------------------------- */
+
+#define NUM_CHARS 256
+
+static s7_pointer g_char_to_integer(s7_scheme *sc, s7_pointer args)
+{
+ #define H_char_to_integer "(char->integer c) converts the character c to an integer"
+ #define Q_char_to_integer s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_CHAR)
+
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->CHAR_TO_INTEGER, args, T_CHARACTER, 0);
+ return(small_int(character(car(args))));
}
+#define int_method_or_bust(Sc, Obj, Method, Args, Type, Num) \
+ { \
+ s7_pointer func; \
+ if ((has_methods(Obj)) && ((func = find_method(Sc, find_let(Sc, Obj), Method)) != Sc->UNDEFINED)) \
+ return(integer(s7_apply_function(Sc, func, Args))); \
+ if (Num == 0) simple_wrong_type_argument(Sc, Method, Obj, Type); \
+ wrong_type_argument(Sc, Method, Num, Obj, Type); \
+ }
-static bool hooks_are_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_int c_char_to_integer(s7_scheme *sc, s7_pointer p)
{
- return(s7_is_equal(sc, hook_arity(x), hook_arity(y)) &&
- s7_is_equal(sc, hook_functions(x), hook_functions(y)));
+ if (!s7_is_character(p))
+ int_method_or_bust(sc, p, sc->CHAR_TO_INTEGER, set_plist_1(sc, p), T_CHARACTER, 0);
+ return(character(p));
}
+PF_TO_IF(char_to_integer, c_char_to_integer)
-static bool internal_hook_arity_ok(s7_scheme *sc, s7_pointer hook, s7_pointer funcs)
+
+static s7_pointer c_int_to_char(s7_scheme *sc, s7_int ind)
{
- s7_pointer x;
- for (x = funcs; is_pair(x); x = cdr(x))
- if ((!is_function_with_arity(car(x))) ||
- (!function_arity_ok(sc, hook, car(x))))
- return(false);
- return(x == sc->NIL);
+ if ((ind < 0) || (ind >= NUM_CHARS))
+ return(simple_wrong_type_argument_with_type(sc, sc->INTEGER_TO_CHAR, make_integer(sc, ind),
+ make_string_wrapper(sc, "an integer that can represent a character")));
+ return(s7_make_character(sc, (unsigned char)ind));
}
+static s7_pointer c_integer_to_char(s7_scheme *sc, s7_pointer x)
+{
+ s7_int ind;
+ if (!s7_is_integer(x))
+ method_or_bust(sc, x, sc->INTEGER_TO_CHAR, list_1(sc, x), T_INTEGER, 0);
+ ind = s7_integer(x);
+ if ((ind < 0) || (ind >= NUM_CHARS))
+ return(simple_wrong_type_argument_with_type(sc, sc->INTEGER_TO_CHAR, x, make_string_wrapper(sc, "an integer that can represent a character")));
+ return(s7_make_character(sc, (unsigned char)ind));
+}
-static s7_pointer g_trace_hook_set(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_integer_to_char(s7_scheme *sc, s7_pointer args)
{
- /* in normal use, we'd (set! (hook-functions *trace-hook*) ...), but for backwards compatibility,
- * we also need to support (set! *trace-hook* func).
- */
- s7_pointer funcs;
- funcs = cadr(args);
- if ((funcs == sc->NIL) ||
- (is_pair(funcs)))
- {
- if (internal_hook_arity_ok(sc, sc->trace_hook, funcs))
- hook_functions(sc->trace_hook) = funcs;
- else return(sc->ERROR);;
- }
- else
- {
- if (s7_is_procedure(funcs))
- hook_functions(sc->trace_hook) = s7_cons(sc, funcs, sc->NIL);
- else return(sc->ERROR);
- }
- return(sc->trace_hook); /* kinda pointless... */
+ #define H_integer_to_char "(integer->char i) converts the non-negative integer i to a character"
+ #define Q_integer_to_char s7_make_signature(sc, 2, sc->IS_CHAR, sc->IS_INTEGER)
+ return(c_integer_to_char(sc, car(args)));
}
+IF_TO_PF(integer_to_char, c_int_to_char)
+
-static s7_pointer g_load_hook_set(s7_scheme *sc, s7_pointer args)
+static unsigned char uppers[256], lowers[256];
+static void init_uppers(void)
{
- /* in normal use, we'd (set! (hook-functions *load-hook*) ...), but for backwards compatibility,
- * we also need to support (set! *load-hook* func).
- */
- s7_pointer funcs;
- funcs = cadr(args);
- if ((funcs == sc->NIL) ||
- (is_pair(funcs)))
- {
- if (internal_hook_arity_ok(sc, sc->load_hook, funcs))
- hook_functions(sc->load_hook) = funcs;
- else return(sc->ERROR);
- }
- else
+ int i;
+ for (i = 0; i < 256; i++)
{
- if (s7_is_procedure(funcs))
- hook_functions(sc->load_hook) = s7_cons(sc, funcs, sc->NIL);
- else return(sc->ERROR);
+ uppers[i] = (unsigned char)toupper(i);
+ lowers[i] = (unsigned char)tolower(i);
}
- return(sc->load_hook);
}
+static s7_pointer c_char_upcase(s7_scheme *sc, s7_pointer arg)
+{
+ if (!s7_is_character(arg))
+ method_or_bust(sc, arg, sc->CHAR_UPCASE, set_plist_1(sc, arg), T_CHARACTER, 0);
+ return(s7_make_character(sc, upper_character(arg)));
+}
-static s7_pointer g_unbound_variable_hook_set(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_char_upcase(s7_scheme *sc, s7_pointer args)
{
- /* in normal use, we'd (set! (hook-functions *unbound-variable-hook*) ...), but for backwards compatibility,
- * we also need to support (set! *unbound-variable-hook* func).
- */
- s7_pointer funcs;
- funcs = cadr(args);
- if ((funcs == sc->NIL) ||
- (is_pair(funcs)))
- {
- if (internal_hook_arity_ok(sc, sc->unbound_variable_hook, funcs))
- hook_functions(sc->unbound_variable_hook) = funcs;
- else return(sc->ERROR);
- }
- else
- {
- if (s7_is_procedure(funcs))
- hook_functions(sc->unbound_variable_hook) = s7_cons(sc, funcs, sc->NIL);
- else return(sc->ERROR);
- }
- return(sc->unbound_variable_hook);
+ #define H_char_upcase "(char-upcase c) converts the character c to upper case"
+ #define Q_char_upcase pcl_c
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->CHAR_UPCASE, args, T_CHARACTER, 0);
+ return(s7_make_character(sc, upper_character(car(args))));
}
+PF_TO_PF(char_upcase, c_char_upcase)
-static s7_pointer g_error_hook_set(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer c_char_downcase(s7_scheme *sc, s7_pointer arg)
{
- /* in normal use, we'd (set! (hook-functions *error-hook*) ...), but for backwards compatibility,
- * we also need to support (set! *error-hook* func).
- */
- s7_pointer funcs;
+ if (!s7_is_character(arg))
+ method_or_bust(sc, arg, sc->CHAR_DOWNCASE, set_plist_1(sc, arg), T_CHARACTER, 0);
+ return(s7_make_character(sc, lowers[(int)character(arg)]));
+}
- funcs = cadr(args);
- if ((funcs == sc->NIL) ||
- (is_pair(funcs)))
- {
- if (internal_hook_arity_ok(sc, sc->error_hook, funcs))
- hook_functions(sc->error_hook) = funcs;
- else return(sc->ERROR);
- }
- else
- {
- if (s7_is_procedure(funcs))
- hook_functions(sc->error_hook) = s7_cons(sc, funcs, sc->NIL);
- else return(sc->ERROR);
- }
- return(sc->error_hook);
+static s7_pointer g_char_downcase(s7_scheme *sc, s7_pointer args)
+{
+ #define H_char_downcase "(char-downcase c) converts the character c to lower case"
+ #define Q_char_downcase pcl_c
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->CHAR_DOWNCASE, args, T_CHARACTER, 0);
+ return(s7_make_character(sc, lowers[character(car(args))]));
}
+PF_TO_PF(char_downcase, c_char_downcase)
+
+
+static s7_pointer c_is_char_alphabetic(s7_scheme *sc, s7_pointer arg)
+{
+ if (!s7_is_character(arg))
+ method_or_bust(sc, arg, sc->IS_CHAR_ALPHABETIC, set_plist_1(sc, arg), T_CHARACTER, 0);
+ return(make_boolean(sc, is_char_alphabetic(arg)));
+}
+static s7_pointer g_is_char_alphabetic(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_char_alphabetic "(char-alphabetic? c) returns #t if the character c is alphabetic"
+ #define Q_is_char_alphabetic pl_bc
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->IS_CHAR_ALPHABETIC, args, T_CHARACTER, 0);
+ return(make_boolean(sc, is_char_alphabetic(car(args))));
+ /* isalpha returns #t for (integer->char 226) and others in that range */
+}
+PF_TO_PF(is_char_alphabetic, c_is_char_alphabetic)
-/* -------------------------------- eq etc -------------------------------- */
+static s7_pointer c_is_char_numeric(s7_scheme *sc, s7_pointer arg)
+{
+ if (!s7_is_character(arg))
+ method_or_bust(sc, arg, sc->IS_CHAR_NUMERIC, set_plist_1(sc, arg), T_CHARACTER, 0);
+ return(make_boolean(sc, is_char_numeric(arg)));
+}
-bool s7_is_eq(s7_pointer obj1, s7_pointer obj2)
+static s7_pointer g_is_char_numeric(s7_scheme *sc, s7_pointer args)
{
- return(obj1 == obj2);
+ #define H_is_char_numeric "(char-numeric? c) returns #t if the character c is a digit"
+ #define Q_is_char_numeric pl_bc
+ return(c_is_char_numeric(sc, car(args)));
}
+PF_TO_PF(is_char_numeric, c_is_char_numeric)
-bool s7_is_eqv(s7_pointer a, s7_pointer b)
+
+static s7_pointer c_is_char_whitespace(s7_scheme *sc, s7_pointer arg)
{
- if (a == b)
- return(true);
-
-#if WITH_GMP
- if (big_numbers_are_eqv(a, b)) return(true); /* T_NUMBER != T_C_OBJECT but both can represent numbers */
-#endif
+ if (!s7_is_character(arg))
+ method_or_bust(sc, arg, sc->IS_CHAR_WHITESPACE, set_plist_1(sc, arg), T_CHARACTER, 0);
+ return(make_boolean(sc, is_char_whitespace(arg)));
+}
- if (type(a) != type(b))
- return(false);
-
- if (s7_is_string(a))
- return(string_value(a) == string_value(b));
-
- if (s7_is_number(a))
- return(numbers_are_eqv(a, b));
-
- if (s7_is_character(a))
- return(s7_character(a) == s7_character(b));
-
- return(false);
+static s7_pointer g_is_char_whitespace(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_char_whitespace "(char-whitespace? c) returns #t if the character c is non-printing character"
+ #define Q_is_char_whitespace pl_bc
+ return(c_is_char_whitespace(sc, car(args)));
}
+PF_TO_PF(is_char_whitespace, c_is_char_whitespace)
-/* -------- structure equality --------
- *
- * equal? examines the entire structure (possibly a tree etc), which might contain
- * cycles (vector element is the vector etc), so list/vector/hash-table equality
- * needs to carry along a list of pointers seen so far.
- */
-static bool structures_are_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci);
+static s7_pointer c_is_char_upper_case(s7_scheme *sc, s7_pointer arg)
+{
+ if (!s7_is_character(arg))
+ method_or_bust(sc, arg, sc->IS_CHAR_UPPER_CASE, set_plist_1(sc, arg), T_CHARACTER, 0);
+ return(make_boolean(sc, is_char_uppercase(arg)));
+}
-static bool s7_is_equal_tracking_circles(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+static s7_pointer g_is_char_upper_case(s7_scheme *sc, s7_pointer args)
{
- if (x == y)
- return(true);
-
-#if WITH_GMP
- if (big_numbers_are_eqv(x, y)) return(true); /* T_NUMBER != T_C_OBJECT but both can represent numbers */
-#endif
+ #define H_is_char_upper_case "(char-upper-case? c) returns #t if the character c is in upper case"
+ #define Q_is_char_upper_case pl_bc
+ return(c_is_char_upper_case(sc, car(args)));
+}
- if (type(x) != type(y))
- return(false);
-
- switch (type(x))
- {
- case T_STRING:
- return(scheme_strings_are_equal(x, y));
+PF_TO_PF(is_char_upper_case, c_is_char_upper_case)
- case T_S_OBJECT:
- return(call_s_object_equal(sc, x, y));
- case T_C_OBJECT:
- return(objects_are_equal(x, y));
+static s7_pointer c_is_char_lower_case(s7_scheme *sc, s7_pointer arg)
+{
+ if (!s7_is_character(arg))
+ method_or_bust(sc, arg, sc->IS_CHAR_LOWER_CASE, set_plist_1(sc, arg), T_CHARACTER, 0);
+ return(make_boolean(sc, is_char_lowercase(arg)));
+}
- case T_CHARACTER:
- return(s7_character(x) == s7_character(y));
-
- case T_NUMBER:
- return(numbers_are_eqv(x, y));
+static s7_pointer g_is_char_lower_case(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_char_lower_case "(char-lower-case? c) returns #t if the character c is in lower case"
+ #define Q_is_char_lower_case pl_bc
+ return(c_is_char_lower_case(sc, car(args)));
+}
- case T_VECTOR:
- case T_HASH_TABLE:
- case T_PAIR:
- return(structures_are_equal(sc, x, y, ci));
+PF_TO_PF(is_char_lower_case, c_is_char_lower_case)
- case T_HOOK:
- return(hooks_are_equal(sc, x, y));
- case T_C_POINTER: /* might have a list of these for example */
- return(raw_pointer(x) == raw_pointer(y));
- }
- return(false); /* we already checked that x != y (port etc) */
+static s7_pointer g_is_char(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_char "(char? obj) returns #t if obj is a character"
+ #define Q_is_char pl_bt
+ check_boolean_method(sc, s7_is_character, sc->IS_CHAR, args);
}
-static bool structures_are_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+s7_pointer s7_make_character(s7_scheme *sc, unsigned int c)
{
- /* here we know x and y are pointers to the same type of structure */
- int ref_x, ref_y;
+ return(chars[c]);
+}
- ref_x = peek_shared_ref(ci, x);
- ref_y = peek_shared_ref(ci, y);
- if ((ref_x != 0) && (ref_y != 0))
- return(ref_x == ref_y);
-
- if ((ref_x != 0) || (ref_y != 0))
- {
- /* try to harmonize the new guy -- there can be more than one structure equal to the current one */
- if (ref_x != 0)
- add_shared_ref(ci, y, ref_x);
- else add_shared_ref(ci, x, ref_y);
- }
- else add_equal_ref(ci, x, y);
-
- /* now compare the elements of the structures. */
- if (is_pair(x))
- return((s7_is_equal_tracking_circles(sc, car(x), car(y), ci)) &&
- (s7_is_equal_tracking_circles(sc, cdr(x), cdr(y), ci)));
+bool s7_is_character(s7_pointer p)
+{
+ return(type(p) == T_CHARACTER);
+}
- /* vector or hash table */
- {
- s7_Int i, len;
- len = vector_length(x);
- if (len != vector_length(y)) return(false);
- if (s7_is_vector(x))
- {
- /* there's one special case: shared vectors can have 1 dimension but include the dimension info */
- int x_dims = 1, y_dims = 1, j;
+char s7_character(s7_pointer p)
+{
+ return(character(p));
+}
- if (vector_is_multidimensional(x))
- x_dims = vector_ndims(x);
- if (vector_is_multidimensional(y))
- y_dims = vector_ndims(y);
- if (x_dims != y_dims)
- return(false);
+static int charcmp(unsigned char c1, unsigned char c2)
+{
+ return((c1 == c2) ? 0 : (c1 < c2) ? -1 : 1);
+ /* not tolower here -- the single case is apparently supposed to be upper case
+ * this matters in a case like (char-ci<? #\_ #\e) which Guile and Gauche say is #f
+ * although (char<? #\_ #\e) is #t -- the spec does not say how to interpret this!
+ */
+}
- if (x_dims > 1)
- for (j = 0; j < x_dims; j++)
- if (vector_dimension(x, j) != vector_dimension(y, j))
- return(false);
- }
- for (i = 0; i < len; i++)
- if (!(s7_is_equal_tracking_circles(sc, vector_element(x, i), vector_element(y, i), ci)))
- return(false);
- }
- return(true);
+static bool is_character_via_method(s7_scheme *sc, s7_pointer p)
+{
+ if (s7_is_character(p))
+ return(true);
+ if (has_methods(p))
+ {
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->IS_CHAR);
+ if (f != sc->UNDEFINED)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL))));
+ }
+ return(false);
}
-bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static s7_pointer g_char_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
{
- if (x == y)
- return(true);
-
-#if WITH_GMP
- if (big_numbers_are_eqv(x, y)) return(true); /* T_NUMBER != T_C_OBJECT but both can represent numbers */
-#endif
+ s7_pointer x, y;
- if (type(x) != type(y))
- return(false);
-
- switch (type(x))
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
+
+ for (x = cdr(args); is_pair(x); x = cdr(x))
{
- /* one problematic case: #<unspecified> is currently not equal to (values) but they print the same.
- * case T_UNTYPED: return((s7_is_unspecified(sc, x)) && (s7_is_unspecified(sc, y)))
- */
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
- case T_STRING:
- return(scheme_strings_are_equal(x, y));
+ if (charcmp(character(y), character(car(x))) != val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
+ }
+ y = car(x);
+ }
+ return(sc->T);
+}
- case T_S_OBJECT:
- return(call_s_object_equal(sc, x, y));
- case T_C_OBJECT:
- return(objects_are_equal(x, y));
+static s7_pointer g_char_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+{
+ s7_pointer x, y;
- case T_CHARACTER:
- return(s7_character(x) == s7_character(y));
-
- case T_NUMBER:
- return(numbers_are_eqv(x, y));
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
- case T_VECTOR:
- case T_HASH_TABLE:
- if (vector_length(x) != vector_length(y))
- return(false);
- /* fall through */
+ for (x = cdr(args); is_pair(x); x = cdr(x))
+ {
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
- case T_PAIR:
- {
- shared_info *ci;
- bool result;
- ci = new_shared_info();
- result = structures_are_equal(sc, x, y, ci);
- free_shared_info(ci);
- return(result);
- }
+ if (charcmp(character(y), character(car(x))) == val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
+ }
+ y = car(x);
+ }
+ return(sc->T);
+}
- case T_HOOK:
- return(hooks_are_equal(sc, x, y));
- case T_C_POINTER:
- return(raw_pointer(x) == raw_pointer(y));
- }
+static s7_pointer g_chars_are_equal(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_equal "(char=? char ...) returns #t if all the character arguments are equal"
+ #define Q_chars_are_equal pcl_bc
+
+ s7_pointer x, y;
+
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_EQ, args, T_CHARACTER, 1);
+
+ for (x = cdr(args); is_pair(x); x = cdr(x))
+ {
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sc->CHAR_EQ, cons(sc, y, x), T_CHARACTER, position_of(x, args));
- return(false); /* we already checked that x != y (port etc) */
+ if (car(x) != y)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sc->CHAR_EQ, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
+ }
+ }
+ return(sc->T);
}
-static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_chars_are_less(s7_scheme *sc, s7_pointer args)
{
- #define H_is_eq "(eq? obj1 obj2) returns #t if obj1 is eq to (the same object as) obj2"
- return(make_boolean(sc, car(args) == cadr(args)));
+ #define H_chars_are_less "(char<? char ...) returns #t if all the character arguments are increasing"
+ #define Q_chars_are_less pcl_bc
+
+ return(g_char_cmp(sc, args, -1, sc->CHAR_LT));
}
-static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_chars_are_greater(s7_scheme *sc, s7_pointer args)
{
- #define H_is_eqv "(eqv? obj1 obj2) returns #t if obj1 is equivalent to obj2"
- return(make_boolean(sc, s7_is_eqv(car(args), cadr(args))));
+ #define H_chars_are_greater "(char>? char ...) returns #t if all the character arguments are decreasing"
+ #define Q_chars_are_greater pcl_bc
+
+ return(g_char_cmp(sc, args, 1, sc->CHAR_GT));
}
-static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_chars_are_geq(s7_scheme *sc, s7_pointer args)
{
- #define H_is_equal "(equal? obj1 obj2) returns #t if obj1 is equal to obj2"
- return(make_boolean(sc, s7_is_equal(sc, car(args), cadr(args))));
+ #define H_chars_are_geq "(char>=? char ...) returns #t if all the character arguments are equal or decreasing"
+ #define Q_chars_are_geq pcl_bc
+
+ return(g_char_cmp_not(sc, args, -1, sc->CHAR_GEQ));
}
+static s7_pointer g_chars_are_leq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_leq "(char<=? char ...) returns #t if all the character arguments are equal or increasing"
+ #define Q_chars_are_leq pcl_bc
-/* ---------------------------------------- length, copy, fill ---------------------------------------- */
+ return(g_char_cmp_not(sc, args, 1, sc->CHAR_LEQ));
+}
-static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
+static s7_pointer simple_char_eq;
+static s7_pointer g_simple_char_eq(s7_scheme *sc, s7_pointer args)
{
- #define H_length "(length obj) returns the length of obj, which can be a list, vector, string, or hash-table. \
-The length of a dotted list does not include the final cdr, and is returned as a negative number. A circular \
-list has infinite length."
-
- s7_pointer lst = car(args);
-
- if (lst == sc->NIL)
- return(small_int(0));
-
- switch (type(lst))
- {
- case T_PAIR:
- {
- int len;
- len = s7_list_length(sc, lst);
- /* len < 0 -> dotted and (abs len) is length not counting the final cdr
- * len == 0, circular so length is infinite
- */
- if (len == 0)
- return(s7_make_real(sc, INFINITY));
- return(s7_make_integer(sc, len));
- }
-
- case T_VECTOR:
- return(g_vector_length(sc, args));
+ return(make_boolean(sc, character(car(args)) == character(cadr(args))));
+}
- case T_STRING:
- return(g_string_length(sc, args));
+static s7_pointer c_char_eq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_EQ, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_EQ, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, x == y));
+}
- case T_HASH_TABLE:
- return(g_hash_table_size(sc, args));
+static s7_pointer s7_procedure_signature(s7_scheme *sc, s7_pointer x);
+static bool char_check(s7_scheme *sc, s7_pointer obj)
+{
+ if (s7_is_character(obj)) return(true);
+ if ((is_pair(obj)) && (is_symbol(car(obj))))
+ {
+ s7_pointer sig;
+ sig = s7_procedure_signature(sc, s7_symbol_value(sc, car(obj)));
+ return((sig) && (is_pair(sig)) && (car(sig) == sc->IS_CHAR));
+ }
+ return(false);
+}
- case T_C_OBJECT:
- return(object_length(sc, lst));
+PF2_TO_PF_X(char_eq, char_check, c_char_eq, c_is_eq)
- case T_S_OBJECT:
- {
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(lst);
- if (object_types[obj->type].length)
- {
- car(args) = obj->value;
- push_stack(sc, opcode(OP_APPLY), args, object_types[obj->type].length_func);
- return(sc->UNSPECIFIED);
- }
- return(eval_error(sc, "attempt to get length of ~A?", lst));
- }
- default:
- return(s7_wrong_type_arg_error(sc, "length", 0, lst, "a list, vector, string, or hash-table"));
- }
-
- return(small_int(0));
+static s7_pointer char_equal_s_ic, char_equal_2;
+static s7_pointer g_char_equal_s_ic(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer c;
+ c = find_symbol_checked(sc, car(args));
+ if (c == cadr(args))
+ return(sc->T);
+ if (s7_is_character(c))
+ return(sc->F);
+ method_or_bust(sc, c, sc->CHAR_EQ, list_2(sc, c, cadr(args)), T_CHARACTER, 1);
}
-/* what about (length file)?
- */
+static s7_pointer g_char_equal_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->CHAR_EQ, args, T_CHARACTER, 1);
+ if (car(args) == cadr(args))
+ return(sc->T);
+ if (!s7_is_character(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->CHAR_EQ, args, T_CHARACTER, 2);
+ return(sc->F);
+}
-static s7_pointer list_copy(s7_scheme *sc, s7_pointer x, s7_pointer y, bool step)
+static s7_pointer char_less_s_ic, char_less_2;
+static s7_pointer g_char_less_s_ic(s7_scheme *sc, s7_pointer args)
{
- if ((!is_pair(x)) ||
- (x == y))
- return(x);
- return(s7_cons(sc, car(x), list_copy(sc, cdr(x), (step) ? cdr(y) : y, !step)));
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->CHAR_LT, args, T_CHARACTER, 1);
+ return(make_boolean(sc, character(car(args)) < character(cadr(args))));
}
+static s7_pointer g_char_less_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->CHAR_LT, args, T_CHARACTER, 1);
+ if (!s7_is_character(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->CHAR_LT, args, T_CHARACTER, 2);
+ return(make_boolean(sc, character(car(args)) < character(cadr(args))));
+}
-static s7_pointer s7_copy(s7_scheme *sc, s7_pointer obj)
+static s7_pointer c_char_lt(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- switch (type(obj))
- {
- case T_STRING:
- return(s7_make_string_with_length(sc, string_value(obj), string_length(obj)));
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_LT, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_LT, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, character(x) < character(y)));
+}
- case T_S_OBJECT:
- case T_C_OBJECT:
- return(object_copy(sc, obj));
+static s7_pointer c_clt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ return(make_boolean(sc, character(x) < character(y)));
+}
- case T_HASH_TABLE: /* this has to copy nearly everything */
- return(hash_table_copy(sc, obj));
-
- case T_VECTOR:
- return(vector_copy(sc, obj)); /* "shallow" copy */
+PF2_TO_PF_X(char_lt, char_check, c_char_lt, c_clt)
- case T_PAIR:
- return(s7_cons(sc, car(obj), list_copy(sc, cdr(obj), obj, true))); /* this is the only use of list_copy */
- case T_HOOK:
- return(hook_copy(sc, obj));
+static s7_pointer char_greater_s_ic, char_greater_2;
+static s7_pointer g_char_greater_s_ic(s7_scheme *sc, s7_pointer args)
+{
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->CHAR_GT, args, T_CHARACTER, 1);
+ return(make_boolean(sc, character(car(args)) > character(cadr(args))));
+}
- /* perhaps copy input port -> saves current read position?
- * would this require copying or protecting the string (sort of like a shared vector)?
- */
- }
- return(obj);
+static s7_pointer g_char_greater_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!s7_is_character(car(args)))
+ method_or_bust(sc, car(args), sc->CHAR_GT, args, T_CHARACTER, 1);
+ if (!s7_is_character(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->CHAR_GT, args, T_CHARACTER, 2);
+ return(make_boolean(sc, character(car(args)) > character(cadr(args))));
}
+static s7_pointer c_char_gt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_GT, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_GT, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, character(x) > character(y)));
+}
-static s7_pointer g_copy(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_cgt(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- #define H_copy "(copy obj) returns a copy of obj"
- return(s7_copy(sc, car(args)));
+ return(make_boolean(sc, character(x) > character(y)));
}
+PF2_TO_PF_X(char_gt, char_check, c_char_gt, c_cgt)
-static s7_pointer g_reverse(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer c_char_geq(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- #define H_reverse "(reverse lst) returns a list with the elements of lst in reverse order. reverse \
-also accepts a string or vector argument."
- s7_pointer p, np;
-
- p = car(args);
- np = sc->NIL;
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_GEQ, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_GEQ, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, character(x) >= character(y)));
+}
- switch (type(p))
- {
- case T_NIL:
- return(sc->NIL);
+PF2_TO_PF(char_geq, c_char_geq)
- case T_PAIR:
- if (p == sc->NIL)
- return(sc->NIL);
- np = s7_reverse(sc, p);
- if (np == sc->NIL)
- return(s7_wrong_type_arg_error(sc, "reverse", 0, p, "a proper list"));
- break;
- case T_STRING:
- {
- int i, j, len;
- len = string_length(p);
- np = make_empty_string(sc, len, 0);
- if (len > 0)
- for (i = 0, j = len - 1; i < len; i++, j--)
- string_value(np)[i] = string_value(p)[j];
- }
- break;
+static s7_pointer c_char_leq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_LEQ, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_LEQ, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, character(x) <= character(y)));
+}
- case T_VECTOR:
- {
- s7_Int i, j, len;
- len = vector_length(p);
- if (vector_is_multidimensional(p))
- np = g_make_vector(sc, make_list_1(sc, g_vector_dimensions(sc, make_list_1(sc, p))));
- else np = make_vector_1(sc, len, NOT_FILLED);
- if (len > 0)
- for (i = 0, j = len - 1; i < len; i++, j--)
- vector_element(np, i) = vector_element(p, j);
- }
- break;
+PF2_TO_PF(char_leq, c_char_leq)
- case T_HASH_TABLE:
- return(hash_table_reverse(sc, p));
- case T_S_OBJECT:
- case T_C_OBJECT:
- return(object_reverse(sc, p));
- break;
+#if (!WITH_PURE_S7)
+static s7_pointer g_char_cmp_ci(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+{
+ s7_pointer x, y;
- default:
- return(s7_wrong_type_arg_error(sc, "reverse", 0, p, "a list, string, vector, or hash-table"));
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
+
+ for (x = cdr(args); is_pair(x); x = cdr(x))
+ {
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
+ if (charcmp(upper_character(y), upper_character(car(x))) != val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
+ }
+ y = car(x);
}
-
- return(np);
+ return(sc->T);
}
-static s7_pointer list_fill(s7_scheme *sc, s7_pointer obj, s7_pointer val)
+static s7_pointer g_char_cmp_ci_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
{
- /* ambiguous ("tree-fill"?) but if it's like vector-fill, we just stomp on the top level */
s7_pointer x, y;
- x = obj;
- y = obj;
-
- while (true)
+ y = car(args);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sym, args, T_CHARACTER, 1);
+ for (x = cdr(args); is_pair(x); x = cdr(x))
{
- if (!is_pair(x)) return(val);
- car(x) = val;
- if (is_pair(cdr(x)))
- {
- x = cdr(x);
- car(x) = val;
- if (is_pair(cdr(x)))
- {
- x = cdr(x);
- y = cdr(y);
- if (x == y) return(val);
- }
- else
- {
- if (cdr(x) != sc->NIL)
- cdr(x) = val;
- return(val);
- }
- }
- else
+ if (!s7_is_character(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_CHARACTER, position_of(x, args));
+ if (charcmp(upper_character(y), upper_character(car(x))) == val)
{
- if (cdr(x) != sc->NIL)
- cdr(x) = val;
- return(val);
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_character_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_CHARACTER));
+ return(sc->F);
}
+ y = car(x);
}
- return(val);
+ return(sc->T);
}
-static s7_pointer g_fill(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_chars_are_ci_equal(s7_scheme *sc, s7_pointer args)
{
- #define H_fill "(fill obj val) fills obj with the value val"
+ #define H_chars_are_ci_equal "(char-ci=? char ...) returns #t if all the character arguments are equal, ignoring case"
+ #define Q_chars_are_ci_equal pcl_bc
- switch (type(car(args)))
- {
- case T_STRING:
- return(g_string_fill(sc, args));
-
- case T_HASH_TABLE:
- if (cadr(args) != sc->NIL)
- return(s7_wrong_type_arg_error(sc, "fill! hash-table value,", 2, cadr(args), "nil"));
- return(hash_table_clear(sc, car(args)));
+ return(g_char_cmp_ci(sc, args, 0, sc->CHAR_CI_EQ));
+}
- case T_VECTOR:
- return(g_vector_fill(sc, args));
+static s7_pointer c_char_ci_eq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_CI_EQ, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_CI_EQ, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, upper_character(x) == upper_character(y)));
+}
- case T_C_OBJECT:
- return(object_fill(sc, car(args), cadr(args)));
+PF2_TO_PF(char_ci_eq, c_char_ci_eq)
- case T_S_OBJECT:
- {
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(car(args));
- if (object_types[obj->type].fill)
- {
- car(args) = obj->value;
- push_stack(sc, opcode(OP_APPLY), args, object_types[obj->type].fill_func);
- return(sc->UNSPECIFIED);
- }
- return(eval_error(sc, "attempt to fill ~A?", car(args)));
- }
- case T_PAIR:
- return(list_fill(sc, car(args), cadr(args)));
+static s7_pointer g_chars_are_ci_less(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_ci_less "(char-ci<? char ...) returns #t if all the character arguments are increasing, ignoring case"
+ #define Q_chars_are_ci_less pcl_bc
- case T_NIL:
- return(cadr(args)); /* this parallels the empty vector case */
- }
+ return(g_char_cmp_ci(sc, args, -1, sc->CHAR_CI_LT));
+}
- return(s7_wrong_type_arg_error(sc, "fill!", 1, car(args), "a fillable object")); /* (fill! 1 0) */
+static s7_pointer c_char_ci_lt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_CI_LT, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_CI_LT, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, upper_character(x) < upper_character(y)));
}
+PF2_TO_PF(char_ci_lt, c_char_ci_lt)
-static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj)
+
+static s7_pointer g_chars_are_ci_greater(s7_scheme *sc, s7_pointer args)
{
- switch (type(obj))
- {
- case T_VECTOR:
- return(s7_vector_to_list(sc, obj));
+ #define H_chars_are_ci_greater "(char-ci>? char ...) returns #t if all the character arguments are decreasing, ignoring case"
+ #define Q_chars_are_ci_greater pcl_bc
- case T_STRING:
- return(s7_string_to_list(sc, string_value(obj), string_length(obj)));
+ return(g_char_cmp_ci(sc, args, 1, sc->CHAR_CI_GT));
+}
- case T_HASH_TABLE:
- {
- s7_pointer x, iterator, iter_loc;
- int gc_iter;
- /* (format #f "~{~A ~}" (hash-table '(a . 1) '(b . 2))) */
+static s7_pointer c_char_ci_gt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_CI_GT, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_CI_GT, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, upper_character(x) > upper_character(y)));
+}
- iterator = g_make_hash_table_iterator(sc, make_list_1(sc, obj));
- gc_iter = s7_gc_protect(sc, iterator);
- iter_loc = cdadar(closure_body(iterator));
+PF2_TO_PF(char_ci_gt, c_char_ci_gt)
- sc->w = sc->NIL;
- while (true)
- {
- x = g_hash_table_iterate(sc, iter_loc);
- if (x == sc->NIL) break;
- sc->w = s7_cons(sc, x, sc->w);
- }
- x = sc->w;
- sc->w = sc->NIL;
- s7_gc_unprotect_at(sc, gc_iter);
- return(x);
- }
-
- case T_HOOK:
- return(hook_functions(obj));
+static s7_pointer g_chars_are_ci_geq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_ci_geq "(char-ci>=? char ...) returns #t if all the character arguments are equal or decreasing, ignoring case"
+ #define Q_chars_are_ci_geq pcl_bc
- case T_C_OBJECT:
- case T_S_OBJECT:
- {
- long int i, len; /* the "long" matters on 64-bit machines */
- s7_pointer x, z, result;
- int save_x, save_y, save_z, gc_res, gc_z;
- /* (format #f "~{~A ~}" (vct 1 2 3)) */
+ return(g_char_cmp_ci_not(sc, args, -1, sc->CHAR_CI_GEQ));
+}
- SAVE_X_Y_Z(save_x, save_y, save_z);
- x = object_length(sc, obj);
- RESTORE_X_Y_Z(save_x, save_y, save_z);
- if (s7_is_integer(x))
- len = s7_integer(x);
- else return(sc->F);
+static s7_pointer c_char_ci_geq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_CI_GEQ, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_CI_GEQ, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, upper_character(x) >= upper_character(y)));
+}
- if (len < 0)
- return(sc->F);
- if (len == 0)
- return(sc->NIL);
+PF2_TO_PF(char_ci_geq, c_char_ci_geq)
- result = g_make_list(sc, make_list_1(sc, s7_make_integer(sc, len)));
- gc_res = s7_gc_protect(sc, result);
- z = make_list_1(sc, sc->F);
- gc_z = s7_gc_protect(sc, z);
- for (i = 0, x = result; i < len; i++, x = cdr(x))
- {
- car(z) = s7_make_integer(sc, i);
- SAVE_X_Y_Z(save_x, save_y, save_z);
- car(x) = apply_object(sc, obj, z);
- RESTORE_X_Y_Z(save_x, save_y, save_z);
- }
-
- s7_gc_unprotect_at(sc, gc_z);
- s7_gc_unprotect_at(sc, gc_res);
- return(result);
- }
- }
- return(obj);
+static s7_pointer g_chars_are_ci_leq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_chars_are_ci_leq "(char-ci<=? char ...) returns #t if all the character arguments are equal or increasing, ignoring case"
+ #define Q_chars_are_ci_leq pcl_bc
+
+ return(g_char_cmp_ci_not(sc, args, 1, sc->CHAR_CI_LEQ));
}
+static s7_pointer c_char_ci_leq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!s7_is_character(x))
+ method_or_bust(sc, x, sc->CHAR_CI_LEQ, list_2(sc, x, y), T_CHARACTER, 1);
+ if (!s7_is_character(y))
+ method_or_bust(sc, y, sc->CHAR_CI_LEQ, list_2(sc, x, y), T_CHARACTER, 2);
+ return(make_boolean(sc, upper_character(x) <= upper_character(y)));
+}
+PF2_TO_PF(char_ci_leq, c_char_ci_leq)
+#endif /* not pure s7 */
-/* -------------------------------- format -------------------------------- */
-typedef struct {
- char *str;
- int len, loc;
- s7_pointer args;
-} format_data;
+static s7_pointer g_char_position(s7_scheme *sc, s7_pointer args)
+{
+ #define H_char_position "(char-position char-or-str str (start 0)) returns the position of the first occurrence of char in str, or #f"
+ #define Q_char_position s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_BOOLEAN), s7_make_signature(sc, 2, sc->IS_CHAR, sc->IS_STRING), sc->IS_STRING, sc->IS_INTEGER)
+ const char *porig, *p, *pset;
+ s7_int start, pos, len; /* not "int" because start arg might be most-negative-fixnum */
+ s7_pointer arg1, arg2;
-static char *format_error(s7_scheme *sc, const char *msg, const char *str, s7_pointer args, format_data *dat)
-{
- int len;
- char *errmsg;
- s7_pointer x;
+ arg1 = car(args);
+ if ((!s7_is_character(arg1)) &&
+ (!is_string(arg1)))
+ method_or_bust(sc, arg1, sc->CHAR_POSITION, args, T_CHARACTER, 1);
+
+ arg2 = cadr(args);
+ if (!is_string(arg2))
+ method_or_bust(sc, arg2, sc->CHAR_POSITION, args, T_STRING, 2);
+
+ porig = string_value(arg2);
+ len = string_length(arg2);
- if (dat->loc == 0)
+ if (is_pair(cddr(args)))
{
- len = safe_strlen(msg) + 32;
- errmsg = (char *)malloc(len * sizeof(char));
- snprintf(errmsg, len, "format ~S ~{~S~^ ~}: %s", msg);
+ s7_pointer arg3;
+ arg3 = caddr(args);
+ if (!s7_is_integer(arg3))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, arg3, cddr(args))))
+ method_or_bust(sc, arg3, sc->CHAR_POSITION, args, T_INTEGER, 3);
+ arg3 = p;
+ }
+ start = s7_integer(arg3);
+ if (start < 0)
+ return(wrong_type_argument_with_type(sc, sc->CHAR_POSITION, 3, arg3, A_NON_NEGATIVE_INTEGER));
}
- else
+ else start = 0;
+ if (start >= len) return(sc->F);
+
+ if (s7_is_character(arg1))
{
- char *filler;
- int i;
- filler = (char *)calloc(dat->loc + 12, sizeof(char));
- for (i = 0; i < dat->loc + 11; i++)
- filler[i] = ' ';
- len = safe_strlen(msg) + 32 + dat->loc + 12;
- errmsg = (char *)malloc(len * sizeof(char));
- snprintf(errmsg, len, "\nformat: ~S ~{~S~^ ~}\n%s^: %s", filler, msg);
- free(filler);
+ char c;
+ c = character(arg1);
+ p = strchr((const char *)(porig + start), (int)c); /* use strchrnul in Gnu C to catch embedded null case */
+ if (p)
+ return(make_integer(sc, p - porig));
+ return(sc->F);
}
- x = make_list_3(sc, make_string_uncopied(sc, errmsg), make_protected_string(sc, str), args);
+ if (string_length(arg1) == 0)
+ return(sc->F);
+ pset = string_value(arg1);
- if (dat->str) free(dat->str);
- free(dat);
+ pos = strcspn((const char *)(porig + start), (const char *)pset);
+ if ((pos + start) < len)
+ return(make_integer(sc, pos + start));
- s7_error(sc, sc->FORMAT_ERROR, x);
- return(NULL);
+ /* but if the string has an embedded null, we can get erroneous results here --
+ * perhaps check for null at pos+start? What about a searched-for string that
+ * also has embedded nulls?
+ *
+ * The embedded nulls are for byte-vector usages, where presumably you're not talking
+ * about chars and strings, so I think I'll ignore these cases. In unicode, you'd
+ * want to use unicode-aware searchers, so that also is irrelevant.
+ */
+ return(sc->F);
}
+static s7_pointer c_char_position_ppi(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_int z) {return(g_char_position(sc, set_plist_3(sc, x, y, make_integer(sc, z))));}
+static s7_pointer c_char_position_pp(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_char_position(sc, set_plist_2(sc, x, y)));}
+PPIF_TO_PF(char_position, c_char_position_pp, c_char_position_ppi)
-static void format_append_char(format_data *dat, char c)
+
+static s7_pointer char_position_csi;
+static s7_pointer g_char_position_csi(s7_scheme *sc, s7_pointer args)
{
- if (dat->len <= dat->loc + 2)
+ /* assume char arg1, no end */
+ const char *porig, *p;
+ char c;
+ s7_pointer arg2;
+ s7_int start, len;
+
+ c = character(car(args));
+ arg2 = cadr(args);
+
+ if (!is_string(arg2))
+ return(g_char_position(sc, args));
+
+ len = string_length(arg2); /* can't return #f here if len==0 -- need start error check first */
+ porig = string_value(arg2);
+
+ if (is_pair(cddr(args)))
{
- dat->len *= 2;
- dat->str = (char *)realloc(dat->str, dat->len * sizeof(char));
+ s7_pointer arg3;
+ arg3 = caddr(args);
+ if (!s7_is_integer(arg3))
+ return(g_char_position(sc, args));
+ start = s7_integer(arg3);
+ if (start < 0)
+ return(wrong_type_argument_with_type(sc, sc->CHAR_POSITION, 3, arg3, A_NON_NEGATIVE_INTEGER));
+ if (start >= len) return(sc->F);
}
- dat->str[dat->loc++] = c;
+ else start = 0;
+
+ if (len == 0) return(sc->F);
+ p = strchr((const char *)(porig + start), (int)c);
+ if (p)
+ return(make_integer(sc, p - porig));
+ return(sc->F);
}
-static void format_append_string(format_data *dat, const char *str)
+static s7_pointer g_string_position(s7_scheme *sc, s7_pointer args)
{
- const char *s;
- if (!str) return;
- for (s = str; (*s) != 0; s++)
+ #define H_string_position "(string-position str1 str2 (start 0)) returns the starting position of str1 in str2 or #f"
+ #define Q_string_position s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_BOOLEAN), sc->IS_STRING, sc->IS_STRING, sc->IS_INTEGER)
+ const char *s1, *s2, *p2;
+ s7_int start = 0;
+ s7_pointer s1p, s2p;
+
+ s1p = car(args);
+ if (!is_string(s1p))
+ method_or_bust(sc, s1p, sc->STRING_POSITION, args, T_STRING, 1);
+
+ s2p = cadr(args);
+ if (!is_string(s2p))
+ method_or_bust(sc, s2p, sc->STRING_POSITION, args, T_STRING, 2);
+
+ if (is_pair(cddr(args)))
{
- if (dat->len <= dat->loc + 2)
+ s7_pointer arg3;
+ arg3 = caddr(args);
+ if (!s7_is_integer(arg3))
{
- dat->len *= 2;
- dat->str = (char *)realloc(dat->str, dat->len * sizeof(char));
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, arg3, cddr(args))))
+ method_or_bust(sc, arg3, sc->STRING_POSITION, args, T_INTEGER, 3);
+ arg3 = p;
}
- dat->str[dat->loc++] = (*s);
+ start = s7_integer(arg3);
+ if (start < 0)
+ return(wrong_type_argument_with_type(sc, sc->STRING_POSITION, 3, arg3, A_NON_NEGATIVE_INTEGER));
}
+
+ if (string_length(s1p) == 0)
+ return(sc->F);
+ s1 = string_value(s1p);
+ s2 = string_value(s2p);
+ if (start >= string_length(s2p))
+ return(sc->F);
+
+ p2 = strstr((const char *)(s2 + start), s1);
+ if (!p2) return(sc->F);
+ return(make_integer(sc, p2 - s2));
}
+static s7_pointer c_string_position_ppi(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_int z) {return(g_string_position(sc, set_plist_3(sc, x, y, make_integer(sc, z))));}
+static s7_pointer c_string_position_pp(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_string_position(sc, set_plist_2(sc, x, y)));}
+PPIF_TO_PF(string_position, c_string_position_pp, c_string_position_ppi)
-static int format_read_integer(s7_scheme *sc, int *cur_i, int str_len, const char *str, s7_pointer args, format_data *fdat)
-{
- int i, arg1 = -1;
- char *tmp;
- i = *cur_i;
- if (isdigit(str[i]))
- {
- tmp = (char *)(str + i);
- if (sscanf(tmp, "%d", &arg1) < 1)
- format_error(sc, "bad number?", str, args, fdat);
- for (i = i + 1; i < str_len - 1; i++)
- if (!isdigit(str[i]))
- break;
- if (i >= str_len)
- format_error(sc, "numeric argument, but no directive!", str, args, fdat);
- }
- *cur_i = i;
- return(arg1);
-}
+/* -------------------------------- strings -------------------------------- */
-static void format_number(s7_scheme *sc, format_data *fdat, int radix, int width, int precision, char float_choice, char pad)
+s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, int len)
{
- char *tmp;
- if (width < 0) width = 0;
+ s7_pointer x;
+ new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE);
+ string_value(x) = (char *)malloc((len + 1) * sizeof(char));
+ if (len != 0) /* memcpy can segfault if string_value(x) is NULL */
+ memcpy((void *)string_value(x), (void *)str, len);
+ string_value(x)[len] = 0;
+ string_length(x) = len;
+ string_hash(x) = 0;
+ string_needs_free(x) = true;
+ Add_String(x);
+ return(x);
+}
- /* precision choice depends on float_choice if it's -1 */
- if (precision < 0)
- {
- if ((float_choice == 'e') ||
- (float_choice == 'f') ||
- (float_choice == 'g'))
- precision = 6;
- else
- {
- /* in the "int" cases, precision depends on the arg type */
- switch (number_type(car(fdat->args)))
- {
- case NUM_INT:
- case NUM_RATIO:
- precision = 0;
- break;
- default:
- precision = 6;
- break;
- }
- }
- }
+static s7_pointer make_string_uncopied_with_length(s7_scheme *sc, char *str, int len)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_STRING | T_SAFE_PROCEDURE);
+ string_value(x) = str;
+ string_length(x) = len;
+ string_hash(x) = 0;
+ string_needs_free(x) = true;
+ add_string(sc, x);
+ return(x);
+}
- /* should (format #f "~F" 1/3) return "1/3"?? in CL it's "0.33333334" */
- tmp = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice);
+static s7_pointer make_string_wrapper_with_length(s7_scheme *sc, const char *str, int len)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_STRING | T_IMMUTABLE | T_SAFE_PROCEDURE);
+ string_value(x) = (char *)str;
+ string_length(x) = len;
+ string_hash(x) = 0;
+ string_needs_free(x) = false;
+ return(x);
+}
- if (pad != ' ')
- {
- char *padtmp;
- padtmp = tmp;
- while (*padtmp == ' ') (*(padtmp++)) = pad;
- }
- format_append_string(fdat, tmp);
- free(tmp);
- fdat->args = cdr(fdat->args);
+static s7_pointer make_string_wrapper(s7_scheme *sc, const char *str)
+{
+ return(make_string_wrapper_with_length(sc, str, safe_strlen(str)));
}
+static s7_pointer make_empty_string(s7_scheme *sc, int len, char fill)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_STRING);
+ string_value(x) = (char *)malloc((len + 1) * sizeof(char));
+ if (fill != 0)
+ memset((void *)(string_value(x)), fill, len);
+ string_value(x)[len] = 0;
+ string_hash(x) = 0;
+ string_length(x) = len;
+ string_needs_free(x) = true;
+ add_string(sc, x);
+ return(x);
+}
-#if WITH_GMP
-static bool s7_is_one_or_big_one(s7_pointer p);
-#else
-#define s7_is_one_or_big_one(Num) s7_is_one(Num)
-#endif
-static char *format_to_c_string(s7_scheme *sc, const char *str, s7_pointer args, s7_pointer *next_arg)
+s7_pointer s7_make_string(s7_scheme *sc, const char *str)
{
- #define INITIAL_FORMAT_LENGTH 128
- int i = 0, str_len = 0;
- format_data *fdat = NULL;
- char *result, *tmp = NULL;
+ if (str)
+ return(s7_make_string_with_length(sc, str, safe_strlen(str)));
+ return(make_empty_string(sc, 0, 0));
+}
- str_len = safe_strlen(str);
- fdat = (format_data *)malloc(sizeof(format_data));
- fdat->loc = 0;
- fdat->len = INITIAL_FORMAT_LENGTH;
- fdat->str = (char *)calloc(fdat->len, sizeof(char)); /* ~nT col checks need true current string length, so malloc here is messy */
- fdat->str[0] = '\0';
- fdat->args = args;
+static char *make_permanent_string(const char *str)
+{
+ char *x;
+ int len;
+ len = safe_strlen(str);
+ x = (char *)malloc((len + 1) * sizeof(char));
+ memcpy((void *)x, (void *)str, len);
+ x[len] = 0;
+ return(x);
+}
+
- if (str_len == 0)
+s7_pointer s7_make_permanent_string(const char *str)
+{
+ /* for the symbol table which is never GC'd */
+ s7_pointer x;
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_STRING | T_IMMUTABLE);
+ if (str)
{
- if ((args != sc->NIL) &&
- (next_arg == NULL))
- return(format_error(sc, "too many arguments", str, args, fdat));
+ unsigned int len;
+ len = safe_strlen(str);
+ string_length(x) = len;
+ string_value(x) = (char *)malloc((len + 1) * sizeof(char));
+ memcpy((void *)string_value(x), (void *)str, len);
+ string_value(x)[len] = 0;
}
else
{
- for (i = 0; i < str_len - 1; i++)
- {
- if (str[i] == '~')
- {
- switch (str[i + 1])
- {
- case '%': /* -------- newline -------- */
- format_append_char(fdat, '\n');
- i++;
- break;
+ string_value(x) = NULL;
+ string_length(x) = 0;
+ }
+ string_hash(x) = 0;
+ string_needs_free(x) = false;
+ return(x);
+}
- case '&': /* -------- conditional newline -------- */
- if ((fdat->loc > 0) &&
- (fdat->str[fdat->loc - 1] != '\n'))
- format_append_char(fdat, '\n');
- i++;
- break;
-
- case '~': /* -------- tilde -------- */
- format_append_char(fdat, '~');
- i++;
- break;
- case '\n': /* -------- trim white-space -------- */
- for (i = i + 2; i <str_len - 1; i++)
- if (!(white_space[(unsigned char)(str[i])]))
- {
- i--;
- break;
- }
- break;
-
- case '*': /* -------- ignore arg -------- */
- i++;
- fdat->args = cdr(fdat->args);
- break;
+static s7_pointer make_temporary_string(s7_scheme *sc, const char *str, int len)
+{
+ s7_pointer p;
+ p = sc->tmp_strs[0];
+ prepare_temporary_string(sc, len + 1, 0);
+ string_length(p) = len;
+ if (len > 0)
+ memmove((void *)(string_value(p)), (void *)str, len); /* not memcpy because str might be a temp string (i.e. sc->tmp_str_chars -> itself) */
+ string_value(p)[len] = 0;
+ return(p);
+}
- case '^': /* -------- exit -------- */
- if (fdat->args == sc->NIL)
- {
- i = str_len;
- goto ALL_DONE;
- }
- i++;
- break;
- case '@': /* -------- plural, 'y' or 'ies' -------- */
- i += 2;
- if ((str[i] != 'P') && (str[i] != 'p'))
- return(format_error(sc, "unknown '@' directive", str, args, fdat));
- if (!s7_is_number(car(fdat->args))) /* CL accepts non numbers here */
- return(format_error(sc, "'@P' directive argument is not an integer", str, args, fdat));
+bool s7_is_string(s7_pointer p)
+{
+ return(is_string(p));
+}
- if (!s7_is_one_or_big_one(car(fdat->args)))
- format_append_string(fdat, "ies");
- else format_append_char(fdat, 'y');
- fdat->args = cdr(fdat->args);
- break;
+const char *s7_string(s7_pointer p)
+{
+ return(string_value(p));
+}
- case 'P': case 'p': /* -------- plural in 's' -------- */
- if (!s7_is_real(car(fdat->args)))
- return(format_error(sc, "'P' directive argument is not a real number", str, args, fdat));
- if (!s7_is_one_or_big_one(car(fdat->args)))
- format_append_char(fdat, 's');
- i++;
- fdat->args = cdr(fdat->args);
- break;
-
- case 'A': case 'a': /* -------- object->string -------- */
- case 'C': case 'c':
- case 'S': case 's':
- {
- shared_info *ci = NULL;
- s7_pointer obj;
- /* slib suggests num arg to ~A and ~S to truncate: ~20A sends only (up to) 20 chars of object->string result,
- * but that could easily(?) be handled with substring and an embedded format arg.
- */
+static s7_pointer g_is_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_string "(string? obj) returns #t if obj is a string"
+ #define Q_is_string pl_bt
+
+ check_boolean_method(sc, is_string, sc->IS_STRING, args);
+}
- if (fdat->args == sc->NIL)
- return(format_error(sc, "missing argument", str, args, fdat));
- i++;
- obj = car(fdat->args);
- if (((str[i] == 'C') || (str[i] == 'c')) &&
- (!s7_is_character(obj)))
- return(format_error(sc, "'C' directive requires a character argument", str, args, fdat));
+/* -------------------------------- make-string -------------------------------- */
+static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_string "(make-string len (val #\\space)) makes a string of length len filled with the character val (default: space)"
+ #define Q_make_string s7_make_signature(sc, 3, sc->IS_STRING, sc->IS_INTEGER, sc->IS_CHAR)
- if (has_structure(obj))
- ci = make_shared_info(sc, obj);
- tmp = object_to_c_string_with_circle_check(sc, obj, (str[i] == 'S') || (str[i] == 's'), WITH_ELLIPSES, ci);
- if (ci) free_shared_info(ci);
+ s7_pointer n;
+ s7_int len;
+ char fill = ' ';
- format_append_string(fdat, tmp);
- if (tmp) free(tmp);
- fdat->args = cdr(fdat->args);
- }
- break;
-
- case '{': /* -------- iteration -------- */
- {
- int k, curly_len = -1, curly_nesting = 1;
+ n = car(args);
+ if (!s7_is_integer(n))
+ {
+ check_two_methods(sc, n, sc->MAKE_STRING, sc->MAKE_BYTE_VECTOR, args);
+ return(wrong_type_argument(sc, sc->MAKE_STRING, 1, n, T_INTEGER));
+ }
- if (fdat->args == sc->NIL)
- return(format_error(sc, "missing argument", str, args, fdat));
+ len = s7_integer(n);
+ if ((len < 0) || (len > sc->max_string_length))
+ return(out_of_range(sc, sc->MAKE_STRING, small_int(1), n, (len < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
- for (k = i + 2; k < str_len - 1; k++)
- if (str[k] == '~')
- {
- if (str[k + 1] == '}')
- {
- curly_nesting--;
- if (curly_nesting == 0)
- {
- curly_len = k - i - 1;
- break;
- }
- }
- else
- {
- if (str[k + 1] == '{')
- curly_nesting++;
- }
- }
+ if (is_not_null(cdr(args)))
+ {
+ if (!s7_is_character(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->MAKE_STRING, args, T_CHARACTER, 2);
+ fill = s7_character(cadr(args));
+ }
+ n = make_empty_string(sc, (int)len, fill);
+ if (fill == '\0')
+ memset((void *)string_value(n), 0, (int)len);
+ return(n);
+}
- if (curly_len == -1)
- return(format_error(sc, "'{' directive, but no matching '}'", str, args, fdat));
+static s7_pointer c_make_string(s7_scheme *sc, s7_int len) {return(make_empty_string(sc, (int)len, ' '));}
+IF_TO_PF(make_string, c_make_string)
- /* what about cons's here? I can't see any way in CL either to specify the car or cdr of a cons within the format string
- * (cons 1 2) is applicable: ((cons 1 2) 0) -> 1
- * also there can be applicable objects that won't work in the map context (arg not integer etc)
- */
- if (car(fdat->args) != sc->NIL) /* (format #f "~{~A ~}" '()) -> "" */
- {
- s7_pointer curly_arg;
- curly_arg = object_to_list(sc, car(fdat->args));
- if (curly_arg != sc->NIL) /* (format #f "~{~A ~}" #()) -> "" */
- {
- char *curly_str = NULL; /* this is the local (nested) format control string */
- int curly_gc;
+#if (!WITH_PURE_S7)
+static s7_pointer g_string_length(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_length "(string-length str) returns the length of the string str"
+ #define Q_string_length s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_STRING)
+ s7_pointer p;
+ p = car(args);
+ if (!is_string(p))
+ method_or_bust(sc, p, sc->STRING_LENGTH, args, T_STRING, 0);
+ return(make_integer(sc, string_length(p)));
+}
- if (!is_proper_list(sc, curly_arg))
- return(format_error(sc, "'{' directive argument should be a proper list or something we can turn into a list", str, args, fdat));
- curly_gc = s7_gc_protect(sc, curly_arg);
+static s7_int c_string_length(s7_scheme *sc, s7_pointer p)
+{
+ if (!is_string(p))
+ int_method_or_bust(sc, p, sc->STRING_LENGTH, set_plist_1(sc, p), T_STRING, 0);
+ return(string_length(p));
+}
- curly_str = (char *)malloc(curly_len * sizeof(char));
- for (k = 0; k < curly_len - 1; k++)
- curly_str[k] = str[i + 2 + k];
- curly_str[curly_len - 1] = '\0';
+PF_TO_IF(string_length, c_string_length)
+#endif
- while (curly_arg != sc->NIL)
- {
- s7_pointer new_arg = sc->NIL;
- tmp = format_to_c_string(sc, curly_str, curly_arg, &new_arg);
- format_append_string(fdat, tmp);
- if (tmp) free(tmp);
- if (curly_arg == new_arg)
- {
- if (curly_str) free(curly_str);
- s7_gc_unprotect_at(sc, curly_gc);
- return(format_error(sc, "'{...}' doesn't consume any arguments!", str, args, fdat));
- }
- curly_arg = new_arg;
- }
- free(curly_str);
- s7_gc_unprotect_at(sc, curly_gc);
- }
- }
+/* -------------------------------- string-up|downcase -------------------------------- */
- i += (curly_len + 2); /* jump past the ending '}' too */
- fdat->args = cdr(fdat->args);
- }
- break;
-
- case '}':
- return(format_error(sc, "unmatched '}'", str, args, fdat));
-
- /* -------- numeric args -------- */
- case '0': case '1': case '2': case '3': case '4': case '5':
- case '6': case '7': case '8': case '9': case ',':
-
- case 'B': case 'b':
- case 'D': case 'd':
- case 'E': case 'e':
- case 'F': case 'f':
- case 'G': case 'g':
- case 'O': case 'o':
- case 'T': case 't':
- case 'X': case 'x':
- {
- int width = -1, precision = -1;
- char pad = ' ';
- i++;
+static s7_pointer c_string_downcase(s7_scheme *sc, s7_pointer p)
+{
+ s7_pointer newstr;
+ int i, len;
+ unsigned char *nstr, *ostr;
- if (isdigit(str[i]))
- width = format_read_integer(sc, &i, str_len, str, args, fdat);
+ sc->temp3 = p;
+ if (!is_string(p))
+ method_or_bust(sc, p, sc->STRING_DOWNCASE, list_1(sc, p), T_STRING, 0);
- if (str[i] == ',')
- {
- i++;
- if (isdigit(str[i]))
- precision = format_read_integer(sc, &i, str_len, str, args, fdat);
- /* is (format #f "~12,12D" 1) an error? The precision has no use here. */
- else
- {
- if (str[i] == '\'') /* (format #f "~12,'xD" 1) -> "xxxxxxxxxxx1" */
- {
- pad = str[i + 1];
- i += 2;
- }
- /* is (let ((str "~12,'xD")) (set! (str 5) #\null) (format #f str 1)) an error? */
- }
- }
- if ((str[i] != 'T') && (str[i] != 't'))
- {
- if (fdat->args == sc->NIL)
- return(format_error(sc, "missing argument", str, args, fdat));
- if (!(s7_is_number(car(fdat->args))))
- return(format_error(sc, "numeric argument required", str, args, fdat));
- }
+ len = string_length(p);
+ newstr = make_empty_string(sc, len, 0);
- switch (str[i])
- {
- /* -------- pad to column -------- */
- /* are columns numbered from 1 or 0? there seems to be disagreement about this directive */
- /* does "space over to" mean including? */
- case 'T': case 't':
- if (width == -1) width = 0;
- if (precision == -1) precision = 0;
- if ((width > 0) || (precision > 0)) /* (format #f "a~8Tb") */
- {
- int j, k, outstr_len;
- outstr_len = safe_strlen(fdat->str);
- for (k = outstr_len - 1; k >= 0; k--)
- if (fdat->str[k] == '\n')
- break;
+ ostr = (unsigned char *)string_value(p);
+ nstr = (unsigned char *)string_value(newstr);
+ for (i = 0; i < len; i++)
+ nstr[i] = lowers[(int)ostr[i]];
+
+ return(newstr);
+}
- /* (length (substring (format #f "~%~10T.") 1)) == (length (format #f "~10T."))
- * (length (substring (format #f "~%-~10T.~%") 1)) == (length (format #f "-~10T.~%"))
- */
+static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_downcase "(string-downcase str) returns the lower case version of str."
+ #define Q_string_downcase pcl_s
+ return(c_string_downcase(sc, car(args)));
+}
- if (precision > 0)
- {
- int mult;
- mult = (int)(ceil((s7_Double)(outstr_len - k - width) / (s7_Double)precision)); /* CLtL2 ("least positive int") */
- if (mult < 1) mult = 1;
- width += (precision * mult);
- }
-
- for (j = outstr_len - k; j < width; j++)
- format_append_char(fdat, pad);
- }
- break;
-
- /* -------- numbers -------- */
- case 'F': case 'f':
- format_number(sc, fdat, 10, width, precision, 'f', pad);
- break;
-
- case 'G': case 'g':
- format_number(sc, fdat, 10, width, precision, 'g', pad);
- break;
-
- case 'E': case 'e':
- format_number(sc, fdat, 10, width, precision, 'e', pad);
- break;
-
- /* how to handle non-integer arguments in the next 4 cases? clisp just returns
- * the argument: (format nil "~X" 1.25) -> "1.25" which is perverse (ClTl2 p 581:
- * "if arg is not an integer, it is printed in ~A format and decimal base")!!
- * Guile raises an error ("argument is not an integer"). slib also raise an error.
- * I think I'll use the type of the number to choose the output format.
- */
- case 'D': case 'd':
- format_number(sc, fdat, 10, width, precision, 'd', pad);
- break;
+PF_TO_PF(string_downcase, c_string_downcase)
- case 'O': case 'o':
- format_number(sc, fdat, 8, width, precision, 'o', pad);
- break;
- case 'X': case 'x':
- format_number(sc, fdat, 16, width, precision, 'x', pad);
- break;
+static s7_pointer c_string_upcase(s7_scheme *sc, s7_pointer p)
+{
+ s7_pointer newstr;
+ int i, len;
+ unsigned char *nstr, *ostr;
- case 'B': case 'b':
- format_number(sc, fdat, 2, width, precision, 'b', pad);
- break;
-
- default:
- return(format_error(sc, "unimplemented format directive", str, args, fdat));
- }
- }
- break;
+ sc->temp3 = p;
+ if (!is_string(p))
+ method_or_bust(sc, p, sc->STRING_UPCASE, list_1(sc, p), T_STRING, 0);
- default:
- return(format_error(sc, "unimplemented format directive", str, args, fdat));
- }
- }
- else
- {
- /* format_append_char(fdat, str[i]); */
- if (fdat->len <= fdat->loc + 2)
- {
- fdat->len *= 2;
- fdat->str = (char *)realloc(fdat->str, fdat->len * sizeof(char));
- }
- fdat->str[fdat->loc++] = str[i];
- }
- }
- }
+ len = string_length(p);
+ newstr = make_empty_string(sc, len, 0);
- ALL_DONE:
- if (next_arg)
- (*next_arg) = fdat->args;
- else
- {
- if (fdat->args != sc->NIL)
- return(format_error(sc, "too many arguments", str, args, fdat));
- }
- if (i < str_len)
- format_append_char(fdat, str[i]); /* possible trailing ~ is sent out */
- format_append_char(fdat, '\0');
- result = fdat->str;
- free(fdat);
- return(result);
+ ostr = (unsigned char *)string_value(p);
+ nstr = (unsigned char *)string_value(newstr);
+ for (i = 0; i < len; i++)
+ nstr[i] = uppers[(int)ostr[i]];
+
+ return(newstr);
+}
+
+static s7_pointer g_string_upcase(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_upcase "(string-upcase str) returns the upper case version of str."
+ #define Q_string_upcase pcl_s
+ return(c_string_upcase(sc, car(args)));
}
+PF_TO_PF(string_upcase, c_string_upcase)
-static s7_pointer format_to_output(s7_scheme *sc, s7_pointer out_loc, const char *in_str, s7_pointer args)
+
+unsigned int s7_string_length(s7_pointer str)
{
- s7_pointer result;
+ return(string_length(str));
+}
- if ((!in_str) || (!(*in_str)))
- {
- if (args != sc->NIL)
- return(s7_error(sc,
- sc->FORMAT_ERROR,
- make_list_2(sc, make_protected_string(sc, "format control string is null, but there are other arguments: ~A"), args)));
- return(make_protected_string(sc, ""));
- }
- result = make_string_uncopied(sc, format_to_c_string(sc, in_str, args, NULL));
+/* -------------------------------- string-ref -------------------------------- */
+static s7_pointer string_ref_1(s7_scheme *sc, s7_pointer strng, s7_pointer index)
+{
+ char *str;
+ s7_int ind;
- if (out_loc != sc->F)
- s7_display(sc, result, out_loc);
+ if (!s7_is_integer(index))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, index, cons(sc, index, sc->NIL))))
+ method_or_bust(sc, index, sc->STRING_REF, list_2(sc, strng, index), T_INTEGER, 2);
+ index = p;
+ }
+ ind = s7_integer(index);
+ if (ind < 0)
+ return(wrong_type_argument_with_type(sc, sc->STRING_REF, 2, index, A_NON_NEGATIVE_INTEGER));
+ if (ind >= string_length(strng))
+ return(out_of_range(sc, sc->STRING_REF, small_int(2), index, ITS_TOO_LARGE));
- return(result);
+ str = string_value(strng);
+ return(s7_make_character(sc, ((unsigned char *)str)[ind]));
}
-static s7_pointer g_format(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_ref(s7_scheme *sc, s7_pointer args)
{
- #define H_format "(format out str . args) substitutes args into str sending the result to out. Most of \
-s7's format directives are taken from CL: ~% = newline, ~& = newline if the preceding output character was \
-no a newline, ~~ = ~, ~<newline> trims white space, ~* skips an argument, ~^ exits {} iteration if the arg list is exhausted, \
-~nT spaces over to column n, ~A prints a representation of any object, ~S is the same, but puts strings in double quotes, \
-~C prints a character, numbers are handled by ~F, ~E, ~G, ~B, ~O, ~D, and ~X with preceding numbers giving \
-spacing (and spacing character) and precision. ~{ starts an embedded format directive which is ended by ~}: \n\
-\n\
- >(format #f \"dashed: ~{~A~^-~}\" '(1 2 3))\n\
- \"dashed: 1-2-3\"\n\
-\n\
-~P inserts \"s\" if the current argument is not 1 or 1.0 (use ~@P for \"ies\" or \"y\").\n\
-~B is number->string in base 2, ~O in base 8, ~D base 10, ~X base 16,\n\
-~E: (format #f \"~E\" 100.1) -> \"1.001000e+02\" (%e in C)\n\
-~F: (format #f \"~F\" 100.1) -> \"100.100000\" (%f in C)\n\
-~G: (format #f \"~G\" 100.1) -> \"100.1\" (%g in C)"
+ s7_pointer strng, index, p;
+ char *str;
+ s7_int ind;
- s7_pointer pt;
- pt = car(args);
+ #define H_string_ref "(string-ref str index) returns the character at the index-th element of the string str"
+ #define Q_string_ref s7_make_signature(sc, 3, sc->IS_CHAR, sc->IS_STRING, sc->IS_INTEGER)
- if (s7_is_string(pt))
- return(format_to_output(sc, sc->F, s7_string(pt), cdr(args)));
+ strng = car(args);
+ if (!is_string(strng))
+ method_or_bust(sc, strng, sc->STRING_REF, args, T_STRING, 1);
- if (!s7_is_string(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "format control string,", 2, cadr(args), "a string"));
-
- if (!((s7_is_boolean(pt)) || /* #f or #t */
- ((is_output_port(pt)) && /* (current-output-port) or call-with-open-file arg, etc */
- (!port_is_closed(pt)))))
- return(s7_wrong_type_arg_error(sc, "format", 1, pt, "#f, #t, or an open output port"));
+ index = cadr(args);
+ if (!s7_is_integer(index))
+ {
+ if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
+ method_or_bust(sc, index, sc->STRING_REF, args, T_INTEGER, 2);
+ index = p;
+ }
+ ind = s7_integer(index);
+ if (ind < 0)
+ return(wrong_type_argument_with_type(sc, sc->STRING_REF, 2, index, A_NON_NEGATIVE_INTEGER));
+ if (ind >= string_length(strng))
+ return(out_of_range(sc, sc->STRING_REF, small_int(2), index, ITS_TOO_LARGE));
- return(format_to_output(sc, (pt == sc->T) ? sc->output_port : pt, s7_string(cadr(args)), cddr(args)));
+ str = string_value(strng);
+ return(s7_make_character(sc, ((unsigned char *)str)[ind]));
}
-
-const char *s7_format(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_string_ref(s7_scheme *sc, s7_pointer str, s7_int ind)
{
- return(s7_string(g_format(sc, args))); /* for the run macro in run.c */
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->STRING_REF, list_2(sc, str, make_integer(sc, ind)), T_STRING, 1);
+ if (ind < 0)
+ return(wrong_type_argument_with_type(sc, sc->STRING_REF, 2, make_integer(sc, ind), A_NON_NEGATIVE_INTEGER));
+ if (ind >= string_length(str))
+ return(out_of_range(sc, sc->STRING_REF, small_int(2), make_integer(sc, ind), ITS_TOO_LARGE));
+ return(s7_make_character(sc, ((unsigned char *)string_value(str))[ind]));
}
+PIF_TO_PF(string_ref, c_string_ref)
-/* -------- trace -------- */
-
-/*
- (define (hiho arg) (if (> arg 0) (+ 1 (hiho (- arg 1))) 0))
- (trace hiho)
- (hiho 3)
-
- [hiho 3]
- [hiho 2]
- [hiho 1]
- [hiho 0]
- 0
- 1
- 2
- 3
-*/
-
-static s7_pointer g_trace(s7_scheme *sc, s7_pointer args)
+/* -------------------------------- string-set! -------------------------------- */
+static s7_pointer g_string_set(s7_scheme *sc, s7_pointer args)
{
- #define H_trace "(trace . args) adds each function in its argument list to the trace list.\
-Each argument can be a function, symbol, macro, or any applicable object: (trace abs '+ v) where v is a vct \
-prints out data about any call on abs or +, and any reference to the vct v. Trace output is sent \
-to the current-output-port. If trace is called without any arguments, everything is traced -- use \
-untrace without arguments to turn this off."
+ #define H_string_set "(string-set! str index chr) sets the index-th element of the string str to the character chr"
+ #define Q_string_set s7_make_signature(sc, 4, sc->IS_CHAR, sc->IS_STRING, sc->IS_INTEGER, sc->IS_CHAR)
- int i;
- s7_pointer x;
+ s7_pointer x, c, index;
+ char *str;
+ s7_int ind;
-#if HAVE_PTHREADS
- sc = sc->orig_sc;
-#endif
+ x = car(args);
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_SET, args, T_STRING, 1);
- if (args == sc->NIL)
+ index = cadr(args);
+ if (!s7_is_integer(index))
{
- (*(sc->trace_all)) = true;
- (*(sc->tracing)) = true;
- return(sc->F);
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
+ method_or_bust(sc, index, sc->STRING_SET, args, T_INTEGER, 2);
+ index = p;
}
-
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if ((!s7_is_symbol(car(x))) &&
- (!is_procedure(car(x))) &&
- (!is_any_macro(car(x))))
- return(s7_wrong_type_arg_error(sc, "trace", i, car(x), "a symbol, a function, or some other applicable object"));
+ ind = s7_integer(index);
+ if (ind < 0)
+ return(wrong_type_argument_with_type(sc, sc->STRING_SET, 2, index, A_NON_NEGATIVE_INTEGER));
+ if (ind >= string_length(x))
+ return(out_of_range(sc, sc->STRING_SET, small_int(2), index, ITS_TOO_LARGE));
+ str = string_value(_TSet(x));
- for (x = args; x != sc->NIL; x = cdr(x))
+ c = caddr(args);
+ if (!s7_is_character(c))
{
- if (s7_is_symbol(car(x)))
- sc->trace_list[sc->trace_top++] = eval_symbol(sc, car(x));
- else sc->trace_list[sc->trace_top++] = car(x);
- if (sc->trace_top >= sc->trace_list_size)
+ if ((is_byte_vector(x)) &&
+ (s7_is_integer(c)))
{
- sc->trace_list_size *= 2;
- sc->trace_list = (s7_pointer *)realloc(sc->trace_list, sc->trace_list_size * sizeof(s7_pointer));
+ s7_int ic; /* not int here! */
+ ic = s7_integer(c);
+ if ((ic < 0) || (ic > 255))
+ return(wrong_type_argument_with_type(sc, sc->STRING_SET, 3, c, AN_UNSIGNED_BYTE));
+ str[ind] = (char)ic;
+ return(c);
}
+ method_or_bust(sc, c, sc->STRING_SET, list_3(sc, x, index, c), T_CHARACTER, 3);
}
- (*(sc->tracing)) = (sc->trace_top > 0);
- return(sc->T);
+ str[ind] = (char)s7_character(c);
+ return(c);
}
-
-static s7_pointer g_untrace(s7_scheme *sc, s7_pointer args)
+static int c_string_tester(s7_scheme *sc, s7_pointer expr)
{
- #define H_untrace "(untrace . args) removes each function in its arg list from the trace list. \
-If untrace is called with no arguments, all functions are removed, turning off all tracing."
- int i, j, ctr;
- s7_pointer x;
-
-#if HAVE_PTHREADS
- sc = sc->orig_sc;
-#endif
-
- if (args == sc->NIL)
- {
- (*(sc->trace_all)) = false;
- for (i = 0; i < sc->trace_top; i++)
- sc->trace_list[i] = sc->NIL;
- sc->trace_top = 0;
- (*(sc->tracing)) = false;
- return(sc->F);
- }
-
- for (ctr = 1, x = args; x != sc->NIL; ctr++, x = cdr(x))
+ s7_pointer a1;
+ a1 = cadr(expr);
+ if (is_symbol(a1))
{
- s7_pointer value;
- if (s7_is_symbol(car(x)))
- value = eval_symbol(sc, car(x));
- else
+ s7_pointer table;
+ table = s7_slot(sc, a1);
+ if ((is_slot(table)) &&
+ ((is_immutable_symbol(a1)) || (!is_stepper(table))) &&
+ (is_string(slot_value(table))))
{
- if ((is_procedure(car(x))) ||
- (is_any_macro(car(x))))
- value = car(x);
- else return(s7_wrong_type_arg_error(sc, "untrace", ctr, car(x), "a symbol or procedure")); /* (untrace "hi") */
+ s7_pointer a2;
+ s7_xf_store(sc, slot_value(table));
+ a2 = caddr(expr);
+ if (is_symbol(a2))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, a2);
+ if ((is_slot(slot)) &&
+ (is_integer(slot_value(slot))))
+ {
+ s7_xf_store(sc, slot);
+ return(TEST_SS);
+ }
+ }
+ else
+ {
+ if (s7_arg_to_if(sc, a1))
+ return(TEST_SI);
+ }
+ return(TEST_SQ);
}
- for (i = 0; i < sc->trace_top; i++)
- if (value == sc->trace_list[i])
- sc->trace_list[i] = sc->NIL;
}
-
- /* now collapse list and reset trace_top (and possibly tracing) */
- for (i = 0, j = 0; i < sc->trace_top; i++)
- if (sc->trace_list[i] != sc->NIL)
- sc->trace_list[j++] = sc->trace_list[i];
-
- sc->trace_top = j;
- (*(sc->tracing)) = (sc->trace_top > 0);
- return(sc->T);
+ return(TEST_NO_S);
}
+static s7_pointer c_string_set_s(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
+{
+ if (!s7_is_character(val))
+ method_or_bust(sc, val, sc->STRING_SET, list_3(sc, vec, make_integer(sc, index), val), T_CHARACTER, 3);
+ if ((index < 0) ||
+ (index >= string_length(vec)))
+ return(out_of_range(sc, sc->STRING_SET, small_int(2), make_integer(sc, index), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
-#if HAVE_PTHREADS
- static pthread_mutex_t trace_lock = PTHREAD_MUTEX_INITIALIZER;
-#endif
+ string_value(vec)[index] = (char)character(val);
+ return(val);
+}
-static void trace_apply(s7_scheme *sc)
+static s7_pointer c_string_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
{
- int i;
- bool trace_it = false;
+ if (!s7_is_string(vec))
+ method_or_bust(sc, vec, sc->STRING_SET, set_plist_3(sc, vec, make_integer(sc, index), val), T_STRING, 1);
+ return(c_string_set_s(sc, vec, index, val));
+}
-#if HAVE_PTHREADS
- pthread_mutex_lock(&trace_lock);
-#endif
+PIPF_TO_PF(string_set, c_string_set_s, c_string_set, c_string_tester)
- if (*(sc->trace_all))
- trace_it = true;
- else
- {
- for (i = 0; i < sc->trace_top; i++)
- if (sc->code == sc->trace_list[i])
- {
- trace_it = true;
- break;
- }
- }
- if (trace_it)
- {
- int k, len;
- char *tmp1, *tmp2, *str;
- push_stack(sc, opcode(OP_TRACE_RETURN), sc->code, sc->NIL);
- tmp1 = s7_object_to_c_string(sc, sc->code);
- tmp2 = s7_object_to_c_string(sc, sc->args);
+/* -------------------------------- string-append -------------------------------- */
+static s7_pointer g_string_append_1(s7_scheme *sc, s7_pointer args, bool use_temp)
+{
+ int len = 0;
+ s7_pointer x, newstr;
+ char *pos;
- len = safe_strlen(tmp2);
- tmp2[0] = ' ';
- tmp2[len - 1] = ']';
-
- len += (safe_strlen(tmp1) + sc->trace_depth + 64);
- str = (char *)calloc(len, sizeof(char));
-
- for (k = 0; k < sc->trace_depth; k++) str[k] = ' ';
- str[k] = '[';
- strcat(str, tmp1);
- strcat(str, tmp2);
- free(tmp1);
- free(tmp2);
-
-#if HAVE_PTHREADS
- if (sc->thread_id != 0) /* main thread */
+ if (is_null(args))
+ return(s7_make_string_with_length(sc, "", 0));
+
+ /* get length for new string */
+ for (x = args; is_not_null(x); x = cdr(x))
+ {
+ s7_pointer p;
+ p = car(x);
+ if (!is_string(p))
{
- char *tmp3;
- tmp3 = (char *)calloc(64, sizeof(char));
- snprintf(tmp3, 64, " (thread %d)", sc->thread_id);
- strcat(str, tmp3);
- free(tmp3);
+ /* look for string-append and if found, cobble up a plausible intermediate call */
+ if (has_methods(p))
+ {
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, p), sc->STRING_APPEND);
+ if (func != sc->UNDEFINED)
+ {
+ s7_pointer y;
+ if (len == 0)
+ return(s7_apply_function(sc, func, args));
+ newstr = make_empty_string(sc, len, 0);
+ for (pos = string_value(newstr), y = args; y != x; pos += string_length(car(y)), y = cdr(y))
+ memcpy(pos, string_value(car(y)), string_length(car(y)));
+ return(s7_apply_function(sc, func, cons(sc, newstr, x)));
+ }
+ }
+ return(wrong_type_argument(sc, sc->STRING_APPEND, position_of(x, args), p, T_STRING));
}
-#endif
-
- strcat(str, "\n");
- write_string(sc, str, sc->output_port);
- free(str);
-
- sc->trace_depth++;
-
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&trace_lock);
-#endif
-
- if (hook_functions(sc->trace_hook) != sc->NIL)
- {
- push_stack(sc, opcode(OP_TRACE_HOOK_QUIT), sc->args, sc->code); /* restore current state after dealing with the trace hook func */
- /* we have to turn off tracing while evaluating the trace hook functions
- */
- (*(sc->tracing)) = false;
- s7_hook_apply(sc, sc->trace_hook, make_list_2(sc, sc->code, sc->args));
+ len += string_length(p);
+ }
- /* it would be nice if *trace-hook* could return #f to turn off trace printout.
- * then it could be used (more cleanly) for a call-history list (a circular list)
- */
- }
+ if (use_temp)
+ {
+ newstr = sc->tmp_strs[0];
+ prepare_temporary_string(sc, len + 1, 0);
+ string_length(newstr) = len;
+ string_value(newstr)[len] = 0;
}
-#if HAVE_PTHREADS
- else pthread_mutex_unlock(&trace_lock);
-#endif
-}
+ else
+ {
+ /* store the contents of the argument strings into the new string */
+ newstr = make_empty_string(sc, len, 0);
+ }
+ for (pos = string_value(newstr), x = args; is_not_null(x); pos += string_length(car(x)), x = cdr(x))
+ memcpy(pos, string_value(car(x)), string_length(car(x)));
+ if (is_byte_vector(car(args)))
+ set_byte_vector(newstr);
-static void trace_return(s7_scheme *sc)
-{
- int k, len;
- char *str, *tmp;
+ return(newstr);
+}
-#if HAVE_PTHREADS
- pthread_mutex_lock(&trace_lock);
-#endif
+static s7_pointer g_string_append(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_append "(string-append str1 ...) appends all its string arguments into one string"
+ #define Q_string_append pcl_s
+ return(g_string_append_1(sc, args, false));
+}
- tmp = s7_object_to_c_string(sc, sc->value);
+static s7_pointer string_append_to_temp;
+static s7_pointer g_string_append_to_temp(s7_scheme *sc, s7_pointer args)
+{
+ return(g_string_append_1(sc, args, true));
+}
- len = sc->trace_depth + safe_strlen(tmp) + 3;
- str = (char *)calloc(len, sizeof(char));
- for (k = 0; k < sc->trace_depth; k++) str[k] = ' ';
- strcat(str, tmp);
- strcat(str, "\n");
- free(tmp);
+#if (!WITH_PURE_S7)
+static s7_pointer g_string_copy(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_copy "(string-copy str) returns a copy of its string argument"
+ #define Q_string_copy pcl_s
+ s7_pointer p;
+ p = car(args);
+ if (!is_string(p))
+ method_or_bust(sc, p, sc->STRING_COPY, args, T_STRING, 1);
+ return(s7_make_string_with_length(sc, string_value(p), string_length(p)));
+}
+#endif
- write_string(sc, str, sc->output_port);
- free(str);
- sc->trace_depth--;
- if (sc->trace_depth < 0) sc->trace_depth = 0;
+/* -------------------------------- substring -------------------------------- */
+static s7_pointer start_and_end(s7_scheme *sc, s7_pointer caller, s7_pointer fallback,
+ s7_pointer start_and_end_args, s7_pointer args, int position, s7_int *start, s7_int *end)
+{
+ /* we assume that *start=0 and *end=length, that end is "exclusive"
+ * return true if the start/end points are not changed.
+ */
+ s7_pointer pstart, pend, p;
+ s7_int index;
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&trace_lock);
+#if DEBUGGING
+ if (is_null(start_and_end_args))
+ {
+ fprintf(stderr, "start_and_end args is null\n");
+ return(sc->GC_NIL);
+ }
#endif
-}
-
-
+ pstart = car(start_and_end_args);
+ if (!s7_is_integer(pstart))
+ {
+ if (!s7_is_integer(p = check_values(sc, pstart, start_and_end_args)))
+ {
+ check_two_methods(sc, pstart, caller, fallback, args);
+ return(wrong_type_argument(sc, caller, position, pstart, T_INTEGER));
+ }
+ else pstart = p;
+ }
+ index = s7_integer(pstart);
+ if ((index < 0) ||
+ (index > *end)) /* *end == length here */
+ return(out_of_range(sc, caller, small_int(position), pstart, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+ *start = index;
-/* -------- error handlers -------- */
+ if (is_null(cdr(start_and_end_args)))
+ return(sc->GC_NIL);
-static const char *type_name(s7_pointer arg)
-{
- switch (type(arg))
+ pend = cadr(start_and_end_args);
+ if (!s7_is_integer(pend))
{
- case T_NIL: return("nil");
- case T_UNTYPED: return("untyped");
- case T_BOOLEAN: return("boolean");
- case T_STRING: return("string");
- case T_SYMBOL: return("symbol");
- case T_PAIR: return("pair");
- case T_CLOSURE: return("closure");
- case T_CLOSURE_STAR: return("closure*");
- case T_GOTO: return("goto");
- case T_CONTINUATION: return("continuation");
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- case T_C_LST_ARGS_FUNCTION:
- case T_C_ANY_ARGS_FUNCTION:
- case T_C_FUNCTION: return("function");
- case T_C_MACRO: return("macro");
- case T_C_POINTER: return("c-pointer");
- case T_CHARACTER: return("character");
- case T_VECTOR: return("vector");
- case T_BACRO:
- case T_MACRO: return("macro");
- case T_CATCH: return("catch");
- case T_DYNAMIC_WIND: return("dynamic-wind");
- case T_HASH_TABLE: return("hash-table");
- case T_S_OBJECT: return(object_types[s_object_type(arg)].name);
- case T_C_OBJECT: return(object_types[c_object_type(arg)].name);
- case T_HOOK: return("hook");
-
- case T_INPUT_PORT:
- {
- if (is_file_port(arg))
- return("input file port");
- if (is_string_port(arg))
- return("input string port");
- return("input port");
- }
-
- case T_OUTPUT_PORT:
- {
- if (is_file_port(arg))
- return("output file port");
- if (is_string_port(arg))
- return("output string port");
- return("output port");
- }
-
- case T_NUMBER:
- {
- switch (number_type(arg))
- {
- case NUM_INT: return("integer");
- case NUM_RATIO: return("ratio");
- case NUM_REAL:
- case NUM_REAL2: return("real");
- default: return("complex number"); /* "a complex" doesn't sound right */
- }
- }
+ if (!s7_is_integer(p = check_values(sc, pend, cdr(start_and_end_args))))
+ {
+ check_two_methods(sc, pend, caller, fallback,
+ (position == 2) ? list_3(sc, car(args), pstart, pend) : list_4(sc, car(args), cadr(args), pstart, pend));
+ return(wrong_type_argument(sc, caller, position + 1, pend, T_INTEGER));
+ }
+ else pend = p;
}
- return("messed up object");
+ index = s7_integer(pend);
+ if ((index < *start) ||
+ (index > *end))
+ return(out_of_range(sc, caller, small_int(position + 1), pend, (index < *start) ? ITS_TOO_SMALL : ITS_TOO_LARGE));
+ *end = index;
+ return(sc->GC_NIL);
}
-s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr)
+static s7_pointer g_substring(s7_scheme *sc, s7_pointer args)
{
- /* info list is '(format_string caller arg_n arg type_name descr) */
- if (arg_n < 0) arg_n = 0;
+ #define H_substring "(substring str start (end (length str))) returns the portion of the string str between start and \
+end: (substring \"01234\" 1 2) -> \"1\""
+ #define Q_substring s7_make_circular_signature(sc, 2, 3, sc->IS_STRING, sc->IS_STRING, sc->IS_INTEGER)
- if (arg_n > 0)
+ s7_pointer x, str;
+ s7_int start = 0, end;
+ int len;
+ char *s;
+
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->SUBSTRING, args, T_STRING, 1);
+
+ end = string_length(str);
+ if (!is_null(cdr(args)))
{
- s7_list_set(sc, sc->WRONG_TYPE_ARG_INFO, 1, make_protected_string(sc, caller));
- s7_list_set(sc, sc->WRONG_TYPE_ARG_INFO, 2, (arg_n < NUM_SMALL_INTS) ? small_int(arg_n) : s7_make_integer(sc, arg_n));
- s7_list_set(sc, sc->WRONG_TYPE_ARG_INFO, 3, arg);
- s7_list_set(sc, sc->WRONG_TYPE_ARG_INFO, 4, make_protected_string(sc, type_name(arg)));
- s7_list_set(sc, sc->WRONG_TYPE_ARG_INFO, 5, make_protected_string(sc, descr));
- return(s7_error(sc, sc->WRONG_TYPE_ARG, sc->WRONG_TYPE_ARG_INFO));
+ x = start_and_end(sc, sc->SUBSTRING, NULL, cdr(args), args, 2, &start, &end);
+ if (x != sc->GC_NIL) return(x);
}
- s7_list_set(sc, sc->SIMPLE_WRONG_TYPE_ARG_INFO, 1, make_protected_string(sc, caller));
- s7_list_set(sc, sc->SIMPLE_WRONG_TYPE_ARG_INFO, 2, arg);
- s7_list_set(sc, sc->SIMPLE_WRONG_TYPE_ARG_INFO, 3, make_protected_string(sc, type_name(arg)));
- s7_list_set(sc, sc->SIMPLE_WRONG_TYPE_ARG_INFO, 4, make_protected_string(sc, descr));
- return(s7_error(sc, sc->WRONG_TYPE_ARG, sc->SIMPLE_WRONG_TYPE_ARG_INFO));
+ s = string_value(str);
+ len = (int)(end - start);
+ x = s7_make_string_with_length(sc, (char *)(s + start), len);
+ string_value(x)[len] = 0;
+ return(x);
}
-s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr)
+static s7_pointer substring_to_temp;
+static s7_pointer g_substring_to_temp(s7_scheme *sc, s7_pointer args)
{
- /* info list is '(format_string caller arg_n arg descr) */
- if (arg_n < 0) arg_n = 0;
+ s7_pointer str;
+ s7_int start = 0, end;
- if (arg_n > 0)
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->SUBSTRING, args, T_STRING, 1);
+
+ end = string_length(str);
+ if (!is_null(cdr(args)))
{
- s7_list_set(sc, sc->OUT_OF_RANGE_INFO, 1, make_protected_string(sc, caller));
- s7_list_set(sc, sc->OUT_OF_RANGE_INFO, 2, (arg_n < NUM_SMALL_INTS) ? small_int(arg_n) : s7_make_integer(sc, arg_n));
- s7_list_set(sc, sc->OUT_OF_RANGE_INFO, 3, arg);
- s7_list_set(sc, sc->OUT_OF_RANGE_INFO, 4, make_protected_string(sc, descr));
- return(s7_error(sc, sc->OUT_OF_RANGE, sc->OUT_OF_RANGE_INFO));
+ s7_pointer x;
+ x = start_and_end(sc, sc->SUBSTRING, NULL, cdr(args), args, 2, &start, &end);
+ if (x != sc->GC_NIL) return(x);
}
- s7_list_set(sc, sc->SIMPLE_OUT_OF_RANGE_INFO, 1, make_protected_string(sc, caller));
- s7_list_set(sc, sc->SIMPLE_OUT_OF_RANGE_INFO, 2, arg);
- s7_list_set(sc, sc->SIMPLE_OUT_OF_RANGE_INFO, 3, make_protected_string(sc, descr));
- return(s7_error(sc, sc->OUT_OF_RANGE, sc->SIMPLE_OUT_OF_RANGE_INFO));
+ return(make_temporary_string(sc, (const char *)(string_value(str) + start), (int)(end - start)));
}
-s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args)
+/* -------------------------------- object->string -------------------------------- */
+static use_write_t write_choice(s7_scheme *sc, s7_pointer arg)
{
- return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_2(sc,
- make_protected_string(sc, caller), /* "caller" includes the format directives */
- args)));
+ if (arg == sc->F) return(USE_DISPLAY);
+ if (arg == sc->T) return(USE_WRITE);
+ if (arg == sc->KEY_READABLE) return(USE_READABLE_WRITE);
+ return(USE_WRITE_WRONG);
}
+#define DONT_USE_DISPLAY(Choice) ((Choice == USE_DISPLAY) ? USE_WRITE : Choice)
+
+static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, use_write_t use_write, int *nlen);
-static s7_pointer division_by_zero_error(s7_scheme *sc, const char *caller, s7_pointer arg)
+static s7_pointer g_object_to_string(s7_scheme *sc, s7_pointer args)
{
- return(s7_error(sc, make_symbol(sc, "division-by-zero"),
- make_list_3(sc,
- make_protected_string(sc, "~A: division by zero, ~A"),
- make_protected_string(sc, caller),
- arg)));
-}
+ #define H_object_to_string "(object->string obj (write #t)) returns a string representation of obj."
+ #define Q_object_to_string s7_make_signature(sc, 3, sc->IS_STRING, sc->T, s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_KEYWORD))
+ use_write_t choice;
+ char *str;
+ s7_pointer obj;
+ int len = 0;
-static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *descr, const char *name)
-{
- return(s7_error(sc, make_symbol(sc, "io-error"),
- make_list_4(sc,
- make_protected_string(sc, "~A: ~A ~S"),
- make_protected_string(sc, caller),
- make_protected_string(sc, descr),
- make_protected_string(sc, name))));
+ if (is_not_null(cdr(args)))
+ {
+ choice = write_choice(sc, cadr(args));
+ if (choice == USE_WRITE_WRONG)
+ method_or_bust(sc, cadr(args), sc->OBJECT_TO_STRING, args, T_BOOLEAN, 2);
+ }
+ else choice = USE_WRITE;
+ /* can't use s7_object_to_string here anymore because it assumes use_write arg is a boolean */
+
+ obj = car(args);
+ check_method(sc, obj, sc->OBJECT_TO_STRING, args);
+ str = s7_object_to_c_string_1(sc, obj, choice, &len);
+ if (str)
+ return(make_string_uncopied_with_length(sc, str, len));
+ return(s7_make_string_with_length(sc, "", 0));
}
+static s7_pointer c_object_to_string(s7_scheme *sc, s7_pointer x) {return(g_object_to_string(sc, set_plist_1(sc, x)));}
+PF_TO_PF(object_to_string, c_object_to_string)
+
-void s7_set_error_exiter(s7_scheme *sc, void (*error_exiter)(void))
+/* -------------------------------- string comparisons -------------------------------- */
+static int scheme_strcmp(s7_pointer s1, s7_pointer s2)
{
- sc->error_exiter = error_exiter;
+ /* tricky here because str[i] must be treated as unsigned
+ * (string<? (string (integer->char #xf0)) (string (integer->char #x70)))
+ * also null or lack thereof does not say anything about the string end
+ * so we have to go by its length.
+ */
+ int i, len, len1, len2;
+ char *str1, *str2;
+
+ len1 = string_length(s1);
+ len2 = string_length(s2);
+ if (len1 > len2)
+ len = len2;
+ else len = len1;
+
+ str1 = string_value(s1);
+ str2 = string_value(s2);
+
+ for (i = 0; i < len; i++)
+ if ((unsigned char)(str1[i]) < (unsigned char )(str2[i]))
+ return(-1);
+ else
+ {
+ if ((unsigned char)(str1[i]) > (unsigned char)(str2[i]))
+ return(1);
+ }
+
+ if (len1 < len2)
+ return(-1);
+ if (len1 > len2)
+ return(1);
+ return(0);
}
-static s7_pointer g_dynamic_wind(s7_scheme *sc, s7_pointer args)
+static bool is_string_via_method(s7_scheme *sc, s7_pointer p)
{
- #define H_dynamic_wind "(dynamic-wind init body finish) calls init, then body, then finish, \
-each a function of no arguments, guaranteeing that finish is called even if body is exited"
- s7_pointer p;
+ if (s7_is_string(p))
+ return(true);
+ if (has_methods(p))
+ {
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->IS_STRING);
+ if (f != sc->UNDEFINED)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL))));
+ }
+ return(false);
+}
- if (!is_thunk(sc, car(args)))
- return(s7_wrong_type_arg_error(sc, "dynamic-wind", 1, car(args), "a thunk"));
- if (!is_thunk(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, "dynamic-wind", 2, cadr(args), "a thunk"));
- if (!is_thunk(sc, caddr(args)))
- return(s7_wrong_type_arg_error(sc, "dynamic-wind", 3, caddr(args), "a thunk"));
+static s7_pointer g_string_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+{
+ s7_pointer x, y;
- /* this won't work:
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sym, args, T_STRING, 1);
- (let ((final (lambda (a b c) (list a b c))))
- (dynamic-wind
- (lambda () #f)
- (lambda () (set! final (lambda () (display "in final"))))
- final))
-
- * but why not? 'final' is a thunk by the time it is evaluated.
- * catch (the error handler) is similar.
- *
- * It can't work here because we set up the dynamic_wind_out slot below and
- * even if the thunk check was removed, we'd still be trying to apply the original function.
- */
-
- NEW_CELL(sc, p);
- dynamic_wind_in(p) = car(args);
- dynamic_wind_body(p) = cadr(args);
- dynamic_wind_out(p) = caddr(args);
- dynamic_wind_state(p) = DWIND_INIT;
- set_type(p, T_DYNAMIC_WIND | T_DONT_COPY); /* atom -> don't mark car/cdr, don't copy */
-
- push_stack(sc, opcode(OP_DYNAMIC_WIND), sc->NIL, p); /* args will be the saved result, code = s7_dynwind_t obj */
-
- sc->args = sc->NIL;
- sc->code = car(args);
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
+ {
+ if (!is_string(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (scheme_strcmp(y, car(x)) != val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
+ }
+ y = car(x);
+ }
+ return(sc->T);
}
-/* C-side dynamic-wind would need at least void* context pointer passed to each function,
- * and to fit with the scheme-side stuff above, the functions need to be s7 functions,
- * so I wonder if it could be s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish)
- * and the caller would use the C-closure idea (s7.html) to package up C-side data.
- * Then, the caller would probably assume a return value, requiring s7_call?
- * -> g_dynamic_wind(sc, make_list_3(sc, init, body, finish)) but with eval(sc, OP_APPLY) at end?
- */
-
-static s7_pointer g_catch(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
{
- #define H_catch "(catch tag thunk handler) evaluates thunk; if an error occurs that matches the tag (#t matches all), the handler is called"
- s7_pointer p;
+ s7_pointer x, y;
- /* should this check for a tag that can't possibly be eq? to anything that error might throw? (a string for example)
- */
- if (!is_thunk(sc, cadr(args)))
- return(s7_wrong_type_arg_error(sc, "catch", 2, cadr(args), "a thunk"));
- if (!is_procedure(caddr(args)))
- return(s7_wrong_type_arg_error(sc, "catch", 3, caddr(args), "a procedure"));
-
- NEW_CELL(sc, p);
- catch_tag(p) = car(args);
- catch_goto_loc(p) = s7_stack_top(sc);
- catch_handler(p) = caddr(args);
- set_type(p, T_CATCH | T_DONT_COPY); /* atom -> don't mark car/cdr, don't copy */
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sym, args, T_STRING, 1);
- push_stack(sc, opcode(OP_CATCH), sc->NIL, p);
- sc->args = sc->NIL;
- sc->code = cadr(args);
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->F);
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
+ {
+ if (!is_string(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (scheme_strcmp(y, car(x)) == val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
+ }
+ y = car(x);
+ }
+ return(sc->T);
}
-#if 0
-void s7_catch(s7_scheme *sc, s7_pointer tag, s7_pointer thunk, s7_pointer error_handler)
+static bool scheme_strings_are_equal(s7_pointer x, s7_pointer y)
{
- /* ideally this would return the thunk evaluation value, but that requires s7_call
- */
- g_catch(sc, make_list_3(sc, tag, thunk, error_handler));
+ return((string_length(x) == string_length(y)) &&
+ (strings_are_equal_with_length(string_value(x), string_value(y), string_length(x))));
}
-#endif
-
-/* error reporting info -- save filename and line number */
-
-#define INITIAL_FILE_NAMES_SIZE 8
-static s7_pointer *file_names = NULL;
-static int file_names_size = 0;
-static int file_names_top = -1;
-
-#if HAVE_PTHREADS
-static pthread_mutex_t remember_files_lock = PTHREAD_MUTEX_INITIALIZER;
-#endif
-#define remembered_line_number(Line) (Line & 0xfffff)
-#define remembered_file_name(Line) (((Line >> 20) <= file_names_top) ? file_names[Line >> 20] : sc->F)
-/* this gives room for 4000 files each of 1000000 lines */
+static s7_pointer g_strings_are_equal(s7_scheme *sc, s7_pointer args)
+{
+ #define H_strings_are_equal "(string=? str ...) returns #t if all the string arguments are equal"
+ #define Q_strings_are_equal pcl_bs
+ /* C-based check stops at null, but we can have embedded nulls.
+ * (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2))
+ */
+ s7_pointer x, y;
+ bool happy = true;
-static int remember_file_name(s7_scheme *sc, const char *file)
-{
- int i, old_size = 0;
-#if HAVE_PTHREADS
- pthread_mutex_lock(&remember_files_lock);
-#endif
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_EQ, args, T_STRING, 1);
- file_names_top++;
- if (file_names_top >= file_names_size)
+ for (x = cdr(args); is_pair(x); x = cdr(x))
{
- if (file_names_size == 0)
- {
- file_names_size = INITIAL_FILE_NAMES_SIZE;
- file_names = (s7_pointer *)calloc(file_names_size, sizeof(s7_pointer));
- }
- else
+ s7_pointer p;
+ p = car(x);
+ if (y != p)
{
- old_size = file_names_size;
- file_names_size *= 2;
- file_names = (s7_pointer *)realloc(file_names, file_names_size * sizeof(s7_pointer));
+ if (!is_string(p))
+ method_or_bust(sc, p, sc->STRING_EQ, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (happy)
+ happy = scheme_strings_are_equal(p, y);
}
- for (i = old_size; i < file_names_size; i++)
- file_names[i] = sc->F;
}
- file_names[file_names_top] = s7_make_permanent_string(file);
-
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&remember_files_lock);
-#endif
+ if (!happy)
+ return(sc->F);
+ return(sc->T);
+}
- return(file_names_top);
+static s7_pointer c_string_eq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_EQ, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_EQ, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, ((string_length(x) == string_length(y)) &&
+ (strings_are_equal_with_length(string_value(x), string_value(y), string_length(x))))));
}
+PF2_TO_PF(string_eq, c_string_eq)
-#define ERROR_INFO_DEFAULT sc->F
-#define ERROR_TYPE 0
-#define ERROR_DATA 1
-#define ERROR_CODE 2
-#define ERROR_CODE_LINE 3
-#define ERROR_CODE_FILE 4
-#define ERROR_ENVIRONMENT 5
-#define ERROR_STACK_SIZE 8
-#define ERROR_INFO_SIZE (6 + ERROR_STACK_SIZE)
-/* *error-info* is a vector of 6 or more elements:
- * 0: the error type or tag ('division-by-zero)
- * 1: the message or information passed by the error function
- * 2: if not #f, the code that s7 thinks triggered the error
- * 3: if not #f, the line number of that code
- * 4: if not #f, the file name of that code
- * 5: the environment at the point of the error
- * 6..top: stack enviroment pointers (giving enough info to reconstruct the current call stack), ending in #f
- */
+static s7_pointer g_strings_are_less(s7_scheme *sc, s7_pointer args)
+{
+ #define H_strings_are_less "(string<? str ...) returns #t if all the string arguments are increasing"
+ #define Q_strings_are_less pcl_bs
-/* slightly ugly:
+ return(g_string_cmp(sc, args, -1, sc->STRING_LT));
+}
-(define-macro (cerror . args)
- `(call/cc
- (lambda (continue)
- (apply error continue ',args))))
+static s7_pointer c_string_lt(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_LT, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_LT, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcmp(x, y) == -1));
+}
-;;; now ((vector-ref *error-info* 0)) will continue from the error
+PF2_TO_PF(string_lt, c_string_lt)
-(define (cerror . args)
- (format #t "error: ~A" (car args))
- (if (not (null? (cdr args)))
- (if (and (string? (cadr args))
- (not (null? (cddr args))))
- (let ((str (apply format (cdr args))))
- (format #t "~S~%" str))
- (format #t "~S~%" (cadr args))))
- (format #t "continue? (<cr>=yes) ")
- (let ((val (read-line ())))
- (if (not (char=? (val 0) #\newline))
- (error (car args)))))
-;;; so perhaps wrap the caller-passed stuff in "continue?" etc?
-*/
+static s7_pointer g_strings_are_greater(s7_scheme *sc, s7_pointer args)
+{
+ #define H_strings_are_greater "(string>? str ...) returns #t if all the string arguments are decreasing"
+ #define Q_strings_are_greater pcl_bs
+ return(g_string_cmp(sc, args, 1, sc->STRING_GT));
+}
-static s7_pointer s7_error_1(s7_scheme *sc, s7_pointer type, s7_pointer info, bool exit_eval)
+static s7_pointer c_string_gt(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- int i;
- bool reset_error_hook = false;
- s7_pointer catcher;
- const char *call_name = NULL, *call_file = NULL;
- int call_line = 0;
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_GT, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_GT, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcmp(x, y) == 1));
+}
- /* set up *error-info*, look for a catch that matches 'type', if found
- * call its error-handler, else if *error-hook* is bound, call it,
- * else send out the error info ourselves.
- */
- sc->no_values = 0;
- catcher = sc->F;
+PF2_TO_PF(string_gt, c_string_gt)
- if (sc->s7_call_name)
- {
- call_name = sc->s7_call_name;
- call_file = sc->s7_call_file;
- call_line = sc->s7_call_line;
- sc->s7_call_name = NULL;
- sc->s7_call_file = NULL;
- sc->s7_call_line = -1;
- }
- vector_element(sc->error_info, ERROR_TYPE) = type;
- vector_element(sc->error_info, ERROR_DATA) = info;
- vector_element(sc->error_info, ERROR_CODE) = sc->cur_code;
- vector_element(sc->error_info, ERROR_CODE_LINE) = ERROR_INFO_DEFAULT;
- vector_element(sc->error_info, ERROR_CODE_FILE) = ERROR_INFO_DEFAULT;
- vector_element(sc->error_info, ERROR_ENVIRONMENT) = sc->envir;
- s7_gc_on(sc, true); /* this is in case we were triggered from the sort function -- clumsy! */
+static s7_pointer g_strings_are_geq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_strings_are_geq "(string>=? str ...) returns #t if all the string arguments are equal or decreasing"
+ #define Q_strings_are_geq pcl_bs
- /* currently sc->error_info is shared by all threads, so if two get an error at the same
- * time, could we get a confused error message?
- */
+ return(g_string_cmp_not(sc, args, -1, sc->STRING_GEQ));
+}
- /* (let ((x 32)) (define (h1 a) (* a "hi")) (define (h2 b) (+ b (h1 b))) (h2 1)) */
- if (is_pair(sc->cur_code))
- {
- int line, j, top;
- line = pair_line_number(sc->cur_code);
+static s7_pointer c_string_geq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_GEQ, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_GEQ, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcmp(x, y) != -1));
+}
- if ((line > 0) &&
- (remembered_line_number(line) != 0) &&
- (remembered_file_name(line) != sc->F))
- {
- vector_element(sc->error_info, ERROR_CODE_LINE) = s7_make_integer(sc, remembered_line_number(line));
- vector_element(sc->error_info, ERROR_CODE_FILE) = remembered_file_name(line);
- }
+PF2_TO_PF(string_geq, c_string_geq)
- for (top = s7_stack_top(sc) - 1, j = ERROR_ENVIRONMENT + 1; (top > 0) && (j < ERROR_INFO_SIZE); top -= 4, j++)
- vector_element(sc->error_info, j) = stack_environment(sc->stack, top);
- if (j < ERROR_INFO_SIZE)
- vector_element(sc->error_info, j) = ERROR_INFO_DEFAULT;
- }
- sc->cur_code = ERROR_INFO_DEFAULT;
+static s7_pointer g_strings_are_leq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_strings_are_leq "(string<=? str ...) returns #t if all the string arguments are equal or increasing"
+ #define Q_strings_are_leq pcl_bs
- /* if (!s7_is_continuation(type))... */
+ return(g_string_cmp_not(sc, args, 1, sc->STRING_LEQ));
+}
- /* top is 1 past actual top, top - 1 is op, if op = OP_CATCH, top - 4 is the cell containing the catch struct */
- for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
- {
- opcode_t op;
- s7_pointer x;
+static s7_pointer c_string_leq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_LEQ, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_LEQ, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcmp(x, y) != 1));
+}
- op = (opcode_t)stack_op(sc->stack, i);
- switch (op)
- {
- case OP_DYNAMIC_WIND:
- x = stack_code(sc->stack, i);
- if (dynamic_wind_state(x) == DWIND_BODY)
- {
- dynamic_wind_state(x) = DWIND_FINISH; /* make sure an uncaught error in the exit thunk doesn't cause us to loop */
- push_stack(sc, opcode(OP_EVAL_DONE), sc->args, sc->code);
- sc->args = sc->NIL;
- sc->code = dynamic_wind_out(x);
- eval(sc, OP_APPLY); /* I guess this means no call/cc out of the exit thunk in an error-catching context */
- }
- break;
+PF2_TO_PF(string_leq, c_string_leq)
- case OP_CATCH:
- x = stack_code(sc->stack, i);
- if ((type == sc->T) ||
- (catch_tag(x) == sc->T) ||
- (catch_tag(x) == type))
- {
- catcher = x;
- goto GOT_CATCH;
- }
- break;
- case OP_UNWIND_OUTPUT:
- x = stack_code(sc->stack, i); /* "code" = port that we opened */
- s7_close_output_port(sc, x);
- x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #f */
- if (x != sc->F)
- sc->output_port = x;
- break;
+static s7_pointer string_equal_s_ic, string_equal_2;
+static s7_pointer g_string_equal_s_ic(s7_scheme *sc, s7_pointer args)
+{
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->STRING_EQ, args, T_STRING, 1);
+ return(make_boolean(sc, scheme_strings_are_equal(car(args), cadr(args))));
+}
- case OP_UNWIND_INPUT:
- s7_close_input_port(sc, stack_code(sc->stack, i)); /* "code" = port that we opened */
- sc->input_port = stack_args(sc->stack, i); /* "args" = port that we shadowed */
- sc->input_is_file = (is_file_port(sc->input_port));
- break;
+static s7_pointer g_string_equal_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->STRING_EQ, args, T_STRING, 1);
+ if (!is_string(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->STRING_EQ, args, T_STRING, 2);
+ return(make_boolean(sc, scheme_strings_are_equal(car(args), cadr(args))));
+}
- case OP_READ_DONE: /* perhaps an error during (read) */
- pop_input_port(sc);
- break;
- case OP_EVAL_STRING_1: /* perhaps an error happened before we could push the OP_EVAL_STRING_2 */
- case OP_EVAL_STRING_2:
- s7_close_input_port(sc, sc->input_port);
- pop_input_port(sc);
- break;
+static s7_pointer string_less_2;
+static s7_pointer g_string_less_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->STRING_LT, args, T_STRING, 1);
+ if (!is_string(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->STRING_LT, args, T_STRING, 2);
+ return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == -1));
+}
- case OP_BARRIER:
- if (is_input_port(stack_args(sc->stack, i))) /* (eval-string "'(1 .)") */
- {
- if (sc->input_port == stack_args(sc->stack, i))
- pop_input_port(sc);
- s7_close_input_port(sc, stack_args(sc->stack, i));
- }
- break;
- case OP_DEACTIVATE_GOTO:
- call_exit_active(stack_args(sc->stack, i)) = false;
- break;
+static s7_pointer string_greater_2;
+static s7_pointer g_string_greater_2(s7_scheme *sc, s7_pointer args)
+{
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->STRING_GT, args, T_STRING, 1);
+ if (!is_string(cadr(args)))
+ method_or_bust(sc, cadr(args), sc->STRING_GT, args, T_STRING, 2);
+ return(make_boolean(sc, scheme_strcmp(car(args), cadr(args)) == 1));
+}
- case OP_TRACE_RETURN:
- sc->trace_depth--;
- if (sc->trace_depth < 0) sc->trace_depth = 0;
- break;
- /* perhaps also OP_LOAD_CLOSE_AND_POP_IF_EOF
- * currently an error during a nested load stops all loads
- */
+#if (!WITH_PURE_S7)
- case OP_ERROR_HOOK_QUIT:
- hook_functions(sc->error_hook) = stack_code(sc->stack, i);
+static int scheme_strcasecmp(s7_pointer s1, s7_pointer s2)
+{
+ /* same as scheme_strcmp -- watch out for unwanted sign! and lack of trailing null (length sets string end).
+ */
+ int i, len, len1, len2;
+ unsigned char *str1, *str2;
- /* apparently there was an error during *error-hook* evaluation, but Rick wants the hook re-established anyway */
- reset_error_hook = true;
- /* avoid infinite loop -- don't try to (re-)evaluate (buggy) *error-hook*! */
- break;
+ len1 = string_length(s1);
+ len2 = string_length(s2);
+ if (len1 > len2)
+ len = len2;
+ else len = len1;
- default:
- break;
- }
- }
-
-GOT_CATCH:
- if (catcher != sc->F)
- {
- int loc;
+ str1 = (unsigned char *)string_value(s1);
+ str2 = (unsigned char *)string_value(s2);
- sc->args = make_list_2(sc, type, info);
- sc->code = catch_handler(catcher);
- loc = catch_goto_loc(catcher);
- sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
+ for (i = 0; i < len; i++)
+ if (uppers[(int)str1[i]] < uppers[(int)str2[i]])
+ return(-1);
+ else
+ {
+ if (uppers[(int)str1[i]] > uppers[(int)str2[i]])
+ return(1);
+ }
- /* if user (i.e. yers truly!) copies/pastes the preceding lambda () into the
- * error handler portion of the catch, he gets the inexplicable message:
- * ;(): too many arguments: (a1 ())
- * when this apply tries to call the handler. So, we need a special case
- * error check here!
- */
- if (!args_match(sc, sc->code, 2))
- return(s7_wrong_number_of_args_error(sc, "catch error handler has wrong number of args: ~A", sc->args));
+ if (len1 < len2)
+ return(-1);
+ if (len1 > len2)
+ return(1);
+ return(0);
+}
- sc->op = OP_APPLY;
- /* explicit eval needed if s7_call called into scheme where a caught error occurred (ex6 in exs7.c)
- * but putting it here (via eval(sc, OP_APPLY)) means the C stack is not cleared correctly in non-s7-call cases,
- * so defer it until s7_call
- */
- }
- else
- {
- /* (set! *error-hook* (list (lambda (tag args) (apply format (cons #t args))))) */
+static bool scheme_strequal_ci(s7_pointer s1, s7_pointer s2)
+{
+ /* same as scheme_strcmp -- watch out for unwanted sign! */
+ int i, len, len2;
+ unsigned char *str1, *str2;
- if ((!reset_error_hook) &&
- (is_pair(hook_functions(sc->error_hook))))
- {
- s7_pointer error_list;
- /* (set! (hook-functions *error-hook*) (list (lambda args (format *stderr* "got error ~A~%" args)))) */
+ len = string_length(s1);
+ len2 = string_length(s2);
+ if (len != len2)
+ return(false);
- error_list = hook_functions(sc->error_hook);
- hook_functions(sc->error_hook) = sc->NIL;
- /* if the *error-hook* functions trigger an error, we had better not have *error-hook* still set! */
+ str1 = (unsigned char *)string_value(s1);
+ str2 = (unsigned char *)string_value(s2);
- push_stack(sc, opcode(OP_ERROR_HOOK_QUIT), sc->NIL, error_list); /* restore *error-hook* upon successful (or any!) evaluation */
- sc->args = make_list_2(sc, type, info);
- sc->code = error_list;
- /* push_stack(sc, opcode(OP_HOOK_APPLY), sc->args, sc->code); */
+ for (i = 0; i < len; i++)
+ if (uppers[(int)str1[i]] != uppers[(int)str2[i]])
+ return(false);
+ return(true);
+}
- /* if we drop into the longjmp below, the hook functions are not called!
- * OP_ERROR_HOOK_QUIT performs the longjmp, so it should be safe to go to eval.
- */
- eval(sc, OP_HOOK_APPLY);
- }
- else
- {
- /* if info is not a list, send object->string to current error port,
- * else assume car(info) is a format control string, and cdr(info) are its args
- *
- * if at all possible, get some indication of where we are!
- */
- s7_pointer x, error_port;
- error_port = s7_current_error_port(sc);
- if ((!s7_is_list(sc, info)) ||
- (!s7_is_string(car(info))))
- format_to_output(sc, error_port, "\n;~A ~A", make_list_2(sc, type, info));
- else
- {
- const char *carstr;
- int i, len;
- bool use_format = false;
-
- /* it's possible that the error string is just a string -- not intended for format */
- carstr = s7_string(car(info));
- len = string_length(car(info));
- for (i = 0; i < len; i++)
- if (carstr[i] == '~')
- {
- use_format = true;
- break;
- }
-
- if (use_format)
- {
- char *errstr;
- len += 8;
- errstr = (char *)malloc(len * sizeof(char));
- snprintf(errstr, len, "\n;%s", s7_string(car(info)));
- format_to_output(sc, error_port, errstr, cdr(info));
- free(errstr);
- }
- else format_to_output(sc, error_port, "\n;~A ~A", make_list_2(sc, type, info));
- }
-
- /* now display location and \n at end */
-
- if ((is_input_port(sc->input_port)) &&
- (port_file(sc->input_port) != stdin))
+static s7_pointer g_string_ci_cmp(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+{
+ s7_pointer x, y;
+
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sym, args, T_STRING, 1);
+
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
+ {
+ if (!is_string(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (val == 0)
+ {
+ if (!scheme_strequal_ci(y, car(x)))
{
- const char *filename = NULL;
- int line;
-
- filename = port_filename(sc->input_port);
- line = port_line_number(sc->input_port);
-
- if (filename)
- format_to_output(sc, error_port, ", ~A[~D]",
- make_list_2(sc, make_protected_string(sc, filename), s7_make_integer(sc, line)));
- else
- {
- if (line > 0)
- format_to_output(sc, error_port, ", line ~D",
- make_list_1(sc, s7_make_integer(sc, line)));
- }
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
}
- else
+ }
+ else
+ {
+ if (scheme_strcasecmp(y, car(x)) != val)
{
- if ((call_file != NULL) &&
- (call_name != NULL) &&
- (call_line >= 0))
- {
- format_to_output(sc, error_port, ", ~A ~A[~D]",
- make_list_3(sc,
- make_protected_string(sc, call_name),
- make_protected_string(sc, call_file),
- s7_make_integer(sc, call_line)));
- }
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
}
- s7_newline(sc, error_port);
+ }
+ y = car(x);
+ }
+ return(sc->T);
+}
- if (is_pair(vector_element(sc->error_info, ERROR_CODE)))
- {
- format_to_output(sc, error_port, "; ~A",
- make_list_1(sc, vector_element(sc->error_info, ERROR_CODE)));
- s7_newline(sc, error_port);
- if (s7_is_string(vector_element(sc->error_info, ERROR_CODE_FILE)))
- {
- format_to_output(sc, error_port, "; [~S, line ~D]",
- make_list_2(sc,
- vector_element(sc->error_info, ERROR_CODE_FILE),
- vector_element(sc->error_info, ERROR_CODE_LINE)));
- s7_newline(sc, error_port);
- }
- }
-
- /* look for __func__ in the error environment etc
- */
- x = find_symbol(sc, vector_element(sc->error_info, ERROR_ENVIRONMENT), sc->__FUNC__); /* returns nil if no __func__ */
+static s7_pointer g_string_ci_cmp_not(s7_scheme *sc, s7_pointer args, int val, s7_pointer sym)
+{
+ s7_pointer x, y;
- if ((is_pair(x)) &&
- (error_port != sc->F))
- {
- s7_display(sc, make_protected_string(sc, "; "), error_port);
- s7_display(sc, cdr(x), error_port);
- s7_newline(sc, error_port);
- }
-
- if ((exit_eval) &&
- (sc->error_exiter))
- (*(sc->error_exiter))();
+ y = car(args);
+ if (!is_string(y))
+ method_or_bust(sc, y, sym, args, T_STRING, 1);
- /* if (s7_is_continuation(type))
- * go into repl here with access to continuation? Or expect *error-handler* to deal with it?
- */
- sc->value = type;
- stack_reset(sc);
- sc->op = OP_ERROR_QUIT;
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
+ {
+ if (!is_string(car(x)))
+ method_or_bust(sc, car(x), sym, cons(sc, y, x), T_STRING, position_of(x, args));
+ if (scheme_strcasecmp(y, car(x)) == val)
+ {
+ for (y = cdr(x); is_pair(y); y = cdr(y))
+ if (!is_string_via_method(sc, car(y)))
+ return(wrong_type_argument(sc, sym, position_of(y, args), car(y), T_STRING));
+ return(sc->F);
}
+ y = car(x);
}
+ return(sc->T);
+}
- if (sc->longjmp_ok)
- {
- longjmp(sc->goto_start, 1); /* this is trying to clear the C stack back to some clean state */
- }
- return(type);
+static s7_pointer g_strings_are_ci_equal(s7_scheme *sc, s7_pointer args)
+{
+ #define H_strings_are_ci_equal "(string-ci=? str ...) returns #t if all the string arguments are equal, ignoring case"
+ #define Q_strings_are_ci_equal pcl_bs
+ return(g_string_ci_cmp(sc, args, 0, sc->STRING_CI_EQ));
}
-
-s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
+static s7_pointer c_string_ci_eq(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- return(s7_error_1(sc, type, info, false));
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_CI_EQ, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_CI_EQ, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcasecmp(x, y) == 0));
}
+PF2_TO_PF(string_ci_eq, c_string_ci_eq)
+
-s7_pointer s7_error_and_exit(s7_scheme *sc, s7_pointer type, s7_pointer info)
+static s7_pointer g_strings_are_ci_less(s7_scheme *sc, s7_pointer args)
{
- return(s7_error_1(sc, type, info, true));
+ #define H_strings_are_ci_less "(string-ci<? str ...) returns #t if all the string arguments are increasing, ignoring case"
+ #define Q_strings_are_ci_less pcl_bs
+ return(g_string_ci_cmp(sc, args, -1, sc->STRING_CI_LT));
}
-
-static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+static s7_pointer c_string_ci_lt(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- /* the operator type is needed here else the error message is confusing:
- * (apply '+ (list 1 2))) -> ;attempt to apply + to (1 2)?
- */
- if (obj == sc->NIL)
- return(s7_error(sc, sc->SYNTAX_ERROR, make_list_2(sc, make_protected_string(sc, "attempt to apply nil to ~S?"), args)));
- return(s7_error(sc, sc->SYNTAX_ERROR,
- make_list_4(sc,
- make_protected_string(sc, "attempt to apply the ~A ~S to ~S?"),
- make_protected_string(sc, type_name(obj)),
- obj,
- args)));
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_CI_LT, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_CI_LT, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcasecmp(x, y) == -1));
}
+PF2_TO_PF(string_ci_lt, c_string_ci_lt)
-static s7_pointer eval_error(s7_scheme *sc, const char *errmsg, s7_pointer obj)
+
+static s7_pointer g_strings_are_ci_greater(s7_scheme *sc, s7_pointer args)
{
- return(s7_error(sc, sc->SYNTAX_ERROR, make_list_2(sc, make_protected_string(sc, errmsg), obj)));
+ #define H_strings_are_ci_greater "(string-ci>? str ...) returns #t if all the string arguments are decreasing, ignoring case"
+ #define Q_strings_are_ci_greater pcl_bs
+ return(g_string_ci_cmp(sc, args, 1, sc->STRING_CI_GT));
}
-
-static s7_pointer eval_error_with_name(s7_scheme *sc, const char *errmsg, s7_pointer obj)
+static s7_pointer c_string_ci_gt(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- return(s7_error(sc, sc->SYNTAX_ERROR,
- make_list_3(sc,
- make_protected_string(sc, errmsg),
- make_protected_string(sc, op_names[(int)(sc->op)]),
- obj)));
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_CI_GT, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_CI_GT, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcasecmp(x, y) == 1));
}
+PF2_TO_PF(string_ci_gt, c_string_ci_gt)
+
-static s7_pointer eval_error_no_arg(s7_scheme *sc, const char *errmsg)
+static s7_pointer g_strings_are_ci_geq(s7_scheme *sc, s7_pointer args)
{
- return(s7_error(sc, sc->SYNTAX_ERROR, make_list_1(sc, make_protected_string(sc, errmsg))));
+ #define H_strings_are_ci_geq "(string-ci>=? str ...) returns #t if all the string arguments are equal or decreasing, ignoring case"
+ #define Q_strings_are_ci_geq pcl_bs
+ return(g_string_ci_cmp_not(sc, args, -1, sc->STRING_CI_GEQ));
}
-
-static s7_pointer read_error(s7_scheme *sc, const char *errmsg)
+static s7_pointer c_string_ci_geq(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- /* reader errors happen before the evaluator gets involved, so forms such as:
- * (catch #t (lambda () (car '( . ))) (lambda arg 'error))
- * do not catch the error if we simply signal an error when we encounter it.
- */
- char *msg;
- int len;
- s7_pointer pt;
- pt = sc->input_port;
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_CI_GEQ, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_CI_GEQ, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcasecmp(x, y) != -1));
+}
- /* make an heroic effort to find where we slid off the tracks */
+PF2_TO_PF(string_ci_geq, c_string_ci_geq)
- if (is_string_port(sc->input_port))
- {
- #define QUOTE_SIZE 40
- int i, j, start = 0, end, slen;
- char *recent_input = NULL;
- /* we can run off the end in cases like (eval-string "(. . ,.)") or (eval-string " (@ . ,.)") */
- if (port_string_point(pt) >= port_string_length(pt))
- port_string_point(pt) = port_string_length(pt) - 1;
+static s7_pointer g_strings_are_ci_leq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_strings_are_ci_leq "(string-ci<=? str ...) returns #t if all the string arguments are equal or increasing, ignoring case"
+ #define Q_strings_are_ci_leq pcl_bs
+ return(g_string_ci_cmp_not(sc, args, 1, sc->STRING_CI_LEQ));
+}
- /* start at current position and look back a few chars */
- for (i = port_string_point(pt), j = 0; (i > 0) && (j < QUOTE_SIZE); i--, j++)
- if ((port_string(pt)[i] == '\0') ||
- (port_string(pt)[i] == '\n') ||
- (port_string(pt)[i] == '\r'))
- break;
- start = i;
+static s7_pointer c_string_ci_leq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_CI_LEQ, list_2(sc, x, y), T_STRING, 1);
+ if (!is_string(y))
+ method_or_bust(sc, y, sc->STRING_CI_LEQ, list_2(sc, x, y), T_STRING, 2);
+ return(make_boolean(sc, scheme_strcasecmp(x, y) != 1));
+}
- /* start at current position and look ahead a few chars */
- for (i = port_string_point(pt), j = 0; (i < port_string_length(pt)) && (j < QUOTE_SIZE); i++, j++)
- if ((port_string(pt)[i] == '\0') ||
- (port_string(pt)[i] == '\n') ||
- (port_string(pt)[i] == '\r'))
- break;
+PF2_TO_PF(string_ci_leq, c_string_ci_leq)
+#endif /* pure s7 */
- end = i;
- slen = end - start;
- /* hopefully this is more or less the current line where the read error happened */
- if (slen > 0)
- {
- recent_input = (char *)calloc((slen + 9), sizeof(char));
- for (i = 0; i < (slen + 8); i++) recent_input[i] = '.';
- recent_input[3] = ' ';
- recent_input[slen + 4] = ' ';
- for (i = 0; i < slen; i++) recent_input[i + 4] = port_string(pt)[start + i];
- }
+static s7_pointer g_string_fill(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_fill "(string-fill! str chr start end) fills the string str with the character chr"
+ #define Q_string_fill s7_make_circular_signature(sc, 3, 4, s7_make_signature(sc, 2, sc->IS_CHAR, sc->IS_INTEGER), sc->IS_STRING, sc->IS_CHAR, sc->IS_INTEGER)
- if ((port_line_number(pt) > 0) &&
- (port_filename(pt)))
+ s7_pointer x, chr;
+ s7_int start = 0, end, byte = 0;
+ x = car(args);
+
+ if (!is_string(x))
+ method_or_bust(sc, x, sc->STRING_FILL, args, T_STRING, 1); /* not two methods here */
+
+ chr = cadr(args);
+ if (!is_byte_vector(x))
+ {
+ if (!s7_is_character(chr))
{
- len = safe_strlen(recent_input) + safe_strlen(errmsg) + safe_strlen(port_filename(pt)) + safe_strlen(sc->current_file) + 64;
- msg = (char *)malloc(len * sizeof(char));
- len = snprintf(msg, len, "%s: %s %s[%d], last top-level form at: %s[%d]",
- errmsg, (recent_input) ? recent_input : "", port_filename(pt), port_line_number(pt),
- sc->current_file, sc->current_line);
+ check_two_methods(sc, chr, sc->STRING_FILL, sc->FILL, args);
+ return(wrong_type_argument(sc, sc->STRING_FILL, 2, chr, T_CHARACTER));
}
- else
+ }
+ else
+ {
+ if (!is_integer(chr))
{
- len = safe_strlen(recent_input) + safe_strlen(errmsg) + safe_strlen(sc->current_file) + 64;
- msg = (char *)malloc(len * sizeof(char));
-
- if ((sc->current_file) &&
- (sc->current_line >= 0))
- len = snprintf(msg, len, "%s: %s, last top-level form at %s[%d]",
- errmsg, (recent_input) ? recent_input : "",
- sc->current_file, sc->current_line);
- else len = snprintf(msg, len, "%s: %s", errmsg, (recent_input) ? recent_input : "");
+ check_two_methods(sc, chr, sc->STRING_FILL, sc->FILL, args);
+ return(wrong_type_argument(sc, sc->FILL, 2, chr, T_INTEGER));
}
-
- if (recent_input) free(recent_input);
- return(s7_error(sc, sc->READ_ERROR, make_string_uncopied_with_length(sc, msg, len)));
+ byte = integer(chr);
+ if ((byte < 0) || (byte > 255))
+ return(simple_wrong_type_argument_with_type(sc, sc->STRING_FILL, chr, AN_UNSIGNED_BYTE));
}
- if ((port_line_number(pt) > 0) &&
- (port_filename(pt)))
+ end = string_length(x);
+ if (!is_null(cddr(args)))
{
- len = safe_strlen(errmsg) + safe_strlen(port_filename(pt)) + safe_strlen(sc->current_file) + 64;
- msg = (char *)malloc(len * sizeof(char));
- len = snprintf(msg, len, "%s %s[%d], last top-level form at %s[%d]",
- errmsg, port_filename(pt), port_line_number(pt),
- sc->current_file, sc->current_line);
- return(s7_error(sc, sc->READ_ERROR, make_string_uncopied_with_length(sc, msg, len)));
+ s7_pointer p;
+ p = start_and_end(sc, sc->STRING_FILL, sc->FILL, cddr(args), args, 3, &start, &end);
+ if (p != sc->GC_NIL) return(p);
+ if (start == end) return(chr);
}
+ if (end == 0) return(chr);
- return(s7_error(sc, sc->READ_ERROR, make_protected_string(sc, (char *)errmsg)));
+ if (!is_byte_vector(x))
+ memset((void *)(string_value(x) + start), (int)character(chr), end - start);
+ else memset((void *)(string_value(x) + start), (int)byte, end - start);
+
+ return(chr);
}
+#if (!WITH_PURE_S7)
+static s7_pointer c_string_fill(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_string_fill(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(string_fill, c_string_fill)
+#endif
+
-static s7_pointer g_error(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_string_1(s7_scheme *sc, s7_pointer args, s7_pointer sym)
{
- #define H_error "(error type ...) signals an error. The 'type' can be used with catch to trap \
-particular errors. If the error is not caught, s7 treats the 2nd argument as a format control string, \
-and applies it to the rest of the arguments."
+ int i, len;
+ s7_pointer x, newstr;
+ char *str;
- if (args != sc->NIL)
+ /* get length for new string and check arg types */
+ for (len = 0, x = args; is_not_null(x); len++, x = cdr(x))
{
- if (s7_is_string(car(args))) /* CL-style error? -- use tag = 'no-catch */
+ s7_pointer p;
+ p = car(x);
+ if (!s7_is_character(p))
{
- s7_error(sc, make_symbol(sc, "no-catch"), args);
- return(sc->UNSPECIFIED);
+ if (has_methods(p))
+ {
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, p), sym);
+ if (func != sc->UNDEFINED)
+ {
+ s7_pointer y;
+ if (len == 0)
+ return(s7_apply_function(sc, func, args));
+ newstr = make_empty_string(sc, len, 0);
+ str = string_value(newstr);
+ for (i = 0, y = args; y != x; i++, y = cdr(y))
+ str[i] = character(car(y));
+ return(g_string_append(sc, set_plist_2(sc, newstr, s7_apply_function(sc, func, x))));
+ }
+ }
+ return(wrong_type_argument(sc, sym, len + 1, car(x), T_CHARACTER));
}
- return(s7_error(sc, car(args), cdr(args)));
}
- return(s7_error(sc, sc->NIL, sc->NIL));
-}
-
-
-static s7_pointer missing_close_paren_error(s7_scheme *sc)
-{
- int len;
- char *msg;
- s7_pointer pt;
- pt = sc->input_port;
+ newstr = make_empty_string(sc, len, 0);
+ str = string_value(newstr);
+ for (i = 0, x = args; is_not_null(x); i++, x = cdr(x))
+ str[i] = character(car(x));
- if ((port_line_number(pt) > 0) &&
- (port_filename(pt)))
- {
- len = safe_strlen(port_filename(pt)) + safe_strlen(sc->current_file) + 128;
- msg = (char *)malloc(len * sizeof(char));
- len = snprintf(msg, len, "missing close paren, %s[%d], last top-level form at %s[%d]\n",
- port_filename(pt), port_line_number(pt),
- sc->current_file, sc->current_line);
- return(s7_error(sc, sc->READ_ERROR, make_string_uncopied_with_length(sc, msg, len)));
- }
- return(s7_error(sc, sc->READ_ERROR, make_protected_string(sc, "missing close paren")));
+ return(newstr);
}
-static void improper_arglist_error(s7_scheme *sc)
+static s7_pointer g_string(s7_scheme *sc, s7_pointer args)
{
- /* sc->code is the last (dotted) arg, sc->args is the arglist reversed not including sc->code
- * the original was `(,@(reverse args) . ,code) essentially
- */
- s7_error(sc, sc->SYNTAX_ERROR,
- make_list_2(sc,
- make_protected_string(sc, "improper list of arguments: ~A"),
- append_in_place(sc, safe_reverse_in_place(sc, sc->args), sc->code)));
-}
+ #define H_string "(string chr...) appends all its character arguments into one string"
+ #define Q_string s7_make_circular_signature(sc, 1, 2, sc->IS_STRING, sc->IS_CHAR)
+ if (is_null(args)) /* (string) but not (string ()) */
+ return(s7_make_string_with_length(sc, "", 0));
+ return(g_string_1(sc, args, sc->STRING));
+}
-static void display_frame(s7_scheme *sc, s7_pointer envir, s7_pointer port)
+#if (!WITH_PURE_S7)
+static s7_pointer g_list_to_string(s7_scheme *sc, s7_pointer args)
{
- if ((is_pair(envir)) &&
- (is_pair(cdr(envir))))
- {
- s7_pointer args, op;
-
- args = car(envir);
- op = cadr(envir);
-
- if ((is_pair(op)) &&
- (is_pair(car(op))))
- {
- s7_pointer lst, sym, proc;
-
- /* there can be locals (of 'do' for example) preceding a function call here:
- * (((i . 1))
- * ((n . 2))
- * ((__func__ idle "t257.scm" 40)) ...)
- */
- if (caar(op) != sc->__FUNC__)
- {
- format_to_output(sc, port, "~A ", make_list_1(sc, args));
- args = op;
- if (is_pair(cddr(envir)))
- {
- op = caddr(envir);
- if ((!is_pair(op)) ||
- (!is_pair(car(op))) ||
- (caar(op) != sc->__FUNC__))
- return;
- }
- else return;
- }
-
- lst = car(op);
- if (s7_is_symbol(cdr(lst)))
- sym = cdr(lst);
- else sym = cadr(lst);
+ #define H_list_to_string "(list->string lst) appends all the list's characters into one string; (apply string lst)"
+ #define Q_list_to_string s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_PROPER_LIST)
- proc = s7_symbol_local_value(sc, sym, envir);
- if (is_procedure(proc))
- {
- s7_pointer local_env, file_info = sc->F;
- local_env = s7_reverse(sc, args);
- if (!s7_is_symbol(cdr(lst)))
- file_info = cddr(lst);
+ if (is_null(car(args)))
+ return(s7_make_string_with_length(sc, "", 0));
- format_to_output(sc, port, "(~A~{ ~A~})", make_list_2(sc, sym, local_env));
- if (is_pair(file_info))
- format_to_output(sc, port, " [~S ~D]", file_info);
- }
- else
- format_to_output(sc, port, "(~A~{~^ ~A~})", make_list_2(sc, cdr(lst), s7_reverse(sc, args)));
- s7_newline(sc, port);
- }
- }
+ if (!is_proper_list(sc, car(args)))
+ method_or_bust_with_type(sc, car(args), sc->LIST_TO_STRING, args, make_string_wrapper(sc, "a (proper, non-circular) list of characters"), 0);
+ return(g_string_1(sc, car(args), sc->LIST_TO_STRING));
}
+#endif
-
-static s7_pointer g_stacktrace(s7_scheme *sc, s7_pointer args)
+static s7_pointer s7_string_to_list(s7_scheme *sc, const char *str, int len)
{
- /* 4 cases currently:
- * if args=nil, show current stack
- * =thread obj, show its stack
- * =vector, assume it is a vector of envs from *error-info*
- * =continuation, show its stack
- * if trailing arg is a port, it sets where the output goes
- */
- #define H_stacktrace "(stacktrace (obj #f) (port (current-output-port))) displays a stacktrace. If obj is not \
-given, the current stack is displayed, if obj is a thread object, its stack is displayed, \
-if obj is *error-info*, the stack at the point of the error is displayed, and if obj \
-is a continuation, its stack is displayed. If the trailing port argument is not given, \
-output is sent to the current-output-port."
-
- int i, top = 0;
- s7_pointer stk = sc->F, port, obj;
- port = s7_current_output_port(sc);
+ int i;
+ s7_pointer result;
- if (args != sc->NIL)
+ if (len == 0)
+ return(sc->NIL);
+ if (len >= (sc->free_heap_top - sc->free_heap))
{
- if (is_output_port(car(args)))
- {
- port = car(args);
- args = cdr(args);
- }
- else
- {
- if (cdr(args) != sc->NIL)
- {
- if ((is_output_port(cadr(args))) &&
- (!port_is_closed(cadr(args))))
- port = cadr(args);
- else return(s7_wrong_type_arg_error(sc, "stacktrace", 2, cadr(args), "an open output port"));
- }
- }
- obj = car(args);
+ gc(sc);
+ while (len >= (sc->free_heap_top - sc->free_heap))
+ resize_heap(sc);
}
- else obj = sc->F;
- /* *error-info* is the special case here */
- if (s7_is_vector(obj))
- {
- if (vector_length(obj) < ERROR_INFO_SIZE)
- return(s7_wrong_type_arg_error(sc, "stacktrace", 1, obj, "*error-info*"));
+ sc->v = sc->NIL;
+ for (i = len - 1; i >= 0; i--)
+ sc->v = cons_unchecked(sc, s7_make_character(sc, ((unsigned char)str[i])), sc->v);
+ result = sc->v;
+ sc->v = sc->NIL;
+ return(result);
+}
- for (i = ERROR_ENVIRONMENT; i < ERROR_INFO_SIZE; i++)
- {
- if (vector_element(obj, i) == ERROR_INFO_DEFAULT)
- break;
- display_frame(sc, vector_element(obj, i), port);
- }
- return(sc->UNSPECIFIED);
- }
+#if (!WITH_PURE_S7)
+static s7_pointer g_string_to_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_string_to_list "(string->list str start end) returns the elements of the string str in a list; (map values str)"
+ #define Q_string_to_list s7_make_circular_signature(sc, 2, 3, sc->IS_LIST, sc->IS_STRING, sc->IS_INTEGER)
+
+ s7_int i, start = 0, end;
+ s7_pointer p, str;
- if (args == sc->NIL)
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->STRING_TO_LIST, args, T_STRING, 0);
+
+ end = string_length(str);
+ if (!is_null(cdr(args)))
{
- top = s7_stack_top(sc);
- stk = sc->stack;
+ p = start_and_end(sc, sc->STRING_TO_LIST, NULL, cdr(args), args, 2, &start, &end);
+ if (p != sc->GC_NIL) return(p);
+ if (start == end) return(sc->NIL);
}
else
{
- if (s7_is_continuation(obj))
- {
- top = continuation_stack_top(obj);
- stk = continuation_stack(obj);
- }
-#if HAVE_PTHREADS
- else
- {
- if (s7_is_thread(obj))
- {
- thred *f;
- f = (thred *)s7_object_value(obj);
- top = s7_stack_top(f->sc);
- stk = f->sc->stack;
- }
- }
-#endif
+ if (end == 0) return(sc->NIL);
}
- if (stk == sc->F)
- return(s7_wrong_type_arg_error(sc, "stacktrace", 0, args, "a vector, thread object, or continuation"));
-
- for (i = top - 1; i > 0; i -= 4)
- display_frame(sc, stack_environment(stk, i), port);
-
- return(sc->UNSPECIFIED);
-}
+ if ((start == 0) && (end == string_length(str)))
+ return(s7_string_to_list(sc, string_value(str), string_length(str)));
+ sc->w = sc->NIL;
+ for (i = end - 1; i >= start; i--)
+ sc->w = cons(sc, s7_make_character(sc, ((unsigned char)string_value(str)[i])), sc->w);
-s7_pointer s7_stacktrace(s7_scheme *sc, s7_pointer arg)
-{
- if ((arg == sc->NIL) ||
- (is_pair(arg)))
- return(g_stacktrace(sc, arg));
- return(g_stacktrace(sc, make_list_1(sc, arg)));
+ p = sc->w;
+ sc->w = sc->NIL;
+ return(p);
}
+static s7_pointer c_string_to_list(s7_scheme *sc, s7_pointer x) {return(g_string_to_list(sc, set_plist_1(sc, x)));}
+PF_TO_PF(string_to_list, c_string_to_list)
+#endif
+/* -------------------------------- byte_vectors --------------------------------
+ *
+ * these are just strings with the T_BYTE_VECTOR bit set.
+ */
-/* -------------------------------- leftovers -------------------------------- */
+static bool s7_is_byte_vector(s7_pointer b) {return((is_string(b)) && (is_byte_vector(b)));}
-bool (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc)
+static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args)
{
- return(sc->begin_hook);
+ #define H_is_byte_vector "(byte-vector? obj) returns #t if obj is a byte-vector"
+ #define Q_is_byte_vector pl_bt
+
+ check_boolean_method(sc, s7_is_byte_vector, sc->IS_BYTE_VECTOR, args);
}
-void s7_set_begin_hook(s7_scheme *sc, bool (*hook)(s7_scheme *sc))
+static s7_pointer g_to_byte_vector(s7_scheme *sc, s7_pointer args)
{
- sc->begin_hook = hook;
+ #define H_to_byte_vector "(->byte-vector obj) turns a string into a byte-vector."
+ #define Q_to_byte_vector s7_make_signature(sc, 2, sc->IS_BYTE_VECTOR, sc->IS_STRING)
+ s7_pointer str;
+ str = car(args);
+ if (is_integer(str))
+ str = s7_make_string_with_length(sc, (const char *)(&(integer(str))), sizeof(s7_int));
+ else
+ {
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->TO_BYTE_VECTOR, set_plist_1(sc, str), T_STRING, 1);
+ }
+ set_byte_vector(str);
+ return(str);
}
+static s7_pointer c_to_byte_vector(s7_scheme *sc, s7_pointer str) {return(g_to_byte_vector(sc, set_plist_1(sc, str)));}
-void s7_quit(s7_scheme *sc)
-{
- /* if s7 is running in a separate thread, gets hung, and a GUI event tries to interrupt it by calling
- * s7_quit, there is no guarantee we'll be in a place in the evaluator where pushing OP_EVAL_DONE
- * will actually stop s7. But the odds are better than zero, and if pthread_setcanceltype is
- * asynchronous, and the thread is cancelled before calling s7_quit, there's hope. Anyway, this
- * function assumes you've called s7_eval_c_string from C, and you want to interrupt it.
- */
- sc->longjmp_ok = false;
- pop_input_port(sc);
-
- stack_reset(sc);
- push_stack(sc, opcode(OP_EVAL_DONE), sc->NIL, sc->NIL);
-}
+PF_TO_PF(to_byte_vector, c_to_byte_vector)
-static s7_pointer apply_list_star(s7_scheme *sc, s7_pointer d)
+static s7_pointer g_make_byte_vector(s7_scheme *sc, s7_pointer args)
{
- s7_pointer p, q;
- if (cdr(d) == sc->NIL)
- return(car(d));
-
- p = s7_cons(sc, car(d), cdr(d));
- q = p;
- while (cdr(cdr(p)) != sc->NIL)
+ #define H_make_byte_vector "(make-byte-vector len (byte 0)) makes a byte-vector of length len filled with byte."
+ #define Q_make_byte_vector s7_make_circular_signature(sc, 1, 2, sc->IS_BYTE_VECTOR, sc->IS_INTEGER)
+
+ s7_pointer str;
+ if (is_null(cdr(args)))
{
- d = s7_cons(sc, car(p), cdr(p));
- if (cdr(cdr(p)) != sc->NIL)
- p = cdr(d);
+ str = g_make_string(sc, args);
+ if (is_string(str))
+ memclr((void *)(string_value(str)), string_length(str));
}
- cdr(p) = car(cdr(p));
- return(q);
+ else
+ {
+ s7_pointer len, byte;
+ s7_int b;
+ len = car(args);
+ if (!is_integer(len))
+ method_or_bust(sc, len, sc->MAKE_BYTE_VECTOR, args, T_INTEGER, 1);
+
+ byte = cadr(args);
+ if (!s7_is_integer(byte))
+ method_or_bust(sc, byte, sc->MAKE_BYTE_VECTOR, args, T_INTEGER, 2);
+
+ b = s7_integer(byte);
+ if ((b < 0) || (b > 255))
+ return(simple_wrong_type_argument_with_type(sc, sc->MAKE_BYTE_VECTOR, byte, AN_UNSIGNED_BYTE));
+ str = g_make_string(sc, set_plist_2(sc, len, chars[b]));
+ }
+ set_byte_vector(str);
+ return(str);
}
-static s7_pointer g_apply(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_byte_vector(s7_scheme *sc, s7_pointer args)
{
- #define H_apply "(apply func ...) applies func to the rest of the arguments"
+ #define H_byte_vector "(byte-vector ...) returns a byte-vector whose elements are the arguments"
+ #define Q_byte_vector s7_make_circular_signature(sc, 1, 2, sc->IS_BYTE_VECTOR, sc->IS_INTEGER)
- sc->code = car(args);
- if (cdr(args) == sc->NIL)
- sc->args = sc->NIL;
- else
- {
- sc->args = apply_list_star(sc, cdr(args));
+ s7_int i, len;
+ s7_pointer vec, x;
+ char *str;
- if (!is_proper_list(sc, sc->args)) /* (apply + #f) etc */
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc,
- make_protected_string(sc, "apply's last argument should be a proper list: ~A"),
- args)));
- }
+ len = s7_list_length(sc, args);
+ vec = make_empty_string(sc, len, 0);
+ str = string_value(vec);
- if (is_any_macro(sc->code)) /* (apply mac '(3)) -> (apply mac '((mac 3))) */
+ for (i = 0, x = args; is_pair(x); i++, x = cdr(x))
{
- push_stack(sc, opcode(OP_EVAL_MACRO), sc->NIL, sc->NIL);
- sc->args = make_list_1(sc, s7_cons(sc, sc->code, sc->args));
+ s7_pointer byte;
+ s7_int b;
+ byte = car(x);
+ if (!s7_is_integer(byte))
+ {
+ if (has_methods(byte))
+ {
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, byte), sc->BYTE_VECTOR);
+ if (func != sc->UNDEFINED)
+ {
+ if (i == 0)
+ return(s7_apply_function(sc, func, args));
+ string_length(vec) = i;
+ vec = g_string_append(sc, set_plist_2(sc, vec, s7_apply_function(sc, func, x)));
+ set_byte_vector(vec);
+ return(vec);
+ }
+ }
+ return(wrong_type_argument(sc, sc->BYTE_VECTOR, i + 1, byte, T_INTEGER));
+ }
+ b = s7_integer(byte);
+ if ((b < 0) || (b > 255))
+ return(simple_wrong_type_argument_with_type(sc, sc->BYTE_VECTOR, byte, AN_UNSIGNED_BYTE));
+ str[i] = (unsigned char)b;
}
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->NIL);
+ set_byte_vector(vec);
+ return(vec);
}
-
-static s7_pointer g_eval(s7_scheme *sc, s7_pointer args)
+static s7_pointer byte_vector_to_list(s7_scheme *sc, const char *str, int len)
{
- #define H_eval "(eval code (env (current-environment))) evaluates code in the environment env. 'env' \
-defaults to the current environment; to evaluate something in the top-level environment instead, \
-pass (global-environment):\n\
-\n\
- (define x 32) \n\
- (let ((x 3))\n\
- (eval 'x (global-environment)))\n\
-\n\
- returns 32"
-
- if (cdr(args) != sc->NIL)
- {
- if (!is_environment(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "eval", 2, cadr(args), "an environment"));
- sc->envir = cadr(args);
- }
-
- /* this causes stack-overflow -> segfault:
- * (define-macro* (mac (env (current-environment))) `(display ,env)) (mac)
- * which is the same as
- * (let ((lst (list (list (cons 1 2))))) (set! (cdr (caar lst)) lst) (eval lst))
- * (let ((lst (list (cons + 2)))) (set! (cdr (car lst)) lst) (eval lst))
- * but I can't think of a good way to catch such stuff (or what to do if I do catch it)
- *
- * guile hangs: (let ((lst (list (cons + 2)))) (set-cdr! (car lst) lst) (eval lst (interaction-environment)))
- * sbcl and clisp stack overflow: (let ((lst (list (cons 1 2)))) (setf (cdr (car lst)) lst) (eval lst))
- *
- * so, I'm not alone...
- */
+ int i;
+ s7_pointer p;
+ if (len == 0) return(sc->NIL);
+ sc->w = sc->NIL;
+ for (i = len - 1; i >= 0; i--)
+ sc->w = cons(sc, small_int((unsigned int)((unsigned char)(str[i]))), sc->w); /* extra cast is not redundant! */
+ p = sc->w;
+ sc->w = sc->NIL;
+ return(p);
+}
- sc->code = car(args);
- if (s7_stack_top(sc) < 12)
- push_stack(sc, opcode(OP_BARRIER), sc->NIL, sc->NIL);
- push_stack(sc, opcode(OP_EVAL), sc->args, sc->code);
- return(sc->NIL);
-}
+/* -------------------------------- ports --------------------------------
+ *
+ * originally nil served as stdin and friends, but that made it impossible to catch an error
+ * like (read-line (current-output-port)) when the latter was stdout. So we now have
+ * the built-in constant ports *stdin*, *stdout*, and *stderr*. Some way is needed to
+ * refer to these directly so that (read-line *stdin*) for example can insist on reading
+ * from the terminal, or whatever stdin is.
+ */
-s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args)
+static s7_pointer g_is_port_closed(s7_scheme *sc, s7_pointer args)
{
- bool old_longjmp;
- jmp_buf old_goto_start;
+ #define H_is_port_closed "(port-closed? p) returns #t if the port p is closed."
+ #define Q_is_port_closed pl_bt
+ s7_pointer x;
- /* this can be called while we are in the eval loop (within eval_c_string for instance),
- * and if we reset the stack, the previously running evaluation steps off the end
- * of the stack == segfault.
- */
+ x = car(args);
+ if ((is_input_port(x)) || (is_output_port(x)))
+ return(make_boolean(sc, port_is_closed(x)));
- if (is_c_function(func))
- return(c_function_call(func)(sc, args)); /* no check for wrong-number-of-args -- is that reasonable? */
+ method_or_bust_with_type(sc, x, sc->IS_PORT_CLOSED, args, make_string_wrapper(sc, "a port"), 0);
+}
- old_longjmp = sc->longjmp_ok;
- memcpy((void *)old_goto_start, (void *)(sc->goto_start), sizeof(jmp_buf));
- /* if an error occurs during s7_call, and it is caught, catch (above) wants to longjmp
- * to its caller to complete the error handler evaluation so that the C stack is
- * cleaned up -- this means we have to have the longjmp location set here, but
- * we could get here from anywhere, so we need to save and restore the incoming
- * longjmp location.
- */
+static s7_pointer c_port_line_number(s7_scheme *sc, s7_pointer x)
+{
+ if ((!(is_input_port(x))) ||
+ (port_is_closed(x)))
+ method_or_bust_with_type(sc, x, sc->PORT_LINE_NUMBER, list_1(sc, x), AN_INPUT_PORT, 0);
+ return(make_integer(sc, port_line_number(x)));
+}
- sc->longjmp_ok = true;
- if (setjmp(sc->goto_start) != 0) /* returning from s7_error catch handler */
- {
- sc->longjmp_ok = old_longjmp;
- memcpy((void *)(sc->goto_start), (void *)old_goto_start, sizeof(jmp_buf));
-
- if ((sc->op == OP_ERROR_QUIT) &&
- (sc->longjmp_ok))
- {
- longjmp(sc->goto_start, 1); /* this is trying to clear the C stack back to some clean state */
- }
+static s7_pointer g_port_line_number(s7_scheme *sc, s7_pointer args)
+{
+ #define H_port_line_number "(port-line-number input-file-port) returns the current read line number of port"
+ #define Q_port_line_number s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_INPUT_PORT)
- eval(sc, sc->op);
- /* sc->op can be OP_APPLY if s7_call raised an error that was caught (via catch) -- we're about to go to the error handler */
- return(sc->value);
- }
+ if (is_null(args))
+ return(c_port_line_number(sc, sc->input_port));
+ return(c_port_line_number(sc, car(args)));
+}
- push_stack(sc, opcode(OP_EVAL_DONE), sc->args, sc->code); /* this saves the current evaluation and will eventually finish this (possibly) nested call */
- sc->args = args;
- sc->code = func;
- eval(sc, OP_APPLY);
+PF_TO_PF(port_line_number, c_port_line_number)
- sc->longjmp_ok = old_longjmp;
- memcpy((void *)(sc->goto_start), (void *)old_goto_start, sizeof(jmp_buf));
+int s7_port_line_number(s7_pointer p)
+{
+ if (is_input_port(p))
+ return(port_line_number(p));
+ return(0);
+}
- return(sc->value);
-}
+const char *s7_port_filename(s7_pointer x)
+{
+ if (((is_input_port(x)) ||
+ (is_output_port(x))) &&
+ (!port_is_closed(x)))
+ return(port_filename(x));
+ return(NULL);
+}
-s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, int line)
-{
- s7_pointer result;
- if (caller)
+static s7_pointer c_port_filename(s7_scheme *sc, s7_pointer x)
+{
+ if (((is_input_port(x)) ||
+ (is_output_port(x))) &&
+ (!port_is_closed(x)))
{
- sc->s7_call_name = caller;
- sc->s7_call_file = file;
- sc->s7_call_line = line;
+ if (port_filename(x))
+ return(make_string_wrapper_with_length(sc, port_filename(x), port_filename_length(x)));
+ return(s7_make_string_with_length(sc, "", 0));
+ /* otherwise (eval-string (port-filename)) and (string->symbol (port-filename)) segfault */
}
+ method_or_bust_with_type(sc, x, sc->PORT_FILENAME, list_1(sc, x), AN_OPEN_PORT, 0);
+}
- result = s7_call(sc, func, args);
-
- if (caller)
- {
- sc->s7_call_name = NULL;
- sc->s7_call_file = NULL;
- sc->s7_call_line = -1;
- }
+static s7_pointer g_port_filename(s7_scheme *sc, s7_pointer args)
+{
+ #define H_port_filename "(port-filename file-port) returns the filename associated with port"
+ #define Q_port_filename s7_make_signature(sc, 2, sc->IS_STRING, sc->T)
- return(result);
+ if (is_null(args))
+ return(c_port_filename(sc, sc->input_port));
+ return(c_port_filename(sc, car(args)));
}
+PF_TO_PF(port_filename, c_port_filename)
-static s7_pointer g_s7_version(s7_scheme *sc, s7_pointer args)
+
+bool s7_is_input_port(s7_scheme *sc, s7_pointer p)
{
- #define H_s7_version "(s7-version) returns some string describing the current S7"
- return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE));
+ return(is_input_port(p));
}
+static s7_pointer g_is_input_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_input_port "(input-port? p) returns #t if p is an input port"
+ #define Q_is_input_port pl_bt
+ check_boolean_method(sc, is_input_port, sc->IS_INPUT_PORT, args);
+}
-/* ---------------------------------------- map and for-each ---------------------------------------- */
-static s7_Int applicable_length(s7_scheme *sc, s7_pointer obj)
+bool s7_is_output_port(s7_scheme *sc, s7_pointer p)
{
- switch (type(obj))
- {
- case T_PAIR:
- {
- s7_Int len;
- len = s7_list_length(sc, obj);
- if (len < 0) /* dotted (does not include the final cdr -- perhaps this is a bug) */
- return(-len); /* it means that (map abs '(1 . "hi")) returns '(1) */
- if (len == 0) /* circular */
- return(S7_LONG_MAX);
- return(len);
- }
+ return(is_output_port(p));
+}
- case T_S_OBJECT:
- case T_C_OBJECT:
- {
- /* both map and for-each assume sc->x|y|z are unchanged across this call */
- int save_x, save_y, save_z;
- s7_pointer result;
- SAVE_X_Y_Z(save_x, save_y, save_z);
- result = object_length(sc, obj);
- RESTORE_X_Y_Z(save_x, save_y, save_z);
+static s7_pointer g_is_output_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_output_port "(output-port? p) returns #t if p is an output port"
+ #define Q_is_output_port pl_bt
+ check_boolean_method(sc, is_output_port, sc->IS_OUTPUT_PORT, args);
+}
+
- if (s7_is_integer(result)) /* we need to check, else misinterpreting it as an integer can lead to a infinite loop */
- return(s7_integer(result));
- return(-1);
- }
+s7_pointer s7_current_input_port(s7_scheme *sc)
+{
+ return(sc->input_port);
+}
- case T_STRING:
- return(string_length(obj));
- case T_VECTOR:
- return(vector_length(obj));
+static s7_pointer g_current_input_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_current_input_port "(current-input-port) returns the current input port"
+ #define Q_current_input_port s7_make_signature(sc, 1, sc->IS_INPUT_PORT)
+ return(sc->input_port);
+}
- case T_HASH_TABLE:
- return(hash_table_entries(obj));
+#if (!WITH_PURE_S7)
+static s7_pointer g_set_current_input_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_set_current_input_port "(set-current-input-port port) sets the current-input port to port and returns the previous value of the input port"
+ #define Q_set_current_input_port s7_make_signature(sc, 2, sc->IS_INPUT_PORT, sc->IS_INPUT_PORT)
- case T_NIL:
- return(0);
+ s7_pointer old_port, port;
+ old_port = sc->input_port;
+ port = car(args);
+ if ((is_input_port(port)) &&
+ (!port_is_closed(port)))
+ sc->input_port = port;
+ else
+ {
+ check_method(sc, port, s7_make_symbol(sc, "set-current-input-port"), args);
+ return(s7_wrong_type_arg_error(sc, "set-current-input-port", 0, port, "an open input port"));
}
-
- return(-1);
+ return(old_port);
}
+#endif
-
-static bool next_for_each(s7_scheme *sc)
+s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer port)
{
- /* func = sc->code, func-args = caddr(sc->args), counter = car(sc->args), len = cadr(sc->args), object(s) = cdddr(sc->args) */
- s7_pointer x, y, z, vargs, fargs;
- int loc, zloc = -1;
-
- z = sc->NIL;
- vargs = cdddr(sc->args);
- fargs = caddr(sc->args);
- loc = s7_integer(car(sc->args));
+ s7_pointer old_port;
+ old_port = sc->input_port;
+ sc->input_port = port;
+ return(old_port);
+}
- /* for-each func ... -- each trailing sequence arg contributes one arg to the current call on func,
- * so in the next loop, gather one arg from each sequence.
- */
- for (x = fargs, y = vargs; x != sc->NIL; x = cdr(x), y = cdr(y))
- switch (type(car(y)))
- {
- case T_PAIR:
- car(x) = caar(y);
- car(y) = cdar(y);
- break;
+s7_pointer s7_current_output_port(s7_scheme *sc)
+{
+ return(sc->output_port);
+}
- case T_S_OBJECT:
- {
- int save_x, save_y, save_z;
- if (z == sc->NIL)
- {
- z = make_list_1(sc, s7_make_integer(sc, integer(number(car(sc->args)))));
- /* we can't use car(sc->args) directly here -- it is a mutable integer, incremented below,
- * but the object application (the getter function) might return the index!
- * Then, we pre-increment, and the for-each application sees the incremented value.
- *
- * (let ((ctr ((cadr (make-type :getter (lambda (a b) b) :length (lambda (a) 4))))) (sum 0))
- * (for-each (lambda (a b) (set! sum (+ sum a b))) ctr ctr) sum)
- */
- zloc = s7_gc_protect(sc, z);
- }
+s7_pointer s7_set_current_output_port(s7_scheme *sc, s7_pointer port)
+{
+ s7_pointer old_port;
+ old_port = sc->output_port;
+ sc->output_port = port;
+ return(old_port);
+}
- SAVE_X_Y_Z(save_x, save_y, save_z);
- car(x) = apply_object(sc, car(y), z);
- RESTORE_X_Y_Z(save_x, save_y, save_z);
- }
- break;
- case T_C_OBJECT:
- if (z == sc->NIL)
- {
- z = make_list_1(sc, s7_make_integer(sc, integer(number(car(sc->args))))); /* see above */
- zloc = s7_gc_protect(sc, z);
- }
- car(x) = apply_object(sc, car(y), z);
- break;
-
- case T_VECTOR:
- car(x) = vector_element(car(y), loc);
- break;
+static s7_pointer g_current_output_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_current_output_port "(current-output-port) returns the current output port"
+ #define Q_current_output_port s7_make_signature(sc, 1, sc->IS_OUTPUT_PORT)
+ return(sc->output_port);
+}
- case T_CLOSURE: /* hash-table via an iterator */
- car(x) = g_hash_table_iterate(sc, cdadar(closure_body(car(y)))); /* cdadadar? I suppose this accessor could be optimized */
- break;
+#if (!WITH_PURE_S7)
+static s7_pointer g_set_current_output_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_set_current_output_port "(set-current-output-port port) sets the current-output port to port and returns the previous value of the output port"
+ #define Q_set_current_output_port s7_make_signature(sc, 2, sc->IS_OUTPUT_PORT, sc->IS_OUTPUT_PORT)
- case T_STRING:
- car(x) = s7_make_character(sc, ((unsigned char)(string_value(car(y))[loc])));
- break;
+ s7_pointer old_port, port;
+ old_port = sc->output_port;
+ port = car(args);
+ if (((is_output_port(port)) &&
+ (!port_is_closed(port))) ||
+ (port == sc->F))
+ sc->output_port = port;
+ else
+ {
+ check_method(sc, port, s7_make_symbol(sc, "set-current-output-port"), args);
+ return(s7_wrong_type_arg_error(sc, "set-current-output-port", 0, port, "an open output port"));
+ }
+ return(old_port);
+}
+#endif
- default: /* see comment in next_map: (let ((L (list 1 2 3 4 5))) (for-each (lambda (x) (set-cdr! (cddr L) 5) (display x)) L)) */
- if (z != sc->NIL)
- s7_gc_unprotect_at(sc, zloc);
- return(false);
- break;
- }
+s7_pointer s7_current_error_port(s7_scheme *sc)
+{
+ return(sc->error_port);
+}
- if (z != sc->NIL)
- s7_gc_unprotect_at(sc, zloc);
- integer(number(car(sc->args))) = loc + 1;
- push_stack(sc, opcode(OP_FOR_EACH), sc->args, sc->code);
- sc->args = fargs;
- return(true);
+s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port)
+{
+ s7_pointer old_port;
+ old_port = sc->error_port;
+ sc->error_port = port;
+ return(old_port);
}
-static bool is_sequence(s7_scheme *sc, s7_pointer p)
+static s7_pointer g_current_error_port(s7_scheme *sc, s7_pointer args)
{
- return((is_pair(p)) ||
- (s7_is_vector(p)) ||
- (s7_is_string(p)) ||
- (s7_is_hash_table(p)) ||
- (is_c_object(p)) ||
- (is_s_object(p)) ||
- (p == sc->NIL));
+ #define H_current_error_port "(current-error-port) returns the current error port"
+ #define Q_current_error_port s7_make_signature(sc, 1, sc->IS_OUTPUT_PORT)
+ return(sc->error_port);
}
-static s7_pointer g_for_each(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_set_current_error_port(s7_scheme *sc, s7_pointer args)
{
- #define H_for_each "(for-each proc object . objects) applies proc to each element of the objects traversed in parallel. \
-Each object can be a list (the normal case), string, vector, hash-table, or any applicable object."
-
- /* (for-each (lambda (n) (format #t "~A " n)) (vct 1.0 2.0 3.0)) */
- s7_Int i, len;
- /* "int" here is unhappy on 64-bit machines, and "long int" is unhappy on 32-bit machines, so try long long int.
- * string_length is an int.
- */
- s7_pointer obj, x;
- sc->code = car(args);
+ #define H_set_current_error_port "(set-current-error-port port) sets the current-error port to port and returns the previous value of the error port"
+ #define Q_set_current_error_port s7_make_signature(sc, 2, sc->IS_OUTPUT_PORT, sc->IS_OUTPUT_PORT)
+ s7_pointer old_port, port;
- /* macro application requires the entire call as the argument to apply, but apply itself fixes this up.
- * that is, g_apply checks, then goes to OP_EVAL_MACRO after OP_APPLY with the fixed up list,
- * but here we are simply sending it to OP_APPLY, so
- *
- * (define-macro (hi a) `(+ ,a 1))
- * (apply hi '(1)) ; internally rewritten as (apply hi '((hi 1)))
- * 2 ; apply adds the evaluation if its 1st arg is a macro
- * (map hi '((hi 1) (hi 2))) ; here we've rewritten the arg lists by hand
- * ((+ 1 1) (+ 2 1)) ; but no evaluation
- *
- * ideally I think it should be
- *
- * (map hi '(1 2))
- * (2 3)
- *
- * OP_APPLY knows this is happening (in the 2nd case) and raises an error -- what would break
- * if we handle it locally instead? This actually affects only T_C_MACRO (quasiquote) --
- * normal macros/bacros would still be broken.
- * or could we rewrite the args to fit just as in apply? (also need the evaluation)
- */
+ old_port = sc->error_port;
+ port = car(args);
+ if (((is_output_port(port)) &&
+ (!port_is_closed(port))) ||
+ (port == sc->F))
+ sc->error_port = port;
+ else
+ {
+ check_method(sc, port, s7_make_symbol(sc, "set-current-error-port"), args);
+ return(s7_wrong_type_arg_error(sc, "set-current-error-port", 0, port, "an open output port"));
+ }
+ return(old_port);
+}
- /* before checking len=0, we need to check that the arguments are all sequences (this is like our handling of args to + for example)
- * otherwise (for-each = "" 123) -> #<unspecified>
- * the function may not actually be applicable to its sequence elements, but that isn't an error:
- * (map abs "") -> '()
- */
- for (i = 2, x = cdr(args); x != sc->NIL; x = cdr(x), i++)
- if (!is_sequence(sc, car(x)))
- return(s7_wrong_type_arg_error(sc, "for-each", i, car(x), "a sequence"));
- sc->y = args;
- obj = cadr(args);
+#if (!WITH_PURE_S7)
+static s7_pointer g_is_char_ready(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_char_ready "(char-ready? (port (current-input-port))) returns #t if a character is ready for input on the given port"
+ #define Q_is_char_ready s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_INPUT_PORT)
+ if (is_not_null(args))
+ {
+ s7_pointer pt = car(args);
+ if (!is_input_port(pt))
+ method_or_bust_with_type(sc, pt, sc->IS_CHAR_READY, args, AN_INPUT_PORT, 0);
+ if (port_is_closed(pt))
+ return(simple_wrong_type_argument_with_type(sc, sc->IS_CHAR_READY, pt, AN_OPEN_PORT));
- len = applicable_length(sc, obj);
- if (len < 0)
- return(s7_wrong_type_arg_error(sc, "for-each", 2, obj, "a vector, list, string, hash-table, or applicable object"));
+ if (is_function_port(pt))
+ return((*(port_input_function(pt)))(sc, S7_IS_CHAR_READY, pt));
+ return(make_boolean(sc, is_string_port(pt)));
+ }
+ return(make_boolean(sc, (is_input_port(sc->input_port)) && (is_string_port(sc->input_port))));
+}
+#endif
- if (len != 0)
- {
- sc->x = make_list_1(sc, sc->NIL);
- if (s7_is_hash_table(obj))
- sc->z = make_list_1(sc, g_make_hash_table_iterator(sc, cdr(args)));
- else sc->z = make_list_1(sc, obj);
- /* we have to copy the args if any of them is a list:
- * (let* ((x (list (list 1 2 3))) (y (apply for-each abs x))) (list x y))
- * (is this trying to say that the for-each loop might otherwise change the original list as it cdrs down it?)
- */
+static s7_pointer g_is_eof_object(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_eof_object "(eof-object? val) returns #t if val is the end-of-file object"
+ #define Q_is_eof_object pl_bt
+ check_boolean_method(sc, is_eof, sc->IS_EOF_OBJECT, args);
+}
- if (cddr(args) != sc->NIL)
- {
- for (i = 3, x = cddr(args); x != sc->NIL; x = cdr(x), i++)
- {
- s7_Int nlen;
- nlen = applicable_length(sc, car(x));
- if (nlen < 0)
- return(s7_wrong_type_arg_error(sc, "for-each", i, car(x), "a vector, list, string, hash-table, or applicable object"));
- if (nlen < len) len = nlen;
- if (len == 0) break; /* need error check below */
+static int closed_port_read_char(s7_scheme *sc, s7_pointer port);
+static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied);
+static void closed_port_write_char(s7_scheme *sc, int c, s7_pointer port);
+static void closed_port_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port);
+static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port);
- sc->x = s7_cons(sc, sc->NIL, sc->x); /* we're making a list to be filled in later with the individual args */
+void s7_close_input_port(s7_scheme *sc, s7_pointer p)
+{
+#if DEBUGGING
+ if (!is_input_port(p))
+ fprintf(stderr, "s7_close_input_port: %s\n", DISPLAY(p));
+#endif
+ if ((is_immutable_port(p)) ||
+ ((is_input_port(p)) && (port_is_closed(p))))
+ return;
- if (s7_is_hash_table(car(x)))
- sc->z = s7_cons(sc, g_make_hash_table_iterator(sc, x), sc->z);
- else sc->z = s7_cons(sc, car(x), sc->z);
- }
- }
+ if (port_filename(p))
+ {
+ free(port_filename(p));
+ port_filename(p) = NULL;
}
- if (len == 0)
+ if (is_file_port(p))
{
- /* here we can't depend on OP_APPLY to do the error check on the 1st arg:
- * (map 0 '()) -> '()
- * so we check by hand before returning #<unspecified>
- */
- if (((typeflag(sc->code) & (T_ANY_MACRO | T_SYNTAX | T_PROCEDURE)) != 0) ||
- (is_pair(sc->code)) || /* if this used is_sequence (above), (map '()...) would not be an error */
- (s7_is_string(sc->code)) ||
- (s7_is_vector(sc->code)) ||
- (s7_is_hash_table(sc->code)) ||
- (is_hook(sc->code)))
- return(sc->UNSPECIFIED); /* circular -> S7_LONG_MAX in this case, so 0 -> nil */
- return(s7_wrong_type_arg_error(sc, "for-each", 1, sc->code, "a procedure or something applicable"));
- }
-
- if (len == S7_LONG_MAX)
- {
- /* if at this point len == S7_LONG_MAX, then all args are circular lists, assuming that
- * we're not looking at some enormous vector or string -- perhaps -1 would be a
- * better marker. This actually might not be an error (the for-each function could
- * have call-with-exit), but it seems better to complain about it.
- *
- * this means that a make-type generator's length is tricky:
- * (let ((ctr ((cadr (make-type :getter (lambda (a b) b) :length (lambda (a) (- (expt 2 31) 1)))))) (sum 0))
- * (call-with-exit (lambda (go) (for-each (lambda (a) (set! sum (+ sum a)) (if (> sum 100) (go sum))) ctr))))
- * returns an error about circular lists, but should return 105.
- *
- * I think I'll at least check that the args were in fact lists.
- */
- for (x = cdr(args); (is_pair(x)) && (is_pair(car(x))); x = cdr(x)) {}
- if (!is_pair(x))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "for-each's arguments are circular lists! ~A"), cdr(args))));
+ if (port_file(p))
+ {
+ fclose(port_file(p));
+ port_file(p) = NULL;
+ }
+ }
+ else
+ {
+ if ((is_string_port(p)) &&
+ (port_gc_loc(p) != -1))
+ s7_gc_unprotect_at(sc, port_gc_loc(p));
+ }
+ if (port_needs_free(p))
+ {
+ if (port_data(p))
+ {
+ free(port_data(p));
+ port_data(p) = NULL;
+ port_data_size(p) = 0;
+ }
+ port_needs_free(p) = false;
}
- sc->args = s7_cons(sc, make_mutable_integer(sc, 0), /* '(counter applicable-len func-args-holder . objects) */
- s7_cons(sc, s7_make_integer(sc, len),
- s7_cons(sc, sc->x,
- safe_reverse_in_place(sc, sc->z))));
-
- sc->x = sc->NIL;
- sc->y = sc->NIL;
- sc->z = sc->NIL;
- push_stack(sc, opcode(OP_FOR_EACH), sc->args, sc->code);
- return(sc->UNSPECIFIED);
+ port_read_character(p) = closed_port_read_char;
+ port_read_line(p) = closed_port_read_line;
+ port_write_character(p) = closed_port_write_char;
+ port_write_string(p) = closed_port_write_string;
+ port_display(p) = closed_port_display;
+ port_is_closed(p) = true;
}
-static bool next_map(s7_scheme *sc)
+static s7_pointer c_close_input_port(s7_scheme *sc, s7_pointer pt)
{
- /* func = sc->code, results so far = caddr(sc->args), counter = car(sc->args), len = cadr(sc->args), object(s) = cdddr(sc->args) */
- s7_pointer y, z, vargs, results;
- int loc, zloc = -1;
-
- z = sc->NIL;
- vargs = cdddr(sc->args);
- results = caddr(sc->args);
- loc = s7_integer(car(sc->args));
- sc->x = sc->NIL; /* can't use preset args list here (as in for-each): (map list '(a b c)) */
-
- for (y = vargs; y != sc->NIL; y = cdr(y))
- {
- s7_pointer x;
- switch (type(car(y)))
- {
- case T_PAIR:
- x = caar(y);
- car(y) = cdar(y);
- break;
-
- case T_S_OBJECT:
- {
- int save_x, save_y, save_z;
- if (z == sc->NIL)
- {
- z = make_list_1(sc, s7_make_integer(sc, integer(number(car(sc->args))))); /* see note in next_for_each */
- zloc = s7_gc_protect(sc, z);
- }
- SAVE_X_Y_Z(save_x, save_y, save_z);
- x = apply_object(sc, car(y), z);
- RESTORE_X_Y_Z(save_x, save_y, save_z);
- }
- break;
+ if (!is_input_port(pt))
+ method_or_bust_with_type(sc, pt, sc->CLOSE_INPUT_PORT, set_plist_1(sc, pt), AN_INPUT_PORT, 0);
+ if (!is_immutable_port(pt))
+ s7_close_input_port(sc, pt);
+ return(sc->UNSPECIFIED);
+}
- case T_C_OBJECT:
- if (z == sc->NIL)
- {
- z = make_list_1(sc, s7_make_integer(sc, integer(number(car(sc->args)))));
- zloc = s7_gc_protect(sc, z);
- }
- x = apply_object(sc, car(y), z);
- break;
-
- case T_VECTOR:
- x = vector_element(car(y), loc);
- break;
+static s7_pointer g_close_input_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_close_input_port "(close-input-port port) closes the port"
+ #define Q_close_input_port s7_make_signature(sc, 2, sc->T, sc->IS_INPUT_PORT)
+ return(c_close_input_port(sc, car(args)));
+}
- case T_STRING:
- x = s7_make_character(sc, ((unsigned char)(string_value(car(y))[loc])));
- break;
+PF_TO_PF(close_input_port, c_close_input_port)
- case T_CLOSURE: /* hash-table via an iterator */
- x = g_hash_table_iterate(sc, cdr(cadar(closure_body(car(y)))));
- break;
- default:
- /* this can happen if one of the args is clobbered by the map function, so our initial
- * length is messed up:
- * (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! (cddr L) 5) x) L))
- */
+void s7_flush_output_port(s7_scheme *sc, s7_pointer p)
+{
+ if ((!is_output_port(p)) ||
+ (!is_file_port(p)) ||
+ (port_is_closed(p)) ||
+ (p == sc->F))
+ return;
- if (z != sc->NIL)
- s7_gc_unprotect_at(sc, zloc);
- return(false); /* this stops the map process, so the code mentioned above returns '(1 2 3) */
- break;
+ if (port_file(p))
+ {
+ if (port_position(p) > 0)
+ {
+ if (fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p)) != port_position(p))
+ s7_warn(sc, 64, "fwrite trouble in flush-output-port\n");
+ port_position(p) = 0;
}
-
- sc->x = s7_cons(sc, x, sc->x);
+ fflush(port_file(p));
}
-
- if (z != sc->NIL)
- s7_gc_unprotect_at(sc, zloc);
- sc->x = safe_reverse_in_place(sc, sc->x);
-
- integer(number(car(sc->args))) = loc + 1;
- push_stack(sc, opcode(OP_MAP), sc->args, sc->code);
- sc->args = sc->x;
- sc->x = sc->NIL;
- return(true);
}
-static s7_pointer g_map(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_flush_output_port(s7_scheme *sc, s7_pointer args)
{
- #define H_map "(map proc object . objects) applies proc to a list made up of the next element of each of its arguments, returning \
-a list of the results. Its arguments can be lists, vectors, strings, hash-tables, or any applicable objects."
-
- s7_Int i, len;
- s7_pointer obj, x;
- sc->code = car(args);
+ #define H_flush_output_port "(flush-output-port port) flushes the port"
+ #define Q_flush_output_port s7_make_signature(sc, 2, sc->T, sc->IS_OUTPUT_PORT)
+ s7_pointer pt;
- for (i = 2, x = cdr(args); x != sc->NIL; x = cdr(x), i++)
- if (!is_sequence(sc, car(x)))
- return(s7_wrong_type_arg_error(sc, "map", i, car(x), "a sequence"));
+ if (is_null(args))
+ pt = sc->output_port;
+ else pt = car(args);
- sc->y = args; /* gc protect */
- obj = cadr(args);
+ if (!is_output_port(pt))
+ {
+ if (pt == sc->F) return(pt);
+ method_or_bust_with_type(sc, pt, sc->FLUSH_OUTPUT_PORT, args, AN_OUTPUT_PORT, 0);
+ }
+ s7_flush_output_port(sc, pt);
+ return(pt);
+}
- len = applicable_length(sc, obj);
- if (len < 0)
- return(s7_wrong_type_arg_error(sc, "map", 2, obj, "a vector, list, string, hash-table, or applicable object"));
+static s7_pointer c_flush_output_port(s7_scheme *sc) {return(g_flush_output_port(sc, sc->NIL));}
+PF_0(flush_output_port, c_flush_output_port)
- if (len != 0)
+static void close_output_port(s7_scheme *sc, s7_pointer p)
+{
+ if (is_file_port(p))
{
- if (s7_is_hash_table(obj))
- sc->z = make_list_1(sc, g_make_hash_table_iterator(sc, cdr(args)));
- else sc->z = make_list_1(sc, obj);
+ if (port_filename(p)) /* only a file (output) port has a filename */
+ {
+ free(port_filename(p));
+ port_filename(p) = NULL;
+ port_filename_length(p) = 0;
+ }
- /* we have to copy the args if any of them is a list:
- * (let* ((x (list (list 1 2 3))) (y (apply map abs x))) (list x y))
- */
-
- if (cddr(args) != sc->NIL)
+ if (port_file(p))
{
- for (i = 3, x = cddr(args); x != sc->NIL; x = cdr(x), i++)
+ if (port_position(p) > 0)
{
- s7_Int nlen;
-
- nlen = applicable_length(sc, car(x));
- if (nlen < 0)
- return(s7_wrong_type_arg_error(sc, "map", i, car(x), "a vector, list, string, hash-table, or applicable object"));
- if (nlen < len) len = nlen;
- if (len == 0) break; /* need error check below */
-
- if (s7_is_hash_table(car(x)))
- sc->z = s7_cons(sc, g_make_hash_table_iterator(sc, x), sc->z);
- else sc->z = s7_cons(sc, car(x), sc->z);
+ if (fwrite((void *)(port_data(p)), 1, port_position(p), port_file(p)) != port_position(p))
+ s7_warn(sc, 64, "fwrite trouble in close-output-port\n");
+ port_position(p) = 0;
}
+ free(port_data(p));
+ fflush(port_file(p));
+ fclose(port_file(p));
+ port_file(p) = NULL;
}
}
-
- if (len == 0) /* (map 1 "hi" '()) */
+ else
{
- if (((typeflag(sc->code) & (T_ANY_MACRO | T_SYNTAX | T_PROCEDURE)) != 0) ||
- (is_pair(sc->code)) ||
- (s7_is_string(sc->code)) ||
- (s7_is_vector(sc->code)) ||
- (s7_is_hash_table(sc->code)) ||
- (is_hook(sc->code)))
- return(sc->NIL); /* obj has no elements (the circular list case will return S7_LONG_MAX here) */
- return(s7_wrong_type_arg_error(sc, "map", 1, sc->code, "a procedure or something applicable"));
+ if ((is_string_port(p)) &&
+ (port_data(p)))
+ {
+ free(port_data(p));
+ port_data(p) = NULL;
+ port_data_size(p) = 0;
+ port_needs_free(p) = false;
+ }
}
+ port_read_character(p) = closed_port_read_char;
+ port_read_line(p) = closed_port_read_line;
+ port_write_character(p) = closed_port_write_char;
+ port_write_string(p) = closed_port_write_string;
+ port_display(p) = closed_port_display;
+ port_is_closed(p) = true;
+}
- if (len == S7_LONG_MAX)
+void s7_close_output_port(s7_scheme *sc, s7_pointer p)
+{
+ if ((is_immutable_port(p)) ||
+ ((is_output_port(p)) && (port_is_closed(p))) ||
+ (p == sc->F))
+ return;
+ close_output_port(sc, p);
+}
+
+
+static s7_pointer c_close_output_port(s7_scheme *sc, s7_pointer pt)
+{
+ if (!is_output_port(pt))
{
- /* all args are circular lists, or perhaps an odd scheme type (see comment under for-each) */
- for (x = cdr(args); (is_pair(x)) && (is_pair(car(x))); x = cdr(x)) {}
- if (!is_pair(x))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "map's arguments are circular lists! ~A"), cdr(args))));
+ if (pt == sc->F) return(sc->UNSPECIFIED);
+ method_or_bust_with_type(sc, pt, sc->CLOSE_OUTPUT_PORT, set_plist_1(sc, pt), AN_OUTPUT_PORT, 0);
}
+ if (!(is_immutable_port(pt)))
+ s7_close_output_port(sc, pt);
+ return(sc->UNSPECIFIED);
+}
+
+static s7_pointer g_close_output_port(s7_scheme *sc, s7_pointer args)
+{
+ #define H_close_output_port "(close-output-port port) closes the port"
+ #define Q_close_output_port s7_make_signature(sc, 2, sc->T, sc->IS_OUTPUT_PORT)
+ return(c_close_output_port(sc, car(args)));
+}
- sc->args = s7_cons(sc, make_mutable_integer(sc, 0),
- s7_cons(sc, s7_make_integer(sc, len),
- s7_cons(sc, sc->NIL,
- safe_reverse_in_place(sc, sc->z))));
+PF_TO_PF(close_output_port, c_close_output_port)
- sc->y = sc->NIL;
- sc->z = sc->NIL;
- if (next_map(sc))
- push_stack(sc, opcode(OP_APPLY), sc->args, sc->code);
- return(sc->NIL);
+/* -------- read character functions -------- */
+
+static int file_read_char(s7_scheme *sc, s7_pointer port)
+{
+ return(fgetc(port_file(port)));
}
+static int function_read_char(s7_scheme *sc, s7_pointer port)
+{
+ return(character((*(port_input_function(port)))(sc, S7_READ_CHAR, port)));
+}
+
+static int string_read_char(s7_scheme *sc, s7_pointer port)
+{
+ if (port_data_size(port) <= port_position(port)) /* port_string_length is 0 if no port string */
+ return(EOF);
+ return((unsigned char)port_data(port)[port_position(port)++]);
+}
-/* -------------------------------- multiple-values -------------------------------- */
-static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
+static int output_read_char(s7_scheme *sc, s7_pointer port)
{
- if (sc->stack_end > sc->stack_start)
- {
- /* code = args yet to eval in order, args = evalled args reversed */
- int top;
- s7_pointer x;
- top = s7_stack_top(sc) - 1;
+ simple_wrong_type_argument_with_type(sc, sc->READ_CHAR, port, AN_INPUT_PORT);
+ return(0);
+}
- switch ((opcode_t)stack_op(sc->stack, top))
- {
- /* the normal case -- splice values into caller's args */
- case OP_EVAL_ARGS1:
- /* it's not safe to simply reverse args and tack the current stacked args onto its (new) end,
- * setting stacked args to cdr of reversed-args and returning car because the list (args)
- * can be some variable's value in a macro expansion via ,@ and reversing it in place
- * (all this to avoid consing), clobbers the variable's value.
- */
- for (x = args; cdr(x) != sc->NIL; x = cdr(x))
- stack_args(sc->stack, top) = s7_cons(sc, car(x), stack_args(sc->stack, top));
- return(car(x));
+static int closed_port_read_char(s7_scheme *sc, s7_pointer port)
+{
+ simple_wrong_type_argument_with_type(sc, sc->READ_CHAR, port, AN_OPEN_PORT);
+ return(0);
+}
- /* what about values-assoc which would splice in the value in the alist based on the head of the spliced-into list?
- * this is aimed at objects-as-alists
- * '((+ . ((obj+ self))) ...)? so (+ ... obj ...) becomes (+ (obj+ obj ...) ...)?
- */
- /* look for errors here rather than glomming up the set! and let code */
- case OP_SET1: /* (set! var (values 1 2 3)) */
- set_multiple_value(args);
- return(eval_error(sc, "can't set! some variable to ~A", args));
- case OP_LET1: /* (let ((var (values 1 2 3))) ...) */
- case OP_LET_STAR1:
- case OP_LETREC1:
- set_multiple_value(args);
- return(eval_error_with_name(sc, "~A: can't bind some variable to ~A", args));
+/* -------- read line functions -------- */
- /* handle 'and' and 'or' specially */
- case OP_AND1:
- for (x = args; cdr(x) != sc->NIL; x = cdr(x))
- if (car(x) == sc->F)
- return(sc->F);
- return(car(x));
+static s7_pointer output_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+{
+ return(simple_wrong_type_argument_with_type(sc, sc->READ_LINE, port, AN_INPUT_PORT));
+}
- case OP_OR1:
- for (x = args; cdr(x) != sc->NIL; x = cdr(x))
- if (car(x) != sc->F)
- return(car(x));
- return(car(x));
- case OP_BARRIER:
- pop_stack(sc);
- return(splice_in_values(sc, args));
+static s7_pointer closed_port_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+{
+ return(simple_wrong_type_argument_with_type(sc, sc->READ_LINE, port, AN_OPEN_PORT));
+}
- default:
- break;
- }
+
+static s7_pointer function_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+{
+ return((*(port_input_function(port)))(sc, S7_READ_LINE, port));
+}
+
+
+static s7_pointer stdin_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
+{
+ if (sc->read_line_buf == NULL)
+ {
+ sc->read_line_buf_size = 1024;
+ sc->read_line_buf = (char *)malloc(sc->read_line_buf_size * sizeof(char));
}
- /* let it meander back up the call chain until someone knows where to splice it */
- set_multiple_value(args);
- return(args);
+ if (fgets(sc->read_line_buf, sc->read_line_buf_size, stdin) != NULL)
+ return(s7_make_string(sc, sc->read_line_buf)); /* fgets adds the trailing '\0' */
+ return(s7_make_string_with_length(sc, NULL, 0));
}
-static s7_pointer g_values(s7_scheme *sc, s7_pointer args)
+static s7_pointer file_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
{
- #define H_values "(values obj ...) splices its arguments into whatever list holds it (its 'continuation')"
+ char *buf;
+ int read_size, previous_size = 0;
- if (args == sc->NIL)
+ if (sc->read_line_buf == NULL)
{
- if ((opcode_t)stack_op(sc->stack, s7_stack_top(sc) - 1) == OP_SET1) /* (set! var (values)) */
- return(eval_error(sc, "set!: can't assign (values) to something", args));
- return(sc->NO_VALUE);
+ sc->read_line_buf_size = 1024;
+ sc->read_line_buf = (char *)malloc(sc->read_line_buf_size * sizeof(char));
}
- /* this was sc->NIL until 16-Jun-10,
- * nil is consistent with the implied values call in call/cc (if no args, the continuation function returns '())
- * hmmm...
- * Guile complains ("too few values returned to continuation") in the call/cc case, and
- * (equal? (if #f #f) (* (values))) complains "Zero values returned to single-valued continuation"
- * so perhaps call/cc should also return #<unspecified> -- I don't know what is best.
- */
-
- if (cdr(args) == sc->NIL)
- return(car(args));
+ buf = sc->read_line_buf;
+ read_size = sc->read_line_buf_size;
- return(splice_in_values(sc, args));
+ while (true)
+ {
+ char *p, *rtn;
+ size_t len;
+
+ p = fgets(buf, read_size, port_file(port));
+ if (!p)
+ return(sc->EOF_OBJECT);
+
+ rtn = strchr(buf, (int)'\n');
+ if (rtn)
+ {
+ port_line_number(port)++;
+ return(s7_make_string_with_length(sc, sc->read_line_buf, (with_eol) ? (previous_size + rtn - p + 1) : (previous_size + rtn - p)));
+ }
+ /* if no newline, then either at eof or need bigger buffer */
+ len = strlen(sc->read_line_buf);
+
+ if ((len + 1) < sc->read_line_buf_size)
+ return(s7_make_string_with_length(sc, sc->read_line_buf, len));
+
+ previous_size = sc->read_line_buf_size;
+ sc->read_line_buf_size *= 2;
+ sc->read_line_buf = (char *)realloc(sc->read_line_buf, sc->read_line_buf_size * sizeof(char));
+ read_size = previous_size;
+ previous_size -= 1;
+ buf = (char *)(sc->read_line_buf + previous_size);
+ }
+ return(sc->EOF_OBJECT);
}
-s7_pointer s7_values(s7_scheme *sc, int num_values, ...)
+static s7_pointer string_read_line(s7_scheme *sc, s7_pointer port, bool with_eol, bool copied)
{
- int i;
- va_list ap;
- s7_pointer p;
-
- if (num_values == 0)
- return(sc->NIL);
+ unsigned int i, port_start;
+ unsigned char *port_str, *cur, *start;
- sc->w = sc->NIL;
- va_start(ap, num_values);
- for (i = 0; i < num_values; i++)
- sc->w = s7_cons(sc, va_arg(ap, s7_pointer), sc->w);
- va_end(ap);
+ port_start = port_position(port);
+ port_str = port_data(port);
+ start = (unsigned char *)(port_str + port_start);
- p = sc->w;
- sc->w = sc->NIL;
+ cur = (unsigned char *)strchr((const char *)start, (int)'\n'); /* this can run off the end making valgrind unhappy, but I think it's innocuous */
+ if (cur)
+ {
+ port_line_number(port)++;
+ i = cur - port_str;
+ port_position(port) = i + 1;
+ if (copied)
+ return(s7_make_string_with_length(sc, (const char *)start, ((with_eol) ? i + 1 : i) - port_start));
+ return(make_string_wrapper_with_length(sc, (char *)start, ((with_eol) ? i + 1 : i) - port_start));
+ }
+ i = port_data_size(port);
+ port_position(port) = i;
+ if (i <= port_start) /* the < part can happen -- if not caught we try to create a string of length -1 -> segfault */
+ return(sc->EOF_OBJECT);
- return(g_values(sc, safe_reverse_in_place(sc, p)));
+ if (copied)
+ return(s7_make_string_with_length(sc, (const char *)start, i - port_start));
+ return(make_string_wrapper_with_length(sc, (char *)start, i - port_start));
}
+/* -------- write character functions -------- */
-/* -------------------------------- quasiquote -------------------------------- */
-
-static s7_pointer g_qq_list(s7_scheme *sc, s7_pointer args)
+static void resize_port_data(s7_pointer pt, int new_size)
{
- #define H_qq_list "({list} ...) returns its arguments in a list (internal to quasiquote)"
+ int loc;
+ loc = port_data_size(pt);
+ port_data_size(pt) = new_size;
+ port_data(pt) = (unsigned char *)realloc(port_data(pt), new_size * sizeof(unsigned char));
+ memclr((void *)(port_data(pt) + loc), new_size - loc);
+}
- s7_pointer x, y, px;
+static void string_write_char(s7_scheme *sc, int c, s7_pointer pt)
+{
+ if (port_position(pt) >= port_data_size(pt))
+ resize_port_data(pt, port_data_size(pt) * 2);
+ port_data(pt)[port_position(pt)++] = c;
+}
- for (x = args; is_pair(x); x = cdr(x))
- if (car(x) == sc->NO_VALUE)
- break;
-
- if (x == sc->NIL)
- return(args);
+static void stdout_write_char(s7_scheme *sc, int c, s7_pointer port)
+{
+ fputc(c, stdout);
+}
- /* this is not maximally efficient, but it's not important:
- * we've hit the rare special case where ({apply} {values} '())) needs to be ignored
- * in the splicing process (i.e. the arglist acts as if the thing never happened)
- */
- px = sc->NIL;
- for (x = args, y = args; is_pair(y); y = cdr(y))
- if (car(y) != sc->NO_VALUE)
- {
- car(x) = car(y);
- px = x;
- x = cdr(x);
- }
-
- if ((y != sc->NIL) &&
- (y != sc->NO_VALUE))
- cdr(x) = cdr(y);
- else
- {
- sc->no_values--;
- if (px == sc->NIL)
- return(sc->NIL);
- cdr(px) = sc->NIL;
- }
+static void stderr_write_char(s7_scheme *sc, int c, s7_pointer port)
+{
+ fputc(c, stderr);
+}
- return(args);
+static void function_write_char(s7_scheme *sc, int c, s7_pointer port)
+{
+ (*(port_output_function(port)))(sc, c, port);
}
-static s7_pointer g_qq_values(s7_scheme *sc, s7_pointer args)
+#define PORT_DATA_SIZE 256
+static void file_write_char(s7_scheme *sc, int c, s7_pointer port)
{
- #define H_qq_values "(apply {values} arg) is the quasiquote internal form for \", at arg\""
-
- /* for quasiquote handling: (apply values car(args)) if args not nil, else nil
- * (values) -> #<unspecified> which is not wanted in this context.
- */
- if (args == sc->NIL)
+ if (port_position(port) == PORT_DATA_SIZE)
{
- sc->no_values++;
- return(sc->NO_VALUE);
+ if (fwrite((void *)(port_data(port)), 1, PORT_DATA_SIZE, port_file(port)) != PORT_DATA_SIZE)
+ s7_warn(sc, 64, "fwrite trouble during write-char\n");
+ port_position(port) = 0;
}
- return(g_values(sc, args));
+ port_data(port)[port_position(port)++] = (unsigned char)c;
}
-/* new version uses apply values for unquote_splicing
- *
- * (define-macro (hi a) `(+ 1 ,a) == (list '+ 1 a)
- * (define-macro (hi a) ``(+ 1 ,,a) == (list list '+ 1 (list quote a)))
- *
- * (define-macro (hi a) `(+ 1 , at a) == (list '+ 1 (apply values a))
- * (define-macro (hi a) ``(+ 1 ,, at a) == (list list '+ 1 (apply values a))
- *
- * this is not the same as CL's quasiquote; for example:
- * [1]> (let ((a 1) (b 2)) `(,a , at b))
- * (1 . 2)
- * in s7 this is an error.
- */
-
-static bool is_simple_code(s7_scheme *sc, s7_pointer form)
+static void input_write_char(s7_scheme *sc, int c, s7_pointer port)
{
- s7_pointer tmp;
- for (tmp = form; is_pair(tmp); tmp = cdr(tmp))
- if (is_pair(car(tmp)))
- {
- if (!is_simple_code(sc, car(tmp)))
- return(false);
- }
- else
- {
- if ((car(tmp) == sc->UNQUOTE) ||
-#if WITH_UNQUOTE_SPLICING
- (car(tmp) == sc->UNQUOTE_SPLICING) ||
-#endif
- ((car(tmp) == sc->NIL) && (cdr(tmp) == sc->NIL)))
- return(false);
- }
- return(tmp == sc->NIL);
+ simple_wrong_type_argument_with_type(sc, sc->WRITE_CHAR, port, AN_OUTPUT_PORT);
}
-static s7_pointer g_quasiquote_1(s7_scheme *sc, s7_pointer form)
+static void closed_port_write_char(s7_scheme *sc, int c, s7_pointer port)
{
- if (!is_pair(form))
- {
- if (!s7_is_symbol(form))
- {
- /* things that evaluate to themselves don't need to be quoted.
- * but this means `() -> () whereas below `(1) -> '(1) -- should nil here return '()?
- * (this also affects vector constants since they call g_quasiquote at run time in OP_READ_QUASIQUOTE_VECTOR)
- */
- return(form);
- }
- return(make_list_2(sc, sc->QUOTE, form));
- }
-
- if (car(form) == sc->UNQUOTE)
- {
- if (cddr(form) != sc->NIL)
- return(eval_error(sc, "unquote: too many arguments, ~S", form));
- return(cadr(form));
- }
+ simple_wrong_type_argument_with_type(sc, sc->WRITE_CHAR, port, AN_OPEN_PORT);
+}
-#if WITH_UNQUOTE_SPLICING
- if (car(form) == sc->UNQUOTE_SPLICING)
- return(make_list_3(sc, sc->QQ_APPLY, sc->QQ_VALUES, cadr(form)));
-#endif
- /* it's a list, so return the list with each element handled as above.
- * we try to support dotted lists which makes the code much messier.
- */
-
- /* if no element of the list is a list or unquote, just return the original quoted */
- if (is_simple_code(sc, form))
- return(make_list_2(sc, sc->QUOTE, form));
- {
- int len, i, loc;
- s7_pointer orig, bq, old_scw;
- bool dotted = false;
+/* -------- write string functions -------- */
- len = s7_list_length(sc, form);
- if (len < 0)
- {
- len = -len;
- dotted = true;
- }
+static void input_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+{
+ simple_wrong_type_argument_with_type(sc, sc->WRITE, port, AN_OUTPUT_PORT);
+}
- old_scw = sc->w;
- loc = s7_gc_protect(sc, old_scw);
- sc->w = sc->NIL;
- for (i = 0; i <= len; i++)
- sc->w = s7_cons(sc, sc->NIL, sc->w);
+static void closed_port_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+{
+ simple_wrong_type_argument_with_type(sc, sc->WRITE, port, AN_OPEN_PORT);
+}
- car(sc->w) = sc->QQ_LIST;
-
- if (!dotted)
- {
- /* fprintf(stderr, "%s\n", s7_object_to_c_string(sc, form)); */
- for (orig = form, bq = cdr(sc->w), i = 0; i < len; i++, orig = cdr(orig), bq = cdr(bq))
- {
-#if WITH_UNQUOTE_SPLICING
- if ((is_pair(orig)) &&
- ((cadr(orig) == sc->UNQUOTE) ||
- (cadr(orig) == sc->UNQUOTE_SPLICING)))
- {
- /* `(1 . ,2) -> '(1 unquote 2) -> '(1 . 2)
- */
- car(bq) = g_quasiquote_1(sc, car(orig));
- cdr(bq) = sc->NIL;
- if (cadr(orig) == sc->UNQUOTE)
- sc->w = make_list_3(sc, sc->QQ_APPEND, sc->w, caddr(orig));
- else
- {
- /* CL doesn't accept this case at all, but we accept `(1 . ,@('(2 3))) -> '(1 2 3)
- */
- if ((!is_pair(caddr(orig))) ||
- (cdddr(orig) != sc->NIL) ||
- (!is_pair(caaddr(orig))))
- {
- s7_gc_unprotect_at(sc, loc);
- return(read_error(sc, "stray dot?"));
- }
- sc->w = make_list_3(sc, sc->QQ_APPEND, sc->w, caaddr(orig));
- }
- break;
- }
- else car(bq) = g_quasiquote_1(sc, car(orig));
-#else
- if ((is_pair(orig)) &&
- (cadr(orig) == sc->UNQUOTE))
- {
- /* `(1 . ,(+ 1 1)) -> '(1 unquote (+ 1 1)) -> '(1 . 2)
- * `(1 . ,@'((2 3))) -> (1 unquote ({apply} {values} '((2 3)))) -> ({append} ({list} 1) ({apply} {values} '((2 3)))) -> '(1 2 3)
- * this used to be `(1 . ,@('(2 3))).
- * This now becomes (1 unquote ({apply} {values} ('(2 3)))) -> ({append} ({list} 1) ({apply} {values} ('(2 3)))) -> error
- * `(1 . (,@'(2 3))) works in both cases, and `(1 . (,(+ 1 1)))
- * so do we actually need this block? `(1 ,@'(2 3)) if undotted
- */
- car(bq) = g_quasiquote_1(sc, car(orig));
- cdr(bq) = sc->NIL;
- sc->w = make_list_3(sc, sc->QQ_APPEND, sc->w, caddr(orig));
- break;
- }
- else car(bq) = g_quasiquote_1(sc, car(orig));
-#endif
- }
- /* fprintf(stderr, "%s\n", s7_object_to_c_string(sc, sc->w)); */
- }
- else
- {
- /* `(1 2 . 3) */
- len --;
- for (orig = form, bq = cdr(sc->w), i = 0; i < len; i++, orig = cdr(orig), bq = cdr(bq))
- car(bq) = g_quasiquote_1(sc, car(orig));
- car(bq) = g_quasiquote_1(sc, car(orig));
- sc->w = make_list_3(sc, sc->QQ_APPEND, sc->w, g_quasiquote_1(sc, cdr(orig)));
- /* quasiquote might quote a symbol in cdr(orig), so it's not completely pointless */
- }
+static void input_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+ simple_wrong_type_argument_with_type(sc, sc->WRITE, port, AN_OUTPUT_PORT);
+}
- bq = sc->w;
- sc->w = old_scw;
- s7_gc_unprotect_at(sc, loc);
+static void closed_port_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+ simple_wrong_type_argument_with_type(sc, sc->WRITE, port, AN_OPEN_PORT);
+}
- return(bq);
- }
+static void stdout_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+{
+ if (str[len] == '\0')
+ fputs(str, stdout);
+ else
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ fputc(str[i], stdout);
+ }
}
+static void stderr_write_string(s7_scheme *sc, const char *str, int len, s7_pointer port)
+{
+ if (str[len] == '\0')
+ fputs(str, stderr);
+ else
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ fputc(str[i], stderr);
+ }
+}
-static s7_pointer g_quasiquote(s7_scheme *sc, s7_pointer args)
+static void string_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
{
- /* this is for explicit quasiquote support, not the backquote stuff in macros */
- return(g_quasiquote_1(sc, car(args)));
+ int new_len; /* len is known to be non-zero */
+
+ new_len = port_position(pt) + len;
+ if (new_len >= (int)port_data_size(pt))
+ resize_port_data(pt, new_len * 2);
+
+ memcpy((void *)(port_data(pt) + port_position(pt)), (void *)str, len);
+ /* memcpy is much faster than the equivalent while loop */
+ port_position(pt) = new_len;
}
+static s7_pointer write_string_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ check_for_substring_temp(sc, expr);
+ return(f);
+}
-/* ---------------- reader funcs for eval ---------------- */
-static void back_up_stack(s7_scheme *sc)
+static void file_display(s7_scheme *sc, const char *s, s7_pointer port)
{
- opcode_t top_op;
- top_op =(opcode_t)stack_op(sc->stack, s7_stack_top(sc) - 1);
- if (top_op == OP_READ_DOT)
+ if (s)
{
- pop_stack(sc);
- top_op = (opcode_t)stack_op(sc->stack, s7_stack_top(sc) - 1);
+ if (port_position(port) > 0)
+ {
+ if (fwrite((void *)(port_data(port)), 1, port_position(port), port_file(port)) != port_position(port))
+ s7_warn(sc, 64, "fwrite trouble in display\n");
+ port_position(port) = 0;
+ }
+ if (fputs(s, port_file(port)) == EOF)
+ s7_warn(sc, 64, "write to %s: %s\n", port_filename(port), strerror(errno));
}
- if (top_op == OP_READ_VECTOR)
+}
+
+static void file_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
+{
+ int new_len;
+ new_len = port_position(pt) + len;
+ if (new_len >= PORT_DATA_SIZE)
{
- pop_stack(sc);
- top_op = (opcode_t)stack_op(sc->stack, s7_stack_top(sc) - 1);
+ if (port_position(pt) > 0)
+ {
+ if (fwrite((void *)(port_data(pt)), 1, port_position(pt), port_file(pt)) != port_position(pt))
+ s7_warn(sc, 64, "fwrite trouble in write-string\n");
+ port_position(pt) = 0;
+ }
+ if (fwrite((void *)str, 1, len, port_file(pt)) != (size_t)len)
+ s7_warn(sc, 64, "fwrite trouble in write-string\n");
+ }
+ else
+ {
+ memcpy((void *)(port_data(pt) + port_position(pt)), (void *)str, len);
+ port_position(pt) = new_len;
}
- if (top_op == OP_READ_QUOTE)
- pop_stack(sc);
}
+static void string_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+ if (s)
+ string_write_string(sc, s, safe_strlen(s), port);
+}
-static token_t token(s7_scheme *sc);
-static token_t read_sharp(s7_scheme *sc, s7_pointer pt)
+static void function_display(s7_scheme *sc, const char *s, s7_pointer port)
{
- int c;
- /* inchar can return EOF, so it can't be used directly as an index into the digits array */
- c = inchar(pt);
- if (c == EOF)
- s7_error(sc, sc->READ_ERROR,
- make_list_1(sc, make_protected_string(sc, "unexpected '#' at end of input")));
+ if (s)
+ {
+ for (; *s; s++)
+ (*(port_output_function(port)))(sc, *s, port);
+ }
+}
+
+static void function_write_string(s7_scheme *sc, const char *str, int len, s7_pointer pt)
+{
+ int i;
+ for (i = 0; i < len; i++)
+ (*(port_output_function(pt)))(sc, str[i], pt);
+}
- sc->w = small_int(1);
- if (c == '(')
- return(TOKEN_VECTOR);
+static void stdout_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+ if (s) fputs(s, stdout);
+}
- if (isdigit(c)) /* #2D(...) */
- {
- int dims, dig, d, loc = 0;
- sc->strbuf[loc++] = c;
- dims = digits[c];
- while (true)
- {
- d = inchar(pt);
- if (d == EOF)
- s7_error(sc, sc->READ_ERROR,
- make_list_1(sc, make_protected_string(sc, "unexpected end of input while reading #n...")));
+static void stderr_display(s7_scheme *sc, const char *s, s7_pointer port)
+{
+ if (s) fputs(s, stderr);
+}
- dig = digits[d];
- if (dig >= 10) break;
- dims = dig + (dims * 10);
- sc->strbuf[loc++] = d;
- }
- sc->strbuf[loc++] = d;
- if ((d == 'D') || (d == 'd'))
- {
- d = inchar(pt);
- if (d == EOF)
- s7_error(sc, sc->READ_ERROR,
- make_list_1(sc, make_protected_string(sc, "unexpected end of input while reading #nD...")));
- sc->strbuf[loc++] = d;
- if (d == '(')
- {
- sc->w = s7_make_integer(sc, dims);
- return(TOKEN_VECTOR);
- }
- }
- /* try to back out */
- for (d = loc - 1; d > 0; d--)
- backchar(sc->strbuf[d], pt);
- }
+static s7_pointer g_write_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_write_string "(write-string str port start end) writes str to port."
+ #define Q_write_string s7_make_circular_signature(sc, 3, 4, sc->IS_STRING, sc->IS_STRING, sc->IS_OUTPUT_PORT, sc->IS_INTEGER)
+ s7_pointer str, port;
+ s7_int start = 0, end;
-#if (!S7_DISABLE_DEPRECATED)
- if (c == ':') /* turn #: into : -- this is for compatiblity with Guile, #:optional in particular */
- {
- sc->strbuf[0] = ':';
- return(TOKEN_ATOM);
- }
-#endif
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->WRITE_STRING, args, T_STRING, 1);
- /* block comments in either #! ... !# */
- if (c == '!')
+ end = string_length(str);
+ if (!is_null(cdr(args)))
{
- char last_char;
- last_char = ' ';
- while ((c = inchar(pt)) != EOF)
+ s7_pointer inds;
+ port = cadr(args);
+ inds = cddr(args);
+ if (!is_null(inds))
{
- if ((c == '#') &&
- (last_char == '!'))
- break;
- last_char = c;
+ s7_pointer p;
+ p = start_and_end(sc, sc->WRITE_STRING, NULL, inds, args, 3, &start, &end);
+ if (p != sc->GC_NIL) return(p);
}
- if (c == EOF)
- s7_error(sc, sc->READ_ERROR,
- make_list_1(sc, make_protected_string(sc, "unexpected end of input while reading #!")));
- return(token(sc));
}
-
- /* or #| ... |# */
- if (c == '|')
+ else port = sc->output_port;
+ if (!is_output_port(port))
{
- char last_char;
- last_char = ' ';
- while ((c = inchar(pt)) != EOF)
+ if (port == sc->F)
{
- if ((c == '#') &&
- (last_char == '|'))
- break;
- last_char = c;
+ s7_pointer x;
+ int len;
+ if ((start == 0) && (end == string_length(str)))
+ return(str);
+ len = (int)(end - start);
+ x = s7_make_string_with_length(sc, (char *)(string_value(str) + start), len);
+ string_value(x)[len] = 0;
+ return(x);
}
- if (c == EOF)
- s7_error(sc, sc->READ_ERROR,
- make_list_1(sc, make_protected_string(sc, "unexpected end of input while reading #|")));
- return(token(sc));
+ method_or_bust_with_type(sc, port, sc->WRITE_STRING, args, AN_OUTPUT_PORT, 2);
}
-
- sc->strbuf[0] = c;
- return(TOKEN_SHARP_CONST); /* next stage notices any errors */
-}
+ if (start == 0)
+ port_write_string(port)(sc, string_value(str), end, port);
+ else port_write_string(port)(sc, (char *)(string_value(str) + start), (end - start), port);
+ return(str);
+}
+
+static s7_pointer c_write_string(s7_scheme *sc, s7_pointer x) {return(g_write_string(sc, set_plist_1(sc, x)));}
+PF_TO_PF(write_string, c_write_string)
-static token_t read_semicolon(s7_scheme *sc, s7_pointer pt)
+
+
+/* -------- skip to newline readers -------- */
+
+static token_t file_read_semicolon(s7_scheme *sc, s7_pointer pt)
{
int c;
- if (sc->input_is_file)
- {
- do (c = fgetc(port_file(pt))); while ((c != '\n') && (c != EOF));
- port_line_number(pt)++;
- if (c == EOF)
- return(TOKEN_EOF);
- }
- else
+ do (c = fgetc(port_file(pt))); while ((c != '\n') && (c != EOF));
+ port_line_number(pt)++;
+ if (c == EOF)
+ return(TOKEN_EOF);
+ return(token(sc));
+}
+
+
+static token_t string_read_semicolon(s7_scheme *sc, s7_pointer pt)
+{
+ const char *orig_str, *str;
+ str = (const char *)(port_data(pt) + port_position(pt));
+ orig_str = strchr(str, (int)'\n');
+ if (!orig_str)
{
- do (c = port_string(pt)[port_string_point(pt)++]); while ((c != '\n') && (c != 0));
- port_line_number(pt)++;
- if (c == 0)
- return(TOKEN_EOF);
+ port_position(pt) = port_data_size(pt);
+ return(TOKEN_EOF);
}
+ port_position(pt) += (orig_str - str + 1); /* + 1 because strchr leaves orig_str pointing at the newline */
+ port_line_number(pt)++;
return(token(sc));
}
-static token_t read_comma(s7_scheme *sc, s7_pointer pt)
+/* -------- white space readers -------- */
+
+static int file_read_white_space(s7_scheme *sc, s7_pointer port)
{
int c;
- /* here we probably should check for symbol names that start with "@":
-
- :(defmacro hi (@foo) `(+ , at foo 1))
- hi
- :(hi 2)
- ;foo: unbound variable
-
- but
+ while (is_white_space(c = fgetc(port_file(port))))
+ if (c == '\n')
+ port_line_number(port)++;
+ return(c);
+}
- :(defmacro hi (.foo) `(+ ,.foo 1))
- hi
- :(hi 2)
- 3
- and ambiguous:
- :(define-macro (hi @foo . foo) `(list , at foo))
+static int terminated_string_read_white_space(s7_scheme *sc, s7_pointer pt)
+{
+ const unsigned char *str;
+ unsigned char c;
+ /* here we know we have null termination and white_space[#\null] is false.
+ */
+ str = (const unsigned char *)(port_data(pt) + port_position(pt));
- what about , @foo -- is the space significant? We accept ,@ foo.
- */
+ while (white_space[c = *str++]) /* (let ((ÿa 1)) ÿa) -- 255 is not -1 = EOF */
+ if (c == '\n')
+ port_line_number(pt)++;
+ if (c)
+ port_position(pt) = str - port_data(pt);
+ else port_position(pt) = port_data_size(pt);
+ return((int)c);
+}
- if ((c = inchar(pt)) == '@')
- return(TOKEN_AT_MARK);
- if (c == EOF)
- {
- sc->strbuf[0] = ','; /* was '@' which doesn't make any sense */
- return(TOKEN_COMMA); /* was TOKEN_ATOM, which also doesn't seem sensible */
- }
- backchar(c, pt);
- return(TOKEN_COMMA);
+/* name (alphanumeric token) readers */
+
+static void resize_strbuf(s7_scheme *sc, unsigned int needed_size)
+{
+ unsigned int i, old_size;
+ old_size = sc->strbuf_size;
+ while (sc->strbuf_size <= needed_size) sc->strbuf_size *= 2;
+ sc->strbuf = (char *)realloc(sc->strbuf, sc->strbuf_size * sizeof(char));
+ for (i = old_size; i < sc->strbuf_size; i++) sc->strbuf[i] = '\0';
}
-static token_t read_dot(s7_scheme *sc, s7_pointer pt)
+static s7_pointer file_read_name_or_sharp(s7_scheme *sc, s7_pointer pt, bool atom_case)
{
int c;
- c = inchar(pt);
- if (c != EOF)
- {
- backchar(c, pt);
+ unsigned int i = 1;
+ /* sc->strbuf[0] has the first char of the string we're reading */
- if ((!char_ok_in_a_name[c]) && (c != 0))
- return(TOKEN_DOT);
- }
+ do {
+ c = fgetc(port_file(pt)); /* might return EOF */
+ if (c == '\n')
+ port_line_number(pt)++;
+
+ sc->strbuf[i++] = c;
+ if (i >= sc->strbuf_size)
+ resize_strbuf(sc, i);
+ } while ((c != EOF) && (char_ok_in_a_name[c]));
+
+ if ((i == 2) &&
+ (sc->strbuf[0] == '\\'))
+ sc->strbuf[2] = '\0';
else
{
- sc->strbuf[0] = '.';
- return(TOKEN_DOT);
+ if (c != EOF)
+ {
+ if (c == '\n')
+ port_line_number(pt)--;
+ ungetc(c, port_file(pt));
+ }
+ sc->strbuf[i - 1] = '\0';
}
- sc->strbuf[0] = '.';
- return(TOKEN_ATOM); /* i.e. something that can start with a dot like a number */
+
+ if (atom_case)
+ return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR));
+
+ return(make_sharp_constant(sc, sc->strbuf, UNNESTED_SHARP, BASE_10, WITH_OVERFLOW_ERROR));
}
+static s7_pointer file_read_name(s7_scheme *sc, s7_pointer pt)
+{
+ return(file_read_name_or_sharp(sc, pt, true));
+}
-static token_t token(s7_scheme *sc)
+static s7_pointer file_read_sharp(s7_scheme *sc, s7_pointer pt)
{
- int c;
- s7_pointer pt;
+ return(file_read_name_or_sharp(sc, pt, false));
+}
- pt = sc->input_port;
- if (sc->input_is_file)
- {
- while (is_white_space(c = fgetc(port_file(pt))))
- if (c == '\n')
- port_line_number(pt)++;
- if (c == EOF)
- return(TOKEN_EOF);
- }
- else
- {
- char *orig_str, *str;
- unsigned char c1;
- str = (char *)(port_string(pt) + port_string_point(pt));
- if (!(*str)) return(TOKEN_EOF);
+static s7_pointer string_read_name_no_free(s7_scheme *sc, s7_pointer pt)
+{
+ /* sc->strbuf[0] has the first char of the string we're reading */
+ unsigned int k;
+ char *str, *orig_str;
- /* we can't depend on the extra 0 of padding at the end of an input string port --
- * eval_string and others take the given string without copying or padding.
- */
- orig_str = str;
- while (white_space[c1 = (unsigned char)(*str++)]) /* (let ((ÿa 1)) ÿa) -- 255 is not -1 = EOF */
- if (c1 == '\n')
- port_line_number(pt)++;
- if (c1 == 0)
+ str = (char *)(port_data(pt) + port_position(pt));
+
+ if (!char_ok_in_a_name[(unsigned char)*str])
+ {
+ s7_pointer result;
+ result = sc->singletons[(unsigned char)(sc->strbuf[0])];
+ if (!result)
{
- port_string_point(pt) += (str - orig_str - 1);
- return(TOKEN_EOF);
+ sc->strbuf[1] = '\0';
+ result = make_symbol_with_length(sc, sc->strbuf, 1);
+ sc->singletons[(unsigned char)(sc->strbuf[0])] = result;
}
- port_string_point(pt) += (str - orig_str);
- c = c1;
+ return(result);
}
- switch (c)
- {
- case '(':
- return(TOKEN_LEFT_PAREN);
-
- case ')':
- return(TOKEN_RIGHT_PAREN);
-
- case '.':
- return(read_dot(sc, pt));
+ orig_str = (char *)(str - 1);
+ str++;
+ while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
+ k = str - orig_str;
+ if (*str != 0)
+ port_position(pt) += (k - 1);
+ else port_position(pt) = port_data_size(pt);
+
+ /* this is equivalent to:
+ * str = strpbrk(str, "(); \"\t\r\n");
+ * if (!str)
+ * {
+ * k = strlen(orig_str);
+ * str = (char *)(orig_str + k);
+ * }
+ * else k = str - orig_str;
+ * but slightly faster.
+ */
- case '\'':
- return(TOKEN_QUOTE);
-
- case ';':
- return(read_semicolon(sc, pt));
+ if (!number_table[(unsigned char)(*orig_str)])
+ return(make_symbol_with_length(sc, orig_str, k));
- case '"':
- return(TOKEN_DOUBLE_QUOTE);
-
- case '`':
- return(TOKEN_BACK_QUOTE);
-
- case ',':
- return(read_comma(sc, pt));
-
- case '#':
- return(read_sharp(sc, pt));
+ /* eval_c_string string is a constant so we can't set and unset the token's end char */
+ if ((k + 1) >= sc->strbuf_size)
+ resize_strbuf(sc, k + 1);
- default:
- sc->strbuf[0] = c; /* every TOKEN_ATOM return goes to read_delimited_string, so we save a backchar/inchar shuffle by starting the read here */
- return(TOKEN_ATOM);
- }
+ memcpy((void *)(sc->strbuf), (void *)orig_str, k);
+ sc->strbuf[k] = '\0';
+ return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR));
}
-static void resize_strbuf(s7_scheme *sc)
+static s7_pointer string_read_sharp(s7_scheme *sc, s7_pointer pt)
{
- int i, old_size;
- old_size = sc->strbuf_size;
- sc->strbuf_size *= 2;
- sc->strbuf = (char *)realloc(sc->strbuf, sc->strbuf_size * sizeof(char));
- for (i = old_size; i < sc->strbuf_size; i++) sc->strbuf[i] = '\0';
-}
+ /* sc->strbuf[0] has the first char of the string we're reading.
+ * since a *#readers* function might want to get further input, we can't mess with the input even when it is otherwise safe
+ */
+ unsigned int k;
+ char *orig_str, *str;
+ str = (char *)(port_data(pt) + port_position(pt));
-#define WITH_SHARP false
-#define NO_SHARP true
+ if (!char_ok_in_a_name[(unsigned char)*str])
+ {
+ if (sc->strbuf[0] == 'f')
+ return(sc->F);
+ if (sc->strbuf[0] == 't')
+ return(sc->T);
+ if (sc->strbuf[0] == '\\')
+ {
+ /* must be from #\( and friends -- a character that happens to be not ok-in-a-name */
+ sc->strbuf[1] = str[0];
+ sc->strbuf[2] = '\0';
+ port_position(pt)++;
+ }
+ else sc->strbuf[1] = '\0';
+ return(make_sharp_constant(sc, sc->strbuf, UNNESTED_SHARP, BASE_10, WITH_OVERFLOW_ERROR));
+ }
-static s7_pointer read_delimited_string(s7_scheme *sc, bool atom_case)
-{
- s7_pointer pt;
+ orig_str = (char *)(str - 1);
+ str++;
+ while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
+ k = str - orig_str;
+ if (*str != 0)
+ port_position(pt) += (k - 1);
+ else port_position(pt) += k;
- pt = sc->input_port;
- /* sc->strbuf[0] has the 1st char of the string we're reading */
+ if ((k + 1) >= sc->strbuf_size)
+ resize_strbuf(sc, k + 1);
- if (sc->input_is_file)
- {
- int c, i = 1;
- do
- {
- c = fgetc(port_file(pt)); /* might return EOF */
- if (c == '\n')
- port_line_number(pt)++;
+ memcpy((void *)(sc->strbuf), (void *)orig_str, k);
+ sc->strbuf[k] = '\0';
+ return(make_sharp_constant(sc, sc->strbuf, UNNESTED_SHARP, BASE_10, WITH_OVERFLOW_ERROR));
+}
- sc->strbuf[i++] = c;
- if (i >= sc->strbuf_size)
- resize_strbuf(sc);
- }
- while ((c != EOF) && (char_ok_in_a_name[c]));
- if ((i == 2) &&
- (sc->strbuf[0] == '\\'))
- sc->strbuf[2] = '\0';
- else
+static s7_pointer string_read_name(s7_scheme *sc, s7_pointer pt)
+{
+ /* port_string was allocated (and read from a file) so we can mess with it directly */
+ s7_pointer result;
+ unsigned int k;
+ char *orig_str, *str;
+ char endc;
+
+ str = (char *)(port_data(pt) + port_position(pt));
+ if (!char_ok_in_a_name[(unsigned char)*str])
+ {
+ s7_pointer result;
+ result = sc->singletons[(unsigned char)(sc->strbuf[0])];
+ if (!result)
{
- if (c != EOF)
- {
- if (c == '\n')
- port_line_number(pt)--;
- ungetc(c, port_file(pt));
- }
- sc->strbuf[i - 1] = '\0';
+ sc->strbuf[1] = '\0';
+ result = make_symbol_with_length(sc, sc->strbuf, 1);
+ sc->singletons[(unsigned char)(sc->strbuf[0])] = result;
}
+ return(result);
}
- else
- {
- int k = 0;
- char *orig_str, *str;
- orig_str = (char *)(port_string(pt) + port_string_point(pt) - 1);
- str = (char *)(orig_str + 1);
+ orig_str = (char *)(str - 1);
+ str++;
+ while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
+ k = str - orig_str;
+ if (*str != 0)
+ port_position(pt) += (k - 1);
+ else port_position(pt) = port_data_size(pt);
- while (char_ok_in_a_name[(unsigned char)(*str)]) {str++;}
- k = str - orig_str;
- port_string_point(pt) += k;
-
- if ((!atom_case) && /* there's a bizarre special case here \ with the next char #\null: (eval-string "(list \\\x00 1)") */
- (k == 1) &&
- (*orig_str == '\\'))
- {
- /* must be from #\( and friends -- a character that happens to be not ok-in-a-name */
- sc->strbuf[1] = orig_str[1];
- sc->strbuf[2] = '\0';
- return(make_sharp_constant(sc, sc->strbuf, UNNESTED_SHARP, BASE_10));
- }
- else
- {
- if (port_needs_free(pt))
- {
- /* port_string was allocated (and read from a file) so we can mess with it directly */
- s7_pointer result;
- char endc;
-
- endc = orig_str[k];
- orig_str[k] = '\0';
+ if (!number_table[(unsigned char)(*orig_str)])
+ return(make_symbol_with_length(sc, orig_str, k));
- if (atom_case)
- {
- switch (*orig_str)
- {
- case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9':
- case '.': case '+': case '-':
- result = make_atom(sc, orig_str, BASE_10, SYMBOL_OK);
- break;
-
- case '#':
- result = make_sharp_constant(sc, (char *)(orig_str + 1), UNNESTED_SHARP, BASE_10);
- break;
-
- default:
- /* result = make_symbol(sc, orig_str);
- * expanded for speed
- */
- {
- int location;
- location = symbol_table_hash(orig_str);
- result = symbol_table_find_by_name(sc, orig_str, location);
+ endc = (*str);
+ (*str) = '\0';
+ result = make_atom(sc, orig_str, BASE_10, SYMBOL_OK, WITH_OVERFLOW_ERROR);
+ (*str) = endc;
+ return(result);
+}
- if (result == sc->NIL)
- {
- if (*(sc->symbol_table_is_locked))
- result = sc->F;
- else result = symbol_table_add_by_name_at_location(sc, orig_str, location);
- }
- }
- break;
- }
- }
- else result = make_sharp_constant(sc, orig_str, UNNESTED_SHARP, BASE_10);
-
- orig_str[k] = endc;
- if (*str != 0) port_string_point(pt)--;
- /* skipping the null has one minor consequence:
- * (let ((str "(+ 1 2 3)")) (set! (str 2) #\null) (eval-string str)) ; "(+\x001 2 3)" -> 6
- * (let ((str "(+ 1 2 3)")) (set! (str 3) #\null) (eval-string str)) ; "(+ \x00 2 3)" -> missing paren error
- */
- return(result);
- }
-
- /* eval_c_string string is a constant so we can't set and unset the token's end char */
- if ((k + 1) >= sc->strbuf_size)
- resize_strbuf(sc);
-
- memcpy((void *)(sc->strbuf), (void *)orig_str, k);
- if (*str != 0) port_string_point(pt)--;
- sc->strbuf[k] = '\0';
- }
- }
- if (atom_case)
- return(make_atom(sc, sc->strbuf, BASE_10, SYMBOL_OK));
+static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, long max_size, const char *caller)
+{
+ s7_pointer port;
+#ifndef _MSC_VER
+ long size;
+#endif
+ int port_loc;
- return(make_sharp_constant(sc, sc->strbuf, UNNESTED_SHARP, BASE_10));
-}
+ new_cell(sc, port, T_INPUT_PORT);
+ port_loc = s7_gc_protect(sc, port);
+ port_port(port) = alloc_port(sc);
+ port_is_closed(port) = false;
+ port_original_input_string(port) = sc->NIL;
+ port_write_character(port) = input_write_char;
+ port_write_string(port) = input_write_string;
+ /* if we're constantly opening files, and each open saves the file name in permanent
+ * memory, we gradually core-up.
+ */
+ port_filename_length(port) = safe_strlen(name);
+ port_filename(port) = copy_string_with_length(name, port_filename_length(port));
+ port_line_number(port) = 1; /* first line is numbered 1 */
+ add_input_port(sc, port);
-#define NOT_AN_X_CHAR -1
+#ifndef _MSC_VER
+ /* this doesn't work in MS C */
+ fseek(fp, 0, SEEK_END);
+ size = ftell(fp);
+ rewind(fp);
-static int read_x_char(s7_pointer pt)
-{
- /* possible "\xnn" char (write creates these things, so we have to read them)
- * but we could have crazy input like "\x -- with no trailing double quote
+ /* pseudo files (under /proc for example) have size=0, but we can read them, so don't assume a 0 length file is empty
*/
- int d1, d2, c;
- c = inchar(pt);
- if (c == EOF)
- return(NOT_AN_X_CHAR);
+ if ((size > 0) && /* if (size != 0) we get (open-input-file "/dev/tty") -> (open "/dev/tty") read 0 bytes of an expected -1? */
+ ((max_size < 0) || (size < max_size)))
+ {
+ size_t bytes;
+ unsigned char *content;
- d1 = digits[c];
- if (d1 < 16)
+ content = (unsigned char *)malloc((size + 2) * sizeof(unsigned char));
+ bytes = fread(content, sizeof(unsigned char), size, fp);
+ if (bytes != (size_t)size)
+ {
+ char tmp[256];
+ int len;
+ len = snprintf(tmp, 256, "(%s \"%s\") read %ld bytes of an expected %ld?", caller, name, (long)bytes, size);
+ port_write_string(sc->output_port)(sc, tmp, len, sc->output_port);
+ size = bytes;
+ }
+ content[size] = '\0';
+ content[size + 1] = '\0';
+ fclose(fp);
+
+ port_type(port) = STRING_PORT;
+ port_data(port) = content;
+ port_data_size(port) = size;
+ port_position(port) = 0;
+ port_needs_free(port) = true;
+ port_gc_loc(port) = -1;
+ port_read_character(port) = string_read_char;
+ port_read_line(port) = string_read_line;
+ port_display(port) = input_display;
+ port_read_semicolon(port) = string_read_semicolon;
+ port_read_white_space(port) = terminated_string_read_white_space;
+ port_read_name(port) = string_read_name;
+ port_read_sharp(port) = string_read_sharp;
+ }
+ else
{
- c = inchar(pt);
- if (c == EOF)
- return(NOT_AN_X_CHAR);
- d2 = digits[c];
- if (d2 < 16)
- return(16 * d1 + d2); /* following char can be anything, including a number -- we ignore it */
- /* apparently one digit is also ok */
- backchar(c, pt);
- return(d1);
+ port_file(port) = fp;
+ port_type(port) = FILE_PORT;
+ port_needs_free(port) = false;
+ port_read_character(port) = file_read_char;
+ port_read_line(port) = file_read_line;
+ port_display(port) = input_display;
+ port_read_semicolon(port) = file_read_semicolon;
+ port_read_white_space(port) = file_read_white_space;
+ port_read_name(port) = file_read_name;
+ port_read_sharp(port) = file_read_sharp; /* was string_read_sharp?? */
}
- return(NOT_AN_X_CHAR);
+#else
+ /* _stat64 is no better than the fseek/ftell route, and
+ * GetFileSizeEx and friends requires Windows.h which makes hash of everything else.
+ * fread until done takes too long on big files, so use a file port
+ */
+ port_file(port) = fp;
+ port_type(port) = FILE_PORT;
+ port_needs_free(port) = false;
+ port_read_character(port) = file_read_char;
+ port_read_line(port) = file_read_line;
+ port_display(port) = input_display;
+ port_read_semicolon(port) = file_read_semicolon;
+ port_read_white_space(port) = file_read_white_space;
+ port_read_name(port) = file_read_name;
+ port_read_sharp(port) = file_read_sharp;
+#endif
+
+ s7_gc_unprotect_at(sc, port_loc);
+ return(port);
}
-static s7_pointer read_string_constant(s7_scheme *sc, s7_pointer pt)
+static s7_pointer make_input_file(s7_scheme *sc, const char *name, FILE *fp)
{
- /* sc->F => error
- * no check needed here for bad input port and so on
- */
- int i = 0, c;
+ #define MAX_SIZE_FOR_STRING_PORT 5000000
+ return(read_file(sc, fp, name, MAX_SIZE_FOR_STRING_PORT, "open"));
+}
+
+#if (!MS_WINDOWS)
+#include <sys/stat.h>
+#endif
+
+static bool is_directory(const char *filename)
+{
+#if (!MS_WINDOWS)
+ #ifdef S_ISDIR
+ struct stat statbuf;
+ return((stat(filename, &statbuf) >= 0) &&
+ (S_ISDIR(statbuf.st_mode)));
+ #endif
+#endif
+ return(false);
+}
+
+
+static s7_pointer open_input_file_1(s7_scheme *sc, const char *name, const char *mode, const char *caller)
+{
+ FILE *fp;
+ /* see if we can open this file before allocating a port */
+
+ if (is_directory(name))
+ return(file_error(sc, caller, "is a directory", name));
- if (!(sc->input_is_file))
+ errno = 0;
+ fp = fopen(name, mode);
+ if (!fp)
{
- /* try the most common case first */
- char *s, *start, *end;
- start = (char *)(port_string(pt) + port_string_point(pt));
- end = (char *)(port_string(pt) + port_string_length(pt));
- for (s = start; s < end; s++)
+#if (!MS_WINDOWS)
+ if (errno == EINVAL)
+ return(file_error(sc, caller, "invalid mode", mode));
+ #if WITH_GCC
+ /* catch one special case, "~/..." */
+ if ((name[0] == '~') &&
+ (name[1] == '/'))
{
- if (*s == '"') /* switch here no faster */
+ char *home;
+ home = getenv("HOME");
+ if (home)
{
- s7_pointer result;
+ char *filename;
int len;
- len = s - start;
- result = s7_make_terminated_string_with_length(sc, start, len);
- port_string_point(pt) += (len + 1);
- return(result);
- }
- else
- {
- if (*s == '\\')
- {
- if ((s - start) >= sc->strbuf_size)
- resize_strbuf(sc);
- for (i = 0; i < (s - start); i++)
- sc->strbuf[i] = port_string(pt)[port_string_point(pt)++];
- break;
- }
- else
- {
- if (*s == '\n')
- port_line_number(pt)++;
- }
+ len = safe_strlen(name) + safe_strlen(home) + 1;
+ tmpbuf_malloc(filename, len);
+ snprintf(filename, len, "%s%s", home, (char *)(name + 1));
+ fp = fopen(filename, "r");
+ tmpbuf_free(filename, len);
+ if (fp)
+ return(make_input_file(sc, name, fp));
}
}
+ #endif
+#endif
+ return(file_error(sc, caller, strerror(errno), name));
}
+ return(make_input_file(sc, name, fp));
+}
- while (true)
- {
- /* splitting this check out and duplicating the loop was slower?!? */
- if (sc->input_is_file)
- c = fgetc(port_file(pt)); /* not unsigned char! -- could be EOF */
- else
- {
- if (port_string_length(pt) <= port_string_point(pt))
- return(sc->F);
- c = (unsigned char)port_string(pt)[port_string_point(pt)++];
- }
- switch (c)
- {
- case '\n':
- port_line_number(pt)++;
- sc->strbuf[i++] = c;
- break;
-
- case EOF:
- return(sc->F);
-
- case '"':
- return(s7_make_terminated_string_with_length(sc, sc->strbuf, i));
-
- case '\\':
- c = inchar(pt);
+s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode)
+{
+ return(open_input_file_1(sc, name, mode, "open-input-file"));
+}
- if (c == EOF)
- return(sc->F);
- if (c == '\\')
- sc->strbuf[i++] = '\\';
- else
- {
- if (c == '"')
- sc->strbuf[i++] = '"';
- else
- {
- if (c == 'n')
- sc->strbuf[i++] = '\n';
- else
- {
- if (c == 'x')
- {
- c = read_x_char(pt);
- if (c == NOT_AN_X_CHAR)
- return(sc->T);
- sc->strbuf[i++] = (unsigned char)c;
- }
- else
- if (!is_white_space(c))
- return(sc->T);
-
- /* #f here would give confusing error message "end of input", so return #t=bad backslash.
- * this is not optimal. It's easy to forget that backslash needs to be backslashed.
- *
- * the white_space business implements Scheme's \<newline> or \<space> feature -- the character after \ is flushed.
- * It may be that r6rs expects all white space after \ to be flushed, but in that case
- * (string->number "1\ 2") is 12?? Too bizarre.
- */
- }
- }
- }
- break;
+static s7_pointer g_open_input_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_open_input_file "(open-input-file filename (mode \"r\")) opens filename for reading"
+ #define Q_open_input_file s7_make_signature(sc, 3, sc->IS_INPUT_PORT, sc->IS_STRING, sc->IS_STRING)
+ s7_pointer name = car(args);
- default:
- sc->strbuf[i++] = c;
- break;
- }
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->OPEN_INPUT_FILE, args, T_STRING, 1);
+ /* what if the file name is a byte-vector? currently we accept it */
- if (i >= sc->strbuf_size)
- resize_strbuf(sc);
+ if (is_pair(cdr(args)))
+ {
+ s7_pointer mode;
+ mode = cadr(args);
+ if (!is_string(mode))
+ method_or_bust_with_type(sc, mode, sc->OPEN_INPUT_FILE, args, make_string_wrapper(sc, "a string (a mode such as \"r\")"), 2);
+ /* since scheme allows embedded nulls, dumb stuff is accepted here: (open-input-file file "a\x00b") -- should this be an error? */
+ return(open_input_file_1(sc, string_value(name), string_value(mode), "open-input-file"));
}
+ return(open_input_file_1(sc, string_value(name), "r", "open-input-file"));
}
-/* static const char *tokens[12] = {"eof", "left_paren", "right_paren", "dot", "atom", "quote",
- "double_quote", "back_quote", "comma", "at_mark", "sharp_const", "vector"};
-*/
+static void make_standard_ports(s7_scheme *sc)
+{
+ s7_pointer x;
-static s7_pointer read_expression(s7_scheme *sc)
-{
- while (true)
- {
- int c;
- switch (sc->tok)
- {
- case TOKEN_EOF:
- return(sc->EOF_OBJECT);
-
- case TOKEN_VECTOR: /* already read #( -- TOKEN_VECTOR is triggered by #( */
- push_stack(sc, opcode(OP_READ_VECTOR), sc->w, sc->NIL); /* sc->w is the dimensions */
- /* fall through */
-
- case TOKEN_LEFT_PAREN:
- sc->tok = token(sc);
+ /* standard output */
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_OUTPUT_PORT | T_IMMUTABLE);
+ port_port(x) = (port_t *)calloc(1, sizeof(port_t));
+ port_type(x) = FILE_PORT;
+ port_data(x) = NULL;
+ port_is_closed(x) = false;
+ port_filename_length(x) = 8;
+ port_filename(x) = copy_string_with_length("*stdout*", 8);
+ port_file_number(x) = remember_file_name(sc, port_filename(x)); /* these numbers need to be correct for the evaluator (__FUNC__ data) */
+ port_line_number(x) = 0;
+ port_file(x) = stdout;
+ port_needs_free(x) = false;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = stdout_display;
+ port_write_character(x) = stdout_write_char;
+ port_write_string(x) = stdout_write_string;
+ sc->standard_output = x;
- if (sc->tok == TOKEN_RIGHT_PAREN)
- return(sc->NIL);
+ /* standard error */
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_OUTPUT_PORT | T_IMMUTABLE);
+ port_port(x) = (port_t *)calloc(1, sizeof(port_t));
+ port_type(x) = FILE_PORT;
+ port_data(x) = NULL;
+ port_is_closed(x) = false;
+ port_filename_length(x) = 8;
+ port_filename(x) = copy_string_with_length("*stderr*", 8);
+ port_file_number(x) = remember_file_name(sc, port_filename(x));
+ port_line_number(x) = 0;
+ port_file(x) = stderr;
+ port_needs_free(x) = false;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = stderr_display;
+ port_write_character(x) = stderr_write_char;
+ port_write_string(x) = stderr_write_string;
+ sc->standard_error = x;
- if (sc->tok == TOKEN_DOT)
- {
- back_up_stack(sc);
- do {c = inchar(sc->input_port);} while ((c != ')') && (c != EOF));
- return(read_error(sc, "stray dot after '('?")); /* (car '( . )) */
- }
+ /* standard input */
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_INPUT_PORT | T_IMMUTABLE);
+ port_port(x) = (port_t *)calloc(1, sizeof(port_t));
+ port_type(x) = FILE_PORT;
+ port_is_closed(x) = false;
+ port_original_input_string(x) = sc->NIL;
+ port_filename_length(x) = 7;
+ port_filename(x) = copy_string_with_length("*stdin*", 7);
+ port_file_number(x) = remember_file_name(sc, port_filename(x));
+ port_line_number(x) = 0;
+ port_file(x) = stdin;
+ port_needs_free(x) = false;
+ port_read_character(x) = file_read_char;
+ port_read_line(x) = stdin_read_line;
+ port_display(x) = input_display;
+ port_read_semicolon(x) = file_read_semicolon;
+ port_read_white_space(x) = file_read_white_space;
+ port_read_name(x) = file_read_name;
+ port_read_sharp(x) = file_read_sharp;
+ port_write_character(x) = input_write_char;
+ port_write_string(x) = input_write_string;
+ sc->standard_input = x;
- if (sc->tok == TOKEN_EOF)
- return(missing_close_paren_error(sc));
+ s7_define_constant(sc, "*stdin*", sc->standard_input);
+ s7_define_constant(sc, "*stdout*", sc->standard_output);
+ s7_define_constant(sc, "*stderr*", sc->standard_error);
- push_stack(sc, opcode(OP_READ_LIST), sc->NIL, sc->NIL);
- /* all these push_stacks that don't care about code/args look wasteful, but if a read error
- * occurs, we need clean info in the error handler, so it's tricky to optimize this.
- * (and if we do optimize it, it saves maybe %1 of the total stack time).
- */
+ sc->input_port = sc->standard_input;
+ sc->output_port = sc->standard_output;
+ sc->error_port = sc->standard_error;
+ sc->current_file = NULL;
+ sc->current_line = -1;
+}
- if (sc->stack_end >= sc->stack_resize_trigger)
- increase_stack_size(sc);
- break;
-
- case TOKEN_QUOTE:
- push_stack(sc, opcode(OP_READ_QUOTE), sc->NIL, sc->NIL);
- sc->tok = token(sc);
- break;
-
- case TOKEN_BACK_QUOTE:
- sc->tok = token(sc);
- if (sc->tok == TOKEN_VECTOR)
- {
- push_stack(sc, opcode(OP_READ_QUASIQUOTE_VECTOR), sc->w, sc->NIL);
- sc->tok= TOKEN_LEFT_PAREN;
- }
- else push_stack(sc, opcode(OP_READ_QUASIQUOTE), sc->NIL, sc->NIL);
- break;
-
- case TOKEN_COMMA:
- push_stack(sc, opcode(OP_READ_UNQUOTE), sc->NIL, sc->NIL);
- sc->tok = token(sc);
- break;
-
- case TOKEN_AT_MARK:
- push_stack(sc, opcode(OP_READ_APPLY_VALUES), sc->NIL, sc->NIL);
- sc->tok = token(sc);
- break;
-
- case TOKEN_ATOM:
- return(read_delimited_string(sc, NO_SHARP));
- /* If reading list (from lparen), this will finally get us to op_read_list */
-
- case TOKEN_DOUBLE_QUOTE:
- sc->value = read_string_constant(sc, sc->input_port);
- if (sc->value == sc->F) /* can happen if input code ends in the middle of a string */
- return(read_error(sc, "end of input encountered while in a string"));
- if (sc->value == sc->T)
- return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
+s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode)
+{
+ FILE *fp;
+ s7_pointer x;
+ /* see if we can open this file before allocating a port */
- return(sc->value);
-
- case TOKEN_SHARP_CONST:
- sc->value = read_delimited_string(sc, WITH_SHARP);
+ errno = 0;
+ fp = fopen(name, mode);
+ if (!fp)
+ {
+#if (!MS_WINDOWS)
+ if (errno == EINVAL)
+ return(file_error(sc, "open-output-file", "invalid mode", mode));
+#endif
+ return(file_error(sc, "open-output-file", strerror(errno), name));
+ }
- /* here we need the following character and form
- * strbuf[0] == '#', false above = # case, not an atom
- */
- if (sc->value == sc->NIL)
- return(read_error(sc, "undefined # expression"));
- return(sc->value);
+ new_cell(sc, x, T_OUTPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = FILE_PORT;
+ port_is_closed(x) = false;
+ port_filename_length(x) = safe_strlen(name);
+ port_filename(x) = copy_string_with_length(name, port_filename_length(x));
+ port_line_number(x) = 1;
+ port_file(x) = fp;
+ port_needs_free(x) = false;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = file_display;
+ port_write_character(x) = file_write_char;
+ port_write_string(x) = file_write_string;
+ port_position(x) = 0;
+ port_data_size(x) = PORT_DATA_SIZE;
+ port_data(x) = (unsigned char *)malloc(PORT_DATA_SIZE); /* was +8? */
+ add_output_port(sc, x);
+ return(x);
+}
- case TOKEN_DOT: /* (catch #t (lambda () (+ 1 . . )) (lambda args 'hiho)) */
- back_up_stack(sc);
- do {c = inchar(sc->input_port);} while ((c != ')') && (c != EOF));
- return(read_error(sc, "stray dot in list?")); /* (+ 1 . . ) */
- case TOKEN_RIGHT_PAREN: /* (catch #t (lambda () '(1 2 . )) (lambda args 'hiho)) */
- back_up_stack(sc);
- return(read_error(sc, "unexpected close paren")); /* (+ 1 2)) or (+ 1 . ) */
- }
+static s7_pointer g_open_output_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_open_output_file "(open-output-file filename (mode \"w\")) opens filename for writing"
+ #define Q_open_output_file s7_make_signature(sc, 3, sc->IS_OUTPUT_PORT, sc->IS_STRING, sc->IS_STRING)
+ s7_pointer name = car(args);
+
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->OPEN_OUTPUT_FILE, args, T_STRING, 1);
+
+ if (is_pair(cdr(args)))
+ {
+ if (!is_string(cadr(args)))
+ method_or_bust_with_type(sc, cadr(args), sc->OPEN_OUTPUT_FILE, args, make_string_wrapper(sc, "a string (a mode such as \"w\")"), 2);
+ return(s7_open_output_file(sc, string_value(name), string_value(cadr(args))));
}
+ return(s7_open_output_file(sc, string_value(name), "w"));
+}
- /* we never get here */
- return(sc->NIL);
+
+static s7_pointer open_input_string(s7_scheme *sc, const char *input_string, int len)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_INPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = STRING_PORT;
+ port_is_closed(x) = false;
+ port_original_input_string(x) = sc->NIL;
+ port_data(x) = (unsigned char *)input_string;
+ port_data_size(x) = len;
+ port_position(x) = 0;
+ port_filename_length(x) = 0;
+ port_filename(x) = NULL;
+ port_file_number(x) = 0; /* unsigned int */
+ port_line_number(x) = 0;
+ port_needs_free(x) = false;
+ port_gc_loc(x) = -1;
+ port_read_character(x) = string_read_char;
+ port_read_line(x) = string_read_line;
+ port_display(x) = input_display;
+ port_read_semicolon(x) = string_read_semicolon;
+#if DEBUGGING
+ if (input_string[len] != '\0')
+ fprintf(stderr, "read_white_space string is not terminated: %s", input_string);
+#endif
+ port_read_white_space(x) = terminated_string_read_white_space;
+ port_read_name(x) = string_read_name_no_free;
+ port_read_sharp(x) = string_read_sharp;
+ port_write_character(x) = input_write_char;
+ port_write_string(x) = input_write_string;
+ add_input_port(sc, x);
+ return(x);
}
+static s7_pointer open_and_protect_input_string(s7_scheme *sc, s7_pointer str)
+{
+ s7_pointer p;
+ p = open_input_string(sc, string_value(str), string_length(str));
+ port_gc_loc(p) = s7_gc_protect(sc, str);
+ return(p);
+}
-/* ---------------- */
-static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym)
+s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string)
{
- /* handle *unbound-variable-hook* */
- if (hook_functions(sc->unbound_variable_hook) != sc->NIL)
- {
- int save_x, save_y, save_z, cur_code_loc;
- s7_pointer x, cur_code;
+ return(open_input_string(sc, input_string, safe_strlen(input_string)));
+}
- cur_code = sc->cur_code;
- if (!is_pair(cur_code))
- {
- /* isolated typo perhaps -- no pair to hold the position info, so make one.
- * sc->cur_code is GC-protected, so this should be safe.
- */
- cur_code = s7_cons(sc, sym, sc->NIL); /* the error will say "(sym)" which is not too misleading */
- pair_line_number(cur_code) = port_line_number(sc->input_port) | (port_file_number(sc->input_port) << 20);
- }
- cur_code_loc = s7_gc_protect(sc, cur_code); /* we need to save this because it has the file/line number of the unbound symbol */
- SAVE_X_Y_Z(save_x, save_y, save_z);
+static s7_pointer g_open_input_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_open_input_string "(open-input-string str) opens an input port reading str"
+ #define Q_open_input_string s7_make_signature(sc, 2, sc->IS_INPUT_PORT, sc->IS_STRING)
+ s7_pointer input_string, port;
- /* not s7_hook_apply here because we need the value that the hook function returns
- * should we call the entire list? or just call trailing funcs if x is #<unspecified>?
- */
+ input_string = car(args);
+ if (!is_string(input_string))
+ method_or_bust(sc, input_string, sc->OPEN_INPUT_STRING, args, T_STRING, 0);
+ port = open_and_protect_input_string(sc, input_string);
+ return(port);
+}
- x = s7_call(sc,
- car(hook_functions(sc->unbound_variable_hook)),
- make_list_1(sc, sym));
- RESTORE_X_Y_Z(save_x, save_y, save_z);
+#define FORMAT_PORT_LENGTH 128
+/* the large majority (> 99% in my tests) of the output strings have less than 128 chars when the port is finally closed
+ * 256 is slightly slower (the calloc time below dominates the realloc time in string_write_string)
+ * 64 is much slower (realloc dominates)
+ */
- sc->cur_code = cur_code;
- s7_gc_unprotect_at(sc, cur_code_loc);
+static s7_pointer open_output_string(s7_scheme *sc, int len)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_OUTPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = STRING_PORT;
+ port_is_closed(x) = false;
+ port_data_size(x) = len;
+ port_data(x) = (unsigned char *)malloc(len * sizeof(unsigned char)); /* was +8? */
+ port_data(x)[0] = '\0'; /* in case s7_get_output_string before any output */
+ port_position(x) = 0;
+ port_needs_free(x) = true;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = string_display;
+ port_write_character(x) = string_write_char;
+ port_write_string(x) = string_write_string;
+ add_output_port(sc, x);
+ return(x);
+}
- if (x != sc->UNDEFINED)
- return(x);
- }
-
- return(eval_error(sc, "~A: unbound variable", sym));
+s7_pointer s7_open_output_string(s7_scheme *sc)
+{
+ return(open_output_string(sc, sc->initial_string_port_length));
}
-static s7_pointer eval_symbol_1(s7_scheme *sc, s7_pointer sym)
+static s7_pointer g_open_output_string(s7_scheme *sc, s7_pointer args)
{
- if ((is_keyword(sym)) ||
- (is_syntax(sym)))
- return(sym);
-
- if (sym == sc->UNQUOTE)
- return(eval_error_no_arg(sc, "unquote (',') occurred outside quasiquote"));
-#if WITH_UNQUOTE_SPLICING
- if (sym == sc->UNQUOTE_SPLICING)
- return(eval_error_no_arg(sc, "unquote-splicing (',@') occurred without quasiquote"));
-#endif
+ #define H_open_output_string "(open-output-string) opens an output string port"
+ #define Q_open_output_string s7_make_signature(sc, 1, sc->IS_OUTPUT_PORT)
+ return(s7_open_output_string(sc));
+}
- /* actually we'll normally get an error from apply. (,@ 1) triggers this error.
- */
- return(unbound_variable(sc, sym));
+const char *s7_get_output_string(s7_scheme *sc, s7_pointer p)
+{
+ port_data(p)[port_position(p)] = '\0';
+ return((const char *)port_data(p));
}
-static s7_pointer eval_symbol(s7_scheme *sc, s7_pointer sym)
+static s7_pointer g_get_output_string(s7_scheme *sc, s7_pointer args)
{
- s7_pointer x;
+ #define H_get_output_string "(get-output-string port clear-port) returns the output accumulated in port. \
+If the optional 'clear-port' is #t, the current string is flushed."
+ #define Q_get_output_string s7_make_signature(sc, 3, sc->IS_STRING, sc->IS_OUTPUT_PORT, sc->IS_BOOLEAN)
+
+ s7_pointer p, result;
+ bool clear_port = false;
- x = find_symbol(sc, sc->envir, sym);
- if (x != sc->NIL)
- return(symbol_value(x));
+ if (is_pair(cdr(args)))
+ {
+ p = cadr(args);
+ if (!s7_is_boolean(p))
+ return(wrong_type_argument(sc, sc->GET_OUTPUT_STRING, 2, p, T_BOOLEAN));
+ clear_port = (p == sc->T);
+ }
+ p = car(args);
+ if ((!is_output_port(p)) ||
+ (!is_string_port(p)))
+ {
+ if (p == sc->F) return(make_empty_string(sc, 0, 0));
+ method_or_bust_with_type(sc, p, sc->GET_OUTPUT_STRING, args, make_string_wrapper(sc, "an output string port"), 0);
+ }
+ if (port_is_closed(p))
+ return(simple_wrong_type_argument_with_type(sc, sc->GET_OUTPUT_STRING, p, make_string_wrapper(sc, "an active (open) string port")));
- return(eval_symbol_1(sc, sym));
+ result = s7_make_string_with_length(sc, (const char *)port_data(p), port_position(p));
+ if (clear_port)
+ {
+ port_position(p) = 0;
+ port_data(p)[0] = '\0';
+ }
+ return(result);
}
-static s7_pointer assign_syntax(s7_scheme *sc, const char *name, opcode_t op)
+s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port))
{
s7_pointer x;
- x = symbol_table_add_by_name_at_location(sc, name, symbol_table_hash(name));
- typeflag(x) |= (T_SYNTAX | T_DONT_COPY);
- syntax_opcode(x) = (int)op;
+ new_cell(sc, x, T_INPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = FUNCTION_PORT;
+ port_is_closed(x) = false;
+ port_original_input_string(x) = sc->NIL;
+ port_needs_free(x) = false;
+ port_input_function(x) = function;
+ port_read_character(x) = function_read_char;
+ port_read_line(x) = function_read_line;
+ port_display(x) = input_display;
+ port_write_character(x) = input_write_char;
+ port_write_string(x) = input_write_string;
+ add_input_port(sc, x);
return(x);
}
-static bool memq(s7_pointer symbol, s7_pointer list)
+s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, unsigned char c, s7_pointer port))
{
s7_pointer x;
- for (x = list; is_pair(x); x = cdr(x))
- if (car(x) == symbol)
- return(true);
- return(false);
-}
-
+ new_cell(sc, x, T_OUTPUT_PORT);
+ port_port(x) = alloc_port(sc);
+ port_type(x) = FUNCTION_PORT;
+ port_data(x) = NULL;
+ port_is_closed(x) = false;
+ port_needs_free(x) = false;
+ port_output_function(x) = function;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = function_display;
+ port_write_character(x) = function_write_char;
+ port_write_string(x) = function_write_string;
+ add_output_port(sc, x);
+ return(x);
+}
-static s7_pointer quotify(s7_scheme *sc, s7_pointer pars)
+
+static void push_input_port(s7_scheme *sc, s7_pointer new_port)
{
- /* the default parameter values of define-macro* and define-bacro* should not be evaluated until
- * the expansion is evaluated. That is,
- *
- * (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(let ((x -1)) (+ x ,a))) (list (hi) x))
- *
- * should return the same value as the equivalent explicit form:
- *
- * (let ((x 0)) (define-macro (hi a) `(let ((x -1)) (+ x ,a))) (list (hi (let () (set! x (+ x 1)) x)) x))
- *
- * '(-1 0) in both cases.
- *
- * But at the point in eval where we handle lambda* arguments, we can't easily tell whether we're part of
- * a function or a macro, so at definition time of a macro* we scan the parameter list for an expression
- * as a default value, and replace it with (quote expr).
- *
- * and... (define-macro* ((a x)) ...) should behave the same as (define-macro* ((a (+ x 0))) ...)
- */
- s7_pointer tmp;
- for (tmp = pars; is_pair(tmp); tmp = cdr(tmp))
- if ((is_pair(car(tmp))) &&
- ((is_pair(cadar(tmp))) ||
- (s7_is_symbol(cadar(tmp)))))
- cadar(tmp) = make_list_2(sc, sc->QUOTE, cadar(tmp));
- return(pars);
+ sc->temp6 = sc->input_port;
+ sc->input_port = new_port;
+ sc->input_port_stack = cons(sc, sc->temp6, sc->input_port_stack);
+ sc->temp6 = sc->NIL;
}
-static lstar_err_t prepare_closure_star(s7_scheme *sc)
+static void pop_input_port(s7_scheme *sc)
{
- /* sc->code is a closure: ((args body) envir)
- * (define* (hi a (b 1)) (+ a b))
- * (procedure-source hi) -> (lambda* (a (b 1)) (+ a b))
- *
- * so rather than spinning through the args binding names to values in the
- * procedure's new environment (as in the usual closure case above),
- * we scan the current args, and match against the
- * template in the car of the closure, binding as we go.
- *
- * for each actual arg, if it's not a keyword that matches a member of the
- * template, bind it to its current (place-wise) arg, else bind it to
- * that arg. If it's the symbol :key or :optional, just go on.
- * If it's :rest bind the next arg to the trailing args at this point.
- * All args can be accessed by their name as a keyword.
- * In other words (define* (hi (a 1)) ...) is the same as (define* (hi :key (a 1)) ...) etc.
- *
- * all args are optional, any arg with no default value defaults to #f.
- * but the rest arg should default to '().
- *
- * I later decided to add two warnings: if a parameter is set twice and if
- * an unknown keyword is seen in a keyword position and there is no rest arg.
- */
+ if (is_pair(sc->input_port_stack))
+ {
+ s7_pointer nxt;
+ sc->input_port = car(sc->input_port_stack);
+ nxt = cdr(sc->input_port_stack);
+ /* is this safe? */
+ free_cell(sc, sc->input_port_stack);
+ sc->input_port_stack = nxt;
+ }
+ else sc->input_port = sc->standard_input;
+}
- bool allow_other_keys = false;
- /* set all default values */
- for (sc->z = closure_args(sc->code); is_pair(sc->z); sc->z = cdr(sc->z))
+static int inchar(s7_pointer pt)
+{
+ int c;
+ if (is_file_port(pt))
+ c = fgetc(port_file(pt)); /* not unsigned char! -- could be EOF */
+ else
{
- /* bind all the args to something (default value or #f or maybe #undefined) */
- if (!((car(sc->z) == sc->KEY_KEY) ||
- (car(sc->z) == sc->KEY_OPTIONAL) ||
- (car(sc->z) == sc->KEY_ALLOW_OTHER_KEYS)))
- {
- if (car(sc->z) == sc->KEY_REST)
- {
- sc->z = cdr(sc->z);
- add_to_local_environment(sc, car(sc->z), sc->NIL); /* set :rest arg to sc->NIL, not sc->F */
- }
- else
- {
- if (is_pair(car(sc->z))) /* (define* (hi (a mus-next)) a) */
- add_to_local_environment(sc, /* or (define* (hi (a 'hi)) (list a (eq? a 'hi))) */
- caar(sc->z),
- lambda_star_argument_default_value(sc, cadar(sc->z)));
- /* mus-next, for example, needs to be evaluated before binding */
- else add_to_local_environment(sc, car(sc->z), sc->F);
- }
- }
+ if (port_data_size(pt) <= port_position(pt))
+ return(EOF);
+ c = (unsigned char)port_data(pt)[port_position(pt)++];
}
- if (s7_is_symbol(sc->z)) /* dotted (last) arg? -- make sure its name exists in the current environment */
- add_to_local_environment(sc, sc->z, sc->NIL); /* this was sc->F */
-
- /* now get the current args, re-setting args that have explicit values */
- sc->x = closure_args(sc->code);
- sc->y = sc->args;
- sc->z = sc->NIL;
- while ((is_pair(sc->x)) &&
- (is_pair(sc->y)))
+
+ if (c == '\n')
+ port_line_number(pt)++;
+
+ return(c);
+}
+
+
+static void backchar(char c, s7_pointer pt)
+{
+ if (c == '\n')
+ port_line_number(pt)--;
+
+ if (is_file_port(pt))
+ ungetc(c, port_file(pt));
+ else
{
- if ((car(sc->x) == sc->KEY_KEY) ||
- (car(sc->x) == sc->KEY_OPTIONAL))
- sc->x = cdr(sc->x); /* everything is :key and :optional, so these are ignored */
- else
- {
- lstar_err_t err = LSTAR_OK;
-
- if (car(sc->x) == sc->KEY_REST) /* the rest arg */
- {
- /* next arg is bound to trailing args from this point as a list */
- sc->z = sc->KEY_REST;
- sc->x = cdr(sc->x);
-
- if (is_pair(car(sc->x)))
- err = lambda_star_argument_set_value(sc, caar(sc->x), sc->y);
- else err = lambda_star_argument_set_value(sc, car(sc->x), sc->y);
- if (err != LSTAR_OK) return(err);
-
- sc->y = cdr(sc->y);
- sc->x = cdr(sc->x);
- if (car(sc->x) == sc->KEY_ALLOW_OTHER_KEYS)
- break;
- }
- else
- {
- if (is_keyword(car(sc->y)))
- {
- char *name; /* found a keyword, need to remove the ':' before checking the lambda args */
- s7_pointer sym;
-
- name = symbol_name(car(sc->y));
- if (name[0] == ':')
- sym = make_symbol(sc, (const char *)(name + 1));
- else
- {
- /* must be a trailing ':' here, else not is_keyword */
- name[symbol_name_length(car(sc->y)) - 1] = '\0';
- sym = make_symbol(sc, name);
- name[symbol_name_length(car(sc->y)) - 1] = ':';
- }
-
- if (cdr(sc->y) == sc->NIL)
- err = LSTAR_NO_SUCH_KEY;
- err = lambda_star_argument_set_value(sc, sym, car(cdr(sc->y))); /* cdr(sc->y) is the next arg */
-
- if (err == LSTAR_NO_SUCH_KEY)
- {
- /* if default value is a key, go ahead and use this value.
- * (define* (f (a :b)) a) (f :c)
- * this has become much trickier than I anticipated...
- */
- if ((allow_other_keys) ||
- (memq(sc->KEY_ALLOW_OTHER_KEYS, sc->x)))
- {
- allow_other_keys = true;
- /* in CL: (defun hi (&key (a 1) &allow-other-keys) a) (hi :b :a :a 3) -> 3
- * in s7: (define* (hi (a 1) :allow-other-keys) a) (hi :b :a :a 3) -> 3
- */
- sc->y = cddr(sc->y);
- continue;
- }
- else
- {
- if ((is_pair(car(sc->x))) &&
- (is_keyword(cadar(sc->x))))
- {
- /* sc->x is the closure args list, not the copy of it in the current environment */
- s7_pointer x;
-
- x = find_symbol(sc, sc->envir, caar(sc->x));
- if (x != sc->NIL)
- {
- if (is_not_local(x))
- {
- err = LSTAR_OK;
- set_local(x);
- cdr(x) = car(sc->y);
- }
- else err = LSTAR_ALREADY_SET;
- }
- /* (define* (f a (b :c)) b) (f :b 1 :d) */
- }
- }
- }
- else sc->y = cdr(sc->y);
-
- if (err != LSTAR_OK) return(err);
- sc->y = cdr(sc->y);
- }
- else /* not a key/value pair */
- {
- if (is_pair(car(sc->x)))
- err = lambda_star_argument_set_value(sc, caar(sc->x), car(sc->y));
- else err = lambda_star_argument_set_value(sc, car(sc->x), car(sc->y));
- if (err != LSTAR_OK) return(err);
-
- sc->y = cdr(sc->y);
- }
- sc->x = cdr(sc->x);
- }
- }
+ if (port_position(pt) > 0)
+ port_position(pt)--;
}
+}
- /* check for trailing args with no :rest arg */
- if (sc->y != sc->NIL)
+
+int s7_read_char(s7_scheme *sc, s7_pointer port)
+{
+ /* needs to be int return value so EOF=-1, but not 255 */
+ return(port_read_character(port)(sc, port));
+}
+
+
+int s7_peek_char(s7_scheme *sc, s7_pointer port)
+{
+ int c; /* needs to be an int so EOF=-1, but not 255 */
+ c = port_read_character(port)(sc, port);
+ if (c != EOF)
+ backchar(c, port);
+ return(c);
+}
+
+
+void s7_write_char(s7_scheme *sc, int c, s7_pointer pt)
+{
+ if (pt != sc->F)
+ port_write_character(pt)(sc, c, pt);
+}
+
+
+static s7_pointer input_port_if_not_loading(s7_scheme *sc)
+{
+ s7_pointer port;
+ port = sc->input_port;
+ if (is_loader_port(port)) /* this flag is turned off by the reader macros, so we aren't in that context */
{
- if ((sc->x == sc->NIL) &&
- (is_pair(sc->y)))
- {
- if (sc->z != sc->KEY_REST)
- {
- if (!allow_other_keys)
- return(LSTAR_TOO_MANY_ARGS);
- }
- }
- else
+ int c;
+ c = port_read_white_space(port)(sc, port);
+ if (c > 0) /* we can get either EOF or NULL at the end */
{
- /* final arg was dotted? */
- if (s7_is_symbol(sc->x))
- add_to_local_environment(sc, sc->x, sc->y);
+ backchar(c, port);
+ return(NULL);
}
+ return(sc->standard_input);
}
- return(LSTAR_OK);
+ return(port);
}
+static s7_pointer g_read_char(s7_scheme *sc, s7_pointer args)
+{
+ #define H_read_char "(read-char (port (current-input-port))) returns the next character in the input port"
+ #define Q_read_char s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->IS_CHAR, sc->IS_EOF_OBJECT), sc->IS_INPUT_PORT)
+ s7_pointer port;
+
+ if (is_not_null(args))
+ port = car(args);
+ else
+ {
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->EOF_OBJECT);
+ }
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->READ_CHAR, args, AN_INPUT_PORT, 0);
+ return(chars[port_read_character(port)(sc, port)]);
+}
-static s7_pointer initial_add, initial_subtract, initial_equal, initial_lt, initial_gt;
-static bool is_steppable_integer(s7_pointer p)
+static s7_pointer read_char_0, read_char_1;
+static s7_pointer g_read_char_0(s7_scheme *sc, s7_pointer args)
{
- return((type(p) == T_NUMBER) && /* not bignum, or any other weird case */
- (number_type(p) == NUM_INT) && /* not float etc */
- (integer(number(p)) < S7_LONG_MAX) && /* not a huge int (bignum overflow etc) */
- (integer(number(p)) > S7_LONG_MIN));
+ s7_pointer port;
+ port = input_port_if_not_loading(sc);
+ if (port)
+ return(chars[port_read_character(port)(sc, port)]);
+ return(sc->EOF_OBJECT);
}
-static s7_pointer prepare_do_step_variables(s7_scheme *sc)
+static s7_pointer g_read_char_1(s7_scheme *sc, s7_pointer args)
{
- sc->args = safe_reverse_in_place(sc, sc->args);
- sc->code = car(sc->args); /* saved at the start */
- sc->args = cdr(sc->args); /* init values */
- sc->envir = new_frame_in_env(sc, sc->envir);
-
- sc->value = sc->NIL;
- for (sc->x = car(sc->code), sc->y = sc->args; sc->y != sc->NIL; sc->x = cdr(sc->x), sc->y = cdr(sc->y))
- {
- s7_pointer tmp;
- tmp = caar(sc->x);
- if (!s7_is_symbol(tmp))
- return(eval_error(sc, "do step variable: ~S is not a symbol?", tmp));
- if (is_immutable(tmp))
- return(eval_error(sc, "do step variable: ~S is immutable", tmp));
- /* symbol-access is dealt with elsewhere */
- sc->value = s7_cons(sc, add_to_local_environment(sc, tmp, car(sc->y)), sc->value);
- }
-
- /* now we've set up the environment, next set up for the loop */
- sc->y = safe_reverse_in_place(sc, sc->value);
-
- /* here args is a list of init values (in order of occurrence in the do var list), but those values are also in the bindings */
- sc->args = sc->NIL;
-
- /* sc->y is the list of bindings, sc->x is the step variable info
- * so car(sc->x) is a step variable's info,
- * caar is the variable name, cadar is its initial value (possibly an expression), caddar is the step expression, if any
- */
- for (sc->x = car(sc->code); sc->y != sc->NIL; sc->x = cdr(sc->x), sc->y = cdr(sc->y))
- if (cddar(sc->x) != sc->NIL) /* else no incr expr, so ignore it henceforth */
- {
- s7_pointer step_expr, binding, new_expr = sc->F;
+ s7_pointer port;
+ port = car(args);
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->READ_CHAR, args, AN_INPUT_PORT, 0);
+ return(chars[port_read_character(port)(sc, port)]);
+}
- binding = car(sc->y);
- step_expr = caddar(sc->x);
+static s7_pointer c_read_char(s7_scheme *sc)
+{
+ int c;
+ s7_pointer port;
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->EOF_OBJECT);
+ c = port_read_character(port)(sc, port);
+ if (c == EOF)
+ return(sc->EOF_OBJECT);
+ return(chars[c]);
+}
- /* if step_expr is a constant, I don't think we save much by predigesting it
- *
- * we're looking for a simple expression like (+ i 1) or (+ 1 i) or (- i 1)
- */
+PF_0(read_char, c_read_char)
- if ((is_steppable_integer(cdr(binding))) && /* not (do ((i 1.0 (+ i 1))) ((> i 3))) */
- (is_pair(step_expr)) && /* not (do ((i 1 4)) ((> i 3))) */
- (s7_is_symbol(car(step_expr))) && /* not (do ((i 1 ((if #t + -) i 1))) ((> i 3))) */
- (is_pair(cdr(step_expr))) && /* not (do ((i 1 (+))) ((> i 0))) */
- (is_pair(cddr(step_expr))) && /* not (do ((i 1 (+ 1))) ((> i 0))) */
- (cdddr(step_expr) == sc->NIL) && /* not (do ((i 1 (+ 1 i 2))) ((> i 0))) */
- (((is_steppable_integer(cadr(step_expr))) && /* not (do ((i 1 (+ 1.0 i))) ((> i 0))) */
- (caddr(step_expr) == car(binding))) || /* not (do ((i 1 (+ 1 pi))) ((> i 0))) */
- ((is_steppable_integer(caddr(step_expr))) && /* these also check for crazy cases like */
- (cadr(step_expr) == car(binding))))) /* (do ((i 0 (+ i 8796093022208))) ((> i 0))) */
- {
- s7_pointer op;
- op = find_symbol(sc, sc->envir, car(step_expr)); /* not (do ((i 1 (* i 2))) ((> i 0))) */
- if ((symbol_value(op) == initial_add) ||
- ((symbol_value(op) == initial_subtract) &&
- (cadr(step_expr) == car(binding)))) /* not (do ((i 10 (- 1 i))) ((< i 0) i)) */
- {
- int gc_loc;
- /* can't change step_expr here because value of '+' might change,
- * so instead we append a vector: #(+ initial value, + binding, var binding, increment)
- */
- new_expr = s7_make_vector(sc, 4);
- gc_loc = s7_gc_protect(sc, new_expr);
-
- vector_element(new_expr, 0) = symbol_value(op); /* 1st 2 so we can be sure the operator is still the initial '+' or '-' function */
- vector_element(new_expr, 1) = op;
- vector_element(new_expr, 2) = binding; /* next to to check that it's safe to mess with the step var (same type, safe values) */
- if (s7_is_integer(cadr(step_expr)))
- vector_element(new_expr, 3) = cadr(step_expr);
- else vector_element(new_expr, 3) = caddr(step_expr);
-
- /* if the operator changes or the step variable is set to something weird in the do body,
- * we fall back on the original step expression.
- * (do ((i 0 (+ i 1))) ((> i 2)) (set! i (+ i 3.0)))
- * (let ((add +)) (do ((i 0 (add i 1))) ((< i 0)) (set! add -)))
- * etc.
- */
- s7_gc_unprotect_at(sc, gc_loc);
- }
- }
- sc->args = s7_cons(sc,
- make_list_4(sc, binding, step_expr, cdar(sc->y), new_expr),
- sc->args);
- }
-
- sc->args = safe_reverse_in_place(sc, sc->args);
- {
- s7_pointer end_stuff;
- end_stuff = cadr(sc->code);
- if (end_stuff == sc->NIL)
- sc->args = s7_cons(sc, sc->args, sc->NIL);
- else sc->args = s7_cons(sc, sc->args, s7_cons(sc, s7_cons(sc, car(end_stuff), sc->F), cdr(end_stuff)));
- }
- sc->code = cddr(sc->code);
-
- /* here args is a list of 2 or 3 lists, 1st is (list (list (var . binding) incr-expr init-value) ...), 2nd is end-expr, 3rd can be result expr
- * so for (do ((i 0 (+ i 1))) ((= i 3) (+ i 1)) ...) args is ((((i . 0) (+ i 1) 0 <opt-vector>)) (= i 3) (+ i 1))
- */
- return(sc->F);
+static s7_pointer read_char_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 0)
+ return(read_char_0);
+ if (args == 1)
+ return(read_char_1);
+ return(f);
}
-static void prepare_do_end_test(s7_scheme *sc)
+static s7_pointer g_write_char(s7_scheme *sc, s7_pointer args)
{
- /* sc->args = (list var-data [(end-test #f) [rtn-expr]])
- * if the end-test is optimizable, its info vector is placed where the #f is
- */
-
- if (cdr(sc->args) != sc->NIL) /* nil case: (call-with-exit (lambda (r) (do ((i 0 (+ i 1))) () (if (= i 100) (r 1))))) */
- {
- s7_pointer end_expr;
- end_expr = car(cadr(sc->args));
+ #define H_write_char "(write-char char (port (current-output-port))) writes char to the output port"
+ #define Q_write_char s7_make_signature(sc, 3, sc->IS_CHAR, sc->IS_CHAR, sc->IS_OUTPUT_PORT)
+ s7_pointer port, chr;
- /* cadr(sc->args) can't be nil -- it is always a cons with cdr = #f
- * end_expr now holds the end-test expression
- *
- * we're looking for an end-test of the form (= var int) or (= var1 var2) or (= int var)
- * all the step vars have been initialized by now, so we can check for int vars
- */
+ chr = car(args);
+ if (!s7_is_character(chr))
+ method_or_bust(sc, chr, sc->WRITE_CHAR, args, T_CHARACTER, 1);
- if ((is_pair(end_expr)) && /* nil if: (do ((i 0 (+ i 1))) (() 1) */
- (s7_is_symbol(car(end_expr))) &&
- (is_pair(cdr(end_expr))) &&
- (is_pair(cddr(end_expr))) &&
- (cdddr(end_expr) == sc->NIL) &&
- (((s7_is_symbol(cadr(end_expr))) ||
- (is_steppable_integer(cadr(end_expr)))) &&
- ((s7_is_symbol(caddr(end_expr))) ||
- (is_steppable_integer(caddr(end_expr))))))
- {
- s7_pointer op, arg1 = sc->F, val1 = sc->F, arg2 = sc->F, val2 = sc->F;
- op = find_symbol(sc, sc->envir, car(end_expr));
- if ((symbol_value(op) == initial_equal) ||
- (symbol_value(op) == initial_lt) ||
- (symbol_value(op) == initial_gt))
- {
- if (s7_is_symbol(cadr(end_expr)))
- {
- arg1 = find_symbol(sc, sc->envir, cadr(end_expr));
- val1 = symbol_value(arg1);
- if (!is_steppable_integer(val1))
- val1 = sc->F;
- }
- else val1 = cadr(end_expr);
- if (val1 != sc->F)
- {
- if (s7_is_symbol(caddr(end_expr)))
- {
- arg2 = find_symbol(sc, sc->envir, caddr(end_expr));
- val2 = symbol_value(arg2);
- if (!is_steppable_integer(val2))
- val2 = sc->F;
- }
- else val2 = caddr(end_expr);
- if (val2 != sc->F)
- {
- /* everything looks ok -- make a vector of binding info */
- int gc_loc;
- s7_pointer new_expr;
-
- new_expr = s7_make_vector(sc, 6);
- gc_loc = s7_gc_protect(sc, new_expr);
-
- vector_element(new_expr, 0) = symbol_value(op); /* 1st 2 so we can be sure the operator is still the initial '=' function */
- vector_element(new_expr, 1) = op;
- vector_element(new_expr, 2) = arg1;
- vector_element(new_expr, 3) = val1;
- vector_element(new_expr, 4) = arg2;
- vector_element(new_expr, 5) = val2;
-
- cdr(cadr(sc->args)) = new_expr;
- s7_gc_unprotect_at(sc, gc_loc);
+ if (is_pair(cdr(args)))
+ port = cadr(args);
+ else port = sc->output_port;
+ if (port == sc->F) return(chr);
+ if (!is_output_port(port))
+ method_or_bust_with_type(sc, port, sc->WRITE_CHAR, args, AN_OUTPUT_PORT, 2);
- /* if (do ((i 0 (+ i 1))) ((= i 3)))
- * args is (<var info> ((= i 3) . #(= <= binding> <i binding> 0 #f 3)))
- */
- }
- }
- }
- }
- }
+ port_write_character(port)(sc, s7_character(chr), port);
+ return(chr);
}
+static s7_pointer c_write_char(s7_scheme *sc, s7_pointer chr)
+{
+ if (!s7_is_character(chr))
+ method_or_bust(sc, chr, sc->WRITE_CHAR, set_plist_1(sc, chr), T_CHARACTER, 1);
+ if (sc->output_port == sc->F) return(chr);
+ port_write_character(sc->output_port)(sc, s7_character(chr), sc->output_port);
+ return(chr);
+}
-/* -------------------------------- eval -------------------------------- */
+static s7_pointer write_char_1;
+static s7_pointer g_write_char_1(s7_scheme *sc, s7_pointer args) {return(c_write_char(sc, car(args)));}
-/* all explicit write-* in eval assume current-output-port -- error fallback handling, etc */
-/* internal reads assume sc->input_port is the input port */
+PF_TO_PF(write_char, c_write_char)
-static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
+
+static s7_pointer write_char_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
{
- sc->cur_code = ERROR_INFO_DEFAULT;
- sc->op = first_op;
-
- /* this procedure can be entered recursively (via s7_call for example), so it's no place for a setjmp
- * I don't think the recursion can hurt our continuations because s7_call is coming from hooks and
- * callbacks that are implicit in our stack.
- */
-
- goto START_WITHOUT_POP_STACK;
- /* this ugly two-step is actually noticeably faster than other ways of writing this code
- */
+ if (args == 1)
+ return(write_char_1);
+ return(f);
+}
- START:
- pop_stack(sc);
+/* (with-output-to-string (lambda () (write-char #\space))) -> " "
+ * (with-output-to-string (lambda () (write #\space))) -> "#\\space"
+ * (with-output-to-string (lambda () (display #\space))) -> " "
+ * is this correct? It's what Guile does. write-char is actually display-char.
+ */
- START_WITHOUT_POP_STACK:
- switch (sc->op)
- {
- case OP_READ_INTERNAL:
- /* if we're loading a file, and in the file we evaluate something like:
- *
- * (let ()
- * (set-current-input-port (open-input-file "tmp2.r5rs"))
- * (close-input-port (current-input-port)))
- * ... (with no reset of input port to its original value)
- *
- * the load process tries to read the loaded string, but the sc->input_port is now closed,
- * and the original is inaccessible! So we get a segfault in token. We don't want to put
- * a port_is_closed check there because token only rarely is in this danger. I think this
- * is the only place where we can be about to call token, and someone has screwed up our port.
- *
- * We can't call read_error here because it assumes the input string is ok!
- */
- if (port_is_closed(sc->input_port))
- return(s7_error(sc, sc->READ_ERROR, make_list_1(sc, make_protected_string(sc, "our input port got clobbered!"))));
+static s7_pointer g_peek_char(s7_scheme *sc, s7_pointer args)
+{
+ #define H_peek_char "(peek-char (port (current-input-port))) returns the next character in the input port, but does not remove it from the input stream"
+ #define Q_peek_char s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->IS_CHAR, sc->IS_EOF_OBJECT), sc->IS_INPUT_PORT)
+ s7_pointer port;
- sc->tok = token(sc);
+ if (is_not_null(args))
+ port = car(args);
+ else port = sc->input_port;
- switch (sc->tok)
- {
- case TOKEN_EOF:
- goto START;
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->PEEK_CHAR, args, AN_INPUT_PORT, 0);
+ if (port_is_closed(port))
+ return(simple_wrong_type_argument_with_type(sc, sc->PEEK_CHAR, port, AN_OPEN_PORT));
- case TOKEN_RIGHT_PAREN:
- read_error(sc, "unexpected close paren");
+ if (is_function_port(port))
+ return((*(port_input_function(port)))(sc, S7_PEEK_CHAR, port));
+ return(chars[s7_peek_char(sc, port)]);
+}
- case TOKEN_COMMA:
- read_error(sc, "unexpected comma");
+static s7_pointer c_peek_char(s7_scheme *sc) {return(chars[s7_peek_char(sc, sc->input_port)]);}
+PF_0(peek_char, c_peek_char)
- default:
- sc->value = read_expression(sc);
- sc->current_line = port_line_number(sc->input_port); /* this info is used to track down missing close parens */
- sc->current_file = port_filename(sc->input_port);
- goto START;
- }
-
- /* (read p) from scheme
- * "p" becomes current input port for eval's duration, then pops back before returning value into calling expr
- */
- case OP_READ_DONE:
- pop_input_port(sc);
-
- if (sc->tok == TOKEN_EOF)
- sc->value = sc->EOF_OBJECT;
- sc->current_file = NULL;
- goto START;
-
-
- /* load("file"); from C (g_load) -- assume caller will clean up
- * read and evaluate exprs until EOF that matches (stack reflects nesting)
- */
- case OP_LOAD_RETURN_IF_EOF: /* loop here until eof (via push stack below) */
- if (sc->tok != TOKEN_EOF)
- {
- push_stack(sc, opcode(OP_LOAD_RETURN_IF_EOF), sc->NIL, sc->NIL);
- push_stack(sc, opcode(OP_READ_INTERNAL), sc->NIL, sc->NIL);
- sc->code = sc->value;
- goto EVAL; /* we read an expression, now evaluate it, and return to read the next */
- }
- sc->current_file = NULL;
- return(sc->F);
-
-
- /* (load "file") in scheme
- * read and evaluate all exprs, then upon EOF, close current and pop input port stack
- */
- case OP_LOAD_CLOSE_AND_POP_IF_EOF:
- if (sc->tok != TOKEN_EOF)
- {
- push_stack(sc, opcode(OP_LOAD_CLOSE_AND_POP_IF_EOF), sc->NIL, sc->NIL); /* was push args, code */
- push_stack(sc, opcode(OP_READ_INTERNAL), sc->NIL, sc->NIL);
- sc->code = sc->value;
- goto EVAL; /* we read an expression, now evaluate it, and return to read the next */
- }
- s7_close_input_port(sc, sc->input_port);
- pop_input_port(sc);
- sc->current_file = NULL;
- goto START;
-
-
- /* read and evaluate string expression(s?)
- * assume caller (C via g_eval_c_string) is dealing with the string port
- */
- case OP_EVAL_STRING:
- /* this is the C side s7_eval_c_string.
- */
-
- /* (eval-string (string-append "(list 1 2 3)" (string #\newline) (string #\newline)))
- * needs to be sure to get rid of the trailing white space before checking for EOF
- * else it tries to eval twice and gets "attempt to apply 1?, line 2"
- */
- if ((sc->tok != TOKEN_EOF) &&
- (port_string_point(sc->input_port) < port_string_length(sc->input_port))) /* ran past end somehow? */
- {
- unsigned char c;
- while (white_space[c = port_string(sc->input_port)[port_string_point(sc->input_port)++]])
- if (c == '\n')
- port_line_number(sc->input_port)++;
+static s7_pointer g_read_byte(s7_scheme *sc, s7_pointer args)
+{
+ #define H_read_byte "(read-byte (port (current-input-port))): reads a byte from the input port"
+ #define Q_read_byte s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_EOF_OBJECT), sc->IS_INPUT_PORT)
+ s7_pointer port;
+ int c;
- if (c != 0)
- {
- backchar(c, sc->input_port);
- push_stack(sc, opcode(OP_EVAL_STRING), sc->NIL, sc->value);
- push_stack(sc, opcode(OP_READ_INTERNAL), sc->NIL, sc->NIL);
- }
- else push_stack(sc, opcode(OP_EVAL_DONE), sc->NIL, sc->value);
- }
- else push_stack(sc, opcode(OP_EVAL_DONE), sc->NIL, sc->value);
- sc->code = sc->value;
- goto EVAL;
+ if (is_not_null(args))
+ port = car(args);
+ else
+ {
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->EOF_OBJECT);
+ }
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->READ_BYTE, args, AN_INPUT_PORT, 0);
-
- case OP_EVAL_STRING_2:
- s7_close_input_port(sc, sc->input_port);
- pop_input_port(sc);
+ c = port_read_character(port)(sc, port);
+ if (c == EOF)
+ return(sc->EOF_OBJECT);
+ return(small_int(c));
+}
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
+static s7_pointer c_read_byte(s7_scheme *sc)
+{
+ int c;
+ s7_pointer port;
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->EOF_OBJECT);
+ c = port_read_character(port)(sc, port);
+ if (c == EOF)
+ return(sc->EOF_OBJECT);
+ return(small_int(c));
+}
- goto START;
+PF_0(read_byte, c_read_byte)
-
- case OP_EVAL_STRING_1:
- if ((sc->tok != TOKEN_EOF) &&
- (port_string_point(sc->input_port) < port_string_length(sc->input_port))) /* ran past end somehow? */
- {
- unsigned char c;
- while (white_space[c = port_string(sc->input_port)[port_string_point(sc->input_port)++]])
- if (c == '\n')
- port_line_number(sc->input_port)++;
- if (c != 0)
- {
- backchar(c, sc->input_port);
- push_stack(sc, opcode(OP_EVAL_STRING_1), sc->NIL, sc->value);
- push_stack(sc, opcode(OP_READ_INTERNAL), sc->NIL, sc->NIL);
- }
- else push_stack(sc, opcode(OP_EVAL_STRING_2), sc->NIL, sc->NIL);
- }
- else push_stack(sc, opcode(OP_EVAL_STRING_2), sc->NIL, sc->NIL);
- sc->code = sc->value;
- goto EVAL;
+static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args)
+{
+ #define H_write_byte "(write-byte byte (port (current-output-port))): writes byte to the output port"
+ #define Q_write_byte s7_make_signature(sc, 3, sc->IS_INTEGER, sc->IS_INTEGER, sc->IS_OUTPUT_PORT)
+ s7_pointer port, b;
+ s7_int val;
+ b = car(args);
+ if (!s7_is_integer(b))
+ method_or_bust(sc, car(args), sc->WRITE_BYTE, args, T_INTEGER, 1);
- /* -------------------- sort! (heapsort, done directly so that call/cc in the sort function will work correctly) -------------------- */
+ val = s7_integer(b);
+ if ((val < 0) || (val > 255)) /* need to check this before port==#f, else (write-byte most-positive-fixnum #f) is not an error */
+ return(wrong_type_argument_with_type(sc, sc->WRITE_BYTE, 1, b, AN_UNSIGNED_BYTE));
- #define SORT_N integer(number(vector_element(sc->code, 0)))
- #define SORT_K integer(number(vector_element(sc->code, 1)))
- #define SORT_J integer(number(vector_element(sc->code, 2)))
- #define SORT_K1 integer(number(vector_element(sc->code, 3)))
- #define SORT_ARGS vector_element(sc->code, 4)
- #define SORT_CALLS integer(number(vector_element(sc->code, 5)))
- #define SORT_STOP integer(number(vector_element(sc->code, 6)))
- #define SORT_ARG_1 car(SORT_ARGS)
- #define SORT_ARG_2 cadr(SORT_ARGS)
- #define SORT_DATA(K) vector_element(car(sc->args), K)
- #define SORT_LESSP cadr(sc->args)
+ if (is_pair(cdr(args)))
+ port = cadr(args);
+ else port = sc->output_port;
- HEAPSORT:
- {
- s7_Int n, j, k;
- n = SORT_N;
- k = SORT_K1;
+ if (!is_output_port(port))
+ {
+ if (port == sc->F) return(car(args));
+ method_or_bust_with_type(sc, port, sc->WRITE_BYTE, args, AN_OUTPUT_PORT, 0);
+ }
- if ((n == k) || (k > ((s7_Int)(n / 2)))) /* k == n == 0 is the first case */
- goto START;
+ s7_write_char(sc, (int)(s7_integer(b)), port);
+ return(b);
+}
- if (sc->safety != 0)
- {
- SORT_CALLS++;
- if (SORT_CALLS > SORT_STOP)
- return(eval_error(sc, "sort! is caught in an infinite loop, comparison: ~S", SORT_LESSP));
- }
- j = 2 * k;
- SORT_J = j;
- if (j < n)
- {
- push_stack(sc, opcode(OP_SORT1), sc->args, sc->code);
- SORT_ARG_1 = SORT_DATA(j);
- SORT_ARG_2 = SORT_DATA(j + 1);
+static s7_int c_write_byte(s7_scheme *sc, s7_int x)
+{
+ if ((x < 0) || (x > 255))
+ wrong_type_argument_with_type(sc, sc->WRITE_BYTE, 1, make_integer(sc, x), AN_UNSIGNED_BYTE);
+ s7_write_char(sc, (int)x, sc->output_port);
+ return(x);
+}
- sc->x = SORT_LESSP;
- sc->args = SORT_ARGS;
- sc->code = sc->x;
- goto APPLY;
- }
- else sc->value = sc->F;
- }
+IF_TO_IF(write_byte, c_write_byte)
- case OP_SORT1:
- {
- s7_Int j, k;
- k = SORT_K1;
- j = SORT_J;
- if (is_true(sc, sc->value))
- {
- j = j + 1;
- SORT_J = j;
- }
- push_stack(sc, opcode(OP_SORT2), sc->args, sc->code);
- SORT_ARG_1 = SORT_DATA(k);
- SORT_ARG_2 = SORT_DATA(j);
-
- sc->x = SORT_LESSP;
- sc->args = SORT_ARGS;
- sc->code = sc->x;
- goto APPLY;
- }
- case OP_SORT2:
- {
- s7_Int j, k;
- k = SORT_K1;
- j = SORT_J;
- if (is_true(sc, sc->value))
- {
- sc->x = SORT_DATA(j);
- SORT_DATA(j) = SORT_DATA(k);
- SORT_DATA(k) = sc->x;
- }
- else goto START;
- SORT_K1 = SORT_J;
- goto HEAPSORT;
- }
+static s7_pointer g_read_line(s7_scheme *sc, s7_pointer args)
+{
+ #define H_read_line "(read-line port (with-eol #f)) returns the next line from port, or #<eof>.\
+If 'with-eol' is not #f, read-line includes the trailing end-of-line character."
+ #define Q_read_line s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_EOF_OBJECT), sc->IS_INPUT_PORT, sc->IS_BOOLEAN)
- case OP_SORT:
- /* coming in sc->args is sort args (data less?), sc->code = '(n k 0)
- *
- * here we call the inner loop until k <= 0 [the local k! -- this is tricky because scheme passes args by value]
- */
- {
- s7_Int n, k;
- k = SORT_K;
- n = SORT_N;
- if (k <= 0)
- goto SORT3;
+ s7_pointer port;
+ bool with_eol = false;
- SORT_K = k - 1;
- SORT_K1 = k - 1;
+ if (is_not_null(args))
+ {
+ port = car(args);
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->READ_LINE, args, AN_INPUT_PORT, 1);
- push_stack(sc, opcode(OP_SORT), sc->args, sc->code);
- goto HEAPSORT;
- }
+ if (is_not_null(cdr(args)))
+ with_eol = (cadr(args) != sc->F);
+ }
+ else
+ {
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->EOF_OBJECT);
+ }
+ return(port_read_line(port)(sc, port, with_eol, true));
+}
- SORT3:
- case OP_SORT3:
- {
- s7_Int n;
- n = SORT_N;
- if (n <= 0)
- {
- sc->value = car(sc->args);
- goto START;
- }
- sc->x = SORT_DATA(0);
- SORT_DATA(0) = SORT_DATA(n);
- SORT_DATA(n) = sc->x;
- SORT_N = n - 1;
- SORT_K1 = 0;
- push_stack(sc, opcode(OP_SORT3), sc->args, sc->code);
- goto HEAPSORT;
- }
+static s7_pointer c_read_line(s7_scheme *sc) {return(g_read_line(sc, sc->NIL));}
+PF_0(read_line, c_read_line)
- case OP_SORT4:
- /* sc->value is the sort vector which needs to be turned into a list */
- sc->value = s7_vector_to_list(sc, sc->value);
- goto START;
- case OP_SORT_TWO:
- /* here we're sorting a list of 2 items */
- if (is_true(sc, sc->value))
- sc->value = sc->args;
- else sc->value = make_list_2(sc, cadr(sc->args), car(sc->args));
- goto START;
-
- /* batcher networks:
- * ((0 2) (0 1) (1 2))
- * ((0 2) (1 3) (0 1) (2 3) (1 2))
- * ((0 4) (0 2) (1 3) (2 4) (0 1) (2 3) (1 4) (1 2) (3 4))
- * ((0 4) (1 5) (0 2) (1 3) (2 4) (3 5) (0 1) (2 3) (4 5) (1 4) (1 2) (3 4))
- * ((0 4) (1 5) (2 6) (0 2) (1 3) (4 6) (2 4) (3 5) (0 1) (2 3) (4 5) (1 4) (3 6) (1 2) (3 4) (5 6))
- * ((0 4) (1 5) (2 6) (3 7) (0 2) (1 3) (4 6) (5 7) (2 4) (3 5) (0 1) (2 3) (4 5) (6 7) (1 4) (3 6) (1 2) (3 4) (5 6))
- *
- * but since it has to be done here by hand, it turns into too much code, 3 is:
- * < l0 l2 ?
- * no goto L1
- * < l0 l1 ?
- * no return 1 0 2
- * < l1 l2?
- * yes return 0 1 2 (direct)
- * no return 0 2 1
- * L1:
- * < l0 l1 ?
- * yes return 2 0 1
- * < l1 l2 ?
- * yes return 1 2 0
- * no return 2 1 0
- * since each "<" op above goes to OP_APPLY, we have ca 5 labels, and ca 25-50 lines
- */
+static s7_pointer read_line_uncopied;
+static s7_pointer g_read_line_uncopied(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer port;
+ bool with_eol = false;
+ port = car(args);
+ if (!is_input_port(port))
+ return(g_read_line(sc, args));
+ if (is_not_null(cdr(args)))
+ with_eol = (cadr(args) != sc->F);
+ return(port_read_line(port)(sc, port, with_eol, false));
+}
- case OP_MAP:
- if (sc->value != sc->NO_VALUE) /* (map (lambda (x) (values)) (list 1)) */
- {
- if (is_multiple_value(sc->value)) /* (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4)) */
- caddr(sc->args) = s7_append(sc, safe_reverse_in_place(sc, multiple_value(sc->value)), caddr(sc->args));
- /* not append_in_place here because sc->value has the multiple-values bit set */
- else caddr(sc->args) = s7_cons(sc, sc->value, caddr(sc->args));
- }
+static s7_pointer c_read_string(s7_scheme *sc, s7_int chars, s7_pointer port)
+{
+ s7_pointer s;
+ s7_int i;
+ unsigned char *str;
- if (s7_integer(car(sc->args)) < s7_integer(cadr(sc->args)))
- {
- if (next_map(sc)) goto APPLY;
- }
-
- sc->value = safe_reverse_in_place(sc, caddr(sc->args));
- goto START;
+ if (chars < 0)
+ return(wrong_type_argument_with_type(sc, sc->READ_STRING, 1, make_integer(sc, chars), A_NON_NEGATIVE_INTEGER));
+ if (chars > sc->max_string_length)
+ return(out_of_range(sc, sc->READ_STRING, small_int(1), make_integer(sc, chars), ITS_TOO_LARGE));
-
- case OP_FOR_EACH:
- /* func = sc->code, func-args = caddr(sc->args), counter = car(sc->args), len = cadr(sc->args), object(s) = cdddr(sc->args) */
- if (s7_integer(car(sc->args)) < s7_integer(cadr(sc->args)))
- {
- if (next_for_each(sc)) goto APPLY;
- }
- sc->value = sc->UNSPECIFIED;
- goto START;
+ if (!port) return(sc->EOF_OBJECT);
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->READ_STRING, list_2(sc, make_integer(sc, chars), port), AN_INPUT_PORT, 2);
+ if (chars == 0)
+ return(make_empty_string(sc, 0, 0));
- case OP_MEMBER_IF1:
- case OP_MEMBER_IF:
- /* code=func, args=((val (car list)) list list), value=result of comparison
- */
- if (sc->value != sc->F) /* previous comparison was not #f -- return list */
+ s = make_empty_string(sc, chars, 0);
+ str = (unsigned char *)string_value(s);
+ for (i = 0; i < chars; i++)
+ {
+ int c;
+ c = port_read_character(port)(sc, port);
+ if (c == EOF)
{
- sc->value = cadr(sc->args);
- goto START;
+ if (i == 0)
+ return(sc->EOF_OBJECT);
+ string_length(s) = i;
+ return(s);
}
+ str[i] = (unsigned char)c;
+ }
+ return(s);
+}
- cadr(sc->args) = cdadr(sc->args); /* cdr down arg list */
- if ((cadr(sc->args) == sc->NIL) || /* no more args -- return #f */
- (!is_pair(cadr(sc->args)))) /* (member 3 '(1 2 . 3) =) -- we access caadr below */
- {
- sc->value = sc->F;
- goto START;
- }
+static s7_pointer g_read_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_read_string "(read-string k port) reads k characters from port into a new string and returns it."
+ #define Q_read_string s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_EOF_OBJECT), sc->IS_INTEGER, sc->IS_INPUT_PORT)
+ s7_pointer k, port;
- if (sc->op == OP_MEMBER_IF1)
- {
- /* circular list check */
- caddr(sc->args) = cdaddr(sc->args); /* cdr down the slow list (check for circular list) */
- if (cadr(sc->args) == caddr(sc->args))
- {
- sc->value = sc->F;
- goto START;
- }
- push_stack(sc, opcode(OP_MEMBER_IF), sc->args, sc->code);
- }
- else push_stack(sc, opcode(OP_MEMBER_IF1), sc->args, sc->code);
- cadar(sc->args) = caadr(sc->args);
- sc->args = car(sc->args);
- goto APPLY;
+ k = car(args);
+ if (!s7_is_integer(k))
+ method_or_bust(sc, k, sc->READ_STRING, args, T_INTEGER, 1);
+ if (!is_null(cdr(args)))
+ port = cadr(args);
+ else port = input_port_if_not_loading(sc); /* port checked (for NULL) in c_read_string */
+ return(c_read_string(sc, s7_integer(k), port));
+}
- case OP_ASSOC_IF1:
- case OP_ASSOC_IF:
- /* code=func, args=((val (caar list)) list), value=result of comparison
- * (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) =)
- */
- if (sc->value != sc->F) /* previous comparison was not #f -- return (car list) */
- {
- sc->value = caadr(sc->args);
- goto START;
- }
+static s7_pointer c_read_string_1(s7_scheme *sc, s7_int chars) {return(c_read_string(sc, chars, input_port_if_not_loading(sc)));}
+IF_TO_PF(read_string, c_read_string_1)
- cadr(sc->args) = cdadr(sc->args); /* cdr down arg list */
- if ((cadr(sc->args) == sc->NIL) || /* no more args -- return #f */
- (!is_pair(cadr(sc->args)))) /* (assoc 3 '((1 . 2) . 3) =) */
- {
- sc->value = sc->F;
- goto START;
- }
- if (sc->op == OP_ASSOC_IF1)
+s7_pointer s7_read(s7_scheme *sc, s7_pointer port)
+{
+ if (is_input_port(port))
+ {
+ bool old_longjmp;
+ s7_pointer old_envir;
+ old_envir = sc->envir;
+ sc->envir = sc->NIL;
+ if (sc->longjmp_ok)
{
- /* circular list check */
- caddr(sc->args) = cdaddr(sc->args); /* cdr down the slow list */
- if (cadr(sc->args) == caddr(sc->args))
- {
- sc->value = sc->F;
- goto START;
- }
- push_stack(sc, opcode(OP_ASSOC_IF), sc->args, sc->code);
+ push_input_port(sc, port);
+ push_stack(sc, OP_BARRIER, port, sc->NIL);
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ eval(sc, OP_READ_INTERNAL);
+ pop_input_port(sc);
+ sc->envir = old_envir;
+ return(sc->value);
}
- else push_stack(sc, opcode(OP_ASSOC_IF1), sc->args, sc->code);
-
- if (!is_pair(caadr(sc->args))) /* (assoc 1 '((2 . 2) 3) =) -- we access caaadr below */
- return(eval_error(sc, "assoc: 2nd arg is not an alist: ~S", caddr(sc->args)));
- /* not sure about this -- we could simply skip the entry both here and in g_assoc
- * (assoc 1 '((2 . 2) 3)) -> #f
- * (assoc 1 '((2 . 2) 3) =) -> error currently
- */
-
- cadar(sc->args) = caaadr(sc->args);
- sc->args = car(sc->args);
- goto APPLY;
-
-
- case OP_HOOK_APPLY:
- /* args = function args, code = function list */
- if (sc->code != sc->NIL)
+ stack_reset(sc);
+ push_stack(sc, OP_EVAL_DONE, old_envir, sc->NIL); /* GC protect envir */
+ push_input_port(sc, port);
+ old_longjmp = sc->longjmp_ok;
+ if (!sc->longjmp_ok)
{
- push_stack(sc, opcode(OP_HOOK_APPLY), sc->args, cdr(sc->code));
- sc->code = car(sc->code);
- goto APPLY;
+ sc->longjmp_ok = true;
+ if (setjmp(sc->goto_start) != 0)
+ eval(sc, sc->op);
+ else eval(sc, OP_READ_INTERNAL);
}
- goto START;
+ sc->longjmp_ok = old_longjmp;
+ pop_input_port(sc);
+ sc->envir = old_envir;
+ return(sc->value);
+ }
+ return(simple_wrong_type_argument_with_type(sc, sc->READ, port, AN_INPUT_PORT));
+}
- case OP_DO_STEP:
- /* increment all vars, return to endtest
- * these are also updated in parallel at the end, so we gather all the incremented values first
- */
- push_stack(sc, opcode(OP_DO_END), sc->args, sc->code);
- if (car(sc->args) == sc->NIL)
- goto START;
- sc->args = car(sc->args); /* the var data lists */
- sc->code = sc->args; /* save the top of the list */
-
-
- DO_STEP1:
- /* on each iteration, we first get here with args as the list of var bindings, exprs, and init vals
- * e.g. (((i . 0) (+ i 1) 0))
- * each arg incr expr is evaluated and the value placed in caddr while we cdr down args
- * finally args is nil...
- */
+static s7_pointer g_read(s7_scheme *sc, s7_pointer args)
+{
+ /* would it be useful to add an environment arg here? (just set sc->envir at the end?)
+ * except for expansions, nothing is evaluated at read time, unless...
+ * say we set up a dot reader:
+ * (set! *#readers* (cons (cons #\. (lambda (str) (if (string=? str ".") (eval (read)) #f))) *#readers*))
+ * then
+ * (call-with-input-string "(+ 1 #.(+ 1 hiho))" (lambda (p) (read p)))
+ * evaluates hiho in the rootlet, but how to pass the env to the inner eval or read?
+ * (eval, eval-string and load already have an env arg)
+ */
+ #define H_read "(read (port (current-input-port))) returns the next object in the input port, or #<eof> at the end"
+ #define Q_read s7_make_signature(sc, 2, sc->T, sc->IS_INPUT_PORT)
+ s7_pointer port;
- if (sc->args == sc->NIL)
- {
- for (sc->x = sc->code; sc->x != sc->NIL; sc->x = cdr(sc->x))
- set_symbol_value(caar(sc->x), caddar(sc->x));
+ if (is_not_null(args))
+ port = car(args);
+ else
+ {
+ port = input_port_if_not_loading(sc);
+ if (!port) return(sc->EOF_OBJECT);
+ }
- /* some schemes rebind here, rather than reset, but that is expensive,
- * and only matters once in a blue moon (closure over enclosed lambda referring to a do var)
- * and the caller can easily mimic the correct behavior in that case by adding a let or using a named let,
- * making the rebinding explicit.
- *
- * Hmmm... I'll leave this alone, but there are other less cut-and-dried cases:
- *
- * (let ((j (lambda () 0))
- * (k 0))
- * (do ((i (j) (j))
- * (j (lambda () 1) (lambda () (+ i 1)))) ; bind here hits different "i" than set!
- * ((= i 3) k)
- * (set! k (+ k i))))
- *
- * is it 6 or 3?
- *
- * if we had a way to tell that there were no lambdas in the do expression, would that
- * guarantee that set was ok? Here's a bad case:
- *
- * (let ((f #f))
- * (do ((i 0 (+ i 1)))
- * ((= i 3))
- * (let () ; so that the define is ok
- * (define (x) i)
- * (if (= i 1) (set! f x))))
- * (f))
- *
- * s7 says 3, guile says 1.
- *
- * I wonder if what they're actually talking about is a kind of shared value problem. If we
- * set the value directly (not the cdr(binding) but, for example, integer(cdr(binding))), then
- * every previous reference gets changed as a side-effect. In the current code, we're "binding"
- * the value in the sense that on each step, a new value is assigned to the step variable.
- * In the "direct" case, (let ((v #(0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (set! (v i) i))
- * would return #(3 3 3).
- */
-
- sc->value = sc->NIL;
- pop_stack(sc);
- sc->op = OP_DO_END;
- goto START_WITHOUT_POP_STACK;
- }
+ if (!is_input_port(port))
+ method_or_bust_with_type(sc, port, sc->READ, args, AN_INPUT_PORT, 0);
- /* check for (very common) optimized case */
- {
- s7_pointer sv;
- sv = car(cdddr(car(sc->args)));
- if ((sv != sc->F) && /* optimization is possible */
- (symbol_value(vector_element(sv, 1)) == vector_element(sv, 0)) && /* '+' has not changed */
- (is_steppable_integer(cdr(vector_element(sv, 2))))) /* step var is still ok */
- {
- if (vector_element(sv, 0) == initial_add)
- caddar(sc->args) = s7_make_integer(sc, s7_integer(cdr(vector_element(sv, 2))) + s7_integer(vector_element(sv, 3)));
- else caddar(sc->args) = s7_make_integer(sc, s7_integer(cdr(vector_element(sv, 2))) - s7_integer(vector_element(sv, 3)));
- /* this can't use make_mutable_integer */
+ if (is_function_port(port))
+ return((*(port_input_function(port)))(sc, S7_READ, port));
- sc->args = cdr(sc->args); /* go to next step var */
- goto DO_STEP1;
- }
- }
+ if ((is_string_port(port)) &&
+ (port_data_size(port) <= port_position(port)))
+ return(sc->EOF_OBJECT);
- push_stack(sc, opcode(OP_DO_STEP2), sc->args, sc->code);
-
- /* here sc->args is a list like (((i . 0) (+ i 1) 0 #f) ...)
- * so sc->code becomes (+ i 1) in this case
- */
- sc->code = cadar(sc->args);
- sc->args = sc->NIL;
- goto EVAL;
-
+ push_input_port(sc, port);
+ push_stack(sc, OP_READ_DONE, sc->NIL, sc->NIL); /* this stops the internal read process so we only get one form */
+ push_stack(sc, OP_READ_INTERNAL, sc->NIL, sc->NIL);
- case OP_DO_STEP2:
- caddar(sc->args) = sc->value; /* save current value */
- sc->args = cdr(sc->args); /* go to next step var */
- goto DO_STEP1;
-
+ return(port);
+}
- case OP_DO:
- /* setup is very similar to let */
- /* sc->code is the stuff after "do" */
+static s7_pointer c_read(s7_scheme *sc) {return(g_read(sc, sc->NIL));}
+PF_0(read, c_read)
- if ((!is_pair(sc->code)) || /* (do . 1) */
- ((!is_pair(car(sc->code))) && /* (do 123) */
- (car(sc->code) != sc->NIL))) /* (do () ...) is ok */
- return(eval_error(sc, "do: var list is not a list: ~S", sc->code));
- if (!is_pair(cdr(sc->code))) /* (do () . 1) */
- return(eval_error(sc, "do body is messed up: ~A", sc->code));
+/* -------------------------------- load -------------------------------- */
- if ((!is_pair(cadr(sc->code))) && /* (do ((i 0)) 123) */
- (cadr(sc->code) != sc->NIL)) /* no end-test? */
- return(eval_error(sc, "do: end-test and end-value list is not a list: ~A", sc->code));
+static FILE *search_load_path(s7_scheme *sc, const char *name)
+{
+ int i, len;
+ s7_pointer lst;
- if (car(sc->code) == sc->NIL) /* (do () ...) -- (let ((i 0)) (do () ((= i 1)) (set! i 1))) */
+ lst = s7_load_path(sc);
+ len = s7_list_length(sc, lst);
+ for (i = 0; i < len; i++)
+ {
+ const char *new_dir;
+ new_dir = string_value(s7_list_ref(sc, lst, i));
+ if (new_dir)
{
- s7_pointer end_stuff;
- end_stuff = cadr(sc->code);
- sc->envir = new_frame_in_env(sc, sc->envir);
- if (end_stuff == sc->NIL)
- sc->args = make_list_1(sc, sc->NIL);
- else sc->args = s7_cons(sc, sc->NIL, s7_cons(sc, s7_cons(sc, car(end_stuff), sc->F), cdr(end_stuff)));
- sc->code = cddr(sc->code);
- goto DO_END1;
+ FILE *fp;
+ snprintf(sc->tmpbuf, TMPBUF_SIZE, "%s/%s", new_dir, name);
+ fp = fopen(sc->tmpbuf, "r");
+ if (fp) return(fp);
}
-
- /* eval each init value, then set up the new frame (like let, not let*) */
- sc->args = sc->NIL; /* the evaluated var-data */
- sc->value = sc->code; /* protect it */
- sc->code = car(sc->code); /* the vars */
-
-
- case OP_DO_INIT:
- sc->args = s7_cons(sc, sc->value, sc->args); /* code will be last element (first after reverse) */
- if (is_pair(sc->code))
- {
- /* here sc->code is a list like: ((i 0 (+ i 1)) ...)
- * so cadar gets the init value.
- *
- * we accept:
- * (do ((i 1) (i 2)) (#t i)) -> 2
- * (do () (1) . "hi") -- this is like (do () (#t #t) (asdf))
- */
- if (!(is_pair(car(sc->code)))) /* (do (4) (= 3)) */
- return(eval_error(sc, "do: variable name missing? ~A", sc->code));
+ }
+ return(NULL);
+}
- if (is_pair(cdar(sc->code)))
- {
- if ((!is_pair(cddar(sc->code))) &&
- (cddar(sc->code) != sc->NIL)) /* (do ((i 0 . 1)) ...) */
- return(eval_error(sc, "do: step variable info is an improper list?: ~A", sc->code));
- if ((is_pair(cddar(sc->code))) &&
- (cdr(cddar(sc->code)) != sc->NIL)) /* (do ((i 0 1 (+ i 1))) ...) */
- return(eval_error(sc, "do: step variable info has extra stuff after the increment: ~A", sc->code));
- }
- else return(eval_error(sc, "do: step variable has no initial value: ~A", car(sc->code)));
- /* (do ((i)) ...) */
+static s7_pointer s7_load_1(s7_scheme *sc, const char *filename, s7_pointer e)
+{
+ s7_pointer port;
+ FILE *fp;
+ char *new_filename = NULL;
- push_stack(sc, opcode(OP_DO_INIT), sc->args, cdr(sc->code));
- sc->code = cadar(sc->code);
- sc->args = sc->NIL;
- goto EVAL;
- }
-
- /* all the initial values are now in the args list */
+ fp = fopen(filename, "r");
+ if (!fp)
+ {
+ fp = search_load_path(sc, filename);
+ if (fp)
+ new_filename = copy_string(sc->tmpbuf); /* (require libc.scm) for example needs the directory for cload in some cases */
+ }
+ if (!fp)
+ return(file_error(sc, "load", "can't open", filename));
- if (sc->code != sc->NIL) /* (do ((i 0 i) . 1) ((= i 1))) */
- return(eval_error(sc, "do: list of variables is improper: ~A", sc->code));
-
- prepare_do_step_variables(sc);
+ if (is_pair(s7_hook_functions(sc, sc->load_hook)))
+ s7_call(sc, sc->load_hook, list_1(sc, sc->temp4 = s7_make_string(sc, filename)));
- DO_END1:
- prepare_do_end_test(sc);
-
+ port = read_file(sc, fp, (new_filename) ? (const char *)new_filename : filename, -1, "load"); /* -1 means always read its contents into a local string */
+ port_file_number(port) = remember_file_name(sc, filename);
+ if (new_filename) free(new_filename);
+ set_loader_port(port);
+ push_input_port(sc, port);
- case OP_DO_END:
- /* here vars have been init'd or incr'd
- * args = (list var-data end-expr return-expr-if-any)
- * if (do ((i 0 (+ i 1))) ((= i 3) 10)), args: (vars ((= i 3) <opt-info>) 10)
- * if (do ((i 0 (+ i 1))) ((= i 3))), args: (vars ((= i 3) <opt-info>)) and result expr is () == (begin)
- * if (do ((i 0 (+ i 1))) (#t 10 12)), args: (vars #t 10 12), result: ([begin] 10 12) -> 12
- * if (call-with-exit (lambda (r) (do () () (r)))), args: '(())
- * code = body
- */
+ /* it's possible to call this recursively (s7_load is Xen_load_file which can be invoked via s7_call)
+ * but in that case, we actually want it to behave like g_load and continue the evaluation upon completion
+ */
+ sc->envir = e;
+ push_stack(sc, OP_LOAD_RETURN_IF_EOF, port, sc->code);
- if (cdr(sc->args) != sc->NIL)
+ if (!sc->longjmp_ok)
+ {
+ bool old_longjmp;
+ old_longjmp = sc->longjmp_ok;
+ if (!sc->longjmp_ok)
{
- /* check for optimizable case */
- {
- s7_pointer sv;
- sv = cdr(cadr(sc->args));
- if ((sv != sc->F) && /* optimization is possible */
- (symbol_value(vector_element(sv, 1)) == vector_element(sv, 0)) && /* '=' or whatever has not changed */
- ((vector_element(sv, 2) == sc->F) || /* arg1 is either a prechecked int constant */
- (is_steppable_integer(cdr(vector_element(sv, 2))))) && /* or a variable whose value is an acceptable integer */
- ((vector_element(sv, 4) == sc->F) || /* same for arg2 */
- (is_steppable_integer(cdr(vector_element(sv, 4))))))
- {
- /* get the current arg values (we've checked above that they're ints), check for equality
- */
- s7_Int arg1, arg2;
- if (vector_element(sv, 2) == sc->F)
- arg1 = s7_integer(vector_element(sv, 3));
- else arg1 = s7_integer(cdr(vector_element(sv, 2)));
- if (vector_element(sv, 4) == sc->F)
- arg2 = s7_integer(vector_element(sv, 5));
- else arg2 = s7_integer(cdr(vector_element(sv, 4)));
-
- /* it seems innocuous to extend this to other ops like '>', but somehow
- * that greatly slows down eval_args below! (A switch statement
- * or a function call is equally bad).
- */
- if (((vector_element(sv, 0) == initial_equal) && (arg1 == arg2)) ||
- ((vector_element(sv, 0) == initial_lt) && (arg1 < arg2)) ||
- ((vector_element(sv, 0) == initial_gt) && (arg1 > arg2)))
- {
- /* end test is #t, go to result */
- sc->code = cddr(sc->args); /* result expr (a list -- implicit begin) */
- goto BEGIN;
- }
-
- /* end test is #f, evaluate body (sc->code is ready to go) */
- push_stack(sc, opcode(OP_DO_STEP), sc->args, sc->code);
- goto BEGIN;
- }
- }
-
- push_stack(sc, opcode(OP_DO_END1), sc->args, sc->code);
- sc->code = caadr(sc->args); /* evaluate the end expr */
- sc->args = sc->NIL;
- goto EVAL;
+ sc->longjmp_ok = true;
+ if (setjmp(sc->goto_start) != 0)
+ eval(sc, sc->op);
+ else eval(sc, OP_READ_INTERNAL);
}
- else sc->value = sc->F; /* (do ((...)) () ...) -- no endtest */
+ sc->longjmp_ok = old_longjmp;
+ }
+ else eval(sc, OP_READ_INTERNAL);
+ pop_input_port(sc);
+ if (is_input_port(port))
+ s7_close_input_port(sc, port);
+ return(sc->value);
+}
- case OP_DO_END1:
- /* sc->value is the result of end-test evaluation */
- if (is_true(sc, sc->value))
- {
- /* we're done -- deal with result exprs
- * if there isn't an end test, there also isn't a result (they're in the same list)
- */
- sc->code = cddr(sc->args); /* result expr (a list -- implicit begin) */
- }
- else
- {
- /* evaluate the body and step vars, etc */
- push_stack(sc, opcode(OP_DO_STEP), sc->args, sc->code);
- /* sc->code is ready to go */
- }
- /* fall through */
+s7_pointer s7_load(s7_scheme *sc, const char *filename)
+{
+ return(s7_load_1(sc, filename, sc->NIL));
+}
- BEGIN:
- case OP_BEGIN:
- if (sc->begin_hook)
- {
- push_stack(sc, opcode(OP_BARRIER), sc->args, sc->code);
- if ((*(sc->begin_hook))(sc))
- {
- s7_quit(sc);
- return(sc->F);
- }
- pop_stack(sc);
- }
- sc->args = sc->NIL;
- if (!is_pair(sc->code))
- {
- if (sc->code != sc->NIL) /* (begin . 1), (cond (#t . 1)) */
- return(eval_error_with_name(sc, "~A: unexpected dot or '() at end of body? ~A", sc->code));
+#if WITH_C_LOADER
+#include <dlfcn.h>
- sc->value = sc->code;
- goto START;
- }
-
- if (cdr(sc->code) != sc->NIL)
- push_stack(sc, opcode(OP_BEGIN), sc->NIL, cdr(sc->code));
-
- sc->code = car(sc->code);
- sc->cur_code = sc->code; /* in case error occurs, this helps tell us where we are */
- /* fall through */
-
+static char *full_filename(const char *filename)
+{
+ int len;
+ char *pwd, *rtn;
+ pwd = getcwd(NULL, 0); /* docs say this means it will return a new string of the right size */
+ len = safe_strlen(pwd) + safe_strlen(filename) + 8;
+ rtn = (char *)malloc(len * sizeof(char));
+ if (pwd)
+ {
+ snprintf(rtn, len, "%s/%s", pwd, filename);
+ free(pwd);
+ }
+ else snprintf(rtn, len, "%s", filename);
+ return(rtn);
+}
+#endif
- /* replacing this label with the equivalent sc->op = OP_EVAL and so on is much slower */
- EVAL:
- case OP_EVAL: /* main part of evaluation */
- switch (type(sc->code))
- {
- case T_PAIR:
- /* using a local s7_pointer here drastically slows things down?!? */
- if (is_syntax(car(sc->code)))
- {
- sc->op = (opcode_t)syntax_opcode(car(sc->code));
- sc->code = cdr(sc->code);
- goto START_WITHOUT_POP_STACK;
- }
- /* if we check here for a thunk (or argless macro call), and jump to apply,
- * it's actually slower by about 30/2400 than just plowing ahead as if
- * there were args. (The check costs 27 and we only hit it a few hundred times).
- */
- push_stack(sc, opcode(OP_EVAL_ARGS), sc->NIL, cdr(sc->code));
- sc->code = car(sc->code);
- goto EVAL;
+static s7_pointer g_load(s7_scheme *sc, s7_pointer args)
+{
+ #define H_load "(load file (env (rootlet))) loads the scheme file 'file'. The 'env' argument \
+defaults to the rootlet. To load into the current environment instead, pass (curlet)."
+ #define Q_load s7_make_signature(sc, 3, sc->VALUES, sc->IS_STRING, sc->IS_LET)
- case T_SYMBOL:
- {
- /* expand eval_symbol here to speed it up by a lot */
- s7_pointer x;
+ FILE *fp = NULL;
+ s7_pointer name, port;
+ const char *fname;
- if (is_not_local(sc->code))
- x = symbol_global_slot(sc->code);
- else x = find_symbol(sc, sc->envir, sc->code);
+ name = car(args);
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->LOAD, args, T_STRING, 1);
- if (x != sc->NIL)
- sc->value = symbol_value(x);
- else sc->value = eval_symbol_1(sc, sc->code);
- goto START;
- }
+ if (is_not_null(cdr(args)))
+ {
+ s7_pointer e;
+ e = cadr(args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->LOAD, 2, e, A_LET));
+ if (e == sc->rootlet)
+ sc->envir = sc->NIL;
+ else sc->envir = e;
+ }
+ else sc->envir = sc->NIL;
- default:
- sc->value = sc->code;
- goto START;
- }
- break;
+ fname = string_value(name);
+ if ((!fname) || (!(*fname))) /* fopen("", "r") returns a file pointer?? */
+ return(s7_error(sc, sc->OUT_OF_RANGE, set_elist_2(sc, make_string_wrapper(sc, "load's first argument, ~S, should be a filename"), name)));
-
- case OP_EVAL_ARGS:
- if (is_any_macro_or_syntax(sc->value))
- {
- if (is_any_macro(sc->value))
- {
- /* macro expansion */
- push_stack(sc, opcode(OP_EVAL_MACRO), sc->NIL, sc->code); /* sc->code is here for (vital) GC protection */
- /* args is nil, value is the macro code bound to mac-name, code is the unevaluated arglist
- * we want to pass a list of (mac . args) to the macro expander
- */
- car(sc->TEMP_CELL_1) = sc->value; /* macro */
- cdr(sc->TEMP_CELL_1) = sc->code; /* args */
- sc->args = sc->TEMP_CELL;
- sc->code = sc->value;
- goto APPLY;
- }
+ if (is_directory(fname))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "load argument, ~S, is a directory"), name)));
- /* (define progn begin)
- * (progn (display "hi") (+ 1 23))
- * we can't catch this above under T_SYMBOL because we might be using "syntax" symbols as symbols (case labels etc)
- */
+#if WITH_C_LOADER
+ /* if fname ends in .so, try loading it as a c shared object
+ * (load "/home/bil/cl/m_j0.so" (inlet (cons 'init_func 'init_m_j0)))
+ */
+ {
+ int fname_len;
- sc->op = (opcode_t)syntax_opcode(sc->value);
- goto START_WITHOUT_POP_STACK;
- }
+ fname_len = safe_strlen(fname);
+ if ((fname_len > 3) &&
+ (is_pair(cdr(args))) &&
+ (local_strcmp((const char *)(fname + (fname_len - 3)), ".so")))
+ {
+ s7_pointer init;
- /* sc->value is the func, sc->code is the entire expression
- *
- * we don't have to delay lookup of the func because arg evaluation order is not specified, so
- * (let ((func +)) (func (let () (set! func -) 3) 2))
- * can return 5.
- *
- * check for args=nil and jump to apply here costs slightly more than it saves
- *
- * here sc->args is nil, sc->value is the operator (car of list), sc->code is the rest -- the args.
- * allocating sc->args here rather than below (trading 2 sets for a jump) was much slower
- */
+ init = let_ref_1(sc, sc->envir, s7_make_symbol(sc, "init_func"));
+ if (is_symbol(init))
+ {
+ void *library;
+ char *pwd_name = NULL;
-
- /* using while here rather than EVAL_ARGS and a goto made no speed difference */
- EVAL_ARGS:
- case OP_EVAL_ARGS1:
- /* this is where most of s7's compute time goes */
- /* expanding the function calls (s7_cons, new_cell, and eval_symbol) in place seems to speed up s7 by a noticeable amount! */
- /* before expansion: sc->args = s7_cons(sc, sc->value, sc->args); */
-
- /* I tried using prebuilt never-gc'd arglists here to drastically reduce consing etc, but
- * they are tricky (the arglist object needs to be in the regular heap so that errors and
- * call/cc's can hold references to internal objects in the list, but that slows down
- * decisions about when a given arglist can be returned to the arglist-heap). We have to
- * store the argument in the arglist and update the current location in any case, so
- * the savings won't be huge (the entire process involves not more than 1/4 of the total
- * compute time), and in my implementation, although gc-ing was greatly reduced, other
- * things took more time, and s7 ended up running slightly slower. So, I think I could
- * get a slight speed-up this way, with a few more days of work, but the code would be
- * much more complicated. I prefer simpler code in this case.
- */
+ if (fname[0] != '/')
+ pwd_name = full_filename(fname); /* this is necessary, at least in Linux -- we can't blithely dlopen whatever is passed to us */
+ library = dlopen((pwd_name) ? pwd_name : fname, RTLD_NOW);
+ if (library)
+ {
+ const char *init_name = NULL;
+ void *init_func;
- {
- s7_pointer x;
- NEW_CELL(sc, x);
- car(x) = sc->value;
- cdr(x) = sc->args;
- set_type(x, T_PAIR | T_STRUCTURE);
- sc->args = x;
+ init_name = symbol_name(init);
+ init_func = dlsym(library, init_name);
+ if (init_func)
+ {
+ typedef void *(*dl_func)(s7_scheme *sc);
+ ((dl_func)init_func)(sc);
+ if (pwd_name) free(pwd_name);
+ return(sc->T);
+ }
+ else
+ {
+ s7_warn(sc, 512, "loaded %s, but can't find %s (%s)?\n", fname, init_name, dlerror());
+ dlclose(library);
+ }
+ }
+ else s7_warn(sc, 512, "load %s failed: %s\n", (pwd_name) ? pwd_name : fname, dlerror());
+ if (pwd_name) free(pwd_name);
+ }
+ else s7_warn(sc, 512, "can't load %s: no init function\n", fname);
+ return(sc->F);
}
+ }
+#endif
- /* 1st time, value = op, args = nil (only e0 entry is from op_eval above), code is full list (at e0) */
- if (is_pair(sc->code)) /* evaluate current arg -- must check for pair here, not sc->NIL (improper list as args) */
- {
- int typ;
- s7_pointer car_code;
- car_code = car(sc->code);
- typ = type(car_code);
-
- /* switch statement here is much slower for some reason */
- if (typ == T_PAIR)
- {
- push_stack(sc, opcode(OP_EVAL_ARGS1), sc->args, cdr(sc->code));
- sc->code = car_code;
- /* sc->args = sc->NIL; */
- goto EVAL;
- }
-
- if (typ == T_SYMBOL)
- {
- /* expand eval_symbol here to speed it up, was sc->value = eval_symbol(sc, car(sc->code)); */
- s7_pointer x;
- if (is_not_local(car_code))
- x = symbol_global_slot(car_code);
- else x = find_symbol(sc, sc->envir, car_code);
- if (x != sc->NIL)
- sc->value = symbol_value(x);
- else sc->value = eval_symbol_1(sc, car_code);
- }
- else sc->value = car_code;
+ fp = fopen(fname, "r");
- sc->code = cdr(sc->code);
- goto EVAL_ARGS;
- }
- else /* got all args -- go to apply */
+#if WITH_GCC
+ if (!fp)
+ {
+ /* catch one special case, "~/..." since it causes 99.9% of the "can't load ..." errors */
+ if ((fname[0] == '~') &&
+ (fname[1] == '/'))
{
- if (sc->code != sc->NIL)
- improper_arglist_error(sc);
- else
+ char *home;
+ home = getenv("HOME");
+ if (home)
{
- sc->args = safe_reverse_in_place(sc, sc->args);
- /* we could omit this reversal in many cases: all built in ops could
- * assume reversed args, things like eq? and + don't care about order, etc.
- * But, I think the reversal is not taking any noticeable percentage of
- * the overall compute time (ca 1% according to callgrind).
- */
- sc->code = car(sc->args);
- sc->args = cdr(sc->args);
- /* fall through */
-
- /* I tried a "safe function" bit meaning the args could be gc'd immediately after
- * the call, setting sc->arg_temp = sc->args here, then returning those
- * args to the free list after the function call -- a kind of incremental GC.
- * The GC is called less often, but the local free code takes more time than
- * we save in the GC, so the only gain is that there are fewer points where
- * s7 pauses to call the GC. The time lost is about 1%. This was a big
- * disappointment!
- */
+ char *filename;
+ int len;
+ len = safe_strlen(fname) + safe_strlen(home) + 1;
+ tmpbuf_malloc(filename, len);
+ snprintf(filename, len, "%s%s", home, (char *)(fname + 1));
+ fp = fopen(filename, "r");
+ tmpbuf_free(filename, len);
}
}
-
-
- /* ---------------- OP_APPLY ---------------- */
- APPLY:
- case OP_APPLY: /* apply 'code' to 'args' */
-
-#if WITH_PROFILING
- symbol_calls(sc->code)++;
- if (!(symbol_data(sc->code)))
- symbol_data(sc->code) = (int *)calloc(100, sizeof(int));
- tick_args(symbol_data(sc->code), sc->args);
+ }
#endif
- if (*(sc->tracing))
- trace_apply(sc);
+ if (!fp)
+ {
+ fp = search_load_path(sc, fname);
+ if (!fp)
+ return(file_error(sc, "load", "can't open", fname));
+ }
- APPLY_WITHOUT_TRACE:
+ port = read_file(sc, fp, fname, -1, "load");
+ port_file_number(port) = remember_file_name(sc, fname);
+ set_loader_port(port);
+ push_input_port(sc, port);
- /*
- * if (sc->stack_end >= sc->stack_resize_trigger)
- * increase_stack_size(sc);
- *
- * the two places where the stack reaches it maximum size are in read_expression where TOKEN_LEFT_PAREN
- * pushes OP_READ_LIST, and (the actual max) in OP_EVAL at the push of OP_EVAL_ARGS. I've moved
- * the stack size check from here (where it reflects the eval stack size) to read_expression (where
- * it reflects nested list depth), and added it to the T_CLOSURE(*) parts of apply since (for example)
- * extremely deep recursion involving map or for-each can increase the stack size indefinitely:
- *
- * (define (tfe a b)
- * (format #t "~A ~A -> ~A~%" a b (-s7-stack-size))
- * (for-each
- * (lambda (c)
- * (if (< c b)
- * (tfe (+ c 1) b)))
- * (list a)))
- *
- * now (tfe 0 1000) triggers the stack increase.
- */
+ push_stack(sc, OP_LOAD_CLOSE_AND_POP_IF_EOF, sc->NIL, sc->NIL); /* was pushing args and code, but I don't think they're used later */
+ push_stack(sc, OP_READ_INTERNAL, sc->NIL, sc->NIL);
- switch (type(sc->code))
- {
- case T_C_FUNCTION: /* -------- C-based function -------- */
- {
- int len;
- len = safe_list_length(sc, sc->args);
- /* I tried embedding this list length in the safe_reverse_in_place function above, but
- * that did not provide any speed-up.
- */
+ /* now we've opened and moved to the file to be loaded, and set up the stack to return
+ * to where we were. Call *load-hook* if it is a procedure.
+ */
- if (len < c_function_required_args(sc->code))
- return(s7_error(sc,
- sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->NOT_ENOUGH_ARGUMENTS, sc->code, sc->args)));
+ if (is_not_null(s7_hook_functions(sc, sc->load_hook)))
+ s7_apply_function(sc, sc->load_hook, list_1(sc, sc->temp4 = s7_make_string(sc, fname)));
- if (c_function_all_args(sc->code) < len)
- return(s7_error(sc,
- sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->TOO_MANY_ARGUMENTS, sc->code, sc->args)));
- }
- /* drop into ... */
+ return(sc->UNSPECIFIED);
+}
- case T_C_ANY_ARGS_FUNCTION: /* -------- C-based function that can take any number of arguments -------- */
- sc->value = c_function_call(sc->code)(sc, sc->args);
- goto START;
- case T_C_OPT_ARGS_FUNCTION: /* -------- C-based function that has n optional arguments -------- */
- {
- int len;
- len = safe_list_length(sc, sc->args);
- if (c_function_all_args(sc->code) < len)
- return(s7_error(sc,
- sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->TOO_MANY_ARGUMENTS, sc->code, sc->args)));
- sc->value = c_function_call(sc->code)(sc, sc->args);
- goto START;
- }
+s7_pointer s7_load_path(s7_scheme *sc)
+{
+ return(s7_symbol_value(sc, sc->LOAD_PATH));
+}
- case T_C_RST_ARGS_FUNCTION: /* -------- C-based function that has n required args, then any others -------- */
- {
- int len;
- len = safe_list_length(sc, sc->args);
- if (len < c_function_required_args(sc->code))
- return(s7_error(sc,
- sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->NOT_ENOUGH_ARGUMENTS, sc->code, sc->args)));
- sc->value = c_function_call(sc->code)(sc, sc->args);
- /* sc->code here need not match sc->code before the function call (map for example) */
- goto START;
- }
- case T_C_LST_ARGS_FUNCTION: /* -------- {list} -------- */
- if (sc->no_values == 0)
- sc->value = sc->args;
- else sc->value = g_qq_list(sc, sc->args); /* c_function_call(sc->code)(sc, sc->args); */
- goto START;
+s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir)
+{
+ s7_symbol_set_value(sc,
+ sc->LOAD_PATH,
+ cons(sc,
+ s7_make_string(sc, dir),
+ s7_symbol_value(sc, sc->LOAD_PATH)));
+ return(s7_symbol_value(sc, sc->LOAD_PATH));
+}
- case T_C_MACRO: /* -------- C-based macro -------- */
- {
- int len;
-
- if (is_pair(car(sc->args))) /* normally args is ((mac-name ...)) */
- { /* but in a case like (call-with-exit quasiquote), args is (#<goto>) */
- if ((cdar(sc->args) != sc->NIL) &&
- (!is_pair(cdar(sc->args)))) /* (quasiquote . 1) */
- eval_error(sc, "improper list of arguments: ~A", car(sc->args));
- sc->args = cdar(sc->args);
- }
- else
- {
- /* I think this can only be triggered by map/for-each with a (c_)macro [in fact, quasiquote] argument,
- * so perhaps we can fix it here?
- */
- eval_error(sc, "~A called as a function, but it's a macro!", sc->code);
- }
- len = s7_list_length(sc, sc->args);
- if (len <= 0) /* (quasiquote 0 . 1) */
- return(s7_error(sc, sc->SYNTAX_ERROR,
- make_list_3(sc, make_protected_string(sc, "~A: improper list of arguments: ~S"), sc->code, sc->args)));
+static s7_pointer g_load_path_set(s7_scheme *sc, s7_pointer args)
+{
+ /* new value must be either () or a proper list of strings */
+ if (is_null(cadr(args))) return(cadr(args));
+ if (is_pair(cadr(args)))
+ {
+ s7_pointer x;
+ for (x = cadr(args); is_pair(x); x = cdr(x))
+ if (!is_string(car(x)))
+ return(sc->ERROR);
+ if (is_null(x))
+ return(cadr(args));
+ }
+ return(sc->ERROR);
+}
- if (len < c_macro_required_args(sc->code))
- return(s7_error(sc,
- sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->NOT_ENOUGH_ARGUMENTS, sc->code, sc->args)));
-
- if (c_macro_all_args(sc->code) < len)
- return(s7_error(sc,
- sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->TOO_MANY_ARGUMENTS, sc->code, sc->args)));
- sc->value = c_macro_call(sc->code)(sc, sc->args);
- goto START;
- }
-
- case T_BACRO: /* -------- bacro -------- */
- NEW_FRAME(sc, sc->envir, sc->envir); /* like let* -- we'll be adding macro args, so might as well sequester things here */
- goto BACRO;
- /* another choice is to do expansion and evaluation in the definition env,
- * so only the args come (unevaluated) from the current env.
- * I can't immediately see any need for this.
- *
- * but probably useful would be bacro without the following evaluation, sort of like a function with unevaluated args
- * (but expanded in the call-time env): "lacro"?
- */
+/* ---------------- autoload ---------------- */
- case T_CLOSURE: /* -------- normal function (lambda), or macro -------- */
- if (sc->stack_end >= sc->stack_resize_trigger)
- increase_stack_size(sc);
+void s7_autoload_set_names(s7_scheme *sc, const char **names, int size)
+{
+ /* the idea here is that by sticking to string constants we can handle 90% of the work at compile-time,
+ * with less start-up memory. Then eventually we'll add C libraries a la xg (gtk) as environments
+ * and every name in that library will come as an import once dlopen has picked up the library.
+ * So, hopefully, we can pre-declare as many names as we want from as many libraries as we want,
+ * without a bloated mess of a run-time image. And new libraries are easy to accommodate --
+ * add the names to be auto-exported to this list with the name of the scheme file that cloads
+ * the library and exports the given name. So, we'll need a separate such file for each library?
+ *
+ * the environment variable could use the library base name in *: *libm* or *libgtk*
+ * (*libm* 'j0)
+ * why not just predeclare these libraries? The caller could import what he wants via require.
+ * So the autoloader need only know which libraries, but this doesn't fit the current use of gtk in xg
+ * In fact, we only need to see *libm* -> libm.so etc, but we still need the arg/return types of each function, etc
+ * And libgtk is enormous -- seems too bad to tie-in everything via the FFI when we need less than 1% of it.
+ * Perhaps each module as an environment within the main one: ((*libgtk* *gtkwidget*) 'gtk_widget_new)?
+ * But that requires inside knowlege of the library, and changes without notice.
+ *
+ * Also we need to decide how to handle name collisions (by order of autoload lib setup)
+ * And (lastly?) how to handle different library versions?
+ *
+ *
+ * so autoload known libs here in s7 so we're indepentdent of snd
+ * (currently these are included in make-index.scm[line 575] -> snd-xref.c)
+ * for each module, include an env in the lib env (*libgtk* 'gtkwidget.h) or whatever that has the names in that header
+ * in autoload below, don't sort! -- just build a list of autoload tables and check each in order at autoload time (we want startup to be fast)
+ * for versions, include wrapper macro at end of each c-define choice
+ * in the xg case, there's no savings in delaying the defines
+ *
+ */
- case T_MACRO:
- /* sc->envir = new_frame_in_env(sc, closure_environment(sc->code)); */
- NEW_FRAME(sc, closure_environment(sc->code), sc->envir);
+ if (sc->autoload_names == NULL)
+ {
+ sc->autoload_names = (const char ***)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(const char **));
+ sc->autoload_names_sizes = (int *)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(int));
+ sc->autoloaded_already = (bool **)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(bool *));
+ sc->autoload_names_top = INITIAL_AUTOLOAD_NAMES_SIZE;
+ sc->autoload_names_loc = 0;
+ }
+ else
+ {
+ if (sc->autoload_names_loc >= sc->autoload_names_top)
+ {
+ int i;
+ sc->autoload_names_top *= 2;
+ sc->autoload_names = (const char ***)realloc(sc->autoload_names, sc->autoload_names_top * sizeof(const char **));
+ sc->autoload_names_sizes = (int *)realloc(sc->autoload_names_sizes, sc->autoload_names_top * sizeof(int));
+ sc->autoloaded_already = (bool **)realloc(sc->autoloaded_already, sc->autoload_names_top * sizeof(bool *));
+ for (i = sc->autoload_names_loc; i < sc->autoload_names_top; i++)
+ {
+ sc->autoload_names[i] = NULL;
+ sc->autoload_names_sizes[i] = 0;
+ sc->autoloaded_already[i] = NULL;
+ }
+ }
+ }
- BACRO:
- /* load up the current args into the ((args) (lambda)) layout [via the current environment] */
+ sc->autoload_names[sc->autoload_names_loc] = names;
+ sc->autoload_names_sizes[sc->autoload_names_loc] = size;
+ sc->autoloaded_already[sc->autoload_names_loc] = (bool *)calloc(size, sizeof(bool));
+ sc->autoload_names_loc++;
+}
- /* (defmacro hi (a b) `(+ ,a ,b)) */
- /* -> code: #<macro>, args: ((hi 2 3)), closure args: (defmac-9) */
- /* then back again: code: #<closure>, args: (2 3), closure args: (a b) */
- /* (define (hi a b) (+ a b))
- * (hi 1 2)
- * sc->args: (1 2)
- */
+static const char *find_autoload_name(s7_scheme *sc, s7_pointer symbol, bool *already_loaded, bool loading)
+{
+ int l = 0, pos = -1, lib, libs;
+ const char *name, *this_name;
- /* although not the normal entry path, it is possible to apply a macro:
- *
- * (define-macro (hi a) `(+ ,a 1))
- * (apply hi '(4))
- * 5
- *
- * (let ((x 32)) (define-macro* (mac (a (let () (display x) 3))) `(+ 1 ,a)) (let ((x 4)) (mac x)))
- * displays 32, returns 5, so the evaluation of the default value happens in the definition environment
- * (let ((x 32)) (define* (mac (a (let () (display x) 3))) (+ 1 a)) (let ((x 4)) (mac x)))
- * is the same
- * (let ((x 32)) (define-bacro* (mac (a (let () (display x) 3))) `(+ 1 ,a)) (let ((x 4)) (mac x)))
- * displays 4 and returns 5
- *
- * so... we need a way to get the call environment from within either a macro or a function
- */
+ name = symbol_name(symbol);
+ libs = sc->autoload_names_loc;
- /* (let* ((mac (let () (define-macro (mac1 a) `(+ ,a 1)) mac1)) (lst (list 1))) (set-cdr! lst lst) (apply mac lst ()))
- * hangs -- this is equivalent to (eval <circular-list>) which also hangs.
- */
+ for (lib = 0; lib < libs; lib++)
+ {
+ const char **names;
+ int u;
+ u = sc->autoload_names_sizes[lib] - 1;
+ names = sc->autoload_names[lib];
- for (sc->x = closure_args(sc->code), sc->y = sc->args; is_pair(sc->x); sc->x = cdr(sc->x), sc->y = cdr(sc->y))
+ while (true)
+ {
+ int comp;
+ if (u < l) break;
+ pos = (l + u) / 2;
+ this_name = names[pos * 2];
+ comp = strcmp(this_name, name);
+ if (comp == 0)
{
- if (sc->y == sc->NIL)
- return(s7_error(sc,
- sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->NOT_ENOUGH_ARGUMENTS, closure_name(sc, sc->code), sc->args)));
-#if HAVE_PTHREADS
- add_to_local_environment(sc, car(sc->x), car(sc->y));
- /* if the expansion (below) is not thread-safe, neither is this, but at least the trouble stays local to the function */
-#else
-
- {
- /* expand add_to_local_environment(sc, car(sc->x), car(sc->y)); -- (sc variable value)
- * ugly, but this is the principal call and the "inline" attribute is much slower
- */
- s7_pointer x, y, z;
+ *already_loaded = sc->autoloaded_already[lib][pos];
+ if (loading) sc->autoloaded_already[lib][pos] = true;
+ return(names[pos * 2 + 1]); /* file name given func name */
+ }
+ if (comp < 0)
+ l = pos + 1;
+ else u = pos - 1;
+ }
+ }
+ return(NULL);
+}
- z = car(sc->x);
- if (is_immutable_or_accessed(z))
- {
- if (is_immutable(z))
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_2(sc, make_protected_string(sc, "can't bind an immutable object: ~S"), z)));
- car(sc->y) = call_symbol_bind(sc, z, car(sc->y));
- }
- NEW_CELL(sc, y);
- car(y) = z;
- cdr(y) = car(sc->y);
- set_type(y, T_PAIR | T_IMMUTABLE | T_DONT_COPY | T_STRUCTURE);
+s7_pointer s7_autoload(s7_scheme *sc, s7_pointer symbol, s7_pointer file_or_function)
+{
+ /* add '(symbol . file) to s7's autoload table */
+ if (is_null(sc->autoload_table))
+ sc->autoload_table = s7_make_hash_table(sc, sc->default_hash_table_length);
+ s7_hash_table_set(sc, sc->autoload_table, symbol, file_or_function);
+ return(file_or_function);
+}
- NEW_CELL(sc, x);
- car(x) = y;
- cdr(x) = car(sc->envir);
- set_type(x, T_PAIR | T_STRUCTURE);
- car(sc->envir) = x;
- set_local(z);
- }
-#endif
- }
-
- if (sc->x == sc->NIL)
- {
- if (sc->y != sc->NIL)
- return(s7_error(sc,
- sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->TOO_MANY_ARGUMENTS, closure_name(sc, sc->code), sc->args)));
- }
- else add_to_local_environment(sc, sc->x, sc->y); /* the rest arg I think */
+static s7_pointer g_autoload(s7_scheme *sc, s7_pointer args)
+{
+ #define H_autoload "(autoload symbol file-or-function) adds the symbol to its table of autoloadable symbols. \
+If that symbol is encountered as an unbound variable, s7 either loads the file (following *load-path*), or calls \
+the function. The function takes one argument, the calling environment. Presumably the symbol is defined \
+in the file, or by the function."
+ #define Q_autoload s7_make_signature(sc, 3, sc->T, sc->IS_SYMBOL, sc->T)
- sc->code = closure_body(sc->code);
- goto BEGIN;
-
- case T_CLOSURE_STAR: /* -------- define* (lambda*) -------- */
- {
- lstar_err_t err;
- if (sc->stack_end >= sc->stack_resize_trigger)
- increase_stack_size(sc);
+ s7_pointer sym, value;
- sc->envir = new_frame_in_env(sc, closure_environment(sc->code));
- err = prepare_closure_star(sc);
+ sym = car(args);
+ if (is_string(sym))
+ {
+ if (string_length(sym) == 0) /* (autoload "" ...) */
+ return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a symbol-name or a symbol"));
+ sym = make_symbol_with_length(sc, string_value(sym), string_length(sym));
+ }
+ if (!is_symbol(sym))
+ {
+ check_method(sc, sym, sc->AUTOLOAD, args);
+ return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a string (symbol-name) or a symbol"));
+ }
+ if (is_keyword(sym))
+ return(s7_wrong_type_arg_error(sc, "autoload", 1, sym, "a normal symbol (a keyword is never unbound)"));
- switch (err)
- {
- case LSTAR_OK:
- break;
+ value = cadr(args);
+ if (is_string(value))
+ return(s7_autoload(sc, sym, value));
+ if (((is_closure(value)) || (is_closure_star(value))) &&
+ (s7_is_aritable(sc, value, 1)))
+ return(s7_autoload(sc, sym, value));
- case LSTAR_TOO_MANY_ARGS:
- return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, sc->TOO_MANY_ARGUMENTS, closure_name(sc, sc->code), sc->args)));
-
- case LSTAR_NO_SUCH_KEY:
- /* this is a problem. If we're using keywords to pass choices (:all etc),
- * this error check mistakes a datum for an incorrect parameter name.
- * If we add :allow-other-keys, then we can't tell when it is actually
- * an "other key" (hence skip the next arg), and when it is a key passed
- * as the actual argument. I guess since keywords exist only to name
- * function parameters, we should not use them as symbols -- this way
- * of doing things goes back to CL where the package names were a real
- * annoyance.
- */
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_4(sc,
- make_protected_string(sc, "~A: unknown key: ~A in ~A"),
- closure_name(sc, sc->code), sc->y, sc->args)));
-
- case LSTAR_ALREADY_SET:
- return(s7_error(sc, sc->WRONG_TYPE_ARG,
- make_list_4(sc,
- make_protected_string(sc, "~A: parameter set twice, ~A in ~A"),
- closure_name(sc, sc->code), sc->y, sc->args)));
- }
+ check_method(sc, value, sc->AUTOLOAD, args);
+ return(s7_wrong_type_arg_error(sc, "autoload", 2, value, "a string (file-name) or a thunk"));
+}
- /* evaluate the function body */
- sc->code = closure_body(sc->code);
- goto BEGIN;
- }
-
- case T_CONTINUATION: /* -------- continuation ("call-with-current-continuation") -------- */
- call_with_current_continuation(sc);
- goto START;
- case T_GOTO: /* -------- goto ("call-with-exit") -------- */
- call_with_exit(sc);
- goto START;
+static s7_pointer g_autoloader(s7_scheme *sc, s7_pointer args)
+{
+ #define H_autoloader "(*autoload* sym) returns the autoload info for the symbol sym, or #f."
+ #define Q_autoloader s7_make_signature(sc, 2, sc->T, sc->IS_SYMBOL)
+ s7_pointer sym;
- case T_HOOK: /* -------- hook -------- */
- if (is_pair(hook_functions(sc->code)))
- {
- sc->code = hook_functions(sc->code);
- push_stack(sc, opcode(OP_HOOK_APPLY), sc->args, cdr(sc->code));
- sc->code = car(sc->code);
- goto APPLY;
- }
- else sc->value = sc->UNSPECIFIED;
- goto START;
+ sym = car(args);
+ if (!is_symbol(sym))
+ {
+ check_method(sc, sym, sc->AUTOLOADER, args);
+ return(s7_wrong_type_arg_error(sc, "*autoload*", 1, sym, "a symbol"));
+ }
+ if (sc->autoload_names)
+ {
+ const char *file;
+ bool loaded = false;
+ file = find_autoload_name(sc, sym, &loaded, false);
+ if (file)
+ return(s7_make_string(sc, file));
+ }
+ if (is_hash_table(sc->autoload_table))
+ return(s7_hash_table_ref(sc, sc->autoload_table, sym));
- case T_S_OBJECT: /* -------- applicable s(cheme) object -------- */
- {
- int tag;
- tag = s_object_type(sc->code);
- if (object_types[tag].apply)
- {
- s_type_t *obj;
- obj = (s_type_t *)s7_object_value(sc->code);
- sc->code = object_types[tag].getter_func;
- sc->args = s7_cons(sc, obj->value, sc->args);
- goto APPLY;
- }
- return(apply_error(sc, sc->code, sc->args));
- }
-
- case T_C_OBJECT: /* -------- applicable c object -------- */
- sc ->value = apply_object(sc, sc->code, sc->args);
- if (sc->stack_end > sc->stack_start)
- pop_stack(sc);
- goto START_WITHOUT_POP_STACK;
-
- case T_VECTOR: /* -------- vector as applicable object -------- */
- /* sc->code is the vector, sc->args is the list of dimensions */
- if (sc->args == sc->NIL) /* (#2d((1 2) (3 4))) */
- return(s7_wrong_number_of_args_error(sc, "not enough args for vector-ref: ~A", sc->args));
-
- sc->value = vector_ref_1(sc, sc->code, sc->args);
- goto START;
+ return(sc->F);
+}
- case T_STRING: /* -------- string as applicable object -------- */
- if (sc->args == sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "not enough args for string-ref (via string as applicable object): ~A", sc->args));
- if (cdr(sc->args) != sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "too many args for string-ref (via string as applicable object): ~A", sc->args));
- sc->value = string_ref_1(sc, sc->code, car(sc->args));
- goto START;
+static s7_pointer g_require(s7_scheme *sc, s7_pointer args)
+{
+ #define H_require "(require . symbols) loads each file associated with each symbol if it has not been loaded already.\
+The symbols refer to the argument to \"provide\"."
+ #define Q_require s7_make_circular_signature(sc, 1, 2, sc->T, sc->IS_SYMBOL)
- case T_PAIR: /* -------- list as applicable object -------- */
- if (is_multiple_value(sc->code)) /* ((values 1 2 3) 0) */
+ s7_pointer p;
+ sc->temp5 = cons(sc, args, sc->temp5);
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ if (is_symbol(car(p)))
+ {
+ if (!is_slot(find_symbol(sc, car(p))))
{
- /* car of values can be anything, so conjure up a new expression, and apply again */
- sc->x = multiple_value(sc->code); /* ((values + 1 2) 3) */
- sc->code = car(sc->x);
- sc->args = s7_append(sc, cdr(sc->x), sc->args);
- sc->x = sc->NIL;
- goto APPLY;
+ s7_pointer f;
+ f = g_autoloader(sc, p);
+ if (is_string(f))
+ s7_load_1(sc, string_value(f), sc->envir);
+ else
+ {
+ sc->temp5 = sc->NIL;
+ return(s7_error(sc, make_symbol(sc, "autoload-error"),
+ set_elist_2(sc, make_string_wrapper(sc, "require: no autoload info for ~S"), car(p))));
+ }
}
- if (sc->args == sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "not enough args for list-ref (via list as applicable object): ~A", sc->args));
+ }
+ else
+ {
+ sc->temp5 = sc->NIL;
+ if ((is_pair(car(p))) && (caar(p) == sc->QUOTE))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "require: don't quote ~S"), car(p))));
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "require: ~S is not a symbol"), car(p))));
+ }
+ }
+ sc->temp5 = cdr(sc->temp5);
+ return(sc->T);
+}
- if (cdr(sc->args) == sc->NIL)
- sc->value = list_ref_1(sc, sc->code, car(sc->args)); /* (L 1) */
- else sc->value = g_list_ref(sc, s7_cons(sc, sc->code, sc->args)); /* (L 1 2) */
- goto START;
- case T_HASH_TABLE: /* -------- hash-table as applicable object -------- */
- if (sc->args == sc->NIL)
- return(s7_wrong_number_of_args_error(sc, "not enough args for hash-table-ref (via hash table as applicable object): ~A", sc->args));
+/* -------------------------------- eval-string -------------------------------- */
- if (cdr(sc->args) == sc->NIL)
- sc->value = s7_hash_table_ref(sc, sc->code, car(sc->args));
- else sc->value = g_hash_table_ref(sc, s7_cons(sc, sc->code, sc->args));
- goto START;
+static s7_pointer eval_string_1(s7_scheme *sc, const char *str)
+{
+ s7_pointer port;
- case T_SYMBOL: /* -------- syntactic keyword as applicable object -------- */
- if (is_syntax(sc->code)) /* (apply begin '((define x 3) (+ x 2))) */
- {
- sc->op = (opcode_t)syntax_opcode(sc->code);
- sc->code = sc->args;
- goto START_WITHOUT_POP_STACK;
- /* this was:
- * sc->code = s7_cons(sc, sc->code, sc->args); goto EVAL;
- * but that merely leads to the code above, I think.
- */
+ port = s7_open_input_string(sc, str);
+ push_input_port(sc, port);
- }
- /* else fall through */
+ push_stack(sc, OP_BARRIER, port, sc->NIL);
+ /* we're being called directly from C here, not as part of a scheme program.
+ * Use this op to protect the port, I guess.
+ */
+ push_stack(sc, OP_EVAL_STRING, sc->args, sc->code);
+ /* eval-string is not tail-recursive because it pushes markers in eval to catch
+ * multiple statements in one eval-string call.
+ */
+ eval(sc, OP_READ_INTERNAL);
- default:
- return(apply_error(sc, sc->code, sc->args));
- }
- /* ---------------- end OP_APPLY ---------------- */
+ pop_input_port(sc);
+ s7_close_input_port(sc, port);
+ if (is_multiple_value(sc->value)) /* (+ 1 (eval-string "(values 2 3)")) */
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
-
- case OP_EVAL_MACRO: /* after (scheme-side) macroexpansion, evaluate the resulting expression */
- /*
- * (define-macro (hi a) `(+ ,a 1))
- * (hi 2)
- * here with value: (+ 2 1)
- */
- sc->code = sc->value;
- goto EVAL;
+ return(sc->value);
+}
- case OP_LAMBDA:
- /* this includes unevaluated symbols (direct symbol table refs) in macro arg list */
- if ((!is_pair(sc->code)) ||
- (!is_pair(cdr(sc->code)))) /* (lambda) or (lambda #f) or (lambda . 1) */
- return(eval_error(sc, "lambda: no args or no body? ~A", sc->code));
+s7_pointer s7_eval_c_string_with_environment(s7_scheme *sc, const char *str, s7_pointer e)
+{
+ bool old_longjmp;
+ s7_pointer port, old_envir;
+ /* this can be called recursively via s7_call */
- if (!s7_is_list(sc, car(sc->code)))
- {
- if (s7_is_constant(car(sc->code))) /* (lambda :a ...) */
- return(eval_error(sc, "lambda parameter '~S is a constant", car(sc->code))); /* not ~A here, (lambda #\null do) for example */
+ sc->v = sc->envir; /* old envir needs GC protection even given the push_stack below */
+ old_envir = sc->envir;
+ sc->envir = e;
+ if (sc->longjmp_ok)
+ {
+ s7_pointer result;
+ result = eval_string_1(sc, str);
+ sc->envir = old_envir;
+ return(result);
+ }
- /* we currently accept (lambda i i . i) (lambda quote i) (lambda : : . #()) (lambda : 1 . "")
- * at this level, but when the lambda form is evaluated, it will trigger an error.
- */
- }
- else
- {
- for (sc->x = car(sc->code); is_pair(sc->x); sc->x = cdr(sc->x))
- {
- if (s7_is_constant(car(sc->x))) /* (lambda (pi) pi) */
- return(eval_error(sc, "lambda parameter '~S is a constant", car(sc->x)));
- if (symbol_is_in_list(car(sc->x), cdr(sc->x))) /* (lambda (a a) ...) or (lambda (a . a) ...) */
- return(eval_error(sc, "lambda parameter '~S is used twice in the parameter list", car(sc->x)));
- }
- if ((sc->x != sc->NIL) &&
- (s7_is_constant(sc->x))) /* (lambda (a . 0.0) a) or (lambda (a . :b) a) */
- return(eval_error(sc, "lambda :rest parameter '~A is a constant", sc->x));
- }
+ stack_reset(sc);
+ push_stack(sc, OP_EVAL_STRING, old_envir, sc->NIL); /* GC protect envir */
- /* sc->value = make_closure(sc, sc->code, sc->envir, T_CLOSURE); */
- /* optimize that since it happens a bazillion times */
+ port = s7_open_input_string(sc, str);
+ push_input_port(sc, port);
- NEW_CELL(sc, sc->value);
- car(sc->value) = sc->code;
- cdr(sc->value) = sc->envir;
- set_type(sc->value, T_CLOSURE | T_PROCEDURE | T_DONT_COPY_CDR | T_DONT_COPY);
+ old_longjmp = sc->longjmp_ok;
+ if (!sc->longjmp_ok)
+ {
+ sc->longjmp_ok = true;
+ if (setjmp(sc->goto_start) != 0)
+ eval(sc, sc->op);
+ else eval(sc, OP_READ_INTERNAL);
+ }
- goto START;
+ sc->longjmp_ok = old_longjmp;
+ pop_input_port(sc);
+ s7_close_input_port(sc, port);
+ sc->envir = old_envir;
+ return(sc->value);
+}
- case OP_LAMBDA_STAR:
- if ((!is_pair(sc->code)) ||
- (!is_pair(cdr(sc->code)))) /* (lambda*) or (lambda* #f) */
- return(eval_error(sc, "lambda*: no args or no body? ~A", sc->code));
+s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str)
+{
+ return(s7_eval_c_string_with_environment(sc, str, sc->NIL));
+}
- if (!s7_is_list(sc, car(sc->code)))
- {
- if (s7_is_constant(car(sc->code))) /* (lambda* :a ...) */
- return(eval_error(sc, "lambda* parameter '~A is a constant", car(sc->code)));
- }
- else
- {
- for (sc->w = car(sc->code); is_pair(sc->w); sc->w = cdr(sc->w))
- {
- if (is_pair(car(sc->w)))
- {
- if (s7_is_constant(caar(sc->w))) /* (lambda* ((:a 1)) ...) */
- return(eval_error(sc, "lambda* parameter '~A is a constant", caar(sc->w)));
- if (symbol_is_in_list(caar(sc->w), cdr(sc->w))) /* (lambda* ((a 1) a) ...) */
- return(eval_error(sc, "lambda* parameter '~A is used twice in the argument list", caar(sc->w)));
- if (!is_pair(cdar(sc->w))) /* (lambda* ((a . 0.0)) a) */
- {
- if (cdar(sc->w) == sc->NIL) /* (lambda* ((a)) ...) */
- return(eval_error(sc, "lambda* parameter default value missing? '~A", car(sc->w)));
- return(eval_error(sc, "lambda* parameter is a dotted pair? '~A", car(sc->w)));
- }
- if (cddar(sc->w) != sc->NIL) /* (lambda* ((a 0.0 "hi")) a) */
- return(eval_error(sc, "lambda* parameter has multiple default values? '~A", car(sc->w)));
- }
- else
- {
- if (car(sc->w) != sc->KEY_REST)
- {
- if ((s7_is_constant(car(sc->w))) &&
- (car(sc->w) != sc->KEY_KEY) &&
- (car(sc->w) != sc->KEY_OPTIONAL) &&
- (car(sc->w) != sc->KEY_ALLOW_OTHER_KEYS)) /* (lambda* (pi) ...) */
- return(eval_error(sc, "lambda* parameter '~A is a constant", car(sc->w)));
- if (symbol_is_in_list(car(sc->w), cdr(sc->w))) /* (lambda* (a a) ...) or (lambda* (a . a) ...) */
- return(eval_error(sc, "lambda* parameter '~A is used twice in the argument list", car(sc->w)));
-
- if ((car(sc->w) == sc->KEY_ALLOW_OTHER_KEYS) && /* (lambda* (:allow-other-keys x) x) */
- (cdr(sc->w) != sc->NIL))
- eval_error(sc, ":allow-other-keys should be the last parameter: ~A", car(sc->code));
- }
- else
- {
- if (!is_pair(cdr(sc->w))) /* (lambda* (:rest) ...) */
- return(eval_error(sc, "lambda* :rest parameter missing? ~A", sc->w));
- if (!s7_is_symbol(cadr(sc->w))) /* (lambda* (:rest (a 1)) ...) */
- {
- if (!is_pair(cadr(sc->w))) /* (lambda* (:rest 1) ...) */
- return(eval_error(sc, "lambda* :rest parameter is not a symbol? ~A", sc->w));
- return(eval_error(sc, "lambda* :rest parameter can't have a default value. ~A", sc->w));
- }
- }
- }
- }
- if ((sc->w != sc->NIL) &&
- (s7_is_constant(sc->w))) /* (lambda* (a . 0.0) a) or (lambda* (a . :b) a) */
- return(eval_error(sc, "lambda* :rest parameter '~A is a constant", sc->w));
- }
+static s7_pointer g_eval_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_eval_string "(eval-string str (env (curlet))) returns the result of evaluating the string str as Scheme code"
+ #define Q_eval_string s7_make_signature(sc, 3, sc->VALUES, sc->IS_STRING, sc->IS_LET)
+ s7_pointer port, str;
- sc->value = make_closure(sc, sc->code, sc->envir, T_CLOSURE_STAR);
- goto START;
-
-
- case OP_QUOTE:
- if (!is_pair(sc->code)) /* (quote . -1) */
- {
- if (sc->code == sc->NIL)
- return(eval_error(sc, "quote: not enough arguments: ~A", sc->code));
- return(eval_error(sc, "quote: stray dot?: ~A", sc->code));
- }
- if (cdr(sc->code) != sc->NIL) /* (quote . (1 2)) or (quote 1 1) */
- return(eval_error(sc, "quote: too many arguments ~A", sc->code));
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->EVAL_STRING, args, T_STRING, 1);
- sc->value = car(sc->code);
- goto START;
+ if (is_not_null(cdr(args)))
+ {
+ s7_pointer e;
+ e = cadr(args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->EVAL_STRING, 2, e, A_LET));
+ if (e == sc->rootlet)
+ sc->envir = sc->NIL;
+ else sc->envir = e;
+ }
-
- case OP_DEFINE_CONSTANT1:
- /* define-constant -> OP_DEFINE_CONSTANT -> OP_DEFINE..1, then back to here */
- /* at this point, sc->value is the symbol that we want to be immutable, sc->code is the original pair */
+ port = open_and_protect_input_string(sc, str);
+ push_input_port(sc, port);
- sc->x = find_local_symbol(sc, sc->envir, sc->value);
- set_immutable(car(sc->x));
- goto START;
+ sc->temp3 = sc->args;
+ push_stack(sc, OP_EVAL_STRING_1, args, sc->code);
+ push_stack(sc, OP_READ_INTERNAL, sc->NIL, sc->NIL);
+ return(sc->F);
+}
- case OP_DEFINE_CONSTANT:
- push_stack(sc, opcode(OP_DEFINE_CONSTANT1), sc->NIL, sc->code);
+static s7_pointer eval_string_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ check_for_substring_temp(sc, expr);
+ return(f);
+}
-
- case OP_DEFINE_STAR:
- case OP_DEFINE:
- if (!is_pair(sc->code))
- return(eval_error_with_name(sc, "~A: nothing to define? ~A", sc->code)); /* (define) */
- if (!is_pair(cdr(sc->code)))
- return(eval_error_with_name(sc, "~A: no value? ~A", sc->code)); /* (define var) */
+static s7_pointer call_with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
+{
+ s7_pointer p;
+ p = cadr(args);
+ port_original_input_string(port) = car(args);
+ push_stack(sc, OP_UNWIND_INPUT, sc->input_port, port);
+ push_stack(sc, OP_APPLY, list_1(sc, port), p);
+ return(sc->F);
+}
- if ((!is_pair(car(sc->code))) &&
- (cddr(sc->code) != sc->NIL)) /* (define var 1 . 2) */
- return(eval_error_with_name(sc, "~A: more than 1 value? ~A", sc->code)); /* (define var 1 2) */
- /* parameter error checks are handled by lambda/lambda* (see OP_LAMBDA above) */
- if (is_pair(car(sc->code)))
- {
- sc->x = caar(sc->code);
- if (sc->op == OP_DEFINE_STAR)
- sc->code = s7_cons(sc, sc->LAMBDA_STAR, s7_cons(sc, cdar(sc->code), cdr(sc->code)));
- else sc->code = s7_cons(sc, sc->LAMBDA, s7_cons(sc, cdar(sc->code), cdr(sc->code)));
- }
- else
- {
- sc->x = car(sc->code);
- sc->code = cadr(sc->code);
- }
+/* -------------------------------- call-with-input-string -------------------------------- */
- if (!s7_is_symbol(sc->x)) /* (define (3 a) a) */
- return(eval_error_with_name(sc, "~A: define a non-symbol? ~S", sc->x));
- if (is_keyword(sc->x)) /* (define :hi 1) */
- return(eval_error_with_name(sc, "~A ~A: keywords are constants", sc->x));
+static s7_pointer g_call_with_input_string(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer str, proc;
+ #define H_call_with_input_string "(call-with-input-string str proc) opens a string port for str and applies proc to it"
+ #define Q_call_with_input_string pl_sf
+ /* (call-with-input-string "44" (lambda (p) (+ 1 (read p)))) -> 45 */
- /* (define ((f a) b) (* a b)) -> (define f (lambda (a) (lambda (b) (* a b)))) */
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->CALL_WITH_INPUT_STRING, args, T_STRING, 1);
- push_stack(sc, opcode(OP_DEFINE1), sc->NIL, sc->x);
- sc->x = sc->NIL;
- goto EVAL;
-
-
- case OP_DEFINE1:
- /* sc->code is the symbol being defined, sc->value is its value
- * if sc->value is a closure, car is of the form ((args...) body...)
- * so the doc string if any is (cadr (car value))
- * and the arg list gives the number of optional args up to the dot
- */
+ proc = cadr(args);
+ if (is_let(proc))
+ check_method(sc, proc, sc->CALL_WITH_INPUT_STRING, args);
- /* it's not possible to expand and replace macros at this point without evaluating
- * the body. Just as examples, say we have a macro "mac",
- * (define (hi) (call/cc (lambda (mac) (mac 1))))
- * (define (hi) (quote (mac 1))) or macroexpand etc
- * (define (hi mac) (mac 1)) assuming mac here is a function passed as an arg,
- * etc...
- */
+ if (!s7_is_aritable(sc, proc, 1))
+ return(wrong_type_argument_with_type(sc, sc->CALL_WITH_INPUT_STRING, 2, proc,
+ make_string_wrapper(sc, "a procedure of one argument (the port)")));
- /* if we're defining a function, add its symbol to the new function's environment under the name __func__ */
+ if ((is_continuation(proc)) || (is_goto(proc)))
+ return(wrong_type_argument_with_type(sc, sc->CALL_WITH_INPUT_STRING, 2, proc, A_NORMAL_PROCEDURE));
- /* the immutable constant check needs to wait until we have the actual new value because
- * we want to ignore the rebinding (not raise an error) if it is the existing value.
- * This happens when we reload a file that has a define-constant call.
- */
- if (is_immutable_or_accessed(sc->code))
- {
- if (is_immutable(sc->code)) /* (define pi 3) or (define (pi a) a) */
- {
- s7_pointer x;
- x = find_symbol(sc, sc->envir, sc->code);
- if (!(s7_is_equal(sc, sc->value, cdr(x)))) /* if value is unchanged, just ignore this definition */
- return(eval_error_with_name(sc, "~A: ~S is immutable", sc->code));
- }
- sc->value = call_symbol_bind(sc, sc->code, sc->value);
- }
+ return(call_with_input(sc, open_and_protect_input_string(sc, str), args));
+}
- if ((is_closure(sc->value)) ||
- (is_closure_star(sc->value)))
- {
- if ((port_filename(sc->input_port)) && /* add (__func__ (name file line)) to current env */
- (port_file(sc->input_port) != stdin))
- sc->x = immutable_cons(sc,
- sc->__FUNC__,
- make_list_3(sc, sc->code,
- file_names[port_file_number(sc->input_port)],
- s7_make_integer(sc, port_line_number(sc->input_port))));
- else sc->x = immutable_cons(sc, sc->__FUNC__, sc->code); /* fallback on (__func__ name) */
- closure_environment(sc->value) = s7_cons(sc,
- make_list_1(sc, sc->x),
- closure_environment(sc->value));
- typeflag(closure_environment(sc->value)) |= T_ENVIRONMENT;
- }
- else
- {
- if (s7_is_procedure_with_setter(sc->value))
- {
- s7_pws_t *f = (s7_pws_t *)s7_object_value(sc->value);
- f->name = copy_string(symbol_name(sc->code));
- }
- }
+static s7_pointer c_call_with_input_string(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_call_with_input_string(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(call_with_input_string, c_call_with_input_string)
- /* add the newly defined thing to the current environment */
- sc->x = find_local_symbol(sc, sc->envir, sc->code);
- if (sc->x != sc->NIL)
- set_symbol_value(sc->x, sc->value);
- else add_to_current_environment(sc, sc->code, sc->value);
- sc->value = sc->code;
- sc->x = sc->NIL;
- goto START;
-
-
- case OP_SET2:
- if (is_pair(sc->value))
- {
- /* (let ((L '((1 2 3)))) (set! ((L 0) 1) 32) L)
- * (let ((L '(((1 2 3))))) (set! ((L 0) 0 1) 32) L)
- * any deeper nesting was handled already by the first eval:
- * set! looks at its first argument, if it's a symbol, it sets the associated value,
- * if it's a list, it looks at the car of that list to decide which setter to call,
- * if it's a list of lists, it passes the embedded lists to eval, then looks at the
- * car of the result. This means that we can do crazy things like:
- * (let ((x '(1)) (y '(2))) (set! ((if #t x y) 0) 32) x)
- *
- * the other args need to be evaluated (but not the list as if it were code):
- * (let ((L '((1 2 3))) (index 1)) (set! ((L 0) index) 32) L)
- */
+/* -------------------------------- call-with-input-file -------------------------------- */
- if (!is_proper_list(sc, sc->args)) /* (set! ('(1 2) 1 . 2) 1) */
- eval_error(sc, "set! target arguments are an improper list: ~A", sc->args);
+static s7_pointer g_call_with_input_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_call_with_input_file "(call-with-input-file filename proc) opens filename and calls proc with the input port as its argument"
+ #define Q_call_with_input_file pl_sf
+ s7_pointer str, proc;
- /* in all of these cases, we might need to GC protect the temporary lists */
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->CALL_WITH_INPUT_FILE, args, T_STRING, 1);
- if (is_multiple_value(sc->value))
- {
- sc->code = s7_cons(sc, sc->SET, s7_append(sc, multiple_value(sc->value), s7_append(sc, sc->args, sc->code)));
- sc->op = OP_SET;
- goto START_WITHOUT_POP_STACK;
- }
+ proc = cadr(args);
+ if (!s7_is_aritable(sc, proc, 1))
+ return(wrong_type_argument_with_type(sc, sc->CALL_WITH_INPUT_FILE, 2, proc,
+ make_string_wrapper(sc, "a procedure of one argument (the port)")));
+ if ((is_continuation(proc)) || (is_goto(proc)))
+ return(wrong_type_argument_with_type(sc, sc->CALL_WITH_INPUT_FILE, 2, proc, A_NORMAL_PROCEDURE));
- /* old form:
- * sc->code = s7_cons(sc, sc->LIST_SET, s7_cons(sc, make_list_2(sc, sc->QUOTE, sc->value), s7_append(sc, sc->args, sc->code)));
- */
+ return(call_with_input(sc, open_input_file_1(sc, string_value(str), "r", "call-with-input-file"), args));
+}
- push_stack(sc, opcode(OP_EVAL_ARGS1), make_list_2(sc, sc->value, sc->LIST_SET), s7_append(sc, cdr(sc->args), sc->code));
- sc->code = car(sc->args);
- goto EVAL;
+static s7_pointer c_call_with_input_file(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_call_with_input_file(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(call_with_input_file, c_call_with_input_file)
- /* timings: old 3.25, new 2.34 (1.93 direct)
- * (time (let ((L '((1 2 3)))) (do ((i 0 (+ i 1))) ((= i 10000000)) (set! ((L 0) 1) i)) L))
- */
- }
- if (s7_is_vector(sc->value))
- {
- /* old form:
- * sc->code = s7_cons(sc, sc->VECTOR_SET, s7_cons(sc, sc->value, s7_append(sc, sc->args, sc->code)));
- * [vector arg (sc->value) doesn't need to be quoted since eval won't treat it as code]
- */
- push_stack(sc, opcode(OP_EVAL_ARGS1), make_list_2(sc, sc->value, sc->VECTOR_SET), s7_append(sc, cdr(sc->args), sc->code));
- sc->code = car(sc->args);
- goto EVAL;
- }
+static s7_pointer with_input(s7_scheme *sc, s7_pointer port, s7_pointer args)
+{
+ s7_pointer old_input_port, p;
+ old_input_port = sc->input_port;
+ sc->input_port = port;
+ port_original_input_string(port) = car(args);
+ push_stack(sc, OP_UNWIND_INPUT, old_input_port, port);
+ p = cadr(args);
+ push_stack(sc, OP_APPLY, sc->NIL, p);
+ return(sc->F);
+}
- sc->code = s7_cons(sc, s7_cons(sc, sc->value, sc->args), sc->code);
+/* -------------------------------- with-input-from-string -------------------------------- */
- case OP_SET: /* entry for set! */
- if (!is_pair(sc->code))
- {
- if (sc->code == sc->NIL) /* (set!) */
- return(eval_error(sc, "set!: not enough arguments: ~A", sc->code));
- return(eval_error(sc, "set!: stray dot? ~A", sc->code)); /* (set! . 1) */
- }
- if (!is_pair(cdr(sc->code)))
- {
- if (cdr(sc->code) == sc->NIL) /* (set! var) */
- return(eval_error(sc, "set!: not enough arguments: ~A", sc->code));
- return(eval_error(sc, "set!: stray dot? ~A", sc->code)); /* (set! var . 1) */
- }
- if (cddr(sc->code) != sc->NIL) /* (set! var 1 2) */
- return(eval_error(sc, "~A: too many arguments to set!", sc->code));
-
- /* cadr (the value) has not yet been evaluated */
+static s7_pointer g_with_input_from_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_with_input_from_string "(with-input-from-string str thunk) opens str as the temporary current-input-port and calls thunk"
+ #define Q_with_input_from_string pl_sf
+ s7_pointer str;
- if (is_immutable(car(sc->code))) /* (set! pi 3) */
- return(eval_error(sc, "set!: can't alter immutable object: ~S", car(sc->code)));
-
- if (is_pair(car(sc->code))) /* has accessor */
- {
- if (is_pair(caar(sc->code)))
- {
- if ((cdar(sc->code) != sc->NIL) &&
- (!is_pair(cdar(sc->code)))) /* (set! ('(1 2) . 0) 1) */
- eval_error(sc, "improper list of args to set!: ~A", sc->code);
- push_stack(sc, opcode(OP_SET2), cdar(sc->code), cdr(sc->code));
- sc->code = caar(sc->code);
- goto EVAL;
- }
-
- if (s7_is_symbol(caar(sc->code)))
- sc->x = s7_symbol_value(sc, caar(sc->code)); /* this can't be simply symbol_value */
- else sc->x = caar(sc->code); /* might be the pws function itself */
-
- /* code here is the accessor and the value without the "set!": ((window-width) 800) */
- /* (set! (hi 0) (* 2 3)) -> ((hi 0) (* 2 3)) */
+ str = car(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->WITH_INPUT_FROM_STRING, args, T_STRING, 1);
- /* for these kinds of objects, some Schemes restrict set!
- * (list-set! '(1 2 3) 1 32) is accepted but does it make sense?
- * (set-car! '(1 . 2) 32)
- * (string-set! "hiho" 1 #\z)
- * (vector-set! #(1 2 3) 1 32)
- * (let ((x (lambda () "hiho"))) (string-set! (x) 1 #\a))
- * (let ((x (lambda () #(1 2 3)))) (vector-set! (x) 1 32))
- * (let ((str "hiho")) (string-set! str 1 #\x) str)
- * (let ((v #(1 2 3))) (vector-set! v 1 32) v)
- * (let ((x (lambda () "hiho"))) (string-set! (x) 1 #\x) (x))
- *
- * It seems weird that we can reach into both the function body, and its closure:
- * (let ((xx (let ((x '(1 2 3))) (lambda () x)))) (list-set! (xx) 1 32) (xx)) -> '(1 32 3)
- *
- * (let* ((x '(1 2)) (y (list x)) (z (car y))) (list-set! z 1 32) (list x y z))
- * ((1 32) ((1 32)) (1 32))
- *
- * (string-set! (symbol->string 'symbol->string) 1 #\X) -> error currently also in Guile "string is read-only"
- * (setf (elt (symbol-name 'xyz) 1) #\X) -> error in CL "read-only string"
- */
+ if (!is_thunk(sc, cadr(args)))
+ method_or_bust_with_type(sc, cadr(args), sc->WITH_INPUT_FROM_STRING, args, A_THUNK, 2);
- if (!is_proper_list(sc, car(sc->code))) /* (set! ("hi" . 1) #\a) or (set! (#(1 2) . 1) 0) */
- eval_error(sc, "set! target is an improper list: (set! ~A ...)", car(sc->code));
+ /* since the arguments are evaluated before we get here, we can get some confusing situations:
+ * (with-input-from-string "#x2.1" (read))
+ * (read) -> whatever it can get from the current input port!
+ * ";with-input-from-string argument 2, #<eof>, is untyped but should be a thunk"
+ */
+ return(with_input(sc, open_and_protect_input_string(sc, str), args));
+}
- switch (type(sc->x))
- {
- case T_S_OBJECT:
- /* it's tricky to split out this case because we haven't evaluated the args yet, so we check in g_object_set.
- */
- case T_C_OBJECT:
- if (object_set_function(sc->x))
- {
- /* sc->code = s7_cons(sc, sc->OBJECT_SET, s7_append(sc, car(sc->code), cdr(sc->code))); */
- if (is_pair(cdar(sc->code)))
- {
- push_stack(sc, opcode(OP_EVAL_ARGS1), make_list_2(sc, sc->x, sc->OBJECT_SET), s7_append(sc, cddar(sc->code), cdr(sc->code)));
- sc->code = cadar(sc->code);
- }
- else /* (set! (window-width) 800) -> ((window-width) 800) so cdar(sc->code) is nil */
- {
- push_stack(sc, opcode(OP_EVAL_ARGS1), make_list_2(sc, sc->x, sc->OBJECT_SET), cddr(sc->code));
- sc->code = cadr(sc->code);
- }
- }
- /* use set method (append copies/flattens the lists) -- we can't stitch car to cdr here because we're
- * dealing with in-coming code -- set_cdr! will create a circular list.
- */
- else return(eval_error(sc, "no generalized set for ~A", caar(sc->code)));
- break;
+static s7_pointer c_with_input_from_string(s7_scheme *sc, s7_pointer x) {return(g_with_input_from_string(sc, set_plist_1(sc, x)));}
+PF_TO_PF(with_input_from_string, c_with_input_from_string)
- case T_VECTOR:
- /* sc->x is the vector, sc->code is expr without the set! */
- /* args have not been evaluated! */
- /* sc->code = s7_cons(sc, sc->VECTOR_SET, s7_append(sc, car(sc->code), cdr(sc->code))); */
- push_stack(sc, opcode(OP_EVAL_ARGS1), make_list_2(sc, sc->x, sc->VECTOR_SET), s7_append(sc, cddar(sc->code), cdr(sc->code)));
- sc->code = cadar(sc->code);
- break;
-
- case T_STRING:
- /* sc->code = s7_cons(sc, sc->STRING_SET, s7_append(sc, car(sc->code), cdr(sc->code))); */
- push_stack(sc, opcode(OP_EVAL_ARGS1), make_list_2(sc, sc->x, sc->STRING_SET), s7_append(sc, cddar(sc->code), cdr(sc->code)));
- sc->code = cadar(sc->code);
- break;
- case T_PAIR:
- /* code: ((lst 1) 32) from (let ((lst '(1 2 3))) (set! (lst 1) 32))
- * old form:
- * sc->code = s7_cons(sc, sc->LIST_SET, s7_append(sc, car(sc->code), cdr(sc->code)));
- * old: 2.32, new: 1.77 (1.50 direct)
- * (time (let ((lst '(1 2 3))) (do ((i 0 (+ i 1))) ((= i 10000000)) (set! (lst 1) 32))))
- */
- push_stack(sc, opcode(OP_EVAL_ARGS1), make_list_2(sc, sc->x, sc->LIST_SET), s7_append(sc, cddar(sc->code), cdr(sc->code)));
- sc->code = cadar(sc->code);
- break;
+/* -------------------------------- with-input-from-file -------------------------------- */
- case T_HASH_TABLE:
- /* sc->code = s7_cons(sc, sc->HASH_TABLE_SET, s7_append(sc, car(sc->code), cdr(sc->code))); */
- push_stack(sc, opcode(OP_EVAL_ARGS1), make_list_2(sc, sc->x, sc->HASH_TABLE_SET), s7_append(sc, cddar(sc->code), cdr(sc->code)));
- sc->code = cadar(sc->code);
- break;
+static s7_pointer g_with_input_from_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_with_input_from_file "(with-input-from-file filename thunk) opens filename as the temporary current-input-port and calls thunk"
+ #define Q_with_input_from_file pl_sf
- case T_C_OPT_ARGS_FUNCTION:
- case T_C_RST_ARGS_FUNCTION:
- case T_C_ANY_ARGS_FUNCTION: /* (let ((lst (list 1 2))) (set! (list-ref lst 1) 2) lst) */
- case T_C_FUNCTION:
- /* perhaps it has a setter */
-
- if (is_procedure(c_function_setter(sc->x)))
- sc->code = s7_cons(sc, c_function_setter(sc->x), s7_append(sc, cdar(sc->code), cdr(sc->code)));
- else return(eval_error(sc, "no generalized set for ~A", caar(sc->code)));
- break;
+ if (!is_string(car(args)))
+ method_or_bust(sc, car(args), sc->WITH_INPUT_FROM_FILE, args, T_STRING, 1);
- default: /* (set! (1 2) 3) */
- return(eval_error(sc, "no generalized set for ~A", caar(sc->code)));
- }
- }
- else /* thing to be set is not a pair */
- {
- if (!s7_is_symbol(car(sc->code))) /* (set! 12345 1) */
- return(eval_error(sc, "set! can't change ~S", car(sc->code)));
-
- push_stack(sc, opcode(OP_SET1), sc->NIL, car(sc->code));
- sc->code = cadr(sc->code);
- }
- sc->x = sc->NIL;
- goto EVAL;
-
-
- case OP_SET1:
- sc->y = find_symbol(sc, sc->envir, sc->code);
- if (sc->y != sc->NIL)
- {
- if (symbol_accessed(sc->code))
- {
- s7_pointer func;
- func = cadr(csr(sc->y));
- if (is_procedure(func))
- {
- push_stack(sc, opcode(OP_SET_ACCESS), sc->y, make_list_2(sc, sc->code, sc->value));
- sc->args = make_list_2(sc, sc->code, sc->value);
- sc->code = func;
- goto APPLY;
- }
- }
- set_symbol_value(sc->y, sc->value);
- sc->y = sc->NIL;
- goto START;
- }
- /* if unbound variable hook here, we need the binding, not the current value */
+ if (!is_thunk(sc, cadr(args)))
+ method_or_bust_with_type(sc, cadr(args), sc->WITH_INPUT_FROM_FILE, args, A_THUNK, 2);
- if (is_syntax(sc->code))
- return(eval_error(sc, "can't set! ~A", sc->code));
- return(eval_error(sc, "set! ~A: unbound variable", sc->code));
+ return(with_input(sc, open_input_file_1(sc, string_value(car(args)), "r", "with-input-from-file"), args));
+}
-
- case OP_SET_ACCESS:
- /* sc->value is the new value from the set access function, sc->code is the symbol and the original value, sc->args is the binding slot
- */
- if (sc->value == sc->ERROR)
- return(s7_error(sc, sc->ERROR,
- make_list_3(sc, make_protected_string(sc, "can't set! ~S to ~S"), car(sc->code), cadr(sc->code))));
- set_symbol_value(sc->args, sc->value);
- goto START;
+static s7_pointer c_with_input_from_file(s7_scheme *sc, s7_pointer x) {return(g_with_input_from_file(sc, set_plist_1(sc, x)));}
+PF_TO_PF(with_input_from_file, c_with_input_from_file)
- case OP_IF:
- {
- s7_pointer cdr_code;
- if (!is_pair(sc->code)) /* (if) or (if . 1) */
- return(eval_error(sc, "(if): if needs at least 2 expressions: ~A", sc->code));
- cdr_code = cdr(sc->code);
- if (!is_pair(cdr_code)) /* (if 1) */
- return(eval_error(sc, "(if ~A): if needs another clause", car(sc->code)));
-
- if (is_pair(cdr(cdr_code)))
- {
- if (cddr(cdr_code) != sc->NIL) /* (if 1 2 3 4) */
- return(eval_error(sc, "too many clauses for if: ~A", sc->code));
- }
- else
- {
- if (cdr(cdr_code) != sc->NIL) /* (if 1 2 . 3) */
- return(eval_error(sc, "if: ~A has improper list?", sc->code));
- }
-
- push_stack(sc, opcode(OP_IF1), sc->NIL, cdr_code);
- sc->code = car(sc->code);
- goto EVAL;
- }
-
-
- case OP_IF1:
- if (is_true(sc, sc->value))
- sc->code = car(sc->code);
- else
- sc->code = cadr(sc->code); /* as per r5rs spec, (if #f #f) ==> #<unspecified> because car(sc->NIL) = sc->UNSPECIFIED */
- goto EVAL;
-
-
- case OP_LET:
- /* sc->code is everything after the let: (let ((a 1)) a) so sc->code is (((a 1)) a) */
- /* car can be either a list or a symbol ("named let") */
+/* -------------------------------- iterators -------------------------------- */
+
+static s7_pointer g_is_iterator(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_iterator "(iterator? obj) returns #t if obj is an iterator."
+ #define Q_is_iterator pl_bt
+ s7_pointer x;
+
+ x = car(args);
+ if (is_iterator(x)) return(sc->T);
+ check_closure_for(sc, x, sc->IS_ITERATOR);
+ check_boolean_method(sc, is_iterator, sc->IS_ITERATOR, args);
+ return(sc->F);
+}
- if (!is_pair(sc->code)) /* (let . 1) */
- return(eval_error(sc, "let form is an improper list? ~A", sc->code));
- if (cdr(sc->code) == sc->NIL) /* (let) */
- return(eval_error(sc, "let has no variables or body: ~A", sc->code));
+static s7_pointer iterator_copy(s7_scheme *sc, s7_pointer p)
+{
+ /* fields are obj cur [loc|lcur] [len|slow|hcur] next */
+ s7_pointer iter;
+ new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
+ iterator_sequence(iter) = iterator_sequence(p); /* obj */
+ iterator_position(iter) = iterator_position(p); /* loc|lcur (loc is s7_int) */
+ iterator_length(iter) = iterator_length(p); /* len|slow|hcur (len is s7_int) */
+ iterator_current(iter) = iterator_current(p); /* cur */
+ iterator_next(iter) = iterator_next(p); /* next */
+ return(iter);
+}
- if (!is_pair(cdr(sc->code))) /* (let () ) */
- return(eval_error(sc, "let has no body: ~A", sc->code));
-
- if ((!is_pair(car(sc->code))) && /* (let 1 ...) */
- (car(sc->code) != sc->NIL) &&
- (!s7_is_symbol(car(sc->code))))
- return(eval_error(sc, "let variable list is messed up or missing: ~A", sc->code));
-
- /* we accept these (other schemes complain, but I can't see why -- a no-op is the user's business!):
- * (let () (define (hi) (+ 1 2)))
- * (let () (begin (define x 3)))
- * (let () 3 (begin (define x 3)))
- * (let () (define x 3))
- * (let () (if #t (define (x) 3)))
- *
- * similar cases:
- * (case 0 ((0) (define (x) 3) (x)))
- * (cond (0 (define (x) 3) (x)))
- * (and (define (x) x) 1)
- * (begin (define (x y) y) (x (define (x y) y)))
- * (if (define (x) 1) 2 3)
- * (do () ((define (x) 1) (define (y) 2)))
- *
- * but we can get some humorous results:
- * (let ((x (lambda () 3))) (if (define (x) 4) (x) 0)) -> 4
- */
- if ((s7_is_symbol(car(sc->code))) &&
- (((!is_pair(cadr(sc->code))) && /* (let hi #t) */
- (cadr(sc->code) != sc->NIL)) ||
- (cddr(sc->code) == sc->NIL))) /* (let hi ()) */
- return(eval_error(sc, "named let variable list is messed up or missing: ~A", sc->code));
+static s7_pointer iterator_finished(s7_scheme *sc, s7_pointer iterator)
+{
+ return(sc->ITERATOR_END);
+}
- sc->args = sc->NIL;
- sc->value = sc->code;
- sc->code = s7_is_symbol(car(sc->code)) ? cadr(sc->code) : car(sc->code);
- if (sc->code == sc->NIL) /* (let () ...): no bindings, so skip that step */
+static s7_pointer let_iterate(s7_scheme *sc, s7_pointer iterator)
+{
+ s7_pointer slot;
+ slot = iterator_let_current(iterator);
+ if (is_slot(slot))
+ {
+ iterator_let_current(iterator) = next_slot(slot);
+ if (iterator_let_cons(iterator))
{
- sc->code = sc->value;
- goto LET2;
+ s7_pointer p;
+ p = iterator_let_cons(iterator);
+ car(p) = slot_symbol(slot);
+ cdr(p) = slot_value(slot);
+ return(p);
}
+ return(cons(sc, slot_symbol(slot), slot_value(slot)));
+ }
+ iterator_next(iterator) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
-
- case OP_LET1: /* let -- calculate parameters */
- /* sc->args = s7_cons(sc, sc->value, sc->args); */
- {
- s7_pointer x;
- NEW_CELL(sc, x);
- car(x) = sc->value;
- cdr(x) = sc->args;
- set_type(x, T_PAIR | T_STRUCTURE);
- sc->args = x;
- }
-
- if (is_pair(sc->code))
- {
- if (!is_pair(car(sc->code))) /* (let ((x)) ...) or (let ((x 1) . (y 2)) ...) */
- return(eval_error(sc, "let variable declaration, but no value?: ~A", car(sc->code)));
+static s7_pointer rootlet_iterate(s7_scheme *sc, s7_pointer iterator)
+{
+ s7_pointer slot;
+ slot = iterator_current(iterator);
+ if (is_slot(slot))
+ {
+ if (iterator_position(iterator) < sc->rootlet_entries)
+ {
+ iterator_position(iterator)++;
+ iterator_current(iterator) = vector_element(sc->rootlet, iterator_position(iterator));
+ }
+ else iterator_current(iterator) = sc->NIL;
+ return(cons(sc, slot_symbol(slot), slot_value(slot)));
+ }
+ iterator_next(iterator) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- if (!(is_pair(cdar(sc->code)))) /* (let ((x . 1))...) */
- return(eval_error(sc, "let variable declaration is not a proper list?: ~A", car(sc->code)));
+static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator)
+{
+ s7_pointer table;
+ int loc, len;
+ hash_entry_t **elements;
+ hash_entry_t *lst;
- if (cddar(sc->code) != sc->NIL) /* (let ((x 1 2 3)) ...) */
- return(eval_error(sc, "let variable declaration has more than one value?: ~A", car(sc->code)));
+ lst = iterator_hash_current(iterator);
+ if (lst)
+ {
+ iterator_hash_current(iterator) = lst->next;
+ if (iterator_current(iterator))
+ {
+ s7_pointer p;
+ p = iterator_current(iterator);
+ car(p) = lst->key;
+ cdr(p) = lst->value;
+ return(p);
+ }
+ return(cons(sc, lst->key, lst->value));
+ }
- /* currently if the extra value involves a read error, we get a kind of panicky-looking message:
- * (let ((x . 2 . 3)) x)
- * ;let variable declaration has more than one value?: (x error error "stray dot?: ... ((x . 2 . 3)) x) ..")
- */
+ table = iterator_sequence(iterator); /* using iterator_length and hash_table_entries here was slightly slower */
+ len = hash_table_mask(table) + 1;
+ elements = hash_table_elements(table);
- push_stack(sc, opcode(OP_LET1), sc->args, cdr(sc->code));
- sc->code = cadar(sc->code);
- /* sc->args = sc->NIL; */
- goto EVAL;
+ for (loc = iterator_position(iterator) + 1; loc < len; loc++)
+ {
+ hash_entry_t *x;
+ x = elements[loc];
+ if (x)
+ {
+ iterator_position(iterator) = loc;
+ iterator_hash_current(iterator) = x->next;
+ if (iterator_current(iterator))
+ {
+ s7_pointer p;
+ p = iterator_current(iterator);
+ car(p) = x->key;
+ cdr(p) = x->value;
+ return(p);
+ }
+ return(cons(sc, x->key, x->value));
}
+ }
+ iterator_next(iterator) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- /* we accept (let ((:hi 1)) :hi)
- * (let ('1) quote) [guile accepts this]
- */
-
- if (sc->code != sc->NIL) /* (let* ((a 1) . b) a) */
- return(eval_error(sc, "let var list improper?: ~A", sc->code));
+static s7_pointer string_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
+ return(s7_make_character(sc, (unsigned char)(string_value(iterator_sequence(obj))[iterator_position(obj)++])));
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- sc->args = safe_reverse_in_place(sc, sc->args);
- sc->code = car(sc->args);
- sc->args = cdr(sc->args);
+static s7_pointer byte_vector_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
+ return(small_int((unsigned char)(string_value(iterator_sequence(obj))[iterator_position(obj)++])));
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
-
- LET2:
- case OP_LET2:
- NEW_FRAME(sc, sc->envir, sc->envir);
- for (sc->x = s7_is_symbol(car(sc->code)) ? cadr(sc->code) : car(sc->code), sc->y = sc->args; sc->y != sc->NIL; sc->x = cdr(sc->x), sc->y = cdr(sc->y))
- {
- if (!(s7_is_symbol(caar(sc->x))))
- return(eval_error(sc, "bad variable ~S in let bindings", car(sc->x)));
+static s7_pointer float_vector_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
+ return(make_real(sc, float_vector_element(iterator_sequence(obj), iterator_position(obj)++)));
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- /* check for name collisions -- not sure this is required by Scheme */
- if (find_local_symbol(sc, sc->envir, caar(sc->x)) != sc->NIL) /* (let ((i 0) (i 1)) i) */
- return(eval_error(sc, "duplicate identifier in let: ~A", car(sc->x)));
+static s7_pointer int_vector_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
+ return(make_integer(sc, int_vector_element(iterator_sequence(obj), iterator_position(obj)++)));
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- add_to_local_environment(sc, caar(sc->x), car(sc->y)); /* expansion here does not help */
- }
+static s7_pointer vector_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
+ return(vector_element(iterator_sequence(obj), iterator_position(obj)++));
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- if (s7_is_symbol(car(sc->code)))
- {
- /* named let */
- for (sc->x = cadr(sc->code), sc->args = sc->NIL; is_pair(sc->x); sc->x = cdr(sc->x))
- sc->args = s7_cons(sc, caar(sc->x), sc->args);
- /* perhaps we could mimic the "do" setp var handling here to avoid the consing */
-
- sc->x = s7_make_closure(sc, s7_cons(sc, safe_reverse_in_place(sc, sc->args), cddr(sc->code)), sc->envir);
- if (find_local_symbol(sc, sc->envir, car(sc->code)) != sc->NIL) /* (let loop ((i 0) (loop 1)) i) */
- return(eval_error(sc, "named let name collides with a let variable: ~A", car(sc->code)));
+static s7_pointer closure_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ s7_pointer result;
+ result = s7_apply_function(sc, iterator_sequence(obj), sc->NIL);
+ if (result == sc->ITERATOR_END)
+ iterator_next(obj) = iterator_finished;
+ return(result);
+}
- add_to_local_environment(sc, car(sc->code), sc->x);
- sc->code = cddr(sc->code);
- sc->x = sc->NIL;
- }
- else
- {
- sc->code = cdr(sc->code);
- }
- goto BEGIN;
+static s7_pointer c_object_direct_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
+ {
+ s7_pointer result, p;
+ p = iterator_sequence(obj);
+ result = c_object_cref(p)(sc, p, iterator_position(obj));
+ iterator_position(obj)++;
+ if (result == sc->ITERATOR_END)
+ iterator_next(obj) = iterator_finished;
+ return(result);
+ }
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
+static s7_pointer c_object_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (iterator_position(obj) < iterator_length(obj))
+ {
+ s7_pointer result, p, cur;
+ p = iterator_sequence(obj);
+ cur = iterator_current(obj);
+ car(sc->Z2_1) = sc->x;
+ car(sc->Z2_2) = sc->z; /* is this necessary? */
+ car(cur) = make_integer(sc, iterator_position(obj));
+ result = (*(c_object_ref(p)))(sc, p, cur);
+ sc->x = car(sc->Z2_1);
+ sc->z = car(sc->Z2_2);
+ iterator_position(obj)++;
+ if (result == sc->ITERATOR_END)
+ iterator_next(obj) = iterator_finished;
+ return(result);
+ }
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- case OP_LET_STAR:
- if (!is_pair(sc->code)) /* (let* . 1) */
- return(eval_error(sc, "let* variable list is messed up: ~A", sc->code));
- if ((!is_pair(cdr(sc->code))) || /* (let*) */
- ((!is_pair(car(sc->code))) && /* (let* 1 ...), also there's no named let* */
- (car(sc->code) != sc->NIL)))
+static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj);
+static s7_pointer pair_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ if (is_pair(iterator_current(obj)))
+ {
+ s7_pointer result;
+ result = car(iterator_current(obj));
+ iterator_current(obj) = cdr(iterator_current(obj));
+ if (iterator_current(obj) == iterator_slow(obj))
{
- if (s7_is_symbol(car(sc->code)))
- return(eval_error(sc, "there is no named let*: ~A", sc->code));
- return(eval_error(sc, "let* variable list is messed up: ~A", sc->code));
+ iterator_next(obj) = iterator_finished;
+ return(result);
}
+ iterator_next(obj) = pair_iterate_1;
+ return(result);
+ }
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- if (car(sc->code) == sc->NIL)
+static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj)
+{
+ if (is_pair(iterator_current(obj)))
+ {
+ s7_pointer result;
+ result = car(iterator_current(obj));
+ iterator_current(obj) = cdr(iterator_current(obj));
+ if (iterator_current(obj) == iterator_slow(obj))
{
- sc->envir = new_frame_in_env(sc, sc->envir);
- sc->code = cdr(sc->code);
- goto BEGIN;
+ iterator_next(obj) = iterator_finished;
+ return(result);
}
-
- if ((!is_pair(car(sc->code))) || /* (let* x ... ) */
- (!is_pair(caar(sc->code))) || /* (let* (x) ...) */
- (!is_pair(cdaar(sc->code)))) /* (let* ((x . 1)) ...) */
- return(eval_error(sc, "let* variable declaration value is missing: ~A", sc->code));
-
- push_stack(sc, opcode(OP_LET_STAR1), cdr(sc->code), car(sc->code));
- sc->code = cadaar(sc->code);
- goto EVAL;
-
-
- case OP_LET_STAR1: /* let* -- calculate parameters */
- if (!(s7_is_symbol(caar(sc->code))))
- return(eval_error(sc, "bad variable ~S in let* bindings", car(sc->code)));
+ iterator_slow(obj) = cdr(iterator_slow(obj));
+ iterator_next(obj) = pair_iterate;
+ return(result);
+ }
+ iterator_next(obj) = iterator_finished;
+ return(sc->ITERATOR_END);
+}
- if (!is_pair(car(sc->code))) /* (let* ((x)) ...) */
- return(eval_error(sc, "let* variable declaration, but no value?: ~A", car(sc->code)));
+static s7_pointer iterator_method(s7_scheme *sc, s7_pointer e)
+{
+ s7_pointer func;
+ if ((has_methods(e)) &&
+ ((func = find_method(sc, find_let(sc, e), sc->MAKE_ITERATOR)) != sc->UNDEFINED))
+ {
+ s7_pointer it;
+ it = s7_apply_function(sc, func, list_1(sc, e));
+ if (!is_iterator(it))
+ return(s7_error(sc, sc->ERROR, set_elist_2(sc, make_string_wrapper(sc, "make-iterator method must return an interator: ~S"), it)));
+ return(it);
+ }
+ return(NULL);
+}
- if (!(is_pair(cdar(sc->code)))) /* (let* ((x . 1))...) */
- return(eval_error(sc, "let* variable declaration is not a proper list?: ~A", car(sc->code)));
+s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e)
+{
+ s7_pointer iter;
- if (cddar(sc->code) != sc->NIL) /* (let* ((x 1 2 3)) ...) */
- return(eval_error(sc, "let* variable declaration has more than one value?: ~A", car(sc->code)));
+ new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
+ iterator_sequence(iter) = e;
+ iterator_position(iter) = 0;
- /* sc->envir = new_frame_in_env(sc, sc->envir); */
- NEW_FRAME(sc, sc->envir, sc->envir);
- /* we can't skip this new frame -- we have to imitate a nested let, otherwise
- *
- * (let ((f1 (lambda (arg) (+ arg 1))))
- * (let* ((x 32)
- * (f1 (lambda (arg) (f1 (+ x arg)))))
- * (f1 1)))
- *
- * will hang.
- */
+ switch (type(e))
+ {
+ case T_LET:
+ if (e == sc->rootlet)
+ {
+ iterator_current(iter) = vector_element(e, 0); /* unfortunately tricky -- let_iterate uses different fields */
+ iterator_next(iter) = rootlet_iterate;
+ }
+ else
+ {
+ s7_pointer f;
+ sc->temp6 = iter;
+ f = iterator_method(sc, e);
+ sc->temp6 = sc->NIL;
+ if (f) {free_cell(sc, iter); return(f);}
+ iterator_let_current(iter) = let_slots(e);
+ iterator_next(iter) = let_iterate;
+ iterator_let_cons(iter) = NULL;
+ }
+ break;
- add_to_local_environment(sc, caar(sc->code), sc->value);
- sc->code = cdr(sc->code);
- if (is_pair(sc->code))
- {
- if (!is_pair(car(sc->code))) /* (let* ((x -1) 2) 3) */
- return(eval_error(sc, "let* variable/binding is ~S?", car(sc->code)));
+ case T_HASH_TABLE:
+ iterator_hash_current(iter) = NULL;
+ iterator_current(iter) = NULL;
+ iterator_position(iter) = -1;
+ iterator_next(iter) = hash_table_iterate;
+ break;
- if (!is_pair(cdar(sc->code))) /* (let* ((a 1) (b . 2)) ...) */
- return(eval_error(sc, "let* variable list is messed up? ~A", sc->code));
+ case T_STRING:
+ iterator_length(iter) = string_length(e);
+ if (is_byte_vector(e))
+ iterator_next(iter) = byte_vector_iterate;
+ else iterator_next(iter) = string_iterate;
+ break;
- push_stack(sc, opcode(OP_LET_STAR1), sc->args, sc->code);
- sc->code = cadar(sc->code);
- /* sc->args = sc->NIL; */
- goto EVAL;
- }
+ case T_VECTOR:
+ iterator_length(iter) = vector_length(e);
+ iterator_next(iter) = vector_iterate;
+ break;
- if (sc->code != sc->NIL) /* (let* ((a 1) . b) a) */
- return(eval_error(sc, "let* var list improper?: ~A", sc->code));
+ case T_INT_VECTOR:
+ iterator_length(iter) = vector_length(e);
+ iterator_next(iter) = int_vector_iterate;
+ break;
- sc->code = sc->args;
- goto BEGIN;
-
-
- case OP_LETREC:
- if ((!is_pair(sc->code)) || /* (letrec . 1) */
- (!is_pair(cdr(sc->code))) || /* (letrec) */
- ((!is_pair(car(sc->code))) && /* (letrec 1 ...) */
- (car(sc->code) != sc->NIL)))
- return(eval_error(sc, "letrec variable list is messed up: ~A", sc->code));
-
- /* get all local vars and set to #undefined
- * get parallel list of values
- * eval each member of values list with env still full of #undefined's
- * assign each value to its variable
- * eval body
- *
- * which means that (letrec ((x x)) x) is not an error!
- */
- sc->envir = new_frame_in_env(sc, sc->envir);
- sc->args = sc->NIL;
- sc->value = sc->code;
- sc->code = car(sc->code);
+ case T_FLOAT_VECTOR:
+ iterator_length(iter) = vector_length(e);
+ iterator_next(iter) = float_vector_iterate;
+ break;
- for (sc->x = sc->code; sc->x != sc->NIL; sc->x = cdr(sc->x))
- {
- if (!is_pair(sc->x)) /* (letrec ((a 1) . 2) ...) */
- return(eval_error(sc, "improper list of letrec variables? ~A", sc->code));
+ case T_PAIR:
+ iterator_current(iter) = e;
+ iterator_next(iter) = pair_iterate;
+ iterator_slow(iter) = e;
+ break;
- if ((!is_pair(car(sc->x))) || /* (letrec (1 2) #t) */
- (!(s7_is_symbol(caar(sc->x)))))
- return(eval_error(sc, "bad variable ~S in letrec bindings", car(sc->x)));
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ {
+ s7_pointer p;
+ p = cons(sc, e, sc->NIL);
+ if (g_is_iterator(sc, p) != sc->F)
+ {
+ car(p) = small_int(0);
+ iterator_current(iter) = p;
+ set_mark_seq(iter);
+ iterator_next(iter) = closure_iterate;
+ if (has_methods(e))
+ iterator_length(iter) = closure_length(sc, e);
+ else iterator_length(iter) = s7_int_max;
+ }
+ else
+ {
+ free_cell(sc, iter);
+ return(simple_wrong_type_argument_with_type(sc, sc->MAKE_ITERATOR, e, make_string_wrapper(sc, "a closure/macro with an 'iterator local that is not #f")));
+ }
+ }
+ break;
- add_to_local_environment(sc, caar(sc->x), sc->UNDEFINED);
+ case T_C_OBJECT:
+ iterator_length(iter) = object_length_to_int(sc, e);
+ if (c_object_direct_ref(e))
+ {
+ iterator_next(iter) = c_object_direct_iterate;
+ c_object_cref(e) = c_object_direct_ref(e);
+ }
+ else
+ {
+ s7_pointer f;
+ sc->temp6 = iter;
+ f = iterator_method(sc, e);
+ sc->temp6 = sc->NIL;
+ if (f) {free_cell(sc, iter); return(f);}
+ iterator_current(iter) = cons(sc, small_int(0), sc->NIL);
+ set_mark_seq(iter);
+ iterator_next(iter) = c_object_iterate;
}
+ break;
-
- case OP_LETREC1: /* letrec -- calculate parameters */
- sc->args = s7_cons(sc, sc->value, sc->args);
- if (is_pair(sc->code))
- {
- if (!is_pair(car(sc->code))) /* (letrec ((x)) x) -- perhaps this is legal? */
- return(eval_error(sc, "letrec variable declaration has no value?: ~A", car(sc->code)));
-
- if (!(is_pair(cdar(sc->code)))) /* (letrec ((x . 1))...) */
- return(eval_error(sc, "letrec variable declaration is not a proper list?: ~A", car(sc->code)));
-
- if (cddar(sc->code) != sc->NIL) /* (letrec ((x 1 2 3)) ...) */
- return(eval_error(sc, "letrec variable declaration has more than one value?: ~A", car(sc->code)));
-
- push_stack(sc, opcode(OP_LETREC1), sc->args, cdr(sc->code));
- sc->code = cadar(sc->code);
- /* sc->args = sc->NIL; */
- goto EVAL;
- }
+ default:
+ return(simple_wrong_type_argument_with_type(sc, sc->MAKE_ITERATOR, e, A_SEQUENCE));
+ }
+ return(iter);
+}
- sc->args = safe_reverse_in_place(sc, sc->args);
- sc->code = car(sc->args);
- sc->args = cdr(sc->args);
-
- case OP_LETREC2:
- for (sc->x = car(sc->code), sc->y = sc->args; sc->y != sc->NIL; sc->x = cdr(sc->x), sc->y = cdr(sc->y))
- s7_symbol_set_value(sc, caar(sc->x), car(sc->y));
- sc->code = cdr(sc->code);
- goto BEGIN;
-
-
- case OP_COND:
- if (!is_pair(sc->code)) /* (cond) or (cond . 1) */
- return(eval_error(sc, "cond, but no body: ~A", sc->code));
- for (sc->x = sc->code; is_pair(sc->x); sc->x = cdr(sc->x))
- if (!is_pair(car(sc->x))) /* (cond 1) or (cond (#t 1) 3) */
- return(eval_error(sc, "every clause in cond must be a list: ~A", car(sc->x)));
- if (sc->x != sc->NIL) /* (cond ((1 2)) . 1) */
- return(eval_error(sc, "cond: stray dot? ~A", sc->code));
-
- push_stack(sc, opcode(OP_COND1), sc->NIL, sc->code);
- sc->code = caar(sc->code);
- goto EVAL;
-
-
- case OP_COND1:
- if (is_true(sc, sc->value)) /* got a hit (is_true -> not false, so else is true even though it has no value) */
+static s7_pointer g_make_iterator(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_iterator "(make-iterator sequence) returns an iterator object that \
+returns the next value in the sequence each time it is called. When it reaches the end, it returns " ITERATOR_END_NAME "."
+ #define Q_make_iterator s7_make_signature(sc, 3, sc->IS_ITERATOR, sc->IS_SEQUENCE, sc->IS_PAIR)
+
+ s7_pointer seq;
+ seq = car(args);
+
+ if (is_pair(cdr(args)))
+ {
+ if (is_pair(cadr(args)))
{
- sc->code = cdar(sc->code);
- if (sc->code == sc->NIL)
+ if (is_hash_table(seq))
{
- if (is_multiple_value(sc->value)) /* (+ 1 (cond ((values 2 3)))) */
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- /* no result clause, so return test, (cond (#t)) -> #t, (cond ((+ 1 2))) -> 3 */
- goto START;
+ s7_pointer iter;
+ iter = s7_make_iterator(sc, seq);
+ iterator_current(iter) = cadr(args);
+ set_mark_seq(iter);
+ return(iter);
}
-
- if ((is_pair(sc->code)) &&
- (car(sc->code) == sc->FEED_TO) &&
- (s7_symbol_value(sc, sc->FEED_TO) == sc->UNDEFINED))
+ if ((is_let(seq)) && (seq != sc->rootlet))
{
- if (!is_pair(cdr(sc->code))) /* (cond (#t =>)) or (cond (#t => . 1)) */
- return(eval_error(sc, "cond: '=>' target missing? ~A", cdr(sc->code)));
- if (is_pair(cddr(sc->code))) /* (cond (1 => + abs)) */
- return(eval_error(sc, "cond: '=>' has too many targets: ~A", sc->code));
- if (sc->value == sc->ELSE) /* (cond ((= 1 2) 3) (else => not)) */
- return(eval_error(sc, "cond: 'else =>' is considered bad form: ~A", sc->code));
-
- /* currently we accept:
- * (cond (1 2) (=> . =>)) and all variants thereof, e.g. (cond (1 2) (=> 1 . 2) (1 2)) or
- * (cond (1) (=>)) but Guile accepts this?
- * (cond (1) (1 =>))
- * amusing (correct) case: (cond (1 => "hi")) -> #\i
- */
-
- if (is_multiple_value(sc->value)) /* (cond ((values 1 2) => +)) */
- sc->code = s7_cons(sc, cadr(sc->code), multiple_value(sc->value));
- else sc->code = make_list_2(sc, cadr(sc->code), make_list_2(sc, sc->QUOTE, sc->value));
- goto EVAL;
+ s7_pointer iter;
+ iter = s7_make_iterator(sc, seq);
+ iterator_let_cons(iter) = cadr(args);
+ set_mark_seq(iter);
+ return(iter);
}
- goto BEGIN;
}
+ else return(simple_wrong_type_argument(sc, sc->MAKE_ITERATOR, cadr(args), T_PAIR));
+ }
+ return(s7_make_iterator(sc, seq));
+}
- sc->code = cdr(sc->code);
- if (sc->code == sc->NIL)
- {
- sc->value = sc->NIL;
- goto START;
- }
-
- push_stack(sc, opcode(OP_COND1), sc->NIL, sc->code);
- sc->code = caar(sc->code);
- goto EVAL;
-
-
- case OP_AND:
- if (sc->code == sc->NIL)
- {
- sc->value = sc->T;
- goto START;
- }
- if (!is_pair(sc->code)) /* (and . 1) */
- return(eval_error(sc, "and: stray dot?: ~A", sc->code));
- if (cdr(sc->code) != sc->NIL)
- push_stack(sc, opcode(OP_AND1), sc->NIL, cdr(sc->code));
- sc->code = car(sc->code);
- goto EVAL;
-
-
- case OP_AND1:
- if ((is_false(sc, sc->value)) ||
- (sc->code == sc->NIL))
- goto START;
+PF_TO_PF(make_iterator, s7_make_iterator)
- if (!is_pair(sc->code)) /* (and #t . 1) but (and #f . 1) returns #f */
- return(eval_error(sc, "and: stray dot?: ~A", sc->code));
- if (cdr(sc->code) != sc->NIL)
- push_stack(sc, opcode(OP_AND1), sc->NIL, cdr(sc->code));
- sc->code = car(sc->code);
- goto EVAL;
+static s7_pointer c_iterate(s7_scheme *sc, s7_pointer iter)
+{
+ if (!is_iterator(iter))
+ method_or_bust(sc, iter, sc->ITERATE, list_1(sc, iter), T_ITERATOR, 0);
+ return((iterator_next(iter))(sc, iter));
+}
-
- case OP_OR:
- if (sc->code == sc->NIL)
+static s7_pointer g_iterate(s7_scheme *sc, s7_pointer args)
+{
+ #define H_iterate "(iterate obj) returns the next element from the iterator obj, or " ITERATOR_END_NAME "."
+ #define Q_iterate s7_make_signature(sc, 2, sc->T, sc->IS_ITERATOR)
+
+ s7_pointer iter;
+ iter = car(args);
+ if (!is_iterator(iter))
+ method_or_bust(sc, iter, sc->ITERATE, args, T_ITERATOR, 0);
+ return((iterator_next(iter))(sc, iter));
+}
+
+static s7_pointer iterate_pf_p(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t f;
+ s7_pointer x;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ return(c_iterate(sc, x));
+}
+
+static s7_pointer iterate_pf_s(s7_scheme *sc, s7_pointer **p)
+{
+ pf_pf_t f;
+ s7_pointer x;
+ x = (s7_pointer)(**p); (*p)++;
+ f = (pf_pf_t)(**p); (*p)++;
+ return(f(sc, x));
+}
+
+static s7_pf_t iterate_gf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ {
+ s7_pointer a1, obj;
+ a1 = cadr(expr);
+ if ((is_symbol(a1)) &&
+ (!s7_xf_is_stepper(sc, a1)) &&
+ (is_iterator(obj = s7_symbol_value(sc, a1))))
{
- sc->value = sc->F;
- goto START;
+ s7_xf_store(sc, obj);
+ s7_xf_store(sc, (s7_pointer)iterator_next(obj));
+ return(iterate_pf_s);
}
- if (!is_pair(sc->code)) /* (or . 1) */
- return(eval_error(sc, "or: stray dot?: ~A", sc->code));
- if (cdr(sc->code) != sc->NIL)
- push_stack(sc, opcode(OP_OR1), sc->NIL, cdr(sc->code));
- sc->code = car(sc->code);
- goto EVAL;
-
-
- case OP_OR1:
- if ((is_true(sc, sc->value)) ||
- (sc->code == sc->NIL))
- goto START;
+ if (s7_arg_to_pf(sc, a1))
+ return(iterate_pf_p);
+ }
+ return(NULL);
+}
- if (!is_pair(sc->code)) /* (or #f . 1) but (or #t . 1) returns #t */
- return(eval_error(sc, "or: stray dot?: ~A", sc->code));
+static s7_pf_t iterate_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_null(cddr(expr))))
+ {
+ s7_pointer a1, obj;
+ a1 = cadr(expr);
+ if ((is_symbol(a1)) &&
+ (!s7_xf_is_stepper(sc, a1)) &&
+ (is_iterator(obj = s7_symbol_value(sc, a1))))
+ {
+ s7_pointer seq;
+ seq = iterator_sequence(obj);
+ if ((type(seq) == T_VECTOR) || (is_string(seq)) || (is_pair(seq)))
+ {
+ s7_xf_store(sc, obj);
+ s7_xf_store(sc, (s7_pointer)iterator_next(obj));
+ return(iterate_pf_s);
+ }
+ }
+ }
+ return(NULL);
+}
- if (cdr(sc->code) != sc->NIL)
- push_stack(sc, opcode(OP_OR1), sc->NIL, cdr(sc->code));
- sc->code = car(sc->code);
- goto EVAL;
+s7_pointer s7_iterate(s7_scheme *sc, s7_pointer obj)
+{
+ return((iterator_next(obj))(sc, obj));
+}
- /* by going direct without a push_stack on the last one we get "tail recursion",
- * but if the last arg (also in "and" above) is "values", there is a slight
- * inconsistency: the values are returned and spliced into the caller if trailing, but
- * are spliced into the "or" if not trailing, so
- *
- * (+ 10 (or (values 1 2) #f))
- * 11
- * (+ 10 (or #f (values 1 2)))
- * 13
- * (+ 10 (or (or #f (values 1 2)) #f))
- * 11
- *
- * The tail recursion is more important. This behavior matches that of "begin" -- if the
- * values statement is last, it splices into the next outer arglist.
- *
- * I tried implementing dynamic-binding by walking up the stack looking at envs, but
- * for that to work in some cases, every new frame needs to be on the stack, hence
- * OP_LET_UNWIND. But that means the stack grows on every let, so tail recursion is
- * defeated. I'd have to notice tail calls and pop the stack, but I decided that
- * was too much work for a minor (unneeded) feature. Although the stack does not
- * grow, we're depending on the GC to take care of the old local envs after the
- * tail call. My test:
- *
- * (let ((max-stack 0))
- * (define (tc-1 a c)
- * (let ((b (+ a 1))
- * (d (make-vector 1000)))
- * (if (> (s7-stack-size) max-stack)
- * (set! max-stack (s7-stack-size)))
- * (if (< b c)
- * (tc-1 b c))))
- * (tc-1 0 3200000) max-stack)
- * 4
- *
- * indicated (via "top") that the memory footprint was not growing, and the "4"
- * shows the stack was ok, so I currently believe that s7 is doing tail calls
- * correctly.
- */
+bool s7_is_iterator(s7_pointer obj)
+{
+ return(is_iterator(obj));
+}
+bool s7_iterator_is_at_end(s7_pointer obj)
+{
+ return(iterator_is_at_end(obj));
+}
- case OP_BACRO:
- /* sc->value is the symbol, sc->x is the binding (the bacro) */
- set_type(sc->x, T_BACRO | T_ANY_MACRO | T_DONT_COPY_CDR | T_DONT_COPY);
- goto START;
+static s7_pointer g_iterator_sequence(s7_scheme *sc, s7_pointer args)
+{
+ #define H_iterator_sequence "(iterator-sequence iterator) returns the sequence that iterator is traversing."
+ #define Q_iterator_sequence s7_make_signature(sc, 2, sc->IS_SEQUENCE, sc->IS_ITERATOR)
- case OP_MACRO:
- /* symbol? macro name has already been checked */
- set_type(sc->value, T_MACRO | T_ANY_MACRO | T_DONT_COPY_CDR | T_DONT_COPY);
+ s7_pointer iter;
- /* find name in environment, and define it */
- sc->x = find_local_symbol(sc, sc->envir, sc->code);
- if (sc->x != sc->NIL)
- set_symbol_value(sc->x, sc->value);
- else add_to_current_environment(sc, sc->code, sc->value);
+ iter = car(args);
+ if (!is_iterator(iter))
+ return(simple_wrong_type_argument(sc, sc->ITERATOR_SEQUENCE, iter, T_ITERATOR));
+ return(iterator_sequence(iter));
+}
- /* pop back to wherever the macro call was */
- sc->x = sc->value;
- sc->value = sc->code;
- goto START;
-
-
- case OP_DEFMACRO:
- case OP_DEFMACRO_STAR:
- /* defmacro(*) could be defined in terms of define-macro(*), but I guess this gives us better error messages */
-
- if (!is_pair(sc->code)) /* (defmacro . 1) */
- return(eval_error_with_name(sc, "~A name missing (stray dot?): ~A", sc->code));
-
- sc->x = car(sc->code);
- if (!s7_is_symbol(sc->x)) /* (defmacro) or (defmacro 1 ...) */
- return(eval_error_with_name(sc, "~A name: ~S is not a symbol?", sc->x));
-
- if (is_immutable_or_accessed(sc->x))
- {
- if (is_immutable(sc->x))
- return(eval_error_with_name(sc, "~A: ~S is immutable", sc->x)); /* (defmacro pi (a) `(+ ,a 1)) */
- sc->code = call_symbol_bind(sc, sc->x, sc->code);
- }
-
- sc->z = cdr(sc->code);
- if (!is_pair(sc->z)) /* (defmacro a) */
- return(eval_error_with_name(sc, "~A ~A, but no args or body?", sc->x));
-
- sc->y = car(sc->z); /* the arglist */
- if ((!is_pair(sc->y)) &&
- (sc->y != sc->NIL) &&
- (!s7_is_symbol(sc->y)))
- return(s7_error(sc, sc->SYNTAX_ERROR, /* (defmacro mac "hi" ...) */
- make_list_3(sc, make_protected_string(sc, "defmacro ~A argument list is ~S?"), sc->x, sc->y)));
-
- for ( ; is_pair(sc->y); sc->y = cdr(sc->y))
- if ((!s7_is_symbol(car(sc->y))) &&
- (sc->op == OP_DEFMACRO))
- return(s7_error(sc, sc->SYNTAX_ERROR, /* (defmacro mac (1) ...) */
- make_list_3(sc, make_protected_string(sc, "defmacro ~A argument name is not a symbol: ~S"), sc->x, sc->y)));
-
- /* other parameter error checks are handled by lambda/lambda* (see OP_LAMBDA above) at macro expansion time */
-
- if (cdr(sc->z) == sc->NIL) /* (defmacro hi ()) */
- return(eval_error_with_name(sc, "~A ~A has no body?", sc->x));
- if (!is_pair(cdr(sc->z)))
- return(eval_error_with_name(sc, "~A ~A has stray dot?", sc->x));
-
- sc->y = s7_gensym(sc, "defmac");
- sc->code = s7_cons(sc,
- sc->LAMBDA,
- s7_cons(sc,
- make_list_1(sc, sc->y),
- make_list_1(sc,
- s7_cons(sc,
- sc->APPLY,
- s7_cons(sc,
- s7_cons(sc,
- (sc->op == OP_DEFMACRO_STAR) ? sc->LAMBDA_STAR : sc->LAMBDA,
- sc->z),
- make_list_1(sc, make_list_2(sc, sc->CDR, sc->y)))))));
-
- /* so, (defmacro hi (a b) `(+ ,a ,b)) becomes:
- * sc->x: hi
- * sc->code: (lambda (defmac-21)
- * (apply (lambda (a b)
- * (cons (quote +) (cons a (cons b (quote ())))))
- * (cdr defmac-21)))
- */
- sc->y = sc->NIL;
- sc->z = sc->NIL;
- push_stack(sc, opcode(OP_MACRO), sc->NIL, sc->x); /* sc->x (the name symbol) will be sc->code when we pop to OP_MACRO */
- sc->x = sc->NIL;
- goto EVAL;
+static s7_pointer c_iterator_sequence(s7_scheme *sc, s7_pointer iter)
+{
+ if (!is_iterator(iter))
+ return(simple_wrong_type_argument(sc, sc->ITERATOR_SEQUENCE, iter, T_ITERATOR));
+ return(iterator_sequence(iter));
+}
+PF_TO_PF(iterator_sequence, c_iterator_sequence)
- case OP_EXPANSION:
- /* sc->x is the value (sc->value right now is sc->code, the macro name symbol) */
- set_type(sc->x, T_MACRO | T_ANY_MACRO | T_EXPANSION | T_DONT_COPY_CDR | T_DONT_COPY);
- set_type(sc->value, type(sc->value) | T_EXPANSION | T_DONT_COPY);
- goto START;
+static s7_pointer g_iterator_is_at_end(s7_scheme *sc, s7_pointer args)
+{
+ #define H_iterator_is_at_end "(iterator-at-end? iter) returns #t if the iterator has reached the end of its sequence."
+ #define Q_iterator_is_at_end s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_ITERATOR)
+ s7_pointer iter;
- case OP_DEFINE_BACRO:
- case OP_DEFINE_BACRO_STAR:
- case OP_DEFINE_EXPANSION:
- if (sc->op == OP_DEFINE_EXPANSION)
- push_stack(sc, opcode(OP_EXPANSION), sc->NIL, sc->NIL);
- else push_stack(sc, opcode(OP_BACRO), sc->NIL, sc->NIL);
- /* drop into define-macro */
+ iter = car(args);
+ if (!is_iterator(iter))
+ return(simple_wrong_type_argument(sc, sc->ITERATOR_IS_AT_END, iter, T_ITERATOR));
+ return(make_boolean(sc, iterator_is_at_end(iter)));
+}
- case OP_DEFINE_MACRO:
- case OP_DEFINE_MACRO_STAR:
- if (!is_pair(sc->code)) /* (define-macro . 1) */
- return(eval_error_with_name(sc, "~A name missing (stray dot?): ~A", sc->code));
- if (!is_pair(car(sc->code))) /* (define-macro a ...) */
- return(s7_wrong_type_arg_error(sc, op_names[(int)(sc->op)], 1, car(sc->code), "a list (name ...)"));
+/* -------------------------------------------------------------------------------- */
- sc->x = caar(sc->code);
- if (!s7_is_symbol(sc->x))
- return(eval_error_with_name(sc, "~A: ~S is not a symbol?", sc->x));
+#define INITIAL_SHARED_INFO_SIZE 8
- if (is_immutable_or_accessed(sc->x))
- {
- if (is_immutable(sc->x))
- return(eval_error_with_name(sc, "~A: ~S is immutable", sc->x));
- sc->code = call_symbol_bind(sc, sc->x, sc->code);
- }
+static int shared_ref(shared_info *ci, s7_pointer p)
+{
+ /* from print after collecting refs, not called by equality check */
+ int i;
+ s7_pointer *objs;
- /* (define-macro (hi a) `(+ ,a 1))
- * in this case we want cadr, not caddr of defmacro
- */
- sc->z = cdr(sc->code);
- if (!is_pair(sc->z)) /* (define-macro (...)) */
- return(eval_error_with_name(sc, "~A ~A, but no body?", sc->x));
-
- sc->y = cdar(sc->code); /* the arglist */
- if ((!is_pair(sc->y)) &&
- (sc->y != sc->NIL) &&
- (!s7_is_symbol(sc->y)))
- return(s7_error(sc, sc->SYNTAX_ERROR, /* (define-macro (mac . 1) ...) */
- make_list_3(sc, make_protected_string(sc, "define-macro ~A argument list is ~S?"), sc->x, sc->y)));
-
- for ( ; is_pair(sc->y); sc->y = cdr(sc->y))
- if ((!s7_is_symbol(car(sc->y))) &&
- ((sc->op == OP_DEFINE_MACRO) || (sc->op == OP_DEFINE_BACRO)))
- return(s7_error(sc, sc->SYNTAX_ERROR, /* (define-macro (mac 1) ...) */
- make_list_3(sc, make_protected_string(sc, "define-macro ~A argument name is not a symbol: ~S"), sc->x, sc->y)));
-
- sc->y = s7_gensym(sc, "defmac");
- sc->code = s7_cons(sc,
- sc->LAMBDA,
- s7_cons(sc,
- make_list_1(sc, sc->y),
- make_list_1(sc,
- s7_cons(sc,
- sc->APPLY,
- s7_cons(sc,
- s7_cons(sc,
- ((sc->op == OP_DEFINE_MACRO_STAR) ||
- (sc->op == OP_DEFINE_BACRO_STAR)) ? sc->LAMBDA_STAR : sc->LAMBDA,
- s7_cons(sc, /* cdar(sc->code) is the parameter list */
- ((sc->op == OP_DEFINE_MACRO_STAR) ||
- (sc->op == OP_DEFINE_BACRO_STAR)) ? quotify(sc, cdar(sc->code)) : cdar(sc->code),
- sc->z)),
- make_list_1(sc, make_list_2(sc, sc->CDR, sc->y)))))));
-
- /* (define-macro (hi a b) `(+ ,a ,b)) becomes:
- * sc->x: hi
- * sc->code: (lambda ({defmac}-14) (apply (lambda (a b) ({list} '+ a b)) (cdr {defmac}-14)))
- */
- sc->y = sc->NIL;
- sc->z = sc->NIL;
- push_stack(sc, opcode(OP_MACRO), sc->NIL, sc->x); /* sc->x (the name symbol) will be sc->code when we pop to OP_MACRO */
- sc->x = sc->NIL;
- goto EVAL;
-
-
- case OP_CASE: /* case, car(sc->code) is the selector */
- if (!is_pair(sc->code)) /* (case) or (case . 1) */
- return(eval_error(sc, "case has no selector: ~A", sc->code));
- if (!is_pair(cdr(sc->code))) /* (case 1) or (case 1 . 1) */
- return(eval_error(sc, "case has no clauses?: ~A", sc->code));
- if (!is_pair(cadr(sc->code))) /* (case 1 1) */
- return(eval_error(sc, "case clause is not a list? ~A", sc->code));
-
- push_stack(sc, opcode(OP_CASE1), sc->NIL, cdr(sc->code));
- sc->code = car(sc->code);
- goto EVAL;
-
-
- case OP_CASE1:
- for (sc->x = sc->code; sc->x != sc->NIL; sc->x = cdr(sc->x))
- {
- if ((!is_pair(sc->x)) || /* (case 1 ((2) 1) . 1) */
- (!is_pair(car(sc->x))))
- return(eval_error(sc, "case clause ~A messed up", sc->x));
- if (!is_pair(cdar(sc->x))) /* (case 1 ((1))) */
- return(eval_error(sc, "case clause result missing: ~A", car(sc->x)));
-
- sc->y = caar(sc->x);
- if (!is_pair(sc->y))
- {
- if ((sc->y != sc->ELSE) && /* (case 1 (2 1)) */
- ((!s7_is_symbol(sc->y)) ||
- (s7_symbol_value(sc, sc->y) != sc->ELSE))) /* "proper list" below because: (case 1 (() 2) ... */
- return(eval_error(sc, "case clause key list ~A is not a proper list or 'else'", sc->y));
- if (cdr(sc->x) != sc->NIL) /* (case 1 (else 1) ((2) 1)) */
- return(eval_error(sc, "case 'else' clause, ~A, is not the last clause", sc->x));
- break;
- }
+ if (!is_collected(p)) return(0);
- /* what about (case 1 ((1) #t) ((1) #f)) [this is ok by guile]
- * (case 1 ((1) #t) ())
- * (case 1 ((2 2 2) 1)): guile says #<unspecified>
- */
+ objs = ci->objs;
+ for (i = 0; i < ci->top; i++)
+ if (objs[i] == p)
+ {
+ int val;
+ val = ci->refs[i];
+ if (val > 0)
+ ci->refs[i] = -ci->refs[i];
+ return(val);
+ }
+ return(0);
+}
- /* the selector (sc->value) is evaluated, but the search key is not
- * (case '2 ((2) 3) (else 1)) -> 3
- * (case '2 (('2) 3) (else 1)) -> 1
- */
- if (s7_is_eqv(car(sc->y), sc->value))
- break;
+static int peek_shared_ref(shared_info *ci, s7_pointer p)
+{
+ /* returns 0 if not found, otherwise the ref value for p */
+ int i;
+ s7_pointer *objs;
+ objs = ci->objs;
- for (sc->y = cdr(sc->y); sc->y != sc->NIL; sc->y = cdr(sc->y))
- {
- if (!is_pair(sc->y)) /* (case () ((1 . 2) . hi) . hi) */
- return(eval_error(sc, "case key list is improper? ~A", sc->x));
- if (s7_is_eqv(car(sc->y), sc->value))
- break;
- }
-
- if (sc->y != sc->NIL)
- break;
- }
+ if (!is_collected(p)) return(0);
+ for (i = 0; i < ci->top; i++)
+ if (objs[i] == p) return(ci->refs[i]);
- /* now sc->x is the entire matching clause (or nil if nothing matched)
- * (case 2 ((2) 3)), sc->x: (((2) 3))
- */
+ return(0);
+}
- if (sc->x != sc->NIL)
- {
- if (is_pair(caar(sc->x))) /* the normal case (list of keys = caar, rest of clause = cdar) */
- {
- sc->code = cdar(sc->x);
- goto BEGIN;
- } /* else it's the "else" clause presumably -- evaluate caar to make sure? */
- push_stack(sc, opcode(OP_CASE2), sc->NIL, cdar(sc->x));
- sc->code = caar(sc->x);
- goto EVAL;
- }
- sc->value = sc->UNSPECIFIED; /* this was sc->NIL but the spec says case value is unspecified if no clauses match */
- goto START;
-
-
- case OP_CASE2:
- if (is_true(sc, sc->value))
- goto BEGIN;
- sc->value = sc->NIL;
- goto START;
-
+static void enlarge_shared_info(shared_info *ci)
+{
+ int i;
+ ci->size *= 2;
+ ci->objs = (s7_pointer *)realloc(ci->objs, ci->size * sizeof(s7_pointer));
+ ci->refs = (int *)realloc(ci->refs, ci->size * sizeof(int));
+ for (i = ci->top; i < ci->size; i++)
+ {
+ ci->refs[i] = 0;
+ ci->objs[i] = NULL;
+ }
+}
- case OP_ERROR_QUIT:
- case OP_EVAL_DONE:
- /* this is the "time to quit" operator */
- return(sc->F);
- break;
-
- case OP_BARRIER:
- case OP_CATCH:
- goto START;
+static void add_equal_ref(shared_info *ci, s7_pointer x, s7_pointer y)
+{
+ /* assume neither x nor y is in the table, and that they should share a ref value,
+ * called only in equality check, not printer.
+ */
+ if ((ci->top + 2) >= ci->size)
+ enlarge_shared_info(ci);
- case OP_DEACTIVATE_GOTO:
- call_exit_active(sc->args) = false; /* as we leave the call-with-exit body, deactivate the exiter */
- goto START;
+ set_collected(x);
+ set_collected(y);
+ ci->ref++;
+ ci->objs[ci->top] = x;
+ ci->refs[ci->top++] = ci->ref;
+ ci->objs[ci->top] = y;
+ ci->refs[ci->top++] = ci->ref;
+}
- case OP_TRACE_HOOK_QUIT:
- (*(sc->tracing)) = true; /* this was turned off before calling the *trace-hook* functions */
- goto APPLY_WITHOUT_TRACE;
-
- case OP_ERROR_HOOK_QUIT:
- hook_functions(sc->error_hook) = sc->code; /* restore old value */
-
- /* now mimic the end of the normal error handler. Since this error hook evaluation can happen
- * in an arbitrary s7_call nesting, we can't just return from the current evaluation --
- * we have to jump to the original (top-level) call. Otherwise '#<unspecified> or whatever
- * is simply treated as the (non-error) return value, and the higher level evaluations
- * get confused.
- */
- stack_reset(sc);
- sc->op = OP_ERROR_QUIT;
- /* sc->value = sc->UNSPECIFIED; */ /* return the *error-hook* function's value if possible */
- if (sc->longjmp_ok)
- {
- longjmp(sc->goto_start, 1);
- }
- return(sc->value); /* not executed I hope */
+static void add_shared_ref(shared_info *ci, s7_pointer x, int ref_x)
+{
+ /* called only in equality check, not printer */
-
- case OP_GET_OUTPUT_STRING: /* from call-with-output-string and with-output-to-string -- return the string */
- sc->value = s7_make_string(sc, s7_get_output_string(sc, sc->code));
- goto START;
+ if (ci->top == ci->size)
+ enlarge_shared_info(ci);
+ set_collected(x);
- case OP_UNWIND_OUTPUT:
- {
- bool is_file;
- is_file = is_file_port(sc->code);
-
- if ((is_output_port(sc->code)) &&
- (!port_is_closed(sc->code)))
- s7_close_output_port(sc, sc->code); /* may call fflush */
-
- if ((is_output_port(sc->args)) &&
- (!port_is_closed(sc->args)))
- sc->output_port = sc->args;
-
- if (is_file)
- {
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- }
- goto START;
- }
+ ci->objs[ci->top] = x;
+ ci->refs[ci->top++] = ref_x;
+}
+static shared_info *collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length, bool *cyclic);
+static hash_entry_t *hash_equal(s7_scheme *sc, s7_pointer table, s7_pointer key);
- case OP_UNWIND_INPUT:
- if ((is_input_port(sc->code)) &&
- (!port_is_closed(sc->code)))
- s7_close_input_port(sc, sc->code);
+static void collect_vector_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length, bool *cyclic)
+{
+ s7_int i, plen;
- if ((is_input_port(sc->args)) &&
- (!port_is_closed(sc->args)))
- {
- sc->input_port = sc->args;
- sc->input_is_file = (is_file_port(sc->input_port));
- }
- if (is_multiple_value(sc->value))
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- goto START;
+ if (stop_at_print_length)
+ {
+ plen = sc->print_length;
+ if (plen > vector_length(top))
+ plen = vector_length(top);
+ }
+ else plen = vector_length(top);
+ for (i = 0; i < plen; i++)
+ if (has_structure(vector_element(top, i)))
+ collect_shared_info(sc, ci, vector_element(top, i), stop_at_print_length, cyclic);
+}
- case OP_DYNAMIC_WIND:
- if (dynamic_wind_state(sc->code) == DWIND_INIT)
- {
- dynamic_wind_state(sc->code) = DWIND_BODY;
- push_stack(sc, opcode(OP_DYNAMIC_WIND), sc->NIL, sc->code);
- sc->args = sc->NIL;
- sc->code = dynamic_wind_body(sc->code);
- goto APPLY;
- }
- else
+
+static shared_info *collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length, bool *cyclic)
+{
+ /* look for top in current list.
+ *
+ * As we collect objects (guaranteed to have structure) we set the collected bit. If we ever
+ * encounter an object with that bit on, we've seen it before so we have a possible cycle.
+ * Once the collection pass is done, we run through our list, and clear all these bits.
+ */
+ if (is_shared(top))
+ return(ci);
+
+ if (is_collected(top))
+ {
+ s7_pointer *p, *objs_end;
+ int i;
+ *cyclic = true;
+ objs_end = (s7_pointer *)(ci->objs + ci->top);
+
+ for (p = ci->objs; p < objs_end; p++)
+ if ((*p) == top)
+ {
+ i = (int)(p - ci->objs);
+ if (ci->refs[i] == 0)
+ {
+ ci->has_hits = true;
+ ci->refs[i] = ++ci->ref; /* if found, set the ref number */
+ }
+ break;
+ }
+ }
+ else
+ {
+ /* top not seen before -- add it to the list */
+ bool top_cyclic = false;
+ set_collected(top);
+
+ if (ci->top == ci->size)
+ enlarge_shared_info(ci);
+ ci->objs[ci->top++] = top;
+
+ /* now search the rest of this structure */
+ switch (type(top))
{
- if (dynamic_wind_state(sc->code) == DWIND_BODY)
+ case T_PAIR:
+ if (has_structure(car(top)))
+ collect_shared_info(sc, ci, car(top), stop_at_print_length, &top_cyclic);
+ if (has_structure(cdr(top)))
+ collect_shared_info(sc, ci, cdr(top), stop_at_print_length, &top_cyclic);
+ break;
+
+ case T_VECTOR:
+ collect_vector_info(sc, ci, top, stop_at_print_length, &top_cyclic);
+ break;
+
+ case T_ITERATOR:
+ collect_shared_info(sc, ci, iterator_sequence(top), stop_at_print_length, &top_cyclic);
+ break;
+
+ case T_HASH_TABLE:
+ if (hash_table_entries(top) > 0)
{
- dynamic_wind_state(sc->code) = DWIND_FINISH;
- push_stack(sc, opcode(OP_DYNAMIC_WIND), sc->value, sc->code);
- sc->args = sc->NIL;
- sc->code = dynamic_wind_out(sc->code);
- goto APPLY;
+ unsigned int i, len;
+ hash_entry_t **entries;
+ bool keys_safe;
+
+ keys_safe = ((hash_table_checker(top) != hash_equal) &&
+ (!hash_table_checker_locked(top)));
+ entries = hash_table_elements(top);
+ len = hash_table_mask(top) + 1;
+ for (i = 0; i < len; i++)
+ {
+ hash_entry_t *p;
+ for (p = entries[i]; p; p = p->next)
+ {
+ if ((!keys_safe) &&
+ (has_structure(p->key)))
+ collect_shared_info(sc, ci, p->key, stop_at_print_length, &top_cyclic);
+ if (has_structure(p->value))
+ collect_shared_info(sc, ci, p->value, stop_at_print_length, &top_cyclic);
+ }
+ }
}
+ break;
+
+ case T_SLOT:
+ if (has_structure(slot_value(top)))
+ collect_shared_info(sc, ci, slot_value(top), stop_at_print_length, &top_cyclic);
+ break;
+
+ case T_LET:
+ if (top == sc->rootlet)
+ collect_vector_info(sc, ci, top, stop_at_print_length, &top_cyclic);
else
{
- /* (+ 1 (dynamic-wind (lambda () #f) (lambda () (values 2 3 4)) (lambda () #f)) 5) */
- if (is_multiple_value(sc->args))
- sc->value = splice_in_values(sc, multiple_value(sc->args));
- else sc->value = sc->args; /* value saved above */
- goto START;
+ s7_pointer p;
+ for (p = let_slots(top); is_slot(p); p = next_slot(p))
+ if (has_structure(slot_value(p)))
+ collect_shared_info(sc, ci, slot_value(p), stop_at_print_length, &top_cyclic);
}
+ break;
}
- break;
-
-
- case OP_WITH_ENV:
- /* (with-environment env . body) */
- if (!is_pair(sc->code)) /* (with-environment . "hi") */
- return(eval_error(sc, "with-environment takes an environment argument: ~A", sc->code));
- if (!is_pair(cdr(sc->code)))
- return(eval_error(sc, "with-environment body is messed up: ~A", sc->code));
- push_stack(sc, opcode(OP_WITH_ENV1), sc->NIL, sc->code);
- /* sc->args = sc->NIL; */
- sc->code = car(sc->code); /* eval env arg */
- goto EVAL;
-
-
- case OP_WITH_ENV1:
- if (!is_environment(sc->value)) /* (with-environment . "hi") */
- return(eval_error(sc, "with-environment takes an environment argument: ~A", sc->value));
-
- sc->envir = sc->value; /* in new env... */
- sc->code = cdr(sc->code); /* handle body */
- goto BEGIN;
+ if (!top_cyclic)
+ set_shared(top);
+ else *cyclic = true;
+ }
+ return(ci);
+}
- case OP_TRACE_RETURN:
- trace_return(sc);
- goto START;
-
-
- READ_LIST:
- case OP_READ_LIST:
- /* sc->args is sc->NIL at first */
- /* was: sc->args = s7_cons(sc, sc->value, sc->args); */
- {
- s7_pointer x;
- NEW_CELL(sc, x);
- car(x) = sc->value;
- cdr(x) = sc->args;
- set_type(x, T_PAIR | T_STRUCTURE);
- sc->args = x;
- }
-
- /* sc->tok = token(sc); */
- /* this is 75% of the token calls, so expanding it saves lots of time */
- {
- int c;
- s7_pointer pt;
+static shared_info *new_shared_info(s7_scheme *sc)
+{
+ shared_info *ci;
+ if (sc->circle_info == NULL)
+ {
+ ci = (shared_info *)calloc(1, sizeof(shared_info));
+ ci->size = INITIAL_SHARED_INFO_SIZE;
+ ci->objs = (s7_pointer *)malloc(ci->size * sizeof(s7_pointer));
+ ci->refs = (int *)calloc(ci->size, sizeof(int)); /* finder expects 0 = unseen previously */
+ sc->circle_info = ci;
+ }
+ else
+ {
+ int i;
+ ci = sc->circle_info;
+ memclr((void *)(ci->refs), ci->top * sizeof(int));
+ for (i = 0; i < ci->top; i++)
+ clear_collected_and_shared(ci->objs[i]);
+ }
+ ci->top = 0;
+ ci->ref = 0;
+ ci->has_hits = false;
+ return(ci);
+}
- pt = sc->input_port;
- if (sc->input_is_file)
- {
- while (is_white_space(c = fgetc(port_file(pt))))
- if (c == '\n')
- port_line_number(pt)++;
- if (c == EOF)
- return(missing_close_paren_error(sc));
- }
- else
- {
- char *orig_str, *str;
- unsigned char c1;
- str = (char *)(port_string(pt) + port_string_point(pt));
- if (!(*str))
- return(missing_close_paren_error(sc));
+static shared_info *make_shared_info(s7_scheme *sc, s7_pointer top, bool stop_at_print_length)
+{
+ /* for the printer */
+ shared_info *ci;
+ int i, refs;
+ s7_pointer *ci_objs;
+ int *ci_refs;
+ bool no_problem = true, cyclic = false;
- orig_str = str;
- while (white_space[c1 = (unsigned char)(*str++)]) /* (let ((ÿa 1)) ÿa) -- 255 is not -1 = EOF */
- if (c1 == '\n')
- port_line_number(pt)++;
- if (c1 == 0)
+ /* check for simple cases first */
+ if (is_pair(top))
+ {
+ if (s7_list_length(sc, top) != 0) /* it is not circular at the top level (following cdr), so we can check each car(x) */
+ {
+ s7_pointer x;
+ for (x = top; is_pair(x); x = cdr(x))
+ if (has_structure(car(x)))
{
- port_string_point(pt) += (str - orig_str - 1);
- return(missing_close_paren_error(sc));
+ /* it can help a little in some cases to scan vectors here (and slots):
+ * if no element has structure, it's ok (maybe also hash_table_entries == 0)
+ */
+ no_problem = false;
+ break;
}
- port_string_point(pt) += (str - orig_str);
- c = c1;
- }
+ if ((no_problem) &&
+ (!is_null(x)) &&
+ (has_structure(x)))
+ no_problem = false;
- switch (c)
- {
- case '(':
- sc->tok = TOKEN_LEFT_PAREN;
- break;
-
- case ')':
- sc->tok = TOKEN_RIGHT_PAREN;
- break;
-
- case '.':
- sc->tok = read_dot(sc, pt);
- break;
-
- case '\'':
- sc->tok = TOKEN_QUOTE;
- break;
-
- case ';':
- sc->tok = read_semicolon(sc, pt);
- break;
-
- case '"':
- sc->tok = TOKEN_DOUBLE_QUOTE;
- break;
-
- case '`':
- sc->tok = TOKEN_BACK_QUOTE;
- break;
-
- case ',':
- sc->tok = read_comma(sc, pt);
- break;
-
- case '#':
- sc->tok = read_sharp(sc, pt);
- break;
-
- default:
- sc->strbuf[0] = c;
- /* sc->tok = TOKEN_ATOM; */
- sc->value = read_delimited_string(sc, NO_SHARP);
- goto READ_LIST;
- break;
- }
- }
-
- switch (sc->tok)
- {
- case TOKEN_RIGHT_PAREN:
- if (sc->args == sc->NIL)
- sc->value = sc->NIL;
- else
- {
- sc->value = safe_reverse_in_place(sc, sc->args);
- if (sc->input_port != sc->NIL)
- pair_line_number(sc->value) = port_line_number(sc->input_port) | (port_file_number(sc->input_port) << 20);
-
- /* read-time macro expansion
- *
- * (defmacro hi (a) (format #t "hi...") `(+ ,a 1))
- * (define (ho b) (+ 1 (hi b)))
- *
- * here sc->value is: (ho b), (hi b), (+ 1 (hi b)), (define (ho b) (+ 1 (hi b)))
- *
- * but... first we can't tell for sure at this point that "hi" really is a macro
- *
- * (letrec ((hi ... (hi...))) will be confused about the 2nd hi,
- * or (call/cc (lambda (hi) (hi 1))) etc.
- *
- * second, figuring out that we're quoted is not easy -- we have to march all the
- * way to the bottom of the stack looking for op_read_quote or op_read_vector
- *
- * #(((hi)) 2) or '(((hi)))
- *
- * or op_read_list with args not equal (quote) or (macroexapand)
- *
- * '(hi 3) or (macroexpand (hi 3) or (quote (hi 3))
- *
- * and those are only the problems I noticed!
- *
- * The hardest of these problems involve shadowing, so Rick asked for "define-expansion"
- * which is just like define-macro, but the programmer guarantees that the macro
- * name will not be shadowed. So I'll also assume that the other funny cases are
- * being avoided -- see what happens!
- *
- * (define-expansion (hi a) `(+ ,a 1))
- * (define (ho b) (+ 1 (hi b)))
- * (procedure-source ho) -> (lambda (b) (+ 1 (+ b 1)))
- */
-
- if (is_expansion(car(sc->value)))
- {
- int loc;
- loc = s7_stack_top(sc) - 1;
- if ((loc >= 3) &&
- ((int)stack_op(sc->stack, loc) != OP_READ_QUOTE) && /* '(hi 1) for example */
- (car(stack_args(sc->stack, loc)) != sc->QUOTE) && /* (quote (hi 1)) */
- (car(stack_args(sc->stack, loc)) != sc->MACROEXPAND)) /* (macroexpand (hi 1)) */
- {
- s7_pointer x;
- x = symbol_value(find_symbol(sc, sc->envir, car(sc->value)));
- sc->args = make_list_1(sc, sc->value);
- sc->code = x;
- goto APPLY;
- }
- }
- }
- break;
-
- case TOKEN_EOF:
- /* can't happen, I believe */
- return(missing_close_paren_error(sc));
-
- case TOKEN_ATOM:
- sc->value = read_delimited_string(sc, NO_SHARP);
- goto READ_LIST;
- break;
-
- case TOKEN_SHARP_CONST:
- sc->value = read_delimited_string(sc, WITH_SHARP);
- if (sc->value == sc->NIL)
- return(read_error(sc, "undefined # expression"));
- goto READ_LIST;
- break;
-
- case TOKEN_DOUBLE_QUOTE:
- sc->value = read_string_constant(sc, sc->input_port);
- if (sc->value == sc->F) /* can happen if input code ends in the middle of a string */
- return(read_error(sc, "end of input encountered while in a string"));
- if (sc->value == sc->T)
- return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
- goto READ_LIST;
- break;
-
- case TOKEN_DOT:
- push_stack(sc, opcode(OP_READ_DOT), sc->args, sc->NIL);
- sc->tok = token(sc);
- sc->value = read_expression(sc);
- break;
-
- default:
- /* by far the main case here is TOKEN_LEFT_PAREN, but it doesn't save anything to move it to this level */
- push_stack(sc, opcode(OP_READ_LIST), sc->args, sc->NIL);
- sc->value = read_expression(sc);
- break;
+ if (no_problem)
+ return(NULL);
}
- goto START;
-
-
- case OP_READ_DOT:
- if (token(sc) != TOKEN_RIGHT_PAREN)
+ }
+ else
+ {
+ if (s7_is_vector(top))
{
- back_up_stack(sc);
- read_error(sc, "stray dot?"); /* (+ 1 . 2 3) or (list . ) */
- }
- /* args = previously read stuff, value = thing just after the dot and before the ')':
- * (list 1 2 . 3)
- * value: 3, args: (2 1 list)
- * '(1 . 2)
- * value: 2, args: (1)
- *
- * but we also get here in a lambda arg list:
- * (lambda (a b . c) #f)
- * value: c, args: (b a)
- *
- * so we have to leave any error checks until later, I guess
- * -- in eval_args1, if we end with non-pair-not-nil then
- * something is fishy
- */
- sc->value = reverse_in_place(sc, sc->value, sc->args);
- goto START;
-
-
- case OP_READ_QUOTE:
- sc->value = make_list_2(sc, sc->QUOTE, sc->value);
- goto START;
-
-
- case OP_READ_QUASIQUOTE:
- /* this was pushed when the backquote was seen, then eventually we popped back to it */
- sc->value = g_quasiquote_1(sc, sc->value);
- goto START;
-
-
- case OP_READ_VECTOR:
- if (!is_proper_list(sc, sc->value)) /* #(1 . 2) */
- return(read_error(sc, "vector constant data is not a proper list"));
-
- if (sc->args == small_int(1))
- sc->value = g_vector(sc, sc->value);
- else sc->value = g_multivector(sc, (int)s7_integer(sc->args), sc->value);
- goto START;
-
-
- case OP_READ_QUASIQUOTE_VECTOR:
- /* this works only if the quasiquoted list elements can be evaluated in the read-time environment.
- *
- * `#(1 ,@(list 1 2) 4) -> (apply vector ({list} 1 ({apply} {values} (list 1 2)) 4)) -> #(1 1 2 4)
- *
- * Originally, I used:
- *
- * sc->value = make_list_3(sc, sc->APPLY, sc->VECTOR, g_quasiquote_1(sc, sc->value));
- * goto START;
- *
- * which means that #(...) makes a vector at read time, but `#(...) is just like (vector ...).
- *
- * :(let ((f1 (lambda () (let ((x 32)) #(x 0))))
- * (f2 (lambda () (let ((x 32)) `#(,x 0)))))
- * (eq? (f1) (f1)))
- * #t
- * :(let ((f1 (lambda () (let ((x 32)) #(x 0))))
- * (f2 (lambda () (let ((x 32)) `#(,x 0)))))
- * (eq? (f2) (f2)))
- * #f
- *
- * The tricky part in s7 is that we might have quasiquoted multidimensional vectors:
- */
- if (sc->args == small_int(1))
- sc->code = make_list_3(sc, sc->APPLY, sc->VECTOR, g_quasiquote_1(sc, sc->value));
- else sc->code = make_list_4(sc, sc->APPLY, sc->MULTIVECTOR, sc->args, g_quasiquote_1(sc, sc->value));
- /* sc->args = sc->NIL; */
- goto EVAL;
+ if (type(top) != T_VECTOR)
+ return(NULL);
-
- case OP_READ_UNQUOTE:
- /* here if sc->value is a constant, the unquote is pointless */
- if ((is_pair(sc->value)) ||
- (s7_is_symbol(sc->value)))
- sc->value = make_list_2(sc, sc->UNQUOTE, sc->value);
- goto START;
-
-
- case OP_READ_APPLY_VALUES:
-#if WITH_UNQUOTE_SPLICING
- sc->value = make_list_2(sc, sc->UNQUOTE_SPLICING, sc->value);
-#else
- sc->value = make_list_2(sc, sc->UNQUOTE, make_list_3(sc, sc->QQ_APPLY, sc->QQ_VALUES, sc->value));
-#endif
- goto START;
-
-
- default:
- return(eval_error(sc, "~A: unknown operator!", s7_make_integer(sc, sc->op))); /* not small_int because it's bogus */
+ for (i = 0; i < vector_length(top); i++)
+ if (has_structure(vector_element(top, i)))
+ {
+ no_problem = false;
+ break;
+ }
+ if (no_problem)
+ return(NULL);
+ }
}
- return(sc->F);
-}
-
-
-
+ ci = new_shared_info(sc);
-/* -------------------------------- threads -------------------------------- */
-
-#if HAVE_PTHREADS
+ /* collect all pointers associated with top */
+ collect_shared_info(sc, ci, top, stop_at_print_length, &cyclic);
-static s7_scheme *clone_s7(s7_scheme *sc, s7_pointer vect)
-{
- int i;
- s7_scheme *new_sc;
+ for (i = 0; i < ci->top; i++)
+ {
+ s7_pointer p;
+ p = ci->objs[i];
+ clear_collected_and_shared(p);
+ }
+ if (!cyclic)
+ return(NULL);
- /* whoever called us has presumably grabbed alloc_lock for the duration */
+ if (!(ci->has_hits))
+ return(NULL);
- new_sc = (s7_scheme *)malloc(sizeof(s7_scheme));
- memcpy((void *)new_sc, (void *)sc, sizeof(s7_scheme));
-
- /* share the heap, symbol table and global environment, protected objects list, and all the startup stuff (all via the memcpy),
- * but have separate stacks and eval locals (and GC temps)
- */
-
- new_sc->longjmp_ok = false;
- new_sc->strbuf_size = INITIAL_STRBUF_SIZE;
- new_sc->strbuf = (char *)calloc(new_sc->strbuf_size, sizeof(char));
+ ci_objs = ci->objs;
+ ci_refs = ci->refs;
- new_sc->read_line_buf = NULL;
- new_sc->read_line_buf_size = 0;
-
- new_sc->stack = vect;
- new_sc->stack_start = vector_elements(vect);
- new_sc->stack_end = new_sc->stack_start;
- new_sc->stack_size = vector_length(vect);
- new_sc->stack_resize_trigger = (s7_pointer *)(new_sc->stack_start + new_sc->stack_size / 2);
-
- new_sc->w = new_sc->NIL;
- new_sc->x = new_sc->NIL;
- new_sc->y = new_sc->NIL;
- new_sc->z = new_sc->NIL;
- new_sc->code = new_sc->NIL;
- new_sc->args = new_sc->NIL;
- new_sc->value = new_sc->NIL;
- new_sc->cur_code = ERROR_INFO_DEFAULT;
-
- /* should threads share the current ports and associated stack?
- * sc->input_port = sc->NIL;
- * sc->input_port_stack = sc->NIL;
+ /* find if any were referenced twice (once for just being there, so twice=shared)
+ * we know there's at least one such reference because has_hits is true.
*/
-
- new_sc->temps_size = GC_TEMPS_SIZE;
- new_sc->temps_ctr = 0;
- new_sc->temps = (s7_pointer *)malloc(new_sc->temps_size * sizeof(s7_pointer));
- for (i = 0; i < new_sc->temps_size; i++)
- new_sc->temps[i] = new_sc->NIL;
-
- new_sc->no_values = 0;
- new_sc->key_values = sc->NIL;
-
- (*(sc->thread_ids))++; /* in case a spawned thread spawns another, we need this variable to be global to all */
- new_sc->thread_id = (*(sc->thread_ids)); /* for more readable debugging printout -- main thread is thread 0 */
-
- new_sc->default_rng = NULL;
-#if WITH_GMP
- new_sc->default_big_rng = NULL;
-#endif
-
- return(new_sc);
-}
-
-
-static s7_scheme *close_s7(s7_scheme *sc)
-{
- free(sc->strbuf);
- free(sc->temps);
- if (sc->read_line_buf) free(sc->read_line_buf);
- if (sc->default_rng) free(sc->default_rng);
-#if WITH_GMP
- if (sc->default_big_rng) free(sc->default_big_rng);
-#endif
- free(sc);
- return(NULL);
-}
-
-
-static void mark_s7(s7_scheme *sc)
-{
- int i;
- S7_MARK(sc->args);
- S7_MARK(sc->envir);
- S7_MARK(sc->code);
- S7_MARK(sc->cur_code);
- mark_vector(sc->stack, s7_stack_top(sc));
- S7_MARK(sc->value);
- S7_MARK(sc->w);
- S7_MARK(sc->x);
- S7_MARK(sc->y);
- S7_MARK(sc->z);
- for (i = 0; i < sc->temps_size; i++)
- S7_MARK(sc->temps[i]);
- S7_MARK(sc->key_values);
- S7_MARK(sc->input_port);
- S7_MARK(sc->input_port_stack);
- S7_MARK(sc->output_port);
- S7_MARK(sc->error_port);
-}
-
-
-static int thread_tag = 0;
-
-
-pthread_t *s7_thread(s7_pointer obj)
-{
- thred *f;
- f = (thred *)s7_object_value(obj);
- if (f) return(f->thread);
- return(NULL);
-}
-
-
-static char *thread_print(s7_scheme *sc, void *obj)
-{
- char *buf;
- thred *p = (thred *)obj;
- buf = (char *)malloc(32 * sizeof(char));
- snprintf(buf, 32, "#<thread %d>", p->sc->thread_id);
- return(buf);
+ for (i = 0, refs = 0; i < ci->top; i++)
+ if (ci_refs[i] > 0)
+ {
+ set_collected(ci_objs[i]);
+ if (i == refs)
+ refs++;
+ else
+ {
+ ci_objs[refs] = ci_objs[i];
+ ci_refs[refs++] = ci_refs[i];
+ ci_refs[i] = 0;
+ ci_objs[i] = NULL;
+ }
+ }
+ ci->top = refs;
+ return(ci);
}
+/* -------------------------------- cyclic-sequences -------------------------------- */
-static void thread_free(void *obj)
+static s7_pointer cyclic_sequences(s7_scheme *sc, s7_pointer obj, bool return_list)
{
- thred *f = (thred *)obj;
- if (f)
+ if (has_structure(obj))
{
- /* pthread_detach(*(f->thread)); */
- free(f->thread);
- f->thread = NULL;
- f->sc = close_s7(f->sc);
- free(f);
+ shared_info *ci;
+ ci = make_shared_info(sc, obj, false); /* false=don't stop at print length (vectors etc) */
+ if (ci)
+ {
+ if (return_list)
+ {
+ int i;
+ s7_pointer lst;
+ sc->w = sc->NIL;
+ for (i = 0; i < ci->top; i++)
+ sc->w = cons(sc, ci->objs[i], sc->w);
+ lst = sc->w;
+ sc->w = sc->NIL;
+ return(lst);
+ }
+ else return(sc->T);
+ }
}
+ return(sc->NIL);
}
+static s7_pointer g_cyclic_sequences(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cyclic_sequences "(cyclic-sequences obj) returns a list of elements that are cyclic."
+ #define Q_cyclic_sequences s7_make_signature(sc, 2, sc->IS_LIST, sc->T)
+ return(cyclic_sequences(sc, car(args), true));
+}
-static void thread_mark(void *val)
+static int circular_list_entries(s7_pointer lst)
{
- thred *f = (thred *)val;
- if ((f) && (f->sc)) /* possibly still in make_thread */
+ int i;
+ s7_pointer x;
+ for (i = 1, x = cdr(lst); ; i++, x = cdr(x))
{
- mark_s7(f->sc);
- S7_MARK(f->func);
+ int j;
+ s7_pointer y;
+ for (y = lst, j = 0; j < i; y = cdr(y), j++)
+ if (x == y)
+ return(i);
}
}
-static bool thread_equal(void *obj1, void *obj2)
-{
- return(obj1 == obj2);
-}
-
+static void object_to_port_with_circle_check(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info *ci);
+static void object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci);
+static s7_pointer object_out(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice);
-static void *run_thread_func(void *obj)
+static char *multivector_indices_to_string(s7_scheme *sc, s7_int index, s7_pointer vect, char *str, int cur_dim)
{
- thred *f;
- f = (thred *)s7_object_value((s7_pointer)obj);
- return((void *)s7_call(f->sc, f->func, f->sc->NIL));
-}
+ s7_int size, ind;
+ char buf[64];
+ size = vector_dimension(vect, cur_dim);
+ ind = index % size;
+ if (cur_dim > 0)
+ multivector_indices_to_string(sc, (index - ind) / size, vect, str, cur_dim - 1);
-s7_scheme *s7_thread_s7(s7_pointer obj)
-{
- thred *f;
- f = (thred *)s7_object_value(obj);
- return(f->sc);
+ snprintf(buf, 64, " %lld", ind);
+#ifdef __OpenBSD__
+ strlcat(str, buf, 128); /* 128=length of str */
+#else
+ strcat(str, buf);
+#endif
+ return(str);
}
-void *s7_thread_data(s7_pointer obj)
-{
- thred *f;
- f = (thred *)s7_object_value(obj);
- return(f->data);
-}
-
-
-static s7_pointer s7_make_thread_1(s7_scheme *sc, void *(*func)(void *obj), void *data, s7_pointer scheme_func, bool local, int stack_size)
+static int multivector_to_port(s7_scheme *sc, s7_pointer vec, s7_pointer port,
+ int out_len, int flat_ref, int dimension, int dimensions, bool *last,
+ use_write_t use_write, shared_info *ci)
{
- thred *f;
- s7_pointer obj, vect, frame;
- int floc, vloc, oloc;
-
- if (local)
- frame = new_frame_in_env(sc, sc->envir);
- else frame = sc->envir;
-
- floc = s7_gc_protect(sc, frame);
- vect = s7_make_vector(sc, stack_size);
- vloc = s7_gc_protect(sc, vect);
-
- f = (thred *)calloc(1, sizeof(thred));
- f->func = scheme_func;
-
- obj = s7_make_object(sc, thread_tag, (void *)f);
- oloc = s7_gc_protect(sc, obj);
- pthread_mutex_lock(&alloc_lock);
-
- f->sc = clone_s7(sc, vect);
- f->sc->envir = frame;
- f->sc->y = obj;
- f->thread = (pthread_t *)malloc(sizeof(pthread_t));
- f->data = data;
+ int i;
- pthread_create(f->thread, NULL, func, (void *)obj);
+ if (use_write != USE_READABLE_WRITE)
+ {
+ if (*last)
+ port_write_string(port)(sc, " (", 2, port);
+ else port_write_character(port)(sc, '(', port);
+ (*last) = false;
+ }
- pthread_mutex_unlock(&alloc_lock);
- s7_gc_unprotect_at(sc, floc);
- s7_gc_unprotect_at(sc, vloc);
- s7_gc_unprotect_at(sc, oloc);
+ for (i = 0; i < vector_dimension(vec, dimension); i++)
+ {
+ if (dimension == (dimensions - 1))
+ {
+ if (flat_ref < out_len)
+ {
+ if (use_write == USE_READABLE_WRITE)
+ {
+ int plen;
+ char buf[128];
+ char *indices;
+ /* need to translate flat_ref into a set of indices
+ */
+ tmpbuf_calloc(indices, 128);
+ plen = snprintf(buf, 128, "(set! ({v}%s) ", multivector_indices_to_string(sc, flat_ref, vec, indices, dimension));
+ port_write_string(port)(sc, buf, plen, port);
+ tmpbuf_free(indices, 128);
+ }
+ object_to_port_with_circle_check(sc, vector_element(vec, flat_ref), port, DONT_USE_DISPLAY(use_write), ci);
- return(obj);
+ if (use_write == USE_READABLE_WRITE)
+ port_write_string(port)(sc, ") ", 2, port);
+ flat_ref++;
+ }
+ else
+ {
+ port_write_string(port)(sc, "...)", 4, port);
+ return(flat_ref);
+ }
+ if ((use_write != USE_READABLE_WRITE) &&
+ (i < (vector_dimension(vec, dimension) - 1)))
+ port_write_character(port)(sc, ' ', port);
+ }
+ else
+ {
+ if (flat_ref < out_len)
+ flat_ref = multivector_to_port(sc, vec, port, out_len, flat_ref, dimension + 1, dimensions, last, DONT_USE_DISPLAY(use_write), ci);
+ else
+ {
+ port_write_string(port)(sc, "...)", 4, port);
+ return(flat_ref);
+ }
+ }
+ }
+ if (use_write != USE_READABLE_WRITE)
+ port_write_character(port)(sc, ')', port);
+ (*last) = true;
+ return(flat_ref);
}
-/* (define hi (make-thread (lambda () (display "hi")))) */
-
-static s7_pointer g_make_thread(s7_scheme *sc, s7_pointer args)
+static void vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- #define H_make_thread "(make-thread thunk (initial-stack-size 300)) creates a new thread running thunk"
- int stack_size = 300;
-
- if (!is_procedure(car(args)))
- return(s7_wrong_type_arg_error(sc, "make-thread", (cdr(args) == sc->NIL) ? 0 : 1, car(args), "a thunk"));
+ s7_int i, len;
+ int plen;
+ bool too_long = false;
+ char buf[128];
- if (cdr(args) != sc->NIL)
+ len = vector_length(vect);
+ if (len == 0)
{
- if (!s7_is_integer(cadr(args)))
- return(s7_wrong_type_arg_error(sc, "make-thread stack-size", 2, cadr(args), "an integer"));
- stack_size = s7_integer(cadr(args));
+ if (vector_rank(vect) > 1)
+ {
+ plen = snprintf(buf, 32, "#%uD()", vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else port_write_string(port)(sc, "#()", 3, port);
+ return;
}
-
- return(s7_make_thread_1(sc, run_thread_func, NULL, car(args), true, stack_size));
-}
+ if (use_write != USE_READABLE_WRITE)
+ {
+ plen = sc->print_length;
+ if (plen <= 0)
+ {
+ if (vector_rank(vect) > 1)
+ {
+ plen = snprintf(buf, 32, "#%uD(...)", vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else port_write_string(port)(sc, "#(...)", 6, port);
+ return;
+ }
-s7_pointer s7_make_thread(s7_scheme *sc, void *(*func)(void *obj), void *func_obj, bool local)
-{
- return(s7_make_thread_1(sc, func, func_obj, sc->F, local, 300));
-}
+ if (len > plen)
+ {
+ too_long = true;
+ len = plen;
+ }
+ }
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if ((ci) &&
+ (peek_shared_ref(ci, vect) != 0))
+ {
+ port_write_string(port)(sc, "(let (({v} (make-vector ", 24, port);
+ if (vector_rank(vect) > 1)
+ {
+ unsigned int dim;
+ port_write_string(port)(sc, "'(", 2, port);
+ for (dim = 0; dim < vector_ndims(vect); dim++)
+ {
+ plen = snprintf(buf, 128, "%lld ", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ port_write_string(port)(sc, ")))) ", 5, port);
+ }
+ else
+ {
+ plen = snprintf(buf, 128, "%lld))) ", vector_length(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ if (shared_ref(ci, vect) < 0)
+ {
+ plen = snprintf(buf, 128, "(set! {%d} {v}) ", -shared_ref(ci, vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+
+ if (vector_rank(vect) > 1)
+ {
+ bool last = false;
+ multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, use_write, ci);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ {
+ port_write_string(port)(sc, "(set! ({v} ", 11, port);
+ plen = snprintf(buf, 128, "%lld) ", i);
+ port_write_string(port)(sc, buf, plen, port);
+ object_to_port_with_circle_check(sc, vector_element(vect, i), port, use_write, ci);
+ port_write_string(port)(sc, ") ", 2, port);
+ }
+ }
+ port_write_string(port)(sc, "{v})", 4, port);
+ }
+ else /* simple readable case */
+ {
+ if (vector_rank(vect) > 1)
+ port_write_string(port)(sc, "(make-shared-vector (vector", 27, port);
+ else port_write_string(port)(sc, "(vector", 7, port);
-bool s7_is_thread(s7_pointer obj)
-{
- return((is_c_object(obj)) &&
- (c_object_type(obj) == thread_tag));
-}
+ for (i = 0; i < len; i++)
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, vector_element(vect, i), port, use_write, ci);
+ }
+ port_write_character(port)(sc, ')', port);
+ if (vector_rank(vect) > 1)
+ {
+ unsigned int dim;
+ port_write_string(port)(sc, " '(", 3, port);
+ for (dim = 0; dim < vector_ndims(vect) - 1; dim++)
+ {
+ plen = snprintf(buf, 128, "%lld ", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ plen = snprintf(buf, 128, "%lld", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
+ port_write_string(port)(sc, "))", 2, port);
+ }
+ }
+ }
+ else
+ {
+ if (vector_rank(vect) > 1)
+ {
+ bool last = false;
+ if (vector_ndims(vect) > 1)
+ {
+ plen = snprintf(buf, 32, "#%uD", vector_ndims(vect));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ else port_write_character(port)(sc, '#', port);
+ multivector_to_port(sc, vect, port, len, 0, 0, vector_ndims(vect), &last, use_write, ci);
+ }
+ else
+ {
+ port_write_string(port)(sc, "#(", 2, port);
+ for (i = 0; i < len - 1; i++)
+ {
+ object_to_port_with_circle_check(sc, vector_element(vect, i), port, DONT_USE_DISPLAY(use_write), ci);
+ port_write_character(port)(sc, ' ', port);
+ }
+ object_to_port_with_circle_check(sc, vector_element(vect, i), port, DONT_USE_DISPLAY(use_write), ci);
-static s7_pointer g_is_thread(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_thread "(thread? obj) returns #t if obj is a thread object"
- return(make_boolean(sc, s7_is_thread(car(args))));
+ if (too_long)
+ port_write_string(port)(sc, " ...)", 5, port);
+ else port_write_character(port)(sc, ')', port);
+ }
+ }
}
-
-static s7_pointer g_join_thread(s7_scheme *sc, s7_pointer args)
+static bool string_needs_slashification(const char *str, int len)
{
- #define H_join_thread "(join-thread thread) causes the current thread to wait for the thread to finish. It \
-returns the value returned by the thread function."
- thred *f;
- if (!s7_is_thread(car(args)))
- return(s7_wrong_type_arg_error(sc, "join-thread", 0, car(args), "a thread"));
-
- f = (thred *)s7_object_value(car(args));
- pthread_join(*(f->thread), NULL);
- return(f->sc->value);
+ /* we have to go by len (str len) not *s==0 because s7 strings can have embedded nulls */
+ unsigned char *p, *pend;
+ pend = (unsigned char *)(str + len);
+ for (p = (unsigned char *)str; p < pend; p++)
+ if (slashify_table[*p])
+ return(true);
+ return(false);
}
+#define IN_QUOTES true
+#define NOT_IN_QUOTES false
-static s7_pointer thread_environment(s7_scheme *sc, s7_pointer obj)
+static char *slashify_string(s7_scheme *sc, const char *p, int len, bool quoted, int *nlen) /* do not free result */
{
- thred *f;
- f = (thred *)s7_object_value(obj);
- if ((f) && (f->sc) && (f->sc->envir))
- return(f->sc->envir);
- return(sc->NIL);
-}
-
+ int j = 0, cur_size, size;
+ char *s;
+ unsigned char *pcur, *pend;
+ pend = (unsigned char *)(p + len);
+ size = len + 256;
+ if (size > sc->slash_str_size)
+ {
+ if (sc->slash_str) free(sc->slash_str);
+ sc->slash_str_size = size;
+ sc->slash_str = (char *)malloc(size);
+ }
+ else size = sc->slash_str_size;
+ cur_size = size - 2;
-/* -------- locks -------- */
+ /* memset((void *)sc->slash_str, 0, size); */
+ s = sc->slash_str;
-static int lock_tag = 0;
+ if (quoted) s[j++] = '"';
+ /* what about the trailing nulls? Guile writes them out (as does s7 currently)
+ * but that is not ideal. I'd like to use ~S for error messages, so that
+ * strings are clearly identified via the double-quotes, but this way of
+ * writing them is ugly:
+ *
+ * :(let ((str (make-string 8 #\null))) (set! (str 0) #\a) str)
+ * "a\x00\x00\x00\x00\x00\x00\x00"
+ *
+ * but it would be misleading to omit them because:
+ *
+ * :(let ((str (make-string 8 #\null))) (set! (str 0) #\a) (string-append str "bc"))
+ * "a\x00\x00\x00\x00\x00\x00\x00bc"
+ */
-pthread_mutex_t *s7_lock(s7_pointer obj)
-{
- return((pthread_mutex_t *)s7_object_value(obj));
-}
+ for (pcur = (unsigned char *)p; pcur < pend; pcur++)
+ {
+ if (slashify_table[*pcur])
+ {
+ s[j++] = '\\';
+ switch (*pcur)
+ {
+ case '"':
+ s[j++] = '"';
+ break;
+ case '\\':
+ s[j++] = '\\';
+ break;
-static char *lock_print(s7_scheme *sc, void *obj)
-{
- char *buf;
- buf = (char *)malloc(64 * sizeof(char));
- snprintf(buf, 64, "#<lock %p>", obj);
- return(buf);
+ default: /* this is the "\x01" stuff */
+ {
+ unsigned int n;
+ static char dignum[] = "0123456789abcdef";
+ s[j++] = 'x';
+ n = (unsigned int)(*pcur);
+ if (n < 16)
+ s[j++] = '0';
+ else s[j++] = dignum[(n / 16) % 16];
+ s[j++] = dignum[n % 16];
+ }
+ break;
+ }
+ }
+ else s[j++] = *pcur;
+ if (j >= cur_size) /* even with 256 extra, we can overflow (for example, inordinately many tabs in ALSA output) */
+ {
+ /* int k; */
+ size *= 2;
+ sc->slash_str = (char *)realloc(sc->slash_str, size * sizeof(char));
+ sc->slash_str_size = size;
+ cur_size = size - 2;
+ s = sc->slash_str;
+ /* for (k = j; k < size; k++) s[k] = 0; */
+ }
+ }
+ if (quoted) s[j++] = '"';
+ s[j] = '\0';
+ (*nlen) = j;
+ return(s);
}
-
-static void lock_free(void *obj)
+static void output_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
{
- pthread_mutex_t *lock = (pthread_mutex_t *)obj;
- if (lock)
+ if ((obj == sc->standard_output) ||
+ (obj == sc->standard_error))
+ port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
+ else
{
- pthread_mutex_destroy(lock);
- free(lock);
+ int nlen;
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if (port_is_closed(obj))
+ port_write_string(port)(sc, "(let ((p (open-output-string))) (close-output-port p) p)", 56, port);
+ else
+ {
+ char *str;
+ if (is_string_port(obj))
+ {
+ port_write_string(port)(sc, "(let ((p (open-output-string)))", 31, port);
+ if (port_position(obj) > 0)
+ {
+ port_write_string(port)(sc, " (display ", 10, port);
+ str = slashify_string(sc, (const char *)port_data(obj), port_position(obj), IN_QUOTES, &nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ port_write_string(port)(sc, " p)", 3, port);
+ }
+ port_write_string(port)(sc, " p)", 3, port);
+ }
+ else
+ {
+ str = (char *)malloc(256 * sizeof(char));
+ nlen = snprintf(str, 256, "(open-output-file \"%s\" \"a\")", port_filename(obj));
+ port_write_string(port)(sc, str, nlen, port);
+ free(str);
+ }
+ }
+ }
+ else
+ {
+ if (is_string_port(obj))
+ port_write_string(port)(sc, "<output-string-port", 19, port);
+ else
+ {
+ if (is_file_port(obj))
+ port_write_string(port)(sc, "<output-file-port", 17, port);
+ else port_write_string(port)(sc, "<output-function-port", 21, port);
+ }
+ if (port_is_closed(obj))
+ port_write_string(port)(sc, " (closed)>", 10, port);
+ else port_write_character(port)(sc, '>', port);
+ }
}
}
-
-static bool lock_equal(void *obj1, void *obj2)
+static void input_port_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
{
- return(obj1 == obj2);
+ if (obj == sc->standard_input)
+ port_write_string(port)(sc, port_filename(obj), port_filename_length(obj), port);
+ else
+ {
+ int nlen = 0;
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if (port_is_closed(obj))
+ port_write_string(port)(sc, "(call-with-input-string \"\" (lambda (p) p))", 42, port);
+ else
+ {
+ if (is_function_port(obj))
+ port_write_string(port)(sc, "#<function input port>", 22, port);
+ else
+ {
+ char *str;
+ if (is_file_port(obj))
+ {
+ str = (char *)malloc(256 * sizeof(char));
+ nlen = snprintf(str, 256, "(open-input-file \"%s\")", port_filename(obj));
+ port_write_string(port)(sc, str, nlen, port);
+ free(str);
+ }
+ else
+ {
+ /* if the string is large, slashify_string is a problem. Usually this is actually
+ * a file port where the contents were read in one (up to 5MB) gulp, so the
+ * readable version could be: open file, read-char to the current port_position.
+ * s7_port_filename(port) has the char* name if any.
+ */
+ int data_len;
+ data_len = port_data_size(obj) - port_position(obj);
+ if (data_len > 100)
+ {
+ const char *filename;
+ filename = (const char *)s7_port_filename(obj);
+ if (filename)
+ {
+ #define DO_STR_LEN 1024
+ char *do_str;
+ int len;
+ do_str = (char *)malloc(DO_STR_LEN * sizeof(char));
+ if (port_position(obj) > 0)
+ {
+ len = snprintf(do_str, DO_STR_LEN, "(let ((port (open-input-file \"%s\")))", filename);
+ port_write_string(port)(sc, do_str, len, port);
+ len = snprintf(do_str, DO_STR_LEN, " (do ((i 0 (+ i 1)) (c (read-char port) (read-char port))) ((= i %d) port)))",
+ port_position(obj) - 1);
+ }
+ else len = snprintf(do_str, DO_STR_LEN, "(open-input-file \"%s\")", filename);
+ port_write_string(port)(sc, do_str, len, port);
+ free(do_str);
+ return;
+ }
+ }
+ port_write_string(port)(sc, "(open-input-string ", 19, port);
+ /* not port_write_string here because there might be embedded double-quotes */
+ str = slashify_string(sc, (const char *)(port_data(obj) + port_position(obj)), port_data_size(obj) - port_position(obj), IN_QUOTES, &nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ port_write_character(port)(sc, ')', port);
+ }
+ }
+ }
+ }
+ else
+ {
+ if (is_string_port(obj))
+ port_write_string(port)(sc, "<input-string-port", 18, port);
+ else
+ {
+ if (is_file_port(obj))
+ port_write_string(port)(sc, "<input-file-port", 16, port);
+ else port_write_string(port)(sc, "<input-function-port", 20, port);
+ }
+ if (port_is_closed(obj))
+ port_write_string(port)(sc, " (closed)>", 10, port);
+ else port_write_character(port)(sc, '>', port);
+ }
+ }
}
-
-bool s7_is_lock(s7_pointer obj)
+static bool symbol_needs_slashification(s7_pointer obj)
{
- return((is_c_object(obj)) &&
- (c_object_type(obj) == lock_tag));
+ unsigned char *p, *pend;
+ const char *str;
+ int len;
+ str = symbol_name(obj);
+ if (str[0] == '#')
+ return(true);
+ len = symbol_name_length(obj);
+ pend = (unsigned char *)(str + len);
+ for (p = (unsigned char *)str; p < pend; p++)
+ if (symbol_slashify_table[*p])
+ return(true);
+ set_clean_symbol(obj);
+ return(false);
}
-
-static s7_pointer g_is_lock(s7_scheme *sc, s7_pointer args)
+static void symbol_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
{
- #define H_is_lock "(lock? obj) returns #t if obj is a lock (mutex) object"
- return(make_boolean(sc, s7_is_lock(car(args))));
+ /* I think this is the only place we print a symbol's name
+ * but in the readable case, what about (symbol "1;3")? it actually seems ok!
+ */
+ if ((!is_clean_symbol(obj)) &&
+ (symbol_needs_slashification(obj)))
+ {
+ int nlen = 0;
+ char *str, *symstr;
+ str = slashify_string(sc, symbol_name(obj), symbol_name_length(obj), NOT_IN_QUOTES, &nlen);
+ nlen += 16;
+ tmpbuf_malloc(symstr, nlen);
+ nlen = snprintf(symstr, nlen, "(symbol \"%s\")", str);
+ port_write_string(port)(sc, symstr, nlen, port);
+ tmpbuf_free(symstr, nlen);
+ }
+ else
+ {
+ if ((use_write == USE_READABLE_WRITE) &&
+ (!is_keyword(obj)))
+ port_write_character(port)(sc, '\'', port);
+ if (is_string_port(port))
+ {
+ int new_len;
+ new_len = port_position(port) + symbol_name_length(obj);
+ if (new_len >= (int)port_data_size(port))
+ resize_port_data(port, new_len * 2);
+ memcpy((void *)(port_data(port) + port_position(port)), (void *)symbol_name(obj), symbol_name_length(obj));
+ port_position(port) = new_len;
+ }
+ else port_write_string(port)(sc, symbol_name(obj), symbol_name_length(obj), port);
+ }
}
-
-s7_pointer s7_make_lock(s7_scheme *sc)
+static void string_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
{
- pthread_mutex_t *lock;
- lock = (pthread_mutex_t *)malloc(sizeof(pthread_mutex_t));
- pthread_mutex_init(lock, NULL);
- return(s7_make_object(sc, lock_tag, (void *)lock));
+ if (string_length(obj) > 0)
+ {
+ /* this used to check for length > 1<<24 -- is that still necessary?
+ * since string_length is a scheme length, not C, this write can embed nulls from C's point of view
+ */
+ if (use_write == USE_DISPLAY)
+ port_write_string(port)(sc, string_value(obj), string_length(obj), port);
+ else
+ {
+ if (!string_needs_slashification(string_value(obj), string_length(obj)))
+ {
+ port_write_character(port)(sc, '"', port);
+ port_write_string(port)(sc, string_value(obj), string_length(obj), port);
+ port_write_character(port)(sc, '"', port);
+ }
+ else
+ {
+ char *str;
+ int nlen = 0;
+ str = slashify_string(sc, string_value(obj), string_length(obj), IN_QUOTES, &nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ }
+ }
+ }
+ else
+ {
+ if (use_write != USE_DISPLAY)
+ port_write_string(port)(sc, "\"\"", 2, port);
+ }
}
-
-static s7_pointer g_make_lock(s7_scheme *sc, s7_pointer args)
+static void byte_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write)
{
- #define H_make_lock "(make-lock) creates a new lock (mutex variable)"
- return(s7_make_lock(sc));
-}
+ s7_int i, len;
+ int plen;
+ bool too_long = false;
+ len = string_length(vect);
+ if (use_write == USE_READABLE_WRITE)
+ plen = len;
+ else plen = sc->print_length;
-static s7_pointer g_grab_lock(s7_scheme *sc, s7_pointer args)
-{
- #define H_grab_lock "(grab-lock lock) stops the current thread until it can grab the lock."
- if (g_is_lock(sc, args) == sc->F)
- return(s7_wrong_type_arg_error(sc, "grab-lock", 0, car(args), "a lock (mutex)"));
+ if (len == 0)
+ port_write_string(port)(sc, "#u8()", 5, port);
+ else
+ {
+ if (plen <= 0)
+ port_write_string(port)(sc, "#u8(...)", 8, port);
+ else
+ {
+ unsigned int nlen;
+ char *p;
+ if (len > plen)
+ {
+ too_long = true;
+ len = plen;
+ }
+ port_write_string(port)(sc, "#u8(", 4, port);
+ for (i = 0; i < len - 1; i++)
+ {
+ p = pos_int_to_str((int)((unsigned char)string_value(vect)[i]), &nlen, ' ');
+ port_write_string(port)(sc, p, nlen - 1, port);
+ }
+ p = pos_int_to_str((int)((unsigned char)string_value(vect)[i]), &nlen, (too_long) ? '\0' : ')');
+ port_write_string(port)(sc, p, nlen - 1, port);
- return(s7_make_integer(sc, pthread_mutex_lock((pthread_mutex_t *)s7_object_value(car(args)))));
+ if (too_long)
+ port_write_string(port)(sc, " ...)", 5, port);
+ }
+ }
}
-static s7_pointer g_release_lock(s7_scheme *sc, s7_pointer args)
+static void int_or_float_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port, use_write_t use_write)
{
- #define H_release_lock "(release-lock lock) releases the lock"
- if (g_is_lock(sc, args) == sc->F)
- return(s7_wrong_type_arg_error(sc, "release-lock", 0, car(args), "a lock (mutex)"));
+ s7_int i, len;
+ int plen;
+ bool too_long = false;
- return(s7_make_integer(sc, pthread_mutex_unlock((pthread_mutex_t *)s7_object_value(car(args)))));
-}
+ len = vector_length(vect);
+ if (use_write == USE_READABLE_WRITE)
+ plen = len;
+ else plen = sc->print_length;
+ if (len == 0)
+ port_write_string(port)(sc, "#()", 3, port);
+ else
+ {
+ if (plen <= 0)
+ port_write_string(port)(sc, "#(...)", 6, port);
+ else
+ {
+ char buf[128];
+ if (len > plen)
+ {
+ too_long = true;
+ len = plen;
+ }
+ if (is_int_vector(vect))
+ {
+ if (vector_rank(vect) > 1)
+ port_write_string(port)(sc, "(make-shared-vector (int-vector", 31, port);
+ else port_write_string(port)(sc, "(int-vector", 11, port);
+ if (!is_string_port(port))
+ {
+ for (i = 0; i < len; i++)
+ {
+ plen = snprintf(buf, 128, " %lld", int_vector_element(vect, i));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ }
+ else
+ {
+ /* an experiment */
+ int new_len, next_len;
+ unsigned char *dbuf;
+ new_len = port_position(port);
+ next_len = port_data_size(port) - 128;
+ dbuf = port_data(port);
+
+ for (i = 0; i < len; i++)
+ {
+ if (new_len >= next_len)
+ {
+ resize_port_data(port, port_data_size(port) * 2);
+ next_len = port_data_size(port) - 128;
+ dbuf = port_data(port);
+ }
+ plen = snprintf((char *)(dbuf + new_len), 128, " %lld", int_vector_element(vect, i));
+ new_len += plen;
+ }
+ port_position(port) = new_len;
+ }
+ }
+ else
+ {
+ if (vector_rank(vect) > 1)
+ port_write_string(port)(sc, "(make-shared-vector (float-vector", 33, port);
+ else port_write_string(port)(sc, "(float-vector", 13, port);
-/* -------- thread variables (pthread keys) -------- */
+ for (i = 0; i < len; i++)
+ {
+ port_write_character(port)(sc, ' ', port);
+ plen = snprintf(buf, 124, float_format_g, float_format_precision, float_vector_element(vect, i)); /* 124 so floatify has room */
+ floatify(buf, &plen);
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ }
-static int key_tag = 0;
+ if (too_long)
+ port_write_string(port)(sc, " ...)", 5, port);
+ else port_write_character(port)(sc, ')', port);
-static void *key_value(s7_pointer obj)
-{
- pthread_key_t *key;
- key = (pthread_key_t *)s7_object_value(obj);
- return(pthread_getspecific(*key)); /* returns NULL if never set */
+ if (vector_rank(vect) > 1)
+ {
+ unsigned int dim;
+ port_write_string(port)(sc, " '(", 3, port);
+ for (dim = 0; dim < vector_ndims(vect) - 1; dim++)
+ {
+ plen = snprintf(buf, 128, "%lld ", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ plen = snprintf(buf, 128, "%lld", vector_dimension(vect, dim));
+ port_write_string(port)(sc, buf, plen, port);
+ port_write_string(port)(sc, "))", 2, port);
+ }
+ }
+ }
}
-static char *key_print(s7_scheme *sc, void *obj)
+static void list_to_port(s7_scheme *sc, s7_pointer lst, s7_pointer port, use_write_t use_write, shared_info *ci)
{
- char *buf, *val_str;
- s7_pointer val;
- int len;
+ /* we need list_to_starboard... */
+ s7_pointer x;
+ int i, len, true_len;
- val = sc->F;
- if (obj)
+ true_len = s7_list_length(sc, lst);
+ if (true_len < 0) /* a dotted list -- handle cars, then final cdr */
+ len = (-true_len + 1);
+ else
{
- val = (s7_pointer)pthread_getspecific(*((pthread_key_t *)obj));
- if (!val)
- val = sc->F;
+ if (true_len == 0) /* either () or a circular list */
+ {
+ if (is_not_null(lst))
+ len = circular_list_entries(lst);
+ else
+ {
+ port_write_string(port)(sc, "()", 2, port);
+ return;
+ }
+ }
+ else len = true_len;
}
- val_str = s7_object_to_c_string(sc, val);
- len = 64 + safe_strlen(val_str);
- buf = (char *)malloc(len * sizeof(char));
- snprintf(buf, len, "#<[thread %d] key: %s>", sc->thread_id, val_str);
- if (val_str) free(val_str);
- return(buf);
-}
-
-
-static void key_free(void *obj)
-{
- pthread_key_t *key = (pthread_key_t *)obj;
- if (key)
+ if (((car(lst) == sc->QUOTE) ||
+ (car(lst) == sc->QUOTE_UNCHECKED)) && /* this can happen (see lint.scm) */
+ (true_len == 2))
{
- pthread_key_delete(*key);
- free(key);
+ /* len == 1 is important, otherwise (list 'quote 1 2) -> '1 2 which looks weird
+ * or (object->string (apply . `''1)) -> "'quote 1"
+ * so (quote x) = 'x but (quote x y z) should be left alone (if evaluated, it's an error)
+ */
+ port_write_character(port)(sc, '\'', port);
+ object_to_port_with_circle_check(sc, cadr(lst), port, USE_WRITE, ci);
+ return;
+ }
+ else port_write_character(port)(sc, '(', port);
+
+ if (is_multiple_value(lst))
+ port_write_string(port)(sc, "values ", 7, port);
+
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if (ci)
+ {
+ int plen;
+ char buf[128];
+
+ port_write_string(port)(sc, "let (({lst} (make-list ", 23, port);
+ plen = snprintf(buf, 128, "%d))) ", len);
+ port_write_string(port)(sc, buf, plen, port);
+
+ if ((shared_ref(ci, lst) < 0))
+ {
+ plen = snprintf(buf, 128, "(set! {%d} {lst}) ", -shared_ref(ci, lst));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+
+ port_write_string(port)(sc, "(let (({x} {lst})) ", 19, port);
+ for (i = 0, x = lst; (i < len) && (is_pair(x)); i++, x = cdr(x))
+ {
+ port_write_string(port)(sc, "(set-car! {x} ", 14, port);
+ object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
+ port_write_string(port)(sc, ") ", 2, port);
+ if (i < len - 1)
+ port_write_string(port)(sc, "(set! {x} (cdr {x})) ", 21, port);
+ }
+ if (!is_null(x))
+ {
+ port_write_string(port)(sc, "(set-cdr! {x} ", 14, port);
+ object_to_port_with_circle_check(sc, x, port, use_write, ci);
+ port_write_string(port)(sc, ") ", 2, port);
+ }
+ port_write_string(port)(sc, ") {lst})", 8, port);
+ }
+ else
+ {
+ /* the easier cases: no circles or shared refs to patch up */
+ if (true_len > 0)
+ {
+ port_write_string(port)(sc, "list", 4, port);
+ for (x = lst; is_pair(x); x = cdr(x))
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
+ }
+ port_write_character(port)(sc, ')', port);
+ }
+ else
+ {
+ port_write_string(port)(sc, "cons ", 5, port);
+ object_to_port_with_circle_check(sc, car(lst), port, use_write, ci);
+ for (x = cdr(lst); is_pair(x); x = cdr(x))
+ {
+ port_write_character(port)(sc, ' ', port);
+ port_write_string(port)(sc, "(cons ", 6, port);
+ object_to_port_with_circle_check(sc, car(x), port, use_write, ci);
+ }
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, x, port, use_write, ci);
+ for (i = 1; i < len; i++)
+ port_write_character(port)(sc, ')', port);
+ }
+ }
+ }
+ else
+ {
+ if (ci)
+ {
+ for (x = lst, i = 0; (is_pair(x)) && (i < len) && ((!ci) || (i == 0) || (peek_shared_ref(ci, x) == 0)); i++, x = cdr(x))
+ {
+ object_to_port_with_circle_check(sc, car(x), port, DONT_USE_DISPLAY(use_write), ci);
+ if (i < (len - 1))
+ port_write_character(port)(sc, ' ', port);
+ }
+ if (is_not_null(x))
+ {
+ if ((true_len == 0) &&
+ (i == len))
+ port_write_string(port)(sc, " . ", 3, port);
+ else port_write_string(port)(sc, ". ", 2, port);
+ object_to_port_with_circle_check(sc, x, port, DONT_USE_DISPLAY(use_write), ci);
+ }
+ port_write_character(port)(sc, ')', port);
+ }
+ else
+ {
+ for (x = lst, i = 0; (is_pair(x)) && (i < len); i++, x = cdr(x))
+ {
+ object_to_port(sc, car(x), port, DONT_USE_DISPLAY(use_write), ci);
+ if (i < (len - 1))
+ port_write_character(port)(sc, ' ', port);
+ }
+ if (is_not_null(x))
+ {
+ port_write_string(port)(sc, ". ", 2, port);
+ object_to_port(sc, x, port, DONT_USE_DISPLAY(use_write), ci);
+ }
+ port_write_character(port)(sc, ')', port);
+ }
+ }
+}
+
+
+static void hash_table_to_port(s7_scheme *sc, s7_pointer hash, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ int i, len, gc_iter;
+ bool too_long = false;
+ s7_pointer iterator, p;
+
+ /* if hash is a member of ci, just print its number
+ * (let ((ht (hash-table '(a . 1)))) (hash-table-set! ht 'b ht))
+ *
+ * since equal? does not care about the hash-table lengths, we can ignore that complication in the :readable case
+ */
+
+ len = hash_table_entries(hash);
+ if (len == 0)
+ {
+ port_write_string(port)(sc, "(hash-table)", 12, port);
+ return;
+ }
+
+ if (use_write != USE_READABLE_WRITE)
+ {
+ s7_int plen;
+ plen = sc->print_length;
+ if (plen <= 0)
+ {
+ port_write_string(port)(sc, "(hash-table ...)", 16, port);
+ return;
+ }
+ if (len > plen)
+ {
+ too_long = true;
+ len = plen;
+ }
+ }
+
+ iterator = s7_make_iterator(sc, hash);
+ gc_iter = s7_gc_protect(sc, iterator);
+ p = cons(sc, sc->F, sc->F);
+ iterator_current(iterator) = p;
+ set_mark_seq(iterator);
+
+ if ((use_write == USE_READABLE_WRITE) &&
+ (ci) &&
+ (peek_shared_ref(ci, hash) != 0))
+ {
+ port_write_string(port)(sc, "(let (({ht} (make-hash-table)))", 31, port);
+ if (shared_ref(ci, hash) < 0)
+ {
+ int plen;
+ char buf[64];
+ plen = snprintf(buf, 64, "(set! {%d} {ht}) ", -shared_ref(ci, hash));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+ for (i = 0; i < len; i++)
+ {
+ s7_pointer key_val, key, val;
+
+ key_val = hash_table_iterate(sc, iterator);
+ key = car(key_val);
+ val = cdr(key_val);
+
+ port_write_string(port)(sc, " (set! ({ht} ", 13, port);
+ if (key == hash)
+ port_write_string(port)(sc, "{ht}", 4, port);
+ else object_to_port_with_circle_check(sc, key, port, USE_READABLE_WRITE, ci);
+ port_write_string(port)(sc, ") ", 2, port);
+ if (val == hash)
+ port_write_string(port)(sc, "{ht}", 4, port);
+ else object_to_port_with_circle_check(sc, val, port, USE_READABLE_WRITE, ci);
+ port_write_character(port)(sc, ')', port);
+ }
+ port_write_string(port)(sc, " {ht})", 6, port);
+ }
+ else
+ {
+ port_write_string(port)(sc, "(hash-table", 11, port);
+ for (i = 0; i < len; i++)
+ {
+ s7_pointer key_val;
+ if (use_write == USE_READABLE_WRITE)
+ port_write_character(port)(sc, ' ', port);
+ else port_write_string(port)(sc, " '", 2, port);
+ key_val = hash_table_iterate(sc, iterator);
+ object_to_port_with_circle_check(sc, key_val, port, DONT_USE_DISPLAY(use_write), ci);
+ }
+
+ if (too_long)
+ port_write_string(port)(sc, " ...)", 5, port);
+ else port_write_character(port)(sc, ')', port);
+ }
+
+ s7_gc_unprotect_at(sc, gc_iter);
+}
+
+
+static void slot_to_port_1(s7_scheme *sc, s7_pointer x, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (is_slot(x))
+ {
+ slot_to_port_1(sc, next_slot(x), port, use_write, ci);
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, x, port, use_write, ci);
+ }
+}
+
+static void let_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ /* if outer env points to (say) method list, the object needs to specialize object->string itself
+ */
+ if (has_methods(obj))
+ {
+ s7_pointer print_func;
+ print_func = find_method(sc, obj, sc->OBJECT_TO_STRING);
+ if (print_func != sc->UNDEFINED)
+ {
+ s7_pointer p;
+ /* what needs to be protected here? for one, the function might not return a string! */
+
+ clear_has_methods(obj);
+ if (use_write == USE_WRITE)
+ p = s7_apply_function(sc, print_func, list_1(sc, obj));
+ else p = s7_apply_function(sc, print_func, list_2(sc, obj, (use_write == USE_DISPLAY) ? sc->F : sc->KEY_READABLE));
+ set_has_methods(obj);
+
+ if ((is_string(p)) &&
+ (string_length(p) > 0))
+ port_write_string(port)(sc, string_value(p), string_length(p), port);
+ return;
+ }
+ }
+ if (obj == sc->rootlet)
+ port_write_string(port)(sc, "(rootlet)", 9, port);
+ else
+ {
+ /* circles can happen here:
+ * (let () (let ((b (curlet))) (curlet)))
+ * #<let 'b #<let>>
+ * or (let ((b #f)) (set! b (curlet)) (curlet))
+ * #1=#<let 'b #1#>
+ */
+ if ((use_write == USE_READABLE_WRITE) &&
+ (ci) &&
+ (peek_shared_ref(ci, obj) != 0))
+ {
+ s7_pointer x;
+ port_write_string(port)(sc, "(let (({e} (inlet))) ", 21, port);
+ if ((ci) &&
+ (shared_ref(ci, obj) < 0))
+ {
+ int plen;
+ char buf[64];
+ plen = snprintf(buf, 64, "(set! {%d} {e}) ", -shared_ref(ci, obj));
+ port_write_string(port)(sc, buf, plen, port);
+ }
+
+ port_write_string(port)(sc, "(apply varlet {e} (reverse (list ", 33, port);
+ for (x = let_slots(obj); is_slot(x); x = next_slot(x))
+ {
+ port_write_string(port)(sc, "(cons ", 6, port);
+ symbol_to_port(sc, slot_symbol(x), port, use_write);
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, slot_value(x), port, use_write, ci);
+ port_write_character(port)(sc, ')', port);
+ }
+ port_write_string(port)(sc, "))) {e})", 8, port);
+ }
+ else
+ {
+ port_write_string(port)(sc, "(inlet", 6, port);
+ slot_to_port_1(sc, let_slots(obj), port, use_write, ci);
+ port_write_character(port)(sc, ')', port);
+ }
+ }
+}
+
+
+static void write_macro_readably(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+ s7_pointer arglist, body, expr;
+
+ body = closure_body(obj);
+ arglist = closure_args(obj);
+
+ port_write_string(port)(sc, "(define-", 8, port);
+ port_write_string(port)(sc, ((is_macro(obj)) || (is_macro_star(obj))) ? "macro" : "bacro", 5, port);
+ if ((is_macro_star(obj)) || (is_bacro_star(obj)))
+ port_write_character(port)(sc, '*', port);
+ port_write_string(port)(sc, " (_m_", 5, port);
+ if (is_symbol(arglist))
+ {
+ port_write_string(port)(sc, " . ", 3, port);
+ port_write_string(port)(sc, symbol_name(arglist), symbol_name_length(arglist), port);
+ }
+ else
+ {
+ if (is_pair(arglist))
+ {
+ for (expr = arglist; is_pair(expr); expr = cdr(expr))
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_to_port(sc, car(expr), port, USE_WRITE, NULL);
+ }
+ if (!is_null(expr))
+ {
+ port_write_string(port)(sc, " . ", 3, port);
+ object_to_port(sc, expr, port, USE_WRITE, NULL);
+ }
+ }
+ }
+ port_write_string(port)(sc, ") ", 2, port);
+ for (expr = body; is_pair(expr); expr = cdr(expr))
+ object_to_port(sc, car(expr), port, USE_WRITE, NULL);
+ port_write_character(port)(sc, ')', port);
+}
+
+
+static s7_pointer match_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer e)
+{
+ s7_pointer y, le;
+ for (le = e; is_let(le) && (le != sc->rootlet); le = outlet(le))
+ for (y = let_slots(le); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(y);
+ return(NULL);
+}
+
+static bool slot_memq(s7_pointer symbol, s7_pointer symbols)
+{
+ s7_pointer x;
+ for (x = symbols; is_pair(x); x = cdr(x))
+ if (slot_symbol(car(x)) == symbol)
+ return(true);
+ return(false);
+}
+
+static bool arg_memq(s7_pointer symbol, s7_pointer args)
+{
+ s7_pointer x;
+ for (x = args; is_pair(x); x = cdr(x))
+ if ((car(x) == symbol) ||
+ ((is_pair(car(x))) &&
+ (caar(x) == symbol)))
+ return(true);
+ return(false);
+}
+
+
+static void collect_locals(s7_scheme *sc, s7_pointer body, s7_pointer e, s7_pointer args, int gc_loc)
+{
+ if (is_pair(body))
+ {
+ collect_locals(sc, car(body), e, args, gc_loc);
+ collect_locals(sc, cdr(body), e, args, gc_loc);
+ }
+ else
+ {
+ if ((is_symbol(body)) &&
+ (!arg_memq(body, args)) &&
+ (!slot_memq(body, gc_protected_at(sc, gc_loc))))
+ {
+ s7_pointer slot;
+ slot = match_symbol(sc, body, e);
+ if (slot)
+ gc_protected_at(sc, gc_loc) = cons(sc, slot, gc_protected_at(sc, gc_loc));
+ }
+ }
+}
+
+
+
+static s7_pointer find_closure(s7_scheme *sc, s7_pointer closure, s7_pointer cur_env)
+{
+ s7_pointer e, y;
+ for (e = cur_env; is_let(e); e = outlet(e))
+ {
+ if ((is_function_env(e)) &&
+ (is_global(funclet_function(e))) && /* (define (f1) (lambda () 1)) shouldn't say the returned closure is named f1 */
+ (slot_value(global_slot(funclet_function(e))) == closure))
+ return(funclet_function(e));
+
+ for (y = let_slots(e); is_slot(y); y = next_slot(y))
+ if (slot_value(y) == closure)
+ return(slot_symbol(y));
+ }
+ return(sc->NIL);
+}
+
+static void write_closure_name(s7_scheme *sc, s7_pointer closure, s7_pointer port)
+{
+ s7_pointer x;
+ x = find_closure(sc, closure, closure_let(closure));
+ /* this can be confusing! In some cases, the function is in its environment, and in other very similar-looking cases it isn't:
+ * (let ((a (lambda () 1))) a)
+ * #<lambda ()>
+ * (letrec ((a (lambda () 1))) a)
+ * a
+ * (let () (define (a) 1) a)
+ * a
+ */
+ if (is_symbol(x)) /* after find_closure */
+ {
+ port_write_string(port)(sc, symbol_name(x), symbol_name_length(x), port);
+ return;
+ }
+
+ /* names like #<closure> and #<macro> are useless -- try to be a bit more informative */
+ switch (type(closure))
+ {
+ case T_CLOSURE:
+ port_write_string(port)(sc, "#<lambda ", 9, port);
+ break;
+
+ case T_CLOSURE_STAR:
+ port_write_string(port)(sc, "#<lambda* ", 10, port);
+ break;
+
+ case T_MACRO:
+ if (is_expansion(closure))
+ port_write_string(port)(sc, "#<expansion ", 12, port);
+ else port_write_string(port)(sc, "#<macro ", 8, port);
+ break;
+
+ case T_MACRO_STAR:
+ port_write_string(port)(sc, "#<macro* ", 9, port);
+ break;
+
+ case T_BACRO:
+ port_write_string(port)(sc, "#<bacro ", 8, port);
+ break;
+
+ case T_BACRO_STAR:
+ port_write_string(port)(sc, "#<bacro* ", 9, port);
+ break;
+ }
+
+ if (is_null(closure_args(closure)))
+ port_write_string(port)(sc, "()>", 3, port);
+ else
+ {
+ s7_pointer args;
+ args = closure_args(closure);
+ if (is_symbol(args))
+ {
+ port_write_string(port)(sc, symbol_name(args), symbol_name_length(args), port);
+ port_write_character(port)(sc, '>', port); /* (lambda a a) -> #<lambda a> */
+ }
+ else
+ {
+ port_write_character(port)(sc, '(', port);
+ x = car(args);
+ if (is_pair(x)) x = car(x);
+ port_write_string(port)(sc, symbol_name(x), symbol_name_length(x), port);
+ if (!is_null(cdr(args)))
+ {
+ s7_pointer y;
+ port_write_character(port)(sc, ' ', port);
+ if (is_pair(cdr(args)))
+ {
+ y = cadr(args);
+ if (is_pair(y))
+ y = car(y);
+ else
+ {
+ if (y == sc->KEY_REST)
+ {
+ port_write_string(port)(sc, ":rest ", 6, port);
+ args = cdr(args);
+ y = cadr(args);
+ if (is_pair(y)) y = car(y);
+ }
+ }
+ }
+ else
+ {
+ port_write_string(port)(sc, ". ", 2, port);
+ y = cdr(args);
+ }
+ port_write_string(port)(sc, symbol_name(y), symbol_name_length(y), port);
+ if ((is_pair(cdr(args))) &&
+ (!is_null(cddr(args))))
+ port_write_string(port)(sc, " ...", 4, port);
+ }
+ port_write_string(port)(sc, ")>", 2, port);
+ }
+ }
+}
+
+static s7_pointer closure_name(s7_scheme *sc, s7_pointer closure)
+{
+ /* this is used by the error handlers to get the current function name
+ */
+ s7_pointer x;
+
+ x = find_closure(sc, closure, sc->envir);
+ if (is_symbol(x))
+ return(x);
+
+ if (is_pair(sc->cur_code))
+ return(sc->cur_code);
+
+ return(closure); /* desperation -- the parameter list (caar here) will cause endless confusion in OP_APPLY errors! */
+}
+
+
+static void write_closure_readably_1(s7_scheme *sc, s7_pointer obj, s7_pointer arglist, s7_pointer body, s7_pointer port)
+{
+ s7_int old_print_length;
+ s7_pointer p;
+
+ if (type(obj) == T_CLOSURE_STAR)
+ port_write_string(port)(sc, "(lambda* ", 9, port);
+ else port_write_string(port)(sc, "(lambda ", 8, port);
+
+ if ((is_pair(arglist)) &&
+ (allows_other_keys(arglist)))
+ {
+ sc->temp9 = s7_append(sc, arglist, cons(sc, sc->KEY_ALLOW_OTHER_KEYS, sc->NIL));
+ object_out(sc, sc->temp9, port, USE_WRITE);
+ sc->temp9 = sc->NIL;
+ }
+ else object_out(sc, arglist, port, USE_WRITE); /* here we just want the straight output (a b) not (list 'a 'b) */
+
+ old_print_length = sc->print_length;
+ sc->print_length = 1048576;
+ for (p = body; is_pair(p); p = cdr(p))
+ {
+ port_write_character(port)(sc, ' ', port);
+ object_out(sc, car(p), port, USE_WRITE);
+ }
+ port_write_character(port)(sc, ')', port);
+ sc->print_length = old_print_length;
+}
+
+static void write_closure_readably(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+ s7_pointer body, arglist, pe, local_slots, setter = NULL;
+ int gc_loc;
+
+ body = closure_body(obj);
+ arglist = closure_args(obj);
+ pe = closure_let(obj); /* perhaps check for documentation? */
+
+ gc_loc = s7_gc_protect(sc, sc->NIL);
+ collect_locals(sc, body, pe, arglist, gc_loc); /* collect locals used only here */
+ if (s7_is_dilambda(obj))
+ {
+ setter = closure_setter(obj);
+ if ((!(has_closure_let(setter))) ||
+ (closure_let(setter) != pe))
+ setter = NULL;
+ }
+ if (setter)
+ collect_locals(sc, closure_body(setter), pe, closure_args(setter), gc_loc);
+ local_slots = gc_protected_at(sc, gc_loc);
+
+ if (!is_null(local_slots))
+ {
+ s7_pointer x;
+ port_write_string(port)(sc, "(let (", 6, port);
+ for (x = local_slots; is_pair(x); x = cdr(x))
+ {
+ s7_pointer slot;
+ slot = car(x);
+ port_write_character(port)(sc, '(', port);
+ port_write_string(port)(sc, symbol_name(slot_symbol(slot)), symbol_name_length(slot_symbol(slot)), port);
+ port_write_character(port)(sc, ' ', port);
+ object_out(sc, slot_value(slot), port, USE_WRITE);
+ if (is_null(cdr(x)))
+ port_write_character(port)(sc, ')', port);
+ else port_write_string(port)(sc, ") ", 2, port);
+ }
+ port_write_string(port)(sc, ") ", 2, port);
+ }
+
+ if (setter)
+ port_write_string(port)(sc, "(dilambda ", 10, port);
+
+ write_closure_readably_1(sc, obj, arglist, body, port);
+
+ if (setter)
+ {
+ port_write_character(port)(sc, ' ', port);
+ write_closure_readably_1(sc, setter, closure_args(setter), closure_body(setter), port);
+ port_write_character(port)(sc, ')', port);
+ }
+
+ if (!is_null(local_slots))
+ port_write_character(port)(sc, ')', port);
+ s7_gc_unprotect_at(sc, gc_loc);
+}
+
+
+#if TRAP_SEGFAULT
+#include <signal.h>
+static sigjmp_buf senv; /* global here is not a problem -- it is used only to protect s7_is_valid */
+static volatile sig_atomic_t can_jump = 0;
+static void segv(int ignored) {if (can_jump) siglongjmp(senv, 1);}
+#endif
+
+bool s7_is_valid(s7_scheme *sc, s7_pointer arg)
+{
+ bool result = false;
+ if (!arg) return(false);
+
+#if TRAP_SEGFAULT
+ if (sigsetjmp(senv, 1) == 0)
+ {
+ void (*old_segv)(int sig);
+ can_jump = 1;
+ old_segv = signal(SIGSEGV, segv);
+#endif
+ result = ((!is_free(arg)) &&
+ (type(arg) < NUM_TYPES) &&
+ (arg->hloc >= not_heap) &&
+ ((arg->hloc < 0) ||
+ ((arg->hloc < (int)sc->heap_size) && (sc->heap[arg->hloc] == arg))));
+
+#if TRAP_SEGFAULT
+ signal(SIGSEGV, old_segv);
+ }
+ else result = false;
+ can_jump = 0;
+#endif
+
+ return(result);
+}
+
+enum {NO_ARTICLE, INDEFINITE_ARTICLE};
+
+static char *describe_type_bits(s7_scheme *sc, s7_pointer obj)
+{
+ unsigned int full_typ;
+ unsigned char typ;
+ char *buf;
+
+ buf = (char *)malloc(512 * sizeof(char));
+ typ = unchecked_type(obj);
+ full_typ = typeflag(obj);
+
+ /* if debugging all of these bits are being watched, so we need some ugly subterfuges */
+ snprintf(buf, 512, "type: %d (%s), flags: #x%x%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s",
+ typ,
+ type_name(sc, obj, NO_ARTICLE),
+ full_typ,
+ ((full_typ & T_PROCEDURE) != 0) ? " procedure" : "",
+ ((full_typ & T_GC_MARK) != 0) ? " gc-marked" : "",
+ ((full_typ & T_IMMUTABLE) != 0) ? " immutable" : "",
+ ((full_typ & T_EXPANSION) != 0) ? " expansion" : "",
+ ((full_typ & T_MULTIPLE_VALUE) != 0) ? " values or matched" : "",
+ ((full_typ & T_KEYWORD) != 0) ? " keyword" : "",
+ ((full_typ & T_DONT_EVAL_ARGS) != 0) ? " dont-eval-args" : "",
+ ((full_typ & T_SYNTACTIC) != 0) ? " syntactic" : "",
+ ((full_typ & T_OVERLAY) != 0) ? " overlay" : "",
+ ((full_typ & T_CHECKED) != 0) ? " checked" : "",
+ ((full_typ & T_UNSAFE) != 0) ? ((is_symbol(obj)) ? " clean" : " unsafe") : "",
+ ((full_typ & T_OPTIMIZED) != 0) ? " optimized" : "",
+ ((full_typ & T_SAFE_CLOSURE) != 0) ? " safe-closure" : "",
+ ((full_typ & T_SAFE_PROCEDURE) != 0) ? " safe-procedure" : "",
+ ((full_typ & T_SETTER) != 0) ? " setter" : "",
+ ((full_typ & T_COPY_ARGS) != 0) ? " copy-args" : "",
+ ((full_typ & T_COLLECTED) != 0) ? " collected" : "",
+ ((full_typ & T_SHARED) != 0) ? " shared" : "",
+ ((full_typ & T_HAS_METHODS) != 0) ? " has-methods" : "",
+ ((full_typ & T_GLOBAL) != 0) ? ((is_pair(obj)) ? " unsafe-do" : " global") : "",
+ ((full_typ & T_SAFE_STEPPER) != 0) ? ((is_let(obj)) ? " let-set!-fallback" : ((is_slot(obj)) ? " safe-stepper" : " print-name")) : "",
+ ((full_typ & T_LINE_NUMBER) != 0) ?
+ ((is_pair(obj)) ? " line number" : ((is_input_port(obj)) ? " loader-port" : ((is_let(obj)) ? " with-let" : " has accessor"))) : "",
+ ((full_typ & T_MUTABLE) != 0) ?
+ ((is_string(obj)) ? " byte-vector" : ((is_let(obj)) ? " let-ref-fallback" :
+ ((is_iterator(obj)) ? " mark-seq" : ((is_slot(obj)) ? " stepper" : " mutable")))) : "",
+ ((full_typ & T_GENSYM) != 0) ?
+ ((is_let(obj)) ? " function-env" : ((is_unspecified(obj)) ? " no-value" : ((is_pair(obj)) ? " list-in-use" :
+ ((is_closure_star(obj)) ? " simple-args" : ((is_string(obj)) ? " documented" : " gensym"))))) : "");
+ return(buf);
+}
+
+#if DEBUGGING
+static const char *check_name(int typ)
+{
+ if ((typ >= 0) && (typ < NUM_TYPES))
+ {
+ s7_pointer p;
+ p = prepackaged_type_names[typ];
+ if (is_string(p)) return(string_value(p));
+
+ switch (typ)
+ {
+ case T_C_OBJECT: return("a c-object");
+ case T_INPUT_PORT: return("an input port");
+ case T_OUTPUT_PORT: return("an output port");
+ }
+ }
+ return("unknown type!");
+}
+
+static s7_pointer check_seti(s7_scheme *sc, s7_pointer x, const char *func, int line)
+{
+ if (is_immutable(x))
+ {
+ fprintf(stderr, "%s%s[%d]: set! immutable %s: %s%s\n", BOLD_TEXT, func, line, type_name(sc, x, NO_ARTICLE), DISPLAY(x), UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(x);
+}
+
+static s7_pointer check_ref(s7_pointer p, int expected_type, const char *func, int line, const char *func1, const char *func2)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if (typ != expected_type)
+ {
+ if ((!func1) || (typ != T_FREE))
+ {
+ fprintf(stderr, "%s%s[%d]: not %s, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(expected_type), check_name(typ), typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ else
+ {
+ if ((strcmp(func, func1) != 0) &&
+ ((!func2) || (strcmp(func, func2) != 0)))
+ {
+ fprintf(stderr, "%s%s[%d]: free cell, not %s%s\n", BOLD_TEXT, func, line, check_name(expected_type), UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ }
+ }
+ return(p);
+}
+
+static s7_pointer check_ref2(s7_pointer p, int expected_type, int other_type, const char *func, int line, const char *func1, const char *func2)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != expected_type) && (typ != other_type))
+ return(check_ref(p, expected_type, func, line, func1, func2));
+ return(p);
+}
+
+static s7_pointer check_ref3(s7_pointer p, const char *func, int line)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != T_INPUT_PORT) && (typ != T_OUTPUT_PORT) && (typ != T_FREE))
+ {
+ fprintf(stderr, "%s%s[%d]: not a port, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
+
+static s7_pointer check_ref4(s7_pointer p, const char *func, int line)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != T_VECTOR) && (typ != T_FLOAT_VECTOR) && (typ != T_INT_VECTOR) && (typ != T_FREE))
+ {
+ fprintf(stderr, "%s%s[%d]: not a vector, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
+
+static s7_pointer check_ref5(s7_pointer p, const char *func, int line)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if (!t_has_closure_let[typ])
+ {
+ fprintf(stderr, "%s%s[%d]: not a closure, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
+
+static s7_pointer check_ref6(s7_pointer p, const char *func, int line)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ < T_C_FUNCTION_STAR) && (typ != T_C_MACRO))
+ {
+ fprintf(stderr, "%s%s[%d]: not a c function, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
+
+static s7_pointer check_ref7(s7_pointer p, const char *func, int line)
+{
+ if ((!func) || (strcmp(func, "decribe_type_bits") != 0))
+ {
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ < T_INTEGER) || (typ > T_COMPLEX))
+ {
+ fprintf(stderr, "%s%s[%d]: not a number, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ }
+ return(p);
+}
+
+static s7_pointer check_ref8(s7_pointer p, const char *func, int line)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if ((!t_sequence_p[typ]) && (!t_structure_p[typ]))
+ {
+ fprintf(stderr, "%s%s[%d]: not a sequence, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
+
+static s7_pointer check_ref9(s7_pointer p, const char *func, int line)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if ((typ != T_LET) && (typ != T_C_OBJECT) && (!is_any_closure(p)) && (!is_any_macro(p)))
+ {
+ fprintf(stderr, "%s%s[%d]: not a possible method holder, but %s (%d)%s\n", BOLD_TEXT, func, line, check_name(typ), typ, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
+
+static s7_pointer check_nref(s7_pointer p, const char *func, int line)
+{
+ int typ;
+ typ = unchecked_type(p);
+ if (typ == T_FREE)
+ {
+ fprintf(stderr, "%s%s[%d]: attempt to use cleared type%s\n", BOLD_TEXT, func, line, UNBOLD_TEXT);
+ if (stop_at_error) abort();
+ }
+ return(p);
+}
+
+static void print_gc_info(s7_pointer obj, int line)
+{
+ fprintf(stderr, "%s%p is free (line %d), current: %s[%d], previous: %s[%d], gc call: %s[%d], clear: %d, alloc: %s[%d]%s\n",
+ BOLD_TEXT,
+ obj, line,
+ obj->current_alloc_func, obj->current_alloc_line,
+ obj->previous_alloc_func, obj->previous_alloc_line,
+ obj->gc_func, obj->gc_line, obj->clear_line, obj->alloc_func, obj->alloc_line,
+ UNBOLD_TEXT);
+ abort();
+}
+
+static void show_opt1_bits(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ fprintf(stderr, "%sopt1 %s[%d]: %p->%p %x%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s\n", BOLD_TEXT, func, line, p, p->object.cons.opt1, p->debugger_bits,
+ ((p->debugger_bits & E_SET) != 0) ? " e-set" : "",
+ ((p->debugger_bits & E_FAST) != 0) ? " fast" : "",
+ ((p->debugger_bits & E_CFUNC) != 0) ? " cfunc" : "",
+ ((p->debugger_bits & E_CLAUSE) != 0) ? " clause" : "",
+ ((p->debugger_bits & E_BACK) != 0) ? " back" : "",
+ ((p->debugger_bits & E_LAMBDA) != 0) ? " lambda" : "",
+ ((p->debugger_bits & E_SYM) != 0) ? " sym" : "",
+ ((p->debugger_bits & E_PAIR) != 0) ? " pair" : "",
+ ((p->debugger_bits & E_CON) != 0) ? " con" : "",
+ ((p->debugger_bits & E_GOTO) != 0) ? " goto" : "",
+ ((p->debugger_bits & E_VECTOR) != 0) ? " vector" : "",
+ ((p->debugger_bits & E_ANY) != 0) ? " any" : "",
+ ((p->debugger_bits & E_SLOT) != 0) ? " slot" : "",
+ ((p->debugger_bits & S_HASH) != 0) ? " raw-hash" : "",
+ UNBOLD_TEXT);
+}
+
+static s7_pointer opt1_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
+{
+ if ((!opt1_is_set(p)) ||
+ ((!opt1_role_matches(p, role)) &&
+ (role != E_ANY)))
+ {
+ show_opt1_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.cons.opt1);
+}
+
+static s7_pointer set_opt1_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
+{
+ p->object.cons.opt1 = x;
+ set_opt1_role(p, role);
+ set_opt1_is_set(p);
+ return(x);
+}
+
+static unsigned long long int s_hash_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ if ((!opt1_is_set(p)) ||
+ (!opt1_role_matches(p, S_HASH)))
+ {
+ show_opt1_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.hash);
+}
+
+static void set_s_hash_1(s7_scheme *sc, s7_pointer p, unsigned long long int x, const char *func, int line)
+{
+ p->object.sym_cons.hash = x;
+ set_opt1_role(p, S_HASH);
+ set_opt1_is_set(p);
+}
+
+static void show_opt2_bits(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ fprintf(stderr, "%s%s[%d]: opt2: %p->%p %x%s%s%s%s%s%s%s%s%s%s%s\n", BOLD_TEXT, func, line, p, p->object.cons.opt2, p->debugger_bits,
+ ((p->debugger_bits & F_SET) != 0) ? " f-set" : "",
+ ((p->debugger_bits & F_C_CALL) != 0) ? " c-call" : "",
+ ((p->debugger_bits & F_KEY) != 0) ? " key" : "",
+ ((p->debugger_bits & F_SLOW) != 0) ? " slow" : "",
+ ((p->debugger_bits & F_SYM) != 0) ? " sym" : "",
+ ((p->debugger_bits & F_PAIR) != 0) ? " pair" : "",
+ ((p->debugger_bits & F_CON) != 0) ? " con" : "",
+ ((p->debugger_bits & F_CALL) != 0) ? " call" : "",
+ ((p->debugger_bits & F_LAMBDA) != 0) ? " lambda" : "",
+ ((p->debugger_bits & S_NAME) != 0) ? " raw-name" : "",
+ UNBOLD_TEXT);
+}
+
+static s7_pointer opt2_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
+{
+ if ((!opt2_is_set(p)) ||
+ (!opt2_role_matches(p, role)))
+ {
+ show_opt2_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.cons.opt2);
+}
+
+static void set_opt2_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
+{
+ p->object.cons.opt2 = x;
+ set_opt2_role(p, role);
+ set_opt2_is_set(p);
+}
+
+static const char *s_name_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ if ((!opt2_is_set(p)) ||
+ (!opt2_role_matches(p, S_NAME)))
+ {
+ show_opt2_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.fstr);
+}
+
+static void set_s_name_1(s7_scheme *sc, s7_pointer p, const char *str, const char *func, int line)
+{
+ p->object.sym_cons.fstr = str;
+ set_opt2_role(p, S_NAME);
+ set_opt2_is_set(p);
+}
+
+static void show_opt3_bits(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ fprintf(stderr, "%s%s[%d]: opt3: %x%s%s%s%s%s%s%s%s%s\n", BOLD_TEXT, func, line,
+ p->debugger_bits,
+ ((p->debugger_bits & G_SET) != 0) ? " g-set" : "",
+ ((p->debugger_bits & G_ARGLEN) != 0) ? " arglen" : "",
+ ((p->debugger_bits & G_SYM) != 0) ? " sym" : "",
+ ((p->debugger_bits & G_AND) != 0) ? " and" : "",
+ ((p->debugger_bits & S_LINE) != 0) ? " line" : "",
+ ((p->debugger_bits & S_LEN) != 0) ? " len" : "",
+ ((p->debugger_bits & S_OP) != 0) ? " op" : "",
+ ((p->debugger_bits & S_SYNOP) != 0) ? " syn-op" : "",
+ UNBOLD_TEXT);
+}
+
+static s7_pointer opt3_1(s7_scheme *sc, s7_pointer p, unsigned int role, const char *func, int line)
+{
+ if ((!opt3_is_set(p)) ||
+ (!opt3_role_matches(p, role)))
+ {
+ show_opt3_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.cons.opt3);
+}
+
+static void set_opt3_1(s7_scheme *sc, s7_pointer p, s7_pointer x, unsigned int role, const char *func, int line)
+{
+ typeflag(p) &= ~(T_OPTIMIZED | T_LINE_NUMBER);
+ p->object.cons.opt3 = x;
+ set_opt3_is_set(p);
+ set_opt3_role(p, role);
+}
+
+/* S_LINE */
+static unsigned int s_line_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ if ((!opt3_is_set(p)) ||
+ ((p->debugger_bits & S_LINE) == 0) ||
+ (!has_line_number(p)))
+ {
+ show_opt3_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.line);
+}
+
+static void set_s_line_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
+{
+ p->object.sym_cons.line = x;
+ (p)->debugger_bits = (S_LINE | (p->debugger_bits & ~S_LEN)); /* turn on line, cancel len */
+ set_opt3_is_set(p);
+}
+
+/* S_LEN (collides with S_LINE) */
+static unsigned int s_len_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ if ((!opt3_is_set(p)) ||
+ ((p->debugger_bits & S_LEN) == 0) ||
+ (has_line_number(p)))
+ {
+ show_opt3_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.line);
+}
+
+static void set_s_len_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
+{
+ typeflag(p) &= ~(T_LINE_NUMBER);
+ p->object.sym_cons.line = x;
+ (p)->debugger_bits = (S_LEN | (p->debugger_bits & ~(S_LINE)));
+ set_opt3_is_set(p);
+}
+
+/* S_OP */
+static unsigned int s_op_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ if ((!opt3_is_set(p)) ||
+ ((p->debugger_bits & S_OP) == 0))
+ {
+ show_opt3_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.op);
+}
+
+static void set_s_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
+{
+ p->object.sym_cons.op = x;
+ (p)->debugger_bits = (S_OP | (p->debugger_bits & ~(S_SYNOP)));
+ set_opt3_is_set(p);
+}
+
+/* S_SYNOP (collides with S_OP) */
+static unsigned int s_syn_op_1(s7_scheme *sc, s7_pointer p, const char *func, int line)
+{
+ if ((!opt3_is_set(p)) ||
+ ((p->debugger_bits & S_SYNOP) == 0))
+ {
+ show_opt3_bits(sc, p, func, line);
+ if (stop_at_error) abort();
+ }
+ return(p->object.sym_cons.op);
+}
+
+static void set_s_syn_op_1(s7_scheme *sc, s7_pointer p, unsigned int x, const char *func, int line)
+{
+ p->object.sym_cons.op = x;
+ (p)->debugger_bits = (S_SYNOP | (p->debugger_bits & ~(S_OP)));
+ set_opt3_is_set(p);
+}
+
+static void print_debugging_state(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+ /* show current state, current allocated state, and previous allocated state.
+ */
+ char *current_bits, *allocated_bits, *previous_bits, *str;
+ int save_typeflag, len, nlen;
+ const char *excl_name;
+
+ if (is_free(obj))
+ excl_name = "free cell!";
+ else excl_name = "unknown object!";
+
+ current_bits = describe_type_bits(sc, obj);
+ save_typeflag = typeflag(obj);
+ typeflag(obj) = obj->current_alloc_type;
+ allocated_bits = describe_type_bits(sc, obj);
+ typeflag(obj) = obj->previous_alloc_type;
+ previous_bits = describe_type_bits(sc, obj);
+ typeflag(obj) = save_typeflag;
+
+ len = safe_strlen(excl_name) +
+ safe_strlen(current_bits) + safe_strlen(allocated_bits) + safe_strlen(previous_bits) +
+ safe_strlen(obj->previous_alloc_func) + safe_strlen(obj->current_alloc_func) + 512;
+ tmpbuf_malloc(str, len);
+
+ nlen = snprintf(str, len,
+ "\n<%s %s,\n current: %s[%d] %s,\n previous: %s[%d] %s\n hloc: %d (%d uses), free: %s[%d], clear: %d, alloc: %s[%d]>",
+ excl_name, current_bits,
+ obj->current_alloc_func, obj->current_alloc_line, allocated_bits,
+ obj->previous_alloc_func, obj->previous_alloc_line, previous_bits,
+ heap_location(obj), obj->uses,
+ obj->gc_func, obj->gc_line, obj->clear_line, obj->alloc_func, obj->alloc_line);
+
+ free(current_bits);
+ free(allocated_bits);
+ free(previous_bits);
+ if (is_null(port))
+ fprintf(stderr, "%p: %s\n", obj, str);
+ else port_write_string(port)(sc, str, nlen, port);
+ tmpbuf_free(str, len);
+}
+#endif
+
+static void iterator_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if (use_write == USE_READABLE_WRITE)
+ {
+ if (iterator_is_at_end(obj))
+ port_write_string(port)(sc, "(make-iterator #())", 19, port);
+ else
+ {
+ s7_pointer seq;
+ seq = iterator_sequence(obj);
+ if ((is_string(seq)) && (!is_byte_vector(seq)))
+ {
+ port_write_string(port)(sc, "(make-iterator \"", 16, port);
+ port_write_string(port)(sc, (char *)(string_value(seq) + iterator_position(obj)), string_length(seq) - iterator_position(obj), port);
+ port_write_string(port)(sc, "\")", 2, port);
+ }
+ else
+ {
+ if (iterator_position(obj) > 0)
+ port_write_string(port)(sc, "(let ((iter (make-iterator ", 27, port);
+ else port_write_string(port)(sc, "(make-iterator ", 15, port);
+ object_to_port_with_circle_check(sc, iterator_sequence(obj), port, use_write, ci);
+ if (iterator_position(obj) > 0)
+ {
+ int nlen;
+ char *str;
+ str = (char *)malloc(128 * sizeof(char));
+ nlen = snprintf(str, 128, "))) (do ((i 0 (+ i 1))) ((= i %lld) iter) (iterate iter)))", iterator_position(obj));
+ port_write_string(port)(sc, str, nlen, port);
+ free(str);
+ }
+ else port_write_character(port)(sc, ')', port);
+ }
+ }
+ }
+ else
+ {
+ const char *str;
+ str = type_name(sc, iterator_sequence(obj), NO_ARTICLE);
+ port_write_string(port)(sc, "#<iterator: ", 12, port);
+ port_write_string(port)(sc, str, safe_strlen(str), port);
+ port_write_character(port)(sc, '>', port);
+ }
+}
+
+static void baffle_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+ int nlen;
+ char buf[64];
+ nlen = snprintf(buf, 64, "#<baffle: %d>", baffle_key(obj));
+ port_write_string(port)(sc, buf, nlen, port);
+}
+
+static void c_pointer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
+{
+ int nlen;
+ char buf[64];
+
+ if (use_write == USE_READABLE_WRITE)
+ nlen = snprintf(buf, 64, "(c-pointer " INT_FORMAT ")", (ptr_int)raw_pointer(obj));
+ else nlen = snprintf(buf, 64, "#<c_pointer %p>", raw_pointer(obj));
+ port_write_string(port)(sc, buf, nlen, port);
+}
+
+static void rng_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write)
+{
+ int nlen;
+ char buf[128];
+#if WITH_GMP
+ if (use_write == USE_READABLE_WRITE)
+ nlen = snprintf(buf, 128, "#<unprint-readable object>");
+ else nlen = snprintf(buf, 128, "#<rng %p>", obj);
+#else
+ if (use_write == USE_READABLE_WRITE)
+ nlen = snprintf(buf, 128, "(random-state %llu %llu)", random_seed(obj), random_carry(obj));
+ else nlen = snprintf(buf, 128, "#<rng %llu %llu>", random_seed(obj), random_carry(obj));
+#endif
+ port_write_string(port)(sc, buf, nlen, port);
+}
+
+
+static void object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ int nlen;
+ char *str;
+
+ switch (type(obj))
+ {
+ case T_FLOAT_VECTOR:
+ case T_INT_VECTOR:
+ int_or_float_vector_to_port(sc, obj, port, use_write);
+ break;
+
+ case T_VECTOR:
+ vector_to_port(sc, obj, port, use_write, ci);
+ break;
+
+ case T_PAIR:
+ list_to_port(sc, obj, port, use_write, ci);
+ break;
+
+ case T_HASH_TABLE:
+ hash_table_to_port(sc, obj, port, use_write, ci);
+ break;
+
+ case T_ITERATOR:
+ iterator_to_port(sc, obj, port, use_write, ci);
+ break;
+
+ case T_LET:
+ let_to_port(sc, obj, port, use_write, ci);
+ break;
+
+ case T_UNIQUE:
+ /* if file has #<eof> it causes read to return #<eof> -> end of read! what is readable version? */
+ if ((use_write == USE_READABLE_WRITE) &&
+ (obj == sc->EOF_OBJECT))
+ port_write_string(port)(sc, "(begin #<eof>)", 14, port);
+ else port_write_string(port)(sc, unique_name(obj), unique_name_length(obj), port);
+ break;
+
+ case T_BOOLEAN:
+ case T_NIL:
+ case T_UNSPECIFIED:
+ port_write_string(port)(sc, unique_name(obj), unique_name_length(obj), port);
+ break;
+
+ case T_INPUT_PORT:
+ input_port_to_port(sc, obj, port, use_write);
+ break;
+
+ case T_OUTPUT_PORT:
+ output_port_to_port(sc, obj, port, use_write);
+ break;
+
+ case T_COUNTER:
+ port_write_string(port)(sc, "#<counter>", 10, port);
+ break;
+
+ case T_BAFFLE:
+ baffle_to_port(sc, obj, port);
+ break;
+
+ case T_INTEGER:
+ if (has_print_name(obj))
+ port_write_string(port)(sc, print_name(obj), print_name_length(obj), port);
+ else
+ {
+ nlen = 0;
+ str = integer_to_string_base_10_no_width(obj, &nlen);
+ if (nlen > 0)
+ {
+ set_print_name(obj, str, nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ }
+ else port_display(port)(sc, str, port);
+ }
+ break;
+
+ case T_REAL:
+ case T_RATIO:
+ case T_COMPLEX:
+ if (has_print_name(obj))
+ port_write_string(port)(sc, print_name(obj), print_name_length(obj), port);
+ else
+ {
+ nlen = 0;
+ str = number_to_string_base_10(obj, 0, float_format_precision, 'g', &nlen, use_write); /* was 14 */
+ set_print_name(obj, str, nlen);
+ port_write_string(port)(sc, str, nlen, port);
+ }
+ break;
+
+#if WITH_GMP
+ case T_BIG_INTEGER:
+ case T_BIG_RATIO:
+ case T_BIG_REAL:
+ case T_BIG_COMPLEX:
+ nlen = 0;
+ str = big_number_to_string_with_radix(obj, BASE_10, 0, &nlen, use_write);
+ port_write_string(port)(sc, str, nlen, port);
+ free(str);
+ break;
+#endif
+
+ case T_SYMBOL:
+ symbol_to_port(sc, obj, port, use_write);
+ break;
+
+ case T_SYNTAX:
+ port_display(port)(sc, symbol_name(syntax_symbol(obj)), port);
+ break;
+
+ case T_STRING:
+ if (is_byte_vector(obj))
+ byte_vector_to_port(sc, obj, port, use_write);
+ else string_to_port(sc, obj, port, use_write);
+ break;
+
+ case T_CHARACTER:
+ if (use_write == USE_DISPLAY)
+ port_write_character(port)(sc, character(obj), port);
+ else port_write_string(port)(sc, character_name(obj), character_name_length(obj), port);
+ break;
+
+ case T_CLOSURE:
+ case T_CLOSURE_STAR:
+ if (has_methods(obj))
+ {
+ /* look for object->string method else fallback on ordinary case.
+ * can't use recursion on closure_let here because then the fallback name is #<let>.
+ */
+ s7_pointer print_func;
+ print_func = find_method(sc, closure_let(obj), sc->OBJECT_TO_STRING);
+ if (print_func != sc->UNDEFINED)
+ {
+ s7_pointer p;
+ p = s7_apply_function(sc, print_func, list_1(sc, obj));
+ if (string_length(p) > 0)
+ port_write_string(port)(sc, string_value(p), string_length(p), port);
+ break;
+ }
+ }
+ if (use_write == USE_READABLE_WRITE)
+ write_closure_readably(sc, obj, port);
+ else write_closure_name(sc, obj, port);
+ break;
+
+ case T_MACRO:
+ case T_MACRO_STAR:
+ case T_BACRO:
+ case T_BACRO_STAR:
+ if (use_write == USE_READABLE_WRITE)
+ write_macro_readably(sc, obj, port);
+ else write_closure_name(sc, obj, port);
+ break;
+
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ port_write_string(port)(sc, c_function_name(obj), c_function_name_length(obj), port);
+ break;
+
+ case T_C_MACRO:
+ port_write_string(port)(sc, c_macro_name(obj), c_macro_name_length(obj), port);
+ break;
+
+ case T_C_POINTER:
+ c_pointer_to_port(sc, obj, port, use_write);
+ break;
+
+ case T_RANDOM_STATE:
+ rng_to_port(sc, obj, port, use_write);
+ break;
+
+ case T_CONTINUATION:
+ if (use_write == USE_READABLE_WRITE)
+ port_write_string(port)(sc, "continuation", 12, port);
+ else port_write_string(port)(sc, "#<continuation>", 15, port);
+ break;
+
+ case T_GOTO:
+ if (use_write == USE_READABLE_WRITE)
+ port_write_string(port)(sc, "goto", 4, port);
+ else port_write_string(port)(sc, "#<goto>", 7, port);
+ break;
+
+ case T_CATCH:
+ port_write_string(port)(sc, "#<catch>", 8, port);
+ break;
+
+ case T_DYNAMIC_WIND:
+ /* this can happen because (*s7* 'stack) can involve dynamic-wind markers */
+ port_write_string(port)(sc, "#<dynamic-wind>", 15, port);
+ break;
+
+ case T_C_OBJECT:
+ if (use_write == USE_READABLE_WRITE)
+ str = ((*(c_object_print_readably(obj)))(sc, c_object_value(obj)));
+ else str = ((*(c_object_print(obj)))(sc, c_object_value(obj)));
+ port_display(port)(sc, str, port);
+ free(str);
+ break;
+
+ case T_SLOT:
+ if (use_write != USE_READABLE_WRITE)
+ port_write_character(port)(sc, '\'', port);
+ symbol_to_port(sc, slot_symbol(obj), port, use_write);
+ port_write_character(port)(sc, ' ', port);
+ object_to_port_with_circle_check(sc, slot_value(obj), port, use_write, ci);
+ break;
+
+ default:
+#if DEBUGGING
+ print_debugging_state(sc, obj, port);
+#else
+ {
+ char *str, *tmp;
+ int len;
+ tmp = describe_type_bits(sc, obj);
+ len = 32 + safe_strlen(tmp);
+ tmpbuf_malloc(str, len);
+ if (is_free(obj))
+ nlen = snprintf(str, len, "<free cell! %s>", tmp);
+ else nlen = snprintf(str, len, "<unknown object! %s>", tmp);
+ free(tmp);
+ port_write_string(port)(sc, str, nlen, port);
+ tmpbuf_free(str, len);
+ }
+#endif
+ break;
+ }
+}
+
+
+static void object_to_port_with_circle_check(s7_scheme *sc, s7_pointer vr, s7_pointer port, use_write_t use_write, shared_info *ci)
+{
+ if ((ci) &&
+ (has_structure(vr)))
+ {
+ int ref;
+ ref = shared_ref(ci, vr);
+ if (ref != 0)
+ {
+ char buf[32];
+ int nlen;
+ char *p;
+ unsigned int len;
+ if (ref > 0)
+ {
+ if (use_write == USE_READABLE_WRITE)
+ {
+ nlen = snprintf(buf, 32, "(set! {%d} ", ref);
+ port_write_string(port)(sc, buf, nlen, port);
+ object_to_port(sc, vr, port, USE_READABLE_WRITE, ci);
+ port_write_character(port)(sc, ')', port);
+ }
+ else
+ {
+ p = pos_int_to_str((s7_int)ref, &len, '=');
+ *--p = '#';
+ port_write_string(port)(sc, p, len, port);
+ object_to_port(sc, vr, port, DONT_USE_DISPLAY(use_write), ci);
+ }
+ }
+ else
+ {
+ if (use_write == USE_READABLE_WRITE)
+ {
+ nlen = snprintf(buf, 32, "{%d}", -ref);
+ port_write_string(port)(sc, buf, nlen, port);
+ }
+ else
+ {
+ p = pos_int_to_str((s7_int)(-ref), &len, '#');
+ *--p = '#';
+ port_write_string(port)(sc, p, len, port);
+ }
+ }
+ return;
+ }
+ }
+ object_to_port(sc, vr, port, use_write, ci);
+}
+
+
+static void setup_shared_reads(s7_scheme *sc, s7_pointer port, shared_info *ci)
+{
+ int i;
+ char buf[64];
+
+ port_write_string(port)(sc, "(let (", 6, port);
+ for (i = 1; i <= ci->top; i++)
+ {
+ int len;
+ len = snprintf(buf, 64, "({%d} #f)", i);
+ port_write_string(port)(sc, buf, len, port);
+ }
+ port_write_string(port)(sc, ") ", 2, port);
+}
+
+static void finish_shared_reads(s7_scheme *sc, s7_pointer port, shared_info *ci)
+{
+ port_write_character(port)(sc, ')', port);
+}
+
+static s7_pointer object_out(s7_scheme *sc, s7_pointer obj, s7_pointer strport, use_write_t choice)
+{
+ if ((has_structure(obj)) &&
+ (obj != sc->rootlet))
+ {
+ shared_info *ci;
+ ci = make_shared_info(sc, obj, choice != USE_READABLE_WRITE);
+ if (ci)
+ {
+ if (choice == USE_READABLE_WRITE)
+ {
+ setup_shared_reads(sc, strport, ci);
+ object_to_port_with_circle_check(sc, obj, strport, choice, ci);
+ finish_shared_reads(sc, strport, ci);
+ }
+ else object_to_port_with_circle_check(sc, obj, strport, choice, ci);
+ return(obj);
+ }
+ }
+ object_to_port(sc, obj, strport, choice, NULL);
+ return(obj);
+}
+
+
+static s7_pointer format_ports = NULL;
+
+static s7_pointer open_format_port(s7_scheme *sc)
+{
+ s7_pointer x;
+ int len;
+
+ if (format_ports)
+ {
+ x = format_ports;
+ format_ports = (s7_pointer)(port_port(x)->next);
+ port_position(x) = 0;
+ port_data(x)[0] = '\0';
+ return(x);
+ }
+
+ len = FORMAT_PORT_LENGTH;
+ x = alloc_pointer();
+ set_type(x, T_OUTPUT_PORT);
+ port_port(x) = (port_t *)calloc(1, sizeof(port_t));
+ port_type(x) = STRING_PORT;
+ port_is_closed(x) = false;
+ port_data_size(x) = len;
+ port_data(x) = (unsigned char *)malloc(len * sizeof(unsigned char)); /* was +8 */
+ port_data(x)[0] = '\0';
+ port_position(x) = 0;
+ port_needs_free(x) = false;
+ port_read_character(x) = output_read_char;
+ port_read_line(x) = output_read_line;
+ port_display(x) = string_display;
+ port_write_character(x) = string_write_char;
+ port_write_string(x) = string_write_string;
+ return(x);
+}
+
+static void close_format_port(s7_scheme *sc, s7_pointer port)
+{
+ port_port(port)->next = (void *)format_ports;
+ format_ports = port;
+}
+
+
+static char *s7_object_to_c_string_1(s7_scheme *sc, s7_pointer obj, use_write_t use_write, int *nlen)
+{
+ char *str;
+ s7_pointer strport;
+
+ strport = open_format_port(sc);
+ object_out(sc, obj, strport, use_write);
+ if (nlen) (*nlen) = port_position(strport);
+
+ str = (char *)malloc((port_position(strport) + 1) * sizeof(char));
+ memcpy((void *)str, (void *)port_data(strport), port_position(strport));
+ str[port_position(strport)] = '\0';
+ close_format_port(sc, strport);
+
+ return(str);
+}
+
+
+char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj)
+{
+ return(s7_object_to_c_string_1(sc, obj, USE_WRITE, NULL));
+}
+
+
+s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer obj, bool use_write) /* unavoidable backwards compatibility rigidity here */
+{
+ char *str;
+ int len = 0;
+
+ str = s7_object_to_c_string_1(sc, obj, (use_write) ? USE_WRITE : USE_DISPLAY, &len);
+ if (str)
+ return(make_string_uncopied_with_length(sc, str, len));
+ return(s7_make_string_with_length(sc, "", 0));
+}
+
+
+/* -------------------------------- newline -------------------------------- */
+void s7_newline(s7_scheme *sc, s7_pointer port)
+{
+ s7_write_char(sc, '\n', port);
+}
+
+static s7_pointer g_newline(s7_scheme *sc, s7_pointer args)
+{
+ #define H_newline "(newline (port (current-output-port))) writes a carriage return to the port"
+ #define Q_newline s7_make_signature(sc, 2, sc->T, sc->IS_OUTPUT_PORT)
+ s7_pointer port;
+
+ if (is_not_null(args))
+ port = car(args);
+ else port = sc->output_port;
+ if (!is_output_port(port))
+ {
+ if (port == sc->F) return(sc->UNSPECIFIED);
+ method_or_bust_with_type(sc, port, sc->NEWLINE, args, AN_OUTPUT_PORT, 0);
+ }
+ s7_newline(sc, port);
+ return(sc->UNSPECIFIED);
+}
+
+static s7_pointer c_newline(s7_scheme *sc) {s7_newline(sc, sc->output_port); return(sc->UNSPECIFIED);}
+PF_0(newline, c_newline)
+
+
+/* -------------------------------- write -------------------------------- */
+void s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+ if (port != sc->F)
+ {
+ if (port_is_closed(port))
+ s7_wrong_type_arg_error(sc, "write", 2, port, "an open output port");
+ object_out(sc, obj, port, USE_WRITE);
+ }
+}
+
+
+static s7_pointer g_write(s7_scheme *sc, s7_pointer args)
+{
+ #define H_write "(write obj (port (current-output-port))) writes (object->string obj) to the output port"
+ #define Q_write s7_make_signature(sc, 3, sc->T, sc->T, sc->IS_OUTPUT_PORT)
+ s7_pointer port;
+
+ if (is_pair(cdr(args)))
+ port = cadr(args);
+ else port = sc->output_port;
+ if (!is_output_port(port))
+ {
+ if (port == sc->F) return(car(args));
+ method_or_bust_with_type(sc, port, sc->WRITE, args, AN_OUTPUT_PORT, 2);
+ }
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "write", 2, port, "an open output port"));
+ return(object_out(sc, car(args), port, USE_WRITE));
+}
+
+static s7_pointer c_write_i(s7_scheme *sc, s7_int x) {return(g_write(sc, set_plist_1(sc, make_integer(sc, x))));}
+static s7_pointer c_write_r(s7_scheme *sc, s7_double x) {return(g_write(sc, set_plist_1(sc, make_real(sc, x))));}
+static s7_pointer c_write_p(s7_scheme *sc, s7_pointer x) {return(g_write(sc, set_plist_1(sc, x)));}
+XF_TO_PF(write, c_write_i, c_write_r, c_write_p)
+
+
+/* -------------------------------- display -------------------------------- */
+void s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port)
+{
+ if (port != sc->F)
+ {
+ if (port_is_closed(port))
+ s7_wrong_type_arg_error(sc, "display", 2, port, "an open output port");
+ object_out(sc, obj, port, USE_DISPLAY);
+ }
+}
+
+
+static s7_pointer g_display(s7_scheme *sc, s7_pointer args)
+{
+ #define H_display "(display obj (port (current-output-port))) prints obj"
+ #define Q_display s7_make_signature(sc, 3, sc->T, sc->T, sc->IS_OUTPUT_PORT)
+ s7_pointer port;
+
+ if (is_pair(cdr(args)))
+ port = cadr(args);
+ else port = sc->output_port;
+ if (!is_output_port(port))
+ {
+ if (port == sc->F) return(car(args));
+ method_or_bust_with_type(sc, port, sc->DISPLAY, args, AN_OUTPUT_PORT, 2);
+ }
+ if (port_is_closed(port))
+ return(s7_wrong_type_arg_error(sc, "display", 2, port, "an open output port"));
+ return(object_out(sc, car(args), port, USE_DISPLAY));
+}
+
+static s7_pointer c_display(s7_scheme *sc, s7_pointer x) {return(g_display(sc, set_plist_1(sc, x)));}
+PF_TO_PF(display, c_display)
+
+
+/* -------------------------------- call-with-output-string -------------------------------- */
+static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_call_with_output_string "(call-with-output-string proc) opens a string port applies proc to it, then returns the collected output"
+ #define Q_call_with_output_string s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_PROCEDURE)
+ s7_pointer port, proc;
+
+ proc = car(args);
+ if (is_let(proc))
+ check_method(sc, proc, sc->CALL_WITH_OUTPUT_STRING, args);
+ if (!s7_is_aritable(sc, proc, 1))
+ method_or_bust_with_type(sc, proc, sc->CALL_WITH_OUTPUT_STRING, args, make_string_wrapper(sc, "a procedure of one argument (the port)"), 1);
+
+ if ((is_continuation(proc)) || (is_goto(proc)))
+ return(wrong_type_argument_with_type(sc, sc->CALL_WITH_OUTPUT_STRING, 1, proc, A_NORMAL_PROCEDURE));
+
+ port = s7_open_output_string(sc);
+ push_stack(sc, OP_GET_OUTPUT_STRING_1, sc->F, port);
+ push_stack(sc, OP_APPLY, list_1(sc, port), proc);
+ return(sc->F);
+}
+
+static s7_pointer c_call_with_output_string(s7_scheme *sc, s7_pointer x) {return(g_call_with_output_string(sc, set_plist_1(sc, x)));}
+PF_TO_PF(call_with_output_string, c_call_with_output_string)
+
+
+/* -------------------------------- call-with-output-file -------------------------------- */
+static s7_pointer g_call_with_output_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_call_with_output_file "(call-with-output-file filename proc) opens filename and calls proc with the output port as its argument"
+ #define Q_call_with_output_file pl_sf
+ s7_pointer port, file, proc;
+
+ file = car(args);
+ if (!is_string(file))
+ method_or_bust(sc, file, sc->CALL_WITH_OUTPUT_FILE, args, T_STRING, 1);
+
+ proc = cadr(args);
+ if (!s7_is_aritable(sc, proc, 1))
+ method_or_bust_with_type(sc, proc, sc->CALL_WITH_OUTPUT_FILE, args, make_string_wrapper(sc, "a procedure of one argument (the port)"), 2);
+
+ if ((is_continuation(proc)) || is_goto(proc))
+ return(wrong_type_argument_with_type(sc, sc->CALL_WITH_OUTPUT_FILE, 2, proc, A_NORMAL_PROCEDURE));
+
+ port = s7_open_output_file(sc, string_value(file), "w");
+ push_stack(sc, OP_UNWIND_OUTPUT, sc->F, port);
+ push_stack(sc, OP_APPLY, list_1(sc, port), proc);
+ return(sc->F);
+}
+
+static s7_pointer c_call_with_output_file(s7_scheme *sc, s7_pointer x) {return(g_call_with_output_file(sc, set_plist_1(sc, x)));}
+PF_TO_PF(call_with_output_file, c_call_with_output_file)
+
+
+/* -------------------------------- with-output-to-string -------------------------------- */
+static s7_pointer g_with_output_to_string(s7_scheme *sc, s7_pointer args)
+{
+ #define H_with_output_to_string "(with-output-to-string thunk) opens a string as a temporary current-output-port, calls thunk, then returns the collected output"
+ #define Q_with_output_to_string s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_PROCEDURE)
+ s7_pointer old_output_port, p;
+
+ p = car(args);
+ if (!is_thunk(sc, p))
+ method_or_bust_with_type(sc, p, sc->WITH_OUTPUT_TO_STRING, args, A_THUNK, 1);
+
+ old_output_port = sc->output_port;
+ sc->output_port = s7_open_output_string(sc);
+ push_stack(sc, OP_GET_OUTPUT_STRING_1, old_output_port, sc->output_port);
+
+ push_stack(sc, OP_APPLY, sc->NIL, p);
+ return(sc->F);
+}
+
+static s7_pointer c_with_output_to_string(s7_scheme *sc, s7_pointer x) {return(g_with_output_to_string(sc, set_plist_1(sc, x)));}
+PF_TO_PF(with_output_to_string, c_with_output_to_string)
+
+/* (let () (define-macro (mac) (write "123")) (with-output-to-string mac))
+ * (string-ref (with-output-to-string (lambda () (write "1234") (values (get-output-string) 1))))
+ */
+
+
+/* -------------------------------- with-output-to-file -------------------------------- */
+static s7_pointer g_with_output_to_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_with_output_to_file "(with-output-to-file filename thunk) opens filename as the temporary current-output-port and calls thunk"
+ #define Q_with_output_to_file pl_sf
+ s7_pointer old_output_port, file, proc;
+
+ file = car(args);
+ if (!is_string(file))
+ method_or_bust(sc, file, sc->WITH_OUTPUT_TO_FILE, args, T_STRING, 1);
+
+ proc = cadr(args);
+ if (!is_thunk(sc, proc))
+ method_or_bust_with_type(sc, proc, sc->WITH_OUTPUT_TO_FILE, args, A_THUNK, 2);
+
+ old_output_port = sc->output_port;
+ sc->output_port = s7_open_output_file(sc, string_value(file), "w");
+ push_stack(sc, OP_UNWIND_OUTPUT, old_output_port, sc->output_port);
+
+ push_stack(sc, OP_APPLY, sc->NIL, proc);
+ return(sc->F);
+}
+
+static s7_pointer c_with_output_to_file(s7_scheme *sc, s7_pointer x) {return(g_with_output_to_file(sc, set_plist_1(sc, x)));}
+PF_TO_PF(with_output_to_file, c_with_output_to_file)
+
+
+/* -------------------------------- format -------------------------------- */
+
+static s7_pointer format_error_1(s7_scheme *sc, s7_pointer msg, const char *str, s7_pointer args, format_data *fdat)
+{
+ s7_pointer x = NULL, ctrl_str;
+ static s7_pointer format_string_1 = NULL, format_string_2, format_string_3, format_string_4;
+
+ if (!format_string_1)
+ {
+ format_string_1 = s7_make_permanent_string("format: ~S ~{~S~^ ~}: ~A");
+ format_string_2 = s7_make_permanent_string("format: ~S: ~A");
+ format_string_3 = s7_make_permanent_string("format: ~S ~{~S~^ ~}~&~NT^: ~A");
+ format_string_4 = s7_make_permanent_string("format: ~S~&~NT^: ~A");
+ }
+
+ if (fdat->orig_str)
+ ctrl_str = fdat->orig_str;
+ else ctrl_str = make_string_wrapper(sc, str);
+
+ if (fdat->loc == 0)
+ {
+ if (is_pair(args))
+ x = set_elist_4(sc, format_string_1, ctrl_str, args, msg);
+ else x = set_elist_3(sc, format_string_2, ctrl_str, msg);
+ }
+ else
+ {
+ if (is_pair(args))
+ x = set_elist_5(sc, format_string_3, ctrl_str, args, make_integer(sc, fdat->loc + 20), msg);
+ else x = set_elist_4(sc, format_string_4, ctrl_str, make_integer(sc, fdat->loc + 20), msg);
+ }
+ if (fdat->port)
+ {
+ close_format_port(sc, fdat->port);
+ fdat->port = NULL;
+ }
+ return(s7_error(sc, sc->FORMAT_ERROR, x));
+}
+
+#define format_error(Sc, Msg, Str, Args, Fdat) \
+ do {static s7_pointer _Err_ = NULL; if (!_Err_) _Err_ = s7_make_permanent_string(Msg); return(format_error_1(Sc, _Err_, Str, Args, Fdat));} while (0)
+
+#define just_format_error(Sc, Msg, Str, Args, Fdat) \
+ do {static s7_pointer _Err_ = NULL; if (!_Err_) _Err_ = s7_make_permanent_string(Msg); format_error_1(Sc, _Err_, Str, Args, Fdat);} while (0)
+
+static void format_append_char(s7_scheme *sc, format_data *fdat, char c, s7_pointer port)
+{
+ port_write_character(port)(sc, c, port);
+ sc->format_column++;
+
+ /* if c is #\null, is this the right thing to do?
+ * We used to return "1 2 3 4" because ~C was first turned into a string (empty in this case)
+ * (format #f "1 2~C3 4" #\null)
+ * "1 2"
+ * Clisp does this:
+ * (format nil "1 2~C3 4" (int-char 0))
+ * "1 23 4"
+ * whereas sbcl says int-char is undefined, and
+ * Guile returns "1 2\x003 4"
+ */
+}
+
+static void format_append_newline(s7_scheme *sc, format_data *fdat, s7_pointer port)
+{
+ port_write_character(port)(sc, '\n', port);
+ sc->format_column = 0;
+}
+
+
+static void format_append_string(s7_scheme *sc, format_data *fdat, const char *str, int len, s7_pointer port)
+{
+ port_write_string(port)(sc, str, len, port);
+ fdat->loc += len;
+ sc->format_column += len;
+}
+
+static void format_append_chars(s7_scheme *sc, format_data *fdat, char pad, int chars, s7_pointer port)
+{
+ int j;
+ if (chars > 0)
+ {
+ if (chars < TMPBUF_SIZE)
+ {
+ for (j = 0; j < chars; j++)
+ sc->tmpbuf[j] = pad;
+ sc->tmpbuf[chars] = '\0';
+ format_append_string(sc, fdat, sc->tmpbuf, chars, port);
+ }
+ else
+ {
+ for (j = 0; j < chars; j++)
+ format_append_char(sc, fdat, pad, port);
+ }
+ }
+}
+
+
+static int format_read_integer(s7_scheme *sc, int *cur_i, int str_len, const char *str, s7_pointer args, format_data *fdat)
+{
+ /* we know that str[*cur_i] is a digit */
+ int i, lval = 0;
+ for (i = *cur_i; i < str_len - 1; i++)
+ {
+ int dig;
+ dig = digits[(unsigned char)str[i]];
+ if (dig < 10)
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if ((int_multiply_overflow(lval, 10, &lval)) ||
+ (int_add_overflow(lval, dig, &lval)))
+ break;
+#else
+ lval = dig + (lval * 10);
+#endif
+ }
+ else break;
+ }
+
+ if (i >= str_len)
+ just_format_error(sc, "numeric argument, but no directive!", str, args, fdat);
+ *cur_i = i;
+ return(lval);
+}
+
+
+static void format_number(s7_scheme *sc, format_data *fdat, int radix, int width, int precision, char float_choice, char pad, s7_pointer port)
+{
+ char *tmp;
+ int nlen = 0;
+ if (width < 0) width = 0;
+
+ /* precision choice depends on float_choice if it's -1 */
+ if (precision < 0)
+ {
+ if ((float_choice == 'e') ||
+ (float_choice == 'f') ||
+ (float_choice == 'g'))
+ precision = 6;
+ else
+ {
+ /* in the "int" cases, precision depends on the arg type */
+ switch (type(car(fdat->args)))
+ {
+ case T_INTEGER:
+ case T_RATIO:
+ precision = 0;
+ break;
+
+ default:
+ precision = 6;
+ break;
+ }
+ }
+ }
+ /* should (format #f "~F" 1/3) return "1/3"?? in CL it's "0.33333334" */
+
+ tmp = number_to_string_with_radix(sc, car(fdat->args), radix, width, precision, float_choice, &nlen);
+ if (pad != ' ')
+ {
+ char *padtmp;
+ padtmp = tmp;
+ while (*padtmp == ' ') (*(padtmp++)) = pad;
+ }
+ format_append_string(sc, fdat, tmp, nlen, port);
+
+ free(tmp);
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+}
+
+
+static int format_nesting(const char *str, char opener, char closer, int start, int end) /* start=i, end=str_len-1 */
+{
+ int k, nesting = 1;
+ for (k = start + 2; k < end; k++)
+ if (str[k] == '~')
+ {
+ if (str[k + 1] == closer)
+ {
+ nesting--;
+ if (nesting == 0)
+ return(k - start - 1);
+ }
+ else
+ {
+ if (str[k + 1] == opener)
+ nesting++;
+ }
+ }
+ return(-1);
+}
+
+static bool format_method(s7_scheme *sc, const char *str, format_data *fdat, s7_pointer port)
+{
+ s7_pointer obj, func;
+
+ obj = car(fdat->args);
+ if ((has_methods(obj)) &&
+ ((func = find_method(sc, find_let(sc, obj), sc->FORMAT)) != sc->UNDEFINED))
+ {
+ s7_pointer ctrl_str;
+ if (fdat->orig_str)
+ ctrl_str = fdat->orig_str;
+ else ctrl_str = make_string_wrapper(sc, str);
+
+ obj = s7_apply_function(sc, func, cons(sc, ctrl_str, fdat->args));
+ if (is_string(obj))
+ {
+ format_append_string(sc, fdat, string_value(obj), string_length(obj), port);
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+ return(true);
+ }
+ }
+ return(false);
+}
+
+
+static int format_numeric_arg(s7_scheme *sc, const char *str, int str_len, format_data *fdat, s7_pointer args, int *i)
+{
+ #define MAX_FORMAT_WIDTH 10000
+ int width;
+ if ((str[*i] == 'n') || (str[*i] == 'N'))
+ {
+ *i = *i + 1;
+ if (is_null(fdat->args)) /* (format #f "~nT") */
+ just_format_error(sc, "~~N: missing argument", str, args, fdat);
+ if (!s7_is_integer(car(fdat->args)))
+ just_format_error(sc, "~~N: integer argument required", str, args, fdat);
+ width = (int)s7_integer(car(fdat->args));
+ fdat->args = cdr(fdat->args); /* I don't think fdat->ctr should be incremented here -- it's for *vector-print-length* etc */
+ }
+ else width = format_read_integer(sc, i, str_len, str, args, fdat);
+ if ((width < 0) || /* maybe overflow somewhere? */
+ (width > MAX_FORMAT_WIDTH))
+ just_format_error(sc, "width argument too big", str, args, fdat);
+ return(width);
+}
+
+
+#if WITH_GMP
+static bool s7_is_one_or_big_one(s7_pointer p);
+#else
+#define s7_is_one_or_big_one(Num) s7_is_one(Num)
+#endif
+
+static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj);
+
+static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *str, s7_pointer args,
+ s7_pointer *next_arg, bool with_result, bool columnized, int len, s7_pointer orig_str)
+{
+ int i, str_len;
+ format_data *fdat;
+ s7_pointer deferred_port;
+
+ if ((!with_result) &&
+ (port == sc->F))
+ return(sc->F);
+
+ if (len <= 0)
+ {
+ str_len = safe_strlen(str);
+ if (str_len == 0)
+ {
+ if (is_not_null(args))
+ {
+ static s7_pointer null_err = NULL;
+ if (!null_err)
+ null_err = s7_make_permanent_string("format control string is null, but there are arguments: ~S");
+ return(s7_error(sc, sc->FORMAT_ERROR, set_elist_2(sc, null_err, args)));
+ }
+ if (with_result)
+ return(make_string_wrapper_with_length(sc, "", 0));
+ return(sc->F);
+ }
+ }
+ else str_len = len;
+
+ sc->format_depth++;
+ if (sc->format_depth >= sc->num_fdats)
+ {
+ int k, new_num_fdats;
+ new_num_fdats = sc->format_depth * 2;
+ sc->fdats = (format_data **)realloc(sc->fdats, sizeof(format_data *) * new_num_fdats);
+ for (k = sc->num_fdats; k < new_num_fdats; k++) sc->fdats[k] = NULL;
+ sc->num_fdats = new_num_fdats;
+ }
+
+ fdat = sc->fdats[sc->format_depth];
+ if (!fdat)
+ {
+ fdat = (format_data *)malloc(sizeof(format_data));
+ sc->fdats[sc->format_depth] = fdat;
+ fdat->curly_len = 0;
+ fdat->curly_str = NULL;
+ fdat->ctr = 0;
+ }
+ else
+ {
+ if (fdat->port)
+ close_format_port(sc, fdat->port);
+ if (fdat->strport)
+ close_format_port(sc, fdat->strport);
+ }
+ fdat->port = NULL;
+ fdat->strport = NULL;
+ fdat->loc = 0;
+ fdat->args = args;
+ fdat->orig_str = orig_str;
+ fdat->curly_arg = sc->NIL;
+
+ /* choose whether to write to a temporary string port, or simply use the in-coming port
+ * if with_result, returned string is wanted.
+ * if port is sc->F, no non-string result is wanted.
+ * if port is not boolean, it better be a port.
+ * if we are about to goto START in eval, and main_stack_op(Sc) == OP_BEGIN1, no return string is wanted -- yow, this is not true
+ */
+
+ if (with_result)
+ {
+ deferred_port = port;
+ port = open_format_port(sc);
+ fdat->port = port;
+ }
+ else deferred_port = sc->F;
+
+ for (i = 0; i < str_len - 1; i++)
+ {
+ if ((unsigned char)(str[i]) == (unsigned char)'~') /* what does MS C want? */
+ {
+ use_write_t use_write;
+ switch (str[i + 1])
+ {
+ case '%': /* -------- newline -------- */
+ /* sbcl apparently accepts numeric args here (including 0) */
+
+ if ((port_data(port)) &&
+ (port_position(port) < port_data_size(port)))
+ {
+ port_data(port)[port_position(port)++] = '\n';
+ /* which is actually a bad idea, but as a desperate stopgap, I simply padded
+ * the string port string with 8 chars that are not in the length.
+ */
+ sc->format_column = 0;
+ }
+ else format_append_newline(sc, fdat, port);
+ i++;
+ break;
+
+ case '&': /* -------- conditional newline -------- */
+ if (sc->format_column > 0)
+ format_append_newline(sc, fdat, port);
+ i++;
+ break;
+
+ case '~': /* -------- tilde -------- */
+ format_append_char(sc, fdat, '~', port);
+ i++;
+ break;
+
+ case '\n': /* -------- trim white-space -------- */
+ for (i = i + 2; i <str_len - 1; i++)
+ if (!(white_space[(unsigned char)(str[i])]))
+ {
+ i--;
+ break;
+ }
+ break;
+
+ case '*': /* -------- ignore arg -------- */
+ i++;
+ if (is_null(fdat->args)) /* (format #f "~*~A") */
+ format_error(sc, "can't skip argument!", str, args, fdat);
+ fdat->args = cdr(fdat->args);
+ break;
+
+ case '|': /* -------- exit if args nil or ctr > *vector-print-length* -------- */
+ if ((is_pair(fdat->args)) &&
+ (fdat->ctr >= sc->print_length))
+ {
+ format_append_string(sc, fdat, " ...", 4, port);
+ fdat->args = sc->NIL;
+ }
+ /* fall through */
+
+ case '^': /* -------- exit -------- */
+ if (is_null(fdat->args))
+ {
+ i = str_len;
+ goto ALL_DONE;
+ }
+ i++;
+ break;
+
+ case '@': /* -------- plural, 'y' or 'ies' -------- */
+ i += 2;
+ if ((str[i] != 'P') && (str[i] != 'p'))
+ format_error(sc, "unknown '@' directive", str, args, fdat);
+ if (!s7_is_real(car(fdat->args))) /* CL accepts non numbers here */
+ format_error(sc, "'@P' directive argument is not a real number", str, args, fdat);
+
+ if (!s7_is_one_or_big_one(car(fdat->args)))
+ format_append_string(sc, fdat, "ies", 3, port);
+ else format_append_char(sc, fdat, 'y', port);
+
+ fdat->args = cdr(fdat->args);
+ break;
+
+ case 'P': case 'p': /* -------- plural in 's' -------- */
+ if (!s7_is_real(car(fdat->args)))
+ format_error(sc, "'P' directive argument is not a real number", str, args, fdat);
+ if (!s7_is_one_or_big_one(car(fdat->args)))
+ format_append_char(sc, fdat, 's', port);
+ i++;
+ fdat->args = cdr(fdat->args);
+ break;
+
+ case '{': /* -------- iteration -------- */
+ {
+ int curly_len;
+
+ if (is_null(fdat->args))
+ format_error(sc, "missing argument", str, args, fdat);
+
+ curly_len = format_nesting(str, '{', '}', i, str_len - 1);
+
+ if (curly_len == -1)
+ format_error(sc, "'{' directive, but no matching '}'", str, args, fdat);
+ if (curly_len == 1)
+ format_error(sc, "~{~}' doesn't consume any arguments!", str, args, fdat);
+
+ /* what about cons's here? I can't see any way in CL either to specify the car or cdr of a cons within the format string
+ * (cons 1 2) is applicable: ((cons 1 2) 0) -> 1
+ * also there can be applicable objects that won't work in the map context (arg not integer etc)
+ */
+ if (is_not_null(car(fdat->args))) /* (format #f "~{~A ~}" ()) -> "" */
+ {
+ s7_pointer curly_arg;
+ curly_arg = object_to_list(sc, car(fdat->args)); /* if a pair, this simply returns the original */
+ if (is_not_null(curly_arg)) /* (format #f "~{~A ~}" #()) -> "" */
+ {
+ char *curly_str = NULL; /* this is the local (nested) format control string */
+ s7_pointer orig_arg;
+
+ if (!is_proper_list(sc, curly_arg))
+ format_error(sc, "'{' directive argument should be a proper list or something we can turn into a list", str, args, fdat);
+
+ fdat->curly_arg = curly_arg;
+ if (curly_arg != car(fdat->args))
+ orig_arg = curly_arg;
+ else orig_arg = sc->NIL;
+
+ if (curly_len > fdat->curly_len)
+ {
+ if (fdat->curly_str) free (fdat->curly_str);
+ fdat->curly_len = curly_len;
+ fdat->curly_str = (char *)malloc(curly_len * sizeof(char));
+ }
+ curly_str = fdat->curly_str;
+ memcpy((void *)curly_str, (void *)(str + i + 2), curly_len - 1);
+ curly_str[curly_len - 1] = '\0';
+
+ if ((sc->format_depth < sc->num_fdats - 1) &&
+ (sc->fdats[sc->format_depth + 1]))
+ sc->fdats[sc->format_depth + 1]->ctr = 0;
+
+ /* it's not easy to use an iterator here instead of a list (so object->list isn't needed above),
+ * because the curly brackets may enclose multiple arguments -- we would need to use
+ * iterators throughout this function.
+ */
+ while (is_not_null(curly_arg))
+ {
+ s7_pointer new_arg = sc->NIL;
+ format_to_port_1(sc, port, curly_str, curly_arg, &new_arg, false, columnized, curly_len - 1, NULL);
+ if (curly_arg == new_arg)
+ {
+ fdat->curly_arg = sc->NIL;
+ format_error(sc, "'{...}' doesn't consume any arguments!", str, args, fdat);
+ }
+ curly_arg = new_arg;
+ }
+ fdat->curly_arg = sc->NIL;
+ while (is_pair(orig_arg))
+ {
+ s7_pointer p;
+ p = orig_arg;
+ orig_arg = cdr(orig_arg);
+ free_cell(sc, p); /* if car(fdar->args) is a hash-table, we could also free_cell(car(p)), but not in any other case */
+ }
+ }
+ }
+
+ i += (curly_len + 2); /* jump past the ending '}' too */
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+ }
+ break;
+
+ case '}':
+ format_error(sc, "unmatched '}'", str, args, fdat);
+
+ case 'W': case 'w':
+ use_write = USE_READABLE_WRITE;
+ goto OBJSTR;
+
+ case 'S': case 's':
+ use_write = USE_WRITE;
+ goto OBJSTR;
+
+ case 'A': case 'a':
+ use_write = USE_DISPLAY;
+ OBJSTR:
+ /* object->string */
+ {
+ s7_pointer obj, strport;
+ if (is_null(fdat->args))
+ format_error(sc, "missing argument", str, args, fdat);
+
+ i++;
+ obj = car(fdat->args);
+ /* for the column check, we need to know the length of the object->string output */
+ if (columnized)
+ {
+ strport = open_format_port(sc);
+ fdat->strport = strport;
+ }
+ else strport = port;
+ object_out(sc, obj, strport, use_write);
+ if (columnized)
+ {
+ if (port_position(strport) >= port_data_size(strport))
+ resize_port_data(strport, port_data_size(strport) * 2);
+
+ port_data(strport)[port_position(strport)] = '\0';
+ if (port_position(strport) > 0)
+ format_append_string(sc, fdat, (const char *)port_data(strport), port_position(strport), port);
+ close_format_port(sc, strport);
+ fdat->strport = NULL;
+ }
+
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+ }
+ break;
+
+
+ /* -------- numeric args -------- */
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9': case ',':
+ case 'N': case 'n':
+
+ case 'B': case 'b':
+ case 'D': case 'd':
+ case 'E': case 'e':
+ case 'F': case 'f':
+ case 'G': case 'g':
+ case 'O': case 'o':
+ case 'X': case 'x':
+
+ case 'T': case 't':
+ case 'C': case 'c':
+ {
+ int width = -1, precision = -1;
+ char pad = ' ';
+ i++; /* str[i] == '~' */
+
+ if ((isdigit((int)(str[i]))) ||
+ (str[i] == 'N') || (str[i] == 'n')) /* this is faster than the equivalent strchr */
+ width = format_numeric_arg(sc, str, str_len, fdat, args, &i);
+ if (str[i] == ',')
+ {
+ i++; /* is (format #f "~12,12D" 1) an error? The precision has no use here. */
+ if ((isdigit((int)(str[i]))) ||
+ (str[i] == 'N') || (str[i] == 'n'))
+ precision = format_numeric_arg(sc, str, str_len, fdat, args, &i);
+ else
+ {
+ if (str[i] == '\'') /* (format #f "~12,'xD" 1) -> "xxxxxxxxxxx1" */
+ {
+ pad = str[i + 1];
+ i += 2;
+ if (i >= str_len) /* (format #f "~,'") */
+ format_error(sc, "incomplete numeric argument", str, args, fdat);
+ }
+ /* is (let ((str "~12,'xD")) (set! (str 5) #\null) (format #f str 1)) an error? */
+ }
+ }
+
+ switch (str[i])
+ {
+ /* -------- pad to column --------
+ * are columns numbered from 1 or 0? there seems to be disagreement about this directive
+ * does "space over to" mean including?
+ */
+
+ case 'T': case 't':
+ if (width == -1) width = 0;
+ if (precision == -1) precision = 0;
+ if ((width > 0) || (precision > 0)) /* (format #f "a~8Tb") */
+ {
+ /* (length (substring (format #f "~%~10T.") 1)) == (length (format #f "~10T."))
+ * (length (substring (format #f "~%-~10T.~%") 1)) == (length (format #f "-~10T.~%"))
+ */
+ if (precision > 0)
+ {
+ int mult;
+ mult = (int)(ceil((s7_double)(sc->format_column + 1 - width) / (s7_double)precision)); /* CLtL2 ("least positive int") */
+ if (mult < 1) mult = 1;
+ width += (precision * mult);
+ }
+ format_append_chars(sc, fdat, pad, width - sc->format_column - 1, port);
+ }
+ break;
+
+ case 'C': case 'c':
+ {
+ s7_pointer obj;
+
+ if (is_null(fdat->args))
+ format_error(sc, "~~C: missing argument", str, args, fdat);
+ /* the "~~" here and below protects against "~C" being treated as a directive */
+ /* i++; */
+ obj = car(fdat->args);
+
+ if (!s7_is_character(obj))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "'C' directive requires a character argument", str, args, fdat);
+ }
+ else
+ {
+ /* here use_write is false, so we just add the char, not its name */
+ if (width == -1)
+ format_append_char(sc, fdat, character(obj), port);
+ else format_append_chars(sc, fdat, character(obj), width, port);
+ fdat->args = cdr(fdat->args);
+ fdat->ctr++;
+ }
+ }
+ break;
+
+ /* -------- numbers -------- */
+ case 'F': case 'f':
+ if (is_null(fdat->args))
+ format_error(sc, "~~F: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~F: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 10, width, precision, 'f', pad, port);
+ break;
+
+ case 'G': case 'g':
+ if (is_null(fdat->args))
+ format_error(sc, "~~G: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~G: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 10, width, precision, 'g', pad, port);
+ break;
+
+ case 'E': case 'e':
+ if (is_null(fdat->args))
+ format_error(sc, "~~E: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~E: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 10, width, precision, 'e', pad, port);
+ break;
+
+ /* how to handle non-integer arguments in the next 4 cases? clisp just returns
+ * the argument: (format nil "~X" 1.25) -> "1.25" which is perverse (ClTl2 p 581:
+ * "if arg is not an integer, it is printed in ~A format and decimal base")!!
+ * I think I'll use the type of the number to choose the output format.
+ */
+ case 'D': case 'd':
+ if (is_null(fdat->args))
+ format_error(sc, "~~D: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ /* (let () (require mockery.scm) (format #f "~D" ((*mock-number* 'mock-number) 123)))
+ * port here is a string-port, str has the width/precision data if the caller wants it,
+ * args is the current arg. But format_number handles fdat->args and so on, so
+ * I think I'll pass the format method the current control string (str), the
+ * current object (car(fdat->args)), and the arglist (args), and assume it will
+ * return a (scheme) string.
+ */
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~D: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 10, width, precision, 'd', pad, port);
+ break;
+
+ case 'O': case 'o':
+ if (is_null(fdat->args))
+ format_error(sc, "~~O: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~O: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 8, width, precision, 'o', pad, port);
+ break;
+
+ case 'X': case 'x':
+ if (is_null(fdat->args))
+ format_error(sc, "~~X: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~X: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 16, width, precision, 'x', pad, port);
+ break;
+
+ case 'B': case 'b':
+ if (is_null(fdat->args))
+ format_error(sc, "~~B: missing argument", str, args, fdat);
+ if (!(s7_is_number(car(fdat->args))))
+ {
+ if (!format_method(sc, str, fdat, port))
+ format_error(sc, "~~B: numeric argument required", str, args, fdat);
+ }
+ else format_number(sc, fdat, 2, width, precision, 'b', pad, port);
+ break;
+
+ default:
+ if (width > 0)
+ format_error(sc, "unused numeric argument", str, args, fdat);
+ format_error(sc, "unimplemented format directive", str, args, fdat);
+ }
+ }
+ break;
+
+ default:
+ format_error(sc, "unimplemented format directive", str, args, fdat);
+ }
+ }
+ else /* str[i] is not #\~ */
+ {
+ int j, new_len;
+ const char *p;
+
+ p = (char *)strchr((const char *)(str + i + 1), (int)'~');
+ if (!p)
+ j = str_len;
+ else j = (int)(p - str);
+ new_len = j - i;
+
+ if ((port_data(port)) &&
+ ((port_position(port) + new_len) < port_data_size(port)))
+ {
+ memcpy((void *)(port_data(port) + port_position(port)), (void *)(str + i), new_len);
+ port_position(port) += new_len;
+ }
+ else port_write_string(port)(sc, (char *)(str + i), new_len, port);
+ fdat->loc += new_len;
+ sc->format_column += new_len;
+ i = j - 1;
+ }
+ }
+
+ ALL_DONE:
+ if (next_arg)
+ (*next_arg) = fdat->args;
+ else
+ {
+ if (is_not_null(fdat->args))
+ format_error(sc, "too many arguments", str, args, fdat);
+ }
+ if (i < str_len)
+ {
+ if (str[i] == '~')
+ format_error(sc, "control string ends in tilde", str, args, fdat);
+ format_append_char(sc, fdat, str[i], port);
+ }
+
+ sc->format_depth--;
+
+ if (with_result)
+ {
+ s7_pointer result;
+
+ if ((is_output_port(deferred_port)) &&
+ (port_position(port) > 0))
+ {
+ port_data(port)[port_position(port)] = '\0';
+ port_write_string(deferred_port)(sc, (const char *)port_data(port), port_position(port), deferred_port);
+ }
+ result = s7_make_string_with_length(sc, (char *)port_data(port), port_position(port));
+ close_format_port(sc, port);
+ fdat->port = NULL;
+ return(result);
+ }
+ return(sc->F);
+}
+
+
+static bool is_columnizing(const char *str)
+{
+ /* look for ~t ~,<int>T ~<int>,<int>t */
+ char *p;
+
+ for (p = (char *)str; (*p);)
+ if (*p++ == '~') /* this is faster than strchr */
+ {
+ char c;
+ c = *p++;
+ if ((c == 't') || (c == 'T')) return(true);
+ if (!c) return(false);
+ if ((c == ',') || ((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N'))
+ {
+ while (((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N')) c = *p++;
+ if ((c == 't') || (c == 'T')) return(true);
+ if (!c) return(false); /* ~,1 for example */
+ if (c == ',')
+ {
+ c = *p++;
+ while (((c >= '0') && (c <= '9')) || (c == 'n') || (c == 'N')) c = *p++;
+ if ((c == 't') || (c == 'T')) return(true);
+ if (!c) return(false);
+ }
+ }
+ }
+ return(false);
+}
+
+
+static s7_pointer format_to_port(s7_scheme *sc, s7_pointer port, const char *str, s7_pointer args, s7_pointer *next_arg, bool with_result, int len)
+{
+ return(format_to_port_1(sc, port, str, args, next_arg, with_result, true /* is_columnizing(str) */, len, NULL));
+ /* is_columnizing on every call is much slower than ignoring the issue */
+}
+
+
+static s7_pointer g_format_1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer pt, str;
+ sc->format_column = 0;
+ pt = car(args);
+
+ if (is_string(pt))
+ return(format_to_port_1(sc, sc->F, string_value(pt), cdr(args), NULL, true, true, string_length(pt), pt));
+ if (is_null(pt)) pt = sc->output_port; /* () -> (current-output-port) */
+
+ if (!((s7_is_boolean(pt)) || /* #f or #t */
+ ((is_output_port(pt)) && /* (current-output-port) or call-with-open-file arg, etc */
+ (!port_is_closed(pt)))))
+ method_or_bust_with_type(sc, pt, sc->FORMAT, args, AN_OUTPUT_PORT, 1);
+
+ str = cadr(args);
+ if (!is_string(str))
+ method_or_bust(sc, str, sc->FORMAT, args, T_STRING, 2);
+
+ return(format_to_port_1(sc, (pt == sc->T) ? sc->output_port : pt,
+ string_value(str), cddr(args), NULL, !is_output_port(pt), true, string_length(str), str));
+}
+
+
+static s7_pointer g_format(s7_scheme *sc, s7_pointer args)
+{
+ #define H_format "(format out str . args) substitutes args into str sending the result to out. Most of \
+s7's format directives are taken from CL: ~% = newline, ~& = newline if the preceding output character was \
+no a newline, ~~ = ~, ~<newline> trims white space, ~* skips an argument, ~^ exits {} iteration if the arg list is exhausted, \
+~nT spaces over to column n, ~A prints a representation of any object, ~S is the same, but puts strings in double quotes, \
+~C prints a character, numbers are handled by ~F, ~E, ~G, ~B, ~O, ~D, and ~X with preceding numbers giving \
+spacing (and spacing character) and precision. ~{ starts an embedded format directive which is ended by ~}: \n\
+\n\
+ >(format #f \"dashed: ~{~A~^-~}\" '(1 2 3))\n\
+ \"dashed: 1-2-3\"\n\
+\n\
+~P inserts \"s\" if the current it is not 1 or 1.0 (use ~@P for \"ies\" or \"y\").\n\
+~B is number->string in base 2, ~O in base 8, ~D base 10, ~X base 16,\n\
+~E: (format #f \"~E\" 100.1) -> \"1.001000e+02\" (%e in C)\n\
+~F: (format #f \"~F\" 100.1) -> \"100.100000\" (%f in C)\n\
+~G: (format #f \"~G\" 100.1) -> \"100.1\" (%g in C)\n\
+\n\
+If the 'out' it is not an output port, the resultant string is returned. If it \
+is #t, the string is also sent to the current-output-port."
+
+ #define Q_format s7_make_circular_signature(sc, 1, 2, s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_BOOLEAN), sc->T)
+ return(g_format_1(sc, args));
+}
+
+
+const char *s7_format(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer result;
+ result = g_format_1(sc, args);
+ if (is_string(result))
+ return(string_value(result));
+ return(NULL);
+}
+
+
+
+/* -------------------------------- system extras -------------------------------- */
+
+#if WITH_SYSTEM_EXTRAS
+#include <fcntl.h>
+
+static s7_pointer g_is_directory(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_directory "(directory? str) returns #t if str is the name of a directory"
+ #define Q_is_directory s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_STRING)
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->IS_DIRECTORY, args, T_STRING, 0);
+ return(s7_make_boolean(sc, is_directory(string_value(name))));
+}
+
+
+static bool file_probe(const char *arg)
+{
+#if (!MS_WINDOWS)
+ return(access(arg, F_OK) == 0);
+#else
+ int fd;
+ fd = open(arg, O_RDONLY, 0);
+ if (fd == -1) return(false);
+ close(fd);
+ return(true);
+#endif
+}
+
+
+static s7_pointer g_file_exists(s7_scheme *sc, s7_pointer args)
+{
+ #define H_file_exists "(file-exists? filename) returns #t if the file exists"
+ #define Q_file_exists s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_STRING)
+
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->FILE_EXISTS, args, T_STRING, 0);
+ return(s7_make_boolean(sc, file_probe(string_value(name))));
+}
+
+
+static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args)
+{
+ #define H_delete_file "(delete-file filename) deletes the file filename."
+ #define Q_delete_file s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_STRING)
+
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->DELETE_FILE, args, T_STRING, 0);
+ return(make_integer(sc, unlink(string_value(name))));
+}
+
+
+static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args)
+{
+ #define H_getenv "(getenv var) returns the value of an environment variable."
+ #define Q_getenv pcl_s
+
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->GETENV, args, T_STRING, 0);
+ return(s7_make_string(sc, getenv(string_value(name))));
+}
+
+
+static s7_pointer g_system(s7_scheme *sc, s7_pointer args)
+{
+ #define H_system "(system command) executes the command. If the optional second it is #t, \
+system captures the output as a string and returns it."
+ #define Q_system s7_make_signature(sc, 3, sc->T, sc->IS_STRING, sc->IS_BOOLEAN)
+
+ s7_pointer name;
+ name = car(args);
+
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->SYSTEM, args, T_STRING, 0);
+
+ if ((is_pair(cdr(args))) &&
+ (cadr(args) == sc->T))
+ {
+ #define BUF_SIZE 256
+ char buf[BUF_SIZE];
+ char *str = NULL;
+ int cur_len = 0, full_len = 0;
+ FILE *fd;
+ s7_pointer res;
+
+ fd = popen(string_value(name), "r");
+ while (fgets(buf, BUF_SIZE, fd))
+ {
+ int buf_len;
+ buf_len = safe_strlen(buf);
+ if (cur_len + buf_len >= full_len)
+ {
+ full_len += BUF_SIZE * 2;
+ if (str)
+ str = (char *)realloc(str, full_len * sizeof(char));
+ else str = (char *)malloc(full_len * sizeof(char));
+ }
+ memcpy((void *)(str + cur_len), (void *)buf, buf_len);
+ cur_len += buf_len;
+ }
+ pclose(fd);
+
+ res = s7_make_string_with_length(sc, str, cur_len);
+ if (str) free(str);
+ return(res);
+ }
+ return(make_integer(sc, system(string_value(name))));
+}
+
+
+#ifndef _MSC_VER
+#include <dirent.h>
+
+static s7_pointer c_directory_to_list(s7_scheme *sc, s7_pointer name)
+{
+ DIR *dpos;
+ s7_pointer result;
+
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->DIRECTORY_TO_LIST, list_1(sc, name), T_STRING, 0);
+
+ sc->w = sc->NIL;
+ if ((dpos = opendir(string_value(name))) != NULL)
+ {
+ struct dirent *dirp;
+ while ((dirp = readdir(dpos)) != NULL)
+ sc->w = cons(sc, s7_make_string(sc, dirp->d_name), sc->w);
+ closedir(dpos);
+ }
+
+ result = sc->w;
+ sc->w = sc->NIL;
+ return(result);
+}
+
+static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_directory_to_list "(directory->list directory) returns the contents of the directory as a list of strings (filenames)."
+ #define Q_directory_to_list s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_STRING)
+ return(c_directory_to_list(sc, car(args)));
+}
+
+PF_TO_PF(directory_to_list, c_directory_to_list)
+
+
+static s7_pointer g_file_mtime(s7_scheme *sc, s7_pointer args)
+{
+ #define H_file_mtime "(file-mtime file): return the write date of file"
+ #define Q_file_mtime s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_STRING)
+
+ struct stat statbuf;
+ int err;
+ s7_pointer name;
+
+ name = car(args);
+ if (!is_string(name))
+ method_or_bust(sc, name, sc->FILE_MTIME, args, T_STRING, 0);
+
+ err = stat(string_value(name), &statbuf);
+ if (err < 0)
+ return(file_error(sc, "file-mtime", strerror(errno), string_value(name)));
+
+ return(s7_make_integer(sc, (s7_int)(statbuf.st_mtime)));
+}
+#endif
+#endif
+
+
+
+/* -------------------------------- lists -------------------------------- */
+
+s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+ car(x) = a;
+ cdr(x) = b;
+ return(x);
+}
+
+
+static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ /* apparently slightly faster as a function? */
+ s7_pointer x;
+ new_cell_no_check(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+ car(x) = a;
+ cdr(x) = b;
+ return(x);
+}
+
+
+static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, unsigned int type)
+{
+ /* for the symbol table which is never GC'd (and its contents aren't marked) */
+ s7_pointer x;
+ x = alloc_pointer();
+ set_type(x, type);
+ unheap(x);
+ car(x) = a;
+ cdr(x) = b;
+ return(x);
+}
+
+static s7_pointer permanent_list(s7_scheme *sc, int len)
+{
+ int j;
+ s7_pointer p;
+ p = sc->NIL;
+ for (j = 0; j < len; j++)
+ p = permanent_cons(sc->NIL, p, T_PAIR | T_IMMUTABLE);
+ return(p);
+}
+
+#if DEBUGGING
+static int sigs = 0, sig_pairs = 0;
+#endif
+
+s7_pointer s7_make_signature(s7_scheme *sc, int len, ...)
+{
+ va_list ap;
+ s7_pointer p, res;
+#if DEBUGGING
+ sigs++;
+ sig_pairs += len;
+#endif
+
+ res = permanent_list(sc, len);
+ va_start(ap, len);
+ for (p = res; is_pair(p); p = cdr(p))
+ {
+ car(p) = va_arg(ap, s7_pointer);
+#if DEBUGGING
+ if (!car(p))
+ {
+ fprintf(stderr, "missed type check in procedure-signature\n");
+ abort();
+ }
+#endif
+ }
+ va_end(ap);
+
+ return((s7_pointer)res);
+}
+
+s7_pointer s7_make_circular_signature(s7_scheme *sc, int cycle_point, int len, ...)
+{
+ va_list ap;
+ int i;
+ s7_pointer p, res, back = NULL, end = NULL;
+#if DEBUGGING
+ sigs++;
+ sig_pairs += len;
+#endif
+
+ res = permanent_list(sc, len);
+ va_start(ap, len);
+ for (p = res, i = 0; is_pair(p); p = cdr(p), i++)
+ {
+ car(p) = va_arg(ap, s7_pointer);
+ if (i == cycle_point) back = p;
+ if (i == (len - 1)) end = p;
+#if DEBUGGING
+ if (!car(p))
+ {
+ fprintf(stderr, "missed type check in (circular) procedure-signature\n");
+ abort();
+ }
+#endif
+ }
+ va_end(ap);
+ cdr(end) = back;
+ return((s7_pointer)res);
+}
+
+
+bool s7_is_pair(s7_pointer p)
+{
+ return(is_pair(p));
+}
+
+
+s7_pointer s7_car(s7_pointer p) {return(car(p));}
+s7_pointer s7_cdr(s7_pointer p) {return(cdr(p));}
+
+s7_pointer s7_cadr(s7_pointer p) {return(cadr(p));}
+s7_pointer s7_cddr(s7_pointer p) {return(cddr(p));}
+s7_pointer s7_cdar(s7_pointer p) {return(cdar(p));}
+s7_pointer s7_caar(s7_pointer p) {return(caar(p));}
+
+s7_pointer s7_caadr(s7_pointer p) {return(caadr(p));}
+s7_pointer s7_caddr(s7_pointer p) {return(caddr(p));}
+s7_pointer s7_cadar(s7_pointer p) {return(cadar(p));}
+s7_pointer s7_caaar(s7_pointer p) {return(caaar(p));}
+s7_pointer s7_cdadr(s7_pointer p) {return(cdadr(p));}
+s7_pointer s7_cdddr(s7_pointer p) {return(cdddr(p));}
+s7_pointer s7_cddar(s7_pointer p) {return(cddar(p));}
+s7_pointer s7_cdaar(s7_pointer p) {return(cdaar(p));}
+
+s7_pointer s7_caaadr(s7_pointer p) {return(caaadr(p));}
+s7_pointer s7_caaddr(s7_pointer p) {return(caaddr(p));}
+s7_pointer s7_caadar(s7_pointer p) {return(caadar(p));}
+s7_pointer s7_caaaar(s7_pointer p) {return(caaaar(p));}
+s7_pointer s7_cadadr(s7_pointer p) {return(cadadr(p));}
+s7_pointer s7_cadddr(s7_pointer p) {return(cadddr(p));}
+s7_pointer s7_caddar(s7_pointer p) {return(caddar(p));}
+s7_pointer s7_cadaar(s7_pointer p) {return(cadaar(p));}
+
+s7_pointer s7_cdaadr(s7_pointer p) {return(cdaadr(p));}
+s7_pointer s7_cdaddr(s7_pointer p) {return(cdaddr(p));}
+s7_pointer s7_cdadar(s7_pointer p) {return(cdadar(p));}
+s7_pointer s7_cdaaar(s7_pointer p) {return(cdaaar(p));}
+s7_pointer s7_cddadr(s7_pointer p) {return(cddadr(p));}
+s7_pointer s7_cddddr(s7_pointer p) {return(cddddr(p));}
+s7_pointer s7_cdddar(s7_pointer p) {return(cdddar(p));}
+s7_pointer s7_cddaar(s7_pointer p) {return(cddaar(p));}
+
+
+s7_pointer s7_set_car(s7_pointer p, s7_pointer q)
+{
+ car(p) = q;
+ return(p);
+}
+
+
+s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q)
+{
+ cdr(p) = q;
+ return(p);
+}
+
+/* -------------------------------------------------------------------------------- */
+
+s7_pointer s7_apply_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1))
+{
+ /* not currently used */
+ return(f1(car(args)));
+}
+
+s7_pointer s7_apply_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2))
+{
+ return(f2(car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3))
+{
+ s7_pointer a1;
+ a1 = car(args); args = cdr(args);
+ return(f3(a1, car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4))
+{
+ s7_pointer a1, a2;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ return(f4(a1, a2, car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_5(s7_scheme *sc, s7_pointer args, s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5))
+{
+ s7_pointer a1, a2, a3, a4;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ return(f5(a1, a2, a3, a4, car(args)));
+}
+
+s7_pointer s7_apply_6(s7_scheme *sc, s7_pointer args, s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6))
+{
+ s7_pointer a1, a2, a3, a4;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ return(f6(a1, a2, a3, a4, car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_7(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6, s7_pointer a7))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ a5 = car(args); a6 = cadr(args); args = cddr(args);
+ return(f7(a1, a2, a3, a4, a5, a6, car(args)));
+}
+
+s7_pointer s7_apply_8(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ a5 = car(args); a6 = cadr(args); args = cddr(args);
+ return(f8(a1, a2, a3, a4, a5, a6, car(args), cadr(args)));
+}
+
+s7_pointer s7_apply_9(s7_scheme *sc, s7_pointer args, s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8, s7_pointer a9))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6;
+ a1 = car(args); a2 = cadr(args); args = cddr(args);
+ a3 = car(args); a4 = cadr(args); args = cddr(args);
+ a5 = car(args); a6 = cadr(args); args = cddr(args);
+ return(f9(a1, a2, a3, a4, a5, a6, car(args), cadr(args), caddr(args)));
+}
+
+s7_pointer s7_apply_n_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1))
+{
+ if (is_pair(args))
+ return(f1(car(args)));
+ return(f1(sc->UNDEFINED));
+}
+
+s7_pointer s7_apply_n_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2))
+{
+ if (is_pair(args))
+ {
+ if (is_pair(cdr(args)))
+ return(f2(car(args), cadr(args)));
+ return(f2(car(args), sc->UNDEFINED));
+ }
+ return(f2(sc->UNDEFINED, sc->UNDEFINED));
+}
+
+s7_pointer s7_apply_n_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3))
+{
+ if (is_pair(args))
+ {
+ s7_pointer a1;
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a2;
+ a2 = car(args);
+ if (is_pair(cdr(args)))
+ return(f3(a1, a2, cadr(args)));
+ return(f3(a1, a2, sc->UNDEFINED));
+ }
+ return(f3(a1, sc->UNDEFINED, sc->UNDEFINED));
+ }
+ return(f3(sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED));
+}
+
+s7_pointer s7_apply_n_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4))
+{
+ if (is_pair(args))
+ {
+ s7_pointer a1;
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a2;
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a3;
+ a3 = car(args);
+ if (is_pair(cdr(args)))
+ return(f4(a1, a2, a3, cadr(args)));
+ return(f4(a1, a2, a3, sc->UNDEFINED));
+ }
+ return(f4(a1, a2, sc->UNDEFINED, sc->UNDEFINED));
+ }
+ return(f4(a1, sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED));
+ }
+ return(f4(sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED));
+}
+
+s7_pointer s7_apply_n_5(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5))
+{
+ if (is_pair(args))
+ {
+ s7_pointer a1;
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a2;
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a3;
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ s7_pointer a4;
+ a4 = car(args);
+ if (is_pair(cdr(args)))
+ return(f5(a1, a2, a3, a4, cadr(args)));
+ return(f5(a1, a2, a3, a4, sc->UNDEFINED));
+ }
+ return(f5(a1, a2, a3, sc->UNDEFINED, sc->UNDEFINED));
+ }
+ return(f5(a1, a2, sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED));
+ }
+ return(f5(a1, sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED));
+ }
+ return(f5(sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED, sc->UNDEFINED));
+}
+
+s7_pointer s7_apply_n_6(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5, s7_pointer a6))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6;
+ a1 = sc->UNDEFINED; a2 = sc->UNDEFINED; a3 = sc->UNDEFINED; a4 = sc->UNDEFINED; a5 = sc->UNDEFINED; a6 = sc->UNDEFINED;
+ if (is_pair(args))
+ {
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a4 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a5 = car(args);
+ if (is_pair(cdr(args))) a6 = cadr(args);
+ }}}}}
+ return(f6(a1, a2, a3, a4, a5, a6));
+}
+
+s7_pointer s7_apply_n_7(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6, a7;
+ a1 = sc->UNDEFINED; a2 = sc->UNDEFINED; a3 = sc->UNDEFINED; a4 = sc->UNDEFINED; a5 = sc->UNDEFINED;
+ a6 = sc->UNDEFINED, a7 = sc->UNDEFINED;
+ if (is_pair(args))
+ {
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a4 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a5 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a6 = car(args);
+ if (is_pair(cdr(args))) a7 = cadr(args);
+ }}}}}}
+ return(f7(a1, a2, a3, a4, a5, a6, a7));
+}
+
+s7_pointer s7_apply_n_8(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6, a7, a8;
+ a1 = sc->UNDEFINED; a2 = sc->UNDEFINED; a3 = sc->UNDEFINED; a4 = sc->UNDEFINED; a5 = sc->UNDEFINED;
+ a6 = sc->UNDEFINED, a7 = sc->UNDEFINED; a8 = sc->UNDEFINED;
+ if (is_pair(args))
+ {
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a4 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a5 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a6 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a7 = car(args);
+ if (is_pair(cdr(args))) a8 = cadr(args);
+ }}}}}}}
+ return(f8(a1, a2, a3, a4, a5, a6, a7, a8));
+}
+
+s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8,
+ s7_pointer a9))
+{
+ s7_pointer a1, a2, a3, a4, a5, a6, a7, a8, a9;
+ a1 = sc->UNDEFINED; a2 = sc->UNDEFINED; a3 = sc->UNDEFINED; a4 = sc->UNDEFINED; a5 = sc->UNDEFINED;
+ a6 = sc->UNDEFINED, a7 = sc->UNDEFINED; a8 = sc->UNDEFINED; a9 = sc->UNDEFINED;
+ if (is_pair(args))
+ {
+ a1 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a2 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a3 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a4 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a5 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a6 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a7 = car(args); args = cdr(args);
+ if (is_pair(args))
+ {
+ a8 = car(args);
+ if (is_pair(cdr(args))) a9 = cadr(args);
+ }}}}}}}}
+ return(f9(a1, a2, a3, a4, a5, a6, a7, a8, a9));
+}
+
+/* -------------------------------------------------------------------------------- */
+
+
+
+s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, int num)
+{
+ int i;
+ s7_pointer x;
+ for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
+ if ((i == num) && (is_pair(x)))
+ return(car(x));
+ return(sc->NIL);
+}
+
+
+s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, int num, s7_pointer val)
+{
+ int i;
+ s7_pointer x;
+ for (x = lst, i = 0; (i < num) && (is_pair(x)); i++, x = cdr(x)) {}
+ if ((i == num) &&
+ (is_pair(x)))
+ car(x) = val;
+ return(val);
+}
+
+
+s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+{
+ s7_pointer x;
+ for (x = lst; is_pair(x); x = cdr(x))
+ if (s7_is_equal(sc, sym, car(x)))
+ return(x);
+ return(sc->F);
+}
+
+
+static bool symbol_is_in_arg_list(s7_pointer sym, s7_pointer lst)
+{
+ s7_pointer x;
+ for (x = lst; is_pair(x); x = cdr(x))
+ if ((sym == car(x)) ||
+ ((is_pair(car(x))) &&
+ (sym == caar(x))))
+ return(true);
+ return(sym == x);
+}
+
+
+s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst)
+{
+ s7_pointer x, y;
+
+ if (!is_pair(lst))
+ return(sc->F);
+
+ x = lst;
+ y = lst;
+ while (true)
+ {
+ if ((is_pair(car(x))) && (s7_is_equal(sc, sym, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((is_pair(car(x))) && (s7_is_equal(sc, sym, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+}
+
+
+s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a)
+{
+ /* reverse list -- produce new list (other code assumes this function does not return the original!) */
+ s7_pointer x, p;
+
+ if (is_null(a)) return(a);
+
+ if (!is_pair(cdr(a)))
+ {
+ if (is_not_null(cdr(a)))
+ return(cons(sc, cdr(a), car(a)));
+ return(cons(sc, car(a), sc->NIL)); /* don't return 'a' itself */
+ }
+
+ sc->w = list_1(sc, car(a));
+ for (x = cdr(a), p = a; is_pair(x); x = cdr(x), p = cdr(p))
+ {
+ sc->w = cons(sc, car(x), sc->w);
+ if (is_pair(cdr(x)))
+ {
+ x = cdr(x);
+ sc->w = cons(sc, car(x), sc->w);
+ }
+ if (x == p) /* this can take awhile to notice there's a cycle, but what does the caller expect? */
+ break;
+ }
+
+ if (is_not_null(x))
+ p = cons(sc, x, sc->w); /* ?? this means that (reverse '(1 2 . 3)) returns '(3 2 1) -- we used to return () here */
+ else p = sc->w;
+
+ sc->w = sc->NIL;
+ return(p);
+}
+
+/* s7_reverse sometimes tacks extra nodes on the end of a reversed circular list (it detects the cycle too late)
+ * (let ((lst (list 0))) (set! (cdr lst) lst) (reverse lst)) -> (#1=(0 . #1#) 0 0 0)
+ */
+
+
+static s7_pointer reverse_in_place(s7_scheme *sc, s7_pointer term, s7_pointer list)
+{
+ s7_pointer p = list, result = term, q;
+
+ while (is_not_null(p))
+ {
+ q = cdr(p);
+ if ((!is_pair(q)) &&
+ (is_not_null(q)))
+ return(sc->NIL); /* improper list? */
+ cdr(p) = result;
+ result = p;
+ p = q;
+ }
+ return(result);
+}
+
+
+static s7_pointer reverse_in_place_unchecked(s7_scheme *sc, s7_pointer term, s7_pointer list)
+{
+ s7_pointer p = list, result = term, q;
+
+ while (is_not_null(p))
+ {
+ q = cdr(p);
+ cdr(p) = result;
+ result = p;
+ p = q;
+
+ if (is_null(p)) break;
+ q = cdr(p);
+ cdr(p) = result;
+ result = p;
+ p = q;
+ }
+ return(result);
+}
+
+
+static s7_pointer safe_reverse_in_place(s7_scheme *sc, s7_pointer list) /* "safe" here means we guarantee this list is unproblematic */
+{
+ s7_pointer p = list, result, q;
+ result = sc->NIL;
+
+ while (is_not_null(p))
+ {
+ q = cdr(p);
+ /* also if (is_null(list)) || (is_null(cdr(list))) return(list) */
+ cdr(p) = result;
+ result = p;
+ p = q;
+
+ /* unroll the loop for speed */
+ if (is_null(p)) break;
+ q = cdr(p);
+ cdr(p) = result;
+ result = p;
+ p = q;
+
+ if (is_null(p)) break;
+ q = cdr(p);
+ cdr(p) = result;
+ result = p;
+ p = q;
+
+ if (is_null(p)) break;
+ q = cdr(p);
+ cdr(p) = result;
+ result = p;
+ p = q;
+ }
+ return(result);
+}
+
+
+/* is this correct? (let ((x (list 1 2))) (eq? x (append () x))) -> #t
+ */
+
+s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ s7_pointer p, tp, np;
+ if (is_null(a)) return(b);
+
+ tp = cons(sc, car(a), sc->NIL);
+ sc->y = tp;
+ for (p = cdr(a), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+ cdr(np) = cons(sc, car(p), sc->NIL);
+ cdr(np) = b;
+ sc->y = sc->NIL;
+
+ return(tp);
+}
+
+
+static s7_pointer copy_list(s7_scheme *sc, s7_pointer lst)
+{
+ s7_pointer p, tp, np;
+ if (!is_pair(lst)) return(sc->NIL);
+ tp = cons(sc, car(lst), sc->NIL);
+ sc->y = tp;
+ for (p = cdr(lst), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+ cdr(np) = cons(sc, car(p), sc->NIL);
+ sc->y = sc->NIL;
+ return(tp);
+}
+
+
+static s7_pointer copy_list_with_arglist_error(s7_scheme *sc, s7_pointer lst)
+{
+ s7_pointer p, tp, np;
+ if (is_null(lst)) return(sc->NIL);
+ if (!is_pair(lst))
+ s7_error(sc, sc->SYNTAX_ERROR, set_elist_2(sc, make_string_wrapper(sc, "stray dot?: ~S"), lst));
+ tp = cons(sc, car(lst), sc->NIL);
+ sc->y = tp;
+ for (p = cdr(lst), np = tp; is_pair(p); p = cdr(p), np = cdr(np))
+ cdr(np) = cons(sc, car(p), sc->NIL);
+ sc->y = sc->NIL;
+ if (!is_null(p))
+ s7_error(sc, sc->SYNTAX_ERROR, set_elist_2(sc, make_string_wrapper(sc, "improper list of arguments: ~S"), lst));
+ return(tp);
+}
+
+
+static s7_pointer revappend(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ /* (map (lambda (x) (if (odd? x) (apply values '(1 2 3)) (values))) (list 1 2 3 4))
+ * is a bad case -- we have to copy the incoming list.
+ */
+ s7_pointer p = b, q;
+
+ if (is_not_null(a))
+ {
+ a = copy_list(sc, a);
+ while (is_not_null(a))
+ {
+ q = cdr(a);
+ cdr(a) = p;
+ p = a;
+ a = q;
+ }
+ }
+ return(p);
+}
+
+static int safe_list_length(s7_scheme *sc, s7_pointer a)
+{
+ /* assume that "a" is a proper list */
+ int i = 0;
+ s7_pointer b;
+ for (b = a; is_pair(b); i++, b = cdr(b)) {};
+ return(i);
+}
+
+
+int s7_list_length(s7_scheme *sc, s7_pointer a)
+{
+ /* returns -len if list is dotted, 0 if it's (directly) circular */
+ int i;
+ s7_pointer slow, fast;
+
+ slow = fast = a;
+ for (i = 0; ; i += 2)
+ {
+ if (!is_pair(fast))
+ {
+ if (is_null(fast))
+ return(i);
+ return(-i);
+ }
+
+ fast = cdr(fast);
+ if (!is_pair(fast))
+ {
+ if (is_null(fast))
+ return(i + 1);
+ return(-i - 1);
+ }
+ /* if unrolled further, it's a lot slower? */
+
+ fast = cdr(fast);
+ slow = cdr(slow);
+ if (fast == slow)
+ return(0);
+ }
+ return(0);
+}
+
+
+/* -------------------------------- null? pair? -------------------------------- */
+static s7_pointer g_is_null(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_null "(null? obj) returns #t if obj is the empty list"
+ #define Q_is_null pl_bt
+ check_boolean_method(sc, is_null, sc->IS_NULL, args);
+ /* as a generic this could be: has_structure and length == 0 */
+}
+
+
+static s7_pointer g_is_pair(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_pair "(pair? obj) returns #t if obj is a pair (a non-empty list)"
+ #define Q_is_pair pl_bt
+ check_boolean_method(sc, is_pair, sc->IS_PAIR, args);
+}
+
+
+/* -------------------------------- list? proper-list? -------------------------------- */
+bool s7_is_list(s7_scheme *sc, s7_pointer p)
+{
+ return((is_pair(p)) ||
+ (is_null(p)));
+}
+
+
+static bool is_proper_list(s7_scheme *sc, s7_pointer lst)
+{
+ s7_pointer slow, fast;
+
+ fast = lst;
+ slow = lst;
+ while (true)
+ {
+ if (!is_pair(fast))
+ return(is_null(fast)); /* else it's an improper list */
+
+ fast = cdr(fast);
+ if (!is_pair(fast)) return(is_null(fast));
+
+ fast = cdr(fast);
+ if (!is_pair(fast)) return(is_null(fast));
+
+ fast = cdr(fast);
+ slow = cdr(slow);
+ if (fast == slow) return(false);
+ }
+ return(true);
+}
+
+
+static s7_pointer g_is_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_list "(list? obj) returns #t if obj is a pair or null"
+ #define Q_is_list pl_bt
+ #define is_a_list(p) s7_is_list(sc, p)
+ check_boolean_method(sc, is_a_list, sc->IS_LIST, args);
+}
+
+
+/* -------------------------------- make-list -------------------------------- */
+static s7_pointer make_list(s7_scheme *sc, int len, s7_pointer init)
+{
+ switch (len)
+ {
+ case 0: return(sc->NIL);
+ case 1: return(cons(sc, init, sc->NIL));
+ case 2: return(cons_unchecked(sc, init, cons(sc, init, sc->NIL)));
+ case 3: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->NIL))));
+ case 4: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->NIL)))));
+ case 5: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
+ cons_unchecked(sc, init, cons(sc, init, sc->NIL))))));
+ case 6: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
+ cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->NIL)))))));
+ case 7: return(cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init,
+ cons_unchecked(sc, init, cons_unchecked(sc, init, cons_unchecked(sc, init, cons(sc, init, sc->NIL))))))));
+ default:
+ {
+ s7_pointer result;
+ int i;
+
+ if (len >= (sc->free_heap_top - sc->free_heap))
+ {
+ gc(sc);
+ while (len >= (sc->free_heap_top - sc->free_heap))
+ resize_heap(sc);
+ }
+
+ sc->v = sc->NIL;
+ for (i = 0; i < len; i++)
+ sc->v = cons_unchecked(sc, init, sc->v);
+ result = sc->v;
+ sc->v = sc->NIL;
+ return(result);
+ }
+ }
+ return(sc->NIL); /* never happens, I hope */
+}
+
+
+static s7_pointer g_make_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_list "(make-list length (initial-element #f)) returns a list of 'length' elements whose value is 'initial-element'."
+ #define Q_make_list s7_make_signature(sc, 3, sc->IS_LIST, sc->IS_INTEGER, sc->T)
+
+ s7_pointer init;
+ s7_int len;
+
+ if (!s7_is_integer(car(args)))
+ method_or_bust(sc, car(args), sc->MAKE_LIST, args, T_INTEGER, 1);
+
+ len = s7_integer(car(args)); /* needs to be s7_int here so that (make-list most-negative-fixnum) is handled correctly */
+ if (len < 0)
+ return(out_of_range(sc, sc->MAKE_LIST, small_int(1), car(args), ITS_NEGATIVE));
+ if (len == 0) return(sc->NIL); /* what about (make-list 0 123)? */
+ if (len > sc->max_list_length)
+ return(out_of_range(sc, sc->MAKE_LIST, small_int(1), car(args), ITS_TOO_LARGE));
+
+ if (is_pair(cdr(args)))
+ init = cadr(args);
+ else init = sc->F;
+ return(make_list(sc, (int)len, init));
+}
+
+static s7_pointer c_make_list(s7_scheme *sc, s7_int len) {return(make_list(sc, (int)len, sc->F));}
+IF_TO_PF(make_list, c_make_list)
+
+
+/* -------------------------------- list-ref -------------------------------- */
+static s7_pointer list_ref_ic;
+static s7_pointer g_list_ref_ic(s7_scheme *sc, s7_pointer args)
+{
+ s7_int i, index;
+ s7_pointer lst, p;
+
+ lst = car(args);
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->LIST_REF, args, T_PAIR, 1);
+
+ index = s7_integer(cadr(args));
+
+ for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+
+ if (!is_pair(p))
+ {
+ if (is_null(p))
+ return(out_of_range(sc, sc->LIST_REF, small_int(2), cadr(args), ITS_TOO_LARGE));
+ return(wrong_type_argument_with_type(sc, sc->LIST_REF, 1, lst, A_PROPER_LIST));
+ }
+ return(car(p));
+}
+
+
+static s7_pointer list_ref_1(s7_scheme *sc, s7_pointer lst, s7_pointer ind)
+{
+ s7_int i, index;
+ s7_pointer p;
+
+ if (!s7_is_integer(ind))
+ {
+ if (!s7_is_integer(p = check_values(sc, ind, cons(sc, ind, sc->NIL))))
+ method_or_bust(sc, ind, sc->LIST_REF, list_2(sc, lst, ind), T_INTEGER, 2);
+ ind = p;
+ }
+ index = s7_integer(ind);
+ if ((index < 0) || (index > sc->max_list_length))
+ return(out_of_range(sc, sc->LIST_REF, small_int(2), ind, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+
+ if (!is_pair(p))
+ {
+ if (is_null(p))
+ return(out_of_range(sc, sc->LIST_REF, small_int(2), ind, ITS_TOO_LARGE));
+ return(wrong_type_argument_with_type(sc, sc->LIST_REF, 1, lst, A_PROPER_LIST));
+ }
+ return(car(p));
+}
+
+
+static s7_pointer g_list_ref(s7_scheme *sc, s7_pointer args)
+{
+ #define H_list_ref "(list-ref lst i ...) returns the i-th element (0-based) of the list"
+ #define Q_list_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->IS_PAIR, sc->IS_INTEGER)
+
+ /* (let ((L '((1 2 3) (4 5 6)))) (list-ref L 1 2))
+
+ (define (lref L . args)
+ (if (null? (cdr args))
+ (list-ref L (car args))
+ (apply lref (list-ref L (car args)) (cdr args))))
+ */
+ s7_pointer lst, inds;
+
+ lst = car(args);
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->LIST_REF, args, T_PAIR, 1);
+
+ inds = cdr(args);
+ while (true)
+ {
+ lst = list_ref_1(sc, lst, car(inds));
+ if (is_null(cdr(inds)))
+ return(lst);
+ inds = cdr(inds);
+ if (!is_pair(lst)) /* trying to avoid a cons here at the cost of one extra type check */
+ return(implicit_index(sc, lst, inds));
+ }
+}
+
+static s7_pointer c_list_ref(s7_scheme *sc, s7_pointer x, s7_int index)
+{
+ int i;
+ s7_pointer p;
+ if (!s7_is_pair(x))
+ method_or_bust(sc, x, sc->LIST_REF, list_2(sc, x, make_integer(sc, index)), T_PAIR, 1);
+ if (index < 0)
+ return(out_of_range(sc, sc->LIST_REF, small_int(2), make_integer(sc, index), ITS_NEGATIVE));
+ for (i = 0, p = x; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+ if (!is_pair(p))
+ {
+ if (is_null(p))
+ return(out_of_range(sc, sc->LIST_REF, small_int(2), make_integer(sc, index), ITS_TOO_LARGE));
+ return(wrong_type_argument_with_type(sc, sc->LIST_REF, 1, x, A_PROPER_LIST));
+ }
+ return(car(p));
+}
+
+PIF_TO_PF(list_ref, c_list_ref)
+
+
+/* -------------------------------- list-set! -------------------------------- */
+static s7_pointer g_list_set_1(s7_scheme *sc, s7_pointer lst, s7_pointer args, int arg_num)
+{
+ #define H_list_set "(list-set! lst i ... val) sets the i-th element (0-based) of the list to val"
+ #define Q_list_set s7_make_circular_signature(sc, 2, 3, sc->T, sc->IS_PAIR, sc->T)
+
+ int i;
+ s7_int index;
+ s7_pointer p, ind;
+
+ /* (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 2 32) L) */
+
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->LIST_SET, cons(sc, lst, args), T_PAIR, 1);
+
+ ind = car(args);
+ if (!s7_is_integer(ind))
+ {
+ if (!s7_is_integer(p = check_values(sc, ind, args)))
+ method_or_bust(sc, ind, sc->LIST_SET, cons(sc, lst, args), T_INTEGER, arg_num);
+ ind = p;
+ }
+ index = s7_integer(ind);
+ if ((index < 0) || (index > sc->max_list_length))
+ return(out_of_range(sc, sc->LIST_SET, small_int(arg_num), ind, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ for (i = 0, p = _TSet(lst); (i < index) && is_pair(p); i++, p = cdr(p)) {}
+
+ if (!is_pair(p))
+ {
+ if (is_null(p))
+ return(out_of_range(sc, sc->LIST_SET, small_int(arg_num), ind, ITS_TOO_LARGE));
+ return(wrong_type_argument_with_type(sc, sc->LIST_SET, 1, lst, A_PROPER_LIST));
+ }
+ if (is_null(cddr(args)))
+ car(p) = cadr(args);
+ else return(g_list_set_1(sc, car(p), cdr(args), arg_num + 1));
+
+ return(cadr(args));
+}
+
+
+static s7_pointer g_list_set(s7_scheme *sc, s7_pointer args)
+{
+ return(g_list_set_1(sc, car(args), cdr(args), 2));
+}
+
+static int c_list_tester(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer a1;
+ a1 = cadr(expr);
+ if (is_symbol(a1))
+ {
+ s7_pointer table;
+ table = s7_slot(sc, a1);
+ if ((is_slot(table)) &&
+ ((is_immutable_symbol(a1)) || (!is_stepper(table))) &&
+ (is_pair(slot_value(table))))
+ {
+ s7_xf_store(sc, slot_value(table));
+ a1 = caddr(expr);
+ if (is_symbol(a1))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, a1);
+ if ((is_slot(slot)) &&
+ (is_integer(slot_value(slot))))
+ {
+ s7_xf_store(sc, slot);
+ return(TEST_SS);
+ }
+ }
+ else
+ {
+ if (s7_arg_to_if(sc, a1))
+ return(TEST_SI);
+ }
+ return(TEST_SQ);
+ }
+ }
+ return(TEST_NO_S);
+}
+
+static s7_pointer c_list_set_s(s7_scheme *sc, s7_pointer lst, s7_int index, s7_pointer val)
+{
+ s7_int i;
+ s7_pointer p;
+
+ if ((index < 0) || (index > sc->max_list_length))
+ return(out_of_range(sc, sc->LIST_SET, small_int(2), make_integer(sc, index), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ for (i = 0, p = lst; (i < index) && is_pair(p); i++, p = cdr(p)) {}
+ if (!is_pair(p))
+ {
+ if (is_null(p))
+ return(out_of_range(sc, sc->LIST_SET, small_int(2), make_integer(sc, index), ITS_TOO_LARGE));
+ return(wrong_type_argument_with_type(sc, sc->LIST_SET, 1, lst, A_PROPER_LIST));
+ }
+ car(p) = val;
+ return(val);
+}
+
+static s7_pointer c_list_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
+{
+ if (!s7_is_pair(vec))
+ method_or_bust(sc, vec, sc->LIST_SET, set_plist_3(sc, vec, make_integer(sc, index), val), T_PAIR, 1);
+ return(c_list_set_s(sc, vec, index, val));
+}
+
+PIPF_TO_PF(list_set, c_list_set_s, c_list_set, c_list_tester)
+
+static s7_pointer list_set_ic;
+static s7_pointer g_list_set_ic(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->LIST_SET, args, T_PAIR, 1);
+ return(c_list_set_s(sc, lst, s7_integer(cadr(args)), caddr(args)));
+}
+
+
+/* -------------------------------- list-tail -------------------------------- */
+static s7_pointer c_list_tail(s7_scheme *sc, s7_pointer lst, s7_int index)
+{
+ s7_int i;
+ s7_pointer p;
+
+ if (!s7_is_list(sc, lst))
+ method_or_bust_with_type(sc, lst, sc->LIST_TAIL, list_2(sc, lst, make_integer(sc, index)), A_LIST, 1);
+
+ if ((index < 0) || (index > sc->max_list_length))
+ return(out_of_range(sc, sc->LIST_TAIL, small_int(2), make_integer(sc, index), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ for (i = 0, p = lst; (i < index) && (is_pair(p)); i++, p = cdr(p)) {}
+ if (i < index)
+ return(out_of_range(sc, sc->LIST_TAIL, small_int(2), make_integer(sc, index), ITS_TOO_LARGE));
+ return(p);
+}
+
+static s7_pointer g_list_tail(s7_scheme *sc, s7_pointer args)
+{
+ #define H_list_tail "(list-tail lst i) returns the list from the i-th element on"
+ #define Q_list_tail s7_make_signature(sc, 3, sc->IS_LIST, sc->IS_PAIR, sc->IS_INTEGER)
+ s7_pointer p;
+
+ p = cadr(args);
+ if (!s7_is_integer(p))
+ {
+ s7_pointer p1;
+ if (!s7_is_integer(p1 = check_values(sc, p, cdr(args))))
+ method_or_bust(sc, p, sc->LIST_TAIL, args, T_INTEGER, 2);
+ p = p1;
+ }
+ return(c_list_tail(sc, car(args), s7_integer(p)));
+}
+
+PIF_TO_PF(list_tail, c_list_tail)
+
+
+/* -------------------------------- cons -------------------------------- */
+static s7_pointer g_cons(s7_scheme *sc, s7_pointer args)
+{
+ /* n-ary cons could be the equivalent of CL's list*? */
+ /* it would be neater to have a single cons cell able to contain (directly) any number of elements */
+ /* (set! (cadr (cons 1 2 3)) 4) -> (1 4 . 3) */
+
+ #define H_cons "(cons a b) returns a pair containing a and b"
+ #define Q_cons s7_make_signature(sc, 3, sc->IS_PAIR, sc->T, sc->T)
+
+ /* cdr(args) = cadr(args);
+ * this is not safe -- it changes a variable's value directly:
+ * (let ((lst (list 1 2))) (list (apply cons lst) lst)) -> '((1 . 2) (1 . 2))
+ */
+ s7_pointer x;
+
+ new_cell(sc, x, T_PAIR | T_SAFE_PROCEDURE);
+ car(x) = car(args);
+ cdr(x) = cadr(args);
+ return(x);
+}
+
+PF2_TO_PF(cons, s7_cons)
+
+static void init_car_a_list(void)
+{
+ CAR_A_LIST = s7_make_permanent_string("a list whose car is also a list");
+ CDR_A_LIST = s7_make_permanent_string("a list whose cdr is also a list");
+
+ CAAR_A_LIST = s7_make_permanent_string("a list whose caar is also a list");
+ CADR_A_LIST = s7_make_permanent_string("a list whose cadr is also a list");
+ CDAR_A_LIST = s7_make_permanent_string("a list whose cdar is also a list");
+ CDDR_A_LIST = s7_make_permanent_string("a list whose cddr is also a list");
+
+ CAAAR_A_LIST = s7_make_permanent_string("a list whose caaar is also a list");
+ CAADR_A_LIST = s7_make_permanent_string("a list whose caadr is also a list");
+ CADAR_A_LIST = s7_make_permanent_string("a list whose cadar is also a list");
+ CADDR_A_LIST = s7_make_permanent_string("a list whose caddr is also a list");
+ CDAAR_A_LIST = s7_make_permanent_string("a list whose cdaar is also a list");
+ CDADR_A_LIST = s7_make_permanent_string("a list whose cdadr is also a list");
+ CDDAR_A_LIST = s7_make_permanent_string("a list whose cddar is also a list");
+ CDDDR_A_LIST = s7_make_permanent_string("a list whose cdddr is also a list");
+
+ A_LIST = s7_make_permanent_string("a list");
+ AN_EQ_FUNC = s7_make_permanent_string("a procedure that can take 2 arguments");
+ AN_ASSOCIATION_LIST = s7_make_permanent_string("an association list");
+ A_NORMAL_REAL = s7_make_permanent_string("a normal real");
+ A_RATIONAL = s7_make_permanent_string("an integer or a ratio");
+ A_NUMBER = s7_make_permanent_string("a number");
+ A_PROCEDURE = s7_make_permanent_string("a procedure");
+ A_NORMAL_PROCEDURE = s7_make_permanent_string("a normal procedure (not a continuation)");
+ A_LET = s7_make_permanent_string("a let (environment)");
+ A_PROPER_LIST = s7_make_permanent_string("a proper list");
+ A_BOOLEAN = s7_make_permanent_string("a boolean");
+ AN_INPUT_PORT = s7_make_permanent_string("an input port");
+ AN_OPEN_PORT = s7_make_permanent_string("an open port");
+ AN_OUTPUT_PORT = s7_make_permanent_string("an output port");
+ AN_INPUT_STRING_PORT = s7_make_permanent_string("an input string port");
+ AN_INPUT_FILE_PORT = s7_make_permanent_string("an input file port");
+ AN_OUTPUT_STRING_PORT = s7_make_permanent_string("an output string port");
+ AN_OUTPUT_FILE_PORT = s7_make_permanent_string("an output file port");
+ A_THUNK = s7_make_permanent_string("a thunk");
+ A_SYMBOL = s7_make_permanent_string("a symbol");
+ A_NON_NEGATIVE_INTEGER = s7_make_permanent_string("a non-negative integer");
+ AN_UNSIGNED_BYTE = s7_make_permanent_string("an unsigned byte");
+ SOMETHING_APPLICABLE = s7_make_permanent_string("a procedure or something applicable");
+ A_RANDOM_STATE_OBJECT = s7_make_permanent_string("a random-state object");
+ A_FORMAT_PORT = s7_make_permanent_string("#f, #t, or an open output port");
+ A_BINDING = s7_make_permanent_string("a pair whose car is a symbol: '(symbol . value)");
+ A_NON_CONSTANT_SYMBOL = s7_make_permanent_string("a non-constant symbol");
+ A_SEQUENCE = s7_make_permanent_string("a sequence");
+ A_VALID_RADIX = s7_make_permanent_string("should be between 2 and 16");
+ RESULT_IS_TOO_LARGE = s7_make_permanent_string("result is too large");
+ ITS_TOO_LARGE = s7_make_permanent_string("it is too large");
+ ITS_TOO_SMALL = s7_make_permanent_string("it is less than the start position");
+ ITS_NEGATIVE = s7_make_permanent_string("it is negative");
+ ITS_NAN = s7_make_permanent_string("NaN usually indicates a numerical error");
+ ITS_INFINITE = s7_make_permanent_string("it is infinite");
+ TOO_MANY_INDICES = s7_make_permanent_string("too many indices");
+#if (!HAVE_COMPLEX_NUMBERS)
+ NO_COMPLEX_NUMBERS = s7_make_permanent_string("this version of s7 does not support complex numbers");
+#endif
+}
+
+
+/* -------- car -------- */
+static s7_pointer g_car_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->CAR, set_plist_1(sc, lst), T_PAIR, 0);
+ return(car(lst));
+}
+
+static s7_pointer g_car(s7_scheme *sc, s7_pointer args)
+{
+ #define H_car "(car pair) returns the first element of the pair"
+ #define Q_car pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->CAR, args, T_PAIR, 0);
+ return(car(lst));
+}
+
+PF_TO_PF(car, g_car_1)
+
+
+static s7_pointer g_set_car(s7_scheme *sc, s7_pointer args)
+{
+ #define H_set_car "(set-car! pair val) sets the pair's first element to val"
+ #define Q_set_car s7_make_signature(sc, 3, sc->T, sc->IS_PAIR, sc->T)
+ s7_pointer p;
+
+ p = car(args);
+ if (!is_pair(p))
+ method_or_bust(sc, p, sc->SET_CAR, args, T_PAIR, 1);
+
+ car(p) = cadr(args);
+ return(car(p));
+}
+
+static s7_pointer c_set_car(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_pair(x))
+ method_or_bust(sc, x, sc->SET_CAR, set_plist_2(sc, x, y), T_PAIR, 1);
+ car(x) = y;
+ return(y);
+}
+
+PF2_TO_PF(set_car, c_set_car)
+
+
+/* -------- cdr -------- */
+static s7_pointer g_cdr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->CDR, set_plist_1(sc, lst), T_PAIR, 0);
+ return(cdr(lst));
+}
+
+static s7_pointer g_cdr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdr "(cdr pair) returns the second element of the pair"
+ #define Q_cdr pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst))
+ method_or_bust(sc, lst, sc->CDR, args, T_PAIR, 0);
+ return(cdr(lst));
+}
+
+PF_TO_PF(cdr, g_cdr_1)
+
+
+static s7_pointer g_set_cdr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_set_cdr "(set-cdr! pair val) sets the pair's second element to val"
+ #define Q_set_cdr s7_make_signature(sc, 3, sc->T, sc->IS_PAIR, sc->T)
+ s7_pointer p;
+
+ p = car(args);
+ if (!is_pair(p))
+ method_or_bust(sc, p, sc->SET_CDR, args, T_PAIR, 1);
+
+ cdr(p) = cadr(args);
+ return(cdr(p));
+}
+
+static s7_pointer c_set_cdr(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_pair(x))
+ method_or_bust(sc, x, sc->SET_CDR, set_plist_2(sc, x, y), T_PAIR, 1);
+ cdr(x) = y;
+ return(y);
+}
+
+PF2_TO_PF(set_cdr, c_set_cdr)
+
+
+
+/* -------- caar --------*/
+static s7_pointer g_caar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CAAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAR, lst, CAR_A_LIST));
+ /* it makes no difference in timing to move lst here or below (i.e. lst=car(lst) then return(car(lst)) and so on) */
+ return(caar(lst));
+}
+
+static s7_pointer g_caar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caar "(caar lst) returns (car (car lst)): (caar '((1 2))) -> 1"
+ #define Q_caar pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CAAR, args, T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAR, lst, CAR_A_LIST));
+ /* it makes no difference in timing to move lst here or below (i.e. lst=car(lst) then return(car(lst)) and so on) */
+ return(caar(lst));
+}
+
+PF_TO_PF(caar, g_caar_1)
+
+
+/* -------- cadr --------*/
+static s7_pointer g_cadr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CADR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADR, lst, CDR_A_LIST));
+ return(cadr(lst));
+}
+
+static s7_pointer g_cadr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cadr "(cadr lst) returns (car (cdr lst)): (cadr '(1 2 3)) -> 2"
+ #define Q_cadr pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CADR, args, T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADR, lst, CDR_A_LIST));
+ return(cadr(lst));
+}
+
+PF_TO_PF(cadr, g_cadr_1)
+
+
+/* -------- cdar -------- */
+static s7_pointer g_cdar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAR, lst, CAR_A_LIST));
+ return(cdar(lst));
+}
+
+static s7_pointer g_cdar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdar "(cdar lst) returns (cdr (car lst)): (cdar '((1 2 3))) -> '(2 3)"
+ #define Q_cdar pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDAR, args, T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAR, lst, CAR_A_LIST));
+ return(cdar(lst));
+}
+
+PF_TO_PF(cdar, g_cdar_1)
+
+
+/* -------- cddr -------- */
+static s7_pointer g_cddr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDDR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDR, lst, CDR_A_LIST));
+ return(cddr(lst));
+}
+
+static s7_pointer g_cddr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cddr "(cddr lst) returns (cdr (cdr lst)): (cddr '(1 2 3 4)) -> '(3 4)"
+ #define Q_cddr pl_p
+
+ s7_pointer lst;
+ lst = car(args);
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDDR, args, T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDR, lst, CDR_A_LIST));
+ return(cddr(lst));
+}
+
+PF_TO_PF(cddr, g_cddr_1)
+
+
+/* -------- caaar -------- */
+static s7_pointer g_caaar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CAAAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAAR, lst, CAR_A_LIST));
+ if (!is_pair(car(car(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->CAAAR, lst, CAAR_A_LIST));
+ return(caaar(lst));
+}
+
+static s7_pointer g_caaar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caaar "(caaar lst) returns (car (car (car lst))): (caaar '(((1 2)))) -> 1"
+ #define Q_caaar pl_p
+
+ return(g_caaar_1(sc, car(args)));
+}
+
+PF_TO_PF(caaar, g_caaar_1)
+
+
+/* -------- caadr -------- */
+static s7_pointer g_caadr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CAADR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAADR, lst, CDR_A_LIST));
+ if (!is_pair(car(cdr(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->CAADR, lst, CADR_A_LIST));
+ return(caadr(lst));
+}
+
+static s7_pointer g_caadr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caadr "(caadr lst) returns (car (car (cdr lst))): (caadr '(1 (2 3))) -> 2"
+ #define Q_caadr pl_p
+
+ return(g_caadr_1(sc, car(args)));
+}
+
+PF_TO_PF(caadr, g_caadr_1)
+
+
+/* -------- cadar -------- */
+static s7_pointer g_cadar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CADAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADAR, lst, CAR_A_LIST));
+ if (!is_pair(cdr(car(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->CADAR, lst, CDAR_A_LIST));
+ return(cadar(lst));
+}
+
+static s7_pointer g_cadar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cadar "(cadar lst) returns (car (cdr (car lst))): (cadar '((1 2 3))) -> 2"
+ #define Q_cadar pl_p
+
+ return(g_cadar_1(sc, car(args)));
+}
+
+PF_TO_PF(cadar, g_cadar_1)
+
+
+/* -------- cdaar -------- */
+static s7_pointer g_cdaar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDAAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAAR, lst, CAR_A_LIST));
+ if (!is_pair(car(car(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->CDAAR, lst, CAAR_A_LIST));
+ return(cdaar(lst));
+}
+
+static s7_pointer g_cdaar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdaar "(cdaar lst) returns (cdr (car (car lst))): (cdaar '(((1 2 3)))) -> '(2 3)"
+ #define Q_cdaar pl_p
+
+ return(g_cdaar_1(sc, car(args)));
+}
+
+PF_TO_PF(cdaar, g_cdaar_1)
+
+
+/* -------- caddr -------- */
+static s7_pointer g_caddr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CADDR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADDR, lst, CDR_A_LIST));
+ if (!is_pair(cdr(cdr(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->CADDR, lst, CDDR_A_LIST));
+ return(caddr(lst));
+}
+
+static s7_pointer g_caddr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caddr "(caddr lst) returns (car (cdr (cdr lst))): (caddr '(1 2 3 4)) -> 3"
+ #define Q_caddr pl_p
+
+ return(g_caddr_1(sc, car(args)));
+}
+
+PF_TO_PF(caddr, g_caddr_1)
+
+
+/* -------- cdddr -------- */
+static s7_pointer g_cdddr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDDDR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDDR, lst, CDR_A_LIST));
+ if (!is_pair(cdr(cdr(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->CDDDR, lst, CDDR_A_LIST));
+ return(cdddr(lst));
+}
+
+static s7_pointer g_cdddr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdddr "(cdddr lst) returns (cdr (cdr (cdr lst))): (cdddr '(1 2 3 4)) -> '(4)"
+ #define Q_cdddr pl_p
+
+ return(g_cdddr_1(sc, car(args)));
+}
+
+PF_TO_PF(cdddr, g_cdddr_1)
+
+
+/* -------- cdadr -------- */
+static s7_pointer g_cdadr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDADR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDADR, lst, CDR_A_LIST));
+ if (!is_pair(car(cdr(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->CDADR, lst, CADR_A_LIST));
+ return(cdadr(lst));
+}
+
+static s7_pointer g_cdadr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdadr "(cdadr lst) returns (cdr (car (cdr lst))): (cdadr '(1 (2 3 4))) -> '(3 4)"
+ #define Q_cdadr pl_p
+
+ return(g_cdadr_1(sc, car(args)));
+}
+
+PF_TO_PF(cdadr, g_cdadr_1)
+
+
+/* -------- cddar -------- */
+static s7_pointer g_cddar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDDAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDAR, lst, CAR_A_LIST));
+ if (!is_pair(cdr(car(lst)))) return(simple_wrong_type_argument_with_type(sc, sc->CDDAR, lst, CDAR_A_LIST));
+ return(cddar(lst));
+}
+
+static s7_pointer g_cddar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cddar "(cddar lst) returns (cdr (cdr (car lst))): (cddar '((1 2 3 4))) -> '(3 4)"
+ #define Q_cddar pl_p
+
+ return(g_cddar_1(sc, car(args)));
+}
+
+PF_TO_PF(cddar, g_cddar_1)
+
+
+/* -------- caaaar -------- */
+static s7_pointer g_caaaar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CAAAAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAAAR, lst, CAR_A_LIST));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAAAR, lst, CAAR_A_LIST));
+ if (!is_pair(caaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAAAR, lst, CAAAR_A_LIST));
+ return(caaaar(lst));
+}
+
+static s7_pointer g_caaaar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caaaar "(caaaar lst) returns (car (car (car (car lst)))): (caaaar '((((1 2))))) -> 1"
+ #define Q_caaaar pl_p
+
+ return(g_caaaar_1(sc, car(args)));
+}
+
+PF_TO_PF(caaaar, g_caaaar_1)
+
+
+/* -------- caaadr -------- */
+static s7_pointer g_caaadr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CAAADR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAADR, lst, CDR_A_LIST));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAADR, lst, CADR_A_LIST));
+ if (!is_pair(caadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAAADR, lst, CAADR_A_LIST));
+ return(caaadr(lst));
+}
+
+static s7_pointer g_caaadr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caaadr "(caaadr lst) returns (car (car (car (cdr lst)))): (caaadr '(1 ((2 3)))) -> 2"
+ #define Q_caaadr pl_p
+
+ return(g_caaadr_1(sc, car(args)));
+}
+
+PF_TO_PF(caaadr, g_caaadr_1)
+
+
+/* -------- caadar -------- */
+static s7_pointer g_caadar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CAADAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAADAR, lst, CAR_A_LIST));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAADAR, lst, CDAR_A_LIST));
+ if (!is_pair(cadar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAADAR, lst, CADAR_A_LIST));
+ return(caadar(lst));
+}
+
+static s7_pointer g_caadar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caadar "(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"
+ #define Q_caadar pl_p
+
+ return(g_caadar_1(sc, car(args)));
+}
+
+PF_TO_PF(caadar, g_caadar_1)
+
+
+/* -------- cadaar -------- */
+static s7_pointer g_cadaar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CADAAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADAAR, lst, CAR_A_LIST));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADAAR, lst, CAAR_A_LIST));
+ if (!is_pair(cdaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADAAR, lst, CDAAR_A_LIST));
+ return(cadaar(lst));
+}
+
+static s7_pointer g_cadaar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cadaar "(cadaar lst) returns (car (cdr (car (car lst)))): (cadaar '(((1 2 3)))) -> 2"
+ #define Q_cadaar pl_p
+
+ return(g_cadaar_1(sc, car(args)));
+}
+
+PF_TO_PF(cadaar, g_cadaar_1)
+
+
+/* -------- caaddr -------- */
+static s7_pointer g_caaddr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CAADDR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAADDR, lst, CDR_A_LIST));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAADDR, lst, CDDR_A_LIST));
+ if (!is_pair(caddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CAADDR, lst, CADDR_A_LIST));
+ return(caaddr(lst));
+}
+
+static s7_pointer g_caaddr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caaddr "(caaddr lst) returns (car (car (cdr (cdr lst)))): (caaddr '(1 2 (3 4))) -> 3"
+ #define Q_caaddr pl_p
+
+ return(g_caaddr_1(sc, car(args)));
+}
+
+PF_TO_PF(caaddr, g_caaddr_1)
+
+
+/* -------- cadddr -------- */
+static s7_pointer g_cadddr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CADDDR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADDDR, lst, CDR_A_LIST));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADDDR, lst, CDDR_A_LIST));
+ if (!is_pair(cdddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADDDR, lst, CDDDR_A_LIST));
+ return(cadddr(lst));
+}
+
+static s7_pointer g_cadddr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cadddr "(cadddr lst) returns (car (cdr (cdr (cdr lst)))): (cadddr '(1 2 3 4 5)) -> 4"
+ #define Q_cadddr pl_p
+
+ return(g_cadddr_1(sc, car(args)));
+}
+
+PF_TO_PF(cadddr, g_cadddr_1)
+
+
+/* -------- cadadr -------- */
+static s7_pointer g_cadadr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CADADR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADADR, lst, CDR_A_LIST));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADADR, lst, CADR_A_LIST));
+ if (!is_pair(cdadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADADR, lst, CDADR_A_LIST));
+ return(cadadr(lst));
+}
+
+static s7_pointer g_cadadr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cadadr "(cadadr lst) returns (car (cdr (car (cdr lst)))): (cadadr '(1 (2 3 4))) -> 3"
+ #define Q_cadadr pl_p
+
+ return(g_cadadr_1(sc, car(args)));
+}
+
+PF_TO_PF(cadadr, g_cadadr_1)
+
+
+/* -------- caddar -------- */
+static s7_pointer g_caddar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CADDAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADDAR, lst, CAR_A_LIST));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADDAR, lst, CDAR_A_LIST));
+ if (!is_pair(cddar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CADDAR, lst, CDDAR_A_LIST));
+ return(caddar(lst));
+}
+
+static s7_pointer g_caddar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_caddar "(caddar lst) returns (car (cdr (cdr (car lst)))): (caddar '((1 2 3 4))) -> 3"
+ #define Q_caddar pl_p
+
+ return(g_caddar_1(sc, car(args)));
+}
+
+PF_TO_PF(caddar, g_caddar_1)
+
+
+/* -------- cdaaar -------- */
+static s7_pointer g_cdaaar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDAAAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAAAR, lst, CAR_A_LIST));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAAAR, lst, CAAR_A_LIST));
+ if (!is_pair(caaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAAAR, lst, CAAAR_A_LIST));
+ return(cdaaar(lst));
+}
+
+static s7_pointer g_cdaaar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdaaar "(cdaaar lst) returns (cdr (car (car (car lst)))): (cdaaar '((((1 2 3))))) -> '(2 3)"
+ #define Q_cdaaar pl_p
+
+ return(g_cdaaar_1(sc, car(args)));
+}
+
+PF_TO_PF(cdaaar, g_cdaaar_1)
+
+
+/* -------- cdaadr -------- */
+static s7_pointer g_cdaadr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDAADR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAADR, lst, CDR_A_LIST));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAADR, lst, CADR_A_LIST));
+ if (!is_pair(caadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDAADR, lst, CAADR_A_LIST));
+ return(cdaadr(lst));
+}
+
+static s7_pointer g_cdaadr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdaadr "(cdaadr lst) returns (cdr (car (car (cdr lst)))): (cdaadr '(1 ((2 3 4)))) -> '(3 4)"
+ #define Q_cdaadr pl_p
+
+ return(g_cdaadr_1(sc, car(args)));
+}
+
+PF_TO_PF(cdaadr, g_cdaadr_1)
+
+
+/* -------- cdadar -------- */
+static s7_pointer g_cdadar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDADAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDADAR, lst, CAR_A_LIST));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDADAR, lst, CDAR_A_LIST));
+ if (!is_pair(cadar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDADAR, lst, CADAR_A_LIST));
+ return(cdadar(lst));
+}
+
+static s7_pointer g_cdadar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdadar "(cdadar lst) returns (cdr (car (cdr (car lst)))): (cdadar '((1 (2 3 4)))) -> '(3 4)"
+ #define Q_cdadar pl_p
+
+ return(g_cdadar_1(sc, car(args)));
+}
+
+PF_TO_PF(cdadar, g_cdadar_1)
+
+
+/* -------- cddaar -------- */
+static s7_pointer g_cddaar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDDAAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDAAR, lst, CAR_A_LIST));
+ if (!is_pair(caar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDAAR, lst, CAAR_A_LIST));
+ if (!is_pair(cdaar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDAAR, lst, CDAAR_A_LIST));
+ return(cddaar(lst));
+}
+
+static s7_pointer g_cddaar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cddaar "(cddaar lst) returns (cdr (cdr (car (car lst)))): (cddaar '(((1 2 3 4)))) -> '(3 4)"
+ #define Q_cddaar pl_p
+
+ return(g_cddaar_1(sc, car(args)));
+}
+
+PF_TO_PF(cddaar, g_cddaar_1)
+
+
+/* -------- cdaddr -------- */
+static s7_pointer g_cdaddr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDADDR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDADDR, lst, CDR_A_LIST));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDADDR, lst, CDDR_A_LIST));
+ if (!is_pair(caddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDADDR, lst, CADDR_A_LIST));
+ return(cdaddr(lst));
+}
+
+static s7_pointer g_cdaddr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdaddr "(cdaddr lst) returns (cdr (car (cdr (cdr lst)))): (cdaddr '(1 2 (3 4 5))) -> '(4 5)"
+ #define Q_cdaddr pl_p
+
+ return(g_cdaddr_1(sc, car(args)));
+}
+
+PF_TO_PF(cdaddr, g_cdaddr_1)
+
+
+/* -------- cddddr -------- */
+static s7_pointer g_cddddr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDDDDR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDDDR, lst, CDR_A_LIST));
+ if (!is_pair(cddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDDDR, lst, CDDR_A_LIST));
+ if (!is_pair(cdddr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDDDR, lst, CDDDR_A_LIST));
+ return(cddddr(lst));
+}
+
+static s7_pointer g_cddddr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cddddr "(cddddr lst) returns (cdr (cdr (cdr (cdr lst)))): (cddddr '(1 2 3 4 5)) -> '(5)"
+ #define Q_cddddr pl_p
+ return(g_cddddr_1(sc, car(args)));
+}
+
+PF_TO_PF(cddddr, g_cddddr_1)
+
+
+/* -------- cddadr -------- */
+static s7_pointer g_cddadr_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDDADR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(cdr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDADR, lst, CDR_A_LIST));
+ if (!is_pair(cadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDADR, lst, CADR_A_LIST));
+ if (!is_pair(cdadr(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDADR, lst, CDADR_A_LIST));
+ return(cddadr(lst));
+}
+
+static s7_pointer g_cddadr(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cddadr "(cddadr lst) returns (cdr (cdr (car (cdr lst)))): (cddadr '(1 (2 3 4 5))) -> '(4 5)"
+ #define Q_cddadr pl_p
+ return(g_cddadr_1(sc, car(args)));
+}
+
+PF_TO_PF(cddadr, g_cddadr_1)
+
+
+/* -------- cdddar -------- */
+static s7_pointer g_cdddar_1(s7_scheme *sc, s7_pointer lst)
+{
+ if (!is_pair(lst)) method_or_bust(sc, lst, sc->CDDDAR, set_plist_1(sc, lst), T_PAIR, 0);
+ if (!is_pair(car(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDDAR, lst, CAR_A_LIST));
+ if (!is_pair(cdar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDDAR, lst, CDAR_A_LIST));
+ if (!is_pair(cddar(lst))) return(simple_wrong_type_argument_with_type(sc, sc->CDDDAR, lst, CDDAR_A_LIST));
+ return(cdddar(lst));
+}
+
+static s7_pointer g_cdddar(s7_scheme *sc, s7_pointer args)
+{
+ #define H_cdddar "(cdddar lst) returns (cdr (cdr (cdr (car lst)))): (cdddar '((1 2 3 4 5))) -> '(4 5)"
+ #define Q_cdddar pl_p
+
+ return(g_cdddar_1(sc, car(args)));
+}
+
+PF_TO_PF(cdddar, g_cdddar_1)
+
+
+
+s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+ s7_pointer y;
+ y = x;
+ while (true)
+ {
+ /* we can blithely take the car of anything, since we're not treating it as an object,
+ * then if we get a bogus match, the following check that caar made sense ought to catch it.
+ *
+ * if car(#<unspecified>) = #<unspecified> (initialization time), then cdr(nil)->unspec
+ * and subsequent caar(unspc)->unspec so we could forgo half the is_pair checks below.
+ * This breaks if "x" is a dotted list -- the last cdr is not nil, so we lose.
+ */
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == unchecked_car(car(x))) && (is_pair(car(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer c_assq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_pair(y))
+ {
+ if (is_null(y)) return(sc->F);
+ method_or_bust_with_type(sc, y, sc->ASSQ, list_2(sc, x, y), AN_ASSOCIATION_LIST, 2);
+ }
+ /* we don't check for (pair? (car x)) here (or in assv) so we get some inconsistency with assoc:
+ * (assq #f '(#f 2 . 3)) -> #f
+ * (assoc #f '(#f 2 . 3)) -> 'error
+ */
+ return(s7_assq(sc, x, y));
+}
+
+static s7_pointer g_assq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_assq "(assq obj alist) returns the key-value pair associated (via eq?) with the key obj in the association list alist"
+ #define Q_assq s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_BOOLEAN), sc->T, sc->IS_LIST)
+ return(c_assq(sc, car(args), cadr(args)));
+}
+
+PF2_TO_PF(assq, c_assq)
+#endif
+
+
+static s7_pointer c_assv(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ s7_pointer z;
+ if (!is_pair(y))
+ {
+ if (is_null(y)) return(sc->F);
+ method_or_bust_with_type(sc, y, sc->ASSV, list_2(sc, x, y), AN_ASSOCIATION_LIST, 2);
+ }
+
+ if (is_simple(x))
+ return(s7_assq(sc, x, y));
+
+ z = y;
+ while (true)
+ {
+ /* here we can't play the assq == game because s7_is_eqv thinks it's getting a legit s7 object */
+ if ((is_pair(car(y))) && (s7_is_eqv(x, caar(y)))) return(car(y));
+ y = cdr(y);
+ if (!is_pair(y)) return(sc->F);
+
+ if ((is_pair(car(y))) && (s7_is_eqv(x, caar(y)))) return(car(y));
+ y = cdr(y);
+ if (!is_pair(y)) return(sc->F);
+
+ z = cdr(z);
+ if (z == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
+
+static s7_pointer g_assv(s7_scheme *sc, s7_pointer args) /* g_assv is called by g_assoc below */
+{
+ #define H_assv "(assv obj alist) returns the key-value pair associated (via eqv?) with the key obj in the association list alist"
+ #define Q_assv Q_assq
+ return(c_assv(sc, car(args), cadr(args)));
+}
+
+#if (!WITH_PURE_S7)
+PF2_TO_PF(assv, c_assv)
+#endif
+
+static s7_pointer all_x_c_ss(s7_scheme *sc, s7_pointer arg);
+static s7_pointer all_x_c_uu(s7_scheme *sc, s7_pointer arg);
+static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args);
+
+static s7_pointer g_assoc(s7_scheme *sc, s7_pointer args)
+{
+ #define H_assoc "(assoc obj alist (func #f)) returns the key-value pair associated (via equal?) with the key obj in the association list alist.\
+If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
+ #define Q_assoc s7_make_signature(sc, 4, s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_BOOLEAN), sc->T, sc->IS_LIST, sc->IS_PROCEDURE)
+
+ s7_pointer x, y, obj, eq_func = NULL;
+
+ x = cadr(args);
+ if (!is_null(x))
+ {
+ if (!is_pair(x))
+ method_or_bust_with_type(sc, x, sc->ASSOC, args, AN_ASSOCIATION_LIST, 2);
+
+ if ((is_pair(x)) && (!is_pair(car(x))))
+ return(wrong_type_argument_with_type(sc, sc->ASSOC, 2, x, AN_ASSOCIATION_LIST)); /* we're assuming caar below so it better exist */
+ }
+
+ if (is_not_null(cddr(args)))
+ {
+ /* check third arg before second (trailing arg error check) */
+ eq_func = caddr(args);
+
+ if (type(eq_func) < T_GOTO)
+ method_or_bust_with_type(sc, eq_func, sc->ASSOC, args, A_PROCEDURE, 0);
+
+ if (!s7_is_aritable(sc, eq_func, 2))
+ return(wrong_type_argument_with_type(sc, sc->ASSOC, 3, eq_func, AN_EQ_FUNC));
+ }
+ if (is_null(x)) return(sc->F);
+
+ if (eq_func)
+ {
+ /* now maybe there's a simple case */
+ if (s7_list_length(sc, x) > 0)
+ {
+ if ((is_safe_procedure(eq_func)) &&
+ (is_c_function(eq_func)))
+ {
+ s7_function func;
+
+ func = c_function_call(eq_func);
+ if (func == g_is_eq) return(s7_assq(sc, car(args), x));
+ if (func == g_is_eqv) return(g_assv(sc, args));
+ car(sc->T2_1) = car(args);
+
+ for (; is_pair(x); x = cdr(x))
+ {
+ if (is_pair(car(x)))
+ {
+ car(sc->T2_2) = caar(x);
+ if (is_true(sc, func(sc, sc->T2_1)))
+ return(car(x));
+ /* I wonder if the assoc equality function should get the cons, not just caar?
+ */
+ }
+ else return(wrong_type_argument_with_type(sc, sc->ASSOC, 2, cadr(args), AN_ASSOCIATION_LIST));
+ }
+ return(sc->F);
+ }
+
+ /* lg auto? */
+ if ((is_closure(eq_func)) &&
+ (is_pair(closure_args(eq_func))) &&
+ (is_pair(cdr(closure_args(eq_func))))) /* not dotted arg list */
+ {
+ s7_pointer body;
+ body = closure_body(eq_func);
+ if ((is_optimized(car(body))) &&
+ (is_null(cdr(body))) &&
+ (is_all_x_safe(sc, car(body))))
+ {
+ s7_function func;
+ s7_pointer b;
+
+ new_frame_with_two_slots(sc, sc->envir, sc->envir, car(closure_args(eq_func)), car(args), cadr(closure_args(eq_func)), sc->F);
+ func = all_x_eval(sc, car(body), sc->envir, let_symbol_is_safe); /* safe since local */
+ b = next_slot(let_slots(sc->envir));
+
+ for (; is_pair(x); x = cdr(x))
+ {
+ slot_set_value(b, caar(x));
+ if (is_true(sc, func(sc, car(body))))
+ return(car(x));
+ }
+ return(sc->F);
+ }
+ }
+ }
+
+ /* sc->value = sc->F; */
+ y = cons(sc, args, sc->NIL);
+ set_opt_fast(y, x);
+ set_opt_slow(y, x);
+ push_stack(sc, OP_ASSOC_IF, y, eq_func);
+ push_stack(sc, OP_APPLY, list_2(sc, car(args), caar(x)), eq_func);
+ return(sc->UNSPECIFIED);
+ }
+
+ x = cadr(args);
+ obj = car(args);
+ if (is_simple(obj))
+ return(s7_assq(sc, obj, x));
+
+ y = x;
+ if (is_string(obj))
+ {
+ s7_pointer val;
+ while (true)
+ {
+ if (is_pair(car(x)))
+ {
+ val = caar(x);
+ if ((val == obj) ||
+ ((is_string(val)) &&
+ (scheme_strings_are_equal(obj, val))))
+ return(car(x));
+ }
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (is_pair(car(x)))
+ {
+ val = caar(x);
+ if ((val == obj) ||
+ ((is_string(val)) &&
+ (scheme_strings_are_equal(obj, val))))
+ return(car(x));
+ }
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+ }
+
+ while (true)
+ {
+ if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((is_pair(car(x))) && (s7_is_equal(sc, obj, caar(x)))) return(car(x));
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
+
+static s7_pointer c_assoc(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_assoc(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(assoc, c_assoc)
+
+
+/* ---------------- member, memv, memq ---------------- */
+
+s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+ s7_pointer y;
+ y = x;
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer c_memq(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ if (!is_pair(y))
+ {
+ if (is_null(y)) return(sc->F);
+ method_or_bust_with_type(sc, y, sc->MEMQ, list_2(sc, x, y), A_LIST, 2);
+ }
+ return(s7_memq(sc, x, y));
+}
+
+static s7_pointer g_memq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_memq "(memq obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memq uses eq?"
+ #define Q_memq pl_tp
+ return(c_memq(sc, car(args), cadr(args)));
+}
+
+PF2_TO_PF(memq, c_memq)
+#endif
+/* I think (memq 'c '(a b . c)) should return #f because otherwise
+ * (memq () ...) would return the () at the end.
+ */
+
+
+/* if memq's list is a quoted list, it won't be changing, so we can tell ahead of time that it is
+ * a proper list, and what its length is.
+ */
+static s7_pointer memq_3, memq_4, memq_any;
+
+static s7_pointer g_memq_3(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, obj;
+ x = cadr(args);
+ obj = car(args);
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ }
+ return(sc->F);
+}
+
+static s7_pointer g_memq_4(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, obj;
+ x = cadr(args);
+ obj = car(args);
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ }
+ return(sc->F);
+}
+
+static s7_pointer g_memq_any(s7_scheme *sc, s7_pointer args)
+{
+ /* no circular list check needed in this case */
+ s7_pointer x, obj;
+ x = cadr(args);
+ obj = car(args);
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F); /* every other pair check could be omitted */
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ }
+ return(sc->F);
+}
+
+
+static s7_pointer memq_car;
+static s7_pointer g_memq_car(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, obj;
+
+ obj = find_symbol_checked(sc, cadar(args));
+ if (!is_pair(obj))
+ {
+ s7_pointer func;
+ if ((has_methods(obj)) &&
+ ((func = find_method(sc, find_let(sc, obj), sc->CAR)) != sc->UNDEFINED))
+ obj = s7_apply_function(sc, func, list_1(sc, obj));
+ if (!is_pair(obj))
+ return(simple_wrong_type_argument(sc, sc->CAR, obj, T_PAIR));
+ }
+ obj = car(obj);
+ x = cadr(cadr(args));
+
+ while (true)
+ {
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (obj == car(x)) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ }
+ return(sc->F);
+}
+
+static s7_pointer memq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if ((is_pair(caddr(expr))) &&
+ (car(caddr(expr)) == sc->QUOTE) &&
+ (is_pair(cadr(caddr(expr)))))
+ {
+ int len;
+
+ if ((is_h_safe_c_s(cadr(expr))) &&
+ (c_callee(cadr(expr)) == g_car))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(memq_car);
+ }
+
+ len = s7_list_length(sc, cadr(caddr(expr)));
+ if (len > 0)
+ {
+ if ((len % 4) == 0)
+ return(memq_4);
+ if ((len % 3) == 0)
+ return(memq_3);
+ return(memq_any);
+ }
+ }
+ return(f);
+}
+
+
+static s7_pointer memv_number(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+ s7_pointer y;
+ y = x;
+ while (true)
+ {
+ if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ if ((s7_is_number(car(x))) && (numbers_are_eqv(obj, car(x)))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+}
+
+
+static s7_pointer c_memv(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ s7_pointer z;
+
+ if (!is_pair(y))
+ {
+ if (is_null(y)) return(sc->F);
+ method_or_bust_with_type(sc, y, sc->MEMV, list_2(sc, x, y), A_LIST, 2);
+ }
+
+ if (is_simple(x)) return(s7_memq(sc, x, y));
+ if (s7_is_number(x)) return(memv_number(sc, x, y));
+
+ z = y;
+ while (true)
+ {
+ if (s7_is_eqv(x, car(y))) return(y);
+ y = cdr(y);
+ if (!is_pair(y)) return(sc->F);
+
+ if (s7_is_eqv(x, car(y))) return(y);
+ y = cdr(y);
+ if (!is_pair(y)) return(sc->F);
+
+ z = cdr(z);
+ if (z == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
+
+static s7_pointer g_memv(s7_scheme *sc, s7_pointer args)
+{
+ #define H_memv "(memv obj list) looks for obj in list and returns the list from that point if it is found, otherwise #f. memv uses eqv?"
+ #define Q_memv pl_tp
+
+ return(c_memv(sc, car(args), cadr(args)));
+}
+
+#if (!WITH_PURE_S7)
+PF2_TO_PF(memv, c_memv)
+#endif
+
+static s7_pointer member(s7_scheme *sc, s7_pointer obj, s7_pointer x)
+{
+ s7_pointer y;
+
+ y = x;
+ if (is_string(obj))
+ {
+ while (true)
+ {
+ if ((obj == car(x)) ||
+ ((is_string(car(x))) &&
+ (scheme_strings_are_equal(obj, car(x)))))
+ return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if ((obj == car(x)) ||
+ ((is_string(car(x))) &&
+ (scheme_strings_are_equal(obj, car(x)))))
+ return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F);
+ }
+
+ while (true)
+ {
+ if (s7_is_equal(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (s7_is_equal(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (s7_is_equal(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ if (s7_is_equal(sc, obj, car(x))) return(x);
+ x = cdr(x);
+ if (!is_pair(x)) return(sc->F);
+
+ y = cdr(y);
+ if (x == y) return(sc->F);
+ }
+ return(sc->F); /* not reached */
+}
+
+static s7_pointer g_member(s7_scheme *sc, s7_pointer args)
+{
+ #define H_member "(member obj list (func #f)) looks for obj in list and returns the list from that point if it is found, otherwise #f. \
+member uses equal? If 'func' is a function of 2 arguments, it is used for the comparison instead of 'equal?"
+ #define Q_member s7_make_signature(sc, 4, sc->T, sc->T, sc->IS_LIST, sc->IS_PROCEDURE)
+
+ /* this could be extended to accept sequences:
+ * (member #\a "123123abnfc" char=?) -> "abnfc"
+ * (member "abc" "123abc321" string=?) -> "abc321" but there's the string length complication
+ * (member 1 #(0 1 2) =) -> #(1 2) etc but what would it do for a hash-table?
+ * the third arg can be weird: (member #f (list #t) cons) -> (#t) -- cons returns '(#f . #t) which is true, so we get '(#t)
+ * should this be an error: (member '(1 2 3) () '(1 . 2)) -- the third arg is bogus, but the second is nil
+ *
+ * here as in assoc, sort, and make-hash-table we accept macros, but I can't think of a good reason to do so.
+ */
+
+ s7_pointer x, y, obj, eq_func = NULL;
+ x = cadr(args);
+
+ if ((!is_pair(x)) && (!is_null(x)))
+ method_or_bust_with_type(sc, x, sc->MEMBER, args, A_LIST, 2);
+
+ if (is_not_null(cddr(args)))
+ {
+ /* check third arg before second (trailing arg error check) */
+ eq_func = caddr(args);
+
+ if (type(eq_func) < T_GOTO)
+ method_or_bust_with_type(sc, eq_func, sc->MEMBER, args, A_PROCEDURE, 3);
+
+ if (!s7_is_aritable(sc, eq_func, 2))
+ return(wrong_type_argument_with_type(sc, sc->MEMBER, 3, eq_func, AN_EQ_FUNC));
+ }
+
+ if (is_null(x)) return(sc->F);
+ if (eq_func)
+ {
+ /* now maybe there's a simple case */
+ if (s7_list_length(sc, x) > 0)
+ {
+ if ((is_safe_procedure(eq_func)) &&
+ (is_c_function(eq_func)))
+ {
+ s7_function func;
+
+ func = c_function_call(eq_func);
+ if (func == g_is_eq) return(s7_memq(sc, car(args), x));
+ if (func == g_is_eqv) return(g_memv(sc, args));
+ car(sc->T2_1) = car(args);
+
+ for (; is_pair(x); x = cdr(x))
+ {
+ car(sc->T2_2) = car(x);
+ if (is_true(sc, func(sc, sc->T2_1)))
+ return(x);
+ }
+ return(sc->F);
+ }
+
+ if ((is_closure(eq_func)) &&
+ (is_pair(closure_args(eq_func))) &&
+ (is_pair(cdr(closure_args(eq_func))))) /* not dotted arg list */
+ {
+ s7_pointer body;
+ body = closure_body(eq_func);
+ if ((is_optimized(car(body))) &&
+ (is_null(cdr(body))) &&
+ (is_all_x_safe(sc, car(body))))
+ {
+ s7_function func;
+ func = all_x_eval(sc, car(body), closure_args(eq_func), pair_symbol_is_safe);
+
+ /* tmap, lg falls through*/
+ if (((func == all_x_c_ss) || (func == all_x_c_uu)) &&
+ (cadar(body) == car(closure_args(eq_func))) &&
+ (caddar(body) == cadr(closure_args(eq_func))))
+ {
+ car(sc->T2_1) = car(args);
+ func = c_callee(car(body));
+ for (; is_pair(x); x = cdr(x))
+ {
+ car(sc->T2_2) = car(x);
+ if (is_true(sc, func(sc, sc->T2_1)))
+ return(x);
+ }
+ }
+ else
+ {
+ s7_pointer b;
+ new_frame_with_two_slots(sc, sc->envir, sc->envir, car(closure_args(eq_func)), car(args), cadr(closure_args(eq_func)), sc->F);
+ b = next_slot(let_slots(sc->envir));
+
+ for (; is_pair(x); x = cdr(x))
+ {
+ slot_set_value(b, car(x));
+ if (is_true(sc, func(sc, car(body))))
+ return(x);
+ }
+ }
+ return(sc->F);
+ }
+ }
+ }
+
+ y = cons(sc, args, sc->NIL); /* this could probably be handled with a counter cell (cdr here is unused) */
+ set_opt_fast(y, x);
+ set_opt_slow(y, x);
+ push_stack(sc, OP_MEMBER_IF, y, eq_func);
+ car(sc->T2_1) = car(args);
+ car(sc->T2_2) = car(x);
+ push_stack(sc, OP_APPLY, sc->T2_1, eq_func);
+ return(sc->UNSPECIFIED);
+ }
+
+ obj = car(args);
+ if (is_simple(obj))
+ return(s7_memq(sc, obj, x));
+
+ /* the only things that aren't simply == here are c_object, string, number, vector, hash-table, pair, and c_pointer
+ * but all the other cases are unlikely.
+ */
+ if (s7_is_number(obj))
+ return(memv_number(sc, obj, x));
+
+ return(member(sc, obj, x));
+}
+
+static s7_pointer c_member(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_member(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(member, c_member)
+
+static s7_pointer member_sq;
+static s7_pointer g_member_sq(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer obj, lst;
+ lst = cadr(cadr(args));
+ obj = find_symbol_checked(sc, car(args));
+
+ if (is_simple(obj))
+ return(s7_memq(sc, obj, lst));
+
+ if (s7_is_number(obj))
+ return(memv_number(sc, obj, lst));
+
+ return(member(sc, obj, lst));
+}
+
+static s7_pointer member_num_s;
+static s7_pointer g_member_num_s(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer lst;
+
+ lst = find_symbol_checked(sc, cadr(args));
+ if (!is_pair(lst))
+ {
+ if (is_null(lst)) return(sc->F);
+ method_or_bust_with_type(sc, lst, sc->MEMBER, list_2(sc, car(args), lst), A_LIST, 2);
+ }
+ return(memv_number(sc, car(args), lst));
+}
+
+static s7_pointer member_ss;
+static s7_pointer g_member_ss(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer obj, x;
+
+ obj = find_symbol_checked(sc, car(args));
+ x = find_symbol_checked(sc, cadr(args));
+ if (!is_pair(x))
+ {
+ if (is_null(x)) return(sc->F);
+ method_or_bust_with_type(sc, x, sc->MEMBER, list_2(sc, obj, x), A_LIST, 2);
+ }
+
+ if (is_simple(obj))
+ return(s7_memq(sc, obj, x));
+
+ if (s7_is_number(obj))
+ return(memv_number(sc, obj, x));
+
+ return(member(sc, obj, x));
+}
+
+static s7_pointer member_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ if (is_symbol(caddr(expr)))
+ {
+ if (s7_is_number(cadr(expr)))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(member_num_s); /* (member 4 lst) */
+ }
+
+ if (is_symbol(cadr(expr)))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(member_ss); /* (member obj lst) */
+ }
+ }
+ else
+ {
+ if ((is_symbol(cadr(expr))) &&
+ (is_pair(caddr(expr))) &&
+ (car(caddr(expr)) == sc->QUOTE) &&
+ (is_pair(cadr(caddr(expr)))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(member_sq); /* (member q '(quote lambda case)) */
+ }
+ }
+ }
+
+ if ((args == 3) &&
+ (is_symbol(cadddr(expr))) &&
+ (cadddr(expr) == sc->IS_EQ))
+ return(memq_chooser(sc, f, 2, expr));
+
+ return(f);
+}
+
+
+static bool is_memq(s7_pointer sym, s7_pointer lst)
+{
+ s7_pointer x;
+ for (x = lst; is_pair(x); x = cdr(x))
+ if (sym == car(x))
+ return(true);
+ return(false);
+}
+
+
+static s7_pointer c_is_provided(s7_scheme *sc, s7_pointer sym)
+{
+ s7_pointer topf, x;
+
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->IS_PROVIDED, list_1(sc, sym), T_SYMBOL, 0);
+
+ /* here the *features* list is spread out (or can be anyway) along the curlet chain,
+ * so we need to travel back all the way to the top level checking each *features* list in turn.
+ * Since *features* grows via cons (newest first), we can stop the scan if we hit the shared
+ * top-level at least.
+ */
+ topf = slot_value(global_slot(sc->S7_FEATURES));
+ if (is_memq(sym, topf))
+ return(sc->T);
+
+ if (is_global(sc->S7_FEATURES))
+ return(sc->F);
+ for (x = sc->envir; symbol_id(sc->S7_FEATURES) < let_id(x); x = outlet(x));
+ for (; is_let(x); x = outlet(x))
+ {
+ s7_pointer y;
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == sc->S7_FEATURES)
+ {
+ if ((slot_value(y) != topf) &&
+ (is_memq(sym, slot_value(y))))
+ return(sc->T);
+ }
+ }
+ return(sc->F);
+}
+
+static s7_pointer g_is_provided(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_provided "(provided? symbol) returns #t if symbol is a member of the *features* list"
+ #define Q_is_provided s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_SYMBOL)
+
+ return(c_is_provided(sc, car(args)));
+}
+
+bool s7_is_provided(s7_scheme *sc, const char *feature)
+{
+ return(is_memq(s7_make_symbol(sc, feature), s7_symbol_value(sc, sc->S7_FEATURES))); /* this goes from local outward */
+}
+
+PF_TO_PF(is_provided, c_is_provided)
+
+
+static s7_pointer c_provide(s7_scheme *sc, s7_pointer sym)
+{
+ /* this has to be relative to the curlet: (load file env)
+ * the things loaded are only present in env, and go away with it, so should not be in the global *features* list
+ */
+ s7_pointer p, lst;
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->PROVIDE, list_1(sc, sym), T_SYMBOL, 0);
+
+ p = find_local_symbol(sc, sc->S7_FEATURES, sc->envir); /* if sc->envir is nil, this returns the global slot, else local slot */
+ lst = slot_value(find_symbol(sc, sc->S7_FEATURES)); /* in either case, we want the current *feartures* list */
+
+ if (p == sc->UNDEFINED)
+ make_slot_1(sc, sc->envir, sc->S7_FEATURES, cons(sc, sym, lst));
+ else
+ {
+ if (!is_memq(sym, lst))
+ slot_set_value(p, cons(sc, sym, lst));
+ }
+
+ if (!is_slot(find_symbol(sc, sym))) /* *features* name might be the same as an existing function */
+ s7_define(sc, sc->envir, sym, sym);
+ return(sym);
+}
+
+static s7_pointer g_provide(s7_scheme *sc, s7_pointer args)
+{
+ #define H_provide "(provide symbol) adds symbol to the *features* list"
+ #define Q_provide s7_make_signature(sc, 2, sc->IS_SYMBOL, sc->IS_SYMBOL)
+ return(c_provide(sc, car(args)));
+}
+
+void s7_provide(s7_scheme *sc, const char *feature)
+{
+ c_provide(sc, s7_make_symbol(sc, feature));
+}
+
+PF_TO_PF(provide, c_provide)
+
+
+static s7_pointer g_features_set(s7_scheme *sc, s7_pointer args)
+{
+ /* symbol_access for set/let of *features* which can only be changed via provide */
+ if (s7_is_list(sc, cadr(args)))
+ return(cadr(args));
+ return(sc->ERROR);
+}
+
+
+static s7_pointer g_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_list "(list ...) returns its arguments in a list"
+ #define Q_list s7_make_circular_signature(sc, 1, 2, sc->IS_PAIR, sc->T)
+ return(copy_list(sc, args));
+}
+
+static s7_pointer c_list_1(s7_scheme *sc, s7_pointer x) {return(cons(sc, x, sc->NIL));}
+PF_TO_PF(list, c_list_1)
+
+static s7_pointer list_0, list_1, list_2;
+static s7_pointer g_list_0(s7_scheme *sc, s7_pointer args)
+{
+ return(sc->NIL);
+}
+
+static s7_pointer g_list_1(s7_scheme *sc, s7_pointer args)
+{
+ return(cons(sc, car(args), sc->NIL));
+}
+
+static s7_pointer g_list_2(s7_scheme *sc, s7_pointer args)
+{
+ return(cons_unchecked(sc, car(args), cons(sc, cadr(args), sc->NIL)));
+}
+
+static s7_pointer list_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ switch (args)
+ {
+ case 0: return(list_0);
+ case 1: return(list_1);
+ case 2: return(list_2);
+ }
+ return(f);
+}
+
+
+s7_pointer s7_list(s7_scheme *sc, int num_values, ...)
+{
+ int i;
+ va_list ap;
+ s7_pointer p;
+
+ if (num_values == 0)
+ return(sc->NIL);
+
+ sc->w = sc->NIL;
+ va_start(ap, num_values);
+ for (i = 0; i < num_values; i++)
+ sc->w = cons(sc, va_arg(ap, s7_pointer), sc->w);
+ va_end(ap);
+
+ p = sc->w;
+ sc->w = sc->NIL;
+
+ return(safe_reverse_in_place(sc, p));
+}
+
+static s7_int sequence_length(s7_scheme *sc, s7_pointer lst);
+
+static s7_pointer g_list_append(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer y, tp, np = NULL, pp;
+
+ /* we know here that args is a pair and cdr(args) is a pair */
+ tp = sc->NIL;
+ for (y = args; is_pair(y); y = cdr(y)) /* arglist so not dotted */
+ {
+ s7_pointer p;
+ p = car(y);
+
+ check_method(sc, p, sc->APPEND, (is_null(tp)) ? args : cons(sc, tp, y));
+
+ if (is_null(cdr(y)))
+ {
+ if (is_null(tp))
+ return(p);
+ if ((s7_is_list(sc, p)) ||
+ (!is_sequence(p)))
+ cdr(np) = p;
+ else
+ {
+ s7_int len;
+ len = sequence_length(sc, p);
+ if (len > 0)
+ cdr(np) = s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F)));
+ else
+ {
+ if (len < 0)
+ cdr(np) = p;
+ }
+ }
+ sc->y = sc->NIL;
+ return(tp);
+ }
+
+ if (!is_sequence(p))
+ return(wrong_type_argument_with_type(sc, sc->APPEND, position_of(y, args), p, A_SEQUENCE));
+
+ if (!is_null(p))
+ {
+ if (is_pair(p))
+ {
+ if (!is_proper_list(sc, p))
+ {
+ sc->y = sc->NIL;
+ return(wrong_type_argument_with_type(sc, sc->APPEND, position_of(y, args), p, A_PROPER_LIST));
+ }
+ /* is this error correct?
+ * (append '(3) '(1 . 2)) -> '(3 1 . 2) ; (old) guile also returns this
+ * but (append '(1 . 2) '(3)) -> this error
+ */
+
+ if (is_null(tp))
+ {
+ tp = cons(sc, car(p), sc->NIL);
+ np = tp;
+ sc->y = tp; /* GC protect? */
+ pp = cdr(p);
+ }
+ else pp = p;
+ for (; is_pair(pp); pp = cdr(pp), np = cdr(np))
+ cdr(np) = cons(sc, car(pp), sc->NIL);
+ }
+ else
+ {
+ s7_int len;
+ len = sequence_length(sc, p);
+ if (len > 0)
+ {
+ if (is_null(tp))
+ {
+ tp = s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F)));
+ np = tp;
+ sc->y = tp;
+ }
+ else cdr(np) = s7_copy(sc, set_plist_2(sc, p, make_list(sc, len, sc->F)));
+ for (; is_pair(cdr(np)); np = cdr(np));
+ }
+ else
+ {
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->APPEND, position_of(y, args), p, A_SEQUENCE));
+ }
+ }
+ }
+ }
+ return(tp);
+}
+
+
+static s7_pointer append_in_place(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ /* tack b onto the end of a without copying either -- 'a' is changed! */
+ s7_pointer p;
+ if (is_null(a))
+ return(b);
+ p = a;
+ while (is_not_null(cdr(p))) p = cdr(p);
+ cdr(p) = b;
+ return(a);
+}
+
+
+/* -------------------------------- vectors -------------------------------- */
+
+bool s7_is_vector(s7_pointer p)
+{
+ return(t_vector_p[type(p)]);
+}
+
+
+bool s7_is_float_vector(s7_pointer p)
+{
+ return(type(p) == T_FLOAT_VECTOR);
+}
+
+
+bool s7_is_int_vector(s7_pointer p)
+{
+ return(type(p) == T_INT_VECTOR);
+}
+
+
+static s7_pointer default_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+{
+ vector_element(vec, loc) = val;
+ return(val);
+}
+
+static s7_pointer default_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
+{
+ return(vector_element(vec, loc));
+}
+
+static s7_pointer int_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+{
+ if (!s7_is_integer(val))
+ s7_wrong_type_arg_error(sc, "int_vector_set!", 3, val, "an integer");
+ int_vector_element(vec, loc) = s7_integer(val);
+ return(val);
+}
+
+static s7_pointer int_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
+{
+ return(make_integer(sc, int_vector_element(vec, loc)));
+}
+
+static s7_pointer float_vector_setter(s7_scheme *sc, s7_pointer vec, s7_int loc, s7_pointer val)
+{
+ float_vector_element(vec, loc) = real_to_double(sc, val, "float-vector-set!");
+ return(val);
+}
+
+static s7_pointer float_vector_getter(s7_scheme *sc, s7_pointer vec, s7_int loc)
+{
+ return(make_real(sc, float_vector_element(vec, loc)));
+}
+
+
+static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, unsigned int typ)
+{
+ s7_pointer x;
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->MAKE_VECTOR, 1, make_integer(sc, len), A_NON_NEGATIVE_INTEGER));
+ if (len > sc->max_vector_length)
+ return(out_of_range(sc, sc->MAKE_VECTOR, small_int(1), make_integer(sc, len), ITS_TOO_LARGE));
+
+ /* this has to follow the error checks! (else garbage in free_heap temps portion confuses GC when "vector" is finalized) */
+ new_cell(sc, x, typ | T_SAFE_PROCEDURE); /* (v 0) as vector-ref is safe */
+ vector_length(x) = 0;
+ vector_elements(x) = NULL;
+ vector_dimension_info(x) = NULL;
+
+ if (len > 0)
+ {
+ vector_length(x) = len;
+ if (typ == T_VECTOR)
+ {
+ vector_elements(x) = (s7_pointer *)malloc(len * sizeof(s7_pointer));
+ if (!vector_elements(x))
+ return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-vector allocation failed!"))));
+ vector_getter(x) = default_vector_getter;
+ vector_setter(x) = default_vector_setter;
+ if (filled) s7_vector_fill(sc, x, sc->NIL); /* make_hash_table assumes nil as the default value */
+ }
+ else
+ {
+ if (typ == T_FLOAT_VECTOR)
+ {
+ if (filled)
+ float_vector_elements(x) = (s7_double *)calloc(len, sizeof(s7_double));
+ else float_vector_elements(x) = (s7_double *)malloc(len * sizeof(s7_double));
+ if (!float_vector_elements(x))
+ return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-float-vector allocation failed!"))));
+ vector_getter(x) = float_vector_getter;
+ vector_setter(x) = float_vector_setter;
+ }
+ else
+ {
+ if (filled)
+ int_vector_elements(x) = (s7_int *)calloc(len, sizeof(s7_int));
+ else int_vector_elements(x) = (s7_int *)malloc(len * sizeof(s7_int));
+ if (!int_vector_elements(x))
+ return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-int-vector allocation failed!"))));
+ vector_getter(x) = int_vector_getter;
+ vector_setter(x) = int_vector_setter;
+ }
+ }
+ }
+
+ Add_Vector(x);
+ return(x);
+}
+
+
+s7_pointer s7_make_vector(s7_scheme *sc, s7_int len)
+{
+ return(make_vector_1(sc, len, FILLED, T_VECTOR));
+}
+
+static vdims_t *make_wrap_only(s7_scheme *sc)
+{
+ vdims_t *v;
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->original = sc->F;
+ v->elements_allocated = false;
+ v->ndims = 1;
+ v->dimensions_allocated = false;
+ v->dims = NULL;
+ v->offsets = NULL;
+ return(v);
+}
+
+#define make_vdims(Sc, Alloc, Dims, Info) ((((Dims) == 1) && (!(Alloc))) ? sc->wrap_only : make_vdims_1(Sc, Alloc, Dims, Info))
+
+static vdims_t *make_vdims_1(s7_scheme *sc, bool elements_allocated, int dims, s7_int *dim_info)
+{
+ vdims_t *v;
+
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->original = sc->F;
+ v->elements_allocated = elements_allocated;
+ v->ndims = dims;
+ if (dims > 1)
+ {
+ int i;
+ s7_int offset = 1;
+ v->dimensions_allocated = true;
+ v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+
+ for (i = 0; i < dims; i++)
+ v->dims[i] = dim_info[i];
+ for (i = v->ndims - 1; i >= 0; i--)
+ {
+ v->offsets[i] = offset;
+ offset *= v->dims[i];
+ }
+ }
+ else
+ {
+ v->dimensions_allocated = false;
+ v->dims = NULL;
+ v->offsets = NULL;
+ }
+ return(v);
+}
+
+
+s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, int dims, s7_int *dim_info)
+{
+ s7_pointer p;
+ p = make_vector_1(sc, len, FILLED, T_INT_VECTOR);
+ if (dim_info)
+ vector_dimension_info(p) = make_vdims(sc, true, dims, dim_info);
+ return(p);
+}
+
+
+s7_pointer s7_make_float_vector(s7_scheme *sc, s7_int len, int dims, s7_int *dim_info)
+{
+ s7_pointer p;
+ p = make_vector_1(sc, len, FILLED, T_FLOAT_VECTOR);
+ if (dim_info)
+ vector_dimension_info(p) = make_vdims(sc, true, dims, dim_info);
+ return(p);
+}
+
+
+s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *data, int dims, s7_int *dim_info, bool free_data)
+{
+ /* this wraps up a C-allocated/freed double array as an s7 vector.
+ */
+ s7_pointer x;
+
+ new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
+ float_vector_elements(x) = data;
+ vector_getter(x) = float_vector_getter;
+ vector_setter(x) = float_vector_setter;
+ vector_length(x) = len;
+ if (!dim_info)
+ {
+ if (!free_data) /* here we need the dim info to tell the GC to leave the data alone */
+ {
+ s7_int di[1];
+ di[0] = len;
+ vector_dimension_info(x) = make_vdims(sc, free_data, 1, di);
+ }
+ else vector_dimension_info(x) = NULL;
+ }
+ else vector_dimension_info(x) = make_vdims(sc, free_data, dims, dim_info);
+ Add_Vector(x);
+ return(x);
+}
+
+
+s7_int s7_vector_length(s7_pointer vec)
+{
+ return(vector_length(vec));
+}
+
+
+s7_int s7_print_length(s7_scheme *sc) {return(sc->print_length);}
+s7_int s7_set_print_length(s7_scheme *sc, s7_int new_len)
+{
+ s7_int old_len;
+ old_len = sc->print_length;
+ sc->print_length = new_len;
+ return(old_len);
+}
+
+
+#if (!WITH_GMP)
+void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
+#else
+static void vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
+#endif
+{
+ s7_int len, i, left;
+
+ len = vector_length(vec);
+ if (len == 0) return;
+ left = len - 8;
+ i = 0;
+
+ switch (type(vec))
+ {
+ case T_FLOAT_VECTOR:
+ if (!s7_is_real(obj))
+ s7_wrong_type_arg_error(sc, "(float) vector-fill!", 2, obj, "a real");
+ else
+ {
+ s7_double x;
+ x = real_to_double(sc, obj, "vector-fill!");
+ if (x == 0.0)
+ memclr((void *)float_vector_elements(vec), len * sizeof(s7_double));
+ else
+ {
+ s7_double *orig;
+ orig = float_vector_elements(vec);
+ while (i <= left)
+ {
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ orig[i++] = x;
+ }
+ for (; i < len; i++)
+ orig[i] = x;
+ }
+ }
+ break;
+
+ case T_INT_VECTOR:
+ if (!s7_is_integer(obj)) /* possibly a bignum */
+ s7_wrong_type_arg_error(sc, "(int) vector-fill!", 2, obj, "an integer");
+ else
+ {
+ s7_int k;
+ k = s7_integer(obj);
+ if (k == 0)
+ memclr((void *)int_vector_elements(vec), len * sizeof(s7_int));
+ else
+ {
+ s7_int* orig;
+ orig = int_vector_elements(vec);
+ while (i <= left)
+ {
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ orig[i++] = k;
+ }
+ for (; i < len; i++)
+ orig[i] = k;
+ }
+ }
+ break;
+
+ default:
+ {
+ s7_pointer *orig;
+ orig = vector_elements(vec);
+ while (i <= left)
+ {
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ orig[i++] = obj;
+ }
+ for (; i < len; i++)
+ orig[i] = obj;
+ }
+ }
+}
+
+
+static s7_pointer g_vector_fill(s7_scheme *sc, s7_pointer args)
+{
+ #define H_vector_fill "(vector-fill! v val start end) sets all elements of the vector v between start and end to val"
+ #define Q_vector_fill s7_make_circular_signature(sc, 3, 4, sc->T, sc->IS_VECTOR, sc->T, sc->IS_INTEGER)
+
+ s7_pointer x, fill;
+ s7_int start = 0, end;
+
+ x = car(args);
+ if (!s7_is_vector(x))
+ {
+ check_method(sc, x, sc->VECTOR_FILL, args);
+ /* not two_methods (and fill!) here else we get stuff like:
+ * (let ((e (openlet (inlet 'fill! (lambda (obj val) (string-fill! (obj 'value) val)) 'value "01234")))) (vector-fill! e #\a) (e 'value)) -> "aaaaa"
+ */
+ return(wrong_type_argument(sc, sc->VECTOR_FILL, 1, x, T_VECTOR));
+ }
+
+ fill = cadr(args);
+ if (is_float_vector(x))
+ {
+ if (!s7_is_real(fill)) /* possibly a bignum */
+ {
+ check_two_methods(sc, fill, sc->VECTOR_FILL, sc->FILL, args);
+ s7_wrong_type_arg_error(sc, "(float) vector-fill!", 2, fill, "a real");
+ }
+ }
+ else
+ {
+ if (is_int_vector(x))
+ {
+ if (!s7_is_integer(fill))
+ {
+ check_two_methods(sc, fill, sc->VECTOR_FILL, sc->FILL, args);
+ s7_wrong_type_arg_error(sc, "(int) vector-fill!", 2, fill, "an integer");
+ }
+ }
+ }
+
+ end = vector_length(x);
+ if (!is_null(cddr(args)))
+ {
+ s7_pointer p;
+ p = start_and_end(sc, sc->VECTOR_FILL, sc->FILL, cddr(args), args, 3, &start, &end);
+ if (p != sc->GC_NIL) return(p);
+ if (start == end) return(fill);
+ }
+ if (end == 0) return(fill);
+
+ if ((start == 0) && (end == vector_length(x)))
+ s7_vector_fill(sc, x, fill);
+ else
+ {
+ s7_int i;
+ if (is_normal_vector(x))
+ {
+ for (i = start; i < end; i++)
+ vector_element(x, i) = fill;
+ }
+ else
+ {
+ if (is_int_vector(x))
+ {
+ s7_int k;
+ k = s7_integer(fill);
+ if (k == 0)
+ memclr((void *)(int_vector_elements(x) + start), (end - start) * sizeof(s7_int));
+ else
+ {
+ for (i = start; i < end; i++)
+ int_vector_element(x, i) = k;
+ }
+ }
+ else
+ {
+ if (is_float_vector(x))
+ {
+ s7_double y;
+ y = real_to_double(sc, fill, "vector-fill!");
+ if (y == 0.0)
+ memclr((void *)(float_vector_elements(x) + start), (end - start) * sizeof(s7_double));
+ else
+ {
+ s7_double *orig;
+ s7_int left;
+ orig = float_vector_elements(x);
+ left = end - 8;
+ i = start;
+ while (i <= left)
+ {
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ orig[i++] = y;
+ }
+ for (; i < end; i++)
+ orig[i] = y;
+ }
+ }
+ }
+ }
+ }
+ return(fill);
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer c_vector_fill(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_vector_fill(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(vector_fill, c_vector_fill)
+#endif
+
+s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index)
+{
+ if (index >= vector_length(vec))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), make_integer(sc, index), ITS_TOO_LARGE));
+
+ return(vector_getter(vec)(sc, vec, index));
+}
+
+
+s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a)
+{
+ if (index >= vector_length(vec))
+ return(out_of_range(sc, sc->VECTOR_SET, small_int(2), make_integer(sc, index), ITS_TOO_LARGE));
+
+ vector_setter(vec)(sc, vec, index, a);
+ return(a);
+}
+
+
+s7_pointer *s7_vector_elements(s7_pointer vec)
+{
+ return(vector_elements(vec));
+}
+
+
+s7_int *s7_int_vector_elements(s7_pointer vec)
+{
+ return(int_vector_elements(vec));
+}
+
+
+s7_double *s7_float_vector_elements(s7_pointer vec)
+{
+ return(float_vector_elements(vec));
+}
+
+
+s7_int *s7_vector_dimensions(s7_pointer vec)
+{
+ s7_int *dims;
+ if (vector_dimension_info(vec))
+ return(vector_dimensions(vec));
+ dims = (s7_int *)malloc(sizeof(s7_int));
+ dims[0] = vector_length(vec);
+ return(dims);
+}
+
+
+s7_int *s7_vector_offsets(s7_pointer vec)
+{
+ s7_int *offs;
+ if (vector_dimension_info(vec))
+ return(vector_offsets(vec));
+ offs = (s7_int *)malloc(sizeof(s7_int));
+ offs[0] = 1;
+ return(offs);
+}
+
+
+#if (!WITH_PURE_S7)
+static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int typ);
+
+static s7_pointer g_vector_append(s7_scheme *sc, s7_pointer args)
+{
+ /* returns a one-dimensional vector. To handle multidimensional vectors, we'd need to
+ * ensure all the dimensional data matches (rank, size of each dimension except the last etc),
+ * which is too much trouble.
+ */
+ #define H_vector_append "(vector-append . vectors) returns a new (1-dimensional) vector containing the elements of its vector arguments."
+ #define Q_vector_append pcl_v
+
+ s7_pointer p;
+ int i;
+
+ if (is_null(args))
+ return(make_vector_1(sc, 0, NOT_FILLED, T_VECTOR));
+
+ for (i = 0, p = args; is_pair(p); p = cdr(p), i++)
+ {
+ s7_pointer x;
+ x = car(p);
+ if (!s7_is_vector(x))
+ {
+ if (has_methods(x))
+ {
+ s7_pointer func;
+ func = find_method(sc, find_let(sc, x), sc->VECTOR_APPEND);
+ if (func != sc->UNDEFINED)
+ {
+ int k;
+ s7_pointer v, y;
+ if (i == 0)
+ return(s7_apply_function(sc, func, args));
+ /* we have to copy the arglist here */
+ sc->temp9 = make_list(sc, i, sc->F);
+ for (k = 0, y = args, v = sc->temp9; k < i; k++, y = cdr(y), v = cdr(v))
+ car(v) = car(y);
+ v = g_vector_append(sc, sc->temp9);
+ y = s7_apply_function(sc, func, cons(sc, v, p));
+ sc->temp9 = sc->NIL;
+ return(y);
+ }
+ }
+ return(wrong_type_argument(sc, sc->VECTOR_APPEND, i, x, T_VECTOR));
+ }
+ }
+ return(vector_append(sc, args, type(car(args))));
+}
+#endif
+
+s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, int indices, ...)
+{
+ /* from s7.html */
+ int ndims;
+
+ ndims = s7_vector_rank(vector);
+ if (ndims == indices)
+ {
+ va_list ap;
+ s7_int index = 0;
+ va_start(ap, indices);
+
+ if (ndims == 1)
+ {
+ index = va_arg(ap, s7_int);
+ va_end(ap);
+ return(s7_vector_ref(sc, vector, index));
+ }
+ else
+ {
+ int i;
+ s7_int *offsets, *dimensions;
+
+ dimensions = s7_vector_dimensions(vector);
+ offsets = s7_vector_offsets(vector);
+
+ for (i = 0; i < indices; i++)
+ {
+ int ind;
+ ind = va_arg(ap, int);
+ if ((ind < 0) ||
+ (ind >= dimensions[i]))
+ {
+ va_end(ap);
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(i), make_integer(sc, ind), (ind < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+ }
+ index += (ind * offsets[i]);
+ }
+ va_end(ap);
+ return(vector_getter(vector)(sc, vector, index));
+ }
+ }
+ return(s7_wrong_number_of_args_error(sc, "s7_vector_ref_n: wrong number of indices: ~A", s7_make_integer(sc, indices)));
+}
+
+
+s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, int indices, ...)
+{
+ int ndims;
+
+ ndims = s7_vector_rank(vector);
+ if (ndims == indices)
+ {
+ va_list ap;
+ s7_int index = 0;
+ va_start(ap, indices);
+
+ if (ndims == 1)
+ {
+ index = va_arg(ap, s7_int);
+ va_end(ap);
+ s7_vector_set(sc, vector, index, value);
+ return(value);
+ }
+ else
+ {
+ int i;
+ s7_int *offsets, *dimensions;
+
+ dimensions = s7_vector_dimensions(vector);
+ offsets = s7_vector_offsets(vector);
+
+ for (i = 0; i < indices; i++)
+ {
+ int ind;
+ ind = va_arg(ap, int);
+ if ((ind < 0) ||
+ (ind >= dimensions[i]))
+ {
+ va_end(ap);
+ return(s7_out_of_range_error(sc, "s7_vector_set_n", i, s7_make_integer(sc, ind), "should be a valid index"));
+ }
+ index += (ind * offsets[i]);
+ }
+ va_end(ap);
+ vector_setter(vector)(sc, vector, index, value);
+ return(value);
+ }
+ }
+ return(s7_wrong_number_of_args_error(sc, "s7_vector_set_n: wrong number of indices: ~A", s7_make_integer(sc, indices)));
+}
+
+
+s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect)
+{
+ s7_int i, len;
+ s7_pointer result;
+
+ len = vector_length(vect);
+ if (len == 0)
+ return(sc->NIL);
+ if (len >= (sc->free_heap_top - sc->free_heap))
+ {
+ gc(sc);
+ while (len >= (sc->free_heap_top - sc->free_heap))
+ resize_heap(sc);
+ }
+
+ sc->v = sc->NIL;
+ for (i = len - 1; i >= 0; i--)
+ sc->v = cons_unchecked(sc, vector_getter(vect)(sc, vect, i), sc->v);
+ result = sc->v;
+ sc->v = sc->NIL;
+ return(result);
+}
+
+#if (!WITH_PURE_S7)
+static s7_pointer c_vector_to_list(s7_scheme *sc, s7_pointer vec)
+{
+ sc->temp3 = vec;
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_TO_LIST, list_1(sc, vec), T_VECTOR, 0);
+ return(s7_vector_to_list(sc, vec));
+}
+
+static s7_pointer g_vector_to_list(s7_scheme *sc, s7_pointer args)
+{
+ s7_int i, start = 0, end;
+ s7_pointer p, vec;
+ #define H_vector_to_list "(vector->list v start end) returns the elements of the vector v as a list; (map values v)"
+ #define Q_vector_to_list s7_make_circular_signature(sc, 2, 3, sc->IS_LIST, sc->IS_VECTOR, sc->IS_INTEGER)
+
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_TO_LIST, args, T_VECTOR, 0);
+
+ end = vector_length(vec);
+ if (!is_null(cdr(args)))
+ {
+ p = start_and_end(sc, sc->VECTOR_TO_LIST, NULL, cdr(args), args, 2, &start, &end);
+ if (p != sc->GC_NIL) return(p);
+ if (start == end) return(sc->NIL);
+ }
+ if ((start == 0) && (end == vector_length(vec)))
+ return(s7_vector_to_list(sc, vec));
+
+ sc->w = sc->NIL;
+ for (i = end - 1; i >= start; i--)
+ sc->w = cons(sc, vector_getter(vec)(sc, vec, i), sc->w);
+ p = sc->w;
+ sc->w = sc->NIL;
+ return(p);
+}
+
+PF_TO_PF(vector_to_list, c_vector_to_list)
+#endif
+
+s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill)
+{
+ s7_pointer vect;
+ vect = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ s7_vector_fill(sc, vect, fill);
+ return(vect);
+}
+
+
+static s7_pointer g_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_vector "(vector ...) returns a vector whose elements are the arguments"
+ #define Q_vector s7_make_circular_signature(sc, 1, 2, sc->IS_VECTOR, sc->T)
+
+ s7_int len;
+ s7_pointer vec;
+
+ len = s7_list_length(sc, args);
+ vec = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ if (len > 0)
+ {
+ s7_int i;
+ s7_pointer x;
+ for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
+ vector_element(vec, i) = car(x);
+ }
+ return(vec);
+}
+
+static s7_pointer c_vector_1(s7_scheme *sc, s7_pointer x) {return(g_vector(sc, set_plist_1(sc, x)));}
+PF_TO_PF(vector, c_vector_1)
+
+
+static s7_pointer g_is_float_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_float_vector "(float-vector? obj) returns #t if obj is an homogenous float vector"
+ #define Q_is_float_vector pl_bt
+ check_boolean_method(sc, s7_is_float_vector, sc->IS_FLOAT_VECTOR, args);
+}
+
+static s7_pointer g_float_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_float_vector "(float-vector ...) returns an homogenous float vector whose elements are the arguments"
+ #define Q_float_vector s7_make_circular_signature(sc, 1, 2, sc->IS_FLOAT_VECTOR, sc->IS_REAL)
+
+ s7_int len;
+ s7_pointer vec;
+
+ len = s7_list_length(sc, args);
+ vec = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR); /* dangerous: assumes real_to_double won't trigger GC even if bignums */
+ if (len > 0)
+ {
+ s7_int i;
+ s7_pointer x;
+ for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
+ {
+ if (s7_is_real(car(x))) /* bignum is ok here */
+ float_vector_element(vec, i) = real_to_double(sc, car(x), "float-vector");
+ else return(simple_wrong_type_argument(sc, sc->FLOAT_VECTOR, car(x), T_REAL));
+ }
+ }
+ return(vec);
+}
+
+static s7_pointer c_float_vector_1(s7_scheme *sc, s7_pointer x) {return(g_float_vector(sc, set_plist_1(sc, x)));}
+PF_TO_PF(float_vector, c_float_vector_1)
+
+
+static s7_pointer g_is_int_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_int_vector "(int-vector? obj) returns #t if obj is an homogenous int vector"
+ #define Q_is_int_vector pl_bt
+ check_boolean_method(sc, is_int_vector, sc->IS_INT_VECTOR, args);
+}
+
+static s7_pointer g_int_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_int_vector "(int-vector ...) returns an homogenous int vector whose elements are the arguments"
+ #define Q_int_vector s7_make_circular_signature(sc, 1, 2, sc->IS_INT_VECTOR, sc->IS_INTEGER)
+
+ s7_int len;
+ s7_pointer vec;
+
+ len = s7_list_length(sc, args);
+ vec = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
+ if (len > 0)
+ {
+ s7_int i;
+ s7_pointer x;
+ for (x = args, i = 0; is_pair(x); x = cdr(x), i++)
+ {
+ if (is_integer(car(x)))
+ int_vector_element(vec, i) = integer(car(x));
+ else return(simple_wrong_type_argument(sc, sc->INT_VECTOR, car(x), T_INTEGER));
+ }
+ }
+ return(vec);
+}
+
+static s7_pointer c_int_vector_1(s7_scheme *sc, s7_pointer x) {return(g_int_vector(sc, set_plist_1(sc, x)));}
+PF_TO_PF(int_vector, c_int_vector_1)
+
+
+#if (!WITH_PURE_S7)
+static s7_pointer c_list_to_vector(s7_scheme *sc, s7_pointer p)
+{
+ sc->temp3 = p;
+ if (is_null(p))
+ return(s7_make_vector(sc, 0));
+
+ if (!is_proper_list(sc, p))
+ method_or_bust_with_type(sc, p, sc->LIST_TO_VECTOR, list_1(sc, p), A_PROPER_LIST, 0);
+
+ return(g_vector(sc, p));
+}
+
+static s7_pointer g_list_to_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_list_to_vector "(list->vector lst) returns a vector containing the elements of lst; (apply vector lst)"
+ #define Q_list_to_vector s7_make_signature(sc, 2, sc->IS_VECTOR, sc->IS_PROPER_LIST)
+ return(c_list_to_vector(sc, car(args)));
+}
+
+PF_TO_PF(list_to_vector, c_list_to_vector)
+
+
+static s7_pointer g_vector_length(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer vec;
+ #define H_vector_length "(vector-length v) returns the length of vector v"
+ #define Q_vector_length s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_VECTOR)
+
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_LENGTH, args, T_VECTOR, 0);
+
+ return(make_integer(sc, vector_length(vec)));
+}
+
+static s7_int c_vector_length(s7_scheme *sc, s7_pointer vec)
+{
+ if (!s7_is_vector(vec))
+ int_method_or_bust(sc, vec, sc->VECTOR_LENGTH, set_plist_1(sc, vec), T_VECTOR, 0);
+ return(vector_length(vec));
+}
+
+PF_TO_IF(vector_length, c_vector_length)
+#endif
+
+static s7_pointer make_shared_vector(s7_scheme *sc, s7_pointer vect, int skip_dims, s7_int index)
+{
+ s7_pointer x;
+ vdims_t *v;
+
+ /* (let ((v #2d((1 2) (3 4)))) (v 1))
+ * (let ((v (make-vector '(2 3 4) 0))) (v 1 2))
+ * (let ((v #3d(((0 1 2 3) (4 5 6 7) (8 9 10 11)) ((12 13 14 15) (16 17 18 19) (20 21 22 23))))) (v 0 1))
+ */
+
+ new_cell(sc, x, typeflag(vect) | T_SAFE_PROCEDURE);
+ vector_length(x) = 0;
+ vector_elements(x) = NULL;
+ vector_getter(x) = vector_getter(vect);
+ vector_setter(x) = vector_setter(vect);
+
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->ndims = vector_ndims(vect) - skip_dims;
+ v->dims = (s7_int *)(vector_dimensions(vect) + skip_dims);
+ v->offsets = (s7_int *)(vector_offsets(vect) + skip_dims);
+ v->original = vect; /* shared_vector */
+ if (type(vect) == T_VECTOR)
+ mark_function[T_VECTOR] = mark_vector_possibly_shared;
+ else mark_function[type(vect)] = mark_int_or_float_vector_possibly_shared;
+ v->elements_allocated = false;
+ v->dimensions_allocated = false;
+ vector_dimension_info(x) = v;
+
+ if (skip_dims > 0)
+ vector_length(x) = vector_offset(vect, skip_dims - 1);
+ else vector_length(x) = vector_length(vect);
+
+ if (is_int_vector(vect))
+ int_vector_elements(x) = (s7_int *)(int_vector_elements(vect) + index);
+ else
+ {
+ if (is_float_vector(vect))
+ float_vector_elements(x) = (s7_double *)(float_vector_elements(vect) + index);
+ else vector_elements(x) = (s7_pointer *)(vector_elements(vect) + index);
+ }
+ add_vector(sc, x);
+ return(x);
+}
+
+
+static s7_pointer g_make_shared_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_shared_vector "(make-shared-vector original-vector new-dimensions (offset 0)) returns \
+a vector that points to the same elements as the original-vector but with different dimensional info."
+ #define Q_make_shared_vector s7_make_signature(sc, 4, sc->IS_VECTOR, sc->IS_VECTOR, s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_INTEGER), sc->IS_INTEGER)
+
+ /* (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (make-shared-vector v1 '(6)))) v2)) -> #(1 2 3 4 5 6)
+ * (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (make-shared-vector v1 '(3 2)))) v2)) -> #2D((1 2) (3 4) (5 6))
+ * this is most useful in generic functions -- they can still use (v n) as the accessor.
+ */
+ s7_pointer orig, dims, y, x;
+ vdims_t *v;
+ int i;
+ s7_int new_len = 1, orig_len, offset = 0;
+
+ orig = car(args);
+ if (!s7_is_vector(orig))
+ method_or_bust(sc, orig, sc->MAKE_SHARED_VECTOR, args, T_VECTOR, 1);
+
+ orig_len = vector_length(orig);
+
+ if (!is_null(cddr(args)))
+ {
+ s7_pointer off;
+ off = caddr(args);
+ if (s7_is_integer(off))
+ {
+ offset = s7_integer(off);
+ if ((offset < 0) ||
+ (offset >= orig_len)) /* we need this if, for example, offset == 9223372036854775807 */
+ return(out_of_range(sc, sc->MAKE_SHARED_VECTOR, small_int(3), off, (offset < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+ }
+ else method_or_bust(sc, off, sc->MAKE_SHARED_VECTOR, args, T_INTEGER, 3);
+ }
+
+ dims = cadr(args);
+ if (is_integer(dims))
+ {
+ if ((s7_integer(dims) < 0) ||
+ (s7_integer(dims) >= orig_len))
+ return(out_of_range(sc, sc->MAKE_SHARED_VECTOR, small_int(2), dims, (s7_integer(dims) < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+ dims = list_1(sc, dims);
+ }
+ else
+ {
+ if ((is_null(dims)) ||
+ (!is_proper_list(sc, dims)))
+ method_or_bust(sc, dims, sc->MAKE_SHARED_VECTOR, args, T_PAIR, 2);
+
+ for (y = dims; is_pair(y); y = cdr(y))
+ if ((!s7_is_integer(car(y))) || /* (make-shared-vector v '((1 2) (3 4))) */
+ (s7_integer(car(y)) > orig_len) ||
+ (s7_integer(car(y)) < 0))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_1(sc, make_string_wrapper(sc, "a list of integers that fits the original vector"))));
+ }
+
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->ndims = safe_list_length(sc, dims);
+ v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->dimensions_allocated = true;
+ v->elements_allocated = false;
+ v->original = orig; /* shared_vector */
+ if (type(orig) == T_VECTOR)
+ mark_function[T_VECTOR] = mark_vector_possibly_shared;
+ else mark_function[type(orig)] = mark_int_or_float_vector_possibly_shared;
+
+ for (i = 0, y = dims; is_pair(y); i++, y = cdr(y))
+ v->dims[i] = s7_integer(car(y));
+
+ for (i = v->ndims - 1; i >= 0; i--)
+ {
+ v->offsets[i] = new_len;
+ new_len *= v->dims[i];
+ }
+
+ if ((new_len < 0) || ((new_len + offset) > vector_length(orig)))
+ {
+ free(v->dims);
+ free(v->offsets);
+ free(v);
+ return(out_of_range(sc, sc->MAKE_SHARED_VECTOR, small_int(2), dims, make_string_wrapper(sc, "a shared vector has to fit in the original vector")));
+ }
+
+ new_cell(sc, x, typeflag(orig) | T_SAFE_PROCEDURE);
+ vector_dimension_info(x) = v;
+ vector_length(x) = new_len; /* might be less than original length */
+ vector_getter(x) = vector_getter(orig);
+ vector_setter(x) = vector_setter(orig);
+
+ if (is_int_vector(orig))
+ int_vector_elements(x) = (s7_int *)(int_vector_elements(orig) + offset);
+ else
+ {
+ if (is_float_vector(orig))
+ float_vector_elements(x) = (s7_double *)(float_vector_elements(orig) + offset);
+ else vector_elements(x) = (s7_pointer *)(vector_elements(orig) + offset);
+ }
+
+ add_vector(sc, x);
+ return(x);
+}
+
+static s7_pointer c_make_shared_vector_ppi(s7_scheme *sc, s7_pointer x, s7_pointer y, s7_int z)
+{
+ return(g_make_shared_vector(sc, set_plist_3(sc, x, y, make_integer(sc, z))));
+}
+
+static s7_pointer c_make_shared_vector_pp(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ return(g_make_shared_vector(sc, set_plist_2(sc, x, y)));
+}
+
+PPIF_TO_PF(make_shared_vector, c_make_shared_vector_pp, c_make_shared_vector_ppi)
+
+
+static s7_pointer make_vector_wrapper(s7_scheme *sc, s7_int size, s7_pointer *elements)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_VECTOR | T_SAFE_PROCEDURE);
+ vector_length(x) = size;
+ vector_elements(x) = elements;
+ vector_getter(x) = default_vector_getter;
+ vector_setter(x) = default_vector_setter;
+ vector_dimension_info(x) = NULL;
+ /* don't add_vector -- no need for sweep to see this */
+ return(x);
+}
+
+static s7_pointer make_subvector(s7_scheme *sc, s7_pointer v)
+{
+ s7_pointer x;
+ new_cell(sc, x, type(v));
+ vector_length(x) = vector_length(v);
+ if (is_normal_vector(v))
+ vector_elements(x) = vector_elements(v);
+ else
+ {
+ if (is_float_vector(v))
+ float_vector_elements(x) = float_vector_elements(v);
+ else int_vector_elements(x) = int_vector_elements(v);
+ }
+ vector_getter(x) = vector_getter(v);
+ vector_setter(x) = vector_setter(v);
+ vector_dimension_info(x) = NULL;
+ return(x);
+}
+
+
+static s7_pointer vector_ref_1(s7_scheme *sc, s7_pointer vect, s7_pointer indices)
+{
+ s7_int index = 0;
+ if (vector_length(vect) == 0)
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(1), vect, ITS_TOO_LARGE));
+
+ if (vector_rank(vect) > 1)
+ {
+ unsigned int i;
+ s7_pointer x;
+ for (x = indices, i = 0; (is_not_null(x)) && (i < vector_ndims(vect)); x = cdr(x), i++)
+ {
+ s7_int n;
+ s7_pointer p, p1;
+ p = car(x);
+ if (!s7_is_integer(p))
+ {
+ if (!s7_is_integer(p1 = check_values(sc, p, x)))
+ method_or_bust(sc, p, sc->VECTOR_REF, cons(sc, vect, indices), T_INTEGER, i + 2);
+ p = p1;
+ }
+ n = s7_integer(p);
+ if ((n < 0) ||
+ (n >= vector_dimension(vect, i)))
+ return(out_of_range(sc, sc->VECTOR_REF, make_integer(sc, i + 2), p, (n < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ index += n * vector_offset(vect, i);
+ }
+ if (is_not_null(x))
+ {
+ if (type(vect) != T_VECTOR)
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), indices, TOO_MANY_INDICES));
+ return(implicit_index(sc, vector_element(vect, index), x));
+ }
+
+ /* if not enough indices, return a shared vector covering whatever is left */
+ if (i < vector_ndims(vect))
+ return(make_shared_vector(sc, vect, i, index));
+ }
+ else
+ {
+ s7_pointer p, p1;
+ /* (let ((hi (make-vector 3 0.0)) (sum 0.0)) (do ((i 0 (+ i 1))) ((= i 3)) (set! sum (+ sum (hi i)))) sum) */
+ p = car(indices);
+
+ if (!s7_is_integer(p))
+ {
+ if (!s7_is_integer(p1 = check_values(sc, p, indices)))
+ method_or_bust(sc, p, sc->VECTOR_REF, cons(sc, vect, indices), T_INTEGER, 2);
+ p = p1;
+ }
+ index = s7_integer(p);
+ if ((index < 0) ||
+ (index >= vector_length(vect)))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), p, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ if (is_not_null(cdr(indices))) /* (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref L 1 2)) */
+ {
+ if (type(vect) != T_VECTOR)
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), indices, TOO_MANY_INDICES));
+ return(implicit_index(sc, vector_element(vect, index), cdr(indices)));
+ }
+ }
+ return((vector_getter(vect))(sc, vect, index));
+}
+
+
+static s7_pointer g_vector_ref(s7_scheme *sc, s7_pointer args)
+{
+ #define H_vector_ref "(vector-ref v ... i) returns the i-th element of vector v."
+ #define Q_vector_ref s7_make_circular_signature(sc, 2, 3, sc->T, sc->IS_VECTOR, sc->IS_INTEGER)
+
+ s7_pointer vec;
+
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_REF, args, T_VECTOR, 1);
+ return(vector_ref_1(sc, vec, cdr(args)));
+}
+
+static s7_pointer g_vector_ref_ic_n(s7_scheme *sc, s7_pointer args, s7_int index)
+{
+ s7_pointer vec;
+ vec = find_symbol_checked(sc, car(args));
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_REF, list_2(sc, vec, cadr(args)), T_VECTOR, 1);
+
+ if (index >= vector_length(vec))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), cadr(args), ITS_TOO_LARGE));
+ if (vector_rank(vec) > 1)
+ {
+ if (index >= vector_dimension(vec, 0))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), cadr(args), ITS_TOO_LARGE));
+ return(make_shared_vector(sc, vec, 1, index * vector_offset(vec, 0)));
+ }
+ return(vector_getter(vec)(sc,vec, index));
+}
+
+/* (vector-ref fv i) -> allocates real, so it's not a pf case */
+static s7_pointer vector_ref_pf_slot(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer x, y;
+ x = (**p); (*p)++;
+ y = slot_value(**p); (*p)++;
+ return(vector_elements(x)[s7_integer(y)]);
+}
+
+static s7_pointer vector_ref_pf_s(s7_scheme *sc, s7_pointer **p)
+{
+ s7_if_t xf;
+ s7_pointer x;
+ s7_int y;
+ x = (**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ return(vector_elements(x)[y]);
+}
+
+static s7_pointer vector_ref_pf_i(s7_scheme *sc, s7_pointer **p)
+{
+ s7_if_t xf;
+ s7_pointer x;
+ s7_int y;
+ x = slot_value(**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ return(vector_elements(x)[y]);
+}
+
+static int c_vector_tester(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer a1;
+ a1 = cadr(expr);
+ if (is_symbol(a1))
+ {
+ s7_pointer table;
+ table = s7_slot(sc, a1);
+ if ((is_slot(table)) && ((is_immutable_symbol(a1)) || (!is_stepper(table))))
+ {
+ table = slot_value(table);
+ if ((type(table) == T_VECTOR) && (vector_rank(table) == 1))
+ {
+ s7_pointer a2;
+ s7_xf_store(sc, table);
+ a2 = caddr(expr);
+ if (is_symbol(a2))
+ {
+ s7_pointer slot;
+ slot = s7_slot(sc, a2);
+ if ((is_slot(slot)) &&
+ (is_integer(slot_value(slot))))
+ {
+ s7_xf_store(sc, slot);
+ return(TEST_SS);
+ }
+ }
+ else
+ {
+ if (s7_arg_to_if(sc, a2))
+ return(TEST_SI);
+ }
+ return(TEST_SQ);
+ }
+ }
+ }
+ return(TEST_NO_S);
+}
+
+static s7_pf_t vector_ref_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ {
+ int choice;
+ choice = (c_vector_tester(sc, expr));
+ if (choice == TEST_SS)
+ return(vector_ref_pf_slot);
+ if (choice == TEST_SI)
+ return(vector_ref_pf_s);
+ }
+ return(NULL);
+}
+
+static s7_pointer vector_ref_ic;
+static s7_pointer g_vector_ref_ic(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, s7_integer(cadr(args))));}
+static s7_pointer vector_ref_ic_0;
+static s7_pointer g_vector_ref_ic_0(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 0));}
+static s7_pointer vector_ref_ic_1;
+static s7_pointer g_vector_ref_ic_1(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 1));}
+static s7_pointer vector_ref_ic_2;
+static s7_pointer g_vector_ref_ic_2(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 2));}
+static s7_pointer vector_ref_ic_3;
+static s7_pointer g_vector_ref_ic_3(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 3));}
+
+static s7_pointer vector_ref_gs;
+static s7_pointer g_vector_ref_gs(s7_scheme *sc, s7_pointer args)
+{
+ /* global vector ref: (vector-ref global_vector i) */
+ s7_pointer x, vec;
+ s7_int index;
+
+ vec = find_global_symbol_checked(sc, car(args));
+ x = find_symbol_checked(sc, cadr(args));
+
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_REF, list_2(sc, vec, x), T_VECTOR, 1);
+ if (!s7_is_integer(x))
+ method_or_bust(sc, x, sc->VECTOR_REF, list_2(sc, vec, x), T_INTEGER, 2);
+
+ index = s7_integer(x);
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), cadr(args), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ if (vector_rank(vec) > 1)
+ {
+ if (index >= vector_dimension(vec, 0))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), cadr(args), ITS_TOO_LARGE));
+ return(make_shared_vector(sc, vec, 1, index * vector_offset(vec, 0)));
+ }
+ return(vector_getter(vec)(sc, vec, index));
+}
+
+static s7_pointer vector_ref_add1;
+static s7_pointer g_vector_ref_add1(s7_scheme *sc, s7_pointer args)
+{
+ /* (vector-ref v (+ s 1)) I think */
+ s7_pointer vec, x;
+ s7_int index;
+
+ vec = find_symbol_checked(sc, car(args));
+ x = find_symbol_checked(sc, cadr(cadr(args)));
+
+ if (!s7_is_integer(x))
+ method_or_bust(sc, x, sc->VECTOR_REF, list_2(sc, vec, x), T_INTEGER, 2);
+ index = s7_integer(x) + 1;
+
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_REF, list_2(sc, vec, s7_make_integer(sc, index)), T_VECTOR, 1);
+
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), cadr(args), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ if (vector_rank(vec) > 1)
+ {
+ if (index >= vector_dimension(vec, 0))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), cadr(args), ITS_TOO_LARGE));
+ return(make_shared_vector(sc, vec, 1, index * vector_offset(vec, 0)));
+ }
+ return(vector_getter(vec)(sc, vec, index));
+}
+
+
+static s7_pointer vector_ref_2, constant_vector_ref_gs;
+static s7_pointer g_constant_vector_ref_gs(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, vec;
+ s7_int index;
+ vec = opt_vector(args);
+ x = find_symbol_checked(sc, cadr(args));
+ if (!s7_is_integer(x))
+ return(g_vector_ref_gs(sc, args));
+ index = s7_integer(x);
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), cadr(args), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+ return(vector_element(vec, index));
+}
+
+static s7_pointer g_vector_ref_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer vec, ind;
+ s7_int index;
+
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_REF, args, T_VECTOR, 1); /* should be ok because we go to g_vector_ref below */
+
+ if (vector_rank(vec) > 1)
+ return(g_vector_ref(sc, args));
+
+ ind = cadr(args);
+ if (!s7_is_integer(ind))
+ method_or_bust(sc, ind, sc->VECTOR_REF, args, T_INTEGER, 2);
+
+ index = s7_integer(ind);
+ if ((index < 0) || (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), ind, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ return(vector_getter(vec)(sc, vec, index));
+}
+
+
+
+static s7_pointer g_vector_set(s7_scheme *sc, s7_pointer args)
+{
+ #define H_vector_set "(vector-set! v i ... value) sets the i-th element of vector v to value."
+ #define Q_vector_set s7_make_circular_signature(sc, 3, 4, sc->T, sc->IS_VECTOR, sc->IS_INTEGER, sc->IS_INTEGER_OR_ANY_AT_END)
+
+ s7_pointer vec, val;
+ s7_int index;
+
+ vec = car(args);
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_SET, args, T_VECTOR, 1);
+
+ if (vector_length(_TSet(vec)) == 0)
+ return(out_of_range(sc, sc->VECTOR_SET, small_int(1), vec, ITS_TOO_LARGE));
+
+ if (vector_rank(vec) > 1)
+ {
+ unsigned int i;
+ s7_pointer x;
+ index = 0;
+ for (x = cdr(args), i = 0; (is_not_null(cdr(x))) && (i < vector_ndims(vec)); x = cdr(x), i++)
+ {
+ s7_int n;
+ s7_pointer p, p1;
+ p = car(x);
+ if (!s7_is_integer(p))
+ {
+ if (!s7_is_integer(p1 = check_values(sc, p, x)))
+ method_or_bust(sc, p, sc->VECTOR_SET, args, T_INTEGER, i + 2);
+ p = p1;
+ }
+ n = s7_integer(p);
+ if ((n < 0) ||
+ (n >= vector_dimension(vec, i)))
+ return(out_of_range(sc, sc->VECTOR_SET, make_integer(sc, i + 2), p, (n < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ index += n * vector_offset(vec, i);
+ }
+
+ if (is_not_null(cdr(x)))
+ return(s7_wrong_number_of_args_error(sc, "too many args for vector-set!: ~S", args));
+ if (i != vector_ndims(vec))
+ return(s7_wrong_number_of_args_error(sc, "not enough args for vector-set!: ~S", args));
+
+ val = car(x);
+ }
+ else
+ {
+ s7_pointer p, p1;
+ p = cadr(args);
+ if (!s7_is_integer(p))
+ {
+ if (!s7_is_integer(p1 = check_values(sc, p, cdr(args))))
+ method_or_bust(sc, p, sc->VECTOR_SET, args, T_INTEGER, 2);
+ p = p1;
+ }
+ index = s7_integer(p);
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->VECTOR_SET, small_int(2), p, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ if (is_not_null(cdddr(args)))
+ {
+ car(sc->temp_cell_2) = vector_getter(vec)(sc, vec, index);
+ cdr(sc->temp_cell_2) = cddr(args);
+ return(g_vector_set(sc, sc->temp_cell_2));
+ }
+ val = caddr(args);
+ }
+
+ vector_setter(vec)(sc, vec, index, val);
+ return(val);
+}
+
+
+static s7_pointer vector_set_ic;
+static s7_pointer g_vector_set_ic(s7_scheme *sc, s7_pointer args)
+{
+ /* (vector-set! vec 0 x) */
+ s7_pointer vec, val;
+ s7_int index;
+
+ vec = find_symbol_checked(sc, car(args));
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_SET, list_3(sc, vec, cadr(args), find_symbol_checked(sc, caddr(args))), T_VECTOR, 1);
+ /* the list_3 happens only if we find the method */
+
+ if (vector_rank(vec) > 1)
+ return(g_vector_set(sc, set_plist_3(sc, vec, cadr(args), find_symbol_checked(sc, caddr(args)))));
+
+ index = s7_integer(cadr(args));
+ if (index >= vector_length(vec))
+ return(out_of_range(sc, sc->VECTOR_SET, small_int(2), cadr(args), ITS_TOO_LARGE));
+
+ val = find_symbol_checked(sc, caddr(args));
+ vector_setter(vec)(sc, vec, index, val);
+ return(val);
+}
+
+
+static s7_pointer vector_set_vref;
+static s7_pointer g_vector_set_vref(s7_scheme *sc, s7_pointer args)
+{
+ /* (vector-set! vec i (vector-ref vec j)) -- checked that the vector is the same */
+ s7_pointer vec, val1, val2;
+ s7_int index1, index2;
+
+ vec = find_symbol_checked(sc, car(args));
+ val1 = find_symbol_checked(sc, cadr(args));
+ val2 = find_symbol_checked(sc, caddr(caddr(args)));
+
+ if ((!s7_is_vector(vec)) ||
+ (vector_rank(vec) > 1) ||
+ (!s7_is_integer(val1)) ||
+ (!s7_is_integer(val2)))
+ return(g_vector_set(sc, set_plist_3(sc, vec, val1, g_vector_ref(sc, set_plist_2(sc, vec, val2)))));
+
+ index1 = s7_integer(val1);
+ if (index1 >= vector_length(vec))
+ return(out_of_range(sc, sc->VECTOR_SET, small_int(2), val1, ITS_TOO_LARGE));
+
+ index2 = s7_integer(val2);
+ if (index2 >= vector_length(vec))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), val2, ITS_TOO_LARGE));
+
+ vector_setter(vec)(sc, vec, index1, val1 = vector_getter(vec)(sc, vec, index2));
+ return(val1);
+}
+
+
+static s7_pointer vector_set_vector_ref;
+static s7_pointer g_vector_set_vector_ref(s7_scheme *sc, s7_pointer args)
+{
+ /* (vector-set! data i|j (+|- (vector-ref data i) tc)) */
+ s7_pointer vec, val, val2, tc, arg3;
+ s7_int index1, index2;
+
+ vec = find_symbol_checked(sc, car(args));
+ val = find_symbol_checked(sc, cadr(args));
+
+ arg3 = caddr(args);
+ tc = find_symbol_checked(sc, caddr(arg3));
+ val2 = caddr(cadr(arg3));
+
+ if ((!s7_is_vector(vec)) ||
+ (vector_rank(vec) > 1) ||
+ (!s7_is_integer(val)))
+ return(g_vector_set(sc, set_plist_3(sc, vec, val, c_call(arg3)(sc, list_2(sc, g_vector_ref(sc, set_plist_2(sc, vec, find_symbol_checked(sc, val2))), tc)))));
+
+ index1 = s7_integer(val);
+ if (index1 >= vector_length(vec))
+ return(out_of_range(sc, sc->VECTOR_SET, small_int(2), val, ITS_TOO_LARGE));
+
+ if (val2 != cadr(args))
+ {
+ val2 = find_symbol_checked(sc, val2);
+ if (!s7_is_integer(val2))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, val2, list_1(sc, val2))))
+ return(wrong_type_argument(sc, sc->VECTOR_REF, 2, val2, T_INTEGER));
+ else val2 = p;
+ }
+ index2 = s7_integer(val2);
+ if (index2 >= vector_length(vec))
+ return(out_of_range(sc, sc->VECTOR_REF, small_int(2), val, ITS_TOO_LARGE));
+ }
+ else index2 = index1;
+
+ car(sc->Z2_1) = vector_getter(vec)(sc, vec, index2);
+ car(sc->Z2_2) = tc;
+ vector_setter(vec)(sc, vec, index1, tc = c_call(arg3)(sc, sc->Z2_1));
+ return(tc);
+}
+
+static s7_pointer c_vector_set_3(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
+{
+ /* (vector-set! vec ind val) where are all predigested */
+
+ if (!s7_is_vector(vec))
+ method_or_bust(sc, vec, sc->VECTOR_SET, list_3(sc, vec, make_integer(sc, index), val), T_VECTOR, 1);
+
+ if (vector_rank(vec) > 1)
+ return(g_vector_set(sc, list_3(sc, vec, make_integer(sc, index), val)));
+
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->VECTOR_SET, small_int(2), make_integer(sc, index), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ vector_setter(vec)(sc, vec, index, val);
+ return(val);
+}
+
+static s7_pointer c_vector_set_s(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer val)
+{
+ /* (vector-set! vec ind val) where are all predigested, vector is prechecked */
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, sc->VECTOR_SET, small_int(2), make_integer(sc, index), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ vector_elements(vec)[index] = val;
+ return(val);
+}
+
+static s7_pointer vector_set_3;
+static s7_pointer g_vector_set_3(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer ind;
+ ind = cadr(args);
+ if (!s7_is_integer(ind))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, ind, cdr(args))))
+ return(wrong_type_argument(sc, sc->VECTOR_SET, 2, ind, T_INTEGER));
+ else ind = p;
+ }
+ return(c_vector_set_3(sc, car(args), s7_integer(ind), caddr(args)));
+}
+
+PIPF_TO_PF(vector_set, c_vector_set_s, c_vector_set_3, c_vector_tester)
+
+
+static s7_pointer g_make_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_vector "(make-vector len (value #f) (homogenous #f)) returns a vector of len elements initialized to value. \
+To create a multidimensional vector, put the dimension bounds in a list (this is to avoid ambiguities such as \
+(make-vector 1 2) where it's not clear whether the '2' is an initial value or a dimension size). (make-vector '(2 3) 1.0) \
+returns a 2 dimensional vector of 6 total elements, all initialized to 1.0. If homogenous is #t, and value is either an integer \
+or a real, the vector can only hold numbers of that type (s7_int or s7_double)."
+ #define Q_make_vector s7_make_signature(sc, 4, sc->IS_VECTOR, s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_PAIR), sc->T, sc->IS_BOOLEAN)
+
+ s7_int len;
+ s7_pointer x, fill, vec;
+ int result_type = T_VECTOR;
+
+ fill = sc->UNSPECIFIED;
+ x = car(args);
+ if (s7_is_integer(x))
+ {
+ len = s7_integer(x);
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->MAKE_VECTOR, 1, x, A_NON_NEGATIVE_INTEGER));
+ }
+ else
+ {
+ if (!(is_pair(x)))
+ method_or_bust_with_type(sc, x, sc->MAKE_VECTOR, args, make_string_wrapper(sc, "an integer or a list of integers"), 1);
+
+ if (!s7_is_integer(car(x)))
+ return(wrong_type_argument_with_type(sc, sc->MAKE_VECTOR, 1, car(x),
+ make_string_wrapper(sc, "each dimension should be an integer")));
+ if (is_null(cdr(x)))
+ len = s7_integer(car(x));
+ else
+ {
+ int dims;
+ s7_pointer y;
+
+ dims = s7_list_length(sc, x);
+ if (dims <= 0) /* 0 if circular, negative if dotted */
+ return(wrong_type_argument_with_type(sc, sc->MAKE_VECTOR, 1, x, A_PROPER_LIST));
+ if (dims > sc->max_vector_dimensions)
+ return(out_of_range(sc, sc->MAKE_VECTOR, small_int(1), x, ITS_TOO_LARGE));
+
+ for (len = 1, y = x; is_not_null(y); y = cdr(y))
+ {
+ if (!s7_is_integer(car(y)))
+ return(wrong_type_argument(sc, sc->MAKE_VECTOR, position_of(y, x), car(y), T_INTEGER));
+ len *= s7_integer(car(y));
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->MAKE_VECTOR, position_of(y, x), car(y), A_NON_NEGATIVE_INTEGER));
+ }
+ }
+ }
+
+ if (is_not_null(cdr(args)))
+ {
+ fill = cadr(args);
+ if (is_not_null(cddr(args)))
+ {
+ if (caddr(args) == sc->T)
+ {
+ /* here bignums can cause confusion, so use is_integer not s7_is_integer etc */
+ if (is_integer(fill))
+ result_type = T_INT_VECTOR;
+ else
+ {
+ if (s7_is_real(fill)) /* might be gmp with big_real by accident (? see above) */
+ result_type = T_FLOAT_VECTOR;
+ else method_or_bust_with_type(sc, fill, sc->MAKE_VECTOR, args, make_string_wrapper(sc, "an integer or a real since 'homogenous' is #t"), 2);
+ }
+ }
+ else
+ {
+ if (caddr(args) != sc->F)
+ method_or_bust_with_type(sc, caddr(args), sc->MAKE_VECTOR, args, A_BOOLEAN, 3);
+ }
+ }
+ }
+
+ vec = make_vector_1(sc, len, NOT_FILLED, result_type);
+ if (len > 0) s7_vector_fill(sc, vec, fill);
+
+ if ((is_pair(x)) &&
+ (is_pair(cdr(x))))
+ {
+ int i;
+ s7_int offset = 1;
+ s7_pointer y;
+ vdims_t *v;
+
+ v = (vdims_t *)malloc(sizeof(vdims_t));
+ v->ndims = safe_list_length(sc, x);
+ v->dims = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->offsets = (s7_int *)malloc(v->ndims * sizeof(s7_int));
+ v->original = sc->F;
+ v->dimensions_allocated = true;
+ v->elements_allocated = (len > 0);
+
+ for (i = 0, y = x; is_not_null(y); i++, y = cdr(y))
+ v->dims[i] = s7_integer(car(y));
+
+ for (i = v->ndims - 1; i >= 0; i--)
+ {
+ v->offsets[i] = offset;
+ offset *= v->dims[i];
+ }
+ vector_dimension_info(vec) = v;
+ }
+ return(vec);
+}
+
+IF_TO_PF(make_vector, s7_make_vector)
+
+
+static s7_pointer g_make_float_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_float_vector "(make-float-vector len (init 0.0)) returns a float-vector."
+ #define Q_make_float_vector s7_make_signature(sc, 3, sc->IS_FLOAT_VECTOR, s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_PAIR), sc->IS_REAL)
+ s7_int len;
+ s7_pointer x, p;
+ s7_double *arr;
+
+ p = car(args);
+ if ((is_pair(cdr(args))) ||
+ (!is_integer(p)))
+ {
+ s7_pointer init;
+ if (is_pair(cdr(args)))
+ {
+ init = cadr(args);
+ if (!s7_is_real(init))
+ method_or_bust(sc, init, sc->MAKE_FLOAT_VECTOR, args, T_REAL, 2);
+#if WITH_GMP
+ if (s7_is_bignum(init))
+ return(g_make_vector(sc, set_plist_3(sc, p, make_real(sc, real_to_double(sc, init, "make-float-vector")), sc->T)));
+#endif
+ if (is_rational(init))
+ return(g_make_vector(sc, set_plist_3(sc, p, make_real(sc, rational_to_double(sc, init)), sc->T)));
+ }
+ else init = real_zero;
+ return(g_make_vector(sc, set_plist_3(sc, p, init, sc->T)));
+ }
+
+ len = s7_integer(p);
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->MAKE_FLOAT_VECTOR, 1, p, A_NON_NEGATIVE_INTEGER));
+ if (len > sc->max_vector_length)
+ return(out_of_range(sc, sc->MAKE_FLOAT_VECTOR, small_int(1), p, ITS_TOO_LARGE));
+
+ if (len > 0)
+ arr = (s7_double *)calloc(len, sizeof(s7_double));
+ else arr = NULL;
+
+ new_cell(sc, x, T_FLOAT_VECTOR | T_SAFE_PROCEDURE);
+ vector_length(x) = len;
+ float_vector_elements(x) = arr;
+ vector_dimension_info(x) = NULL;
+ vector_getter(x) = float_vector_getter;
+ vector_setter(x) = float_vector_setter;
+
+ add_vector(sc, x);
+ return(x);
+}
+
+static s7_pointer c_make_float_vector(s7_scheme *sc, s7_int len) {return(s7_make_float_vector(sc, len, 1, NULL));}
+IF_TO_PF(make_float_vector, c_make_float_vector)
+
+
+static s7_pointer g_make_int_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_int_vector "(make-int-vector len (init 0.0)) returns an int-vector."
+ #define Q_make_int_vector s7_make_signature(sc, 3, sc->IS_INT_VECTOR, s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_PAIR), sc->IS_INTEGER)
+
+ s7_int len;
+ s7_pointer x, p;
+ s7_int *arr;
+
+ p = car(args);
+ if ((is_pair(cdr(args))) ||
+ (!is_integer(p)))
+ {
+ s7_pointer init;
+ if (is_pair(cdr(args)))
+ {
+ init = cadr(args);
+ if (!is_integer(init))
+ method_or_bust(sc, init, sc->MAKE_INT_VECTOR, args, T_INTEGER, 2);
+ }
+ else init = small_int(0);
+ return(g_make_vector(sc, set_plist_3(sc, p, init, sc->T)));
+ }
+
+ len = s7_integer(p);
+ if (len < 0)
+ return(wrong_type_argument_with_type(sc, sc->MAKE_INT_VECTOR, 1, p, A_NON_NEGATIVE_INTEGER));
+ if (len > sc->max_vector_length)
+ return(out_of_range(sc, sc->MAKE_INT_VECTOR, small_int(1), p, ITS_TOO_LARGE));
+
+ if (len > 0)
+ arr = (s7_int *)calloc(len, sizeof(s7_int));
+ else arr = NULL;
+
+ new_cell(sc, x, T_INT_VECTOR | T_SAFE_PROCEDURE);
+ vector_length(x) = len;
+ int_vector_elements(x) = arr;
+ vector_dimension_info(x) = NULL;
+ vector_getter(x) = int_vector_getter;
+ vector_setter(x) = int_vector_setter;
+
+ add_vector(sc, x);
+ return(x);
+}
+
+static s7_pointer c_make_int_vector(s7_scheme *sc, s7_int len) {return(s7_make_int_vector(sc, len, 1, NULL));}
+IF_TO_PF(make_int_vector, c_make_int_vector)
+
+
+static s7_pointer g_is_vector(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_vector "(vector? obj) returns #t if obj is a vector"
+ #define Q_is_vector pl_bt
+ check_boolean_method(sc, s7_is_vector, sc->IS_VECTOR, args);
+}
+
+
+int s7_vector_rank(s7_pointer vect)
+{
+ return(vector_rank(vect));
+}
+
+
+static s7_pointer g_vector_dimensions(s7_scheme *sc, s7_pointer args)
+{
+ #define H_vector_dimensions "(vector-dimensions vect) returns a list of vect's dimensions. In srfi-63 terms:\n\
+ (define array-dimensions vector-dimensions)\n\
+ (define (array-rank v) (length (vector-dimensions v)))"
+ #define Q_vector_dimensions s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_VECTOR)
+
+ s7_pointer x;
+ x = car(args);
+ if (!s7_is_vector(x))
+ method_or_bust(sc, x, sc->VECTOR_DIMENSIONS, args, T_VECTOR, 0);
+
+ if (vector_rank(x) > 1)
+ {
+ int i;
+ sc->w = sc->NIL;
+ for (i = vector_ndims(x) - 1; i >= 0; i--)
+ sc->w = cons(sc, make_integer(sc, vector_dimension(x, i)), sc->w);
+ x = sc->w;
+ sc->w = sc->NIL;
+ return(x);
+ }
+ return(list_1(sc, make_integer(sc, vector_length(x))));
+}
+
+static s7_pointer c_vector_dimensions(s7_scheme *sc, s7_pointer x) {return(g_vector_dimensions(sc, set_plist_1(sc, x)));}
+PF_TO_PF(vector_dimensions, c_vector_dimensions)
+
+
+#define MULTIVECTOR_TOO_MANY_ELEMENTS -1
+#define MULTIVECTOR_NOT_ENOUGH_ELEMENTS -2
+
+static int traverse_vector_data(s7_scheme *sc, s7_pointer vec, int flat_ref, int dimension, int dimensions, int *sizes, s7_pointer lst)
+{
+ /* we're filling vec, we're currently looking for element (flat-wise) flat_ref,
+ * we're at ref in dimension of dimensions, where sizes gives the bounds, and lst is our data
+ * #3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))
+ */
+ int i;
+ s7_pointer x;
+
+ for (i = 0, x = lst; i < sizes[dimension]; i++, x = cdr(x))
+ {
+ if (!is_pair(x))
+ return(MULTIVECTOR_NOT_ENOUGH_ELEMENTS);
+
+ if (dimension == (dimensions - 1))
+ vector_setter(vec)(sc, vec, flat_ref++, car(x));
+ else
+ {
+ flat_ref = traverse_vector_data(sc, vec, flat_ref, dimension + 1, dimensions, sizes, car(x));
+ if (flat_ref < 0) return(flat_ref);
+ }
+ }
+ if (is_not_null(x))
+ return(MULTIVECTOR_TOO_MANY_ELEMENTS);
+ return(flat_ref);
+}
+
+
+static s7_pointer s7_multivector_error(s7_scheme *sc, const char *message, s7_pointer data)
+{
+ return(s7_error(sc, sc->READ_ERROR,
+ set_elist_3(sc, make_string_wrapper(sc, "reading constant vector, ~A: ~A"), make_string_wrapper(sc, message), data)));
+}
+
+
+static s7_pointer g_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
+{
+ /* get the dimension bounds from data, make the new vector, fill it from data
+ *
+ * dims needs to be s7_int so we can at least give correct error messages.
+ * also should we let an empty vector have any number of dimensions? currently ndims is an int.
+ */
+ s7_pointer vec, x;
+ int i, vec_loc, err;
+ int *sizes;
+
+ /* (#2d((1 2 3) (4 5 6)) 0 0) -> 1
+ * (#2d((1 2 3) (4 5 6)) 0 1) -> 2
+ * (#2d((1 2 3) (4 5 6)) 1 1) -> 5
+ * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 0 0 0) -> 1
+ * (#3D(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) -> 7
+ * #3D(((1 2) (3 4)) ((5 6) (7))) -> error, #3D(((1 2) (3 4)) ((5 6) (7 8 9))), #3D(((1 2) (3 4)) (5 (7 8 9))) etc
+ *
+ * but a special case: #nD() is an n-dimensional empty vector
+ */
+
+ if (dims <= 0) /* #0d(...) #2147483649D() [if dims is int this is negative] */
+ return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, make_integer(sc, dims), "must be 1 or more"));
+ if (dims > sc->max_vector_dimensions)
+ return(s7_out_of_range_error(sc, "#nD(...) dimensions", 1, make_integer(sc, dims), "must be < 512")); /* sc->max_vector_dimensions=512 currently */
+
+ sc->w = sc->NIL;
+ if (is_null(data)) /* dims are already 0 (calloc above) */
+ return(g_make_vector(sc, set_plist_1(sc, make_list(sc, dims, small_int(0)))));
+
+ sizes = (int *)calloc(dims, sizeof(int));
+ for (x = data, i = 0; i < dims; i++)
+ {
+ sizes[i] = safe_list_length(sc, x);
+ sc->w = cons(sc, make_integer(sc, sizes[i]), sc->w);
+ x = car(x);
+ if ((i < (dims - 1)) &&
+ (!is_pair(x)))
+ {
+ free(sizes);
+ return(s7_multivector_error(sc, "we need a list that fully specifies the vector's elements", data));
+ }
+ }
+
+ vec = g_make_vector(sc, set_plist_1(sc, sc->w = safe_reverse_in_place(sc, sc->w)));
+ vec_loc = s7_gc_protect(sc, vec);
+ sc->w = sc->NIL;
+
+ /* now fill the vector checking that all the lists match */
+ err = traverse_vector_data(sc, vec, 0, 0, dims, sizes, data);
+
+ free(sizes);
+ s7_gc_unprotect_at(sc, vec_loc);
+ if (err < 0)
+ return(s7_multivector_error(sc, (err == MULTIVECTOR_TOO_MANY_ELEMENTS) ? "found too many elements" : "not enough elements found", data));
+
+ return(vec);
+}
+
+
+static s7_pointer g_qq_multivector(s7_scheme *sc, s7_pointer args)
+{
+ /* `#2d((1 2) ,(list 3 4)) */
+ #define H_qq_multivector "quasiquote internal support for multidimensional vector constants"
+ #define Q_qq_multivector s7_make_signature(sc, 2, sc->IS_VECTOR, sc->T)
+ return(g_multivector(sc, s7_integer(car(args)), cdr(args)));
+}
+
+
+s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect)
+{
+ s7_int len;
+ s7_pointer new_vect;
+
+ len = vector_length(old_vect);
+ if (is_float_vector(old_vect))
+ {
+ if (vector_rank(old_vect) > 1)
+ new_vect = g_make_vector(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), real_zero, sc->T));
+ else new_vect = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR);
+ if (len > 0)
+ memcpy((void *)(float_vector_elements(new_vect)), (void *)(float_vector_elements(old_vect)), len * sizeof(s7_double));
+ }
+ else
+ {
+ if (is_int_vector(old_vect))
+ {
+ if (vector_rank(old_vect) > 1)
+ new_vect = g_make_vector(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, old_vect)), small_int(0), sc->T));
+ else new_vect = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
+ if (len > 0)
+ memcpy((void *)(int_vector_elements(new_vect)), (void *)(int_vector_elements(old_vect)), len * sizeof(s7_int));
+ }
+ else
+ {
+ if (vector_rank(old_vect) > 1)
+ new_vect = g_make_vector(sc, set_plist_1(sc, g_vector_dimensions(sc, list_1(sc, old_vect))));
+ else new_vect = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+
+ /* here and in vector-fill! we have a problem with bignums -- should new bignums be allocated? (copy_list also) */
+ if (len > 0)
+ memcpy((void *)(vector_elements(new_vect)), (void *)(vector_elements(old_vect)), len * sizeof(s7_pointer));
+ }
+ }
+ return(new_vect);
+}
+
+
+static s7_pointer univect_ref(s7_scheme *sc, s7_pointer args, bool flt)
+{
+ s7_pointer v, caller;
+ s7_int ind;
+ int typ;
+
+ caller = (flt) ? sc->FLOAT_VECTOR_REF : sc->INT_VECTOR_REF;
+ typ = (flt) ? T_FLOAT_VECTOR : T_INT_VECTOR;
+
+ v = car(args);
+ if (type(v) != typ)
+ method_or_bust(sc, v, caller, args, typ, 1);
+
+ if (vector_rank(v) == 1)
+ {
+ s7_pointer index;
+ index = cadr(args);
+ if (!s7_is_integer(index))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, index, cdr(args))))
+ return(wrong_type_argument(sc, caller, 2, index, T_INTEGER));
+ else index = p;
+ }
+ ind = s7_integer(index);
+ if ((ind < 0) || (ind >= vector_length(v)))
+ return(simple_out_of_range(sc, caller, index, (ind < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+ if (!is_null(cddr(args)))
+ return(out_of_range(sc, caller, small_int(2), cdr(args), TOO_MANY_INDICES));
+ }
+ else
+ {
+ unsigned int i;
+ s7_pointer x;
+ ind = 0;
+ for (x = cdr(args), i = 0; (is_not_null(x)) && (i < vector_ndims(v)); x = cdr(x), i++)
+ {
+ s7_int n;
+ if (!s7_is_integer(car(x)))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, car(x), x)))
+ return(wrong_type_argument(sc, caller, i + 2, car(x), T_INTEGER));
+ n = s7_integer(p);
+ }
+ else n = s7_integer(car(x));
+ if ((n < 0) ||
+ (n >= vector_dimension(v, i)))
+ return(out_of_range(sc, caller, make_integer(sc, i + 2), car(x), (n < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ ind += n * vector_offset(v, i);
+ }
+ if (is_not_null(x))
+ return(out_of_range(sc, caller, small_int(2), cdr(args), TOO_MANY_INDICES));
+
+ /* if not enough indices, return a shared vector covering whatever is left */
+ if (i < vector_ndims(v))
+ return(make_shared_vector(sc, v, i, ind));
+ }
+ if (flt)
+ return(make_real(sc, float_vector_element(v, ind)));
+ return(make_integer(sc, int_vector_element(v, ind)));
+}
+
+
+static s7_pointer univect_set(s7_scheme *sc, s7_pointer args, bool flt)
+{
+ s7_pointer vec, val, caller;
+ s7_int index;
+ int typ;
+
+ caller = (flt) ? sc->FLOAT_VECTOR_SET : sc->INT_VECTOR_SET;
+ typ = (flt) ? T_FLOAT_VECTOR : T_INT_VECTOR;
+
+ vec = car(args);
+ if (type(vec) != typ)
+ method_or_bust(sc, vec, caller, args, typ, 1);
+
+ if (vector_rank(vec) > 1)
+ {
+ unsigned int i;
+ s7_pointer x;
+ index = 0;
+ for (x = cdr(args), i = 0; (is_not_null(cdr(x))) && (i < vector_ndims(vec)); x = cdr(x), i++)
+ {
+ s7_int n;
+ if (!s7_is_integer(car(x)))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, car(x), x)))
+ method_or_bust(sc, car(x), caller, args, T_INTEGER, i + 2);
+ n = s7_integer(p);
+ }
+ else n = s7_integer(car(x));
+ if ((n < 0) ||
+ (n >= vector_dimension(vec, i)))
+ return(out_of_range(sc, caller, make_integer(sc, i + 2), car(x), (n < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ index += n * vector_offset(vec, i);
+ }
+
+ if (is_not_null(cdr(x)))
+ return(s7_wrong_number_of_args_error(sc, "too many args: ~S", args));
+ if (i != vector_ndims(vec))
+ return(s7_wrong_number_of_args_error(sc, "not enough args: ~S", args));
+
+ val = car(x);
+ }
+ else
+ {
+ if (!s7_is_integer(cadr(args)))
+ {
+ s7_pointer p;
+ if (!s7_is_integer(p = check_values(sc, cadr(args), cdr(args))))
+ method_or_bust(sc, cadr(args), caller, args, T_INTEGER, 2);
+ index = s7_integer(p);
+ }
+ else index = s7_integer(cadr(args));
+ if ((index < 0) ||
+ (index >= vector_length(vec)))
+ return(out_of_range(sc, caller, small_int(2), cadr(args), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE));
+
+ if (is_not_null(cdddr(args)))
+ return(s7_wrong_number_of_args_error(sc, "too many args: ~S", args));
+ val = caddr(args);
+ }
+
+ if (flt)
+ {
+ if (!s7_is_real(val))
+ method_or_bust(sc, val, caller, args, T_REAL, 3);
+ float_vector_element(vec, index) = real_to_double(sc, val, "float-vector-set!");
+ /* currently this accepts a complex value and assigns real_part(val) to the float-vector -- maybe an error instead? */
+ }
+ else
+ {
+ if (!s7_is_integer(val))
+ method_or_bust(sc, val, caller, args, T_INTEGER, 3);
+ int_vector_element(vec, index) = s7_integer(val);
+ }
+ return(val);
+}
+
+
+static s7_pointer g_float_vector_ref(s7_scheme *sc, s7_pointer args)
+{
+ #define H_float_vector_ref "(float-vector-ref v ...) returns an element of the float-vector v."
+ #define Q_float_vector_ref s7_make_circular_signature(sc, 2, 3, sc->IS_FLOAT, sc->IS_FLOAT_VECTOR, sc->IS_INTEGER)
+ return(univect_ref(sc, args, true));
+}
+
+
+static s7_pointer g_float_vector_set(s7_scheme *sc, s7_pointer args)
+{
+ #define H_float_vector_set "(float-vector-set! v i ... value) sets the i-th element of the float-vector v to value."
+ #define Q_float_vector_set s7_make_circular_signature(sc, 3, 4, sc->IS_REAL, sc->IS_FLOAT_VECTOR, sc->IS_INTEGER, sc->IS_INTEGER_OR_REAL_AT_END)
+ return(univect_set(sc, args, true));
+}
+
+static s7_pointer g_int_vector_ref(s7_scheme *sc, s7_pointer args)
+{
+ #define H_int_vector_ref "(int-vector-ref v ...) returns an element of the int-vector v."
+ #define Q_int_vector_ref s7_make_circular_signature(sc, 2, 3, sc->IS_INTEGER, sc->IS_INT_VECTOR, sc->IS_INTEGER)
+ return(univect_ref(sc, args, false));
+}
+
+static s7_pointer g_int_vector_set(s7_scheme *sc, s7_pointer args)
+{
+ #define H_int_vector_set "(int-vector-set! v i ... value) sets the i-th element of the int-vector v to value."
+ #define Q_int_vector_set s7_make_circular_signature(sc, 2, 3, sc->IS_INTEGER, sc->IS_INT_VECTOR, sc->IS_INTEGER)
+ return(univect_set(sc, args, false));
+}
+
+
+/* int-vector-ref|set optimizers */
+
+static s7_int int_vector_ref_if_a(s7_scheme *sc, s7_pointer **p)
+{
+ s7_if_t xf;
+ s7_pointer x;
+ s7_int y;
+ x = (**p); (*p)++;
+ if (!is_int_vector(x))
+ wrong_type_argument(sc, sc->INT_VECTOR_REF, 1, x, T_INT_VECTOR);
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ if ((y < 0) || (y >= vector_length(x)))
+ out_of_range(sc, sc->INT_VECTOR_REF, small_int(2), make_integer(sc, y), (y < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ return(int_vector_elements(x)[y]);
+}
+
+static s7_if_t int_vector_ref_if_expanded(s7_scheme *sc, s7_pointer iv, s7_pointer ind_expr)
+{
+ s7_xf_store(sc, iv);
+ if (s7_arg_to_if(sc, ind_expr))
+ return(int_vector_ref_if_a);
+ return(NULL);
+}
+
+static s7_if_t int_vector_ref_if(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ {
+ s7_pointer iv;
+ iv = cadr(expr);
+ if (!is_symbol(iv)) return(NULL);
+ iv = s7_slot(sc, iv);
+ if (!is_slot(iv)) return(NULL);
+ if (!is_int_vector(slot_value(iv))) return(NULL);
+ return(int_vector_ref_if_expanded(sc, slot_value(iv), caddr(expr)));
+ }
+ return(NULL);
+}
+
+static s7_if_t implicit_int_vector_ref(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_null(cdr(expr))) || (!is_null(cddr(expr)))) return(NULL);
+ return(int_vector_ref_if_expanded(sc, s7_symbol_value(sc, car(expr)), cadr(expr)));
+}
+
+static s7_int int_vector_set_if_a(s7_scheme *sc, s7_pointer **p)
+{
+ s7_if_t xf;
+ s7_pointer x;
+ s7_int y, z;
+ x = (**p); (*p)++;
+ if (!is_int_vector(x))
+ wrong_type_argument(sc, sc->INT_VECTOR_SET, 1, x, T_INT_VECTOR);
+ xf = (s7_if_t)(**p); (*p)++;
+ y = xf(sc, p);
+ if ((y < 0) || (y >= vector_length(x)))
+ out_of_range(sc, sc->INT_VECTOR_SET, small_int(2), make_integer(sc, y), (y < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ xf = (s7_if_t)(**p); (*p)++;
+ z = xf(sc, p);
+ int_vector_elements(x)[y] = z;
+ return(z);
+}
+
+static s7_if_t int_vector_set_if_expanded(s7_scheme *sc, s7_pointer iv, s7_pointer ind_sym, s7_pointer val_expr)
+{
+ s7_xf_store(sc, iv);
+ if ((s7_arg_to_if(sc, ind_sym)) &&
+ (s7_arg_to_if(sc, val_expr)))
+ return(int_vector_set_if_a);
+ return(NULL);
+}
+
+static s7_if_t int_vector_set_if(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_pair(cdddr(expr))) && (is_null(cddddr(expr))))
+ {
+ s7_pointer iv;
+ iv = cadr(expr);
+ if (!is_symbol(iv)) return(NULL);
+ iv = s7_slot(sc, iv);
+ if (!is_slot(iv)) return(NULL);
+ if (!is_int_vector(slot_value(iv))) return(NULL);
+ return(int_vector_set_if_expanded(sc, slot_value(iv), caddr(expr), cadddr(expr)));
+ }
+ return(NULL);
+}
+
+
+
+/* float-vector-ref|set optimizers */
+static s7_double fv_set_rf_checked(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer fv, ind;
+ s7_double val;
+ s7_int index;
+ s7_rf_t rf;
+ fv = **p; (*p)++;
+ ind = slot_value(**p); (*p)++;
+ if (!is_integer(ind))
+ wrong_type_argument(sc, sc->FLOAT_VECTOR_SET, 2, ind, T_INTEGER);
+ index = integer(ind);
+ if ((index < 0) || (index >= vector_length(fv)))
+ out_of_range(sc, sc->FLOAT_VECTOR_SET, small_int(2), ind, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ float_vector_element(fv, index) = val;
+ return(val);
+}
+
+static s7_double fv_set_rf_r(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer fv, ind, x;
+ s7_double val;
+ s7_int index;
+ fv = **p; (*p)++;
+ ind = slot_value(**p); (*p)++;
+ if (!is_integer(ind))
+ wrong_type_argument(sc, sc->FLOAT_VECTOR_SET, 2, ind, T_INTEGER);
+ index = integer(ind);
+ if ((index < 0) || (index >= vector_length(fv)))
+ out_of_range(sc, sc->FLOAT_VECTOR_SET, small_int(2), ind, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ x = **p; (*p)++;
+ val = real_to_double(sc, x, "float-vector-set!");
+ float_vector_element(fv, index) = val;
+ return(val);
+}
+
+static s7_double fv_set_rf_s(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer fv, ind, x;
+ s7_double val;
+ s7_int index;
+ fv = **p; (*p)++;
+ ind = slot_value(**p); (*p)++;
+ if (!is_integer(ind))
+ wrong_type_argument(sc, sc->FLOAT_VECTOR_SET, 2, ind, T_INTEGER);
+ index = integer(ind);
+ if ((index < 0) || (index >= vector_length(fv)))
+ out_of_range(sc, sc->FLOAT_VECTOR_SET, small_int(2), ind, (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ x = slot_value(**p); (*p)++;
+ val = real_to_double(sc, x, "float-vector-set!");
+ float_vector_element(fv, index) = val;
+ return(val);
+}
+
+
+static s7_double fv_set_rf_six(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer fv, ind;
+ s7_double val;
+ s7_int index;
+ s7_rf_t rf;
+ fv = **p; (*p)++;
+ ind = **p; (*p)++;
+ index = integer(ind);
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ float_vector_element(fv, index) = val;
+ return(val);
+}
+
+static s7_double fv_set_rf_if(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer fv;
+ s7_double val;
+ s7_int index;
+ s7_rf_t rf;
+ s7_if_t xf;
+ fv = **p; (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ index = xf(sc, p);
+ if ((index < 0) || (index >= vector_length(fv)))
+ out_of_range(sc, sc->FLOAT_VECTOR_SET, small_int(2), make_integer(sc, index), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ rf = (s7_rf_t)(**p); (*p)++;
+ val = rf(sc, p);
+ float_vector_element(fv, index) = val;
+ return(val);
+}
+
+static s7_rf_t float_vector_set_rf_expanded(s7_scheme *sc, s7_pointer fv, s7_pointer ind_sym, s7_pointer val_expr)
+{
+ xf_t *rc;
+ xf_init(3);
+ xf_store(fv);
+ if (is_symbol(ind_sym))
+ {
+ s7_pointer ind, ind_slot;
+
+ ind_slot = s7_slot(sc, ind_sym);
+ if (!is_slot(ind_slot)) return(NULL);
+ ind = slot_value(ind_slot);
+ if (!is_integer(ind)) return(NULL);
+ if (numerator(ind) < 0) return(NULL);
+ xf_store(ind_slot);
+ if (is_real(val_expr))
+ {
+ xf_store(val_expr);
+ return(fv_set_rf_r);
+ }
+ if (is_symbol(val_expr))
+ {
+ s7_pointer slot, val;
+ slot = s7_slot(sc, val_expr);
+ if (!is_slot(slot)) return(NULL);
+ val = slot_value(slot);
+ if (!is_real(val)) return(NULL);
+ xf_store(slot);
+ return(fv_set_rf_s);
+ }
+ if (!is_pair(val_expr)) return(NULL);
+ return(pair_to_rf(sc, val_expr, fv_set_rf_checked));
+ }
+ if (is_pair(ind_sym))
+ {
+ s7_ip_t ip;
+ s7_if_t xf;
+ s7_int loc;
+ if (!is_pair(val_expr)) return(NULL);
+ xf_save_loc(loc);
+ ip = pair_to_ip(sc, ind_sym);
+ if (!ip) return(NULL);
+ xf = ip(sc, ind_sym);
+ if (!xf) return(NULL);
+ xf_store_at(loc, (s7_pointer)xf);
+ return(pair_to_rf(sc, val_expr, fv_set_rf_if));
+ }
+ if ((is_integer(ind_sym)) &&
+ (is_pair(val_expr)))
+ {
+ s7_int index;
+ index = integer(ind_sym);
+ if ((index < 0) || (index >= vector_length(fv))) return(NULL);
+ xf_store(ind_sym);
+ return(pair_to_rf(sc, val_expr, fv_set_rf_six));
+ }
+ return(NULL);
+}
+
+static s7_rf_t float_vector_set_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer fv;
+ fv = cadr(expr);
+ if (!is_symbol(fv)) return(NULL);
+ fv = s7_slot(sc, fv);
+ if (!is_slot(fv)) return(NULL);
+ if (!is_float_vector(slot_value(fv))) return(NULL);
+ return(float_vector_set_rf_expanded(sc, slot_value(fv), caddr(expr), cadddr(expr)));
+}
+
+
+static s7_double fv_ref_rf_ss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s7_int ind;
+ s1 = slot_value(**p); (*p)++;
+ s2 = slot_value(**p); (*p)++;
+ ind = s7_integer(s2);
+ if ((ind < 0) || (ind >= vector_length(s1)))
+ out_of_range(sc, sc->FLOAT_VECTOR_REF, small_int(2), s2, (ind < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ return(float_vector_elements(s1)[ind]);
+}
+
+static s7_double fv_ref_rf_si(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1, s2;
+ s7_int ind;
+ s1 = slot_value(**p); (*p)++;
+ s2 = (**p); (*p)++;
+ ind = s7_integer(s2);
+ if ((ind < 0) || (ind >= vector_length(s1)))
+ out_of_range(sc, sc->FLOAT_VECTOR_REF, small_int(2), s2, (ind < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ return(float_vector_elements(s1)[ind]);
+}
+
+static s7_double fv_ref_rf_sx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_if_t i1;
+ s7_int ind;
+ s1 = slot_value(**p); (*p)++;
+ i1 = (s7_if_t)(**p); (*p)++;
+ ind = i1(sc, p);
+ if ((ind < 0) || (ind >= vector_length(s1)))
+ out_of_range(sc, sc->FLOAT_VECTOR_REF, small_int(2), make_integer(sc, ind), (ind < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ return(float_vector_elements(s1)[ind]);
+}
+
+static s7_double fv_ref_rf_pf(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer s1;
+ s7_pf_t fv;
+ s7_if_t i1;
+ s7_int ind;
+ fv = (s7_pf_t)(**p); (*p)++;
+ s1 = fv(sc, p);
+ if (!is_float_vector(s1))
+ wrong_type_argument(sc, sc->FLOAT_VECTOR_REF, 1, s1, T_FLOAT_VECTOR);
+ i1 = (s7_if_t)(**p); (*p)++;
+ ind = i1(sc, p);
+ if ((ind < 0) || (ind >= vector_length(s1)))
+ out_of_range(sc, sc->FLOAT_VECTOR_REF, small_int(2), make_integer(sc, ind), (ind < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ return(float_vector_elements(s1)[ind]);
+}
+
+static s7_rf_t float_vector_ref_rf_expanded(s7_scheme *sc, s7_pointer a1, s7_pointer a2)
+{
+ if ((is_symbol(a1)) &&
+ (is_float_vector(s7_symbol_value(sc, a1))))
+ {
+ xf_t *rc;
+ xf_init(2);
+ xf_store(s7_slot(sc, a1));
+ if (is_integer(a2))
+ {
+ xf_store(a2);
+ return(fv_ref_rf_si);
+ }
+ if (is_symbol(a2))
+ {
+ a2 = s7_slot(sc, a2);
+ if ((!is_slot(a2)) || (is_t_complex(slot_value(a2)))) return(NULL);
+ xf_store(a2);
+ return(fv_ref_rf_ss);
+ }
+ if (is_pair(a2))
+ return(pair_to_rf_via_if(sc, a2, fv_ref_rf_sx));
+ }
+ if ((is_pair(a1)) &&
+ (s7_arg_to_pf(sc, a1)) &&
+ (s7_arg_to_if(sc, a2)))
+ return(fv_ref_rf_pf);
+ return(NULL);
+}
+
+static s7_rf_t float_vector_ref_rf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_null(cdr(expr))) || (is_null(cddr(expr))) || (!is_null(cdddr(expr)))) return(NULL);
+ return(float_vector_ref_rf_expanded(sc, cadr(expr), caddr(expr)));
+}
+
+static s7_rf_t implicit_float_vector_ref(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_null(cdr(expr))) || (!is_null(cddr(expr)))) return(NULL);
+ return(float_vector_ref_rf_expanded(sc, car(expr), cadr(expr)));
+}
+
+
+static s7_pointer hash_table_ref_pf_i(s7_scheme *sc, s7_pointer **p);
+static s7_pointer hash_table_set_pf_sxx(s7_scheme *sc, s7_pointer **p);
+
+static s7_pf_t implicit_pf_sequence_ref(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer seq, ind;
+ if ((is_null(cdr(expr))) || (!is_null(cddr(expr)))) return(NULL);
+ seq = car(expr);
+ ind = cadr(expr);
+ if (!is_symbol(seq)) return(NULL);
+ seq = s7_slot(sc, seq);
+ if (!is_slot(seq)) return(NULL);
+ s7_xf_store(sc, seq);
+ switch (type(slot_value(seq)))
+ {
+ case T_STRING:
+ if (s7_arg_to_if(sc, ind))
+ return(string_ref_pf_si);
+ break;
+
+ case T_PAIR:
+ if (s7_arg_to_if(sc, ind))
+ return(list_ref_pf_si);
+ break;
+
+ case T_VECTOR:
+ if (s7_arg_to_if(sc, ind))
+ return(vector_ref_pf_i); /* TODO: these vref funcs don't check bounds */
+ break;
+
+ case T_HASH_TABLE:
+ if (s7_arg_to_pf(sc, ind))
+ return(hash_table_ref_pf_i);
+ break;
+
+ case T_LET:
+ if (s7_arg_to_pf(sc, ind))
+ return(let_ref_pf_p2_sp);
+ break;
+ }
+ return(NULL);
+}
+
+static s7_pf_t implicit_gf_sequence_ref(s7_scheme *sc, s7_pointer expr)
+{
+ /* only difference from pf case: int|float-vectors return s7_pointer values */
+ return(implicit_pf_sequence_ref(sc, expr));
+}
+
+#if WITH_OPTIMIZATION
+static s7_pf_t implicit_pf_sequence_set(s7_scheme *sc, s7_pointer seq, s7_pointer ind, s7_pointer val)
+{
+ /* seq is the slot */
+ s7_xf_store(sc, seq);
+ switch (type(slot_value(seq)))
+ {
+ case T_STRING:
+ if ((s7_arg_to_if(sc, ind)) &&
+ (s7_arg_to_pf(sc, val)))
+ return(string_set_pf_seq);
+ break;
+
+ case T_PAIR:
+ if ((s7_arg_to_if(sc, ind)) &&
+ (s7_arg_to_pf(sc, val)))
+ return(list_set_pf_seq);
+ break;
+
+ case T_VECTOR:
+ if ((s7_arg_to_if(sc, ind)) &&
+ (s7_arg_to_pf(sc, val)))
+ return(vector_set_pf_seq);
+ break;
+
+ case T_HASH_TABLE:
+ if ((s7_arg_to_pf(sc, ind)) &&
+ (s7_arg_to_pf(sc, val)))
+ return(hash_table_set_pf_sxx);
+ break;
+
+ case T_LET:
+ if ((s7_arg_to_pf(sc, ind)) &&
+ (s7_arg_to_pf(sc, val)))
+ return(let_set_pf_p3_s);
+ break;
+ }
+ return(NULL);
+}
+
+static s7_pf_t implicit_gf_sequence_set(s7_scheme *sc, s7_pointer v, s7_pointer ind, s7_pointer val)
+{
+ return(implicit_pf_sequence_set(sc, v, ind, val));
+}
+#endif
+
+
+
+/* -------------------------------------------------------------------------------- */
+
+static bool c_function_is_ok(s7_scheme *sc, s7_pointer x)
+{
+ /* macro version of this (below) is much slower! */
+ s7_pointer p;
+
+ p = car(x);
+ if (is_global(p)) p = slot_value(global_slot(p)); else p = find_symbol_unchecked(sc, p);
+ /* this is nearly always global and p == opt_cfunc(x) */
+ return((p == opt_any1(x)) ||
+ ((is_any_c_function(p)) && (opt_cfunc(x)) &&
+ (c_function_class(p) == c_function_class(opt_cfunc(x)))));
+}
+
+#if 0
+#define c_function_is_ok(Sc, X) \
+ ({ s7_pointer _X_, _p_; _X_ = X; _p_ = find_global_symbol_checked(Sc, car(_X_)); \
+ ((_p_ == opt_cfunc(_X_)) || ((is_any_c_function(_p_)) && (c_function_class(_p_) == c_function_class(opt_cfunc(_X_))))); })
+#endif
+
+static bool arglist_has_rest(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ for (p = args; is_pair(p); p = cdr(p))
+ if (car(p) == sc->KEY_REST)
+ return(true);
+ return(false);
+}
+
+
+static bool arglist_has_keyword(s7_pointer args)
+{
+ s7_pointer p;
+ for (p = args; is_pair(p); p = cdr(p))
+ if (is_keyword(car(p)))
+ return(true);
+ return(false);
+}
+
+
+/* -------- sort! -------- */
+
+#if (!WITH_GMP)
+static int dbl_less(const void *f1, const void *f2)
+{
+ if ((*((s7_double *)f1)) < (*((s7_double *)f2))) return(-1);
+ if ((*((s7_double *)f1)) > (*((s7_double *)f2))) return(1);
+ return(0);
+}
+
+static int int_less(const void *f1, const void *f2)
+{
+ if ((*((s7_int *)f1)) < (*((s7_int *)f2))) return(-1);
+ if ((*((s7_int *)f1)) > (*((s7_int *)f2))) return(1);
+ return(0);
+}
+
+static int dbl_greater(const void *f1, const void *f2) {return(-dbl_less(f1, f2));}
+static int int_greater(const void *f1, const void *f2) {return(-int_less(f1, f2));}
+
+static int byte_less(const void *f1, const void *f2)
+{
+ if ((*((unsigned char *)f1)) < (*((unsigned char *)f2))) return(-1);
+ if ((*((unsigned char *)f1)) > (*((unsigned char *)f2))) return(1);
+ return(0);
+}
+
+static int byte_greater(const void *f1, const void *f2) {return(-byte_less(f1, f2));}
+
+static int dbl_less_2(const void *f1, const void *f2)
+{
+ s7_pointer p1, p2;
+ p1 = (*((s7_pointer *)f1));
+ p2 = (*((s7_pointer *)f2));
+ if (real(p1) < real(p2)) return(-1);
+ if (real(p1) > real(p2)) return(1);
+ return(0);
+}
+
+static int int_less_2(const void *f1, const void *f2)
+{
+ s7_pointer p1, p2;
+ p1 = (*((s7_pointer *)f1));
+ p2 = (*((s7_pointer *)f2));
+ if (integer(p1) < integer(p2)) return(-1);
+ if (integer(p1) > integer(p2)) return(1);
+ return(0);
+}
+
+static int dbl_greater_2(const void *f1, const void *f2) {return(-dbl_less_2(f1, f2));}
+static int int_greater_2(const void *f1, const void *f2) {return(-int_less_2(f1, f2));}
+#endif
+
+static s7_scheme *compare_sc;
+static s7_function compare_func;
+static s7_pointer compare_args, compare_begin, compare_v1, compare_v2;
+static opcode_t compare_op;
+static s7_pf_t compare_pf;
+
+static int vector_compare(const void *v1, const void *v2)
+{
+ car(compare_args) = (*(s7_pointer *)v1);
+ cadr(compare_args) = (*(s7_pointer *)v2);
+ return(((*(compare_func))(compare_sc, compare_args) != compare_sc->F) ? -1 : 1);
+}
+
+static int pf_compare(const void *v1, const void *v2)
+{
+ s7_pointer *top;
+ s7_pointer **rp;
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ top = compare_sc->cur_rf->data;
+ rp = ⊤ (*rp)++;
+ if (is_true(compare_sc, compare_pf(compare_sc, rp)))
+ return(-1);
+ return(1);
+}
+
+static int closure_compare(const void *v1, const void *v2)
+{
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ push_stack(compare_sc, OP_EVAL_DONE, compare_sc->args, compare_sc->code);
+ compare_sc->code = compare_args; /* this should be ok because we checked in advance that it is a safe closure (no sort! for example) */
+ eval(compare_sc, compare_op);
+ return((compare_sc->value != compare_sc->F) ? -1 : 1);
+}
+
+static int closure_compare_begin(const void *v1, const void *v2)
+{
+ slot_set_value(compare_v1, (*(s7_pointer *)v1));
+ slot_set_value(compare_v2, (*(s7_pointer *)v2));
+ push_stack(compare_sc, OP_EVAL_DONE, compare_sc->args, compare_sc->code);
+ push_stack_no_args(compare_sc, OP_BEGIN1, compare_begin);
+ compare_sc->code = compare_args;
+ eval(compare_sc, compare_op);
+ return((compare_sc->value != compare_sc->F) ? -1 : 1);
+}
+
+static s7_pointer g_sort(s7_scheme *sc, s7_pointer args)
+{
+ #define H_sort "(sort! sequence less?) sorts a sequence using the function 'less?' to compare elements."
+ #define Q_sort s7_make_signature(sc, 3, sc->T, sc->IS_SEQUENCE, sc->IS_PROCEDURE)
+
+ s7_pointer data, lessp, lx;
+ s7_int len = 0, n, k;
+ int (*sort_func)(const void *v1, const void *v2);
+ s7_pointer *elements;
+ int gc_loc = -1;
+
+ /* both the intermediate vector (if any) and the current args pointer need GC protection,
+ * but it is a real bother to unprotect args at every return statement, so I'll use temp3
+ */
+ sc->temp3 = args; /* this is needed! */
+ data = car(args);
+ if (is_null(data))
+ {
+ /* (apply sort! () #f) should be an error I think */
+ lessp = cadr(args);
+ if (type(lessp) < T_GOTO)
+ method_or_bust_with_type(sc, lessp, sc->SORT, args, A_PROCEDURE, 2);
+ if (!s7_is_aritable(sc, lessp, 2))
+ return(wrong_type_argument_with_type(sc, sc->SORT, 2, lessp, AN_EQ_FUNC));
+ return(sc->NIL);
+ }
+
+ lessp = cadr(args);
+ if (type(lessp) < T_GOTO)
+ method_or_bust_with_type(sc, lessp, sc->SORT, args, A_PROCEDURE, 2);
+ if (!s7_is_aritable(sc, lessp, 2))
+ return(wrong_type_argument_with_type(sc, sc->SORT, 2, lessp, AN_EQ_FUNC));
+
+ if ((is_continuation(lessp)) || is_goto(lessp))
+ return(wrong_type_argument_with_type(sc, sc->SORT, 2, lessp, A_NORMAL_PROCEDURE));
+
+ sort_func = vector_compare;
+ compare_func = NULL;
+ compare_args = sc->T2_1;
+ compare_sc = sc;
+
+ if ((is_safe_procedure(lessp)) && /* (sort! a <) */
+ (is_c_function(lessp)))
+ {
+ s7_pointer sig;
+ sig = c_function_signature(lessp);
+ if ((sig) &&
+ (is_pair(sig)) &&
+ (car(sig) != sc->IS_BOOLEAN))
+ return(wrong_type_argument_with_type(sc, sc->SORT, 2, lessp, make_string_wrapper(sc, "sort! function should return a boolean")));
+ compare_func = c_function_call(lessp);
+ }
+ else
+ {
+ if (is_closure(lessp))
+ {
+ s7_pointer expr, largs;
+ expr = car(closure_body(lessp));
+ largs = closure_args(lessp);
+
+ if ((is_null(cdr(closure_body(lessp)))) &&
+ (is_optimized(expr)))
+ {
+ /* since (sort seq (lambda (a b) ...)) can't return a "safe closure" (the hop bit is off in
+ * optimize in this case, for some arcane reason), the optimized expression won't be hop_safe,
+ * but that is irrelevant at this point -- if c_function_is_ok, we're good to go.
+ */
+ if ((is_pair(largs)) &&
+ (!arglist_has_rest(sc, largs)) &&
+ (((optimize_op(expr) & 1) != 0) ||
+ (c_function_is_ok(sc, expr))))
+ {
+ int orig_data;
+ orig_data = optimize_op(expr);
+ set_optimize_op(expr, optimize_op(expr) | 1);
+ if ((optimize_op(expr) == HOP_SAFE_C_SS) &&
+ (car(largs) == cadr(expr)) &&
+ (cadr(largs) == caddr(expr)))
+ {
+ lessp = find_symbol_unchecked(sc, car(expr));
+ compare_func = c_function_call(lessp);
+ }
+ else
+ {
+ if (!is_unsafe_sort(expr))
+ {
+ new_frame_with_two_slots(sc, closure_let(lessp), sc->envir, car(largs), sc->F, cadr(largs), sc->F);
+ set_stepper(let_slots(sc->envir));
+ set_stepper(next_slot(let_slots(sc->envir)));
+ s7_xf_new(sc, sc->envir);
+ compare_pf = xf_opt(sc, expr);
+ if (compare_pf)
+ {
+ sort_func = pf_compare;
+ compare_func = g_sort; /* whatever...(just a flag) */
+ compare_v1 = let_slots(sc->envir);
+ compare_v2 = next_slot(let_slots(sc->envir));
+ }
+ else
+ {
+ set_unsafe_sort(expr);
+ s7_xf_free(sc);
+ }
+ }
+ }
+ set_optimize_op(expr, orig_data);
+ }
+ }
+
+ if ((!compare_func) &&
+ (is_pair(largs)) && /* closure args not a symbol, etc */
+ (is_safe_closure(lessp))) /* no embedded sort! or call/cc, etc */
+ {
+ new_frame_with_two_slots(sc, closure_let(lessp), sc->envir, car(largs), sc->F, cadr(largs), sc->F);
+ compare_func = (s7_function)lessp; /* not used -- just a flag */
+ compare_args = car(closure_body(lessp));
+ compare_begin = cdr(closure_body(lessp));
+ if (is_null(compare_begin))
+ sort_func = closure_compare;
+ else sort_func = closure_compare_begin;
+ if (typesflag(compare_args) == SYNTACTIC_PAIR)
+ {
+ compare_op = (opcode_t)pair_syntax_op(compare_args);
+ compare_args = cdr(compare_args);
+ }
+ else compare_op = OP_EVAL;
+ compare_v1 = let_slots(sc->envir);
+ compare_v2 = next_slot(let_slots(sc->envir));
+ }
+ }
+ }
+
+#if (!WITH_GMP)
+ if (compare_func == g_less)
+ compare_func = g_less_2;
+ else
+ {
+ if (compare_func == g_greater)
+ compare_func = g_greater_2;
+ }
+#endif
+
+ switch (type(data))
+ {
+ case T_PAIR:
+ len = s7_list_length(sc, data); /* 0 here == infinite */
+ if (len <= 0)
+ {
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "sort! argument 1 should be a proper list: ~S"), data)));
+ }
+ if (len < 2)
+ {
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(data);
+ }
+ if (compare_func)
+ {
+ int i;
+ s7_pointer vec, p;
+
+ vec = g_vector(sc, data);
+ gc_loc = s7_gc_protect(sc, vec);
+ elements = s7_vector_elements(vec);
+
+ sc->v = vec;
+ qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
+ for (p = data, i = 0; i < len; i++, p = cdr(p))
+ car(p) = elements[i];
+
+ s7_gc_unprotect_at(sc, gc_loc);
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(data);
+ }
+
+ push_stack(sc, OP_SORT_PAIR_END, cons(sc, data, lessp), sc->code); /* save and gc protect the original list and func */
+ car(args) = g_vector(sc, data);
+ break;
+
+ case T_STRING:
+ {
+ /* byte-vectors here also, so this isn't completely silly */
+ int i;
+ s7_pointer vec;
+ unsigned char *chrs;
+
+ len = string_length(data);
+ if (len < 2)
+ {
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(data);
+ }
+
+#if (!WITH_GMP)
+ if (is_c_function(lessp))
+ {
+ if (((!is_byte_vector(data)) && (compare_func == g_chars_are_less)) ||
+ ((is_byte_vector(data)) && (compare_func == g_less_2)))
+ {
+ qsort((void *)vector_elements(data), len, sizeof(unsigned char), byte_less);
+ return(data);
+ }
+ if (((!is_byte_vector(data)) && (compare_func == g_chars_are_greater)) ||
+ ((is_byte_vector(data)) && (compare_func == g_greater_2)))
+ {
+ qsort((void *)vector_elements(data), len, sizeof(unsigned char), byte_greater);
+ return(data);
+ }
+ }
+#endif
+
+ vec = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ gc_loc = s7_gc_protect(sc, vec);
+ elements = s7_vector_elements(vec);
+ chrs = (unsigned char *)string_value(data);
+
+ if (is_byte_vector(data))
+ {
+ for (i = 0; i < len; i++)
+ elements[i] = small_int(chrs[i]);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ elements[i] = chars[chrs[i]];
+ }
+
+ if (compare_func)
+ {
+ sc->v = vec;
+ qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
+
+ if (is_byte_vector(data))
+ {
+ for (i = 0; i < len; i++)
+ chrs[i] = (char)integer(elements[i]);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ chrs[i] = character(elements[i]);
+ }
+ s7_gc_unprotect_at(sc, gc_loc);
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(data);
+ }
+
+ push_stack(sc, OP_SORT_STRING_END, cons(sc, data, lessp), sc->code);
+ car(args) = vec;
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ break;
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ {
+ int i;
+ s7_pointer vec;
+
+ len = vector_length(data);
+ if (len < 2)
+ {
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(data);
+ }
+#if (!WITH_GMP)
+ if (is_c_function(lessp))
+ {
+ if (compare_func == g_less_2)
+ {
+ if (type(data) == T_FLOAT_VECTOR)
+ qsort((void *)vector_elements(data), len, sizeof(s7_double), dbl_less);
+ else qsort((void *)vector_elements(data), len, sizeof(s7_int), int_less);
+ return(data);
+ }
+ if (compare_func == g_greater_2)
+ {
+ if (type(data) == T_FLOAT_VECTOR)
+ qsort((void *)vector_elements(data), len, sizeof(s7_double), dbl_greater);
+ else qsort((void *)vector_elements(data), len, sizeof(s7_int), int_greater);
+ return(data);
+ }
+ }
+#endif
+
+ /* currently we have to make the ordinary vector here even if not compare_func
+ * because the sorter uses vector_element to access sort args (see SORT_DATA in eval).
+ * This is probably better than passing down getter/setter (fewer allocations).
+ * get/set macro in eval is SORT_DATA(k) then s7_vector_to_list if pair at start (sort_*_end)
+ */
+ vec = make_vector_1(sc, len, FILLED, T_VECTOR);
+ /* we need this vector prefilled because vector_getter below makes reals/int, causing possible GC
+ * at any time during that loop, and the GC mark process expects the vector to have an s7_pointer
+ * at every element.
+ */
+ gc_loc = s7_gc_protect(sc, vec);
+ elements = s7_vector_elements(vec);
+
+ for (i = 0; i < len; i++)
+ elements[i] = vector_getter(data)(sc, data, i);
+
+ if (compare_func)
+ {
+ sc->v = vec;
+ qsort((void *)elements, len, sizeof(s7_pointer), sort_func);
+
+ for (i = 0; i < len; i++)
+ vector_setter(data)(sc, data, i, elements[i]);
+
+ s7_gc_unprotect_at(sc, gc_loc);
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(data);
+ }
+
+ push_stack(sc, OP_SORT_VECTOR_END, cons(sc, data, lessp), sc->code); /* save and gc protect the original homogenous vector and func */
+ car(args) = vec;
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ break;
+
+ case T_VECTOR:
+ len = vector_length(data);
+ if (len < 2)
+ {
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(data);
+ }
+ if (compare_func)
+ {
+ /* here if, for example, compare_func == string<?, we could precheck for strings,
+ * then qsort without the type checks. Also common is (lambda (a b) (f (car a) (car b))).
+ */
+#if (!WITH_GMP)
+ if ((compare_func == g_less_2) || (compare_func == g_greater_2))
+ {
+ int i, typ;
+ s7_pointer *els;
+ els = s7_vector_elements(data);
+ typ = type(els[0]);
+ if ((typ == T_INTEGER) || (typ == T_REAL))
+ for (i = 1; i < len; i++)
+ if (type(els[i]) != typ)
+ {
+ typ = T_FREE;
+ break;
+ }
+ if (typ == T_INTEGER)
+ {
+ qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_less_2) ? int_less_2 : int_greater_2));
+ return(data);
+ }
+ if (typ == T_REAL)
+ {
+ qsort((void *)els, len, sizeof(s7_pointer), ((compare_func == g_less_2) ? dbl_less_2 : dbl_greater_2));
+ return(data);
+ }
+ }
+#endif
+ qsort((void *)s7_vector_elements(data), len, sizeof(s7_pointer), sort_func);
+ if (sort_func == pf_compare) s7_xf_free(sc);
+ return(data);
+ }
+ break;
+
+ default:
+ method_or_bust_with_type(sc, data, sc->SORT, args, A_SEQUENCE, 1);
+ }
+ if (sort_func == pf_compare) s7_xf_free(sc);
+
+ n = len - 1;
+ k = ((int)(n / 2)) + 1;
+
+ lx = s7_make_vector(sc, (sc->safety == 0) ? 4 : 6);
+ gc_loc = s7_gc_protect(sc, lx);
+ sc->v = lx;
+
+ vector_element(lx, 0) = make_mutable_integer(sc, n);
+ vector_element(lx, 1) = make_mutable_integer(sc, k);
+ vector_element(lx, 2) = make_mutable_integer(sc, 0);
+ vector_element(lx, 3) = make_mutable_integer(sc, 0);
+ if (sc->safety != 0)
+ {
+ vector_element(lx, 4) = make_mutable_integer(sc, 0);
+ vector_element(lx, 5) = make_integer(sc, n * n);
+ }
+ push_stack(sc, OP_SORT, args, lx);
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ return(sc->F);
+ /* if the comparison function waffles, sort! can hang: (sort! '(1 2 3) (lambda (a b) (= a b)))
+ * set 'safety to 1 to add a check for this loop, but the "safe" procedures are direct, so unchecked.
+ */
+}
+
+static s7_pointer c_sort_p(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(g_sort(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(sort, c_sort_p)
+
+
+/* these are for the eval sort -- sort a vector, then if necessary put that data into the original sequence */
+static s7_pointer vector_into_list(s7_pointer vect, s7_pointer lst)
+{
+ s7_pointer p;
+ s7_pointer *elements;
+ int i, len;
+
+ elements = s7_vector_elements(vect);
+ len = vector_length(vect);
+ for (i = 0, p = lst; i < len; i++, p = cdr(p))
+ car(p) = elements[i];
+ return(lst);
+}
+
+static s7_pointer vector_into_fi_vector(s7_pointer source, s7_pointer dest)
+{
+ s7_pointer *elements;
+ int i, len;
+
+ elements = s7_vector_elements(source);
+ len = vector_length(source);
+
+ if (is_float_vector(dest))
+ {
+ s7_double *flts;
+ flts = float_vector_elements(dest);
+ for (i = 0; i < len; i++)
+ flts[i] = real(elements[i]);
+ }
+ else
+ {
+ s7_int *ints;
+ ints = int_vector_elements(dest);
+ for (i = 0; i < len; i++)
+ ints[i] = integer(elements[i]);
+ }
+ return(dest);
+}
+
+static s7_pointer vector_into_string(s7_pointer vect, s7_pointer dest)
+{
+ s7_pointer *elements;
+ int i, len;
+ unsigned char *str;
+
+ elements = s7_vector_elements(vect);
+ len = vector_length(vect);
+ str = (unsigned char *)string_value(dest);
+
+ if (is_byte_vector(dest))
+ {
+ for (i = 0; i < len; i++)
+ str[i] = (unsigned char)integer(elements[i]);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ str[i] = character(elements[i]);
+ }
+ return(dest);
+}
+
+
+
+/* -------- hash tables -------- */
+
+static hash_entry_t *hash_free_list = NULL;
+
+static void free_hash_table(s7_pointer table)
+{
+ hash_entry_t **entries;
+ entries = hash_table_elements(table);
+
+ if (hash_table_entries(table) > 0)
+ {
+ unsigned int i, len;
+ len = hash_table_mask(table) + 1;
+ for (i = 0; i < len; i++)
+ {
+ hash_entry_t *p, *n;
+ for (p = entries[i++]; p; p = n)
+ {
+ n = p->next;
+ p->next = hash_free_list;
+ hash_free_list = p;
+ }
+ for (p = entries[i]; p; p = n)
+ {
+ n = p->next;
+ p->next = hash_free_list;
+ hash_free_list = p;
+ }
+ }
+ }
+ free(entries);
+}
+
+static hash_entry_t *make_hash_entry(s7_pointer key, s7_pointer value, unsigned int raw_hash)
+{
+ hash_entry_t *p;
+ if (hash_free_list)
+ {
+ p = hash_free_list;
+ hash_free_list = p->next;
+ }
+ else p = (hash_entry_t *)malloc(sizeof(hash_entry_t));
+ p->key = key;
+ p->value = value;
+ p->raw_hash = raw_hash;
+ return(p);
+}
+
+
+/* -------------------------------- hash-table? -------------------------------- */
+bool s7_is_hash_table(s7_pointer p)
+{
+ return(is_hash_table(p));
+}
+
+static s7_pointer g_is_hash_table(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_hash_table "(hash-table? obj) returns #t if obj is a hash-table"
+ #define Q_is_hash_table pl_bt
+ check_boolean_method(sc, is_hash_table, sc->IS_HASH_TABLE, args);
+}
+
+
+/* -------------------------------- hash-table-entries -------------------------------- */
+static s7_pointer g_hash_table_entries(s7_scheme *sc, s7_pointer args)
+{
+ #define H_hash_table_entries "(hash-table-entries obj) returns the number of entries in the hash-table obj"
+ #define Q_hash_table_entries s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_HASH_TABLE)
+
+ if (!is_hash_table(car(args)))
+ method_or_bust(sc, car(args), sc->HASH_TABLE_ENTRIES, args, T_HASH_TABLE, 0);
+ return(make_integer(sc, hash_table_entries(car(args))));
+}
+
+static s7_int c_hash_table_entries(s7_scheme *sc, s7_pointer p)
+{
+ if (!is_hash_table(p))
+ int_method_or_bust(sc, p, sc->HASH_TABLE_ENTRIES, set_plist_1(sc, p), T_HASH_TABLE, 0);
+ return(hash_table_entries(p));
+}
+
+PF_TO_IF(hash_table_entries, c_hash_table_entries)
+
+
+/* ---------------- mappers ---------------- */
+static unsigned int hash_float_location(s7_double x)
+{
+ int loc;
+#if defined(__clang__)
+ if ((is_inf(x)) || (is_NaN(x))) return(0);
+#endif
+ x = fabs(x);
+ if (x < 100.0)
+ loc = 1000.0 * x; /* this means hash_table_float_epsilon only works if it is less than about .001 */
+ else loc = x;
+
+ if (loc < 0)
+ return(0);
+ return(loc);
+}
+
+/* built in hash loc tables for eq? eqv? equal? morally-equal? = string=? string-ci=? char=? char-ci=? (default=equal?) */
+
+#define hash_loc(Sc, Table, Key) (*(hash_table_mapper(Table)[type(Key)]))(Sc, Table, Key)
+
+static hash_map_t *eq_hash_map, *eqv_hash_map, *string_eq_hash_map, *number_eq_hash_map, *char_eq_hash_map, *closure_hash_map;
+static hash_map_t *morally_equal_hash_map, *c_function_hash_map;
+#if (!WITH_PURE_S7)
+static hash_map_t *string_ci_eq_hash_map, *char_ci_eq_hash_map;
+#endif
+
+static unsigned int hash_map_nil(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(type(key));}
+static unsigned int hash_map_int(s7_scheme *sc, s7_pointer table, s7_pointer key) {return((unsigned int)(s7_int_abs(integer(key))));}
+static unsigned int hash_map_char(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(character(key));}
+static unsigned int hash_map_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key) {return((unsigned int)denominator(key));} /* overflow possible as elsewhere */
+static unsigned int hash_map_complex(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(hash_float_location(real_part(key)));}
+static unsigned int hash_map_symbol(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(symbol_hmap(key));}
+static unsigned int hash_map_syntax(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(symbol_hmap(syntax_symbol(key)));}
+
+#if WITH_GMP
+static unsigned int hash_map_big_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return((unsigned int)(big_integer_to_s7_int(big_integer(key))));
+}
+
+static unsigned int hash_map_big_ratio(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return((unsigned int)(big_integer_to_s7_int(mpq_denref(big_ratio(key)))));
+}
+
+static unsigned int hash_map_big_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return((unsigned int)mpfr_get_d(big_real(key), GMP_RNDN));
+}
+
+static unsigned int hash_map_big_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return((unsigned int)mpfr_get_d(mpc_realref(big_complex(key)), GMP_RNDN));
+}
+#endif
+
+static unsigned int hash_map_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (string_hash(key) == 0)
+ string_hash(key) = raw_string_hash((const unsigned char *)string_value(key), string_length(key));
+ return(string_hash(key));
+}
+
+#if (!WITH_PURE_S7)
+static unsigned int hash_map_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer key) {return(upper_character(key));}
+
+static unsigned int hash_map_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ int len;
+ len = string_length(key);
+ if (len == 0) return(0);
+ return(len + (uppers[(int)(string_value(key)[0])] << 4));
+}
+#endif
+
+static unsigned int hash_map_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return(hash_float_location(real(key)));
+ /* currently 1e300 goes to most-negative-fixnum! -> 0 after logand size, I hope
+ *
+ * we need round, not floor for the location calculation in the real/complex cases else
+ * 1-eps doesn't match 1.0, but 1+eps does. And what if round(val) is too big for int?
+ * lrint is complex and requires special compiler flags to get any speed (-fno-math-errno).
+ * all we need is (int)(val+0.5) -- all the other stuff is pointless in this context
+ */
+}
+
+static unsigned int hash_map_real_eq(s7_scheme *sc, s7_pointer table, s7_pointer x)
+{
+ if (real(x) < 0.0)
+ return((unsigned int)(s7_round(-real(x))));
+ return((unsigned int)s7_round(real(x)));
+}
+
+static unsigned int hash_map_ratio_eq(s7_scheme *sc, s7_pointer table, s7_pointer y)
+{
+ s7_double x;
+ x = fraction(y);
+ if (x < 0.0)
+ return((unsigned int)s7_round(-x));
+ return((unsigned int)s7_round(x));
+}
+
+static unsigned int hash_map_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ /* hash-tables are equal if key/values match independent of table size and entry order.
+ * if not using morally-equal?, hash_table_checker|mapper must also be the same.
+ * Keys are supposed to be constant while keys, so a hash-table shouldn't be a key of itself.
+ */
+ return(hash_table_entries(key));
+}
+
+static unsigned int hash_map_int_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (vector_length(key) == 0)
+ return(0);
+ if (vector_length(key) == 1)
+ return((unsigned int)(s7_int_abs(int_vector_element(key, 0))));
+ return((unsigned int)(vector_length(key) + s7_int_abs(int_vector_element(key, 0)) + s7_int_abs(int_vector_element(key, 1))));
+}
+
+static unsigned int hash_map_float_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (vector_length(key) == 0)
+ return(0);
+ if (vector_length(key) == 1)
+ return(hash_float_location(float_vector_element(key, 0)));
+ return((unsigned int)(vector_length(key) + hash_float_location(float_vector_element(key, 0)) + hash_float_location(float_vector_element(key, 1))));
+}
+
+static unsigned int hash_map_vector(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if ((vector_length(key) == 0) ||
+ (is_sequence(vector_element(key, 0))))
+ return(vector_length(key));
+ if ((vector_length(key) == 1) ||
+ (is_sequence(vector_element(key, 1))))
+ return(hash_loc(sc, table, vector_element(key, 0)));
+ return(vector_length(key) + hash_loc(sc, table, vector_element(key, 0)) + hash_loc(sc, table, vector_element(key, 1)));
+}
+
+static unsigned int hash_map_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ int x;
+ x = heap_location(key);
+ if (x < 0) return(-x);
+ return(x);
+}
+
+static unsigned int hash_map_closure(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ s7_pointer f, old_e, args, body;
+
+ f = hash_table_procedures_mapper(table);
+ old_e = sc->envir;
+ args = closure_args(f);
+ body = closure_body(f);
+ new_frame_with_slot(sc, closure_let(f), sc->envir, (is_symbol(car(args))) ? car(args) : caar(args), key);
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ if (is_pair(cdr(body)))
+ push_stack_no_args(sc, OP_BEGIN1, cdr(body));
+ sc->code = car(body);
+ eval(sc, OP_EVAL);
+ sc->envir = old_e;
+ return(integer(sc->value));
+}
+
+static unsigned int hash_map_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ s7_function f;
+ f = c_function_call(hash_table_procedures_mapper(table));
+ car(sc->T1_1) = key;
+ return(integer(f(sc, sc->T1_1)));
+}
+
+static unsigned int hash_map_let(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ /* lets are equal if same symbol/value pairs, independent of order, taking into account shadowing
+ * (length (inlet 'a 1 'a 2)) = 2
+ * but this counts as just one entry from equal?'s point of view, so if more than one entry, we have a problem.
+ * (equal? (inlet 'a 1) (inlet 'a 3 'a 2 'a 1)) = #t
+ * also currently equal? follows outlet, but that is ridiculous here, so in this case hash equal?
+ * is not the same as equal? Surely anyone using lets as keys wants eq?
+ */
+ s7_pointer slot;
+ int slots;
+
+ if ((key == sc->rootlet) ||
+ (!is_slot(let_slots(key))))
+ return(0);
+ slot = let_slots(key);
+ if (!is_slot(next_slot(slot)))
+ {
+ if (is_sequence(slot_value(slot))) /* avoid loop if cycles */
+ return(symbol_hmap(slot_symbol(slot)));
+ return(symbol_hmap(slot_symbol(slot)) + hash_loc(sc, table, slot_value(slot)));
+ }
+ slots = 0;
+ for (; is_slot(slot); slot = next_slot(slot))
+ if (!is_matched_symbol(slot_symbol(slot)))
+ {
+ set_match_symbol(slot_symbol(slot));
+ slots++;
+ }
+ for (slot = let_slots(key); is_slot(slot); slot = next_slot(slot))
+ clear_match_symbol(slot_symbol(slot));
+
+ if (slots == 1)
+ {
+ slot = let_slots(key);
+ if (is_sequence(slot_value(slot))) /* avoid loop if cycles */
+ return(symbol_hmap(slot_symbol(slot)));
+ return(symbol_hmap(slot_symbol(slot)) + hash_loc(sc, table, slot_value(slot)));
+ }
+
+ return(slots);
+}
+
+static unsigned int hash_map_pair(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ /* len+loc(car) is not horrible, but it means (for example) every list '(set! ...) is hashed to the same location,
+ * so at least we need to take cadr into account if possible. Better would combine the list_length(max 5 == safe_strlen5?) call
+ * with stats like symbols/pairs/constants at top level, then use those to spread it out over all the locs.
+ */
+ s7_pointer p1;
+ unsigned int loc = 0;
+
+ if (!is_sequence(car(key)))
+ loc = hash_loc(sc, table, car(key)) + 1;
+ p1 = cdr(key);
+ if ((is_pair(p1)) && (!is_sequence(car(p1))))
+ loc += hash_loc(sc, table, car(p1)) + 1;
+ return(loc);
+}
+
+
+/* ---------------- checkers ---------------- */
+static hash_entry_t *hash_empty(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_int(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (is_integer(key))
+ {
+ s7_int keyval;
+ hash_entry_t *x;
+ unsigned int loc, hash_len;
+
+ hash_len = hash_table_mask(table);
+ keyval = integer(key);
+ if (keyval < 0)
+ loc = (unsigned int)((-keyval) & hash_len);
+ else loc = (unsigned int)(keyval & hash_len);
+ /* I think this assumes hash_map_int is using s7_int_abs (and high order bits are ignored) */
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (integer(x->key) == keyval)
+ return(x);
+ }
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (is_string(key))
+ {
+ hash_entry_t *x;
+ unsigned int hash_len, key_len;
+ unsigned long long int hash;
+ const char *key_str;
+
+ key_len = string_length(key);
+ key_str = string_value(key);
+
+ hash_len = hash_table_mask(table);
+ if (string_hash(key) == 0)
+ string_hash(key) = raw_string_hash((const unsigned char *)string_value(key), string_length(key));
+ hash = string_hash(key);
+
+ if (key_len <= 8)
+ {
+ for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
+ if ((hash == string_hash(x->key)) &&
+ (key_len == string_length(x->key)))
+ return(x);
+ }
+ else
+ {
+ for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
+ if ((hash == string_hash(x->key)) &&
+ (key_len == string_length(x->key)) && /* these are scheme strings, so we can't assume 0=end of string */
+ (strings_are_equal_with_length(key_str, string_value(x->key), key_len)))
+ return(x);
+ }
+ }
+ return(NULL);
+}
+
+#if (!WITH_PURE_S7)
+static hash_entry_t *hash_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (is_string(key))
+ {
+ hash_entry_t *x;
+ unsigned int hash, hash_len;
+
+ hash_len = hash_table_mask(table);
+ hash = hash_map_ci_string(sc, table, key);
+
+ for (x = hash_table_element(table, hash & hash_len); x; x = x->next)
+ if (scheme_strequal_ci(key, x->key))
+ return(x);
+ }
+ return(NULL);
+}
+
+static hash_entry_t *hash_ci_char(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (s7_is_character(key))
+ {
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (upper_character(key) == upper_character(x->key))
+ return(x);
+ }
+ return(NULL);
+}
+#endif
+
+static hash_entry_t *hash_float_1(s7_scheme *sc, s7_pointer table, unsigned int loc, s7_double keyval)
+{
+ hash_entry_t *x;
+ bool look_for_nan;
+ look_for_nan = is_NaN(keyval);
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ {
+ if (is_t_real(x->key)) /* we're possibly called from hash_equal, so keys might not be T_REAL */
+ {
+ s7_double val;
+ val = real(x->key);
+ if (look_for_nan)
+ {
+ if (is_NaN(val))
+ return(x);
+ }
+ else
+ {
+ if ((val == keyval) || /* inf case */
+ (fabs(val - keyval) < sc->hash_table_float_epsilon))
+ return(x);
+ }
+ }
+ }
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_float(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ /* give the equality check some room. also inf == inf and nan == nan
+ */
+ if (type(key) == T_REAL)
+ {
+ s7_double keyval;
+ unsigned int hash_len, loc;
+
+ hash_len = hash_table_mask(table);
+ keyval = real(key);
+ loc = hash_float_location(keyval) & hash_len;
+
+ return(hash_float_1(sc, table, loc, keyval));
+ }
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_complex_1(s7_scheme *sc, s7_pointer table, unsigned int loc, s7_pointer key)
+{
+ hash_entry_t *x;
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if ((is_t_complex(x->key)) &&
+ (s7_is_morally_equal(sc, x->key, key)))
+ return(x);
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_equal_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return(hash_float_1(sc, table, hash_loc(sc, table, key) & hash_table_mask(table), real(key)));
+}
+
+
+static hash_entry_t *hash_equal_complex(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return(hash_complex_1(sc, table, hash_loc(sc, table, key) & hash_table_mask(table), key));
+}
+
+
+static hash_entry_t *hash_equal_syntax(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int loc;
+ loc = hash_loc(sc, table, key) & hash_table_mask(table);
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if ((is_syntax(x->key)) &&
+ (syntax_symbol(x->key) == syntax_symbol(key))) /* the opcodes might differ, but the symbols should not */
+ return(x);
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_equal_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int loc;
+ loc = hash_loc(sc, table, key) & hash_table_mask(table);
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (x->key == key)
+ return(x);
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_equal_any(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int loc;
+ loc = hash_loc(sc, table, key) & hash_table_mask(table);
+
+ /* we can get into an infinite loop here, but it requires 2 hash tables that are members of each other
+ * and key is one of them, so I changed the equality check above to use eq? -- not sure this is right.
+ */
+ /* hope for an easy case... */
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (x->key == key)
+ return(x);
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (s7_is_equal(sc, x->key, key))
+ return(x);
+ return(NULL);
+}
+
+
+static hash_entry_t *(*default_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
+static hash_entry_t *(*equal_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
+static hash_entry_t *(*morally_equal_hash_checks[NUM_TYPES])(s7_scheme *sc, s7_pointer table, s7_pointer key);
+
+static hash_entry_t *hash_equal(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ return((*(equal_hash_checks[type(key)]))(sc, table, key));
+}
+
+static hash_entry_t *hash_morally_equal(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int loc;
+ loc = hash_loc(sc, table, key) & hash_table_mask(table);
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (x->key == key)
+ return(x);
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (s7_is_morally_equal(sc, x->key, key))
+ return(x);
+ return(NULL);
+}
+
+static hash_entry_t *hash_c_function(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+ s7_function f;
+
+ f = c_function_call(hash_table_procedures_checker(table));
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
+
+ car(sc->T2_1) = key;
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ {
+ car(sc->T2_2) = x->key;
+ if (is_true(sc, f(sc, sc->T2_1)))
+ return(x);
+ }
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_eq(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ /* explicit eq? as hash equality func or (for example) symbols as keys */
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (key == x->key)
+ return(x);
+
+ return(NULL);
+}
+
+static hash_entry_t *hash_eqv(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if (s7_is_eqv(key, x->key))
+ return(x);
+
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_number(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (is_number(key))
+ {
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
+
+#if (!WITH_GMP)
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if ((is_number(x->key)) &&
+ (is_true(sc, c_equal_2_1(sc, key, x->key))))
+ return(x);
+#else
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ if ((is_number(x->key)) &&
+ (is_true(sc, big_equal(sc, set_plist_2(sc, key, x->key)))))
+ return(x);
+#endif
+ }
+ return(NULL);
+}
+
+static hash_entry_t *hash_symbol(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (is_symbol(key))
+ {
+ hash_entry_t *x;
+ for (x = hash_table_element(table, symbol_hmap(key) & hash_table_mask(table)); x; x = x->next)
+ if (key == x->key)
+ return(x);
+ }
+ return(NULL);
+}
+
+
+static hash_entry_t *hash_char(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ if (s7_is_character(key))
+ return(hash_eq(sc, table, key));
+ return(NULL);
+}
+
+static hash_entry_t *hash_closure(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+ s7_pointer f, args, body, old_e;
+
+ f = hash_table_procedures_checker(table);
+ hash_len = hash_table_mask(table);
+ loc = hash_loc(sc, table, key) & hash_len;
+
+ old_e = sc->envir;
+ args = closure_args(f); /* in lambda* case, car/cadr(args) can be lists */
+ body = closure_body(f);
+ new_frame_with_two_slots(sc, closure_let(f), sc->envir,
+ (is_symbol(car(args))) ? car(args) : caar(args), key,
+ (is_symbol(cadr(args))) ? cadr(args) : caadr(args), sc->F);
+
+ for (x = hash_table_element(table, loc); x; x = x->next)
+ {
+ slot_set_value(next_slot(let_slots(sc->envir)), x->key);
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ if (is_pair(cdr(body)))
+ push_stack_no_args(sc, OP_BEGIN1, cdr(body));
+ sc->code = car(body);
+ eval(sc, OP_EVAL);
+ if (is_true(sc, sc->value))
+ {
+ sc->envir = old_e;
+ return(x);
+ }
+ }
+ sc->envir = old_e;
+ return(NULL);
+}
+
+
+static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, s7_pointer key, hash_entry_t *p)
+{
+ hash_entry_t *x;
+ unsigned int hash_len, loc;
+
+ hash_len = hash_table_mask(table);
+#if DEBUGGING
+ if (p->raw_hash != hash_loc(sc, table, key))
+ fprintf(stderr, "%s[%d]: %s raw: %u, loc: %u\n", __func__, __LINE__, DISPLAY(key), p->raw_hash, hash_loc(sc, table, key));
+#endif
+ loc = p->raw_hash & hash_len;
+
+
+ x = hash_table_element(table, loc);
+ if (x == p)
+ hash_table_element(table, loc) = x->next;
+ else
+ {
+ hash_entry_t *y;
+ for (y = x, x = x->next; x; y = x, x = x->next)
+ if (x == p)
+ {
+ y->next = x->next;
+ break;
+ }
+#if DEBUGGING
+ if (!x) fprintf(stderr, "lost %s!\n", DISPLAY(key));
+#endif
+ }
+ hash_table_entries(table)--;
+ if ((hash_table_entries(table) == 0) &&
+ (!hash_table_checker_locked(table)))
+ hash_table_checker(table) = hash_empty;
+ x->next = hash_free_list;
+ hash_free_list = x;
+ return(sc->F);
+}
+
+/* -------------------------------- make-hash-table -------------------------------- */
+
+s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size)
+{
+ s7_pointer table;
+ hash_entry_t **els;
+ /* size is rounded up to the next power of 2 */
+
+ if ((size & (size + 1)) != 0) /* already 2^n - 1 ? */
+ {
+ size--;
+ size |= (size >> 1);
+ size |= (size >> 2);
+ size |= (size >> 4);
+ size |= (size >> 8);
+ size |= (size >> 16);
+ if (s7_int_bits > 31) /* this is either 31 or 63 */
+ size |= (size >> 32);
+ }
+ size++;
+
+ els = (hash_entry_t **)calloc(size, sizeof(hash_entry_t *));
+ if (!els) return(s7_error(sc, make_symbol(sc, "out-of-memory"), set_elist_1(sc, make_string_wrapper(sc, "make-hash-table allocation failed!"))));
+
+ new_cell(sc, table, T_HASH_TABLE | T_SAFE_PROCEDURE);
+ hash_table_mask(table) = size - 1;
+ hash_table_elements(table) = els;
+ hash_table_checker(table) = hash_empty;
+ hash_table_mapper(table) = default_hash_map;
+ hash_table_entries(table) = 0;
+ hash_table_procedures(table) = sc->F;
+ add_hash_table(sc, table);
+
+ return(table);
+}
+
+static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_is_morally_equal(s7_scheme *sc, s7_pointer args);
+
+static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args)
+{
+ #define H_make_hash_table "(make-hash-table (size 511) eq-func) returns a new hash table"
+ #define Q_make_hash_table s7_make_signature(sc, 3, sc->IS_HASH_TABLE, sc->IS_INTEGER, sc->IS_PAIR)
+
+ s7_int size;
+ size = sc->default_hash_table_length;
+
+ if (is_not_null(args))
+ {
+ s7_pointer p;
+ p = car(args);
+ if (!s7_is_integer(p))
+ {
+ s7_pointer p1;
+ if (!s7_is_integer(p1 = check_values(sc, p, args)))
+ method_or_bust(sc, p, sc->MAKE_HASH_TABLE, args, T_INTEGER, 1);
+ p = p1;
+ }
+ size = s7_integer(p);
+ if (size <= 0) /* we need s7_int here to catch (make-hash-table most-negative-fixnum) etc */
+ return(simple_out_of_range(sc, sc->MAKE_HASH_TABLE, p, make_string_wrapper(sc, "should be a positive integer")));
+ if (size > sc->max_vector_length)
+ return(simple_out_of_range(sc, sc->MAKE_HASH_TABLE, p, ITS_TOO_LARGE));
+
+ if (is_not_null(cdr(args)))
+ {
+ s7_pointer ht, proc;
+ proc = cadr(args);
+
+ if (is_c_function(proc))
+ {
+ if (!s7_is_aritable(sc, proc, 2))
+ return(wrong_type_argument_with_type(sc, sc->MAKE_HASH_TABLE, 3, proc, AN_EQ_FUNC));
+
+ ht = s7_make_hash_table(sc, size);
+ if (c_function_call(proc) == g_is_equal)
+ return(ht);
+ if (c_function_call(proc) == g_is_eq)
+ {
+ hash_table_checker(ht) = hash_eq;
+ hash_table_mapper(ht) = eq_hash_map;
+ }
+ else
+ {
+ if (c_function_call(proc) == g_strings_are_equal)
+ {
+ hash_table_checker(ht) = hash_string;
+ hash_table_mapper(ht) = string_eq_hash_map;
+ }
+ else
+ {
+#if (!WITH_PURE_S7)
+ if (c_function_call(proc) == g_strings_are_ci_equal)
+ {
+ hash_table_checker(ht) = hash_ci_string;
+ hash_table_mapper(ht) = string_ci_eq_hash_map;
+ }
+ else
+ {
+ if (c_function_call(proc) == g_chars_are_ci_equal)
+ {
+ hash_table_checker(ht) = hash_ci_char;
+ hash_table_mapper(ht) = char_ci_eq_hash_map;
+ }
+ else
+ {
+#endif
+ if (c_function_call(proc) == g_chars_are_equal)
+ {
+ hash_table_checker(ht) = hash_char;
+ hash_table_mapper(ht) = char_eq_hash_map;
+ }
+ else
+ {
+#if (!WITH_GMP)
+ if (c_function_call(proc) == g_equal)
+#else
+ if ((c_function_call(proc) == g_equal) ||
+ (c_function_call(proc) == big_equal))
+#endif
+ {
+ hash_table_checker(ht) = hash_number;
+ hash_table_mapper(ht) = number_eq_hash_map;
+ }
+ else
+ {
+ if (c_function_call(proc) == g_is_eqv)
+ {
+ hash_table_checker(ht) = hash_eqv;
+ hash_table_mapper(ht) = eqv_hash_map;
+ }
+ else
+ {
+ if (c_function_call(proc) == g_is_morally_equal)
+ {
+ hash_table_checker(ht) = hash_morally_equal;
+ hash_table_mapper(ht) = morally_equal_hash_map;
+ }
+ else return(wrong_type_argument_with_type(sc, sc->MAKE_HASH_TABLE, 3, proc,
+ make_string_wrapper(sc, "a hash function")));
+ }}}}}
+#if (!WITH_PURE_S7)
+ }}
+#endif
+ return(ht);
+ }
+ /* proc not c_function */
+ else
+ {
+ if (is_pair(proc))
+ {
+ s7_pointer checker, mapper;
+ checker = car(proc);
+ mapper = cdr(proc);
+
+ if (((is_any_c_function(checker)) || (is_any_closure(checker))) &&
+ ((is_any_c_function(mapper)) || (is_any_closure(mapper))) &&
+ (s7_is_aritable(sc, checker, 2)) &&
+ (s7_is_aritable(sc, mapper, 1)))
+ {
+ s7_pointer sig;
+ ht = s7_make_hash_table(sc, size);
+ if (is_any_c_function(checker))
+ {
+ sig = c_function_signature(checker);
+ if ((sig) &&
+ (is_pair(sig)) &&
+ (car(sig) != sc->IS_BOOLEAN))
+ return(wrong_type_argument_with_type(sc, sc->MAKE_HASH_TABLE, 3, proc,
+ make_string_wrapper(sc, "equality function should return a boolean")));
+ hash_table_checker(ht) = hash_c_function;
+ }
+ else hash_table_checker(ht) = hash_closure;
+ if (is_any_c_function(mapper))
+ {
+ sig = c_function_signature(mapper);
+ if ((sig) &&
+ (is_pair(sig)) &&
+ (car(sig) != sc->IS_INTEGER))
+ return(wrong_type_argument_with_type(sc, sc->MAKE_HASH_TABLE, 3, proc,
+ make_string_wrapper(sc, "mapping function should return an integer")));
+ hash_table_mapper(ht) = c_function_hash_map;
+ }
+ else hash_table_mapper(ht) = closure_hash_map;
+ hash_table_procedures(ht) = proc;
+ return(ht);
+ }
+ }
+ return(wrong_type_argument_with_type(sc, sc->MAKE_HASH_TABLE, 3, proc,
+ make_string_wrapper(sc, "a cons of two functions")));
+ }
+ }
+ }
+ return(s7_make_hash_table(sc, size));
+}
+
+
+void init_hash_maps(void)
+{
+ int i;
+
+ default_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ eqv_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ string_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ number_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ char_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+#if (!WITH_PURE_S7)
+ string_ci_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ char_ci_eq_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+#endif
+ closure_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ c_function_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+ morally_equal_hash_map = (hash_map_t *)malloc(NUM_TYPES * sizeof(hash_map_t));
+
+ for (i = 0; i < NUM_TYPES; i++)
+ {
+ default_hash_map[i] = hash_map_nil;
+ string_eq_hash_map[i] = hash_map_nil;
+ char_eq_hash_map[i] = hash_map_nil;
+#if (!WITH_PURE_S7)
+ string_ci_eq_hash_map[i] = hash_map_nil;
+ char_ci_eq_hash_map[i] = hash_map_nil;
+#endif
+ number_eq_hash_map[i] = hash_map_nil;
+ closure_hash_map[i] = hash_map_closure;
+ c_function_hash_map[i] = hash_map_c_function;
+ eq_hash_map[i] = hash_map_eq;
+ eqv_hash_map[i] = hash_map_eq;
+
+ equal_hash_checks[i] = hash_equal_any;
+ morally_equal_hash_checks[i] = hash_equal_any;
+ default_hash_checks[i] = hash_equal;
+ }
+ default_hash_map[T_INTEGER] = hash_map_int;
+ default_hash_map[T_RATIO] = hash_map_ratio;
+ default_hash_map[T_REAL] = hash_map_real;
+ default_hash_map[T_COMPLEX] = hash_map_complex;
+ default_hash_map[T_CHARACTER] = hash_map_char;
+ default_hash_map[T_SYMBOL] = hash_map_symbol;
+ default_hash_map[T_SYNTAX] = hash_map_syntax;
+ default_hash_map[T_STRING] = hash_map_string;
+ default_hash_map[T_HASH_TABLE] = hash_map_hash_table;
+ default_hash_map[T_VECTOR] = hash_map_vector;
+ default_hash_map[T_INT_VECTOR] = hash_map_int_vector;
+ default_hash_map[T_FLOAT_VECTOR] = hash_map_float_vector;
+ default_hash_map[T_LET] = hash_map_let;
+ default_hash_map[T_PAIR] = hash_map_pair;
+#if WITH_GMP
+ default_hash_map[T_BIG_INTEGER] = hash_map_big_int;
+ default_hash_map[T_BIG_RATIO] = hash_map_big_ratio;
+ default_hash_map[T_BIG_REAL] = hash_map_big_real;
+ default_hash_map[T_BIG_COMPLEX] = hash_map_big_complex;
+#endif
+
+ for (i = 0; i < NUM_TYPES; i++) morally_equal_hash_map[i] = default_hash_map[i];
+
+ string_eq_hash_map[T_STRING] = hash_map_string;
+ char_eq_hash_map[T_CHARACTER] = hash_map_char;
+#if (!WITH_PURE_S7)
+ string_ci_eq_hash_map[T_STRING] = hash_map_ci_string;
+ char_ci_eq_hash_map[T_CHARACTER] = hash_map_ci_char;
+#endif
+
+ number_eq_hash_map[T_INTEGER] = hash_map_int;
+ number_eq_hash_map[T_RATIO] = hash_map_ratio_eq;
+ number_eq_hash_map[T_REAL] = hash_map_real_eq;
+ number_eq_hash_map[T_COMPLEX] = hash_map_complex;
+#if (WITH_GMP)
+ number_eq_hash_map[T_BIG_INTEGER] = hash_map_big_int;
+ number_eq_hash_map[T_BIG_RATIO] = hash_map_big_ratio;
+ number_eq_hash_map[T_BIG_REAL] = hash_map_big_real;
+ number_eq_hash_map[T_BIG_COMPLEX] = hash_map_big_complex;
+#endif
+
+ eqv_hash_map[T_INTEGER] = hash_map_int;
+ eqv_hash_map[T_RATIO] = hash_map_ratio_eq;
+ eqv_hash_map[T_REAL] = hash_map_real_eq;
+ eqv_hash_map[T_COMPLEX] = hash_map_complex;
+
+ morally_equal_hash_map[T_INTEGER] = hash_map_int;
+ morally_equal_hash_map[T_RATIO] = hash_map_ratio_eq;
+ morally_equal_hash_map[T_REAL] = hash_map_real_eq;
+ morally_equal_hash_map[T_COMPLEX] = hash_map_complex;
+
+ equal_hash_checks[T_REAL] = hash_equal_real;
+ equal_hash_checks[T_COMPLEX] = hash_equal_complex;
+ equal_hash_checks[T_SYNTAX] = hash_equal_syntax;
+ equal_hash_checks[T_SYMBOL] = hash_equal_eq;
+ equal_hash_checks[T_CHARACTER] = hash_equal_eq;
+
+ default_hash_checks[T_STRING] = hash_string;
+ default_hash_checks[T_INTEGER] = hash_int;
+ default_hash_checks[T_REAL] = hash_float;
+ default_hash_checks[T_SYMBOL] = hash_symbol;
+ default_hash_checks[T_CHARACTER] = hash_char;
+}
+
+
+static unsigned int resize_hash_table(s7_scheme *sc, s7_pointer table)
+{
+ /* resize the table */
+ unsigned int hash_len, loc;
+ int i, old_size, new_size;
+ hash_entry_t **new_els, **old_els;
+
+ old_size = hash_table_mask(table) + 1;
+ new_size = old_size * 4;
+ hash_len = new_size - 1;
+ new_els = (hash_entry_t **)calloc(new_size, sizeof(hash_entry_t *));
+ old_els = hash_table_elements(table);
+
+ for (i = 0; i < old_size; i++)
+ {
+ hash_entry_t *x, *n;
+ for (x = old_els[i]; x; x = n)
+ {
+ n = x->next;
+ loc = x->raw_hash & hash_len;
+ x->next = new_els[loc];
+ new_els[loc] = x;
+ }
+ }
+ hash_table_elements(table) = new_els;
+ free(old_els);
+ hash_table_mask(table) = new_size - 1;
+ return(hash_len);
+}
+
+
+/* -------------------------------- hash-table-ref -------------------------------- */
+
+s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key)
+{
+ hash_entry_t *x;
+ x = (*hash_table_checker(table))(sc, table, key);
+ if (x) return(x->value);
+ return(sc->F);
+}
+
+
+static s7_pointer g_hash_table_ref(s7_scheme *sc, s7_pointer args)
+{
+ #define H_hash_table_ref "(hash-table-ref table key) returns the value associated with key in the hash table"
+ #define Q_hash_table_ref s7_make_signature(sc, 3, sc->T, sc->IS_HASH_TABLE, sc->T)
+
+ s7_pointer table;
+ table = car(args);
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->HASH_TABLE_REF, args, T_HASH_TABLE, 1);
+ /*
+ (define (href H . args)
+ (if (null? (cdr args))
+ (hash-table-ref H (car args))
+ (apply href (hash-table-ref H (car args)) (cdr args))))
+ */
+ if (is_null(cddr(args)))
+ return(s7_hash_table_ref(sc, table, cadr(args)));
+ return(implicit_index(sc, s7_hash_table_ref(sc, table, cadr(args)), cddr(args)));
+}
+
+
+static s7_pointer hash_table_ref_2;
+static s7_pointer g_hash_table_ref_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer table;
+ hash_entry_t *x;
+
+ table = car(args);
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->HASH_TABLE_REF, args, T_HASH_TABLE, 1);
+
+ x = (*hash_table_checker(table))(sc, table, cadr(args));
+ if (x) return(x->value);
+ return(sc->F);
+}
+
+static s7_pointer hash_table_ref_ss;
+static s7_pointer g_hash_table_ref_ss(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer table;
+ hash_entry_t *x;
+
+ table = find_symbol_checked(sc, car(args));
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->HASH_TABLE_REF, list_2(sc, table, find_symbol_checked(sc, cadr(args))), T_HASH_TABLE, 1);
+
+ x = (*hash_table_checker(table))(sc, table, find_symbol_checked(sc, cadr(args)));
+ if (x) return(x->value);
+ return(sc->F);
+}
+
+static s7_pointer hash_table_ref_car;
+static s7_pointer g_hash_table_ref_car(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer y, table;
+ hash_entry_t *x;
+
+ table = find_symbol_checked(sc, car(args));
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->HASH_TABLE_REF, list_2(sc, table, car(find_symbol_checked(sc, cadadr(args)))), T_HASH_TABLE, 1);
+
+ y = find_symbol_checked(sc, cadadr(args));
+ if (!is_pair(y))
+ return(simple_wrong_type_argument(sc, sc->CAR, y, T_PAIR));
+
+ x = (*hash_table_checker(table))(sc, table, car(y));
+ if (x) return(x->value);
+ return(sc->F);
+}
+
+static s7_pointer hash_table_ref_pf_a(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t f;
+ s7_pointer x, y;
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ f = (s7_pf_t)(**p); (*p)++;
+ y = f(sc, p);
+ return(s7_hash_table_ref(sc, x, y));
+}
+
+static s7_pointer hash_table_ref_pf_i(s7_scheme *sc, s7_pointer **p) /* i=implicit I think */
+{
+ s7_pf_t f;
+ s7_pointer x, y;
+ x = slot_value(**p); (*p)++;
+ f = (s7_pf_t)(**p); (*p)++;
+ y = f(sc, p);
+ return(s7_hash_table_ref(sc, x, y));
+}
+
+static s7_pointer hash_table_ref_pf_s(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t f;
+ s7_pointer x, y;
+ hash_entry_t *h;
+ x = (**p); (*p)++;
+ f = (s7_pf_t)(**p); (*p)++;
+ y = f(sc, p);
+ h = (*hash_table_checker(x))(sc, x, y);
+ if (h) return(h->value);
+ return(sc->F);
+}
+
+static s7_pointer hash_table_ref_pf_ps(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer x, y;
+ x = (**p); (*p) += 2;
+ y = slot_value(**p); (*p)++;
+ return(s7_hash_table_ref(sc, x, y));
+}
+
+static s7_pointer hash_table_ref_pf_r(s7_scheme *sc, s7_pointer **p)
+{
+ s7_rf_t f;
+ s7_pointer x;
+ s7_double y;
+ int hash_len;
+ hash_entry_t *h;
+ x = (**p); (*p)++;
+ f = (s7_rf_t)(**p); (*p)++;
+ y = f(sc, p);
+ hash_len = hash_table_mask(x);
+ h = hash_float_1(sc, x, hash_float_location(y) & hash_len, y);
+ if (h) return(h->value);
+ return(sc->F);
+}
+
+static s7_pf_t hash_table_ref_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_null(cdddr(expr))))
+ {
+ s7_pointer a1;
+ a1 = cadr(expr);
+ if (is_symbol(a1))
+ {
+ s7_pointer table;
+ table = s7_slot(sc, a1);
+ if ((is_slot(table)) && (!is_stepper(table)) && (is_hash_table(slot_value(table))))
+ {
+ ptr_int loc;
+ s7_pointer a2;
+ a2 = caddr(expr);
+ s7_xf_store(sc, slot_value(table));
+ loc = rc_loc(sc);
+ if (s7_arg_to_pf(sc, a2))
+ return((is_symbol(a2)) ? hash_table_ref_pf_ps : hash_table_ref_pf_s);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_gf(sc, a2))
+ return((is_symbol(a2)) ? hash_table_ref_pf_ps : hash_table_ref_pf_s);
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (s7_arg_to_rf(sc, a2))
+ return(hash_table_ref_pf_r);
+ return(NULL);
+ }
+ }
+ if ((s7_arg_to_pf(sc, cadr(expr))) &&
+ (s7_arg_to_pf(sc, caddr(expr))))
+ return(hash_table_ref_pf_a);
+ }
+ return(NULL);
+}
+
+
+/* -------------------------------- hash-table-set! -------------------------------- */
+
+static void hash_table_set_function(s7_pointer table, int typ)
+{
+ if ((hash_table_checker(table) != hash_equal) &&
+ (hash_table_checker(table) != default_hash_checks[typ]))
+ {
+ if (hash_table_checker(table) == hash_empty)
+ hash_table_checker(table) = default_hash_checks[typ];
+ else hash_table_checker(table) = hash_equal;
+ }
+}
+
+
+s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value)
+{
+ hash_entry_t *x;
+ x = (*hash_table_checker(table))(sc, table, key);
+
+ if (x)
+ {
+ if (value == sc->F)
+ return(remove_from_hash_table(sc, table, key, x));
+ x->value = value;
+ }
+ else
+ {
+ unsigned int hash_len, raw_hash, loc;
+ hash_entry_t *p;
+ if (value == sc->F) return(sc->F);
+
+ if (!hash_table_checker_locked(table))
+ hash_table_set_function(table, type(key));
+
+ hash_len = hash_table_mask(table);
+ if (hash_table_entries(table) > hash_len)
+ hash_len = resize_hash_table(sc, table);
+ raw_hash = hash_loc(sc, table, key);
+
+ if (!hash_free_list)
+ {
+ int i;
+ hash_free_list = (hash_entry_t *)malloc(16 * sizeof(hash_entry_t));
+ for (p = hash_free_list, i = 0; i < 15; i++) {p->next = p + 1; p++;}
+ p->next = NULL;
+ }
+
+ p = hash_free_list;
+ hash_free_list = p->next;
+ p->key = key;
+ p->value = value;
+ p->raw_hash = raw_hash;
+
+ loc = raw_hash & hash_len;
+ p->next = hash_table_element(table, loc);
+ hash_table_element(table, loc) = p;
+ hash_table_entries(table)++;
+ }
+ return(value);
+}
+
+static s7_pointer hash_table_set_pf_sxs(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer key, table, value;
+ s7_pf_t pf;
+ table = slot_value(**p); (*p)++;
+ pf = (s7_pf_t)(**p); (*p)++;
+ key = pf(sc, p);
+ value = slot_value(**p); (*p)++;
+ return(s7_hash_table_set(sc, table, key, value));
+}
+
+static s7_pointer hash_table_set_pf_sxx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer key, table, value;
+ s7_pf_t pf;
+ table = slot_value(**p); (*p)++;
+ pf = (s7_pf_t)(**p); (*p)++;
+ key = pf(sc, p);
+ pf = (s7_pf_t)(**p); (*p)++;
+ value = pf(sc, p);
+ return(s7_hash_table_set(sc, table, key, value));
+}
+
+static s7_pointer hash_table_set_pf_sss(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pointer key, table, value;
+ table = slot_value(**p); (*p)++;
+ key = slot_value(**p); (*p)++;
+ value = slot_value(**p); (*p)++;
+ return(s7_hash_table_set(sc, table, key, value));
+}
+
+static s7_pointer hash_table_set_pf_ssx(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t pf;
+ s7_pointer key, table, value;
+ table = slot_value(**p); (*p)++;
+ key = slot_value(**p); (*p)++;
+ pf = (s7_pf_t)(**p); (*p)++;
+ value = pf(sc, p);
+ return(s7_hash_table_set(sc, table, key, value));
+}
+
+static s7_pf_t hash_table_set_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((is_pair(cdr(expr))) && (is_pair(cddr(expr))) && (is_pair(cdddr(expr))) && (is_null(cddddr(expr))))
+ {
+ s7_pointer a1, a2, a3;
+ a1 = cadr(expr);
+ a2 = caddr(expr);
+ a3 = cadddr(expr);
+ if (is_symbol(a1))
+ {
+ xf_t *rc;
+ a1 = s7_slot(sc, a1);
+ if ((!is_slot(a1)) || (!is_hash_table(slot_value(a1))) || (is_stepper(a1))) return(NULL);
+ xf_init(3);
+ xf_store(a1);
+ if (is_symbol(a2))
+ {
+ a2 = s7_slot(sc, a2);
+ if (!is_slot(a2)) return(NULL);
+ xf_store(a2);
+ }
+ else
+ {
+ ptr_int loc;
+ loc = rc_loc(sc);
+ if (!s7_arg_to_pf(sc, a2))
+ {
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (!s7_arg_to_gf(sc, a2)) return(NULL);
+ }
+ }
+ if (is_symbol(a3))
+ {
+ a3 = s7_slot(sc, a3);
+ if (!is_slot(a3)) return(NULL);
+ xf_store(a3);
+ return((is_slot(a2)) ? hash_table_set_pf_sss : hash_table_set_pf_sxs);
+ }
+ else
+ {
+ ptr_int loc;
+ loc = rc_loc(sc);
+ if (!s7_arg_to_pf(sc, a3))
+ {
+ sc->cur_rf->cur = rc_go(sc, loc);
+ if (!s7_arg_to_gf(sc, a3)) return(NULL);
+ }
+ return((is_slot(a2)) ? hash_table_set_pf_ssx : hash_table_set_pf_sxx);
+ }
+ }
+ }
+ return(NULL);
+}
+
+
+static s7_pointer g_hash_table_set(s7_scheme *sc, s7_pointer args)
+{
+ #define H_hash_table_set "(hash-table-set! table key value) sets the value associated with key in the hash table to value"
+ #define Q_hash_table_set s7_make_signature(sc, 4, sc->T, sc->IS_HASH_TABLE, sc->T, sc->T)
+
+ s7_pointer table;
+ table = car(args);
+ if (!is_hash_table(table))
+ method_or_bust(sc, table, sc->HASH_TABLE_SET, args,T_HASH_TABLE, 1);
+ return(s7_hash_table_set(sc, table, cadr(args), caddr(args)));
+}
+
+
+/* -------------------------------- hash-table -------------------------------- */
+static s7_pointer g_hash_table(s7_scheme *sc, s7_pointer args)
+{
+ #define H_hash_table "(hash-table ...) returns a hash-table containing the cons's passed as its arguments. \
+That is, (hash-table '(\"hi\" . 3) (\"ho\" . 32)) returns a new hash-table with the two key/value pairs preinstalled."
+ #define Q_hash_table s7_make_circular_signature(sc, 1, 2, sc->IS_HASH_TABLE, sc->IS_LIST)
+
+ int len;
+ s7_pointer x, ht;
+
+ /* this accepts repeated keys: (hash-table '(a . 1) '(a . 1)) */
+ for (len = 0, x = args; is_pair(x); x = cdr(x), len++)
+ if ((!is_pair(car(x))) &&
+ (!is_null(car(x))))
+ return(wrong_type_argument(sc, sc->HASH_TABLE, position_of(x, args), car(x), T_PAIR));
+
+ ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length);
+ if (len > 0)
+ {
+ int ht_loc;
+ ht_loc = s7_gc_protect(sc, ht); /* hash_table_set can cons, so we need to protect this */
+ for (x = args; is_pair(x); x = cdr(x))
+ if (is_pair(car(x)))
+ s7_hash_table_set(sc, ht, caar(x), cdar(x));
+ s7_gc_unprotect_at(sc, ht_loc);
+ }
+ return(ht);
+}
+
+
+/* -------------------------------- hash-table* -------------------------------- */
+static s7_pointer g_hash_table_star(s7_scheme *sc, s7_pointer args)
+{
+ #define H_hash_table_star "(hash-table* ...) returns a hash-table containing the symbol/value pairs passed as its arguments. \
+That is, (hash-table* 'a 1 'b 2) returns a new hash-table with the two key/value pairs preinstalled."
+ #define Q_hash_table_star s7_make_circular_signature(sc, 1, 2, sc->IS_HASH_TABLE, sc->T)
+
+ int len;
+ s7_pointer ht;
+
+ len = safe_list_length(sc, args);
+ if (len & 1)
+ return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_2(sc, make_string_wrapper(sc, "hash-table* got an odd number of arguments: ~S"), args)));
+ len /= 2;
+
+ ht = s7_make_hash_table(sc, (len > sc->default_hash_table_length) ? len : sc->default_hash_table_length);
+ if (len > 0)
+ {
+ int ht_loc;
+ s7_pointer x, y;
+ ht_loc = s7_gc_protect(sc, ht); /* hash_table_set can cons, so we need to protect this */
+
+ for (x = args, y = cdr(args); is_pair(y); x = cddr(x), y = cddr(y))
+ s7_hash_table_set(sc, ht, car(x), car(y));
+
+ s7_gc_unprotect_at(sc, ht_loc);
+ }
+ return(ht);
+}
+
+
+static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer new_hash, unsigned int start, unsigned int end)
+{
+ unsigned int i, old_len, new_len, count = 0;
+ hash_entry_t **old_lists, **new_lists;
+ hash_entry_t *x, *p;
+
+ old_len = hash_table_mask(old_hash) + 1;
+ new_len = hash_table_mask(new_hash);
+ old_lists = hash_table_elements(old_hash);
+ new_lists = hash_table_elements(new_hash);
+
+ if (hash_table_entries(new_hash) == 0)
+ {
+ hash_table_checker(new_hash) = hash_table_checker(old_hash);
+ for (i = 0; i < old_len; i++)
+ for (x = old_lists[i]; x; x = x->next)
+ {
+ if (count >= end)
+ {
+ hash_table_entries(new_hash) = end - start;
+ return(new_hash);
+ }
+ if (count >= start)
+ {
+ unsigned int loc;
+ loc = x->raw_hash & new_len;
+ p = make_hash_entry(x->key, x->value, x->raw_hash);
+ p->next = new_lists[loc];
+ new_lists[loc] = p;
+ }
+ count++;
+ }
+ hash_table_entries(new_hash) = count - start;
+ return(new_hash);
+ }
+
+ /* this can't be optimized much because we have to look for key matches */
+ for (i = 0; i < old_len; i++)
+ for (x = old_lists[i]; x; x = x->next)
+ {
+ if (count >= end)
+ return(new_hash);
+ if (count >= start)
+ {
+ hash_entry_t *y;
+ y = (*hash_table_checker(new_hash))(sc, new_hash, x->key);
+ if (y)
+ y->value = x->value;
+ else
+ {
+ unsigned int loc;
+ loc = x->raw_hash & new_len;
+ p = make_hash_entry(x->key, x->value, x->raw_hash);
+ p->next = new_lists[loc];
+ new_lists[loc] = p;
+ hash_table_entries(new_hash)++;
+ if (!hash_table_checker_locked(new_hash))
+ hash_table_set_function(new_hash, type(x->key));
+ }
+ }
+ count++;
+ }
+ return(new_hash);
+}
+
+s7_pointer hash_table_fill(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer val, table;
+ table = car(args);
+ val = cadr(args);
+ if (hash_table_entries(table) > 0)
+ {
+ int len;
+ hash_entry_t **entries;
+ entries = hash_table_elements(table);
+ len = hash_table_mask(table) + 1;
+ /* hash-table-ref returns #f if it can't find a key, so val == #f here means empty the table */
+ if (val == sc->F)
+ {
+ hash_entry_t **hp, **hn;
+ hash_entry_t *p;
+ hp = entries;
+ hn = (hash_entry_t **)(hp + len);
+ for (; hp < hn; hp++)
+ {
+ if (*hp)
+ {
+ p = *hp;
+ while (p->next) p = p->next;
+ p->next = hash_free_list;
+ hash_free_list = *hp;
+ }
+ hp++;
+ if (*hp)
+ {
+ p = *hp;
+ while (p->next) p = p->next;
+ p->next = hash_free_list;
+ hash_free_list = *hp;
+ }
+ }
+ memset(entries, 0, len * sizeof(hash_entry_t *));
+ if (!hash_table_checker_locked(table))
+ hash_table_checker(table) = hash_empty;
+ hash_table_entries(table) = 0;
+ }
+ else
+ {
+ int i;
+ hash_entry_t *x;
+ for (i = 0; i < len; i++)
+ for (x = entries[i]; x; x = x->next)
+ x->value = val;
+ /* keys haven't changed, so no need to mess with hash_table_checker */
+ }
+ }
+ return(val);
+}
+
+
+static s7_pointer hash_table_reverse(s7_scheme *sc, s7_pointer old_hash)
+{
+ int i, len;
+ s7_pointer new_hash;
+ hash_entry_t **old_lists;
+ int gc_loc;
+
+ len = hash_table_mask(old_hash) + 1;
+ new_hash = s7_make_hash_table(sc, len);
+ gc_loc = s7_gc_protect(sc, new_hash);
+
+ /* I don't think the original hash functions can make any sense in general, so ignore them */
+ old_lists = hash_table_elements(old_hash);
+ for (i = 0; i < len; i++)
+ {
+ hash_entry_t *x;
+ for (x = old_lists[i]; x; x = x->next)
+ s7_hash_table_set(sc, new_hash, x->value, x->key);
+ }
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(new_hash);
+}
+
+
+
+/* -------------------------------- functions -------------------------------- */
+
+bool s7_is_function(s7_pointer p)
+{
+ return(is_c_function(p));
+}
+
+
+static s7_pointer fallback_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ return(f);
+}
+
+static void s7_function_set_class(s7_pointer f, s7_pointer base_f)
+{
+ c_function_class(f) = c_function_class(base_f);
+ c_function_base(f) = base_f;
+}
+
+static int c_functions = 0;
+
+s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function f, int required_args, int optional_args, bool rest_arg, const char *doc)
+{
+ c_proc_t *ptr;
+ unsigned int ftype = T_C_FUNCTION;
+ s7_pointer x;
+
+ x = alloc_pointer();
+ unheap(x);
+
+ ptr = (c_proc_t *)malloc(sizeof(c_proc_t));
+ c_functions++;
+ if (required_args == 0)
+ {
+ if (rest_arg)
+ ftype = T_C_ANY_ARGS_FUNCTION;
+ else
+ {
+ if (optional_args != 0)
+ ftype = T_C_OPT_ARGS_FUNCTION;
+ /* a thunk needs to check for no args passed */
+ }
+ }
+ else
+ {
+ if (rest_arg)
+ ftype = T_C_RST_ARGS_FUNCTION;
+ }
+
+ set_type(x, ftype | T_PROCEDURE);
+
+ c_function_data(x) = ptr;
+ c_function_call(x) = f;
+ c_function_base(x) = x;
+ c_function_setter(x) = sc->F;
+ c_function_name(x) = name; /* (procedure-name proc) => (format #f "~A" proc) */
+ c_function_name_length(x) = safe_strlen(name);
+ if (doc)
+ c_function_documentation(x) = make_permanent_string(doc);
+ else c_function_documentation(x) = NULL;
+ c_function_signature(x) = sc->F;
+
+ c_function_required_args(x) = required_args;
+ c_function_optional_args(x) = optional_args;
+ c_function_has_rest_arg(x) = rest_arg;
+ if (rest_arg)
+ c_function_all_args(x) = MAX_ARITY;
+ else c_function_all_args(x) = required_args + optional_args;
+
+ c_function_class(x) = ++sc->f_class;
+ c_function_chooser(x) = fallback_chooser;
+ c_function_rp(x) = NULL;
+ c_function_ip(x) = NULL;
+ c_function_pp(x) = NULL;
+ c_function_gp(x) = NULL;
+
+ return(x);
+}
+
+s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function f,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
+{
+ s7_pointer p;
+ p = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, doc);
+ typeflag(p) |= T_SAFE_PROCEDURE; /* not set_type(p, type(p) ...) because that accidentally clears the T_PROCEDURE bit */
+ return(p);
+}
+
+
+s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f,
+ int required_args, int optional_args, bool rest_arg, const char *doc, s7_pointer signature)
+{
+ s7_pointer func;
+ func = s7_make_function(sc, name, f, required_args, optional_args, rest_arg, doc);
+ typeflag(func) |= T_SAFE_PROCEDURE;
+ if (signature) c_function_signature(func) = signature;
+ return(func);
+}
+
+
+bool s7_is_procedure(s7_pointer x)
+{
+ return(is_procedure(x)); /* this returns "is applicable" so it is true for applicable c_objects, macros, etc */
+}
+
+
+static s7_pointer g_is_procedure(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_procedure "(procedure? obj) returns #t if obj is a procedure"
+ #define Q_is_procedure pl_bt
+ s7_pointer x;
+ int typ;
+
+ x = car(args);
+ if ((!is_procedure(x)) || (is_c_object(x)))
+ {
+ check_method(sc, x, sc->IS_PROCEDURE, args);
+ return(sc->F);
+ }
+ typ = type(x);
+
+ /* make_object sets the T_PROCEDURE bit if the object has an apply function,
+ * but we currently return (procedure? "hi") -> #f, so we can't simply use
+ * is_procedure.
+ *
+ * Unfortunately much C code depends on s7_is_procedure treating applicable
+ * objects and macros as procedures. We can use arity = applicable?
+ */
+ return(make_boolean(sc,
+ (typ == T_CLOSURE) ||
+ (typ == T_CLOSURE_STAR) ||
+ (typ >= T_C_FUNCTION_STAR) ||
+ (typ == T_GOTO) ||
+ (typ == T_CONTINUATION)));
+}
+
+
+static void s7_function_set_setter(s7_scheme *sc, const char *getter, const char *setter)
+{
+ /* this is internal, used only with c_function setters, so we don't need to worry about the GC mark choice
+ */
+ c_function_setter(s7_name_to_value(sc, getter)) = s7_name_to_value(sc, setter);
+}
+
+
+s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p)
+{
+ if (has_closure_let(p))
+ return(closure_body(p));
+ return(sc->NIL);
+}
+
+
+s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p)
+{
+ if (has_closure_let(p))
+ return(closure_let(p));
+ return(sc->NIL);
+}
+
+
+s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p)
+{
+ if (has_closure_let(p))
+ return(closure_args(p));
+ return(sc->NIL);
+}
+
+
+static s7_pointer c_procedure_source(s7_scheme *sc, s7_pointer p)
+{
+ /* make it look like a scheme-level lambda */
+ if (is_symbol(p))
+ {
+ p = s7_symbol_value(sc, p);
+ if (p == sc->UNDEFINED)
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "procedure-source arg, '~S, is unbound"), p)));
+ }
+
+ if ((is_c_function(p)) || (is_c_macro(p)))
+ return(sc->NIL);
+
+ check_method(sc, p, sc->PROCEDURE_SOURCE, list_1(sc, p));
+ if (has_closure_let(p))
+ {
+ s7_pointer body;
+ body = closure_body(p);
+ if (is_safe_closure(body))
+ clear_safe_closure(body);
+ return(append_in_place(sc, list_2(sc, ((is_closure_star(p)) || (is_macro_star(p)) || (is_bacro_star(p))) ? sc->LAMBDA_STAR : sc->LAMBDA, closure_args(p)), body));
+ }
+
+ if (!is_procedure(p))
+ return(simple_wrong_type_argument_with_type(sc, sc->PROCEDURE_SOURCE, p, make_string_wrapper(sc, "a procedure or a macro")));
+
+ return(sc->NIL);
+}
+
+static s7_pointer g_procedure_source(s7_scheme *sc, s7_pointer args)
+{
+ #define H_procedure_source "(procedure-source func) tries to return the definition of func"
+ #define Q_procedure_source s7_make_signature(sc, 2, sc->IS_LIST, sc->IS_PROCEDURE)
+ return(c_procedure_source(sc, car(args)));
+}
+
+PF_TO_PF(procedure_source, c_procedure_source)
+
+
+s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p)
+{
+ if (has_closure_let(p))
+ return(closure_let(p));
+ return(sc->rootlet);
+}
+
+
+static s7_pointer g_funclet(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p, e;
+ #define H_funclet "(funclet func) tries to return an object's environment"
+ #define Q_funclet s7_make_signature(sc, 2, sc->IS_LET, sc->IS_PROCEDURE)
+
+ /* this procedure gives direct access to a function's closure -- see s7test.scm
+ * for some wild examples. At least it provides a not-too-kludgey way for several functions
+ * to share a closure.
+ */
+
+ p = car(args);
+ if (is_symbol(p))
+ {
+ p = s7_symbol_value(sc, p);
+ if (p == sc->UNDEFINED)
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "funclet arg, '~S, is unbound"), car(args)))); /* not p here */
+ }
+ check_method(sc, p, sc->FUNCLET, args);
+
+ if (!is_procedure_or_macro(p))
+ return(simple_wrong_type_argument_with_type(sc, sc->FUNCLET, p, make_string_wrapper(sc, "a procedure or a macro")));
+
+ e = find_let(sc, p);
+ if ((is_null(e)) &&
+ (!is_c_object(p)))
+ return(sc->rootlet);
+
+ return(e);
+}
+
+
+s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
+{
+ s7_pointer func, sym;
+ func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->NIL, sym, func);
+ return(sym);
+}
+
+
+s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
+{
+ /* returns (string->symbol name), not the c_proc_t func */
+ s7_pointer func, sym;
+ func = s7_make_safe_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->NIL, sym, func);
+ return(sym);
+}
+
+
+s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg,
+ const char *doc, s7_pointer signature)
+{
+ /* returns (string->symbol name), not the c_proc_t func */
+ s7_pointer func, sym;
+ func = s7_make_typed_function(sc, name, fnc, required_args, optional_args, rest_arg, doc, signature);
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->NIL, sym, func);
+ return(sym);
+}
+
+
+static s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg,
+ const char *doc, s7_pointer signature)
+{
+ /* returns (string->symbol name), not the c_proc_t func */
+ s7_pointer func, sym;
+ func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+ if (signature) c_function_signature(func) = signature;
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->NIL, sym, func);
+ return(sym);
+}
+
+
+s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
+{
+ s7_pointer func, sym;
+ func = s7_make_function(sc, name, fnc, required_args, optional_args, rest_arg, doc);
+ set_type(func, T_C_MACRO | T_DONT_EVAL_ARGS); /* this used to include T_PROCEDURE */
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->NIL, sym, func);
+ return(sym);
+}
+
+
+bool s7_is_macro(s7_scheme *sc, s7_pointer x)
+{
+ return(is_any_macro(x));
+}
+
+
+static s7_pointer g_is_macro(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_macro "(macro? arg) returns #t if 'arg' is a macro or a bacro"
+ #define Q_is_macro pl_bt
+ check_boolean_method(sc, is_any_macro, sc->IS_MACRO, args);
+}
+
+
+static void define_function_star_1(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc, bool safe)
+{
+ s7_pointer func, sym, local_args, p;
+ char *internal_arglist;
+ int i, len, n_args, gc_loc;
+ s7_pointer *names, *defaults;
+
+ len = safe_strlen(arglist) + 8;
+ tmpbuf_malloc(internal_arglist, len);
+ snprintf(internal_arglist, len, "'(%s)", arglist);
+ local_args = s7_eval_c_string(sc, internal_arglist);
+ gc_loc = s7_gc_protect(sc, local_args);
+ tmpbuf_free(internal_arglist, len);
+ n_args = safe_list_length(sc, local_args); /* currently rest arg not supported, and we don't notice :key :allow-other-keys etc */
+
+ func = s7_make_function(sc, name, fnc, 0, n_args, false, doc);
+ if (safe)
+ set_type(func, T_C_FUNCTION_STAR | T_PROCEDURE | T_SAFE_PROCEDURE);
+ else set_type(func, T_C_FUNCTION_STAR | T_PROCEDURE);
+
+ c_function_call_args(func) = make_list(sc, n_args, sc->F);
+ s7_remove_from_heap(sc, c_function_call_args(func));
+
+ sym = make_symbol(sc, name);
+ s7_define(sc, sc->NIL, sym, func);
+
+ names = (s7_pointer *)malloc(n_args * sizeof(s7_pointer));
+ c_function_arg_names(func) = names;
+ defaults = (s7_pointer *)malloc(n_args * sizeof(s7_pointer));
+ c_function_arg_defaults(func) = defaults;
+ set_simple_defaults(func);
+
+ for (p = local_args, i = 0; i < n_args; p = cdr(p), i++)
+ {
+ s7_pointer arg;
+ arg = car(p);
+ if (is_pair(arg))
+ {
+ names[i] = s7_make_keyword(sc, symbol_name(car(arg)));
+ defaults[i] = cadr(arg);
+ s7_remove_from_heap(sc, cadr(arg));
+ if ((is_symbol(defaults[i])) ||
+ (is_pair(defaults[i])))
+ {
+ clear_simple_defaults(func);
+ mark_function[T_C_FUNCTION_STAR] = mark_c_proc_star;
+ }
+ }
+ else
+ {
+ names[i] = s7_make_keyword(sc, symbol_name(arg));
+ defaults[i] = sc->F;
+ }
+ }
+ s7_gc_unprotect_at(sc, gc_loc);
+}
+
+void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
+{
+ define_function_star_1(sc, name, fnc, arglist, doc, false);
+}
+
+void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc)
+{
+ define_function_star_1(sc, name, fnc, arglist, doc, true);
+}
+
+
+s7_pointer set_c_function_call_args(s7_scheme *sc)
+{
+ int i, j, n_args;
+ s7_pointer arg, par, call_args, func;
+ s7_pointer *df;
+
+ func = sc->code;
+ n_args = c_function_all_args(func);
+ call_args = c_function_call_args(func);
+
+ df = c_function_arg_defaults(func);
+ for (i = 0, par = call_args; is_pair(par); i++, par = cdr(par))
+ {
+ clear_checked(par);
+ car(par) = df[i];
+ }
+
+ df = c_function_arg_names(func);
+ for (i = 0, arg = sc->args, par = call_args; (i < n_args) && (is_pair(arg)); i++, arg = cdr(arg), par = cdr(par))
+ {
+ if (!is_keyword(car(arg)))
+ {
+ if (is_checked(par))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_3(sc, make_string_wrapper(sc, "parameter set twice, ~S in ~S"), car(par), sc->args)));
+ set_checked(par);
+ car(par) = car(arg);
+ }
+ else
+ {
+ s7_pointer p;
+ for (j = 0, p = call_args; j < n_args; j++, p = cdr(p))
+ if (df[j] == car(arg))
+ break;
+ if (j == n_args)
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "~A: not a parameter name?"), car(arg))));
+ if (is_checked(p))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_3(sc, make_string_wrapper(sc, "parameter set twice, ~S in ~S"), car(p), sc->args)));
+ set_checked(p);
+ arg = cdr(arg);
+ car(p) = car(arg);
+ }
+ }
+
+ if (!is_null(arg))
+ return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->TOO_MANY_ARGUMENTS, func, sc->args)));
+
+ if (!has_simple_defaults(func))
+ for (i = 0, par = call_args; i < n_args; i++, par = cdr(par))
+ if (!is_checked(par))
+ {
+ if (is_symbol(car(par)))
+ car(par) = find_symbol_checked(sc, car(par));
+ else
+ {
+ if (is_pair(car(par)))
+ car(par) = s7_eval_form(sc, car(par), sc->NIL);
+ }
+ }
+ return(call_args);
+}
+
+
+/* -------------------------------- procedure-documentation -------------------------------- */
+static s7_pointer get_doc(s7_scheme *sc, s7_pointer x)
+{
+ check_closure_for(sc, x, sc->DOCUMENTATION);
+ return(NULL);
+}
+
+const char *s7_procedure_documentation(s7_scheme *sc, s7_pointer x)
+{
+ s7_pointer val;
+ if (is_symbol(x))
+ {
+ if ((symbol_has_help(x)) &&
+ (is_global(x)))
+ return(symbol_help(x));
+ x = s7_symbol_value(sc, x); /* this is needed by Snd */
+ }
+
+ if ((is_any_c_function(x)) ||
+ (is_c_macro(x)))
+ return((char *)c_function_documentation(x));
+
+ val = get_doc(sc, x);
+ if ((val) && (is_string(val)))
+ return(string_value(val));
+
+ return(NULL);
+}
+
+static s7_pointer c_procedure_documentation(s7_scheme *sc, s7_pointer p)
+{
+ if (is_symbol(p))
+ {
+ if ((symbol_has_help(p)) &&
+ (is_global(p)))
+ return(s7_make_string(sc, symbol_help(p)));
+ p = s7_symbol_value(sc, p);
+ }
+
+ check_method(sc, p, sc->PROCEDURE_DOCUMENTATION, list_1(sc, p));
+ if ((!is_procedure(p)) &&
+ (!s7_is_macro(sc, p)))
+ return(simple_wrong_type_argument_with_type(sc, sc->PROCEDURE_DOCUMENTATION, p, A_PROCEDURE));
+
+ return(s7_make_string(sc, s7_procedure_documentation(sc, p)));
+}
+
+static s7_pointer g_procedure_documentation(s7_scheme *sc, s7_pointer args)
+{
+ #define H_procedure_documentation "(procedure-documentation func) returns func's documentation string"
+ #define Q_procedure_documentation s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_PROCEDURE)
+ return(c_procedure_documentation(sc, car(args)));
+}
+
+PF_TO_PF(procedure_documentation, c_procedure_documentation)
+
+
+/* -------------------------------- help -------------------------------- */
+const char *s7_help(s7_scheme *sc, s7_pointer obj)
+{
+ if (is_syntax(obj))
+ return(string_value(syntax_documentation(obj)));
+
+ if (is_symbol(obj))
+ {
+ /* here look for name */
+ if (s7_symbol_documentation(sc, obj))
+ return(s7_symbol_documentation(sc, obj));
+ obj = s7_symbol_value(sc, obj);
+ }
+
+ if (is_procedure_or_macro(obj))
+ return(s7_procedure_documentation(sc, obj));
+
+ /* if is string, apropos? (can scan symbol table) */
+ return(NULL);
+}
+
+
+static s7_pointer g_help(s7_scheme *sc, s7_pointer args)
+{
+ #define H_help "(help obj) returns obj's documentation"
+ #define Q_help s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->IS_STRING, sc->IS_BOOLEAN), sc->T)
+ const char *doc;
+
+ check_method(sc, car(args), sc->HELP, args);
+ doc = s7_help(sc, car(args));
+ if (!doc)
+ return(sc->F);
+ return(s7_make_string(sc, doc));
+}
+
+static s7_pointer c_help(s7_scheme *sc, s7_pointer x) {return(g_help(sc, set_plist_1(sc, x)));}
+PF_TO_PF(help, c_help)
+
+
+/* -------------------------------- procedure-signature -------------------------------- */
+static s7_pointer get_signature(s7_scheme *sc, s7_pointer x)
+{
+ check_closure_for(sc, x, sc->SIGNATURE);
+ return(sc->F);
+}
+
+static s7_pointer s7_procedure_signature(s7_scheme *sc, s7_pointer x)
+{
+ if ((is_any_c_function(x)) ||
+ (is_c_macro(x)))
+ return((s7_pointer)c_function_signature(x));
+ return(get_signature(sc, x));
+}
+
+static s7_pointer c_procedure_signature(s7_scheme *sc, s7_pointer p)
+{
+ if (is_symbol(p))
+ {
+ p = s7_symbol_value(sc, p);
+ if (p == sc->UNDEFINED)
+ return(sc->F);
+ }
+ check_method(sc, p, sc->PROCEDURE_SIGNATURE, list_1(sc, p));
+
+ if (!is_procedure(p))
+ return(sc->F);
+ return(s7_procedure_signature(sc, p));
+}
+
+static s7_pointer g_procedure_signature(s7_scheme *sc, s7_pointer args)
+{
+ #define H_procedure_signature "(procedure-signature func) returns func's signature"
+ #define Q_procedure_signature s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->IS_PAIR, sc->IS_BOOLEAN), sc->T)
+
+ return(c_procedure_signature(sc, car(args)));
+}
+
+PF_TO_PF(procedure_signature, c_procedure_signature)
+
+
+/* -------------------------------- new types (c_objects) -------------------------------- */
+
+static void fallback_free(void *value) {}
+static void fallback_mark(void *value) {}
+
+static char *fallback_print(s7_scheme *sc, void *val)
+{
+ return(copy_string("#<unprintable object>"));
+}
+
+static char *fallback_print_readably(s7_scheme *sc, void *val)
+{
+ return(copy_string("#<unprint-readable object>"));
+}
+
+static bool fallback_equal(void *val1, void *val2)
+{
+ return(val1 == val2);
+}
+
+static s7_pointer fallback_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ return(apply_error(sc, obj, args));
+}
+
+static s7_pointer fallback_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ eval_error(sc, "attempt to set ~S?", obj);
+}
+
+static s7_pointer fallback_length(s7_scheme *sc, s7_pointer obj)
+{
+ return(sc->F);
+}
+
+
+bool s7_is_object(s7_pointer p)
+{
+ return(is_c_object(p));
+}
+
+static s7_pointer g_is_c_object(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_c_object "(c-object? obj) returns the object's type tag if obj is a C object, otherwise #f"
+ #define Q_is_c_object pl_bt
+
+ s7_pointer p;
+ p = car(args);
+ if (is_c_object(p))
+ return(make_integer(sc, c_object_type(p))); /* this is the object_types table index = tag */
+ check_method(sc, p, sc->IS_C_OBJECT, args);
+ return(sc->F);
+ /* <1> (*s7* 'c-types)
+ ("<random-number-generator>")
+ <2> (c-object? (random-state 123))
+ 0
+ */
+}
+
+
+static s7_pointer g_internal_object_set(s7_scheme *sc, s7_pointer args)
+{
+ return((*(c_object_set(car(args))))(sc, car(args), cdr(args)));
+}
+
+
+int s7_new_type(const char *name,
+ char *(*print)(s7_scheme *sc, void *value),
+ void (*gc_free)(void *value),
+ bool (*equal)(void *val1, void *val2),
+ void (*gc_mark)(void *val),
+ s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args))
+{
+ int tag;
+ tag = num_object_types++;
+ if (tag >= object_types_size)
+ {
+ if (object_types_size == 0)
+ {
+ object_types_size = 8;
+ object_types = (c_object_t **)calloc(object_types_size, sizeof(c_object_t *));
+ }
+ else
+ {
+ object_types_size = tag + 8;
+ object_types = (c_object_t **)realloc((void *)object_types, object_types_size * sizeof(c_object_t *));
+ }
+ }
+ object_types[tag] = (c_object_t *)calloc(1, sizeof(c_object_t));
+ object_types[tag]->type = tag;
+ object_types[tag]->name = copy_string(name);
+ object_types[tag]->scheme_name = s7_make_permanent_string(name);
+
+ object_types[tag]->free = (gc_free) ? gc_free : fallback_free;
+ object_types[tag]->print = (print) ? print : fallback_print;
+ object_types[tag]->equal = (equal) ? equal : fallback_equal;
+ object_types[tag]->gc_mark = (gc_mark) ? gc_mark : fallback_mark;
+ object_types[tag]->ref = (ref) ? ref : fallback_ref;
+ object_types[tag]->set = (set) ? set : fallback_set;
+
+ if (object_types[tag]->ref != fallback_ref)
+ object_types[tag]->outer_type = (T_C_OBJECT | T_PROCEDURE | T_SAFE_PROCEDURE);
+ else object_types[tag]->outer_type = T_C_OBJECT;
+
+ object_types[tag]->length = fallback_length;
+ object_types[tag]->copy = NULL;
+ object_types[tag]->reverse = NULL;
+ object_types[tag]->fill = NULL;
+ object_types[tag]->print_readably = fallback_print_readably;
+
+ object_types[tag]->ip = NULL;
+ object_types[tag]->rp = NULL;
+ object_types[tag]->set_ip = NULL;
+ object_types[tag]->set_rp = NULL;
+
+ return(tag);
+}
+
+
+int s7_new_type_x(s7_scheme *sc,
+ const char *name,
+ char *(*print)(s7_scheme *sc, void *value),
+ void (*free)(void *value),
+ bool (*equal)(void *val1, void *val2),
+ void (*gc_mark)(void *val),
+ s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
+ s7_pointer (*length)(s7_scheme *sc, s7_pointer obj),
+ s7_pointer (*copy)(s7_scheme *sc, s7_pointer args),
+ s7_pointer (*reverse)(s7_scheme *sc, s7_pointer args),
+ s7_pointer (*fill)(s7_scheme *sc, s7_pointer args))
+{
+ int tag;
+ tag = s7_new_type(name, print, free, equal, gc_mark, apply, set);
+ if (length)
+ object_types[tag]->length = length;
+ else object_types[tag]->length = fallback_length;
+ object_types[tag]->copy = copy;
+ object_types[tag]->reverse = reverse;
+ object_types[tag]->fill = fill;
+ return(tag);
+}
+
+
+static void free_object(s7_pointer a)
+{
+ (*(c_object_free(a)))(c_object_value(a));
+}
+
+
+static bool objects_are_equal(s7_scheme *sc, s7_pointer a, s7_pointer b)
+{
+ return((c_object_type(a) == c_object_type(b)) &&
+ ((*(c_object_eql(a)))(c_object_value(a), c_object_value(b))));
+}
+
+
+void *s7_object_value(s7_pointer obj)
+{
+ return(c_object_value(obj));
+}
+
+
+void *s7_object_value_checked(s7_pointer obj, int type)
+{
+ if ((is_c_object(obj)) &&
+ (c_object_type(obj) == type))
+ return(c_object_value(obj));
+ return(NULL);
+}
+
+
+void s7_set_object_print_readably(int type, char *(*printer)(s7_scheme *sc, void *val))
+{
+ object_types[type]->print_readably = printer;
+}
+
+
+int s7_object_type(s7_pointer obj)
+{
+ if (is_c_object(obj))
+ return(c_object_type(obj));
+ return(-1);
+}
+
+
+s7_pointer s7_make_object(s7_scheme *sc, int type, void *value)
+{
+ s7_pointer x;
+ new_cell(sc, x, object_types[type]->outer_type);
+
+ /* c_object_info(x) = &(object_types[type]); */
+ /* that won't work because object_types can move when it is realloc'd and the old stuff is freed by realloc
+ * and since we're checking (for example) ref_2 existence as not null, we can't use a table of c_object_t's!
+ */
+ c_object_type(x) = type;
+ c_object_value(x) = value;
+ c_object_set_let(x, sc->NIL);
+ add_c_object(sc, x);
+ return(x);
+}
+
+
+s7_pointer s7_object_let(s7_pointer obj)
+{
+ return(c_object_let(obj));
+}
+
+
+s7_pointer s7_object_set_let(s7_pointer obj, s7_pointer e)
+{
+ c_object_set_let(obj, e);
+ return(e);
+}
+
+
+void s7_object_type_set_xf(int tag, s7_ip_t ip, s7_ip_t set_ip, s7_rp_t rp, s7_rp_t set_rp)
+{
+ object_types[tag]->ip = ip;
+ object_types[tag]->rp = rp;
+ object_types[tag]->set_ip = set_ip;
+ object_types[tag]->set_rp = set_rp;
+}
+
+void s7_object_type_set_direct(int tag,
+ s7_pointer (*dref)(s7_scheme *sc, s7_pointer obj, s7_int index),
+ s7_pointer (*dset)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val))
+{
+ object_types[tag]->direct_ref = dref;
+ object_types[tag]->direct_set = dset;
+}
+
+static s7_pointer object_length(s7_scheme *sc, s7_pointer obj)
+{
+ if (c_object_length(obj))
+ return((*(c_object_length(obj)))(sc, obj));
+ eval_error(sc, "attempt to get length of ~S?", obj);
+}
+
+
+static s7_int object_length_to_int(s7_scheme *sc, s7_pointer obj)
+{
+ if (c_object_length(obj))
+ {
+ s7_pointer res;
+ res = (*(c_object_length(obj)))(sc, obj);
+ if (s7_is_integer(res))
+ return(s7_integer(res));
+ }
+ return(-1);
+}
+
+
+static s7_pointer object_copy(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer obj;
+ obj = car(args);
+ check_method(sc, obj, sc->COPY, args);
+ if (c_object_copy(obj))
+ return((*(c_object_copy(obj)))(sc, args));
+ eval_error(sc, "attempt to copy ~S?", obj);
+}
+
+
+
+
+/* -------- dilambda -------- */
+
+s7_pointer s7_dilambda(s7_scheme *sc,
+ const char *name,
+ s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+ int get_req_args, int get_opt_args,
+ s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+ int set_req_args, int set_opt_args,
+ const char *documentation)
+{
+ s7_pointer get_func, set_func;
+ char *internal_set_name;
+ int len;
+
+ len = 16 + safe_strlen(name);
+ internal_set_name = (char *)malloc(len * sizeof(char));
+ snprintf(internal_set_name, len, "[set-%s]", name);
+
+ get_func = s7_make_safe_function(sc, name, getter, get_req_args, get_opt_args, false, documentation);
+ s7_define(sc, sc->NIL, make_symbol(sc, name), get_func);
+ set_func = s7_make_function(sc, internal_set_name, setter, set_req_args, set_opt_args, false, documentation);
+ c_function_setter(get_func) = set_func;
+
+ return(get_func);
+}
+
+s7_pointer s7_typed_dilambda(s7_scheme *sc,
+ const char *name,
+ s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+ int get_req_args, int get_opt_args,
+ s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+ int set_req_args, int set_opt_args,
+ const char *documentation,
+ s7_pointer get_sig, s7_pointer set_sig)
+{
+ s7_pointer get_func, set_func;
+ get_func = s7_dilambda(sc, name, getter, get_req_args, get_opt_args, setter, set_req_args, set_opt_args, documentation);
+ set_func = c_function_setter(get_func);
+ if (get_sig) c_function_signature(get_func) = get_sig;
+ if (set_sig) c_function_signature(set_func) = set_sig;
+ return(get_func);
+}
+
+
+bool s7_is_dilambda(s7_pointer obj)
+{
+ return(((is_c_function(obj)) &&
+ (is_c_function(c_function_setter(obj)))) ||
+ ((is_any_closure(obj)) &&
+ (is_procedure(closure_setter(obj)))));
+}
+
+static s7_pointer g_is_dilambda(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_dilambda "(dilambda? obj) returns #t if obj is a procedure with setter."
+ #define Q_is_dilambda pl_bt
+ check_boolean_method(sc, s7_is_dilambda, sc->IS_DILAMBDA, args);
+}
+
+
+s7_pointer s7_procedure_setter(s7_scheme *sc, s7_pointer obj)
+{
+ if (is_c_function(obj))
+ return(c_function_setter(obj));
+
+ return(closure_setter(obj));
+}
+
+
+static s7_pointer g_procedure_setter(s7_scheme *sc, s7_pointer args)
+{
+ #define H_procedure_setter "(procedure-setter obj) returns the setter associated with obj, or #f"
+ #define Q_procedure_setter s7_make_signature(sc, 2, sc->T, sc->IS_PROCEDURE)
+ s7_pointer p;
+
+ p = car(args);
+ switch (type(p))
+ {
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ return(closure_setter(p));
+
+ case T_C_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ return(c_function_setter(p));
+
+ case T_C_MACRO:
+ return(c_macro_setter(p));
+
+ case T_GOTO:
+ case T_CONTINUATION:
+ return(sc->F);
+
+ case T_LET:
+ case T_C_OBJECT:
+ check_method(sc, p, s7_make_symbol(sc, "procedure-setter"), args);
+ break;
+
+ case T_ITERATOR:
+ if (is_any_closure(iterator_sequence(p)))
+ return(closure_setter(iterator_sequence(p)));
+ return(sc->F);
+ }
+ return(s7_wrong_type_arg_error(sc, "procedure-setter", 0, p, "a procedure or a reasonable facsimile thereof"));
+}
+
+
+static s7_pointer g_procedure_set_setter(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p, setter;
+
+ p = car(args);
+ if (!is_procedure_or_macro(p))
+ return(s7_wrong_type_arg_error(sc, "set! procedure-setter procedure", 1, p, "a procedure"));
+
+ setter = cadr(args);
+ if ((setter != sc->F) &&
+ (!is_procedure_or_macro(setter)))
+ return(s7_wrong_type_arg_error(sc, "set! procedure-setter setter", 2, setter, "a procedure or #f"));
+
+ /* should we check that p != setter?
+ * :(set! (procedure-setter <) <)
+ * <
+ * :(set! (< 3 2) 3)
+ * #f
+ * :(set! (< 1) 2)
+ * #t
+ * can this make sense?
+ */
+
+ switch (type(p))
+ {
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ closure_setter(p) = setter;
+ break;
+
+ case T_C_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ c_function_setter(p) = setter;
+ if (is_any_closure(setter))
+ add_setter(sc, p, setter);
+ break;
+
+ case T_C_FUNCTION_STAR:
+ c_function_setter(p) = setter;
+ if (is_any_closure(setter))
+ add_setter(sc, p, setter);
+ break;
+
+ case T_C_MACRO:
+ if (is_any_closure(setter))
+ add_setter(sc, p, setter);
+ c_macro_setter(p) = setter;
+ break;
+
+ case T_GOTO:
+ return(s7_wrong_type_arg_error(sc, "set! procedure-setter", 1, p, "a normal procedure (not a call-with-exit exit procedure)"));
+
+ case T_CONTINUATION:
+ return(s7_wrong_type_arg_error(sc, "set! procedure-setter", 1, p, "a normal procedure"));
+ }
+ return(setter);
+}
+
+
+void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc, s7_function set_fnc, int req_args, int opt_args, const char *doc)
+{
+ s7_dilambda(sc, name, get_fnc, req_args, opt_args, set_fnc, req_args + 1, opt_args, doc);
+}
+
+
+
+/* -------------------------------- arity -------------------------------- */
+
+static s7_pointer closure_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args)
+{
+ /* x_args is unprocessed -- it is exactly the list as used in the closure[*] definition
+ */
+ int len;
+
+ if (is_symbol(x_args)) /* any number of args is ok */
+ return(s7_cons(sc, small_int(0), max_arity));
+
+ if (closure_arity_unknown(x))
+ closure_arity(x) = s7_list_length(sc, x_args);
+ len = closure_arity(x);
+ if (len < 0) /* dotted list => rest arg, (length '(a b . c)) is -2 */
+ return(s7_cons(sc, s7_make_integer(sc, -len), max_arity));
+ return(s7_cons(sc, s7_make_integer(sc, len), s7_make_integer(sc, len)));
+}
+
+static void closure_star_arity_1(s7_scheme *sc, s7_pointer x, s7_pointer args)
+{
+ if (closure_arity_unknown(x))
+ {
+ if (is_null(args))
+ closure_arity(x) = 0;
+ else
+ {
+ if (allows_other_keys(args))
+ closure_arity(x) = -1;
+ else
+ {
+ s7_pointer p;
+ int i;
+ for (i = 0, p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer arg;
+ arg = car(p);
+ if (arg == sc->KEY_REST)
+ break;
+ i++;
+ }
+ if (is_null(p))
+ closure_arity(x) = i;
+ else closure_arity(x) = -1; /* see below */
+ }
+ }
+ }
+}
+
+static s7_pointer closure_star_arity_to_cons(s7_scheme *sc, s7_pointer x, s7_pointer x_args)
+{
+ if (is_symbol(x_args))
+ return(s7_cons(sc, small_int(0), max_arity));
+
+ closure_star_arity_1(sc, x, x_args);
+
+ if (closure_arity(x) == -1)
+ return(s7_cons(sc, small_int(0), max_arity));
+ return(s7_cons(sc, small_int(0), s7_make_integer(sc, closure_arity(x))));
+}
+
+
+static int closure_arity_to_int(s7_scheme *sc, s7_pointer x)
+{
+ /* not lambda* here */
+ if (closure_arity_unknown(x))
+ {
+ int i;
+ s7_pointer b;
+ for (i = 0, b = closure_args(x); is_pair(b); i++, b = cdr(b)) {};
+ if (is_null(b))
+ closure_arity(x) = i;
+ else
+ {
+ if (i == 0)
+ return(-1);
+ closure_arity(x) = -i;
+ }
+ }
+ return(closure_arity(x));
+}
+
+
+static int closure_star_arity_to_int(s7_scheme *sc, s7_pointer x)
+{
+ /* not lambda here */
+ closure_star_arity_1(sc, x, closure_args(x));
+ return(closure_arity(x));
+}
+
+
+s7_pointer s7_arity(s7_scheme *sc, s7_pointer x)
+{
+ switch (type(x))
+ {
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION:
+ return(s7_cons(sc, s7_make_integer(sc, c_function_required_args(x)), s7_make_integer(sc, c_function_all_args(x))));
+
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ return(s7_cons(sc, small_int(0), s7_make_integer(sc, c_function_all_args(x)))); /* should this be *2? */
+
+ case T_MACRO:
+ case T_BACRO:
+ case T_CLOSURE:
+ return(closure_arity_to_cons(sc, x, closure_args(x)));
+
+ case T_MACRO_STAR:
+ case T_BACRO_STAR:
+ case T_CLOSURE_STAR:
+ return(closure_star_arity_to_cons(sc, x, closure_args(x)));
+
+ case T_C_MACRO:
+ return(s7_cons(sc, s7_make_integer(sc, c_macro_required_args(x)), s7_make_integer(sc, c_macro_all_args(x))));
+
+ case T_GOTO:
+ case T_CONTINUATION:
+ return(s7_cons(sc, small_int(0), max_arity));
+
+ case T_STRING:
+ if (string_length(x) == 0)
+ return(sc->F);
+
+ case T_LET:
+ /* check_method(sc, x, sc->ARITY, args); */
+ return(s7_cons(sc, small_int(1), small_int(1)));
+
+ case T_C_OBJECT:
+ /* check_method(sc, x, sc->ARITY, args); */
+ if (is_procedure(x))
+ return(s7_cons(sc, small_int(0), max_arity));
+ return(sc->F);
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ if (vector_length(x) == 0)
+ return(sc->F);
+
+ case T_PAIR:
+ case T_HASH_TABLE:
+ return(s7_cons(sc, small_int(1), max_arity));
+
+ case T_ITERATOR:
+ return(s7_cons(sc, small_int(0), small_int(0)));
+
+ case T_SYNTAX:
+ return(s7_cons(sc, small_int(syntax_min_args(x)), (syntax_max_args(x) == -1) ? max_arity : small_int(syntax_max_args(x))));
+ }
+ return(sc->F);
+}
+
+
+static s7_pointer g_arity(s7_scheme *sc, s7_pointer args)
+{
+ #define H_arity "(arity obj) the min and max acceptable args for obj if it is applicable, otherwise #f."
+ #define Q_arity pcl_t
+ /* check_method(sc, p, sc->ARITY, args); */
+ return(s7_arity(sc, car(args)));
+}
+
+PF_TO_PF(arity, s7_arity)
+
+
+static bool closure_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int args)
+{
+ /* x_args is unprocessed -- it is exactly the list as used in the closure definition
+ */
+ int len;
+
+ if (args == 0)
+ return(!is_pair(x_args));
+
+ if (is_symbol(x_args)) /* any number of args is ok */
+ return(true);
+
+ len = closure_arity(x);
+ if (len == CLOSURE_ARITY_NOT_SET)
+ {
+ len = s7_list_length(sc, x_args);
+ closure_arity(x) = len;
+ }
+ if (len < 0) /* dotted list => rest arg, (length '(a b . c)) is -2 */
+ return((-len) <= args); /* so we have enough to take care of the required args */
+ return(args == len); /* in a normal lambda list, there are no other possibilities */
+}
+
+
+static bool closure_star_is_aritable(s7_scheme *sc, s7_pointer x, s7_pointer x_args, int args)
+{
+ if (is_symbol(x_args))
+ return(true);
+
+ closure_star_arity_1(sc, x, x_args);
+ return((closure_arity(x) == -1) ||
+ (args <= closure_arity(x)));
+}
+
+
+bool s7_is_aritable(s7_scheme *sc, s7_pointer x, int args)
+{
+ switch (type(x))
+ {
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_FUNCTION:
+ return(((int)c_function_required_args(x) <= args) &&
+ ((int)c_function_all_args(x) >= args));
+
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ return((int)c_function_all_args(x) >= args);
+
+ case T_MACRO:
+ case T_BACRO:
+ case T_CLOSURE:
+ return(closure_is_aritable(sc, x, closure_args(x), args));
+
+ case T_MACRO_STAR:
+ case T_BACRO_STAR:
+ case T_CLOSURE_STAR:
+ return(closure_star_is_aritable(sc, x, closure_args(x), args));
+
+ case T_C_MACRO:
+ return(((int)c_macro_required_args(x) <= args) &&
+ ((int)c_macro_all_args(x) >= args));
+
+ case T_GOTO:
+ case T_CONTINUATION:
+ return(true);
+
+ case T_STRING:
+ return((args == 1) &&
+ (string_length(x) > 0)); /* ("" 0) -> error */
+
+ case T_C_OBJECT:
+ /* check_method(sc, x, sc->IS_ARITABLE, list_2(sc, x, s7_make_integer(sc, args))); -- see below */
+ return(is_procedure(x)); /* i.e. is_applicable */
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return((args > 0) &&
+ (vector_length(x) > 0) && /* (#() 0) -> error */
+ ((unsigned int)args <= vector_rank(x)));
+
+ case T_LET:
+ /* check_method(sc, x, sc->IS_ARITABLE, list_2(sc, x, s7_make_integer(sc, args))); */
+ /* this slows us down a lot */
+ case T_HASH_TABLE:
+ case T_PAIR:
+ return(args == 1);
+
+ case T_ITERATOR:
+ return(args == 0);
+
+ case T_SYNTAX:
+ return((args >= syntax_min_args(x)) && ((args <= syntax_max_args(x)) || (syntax_max_args(x) == -1)));
+ }
+ return(false);
+}
+
+static s7_pointer g_is_aritable(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_aritable "(aritable? obj num-args) returns #t if 'obj can be applied to 'num-args arguments."
+ #define Q_is_aritable s7_make_signature(sc, 3, sc->IS_BOOLEAN, sc->T, sc->IS_INTEGER)
+
+ s7_pointer n;
+ s7_int num;
+
+ n = cadr(args);
+ if (!s7_is_integer(n)) /* remember gmp case! */
+ method_or_bust(sc, n, sc->IS_ARITABLE, args, T_INTEGER, 2);
+
+ num = s7_integer(n);
+ if (num < 0)
+ return(out_of_range(sc, sc->IS_ARITABLE, small_int(2), n, ITS_NEGATIVE));
+ if (num > MAX_ARITY) num = MAX_ARITY;
+
+ return(make_boolean(sc, s7_is_aritable(sc, car(args), (int)num)));
+}
+
+static s7_pointer c_is_aritable(s7_scheme *sc, s7_pointer x, s7_int y) {return(make_boolean(sc, s7_is_aritable(sc, x, y)));}
+PIF_TO_PF(is_aritable, c_is_aritable)
+
+
+static s7_pointer is_aritable_ic;
+static s7_pointer g_is_aritable_ic(s7_scheme *sc, s7_pointer args)
+{
+ return(make_boolean(sc, s7_is_aritable(sc, car(args), (int)integer(cadr(args)))));
+}
+
+static s7_pointer is_aritable_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+ if ((s7_is_integer(arg2)) &&
+ (s7_integer(arg2) < MAX_ARITY) &&
+ (s7_integer(arg2) >= 0))
+ return(is_aritable_ic);
+ }
+ return(f);
+}
+
+
+/* -------- sequence? -------- */
+static s7_pointer g_is_sequence(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_sequence "(sequence? obj) returns #t if obj is a sequence (vector, string, pair, etc)"
+ #define Q_is_sequence pl_bt
+ check_boolean_method(sc, is_simple_sequence, sc->IS_SEQUENCE, args);
+}
+
+
+
+/* -------------------------------- symbol-access ------------------------------------------------ */
+
+static unsigned int protect_accessor(s7_scheme *sc, s7_pointer acc)
+{
+ unsigned int loc;
+ if (sc->protected_accessors_size == sc->protected_accessors_loc)
+ {
+ int i, new_size, size;
+ size = sc->protected_accessors_size;
+ new_size = 2 * size;
+ vector_elements(sc->protected_accessors) = (s7_pointer *)realloc(vector_elements(sc->protected_accessors), new_size * sizeof(s7_pointer));
+ vector_length(sc->protected_accessors) = new_size;
+ for (i = size; i < new_size; i++)
+ vector_element(sc->protected_accessors, i) = sc->GC_NIL;
+ sc->protected_accessors_size = new_size;
+ }
+ loc = sc->protected_accessors_loc++;
+ vector_element(sc->protected_accessors, loc) = acc;
+ return(loc);
+}
+
+s7_pointer s7_symbol_access(s7_scheme *sc, s7_pointer sym)
+{
+ /* these refer to the rootlet */
+ if ((is_slot(global_slot(sym))) &&
+ (slot_has_accessor(global_slot(sym))))
+ return(s7_gc_protected_at(sc, symbol_global_accessor_index(sym)));
+ return(sc->F);
+}
+
+
+s7_pointer s7_symbol_set_access(s7_scheme *sc, s7_pointer symbol, s7_pointer func)
+{
+ if (slot_has_accessor(global_slot(symbol)))
+ {
+ unsigned int index;
+ index = symbol_global_accessor_index(symbol);
+ if (is_immutable(vector_element(sc->protected_accessors, index)))
+ return(func);
+ vector_element(sc->protected_accessors, index) = func;
+ }
+ else
+ {
+ if (func != sc->F)
+ {
+ slot_set_has_accessor(global_slot(symbol));
+ symbol_set_has_accessor(symbol);
+ symbol_global_accessor_index(symbol) = protect_accessor(sc, func);
+ }
+ }
+ slot_accessor(global_slot(symbol)) = func;
+ return(func);
+}
+
+/* (let () (define xxx 23) (define (hix) (set! xxx 24)) (hix) (set! (symbol-access 'xxx) (lambda (sym val) (format *stderr* "val: ~A~%" val) val)) (hix))
+ * so set symbol-access before use!
+ */
+
+static s7_pointer g_symbol_access(s7_scheme *sc, s7_pointer args)
+{
+ #define H_symbol_access "(symbol-access sym (env (curlet))) is the function called when the symbol is set!."
+ #define Q_symbol_access s7_make_signature(sc, 3, sc->T, sc->IS_SYMBOL, sc->IS_LET)
+ s7_pointer sym, p, e;
+
+ sym = car(args);
+ if (!is_symbol(sym))
+ method_or_bust(sc, sym, sc->SYMBOL_ACCESS, args, T_SYMBOL, 0);
+ if (is_keyword(sym))
+ return(sc->F);
+
+ if (is_pair(cdr(args)))
+ {
+ e = cadr(args);
+ if (!is_let(e))
+ return(wrong_type_argument(sc, sc->SYMBOL_ACCESS, 2, e, T_LET));
+ }
+ else e = sc->envir;
+
+ if ((e == sc->rootlet) ||
+ (e == sc->NIL))
+ return(s7_symbol_access(sc, sym));
+
+ if (is_null(cdr(args)))
+ p = find_symbol(sc, sym);
+ else p = find_local_symbol(sc, sym, e);
+
+ if ((is_slot(p)) &&
+ (slot_has_accessor(p)))
+ return(slot_accessor(p));
+ return(sc->F);
+}
+
+
+static s7_pointer g_symbol_set_access(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer sym, func, e, p;
+ /* perhaps: check func */
+
+ sym = car(args);
+ if (!is_symbol(sym)) /* no check method because no method name? */
+ return(s7_wrong_type_arg_error(sc, "set! symbol-access", 1, sym, "a symbol"));
+ if (is_keyword(sym))
+ return(s7_wrong_type_arg_error(sc, "set! symbol-access", 1, sym, "a normal symbol (a keyword can't be set)"));
+
+ /* (set! (symbol-access sym) f) or (set! (symbol-access sym env) f) */
+ if (is_pair(cddr(args)))
+ {
+ e = cadr(args);
+ if (!is_let(e))
+ return(s7_wrong_type_arg_error(sc, "set! symbol-access", 2, e, "a let"));
+ func = caddr(args);
+ }
+ else
+ {
+ e = sc->envir;
+ func = cadr(args);
+ }
+
+ if ((!is_procedure_or_macro(func)) &&
+ (func != sc->F))
+ return(s7_wrong_type_arg_error(sc, "set! symbol-access", 3, func, "a function or #f"));
+
+ if ((e == sc->rootlet) ||
+ (e == sc->NIL))
+ {
+ if (!is_slot(global_slot(sym)))
+ return(sc->F);
+ return(s7_symbol_set_access(sc, sym, func));
+ }
+
+ if (is_null(cddr(args)))
+ p = find_symbol(sc, sym);
+ else p = find_local_symbol(sc, sym, e);
+
+ if (is_slot(p))
+ {
+ slot_accessor(p) = func;
+ if (func != sc->F)
+ {
+ slot_set_has_accessor(p);
+ symbol_set_has_accessor(sym);
+ }
+ return(func);
+ }
+ return(sc->F);
+}
+
+
+static s7_pointer bind_accessed_symbol(s7_scheme *sc, opcode_t op, s7_pointer symbol, s7_pointer new_value)
+{
+ /* this refers to (define (sym ...)) and friends -- define cases
+ * see call_accessor for the set! cases
+ */
+ s7_pointer func;
+
+ func = g_symbol_access(sc, set_plist_2(sc, symbol, sc->envir));
+ if (is_procedure_or_macro(func))
+ {
+ if (is_c_function(func))
+ {
+ s7_pointer old_value;
+ old_value = new_value;
+ car(sc->T2_1) = symbol;
+ car(sc->T2_2) = new_value;
+ new_value = c_function_call(func)(sc, sc->T2_1);
+ if (new_value == sc->ERROR)
+ return(s7_error(sc, sc->ERROR, set_elist_3(sc, make_string_wrapper(sc, "can't bind ~S to ~S"), symbol, old_value)));
+ }
+ else
+ {
+ sc->args = list_2(sc, symbol, new_value);
+ push_stack(sc, op, sc->args, sc->code);
+ sc->code = func;
+ return(sc->NO_VALUE); /* this means the accessor in set! needs to goto APPLY to get the new value */
+ }
+ }
+ return(new_value);
+}
+
+
+
+/* -------------------------------- hooks -------------------------------- */
+
+s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook)
+{
+ return(s7_symbol_local_value(sc, sc->BODY, closure_let(hook)));
+}
+
+
+s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions)
+{
+ if (s7_is_list(sc, functions))
+ s7_let_set(sc, closure_let(hook), sc->BODY, functions);
+ return(functions);
+}
+
+
+
+/* -------------------------------- eq etc -------------------------------- */
+
+bool s7_is_eq(s7_pointer obj1, s7_pointer obj2)
+{
+ return(obj1 == obj2); /* so floats and NaNs might be eq? but not eqv? */
+}
+
+
+static s7_pointer g_is_eq(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_eq "(eq? obj1 obj2) returns #t if obj1 is eq to (the same object as) obj2"
+ #define Q_is_eq pcl_bt
+ return(make_boolean(sc, ((car(args) == cadr(args)) ||
+ ((is_unspecified(car(args))) && (is_unspecified(cadr(args)))))));
+ /* (eq? (apply apply apply values '(())) #<unspecified>) should return #t
+ */
+}
+
+
+bool s7_is_eqv(s7_pointer a, s7_pointer b)
+{
+ if ((a == b) && (!is_number(a)))
+ return(true);
+
+#if WITH_GMP
+ if ((is_big_number(a)) || (is_big_number(b)))
+ return(big_numbers_are_eqv(a, b));
+#endif
+
+ if (type(a) != type(b))
+ return(false);
+
+ if (is_string(a))
+ return(string_value(a) == string_value(b));
+
+ if (s7_is_number(a))
+ return(numbers_are_eqv(a, b));
+
+ if (is_unspecified(a)) /* types are the same so we know b is also unspecified */
+ return(true);
+
+ return(false);
+}
+
+
+static s7_pointer g_is_eqv(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_eqv "(eqv? obj1 obj2) returns #t if obj1 is equivalent to obj2"
+ #define Q_is_eqv pcl_bt
+ return(make_boolean(sc, s7_is_eqv(car(args), cadr(args))));
+}
+
+
+
+static bool floats_are_morally_equal(s7_scheme *sc, s7_double x, s7_double y)
+{
+ if (x == y) return(true);
+
+ if ((is_NaN(x)) || (is_NaN(y)))
+ return((is_NaN(x)) && (is_NaN(y)));
+
+ return(fabs(x - y) <= sc->morally_equal_float_epsilon);
+}
+
+static bool eq_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return(x == y);
+}
+
+static bool symbol_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ if (x == y) return(true);
+ if (!is_symbol(y)) return(false); /* (morally-equal? ''(1) '(1)) */
+ if (!morally) return(false);
+ return((is_slot(global_slot(x))) && /* the optimizer can replace the original symbol with its own */
+ (is_syntax(slot_value(global_slot(x)))) &&
+ (is_slot(global_slot(y))) &&
+ (is_syntax(slot_value(global_slot(y)))) &&
+ (syntax_symbol(slot_value(global_slot(x))) == syntax_symbol(slot_value(global_slot(y)))));
+}
+
+static bool unspecified_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return(is_unspecified(y));
+}
+
+static bool c_pointer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((s7_is_c_pointer(y)) && (raw_pointer(x) == raw_pointer(y)));
+}
+
+static bool string_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((is_string(y)) && (scheme_strings_are_equal(x, y)));
+}
+
+static bool syntax_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((is_syntax(y)) && (syntax_symbol(x) == syntax_symbol(y)));
+}
+
+static bool c_object_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((is_c_object(y)) && (objects_are_equal(sc, x, y)));
+}
+
+static bool port_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ if (x == y) return(true);
+ if ((!morally) || (type(x) != type(y)) || (port_type(x) != port_type(y))) return(false);
+ if ((port_is_closed(x)) && (port_is_closed(y))) return(true);
+ return((is_string_port(x)) &&
+ (port_position(x) == port_position(y)) &&
+ (port_data_size(x) == port_data_size(y)) &&
+ (local_strncmp((const char *)port_data(x), (const char *)port_data(y), (is_input_port(x)) ? port_data_size(x) : port_position(x))));
+}
+
+static int equal_ref(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ /* here we know x and y are pointers to the same type of structure */
+ int ref_x, ref_y;
+ ref_x = peek_shared_ref(ci, x);
+ ref_y = peek_shared_ref(ci, y);
+
+ if ((ref_x != 0) && (ref_y != 0))
+ return((ref_x == ref_y) ? 1 : 0);
+
+ /* try to harmonize the new guy -- there can be more than one structure equal to the current one */
+ if (ref_x != 0)
+ add_shared_ref(ci, y, ref_x);
+ else
+ {
+ if (ref_y != 0)
+ add_shared_ref(ci, x, ref_y);
+ else add_equal_ref(ci, x, y);
+ }
+ return(-1);
+}
+
+static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally);
+
+static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ hash_entry_t **lists;
+ int i, len;
+ shared_info *nci = ci;
+
+ if (x == y)
+ return(true);
+ if (!is_hash_table(y))
+ {
+ if ((morally) && (has_methods(y)))
+ {
+ s7_pointer equal_func;
+ equal_func = find_method(sc, find_let(sc, y), sc->IS_MORALLY_EQUAL);
+ if (equal_func != sc->UNDEFINED)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, y, x))));
+ }
+ return(false);
+ }
+ if (ci)
+ {
+ i = equal_ref(sc, x, y, ci);
+ if (i == 0) return(false);
+ if (i == 1) return(true);
+ }
+
+ if (hash_table_entries(x) != hash_table_entries(y))
+ return(false);
+ if (hash_table_entries(x) == 0)
+ return(true);
+ if ((!morally) &&
+ ((hash_table_checker_locked(x)) || (hash_table_checker_locked(y))))
+ {
+ if (hash_table_checker(x) != hash_table_checker(y))
+ return(false);
+ if (hash_table_mapper(x) != hash_table_mapper(y))
+ return(false);
+ }
+
+ len = hash_table_mask(x) + 1;
+ lists = hash_table_elements(x);
+ if (!nci) nci = new_shared_info(sc);
+
+ for (i = 0; i < len; i++)
+ {
+ hash_entry_t *p;
+ for (p = lists[i]; p; p = p->next)
+ {
+ hash_entry_t *y_val;
+ y_val = (*hash_table_checker(y))(sc, y, p->key);
+
+ if ((!y_val) ||
+ (!s7_is_equal_1(sc, p->value, y_val->value, nci, morally)))
+ return(false);
+ }
+ }
+ /* if we get here, every key/value in x has a corresponding key/value in y, and the number of entries match,
+ * so surely the tables are equal??
+ */
+ return(true);
+}
+
+
+static bool slots_match(s7_scheme *sc, s7_pointer px, s7_pointer y, bool morally, shared_info *nci)
+{
+ s7_pointer ey, py;
+ for (ey = y; (is_let(ey)) && (ey != sc->rootlet); ey = outlet(ey))
+ for (py = let_slots(ey); is_slot(py); py = next_slot(py))
+ if (slot_symbol(px) == slot_symbol(py)) /* we know something will match */
+ return(s7_is_equal_1(sc, slot_value(px), slot_value(py), nci, morally));
+ return(false);
+}
+
+static bool let_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ /* x == y if all unshadowed vars match, leaving aside the rootlet, so that for any local variable,
+ * we get the same value in either x or y.
+ */
+
+ s7_pointer ex, ey, px, py;
+ shared_info *nci = ci;
+ int x_len, y_len;
+
+ if (x == y)
+ return(true);
+
+ if (morally)
+ {
+ s7_pointer equal_func;
+ if (has_methods(x))
+ {
+ equal_func = find_method(sc, find_let(sc, x), sc->IS_MORALLY_EQUAL);
+ if (equal_func != sc->UNDEFINED)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, x, y))));
+ }
+ if (has_methods(y))
+ {
+ equal_func = find_method(sc, find_let(sc, y), sc->IS_MORALLY_EQUAL);
+ if (equal_func != sc->UNDEFINED)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, y, x))));
+ }
+ }
+ if (!is_let(y))
+ return(false);
+ if ((x == sc->rootlet) || (y == sc->rootlet))
+ return(false);
+
+ if (ci)
+ {
+ int i;
+ i = equal_ref(sc, x, y, ci);
+ if (i == 0) return(false);
+ if (i == 1) return(true);
+ }
+
+ clear_syms_in_list(sc);
+ for (x_len = 0, ex = x; (is_let(ex)) && (ex != sc->rootlet); ex = outlet(ex))
+ for (px = let_slots(ex); is_slot(px); px = next_slot(px))
+ if (symbol_tag(slot_symbol(px)) != sc->syms_tag)
+ {
+ add_sym_to_list(sc, slot_symbol(px));
+ x_len++;
+ }
+
+ for (ey = y; (is_let(ey)) && (ey != sc->rootlet); ey = outlet(ey))
+ for (py = let_slots(ey); is_slot(py); py = next_slot(py))
+ if (symbol_tag(slot_symbol(py)) != sc->syms_tag) /* symbol in y, not in x */
+ return(false);
+
+ for (y_len = 0, ey = y; (is_let(ey)) && (ey != sc->rootlet); ey = outlet(ey))
+ for (py = let_slots(ey); is_slot(py); py = next_slot(py))
+ if (symbol_tag(slot_symbol(py)) != 0)
+ {
+ y_len ++;
+ symbol_tag(slot_symbol(py)) = 0;
+ }
+
+ if (x_len != y_len) /* symbol in x, not in y */
+ return(false);
+
+ if (!nci) nci = new_shared_info(sc);
+
+ for (ex = x; (is_let(ex)) && (ex != sc->rootlet); ex = outlet(ex))
+ for (px = let_slots(ex); is_slot(px); px = next_slot(px))
+ if (symbol_tag(slot_symbol(px)) == 0) /* unshadowed */
+ {
+ symbol_tag(slot_symbol(px)) = sc->syms_tag; /* values don't match */
+ if (!slots_match(sc, px, y, morally, nci))
+ return(false);
+ }
+ return(true);
+}
+
+static bool closure_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ if (x == y)
+ return(true);
+ if (type(x) != type(y))
+ return(false);
+ if ((has_methods(x)) &&
+ (has_methods(y)))
+ {
+ s7_pointer equal_func;
+ equal_func = find_method(sc, closure_let(x), (morally) ? sc->IS_MORALLY_EQUAL : sc->IS_EQUAL);
+ if (equal_func != sc->UNDEFINED)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, x, y))));
+ }
+ /* not sure about this -- we can't simply check let_equal(closure_let(x), closure_let(y))
+ * because locally defined constant functions on the second pass find the outer let.
+ */
+ return((morally) &&
+ (s7_is_equal_1(sc, closure_args(x), closure_args(y), ci, morally)) &&
+ (s7_is_equal_1(sc, closure_body(x), closure_body(y), ci, morally)));
+}
+
+static bool pair_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ int i;
+ s7_pointer px, py;
+ shared_info *nci = ci;
+
+ if (x == y)
+ return(true);
+ if (!is_pair(y))
+ {
+ if ((morally) && (has_methods(y)))
+ {
+ s7_pointer equal_func;
+ equal_func = find_method(sc, find_let(sc, y), sc->IS_MORALLY_EQUAL);
+ if (equal_func != sc->UNDEFINED)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, y, x))));
+ }
+ return(false);
+ }
+ if (ci)
+ {
+ i = equal_ref(sc, x, y, ci);
+ if (i == 0) return(false);
+ if (i == 1) return(true);
+ }
+ else nci = new_shared_info(sc);
+
+ if (!s7_is_equal_1(sc, car(x), car(y), nci, morally)) return(false);
+ for (px = cdr(x), py = cdr(y); (is_pair(px)) && (is_pair(py)); px = cdr(px), py = cdr(py))
+ {
+ if (!s7_is_equal_1(sc, car(px), car(py), nci, morally)) return(false);
+ i = equal_ref(sc, px, py, nci);
+ if (i == 0) return(false);
+ if (i == 1) return(true);
+ }
+ return(s7_is_equal_1(sc, px, py, nci, morally));
+}
+
+static bool vector_rank_match(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ int x_dims, y_dims;
+
+ if (vector_has_dimensional_info(x))
+ x_dims = vector_ndims(x);
+ else x_dims = 1;
+ if (vector_has_dimensional_info(y))
+ y_dims = vector_ndims(y);
+ else y_dims = 1;
+
+ if (x_dims != y_dims)
+ return(false);
+
+ if (x_dims > 1)
+ {
+ int j;
+ for (j = 0; j < x_dims; j++)
+ if (vector_dimension(x, j) != vector_dimension(y, j))
+ return(false);
+ }
+ return(true);
+}
+
+
+static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ s7_int i, len;
+ shared_info *nci = ci;
+
+ if (x == y)
+ return(true);
+ if (!s7_is_vector(y))
+ {
+ if ((morally) && (has_methods(y)))
+ {
+ s7_pointer equal_func;
+ equal_func = find_method(sc, find_let(sc, y), sc->IS_MORALLY_EQUAL);
+ if (equal_func != sc->UNDEFINED)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, y, x))));
+ }
+ return(false);
+ }
+ len = vector_length(x);
+ if (len != vector_length(y)) return(false);
+ if (len == 0)
+ {
+ if (morally) return(true);
+ if (!vector_rank_match(sc, x, y))
+ return(false);
+ return(true);
+ }
+ if (!vector_rank_match(sc, x, y))
+ return(false);
+
+ if (type(x) != type(y))
+ {
+ if (!morally) return(false);
+ /* (morally-equal? (make-int-vector 3 0) (make-vector 3 0)) -> #t
+ * (morally-equal? (make-float-vector 3 1.0) (vector 1 1 1)) -> #t
+ */
+ for (i = 0; i < len; i++)
+ if (!s7_is_equal_1(sc, vector_getter(x)(sc, x, i), vector_getter(y)(sc, y, i), NULL, true)) /* this could be greatly optimized */
+ return(false);
+ return(true);
+ }
+
+ if (is_float_vector(x))
+ {
+ if (!morally)
+ {
+ for (i = 0; i < len; i++)
+ {
+ s7_double z;
+ z = float_vector_element(x, i);
+ if ((is_NaN(z)) ||
+ (z != float_vector_element(y, i)))
+ return(false);
+ }
+ return(true);
+ }
+ else
+ {
+ s7_double *arr1, *arr2;
+ s7_double fudge;
+ arr1 = float_vector_elements(x);
+ arr2 = float_vector_elements(y);
+ fudge = sc->morally_equal_float_epsilon;
+ if (fudge == 0.0)
+ {
+ for (i = 0; i < len; i++)
+ if ((arr1[i] != arr2[i]) &&
+ ((!is_NaN(arr1[i])) || (!is_NaN(arr2[i]))))
+ return(false);
+ }
+ else
+ {
+ for (i = 0; i < len; i++)
+ {
+ s7_double diff;
+ diff = fabs(arr1[i] - arr2[i]);
+ if (diff > fudge) return(false);
+ if ((is_NaN(diff)) &&
+ ((!is_NaN(arr1[i])) || (!is_NaN(arr2[i]))))
+ return(false);
+ }
+ }
+ return(true);
+ }
+ }
+
+ if (is_int_vector(x))
+ {
+ for (i = 0; i < len; i++)
+ if (int_vector_element(x, i) != int_vector_element(y, i))
+ return(false);
+ return(true);
+ }
+
+ if (ci)
+ {
+ i = equal_ref(sc, x, y, ci);
+ if (i == 0) return(false);
+ if (i == 1) return(true);
+ }
+ else nci = new_shared_info(sc);
+
+ for (i = 0; i < len; i++)
+ if (!(s7_is_equal_1(sc, vector_element(x, i), vector_element(y, i), nci, morally)))
+ return(false);
+ return(true);
+}
+
+static bool iterator_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ if (x == y) return(true);
+ if (!is_iterator(y)) return(false);
+
+ switch (type(iterator_sequence(x)))
+ {
+ case T_STRING:
+ return((is_string(iterator_sequence(y))) &&
+ (iterator_position(x) == iterator_position(y)) &&
+ (string_equal(sc, iterator_sequence(x), iterator_sequence(y), ci, morally)));
+
+ case T_VECTOR:
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ return((s7_is_vector(iterator_sequence(y))) &&
+ (iterator_position(x) == iterator_position(y)) &&
+ (vector_equal(sc, iterator_sequence(x), iterator_sequence(y), ci, morally)));
+
+ case T_PAIR:
+ return((iterator_sequence(x) == iterator_sequence(y)) &&
+ (iterator_next(x) == iterator_next(y)) && /* even if seqs are equal, one might be at end */
+ (iterator_current(x) == iterator_current(y))); /* current pointer into the sequence */
+
+ case T_HASH_TABLE:
+ return((iterator_sequence(x) == iterator_sequence(y)) &&
+ (iterator_next(x) == iterator_next(y)) &&
+ (iterator_current(x) == iterator_current(y)) &&
+ (iterator_hash_current(x) == iterator_hash_current(y)) &&
+ (iterator_position(x) == iterator_position(y)));
+
+ default:
+ break;
+ }
+ return(false);
+}
+
+static bool bignum_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ if (!s7_is_number(y)) return(false);
+#if WITH_GMP
+ if (!morally)
+ return(big_numbers_are_eqv(x, y));
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
+#else
+ return(false);
+#endif
+}
+
+static bool integer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+#if WITH_GMP
+ if (is_big_number(y))
+ {
+ if (!morally)
+ return(big_numbers_are_eqv(x, y));
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
+ }
+#endif
+ if (is_integer(y))
+ return(integer(x) == integer(y));
+ if ((!morally) || (!is_number(y)))
+ return(false);
+
+ if (is_t_real(y))
+ return((!is_NaN(real(y))) &&
+ (fabs(integer(x) - real(y)) <= sc->morally_equal_float_epsilon));
+
+ if (is_t_ratio(y))
+ return(s7_fabsl(integer(x) - fraction(y)) <= sc->morally_equal_float_epsilon);
+
+ return((!is_NaN(real_part(y))) &&
+ (!is_NaN(imag_part(y))) &&
+ (fabs(integer(x) - real_part(y)) <= sc->morally_equal_float_epsilon) &&
+ (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+}
+
+/* apparently ratio_equal is predefined in g++ -- name collision on mac */
+static bool fraction_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+#if WITH_GMP
+ if (is_big_number(y))
+ {
+ if (!morally)
+ return(big_numbers_are_eqv(x, y));
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
+ }
+#endif
+ if (!morally)
+ return((s7_is_ratio(y)) &&
+ (numerator(x) == numerator(y)) &&
+ (denominator(x) == denominator(y)));
+
+ if (is_t_ratio(y))
+ return(s7_fabsl(fraction(x) - fraction(y)) <= sc->morally_equal_float_epsilon);
+
+ if (is_t_real(y))
+ return(floats_are_morally_equal(sc, fraction(x), real(y)));
+
+ if (is_integer(y))
+ return(s7_fabsl(fraction(x) - integer(y)) <= sc->morally_equal_float_epsilon);
+
+ if (is_t_complex(y))
+ return((!is_NaN(real_part(y))) &&
+ (!is_NaN(imag_part(y))) &&
+ (s7_fabsl(fraction(x) - real_part(y)) <= sc->morally_equal_float_epsilon) &&
+ (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+ return(false);
+}
+
+static bool real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+#if WITH_GMP
+ if (is_big_number(y))
+ {
+ if (!morally)
+ return(big_numbers_are_eqv(x, y));
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
+ }
+#endif
+ if (!morally)
+ return((is_t_real(y)) &&
+ (real(x) == real(y)));
+ if (!is_number(y)) return(false);
+
+ if (is_t_real(y))
+ return(floats_are_morally_equal(sc, real(x), real(y)));
+
+ if (is_integer(y))
+ return((!is_NaN(real(x))) &&
+ (fabs(real(x) - integer(y)) <= sc->morally_equal_float_epsilon));
+
+ if (is_t_ratio(y))
+ return(floats_are_morally_equal(sc, real(x), fraction(y)));
+
+ if (is_NaN(real(x)))
+ return((is_NaN(real_part(y))) &&
+ (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+
+ return((!is_NaN(real(x))) &&
+ (!is_NaN(real_part(y))) &&
+ (!is_NaN(imag_part(y))) &&
+ ((real(x) == real_part(y)) ||
+ (fabs(real(x) - real_part(y)) <= sc->morally_equal_float_epsilon)) &&
+ (fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
+}
+
+static bool complex_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+#if WITH_GMP
+ if (is_big_number(y))
+ {
+ if (!morally)
+ return(big_numbers_are_eqv(x, y));
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
+ }
+#endif
+ if (!morally)
+ return((is_t_complex(y)) &&
+ (!is_NaN(real_part(x))) &&
+ (!is_NaN(imag_part(x))) &&
+ (real_part(x) == real_part(y)) &&
+ (imag_part(x) == imag_part(y)));
+ if (!is_number(y)) return(false);
+
+ if (is_integer(y))
+ return((!is_NaN(real_part(x))) &&
+ (!is_NaN(imag_part(x))) &&
+ (fabs(real_part(x) - integer(y)) <= sc->morally_equal_float_epsilon) &&
+ (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+
+ if (s7_is_ratio(y))
+ return((!is_NaN(real_part(x))) &&
+ (!is_NaN(imag_part(x))) &&
+ (s7_fabsl(real_part(x) - fraction(y)) <= sc->morally_equal_float_epsilon) &&
+ (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+
+ if (is_real(y))
+ {
+ if (is_NaN(imag_part(x)))
+ return(false);
+ if (is_NaN(real(y)))
+ return((is_NaN(real_part(x))) &&
+ (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+ return(((real_part(x) == real(y)) ||
+ (fabs(real_part(x) - real(y)) <= sc->morally_equal_float_epsilon)) &&
+ (fabs(imag_part(x)) <= sc->morally_equal_float_epsilon));
+ }
+
+ /* should (morally-equal? nan.0 (complex nan.0 nan.0)) be #t (it's #f above)? */
+ if (is_NaN(real_part(x)))
+ return((is_NaN(real_part(y))) &&
+ (((is_NaN(imag_part(x))) && (is_NaN(imag_part(y)))) ||
+ (imag_part(x) == imag_part(y)) ||
+ (fabs(imag_part(x) - imag_part(y)) <= sc->morally_equal_float_epsilon)));
+
+ if (is_NaN(imag_part(x)))
+ return((is_NaN(imag_part(y))) &&
+ ((real_part(x) == real_part(y)) ||
+ (fabs(real_part(x) - real_part(y)) <= sc->morally_equal_float_epsilon)));
+
+ if ((is_NaN(real_part(y))) ||
+ (is_NaN(imag_part(y))))
+ return(false);
+
+ return(((real_part(x) == real_part(y)) ||
+ (fabs(real_part(x) - real_part(y)) <= sc->morally_equal_float_epsilon)) &&
+ ((imag_part(x) == imag_part(y)) ||
+ (fabs(imag_part(x) - imag_part(y)) <= sc->morally_equal_float_epsilon)));
+}
+
+static bool rng_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+#if WITH_GMP
+ return(x == y);
+#else
+ return((x == y) ||
+ ((is_random_state(y)) &&
+ (random_seed(x) == random_seed(y)) &&
+ (random_carry(x) == random_carry(y))));
+#endif
+}
+
+
+
+static bool (*equals[NUM_TYPES])(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally);
+
+static void init_equals(void)
+{
+ int i;
+ for (i = 0; i < NUM_TYPES; i++) equals[i] = eq_equal;
+ equals[T_SYMBOL] = symbol_equal;
+ equals[T_C_POINTER] = c_pointer_equal;
+ equals[T_UNSPECIFIED] = unspecified_equal;
+ equals[T_STRING] = string_equal;
+ equals[T_SYNTAX] = syntax_equal;
+ equals[T_C_OBJECT] = c_object_equal;
+ equals[T_RANDOM_STATE] = rng_equal;
+ equals[T_ITERATOR] = iterator_equal;
+ equals[T_INPUT_PORT] = port_equal;
+ equals[T_OUTPUT_PORT] = port_equal;
+ equals[T_MACRO] = closure_equal;
+ equals[T_MACRO_STAR] = closure_equal;
+ equals[T_BACRO] = closure_equal;
+ equals[T_BACRO_STAR] = closure_equal;
+ equals[T_CLOSURE] = closure_equal;
+ equals[T_CLOSURE_STAR] = closure_equal;
+ equals[T_HASH_TABLE] = hash_table_equal;
+ equals[T_LET] = let_equal;
+ equals[T_PAIR] = pair_equal;
+ equals[T_VECTOR] = vector_equal;
+ equals[T_INT_VECTOR] = vector_equal;
+ equals[T_FLOAT_VECTOR] = vector_equal;
+ equals[T_INTEGER] = integer_equal;
+ equals[T_RATIO] = fraction_equal;
+ equals[T_REAL] = real_equal;
+ equals[T_COMPLEX] = complex_equal;
+ equals[T_BIG_INTEGER] = bignum_equal;
+ equals[T_BIG_RATIO] = bignum_equal;
+ equals[T_BIG_REAL] = bignum_equal;
+ equals[T_BIG_COMPLEX] = bignum_equal;
+}
+
+static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
+ return((*(equals[type(x)]))(sc, x, y, ci, morally));
+}
+
+bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ return(s7_is_equal_1(sc, x, y, NULL, false));
+}
+
+bool s7_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ return(s7_is_equal_1(sc, x, y, NULL, true));
+}
+
+static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_equal "(equal? obj1 obj2) returns #t if obj1 is equal to obj2"
+ #define Q_is_equal pcl_bt
+ return(make_boolean(sc, s7_is_equal(sc, car(args), cadr(args))));
+}
+
+static s7_pointer g_is_morally_equal(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_morally_equal "(morally-equal? obj1 obj2) returns #t if obj1 is close enough to obj2."
+ #define Q_is_morally_equal pcl_bt
+ return(make_boolean(sc, s7_is_morally_equal(sc, car(args), cadr(args))));
+}
+
+
+
+/* ---------------------------------------- length, copy, fill ---------------------------------------- */
+
+static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst)
+{
+ switch (type(lst))
+ {
+ case T_PAIR:
+ {
+ int len;
+ len = s7_list_length(sc, lst);
+ /* len < 0 -> dotted and (abs len) is length not counting the final cdr
+ * len == 0, circular so length is infinite
+ */
+ if (len == 0)
+ return(real_infinity);
+ return(make_integer(sc, len));
+ }
+
+ case T_NIL:
+ return(small_int(0));
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(make_integer(sc, vector_length(lst)));
+
+ case T_STRING:
+ return(make_integer(sc, string_length(lst)));
+
+ case T_ITERATOR:
+ return(make_integer(sc, iterator_length(lst))); /* in several cases, this is incorrect */
+
+ case T_HASH_TABLE:
+ return(make_integer(sc, hash_table_mask(lst) + 1));
+
+ case T_C_OBJECT:
+ check_method(sc, lst, sc->LENGTH, list_1(sc, lst));
+ return(object_length(sc, lst));
+
+ case T_LET:
+ check_method(sc, lst, sc->LENGTH, list_1(sc, lst));
+ return(make_integer(sc, let_length(sc, lst)));
+
+ case T_CLOSURE:
+ case T_CLOSURE_STAR:
+ if (has_methods(lst))
+ return(make_integer(sc, closure_length(sc, lst)));
+ return(sc->F);
+
+ case T_INPUT_PORT:
+ if (is_string_port(lst))
+ return(make_integer(sc, port_data_size(lst)));
+ return(sc->F);
+
+ default:
+ return(sc->F);
+ }
+ return(sc->F);
+}
+
+static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
+{
+ #define H_length "(length obj) returns the length of obj, which can be a list, vector, string, or hash-table. \
+The length of a dotted list does not include the final cdr, and is returned as a negative number. A circular \
+list has infinite length. Length of anything else returns #f."
+ #define Q_length pcl_t
+ return(s7_length(sc, car(args)));
+}
+
+/* what about (length file)? input port, read_file gets the file length, so perhaps save it
+ * but we're actually looking at the port, so its length is what remains to be read? (if input port)
+ */
+
+PF_TO_PF(length, s7_length)
+
+
+
+/* -------------------------------- copy -------------------------------- */
+
+static s7_pointer copy_to_string_error = NULL, copy_to_byte_vector_error = NULL;
+
+static void set_string_error_source(s7_scheme *sc, s7_pointer source)
+{
+ if (!copy_to_string_error)
+ copy_to_string_error = s7_make_permanent_string("copy ~A to string, ~S is not a character");
+ if (!copy_to_byte_vector_error)
+ copy_to_byte_vector_error = s7_make_permanent_string("copy ~A to byte-vector, ~S is not a byte");
+ cadr(sc->elist_3) = prepackaged_type_name(sc, source);
+}
+
+static s7_pointer string_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
+{
+ if (s7_is_character(val))
+ {
+ string_value(str)[loc] = s7_character(val);
+ return(val);
+ }
+ /* (copy #(3) "123"): wrong type arg because not a char, but it's very confusing to report
+ * error: copy argument 3, 3, is an integer but should be a character
+ * perhaps better, copy #(3) to string, 3 is not a character
+ */
+#if DEBUGGING
+ if (!copy_to_string_error) {fprintf(stderr, "string_error not set\n"); abort();}
+#endif
+ car(sc->elist_3) = copy_to_string_error;
+ caddr(sc->elist_3) = val;
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, sc->elist_3));
+}
+
+static s7_pointer byte_vector_setter(s7_scheme *sc, s7_pointer str, s7_int loc, s7_pointer val)
+{
+ if (s7_is_integer(val))
+ {
+ s7_int byte;
+ byte = s7_integer(val);
+ if ((byte >= 0) && (byte < 256))
+ string_value(str)[loc] = (unsigned char)byte;
+ else return(simple_wrong_type_argument_with_type(sc, sc->COPY, val, AN_UNSIGNED_BYTE));
+ return(val);
+ }
+#if DEBUGGING
+ if (!copy_to_byte_vector_error) {fprintf(stderr, "byte_vector_error not set\n"); abort();}
+#endif
+ car(sc->elist_3) = copy_to_byte_vector_error;
+ caddr(sc->elist_3) = val;
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, sc->elist_3));
+}
+
+static s7_pointer string_getter(s7_scheme *sc, s7_pointer str, s7_int loc)
+{
+ return(s7_make_character(sc, (unsigned char)(string_value(str)[loc]))); /* cast needed else (copy (string (integer->char 255))...) is trouble */
+}
+
+static s7_pointer byte_vector_getter(s7_scheme *sc, s7_pointer str, s7_int loc)
+{
+ return(make_integer(sc, (unsigned char)(string_value(str)[loc])));
+}
+
+static s7_pointer c_object_setter(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_pointer val)
+{
+ car(sc->T2_1) = make_integer(sc, loc);
+ car(sc->T2_2) = val;
+ return((*(c_object_set(obj)))(sc, obj, sc->T2_1));
+}
+
+static s7_pointer c_object_getter(s7_scheme *sc, s7_pointer obj, s7_int loc)
+{
+ car(sc->T1_1) = make_integer(sc, loc);
+ return((*(c_object_ref(obj)))(sc, obj, sc->T1_1));
+}
+
+static s7_pointer let_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
+{
+ /* loc is irrelevant here
+ * val has to be of the form (cons symbol value)
+ * if symbol is already in e, its value is changed, otherwise a new slot is added to e
+ */
+ static s7_pointer ls_err = NULL;
+ s7_pointer sym;
+ if (!is_pair(val))
+ {
+ if (!ls_err) ls_err = s7_make_permanent_string("(cons symbol value)");
+ return(wrong_type_argument_with_type(sc, sc->COPY, 3, e, ls_err));
+ }
+ sym = car(val);
+ if (!is_symbol(sym))
+ {
+ if (!ls_err) ls_err = s7_make_permanent_string("(cons symbol value)");
+ return(wrong_type_argument_with_type(sc, sc->COPY, 3, e, ls_err));
+ }
+ if ((symbol_id(sym) < let_id(e)) ||
+ (s7_let_set(sc, e, sym, cdr(val)) != cdr(val)))
+ make_slot_1(sc, e, sym, cdr(val));
+ return(val);
+}
+
+static s7_pointer hash_table_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
+{
+ /* loc is irrelevant here
+ * val has to be of the form (cons key value)
+ * if key is already in e, its value is changed, otherwise a new slot is added to e
+ */
+ if (!is_pair(val))
+ return(wrong_type_argument_with_type(sc, sc->COPY, 1, e, A_LIST));
+ return(s7_hash_table_set(sc, e, car(val), cdr(val)));
+}
+
+
+s7_pointer s7_copy(s7_scheme *sc, s7_pointer args)
+{
+ #define H_copy "(copy obj) returns a copy of obj, (copy src dest) copies src into dest, (copy src dest start end) copies src from start to end."
+ #define Q_copy s7_make_circular_signature(sc, 3, 4, sc->T, sc->IS_SEQUENCE, sc->IS_SEQUENCE, sc->IS_INTEGER)
+
+ s7_pointer source, dest;
+ s7_int i, j, dest_len, start, end, source_len;
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_pointer val) = NULL;
+ s7_pointer (*get)(s7_scheme *sc, s7_pointer obj, s7_int loc) = NULL;
+ bool have_indices;
+
+ source = car(args);
+ if (is_null(cdr(args))) /* (copy obj) */
+ {
+ switch (type(source))
+ {
+ case T_STRING:
+ {
+ s7_pointer ns;
+ ns = s7_make_string_with_length(sc, string_value(source), string_length(source));
+ if (is_byte_vector(source))
+ set_byte_vector(ns);
+ return(ns);
+ }
+
+ case T_C_OBJECT:
+ return(object_copy(sc, args));
+
+ case T_RANDOM_STATE:
+ return(rng_copy(sc, args));
+
+ case T_HASH_TABLE: /* this has to copy nearly everything */
+ {
+ int gc_loc;
+ s7_pointer new_hash;
+ new_hash = s7_make_hash_table(sc, hash_table_mask(source) + 1);
+ gc_loc = s7_gc_protect(sc, new_hash);
+ hash_table_checker(new_hash) = hash_table_checker(source);
+ hash_table_mapper(new_hash) = hash_table_mapper(source);
+ hash_table_procedures(new_hash) = hash_table_procedures(source);
+ hash_table_copy(sc, source, new_hash, 0, hash_table_entries(source));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(new_hash);
+ }
+
+ case T_ITERATOR:
+ return(iterator_copy(sc, source));
+
+ case T_LET:
+ check_method(sc, source, sc->COPY, args);
+ return(let_copy(sc, source)); /* this copies only the local env and points to outer envs */
+
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ check_method(sc, source, sc->COPY, args);
+ return(copy_closure(sc, source));
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(s7_vector_copy(sc, source)); /* "shallow" copy */
+
+ case T_PAIR: /* top level only, as in the other cases, last arg checks for circles */
+ return(protected_list_copy(sc, source));
+
+ case T_INTEGER:
+ new_cell(sc, dest, T_INTEGER);
+ integer(dest) = integer(source);
+ return(dest);
+
+ case T_RATIO:
+ new_cell(sc, dest, T_RATIO);
+ numerator(dest) = numerator(source);
+ denominator(dest) = denominator(source);
+ return(dest);
+
+ case T_REAL:
+ new_cell(sc, dest, T_REAL);
+ set_real(dest, real(source));
+ return(dest);
+
+ case T_COMPLEX:
+ new_cell(sc, dest, T_COMPLEX);
+ set_real_part(dest, real_part(source));
+ set_imag_part(dest, imag_part(source));
+ return(dest);
+
+#if WITH_GMP
+ case T_BIG_INTEGER: return(mpz_to_big_integer(sc, big_integer(source)));
+ case T_BIG_RATIO: return(mpq_to_big_ratio(sc, big_ratio(source)));
+ case T_BIG_REAL: return(mpfr_to_big_real(sc, big_real(source)));
+ case T_BIG_COMPLEX: return(mpc_to_big_complex(sc, big_complex(source)));
+#endif
+
+ case T_C_POINTER:
+ return(s7_make_c_pointer(sc, s7_c_pointer(source)));
+ }
+ return(source);
+ }
+
+ have_indices = (is_pair(cddr(args)));
+ dest = cadr(args);
+ if ((source == dest) && (!have_indices))
+ return(dest);
+
+ switch (type(source))
+ {
+ case T_PAIR:
+ if (dest == sc->KEY_READABLE) /* a kludge, but I can't think of anything less stupid */
+ return(copy_body(sc, source));
+
+ end = s7_list_length(sc, source);
+ if (end == 0)
+ end = circular_list_entries(source);
+ else
+ {
+ if (end < 0) end = -end;
+ }
+ break;
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ get = vector_getter(source);
+ end = vector_length(source);
+ break;
+
+ case T_STRING:
+ if (is_byte_vector(source))
+ get = byte_vector_getter;
+ else get = string_getter;
+ end = string_length(source);
+ break;
+
+ case T_HASH_TABLE:
+ end = hash_table_entries(source);
+ break;
+
+ case T_C_OBJECT:
+ check_method(sc, source, sc->COPY, args);
+ {
+ s7_pointer x;
+ x = object_copy(sc, args);
+ if (x == dest)
+ return(dest);
+ /* if object_copy can't handle args for some reason, it should return #f (not dest), and we'll soldier on... */
+ }
+ get = c_object_direct_ref(source);
+ if (!get) get = c_object_getter;
+ end = object_length_to_int(sc, source);
+ break;
+
+ case T_LET:
+ check_method(sc, source, sc->COPY, args);
+ if (source == sc->rootlet)
+ return(wrong_type_argument_with_type(sc, sc->COPY, 1, source, make_string_wrapper(sc, "a sequence other than the rootlet")));
+ end = let_length(sc, source);
+ break;
+
+ case T_NIL:
+ end = 0;
+ if (is_sequence(dest))
+ break;
+
+ default:
+ return(wrong_type_argument_with_type(sc, sc->COPY, 1, source, A_SEQUENCE));
+ /* copy doesn't have to duplicate fill!, so (copy 1 #(...)) need not be supported */
+ }
+
+ start = 0;
+ if (have_indices)
+ {
+ s7_pointer p;
+ p = start_and_end(sc, sc->COPY, NULL, cddr(args), args, 3, &start, &end);
+ if (p != sc->GC_NIL) return(p);
+ }
+ if ((start == 0) && (source == dest))
+ return(dest);
+ source_len = end - start;
+
+ switch (type(dest))
+ {
+ case T_PAIR:
+ dest_len = s7_list_length(sc, dest);
+ if (dest_len == 0)
+ dest_len = circular_list_entries(dest);
+ else
+ {
+ if (dest_len < 0)
+ dest_len = -dest_len;
+ }
+ break;
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ set = vector_setter(dest);
+ dest_len = vector_length(dest);
+ break;
+
+ case T_STRING:
+ if (is_byte_vector(dest))
+ set = byte_vector_setter;
+ else set = string_setter;
+ dest_len = string_length(dest);
+ break;
+
+ case T_HASH_TABLE:
+ set = hash_table_setter;
+ dest_len = source_len;
+ break;
+
+ case T_C_OBJECT:
+ set = c_object_direct_set(dest);
+ if (!set) set = c_object_setter;
+ dest_len = object_length_to_int(sc, dest);
+ break;
+
+ case T_LET:
+ if (dest == sc->rootlet)
+ return(wrong_type_argument_with_type(sc, sc->COPY, 2, dest, make_string_wrapper(sc, "a sequence other than the rootlet")));
+ set = let_setter;
+ dest_len = source_len; /* grows via set, so dest_len isn't relevant */
+ break;
+
+ case T_NIL:
+ return(sc->NIL);
+
+ default:
+ return(wrong_type_argument_with_type(sc, sc->COPY, 2, dest, A_SEQUENCE));
+ }
+
+ if ((source_len == 0) || (dest_len == 0))
+ return(dest);
+
+ /* end is source_len if not set explicitly */
+ if (dest_len < source_len)
+ {
+ end = dest_len + start;
+ source_len = dest_len;
+ }
+
+ if ((source != dest) &&
+ (type(source) == type(dest)))
+ {
+ switch (type(source))
+ {
+ case T_PAIR:
+ {
+ s7_pointer ps, pd;
+
+ ps = source;
+ for (i = 0; i < start; i++)
+ ps = cdr(ps);
+ for (pd = dest; (i < end) && is_pair(ps) && is_pair(pd); i++, ps = cdr(ps), pd = cdr(pd))
+ car(pd) = car(ps);
+ return(dest);
+ }
+
+ case T_VECTOR:
+ memcpy((void *)(vector_elements(dest)), (void *)((vector_elements(source)) + start), source_len * sizeof(s7_pointer));
+ return(dest);
+
+ case T_INT_VECTOR:
+ memcpy((void *)(int_vector_elements(dest)), (void *)((int_vector_elements(source)) + start), source_len * sizeof(s7_int));
+ return(dest);
+
+ case T_FLOAT_VECTOR:
+ memcpy((void *)(float_vector_elements(dest)), (void *)((float_vector_elements(source)) + start), source_len * sizeof(s7_double));
+ return(dest);
+
+ case T_STRING: /* this is 4 cases (string/byte-vector) */
+ memcpy((void *)string_value(dest), (void *)((string_value(source)) + start), source_len * sizeof(char));
+ return(dest);
+
+ case T_C_OBJECT:
+ {
+ s7_pointer mi, mj;
+ int gc_loc1, gc_loc2;
+ s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
+ s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args);
+
+ mi = make_mutable_integer(sc, start);
+ mj = make_mutable_integer(sc, end);
+ gc_loc1 = s7_gc_protect(sc, mi);
+ gc_loc2 = s7_gc_protect(sc, mj);
+ ref = c_object_ref(source);
+ set = c_object_set(dest);
+
+ for (i = start, j = 0; i < end; i++, j++)
+ {
+ integer(mi) = i;
+ integer(mj) = j;
+ car(sc->T1_1) = mi;
+ car(sc->T2_2) = ref(sc, source, sc->T1_1);
+ car(sc->T2_1) = mj;
+ set(sc, dest, sc->T2_1);
+ }
+ s7_gc_unprotect_at(sc, gc_loc1);
+ s7_gc_unprotect_at(sc, gc_loc2);
+ return(dest);
+ }
+
+ case T_LET:
+ break;
+
+ case T_HASH_TABLE:
+ {
+ s7_pointer p;
+ p = hash_table_copy(sc, source, dest, start, end);
+ if ((hash_table_checker(source) != hash_table_checker(dest)) &&
+ (!hash_table_checker_locked(dest)))
+ {
+ if (hash_table_checker(dest) == hash_empty)
+ hash_table_checker(dest) = hash_table_checker(source);
+ else hash_table_checker(dest) = hash_equal;
+ }
+ return(p);
+ }
+ break;
+
+ default:
+ return(dest);
+ }
+ }
+
+ switch (type(source))
+ {
+ case T_PAIR:
+ {
+ s7_pointer p;
+ p = source;
+ if (start > 0)
+ for (i = 0; i < start; i++)
+ p = cdr(p);
+ /* dest won't be a pair here -- the pair->pair case was caught above */
+ if (is_string(dest)) set_string_error_source(sc, source);
+ for (i = start, j = 0; i < end; i++, j++, p = cdr(p))
+ set(sc, dest, j, car(p));
+ return(dest);
+ }
+
+ case T_LET:
+ /* implicit index can give n-way reality check (ht growth by new entries)
+ * if shadowed entries are they unshadowed by reversal?
+ */
+ {
+ /* source and dest can't be rootlet (checked above) */
+ s7_pointer slot;
+ slot = let_slots(source);
+ for (i = 0; i < start; i++) slot = next_slot(slot);
+ if (is_pair(dest))
+ {
+ s7_pointer p;
+ for (i = start, p = dest; i < end; i++, p = cdr(p), slot = next_slot(slot))
+ car(p) = cons(sc, slot_symbol(slot), slot_value(slot));
+ }
+ else
+ {
+ if (is_let(dest))
+ {
+ for (i = start; i < end; i++, slot = next_slot(slot))
+ make_slot_1(sc, dest, slot_symbol(slot), slot_value(slot));
+ }
+ else
+ {
+ if (is_hash_table(dest))
+ {
+ for (i = start; i < end; i++, slot = next_slot(slot))
+ s7_hash_table_set(sc, dest, slot_symbol(slot), slot_value(slot));
+ }
+ else
+ {
+ for (i = start, j = 0; i < end; i++, j++, slot = next_slot(slot))
+ set(sc, dest, j, cons(sc, slot_symbol(slot), slot_value(slot)));
+ }
+ }
+ }
+ return(dest);
+ }
+
+ case T_HASH_TABLE:
+ {
+ int loc, skip;
+ hash_entry_t **elements;
+ hash_entry_t *x = NULL;
+ elements = hash_table_elements(source);
+ loc = -1;
+
+ skip = start;
+ while (skip > 0)
+ {
+ while (!x) x = elements[++loc];
+ skip--;
+ x = x->next;
+ }
+
+ if (is_pair(dest))
+ {
+ s7_pointer p;
+ for (i = start, p = dest; i < end; i++, p = cdr(p))
+ {
+ while (!x) x = elements[++loc];
+ car(p) = cons(sc, x->key, x->value);
+ x = x->next;
+ }
+ }
+ else
+ {
+ if (is_let(dest))
+ {
+ for (i = start; i < end; i++)
+ {
+ while (!x) x = elements[++loc];
+ make_slot_1(sc, dest, x->key, x->value);
+ x = x->next;
+ }
+ }
+ else
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ {
+ while (!x) x = elements[++loc];
+ set(sc, dest, j, cons(sc, x->key, x->value));
+ x = x->next;
+ }
+ }
+ }
+ return(dest);
+ }
+
+ case T_FLOAT_VECTOR:
+ if (is_int_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ int_vector_element(dest, j) = (s7_int)(float_vector_element(source, i));
+ return(dest);
+ }
+ break;
+
+ case T_INT_VECTOR:
+ if (is_float_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ float_vector_element(dest, j) = (s7_double)(int_vector_element(source, i));
+ return(dest);
+ }
+ if (is_string(dest)) /* includes byte-vector, as below */
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ string_value(dest)[j] = (unsigned char)int_vector_element(source, i);
+ return(dest);
+ }
+ break;
+
+ case T_STRING:
+ if (is_normal_vector(dest))
+ {
+ if (is_byte_vector(source))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ vector_element(dest, j) = make_integer(sc, (s7_int)((unsigned char)string_value(source)[i]));
+ }
+ else
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ vector_element(dest, j) = s7_make_character(sc, (unsigned char)string_value(source)[i]);
+ }
+ return(dest);
+ }
+ if (is_int_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ int_vector_element(dest, j) = (s7_int)((unsigned char)(string_value(source)[i]));
+ return(dest);
+ }
+ if (is_float_vector(dest))
+ {
+ for (i = start, j = 0; i < end; i++, j++)
+ float_vector_element(dest, j) = (s7_double)((unsigned char)(string_value(source)[i]));
+ return(dest);
+ }
+ }
+
+ if (is_pair(dest))
+ {
+ s7_pointer p;
+ for (i = start, p = dest; i < end; i++, p = cdr(p))
+ car(p) = get(sc, source, i);
+ }
+ else
+ {
+ /* if source == dest here, we're moving data backwards, so this is safe in either case */
+ if (is_string(dest)) set_string_error_source(sc, source);
+ for (i = start, j = 0; i < end; i++, j++)
+ set(sc, dest, j, get(sc, source, i));
+ }
+ /* some choices probably should raise an error, but don't:
+ * (copy (make-hash-table) "1") ; nothing to copy (empty hash table), so no error
+ */
+ return(dest);
+}
+
+#define g_copy s7_copy
+
+static s7_pointer c_copy(s7_scheme *sc, s7_pointer x) {return(s7_copy(sc, set_plist_1(sc, x)));}
+PF_TO_PF(copy, c_copy)
+
+
+
+/* -------------------------------- reverse -------------------------------- */
+
+static s7_pointer g_reverse(s7_scheme *sc, s7_pointer args)
+{
+ #define H_reverse "(reverse lst) returns a list with the elements of lst in reverse order. reverse \
+also accepts a string or vector argument."
+ #define Q_reverse s7_make_signature(sc, 2, sc->IS_SEQUENCE, sc->IS_SEQUENCE)
+
+ s7_pointer p, np;
+
+ p = car(args);
+ sc->temp3 = p;
+ np = sc->NIL;
+
+ switch (type(p))
+ {
+ case T_NIL:
+ return(sc->NIL);
+
+ case T_PAIR:
+ return(s7_reverse(sc, p));
+
+ case T_STRING:
+ {
+ char *source, *dest, *end;
+ int len;
+ len = string_length(p);
+ source = string_value(p);
+ end = (char *)(source + len);
+ dest = (char *)malloc((len + 1) * sizeof(char));
+ dest[len] = 0;
+ np = make_string_uncopied_with_length(sc, dest, len);
+ dest += len;
+ while (source < end) *(--dest) = *source++;
+ if (is_byte_vector(p))
+ set_byte_vector(np);
+ }
+ break;
+
+ case T_INT_VECTOR:
+ {
+ s7_int *source, *dest, *end;
+ s7_int len;
+ len = vector_length(p);
+ if (vector_rank(p) > 1)
+ np = g_make_vector(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, p)), small_int(0), sc->T));
+ else np = make_vector_1(sc, len, NOT_FILLED, T_INT_VECTOR);
+ source = int_vector_elements(p);
+ end = (s7_int *)(source + len);
+ dest = (s7_int *)(int_vector_elements(np) + len);
+ while (source < end) *(--dest) = *source++;
+ }
+ break;
+
+ case T_FLOAT_VECTOR:
+ {
+ s7_double *source, *dest, *end;
+ s7_int len;
+ len = vector_length(p);
+ if (vector_rank(p) > 1)
+ np = g_make_vector(sc, set_plist_3(sc, g_vector_dimensions(sc, set_plist_1(sc, p)), real_zero, sc->T));
+ else np = make_vector_1(sc, len, NOT_FILLED, T_FLOAT_VECTOR);
+ source = float_vector_elements(p);
+ end = (s7_double *)(source + len);
+ dest = (s7_double *)(float_vector_elements(np) + len);
+ while (source < end) *(--dest) = *source++;
+ }
+ break;
+
+ case T_VECTOR:
+ {
+ s7_pointer *source, *dest, *end;
+ s7_int len;
+ len = vector_length(p);
+ if (vector_rank(p) > 1)
+ np = g_make_vector(sc, set_plist_1(sc, g_vector_dimensions(sc, list_1(sc, p))));
+ else np = make_vector_1(sc, len, NOT_FILLED, T_VECTOR);
+ source = vector_elements(p);
+ end = (s7_pointer *)(source + len);
+ dest = (s7_pointer *)(vector_elements(np) + len);
+ while (source < end) *(--dest) = *source++;
+ }
+ break;
+
+ case T_HASH_TABLE:
+ return(hash_table_reverse(sc, p));
+
+ case T_C_OBJECT:
+ check_method(sc, p, sc->REVERSE, args);
+ if (c_object_reverse(p))
+ return((*(c_object_reverse(p)))(sc, args));
+ eval_error(sc, "attempt to reverse ~S?", p);
+
+ default:
+ method_or_bust_with_type(sc, p, sc->REVERSE, args, A_SEQUENCE, 0);
+ }
+ return(np);
+}
+
+static s7_pointer c_reverse(s7_scheme *sc, s7_pointer x) {return(g_reverse(sc, set_plist_1(sc, x)));}
+PF_TO_PF(reverse, c_reverse)
+
+static s7_pointer c_reverse_in_place(s7_scheme *sc, s7_pointer p)
+{
+ switch (type(p))
+ {
+ case T_NIL:
+ return(sc->NIL);
+
+ case T_PAIR:
+ {
+ s7_pointer np;
+ np = reverse_in_place(sc, sc->NIL, p);
+ if (is_null(np))
+ return(simple_wrong_type_argument_with_type(sc, sc->REVERSEB, p, A_PROPER_LIST));
+ return(np);
+ }
+ break;
+ /* (reverse! p) is supposed to change p directly and lisp programmers expect reverse! to be fast
+ * so in a sense this is different from the other cases: it assumes (set! p (reverse! p))
+ * To make (reverse! p) direct:
+ * for (l = p, r = cdr(p); is_pair(r); l = r, r = cdr(r)) opt1(r) = l;
+ * if (!is_null(r)) return(simple_wrong_type_argument_with_type(sc, sc->REVERSEB, p, A_PROPER_LIST));
+ * for (r = l, l = p; l != r; l = cdr(l)) {t = car(l); car(l) = car(r); car(r) = t; if (cdr(l) != r) r = opt1(r);}
+ */
+
+ case T_STRING:
+ {
+ int len;
+ char *s1, *s2;
+ len = string_length(p);
+ if (len < 2) return(p);
+ s1 = string_value(p);
+ s2 = (char *)(s1 + len - 1);
+ while (s1 < s2) {char c; c = *s1; *s1++ = *s2; *s2-- = c;}
+ }
+ break;
+
+ case T_INT_VECTOR:
+ {
+ s7_int len;
+ s7_int *s1, *s2;
+ len = vector_length(p);
+ if (len < 2) return(p);
+ s1 = int_vector_elements(p);
+ s2 = (s7_int *)(s1 + len - 1);
+ while (s1 < s2) {s7_int c; c = *s1; *s1++ = *s2; *s2-- = c;}
+ }
+ break;
+
+ case T_FLOAT_VECTOR:
+ {
+ s7_int len;
+ s7_double *s1, *s2;
+ len = vector_length(p);
+ if (len < 2) return(p);
+ s1 = float_vector_elements(p);
+ s2 = (s7_double *)(s1 + len - 1);
+ while (s1 < s2) {s7_double c; c = *s1; *s1++ = *s2; *s2-- = c;}
+ }
+ break;
+
+ case T_VECTOR:
+ {
+ s7_int len;
+ s7_pointer *s1, *s2;
+ len = vector_length(p);
+ if (len < 2) return(p);
+ s1 = vector_elements(p);
+ s2 = (s7_pointer *)(s1 + len - 1);
+ while (s1 < s2) {s7_pointer c; c = *s1; *s1++ = *s2; *s2-- = c;}
+ }
+ break;
+
+ default:
+ if ((is_simple_sequence(p)) &&
+ (!has_methods(p)))
+ return(simple_wrong_type_argument_with_type(sc, sc->REVERSEB, p, make_string_wrapper(sc, "a vector, string, or list")));
+ method_or_bust_with_type(sc, p, sc->REVERSEB, list_1(sc, p), A_SEQUENCE, 0);
+ }
+ return(p);
+}
+
+static s7_pointer g_reverse_in_place(s7_scheme *sc, s7_pointer args)
+{
+ #define H_reverse_in_place "(reverse! lst) reverses lst in place"
+ #define Q_reverse_in_place s7_make_signature(sc, 2, sc->IS_SEQUENCE, sc->IS_SEQUENCE)
+ return(c_reverse_in_place(sc, car(args)));
+}
+
+PF_TO_PF(reverse_in_place, c_reverse_in_place)
+
+
+/* -------------------------------- fill! -------------------------------- */
+
+static s7_pointer list_fill(s7_scheme *sc, s7_pointer args)
+{
+ /* ambiguous ("tree-fill"?) but if it's like vector-fill, we just stomp on the top level */
+ s7_pointer x, y, obj, val;
+ s7_int i, start = 0, end, len;
+
+ obj = car(args);
+ len = s7_list_length(sc, obj);
+ end = len;
+ if (end < 0) end = -end; else {if (end == 0) end = 123123123;}
+ val = cadr(args);
+
+ if (!is_null(cddr(args)))
+ {
+ s7_pointer p;
+ p = start_and_end(sc, sc->FILL, sc->FILL, cddr(args), args, 3, &start, &end);
+ if (p != sc->GC_NIL) return(p);
+ if (start == end) return(val);
+ }
+
+ if (len > 0)
+ {
+ s7_int i;
+ s7_pointer p;
+ if (end < len) len = end;
+ for (i = 0, p = obj; i < start; p = cdr(p), i++);
+ for (; i < len; p = cdr(p), i++) car(p) = val;
+ return(val);
+ }
+
+ for (x = obj, y = obj, i = 0; ;i++)
+ {
+ if ((end > 0) && (i >= end))
+ return(val);
+ if (i >= start) car(x) = val;
+ if (!is_pair(cdr(x)))
+ {
+ if (!is_null(cdr(x)))
+ cdr(x) = val;
+ return(val);
+ }
+ x = cdr(x);
+ if ((i & 1) != 0) y = cdr(y);
+ if (x == y) return(val);
+ }
+ return(val);
+}
+
+
+s7_pointer s7_fill(s7_scheme *sc, s7_pointer args)
+{
+ #define H_fill "(fill! obj val (start 0) end) fills obj with val"
+ #define Q_fill s7_make_circular_signature(sc, 3, 4, sc->T, sc->IS_SEQUENCE, sc->T, sc->IS_INTEGER)
+ s7_pointer p;
+
+ p = car(args);
+ switch (type(p))
+ {
+ case T_STRING:
+ return(g_string_fill(sc, args)); /* redundant type check here and below */
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(g_vector_fill(sc, args));
+
+ case T_PAIR:
+ return(list_fill(sc, args));
+
+ case T_NIL:
+ return(cadr(args)); /* this parallels the empty vector case */
+
+ case T_HASH_TABLE:
+ return(hash_table_fill(sc, args));
+
+ case T_C_OBJECT:
+ check_method(sc, p, sc->FILL, args);
+ if (c_object_fill(p))
+ return((*(c_object_fill(p)))(sc, args));
+ eval_error(sc, "attempt to fill ~S?", p);
+
+ default:
+ check_method(sc, p, sc->FILL, args);
+ }
+ return(wrong_type_argument_with_type(sc, sc->FILL, 1, p, A_SEQUENCE)); /* (fill! 1 0) */
+}
+
+#define g_fill s7_fill
+/* perhaps (fill iterator obj) could fill the underlying sequence (if any) -- not let/closure
+ * similarly for length, reverse etc
+ */
+
+static s7_pointer c_fill(s7_scheme *sc, s7_pointer x, s7_pointer y) {return(s7_fill(sc, set_plist_2(sc, x, y)));}
+PF2_TO_PF(fill, c_fill)
+
+
+/* -------------------------------- append -------------------------------- */
+
+static s7_int sequence_length(s7_scheme *sc, s7_pointer lst)
+{
+ switch (type(lst))
+ {
+ case T_PAIR:
+ {
+ int len;
+ len = s7_list_length(sc, lst);
+ if (len == 0) return(-1);
+ return(len);
+ }
+ case T_NIL: return(0);
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR: return(vector_length(lst));
+ case T_STRING: return(string_length(lst));
+ case T_HASH_TABLE: return(hash_table_entries(lst));
+ case T_LET: return(let_length(sc, lst));
+ case T_C_OBJECT:
+ {
+ s7_pointer x;
+ x = object_length(sc, lst);
+ if (s7_is_integer(x))
+ return(s7_integer(x));
+ }
+ }
+ return(-1);
+}
+
+static s7_int total_sequence_length(s7_scheme *sc, s7_pointer args, s7_pointer caller, int typ)
+{
+ s7_pointer p;
+ int i;
+ s7_int len = 0;
+
+ for (i = 0, p = args; is_pair(p); p = cdr(p), i++)
+ {
+ s7_pointer seq;
+ s7_int n;
+ seq = car(p);
+ n = sequence_length(sc, seq);
+ if ((n > 0) && (typ != T_FREE) && ((type(seq) == T_HASH_TABLE) || (type(seq) == T_LET)))
+ {
+ wrong_type_argument(sc, sc->APPEND, i, seq, typ);
+ return(0);
+ }
+ if (n < 0)
+ {
+ wrong_type_argument_with_type(sc, sc->APPEND, i, seq, (is_pair(seq)) ? A_PROPER_LIST : A_SEQUENCE);
+ return(0);
+ }
+ len += n;
+ }
+ return(len);
+}
+
+static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int typ)
+{
+ s7_pointer new_vec;
+ s7_int len;
+
+ len = total_sequence_length(sc, args, sc->VECTOR_APPEND, (typ == T_VECTOR) ? T_FREE : ((typ == T_FLOAT_VECTOR) ? T_REAL : T_INTEGER));
+ new_vec = make_vector_1(sc, len, (typ == T_VECTOR) ? FILLED : NOT_FILLED, typ); /* might hit GC in loop below so we can't use NOT_FILLED here */
+
+ if (len > 0)
+ {
+ s7_pointer p, sv;
+ int i;
+
+ sc->temp9 = new_vec; /* s7_copy below can call s7_error so s7_gc_protect here is tricky -- use a preset position perhaps? */
+ sv = make_subvector(sc, new_vec);
+ sc->temp10 = sv;
+
+ for (i = 0, p = args; is_pair(p); p = cdr(p))
+ {
+ s7_int n;
+ s7_pointer x;
+ x = car(p);
+ n = sequence_length(sc, x);
+ if (n > 0)
+ {
+ vector_length(sv) = n;
+ s7_copy(sc, set_plist_2(sc, x, sv));
+ vector_length(sv) = 0; /* so GC doesn't march off the end */
+ i += n;
+ if (typ == T_VECTOR)
+ vector_elements(sv) = (s7_pointer *)(vector_elements(new_vec) + i);
+ else
+ {
+ if (typ == T_FLOAT_VECTOR)
+ float_vector_elements(sv) = (s7_double *)(float_vector_elements(new_vec) + i);
+ else int_vector_elements(sv) = (s7_int *)(int_vector_elements(new_vec) + i);
+ }
+ }
+ }
+ set_plist_2(sc, sc->NIL, sc->NIL);
+ sc->temp9 = sc->NIL;
+ sc->temp10 = sc->NIL;
+ vector_length(sv) = 0;
+ }
+ return(new_vec);
+}
+
+static s7_pointer string_append(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer new_str;
+ s7_int len;
+
+ len = total_sequence_length(sc, args, sc->STRING_APPEND, (is_byte_vector(car(args))) ? T_INTEGER : T_CHARACTER);
+ new_str = make_empty_string(sc, len, 0);
+ if (is_byte_vector(car(args)))
+ set_byte_vector(new_str);
+
+ if (len > 0)
+ {
+ s7_pointer p, sv;
+ int i;
+
+ sc->temp9 = new_str;
+ sv = make_string_wrapper_with_length(sc, (const char *)string_value(new_str), len);
+ if (is_byte_vector(new_str))
+ set_byte_vector(sv);
+ sc->temp10 = sv;
+
+ for (i = 0, p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ s7_int n;
+ x = car(p);
+ n = sequence_length(sc, x);
+ if (n > 0)
+ {
+ string_length(sv) = n;
+ s7_copy(sc, set_plist_2(sc, x, sv));
+ i += n;
+ string_value(sv) = (char *)(string_value(new_str) + i);
+ }
+ }
+ set_plist_2(sc, sc->NIL, sc->NIL);
+ sc->temp9 = sc->NIL;
+ sc->temp10 = sc->NIL;
+ string_length(sv) = 0;
+ }
+
+ return(new_str);
+}
+
+static s7_pointer hash_table_append(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer new_hash, p;
+ new_hash = s7_make_hash_table(sc, sc->default_hash_table_length);
+ for (p = args; is_pair(p); p = cdr(p))
+ s7_copy(sc, set_plist_2(sc, car(p), new_hash));
+ set_plist_2(sc, sc->NIL, sc->NIL);
+ return(new_hash);
+}
+
+static s7_pointer let_append(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer new_let, p, e;
+
+ e = car(args);
+ check_method(sc, e, sc->APPEND, args);
+ new_let = new_frame_in_env(sc, sc->NIL);
+ for (p = args; is_pair(p); p = cdr(p))
+ s7_copy(sc, set_plist_2(sc, car(p), new_let));
+ set_plist_2(sc, sc->NIL, sc->NIL);
+ return(new_let);
+}
+
+static s7_pointer g_append(s7_scheme *sc, s7_pointer args)
+{
+ #define H_append "(append ...) returns its argument sequences appended into one sequence"
+ #define Q_append s7_make_circular_signature(sc, 0, 1, sc->T)
+ s7_pointer a1;
+
+ if (is_null(args)) return(sc->NIL); /* (append) -> () */
+ a1 = car(args); /* first arg determines result type unless all args but last are empty (sigh) */
+ if (is_null(cdr(args))) return(a1); /* (append <anything>) -> <anything> */
+
+ switch (type(a1))
+ {
+ case T_NIL:
+ case T_PAIR:
+ return(g_list_append(sc, args)); /* only list case accepts any trailing arg because dotted lists are special */
+
+ case T_VECTOR:
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ return(vector_append(sc, args, type(a1)));
+
+ case T_STRING:
+ return(string_append(sc, args));
+
+ case T_HASH_TABLE:
+ return(hash_table_append(sc, args));
+
+ case T_LET:
+ return(let_append(sc, args));
+
+ default:
+ check_method(sc, a1, sc->APPEND, args);
+ }
+ return(wrong_type_argument_with_type(sc, sc->APPEND, 1, a1, A_SEQUENCE)); /* (append 1 0) */
+}
+
+static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj)
+{
+ /* used only in format_to_port_1 and (map values ...) */
+ switch (type(obj))
+ {
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(s7_vector_to_list(sc, obj));
+
+ case T_STRING:
+ if (is_byte_vector(obj))
+ return(byte_vector_to_list(sc, string_value(obj), string_length(obj)));
+ return(s7_string_to_list(sc, string_value(obj), string_length(obj)));
+
+ case T_HASH_TABLE:
+ if (hash_table_entries(obj) > 0)
+ {
+ s7_pointer x, iterator;
+ iterator = s7_make_iterator(sc, obj);
+ sc->temp8 = iterator;
+ sc->w = sc->NIL;
+ while (true)
+ {
+ x = s7_iterate(sc, iterator);
+ if (iterator_is_at_end(iterator)) break;
+ sc->w = cons(sc, x, sc->w);
+ }
+ x = sc->w;
+ sc->w = sc->NIL;
+ sc->temp8 = sc->NIL;
+ return(x);
+ }
+ return(sc->NIL);
+
+ case T_LET:
+#if (!WITH_PURE_S7)
+ check_method(sc, obj, sc->LET_TO_LIST, list_1(sc, obj));
+#endif
+ return(s7_let_to_list(sc, obj));
+
+ case T_ITERATOR:
+ {
+ s7_pointer result, p = NULL;
+ int results = 0;
+ result = sc->NIL;
+ while (true)
+ {
+ s7_pointer val;
+ val = s7_iterate(sc, obj);
+ if ((val == sc->ITERATOR_END) &&
+ (iterator_is_at_end(obj)))
+ {
+ sc->temp8 = sc->NIL;
+ return(result);
+ }
+ if (sc->safety > 0)
+ {
+ results++;
+ if (results > 10000)
+ {
+ fprintf(stderr, "iterator in object->list is creating a very long list!\n");
+ results = S7_LONG_MIN;
+ }
+ }
+ if (val != sc->NO_VALUE)
+ {
+ if (is_null(result))
+ {
+ if (is_multiple_value(val))
+ {
+ result = multiple_value(val);
+ clear_multiple_value(val);
+ for (p = result; is_pair(cdr(p)); p = cdr(p));
+ }
+ else
+ {
+ result = cons(sc, val, sc->NIL);
+ p = result;
+ }
+ sc->temp8 = result;
+ }
+ else
+ {
+ if (is_multiple_value(val))
+ {
+ cdr(p) = multiple_value(val);
+ clear_multiple_value(val);
+ for (; is_pair(cdr(p)); p = cdr(p));
+ }
+ else
+ {
+ cdr(p) = cons(sc, val, sc->NIL);
+ p = cdr(p);
+ }
+ }
+ }
+ }
+ }
+
+ case T_C_OBJECT:
+ {
+ long int i, len; /* the "long" matters on 64-bit machines */
+ s7_pointer x, z, result;
+ int gc_z = -1;
+
+ x = object_length(sc, obj);
+ if (s7_is_integer(x))
+ len = s7_integer(x);
+ else return(sc->F);
+
+ if (len < 0)
+ return(sc->F);
+ if (len == 0)
+ return(sc->NIL);
+
+ result = make_list(sc, len, sc->NIL);
+ sc->temp8 = result;
+ z = list_1(sc, sc->F);
+ gc_z = s7_gc_protect(sc, z);
+
+ car(sc->Z2_1) = sc->x;
+ car(sc->Z2_2) = sc->z;
+ for (i = 0, x = result; i < len; i++, x = cdr(x))
+ {
+ car(z) = make_integer(sc, i);
+ car(x) = (*(c_object_ref(obj)))(sc, obj, z);
+ }
+ sc->x = car(sc->Z2_1);
+ sc->z = car(sc->Z2_2);
+ s7_gc_unprotect_at(sc, gc_z);
+ sc->temp8 = sc->NIL;
+ return(result);
+ }
+ }
+ return(obj);
+}
+
+
+
+/* ---------------- stacktrace ---------------- */
+
+static s7_pointer stacktrace_find_caller(s7_scheme *sc, s7_pointer e)
+{
+ if ((is_let(e)) && (e != sc->rootlet))
+ {
+ if (is_function_env(e))
+ return(funclet_function(e));
+ return(stacktrace_find_caller(sc, outlet(e)));
+ }
+ return(sc->F);
+}
+
+static bool stacktrace_find_let(s7_scheme *sc, int loc, s7_pointer e)
+{
+ return((loc > 0) &&
+ ((stack_let(sc->stack, loc) == e) ||
+ (stacktrace_find_let(sc, loc - 4, e))));
+}
+
+static int stacktrace_find_error_hook_quit(s7_scheme *sc)
+{
+ int i;
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ if (stack_op(sc->stack, i) == OP_ERROR_HOOK_QUIT)
+ return(i);
+ return(-1);
+}
+
+static bool stacktrace_in_error_handler(s7_scheme *sc, int loc)
+{
+ return((outlet(sc->owlet) == sc->envir) ||
+ (stacktrace_find_let(sc, loc * 4, outlet(sc->owlet))) ||
+ (stacktrace_find_error_hook_quit(sc) > 0));
+}
+
+
+static bool stacktrace_error_hook_function(s7_scheme *sc, s7_pointer sym)
+{
+ if (is_symbol(sym))
+ {
+ s7_pointer f;
+ f = s7_symbol_value(sc, sym);
+ return((is_procedure(f)) &&
+ (is_procedure(sc->error_hook)) &&
+ (is_pair(s7_hook_functions(sc, sc->error_hook))) &&
+ (direct_memq(f, s7_hook_functions(sc, sc->error_hook))));
+ }
+ return(false);
+}
+
+static char *stacktrace_walker(s7_scheme *sc, s7_pointer code, s7_pointer e,
+ char *notes, int gc_syms,
+ int code_cols, int total_cols, int notes_start_col,
+ bool as_comment)
+{
+ s7_pointer syms;
+ syms = gc_protected_at(sc, gc_syms);
+
+ if (is_symbol(code))
+ {
+ if ((!direct_memq(code, syms)) &&
+ (!is_slot(global_slot(code))))
+ {
+ s7_pointer val;
+
+ syms = cons(sc, code, syms);
+ gc_protected_at(sc, gc_syms) = syms;
+
+ val = s7_symbol_local_value(sc, code, e);
+ if ((val) && (val != sc->UNDEFINED) &&
+ (!is_any_macro(val)))
+ {
+ int typ;
+
+ typ = type(val);
+ if (typ < T_GOTO)
+ {
+ char *objstr, *str;
+ const char *spaces;
+ int objlen, new_note_len, notes_max, cur_line_len = 0, spaces_len;
+ bool new_notes_line = false;
+
+ spaces = " ";
+ spaces_len = strlen(spaces);
+
+ if (notes_start_col < 0) notes_start_col = 50;
+ notes_max = total_cols - notes_start_col;
+ objstr = s7_object_to_c_string(sc, val);
+ objlen = strlen(objstr);
+ if (objlen > notes_max)
+ {
+ objstr[notes_max - 4] = '.';
+ objstr[notes_max - 3] = '.';
+ objstr[notes_max - 2] = '.';
+ objstr[notes_max - 1] = '\0';
+ objlen = notes_max;
+ }
+
+ new_note_len = symbol_name_length(code) + 3 + objlen;
+ /* we want to append this much info to the notes, but does it need a new line?
+ */
+ if (notes_start_col < code_cols)
+ new_notes_line = true;
+ else
+ {
+ if (notes)
+ {
+ char *last_newline;
+ last_newline = strrchr(notes, (int)'\n'); /* returns ptr to end if none = nil if not found? */
+ if (last_newline)
+ cur_line_len = strlen(notes) - strlen(last_newline);
+ else cur_line_len = strlen(notes);
+ new_notes_line = ((cur_line_len + new_note_len) > notes_max);
+ }
+ }
+
+ if (new_notes_line)
+ {
+ new_note_len += (4 + notes_start_col + ((notes) ? strlen(notes) : 0));
+ str = (char *)malloc(new_note_len * sizeof(char));
+ snprintf(str, new_note_len, "%s\n%s%s%s%s: %s",
+ (notes) ? notes : "",
+ (as_comment) ? "; " : "",
+ (spaces_len >= notes_start_col) ? (char *)(spaces + spaces_len - notes_start_col) : "",
+ (as_comment) ? "" : " ; ",
+ symbol_name(code),
+ objstr);
+ }
+ else
+ {
+ new_note_len += ((notes) ? strlen(notes) : 0) + 4;
+ str = (char *)malloc(new_note_len * sizeof(char));
+ snprintf(str, new_note_len, "%s%s%s: %s",
+ (notes) ? notes : "",
+ (notes) ? ", " : " ; ",
+ symbol_name(code),
+ objstr);
+ }
+ free(objstr);
+ if (notes) free(notes);
+ return(str);
+ }
+ }
+ }
+ return(notes);
+ }
+ if (is_pair(code))
+ {
+ notes = stacktrace_walker(sc, car(code), e, notes, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
+ return(stacktrace_walker(sc, cdr(code), e, notes, gc_syms, code_cols, total_cols, notes_start_col, as_comment));
+ }
+ return(notes);
+}
+
+static char *stacktrace_add_func(s7_scheme *sc, s7_pointer f, s7_pointer code, char *errstr, char *notes, int code_max, bool as_comment)
+{
+ int newlen, errlen;
+ char *newstr, *str;
+
+ errlen = strlen(errstr);
+ if ((is_symbol(f)) &&
+ (f != car(code)))
+ {
+ newlen = symbol_name_length(f) + errlen + 10;
+ newstr = (char *)malloc(newlen * sizeof(char));
+ errlen = snprintf(newstr, newlen, "%s: %s", symbol_name(f), errstr);
+ }
+ else
+ {
+ newlen = errlen + 8;
+ newstr = (char *)malloc(newlen * sizeof(char));
+ if ((errlen > 2) && (errstr[2] == '('))
+ errlen = snprintf(newstr, newlen, " %s", errstr);
+ else errlen = snprintf(newstr, newlen, "%s", errstr);
+ }
+
+ newlen = code_max + 8 + ((notes) ? strlen(notes) : 0);
+ str = (char *)malloc(newlen * sizeof(char));
+
+ if (errlen >= code_max)
+ {
+ newstr[code_max - 4] = '.';
+ newstr[code_max - 3] = '.';
+ newstr[code_max - 2] = '.';
+ newstr[code_max - 1] = '\0';
+ snprintf(str, newlen, "%s%s%s\n", (as_comment) ? "; " : "", newstr, (notes) ? notes : "");
+ }
+ else
+ {
+ /* send out newstr, pad with spaces to code_max, then notes */
+ int len;
+ len = snprintf(str, newlen, "%s%s", (as_comment) ? "; " : "", newstr);
+ if (notes)
+ {
+ int i;
+ for (i = len; i < code_max - 1; i++)
+ str[i] = ' ';
+ str[i] = '\0';
+#ifdef __OpenBSD__
+ strlcat(str, notes, newlen);
+ strlcat(str, "\n", newlen);
+#else
+ strcat(str, notes);
+ strcat(str, "\n");
+#endif
+ }
+ }
+ free(newstr);
+ return(str);
+}
+
+
+static char *stacktrace_1(s7_scheme *sc, int frames_max, int code_cols, int total_cols, int notes_start_col, bool as_comment)
+{
+ char *str;
+ int loc, top, frames = 0, gc_syms;
+
+ gc_syms = s7_gc_protect(sc, sc->NIL);
+ str = NULL;
+ top = (sc->stack_end - sc->stack_start) / 4; /* (*s7* 'stack_top), not s7_stack_top! */
+
+ if (stacktrace_in_error_handler(sc, top))
+ {
+ s7_pointer err_code;
+ err_code = slot_value(sc->error_code);
+ if (is_pair(err_code))
+ {
+ char *errstr, *notes = NULL;
+ s7_pointer cur_env, f;
+
+ errstr = s7_object_to_c_string(sc, err_code);
+ cur_env = outlet(sc->owlet);
+ f = stacktrace_find_caller(sc, cur_env); /* this is a symbol */
+ if ((is_let(cur_env)) &&
+ (cur_env != sc->rootlet))
+ notes = stacktrace_walker(sc, err_code, cur_env, NULL, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
+ str = stacktrace_add_func(sc, f, err_code, errstr, notes, code_cols, as_comment);
+ free(errstr);
+ }
+
+ /* now if OP_ERROR_HOOK_QUIT is in the stack, jump past it!
+ */
+ loc = stacktrace_find_error_hook_quit(sc);
+ if (loc > 0) top = (loc + 1) / 4;
+ }
+
+ for (loc = top - 1; loc > 0; loc--)
+ {
+ s7_pointer code;
+ int true_loc;
+
+ true_loc = (int)(loc + 1) * 4 - 1;
+ code = stack_code(sc->stack, true_loc);
+
+ if (is_pair(code))
+ {
+ char *codestr;
+ codestr = s7_object_to_c_string(sc, code);
+ if (codestr)
+ {
+ if ((!local_strcmp(codestr, "(result)")) &&
+ (!local_strcmp(codestr, "(#f)")) &&
+ (strstr(codestr, "(stacktrace)") == NULL) &&
+ (strstr(codestr, "(stacktrace ") == NULL))
+ {
+ s7_pointer e, f;
+
+ e = stack_let(sc->stack, true_loc);
+ f = stacktrace_find_caller(sc, e);
+ if (!stacktrace_error_hook_function(sc, f))
+ {
+ char *notes = NULL, *newstr;
+ int newlen;
+
+ frames++;
+ if (frames > frames_max)
+ {
+ free(codestr);
+ s7_gc_unprotect_at(sc, gc_syms);
+ return(str);
+ }
+
+ if ((is_let(e)) && (e != sc->rootlet))
+ notes = stacktrace_walker(sc, code, e, NULL, gc_syms, code_cols, total_cols, notes_start_col, as_comment);
+ newstr = stacktrace_add_func(sc, f, code, codestr, notes, code_cols, as_comment);
+ free(codestr);
+ if (notes) free(notes);
+
+ newlen = strlen(newstr) + 1 + ((str) ? strlen(str) : 0);
+ codestr = (char *)malloc(newlen * sizeof(char));
+ snprintf(codestr, newlen, "%s%s", (str) ? str : "", newstr);
+ if (str) free(str);
+ free(newstr);
+ str = codestr;
+ codestr = NULL;
+ }
+ else free(codestr);
+ }
+ else free(codestr);
+ }
+ }
+ }
+
+ s7_gc_unprotect_at(sc, gc_syms);
+ return(str);
+}
+
+
+s7_pointer s7_stacktrace(s7_scheme *sc)
+{
+ char *str;
+ str = stacktrace_1(sc, 30, 45, 80, 45, false);
+ return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
+}
+
+
+static s7_pointer g_stacktrace(s7_scheme *sc, s7_pointer args)
+{
+ #define H_stacktrace "(stacktrace (max-frames 30) (code-cols 50) (total-cols 80) (note-col 50) as-comment) returns \
+a stacktrace as a string. Each line has two portions, the code being evaluated and a note giving \
+the value of local variables in that code. The first argument sets how many lines are displayed. \
+The next three arguments set the length and layout of those lines. 'as-comment' if #t causes each \
+line to be preceded by a semicolon."
+ #define Q_stacktrace s7_make_signature(sc, 6, sc->IS_STRING, sc->IS_INTEGER, sc->IS_INTEGER, sc->IS_INTEGER, sc->IS_INTEGER, sc->IS_BOOLEAN)
+
+ s7_int max_frames = 30, code_cols = 50, total_cols = 80, notes_start_col = 50;
+ bool as_comment = false;
+ char *str;
+
+ if (!is_null(args))
+ {
+ if (s7_is_integer(car(args)))
+ {
+ max_frames = s7_integer(car(args));
+ if ((max_frames <= 0) || (max_frames > s7_int32_max))
+ max_frames = 30;
+ args = cdr(args);
+ if (!is_null(args))
+ {
+ if (s7_is_integer(car(args)))
+ {
+ code_cols = s7_integer(car(args));
+ if ((code_cols <= 8) || (code_cols > s7_int32_max))
+ code_cols = 50;
+ args = cdr(args);
+ if (!is_null(args))
+ {
+ if (s7_is_integer(car(args)))
+ {
+ total_cols = s7_integer(car(args));
+ if ((total_cols <= code_cols) || (total_cols > s7_int32_max))
+ total_cols = 80;
+ args = cdr(args);
+ if (!is_null(args))
+ {
+ if (s7_is_integer(car(args)))
+ {
+ notes_start_col = s7_integer(car(args));
+ if ((notes_start_col <= 0) || (notes_start_col > s7_int32_max))
+ notes_start_col = 50;
+ args = cdr(args);
+ if (!is_null(args))
+ {
+ if (s7_is_boolean(car(args)))
+ as_comment = s7_boolean(sc, car(args));
+ else return(wrong_type_argument(sc, sc->STACKTRACE, 5, car(args), T_BOOLEAN));
+ }
+ }
+ else return(wrong_type_argument(sc, sc->STACKTRACE, 4, car(args), T_INTEGER));
+ }
+ }
+ else return(wrong_type_argument(sc, sc->STACKTRACE, 3, car(args), T_INTEGER));
+ }
+ }
+ else return(wrong_type_argument(sc, sc->STACKTRACE, 2, car(args), T_INTEGER));
+ }
+ }
+ else method_or_bust(sc, car(args), sc->STACKTRACE, args, T_INTEGER, 1);
+ }
+ str = stacktrace_1(sc, (int)max_frames, (int)code_cols, (int)total_cols, (int)notes_start_col, as_comment);
+ return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
+}
+
+
+
+/* -------- error handlers -------- */
+
+static const char *make_type_name(s7_scheme *sc, const char *name, int article)
+{
+ int i, slen, len;
+
+ slen = safe_strlen(name);
+ len = slen + 8;
+ if (len > sc->typnam_len)
+ {
+ if (sc->typnam) free(sc->typnam);
+ sc->typnam = (char *)malloc(len * sizeof(char));
+ sc->typnam_len = len;
+ }
+ if (article == INDEFINITE_ARTICLE)
+ {
+ i = 1;
+ sc->typnam[0] = 'a';
+ if ((name[0] == 'a') || (name[0] == 'e') || (name[0] == 'i') || (name[0] == 'o') || (name[0] == 'u'))
+ sc->typnam[i++] = 'n';
+ sc->typnam[i++] = ' ';
+ }
+ else i = 0;
+ memcpy((void *)(sc->typnam + i), (void *)name, slen);
+ sc->typnam[i + slen] = '\0';
+ return(sc->typnam);
+}
+
+
+static const char *type_name_from_type(s7_scheme *sc, int typ, int article)
+{
+ static const char *frees[2] = {"free cell", "a free cell"};
+ static const char *nils[2] = {"nil", "nil"};
+ static const char *uniques[2] = {"untyped", "untyped"};
+ static const char *booleans[2] = {"boolean", "boolean"};
+ static const char *strings[2] = {"string", "a string"};
+ static const char *symbols[2] = {"symbol", "a symbol"};
+ static const char *syntaxes[2] = {"syntax", "syntactic"};
+ static const char *pairs[2] = {"pair", "a pair"};
+ static const char *gotos[2] = {"goto", "a goto (from call-with-exit)"};
+ static const char *continuations[2] = {"continuation", "a continuation"};
+ static const char *c_functions[2] = {"c-function", "a c-function"};
+ static const char *macros[2] = {"macro", "a macro"};
+ static const char *c_macros[2] = {"c-macro", "a c-macro"};
+ static const char *bacros[2] = {"bacro", "a bacro"};
+ static const char *vectors[2] = {"vector", "a vector"};
+ static const char *int_vectors[2] = {"int-vector", "an int-vector"};
+ static const char *float_vectors[2] = {"float-vector", "a float-vector"};
+ static const char *c_pointers[2] = {"C pointer", "a raw C pointer"};
+ static const char *counters[2] = {"internal counter", "an internal counter"};
+ static const char *baffles[2] = {"baffle", "a baffle"};
+ static const char *slots[2] = {"slot", "a slot (variable binding)"};
+ static const char *characters[2] = {"character", "a character"};
+ static const char *catches[2] = {"catch", "a catch"};
+ static const char *dynamic_winds[2] = {"dynamic-wind", "a dynamic-wind"};
+ static const char *hash_tables[2] = {"hash-table", "a hash-table"};
+ static const char *iterators[2] = {"iterator", "an iterator"};
+ static const char *environments[2] = {"environment", "an environment"};
+ static const char *integers[2] = {"integer", "an integer"};
+ static const char *big_integers[2] = {"big integer", "a big integer"};
+ static const char *ratios[2] = {"ratio", "a ratio"};
+ static const char *big_ratios[2] = {"big ratio", "a big ratio"};
+ static const char *reals[2] = {"real", "a real"};
+ static const char *big_reals[2] = {"big real", "a big real"};
+ static const char *complexes[2] = {"complex number", "a complex number"};
+ static const char *big_complexes[2] = {"big complex number", "a big complex number"};
+ static const char *functions[2] = {"function", "a function"};
+ static const char *function_stars[2] = {"function*", "a function*"};
+ static const char *rngs[2] = {"random-state", "a random-state"};
+
+ switch (typ)
+ {
+ case T_FREE: return(frees[article]);
+ case T_NIL: return(nils[article]);
+ case T_UNIQUE: return(uniques[article]);
+ case T_UNSPECIFIED: return(uniques[article]);
+ case T_BOOLEAN: return(booleans[article]);
+ case T_STRING: return(strings[article]);
+ case T_SYMBOL: return(symbols[article]);
+ case T_SYNTAX: return(syntaxes[article]);
+ case T_PAIR: return(pairs[article]);
+ case T_GOTO: return(gotos[article]);
+ case T_CONTINUATION: return(continuations[article]);
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ case T_C_FUNCTION: return(c_functions[article]);
+ case T_CLOSURE: return(functions[article]);
+ case T_CLOSURE_STAR: return(function_stars[article]);
+ case T_C_MACRO: return(c_macros[article]);
+ case T_C_POINTER: return(c_pointers[article]);
+ case T_CHARACTER: return(characters[article]);
+ case T_VECTOR: return(vectors[article]);
+ case T_INT_VECTOR: return(int_vectors[article]);
+ case T_FLOAT_VECTOR: return(float_vectors[article]);
+ case T_MACRO_STAR:
+ case T_MACRO: return(macros[article]);
+ case T_BACRO_STAR:
+ case T_BACRO: return(bacros[article]);
+ case T_CATCH: return(catches[article]); /* are these 2 possible? */
+ case T_DYNAMIC_WIND: return(dynamic_winds[article]);
+ case T_HASH_TABLE: return(hash_tables[article]);
+ case T_ITERATOR: return(iterators[article]);
+ case T_LET: return(environments[article]);
+ case T_COUNTER: return(counters[article]);
+ case T_BAFFLE: return(baffles[article]);
+ case T_RANDOM_STATE: return(rngs[article]);
+ case T_SLOT: return(slots[article]);
+ case T_INTEGER: return(integers[article]);
+ case T_RATIO: return(ratios[article]);
+ case T_REAL: return(reals[article]);
+ case T_COMPLEX: return(complexes[article]);
+ case T_BIG_INTEGER: return(big_integers[article]);
+ case T_BIG_RATIO: return(big_ratios[article]);
+ case T_BIG_REAL: return(big_reals[article]);
+ case T_BIG_COMPLEX: return(big_complexes[article]);
+ }
+ return(NULL);
+}
+
+
+static const char *type_name(s7_scheme *sc, s7_pointer arg, int article)
+{
+ switch (unchecked_type(arg))
+ {
+ case T_C_OBJECT:
+ return(make_type_name(sc, object_types[c_object_type(arg)]->name, article));
+
+ case T_INPUT_PORT:
+ return(make_type_name(sc, (is_file_port(arg)) ? "input file port" : ((is_string_port(arg)) ? "input string port" : "input port"), article));
+
+ case T_OUTPUT_PORT:
+ return(make_type_name(sc, (is_file_port(arg)) ? "output file port" : ((is_string_port(arg)) ? "output string port" : "output port"), article));
+
+ case T_LET:
+ if (has_methods(arg))
+ {
+ s7_pointer class_name;
+ class_name = find_method(sc, arg, sc->CLASS_NAME);
+ if (is_symbol(class_name))
+ return(make_type_name(sc, symbol_name(class_name), article));
+ }
+
+ default:
+ {
+ const char *str;
+ str = type_name_from_type(sc, unchecked_type(arg), article);
+ if (str) return(str);
+ }
+ }
+ return("messed up object");
+}
+
+
+static s7_pointer prepackaged_type_name(s7_scheme *sc, s7_pointer x)
+{
+ s7_pointer p;
+
+ if (has_methods(x))
+ {
+ p = find_method(sc, find_let(sc, x), sc->CLASS_NAME);
+ if (is_symbol(p))
+ return(symbol_name_cell(p));
+ }
+
+ p = prepackaged_type_names[type(x)];
+ if (is_string(p)) return(p);
+
+ switch (type(x))
+ {
+ case T_C_OBJECT: return(object_types[c_object_type(x)]->scheme_name);
+ case T_INPUT_PORT: return((is_file_port(x)) ? AN_INPUT_FILE_PORT : ((is_string_port(x)) ? AN_INPUT_STRING_PORT : AN_INPUT_PORT));
+ case T_OUTPUT_PORT: return((is_file_port(x)) ? AN_OUTPUT_FILE_PORT : ((is_string_port(x)) ? AN_OUTPUT_STRING_PORT : AN_OUTPUT_PORT));
+ }
+ return(make_string_wrapper(sc, "unknown type!"));
+}
+
+static s7_pointer type_name_string(s7_scheme *sc, s7_pointer arg)
+{
+ if (type(arg) < NUM_TYPES)
+ {
+ s7_pointer p;
+ p = prepackaged_type_names[type(arg)]; /* these use INDEFINITE_ARTICLE */
+ if (is_string(p)) return(p);
+ }
+ return(make_string_wrapper(sc, type_name(sc, arg, INDEFINITE_ARTICLE)));
+}
+
+
+static s7_pointer wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer typnam, s7_pointer descr)
+{
+ s7_pointer p;
+ p = cdr(sc->wrong_type_arg_info); /* info list is '(format_string caller arg_n arg type_name descr) */
+ car(p) = caller; p = cdr(p);
+ car(p) = arg_n; p = cdr(p);
+ car(p) = arg; p = cdr(p);
+ car(p) = (typnam == sc->GC_NIL) ? prepackaged_type_name(sc, arg) : typnam;
+ p = cdr(p);
+ car(p) = descr;
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, sc->wrong_type_arg_info));
+}
+
+
+static s7_pointer simple_wrong_type_arg_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer typnam, s7_pointer descr)
+{
+ set_wlist_4(sc, cdr(sc->simple_wrong_type_arg_info), caller, arg, (typnam == sc->GC_NIL) ? prepackaged_type_name(sc, arg) : typnam, descr);
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, sc->simple_wrong_type_arg_info));
+}
+
+
+s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr)
+{
+ /* info list is '(format_string caller arg_n arg type_name descr) */
+ if (arg_n < 0) arg_n = 0;
+ if (arg_n > 0)
+ return(wrong_type_arg_error_prepackaged(sc, make_string_wrapper(sc, caller),
+ make_integer(sc, arg_n), arg, type_name_string(sc, arg),
+ make_string_wrapper(sc, descr)));
+ return(simple_wrong_type_arg_error_prepackaged(sc, make_string_wrapper(sc, caller),
+ arg, type_name_string(sc, arg),
+ make_string_wrapper(sc, descr)));
+}
+
+
+static s7_pointer out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg_n, s7_pointer arg, s7_pointer descr)
+{
+ /* info list is '(format_string caller arg_n arg descr) */
+ set_wlist_4(sc, cdr(sc->out_of_range_info), caller, arg_n, arg, descr);
+ return(s7_error(sc, sc->OUT_OF_RANGE, sc->out_of_range_info));
+}
+
+
+static s7_pointer simple_out_of_range_error_prepackaged(s7_scheme *sc, s7_pointer caller, s7_pointer arg, s7_pointer descr)
+{
+ set_wlist_3(sc, cdr(sc->simple_out_of_range_info), caller, arg, descr);
+ return(s7_error(sc, sc->OUT_OF_RANGE, sc->simple_out_of_range_info));
+}
+
+
+s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr)
+{
+ /* info list is '(format_string caller arg_n arg descr) */
+ if (arg_n < 0) arg_n = 0;
+
+ if (arg_n > 0)
+ return(out_of_range_error_prepackaged(sc, make_string_wrapper(sc, caller), make_integer(sc, arg_n), arg, make_string_wrapper(sc, descr)));
+ return(simple_out_of_range_error_prepackaged(sc, make_string_wrapper(sc, caller), arg, make_string_wrapper(sc, descr)));
+}
+
+
+s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args)
+{
+ return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_2(sc, make_string_wrapper(sc, caller), args))); /* "caller" includes the format directives */
+}
+
+
+static s7_pointer division_by_zero_error(s7_scheme *sc, s7_pointer caller, s7_pointer arg)
+{
+ return(s7_error(sc, sc->DIVISION_BY_ZERO, set_elist_3(sc, sc->DIVISION_BY_ZERO_ERROR, caller, arg)));
+}
+
+
+static s7_pointer file_error(s7_scheme *sc, const char *caller, const char *descr, const char *name)
+{
+ return(s7_error(sc, sc->IO_ERROR,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: ~A ~S"),
+ make_string_wrapper(sc, caller),
+ make_string_wrapper(sc, descr),
+ make_string_wrapper(sc, name))));
+}
+
+
+static s7_pointer closure_or_f(s7_scheme *sc, s7_pointer p)
+{
+ s7_pointer body;
+ if (!is_closure(p)) return(p);
+ body = closure_body(p);
+ if (is_pair(cdr(body))) return(p);
+ if (!is_pair(car(body))) return(sc->F);
+ if (caar(body) == sc->QUOTE) return(sc->F);
+ return(p);
+}
+
+
+static s7_pointer g_dynamic_wind(s7_scheme *sc, s7_pointer args)
+{
+ #define H_dynamic_wind "(dynamic-wind init body finish) calls init, then body, then finish, \
+each a function of no arguments, guaranteeing that finish is called even if body is exited"
+ #define Q_dynamic_wind s7_make_circular_signature(sc, 1, 2, sc->VALUES, sc->IS_PROCEDURE)
+
+ s7_pointer p;
+
+ if (!is_thunk(sc, car(args)))
+ method_or_bust_with_type(sc, car(args), sc->DYNAMIC_WIND, args, A_THUNK, 1);
+ if (!is_thunk(sc, cadr(args)))
+ method_or_bust_with_type(sc, cadr(args), sc->DYNAMIC_WIND, args, A_THUNK, 2);
+ if (!is_thunk(sc, caddr(args)))
+ method_or_bust_with_type(sc, caddr(args), sc->DYNAMIC_WIND, args, A_THUNK, 3);
+
+ /* this won't work:
+
+ (let ((final (lambda (a b c) (list a b c))))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () (set! final (lambda () (display "in final"))))
+ final))
+
+ * but why not? 'final' is a thunk by the time it is evaluated.
+ * catch (the error handler) is similar.
+ *
+ * It can't work here because we set up the dynamic_wind_out slot below and
+ * even if the thunk check was removed, we'd still be trying to apply the original function.
+ */
+
+ new_cell(sc, p, T_DYNAMIC_WIND); /* don't mark car/cdr, don't copy */
+ dynamic_wind_in(p) = closure_or_f(sc, car(args));
+ dynamic_wind_body(p) = cadr(args);
+ dynamic_wind_out(p) = closure_or_f(sc, caddr(args));
+
+ /* since we don't care about the in and out results, and they are thunks, if the body is not a pair,
+ * or is a quoted thing, we just ignore that function.
+ */
+
+ push_stack(sc, OP_DYNAMIC_WIND, sc->NIL, p); /* args will be the saved result, code = s7_dynwind_t obj */
+ if (dynamic_wind_in(p) != sc->F)
+ {
+ dynamic_wind_state(p) = DWIND_INIT;
+ push_stack(sc, OP_APPLY, sc->NIL, dynamic_wind_in(p));
+ }
+ else
+ {
+ dynamic_wind_state(p) = DWIND_BODY;
+ push_stack(sc, OP_APPLY, sc->NIL, dynamic_wind_body(p));
+ }
+ return(sc->F);
+}
+
+
+s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish)
+{
+ /* this is essentially s7_call with a dynamic-wind wrapper around "body" */
+ s7_pointer p;
+ bool old_longjmp;
+ jmp_buf old_goto_start;
+
+ sc->temp1 = ((init == sc->F) ? finish : init);
+ sc->temp2 = body;
+ old_longjmp = sc->longjmp_ok;
+ memcpy((void *)old_goto_start, (void *)(sc->goto_start), sizeof(jmp_buf));
+ sc->longjmp_ok = true;
+
+ if (setjmp(sc->goto_start) != 0) /* returning from s7_error catch handler */
+ {
+ sc->longjmp_ok = old_longjmp;
+ memcpy((void *)(sc->goto_start), (void *)old_goto_start, sizeof(jmp_buf));
+ if ((sc->op == OP_ERROR_QUIT) &&
+ (sc->longjmp_ok))
+ longjmp(sc->goto_start, 1);
+ eval(sc, sc->op);
+ return(sc->value);
+ }
+
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = sc->NIL;
+
+ new_cell(sc, p, T_DYNAMIC_WIND);
+ dynamic_wind_in(p) = init;
+ dynamic_wind_body(p) = body;
+ dynamic_wind_out(p) = finish;
+ push_stack(sc, OP_DYNAMIC_WIND, sc->NIL, p);
+ if (init != sc->F)
+ {
+ dynamic_wind_state(p) = DWIND_INIT;
+ sc->code = init;
+ }
+ else
+ {
+ dynamic_wind_state(p) = DWIND_BODY;
+ sc->code = body;
+ }
+
+ eval(sc, OP_APPLY);
+ sc->longjmp_ok = old_longjmp;
+ memcpy((void *)(sc->goto_start), (void *)old_goto_start, sizeof(jmp_buf));
+ return(sc->value);
+}
+
+
+static s7_pointer g_catch(s7_scheme *sc, s7_pointer args)
+{
+ #define H_catch "(catch tag thunk handler) evaluates thunk; if an error occurs that matches the tag (#t matches all), the handler is called"
+ #define Q_catch s7_make_circular_signature(sc, 2, 3, sc->VALUES, sc->T, sc->IS_PROCEDURE)
+
+ s7_pointer p, proc, err;
+
+ /* Guile sets up the catch before looking for arg errors:
+ * (catch #t log (lambda args "hiho")) -> "hiho"
+ * which is consistent in that (catch #t (lambda () (log))...) should probably be the same as (catch #t log ...)
+ */
+
+ proc = cadr(args);
+ err = caddr(args);
+ /* if (is_let(err)) check_method(sc, err, sc->CATCH, args); */ /* causes exit from s7! */
+
+ new_cell(sc, p, T_CATCH);
+ catch_tag(p) = car(args);
+ catch_goto_loc(p) = s7_stack_top(sc);
+ catch_op_loc(p) = (int)(sc->op_stack_now - sc->op_stack);
+ catch_handler(p) = err;
+
+ if (is_any_macro(err))
+ push_stack(sc, OP_CATCH_2, args, p);
+ else push_stack(sc, OP_CATCH, args, p); /* args ignored but maybe safer for GC? */
+
+ /* not sure about these error checks -- they can be omitted */
+ if (!is_thunk(sc, proc))
+ return(wrong_type_argument_with_type(sc, sc->CATCH, 2, proc, A_THUNK));
+
+ if (!is_applicable(err))
+ return(wrong_type_argument_with_type(sc, sc->CATCH, 3, err, SOMETHING_APPLICABLE));
+
+ /* should we check here for (aritable? err 2)? -- right now:
+ * (catch #t (lambda () 1) "hiho") -> 1
+ * currently this is checked only if the error handler is called
+ */
+
+ if (is_closure(proc)) /* not also lambda* here because we need to handle the arg defaults */
+ {
+ sc->code = closure_body(proc);
+ new_frame(sc, closure_let(proc), sc->envir);
+ push_stack(sc, OP_BEGIN_UNCHECKED, sc->args, sc->code);
+ }
+ else push_stack(sc, OP_APPLY, sc->NIL, proc);
+
+ return(sc->F);
+}
+
+/* s7_catch(sc, tag, body, error): return(g_catch(sc, list(sc, 3, tag, body, error))) */
+
+/* error reporting info -- save filename and line number */
+
+#define remember_location(Line, File) (((File) << 20) | (Line))
+#define remembered_line_number(Line) ((Line) & 0xfffff)
+#define remembered_file_name(Line) ((((Line) >> 20) <= sc->file_names_top) ? sc->file_names[Line >> 20] : sc->F)
+/* this gives room for 4000 files each of 1000000 lines */
+
+
+static int remember_file_name(s7_scheme *sc, const char *file)
+{
+ int i;
+
+ for (i = 0; i <= sc->file_names_top; i++)
+ if (safe_strcmp(file, string_value(sc->file_names[i])))
+ return(i);
+
+ sc->file_names_top++;
+ if (sc->file_names_top >= sc->file_names_size)
+ {
+ int old_size = 0;
+ if (sc->file_names_size == 0)
+ {
+ sc->file_names_size = INITIAL_FILE_NAMES_SIZE;
+ sc->file_names = (s7_pointer *)calloc(sc->file_names_size, sizeof(s7_pointer));
+ }
+ else
+ {
+ old_size = sc->file_names_size;
+ sc->file_names_size *= 2;
+ sc->file_names = (s7_pointer *)realloc(sc->file_names, sc->file_names_size * sizeof(s7_pointer));
+ }
+ for (i = old_size; i < sc->file_names_size; i++)
+ sc->file_names[i] = sc->F;
+ }
+ sc->file_names[sc->file_names_top] = s7_make_permanent_string(file);
+
+ return(sc->file_names_top);
+}
+
+
+static s7_pointer init_owlet(s7_scheme *sc)
+{
+ s7_pointer e;
+ e = new_frame_in_env(sc, sc->rootlet);
+ sc->temp3 = e;
+ sc->error_type = make_slot_1(sc, e, make_symbol(sc, "error-type"), sc->F); /* the error type or tag ('division-by-zero) */
+ sc->error_data = make_slot_1(sc, e, make_symbol(sc, "error-data"), sc->F); /* the message or information passed by the error function */
+ sc->error_code = make_slot_1(sc, e, make_symbol(sc, "error-code"), sc->F); /* the code that s7 thinks triggered the error */
+ sc->error_line = make_slot_1(sc, e, make_symbol(sc, "error-line"), sc->F); /* the line number of that code */
+ sc->error_file = make_slot_1(sc, e, make_symbol(sc, "error-file"), sc->F); /* the file name of that code */
+ return(e);
+}
+
+
+static s7_pointer g_owlet(s7_scheme *sc, s7_pointer args)
+{
+ #define H_owlet "(owlet) returns the environment at the point of the last error. \
+It has the additional local variables: error-type, error-data, error-code, error-line, and error-file."
+ #define Q_owlet s7_make_signature(sc, 1, sc->IS_LET)
+ /* if owlet is not copied, (define e (owlet)), e changes as owlet does!
+ */
+ s7_pointer e, x;
+ int gc_loc;
+
+ e = let_copy(sc, sc->owlet);
+ gc_loc = s7_gc_protect(sc, e);
+
+ /* also make sure the pairs are copied: should be error-data and error-code */
+ for (x = let_slots(e); is_slot(x); x = next_slot(x))
+ if (is_pair(slot_value(x)))
+ slot_set_value(x, protected_list_copy(sc, slot_value(x)));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(e);
+}
+
+static s7_pointer c_owlet(s7_scheme *sc) {return(g_owlet(sc, sc->NIL));}
+PF_0(owlet, c_owlet)
+
+
+static s7_pointer active_catches(s7_scheme *sc)
+{
+ int i;
+ s7_pointer x, lst;
+ lst = sc->NIL;
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ switch (stack_op(sc->stack, i))
+ {
+ case OP_CATCH_ALL:
+ lst = cons(sc, sc->T, lst);
+ break;
+
+ case OP_CATCH_2:
+ case OP_CATCH_1:
+ case OP_CATCH:
+ x = stack_code(sc->stack, i);
+ lst = cons(sc, catch_tag(x), lst);
+ break;
+ }
+ return(reverse_in_place_unchecked(sc, sc->NIL, lst));
+}
+
+static s7_pointer active_exits(s7_scheme *sc)
+{
+ /* (call-with-exit (lambda (exiter) (*s7* 'exits))) */
+ int i;
+ s7_pointer lst;
+ lst = sc->NIL;
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ if (stack_op(sc->stack, i) == OP_DEACTIVATE_GOTO)
+ {
+ s7_pointer func, jump;
+ func = stack_code(sc->stack, i); /* presumably this has the goto name */
+ jump = stack_args(sc->stack, i); /* call this to jump */
+
+ if (is_any_closure(func))
+ lst = cons(sc, cons(sc, car(closure_args(func)), jump), lst);
+ else
+ {
+ if ((is_pair(func)) && (car(func) == sc->CALL_WITH_EXIT))
+ lst = cons(sc, cons(sc, car(cadr(cadr(func))), jump), lst); /* (call-with-exit (lambda (three) ...)) */
+ else lst = cons(sc, cons(sc, sc->UNSPECIFIED, jump), lst);
+ }
+ sc->w = lst;
+ }
+ return(reverse_in_place_unchecked(sc, sc->NIL, lst));
+}
+
+static s7_pointer stack_entries(s7_scheme *sc)
+{
+ int i;
+ s7_pointer lst;
+ lst = sc->NIL;
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ {
+ s7_pointer func, args, e;
+ opcode_t op;
+ func = stack_code(sc->stack, i);
+ args = stack_args(sc->stack, i);
+ e = stack_let(sc->stack, i);
+ op = stack_op(sc->stack, i);
+ if ((s7_is_valid(sc, func)) &&
+ (s7_is_valid(sc, args)) &&
+ (s7_is_valid(sc, e)) &&
+ (op < OP_MAX_DEFINED))
+ {
+ lst = cons(sc, list_4(sc, func, args, e, make_integer(sc, op)), lst);
+ sc->w = lst;
+ }
+ }
+ return(reverse_in_place_unchecked(sc, sc->NIL, lst));
+}
+
+
+/* catch handlers */
+
+typedef bool (*catch_function)(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook);
+static catch_function catchers[OP_MAX_DEFINED + 1];
+
+static bool catch_all_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ s7_pointer catcher;
+ catcher = stack_let(sc->stack, i);
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_all_op_loc(catcher));
+ sc->stack_end = (s7_pointer *)(sc->stack_start + catch_all_goto_loc(catcher));
+ pop_stack(sc);
+ sc->value = catch_all_result(catcher);
+ return(true);
+}
+
+static bool catch_2_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ /* this is the macro-error-handler case from g_catch
+ * (let () (define-macro (m . args) (apply (car args) (cadr args))) (catch #t (lambda () (error abs -1)) m))
+ */
+ s7_pointer x;
+ x = stack_code(sc->stack, i);
+ if ((catch_tag(x) == sc->T) ||
+ (catch_tag(x) == type) ||
+ (type == sc->T))
+ {
+ int loc;
+ loc = catch_goto_loc(x);
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_op_loc(x));
+ sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
+ sc->code = catch_handler(x);
+
+ car(sc->T2_1) = type;
+ car(sc->T2_2) = info;
+ sc->args = sc->T2_1; /* copied in op_apply? */
+
+ sc->op = OP_APPLY;
+ return(true);
+ }
+ return(false);
+}
+
+static bool catch_1_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ s7_pointer x;
+ x = stack_code(sc->stack, i);
+ if ((catch_tag(x) == sc->T) ||
+ (catch_tag(x) == type) ||
+ (type == sc->T))
+ {
+ int loc;
+ opcode_t op;
+ s7_pointer catcher, error_func, body;
+
+ op = stack_op(sc->stack, i);
+ sc->temp4 = stack_let(sc->stack, i); /* GC protect this, since we're moving the stack top below */
+ catcher = x;
+ loc = catch_goto_loc(catcher);
+ sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_op_loc(catcher));
+ sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
+ error_func = catch_handler(catcher);
+
+ /* very often the error handler just returns either a constant ('error or #f), or
+ * the args passed to it, so there's no need to laboriously make a closure,
+ * and apply it -- just set sc->value to the closure body (or the args) and
+ * return.
+ *
+ * so first examine closure_body(error_func)
+ * if it is a constant, or quoted symbol, return that,
+ * if it is the args symbol, return (list type info)
+ */
+
+ /* if OP_CATCH_1, we deferred making the error handler until it is actually needed */
+ if (op == OP_CATCH_1)
+ body = cdr(error_func);
+ else
+ {
+ if (is_closure(error_func))
+ body = closure_body(error_func);
+ else body = NULL;
+ }
+
+ if ((body) && (is_null(cdr(body))))
+ {
+ s7_pointer y = NULL;
+ body = car(body);
+ if (is_pair(body))
+ {
+ if (car(body) == sc->QUOTE)
+ y = cadr(body);
+ else
+ {
+ if ((car(body) == sc->CAR) &&
+ (is_pair(error_func)) &&
+ (cadr(body) == car(error_func)))
+ y = type;
+ }
+ }
+ else
+ {
+ if (is_symbol(body))
+ {
+ if ((is_pair(error_func)) &&
+ (body == car(error_func)))
+ y = list_2(sc, type, info);
+ }
+ else y = body;
+ }
+ if (y)
+ {
+ pop_stack(sc);
+ sc->value = y;
+ sc->temp4 = sc->NIL;
+ return(true);
+ }
+ }
+ if (op == OP_CATCH_1)
+ {
+ s7_pointer y = NULL;
+ make_closure_without_capture(sc, y, car(error_func), cdr(error_func), sc->temp4);
+ sc->code = y;
+ }
+ else sc->code = error_func;
+ sc->temp4 = sc->NIL;
+
+ /* if user (i.e. yers truly!) copies/pastes the preceding lambda () into the
+ * error handler portion of the catch, he gets the inexplicable message:
+ * ;(): too many arguments: (a1 ())
+ * when this apply tries to call the handler. So, we need a special case
+ * error check here!
+ */
+
+ if (!s7_is_aritable(sc, sc->code, 2))
+ {
+ s7_wrong_number_of_args_error(sc, "catch error handler should accept 2 args: ~S", sc->code);
+ return(false);
+ }
+
+ /* since make_closure_with_let sets needs_copied_args and we're going to OP_APPLY,
+ * we don't need a new list here.
+ */
+ car(sc->T2_1) = type;
+ car(sc->T2_2) = info;
+ sc->args = sc->T2_1;
+ sc->op = OP_APPLY;
+
+ /* explicit eval needed if s7_call called into scheme where a caught error occurred (ex6 in exs7.c)
+ * but putting it here (via eval(sc, OP_APPLY)) means the C stack is not cleared correctly in non-s7-call cases,
+ * so defer it until s7_call
+ */
+ return(true);
+ }
+ return(false);
+}
+
+static bool catch_dw_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ s7_pointer x;
+ x = stack_code(sc->stack, i);
+ if (dynamic_wind_state(x) == DWIND_BODY)
+ {
+ dynamic_wind_state(x) = DWIND_FINISH; /* make sure an uncaught error in the exit thunk doesn't cause us to loop */
+ if (dynamic_wind_out(x) != sc->F)
+ {
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->code = dynamic_wind_out(x);
+ sc->args = sc->NIL;
+ eval(sc, OP_APPLY); /* I guess this means no call/cc out of the exit thunk in an error-catching context */
+ }
+ }
+ return(false);
+}
+
+static bool catch_out_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ s7_pointer x;
+ x = stack_code(sc->stack, i); /* "code" = port that we opened */
+ s7_close_output_port(sc, x);
+ x = stack_args(sc->stack, i); /* "args" = port that we shadowed, if not #f */
+ if (x != sc->F)
+ sc->output_port = x;
+ return(false);
+}
+
+static bool catch_in_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ s7_close_input_port(sc, stack_code(sc->stack, i)); /* "code" = port that we opened */
+ sc->input_port = stack_args(sc->stack, i); /* "args" = port that we shadowed */
+ return(false);
+}
+
+static bool catch_read_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ pop_input_port(sc);
+ return(false);
+}
+
+static bool catch_eval_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ s7_close_input_port(sc, sc->input_port);
+ pop_input_port(sc);
+ return(false);
+}
+
+static bool catch_barrier_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ if (is_input_port(stack_args(sc->stack, i))) /* (eval-string "'(1 .)") */
+ {
+ if (sc->input_port == stack_args(sc->stack, i))
+ pop_input_port(sc);
+ s7_close_input_port(sc, stack_args(sc->stack, i));
+ }
+ return(false);
+}
+
+static bool catch_hook_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ sc->error_hook = stack_code(sc->stack, i);
+ /* apparently there was an error during *error-hook* evaluation, but Rick wants the hook re-established anyway */
+ (*reset_hook) = true;
+ /* avoid infinite loop -- don't try to (re-)evaluate (buggy) *error-hook*! */
+ return(false);
+}
+
+static bool catch_goto_function(s7_scheme *sc, int i, s7_pointer type, s7_pointer info, bool *reset_hook)
+{
+ call_exit_active(stack_args(sc->stack, i)) = false;
+ return(false);
+}
+
+static void init_catchers(void)
+{
+ int i;
+ for (i = 0; i <= OP_MAX_DEFINED; i++) catchers[i] = NULL;
+ catchers[OP_CATCH_ALL] = catch_all_function;
+ catchers[OP_CATCH_2] = catch_2_function;
+ catchers[OP_CATCH_1] = catch_1_function;
+ catchers[OP_CATCH] = catch_1_function;
+ catchers[OP_DYNAMIC_WIND] = catch_dw_function;
+ catchers[OP_GET_OUTPUT_STRING_1] = catch_out_function;
+ catchers[OP_UNWIND_OUTPUT] = catch_out_function;
+ catchers[OP_UNWIND_INPUT] = catch_in_function;
+ catchers[OP_READ_DONE] = catch_read_function; /* perhaps an error during (read) */
+ catchers[OP_EVAL_STRING_1] = catch_eval_function; /* perhaps an error happened before we could push the OP_EVAL_STRING_2 */
+ catchers[OP_EVAL_STRING_2] = catch_eval_function;
+ catchers[OP_BARRIER] = catch_barrier_function;
+ catchers[OP_DEACTIVATE_GOTO] = catch_goto_function;
+ catchers[OP_ERROR_HOOK_QUIT] = catch_hook_function;
+}
+
+static s7_pointer g_throw(s7_scheme *sc, s7_pointer args)
+{
+ #define H_throw "(throw tag . info) is like (error ...) but it does not affect the owlet. \
+It looks for an existing catch with a matching tag, and jumps to it if found. Otherwise it raises an error."
+ #define Q_throw pcl_t
+
+ bool ignored_flag = false;
+ int i;
+ s7_pointer type, info;
+
+ type = car(args);
+ info = cdr(args);
+ /* look for a catcher */
+
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ {
+ catch_function catcher;
+ catcher = catchers[stack_op(sc->stack, i)];
+ if ((catcher) &&
+ (catcher(sc, i, type, info, &ignored_flag)))
+ {
+ if (sc->longjmp_ok) longjmp(sc->goto_start, 1);
+ return(sc->value);
+ }
+ }
+ if (is_let(car(args))) check_method(sc, car(args), sc->THROW, args);
+ return(s7_error(sc, make_symbol(sc, "uncaught-throw"), args));
+}
+
+
+static void s7_warn(s7_scheme *sc, int len, const char *ctrl, ...)
+{
+ va_list ap;
+ char *str;
+
+ str = (char *)malloc(len * sizeof(char));
+ va_start(ap, ctrl);
+ len = vsnprintf(str, len, ctrl, ap);
+ va_end(ap);
+
+ if (port_is_closed(sc->error_port))
+ sc->error_port = sc->standard_error;
+ s7_display(sc, make_string_uncopied_with_length(sc, str, len), sc->error_port);
+}
+
+
+s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
+{
+ static int last_line = -1;
+ bool reset_error_hook = false;
+ s7_pointer cur_code;
+
+ /* type is a symbol normally, and info is compatible with format: (apply format #f info) --
+ * car(info) is the control string, cdr(info) its args
+ * type/range errors have cadr(info)=caller, caddr(info)=offending arg number
+ * null info can mean symbol table is locked so make-symbol uses s7_error to get out
+ *
+ * set up (owlet), look for a catch that matches 'type', if found
+ * call its error-handler, else if *error-hook* is bound, call it,
+ * else send out the error info ourselves.
+ */
+ sc->no_values = 0;
+ sc->format_depth = -1;
+ sc->gc_off = false; /* this is in case we were triggered from the sort function -- clumsy! */
+ s7_xf_clear(sc);
+
+ slot_set_value(sc->error_type, type);
+ slot_set_value(sc->error_data, info);
+#if DEBUGGING
+ if (!is_let(sc->owlet))
+ fprintf(stderr, "owlet clobbered!\n");
+#endif
+ if ((unchecked_type(sc->envir) != T_LET) &&
+ (sc->envir != sc->NIL))
+ sc->envir = sc->NIL; /* in reader, the envir frame is mostly ignored so it can be (and usually is) garbage */
+
+ set_outlet(sc->owlet, sc->envir);
+
+ cur_code = sc->cur_code;
+ slot_set_value(sc->error_code, cur_code);
+ if (has_line_number(cur_code))
+ {
+ int line;
+ line = pair_line(cur_code);
+ if (line != last_line)
+ {
+ last_line = line;
+ if (line > 0)
+ {
+ slot_set_value(sc->error_line, make_integer(sc, remembered_line_number(line)));
+ slot_set_value(sc->error_file, remembered_file_name(line));
+ }
+ else
+ {
+ slot_set_value(sc->error_line, sc->F);
+ slot_set_value(sc->error_file, sc->F);
+ }
+ }
+ }
+ else
+ {
+ slot_set_value(sc->error_line, sc->F);
+ slot_set_value(sc->error_file, sc->F);
+ }
+
+ { /* look for a catcher */
+ int i;
+ /* top is 1 past actual top, top - 1 is op, if op = OP_CATCH, top - 4 is the cell containing the catch struct */
+ for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
+ {
+ catch_function catcher;
+ catcher = catchers[stack_op(sc->stack, i)];
+ if ((catcher) &&
+ (catcher(sc, i, type, info, &reset_error_hook)))
+ {
+ if (sc->longjmp_ok) longjmp(sc->goto_start, 1);
+ return(type); /* throw returns sc->value here? */
+ }
+ }
+ }
+
+ /* error not caught */
+ /* (set! *error-hook* (list (lambda (hook) (apply format #t (hook 'args))))) */
+
+ if ((!reset_error_hook) &&
+ (is_procedure(sc->error_hook)) &&
+ (is_pair(s7_hook_functions(sc, sc->error_hook))))
+ {
+ s7_pointer error_hook_func;
+ /* (set! (hook-functions *error-hook*) (list (lambda (h) (format *stderr* "got error ~A~%" (h 'args))))) */
+
+ error_hook_func = sc->error_hook;
+ sc->error_hook = sc->F;
+ /* if the *error-hook* functions trigger an error, we had better not have *error-hook* still set! */
+
+ push_stack(sc, OP_ERROR_HOOK_QUIT, sc->NIL, error_hook_func); /* restore *error-hook* upon successful (or any!) evaluation */
+ sc->args = list_2(sc, type, info);
+ sc->code = error_hook_func;
+
+ /* if we drop into the longjmp below, the hook functions are not called!
+ * OP_ERROR_HOOK_QUIT performs the longjmp, so it should be safe to go to eval.
+ */
+ eval(sc, OP_APPLY);
+ }
+ else
+ {
+ if (port_is_closed(sc->error_port))
+ sc->error_port = sc->standard_error;
+ /* if info is not a list, send object->string to current error port,
+ * else assume car(info) is a format control string, and cdr(info) are its args
+ *
+ * if at all possible, get some indication of where we are!
+ */
+ if ((!s7_is_list(sc, info)) ||
+ (!is_string(car(info))))
+ format_to_port(sc, sc->error_port, "\n;~S ~S", set_plist_2(sc, type, info), NULL, false, 7);
+ else
+ {
+ const char *carstr;
+ int i, len;
+ bool use_format = false;
+
+ /* it's possible that the error string is just a string -- not intended for format */
+ carstr = string_value(car(info));
+ len = string_length(car(info));
+ for (i = 0; i < len; i++)
+ if (carstr[i] == '~')
+ {
+ use_format = true;
+ break;
+ }
+
+ if (use_format)
+ {
+ char *errstr;
+ int str_len;
+ len += 8;
+ tmpbuf_malloc(errstr, len);
+ str_len = snprintf(errstr, len, "\n;%s", string_value(car(info)));
+ format_to_port(sc, sc->error_port, errstr, cdr(info), NULL, false, str_len);
+ tmpbuf_free(errstr, len);
+ }
+ else format_to_port(sc, sc->error_port, "\n;~S ~S", set_plist_2(sc, type, info), NULL, false, 7);
+ }
+
+ /* now display location at end */
+
+ if ((is_input_port(sc->input_port)) &&
+ (port_file(sc->input_port) != stdin) &&
+ (!port_is_closed(sc->input_port)))
+ {
+ const char *filename = NULL;
+ int line;
+
+ filename = port_filename(sc->input_port);
+ line = port_line_number(sc->input_port);
+
+ if (filename)
+ format_to_port(sc, sc->error_port, "\n; ~A[~D]", set_plist_2(sc, make_string_wrapper(sc, filename), make_integer(sc, line)), NULL, false, 10);
+ else
+ {
+ if ((line > 0) &&
+ (slot_value(sc->error_line) != sc->F))
+ format_to_port(sc, sc->error_port, "\n; line ~D", set_plist_1(sc, make_integer(sc, line)), NULL, false, 11);
+ else
+ {
+ if (is_pair(sc->input_port_stack))
+ {
+ s7_pointer p;
+ p = car(sc->input_port_stack);
+ if ((is_input_port(p)) &&
+ (port_file(p) != stdin) &&
+ (!port_is_closed(p)))
+ {
+ filename = port_filename(p);
+ line = port_line_number(p);
+ if (filename)
+ format_to_port(sc, sc->error_port, "\n; ~A[~D]",
+ set_plist_2(sc, make_string_wrapper(sc, filename), make_integer(sc, line)), NULL, false, 10);
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ const char *call_name;
+ call_name = sc->s7_call_name;
+ /* sc->s7_call_name = NULL; */
+ if (call_name)
+ {
+ sc->s7_call_name = NULL;
+ if ((sc->s7_call_file != NULL) &&
+ (sc->s7_call_line >= 0))
+ {
+ format_to_port(sc, sc->error_port, "\n; ~A ~A[~D]",
+ set_plist_3(sc,
+ make_string_wrapper(sc, call_name),
+ make_string_wrapper(sc, sc->s7_call_file),
+ make_integer(sc, sc->s7_call_line)),
+ NULL, false, 13);
+ }
+ }
+ }
+ s7_newline(sc, sc->error_port);
+
+ if (is_string(slot_value(sc->error_file)))
+ {
+ format_to_port(sc, sc->error_port, "; ~S, line ~D",
+ set_plist_2(sc, slot_value(sc->error_file), slot_value(sc->error_line)),
+ NULL, false, 16);
+ s7_newline(sc, sc->error_port);
+ }
+
+ /* look for __func__ in the error environment etc */
+ if (sc->error_port != sc->F)
+ {
+ char *errstr;
+ errstr = stacktrace_1(sc,
+ s7_integer(car(sc->stacktrace_defaults)),
+ s7_integer(cadr(sc->stacktrace_defaults)),
+ s7_integer(caddr(sc->stacktrace_defaults)),
+ s7_integer(cadddr(sc->stacktrace_defaults)),
+ s7_boolean(sc, s7_list_ref(sc, sc->stacktrace_defaults, 4)));
+ if (errstr)
+ {
+ port_write_string(sc->error_port)(sc, ";\n", 2, sc->error_port);
+ port_write_string(sc->error_port)(sc, errstr, strlen(errstr), sc->error_port);
+ free(errstr);
+ port_write_character(sc->error_port)(sc, '\n', sc->error_port);
+ }
+ }
+ else
+ {
+ if (is_pair(slot_value(sc->error_code)))
+ {
+ format_to_port(sc, sc->error_port, "; ~S", set_plist_1(sc, slot_value(sc->error_code)), NULL, false, 7);
+ s7_newline(sc, sc->error_port);
+ }
+ }
+
+ /* if (is_continuation(type))
+ * go into repl here with access to continuation? Or expect *error-handler* to deal with it?
+ */
+ sc->value = type;
+ stack_reset(sc);
+ sc->op = OP_ERROR_QUIT;
+ }
+
+ if (sc->longjmp_ok) longjmp(sc->goto_start, 1);
+ return(type);
+}
+
+
+static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ /* the operator type is needed here else the error message is confusing:
+ * (apply '+ (list 1 2))) -> ;attempt to apply + to (1 2)?
+ */
+ static s7_pointer errstr = NULL;
+ if (is_null(obj))
+ return(s7_error(sc, sc->SYNTAX_ERROR, set_elist_2(sc, make_string_wrapper_with_length(sc, "attempt to apply nil to ~S?", 27), args)));
+ if (!errstr)
+ errstr = s7_make_permanent_string("attempt to apply ~A ~S to ~S?");
+ return(s7_error(sc, sc->SYNTAX_ERROR, set_elist_4(sc, errstr, type_name_string(sc, obj), obj, args)));
+}
+
+
+static s7_pointer read_error_1(s7_scheme *sc, const char *errmsg, bool string_error)
+{
+ /* reader errors happen before the evaluator gets involved, so forms such as:
+ * (catch #t (lambda () (car '( . ))) (lambda arg 'error))
+ * do not catch the error if we simply signal an error when we encounter it.
+ */
+ char *msg;
+ int len;
+ s7_pointer pt;
+
+ pt = sc->input_port;
+ if (!string_error)
+ {
+ /* make an heroic effort to find where we slid off the tracks */
+
+ if (is_string_port(sc->input_port))
+ {
+ #define QUOTE_SIZE 40
+ unsigned int i, j, start = 0, end, slen;
+ char *recent_input = NULL;
+
+ /* we can run off the end in cases like (eval-string "(. . ,.)") or (eval-string " (@ . ,.)") */
+ if (port_position(pt) >= port_data_size(pt))
+ port_position(pt) = port_data_size(pt) - 1;
+
+ /* start at current position and look back a few chars */
+ for (i = port_position(pt), j = 0; (i > 0) && (j < QUOTE_SIZE); i--, j++)
+ if ((port_data(pt)[i] == '\0') ||
+ (port_data(pt)[i] == '\n') ||
+ (port_data(pt)[i] == '\r'))
+ break;
+ start = i;
+
+ /* start at current position and look ahead a few chars */
+ for (i = port_position(pt), j = 0; (i < port_data_size(pt)) && (j < QUOTE_SIZE); i++, j++)
+ if ((port_data(pt)[i] == '\0') ||
+ (port_data(pt)[i] == '\n') ||
+ (port_data(pt)[i] == '\r'))
+ break;
+
+ end = i;
+ slen = end - start;
+ /* hopefully this is more or less the current line where the read error happened */
+
+ if (slen > 0)
+ {
+ recent_input = (char *)calloc((slen + 9), sizeof(char));
+ for (i = 0; i < (slen + 8); i++) recent_input[i] = '.';
+ recent_input[3] = ' ';
+ recent_input[slen + 4] = ' ';
+ for (i = 0; i < slen; i++) recent_input[i + 4] = port_data(pt)[start + i];
+ }
+
+ if ((port_line_number(pt) > 0) &&
+ (port_filename(pt)))
+ {
+ len = safe_strlen(recent_input) + safe_strlen(errmsg) + port_filename_length(pt) + safe_strlen(sc->current_file) + 64;
+ msg = (char *)malloc(len * sizeof(char));
+ len = snprintf(msg, len, "%s: %s %s[%u], last top-level form at: %s[%d]",
+ errmsg, (recent_input) ? recent_input : "", port_filename(pt), port_line_number(pt),
+ sc->current_file, sc->current_line);
+ }
+ else
+ {
+ len = safe_strlen(recent_input) + safe_strlen(errmsg) + safe_strlen(sc->current_file) + 64;
+ msg = (char *)malloc(len * sizeof(char));
+
+ if ((sc->current_file) &&
+ (sc->current_line >= 0))
+ len = snprintf(msg, len, "%s: %s, last top-level form at %s[%d]",
+ errmsg, (recent_input) ? recent_input : "",
+ sc->current_file, sc->current_line);
+ else len = snprintf(msg, len, "%s: %s", errmsg, (recent_input) ? recent_input : "");
+ }
+
+ if (recent_input) free(recent_input);
+ return(s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
+ }
+
+ if ((port_line_number(pt) > 0) &&
+ (port_filename(pt)))
+ {
+ len = safe_strlen(errmsg) + port_filename_length(pt) + safe_strlen(sc->current_file) + 128;
+ msg = (char *)malloc(len * sizeof(char));
+
+ if (string_error)
+ len = snprintf(msg, len, "%s %s[%u],\n; possible culprit: \"%s...\"\n; last top-level form at %s[%d]",
+ errmsg, port_filename(pt), port_line_number(pt),
+ sc->strbuf, sc->current_file, sc->current_line);
+ else len = snprintf(msg, len, "%s %s[%u], last top-level form at %s[%d]",
+ errmsg, port_filename(pt), port_line_number(pt),
+ sc->current_file, sc->current_line);
+ return(s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
+
+ return(s7_error(sc, (string_error) ? sc->STRING_READ_ERROR : sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, (char *)errmsg))));
+}
+
+static s7_pointer read_error(s7_scheme *sc, const char *errmsg)
+{
+ return(read_error_1(sc, errmsg, false));
+}
+
+static s7_pointer string_read_error(s7_scheme *sc, const char *errmsg)
+{
+ return(read_error_1(sc, errmsg, true));
+}
+
+
+static s7_pointer g_error(s7_scheme *sc, s7_pointer args)
+{
+ #define H_error "(error type ...) signals an error. The 'type' can be used with catch to trap \
+particular errors. If the error is not caught, s7 treats the second argument as a format control string, \
+and applies it to the rest of the arguments."
+ #define Q_error pcl_t
+
+ if (is_not_null(args))
+ {
+ if (is_string(car(args))) /* CL-style error? -- use tag = 'no-catch */
+ {
+ s7_error(sc, sc->NO_CATCH, args); /* this can have trailing args (implicit format) */
+ return(sc->UNSPECIFIED);
+ }
+ return(s7_error(sc, car(args), cdr(args)));
+ }
+ return(s7_error(sc, sc->NIL, sc->NIL));
+}
+
+
+static char *truncate_string(char *form, int len, use_write_t use_write, int *form_len)
+{
+ unsigned char *f;
+ f = (unsigned char *)form;
+
+ if (use_write != USE_DISPLAY)
+ {
+ /* I guess we need to protect the outer double quotes in this case */
+ int i;
+ for (i = len - 5; i >= (len / 2); i--)
+ if (is_white_space((int)f[i]))
+ {
+ form[i] = '.';
+ form[i + 1] = '.';
+ form[i + 2] = '.';
+ form[i + 3] = '"';
+ form[i + 4] = '\0';
+ (*form_len) = i + 4;
+ return(form);
+ }
+ i = len - 5;
+ if (i > 0)
+ {
+ form[i] = '.';
+ form[i + 1] = '.';
+ form[i + 2] = '.';
+ form[i + 3] = '"';
+ form[i + 4] = '\0';
+ }
+ else
+ {
+ if (len >= 2)
+ {
+ form[len - 1] = '"';
+ form[len] = '\0';
+ }
+ }
+ }
+ else
+ {
+ int i;
+ for (i = len - 4; i >= (len / 2); i--)
+ if (is_white_space((int)f[i]))
+ {
+ form[i] = '.';
+ form[i + 1] = '.';
+ form[i + 2] = '.';
+ form[i + 3] = '\0';
+ (*form_len) = i + 3;
+ return(form);
+ }
+ i = len - 4;
+ if (i >= 0)
+ {
+ form[i] = '.';
+ form[i + 1] = '.';
+ form[i + 2] = '.';
+ form[i + 3] = '\0';
+ }
+ else form[len] = '\0';
+ }
+ return(form);
+}
+
+
+static char *object_to_truncated_string(s7_scheme *sc, s7_pointer p, int len)
+{
+ char *s;
+ int s_len;
+ s = s7_object_to_c_string(sc, p);
+ s_len = safe_strlen(s);
+ if (s_len > len)
+ return(truncate_string(s, len, USE_DISPLAY, &s_len));
+ return(s);
+}
+
+
+static char *missing_close_paren_syntax_check(s7_scheme *sc, s7_pointer lst)
+{
+ s7_pointer p, old_hook;
+ int old_hook_loc;
+ char *msg = NULL;
+
+ /* this can get into an infinite loop if unbound variable hook gets involved so...
+ */
+ old_hook = s7_hook_functions(sc, sc->unbound_variable_hook);
+ old_hook_loc = s7_gc_protect(sc, old_hook);
+ s7_hook_set_functions(sc, sc->unbound_variable_hook, sc->NIL);
+
+ for (p = lst; is_pair(p); p = cdr(p))
+ {
+ if (is_pair(car(p)))
+ {
+ s7_pointer sym;
+ sym = caar(p);
+ if (is_symbol(sym))
+ {
+ int len;
+
+ len = s7_list_length(sc, car(p));
+ if (((sym == make_symbol_with_length(sc, "if", 2)) &&
+ (len > 4)) ||
+ /* some care is needed -- we can't risk autoloading the very same file we're complaining about! */
+ ((is_slot(global_slot(sym))) &&
+ (s7_is_procedure(slot_value(global_slot(sym)))) &&
+ (!s7_is_aritable(sc, slot_value(global_slot(sym)), len))) ||
+ ((sym == make_symbol_with_length(sc, "define", 6)) &&
+ (is_pair(cdr(p))) &&
+ (is_symbol(cadr(p))) &&
+ (len > 3)))
+ {
+ int msg_len, form_len;
+ char *form;
+ /* it's very tricky to try to see other errors here, especially because 'case'
+ * can have syntax names in its key lists. Even this may get fooled, but
+ * I'm hoping that more often than not, it will help track down the missing
+ * close paren.
+ */
+
+ form = object_to_truncated_string(sc, car(p), 80);
+ form_len = safe_strlen(form);
+ msg_len = form_len + 128;
+ msg = (char *)malloc(msg_len * sizeof(char));
+ snprintf(msg, msg_len, "; this looks bogus: %s", form);
+ free(form);
+
+ s7_hook_set_functions(sc, sc->unbound_variable_hook, old_hook);
+ s7_gc_unprotect_at(sc, old_hook_loc);
+
+ return(msg);
+ }
+ }
+ msg = missing_close_paren_syntax_check(sc, car(p));
+ if (msg)
+ {
+ s7_hook_set_functions(sc, sc->unbound_variable_hook, old_hook);
+ s7_gc_unprotect_at(sc, old_hook_loc);
+ return(msg);
+ }
+ }
+ }
+ s7_hook_set_functions(sc, sc->unbound_variable_hook, old_hook);
+ s7_gc_unprotect_at(sc, old_hook_loc);
+
+ return(NULL);
+}
+
+static s7_pointer missing_close_paren_error(s7_scheme *sc)
+{
+ int len;
+ char *msg, *syntax_msg = NULL;
+ s7_pointer pt;
+
+ if ((unchecked_type(sc->envir) != T_LET) &&
+ (sc->envir != sc->NIL))
+ sc->envir = sc->NIL;
+
+ /* check *missing-close-paren-hook* */
+ if (!is_null(sc->missing_close_paren_hook))
+ {
+ s7_pointer result;
+ result = s7_call(sc, sc->missing_close_paren_hook, sc->NIL);
+ if (result != sc->UNSPECIFIED)
+ return(g_throw(sc, list_1(sc, result)));
+ }
+
+ pt = sc->input_port;
+
+ /* it's hard to give a good idea here of where the missing paren is because we've already
+ * popped off all the stacked info, following ')' until eof.
+ * but the current incoming program code is in sc->args, reversed at its top level,
+ * so it's worth looking for some problem involving too many clauses (if) or arguments, etc.
+ * another gotcha: since we're in the reader, we can't depend on sc->envir!
+ * this can be a hard bug to track down in a large program, so s7 really has to make an effort to help.
+ */
+
+ if (is_pair(sc->args))
+ {
+ s7_pointer lx;
+ lx = s7_reverse(sc, sc->args);
+ syntax_msg = missing_close_paren_syntax_check(sc, lx);
+ /* if syntax_msg is null, we didn't find the problem, so perhaps show it indented?
+ */
+ }
+
+ if ((port_line_number(pt) > 0) &&
+ (port_filename(pt)))
+ {
+ len = port_filename_length(pt) + safe_strlen(sc->current_file) + safe_strlen(syntax_msg) + 128;
+ msg = (char *)malloc(len * sizeof(char));
+ if (syntax_msg)
+ {
+ len = snprintf(msg, len, "missing close paren, %s[%u], last top-level form at %s[%d]\n%s",
+ port_filename(pt), port_line_number(pt),
+ sc->current_file, sc->current_line, syntax_msg);
+ free(syntax_msg);
+ }
+ else len = snprintf(msg, len, "missing close paren, %s[%u], last top-level form at %s[%d]",
+ port_filename(pt), port_line_number(pt),
+ sc->current_file, sc->current_line);
+ return(s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
+
+ if (syntax_msg)
+ {
+ len = safe_strlen(syntax_msg) + 128;
+ msg = (char *)malloc(len * sizeof(char));
+ len = snprintf(msg, len, "missing close paren\n%s\n", syntax_msg);
+ free(syntax_msg);
+ return(s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_uncopied_with_length(sc, msg, len))));
+ }
+ return(s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "missing close paren"))));
+}
+
+
+static void improper_arglist_error(s7_scheme *sc)
+{
+ /* sc->code is the last (dotted) arg, sc->args is the arglist reversed not including sc->code
+ * the original was `(,@(reverse args) . ,code) essentially
+ */
+ if (sc->args == sc->NIL) /* (abs . 1) */
+ s7_error(sc, sc->SYNTAX_ERROR, set_elist_1(sc, make_string_wrapper(sc, "function call is a dotted list?")));
+ else s7_error(sc, sc->SYNTAX_ERROR,
+ set_elist_2(sc, make_string_wrapper(sc, "improper list of arguments: ~S"),
+ append_in_place(sc, sc->args = safe_reverse_in_place(sc, sc->args), sc->code)));
+}
+
+
+
+/* -------------------------------- leftovers -------------------------------- */
+
+
+void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val)
+{
+ return(sc->begin_hook);
+}
+
+
+void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val))
+{
+ sc->begin_hook = hook;
+}
+
+
+static bool call_begin_hook(s7_scheme *sc)
+{
+ bool result = false;
+ /* originally begin_hook was bool (*hook)(s7_scheme *sc): the value was returned directly,
+ * rather than going through a *bool arg (&result below). That works in gcc (Linux/OSX),
+ * but does not work in MS Visual C++. In the latter, the compiler apparently completely
+ * eliminates any local, returning (for example) a thread-relative stack-allocated value
+ * directly, but then by the time we get here, that variable has vanished, and we get
+ * garbage. We had to thwart the optimization by adding if ((flag) && (!flag)) fprintf(...);
+ * So, in the new form (26-Jun-13), the value is passed directly into an s7 variable
+ * that I hope can't be optimized out of existence.
+ */
+ opcode_t op;
+ op = sc->op;
+
+ push_stack(sc, OP_BARRIER, sc->args, sc->code);
+ sc->begin_hook(sc, &result);
+ if (result)
+ {
+ /* set (owlet) in case we were interrupted and need to see why something was hung */
+ slot_set_value(sc->error_type, sc->F);
+ slot_set_value(sc->error_data, sc->value); /* was sc->F but we now clobber this below */
+ slot_set_value(sc->error_code, sc->cur_code);
+ slot_set_value(sc->error_line, sc->F);
+ slot_set_value(sc->error_file, sc->F);
+ set_outlet(sc->owlet, sc->envir);
+
+ sc->value = s7_make_symbol(sc, "begin-hook-interrupt");
+ /* otherwise the evaluator returns whatever random thing is in sc->value (normally #<closure>)
+ * which makes debugging unnecessarily difficult.
+ */
+ s7_quit(sc); /* don't call gc here -- perhaps at restart somehow? */
+ return(true);
+ }
+ pop_stack_no_op(sc);
+ sc->op = op; /* for better error handling. otherwise we get "barrier" as the offending function name in eval_error */
+ return(false);
+}
+
+
+static s7_pointer apply_list_star(s7_scheme *sc, s7_pointer d)
+{
+ s7_pointer p, q;
+ /* we check this ahead of time: if (is_null(cdr(d))) return(car(d)); */
+ p = cons(sc, car(d), cdr(d));
+ q = p;
+ while (is_not_null(cdr(cdr(p))))
+ {
+ d = cons(sc, car(p), cdr(p));
+ p = cdr(p);
+ }
+ cdr(p) = car(cdr(p));
+ return(q);
+}
+
+
+static s7_pointer apply_list_error(s7_scheme *sc, s7_pointer lst)
+{
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "apply's last argument should be a proper list: ~S"), lst)));
+}
+
+static s7_pointer g_apply(s7_scheme *sc, s7_pointer args)
+{
+ #define H_apply "(apply func ...) applies func to the rest of the arguments"
+ #define Q_apply s7_make_circular_signature(sc, 2, 3, sc->VALUES, sc->IS_PROCEDURE, sc->T)
+
+ /* can apply always be replaced with apply values?
+ * (apply + '(1 2 3)) is the same as (+ (apply values '(1 2 3)))
+ * not if apply* in disguise, I think:
+ * (apply + 1 2 ()) -> 3
+ * (apply + 1 2 (apply values ())) -> error
+ */
+ sc->code = car(args);
+ if (is_null(cdr(args)))
+ sc->args = sc->NIL;
+ else
+ {
+ if (is_safe_procedure(sc->code))
+ {
+ s7_pointer p, q;
+
+ for (q = args, p = cdr(args); is_not_null(cdr(p)); q = p, p = cdr(p));
+ /* the last arg is supposed to be a list, it will be spliced onto the end of the previous arg list (if any) below */
+
+ if (!is_proper_list(sc, car(p))) /* (apply + #f) etc */
+ return(apply_list_error(sc, args));
+ cdr(q) = car(p);
+ /* this would work: if (is_c_function(sc->code)) return(c_function_call(sc->code)(sc, cdr(args)));
+ * but it omits the arg number check
+ */
+ push_stack(sc, OP_APPLY, cdr(args), sc->code);
+ return(sc->NIL);
+ }
+ else
+ {
+ /* here we have to copy the arg list */
+ if (is_null(cddr(args)))
+ sc->args = cadr(args);
+ else sc->args = apply_list_star(sc, cdr(args));
+
+ if (!is_proper_list(sc, sc->args)) /* (apply + #f) etc */
+ return(apply_list_error(sc, args));
+ }
+ }
+
+ push_stack(sc, OP_APPLY, sc->args, sc->code);
+ return(sc->NIL);
+}
+
+s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args)
+{
+ if (is_c_function(fnc))
+ return(c_function_call(fnc)(sc, args));
+
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->args = args;
+ sc->code = fnc;
+ eval(sc, OP_APPLY);
+ /* we're limited in choices here -- the caller might be (say) car(sc->T1_1) = c_call(...) where the c_call
+ * happens to fallback on a method -- we can't just push OP_APPLY and drop back into the evaluator normally.
+ */
+ return(sc->value);
+}
+
+
+s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e)
+{
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->code = code;
+ if ((e != sc->rootlet) &&
+ (is_let(e)))
+ sc->envir = e;
+ else sc->envir = sc->NIL; /* can't check is_let(e) because sc->rootlet sets its type to t_env! */
+ eval(sc, OP_BEGIN);
+ return(sc->value);
+}
+
+
+s7_pointer s7_eval_form(s7_scheme *sc, s7_pointer form, s7_pointer e)
+{
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
+ sc->code = form;
+ if ((e != sc->rootlet) &&
+ (is_let(e)))
+ sc->envir = e;
+ else sc->envir = sc->NIL;
+ eval(sc, OP_EVAL);
+ return(sc->value);
+}
+
+
+static s7_pointer g_eval(s7_scheme *sc, s7_pointer args)
+{
+ #define H_eval "(eval code (env (curlet))) evaluates code in the environment env. 'env' \
+defaults to the curlet; to evaluate something in the top-level environment instead, \
+pass (rootlet):\n\
+\n\
+ (define x 32) \n\
+ (let ((x 3))\n\
+ (eval 'x (rootlet)))\n\
+\n\
+ returns 32"
+ #define Q_eval s7_make_signature(sc, 3, sc->VALUES, sc->IS_LIST, sc->IS_LET)
+
+ if (is_not_null(cdr(args)))
+ {
+ s7_pointer e;
+ e = cadr(args);
+ if (!is_let(e))
+ return(wrong_type_argument_with_type(sc, sc->EVAL, 2, e, A_LET));
+ if (e == sc->rootlet)
+ sc->envir = sc->NIL;
+ else sc->envir = e;
+ }
+ sc->code = car(args);
+
+ if (s7_stack_top(sc) < 12)
+ push_stack(sc, OP_BARRIER, sc->NIL, sc->NIL);
+ push_stack(sc, OP_EVAL, sc->args, sc->code);
+
+ return(sc->NIL);
+}
+
+
+s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args)
+{
+ bool old_longjmp;
+ jmp_buf old_goto_start;
+
+ /* this can be called while we are in the eval loop (within eval_c_string for instance),
+ * and if we reset the stack, the previously running evaluation steps off the end
+ * of the stack == segfault.
+ */
+ if (is_c_function(func))
+ return(c_function_call(func)(sc, args)); /* no check for wrong-number-of-args -- is that reasonable? */
+
+ sc->temp1 = func; /* this is just GC protection */
+ sc->temp2 = args;
+
+ old_longjmp = sc->longjmp_ok;
+ memcpy((void *)old_goto_start, (void *)(sc->goto_start), sizeof(jmp_buf));
+
+ /* if an error occurs during s7_call, and it is caught, catch (above) wants to longjmp
+ * to its caller to complete the error handler evaluation so that the C stack is
+ * cleaned up -- this means we have to have the longjmp location set here, but
+ * we could get here from anywhere, so we need to save and restore the incoming
+ * longjmp location.
+ */
+
+ sc->longjmp_ok = true;
+ if (setjmp(sc->goto_start) != 0) /* returning from s7_error catch handler */
+ {
+ sc->longjmp_ok = old_longjmp;
+ memcpy((void *)(sc->goto_start), (void *)old_goto_start, sizeof(jmp_buf));
+
+ if ((sc->op == OP_ERROR_QUIT) &&
+ (sc->longjmp_ok))
+ longjmp(sc->goto_start, 1); /* this is trying to clear the C stack back to some clean state */
+
+ eval(sc, sc->op);
+ /* sc->op can be OP_APPLY if s7_call raised an error that was caught (via catch) -- we're about to go to the error handler */
+ return(sc->value);
+ }
+
+ push_stack(sc, OP_EVAL_DONE, sc->args, sc->code); /* this saves the current evaluation and will eventually finish this (possibly) nested call */
+ sc->args = args;
+ sc->code = func;
+ /* besides a closure, "func" can also be an object (T_C_OBJECT) -- in Snd, a generator for example */
+
+ eval(sc, OP_APPLY);
+
+ sc->longjmp_ok = old_longjmp;
+ memcpy((void *)(sc->goto_start), (void *)old_goto_start, sizeof(jmp_buf));
+ return(sc->value);
+}
+
+
+s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, int line)
+{
+ s7_pointer result;
+
+ if (caller)
+ {
+ sc->s7_call_name = caller;
+ sc->s7_call_file = file;
+ sc->s7_call_line = line;
+ }
+
+ result = s7_call(sc, func, args);
+
+ if (caller)
+ {
+ sc->s7_call_name = NULL;
+ sc->s7_call_file = NULL;
+ sc->s7_call_line = -1;
+ }
+ return(result);
+}
+
+
+static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indices)
+{
+ /* (let ((lst '("12" "34"))) (lst 0 1)) -> #\2
+ * (let ((lst (list #(1 2) #(3 4)))) (lst 0 1)) -> 2
+ *
+ * this can get tricky:
+ * ((list (lambda (a) (+ a 1)) (lambda (b) (* b 2))) 1 2) -> 4
+ * but what if func takes rest/optional args, etc?
+ * ((list (lambda args (car args))) 0 "hi" 0)
+ * should this return #\h or "hi"??
+ * currently it is "hi" which is consistent with
+ * ((lambda args (car args)) "hi" 0)
+ * but...
+ * ((lambda (arg) arg) "hi" 0)
+ * is currently an error (too many arguments)
+ * it should be (((lambda (arg) arg) "hi") 0) -> #\h
+ *
+ * this applies to non-homogenous cases, so float|int-vectors don't get here
+ */
+
+ switch (type(obj))
+ {
+ case T_VECTOR: /* (#(#(1 2) #(3 4)) 1 1) -> 4 */
+ return(vector_ref_1(sc, obj, indices));
+
+ case T_STRING: /* (#("12" "34") 0 1) -> #\2 */
+ if (is_null(cdr(indices)))
+ {
+ if (is_byte_vector(obj)) /* ((vector (byte-vector 1)) 0 0) */
+ return(small_int((unsigned int)(character(string_ref_1(sc, obj, car(indices))))));
+ return(string_ref_1(sc, obj, car(indices)));
+ }
+ return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->TOO_MANY_ARGUMENTS, obj, indices)));
+
+ case T_PAIR: /* (#((1 2) (3 4)) 1 0) -> 3, (#((1 (2 3))) 0 1 0) -> 2 */
+ obj = list_ref_1(sc, obj, car(indices));
+ if (is_pair(cdr(indices)))
+ return(implicit_index(sc, obj, cdr(indices)));
+ return(obj);
+
+ case T_HASH_TABLE: /* ((vector (hash-table '(a . 1) '(b . 2))) 0 'a) -> 1 */
+ obj = s7_hash_table_ref(sc, obj, car(indices));
+ if (is_pair(cdr(indices)))
+ return(implicit_index(sc, obj, cdr(indices)));
+ return(obj);
+
+ case T_C_OBJECT:
+ return((*(c_object_ref(obj)))(sc, obj, indices));
+
+ case T_LET:
+ obj = s7_let_ref(sc, obj, car(indices));
+ if (is_pair(cdr(indices)))
+ return(implicit_index(sc, obj, cdr(indices)));
+ return(obj);
+
+ default: /* (#(a b c) 0 1) -> error, but ((list (lambda (x) x)) 0 "hi") -> "hi" */
+ return(g_apply(sc, list_2(sc, obj, indices)));
+ }
+}
+
+/* -------------------------------- s7-version -------------------------------- */
+static s7_pointer g_s7_version(s7_scheme *sc, s7_pointer args)
+{
+ #define H_s7_version "(s7-version) returns some string describing the current s7"
+ #define Q_s7_version pcl_s
+
+#if WITH_COUNTS
+ report_counts(sc);
+#endif
+ return(s7_make_string(sc, "s7 " S7_VERSION ", " S7_DATE));
+}
+
+
+void s7_quit(s7_scheme *sc)
+{
+ sc->longjmp_ok = false;
+ pop_input_port(sc);
+ stack_reset(sc);
+ push_stack(sc, OP_EVAL_DONE, sc->NIL, sc->NIL);
+}
+
+/* -------------------------------- exit -------------------------------- */
+static s7_pointer g_emergency_exit(s7_scheme *sc, s7_pointer args)
+{
+ #define H_emergency_exit "(emergency-exit obj) exits s7 immediately"
+ #define Q_emergency_exit pcl_t
+
+ s7_pointer obj;
+#ifndef EXIT_SUCCESS
+ #define EXIT_SUCCESS 0
+ #define EXIT_FAILURE 1
+#endif
+ if (is_null(args))
+ _exit(EXIT_SUCCESS); /* r7rs spec says use _exit here */
+ obj = car(args);
+ if (obj == sc->F)
+ _exit(EXIT_FAILURE);
+ if ((obj == sc->T) || (!s7_is_integer(obj)))
+ _exit(EXIT_SUCCESS);
+ _exit((int)s7_integer(obj));
+ return(sc->F);
+}
+
+
+static s7_pointer g_exit(s7_scheme *sc, s7_pointer args)
+{
+ #define H_exit "(exit obj) exits s7"
+ #define Q_exit pcl_t
+
+ s7_quit(sc);
+ return(g_emergency_exit(sc, args));
+}
+
+
+#if DEBUGGING
+static s7_pointer g_abort(s7_scheme *sc, s7_pointer args) {abort();}
+#endif
+
+
+
+static s7_function all_x_function[OPT_MAX_DEFINED];
+#define is_all_x_op(Op) (all_x_function[Op] != NULL)
+
+static bool is_all_x_safe(s7_scheme *sc, s7_pointer p)
+{
+ return((!is_pair(p)) ||
+ ((car(p) == sc->QUOTE) && (is_pair(cdr(p)))) || /* (if #t (quote . -1)) */
+ ((is_optimized(p)) && (is_all_x_op(optimize_op(p)))));
+}
+
+
+static int all_x_count(s7_pointer x)
+{
+ int count = 0;
+ s7_pointer p;
+ for (p = cdr(x); is_pair(p); p = cdr(p))
+ if ((is_optimized(car(p))) &&
+ (is_all_x_op(optimize_op(car(p)))))
+ count++;
+ return(count);
+}
+
+
+/* arg here is the full expression */
+
+static s7_pointer all_x_else(s7_scheme *sc, s7_pointer arg) {return(sc->T);} /* used in cond_all_x */
+static s7_pointer all_x_c(s7_scheme *sc, s7_pointer arg) {return(arg);}
+static s7_pointer all_x_q(s7_scheme *sc, s7_pointer arg) {return(cadr(arg));}
+static s7_pointer all_x_s(s7_scheme *sc, s7_pointer arg) {return(find_symbol_checked(sc, arg));}
+static s7_pointer all_x_u(s7_scheme *sc, s7_pointer arg) {return(find_symbol_unchecked(sc, arg));}
+static s7_pointer all_x_k(s7_scheme *sc, s7_pointer arg) {return(arg);}
+static s7_pointer all_x_c_c(s7_scheme *sc, s7_pointer arg) {return(c_call(arg)(sc, cdr(arg)));}
+
+static s7_pointer all_x_c_add1(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer x;
+ x = find_symbol_unchecked(sc, cadr(arg));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + 1));
+ return(g_add_s1_1(sc, x, arg));
+}
+
+static s7_pointer all_x_c_addi(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer x;
+ x = find_symbol_unchecked(sc, cadr(arg));
+ if (is_integer(x))
+ return(make_integer(sc, integer(x) + integer(caddr(arg))));
+ return(g_add_2(sc, set_plist_2(sc, x, caddr(arg))));
+}
+
+static s7_pointer all_x_c_char_eq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer c;
+ c = find_symbol_unchecked(sc, cadr(arg));
+ if (c == caddr(arg))
+ return(sc->T);
+ if (s7_is_character(c))
+ return(sc->F);
+ method_or_bust(sc, c, sc->CHAR_EQ, set_plist_2(sc, c, caddr(arg)), T_CHARACTER, 1);
+}
+
+static s7_pointer all_x_c_q(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T1_1) = cadr(cadr(arg));
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_s(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(arg));
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_u(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(arg));
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_cdr_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = find_symbol_checked(sc, cadr(arg));
+ return((is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val)));
+}
+
+static s7_pointer all_x_cdr_u(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = find_symbol_unchecked(sc, cadr(arg));
+ return((is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val)));
+}
+
+static s7_pointer all_x_car_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer val;
+ val = find_symbol_checked(sc, cadr(arg));
+ return((is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val)));
+}
+
+static s7_pointer all_x_null_s(s7_scheme *sc, s7_pointer arg)
+{
+ return(make_boolean(sc, is_null(find_symbol_checked(sc, cadr(arg)))));
+}
+
+static s7_pointer all_x_c_sc(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T2_2) = caddr(arg);
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_uc(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(arg));
+ car(sc->T2_2) = caddr(arg);
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_cs(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T2_1) = cadr(arg);
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_ss(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_uu(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(arg));
+ car(sc->T2_2) = find_symbol_unchecked(sc, caddr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_sss(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T3_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T3_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T3_3) = find_symbol_checked(sc, cadddr(arg));
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_uuu(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T3_1) = find_symbol_unchecked(sc, cadr(arg));
+ car(sc->T3_2) = find_symbol_unchecked(sc, caddr(arg));
+ car(sc->T3_3) = find_symbol_unchecked(sc, cadddr(arg));
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_scs(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T3_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T3_3) = find_symbol_checked(sc, cadddr(arg));
+ car(sc->T3_2) = caddr(arg);
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_css(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T3_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T3_3) = find_symbol_checked(sc, cadddr(arg));
+ car(sc->T3_1) = cadr(arg);
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_csc(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T3_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T3_1) = cadr(arg);
+ car(sc->T3_3) = cadddr(arg);
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_ssc(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T3_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T3_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T3_3) = cadddr(arg);
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_sq(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T2_2) = cadr(caddr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T1_1) = c_call(largs)(sc, cdr(largs));
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_s_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ car(sc->T2_2) = c_call(largs)(sc, cdr(largs));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_c_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ car(sc->T2_2) = c_call(largs)(sc, cdr(largs));
+ car(sc->T2_1) = cadr(arg);
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opcq_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = c_call(largs)(sc, cdr(largs));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opcq_c(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = c_call(largs)(sc, cdr(largs));
+ car(sc->T2_2) = caddr(arg);
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opcq_opcq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = c_call(largs)(sc, cdr(largs));
+ largs = caddr(arg);
+ car(sc->T2_2) = c_call(largs)(sc, cdr(largs));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T1_1) = c_call(largs)(sc, sc->T1_1);
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_not_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(largs));
+ if (c_call(largs)(sc, sc->T1_1) == sc->F)
+ return(sc->T);
+ return(sc->F);
+}
+
+static s7_pointer all_x_c_opuq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(largs));
+ car(sc->T1_1) = c_call(largs)(sc, sc->T1_1);
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_not_opuq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(largs));
+ if (c_call(largs)(sc, sc->T1_1) == sc->F)
+ return(sc->T);
+ return(sc->F);
+}
+
+static s7_pointer all_x_c_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(largs));
+ car(sc->T1_1) = c_call(largs)(sc, sc->T2_1);
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_opuuq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_unchecked(sc, caddr(largs));
+ car(sc->T1_1) = c_call(largs)(sc, sc->T2_1);
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_opscq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = caddr(largs);
+ car(sc->T1_1) = c_call(largs)(sc, sc->T2_1);
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_opsqq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = cadr(caddr(largs));
+ car(sc->T1_1) = c_call(largs)(sc, sc->T2_1);
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_opssq_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(largs));
+ car(sc->T2_1) = c_call(largs)(sc, sc->T2_1);
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opuuq_u(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_unchecked(sc, caddr(largs));
+ car(sc->T2_1) = c_call(largs)(sc, sc->T2_1);
+ car(sc->T2_2) = find_symbol_unchecked(sc, caddr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opssq_c(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(largs));
+ car(sc->T2_1) = c_call(largs)(sc, sc->T2_1);
+ car(sc->T2_2) = caddr(arg);
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opsq_s(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_1) = c_call(largs)(sc, sc->T1_1);
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opuq_u(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(largs));
+ car(sc->T2_1) = c_call(largs)(sc, sc->T1_1);
+ car(sc->T2_2) = find_symbol_unchecked(sc, caddr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opsq_c(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cadr(arg);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_1) = c_call(largs)(sc, sc->T1_1);
+ car(sc->T2_2) = caddr(arg);
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_s_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T2_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_u_opuuq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_unchecked(sc, caddr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T2_1);
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_s_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T1_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_u_opuq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T1_1);
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(arg));
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_c_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = caddr(arg);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T1_1);
+ car(sc->T2_1) = cadr(arg);
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opsq_opsq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cdr(arg);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(car(largs)));
+ sc->temp3 = c_call(car(largs))(sc, sc->T1_1);
+ largs = cadr(largs);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T1_1);
+ car(sc->T2_1) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opuq_opuq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cdr(arg);
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(car(largs)));
+ sc->temp3 = c_call(car(largs))(sc, sc->T1_1);
+ largs = cadr(largs);
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T1_1);
+ car(sc->T2_1) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opssq_opssq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cdr(arg);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(car(largs)));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(car(largs)));
+ sc->temp3 = c_call(car(largs))(sc, sc->T2_1);
+ largs = cadr(largs);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T2_1);
+ car(sc->T2_1) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_opuuq_opuuq(s7_scheme *sc, s7_pointer arg)
+{
+ s7_pointer largs;
+ largs = cdr(arg);
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(car(largs)));
+ car(sc->T2_2) = find_symbol_unchecked(sc, caddr(car(largs)));
+ sc->temp3 = c_call(car(largs))(sc, sc->T2_1);
+ largs = cadr(largs);
+ car(sc->T2_1) = find_symbol_unchecked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_unchecked(sc, caddr(largs));
+ car(sc->T2_2) = c_call(largs)(sc, sc->T2_1);
+ car(sc->T2_1) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_op_opssq_q_c(s7_scheme *sc, s7_pointer code)
+{
+ s7_pointer arg;
+ arg = cadr(cadr(code));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T1_1) = c_call(arg)(sc, sc->T2_1);
+ car(sc->T2_1) = c_call(cadr(code))(sc, sc->T1_1);
+ car(sc->T2_2) = caddr(code);
+ return(c_call(code)(sc, sc->T2_1));
+}
+
+static s7_pointer all_x_c_a(s7_scheme *sc, s7_pointer arg)
+{
+ car(sc->T1_1) = c_call(cdr(arg))(sc, cadr(arg));
+ return(c_call(arg)(sc, sc->T1_1));
+}
+
+static s7_pointer all_x_c_ssa(s7_scheme *sc, s7_pointer arg)
+{
+ sc->temp3 = c_call(cdddr(arg))(sc, cadddr(arg));
+ car(sc->T3_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T3_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T3_3) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_sas(s7_scheme *sc, s7_pointer arg)
+{
+ sc->temp3 = c_call(cddr(arg))(sc, caddr(arg));
+ car(sc->T3_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T3_3) = find_symbol_checked(sc, cadddr(arg));
+ car(sc->T3_2) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_sca(s7_scheme *sc, s7_pointer arg)
+{
+ sc->temp3 = c_call(cdddr(arg))(sc, cadddr(arg));
+ car(sc->T3_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T3_2) = caddr(arg);
+ car(sc->T3_3) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_csa(s7_scheme *sc, s7_pointer arg)
+{
+ sc->temp3 = c_call(cdddr(arg))(sc, cadddr(arg));
+ car(sc->T3_1) = cadr(arg);
+ car(sc->T3_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T3_3) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static s7_pointer all_x_c_cas(s7_scheme *sc, s7_pointer arg)
+{
+ sc->temp3 = c_call(cddr(arg))(sc, caddr(arg));
+ car(sc->T3_1) = cadr(arg);
+ car(sc->T3_3) = find_symbol_checked(sc, cadddr(arg));
+ car(sc->T3_2) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ return(c_call(arg)(sc, sc->T3_1));
+}
+
+static void all_x_function_init(void)
+{
+ int i;
+ for (i = 0; i < OPT_MAX_DEFINED; i++)
+ all_x_function[i] = NULL;
+
+ all_x_function[HOP_SAFE_C_C] = all_x_c_c;
+ all_x_function[HOP_SAFE_C_Q] = all_x_c_q;
+ all_x_function[HOP_SAFE_C_A] = all_x_c_a;
+ all_x_function[HOP_SAFE_C_S] = all_x_c_s;
+
+ all_x_function[HOP_SAFE_C_opCq] = all_x_c_opcq;
+ all_x_function[HOP_SAFE_C_opSq] = all_x_c_opsq;
+ all_x_function[HOP_SAFE_C_opSSq] = all_x_c_opssq;
+ all_x_function[HOP_SAFE_C_opSCq] = all_x_c_opscq;
+ all_x_function[HOP_SAFE_C_opSQq] = all_x_c_opsqq;
+
+ all_x_function[HOP_SAFE_C_SC] = all_x_c_sc;
+ all_x_function[HOP_SAFE_C_CS] = all_x_c_cs;
+ all_x_function[HOP_SAFE_C_SQ] = all_x_c_sq;
+ all_x_function[HOP_SAFE_C_SS] = all_x_c_ss;
+
+ all_x_function[HOP_SAFE_C_opSq_S] = all_x_c_opsq_s;
+ all_x_function[HOP_SAFE_C_opSq_C] = all_x_c_opsq_c;
+ all_x_function[HOP_SAFE_C_S_opSq] = all_x_c_s_opsq;
+ all_x_function[HOP_SAFE_C_S_opCq] = all_x_c_s_opcq;
+ all_x_function[HOP_SAFE_C_opCq_S] = all_x_c_opcq_s;
+ all_x_function[HOP_SAFE_C_opCq_C] = all_x_c_opcq_c;
+ all_x_function[HOP_SAFE_C_C_opSq] = all_x_c_c_opsq;
+ all_x_function[HOP_SAFE_C_C_opCq] = all_x_c_c_opcq;
+ all_x_function[HOP_SAFE_C_opSSq_C] = all_x_c_opssq_c;
+ all_x_function[HOP_SAFE_C_opSSq_S] = all_x_c_opssq_s;
+ all_x_function[HOP_SAFE_C_S_opSSq] = all_x_c_s_opssq;
+ all_x_function[HOP_SAFE_C_opSq_opSq] = all_x_c_opsq_opsq;
+ all_x_function[HOP_SAFE_C_opCq_opCq] = all_x_c_opcq_opcq;
+ all_x_function[HOP_SAFE_C_opSSq_opSSq] = all_x_c_opssq_opssq;
+ all_x_function[HOP_SAFE_C_op_opSSq_q_C] = all_x_c_op_opssq_q_c;
+
+ all_x_function[HOP_SAFE_C_CSA] = all_x_c_csa;
+ all_x_function[HOP_SAFE_C_CAS] = all_x_c_cas;
+ all_x_function[HOP_SAFE_C_SCA] = all_x_c_sca;
+ all_x_function[HOP_SAFE_C_SAS] = all_x_c_sas;
+ all_x_function[HOP_SAFE_C_SSA] = all_x_c_ssa;
+ all_x_function[HOP_SAFE_C_SSC] = all_x_c_ssc;
+ all_x_function[HOP_SAFE_C_SSS] = all_x_c_sss;
+ all_x_function[HOP_SAFE_C_SCS] = all_x_c_scs;
+ all_x_function[HOP_SAFE_C_CSS] = all_x_c_css;
+ all_x_function[HOP_SAFE_C_CSC] = all_x_c_csc;
+}
+
+static s7_function all_x_eval(s7_scheme *sc, s7_pointer arg, s7_pointer e, safe_sym_t *checker)
+{
+ if (is_pair(arg))
+ {
+ if (is_optimized(arg))
+ {
+ switch (optimize_op(arg))
+ {
+ case HOP_SAFE_C_C:
+ if ((c_call(arg) == g_add_cs1) &&
+ (checker(sc, cadr(arg), e)))
+ return(all_x_c_add1);
+ if ((c_call(arg) == g_add_si) &&
+ (checker(sc, cadr(arg), e)))
+ return(all_x_c_addi);
+ if ((c_call(arg) == g_char_equal_s_ic) &&
+ (checker(sc, cadr(arg), e)))
+ return(all_x_c_char_eq);
+ return(all_x_c_c);
+
+ case HOP_SAFE_C_S:
+ if (car(arg) == sc->CDR)
+ {
+ if (checker(sc, cadr(arg), e))
+ return(all_x_cdr_u);
+ return(all_x_cdr_s);
+ }
+ if (car(arg) == sc->CAR) return(all_x_car_s);
+ if (car(arg) == sc->IS_NULL) return(all_x_null_s);
+ if (checker(sc, cadr(arg), e)) /* all we want here is assurance it's not going to be unbound */
+ return(all_x_c_u);
+ return(all_x_c_s);
+
+ case HOP_SAFE_C_SS:
+ if ((checker(sc, cadr(arg), e)) &&
+ (checker(sc, caddr(arg), e)))
+ return(all_x_c_uu);
+ return(all_x_c_ss);
+
+ case HOP_SAFE_C_SSS:
+ if ((checker(sc, cadr(arg), e)) &&
+ (checker(sc, caddr(arg), e)) &&
+ (checker(sc, cadddr(arg), e)))
+ return(all_x_c_uuu);
+ return(all_x_c_sss);
+
+ case HOP_SAFE_C_SC:
+ if (checker(sc, cadr(arg), e))
+ return(all_x_c_uc);
+ return(all_x_c_sc);
+
+ case HOP_SAFE_C_opSq:
+ if (checker(sc, cadr(cadr(arg)), e))
+ {
+ if (car(arg) == sc->NOT)
+ return(all_x_c_not_opuq);
+ return(all_x_c_opuq);
+ }
+ if (car(arg) == sc->NOT)
+ return(all_x_c_not_opsq);
+ return(all_x_c_opsq);
+
+ case HOP_SAFE_C_opSq_opSq:
+ if ((checker(sc, cadr(cadr(arg)), e)) &&
+ (checker(sc, cadr(caddr(arg)), e)))
+ return(all_x_c_opuq_opuq);
+ return(all_x_c_opsq_opsq);
+
+ case HOP_SAFE_C_opSSq_opSSq:
+ if ((checker(sc, cadr(cadr(arg)), e)) &&
+ (checker(sc, caddr(cadr(arg)), e)) &&
+ (checker(sc, cadr(caddr(arg)), e)) &&
+ (checker(sc, caddr(caddr(arg)), e)))
+ return(all_x_c_opuuq_opuuq);
+ return(all_x_c_opssq_opssq);
+
+ case HOP_SAFE_C_opSSq:
+ if ((checker(sc, cadr(cadr(arg)), e)) &&
+ (checker(sc, caddr(cadr(arg)), e)))
+ return(all_x_c_opuuq);
+ return(all_x_c_opssq);
+
+ case HOP_SAFE_C_opSSq_S:
+ if ((checker(sc, cadr(cadr(arg)), e)) &&
+ (checker(sc, caddr(cadr(arg)), e)) &&
+ (checker(sc, caddr(arg), e)))
+ return(all_x_c_opuuq_u);
+ return(all_x_c_opssq_s);
+
+ case HOP_SAFE_C_S_opSq:
+ if ((checker(sc, cadr(arg), e)) &&
+ (checker(sc, cadr(caddr(arg)), e)))
+ return(all_x_c_u_opuq);
+ return(all_x_c_s_opsq);
+
+ case HOP_SAFE_C_S_opSSq:
+ if ((checker(sc, cadr(arg), e)) &&
+ (checker(sc, cadr(caddr(arg)), e)) &&
+ (checker(sc, caddr(caddr(arg)), e)))
+ return(all_x_c_u_opuuq);
+ return(all_x_c_s_opssq);
+
+ case HOP_SAFE_C_opSq_S:
+ if ((checker(sc, cadr(cadr(arg)), e)) &&
+ (checker(sc, caddr(arg), e)))
+ return(all_x_c_opuq_u);
+ return(all_x_c_opsq_s);
+
+ default:
+ /* if (!all_x_function[optimize_op(arg)]) fprintf(stderr, "%s: %s\n", opt_names[optimize_op(arg)], DISPLAY(arg)); */
+ return(all_x_function[optimize_op(arg)]);
+ }
+ }
+ if (car(arg) == sc->QUOTE)
+ return(all_x_q);
+ return(NULL);
+ }
+ if (is_symbol(arg))
+ {
+ if (is_keyword(arg))
+ return(all_x_k);
+ if (checker(sc, arg, e))
+ return(all_x_u);
+ return(all_x_s);
+ }
+ return(all_x_c);
+}
+
+
+static s7_function cond_all_x_eval(s7_scheme *sc, s7_pointer arg, s7_pointer e)
+{
+ if (arg == sc->ELSE)
+ return(all_x_else);
+ return(all_x_eval(sc, arg, e, let_symbol_is_safe));
+}
+
+
+/* ---------------------------------------- for-each ---------------------------------------- */
+
+static s7_pointer make_counter(s7_scheme *sc, s7_pointer iter)
+{
+ s7_pointer x;
+ new_cell(sc, x, T_COUNTER);
+ counter_result(x) = sc->NIL;
+ counter_list(x) = iter; /* iterator */
+ counter_capture(x) = 0; /* will be capture_let_counter */
+ counter_set_let(x, sc->NIL); /* will be the saved env */
+ return(x);
+}
+
+static s7_pointer g_for_each(s7_scheme *sc, s7_pointer args)
+{
+ #define H_for_each "(for-each proc object . objects) applies proc to each element of the objects traversed in parallel. \
+Each object can be a list, string, vector, hash-table, or any other sequence."
+ #define Q_for_each s7_make_circular_signature(sc, 2, 3, sc->T, sc->IS_PROCEDURE, sc->LENGTH)
+
+ s7_pointer p, f;
+ int len;
+ bool got_nil = false;
+
+ /* fprintf(stderr, "for-each: %s\n", DISPLAY(args)); */
+
+ /* try the normal case first */
+ f = car(args); /* the function */
+ p = cadr(args);
+ if ((is_null(cddr(args))) &&
+ (is_pair(p)) &&
+ (is_closure(f)) && /* not lambda* that might get confused about arg names */
+ (closure_arity_to_int(sc, f) == 1) && /* not a rest arg: not is_pair: (lambda (x . args) arg) */
+ (!is_immutable_symbol(car(closure_args(f)))))
+ {
+ s7_pointer c;
+ c = make_counter(sc, p);
+ counter_result(c) = p;
+ push_stack(sc, OP_FOR_EACH_2, c, f);
+ return(sc->UNSPECIFIED);
+ }
+
+ if (!is_applicable(f))
+ method_or_bust_with_type(sc, f, sc->FOR_EACH, args, SOMETHING_APPLICABLE, 1);
+
+ for (len = 0, p = cdr(args); is_not_null(p); p = cdr(p), len++)
+ {
+ if ((!is_sequence(car(p))) && (!is_iterator(car(p))))
+ return(simple_wrong_type_argument_with_type(sc, sc->FOR_EACH, car(p), A_SEQUENCE));
+ if (is_null(car(p)))
+ got_nil = true;
+ }
+
+ if (!s7_is_aritable(sc, f, len))
+ {
+ static s7_pointer for_each_args_error = NULL;
+ if (!for_each_args_error)
+ for_each_args_error = s7_make_permanent_string("for-each ~A: ~A args?");
+ return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, for_each_args_error, f, small_int(len))));
+ }
+
+ if (got_nil) return(sc->UNSPECIFIED);
+
+ sc->temp3 = args;
+ sc->z = sc->NIL; /* don't use sc->args here -- it needs GC protection until we get the iterators */
+ for (p = cdr(args); is_not_null(p); p = cdr(p))
+ {
+ s7_pointer iter;
+ iter = car(p);
+ if (!is_iterator(car(p)))
+ iter = s7_make_iterator(sc, iter);
+ sc->z = cons(sc, iter, sc->z);
+ }
+ sc->temp3 = sc->NIL;
+
+ sc->x = make_list(sc, len, sc->NIL);
+ sc->z = safe_reverse_in_place(sc, sc->z);
+ sc->z = cons(sc, sc->z, sc->x);
+
+ /* if function is safe c func, do the for-each locally */
+ if ((is_safe_procedure(f)) &&
+ (is_c_function(f)))
+ {
+ s7_function func;
+ s7_pointer iters;
+ func = c_function_call(f);
+ push_stack(sc, OP_NO_OP, sc->args, sc->z); /* temporary GC protection */
+ if (len == 1)
+ {
+ s7_pointer x, y;
+ x = caar(sc->z);
+ y = cdr(sc->z);
+ sc->z = sc->NIL;
+ while (true)
+ {
+ car(y) = s7_iterate(sc, x);
+ if (iterator_is_at_end(x))
+ {
+ pop_stack(sc);
+ return(sc->UNSPECIFIED);
+ }
+ func(sc, y);
+ }
+ }
+ iters = sc->z;
+ sc->z = sc->NIL;
+ while (true)
+ {
+ s7_pointer x, y;
+ for (x = car(iters), y = cdr(iters); is_pair(x); x = cdr(x), y = cdr(y))
+ {
+ car(y) = s7_iterate(sc, car(x));
+ if (iterator_is_at_end(car(x)))
+ {
+
+ pop_stack(sc);
+ return(sc->UNSPECIFIED);
+ }
+ }
+ func(sc, cdr(iters));
+ }
+ }
+
+ /* if closure call is straightforward, use OP_FOR_EACH_1 */
+ if ((len == 1) &&
+ (is_closure(f)) && /* not lambda* that might get confused about arg names */
+ (closure_arity_to_int(sc, f) == 1) && /* not a rest arg: not is_pair: (lambda (x . args) arg) */
+ (!is_immutable_symbol(car(closure_args(f)))))
+ {
+ s7_pointer body, expr;
+ body = closure_body(f);
+ expr = car(body);
+ if ((is_null(cdr(body))) &&
+ (is_optimized(expr)) &&
+ (is_all_x_op(optimize_op(expr))))
+ {
+ s7_function func;
+ s7_pointer slot, iter;
+
+ iter = caar(sc->z);
+ sc->z = sc->NIL;
+ push_stack(sc, OP_NO_OP, iter, f); /* temporary GC protection?? */
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ slot = make_slot_1(sc, sc->envir, car(closure_args(f)), sc->F);
+ func = all_x_eval(sc, expr, sc->envir, let_symbol_is_safe);
+ if (func == all_x_c_c)
+ {
+ func = c_callee(expr);
+ expr = cdr(expr);
+ }
+ while (true)
+ {
+ slot_set_value(slot, s7_iterate(sc, iter));
+ if (iterator_is_at_end(iter))
+ {
+ pop_stack(sc);
+ return(sc->UNSPECIFIED);
+ }
+ func(sc, expr);
+ }
+ }
+ push_stack(sc, OP_FOR_EACH_1, make_counter(sc, caar(sc->z)), f);
+ sc->z = sc->NIL;
+ return(sc->UNSPECIFIED);
+ }
+ push_stack(sc, OP_FOR_EACH, sc->z, f);
+ sc->z = sc->NIL;
+ return(sc->UNSPECIFIED);
+}
+
+
+/* ---------------------------------------- map ---------------------------------------- */
+
+static s7_pointer g_map(s7_scheme *sc, s7_pointer args)
+{
+ #define H_map "(map proc object . objects) applies proc to a list made up of the next element of each of its arguments, returning \
+a list of the results. Its arguments can be lists, vectors, strings, hash-tables, or any applicable objects."
+ #define Q_map s7_make_circular_signature(sc, 2, 3, sc->IS_LIST, sc->IS_PROCEDURE, sc->LENGTH)
+
+ s7_pointer p, f;
+ int len;
+ bool got_nil = false;
+
+ f = car(args); /* the function */
+ if (!is_applicable(f))
+ method_or_bust_with_type(sc, f, sc->MAP, args, SOMETHING_APPLICABLE, 1);
+
+ for (len = 0, p = cdr(args); is_not_null(p); p = cdr(p), len++)
+ {
+ if ((!is_sequence(car(p))) && (!is_iterator(car(p))))
+ return(simple_wrong_type_argument_with_type(sc, sc->MAP, car(p), A_SEQUENCE));
+ if (is_null(car(p)))
+ got_nil = true;
+ }
+
+ if ((!is_pair(f)) &&
+ (!s7_is_aritable(sc, f, len)))
+ {
+ static s7_pointer map_args_error = NULL;
+ if (!map_args_error)
+ map_args_error = s7_make_permanent_string("map ~A: ~A args?");
+ return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, map_args_error, f, small_int(len))));
+ }
+
+ if (got_nil) return(sc->NIL);
+
+ if ((f == slot_value(global_slot(sc->VALUES))) &&
+ (is_null(cddr(args))) &&
+ (!has_methods(cadr(args))))
+ {
+ p = object_to_list(sc, cadr(args));
+ if (p != cadr(args))
+ return(p);
+ }
+
+ sc->temp3 = args;
+ sc->z = sc->NIL; /* don't use sc->args here -- it needs GC protection until we get the iterators */
+ for (p = cdr(args); is_not_null(p); p = cdr(p))
+ {
+ s7_pointer iter;
+ iter = car(p);
+ if (!is_iterator(car(p)))
+ iter = s7_make_iterator(sc, iter);
+ sc->z = cons(sc, iter, sc->z);
+ }
+ sc->z = safe_reverse_in_place(sc, sc->z);
+ sc->temp3 = sc->NIL;
+
+ /* if function is safe c func, do the map locally */
+ if ((is_safe_procedure(f)) &&
+ (is_c_function(f)))
+ {
+ s7_function func;
+ s7_pointer val, val1, old_args, iter_list;
+
+ val1 = cons(sc, sc->z, make_list(sc, len, sc->NIL));
+ iter_list = sc->z;
+ sc->z = sc->NIL;
+ old_args = sc->args;
+ func = c_function_call(f);
+ push_stack(sc, OP_NO_OP, iter_list, val = cons(sc, sc->NIL, sc->code)); /* temporary GC protection */
+
+ while (true)
+ {
+ s7_pointer x, y, z;
+ for (x = iter_list, y = cdr(val1); is_pair(x); x = cdr(x), y = cdr(y))
+ {
+ car(y) = s7_iterate(sc, car(x));
+ if (iterator_is_at_end(car(x)))
+ {
+ pop_stack(sc);
+ sc->args = old_args;
+ return(safe_reverse_in_place(sc, car(val)));
+ }
+ }
+ z = func(sc, cdr(val1)); /* can this contain multiple-values? */
+ if (z != sc->NO_VALUE)
+ car(val) = cons(sc, z, car(val));
+ }
+ }
+
+ /* if closure call is straightforward, use OP_MAP_1 */
+ if ((len == 1) &&
+ (is_closure(f)) && /* not lambda* that might get confused about arg names */
+ (closure_arity_to_int(sc, f) == 1) && /* not a rest arg: not is_pair: (lambda (x . args) arg) */
+ (!is_immutable_symbol(car(closure_args(f)))))
+ {
+ s7_pointer body, expr;
+ body = closure_body(f);
+ expr = car(body);
+ if ((is_null(cdr(body))) &&
+ (is_optimized(expr)) &&
+ (is_all_x_op(optimize_op(expr))))
+ {
+ s7_function func;
+ s7_pointer slot, iter, val, z;
+
+ iter = car(sc->z);
+ sc->z = sc->NIL;
+ push_stack(sc, OP_NO_OP, sc->args, val = cons(sc, sc->NIL, f));
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ slot = make_slot_1(sc, sc->envir, car(closure_args(f)), sc->F);
+ func = all_x_eval(sc, expr, sc->envir, let_symbol_is_safe);
+ if (func == all_x_c_c)
+ {
+ func = c_callee(expr);
+ expr = cdr(expr);
+ }
+ while (true)
+ {
+ slot_set_value(slot, s7_iterate(sc, iter));
+ if (iterator_is_at_end(iter))
+ {
+ pop_stack(sc);
+ return(safe_reverse_in_place(sc, car(val)));
+ }
+ z = func(sc, expr);
+ if (z != sc->NO_VALUE)
+ car(val) = cons(sc, z, car(val));
+ }
+ }
+
+ push_stack(sc, OP_MAP_1, make_counter(sc, car(sc->z)), f);
+ sc->z = sc->NIL;
+ return(sc->NIL);
+ }
+ push_stack(sc, OP_MAP, make_counter(sc, sc->z), f);
+ sc->z = sc->NIL;
+ return(sc->NIL);
+}
+
+
+/* -------------------------------- multiple-values -------------------------------- */
+
+static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
+{
+ int top;
+ s7_pointer x;
+ top = s7_stack_top(sc) - 1; /* stack_end - stack_start: if this is negative, we're in big trouble */
+
+ switch (stack_op(sc->stack, top))
+ {
+ /* the normal case -- splice values into caller's args */
+ case OP_EVAL_ARGS1:
+ case OP_EVAL_ARGS2:
+ case OP_EVAL_ARGS3:
+ case OP_EVAL_ARGS4:
+ /* code = args yet to eval in order, args = evalled args reversed
+ *
+ * it's not safe to simply reverse args and tack the current stacked args onto its (new) end,
+ * setting stacked args to cdr of reversed-args and returning car because the list (args)
+ * can be some variable's value in a macro expansion via ,@ and reversing it in place
+ * (all this to avoid consing), clobbers the variable's value.
+ */
+ for (x = args; is_not_null(cdr(x)); x = cdr(x))
+ stack_args(sc->stack, top) = cons(sc, car(x), stack_args(sc->stack, top));
+ return(car(x));
+
+ /* in the next set, the main evaluator branches blithely assume no multiple-values,
+ * and if it happens anyway, we vector to a different branch here
+ */
+ case OP_SAFE_C_opSq_P_1:
+ vector_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_opSq_P_MV;
+ return(args);
+
+ case OP_SAFE_C_SSZ_1:
+ case OP_EVAL_ARGS_SSP_1:
+ vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_SSP_MV;
+ return(args);
+
+ case OP_SAFE_C_SZ_1:
+ case OP_EVAL_ARGS_P_2:
+ vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_2_MV;
+ return(args);
+
+ case OP_EVAL_ARGS_P_3:
+ vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_3_MV;
+ return(args);
+
+ case OP_SAFE_C_ZC_1:
+ case OP_EVAL_ARGS_P_4:
+ vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_4_MV;
+ return(args);
+
+ case OP_C_P_1:
+ vector_element(sc->stack, top) = (s7_pointer)OP_C_P_2;
+ return(args);
+
+ case OP_SAFE_CLOSURE_P_1:
+ case OP_CLOSURE_P_1:
+ vector_element(sc->stack, top) = (s7_pointer)OP_CLOSURE_P_2;
+ return(args);
+
+ case OP_C_SP_1:
+ vector_element(sc->stack, top) = (s7_pointer)OP_C_SP_2;
+ return(args);
+
+ case OP_SAFE_C_PP_1:
+ vector_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_3;
+ return(args);
+
+ case OP_SAFE_C_PP_2:
+ vector_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_4;
+ return(args);
+
+ case OP_SAFE_C_PP_5:
+ vector_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_6;
+ return(args);
+
+ case OP_EVAL_ARGS5:
+ /* code = previous arg saved, args = ante-previous args reversed
+ * we'll take value->code->args and reverse in args5
+ * if one value, return it, else
+ * put code onto args, splice as above until there are 2 left
+ * set code to first and value to last
+ */
+ if (is_null(args))
+ return(sc->UNSPECIFIED);
+
+ if (is_null(cdr(args)))
+ return(car(args));
+
+ stack_args(sc->stack, top) = cons(sc, stack_code(sc->stack, top), stack_args(sc->stack, top));
+ for (x = args; is_not_null(cddr(x)); x = cdr(x))
+ stack_args(sc->stack, top) = cons(sc, car(x), stack_args(sc->stack, top));
+ stack_code(sc->stack, top) = car(x);
+ return(cadr(x));
+
+ /* look for errors here rather than glomming up the set! and let code */
+ case OP_SET_SAFE:
+ case OP_SET1: /* (set! var (values 1 2 3)) */
+ set_multiple_value(args);
+ eval_error(sc, "can't set! some variable to ~S", args);
+
+ case OP_SET_PAIR_P_1:
+ case OP_SET_PAIR_C_P_1:
+ set_multiple_value(args);
+ eval_error(sc, "too many values to set! ~S", args);
+
+ case OP_LET1: /* (let ((var (values 1 2 3))) ...) */
+ case OP_LET_ONE_1:
+ case OP_LET_Z_1:
+ set_multiple_value(args);
+ eval_error_with_caller(sc, "~A: can't bind some variable to ~S", sc->LET, args);
+ /* "some variable" is ugly, but the actual name is tricky to find at this point --
+ * it's in main_stack_args, but finding the right one is a mess. It's isn't sc->code.
+ */
+
+ case OP_LET_STAR1:
+ set_multiple_value(args);
+ eval_error_with_caller(sc, "~A: can't bind some variable to ~S", sc->LET_STAR, args);
+
+ case OP_LETREC1:
+ case OP_LETREC_STAR1:
+ set_multiple_value(args);
+ eval_error_with_caller(sc, "~A: can't bind some variable to ~S", (sc->op == OP_LETREC1) ? sc->LETREC : sc->LETREC_STAR, args);
+
+ /* handle 'and' and 'or' specially */
+ case OP_AND1:
+ for (x = args; is_not_null(cdr(x)); x = cdr(x))
+ if (car(x) == sc->F)
+ return(sc->F);
+ return(car(x));
+
+ case OP_OR1:
+ for (x = args; is_not_null(cdr(x)); x = cdr(x))
+ if (car(x) != sc->F)
+ return(car(x));
+ return(car(x));
+
+ case OP_BARRIER:
+ pop_stack(sc);
+ return(splice_in_values(sc, args));
+
+ case OP_BEGIN1:
+ /* here we have a values call with nothing to splice into. So flush it...
+ * otherwise the multiple-values bit gets set in some innocent list and never unset:
+ * :(let ((x '((1 2)))) (eval `(apply apply values x)) x)
+ * ((values 1 2))
+ * other cases: (+ 1 (begin (values 5 6) (values 2 3)) 4) -> 10 -- the (5 6) is dropped
+ * (let () (values 1 2 3) 4) but (+ (let () (values 1 2))) -> 3
+ */
+ return(args);
+
+ case OP_CATCH:
+ case OP_CATCH_1:
+ case OP_CATCH_2:
+ /* (+ (catch #t (lambda () (values 3 4)) (lambda args args))) */
+ pop_stack(sc);
+ return(splice_in_values(sc, args));
+
+ case OP_EXPANSION:
+ /* we get here if a reader-macro (define-expansion) returned multiple values.
+ * these need to be read in order into the current reader lists (we'll assume OP_READ_LIST is next in the stack.
+ * and that it will be expecting the next arg entry in sc->value).
+ */
+ pop_stack(sc);
+ top -= 4;
+ for (x = args; is_not_null(cdr(x)); x = cdr(x))
+ stack_args(sc->stack, top) = cons(sc, car(x), stack_args(sc->stack, top));
+ return(car(x)); /* sc->value from OP_READ_LIST point of view */
+
+ default:
+ break;
+ }
+
+ /* let it meander back up the call chain until someone knows where to splice it */
+ set_multiple_value(args);
+ return(args);
+}
+
+
+s7_pointer s7_values(s7_scheme *sc, s7_pointer args)
+{
+ #define H_values "(values obj ...) splices its arguments into whatever list holds it (its 'continuation')"
+ #define Q_values s7_make_circular_signature(sc, 1, 2, sc->VALUES, sc->T)
+
+ if (is_null(args)) /* ((lambda () (let ((x 1)) (set! x (boolean? (values)))))) */
+ return(sc->NO_VALUE);
+
+ /* this was sc->NIL until 16-Jun-10,
+ * nil is consistent with the implied values call in call/cc (if no args, the continuation function returns ())
+ * hmmm...
+ * Guile complains ("too few values returned to continuation") in the call/cc case, and
+ * (equal? (if #f #f) (* (values))) complains "Zero values returned to single-valued continuation"
+ * so perhaps call/cc should also return #<unspecified> -- I don't know what is best.
+ *
+ * a note in the scheme bboard:
+ * This would work in s7:
+ * (define (print-concat . args)
+ * (if (or (null? args) ; (print-concat)
+ * (eq? (car args) (values))) ; (print-concat arg1 ...)
+ * (newline)
+ * (begin
+ * (display (car args))
+ * (print-concat (apply values (cdr args))))))
+ * but it's a bit ugly. I think (values) should be the same as
+ * (apply values ()). It's currently #<unspecified>, mainly for
+ * historical reasons (a lot of the code s7 is used with
+ * assumes that behavior). If (values) simply vanished,
+ * then code like (abs -1 (values)) is not an error.
+ */
+
+ if (is_null(cdr(args)))
+ return(car(args));
+
+ return(splice_in_values(sc, args));
+}
+
+#define g_values s7_values
+
+
+/* -------------------------------- quasiquote -------------------------------- */
+
+static s7_pointer g_qq_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_qq_list "({list} ...) returns its arguments in a list (internal to quasiquote)"
+ #define Q_qq_list pcl_t
+
+ s7_pointer x, y, px;
+
+ if (sc->no_values == 0)
+ return(args);
+
+ for (x = args; is_pair(x); x = cdr(x))
+ if (car(x) == sc->NO_VALUE)
+ break;
+
+ if (is_null(x))
+ return(args);
+
+ /* this is not maximally efficient, but it's not important:
+ * we've hit the rare special case where ({apply_values} ())) needs to be ignored
+ * in the splicing process (i.e. the arglist acts as if the thing never happened)
+ */
+ px = sc->NIL;
+ for (x = args, y = args; is_pair(y); y = cdr(y))
+ if (car(y) != sc->NO_VALUE)
+ {
+ car(x) = car(y);
+ px = x;
+ x = cdr(x);
+ }
+
+ if ((is_not_null(y)) &&
+ (y != sc->NO_VALUE))
+ cdr(x) = cdr(y);
+ else
+ {
+ sc->no_values--;
+ if (is_null(px))
+ return(sc->NIL);
+ cdr(px) = sc->NIL;
+ }
+ return(args);
+}
+
+
+static s7_pointer g_apply_values(s7_scheme *sc, s7_pointer args)
+{
+ #define H_apply_values "({apply_values} var) applies values to var. This is an internal function."
+ #define Q_apply_values pcl_t
+ s7_pointer x;
+
+ if (is_null(args))
+ {
+ sc->no_values++;
+ return(sc->NO_VALUE);
+ }
+ if (is_null(cdr(args)))
+ x = car(args);
+ else x = apply_list_star(sc, args);
+
+ if (!is_proper_list(sc, x))
+ return(apply_list_error(sc, args));
+ if (is_null(x))
+ {
+ sc->no_values++;
+ return(sc->NO_VALUE);
+ }
+ return(g_values(sc, x));
+}
+
+/* (apply values ...) replaces (unquote_splicing ...)
+ *
+ * (define-macro (hi a) `(+ 1 ,a) == (list '+ 1 a)
+ * (define-macro (hi a) ``(+ 1 ,,a) == (list list '+ 1 (list quote a)))
+ *
+ * (define-macro (hi a) `(+ 1 , at a) == (list '+ 1 (apply values a))
+ * (define-macro (hi a) ``(+ 1 ,, at a) == (list list '+ 1 (apply values a))
+ *
+ * this is not the same as CL's quasiquote; for example:
+ * [1]> (let ((a 1) (b 2)) `(,a , at b))
+ * (1 . 2)
+ * in s7 this is an error.
+ *
+ * also in CL the target of ,@ can apparently be a circular list
+ */
+
+static bool is_simple_code(s7_scheme *sc, s7_pointer form)
+{
+ s7_pointer tmp;
+ for (tmp = form; is_pair(tmp); tmp = cdr(tmp))
+ if (is_pair(car(tmp)))
+ {
+ if ((tmp == car(tmp)) || /* try to protect against #1=(#1) -- do we actually need cyclic_sequences here? */
+ (!is_simple_code(sc, car(tmp))))
+ return(false);
+ }
+ else
+ {
+ if ((car(tmp) == sc->UNQUOTE) ||
+ ((is_null(car(tmp))) && (is_null(cdr(tmp)))))
+ return(false);
+ }
+ return(is_null(tmp));
+}
+
+
+static s7_pointer g_quasiquote_1(s7_scheme *sc, s7_pointer form)
+{
+ #define H_quasiquote "(quasiquote arg) is the same as `arg. If arg is a list, it can contain \
+comma (\"unquote\") and comma-atsign (\"apply values\") to pre-evaluate portions of the list. \
+unquoted expressions are evaluated and plugged into the list, apply-values evaluates the expression \
+and splices the resultant list into the outer list. `(1 ,(+ 1 1) ,@(list 3 4)) -> (1 2 3 4)."
+ #define Q_quasiquote pcl_t
+
+ if (!is_pair(form))
+ {
+ if (!is_symbol(form))
+ {
+ /* things that evaluate to themselves don't need to be quoted. */
+ return(form);
+ }
+ return(list_2(sc, sc->QUOTE, form));
+ }
+
+ if (car(form) == sc->UNQUOTE)
+ {
+ if (is_not_null(cddr(form)))
+ eval_error(sc, "unquote: too many arguments, ~S", form);
+ return(cadr(form));
+ }
+
+ /* it's a list, so return the list with each element handled as above.
+ * we try to support dotted lists which makes the code much messier.
+ */
+
+ /* if no element of the list is a list or unquote, just return the original quoted */
+ if (is_simple_code(sc, form))
+ return(list_2(sc, sc->QUOTE, form));
+
+ {
+ int len, i, loc;
+ s7_pointer orig, bq, old_scw;
+ bool dotted = false;
+
+ len = s7_list_length(sc, form);
+ if (len == 0)
+ {
+ /* a circular form, apparently */
+ return(list_2(sc, sc->QUOTE, form));
+ }
+ if (len < 0)
+ {
+ len = -len;
+ dotted = true;
+ }
+
+ old_scw = sc->w;
+ loc = s7_gc_protect(sc, old_scw);
+
+ sc->w = sc->NIL;
+ for (i = 0; i <= len; i++)
+ sc->w = cons(sc, sc->NIL, sc->w);
+
+ car(sc->w) = sc->QQ_List;
+
+ if (!dotted)
+ {
+ for (orig = form, bq = cdr(sc->w), i = 0; i < len; i++, orig = cdr(orig), bq = cdr(bq))
+ {
+ if ((is_pair(cdr(orig))) && /* this was is_pair(orig) which seems to be always the case */
+ (cadr(orig) == sc->UNQUOTE))
+ {
+ /* `(1 . ,(+ 1 1)) -> '(1 unquote (+ 1 1)) -> '(1 . 2)
+ * `(1 . ,@'((2 3))) -> (1 unquote ({apply_values} '((2 3)))) -> ({append} ({list} 1) ({apply_values} '((2 3)))) -> '(1 2 3)
+ * this used to be `(1 . ,@('(2 3))).
+ * This now becomes (1 unquote ({apply_values} ('(2 3)))) -> ({append} ({list} 1) ({apply_values} ('(2 3)))) -> error
+ * `(1 . (,@'(2 3))) works in both cases, and `(1 . (,(+ 1 1)))
+ */
+ car(bq) = g_quasiquote_1(sc, car(orig));
+ cdr(bq) = sc->NIL;
+ sc->w = list_3(sc, sc->QQ_Append, sc->w, caddr(orig));
+ break;
+ }
+ else car(bq) = g_quasiquote_1(sc, car(orig));
+ }
+ }
+ else
+ {
+ /* `(1 2 . 3) */
+ len--;
+ for (orig = form, bq = cdr(sc->w), i = 0; i < len; i++, orig = cdr(orig), bq = cdr(bq))
+ car(bq) = g_quasiquote_1(sc, car(orig));
+ car(bq) = g_quasiquote_1(sc, car(orig));
+
+ sc->w = list_3(sc, sc->QQ_Append, sc->w, g_quasiquote_1(sc, cdr(orig)));
+ /* quasiquote might quote a symbol in cdr(orig), so it's not completely pointless */
+ }
+
+ bq = sc->w;
+ sc->w = old_scw;
+ s7_gc_unprotect_at(sc, loc);
+ return(bq);
+ }
+}
+
+
+static s7_pointer g_quasiquote(s7_scheme *sc, s7_pointer args)
+{
+ /* this is for explicit quasiquote support, not the backquote stuff in macros */
+ return(g_quasiquote_1(sc, car(args)));
+}
+
+
+
+/* ---------------- reader funcs for eval ---------------- */
+
+static void back_up_stack(s7_scheme *sc)
+{
+ opcode_t top_op;
+ top_op = stack_op(sc->stack, s7_stack_top(sc) - 1);
+ if (top_op == OP_READ_DOT)
+ {
+ pop_stack(sc);
+ top_op = stack_op(sc->stack, s7_stack_top(sc) - 1);
+ }
+ if ((top_op == OP_READ_VECTOR) ||
+ (top_op == OP_READ_BYTE_VECTOR))
+ {
+ pop_stack(sc);
+ top_op = stack_op(sc->stack, s7_stack_top(sc) - 1);
+ }
+ if (top_op == OP_READ_QUOTE)
+ pop_stack(sc);
+}
+
+
+static token_t read_sharp(s7_scheme *sc, s7_pointer pt)
+{
+ int c;
+ /* inchar can return EOF, so it can't be used directly as an index into the digits array */
+ c = inchar(pt);
+ switch (c)
+ {
+ case EOF:
+ s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "unexpected '#' at end of input")));
+ break;
+
+ case '(':
+ sc->w = small_int(1);
+ return(TOKEN_VECTOR);
+
+ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9':
+ {
+ /* here we can get an overflow: #1231231231231232131D()
+ * and we can't shrug it off:
+ * :#2147483649123D()
+ * ;#nD(...) dimensions argument 1, -2147483647, is out of range (must be 1 or more)
+ * but
+ * :#2147483649123D()
+ * creates a vector with 512 dimensions!
+ * ndims in the vector struct is an unsigned int, so we'll complain if it goes over short max for now
+ */
+ s7_int dims;
+ int d, loc = 0;
+ sc->strbuf[loc++] = c;
+ dims = digits[c];
+
+ while (true)
+ {
+ s7_int dig;
+ d = inchar(pt);
+ if (d == EOF)
+ s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "unexpected end of input while reading #n...")));
+
+ dig = digits[d];
+ if (dig >= 10) break;
+ dims = dig + (dims * 10);
+ if ((dims <= 0) ||
+ (dims > S7_SHORT_MAX))
+ s7_error(sc, sc->READ_ERROR, set_elist_2(sc, make_string_wrapper(sc, "overflow while reading #nD: ~A"), make_integer(sc, dims)));
+ sc->strbuf[loc++] = d;
+ }
+ sc->strbuf[loc++] = d;
+ if ((d == 'D') || (d == 'd'))
+ {
+ d = inchar(pt);
+ if (d == EOF)
+ s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "unexpected end of input while reading #nD...")));
+ sc->strbuf[loc++] = d;
+ if (d == '(')
+ {
+ sc->w = make_integer(sc, dims);
+ return(TOKEN_VECTOR);
+ }
+ }
+
+ /* try to back out */
+ for (d = loc - 1; d > 0; d--)
+ backchar(sc->strbuf[d], pt);
+ }
+ break;
+
+ case 'u':
+ {
+ int d;
+ d = inchar(pt);
+ if (d == EOF)
+ s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "unexpected end of input while reading #u...")));
+ if (d == '8')
+ {
+ d = inchar(pt);
+ if (d == EOF)
+ s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "unexpected end of input while reading #u8...")));
+ if (d == '(')
+ return(TOKEN_BYTE_VECTOR);
+ backchar(d, pt);
+ backchar('8', pt);
+ }
+ else backchar(d, pt);
+ }
+ break;
+
+ case ':': /* turn #: into : -- this is for compatibility with Guile, #:optional in particular.
+ * I just noticed that Rick is using this -- I'll just leave it alone.
+ * but that means : readers need to handle this case specially.
+ * I don't think #! is special anymore -- maybe remove that code?
+ */
+ sc->strbuf[0] = ':';
+ return(TOKEN_ATOM);
+
+ /* block comments in #! ... !# */
+ /* this is needed when an input file is treated as a script:
+ #!/home/bil/cl/snd
+ !#
+ (format #t "a test~%")
+ (exit)
+ * but very often the closing !# is omitted which is too bad
+ */
+ case '!':
+ {
+ char last_char;
+ s7_pointer reader;
+
+ /* make it possible to override #! handling */
+ for (reader = slot_value(sc->sharp_readers); is_pair(reader); reader = cdr(reader))
+ if (s7_character(caar(reader)) == '!')
+ {
+ sc->strbuf[0] = c;
+ return(TOKEN_SHARP_CONST); /* next stage notices any errors */
+ }
+
+ /* not #! as block comment (for Guile I guess) */
+ last_char = ' ';
+ while ((c = inchar(pt)) != EOF)
+ {
+ if ((c == '#') &&
+ (last_char == '!'))
+ break;
+ last_char = c;
+ }
+ if (c == EOF)
+ s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "unexpected end of input while reading #!")));
+ return(token(sc));
+ }
+
+ /* block comments in #| ... |#
+ * since we ignore everything until the |#, internal semicolon comments are ignored,
+ * meaning that ;|# is as effective as |#
+ */
+ case '|':
+ {
+ if (is_file_port(pt))
+ {
+ char last_char;
+ last_char = ' ';
+ while (true)
+ {
+ c = fgetc(port_file(pt));
+ if (c == EOF)
+ s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "unexpected end of input while reading #|")));
+ if ((c == '#') &&
+ (last_char == '|'))
+ break;
+ last_char = c;
+ if (c == '\n')
+ port_line_number(pt)++;
+ }
+ return(token(sc));
+ }
+ else
+ {
+ const char *str, *orig_str, *p, *pend;
+
+ orig_str = (const char *)(port_data(pt) + port_position(pt));
+ pend = (const char *)(port_data(pt) + port_data_size(pt));
+ str = orig_str;
+
+ while (true)
+ {
+ p = strchr(str, (int)'|');
+ if ((!p) || (p >= pend))
+ {
+ port_position(pt) = port_data_size(pt);
+ s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "unexpected end of input while reading #|")));
+ }
+ if (p[1] == '#')
+ break;
+ str = (const char *)(p + 1);
+ }
+ port_position(pt) += (p - orig_str + 2);
+
+ /* now count newline inside the comment */
+ str = (const char *)orig_str;
+ pend = p;
+ while (true)
+ {
+ p = strchr(str, (int)'\n');
+ if ((p) && (p < pend))
+ {
+ port_line_number(pt)++;
+ str = (char *)(p + 1);
+ }
+ else break;
+ }
+ return(token(sc));
+ }
+ }
+ }
+ sc->strbuf[0] = c;
+ return(TOKEN_SHARP_CONST); /* next stage notices any errors */
+}
+
+
+static token_t read_comma(s7_scheme *sc, s7_pointer pt)
+{
+ int c;
+ /* here we probably should check for symbol names that start with "@":
+ :(define-macro (hi @foo) `(+ , at foo 1))
+ hi
+ :(hi 2)
+ ;foo: unbound variable
+ but
+ :(define-macro (hi .foo) `(+ ,.foo 1))
+ hi
+ :(hi 2)
+ 3
+ and ambiguous:
+ :(define-macro (hi @foo . foo) `(list , at foo))
+ what about , @foo -- is the space significant? We accept ,@ foo.
+ */
+
+ if ((c = inchar(pt)) == '@')
+ return(TOKEN_AT_MARK);
+
+ if (c == EOF)
+ {
+ sc->strbuf[0] = ','; /* was '@' which doesn't make any sense */
+ return(TOKEN_COMMA); /* was TOKEN_ATOM, which also doesn't seem sensible */
+ }
+ backchar(c, pt);
+ return(TOKEN_COMMA);
+}
+
+
+static token_t read_dot(s7_scheme *sc, s7_pointer pt)
+{
+ int c;
+ c = inchar(pt);
+ if (c != EOF)
+ {
+ backchar(c, pt);
+
+ if ((!char_ok_in_a_name[c]) && (c != 0))
+ return(TOKEN_DOT);
+ }
+ else
+ {
+ sc->strbuf[0] = '.';
+ return(TOKEN_DOT);
+ }
+ sc->strbuf[0] = '.';
+ return(TOKEN_ATOM); /* i.e. something that can start with a dot like a number */
+}
+
+
+static token_t token(s7_scheme *sc)
+{
+ int c;
+ c = port_read_white_space(sc->input_port)(sc, sc->input_port);
+ switch (c)
+ {
+ case '(': return(TOKEN_LEFT_PAREN);
+ case ')': return(TOKEN_RIGHT_PAREN);
+ case '.': return(read_dot(sc, sc->input_port));
+ case '\'': return(TOKEN_QUOTE);
+ case ';': return(port_read_semicolon(sc->input_port)(sc, sc->input_port));
+ case '"': return(TOKEN_DOUBLE_QUOTE);
+ case '`': return(TOKEN_BACK_QUOTE);
+ case ',': return(read_comma(sc, sc->input_port));
+ case '#': return(read_sharp(sc, sc->input_port));
+ case '\0':
+ case EOF: return(TOKEN_EOF);
+ default:
+ sc->strbuf[0] = c; /* every TOKEN_ATOM return goes to port_read_name, so we save a backchar/inchar shuffle by starting the read here */
+ return(TOKEN_ATOM);
+ }
+}
+
+
+#define NOT_AN_X_CHAR -1
+
+static int read_x_char(s7_pointer pt)
+{
+ /* possible "\xnn" char (write creates these things, so we have to read them)
+ * but we could have crazy input like "\x -- with no trailing double quote
+ */
+ int d1, c;
+
+ c = inchar(pt);
+ if (c == EOF)
+ return(NOT_AN_X_CHAR);
+
+ d1 = digits[c];
+ if (d1 < 16)
+ {
+ int d2;
+ c = inchar(pt);
+ if (c == EOF)
+ return(NOT_AN_X_CHAR);
+ d2 = digits[c];
+ if (d2 < 16)
+ return(16 * d1 + d2); /* following char can be anything, including a number -- we ignore it */
+ /* apparently one digit is also ok */
+ backchar(c, pt);
+ return(d1);
+ }
+ return(NOT_AN_X_CHAR);
+}
+
+
+static s7_pointer read_string_constant(s7_scheme *sc, s7_pointer pt)
+{
+ /* sc->F => error
+ * no check needed here for bad input port and so on
+ */
+ unsigned int i = 0;
+
+ if (is_string_port(pt))
+ {
+ /* try the most common case first */
+ char *s, *start, *end;
+ start = (char *)(port_data(pt) + port_position(pt));
+ if (*start == '"')
+ {
+ port_position(pt)++;
+ return(make_empty_string(sc, 0, 0));
+ }
+
+ end = (char *)(port_data(pt) + port_data_size(pt));
+ s = strpbrk(start, "\"\n\\");
+ if ((!s) || (s >= end)) /* can this read a huge string constant from a file? */
+ {
+ if (start == end)
+ sc->strbuf[0] = '\0';
+ else memcpy((void *)(sc->strbuf), (void *)start, (end - start > 8) ? 8 : (end - start));
+ sc->strbuf[8] = '\0';
+ return(sc->F);
+ }
+ if (*s == '"')
+ {
+ int len;
+ len = s - start;
+ port_position(pt) += (len + 1);
+ return(s7_make_string_with_length(sc, start, len));
+ }
+
+ for (; s < end; s++)
+ {
+ if (*s == '"') /* switch here no faster */
+ {
+ int len;
+ len = s - start;
+ port_position(pt) += (len + 1);
+ return(s7_make_string_with_length(sc, start, len));
+ }
+ else
+ {
+ if (*s == '\\')
+ {
+ /* all kinds of special cases here (resultant string is not the current string), so drop to loop below (setting "i") */
+ unsigned int len;
+ len = (unsigned int)(s - start);
+ if (len > 0)
+ {
+ if (len >= sc->strbuf_size)
+ resize_strbuf(sc, len);
+ /* for (i = 0; i < len; i++) sc->strbuf[i] = port_data(pt)[port_position(pt)++]; */
+ memcpy((void *)(sc->strbuf), (void *)(port_data(pt) + port_position(pt)), len);
+ port_position(pt) += len;
+ }
+ i = len;
+ break;
+ }
+ else
+ {
+ if (*s == '\n')
+ port_line_number(pt)++;
+ }
+ }
+ }
+ }
+
+ while (true)
+ {
+ /* splitting this check out and duplicating the loop was slower?!? */
+ int c;
+ c = port_read_character(pt)(sc, pt);
+
+ switch (c)
+ {
+ case '\n':
+ port_line_number(pt)++;
+ sc->strbuf[i++] = c;
+ break;
+
+ case EOF:
+ sc->strbuf[(i > 8) ? 8 : i] = '\0';
+ return(sc->F);
+
+ case '"':
+ return(s7_make_string_with_length(sc, sc->strbuf, i));
+
+ case '\\':
+ c = inchar(pt);
+
+ if (c == EOF)
+ {
+ sc->strbuf[(i > 8) ? 8 : i] = '\0';
+ return(sc->F);
+ }
+
+ if ((c == '\\') || (c == '"') || (c == '|'))
+ sc->strbuf[i++] = c;
+ else
+ {
+ if (c == 'n')
+ sc->strbuf[i++] = '\n';
+ else
+ {
+ if (c == 't') /* this is for compatibility with other Schemes */
+ sc->strbuf[i++] = '\t';
+ else
+ {
+ if (c == 'x')
+ {
+ c = read_x_char(pt);
+ if (c == NOT_AN_X_CHAR)
+ return(sc->T);
+ sc->strbuf[i++] = (unsigned char)c;
+ }
+ else
+ {
+ /* if (!is_white_space(c)) */ /* changed 8-Apr-12 */
+ if ((c != '\n') && (c != '\r'))
+ return(sc->T);
+
+ /* #f here would give confusing error message "end of input", so return #t=bad backslash.
+ * this is not optimal. It's easy to forget that backslash needs to be backslashed.
+ *
+ * the white_space business half-implements Scheme's \<newline>...<eol>... or \<space>...<eol>...
+ * feature -- the characters after \ are flushed if they're all white space and include a newline.
+ * (string->number "1\ 2") is 12?? Too bizarre.
+ */
+ }
+ }
+ }
+ }
+ break;
+
+ default:
+ sc->strbuf[i++] = c;
+ break;
+ }
+
+ if (i >= sc->strbuf_size)
+ resize_strbuf(sc, i);
+ }
+}
+
+
+static s7_pointer read_expression(s7_scheme *sc)
+{
+ while (true)
+ {
+ int c;
+ switch (sc->tok)
+ {
+ case TOKEN_EOF:
+ return(sc->EOF_OBJECT);
+
+ case TOKEN_BYTE_VECTOR:
+ push_stack_no_code(sc, OP_READ_BYTE_VECTOR, sc->NIL);
+ sc->tok = TOKEN_LEFT_PAREN;
+ break;
+
+ case TOKEN_VECTOR: /* already read #( -- TOKEN_VECTOR is triggered by #( */
+ push_stack_no_code(sc, OP_READ_VECTOR, sc->w); /* sc->w is the dimensions */
+ /* fall through */
+
+ case TOKEN_LEFT_PAREN:
+ sc->tok = token(sc);
+
+ if (sc->tok == TOKEN_RIGHT_PAREN)
+ return(sc->NIL);
+
+ if (sc->tok == TOKEN_DOT)
+ {
+ back_up_stack(sc);
+ do {c = inchar(sc->input_port);} while ((c != ')') && (c != EOF));
+ return(read_error(sc, "stray dot after '('?")); /* (car '( . )) */
+ }
+
+ if (sc->tok == TOKEN_EOF)
+ return(missing_close_paren_error(sc));
+
+ push_stack_no_code(sc, OP_READ_LIST, sc->NIL);
+ /* here we need to clear args, but code is ignored */
+
+ check_stack_size(sc);
+ break;
+
+ case TOKEN_QUOTE:
+ push_stack_no_code(sc, OP_READ_QUOTE, sc->NIL);
+ sc->tok = token(sc);
+ break;
+
+ case TOKEN_BACK_QUOTE:
+ sc->tok = token(sc);
+#if WITH_QUASIQUOTE_VECTOR
+ if (sc->tok == TOKEN_VECTOR)
+ {
+ push_stack_no_code(sc, OP_READ_QUASIQUOTE_VECTOR, sc->w);
+ sc->tok = TOKEN_LEFT_PAREN;
+ }
+ else
+#endif
+ push_stack_no_code(sc, OP_READ_QUASIQUOTE, sc->NIL);
+ break;
+
+ case TOKEN_COMMA:
+ push_stack_no_code(sc, OP_READ_UNQUOTE, sc->NIL);
+ sc->tok = token(sc);
+ break;
+
+ case TOKEN_AT_MARK:
+ push_stack_no_code(sc, OP_READ_APPLY_VALUES, sc->NIL);
+ sc->tok = token(sc);
+ break;
+
+ case TOKEN_ATOM:
+ return(port_read_name(sc->input_port)(sc, sc->input_port));
+ /* If reading list (from lparen), this will finally get us to op_read_list */
+
+ case TOKEN_DOUBLE_QUOTE:
+ sc->value = read_string_constant(sc, sc->input_port);
+
+ if (sc->value == sc->F) /* can happen if input code ends in the middle of a string */
+ return(string_read_error(sc, "end of input encountered while in a string"));
+ if (sc->value == sc->T)
+ return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
+
+ return(sc->value);
+
+ case TOKEN_SHARP_CONST:
+ sc->value = port_read_sharp(sc->input_port)(sc, sc->input_port);
+
+ /* here we need the following character and form
+ * strbuf[0] == '#', false above = # case, not an atom
+ */
+ if (is_null(sc->value))
+ {
+ return(read_error(sc, "undefined # expression"));
+ /* a read error here seems draconian -- this unknown constant doesn't otherwise get in our way
+ * but how to alert the caller to the problem without stopping the read?
+ */
+ }
+ return(sc->value);
+
+ case TOKEN_DOT: /* (catch #t (lambda () (+ 1 . . )) (lambda args 'hiho)) */
+ back_up_stack(sc);
+ do {c = inchar(sc->input_port);} while ((c != ')') && (c != EOF));
+ return(read_error(sc, "stray dot in list?")); /* (+ 1 . . ) */
+
+ case TOKEN_RIGHT_PAREN: /* (catch #t (lambda () '(1 2 . )) (lambda args 'hiho)) */
+ back_up_stack(sc);
+ return(read_error(sc, "unexpected close paren")); /* (+ 1 2)) or (+ 1 . ) */
+ }
+ }
+ /* we never get here */
+ return(sc->NIL);
+}
+
+
+
+/* ---------------- *unbound-variable-hook* ---------------- */
+
+static s7_pointer loaded_library(s7_scheme *sc, const char *file)
+{
+ s7_pointer p;
+ for (p = slot_value(sc->libraries); is_pair(p); p = cdr(p))
+ if (local_strcmp(file, string_value(caar(p))))
+ return(cdar(p));
+ return(sc->NIL);
+}
+
+static s7_pointer find_closure_let(s7_scheme *sc, s7_pointer cur_env)
+{
+ s7_pointer e;
+ for (e = cur_env; is_let(e); e = outlet(e))
+ if (is_function_env(e))
+ return(e);
+ return(sc->NIL);
+}
+
+static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym)
+{
+ /* this always occurs in a context where we're trying to find anything, so I'll move a couple of those checks here
+ */
+ if (has_ref_fallback(sc->envir)) /* an experiment -- see s7test (with-let *db* (+ int (length str))) */
+ check_method(sc, sc->envir, sc->LET_REF_FALLBACK, sc->w = list_2(sc, sc->envir, sym));
+ /* but if the thing we want to hit this fallback happens to exist at a higher level, oops... */
+
+ if (sym == sc->UNQUOTE)
+ eval_error(sc, "unquote (',') occurred outside quasiquote: ~S", sc->cur_code);
+
+ if (sym == sc->__FUNC__) /* __func__ is a sort of symbol macro */
+ {
+ s7_pointer env;
+ env = find_closure_let(sc, sc->envir);
+ if (is_let(env))
+ {
+ /* for C-defined things like hooks and dilambda, let_file and let_line are 0 */
+ if ((let_file(env) > 0) &&
+ (let_file(env) < (s7_int)sc->file_names_top) && /* let_file(env) might be > int */
+ (let_line(env) > 0))
+ return(list_3(sc, funclet_function(env), sc->file_names[let_file(env)], make_integer(sc, let_line(env))));
+ return(funclet_function(env));
+ }
+ return(sc->UNDEFINED);
+ }
+
+ if (safe_strcmp(symbol_name(sym), "|#"))
+ return(read_error(sc, "unmatched |#"));
+
+ /* check *autoload*, autoload_names, then *unbound-variable-hook*
+ */
+ if ((sc->autoload_names) ||
+ (is_hash_table(sc->autoload_table)) ||
+ (is_not_null(s7_hook_functions(sc, sc->unbound_variable_hook))))
+ {
+ s7_pointer result, cur_code, value, code, args, cur_env, x, z;
+ /* sc->args and sc->code are pushed on the stack by s7_call, then
+ * restored by eval, so they are normally protected, but sc->value and sc->cur_code are
+ * not protected (yet). We need sc->cur_code so that the possible eventual error
+ * call can tell where the error occurred, and we need sc->value because it might
+ * be awaiting addition to sc->args in e.g. OP_EVAL_ARGS5, and then be clobbered
+ * by the hook function. (+ 1 asdf) will end up evaluating (+ asdf asdf) if sc->value
+ * is not protected. We also need to save/restore sc->envir in case s7_load is called.
+ */
+
+ args = sc->args;
+ code = sc->code;
+ value = sc->value;
+ cur_code = sc->cur_code;
+ cur_env = sc->envir;
+ result = sc->UNDEFINED;
+ x = sc->x;
+ z = sc->z;
+ sc->temp7 = s7_list(sc, 6, code, args, value, cur_code, x, z);
+
+ if (!is_pair(cur_code))
+ {
+ /* isolated typo perhaps -- no pair to hold the position info, so make one.
+ * sc->cur_code is GC-protected, so this should be safe.
+ */
+ cur_code = cons(sc, sym, sc->NIL); /* the error will say "(sym)" which is not too misleading */
+ pair_set_line(cur_code, remember_location(port_line_number(sc->input_port), port_file_number(sc->input_port)));
+ set_has_line_number(cur_code);
+ }
+
+ /* check sc->autoload_names */
+ if (sc->autoload_names)
+ {
+ const char *file;
+ bool loaded = false;
+ file = find_autoload_name(sc, sym, &loaded, true);
+ if ((file) && (!loaded))
+ {
+ s7_pointer e;
+ /* if we've already loaded this file, we can get the library (e) from a table [(file lib) ...]
+ * here it was possible to get caught in a loop:
+ * change file, reload, unbound var seen, check autoload, it says "load file"... (where file does not get added to *libraries*)
+ * so the "loaded" arg tries to catch such cases
+ */
+ e = loaded_library(sc, file);
+ if (!is_let(e))
+ e = s7_load(sc, file);
+ result = s7_symbol_value(sc, sym); /* calls find_symbol, does not trigger unbound_variable search */
+ if ((result == sc->UNDEFINED) &&
+ (is_let(e)))
+ {
+ result = s7_let_ref(sc, e, sym);
+ /* I think to be consistent we should add '(sym . result) to the global env */
+ if (result != sc->UNDEFINED)
+ s7_define(sc, sc->NIL, sym, result);
+ }
+ }
+ }
+
+ if (result == sc->UNDEFINED)
+ {
+ /* check the *autoload* hash table */
+ if (is_hash_table(sc->autoload_table))
+ {
+ s7_pointer val;
+ /* it was possible to get in a loop here: missing paren in x.scm, checks last symbol, sees
+ * autoload sym -> x.scm, loads x.scm, missing paren...
+ */
+ val = s7_hash_table_ref(sc, sc->autoload_table, sym);
+ if (is_string(val)) /* val should be a filename. *load-path* is searched if necessary. */
+ s7_load(sc, string_value(val));
+ else
+ {
+ if (is_closure(val)) /* val should be a function of one argument, the current (calling) environment */
+ s7_call(sc, val, s7_cons(sc, sc->envir, sc->NIL));
+ }
+ result = s7_symbol_value(sc, sym); /* calls find_symbol, does not trigger unbound_variable search */
+ }
+
+ /* check *unbound-variable-hook* */
+ if ((result == sc->UNDEFINED) &&
+ (is_not_null(sc->unbound_variable_hook)))
+ {
+ /* (let () (set! (hook-functions *unbound-variable-hook*) (list (lambda (v) _asdf_))) _asdf_) */
+ s7_pointer old_hook;
+
+ old_hook = sc->unbound_variable_hook;
+ car(sc->Z2_1) = old_hook;
+ sc->unbound_variable_hook = sc->error_hook; /* avoid the infinite loop mentioned above */
+ result = s7_call(sc, old_hook, list_1(sc, sym)); /* not s7_apply_function */
+ sc->unbound_variable_hook = old_hook;
+ }
+ }
+
+ sc->value = _NFre(value);
+ sc->cur_code = cur_code;
+ sc->args = args;
+ sc->code = code;
+ sc->envir = cur_env;
+ sc->x = x;
+ sc->z = z;
+ sc->temp7 = sc->NIL;
+
+ if ((result != sc->UNDEFINED) &&
+ (result != sc->UNSPECIFIED))
+ return(result);
+ }
+ eval_error(sc, "~A: unbound variable", sym);
+}
+
+
+static s7_pointer assign_syntax(s7_scheme *sc, const char *name, opcode_t op, s7_pointer min_args, s7_pointer max_args, const char *doc)
+{
+ s7_pointer x, syn;
+ unsigned long long int hash;
+ unsigned int loc;
+
+ hash = raw_string_hash((const unsigned char *)name, safe_strlen(name));
+ loc = hash % SYMBOL_TABLE_SIZE;
+ x = new_symbol(sc, name, safe_strlen(name), hash, loc);
+
+ syn = alloc_pointer();
+ unheap(syn);
+ set_type(syn, T_SYNTAX | T_SYNTACTIC | T_DONT_EVAL_ARGS);
+ syntax_opcode(syn) = op;
+ syntax_symbol(syn) = x;
+ syntax_min_args(syn) = integer(min_args);
+ syntax_max_args(syn) = ((max_args == max_arity) ? -1 : integer(max_args));
+ syntax_documentation(syn) = s7_make_permanent_string(doc);
+ syntax_rp(syn) = NULL;
+ syntax_ip(syn) = NULL;
+ syntax_pp(syn) = NULL;
+
+ global_slot(x) = permanent_slot(x, syn);
+ initial_slot(x) = permanent_slot(x, syn);
+ typeflag(x) = SYNTACTIC_TYPE;
+ symbol_set_local(x, 0LL, sc->NIL);
+ symbol_syntax_op(x) = op;
+ return(x);
+}
+
+static s7_pointer assign_internal_syntax(s7_scheme *sc, const char *name, opcode_t op)
+{
+ s7_pointer x, str, syn;
+ s7_pointer symbol, old_syn;
+
+ symbol = s7_make_symbol(sc, name);
+ old_syn = slot_value(global_slot(symbol));
+ str = s7_make_permanent_string(name);
+
+ x = alloc_pointer();
+ unheap(x);
+ set_type(x, T_SYMBOL);
+ set_symbol_name_cell(x, str);
+ symbol_set_local(x, 0LL, sc->NIL);
+ symbol_syntax_op(x) = op;
+
+ syn = alloc_pointer();
+ heap_location(syn) = heap_location(old_syn);
+ set_type(syn, T_SYNTAX | T_SYNTACTIC | T_DONT_EVAL_ARGS);
+ syntax_opcode(syn) = op;
+ syntax_symbol(syn) = symbol;
+ syntax_min_args(syn) = syntax_min_args(old_syn);
+ syntax_max_args(syn) = syntax_max_args(old_syn);
+ syntax_documentation(syn) = syntax_documentation(old_syn);
+ syntax_rp(syn) = syntax_rp(old_syn);
+ syntax_ip(syn) = syntax_ip(old_syn);
+ syntax_pp(syn) = syntax_pp(old_syn);
+
+ global_slot(x) = permanent_slot(x, syn);
+ initial_slot(x) = permanent_slot(x, syn);
+ typeflag(x) = SYNTACTIC_TYPE;
+ return(x);
+}
+
+
+static s7_int c_pair_line_number(s7_scheme *sc, s7_pointer p)
+{
+ if (!is_pair(p))
+ int_method_or_bust(sc, p, sc->PAIR_LINE_NUMBER, set_plist_1(sc, p), T_PAIR, 0);
+
+ if (has_line_number(p))
+ {
+ unsigned int x;
+ x = pair_line(p);
+ return(remembered_line_number(x));
+ }
+ return(0);
+}
+
+static s7_pointer g_pair_line_number(s7_scheme *sc, s7_pointer args)
+{
+ #define H_pair_line_number "(pair-line-number pair) returns the line number at which it read 'pair'"
+ #define Q_pair_line_number s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_PAIR)
+ return(make_integer(sc, c_pair_line_number(sc, car(args))));
+}
+
+PF_TO_IF(pair_line_number, c_pair_line_number)
+
+
+static s7_pointer lambda_star_argument_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val)
+{
+ s7_pointer x;
+
+ for (x = let_slots(sc->envir) /* presumably the arglist */; is_slot(x); x = next_slot(x))
+ if (slot_symbol(x) == sym)
+ {
+ /* x is our binding (symbol . value) */
+ if (is_not_checked_slot(x))
+ set_checked_slot(x); /* this is a special use of this bit, I think */
+ else return(s7_error(sc, sc->WRONG_TYPE_ARG,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: parameter set twice, ~S in ~S"), closure_name(sc, sc->code), sym, sc->args)));
+ slot_set_value(x, val);
+ return(val);
+ }
+ return(sc->NO_VALUE);
+}
+
+
+static s7_pointer lambda_star_set_args(s7_scheme *sc)
+{
+ /* sc->code is a closure: ((args body) envir)
+ * (define* (hi a (b 1)) (+ a b))
+ * (procedure-source hi) -> (lambda* (a (b 1)) (+ a b))
+ *
+ * so rather than spinning through the args binding names to values in the
+ * procedure's new environment (as in the usual closure case above),
+ * we scan the current args, and match against the
+ * template in the car of the closure, binding as we go.
+ *
+ * for each actual arg, if it's not a keyword that matches a member of the
+ * template, bind it to its current (place-wise) arg, else bind it to
+ * that arg. If it's the symbol :key or :optional, just go on.
+ * If it's :rest bind the next arg to the trailing args at this point.
+ * All args can be accessed by their name as a keyword.
+ * In other words (define* (hi (a 1)) ...) is the same as (define* (hi :key (a 1)) ...) etc.
+ *
+ * all args are optional, any arg with no default value defaults to #f.
+ * but the rest arg should default to ().
+ * I later decided to add two warnings: if a parameter is set twice and if
+ * an unknown keyword is seen in a keyword position and there is no rest arg.
+ *
+ * :key and :optional are just noise words, so these have already been spliced out of the arg list
+ */
+
+ bool allow_other_keys;
+ s7_pointer lx, cx, zx;
+
+ /* get the current args, re-setting args that have explicit values */
+ cx = closure_args(sc->code);
+ allow_other_keys = ((is_pair(cx)) && (allows_other_keys(cx)));
+ lx = sc->args;
+
+ zx = sc->NIL;
+ while ((is_pair(cx)) &&
+ (is_pair(lx)))
+ {
+ if (car(cx) == sc->KEY_REST) /* the rest arg */
+ {
+ /* next arg is bound to trailing args from this point as a list */
+ zx = sc->KEY_REST;
+ cx = cdr(cx);
+
+ if (is_pair(car(cx)))
+ lambda_star_argument_set_value(sc, caar(cx), lx);
+ else lambda_star_argument_set_value(sc, car(cx), lx);
+
+ lx = cdr(lx);
+ cx = cdr(cx);
+ }
+ else
+ {
+ /* mock-symbols introduce an ambiguity here; if the object's value is a keyword, is that
+ * intended to be used as an argument name or value?
+ */
+ s7_pointer car_lx;
+ car_lx = car(lx);
+ if (has_methods(car_lx))
+ car_lx = check_values(sc, car_lx, lx);
+ if ((is_pair(cdr(lx))) &&
+ (is_keyword(car_lx)))
+ {
+ /* char *name; */ /* found a keyword, check the lambda args via the corresponding symbol */
+ s7_pointer sym;
+ sym = keyword_symbol(car_lx);
+
+ if (lambda_star_argument_set_value(sc, sym, car(cdr(lx))) == sc->NO_VALUE)
+ {
+ /* if default value is a key, go ahead and use this value.
+ * (define* (f (a :b)) a) (f :c)
+ * this has become much trickier than I anticipated...
+ */
+ if (allow_other_keys)
+ {
+ /* in CL: (defun hi (&key (a 1) &allow-other-keys) a) (hi :b :a :a 3) -> 3
+ * in s7: (define* (hi (a 1) :allow-other-keys) a) (hi :b :a :a 3) -> 3
+ */
+ lx = cddr(lx);
+ continue;
+ }
+ else
+ {
+ if ((is_pair(car(cx))) &&
+ (is_keyword(cadar(cx))))
+ {
+ /* cx is the closure args list, not the copy of it in the curlet */
+ s7_pointer x;
+
+ x = find_symbol(sc, caar(cx));
+ if (is_slot(x))
+ {
+ if (is_not_checked_slot(x))
+ {
+ set_checked_slot(x);
+ slot_set_value(x, car(lx));
+ }
+ else
+ {
+ /* this case is not caught yet: ((lambda* (a :optional b :allow-other-keys ) a) :b 1 :c :a :a ) */
+ return(s7_error(sc, sc->WRONG_TYPE_ARG,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: parameter set twice, ~S in ~S"),
+ closure_name(sc, sc->code), lx, sc->args)));
+ }
+ }
+ else
+ {
+ return(s7_error(sc, sc->WRONG_TYPE_ARG,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: unknown key: ~S in ~S"),
+ closure_name(sc, sc->code), lx, sc->args)));
+ }
+ /* (define* (f a (b :c)) b) (f :b 1 :d) */
+ }
+ else
+ {
+ return(s7_error(sc, sc->WRONG_TYPE_ARG,
+ set_elist_4(sc, make_string_wrapper(sc, "~A: unknown key: ~S in ~S"),
+ closure_name(sc, sc->code), lx, sc->args)));
+ }
+ }
+ }
+ lx = cdr(lx);
+ if (is_pair(lx)) lx = cdr(lx);
+ }
+ else /* not a key/value pair */
+ {
+ /* this is always a positional (i.e. direct) change, but the closure_args are in the
+ * definition order whereas currently the environment slots are in reverse order.
+ */
+ if (is_pair(car(cx)))
+ lambda_star_argument_set_value(sc, caar(cx), car(lx));
+ else lambda_star_argument_set_value(sc, car(cx), car(lx));
+
+ lx = cdr(lx);
+ }
+ cx = cdr(cx);
+ }
+ }
+
+ /* (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) */
+ /* (let () (define* (f (a :b)) a) (list (f) (f 1) (f :c) (f :a :c) (f :a 1) (f))) */
+
+ /* check for trailing args with no :rest arg */
+ if (is_not_null(lx))
+ {
+ if ((is_not_null(cx)) ||
+ (zx == sc->KEY_REST))
+ {
+ if (is_symbol(cx))
+ make_slot_1(sc, sc->envir, cx, lx);
+ }
+ else
+ {
+ if (!allow_other_keys) /* ((lambda* (a) a) :a 1 2) */
+ return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->TOO_MANY_ARGUMENTS, closure_name(sc, sc->code), sc->args)));
+ else
+ {
+ /* check trailing args for repeated keys or keys with no values or values with no keys */
+ while (is_pair(lx))
+ {
+ if ((!is_keyword(car(lx))) || /* ((lambda* (a :allow-other-keys) a) :a 1 :b 2 3) */
+ (!is_pair(cdr(lx)))) /* ((lambda* (a :allow-other-keys) a) :a 1 :b) */
+ return(s7_error(sc, sc->WRONG_TYPE_ARG,
+ set_elist_3(sc, make_string_wrapper(sc, "~A: not a key/value pair: ~S"), closure_name(sc, sc->code), lx)));
+ /* errors not caught?
+ * ((lambda* (a :allow-other-keys) a) :a 1 :a 2)
+ * ((lambda* (:allow-other-keys ) #f) :b :a :a :b)
+ * ((lambda* (:key b :allow-other-keys ) b) 1 :b 2)
+ */
+ lx = cddr(lx);
+ }
+ }
+ }
+ }
+ return(sc->NIL);
+}
+
+
+static s7_pointer is_pair_car, is_pair_cdr, is_pair_cadr;
+static s7_pointer g_is_pair_car(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer val;
+ val = find_symbol_checked(sc, cadar(args));
+ if (!is_pair(val)) /* (define (tst) (let ((a 123)) (pair? (car a)))) */
+ return(g_is_pair(sc, list_1(sc, g_car(sc, set_plist_1(sc, val)))));
+ return(make_boolean(sc, is_pair(car(val))));
+}
+
+static s7_pointer g_is_pair_cdr(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer val;
+ val = find_symbol_checked(sc, cadar(args));
+ if (!is_pair(val))
+ return(g_is_pair(sc, list_1(sc, g_cdr(sc, set_plist_1(sc, val)))));
+ return(make_boolean(sc, is_pair(cdr(val))));
+}
+
+static s7_pointer g_is_pair_cadr(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer val;
+ val = find_symbol_checked(sc, cadar(args));
+ if (!is_pair(val))
+ return(g_is_pair(sc, list_1(sc, g_cadr(sc, set_plist_1(sc, val)))));
+ return(make_boolean(sc, is_pair(cadr(val))));
+}
+
+static s7_pointer is_pair_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if ((is_optimized(cadr(expr))) &&
+ (optimize_op(cadr(expr)) == HOP_SAFE_C_S))
+ {
+ s7_function g;
+ g = c_callee(cadr(expr));
+ if (g == g_car)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(is_pair_car);
+ }
+ if (g == g_cdr)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(is_pair_cdr);
+ }
+ if (g == g_cadr)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(is_pair_cadr);
+ }
+ }
+ return(f);
+}
+
+static s7_pointer is_null_cdr;
+static s7_pointer g_is_null_cdr(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer val;
+ val = find_symbol_checked(sc, cadar(args));
+ if (!is_pair(val))
+ return(g_is_null(sc, list_1(sc, g_cdr(sc, set_plist_1(sc, val)))));
+ return(make_boolean(sc, is_null(cdr(val))));
+}
+
+static s7_pointer is_null_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (is_h_safe_c_s(cadr(expr)))
+ {
+ s7_function g;
+ g = c_callee(cadr(expr));
+ if (g == g_cdr)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(is_null_cdr);
+ }
+ }
+ return(f);
+}
+
+static s7_pointer format_allg, format_allg_no_column, format_just_newline;
+static s7_pointer g_format_allg(s7_scheme *sc, s7_pointer args)
+{
+ return(g_format_1(sc, args));
+}
+
+static s7_pointer g_format_just_newline(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer pt, str;
+
+ pt = car(args);
+ str = cadr(args);
+
+ if (pt == sc->F)
+ return(s7_make_string_with_length(sc, string_value(str), string_length(str)));
+
+ if (pt == sc->T)
+ {
+ if (sc->output_port != sc->F)
+ port_write_string(sc->output_port)(sc, string_value(str), string_length(str), sc->output_port);
+ return(s7_make_string_with_length(sc, string_value(str), string_length(str)));
+ }
+
+ if ((!is_output_port(pt)) ||
+ (port_is_closed(pt)))
+ method_or_bust_with_type(sc, pt, sc->FORMAT, args, A_FORMAT_PORT, 1);
+
+ port_write_string(pt)(sc, string_value(str), string_length(str), pt);
+ return(sc->F);
+}
+
+
+static s7_pointer g_format_allg_no_column(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer pt, str;
+ pt = car(args);
+ if (is_null(pt)) pt = sc->output_port;
+
+ if (!((s7_is_boolean(pt)) ||
+ ((is_output_port(pt)) && /* (current-output-port) or call-with-open-file arg, etc */
+ (!port_is_closed(pt)))))
+ method_or_bust_with_type(sc, pt, sc->FORMAT, args, A_FORMAT_PORT, 1);
+
+ str = cadr(args);
+ sc->format_column = 0;
+ return(format_to_port_1(sc, (pt == sc->T) ? sc->output_port : pt,
+ string_value(str), cddr(args), NULL,
+ !is_output_port(pt), /* i.e. is boolean port so we're returning a string */
+ false, /* we checked in advance that it is not columnized */
+ string_length(str),
+ str));
+}
+
+
+static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ s7_pointer port, str_arg;
+ port = cadr(expr);
+ str_arg = caddr(expr);
+ if ((args > 1) &&
+ (!is_string(port)) &&
+ (is_string(str_arg)))
+ {
+ if (args == 2)
+ {
+ int len;
+ char *orig;
+ const char *p;
+
+ orig = string_value(str_arg);
+ p = strchr((const char *)orig, (int)'~');
+ if (!p)
+ {
+ if (s7_is_boolean(port))
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(format_just_newline); /* "just_newline" actually just outputs the control string -- see fixup below */
+ }
+
+ len = string_length(str_arg);
+ if ((len > 1) &&
+ (orig[len - 1] == '%') &&
+ ((p - orig) == len - 2))
+ {
+ orig[len - 2] = '\n';
+ orig[len - 1] = '\0';
+ string_length(str_arg) = len - 1;
+ if (s7_is_boolean(port))
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(format_just_newline);
+ }
+ }
+
+ /* this used to worry about optimized expr and particular cases -- why? I can't find a broken case */
+ if (!is_columnizing(string_value(str_arg)))
+ return(format_allg_no_column);
+ return(format_allg);
+ }
+ return(f);
+}
+
+static s7_pointer is_eq_car, is_eq_car_q, is_eq_caar_q;
+static s7_pointer g_is_eq_car(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer lst, val;
+ lst = find_symbol_checked(sc, cadar(args));
+ val = find_symbol_checked(sc, cadr(args));
+ if (!is_pair(lst))
+ return(g_is_eq(sc, set_plist_2(sc, g_car(sc, list_1(sc, lst)), val)));
+ return(make_boolean(sc, car(lst) == val));
+}
+
+static s7_pointer g_is_eq_car_q(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer lst;
+ lst = find_symbol_checked(sc, cadar(args));
+ if (!is_pair(lst))
+ return(g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), cadr(cadr(args)))));
+ return(make_boolean(sc, car(lst) == cadr(cadr(args))));
+}
+
+static s7_pointer g_is_eq_caar_q(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer lst;
+ lst = find_symbol_checked(sc, cadar(args));
+ if (!is_pair(lst))
+ return(g_is_eq(sc, set_plist_2(sc, g_caar(sc, set_plist_1(sc, lst)), cadr(cadr(args)))));
+ return(make_boolean(sc, caar(lst) == cadr(cadr(args))));
+}
+
+static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (is_h_safe_c_s(cadr(expr)))
+ {
+ if ((is_symbol(caddr(expr))) &&
+ (c_callee(cadr(expr)) == g_car))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(is_eq_car);
+ }
+ if ((is_pair(caddr(expr))) &&
+ (caaddr(expr) == sc->QUOTE))
+ {
+ if (c_callee(cadr(expr)) == g_car)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(is_eq_car_q);
+ }
+ if (c_callee(cadr(expr)) == g_caar)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(is_eq_caar_q);
+ }
+ }
+ }
+ return(f);
+}
+
+
+/* also not-chooser for all the ? procs, ss case for not equal? etc
+ */
+static s7_pointer not_is_pair, not_is_symbol, not_is_null, not_is_list, not_is_number;
+static s7_pointer not_is_char, not_is_string, not_is_zero, not_is_eq_sq, not_is_eq_ss;
+
+static s7_pointer g_not_is_pair(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_pair, sc->IS_PAIR, args);}
+static s7_pointer g_not_is_null(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_null, sc->IS_NULL, args);}
+static s7_pointer g_not_is_symbol(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_symbol, sc->IS_SYMBOL, args);}
+static s7_pointer g_not_is_number(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, s7_is_number, sc->IS_NUMBER, args);}
+static s7_pointer g_not_is_char(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, s7_is_character, sc->IS_CHAR, args);}
+static s7_pointer g_not_is_string(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_string, sc->IS_STRING, args);}
+static s7_pointer g_not_is_zero(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, s7_is_zero, sc->IS_ZERO, args);}
+static s7_pointer g_not_is_list(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, opt_is_list, sc->IS_LIST, args);}
+
+/* eq? does not check for methods */
+static s7_pointer g_not_is_eq_sq(s7_scheme *sc, s7_pointer args)
+{
+ return(make_boolean(sc, find_symbol_checked(sc, cadr(car(args))) != cadr(caddr(car(args)))));
+}
+
+static s7_pointer g_not_is_eq_ss(s7_scheme *sc, s7_pointer args)
+{
+ return(make_boolean(sc, find_symbol_checked(sc, cadr(car(args))) != find_symbol_checked(sc, caddr(car(args)))));
+}
+
+/* here the method finder is in either car or cdr */
+static s7_pointer not_is_pair_car;
+static s7_pointer g_not_is_pair_car(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer val;
+ val = find_symbol_checked(sc, cadr(cadar(args)));
+ if (!is_pair(val))
+ return(g_not(sc, list_1(sc, g_is_pair(sc, list_1(sc, g_car(sc, set_plist_1(sc, val)))))));
+ return(make_boolean(sc, !is_pair(car(val))));
+}
+
+static s7_pointer not_c_c;
+static s7_pointer g_not_c_c(s7_scheme *sc, s7_pointer args)
+{
+ /* args: ( (null? l) ) */
+ return(make_boolean(sc, is_false(sc, c_call(car(args))(sc, cdar(args)))));
+}
+
+static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int args, s7_pointer expr)
+{
+ if (is_optimized(cadr(expr))) /* cadr(expr) might be a symbol, for example; is_optimized includes is_pair */
+ {
+ if (optimize_op(cadr(expr)) == HOP_SAFE_C_S)
+ {
+ s7_function f;
+ f = c_callee(cadr(expr));
+
+ if (f == g_is_pair)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_pair);
+ }
+ if (f == g_is_null)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_null);
+ }
+ if (f == g_is_symbol)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_symbol);
+ }
+ if (f == g_is_list)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_list);
+ }
+ /* g_is_number is c_function_call(slot_value(global_slot(sc->IS_NUMBER)))
+ * so if this is changed (via openlet??) the latter is perhaps better??
+ * but user might have (#_number? e), so we can't change later and catch this.
+ */
+
+ if ((f == g_is_number) || (f == g_is_complex))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_number);
+ }
+
+ if (f == g_is_zero)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_zero);
+ }
+ if (f == g_is_char)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_char);
+ }
+ if (f == g_is_string)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_string);
+ }
+ }
+ if ((optimize_op(cadr(expr)) == HOP_SAFE_C_SQ) &&
+ (c_callee(cadr(expr)) == g_is_eq))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_eq_sq);
+ }
+
+ if (optimize_op(cadr(expr)) == HOP_SAFE_C_SS)
+ {
+ if (c_callee(cadr(expr)) == g_is_eq)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(not_is_eq_ss);
+ }
+ }
+
+ if (optimize_op(cadr(expr)) == HOP_SAFE_C_C)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ if (c_callee(cadr(expr)) == g_is_pair_car)
+ return(not_is_pair_car);
+ return(not_c_c);
+ }
+ }
+ return(g);
+}
+
+
+static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ if (is_symbol(arg1))
+ {
+ if ((s7_is_integer(arg2)) &&
+ (s7_integer(arg2) >= 0))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ switch (s7_integer(arg2)) /* (might be big int) */
+ {
+ case 0: return(vector_ref_ic_0);
+ case 1: return(vector_ref_ic_1);
+ case 2: return(vector_ref_ic_2);
+ case 3: return(vector_ref_ic_3);
+ default: return(vector_ref_ic);
+ }
+ }
+
+ if (is_global(arg1))
+ {
+ if (is_symbol(arg2))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ if (is_immutable_symbol(arg1))
+ {
+ s7_pointer vect;
+ vect = slot_value(global_slot(arg1));
+ if ((is_normal_vector(vect)) &&
+ (vector_rank(vect) == 1))
+ {
+ set_opt_vector(cdr(expr), vect);
+ return(constant_vector_ref_gs);
+ }
+ }
+ return(vector_ref_gs);
+ }
+ }
+
+ if ((is_pair(arg2)) &&
+ (is_safely_optimized(arg2)) &&
+ (c_callee(arg2) == g_add_cs1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(vector_ref_add1);
+ }
+ }
+ /* vector_ref_sub1 was not worth the code, and few other easily optimized expressions happen here */
+ return(vector_ref_2);
+ }
+ return(f);
+}
+
+
+static s7_pointer vector_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 3)
+ {
+ s7_pointer arg1, arg2, arg3;
+
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ arg3 = cadddr(expr);
+
+ if (is_symbol(arg1))
+ {
+ if ((s7_is_integer(arg2)) &&
+ (s7_integer(arg2) >= 0) &&
+ (is_symbol(arg3)))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(vector_set_ic);
+ }
+ if (is_symbol(arg2))
+ {
+ if ((is_pair(arg3)) &&
+ (is_safely_optimized(arg3)))
+ {
+ if ((c_callee(arg3) == g_vector_ref_2) &&
+ (arg1 == cadr(arg3)) &&
+ (is_symbol(caddr(arg3))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(vector_set_vref);
+ }
+ if (((c_callee(arg3) == g_add_2) || (c_callee(arg3) == g_subtract_2)) &&
+ (is_symbol(caddr(arg3))) &&
+ (is_optimized(cadr(arg3))) &&
+ (c_callee(cadr(arg3)) == g_vector_ref_2) &&
+ (cadr(cadr(arg3)) == arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(vector_set_vector_ref);
+ }
+ }
+ }
+ }
+ return(vector_set_3);
+ }
+ return(f);
+}
+
+
+static s7_pointer list_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if ((args == 3) &&
+ (s7_is_integer(caddr(expr))) &&
+ (s7_integer(caddr(expr)) >= 0) &&
+ (s7_integer(caddr(expr)) < sc->max_list_length))
+ return(list_set_ic);
+ return(f);
+}
+
+
+static s7_pointer list_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if ((args == 2) &&
+ (s7_is_integer(caddr(expr))) &&
+ (s7_integer(caddr(expr)) >= 0) &&
+ (s7_integer(caddr(expr)) < sc->max_list_length))
+ return(list_ref_ic);
+ return(f);
+}
+
+
+static s7_pointer hash_table_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ if ((is_symbol(cadr(expr))) &&
+ (is_symbol(caddr(expr))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(hash_table_ref_ss);
+ }
+ if ((is_symbol(cadr(expr))) &&
+ (is_h_safe_c_s(caddr(expr))) &&
+ (c_callee(caddr(expr)) == g_car))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(hash_table_ref_car);
+ }
+ return(hash_table_ref_2);
+ }
+ return(f);
+}
+
+
+#if (!WITH_GMP)
+static s7_pointer modulo_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if ((args == 2) &&
+ (is_symbol(cadr(expr))) &&
+ (is_integer(caddr(expr))) &&
+ (integer(caddr(expr)) > 1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(mod_si);
+ }
+ return(f);
+}
+#endif
+
+static s7_pointer add_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ /* (+ s f) (+ (* s s) s) (+ s s) (+ s (* s s))
+ */
+#if (!WITH_GMP)
+ if (args == 2)
+ {
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+
+ if (arg1 == small_int(1))
+ return(add_1s);
+
+ if (arg2 == small_int(1))
+ {
+ if (is_symbol(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(add_cs1);
+ }
+ return(add_s1);
+ }
+#if HAVE_OVERFLOW_CHECKS
+ if (s7_is_integer(arg2))
+#else
+ if ((s7_is_integer(arg2)) &&
+ (integer_length(integer(arg2)) < 31))
+#endif
+ {
+ if (is_symbol(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(add_si);
+ }
+ }
+
+ if ((is_t_real(arg2)) &&
+ (is_symbol(arg1)))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(add_sf);
+ }
+
+ if (is_t_real(arg1))
+ {
+ if (is_symbol(arg2))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(add_fs);
+ }
+ if ((is_h_safe_c_c(arg2)) &&
+ (c_callee(arg2) == g_multiply_sf))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(add_f_sf);
+ }
+ }
+ if ((is_optimized(arg1)) &&
+ (is_optimized(arg2)))
+ {
+ if ((optimize_op(arg1) == HOP_SAFE_C_SS) &&
+ (optimize_op(arg2) == HOP_SAFE_C_C) &&
+ (c_callee(arg1) == g_multiply_2) &&
+ (c_callee(arg2) == g_mul_1ss) &&
+ (cadr(arg1) == caddr(cadr(arg2))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_sym1(cdr(expr), caddr(arg1));
+ set_opt_sym2(cdr(expr), caddr(arg2));
+ return(add_ss_1ss);
+ }
+ }
+ return(add_2);
+ }
+#endif
+ return(f);
+}
+
+
+static s7_pointer multiply_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+#if (!WITH_GMP)
+ if (args == 2)
+ {
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+
+ if (is_symbol(arg1))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if (s7_is_integer(arg2))
+#else
+ if ((s7_is_integer(arg2)) &&
+ (integer_length(integer(arg2)) < 31))
+#endif
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_si);
+ }
+ if (arg1 == arg2)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(sqr_ss);
+ }
+ if (is_t_real(arg2))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_sf);
+ }
+ }
+
+ if (is_symbol(arg2))
+ {
+#if HAVE_OVERFLOW_CHECKS
+ if (s7_is_integer(arg1))
+#else
+ if ((s7_is_integer(arg1)) &&
+ (integer_length(integer(arg1)) < 31))
+#endif
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_is);
+ }
+ if (is_t_real(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_fs);
+ }
+ }
+ if ((is_pair(arg1)) &&
+ (is_symbol(arg2)) &&
+ (car(arg1) == sc->SUBTRACT) &&
+ (is_t_real(cadr(arg1))) &&
+ (real(cadr(arg1)) == 1.0) &&
+ (is_symbol(caddr(arg1))) &&
+ (is_null(cdddr(arg1))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(mul_1ss);
+ }
+
+ if ((is_symbol(arg1)) &&
+ (is_optimized(arg2)) &&
+ ((car(arg2) == sc->SIN) || (car(arg2) == sc->COS)) &&
+ (is_symbol(cadr(arg2))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ clear_unsafe(expr);
+ if (car(arg2) == sc->SIN)
+ return(mul_s_sin_s);
+ return(mul_s_cos_s);
+ }
+
+ return(multiply_2);
+ }
+
+ if (args == 3)
+ {
+ s7_pointer arg1, arg2, arg3;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ arg3 = cadddr(expr);
+
+ if ((is_t_real(arg1)) &&
+ (is_symbol(arg2)) &&
+ (is_pair(arg3)) &&
+ (car(arg3) == sc->COS) &&
+ (is_symbol(cadr(arg3))))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(multiply_cs_cos);
+ }
+ }
+
+#endif
+ return(f);
+}
+
+
+static s7_pointer subtract_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+#if (!WITH_GMP)
+ if (args == 1)
+ return(subtract_1);
+
+ if (args == 2)
+ {
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+
+ if (arg2 == small_int(1))
+ {
+ if (is_symbol(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(subtract_cs1);
+ }
+ return(subtract_s1);
+ }
+
+ if (is_t_real(arg2))
+ {
+ if (is_symbol(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(subtract_sf);
+ }
+ if ((is_pair(arg1)) &&
+ (is_safely_optimized(arg1)))
+ {
+ if (c_callee(arg1) == g_random_rc)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(sub_random_rc);
+ }
+ }
+ }
+
+ if (is_t_real(arg1))
+ {
+ if (is_symbol(arg2))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(subtract_fs);
+ }
+ if ((is_h_safe_c_c(arg2)) &&
+ (c_callee(arg2) == g_sqr_ss))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(subtract_f_sqr);
+ }
+ }
+
+ if (s7_is_integer(arg2))
+ {
+ if (is_symbol(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(subtract_csn);
+ }
+ if ((is_safely_optimized(arg1)) &&
+ (c_callee(arg1) == g_random_ic))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(sub_random_ic);
+ }
+ }
+
+ if (is_t_real(arg2))
+ return(subtract_2f);
+
+ return(subtract_2);
+ }
+#endif
+ return(f);
+}
+
+
+static s7_pointer divide_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+#if (!WITH_GMP)
+ if (args == 1)
+ return(invert_1);
+
+ if (args == 2)
+ {
+ s7_pointer arg1;
+ arg1 = cadr(expr);
+ if ((is_t_real(arg1)) &&
+ (real(arg1) == 1.0))
+ return(divide_1r);
+ }
+#endif
+ return(f);
+}
+
+#if (!WITH_GMP)
+static s7_pointer max_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if ((args == 2) &&
+ (is_t_real(cadr(expr))) &&
+ (!is_NaN(real(cadr(expr)))))
+ return(max_f2);
+ return(f);
+}
+
+static s7_pointer min_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if ((args == 2) &&
+ (is_t_real(cadr(expr))) &&
+ (!is_NaN(real(cadr(expr)))))
+ return(min_f2);
+ return(f);
+}
+
+
+static s7_pointer is_zero_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if ((args == 1) &&
+ (is_safely_optimized(cadr(expr))) &&
+ (optimize_op(cadr(expr)) == HOP_SAFE_C_C) &&
+ (c_callee(cadr(expr)) == g_mod_si))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(mod_si_is_zero);
+ }
+ return(f);
+}
+
+
+static s7_pointer equal_chooser(s7_scheme *sc, s7_pointer ur_f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+
+ if (s7_is_integer(arg2))
+ {
+ if (is_safely_optimized(arg1))
+ {
+ s7_function f;
+ f = c_callee(arg1);
+ if (f == g_length)
+ {
+ if (optimize_op(arg1) == HOP_SAFE_C_S)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(equal_length_ic);
+ }
+ }
+ if ((f == g_mod_si) &&
+ (integer(arg2) == 0))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(mod_si_is_zero);
+ }
+ }
+ if (is_symbol(arg1))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(equal_s_ic);
+ }
+ }
+ return(equal_2);
+ }
+ return(ur_f);
+}
+
+static s7_pointer less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+ if (is_integer(arg2))
+ {
+ if (is_h_safe_c_s(cadr(expr)))
+ {
+ s7_function f;
+ f = c_callee(cadr(expr));
+ if (f == g_length)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(less_length_ic);
+ }
+ }
+ if (integer(arg2) == 0)
+ return(less_s0);
+
+ if ((integer(arg2) < s7_int32_max) &&
+ (integer(arg2) > s7_int32_min))
+ return(less_s_ic);
+ }
+ return(less_2);
+ }
+ return(f);
+}
+
+
+static s7_pointer leq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+ if ((is_integer(arg2)) &&
+ (integer(arg2) < s7_int32_max) &&
+ (integer(arg2) > s7_int32_min))
+ return(leq_s_ic);
+ return(leq_2);
+ }
+ return(f);
+}
+
+
+static s7_pointer greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+
+ if ((is_integer(arg2)) &&
+ (integer(arg2) < s7_int32_max) &&
+ (integer(arg2) > s7_int32_min))
+ return(greater_s_ic);
+
+ if ((is_t_real(arg2)) &&
+ (real(arg2) < s7_int32_max) &&
+ (real(arg2) > s7_int32_min))
+ return(greater_s_fc);
+ return(greater_2);
+ }
+ return(f);
+}
+
+
+static s7_pointer geq_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ s7_pointer arg2;
+ arg2 = caddr(expr);
+ if (is_integer(arg2))
+ {
+ if (is_h_safe_c_s(cadr(expr)))
+ {
+ s7_function f;
+ f = c_callee(cadr(expr));
+ if (f == g_length)
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(geq_length_ic);
+ }
+ }
+ if ((integer(arg2) < s7_int32_max) &&
+ (integer(arg2) > s7_int32_min))
+ return(geq_s_ic);
+ }
+ if ((is_t_real(arg2)) &&
+ (real(arg2) < s7_int32_max) &&
+ (real(arg2) > s7_int32_min))
+ return(geq_s_fc);
+
+ return(geq_2);
+ }
+ return(f);
+}
+#endif
+/* end (!WITH_GMP) */
+
+static bool returns_char(s7_scheme *sc, s7_pointer arg)
+{
+ /* also if arg is immutable symbol + value is char */
+ if (s7_is_character(arg)) return(true);
+ if ((is_h_optimized(arg)) &&
+ (is_c_function(opt_cfunc(arg))))
+ {
+ s7_pointer sig;
+ sig = c_function_signature(opt_cfunc(arg));
+ return((sig) &&
+ (is_pair(sig)) &&
+ (car(sig) == sc->IS_CHAR));
+ }
+ return(false);
+}
+
+static s7_pointer char_equal_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ s7_pointer arg1, arg2;
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ if ((returns_char(sc, arg1)) && (returns_char(sc, arg2)))
+ return(simple_char_eq);
+ if ((is_symbol(arg1)) &&
+ (s7_is_character(arg2)))
+ {
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(char_equal_s_ic);
+ }
+ return(char_equal_2);
+ }
+ return(f);
+}
+
+static s7_pointer char_less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ if (s7_is_character(caddr(expr)))
+ return(char_less_s_ic);
+ return(char_less_2);
+ }
+ return(f);
+}
+
+static s7_pointer char_greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (args == 2)
+ {
+ if (s7_is_character(caddr(expr)))
+ return(char_greater_s_ic);
+ return(char_greater_2);
+ }
+ return(f);
+}
+
+static void check_for_substring_temp(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer p, np = NULL, ap = NULL, sp = NULL, arg;
+ int pairs = 0;
+ /* a bit tricky -- accept temp only if there's just one inner expression and it calls substring */
+ for (p = cdr(expr); is_pair(p); p = cdr(p))
+ {
+ arg = car(p);
+ if (is_pair(arg))
+ {
+ pairs++;
+ if ((is_symbol(car(arg))) &&
+ (is_safely_optimized(arg)))
+ {
+ if (c_callee(arg) == g_substring)
+ np = arg;
+ else
+ {
+ if (c_callee(arg) == g_number_to_string)
+ sp = arg;
+ else
+ {
+ if (c_callee(arg) == g_string_append)
+ ap = arg;
+ else
+ {
+ if (c_callee(arg) == g_symbol_to_string)
+ set_c_function(arg, symbol_to_string_uncopied);
+ else
+ {
+ if ((c_callee(arg) == g_read_line) &&
+ (is_pair(cdr(arg))))
+ set_c_function(arg, read_line_uncopied);
+ }}}}}}}
+ if (pairs == 1)
+ {
+ if (np)
+ set_c_function(np, substring_to_temp);
+ else
+ {
+ if (sp)
+ set_c_function(sp, number_to_string_temp);
+ else
+ {
+ if (ap)
+ {
+ for (p = ap; is_pair(p); p = cdr(p))
+ {
+ /* make sure there are no embedded uses of the temp string */
+ arg = car(p);
+ if ((is_pair(arg)) &&
+ (is_safely_optimized(arg)))
+ {
+ if (c_callee(arg) == g_substring_to_temp)
+ set_c_function(arg, slot_value(global_slot(sc->SUBSTRING)));
+ else
+ {
+ if (c_callee(arg) == g_string_append_to_temp)
+ set_c_function(arg, slot_value(global_slot(sc->STRING_APPEND)));
+ }
+ }
+ }
+ set_c_function(ap, string_append_to_temp);
+ }
+ }
+ }
+ }
+}
+
+static s7_pointer char_position_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ if (((args == 2) || (args == 3)) &&
+ (s7_is_character(cadr(expr))))
+ return(char_position_csi);
+ return(f);
+}
+
+static s7_pointer string_equal_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ check_for_substring_temp(sc, expr);
+ if (args == 2)
+ {
+ if (is_string(caddr(expr)))
+ return(string_equal_s_ic);
+ return(string_equal_2);
+ }
+ return(f);
+}
+
+static s7_pointer string_less_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ check_for_substring_temp(sc, expr);
+ if (args == 2)
+ return(string_less_2);
+ return(f);
+}
+
+static s7_pointer string_greater_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ check_for_substring_temp(sc, expr);
+ if (args == 2)
+ return(string_greater_2);
+ return(f);
+}
+
+static s7_pointer string_to_symbol_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ check_for_substring_temp(sc, expr);
+ return(f);
+}
+
+
+static s7_pointer string_ref_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ check_for_substring_temp(sc, expr);
+ return(f);
+}
+
+static s7_pointer string_set_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ return(f);
+}
+
+static s7_pointer string_append_chooser(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr)
+{
+ check_for_substring_temp(sc, expr);
+ return(f);
+}
+
+
+static s7_pointer or_direct;
+static s7_pointer g_or_direct(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ x = car(p);
+ if (is_symbol(x))
+ x = find_symbol_checked(sc, x);
+ if (is_true(sc, x))
+ return(x);
+ }
+ return(sc->F);
+}
+
+
+static s7_pointer and_direct;
+static s7_pointer g_and_direct(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p, x;
+ x = sc->T;
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ x = car(p);
+ if (is_symbol(x))
+ x = find_symbol_checked(sc, x);
+ if (is_false(sc, x))
+ return(x);
+ }
+ return(x);
+}
+
+
+static s7_pointer if_direct;
+static s7_pointer g_if_direct(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ p = car(args);
+ if (is_symbol(p))
+ p = find_symbol_checked(sc, p);
+ if (is_true(sc, p))
+ p = cadr(args);
+ else
+ {
+ if (!is_null(cddr(args)))
+ p = caddr(args);
+ else return(sc->UNSPECIFIED);
+ }
+ if (is_symbol(p))
+ return(find_symbol_checked(sc, p));
+ return(p);
+}
+
+
+static s7_pointer or_all_x, or_all_x_2, or_all_x_2s;
+static s7_pointer g_or_all_x(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ x = c_call(p)(sc, car(p));
+ if (is_true(sc, x))
+ return(x);
+ }
+ return(sc->F);
+}
+
+static s7_pointer g_or_all_x_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ p = c_call(args)(sc, car(args));
+ if (p != sc->F) return(p);
+ p = cdr(args);
+ return(c_call(p)(sc, car(p)));
+}
+
+static s7_pointer g_or_all_x_2s(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ p = car(args);
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(p));
+ p = c_call(p)(sc, sc->T1_1);
+ if (p != sc->F) return(p);
+ p = cadr(args);
+ car(sc->T1_1) = find_symbol_unchecked(sc, cadr(p));
+ return(c_call(p)(sc, sc->T1_1));
+}
+
+
+static s7_pointer and_all_x, and_all_x_2;
+static s7_pointer g_and_all_x(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p, x = sc->T;
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ x = c_call(p)(sc, car(p));
+ if (is_false(sc, x))
+ return(x);
+ }
+ return(x);
+}
+
+static s7_pointer g_and_all_x_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ p = c_call(args)(sc, car(args));
+ if (p == sc->F) return(p);
+ p = cdr(args);
+ return(c_call(p)(sc, car(p)));
+}
+
+
+static s7_pointer if_all_x1;
+static s7_pointer g_if_all_x1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ if (is_true(sc, c_call(args)(sc, car(args))))
+ p = cdr(args);
+ else return(sc->UNSPECIFIED);
+ return(c_call(p)(sc, car(p)));
+}
+
+static s7_pointer if_all_x2;
+static s7_pointer g_if_all_x2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ if (is_true(sc, c_call(args)(sc, car(args))))
+ p = cdr(args);
+ else p = cddr(args);
+ return(c_call(p)(sc, car(p)));
+}
+
+
+static s7_pointer if_all_not_x1;
+static s7_pointer g_if_all_not_x1(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ if (is_false(sc, c_call(args)(sc, cadar(args))))
+ p = cdr(args);
+ else return(sc->UNSPECIFIED);
+ return(c_call(p)(sc, car(p)));
+}
+
+static s7_pointer if_all_not_x2;
+static s7_pointer g_if_all_not_x2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ if (is_false(sc, c_call(args)(sc, cadar(args))))
+ p = cdr(args);
+ else p = cddr(args);
+ return(c_call(p)(sc, car(p)));
+}
+
+
+static s7_pointer if_all_x_qq;
+static s7_pointer g_if_all_x_qq(s7_scheme *sc, s7_pointer args)
+{
+ if (is_true(sc, c_call(args)(sc, car(args))))
+ return(cadr(cadr(args)));
+ return(cadr(caddr(args)));
+}
+
+
+static s7_pointer if_all_x_qa;
+static s7_pointer g_if_all_x_qa(s7_scheme *sc, s7_pointer args)
+{
+ if (is_true(sc, c_call(args)(sc, car(args))))
+ return(cadr(cadr(args)));
+ return(c_call(cddr(args))(sc, caddr(args)));
+}
+
+
+static s7_pointer or_s_direct;
+static s7_pointer g_or_s_direct(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ car(sc->T1_1) = find_symbol_checked(sc, cadar(args));
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ x = c_call(car(p))(sc, sc->T1_1);
+ if (is_true(sc, x))
+ return(x);
+ }
+ return(sc->F);
+}
+
+
+static s7_pointer and_s_direct;
+static s7_pointer g_and_s_direct(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p, x = sc->T;
+ car(sc->T1_1) = find_symbol_checked(sc, cadar(args));
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ x = c_call(car(p))(sc, sc->T1_1);
+ if (is_false(sc, x))
+ return(x);
+ }
+ return(x);
+}
+
+
+static s7_pointer if_s_direct;
+static s7_pointer g_if_s_direct(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ car(sc->T1_1) = find_symbol_checked(sc, cadar(args));
+ if (is_true(sc, c_call(car(args))(sc, sc->T1_1)))
+ p = cdr(args);
+ else
+ {
+ p = cddr(args);
+ if (is_null(p))
+ return(sc->UNSPECIFIED);
+ }
+ return(c_call(car(p))(sc, sc->T1_1));
+}
+
+
+static s7_pointer make_function_with_class(s7_scheme *sc, s7_pointer cls, const char *name, s7_function f,
+ int required_args, int optional_args, bool rest_arg, const char *doc)
+{
+ s7_pointer uf;
+ /* the "safe_function" business here doesn't matter -- this is after the optimizer decides what is safe */
+ uf = s7_make_safe_function(sc, name, f, required_args, optional_args, rest_arg, doc);
+ s7_function_set_class(uf, cls);
+ return(uf);
+}
+
+static s7_pointer set_function_chooser(s7_scheme *sc, s7_pointer sym, s7_pointer (*chooser)(s7_scheme *sc, s7_pointer f, int args, s7_pointer expr))
+{
+ s7_pointer f;
+ f = slot_value(global_slot(sym));
+#ifndef WITHOUT_CHOOSERS
+ c_function_chooser(f) = chooser;
+#endif
+ return(f);
+}
+
+
+static void init_choosers(s7_scheme *sc)
+{
+ s7_pointer f;
+
+#if (!WITH_GMP)
+ s7_if_set_function(slot_value(global_slot(sc->MODULO)), modulo_if);
+ s7_rf_set_function(slot_value(global_slot(sc->MODULO)), modulo_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->REMAINDER)), remainder_rf);
+ s7_if_set_function(slot_value(global_slot(sc->REMAINDER)), remainder_if);
+ s7_rf_set_function(slot_value(global_slot(sc->QUOTIENT)), quotient_rf);
+ s7_if_set_function(slot_value(global_slot(sc->QUOTIENT)), quotient_if);
+ s7_if_set_function(slot_value(global_slot(sc->NUMERATOR)), numerator_if);
+ s7_if_set_function(slot_value(global_slot(sc->DENOMINATOR)), denominator_if);
+ s7_rf_set_function(slot_value(global_slot(sc->REAL_PART)), real_part_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->IMAG_PART)), imag_part_rf);
+ s7_gf_set_function(slot_value(global_slot(sc->RATIONALIZE)), rationalize_pf);
+
+ s7_if_set_function(slot_value(global_slot(sc->CEILING)), ceiling_if);
+ s7_if_set_function(slot_value(global_slot(sc->TRUNCATE)), truncate_if);
+ s7_if_set_function(slot_value(global_slot(sc->ROUND)), round_if);
+ s7_if_set_function(slot_value(global_slot(sc->FLOOR)), floor_if);
+ s7_if_set_function(slot_value(global_slot(sc->LOGIOR)), logior_if);
+ s7_if_set_function(slot_value(global_slot(sc->LOGAND)), logand_if);
+ s7_if_set_function(slot_value(global_slot(sc->LOGXOR)), logxor_if);
+ s7_if_set_function(slot_value(global_slot(sc->LOGNOT)), lognot_if);
+ s7_if_set_function(slot_value(global_slot(sc->ASH)), ash_if);
+ s7_if_set_function(slot_value(global_slot(sc->GCD)), gcd_if);
+ s7_if_set_function(slot_value(global_slot(sc->LCM)), lcm_if);
+ s7_rf_set_function(slot_value(global_slot(sc->MAX)), max_rf);
+ s7_if_set_function(slot_value(global_slot(sc->MAX)), max_if);
+ s7_rf_set_function(slot_value(global_slot(sc->MIN)), min_rf);
+ s7_if_set_function(slot_value(global_slot(sc->MIN)), min_if);
+
+ s7_rf_set_function(slot_value(global_slot(sc->DIVIDE)), divide_rf);
+ s7_if_set_function(slot_value(global_slot(sc->MULTIPLY)), multiply_if);
+ s7_rf_set_function(slot_value(global_slot(sc->MULTIPLY)), multiply_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->ADD)), add_rf);
+ s7_if_set_function(slot_value(global_slot(sc->ADD)), add_if);
+ s7_rf_set_function(slot_value(global_slot(sc->SUBTRACT)), subtract_rf);
+ s7_if_set_function(slot_value(global_slot(sc->SUBTRACT)), subtract_if);
+#if WITH_ADD_PF
+ s7_gf_set_function(slot_value(global_slot(sc->MULTIPLY)), multiply_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->ADD)), add_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->SUBTRACT)), subtract_pf);
+#endif
+
+ s7_rf_set_function(slot_value(global_slot(sc->SIN)), sin_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->COS)), cos_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->TAN)), tan_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->SINH)), sinh_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->COSH)), cosh_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->TANH)), tanh_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->ATAN)), atan_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->EXP)), exp_rf);
+
+ s7_gf_set_function(slot_value(global_slot(sc->ASIN)), asin_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->ACOS)), acos_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->ASINH)), asinh_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->ACOSH)), acosh_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->ATANH)), atanh_pf);
+
+ s7_rf_set_function(slot_value(global_slot(sc->RANDOM)), random_rf);
+ s7_if_set_function(slot_value(global_slot(sc->RANDOM)), random_if);
+
+ s7_gf_set_function(slot_value(global_slot(sc->EXPT)), expt_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->NUMBER_TO_STRING)), number_to_string_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->STRING_TO_NUMBER)), string_to_number_pf);
+
+ s7_rf_set_function(slot_value(global_slot(sc->ABS)), fabs_rf);
+ s7_if_set_function(slot_value(global_slot(sc->ABS)), abs_if);
+#if (!WITH_PURE_S7)
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_RECTANGULAR)), make_complex_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_POLAR)), make_polar_pf);
+#endif
+ s7_rf_set_function(slot_value(global_slot(sc->MAGNITUDE)), magnitude_rf);
+ s7_if_set_function(slot_value(global_slot(sc->MAGNITUDE)), magnitude_if);
+ s7_gf_set_function(slot_value(global_slot(sc->COMPLEX)), make_complex_pf); /* actually complex */
+
+ s7_pf_set_function(slot_value(global_slot(sc->EQ)), equal_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->LT)), less_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->LEQ)), leq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->GEQ)), geq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->GT)), gt_pf);
+#endif /* !gmp */
+
+ s7_if_set_function(slot_value(global_slot(sc->PAIR_LINE_NUMBER)), pair_line_number_if);
+ s7_if_set_function(slot_value(global_slot(sc->HASH_TABLE_ENTRIES)), hash_table_entries_if);
+#if (!WITH_PURE_S7)
+#if (!WITH_GMP)
+ s7_if_set_function(slot_value(global_slot(sc->INTEGER_LENGTH)), integer_length_if);
+#endif
+ s7_if_set_function(slot_value(global_slot(sc->VECTOR_LENGTH)), vector_length_if);
+ s7_if_set_function(slot_value(global_slot(sc->STRING_LENGTH)), string_length_if);
+
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_FILL)), string_fill_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->VECTOR_FILL)), vector_fill_pf);
+#endif
+ s7_pf_set_function(slot_value(global_slot(sc->LENGTH)), length_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->FILL)), fill_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->COPY)), copy_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->REVERSE)), reverse_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->NOT)), not_pf);
+
+ s7_if_set_function(slot_value(global_slot(sc->CHAR_TO_INTEGER)), char_to_integer_if);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_EQ)), char_eq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_GT)), char_gt_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_GEQ)), char_geq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_LT)), char_lt_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_LEQ)), char_leq_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_EQ)), string_eq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_LT)), string_lt_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_LEQ)), string_leq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_GT)), string_gt_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_GEQ)), string_geq_pf);
+
+ s7_gf_set_function(slot_value(global_slot(sc->STRING_UPCASE)), string_upcase_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->STRING_DOWNCASE)), string_downcase_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->CHAR_POSITION)), char_position_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->STRING_POSITION)), string_position_pf);
+
+#if (!WITH_PURE_S7)
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_CI_EQ)), char_ci_eq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_CI_GT)), char_ci_gt_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_CI_GEQ)), char_ci_geq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_CI_LT)), char_ci_lt_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_CI_LEQ)), char_ci_leq_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_CI_EQ)), string_ci_eq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_CI_LT)), string_ci_lt_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_CI_LEQ)), string_ci_leq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_CI_GT)), string_ci_gt_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_CI_GEQ)), string_ci_geq_pf);
+#endif
+
+#if (!WITH_GMP)
+ s7_pf_set_function(slot_value(global_slot(sc->IS_EVEN)), is_even_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_ODD)), is_odd_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_NAN)), is_nan_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_INFINITE)), is_infinite_pf);
+#endif
+ s7_pf_set_function(slot_value(global_slot(sc->IS_ZERO)), is_zero_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_POSITIVE)), is_positive_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_NEGATIVE)), is_negative_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->HASH_TABLE_REF)), hash_table_ref_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->HASH_TABLE_SET)), hash_table_set_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->VECTOR_REF)), vector_ref_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->VECTOR_SET)), vector_set_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_REF)), string_ref_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_SET)), string_set_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->LIST_REF)), list_ref_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->LIST_SET)), list_set_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->LET_REF)), let_ref_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->LET_SET)), let_set_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->TO_BYTE_VECTOR)), to_byte_vector_pf);
+
+ s7_rf_set_function(slot_value(global_slot(sc->FLOAT_VECTOR_REF)), float_vector_ref_rf);
+ s7_rf_set_function(slot_value(global_slot(sc->FLOAT_VECTOR_SET)), float_vector_set_rf);
+
+ s7_if_set_function(slot_value(global_slot(sc->INT_VECTOR_REF)), int_vector_ref_if);
+ s7_if_set_function(slot_value(global_slot(sc->INT_VECTOR_SET)), int_vector_set_if);
+
+ s7_pf_set_function(slot_value(global_slot(sc->CAAAAR)), caaaar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CAAADR)), caaadr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CAAAR)), caaar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CAADAR)), caadar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CAADDR)), caaddr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CAADR)), caadr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CAAR)), caar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CADAAR)), cadaar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CADADR)), cadadr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CADAR)), cadar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CADDAR)), caddar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CADDDR)), cadddr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CADDR)), caddr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CADR)), cadr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CAR)), car_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDAAAR)), cdaaar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDAADR)), cdaadr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDAAR)), cdaar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDADAR)), cdadar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDADDR)), cdaddr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDADR)), cdadr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDAR)), cdar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDDAAR)), cddaar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDDADR)), cddadr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDDAR)), cddar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDDDAR)), cdddar_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDDDDR)), cddddr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDDDR)), cdddr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDDR)), cddr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CDR)), cdr_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->SET_CAR)), set_car_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->SET_CDR)), set_cdr_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->LIST_TAIL)), list_tail_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->ASSOC)), assoc_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->MEMBER)), member_pf);
+
+ s7_gf_set_function(slot_value(global_slot(sc->CONS)), cons_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->LIST)), list_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->INT_VECTOR)), int_vector_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->FLOAT_VECTOR)), float_vector_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->VECTOR)), vector_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->C_POINTER)), c_pointer_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->VECTOR_DIMENSIONS)), vector_dimensions_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_SHARED_VECTOR)), make_shared_vector_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_VECTOR)), make_vector_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_FLOAT_VECTOR)), make_float_vector_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_INT_VECTOR)), make_int_vector_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_LIST)), make_list_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_STRING)), make_string_pf);
+
+#if (!WITH_PURE_S7)
+ s7_pf_set_function(slot_value(global_slot(sc->MEMQ)), memq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->MEMV)), memv_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->ASSQ)), assq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->ASSV)), assv_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->LIST_TO_VECTOR)), list_to_vector_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->VECTOR_TO_LIST)), vector_to_list_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->STRING_TO_LIST)), string_to_list_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->LET_TO_LIST)), let_to_list_pf);
+#endif
+ s7_gf_set_function(slot_value(global_slot(sc->RANDOM_STATE_TO_LIST)), random_state_to_list_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->IS_ARITABLE)), is_aritable_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_BOOLEAN)), is_boolean_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_BYTE_VECTOR)), is_byte_vector_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_CHAR)), is_char_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_COMPLEX)), is_complex_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_CONSTANT)), is_constant_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_CONTINUATION)), is_continuation_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_C_POINTER)), is_c_pointer_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_DILAMBDA)), is_dilambda_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_EOF_OBJECT)), is_eof_object_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_FLOAT_VECTOR)), is_float_vector_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_GENSYM)), is_gensym_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_HASH_TABLE)), is_hash_table_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_INPUT_PORT)), is_input_port_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_INTEGER)), is_integer_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_INT_VECTOR)), is_int_vector_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_KEYWORD)), is_keyword_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_LET)), is_let_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_LIST)), is_list_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_MACRO)), is_macro_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_NULL)), is_null_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_NUMBER)), is_number_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_OUTPUT_PORT)), is_output_port_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_PAIR)), is_pair_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_PROCEDURE)), is_procedure_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_PROVIDED)), is_provided_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_RANDOM_STATE)), is_random_state_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_RATIONAL)), is_rational_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_REAL)), is_real_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_STRING)), is_string_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_SYMBOL)), is_symbol_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_VECTOR)), is_vector_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->IS_ITERATOR)), is_iterator_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->ITERATOR_IS_AT_END)), iterator_is_at_end_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->ITERATOR_SEQUENCE)), iterator_sequence_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->ITERATE)), iterate_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->ITERATE)), iterate_gf);
+ s7_gf_set_function(slot_value(global_slot(sc->MAKE_ITERATOR)), make_iterator_pf);
+#if (!WITH_GMP)
+ s7_gf_set_function(slot_value(global_slot(sc->RANDOM_STATE)), random_state_pf);
+#endif
+ s7_pf_set_function(slot_value(global_slot(sc->REVERSEB)), reverse_in_place_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->SORT)), sort_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->PROVIDE)), provide_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->SYMBOL)), symbol_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->STRING_TO_SYMBOL)), string_to_symbol_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->SYMBOL_TO_STRING)), symbol_to_string_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->MAKE_KEYWORD)), make_keyword_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->KEYWORD_TO_SYMBOL)), keyword_to_symbol_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->SYMBOL_TO_KEYWORD)), symbol_to_keyword_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->SYMBOL_TO_VALUE)), symbol_to_value_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->GENSYM)), gensym_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->ARITY)), arity_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->IS_OPENLET)), is_openlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CURLET)), curlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->OWLET)), owlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->ROOTLET)), rootlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->OUTLET)), outlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->OPENLET)), openlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->COVERLET)), coverlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->FUNCLET)), funclet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CUTLET)), cutlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->VARLET)), varlet_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->UNLET)), unlet_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->INLET)), inlet_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->GC)), gc_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->HELP)), help_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->PROCEDURE_SOURCE)), procedure_source_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->PROCEDURE_DOCUMENTATION)), procedure_documentation_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->PROCEDURE_SIGNATURE)), procedure_signature_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->IS_CHAR_ALPHABETIC)), is_char_alphabetic_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_CHAR_LOWER_CASE)), is_char_lower_case_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_CHAR_NUMERIC)), is_char_numeric_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_CHAR_UPPER_CASE)), is_char_upper_case_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_CHAR_WHITESPACE)), is_char_whitespace_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_UPCASE)), char_upcase_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CHAR_DOWNCASE)), char_downcase_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->INTEGER_TO_CHAR)), integer_to_char_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->CURRENT_INPUT_PORT)), current_input_port_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CURRENT_OUTPUT_PORT)), current_output_port_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CURRENT_ERROR_PORT)), current_error_port_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CLOSE_INPUT_PORT)), close_input_port_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CLOSE_OUTPUT_PORT)), close_output_port_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->FLUSH_OUTPUT_PORT)), flush_output_port_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->PORT_FILENAME)), port_filename_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->PORT_LINE_NUMBER)), port_line_number_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->WITH_INPUT_FROM_FILE)), with_input_from_file_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->WITH_INPUT_FROM_STRING)), with_input_from_string_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->WITH_OUTPUT_TO_STRING)), with_output_to_string_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->WITH_OUTPUT_TO_FILE)), with_output_to_file_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->CALL_WITH_OUTPUT_STRING)), call_with_output_string_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CALL_WITH_OUTPUT_FILE)), call_with_output_file_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CALL_WITH_INPUT_STRING)), call_with_input_string_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->CALL_WITH_INPUT_FILE)), call_with_input_file_pf);
+
+#if WITH_SYSTEM_EXTRAS
+ s7_gf_set_function(slot_value(global_slot(sc->DIRECTORY_TO_LIST)), directory_to_list_pf);
+#endif
+ s7_if_set_function(slot_value(global_slot(sc->WRITE_BYTE)), write_byte_if);
+ s7_pf_set_function(slot_value(global_slot(sc->WRITE_CHAR)), write_char_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->READ_BYTE)), read_byte_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->READ_CHAR)), read_char_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->PEEK_CHAR)), peek_char_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->NEWLINE)), newline_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->WRITE)), write_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->WRITE_STRING)), write_string_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->READ_STRING)), read_string_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->DISPLAY)), display_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->READ)), read_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->READ_LINE)), read_line_pf);
+ s7_gf_set_function(slot_value(global_slot(sc->OBJECT_TO_STRING)), object_to_string_pf);
+
+ s7_pf_set_function(slot_value(global_slot(sc->IS_EQ)), is_eq_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_EQV)), is_eqv_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_EQUAL)), is_equal_pf);
+ s7_pf_set_function(slot_value(global_slot(sc->IS_MORALLY_EQUAL)), is_morally_equal_pf);
+
+
+ /* + */
+ f = set_function_chooser(sc, sc->ADD, add_chooser);
+ sc->add_class = c_function_class(f);
+
+ add_2 = make_function_with_class(sc, f, "+", g_add_2, 2, 0, false, "+ opt");
+ add_1s = make_function_with_class(sc, f, "+", g_add_1s, 2, 0, false, "+ opt");
+ add_s1 = make_function_with_class(sc, f, "+", g_add_s1, 2, 0, false, "+ opt");
+ add_cs1 = make_function_with_class(sc, f, "+", g_add_cs1, 2, 0, false, "+ opt");
+ add_si = make_function_with_class(sc, f, "+", g_add_si, 2, 0, false, "+ opt");
+ add_sf = make_function_with_class(sc, f, "+", g_add_sf, 2, 0, false, "+ opt");
+ add_fs = make_function_with_class(sc, f, "+", g_add_fs, 2, 0, false, "+ opt");
+ add_ss_1ss = make_function_with_class(sc, f, "+", g_add_ss_1ss, 2, 0, false, "+ opt");
+ add_f_sf = make_function_with_class(sc, f, "+", g_add_f_sf, 2, 0, false, "+ opt");
+
+ /* - */
+ f = set_function_chooser(sc, sc->SUBTRACT, subtract_chooser);
+ sc->subtract_class = c_function_class(f);
+ subtract_1 = make_function_with_class(sc, f, "-", g_subtract_1, 1, 0, false, "- opt");
+ subtract_2 = make_function_with_class(sc, f, "-", g_subtract_2, 2, 0, false, "- opt");
+ subtract_s1 = make_function_with_class(sc, f, "-", g_subtract_s1, 2, 0, false, "- opt");
+ subtract_cs1 = make_function_with_class(sc, f, "-", g_subtract_cs1, 2, 0, false, "- opt");
+ subtract_csn = make_function_with_class(sc, f, "-", g_subtract_csn, 2, 0, false, "- opt");
+ subtract_sf = make_function_with_class(sc, f, "-", g_subtract_sf, 2, 0, false, "- opt");
+ subtract_2f = make_function_with_class(sc, f, "-", g_subtract_2f, 2, 0, false, "- opt");
+ subtract_fs = make_function_with_class(sc, f, "-", g_subtract_fs, 2, 0, false, "- opt");
+ subtract_f_sqr = make_function_with_class(sc, f, "-", g_subtract_f_sqr, 2, 0, false, "- opt");
+#if (!WITH_GMP)
+ sub_random_ic = make_function_with_class(sc, f, "random", g_sub_random_ic, 2, 0, false, "- opt");
+ sub_random_rc = make_function_with_class(sc, f, "random", g_sub_random_rc, 2, 0, false, "- opt");
+#endif
+
+
+ /* * */
+ f = set_function_chooser(sc, sc->MULTIPLY, multiply_chooser);
+ sc->multiply_class = c_function_class(f);
+#if (!WITH_GMP)
+ multiply_2 = make_function_with_class(sc, f, "*", g_multiply_2, 2, 0, false, "* opt");
+ multiply_is = make_function_with_class(sc, f, "*", g_multiply_is, 2, 0, false, "* opt");
+ multiply_si = make_function_with_class(sc, f, "*", g_multiply_si, 2, 0, false, "* opt");
+ multiply_fs = make_function_with_class(sc, f, "*", g_multiply_fs, 2, 0, false, "* opt");
+ multiply_sf = make_function_with_class(sc, f, "*", g_multiply_sf, 2, 0, false, "* opt");
+
+ sqr_ss = make_function_with_class(sc, f, "*", g_sqr_ss, 2, 0, false, "* opt");
+ mul_1ss = make_function_with_class(sc, f, "*", g_mul_1ss, 2, 0, false, "* opt");
+ multiply_cs_cos = make_function_with_class(sc, f, "*", g_multiply_cs_cos, 3, 0, false, "* opt");
+ mul_s_sin_s = make_function_with_class(sc, f, "*", g_mul_s_sin_s, 2, 0, false, "* opt");
+ mul_s_cos_s = make_function_with_class(sc, f, "*", g_mul_s_cos_s, 2, 0, false, "* opt");
+#endif
+
+ /* / */
+ f = set_function_chooser(sc, sc->DIVIDE, divide_chooser);
+#if (!WITH_GMP)
+ invert_1 = make_function_with_class(sc, f, "/", g_invert_1, 1, 0, false, "/ opt");
+ divide_1r = make_function_with_class(sc, f, "/", g_divide_1r, 2, 0, false, "/ opt");
+
+ /* modulo */
+ f = set_function_chooser(sc, sc->MODULO, modulo_chooser);
+ mod_si = make_function_with_class(sc, f, "modulo", g_mod_si, 2, 0, false, "modulo opt");
+
+ /* max */
+ f = set_function_chooser(sc, sc->MAX, max_chooser);
+ max_f2 = make_function_with_class(sc, f, "max", g_max_f2, 2, 0, false, "max opt");
+
+ /* min */
+ f = set_function_chooser(sc, sc->MIN, min_chooser);
+ min_f2 = make_function_with_class(sc, f, "min", g_min_f2, 2, 0, false, "min opt");
+
+ /* zero? */
+ set_function_chooser(sc, sc->IS_ZERO, is_zero_chooser);
+
+ /* = */
+ f = set_function_chooser(sc, sc->EQ, equal_chooser);
+ sc->equal_class = c_function_class(f);
+
+ equal_s_ic = make_function_with_class(sc, f, "=", g_equal_s_ic, 2, 0, false, "= opt");
+ equal_length_ic = make_function_with_class(sc, f, "=", g_equal_length_ic, 2, 0, false, "= opt");
+ equal_2 = make_function_with_class(sc, f, "=", g_equal_2, 2, 0, false, "= opt");
+ mod_si_is_zero = make_function_with_class(sc, f, "=", g_mod_si_is_zero, 2, 0, false, "= opt");
+
+ /* < */
+ f = set_function_chooser(sc, sc->LT, less_chooser);
+
+ less_s_ic = make_function_with_class(sc, f, "<", g_less_s_ic, 2, 0, false, "< opt");
+ less_s0 = make_function_with_class(sc, f, "<", g_less_s0, 2, 0, false, "< opt");
+ less_2 = make_function_with_class(sc, f, "<", g_less_2, 2, 0, false, "< opt");
+ less_length_ic = make_function_with_class(sc, f, "<", g_less_length_ic, 2, 0, false, "< opt");
+
+ /* > */
+ f = set_function_chooser(sc, sc->GT, greater_chooser);
+ greater_s_ic = make_function_with_class(sc, f, ">", g_greater_s_ic, 2, 0, false, "> opt");
+ greater_s_fc = make_function_with_class(sc, f, ">", g_greater_s_fc, 2, 0, false, "> opt");
+ greater_2 = make_function_with_class(sc, f, ">", g_greater_2, 2, 0, false, "> opt");
+ greater_2_f = make_function_with_class(sc, f, ">", g_greater_2_f, 2, 0, false, "> opt");
+
+ /* <= */
+ f = set_function_chooser(sc, sc->LEQ, leq_chooser);
+ leq_s_ic = make_function_with_class(sc, f, "<=", g_leq_s_ic, 2, 0, false, "<= opt");
+ leq_2 = make_function_with_class(sc, f, "<=", g_leq_2, 2, 0, false, "<= opt");
+
+ /* >= */
+ f = set_function_chooser(sc, sc->GEQ, geq_chooser);
+ geq_s_ic = make_function_with_class(sc, f, ">=", g_geq_s_ic, 2, 0, false, ">= opt");
+ geq_s_fc = make_function_with_class(sc, f, ">=", g_geq_s_fc, 2, 0, false, ">= opt");
+ geq_2 = make_function_with_class(sc, f, ">=", g_geq_2, 2, 0, false, ">= opt");
+ geq_length_ic = make_function_with_class(sc, f, ">=", g_geq_length_ic, 2, 0, false, ">= opt");
+
+ /* random */
+ f = set_function_chooser(sc, sc->RANDOM, random_chooser);
+ random_i = make_function_with_class(sc, f, "random", g_random_i, 1, 0, false, "random opt");
+ random_ic = make_function_with_class(sc, f, "random", g_random_ic, 1, 0, false, "random opt");
+ random_rc = make_function_with_class(sc, f, "random", g_random_rc, 1, 0, false, "random opt");
+#endif
+
+ /* list */
+ f = set_function_chooser(sc, sc->LIST, list_chooser);
+ list_0 = make_function_with_class(sc, f, "list", g_list_0, 0, 0, false, "list opt");
+ list_1 = make_function_with_class(sc, f, "list", g_list_1, 1, 0, false, "list opt");
+ list_2 = make_function_with_class(sc, f, "list", g_list_2, 2, 0, false, "list opt");
+
+ /* aritable? */
+ f = set_function_chooser(sc, sc->IS_ARITABLE, is_aritable_chooser);
+ is_aritable_ic = make_function_with_class(sc, f, "aritable?", g_is_aritable_ic, 2, 0, false, "aritable? opt");
+
+ /* char=? */
+ f = set_function_chooser(sc, sc->CHAR_EQ, char_equal_chooser);
+ simple_char_eq = make_function_with_class(sc, f, "char=?", g_simple_char_eq, 2, 0, false, "char=? opt");
+ char_equal_s_ic = make_function_with_class(sc, f, "char=?", g_char_equal_s_ic, 2, 0, false, "char=? opt");
+ char_equal_2 = make_function_with_class(sc, f, "char=?", g_char_equal_2, 2, 0, false, "char=? opt");
+
+ /* char>? */
+ f = set_function_chooser(sc, sc->CHAR_GT, char_greater_chooser);
+ char_greater_s_ic = make_function_with_class(sc, f, "char>?", g_char_greater_s_ic, 2, 0, false, "char>? opt");
+ char_greater_2 = make_function_with_class(sc, f, "char>?", g_char_greater_2, 2, 0, false, "char>? opt");
+
+ /* char<? */
+ f = set_function_chooser(sc, sc->CHAR_LT, char_less_chooser);
+ char_less_s_ic = make_function_with_class(sc, f, "char<?", g_char_less_s_ic, 2, 0, false, "char<? opt");
+ char_less_2 = make_function_with_class(sc, f, "char<?", g_char_less_2, 2, 0, false, "char<? opt");
+
+ /* char-position */
+ f = set_function_chooser(sc, sc->CHAR_POSITION, char_position_chooser);
+ char_position_csi = make_function_with_class(sc, f, "char-position", g_char_position_csi, 2, 1, false, "char-position opt");
+
+ /* string->symbol */
+ set_function_chooser(sc, sc->STRING_TO_SYMBOL, string_to_symbol_chooser);
+
+ /* string=? */
+ f = set_function_chooser(sc, sc->STRING_EQ, string_equal_chooser);
+ string_equal_s_ic = make_function_with_class(sc, f, "string=?", g_string_equal_s_ic, 2, 0, false, "string=? opt");
+ string_equal_2 = make_function_with_class(sc, f, "string=?", g_string_equal_2, 2, 0, false, "string=? opt");
+
+ /* substring */
+ substring_to_temp = s7_make_function(sc, "substring", g_substring_to_temp, 2, 1, false, "substring opt");
+ s7_function_set_class(substring_to_temp, slot_value(global_slot(sc->SUBSTRING)));
+
+ /* number->string */
+ number_to_string_temp = s7_make_function(sc, "number->string", g_number_to_string_temp, 1, 1, false, "number->string opt");
+ s7_function_set_class(number_to_string_temp, slot_value(global_slot(sc->NUMBER_TO_STRING)));
+
+ /* string>? */
+ f = set_function_chooser(sc, sc->STRING_GT, string_greater_chooser);
+ string_greater_2 = make_function_with_class(sc, f, "string>?", g_string_greater_2, 2, 0, false, "string>? opt");
+
+ /* string<? */
+ f = set_function_chooser(sc, sc->STRING_LT, string_less_chooser);
+ string_less_2 = make_function_with_class(sc, f, "string<?", g_string_less_2, 2, 0, false, "string<? opt");
+
+ /* string-ref */
+ set_function_chooser(sc, sc->STRING_REF, string_ref_chooser);
+
+ /* string-set! */
+ set_function_chooser(sc, sc->STRING_SET, string_set_chooser);
+
+ /* string-append */
+ f = set_function_chooser(sc, sc->STRING_APPEND, string_append_chooser);
+ string_append_to_temp = make_function_with_class(sc, f, "string-append", g_string_append_to_temp, 0, 0, true, "string-append opt");
+
+ /* symbol->string */
+ f = slot_value(global_slot(sc->SYMBOL_TO_STRING));
+ symbol_to_string_uncopied = s7_make_function(sc, "symbol->string", g_symbol_to_string_uncopied, 1, 0, false, "symbol->string opt");
+ s7_function_set_class(symbol_to_string_uncopied, f);
+
+ /* vector-ref */
+ f = set_function_chooser(sc, sc->VECTOR_REF, vector_ref_chooser);
+ vector_ref_ic = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic, 2, 0, false, "vector-ref opt");
+ vector_ref_ic_0 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_0, 1, 0, false, "vector-ref opt");
+ vector_ref_ic_1 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_1, 1, 0, false, "vector-ref opt");
+ vector_ref_ic_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_2, 1, 0, false, "vector-ref opt");
+ vector_ref_ic_3 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_3, 1, 0, false, "vector-ref opt");
+ vector_ref_add1 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_add1, 2, 0, false, "vector-ref opt");
+ vector_ref_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_2, 2, 0, false, "vector-ref opt");
+ vector_ref_gs = make_function_with_class(sc, f, "vector-ref", g_vector_ref_gs, 2, 0, false, "vector-ref opt");
+ constant_vector_ref_gs = make_function_with_class(sc, f, "vector-ref", g_constant_vector_ref_gs, 2, 0, false, "vector-ref opt");
+
+ /* vector-set! */
+ f = set_function_chooser(sc, sc->VECTOR_SET, vector_set_chooser);
+ vector_set_ic = make_function_with_class(sc, f, "vector-set!", g_vector_set_ic, 3, 0, false, "vector-set! opt");
+ vector_set_vref = make_function_with_class(sc, f, "vector-set!", g_vector_set_vref, 3, 0, false, "vector-set! opt");
+ vector_set_vector_ref = make_function_with_class(sc, f, "vector-set!", g_vector_set_vector_ref, 3, 0, false, "vector-set! opt");
+ vector_set_3 = make_function_with_class(sc, f, "vector-set!", g_vector_set_3, 3, 0, false, "vector-set! opt");
+
+ /* list-ref */
+ f = set_function_chooser(sc, sc->LIST_REF, list_ref_chooser);
+ list_ref_ic = make_function_with_class(sc, f, "list-ref", g_list_ref_ic, 2, 0, false, "list-ref opt");
+
+ /* list-set! */
+ f = set_function_chooser(sc, sc->LIST_SET, list_set_chooser);
+ list_set_ic = make_function_with_class(sc, f, "list-set!", g_list_set_ic, 3, 0, false, "list-set! opt");
+
+ /* hash-table-ref */
+ f = set_function_chooser(sc, sc->HASH_TABLE_REF, hash_table_ref_chooser);
+ hash_table_ref_2 = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_2, 2, 0, false, "hash-table-ref opt");
+ hash_table_ref_ss = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_ss, 2, 0, false, "hash-table-ref opt");
+ hash_table_ref_car = make_function_with_class(sc, f, "hash-table-ref", g_hash_table_ref_car, 2, 0, false, "hash-table-ref opt");
+
+ /* format */
+ f = set_function_chooser(sc, sc->FORMAT, format_chooser);
+ format_allg = make_function_with_class(sc, f, "format", g_format_allg, 1, 0, true, "format opt");
+ format_allg_no_column = make_function_with_class(sc, f, "format", g_format_allg_no_column, 1, 0, true, "format opt");
+ format_just_newline = make_function_with_class(sc, f, "format", g_format_just_newline, 2, 0, false, "format opt");
+
+ /* not */
+ f = set_function_chooser(sc, sc->NOT, not_chooser);
+ not_is_pair = make_function_with_class(sc, f, "not", g_not_is_pair, 1, 0, false, "not opt");
+ not_is_null = make_function_with_class(sc, f, "not", g_not_is_null, 1, 0, false, "not opt");
+ not_is_list = make_function_with_class(sc, f, "not", g_not_is_list, 1, 0, false, "not opt");
+ not_is_symbol = make_function_with_class(sc, f, "not", g_not_is_symbol, 1, 0, false, "not opt");
+ not_is_number = make_function_with_class(sc, f, "not", g_not_is_number, 1, 0, false, "not opt");
+ not_is_zero = make_function_with_class(sc, f, "not", g_not_is_zero, 1, 0, false, "not opt");
+ not_is_string = make_function_with_class(sc, f, "not", g_not_is_string, 1, 0, false, "not opt");
+ not_is_char = make_function_with_class(sc, f, "not", g_not_is_char, 1, 0, false, "not opt");
+ not_is_eq_ss = make_function_with_class(sc, f, "not", g_not_is_eq_ss, 1, 0, false, "not opt");
+ not_is_eq_sq = make_function_with_class(sc, f, "not", g_not_is_eq_sq, 1, 0, false, "not opt");
+ not_is_pair_car = make_function_with_class(sc, f, "not", g_not_is_pair_car, 1, 0, false, "not opt");
+ not_c_c = make_function_with_class(sc, f, "not", g_not_c_c, 1, 0, false, "not opt");
+
+ /* pair? */
+ f = set_function_chooser(sc, sc->IS_PAIR, is_pair_chooser);
+ is_pair_car = make_function_with_class(sc, f, "pair?", g_is_pair_car, 1, 0, false, "pair? opt");
+ is_pair_cdr = make_function_with_class(sc, f, "pair?", g_is_pair_cdr, 1, 0, false, "pair? opt");
+ is_pair_cadr = make_function_with_class(sc, f, "pair?", g_is_pair_cadr, 1, 0, false, "pair? opt");
+
+ /* null? */
+ f = set_function_chooser(sc, sc->IS_NULL, is_null_chooser);
+ is_null_cdr = make_function_with_class(sc, f, "null?", g_is_null_cdr, 1, 0, false, "null? opt");
+
+ /* eq? */
+ f = set_function_chooser(sc, sc->IS_EQ, is_eq_chooser);
+ is_eq_car = make_function_with_class(sc, f, "eq?", g_is_eq_car, 2, 0, false, "eq? opt");
+ is_eq_car_q = make_function_with_class(sc, f, "eq?", g_is_eq_car_q, 2, 0, false, "eq? opt");
+ is_eq_caar_q = make_function_with_class(sc, f, "eq?", g_is_eq_caar_q, 2, 0, false, "eq? opt");
+
+ /* member */
+ f = set_function_chooser(sc, sc->MEMBER, member_chooser);
+ member_ss = make_function_with_class(sc, f, "member", g_member_ss, 2, 0, false, "member opt");
+ member_sq = make_function_with_class(sc, f, "member", g_member_sq, 2, 0, false, "member opt");
+ member_num_s = make_function_with_class(sc, f, "member", g_member_num_s, 2, 0, false, "member opt");
+
+ /* memq */
+#if (!WITH_PURE_S7)
+ f = set_function_chooser(sc, sc->MEMQ, memq_chooser);
+ /* is pure-s7, use member here */
+#endif
+ memq_3 = make_function_with_class(sc, f, "memq", g_memq_3, 2, 0, false, "memq opt");
+ memq_4 = make_function_with_class(sc, f, "memq", g_memq_4, 2, 0, false, "memq opt");
+ memq_any = make_function_with_class(sc, f, "memq", g_memq_any, 2, 0, false, "memq opt");
+ memq_car = make_function_with_class(sc, f, "memq", g_memq_car, 2, 0, false, "memq opt");
+
+ /* read-char */
+ f = set_function_chooser(sc, sc->READ_CHAR, read_char_chooser);
+ read_char_0 = make_function_with_class(sc, f, "read-char", g_read_char_0, 0, 0, false, "read-char opt");
+ read_char_1 = make_function_with_class(sc, f, "read-char", g_read_char_1, 1, 0, false, "read-char opt");
+
+ /* write-char */
+ f = set_function_chooser(sc, sc->WRITE_CHAR, write_char_chooser);
+ write_char_1 = make_function_with_class(sc, f, "write-char", g_write_char_1, 1, 0, false, "write-char opt");
+
+ /* read-line */
+ read_line_uncopied = s7_make_function(sc, "read-line", g_read_line_uncopied, 1, 1, false, "read-line opt");
+ s7_function_set_class(read_line_uncopied, slot_value(global_slot(sc->READ_LINE)));
+
+ /* write-string */
+ set_function_chooser(sc, sc->WRITE_STRING, write_string_chooser);
+
+ /* eval-string */
+ set_function_chooser(sc, sc->EVAL_STRING, eval_string_chooser);
+
+ /* or and if simple cases */
+ or_direct = s7_make_function(sc, "or", g_or_direct, 0, 0, true, "or opt");
+ and_direct = s7_make_function(sc, "and", g_and_direct, 0, 0, true, "and opt");
+ if_direct = s7_make_function(sc, "if", g_if_direct, 2, 1, false, "if opt");
+
+ or_all_x = s7_make_function(sc, "or", g_or_all_x, 0, 0, true, "or opt");
+ or_all_x_2 = s7_make_function(sc, "or", g_or_all_x_2, 2, 0, false, "or opt");
+ or_all_x_2s = s7_make_function(sc, "or", g_or_all_x_2s, 2, 0, false, "or opt");
+ and_all_x = s7_make_function(sc, "and", g_and_all_x, 0, 0, true, "and opt");
+ and_all_x_2 = s7_make_function(sc, "and", g_and_all_x_2, 2, 0, false, "and opt");
+ if_all_x1 = s7_make_function(sc, "if", g_if_all_x1, 2, 0, false, "if opt");
+ if_all_x2 = s7_make_function(sc, "if", g_if_all_x2, 3, 0, false, "if opt");
+ if_all_not_x1 = s7_make_function(sc, "if", g_if_all_not_x1, 2, 0, false, "if opt");
+ if_all_not_x2 = s7_make_function(sc, "if", g_if_all_not_x2, 3, 0, false, "if opt");
+ if_all_x_qq = s7_make_function(sc, "if", g_if_all_x_qq, 3, 0, false, "if opt");
+ if_all_x_qa = s7_make_function(sc, "if", g_if_all_x_qa, 3, 0, false, "if opt");
+
+ or_s_direct = s7_make_function(sc, "or", g_or_s_direct, 0, 0, true, "or opt");
+ and_s_direct = s7_make_function(sc, "and", g_and_s_direct, 0, 0, true, "and opt");
+ if_s_direct = s7_make_function(sc, "if", g_if_s_direct, 2, 1, false, "if opt");
+}
+
+
+static s7_pointer collect_collisions(s7_scheme *sc, s7_pointer lst, s7_pointer e)
+{
+ /* collect local variable names from let/do (pre-error-check) */
+ s7_pointer p;
+ sc->w = e;
+ for (p = lst; is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (is_symbol(caar(p))))
+ sc->w = cons(sc, add_sym_to_list(sc, caar(p)), sc->w);
+ return(sc->w);
+}
+
+static s7_pointer collect_collisions_star(s7_scheme *sc, s7_pointer lst, s7_pointer e)
+{
+ /* collect local variable names from lambda arglists (pre-error-check) */
+ s7_pointer p;
+ sc->w = e;
+ for (p = lst; is_pair(p); p = cdr(p))
+ {
+ s7_pointer car_p;
+ car_p = car(p);
+ if (is_pair(car_p))
+ car_p = car(car_p);
+ if ((is_symbol(car_p)) &&
+ (!is_keyword(car_p)))
+ sc->w = cons(sc, add_sym_to_list(sc, car_p), sc->w);
+ }
+ return(sc->w);
+}
+
+
+#define choose_c_function(Sc, Expr, Func, Args) set_c_function(Expr, c_function_chooser(Func)(Sc, Func, Args, Expr))
+
+static bool optimize_thunk(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop)
+{
+ /* fprintf(stderr, "expr: %s, hop: %d\n", DISPLAY(expr), hop); */
+ if (is_immutable_symbol(car(expr)))
+ hop = 1;
+ if (is_closure(func))
+ {
+ if (is_null(closure_args(func))) /* no rest arg funny business */
+ {
+ if (is_safe_closure(func))
+ {
+ s7_pointer body;
+ body = closure_body(func);
+ set_unsafe_optimize_op(expr, hop + OP_SAFE_THUNK);
+ if (is_null(cdr(body)))
+ {
+ if (is_optimized(car(body)))
+ set_unsafe_optimize_op(expr, hop + OP_SAFE_THUNK_E);
+ else
+ {
+ if ((is_pair(car(body))) &&
+ (is_syntactic(caar(body))))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_THUNK_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_type(car(body), SYNTACTIC_PAIR);
+ }
+ }
+ }
+ }
+ }
+ else set_unsafe_optimize_op(expr, hop + OP_THUNK);
+ set_opt_lambda(expr, func);
+ }
+ return(false); /* false because currently the C_PP stuff assumes safe procedure calls */
+ }
+
+ if (is_c_function(func))
+ {
+ if (c_function_required_args(func) != 0)
+ return(false);
+
+ if ((is_safe_procedure(func)) ||
+ (c_function_call(func) == g_list) || /* (list) is safe */
+ (c_function_call(func) == g_values)) /* (values) is safe */
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
+ choose_c_function(sc, expr, func, 0);
+ return(true);
+ }
+ return(false);
+ }
+
+ if (is_closure_star(func))
+ {
+ if ((is_proper_list(sc, closure_args(func))) &&
+ (has_simple_args(closure_body(func))))
+ {
+ set_unsafe_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR : OP_CLOSURE_STAR));
+ set_opt_lambda(expr, func);
+ }
+ }
+ return(false);
+}
+
+
+static int combine_ops(s7_scheme *sc, combine_op_t op1, s7_pointer e1, s7_pointer e2)
+{
+ int op2;
+ op2 = op_no_hop(e2);
+
+ /* e_c_pp case (1) is slightly different from the others: e2 is not a part of e1
+ */
+ switch (op1)
+ {
+ case E_C_P:
+ switch (op2)
+ {
+ case OP_SAFE_C_C: return(OP_SAFE_C_opCq); /* this includes the multi-arg C_C cases */
+ case OP_SAFE_C_S: return(OP_SAFE_C_opSq);
+ case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq);
+ case OP_SAFE_C_SQ: return(OP_SAFE_C_opSQq);
+ case OP_SAFE_C_SC: return(OP_SAFE_C_opSCq);
+ case OP_SAFE_C_CS: return(OP_SAFE_C_opCSq);
+ case OP_SAFE_C_opSq: return(OP_SAFE_C_op_opSq_q);
+ case OP_SAFE_C_S_opSq: return(OP_SAFE_C_op_S_opSq_q);
+ case OP_SAFE_C_A: return(OP_SAFE_C_opAq);
+ case OP_SAFE_C_AA: return(OP_SAFE_C_opAAq);
+ case OP_SAFE_C_AAA: return(OP_SAFE_C_opAAAq);
+ }
+ return(OP_SAFE_C_Z); /* this splits out to A in optimize_func_one_arg */
+
+ case E_C_SP:
+ switch (op2)
+ {
+ case OP_SAFE_C_S:
+ set_opt_sym1(cdr(e1), cadr(e2));
+ return(OP_SAFE_C_S_opSq);
+
+ case OP_SAFE_C_C:
+ set_opt_pair1(cdr(e1), cdr(e2));
+ return(OP_SAFE_C_S_opCq);
+
+ case OP_SAFE_C_SC:
+ set_opt_sym1(cdr(e1), cadr(e2));
+ set_opt_con2(cdr(e1), caddr(e2));
+ return(OP_SAFE_C_S_opSCq);
+
+ case OP_SAFE_C_CS:
+ /* (* a (- 1 b)), e1 is the full expr, e2 is (- 1 b) */
+ set_opt_con1(cdr(e1), cadr(e2));
+ set_opt_sym2(cdr(e1), caddr(e2));
+ return(OP_SAFE_C_S_opCSq);
+
+ case OP_SAFE_C_SS:
+ /* (* a (- b c)) */
+ set_opt_sym1(cdr(e1), cadr(e2));
+ set_opt_sym2(cdr(e1), caddr(e2));
+ return(OP_SAFE_C_S_opSSq);
+
+ case OP_SAFE_C_opSSq_S:
+ return(OP_SAFE_C_S_op_opSSq_Sq);
+
+ case OP_SAFE_C_S_opSSq:
+ return(OP_SAFE_C_S_op_S_opSSqq);
+
+ case OP_SAFE_C_opSSq_opSSq:
+ return(OP_SAFE_C_S_op_opSSq_opSSqq);
+
+ case OP_SAFE_C_SZ:
+ return(OP_SAFE_C_S_opSZq);
+
+ case OP_SAFE_C_A:
+ return(OP_SAFE_C_S_opAq);
+
+ case OP_SAFE_C_AA:
+ return(OP_SAFE_C_S_opAAq);
+
+ case OP_SAFE_C_CSA:
+ case OP_SAFE_C_CAS:
+ case OP_SAFE_C_SCA:
+ case OP_SAFE_C_SAS:
+ case OP_SAFE_C_SSA:
+ case OP_SAFE_C_AAA:
+ return(OP_SAFE_C_S_opAAAq);
+ }
+ /* fprintf(stderr, "%s: %s\n", opt_names[op2], DISPLAY(e1)); */
+ return(OP_SAFE_C_SZ);
+
+ case E_C_PS:
+ switch (op2)
+ {
+ case OP_SAFE_C_C: return(OP_SAFE_C_opCq_S);
+ case OP_SAFE_C_S: return(OP_SAFE_C_opSq_S);
+ case OP_SAFE_C_CS: return(OP_SAFE_C_opCSq_S);
+ case OP_SAFE_C_SC: return(OP_SAFE_C_opSCq_S);
+ case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq_S);
+ case OP_SAFE_C_opSq: return(OP_SAFE_C_op_opSq_q_S);
+ case OP_SAFE_C_opSSq: return(OP_SAFE_C_op_opSSq_q_S);
+ }
+ return(OP_SAFE_C_ZS);
+
+ case E_C_PC:
+ switch (op2)
+ {
+ case OP_SAFE_C_C: return(OP_SAFE_C_opCq_C);
+ case OP_SAFE_C_S: return(OP_SAFE_C_opSq_C);
+ case OP_SAFE_C_CS: return(OP_SAFE_C_opCSq_C);
+ case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq_C);
+ case OP_SAFE_C_SC: return(OP_SAFE_C_opSCq_C);
+ case OP_SAFE_C_opSq: return(OP_SAFE_C_op_opSq_q_C);
+ case OP_SAFE_C_opSSq: return(OP_SAFE_C_op_opSSq_q_C);
+ }
+ return(OP_SAFE_C_ZC);
+
+ case E_C_CP:
+ switch (op2)
+ {
+ case OP_SAFE_C_C:
+ set_opt_pair1(cdr(e1), cdr(e2));
+ return(OP_SAFE_C_C_opCq);
+
+ case OP_SAFE_C_S:
+ set_opt_sym1(cdr(e1), cadr(e2));
+ return(OP_SAFE_C_C_opSq);
+
+ case OP_SAFE_C_CS:
+ set_opt_con1(cdr(e1), cadr(e2));
+ set_opt_sym2(cdr(e1), caddr(e2));
+ return(OP_SAFE_C_C_opCSq);
+
+ case OP_SAFE_C_SC:
+ set_opt_sym1(cdr(e1), cadr(e2));
+ set_opt_con2(cdr(e1), caddr(e2));
+ return(OP_SAFE_C_C_opSCq);
+
+ case OP_SAFE_C_SS:
+ set_opt_sym1(cdr(e1), cadr(e2));
+ set_opt_sym2(cdr(e1), caddr(e2));
+ return(OP_SAFE_C_C_opSSq);
+
+ case OP_SAFE_C_S_opCq:
+ return(OP_SAFE_C_C_op_S_opCqq);
+ }
+ return(OP_SAFE_C_CZ);
+
+ case E_C_PP:
+ switch (op2)
+ {
+ case OP_SAFE_C_S:
+ if (optimize_op_match(e1, OP_SAFE_C_S))
+ return(OP_SAFE_C_opSq_opSq);
+ if (optimize_op_match(e1, OP_SAFE_C_SS))
+ return(OP_SAFE_C_opSSq_opSq);
+ break;
+
+ case OP_SAFE_C_C:
+ if (optimize_op_match(e1, OP_SAFE_C_C))
+ return(OP_SAFE_C_opCq_opCq);
+ if (optimize_op_match(e1, OP_SAFE_C_SS))
+ return(OP_SAFE_C_opSSq_opCq);
+ break;
+
+ case OP_SAFE_C_SC:
+ if (optimize_op_match(e1, OP_SAFE_C_SC))
+ return(OP_SAFE_C_opSCq_opSCq);
+ break;
+
+ case OP_SAFE_C_SS:
+ if (optimize_op_match(e1, OP_SAFE_C_C))
+ return(OP_SAFE_C_opCq_opSSq);
+ if (optimize_op_match(e1, OP_SAFE_C_SS))
+ return(OP_SAFE_C_opSSq_opSSq);
+ if (optimize_op_match(e1, OP_SAFE_C_S))
+ return(OP_SAFE_C_opSq_opSSq);
+ break;
+ }
+ return(OP_SAFE_C_ZZ);
+
+ default:
+ break;
+ }
+ return(OP_NO_OP);
+}
+
+
+static void annotate_args(s7_scheme *sc, s7_pointer args, s7_pointer e)
+{
+ s7_pointer p;
+ for (p = args; is_pair(p); p = cdr(p))
+ set_c_call(p, all_x_eval(sc, car(p), e, (s7_is_list(sc, e)) ? pair_symbol_is_safe : let_symbol_is_safe));
+}
+
+static void annotate_arg(s7_scheme *sc, s7_pointer arg, s7_pointer e)
+{
+ /* if sc->envir is sc->NIL, we're at the top-level, but the global_slot check should suffice for that */
+ set_c_call(arg, all_x_eval(sc, car(arg), e, (s7_is_list(sc, e)) ? pair_symbol_is_safe : let_symbol_is_safe));
+}
+
+
+static void opt_generator(s7_scheme *sc, s7_pointer func, s7_pointer expr, int hop)
+{
+ /* this is an optimization aimed at generators. So we might as well go all out... */
+ if (is_global(car(expr))) /* not a function argument for example */
+ {
+ s7_pointer body;
+ body = closure_body(func);
+ if ((s7_list_length(sc, body) == 2) &&
+ (caar(body) == sc->LET_SET) &&
+ (is_optimized(car(body))) &&
+ (optimize_op(car(body)) == HOP_SAFE_C_SQS) &&
+ (caadr(body) == sc->WITH_LET) &&
+ (is_symbol(cadr(cadr(body)))))
+ {
+ s7_pointer args;
+ args = closure_args(func);
+ if ((cadr(cadr(body)) == car(args)) &&
+ (is_pair(cdr(args))) &&
+ (is_pair(cadr(args))) &&
+ (cadddr(car(body)) == caadr(closure_args(func))))
+ {
+ if (is_global(car(expr))) hop = 1; /* it's my party... */
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_S0);
+ set_opt_sym1(cdr(expr), cadr(caddar(body)));
+ set_opt_pair2(cdr(expr), cddadr(body));
+ }
+ }
+ }
+}
+
+static bool is_lambda(s7_scheme *sc, s7_pointer sym)
+{
+ return((sym == sc->LAMBDA) && (symbol_id(sym) == 0));
+ /* symbol_id==0 means it has never been rebound (T_GLOBAL might not be set for initial stuff) */
+}
+
+
+static bool optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
+{
+ s7_pointer arg1;
+ /* very often, expr is already optimized */
+
+ arg1 = cadr(expr);
+ if ((pairs == 0) &&
+ (is_immutable_symbol(car(expr))))
+ hop = 1;
+
+ if (((is_c_function(func)) &&
+ (c_function_required_args(func) <= 1) &&
+ (c_function_all_args(func) >= 1)) ||
+ ((is_c_function_star(func)) &&
+ (c_function_all_args(func) == 1))) /* surely no need to check key here? */
+ {
+ bool func_is_safe;
+ func_is_safe = is_safe_procedure(func);
+ if (pairs == 0)
+ {
+ if (func_is_safe) /* safe c function */
+ {
+ set_safe_optimize_op(expr, hop + ((symbols == 0) ? OP_SAFE_C_C : OP_SAFE_C_S));
+
+ /* we can't simply check is_global here to forego symbol value lookup later because we aren't
+ * tracking local vars, so the global bit may be on right now, but won't be when
+ * this code is evaluated. But memq(sym, e) would catch such cases.
+ * I think it has already been checked for func, so we only need to look for arg1.
+ * But global symbols are rare, and I don't see a huge savings in the lookup time --
+ * in callgrind it's about 7/lookup in both cases.
+ */
+
+ choose_c_function(sc, expr, func, 1);
+ return(true);
+ }
+ else /* c function is not safe */
+ {
+ set_unsafely_optimized(expr);
+ if (symbols == 0)
+ {
+ set_optimize_op(expr, hop + OP_C_A);
+ annotate_arg(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(1));
+ }
+ else
+ {
+ if (c_function_call(func) == g_read)
+ set_optimize_op(expr, hop + OP_READ_S);
+ else set_optimize_op(expr, hop + OP_C_S);
+ }
+ choose_c_function(sc, expr, func, 1);
+ return(false);
+ }
+ }
+ else /* pairs == 1 */
+ {
+ if (bad_pairs == 0)
+ {
+ if (func_is_safe)
+ {
+ int op;
+ op = combine_ops(sc, E_C_P, expr, arg1);
+ set_safe_optimize_op(expr, hop + op);
+ /* fallback is Z */
+ if (!hop)
+ {
+ clear_hop(arg1);
+ }
+ else
+ {
+ if ((op == OP_SAFE_C_Z) &&
+ (is_all_x_op(optimize_op(arg1))))
+ {
+ /* this is confusing! this is much faster than safe_c_z, but
+ * the parallel let_z|a case seems to claim that z is faster.
+ */
+ set_optimize_op(expr, hop + OP_SAFE_C_A);
+ annotate_arg(sc, cdr(expr), e);
+ }
+ }
+ choose_c_function(sc, expr, func, 1);
+ return(true);
+ }
+ if (is_all_x_op(optimize_op(arg1)))
+ {
+ set_unsafe_optimize_op(expr, hop + OP_C_A);
+ annotate_arg(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(1));
+ choose_c_function(sc, expr, func, 1);
+ return(false);
+ }
+ }
+ else /* bad_pairs == 1 */
+ {
+ if (quotes == 1)
+ {
+ if (func_is_safe)
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_Q);
+ choose_c_function(sc, expr, func, 1);
+ return(true);
+ }
+ set_unsafe_optimize_op(expr, hop + OP_C_A);
+ annotate_arg(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(1));
+ choose_c_function(sc, expr, func, 1);
+ return(false);
+ }
+ else /* quotes == 0 */
+ {
+ if (!func_is_safe)
+ {
+ s7_pointer lambda_expr;
+ lambda_expr = arg1;
+ if ((is_pair(lambda_expr)) &&
+ (is_lambda(sc, car(lambda_expr))) && /* check for stuff like (define (f) (eval (lambda 2))) */
+ (is_pair(cdr(lambda_expr))) &&
+ (is_pair(cddr(lambda_expr))))
+ {
+ if ((c_function_call(func) == g_call_with_exit) &&
+ (is_pair(cadr(lambda_expr))) &&
+ (is_null(cdadr(lambda_expr))))
+ {
+ set_unsafe_optimize_op(expr, hop + OP_CALL_WITH_EXIT);
+ choose_c_function(sc, expr, func, 1);
+ set_opt_pair2(expr, cdr(lambda_expr));
+ return(false);
+ }
+ }
+ }
+ set_unsafe_optimize_op(expr, hop + ((is_h_optimized(arg1)) ? OP_C_Z : OP_C_P));
+ choose_c_function(sc, expr, func, 1);
+ return(false);
+ }
+ }
+ }
+
+ if (!func_is_safe)
+ {
+ set_unsafe_optimize_op(expr, hop + ((is_h_optimized(arg1)) ? OP_C_Z : OP_C_P));
+ choose_c_function(sc, expr, func, 1);
+ return(false);
+ }
+ return(is_optimized(expr));
+ }
+
+ if (is_closure(func))
+ {
+ bool safe_case, global_case;
+ s7_pointer body;
+
+ if (closure_arity_to_int(sc, func) != 1)
+ return(false);
+ /* this is checking for dotted arglists: boolean=? for example. To optimize these calls, we need op_closure cases that
+ * bind the dotted name to the remaining args as a list. This does not happen enough to be worth the trouble.
+ */
+ safe_case = is_safe_closure(func);
+ global_case = is_global(car(expr));
+ body = closure_body(func);
+
+ if (pairs == 0)
+ {
+ if (is_symbol(arg1))
+ {
+ if (safe_case)
+ {
+ set_optimize_op(expr, hop + ((global_case) ? OP_SAFE_GLOSURE_S : OP_SAFE_CLOSURE_S));
+ if (is_null(cdr(body)))
+ {
+ if ((global_case) &&
+ (is_optimized(car(body))))
+ set_optimize_op(expr, hop + OP_SAFE_GLOSURE_S_E);
+ else
+ {
+ if ((is_pair(car(body))) &&
+ (is_syntactic(caar(body))))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_S_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_type(car(body), SYNTACTIC_PAIR);
+ }
+ }
+ }
+ }
+ }
+ else set_optimize_op(expr, hop + ((global_case) ? OP_GLOSURE_S : OP_CLOSURE_S));
+ set_opt_sym2(expr, arg1);
+ }
+ else
+ {
+ set_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_C : OP_CLOSURE_C));
+ set_opt_con2(expr, arg1);
+ }
+ set_opt_lambda(expr, func);
+ set_unsafely_optimized(expr);
+ return(false);
+ }
+ else /* pairs == 1 */
+ {
+ if (bad_pairs == 0)
+ {
+ if ((is_optimized(arg1)) &&
+ (is_all_x_op(optimize_op(arg1))))
+ {
+ set_unsafely_optimized(expr);
+ annotate_arg(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(1));
+ if (safe_case)
+ set_optimize_op(expr, hop + ((global_case) ? OP_SAFE_GLOSURE_A : OP_SAFE_CLOSURE_A));
+ else set_optimize_op(expr, hop + ((global_case) ? OP_GLOSURE_A : OP_CLOSURE_A));
+ set_opt_lambda(expr, func);
+ return(false);
+ }
+ }
+ else /* bad_pairs == 1 */
+ {
+ if (quotes == 1)
+ {
+ set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_Q : OP_CLOSURE_Q));
+ set_opt_lambda(expr, func);
+ return(false);
+ }
+ }
+ if ((quotes == 0) &&
+ (global_case))
+ {
+ set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_GLOSURE_P : OP_GLOSURE_P));
+ set_opt_lambda(expr, func);
+ return(false);
+ }
+ }
+
+ if (pairs == (quotes + all_x_count(expr)))
+ {
+ set_unsafe_optimize_op(expr, hop + ((safe_case ? OP_SAFE_CLOSURE_A : OP_CLOSURE_A)));
+ annotate_arg(sc, cdr(expr), e);
+ set_opt_lambda(expr, func);
+ set_arglist_length(expr, small_int(1));
+ return(false);
+ }
+ return(is_optimized(expr));
+ }
+
+ if (is_closure_star(func))
+ {
+ bool safe_case;
+ if ((!has_simple_args(closure_body(func))) ||
+ (is_null(closure_args(func))))
+ return(false);
+ safe_case = is_safe_closure(func);
+
+ if ((pairs == 0) &&
+ (symbols == 1))
+ {
+ set_unsafely_optimized(expr);
+ if (safe_case)
+ {
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_S);
+ if (closure_star_arity_to_int(sc, func) == 2)
+ {
+ s7_pointer defarg2;
+ defarg2 = cadr(closure_args(func));
+ if ((is_pair(defarg2)) &&
+ (s7_is_zero(cadr(defarg2))))
+ opt_generator(sc, func, expr, hop);
+ }
+ }
+ else set_optimize_op(expr, hop + OP_CLOSURE_STAR_S);
+ set_opt_lambda(expr, func);
+ set_opt_sym2(expr, arg1);
+ return(false);
+ }
+
+ if ((!arglist_has_rest(sc, closure_args(func))) &&
+ (pairs == (quotes + all_x_count(expr))))
+ {
+ set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ annotate_arg(sc, cdr(expr), e);
+ set_opt_lambda(expr, func);
+ set_arglist_length(expr, small_int(1));
+ return(false);
+ }
+ return(is_optimized(expr));
+ }
+
+ if ((pairs == 0) &&
+ (s7_is_vector(func)))
+ {
+ set_safe_optimize_op(expr, hop + ((symbols == 1) ? OP_VECTOR_S : OP_VECTOR_C));
+ set_opt_vector(expr, func);
+ return(true);
+ }
+ /* unknown_* is set later */
+ return(is_optimized(expr));
+}
+
+
+static bool rdirect_memq(s7_scheme *sc, s7_pointer symbol, s7_pointer symbols)
+{
+ s7_pointer x;
+ for (x = symbols; is_pair(x); x = cdr(x))
+ {
+ if (car(x) == symbol)
+ return(true);
+ x = cdr(x);
+ if (car(x) == symbol) /* car(nil)=unspec, cdr(unspec)=unspec! This only works for lists known to be undotted and non-circular */
+ return(true);
+ }
+ return(false);
+}
+
+static s7_pointer find_uncomplicated_symbol(s7_scheme *sc, s7_pointer symbol, s7_pointer e)
+{
+ s7_pointer x;
+ long long int id;
+
+ if ((symbol_tag(symbol) == sc->syms_tag) &&
+ (rdirect_memq(sc, symbol, e))) /* it's probably a local variable reference */
+ return(sc->NIL);
+
+ if (is_global(symbol))
+ return(global_slot(symbol));
+
+ id = symbol_id(symbol);
+ for (x = sc->envir; id < let_id(x); x = outlet(x));
+ for (; is_let(x); x = outlet(x))
+ {
+ s7_pointer y;
+ if (let_id(x) == id)
+ return(local_slot(symbol));
+
+ for (y = let_slots(x); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == symbol)
+ return(y);
+ }
+
+ return(global_slot(symbol)); /* it's no longer global perhaps (local definition now inaccessible) */
+}
+
+
+static bool unsafe_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer arg1, s7_pointer arg2, s7_pointer arg3, s7_pointer e)
+{
+ s7_pointer f = NULL; /* arg3 if member|assoc */
+ if (!arg3) return(true);
+ f = arg3;
+ if (!is_symbol(f)) return(false);
+ f = find_uncomplicated_symbol(sc, f, e); /* form_is_safe -- how to catch local c-funcs here? */
+ if (is_slot(f))
+ {
+ f = slot_value(f);
+ return((is_c_function(f)) &&
+ (is_safe_procedure(f)));
+ }
+ return(false);
+}
+
+static bool optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
+{
+ s7_pointer arg1, arg2;
+
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ if ((pairs == 0) &&
+ (is_immutable_symbol(car(expr))))
+ hop = 1;
+
+ if ((is_c_function(func) &&
+ (c_function_required_args(func) <= 2) &&
+ (c_function_all_args(func) >= 2)) ||
+ ((is_c_function_star(func)) &&
+ (c_function_all_args(func) == 2) &&
+ (!is_keyword(arg1))))
+ {
+ /* this is a mess */
+ bool func_is_safe;
+ func_is_safe = is_safe_procedure(func);
+ if (pairs == 0)
+ {
+ if ((func_is_safe) ||
+ ((is_possibly_safe(func)) &&
+ (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ {
+ /* another case here: set-car! and set-cdr! are safe if symbols==1 and arg1 is the symbol (i.e. arg2 is a constant) */
+ if (symbols == 0)
+ set_optimize_op(expr, hop + OP_SAFE_C_C);
+ else
+ {
+ if (symbols == 2)
+ set_optimize_op(expr, hop + OP_SAFE_C_SS); /* these two symbols are almost never the same, (sqrt (+ (* x x) (* y y))) */
+ else set_optimize_op(expr, hop + ((is_symbol(arg1)) ? OP_SAFE_C_SC : OP_SAFE_C_CS));
+ }
+ set_optimized(expr);
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ set_unsafely_optimized(expr);
+ if (symbols == 2)
+ {
+ if (c_function_call(func) == g_apply)
+ {
+ set_optimize_op(expr, hop + OP_APPLY_SS);
+ set_opt_cfunc(expr, func);
+ set_opt_sym2(expr, arg2);
+ }
+ else
+ {
+ set_optimize_op(expr, hop + OP_C_SS);
+ choose_c_function(sc, expr, func, 2);
+ }
+ }
+ else
+ {
+ set_optimize_op(expr, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ choose_c_function(sc, expr, func, 2);
+ if (is_safe_procedure(opt_cfunc(expr)))
+ {
+ clear_unsafe(expr);
+ set_optimized(expr);
+ /* symbols can be 0..2 here, no pairs */
+ if (symbols == 1)
+ {
+ if (is_symbol(arg1))
+ set_optimize_op(expr, hop + OP_SAFE_C_SC);
+ else set_optimize_op(expr, hop + OP_SAFE_C_CS);
+ }
+ else
+ {
+ if (symbols == 2)
+ set_optimize_op(expr, hop + OP_SAFE_C_SS);
+ else set_optimize_op(expr, hop + OP_SAFE_C_C);
+ }
+ return(true);
+ }
+ }
+ return(false);
+ }
+
+ /* pairs != 0 */
+ if ((bad_pairs == 0) &&
+ (pairs == 2))
+ {
+ if ((func_is_safe) ||
+ ((is_possibly_safe(func)) &&
+ (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ {
+ int op;
+ op = combine_ops(sc, E_C_PP, arg1, arg2);
+ set_safe_optimize_op(expr, hop + op);
+ /* fallback here is ZZ */
+ if (!hop)
+ {
+ clear_hop(arg1);
+ clear_hop(arg2);
+ }
+ else
+ {
+ if (op == OP_SAFE_C_ZZ)
+ {
+ if (is_all_x_safe(sc, arg1))
+ {
+ if (is_all_x_safe(sc, arg2))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_AA);
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ }
+ else
+ {
+ if (optimize_op(arg1) == HOP_SAFE_C_C)
+ set_optimize_op(expr, hop + OP_SAFE_C_opCq_Z);
+ else
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_AZ);
+ annotate_arg(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ }
+ }
+ }
+ else
+ {
+ if (is_all_x_safe(sc, arg2))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_ZA);
+ annotate_arg(sc, cddr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ }
+ }
+ }
+ }
+ choose_c_function(sc, expr, func, 2); /* this might change the op to safe_c_c, so it has to be last */
+ return(true);
+ }
+ }
+
+ if ((bad_pairs == 0) &&
+ (pairs == 1))
+ {
+ if ((func_is_safe) ||
+ ((is_possibly_safe(func)) &&
+ (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ {
+ combine_op_t orig_op;
+ int op;
+
+ if (is_pair(arg1))
+ {
+ if (is_symbol(arg2))
+ orig_op = E_C_PS;
+ else orig_op = E_C_PC;
+ op = combine_ops(sc, orig_op, expr, arg1);
+ if (!hop) clear_hop(arg1);
+ }
+ else
+ {
+ if (is_symbol(arg1))
+ orig_op = E_C_SP;
+ else orig_op = E_C_CP;
+ op = combine_ops(sc, orig_op, expr, arg2);
+ if (!hop) clear_hop(arg2);
+ }
+
+ set_safe_optimize_op(expr, hop + op);
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ if (symbols == 1)
+ {
+ if (is_symbol(arg1))
+ {
+ if (is_safe_c_s(arg2))
+ {
+ set_unsafe_optimize_op(expr, hop + OP_C_S_opSq);
+ set_opt_sym1(cdr(expr), cadr(arg2));
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ if (optimize_op_match(arg2, OP_SAFE_C_C))
+ {
+ set_unsafe_optimize_op(expr, hop + OP_C_S_opCq);
+ set_opt_pair1(cdr(expr), cdr(arg2));
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ }
+ }
+ }
+
+ if ((bad_pairs == 1) && (quotes == 1))
+ {
+ if ((func_is_safe) ||
+ ((is_possibly_safe(func)) &&
+ (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ {
+ if (symbols == 1)
+ {
+ set_optimized(expr);
+ if (is_symbol(arg1))
+ set_optimize_op(expr, hop + OP_SAFE_C_SQ);
+ else set_optimize_op(expr, hop + OP_SAFE_C_QS);
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ else
+ {
+ if (pairs == 1)
+ {
+ /* Q must be 1, symbols = 0, pairs = 1 (the quote), so this must be CQ or QC?
+ */
+ set_optimized(expr);
+ if (is_pair(arg1))
+ set_optimize_op(expr, hop + OP_SAFE_C_QC);
+ else set_optimize_op(expr, hop + OP_SAFE_C_CQ);
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ if (pairs == 1)
+ {
+ set_unsafe_optimize_op(expr, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ }
+ }
+
+ if (quotes == 2)
+ {
+ if ((func_is_safe) ||
+ ((is_possibly_safe(func)) &&
+ (unsafe_is_safe(sc, func, arg1, arg2, NULL, e))))
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_QQ);
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ set_unsafe_optimize_op(expr, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+
+ if ((pairs == 1) &&
+ (quotes == 0) &&
+ ((func_is_safe) ||
+ ((is_possibly_safe(func)) &&
+ (unsafe_is_safe(sc, func, arg1, arg2, NULL, e)))))
+ {
+ if (symbols == 1)
+ {
+ set_optimized(expr);
+ if (is_symbol(arg1))
+ {
+ if ((bad_pairs == 0) || (is_h_optimized(arg2))) /* bad_pair && h_optimized happens a lot */
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_SZ);
+ choose_c_function(sc, expr, func, 2);
+ /* if hop is on, is it the case that opt1 is unused? where besides c_function_is_ok is it referenced?
+ * some like add_ss_1ss use opt1(cdr(...)) which is safe here I think because cadr is a symbol
+ * it's used in the choosers to detect e.g. temp funcs
+ */
+ return(true);
+ }
+ set_unsafe(expr);
+ set_optimize_op(expr, hop + OP_SAFE_C_SP);
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+
+ /* arg2 is a symbol */
+ if ((bad_pairs == 0) || (is_h_optimized(arg1)))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_ZS);
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ /* unknowns get here: (* amp (amps 0))
+ * also list: (make-polywave pitch (list 1 0.93 2 0.07))
+ * and (* vol (granulate gen))
+ */
+ set_unsafe(expr);
+ set_optimize_op(expr, hop + OP_SAFE_C_PS);
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ if (symbols == 0)
+ {
+ set_optimized(expr);
+ if (is_pair(arg1))
+ {
+ if ((bad_pairs == 0) || (is_h_optimized(arg2)))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_ZC);
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ else
+ {
+ set_unsafe(expr);
+ set_optimize_op(expr, hop + OP_SAFE_C_PC);
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ }
+ else
+ {
+ if ((bad_pairs == 0) || (is_h_optimized(arg1)))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_CZ);
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ else
+ {
+ set_unsafe(expr);
+ set_optimize_op(expr, hop + OP_SAFE_C_CP);
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ }
+ }
+ }
+
+ if ((pairs == 2) &&
+ ((func_is_safe) ||
+ ((is_possibly_safe(func)) &&
+ (unsafe_is_safe(sc, func, arg1, arg2, NULL, e)))))
+ {
+ if ((bad_pairs == 1) &&
+ (is_safe_c_s(arg1)))
+ {
+ /* unsafe func here won't work unless we check that later and make the new arg list (for {list} etc)
+ * (and it has to be the last pair else the unknown_g stuff can mess up)
+ */
+ set_unsafe_optimize_op(expr, hop + OP_SAFE_C_opSq_P);
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ else
+ {
+ if (quotes == 0)
+ {
+ set_unsafely_optimized(expr);
+ if (is_all_x_safe(sc, arg1))
+ {
+ set_optimize_op(expr, hop + ((is_h_optimized(arg2)) ? OP_SAFE_C_AZ : OP_SAFE_C_AP));
+ annotate_arg(sc, cdr(expr), e);
+ }
+ else set_optimize_op(expr, hop + OP_SAFE_C_PP);
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ else
+ {
+ if (quotes == 1)
+ {
+ if (car(arg1) == sc->QUOTE)
+ set_optimize_op(expr, hop + OP_SAFE_C_QP);
+ else set_optimize_op(expr, hop + OP_SAFE_C_PQ);
+ set_unsafely_optimized(expr);
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ }
+ }
+ }
+
+ if (func_is_safe)
+ {
+ if (pairs == (quotes + all_x_count(expr)))
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_AA);
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(2));
+ choose_c_function(sc, expr, func, 2);
+ return(true);
+ }
+ }
+
+ if ((pairs == 1) &&
+ (symbols == 1) &&
+ (quotes == 0) &&
+ (!func_is_safe) &&
+ (is_symbol(arg1)))
+ {
+ set_unsafe_optimize_op(expr, hop + ((is_h_optimized(arg2)) ? OP_C_SZ : OP_C_SP));
+ choose_c_function(sc, expr, func, 2);
+ return(false);
+ }
+ return(is_optimized(expr));
+ }
+
+ if (is_closure(func))
+ {
+ if (closure_arity_to_int(sc, func) != 2)
+ return(false);
+
+ if ((pairs == 0) &&
+ (symbols >= 1))
+ {
+ set_unsafely_optimized(expr);
+ if (symbols == 2)
+ {
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_SS : OP_CLOSURE_SS));
+ set_opt_sym2(expr, arg2);
+ }
+ else
+ {
+ if (is_symbol(arg1))
+ {
+ set_optimize_op(expr, hop + ((is_safe_closure(func) ? OP_SAFE_CLOSURE_SC : OP_CLOSURE_SC)));
+ set_opt_con2(expr, arg2);
+ }
+ else
+ {
+ set_optimize_op(expr, hop + ((is_safe_closure(func) ? OP_SAFE_CLOSURE_CS : OP_CLOSURE_CS)));
+ set_opt_sym2(expr, arg2);
+ }
+ }
+ set_opt_lambda(expr, func);
+ return(false);
+ }
+
+ if ((!arglist_has_rest(sc, closure_args(func))) &&
+ (pairs == (quotes + all_x_count(expr))))
+ {
+ set_unsafely_optimized(expr);
+ if (is_safe_closure(func))
+ {
+ if (is_symbol(arg1))
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_SA);
+ else set_optimize_op(expr, hop + OP_SAFE_CLOSURE_AA);
+ }
+ else set_optimize_op(expr, hop + OP_CLOSURE_AA);
+ annotate_args(sc, cdr(expr), e);
+ set_opt_lambda(expr, func);
+ set_arglist_length(expr, small_int(2));
+ return(false);
+ }
+ return(is_optimized(expr));
+ }
+
+ if (is_closure_star(func))
+ {
+ if (((!has_simple_args(closure_body(func))) ||
+ (closure_star_arity_to_int(sc, func) < 2) ||
+ (arglist_has_keyword(cdr(expr)))))
+ return(false);
+
+ if ((pairs == 0) &&
+ (symbols >= 1) &&
+ (is_symbol(arg1)))
+ {
+ set_unsafely_optimized(expr);
+ if (symbols == 2)
+ {
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_SS : OP_CLOSURE_STAR_SX));
+ set_opt_sym2(expr, arg2);
+ }
+ else
+ {
+ if (is_safe_closure(func))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_SC);
+ set_opt_con2(expr, arg2);
+ if (arg2 == real_zero)
+ opt_generator(sc, func, expr, hop);
+ }
+ else set_optimize_op(expr, hop + OP_CLOSURE_STAR_SX);
+ }
+ set_opt_lambda(expr, func);
+ return(false);
+ }
+
+ if ((!arglist_has_rest(sc, closure_args(func))) &&
+ (pairs == (quotes + all_x_count(expr))))
+ {
+ set_unsafely_optimized(expr);
+ if (is_safe_closure(func))
+ {
+ if ((is_symbol(arg1)) &&
+ (closure_star_arity_to_int(sc, func) == 2))
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_SA);
+ else set_optimize_op(expr, hop + OP_SAFE_CLOSURE_STAR_ALL_X);
+ }
+ else set_optimize_op(expr, hop + OP_CLOSURE_STAR_ALL_X);
+ annotate_args(sc, cdr(expr), e);
+ set_opt_lambda(expr, func);
+ set_arglist_length(expr, small_int(2));
+ return(false);
+ }
+ }
+ return(is_optimized(expr));
+}
+
+
+static bool optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
+{
+ s7_pointer arg1, arg2, arg3;
+
+ arg1 = cadr(expr);
+ arg2 = caddr(expr);
+ arg3 = cadddr(expr);
+ if ((pairs == 0) &&
+ (is_immutable_symbol(car(expr))))
+ hop = 1;
+
+ if ((is_c_function(func) &&
+ (c_function_required_args(func) <= 3) &&
+ (c_function_all_args(func) >= 3)) ||
+ ((is_c_function_star(func)) &&
+ (c_function_all_args(func) == 3) &&
+ (!is_keyword(arg1)) &&
+ (!is_keyword(arg2))))
+ {
+ if ((is_safe_procedure(func)) ||
+ ((is_possibly_safe(func)) &&
+ (unsafe_is_safe(sc, func, arg1, arg2, arg3, e))))
+ {
+ if (pairs == 0)
+ {
+ set_optimized(expr);
+ if (symbols == 0)
+ set_optimize_op(expr, hop + OP_SAFE_C_C);
+ else
+ {
+ if (symbols == 3)
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_SSS);
+ set_opt_sym1(cdr(expr), arg2);
+ set_opt_sym2(cdr(expr), arg3);
+ }
+ else
+ {
+ if (symbols == 2)
+ {
+ if (!is_symbol(arg1))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_CSS);
+ set_opt_sym1(cdr(expr), arg2);
+ set_opt_sym2(cdr(expr), arg3);
+ }
+ else
+ {
+ if (!is_symbol(arg3))
+ {
+ set_opt_con2(cdr(expr), arg3);
+ if (is_keyword(arg2))
+ {
+ set_opt_con1(cdr(expr), arg2);
+ set_optimize_op(expr, hop + OP_SAFE_C_SCC);
+ }
+ else
+ {
+ set_opt_sym1(cdr(expr), arg2);
+ set_optimize_op(expr, hop + OP_SAFE_C_SSC);
+ }
+ }
+ else
+ {
+ set_opt_con1(cdr(expr), arg2);
+ set_opt_sym2(cdr(expr), arg3);
+ set_optimize_op(expr, hop + OP_SAFE_C_SCS);
+ }
+ }
+ }
+ else
+ {
+ if (is_symbol(arg1))
+ {
+ set_opt_con1(cdr(expr), arg2);
+ set_opt_con2(cdr(expr), arg3);
+ set_optimize_op(expr, hop + OP_SAFE_C_SCC);
+ }
+ else
+ {
+ if (is_symbol(arg2))
+ {
+ set_opt_sym1(cdr(expr), arg2);
+ set_opt_con2(cdr(expr), arg3);
+ set_optimize_op(expr, hop + OP_SAFE_C_CSC);
+ }
+ else
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_AAA); /* fallback on all_x_c and s here -- a kludge */
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(3));
+ }
+ }
+ }
+ }
+ }
+ choose_c_function(sc, expr, func, 3);
+ return(true);
+ }
+
+ /* pairs != 0 */
+ if (pairs == quotes + all_x_count(expr))
+ {
+ set_optimized(expr);
+ if ((symbols == 2) &&
+ (quotes == 1))
+ {
+ if ((is_symbol(arg1)) &&
+ (is_symbol(arg3)))
+ {
+ set_opt_con1(cdr(expr), cadr(arg2));
+ set_opt_sym2(cdr(expr), arg3);
+ set_optimize_op(expr, hop + OP_SAFE_C_SQS);
+ choose_c_function(sc, expr, func, 3);
+ return(true);
+ }
+ }
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(3));
+ set_optimize_op(expr, hop + OP_SAFE_C_AAA);
+
+ if (pairs == 1)
+ {
+ if (symbols == 1)
+ {
+ if (is_pair(arg3))
+ {
+ if (is_symbol(arg2))
+ set_optimize_op(expr, hop + OP_SAFE_C_CSA);
+ else set_optimize_op(expr, hop + OP_SAFE_C_SCA);
+ }
+ else
+ {
+ if ((is_pair(arg2)) &&
+ (is_symbol(arg3)))
+ set_optimize_op(expr, hop + OP_SAFE_C_CAS);
+ }
+ }
+ else
+ {
+ if ((symbols == 2) && (is_symbol(arg1)))
+ set_optimize_op(expr, hop + ((is_symbol(arg2)) ? OP_SAFE_C_SSA : OP_SAFE_C_SAS));
+ }
+ }
+ choose_c_function(sc, expr, func, 3);
+ return(true);
+ }
+
+ if (bad_pairs == 0)
+ {
+ if ((symbols == 2) &&
+ (is_symbol(arg1)) &&
+ (is_symbol(arg2)))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_SSZ);
+ }
+ else
+ {
+ /* use either X or Z in all 8 choices */
+ if ((!is_pair(arg1)) ||
+ (is_all_x_op(optimize_op(arg1))))
+ {
+ annotate_arg(sc, cdr(expr), e);
+ if ((!is_pair(arg2)) ||
+ (is_all_x_op(optimize_op(arg2))))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_AAZ); /* here last can't be A because we checked for that above */
+ annotate_arg(sc, cddr(expr), e);
+ }
+ else
+ {
+ if ((!is_pair(arg3)) ||
+ (is_all_x_op(optimize_op(arg3))))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_AZA);
+ annotate_arg(sc, cdddr(expr), e);
+ }
+ else set_optimize_op(expr, hop + OP_SAFE_C_AZZ);
+ }
+ }
+ else
+ {
+ if ((!is_pair(arg2)) ||
+ (is_all_x_op(optimize_op(arg2))))
+ {
+ annotate_arg(sc, cddr(expr), e);
+ if ((!is_pair(arg3)) ||
+ (is_all_x_op(optimize_op(arg3))))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_ZAA);
+ annotate_arg(sc, cdddr(expr), e);
+ }
+ else set_optimize_op(expr, hop + OP_SAFE_C_ZAZ);
+ }
+ else
+ {
+ if ((!is_pair(arg3)) ||
+ (is_all_x_op(optimize_op(arg3))))
+ {
+ set_optimize_op(expr, hop + OP_SAFE_C_ZZA);
+ annotate_arg(sc, cdddr(expr), e);
+ }
+ else set_optimize_op(expr, hop + OP_SAFE_C_ZZZ);
+ }
+ }
+ }
+ set_optimized(expr);
+ choose_c_function(sc, expr, func, 3);
+ set_arglist_length(expr, small_int(3));
+ return(true);
+ }
+
+ /* aap is not better than ssp, sap also saves very little */
+ if ((pairs == 1) &&
+ (bad_pairs == 1) &&
+ (symbols == 2) &&
+ (is_pair(arg3)))
+ {
+ set_unsafe_optimize_op(expr, hop + ((is_h_optimized(arg3)) ? OP_SAFE_C_SSZ : OP_SAFE_C_SSP));
+ choose_c_function(sc, expr, func, 3);
+ return(false);
+ }
+ }
+ else /* func is not safe */
+ {
+ if (pairs == quotes + all_x_count(expr))
+ {
+ set_optimized(expr);
+ if ((symbols == 2) &&
+ (pairs == 0) &&
+ (is_symbol(arg1)) &&
+ (is_symbol(arg3)))
+ set_optimize_op(expr, hop + OP_C_SCS);
+ else
+ {
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, small_int(3));
+ set_optimize_op(expr, hop + OP_C_ALL_X);
+ }
+ choose_c_function(sc, expr, func, 3);
+ if (optimize_op(expr) != HOP_SAFE_C_C) /* did chooser fix it up? */
+ {
+ set_unsafe(expr);
+ return(false);
+ }
+ return(true);
+ }
+
+ /* (define (hi) (catch #t (lambda () 1) (lambda args 2)))
+ * first arg list must be (), second a symbol
+ */
+ if (c_function_call(func) == g_catch)
+ {
+ if (((bad_pairs == 2) && (!is_pair(arg1))) ||
+ ((bad_pairs == 3) && (car(arg1) == sc->QUOTE)))
+ {
+ s7_pointer body_lambda, error_lambda;
+ body_lambda = arg2;
+ error_lambda = arg3;
+
+ if ((is_pair(body_lambda)) &&
+ (is_lambda(sc, car(body_lambda))) &&
+ (is_pair(error_lambda)) &&
+ (is_lambda(sc, car(error_lambda))) &&
+ (is_null(cadr(body_lambda))) &&
+ (is_not_null(cddr(body_lambda))) &&
+ (is_symbol(cadr(error_lambda))) &&
+ (!is_immutable_symbol(cadr(error_lambda))) &&
+ (is_not_null(cddr(error_lambda))))
+ {
+ s7_pointer error_result;
+ error_result = caddr(error_lambda);
+ set_unsafely_optimized(expr);
+ if ((arg1 == sc->T) &&
+ (is_null(cdddr(error_lambda))) &&
+ (!is_symbol(error_result)) &&
+ ((!is_pair(error_result)) || (car(error_result) == sc->QUOTE)))
+ {
+ set_optimize_op(expr, hop + OP_C_CATCH_ALL);
+ set_c_function(expr, func);
+ if (is_pair(error_result))
+ set_opt_con2(expr, cadr(error_result));
+ else set_opt_con2(expr, error_result);
+ set_opt_pair1(cdr(expr), cddr(body_lambda));
+ }
+ else
+ {
+ set_optimize_op(expr, hop + OP_C_CATCH);
+ choose_c_function(sc, expr, func, 3);
+ }
+ return(false);
+ }
+ }
+ }
+ }
+ return(is_optimized(expr));
+ }
+
+ /* not c func */
+ if(is_closure(func))
+ {
+ if (closure_arity_to_int(sc, func) != 3)
+ return(false);
+
+ if ((symbols == 3) &&
+ (!is_safe_closure(func)))
+ {
+ set_unsafely_optimized(expr);
+ set_opt_lambda(expr, func);
+ set_arglist_length(expr, small_int(3));
+ set_optimize_op(expr, hop + OP_CLOSURE_ALL_S);
+ return(false);
+ }
+
+ if (pairs == quotes + all_x_count(expr))
+ {
+ if (is_safe_closure(func))
+ {
+ if (is_symbol(arg1))
+ set_optimize_op(expr, hop + OP_SAFE_CLOSURE_SAA);
+ else set_optimize_op(expr, hop + OP_SAFE_CLOSURE_ALL_X);
+ }
+ else set_optimize_op(expr, hop + OP_CLOSURE_ALL_X);
+ set_unsafely_optimized(expr);
+ annotate_args(sc, cdr(expr), e);
+ set_opt_lambda(expr, func);
+ set_arglist_length(expr, small_int(3));
+ return(false);
+ }
+ }
+
+ if (is_closure_star(func))
+ {
+ if ((!has_simple_args(closure_body(func))) ||
+ (closure_star_arity_to_int(sc, func) < 3) ||
+ (arglist_has_keyword(cdr(expr))) ||
+ (arglist_has_rest(sc, closure_args(func)))) /* is this redundant? */
+ return(false);
+
+ if (pairs == quotes + all_x_count(expr))
+ {
+ set_unsafe_optimize_op(expr, hop + ((is_safe_closure(func) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X)));
+ annotate_args(sc, cdr(expr), e);
+ set_opt_lambda(expr, func);
+ set_arglist_length(expr, small_int(3));
+ return(false);
+ }
+ }
+
+ if (bad_pairs > quotes) return(false);
+ return(is_optimized(expr));
+}
+
+
+static bool optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, int args, int pairs, int symbols, int quotes, int bad_pairs, s7_pointer e)
+{
+ bool func_is_closure;
+
+ if (bad_pairs > quotes) return(false);
+ if ((pairs == 0) &&
+ (is_immutable_symbol(car(expr))))
+ hop = 1;
+
+ if ((is_c_function(func)) &&
+ (c_function_required_args(func) <= (unsigned int)args) &&
+ (c_function_all_args(func) >= (unsigned int)args))
+ {
+ if (is_safe_procedure(func))
+ {
+ if (pairs == 0)
+ {
+ if (symbols == 0)
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
+ choose_c_function(sc, expr, func, args);
+ return(true);
+ }
+ if ((symbols == args) &&
+ (args < GC_TRIGGER_SIZE))
+ {
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_ALL_S);
+ set_arglist_length(expr, make_permanent_integer(args));
+ choose_c_function(sc, expr, func, args);
+ return(true);
+ }
+ }
+
+ if ((args < GC_TRIGGER_SIZE) &&
+ (pairs == (quotes + all_x_count(expr))))
+ {
+ set_optimized(expr);
+ if (args == 4)
+ set_optimize_op(expr, hop + OP_SAFE_C_AAAA);
+ else set_optimize_op(expr, hop + OP_SAFE_C_ALL_X);
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, make_permanent_integer(args));
+ choose_c_function(sc, expr, func, args);
+ return(true);
+ }
+ }
+ else /* c_func is not safe */
+ {
+ if ((args < GC_TRIGGER_SIZE) &&
+ (pairs == (quotes + all_x_count(expr))))
+ {
+ set_unsafe_optimize_op(expr, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, make_permanent_integer(args));
+ choose_c_function(sc, expr, func, args);
+ return(false);
+ }
+ }
+ return(is_optimized(expr));
+ }
+
+ func_is_closure = is_closure(func);
+ if (func_is_closure)
+ {
+ if (closure_arity_to_int(sc, func) != args)
+ return(false);
+
+ if ((pairs == 0) &&
+ ((symbols == args) || (symbols == 0)) &&
+ (args < GC_TRIGGER_SIZE))
+ {
+ bool safe_case;
+ safe_case = is_safe_closure(func);
+ set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_ALL_X : OP_CLOSURE_ALL_X));
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, make_permanent_integer(args));
+ set_opt_lambda(expr, func);
+
+ if ((!safe_case) &&
+ (symbols == args))
+ set_optimize_op(expr, hop + OP_CLOSURE_ALL_S);
+ return(false);
+ }
+ }
+
+ if ((is_closure_star(func)) &&
+ ((!has_simple_args(closure_body(func))) ||
+ (closure_star_arity_to_int(sc, func) < args) ||
+ (arglist_has_keyword(cdr(expr)))))
+ return(false);
+
+ if (args < GC_TRIGGER_SIZE)
+ {
+ if (((func_is_closure) ||
+ (is_closure_star(func))) &&
+ (!arglist_has_rest(sc, closure_args(func))) &&
+ (pairs == (quotes + all_x_count(expr))))
+ {
+ set_unsafely_optimized(expr);
+ if (func_is_closure)
+ set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_ALL_X : OP_CLOSURE_ALL_X));
+ else set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ annotate_args(sc, cdr(expr), e);
+ set_arglist_length(expr, make_permanent_integer(args));
+ set_opt_lambda(expr, func);
+ return(false);
+ }
+ }
+ return(is_optimized(expr));
+}
+
+
+static bool optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, int hop, s7_pointer e)
+{
+ opcode_t op;
+ s7_pointer p;
+
+ if (!is_pair(cdr(expr))) /* cddr(expr) might be null if, for example, (begin (let ...)) */
+ return(false);
+
+ op = (opcode_t)syntax_opcode(func);
+ sc->w = e;
+ switch (op)
+ {
+ case OP_QUOTE:
+ case OP_MACROEXPAND:
+ return(false);
+
+ case OP_LET:
+ case OP_LET_STAR:
+ if (is_symbol(cadr(expr)))
+ e = collect_collisions(sc, caddr(expr), cons(sc, add_sym_to_list(sc, cadr(expr)), e));
+ else e = collect_collisions(sc, cadr(expr), e);
+ break;
+
+ case OP_LETREC:
+ case OP_LETREC_STAR:
+ e = collect_collisions(sc, cadr(expr), e);
+ break;
+
+ case OP_DEFINE_MACRO:
+ case OP_DEFINE_MACRO_STAR:
+ case OP_DEFINE_BACRO:
+ case OP_DEFINE_BACRO_STAR:
+ case OP_DEFINE_CONSTANT:
+ case OP_DEFINE_EXPANSION:
+ case OP_DEFINE:
+ case OP_DEFINE_STAR:
+ if (is_pair(cadr(expr)))
+ {
+ s7_pointer name_args;
+ name_args = cadr(expr);
+ if (is_symbol(car(name_args)))
+ e = cons(sc, add_sym_to_list(sc, car(name_args)), e);
+ if (is_symbol(cdr(name_args)))
+ e = cons(sc, add_sym_to_list(sc, cdr(name_args)), e);
+ else e = collect_collisions_star(sc, cdr(name_args), e);
+ /* fprintf(stderr, "%s -> e: %s\n", DISPLAY(expr), DISPLAY(e)); */
+ }
+ break;
+
+ case OP_LAMBDA:
+ case OP_LAMBDA_STAR:
+ if (is_symbol(cadr(expr))) /* (lambda args ...) */
+ e = cons(sc, add_sym_to_list(sc, cadr(expr)), e);
+ else e = collect_collisions_star(sc, cadr(expr), e);
+ break;
+
+ case OP_SET:
+ if (is_symbol(cadr(expr)))
+ e = cons(sc, add_sym_to_list(sc, cadr(expr)), e);
+ break;
+
+ case OP_DO:
+ e = collect_collisions(sc, cadr(expr), e);
+ break;
+
+ case OP_WITH_LET:
+ if (sc->safety != 0)
+ hop = 0;
+ e = sc->NIL;
+ /* we can't trust anything here, so hop ought to be off. For example,
+ * (define (hi)
+ * (let ((e (sublet (curlet)
+ * (cons 'abs (lambda (a) (- a 1))))))
+ * (with-let e (abs -1))))
+ * returns 1 if hop is 1, but -2 outside the function body.
+ */
+ break;
+
+ default:
+ break;
+ }
+ if (is_pair(e)) sc->w = e;
+ /* fprintf(stderr, "%s -> e: %s\n", DISPLAY(expr), DISPLAY(e)); */
+
+ for (p = cdr(expr); is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) && (!is_checked(car(p)))) /* ((typeflag & (0xff | T_CHECKED)) == T_PAIR) is not faster */
+ optimize_expression(sc, car(p), hop, e);
+
+ if ((hop == 1) &&
+ (symbol_id(car(expr)) == 0))
+ {
+ if ((op == OP_IF) || (op == OP_OR) || (op == OP_AND))
+ {
+ bool happy = true;
+ for (p = cdr(expr); (happy) && (is_pair(p)); p = cdr(p))
+ happy = is_all_x_safe(sc, car(p));
+
+ if ((happy) &&
+ (is_null(p))) /* catch the syntax error later: (or #f . 2) etc */
+ {
+ int args, symbols = 0, pairs = 0, rest = 0;
+ s7_pointer sym = NULL;
+ bool c_s_is_ok = true;
+
+ for (args = 0, p = cdr(expr); is_pair(p); p = cdr(p), args++)
+ {
+ if (is_symbol(car(p)))
+ symbols++;
+ else
+ {
+ if (!is_pair(car(p)))
+ rest++;
+ else
+ {
+ pairs++;
+ if ((c_s_is_ok) &&
+ ((!is_h_safe_c_s(car(p))) ||
+ ((sym) && (sym != cadar(p)))))
+ c_s_is_ok = false;
+ else sym = cadar(p);
+ }
+ }
+ }
+
+ if ((op == OP_IF) &&
+ ((args < 2) || (args > 3))) /* syntax error */
+ return(false);
+
+ set_safe_optimize_op(expr, hop + OP_SAFE_C_C);
+ if (pairs == 0)
+ {
+ if (op == OP_OR)
+ set_c_function(expr, or_direct);
+ else
+ {
+ if (op == OP_AND)
+ set_c_function(expr, and_direct);
+ else set_c_function(expr, if_direct);
+ }
+ return(true);
+ }
+
+ if ((pairs == args) &&
+ (c_s_is_ok))
+ {
+ if (op == OP_OR)
+ set_c_function(expr, or_s_direct);
+ else
+ {
+ if (op == OP_AND)
+ set_c_function(expr, and_s_direct);
+ else set_c_function(expr, if_s_direct);
+ }
+ return(true);
+ }
+
+ for (p = cdr(expr); is_pair(p); p = cdr(p))
+ set_c_call(p, all_x_eval(sc, car(p), e, pair_symbol_is_safe));
+
+ if (op == OP_OR)
+ {
+ if (s7_list_length(sc, cdr(expr)) == 2)
+ {
+ set_c_function(expr, or_all_x_2);
+ if ((c_call(cdr(expr)) == all_x_c_u) &&
+ (c_call(cddr(expr)) == all_x_c_u))
+ set_c_function(expr, or_all_x_2s);
+ }
+ else set_c_function(expr, or_all_x);
+ }
+ else
+ {
+ if (op == OP_AND)
+ {
+ if (s7_list_length(sc, cdr(expr)) == 2)
+ set_c_function(expr, and_all_x_2);
+ else set_c_function(expr, and_all_x);
+ }
+ else
+ {
+ s7_pointer test, b1, b2;
+ test = cdr(expr);
+ b1 = cdr(test);
+ b2 = cdr(b1);
+ if ((c_call(b1) == all_x_q) &&
+ (is_pair(b2)))
+ {
+ if (c_call(b2) == all_x_q)
+ set_c_function(expr, if_all_x_qq);
+ else set_c_function(expr, if_all_x_qa);
+ }
+ else
+ {
+ if ((is_pair(car(test))) &&
+ (caar(test) == sc->NOT))
+ {
+ set_c_call(test, all_x_eval(sc, cadar(test), e, pair_symbol_is_safe));
+ if (is_null(b2))
+ set_c_function(expr, if_all_not_x1);
+ else set_c_function(expr, if_all_not_x2);
+ }
+ else
+ {
+ if (is_null(b2))
+ set_c_function(expr, if_all_x1);
+ else set_c_function(expr, if_all_x2);
+ }
+ }
+ }
+ }
+ return(true);
+ }
+ /* else we could check other if cases here (test is often all_x_safe)
+ */
+ }
+ }
+ return(false);
+}
+
+
+static bool optimize_expression(s7_scheme *sc, s7_pointer expr, int hop, s7_pointer e)
+{
+ s7_pointer car_expr;
+ /* fprintf(stderr, "opt %d %s %s\n", hop, DISPLAY(expr), DISPLAY(e)); */
+ /* if (is_checked(expr)) return(true); */
+
+ set_checked(expr);
+ car_expr = car(expr);
+
+ if (is_symbol(car_expr))
+ {
+ s7_pointer func;
+ if (is_syntactic(car_expr))
+ return(optimize_syntax(sc, expr, slot_value(global_slot(car_expr)), hop, e));
+
+ if (car_expr == sc->QUOTE)
+ return(false);
+
+ func = find_uncomplicated_symbol(sc, car_expr, e);
+ if (is_slot(func))
+ {
+ func = slot_value(func);
+ if (is_syntactic(func))
+ return(optimize_syntax(sc, expr, func, hop, e));
+
+ /* we miss implicit indexing here because at this time, the data are not set */
+ if ((is_procedure(func)) ||
+ (is_c_function(func)) ||
+ (is_safe_procedure(func))) /* built-in applicable objects like vectors */
+ {
+ int pairs = 0, symbols = 0, args = 0, bad_pairs = 0, quotes = 0, orig_hop;
+ s7_pointer p;
+
+ orig_hop = hop;
+ if ((is_any_closure(func)) || /* can't depend on opt1 here because it might not be global, or might be redefined locally */
+ ((!is_global(car_expr)) &&
+ ((!is_slot(global_slot(car_expr))) ||
+ (slot_value(global_slot(car_expr)) != func))))
+ {
+ /* (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a)) (f1 12))
+ * (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a 1)) (f1 12))
+ * and similar define* cases
+ */
+
+ hop = 0;
+ /* this is very tricky! See s7test for some cases. Basically, we need to protect a recursive call
+ * of the current function being optimized from being confused with some previous definition
+ * of the same name. But method lists have global names so the global bit is off even though the
+ * thing is actually a safe global. But no closure can be considered safe in the hop sense --
+ * even a global function might be redefined at anuy time, and previous uses of it in other functions
+ * need to reflect its new value.
+ * So, closures are always checked, but built-in functions are used as if never redefined until that redefinition.
+ * costs: index 6/1380, t502: 2/12900, bench: 43/4134, snd-test: 22/37200
+ * Syntax handling is already impure in s7, so the special handling of built-in functions doesn't
+ * offend me much. Consider each a sort of reader macro until someone redefines it -- previous
+ * uses may not be affected because they might have been optimized away -- the result depends on the
+ * current optimizer.
+ * Another case (from K Matheussen):
+ * (define (call-func func arg1 arg2) (define (call) (func arg1 arg2)) (call)) (call-func + 1 2.5) (call-func - 5 2)
+ * when we get here originally "func" is +, hop=1, but just checking for !is_global(car_expr) is
+ * not good enough -- if we load mockery.scm, nothing is global!
+ */
+ }
+ /* but if we make a recursive call on a func, we've obviously already looked up that function, and
+ * if it has not been shadowed, then we don't need to check it -- so the hop bit should be on
+ * for that one case.
+ */
+
+ for (p = cdr(expr); is_pair(p); p = cdr(p), args++) /* check the args (the calling expression) */
+ {
+ s7_pointer car_p;
+ car_p = car(p);
+ if (is_symbol(car_p))
+ symbols++;
+ else
+ {
+ if (is_pair(car_p))
+ {
+ pairs++;
+ if (!is_checked(car_p))
+ {
+ if (!optimize_expression(sc, car_p, orig_hop, e))
+ {
+ bad_pairs++;
+ if ((car(car_p) == sc->QUOTE) &&
+ (is_pair(cdr(car_p))) &&
+ (is_null(cddr(car_p))))
+ quotes++;
+ }
+ }
+ else
+ {
+ if ((!is_optimized(car_p)) ||
+ (is_unsafe(car_p)))
+ {
+ bad_pairs++;
+ if ((car(car_p) == sc->QUOTE) &&
+ (is_pair(cdr(car_p))) &&
+ (is_null(cddr(car_p))))
+ quotes++;
+ }
+ }
+ }
+ }
+ }
+ if (is_null(p)) /* if not null, dotted list of args? */
+ {
+ switch (args)
+ {
+ case 0: return(optimize_thunk(sc, expr, func, hop));
+ case 1: return(optimize_func_one_arg(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e));
+ case 2: return(optimize_func_two_args(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e));
+ case 3: return(optimize_func_three_args(sc, expr, func, hop, pairs, symbols, quotes, bad_pairs, e));
+ default: return(optimize_func_many_args(sc, expr, func, hop, args, pairs, symbols, quotes, bad_pairs, e));
+ }
+ }
+ return(false);
+ }
+ }
+ else
+ {
+ if ((sc->undefined_identifier_warnings) &&
+ (func == sc->UNDEFINED) && /* car_expr is not in e or global */
+ (symbol_tag(car_expr) == 0)) /* and we haven't looked it up earlier */
+ {
+ s7_pointer p;
+ p = sc->input_port;
+ if ((is_input_port(p)) &&
+ (port_file(p) != stdin) &&
+ (!port_is_closed(p)) &&
+ (port_filename(p)))
+ s7_warn(sc, 1024, "%s might be undefined (%s %u)\n", DISPLAY(car_expr), port_filename(p), port_line_number(p));
+ else s7_warn(sc, 1024, "; %s might be undefined\n", DISPLAY(car_expr));
+ symbol_tag(car_expr) = 1; /* one warning is enough */
+ }
+ /* we need local definitions and func args in e? also check is_symbol case below
+ */
+ }
+
+ /* car_expr is a symbol but it's not a known procedure or a "safe" case = vector etc */
+ {
+ /* else maybe it's something like a let variable binding: (sqrtfreq (sqrt frequency)) */
+ s7_pointer p;
+ int len = 0, pairs = 0, symbols = 0, quotes = 0;
+
+ for (p = cdr(expr); is_pair(p); p = cdr(p), len++)
+ {
+ s7_pointer car_p;
+ car_p = car(p);
+ if (is_pair(car_p))
+ {
+ pairs++;
+ if ((hop != 0) && (car(car_p) == sc->QUOTE))
+ quotes++;
+ if (!is_checked(car_p))
+ optimize_expression(sc, car_p, hop, e);
+ }
+ else
+ {
+ if (is_symbol(car_p))
+ symbols++;
+ }
+ }
+
+ if ((is_null(p)) && /* (+ 1 . 2) */
+ (!is_optimized(expr)))
+ {
+ /* len=0 case is almost entirely arglists */
+ set_opt_con1(expr, sc->GC_NIL);
+ if (pairs == 0)
+ {
+ if (len == 0)
+ {
+ /* hoping to catch object application here, as in readers in Snd */
+ set_unsafe_optimize_op(expr, OP_UNKNOWN);
+ return(false);
+ }
+
+ if (len == 1)
+ {
+ if (car_expr != sc->QUOTE) /* !! quote can be redefined locally, unsetting the T_SYNTACTIC flag -- can this happen elsewhere? */
+ {
+ set_unsafe_optimize_op(expr, OP_UNKNOWN_G);
+ /* hooboy -- we get here in let bindings...
+ * to save access to the caller, we'd need to pass it as an arg to optimize_expression
+ */
+ }
+ return(false);
+ }
+
+ if (len == 2)
+ {
+ set_unsafely_optimized(expr);
+ if (symbols == 2)
+ set_optimize_op(expr, OP_UNKNOWN_GG);
+ else
+ {
+ if (symbols == 0)
+ set_optimize_op(expr, OP_UNKNOWN_GG);
+ else
+ {
+ if (is_symbol(cadr(expr)))
+ set_optimize_op(expr, OP_UNKNOWN_GG);
+ else set_optimize_op(expr, OP_UNKNOWN_GG);
+ }
+ }
+ return(false);
+ }
+
+ if ((len >= 3) &&
+ (len == symbols))
+ {
+ set_unsafe_optimize_op(expr, OP_UNKNOWN_ALL_S);
+ set_arglist_length(expr, make_permanent_integer(len));
+ return(false);
+ }
+ }
+ else /* pairs != 0 */
+ {
+ s7_pointer arg1;
+ arg1 = cadr(expr);
+ if (pairs == 1)
+ {
+ if (len == 1)
+ {
+ if (quotes == 1)
+ {
+ set_unsafe_optimize_op(expr, OP_UNKNOWN_A);
+ return(false);
+ }
+
+ if (is_all_x_safe(sc, arg1))
+ {
+ set_arglist_length(expr, small_int(1));
+ set_unsafe_optimize_op(expr, OP_UNKNOWN_A);
+ return(false);
+ }
+ }
+ else
+ {
+ if (len == 2)
+ {
+ if ((is_all_x_safe(sc, arg1)) &&
+ (is_all_x_safe(sc, caddr(expr))))
+ {
+ set_arglist_length(expr, small_int(2));
+ set_unsafe_optimize_op(expr, OP_UNKNOWN_AA);
+ return(false);
+ }
+ }
+ }
+ }
+
+ if ((len == 2) &&
+ (is_all_x_safe(sc, arg1)) &&
+ (is_all_x_safe(sc, caddr(expr))))
+ {
+ set_arglist_length(expr, small_int(2));
+ set_unsafe_optimize_op(expr, OP_UNKNOWN_AA);
+ return(false);
+ }
+
+ if ((pairs == (quotes + all_x_count(expr))) &&
+ (len < GC_TRIGGER_SIZE))
+ {
+ set_unsafe_optimize_op(expr, (len == 1) ? OP_UNKNOWN_A : OP_UNKNOWN_ALL_X);
+ set_arglist_length(expr, make_permanent_integer(len));
+ return(false);
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ /* car(expr) is not a symbol, but there might be interesting stuff here */
+ /* (define (hi a) (case 1 ((1) (if (> a 2) a 2)))) */
+ s7_pointer p;
+ for (p = expr; is_pair(p); p = cdr(p))
+ {
+ if ((is_pair(car(p))) && (!is_checked(car(p))))
+ optimize_expression(sc, car(p), hop, e);
+ }
+ }
+ return(false);
+}
+
+
+static s7_pointer optimize(s7_scheme *sc, s7_pointer code, int hop, s7_pointer e)
+{
+ s7_pointer x;
+ if (sc->safety > 1) return(NULL);
+ /* fprintf(stderr, "optimize %s %d %s\n", DISPLAY_80(code), hop, DISPLAY(e)); */
+ for (x = code; (is_pair(x)) && (!is_checked(x)); x = cdr(x))
+ {
+ set_checked(x);
+ if ((is_pair(car(x))) && (!is_checked(car(x))))
+ optimize_expression(sc, car(x), hop, e);
+ }
+ if ((!is_null(x)) &&
+ (!is_pair(x)))
+ eval_error(sc, "stray dot in function body: ~S", code);
+ return(NULL);
+}
+
+
+#if WITH_GCC
+ #define indirect_c_function_is_ok(Sc, X) ({s7_pointer _X_; _X_ = X; (((optimize_op(_X_) & 0x1) != 0) || (c_function_is_ok(Sc, _X_)));})
+ #define indirect_cq_function_is_ok(Sc, X) ({s7_pointer _X_; _X_ = X; ((!is_optimized(_X_)) || ((optimize_op(_X_) & 0x1) != 0) || (c_function_is_ok(Sc, _X_)));})
+#else
+ #define indirect_c_function_is_ok(Sc, X) (((optimize_op(X) & 0x1) != 0) || (c_function_is_ok(Sc, X)))
+ #define indirect_cq_function_is_ok(Sc, X) ((!is_optimized(X)) || ((optimize_op(X) & 0x1) != 0) || (c_function_is_ok(Sc, X)))
+#endif
+
+static bool body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool at_end);
+
+static bool form_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer x, bool at_end)
+{
+ /* called only from body_is_safe and itself */
+ s7_pointer expr;
+
+ sc->cycle_counter++;
+ if ((!is_proper_list(sc, x)) ||
+ (sc->cycle_counter > 5000))
+ return(false);
+
+ expr = car(x);
+ if (is_syntactic_symbol(expr))
+ {
+ switch (symbol_syntax_op(expr))
+ {
+ case OP_OR:
+ case OP_AND:
+ case OP_BEGIN:
+ case OP_WITH_BAFFLE:
+ if (!body_is_safe(sc, func, cdr(x), at_end))
+ return(false);
+ break;
+
+ case OP_MACROEXPAND:
+ return(false);
+
+ case OP_QUOTE:
+ break;
+
+ /* in the name binders, we first have to check that "func" actually is the same thing as the caller's func */
+ case OP_LET:
+ case OP_LET_STAR:
+ if (is_symbol(cadr(x)))
+ return(false);
+
+ case OP_LETREC:
+ case OP_LETREC_STAR:
+ if (is_pair(cadr(x)))
+ {
+ s7_pointer vars;
+ for (vars = cadr(x); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer let_var;
+
+ let_var = car(vars);
+ if ((!is_pair(let_var)) ||
+ (!is_pair(cdr(let_var))))
+ return(false);
+
+ if (car(let_var) == func)
+ return(false); /* it's shadowed */
+
+ if ((is_pair(cadr(let_var))) &&
+ (!form_is_safe(sc, func, cadr(let_var), false)))
+ return(false);
+ }
+ }
+ if (!body_is_safe(sc, func, cddr(x), at_end))
+ return(false);
+ break;
+
+ case OP_IF:
+ if (!is_pair(cdr(x))) return(false); /* (if) ! */
+ if (!((!is_pair(cadr(x))) || (form_is_safe(sc, func, cadr(x), false)))) return(false);
+ if (!((!is_pair(caddr(x))) || (form_is_safe(sc, func, caddr(x), at_end)))) return(false);
+ if (!((!is_pair(cdddr(x))) || (!is_pair(cadddr(x))) || (form_is_safe(sc, func, cadddr(x), at_end)))) return(false);
+ break;
+
+ case OP_WHEN:
+ case OP_UNLESS:
+ if (!is_pair(cdr(x))) return(false); /* (when) */
+ if (!((!is_pair(cadr(x))) || (form_is_safe(sc, func, cadr(x), false)))) return(false);
+ if (!body_is_safe(sc, func, cddr(x), at_end)) return(false);
+ break;
+
+ case OP_COND:
+ {
+ s7_pointer p;
+ for (p = cdr(x); is_pair(p); p = cdr(p))
+ {
+ s7_pointer ex;
+ ex = car(p);
+ if (is_pair(ex)) /* ?? */
+ {
+ if ((is_pair(car(ex))) && (!form_is_safe(sc, func, car(ex), false)))
+ return(false);
+ if ((is_pair(cdr(ex))) && (!body_is_safe(sc, func, cdr(ex), at_end)))
+ return(false);
+ }
+ }
+ if (is_not_null(p))
+ return(false);
+ }
+ break;
+
+ case OP_CASE:
+ {
+ s7_pointer p;
+ if ((is_pair(cadr(x))) && (!form_is_safe(sc, func, cadr(x), false))) return(false);
+ for (p = cddr(x); is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) && (!body_is_safe(sc, func, cdar(p), at_end)))
+ return(false);
+ }
+ break;
+
+ case OP_DO:
+ /* (do (...) (...) ...) */
+ if (!is_pair(cddr(x)))
+ return(false);
+ if (!body_is_safe(sc, func, cdddr(x), false))
+ return(false);
+ if (is_pair(cadr(x)))
+ {
+ s7_pointer vars;
+ for (vars = cadr(x); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer do_var;
+ do_var = car(vars);
+ if (!is_pair(do_var))
+ return(false);
+
+ if ((car(do_var) == func) ||
+ (!is_pair(cdr(do_var)))) /* (do ((a . 1) (b . 2)) ...) */
+ return(false);
+
+ if ((is_pair(cadr(do_var))) &&
+ (!form_is_safe(sc, func, cadr(do_var), false)))
+ return(false);
+
+ if ((is_pair(cddr(do_var))) &&
+ (is_pair(caddr(do_var))) &&
+ (!form_is_safe(sc, func, caddr(do_var), false)))
+ return(false);
+ }
+ }
+ if ((is_pair(caddr(x))) &&
+ (!body_is_safe(sc, func, caddr(x), at_end)))
+ return(false);
+ break;
+
+ case OP_SET:
+ /* if we set func, we have to make sure we abandon the tail call scan:
+ * (let () (define (hi a) (let ((v (vector 1 2 3))) (set! hi v) (hi a))) (hi 1))
+ */
+ if (!is_pair(cdr(x))) return(false); /* (set!) ! */
+ if (cadr(x) == func)
+ return(false);
+
+ /* car(x) is set!, cadr(x) is settee or obj, caddr(x) is val */
+ if (is_symbol(caddr(x)))
+ return(false); /* ?? because it might be a local function that has captured local state? */
+
+ if (((!is_pair(caddr(x))) || (form_is_safe(sc, func, caddr(x), false))) &&
+ ((is_symbol(cadr(x))) ||
+ ((is_pair(cadr(x))) && (form_is_safe(sc, func, cadr(x), false)))))
+ return(true);
+ return(false);
+
+ case OP_WITH_LET:
+ if (is_pair(cadr(x)))
+ return(false);
+
+ if (!body_is_safe(sc, sc->F, cddr(x), at_end))
+ return(false);
+ break;
+
+ /* op_define and friends are not safe: (define (a) (define b 3)...) tries to put b in the current env,
+ * but in a safe func, that's a constant. See s7test L 1865 for an example.
+ */
+ default:
+ /* try to catch weird cases like:
+ * (let () (define (hi1 a) (define (hi1 b) (+ b 1)) (hi1 a)) (hi1 1))
+ * (let () (define (hi1 a) (define (ho1 b) b) (define (hi1 b) (+ b 1)) (hi1 a)) (hi1 1))
+ */
+ return(false);
+ }
+ }
+ else /* car(x) is not syntactic ?? */
+ {
+ if ((!is_optimized(x)) ||
+ (is_unsafe(x)))
+ {
+ if (expr == func) /* try to catch tail call */
+ {
+ s7_pointer p;
+
+ for (p = cdr(x); is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (((!is_optimized(car(p))) && (caar(p) != sc->QUOTE)) ||
+ (is_unsafe(car(p))) ||
+ (caar(p) == func))) /* func called as arg, so not tail call */
+ return(false);
+
+ if ((at_end) && (is_null(p))) /* tail call, so safe */
+ return(true);
+ return(false);
+ }
+
+ if (is_symbol(expr))
+ {
+ if (is_global(expr))
+ {
+ s7_pointer f;
+ f = find_symbol_checked(sc, expr);
+ if (((is_c_function(f)) &&
+ ((is_safe_procedure(f)) ||
+ ((is_possibly_safe(f)) &&
+ (is_pair(cdr(x))) &&
+ (is_pair(cddr(x))) &&
+ (unsafe_is_safe(sc, f, cadr(x), caddr(x), (is_pair(cdddr(x))) ? cadddr(x) : NULL, sc->NIL))))) ||
+ ((is_closure(f)) &&
+ (is_safe_closure(f))))
+ {
+ s7_pointer p;
+ for (p = cdr(x); is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ ((!is_optimized(car(p))) ||
+ (is_unsafe(car(p)))))
+ {
+ if ((caar(p) != func) ||
+ (!is_null(cdr(p))))
+ return(false);
+ }
+ if (!is_null(p))
+ return(false);
+ }
+ }
+ else
+ {
+ s7_pointer f;
+ f = find_symbol(sc, expr);
+ if (is_slot(f))
+ {
+ if ((is_syntax(slot_value(f))) || (is_any_macro(slot_value(f))))
+ return(false);
+ if ((is_closure(slot_value(f))) &&
+ (is_safe_closure(slot_value(f))))
+ {
+ s7_pointer p;
+ /* the calling function is safe, but what about its arguments? */
+ for (p = cdr(x); is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (caar(p) == func)) /* this would be a recursive call on func that is not in tail-call position */
+ return(false);
+ return(true);
+ }
+ }
+ }
+ }
+ return(false);
+ }
+ }
+ return(true);
+}
+
+
+static bool body_is_safe(s7_scheme *sc, s7_pointer func, s7_pointer body, bool at_end)
+{
+ /* called in optimize_lambda and above */
+ s7_pointer p;
+ for (p = body; is_pair(p); p = cdr(p))
+ if ((is_pair(car(p))) &&
+ (!form_is_safe(sc, func, car(p), (at_end) && (is_null(cdr(p))))))
+ return(false);
+ return(is_null(p));
+}
+
+
+
+/* ---------------------------------------- error checks ---------------------------------------- */
+
+#define goto_START 0
+#define goto_BEGIN1 1
+#define fall_through 2
+#define goto_DO_END_CLAUSES 3
+#define goto_SAFE_DO_END_CLAUSES 4
+#define goto_OPT_EVAL 5
+#define goto_START_WITHOUT_POP_STACK 6
+#define goto_EVAL 7
+#define goto_APPLY 8
+#define goto_EVAL_ARGS 9
+#define goto_DO_UNCHECKED 10
+
+static s7_pointer check_lambda_args(s7_scheme *sc, s7_pointer args, int *arity)
+{
+ s7_pointer x;
+ int i;
+
+ if ((!is_pair(args)) && (!is_null(args)))
+ {
+ if (s7_is_constant(args)) /* (lambda :a ...) */
+ eval_error(sc, "lambda parameter '~S is a constant", args); /* not ~A here, (lambda #\null do) for example */
+
+ /* we currently accept (lambda i i . i) (lambda quote i) (lambda : : . #()) (lambda : 1 . "")
+ * at this level, but when the lambda form is evaluated, it will trigger an error.
+ */
+ if (is_symbol(args))
+ set_local(args);
+
+ if (arity) (*arity) = -1;
+ return(sc->F);
+ }
+
+ for (i = 0, x = args; is_pair(x); i++, x = cdr(x))
+ {
+ s7_pointer car_x;
+ car_x = car(x);
+ if (s7_is_constant(car_x)) /* (lambda (pi) pi), constant here means not a symbol */
+ {
+ if (is_pair(car_x)) /* (lambda ((:hi . "hi") . "hi") 1) */
+ eval_error(sc, "lambda parameter '~S is a pair (perhaps you want define* or lambda*?)", car_x);
+ eval_error(sc, "lambda parameter '~S is a constant", car_x);
+ }
+ if (symbol_is_in_arg_list(car_x, cdr(x))) /* (lambda (a a) ...) or (lambda (a . a) ...) */
+ eval_error(sc, "lambda parameter '~S is used twice in the parameter list", car_x);
+ set_local(car_x);
+ }
+ if (is_not_null(x))
+ {
+ if (s7_is_constant(x)) /* (lambda (a . 0.0) a) or (lambda (a . :b) a) */
+ eval_error(sc, "lambda :rest parameter '~S is a constant", x);
+ i = -i - 1;
+ }
+
+ if (arity) (*arity) = i;
+ return(sc->F);
+}
+
+
+static s7_pointer check_lambda_star_args(s7_scheme *sc, s7_pointer args, int *arity)
+{
+ s7_pointer top, v, w;
+ int i;
+
+ if (!s7_is_list(sc, args))
+ {
+ if (s7_is_constant(args)) /* (lambda* :a ...) */
+ eval_error(sc, "lambda* parameter '~S is a constant", args);
+ if (is_symbol(args))
+ set_local(args);
+ if (arity) (*arity) = -1;
+ return(args);
+ }
+
+ top = args;
+ v = args;
+ for (i = 0, w = args; is_pair(w); i++, v = w, w = cdr(w))
+ {
+ s7_pointer car_w;
+ car_w = car(w);
+ if (is_pair(car_w))
+ {
+ if (s7_is_constant(car(car_w))) /* (lambda* ((:a 1)) ...) */
+ eval_error(sc, "lambda* parameter '~A is a constant", car(car_w));
+ if (symbol_is_in_arg_list(caar(w), cdr(w))) /* (lambda* ((a 1) a) ...) */
+ eval_error(sc, "lambda* parameter '~A is used twice in the argument list", car(car_w));
+
+ if (!is_pair(cdr(car_w))) /* (lambda* ((a . 0.0)) a) */
+ {
+ if (is_null(cdr(car_w))) /* (lambda* ((a)) ...) */
+ eval_error(sc, "lambda* parameter default value missing? '~A", car_w);
+ eval_error(sc, "lambda* parameter is a dotted pair? '~A", car_w);
+ }
+ else
+ {
+ if ((is_pair(cadr(car_w))) && /* (lambda* ((a (quote . -1))) ...) */
+ (s7_list_length(sc, cadr(car_w)) < 0))
+ eval_error(sc, "lambda* parameter default value is improper? ~A", car_w);
+ }
+
+ if (is_not_null(cddr(car_w))) /* (lambda* ((a 0.0 'hi)) a) */
+ eval_error(sc, "lambda* parameter has multiple default values? '~A", car_w);
+
+ set_local(car(car_w));
+ }
+ else
+ {
+ if (car_w != sc->KEY_REST)
+ {
+ if (s7_is_constant(car_w))
+ {
+ if (car_w == sc->KEY_ALLOW_OTHER_KEYS)
+ {
+ if (is_not_null(cdr(w))) /* (lambda* (:allow-other-keys x) x) */
+ eval_error(sc, ":allow-other-keys should be the last parameter: ~A", args);
+ if (w == top)
+ eval_error(sc, ":allow-other-keys can't be the only parameter: ~A", args);
+ set_allow_other_keys(top);
+ cdr(v) = sc->NIL;
+ }
+ else /* (lambda* (pi) ...) */
+ eval_error(sc, "lambda* parameter '~A is a constant", car_w);
+ }
+ if (symbol_is_in_arg_list(car_w, cdr(w))) /* (lambda* (a a) ...) or (lambda* (a . a) ...) */
+ eval_error(sc, "lambda* parameter '~A is used twice in the argument list", car_w);
+
+ if (!is_keyword(car_w)) set_local(car_w);
+ }
+ else
+ {
+ if (!is_pair(cdr(w))) /* (lambda* (:rest) ...) */
+ eval_error(sc, "lambda* :rest parameter missing? ~A", w);
+ if (!is_symbol(cadr(w))) /* (lambda* (:rest (a 1)) ...) */
+ {
+ if (!is_pair(cadr(w))) /* (lambda* (:rest 1) ...) */
+ eval_error(sc, "lambda* :rest parameter is not a symbol? ~A", w);
+ eval_error(sc, "lambda* :rest parameter can't have a default value. ~A", w);
+ }
+ else
+ {
+ if (is_immutable_symbol(cadr(w)))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), w)));
+ }
+ set_local(cadr(w));
+ }
+ }
+ }
+ if (is_not_null(w))
+ {
+ if (s7_is_constant(w)) /* (lambda* (a . 0.0) a) or (lambda* (a . :b) a) */
+ eval_error(sc, "lambda* :rest parameter '~A is a constant", w);
+ if (is_symbol(w))
+ set_local(w);
+ i = -1;
+ }
+ if (arity) (*arity) = i;
+ return(top);
+}
+
+
+static void check_lambda(s7_scheme *sc)
+{
+ /* code is a lambda form minus the "lambda": ((a b) (+ a b)) */
+ /* this includes unevaluated symbols (direct symbol table refs) in macro arg list */
+ s7_pointer code, body;
+
+ code = sc->code;
+ if (!is_pair(code)) /* (lambda) or (lambda . 1) */
+ eval_error_no_return(sc, sc->SYNTAX_ERROR, "lambda: no args? ~A", sc->cur_code);
+
+ body = cdr(code);
+ if (!is_pair(body)) /* (lambda #f) */
+ eval_error_no_return(sc, sc->SYNTAX_ERROR, "lambda: no body? ~A", code);
+
+ /* in many cases, this is a no-op -- we already checked at define */
+ check_lambda_args(sc, car(code), NULL);
+ clear_syms_in_list(sc);
+
+ /* look for (define f (let (...) (lambda ...))) and treat as equivalent to (define (f ...)...)
+ * It's actually safe to ignore main_stack_op, but s7test has some dubious tests that this
+ * check gets around -- need to decide about these cases!
+ */
+ if ((sc->safety != 0) ||
+ (main_stack_op(sc) != OP_DEFINE1))
+ optimize(sc, body, 0, sc->NIL);
+ else optimize_lambda(sc, true, sc->GC_NIL, car(code), body); /* why was lambda the func? */
+
+ if ((is_overlaid(code)) &&
+ (has_opt_back(code)))
+ pair_set_syntax_symbol(code, sc->LAMBDA_UNCHECKED);
+}
+
+static void check_lambda_star(s7_scheme *sc)
+{
+ if ((!is_pair(sc->code)) ||
+ (!is_pair(cdr(sc->code)))) /* (lambda*) or (lambda* #f) */
+ eval_error_no_return(sc, sc->SYNTAX_ERROR, "lambda*: no args or no body? ~A", sc->code);
+
+ car(sc->code) = check_lambda_star_args(sc, car(sc->code), NULL);
+ clear_syms_in_list(sc);
+
+ if ((sc->safety != 0) ||
+ (main_stack_op(sc) != OP_DEFINE1))
+ optimize(sc, cdr(sc->code), 0, sc->NIL);
+ else optimize_lambda(sc, false, sc->GC_NIL, car(sc->code), cdr(sc->code));
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->LAMBDA_STAR_UNCHECKED);
+}
+
+static s7_pointer check_when(s7_scheme *sc)
+{
+ if (!is_pair(sc->code)) /* (when) or (when . 1) */
+ eval_error(sc, "when has no expression or body: ~A", sc->code);
+ if (!is_pair(cdr(sc->code))) /* (when 1) or (when 1 . 1) */
+ eval_error(sc, "when has no body?: ~A", sc->code);
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->WHEN_UNCHECKED);
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->WHEN_S);
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_unless(s7_scheme *sc)
+{
+ if (!is_pair(sc->code)) /* (unless) or (unless . 1) */
+ eval_error(sc, "unless has no expression or body: ~A", sc->code);
+ if (!is_pair(cdr(sc->code))) /* (unless 1) or (unless 1 . 1) */
+ eval_error(sc, "unless has no body?: ~A", sc->code);
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->UNLESS_UNCHECKED);
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->UNLESS_S);
+ }
+ return(sc->code);
+}
+
+/* (apply unless (list values :key #f)) */
+
+
+static s7_pointer check_case(s7_scheme *sc)
+{
+ bool keys_simple = true, have_else = false, has_feed_to = false, keys_single = true, bodies_simple = true, bodies_simplest = true;
+ s7_pointer x;
+
+ if (!is_pair(sc->code)) /* (case) or (case . 1) */
+ eval_error(sc, "case has no selector: ~A", sc->code);
+ if (!is_pair(cdr(sc->code))) /* (case 1) or (case 1 . 1) */
+ eval_error(sc, "case has no clauses?: ~A", sc->code);
+ if (!is_pair(cadr(sc->code))) /* (case 1 1) */
+ eval_error(sc, "case clause is not a list? ~A", sc->code);
+
+ for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
+ {
+ s7_pointer y;
+ if ((!is_pair(x)) || /* (case 1 ((2) 1) . 1) */
+ (!is_pair(car(x))))
+ eval_error(sc, "case clause ~A messed up", x);
+ if (!is_pair(cdar(x))) /* (case 1 ((1))) */
+ eval_error(sc, "case clause result missing: ~A", car(x));
+
+ if ((bodies_simple) && (!is_null(cddar(x))))
+ {
+ bodies_simple = false;
+ bodies_simplest = false;
+ }
+ if (bodies_simplest)
+ {
+ if ((is_pair(cadar(x))) &&
+ (caadar(x) != sc->QUOTE))
+ {
+ if (is_pair(caar(x)))
+ bodies_simplest = false;
+ else
+ {
+ if ((caar(x) != sc->ELSE) && (caar(x) != sc->else_symbol) &&
+ ((!is_symbol(caar(x))) ||
+ (s7_symbol_value(sc, caar(x)) != sc->ELSE)))
+ bodies_simplest = false;
+ }
+ }
+ }
+ y = caar(x);
+ if (!is_pair(y))
+ {
+ if ((y != sc->ELSE) && (y != sc->else_symbol) && /* (case 1 (2 1)) */
+ ((!is_symbol(y)) ||
+ (s7_symbol_value(sc, y) != sc->ELSE))) /* "proper list" below because: (case 1 (() 2) ... */
+ eval_error(sc, "case clause key list ~A is not a proper list or 'else'", y);
+ if (is_not_null(cdr(x))) /* (case 1 (else 1) ((2) 1)) */
+ eval_error(sc, "case 'else' clause, ~A, is not the last clause", x);
+ have_else = true;
+ }
+ else
+ {
+ /* what about (case 1 ((1) #t) ((1) #f)) [this is ok by guile]
+ * (case 1 ((1) #t) ())
+ * (case 1 ((2 2 2) 1)): guile says #<unspecified>
+ * but we do support: (let ((otherwise else)) (case 0 ((1) 2) (otherwise 3))) -> 3!
+ * is that consistent?
+ * (let ((else #f)) (case 0 ((1) 2) (else 3))) -> 3
+ * (case 0 ((1) 2) (else (let ((else 3)) else))) -> 3
+ * the selector (sc->value) is evaluated, but the search key is not
+ * (case '2 ((2) 3) (else 1)) -> 3
+ * (case '2 (('2) 3) (else 1)) -> 1
+ * another approach: make else a value, not a symbol, like #<unspecified>, evaluates to itself
+ * or set it to be immutable, but I guess I'll say "use #_else" for now.
+ */
+ if (!is_simple(car(y)))
+ keys_simple = false;
+ if (!is_null(cdr(y)))
+ keys_single = false;
+
+ for (y = cdr(y); is_not_null(y); y = cdr(y))
+ {
+ if (!is_pair(y)) /* (case () ((1 . 2) . hi) . hi) */
+ eval_error(sc, "case key list is improper? ~A", x);
+ if (!is_simple(car(y)))
+ keys_simple = false;
+ }
+ }
+ y = car(x);
+ if ((cadr(y) == sc->FEED_TO) &&
+ (s7_symbol_value(sc, sc->FEED_TO) == sc->UNDEFINED))
+ {
+ has_feed_to = true;
+ if (!is_pair(cddr(y))) /* (case 1 (else =>)) */
+ eval_error(sc, "case: '=>' target missing? ~A", y);
+ if (is_pair(cdddr(y))) /* (case 1 (else => + - *)) */
+ eval_error(sc, "case: '=>' has too many targets: ~A", y);
+ }
+ }
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
+ {
+ set_opt_key(x, caar(x));
+ if (is_pair(opt_key(x))) set_opt_clause(x, cadar(x));
+ }
+ pair_set_syntax_symbol(sc->code, sc->CASE_UNCHECKED);
+
+ if ((!has_feed_to) &&
+ (keys_simple))
+ {
+ if (have_else) /* don't combine ifs ! */
+ {
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->CASE_SIMPLE);
+ }
+ else
+ {
+ if (keys_single)
+ {
+ if ((bodies_simple) &&
+ (is_symbol(car(sc->code))))
+ pair_set_syntax_symbol(sc->code, sc->CASE_SIMPLEST);
+ else
+ {
+ if ((is_optimized(car(sc->code))) &&
+ (optimize_op(car(sc->code)) == HOP_SAFE_C_SS))
+ pair_set_syntax_symbol(sc->code, sc->CASE_SIMPLEST_SS);
+ }
+ for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
+ set_opt_key(x, caaar(x));
+ }
+ else
+ {
+ if (bodies_simple)
+ {
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->CASE_SIMPLER_1);
+ else
+ {
+ if ((is_optimized(car(sc->code))) &&
+ (optimize_op(car(sc->code)) == HOP_SAFE_C_SS))
+ pair_set_syntax_symbol(sc->code, sc->CASE_SIMPLER_SS);
+ }
+ }
+ else
+ {
+ if (is_symbol(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->CASE_SIMPLER);
+ }
+ }
+ }
+ }
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_let_one_var(s7_scheme *sc, s7_pointer start)
+{
+ s7_pointer binding;
+
+ pair_set_syntax_symbol(sc->code, sc->LET_ONE);
+ binding = car(start);
+
+ if (is_pair(cadr(binding)))
+ {
+ if (is_h_optimized(cadr(binding)))
+ {
+ if (is_null(cddr(sc->code))) /* one statement body */
+ {
+ set_opt_sym2(cdr(sc->code), car(binding));
+ set_opt_pair2(sc->code, cadr(binding));
+ pair_set_syntax_symbol(sc->code, sc->LET_Z);
+
+ if ((is_h_safe_c_s(cadr(binding))) &&
+ (is_pair(cadr(sc->code)))) /* one body expr is a pair */
+ {
+ pair_set_syntax_symbol(sc->code, sc->LET_opSq_P);
+ set_opt_sym2(sc->code, cadr(cadr(binding)));
+
+ if ((!is_optimized(cadr(sc->code))) &&
+ (is_syntactic_symbol(caadr(sc->code))))
+ {
+ /* the is_optimized check here and in other parallel cases protects against cases like:
+ * (define (hi) (let ((e #f)) (let ((val (not e))) (if (boolean? val) val e)))) (hi)
+ * where the "(if...)" part is optimized as safe_c_s before we get here. If we simply
+ * pair_set_syntax_op(cadr(sc->code)) as below, the optimization bit is on, but the
+ * apparent optimize_op (op) is now safe_c_qq! So eval ejects it and it is handled by the
+ * explicit ("trailers") code.
+ */
+ pair_set_syntax_op(cadr(sc->code), symbol_syntax_op(caadr(sc->code)));
+ }
+ return(sc->code);
+ }
+ }
+
+ if (is_h_safe_c_s(cadr(binding)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->LET_opSq);
+ set_opt_sym2(sc->code, cadr(cadr(binding)));
+ return(sc->code);
+ }
+ /* opt1 here is opt_back */
+ set_opt_pair2(sc->code, cadr(binding));
+ if (optimize_op(cadr(binding)) == HOP_SAFE_C_SS)
+ {
+ pair_set_syntax_symbol(sc->code, sc->LET_opSSq);
+ set_opt_sym3(sc->code, caddr(cadr(binding)));
+ }
+ else
+ {
+ if (optimize_op(cadr(binding)) == HOP_SAFE_C_C)
+ {
+ set_opt_sym3(sc->code, car(binding));
+ pair_set_syntax_symbol(sc->code, sc->LET_opCq);
+ }
+ /* let_all_x here is slightly slower than fallback let_z */
+ }
+ }
+ }
+ else
+ {
+ s7_pointer p;
+ p = cadaar(sc->code); /* sc->code is of the form '(((x y))...) */
+ set_opt_sym3(sc->code, caaar(sc->code));
+ if (is_symbol(p))
+ {
+ set_opt_sym2(sc->code, p);
+ pair_set_syntax_symbol(sc->code, sc->LET_S);
+ }
+ else
+ {
+ set_opt_con2(sc->code, p);
+ pair_set_syntax_symbol(sc->code, sc->LET_C);
+ }
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_let(s7_scheme *sc)
+{
+ s7_pointer x, start;
+ bool named_let;
+ int vars;
+
+ if (!is_pair(sc->code)) /* (let . 1) */
+ {
+ if (is_null(sc->code)) /* (let) */
+ eval_error(sc, "let has no variables or body: ~A", sc->code);
+ eval_error(sc, "let form is an improper list? ~A", sc->code);
+ }
+
+ if (!is_pair(cdr(sc->code))) /* (let () ) */
+ eval_error(sc, "let has no body: ~A", sc->code);
+
+ if ((!s7_is_list(sc, car(sc->code))) && /* (let 1 ...) */
+ (!is_symbol(car(sc->code))))
+ eval_error(sc, "let variable list is messed up or missing: ~A", sc->code);
+
+ /* we accept these (other schemes complain, but I can't see why -- a no-op is the user's business!):
+ * (let () (define (hi) (+ 1 2)))
+ * (let () (begin (define x 3)))
+ * (let () 3 (begin (define x 3)))
+ * (let () (define x 3))
+ * (let () (if #t (define (x) 3)))
+ *
+ * similar cases:
+ * (case 0 ((0) (define (x) 3) (x)))
+ * (cond (0 (define (x) 3) (x)))
+ * (and (define (x) x) 1)
+ * (begin (define (x y) y) (x (define (x y) y)))
+ * (if (define (x) 1) 2 3)
+ * (do () ((define (x) 1) (define (y) 2)))
+ *
+ * but we can get some humorous results:
+ * (let ((x (lambda () 3))) (if (define (x) 4) (x) 0)) -> 4
+ */
+
+ named_let = (is_symbol(car(sc->code)));
+
+ if (named_let)
+ {
+ if (!s7_is_list(sc, cadr(sc->code))) /* (let hi #t) */
+ eval_error(sc, "let variable list is messed up: ~A", sc->code);
+ if (is_null(cddr(sc->code))) /* (let hi () ) */
+ eval_error(sc, "named let has no body: ~A", sc->code);
+ if (is_immutable_symbol(car(sc->code)))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), sc->code)));
+ set_local(car(sc->code));
+ start = cadr(sc->code);
+ }
+ else start = car(sc->code);
+
+ clear_syms_in_list(sc);
+ for (vars = 0, x = start; is_pair(x); vars++, x = cdr(x))
+ {
+ s7_pointer y, carx;
+
+ carx = car(x);
+
+ if ((!is_pair(carx)) || (is_null(cdr(carx)))) /* (let ((x)) ...) or (let ((x 1) . (y 2)) ...) */
+ eval_error(sc, "let variable declaration, but no value?: ~A", x);
+
+ if (!(is_pair(cdr(carx)))) /* (let ((x . 1))...) */
+ eval_error(sc, "let variable declaration is not a proper list?: ~A", x);
+
+ if (is_not_null(cddr(carx))) /* (let ((x 1 2 3)) ...) */
+ eval_error(sc, "let variable declaration has more than one value?: ~A", x);
+
+ /* currently if the extra value involves a read error, we get a kind of panicky-looking message:
+ * (let ((x . 2 . 3)) x)
+ * ;let variable declaration has more than one value?: (x error error "stray dot?: ... ((x . 2 . 3)) x) ..")
+ */
+
+ y = car(carx);
+ if (!(is_symbol(y)))
+ eval_error(sc, "bad variable ~S in let", carx);
+
+ if (is_immutable_symbol(y))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), x)));
+
+ /* check for name collisions -- not sure this is required by Scheme */
+ if (symbol_tag(y) == sc->syms_tag)
+ eval_error(sc, "duplicate identifier in let: ~A", y);
+ add_sym_to_list(sc, y);
+ set_local(y);
+ }
+
+ /* we accept (let ((:hi 1)) :hi)
+ * (let ('1) quote) [guile accepts this]
+ */
+
+ if (is_not_null(x)) /* (let* ((a 1) . b) a) */
+ eval_error(sc, "let var list improper?: ~A", sc->code);
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ if (named_let)
+ {
+ s7_pointer ex;
+
+ if (is_null(start))
+ pair_set_syntax_symbol(sc->code, sc->NAMED_LET_NO_VARS);
+ else pair_set_syntax_symbol(sc->code, sc->NAMED_LET);
+
+ /* this is (let name ...) so the initial values need to be removed from the closure arg list */
+ sc->args = sc->NIL; /* sc->args is set to nil in named_let below */
+ for (ex = start; is_pair(ex); ex = cdr(ex))
+ sc->args = cons(sc, caar(ex), sc->args);
+ optimize_lambda(sc, true, car(sc->code), sc->args = safe_reverse_in_place(sc, sc->args), cddr(sc->code));
+
+ /* apparently these guys are almost never safe */
+ return(sc->code);
+ }
+
+ if (is_null(start))
+ pair_set_syntax_symbol(sc->code, sc->LET_NO_VARS);
+ else
+ {
+ pair_set_syntax_symbol(sc->code, sc->LET_UNCHECKED);
+ if (is_null(cdr(start))) /* one binding */
+ check_let_one_var(sc, start);
+ else
+ {
+ if (vars < GC_TRIGGER_SIZE)
+ {
+ s7_pointer p, op;
+
+ op = sc->NIL;
+ for (p = start; is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ x = car(p);
+ if (is_pair(cadr(x)))
+ {
+ if (car(cadr(x)) == sc->QUOTE)
+ op = sc->LET_ALL_X;
+ else
+ {
+ if (is_h_safe_c_s(cadr(x)))
+ {
+ if ((op == sc->NIL) || (op == sc->LET_ALL_opSq))
+ op = sc->LET_ALL_opSq;
+ else op = sc->LET_ALL_X;
+ }
+ else
+ {
+ if (is_all_x_safe(sc, cadr(x)))
+ op = sc->LET_ALL_X;
+ else
+ {
+ op = sc->LET_UNCHECKED;
+ break;
+ }
+ }
+ }
+ }
+ else
+ {
+ if (is_symbol(cadr(x)))
+ {
+ if ((op == sc->NIL) || (op == sc->LET_ALL_S))
+ op = sc->LET_ALL_S;
+ else op = sc->LET_ALL_X;
+ }
+ else
+ {
+ if ((op == sc->NIL) || (op == sc->LET_ALL_C))
+ op = sc->LET_ALL_C;
+ else op = sc->LET_ALL_X;
+ }
+ }
+ }
+ pair_set_syntax_symbol(sc->code, op);
+ }
+ else pair_set_syntax_symbol(sc->code, sc->LET_UNCHECKED);
+ }
+ }
+ if (pair_syntax_symbol(sc->code) == sc->LET_ALL_X)
+ {
+ s7_pointer p;
+ for (p = start; is_pair(p); p = cdr(p))
+ set_c_call(cdar(p), all_x_eval(sc, cadar(p), sc->envir, let_symbol_is_safe));
+ }
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_let_star(s7_scheme *sc)
+{
+ s7_pointer y;
+ bool named_let;
+
+ if (!is_pair(sc->code)) /* (let* . 1) */
+ eval_error(sc, "let* variable list is messed up: ~A", sc->code);
+
+ if (!is_pair(cdr(sc->code))) /* (let*) */
+ eval_error(sc, "let* variable list is messed up: ~A", sc->code);
+
+ named_let = (is_symbol(car(sc->code)));
+
+ if (named_let)
+ {
+ if (!s7_is_list(sc, cadr(sc->code))) /* (let* hi #t) */
+ eval_error(sc, "let* variable list is messed up: ~A", sc->code);
+ if (is_null(cddr(sc->code))) /* (let* hi () ) */
+ eval_error(sc, "named let* has no body: ~A", sc->code);
+ if (is_immutable_symbol(car(sc->code)))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), sc->code)));
+ set_local(car(sc->code));
+ if ((!is_null(cadr(sc->code))) &&
+ ((!is_pair(cadr(sc->code))) || /* (let* hi x ... ) */
+ (!is_pair(caadr(sc->code))) || /* (let* hi (x) ...) */
+ (!is_pair(cdaadr(sc->code))))) /* (let* hi ((x . 1)) ...) */
+ eval_error(sc, "named let* variable declaration value is missing: ~A", sc->code);
+ }
+ else
+ {
+ if ((!is_null(car(sc->code))) &&
+ ((!is_pair(car(sc->code))) || /* (let* x ... ) */
+ (!is_pair(caar(sc->code))) || /* (let* (x) ...) */
+ (!is_pair(cdaar(sc->code))))) /* (let* ((x . 1)) ...) */
+ eval_error(sc, "let* variable declaration value is missing: ~A", sc->code);
+ }
+
+ for (y = ((named_let) ? cadr(sc->code) : car(sc->code)); is_pair(y); y = cdr(y))
+ {
+ s7_pointer x, z;
+ x = car(y);
+ if (!(is_symbol(car(x)))) /* (let* ((3 1)) 1) */
+ eval_error(sc, "bad variable ~S in let*", x);
+
+ z = car(x);
+ if (is_immutable_symbol(z))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), x)));
+
+ if (!is_pair(x)) /* (let* ((x)) ...) */
+ eval_error(sc, "let* variable declaration, but no value?: ~A", x);
+
+ if (!(is_pair(cdr(x)))) /* (let* ((x . 1))...) */
+ eval_error(sc, "let* variable declaration is not a proper list?: ~A", x);
+
+ if (is_not_null(cddr(x))) /* (let* ((x 1 2 3)) ...) */
+ eval_error(sc, "let* variable declaration has more than one value?: ~A", x);
+
+ x = cdr(y);
+ if (is_pair(x))
+ {
+ if (!is_pair(car(x))) /* (let* ((x -1) 2) 3) */
+ eval_error(sc, "let* variable/binding is ~S?", car(x));
+
+ if (!is_pair(cdar(x))) /* (let* ((a 1) (b . 2)) ...) */
+ eval_error(sc, "let* variable list is messed up? ~A", x);
+ }
+ else
+ {
+ if (is_not_null(x)) /* (let* ((a 1) . b) a) */
+ eval_error(sc, "let* var list improper?: ~A", x);
+ }
+
+ /* currently (let* ((a 1) (a (+ a 1))) a) is 2, not an error! */
+ set_local(z);
+ }
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ if (named_let)
+ {
+ if (is_null(cadr(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->NAMED_LET_NO_VARS);
+ else
+ {
+ pair_set_syntax_symbol(sc->code, sc->NAMED_LET_STAR);
+ set_opt_con2(sc->code, cadr(car(cadr(sc->code))));
+ }
+ return(sc->code);
+ }
+
+ pair_set_syntax_symbol(sc->code, sc->LET_STAR_UNCHECKED);
+ if (is_null(car(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->LET_NO_VARS); /* (let* () ...) */
+ else
+ {
+ if (is_null(cdar(sc->code)))
+ check_let_one_var(sc, car(sc->code)); /* (let* ((var...))...) -> (let ((var...))...) */
+ else /* more than one entry */
+ {
+ s7_pointer p, op;
+ op = sc->LET_STAR_ALL_X;
+ set_opt_con2(sc->code, cadaar(sc->code));
+ for (p = car(sc->code); is_pair(p); p = cdr(p))
+ {
+ s7_pointer x;
+ x = car(p);
+ if (is_pair(cadr(x)))
+ {
+ if ((!is_all_x_safe(sc, cadr(x))) &&
+ (car(cadr(x)) != sc->QUOTE))
+ {
+ op = sc->LET_STAR2;
+ break;
+ }
+ }
+ }
+ pair_set_syntax_symbol(sc->code, op);
+ }
+ }
+ if ((pair_syntax_symbol(sc->code) == sc->LET_ALL_X) ||
+ (pair_syntax_symbol(sc->code) == sc->LET_STAR_ALL_X))
+ {
+ s7_pointer p;
+ for (p = car(sc->code); is_pair(p); p = cdr(p))
+ set_c_call(cdar(p), all_x_eval(sc, cadar(p), sc->envir, let_symbol_is_safe));
+ }
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_letrec(s7_scheme *sc, bool letrec)
+{
+ s7_pointer x, caller;
+ caller = (letrec) ? sc->LETREC : sc->LETREC_STAR;
+ if ((!is_pair(sc->code)) || /* (letrec . 1) */
+ (!is_pair(cdr(sc->code))) || /* (letrec) */
+ (!s7_is_list(sc, car(sc->code)))) /* (letrec 1 ...) */
+ eval_error_with_caller(sc, "~A: variable list is messed up: ~A", caller, sc->code);
+
+ clear_syms_in_list(sc);
+ for (x = car(sc->code); is_not_null(x); x = cdr(x))
+ {
+ s7_pointer y, carx;
+ if (!is_pair(x)) /* (letrec ((a 1) . 2) ...) */
+ eval_error_with_caller(sc, "~A: improper list of variables? ~A", caller, sc->code);
+
+ carx = car(x);
+ if ((!is_pair(carx)) || /* (letrec (1 2) #t) */
+ (!(is_symbol(car(carx)))))
+ eval_error_with_caller(sc, "~A: bad variable ~S", caller, carx);
+
+ y = car(carx);
+ if (is_immutable_symbol(y))
+ return(s7_error(sc, sc->WRONG_TYPE_ARG, set_elist_2(sc, make_string_wrapper(sc, "can't bind an immutable object: ~S"), x)));
+
+ if (!is_pair(cdr(carx))) /* (letrec ((x . 1))...) */
+ {
+ if (is_null(cdr(carx))) /* (letrec ((x)) x) -- perhaps this is legal? */
+ eval_error_with_caller(sc, "~A: variable declaration has no value?: ~A", caller, carx);
+ eval_error_with_caller(sc, "~A: variable declaration is not a proper list?: ~A", caller, carx);
+ }
+ if (is_not_null(cddr(carx))) /* (letrec ((x 1 2 3)) ...) */
+ eval_error_with_caller(sc, "~A: variable declaration has more than one value?: ~A", caller, carx);
+
+ /* check for name collisions -- this is needed in letrec* else which of the two legit values
+ * does our "rec" refer to, so to speak.
+ */
+ if (symbol_tag(y) == sc->syms_tag)
+ eval_error_with_caller(sc, "~A: duplicate identifier: ~A", caller, y);
+ add_sym_to_list(sc, y);
+ set_local(y);
+ }
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ pair_set_syntax_symbol(sc->code, (letrec) ? sc->LETREC_UNCHECKED : sc->LETREC_STAR_UNCHECKED);
+
+ return(sc->code);
+}
+
+
+static s7_pointer check_quote(s7_scheme *sc)
+{
+ if (!is_pair(sc->code)) /* (quote . -1) */
+ {
+ if (is_null(sc->code))
+ eval_error(sc, "quote: not enough arguments: ~A", sc->code);
+ eval_error(sc, "quote: stray dot?: ~A", sc->code);
+ }
+ if (is_not_null(cdr(sc->code))) /* (quote . (1 2)) or (quote 1 1) */
+ eval_error(sc, "quote: too many arguments ~A", sc->code);
+#if 0
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->QUOTE_UNCHECKED);
+ }
+#endif
+ return(sc->code);
+}
+
+
+static s7_pointer check_and(s7_scheme *sc)
+{
+ s7_pointer p;
+ bool all_pairs;
+
+ if (is_null(sc->code))
+ return(sc->code);
+
+ all_pairs = is_pair(sc->code);
+ for (p = sc->code; is_pair(p); p = cdr(p))
+ {
+ if (!is_pair(car(p)))
+ all_pairs = false;
+ }
+
+ if (is_not_null(p)) /* (and . 1) (and #t . 1) */
+ eval_error(sc, "and: stray dot?: ~A", sc->code);
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ if (all_pairs)
+ {
+ for (p = sc->code; is_pair(p); p = cdr(p))
+ set_c_call(p, all_x_eval(sc, car(p), sc->envir, let_symbol_is_safe)); /* c_callee can be nil! */
+ if ((c_callee(sc->code)) &&
+ (is_pair(cdr(sc->code))) &&
+ (is_null(cddr(sc->code))))
+ pair_set_syntax_symbol(sc->code, sc->AND_P2);
+ else pair_set_syntax_symbol(sc->code, sc->AND_P);
+ }
+ else pair_set_syntax_symbol(sc->code, sc->AND_UNCHECKED);
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_or(s7_scheme *sc)
+{
+ s7_pointer p;
+ bool all_pairs;
+
+ if (is_null(sc->code))
+ return(sc->code);
+
+ all_pairs = is_pair(sc->code);
+ for (p = sc->code; is_pair(p); p = cdr(p))
+ {
+ if (!is_pair(car(p)))
+ all_pairs = false;
+ }
+
+ if (is_not_null(p))
+ eval_error(sc, "or: stray dot?: ~A", sc->code);
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ if (all_pairs)
+ {
+ s7_pointer ep;
+ for (ep = sc->code; is_pair(ep); ep = cdr(ep))
+ set_c_call(ep, all_x_eval(sc, car(ep), sc->envir, let_symbol_is_safe));
+ if ((c_callee(sc->code)) &&
+ (is_pair(cdr(sc->code))) &&
+ (is_null(cddr(sc->code))))
+ pair_set_syntax_symbol(sc->code, sc->OR_P2);
+ else pair_set_syntax_symbol(sc->code, sc->OR_P);
+ }
+ else pair_set_syntax_symbol(sc->code, sc->OR_UNCHECKED);
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_if(s7_scheme *sc)
+{
+ s7_pointer cdr_code;
+
+ if (!is_pair(sc->code)) /* (if) or (if . 1) */
+ eval_error(sc, "(if): if needs at least 2 expressions: ~A", sc->code);
+
+ cdr_code = cdr(sc->code);
+ if (!is_pair(cdr_code)) /* (if 1) */
+ eval_error(sc, "(if ~A): if needs another clause", car(sc->code));
+
+ if (is_pair(cdr(cdr_code)))
+ {
+ if (is_not_null(cddr(cdr_code))) /* (if 1 2 3 4) */
+ eval_error(sc, "too many clauses for if: ~A", sc->code);
+ }
+ else
+ {
+ if (is_not_null(cdr(cdr_code))) /* (if 1 2 . 3) */
+ eval_error(sc, "if: ~A has improper list?", sc->code);
+ }
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ s7_pointer test;
+ bool one_branch;
+ pair_set_syntax_symbol(sc->code, sc->IF_UNCHECKED);
+
+ one_branch = (is_null(cdr(cdr_code)));
+ test = car(sc->code);
+ if (is_pair(test))
+ {
+ if (is_h_optimized(test))
+ {
+ if (optimize_op(test) == HOP_SAFE_C_C)
+ {
+ if (c_callee(test) == g_and_all_x_2)
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_AND2_P : sc->IF_AND2_P_P);
+ set_opt_and_2_test(sc->code, cddr(test));
+ }
+ else pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_CC_P : sc->IF_CC_P_P);
+ set_opt_pair2(sc->code, cdr(test));
+ }
+ else
+ {
+ if (is_h_safe_c_s(test))
+ {
+ /* these miss methods? */
+ if (car(test) == sc->IS_PAIR)
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_IS_PAIR_P : sc->IF_IS_PAIR_P_P);
+ else
+ {
+ if (car(test) == sc->IS_SYMBOL)
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_IS_SYMBOL_P : sc->IF_IS_SYMBOL_P_P);
+ else
+ {
+ if (car(test) == sc->NOT)
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_NOT_S_P : sc->IF_NOT_S_P_P);
+ else pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_CS_P : sc->IF_CS_P_P);
+ }
+ }
+ set_opt_sym2(sc->code, cadr(test));
+ }
+ else
+ {
+ if (optimize_op(test) == HOP_SAFE_C_SQ)
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_CSQ_P : sc->IF_CSQ_P_P);
+ set_opt_con2(sc->code, cadr(caddr(test)));
+ set_opt_sym3(sc->code, cadr(test));
+ }
+ else
+ {
+ if (optimize_op(test) == HOP_SAFE_C_SS)
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_CSS_P : sc->IF_CSS_P_P);
+ set_opt_sym2(sc->code, caddr(test));
+ set_opt_sym3(sc->code, cadr(test));
+ }
+ else
+ {
+ if (optimize_op(test) == HOP_SAFE_C_SC)
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_CSC_P : sc->IF_CSC_P_P);
+ set_opt_con2(sc->code, caddr(test));
+ set_opt_sym3(sc->code, cadr(test));
+ }
+ else
+ {
+ if (optimize_op(test) == HOP_SAFE_C_S_opCq)
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_S_opCq_P : sc->IF_S_opCq_P_P);
+ set_opt_pair2(sc->code, caddr(test));
+ set_opt_sym3(sc->code, cadr(test));
+ }
+ else
+ {
+ if (optimize_op(test) == HOP_SAFE_C_opSSq)
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_opSSq_P : sc->IF_opSSq_P_P);
+ set_opt_pair2(sc->code, cadar(sc->code));
+ set_opt_sym3(sc->code, caddr(opt_pair2(sc->code)));
+ }
+ else
+ {
+ if (is_all_x_safe(sc, test))
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_A_P : sc->IF_A_P_P);
+ set_c_call(sc->code, all_x_eval(sc, test, sc->envir, let_symbol_is_safe));
+ }
+ else
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_Z_P : sc->IF_Z_P_P);
+ set_opt_con2(sc->code, cadr(sc->code));
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_P_P : sc->IF_P_P_P);
+ if (is_syntactic_symbol(car(test)))
+ {
+ pair_set_syntax_op(test, symbol_syntax_op(car(test)));
+
+ if ((symbol_syntax_op(car(test)) == OP_AND) ||
+ (symbol_syntax_op(car(test)) == OP_OR))
+ {
+ opcode_t new_op;
+ s7_pointer old_code;
+ old_code = sc->code;
+ sc->code = cdr(test);
+ if (symbol_syntax_op(car(test)) == OP_AND) check_and(sc); else check_or(sc);
+ new_op = symbol_syntax_op(car(test));
+ sc->code = old_code;
+ if ((new_op == OP_AND_P) || (new_op == OP_AND_P2))
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_ANDP_P : sc->IF_ANDP_P_P);
+ else
+ {
+ if ((new_op == OP_OR_P) || (new_op == OP_OR_P2))
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_ORP_P : sc->IF_ORP_P_P);
+ }
+ }
+ }
+ }
+ }
+ else /* test is symbol or constant, but constant here is nutty */
+ {
+ if (is_symbol(test))
+ pair_set_syntax_symbol(sc->code, (one_branch) ? sc->IF_S_P : sc->IF_S_P_P);
+ }
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_pointer func, s7_pointer args, s7_pointer body)
+{
+ int len;
+ /* fprintf(stderr, "opt %s %s\n", DISPLAY(args), DISPLAY(body)); */
+
+ len = s7_list_length(sc, body);
+ if (len < 0) /* (define (hi) 1 . 2) */
+ eval_error_with_caller(sc, "~A: function body messed up, ~A", (unstarred_lambda) ? sc->LAMBDA : sc->LAMBDA_STAR, sc->code);
+
+ if (len > 0) /* i.e. not circular */
+ {
+ s7_pointer lst;
+
+ clear_syms_in_list(sc);
+ if (is_symbol(func))
+ lst = list_1(sc, add_sym_to_list(sc, func));
+ else lst = sc->NIL;
+ optimize(sc, body, 1, collect_collisions_star(sc, args, lst));
+
+ /* if the body is safe, we can optimize the calling sequence */
+ if ((is_proper_list(sc, args)) &&
+ (!arglist_has_rest(sc, args)))
+ {
+ if (!unstarred_lambda)
+ {
+ s7_pointer p;
+ bool happy = true;
+ /* check default vals -- if none is an expression or symbol, set simple args */
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer arg;
+ arg = car(p);
+ if ((is_pair(arg)) && /* has default value */
+ ((is_symbol(cadr(arg))) || /* if default value might involve eval in any way, it isn't simple */
+ ((is_pair(cadr(arg))) && /* pair as default only ok if it is (quote ...) */
+ (car(cadr(arg)) != sc->QUOTE))))
+ {
+ happy = false;
+ break;
+ }
+ }
+ if (happy)
+ set_simple_args(body);
+ }
+ sc->cycle_counter = 0;
+ if (((unstarred_lambda) || (has_simple_args(body))) &&
+ (body_is_safe(sc, func, body, true)))
+ {
+ /* there is one problem with closure* here -- we can't trust anything that has fancy (non-constant) default argument values. */
+ set_safe_closure(body);
+ /* this bit is set on the function itself in make_closure and friends */
+ }
+ }
+ }
+ return(NULL);
+}
+
+
+static s7_pointer check_define(s7_scheme *sc)
+{
+ s7_pointer func, caller;
+ bool starred;
+ int arity = CLOSURE_ARITY_NOT_SET;
+
+ starred = (sc->op == OP_DEFINE_STAR);
+ if (starred)
+ {
+ caller = sc->DEFINE_STAR;
+ sc->op = OP_DEFINE_STAR_UNCHECKED;
+ }
+ else
+ {
+ if (sc->op == OP_DEFINE)
+ caller = sc->DEFINE;
+ else caller = sc->DEFINE_CONSTANT;
+ }
+
+ if (!is_pair(sc->code))
+ eval_error_with_caller(sc, "~A: nothing to define? ~A", caller, sc->code); /* (define) */
+
+ if (!is_pair(cdr(sc->code)))
+ {
+ if (is_null(cdr(sc->code)))
+ eval_error_with_caller(sc, "~A: no value? ~A", caller, sc->code); /* (define var) */
+ eval_error_with_caller(sc, "~A: bad form? ~A", caller, sc->code); /* (define var . 1) */
+ }
+ if (!is_pair(car(sc->code)))
+ {
+ if (is_not_null(cddr(sc->code))) /* (define var 1 . 2) */
+ eval_error_with_caller(sc, "~A: more than 1 value? ~A", caller, sc->code); /* (define var 1 2) */
+ if (starred)
+ eval_error(sc, "define* is restricted to functions: (define* ~{~S~^ ~})", sc->code);
+
+ func = car(sc->code);
+ if (!is_symbol(func)) /* (define 3 a) */
+ eval_error_with_caller(sc, "~A: define a non-symbol? ~S", caller, func);
+ if (is_keyword(func)) /* (define :hi 1) */
+ eval_error_with_caller(sc, "~A ~A: keywords are constants", caller, func);
+ if (is_syntactic(func)) /* (define and a) */
+ {
+ if (sc->safety > 0)
+ s7_warn(sc, 128, "%s: syntactic keywords tend to behave badly if redefined", DISPLAY(func));
+ set_local(func);
+ }
+
+ if ((is_pair(cadr(sc->code))) && /* look for (define sym (lambda ...)) and treat it like (define (sym ...)...) */
+ ((caadr(sc->code) == sc->LAMBDA) ||
+ (caadr(sc->code) == sc->LAMBDA_STAR)) &&
+ (symbol_id(caadr(sc->code)) == 0))
+ /* not is_global here because that bit might not be set for initial symbols (why not? -- redef as method etc) */
+ optimize_lambda(sc, caadr(sc->code) == sc->LAMBDA, func, cadr(cadr(sc->code)), cddr(cadr(sc->code)));
+ }
+ else
+ {
+ func = caar(sc->code);
+ if (!is_symbol(func)) /* (define (3 a) a) */
+ eval_error_with_caller(sc, "~A: define a non-symbol? ~S", caller, func);
+ if (is_syntactic(func)) /* (define (and a) a) */
+ {
+ if (sc->safety > 0)
+ s7_warn(sc, 128, "%s: syntactic keywords tend to behave badly if redefined", DISPLAY(func));
+ set_local(func);
+ }
+ if (starred)
+ cdar(sc->code) = check_lambda_star_args(sc, cdar(sc->code), &arity);
+ else check_lambda_args(sc, cdar(sc->code), &arity);
+ optimize_lambda(sc, !starred, func, cdar(sc->code), cdr(sc->code));
+ }
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ if (sc->op == OP_DEFINE)
+ {
+ if ((is_pair(car(sc->code))) &&
+ (!symbol_has_accessor(func)) &&
+ (!is_immutable_symbol(func)))
+ pair_set_syntax_symbol(sc->code, sc->DEFINE_FUNCHECKED);
+ else pair_set_syntax_symbol(sc->code, sc->DEFINE_UNCHECKED);
+ }
+ else
+ {
+ if (starred)
+ pair_set_syntax_symbol(sc->code, sc->DEFINE_STAR_UNCHECKED);
+ else pair_set_syntax_symbol(sc->code, sc->DEFINE_CONSTANT_UNCHECKED);
+ }
+ }
+ return(sc->code);
+}
+
+static int define_unchecked_ex(s7_scheme *sc)
+{
+ if (sc->op == OP_DEFINE_STAR_UNCHECKED)
+ {
+ s7_pointer x;
+ unsigned int typ;
+ if (is_safe_closure(cdr(sc->code)))
+ typ = T_CLOSURE_STAR | T_PROCEDURE | T_SAFE_CLOSURE;
+ else typ = T_CLOSURE_STAR | T_PROCEDURE;
+ new_cell(sc, x, typ);
+ closure_args(x) = cdar(sc->code);
+ closure_body(x) = cdr(sc->code);
+ closure_set_let(x, sc->envir);
+ closure_arity(x) = CLOSURE_ARITY_NOT_SET;
+ closure_setter(x) = sc->F;
+ sc->capture_let_counter++;
+ sc->value = x;
+ sc->code = caar(sc->code);
+ return(fall_through);
+ }
+
+ if (!is_pair(car(sc->code)))
+ {
+ s7_pointer x;
+ x = car(sc->code);
+ sc->code = cadr(sc->code);
+ if (is_pair(sc->code))
+ {
+ push_stack(sc, OP_DEFINE1, sc->NIL, x);
+ return(goto_EVAL);
+ }
+
+ if (is_symbol(sc->code))
+ sc->value = find_global_symbol_checked(sc, sc->code);
+ else sc->value = sc->code;
+ sc->code = x;
+ }
+ else
+ {
+ s7_pointer x;
+ /* a closure. If we called this same code earlier (a local define), the only thing
+ * that is new here is the environment -- we can't blithely save the closure object
+ * in opt2 somewhere, and pick it up the next time around (since call/cc might take
+ * us back to the previous case). We also can't re-use opt2(sc->code) because opt2
+ * is not cleared in the gc.
+ */
+ make_closure_with_let(sc, x, cdar(sc->code), cdr(sc->code), sc->envir);
+ sc->value = _NFre(x);
+ sc->code = caar(sc->code);
+ }
+ return(fall_through);
+}
+
+static void define_funchecked(s7_scheme *sc)
+{
+ s7_pointer new_func, new_env, code;
+ code = sc->code;
+ sc->value = caar(code);
+
+ new_cell(sc, new_func, T_CLOSURE | T_PROCEDURE | T_COPY_ARGS);
+ closure_args(new_func) = cdar(code);
+ closure_body(new_func) = cdr(code);
+ closure_setter(new_func) = sc->F;
+ closure_arity(new_func) = CLOSURE_ARITY_NOT_SET;
+ sc->capture_let_counter++;
+
+ if (is_safe_closure(cdr(code)))
+ {
+ s7_pointer arg;
+ set_safe_closure(new_func);
+
+ new_cell_no_check(sc, new_env, T_LET | T_FUNCTION_ENV);
+ let_id(new_env) = ++sc->let_number;
+ let_set_slots(new_env, sc->NIL);
+ set_outlet(new_env, sc->envir);
+ closure_set_let(new_func, new_env);
+ funclet_set_function(new_env, sc->value);
+
+ for (arg = closure_args(new_func); is_pair(arg); arg = cdr(arg))
+ make_slot_1(sc, new_env, car(arg), sc->NIL);
+ let_set_slots(new_env, reverse_slots(sc, let_slots(new_env)));
+ }
+ else closure_set_let(new_func, sc->envir);
+ /* unsafe closures created by other functions do not support __func__ */
+
+ add_slot(sc->envir, sc->value, new_func);
+ set_local(sc->value);
+ sc->value = new_func;
+}
+
+
+static int lambda_star_default(s7_scheme *sc)
+{
+ while (true)
+ {
+ s7_pointer z;
+ z = sc->args;
+ if (is_slot(z))
+ {
+ if (slot_value(z) == sc->UNDEFINED)
+ {
+ if (is_closure_star(sc->code))
+ {
+ s7_pointer val;
+ val = slot_expression(z);
+ if (is_symbol(val))
+ {
+ slot_set_value(z, find_symbol_checked(sc, val));
+ if (slot_value(z) == sc->UNDEFINED)
+ eval_error_no_return(sc, sc->SYNTAX_ERROR, "lambda* defaults: ~A is unbound", slot_symbol(z));
+ /* but #f is default if no expr, so there's some inconsistency here */
+ }
+ else
+ {
+ if (is_pair(val))
+ {
+ if (car(val) == sc->QUOTE)
+ {
+ if ((!is_pair(cdr(val))) || /* (lambda* ((a (quote))) a) or (lambda* ((a (quote 1 1))) a) etc */
+ (is_pair(cddr(val))))
+ eval_error_no_return(sc, sc->SYNTAX_ERROR, "lambda* default: ~A is messed up", val);
+ slot_set_value(z, cadr(val));
+ }
+ else
+ {
+ push_stack(sc, OP_LAMBDA_STAR_DEFAULT, sc->args, sc->code);
+ sc->code = val;
+ return(goto_EVAL);
+ }
+ }
+ else slot_set_value(z, val);
+ }
+ }
+ else slot_set_value(z, slot_expression(z));
+ }
+ sc->args = slot_pending_value(z);
+ }
+ else break;
+ }
+ return(fall_through);
+}
+
+#if 0
+static void unsafe_closure_2(s7_scheme *sc, s7_pointer arg1, s7_pointer arg2)
+{
+ s7_pointer code, args;
+ if (sc->stack_end >= sc->stack_resize_trigger) resize_stack(sc); /* not check_stack_size because it tries to return sc->F */
+ code = opt_lambda(sc->code);
+ args = closure_args(code);
+ new_frame_with_two_slots(sc, closure_let(code), sc->envir, car(args), arg1, cadr(args), arg2);
+ sc->code = closure_body(code);
+}
+#else
+#define unsafe_closure_2(Sc, Arg1, Arg2) \
+{ \
+ s7_pointer Code, Args, A1, A2; A1 = Arg1; A2 = Arg2; \
+ if (Sc->stack_end >= Sc->stack_resize_trigger) resize_stack(Sc); \
+ Code = opt_lambda(Sc->code); \
+ Args = closure_args(Code); \
+ new_frame_with_two_slots(Sc, closure_let(Code), Sc->envir, car(Args), A1, cadr(Args), A2); \
+ Sc->code = closure_body(Code); \
+}
+#endif
+
+static void unsafe_closure_star(s7_scheme *sc)
+{
+ s7_pointer x, z, e;
+ unsigned long long int id;
+
+ new_frame(sc, closure_let(sc->code), sc->envir);
+ e = sc->envir;
+ id = let_id(e);
+
+ for (x = closure_args(sc->code), z = sc->args; is_pair(x); x = cdr(x))
+ {
+ s7_pointer sym, args, val;
+ if (is_pair(car(x)))
+ sym = caar(x);
+ else sym = car(x);
+ val = car(z);
+ args = cdr(z);
+
+ set_type(z, T_SLOT);
+ slot_set_symbol(z, sym);
+ symbol_set_local(sym, id, z);
+ slot_set_value(z, val);
+ next_slot(z) = let_slots(e);
+ let_set_slots(e, z);
+ z = args;
+ }
+ sc->code = closure_body(sc->code);
+}
+
+static void fill_closure_star(s7_scheme *sc, s7_pointer p)
+{
+ for (; is_pair(p); p = cdr(p))
+ {
+ s7_pointer defval;
+ if (is_pair(car(p)))
+ {
+ defval = cadar(p);
+ if (is_pair(defval))
+ sc->args = cons(sc, cadr(defval), sc->args);
+ else sc->args = cons(sc, defval, sc->args);
+ }
+ else sc->args = cons(sc, sc->F, sc->args);
+ }
+ sc->args = safe_reverse_in_place(sc, sc->args);
+ sc->code = opt_lambda(sc->code);
+}
+
+static void fill_safe_closure_star(s7_scheme *sc, s7_pointer x, s7_pointer p)
+{
+ for (; is_pair(p); p = cdr(p), x = next_slot(x))
+ {
+ s7_pointer defval;
+ if (is_pair(car(p)))
+ {
+ defval = cadar(p);
+ if (is_pair(defval))
+ slot_set_value(x, cadr(defval));
+ else slot_set_value(x, defval);
+ }
+ else slot_set_value(x, sc->F);
+ symbol_set_local(slot_symbol(x), let_id(sc->envir), x);
+ }
+ sc->code = closure_body(opt_lambda(sc->code));
+}
+
+
+static s7_pointer check_define_macro(s7_scheme *sc, opcode_t op)
+{
+ s7_pointer x, y, caller;
+ caller = sc->DEFINE_MACRO;
+ switch (op)
+ {
+ case OP_DEFINE_MACRO: caller = sc->DEFINE_MACRO; break;
+ case OP_DEFINE_MACRO_STAR: caller = sc->DEFINE_MACRO_STAR; break;
+ case OP_DEFINE_BACRO: caller = sc->DEFINE_BACRO; break;
+ case OP_DEFINE_BACRO_STAR: caller = sc->DEFINE_BACRO_STAR; break;
+ case OP_DEFINE_EXPANSION: caller = sc->DEFINE_EXPANSION; break;
+ }
+
+ if (!is_pair(sc->code)) /* (define-macro . 1) */
+ eval_error_with_caller(sc, "~A name missing (stray dot?): ~A", caller, sc->code);
+ if (!is_pair(car(sc->code))) /* (define-macro a ...) */
+ return(wrong_type_argument_with_type(sc, caller, 1, car(sc->code), make_string_wrapper(sc, "a list: (name ...)")));
+ /* not car(opt_back(sc->code)) to get the caller (e.g. 'define-bacro) because opt_back might not be set: (apply define-macro '(1)) */
+
+ x = caar(sc->code);
+ if (!is_symbol(x))
+ eval_error_with_caller(sc, "~A: ~S is not a symbol?", caller, x);
+ if (dont_eval_args(x)) /* (define-macro (quote a) quote) */
+ {
+ if (sc->safety > 0)
+ s7_warn(sc, 128, "%s: syntactic keywords tend to behave badly if redefined", DISPLAY(x));
+ set_local(x);
+ }
+ if (is_immutable_symbol(x))
+ eval_error_with_caller(sc, "~A: ~S is immutable", caller, x);
+
+ if (!is_pair(cdr(sc->code))) /* (define-macro (...)) */
+ eval_error_with_caller(sc, "~A ~A, but no body?", caller, x);
+
+ y = cdar(sc->code); /* the arglist */
+ if ((!s7_is_list(sc, y)) &&
+ (!is_symbol(y)))
+ return(s7_error(sc, sc->SYNTAX_ERROR, /* (define-macro (mac . 1) ...) */
+ set_elist_3(sc, make_string_wrapper(sc, "macro ~A argument list is ~S?"), x, y)));
+
+ for ( ; is_pair(y); y = cdr(y))
+ if ((!is_symbol(car(y))) &&
+ ((sc->op == OP_DEFINE_MACRO) || (sc->op == OP_DEFINE_BACRO) || (sc->op == OP_DEFINE_EXPANSION)))
+ return(s7_error(sc, sc->SYNTAX_ERROR, /* (define-macro (mac 1) ...) */
+ set_elist_3(sc, make_string_wrapper(sc, "define-macro ~A argument name is not a symbol: ~S"), x, y)));
+
+ if ((sc->op == OP_DEFINE_MACRO_STAR) || (sc->op == OP_DEFINE_BACRO_STAR))
+ cdar(sc->code) = check_lambda_star_args(sc, cdar(sc->code), NULL);
+ else check_lambda_args(sc, cdar(sc->code), NULL);
+
+ return(sc->code);
+}
+
+static int expansion_ex(s7_scheme *sc)
+{
+ int loc;
+ s7_pointer caller;
+
+ /* read-time macro expansion:
+ * (define-macro (hi a) (format #t "hi...") `(+ ,a 1))
+ * (define (ho b) (+ 1 (hi b)))
+ * here sc->value is: (ho b), (hi b), (+ 1 (hi b)), (define (ho b) (+ 1 (hi b)))
+ * but... first we can't tell for sure at this point that "hi" really is a macro
+ * (letrec ((hi ... (hi...))) will be confused about the second hi,
+ * or (call/cc (lambda (hi) (hi 1))) etc.
+ * second, figuring out that we're quoted is not easy -- we have to march all the
+ * way to the bottom of the stack looking for op_read_quote or op_read_vector
+ * #(((hi)) 2) or '(((hi)))
+ * or op_read_list with args not equal (quote) or (macroexapand)
+ * '(hi 3) or (macroexpand (hi 3) or (quote (hi 3))
+ * and those are only the problems I noticed!
+ *
+ * The hardest of these problems involve shadowing, so Rick asked for "define-expansion"
+ * which is like define-macro, but the programmer guarantees that the macro
+ * name will not be shadowed.
+ *
+ * to make expansion recognition fast here, define-expansion sets the T_EXPANSION
+ * bit in the symbol as well as the value:
+ * set_type(sc->code, T_EXPANSION | T_SYMBOL)
+ * but this can lead to confusion because the expansion name is now globally identified as an expansion.
+ * (let () (define-expansion (ex1 a) `(+ ,a 1)) (display (ex1 3)))
+ * (define (ex1 b) (* b 2)) (display (ex1 3))
+ * since this happens at the top level, the first line is evaluated, ex1 becomes an expansion.
+ * but the reader has no idea about lets and whatnot, so in the second line, ex1 is still an expansion
+ * to the reader, so ir sees (define (+ b 1) ...) -- error! To support tail-calls, there's no
+ * way in eval to see the let close, so we can't clear the expansion flag when the let is done.
+ * But we don't want define-expansion to mimic define-constant (via T_IMMUTABLE) because programs
+ * like lint need to cancel reader-cond (for example). So, we allow an expansion to be redefined,
+ * and check here that the expander symbol still refers to an expansion.
+ *
+ * but in (define (ex1 b) b), the reader doesn't know we're in a define call (or it would be
+ * a bother to notice), so to redefine an expansion, first (set! ex1 #f) or (define ex1 #f),
+ * then (define (ex1 b) b).
+ *
+ * This is a mess! Maybe we should insist that expansions are always global.
+ */
+
+ loc = s7_stack_top(sc) - 1;
+ if (is_pair(stack_args(sc->stack, loc)))
+ caller = car(stack_args(sc->stack, loc)); /* this can be garbage */
+ else caller = sc->F;
+ if ((loc >= 3) &&
+ (stack_op(sc->stack, loc) != OP_READ_QUOTE) && /* '(hi 1) for example */
+ (stack_op(sc->stack, loc) != OP_READ_VECTOR) && /* #(reader-cond) for example */
+ (caller != sc->QUOTE) && /* (quote (hi 1)) */
+ (caller != sc->MACROEXPAND) && /* (macroexpand (hi 1)) */
+ (caller != sc->DEFINE_EXPANSION)) /* (define-expansion ...) being reloaded/redefined */
+ {
+ s7_pointer symbol, slot;
+ /* we're playing fast and loose with sc->envir in the reader, so here we need a disaster check */
+#if DEBUGGING
+ if (unchecked_type(sc->envir) != T_LET) sc->envir = sc->NIL;
+#else
+ if (!is_let(sc->envir)) sc->envir = sc->NIL;
+#endif
+ symbol = car(sc->value);
+ if ((symbol_id(symbol) == 0) ||
+ (sc->envir == sc->NIL))
+ slot = global_slot(symbol);
+ else slot = find_symbol(sc, symbol);
+ if (is_slot(slot))
+ sc->code = slot_value(slot);
+ else sc->code = sc->UNDEFINED;
+ if (!is_expansion(sc->code))
+ clear_expansion(symbol);
+ else
+ {
+ sc->args = copy_list(sc, cdr(sc->value));
+ return(goto_APPLY);
+ }
+ }
+ return(fall_through);
+}
+
+static s7_pointer check_with_let(s7_scheme *sc)
+{
+ if (!is_pair(sc->code)) /* (with-let . "hi") */
+ eval_error(sc, "with-let takes an environment argument: ~A", sc->code);
+ if (!is_pair(cdr(sc->code))) /* (with-let e) -> an error? */
+ eval_error(sc, "with-let body is messed up: ~A", sc->code);
+ if ((!is_pair(cddr(sc->code))) &&
+ (!is_null(cddr(sc->code))))
+ eval_error(sc, "with-let body has stray dot? ~A", sc->code);
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->WITH_LET_UNCHECKED);
+ if ((is_symbol(car(sc->code))) &&
+ (is_pair(cadr(sc->code))))
+ pair_set_syntax_symbol(sc->code, sc->WITH_LET_S);
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_cond(s7_scheme *sc)
+{
+ bool has_feed_to = false;
+ s7_pointer x;
+ if (!is_pair(sc->code)) /* (cond) or (cond . 1) */
+ eval_error(sc, "cond, but no body: ~A", sc->code);
+
+ for (x = sc->code; is_pair(x); x = cdr(x))
+ {
+ if (!is_pair(car(x))) /* (cond 1) or (cond (#t 1) 3) */
+ eval_error(sc, "every clause in cond must be a list: ~A", car(x));
+ else
+ {
+ s7_pointer y;
+ y = car(x);
+ if ((!is_pair(cdr(y))) && (!is_null(cdr(y)))) /* (cond (1 . 2)) */
+ eval_error(sc, "cond: stray dot? ~A", sc->code);
+ if ((cadr(y) == sc->FEED_TO) &&
+ (s7_symbol_value(sc, sc->FEED_TO) == sc->UNDEFINED))
+ {
+ has_feed_to = true;
+ if (!is_pair(cddr(y))) /* (cond (#t =>)) or (cond (#t => . 1)) */
+ eval_error(sc, "cond: '=>' target missing? ~A", x);
+ if (is_pair(cdddr(y))) /* (cond (1 => + abs)) */
+ eval_error(sc, "cond: '=>' has too many targets: ~A", x);
+ }
+ /* currently we accept:
+ * (cond (1 2) (=> . =>)) and all variants thereof, e.g. (cond (1 2) (=> 1 . 2) (1 2)) or
+ * (cond (1) (=>)) but Guile accepts this?
+ * (cond (1) (1 =>))
+ * amusing (correct) case: (cond (1 => "hi")) -> #\i
+ */
+ }
+ }
+ if (is_not_null(x)) /* (cond ((1 2)) . 1) */
+ eval_error(sc, "cond: stray dot? ~A", sc->code);
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ if (has_feed_to)
+ {
+ pair_set_syntax_symbol(sc->code, sc->COND_UNCHECKED);
+ if (is_null(cdr(sc->code)))
+ {
+ s7_pointer expr, f;
+ expr = car(sc->code);
+ f = caddr(expr);
+ if ((is_pair(f)) &&
+ (car(f) == sc->LAMBDA) &&
+ (is_null(cdr(cddr(f)))))
+ {
+ s7_pointer arg;
+ arg = cadr(f);
+ if ((is_pair(arg)) &&
+ (is_null(cdr(arg))) &&
+ (is_symbol(car(arg))))
+ {
+ /* (define (hi) (cond (#t => (lambda (s) s)))) */
+ set_opt_lambda2(sc->code, caddar(sc->code)); /* (lambda ...) above */
+ pair_set_syntax_symbol(sc->code, sc->IF_P_FEED);
+ }
+ }
+ }
+ }
+ else
+ {
+ s7_pointer p, sym = NULL;
+ bool xopt = true, c_s_is_ok = true;
+ pair_set_syntax_symbol(sc->code, sc->COND_SIMPLE);
+
+ for (p = sc->code; xopt && (is_pair(p)); p = cdr(p))
+ {
+ xopt = is_all_x_safe(sc, caar(p));
+ if ((c_s_is_ok) &&
+ (caar(p) != sc->T) &&
+ (caar(p) != sc->ELSE))
+ {
+ if ((!is_pair(caar(p))) ||
+ (!is_h_safe_c_s(caar(p))) ||
+ ((sym) && (sym != cadaar(p))))
+ c_s_is_ok = false;
+ else sym = cadaar(p);
+ }
+ }
+ if (c_s_is_ok)
+ pair_set_syntax_symbol(sc->code, sc->COND_S);
+ else
+ {
+ if (xopt)
+ {
+ int i;
+ pair_set_syntax_symbol(sc->code, sc->COND_ALL_X);
+ for (i = 0, p = sc->code; is_pair(p); i++, p = cdr(p))
+ set_c_call(car(p), cond_all_x_eval(sc, caar(p), sc->envir)); /* handle 'else' specially here */
+ if (i == 2)
+ pair_set_syntax_symbol(sc->code, sc->COND_ALL_X_2);
+ }
+ }
+ }
+ }
+ return(sc->code);
+}
+
+
+static s7_pointer check_set(s7_scheme *sc)
+{
+ if (!is_pair(sc->code))
+ {
+ if (is_null(sc->code)) /* (set!) */
+ eval_error(sc, "set!: not enough arguments: ~A", sc->code);
+ eval_error(sc, "set!: stray dot? ~A", sc->code); /* (set! . 1) */
+ }
+ if (!is_pair(cdr(sc->code)))
+ {
+ if (is_null(cdr(sc->code))) /* (set! var) */
+ eval_error(sc, "set!: not enough arguments: ~A", sc->code);
+ eval_error(sc, "set!: stray dot? ~A", sc->code); /* (set! var . 1) */
+ }
+ if (is_not_null(cddr(sc->code))) /* (set! var 1 2) */
+ eval_error(sc, "~A: too many arguments to set!", sc->code);
+
+ /* cadr (the value) has not yet been evaluated */
+
+ if (is_immutable(car(sc->code))) /* (set! pi 3) */
+ eval_error(sc, "set!: can't alter immutable object: ~S", car(sc->code));
+
+ if (is_pair(car(sc->code)))
+ {
+ if (is_pair(caar(sc->code)))
+ {
+ if (!s7_is_list(sc, cdar(sc->code))) /* (set! ('(1 2) . 0) 1) */
+ eval_error(sc, "improper list of args to set!: ~A", sc->code);
+ }
+ if (!is_proper_list(sc, car(sc->code))) /* (set! ("hi" . 1) #\a) or (set! (#(1 2) . 1) 0) */
+ eval_error(sc, "set! target is an improper list: (set! ~A ...)", car(sc->code));
+ }
+ else
+ {
+ if (!is_symbol(car(sc->code))) /* (set! 12345 1) */
+ eval_error(sc, "set! can't change ~S", car(sc->code));
+ }
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ if (is_pair(car(sc->code)))
+ {
+ /* here we have (set! (...) ...) */
+ s7_pointer inner, value;
+ inner = car(sc->code);
+ value = cadr(sc->code);
+
+ pair_set_syntax_symbol(sc->code, sc->SET_UNCHECKED);
+ if (is_symbol(car(inner)))
+ {
+ if ((is_null(cdr(inner))) &&
+ (!is_pair(value)) &&
+ (is_global(car(inner))) &&
+ (is_c_function(slot_value(global_slot(car(inner))))) &&
+ (c_function_required_args(slot_value(global_slot(car(inner)))) == 0))
+ pair_set_syntax_symbol(sc->code, sc->SET_PWS);
+ else
+ {
+ if ((is_pair(cdr(inner))) &&
+ (!is_pair(cddr(inner)))) /* we check cddr(sc->code) above */
+ {
+ if (!is_pair(cadr(inner)))
+ {
+ /* (set! (f s) ...) */
+ if (!is_pair(value))
+ pair_set_syntax_symbol(sc->code, sc->SET_PAIR);
+ else
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_PAIR_P);
+ /* splice_in_values protects us here from values */
+ if (is_h_optimized(value)) /* this excludes h_unknown_g etc */
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_PAIR_Z);
+ if (is_all_x_safe(sc, value))
+ {
+ s7_pointer obj;
+ annotate_arg(sc, cdr(sc->code), sc->envir);
+ pair_set_syntax_symbol(sc->code, sc->SET_PAIR_ZA);
+ obj = find_symbol_checked(sc, car(inner));
+ if ((is_c_function(obj)) &&
+ (is_c_function(c_function_setter(obj))))
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_PAIR_A);
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ if ((car(cadr(inner)) == sc->QUOTE) &&
+ (is_symbol(car(inner))) &&
+ ((is_symbol(value)) || (is_all_x_safe(sc, value))))
+ {
+ if (is_symbol(value))
+ pair_set_syntax_symbol(sc->code, sc->SET_LET_S);
+ else
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_LET_ALL_X);
+ set_c_call(cdr(sc->code), all_x_eval(sc, value, sc->envir, let_symbol_is_safe));
+ }
+ }
+ else
+ {
+ if (is_h_safe_c_c(cadr(inner)))
+ {
+ if (!is_pair(value))
+ pair_set_syntax_symbol(sc->code, sc->SET_PAIR_C);
+ else
+ {
+ /* splice_in_values protects us here from values */
+ pair_set_syntax_symbol(sc->code, sc->SET_PAIR_C_P);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ else pair_set_syntax_symbol(sc->code, sc->SET_NORMAL);
+
+ if (is_symbol(car(sc->code)))
+ {
+ s7_pointer settee, value;
+ settee = car(sc->code);
+ value = cadr(sc->code);
+
+ if ((!symbol_has_accessor(settee)) &&
+ (!is_syntactic(settee)))
+ {
+ if (is_symbol(value))
+ pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_S);
+ else
+ {
+ if (!is_pair(value))
+ pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_C);
+ else
+ {
+ if (car(value) == sc->QUOTE)
+ pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_Q);
+ else
+ {
+ /* if cadr(cadr) == car, or cdr(cadr) not null and cadr(cadr) == car, and cddr(cadr) == null,
+ * it's (set! <var> (<op> <var> val)) or (<op> val <var>) or (<op> <var>)
+ * in the set code, we get the slot as usual, then in case 1 above,
+ * car(sc->T2_1) = slot_value(slot), car(sc->T2_2) = increment, call <op>, set slot_value(slot)
+ *
+ * this can be done in all combined cases where a symbol is repeated (do in particular)
+ */
+
+ /* (define (hi) (let ((x 1)) (set! x (+ x 1))))
+ * but the value might be values:
+ * (let () (define (hi) (let ((x 0)) (set! x (values 1 2)) x)) (catch #t hi (lambda a a)) (hi))
+ * which is caught in splice_in_values
+ */
+ pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_P);
+ if (is_h_safe_c_s(value))
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_opSq);
+ set_opt_sym2(sc->code, cadr(value));
+ }
+ else
+ {
+ if (is_h_optimized(value))
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_Z);
+ if (optimize_op(value) == HOP_SAFE_C_C)
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_opCq);
+ /* opt1 here points back? */
+ set_opt_pair2(sc->code, cdr(value));
+ }
+ else
+ {
+ /* most of these special cases probably don't matter */
+ if (optimize_op(value) == HOP_SAFE_C_SS)
+ {
+ if (settee == cadr(value))
+ pair_set_syntax_symbol(sc->code, sc->INCREMENT_SS);
+ else pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_opSSq);
+ set_opt_pair2(sc->code, cdr(value));
+ }
+ else
+ {
+ if (optimize_op(value) == HOP_SAFE_C_SSS)
+ {
+ if ((settee == cadr(value)) &&
+ (car(value) == sc->ADD))
+ pair_set_syntax_symbol(sc->code, sc->INCREMENT_SSS);
+ else pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_opSSSq);
+ set_opt_pair2(sc->code, cdr(value));
+ }
+ else
+ {
+ if (is_all_x_safe(sc, value)) /* value = cadr(sc->code) */
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_SYMBOL_A);
+ annotate_arg(sc, cdr(sc->code), sc->envir);
+ }
+ if (is_callable_c_op(optimize_op(value)))
+ {
+ if ((settee == cadr(value)) &&
+ (!is_null(cddr(value))))
+ {
+ if (is_null(cdddr(value)))
+ {
+ if (is_all_x_safe(sc, caddr(value)))
+ {
+ /* this appears to give a slight savings over the SZ case */
+ pair_set_syntax_symbol(sc->code, sc->INCREMENT_SA);
+ annotate_arg(sc, cddr(value), sc->envir); /* this sets c_callee(arg) */
+ set_opt_pair2(sc->code, cddr(value));
+ }
+ else
+ {
+ if (is_optimized(caddr(value)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->INCREMENT_SZ);
+ set_opt_pair2(sc->code, caddr(value));
+ }
+ }
+ }
+ else
+ {
+ if ((is_null(cddddr(value))) &&
+ (is_all_x_safe(sc, caddr(value))) &&
+ (is_all_x_safe(sc, cadddr(value))))
+ {
+ pair_set_syntax_symbol(sc->code, sc->INCREMENT_SAA);
+ annotate_arg(sc, cddr(value), sc->envir);
+ annotate_arg(sc, cdddr(value), sc->envir);
+ set_opt_pair2(sc->code, cddr(value));
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ if ((is_h_optimized(value)) &&
+ (!is_unsafe(value)) &&
+ (is_not_null(cdr(value)))) /* (set! x (y)) */
+ {
+ if (is_not_null(cddr(value)))
+ {
+ if ((caddr(value) == small_int(1)) &&
+ (cadr(value) == settee))
+ {
+ if ((opt_cfunc(value) == add_s1) ||
+ (opt_cfunc(value) == add_cs1))
+ pair_set_syntax_symbol(sc->code, sc->INCREMENT_1);
+ else
+ {
+ if ((opt_cfunc(value) == subtract_s1) ||
+ (opt_cfunc(value) == subtract_cs1))
+ pair_set_syntax_symbol(sc->code, sc->DECREMENT_1);
+ }
+ }
+ else
+ {
+ if ((cadr(value) == small_int(1)) &&
+ (caddr(value) == settee) &&
+ (opt_cfunc(value) == add_1s))
+ pair_set_syntax_symbol(sc->code, sc->INCREMENT_1);
+ else
+ {
+ if ((settee == caddr(value)) &&
+ (is_symbol(cadr(value))) &&
+ (caadr(sc->code) == sc->CONS))
+ {
+ pair_set_syntax_symbol(sc->code, sc->SET_CONS);
+ set_opt_sym2(sc->code, cadr(value));
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(sc->code);
+}
+
+static bool set_pair_p_3(s7_scheme *sc, s7_pointer obj, s7_pointer arg, s7_pointer value)
+{
+ if (is_slot(obj))
+ obj = slot_value(obj);
+ else eval_error(sc, "no generalized set for ~A", caar(sc->code));
+
+ switch (type(obj))
+ {
+ case T_C_OBJECT:
+ car(sc->T2_1) = arg;
+ car(sc->T2_2) = value;
+ sc->value = (*(c_object_set(obj)))(sc, obj, sc->T2_1);
+ break;
+
+ /* some of these are wasteful -- we know the object type! (list hash-table) */
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+#if WITH_GMP
+ car(sc->T3_1) = obj;
+ car(sc->T3_2) = arg;
+ car(sc->T3_3) = value;
+ sc->value = g_vector_set(sc, sc->T3_1);
+#else
+ if (vector_rank(obj) > 1)
+ {
+ car(sc->T3_1) = obj;
+ car(sc->T3_2) = arg;
+ car(sc->T3_3) = value;
+ sc->value = g_vector_set(sc, sc->T3_1);
+ }
+ else
+ {
+ s7_int index;
+
+ if (!is_integer(arg))
+ eval_type_error(sc, "vector-set!: index must be an integer: ~S", sc->code);
+ index = integer(arg);
+ if (index < 0)
+ eval_range_error(sc, "vector-set!: index must not be negative: ~S", sc->code);
+ if (index >= vector_length(obj))
+ eval_range_error(sc, "vector-set!: index must be less than vector length: ~S", sc->code);
+ vector_setter(obj)(sc, obj, index, value);
+ sc->value = _NFre(value);
+ }
+#endif
+ break;
+
+ case T_STRING:
+#if WITH_GMP
+ car(sc->T3_1) = obj;
+ car(sc->T3_2) = arg;
+ car(sc->T3_3) = value;
+ sc->value = g_string_set(sc, sc->T3_1);
+#else
+ {
+ s7_int index;
+ if (!is_integer(arg))
+ eval_type_error(sc, "string-set!: index must be an integer: ~S", sc->code);
+ index = integer(arg);
+ if (index < 0)
+ eval_range_error(sc, "string-set!: index must not be negative: ~S", sc->code);
+ if (index >= string_length(obj))
+ eval_range_error(sc, "string-set!: index must be less than string length: ~S", sc->code);
+ if (s7_is_character(value))
+ {
+ string_value(obj)[index] = (char)s7_character(value);
+ sc->value = _NFre(value);
+ }
+ else
+ {
+ if ((is_byte_vector(obj)) &&
+ (s7_is_integer(value)))
+ {
+ int ic;
+ ic = s7_integer(value);
+ if ((ic < 0) || (ic > 255))
+ eval_type_error(sc, "string-set!: value must be a character: ~S", sc->code);
+ string_value(obj)[index] = (char)ic;
+ sc->value = _NFre(value);
+ }
+ else eval_type_error(sc, "string-set!: value must be a character: ~S", sc->code);
+ }
+ }
+#endif
+ break;
+
+ case T_PAIR:
+ car(sc->T3_1) = obj;
+ car(sc->T3_2) = arg;
+ car(sc->T3_3) = value;
+ sc->value = g_list_set(sc, sc->T3_1);
+ break;
+
+ case T_HASH_TABLE:
+ sc->value = s7_hash_table_set(sc, obj, arg, value);
+ break;
+
+ case T_LET:
+ sc->value = s7_let_set(sc, obj, arg, value);
+ break;
+
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION: /* (let ((lst (list 1 2))) (set! (list-ref lst 1) 2) lst) */
+ case T_C_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ /* obj here is a c_function, but its setter could be a closure and vice versa below */
+ if (is_procedure_or_macro(c_function_setter(obj)))
+ {
+ if (is_c_function(c_function_setter(obj)))
+ {
+ car(sc->T2_1) = arg;
+ car(sc->T2_2) = value;
+ sc->value = c_function_call(c_function_setter(obj))(sc, sc->T2_1);
+ }
+ else
+ {
+ sc->code = c_function_setter(obj);
+ if (needs_copied_args(sc->code))
+ sc->args = list_2(sc, arg, value);
+ else sc->args = set_plist_2(sc, arg, value);
+ return(true); /* goto APPLY; */
+ }
+ }
+ else eval_error(sc, "no generalized set for ~A", obj);
+ break;
+
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ if (is_procedure_or_macro(closure_setter(obj)))
+ {
+ if (is_c_function(closure_setter(obj)))
+ {
+ car(sc->T2_1) = arg;
+ car(sc->T2_2) = value;
+ sc->value = c_function_call(closure_setter(obj))(sc, sc->T2_1);
+ }
+ else
+ {
+ sc->code = closure_setter(obj);
+ if (needs_copied_args(sc->code))
+ sc->args = list_2(sc, arg, value);
+ else sc->args = set_plist_2(sc, arg, value);
+ return(true); /* goto APPLY; */
+ }
+ }
+ else eval_error(sc, "no generalized set for ~A", obj);
+ break;
+
+ default: /* (set! (1 2) 3) */
+ eval_error(sc, "no generalized set for ~A", obj);
+ }
+ return(false);
+}
+
+
+static bool safe_stepper(s7_scheme *sc, s7_pointer expr, s7_pointer vars)
+{
+ /* for now, just look for stepper as last element of any list
+ * any embedded set is handled by do-is-safe, so we don't need to descend into the depths
+ */
+ s7_pointer p;
+ if (direct_memq(cadr(expr), vars))
+ return(false);
+
+ for (p = cdr(expr); is_pair(cdr(p)); p = cdr(p));
+
+ if (is_pair(p))
+ {
+ if ((is_optimized(p)) &&
+ ((optimize_op(p) & 1) != 0) &&
+ (is_safe_c_op(optimize_op(p))))
+ return(true);
+
+ if (direct_memq(car(p), vars))
+ return(false);
+ }
+ else
+ {
+ if (direct_memq(p, vars))
+ return(false);
+ }
+ return(true);
+}
+
+static int set_pair_ex(s7_scheme *sc)
+{
+ s7_pointer caar_code, cx;
+
+ caar_code = caar(sc->code);
+ if (is_pair(caar_code))
+ {
+ push_stack(sc, OP_SET2, cdar(sc->code), cdr(sc->code));
+ sc->code = caar_code;
+ return(goto_EVAL);
+ }
+
+ if (is_symbol(caar_code))
+ {
+ /* this was cx = s7_symbol_value(sc, caar_code) but the function call overhead is noticeable */
+ cx = find_symbol(sc, caar_code);
+ if (is_slot(cx))
+ cx = slot_value(cx);
+ else eval_error_no_return(sc, sc->SYNTAX_ERROR, "no generalized set for ~A", caar_code);
+ }
+ else cx = caar_code;
+
+ /* code here is the accessor and the value without the "set!": ((window-width) 800) */
+ /* (set! (hi 0) (* 2 3)) -> ((hi 0) (* 2 3)) */
+
+ /* for these kinds of objects, some Schemes restrict set!
+ * (list-set! '(1 2 3) 1 32) is accepted but does it make sense?
+ * (set-car! '(1 . 2) 32)
+ * (string-set! "hiho" 1 #\z)
+ * (vector-set! #(1 2 3) 1 32)
+ * (let ((x (lambda () "hiho"))) (string-set! (x) 1 #\a))
+ * (let ((x (lambda () #(1 2 3)))) (vector-set! (x) 1 32))
+ * (let ((str "hiho")) (string-set! str 1 #\x) str)
+ * (let ((v #(1 2 3))) (vector-set! v 1 32) v)
+ * (let ((x (lambda () "hiho"))) (string-set! (x) 1 #\x) (x))
+ *
+ * It seems weird that we can reach into both the function body, and its closure:
+ * (let ((xx (let ((x '(1 2 3))) (lambda () x)))) (list-set! (xx) 1 32) (xx)) -> '(1 32 3)
+ *
+ * (let* ((x '(1 2)) (y (list x)) (z (car y))) (list-set! z 1 32) (list x y z))
+ * ((1 32) ((1 32)) (1 32))
+ *
+ * (string-set! (symbol->string 'symbol->string) 1 #\X) -> error currently also in Guile "string is read-only"
+ * (setf (elt (symbol-name 'xyz) 1) #\X) -> error in CL "read-only string"
+ */
+ /* for gmp case, indices need to be decoded via s7_integer, not just integer */
+
+ switch (type(cx))
+ {
+ case T_C_OBJECT:
+ {
+ s7_pointer settee, index, val;
+
+ if (is_null(cdr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "no value for object-set!: ~S", sc->code);
+ if (!is_null(cddr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "too many values for object-set!: ~S", sc->code);
+
+ settee = car(sc->code);
+ if ((is_null(cdr(settee))) ||
+ (!is_null(cddr(settee))))
+ {
+ /* no-index or multi-index case -- use slow version.
+ * TODO: ambiguity here -- is (set! (obj a b) v) actually (set! ((obj a) b) v)?
+ * perhaps look at setter? c-object-set takes 1 arg -- is this a bug?
+ */
+ push_op_stack(sc, sc->Object_Set);
+ if (is_null(cdr(settee)))
+ {
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cddr(sc->code));
+ sc->code = cadr(sc->code);
+ }
+ else
+ {
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code)));
+ sc->code = cadr(settee);
+ }
+ return(goto_EVAL);
+ }
+
+ index = cadr(settee);
+ if (!is_pair(index))
+ {
+ if (is_symbol(index))
+ index = find_symbol_checked(sc, index);
+
+ val = cadr(sc->code);
+ if (!is_pair(val))
+ {
+ if (is_symbol(val))
+ val = find_symbol_checked(sc, val);
+ car(sc->T2_1) = index;
+ car(sc->T2_2) = val;
+ sc->value = (*(c_object_set(cx)))(sc, cx, sc->T2_1);
+ return(goto_START);
+ }
+ push_op_stack(sc, sc->Object_Set);
+ sc->args = list_2(sc, index, cx);
+ sc->code = cdr(sc->code);
+ return(goto_EVAL_ARGS);
+ }
+ else
+ {
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code));
+ push_op_stack(sc, sc->Object_Set);
+ sc->code = cadr(settee);
+ }
+ return(goto_EVAL);
+ }
+ break;
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ {
+ /* cx is the vector, sc->code is expr without the set! */
+ /* args have not been evaluated! */
+
+ s7_pointer settee, index, val;
+
+ if (is_null(cdr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "no value for vector-set!: ~S", sc->code);
+ if (!is_null(cddr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "too many values for vector-set!: ~S", sc->code);
+
+ settee = car(sc->code);
+ if (is_null(cdr(settee)))
+ s7_wrong_number_of_args_error(sc, "no index for vector-set!: ~S", sc->code);
+
+ if ((!is_null(cddr(settee))) &&
+ (type(cx) == T_VECTOR))
+ {
+ push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code));
+ sc->code = list_2(sc, car(settee), cadr(settee));
+ return(goto_EVAL);
+ }
+
+ if ((!is_null(cddr(settee))) ||
+ (vector_rank(cx) > 1))
+ {
+ /* multi-index case -- use slow version */
+ push_op_stack(sc, sc->Vector_Set);
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code)));
+ sc->code = cadr(settee);
+ return(goto_EVAL);
+ }
+
+ index = cadr(settee);
+ if (!is_pair(index))
+ {
+ s7_int ind;
+
+ if (is_symbol(index))
+ index = find_symbol_checked(sc, index);
+ if (!s7_is_integer(index))
+ eval_error_no_return(sc, sc->WRONG_TYPE_ARG, "vector-set!: index must be an integer: ~S", sc->code);
+ ind = s7_integer(index);
+ if ((ind < 0) ||
+ (ind >= vector_length(cx)))
+ out_of_range(sc, sc->VECTOR_SET, small_int(2), index, (ind < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ val = cadr(sc->code);
+ if (!is_pair(val))
+ {
+ if (is_symbol(val))
+ val = find_symbol_checked(sc, val);
+ vector_setter(cx)(sc, cx, ind, val);
+ sc->value = _NFre(val);
+ return(goto_START);
+ }
+ push_op_stack(sc, sc->Vector_Set);
+ sc->args = list_2(sc, index, cx);
+ sc->code = cdr(sc->code);
+ return(goto_EVAL_ARGS);
+ }
+ else
+ {
+ /* here the index calc might be trivial -- (+ i 1) or (- j 1) but this branch hardly ever happens
+ */
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code));
+ push_op_stack(sc, sc->Vector_Set);
+ sc->code = cadr(settee);
+ }
+ }
+ break;
+
+ case T_STRING:
+ {
+ /* sc->code = cons(sc, sc->String_Set, s7_append(sc, car(sc->code), cdr(sc->code)));
+ *
+ * here only one index makes sense, and it is required, so
+ * (set! ("str") #\a), (set! ("str" . 1) #\a) and (set! ("str" 1 2) #\a)
+ * are all errors (but see below!).
+ */
+ s7_pointer settee, index, val;
+
+ if (is_null(cdr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "no value for string-set!: ~S", sc->code);
+ if (!is_null(cddr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "too many values for string-set!: ~S", sc->code);
+
+ settee = car(sc->code);
+ if (is_null(cdr(settee))) /* there's an index: (set! (str i) #\a), code is ((str 0) #\1) */
+ s7_wrong_number_of_args_error(sc, "no index for string-set!: ~S", sc->code);
+ if (!is_null(cddr(settee)))
+ s7_wrong_number_of_args_error(sc, "too many indices for string-set!: ~S", sc->code);
+
+ /* if there's one index (the standard case), and it is not a pair, and there's one value (also standard)
+ * and it is not a pair, let's optimize this thing!
+ * cx is what we're setting, cadar is the index, cadr is the new value
+ */
+ index = cadr(settee);
+ if (!is_pair(index))
+ {
+ s7_int ind;
+
+ if (is_symbol(index))
+ index = find_symbol_checked(sc, index);
+ if (!s7_is_integer(index))
+ eval_error_no_return(sc, sc->WRONG_TYPE_ARG, "string-set!: index must be an integer: ~S", sc->code);
+ ind = s7_integer(index);
+ if ((ind < 0) ||
+ (ind >= string_length(cx)))
+ out_of_range(sc, sc->STRING_SET, small_int(2), index, (ind < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+
+ val = cadr(sc->code);
+ if (!is_pair(val))
+ {
+ if (is_symbol(val))
+ val = find_symbol_checked(sc, val);
+ if (s7_is_character(val))
+ {
+ string_value(cx)[ind] = character(val);
+ sc->value = val;
+ return(goto_START);
+ }
+ else
+ {
+ if ((is_byte_vector(cx)) &&
+ (s7_is_integer(val)))
+ {
+ int ic;
+ ic = s7_integer(val);
+ if ((ic < 0) || (ic > 255))
+ eval_error_no_return(sc, sc->WRONG_TYPE_ARG, "string-set!: value must be a character: ~S", sc->code);
+ string_value(cx)[ind] = (char)ic;
+ sc->value = val;
+ return(goto_START);
+ }
+ }
+ eval_error_no_return(sc, sc->WRONG_TYPE_ARG, "string-set!: value must be a character: ~S", sc->code);
+ }
+ push_op_stack(sc, sc->String_Set);
+ sc->args = list_2(sc, index, cx);
+ sc->code = cdr(sc->code);
+ return(goto_EVAL_ARGS);
+ }
+ else
+ {
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code));
+ push_op_stack(sc, sc->String_Set);
+ sc->code = cadar(sc->code);
+ }
+ }
+ break;
+
+ case T_PAIR:
+ /* code: ((lst 1) 32) from (let ((lst '(1 2 3))) (set! (lst 1) 32)) */
+ {
+ s7_pointer settee, index, val;
+
+ if (is_null(cdr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "no value for list-set!: ~S", sc->code);
+ if (!is_null(cddr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "too many values for list-set!: ~S", sc->code);
+
+ settee = car(sc->code);
+ if (is_null(cdr(settee)))
+ s7_wrong_number_of_args_error(sc, "no index for list-set!: ~S", sc->code);
+
+ if (!is_null(cddr(settee)))
+ {
+ /* split (set! (a b c...) v) into (set! ((a b) c ...) v), eval (a b), return
+ * (let ((L (list (list 1 2)))) (set! (L 0 0) 3) L)
+ */
+ push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code));
+ sc->code = list_2(sc, car(settee), cadr(settee));
+ return(goto_EVAL);
+ }
+
+ index = cadr(settee);
+ val = cadr(sc->code);
+
+ if ((is_pair(index)) ||
+ (is_pair(val)))
+ {
+ push_op_stack(sc, sc->List_Set);
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), s7_append(sc, cddr(settee), cdr(sc->code)));
+ sc->code = index;
+ return(goto_EVAL);
+ }
+
+ if (is_symbol(index))
+ index = find_symbol_checked(sc, index);
+ if (is_symbol(val))
+ val = find_symbol_checked(sc, val);
+
+ car(sc->T2_1) = index;
+ car(sc->T2_2) = val;
+ sc->value = g_list_set_1(sc, cx, sc->T2_1, 2);
+ return(goto_START);
+ }
+ break;
+
+
+ case T_HASH_TABLE:
+ {
+ s7_pointer settee, key;
+
+ if (is_null(cdr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "no value for hash-table-set!: ~S", sc->code);
+ if (!is_null(cddr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "too many values for hash-table-set!: ~S", sc->code);
+
+ settee = car(sc->code);
+ if (is_null(cdr(settee)))
+ s7_wrong_number_of_args_error(sc, "no key for hash-table-set!: ~S", sc->code);
+
+ if (!is_null(cddr(settee)))
+ {
+ push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code));
+ sc->code = list_2(sc, car(settee), cadr(settee));
+ return(goto_EVAL);
+ }
+
+ key = cadr(settee);
+ if (!is_pair(key))
+ {
+ s7_pointer val;
+ if (is_symbol(key))
+ key = find_symbol_checked(sc, key);
+ val = cadr(sc->code);
+ if (!is_pair(val))
+ {
+ if (is_symbol(val))
+ val = find_symbol_checked(sc, val);
+ sc->value = s7_hash_table_set(sc, cx, key, val);
+ return(goto_START);
+ }
+ push_op_stack(sc, sc->Hash_Table_Set);
+ sc->args = list_2(sc, key, cx);
+ sc->code = cdr(sc->code);
+ return(goto_EVAL_ARGS);
+ }
+ else
+ {
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code));
+ push_op_stack(sc, sc->Hash_Table_Set);
+ sc->code = cadar(sc->code);
+ }
+ }
+ break;
+
+
+ case T_LET:
+ /* sc->code = cons(sc, sc->Let_Set, s7_append(sc, car(sc->code), cdr(sc->code))); */
+ {
+ s7_pointer settee, key;
+ /* code: ((gen 'input) input) from (set! (gen 'input) input)
+ */
+
+ if (is_null(cdr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "no value for let-set!: ~S", sc->code);
+ if (!is_null(cddr(sc->code)))
+ s7_wrong_number_of_args_error(sc, "too many values for let-set!: ~S", sc->code);
+
+ settee = car(sc->code);
+ if (is_null(cdr(settee)))
+ s7_wrong_number_of_args_error(sc, "no identifier for let-set!: ~S", sc->code);
+
+ if (!is_null(cddr(settee)))
+ {
+ push_stack(sc, OP_SET2, cddr(settee), cdr(sc->code));
+ sc->code = list_2(sc, car(settee), cadr(settee));
+ return(goto_EVAL);
+ }
+
+ key = cadr(settee);
+ if ((is_pair(key)) &&
+ (car(key) == sc->QUOTE))
+ {
+ s7_pointer val;
+ key = cadr(key);
+ val = cadr(sc->code);
+ if (!is_pair(val))
+ {
+ if (is_symbol(val))
+ val = find_symbol_checked(sc, val);
+ sc->value = s7_let_set(sc, cx, key, val);
+ return(goto_START);
+ }
+ push_op_stack(sc, sc->Let_Set);
+ sc->args = list_2(sc, key, cx);
+ sc->code = cdr(sc->code);
+ return(goto_EVAL_ARGS);
+ }
+ else
+ {
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, cx), cdr(sc->code));
+ push_op_stack(sc, sc->Let_Set);
+ sc->code = cadar(sc->code);
+ }
+ }
+ break;
+
+
+ case T_C_MACRO:
+ case T_C_OPT_ARGS_FUNCTION:
+ case T_C_RST_ARGS_FUNCTION:
+ case T_C_ANY_ARGS_FUNCTION: /* (let ((lst (list 1 2))) (set! (list-ref lst 0) 2) lst) */
+ case T_C_FUNCTION:
+ case T_C_FUNCTION_STAR:
+ /* perhaps it has a setter */
+ if (is_procedure(c_function_setter(cx)))
+ {
+ /* sc->code = cons(sc, c_function_setter(cx), s7_append(sc, cdar(sc->code), cdr(sc->code))); */
+ if (is_pair(cdar(sc->code)))
+ {
+ if ((is_symbol(cadr(sc->code))) &&
+ (is_symbol(cadar(sc->code))))
+ {
+ if (is_null(cddar(sc->code)))
+ {
+ car(sc->T2_1) = find_symbol_checked(sc, cadar(sc->code));
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(sc->code));
+ sc->args = sc->T2_1;
+ sc->code = c_function_setter(cx);
+ return(goto_APPLY); /* check arg num etc */
+ }
+ if ((is_symbol(caddar(sc->code))) &&
+ (is_null(cdddar(sc->code))))
+ {
+ car(sc->T3_1) = find_symbol_checked(sc, cadar(sc->code));
+ car(sc->T3_2) = find_symbol_checked(sc, caddar(sc->code));
+ car(sc->T3_3) = find_symbol_checked(sc, cadr(sc->code));
+ sc->args = sc->T3_1;
+ sc->code = c_function_setter(cx);
+ return(goto_APPLY); /* check arg num etc */
+ }
+ }
+
+ push_op_stack(sc, c_function_setter(cx));
+ push_stack(sc, OP_EVAL_ARGS1, sc->NIL, s7_append(sc, cddar(sc->code), cdr(sc->code)));
+ sc->code = cadar(sc->code);
+ }
+ else
+ {
+ if ((is_null(cddr(sc->code))) &&
+ (!is_pair(cadr(sc->code))))
+ {
+ if (is_symbol(cadr(sc->code)))
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(sc->code));
+ else car(sc->T1_1) = cadr(sc->code);
+ sc->args = sc->T1_1;
+ sc->code = c_function_setter(cx);
+ return(goto_APPLY); /* check arg num etc */
+ }
+ push_op_stack(sc, c_function_setter(cx));
+ push_stack(sc, OP_EVAL_ARGS1, sc->NIL, cddr(sc->code));
+ sc->code = cadr(sc->code);
+ }
+ }
+ else
+ {
+ if (is_any_macro(c_function_setter(cx)))
+ {
+ if (is_null(cdar(sc->code)))
+ sc->args = copy_list(sc, cdr(sc->code));
+ else sc->args = s7_append(sc, cdar(sc->code), copy_list(sc, cdr(sc->code)));
+ /* append copies except for its last arg, but for macros, we have to copy everything, hence the extra copy_list */
+ sc->code = c_function_setter(cx);
+ return(goto_APPLY);
+ }
+ else eval_error_no_return(sc, sc->SYNTAX_ERROR, "no generalized set for ~A", caar_code);
+ }
+ break;
+
+ case T_MACRO: case T_MACRO_STAR:
+ case T_BACRO: case T_BACRO_STAR:
+ case T_CLOSURE: case T_CLOSURE_STAR:
+ {
+ s7_pointer setter;
+ setter = closure_setter(cx);
+ if (is_procedure(setter)) /* appears to be caar_code */
+ {
+ /* (set! (o g) ...), here cx = o, sc->code = ((o g) ...) */
+ push_op_stack(sc, setter);
+ if (is_null(cdar(sc->code)))
+ {
+ push_stack(sc, OP_EVAL_ARGS1, sc->NIL, cddr(sc->code));
+ sc->code = cadr(sc->code);
+ }
+ else
+ {
+ if (is_null(cddar(sc->code)))
+ push_stack(sc, OP_EVAL_ARGS1, sc->NIL, cdr(sc->code));
+ else push_stack(sc, OP_EVAL_ARGS1, sc->NIL, s7_append(sc, cddar(sc->code), cdr(sc->code)));
+ sc->code = cadar(sc->code);
+ }
+ }
+ else
+ {
+ if (is_any_macro(setter))
+ {
+ if (is_null(cdar(sc->code)))
+ sc->args = copy_list(sc, cdr(sc->code));
+ else sc->args = s7_append(sc, cdar(sc->code), copy_list(sc, cdr(sc->code)));
+ sc->code = setter;
+ return(goto_APPLY);
+ }
+ else eval_error_no_return(sc, sc->SYNTAX_ERROR, "no generalized set for ~A", caar_code);
+ }
+ }
+ break;
+
+ case T_ITERATOR: /* not sure this makes sense */
+ {
+ s7_pointer setter;
+ setter = iterator_sequence(cx);
+ if ((is_any_closure(setter)) || (is_any_macro(setter)))
+ setter = closure_setter(iterator_sequence(cx));
+ else setter = sc->F;
+ if (is_procedure(setter))
+ {
+ push_op_stack(sc, setter);
+ push_stack(sc, OP_EVAL_ARGS1, sc->NIL, sc->NIL);
+ sc->code = cadr(sc->code); /* the (as yet unevaluated) value, incoming code was ((obj) val) */
+ }
+ else
+ {
+ if (is_any_macro(setter))
+ {
+ sc->args = list_1(sc, cadr(sc->code));
+ sc->code = setter;
+ return(goto_APPLY);
+ }
+ else eval_error_no_return(sc, sc->SYNTAX_ERROR, "no generalized set for ~A", caar_code);
+ }
+ }
+ break;
+
+ default: /* (set! (1 2) 3) */
+ eval_error_no_return(sc, sc->SYNTAX_ERROR, "no generalized set for ~A", caar_code);
+ }
+ return(goto_EVAL);
+}
+
+
+static bool tree_match(s7_scheme *sc, s7_pointer tree)
+{
+ if (is_symbol(tree))
+ return(is_matched_symbol(tree));
+ if (is_pair(tree))
+ return((tree_match(sc, car(tree))) || (tree_match(sc, cdr(tree))));
+ return(false);
+}
+
+
+static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_pointer var_list, bool *has_set)
+{
+ /* here any (unsafe?) closure or jumping-op (call/cc) or shadowed variable is trouble */
+ s7_pointer p;
+
+ for (p = body; is_pair(p); p = cdr(p))
+ {
+ s7_pointer expr;
+ expr = car(p);
+ if (is_pair(expr))
+ {
+ s7_pointer x;
+ x = car(expr);
+ if (is_symbol(x))
+ {
+ if (is_syntactic(x))
+ {
+ opcode_t op;
+ s7_pointer func, vars;
+ func = slot_value(global_slot(x));
+ op = (opcode_t)syntax_opcode(func);
+ switch (op)
+ {
+ case OP_MACROEXPAND:
+ return(false);
+
+ case OP_QUOTE:
+ break;
+
+ case OP_LET:
+ case OP_LET_STAR:
+ if (is_symbol(cadr(expr)))
+ return(false);
+
+ case OP_LETREC:
+ case OP_LETREC_STAR:
+ case OP_DO:
+ for (vars = cadr(expr); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer var;
+ var = caar(vars);
+ if ((direct_memq(var, var_list)) ||
+ (direct_memq(var, steppers)))
+ return(false);
+
+ var_list = cons(sc, var, var_list);
+ sc->x = var_list;
+ if ((is_pair(cdar(vars))) &&
+ (!do_is_safe(sc, cdar(vars), steppers, var_list, has_set)))
+ {
+ sc->x = sc->NIL;
+ return(false);
+ }
+ sc->x = sc->NIL;
+ }
+ if (op == OP_DO)
+ {
+ /* set_unsafe_do(cdr(expr)); */
+ if (!do_is_safe(sc, (op == OP_DO) ? cdddr(expr) : cddr(expr), steppers, var_list, has_set))
+ return(false);
+ }
+ else
+ {
+ if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set))
+ return(false);
+ }
+ break;
+
+ case OP_SET:
+ {
+ s7_pointer settee;
+ settee = cadr(expr);
+ if (!is_symbol(settee)) /* (set! (...) ...) which is tricky due to setter functions/macros */
+ {
+ s7_pointer setv;
+ if ((!is_pair(settee)) ||
+ (!is_symbol(car(settee))))
+ return(false);
+ setv = find_symbol_unchecked(sc, car(settee));
+ if (!((setv) &&
+ ((is_sequence(setv)) ||
+ ((is_c_function(setv)) &&
+ (is_safe_procedure(c_function_setter(setv)))))))
+ return(false);
+ (*has_set) = true;
+ }
+ else
+ {
+ if ((is_pair(cadr(sc->code))) &&
+ (is_pair(caadr(sc->code))))
+ {
+ bool res;
+ set_match_symbol(settee);
+ res = tree_match(sc, caadr(sc->code)); /* (set! end ...) in some fashion */
+ clear_match_symbol(settee);
+ if (res) return(false);
+ }
+
+ if (!direct_memq(cadr(expr), var_list)) /* is some non-local variable being set? */
+ (*has_set) = true;
+ }
+ if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set))
+ return(false);
+ if (!safe_stepper(sc, expr, steppers)) /* is step var's value used as the stored value by set!? */
+ return(false);
+ }
+ break;
+
+ case OP_IF:
+ case OP_WHEN:
+ case OP_UNLESS:
+ case OP_COND:
+ case OP_CASE:
+ case OP_AND:
+ case OP_OR:
+ case OP_BEGIN:
+ if (!do_is_safe(sc, cdr(expr), steppers, var_list, has_set))
+ return(false);
+ break;
+
+ case OP_WITH_LET:
+ return(true);
+
+ default:
+ return(false);
+ }
+ }
+ else
+ {
+ if ((!is_optimized(expr)) ||
+ (is_unsafe(expr)) ||
+ (!do_is_safe(sc, cdr(expr), steppers, var_list, has_set)))
+ /* this is unreasonably retrictive because optimize_expression returns "unsafe"
+ * even when everything is safe -- it's merely saying it could not find a
+ * special optimization case for the expression.
+ */
+ return(false);
+ else
+ {
+ if (is_setter(x)) /* "setter" includes stuff like cons and vector -- x is a symbol */
+ {
+ /* (hash-table-set! ht i 0) -- caddr is being saved, so this is not safe
+ * similarly (vector-set! v 0 i) etc
+ */
+ if (!direct_memq(cadr(expr), var_list)) /* non-local is being changed */
+ {
+ if ((direct_memq(cadr(expr), steppers)) || /* stepper is being set? */
+ (!is_pair(cddr(expr))) ||
+ (!is_pair(cdddr(expr))) ||
+ (is_pair(cddddr(expr))) ||
+ ((x == sc->HASH_TABLE_SET) &&
+ (is_symbol(caddr(expr))) &&
+ (direct_memq(caddr(expr), steppers))) ||
+ ((is_symbol(cadddr(expr))) &&
+ (direct_memq(cadddr(expr), steppers))) ||
+ (is_pair(cadddr(expr))))
+ (*has_set) = true;
+ }
+ if (!do_is_safe(sc, cddr(expr), steppers, var_list, has_set))
+ return(false);
+ if (!safe_stepper(sc, expr, steppers))
+ return(false);
+ }
+ }
+ }
+ }
+ else
+ {
+ return(false);
+ /* car(expr) ("x") is not a symbol: ((mus-data loc) chan) for example
+ * but that's actually safe since it's just in effect vector-ref
+ * there are several examples in dlocsig: ((group-speakers group) i) etc
+ */
+ }
+ }
+ }
+ return(true);
+}
+
+static bool preserves_type(s7_scheme *sc, unsigned int x)
+{
+ return((x == sc->add_class) ||
+ (x == sc->subtract_class) ||
+ (x == sc->multiply_class));
+}
+
+
+static s7_pointer check_do(s7_scheme *sc)
+{
+ s7_pointer x;
+
+ /* fprintf(stderr, "check_do: %s\n", DISPLAY(sc->code)); */
+
+ if ((!is_pair(sc->code)) || /* (do . 1) */
+ ((!is_pair(car(sc->code))) && /* (do 123) */
+ (is_not_null(car(sc->code))))) /* (do () ...) is ok */
+ eval_error(sc, "do: var list is not a list: ~S", sc->code);
+
+ if (!is_pair(cdr(sc->code))) /* (do () . 1) */
+ eval_error(sc, "do body is messed up: ~A", sc->code);
+
+ if ((!is_pair(cadr(sc->code))) && /* (do ((i 0)) 123) */
+ (is_not_null(cadr(sc->code)))) /* no end-test? */
+ eval_error(sc, "do: end-test and end-value list is not a list: ~A", sc->code);
+
+ if (is_pair(car(sc->code)))
+ {
+ for (x = car(sc->code); is_pair(x); x = cdr(x))
+ {
+ if (!(is_pair(car(x)))) /* (do (4) (= 3)) */
+ eval_error(sc, "do: variable name missing? ~A", sc->code);
+
+ if (!is_symbol(caar(x))) /* (do ((3 2)) ()) */
+ eval_error(sc, "do step variable: ~S is not a symbol?", x);
+
+ if (is_immutable_symbol(caar(x))) /* (do ((pi 3 (+ pi 1))) ((= pi 4)) pi) */
+ eval_error(sc, "do step variable: ~S is immutable", x);
+
+ if (is_pair(cdar(x)))
+ {
+ if ((!is_pair(cddar(x))) &&
+ (is_not_null(cddar(x)))) /* (do ((i 0 . 1)) ...) */
+ eval_error(sc, "do: step variable info is an improper list?: ~A", sc->code);
+
+ if ((is_pair(cddar(x))) &&
+ (is_not_null(cdr(cddar(x))))) /* (do ((i 0 1 (+ i 1))) ...) */
+ eval_error(sc, "do: step variable info has extra stuff after the increment: ~A", sc->code);
+ }
+ else eval_error(sc, "do: step variable has no initial value: ~A", x);
+ set_local(caar(x));
+
+ /* (do ((i)) ...) */
+ }
+ if (is_not_null(x)) /* (do ((i 0 i) . 1) ((= i 1))) */
+ eval_error(sc, "do: list of variables is improper: ~A", sc->code);
+ }
+
+ if (is_pair(cadr(sc->code)))
+ {
+ for (x = cadr(sc->code); is_pair(x); x = cdr(x));
+ if (is_not_null(x))
+ eval_error(sc, "stray dot in do end section? ~A", sc->code);
+ }
+
+ for (x = cddr(sc->code); is_pair(x); x = cdr(x));
+ if (is_not_null(x))
+ eval_error(sc, "stray dot in do body? ~A", sc->code);
+
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ {
+ s7_pointer vars, end, body;
+ bool one_line;
+
+ vars = car(sc->code);
+ end = cadr(sc->code);
+ body = cddr(sc->code);
+
+ one_line = ((safe_list_length(sc, body) == 1) && (is_pair(car(body))));
+ pair_set_syntax_symbol(sc->code, sc->DO_UNCHECKED);
+
+ /* (define (hi) (do ((i 0 (+ i 1))) ((= i 3)) (display i)) (newline)) */
+ /* (define (hi) (do ((i 1.5 (+ i 1))) ((= i 2.5)) (display i) (newline)))
+ * in OP_SAFE_DOTIMES, for example, if init value is not an integer, it goes to OP_SIMPLE_DO
+ * remaining optimizable cases: we can step by 1 and use = for end, and yet simple_do(_p) calls the functions
+ * geq happens as often as =, and -1 as step
+ * also cdr as step to is_null as end
+ * also what about no do-var cases? (do () ...)
+ *
+ * also do body is optimized expr: vector_set_3 via hop_safe_c_sss for example or (vset v i (vref w i))
+ */
+ if ((is_pair(end)) && (is_pair(car(end))) &&
+ (is_pair(vars)) && (is_null(cdr(vars))) &&
+ (is_pair(body)))
+ {
+ /* loop has one step variable, and normal-looking end test
+ */
+ vars = car(vars);
+ if ((safe_list_length(sc, vars) == 3) &&
+ ((!is_pair(cadr(vars))) ||
+ (is_h_safe_c_c(cadr(vars)))))
+ {
+ s7_pointer step_expr;
+ step_expr = caddr(vars);
+
+ if ((is_optimized(step_expr)) &&
+ (((optimize_op(step_expr) == HOP_SAFE_C_SC) && (car(vars) == cadr(step_expr))) ||
+ ((optimize_op(step_expr) == HOP_SAFE_C_C) && (car(vars) == cadr(step_expr)) &&
+ ((opt_cfunc(step_expr) == add_cs1) || (opt_cfunc(step_expr) == subtract_cs1))) ||
+ ((optimize_op(step_expr) == HOP_SAFE_C_CS) && (car(vars) == caddr(step_expr)))))
+ {
+ /* step var is (var const|symbol (op var const)|(op const var))
+ */
+ end = car(end);
+
+ if ((is_optimized(end)) &&
+ (car(vars) == cadr(end)) &&
+ (cadr(end) != caddr(end)) &&
+ ((opt_any1(end) == equal_s_ic) ||
+ (optimize_op(end) == HOP_SAFE_C_SS) ||
+ (optimize_op(end) == HOP_SAFE_C_SC)))
+ {
+ /* end var is (op var const|symbol) using same var as step
+ * so at least we can use SIMPLE_DO
+ */
+ bool has_set = false;
+
+ if (opt_cfunc(step_expr) == add_cs1)
+ {
+ set_c_function(step_expr, add_s1);
+ set_optimize_op(step_expr, HOP_SAFE_C_SC);
+ }
+ if (opt_cfunc(step_expr) == subtract_cs1)
+ {
+ set_c_function(step_expr, subtract_s1);
+ set_optimize_op(step_expr, HOP_SAFE_C_SC);
+ }
+ if (opt_cfunc(end) == equal_s_ic)
+ {
+ set_c_function(end, equal_2);
+ set_optimize_op(end, HOP_SAFE_C_SC);
+ }
+
+ if ((opt_cfunc(step_expr) == add_s1) &&
+ (opt_cfunc(end) == equal_2) &&
+ (s7_is_integer(caddr(step_expr))) &&
+ (s7_integer(caddr(step_expr)) == 1))
+ {
+ pair_set_syntax_symbol(sc->code, sc->SIMPLE_DO_A);
+ if ((one_line) &&
+ (is_optimized(car(body))))
+ pair_set_syntax_symbol(sc->code, sc->SIMPLE_DO_E);
+ }
+ else pair_set_syntax_symbol(sc->code, sc->SIMPLE_DO);
+
+ if ((one_line) &&
+ ((!is_optimized(car(body))) || (op_no_hop(car(body)) != OP_SAFE_C_C)) &&
+ (is_syntactic_symbol(caar(body))))
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ pair_set_syntax_symbol(sc->code, sc->SIMPLE_DO_P);
+ set_opt_pair2(sc->code, caddr(caar(sc->code)));
+
+ if ((s7_is_integer(caddr(step_expr))) &&
+ (s7_integer(caddr(step_expr)) == 1) &&
+ (c_function_class(opt_cfunc(step_expr)) == sc->add_class) &&
+ /* we check above that (car(vars) == cadr(step_expr))
+ * and that (car(vars) == cadr(end))
+ */
+ ((c_function_class(opt_cfunc(end)) == sc->equal_class) ||
+ (opt_cfunc(end) == geq_2)))
+ pair_set_syntax_symbol(sc->code, sc->DOTIMES_P);
+ }
+
+ if (do_is_safe(sc, body, sc->w = list_1(sc, car(vars)), sc->NIL, &has_set))
+ {
+ /* now look for the very common dotimes case
+ */
+ if ((((s7_is_integer(caddr(step_expr))) &&
+ (s7_integer(caddr(step_expr)) == 1)) ||
+ ((s7_is_integer(cadr(step_expr))) &&
+ (s7_integer(cadr(step_expr)) == 1))) &&
+ (c_function_class(opt_cfunc(step_expr)) == sc->add_class) &&
+ ((c_function_class(opt_cfunc(end)) == sc->equal_class) ||
+ (opt_cfunc(end) == geq_2))
+ )
+ {
+ /* we're stepping by +1 and going to =
+ * the final integer check has to wait until run time (symbol value dependent)
+ */
+ pair_set_syntax_symbol(sc->code, sc->SAFE_DO);
+ if ((!has_set) &&
+ (c_function_class(opt_cfunc(end)) == sc->equal_class))
+ pair_set_syntax_symbol(sc->code, sc->SAFE_DOTIMES);
+ }
+ }
+ return(sc->NIL);
+ }
+ }
+ }
+ }
+
+ /* we get here if there is more than one local var or anything "non-simple" about the rest
+ */
+ /* (define (hi) (do ((i 0 (+ i 1))) ((= i 3)) (display i)) (newline))
+ * (define (hi) (do ((i 0 (+ i 1)) (j 1 (+ j 1))) ((= i 3)) (display j))(newline))
+ */
+ vars = car(sc->code);
+ end = cadr(sc->code);
+
+ /* check end expression first */
+ if ((is_pair(car(end))) &&
+ (caar(end) != sc->QUOTE) &&
+ (is_optimized(car(end))) &&
+ (is_all_x_safe(sc, car(end))))
+ set_c_call(cdr(sc->code), all_x_eval(sc, car(end), sc->envir, let_symbol_is_safe));
+ else return(sc->code);
+
+ /* vars can be nil (no steppers) */
+ if (is_pair(vars))
+ {
+ s7_pointer p;
+ for (p = vars; is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+
+ if ((!is_all_x_safe(sc, cadr(var))) ||
+ ((is_pair(cddr(var))) &&
+ (!is_all_x_safe(sc, caddr(var)))))
+ {
+ s7_pointer q;
+ for (q = vars; q != p; q = cdr(q))
+ clear_match_symbol(caar(q));
+ return(sc->code);
+ }
+ set_match_symbol(car(var));
+ }
+ /* we want to use the pending_value slot for other purposes, so make sure
+ * the current val is not referred to in any trailing step exprs. The inits
+ * are ok because at init-time, the new frame is not connected.
+ * another tricky case: current var might be used in previous step expr(!)
+ */
+ for (p = vars; is_pair(p); p = cdr(p))
+ {
+ s7_pointer var, val;
+ var = car(p);
+ val = cddr(var);
+ if (is_pair(val))
+ {
+ var = car(var);
+ clear_match_symbol(var); /* ignore current var */
+ if (tree_match(sc, car(val)))
+ {
+ s7_pointer q;
+ for (q = vars; is_pair(q); q = cdr(q))
+ clear_match_symbol(caar(q));
+ return(sc->code);
+ }
+ set_match_symbol(var);
+ }
+ }
+ for (p = vars; is_pair(p); p = cdr(p))
+ clear_match_symbol(caar(p));
+ }
+
+ /* end and steps look ok! */
+ pair_set_syntax_symbol(sc->code, sc->DOX);
+ set_opt_pair2(sc->code, car(end)); /* end expr */
+
+ /* each step expr is safe so not an explicit set!
+ * the symbol_is_safe check in all_x_eval needs to see the do envir, not the caller's
+ * but that means the is_all_x_safe check above also needs to use the local env?
+ */
+ if (is_pair(vars))
+ {
+ s7_pointer p;
+ for (p = vars; is_pair(p); p = cdr(p))
+ {
+ s7_pointer var;
+ var = car(p);
+ if (is_pair(cdr(var)))
+ set_c_call(cdr(var), all_x_eval(sc, cadr(var), sc->envir, let_symbol_is_safe)); /* init val */
+ if (is_pair(cddr(var)))
+ {
+ s7_pointer step_expr;
+ step_expr = caddr(var);
+ set_c_call(cddr(var), all_x_eval(sc, step_expr, vars, do_symbol_is_safe)); /* sets opt2(cddr(var)), not opt1 */
+ if ((is_pair(step_expr)) &&
+ (car(step_expr) != sc->QUOTE) && /* opt_cfunc(==opt1) might not be set in this case (sigh) */
+ (preserves_type(sc, c_function_class(opt_cfunc(step_expr)))))
+ set_safe_stepper(cddr(var));
+ }
+ }
+ }
+ /* there are only a couple of cases in snd-test where a multi-statement do body is completely all-x-able */
+ return(sc->NIL);
+ }
+ return(sc->code);
+}
+
+static bool dox_pf_ok(s7_scheme *sc, s7_pointer code, s7_pointer scc, s7_function endf, bool all_pairs)
+{
+ s7_pointer p, endp;
+ int body_len, i;
+ s7_pf_t pf;
+
+ endp = caadr(scc);
+ body_len = s7_list_length(sc, code);
+
+ s7_xf_new(sc, sc->envir);
+ for (i = 0, p = code; is_pair(p); i++, p = cdr(p))
+ if ((!is_symbol(caar(p))) ||
+ (!xf_opt(sc, car(p))))
+ break;
+
+ if ((is_null(p)) &&
+ (pf = xf_opt(sc, endp)))
+ {
+ s7_pointer slots;
+ s7_pointer *top;
+
+ slots = let_slots(sc->envir);
+ top = sc->cur_rf->data;
+
+ if ((all_pairs) && (body_len == 1))
+ {
+ s7_rf_t rf;
+ rf = (s7_rf_t)(*top);
+ top++;
+ while (true)
+ {
+ s7_pointer slot;
+ s7_pointer *temp;
+ s7_pointer **rp;
+
+ temp = top;
+ rp = &temp;
+ rf(sc, rp);
+
+ for (slot = slots; is_slot(slot); slot = next_slot(slot))
+ if (is_pair(slot_expression(slot)))
+ slot_pending_value(slot) = c_call(slot_expression(slot))(sc, car(slot_expression(slot)));
+ for (slot = slots; is_slot(slot); slot = next_slot(slot))
+ if (is_pair(slot_expression(slot)))
+ slot_set_value(slot, slot_pending_value(slot));
+
+ (*rp)++;
+ if (is_true(sc, pf(sc, rp)))
+ {
+ s7_xf_free(sc);
+ sc->code = cdadr(scc);
+ return(true);
+ }
+ }
+ }
+ else
+ {
+ while (true)
+ {
+ s7_pointer slot;
+ s7_pointer *temp;
+ s7_pointer **rp;
+
+ temp = top;
+ rp = &temp;
+
+ for (i = 0; i < body_len; i++)
+ {
+ s7_rf_t rf;
+ rf = (s7_rf_t)(**rp); (*rp)++;
+ rf(sc, rp);
+ }
+
+ for (slot = slots; is_slot(slot); slot = next_slot(slot))
+ if (is_pair(slot_expression(slot)))
+ slot_pending_value(slot) = c_call(slot_expression(slot))(sc, car(slot_expression(slot)));
+ for (slot = slots; is_slot(slot); slot = next_slot(slot))
+ if (is_pair(slot_expression(slot)))
+ slot_set_value(slot, slot_pending_value(slot));
+
+ (*rp)++;
+ if (is_true(sc, pf(sc, rp)))
+ {
+ s7_xf_free(sc);
+ sc->code = cdadr(scc);
+ return(true);
+ }
+ }
+ }
+ }
+ s7_xf_free(sc);
+ return(false);
+}
+
+static int dox_ex(s7_scheme *sc)
+{
+ /* any number of steppers using dox exprs, end also dox, body and end result arbitrary.
+ * since all these exprs are local, we don't need to jump until the body
+ */
+ long long int id;
+ s7_pointer frame, vars, slot, code;
+ s7_function endf;
+ bool all_pairs = true;
+
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
+
+ new_frame(sc, sc->envir, frame); /* new frame is not tied into the symbol lookup process yet */
+ for (vars = car(sc->code); is_pair(vars); vars = cdr(vars))
+ {
+ s7_pointer expr, val;
+ expr = cadar(vars);
+ if (is_pair(expr))
+ {
+ if (car(expr) == sc->QUOTE)
+ val = cadr(expr);
+ else val = c_call(cdar(vars))(sc, expr);
+ }
+ else
+ {
+ if (is_symbol(expr))
+ val = find_symbol_checked(sc, expr);
+ else val = expr;
+ }
+ new_cell_no_check(sc, slot, T_SLOT);
+ slot_set_symbol(slot, caar(vars));
+ slot_set_value(slot, val);
+ set_stepper(slot);
+ slot_expression(slot) = cddar(vars);
+
+ if (is_pair(slot_expression(slot)))
+ {
+ if (is_safe_stepper(slot_expression(slot)))
+ {
+ s7_pointer step_expr;
+ step_expr = car(slot_expression(slot));
+ if ((is_pair(cddr(step_expr))) &&
+ (type(val) == type(caddr(step_expr))))
+ set_safe_stepper(slot);
+ }
+ }
+ else all_pairs = false;
+
+ next_slot(slot) = let_slots(frame);
+ let_set_slots(frame, slot);
+ }
+
+ sc->envir = frame;
+ id = let_id(frame);
+ for (slot = let_slots(frame); is_slot(slot); slot = next_slot(slot))
+ symbol_set_local(slot_symbol(slot), id, slot);
+
+ if (is_true(sc, c_call(cdr(sc->code))(sc, opt_pair2(sc->code))))
+ {
+ /* if no end result exprs, we return nil, but others probably #<unspecified>
+ * (let ((x (do ((i 0 (+ i 1))) (#t)))) x) -> ()
+ */
+ sc->code = cdadr(sc->code);
+ return(goto_DO_END_CLAUSES);
+ }
+
+ code = cddr(sc->code);
+ endf = c_callee(cdr(sc->code));
+
+ if (is_null(code)) /* no body? */
+ {
+ s7_pointer endp, slots, scc;
+ scc = sc->code;
+ endp = opt_pair2(sc->code);
+
+ if (endf == all_x_c_c)
+ {
+ endf = c_callee(endp);
+ endp = cdr(endp);
+ }
+
+ slots = let_slots(sc->envir);
+
+ if (!is_slot(slots))
+ {
+ while (!is_true(sc, endf(sc, endp)));
+ sc->code = cdadr(scc);
+ return(goto_DO_END_CLAUSES);
+ }
+
+ if ((is_null(next_slot(slots))) && (is_pair(slot_expression(slots))))
+ {
+ s7_function f;
+ s7_pointer a;
+
+ f = c_callee(slot_expression(slots));
+ a = car(slot_expression(slots));
+ if (f == all_x_c_c)
+ {
+ f = c_callee(a);
+ a = cdr(a);
+ }
+
+ while (true) /* thash titer */
+ {
+ slot_set_value(slots, f(sc, a));
+ if (is_true(sc, endf(sc, endp)))
+ {
+ sc->code = cdadr(scc);
+ return(goto_DO_END_CLAUSES);
+ }
+ }
+ }
+ else
+ {
+ while (true)
+ {
+ s7_pointer slt;
+ for (slt = slots; is_slot(slt); slt = next_slot(slt))
+ if (is_pair(slot_expression(slt)))
+ slot_set_value(slt, c_call(slot_expression(slt))(sc, car(slot_expression(slt))));
+ if (is_true(sc, endf(sc, endp)))
+ {
+ sc->code = cdadr(scc);
+ return(goto_DO_END_CLAUSES);
+ }
+ }
+ }
+ }
+
+ if ((!is_unsafe_do(sc->code)) &&
+ (dox_pf_ok(sc, code, sc->code, endf, all_pairs)))
+ return(goto_DO_END_CLAUSES);
+
+ /* fprintf(stderr, "dox: %s\n", DISPLAY(code)); */
+
+ set_unsafe_do(sc->code);
+ if ((is_null(cdr(code))) && /* one expr */
+ (is_pair(car(code))))
+ {
+ code = car(code);
+
+ if ((typesflag(code) == SYNTACTIC_PAIR) ||
+ (typesflag(car(code)) == SYNTACTIC_TYPE))
+ {
+ push_stack_no_args(sc, OP_DOX_STEP_P, sc->code);
+
+ if (typesflag(code) == SYNTACTIC_PAIR)
+ sc->op = (opcode_t)pair_syntax_op(code);
+ else
+ {
+ sc->op = (opcode_t)symbol_syntax_op(car(code));
+ pair_set_syntax_op(code, sc->op);
+ set_type(code, SYNTACTIC_PAIR);
+ }
+ sc->code = cdr(code);
+ return(goto_START_WITHOUT_POP_STACK);
+ }
+ }
+ return(fall_through);
+}
+
+
+static int simple_do_ex(s7_scheme *sc, s7_pointer code)
+{
+ s7_pointer body, step_expr, step_var, ctr, end;
+ s7_function stepf, endf;
+ s7_pf_t rf;
+
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
+
+ body = car(opt_pair2(code));
+ if (!is_symbol(car(body)))
+ return(fall_through);
+
+ step_expr = caddr(caar(code));
+ stepf = c_callee(step_expr);
+ endf = c_callee(caadr(code));
+ ctr = dox_slot1(sc->envir);
+ end = dox_slot2(sc->envir);
+ step_var = caddr(step_expr);
+
+#if (!WITH_GMP)
+ set_stepper(ctr);
+ if (((stepf == g_subtract_s1) && (endf == g_less_s0)) ||
+ ((stepf == g_add_s1) && (endf == g_equal_2))) /* add_s1 means (+ sym 1) */
+ set_safe_stepper(ctr);
+#endif
+ s7_xf_new(sc, sc->envir);
+ rf = xf_opt(sc, body);
+ if (rf)
+ {
+ s7_pointer *top;
+ /* fprintf(stderr, "ex: %s\n", DISPLAY(code)); */
+ top = sc->cur_rf->data;
+ top++;
+#if (!WITH_GMP)
+ if ((stepf == g_add_s1) && (endf == g_equal_2))
+ {
+ while (true)
+ {
+ s7_pointer *temp;
+ temp = top;
+ rf(sc, &temp);
+ slot_set_value(ctr, c_add_s1(sc, slot_value(ctr)));
+ if (is_true(sc, c_equal_2(sc, slot_value(ctr), slot_value(end))))
+ {
+ s7_xf_free(sc);
+ sc->code = cdr(cadr(code));
+ return(goto_DO_END_CLAUSES);
+ }
+ }
+ }
+#endif
+ while (true)
+ {
+ s7_pointer *temp;
+ temp = top;
+ rf(sc, &temp);
+
+ car(sc->T2_1) = slot_value(ctr);
+ car(sc->T2_2) = step_var;
+ slot_set_value(ctr, stepf(sc, sc->T2_1));
+
+ car(sc->T2_1) = slot_value(ctr);
+ car(sc->T2_2) = slot_value(end);
+ if (is_true(sc, endf(sc, sc->T2_1)))
+ {
+ s7_xf_free(sc);
+ sc->code = cdr(cadr(code));
+ return(goto_DO_END_CLAUSES);
+ }
+ }
+ }
+ s7_xf_free(sc);
+ return(fall_through);
+}
+
+static bool pf_ok(s7_scheme *sc, s7_pointer code, s7_pointer scc, bool safe_step)
+{
+ s7_pointer p;
+ int body_len, i;
+
+ if (safe_step)
+ set_safe_stepper(sc->args);
+ else set_safe_stepper(dox_slot1(sc->envir));
+ body_len = s7_list_length(sc, code);
+
+ s7_xf_new(sc, sc->envir);
+ for (i = 0, p = code; is_pair(p); i++, p = cdr(p))
+ if (!xf_opt(sc, car(p)))
+ break;
+
+ if (is_null(p))
+ {
+ s7_pointer stepper;
+ s7_pointer *top;
+ s7_int end;
+
+ stepper = slot_value(sc->args);
+ end = denominator(stepper);
+ top = sc->cur_rf->data;
+ if (safe_step)
+ {
+ if (body_len == 1)
+ {
+ s7_int end4;
+ s7_rf_t rf;
+ rf = (s7_rf_t)(*top);
+ top++;
+ end4 = end - 4;
+ for (; numerator(stepper) < end4; numerator(stepper)++)
+ {
+ s7_pointer *rp;
+ rp = top;
+ rf(sc, &rp);
+ numerator(stepper)++;
+ rp = top;
+ rf(sc, &rp);
+ numerator(stepper)++;
+ rp = top;
+ rf(sc, &rp);
+ numerator(stepper)++;
+ rp = top;
+ rf(sc, &rp);
+ }
+ for (; numerator(stepper) < end; numerator(stepper)++)
+ {
+ s7_pointer *rp;
+ rp = top;
+ rf(sc, &rp);
+ }
+ }
+ else
+ {
+ for (; numerator(stepper) < end; numerator(stepper)++)
+ {
+ s7_pointer *temp;
+ s7_pointer **rp;
+
+ temp = top;
+ rp = &temp;
+ for (i = 0; i < body_len; i++)
+ {
+ s7_rf_t rf;
+ rf = (s7_rf_t)(**rp); (*rp)++;
+ rf(sc, rp);
+ }
+ }
+ }
+ }
+ else
+ {
+ /* can't re-use the stepper value directly */
+ s7_pointer step_slot, end_slot;
+ s7_int step;
+
+ step_slot = dox_slot1(sc->envir);
+ end_slot = dox_slot2(sc->envir);
+
+ if (body_len == 1)
+ {
+ s7_rf_t rf;
+ rf = (s7_rf_t)(*top);
+ top++;
+ while (true)
+ {
+ s7_pointer *rp;
+ rp = top;
+ rf(sc, &rp);
+
+ step = s7_integer(slot_value(step_slot)) + 1;
+ slot_set_value(step_slot, make_integer(sc, step));
+ if (step == s7_integer(slot_value(end_slot))) break;
+ }
+ }
+ else
+ {
+ while (true)
+ {
+ s7_pointer *temp;
+ s7_pointer **rp;
+
+ temp = top;
+ rp = &temp;
+ for (i = 0; i < body_len; i++)
+ {
+ s7_rf_t rf;
+ rf = (s7_rf_t)(**rp); (*rp)++;
+ rf(sc, rp);
+ }
+
+ step = s7_integer(slot_value(step_slot)) + 1;
+ slot_set_value(step_slot, make_integer(sc, step));
+ if (step == s7_integer(slot_value(end_slot))) break;
+ }
+ }
+ }
+ s7_xf_free(sc);
+ sc->code = cdadr(scc);
+ return(true);
+ }
+ s7_xf_free(sc);
+ return(false);
+}
+
+
+static int let_pf_ok(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc, bool safe_case)
+{
+ s7_pointer let_body, p = NULL, let_vars, let_code;
+ bool let_star;
+ int body_len;
+ s7_rf_t varf = NULL;
+ s7_pointer old_e, stepper;
+ int var_len;
+
+ /* fprintf(stderr, "%lld %lld %s %d\n", numerator(step_slot), denominator(step_slot), DISPLAY(scc), safe_case); */
+
+ let_code = caddr(scc);
+ let_body = cddr(let_code);
+ body_len = s7_list_length(sc, let_body);
+ let_star = (symbol_syntax_op(car(let_code)) == OP_LET_STAR);
+ let_vars = cadr(let_code);
+ set_safe_stepper(step_slot);
+ stepper = slot_value(step_slot);
+
+ old_e = sc->envir;
+ sc->envir = new_frame_in_env(sc, sc->envir);
+
+ s7_xf_new(sc, old_e);
+ for (var_len = 0, p = let_vars; (is_pair(p)) && (is_pair(cadar(p))); var_len++, p = cdr(p))
+ {
+ s7_int var_loc;
+ s7_pointer expr, fcar, car_ex;
+ s7_rp_t varp;
+
+ var_loc = s7_xf_store(sc, NULL);
+ expr = cadar(p);
+ car_ex = car(expr);
+ /* fcar = find_symbol_checked(sc, car(expr)); */
+
+ if (!is_symbol(car_ex)) break;
+ fcar = find_symbol(sc, car_ex);
+ if (!is_slot(fcar)) break;
+ fcar = slot_value(fcar);
+
+ varp = rf_function(fcar);
+ if (!varp) break;
+ varf = varp(sc, expr);
+ if (!varf) break;
+ s7_xf_store_at(sc, var_loc, (s7_pointer)varf);
+ if (let_star)
+ make_slot_1(sc, sc->envir, caar(p), s7_make_mutable_real(sc, 1.5));
+ }
+
+ if (is_null(p))
+ {
+ int i;
+ s7_pf_t bodyf = NULL;
+ if (!let_star)
+ for (p = let_vars; is_pair(p); p = cdr(p))
+ make_slot_1(sc, sc->envir, caar(p), s7_make_mutable_real(sc, 1.5));
+
+ for (i = 0, p = let_body; is_pair(p); i++, p = cdr(p))
+ {
+ bodyf = xf_opt(sc, car(p));
+ if (!bodyf) break;
+ }
+
+ if (is_null(p))
+ {
+ s7_pointer *top;
+ s7_int end;
+
+ if (safe_case)
+ {
+ end = denominator(stepper);
+ top = sc->cur_rf->data;
+
+ if ((var_len == 1) && (body_len == 1)) /* very common special case */
+ {
+ s7_pointer rl;
+ s7_int end3;
+ s7_pointer **rp;
+ s7_pointer *temp;
+
+ end3 = end - 3;
+ rl = slot_value(let_slots(sc->envir));
+ top++;
+ for (; numerator(stepper) < end3; numerator(stepper)++)
+ {
+ temp = top;
+ rp = &temp;
+ set_real(rl, varf(sc, rp));
+ (*rp)++;
+ bodyf(sc, rp);
+ numerator(stepper)++;
+ temp = top;
+ rp = &temp;
+ set_real(rl, varf(sc, rp));
+ (*rp)++;
+ bodyf(sc, rp);
+ numerator(stepper)++;
+ temp = top;
+ rp = &temp;
+ set_real(rl, varf(sc, rp));
+ (*rp)++;
+ bodyf(sc, rp);
+ }
+ for (; numerator(stepper) < end; numerator(stepper)++)
+ {
+ temp = top;
+ rp = &temp;
+ set_real(rl, varf(sc, rp));
+ (*rp)++;
+ bodyf(sc, rp);
+ }
+ }
+ else
+ {
+ let_set_slots(sc->envir, reverse_slots(sc, let_slots(sc->envir)));
+ for (; numerator(stepper) < end; numerator(stepper)++)
+ {
+ s7_pointer **rp;
+ s7_pointer *temp;
+
+ temp = top;
+ rp = &temp;
+
+ for (p = let_slots(sc->envir); is_slot(p); p = next_slot(p))
+ {
+ s7_rf_t r1;
+ r1 = (s7_rf_t)(**rp); (*rp)++;
+ set_real(slot_value(p), r1(sc, rp));
+ }
+ for (i = 0; i < body_len; i++)
+ {
+ s7_pf_t pf;
+ pf = (s7_pf_t)(**rp); (*rp)++;
+ pf(sc, rp);
+ }
+ }
+ }
+ }
+ else
+ {
+ end = denominator(stepper);
+ top = sc->cur_rf->data;
+
+ if ((var_len == 1) && (body_len == 1)) /* very common special case */
+ {
+ s7_pointer rl;
+ s7_int k;
+ rl = slot_value(let_slots(sc->envir));
+ top++;
+ for (k = numerator(stepper); k < end; k++)
+ {
+ s7_pointer **rp;
+ s7_pointer *temp;
+ slot_set_value(step_slot, make_integer(sc, k));
+
+ temp = top;
+ rp = &temp;
+ set_real(rl, varf(sc, rp));
+ (*rp)++;
+ bodyf(sc, rp);
+ }
+ }
+ else
+ {
+ s7_int k;
+ let_set_slots(sc->envir, reverse_slots(sc, let_slots(sc->envir)));
+ for (k = numerator(stepper); k < end; k++)
+ {
+ s7_pointer **rp;
+ s7_pointer *temp;
+ slot_set_value(step_slot, make_integer(sc, k));
+
+ temp = top;
+ rp = &temp;
+
+ for (p = let_slots(sc->envir); is_slot(p); p = next_slot(p))
+ {
+ s7_rf_t r1;
+ r1 = (s7_rf_t)(**rp); (*rp)++;
+ set_real(slot_value(p), r1(sc, rp));
+ }
+ for (i = 0; i < body_len; i++)
+ {
+ s7_pf_t pf;
+ pf = (s7_pf_t)(**rp); (*rp)++;
+ pf(sc, rp);
+ }
+ }
+ }
+ }
+ s7_xf_free(sc);
+ sc->code = cdr(cadr(scc));
+ return(goto_SAFE_DO_END_CLAUSES);
+ }
+ }
+ sc->envir = old_e;
+ s7_xf_free(sc);
+ return(fall_through);
+}
+
+
+static int safe_dotimes_ex(s7_scheme *sc)
+{
+ s7_pointer init_val;
+
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
+
+ init_val = cadr(caar(sc->code));
+ if (is_symbol(init_val))
+ init_val = find_symbol_checked(sc, init_val);
+ else
+ {
+ if (is_pair(init_val))
+ init_val = c_call(init_val)(sc, cdr(init_val));
+ }
+ if (s7_is_integer(init_val))
+ {
+ s7_pointer end_expr, end_val, code;
+
+ code = sc->code;
+ end_expr = caadr(code);
+ end_val = caddr(end_expr);
+ if (is_symbol(end_val))
+ end_val = find_symbol_checked(sc, end_val);
+
+ if (s7_is_integer(end_val))
+ {
+ sc->code = cddr(code);
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ sc->args = make_slot_1(sc, sc->envir, caaar(code), make_mutable_integer(sc, s7_integer(init_val)));
+
+ denominator(slot_value(sc->args)) = s7_integer(end_val);
+ set_stepper(sc->args);
+
+ /* (define (hi) (do ((i 1 (+ 1 i))) ((= i 1) i))) -- we need the frame even if the loop is not evaluated */
+ if ((is_null(sc->code)) ||
+ ((!is_pair(car(sc->code))) &&
+ (is_null(cdr(sc->code)))))
+ {
+ numerator(slot_value(sc->args)) = s7_integer(end_val);
+ sc->code = cdr(cadr(code));
+ return(goto_SAFE_DO_END_CLAUSES);
+ }
+
+ if (s7_integer(init_val) == s7_integer(end_val))
+ {
+ sc->code = cdr(cadr(code));
+ return(goto_SAFE_DO_END_CLAUSES);
+ }
+
+ if ((is_null(cdr(sc->code))) &&
+ (is_pair(car(sc->code))))
+ {
+ sc->code = car(sc->code);
+ set_opt_pair2(code, sc->code); /* is_pair above */
+
+ if ((typesflag(sc->code) == SYNTACTIC_PAIR) ||
+ (typesflag(car(sc->code)) == SYNTACTIC_TYPE))
+ {
+ if (!is_unsafe_do(code))
+ {
+ if ((symbol_syntax_op(car(sc->code)) == OP_LET) ||
+ (symbol_syntax_op(car(sc->code)) == OP_LET_STAR))
+ {
+ if (let_pf_ok(sc, sc->args, code, true) == goto_SAFE_DO_END_CLAUSES)
+ return(goto_SAFE_DO_END_CLAUSES);
+ }
+ else
+ {
+ if (pf_ok(sc, cddr(code), code, true))
+ return(goto_SAFE_DO_END_CLAUSES);
+ }
+ set_unsafe_do(code);
+ }
+
+ push_stack(sc, OP_SAFE_DOTIMES_STEP_P, sc->args, code);
+ if (typesflag(sc->code) == SYNTACTIC_PAIR)
+ sc->op = (opcode_t)pair_syntax_op(sc->code);
+ else
+ {
+ sc->op = (opcode_t)symbol_syntax_op(car(sc->code));
+ pair_set_syntax_op(sc->code, sc->op);
+ set_type(sc->code, SYNTACTIC_PAIR);
+ }
+ sc->code = cdr(sc->code);
+ return(goto_START_WITHOUT_POP_STACK);
+ }
+ else /* car not syntactic? */
+ {
+ if ((!is_unsafe_do(code)) &&
+ (pf_ok(sc, cddr(code), code, true)))
+ return(goto_SAFE_DO_END_CLAUSES);
+ set_unsafe_do(code);
+
+#if DEBUGGING
+ if (!is_optimized(sc->code)) fprintf(stderr, "%s[%d]: not opt: %s\n", __func__, __LINE__, DISPLAY(sc->code));
+#endif
+ if (is_optimized(sc->code)) /* think this is not needed -- can we get here otherwise? */
+ {
+ push_stack(sc, OP_SAFE_DOTIMES_STEP_O, sc->args, code);
+ return(goto_OPT_EVAL);
+ }
+ }
+ /* impossible? but make sure in any case we're set up for begin */
+ sc->code = cddr(code);
+ }
+
+ /* multi-line body */
+ if ((!is_unsafe_do(code)) &&
+ (pf_ok(sc, sc->code, code, true)))
+ return(goto_SAFE_DO_END_CLAUSES);
+ set_unsafe_do(code);
+
+ set_opt_pair2(code, sc->code);
+ push_stack(sc, OP_SAFE_DOTIMES_STEP, sc->args, code);
+ return(goto_BEGIN1);
+ }
+ }
+ return(fall_through);
+}
+
+static int safe_do_ex(s7_scheme *sc)
+{
+ /* body is safe, step = +1, end is =, but stepper and end might be set (or at least indirectly exported) in the body:
+ * (let ((lst ())) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j (min i 100))) (set! lst (cons j lst)))) lst)
+ * however, we're very restrictive about this in check_do and do_is_safe; even this is considered trouble:
+ * (let ((x 0)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i))) x)
+ * but end might not be an integer -- need to catch this earlier.
+ */
+ s7_pointer end, init_val, end_val, code;
+
+ /* fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
+
+ code = sc->code;
+
+ init_val = cadaar(code);
+ if (is_symbol(init_val))
+ init_val = find_symbol_checked(sc, init_val);
+ else
+ {
+ if (is_pair(init_val))
+ init_val = c_call(init_val)(sc, cdr(init_val));
+ }
+
+ end = caddr(car(cadr(code)));
+ if (is_symbol(end))
+ end_val = find_symbol_checked(sc, end);
+ else end_val = end;
+
+ if ((!s7_is_integer(init_val)) || (!s7_is_integer(end_val)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->DO_UNCHECKED);
+ return(goto_DO_UNCHECKED);
+ }
+
+ /* (let ((sum 0)) (define (hi) (do ((i 10 (+ i 1))) ((= i 10) i) (set! sum (+ sum i)))) (hi)) */
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ dox_set_slot1(sc->envir, make_slot_1(sc, sc->envir, caaar(code), init_val)); /* define the step var -- might be needed in the end clauses */
+
+ if ((s7_integer(init_val) == s7_integer(end_val)) ||
+ ((s7_integer(init_val) > s7_integer(end_val)) &&
+ (opt_cfunc(car(cadr(code))) == geq_2)))
+ {
+ sc->code = cdr(cadr(code));
+ return(goto_SAFE_DO_END_CLAUSES);
+ }
+
+ if (is_symbol(end))
+ sc->args = find_symbol(sc, end);
+ else sc->args = make_slot(sc, sc->dox_slot_symbol, end); /* here and elsewhere sc->args is used for GC protection */
+ dox_set_slot2(sc->envir, sc->args);
+
+ if ((!is_unsafe_do(sc->code)) &&
+ ((!is_optimized(caadr(code))) ||
+ (opt_cfunc(caadr(code)) != geq_2)))
+ {
+ set_stepper(dox_slot1(sc->envir));
+
+ if (pf_ok(sc, cddr(sc->code), sc->code, false))
+ return(goto_SAFE_DO_END_CLAUSES);
+ set_unsafe_do(sc->code);
+ }
+
+ sc->code = cddr(code);
+ if (is_unsafe_do(sc->code)) /* we've seen this loop before and it's not optimizable */
+ {
+ set_opt_pair2(code, sc->code);
+ push_stack(sc, OP_SAFE_DO_STEP, sc->args, code);
+ return(goto_BEGIN1);
+ }
+
+ set_unsafe_do(sc->code);
+ set_opt_pair2(code, sc->code);
+ push_stack(sc, OP_SAFE_DO_STEP, sc->args, code);
+ return(goto_BEGIN1);
+}
+
+static int dotimes_p_ex(s7_scheme *sc)
+{
+ s7_pointer init, end, code, init_val, end_val;
+ /* (do ... (set! args ...)) -- one line, syntactic */
+
+ /* if (!is_unsafe_do(sc->code)) fprintf(stderr, "%s: %s\n", __func__, DISPLAY(sc->code)); */
+
+ code = sc->code;
+ init = cadaar(code);
+ if (is_symbol(init))
+ init_val = find_symbol_checked(sc, init);
+ else
+ {
+ if (is_pair(init))
+ init_val = c_call(init)(sc, cdr(init));
+ else init_val = init;
+ }
+ sc->value = init_val;
+
+ set_opt_pair2(code, caadr(code));
+ end = caddr(opt_pair2(code));
+ if (is_symbol(end))
+ sc->args = find_symbol(sc, end);
+ else sc->args = make_slot(sc, sc->dox_slot_symbol, end);
+ end_val = slot_value(sc->args);
+
+ if ((!s7_is_integer(init_val)) || (!s7_is_integer(end_val)))
+ {
+ pair_set_syntax_symbol(sc->code, sc->DO_UNCHECKED);
+ return(goto_DO_UNCHECKED);
+ }
+
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ dox_set_slot1(sc->envir, make_slot_1(sc, sc->envir, caaar(code), init_val));
+ dox_set_slot2(sc->envir, sc->args);
+
+ car(sc->T2_1) = slot_value(dox_slot1(sc->envir));
+ car(sc->T2_2) = slot_value(dox_slot2(sc->envir));
+ if (is_true(sc, c_call(caadr(code))(sc, sc->T2_1)))
+ {
+ sc->code = cdadr(code);
+ return(goto_DO_END_CLAUSES);
+ }
+
+ if ((!is_unsafe_do(code)) &&
+ (opt_cfunc(caadr(code)) != geq_2))
+ {
+ s7_pointer old_args, old_init, body;
+ body = caddr(code);
+
+ old_args = sc->args;
+ old_init = slot_value(dox_slot1(sc->envir));
+ sc->args = dox_slot1(sc->envir);
+ slot_set_value(sc->args, make_mutable_integer(sc, integer(slot_value(dox_slot1(sc->envir)))));
+ denominator(slot_value(sc->args)) = integer(slot_value(dox_slot2(sc->envir)));
+ set_stepper(sc->args);
+
+ if (((typesflag(body) == SYNTACTIC_PAIR) ||
+ (typesflag(car(body)) == SYNTACTIC_TYPE)) &&
+ ((symbol_syntax_op(car(body)) == OP_LET) ||
+ (symbol_syntax_op(car(body)) == OP_LET_STAR)))
+ {
+ if (let_pf_ok(sc, sc->args, code, false) == goto_SAFE_DO_END_CLAUSES)
+ return(goto_DO_END_CLAUSES);
+ }
+ else
+ {
+ if (pf_ok(sc, cddr(code), code, false))
+ return(goto_DO_END_CLAUSES);
+ }
+ slot_set_value(sc->args, old_init);
+ sc->args = old_args;
+ set_unsafe_do(code);
+ }
+
+ push_stack(sc, OP_DOTIMES_STEP_P, sc->args, code);
+ sc->code = caddr(code);
+ return(goto_EVAL);
+}
+
+static int do_init_ex(s7_scheme *sc)
+{
+ s7_pointer x, y, z;
+ while (true)
+ {
+ sc->args = cons(sc, sc->value, sc->args); /* code will be last element (first after reverse) */
+ if (is_pair(sc->code))
+ {
+ /* here sc->code is a list like: ((i 0 (+ i 1)) ...) so cadar gets the init value. */
+ s7_pointer init;
+ init = cadar(sc->code);
+ if (is_pair(init))
+ {
+ push_stack(sc, OP_DO_INIT, sc->args, cdr(sc->code));
+ sc->code = init;
+ return(goto_EVAL);
+ }
+ if (is_symbol(init))
+ sc->value = find_symbol_checked(sc, init);
+ else sc->value = init;
+ sc->code = cdr(sc->code);
+ }
+ else break;
+ }
+
+ /* all the initial values are now in the args list */
+ sc->args = safe_reverse_in_place(sc, sc->args);
+ sc->code = car(sc->args); /* saved at the start */
+ z = sc->args;
+ sc->args = cdr(sc->args); /* init values */
+
+ /* sc->envir = new_frame_in_env(sc, sc->envir); */
+ /* sc->args was cons'd above, so it should be safe to reuse it as the new frame */
+ sc->envir = old_frame_in_env(sc, z, sc->envir);
+
+ /* run through sc->code and sc->args adding '( caar(car(code)) . car(args) ) to sc->envir,
+ * also reuse the value cells as the new frame slots.
+ */
+ sc->value = sc->NIL;
+ y = sc->args;
+ for (x = car(sc->code); is_not_null(y); x = cdr(x))
+ {
+ s7_pointer sym, args, val;
+ sym = caar(x);
+ val = car(y);
+ args = cdr(y);
+
+ set_type(y, T_SLOT);
+ slot_set_symbol(y, sym);
+ slot_set_value(y, val);
+ next_slot(y) = let_slots(sc->envir);
+ let_set_slots(sc->envir, y);
+ symbol_set_local(sym, let_id(sc->envir), y);
+
+ if (is_not_null(cddar(x))) /* else no incr expr, so ignore it henceforth */
+ {
+ s7_pointer p;
+ p = cons(sc, caddar(x), val);
+ set_opt_slot1(p, y);
+ /* val is just a place-holder -- this is where we store the new value */
+ sc->value = cons_unchecked(sc, p, sc->value);
+ }
+ y = args;
+ }
+ sc->args = cons(sc, sc->value = safe_reverse_in_place(sc, sc->value), cadr(sc->code));
+ sc->code = cddr(sc->code);
+
+ /* here args is a list of 2 or 3 lists, first is (list (list (var . binding) incr-expr init-value) ...), second is end-expr, third can be result expr
+ * so for (do ((i 0 (+ i 1))) ((= i 3) (+ i 1)) ...) args is ((((i . 0) (+ i 1) 0 #f)) (= i 3) (+ i 1))
+ */
+ return(fall_through);
+}
+
+
+#if (!WITH_GCC)
+#define closure_is_ok(Sc, Code, Type, Args) (find_symbol_unchecked(Sc, car(Code)) == opt_lambda(Code))
+#define closure_star_is_ok(Sc, Code, Type, Args) (find_symbol_unchecked(Sc, car(Code)) == opt_lambda(Code))
+#else
+
+/* it is almost never the case that we already have the value and can see it in the current environment directly,
+ * but once found, the value usually matches the current (opt_lambda(code))
+ *
+ * (_val_) is needed below because car(code) might be undefined (with-let can cause this confusion),
+ * and find_symbol_unchecked returns NULL in that case.
+ */
+#if 1
+/* unlike the c_function_is_ok case, the macro form here is faster?? callgrind and time agree on this.
+ * opt_lambda(_code_) here can (legitimately) be a free cell or almost anything.
+ */
+#define closure_is_ok(Sc, Code, Type, Args) \
+ ({ s7_pointer _code_, _val_; _code_ = Code; _val_ = find_symbol_unchecked(Sc, car(_code_)); \
+ ((_val_ == opt_any1(_code_)) || \
+ ((_val_) && (typesflag(_val_) == (unsigned short)Type) && \
+ ((closure_arity(_val_) == Args) || (closure_arity_to_int(Sc, _val_) == Args)) && \
+ (set_opt_lambda(_code_, _val_)))); })
+#else
+static bool closure_is_ok(s7_scheme *sc, s7_pointer code, unsigned short type, int args)
+{
+ s7_pointer f;
+ f = find_symbol_unchecked(sc, car(code));
+ return ((f == opt_lambda(code)) ||
+ ((f) &&
+ (typesflag(f) == type) &&
+ ((closure_arity(f) == args) || (closure_arity_to_int(sc, f) == args)) &&
+ (set_opt_lambda(code, f))));
+}
+#endif
+
+#define closure_star_is_ok(Sc, Code, Type, Args) \
+ ({ s7_pointer _val_; _val_ = find_symbol_unchecked(Sc, car(Code)); \
+ ((_val_ == opt_any1(Code)) || \
+ ((_val_) && (typesflag(_val_) == (unsigned short)Type) && \
+ ((closure_arity(_val_) >= Args) || (closure_star_arity_to_int(Sc, _val_) >= Args)) && \
+ (set_opt_lambda(Code, _val_)))); })
+
+#endif
+
+#define MATCH_UNSAFE_CLOSURE (T_CLOSURE | T_PROCEDURE)
+#define MATCH_SAFE_CLOSURE (T_CLOSURE | T_PROCEDURE | T_SAFE_CLOSURE)
+#define MATCH_UNSAFE_CLOSURE_STAR (T_CLOSURE_STAR | T_PROCEDURE)
+#define MATCH_SAFE_CLOSURE_STAR (T_CLOSURE_STAR | T_PROCEDURE | T_SAFE_CLOSURE)
+
+/* since T_HAS_METHODS is on if there might be methods, this can protect us from that case */
+
+
+/* unknown ops */
+
+static int fixup_unknown_op(s7_scheme *sc, s7_pointer code, s7_pointer func, int op)
+{
+ /* sc arg used if debugging */
+ set_optimize_op(code, op);
+ set_opt_lambda(code, func); /* opt_lambda works here because it is the only checked case, but ideally we'd split out all the cases via switch (op) */
+ return(goto_OPT_EVAL);
+}
+
+static int unknown_ex(s7_scheme *sc, s7_pointer f)
+{
+ s7_pointer code;
+
+ code = sc->code;
+ switch (type(f))
+ {
+ case T_C_OBJECT:
+ if (s7_is_aritable(sc, f, 0))
+ return(fixup_unknown_op(sc, code, f, OP_C_OBJECT));
+ break;
+
+ case T_GOTO:
+ return(fixup_unknown_op(sc, code, f, OP_GOTO));
+
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (is_null(closure_args(f))))
+ {
+ int hop;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+ if (is_safe_closure(f))
+ {
+ s7_pointer body;
+ body = closure_body(f);
+ set_optimize_op(code, hop + OP_SAFE_THUNK);
+ if (is_null(cdr(body)))
+ {
+ if (is_optimized(car(body)))
+ set_optimize_op(code, hop + OP_SAFE_THUNK_E);
+ else
+ {
+ if ((is_pair(car(body))) &&
+ (is_syntactic_symbol(caar(body))))
+ {
+ set_optimize_op(code, hop + OP_SAFE_THUNK_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_type(car(body), SYNTACTIC_PAIR);
+ }
+ }
+ }
+ }
+ set_opt_lambda(code, f);
+ return(goto_OPT_EVAL);
+ }
+ return(fixup_unknown_op(sc, code, f, hop + OP_THUNK));
+ }
+ /* we can't ignore the recheck here (i.e. set the hop bit) because the closure, even if a global can be set later:
+ * (begin (define *x* #f) (define (test) (display (*x*))) (define (setx n) (set! *x* (lambda () n))) (setx 1) (test) (setx 2) (test))
+ * this is a case where the name matters (we need a pristine global), so it's easily missed.
+ */
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_args(closure_body(f))))
+ return(fixup_unknown_op(sc, code, f, ((is_immutable_symbol(car(code))) ? 1 : 0) + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR : OP_CLOSURE_STAR)));
+ break;
+
+ default:
+ break;
+ }
+ return(fall_through);
+}
+
+static int unknown_g_ex(s7_scheme *sc, s7_pointer f)
+{
+ s7_pointer code;
+ bool sym_case;
+ int hop;
+
+ code = sc->code;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+ sym_case = is_symbol(cadr(code));
+
+ switch (type(f))
+ {
+ case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ if (s7_is_aritable(sc, f, 1))
+ {
+ if (sym_case)
+ {
+ set_optimize_op(code, hop + ((is_safe_procedure(f)) ? OP_SAFE_C_S : OP_C_S));
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+ }
+ else
+ {
+ if (is_safe_procedure(f))
+ {
+ set_optimize_op(code, hop + OP_SAFE_C_C);
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+ }
+ }
+ }
+ break;
+
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (closure_arity_to_int(sc, f) == 1))
+ {
+ if (sym_case)
+ {
+ set_opt_sym2(code, cadr(code));
+ if (is_safe_closure(f))
+ {
+ s7_pointer body;
+ set_optimize_op(code, hop + ((is_global(car(code))) ? OP_SAFE_GLOSURE_S : OP_SAFE_CLOSURE_S));
+ body = closure_body(f);
+ if (is_null(cdr(body)))
+ {
+ if ((is_optimized(car(body))) &&
+ (is_global(car(code))))
+ set_optimize_op(code, hop + OP_SAFE_GLOSURE_S_E);
+ else
+ {
+ if ((is_pair(car(body))) &&
+ (is_syntactic_symbol(caar(body))))
+ {
+ set_optimize_op(code, hop + OP_SAFE_CLOSURE_S_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_type(car(body), SYNTACTIC_PAIR);
+ }
+ }
+ }
+ }
+ }
+ else set_optimize_op(code, hop + ((is_global(car(code))) ? OP_GLOSURE_S : OP_CLOSURE_S));
+ }
+ else
+ {
+ set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_C : OP_CLOSURE_C));
+ set_opt_con2(code, cadr(code));
+ }
+ set_opt_lambda(code, f);
+ return(goto_OPT_EVAL);
+ }
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((sym_case) &&
+ (!has_methods(f)) &&
+ (has_simple_args(closure_body(f))) &&
+ (!is_null(closure_args(f))))
+ {
+ set_opt_sym2(code, cadr(code));
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_S : OP_CLOSURE_STAR_S)));
+ }
+ break;
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ if ((sym_case) ||
+ (is_integer(cadr(code)))) /* (v 4/3) */
+ return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_VECTOR_S : OP_VECTOR_C));
+ break;
+
+ case T_STRING:
+ return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_STRING_S : OP_STRING_C));
+
+ case T_PAIR:
+ return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_PAIR_S : OP_PAIR_C));
+
+ case T_C_OBJECT:
+ if (s7_is_aritable(sc, f, 1))
+ return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_C_OBJECT_S : OP_C_OBJECT_C));
+ break;
+
+ case T_LET:
+ return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_ENVIRONMENT_S : OP_ENVIRONMENT_C));
+
+ case T_HASH_TABLE:
+ return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_HASH_TABLE_S : OP_HASH_TABLE_C));
+
+ case T_GOTO:
+ return(fixup_unknown_op(sc, code, f, (sym_case) ? OP_GOTO_S : OP_GOTO_C));
+
+ default:
+ break;
+ }
+ return(fall_through);
+}
+
+static int unknown_gg_ex(s7_scheme *sc, s7_pointer f)
+{
+ if (s7_is_aritable(sc, f, 2))
+ {
+ bool s1, s2;
+ int hop;
+ s7_pointer code;
+
+ code = sc->code;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+ s1 = is_symbol(cadr(code));
+ s2 = is_symbol(caddr(code));
+
+ switch (type(f))
+ {
+ case T_CLOSURE:
+ if (has_methods(f)) break;
+ if (closure_arity_to_int(sc, f) == 2)
+ {
+ if (s1)
+ {
+ if (is_safe_closure(f))
+ set_optimize_op(code, hop + ((s2) ? OP_SAFE_CLOSURE_SS : OP_SAFE_CLOSURE_SC));
+ else set_optimize_op(code, hop + ((s2) ? OP_CLOSURE_SS : OP_CLOSURE_SC));
+ }
+ else
+ {
+ if (!s2) break;
+ set_optimize_op(code, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_CS : OP_CLOSURE_CS));
+ }
+ if (s2) set_opt_sym2(code, caddr(code)); else set_opt_con2(code, caddr(code));
+ set_opt_lambda(code, f);
+ return(goto_OPT_EVAL);
+ }
+ break;
+
+ case T_CLOSURE_STAR: /* the closure* opts assume args are not keywords, but we can check that! */
+ if ((s1) &&
+ (!has_methods(f)))
+ {
+ if (s2)
+ {
+ if ((!is_keyword(cadr(code))) &&
+ (!is_keyword(caddr(code))) &&
+ (has_simple_args(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= 2))
+ {
+ set_opt_sym2(code, caddr(code));
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_SS : OP_CLOSURE_STAR_SX)));
+ }
+ }
+ else
+ {
+ set_opt_con2(code, caddr(code));
+ if ((!is_keyword(cadr(code))) &&
+ (has_simple_args(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= 2))
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_SC : OP_CLOSURE_STAR_SX)));
+ }
+ }
+ break;
+
+ case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ if (is_safe_procedure(f))
+ {
+ if (s1)
+ set_optimize_op(code, hop + ((s2) ? OP_SAFE_C_SS : OP_SAFE_C_SC));
+ else set_optimize_op(code, hop + ((s2) ? OP_SAFE_C_CS : OP_SAFE_C_C));
+ }
+ else
+ {
+ set_optimize_op(code, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(code), sc->envir);
+ }
+ set_arglist_length(code, small_int(2));
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ if ((is_integer(cadr(code))) && /* !s1 obviously) */
+ (s7_integer(cadr(code)) >= 0) &&
+ (is_integer(caddr(code))) &&
+ (s7_integer(caddr(code)) >= 0))
+ return(fixup_unknown_op(sc, code, f, OP_VECTOR_CC));
+ break;
+
+ default:
+ break;
+ }
+ }
+ return(fall_through);
+}
+
+static int unknown_all_s_ex(s7_scheme *sc, s7_pointer f)
+{
+ s7_pointer code;
+ int num_args;
+
+ code = sc->code;
+ num_args = integer(arglist_length(code));
+
+ if (s7_is_aritable(sc, f, num_args))
+ {
+ int hop;
+ hop = (is_immutable_symbol(car(code))) ? 1 : 0;
+
+ switch (type(f))
+ {
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (closure_arity_to_int(sc, f) == num_args))
+ {
+ annotate_args(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, hop + ((is_safe_closure(f)) ? OP_SAFE_CLOSURE_ALL_X : OP_CLOSURE_ALL_S)));
+ }
+ break;
+
+ case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ if (is_safe_procedure(f))
+ set_optimize_op(code, hop + OP_SAFE_C_ALL_S);
+ else
+ {
+ set_optimize_op(code, hop + OP_C_ALL_X);
+ annotate_args(sc, cdr(code), sc->envir);
+ }
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+
+ default:
+ break;
+ }
+ }
+ return(fall_through);
+}
+
+static int unknown_a_ex(s7_scheme *sc, s7_pointer f)
+{
+ if (s7_is_aritable(sc, f, 1))
+ {
+ s7_pointer code;
+
+ code = sc->code;
+ set_arglist_length(code, small_int(1));
+ annotate_args(sc, cdr(code), sc->envir);
+
+ switch (type(f))
+ {
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR:
+ return(fixup_unknown_op(sc, code, f, OP_VECTOR_A));
+
+ case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ if ((is_safe_procedure(f)) &&
+ (is_optimized(cadr(code))))
+ {
+ int op;
+ op = combine_ops(sc, E_C_P, code, cadr(code));
+ set_optimize_op(code, op);
+ if ((op == OP_SAFE_C_Z) &&
+ (is_all_x_op(optimize_op(cadr(code)))))
+ set_optimize_op(code, OP_SAFE_C_A);
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+ }
+
+ if ((is_pair(cadr(code))) &&
+ (caadr(code) == sc->QUOTE))
+ set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_Q : OP_C_A);
+ else set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_A : OP_C_A);
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (closure_arity_to_int(sc, f) == 1))
+ {
+ if ((is_pair(cadr(code))) &&
+ (caadr(code) == sc->QUOTE))
+ return(fixup_unknown_op(sc, code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_Q : OP_CLOSURE_Q));
+
+ if (is_safe_closure(f))
+ set_optimize_op(code, (is_global(car(code))) ? OP_SAFE_GLOSURE_A : OP_SAFE_CLOSURE_A);
+ else set_optimize_op(code, (is_global(car(code))) ? OP_GLOSURE_A : OP_CLOSURE_A);
+ set_opt_lambda(code, f);
+ return(goto_OPT_EVAL);
+ }
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_args(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= 1) &&
+ (!arglist_has_keyword(cdr(code))))
+ return(fixup_unknown_op(sc, code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ break;
+
+ case T_STRING:
+ return(fixup_unknown_op(sc, code, f, OP_STRING_A));
+
+ case T_PAIR:
+ return(fixup_unknown_op(sc, code, f, OP_PAIR_A));
+
+ case T_C_OBJECT:
+ return(fixup_unknown_op(sc, code, f, OP_C_OBJECT_A));
+
+ case T_LET:
+ return(fixup_unknown_op(sc, code, f, ((is_pair(cadr(code))) && (caadr(code) == sc->QUOTE)) ? OP_ENVIRONMENT_Q : OP_ENVIRONMENT_A));
+
+ case T_HASH_TABLE:
+ return(fixup_unknown_op(sc, code, f, OP_HASH_TABLE_A));
+
+ case T_GOTO:
+ return(fixup_unknown_op(sc, code, f, OP_GOTO_A));
+
+ default:
+ break;
+ }
+ }
+ return(fall_through);
+}
+
+static int unknown_aa_ex(s7_scheme *sc, s7_pointer f)
+{
+ if (s7_is_aritable(sc, f, 2))
+ {
+ s7_pointer code;
+
+ code = sc->code;
+ set_arglist_length(code, small_int(2));
+ annotate_args(sc, cdr(code), sc->envir);
+
+ switch (type(f))
+ {
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (closure_arity_to_int(sc, f) == 2))
+ {
+ set_optimize_op(code, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_AA : OP_CLOSURE_AA);
+ set_opt_lambda(code, f);
+ return(goto_OPT_EVAL);
+ }
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_args(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= 2) &&
+ (!arglist_has_keyword(cdr(code))))
+ return(fixup_unknown_op(sc, code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ break;
+
+ case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_AA : OP_C_ALL_X);
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+
+ default:
+ break;
+ }
+ }
+ return(fall_through);
+}
+
+static int unknown_all_x_ex(s7_scheme *sc, s7_pointer f)
+{
+ s7_pointer code;
+ int num_args;
+
+ code = sc->code;
+ num_args = integer(arglist_length(code));
+
+ if (s7_is_aritable(sc, f, num_args))
+ {
+ switch (type(f))
+ {
+ case T_CLOSURE:
+ if ((!has_methods(f)) &&
+ (closure_arity_to_int(sc, f) == num_args))
+ {
+ annotate_args(sc, cdr(code), sc->envir);
+ if (is_safe_closure(f))
+ {
+ if ((is_symbol(cadr(code))) &&
+ (num_args == 3))
+ set_optimize_op(code, OP_SAFE_CLOSURE_SAA);
+ else set_optimize_op(code, OP_SAFE_CLOSURE_ALL_X);
+ }
+ else set_optimize_op(code, OP_CLOSURE_ALL_X);
+ set_opt_lambda(code, f);
+ return(goto_OPT_EVAL);
+ }
+ break;
+
+ case T_CLOSURE_STAR:
+ if ((!has_methods(f)) &&
+ (has_simple_args(closure_body(f))) &&
+ (closure_star_arity_to_int(sc, f) >= num_args) &&
+ (!arglist_has_keyword(cdr(code))))
+ {
+ annotate_args(sc, cdr(code), sc->envir);
+ return(fixup_unknown_op(sc, code, f, (is_safe_closure(f)) ? OP_SAFE_CLOSURE_STAR_ALL_X : OP_CLOSURE_STAR_ALL_X));
+ }
+ break;
+
+ case T_C_FUNCTION: case T_C_FUNCTION_STAR: case T_C_ANY_ARGS_FUNCTION: case T_C_OPT_ARGS_FUNCTION: case T_C_RST_ARGS_FUNCTION:
+ set_optimize_op(code, (is_safe_procedure(f)) ? OP_SAFE_C_ALL_X : OP_C_ALL_X);
+ annotate_args(sc, cdr(code), sc->envir);
+ set_c_function(code, f);
+ return(goto_OPT_EVAL);
+
+ default:
+ break;
+ }
+ }
+ return(fall_through);
+}
+
+
+static void unwind_output_ex(s7_scheme *sc)
+{
+ bool is_file;
+ is_file = is_file_port(sc->code);
+
+ if ((is_output_port(sc->code)) &&
+ (!port_is_closed(sc->code)))
+ s7_close_output_port(sc, sc->code); /* may call fflush */
+
+ if ((is_output_port(sc->args)) &&
+ (!port_is_closed(sc->args)))
+ sc->output_port = sc->args;
+
+ if ((is_file) &&
+ (is_multiple_value(sc->value)))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+}
+
+static void unwind_input_ex(s7_scheme *sc)
+{
+ if ((is_input_port(sc->code)) &&
+ (!port_is_closed(sc->code)))
+ s7_close_input_port(sc, sc->code);
+
+ if ((is_input_port(sc->args)) &&
+ (!port_is_closed(sc->args)))
+ sc->input_port = sc->args;
+
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+}
+
+static int dynamic_wind_ex(s7_scheme *sc)
+{
+ if (dynamic_wind_state(sc->code) == DWIND_INIT)
+ {
+ dynamic_wind_state(sc->code) = DWIND_BODY;
+ push_stack(sc, OP_DYNAMIC_WIND, sc->NIL, sc->code);
+ sc->code = dynamic_wind_body(sc->code);
+ sc->args = sc->NIL;
+ return(goto_APPLY);
+ }
+ else
+ {
+ if (dynamic_wind_state(sc->code) == DWIND_BODY)
+ {
+ dynamic_wind_state(sc->code) = DWIND_FINISH;
+ if (dynamic_wind_out(sc->code) != sc->F)
+ {
+ push_stack(sc, OP_DYNAMIC_WIND, sc->value, sc->code);
+ sc->code = dynamic_wind_out(sc->code);
+ sc->args = sc->NIL;
+ return(goto_APPLY);
+ }
+ else
+ {
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ return(goto_START);
+ }
+ }
+ if (is_multiple_value(sc->args)) /* (+ 1 (dynamic-wind (lambda () #f) (lambda () (values 2 3 4)) (lambda () #f)) 5) */
+ sc->value = splice_in_values(sc, multiple_value(sc->args));
+ else sc->value = sc->args; /* value saved above */
+ }
+ return(goto_START);
+}
+
+static int read_s_ex(s7_scheme *sc)
+{
+ /* another lint opt */
+ s7_pointer port, code;
+
+ code = sc->code;
+ port = find_symbol_checked(sc, cadr(code));
+
+ if (!is_input_port(port)) /* was also not stdin */
+ {
+ sc->value = g_read(sc, list_1(sc, port));
+ return(goto_START);
+ }
+ /* I guess this port_is_closed check is needed because we're going down a level below */
+ if (port_is_closed(port))
+ simple_wrong_type_argument_with_type(sc, sc->READ, port, AN_OPEN_PORT);
+
+ if (is_function_port(port))
+ sc->value = (*(port_input_function(port)))(sc, S7_READ, port);
+ else
+ {
+ if ((is_string_port(port)) &&
+ (port_data_size(port) <= port_position(port)))
+ sc->value = sc->EOF_OBJECT;
+ else
+ {
+ push_input_port(sc, port);
+ push_stack(sc, OP_READ_DONE, sc->NIL, sc->NIL); /* this stops the internal read process so we only get one form */
+ sc->tok = token(sc);
+ switch (sc->tok)
+ {
+ case TOKEN_EOF:
+ return(goto_START);
+
+ case TOKEN_RIGHT_PAREN:
+ read_error(sc, "unexpected close paren");
+
+ case TOKEN_COMMA:
+ read_error(sc, "unexpected comma");
+
+ default:
+ sc->value = read_expression(sc);
+ sc->current_line = port_line_number(sc->input_port); /* this info is used to track down missing close parens */
+ sc->current_file = port_filename(sc->input_port);
+ }
+ }
+ }
+ /* equally read-done and read-list here */
+ return(goto_START);
+}
+
+static void eval_string_ex(s7_scheme *sc)
+{
+ /* read and evaluate string expression(s?)
+ * assume caller (C via g_eval_c_string) is dealing with the string port
+ */
+ /* (eval-string (string-append "(list 1 2 3)" (string #\newline) (string #\newline)))
+ * needs to be sure to get rid of the trailing white space before checking for EOF
+ * else it tries to eval twice and gets "attempt to apply 1?, line 2"
+ */
+ if ((sc->tok != TOKEN_EOF) &&
+ (port_position(sc->input_port) < port_data_size(sc->input_port))) /* ran past end somehow? */
+ {
+ unsigned char c;
+ while (white_space[c = port_data(sc->input_port)[port_position(sc->input_port)++]])
+ if (c == '\n')
+ port_line_number(sc->input_port)++;
+
+ if (c != 0)
+ {
+ backchar(c, sc->input_port);
+ push_stack(sc, OP_EVAL_STRING, sc->NIL, sc->value);
+ push_stack(sc, OP_READ_INTERNAL, sc->NIL, sc->NIL);
+ }
+ else push_stack(sc, OP_EVAL_DONE, sc->NIL, sc->value);
+ }
+ else push_stack(sc, OP_EVAL_DONE, sc->NIL, sc->value);
+ sc->code = sc->value;
+}
+
+static void eval_string_1_ex(s7_scheme *sc)
+{
+ if ((sc->tok != TOKEN_EOF) &&
+ (port_position(sc->input_port) < port_data_size(sc->input_port))) /* ran past end somehow? */
+ {
+ unsigned char c;
+ while (white_space[c = port_data(sc->input_port)[port_position(sc->input_port)++]])
+ if (c == '\n')
+ port_line_number(sc->input_port)++;
+
+ if (c != 0)
+ {
+ backchar(c, sc->input_port);
+ push_stack(sc, OP_EVAL_STRING_1, sc->NIL, sc->value);
+ push_stack(sc, OP_READ_INTERNAL, sc->NIL, sc->NIL);
+ }
+ else push_stack(sc, OP_EVAL_STRING_2, sc->NIL, sc->NIL);
+ }
+ else push_stack(sc, OP_EVAL_STRING_2, sc->NIL, sc->NIL);
+ sc->code = sc->value;
+}
+
+static int string_c_ex(s7_scheme *sc)
+{
+ s7_int index;
+ s7_pointer s, code;
+ code = sc->code;
+
+ s = find_symbol_checked(sc, car(code));
+ if ((!is_string(s)) ||
+ (!is_integer(cadr(code))))
+ return(fall_through);
+
+ index = s7_integer(cadr(code));
+ if ((index < string_length(s)) &&
+ (index >= 0))
+ {
+ if (is_byte_vector(s))
+ sc->value = small_int((unsigned char)string_value(s)[index]);
+ else sc->value = s7_make_character(sc, ((unsigned char *)string_value(s))[index]);
+ return(goto_START);
+ }
+ sc->value = string_ref_1(sc, s, cadr(code));
+ return(goto_START);
+}
+
+static int string_a_ex(s7_scheme *sc)
+{
+ s7_int index;
+ s7_pointer s, x, code;
+ code = sc->code;
+
+ s = find_symbol_checked(sc, car(code));
+ x = c_call(cdr(code))(sc, cadr(code));
+ if ((!is_string(s)) ||
+ (!s7_is_integer(x)))
+ return(fall_through);
+
+ index = s7_integer(x);
+ if ((index < string_length(s)) &&
+ (index >= 0))
+ {
+ if (is_byte_vector(s))
+ sc->value = small_int((unsigned char)string_value(s)[index]);
+ else sc->value = s7_make_character(sc, ((unsigned char *)string_value(s))[index]);
+ return(goto_START);
+ }
+ sc->value = string_ref_1(sc, s, x);
+ return(goto_START);
+}
+
+static int string_s_ex(s7_scheme *sc)
+{
+ s7_int index;
+ s7_pointer s, ind, code;
+ code = sc->code;
+
+ s = find_symbol_checked(sc, car(code));
+ ind = find_symbol_checked(sc, cadr(code));
+ if ((!is_string(s)) ||
+ (!s7_is_integer(ind)))
+ return(fall_through);
+
+ index = s7_integer(ind);
+ if ((index < string_length(s)) &&
+ (index >= 0))
+ {
+ if (is_byte_vector(s))
+ sc->value = small_int((unsigned char)string_value(s)[index]);
+ else sc->value = s7_make_character(sc, ((unsigned char *)string_value(s))[index]);
+ return(goto_START);
+ }
+ sc->value = string_ref_1(sc, s, ind);
+ return(goto_START);
+}
+
+
+static int vector_c_ex(s7_scheme *sc)
+{
+ /* this is the implicit indexing case (vector-ref is a normal safe op)
+ * (define (hi) (let ((v (vector 1 2 3))) (v 0)))
+ * this starts as unknown_g in optimize_expression -> vector_c
+ * but it still reports itself as unsafe, so there are higher levels possible
+ */
+ s7_pointer v, code;
+ code = sc->code;
+
+ v = find_symbol_checked(sc, car(code));
+ if ((!s7_is_vector(v)) ||
+ (!s7_is_integer(cadr(code)))) /* (v 4/3) */
+ return(fall_through);
+
+ if (vector_rank(v) == 1)
+ {
+ s7_int index;
+ index = s7_integer(cadr(code));
+ if ((index < vector_length(v)) &&
+ (index >= 0))
+ {
+ sc->value = vector_getter(v)(sc, v, index);
+ return(goto_START);
+ }
+ }
+ sc->value = vector_ref_1(sc, v, cdr(code));
+ return(goto_START);
+}
+
+static int vector_cc_ex(s7_scheme *sc)
+{
+ s7_pointer v, code;
+
+ code = sc->code;
+ v = find_symbol_checked(sc, car(code));
+ if (!s7_is_vector(v)) /* we've checked that the args are non-negative ints */
+ return(fall_through);
+
+ if (vector_rank(v) == 2)
+ {
+ s7_int index;
+ index = s7_integer(cadr(code)) * vector_offset(v, 0) + s7_integer(caddr(code));
+ if (index < vector_length(v))
+ {
+ sc->value = vector_getter(v)(sc, v, index);
+ return(goto_START);
+ }
+ }
+ sc->value = vector_ref_1(sc, v, cdr(code));
+ return(goto_START);
+}
+
+static int vector_s_ex(s7_scheme *sc)
+{
+ s7_pointer v, ind, code;
+
+ code = sc->code;
+ v = find_symbol_checked(sc, car(code));
+ ind = find_symbol_checked(sc, cadr(code));
+ if ((!s7_is_vector(v)) ||
+ (!s7_is_integer(ind)))
+ return(fall_through);
+
+ if (vector_rank(v) == 1)
+ {
+ s7_int index;
+ index = s7_integer(ind);
+ if ((index < vector_length(v)) &&
+ (index >= 0))
+ {
+ sc->value = vector_getter(v)(sc, v, index);
+ return(goto_START);
+ }
+ }
+ sc->value = vector_ref_1(sc, v, cons(sc, ind, sc->NIL));
+ return(goto_START);
+}
+
+static int vector_a_ex(s7_scheme *sc)
+{
+ s7_pointer v, x, code;
+
+ code = sc->code;
+ v = find_symbol_checked(sc, car(code));
+ if (!s7_is_vector(v))
+ return(fall_through);
+
+ x = c_call(cdr(code))(sc, cadr(code));
+ if (s7_is_integer(x))
+ {
+ if (vector_rank(v) == 1)
+ {
+ s7_int index;
+ index = s7_integer(x);
+ if ((index < vector_length(v)) &&
+ (index >= 0))
+ {
+ sc->value = vector_getter(v)(sc, v, index);
+ return(goto_START);
+ }
+ }
+ }
+ sc->value = vector_ref_1(sc, v, cons(sc, x, sc->NIL));
+ return(goto_START);
+}
+
+#if WITH_QUASIQUOTE_VECTOR
+static void read_quasiquote_vector_ex(s7_scheme *sc)
+{
+ /* this works only if the quasiquoted list elements can be evaluated in the read-time environment.
+ * `#(1 ,@(list 1 2) 4) -> (apply vector ({list} 1 ({apply_values} (list 1 2)) 4)) -> #(1 1 2 4)
+ *
+ * Originally, I used:
+ * sc->value = list_3(sc, sc->Apply, sc->Vector, g_quasiquote_1(sc, sc->value));
+ * goto START;
+ * which means that #(...) makes a vector at read time, but `#(...) is just like (vector ...).
+ * :(let ((f1 (lambda () (let ((x 32)) #(x 0))))
+ * (f2 (lambda () (let ((x 32)) `#(,x 0)))))
+ * (eq? (f1) (f1)))
+ * #t
+ * :(let ((f1 (lambda () (let ((x 32)) #(x 0))))
+ * (f2 (lambda () (let ((x 32)) `#(,x 0)))))
+ * (eq? (f2) (f2)))
+ * #f
+ * The tricky part in s7 is that we might have quasiquoted multidimensional vectors
+ */
+ if (sc->args == small_int(1))
+ sc->code = list_3(sc, sc->Apply, sc->Vector, g_quasiquote_1(sc, sc->value)); /* qq result will be evaluated (might include {list} etc) */
+ else sc->code = list_4(sc, sc->Apply, sc->Multivector, sc->args, g_quasiquote_1(sc, sc->value));
+}
+#endif
+
+static void increment_1_ex(s7_scheme *sc)
+{
+ /* ([set!] ctr (+ ctr 1)) */
+ s7_pointer val, y;
+
+ y = find_symbol(sc, car(sc->code));
+ if (!is_slot(y))
+ eval_error_no_return(sc, sc->WRONG_TYPE_ARG, "set! ~A: unbound variable", car(sc->code));
+
+ val = slot_value(y);
+ switch (type(val))
+ {
+ case T_INTEGER:
+ sc->value = make_integer(sc, integer(val) + 1); /* this can't be optimized to treat y's value as a mutable integer */
+ break;
+
+ case T_RATIO:
+ new_cell(sc, sc->value, T_RATIO);
+ numerator(sc->value) = numerator(val) + denominator(val);
+ denominator(sc->value) = denominator(val);
+ break;
+
+ case T_REAL:
+ sc->value = make_real(sc, real(val) + 1.0);
+ break;
+
+ case T_COMPLEX:
+ new_cell(sc, sc->value, T_COMPLEX);
+ set_real_part(sc->value, real_part(val) + 1.0);
+ set_imag_part(sc->value, imag_part(val));
+ break;
+
+ default:
+ sc->value = g_add(sc, set_plist_2(sc, val, small_int(1)));
+ break;
+ }
+ slot_set_value(y, sc->value);
+}
+
+static void decrement_1_ex(s7_scheme *sc)
+{
+ /* ([set!] ctr (- ctr 1)) */
+ s7_pointer val, y;
+ y = find_symbol(sc, car(sc->code));
+ if (!is_slot(y))
+ eval_error_no_return(sc, sc->WRONG_TYPE_ARG, "set! ~A: unbound variable", car(sc->code));
+ val = slot_value(y);
+ switch (type(val))
+ {
+ case T_INTEGER:
+ sc->value = make_integer(sc, integer(val) - 1);
+ break;
+
+ case T_RATIO:
+ new_cell(sc, sc->value, T_RATIO);
+ numerator(sc->value) = numerator(val) - denominator(val);
+ denominator(sc->value) = denominator(val);
+ break;
+
+ case T_REAL:
+ sc->value = make_real(sc, real(val) - 1.0);
+ break;
+
+ case T_COMPLEX:
+ new_cell(sc, sc->value, T_COMPLEX);
+ set_real_part(sc->value, real_part(val) - 1.0);
+ set_imag_part(sc->value, imag_part(val));
+ break;
+
+ default:
+ sc->value = g_subtract(sc, set_plist_2(sc, val, small_int(1)));
+ break;
+ }
+ slot_set_value(y, sc->value);
+}
+
+static void set_pws_ex(s7_scheme *sc)
+{
+ /* ([set!] (save-dir) "/home/bil/zap/snd") */
+ s7_pointer obj;
+
+ obj = caar(sc->code);
+ if (is_symbol(obj))
+ {
+ obj = find_symbol(sc, obj);
+ if (is_slot(obj))
+ obj = slot_value(obj);
+ else eval_error_no_return(sc, sc->SYNTAX_ERROR, "no generalized set for ~A", caar(sc->code));
+ }
+
+ if ((is_c_function(obj)) &&
+ (is_procedure(c_function_setter(obj))))
+ {
+ s7_pointer value;
+ value = cadr(sc->code);
+ if (is_symbol(value))
+ value = find_symbol_checked(sc, value);
+
+ car(sc->T1_1) = value;
+ sc->value = c_function_call(c_function_setter(obj))(sc, sc->T1_1);
+ }
+ else eval_error_no_return(sc, sc->SYNTAX_ERROR, "no generalized set for ~A", obj);
+}
+
+
+/* -------------------------------- apply functions -------------------------------- */
+
+static void apply_c_function(s7_scheme *sc) /* -------- C-based function -------- */
+{
+ unsigned int len;
+ len = safe_list_length(sc, sc->args);
+ if (len < c_function_required_args(sc->code))
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->NOT_ENOUGH_ARGUMENTS, sc->code, sc->args));
+ if (c_function_all_args(sc->code) < len)
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->TOO_MANY_ARGUMENTS, sc->code, sc->args));
+ sc->value = c_function_call(sc->code)(sc, sc->args);
+}
+
+static void apply_c_opt_args_function(s7_scheme *sc) /* -------- C-based function that has n optional arguments -------- */
+{
+ unsigned int len;
+ len = safe_list_length(sc, sc->args);
+ if (c_function_all_args(sc->code) < len)
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->TOO_MANY_ARGUMENTS, sc->code, sc->args));
+ sc->value = c_function_call(sc->code)(sc, sc->args);
+}
+
+static void apply_c_rst_args_function(s7_scheme *sc) /* -------- C-based function that has n required args, then any others -------- */
+{
+ unsigned int len;
+ len = safe_list_length(sc, sc->args);
+ if (len < c_function_required_args(sc->code))
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->NOT_ENOUGH_ARGUMENTS, sc->code, sc->args));
+ sc->value = c_function_call(sc->code)(sc, sc->args);
+ /* sc->code here need not match sc->code before the function call (map for example) */
+}
+
+static void apply_c_any_args_function(s7_scheme *sc) /* -------- C-based function that can take any number of arguments -------- */
+{
+ sc->value = c_function_call(sc->code)(sc, sc->args);
+}
+
+static void apply_c_function_star(s7_scheme *sc) /* -------- C-based function with defaults (lambda*) -------- */
+{
+ sc->value = c_function_call(sc->code)(sc, set_c_function_call_args(sc));
+}
+
+static void apply_c_macro(s7_scheme *sc) /* -------- C-based macro -------- */
+{
+ int len;
+ len = s7_list_length(sc, sc->args);
+
+ if (len < (int)c_macro_required_args(sc->code))
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->NOT_ENOUGH_ARGUMENTS, sc->code, sc->args));
+
+ if ((int)c_macro_all_args(sc->code) < len)
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->TOO_MANY_ARGUMENTS, sc->code, sc->args));
+
+ sc->code = c_macro_call(sc->code)(sc, sc->args);
+ if (is_multiple_value(sc->code)) /* can this happen? s7_values splices before returning, and `(values ...) is handled later */
+ {
+ push_stack(sc, OP_EVAL_MACRO_MV, sc->NIL, cdr(sc->code));
+ sc->code = car(sc->code);
+ }
+}
+
+static void apply_syntax(s7_scheme *sc) /* -------- syntactic keyword as applicable object -------- */
+{ /* current reader-cond macro uses this via (map quote ...) */
+ int len; /* ((apply lambda '((x) (+ x 1))) 4) */
+ if (is_pair(sc->args))
+ {
+ len = s7_list_length(sc, sc->args);
+ if (len == 0) eval_error_no_return(sc, sc->SYNTAX_ERROR, "attempt to evaluate a circular list: ~A", sc->args);
+ }
+ else len = 0;
+
+ if (len < syntax_min_args(sc->code))
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->NOT_ENOUGH_ARGUMENTS, sc->code, sc->args));
+
+ if ((syntax_max_args(sc->code) < len) &&
+ (syntax_max_args(sc->code) != -1))
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->TOO_MANY_ARGUMENTS, sc->code, sc->args));
+
+ sc->op = (opcode_t)syntax_opcode(sc->code); /* (apply begin '((define x 3) (+ x 2))) */
+ /* I used to have elaborate checks here for embedded circular lists, but now i think that is the caller's problem */
+ sc->code = sc->args;
+}
+
+static void apply_vector(s7_scheme *sc) /* -------- vector as applicable object -------- */
+{
+ /* sc->code is the vector, sc->args is the list of indices */
+ if (is_null(sc->args)) /* (#2d((1 2) (3 4))) */
+ s7_wrong_number_of_args_error(sc, "not enough args for vector-ref: ~A", sc->args);
+
+ if ((is_null(cdr(sc->args))) &&
+ (s7_is_integer(car(sc->args))) &&
+ (vector_rank(sc->code) == 1))
+ {
+ s7_int index;
+ index = s7_integer(car(sc->args));
+ if ((index >= 0) &&
+ (index < vector_length(sc->code)))
+ sc->value = vector_getter(sc->code)(sc, sc->code, index);
+ else out_of_range(sc, sc->VECTOR_REF, small_int(2), car(sc->args), (index < 0) ? ITS_NEGATIVE : ITS_TOO_LARGE);
+ }
+ else sc->value = vector_ref_1(sc, sc->code, sc->args);
+}
+
+static void apply_string(s7_scheme *sc) /* -------- string as applicable object -------- */
+{
+ if (is_null(cdr(sc->args)))
+ {
+ if (s7_is_integer(car(sc->args)))
+ {
+ s7_int index; /* not int: ("abs" most-negative-fixnum) */
+ index = s7_integer(car(sc->args));
+ if ((index >= 0) &&
+ (index < string_length(sc->code)))
+ {
+ if (is_byte_vector(sc->code))
+ sc->value = small_int((unsigned char)(string_value(sc->code))[index]);
+ else sc->value = s7_make_character(sc, ((unsigned char *)string_value(sc->code))[index]);
+ return;
+ }
+ }
+ sc->value = string_ref_1(sc, sc->code, car(sc->args));
+ return;
+ }
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
+ set_elist_3(sc, (is_null(sc->args)) ? sc->NOT_ENOUGH_ARGUMENTS : sc->TOO_MANY_ARGUMENTS, sc->code, sc->args));
+}
+
+static int apply_pair(s7_scheme *sc) /* -------- list as applicable object -------- */
+{
+ if (is_multiple_value(sc->code)) /* ((values 1 2 3) 0) */
+ {
+ /* car of values can be anything, so conjure up a new expression, and apply again */
+ sc->x = multiple_value(sc->code); /* ((values + 1 2) 3) */
+ sc->code = car(sc->x);
+ sc->args = s7_append(sc, cdr(sc->x), sc->args);
+ sc->x = sc->NIL;
+ return(goto_APPLY);
+ }
+ if (is_null(sc->args))
+ s7_wrong_number_of_args_error(sc, "not enough args for list-ref (via list as applicable object): ~A", sc->args);
+ sc->value = list_ref_1(sc, sc->code, car(sc->args)); /* (L 1) */
+ if (!is_null(cdr(sc->args)))
+ sc->value = implicit_index(sc, sc->value, cdr(sc->args)); /* (L 1 2) */
+ return(goto_START);
+}
+
+static void apply_hash_table(s7_scheme *sc) /* -------- hash-table as applicable object -------- */
+{
+ if (is_null(sc->args))
+ s7_wrong_number_of_args_error(sc, "not enough args for hash-table-ref (via hash table as applicable object): ~A", sc->args);
+ sc->value = s7_hash_table_ref(sc, sc->code, car(sc->args));
+ if (!is_null(cdr(sc->args)))
+ sc->value = implicit_index(sc, sc->value, cdr(sc->args));
+}
+
+static void apply_let(s7_scheme *sc) /* -------- environment as applicable object -------- */
+{
+ if (is_null(sc->args))
+ sc->value = s7_let_ref(sc, sc->code, sc->F); /* why #f and not ()? both are ok in s7test */
+ else sc->value = s7_let_ref(sc, sc->code, car(sc->args));
+ if (is_pair(cdr(sc->args)))
+ sc->value = implicit_index(sc, sc->value, cdr(sc->args));
+ /* (let ((v #(1 2 3))) (let ((e (curlet))) ((e 'v) 1))) -> 2
+ * so (let ((v #(1 2 3))) (let ((e (curlet))) (e 'v 1))) -> 2
+ */
+}
+
+static void apply_iterator(s7_scheme *sc) /* -------- iterator as applicable object -------- */
+{
+ if (!is_null(sc->args))
+ s7_wrong_number_of_args_error(sc, "too many args for iterator: ~A", sc->args);
+ sc->value = s7_iterate(sc, sc->code);
+}
+
+static void apply_lambda(s7_scheme *sc) /* -------- normal function (lambda), or macro -------- */
+{ /* load up the current args into the ((args) (lambda)) layout [via the current environment] */
+ /* not often safe closure here, and very confusing if so to get identity macro args handled correctly */
+ s7_pointer x, z, e;
+ unsigned long long int id;
+ e = sc->envir;
+ id = let_id(e);
+
+ for (x = closure_args(sc->code), z = sc->args; is_pair(x); x = cdr(x))
+ {
+ s7_pointer sym, args, val;
+ /* reuse the value cells as the new frame slots */
+
+ if (is_null(z))
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->NOT_ENOUGH_ARGUMENTS, closure_name(sc, sc->code), sc->cur_code));
+ /* now that args are being reused as slots, the error message can't use sc->args,
+ * so fallback on sc->cur_code in this section.
+ * But that can be #f, and closure_name can be confusing in this context, so we need a better error message!
+ */
+
+ sym = car(x);
+ val = car(z);
+ args = cdr(z);
+ set_type(z, T_SLOT);
+ slot_set_symbol(z, sym);
+ symbol_set_local(sym, id, z);
+ slot_set_value(z, val);
+ next_slot(z) = let_slots(e);
+ let_set_slots(e, z);
+ z = args;
+ }
+ if (is_null(x))
+ {
+ if (is_not_null(z))
+ s7_error(sc, sc->WRONG_NUMBER_OF_ARGS, set_elist_3(sc, sc->TOO_MANY_ARGUMENTS, closure_name(sc, sc->code), sc->cur_code));
+ }
+ else
+ {
+ sc->temp6 = z; /* the rest arg */
+ make_slot_1(sc, sc->envir, x, z);
+ sc->temp6 = sc->NIL;
+ }
+ sc->code = closure_body(sc->code);
+}
+
+static int apply_lambda_star(s7_scheme *sc) /* -------- define* (lambda*) -------- */
+{
+ /* to check for and fixup unset args from defaults, we need to traverse the slots in left-to-right order
+ * but they are stored backwards in the environment, so use pending_value as a back-pointer.
+ * We have to build the environment before calling lambda_star_set_args because keywords can
+ * cause any arg to be set at any point in the arg list.
+ *
+ * the frame-making step below could be precalculated, but where to store it?
+ */
+ s7_pointer z, top, nxt;
+ top = NULL;
+ nxt = NULL;
+ for (z = closure_args(sc->code); is_pair(z); z = cdr(z))
+ {
+ s7_pointer car_z;
+ car_z = car(z);
+ if (is_pair(car_z)) /* arg has a default value of some sort */
+ {
+ s7_pointer val;
+ val = cadr(car_z);
+ if ((!is_pair(val)) &&
+ (!is_symbol(val)))
+ make_slot_1(sc, sc->envir, car(car_z), val);
+ else
+ {
+ s7_pointer y;
+ add_slot(sc->envir, car(car_z), sc->UNDEFINED);
+ y = let_slots(sc->envir);
+ slot_expression(y) = cadr(car_z);
+ slot_pending_value(y) = sc->NIL;
+ if (!top)
+ {
+ top = y;
+ nxt = top;
+ }
+ else
+ {
+ slot_pending_value(nxt) = y;
+ nxt = y;
+ }
+ }
+ }
+ else
+ {
+ if (!is_keyword(car_z))
+ make_slot_1(sc, sc->envir, car_z, sc->F);
+ else
+ {
+ if (car_z == sc->KEY_REST)
+ {
+ make_slot_1(sc, sc->envir, cadr(z), sc->NIL);
+ z = cdr(z);
+ }
+ }
+ }
+ }
+ if (is_symbol(z))
+ make_slot_1(sc, sc->envir, z, sc->NIL);
+ lambda_star_set_args(sc); /* load up current arg vals */
+
+ if (top)
+ {
+ /* get default values, which may involve evaluation */
+ push_stack(sc, OP_LAMBDA_STAR_DEFAULT, sc->args, sc->code); /* op is just a placeholder (don't use OP_BARRIER here) */
+ sc->args = top;
+ if (lambda_star_default(sc) == goto_EVAL) return(goto_EVAL);
+ pop_stack_no_op(sc); /* get original args and code back */
+ }
+
+ sc->code = closure_body(sc->code);
+ return(goto_BEGIN1);
+}
+
+static void apply_continuation(s7_scheme *sc) /* -------- continuation ("call/cc") -------- */
+{
+ if (!call_with_current_continuation(sc))
+ {
+ static s7_pointer cc_err = NULL;
+ if (!cc_err) cc_err = s7_make_permanent_string("continuation can't jump into with-baffle");
+ s7_error(sc, sc->BAFFLED, set_elist_1(sc, cc_err));
+ }
+}
+
+static void apply_c_object(s7_scheme *sc) /* -------- applicable (new-type) object -------- */
+{
+ sc->value = (*(c_object_ref(sc->code)))(sc, sc->code, sc->args);
+}
+
+
+
+
+/* -------------------------------------------------------------------------------- */
+
+static int define1_ex(s7_scheme *sc)
+{
+ /* sc->code is the symbol being defined, sc->value is its value
+ * if sc->value is a closure, car is of the form ((args...) body...)
+ * so the doc string if any is (cadr (car value))
+ * and the arg list gives the number of optional args up to the dot
+ */
+
+ /* it's not possible to expand and replace macros at this point without evaluating
+ * the body. Just as examples, say we have a macro "mac",
+ * (define (hi) (call/cc (lambda (mac) (mac 1))))
+ * (define (hi) (quote (mac 1))) or macroexpand etc
+ * (define (hi mac) (mac 1)) assuming mac here is a function passed as an arg,
+ * etc...
+ */
+
+ /* the immutable constant check needs to wait until we have the actual new value because
+ * we want to ignore the rebinding (not raise an error) if it is the existing value.
+ * This happens when we reload a file that calls define-constant.
+ */
+ if (is_immutable(sc->code)) /* (define pi 3) or (define (pi a) a) */
+ {
+ s7_pointer x;
+ if (!is_symbol(sc->code)) /* (define "pi" 3) ? */
+ eval_error_no_return(sc, sc->SYNTAX_ERROR, "define: ~S is immutable", sc->code);
+
+ x = global_slot(sc->code);
+ if ((!is_slot(x)) ||
+ (type(sc->value) != unchecked_type(slot_value(x))) ||
+ (!s7_is_morally_equal(sc, sc->value, slot_value(x)))) /* if value is unchanged, just ignore this (re)definition */
+ eval_error_no_return(sc, sc->SYNTAX_ERROR, "define: ~S is immutable", sc->code); /* can't use s7_is_equal because value might be NaN, etc */
+ }
+ if (symbol_has_accessor(sc->code))
+ {
+ s7_pointer x;
+ x = find_symbol(sc, sc->code);
+ if ((is_slot(x)) &&
+ (slot_has_accessor(x)))
+ {
+ sc->value = bind_accessed_symbol(sc, OP_DEFINE_WITH_ACCESSOR, sc->code, sc->value);
+ if (sc->value == sc->NO_VALUE)
+ return(goto_APPLY);
+ /* if all goes well, OP_DEFINE_WITH_ACCESSOR will jump to DEFINE2 */
+ }
+ }
+ return(fall_through);
+}
+
+static void define2_ex(s7_scheme *sc)
+{
+ if (is_any_closure(sc->value))
+ {
+ s7_pointer new_func, new_env;
+ new_func = sc->value;
+
+ /* we can get here from let: (define (outer a) (let () (define (inner b) (+ a b)) (inner a)))
+ * but the port info is not relevant here, so restrict the __func__ list making to top-level
+ * cases (via sc->envir == sc->NIL).
+ */
+
+ new_cell_no_check(sc, new_env, T_LET | T_FUNCTION_ENV);
+ let_id(new_env) = ++sc->let_number;
+ set_outlet(new_env, closure_let(new_func));
+ closure_set_let(new_func, new_env);
+ let_set_slots(new_env, sc->NIL);
+ funclet_set_function(new_env, sc->code);
+
+ if ((!is_let(sc->envir)) &&
+ (port_filename(sc->input_port)) &&
+ (port_file(sc->input_port) != stdin))
+ {
+ /* unbound_variable will be called if __func__ is encountered, and will return this info as if __func__ had some meaning */
+ let_set_file(new_env, port_file_number(sc->input_port));
+ let_set_line(new_env, port_line_number(sc->input_port));
+ }
+ else
+ {
+ let_set_file(new_env, 0);
+ let_set_line(new_env, 0);
+ }
+
+ /* this should happen only if the closure* default values do not refer in any way to
+ * the enclosing environment (else we can accidentally shadow something that happens
+ * to share an argument name that is being used as a default value -- kinda dumb!).
+ * I think I'll check this before setting the safe_closure bit.
+ */
+ if (is_safe_closure(new_func))
+ {
+ int i;
+ s7_pointer arg;
+ for (i = 0, arg = closure_args(new_func); is_pair(arg); i++, arg = cdr(arg))
+ {
+ if (is_pair(car(arg)))
+ make_slot_1(sc, new_env, caar(arg), sc->NIL);
+ else make_slot_1(sc, new_env, car(arg), sc->NIL);
+ }
+ let_set_slots(new_env, reverse_slots(sc, let_slots(new_env)));
+ }
+ /* add the newly defined thing to the current environment */
+ if (is_let(sc->envir))
+ {
+ add_slot(sc->envir, sc->code, new_func);
+ set_local(sc->code);
+ /* so funchecked is always local already -- perhaps reset below? */
+ }
+ else s7_make_slot(sc, sc->envir, sc->code, new_func);
+ sc->value = new_func; /* 25-Jul-14 so define returns the value not the name */
+ }
+ else
+ {
+ s7_pointer lx;
+ /* add the newly defined thing to the current environment */
+ lx = find_local_symbol(sc, sc->code, sc->envir);
+ if (is_slot(lx))
+ slot_set_value(lx, sc->value);
+ else s7_make_slot(sc, sc->envir, sc->code, sc->value);
+ }
+}
+
+
+/* ---------------------------------------- */
+
+static void clear_all_optimizations(s7_scheme *sc, s7_pointer p)
+{
+ /* I believe that we would not have been optimized to begin with if the tree were circular,
+ * and this tree is supposed to be a function call + args -- a circular list here is a bug.
+ */
+ if (is_pair(p))
+ {
+ if (is_optimized(p))
+ {
+ clear_optimized(p);
+ clear_optimize_op(p);
+ set_opt_con1(p, sc->NIL);
+ set_opt_con2(p, sc->NIL);
+
+ }
+ clear_all_optimizations(sc, cdr(p));
+ clear_all_optimizations(sc, car(p));
+ }
+}
+
+
+static bool a_is_ok(s7_scheme *sc, s7_pointer p)
+{
+ /* "A" here need not be a function call or "p" a pair (all_x_c etc) */
+ if (is_pair(p))
+ {
+ if ((is_optimized(p)) &&
+ (!c_function_is_ok(sc, p)))
+ return(false);
+ if (car(p) != sc->QUOTE)
+ return((a_is_ok(sc, car(p))) &&
+ (a_is_ok(sc, cdr(p))));
+ }
+ return(true);
+}
+
+#define c_function_is_ok_cadr(Sc, P) ((c_function_is_ok(Sc, P)) && (c_function_is_ok(Sc, cadr(P))))
+#define c_function_is_ok_caddr(Sc, P) ((c_function_is_ok(Sc, P)) && (c_function_is_ok(Sc, caddr(P))))
+#define c_function_is_ok_cadr_caddr(Sc, P) ((c_function_is_ok(Sc, P)) && (c_function_is_ok(Sc, cadr(P))) && (c_function_is_ok(Sc, caddr(P))))
+
+#define a_is_ok_cadr(Sc, P) ((c_function_is_ok(Sc, P)) && (a_is_ok(Sc, cadr(P))))
+#define a_is_ok_caddr(Sc, P) ((c_function_is_ok(Sc, P)) && (a_is_ok(Sc, caddr(P))))
+#define a_is_ok_cadddr(Sc, P) ((c_function_is_ok(Sc, P)) && (a_is_ok(Sc, cadddr(P))))
+
+
+
+
+/* -------------------------------- eval -------------------------------- */
+
+#if WITH_GCC
+#undef new_cell
+#if (!DEBUGGING)
+#define new_cell(Sc, Obj, Type) \
+ do { \
+ if (Sc->free_heap_top <= Sc->free_heap_trigger) {try_to_call_gc(Sc); if ((Sc->begin_hook) && (call_begin_hook(Sc))) return(Sc->F);} \
+ Obj = (*(--(Sc->free_heap_top))); \
+ set_type(Obj, Type); \
+ } while (0)
+#else
+#define new_cell(Sc, Obj, Type) \
+ do { \
+ if ((Sc->free_heap_top <= Sc->free_heap_trigger) || (for_any_other_reason(sc, __LINE__))) {last_gc_line = __LINE__; last_gc_func = __func__; try_to_call_gc(Sc); if ((Sc->begin_hook) && (call_begin_hook(Sc))) return(Sc->F);} \
+ Obj = (*(--(Sc->free_heap_top))); \
+ Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; \
+ set_type(Obj, Type); \
+ } while (0)
+#endif
+#endif
+
+#if WITH_GMP
+#define global_add big_add
+#else
+#define global_add g_add
+#endif
+
+static s7_pointer check_for_cyclic_code(s7_scheme *sc, s7_pointer code)
+{
+ if (cyclic_sequences(sc, code, false) == sc->T)
+ eval_error(sc, "attempt to evaluate a circular list: ~A", code);
+ resize_stack(sc);
+ return(sc->F);
+}
+
+
+static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
+{
+ sc->op = first_op;
+
+ /* this procedure can be entered recursively (via s7_call for example), so it's no place for a setjmp
+ * I don't think the recursion can hurt our continuations because s7_call is coming from hooks and
+ * callbacks that are implicit in our stack.
+ */
+
+ goto START_WITHOUT_POP_STACK;
+ /* this ugly two-step is faster than other ways of writing this code */
+ while (true)
+ {
+ START:
+ pop_stack(sc);
+
+ /* syntax_opcode can be optimize_op, the field can be set at read time, we could
+ * probably combine the optimized and normal case statements, jump here if eval (eval_pair, opt_eval),
+ * and thereby save the is_syntactic and is_pair check in op_eval, op_begin would explicitly jump back here, no op_eval,
+ * current trailers would be outside? and where would eval args go? Huge change, might save 1% if lucky.
+ * see end of file -- I think this is too pessimistic and given rearrangement of the s7_cell layout,
+ * can be done without an increase in size.
+ *
+ * about half the cases don't care about args or op, but it's not simple to distribute the sc->args
+ * setting throughout this switch statement. Lots of branches fall through to the next and there
+ * are many internal goto's to branches, so the code becomes a mess. sc->op is even worse because
+ * we use it in several cases for error information or choice of next op, etc.
+ */
+
+ START_WITHOUT_POP_STACK:
+ /* fprintf(stderr, "%s (%d)\n", op_names[sc->op], (int)(sc->op)); */
+ switch (sc->op)
+ {
+ case OP_NO_OP:
+ break;
+
+ case OP_READ_INTERNAL:
+ /* if we're loading a file, and in the file we evaluate something like:
+ * (let ()
+ * (set-current-input-port (open-input-file "tmp2.r5rs"))
+ * (close-input-port (current-input-port)))
+ * ... (with no reset of input port to its original value)
+ * the load process tries to read the loaded string, but the sc->input_port is now closed,
+ * and the original is inaccessible! So we get a segfault in token. We don't want to put
+ * a port_is_closed check there because token only rarely is in this danger. I think this
+ * is the only place where we can be about to call token, and someone has screwed up our port.
+ *
+ * We can't call read_error here because it assumes the input string is ok!
+ */
+
+ if (port_is_closed(sc->input_port))
+ return(s7_error(sc, sc->READ_ERROR, set_elist_1(sc, make_string_wrapper(sc, "our input port got clobbered!"))));
+
+ sc->tok = token(sc);
+ switch (sc->tok)
+ {
+ case TOKEN_EOF:
+ {
+ /* (eval-string "'a ; b") gets here with 'a -> a, so we need to squelch the pending eval.
+ * another approach would read-ahead in eval_string_1_ex, but this seems less messy.
+ */
+ int top;
+ top = s7_stack_top(sc) - 1;
+ if (stack_op(sc->stack, top) == OP_EVAL_STRING_1)
+ vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_STRING_2;
+ }
+ break;
+
+ case TOKEN_RIGHT_PAREN:
+ read_error(sc, "unexpected close paren");
+
+ case TOKEN_COMMA:
+ read_error(sc, "unexpected comma");
+
+ default:
+ sc->value = read_expression(sc);
+ sc->current_line = port_line_number(sc->input_port); /* this info is used to track down missing close parens */
+ sc->current_file = port_filename(sc->input_port);
+ break;
+ }
+ break;
+
+
+ /* (read p) from scheme
+ * "p" becomes current input port for eval's duration, then pops back before returning value into calling expr
+ */
+ case OP_READ_DONE:
+ pop_input_port(sc);
+
+ if (sc->tok == TOKEN_EOF)
+ sc->value = sc->EOF_OBJECT;
+ sc->current_file = NULL; /* this is for error handling */
+ break;
+
+
+ /* load("file"); from C (g_load) -- assume caller will clean up
+ * read and evaluate exprs until EOF that matches (stack reflects nesting)
+ */
+ case OP_LOAD_RETURN_IF_EOF: /* loop here until eof (via push stack below) */
+ if (sc->tok != TOKEN_EOF)
+ {
+ push_stack(sc, OP_LOAD_RETURN_IF_EOF, sc->NIL, sc->NIL);
+ push_stack(sc, OP_READ_INTERNAL, sc->NIL, sc->NIL);
+ sc->code = sc->value;
+ goto EVAL; /* we read an expression, now evaluate it, and return to read the next */
+ }
+ sc->current_file = NULL;
+ return(sc->F);
+
+
+ /* (load "file") in scheme
+ * read and evaluate all exprs, then upon EOF, close current and pop input port stack
+ */
+ case OP_LOAD_CLOSE_AND_POP_IF_EOF:
+ if (sc->tok != TOKEN_EOF)
+ {
+ push_stack(sc, OP_LOAD_CLOSE_AND_POP_IF_EOF, sc->NIL, sc->NIL); /* was push args, code */
+ if ((!is_string_port(sc->input_port)) ||
+ (port_position(sc->input_port) < port_data_size(sc->input_port)))
+ {
+ push_stack(sc, OP_READ_INTERNAL, sc->NIL, sc->NIL);
+ }
+ else sc->tok = TOKEN_EOF;
+ sc->code = sc->value;
+ goto EVAL; /* we read an expression, now evaluate it, and return to read the next */
+ }
+ s7_close_input_port(sc, sc->input_port);
+ pop_input_port(sc);
+ sc->current_file = NULL;
+
+ if (is_multiple_value(sc->value)) /* (load "file") where "file" is (values 1 2 3) */
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ break;
+
+
+ case OP_EVAL_STRING:
+ eval_string_ex(sc);
+ goto EVAL;
+
+ case OP_EVAL_STRING_2:
+ s7_close_input_port(sc, sc->input_port);
+ pop_input_port(sc);
+
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ break;
+
+ case OP_EVAL_STRING_1:
+ eval_string_1_ex(sc);
+ goto EVAL;
+
+
+ /* -------------------- sort! (heapsort, done directly so that call/cc in the sort function will work correctly) -------------------- */
+
+ #define SORT_N integer(vector_element(sc->code, 0))
+ #define SORT_K integer(vector_element(sc->code, 1))
+ #define SORT_J integer(vector_element(sc->code, 2))
+ #define SORT_K1 integer(vector_element(sc->code, 3))
+ #define SORT_CALLS integer(vector_element(sc->code, 4))
+ #define SORT_STOP integer(vector_element(sc->code, 5))
+ #define SORT_DATA(K) vector_element(car(sc->args), K)
+ #define SORT_LESSP cadr(sc->args)
+
+ HEAPSORT:
+ {
+ s7_int n, j, k;
+ s7_pointer lx;
+ n = SORT_N;
+ k = SORT_K1;
+
+ if ((n == k) || (k > ((s7_int)(n / 2)))) /* k == n == 0 is the first case */
+ goto START;
+
+ if (sc->safety != 0)
+ {
+ SORT_CALLS++;
+ if (SORT_CALLS > SORT_STOP)
+ eval_range_error(sc, "sort! is caught in an infinite loop, comparison: ~S", SORT_LESSP);
+ }
+ j = 2 * k;
+ SORT_J = j;
+ if (j < n)
+ {
+ push_stack(sc, OP_SORT1, sc->args, sc->code);
+ lx = SORT_LESSP; /* cadr of sc->args */
+ if (needs_copied_args(lx))
+ sc->args = list_2(sc, SORT_DATA(j), SORT_DATA(j + 1));
+ else
+ {
+ car(sc->T2_1) = SORT_DATA(j);
+ car(sc->T2_2) = SORT_DATA(j + 1);
+ sc->args = sc->T2_1;
+ }
+ sc->code = lx;
+ goto APPLY;
+ }
+ else sc->value = sc->F;
+ }
+
+ case OP_SORT1:
+ {
+ s7_int j, k;
+ s7_pointer lx;
+ k = SORT_K1;
+ j = SORT_J;
+ if (is_true(sc, sc->value))
+ {
+ j = j + 1;
+ SORT_J = j;
+ }
+ push_stack(sc, OP_SORT2, sc->args, sc->code);
+ lx = SORT_LESSP;
+ if (needs_copied_args(lx))
+ sc->args = list_2(sc, SORT_DATA(k), SORT_DATA(j));
+ else
+ {
+ car(sc->T2_1) = SORT_DATA(k);
+ car(sc->T2_2) = SORT_DATA(j);
+ sc->args = sc->T2_1;
+ }
+ sc->code = lx;
+ goto APPLY;
+ }
+
+ case OP_SORT2:
+ {
+ s7_int j, k;
+ k = SORT_K1;
+ j = SORT_J;
+ if (is_true(sc, sc->value))
+ {
+ s7_pointer lx;
+ lx = SORT_DATA(j);
+ SORT_DATA(j) = SORT_DATA(k);
+ SORT_DATA(k) = lx;
+ }
+ else goto START;
+ SORT_K1 = SORT_J;
+ goto HEAPSORT;
+ }
+
+ case OP_SORT:
+ /* coming in sc->args is sort args (data less?), sc->code = '(n k 0)
+ * here we call the inner loop until k <= 0 [the local k! -- this is tricky because scheme passes args by value]
+ */
+ {
+ s7_int k;
+ k = SORT_K;
+ if (k > 0)
+ {
+ SORT_K = k - 1;
+ SORT_K1 = k - 1;
+ push_stack(sc, OP_SORT, sc->args, sc->code);
+ goto HEAPSORT;
+ }
+ /* else fall through */
+ }
+
+ case OP_SORT3:
+ {
+ s7_int n;
+ s7_pointer lx;
+ n = SORT_N;
+ if (n <= 0)
+ {
+ sc->value = car(sc->args);
+ goto START;
+ }
+ lx = SORT_DATA(0);
+ SORT_DATA(0) = SORT_DATA(n);
+ SORT_DATA(n) = lx;
+ SORT_N = n - 1;
+ SORT_K1 = 0;
+ push_stack(sc, OP_SORT3, sc->args, sc->code);
+ goto HEAPSORT;
+ }
+
+ case OP_SORT_PAIR_END: /* sc->value is the sort vector which needs to be copied into the original list */
+ sc->value = vector_into_list(sc->value, car(sc->args));
+ break;
+
+ case OP_SORT_VECTOR_END: /* sc->value is the sort (s7_pointer) vector which needs to be copied into the original (double/int) vector */
+ sc->value = vector_into_fi_vector(sc->value, car(sc->args));
+ break;
+
+ case OP_SORT_STRING_END:
+ sc->value = vector_into_string(sc->value, car(sc->args));
+ break;
+
+ /* batcher networks:
+ * ((0 2) (0 1) (1 2))
+ * ((0 2) (1 3) (0 1) (2 3) (1 2))
+ * etc -- see batcher in s7test.scm (from Doug Hoyte)
+ * but since it has to be done here by hand, it turns into too much code, 3 is:
+ * < l0 l2 ?
+ * no goto L1
+ * < l0 l1 ?
+ * no return 1 0 2
+ * < l1 l2?
+ * yes return 0 1 2 (direct)
+ * no return 0 2 1
+ * L1:
+ * < l0 l1 ?
+ * yes return 2 0 1
+ * < l1 l2 ?
+ * yes return 1 2 0
+ * no return 2 1 0
+ * since each "<" op above goes to OP_APPLY, we have ca 5 labels, and ca 25-50 lines
+ */
+
+
+ /* -------------------------------- MAP -------------------------------- */
+ case OP_MAP_GATHER_1:
+ if (sc->value != sc->NO_VALUE)
+ {
+ if (is_multiple_value(sc->value))
+ counter_result(sc->args) = revappend(sc, multiple_value(sc->value), counter_result(sc->args));
+ else counter_result(sc->args) = cons(sc, sc->value, counter_result(sc->args));
+ }
+
+ case OP_MAP_1:
+ {
+ s7_pointer x, args, code, p;
+ code = sc->code;
+ args = sc->args;
+ p = counter_list(args);
+ x = s7_iterate(sc, p);
+
+ if (iterator_is_at_end(p))
+ {
+ sc->value = safe_reverse_in_place(sc, counter_result(args));
+ goto START;
+ }
+ push_stack(sc, OP_MAP_GATHER_1, args, code);
+ if (counter_capture(args) != sc->capture_let_counter)
+ {
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), x);
+ counter_set_let(args, sc->envir);
+ counter_capture(args) = sc->capture_let_counter;
+ }
+ else sc->envir = old_frame_with_slot(sc, counter_let(args), x);
+ sc->code = closure_body(code);
+ goto BEGIN1;
+ }
+
+
+ case OP_MAP_GATHER:
+ if (sc->value != sc->NO_VALUE) /* (map (lambda (x) (values)) (list 1)) */
+ {
+ if (is_multiple_value(sc->value)) /* (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4)) */
+ counter_result(sc->args) = revappend(sc, multiple_value(sc->value), counter_result(sc->args));
+ /* not append_in_place here because sc->value has the multiple-values bit set */
+ else counter_result(sc->args) = cons(sc, sc->value, counter_result(sc->args));
+ }
+
+ case OP_MAP:
+ {
+ s7_pointer y, iterators;
+ iterators = counter_list(sc->args);
+ sc->x = sc->NIL; /* can't use preset args list here (as in for-each): (map list '(a b c)) */
+ for (y = iterators; is_pair(y); y = cdr(y))
+ {
+ s7_pointer x;
+ x = s7_iterate(sc, car(y));
+ if (iterator_is_at_end(car(y)))
+ {
+ sc->value = safe_reverse_in_place(sc, counter_result(sc->args));
+ /* here and below it is not safe to pre-release sc->args (the counter) */
+ goto START;
+ }
+ sc->x = cons(sc, x, sc->x);
+ }
+ sc->x = safe_reverse_in_place(sc, sc->x);
+ push_stack(sc, OP_MAP_GATHER, sc->args, sc->code);
+ sc->args = sc->x;
+ sc->x = sc->NIL;
+
+ if (needs_copied_args(sc->code))
+ sc->args = copy_list(sc, sc->args);
+ goto APPLY;
+ }
+
+
+ /* -------------------------------- FOR-EACH -------------------------------- */
+ case OP_FOR_EACH:
+ {
+ s7_pointer x, y, iterators, saved_args;
+ iterators = car(sc->args);
+ saved_args = cdr(sc->args);
+ for (x = saved_args, y = iterators; is_pair(x); x = cdr(x), y = cdr(y))
+ {
+ car(x) = s7_iterate(sc, car(y));
+ if (iterator_is_at_end(car(y)))
+ {
+ sc->value = sc->UNSPECIFIED;
+ goto START;
+ }
+ }
+ push_stack(sc, OP_FOR_EACH, sc->args, sc->code);
+ sc->args = saved_args;
+ if (needs_copied_args(sc->code))
+ sc->args = copy_list(sc, sc->args);
+ goto APPLY;
+ }
+
+
+ /* for-each et al remake the local frame, but that's only needed if the local env is exported,
+ * and that can only happen through make-closure in various guises and curlet.
+ * owlet captures, but it would require a deliberate error to use it in this context.
+ * c_objects call object_set_let but that requires a prior curlet or sublet. So we have
+ * sc->capture_let_counter that is incremented every time an environment is captured, then
+ * here we save that ctr, call body, on rerun check ctr, if it has not changed we are safe and can reuse frame.
+ */
+
+ case OP_FOR_EACH_1:
+ {
+ s7_pointer code, counter, p, arg;
+ counter = sc->args;
+ p = counter_list(counter);
+ arg = s7_iterate(sc, p);
+ if (iterator_is_at_end(p))
+ {
+ sc->value = sc->UNSPECIFIED;
+ goto START;
+ }
+ code = sc->code;
+ if (counter_capture(counter) != sc->capture_let_counter)
+ {
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), arg);
+ counter_set_let(counter, sc->envir);
+ counter_capture(counter) = sc->capture_let_counter;
+ }
+ else sc->envir = old_frame_with_slot(sc, counter_let(counter), arg);
+ push_stack(sc, OP_FOR_EACH_1, counter, code);
+ sc->code = closure_body(code);
+ goto BEGIN1;
+ }
+
+ case OP_FOR_EACH_3:
+ case OP_FOR_EACH_2:
+ {
+ s7_pointer code, c, lst, arg;
+ c = sc->args; /* the counter */
+ lst = counter_list(c);
+ if (!is_pair(lst)) /* '(1 2 . 3) as arg? */
+ {
+ sc->value = sc->UNSPECIFIED;
+ goto START;
+ }
+ code = sc->code;
+ arg = car(lst);
+ counter_list(c) = cdr(lst);
+ if (sc->op == OP_FOR_EACH_3)
+ {
+ counter_result(c) = cdr(counter_result(c));
+ if (counter_result(c) == counter_list(c))
+ {
+ sc->value = sc->UNSPECIFIED;
+ goto START;
+ }
+ push_stack(sc, OP_FOR_EACH_2, c, code);
+ }
+ else push_stack(sc, OP_FOR_EACH_3, c, code);
+ if (counter_capture(c) != sc->capture_let_counter)
+ {
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), arg);
+ counter_set_let(c, sc->envir);
+ counter_capture(c) = sc->capture_let_counter;
+ }
+ else sc->envir = old_frame_with_slot(sc, counter_let(c), arg);
+ sc->code = closure_body(code);
+ goto BEGIN1;
+ }
+
+
+ /* -------------------------------- MEMBER -------------------------------- */
+ case OP_MEMBER_IF:
+ case OP_MEMBER_IF1:
+ /* code=func, args = (list original args) with opt_fast->position in cadr (the list), value = result of comparison
+ */
+ if (sc->value != sc->F) /* previous comparison was not #f -- return list */
+ {
+ sc->value = opt_fast(sc->args);
+ goto START;
+ }
+ if (!is_pair(cdr(opt_fast(sc->args)))) /* no more args -- return #f */
+ {
+ sc->value = sc->F;
+ goto START;
+ }
+ set_opt_fast(sc->args, cdr(opt_fast(sc->args))); /* cdr down arg list */
+
+ if (sc->op == OP_MEMBER_IF1)
+ {
+ /* circular list check */
+ if (opt_fast(sc->args) == opt_slow(sc->args))
+ {
+ sc->value = sc->F;
+ goto START;
+ }
+ set_opt_slow(sc->args, cdr(opt_slow(sc->args))); /* cdr down the slow list (check for circular list) */
+ push_stack(sc, OP_MEMBER_IF, sc->args, sc->code);
+ }
+ else push_stack(sc, OP_MEMBER_IF1, sc->args, sc->code);
+
+ if (needs_copied_args(sc->code))
+ sc->args = list_2(sc, caar(sc->args), car(opt_fast(sc->args)));
+ else sc->args = set_plist_2(sc, caar(sc->args), car(opt_fast(sc->args)));
+ goto APPLY;
+
+
+ /* -------------------------------- ASSOC -------------------------------- */
+ case OP_ASSOC_IF:
+ case OP_ASSOC_IF1:
+ /* code=func, args=(list args) with f/opt_fast=list, value=result of comparison
+ * (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) =)
+ */
+ if (sc->value != sc->F) /* previous comparison was not #f -- return (car list) */
+ {
+ sc->value = car(opt_fast(sc->args));
+ goto START;
+ }
+ if (!is_pair(cdr(opt_fast(sc->args)))) /* (assoc 3 '((1 . 2) . 3) =) or nil */
+ {
+ sc->value = sc->F;
+ goto START;
+ }
+ set_opt_fast(sc->args, cdr(opt_fast(sc->args))); /* cdr down arg list */
+
+ if (sc->op == OP_ASSOC_IF1)
+ {
+ /* circular list check */
+ if (opt_fast(sc->args) == opt_slow(sc->args))
+ {
+ sc->value = sc->F;
+ goto START;
+ }
+ set_opt_slow(sc->args, cdr(opt_slow(sc->args))); /* cdr down the slow list */
+ push_stack(sc, OP_ASSOC_IF, sc->args, sc->code);
+ }
+ else push_stack(sc, OP_ASSOC_IF1, sc->args, sc->code);
+
+ if (!is_pair(car(opt_fast(sc->args)))) /* (assoc 1 '((2 . 2) 3) =) -- we access caaadr below */
+ eval_type_error(sc, "assoc: second arg is not an alist: ~S", sc->args);
+ /* not sure about this -- we could simply skip the entry both here and in g_assoc
+ * (assoc 1 '((2 . 2) 3)) -> #f
+ * (assoc 1 '((2 . 2) 3) =) -> error currently
+ */
+ if (needs_copied_args(sc->code))
+ sc->args = list_2(sc, caar(sc->args), caar(opt_fast(sc->args)));
+ else sc->args = set_plist_2(sc, caar(sc->args), caar(opt_fast(sc->args)));
+ goto APPLY;
+
+
+ /* -------------------------------- DO -------------------------------- */
+ SAFE_DOTIMES:
+ case OP_SAFE_DOTIMES:
+ {
+ int choice;
+ choice = safe_dotimes_ex(sc);
+ if (choice == goto_SAFE_DO_END_CLAUSES) goto SAFE_DO_END_CLAUSES;
+ if (choice == goto_BEGIN1) goto BEGIN1;
+ if (choice == goto_OPT_EVAL) goto OPT_EVAL;
+ if (choice == goto_START_WITHOUT_POP_STACK) goto START_WITHOUT_POP_STACK;
+ pair_set_syntax_symbol(sc->code, sc->SIMPLE_DO);
+ goto SIMPLE_DO;
+ }
+
+
+ case OP_SAFE_DOTIMES_STEP_P:
+ {
+ s7_pointer arg;
+ arg = slot_value(sc->args);
+ numerator(arg)++;
+ if (numerator(arg) == denominator(arg))
+ {
+ sc->code = cdr(cadr(sc->code));
+ goto DO_END_CLAUSES;
+ }
+ push_stack(sc, OP_SAFE_DOTIMES_STEP_P, sc->args, sc->code);
+ sc->code = opt_pair2(sc->code);
+ sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->code = cdr(sc->code);
+ goto START_WITHOUT_POP_STACK;
+ }
+
+
+ case OP_SAFE_DOTIMES_STEP_O:
+ {
+ s7_pointer arg;
+ arg = slot_value(sc->args);
+ numerator(arg)++;
+ if (numerator(arg) == denominator(arg))
+ {
+ sc->code = cdr(cadr(sc->code));
+ goto DO_END_CLAUSES;
+ }
+ push_stack(sc, OP_SAFE_DOTIMES_STEP_O, sc->args, sc->code);
+ sc->code = opt_pair2(sc->code);
+ goto OPT_EVAL;
+ }
+
+
+ case OP_SAFE_DOTIMES_STEP_A:
+ {
+ s7_pointer arg;
+ /* no calls?? */
+ arg = slot_value(sc->args);
+ car(sc->T2_1) = arg;
+ car(sc->T2_2) = sc->value;
+ c_call(opt_pair2(sc->code))(sc, sc->T2_1);
+
+ numerator(arg)++;
+ if (numerator(arg) == denominator(arg))
+ {
+ sc->code = cdr(cadr(sc->code));
+ goto DO_END_CLAUSES;
+ }
+
+ push_stack(sc, OP_SAFE_DOTIMES_STEP_A, sc->args, sc->code);
+ sc->code = caddr(opt_pair2(sc->code));
+ goto OPT_EVAL;
+ }
+
+
+ case OP_SAFE_DOTIMES_STEP:
+ {
+ s7_pointer arg;
+ arg = slot_value(sc->args);
+ numerator(arg)++;
+ if (numerator(arg) == denominator(arg))
+ {
+ sc->code = cdr(cadr(sc->code));
+ goto DO_END_CLAUSES;
+ }
+ push_stack(sc, OP_SAFE_DOTIMES_STEP, sc->args, sc->code);
+
+ arg = opt_pair2(sc->code);
+ /* here we know the body has more than one form */
+ push_stack_no_args(sc, OP_BEGIN1, cdr(arg));
+ sc->code = car(arg);
+ goto EVAL;
+ }
+
+
+ SAFE_DO:
+ case OP_SAFE_DO:
+ {
+ int choice;
+ choice = safe_do_ex(sc);
+ if (choice == goto_SAFE_DO_END_CLAUSES) goto SAFE_DO_END_CLAUSES;
+ if (choice == goto_EVAL) goto EVAL;
+ if (choice == goto_DO_UNCHECKED) goto DO_UNCHECKED;
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_DO_STEP:
+ {
+ s7_int step, end;
+ s7_pointer args, code, slot;
+
+ args = sc->envir;
+ code = sc->code;
+ slot = dox_slot1(args);
+
+ step = s7_integer(slot_value(slot)) + 1;
+ slot_set_value(slot, make_integer(sc, step));
+ end = s7_integer(slot_value(dox_slot2(args)));
+
+ if ((step == end) ||
+ ((step > end) &&
+ (opt_cfunc(caadr(code)) == geq_2)))
+ {
+ sc->code = cdadr(code);
+ goto DO_END_CLAUSES;
+ }
+ push_stack(sc, OP_SAFE_DO_STEP, sc->args, code);
+ sc->code = opt_pair2(code);
+ goto BEGIN1;
+ }
+
+
+ SIMPLE_DO_P:
+ case OP_SIMPLE_DO_P:
+ sc->op = OP_SIMPLE_DO_P;
+ goto SIMPLE_DO;
+
+ SIMPLE_DO_E:
+ case OP_SIMPLE_DO_E:
+ sc->op = OP_SIMPLE_DO_E;
+ goto SIMPLE_DO;
+
+ SIMPLE_DO_A:
+ case OP_SIMPLE_DO_A:
+ sc->op = OP_SIMPLE_DO_A;
+
+ SIMPLE_DO:
+ case OP_SIMPLE_DO:
+ {
+ /* body might not be safe in this case, but the step and end exprs are easy
+ * "not safe" merely means we hit something that the optimizer can't specialize like (+ (* (abs (- ...))))
+ */
+ s7_pointer init, end, code;
+
+ code = sc->code;
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ init = cadaar(code);
+ if (is_symbol(init))
+ sc->value = find_symbol_checked(sc, init);
+ else
+ {
+ if (is_pair(init))
+ sc->value = c_call(init)(sc, cdr(init));
+ else sc->value = init;
+ }
+ dox_set_slot1(sc->envir, make_slot_1(sc, sc->envir, caaar(code), sc->value));
+ end = caddr(caadr(code));
+ if (is_symbol(end))
+ sc->args = find_symbol(sc, end);
+ else
+ {
+ s7_pointer slot;
+ new_cell_no_check(sc, slot, T_SLOT);
+ slot_set_symbol(slot, sc->dox_slot_symbol);
+ slot_set_value(slot, end);
+ sc->args = slot;
+ }
+ dox_set_slot2(sc->envir, sc->args);
+ car(sc->T2_1) = slot_value(dox_slot1(sc->envir));
+ car(sc->T2_2) = slot_value(dox_slot2(sc->envir));
+ if (is_true(sc, c_call(caadr(code))(sc, sc->T2_1)))
+ {
+ sc->code = cdadr(code);
+ goto DO_END_CLAUSES;
+ }
+
+ if (sc->op == OP_SIMPLE_DO_P)
+ {
+ push_stack(sc, OP_SIMPLE_DO_STEP_P, sc->args, code);
+ sc->code = caddr(code);
+ goto EVAL;
+ }
+
+ set_opt_pair2(code, cddr(code));
+ if ((is_null(cdr(opt_pair2(code)))) &&
+ (is_pair(car(opt_pair2(code)))) &&
+ (is_symbol(cadr(caddr(caar(code)))))) /* caar=(i 0 (+ i 1)), caddr=(+ i 1), so this is apparently checking that the stepf is reasonable? */
+ {
+ int choice;
+ choice = simple_do_ex(sc, code);
+ if (choice == goto_START) goto START;
+ if (choice == goto_BEGIN1) goto BEGIN1;
+ if (choice == goto_DO_END_CLAUSES) goto DO_END_CLAUSES;
+ }
+
+ if (sc->op == OP_SIMPLE_DO_E)
+ push_stack(sc, OP_SIMPLE_DO_STEP_E, sc->args, code);
+ else
+ {
+ if (sc->op == OP_SIMPLE_DO_A)
+ push_stack(sc, OP_SIMPLE_DO_STEP_A, sc->args, code);
+ else push_stack(sc, OP_SIMPLE_DO_STEP, sc->args, code);
+ }
+ sc->code = opt_pair2(code);
+ goto BEGIN1;
+ }
+
+
+ case OP_SIMPLE_DO_STEP_P:
+ case OP_SIMPLE_DO_STEP:
+ {
+ s7_pointer step, ctr, end, code;
+
+ ctr = dox_slot1(sc->envir);
+ end = dox_slot2(sc->envir);
+ code = sc->code;
+
+ step = caddr(caar(code));
+ if (is_symbol(cadr(step)))
+ {
+ car(sc->T2_1) = slot_value(ctr);
+ car(sc->T2_2) = caddr(step);
+ }
+ else
+ {
+ car(sc->T2_2) = slot_value(ctr);
+ car(sc->T2_1) = cadr(step);
+ }
+ slot_set_value(ctr, c_call(step)(sc, sc->T2_1));
+
+ car(sc->T2_1) = slot_value(ctr);
+ car(sc->T2_2) = slot_value(end);
+ if (is_true(sc, c_call(caadr(code))(sc, sc->T2_1)))
+ {
+ sc->code = cdr(cadr(code));
+ goto DO_END_CLAUSES;
+ }
+
+ push_stack(sc, sc->op, sc->args, code);
+ if (sc->op == OP_SIMPLE_DO_STEP_P)
+ {
+ code = caddr(code);
+ sc->cur_code = code;
+ sc->op = (opcode_t)pair_syntax_op(code);
+ sc->code = cdr(code);
+ goto START_WITHOUT_POP_STACK;
+ }
+
+ sc->code = opt_pair2(code);
+ goto BEGIN1;
+ }
+
+ case OP_SIMPLE_DO_STEP_E:
+ case OP_SIMPLE_DO_STEP_A:
+ {
+ /* (((i 0 (+ i 1))) ((= i 1000)) (set! mx (max mx (abs (f1 signal)))) (set! signal 0.0))
+ * (((i 0 (+ i 1))) ((= i 20)) (outa i (sine-env e)))
+ * we checked in check_do that the step expr is s+1
+ */
+ s7_pointer val, ctr, end, code;
+ s7_int index;
+
+ code = sc->code;
+ ctr = dox_slot1(sc->envir);
+ val = slot_value(ctr);
+ end = slot_value(dox_slot2(sc->envir));
+
+ if (is_integer(val))
+ {
+ slot_set_value(ctr, make_integer(sc, index = integer(val) + 1));
+ if (is_integer(end))
+ {
+ if (index == integer(end))
+ {
+ sc->code = cdr(cadr(code));
+ goto DO_END_CLAUSES;
+ }
+ }
+ else
+ {
+ car(sc->T2_1) = slot_value(ctr);
+ car(sc->T2_2) = end;
+ if (is_true(sc, g_equal_2(sc, sc->T2_1)))
+ {
+ sc->code = cdr(cadr(code));
+ goto DO_END_CLAUSES;
+ }
+ }
+ }
+ else
+ {
+ car(sc->T1_1) = val; /* add_s1 ignores cadr(args) */
+ slot_set_value(ctr, g_add_s1(sc, sc->T1_1));
+ car(sc->T2_1) = slot_value(ctr);
+ car(sc->T2_2) = end;
+ if (is_true(sc, g_equal_2(sc, sc->T2_1)))
+ {
+ sc->code = cdr(cadr(code));
+ goto DO_END_CLAUSES;
+ }
+ }
+
+ push_stack(sc, sc->op, sc->args, code);
+ if (sc->op == OP_SIMPLE_DO_STEP_E)
+ {
+ sc->code = car(opt_pair2(code));
+ goto OPT_EVAL;
+ }
+ sc->code = opt_pair2(code);
+ goto BEGIN1;
+ }
+
+
+ DOTIMES_P:
+ case OP_DOTIMES_P:
+ {
+ int choice;
+ choice = dotimes_p_ex(sc);
+ if (choice == goto_DO_END_CLAUSES) goto DO_END_CLAUSES;
+ if (choice == goto_DO_UNCHECKED) goto DO_UNCHECKED;
+ goto EVAL;
+ }
+
+ case OP_DOTIMES_STEP_P:
+ {
+ s7_pointer ctr, now, end, code, end_test;
+
+ code = sc->code;
+ ctr = dox_slot1(sc->envir);
+ now = slot_value(ctr);
+ end = slot_value(dox_slot2(sc->envir));
+ end_test = opt_pair2(code);
+
+ if (is_integer(now))
+ {
+ slot_set_value(ctr, make_integer(sc, integer(now) + 1));
+ now = slot_value(ctr);
+ if (is_integer(end))
+ {
+ if ((integer(now) == integer(end)) ||
+ ((integer(now) > integer(end)) &&
+ (opt_cfunc(end_test) == geq_2)))
+ {
+ sc->code = cdadr(code);
+ goto DO_END_CLAUSES;
+ }
+ }
+ else
+ {
+ car(sc->T2_1) = now;
+ car(sc->T2_2) = end;
+ if (is_true(sc, c_call(end_test)(sc, sc->T2_1)))
+ {
+ sc->code = cdadr(code);
+ goto DO_END_CLAUSES;
+ }
+ }
+ }
+ else
+ {
+ car(sc->T1_1) = now;
+ slot_set_value(ctr, g_add_s1(sc, sc->T1_1));
+ /* (define (hi) (let ((x 0.0) (y 1.0)) (do ((i y (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((>= i 7)) (set! x (+ x i)))) x)) */
+ car(sc->T2_1) = slot_value(ctr);
+ car(sc->T2_2) = end;
+ if (is_true(sc, c_call(end_test)(sc, sc->T2_1)))
+ {
+ sc->code = cdadr(code);
+ goto DO_END_CLAUSES;
+ }
+ }
+ push_stack(sc, OP_DOTIMES_STEP_P, sc->args, code);
+ code = caddr(code);
+ sc->cur_code = code;
+ sc->op = (opcode_t)pair_syntax_op(code);
+ sc->code = cdr(code);
+ goto START_WITHOUT_POP_STACK;
+ }
+
+
+ DOX:
+ case OP_DOX:
+ {
+ int choice;
+ choice = dox_ex(sc);
+ if (choice == goto_DO_END_CLAUSES) goto DO_END_CLAUSES;
+ if (choice == goto_START) goto START;
+ if (choice == goto_BEGIN1) goto BEGIN1;
+ if (choice == goto_START_WITHOUT_POP_STACK) goto START_WITHOUT_POP_STACK;
+
+ push_stack_no_args(sc, OP_DOX_STEP, sc->code);
+ sc->code = cddr(sc->code);
+ goto BEGIN1;
+ }
+
+
+ case OP_DOX_STEP:
+ {
+ s7_pointer slot;
+
+ for (slot = let_slots(sc->envir); is_slot(slot); slot = next_slot(slot))
+ if (is_pair(slot_expression(slot)))
+ slot_set_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot))));
+
+ if (is_true(sc, c_call(cdr(sc->code))(sc, opt_pair2(sc->code))))
+ {
+ sc->code = cdadr(sc->code);
+ goto DO_END_CLAUSES;
+ }
+ push_stack_no_args(sc, OP_DOX_STEP, sc->code);
+ sc->code = cddr(sc->code);
+ goto BEGIN1;
+ }
+
+ case OP_DOX_STEP_P:
+ {
+ s7_pointer slot;
+
+ for (slot = let_slots(sc->envir); is_slot(slot); slot = next_slot(slot))
+ if (is_pair(slot_expression(slot)))
+ slot_set_value(slot, c_call(slot_expression(slot))(sc, car(slot_expression(slot))));
+
+ if (is_true(sc, c_call(cdr(sc->code))(sc, opt_pair2(sc->code))))
+ {
+ sc->code = cdadr(sc->code);
+ goto DO_END_CLAUSES;
+ }
+ push_stack_no_args(sc, OP_DOX_STEP_P, sc->code);
+ sc->code = caddr(sc->code);
+ sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->code = cdr(sc->code);
+ goto START_WITHOUT_POP_STACK;
+ }
+
+ /* we could use slot_pending_value, slot_expression, not this extra list, but the list seems simpler. */
+ #define DO_VAR_SLOT(P) opt_slot1(P)
+ #define DO_VAR_NEW_VALUE(P) cdr(P)
+ #define DO_VAR_STEP_EXPR(P) car(P)
+
+ DO_STEP:
+ case OP_DO_STEP:
+ /* increment all vars, return to endtest
+ * these are also updated in parallel at the end, so we gather all the incremented values first
+ *
+ * here we know car(sc->args) is not null, args is the list of steppable vars,
+ * any unstepped vars in the do var section are not in this list, so
+ * (do ((i 0 (+ i 1)) (j 2)) ...)
+ * arrives here with sc->args:
+ * '(((+ i 1) . 0))
+ */
+ push_stack(sc, OP_DO_END, sc->args, sc->code);
+ sc->args = car(sc->args); /* the var data lists */
+ sc->code = sc->args; /* save the top of the list */
+
+ DO_STEP1:
+ /* on each iteration, each arg incr expr is evaluated and the value placed in caddr while we cdr down args
+ * finally args is nil...
+ */
+ if (is_null(sc->args))
+ {
+ s7_pointer x;
+
+ for (x = sc->code; is_not_null(x); x = cdr(x))
+ slot_set_value(DO_VAR_SLOT(car(x)), DO_VAR_NEW_VALUE(car(x)));
+
+ /* some schemes rebind here, rather than reset, but that is expensive,
+ * and only matters once in a blue moon (closure over enclosed lambda referring to a do var)
+ * and the caller can easily mimic the correct behavior in that case by adding a let or using a named let,
+ * making the rebinding explicit.
+ *
+ * Hmmm... I'll leave this alone, but there are other less cut-and-dried cases:
+ * (let ((j (lambda () 0))
+ * (k 0))
+ * (do ((i (j) (j))
+ * (j (lambda () 1) (lambda () (+ i 1)))) ; bind here hits different "i" than set!
+ * ((= i 3) k)
+ * (set! k (+ k i))))
+ * is it 6 or 3?
+ *
+ * if we had a way to tell that there were no lambdas in the do expression, would that
+ * guarantee that set was ok? Here's a bad case:
+ * (let ((f #f))
+ * (do ((i 0 (+ i 1)))
+ * ((= i 3))
+ * (let () ; so that the define is ok
+ * (define (x) i)
+ * (if (= i 1) (set! f x))))
+ * (f))
+ * s7 says 3, guile says 1.
+ *
+ * I wonder if what they're actually talking about is a kind of shared value problem. If we
+ * set the value directly (not the cdr(binding) but, for example, integer(cdr(binding))), then
+ * every previous reference gets changed as a side-effect. In the current code, we're "binding"
+ * the value in the sense that on each step, a new value is assigned to the step variable.
+ * In the "direct" case, (let ((v #(0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (set! (v i) i))
+ * would return #(3 3 3).
+ *
+ * if sc->capture_let_counter changes, would it be sufficient to simply make a new slot?
+ * I think not; the closure retains the current env chain, not the slots, so we need a new env.
+ */
+
+ sc->value = sc->NIL;
+ pop_stack_no_op(sc);
+ goto DO_END;
+ }
+ push_stack(sc, OP_DO_STEP2, sc->args, sc->code);
+
+ /* here sc->args is a list like (((i . 0) (+ i 1) 0) ...)
+ * so sc->code becomes (+ i 1) in this case
+ */
+ sc->code = DO_VAR_STEP_EXPR(car(sc->args));
+ goto EVAL;
+
+
+ case OP_DO_STEP2:
+ DO_VAR_NEW_VALUE(car(sc->args)) = sc->value; /* save current value */
+ sc->args = cdr(sc->args); /* go to next step var */
+ goto DO_STEP1;
+
+
+ case OP_DO: /* sc->code is the stuff after "do" */
+ if (is_null(check_do(sc)))
+ {
+ s7_pointer op;
+ op = car(opt_back(sc->code));
+ if (op == sc->DOX) goto DOX;
+ if (op == sc->SAFE_DOTIMES) goto SAFE_DOTIMES;
+ if (op == sc->DOTIMES_P) goto DOTIMES_P;
+ if (op == sc->SAFE_DO) goto SAFE_DO;
+ if (op == sc->SIMPLE_DO_A) goto SIMPLE_DO_A;
+ if (op == sc->SIMPLE_DO_E) goto SIMPLE_DO_E;
+ if (op == sc->SIMPLE_DO) goto SIMPLE_DO;
+ goto SIMPLE_DO_P;
+ }
+
+ DO_UNCHECKED:
+ case OP_DO_UNCHECKED:
+ if (is_null(car(sc->code))) /* (do () ...) -- (let ((i 0)) (do () ((= i 1)) (set! i 1))) */
+ {
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ sc->args = cons_unchecked(sc, sc->NIL, cadr(sc->code));
+ sc->code = cddr(sc->code);
+ goto DO_END;
+ }
+ /* eval each init value, then set up the new frame (like let, not let*) */
+ sc->args = sc->NIL; /* the evaluated var-data */
+ sc->value = sc->code; /* protect it */
+ sc->code = car(sc->code); /* the vars */
+
+
+ case OP_DO_INIT:
+ if (do_init_ex(sc) == goto_EVAL)
+ goto EVAL;
+ /* fall through */
+
+ DO_END:
+ case OP_DO_END:
+ /* here vars have been init'd or incr'd
+ * args = (list var-data end-expr return-expr-if-any)
+ * if (do ((i 0 (+ i 1))) ((= i 3) 10)), args: (vars (= i 3) 10)
+ * if (do ((i 0 (+ i 1))) ((= i 3))), args: (vars (= i 3)) and result expr is () == (begin)
+ * if (do ((i 0 (+ i 1))) (#t 10 12)), args: (vars #t 10 12), result: ([begin] 10 12) -> 12
+ * if (call-with-exit (lambda (r) (do () () (r)))), args: '(())
+ * code = body
+ */
+
+ if (is_not_null(cdr(sc->args)))
+ {
+ push_stack(sc, OP_DO_END1, sc->args, sc->code);
+ sc->code = cadr(sc->args); /* evaluate the end expr */
+ goto EVAL;
+ }
+ else
+ {
+ /* (do ((...)) () ...) -- no endtest */
+ if (is_pair(sc->code))
+ {
+ if (is_null(car(sc->args)))
+ push_stack(sc, OP_DO_END, sc->args, sc->code);
+ else push_stack(sc, OP_DO_STEP, sc->args, sc->code);
+ goto BEGIN1;
+ }
+ else
+ {
+ /* no body? */
+ if (is_null(car(sc->args)))
+ goto DO_END;
+ goto DO_STEP;
+ }
+ }
+
+ case OP_DO_END1:
+ /* sc->value is the result of end-test evaluation */
+ if (is_true(sc, sc->value))
+ {
+ /* we're done -- deal with result exprs
+ * if there isn't an end test, there also isn't a result (they're in the same list)
+ */
+ sc->code = cddr(sc->args); /* result expr (a list -- implicit begin) */
+ free_cell(sc, sc->args);
+ sc->args = sc->NIL;
+ if (is_null(sc->code))
+ {
+ sc->value = sc->NIL;
+ goto START;
+ }
+ }
+ else
+ {
+ /* evaluate the body and step vars, etc */
+ if (is_null(car(sc->args)))
+ push_stack(sc, OP_DO_END, sc->args, sc->code);
+ else push_stack(sc, OP_DO_STEP, sc->args, sc->code);
+ /* sc->code is ready to go */
+ }
+ goto BEGIN1;
+
+
+ SAFE_DO_END_CLAUSES:
+ if (is_null(sc->code))
+ {
+ /* sc->args = sc->NIL; */
+ sc->envir = free_let(sc, sc->envir);
+ sc->value = sc->NIL;
+ goto START;
+ }
+ goto DO_END_CODE;
+
+ DO_END_CLAUSES:
+ if (is_null(sc->code))
+ {
+ sc->value = sc->NIL;
+ goto START;
+ }
+ DO_END_CODE:
+ if (is_pair(cdr(sc->code)))
+ {
+ push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
+ sc->code = car(sc->code);
+ if (is_pair(sc->code))
+ goto EVAL;
+ if (is_symbol(sc->code))
+ sc->value = find_symbol_checked(sc, sc->code);
+ else sc->value = sc->code;
+ goto START;
+
+
+ /* -------------------------------- BEGIN -------------------------------- */
+ case OP_BEGIN:
+ if (!is_proper_list(sc, sc->code)) /* proper list includes nil, I think */
+ eval_error(sc, "unexpected dot? ~A", sc->code);
+
+ if ((!is_null(sc->code)) && /* so check for it here */
+ (!is_null(cdr(sc->code))) &&
+ (is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->BEGIN_UNCHECKED);
+
+ case OP_BEGIN_UNCHECKED:
+ /* if ((sc->begin_hook) && (call_begin_hook(sc))) return(sc->F); */
+ if (is_null(sc->code)) /* (begin) -> () */
+ {
+ sc->value = sc->NIL;
+ goto START;
+ }
+
+ case OP_BEGIN1:
+ if ((sc->begin_hook) && (call_begin_hook(sc))) return(sc->F);
+ BEGIN1:
+#if DEBUGGING
+ if (!s7_is_list(sc, sc->code)) abort();
+#endif
+ if (is_pair(cdr(sc->code))) /* sc->code can be nil here, but cdr(nil)->#<unspecified> */
+ push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code));
+ sc->code = car(sc->code);
+ /* goto EVAL; */
+
+
+ EVAL:
+ case OP_EVAL:
+ /* main part of evaluation
+ * at this point, it's sc->code we care about; sc->args is not relevant.
+ */
+ /* fprintf(stderr, " eval: %s %d %d\n", DISPLAY_80(sc->code), (typesflag(sc->code) == SYNTACTIC_PAIR), (is_optimized(sc->code))); */
+
+ if (typesflag(sc->code) == SYNTACTIC_PAIR) /* xor is not faster here */
+ {
+ sc->cur_code = sc->code; /* in case an error occurs, this helps tell us where we are */
+ sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->code = cdr(sc->code);
+ goto START_WITHOUT_POP_STACK; /* it is only slightly faster to use labels as values (computed gotos) here */
+ }
+
+ if (is_optimized(sc->code))
+ {
+ s7_pointer code;
+ /* fprintf(stderr, " %s\n", opt_names[optimize_op(sc->code)]); */
+
+ OPT_EVAL:
+ code = sc->code;
+ sc->cur_code = code;
+
+ switch (optimize_op(code))
+ {
+ /* -------------------------------------------------------------------------------- */
+ case OP_SAFE_C_C:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_C:
+ sc->value = c_call(code)(sc, cdr(code)); /* this includes all safe calls where all args are constants */
+ goto START;
+
+
+ case OP_SAFE_C_Q:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_Q:
+ car(sc->T1_1) = cadr(cadr(code));
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+
+
+ case OP_SAFE_C_S:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_S:
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(code));
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+
+
+ case OP_SAFE_C_SS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SS:
+ {
+ s7_pointer val, args;
+ args = cdr(code);
+ val = find_symbol_checked(sc, car(args));
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_1) = val;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_ALL_S:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ALL_S:
+ {
+ int num_args;
+ s7_pointer args, p;
+
+ num_args = integer(arglist_length(code));
+ if ((num_args != 0) &&
+ (num_args < NUM_SAFE_LISTS) &&
+ (!list_is_in_use(sc->safe_lists[num_args])))
+ {
+ sc->args = sc->safe_lists[num_args];
+ set_list_in_use(sc->args);
+ }
+ else sc->args = make_list(sc, num_args, sc->NIL);
+
+ for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
+ car(p) = find_symbol_checked(sc, car(args));
+ clear_list_in_use(sc->args);
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SC:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SC:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = find_symbol_checked(sc, car(args));
+ car(sc->T2_2) = cadr(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_CS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_CS:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_1) = car(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SQ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SQ:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = find_symbol_checked(sc, car(args));
+ car(sc->T2_2) = cadr(cadr(args));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_QS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_QS:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_1) = cadr(car(args));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_QQ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_QQ:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = cadr(car(args));
+ car(sc->T2_2) = cadr(cadr(args));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_CQ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_CQ:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = car(args);
+ car(sc->T2_2) = cadr(cadr(args));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_QC:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_QC:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = cadr(car(args));
+ car(sc->T2_2) = cadr(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_Z:
+ if (!c_function_is_ok(sc, code)) break;
+ /* I think a_is_ok of cadr here and below is redundant -- they'll be checked when Z is
+ * because we cleared the hop bit after combine_ops.
+ */
+
+ case HOP_SAFE_C_Z:
+ check_stack_size(sc);
+ push_stack(sc, OP_SAFE_C_P_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_CZ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_CZ:
+ check_stack_size(sc);
+ /* it's possible in a case like this to overflow the stack -- s7test has a deeply
+ * nested expression involving (+ c (+ c (+ ... ))) all opt'd as safe_c_cz -- if we're close
+ * to the stack end at the start, it runs off the end. Normally the stack increase in
+ * the reader protects us, but a call/cc can replace the original stack with a much smaller one.
+ * How to minimize the cost of this check?
+ */
+ push_stack(sc, OP_SAFE_C_SZ_1, cadr(code), code);
+ sc->code = caddr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZC:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ZC:
+ check_stack_size(sc);
+ push_stack(sc, OP_SAFE_C_ZC_1, caddr(code), code); /* need ZC_1 here in case multiple values encountered */
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_SZ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SZ:
+ check_stack_size(sc);
+ push_stack(sc, OP_SAFE_C_SZ_1, find_symbol_checked(sc, cadr(code)), code);
+ sc->code = caddr(code); /* splitting out the all_x cases here and elsewhere saves nothing */
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ZS:
+ check_stack_size(sc);
+ push_stack(sc, OP_EVAL_ARGS_P_3, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_opAq:
+ if (!a_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opAq:
+ {
+ s7_pointer arg;
+ arg = cadr(code);
+ car(sc->A1_1) = c_call(cdr(arg))(sc, cadr(arg));
+ car(sc->T1_1) = c_call(arg)(sc, sc->A1_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opAAq:
+ if (!a_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opAAq:
+ {
+ s7_pointer arg;
+ arg = cadr(code);
+ car(sc->A2_1) = c_call(cdr(arg))(sc, cadr(arg));
+ car(sc->A2_2) = c_call(cddr(arg))(sc, caddr(arg));
+ car(sc->T1_1) = c_call(arg)(sc, sc->A2_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opAAAq:
+ if (!a_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opAAAq:
+ {
+ s7_pointer arg;
+ arg = cadr(code);
+ car(sc->A3_1) = c_call(cdr(arg))(sc, cadr(arg));
+ car(sc->A3_2) = c_call(cddr(arg))(sc, caddr(arg));
+ car(sc->A3_3) = c_call(cdddr(arg))(sc, cadddr(arg));
+ car(sc->T1_1) = c_call(arg)(sc, sc->A3_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_opAq:
+ if (!a_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_S_opAq:
+ {
+ s7_pointer arg;
+ arg = caddr(code);
+ car(sc->A1_1) = c_call(cdr(arg))(sc, cadr(arg));
+ car(sc->T2_2) = c_call(arg)(sc, sc->A1_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(code));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_opAAq:
+ if (!a_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_S_opAAq:
+ {
+ s7_pointer arg;
+ arg = caddr(code);
+ car(sc->A2_1) = c_call(cdr(arg))(sc, cadr(arg));
+ car(sc->A2_2) = c_call(cddr(arg))(sc, caddr(arg));
+ car(sc->T2_2) = c_call(arg)(sc, sc->A2_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(code));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_opAAAq:
+ if (!a_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_S_opAAAq:
+ {
+ s7_pointer arg, p;
+ p = caddr(code);
+ arg = cdr(p);
+ car(sc->A3_1) = c_call(arg)(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_2) = c_call(arg)(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_3) = c_call(arg)(sc, car(arg));
+ car(sc->T2_2) = c_call(p)(sc, sc->A3_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(code));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_opSZq:
+ if (!a_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_S_opSZq:
+ push_stack(sc, OP_SAFE_C_SZ_SZ, find_symbol_checked(sc, cadr(caddr(code))), code);
+ sc->code = caddr(caddr(code));
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_AZ:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_AZ:
+ push_stack(sc, OP_SAFE_C_SZ_1, c_call(cdr(code))(sc, cadr(code)), code);
+ sc->code = caddr(code);
+ goto OPT_EVAL;
+ /* s: h_safe_c_s_op_s_opssqq: 204308 */
+
+
+ case OP_SAFE_C_ZA:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ZA:
+ /* here we can't use ZS order because we sometimes assume left->right arg evaluation (binary-io.scm for example) */
+ push_stack(sc, OP_SAFE_C_ZA_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZZ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ZZ:
+ /* most of the component Z's here are very complex:
+ * 264600: (+ (* even-amp (oscil (vector-ref evens k) (+ even-freq val))) (* odd-amp...
+ */
+ push_stack(sc, OP_SAFE_C_ZZ_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_opCq_Z:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_opCq_Z:
+ push_stack(sc, OP_SAFE_C_ZZ_2, c_call(cadr(code))(sc, cdr(cadr(code))), code);
+ sc->code = caddr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZAA:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ZAA:
+ push_stack(sc, OP_SAFE_C_ZAA_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_AZA:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_AZA:
+ push_stack(sc, OP_SAFE_C_AZA_1, c_call(cdr(code))(sc, cadr(code)), code);
+ sc->code = caddr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_SSZ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SSZ:
+ push_stack(sc, OP_SAFE_C_SSZ_1, find_symbol_checked(sc, cadr(code)), code);
+ sc->code = cadddr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_AAZ:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_AAZ:
+ push_op_stack(sc, c_call(cdr(code))(sc, cadr(code)));
+ push_stack(sc, OP_SAFE_C_AAZ_1, c_call(cddr(code))(sc, caddr(code)), code);
+ sc->code = cadddr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZZA:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ZZA:
+ push_stack(sc, OP_SAFE_C_ZZA_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZAZ:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ZAZ:
+ push_stack(sc, OP_SAFE_C_ZAZ_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_AZZ:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_AZZ:
+ push_stack(sc, OP_SAFE_C_AZZ_1, c_call(cdr(code))(sc, cadr(code)), code);
+ sc->code = caddr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZZZ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ZZZ:
+ push_stack(sc, OP_SAFE_C_ZZZ_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_A:
+ if (!a_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_A:
+ car(sc->A1_1) = c_call(cdr(code))(sc, cadr(code));
+ sc->value = c_call(code)(sc, sc->A1_1);
+ goto START;
+
+
+ case OP_SAFE_C_AA:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_AA:
+ car(sc->A2_1) = c_call(cdr(code))(sc, cadr(code));
+ car(sc->A2_2) = c_call(cddr(code))(sc, caddr(code));
+ sc->value = c_call(code)(sc, sc->A2_1);
+ goto START;
+
+
+ case OP_SAFE_C_AAA:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_AAA:
+ {
+ s7_pointer arg;
+ arg = cdr(code);
+ car(sc->A3_1) = c_call(arg)(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_2) = c_call(arg)(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_3) = c_call(arg)(sc, car(arg));
+ sc->value = c_call(code)(sc, sc->A3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SSA:
+ if (!a_is_ok_cadddr(sc, code)) break;
+
+ case HOP_SAFE_C_SSA:
+ {
+ s7_pointer arg;
+ arg = cdr(code);
+ car(sc->A3_1) = find_symbol_checked(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_2) = find_symbol_checked(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_3) = c_call(arg)(sc, car(arg));
+ sc->value = c_call(code)(sc, sc->A3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SAS:
+ if (!a_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_SAS:
+ {
+ s7_pointer arg;
+ arg = cdr(code);
+ car(sc->A3_1) = find_symbol_checked(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_2) = c_call(arg)(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_3) = find_symbol_checked(sc, car(arg));
+ sc->value = c_call(code)(sc, sc->A3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_CSA:
+ if (!a_is_ok_cadddr(sc, code)) break;
+
+ case HOP_SAFE_C_CSA:
+ {
+ s7_pointer arg;
+ arg = cdr(code);
+ car(sc->A3_1) = car(arg);
+ arg = cdr(arg);
+ car(sc->A3_2) = find_symbol_checked(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_3) = c_call(arg)(sc, car(arg));
+ sc->value = c_call(code)(sc, sc->A3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SCA:
+ if (!a_is_ok_cadddr(sc, code)) break;
+
+ case HOP_SAFE_C_SCA:
+ {
+ s7_pointer arg;
+ arg = cdr(code);
+ car(sc->A3_1) = find_symbol_checked(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A3_2) = car(arg);
+ arg = cdr(arg);
+ car(sc->A3_3) = c_call(arg)(sc, car(arg));
+ sc->value = c_call(code)(sc, sc->A3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_CAS:
+ if (!a_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_CAS:
+ {
+ s7_pointer arg;
+ arg = cdr(code);
+ car(sc->A3_1) = car(arg);
+ arg = cdr(arg);
+ car(sc->A3_2) = c_call(arg)(sc, car(arg));
+ car(sc->A3_3) = find_symbol_checked(sc, cadr(arg));
+ sc->value = c_call(code)(sc, sc->A3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_AAAA:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_AAAA:
+ {
+ s7_pointer arg;
+ arg = cdr(code);
+ car(sc->A4_1) = c_call(arg)(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A4_2) = c_call(arg)(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A4_3) = c_call(arg)(sc, car(arg));
+ arg = cdr(arg);
+ car(sc->A4_4) = c_call(arg)(sc, car(arg));
+ sc->value = c_call(code)(sc, sc->A4_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_ALL_X:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_ALL_X:
+ {
+ int num_args;
+ s7_pointer args, p;
+
+ num_args = integer(arglist_length(code));
+ if ((num_args != 0) &&
+ (num_args < NUM_SAFE_LISTS) &&
+ (!list_is_in_use(sc->safe_lists[num_args])))
+ {
+ sc->args = sc->safe_lists[num_args];
+ set_list_in_use(sc->args);
+ }
+ else sc->args = make_list(sc, num_args, sc->NIL);
+
+ for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
+ car(p) = c_call(args)(sc, car(args));
+ clear_list_in_use(sc->args);
+
+ sc->value = c_call(code)(sc, sc->args);
+ /* we can't release a temp here:
+ * (define (hi) (vector 14800 14020 (oscil os) (* 1/3 14800) 14800 (* 1/2 14800))) (hi) where os returns non-zero:
+ * #(14800 14020 <output-string-port> 14800/3 14800 7400)
+ */
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SQS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SQS:
+ {
+ /* (let-set! gen 'fm fm); many of these are handled in safe_closure_star_s0 */
+ s7_pointer val1, args;
+ args = cdr(code);
+ val1 = find_symbol_checked(sc, car(args));
+ car(sc->T3_3) = find_symbol_checked(sc, opt_sym2(args));
+ car(sc->T3_2) = opt_con1(args);
+ car(sc->T3_1) = val1;
+ sc->value = c_call(code)(sc, sc->T3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SCS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SCS:
+ {
+ /* (define (hi) (let ((x 32) (lst '(0 1))) (list-set! lst 0 x) x)) */
+ s7_pointer val1, args;
+ args = cdr(code);
+
+ val1 = find_symbol_checked(sc, car(args));
+ car(sc->T3_3) = find_symbol_checked(sc, opt_sym2(args));
+ car(sc->T3_2) = opt_con1(args);
+ car(sc->T3_1) = val1;
+ sc->value = c_call(code)(sc, sc->T3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SSC:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SSC:
+ {
+ /* (define (hi) (let ((v #(0 1 2)) (i 0)) (vector-set! v i 1) v)) */
+ s7_pointer val1, args;
+ args = cdr(code);
+
+ val1 = find_symbol_checked(sc, car(args));
+ car(sc->T3_2) = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T3_3) = opt_con2(args);
+ car(sc->T3_1) = val1;
+ sc->value = c_call(code)(sc, sc->T3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_SCC:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SCC:
+ {
+ /* (make-env E :length 100) */
+ s7_pointer args;
+ args = cdr(code);
+
+ car(sc->T3_1) = find_symbol_checked(sc, car(args));
+ car(sc->T3_2) = opt_con1(args);
+ car(sc->T3_3) = opt_con2(args);
+ sc->value = c_call(code)(sc, sc->T3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_CSC:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_CSC:
+ {
+ s7_pointer args;
+ args = cdr(code);
+
+ car(sc->T3_2) = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T3_1) = car(args);
+ car(sc->T3_3) = opt_con2(args);
+ sc->value = c_call(code)(sc, sc->T3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_CSS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_CSS:
+ {
+ s7_pointer val1, args;
+ args = cdr(code);
+
+ val1 = find_symbol_checked(sc, opt_sym2(args));
+ car(sc->T3_2) = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T3_3) = val1;
+ car(sc->T3_1) = car(args);
+ sc->value = c_call(code)(sc, sc->T3_1);
+ goto START;
+ }
+
+ case OP_SAFE_C_SSS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SSS:
+ {
+ s7_pointer val1, val2, args;
+ args = cdr(code);
+
+ val1 = find_symbol_checked(sc, car(args));
+ val2 = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T3_3) = find_symbol_checked(sc, opt_sym2(args));
+ car(sc->T3_1) = val1;
+ car(sc->T3_2) = val2;
+ sc->value = c_call(code)(sc, sc->T3_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opCq:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opCq:
+ car(sc->T1_1) = c_call(car(cdr(code)))(sc, cdar(cdr(code))); /* OP_SAFE_C_C can involve any number of ops */
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+
+
+ case OP_SAFE_C_opSq:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSq:
+ {
+ s7_pointer args;
+ args = cadr(code);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(args));
+ car(sc->T1_1) = c_call(args)(sc, sc->T1_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+ case OP_SAFE_C_op_opSq_q:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
+
+ case HOP_SAFE_C_op_opSq_q:
+ {
+ s7_pointer outer, args;
+ outer = cadr(code);
+ args = cadr(outer);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(args));
+ car(sc->T1_1) = c_call(args)(sc, sc->T1_1);
+ car(sc->T1_1) = c_call(outer)(sc, sc->T1_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+ case OP_SAFE_C_op_S_opSq_q:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, caddr(cadr(code))))) break;
+
+ case HOP_SAFE_C_op_S_opSq_q:
+ {
+ /* (exp (* r (cos x))) */
+ s7_pointer outer, args;
+ outer = cadr(code);
+ args = caddr(outer);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_2) = c_call(args)(sc, sc->T1_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(outer));
+ car(sc->T1_1) = c_call(outer)(sc, sc->T2_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_PS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_PS:
+ push_stack(sc, OP_EVAL_ARGS_P_3, sc->NIL, code); /* gotta wait in this case */
+ sc->code = cadr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_PC:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_PC:
+ push_stack(sc, OP_EVAL_ARGS_P_4, caddr(code), code);
+ sc->code = cadr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_PQ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_PQ:
+ push_stack(sc, OP_EVAL_ARGS_P_4, cadr(caddr(code)), code); /* was P_5, but that's the same as P_4 */
+ sc->code = cadr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_SP:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SP:
+ push_stack(sc, OP_EVAL_ARGS_P_2, find_symbol_checked(sc, cadr(code)), code);
+ sc->code = caddr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_AP:
+ if ((!c_function_is_ok(sc, code)) || (!a_is_ok(sc, cadr(code)))) break;
+
+ case HOP_SAFE_C_AP:
+ push_stack(sc, OP_EVAL_ARGS_P_2, c_call(cdr(code))(sc, cadr(code)), code);
+ sc->code = caddr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_CP:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_CP:
+ push_stack(sc, OP_EVAL_ARGS_P_2, cadr(code), code);
+ sc->code = caddr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_QP:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_QP:
+ push_stack(sc, OP_EVAL_ARGS_P_2, cadr(cadr(code)), code);
+ sc->code = caddr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_PP:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_PP:
+ push_stack(sc, OP_SAFE_C_PP_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_SSP:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_SSP:
+ push_stack(sc, OP_EVAL_ARGS_SSP_1, sc->NIL, code);
+ sc->code = cadddr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_C_opSSq:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSSq:
+ {
+ s7_pointer args, val1;
+ args = cadr(code);
+ val1 = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(args));
+ car(sc->T2_1) = val1;
+ car(sc->T1_1) = c_call(args)(sc, sc->T2_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSCq:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSCq:
+ {
+ s7_pointer args;
+ args = cadr(code);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_2) = caddr(args);
+ car(sc->T1_1) = c_call(args)(sc, sc->T2_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opCSq:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opCSq:
+ {
+ s7_pointer args;
+ args = cadr(code);
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(args));
+ car(sc->T2_1) = cadr(args);
+ car(sc->T1_1) = c_call(args)(sc, sc->T2_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSQq:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSQq:
+ {
+ s7_pointer args;
+ args = cadr(code);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_2) = cadr(caddr(args));
+ car(sc->T1_1) = c_call(args)(sc, sc->T2_1);
+ sc->value = c_call(code)(sc, sc->T1_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_opSq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_S_opSq:
+ {
+ s7_pointer args, val;
+ args = cdr(code);
+ val = find_symbol_checked(sc, car(args));
+ car(sc->T1_1) = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T1_1);
+ car(sc->T2_1) = val;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+ case OP_SAFE_C_S_opCq:
+ if (!c_function_is_ok_caddr(sc, code))break;
+
+ case HOP_SAFE_C_S_opCq:
+ {
+ s7_pointer args, val;
+ args = cdr(code);
+ val = find_symbol_checked(sc, car(args));
+ car(sc->T2_2) = c_call(cadr(args))(sc, opt_pair1(args)); /* any number of constants here */
+ car(sc->T2_1) = val;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_C_opSq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_C_opSq:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T1_1) = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T1_1);
+ car(sc->T2_1) = car(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_C_opCq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_C_opCq:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_2) = c_call(cadr(args))(sc, opt_pair1(args)); /* any # of args */
+ car(sc->T2_1) = car(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_C_opCSq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_C_opCSq:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_2) = find_symbol_checked(sc, opt_sym2(args));
+ car(sc->T2_1) = opt_con1(args);
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1);
+ car(sc->T2_1) = car(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_C_opSSq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_C_opSSq:
+ {
+ s7_pointer args, val;
+ args = cdr(code);
+ val = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T2_2) = find_symbol_checked(sc, opt_sym2(args));
+ car(sc->T2_1) = val;
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1);
+ car(sc->T2_1) = car(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opCSq_C:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opCSq_C:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(car(args)));
+ car(sc->T2_1) = cadr(car(args));
+ car(sc->T2_1) = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_2) = cadr(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSSq_C:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSSq_C:
+ {
+ s7_pointer args, val;
+ args = cdr(code);
+ val = find_symbol_checked(sc, cadr(car(args)));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(car(args)));
+ car(sc->T2_1) = val;
+ car(sc->T2_1) = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_2) = cadr(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSSq_S:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSSq_S:
+ {
+ s7_pointer args, val, val1;
+ args = cdr(code);
+ val = find_symbol_checked(sc, cadr(car(args)));
+ val1 = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(car(args)));
+ car(sc->T2_1) = val;
+ car(sc->T2_1) = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_2) = val1;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_op_opSSq_q_C:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
+
+ case HOP_SAFE_C_op_opSSq_q_C:
+ {
+ /* code: (> (magnitude (- old new)) 0.001) */
+ s7_pointer arg;
+ arg = cadr(cadr(code));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T1_1) = c_call(arg)(sc, sc->T2_1);
+ car(sc->T2_1) = c_call(cadr(code))(sc, sc->T1_1);
+ car(sc->T2_2) = caddr(code);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_op_opSSq_q_S:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
+
+ case HOP_SAFE_C_op_opSSq_q_S:
+ {
+ /* code: (> (magnitude (- old new)) s) */
+ s7_pointer arg;
+ arg = cadr(cadr(code));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(arg));
+ car(sc->T1_1) = c_call(arg)(sc, sc->T2_1);
+ car(sc->T2_1) = c_call(cadr(code))(sc, sc->T1_1);
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(code));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_op_opSq_q_C:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
+
+ case HOP_SAFE_C_op_opSq_q_C:
+ {
+ s7_pointer arg;
+ arg = cadr(cadr(code));
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T1_1) = c_call(arg)(sc, sc->T1_1);
+ car(sc->T2_1) = c_call(cadr(code))(sc, sc->T1_1);
+ car(sc->T2_2) = caddr(code);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_op_opSq_q_S:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, cadr(code))) || (!c_function_is_ok(sc, cadr(cadr(code))))) break;
+
+ case HOP_SAFE_C_op_opSq_q_S:
+ {
+ s7_pointer arg;
+ arg = cadr(cadr(code));
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(arg));
+ car(sc->T1_1) = c_call(arg)(sc, sc->T1_1);
+ car(sc->T2_1) = c_call(cadr(code))(sc, sc->T1_1);
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(code));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_op_opSSq_Sq:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, caddr(code))) || (!c_function_is_ok(sc, cadr(caddr(code))))) break;
+
+ case HOP_SAFE_C_S_op_opSSq_Sq:
+ {
+ /* (let () (define (hi a b c d) (+ a (* (- b c) d))) (define (ho) (hi 1 2 3 4)) (ho))
+ * or actually... (oscil fmosc1 (+ (* fm1-rat vib) fuzz))
+ * and that is then packaged as opCq...: (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
+ * and that is then (+ ...)
+ * but now this is handled in clm2xen.c
+ */
+ s7_pointer args, val, val1;
+ args = caddr(code); /* (* (- b c) d) */
+ val1 = cadr(args);
+ val = find_symbol_checked(sc, cadr(val1)); /* b */
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(val1)); /* c */
+ car(sc->T2_1) = val;
+ val = find_symbol_checked(sc, caddr(args)); /* d */
+ car(sc->T2_1) = c_call(val1)(sc, sc->T2_1); /* (- b c) */
+ car(sc->T2_2) = val;
+ car(sc->T2_2) = c_call(args)(sc, sc->T2_1); /* (* ...) */
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(code)); /* a */
+ sc->value = c_call(code)(sc, sc->T2_1); /* (+ ...) */
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_op_S_opSSqq:
+ if ((!c_function_is_ok(sc, code)) || (!c_function_is_ok(sc, caddr(code))) || (!c_function_is_ok(sc, caddr(caddr(code))))) break;
+
+ case HOP_SAFE_C_S_op_S_opSSqq:
+ {
+ /* (let () (define (hi a b c d) (+ a (* d (- b c)))) (define (ho) (hi 1 2 3 4)) (ho)) */
+ s7_pointer args, val, val1;
+ args = caddr(code); /* (* d (- b c)) */
+ val1 = caddr(args);
+ val = find_symbol_checked(sc, cadr(val1)); /* b */
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(val1)); /* c */
+ car(sc->T2_1) = val;
+ val = find_symbol_checked(sc, cadr(args)); /* d */
+ car(sc->T2_2) = c_call(val1)(sc, sc->T2_1); /* (- b c) */
+ car(sc->T2_1) = val;
+ car(sc->T2_2) = c_call(args)(sc, sc->T2_1); /* (* ...) */
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(code)); /* a */
+ sc->value = c_call(code)(sc, sc->T2_1); /* (+ ...) */
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_op_opSSq_opSSqq:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_S_op_opSSq_opSSqq:
+ {
+ /* (* s (f3 (f1 a b) (f2 c d))) */
+ s7_pointer args, f1, op1, op2;
+
+ args = caddr(code);
+ op1 = cadr(args);
+ op2 = caddr(args);
+
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(op1));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(op1));
+ f1 = c_call(op1)(sc, sc->T2_1);
+
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(op2));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(op2));
+ car(sc->T2_2) = c_call(op2)(sc, sc->T2_1);
+
+ car(sc->T2_1) = f1;
+ car(sc->T2_2) = c_call(args)(sc, sc->T2_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(code));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSCq_S:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSCq_S:
+ {
+ s7_pointer args, val1;
+ args = cdr(code);
+ val1 = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(car(args)));
+ car(sc->T2_2) = caddr(car(args));
+ car(sc->T2_1) = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_2) = val1;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSCq_C:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSCq_C:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(car(args)));
+ car(sc->T2_2) = caddr(car(args));
+ car(sc->T2_1) = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_2) = cadr(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opCSq_S:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opCSq_S:
+ {
+ s7_pointer args, val1;
+ args = cdr(code);
+ val1 = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(car(args)));
+ car(sc->T2_1) = cadr(car(args));
+ car(sc->T2_1) = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_2) = val1;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_opSCq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_S_opSCq:
+ {
+ s7_pointer val1, args;
+ args = cdr(code);
+ val1 = find_symbol_checked(sc, car(args));
+ car(sc->T2_1) = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T2_2) = opt_con2(args);
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1);
+ car(sc->T2_1) = val1;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_C_opSCq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_C_opSCq:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T2_2) = opt_con2(args);
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1);
+ car(sc->T2_1) = car(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_opSSq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_S_opSSq:
+ {
+ /* (* a (- b c)) */
+ s7_pointer val1, val2, args;
+ args = cdr(code);
+ val1 = find_symbol_checked(sc, car(args));
+ val2 = find_symbol_checked(sc, opt_sym1(args));
+ car(sc->T2_2) = find_symbol_checked(sc, opt_sym2(args));
+ car(sc->T2_1) = val2;
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1);
+ car(sc->T2_1) = val1;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_S_opCSq:
+ if (!c_function_is_ok_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_S_opCSq:
+ {
+ /* (* a (- 1 b)) or (logand a (ash 1 b)) */
+ s7_pointer val1, args;
+ args = cdr(code);
+ val1 = find_symbol_checked(sc, car(args)); /* a */
+ car(sc->T2_2) = find_symbol_checked(sc, opt_sym2(args)); /* b */
+ car(sc->T2_1) = opt_con1(args); /* 1 */
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1); /* (- 1 b) */
+ car(sc->T2_1) = val1;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSq_S:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSq_S:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(car(args)));
+ sc->temp3 = c_call(car(args))(sc, sc->T1_1);
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_1) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSq_P:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSq_P:
+ {
+ s7_pointer args;
+ args = cadr(code);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(args));
+ push_stack(sc, OP_SAFE_C_opSq_P_1, c_call(args)(sc, sc->T1_1), sc->code);
+ sc->code = caddr(code);
+ goto EVAL;
+ }
+
+
+ case OP_SAFE_C_opCq_S:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opCq_S:
+ {
+ s7_pointer args, val;
+ args = cdr(code);
+ val = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_1) = c_call(car(args))(sc, cdr(car(args)));
+ car(sc->T2_2) = val;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opCq_C:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opCq_C:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = c_call(car(args))(sc, cdr(car(args)));
+ car(sc->T2_2) = cadr(args); /* the second C stands for 1 arg? */
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSq_C:
+ if (!c_function_is_ok_cadr(sc, code)) break;
+
+ case HOP_SAFE_C_opSq_C:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(car(args)));
+ car(sc->T2_1) = c_call(car(args))(sc, sc->T1_1);
+ car(sc->T2_2) = cadr(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_C_op_S_opCqq:
+ if (!a_is_ok(sc, code)) break;
+
+ case HOP_SAFE_C_C_op_S_opCqq:
+ {
+ /* (define (hi a) (< 1.0 (+ a (* a 2)))) */
+ s7_pointer args, arg1, arg2;
+ args = cdr(code); /* C_op_S_opCqq */
+ arg1 = cadr(args); /* op_S_opCqq */
+ arg2 = caddr(arg1); /* opCq */
+ car(sc->T2_2) = c_call(arg2)(sc, cdr(arg2));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg1));
+ car(sc->T2_2) = c_call(arg1)(sc, sc->T2_1);
+ car(sc->T2_1) = car(args);
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSq_opSq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_opSq_opSq:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(car(args)));
+ sc->temp3 = c_call(car(args))(sc, sc->T1_1);
+ args = cadr(args);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_2) = c_call(args)(sc, sc->T1_1);
+ car(sc->T2_1) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opCq_opCq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_opCq_opCq:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ car(sc->T2_1) = c_call(car(args))(sc, cdr(car(args)));
+ car(sc->T2_2) = c_call(cadr(args))(sc, cdr(cadr(args)));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opCq_opSSq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_opCq_opSSq:
+ {
+ s7_pointer args, val;
+ /* code: (/ (+ bn 1) (+ bn an)) */
+ args = cdr(code);
+ val = c_call(car(args))(sc, cdr(car(args)));
+ args = cdr(args);
+ car(sc->T2_1) = find_symbol_checked(sc, cadar(args));
+ car(sc->T2_2) = find_symbol_checked(sc, caddar(args));
+ car(sc->T2_2) = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_1) = val;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSCq_opSCq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_opSCq_opSCq:
+ {
+ s7_pointer args, val2;
+ args = cdr(code);
+ val2 = find_symbol_checked(sc, cadr(cadr(args)));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(car(args)));
+ car(sc->T2_2) = caddr(car(args));
+ sc->temp3 = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_1) = val2;
+ car(sc->T2_2) = caddr(cadr(args));
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1);
+ car(sc->T2_1) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSSq_opSSq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_opSSq_opSSq:
+ {
+ s7_pointer args, val3, val4;
+ args = cdr(code);
+ val3 = find_symbol_checked(sc, caddr(car(args)));
+ val4 = find_symbol_checked(sc, caddr(cadr(args)));
+
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(car(args)));
+ car(sc->T2_2) = val3;
+ sc->temp3 = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(cadr(args)));
+ car(sc->T2_2) = val4;
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1);
+ car(sc->T2_1) = sc->temp3;
+ sc->temp3 = sc->NIL;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSSq_opSq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_opSSq_opSq:
+ {
+ s7_pointer args, val3;
+ args = cdr(code);
+ val3 = find_symbol_checked(sc, caddr(car(args)));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(car(args)));
+ car(sc->T2_2) = val3;
+ val3 = c_call(car(args))(sc, sc->T2_1);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(cadr(args)));
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T1_1);
+ car(sc->T2_1) = val3;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSq_opSSq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_opSq_opSSq:
+ {
+ s7_pointer args, val3;
+ args = cdr(code);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(car(args)));
+ val3 = c_call(car(args))(sc, sc->T1_1);
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(cadr(args)));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(cadr(args)));
+ car(sc->T2_2) = c_call(cadr(args))(sc, sc->T2_1);
+ car(sc->T2_1) = val3;
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ case OP_SAFE_C_opSSq_opCq:
+ if (!c_function_is_ok_cadr_caddr(sc, code)) break;
+
+ case HOP_SAFE_C_opSSq_opCq:
+ {
+ s7_pointer arg1, arg2, val3;
+ arg1 = cadr(code);
+ arg2 = caddr(code);
+ val3 = find_symbol_checked(sc, caddr(arg1));
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(arg1));
+ car(sc->T2_2) = val3;
+ car(sc->T2_1) = c_call(arg1)(sc, sc->T2_1);
+ car(sc->T2_2) = c_call(arg2)(sc, cdr(arg2));
+ sc->value = c_call(code)(sc, sc->T2_1);
+ goto START;
+ }
+
+
+ /* -------------------------------------------------------------------------------- */
+ case OP_C_S:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_S:
+ sc->args = list_1(sc, find_symbol_checked(sc, cadr(code)));
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+
+
+ case OP_READ_S:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_READ_S:
+ read_s_ex(sc);
+ goto START;
+
+
+ case OP_C_A:
+ if (!a_is_ok_cadr(sc, code)) break;
+
+ case HOP_C_A:
+ sc->args = list_1(sc, c_call(cdr(code))(sc, cadr(code)));
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+
+
+ case OP_C_Z:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_Z:
+ push_stack(sc, OP_C_P_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto OPT_EVAL;
+
+
+ case OP_C_P:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_P:
+ push_stack(sc, OP_C_P_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto EVAL;
+
+
+ case OP_C_SS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_SS:
+ sc->args = list_2(sc, find_symbol_checked(sc, cadr(code)), find_symbol_checked(sc, caddr(code)));
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+
+
+ case OP_C_SZ:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_SZ:
+ push_stack(sc, OP_C_SP_1, find_symbol_checked(sc, cadr(code)), code);
+ sc->code = caddr(code);
+ goto OPT_EVAL;
+
+
+ case OP_C_SP:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_SP:
+ push_stack(sc, OP_C_SP_1, find_symbol_checked(sc, cadr(code)), code);
+ sc->code = caddr(code);
+ goto EVAL;
+
+
+ case OP_APPLY_SS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_APPLY_SS:
+ sc->code = find_symbol_checked(sc, cadr(code)); /* global search here was slower */
+ sc->args = find_symbol_checked(sc, opt_sym2(code));
+ if (!is_proper_list(sc, sc->args)) /* (apply + #f) etc */
+ return(apply_list_error(sc, sc->args));
+ if (needs_copied_args(sc->code))
+ sc->args = copy_list(sc, sc->args);
+ goto APPLY;
+
+
+ case OP_C_S_opSq:
+ if ((!c_function_is_ok(sc, code)) || (!indirect_c_function_is_ok(sc, caddr(code)))) break;
+
+ case HOP_C_S_opSq:
+ {
+ s7_pointer args, val;
+ args = cdr(code);
+ val = find_symbol_checked(sc, car(args));
+ car(sc->T1_1) = find_symbol_checked(sc, opt_sym1(args));
+ sc->args = list_2(sc, val, c_call(cadr(args))(sc, sc->T1_1));
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+ }
+
+
+ case OP_C_S_opCq:
+ if ((!c_function_is_ok(sc, code)) || (!indirect_c_function_is_ok(sc, caddr(code)))) break;
+
+ case HOP_C_S_opCq:
+ {
+ s7_pointer args, val;
+ args = cdr(code);
+ sc->temp3 = find_symbol_checked(sc, car(args));
+ val = c_call(cadr(args))(sc, opt_pair1(args));
+ sc->args = list_2(sc, sc->temp3, val);
+ sc->temp3 = sc->NIL;
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+ }
+
+
+ case OP_C_SCS:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_SCS:
+ {
+ s7_pointer a1, a2;
+ a1 = cdr(code);
+ a2 = cdr(a1);
+ sc->args = list_3(sc, find_symbol_checked(sc, car(a1)), car(a2), find_symbol_checked(sc, cadr(a2))); /* was unchecked? */
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+ }
+
+
+ case OP_C_ALL_X:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_ALL_X:
+ { /* (set-cdr! lst ()) */
+ s7_pointer args, p;
+ sc->args = make_list(sc, integer(arglist_length(code)), sc->NIL);
+ for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
+ car(p) = c_call(args)(sc, car(args));
+ sc->value = c_call(code)(sc, sc->args);
+ goto START;
+ }
+
+
+ case OP_CALL_WITH_EXIT:
+ if (!c_function_is_ok(sc, code)) break;
+ check_lambda_args(sc, cadr(cadr(code)), NULL);
+
+ case HOP_CALL_WITH_EXIT:
+ {
+ s7_pointer go, args;
+ args = opt_pair2(code);
+ go = make_goto(sc);
+ push_stack(sc, OP_DEACTIVATE_GOTO, go, code); /* code arg is ignored, but perhaps this is safer in GC? */
+ new_frame_with_slot(sc, sc->envir, sc->envir, caar(args), go);
+ sc->code = cdr(args);
+ goto BEGIN1;
+ }
+
+ case OP_C_CATCH:
+ if (!c_function_is_ok(sc, code)) break;
+ check_lambda_args(sc, cadr(cadddr(code)), NULL);
+
+ case HOP_C_CATCH:
+ {
+ /* (catch #t (lambda () (set! ("hi") #\a)) (lambda args args))
+ * code is (catch #t (lambda () ....) (lambda args ....))
+ */
+ s7_pointer p, f, args, tag;
+
+ args = cddr(code);
+
+ /* defer making the error lambda */
+ /* z = cdadr(args); make_closure_with_let(sc, y, car(z), cdr(z), sc->envir); */
+
+ /* check catch tag */
+ f = cadr(code);
+ if (!is_pair(f)) /* (catch #t ...) or (catch sym ...) */
+ {
+ if (is_symbol(f))
+ tag = find_symbol_checked(sc, f);
+ else tag = f;
+ }
+ else tag = cadr(f); /* (catch 'sym ...) */
+
+ new_cell(sc, p, T_CATCH); /* the catch object sitting on the stack */
+ catch_tag(p) = tag;
+ catch_goto_loc(p) = s7_stack_top(sc);
+ catch_op_loc(p) = (int)(sc->op_stack_now - sc->op_stack);
+ catch_handler(p) = cdadr(args); /* not yet a closure... */
+
+ push_stack(sc, OP_CATCH_1, code, p); /* code ignored here, except by GC */
+ new_frame(sc, sc->envir, sc->envir);
+ sc->code = cddar(args);
+ goto BEGIN1;
+ }
+
+
+ case OP_C_CATCH_ALL:
+ if (!c_function_is_ok(sc, code)) break;
+
+ case HOP_C_CATCH_ALL:
+ {
+ /* (catch #t (lambda () ...) (lambda args #f)
+ */
+ s7_pointer p;
+ new_frame(sc, sc->envir, sc->envir);
+ /* catch_all needs 3 pieces of info: the goto/op locs and the result
+ * the locs are unsigned ints, so this fits in the new frame's dox1/2 fields.
+ */
+ p = sc->envir;
+ catch_all_set_goto_loc(p, s7_stack_top(sc));
+ catch_all_set_op_loc(p, (int)(sc->op_stack_now - sc->op_stack));
+ catch_all_set_result(p, opt_con2(code));
+ push_stack_no_args(sc, OP_CATCH_ALL, code);
+ sc->code = opt_pair1(cdr(code)); /* the body of the first lambda */
+ goto BEGIN1; /* removed one_liner check here -- rare */
+ }
+
+
+ /* -------------------------------------------------------------------------------- */
+ case OP_THUNK:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 0)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
+
+ case HOP_THUNK:
+ check_stack_size(sc);
+ /* this recursion check is consistent with the other unsafe closure calls, but we're probably in big trouble:
+ * (letrec ((a (lambda () (cons 1 (b)))) (b (lambda () (a)))) (b))
+ * unfortunately the alternative is a segfault when we wander off the end of the stack.
+ *
+ * It seems that we could use the hop bit here (since it is always off) to choose between BEGIN1 and OPT_EVAL or EVAL,
+ * but the EVAL choice gains nothing in time, and the OPT_EVAL choice is too tricky -- it is a two-level optimization,
+ * so if the inner (car(closure_body)) gets unopt'd for some reason, the outer HOP_THUNK never finds
+ * out, and peculiar things start to happen. (Also, is_h_optimized would need to be smarter).
+ */
+ new_frame(sc, closure_let(opt_lambda(code)), sc->envir);
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_THUNK:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 0)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
+
+ case HOP_SAFE_THUNK: /* no frame needed */
+ /* (let ((x 1)) (let () (define (f) x) (let ((x 0)) (define (g) (set! x 32) (f)) (g)))) */
+ sc->envir = closure_let(opt_lambda(code));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_THUNK_E:
+ if (find_symbol_unchecked(sc, car(code)) != opt_any1(code)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
+
+ case HOP_SAFE_THUNK_E:
+ sc->envir = closure_let(opt_lambda(code));
+ sc->code = car(closure_body(opt_lambda(code)));
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_THUNK_P:
+ if (find_symbol_unchecked(sc, car(code)) != opt_any1(code)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
+
+ case HOP_SAFE_THUNK_P:
+ sc->envir = closure_let(opt_lambda(code));
+ sc->code = car(closure_body(opt_lambda(code)));
+ sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->code = cdr(sc->code);
+ goto START_WITHOUT_POP_STACK;
+
+
+ case OP_SAFE_CLOSURE_S:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_S:
+ /* since a tail call is safe, we can't change the current env's let_id until
+ * after we do the lookup -- it might be the current func's arg, and we're
+ * about to call the same func.
+ */
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_CLOSURE_S_P:
+ if (find_symbol_unchecked(sc, car(code)) != opt_any1(code)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_S_P:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
+ sc->code = car(closure_body(opt_lambda(code)));
+ sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->code = cdr(sc->code);
+ goto START_WITHOUT_POP_STACK;
+
+
+ case OP_SAFE_GLOSURE_S:
+ if ((symbol_id(car(code)) != 0) ||(opt_any1(code) != slot_value(global_slot(car(code)))))
+ {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_SAFE_GLOSURE_S:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_GLOSURE_S_E:
+ if ((symbol_id(car(code)) != 0) || (opt_any1(code) != slot_value(global_slot(car(code)))))
+ {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_SAFE_GLOSURE_S_E:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
+ sc->code = car(closure_body(opt_lambda(code)));
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_CLOSURE_C:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_C:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), cadr(code));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_CLOSURE_Q:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_Q:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), cadr(cadr(code)));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_GLOSURE_P:
+ if ((symbol_id(car(code)) != 0) || (opt_any1(code) != slot_value(global_slot(car(code))))) break;
+
+ case HOP_SAFE_GLOSURE_P:
+ push_stack(sc, OP_SAFE_CLOSURE_P_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto EVAL;
+
+
+ case OP_SAFE_CLOSURE_A:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
+ if (!indirect_c_function_is_ok(sc, cadr(code))) break;
+
+ case HOP_SAFE_CLOSURE_A:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), c_call(cdr(code))(sc, cadr(code)));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_GLOSURE_A:
+ if ((symbol_id(car(code)) != 0) || (opt_any1(code) != slot_value(global_slot(car(code)))))
+ {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
+ if (!indirect_c_function_is_ok(sc, cadr(code))) break;
+
+ case HOP_SAFE_GLOSURE_A:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), c_call(cdr(code))(sc, cadr(code)));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_CLOSURE_SS:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_SS:
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)),
+ find_symbol_checked(sc, cadr(code)),
+ find_symbol_checked(sc, opt_sym2(code)));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_CLOSURE_SC:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_SC:
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)), opt_con2(code));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_CLOSURE_CS:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_CS:
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), cadr(code), find_symbol_checked(sc, opt_sym2(code)));
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+
+
+ case OP_SAFE_CLOSURE_SA:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_AA); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_SA:
+ {
+ s7_pointer args;
+ args = cddr(code);
+ args = c_call(args)(sc, car(args));
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)), args);
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_CLOSURE_AA:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_AA); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_AA:
+ {
+ s7_pointer args, y, z;
+ args = cdr(code);
+ y = c_call(args)(sc, car(args));
+ args = cdr(args);
+ z = c_call(args)(sc, car(args));
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), y, z);
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_CLOSURE_SAA:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 3)) break;
+
+ case HOP_SAFE_CLOSURE_SAA:
+ {
+ s7_pointer args, y, z;
+ args = cddr(code);
+ y = c_call(args)(sc, car(args));
+ args = cdr(args);
+ z = c_call(args)(sc, car(args));
+ sc->envir = old_frame_with_three_slots(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)), y, z);
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_CLOSURE_ALL_X:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, integer(arglist_length(code)))) break;
+
+ case HOP_SAFE_CLOSURE_ALL_X:
+ {
+ s7_pointer args, p, env, x, z;
+ int num_args;
+ unsigned long long int id;
+
+ num_args = integer(arglist_length(code));
+ if ((num_args != 0) &&
+ (num_args < NUM_SAFE_LISTS) &&
+ (!list_is_in_use(sc->safe_lists[num_args])))
+ {
+ sc->args = sc->safe_lists[num_args];
+ set_list_in_use(sc->args);
+ }
+ else sc->args = make_list(sc, num_args, sc->NIL);
+
+ for (args = cdr(code), p = sc->args; is_pair(args); args = cdr(args), p = cdr(p))
+ car(p) = c_call(args)(sc, car(args));
+ clear_list_in_use(sc->args);
+ sc->code = opt_lambda(code);
+
+ id = ++sc->let_number;
+ env = closure_let(sc->code);
+ let_id(env) = id;
+
+ for (x = let_slots(env), z = sc->args; is_slot(x); x = next_slot(x), z = cdr(z))
+ {
+ slot_set_value(x, car(z));
+ symbol_set_local(slot_symbol(x), id, x);
+ }
+ sc->envir = env;
+ sc->code = closure_body(sc->code);
+
+ if (is_pair(cdr(sc->code)))
+ {
+ push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code));
+ sc->code = car(sc->code);
+ }
+ else
+ {
+ sc->code = car(sc->code);
+ if (is_optimized(sc->code))
+ goto OPT_EVAL;
+ }
+ goto EVAL;
+ }
+
+
+ /* -------------------------------------------------------------------------------- */
+
+ case OP_SAFE_CLOSURE_STAR_SS:
+ if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_STAR_SS:
+ {
+ s7_pointer x, val1, val2;
+ /* the finders have to operate in the current environment, so we can't change sc->envir until later */
+ val1 = find_symbol_checked(sc, cadr(code));
+ val2 = find_symbol_checked(sc, opt_sym2(code)); /* caddr */
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), val1);
+
+ x = next_slot(let_slots(closure_let(opt_lambda(code))));
+ slot_set_value(x, val2);
+ symbol_set_local(slot_symbol(x), let_id(sc->envir), x);
+ fill_safe_closure_star(sc, next_slot(x), cddr(closure_args(opt_lambda(code))));
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_CLOSURE_STAR_SC:
+ if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_STAR_SC:
+ {
+ s7_pointer x;
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)));
+
+ x = next_slot(let_slots(closure_let(opt_lambda(code))));
+ slot_set_value(x, caddr(code));
+ symbol_set_local(slot_symbol(x), let_id(sc->envir), x);
+ fill_safe_closure_star(sc, next_slot(x), cddr(closure_args(opt_lambda(code))));
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_CLOSURE_STAR_SA:
+ if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 2)) break;
+
+ case HOP_SAFE_CLOSURE_STAR_SA:
+ {
+ s7_pointer arg;
+ /* the second arg needs to be evaluated before we set sc->envir.
+ * we checked at optimize time that this closure takes only 2 args.
+ */
+ arg = cddr(code);
+ arg = c_call(arg)(sc, car(arg));
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, cadr(code)), arg);
+
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_CLOSURE_STAR_ALL_X:
+ if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, integer(arglist_length(code)))) break;
+
+ case HOP_SAFE_CLOSURE_STAR_ALL_X:
+ {
+ s7_pointer args, p, orig_args, e;
+ /* (let () (define* (hi (a 1)) (+ a 1)) (define (ho) (hi (* 2 3))) (ho))
+ * (do ((i 0 (+ i 1))) ((= i 11)) (envelope-interp (/ i 21) '(0 0 100 1)))
+ */
+ e = closure_let(opt_lambda(code));
+ for (args = cdr(code), p = let_slots(e), orig_args = closure_args(opt_lambda(code));
+ is_pair(args);
+ args = cdr(args), orig_args = cdr(orig_args), p = next_slot(p))
+ slot_pending_value(p) = c_call(args)(sc, car(args));
+
+ /* we're out of caller's args, so fill rest of environment slots from the defaults */
+ for (; is_slot(p); p = next_slot(p), orig_args = cdr(orig_args))
+ {
+ s7_pointer defval;
+ if (is_pair(car(orig_args)))
+ {
+ defval = cadar(orig_args);
+ if (is_pair(defval))
+ slot_pending_value(p) = cadr(defval);
+ else slot_pending_value(p) = defval;
+ }
+ else slot_pending_value(p) = sc->F;
+ }
+
+ /* we have to put off the actual environment update in case this is a tail recursive call */
+ let_id(e) = ++sc->let_number;
+ for (p = let_slots(e); is_slot(p); p = next_slot(p))
+ {
+ slot_set_value(p, slot_pending_value(p));
+ symbol_set_local(slot_symbol(p), let_id(e), p);
+ }
+
+ sc->envir = e;
+ sc->code = closure_body(opt_lambda(code));
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_CLOSURE_STAR:
+ if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 0)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_STAR:
+ /* (let () (define* (hi (a 100)) (random a)) (define (ho) (hi)) (ho)) */
+ sc->envir = closure_let(opt_lambda(code));
+ let_id(sc->envir) = ++sc->let_number;
+ fill_safe_closure_star(sc, let_slots(closure_let(opt_lambda(code))), closure_args(opt_lambda(code)));
+ goto BEGIN1;
+
+
+ case OP_SAFE_CLOSURE_STAR_S0:
+ if (find_symbol_unchecked(sc, car(code)) != opt_any1(code)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_STAR_S0:
+ /* here we know we have (let-set! arg1 'name arg2) (with-env arg1 ...) as the safe closure body.
+ * since no errors can come from the first, there's no need for the procedure env.
+ * so do the set and with-env by hand, leaving with the env body.
+ */
+ {
+ s7_pointer e;
+ e = find_symbol_checked(sc, cadr(code)); /* S of S0 above */
+ if (e == sc->rootlet)
+ sc->envir = sc->NIL;
+ else
+ {
+ if (!is_let(e))
+ eval_type_error(sc, "with-let takes an environment argument: ~A", e);
+ sc->envir = e;
+ set_with_let_let(e);
+ }
+
+ if (e != sc->rootlet)
+ {
+ s7_pointer p;
+ let_id(e) = ++sc->let_number;
+ for (p = let_slots(e); is_slot(p); p = next_slot(p))
+ {
+ s7_pointer sym;
+ sym = slot_symbol(p);
+ symbol_set_local(sym, sc->let_number, p);
+ }
+ slot_set_value(local_slot(opt_sym1(cdr(code))), real_zero); /* "arg2" above */
+ }
+ sc->code = opt_pair2(cdr(code));
+ goto BEGIN1;
+ }
+
+
+ case OP_SAFE_CLOSURE_STAR_S:
+ if (!closure_star_is_ok(sc, code, MATCH_SAFE_CLOSURE_STAR, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_SAFE_CLOSURE_STAR_S:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_checked(sc, opt_sym2(code)));
+ /* that sets the first arg to the passed symbol value; now set default values, if any */
+ fill_safe_closure_star(sc, next_slot(let_slots(closure_let(opt_lambda(code)))), cdr(closure_args(opt_lambda(code))));
+ goto BEGIN1;
+
+
+ /* -------------------------------------------------------------------------------- */
+
+ case OP_GOTO:
+ set_opt_goto(code, find_symbol_checked(sc, car(code)));
+ if (!is_goto(opt_goto(code))) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
+
+ case HOP_GOTO:
+ sc->args = sc->NIL;
+ sc->code = opt_goto(code);
+ call_with_exit(sc);
+ goto START;
+
+
+ case OP_GOTO_C:
+ /* call-with-exit repeat use internally is very rare, so let's just look it up */
+ set_opt_goto(code, find_symbol_checked(sc, car(code)));
+ if (!is_goto(opt_goto(code)))
+ {
+ set_optimize_op(code, OP_UNKNOWN_G);
+ goto OPT_EVAL;
+ }
+
+ case HOP_GOTO_C:
+ /* (return #t) -- recognized via OP_UNKNOWN_G, opt_goto(code) is the function [parallels OP_CLOSURE_C] */
+ sc->args = cdr(code);
+ sc->code = opt_goto(code);
+ call_with_exit(sc);
+ goto START;
+
+
+ case OP_GOTO_S:
+ set_opt_goto(code, find_symbol_checked(sc, car(code)));
+ if (!is_goto(opt_goto(code))) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_GOTO_S:
+ sc->args = list_1(sc, find_symbol_checked(sc, cadr(code)));
+ /* I think this needs listification because call_with_exit might call dynamic unwinders etc. */
+ sc->code = opt_goto(code);
+ call_with_exit(sc);
+ goto START;
+
+
+ case OP_GOTO_A:
+ set_opt_goto(code, find_symbol_checked(sc, car(code)));
+ if (!is_goto(opt_goto(code))) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
+
+ case HOP_GOTO_A:
+ sc->args = list_1(sc, c_call(cdr(code))(sc, cadr(code)));
+ sc->code = opt_goto(code);
+ call_with_exit(sc);
+ goto START;
+ /* for T_CONTINUATION, set sc->args to list_1(sc, ...) as in goto (and code?), then call_with_current_continuation */
+
+
+ case OP_CLOSURE_C:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_C:
+ check_stack_size(sc);
+ code = opt_lambda(code);
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), cadr(sc->code));
+ sc->code = closure_body(code);
+ goto BEGIN1;
+
+
+ case OP_CLOSURE_Q:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_Q:
+ check_stack_size(sc);
+ code = opt_lambda(code);
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), cadr(cadr(sc->code)));
+ sc->code = closure_body(code);
+ goto BEGIN1;
+
+
+ case OP_CLOSURE_A:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
+ if (!indirect_c_function_is_ok(sc, cadr(code))) break;
+
+ case HOP_CLOSURE_A:
+ sc->value = c_call(cdr(code))(sc, cadr(code));
+ check_stack_size(sc);
+ code = opt_lambda(code);
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
+ sc->code = closure_body(code);
+ goto BEGIN1;
+
+
+ case OP_GLOSURE_A:
+ if ((symbol_id(car(code)) != 0) ||
+ (opt_lambda(code) != slot_value(global_slot(car(code)))))
+ {set_optimize_op(code, OP_UNKNOWN_A); goto OPT_EVAL;}
+ if (!indirect_c_function_is_ok(sc, cadr(code))) break;
+
+ case HOP_GLOSURE_A:
+ sc->value = c_call(cdr(code))(sc, cadr(code));
+ check_stack_size(sc);
+ code = opt_lambda(code);
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
+ sc->code = closure_body(code);
+ goto BEGIN1;
+
+
+ case OP_GLOSURE_P:
+ if ((symbol_id(car(code)) != 0) || (opt_lambda(code) != slot_value(global_slot(car(code))))) break;
+
+ case HOP_GLOSURE_P:
+ push_stack(sc, OP_CLOSURE_P_1, sc->NIL, code);
+ sc->code = cadr(code);
+ goto EVAL;
+
+
+ case OP_GLOSURE_S:
+ if ((symbol_id(car(code)) != 0) || (opt_any1(code) != slot_value(global_slot(car(code)))))
+ {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_GLOSURE_S:
+ sc->value = find_symbol_checked(sc, opt_sym2(code));
+ check_stack_size(sc);
+ code = opt_lambda(code);
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
+ sc->code = closure_body(code);
+ goto BEGIN1;
+
+
+ case OP_CLOSURE_S:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_S:
+ sc->value = find_symbol_checked(sc, opt_sym2(code));
+ check_stack_size(sc);
+ code = opt_lambda(code);
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
+ sc->code = closure_body(code);
+ goto BEGIN1;
+
+
+ case OP_CLOSURE_SS:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_SS: /* only called if one of these symbols has an accessor */
+ unsafe_closure_2(sc, find_symbol_checked(sc, cadr(code)), find_symbol_checked(sc, opt_sym2(code)));
+ goto BEGIN1;
+
+
+ case OP_CLOSURE_SC:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_SC:
+ unsafe_closure_2(sc, find_symbol_checked(sc, cadr(code)), opt_con2(code));
+ goto BEGIN1;
+
+
+ case OP_CLOSURE_CS:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_CS:
+ unsafe_closure_2(sc, cadr(code), find_symbol_checked(sc, opt_sym2(code)));
+ goto BEGIN1;
+
+
+ case OP_CLOSURE_AA:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, 2)) {set_optimize_op(code, OP_UNKNOWN_AA); goto OPT_EVAL;}
+ if ((is_optimized(cadr(code))) && (!indirect_c_function_is_ok(sc, cadr(code)))) break;
+ if ((is_optimized(caddr(code))) && (!indirect_c_function_is_ok(sc, caddr(code)))) break;
+
+ case HOP_CLOSURE_AA:
+ {
+ s7_pointer args;
+ args = cdr(code);
+ sc->temp2 = c_call(args)(sc, car(args));
+ unsafe_closure_2(sc, sc->temp2, c_call(cdr(args))(sc, cadr(args)));
+ goto BEGIN1;
+ }
+
+
+ case OP_CLOSURE_ALL_S:
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(code)))) {set_optimize_op(code, OP_UNKNOWN_ALL_S); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_ALL_S:
+ {
+ s7_pointer args, p, func, e;
+ /* in this case, we have just lambda (not lambda*), and no dotted arglist,
+ * and no accessed symbols in the arglist, and we know the arglist matches the parameter list.
+ */
+ check_stack_size(sc);
+ func = opt_lambda(code);
+ /* we need to get the slot names from the current function, but the values from the calling environment */
+ new_frame(sc, closure_let(func), e);
+ sc->z = e;
+ for (p = closure_args(func), args = cdr(code); is_pair(p); p = cdr(p), args = cdr(args))
+ add_slot(e, car(p), find_symbol_checked(sc, car(args)));
+ sc->envir = e;
+ sc->z = sc->NIL;
+ sc->code = closure_body(func);
+ goto BEGIN1;
+ }
+
+
+ case OP_CLOSURE_ALL_X:
+ check_stack_size(sc);
+ if (!closure_is_ok(sc, code, MATCH_UNSAFE_CLOSURE, integer(arglist_length(code)))) {set_optimize_op(code, OP_UNKNOWN_ALL_X); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_ALL_X:
+ {
+ s7_pointer args, p, func, e;
+ func = opt_lambda(code);
+ new_frame(sc, closure_let(func), e);
+ sc->z = e;
+ for (p = closure_args(func), args = cdr(code); is_pair(p); p = cdr(p), args = cdr(args))
+ {
+ s7_pointer val;
+ val = c_call(args)(sc, car(args));
+ add_slot_checked(e, car(p), val); /* can't use add_slot here -- all_x_c_* hit trigger? */
+ }
+ sc->envir = e;
+ sc->z = sc->NIL;
+ sc->code = closure_body(func);
+ goto BEGIN1;
+ }
+ /* -------------------------------------------------------------------------------- */
+
+ case OP_CLOSURE_STAR_ALL_X:
+ if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, integer(arglist_length(code))))
+ {
+ set_optimize_op(code, OP_UNKNOWN_ALL_X);
+ goto OPT_EVAL;
+ }
+
+ case HOP_CLOSURE_STAR_ALL_X:
+ {
+ /* here also, all the args are simple */
+ /* (let () (define* (hi (a 1)) (list a)) (define (ho) (hi (* 2 3))) (ho))
+ */
+ s7_pointer args, p, func, new_args;
+
+ func = opt_lambda(code);
+ sc->args = make_list(sc, closure_star_arity_to_int(sc, func), sc->NIL);
+ new_args = sc->args;
+
+ for (p = closure_args(func), args = cdr(code); is_pair(args); p = cdr(p), args = cdr(args), new_args = cdr(new_args))
+ car(new_args) = c_call(args)(sc, car(args));
+
+ for (; is_pair(p); p = cdr(p), new_args = cdr(new_args))
+ {
+ s7_pointer defval;
+ if (is_pair(car(p)))
+ {
+ defval = cadar(p);
+ if (is_pair(defval))
+ car(new_args) = cadr(defval);
+ else car(new_args) = defval;
+ }
+ else car(new_args) = sc->F;
+ }
+ sc->code = opt_lambda(code);
+ unsafe_closure_star(sc);
+ goto BEGIN1;
+ }
+
+
+ case OP_CLOSURE_STAR_SX:
+ if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, 2)) {set_optimize_op(code, OP_UNKNOWN_GG); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_STAR_SX:
+ {
+ s7_pointer val1, val2, args;
+ args = cddr(closure_args(opt_lambda(code)));
+ val1 = find_symbol_checked(sc, cadr(code));
+ val2 = caddr(code);
+ if (is_symbol(val2))
+ val2 = find_symbol_checked(sc, val2);
+ if (is_null(args))
+ {
+ car(sc->T2_1) = val1;
+ car(sc->T2_2) = val2;
+ code = opt_lambda(sc->code);
+ args = closure_args(code);
+ new_frame_with_two_slots(sc, closure_let(code), sc->envir,
+ (is_pair(car(args))) ? caar(args) : car(args), car(sc->T2_1),
+ (is_pair(cadr(args))) ? caadr(args) : cadr(args), car(sc->T2_2));
+ sc->code = closure_body(code);
+ }
+ else
+ {
+ sc->args = list_2(sc, val2, val1);
+ fill_closure_star(sc, args);
+ unsafe_closure_star(sc);
+ }
+ goto BEGIN1;
+ }
+
+
+ case OP_CLOSURE_STAR:
+ if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, 0)) {set_optimize_op(code, OP_UNKNOWN); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_STAR:
+ /* (let () (define* (hi (a 1)) (list a)) (define (ho) (hi)) (ho)) */
+ sc->args = sc->NIL;
+ fill_closure_star(sc, closure_args(opt_lambda(code)));
+ unsafe_closure_star(sc);
+ goto BEGIN1;
+
+
+ case OP_CLOSURE_STAR_S:
+ if (!closure_star_is_ok(sc, code, MATCH_UNSAFE_CLOSURE_STAR, 1)) {set_optimize_op(code, OP_UNKNOWN_G); goto OPT_EVAL;}
+
+ case HOP_CLOSURE_STAR_S:
+ sc->args = list_1(sc, find_symbol_checked(sc, opt_sym2(code)));
+ fill_closure_star(sc, cdr(closure_args(opt_lambda(code))));
+ unsafe_closure_star(sc);
+ goto BEGIN1;
+
+
+ /* -------------------------------------------------------------------------------- */
+ case OP_UNKNOWN:
+ case HOP_UNKNOWN:
+ if (unknown_ex(sc, find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+
+ case OP_UNKNOWN_G:
+ case HOP_UNKNOWN_G:
+ if (unknown_g_ex(sc, find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+
+ case OP_UNKNOWN_GG:
+ case HOP_UNKNOWN_GG:
+ if (unknown_gg_ex(sc, find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+
+ case OP_UNKNOWN_ALL_S:
+ case HOP_UNKNOWN_ALL_S:
+ if (unknown_all_s_ex(sc, find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+
+ case OP_UNKNOWN_A:
+ case HOP_UNKNOWN_A:
+ if (unknown_a_ex(sc, find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+
+ case OP_UNKNOWN_AA:
+ case HOP_UNKNOWN_AA:
+ if (unknown_aa_ex(sc, find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+
+ case OP_UNKNOWN_ALL_X:
+ case HOP_UNKNOWN_ALL_X:
+ if (unknown_all_x_ex(sc, find_symbol_checked(sc, car(code))) == goto_OPT_EVAL)
+ goto OPT_EVAL;
+ break;
+ /* -------------------------------------------------------------------------------- */
+
+
+ case OP_VECTOR_C:
+ case HOP_VECTOR_C:
+ if (vector_c_ex(sc) == goto_START) goto START;
+ break;
+
+ case OP_VECTOR_CC:
+ case HOP_VECTOR_CC:
+ if (vector_cc_ex(sc) == goto_START) goto START;
+ break;
+
+ case OP_VECTOR_A:
+ if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
+ case HOP_VECTOR_A:
+ if (vector_a_ex(sc) == goto_START) goto START;
+ break;
+
+ case OP_VECTOR_S:
+ case HOP_VECTOR_S:
+ if (vector_s_ex(sc) == goto_START) goto START;
+ break;
+
+
+ case OP_STRING_C:
+ case HOP_STRING_C:
+ if (string_c_ex(sc) == goto_START) goto START;
+ break;
+
+ case OP_STRING_A:
+ if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
+ case HOP_STRING_A:
+ if (string_a_ex(sc) == goto_START) goto START;
+ break;
+
+ case OP_STRING_S:
+ case HOP_STRING_S:
+ if (string_s_ex(sc) == goto_START) goto START;
+ break;
+
+
+ case OP_HASH_TABLE_C:
+ case HOP_HASH_TABLE_C:
+ {
+ s7_pointer s;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_hash_table(s)) break;
+ sc->value = s7_hash_table_ref(sc, s, cadr(code));
+ goto START;
+ }
+
+
+ case OP_HASH_TABLE_S:
+ case HOP_HASH_TABLE_S:
+ {
+ s7_pointer s;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_hash_table(s)) break;
+ sc->value = s7_hash_table_ref(sc, s, find_symbol_checked(sc, cadr(code)));
+ goto START;
+ }
+
+
+ case OP_HASH_TABLE_A:
+ if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
+ case HOP_HASH_TABLE_A:
+ {
+ s7_pointer s;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_hash_table(s)) break;
+ sc->value = s7_hash_table_ref(sc, s, c_call(cdr(code))(sc, cadr(code)));
+ goto START;
+ }
+
+
+ case OP_ENVIRONMENT_C:
+ case HOP_ENVIRONMENT_C:
+ {
+ s7_pointer s;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_let(s)) break;
+ sc->value = s7_let_ref(sc, s, cadr(code));
+ goto START;
+ }
+
+
+ case OP_ENVIRONMENT_S:
+ case HOP_ENVIRONMENT_S:
+ {
+ s7_pointer s;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_let(s)) break;
+ sc->value = s7_let_ref(sc, s, find_symbol_checked(sc, cadr(code)));
+ goto START;
+ }
+
+
+ case OP_ENVIRONMENT_Q:
+ case HOP_ENVIRONMENT_Q:
+ {
+ s7_pointer s, sym;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_let(s)) break;
+ sym = cadr(cadr(code));
+ if (is_symbol(sym))
+ sc->value = let_ref_1(sc, s, sym);
+ else return(wrong_type_argument_with_type(sc, sc->LET_REF, 2, sym, A_SYMBOL)); /* (e '(1)) */
+ goto START;
+ }
+
+
+ case OP_ENVIRONMENT_A:
+ if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
+ case HOP_ENVIRONMENT_A:
+ {
+ s7_pointer s, sym;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_let(s)) break;
+ sym = c_call(cdr(code))(sc, cadr(code));
+ if (is_symbol(sym))
+ sc->value = let_ref_1(sc, s, sym);
+ else return(wrong_type_argument_with_type(sc, sc->LET_REF, 2, sym, A_SYMBOL)); /* (e expr) where expr->#f */
+ goto START;
+ }
+
+
+ case OP_PAIR_C:
+ case HOP_PAIR_C:
+ {
+ s7_pointer s;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_pair(s)) break; /* this used to check is_integer(cadr(code)) but surely an error is correct if s is a pair? */
+ sc->value = list_ref_1(sc, s, cadr(code));
+ goto START;
+ }
+
+
+ case OP_PAIR_A:
+ if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
+ case HOP_PAIR_A:
+ {
+ s7_pointer s, x;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_pair(s)) break;
+ x = c_call(cdr(code))(sc, cadr(code));
+ sc->value = list_ref_1(sc, s, x);
+ goto START;
+ }
+
+
+ case OP_PAIR_S:
+ case HOP_PAIR_S:
+ {
+ s7_pointer s, ind;
+ s = find_symbol_checked(sc, car(code));
+ if (!is_pair(s)) break;
+ ind = find_symbol_checked(sc, cadr(code));
+ sc->value = list_ref_1(sc, s, ind);
+ goto START;
+ }
+
+
+ case OP_C_OBJECT:
+ case HOP_C_OBJECT:
+ {
+ s7_pointer c;
+ c = find_symbol_checked(sc, car(code));
+ if (!is_c_object(c)) break;
+ sc->value = (*(c_object_ref(c)))(sc, c, sc->NIL);
+ goto START;
+ }
+
+
+ case OP_C_OBJECT_C:
+ case HOP_C_OBJECT_C:
+ {
+ s7_pointer c;
+ c = find_symbol_checked(sc, car(code));
+ if (!is_c_object(c)) break;
+ sc->value = (*(c_object_ref(c)))(sc, c, cdr(code));
+ goto START;
+ }
+
+
+ case OP_C_OBJECT_A:
+ if (!indirect_cq_function_is_ok(sc, cadr(code))) break;
+ case HOP_C_OBJECT_A:
+ {
+ s7_pointer c;
+ c = find_symbol_checked(sc, car(code));
+ if (!is_c_object(c)) break;
+ car(sc->T1_1) = c_call(cdr(code))(sc, cadr(code));
+ sc->value = (*(c_object_ref(c)))(sc, c, sc->T1_1);
+ goto START;
+ }
+
+ case OP_C_OBJECT_S:
+ case HOP_C_OBJECT_S:
+ {
+ s7_pointer c;
+ c = find_symbol_checked(sc, car(code));
+ if (!is_c_object(c)) break;
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(code));
+ sc->value = (*(c_object_ref(c)))(sc, c, sc->T1_1);
+ goto START;
+ }
+
+ default:
+ fprintf(stderr, "bad op in opt_eval: op %u, is_opt: %d, %s\n", optimize_op(code), is_optimized(code), DISPLAY_80(code));
+ break;
+ }
+
+ /* else cancel all the optimization info -- someone stepped on our symbol */
+ /* there is a problem with this -- if the caller still insists on goto OPT_EVAL, for example,
+ * we get here over and over. (let ((x (list (car y))))...) where list is redefined away.
+ */
+ clear_all_optimizations(sc, code);
+ /* and fall into the normal evaluator */
+ }
+
+ /* fprintf(stderr, "trail: %s\n", DISPLAY(sc->code)); */
+ {
+ s7_pointer code, carc;
+ code = sc->code;
+
+ if (is_pair(code))
+ {
+ sc->cur_code = code;
+ carc = car(code);
+
+ if (typesflag(carc) == SYNTACTIC_TYPE)
+ {
+ set_type(code, SYNTACTIC_PAIR);
+ car(code) = syntax_symbol(slot_value(initial_slot(carc))); /* clear possible optimization confusion */
+ sc->op = (opcode_t)symbol_syntax_op(car(code));
+ pair_set_syntax_op(code, sc->op);
+ sc->code = cdr(code);
+ goto START_WITHOUT_POP_STACK;
+ }
+
+ /* -------------------------------------------------------------------------------- */
+ /* trailers */
+ if (is_symbol(carc))
+ {
+ /* car is a symbol, sc->code a list */
+ sc->value = find_global_symbol_checked(sc, carc);
+ sc->code = cdr(code);
+ /* drop into eval args */
+ }
+ else
+ {
+ /* very uncommon case: car is either itself a pair or some non-symbol */
+ if (is_pair(carc))
+ {
+ /* evaluate the inner list but that list can be circular: carc: #1=(#1# #1#)!
+ * and the cycle can be well-hidden -- #1=((#1 2) . 2) and other such stuff
+ */
+ if (sc->stack_end >= sc->stack_resize_trigger)
+ check_for_cyclic_code(sc, code);
+ push_stack(sc, OP_EVAL_ARGS, sc->NIL, cdr(code));
+ if (typesflag(car(carc)) == SYNTACTIC_TYPE)
+ /* was checking for is_syntactic here but that can be confused by successive optimizer passes:
+ * (define (hi) (((lambda () list)) 1 2 3)) etc
+ */
+ {
+ if ((car(carc) == sc->QUOTE) && /* ('and #f) */
+ ((!is_pair(cdr(carc))) || /* ((quote . #\h) (2 . #\i)) ! */
+ (is_syntactic(cadr(carc)))))
+ return(apply_error(sc, (is_pair(cdr(carc))) ? cadr(carc) : carc, cdr(code)));
+ sc->op = (opcode_t)symbol_syntax_op(car(carc));
+ sc->code = cdr(carc);
+ goto START_WITHOUT_POP_STACK;
+ }
+
+ push_stack(sc, OP_EVAL_ARGS, sc->NIL, cdr(carc));
+ sc->code = car(carc);
+ goto EVAL;
+ }
+ else
+ {
+ /* car must be the function to be applied */
+ sc->value = _NFre(carc);
+ sc->code = cdr(code);
+ /* drop into OP_EVAL_ARGS */
+ }
+ }
+ }
+ else /* sc->code is not a pair */
+ {
+ if (is_symbol(code))
+ {
+ sc->value = find_symbol_checked(sc, code);
+ pop_stack(sc);
+ if (sc->op != OP_EVAL_ARGS)
+ goto START_WITHOUT_POP_STACK;
+ /* drop into OP_EVAL_ARGS */
+ }
+ else
+ {
+ /* sc->code is not a pair or a symbol */
+ sc->value = _NFre(code);
+ goto START;
+ }
+ }
+ /* sc->value is car=something applicable
+ * sc->code = rest of expression
+ * sc->args is nil (set by the drop-through cases above -- perhaps clearer to bring that down?)
+ */
+ }
+
+ case OP_EVAL_ARGS:
+ if (dont_eval_args(sc->value))
+ {
+ if (is_any_macro(sc->value))
+ {
+ /* macro expansion */
+ sc->args = copy_list_with_arglist_error(sc, sc->code);
+ sc->code = sc->value;
+ goto APPLY; /* not UNSAFE_CLOSURE because it might be a bacro */
+ }
+ /* (define progn begin) (progn (display "hi") (+ 1 23)) */
+ if (!is_syntax(sc->value))
+ eval_error(sc, "attempt to evaluate: ~A?", sc->code);
+ sc->op = (opcode_t)syntax_opcode(sc->value);
+ goto START_WITHOUT_POP_STACK;
+ }
+
+ /* sc->value is the func
+ * we don't have to delay lookup of the func because arg evaluation order is not specified, so
+ * (let ((func +)) (func (let () (set! func -) 3) 2))
+ * can return 5.
+ */
+ /* if (is_null(sc->code)) {sc->code = sc->value; goto APPLY;}
+ * this is hit very rarely so it costs more than it saves
+ */
+
+ push_op_stack(sc, sc->value);
+ if (sc->op_stack_now >= sc->op_stack_end)
+ resize_op_stack(sc);
+
+ sc->args = sc->NIL;
+ goto EVAL_ARGS;
+ /* moving eval_args up here (to avoid this goto) was slightly slower, probably by chance. */
+
+ case OP_EVAL_ARGS5:
+ /* sc->value is the last arg, sc->code is the previous */
+ {
+ s7_pointer x, y;
+ new_cell(sc, x, T_PAIR);
+ new_cell_no_check(sc, y, T_PAIR);
+ car(x) = sc->code;
+ cdr(x) = sc->args;
+ car(y) = sc->value;
+ cdr(y) = x;
+ sc->args = safe_reverse_in_place(sc, y);
+ sc->code = pop_op_stack(sc);
+ goto APPLY;
+ }
+
+
+ case OP_EVAL_ARGS2:
+ /* sc->value is the last arg, [so if is_null(cdr(sc->code) and current is pair, push args2] */
+ {
+ s7_pointer x;
+ sc->code = pop_op_stack(sc);
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->args;
+ if (!is_null(sc->args))
+ sc->args = safe_reverse_in_place(sc, x);
+ else sc->args = x;
+ goto APPLY;
+ }
+
+
+ /* tricky cases here all involve values (i.e. multiple-values) */
+ case OP_EVAL_ARGS_P_2:
+ /* from HOP_SAFE_C_SP||CP|QP, handled like P_1 case above
+ * primarily involves generators: (outa i (nrcos gen)) etc
+ */
+ car(sc->T2_1) = sc->args;
+ car(sc->T2_2) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+
+ case OP_EVAL_ARGS_P_2_MV:
+ sc->args = cons(sc, sc->args, sc->value);
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY;
+
+
+ case OP_EVAL_ARGS_SSP_1:
+ /* from HOP_SAFE_C_SSP */
+ car(sc->T3_3) = sc->value;
+ car(sc->T3_1) = find_symbol_checked(sc, cadr(sc->code));
+ car(sc->T3_2) = find_symbol_checked(sc, caddr(sc->code));
+ sc->value = c_call(sc->code)(sc, sc->T3_1);
+ break;
+
+
+ case OP_EVAL_ARGS_SSP_MV:
+ sc->args = cons(sc, find_symbol_checked(sc, cadr(sc->code)), cons(sc, find_symbol_checked(sc, caddr(sc->code)), sc->value));
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY;
+
+
+ case OP_EVAL_ARGS_P_3:
+ car(sc->T2_2) = find_symbol_checked(sc, caddr(sc->code));
+ /* we have to wait because we say the evaluation order is always left to right
+ * and the first arg's evaluation might change the value of the second arg.
+ */
+ car(sc->T2_1) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+ case OP_EVAL_ARGS_P_3_MV:
+ /* (define (hi a) (+ (values 1 2) a))
+ * (define (hi a) (log (values 1 2) a))
+ */
+ sc->w = sc->value;
+ sc->args = cons(sc, find_symbol_checked(sc, caddr(sc->code)), sc->w);
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY;
+
+
+ case OP_EVAL_ARGS_P_4:
+ car(sc->T2_1) = sc->value;
+ car(sc->T2_2) = sc->args;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+ case OP_EVAL_ARGS_P_4_MV: /* same as P_2_MV) */
+ sc->args = cons(sc, sc->args, sc->value);
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY; /* (define (hi) (log (values 1 2) 3)) ? */
+
+
+ case OP_SAFE_C_ZC_1:
+ car(sc->T2_1) = sc->value;
+ car(sc->T2_2) = sc->args;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+
+ case OP_SAFE_C_SZ_1:
+ car(sc->T2_1) = sc->args;
+ car(sc->T2_2) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+
+ case OP_SAFE_C_SZ_SZ:
+ /* S_opSZq actually, in (nominal second, only actual) SZ, S=args, Z=value,
+ * SZ from the SP combiner for SZ
+ */
+ car(sc->T2_1) = sc->args;
+ car(sc->T2_2) = sc->value;
+ car(sc->T2_2) = c_call(caddr(sc->code))(sc, sc->T2_1);
+ car(sc->T2_1) = find_symbol_checked(sc, cadr(sc->code));
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+
+ case OP_SAFE_C_ZA_1:
+ car(sc->T2_2) = c_call(cddr(sc->code))(sc, caddr(sc->code));
+ car(sc->T2_1) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+
+ case OP_SAFE_C_ZZ_1:
+ push_stack(sc, OP_SAFE_C_ZZ_2, sc->value, sc->code);
+ sc->code = caddr(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZZ_2:
+ car(sc->T2_1) = sc->args;
+ car(sc->T2_2) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+
+ case OP_SAFE_C_ZAA_1:
+ car(sc->A3_1) = sc->value;
+ car(sc->A3_2) = c_call(cddr(sc->code))(sc, caddr(sc->code));
+ car(sc->A3_3) = c_call(cdddr(sc->code))(sc, cadddr(sc->code));
+ sc->value = c_call(sc->code)(sc, sc->A3_1);
+ break;
+
+
+ case OP_SAFE_C_AZA_1:
+ car(sc->T3_3) = c_call(cdddr(sc->code))(sc, cadddr(sc->code));
+ car(sc->T3_2) = sc->value;
+ car(sc->T3_1) = sc->args;
+ sc->value = c_call(sc->code)(sc, sc->T3_1);
+ break;
+
+
+ case OP_SAFE_C_SSZ_1:
+ car(sc->T3_1) = sc->args;
+ car(sc->T3_3) = sc->value;
+ car(sc->T3_2) = find_symbol_checked(sc, caddr(sc->code));
+ sc->value = c_call(sc->code)(sc, sc->T3_1);
+ break;
+
+
+ case OP_SAFE_C_AAZ_1:
+ car(sc->T3_1) = pop_op_stack(sc);
+ car(sc->T3_2) = sc->args;
+ car(sc->T3_3) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T3_1);
+ break;
+
+
+ case OP_SAFE_C_ZZA_1:
+ push_op_stack(sc, sc->value);
+ push_stack(sc, OP_SAFE_C_ZZA_2, sc->args, sc->code);
+ sc->code = caddr(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZZA_2:
+ car(sc->A3_1) = pop_op_stack(sc);
+ car(sc->A3_2) = sc->value;
+ car(sc->A3_3) = c_call(cdddr(sc->code))(sc, cadddr(sc->code));
+ sc->value = c_call(sc->code)(sc, sc->A3_1);
+ break;
+
+
+ case OP_SAFE_C_ZAZ_1:
+ push_op_stack(sc, sc->value);
+ push_stack(sc, OP_SAFE_C_ZAZ_2, c_call(cddr(sc->code))(sc, caddr(sc->code)), sc->code);
+ sc->code = cadddr(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZAZ_2:
+ car(sc->T3_1) = pop_op_stack(sc);
+ car(sc->T3_2) = sc->args;
+ car(sc->T3_3) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T3_1);
+ break;
+
+
+ case OP_SAFE_C_AZZ_1:
+ push_op_stack(sc, sc->value);
+ push_stack(sc, OP_SAFE_C_AZZ_2, sc->args, sc->code);
+ sc->code = cadddr(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_AZZ_2:
+ car(sc->T3_1) = sc->args;
+ car(sc->T3_2) = pop_op_stack(sc);
+ car(sc->T3_3) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T3_1);
+ break;
+
+
+ case OP_SAFE_C_ZZZ_1:
+ push_stack(sc, OP_SAFE_C_ZZZ_2, sc->value, sc->code);
+ sc->code = caddr(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZZZ_2:
+ push_op_stack(sc, sc->value);
+ push_stack(sc, OP_SAFE_C_ZZZ_3, sc->args, sc->code);
+ sc->code = cadddr(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_SAFE_C_ZZZ_3:
+ car(sc->T3_1) = sc->args;
+ car(sc->T3_2) = pop_op_stack(sc);
+ car(sc->T3_3) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T3_1);
+ break;
+
+
+ case OP_SAFE_C_opSq_P_1:
+ /* this is the no-multiple-values case */
+ car(sc->T2_1) = sc->args;
+ car(sc->T2_2) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+ case OP_SAFE_C_opSq_P_MV:
+ /* here we need an argnum check since values could have appended any number of args
+ */
+ sc->args = cons(sc, sc->args, sc->value);
+
+ /* can values return an improper or circular list? I don't think so:
+ * (values 1 . 2) -> improper arg list error (same with apply values)
+ *
+ * currently (values) does not simply erase itself:
+ * :(let () (define (arg2 a) (let ((b 1)) (set! b (+ a b)) (values))) (define (hi c) (expt (abs c) (arg2 2))) (hi 2))
+ * ;expt power, argument 2, #<unspecified>, is an untyped but should be a number
+ * :(s7-version (values))
+ * ;s7-version: too many arguments: (#<unspecified>)
+ * :(exp (values) 0.0)
+ * ;exp: too many arguments: (#<unspecified> 0.0)
+ *
+ * map is explicitly a special case, and surely it is more confusing to have (values) scattered at random.
+ * also this is consistent with the unoptimized version
+ */
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY; /* (define (hi a) (+ (abs a) (values 1 2 3))) */
+
+
+ case OP_EVAL_ARGS3:
+ /* sc->value is the next-to-last arg, and we know the last arg is not a list (so values can't mess us up!)
+ */
+ {
+ s7_pointer x, y, val;
+
+ val = sc->code;
+ if (is_symbol(val))
+ val = find_symbol_checked(sc, val);
+
+ new_cell(sc, x, T_PAIR);
+ new_cell_no_check(sc, y, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->args;
+ car(y) = val;
+ cdr(y) = x;
+ sc->args = safe_reverse_in_place(sc, y);
+ sc->code = pop_op_stack(sc);
+ goto APPLY;
+ }
+
+
+ case OP_EVAL_ARGS4:
+ /* sc->code is a pair, and either cdr(sc->code) is not null or car(sc->code) is a pair
+ *
+ * (#f #f) (env #f) etc. args is very often nil here, so we're looking at 3 simple args
+ * or even just 2 in some cases: (+ req opt) with value 2 and args ()
+ */
+ {
+ s7_pointer x;
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->args;
+ sc->args = x; /* all the others reverse -- why not this case? -- reverse is at end? (below) */
+ goto EVAL_ARGS_PAIR;
+ }
+
+
+ case OP_EVAL_ARGS1:
+ {
+ s7_pointer x;
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->args;
+ sc->args = x;
+ }
+
+
+ EVAL_ARGS:
+ /* first time, value = op, args = nil, code is args */
+ if (is_pair(sc->code)) /* evaluate current arg -- must check for pair here, not sc->NIL (improper list as args) */
+ {
+ s7_pointer car_code;
+
+ EVAL_ARGS_PAIR:
+ car_code = car(sc->code);
+
+ /* switch statement here is much slower for some reason */
+ if (is_pair(car_code))
+ {
+ if (sc->stack_end >= sc->stack_resize_trigger)
+ check_for_cyclic_code(sc, sc->code);
+
+ /* all 3 of these push_stacks can result in stack overflow, see above 64065 */
+ if (is_null(cdr(sc->code)))
+ push_stack(sc, OP_EVAL_ARGS2, sc->args, sc->NIL);
+ else
+ {
+ if (!is_pair(cdr(sc->code))) /* (= 0 '(1 . 2) . 3) */
+ improper_arglist_error(sc);
+
+ if ((is_null(cddr(sc->code))) &&
+ (!is_pair(cadr(sc->code))))
+ push_stack(sc, OP_EVAL_ARGS3, sc->args, cadr(sc->code));
+ else push_stack(sc, OP_EVAL_ARGS4, sc->args, cdr(sc->code));
+ }
+ sc->code = car_code;
+ if (is_optimized(sc->code))
+ goto OPT_EVAL;
+ goto EVAL;
+ }
+
+ /* car(sc->code) is not a pair */
+ if (is_pair(cdr(sc->code)))
+ {
+ sc->code = cdr(sc->code);
+ if (is_symbol(car_code))
+ sc->value = find_symbol_checked(sc, car_code);
+ else sc->value = _NFre(car_code);
+ /* sc->value is the current arg's value, sc->code is pointing to the next */
+
+ /* cdr(sc->code) may not be a pair or nil here!
+ * (eq? #f . 1) -> sc->code is 1
+ */
+ if (is_null(cdr(sc->code)))
+ {
+ s7_pointer x, y, val;
+ /* we're at the last arg, sc->value is the previous one, not yet saved in the args list */
+ car_code = car(sc->code);
+ if (is_pair(car_code))
+ {
+ if (sc->stack_end >= sc->stack_resize_trigger)
+ check_for_cyclic_code(sc, sc->code);
+
+ push_stack(sc, OP_EVAL_ARGS5, sc->args, sc->value);
+ sc->code = car_code;
+ goto EVAL;
+ }
+
+ /* get the last arg */
+ if (is_symbol(car_code))
+ val = find_symbol_checked(sc, car_code);
+ else val = car_code;
+ sc->temp4 = val;
+
+ /* get the current arg, which is not a list */
+ sc->code = pop_op_stack(sc);
+ new_cell(sc, x, T_PAIR);
+ new_cell_no_check(sc, y, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->args;
+ car(y) = val;
+ cdr(y) = x;
+ sc->args = safe_reverse_in_place(sc, y);
+ /* drop into APPLY */
+ }
+ else
+ {
+ /* here we know sc->code is a pair, cdr(sc->code) is not null
+ * sc->value is the previous arg's value
+ */
+ s7_pointer x;
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->args;
+ sc->args = x;
+ goto EVAL_ARGS_PAIR;
+ }
+ }
+ else
+ {
+ /* here we've reached the last arg (sc->code == nil), it is not a pair */
+ s7_pointer x, val;
+
+ if (!is_null(cdr(sc->code)))
+ improper_arglist_error(sc);
+
+ sc->code = pop_op_stack(sc);
+ if (is_symbol(car_code))
+ val = find_symbol_checked(sc, car_code); /* this has to precede the set_type below */
+ else val = car_code;
+ sc->temp4 = val;
+ new_cell(sc, x, T_PAIR);
+ car(x) = val;
+ cdr(x) = sc->args;
+
+ if (!is_null(sc->args))
+ sc->args = safe_reverse_in_place(sc, x);
+ else sc->args = x;
+ /* drop into APPLY */
+ }
+ }
+ else /* got all args -- go to apply */
+ {
+ if (is_not_null(sc->code))
+ improper_arglist_error(sc);
+ else
+ {
+ sc->code = pop_op_stack(sc);
+ sc->args = safe_reverse_in_place(sc, sc->args);
+ /* we could omit the arg reversal in many cases, but lots of code assumes the args are in order;
+ * adding a bit for this in the type field saves some time in s7test (many + and * tests), but costs
+ * about the same time in other cases, so it's not a clear win.
+ */
+ }
+ }
+
+ /* turning this into a call on an array of functions was not a complete disaster, but tauto.scm was ~1.5% slower.
+ * the array-index overhead is the same as the current switch statement's, but there was also the boolean+jump overhead,
+ * and the function-local overhead currently otherwise 0 (I assume because the compiler can simply plug it in here).
+ */
+ APPLY:
+ /* fprintf(stderr, "apply %s to %s\n", DISPLAY(sc->code), DISPLAY(sc->args)); */
+ switch (type(sc->code))
+ {
+ case T_C_FUNCTION: apply_c_function(sc); goto START;
+ case T_C_ANY_ARGS_FUNCTION: apply_c_any_args_function(sc); goto START;
+ case T_C_FUNCTION_STAR: apply_c_function_star(sc); goto START;
+ case T_C_OPT_ARGS_FUNCTION: apply_c_opt_args_function(sc); goto START;
+ case T_C_RST_ARGS_FUNCTION: apply_c_rst_args_function(sc); goto START;
+ case T_C_MACRO: apply_c_macro(sc); goto EVAL;
+ case T_CONTINUATION: apply_continuation(sc); goto START;
+ case T_GOTO: call_with_exit(sc); goto START;
+ case T_C_OBJECT: apply_c_object(sc); goto START;
+ case T_INT_VECTOR:
+ case T_FLOAT_VECTOR:
+ case T_VECTOR: apply_vector(sc); goto START;
+ case T_STRING: apply_string(sc); goto START;
+ case T_HASH_TABLE: apply_hash_table(sc); goto START;
+ case T_ITERATOR: apply_iterator(sc); goto START;
+ case T_LET: apply_let(sc); goto START;
+ case T_SYNTAX: apply_syntax(sc); goto START_WITHOUT_POP_STACK;
+ case T_PAIR:
+ if (apply_pair(sc) == goto_APPLY) goto APPLY;
+ goto START;
+
+ case T_MACRO:
+ if (is_expansion(sc->code))
+ push_stack(sc, OP_EXPANSION, sc->NIL, sc->NIL);
+ else push_stack(sc, OP_EVAL_MACRO, sc->NIL, sc->NIL);
+ new_frame(sc, closure_let(sc->code), sc->envir);
+ apply_lambda(sc);
+ goto BEGIN1;
+
+ case T_BACRO:
+ push_stack(sc, OP_EVAL_MACRO, sc->NIL, sc->NIL);
+ new_frame(sc, sc->envir, sc->envir); /* like let* -- we'll be adding macro args, so might as well sequester things here */
+ apply_lambda(sc);
+ goto BEGIN1;
+
+ case T_CLOSURE:
+ check_stack_size(sc);
+ new_frame(sc, closure_let(sc->code), sc->envir);
+ apply_lambda(sc);
+ goto BEGIN1;
+
+
+ case T_MACRO_STAR:
+ push_stack(sc, OP_EVAL_MACRO, sc->NIL, sc->NIL);
+ new_frame(sc, closure_let(sc->code), sc->envir);
+ if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
+ goto BEGIN1;
+
+ case T_BACRO_STAR:
+ push_stack(sc, OP_EVAL_MACRO, sc->NIL, sc->NIL);
+ new_frame(sc, sc->envir, sc->envir);
+ if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
+ goto BEGIN1;
+
+ case T_CLOSURE_STAR:
+ check_stack_size(sc);
+ sc->envir = new_frame_in_env(sc, closure_let(sc->code));
+ if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
+ goto BEGIN1;
+
+ default:
+ return(apply_error(sc, sc->code, sc->args));
+ }
+
+
+ case OP_APPLY: /* apply 'code' to 'args' */
+ if (needs_copied_args(sc->code))
+ sc->args = copy_list(sc, sc->args);
+ goto APPLY;
+ /* (let ((lst '((1 2)))) (define (identity x) x) (cons (apply identity lst) lst)) */
+
+
+ case OP_LAMBDA_STAR_DEFAULT:
+ /* sc->args is the current closure arg list position, sc->value is the default expression's value */
+ slot_set_value(sc->args, sc->value);
+ sc->args = slot_pending_value(sc->args);
+ if (lambda_star_default(sc) == goto_EVAL) goto EVAL;
+ pop_stack_no_op(sc);
+ sc->code = closure_body(sc->code);
+ goto BEGIN1;
+
+
+ case OP_MACROEXPAND_1:
+ sc->args = cdar(sc->code);
+ sc->code = sc->value;
+ goto MACROEXPAND;
+
+ case OP_MACROEXPAND:
+ /* mimic APPLY above, but don't push OP_EVAL_MACRO or OP_EXPANSION
+ * (define-macro (mac a) `(+ ,a 1)) (macroexpand (mac 3)), sc->code: ((mac 3))
+ */
+ if ((!is_pair(sc->code)) ||
+ (!is_pair(car(sc->code))))
+ eval_error(sc, "macroexpand argument is not a macro call: ~A", sc->code);
+ if (!is_null(cdr(sc->code)))
+ eval_error(sc, "macroexpand: too many arguments: ~A", sc->code);
+
+ if (is_pair(caar(sc->code))) /* (macroexpand ((symbol->value 'mac) (+ 1 2))) */
+ {
+ push_stack(sc, OP_MACROEXPAND_1, sc->NIL, sc->code);
+ sc->code = caar(sc->code);
+ goto EVAL;
+ }
+
+ sc->args = cdar(sc->code);
+ if (!is_symbol(caar(sc->code)))
+ eval_error(sc, "macroexpand argument is not a macro call: ~A", sc->code);
+ sc->code = find_symbol_checked(sc, caar(sc->code));
+
+ MACROEXPAND:
+ switch (type(sc->code))
+ {
+ case T_MACRO:
+ new_frame(sc, closure_let(sc->code), sc->envir);
+ apply_lambda(sc);
+ goto BEGIN1;
+
+ case T_BACRO:
+ new_frame(sc, sc->envir, sc->envir);
+ apply_lambda(sc);
+ goto BEGIN1;
+
+ case T_MACRO_STAR:
+ new_frame(sc, closure_let(sc->code), sc->envir);
+ if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
+ goto BEGIN1;
+
+ case T_BACRO_STAR:
+ new_frame(sc, sc->envir, sc->envir);
+ if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
+ goto BEGIN1;
+
+ case T_C_MACRO:
+ sc->value = c_macro_call(sc->code)(sc, sc->args);
+ goto START;
+ }
+ eval_error(sc, "macroexpand argument is not a macro call: ~A", sc->args);
+
+
+ case OP_QUOTE:
+ case OP_QUOTE_UNCHECKED:
+ /* I think a quoted list in another list can be applied to a function, come here and
+ * be changed to unchecked, set-cdr! or something clobbers the argument so we get
+ * here on the next time around with the equivalent of (quote . 0) so unchecked
+ * quote needs more thought.
+ */
+ check_quote(sc);
+ sc->value = car(sc->code);
+ break;
+
+
+ case OP_DEFINE_FUNCHECKED:
+ define_funchecked(sc);
+ break;
+
+ case OP_DEFINE_CONSTANT1:
+ sc->code = car(sc->code);
+ if (is_pair(sc->code)) sc->code = car(sc->code); /* (define-constant (ex3 a)...) */
+ if (is_symbol(sc->code))
+ set_immutable(sc->code);
+ break;
+
+ case OP_DEFINE_CONSTANT:
+ if ((!is_pair(sc->code)) || (!is_pair(cdr(sc->code)))) /* (define-constant) */
+ eval_error(sc, "define-constant: not enough arguments: ~S", sc->code);
+
+ if ((is_symbol(car(sc->code))) && /* (define-constant abs abs): "abs will not be touched" */
+ (car(sc->code) == cadr(sc->code)) &&
+ (symbol_id(car(sc->code)) == 0) && /* else (let iter ... (define-constant iter iter) ...) -> segfault on later calls */
+ (is_null(cddr(sc->code))))
+ {
+ set_immutable(car(sc->code));
+ sc->value = find_symbol_checked(sc, car(sc->code));
+ goto START;
+ }
+ push_stack(sc, OP_DEFINE_CONSTANT1, sc->NIL, sc->code);
+
+ case OP_DEFINE_STAR:
+ case OP_DEFINE:
+ check_define(sc);
+
+ case OP_DEFINE_CONSTANT_UNCHECKED:
+ case OP_DEFINE_STAR_UNCHECKED:
+ case OP_DEFINE_UNCHECKED:
+ if (define_unchecked_ex(sc) == goto_EVAL) goto EVAL;
+
+ case OP_DEFINE1:
+ if (define1_ex(sc) == goto_APPLY) goto APPLY;
+
+ case OP_DEFINE_WITH_ACCESSOR:
+ define2_ex(sc);
+ break;
+
+
+ /* -------------------------------- SET! -------------------------------- */
+
+ case OP_SET_PAIR_P:
+ /* ([set!] (car a) (cadr a)) */
+ /* here the pair can't generate multiple values, or if it does, it's an error (caught below)
+ * splice_in_values will notice the OP_SET_PAIR_P_1 and complain.
+ * (let () (define (hi) (let ((str "123")) (set! (str 0) (values #\a)) str)) (hi) (hi)) is "a23"
+ * (let () (define (hi) (let ((str "123")) (set! (str 0) (values #\a #\b)) str)) (hi) (hi)) is an error from the first call (caught elsewhere)
+ * (let () (define (hi) (let ((str "123")) (set! (str 0) (values #\a #\b)) str)) (catch #t hi (lambda a a)) (hi)) is an error from the second call
+ */
+ push_stack_no_args(sc, OP_SET_PAIR_P_1, sc->code);
+ sc->code = cadr(sc->code);
+ goto EVAL;
+
+
+ case OP_SET_PAIR_Z:
+ push_stack_no_args(sc, OP_SET_PAIR_P_1, sc->code);
+ sc->code = cadr(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_SET_PAIR_A:
+ {
+ s7_pointer obj, val;
+ obj = find_symbol_checked(sc, caar(sc->code));
+ val = c_call(cdr(sc->code))(sc, cadr(sc->code)); /* this call can step on sc->Tx_x */
+ car(sc->T2_1) = cadar(sc->code); /* might be a constant: (set! (mus-sound-srate "oboe.snd") 12345) */
+ if (is_symbol(car(sc->T2_1)))
+ car(sc->T2_1) = find_symbol_checked(sc, cadar(sc->code));
+ car(sc->T2_2) = val;
+ sc->value = c_function_call(c_function_setter(obj))(sc, sc->T2_1);
+ }
+ break;
+
+ case OP_SET_PAIR_C_P: /* ([set!] (name (+ i 1)) (if (eq? (car a) 'car) #\a #\d)) */
+ push_stack_no_args(sc, OP_SET_PAIR_C_P_1, sc->code);
+ sc->code = cadr(sc->code);
+ goto EVAL;
+
+
+ case OP_SET_PAIR_C_P_1: /* code: ((name (+ i 1)) ...) for example, so cadar is the c_c expr and its args are cdr(cadar) */
+ sc->temp8 = sc->value;
+ if (set_pair_p_3(sc, find_symbol(sc, caar(sc->code)), c_call(cadar(sc->code))(sc, cdadar(sc->code)), sc->temp8))
+ goto APPLY;
+ break;
+
+
+ case OP_SET_PAIR_C: /* ([set!] (name (+ len 1)) #\r) */
+ {
+ s7_pointer value;
+ value = cadr(sc->code);
+ if (is_symbol(value))
+ value = find_symbol_checked(sc, value);
+ if (set_pair_p_3(sc, find_symbol(sc, caar(sc->code)), c_call(cadar(sc->code))(sc, cdadar(sc->code)), value))
+ goto APPLY;
+ }
+ break;
+
+
+ case OP_SET_LET_S: /* (set! (*s7* 'print-length) i) */
+ if (set_pair_p_3(sc, find_symbol(sc, caar(sc->code)), cadr(cadar(sc->code)), find_symbol_checked(sc, cadr(sc->code))))
+ goto APPLY;
+ break;
+
+
+ case OP_SET_LET_ALL_X: /* (set! (hook 'result) 123) or (set! (H 'c) 32) */
+ if (set_pair_p_3(sc, find_symbol(sc, caar(sc->code)), cadr(cadar(sc->code)), c_call(cdr(sc->code))(sc, cadr(sc->code))))
+ goto APPLY;
+ break;
+
+
+ case OP_SET_PAIR_ZA: /* unknown setter pair, but value is easy */
+ sc->value = c_call(cdr(sc->code))(sc, cadr(sc->code));
+ /* fall through */
+
+ case OP_SET_PAIR_P_1:
+ {
+ /* car(sc->code) is a pair, caar(code) is the object with a setter, it has one (safe) argument, and one safe value to set
+ * (set! (str i) #\a) in a function (both inner things need to be symbols (or the second can be a quoted symbol) to get here)
+ * the inner list is a proper list, with no embedded list at car.
+ */
+ s7_pointer arg, value;
+ value = sc->value;
+ arg = cadar(sc->code);
+ if (is_symbol(arg))
+ arg = find_symbol_checked(sc, arg);
+ else
+ {
+ if (is_pair(arg))
+ arg = cadr(arg); /* can only be (quote ...) in this case */
+ }
+ if (set_pair_p_3(sc, find_symbol(sc, caar(sc->code)), arg, value))
+ goto APPLY;
+ }
+ break;
+
+
+ case OP_SET_PAIR:
+ {
+ /* ([set!] (procedure-setter g) s) or ([set!] (str 0) #\a) */
+ s7_pointer obj, arg, value;
+ value = cadr(sc->code);
+ if (is_symbol(value))
+ value = find_symbol_checked(sc, value);
+
+ arg = cadar(sc->code);
+ if (is_symbol(arg))
+ arg = find_symbol_checked(sc, arg);
+ else
+ {
+ if (is_pair(arg))
+ arg = cadr(arg); /* can only be (quote ...) in this case */
+ }
+ obj = caar(sc->code);
+ if (is_symbol(obj))
+ obj = find_symbol(sc, obj);
+ if (set_pair_p_3(sc, obj, arg, value))
+ goto APPLY;
+ }
+ break;
+
+
+ /* this is (set! (getter) val) where getter is a global c_function (a built-in pws) and val is not a pair */
+ case OP_SET_PWS: /* (set! (mus-clipping) #f) */
+ set_pws_ex(sc);
+ break;
+
+ case OP_INCREMENT_1:
+ increment_1_ex(sc);
+ break;
+
+ case OP_DECREMENT_1:
+ decrement_1_ex(sc);
+ break;
+
+ #define SET_CASE(Op, Code) \
+ case Op: \
+ { \
+ s7_pointer lx; \
+ lx = find_symbol(sc, _TSet(car(sc->code))); \
+ if (!is_slot(lx)) eval_type_error(sc, "set! ~A: unbound variable", sc->code); \
+ Code; \
+ sc->value = slot_value(lx); \
+ goto START; \
+ }
+
+ SET_CASE(OP_SET_SYMBOL_C, slot_set_value(lx, cadr(sc->code)))
+
+ SET_CASE(OP_SET_SYMBOL_Q, slot_set_value(lx, cadr(cadr(sc->code))))
+
+ SET_CASE(OP_SET_SYMBOL_A, slot_set_value(lx, c_call(cdr(sc->code))(sc, cadr(sc->code))))
+
+ SET_CASE(OP_SET_SYMBOL_S, slot_set_value(lx, find_symbol_checked(sc, cadr(sc->code))))
+
+ SET_CASE(OP_SET_CONS, slot_set_value(lx, cons(sc, find_symbol_checked(sc, opt_sym2(sc->code)), slot_value(lx)))) /* ([set!] bindings (cons v bindings)) */
+
+ SET_CASE(OP_SET_SYMBOL_opCq, slot_set_value(lx, c_call(cadr(sc->code))(sc, opt_pair2(sc->code))))
+
+ /* here we know the symbols do not have accessors, at least at optimization time */
+ SET_CASE(OP_SET_SYMBOL_opSq,
+ do { \
+ car(sc->T1_1) = find_symbol_checked(sc, opt_sym2(sc->code)); \
+ slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->T1_1)); \
+ } while (0))
+
+ SET_CASE(OP_SET_SYMBOL_opSSq,
+ do { \
+ car(sc->T2_1) = find_symbol_checked(sc, car(opt_pair2(sc->code))); \
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(opt_pair2(sc->code))); \
+ slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->T2_1)); \
+ } while (0))
+
+ SET_CASE(OP_SET_SYMBOL_opSSSq,
+ do { \
+ car(sc->T3_1) = find_symbol_checked(sc, car(opt_pair2(sc->code))); \
+ car(sc->T3_2) = find_symbol_checked(sc, opt_sym1(opt_pair2(sc->code))); \
+ car(sc->T3_3) = find_symbol_checked(sc, opt_sym2(opt_pair2(sc->code))); \
+ slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->T3_1)); \
+ } while (0))
+
+ SET_CASE(OP_INCREMENT_SS, /* ([set!] x (+ x i)) */
+ do { \
+ car(sc->T2_1) = slot_value(lx); \
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(opt_pair2(sc->code))); \
+ slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->T2_1)); \
+ } while (0))
+
+ SET_CASE(OP_INCREMENT_SSS, /* ([set!] x (+ x y z)) -- nearly always involves reals */
+ do { \
+ s7_pointer x1; s7_pointer x2; s7_pointer x3; \
+ x1 = slot_value(lx); \
+ x2 = find_symbol_checked(sc, opt_sym1(opt_pair2(sc->code))); \
+ x3 = find_symbol_checked(sc, opt_sym2(opt_pair2(sc->code))); \
+ if ((is_t_real(x1)) && (is_t_real(x2)) && (is_t_real(x3))) \
+ slot_set_value(lx, make_real(sc, real(x1) + real(x2) + real(x3))); \
+ else { \
+ car(sc->T3_1) = x1; car(sc->T3_2) = x2; car(sc->T3_3) = x3; \
+ slot_set_value(lx, global_add(sc, sc->T3_1)); \
+ } \
+ } while (0))
+
+ SET_CASE(OP_INCREMENT_SA,
+ do { \
+ s7_pointer arg; \
+ arg = opt_pair2(sc->code); \
+ car(sc->T2_2) = c_call(arg)(sc, car(arg)); \
+ car(sc->T2_1) = slot_value(lx); \
+ slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->T2_1)); \
+ } while (0))
+
+ SET_CASE(OP_INCREMENT_SAA, /* (set! sum (+ sum (expt k i) (expt (- k) i))) -- oops */
+ do { \
+ s7_pointer arg; \
+ arg = opt_pair2(sc->code); /* cddr(value) */ \
+ car(sc->A3_3) = c_call(cdr(arg))(sc, cadr(arg)); \
+ car(sc->A3_2) = c_call(arg)(sc, car(arg)); \
+ car(sc->A3_1) = slot_value(lx); \
+ slot_set_value(lx, c_call(cadr(sc->code))(sc, sc->A3_1)); \
+ } while (0))
+
+
+ case OP_SET_SAFE:
+ {
+ s7_pointer lx;
+ lx = find_symbol(sc, _TSet(sc->code)); /* SET_CASE above looks for car(sc->code) */
+ if (!is_slot(lx)) eval_type_error(sc, "set! ~A: unbound variable", sc->code);
+ slot_set_value(lx, sc->value);
+ sc->value = slot_value(lx);
+ }
+ break;
+
+ case OP_SET_SYMBOL_P: /* ([set!] f (lambda () 1)) */
+ push_stack_no_args(sc, OP_SET_SAFE, car(sc->code));
+ sc->code = cadr(sc->code);
+ goto EVAL;
+
+
+ case OP_SET_SYMBOL_Z:
+ /* ([set!] sum (+ sum n)) */
+ push_stack_no_args(sc, OP_SET_SAFE, car(sc->code));
+ sc->code = cadr(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_INCREMENT_SZ:
+ {
+ s7_pointer sym;
+ sym = find_symbol(sc, car(sc->code));
+ if (is_slot(sym))
+ {
+ push_stack(sc, OP_INCREMENT_SZ_1, sym, sc->code);
+ sc->code = opt_pair2(sc->code); /* caddr(cadr(sc->code)); */
+ goto OPT_EVAL;
+ }
+ eval_type_error(sc, "set! ~A: unbound variable", sc->code);
+ }
+
+ case OP_INCREMENT_SZ_1:
+ car(sc->T2_1) = slot_value(sc->args);
+ car(sc->T2_2) = sc->value;
+ sc->value = c_call(cadr(sc->code))(sc, sc->T2_1);
+ slot_set_value(sc->args, sc->value);
+ break;
+
+
+ case OP_SET2:
+ if (is_pair(sc->value))
+ {
+ /* (let ((L '((1 2 3)))) (set! ((L 0) 1) 32) L)
+ * (let ((L '(((1 2 3))))) (set! ((L 0) 0 1) 32) L)
+ * any deeper nesting was handled already by the first eval
+ * set! looks at its first argument, if it's a symbol, it sets the associated value,
+ * if it's a list, it looks at the car of that list to decide which setter to call,
+ * if it's a list of lists, it passes the embedded lists to eval, then looks at the
+ * car of the result. This means that we can do crazy things like:
+ * (let ((x '(1)) (y '(2))) (set! ((if #t x y) 0) 32) x)
+ *
+ * the other args need to be evaluated (but not the list as if it were code):
+ * (let ((L '((1 2 3))) (index 1)) (set! ((L 0) index) 32) L)
+ */
+
+ if (!is_proper_list(sc, sc->args)) /* (set! ('(1 2) 1 . 2) 1) */
+ eval_error(sc, "set! target arguments are an improper list: ~A", sc->args);
+
+ /* in all of these cases, we might need to GC protect the temporary lists */
+
+ if (is_multiple_value(sc->value))
+ sc->code = cons(sc, sc->SET, s7_append(sc, multiple_value(sc->value), s7_append(sc, sc->args, sc->code))); /* drop into OP_SET */
+ else
+ {
+ if (sc->args != sc->NIL)
+ {
+ push_op_stack(sc, sc->List_Set);
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, sc->value), s7_append(sc, cdr(sc->args), sc->code));
+ sc->code = car(sc->args);
+ }
+ else eval_error(sc, "list set!: not enough arguments: ~S", sc->code);
+ goto EVAL;
+ }
+ }
+ else
+ {
+ if (s7_is_vector(sc->value))
+ {
+ /* (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1) 0) 32) L)
+ * bad case when args is nil: (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1)) 32) L)
+ */
+ if (sc->args != sc->NIL)
+ {
+ push_op_stack(sc, sc->Vector_Set);
+ push_stack(sc, OP_EVAL_ARGS1, list_1(sc, sc->value), s7_append(sc, cdr(sc->args), sc->code));
+ sc->code = car(sc->args);
+ }
+ else eval_error(sc, "vector set!: not enough arguments: ~S", sc->code);
+ goto EVAL;
+ }
+ sc->code = cons_unchecked(sc, cons(sc, sc->value, sc->args), sc->code);
+ }
+ /* fall through */
+
+
+ case OP_SET: /* entry for set! */
+ check_set(sc);
+
+ case OP_SET_UNCHECKED:
+ if (is_pair(car(sc->code))) /* has accessor */
+ {
+ int choice;
+ choice = set_pair_ex(sc);
+ if (choice == goto_EVAL) goto EVAL;
+ if (choice == goto_START) goto START;
+ if (choice == goto_APPLY) goto APPLY;
+ goto EVAL_ARGS;
+ }
+ /* fall through */
+
+ case OP_SET_NORMAL:
+ {
+ s7_pointer x;
+ x = cadr(sc->code);
+ if (is_pair(x))
+ {
+ push_stack_no_args(sc, OP_SET1, car(sc->code));
+ sc->code = x;
+ goto EVAL;
+ }
+
+ if (is_symbol(x))
+ sc->value = find_symbol_checked(sc, x);
+ else sc->value = _NFre(x);
+ sc->code = car(sc->code);
+ }
+
+
+ case OP_SET1:
+ {
+ s7_pointer lx;
+ /* if unbound variable hook here, we need the binding, not the current value */
+ lx = find_symbol(sc, _TSet(sc->code));
+ if (is_slot(lx))
+ {
+ if (slot_has_accessor(lx))
+ {
+ s7_pointer func;
+ func = slot_accessor(lx);
+ if (is_procedure_or_macro(func))
+ {
+ if (is_c_function(func))
+ {
+ car(sc->T2_1) = sc->code;
+ car(sc->T2_2) = sc->value;
+ sc->value = c_function_call(func)(sc, sc->T2_1);
+ if (sc->value == sc->ERROR) /* backwards compatibility... */
+ return(s7_error(sc, sc->ERROR, set_elist_3(sc, make_string_wrapper(sc, "can't set ~S to ~S"), car(sc->T2_1), car(sc->T2_2))));
+ }
+ else
+ {
+ sc->args = list_2(sc, sc->code, sc->value);
+ push_stack(sc, OP_SET_WITH_ACCESSOR, sc->args, lx); /* op, args, code */
+ sc->code = func;
+ goto APPLY;
+ }
+ }
+ }
+ else
+ {
+ if (is_syntax(slot_value(lx)))
+ eval_error(sc, "can't set! ~A", sc->code);
+ }
+ slot_set_value(lx, sc->value);
+ goto START;
+ }
+ eval_type_error(sc, "set! ~A: unbound variable", sc->code);
+ }
+
+ case OP_SET_WITH_ACCESSOR:
+ if (sc->value == sc->ERROR) /* backwards compatibility... */
+ return(s7_error(sc, sc->ERROR, set_elist_2(sc, make_string_wrapper(sc, "can't set ~S"), sc->args)));
+ slot_set_value(sc->code, sc->value);
+ break;
+
+
+ /* -------------------------------- IF -------------------------------- */
+ case OP_IF:
+ check_if(sc);
+
+ case OP_IF_UNCHECKED:
+ push_stack_no_args(sc, OP_IF1, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+
+ case OP_IF1:
+ if (is_true(sc, sc->value))
+ sc->code = car(sc->code);
+ else sc->code = cadr(sc->code); /* even pre-optimization, (if #f #f) ==> #<unspecified> because car(sc->NIL) = sc->UNSPECIFIED */
+ if (is_pair(sc->code))
+ goto EVAL;
+ if (is_symbol(sc->code))
+ sc->value = find_symbol_checked(sc, sc->code);
+ else sc->value = sc->code;
+ break;
+
+
+ #define IF_CASE(Op, Code) \
+ case Op ## _P: Code {sc->code = cadr(sc->code); goto EVAL;} else {sc->value = sc->UNSPECIFIED; goto START;} \
+ case Op ## _P_P: Code {sc->code = cadr(sc->code); goto EVAL;} else {sc->code = caddr(sc->code); goto EVAL;}
+
+ IF_CASE(OP_IF_S, if (is_true(sc, find_symbol_checked(sc, car(sc->code)))))
+
+ IF_CASE(OP_IF_NOT_S, if (is_false(sc, find_symbol_checked(sc, opt_sym2(sc->code)))))
+
+ IF_CASE(OP_IF_A, if (is_true(sc, c_call(sc->code)(sc, car(sc->code)))))
+
+ IF_CASE(OP_IF_CC, if (is_true(sc, c_call(car(sc->code))(sc, opt_pair2(sc->code)))))
+
+ IF_CASE(OP_IF_IS_PAIR, if (is_pair(find_symbol_checked(sc, opt_sym2(sc->code)))))
+
+ IF_CASE(OP_IF_IS_SYMBOL, if (is_symbol(find_symbol_checked(sc, opt_sym2(sc->code)))))
+
+ IF_CASE(OP_IF_CS, car(sc->T1_1) = find_symbol_checked(sc, opt_sym2(sc->code)); \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->T1_1))))
+
+ IF_CASE(OP_IF_CSQ, car(sc->T2_1) = find_symbol_checked(sc, opt_sym3(sc->code)); \
+ car(sc->T2_2) = opt_con2(sc->code); \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->T2_1))))
+
+ IF_CASE(OP_IF_CSS, car(sc->T2_1) = find_symbol_checked(sc, opt_sym3(sc->code)); \
+ car(sc->T2_2) = find_symbol_checked(sc, opt_sym2(sc->code));
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->T2_1))))
+
+ IF_CASE(OP_IF_CSC, car(sc->T2_1) = find_symbol_checked(sc, opt_sym3(sc->code)); \
+ car(sc->T2_2) = opt_con2(sc->code); \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->T2_1))))
+
+ IF_CASE(OP_IF_S_opCq, car(sc->T2_2) = c_call(opt_pair2(sc->code))(sc, cdr(opt_pair2(sc->code))); \
+ car(sc->T2_1) = find_symbol_checked(sc, opt_sym3(sc->code)); \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->T2_1))))
+
+ IF_CASE(OP_IF_opSSq, {s7_pointer args; s7_pointer val1; \
+ args = opt_pair2(sc->code); \
+ val1 = find_symbol_checked(sc, cadr(args)); \
+ car(sc->T2_2) = find_symbol_checked(sc, opt_sym3(sc->code)); \
+ car(sc->T2_1) = val1; \
+ car(sc->T1_1) = c_call(args)(sc, sc->T2_1);} \
+ if (is_true(sc, c_call(car(sc->code))(sc, sc->T1_1))))
+
+ IF_CASE(OP_IF_AND2, if ((is_true(sc, c_call(opt_pair2(sc->code))(sc, car(opt_pair2(sc->code))))) && \
+ (is_true(sc, c_call(opt_and_2_test(sc->code))(sc, car(opt_and_2_test(sc->code)))))))
+
+
+ case OP_IF_P_P:
+ push_stack_no_args(sc, OP_IF_PP, cadr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+
+ case OP_IF_P_P_P:
+ push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+
+
+ case OP_IF_Z_P:
+ push_stack_no_args(sc, OP_IF_PP, opt_con2(sc->code));
+ sc->code = car(sc->code);
+ goto OPT_EVAL;
+
+ case OP_IF_Z_P_P:
+ push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto OPT_EVAL;
+
+
+ case OP_IF_ANDP_P:
+ push_stack_no_args(sc, OP_IF_PP, cadr(sc->code));
+ sc->code = cdar(sc->code);
+ goto AND_P;
+
+ case OP_IF_ANDP_P_P:
+ push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code));
+ sc->code = cdar(sc->code);
+ goto AND_P;
+
+
+ case OP_IF_ORP_P:
+ push_stack_no_args(sc, OP_IF_PP, cadr(sc->code));
+ sc->code = cdar(sc->code);
+ goto OR_P;
+
+ case OP_IF_ORP_P_P:
+ push_stack_no_args(sc, OP_IF_PPP, cdr(sc->code));
+ sc->code = cdar(sc->code);
+ goto OR_P;
+
+
+ case OP_IF_PPP:
+ if (is_true(sc, sc->value))
+ sc->code = car(sc->code);
+ else sc->code = cadr(sc->code);
+ goto EVAL;
+
+
+ case OP_IF_PP:
+ if (is_true(sc, sc->value))
+ goto EVAL;
+ sc->value = sc->UNSPECIFIED;
+ break;
+
+
+ case OP_IF_P_FEED:
+ /* actually cond right now: (cond (expr => p)) where p is (lambda (s) ...) -- see check_cond */
+ push_stack_no_args(sc, OP_IF_P_FEED_1, sc->code);
+ sc->code = caar(sc->code);
+ goto EVAL;
+
+ case OP_IF_P_FEED_1:
+ if (is_true(sc, sc->value))
+ {
+ if (is_multiple_value(sc->value))
+ sc->code = cons(sc, opt_lambda2(sc->code), multiple_value(sc->value));
+ else
+ {
+ new_frame_with_slot(sc, sc->envir, sc->envir, caadr(opt_lambda2(sc->code)), sc->value);
+ sc->code = caddr(opt_lambda2(sc->code));
+ }
+ goto EVAL;
+ }
+ sc->value = sc->NIL; /* since it's actually cond -- perhaps push as sc->args above */
+ break;
+
+
+ case OP_WHEN:
+ check_when(sc);
+
+ case OP_WHEN_UNCHECKED:
+ push_stack_no_args(sc, OP_WHEN1, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+
+ case OP_WHEN1:
+ if (is_true(sc, sc->value)) goto BEGIN1;
+ sc->value = sc->UNSPECIFIED;
+ break;
+
+ case OP_WHEN_S:
+ if (is_true(sc, find_symbol_checked(sc, car(sc->code))))
+ {
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+ sc->value = sc->UNSPECIFIED;
+ break;
+
+
+ case OP_UNLESS:
+ check_unless(sc);
+
+ case OP_UNLESS_UNCHECKED:
+ push_stack_no_args(sc, OP_UNLESS1, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+
+ case OP_UNLESS1:
+ if (is_false(sc, sc->value)) goto BEGIN1;
+ sc->value = sc->UNSPECIFIED;
+ break;
+
+ case OP_UNLESS_S:
+ if (is_false(sc, find_symbol_checked(sc, car(sc->code))))
+ {
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+ sc->value = sc->UNSPECIFIED;
+ break;
+
+
+ case OP_SAFE_C_P_1:
+ car(sc->T1_1) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T1_1);
+ break;
+
+
+ case OP_SAFE_C_PP_1:
+ /* unless multiple values from last call (first arg), sc->args == sc->NIL because we pushed that.
+ * we get here only from OP_SAFE_C_PP.
+ *
+ * currently splice_in_values changes the operator so if we get here, sc->value is the result of the first arg
+ *
+ * safe_c_pp -> 1, but if mv, -> 3
+ * 1: -> 2, if mv -> 4
+ * 2: done (both normal)
+ * 3: -> 5, but if mv, -> 6
+ * 4: done (1 normal, 2 mv)
+ * 5: done (1 mv, 2 normal)
+ * 6: done (both mv)
+ *
+ * I think safe_c_ppp would require 18 branches (or maybe just collect the args and concatenate at the end?)
+ */
+ push_stack(sc, OP_SAFE_C_PP_2, sc->value, sc->code); /* mv -> 3 */
+ sc->code = caddr(sc->code);
+ if (is_optimized(sc->code))
+ goto OPT_EVAL;
+ goto EVAL;
+
+ case OP_SAFE_C_PP_2:
+ /* we get here only if neither arg returned multiple values, so sc->args is the first value, and sc->value the second */
+ car(sc->T2_1) = sc->args;
+ car(sc->T2_2) = sc->value;
+ sc->value = c_call(sc->code)(sc, sc->T2_1);
+ break;
+
+ case OP_SAFE_C_PP_3:
+ /* we get here if the first arg returned multiple values */
+ push_stack(sc, OP_SAFE_C_PP_5, sc->value, sc->code);
+ sc->code = caddr(sc->code);
+ if (is_optimized(sc->code))
+ goto OPT_EVAL;
+ goto EVAL;
+
+ case OP_SAFE_C_PP_4:
+ /* we get here if the first arg result was normal, but the second had multiple values */
+ sc->args = cons(sc, sc->args, sc->value);
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY;
+
+ case OP_SAFE_C_PP_5:
+ /* 1 mv, 2, normal */
+ sc->args = s7_append(sc, sc->args, list_1(sc, sc->value));
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY;
+
+ case OP_SAFE_C_PP_6:
+ /* both mv */
+ sc->args = s7_append(sc, sc->args, sc->value);
+ /*
+ * c_call(sc->code) here is g_add_2, but we have any number of args from a values call
+ * the original (unoptimized) function is (hopefully) c_function_base(opt_cfunc(sc->code))?
+ * (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (ho 2))) (hi)) -> 7
+ * (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (values 3 4))) (hi)) -> 10
+ * (let () (define (ho a) (+ a 2)) (define (hi) (+ (values 3 4) (ho 1))) (hi)) -> 10
+ * (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) -> 10
+ */
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY;
+
+
+ case OP_C_P_1:
+ sc->value = c_call(sc->code)(sc, list_1(sc, sc->value));
+ break;
+
+ case OP_C_P_2:
+ /* op_c_p_1 -> mv case: (define (hi) (format (values #f "~A ~D" 1 2))) */
+ sc->code = c_function_base(opt_cfunc(sc->code)); /* see comment above */
+ sc->args = copy_list(sc, sc->value);
+ goto APPLY;
+
+
+ case OP_SAFE_CLOSURE_P_1:
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(sc->code)), sc->value);
+ sc->code = closure_body(opt_lambda(sc->code));
+ goto BEGIN1;
+
+ case OP_CLOSURE_P_1:
+ /* sc->value is presumably the argument value */
+ check_stack_size(sc);
+ sc->code = opt_lambda(sc->code);
+ new_frame_with_slot(sc, closure_let(sc->code), sc->envir, car(closure_args(sc->code)), sc->value);
+ sc->code = closure_body(sc->code);
+ goto BEGIN1;
+
+ case OP_CLOSURE_P_2:
+ /* here we got multiple values */
+ sc->code = opt_lambda(sc->code);
+ sc->args = copy_list(sc, sc->value);
+ goto APPLY;
+
+
+ case OP_C_SP_1:
+ sc->value = c_call(sc->code)(sc, list_2(sc, sc->args, sc->value));
+ break;
+
+ case OP_C_SP_2:
+ /* op_c_sp_1 -> mv case: (map + (values '(1 2 3) #(1 2 3))) */
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ sc->args = cons(sc, sc->args, copy_list(sc, sc->value));
+ goto APPLY;
+
+
+ /* -------------------------------- LET -------------------------------- */
+
+ case OP_LET_NO_VARS:
+ new_frame(sc, sc->envir, sc->envir);
+ sc->code = cdr(sc->code); /* ignore the () */
+ goto BEGIN1;
+
+
+ case OP_NAMED_LET_NO_VARS:
+ new_frame(sc, sc->envir, sc->envir);
+ sc->args = make_closure(sc, sc->NIL, cddr(sc->code), T_CLOSURE); /* sc->args is a temp here */
+ make_slot_1(sc, sc->envir, car(sc->code), sc->args);
+ sc->code = cddr(sc->code);
+ goto BEGIN1;
+
+
+ case OP_LET_C:
+ /* one var, init is constant, incoming sc->code is '(((var val))...)! */
+ new_frame_with_slot(sc, sc->envir, sc->envir, opt_sym3(sc->code), opt_con2(sc->code));
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+
+ case OP_LET_S:
+ /* one var, init is symbol, incoming sc->code is '(((var sym))...) */
+ sc->value = find_symbol_checked(sc, opt_sym2(sc->code));
+ new_frame_with_slot(sc, sc->envir, sc->envir, opt_sym3(sc->code), sc->value);
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+
+
+ case OP_LET_opSq:
+ {
+ s7_pointer binding;
+ binding = caar(sc->code);
+ car(sc->T1_1) = find_symbol_checked(sc, opt_sym2(sc->code));
+ sc->value = c_call(cadr(binding))(sc, sc->T1_1);
+ new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value);
+ push_stack_no_args(sc, OP_BEGIN1, cddr(sc->code));
+ sc->code = cadr(sc->code);
+ goto EVAL;
+ }
+
+
+ case OP_LET_opSq_P:
+ {
+ s7_pointer binding;
+ binding = caar(sc->code);
+ car(sc->T1_1) = find_symbol_checked(sc, opt_sym2(sc->code));
+ sc->value = c_call(cadr(binding))(sc, sc->T1_1);
+ new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value);
+ sc->code = cadr(sc->code);
+ goto EVAL;
+ }
+
+
+ case OP_LET_opCq: /* one var, init is safe_c_c */
+ sc->value = c_call(opt_pair2(sc->code))(sc, cdr(opt_pair2(sc->code)));
+ new_frame_with_slot(sc, sc->envir, sc->envir, opt_sym3(sc->code), sc->value);
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+
+
+ case OP_LET_opSSq: /* one var, init is safe_c_ss */
+ {
+ s7_pointer largs, in_val;
+ largs = opt_pair2(sc->code); /* cadr(caar(sc->code)); */
+ in_val = find_symbol_checked(sc, cadr(largs));
+ car(sc->T2_2) = find_symbol_checked(sc, opt_sym3(sc->code)); /* caddr(largs)); */
+ car(sc->T2_1) = in_val;
+ sc->value = c_call(largs)(sc, sc->T2_1);
+ new_frame_with_slot(sc, sc->envir, sc->envir, caaar(sc->code), sc->value);
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+
+
+ case OP_LET_Z:
+ push_stack(sc, OP_LET_Z_1, opt_sym2(cdr(sc->code)), cadr(sc->code));
+ sc->code = opt_pair2(sc->code);
+ goto OPT_EVAL;
+
+ case OP_LET_Z_1:
+ new_frame_with_slot(sc, sc->envir, sc->envir, sc->args, sc->value);
+ goto EVAL;
+
+
+ case OP_LET_ONE:
+ /* one var */
+ {
+ s7_pointer p;
+ p = caar(sc->code);
+ sc->value = cadr(p);
+ if (is_pair(sc->value))
+ {
+ push_stack(sc, OP_LET_ONE_1, car(p), cdr(sc->code)); /* args code */
+ sc->code = sc->value;
+ goto EVAL;
+ }
+ if (is_symbol(sc->value))
+ sc->value = find_symbol_checked(sc, sc->value);
+ sc->code = cdr(sc->code);
+ sc->args = car(p);
+ /* drop through */
+ }
+
+ case OP_LET_ONE_1:
+ new_frame_with_slot(sc, sc->envir, sc->envir, sc->args, sc->value);
+ goto BEGIN1;
+
+
+ case OP_LET_ALL_C:
+ {
+ s7_pointer p;
+ new_frame(sc, sc->envir, sc->envir);
+ for (p = car(sc->code); is_pair(p); p = cdr(p))
+ add_slot(sc->envir, caar(p), cadar(p));
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+
+
+ case OP_LET_ALL_S:
+ /* n vars, all inits are symbols. We need to GC-protect the new frame-list as it is being
+ * created without tying the new frame into sc->envir until the end.
+ */
+ {
+ s7_pointer p, frame;
+ frame = make_simple_let(sc);
+ sc->args = frame;
+ for (p = car(sc->code); is_pair(p); p = cdr(p))
+ add_slot(frame, caar(p), find_symbol_checked(sc, cadar(p)));
+ sc->let_number++;
+ sc->envir = frame;
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+
+
+ case OP_LET_ALL_opSq:
+ {
+ s7_pointer p, frame;
+ frame = make_simple_let(sc);
+ sc->args = frame;
+ for (p = car(sc->code); is_pair(p); p = cdr(p))
+ {
+ s7_pointer cp;
+ cp = cadar(p);
+ car(sc->T1_1) = find_symbol_checked(sc, cadr(cp));
+ add_slot(frame, caar(p), c_call(cp)(sc, sc->T1_1));
+ }
+ sc->let_number++;
+ sc->envir = frame;
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+
+ /* it is possible to save the frame+slots in a copied symbol+syntax pair, then reuse them
+ * on every call here, but the savings in GC+allocation+setup is less than the cost in
+ * marking the saved stuff past its actual life! (If the code is removed from the heap,
+ * the frame has to be saved on the permanent_objects list).
+ */
+ case OP_LET_ALL_X:
+ {
+ s7_pointer p, frame;
+ frame = make_simple_let(sc);
+ sc->args = frame;
+ for (p = car(sc->code); is_pair(p); p = cdr(p))
+ {
+ s7_pointer arg;
+ arg = cdar(p);
+ arg = c_call(arg)(sc, car(arg));
+ add_slot(frame, caar(p), arg);
+ }
+ sc->let_number++;
+ sc->envir = frame;
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+
+
+ case OP_NAMED_LET:
+ sc->args = sc->NIL;
+ sc->value = sc->code;
+ sc->code = cadr(sc->code);
+ goto LET1;
+
+
+ case OP_LET_UNCHECKED:
+ /* not named, but has vars */
+ {
+ s7_pointer x;
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->code;
+ cdr(x) = sc->NIL;
+ sc->args = x;
+ sc->code = car(sc->code);
+ goto LET1A;
+ }
+
+
+ case OP_LET:
+ /* sc->code is everything after the let: (let ((a 1)) a) so sc->code is (((a 1)) a) */
+ /* car can be either a list or a symbol ("named let") */
+ {
+ bool named_let;
+ check_let(sc);
+ sc->args = sc->NIL;
+ sc->value = sc->code;
+ named_let = is_symbol(car(sc->code));
+
+ sc->code = (named_let) ? cadr(sc->code) : car(sc->code);
+ if (is_null(sc->code)) /* (let [name] () ...): no bindings, so skip that step */
+ {
+ sc->code = sc->value;
+ new_frame(sc, sc->envir, sc->envir);
+ if (named_let)
+ {
+ sc->x = make_closure(sc, sc->NIL, cddr(sc->code), T_CLOSURE); /* args = () in new closure, see NAMED_LET_NO_VARS above */
+ /* if this is a safe closure, we can build its env in advance and name it (a thunk in this case) */
+ set_function_env(closure_let(sc->x));
+ funclet_set_function(closure_let(sc->x), car(sc->code));
+ make_slot_1(sc, sc->envir, car(sc->code), sc->x);
+ sc->code = cddr(sc->code);
+ sc->x = sc->NIL;
+ }
+ else sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+ }
+
+ LET1:
+ case OP_LET1:
+ {
+ s7_pointer x, y;
+
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->value; /* the first time (now handled above), this saves the entire let body across the evaluations -- we pick it up later */
+ cdr(x) = sc->args;
+ sc->args = x;
+
+ if (is_pair(sc->code))
+ {
+ LET1A:
+ x = cadar(sc->code);
+ if (is_pair(x))
+ {
+ push_stack(sc, OP_LET1, sc->args, cdr(sc->code));
+ sc->code = x;
+ if (is_optimized(x))
+ goto OPT_EVAL;
+ goto EVAL;
+ /* this push_stack/goto can't be optimized away via a local optimize_op case statement
+ * because any c_call can trigger an embedded call on the evaluator (for example,
+ * open-sound involves both hooks, and s7_load if the corresponding .scm code exists),
+ * so we have to protect sc->code and sc->args via the stack. (I subsequently added
+ * some protection here, but debugging this is hard, and the gain is not huge).
+ */
+ }
+ if (is_symbol(x))
+ sc->value = find_symbol_checked(sc, x);
+ else sc->value = _NFre(x);
+ sc->code = cdr(sc->code);
+ goto LET1;
+ }
+
+ x = safe_reverse_in_place(sc, sc->args);
+ sc->code = car(x); /* restore the original form */
+ y = cdr(x); /* use sc->args as the new frame */
+ sc->y = y;
+ sc->envir = old_frame_in_env(sc, x, sc->envir);
+
+ {
+ bool named_let;
+ named_let = is_symbol(car(sc->code));
+ if (named_let)
+ {
+ /* we need to check the current environment for ridiculous cases like
+ * (let hiho ((hiho 4)) hiho) -- I guess hiho is 4
+ */
+ s7_pointer let_name;
+ let_name = car(sc->code);
+ sc->envir = new_frame_in_env(sc, sc->envir);
+
+ sc->w = sc->NIL;
+ for (x = cadr(sc->code); is_pair(x); x = cdr(x))
+ sc->w = cons(sc, caar(x), sc->w);
+
+ sc->x = make_closure(sc, sc->w = safe_reverse_in_place(sc, sc->w), cddr(sc->code), T_CLOSURE);
+ sc->w = sc->NIL;
+ if (is_safe_closure(sc->x))
+ {
+ s7_pointer arg, new_env;
+ new_env = new_frame_in_env(sc, sc->envir);
+ closure_set_let(sc->x, new_env);
+ for (arg = closure_args(sc->x); is_pair(arg); arg = cdr(arg))
+ make_slot_1(sc, new_env, car(arg), sc->NIL);
+ let_set_slots(new_env, reverse_slots(sc, let_slots(new_env)));
+ }
+ make_slot_1(sc, sc->envir, let_name, sc->x);
+ sc->x = sc->NIL;
+
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ for (x = cadr(sc->code); is_not_null(y); x = cdr(x))
+ {
+ s7_pointer sym, args, val;
+ /* reuse the value cells as the new frame slots */
+
+ sym = caar(x);
+ if (sym == let_name) let_name = sc->NIL;
+ val = car(y);
+ args = cdr(y);
+
+ set_type(y, T_SLOT);
+ slot_set_symbol(y, sym);
+ slot_set_value(y, val);
+ next_slot(y) = let_slots(sc->envir);
+ let_set_slots(sc->envir, y);
+ symbol_set_local(sym, let_id(sc->envir), y);
+
+ y = args;
+ }
+ sc->code = cddr(sc->code);
+ }
+ else
+ {
+ s7_pointer e;
+ unsigned long long int id;
+
+ e = sc->envir;
+ id = let_id(e);
+
+ for (x = car(sc->code); is_not_null(y); x = cdr(x))
+ {
+ s7_pointer sym, args, val;
+ /* reuse the value cells as the new frame slots */
+
+ sym = caar(x);
+ val = car(y);
+ args = cdr(y);
+
+ set_type(y, T_SLOT);
+ slot_set_symbol(y, sym);
+ symbol_set_local(sym, id, y);
+ slot_set_value(y, val);
+ next_slot(y) = let_slots(e);
+ let_set_slots(e, y);
+
+ y = args;
+ }
+ sc->code = cdr(sc->code);
+ }
+ }
+ sc->y = sc->NIL;
+ goto BEGIN1;
+ }
+
+
+ /* -------------------------------- LET* -------------------------------- */
+
+ case OP_LET_STAR_ALL_X:
+ {
+ s7_pointer p;
+ for (p = car(sc->code); is_pair(p); p = cdr(p))
+ {
+ s7_pointer arg;
+ arg = cdar(p);
+ arg = c_call(arg)(sc, car(arg));
+ new_frame_with_slot(sc, sc->envir, sc->envir, caar(p), arg);
+ }
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+
+
+ case OP_NAMED_LET_STAR:
+ push_stack(sc, OP_LET_STAR1, sc->code, cadr(sc->code));
+ sc->code = opt_con2(sc->code);
+ goto EVAL;
+
+
+ case OP_LET_STAR2:
+ push_stack(sc, OP_LET_STAR1, sc->code, car(sc->code));
+ sc->code = opt_con2(sc->code);
+ goto EVAL;
+
+
+ case OP_LET_STAR:
+ check_let_star(sc);
+
+ case OP_LET_STAR_UNCHECKED:
+ if (is_symbol(car(sc->code)))
+ {
+ s7_pointer cx;
+ cx = car(sc->code);
+ sc->value = cdr(sc->code);
+ if (is_null(car(sc->value)))
+ {
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ sc->code = cdr(sc->value);
+ make_slot_1(sc, sc->envir, cx, make_closure(sc, sc->NIL, sc->code, T_CLOSURE_STAR));
+ goto BEGIN1;
+ }
+ }
+ else
+ {
+ if (is_null(car(sc->code)))
+ {
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+ }
+
+ if (is_symbol(car(sc->code)))
+ {
+ push_stack(sc, OP_LET_STAR1, sc->code, cadr(sc->code));
+ sc->code = cadr(caadr(sc->code));
+ }
+ else
+ {
+ push_stack(sc, OP_LET_STAR1, sc->code, car(sc->code));
+ /* args is the let body, saved for later, code is the list of vars+initial-values */
+ sc->code = cadr(caar(sc->code));
+ /* caar(code) = first var/val pair, we've checked that all these guys are legit, so cadr of that is the value */
+ }
+ goto EVAL;
+
+
+ case OP_LET_STAR1: /* let* -- calculate parameters */
+ /* we can't skip (or reuse) this new frame -- we have to imitate a nested let, otherwise
+ * (let ((f1 (lambda (arg) (+ arg 1))))
+ * (let* ((x 32)
+ * (f1 (lambda (arg) (f1 (+ x arg)))))
+ * (f1 1)))
+ * will hang. (much later -- this worries me... Could we defer making the slot?)
+ */
+ while (true)
+ {
+ new_frame_with_slot(sc, sc->envir, sc->envir, caar(sc->code), sc->value);
+ sc->code = cdr(sc->code);
+ if (is_pair(sc->code))
+ {
+ s7_pointer x;
+ x = cadar(sc->code);
+ if (is_pair(x))
+ {
+ push_stack(sc, OP_LET_STAR1, sc->args, sc->code);
+ sc->code = x;
+ if (is_optimized(x))
+ goto OPT_EVAL;
+ goto EVAL;
+ }
+ if (is_symbol(x))
+ sc->value = find_symbol_checked(sc, x);
+ else sc->value = _NFre(x);
+ }
+ else break;
+ }
+ sc->code = sc->args; /* original sc->code set in push_stack above */
+ if (is_symbol(car(sc->code)))
+ {
+ /* now we need to declare the new function */
+ make_slot_1(sc, sc->envir, car(sc->code), make_closure(sc, cadr(sc->code), cddr(sc->code), T_CLOSURE_STAR));
+ sc->code = cddr(sc->code);
+ }
+ else sc->code = cdr(sc->code);
+ goto BEGIN1;
+
+
+ /* -------------------------------- LETREC -------------------------------- */
+
+ case OP_LETREC:
+ check_letrec(sc, true);
+
+ case OP_LETREC_UNCHECKED:
+ /* get all local vars and set to #<undefined>
+ * get parallel list of values
+ * eval each member of values list with env still full of #<undefined>'s
+ * assign each value to its variable
+ * eval body
+ *
+ * which means that (letrec ((x x)) x) is not an error!
+ * but this assumes the environment is not changed by evaluating the exprs?
+ * (letrec ((a (define b 1))) b) -- if let, the define takes place in the calling env, not the current env
+ * I think I need to check here that slot_pending_value is set (using the is_checked bit below).
+ */
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ if (is_pair(car(sc->code)))
+ {
+ s7_pointer x;
+ for (x = car(sc->code); is_not_null(x); x = cdr(x))
+ {
+ s7_pointer slot;
+ slot = make_slot_1(sc, sc->envir, caar(x), sc->UNDEFINED);
+ slot_pending_value(slot) = sc->UNDEFINED;
+ slot_expression(slot) = cadar(x);
+ set_checked_slot(slot);
+ }
+ sc->args = let_slots(sc->envir);
+ push_stack(sc, OP_LETREC1, sc->args, sc->code);
+ sc->code = slot_expression(sc->args);
+ goto EVAL;
+ }
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+
+
+ case OP_LETREC1:
+ slot_pending_value(sc->args) = sc->value;
+ sc->args = next_slot(sc->args);
+ if (is_slot(sc->args))
+ {
+ push_stack(sc, OP_LETREC1, sc->args, sc->code);
+ sc->code = slot_expression(sc->args);
+ goto EVAL;
+ }
+ else
+ {
+ s7_pointer slot;
+ for (slot = let_slots(sc->envir); is_slot(slot); slot = next_slot(slot))
+ if (is_checked_slot(slot))
+ slot_set_value(slot, slot_pending_value(slot));
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+
+
+ /* -------------------------------- LETREC* -------------------------------- */
+
+ case OP_LETREC_STAR:
+ check_letrec(sc, false);
+
+ case OP_LETREC_STAR_UNCHECKED:
+ /* get all local vars and set to #<undefined>
+ * eval each member of values list and assign immediately, as in let*
+ * eval body
+ */
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ if (is_pair(car(sc->code)))
+ {
+ s7_pointer x, p, q;
+ for (x = car(sc->code); is_not_null(x); x = cdr(x))
+ {
+ s7_pointer slot;
+ slot = make_slot_1(sc, sc->envir, caar(x), sc->UNDEFINED);
+ slot_expression(slot) = cadar(x);
+ }
+ /* these are reversed, and for letrec*, they need to be in order, so... (reverse_in_place on the slot list) */
+ p = let_slots(sc->envir);
+ x = sc->NIL;
+ while (is_slot(p))
+ {
+ q = next_slot(p);
+ next_slot(p) = x;
+ x = p;
+ p = q;
+ }
+ let_set_slots(sc->envir, x);
+ sc->args = let_slots(sc->envir);
+ push_stack(sc, OP_LETREC_STAR1, sc->args, sc->code);
+ sc->code = slot_expression(sc->args);
+ goto EVAL;
+ }
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+
+
+ case OP_LETREC_STAR1:
+ {
+ s7_pointer slot;
+ slot = sc->args;
+ slot_set_value(slot, sc->value);
+ slot = next_slot(slot);
+ if (is_slot(slot))
+ {
+ push_stack(sc, OP_LETREC_STAR1, slot, sc->code);
+ sc->code = slot_expression(slot);
+ goto EVAL;
+ }
+ else
+ {
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+ }
+
+
+ /* -------------------------------- COND -------------------------------- */
+ case OP_COND:
+ check_cond(sc);
+
+ case OP_COND_UNCHECKED:
+ push_stack(sc, OP_COND1, sc->NIL, sc->code);
+ sc->code = caar(sc->code);
+ goto EVAL;
+
+
+ case OP_COND1:
+ if (is_true(sc, sc->value))
+ {
+ sc->code = cdar(sc->code);
+ if (is_null(sc->code))
+ {
+ if (is_multiple_value(sc->value)) /* (+ 1 (cond ((values 2 3)))) */
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ /* no result clause, so return test, (cond (#t)) -> #t, (cond ((+ 1 2))) -> 3 */
+ goto START;
+ }
+
+ if (is_pair(sc->code))
+ {
+ if ((car(sc->code) == sc->FEED_TO) &&
+ (s7_symbol_value(sc, sc->FEED_TO) == sc->UNDEFINED))
+ {
+ if (is_multiple_value(sc->value)) /* (cond ((values 1 2) => +)) */
+ sc->code = cons(sc, cadr(sc->code), multiple_value(sc->value));
+ else sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->QUOTE, sc->value));
+ goto EVAL;
+ }
+ goto BEGIN1;
+ }
+ eval_error(sc, "cond: unexpected dot? ~A", sc->code); /* (cond (#t . 1)) etc */
+ }
+ sc->code = cdr(sc->code);
+ if (is_null(sc->code))
+ {
+ sc->value = sc->NIL;
+ goto START;
+ }
+
+ push_stack_no_args(sc, OP_COND1, sc->code);
+ sc->code = caar(sc->code);
+ goto EVAL;
+
+
+ case OP_COND_SIMPLE:
+ push_stack_no_args(sc, OP_COND1_SIMPLE, sc->code);
+ sc->code = caar(sc->code);
+ goto EVAL;
+
+
+ case OP_COND1_SIMPLE:
+ while (true)
+ {
+ if (is_true(sc, sc->value))
+ {
+ sc->code = cdar(sc->code);
+ if (is_null(sc->code))
+ {
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ goto START;
+ }
+ goto BEGIN1;
+ }
+
+ sc->code = cdr(sc->code);
+ if (is_null(sc->code))
+ {
+ sc->value = sc->NIL;
+ goto START;
+ }
+ if (is_pair(caar(sc->code)))
+ {
+ push_stack_no_args(sc, OP_COND1_SIMPLE, sc->code);
+ sc->code = caar(sc->code);
+ goto EVAL;
+ }
+ sc->value = caar(sc->code);
+ if (is_symbol(sc->value))
+ sc->value = find_symbol_checked(sc, sc->value);
+ }
+
+
+ case OP_COND_S:
+ {
+ s7_pointer val = NULL, p;
+ if (is_pair(caar(sc->code)))
+ val = find_symbol_checked(sc, cadaar(sc->code));
+ for (p = sc->code; is_pair(p); p = cdr(p))
+ {
+ s7_pointer ap;
+ ap = caar(p);
+ if (is_pair(ap))
+ {
+ car(sc->T1_1) = val;
+ sc->value = c_call(ap)(sc, sc->T1_1);
+ }
+ else sc->value = sc->T;
+ if (is_true(sc, sc->value))
+ {
+ sc->code = cdar(p);
+ if (is_null(sc->code))
+ {
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ goto START;
+ }
+ goto BEGIN1;
+ }
+ }
+ sc->value = sc->NIL;
+ }
+ break;
+
+ case OP_COND_ALL_X_2:
+ {
+ s7_pointer p;
+ p = sc->code;
+ sc->value = c_call(car(p))(sc, caar(p));
+ if (!is_true(sc, sc->value))
+ {
+ p = cdr(p);
+ sc->value = c_call(car(p))(sc, caar(p));
+ if (!is_true(sc, sc->value))
+ {
+ sc->value = sc->NIL;
+ goto START;
+ }
+ }
+ sc->code = cdar(p);
+ if (is_null(sc->code))
+ {
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ goto START;
+ }
+ goto BEGIN1;
+ }
+
+ case OP_COND_ALL_X:
+ {
+ s7_pointer p;
+ for (p = sc->code; is_pair(p); p = cdr(p))
+ {
+ sc->value = c_call(car(p))(sc, caar(p));
+ if (is_true(sc, sc->value))
+ {
+ sc->code = cdar(p);
+ if (is_null(sc->code))
+ {
+ if (is_multiple_value(sc->value))
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ goto START;
+ }
+ goto BEGIN1;
+ }
+ }
+ sc->value = sc->NIL;
+ }
+ break;
+
+ /* -------------------------------- AND -------------------------------- */
+ case OP_AND:
+ check_and(sc);
+ if (is_null(sc->code))
+ {
+ sc->value = sc->T;
+ goto START;
+ }
+ goto AND1;
+
+ case OP_AND1:
+ if ((is_false(sc, sc->value)) ||
+ (is_null(sc->code)))
+ goto START;
+
+ AND1:
+ case OP_AND_UNCHECKED:
+ {
+ s7_pointer p;
+ p = car(sc->code);
+ if (!is_pair(p))
+ {
+ if (is_symbol(p))
+ sc->value = find_global_symbol_checked(sc, p);
+ else sc->value = p;
+
+ if ((is_false(sc, sc->value)) ||
+ (is_null(cdr(sc->code))))
+ goto START;
+
+ sc->code = cdr(sc->code);
+ goto AND1;
+ }
+
+ if (is_not_null(cdr(sc->code)))
+ push_stack_no_args(sc, OP_AND1, cdr(sc->code));
+ sc->code = p;
+ if (is_optimized(p))
+ goto OPT_EVAL;
+ goto EVAL;
+ }
+
+
+ case OP_AND_P1:
+ if ((is_false(sc, sc->value)) ||
+ (is_null(sc->code)))
+ goto START;
+ /* fall through */
+
+ AND_P:
+ case OP_AND_P:
+ if (c_callee(sc->code)) /* all c_callee's are set via all_x_eval which can return nil */
+ {
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ if (is_false(sc, sc->value))
+ goto START;
+ sc->code = cdr(sc->code);
+ if (is_null(sc->code))
+ goto START;
+ goto AND_P;
+ }
+ else
+ {
+ if (is_not_null(cdr(sc->code)))
+ push_stack_no_args(sc, OP_AND_P1, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
+
+ case OP_AND_P2:
+ /* we know c_callee is set on sc->code, and there are only two branches */
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ if (is_false(sc, sc->value))
+ goto START;
+ sc->code = cadr(sc->code);
+ goto EVAL;
+
+
+ /* -------------------------------- OR -------------------------------- */
+ case OP_OR:
+ check_or(sc);
+ if (is_null(sc->code))
+ {
+ sc->value = sc->F;
+ goto START;
+ }
+ goto OR1;
+
+ case OP_OR1:
+ if ((is_true(sc, sc->value)) ||
+ (is_null(sc->code)))
+ goto START;
+
+ OR1:
+ case OP_OR_UNCHECKED:
+ if (!is_pair(car(sc->code)))
+ {
+ sc->value = car(sc->code);
+ if (is_symbol(sc->value))
+ sc->value = find_symbol_checked(sc, sc->value);
+
+ if ((is_true(sc, sc->value)) ||
+ (is_null(cdr(sc->code))))
+ goto START;
+
+ sc->code = cdr(sc->code);
+ goto OR1;
+ }
+
+ if (is_not_null(cdr(sc->code)))
+ push_stack_no_args(sc, OP_OR1, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+
+
+ case OP_OR_P1:
+ if ((is_true(sc, sc->value)) ||
+ (is_null(sc->code)))
+ goto START;
+ /* fall through */
+
+ OR_P:
+ case OP_OR_P:
+ if (c_callee(sc->code))
+ {
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ if (is_true(sc, sc->value))
+ goto START;
+ sc->code = cdr(sc->code);
+ if (is_null(sc->code))
+ goto START;
+ goto OR_P;
+ }
+ else
+ {
+ if (is_not_null(cdr(sc->code)))
+ push_stack_no_args(sc, OP_OR_P1, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
+
+ case OP_OR_P2:
+ /* we know c_callee is set on sc->code, and there are only two branches */
+ sc->value = c_call(sc->code)(sc, car(sc->code));
+ if (is_true(sc, sc->value))
+ goto START;
+ sc->code = cadr(sc->code);
+ goto EVAL;
+
+ /* by going direct without a push_stack on the last one we get tail calls,
+ * but if the last arg (also in "and" above) is "values", there is a slight
+ * inconsistency: the values are returned and spliced into the caller if trailing, but
+ * are spliced into the "or" if not trailing, so
+ *
+ * (+ 10 (or (values 1 2) #f))
+ * 11
+ * (+ 10 (or #f (values 1 2)))
+ * 13
+ * (+ 10 (or (or #f (values 1 2)) #f))
+ * 11
+ *
+ * The tail recursion is more important. This behavior matches that of "begin" -- if the
+ * values statement is last, it splices into the next outer arglist.
+ */
+
+
+ /* -------------------------------- macro evaluation -------------------------------- */
+
+ case OP_EVAL_MACRO: /* after (scheme-side) macroexpansion, evaluate the resulting expression */
+ /*
+ * (define-macro (hi a) `(+ ,a 1))
+ * (hi 2)
+ * here with value: (+ 2 1)
+ */
+ if (is_multiple_value(sc->value))
+ {
+ /* a normal macro's result is evaluated (below) and its value replaces the macro invocation,
+ * so if a macro returns multiple values, evaluate each one, then replace the macro
+ * invocation with (apply values evaluated-results-in-a-list). We need to save the
+ * new list of results, and where we are in the macro's output list, so code=macro output,
+ * args=new list. If it returns (values), should we use #<unspecified>? I think that
+ * happens now without generating a multiple_value object:
+ * (define-macro (hi) (values)) (hi) -> #<unspecified>
+ *
+ * (define-macro (ho) (values '(+ 1 2) '(* 3 4))) (+ 1 (ho) 3) -> 19
+ * (define-macro (ha) (values '(define a 1) '(define b 2))) (let () (ha) (+ a b)) -> 3
+ */
+ push_stack(sc, OP_EVAL_MACRO_MV, sc->NIL, cdr(sc->value));
+ sc->code = car(sc->value);
+ }
+ else sc->code = sc->value;
+ goto EVAL;
+
+
+ case OP_EVAL_MACRO_MV:
+ if (is_null(sc->code)) /* end of values list */
+ {
+ sc->value = splice_in_values(sc, multiple_value(safe_reverse_in_place(sc, cons(sc, sc->value, sc->args))));
+ goto START;
+ }
+ push_stack(sc, OP_EVAL_MACRO_MV, cons(sc, sc->value, sc->args), cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
+
+
+ case OP_EXPANSION:
+ /* after the expander has finished, if a list was returned, we need to add some annotations.
+ * if the expander returned (values), the list-in-progress vanishes! (This mimics map and *#readers*).
+ */
+ if (sc->value == sc->NO_VALUE)
+ sc->stack_end[-1] = (s7_pointer)OP_READ_NEXT;
+ else
+ {
+ if (is_pair(sc->value))
+ annotate_expansion(sc->value);
+ }
+ break;
+
+
+ case OP_DEFINE_MACRO_WITH_ACCESSOR:
+ if (sc->value == sc->ERROR) /* backwards compatibility... */
+ return(s7_error(sc, sc->ERROR, set_elist_3(sc, make_string_wrapper(sc, "can't define-macro ~S to ~S"), car(sc->args), cadr(sc->args))));
+ sc->code = sc->value;
+ if ((!is_pair(sc->code)) ||
+ (!is_pair(car(sc->code))) ||
+ (!is_symbol(caar(sc->code))))
+ eval_error(sc, "define-macro: ~S does not look like a macro?", sc->code);
+ sc->value = make_macro(sc);
+ break;
+
+
+ case OP_DEFINE_BACRO:
+ case OP_DEFINE_BACRO_STAR:
+ case OP_DEFINE_EXPANSION:
+ case OP_DEFINE_MACRO:
+ case OP_DEFINE_MACRO_STAR:
+ check_define_macro(sc, sc->op);
+ if (symbol_has_accessor(caar(sc->code)))
+ {
+ s7_pointer x;
+ x = find_symbol(sc, caar(sc->code));
+ if ((is_slot(x)) &&
+ (slot_has_accessor(x)))
+ {
+ sc->value = bind_accessed_symbol(sc, OP_DEFINE_MACRO_WITH_ACCESSOR, caar(sc->code), sc->code);
+ if (sc->value == sc->NO_VALUE)
+ goto APPLY;
+ sc->code = sc->value;
+ }
+ }
+ sc->value = make_macro(sc);
+ break;
+
+
+ case OP_LAMBDA:
+ check_lambda(sc);
+
+ case OP_LAMBDA_UNCHECKED:
+ make_closure_with_let(sc, sc->value, car(sc->code), cdr(sc->code), sc->envir);
+ break;
+
+
+ case OP_LAMBDA_STAR:
+ check_lambda_star(sc);
+
+ case OP_LAMBDA_STAR_UNCHECKED:
+ sc->value = make_closure(sc, car(sc->code), cdr(sc->code), T_CLOSURE_STAR);
+ break;
+
+
+ /* -------------------------------- CASE -------------------------------- */
+
+ case OP_CASE: /* case, car(sc->code) is the selector */
+ check_case(sc);
+
+ case OP_CASE_UNCHECKED:
+ {
+ s7_pointer carc;
+ carc = car(sc->code);
+ if (!is_pair(carc))
+ {
+ if (is_symbol(carc))
+ sc->value = find_symbol_checked(sc, carc);
+ else sc->value = carc;
+ sc->code = cdr(sc->code);
+ /* fall through */
+ }
+ else
+ {
+ push_stack_no_args(sc, OP_CASE1, cdr(sc->code));
+ sc->code = carc;
+ goto EVAL;
+ }
+ }
+
+ case OP_CASE1:
+ {
+ s7_pointer x, y;
+ if (is_simple(sc->value))
+ {
+ for (x = sc->code; is_pair(x); x = cdr(x))
+ {
+ y = caar(x);
+ if (!is_pair(y))
+ goto ELSE_CASE;
+ do {
+ if (car(y) == sc->value)
+ goto ELSE_CASE;
+ y = cdr(y);
+ } while (is_pair(y));
+ }
+ }
+ else
+ {
+ for (x = sc->code; is_pair(x); x = cdr(x))
+ {
+ y = caar(x);
+ if (!is_pair(y))
+ goto ELSE_CASE;
+ for (; is_pair(y); y = cdr(y))
+ if (s7_is_eqv(car(y), sc->value))
+ goto ELSE_CASE;
+ }
+ }
+ /* x is the entire matching clause, (case 2 ((2) 3)), x: (((2) 3)) */
+ ELSE_CASE:
+ if (is_not_null(x))
+ {
+ sc->code = cdar(x);
+
+ /* check for => */
+ if ((car(sc->code) == sc->FEED_TO) &&
+ (s7_symbol_value(sc, sc->FEED_TO) == sc->UNDEFINED))
+ {
+ sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->QUOTE, sc->value));
+ goto EVAL;
+ }
+ goto BEGIN1;
+ }
+
+ /* no match found */
+ sc->value = sc->UNSPECIFIED; /* this was sc->NIL but the spec says case value is unspecified if no clauses match */
+ }
+ break;
+
+ case OP_CASE_SIMPLE:
+ /* assume symbol as selector, all keys are simple, and no => */
+ {
+ s7_pointer x, y, selector;
+ selector = find_symbol_checked(sc, car(sc->code));
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ {
+ y = opt_key(x);
+ if (!is_pair(y)) /* else? */
+ {
+ sc->code = cdar(x);
+ goto BEGIN1;
+ }
+ do {
+ if (car(y) == selector)
+ {
+ sc->code = cdar(x);
+ goto BEGIN1;
+ }
+ y = cdr(y);
+ } while (is_pair(y));
+ }
+ sc->value = sc->UNSPECIFIED;
+ }
+ break;
+
+ case OP_CASE_SIMPLER:
+ /* assume symbol as selector, all keys are simple, and no => and no else */
+ {
+ s7_pointer x, y, selector;
+ selector = find_symbol_checked(sc, car(sc->code));
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ {
+ y = opt_key(x);
+ do {
+ if (car(y) == selector)
+ {
+ sc->code = cdar(x);
+ goto BEGIN1;
+ }
+ y = cdr(y);
+ } while (is_pair(y));
+ }
+ sc->value = sc->UNSPECIFIED;
+ }
+ break;
+
+ case OP_CASE_SIMPLER_1:
+ /* assume symbol as selector, all keys are simple, and no => and no else, bodies are 1 liners */
+ {
+ s7_pointer x, y, selector;
+ selector = find_symbol_checked(sc, car(sc->code));
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ {
+ y = opt_key(x);
+ do {
+ if (car(y) == selector)
+ {
+ sc->code = opt_clause(x); /* cadar(x); */
+ goto EVAL;
+ }
+ y = cdr(y);
+ } while (is_pair(y));
+ }
+ sc->value = sc->UNSPECIFIED;
+ }
+ break;
+
+ case OP_CASE_SIMPLER_SS:
+ /* assume hop_safe_ss as selector, all keys are simple, and no => and no else, bodies are 1 liners */
+ {
+ s7_pointer x, y, selector, args;
+ args = cdar(sc->code);
+ x = find_symbol_checked(sc, car(args));
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_1) = x;
+ selector = c_call(car(sc->code))(sc, sc->T2_1);
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ {
+ y = opt_key(x);
+ do {
+ if (car(y) == selector)
+ {
+ sc->code = opt_clause(x); /* cadar(x); */
+ goto EVAL;
+ }
+ y = cdr(y);
+ } while (is_pair(y));
+ }
+ sc->value = sc->UNSPECIFIED;
+ }
+ break;
+
+ case OP_CASE_SIMPLEST_SS:
+ {
+ s7_pointer x, selector, args;
+ args = cdar(sc->code);
+ x = find_symbol_checked(sc, car(args));
+ car(sc->T2_2) = find_symbol_checked(sc, cadr(args));
+ car(sc->T2_1) = x;
+ selector = c_call(car(sc->code))(sc, sc->T2_1);
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ if (opt_key(x) == selector)
+ {
+ sc->code = cdar(x);
+ goto BEGIN1;
+ }
+ sc->value = sc->UNSPECIFIED;
+ }
+ break;
+
+ case OP_CASE_SIMPLEST:
+ /* assume symbol as selector, all keys are simple and singletons, and no => and no else, bodies are 1 liners */
+ {
+ s7_pointer x, selector;
+ selector = find_symbol_checked(sc, car(sc->code));
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
+ if (opt_key(x) == selector)
+ {
+ sc->code = opt_clause(x); /* cadar(x); */
+ goto EVAL;
+ }
+ sc->value = sc->UNSPECIFIED;
+ }
+ break;
+
+
+ case OP_ERROR_QUIT:
+ case OP_EVAL_DONE:
+ /* this is the "time to quit" operator */
+ return(sc->F);
+ break;
+
+ case OP_BARRIER:
+ case OP_CATCH_ALL:
+ case OP_CATCH:
+ case OP_CATCH_1:
+ case OP_CATCH_2:
+ break;
+
+ case OP_DEACTIVATE_GOTO:
+ call_exit_active(sc->args) = false; /* as we leave the call-with-exit body, deactivate the exiter */
+ break;
+
+
+ case OP_ERROR_HOOK_QUIT:
+ sc->error_hook = sc->code; /* restore old value */
+
+ /* now mimic the end of the normal error handler. Since this error hook evaluation can happen
+ * in an arbitrary s7_call nesting, we can't just return from the current evaluation --
+ * we have to jump to the original (top-level) call. Otherwise '#<unspecified> or whatever
+ * is simply treated as the (non-error) return value, and the higher level evaluations
+ * get confused.
+ */
+ stack_reset(sc);
+ sc->op = OP_ERROR_QUIT;
+ if (sc->longjmp_ok) longjmp(sc->goto_start, 1);
+ return(sc->value); /* not executed I hope */
+
+
+ case OP_GET_OUTPUT_STRING: /* from get-output-string -- return a new string */
+ sc->value = s7_make_string_with_length(sc, (const char *)port_data(sc->code), port_position(sc->code));
+ break;
+
+
+ case OP_GET_OUTPUT_STRING_1: /* from call-with-output-string and with-output-to-string -- return the port string directly */
+ if ((!is_output_port(sc->code)) ||
+ (port_is_closed(sc->code)))
+ simple_wrong_type_argument_with_type(sc, sc->WITH_OUTPUT_TO_STRING, sc->code, make_string_wrapper(sc, "an open string output port"));
+
+ if (port_position(sc->code) >= port_data_size(sc->code))
+ resize_port_data(sc->code, port_position(sc->code) + 1); /* need room for the trailing #\null */
+ sc->value = make_string_uncopied_with_length(sc, (char *)port_data(sc->code), port_position(sc->code));
+ string_value(sc->value)[port_position(sc->code)] = 0;
+ port_data(sc->code) = NULL;
+ port_data_size(sc->code) = 0;
+ port_needs_free(sc->code) = false;
+ /* fall through */
+
+ case OP_UNWIND_OUTPUT:
+ unwind_output_ex(sc);
+ break;
+
+ case OP_UNWIND_INPUT:
+ unwind_input_ex(sc);
+ break;
+
+ case OP_DYNAMIC_WIND:
+ if (dynamic_wind_ex(sc) == goto_APPLY) goto APPLY;
+ break;
+
+
+ /* -------------------------------- with-let --------------------------------
+ *
+ * the extra set! to pull in args, or fixup the outlet is annoying, but
+ * but with-let is hard to do right -- what if env is chained as in class/objects?
+ * also, currently a mock-let is an error -- perhaps add the method checks?
+ * but unless 'values, that would require a 'with-let method (it's not a function)
+ */
+ case OP_WITH_LET_S:
+ {
+ s7_pointer e;
+ e = find_symbol_checked(sc, car(sc->code));
+ if (e == sc->rootlet)
+ sc->envir = sc->NIL;
+ else
+ {
+ s7_pointer p;
+ if (!is_let(e))
+ eval_type_error(sc, "with-let takes an environment argument: ~A", e);
+ set_with_let_let(e);
+ let_id(e) = ++sc->let_number;
+ sc->envir = e;
+ /* if the let in question has 10,000 names (e.g. *gtk*) this loop (which can't be avoided currently)
+ * will be noticeable in a few cases. So, instead of saying (with-let *gtk* ...) use something
+ * equivalent to (with-let (sublet *gtk*) ...) which is cleaner anyway. (In my timing tests, even
+ * when pounding on this one block, the loop only amounts to 1% of the time. Normally it's
+ * negligible).
+ */
+ for (p = let_slots(e); is_slot(p); p = next_slot(p))
+ {
+ s7_pointer sym;
+ sym = slot_symbol(p);
+ if (symbol_id(sym) != sc->let_number)
+ symbol_set_local(sym, sc->let_number, p);
+ }
+ }
+ sc->code = cdr(sc->code);
+ goto BEGIN1;
+ }
+
+
+ case OP_WITH_LET:
+ check_with_let(sc);
+
+ case OP_WITH_LET_UNCHECKED:
+ sc->value = car(sc->code);
+ if (!is_pair(sc->value))
+ {
+ if (is_symbol(sc->value))
+ sc->value = find_symbol_checked(sc, sc->value);
+ sc->code = cdr(sc->code);
+
+ if (!is_pair(sc->code))
+ {
+ if (!is_let(sc->value)) /* (with-let e abs) */
+ eval_type_error(sc, "with-let takes an environment argument: ~A", sc->value);
+ if (is_symbol(sc->code))
+ sc->value = s7_symbol_local_value(sc, sc->code, sc->value);
+ else sc->value = sc->code;
+ goto START;
+ }
+ /* else fall through */
+ }
+ else
+ {
+ push_stack(sc, OP_WITH_LET1, sc->NIL, cdr(sc->code));
+ sc->code = sc->value; /* eval env arg */
+ goto EVAL;
+ }
+
+ case OP_WITH_LET1:
+ {
+ s7_pointer e;
+ e = sc->value;
+ if (!is_let(e)) /* (with-let . "hi") */
+ eval_type_error(sc, "with-let takes an environment argument: ~A", e);
+ if (e == sc->rootlet)
+ sc->envir = sc->NIL; /* (with-let (rootlet) ...) */
+ else
+ {
+ s7_pointer p;
+ set_with_let_let(e);
+ let_id(e) = ++sc->let_number;
+ sc->envir = e;
+ for (p = let_slots(e); is_slot(p); p = next_slot(p))
+ {
+ s7_pointer sym;
+ sym = slot_symbol(p);
+ if (symbol_id(sym) != sc->let_number)
+ symbol_set_local(sym, sc->let_number, p);
+ }
+ }
+ goto BEGIN1;
+ }
+
+
+ case OP_WITH_BAFFLE:
+ if (!is_proper_list(sc, sc->code))
+ eval_error(sc, "with-baffle: unexpected dot? ~A", sc->code);
+
+ if ((!is_null(sc->code)) &&
+ (is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->WITH_BAFFLE_UNCHECKED);
+
+ case OP_WITH_BAFFLE_UNCHECKED:
+ if (is_null(sc->code))
+ {
+ sc->value = sc->NIL;
+ goto START;
+ }
+ new_frame(sc, sc->envir, sc->envir);
+ make_slot_1(sc, sc->envir, sc->BAFFLE, make_baffle(sc));
+ goto BEGIN1;
+
+
+ /* -------------------------------- the reader -------------------------------- */
+
+ POP_READ_LIST:
+ /* push-stack OP_READ_LIST is always no_code and sc->op is always OP_READ_LIST (and not used), sc->envir is apparently not needed here
+ */
+ sc->stack_end -= 4;
+ sc->args = sc->stack_end[2];
+
+ READ_LIST:
+ case OP_READ_LIST: /* sc->args is sc->NIL at first */
+ {
+ s7_pointer x;
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->args;
+ sc->args = x;
+ }
+
+ case OP_READ_NEXT: /* this is 75% of the token calls, so expanding it saves lots of time */
+ {
+ int c;
+ s7_pointer pt;
+
+ pt = sc->input_port;
+ c = port_read_white_space(pt)(sc, pt);
+
+ READ_C:
+ switch (c)
+ {
+ case '(':
+ c = port_read_white_space(pt)(sc, pt); /* sc->tok = token(sc) */
+ switch (c)
+ {
+ case '(': sc->tok = TOKEN_LEFT_PAREN; break;
+ case ')': sc->value = sc->NIL; goto READ_LIST; /* was tok = TOKEN_RIGHT_PAREN */
+ case '.': sc->tok = read_dot(sc, pt); break;
+ case '\'': sc->tok = TOKEN_QUOTE; break;
+ case ';': sc->tok = port_read_semicolon(pt)(sc, pt); break;
+ case '"': sc->tok = TOKEN_DOUBLE_QUOTE; break;
+ case '`': sc->tok = TOKEN_BACK_QUOTE; break;
+ case ',': sc->tok = read_comma(sc, pt); break;
+ case '#': sc->tok = read_sharp(sc, pt); break;
+ case '\0': case EOF: sc->tok = TOKEN_EOF; break;
+
+ default:
+ {
+ s7_pointer x;
+ sc->strbuf[0] = c;
+ push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ check_stack_size(sc);
+ sc->value = port_read_name(pt)(sc, pt);
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->NIL;
+ sc->args = x;
+ /*
+ if (port_position(pt) >= port_data_size(pt))
+ return(missing_close_paren_error(sc));
+ */
+ c = port_read_white_space(pt)(sc, pt);
+ goto READ_C;
+ }
+ }
+
+ if (sc->tok == TOKEN_ATOM)
+ {
+ s7_pointer x;
+ push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ check_stack_size(sc);
+ sc->value = port_read_name(pt)(sc, pt);
+ new_cell(sc, x, T_PAIR);
+ car(x) = sc->value;
+ cdr(x) = sc->NIL;
+ sc->args = x;
+ /*
+ if (port_position(pt) >= port_data_size(pt))
+ return(missing_close_paren_error(sc));
+ */
+ c = port_read_white_space(pt)(sc, pt);
+ goto READ_C;
+ }
+
+ if (sc->tok == TOKEN_RIGHT_PAREN)
+ {
+ sc->value = sc->NIL;
+ goto READ_LIST;
+ }
+
+ if (sc->tok == TOKEN_DOT)
+ {
+ do {c = inchar(pt);} while ((c != ')') && (c != EOF));
+ return(read_error(sc, "stray dot after '('?")); /* (car '( . )) */
+ }
+
+ if (sc->tok == TOKEN_EOF)
+ return(missing_close_paren_error(sc));
+
+ push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ push_stack_no_code(sc, OP_READ_LIST, sc->NIL);
+ check_stack_size(sc);
+ sc->value = read_expression(sc);
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ goto START;
+
+ case ')':
+ sc->tok = TOKEN_RIGHT_PAREN;
+ break;
+
+ case '.':
+ sc->tok = read_dot(sc, pt); /* dot or atom */
+ break;
+
+ case '\'':
+ sc->tok = TOKEN_QUOTE;
+ push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ sc->value = read_expression(sc);
+ goto START;
+
+ case ';':
+ sc->tok = port_read_semicolon(pt)(sc, pt);
+ break;
+
+ case '"':
+ sc->tok = TOKEN_DOUBLE_QUOTE;
+ sc->value = read_string_constant(sc, pt);
+ if (sc->value == sc->F) /* can happen if input code ends in the middle of a string */
+ return(string_read_error(sc, "end of input encountered while in a string"));
+ if (sc->value == sc->T)
+ return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
+ goto READ_LIST;
+
+ case '`':
+ sc->tok = TOKEN_BACK_QUOTE;
+ push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ sc->value = read_expression(sc);
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ goto START; /* read_unquote */
+
+ case ',':
+ sc->tok = read_comma(sc, pt); /* at_mark or comma */
+ push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ sc->value = read_expression(sc);
+ goto START; /* read_unquote */
+
+ case '#':
+ sc->tok = read_sharp(sc, pt);
+ break;
+
+ case '\0':
+ case EOF:
+ return(missing_close_paren_error(sc));
+
+ default:
+ sc->strbuf[0] = c;
+ sc->value = port_read_name(pt)(sc, pt);
+ /*
+ if (port_position(pt) >= port_data_size(pt))
+ return(missing_close_paren_error(sc));
+ */
+ goto READ_LIST;
+ }
+ }
+
+ READ_TOK:
+ switch (sc->tok)
+ {
+ case TOKEN_RIGHT_PAREN:
+ /* sc->args can't be null here */
+ sc->value = safe_reverse_in_place(sc, sc->args);
+ if (is_symbol(car(sc->value)))
+ {
+ pair_set_line(sc->value, remember_location(port_line_number(sc->input_port), port_file_number(sc->input_port)));
+ set_has_line_number(sc->value); /* sc->input_port above can't be nil(?) -- it falls back on stdin now */
+
+ if ((is_expansion(car(sc->value))) &&
+ (expansion_ex(sc) == goto_APPLY))
+ goto APPLY;
+ if (is_pair(cdr(sc->value)))
+ {
+ set_opt_back(sc->value);
+ set_overlay(cdr(sc->value));
+ }
+ }
+ break;
+
+ case TOKEN_EOF: /* can't happen, I believe */
+ return(missing_close_paren_error(sc));
+
+ case TOKEN_ATOM:
+ sc->value = port_read_name(sc->input_port)(sc, sc->input_port);
+ /*
+ if (port_position(sc->input_port) >= port_data_size(sc->input_port))
+ return(missing_close_paren_error(sc));
+ */
+ goto READ_LIST;
+
+ case TOKEN_SHARP_CONST:
+ sc->value = port_read_sharp(sc->input_port)(sc, sc->input_port);
+ if (is_null(sc->value))
+ return(read_error(sc, "undefined # expression"));
+ if (sc->value == sc->NO_VALUE)
+ {
+ /* (set! *#readers* (cons (cons #\; (lambda (s) (read) (values))) *#readers*))
+ * (+ 1 #;(* 2 3) 4)
+ * so we need to get the next token, act on it without any assumptions about read list
+ */
+ sc->tok = token(sc);
+ goto READ_TOK;
+ }
+ goto READ_LIST;
+
+ case TOKEN_DOUBLE_QUOTE:
+ sc->value = read_string_constant(sc, sc->input_port);
+ if (sc->value == sc->F) /* can happen if input code ends in the middle of a string */
+ return(string_read_error(sc, "end of input encountered while in a string"));
+ if (sc->value == sc->T)
+ return(read_error(sc, "unknown backslash usage -- perhaps you meant two backslashes?"));
+ goto READ_LIST;
+
+ case TOKEN_DOT:
+ push_stack_no_code(sc, OP_READ_DOT, sc->args);
+ sc->tok = token(sc);
+ sc->value = read_expression(sc);
+ break;
+
+ default:
+ /* by far the main case here is TOKEN_LEFT_PAREN, but it doesn't save anything to move it to this level */
+ push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ sc->value = read_expression(sc);
+ /* check for op_read_list here and explicit pop_stack are slower */
+ break;
+ }
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+
+ case OP_READ_DOT:
+ if (token(sc) != TOKEN_RIGHT_PAREN)
+ {
+ back_up_stack(sc);
+ read_error(sc, "stray dot?"); /* (+ 1 . 2 3) or (list . ) */
+ }
+ /* args = previously read stuff, value = thing just after the dot and before the ')':
+ * (list 1 2 . 3)
+ * value: 3, args: (2 1 list)
+ * '(1 . 2)
+ * value: 2, args: (1)
+ *
+ * but we also get here in a lambda arg list:
+ * (lambda (a b . c) #f)
+ * value: c, args: (b a)
+ *
+ * so we have to leave any error checks until later, I guess
+ * -- in eval_args1, if we end with non-pair-not-nil then
+ * something is fishy
+ */
+ sc->value = reverse_in_place(sc, sc->value, sc->args);
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+
+ case OP_READ_QUOTE:
+ /* can't check for sc->value = sc->NIL here because we want ''() to be different from '() */
+ sc->value = list_2(sc, sc->QUOTE, sc->value);
+ set_opt_back(sc->value);
+ set_overlay(cdr(sc->value));
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+
+ case OP_READ_QUASIQUOTE:
+ /* this was pushed when the backquote was seen, then eventually we popped back to it */
+ sc->value = g_quasiquote_1(sc, sc->value);
+ /* doing quasiquote at read time means there are minor inconsistencies in
+ * various combinations or quote/' and quasiquote/`. A quoted ` will expand
+ * but quoted quasiquote will not (` can't be redefined, but quasiquote can).
+ * see s7test.scm for examples.
+ */
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+
+ case OP_READ_VECTOR:
+ if (!is_proper_list(sc, sc->value)) /* #(1 . 2) */
+ return(read_error(sc, "vector constant data is not a proper list"));
+ if (sc->args == small_int(1)) /* sc->args was sc->w earlier from read_sharp */
+ sc->value = g_vector(sc, sc->value);
+ else sc->value = g_multivector(sc, s7_integer(sc->args), sc->value);
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+
+ case OP_READ_BYTE_VECTOR:
+ if (!is_proper_list(sc, sc->value)) /* #u8(1 . 2) */
+ return(read_error(sc, "byte-vector constant data is not a proper list"));
+ sc->value = g_byte_vector(sc, sc->value);
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+
+#if WITH_QUASIQUOTE_VECTOR
+ case OP_READ_QUASIQUOTE_VECTOR:
+ read_quasiquote_vector_ex(sc);
+ goto EVAL;
+#endif
+
+ case OP_READ_UNQUOTE:
+ /* here if sc->value is a constant, the unquote is pointless (what about ,pi?) */
+ if ((is_pair(sc->value)) ||
+ (is_symbol(sc->value)))
+ sc->value = list_2(sc, sc->UNQUOTE, sc->value);
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+
+ case OP_READ_APPLY_VALUES:
+ if (is_symbol(sc->value))
+ {
+ s7_pointer lst;
+ lst = list_2(sc, sc->QQ_Apply_Values, sc->value);
+ set_unsafe_optimize_op(lst, HOP_C_S);
+ set_c_function(lst, sc->QQ_Apply_Values);
+ sc->value = list_2(sc, sc->UNQUOTE, lst);
+ }
+ else sc->value = list_2(sc, sc->UNQUOTE, list_2(sc, sc->QQ_Apply_Values, sc->value));
+ if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
+ break;
+
+
+ default:
+ fprintf(stderr, "unknown operator: %d in %s\n", (int)(sc->op), DISPLAY(sc->cur_code));
+#if DEBUGGING
+ abort();
+#endif
+ return(sc->F);
+ }
}
-}
-
-
-static bool key_equal(void *obj1, void *obj2)
-{
- return(obj1 == obj2);
-}
-
-
-bool s7_is_thread_variable(s7_pointer obj)
-{
- return((is_c_object(obj)) &&
- (c_object_type(obj) == key_tag));
-}
-
-
-s7_pointer s7_thread_variable(s7_scheme *sc, s7_pointer obj)
-{
- void *val;
- val = key_value(obj);
- if (val)
- return((s7_pointer)val);
return(sc->F);
}
-
-static s7_pointer g_is_thread_variable(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_thread_variable "(thread-variable? obj) returns #t if obj is a thread variable (a pthread key)"
- return(make_boolean(sc, s7_is_thread_variable(car(args))));
-}
-
-
-static s7_pointer g_make_thread_variable(s7_scheme *sc, s7_pointer args)
-{
- #define H_make_thread_variable "(make-thread-variable) returns a new thread specific variable (a pthread key)"
- pthread_key_t *key;
- int err;
- key = (pthread_key_t *)malloc(sizeof(pthread_key_t));
- err = pthread_key_create(key, NULL);
- if (err == 0)
- return(s7_make_object(sc, key_tag, (void *)key));
- return(s7_error(sc, make_symbol(sc, "thread-error"), make_list_1(sc, make_protected_string(sc, "make-thread-variable failed!?"))));
-}
-
-
-static s7_pointer get_key(s7_scheme *sc, s7_pointer obj, s7_pointer args)
-{
- if (args != sc->NIL)
- return(s7_error(sc, sc->WRONG_NUMBER_OF_ARGS,
- make_list_3(sc, make_protected_string(sc, "thread variable is a function of no arguments: ~A ~A"), obj, args)));
- return(s7_thread_variable(sc, obj));
-}
-
-
-static s7_pointer set_key(s7_scheme *sc, s7_pointer obj, s7_pointer args)
-{
- pthread_key_t *key;
- key = (pthread_key_t *)s7_object_value(obj);
- pthread_setspecific(*key, (void *)car(args));
-
- /* to protect from the GC until either the local key value is set again, or the thread is done,
- * we store the key's local value in an alist '(obj value)
- */
- {
- s7_pointer curval;
- curval = g_assq(sc, make_list_2(sc, obj, sc->key_values));
- if (curval == sc->F)
- sc->key_values = s7_cons(sc, s7_cons(sc, obj, car(args)), sc->key_values);
- else cdr(curval) = car(args);
- }
- return(car(args));
-}
+#if WITH_GCC
+#undef new_cell
+#if (!DEBUGGING)
+#define new_cell(Sc, Obj, Type) \
+ do { \
+ if (Sc->free_heap_top <= Sc->free_heap_trigger) try_to_call_gc(Sc); \
+ Obj = (*(--(Sc->free_heap_top))); \
+ set_type(Obj, Type); \
+ } while (0)
+#else
+#define new_cell(Sc, Obj, Type) \
+ do { \
+ if ((Sc->free_heap_top <= Sc->free_heap_trigger) || (for_any_other_reason(sc, __LINE__))) {last_gc_line = __LINE__; last_gc_func = __func__; try_to_call_gc(Sc);} \
+ Obj = (*(--(Sc->free_heap_top))); \
+ Obj->alloc_line = __LINE__; Obj->alloc_func = __func__; \
+ set_type(Obj, Type); \
+ } while (0)
+#endif
+#endif
+/* needed in s7_gmp_init and s7_init, initialized in s7_init before we get to gmp */
+static s7_pointer pl_bt, pl_p, pl_bc, pcl_bc, pcl_bs, pl_bn, pl_sf, pcl_bt, pcl_i, pcl_t, pcl_r, pcl_n, pcl_s, pcl_v, pcl_f, pcl_c;
+#if (!WITH_PURE_S7)
+static s7_pointer pl_tp;
#endif
-
/* -------------------------------- multiprecision arithmetic -------------------------------- */
#if WITH_GMP
-
-static mp_prec_t mpc_precision = 128;
+static mp_prec_t mpc_precision = DEFAULT_BIGNUM_PRECISION; /* global for libs */
static mp_prec_t mpc_set_default_precision(mp_prec_t prec) {mpc_precision = prec; return(prec);}
#define mpc_init(Z) mpc_init2(Z, mpc_precision)
@@ -26163,330 +67453,143 @@ static void mpc_init_set(mpc_ptr z, mpc_ptr y, mpc_rnd_t rnd)
}
-static int big_integer_tag = 0;
-static int big_ratio_tag = 0;
-static int big_real_tag = 0;
-static int big_complex_tag = 0;
-
-#define BIG_INTEGER(a) (*((mpz_t *)a))
-#define BIG_RATIO(a) (*((mpq_t *)a))
-#define BIG_REAL(a) (*((mpfr_t *)a))
-#define BIG_COMPLEX(a) (*((mpc_t *)a))
-
-#define S7_BIG_INTEGER(a) (*((mpz_t *)s7_object_value(a)))
-#define S7_BIG_RATIO(a) (*((mpq_t *)s7_object_value(a)))
-#define S7_BIG_REAL(a) (*((mpfr_t *)s7_object_value(a)))
-#define S7_BIG_COMPLEX(a) (*((mpc_t *)s7_object_value(a)))
-
-#define IS_BIG(p) ((is_c_object(p)) && \
- ((c_object_type(p) == big_integer_tag) || \
- (c_object_type(p) == big_ratio_tag) || \
- (c_object_type(p) == big_real_tag) || \
- (c_object_type(p) == big_complex_tag)))
-
-
-mpfr_t *s7_big_real(s7_pointer x)
-{
- return((mpfr_t *)s7_object_value(x));
-}
-
-
-mpz_t *s7_big_integer(s7_pointer x)
-{
- return((mpz_t *)s7_object_value(x));
-}
-
-
-mpq_t *s7_big_ratio(s7_pointer x)
-{
- return((mpq_t *)s7_object_value(x));
-}
-
-
-mpc_t *s7_big_complex(s7_pointer x)
-{
- return((mpc_t *)s7_object_value(x));
-}
-
-
-bool s7_is_number(s7_pointer p)
-{
- return((type(p) == T_NUMBER) || (IS_BIG(p)));
-}
-
-
-bool s7_is_integer(s7_pointer p)
-{
- return(((type(p) == T_NUMBER) &&
- (number_type(p) == NUM_INT)) ||
- ((is_c_object(p)) &&
- (c_object_type(p) == big_integer_tag)));
-}
-
-
-bool s7_is_real(s7_pointer p)
-{
- return(((type(p) == T_NUMBER) &&
- (number_type(p) < NUM_COMPLEX)) ||
- ((is_c_object(p)) &&
- ((c_object_type(p) == big_integer_tag) ||
- (c_object_type(p) == big_ratio_tag) ||
- (c_object_type(p) == big_real_tag))));
-}
-
-
-bool s7_is_rational(s7_pointer p)
-{
- return(((type(p) == T_NUMBER) &&
- (number_type(p) <= NUM_RATIO)) ||
- ((is_c_object(p)) &&
- ((c_object_type(p) == big_integer_tag) ||
- (c_object_type(p) == big_ratio_tag))));
-}
-
-
-bool s7_is_ratio(s7_pointer p)
-{
- return(((type(p) == T_NUMBER) &&
- (number_type(p) == NUM_RATIO)) ||
- ((is_c_object(p)) &&
- (c_object_type(p) == big_ratio_tag)));
-}
-
-
-bool s7_is_complex(s7_pointer p)
-{
- return(s7_is_number(p));
-}
-
-
-static char *print_big_integer(s7_scheme *sc, void *val) /* the s7_scheme pointer is needed because this is used as the print function in a c_object */
-{
- return(mpz_get_str(NULL, 10, BIG_INTEGER(val)));
-}
-
-
-static char *print_big_ratio(s7_scheme *sc, void *val)
-{
- return(mpq_get_str(NULL, 10, BIG_RATIO(val)));
-}
-
+mpfr_t *s7_big_real(s7_pointer x) {return(&big_real(x));}
+mpz_t *s7_big_integer(s7_pointer x) {return(&big_integer(x));}
+mpq_t *s7_big_ratio(s7_pointer x) {return(&big_ratio(x));}
+mpc_t *s7_big_complex(s7_pointer x) {return(&big_complex(x));}
static char *mpfr_to_string(mpfr_t val, int radix)
{
char *str, *tmp, *str1;
mp_exp_t expptr;
int i, len, ep;
-
+
if (mpfr_zero_p(val))
return(copy_string("0.0"));
-
+
+ if (mpfr_nan_p(val))
+ return(copy_string("nan.0"));
+ if (mpfr_inf_p(val))
+ {
+ if (mpfr_signbit(val) == 0)
+ return(copy_string("inf.0"));
+ return(copy_string("-inf.0"));
+ }
+
str1 = mpfr_get_str(NULL, &expptr, radix, 0, val, GMP_RNDN);
+
/* 0 -> full precision, but it's too hard to make this look like C formatted output.
- *
* :(format #f "~,3F" pi)
- * "3.141592653589793238462643383279502884195E0"
+ * "3.141592653589793238462643383279502884195E0"
* :(format #f "~,3F" 1.1234567890123) ; not a bignum
* "1.123"
* :(format #f "~,3F" 1.12345678901234) ; a bignum
* "1.123456789012339999999999999999999999999E0"
- *
* but we don't know the exponent or the string length until after we call mpfr_get_str.
*/
-
str = str1;
ep = (int)expptr;
len = safe_strlen(str);
-
- if (radix <= 10)
- {
- /* remove trailing 0's */
- for (i = len - 1; i > 3; i--)
- if (str[i] != '0')
- break;
- if (i < len - 1)
- str[i + 1] = '\0';
-
- len += 64;
- tmp = (char *)malloc(len * sizeof(char));
- if (str[0] == '-')
- snprintf(tmp, len, "-%c.%sE%d", str[1], (char *)(str + 2), ep - 1);
- else snprintf(tmp, len, "%c.%sE%d", str[0], (char *)(str + 1), ep - 1);
- }
- else
- {
- /* if radix > 10, we should not be using the 'E' business -- need to move the decimal point */
- /* (number->string 1234.5678909876543212345 16) "4d2.91614dc3ab1f80e55a563311b8f308"
- * (number->string -1234.5678909876543212345 16) "-4d2.91614dc3ab1f80e55a563311b8f308"
- * (number->string 1234.5678909876543212345e8 16) "1cbe991a6a.c3f35c11868cb7e3fb75536"
- * (number->string 1234.5678909876543212345e-8 16) "0.0000cf204983a27e1eff701c562a870641e50"
- * (number->string 123456789098765432.12345e-8 16) "499602d2.fcd6e9e1748ba5adccc12c5a8"
- * (number->string 123456789098765432.1e20 16) "949b0f70beeac8895e74b18b9680000.00"
- */
- int loc = 0;
- tmp = (char *)calloc(len + ep + 64, sizeof(char));
- if (str[0] == '-')
- tmp[loc++] = (*str++);
- if (ep < 0)
- {
- ep = -ep;
- tmp[loc++] = '0';
- tmp[loc++] = '.';
- for (i = 0; i < ep; i++)
- tmp[loc++] = '0';
- }
- else
- {
- for (i = 0; i < ep; i++)
- tmp[loc++] = (*str++);
- tmp[loc++] = '.';
- }
- while (*str) tmp[loc++] = (*str++);
- }
+ /* remove trailing 0's */
+ for (i = len - 1; i > 3; i--)
+ if (str[i] != '0')
+ break;
+ if (i < len - 1)
+ str[i + 1] = '\0';
+
+ len += 64;
+ tmp = (char *)malloc(len * sizeof(char));
+
+ if (str[0] == '-')
+ snprintf(tmp, len, "-%c.%s%c%d", str[1], (char *)(str + 2), (radix <= 10) ? 'E' : '@', ep - 1);
+ else snprintf(tmp, len, "%c.%s%c%d", str[0], (char *)(str + 1), (radix <= 10) ? 'E' : '@', ep - 1);
+
mpfr_free_str(str1);
return(tmp);
}
-static char *print_big_real(s7_scheme *sc, void *val)
-{
- return(mpfr_to_string(BIG_REAL(val), 10));
-}
-
-
-static char *mpc_to_string(mpc_t val, int radix)
+static char *mpc_to_string(mpc_t val, int radix, use_write_t use_write)
{
char *rl, *im, *tmp;
int len;
- mpfr_t r;
-
- mpfr_init(r);
- mpc_real(r, val, GMP_RNDN);
- rl = mpfr_to_string(r, radix);
- mpc_imag(r, val, GMP_RNDN);
- im = mpfr_to_string(r, radix);
-
+ mpfr_t a, b;
+
+ mpfr_init(a);
+ mpc_real(a, val, GMP_RNDN);
+ rl = mpfr_to_string(a, radix);
+ mpfr_init(b);
+ mpc_imag(b, val, GMP_RNDN);
+ im = mpfr_to_string(b, radix);
+
len = safe_strlen(rl) + safe_strlen(im) + 128;
tmp = (char *)malloc(len * sizeof(char));
- snprintf(tmp, len, "%s%s%si", rl, (im[0] == '-') ? "" : "+", im);
-
- free(rl);
- free(im);
- return(tmp);
-}
-
-
-static char *print_big_complex(s7_scheme *sc, void *val)
-{
- return(mpc_to_string(BIG_COMPLEX(val), 10));
+
+ if (use_write == USE_READABLE_WRITE)
+ snprintf(tmp, len, "(complex %s %s)", rl, im);
+ else snprintf(tmp, len, "%s%s%si", rl, (im[0] == '-') ? "" : "+", im);
+
+ free(rl);
+ free(im);
+ return(tmp);
}
-static char *big_number_to_string_with_radix(s7_pointer p, int radix, int width)
+static char *big_number_to_string_with_radix(s7_pointer p, int radix, int width, int *nlen, use_write_t use_write)
{
char *str = NULL;
- if (c_object_type(p) == big_integer_tag)
- str = mpz_get_str(NULL, radix, S7_BIG_INTEGER(p));
- else
+
+ switch (type(p))
{
- if (c_object_type(p) == big_ratio_tag)
- str = mpq_get_str(NULL, radix, S7_BIG_RATIO(p));
- else
- {
- if (c_object_type(p) == big_real_tag)
- str = mpfr_to_string(S7_BIG_REAL(p), radix);
- else str = mpc_to_string(S7_BIG_COMPLEX(p), radix);
- }
+ case T_BIG_INTEGER: str = mpz_get_str(NULL, radix, big_integer(p)); break;
+ case T_BIG_RATIO: str = mpq_get_str(NULL, radix, big_ratio(p)); break;
+ case T_BIG_REAL: str = mpfr_to_string(big_real(p), radix); break;
+ default: str = mpc_to_string(big_complex(p), radix, use_write); break;
}
+
if (width > 0)
{
int len;
len = safe_strlen(str);
if (width > len)
{
- char *p1;
- p1 = pad_number(str, len, width);
- free(str);
- return(p1);
+ int spaces;
+ str = (char *)realloc(str, (width + 1) * sizeof(char));
+ spaces = width - len;
+ str[width] = '\0';
+ memmove((void *)(str + spaces), (void *)str, len);
+ memset((void *)str, (int)' ', spaces);
+ (*nlen) = width;
}
+ else (*nlen) = len;
}
+ else (*nlen) = safe_strlen(str);
return(str);
}
-static void free_big_integer(void *val)
-{
- mpz_clear(BIG_INTEGER(val));
- free(val);
-}
-
-
-static void free_big_ratio(void *val)
-{
- mpq_clear(BIG_RATIO(val));
- free(val);
-}
-
-
-static void free_big_real(void *val)
-{
- mpfr_clear(BIG_REAL(val));
- free(val);
-}
-
-
-static void free_big_complex(void *val)
-{
- mpc_clear(BIG_COMPLEX(val));
- free(val);
-}
-
-
-static bool equal_big_integer(void *val1, void *val2)
-{
- return(mpz_cmp(BIG_INTEGER(val1), BIG_INTEGER(val2)) == 0);
-}
-
-
-static bool equal_big_ratio(void *val1, void *val2)
-{
- return(mpq_cmp(BIG_RATIO(val1), BIG_RATIO(val2)) == 0);
-}
-
-
-static bool equal_big_real(void *val1, void *val2)
-{
- return(mpfr_cmp(BIG_REAL(val1), BIG_REAL(val2)) == 0);
-}
-
-
-static bool equal_big_complex(void *val1, void *val2)
-{
- return(mpc_cmp(BIG_COMPLEX(val1), BIG_COMPLEX(val2)) == 0);
-}
-
-
static bool s7_is_one_or_big_one(s7_pointer p)
{
bool result = false;
- if (!IS_BIG(p))
+
+ if (!is_big_number(p))
return(s7_is_one(p));
-
- if (c_object_type(p) == big_integer_tag)
+
+ if (is_t_big_integer(p))
{
mpz_t n;
mpz_init_set_si(n, 1);
- result = (mpz_cmp(n, BIG_INTEGER(p)) == 0);
+ result = (mpz_cmp(n, big_integer(p)) == 0);
mpz_clear(n);
}
else
{
- if (c_object_type(p) == big_real_tag)
+ if (is_t_big_real(p))
{
mpfr_t n;
mpfr_init_set_d(n, 1.0, GMP_RNDN);
- result = (mpfr_cmp(n, BIG_REAL(p)) == 0);
+ result = (mpfr_cmp(n, big_real(p)) == 0);
mpfr_clear(n);
}
}
@@ -26496,19 +67599,23 @@ static bool s7_is_one_or_big_one(s7_pointer p)
static s7_pointer string_to_big_integer(s7_scheme *sc, const char *str, int radix)
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set_str(*n, (str[0] == '+') ? (const char *)(str + 1) : str, radix);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_INTEGER);
+ add_bigint(sc, x);
+ mpz_init_set_str(big_integer(x), (str[0] == '+') ? (const char *)(str + 1) : str, radix);
+ return(x);
}
static s7_pointer mpz_to_big_integer(s7_scheme *sc, mpz_t val)
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, val);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_INTEGER);
+ add_bigint(sc, x);
+ mpz_init_set(big_integer(x), val);
+ return(x);
}
@@ -26518,39 +67625,40 @@ s7_pointer s7_make_big_integer(s7_scheme *sc, mpz_t *val)
}
-static s7_pointer copy_big_integer(s7_scheme *sc, s7_pointer obj)
-{
- return(s7_make_big_integer(sc, s7_big_integer(obj)));
-}
-
-
static s7_pointer string_to_big_ratio(s7_scheme *sc, const char *str, int radix)
{
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set_str(*n, str, radix);
- mpq_canonicalize(*n);
- if (mpz_cmp_ui(mpq_denref(*n), 1) == 0)
+ s7_pointer x;
+ mpq_t n;
+
+ mpq_init(n);
+ mpq_set_str(n, str, radix);
+ mpq_canonicalize(n);
+
+ if (mpz_cmp_ui(mpq_denref(n), 1) == 0)
+ x = mpz_to_big_integer(sc, mpq_numref(n));
+ else
{
- s7_pointer result;
- result = mpz_to_big_integer(sc, mpq_numref(*n));
- mpq_clear(*n);
- free(n);
- return(result);
+ new_cell(sc, x, T_BIG_RATIO);
+ add_bigratio(sc, x);
+ mpq_init(big_ratio(x));
+ mpq_set_num(big_ratio(x), mpq_numref(n));
+ mpq_set_den(big_ratio(x), mpq_denref(n));
}
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
+ mpq_clear(n);
+ return(x);
}
static s7_pointer mpq_to_big_ratio(s7_scheme *sc, mpq_t val)
{
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set_num(*n, mpq_numref(val));
- mpq_set_den(*n, mpq_denref(val));
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_RATIO);
+ add_bigratio(sc, x);
+ mpq_init(big_ratio(x));
+ mpq_set_num(big_ratio(x), mpq_numref(val));
+ mpq_set_den(big_ratio(x), mpq_denref(val));
+ return(x);
}
@@ -26560,103 +67668,116 @@ s7_pointer s7_make_big_ratio(s7_scheme *sc, mpq_t *val)
}
-static s7_pointer copy_big_ratio(s7_scheme *sc, s7_pointer obj)
-{
- return(s7_make_big_ratio(sc, s7_big_ratio(obj)));
-}
-
-
static s7_pointer mpz_to_big_ratio(s7_scheme *sc, mpz_t val)
{
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set_num(*n, val);
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_RATIO);
+ add_bigratio(sc, x);
+ mpq_init(big_ratio(x));
+ mpq_set_num(big_ratio(x), val);
+ return(x);
}
static s7_pointer make_big_integer_or_ratio(s7_scheme *sc, s7_pointer z)
{
- if (mpz_cmp_ui(mpq_denref(S7_BIG_RATIO(z)), 1) == 0)
- return(mpz_to_big_integer(sc, mpq_numref(S7_BIG_RATIO(z))));
+ if (mpz_cmp_ui(mpq_denref(big_ratio(z)), 1) == 0)
+ return(mpz_to_big_integer(sc, mpq_numref(big_ratio(z))));
return(z);
}
static s7_pointer string_to_big_real(s7_scheme *sc, const char *str, int radix)
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set_str(*n, str, radix, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init_set_str(big_real(x), str, radix, GMP_RNDN);
+ return(x);
}
-
-static mpq_t *s7_Ints_to_mpq(s7_Int num, s7_Int den);
+static void mpz_init_set_s7_int(mpz_t n, s7_int uval);
static s7_pointer s7_number_to_big_real(s7_scheme *sc, s7_pointer p)
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- switch (number_type(p))
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+
+ switch (type(p))
{
- case NUM_INT:
- {
- s7_Int val;
- val = s7_integer(p);
- if ((val <= S7_LONG_MAX) && (val >= S7_LONG_MIN))
- mpfr_init_set_si(*n, (int)val, GMP_RNDN);
- else mpfr_init_set_ld(*n, (long double)val, GMP_RNDN);
- }
+ case T_INTEGER:
+ if (sizeof(s7_int) == sizeof(long int))
+ mpfr_init_set_si(big_real(x), integer(p), GMP_RNDN);
+ else mpfr_init_set_ld(big_real(x), (long double)integer(p), GMP_RNDN);
break;
-
- case NUM_RATIO:
+
+ case T_RATIO:
/* here we can't use fraction(number(p)) even though that uses long double division because
* there are lots of long long int ratios that will still look the same.
* We have to do the actual bignum divide by hand.
*/
{
- mpq_t *q;
- q = s7_Ints_to_mpq(numerator(number(p)), denominator(number(p)));
- mpfr_init_set_q(*n, *q, GMP_RNDN);
- mpq_clear(*q);
- free(q);
+ mpq_t rat;
+ mpz_t n1, d1;
+
+ mpz_init_set_s7_int(n1, numerator(p));
+ mpz_init_set_s7_int(d1, denominator(p));
+ mpq_init(rat);
+
+ mpq_set_num(rat, n1);
+ mpq_set_den(rat, d1);
+ mpq_canonicalize(rat);
+ mpfr_init_set_q(big_real(x), rat, GMP_RNDN);
+
+ mpz_clear(n1);
+ mpz_clear(d1);
+ mpq_clear(rat);
}
break;
-
+
default:
- mpfr_init_set_d(*n, s7_real(p), GMP_RNDN);
+ mpfr_init_set_d(big_real(x), s7_real(p), GMP_RNDN);
break;
}
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ return(x);
}
static s7_pointer mpz_to_big_real(s7_scheme *sc, mpz_t val)
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set_z(*n, val, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init_set_z(big_real(x), val, GMP_RNDN);
+ return(x);
}
static s7_pointer mpq_to_big_real(s7_scheme *sc, mpq_t val)
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set_q(*n, val, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init_set_q(big_real(x), val, GMP_RNDN);
+ return(x);
}
static s7_pointer mpfr_to_big_real(s7_scheme *sc, mpfr_t val)
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, val, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init_set(big_real(x), val, GMP_RNDN);
+
+ return(x);
}
@@ -26666,63 +67787,67 @@ s7_pointer s7_make_big_real(s7_scheme *sc, mpfr_t *val)
}
-static s7_pointer copy_big_real(s7_scheme *sc, s7_pointer obj)
-{
- return(s7_make_big_real(sc, s7_big_real(obj)));
-}
-
-
static s7_pointer big_pi(s7_scheme *sc)
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init(*n);
- mpfr_const_pi(*n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init(big_real(x));
+ mpfr_const_pi(big_real(x), GMP_RNDN);
+ return(x);
}
static s7_pointer s7_number_to_big_complex(s7_scheme *sc, s7_pointer p)
{
- mpc_t *n;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- switch (number_type(p))
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_COMPLEX);
+ add_bignumber(sc, x);
+ mpc_init(big_complex(x));
+
+ switch (type(p))
{
- case NUM_INT:
- {
- s7_Int val;
- val = s7_integer(p);
- if ((val <= S7_LONG_MAX) && (val >= S7_LONG_MIN))
- mpc_set_si(*n, (long int)val, MPC_RNDNN);
- else mpc_set_d(*n, (double)val, MPC_RNDNN);
- }
+ case T_INTEGER:
+ if (sizeof(s7_int) == sizeof(long int))
+ mpc_set_si(big_complex(x), integer(p), MPC_RNDNN);
+ else mpc_set_d(big_complex(x), (double)integer(p), MPC_RNDNN);
break;
- case NUM_RATIO:
+ case T_RATIO:
/* can't use fraction here */
{
mpfr_t temp;
- mpq_t *q;
- q = s7_Ints_to_mpq(numerator(number(p)), denominator(number(p)));
- mpfr_init_set_q(temp, *q, GMP_RNDN);
- mpc_set_fr(*n, temp, MPC_RNDNN);
+ mpq_t rat;
+ mpz_t n1, d1;
+
+ mpz_init_set_s7_int(n1, numerator(p));
+ mpz_init_set_s7_int(d1, denominator(p));
+ mpq_init(rat);
+
+ mpq_set_num(rat, n1);
+ mpq_set_den(rat, d1);
+ mpq_canonicalize(rat);
+ mpfr_init_set_q(temp, rat, GMP_RNDN);
+ mpc_set_fr(big_complex(x), temp, MPC_RNDNN);
+
+ mpz_clear(n1);
+ mpz_clear(d1);
+ mpq_clear(rat);
mpfr_clear(temp);
- mpq_clear(*q);
- free(q);
}
break;
- case NUM_REAL:
- case NUM_REAL2:
- mpc_set_d(*n, s7_real(p), MPC_RNDNN);
+ case T_REAL:
+ mpc_set_d(big_complex(x), s7_real(p), MPC_RNDNN);
break;
default:
- mpc_set_d_d(*n, complex_real_part(p), complex_imag_part(p), MPC_RNDNN);
+ mpc_set_d_d(big_complex(x), real_part(p), imag_part(p), MPC_RNDNN);
break;
}
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ return(x);
}
@@ -26730,308 +67855,183 @@ static s7_pointer make_big_real_or_complex(s7_scheme *sc, s7_pointer z)
{
double ipart;
- ipart = mpfr_get_d(mpc_imagref(S7_BIG_COMPLEX(z)), GMP_RNDN);
+ ipart = mpfr_get_d(mpc_imagref(big_complex(z)), GMP_RNDN);
/* not mpfr_cmp_ui to 0 here because that misleads us when imag_part is NaN or inf */
if (ipart == 0.0)
- {
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, mpc_realref(S7_BIG_COMPLEX(z)), GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
- }
+ return(mpfr_to_big_real(sc, mpc_realref(big_complex(z))));
return(z);
}
static s7_pointer mpz_to_big_complex(s7_scheme *sc, mpz_t val)
{
- mpc_t *n;
mpfr_t temp;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_COMPLEX);
+ add_bignumber(sc, x);
+ mpc_init(big_complex(x));
mpfr_init_set_z(temp, val, GMP_RNDN);
- mpc_set_fr(*n, temp, MPC_RNDNN);
+ mpc_set_fr(big_complex(x), temp, MPC_RNDNN);
+
mpfr_clear(temp);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ return(x);
}
static s7_pointer mpq_to_big_complex(s7_scheme *sc, mpq_t val)
{
- mpc_t *n;
mpfr_t temp;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpfr_init_set_q(temp, val, GMP_RNDN);
- mpc_set_fr(*n, temp, MPC_RNDNN);
- mpfr_clear(temp);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
-}
-
-
-static s7_pointer mpfr_to_big_complex(s7_scheme *sc, mpfr_t val)
-{
- mpc_t *n;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set_fr(*n, val, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
-}
-
-
-static s7_pointer mpc_to_big_complex(s7_scheme *sc, mpc_t val)
-{
- mpc_t *n;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set(*n, val, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
-}
-
-
-s7_pointer s7_make_big_complex(s7_scheme *sc, mpc_t *val)
-{
- return(mpc_to_big_complex(sc, *val));
-}
-
-
-static s7_pointer copy_big_complex(s7_scheme *sc, s7_pointer obj)
-{
- return(s7_make_big_complex(sc, s7_big_complex(obj)));
-}
-
-
-static s7_pointer make_big_complex(s7_scheme *sc, mpfr_t rl, mpfr_t im)
-{
- /* there is no mpc_get_str equivalent, so we need to split up str,
- * use make_big_real to get the 2 halves, then mpc_init, then
- * mpc_set_fr_fr.
- */
- mpc_t *n;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set_fr_fr(*n, rl ,im, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
-}
-
-
-/* gmp.h mpz_init_set_si the "si" part is "signed long int", so in the 64-bit case,
- * s7_Int already fits. I guess we can catch this (since no configure script)
- * by noticing that sizeof(s7_Int) == sizeof(long int).
- */
-
-static void mpz_init_set_s7_Int(mpz_t n, s7_Int uval)
-{
- if (sizeof(s7_Int) == sizeof(long int))
- mpz_init_set_si(n, uval);
- else
- {
- if ((uval <= S7_LONG_MAX) && (uval >= S7_LONG_MIN))
- mpz_init_set_si(n, (int)uval);
- else
- { /* long long int to gmp mpz_t */
- bool need_sign;
- long long int val;
- val = (long long int)uval;
- /* handle one special case (sigh) */
- if (val == S7_LLONG_MIN)
- mpz_init_set_str(n, "-9223372036854775808", 10);
- else
- {
- need_sign = (val < 0);
- if (need_sign) val = -val;
- mpz_init_set_si(n, val >> 32);
- mpz_mul_2exp(n, n, 32);
- mpz_add_ui(n, n, (unsigned int)(val & 0xffffffff));
- if (need_sign) mpz_neg(n, n);
- }
- }
- }
-}
-
-
-static s7_pointer s7_Int_to_big_integer(s7_scheme *sc, s7_Int val)
-{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set_s7_Int(*n, val);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
-}
-
-
-static s7_Int big_integer_to_s7_Int(mpz_t n)
-{
- long long int high, low;
- mpz_t x;
- bool need_sign = false;
-
- if (sizeof(s7_Int) == sizeof(long int))
- return(mpz_get_si(n));
-
- if (mpz_fits_sint_p(n))
- return((s7_Int)mpz_get_si(n));
- /* special case as always is most-negative-fixnum */
-
- mpz_init_set(x, n);
- if (mpz_cmp_ui(x, 0) < 0)
- {
- need_sign = true;
- mpz_neg(x, x);
- }
- low = mpz_get_ui(x);
- if (low == S7_LLONG_MIN)
- return(S7_LLONG_MIN);
-
- mpz_fdiv_q_2exp(x, x, 32);
- high = mpz_get_ui(x);
- mpz_clear(x);
- if (need_sign)
- return(-(low + (high << 32)));
- return(low + (high << 32));
-}
-
-/* (expt 1/2 9223372036854775807) */
-
-
-s7_Double s7_number_to_real(s7_pointer x)
-{
- if (!s7_is_number(x))
- return(0.0);
-
- if (is_c_object(x))
- {
- if (c_object_type(x) == big_real_tag)
- return((s7_Double)mpfr_get_d(S7_BIG_REAL(x), GMP_RNDN));
- if (c_object_type(x) == big_integer_tag)
- return((s7_Double)big_integer_to_s7_Int(S7_BIG_INTEGER(x)));
- if (c_object_type(x) == big_ratio_tag)
- return((s7_Double)((double)big_integer_to_s7_Int(mpq_numref(S7_BIG_RATIO(x))) / (double)big_integer_to_s7_Int(mpq_denref(S7_BIG_RATIO(x)))));
- }
-
- switch (number_type(x))
- {
- case NUM_INT: return((s7_Double)s7_integer(x));
- case NUM_RATIO: return((s7_Double)s7_numerator(x) / (s7_Double)s7_denominator(x));
- case NUM_REAL:
- case NUM_REAL2: return(s7_real(x));
- default: return(complex_real_part(x));
- }
-}
-
+ s7_pointer x;
-s7_Int s7_number_to_integer(s7_pointer x)
-{
- if (is_c_object(x))
- {
- if (c_object_type(x) == big_integer_tag)
- return(big_integer_to_s7_Int(S7_BIG_INTEGER(x)));
- if (c_object_type(x) == big_real_tag)
- return((s7_Int)mpfr_get_d(S7_BIG_REAL(x), GMP_RNDN));
- if (c_object_type(x) == big_ratio_tag)
- return((s7_Int)((double)big_integer_to_s7_Int(mpq_numref(S7_BIG_RATIO(x))) / (double)big_integer_to_s7_Int(mpq_denref(S7_BIG_RATIO(x)))));
- }
+ new_cell(sc, x, T_BIG_COMPLEX);
+ add_bignumber(sc, x);
+ mpc_init(big_complex(x));
+ mpfr_init_set_q(temp, val, GMP_RNDN);
+ mpc_set_fr(big_complex(x), temp, MPC_RNDNN);
- switch (number_type(x))
- {
- case NUM_INT: return(s7_integer(x));
- case NUM_RATIO: return((s7_Int)s7_numerator(x) / (s7_Double)s7_denominator(x));
- case NUM_REAL:
- case NUM_REAL2: return((s7_Int)s7_real(x));
- default: return((s7_Int)complex_real_part(x));
- }
+ mpfr_clear(temp);
+ return(x);
}
-s7_Int s7_numerator(s7_pointer x)
+static s7_pointer mpfr_to_big_complex(s7_scheme *sc, mpfr_t val)
{
- if (is_c_object(x))
- {
- if (c_object_type(x) == big_ratio_tag)
- return(big_integer_to_s7_Int(mpq_numref(S7_BIG_RATIO(x))));
- if (c_object_type(x) == big_integer_tag)
- return(big_integer_to_s7_Int(S7_BIG_INTEGER(x)));
- }
- if (number_type(x) == NUM_RATIO)
- return(numerator(number(x)));
- return(integer(number(x)));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_COMPLEX);
+ add_bignumber(sc, x);
+ mpc_init(big_complex(x));
+ mpc_set_fr(big_complex(x), val, MPC_RNDNN);
+ return(x);
}
-s7_Int s7_denominator(s7_pointer x)
+static s7_pointer mpc_to_big_complex(s7_scheme *sc, mpc_t val)
{
- if (is_c_object(x))
- {
- if (c_object_type(x) != big_ratio_tag)
- return(1);
- return(big_integer_to_s7_Int(mpq_denref(S7_BIG_RATIO(x))));
- }
- if (number_type(x) == NUM_RATIO)
- return(denominator(number(x)));
- return(1);
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_COMPLEX);
+ add_bignumber(sc, x);
+ mpc_init(big_complex(x));
+ mpc_set(big_complex(x), val, MPC_RNDNN);
+ return(x);
}
-s7_Double s7_real_part(s7_pointer x)
+s7_pointer s7_make_big_complex(s7_scheme *sc, mpc_t *val)
{
- if (is_c_object(x))
- {
- if (c_object_type(x) == big_complex_tag)
- return((s7_Double)mpfr_get_d(mpc_realref(S7_BIG_COMPLEX(x)), GMP_RNDN));
+ return(mpc_to_big_complex(sc, *val));
+}
- if (c_object_type(x) == big_real_tag)
- return((s7_Double)mpfr_get_d(S7_BIG_REAL(x), GMP_RNDN));
- if (c_object_type(x) == big_integer_tag)
- return((s7_Double)big_integer_to_s7_Int(S7_BIG_INTEGER(x)));
+static s7_pointer make_big_complex(s7_scheme *sc, mpfr_t rl, mpfr_t im)
+{
+ /* there is no mpc_get_str equivalent, so we need to split up str,
+ * use make_big_real to get the 2 halves, then mpc_init, then
+ * mpc_set_fr_fr.
+ */
+ s7_pointer x;
- if (c_object_type(x) == big_ratio_tag)
- return((s7_Double)((double)big_integer_to_s7_Int(mpq_numref(S7_BIG_RATIO(x))) / (double)big_integer_to_s7_Int(mpq_denref(S7_BIG_RATIO(x)))));
- }
- return(num_to_real_part(number(x)));
+ new_cell(sc, x, T_BIG_COMPLEX);
+ add_bignumber(sc, x);
+ mpc_init(big_complex(x));
+ mpc_set_fr_fr(big_complex(x), rl ,im, MPC_RNDNN);
+ return(x);
}
-s7_Double s7_imag_part(s7_pointer x)
+/* gmp.h mpz_init_set_si the "si" part is "signed long int", so in 64-bit machines, s7_int already fits (if it's long long int).
+ * I guess we can catch the 4-byte long int (since no configure script) by noticing that sizeof(s7_int) == sizeof(long int)?
+ */
+
+static void mpz_init_set_s7_int(mpz_t n, s7_int uval)
{
- if (is_c_object(x))
+ if (sizeof(s7_int) == sizeof(long int))
+ mpz_init_set_si(n, uval);
+ else
{
- if (c_object_type(x) == big_complex_tag)
- return((s7_Double)mpfr_get_d(mpc_imagref(S7_BIG_COMPLEX(x)), GMP_RNDN));
- return(0.0);
+ /* long long int to gmp mpz_t */
+ bool need_sign;
+ long long int val;
+ val = (long long int)uval;
+ /* handle one special case (sigh) */
+ if (val == s7_int_min)
+ mpz_init_set_str(n, "-9223372036854775808", 10);
+ else
+ {
+ need_sign = (val < 0);
+ if (need_sign) val = -val;
+ mpz_init_set_si(n, val >> 32);
+ mpz_mul_2exp(n, n, 32);
+ mpz_add_ui(n, n, (unsigned int)(val & 0xffffffff));
+ if (need_sign) mpz_neg(n, n);
+ }
}
- return(num_to_imag_part(number(x)));
}
-s7_Int s7_integer(s7_pointer p)
+static s7_pointer s7_int_to_big_integer(s7_scheme *sc, s7_int val)
{
- if (is_c_object(p))
- return(big_integer_to_s7_Int(S7_BIG_INTEGER(p)));
- return(integer(number(p)));
+ s7_pointer x;
+
+ new_cell(sc, x, T_BIG_INTEGER);
+ add_bigint(sc, x);
+ mpz_init_set_s7_int(big_integer(x), val);
+ return(x);
}
-s7_Double s7_real(s7_pointer p)
+static s7_int big_integer_to_s7_int(mpz_t n)
{
- if (is_c_object(p))
- return((s7_Double)mpfr_get_d(S7_BIG_REAL(p), GMP_RNDN));
- return(real(number(p)));
+ long long int high, low;
+ mpz_t x;
+ bool need_sign = false;
+
+ if (mpz_fits_slong_p(n))
+ return(mpz_get_si(n));
+
+ if ((hidden_sc->safety > 0) &&
+ (sizeof(s7_int) == sizeof(long int)))
+ {
+ char *str;
+ str = mpz_get_str(NULL, 10, n);
+ s7_warn(hidden_sc, 256, "can't convert %s to s7_int\n", str);
+ free(str);
+ }
+
+ mpz_init_set(x, n);
+ if (mpz_cmp_ui(x, 0) < 0)
+ {
+ need_sign = true;
+ mpz_neg(x, x);
+ }
+ low = mpz_get_ui(x);
+ if (low == s7_int_min)
+ return(s7_int_min);
+
+ mpz_fdiv_q_2exp(x, x, 32);
+ high = mpz_get_ui(x);
+ mpz_clear(x);
+ if (need_sign)
+ return(-(low + (high << 32)));
+ return(low + (high << 32));
}
-static mpq_t *s7_Ints_to_mpq(s7_Int num, s7_Int den)
+static mpq_t *s7_ints_to_mpq(s7_int num, s7_int den)
{
+ /* den here always comes from denominator(x) so it is not negative */
mpq_t *n;
n = (mpq_t *)malloc(sizeof(mpq_t));
mpq_init(*n);
- if ((num <= S7_LONG_MAX) && (num >= S7_LONG_MIN) &&
- (den <= S7_LONG_MAX) && (den >= S7_LONG_MIN))
- mpq_set_si(*n, (long int)num, (long int)den);
+ if (sizeof(s7_int) == sizeof(long int))
+ mpq_set_si(*n, num, den);
else
{
mpz_t n1, d1;
- mpz_init_set_s7_Int(n1, num);
- mpz_init_set_s7_Int(d1, den);
+ mpz_init_set_s7_int(n1, num);
+ mpz_init_set_s7_int(d1, den);
mpq_set_num(*n, n1);
mpq_set_den(*n, d1);
mpq_canonicalize(*n);
@@ -27042,7 +68042,7 @@ static mpq_t *s7_Ints_to_mpq(s7_Int num, s7_Int den)
}
-static mpfr_t *s7_Double_to_mpfr(s7_Double val)
+static mpfr_t *s7_double_to_mpfr(s7_double val)
{
mpfr_t *n;
n = (mpfr_t *)malloc(sizeof(mpfr_t));
@@ -27051,7 +68051,7 @@ static mpfr_t *s7_Double_to_mpfr(s7_Double val)
}
-static mpc_t *s7_Doubles_to_mpc(s7_Double rl, s7_Double im)
+static mpc_t *s7_doubles_to_mpc(s7_double rl, s7_double im)
{
mpc_t *n;
n = (mpc_t *)malloc(sizeof(mpc_t));
@@ -27061,33 +68061,50 @@ static mpc_t *s7_Doubles_to_mpc(s7_Double rl, s7_Double im)
}
-static s7_pointer s7_ratio_to_big_ratio(s7_scheme *sc, s7_Int num, s7_Int den)
+static s7_pointer s7_ratio_to_big_ratio(s7_scheme *sc, s7_int num, s7_int den)
{
- return(s7_make_object(sc, big_ratio_tag, (void *)s7_Ints_to_mpq(num, den)));
+ /* den here always comes from denominator(x) or some positive constant so it is not negative */
+ s7_pointer x;
+ new_cell(sc, x, T_BIG_RATIO);
+ add_bigratio(sc, x);
+ mpq_init(big_ratio(x));
+ if (sizeof(s7_int) == sizeof(long int))
+ mpq_set_si(big_ratio(x), num, den);
+ else
+ {
+ mpz_t n1, d1;
+ mpz_init_set_s7_int(n1, num);
+ mpz_init_set_s7_int(d1, den);
+ mpq_set_num(big_ratio(x), n1);
+ mpq_set_den(big_ratio(x), d1);
+ mpq_canonicalize(big_ratio(x));
+ mpz_clear(n1);
+ mpz_clear(d1);
+ }
+ return(x);
}
static bool big_numbers_are_eqv(s7_pointer a, s7_pointer b)
{
bool result;
- if ((!is_c_object(a)) && (!is_c_object(b))) /* either or both can be big here, but not neither */
- return(false);
-
+ /* either or both can be big here, but not neither */
+
if (s7_is_integer(a))
{
mpz_t a1, b1;
if (!(s7_is_integer(b))) return(false);
- if ((is_c_object(a)) && (is_c_object(b)))
- return(mpz_cmp(S7_BIG_INTEGER(a), S7_BIG_INTEGER(b)) == 0);
+ if ((is_big_number(a)) && (is_big_number(b)))
+ return(mpz_cmp(big_integer(a), big_integer(b)) == 0);
- if (is_c_object(a))
- mpz_init_set(a1, S7_BIG_INTEGER(a));
- else mpz_init_set_s7_Int(a1, s7_integer(a));
+ if (is_big_number(a))
+ mpz_init_set(a1, big_integer(a));
+ else mpz_init_set_s7_int(a1, s7_integer(a));
- if (is_c_object(b))
- mpz_init_set(b1, S7_BIG_INTEGER(b));
- else mpz_init_set_s7_Int(b1, s7_integer(b));
+ if (is_big_number(b))
+ mpz_init_set(b1, big_integer(b));
+ else mpz_init_set_s7_int(b1, s7_integer(b));
result = (mpz_cmp(a1, b1) == 0);
mpz_clear(a1);
@@ -27100,24 +68117,24 @@ static bool big_numbers_are_eqv(s7_pointer a, s7_pointer b)
mpq_t *a1, *b1;
if (!s7_is_ratio(b)) return(false);
- if ((is_c_object(a)) && (is_c_object(b)))
- return(mpq_cmp(S7_BIG_RATIO(a), S7_BIG_RATIO(b)) == 0);
+ if ((is_big_number(a)) && (is_big_number(b)))
+ return(mpq_cmp(big_ratio(a), big_ratio(b)) == 0);
- if (is_c_object(a))
- a1 = (mpq_t *)s7_object_value(a);
- else a1 = s7_Ints_to_mpq(s7_numerator(a), s7_denominator(a));
- if (is_c_object(b))
- b1 = (mpq_t *)s7_object_value(b);
- else b1 = s7_Ints_to_mpq(s7_numerator(b), s7_denominator(b));
+ if (is_big_number(a))
+ a1 = &big_ratio(a);
+ else a1 = s7_ints_to_mpq(numerator(a), denominator(a));
+ if (is_big_number(b))
+ b1 = &big_ratio(b);
+ else b1 = s7_ints_to_mpq(numerator(b), denominator(b));
result = (mpq_cmp(*a1, *b1) == 0);
- if (!is_c_object(a))
+ if (!is_big_number(a))
{
mpq_clear(*a1);
free(a1);
}
- if (!is_c_object(b))
+ if (!is_big_number(b))
{
mpq_clear(*b1);
free(b1);
@@ -27130,37 +68147,36 @@ static bool big_numbers_are_eqv(s7_pointer a, s7_pointer b)
mpfr_t *a1, *b1;
/* s7_is_real is not finicky enough here -- (eqv? 1.0 1) should return #f */
- if (is_c_object(b))
+ if (is_big_number(b))
{
- if (c_object_type(b) != big_real_tag)
+ if (type(b) != T_BIG_REAL)
return(false);
}
else
{
- if ((number_type(b) != NUM_REAL) &&
- (number_type(b) != NUM_REAL2))
+ if (type(b) != T_REAL)
return(false);
}
- if ((is_c_object(a)) && (is_c_object(b)))
- return(mpfr_equal_p(S7_BIG_REAL(a), S7_BIG_REAL(b)));
+ if ((is_big_number(a)) && (is_big_number(b)))
+ return(mpfr_equal_p(big_real(a), big_real(b)));
- if (is_c_object(a))
- a1 = (mpfr_t *)s7_object_value(a);
- else a1 = s7_Double_to_mpfr(s7_real(a));
+ if (is_big_number(a))
+ a1 = &big_real(a);
+ else a1 = s7_double_to_mpfr(s7_real(a));
- if (is_c_object(b))
- b1 = (mpfr_t *)s7_object_value(b);
- else b1 = s7_Double_to_mpfr(s7_real(b));
+ if (is_big_number(b))
+ b1 = &big_real(b);
+ else b1 = s7_double_to_mpfr(s7_real(b));
result = (mpfr_cmp(*a1, *b1) == 0);
- if (!is_c_object(a))
+ if (!is_big_number(a))
{
mpfr_clear(*a1);
free(a1);
}
- if (!is_c_object(b))
+ if (!is_big_number(b))
{
mpfr_clear(*b1);
free(b1);
@@ -27172,63 +68188,57 @@ static bool big_numbers_are_eqv(s7_pointer a, s7_pointer b)
{
mpc_t *a1, *b1;
/* s7_is_complex is not finicky enough here */
- if (is_c_object(b))
- {
- if (c_object_type(b) != big_complex_tag)
- return(false);
- }
- else
- {
- if (number_type(b) < NUM_COMPLEX)
- return(false);
- }
- if ((is_c_object(a)) && (is_c_object(b)))
- return(mpc_cmp(S7_BIG_COMPLEX(a), S7_BIG_COMPLEX(b)) == 0);
+ if ((type(b) != T_BIG_COMPLEX) &&
+ (type(b) != T_COMPLEX))
+ return(false);
+
+ /* (eqv? (bignum "1+i") 1+1i) */
+ if ((is_big_number(a)) && (is_big_number(b)))
+ return(mpc_cmp(big_complex(a), big_complex(b)) == 0);
- if (is_c_object(a))
- a1 = (mpc_t *)s7_object_value(a);
- else a1 = s7_Doubles_to_mpc(complex_real_part(a), complex_imag_part(a));
+ if (is_big_number(a))
+ a1 = &big_complex(a);
+ else a1 = s7_doubles_to_mpc(real_part(a), imag_part(a));
- if (is_c_object(b))
- b1 = (mpc_t *)s7_object_value(b);
- else b1 = s7_Doubles_to_mpc(complex_real_part(b), complex_imag_part(b));
+ if (is_big_number(b))
+ b1 = &big_complex(b);
+ else b1 = s7_doubles_to_mpc(real_part(b), imag_part(b));
result = (mpc_cmp(*a1, *b1) == 0);
- if (!is_c_object(a))
+ if (!is_big_number(a))
{
mpc_clear(*a1);
free(a1);
}
- if (!is_c_object(b))
+ if (!is_big_number(b))
{
mpc_clear(*b1);
free(b1);
}
return(result);
}
-
return(false);
}
static s7_pointer string_to_either_integer(s7_scheme *sc, const char *str, int radix)
{
- s7_Int val;
+ s7_int val;
bool overflow = false;
val = string_to_integer(str, radix, &overflow);
if (!overflow)
- return(s7_make_integer(sc, val));
-
+ return(make_integer(sc, val));
+
return(string_to_big_integer(sc, str, radix));
}
static s7_pointer string_to_either_ratio(s7_scheme *sc, const char *nstr, const char *dstr, int radix)
{
- s7_Int n, d;
+ s7_int n, d;
bool overflow = false;
/* gmp segfaults if passed a bignum/0 so this needs to check first that
@@ -27239,7 +68249,7 @@ static s7_pointer string_to_either_ratio(s7_scheme *sc, const char *nstr, const
if (!overflow)
{
if (d == 0)
- return(s7_make_real(sc, NAN));
+ return(real_NaN);
n = string_to_integer(nstr, radix, &overflow);
if (!overflow)
@@ -27254,20 +68264,20 @@ static s7_pointer string_to_either_ratio(s7_scheme *sc, const char *nstr, const
static s7_pointer string_to_either_real(s7_scheme *sc, const char *str, int radix)
{
bool overflow = false;
- s7_Double val;
+ s7_double val;
val = string_to_double_with_radix((char *)str, radix, &overflow);
if (!overflow)
- return(s7_make_real(sc, val));
+ return(make_real(sc, val));
return(string_to_big_real(sc, str, radix));
}
-static s7_pointer string_to_either_complex_1(s7_scheme *sc, char *q, char *slash1, char *ex1, bool has_dec_point1, int radix, s7_Double *d_rl)
+static s7_pointer string_to_either_complex_1(s7_scheme *sc, char *q, char *slash1, char *ex1, bool has_dec_point1, int radix, s7_double *d_rl)
{
bool overflow = false;
- /* there's a real problem here -- we don't want to promote s7_Double .1 to a bignum because
+ /* there's a real problem here -- we don't want to promote s7_double .1 to a bignum because
* its low order digits are garbage, causing (rationalize .1 0) to return 3602879701896397/36028797018963968
* no matter what the bignum-precision. But we can't just fallback on gmp's reader because (for example)
* it reads 1/2+i or 1+0/0i as 1.0. Also format gets screwed up. And string->number signals an error
@@ -27284,7 +68294,7 @@ static s7_pointer string_to_either_complex_1(s7_scheme *sc, char *q, char *slash
{
if (slash1)
{
- s7_Int n, d;
+ s7_int n, d;
/* q can include the slash and denominator */
n = string_to_integer(q, radix, &overflow);
@@ -27294,29 +68304,28 @@ static s7_pointer string_to_either_complex_1(s7_scheme *sc, char *q, char *slash
{
d = string_to_integer(slash1, radix, &overflow);
if (!overflow)
- (*d_rl) = (s7_Double)n / (s7_Double)d;
+ (*d_rl) = (s7_double)n / (s7_double)d;
else return(string_to_big_ratio(sc, q, radix));
}
}
else
{
- s7_Int val;
+ s7_int val;
val = string_to_integer(q, radix, &overflow);
if (overflow)
return(string_to_big_integer(sc, q, radix));
- (*d_rl) = (s7_Double)val;
+ (*d_rl) = (s7_double)val;
}
}
if ((*d_rl) == -0.0) (*d_rl) = 0.0;
-
return(NULL);
}
static s7_pointer string_to_either_complex(s7_scheme *sc,
- char *q, char *slash1, char *ex1, bool has_dec_point1,
- char *plus, char *slash2, char *ex2, bool has_dec_point2,
+ char *q, char *slash1, char *ex1, bool has_dec_point1,
+ char *plus, char *slash2, char *ex2, bool has_dec_point2,
int radix, int has_plus_or_minus)
{
/* this can be just about anything involving 2 real/ratio/int portions, +/- in between and 'i' at the end */
@@ -27326,16 +68335,15 @@ static s7_pointer string_to_either_complex(s7_scheme *sc,
p_rl = string_to_either_complex_1(sc, q, slash1, ex1, has_dec_point1, radix, &d_rl);
p_im = string_to_either_complex_1(sc, plus, slash2, ex2, has_dec_point2, radix, &d_im);
-
- /* fprintf(stderr, "%p %f %p %f\n", p_rl, d_rl, p_im, d_im); */
+
if (d_im == 0.0)
{
/* 1.0+0.0000000000000000000000000000i */
if ((!p_im) ||
- (big_is_zero_1(sc, p_im) == sc->T))
+ (s7_is_zero(p_im)))
{
if (!p_rl)
- return(s7_make_real(sc, d_rl));
+ return(make_real(sc, d_rl));
return(p_rl);
}
}
@@ -27344,72 +68352,52 @@ static s7_pointer string_to_either_complex(s7_scheme *sc,
return(s7_make_complex(sc, d_rl, (has_plus_or_minus == -1) ? (-d_im) : d_im));
if (p_rl)
- mpfr_init_set(m_rl, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p_rl)), GMP_RNDN);
+ mpfr_init_set(m_rl, big_real(promote_number(sc, T_BIG_REAL, p_rl)), GMP_RNDN);
else mpfr_init_set_d(m_rl, d_rl, GMP_RNDN);
if (p_im)
- mpfr_init_set(m_im, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p_im)), GMP_RNDN);
+ mpfr_init_set(m_im, big_real(promote_number(sc, T_BIG_REAL, p_im)), GMP_RNDN);
else mpfr_init_set_d(m_im, d_im, GMP_RNDN);
- if (has_plus_or_minus == -1)
+ if (has_plus_or_minus == -1)
mpfr_neg(m_im, m_im, GMP_RNDN);
result = make_big_complex(sc, m_rl, m_im);
-
+
mpfr_clear(m_rl);
mpfr_clear(m_im);
return(result);
}
-/* object_type(bignum) can be anything (in pthreads case, we first set the various thread variable tags)
- * so we can't assume it's a very small integer. However, NUM_COMPLEX + higher bits can't be >= 8.
- */
-
-#define SHIFT_BIGNUM_TYPE(type) (1 << (type + NO_NUM_SHIFT))
-
-static int canonicalize_result_type(int type)
+static int big_type_to_result_type(int cur_type, int next_type)
{
- if (type >= SHIFT_BIGNUM_TYPE(big_complex_tag))
+ if ((cur_type == T_BIG_COMPLEX) ||
+ (cur_type == T_COMPLEX) ||
+ (next_type == T_BIG_COMPLEX))
return(T_BIG_COMPLEX);
- if (type >= SHIFT_BIGNUM_TYPE(big_real_tag))
- {
- if ((type & 0x7) >= NUM_COMPLEX)
- return(T_BIG_COMPLEX);
- return(T_BIG_REAL);
- }
-
- if (type >= SHIFT_BIGNUM_TYPE(big_ratio_tag))
- switch (type & 0x7)
- {
- case NUM_INT:
- case NUM_RATIO:
- return(T_BIG_RATIO);
-
- case NUM_REAL:
- case NUM_REAL2:
- return(T_BIG_REAL);
-
- default:
- return(T_BIG_COMPLEX);
- }
+ if ((cur_type == T_BIG_REAL) ||
+ (cur_type == T_REAL) ||
+ (next_type == T_BIG_REAL))
+ return(T_BIG_REAL);
- switch (type & 0x7)
- {
- case NUM_INT:
- return(T_BIG_INTEGER); /* NUM_INT is 0, so this includes the pure big ints case */
+ if ((cur_type == T_BIG_RATIO) ||
+ (cur_type == T_RATIO) ||
+ (next_type == T_BIG_RATIO))
+ return(T_BIG_RATIO);
- case NUM_RATIO:
- return(T_BIG_RATIO);
+ return(T_BIG_INTEGER);
+}
- case NUM_REAL:
- case NUM_REAL2:
- return(T_BIG_REAL);
- default:
- return(T_BIG_COMPLEX);
- }
+static int normal_type_to_result_type(int cur_type, int next_type)
+{
+ if (cur_type > T_COMPLEX)
+ next_type += 4;
+ if (cur_type > next_type)
+ return(cur_type);
+ return(next_type);
}
@@ -27420,61 +68408,60 @@ static s7_pointer promote_number_1(s7_scheme *sc, int type, s7_pointer x, bool c
switch (type)
{
case T_BIG_INTEGER:
- if (is_c_object(x))
+ if (is_big_number(x))
{
if (copy)
- return(mpz_to_big_integer(sc, S7_BIG_INTEGER(x)));
+ return(mpz_to_big_integer(sc, big_integer(x)));
return(x); /* can only be T_BIG_INTEGER here */
}
- return(s7_Int_to_big_integer(sc, s7_integer(x))); /* can only be NUM_INT here */
- break;
+ return(s7_int_to_big_integer(sc, s7_integer(x))); /* can only be integer here */
case T_BIG_RATIO:
- if (is_c_object(x))
+ if (is_big_number(x))
{
- if (c_object_type(x) == big_ratio_tag)
+ if (is_t_big_ratio(x))
{
if (copy)
- return(mpq_to_big_ratio(sc, S7_BIG_RATIO(x)));
+ return(mpq_to_big_ratio(sc, big_ratio(x)));
return(x);
}
- return(mpz_to_big_ratio(sc, S7_BIG_INTEGER(x)));
+ return(mpz_to_big_ratio(sc, big_integer(x)));
}
- if (number_type(x) == NUM_INT)
- return(s7_ratio_to_big_ratio(sc, s7_integer(x), 1));
- return(s7_ratio_to_big_ratio(sc, s7_numerator(x), s7_denominator(x)));
- break;
+ if (is_t_integer(x))
+ return(s7_ratio_to_big_ratio(sc, integer(x), 1));
+ return(s7_ratio_to_big_ratio(sc, numerator(x), denominator(x)));
case T_BIG_REAL:
- if (is_c_object(x))
+ if (is_big_number(x))
{
- if (c_object_type(x) == big_real_tag)
+ if (is_t_big_real(x))
{
if (copy)
- return(mpfr_to_big_real(sc, S7_BIG_REAL(x)));
+ return(mpfr_to_big_real(sc, big_real(x)));
return(x);
}
- if (c_object_type(x) == big_ratio_tag) return(mpq_to_big_real(sc, S7_BIG_RATIO(x)));
- return(mpz_to_big_real(sc, S7_BIG_INTEGER(x)));
+ if (is_t_big_ratio(x))
+ return(mpq_to_big_real(sc, big_ratio(x)));
+ return(mpz_to_big_real(sc, big_integer(x)));
}
return(s7_number_to_big_real(sc, x));
- break;
default:
- if (is_c_object(x))
+ if (is_big_number(x))
{
- if (c_object_type(x) == big_complex_tag)
+ if (is_t_big_complex(x))
{
if (copy)
- return(mpc_to_big_complex(sc, S7_BIG_COMPLEX(x)));
+ return(mpc_to_big_complex(sc, big_complex(x)));
return(x);
}
- if (c_object_type(x) == big_real_tag) return(mpfr_to_big_complex(sc, S7_BIG_REAL(x)));
- if (c_object_type(x) == big_ratio_tag) return(mpq_to_big_complex(sc, S7_BIG_RATIO(x)));
- return(mpz_to_big_complex(sc, S7_BIG_INTEGER(x)));
+ if (is_t_big_real(x))
+ return(mpfr_to_big_complex(sc, big_real(x)));
+ if (is_t_big_ratio(x))
+ return(mpq_to_big_complex(sc, big_ratio(x)));
+ return(mpz_to_big_complex(sc, big_integer(x)));
}
return(s7_number_to_big_complex(sc, x));
- break;
}
return(sc->NIL);
}
@@ -27488,22 +68475,14 @@ static s7_pointer promote_number(s7_scheme *sc, int type, s7_pointer x)
static s7_pointer to_big(s7_scheme *sc, s7_pointer x)
{
- if (IS_BIG(x))
+ if (is_big_number(x))
return(x);
- switch (number_type(x))
+ switch (type(x))
{
- case NUM_INT:
- return(s7_Int_to_big_integer(sc, s7_integer(x)));
-
- case NUM_RATIO:
- return(s7_ratio_to_big_ratio(sc, s7_numerator(x), s7_denominator(x)));
-
- case NUM_REAL:
- case NUM_REAL2:
- return(s7_number_to_big_real(sc, x));
-
- default:
- return(s7_number_to_big_complex(sc, x));
+ case T_INTEGER: return(s7_int_to_big_integer(sc, integer(x)));
+ case T_RATIO: return(s7_ratio_to_big_ratio(sc, numerator(x), denominator(x)));
+ case T_REAL: return(s7_number_to_big_real(sc, x));
+ default: return(s7_number_to_big_complex(sc, x));
}
}
@@ -27514,43 +68493,32 @@ static s7_pointer copy_and_promote_number(s7_scheme *sc, int type, s7_pointer x)
}
-void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
+void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
{
- s7_Int i, len;
- s7_pointer *tp;
- len = vector_length(vec);
- tp = (s7_pointer *)(vector_elements(vec));
-
/* if the same bignum object is assigned to each element, different vector elements
* are actually the same -- we need to make a copy of obj for each one
*/
-
- if (IS_BIG(obj))
+ if ((is_normal_vector(vec)) && (is_big_number(obj)))
{
- int type, gc_loc;
+ int gc_loc;
+ s7_int i, len;
+ s7_pointer *tp;
+
+ len = vector_length(vec);
+ tp = (s7_pointer *)(vector_elements(vec));
/* we'll be calling new_cell below, hence the GC, so make sure the elements are markable,
* and the vector itself is GC protected (we can be called within make-vector).
*/
gc_loc = s7_gc_protect(sc, vec);
- vector_fill(sc, vec, sc->NIL);
+ vector_fill(sc, vec, sc->NIL);
- type = c_object_type(obj);
- for (i = 0; i < len; i++)
+ switch (type(obj))
{
- if (type == big_real_tag)
- tp[i] = mpfr_to_big_real(sc, S7_BIG_REAL(obj));
- else
- {
- if (type == big_integer_tag)
- tp[i] = mpz_to_big_integer(sc, S7_BIG_INTEGER(obj));
- else
- {
- if (type == big_complex_tag)
- tp[i] = mpc_to_big_complex(sc, S7_BIG_COMPLEX(obj));
- else tp[i] = mpq_to_big_ratio(sc, S7_BIG_RATIO(obj));
- }
- }
+ case T_BIG_INTEGER: for (i = 0; i < len; i++) tp[i] = mpz_to_big_integer(sc, big_integer(obj)); break;
+ case T_BIG_RATIO: for (i = 0; i < len; i++) tp[i] = mpq_to_big_ratio(sc, big_ratio(obj)); break;
+ case T_BIG_REAL: for (i = 0; i < len; i++) tp[i] = mpfr_to_big_real(sc, big_real(obj)); break;
+ default: for (i = 0; i < len; i++) tp[i] = mpc_to_big_complex(sc, big_complex(obj)); break;
}
s7_gc_unprotect_at(sc, gc_loc);
}
@@ -27558,121 +68526,135 @@ void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
}
-static s7_pointer g_bignum(s7_scheme *sc, s7_pointer args)
+static s7_pointer big_bignum(s7_scheme *sc, s7_pointer args)
{
#define H_bignum "(bignum val (radix 10)) returns a multiprecision version of the string 'val'"
+ #define Q_bignum s7_make_signature(sc, 3, sc->IS_BIGNUM, sc->IS_NUMBER, sc->IS_INTEGER)
s7_pointer p;
- p = g_string_to_number_1(sc, args, "bignum");
+ p = g_string_to_number_1(sc, args, sc->BIGNUM);
if (is_false(sc, p)) /* (bignum "1/3.0") */
- s7_error(sc, make_symbol(sc, "bignum-error"),
- make_list_2(sc,
- make_protected_string(sc, "bignum argument does not represent a number: ~S"),
- car(args)));
-
- if (is_c_object(p)) return(p);
+ s7_error(sc, make_symbol(sc, "bignum-error"),
+ set_elist_2(sc, make_string_wrapper(sc, "bignum argument does not represent a number: ~S"), car(args)));
- switch (number_type(p))
+ switch (type(p))
{
- case NUM_INT:
+ case T_INTEGER:
return(promote_number(sc, T_BIG_INTEGER, p));
- case NUM_RATIO:
+ case T_RATIO:
return(promote_number(sc, T_BIG_RATIO, p));
/* we can't use promote_number here because it propogates C-double inaccuracies
* (rationalize (bignum "0.1") 0) should return 1/10 not 3602879701896397/36028797018963968
*/
- case NUM_REAL:
- case NUM_REAL2:
- if (isnan(real(number(p)))) return(p);
- return(string_to_big_real(sc, s7_string(car(args)), (is_pair(cdr(args))) ? s7_integer(cadr(args)) : 10));
-
- default:
- /* PERHAPS: read complex via gmp -- does this ever matter?
- * yes: (rationalize (real-part (bignum "0.1+i")) 0) -> 3602879701896397/36028797018963968
- */
+ case T_REAL:
+ if (is_NaN(real(p))) return(p);
+ return(string_to_big_real(sc, string_value(car(args)), (is_pair(cdr(args))) ? s7_integer(cadr(args)) : 10));
+
+ case T_COMPLEX:
return(promote_number(sc, T_BIG_COMPLEX, p));
+
+ default:
+ return(p);
}
}
bool s7_is_bignum(s7_pointer obj)
{
- return(IS_BIG(obj));
+ return(is_big_number(obj));
}
-static s7_pointer g_is_bignum(s7_scheme *sc, s7_pointer args)
+static s7_pointer big_is_bignum(s7_scheme *sc, s7_pointer args)
{
#define H_is_bignum "(bignum? obj) returns #t if obj is a multiprecision number."
- return(s7_make_boolean(sc, IS_BIG(car(args))));
+ #define Q_is_bignum pl_bt
+ return(s7_make_boolean(sc, is_big_number(car(args))));
}
+#define get_result_type(Sc, Type, P) \
+ ((is_number(P)) ? normal_type_to_result_type(Type, type(p)) : ((is_big_number(P)) ? big_type_to_result_type(Type, type(p)) : result_type_via_method(Sc, Type, P)))
+
+static int result_type_via_method(s7_scheme *sc, int result_type, s7_pointer p)
+{
+ s7_pointer f;
+ if (!has_methods(p)) return(-1);
+
+ f = find_method(sc, find_let(sc, p), sc->IS_INTEGER);
+ if ((f != sc->UNDEFINED) &&
+ (is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL)))))
+ return(big_type_to_result_type(result_type, T_BIG_INTEGER));
+
+ f = find_method(sc, find_let(sc, p), sc->IS_RATIONAL);
+ if ((f != sc->UNDEFINED) &&
+ (is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL)))))
+ return(big_type_to_result_type(result_type, T_BIG_RATIO));
+
+ f = find_method(sc, find_let(sc, p), sc->IS_REAL);
+ if ((f != sc->UNDEFINED) &&
+ (is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL)))))
+ return(big_type_to_result_type(result_type, T_BIG_REAL));
+
+ /* might be a number, but not complex (quaternion) */
+ f = find_method(sc, find_let(sc, p), sc->IS_COMPLEX);
+ if ((f != sc->UNDEFINED) &&
+ (is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL)))))
+ return(big_type_to_result_type(result_type, T_BIG_COMPLEX));
+
+ return(-1);
+}
-static s7_Int add_max = 0;
static s7_pointer big_add(s7_scheme *sc, s7_pointer args)
{
- int i, result_type = NUM_INT;
+ int result_type = T_INTEGER;
s7_pointer x, result;
- if (args == sc->NIL)
+ if (is_null(args))
return(small_int(0));
- if ((cdr(args) == sc->NIL) && (s7_is_number(car(args))))
+ if ((is_null(cdr(args))) && (s7_is_number(car(args))))
return(car(args));
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
+ for (x = args; is_not_null(x); x = cdr(x))
{
s7_pointer p;
p = car(x);
- if (type(p) != T_NUMBER)
- {
- if (!IS_BIG(p))
- return(s7_wrong_type_arg_error(sc, "+", i, p, "a number"));
- else result_type |= SHIFT_BIGNUM_TYPE(c_object_type(p));
- }
- else result_type |= number_type(p);
+ result_type = get_result_type(sc, result_type, p);
+ if (result_type < 0)
+ return(g_add(sc, args));
}
- if (IS_NUM(result_type))
+ if (result_type < T_BIG_INTEGER)
return(g_add(sc, args));
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->ADD, args);
- result_type = canonicalize_result_type(result_type);
result = copy_and_promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
s7_pointer arg;
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->ADD, cons(sc, result, x));
+
arg = promote_number(sc, result_type, car(x));
+
switch (result_type)
{
- case T_BIG_INTEGER:
- mpz_add(S7_BIG_INTEGER(result), S7_BIG_INTEGER(result), S7_BIG_INTEGER(arg));
- break;
-
- case T_BIG_RATIO:
- mpq_add(S7_BIG_RATIO(result), S7_BIG_RATIO(result), S7_BIG_RATIO(arg));
- break;
-
- case T_BIG_REAL:
- mpfr_add(S7_BIG_REAL(result), S7_BIG_REAL(result), S7_BIG_REAL(arg), GMP_RNDN);
- break;
-
- case T_BIG_COMPLEX:
- mpc_add(S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(arg), MPC_RNDNN);
- break;
+ case T_BIG_INTEGER: mpz_add(big_integer(result), big_integer(result), big_integer(arg)); break;
+ case T_BIG_RATIO: mpq_add(big_ratio(result), big_ratio(result), big_ratio(arg)); break;
+ case T_BIG_REAL: mpfr_add(big_real(result), big_real(result), big_real(arg), GMP_RNDN); break;
+ case T_BIG_COMPLEX: mpc_add(big_complex(result), big_complex(result), big_complex(arg), MPC_RNDNN); break;
}
}
-
+
switch (result_type)
{
- case T_BIG_RATIO:
- return(make_big_integer_or_ratio(sc, result));
-
- case T_BIG_COMPLEX:
- return(make_big_real_or_complex(sc, result));
+ case T_BIG_RATIO: return(make_big_integer_or_ratio(sc, result));
+ case T_BIG_COMPLEX: return(make_big_real_or_complex(sc, result));
}
return(result);
}
@@ -27681,315 +68663,345 @@ static s7_pointer big_add(s7_scheme *sc, s7_pointer args)
static s7_pointer big_negate(s7_scheme *sc, s7_pointer args)
{
/* assume cdr(args) is nil and we're called from subtract, so check for big num else call g_subtract */
- s7_pointer p;
+ s7_pointer p, x;
+
p = car(args);
- if (is_c_object(p))
+ switch (type(p))
{
- if (c_object_type(p) == big_integer_tag)
- {
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, S7_BIG_INTEGER(p));
- mpz_neg(*n, *n);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
- }
+ case T_BIG_INTEGER:
+ x = mpz_to_big_integer(sc, big_integer(p));
+ mpz_neg(big_integer(x), big_integer(x));
+ return(x);
- if (c_object_type(p) == big_ratio_tag)
- {
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set(*n, S7_BIG_RATIO(p));
- mpq_neg(*n, *n);
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
- }
+ case T_BIG_RATIO:
+ x = mpq_to_big_ratio(sc, big_ratio(p));
+ mpq_neg(big_ratio(x), big_ratio(x));
+ return(x);
- if (c_object_type(p) == big_real_tag)
- {
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p), GMP_RNDN);
- mpfr_neg(*n, *n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
- }
+ case T_BIG_REAL:
+ x = mpfr_to_big_real(sc, big_real(p));
+ mpfr_neg(big_real(x), big_real(x), GMP_RNDN);
+ return(x);
- if (c_object_type(p) == big_complex_tag)
+ case T_BIG_COMPLEX:
+ x = mpc_to_big_complex(sc, big_complex(p));
+ mpc_neg(big_complex(x), big_complex(x), MPC_RNDNN);
+ return(x);
+
+ case T_INTEGER:
+ if (integer(p) == s7_int_min)
{
- mpc_t *n;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_neg(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ x = s7_int_to_big_integer(sc, integer(p));
+ mpz_neg(big_integer(x), big_integer(x));
+ return(x);
}
+ return(make_integer(sc, -integer(p)));
+
+ case T_RATIO:
+ return(s7_make_ratio(sc, -numerator(p), denominator(p)));
+
+ case T_REAL:
+ return(make_real(sc, -real(p)));
+
+ default:
+ return(s7_make_complex(sc, -real_part(p), -imag_part(p)));
}
- return(s7_negate(sc, car(args)));
}
static s7_pointer big_subtract(s7_scheme *sc, s7_pointer args)
{
- int i, result_type = NUM_INT;
+ int result_type = T_INTEGER;
s7_pointer x, result;
if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "-", 1, car(args), "a number"));
-
- if (cdr(args) == sc->NIL)
+ method_or_bust_with_type(sc, car(args), sc->SUBTRACT, args, A_NUMBER, 1);
+
+ if (is_null(cdr(args)))
return(big_negate(sc, args));
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
+ for (x = args; is_not_null(x); x = cdr(x))
{
s7_pointer p;
p = car(x);
- if (type(p) != T_NUMBER)
- {
- if (!IS_BIG(p))
- return(s7_wrong_type_arg_error(sc, "-", i, p, "a number"));
- else result_type |= SHIFT_BIGNUM_TYPE(c_object_type(p));
- }
- else result_type |= number_type(p);
+ result_type = get_result_type(sc, result_type, p);
+ if (result_type < 0)
+ return(g_subtract(sc, args));
}
- if (IS_NUM(result_type))
+ if (result_type < T_BIG_INTEGER)
return(g_subtract(sc, args));
- result_type = canonicalize_result_type(result_type);
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->SUBTRACT, args);
+
result = copy_and_promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
s7_pointer arg;
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->SUBTRACT, cons(sc, result, x));
+
arg = promote_number(sc, result_type, car(x));
+
switch (result_type)
{
- case T_BIG_INTEGER:
- mpz_sub(S7_BIG_INTEGER(result), S7_BIG_INTEGER(result), S7_BIG_INTEGER(arg));
- break;
-
- case T_BIG_RATIO:
- mpq_sub(S7_BIG_RATIO(result), S7_BIG_RATIO(result), S7_BIG_RATIO(arg));
- break;
-
- case T_BIG_REAL:
- mpfr_sub(S7_BIG_REAL(result), S7_BIG_REAL(result), S7_BIG_REAL(arg), GMP_RNDN);
- break;
-
- case T_BIG_COMPLEX:
- mpc_sub(S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(arg), MPC_RNDNN);
- break;
+ case T_BIG_INTEGER: mpz_sub(big_integer(result), big_integer(result), big_integer(arg)); break;
+ case T_BIG_RATIO: mpq_sub(big_ratio(result), big_ratio(result), big_ratio(arg)); break;
+ case T_BIG_REAL: mpfr_sub(big_real(result), big_real(result), big_real(arg), GMP_RNDN); break;
+ case T_BIG_COMPLEX: mpc_sub(big_complex(result), big_complex(result), big_complex(arg), MPC_RNDNN); break;
}
}
switch (result_type)
{
- case T_BIG_RATIO:
- return(make_big_integer_or_ratio(sc, result));
-
- case T_BIG_COMPLEX:
- return(make_big_real_or_complex(sc, result));
- }
+ case T_BIG_RATIO: return(make_big_integer_or_ratio(sc, result));
+ case T_BIG_COMPLEX: return(make_big_real_or_complex(sc, result));
+ }
return(result);
}
static s7_pointer big_multiply(s7_scheme *sc, s7_pointer args)
{
- int i, result_type = NUM_INT;
+ int result_type = T_INTEGER;
s7_pointer x, result;
- if (args == sc->NIL)
+ if (is_null(args))
return(small_int(1));
- if ((cdr(args) == sc->NIL) && (s7_is_number(car(args))))
+ if ((is_null(cdr(args))) && (s7_is_number(car(args))))
return(car(args));
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
+ for (x = args; is_not_null(x); x = cdr(x))
{
s7_pointer p;
p = car(x);
- if (type(p) != T_NUMBER)
- {
- if (!IS_BIG(p))
- return(s7_wrong_type_arg_error(sc, "*", i, p, "a number"));
- else result_type |= SHIFT_BIGNUM_TYPE(c_object_type(p));
- }
- else result_type |= number_type(p);
+ result_type = get_result_type(sc, result_type, p);
+ if (result_type < 0)
+ return(g_multiply(sc, args));
}
- if (IS_NUM(result_type))
+ if (result_type < T_BIG_INTEGER)
return(g_multiply(sc, args));
- result_type = canonicalize_result_type(result_type);
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->MULTIPLY, args);
+
result = copy_and_promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
s7_pointer arg;
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->MULTIPLY, cons(sc, result, x));
+
arg = promote_number(sc, result_type, car(x));
switch (result_type)
{
- case T_BIG_INTEGER:
- mpz_mul(S7_BIG_INTEGER(result), S7_BIG_INTEGER(result), S7_BIG_INTEGER(arg));
- break;
-
- case T_BIG_RATIO:
- mpq_mul(S7_BIG_RATIO(result), S7_BIG_RATIO(result), S7_BIG_RATIO(arg));
- break;
-
- case T_BIG_REAL:
- mpfr_mul(S7_BIG_REAL(result), S7_BIG_REAL(result), S7_BIG_REAL(arg), GMP_RNDN);
- break;
-
- case T_BIG_COMPLEX:
- mpc_mul(S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(arg), MPC_RNDNN);
- break;
+ case T_BIG_INTEGER: mpz_mul(big_integer(result), big_integer(result), big_integer(arg)); break;
+ case T_BIG_RATIO: mpq_mul(big_ratio(result), big_ratio(result), big_ratio(arg)); break;
+ case T_BIG_REAL: mpfr_mul(big_real(result), big_real(result), big_real(arg), GMP_RNDN); break;
+ case T_BIG_COMPLEX: mpc_mul(big_complex(result), big_complex(result), big_complex(arg), MPC_RNDNN); break;
}
}
switch (result_type)
{
- case T_BIG_RATIO:
- return(make_big_integer_or_ratio(sc, result));
-
- case T_BIG_COMPLEX:
- return(make_big_real_or_complex(sc, result));
+ case T_BIG_RATIO: return(make_big_integer_or_ratio(sc, result));
+ case T_BIG_COMPLEX: return(make_big_real_or_complex(sc, result));
}
return(result);
}
-static s7_pointer big_invert(s7_scheme *sc, s7_pointer args)
-{
- /* assume cdr(args) is nil and we're called from divide, so check for big num else call g_divide */
- s7_pointer p;
+static s7_pointer big_invert(s7_scheme *sc, s7_pointer args)
+{
+ /* assume cdr(args) is nil and we're called from divide, so check for big num else call g_divide */
+ s7_pointer p, x;
+
+ p = car(args);
+ if (s7_is_zero(p))
+ return(division_by_zero_error(sc, sc->DIVIDE, p));
+
+ switch (type(p))
+ {
+ case T_INTEGER:
+ if (integer(p) == s7_int_min)
+ {
+ mpz_t n1, d1;
+
+ new_cell(sc, x, T_BIG_RATIO);
+ add_bigratio(sc, x);
+
+ mpz_init_set_s7_int(n1, 1);
+ mpz_init_set_s7_int(d1, s7_int_min);
+ mpq_set_num(big_ratio(x), n1);
+ mpq_set_den(big_ratio(x), d1);
+ mpq_canonicalize(big_ratio(x));
+ mpz_clear(n1);
+ mpz_clear(d1);
+
+ return(x);
+ }
+ return(s7_make_ratio(sc, 1, integer(p))); /* a already checked, not 0 */
+
+ case T_RATIO:
+ return(s7_make_ratio(sc, denominator(p), numerator(p)));
+
+ case T_REAL:
+ return(make_real(sc, 1.0 / real(p)));
+
+ case T_COMPLEX:
+ {
+ s7_double r2, i2, den;
+ r2 = real_part(p);
+ i2 = imag_part(p);
+ den = (r2 * r2 + i2 * i2);
+ return(s7_make_complex(sc, r2 / den, -i2 / den));
+ }
+
+ case T_BIG_INTEGER:
+ /* p might be 1 or -1 */
+ {
+ mpz_t n;
+
+ mpz_init_set_si(n, 1);
+ if (mpz_cmp(n, big_integer(p)) == 0)
+ {
+ mpz_clear(n);
+ return(small_int(1));
+ }
+ mpz_set_si(n, -1);
+ if (mpz_cmp(n, big_integer(p)) == 0)
+ {
+ mpz_clear(n);
+ return(minus_one);
+ }
+
+ new_cell(sc, x, T_BIG_RATIO);
+ add_bigratio(sc, x);
+ mpq_init(big_ratio(x));
+
+ mpz_set_ui(n, 1);
+ mpq_set_num(big_ratio(x), n);
+ mpz_clear(n);
- p = car(args);
- if (big_is_zero_1(sc, p) == sc->T)
- return(division_by_zero_error(sc, "/", p));
+ mpq_set_den(big_ratio(x), big_integer(p));
+ mpq_canonicalize(big_ratio(x));
+ return(x);
+ }
- if (is_c_object(p))
- {
- if (c_object_type(p) == big_integer_tag)
- {
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set_z(*n, S7_BIG_INTEGER(p));
- mpq_inv(*n, *n);
- /* p might have been 1 or -1 */
- if (mpz_cmp_ui(mpq_denref(*n), 1) == 0)
- {
- mpz_t *z;
- z = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*z, mpq_numref(*n));
- mpq_clear(*n);
- free(n);
- return(s7_make_object(sc, big_integer_tag, (void *)z));
- }
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
- }
+ case T_BIG_RATIO:
+ {
+ mpz_t n;
- if (c_object_type(p) == big_ratio_tag)
- {
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set(*n, S7_BIG_RATIO(p));
- mpq_inv(*n, *n);
+ mpz_init_set_si(n, 1);
+ if (mpz_cmp(n, mpq_numref(big_ratio(p))) == 0)
+ {
+ mpz_clear(n);
+ return(mpz_to_big_integer(sc, mpq_denref(big_ratio(p))));
+ }
+ mpz_set_si(n, -1);
+ if (mpz_cmp(n, mpq_numref(big_ratio(p))) == 0)
+ {
+ mpz_clear(n);
+ x = mpz_to_big_integer(sc, mpq_denref(big_ratio(p)));
+ mpz_neg(big_integer(x), big_integer(x));
+ return(x);
+ }
+ mpz_clear(n);
- if (mpz_cmp_ui(mpq_denref(*n), 1) == 0)
- {
- mpz_t *z;
- z = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*z, mpq_numref(*n));
- mpq_clear(*n);
- free(n);
- return(s7_make_object(sc, big_integer_tag, (void *)z));
- }
+ new_cell(sc, x, T_BIG_RATIO);
+ add_bigratio(sc, x);
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
- }
+ mpq_init(big_ratio(x));
+ mpq_set_num(big_ratio(x), mpq_denref(big_ratio(p)));
+ mpq_set_den(big_ratio(x), mpq_numref(big_ratio(p)));
+ mpq_canonicalize(big_ratio(x));
+ return(x);
+ }
- if (c_object_type(p) == big_real_tag)
- {
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p), GMP_RNDN);
- mpfr_ui_div(*n, 1, *n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
- }
+ case T_BIG_REAL:
+ x = mpfr_to_big_real(sc, big_real(p));
+ mpfr_ui_div(big_real(x), 1, big_real(x), GMP_RNDN);
+ return(x);
- if (c_object_type(p) == big_complex_tag)
- {
- mpc_t *n;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- mpc_ui_div(*n, 1, *n, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
- }
+ default:
+ x = mpc_to_big_complex(sc, big_complex(p));
+ mpc_ui_div(big_complex(x), 1, big_complex(x), MPC_RNDNN);
+ return(x);
}
-
- return(s7_invert(sc, p));
}
static s7_pointer big_divide(s7_scheme *sc, s7_pointer args)
{
- int i, result_type = NUM_INT;
+ int result_type = T_INTEGER;
s7_pointer x, divisor, result;
if (!s7_is_number(car(args)))
- return(s7_wrong_type_arg_error(sc, "/", 1, car(args), "a number"));
-
- if (cdr(args) == sc->NIL)
+ method_or_bust_with_type(sc, car(args), sc->DIVIDE, args, A_NUMBER, 1);
+
+ if (is_null(cdr(args)))
return(big_invert(sc, args));
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
+ for (x = args; is_not_null(x); x = cdr(x))
{
s7_pointer p;
p = car(x);
- if (type(p) != T_NUMBER)
- {
- if (!IS_BIG(p))
- return(s7_wrong_type_arg_error(sc, "/", i, p, "a number"));
- else result_type |= SHIFT_BIGNUM_TYPE(c_object_type(p));
- }
- else result_type |= number_type(p);
+ /* if divisor is 0, gmp throws an exception and halts s7!
+ * I don't think we can trap gmp errors, and the abort is built into the library code.
+ */
+ result_type = get_result_type(sc, result_type, p);
+ if (result_type < 0)
+ return(g_divide(sc, args));
+
+ if ((x != args) &&
+ (s7_is_zero(p)))
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
}
- if (IS_NUM(result_type))
+ if (result_type < T_BIG_INTEGER)
return(g_divide(sc, args));
- result_type = canonicalize_result_type(result_type);
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->DIVIDE, args);
+
+ if (!s7_is_number(cadr(args)))
+ check_method(sc, cadr(args), sc->DIVIDE, args);
+
divisor = copy_and_promote_number(sc, result_type, cadr(args));
- for (x = cddr(args); x != sc->NIL; x = cdr(x))
+ for (x = cddr(args); is_not_null(x); x = cdr(x))
{
s7_pointer arg;
+ if (!s7_is_number(car(x)))
+ {
+ s7_pointer func;
+ if ((has_methods(car(x))) && ((func = find_method(sc, find_let(sc, car(x)), sc->MULTIPLY)) != sc->UNDEFINED))
+ {
+ divisor = s7_apply_function(sc, func, cons(sc, divisor, x));
+ break;
+ }
+ }
+
arg = promote_number(sc, result_type, car(x));
switch (result_type)
{
- case T_BIG_INTEGER:
- mpz_mul(S7_BIG_INTEGER(divisor), S7_BIG_INTEGER(divisor), S7_BIG_INTEGER(arg));
- break;
-
- case T_BIG_RATIO:
- mpq_mul(S7_BIG_RATIO(divisor), S7_BIG_RATIO(divisor), S7_BIG_RATIO(arg));
- break;
-
- case T_BIG_REAL:
- mpfr_mul(S7_BIG_REAL(divisor), S7_BIG_REAL(divisor), S7_BIG_REAL(arg), GMP_RNDN);
- break;
-
- case T_BIG_COMPLEX:
- mpc_mul(S7_BIG_COMPLEX(divisor), S7_BIG_COMPLEX(divisor), S7_BIG_COMPLEX(arg), MPC_RNDNN);
- break;
+ case T_BIG_INTEGER: mpz_mul(big_integer(divisor), big_integer(divisor), big_integer(arg)); break;
+ case T_BIG_RATIO: mpq_mul(big_ratio(divisor), big_ratio(divisor), big_ratio(arg)); break;
+ case T_BIG_REAL: mpfr_mul(big_real(divisor), big_real(divisor), big_real(arg), GMP_RNDN); break;
+ case T_BIG_COMPLEX: mpc_mul(big_complex(divisor), big_complex(divisor), big_complex(arg), MPC_RNDNN); break;
}
}
-
- if (big_is_zero_1(sc, divisor) == sc->T)
- return(division_by_zero_error(sc, "/", args));
+
+ if (s7_is_zero(divisor))
+ return(division_by_zero_error(sc, sc->DIVIDE, args));
+
+ /* it's possible for the divisor to be the wrong type here (if complex multiply -> real for example */
+ divisor = promote_number_1(sc, result_type, divisor, false);
result = copy_and_promote_number(sc, result_type, car(args));
@@ -27997,276 +69009,203 @@ static s7_pointer big_divide(s7_scheme *sc, s7_pointer args)
{
case T_BIG_INTEGER:
{
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set_num(*n, S7_BIG_INTEGER(result));
- mpq_set_den(*n, S7_BIG_INTEGER(divisor));
- mpq_canonicalize(*n);
- if (mpz_cmp_ui(mpq_denref(*n), 1) == 0)
- {
- result = mpz_to_big_integer(sc, mpq_numref(*n));
- mpq_clear(*n);
- free(n);
- return(result);
- }
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
+ new_cell(sc, x, T_BIG_RATIO);
+ add_bigratio(sc, x);
+
+ mpq_init(big_ratio(x));
+ mpq_set_num(big_ratio(x), big_integer(result));
+ mpq_set_den(big_ratio(x), big_integer(divisor));
+ mpq_canonicalize(big_ratio(x));
+
+ if (mpz_cmp_ui(mpq_denref(big_ratio(x)), 1) == 0)
+ return(mpz_to_big_integer(sc, mpq_numref(big_ratio(x))));
+ return(x);
}
-
+
case T_BIG_RATIO:
- mpq_div(S7_BIG_RATIO(result), S7_BIG_RATIO(result), S7_BIG_RATIO(divisor));
+ mpq_div(big_ratio(result), big_ratio(result), big_ratio(divisor));
return(make_big_integer_or_ratio(sc, result));
- break;
-
+
case T_BIG_REAL:
- mpfr_div(S7_BIG_REAL(result), S7_BIG_REAL(result), S7_BIG_REAL(divisor), GMP_RNDN);
+ mpfr_div(big_real(result), big_real(result), big_real(divisor), GMP_RNDN);
break;
-
+
case T_BIG_COMPLEX:
- mpc_div(S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(divisor), MPC_RNDNN);
+ mpc_div(big_complex(result), big_complex(result), big_complex(divisor), MPC_RNDNN);
return(make_big_real_or_complex(sc, result));
- break;
}
-
return(result);
}
-static s7_pointer big_numerator(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
- p = car(args);
- if (is_c_object(p))
- {
- if (c_object_type(p) == big_integer_tag)
- return(p);
- if (c_object_type(p) == big_ratio_tag)
- return(mpz_to_big_integer(sc, mpq_numref(S7_BIG_RATIO(p))));
- }
- return(g_numerator(sc, args));
-}
-
-
-static s7_pointer big_denominator(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
- p = car(args);
- if (is_c_object(p))
- {
- if (c_object_type(p) == big_integer_tag)
- return(small_int(1));
- if (c_object_type(p) == big_ratio_tag)
- return(mpz_to_big_integer(sc, mpq_denref(S7_BIG_RATIO(p))));
- }
- return(g_denominator(sc, args));
-}
-
-
-static s7_pointer big_is_even(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
- p = car(args);
- if ((is_c_object(p)) &&
- (c_object_type(p) == big_integer_tag))
- return(make_boolean(sc, mpz_even_p(S7_BIG_INTEGER(p))));
- return(g_is_even(sc, args));
-}
-
-
-static s7_pointer big_is_odd(s7_scheme *sc, s7_pointer args)
+static s7_pointer big_abs(s7_scheme *sc, s7_pointer args)
{
- s7_pointer p;
- p = car(args);
- if ((is_c_object(p)) &&
- (c_object_type(p) == big_integer_tag))
- return(make_boolean(sc, mpz_odd_p(S7_BIG_INTEGER(p))));
- return(g_is_odd(sc, args));
-}
-
+ #define H_abs "(abs x) returns the absolute value of the real number x"
+ #define Q_abs s7_make_signature(sc, 2, sc->IS_REAL, sc->IS_REAL)
+
+ s7_pointer p, x;
-static s7_pointer big_real_part(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
p = car(args);
- if (is_c_object(p))
+ switch (type(p))
{
- if (c_object_type(p) == big_complex_tag)
+ case T_INTEGER:
+ if (integer(p) < 0)
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init(*n);
- mpc_real(*n, S7_BIG_COMPLEX(p), GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
- }
- else
- {
- if ((c_object_type(p) == big_integer_tag) ||
- (c_object_type(p) == big_ratio_tag) ||
- (c_object_type(p) == big_real_tag))
- return(p);
+ if (integer(p) == s7_int_min)
+ {
+ x = s7_int_to_big_integer(sc, integer(p));
+ mpz_neg(big_integer(x), big_integer(x));
+ return(x);
+ }
+ return(make_integer(sc, -integer(p)));
}
- }
- return(g_real_part(sc, args));
-}
-
+ return(p);
-static s7_pointer big_imag_part(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer p;
- p = car(args);
- if (is_c_object(p))
- {
- if (c_object_type(p) == big_complex_tag)
- {
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init(*n);
- mpc_imag(*n, S7_BIG_COMPLEX(p), GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
- }
- else
- {
- if ((c_object_type(p) == big_integer_tag) ||
- (c_object_type(p) == big_ratio_tag) ||
- (c_object_type(p) == big_real_tag))
- return(small_int(0));
- }
- }
- return(g_imag_part(sc, args));
-}
+ case T_RATIO:
+ if (numerator(p) < 0)
+ return(s7_make_ratio(sc, -numerator(p), denominator(p)));
+ return(p);
+ case T_REAL:
+ if (real(p) < 0.0)
+ return(make_real(sc, -real(p)));
+ return(p);
-static s7_pointer big_abs(s7_scheme *sc, s7_pointer args)
-{
- #define H_abs "(abs x) returns the absolute value of the real number x"
- s7_pointer p;
+ case T_BIG_INTEGER:
+ x = mpz_to_big_integer(sc, big_integer(p));
+ mpz_abs(big_integer(x), big_integer(x));
+ return(x);
- p = car(args);
- if (!s7_is_real(p))
- return(s7_wrong_type_arg_error(sc, "abs", 0, p, "a real"));
+ case T_BIG_RATIO:
+ x = mpq_to_big_ratio(sc, big_ratio(p));
+ mpq_abs(big_ratio(x), big_ratio(x));
+ return(x);
- p = to_big(sc, p);
-
- if (c_object_type(p) == big_integer_tag)
- {
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, S7_BIG_INTEGER(p));
- mpz_abs(*n, *n);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
- }
+ case T_BIG_REAL:
+ x = mpfr_to_big_real(sc, big_real(p));
+ mpfr_abs(big_real(x), big_real(x), GMP_RNDN);
+ return(x);
- if (c_object_type(p) == big_ratio_tag)
- {
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set(*n, S7_BIG_RATIO(p));
- mpq_abs(*n, *n);
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
+ default:
+ method_or_bust(sc, p, sc->ABS, args, T_REAL, 0);
}
-
- {
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p), GMP_RNDN);
- mpfr_abs(*n, *n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
- }
}
static s7_pointer big_magnitude(s7_scheme *sc, s7_pointer args)
{
#define H_magnitude "(magnitude z) returns the magnitude of z"
+ #define Q_magnitude s7_make_signature(sc, 2, sc->IS_REAL, sc->IS_NUMBER)
+
s7_pointer p;
p = car(args);
if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "magnitude", 0, p, "a number"));
-
- p = to_big(sc, p);
+ method_or_bust_with_type(sc, p, sc->MAGNITUDE, args, A_NUMBER, 0);
- if (c_object_type(p) == big_complex_tag)
+ if (is_t_big_complex(p))
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init(*n);
- mpc_abs(*n, S7_BIG_COMPLEX(p), GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ mpfr_t n;
+ mpfr_init(n);
+ mpc_abs(n, big_complex(p), GMP_RNDN);
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
- return(big_abs(sc, make_list_1(sc, p)));
-}
+ if (is_t_complex(p))
+ return(make_real(sc, hypot(imag_part(p), real_part(p))));
+ return(big_abs(sc, args));
+}
static s7_pointer big_angle(s7_scheme *sc, s7_pointer args)
{
#define H_angle "(angle z) returns the angle of z"
+ #define Q_angle s7_make_signature(sc, 2, sc->IS_REAL, sc->IS_NUMBER)
+
s7_pointer p;
p = car(args);
- if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "angle", 0, p, "a number"));
+ switch (type(p))
+ {
+ case T_INTEGER:
+ if (integer(p) < 0)
+ return(real_pi);
+ return(small_int(0));
- p = to_big(sc, p);
+ case T_RATIO:
+ if (numerator(p) < 0)
+ return(real_pi);
+ return(small_int(0));
- if (c_object_type(p) == big_integer_tag)
- {
- if (mpz_cmp_ui(S7_BIG_INTEGER(p), 0) >= 0)
+ case T_REAL:
+ if (is_NaN(real(p))) return(p);
+ if (real(p) < 0.0)
+ return(real_pi);
+ return(real_zero);
+
+ case T_COMPLEX:
+ return(make_real(sc, atan2(imag_part(p), real_part(p))));
+
+ case T_BIG_INTEGER:
+ if (mpz_cmp_ui(big_integer(p), 0) >= 0)
return(small_int(0));
return(big_pi(sc));
- }
-
- if (c_object_type(p) == big_ratio_tag)
- {
- if (mpq_cmp_ui(S7_BIG_RATIO(p), 0, 1) >= 0)
+
+ case T_BIG_RATIO:
+ if (mpq_cmp_ui(big_ratio(p), 0, 1) >= 0)
return(small_int(0));
return(big_pi(sc));
- }
-
- if (c_object_type(p) == big_real_tag)
- {
- double x;
- x = mpfr_get_d(S7_BIG_REAL(p), GMP_RNDN);
- /* mpfr_get_d returns inf or -inf if the arg is too large for a double */
- if (isnan(x)) return(p);
- if (x >= 0.0)
- return(real_zero);
- return(big_pi(sc));
- }
- {
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init(*n);
- mpc_arg(*n, S7_BIG_COMPLEX(p), GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
- }
+ case T_BIG_REAL:
+ {
+ double x;
+ x = mpfr_get_d(big_real(p), GMP_RNDN);
+ /* mpfr_get_d returns inf or -inf if the arg is too large for a double */
+ if (is_NaN(x)) return(p);
+ if (x >= 0.0)
+ return(real_zero);
+ return(big_pi(sc));
+ }
+
+ case T_BIG_COMPLEX:
+ {
+ s7_pointer x;
+ new_cell(sc, x, T_BIG_REAL);
+ add_bigreal(sc, x);
+ mpfr_init(big_real(x));
+ mpc_arg(big_real(x), big_complex(p), GMP_RNDN);
+ return(x);
+ }
+
+ default:
+ method_or_bust_with_type(sc, p, sc->ANGLE, args, A_NUMBER, 0);
+ }
}
-static s7_pointer big_make_rectangular(s7_scheme *sc, s7_pointer args)
+static s7_pointer c_big_complex(s7_scheme *sc, s7_pointer args)
{
- #define H_make_rectangular "(make-rectangular x1 x2) returns a complex number with real-part x1 and imaginary-part x2"
+ #define H_complex "(complex x1 x2) returns a complex number with real-part x1 and imaginary-part x2"
+ #define Q_complex s7_make_signature(sc, 3, sc->IS_NUMBER, sc->IS_REAL, sc->IS_REAL)
- s7_pointer p0, p1;
- mpc_t *n;
+ s7_pointer p0, p1, p;
mpfr_t rl, im;
double x;
p0 = car(args);
if (!s7_is_real(p0))
- return(s7_wrong_type_arg_error(sc, "make-rectangular real part,", 1, p0, "a real"));
+ method_or_bust(sc, p0, sc->COMPLEX, args, T_REAL, 1);
p1 = cadr(args);
if (!s7_is_real(p1))
- return(s7_wrong_type_arg_error(sc, "make-rectangular imaginary part,", 2, p1, "a real"));
-
- if ((!is_c_object(p1)) && (s7_real(p1) == 0.0)) /* imag-part is not bignum and is 0.0 */
+ method_or_bust(sc, p1, sc->COMPLEX, args, T_REAL, 2);
+
+ if ((!is_big_number(p1)) && (real_to_double(sc, p1, "complex") == 0.0)) /* imag-part is not bignum and is 0.0 */
return(p0);
- mpfr_init_set(im, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p1)), GMP_RNDN);
+ mpfr_init_set(im, big_real(promote_number(sc, T_BIG_REAL, p1)), GMP_RNDN);
x = mpfr_get_d(im, GMP_RNDN);
if (x == 0.0) /* imag-part is bignum 0.0 */
{
@@ -28274,53 +69213,56 @@ static s7_pointer big_make_rectangular(s7_scheme *sc, s7_pointer args)
return(p0);
}
- mpfr_init_set(rl, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p0)), GMP_RNDN);
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set_fr_fr(*n, rl, im, MPC_RNDNN);
+ mpfr_init_set(rl, big_real(promote_number(sc, T_BIG_REAL, p0)), GMP_RNDN);
+
+ new_cell(sc, p, T_BIG_COMPLEX);
+ add_bignumber(sc, p);
+ mpc_init(big_complex(p));
+ mpc_set_fr_fr(big_complex(p), rl, im, MPC_RNDNN);
+
mpfr_clear(rl);
mpfr_clear(im);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ return(p);
}
-/* (make-polar 0 (real-part (log 0))) = 0? or nan?
- */
+/* (make-polar 0 (real-part (log 0))) = 0? or nan? */
+#if (!WITH_PURE_S7)
static s7_pointer big_make_polar(s7_scheme *sc, s7_pointer args)
{
#define H_make_polar "(make-polar mag ang) returns a complex number with magnitude mag and angle ang"
+ #define Q_make_polar s7_make_signature(sc, 3, sc->IS_NUMBER, sc->IS_REAL, sc->IS_REAL)
- s7_pointer p0, p1;
- mpc_t *n;
+ s7_pointer p0, p1, p;
mpfr_t ang, mag, rl, im;
double x, y;
p0 = car(args);
if (!s7_is_real(p0))
- return(s7_wrong_type_arg_error(sc, "make-polar magnitude,", 1, p0, "a real"));
+ method_or_bust(sc, p0, sc->MAKE_POLAR, args, T_REAL, 1);
p1 = cadr(args);
if (!s7_is_real(p1))
- return(s7_wrong_type_arg_error(sc, "make-polar angle,", 2, p1, "a real"));
-
- mpfr_init_set(ang, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p1)), GMP_RNDN);
+ method_or_bust(sc, p1, sc->MAKE_POLAR, args, T_REAL, 2);
+
+ mpfr_init_set(ang, big_real(promote_number(sc, T_BIG_REAL, p1)), GMP_RNDN);
y = mpfr_get_d(ang, GMP_RNDN);
- if (isnan(y))
+ if (is_NaN(y))
{
mpfr_clear(ang);
- return(s7_make_real(sc, NAN));
+ return(real_NaN);
}
- mpfr_init_set(mag, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p0)), GMP_RNDN);
+ mpfr_init_set(mag, big_real(promote_number(sc, T_BIG_REAL, p0)), GMP_RNDN);
x = mpfr_get_d(mag, GMP_RNDN);
- if (isnan(x))
+ if (is_NaN(x))
{
mpfr_clear(ang);
mpfr_clear(mag);
- return(s7_make_real(sc, NAN));
+ return(real_NaN);
}
if ((x == 0.0) || (y == 0.0))
@@ -28333,7 +69275,7 @@ static s7_pointer big_make_polar(s7_scheme *sc, s7_pointer args)
mpfr_init_set(im, ang, GMP_RNDN);
mpfr_sin(im, im, GMP_RNDN);
mpfr_mul(im, im, mag, GMP_RNDN);
-
+
x = mpfr_get_d(im, GMP_RNDN);
if (x == 0.0)
{
@@ -28346,33 +69288,38 @@ static s7_pointer big_make_polar(s7_scheme *sc, s7_pointer args)
mpfr_init_set(rl, ang, GMP_RNDN);
mpfr_cos(rl, rl, GMP_RNDN);
mpfr_mul(rl, rl, mag, GMP_RNDN);
-
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set_fr_fr(*n, rl, im, MPC_RNDNN);
+
+ new_cell(sc, p, T_BIG_COMPLEX);
+ add_bignumber(sc, p);
+ mpc_init(big_complex(p));
+ mpc_set_fr_fr(big_complex(p), rl, im, MPC_RNDNN);
+
mpfr_clear(rl);
mpfr_clear(im);
mpfr_clear(ang);
mpfr_clear(mag);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ return(p);
}
+#endif
static s7_pointer big_log(s7_scheme *sc, s7_pointer args)
{
#define H_log "(log z1 (z2 e)) returns log(z1) / log(z2) where z2 (the base) defaults to e: (log 8 2) = 3"
- /* either arg can be big, 2nd is optional */
- s7_pointer p0, p1 = NULL;
+ #define Q_log pcl_n
+
+ /* either arg can be big, second is optional */
+ s7_pointer p0, p1 = NULL, p;
p0 = car(args);
if (!s7_is_number(p0))
- return(s7_wrong_type_arg_error(sc, "log", (cdr(args) == sc->NIL) ? 0 : 1, p0, "a number"));
+ method_or_bust_with_type(sc, p0, sc->LOG, args, A_NUMBER, 1);
- if (cdr(args) != sc->NIL)
+ if (is_not_null(cdr(args)))
{
p1 = cadr(args);
if (!s7_is_number(p1))
- return(s7_wrong_type_arg_error(sc, "log base,", 2, p1, "a number"));
+ method_or_bust_with_type(sc, p1, sc->LOG, args, A_NUMBER, 2);
}
if ((s7_is_real(p0)) &&
@@ -28381,14 +69328,14 @@ static s7_pointer big_log(s7_scheme *sc, s7_pointer args)
double x, y = 0.0;
p0 = promote_number(sc, T_BIG_REAL, p0);
- x = mpfr_get_d(S7_BIG_REAL(p0), GMP_RNDN);
- if (isnan(x))
- return(s7_make_real(sc, NAN));
+ x = mpfr_get_d(big_real(p0), GMP_RNDN);
+ if (is_NaN(x))
+ return(real_NaN);
- if (p1)
+ if (p1)
{
p1 = promote_number(sc, T_BIG_REAL, p1);
- y = mpfr_get_d(S7_BIG_REAL(p1), GMP_RNDN);
+ y = mpfr_get_d(big_real(p1), GMP_RNDN);
/* we can't check y here for 1.0 (check for 0.0 apparently is ok):
* :(log 100.0 (+ 1.0 (bignum "1e-16")))
@@ -28396,88 +69343,86 @@ static s7_pointer big_log(s7_scheme *sc, s7_pointer args)
* :(= 1.0 (+ 1.0 (bignum "1e-16")))
* #f
*/
- if (isnan(y))
- return(s7_make_real(sc, NAN));
+ if (is_NaN(y))
+ return(real_NaN);
if (y == 0.0)
- return(s7_out_of_range_error(sc, "log base,", 2, p1, "can't be 0.0"));
+ return(out_of_range(sc, sc->LOG, small_int(2), p1, make_string_wrapper(sc, "argument can't be 0.0")));
}
if (x == 0.0)
return(s7_make_complex(sc, -INFINITY, M_PI));
if ((x > 0.0) && (y >= 0.0))
{
- mpfr_t *n;
- mpfr_t base;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p0), GMP_RNDN);
- mpfr_log(*n, *n, GMP_RNDN);
+ mpfr_t n, base;
+
+ mpfr_init_set(n, big_real(p0), GMP_RNDN);
+ mpfr_log(n, n, GMP_RNDN);
+
if (!p1)
{
/* presumably log is safe with regard to real-part overflow giving a bogus int? */
if ((s7_is_rational(car(args))) &&
- (mpfr_integer_p(*n) != 0))
+ (mpfr_integer_p(n) != 0))
{
- mpz_t *k;
- k = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init(*k);
- mpfr_get_z(*k, *n, GMP_RNDN);
- mpfr_clear(*n);
- free(n);
- return(s7_make_object(sc, big_integer_tag, (void *)k));
+ new_cell(sc, p, T_BIG_INTEGER);
+ add_bigint(sc, p);
+ mpz_init(big_integer(p));
+ mpfr_get_z(big_integer(p), n, GMP_RNDN);
}
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ else p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
- mpfr_init_set(base, S7_BIG_REAL(p1), GMP_RNDN);
+
+ mpfr_init_set(base, big_real(p1), GMP_RNDN);
mpfr_log(base, base, GMP_RNDN);
- mpfr_div(*n, *n, base, GMP_RNDN);
+ mpfr_div(n, n, base, GMP_RNDN);
mpfr_clear(base);
+
if ((s7_is_rational(car(args))) &&
(s7_is_rational(cadr(args))) &&
- (mpfr_integer_p(*n) != 0))
+ (mpfr_integer_p(n) != 0))
{
- mpz_t *k;
- k = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init(*k);
- mpfr_get_z(*k, *n, GMP_RNDN);
- mpfr_clear(*n);
- free(n);
- return(s7_make_object(sc, big_integer_tag, (void *)k));
+ new_cell(sc, p, T_BIG_INTEGER);
+ add_bigint(sc, p);
+ mpz_init(big_integer(p));
+ mpfr_get_z(big_integer(p), n, GMP_RNDN);
}
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ else p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
}
p0 = promote_number(sc, T_BIG_COMPLEX, p0);
if (p1) p1 = promote_number(sc, T_BIG_COMPLEX, p1);
{
- mpc_t *n;
- mpc_t base;
+ mpc_t n, base;
double x;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set(*n, S7_BIG_COMPLEX(p0), MPC_RNDNN);
- mpc_log(*n, *n, MPC_RNDNN);
+ mpc_init(n);
+ mpc_set(n, big_complex(p0), MPC_RNDNN);
+ mpc_log(n, n, MPC_RNDNN);
if (!p1)
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ {
+ p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
+ }
+
mpc_init(base);
- mpc_set(base, S7_BIG_COMPLEX(p1), MPC_RNDNN);
+ mpc_set(base, big_complex(p1), MPC_RNDNN);
mpc_log(base, base, MPC_RNDNN);
- mpc_div(*n, *n, base, MPC_RNDNN);
+ mpc_div(n, n, base, MPC_RNDNN);
mpc_clear(base);
- x = mpfr_get_d(mpc_imagref(*n), GMP_RNDN);
+ x = mpfr_get_d(mpc_imagref(n), GMP_RNDN);
if (x == 0.0)
- {
- mpfr_t *x;
- x = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*x, mpc_realref(*n), GMP_RNDN);
- mpc_clear(*n);
- free(n);
- return(s7_make_object(sc, big_real_tag, (void *)x));
- }
-
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ p = mpfr_to_big_real(sc, mpc_realref(n));
+ else p = mpc_to_big_complex(sc, n);
+
+ mpc_clear(n);
+ return(p);
}
}
@@ -28486,99 +69431,107 @@ static s7_pointer big_sqrt(s7_scheme *sc, s7_pointer args)
{
/* real >= 0 -> real, else complex */
#define H_sqrt "(sqrt z) returns the square root of z"
+ #define Q_sqrt pcl_n
s7_pointer p;
+
p = car(args);
if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "sqrt", 0, p, "a number"));
-
+ method_or_bust_with_type(sc, p, sc->SQRT, args, A_NUMBER, 0);
p = to_big(sc, p);
-
+
/* if big integer, try to return int if perfect square */
- if (c_object_type(p) == big_integer_tag)
+ if (is_t_big_integer(p))
{
- if (mpz_cmp_ui(S7_BIG_INTEGER(p), 0) < 0)
+ if (mpz_cmp_ui(big_integer(p), 0) < 0)
p = promote_number(sc, T_BIG_COMPLEX, p);
else
{
- mpz_t *n;
- mpz_t rem;
- n = (mpz_t *)malloc(sizeof(mpz_t));
+ mpz_t n, rem;
+
mpz_init(rem);
- mpz_init_set(*n, S7_BIG_INTEGER(p));
- mpz_sqrtrem(*n, rem, *n);
+ mpz_init_set(n, big_integer(p));
+ mpz_sqrtrem(n, rem, n);
+
if (mpz_cmp_ui(rem, 0) == 0)
{
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
mpz_clear(rem);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ return(p);
}
- free(n);
+ mpz_clear(n);
mpz_clear(rem);
p = promote_number(sc, T_BIG_REAL, p);
}
}
-
+
/* if big ratio, check both num and den for squares */
- if (c_object_type(p) == big_ratio_tag)
+ if (is_t_big_ratio(p))
{
- if (mpq_cmp_ui(S7_BIG_RATIO(p), 0, 1) < 0)
+ if (mpq_cmp_ui(big_ratio(p), 0, 1) < 0)
p = promote_number(sc, T_BIG_COMPLEX, p);
else
{
mpz_t n1, rem;
mpz_init(rem);
- mpz_init_set(n1, mpq_numref(S7_BIG_RATIO(p)));
+ mpz_init_set(n1, mpq_numref(big_ratio(p)));
mpz_sqrtrem(n1, rem, n1);
+
if (mpz_cmp_ui(rem, 0) == 0)
{
mpz_t d1;
- mpz_init_set(d1, mpq_denref(S7_BIG_RATIO(p)));
+ mpz_init_set(d1, mpq_denref(big_ratio(p)));
mpz_sqrtrem(d1, rem, d1);
+
if (mpz_cmp_ui(rem, 0) == 0)
{
- mpq_t *n;
- n = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*n);
- mpq_set_num(*n, n1);
- mpq_set_den(*n, d1);
- mpq_canonicalize(*n);
+ mpq_t n;
+ mpq_init(n);
+ mpq_set_num(n, n1);
+ mpq_set_den(n, d1);
+ mpq_canonicalize(n);
+ p = mpq_to_big_ratio(sc, n);
mpz_clear(n1);
mpz_clear(d1);
mpz_clear(rem);
- return(s7_make_object(sc, big_ratio_tag, (void *)n));
+ mpq_clear(n);
+ return(p);
}
mpz_clear(d1);
}
+
mpz_clear(n1);
mpz_clear(rem);
-
p = promote_number(sc, T_BIG_REAL, p);
}
}
-
+
/* if real and not negative, use mpfr_sqrt */
- if (c_object_type(p) == big_real_tag)
+ if (is_t_big_real(p))
{
- if (mpfr_cmp_ui(S7_BIG_REAL(p), 0) < 0)
+ if (mpfr_cmp_ui(big_real(p), 0) < 0)
p = promote_number(sc, T_BIG_COMPLEX, p);
else
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p), GMP_RNDN);
- mpfr_sqrt(*n, *n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ mpfr_t n;
+ mpfr_init_set(n, big_real(p), GMP_RNDN);
+ mpfr_sqrt(n, n, GMP_RNDN);
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
}
-
+
/* p is a big number, so it must be complex at this point */
{
- mpc_t *n;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- mpc_sqrt(*n, *n, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ mpc_t n;
+ mpc_init(n);
+ mpc_set(n, big_complex(p), MPC_RNDNN);
+ mpc_sqrt(n, n, MPC_RNDNN);
+ p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
}
}
@@ -28589,185 +69542,204 @@ static s7_pointer big_sqrt(s7_scheme *sc, s7_pointer args)
enum {TRIG_NO_CHECK, TRIG_TAN_CHECK, TRIG_TANH_CHECK};
-static s7_pointer big_trig(s7_scheme *sc, s7_pointer args,
+static s7_pointer big_trig(s7_scheme *sc, s7_pointer args,
int (*mpfr_trig)(mpfr_ptr, mpfr_srcptr, mpfr_rnd_t),
int (*mpc_trig)(mpc_ptr, mpc_srcptr, mpc_rnd_t),
- int tan_case, const char *caller)
+ int tan_case, s7_pointer sym)
/* these declarations mimic the mpfr.h and mpc.h declarations. It seems to me that
* they ought to be:
* int (*mpfr_trig)(mpfr_t rop, mpfr_t op, mp_rnd_t rnd),
* void (*mpc_trig)(mpc_t rop, mpc_t op, mpc_rnd_t rnd))
*/
{
- mpc_t *n;
s7_pointer p;
p = car(args);
/* I think here we should always promote to bignum (otherwise, for example, (exp 800) -> inf)
*/
if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, caller, 0, p, "a number"));
-
+ method_or_bust_with_type(sc, p, sym, args, A_NUMBER, 0);
if (s7_is_real(p))
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p)), GMP_RNDN);
- mpfr_trig(*n, *n, GMP_RNDN);
+ mpfr_t n;
+ mpfr_init_set(n, big_real(promote_number(sc, T_BIG_REAL, p)), GMP_RNDN);
+ mpfr_trig(n, n, GMP_RNDN);
/* it's confusing to check for ints here via mpfr_integer_p because it
* is dependent on the precision! (exp 617/5) returns an integer if
* precision is 128, but a float if 512.
*/
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
- if (!is_c_object(p))
+ if (!is_big_number(p))
p = promote_number(sc, T_BIG_COMPLEX, p);
if (tan_case == TRIG_TAN_CHECK)
{
- if ((MPC_INEX_IM(mpc_cmp_si_si(S7_BIG_COMPLEX(p), 1, 350))) > 0)
- return(s7_make_complex(sc, 0.0, 1.0));
- if ((MPC_INEX_IM(mpc_cmp_si_si(S7_BIG_COMPLEX(p), 1, -350))) < 0)
- return(s7_make_complex(sc, 0.0, -1.0));
+ if ((MPC_INEX_IM(mpc_cmp_si_si(big_complex(p), 1, 350))) > 0)
+ return(s7_make_complex(sc, 0.0, 1.0));
+ if ((MPC_INEX_IM(mpc_cmp_si_si(big_complex(p), 1, -350))) < 0)
+ return(s7_make_complex(sc, 0.0, -1.0));
}
-
+
if (tan_case == TRIG_TANH_CHECK)
{
- if ((MPC_INEX_RE(mpc_cmp_si_si(S7_BIG_COMPLEX(p), 350, 1))) > 0)
+ if ((MPC_INEX_RE(mpc_cmp_si_si(big_complex(p), 350, 1))) > 0)
return(real_one);
- if ((MPC_INEX_RE(mpc_cmp_si_si(S7_BIG_COMPLEX(p), -350, 1))) < 0)
- return(s7_make_real(sc, -1.0));
+ if ((MPC_INEX_RE(mpc_cmp_si_si(big_complex(p), -350, 1))) < 0)
+ return(make_real(sc, -1.0));
}
-
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_trig(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- /* (sin (bignum "1e15+1e15i")) causes mpc to hang (e9 is ok, but e10 hangs)
- * (sin (bignum "0+1e10i")) -> 0+inf (sin (bignum "1+1e10i")) hangs
- *
- * before comparing imag-part to 0, we need to look for NaN and inf, else:
- * (sinh 0+0/0i) -> 0.0
- * (sinh (log 0.0)) -> inf.0
- */
+
{
+ mpc_t n;
double ix;
- ix = mpfr_get_d(mpc_imagref(*n), GMP_RNDN);
+
+ mpc_init(n);
+ mpc_trig(n, big_complex(p), MPC_RNDNN);
+ /* (sin (bignum "1e15+1e15i")) causes mpc to hang (e9 is ok, but e10 hangs)
+ * (sin (bignum "0+1e10i")) -> 0+inf (sin (bignum "1+1e10i")) hangs
+ *
+ * before comparing imag-part to 0, we need to look for NaN and inf, else:
+ * (sinh 0+0/0i) -> 0.0
+ * (sinh (log 0.0)) -> inf.0
+ */
+
+ ix = mpfr_get_d(mpc_imagref(n), GMP_RNDN);
if (ix == 0.0)
{
- mpfr_t *z;
- z = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*z, mpc_realref(*n), GMP_RNDN);
- mpc_clear(*n);
- free(n);
- return(s7_make_object(sc, big_real_tag, (void *)z));
+ mpfr_t z;
+
+ mpfr_init_set(z, mpc_realref(n), GMP_RNDN);
+ p = mpfr_to_big_real(sc, z);
+ mpfr_clear(z);
}
+ else p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
}
- return(s7_make_object(sc, big_complex_tag, (void *)n));
}
static s7_pointer big_sin(s7_scheme *sc, s7_pointer args)
{
#define H_sin "(sin z) returns sin(z)"
- return(big_trig(sc, args, mpfr_sin, mpc_sin, TRIG_NO_CHECK, "sin"));
+ #define Q_sin pcl_n
+
+ return(big_trig(sc, args, mpfr_sin, mpc_sin, TRIG_NO_CHECK, sc->SIN));
}
static s7_pointer big_cos(s7_scheme *sc, s7_pointer args)
{
#define H_cos "(cos z) returns cos(z)"
- return(big_trig(sc, args, mpfr_cos, mpc_cos, TRIG_NO_CHECK, "cos"));
+ #define Q_cos pcl_n
+
+ return(big_trig(sc, args, mpfr_cos, mpc_cos, TRIG_NO_CHECK, sc->COS));
+}
+
+
+s7_pointer s7_cos(s7_scheme *sc, s7_pointer x)
+{
+ return(big_cos(sc, cons(sc, x, sc->NIL)));
}
static s7_pointer big_tan(s7_scheme *sc, s7_pointer args)
{
#define H_tan "(tan z) returns tan(z)"
- return(big_trig(sc, args, mpfr_tan, mpc_tan, TRIG_TAN_CHECK, "tan"));
+ #define Q_tan pcl_n
+
+ return(big_trig(sc, args, mpfr_tan, mpc_tan, TRIG_TAN_CHECK, sc->TAN));
}
static s7_pointer big_sinh(s7_scheme *sc, s7_pointer args)
{
#define H_sinh "(sinh z) returns sinh(z)"
+ #define Q_sinh pcl_n
+
/* currently (sinh 0+0/0i) -> 0.0? */
- return(big_trig(sc, args, mpfr_sinh, mpc_sinh, TRIG_NO_CHECK, "sinh"));
+ return(big_trig(sc, args, mpfr_sinh, mpc_sinh, TRIG_NO_CHECK, sc->SINH));
}
static s7_pointer big_cosh(s7_scheme *sc, s7_pointer args)
{
#define H_cosh "(cosh z) returns cosh(z)"
- return(big_trig(sc, args, mpfr_cosh, mpc_cosh, TRIG_NO_CHECK, "cosh"));
+ #define Q_cosh pcl_n
+
+ return(big_trig(sc, args, mpfr_cosh, mpc_cosh, TRIG_NO_CHECK, sc->COSH));
}
static s7_pointer big_tanh(s7_scheme *sc, s7_pointer args)
{
#define H_tanh "(tanh z) returns tanh(z)"
- return(big_trig(sc, args, mpfr_tanh, mpc_tanh, TRIG_TANH_CHECK, "tanh"));
+ #define Q_tanh pcl_n
+
+ return(big_trig(sc, args, mpfr_tanh, mpc_tanh, TRIG_TANH_CHECK, sc->TANH));
}
static s7_pointer big_exp(s7_scheme *sc, s7_pointer args)
{
#define H_exp "(exp z) returns e^z, (exp 1) is 2.718281828459"
- return(big_trig(sc, args, mpfr_exp, mpc_exp, TRIG_NO_CHECK, "exp"));
+ #define Q_exp pcl_n
+
+ return(big_trig(sc, args, mpfr_exp, mpc_exp, TRIG_NO_CHECK, sc->EXP));
}
static s7_pointer big_expt(s7_scheme *sc, s7_pointer args)
{
#define H_expt "(expt z1 z2) returns z1^z2"
- s7_pointer x, y;
+ #define Q_expt pcl_n
+
+ s7_pointer x, y, p;
/* see comment under g_expt
- * if (cddr(args) != sc->NIL)
- * return(big_expt(sc, make_list_2(sc, car(args), big_expt(sc, cdr(args)))));
+ * if (is_not_null(cddr(args)))
+ * return(big_expt(sc, set_plist_2(sc, car(args), big_expt(sc, cdr(args)))));
*/
x = car(args);
if (!s7_is_number(x))
- return(s7_wrong_type_arg_error(sc, "expt", 1, x, "a number"));
+ method_or_bust_with_type(sc, x, sc->EXPT, args, A_NUMBER, 1);
y = cadr(args);
if (!s7_is_number(y))
- return(s7_wrong_type_arg_error(sc, "expt power,", 2, y, "a number"));
+ method_or_bust_with_type(sc, y, sc->EXPT, args, A_NUMBER, 2);
- if (big_is_zero_1(sc, x) == sc->T)
+ if (s7_is_zero(x))
{
- if ((s7_is_integer(x)) &&
+ if ((s7_is_integer(x)) &&
(s7_is_integer(y)) &&
- (big_is_zero_1(sc, y) == sc->T))
+ (s7_is_zero(y)))
return(small_int(1));
if (s7_is_real(y))
{
if (s7_is_negative(y))
- return(division_by_zero_error(sc, "expt", args));
+ return(division_by_zero_error(sc, sc->EXPT, args));
}
else
{
- if (s7_is_negative(big_real_part(sc, cdr(args))))
- return(division_by_zero_error(sc, "expt", args));
+ if (s7_is_negative(g_real_part(sc, cdr(args))))
+ return(division_by_zero_error(sc, sc->EXPT, args));
}
- if ((s7_is_rational(x)) &&
+ if ((s7_is_rational(x)) &&
(s7_is_rational(y)))
return(small_int(0));
-
return(real_zero);
}
if (s7_is_integer(y))
{
- s7_Int yval;
-
- if (!is_c_object(y))
- yval = s7_integer(y);
- else yval = big_integer_to_s7_Int(S7_BIG_INTEGER(y));
-
+ s7_int yval;
+ yval = s7_integer(y);
if (yval == 0)
{
if (s7_is_rational(x))
@@ -28778,117 +69750,122 @@ static s7_pointer big_expt(s7_scheme *sc, s7_pointer args)
if (yval == 1)
return(x);
- if (!is_c_object(x))
+ if (!is_big_number(x))
{
if ((s7_is_one(x)) || (s7_is_zero(x)))
return(x);
}
- if ((yval < S7_LONG_MAX) &&
- (yval > S7_LONG_MIN))
+ if ((yval < s7_int32_max) &&
+ (yval > s7_int32_min))
{
+ /* from here yval can fit in an unsigned int
+ * (protect against gmp exception if for example (expt 1/9223372036854775807 -9223372036854775807)
+ */
if (s7_is_integer(x))
{
- mpz_t *n;
- mpq_t *r;
+ mpz_t n;
+ mpq_t r;
+
x = promote_number(sc, T_BIG_INTEGER, x);
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, S7_BIG_INTEGER(x));
+ mpz_init_set(n, big_integer(x));
if (yval >= 0)
{
- mpz_pow_ui(*n, *n, (unsigned int)yval);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ mpz_pow_ui(n, n, (unsigned int)yval);
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
- mpz_pow_ui(*n, *n, (unsigned int)(-yval));
- r = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*r);
- mpq_set_z(*r, *n);
- mpq_inv(*r, *r);
- if (mpz_cmp_ui(mpq_denref(*r), 1) == 0)
+
+ mpz_pow_ui(n, n, (unsigned int)(-yval));
+ mpq_init(r);
+ mpq_set_z(r, n);
+ mpq_inv(r, r);
+ if (mpz_cmp_ui(mpq_denref(r), 1) == 0)
{
- mpz_t *z;
- z = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*z, mpq_numref(*r));
- mpq_clear(*r);
- free(r);
- mpz_clear(*n);
- free(n);
- return(s7_make_object(sc, big_integer_tag, (void *)z));
+ mpz_t z;
+ mpz_init_set(z, mpq_numref(r));
+ mpq_clear(r);
+ mpz_clear(n);
+ p = mpz_to_big_integer(sc, z);
+ mpz_clear(z);
+ return(p);
}
- mpz_clear(*n);
- free(n);
- return(s7_make_object(sc, big_ratio_tag, (void *)r));
+ mpz_clear(n);
+ p = mpq_to_big_ratio(sc, r);
+ mpq_clear(r);
+ return(p);
}
- }
-
- if (s7_is_ratio(x)) /* (here y is an integer) */
- {
- mpz_t n, d;
- mpq_t *r;
-
- if (yval > (S7_LLONG_MAX >> 4)) /* gmp aborts or segfaults if this is too large, but I don't know where the actual boundary is */
- return(s7_out_of_range_error(sc, "integer expt exponent,", 1, y, "gmp will segfault"));
- x = promote_number(sc, T_BIG_RATIO, x);
- mpz_init_set(n, mpq_numref(S7_BIG_RATIO(x)));
- mpz_init_set(d, mpq_denref(S7_BIG_RATIO(x)));
- r = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*r);
- if (yval >= 0)
- {
- mpz_pow_ui(n, n, (unsigned int)yval);
- mpz_pow_ui(d, d, (unsigned int)yval);
- mpq_set_num(*r, n);
- mpq_set_den(*r, d);
- }
- else
+ if (s7_is_ratio(x)) /* here y is an integer */
{
- yval = -yval;
- mpz_pow_ui(n, n, (unsigned int)yval);
- mpz_pow_ui(d, d, (unsigned int)yval);
- mpq_set_num(*r, d);
- mpq_set_den(*r, n);
- mpq_canonicalize(*r);
+ mpz_t n, d;
+ mpq_t r;
+
+ x = promote_number(sc, T_BIG_RATIO, x);
+ mpz_init_set(n, mpq_numref(big_ratio(x)));
+ mpz_init_set(d, mpq_denref(big_ratio(x)));
+ mpq_init(r);
+ if (yval >= 0)
+ {
+ mpz_pow_ui(n, n, (unsigned int)yval);
+ mpz_pow_ui(d, d, (unsigned int)yval);
+ mpq_set_num(r, n);
+ mpq_set_den(r, d);
+ }
+ else
+ {
+ yval = -yval;
+ mpz_pow_ui(n, n, (unsigned int)yval);
+ mpz_pow_ui(d, d, (unsigned int)yval);
+ mpq_set_num(r, d);
+ mpq_set_den(r, n);
+ mpq_canonicalize(r);
+ }
+ mpz_clear(n);
+ mpz_clear(d);
+ if (mpz_cmp_ui(mpq_denref(r), 1) == 0)
+ {
+ mpz_t z;
+ mpz_init_set(z, mpq_numref(r));
+ mpq_clear(r);
+ p = mpz_to_big_integer(sc, z);
+ mpz_clear(z);
+ return(p);
+ }
+ p = mpq_to_big_ratio(sc, r);
+ mpq_clear(r);
+ return(p);
}
- mpz_clear(n);
- mpz_clear(d);
- if (mpz_cmp_ui(mpq_denref(*r), 1) == 0)
+
+ if (s7_is_real(x))
{
- mpz_t *z;
- z = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*z, mpq_numref(*r));
- mpq_clear(*r);
- free(r);
- return(s7_make_object(sc, big_integer_tag, (void *)z));
+ mpfr_t z;
+ x = promote_number(sc, T_BIG_REAL, x);
+ mpfr_init_set(z, big_real(x), GMP_RNDN);
+ mpfr_pow_si(z, z, yval, GMP_RNDN);
+ p = mpfr_to_big_real(sc, z);
+ mpfr_clear(z);
+ return(p);
}
- return(s7_make_object(sc, big_ratio_tag, (void *)r));
- }
-
- if (s7_is_real(x))
- {
- mpfr_t *z;
- x = promote_number(sc, T_BIG_REAL, x);
- z = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*z, S7_BIG_REAL(x), GMP_RNDN);
- mpfr_pow_si(*z, *z, yval, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)z));
}
}
- if ((s7_is_ratio(y)) &&
- (numerator(number(y)) == 1))
+ if ((is_t_ratio(y)) && /* not s7_is_ratio which accepts bignums */
+ (numerator(y) == 1))
{
- if (denominator(number(y)) == 2)
+ if (denominator(y) == 2)
return(big_sqrt(sc, args));
if ((s7_is_real(x)) &&
- (denominator(number(y)) == 3))
+ (denominator(y) == 3))
{
- mpfr_t *z;
- z = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*z, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, x)), GMP_RNDN);
- mpfr_cbrt(*z, *z, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)z));
+ mpfr_t z;
+ mpfr_init_set(z, big_real(promote_number(sc, T_BIG_REAL, x)), GMP_RNDN);
+ mpfr_cbrt(z, z, GMP_RNDN);
+ p = mpfr_to_big_real(sc, z);
+ mpfr_clear(z);
+ return(p);
}
}
@@ -28896,74 +69873,76 @@ static s7_pointer big_expt(s7_scheme *sc, s7_pointer args)
(s7_is_real(y)) &&
(s7_is_positive(x)))
{
- mpfr_t *z;
- z = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*z, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, x)), GMP_RNDN);
- mpfr_pow(*z, *z, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, y)), GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)z));
+ mpfr_t z;
+ mpfr_init_set(z, big_real(promote_number(sc, T_BIG_REAL, x)), GMP_RNDN);
+ mpfr_pow(z, z, big_real(promote_number(sc, T_BIG_REAL, y)), GMP_RNDN);
+ p = mpfr_to_big_real(sc, z);
+ mpfr_clear(z);
+ return(p);
}
{
mpc_t cy;
- mpc_t *z;
-
+ mpc_t z;
+
x = promote_number(sc, T_BIG_COMPLEX, x);
y = promote_number(sc, T_BIG_COMPLEX, y);
-
- z = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*z);
- mpc_set(*z, S7_BIG_COMPLEX(x), MPC_RNDNN);
-
- if (mpc_cmp_si_si(*z, 0, 0) == 0)
+
+ mpc_init(z);
+ mpc_set(z, big_complex(x), MPC_RNDNN);
+
+ if (mpc_cmp_si_si(z, 0, 0) == 0)
{
- mpc_clear(*z);
- free(z);
+ mpc_clear(z);
return(small_int(0));
}
-
- if (mpc_cmp_si_si(*z, 1, 0) == 0)
+
+ if (mpc_cmp_si_si(z, 1, 0) == 0)
{
- mpc_clear(*z);
- free(z);
+ mpc_clear(z);
return(small_int(1));
}
-
+
mpc_init(cy);
- mpc_set(cy, S7_BIG_COMPLEX(y), MPC_RNDNN);
- mpc_pow(*z, *z, cy, MPC_RNDNN);
+ mpc_set(cy, big_complex(y), MPC_RNDNN);
+ mpc_pow(z, z, cy, MPC_RNDNN);
mpc_clear(cy);
-
- if (mpfr_cmp_ui(mpc_imagref(*z), 0) == 0)
+
+ if (mpfr_cmp_ui(mpc_imagref(z), 0) == 0)
{
- mpfr_t *n;
+ mpfr_t n;
if ((s7_is_rational(car(args))) &&
(s7_is_rational(cadr(args))) &&
- (mpfr_integer_p(mpc_realref(*z)) != 0))
+ (mpfr_integer_p(mpc_realref(z)) != 0))
{
/* mpfr_integer_p can be confused: (expt 2718/1000 (bignum "617/5")) returns an int if precision=128, float if 512 */
/* so first make sure we're within (say) 31 bits */
mpfr_t zi;
- mpfr_init_set_ui(zi, S7_LONG_MAX, GMP_RNDN);
- if (mpfr_cmpabs(mpc_realref(*z), zi) < 0)
+ mpfr_init_set_ui(zi, s7_int32_max, GMP_RNDN);
+ if (mpfr_cmpabs(mpc_realref(z), zi) < 0)
{
- mpz_t *k;
- k = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init(*k);
- mpfr_get_z(*k, mpc_realref(*z), GMP_RNDN);
- mpc_clear(*z);
+ mpz_t k;
+ mpz_init(k);
+ mpfr_get_z(k, mpc_realref(z), GMP_RNDN);
+ mpc_clear(z);
mpfr_clear(zi);
- free(z);
- return(s7_make_object(sc, big_integer_tag, (void *)k));
+ p = mpz_to_big_integer(sc, k);
+ mpz_clear(k);
+ return(p);
}
mpfr_clear(zi);
}
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, mpc_realref(*z), GMP_RNDN);
- mpc_clear(*z);
- free(z);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+
+ mpfr_init_set(n, mpc_realref(z), GMP_RNDN);
+ mpc_clear(z);
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
- return(s7_make_object(sc, big_complex_tag, (void *)z));
+
+ p = mpc_to_big_complex(sc, z);
+ mpc_clear(z);
+ return(p);
}
}
@@ -28971,30 +69950,34 @@ static s7_pointer big_expt(s7_scheme *sc, s7_pointer args)
static s7_pointer big_asinh(s7_scheme *sc, s7_pointer args)
{
#define H_asinh "(asinh z) returns asinh(z)"
+ #define Q_asinh pcl_n
+
s7_pointer p;
p = car(args);
if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "asinh", 0, p, "a number"));
-
+ method_or_bust_with_type(sc, p, sc->ASINH, args, A_NUMBER, 0);
+
if (s7_is_real(p))
{
- mpfr_t *n;
+ mpfr_t n;
p = promote_number(sc, T_BIG_REAL, p);
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p), GMP_RNDN);
- mpfr_asinh(*n, *n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ mpfr_init_set(n, big_real(p), GMP_RNDN);
+ mpfr_asinh(n, n, GMP_RNDN);
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
{
- mpc_t *n;
- p = promote_number(sc, T_BIG_COMPLEX, p);
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- mpc_asinh(*n, *n, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ mpc_t n;
+ p = promote_number(sc, T_BIG_COMPLEX, p);
+ mpc_init(n);
+ mpc_set(n, big_complex(p), MPC_RNDNN);
+ mpc_asinh(n, n, MPC_RNDNN);
+ p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
}
}
@@ -29002,44 +69985,40 @@ static s7_pointer big_asinh(s7_scheme *sc, s7_pointer args)
static s7_pointer big_acosh(s7_scheme *sc, s7_pointer args)
{
#define H_acosh "(acosh z) returns acosh(z)"
+ #define Q_acosh pcl_n
+
s7_pointer p;
double x;
- mpc_t *n;
+ mpc_t n;
p = car(args);
if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "acosh", 0, p, "a number"));
-
+ method_or_bust_with_type(sc, p, sc->ACOSH, args, A_NUMBER, 0);
p = promote_number(sc, T_BIG_COMPLEX, p);
-
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- mpc_acosh(*n, *n, MPC_RNDNN);
-
- x = mpfr_get_d(mpc_imagref(*n), GMP_RNDN);
+
+ mpc_init(n);
+ mpc_set(n, big_complex(p), MPC_RNDNN);
+ mpc_acosh(n, n, MPC_RNDNN);
+
+ x = mpfr_get_d(mpc_imagref(n), GMP_RNDN);
if (x == 0.0)
- {
- mpfr_t *z;
- z = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*z, mpc_realref(*n), GMP_RNDN);
- mpc_clear(*n);
- free(n);
- return(s7_make_object(sc, big_real_tag, (void *)z));
- }
-
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ p = mpfr_to_big_real(sc, mpc_realref(n));
+ else p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
}
static s7_pointer big_atanh(s7_scheme *sc, s7_pointer args)
{
#define H_atanh "(atanh z) returns atanh(z)"
+ #define Q_atanh pcl_n
+
s7_pointer p;
p = car(args);
if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "atanh", 0, p, "a number"));
+ method_or_bust_with_type(sc, p, sc->ATANH, args, A_NUMBER, 0);
if (s7_is_real(p))
{
@@ -29047,26 +70026,28 @@ static s7_pointer big_atanh(s7_scheme *sc, s7_pointer args)
mpfr_t temp;
p = promote_number(sc, T_BIG_REAL, p);
mpfr_init_set_ui(temp, 1, GMP_RNDN);
- ok = (mpfr_cmpabs(S7_BIG_REAL(p), temp) < 0);
+ ok = (mpfr_cmpabs(big_real(p), temp) < 0);
mpfr_clear(temp);
if (ok)
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p), GMP_RNDN);
- mpfr_atanh(*n, *n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ mpfr_t n;
+ mpfr_init_set(n, big_real(p), GMP_RNDN);
+ mpfr_atanh(n, n, GMP_RNDN);
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
}
{
- mpc_t *n;
+ mpc_t n;
p = promote_number(sc, T_BIG_COMPLEX, p);
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
- mpc_set(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- mpc_atanh(*n, *n, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ mpc_init(n);
+ mpc_set(n, big_complex(p), MPC_RNDNN);
+ mpc_atanh(n, n, MPC_RNDNN);
+ p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
}
}
@@ -29074,42 +70055,47 @@ static s7_pointer big_atanh(s7_scheme *sc, s7_pointer args)
static s7_pointer big_atan(s7_scheme *sc, s7_pointer args)
{
#define H_atan "(atan z) returns atan(z), (atan y x) returns atan(y/x)"
- s7_pointer p0, p1 = NULL;
+ #define Q_atan s7_make_signature(sc, 3, sc->IS_NUMBER, sc->IS_NUMBER, sc->IS_REAL)
+
+ s7_pointer p0, p1 = NULL, p;
p0 = car(args);
if (!s7_is_number(p0))
- return(s7_wrong_type_arg_error(sc, "atan", 0, p0, "a number"));
+ method_or_bust_with_type(sc, p0, sc->ATAN, args, A_NUMBER, 0);
- if (cdr(args) != sc->NIL)
+ if (is_not_null(cdr(args)))
{
p1 = cadr(args);
if (!s7_is_real(p1))
- return(s7_wrong_type_arg_error(sc, "atan", 2, p1, "a real number"));
+ method_or_bust(sc, p1, sc->ATAN, args, T_REAL, 2);
+
if (!s7_is_real(p0))
- return(s7_wrong_type_arg_error(sc, "atan", 1, p0, "if 2 args, both should be real"));
+ return(wrong_type_argument(sc, sc->ATAN, 1, p0, T_REAL));
p1 = promote_number(sc, T_BIG_REAL, p1);
}
if (s7_is_real(p0))
{
- mpfr_t *n;
+ mpfr_t n;
p0 = promote_number(sc, T_BIG_REAL, p0);
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p0), GMP_RNDN);
+ mpfr_init_set(n, big_real(p0), GMP_RNDN);
if (!p1)
- mpfr_atan(*n, *n, GMP_RNDN);
- else mpfr_atan2(*n, *n, S7_BIG_REAL(p1), GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ mpfr_atan(n, n, GMP_RNDN);
+ else mpfr_atan2(n, n, big_real(p1), GMP_RNDN);
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
{
- mpc_t *n;
+ mpc_t n;
p0 = promote_number(sc, T_BIG_COMPLEX, p0);
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init_set(*n, S7_BIG_COMPLEX(p0), MPC_RNDNN);
- mpc_atan(*n, *n, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ mpc_init_set(n, big_complex(p0), MPC_RNDNN);
+ mpc_atan(n, n, MPC_RNDNN);
+ p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
}
}
@@ -29117,39 +70103,42 @@ static s7_pointer big_atan(s7_scheme *sc, s7_pointer args)
static s7_pointer big_acos(s7_scheme *sc, s7_pointer args)
{
#define H_acos "(acos z) returns acos(z); (cos (acos 1)) = 1"
+ #define Q_acos pcl_n
+
s7_pointer p;
p = car(args);
if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "acos", 0, p, "a number"));
+ method_or_bust_with_type(sc, p, sc->ACOS, args, A_NUMBER, 0);
if (s7_is_real(p))
{
bool ok;
mpfr_t temp;
- mpfr_t *n;
+ mpfr_t n;
p = promote_number(sc, T_BIG_REAL, p);
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p), GMP_RNDN);
+ mpfr_init_set(n, big_real(p), GMP_RNDN);
mpfr_init_set_ui(temp, 1, GMP_RNDN);
- ok = (mpfr_cmpabs(*n, temp) <= 0);
+ ok = (mpfr_cmpabs(n, temp) <= 0);
mpfr_clear(temp);
if (ok)
{
- mpfr_acos(*n, *n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ mpfr_acos(n, n, GMP_RNDN);
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
- mpfr_clear(*n);
- free(n);
+ mpfr_clear(n);
}
{
- mpc_t *n;
+ mpc_t n;
p = promote_number(sc, T_BIG_COMPLEX, p);
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init_set(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- mpc_acos(*n, *n, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ mpc_init_set(n, big_complex(p), MPC_RNDNN);
+ mpc_acos(n, n, MPC_RNDNN);
+ p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
}
}
@@ -29157,222 +70146,81 @@ static s7_pointer big_acos(s7_scheme *sc, s7_pointer args)
static s7_pointer big_asin(s7_scheme *sc, s7_pointer args)
{
#define H_asin "(asin z) returns asin(z); (sin (asin 1)) = 1"
+ #define Q_asin pcl_n
+
s7_pointer p;
p = car(args);
if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "asin", 0, p, "a number"));
+ method_or_bust_with_type(sc, p, sc->ASIN, args, A_NUMBER, 0);
if (s7_is_real(p))
{
bool ok;
mpfr_t temp;
- mpfr_t *n;
+ mpfr_t n;
p = promote_number(sc, T_BIG_REAL, p);
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set(*n, S7_BIG_REAL(p), GMP_RNDN);
+ mpfr_init_set(n, big_real(p), GMP_RNDN);
mpfr_init_set_ui(temp, 1, GMP_RNDN);
- ok = (mpfr_cmpabs(*n, temp) <= 0);
+ ok = (mpfr_cmpabs(n, temp) <= 0);
mpfr_clear(temp);
if (ok)
{
- mpfr_asin(*n, *n, GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ mpfr_asin(n, n, GMP_RNDN);
+ p = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(p);
}
- mpfr_clear(*n);
- free(n);
+ mpfr_clear(n);
}
{
- mpc_t *n;
+ mpc_t n;
p = promote_number(sc, T_BIG_COMPLEX, p);
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init_set(*n, S7_BIG_COMPLEX(p), MPC_RNDNN);
- mpc_asin(*n, *n, MPC_RNDNN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ mpc_init_set(n, big_complex(p), MPC_RNDNN);
+ mpc_asin(n, n, MPC_RNDNN);
+ p = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(p);
}
}
-static s7_pointer big_is_zero_1(s7_scheme *sc, s7_pointer p)
-{
- if (is_c_object(p))
- {
- if (c_object_type(p) == big_integer_tag)
- return(make_boolean(sc, mpz_cmp_ui(S7_BIG_INTEGER(p), 0) == 0));
- if (c_object_type(p) == big_ratio_tag)
- return(make_boolean(sc, mpq_cmp_ui(S7_BIG_RATIO(p), 0, 1) == 0));
- if (c_object_type(p) == big_real_tag)
- return(make_boolean(sc, mpfr_zero_p(S7_BIG_REAL(p))));
- if (c_object_type(p) == big_complex_tag)
- return(make_boolean(sc, mpc_cmp_si_si(S7_BIG_COMPLEX(p), 0, 0) == 0));
- }
-
- if (!s7_is_number(p))
- return(s7_wrong_type_arg_error(sc, "zero?", 0, p, "a number"));
- return(make_boolean(sc, s7_is_zero(p)));
-}
-
-
-static s7_pointer big_is_zero(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_zero "(zero? num) returns #t if the number num is zero"
- return(big_is_zero_1(sc, car(args)));
-}
-
-
-static bool s7_is_positive(s7_pointer obj)
-{
- if (is_c_object(obj))
- {
- if (c_object_type(obj) == big_integer_tag)
- return(mpz_cmp_ui(S7_BIG_INTEGER(obj), 0) > 0);
-
- if (c_object_type(obj) == big_ratio_tag)
- return(mpq_cmp_ui(S7_BIG_RATIO(obj), 0, 1) > 0);
-
- if (c_object_type(obj) == big_real_tag)
- return(mpfr_cmp_ui(S7_BIG_REAL(obj), 0) > 0);
- }
-
- switch (number_type(obj))
- {
- case NUM_INT: return(s7_integer(obj) > 0);
- case NUM_RATIO: return(s7_numerator(obj) > 0);
- default: return(s7_real(obj) > 0);
- }
- return(false);
-}
-
-
-static s7_pointer big_is_positive(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_positive "(positive? num) returns #t if the real number num is positive (greater than 0)"
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, "positive?", 0, car(args), "a real"));
-
- return(make_boolean(sc, s7_is_positive(car(args))));
-}
-
-
-static bool s7_is_negative(s7_pointer obj)
-{
- if (is_c_object(obj))
- {
- if (c_object_type(obj) == big_integer_tag)
- return(mpz_cmp_ui(S7_BIG_INTEGER(obj), 0) < 0);
-
- if (c_object_type(obj) == big_ratio_tag)
- return(mpq_cmp_ui(S7_BIG_RATIO(obj), 0, 1) < 0);
-
- if (c_object_type(obj) == big_real_tag)
- return(mpfr_cmp_ui(S7_BIG_REAL(obj), 0) < 0);
- }
-
- switch (number_type(obj))
- {
- case NUM_INT: return(s7_integer(obj) < 0);
- case NUM_RATIO: return(s7_numerator(obj) < 0);
- default: return(s7_real(obj) < 0);
- }
- return(false); /* need s7_scheme pointer to return an error */
-}
-
-
-static s7_pointer big_is_negative(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_negative "(negative? num) returns #t if the real number num is negative (less than 0)"
- if (!s7_is_real(car(args)))
- return(s7_wrong_type_arg_error(sc, "negative?", 0, car(args), "a real"));
-
- return(make_boolean(sc, s7_is_negative(car(args))));
-}
-
-
-static s7_pointer big_is_nan(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_nan "(nan? obj) returns #t if obj is a NaN"
- s7_pointer x;
-
- x = car(args);
- if (s7_is_number(x))
- {
-#ifndef _MSC_VER
- return(make_boolean(sc, (isnan(s7_real_part(x))) || (isnan(s7_imag_part(x)))));
-#else
- /* is this actually different from isinf below? */
- if (isnan(s7_real_part(x)) || isnan(s7_imag_part(x)))
- return(sc->T);
- else return(sc->F);
-#endif
- }
-
- return(sc->F);
-}
-
-
-static s7_pointer big_is_infinite(s7_scheme *sc, s7_pointer args)
-{
- #define H_is_infinite "(infinite? obj) returns #t if obj is an infinite real"
- /* (infinite? 1e310) would return #t if left to g_is_infinite
- */
- s7_pointer x;
- x = car(args);
- if (!s7_is_number(x))
- return(sc->F);
-
- if (is_c_object(x))
- {
- if ((c_object_type(x) == big_integer_tag) ||
- (c_object_type(x) == big_ratio_tag))
- return(sc->F);
-
- if (c_object_type(x) == big_real_tag)
- return(make_boolean(sc, mpfr_inf_p(S7_BIG_REAL(x)) != 0));
-
- if (c_object_type(x) == big_complex_tag)
- return(make_boolean(sc,
- (mpfr_inf_p(S7_BIG_REAL(big_real_part(sc, args))) != 0) ||
- (mpfr_inf_p(S7_BIG_REAL(big_imag_part(sc, args))) != 0)));
- }
-
- return(make_boolean(sc, (isinf(s7_real_part(x))) || (isinf(s7_imag_part(x)))));
-}
-
-
static s7_pointer big_lognot(s7_scheme *sc, s7_pointer args)
{
- if ((is_c_object(car(args))) &&
- (c_object_type(car(args)) == big_integer_tag))
+ if (is_t_big_integer(car(args)))
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init(*n);
- mpz_com(*n, S7_BIG_INTEGER(car(args)));
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ s7_pointer p;
+ mpz_t n;
+ mpz_init(n);
+ mpz_com(n, big_integer(car(args)));
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
return(g_lognot(sc, args));
}
+#if (!WITH_PURE_S7)
static s7_pointer big_integer_length(s7_scheme *sc, s7_pointer args)
{
- if ((is_c_object(car(args))) &&
- (c_object_type(car(args)) == big_integer_tag))
+ if (is_t_big_integer(car(args)))
{
s7_pointer result;
mpfr_t n;
- mpfr_init_set_z(n, S7_BIG_INTEGER(car(args)), GMP_RNDN);
+ mpfr_init_set_z(n, big_integer(car(args)), GMP_RNDN);
if (mpfr_cmp_ui(n, 0) < 0)
mpfr_neg(n, n, GMP_RNDN);
else mpfr_add_ui(n, n, 1, GMP_RNDN);
mpfr_log2(n, n, GMP_RNDU);
- result = s7_make_integer(sc, mpfr_get_si(n, GMP_RNDU));
+ result = make_integer(sc, mpfr_get_si(n, GMP_RNDU));
mpfr_clear(n);
return(result);
}
return(g_integer_length(sc, args));
}
+#endif
static s7_pointer big_ash(s7_scheme *sc, s7_pointer args)
@@ -29387,15 +70235,16 @@ static s7_pointer big_ash(s7_scheme *sc, s7_pointer args)
if ((s7_is_integer(p0)) && /* this includes bignum ints... */
(s7_is_integer(p1)))
{
- mpz_t *n;
- s7_Int shift;
+ mpz_t n;
+ s7_int shift;
+ s7_pointer p;
bool p0_is_big;
int p0_compared_to_zero = 0;
- p0_is_big = is_c_object(p0);
+ p0_is_big = is_big_number(p0);
if (p0_is_big)
- p0_compared_to_zero = mpz_cmp_ui(S7_BIG_INTEGER(p0), 0);
- else
+ p0_compared_to_zero = mpz_cmp_ui(big_integer(p0), 0);
+ else
{
if (s7_integer(p0) > 0)
p0_compared_to_zero = 1;
@@ -29410,70 +70259,102 @@ static s7_pointer big_ash(s7_scheme *sc, s7_pointer args)
if (p0_compared_to_zero == 0)
return(small_int(0));
- if (is_c_object(p1))
+ if (is_big_number(p1))
{
- if (!mpz_fits_sint_p(S7_BIG_INTEGER(p1)))
+ if (!mpz_fits_sint_p(big_integer(p1)))
{
- if (mpz_cmp_ui(S7_BIG_INTEGER(p1), 0) > 0)
- return(s7_out_of_range_error(sc, "ash", 2, p1, "shift is too large"));
+ if (mpz_cmp_ui(big_integer(p1), 0) > 0)
+ return(out_of_range(sc, sc->ASH, small_int(2), p1, ITS_TOO_LARGE));
/* here if p0 is negative, we need to return -1 */
if (p0_compared_to_zero == 1)
return(small_int(0));
- return(small_negative_ints[1]);
+ return(minus_one);
}
- shift = mpz_get_si(S7_BIG_INTEGER(p1));
+ shift = mpz_get_si(big_integer(p1));
}
- else
+ else
{
shift = s7_integer(p1);
- if (shift < S7_LONG_MIN)
+ if (shift < s7_int32_min)
{
if (p0_compared_to_zero == 1)
return(small_int(0));
- return(small_negative_ints[1]);
+ return(minus_one);
}
}
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, S7_BIG_INTEGER(promote_number(sc, T_BIG_INTEGER, p0)));
+ mpz_init_set(n, big_integer(promote_number(sc, T_BIG_INTEGER, p0)));
if (shift > 0) /* left */
- mpz_mul_2exp(*n, *n, shift);
+ mpz_mul_2exp(n, n, shift);
else
{
if (shift < 0) /* right */
- mpz_fdiv_q_2exp(*n, *n, (unsigned int)(-shift));
+ mpz_fdiv_q_2exp(n, n, (unsigned int)(-shift));
}
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
return(g_ash(sc, args));
}
-static s7_pointer big_bits(s7_scheme *sc, s7_pointer args, const char *name, int start, s7_function g_bits,
+static bool is_integer_via_method(s7_scheme *sc, s7_pointer p)
+{
+ if (s7_is_integer(p))
+ return(true);
+ if (has_methods(p))
+ {
+ s7_pointer f;
+ f = find_method(sc, find_let(sc, p), sc->IS_INTEGER);
+ if (f != sc->UNDEFINED)
+ return(is_true(sc, s7_apply_function(sc, f, cons(sc, p, sc->NIL))));
+ }
+ return(false);
+}
+
+static s7_pointer big_bits(s7_scheme *sc, s7_pointer args, s7_pointer sym, int start, s7_function g_bits,
void (*mpz_bits)(mpz_ptr, mpz_srcptr, mpz_srcptr))
{
- int i;
- s7_pointer x;
+ s7_pointer x, lst;
bool use_bigs = false;
- for (i = 1, x = args; x != sc->NIL; x = cdr(x), i++)
+ for (x = args; is_not_null(x); x = cdr(x))
{
- if (!s7_is_integer(car(x)))
- return(s7_wrong_type_arg_error(sc, name, i, car(x), "an integer"));
- if ((is_c_object(car(x))) &&
- (c_object_type(car(x)) == big_integer_tag))
- use_bigs = true;
+ if (!is_integer_via_method(sc, car(x)))
+ return(wrong_type_argument(sc, sym, position_of(x, args), car(x), T_INTEGER));
+ if (!use_bigs) use_bigs = (type(car(x)) != T_INTEGER);
}
if (use_bigs)
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set_si(*n, 0);
+ mpz_t n;
+ mpz_init_set_si(n, 0);
if (start == -1)
- mpz_sub_ui(*n, *n, 1);
- for (x = args; x != sc->NIL; x = cdr(x))
- mpz_bits(*n, *n, S7_BIG_INTEGER(promote_number(sc, T_BIG_INTEGER, car(x))));
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ mpz_sub_ui(n, n, 1);
+ for (x = args; is_not_null(x); x = cdr(x))
+ {
+ s7_pointer i;
+ i = car(x);
+ switch (type(i))
+ {
+ case T_BIG_INTEGER:
+ mpz_bits(n, n, big_integer(i));
+ break;
+
+ case T_INTEGER:
+ mpz_bits(n, n, big_integer(s7_int_to_big_integer(sc, integer(i))));
+ break;
+
+ default:
+ /* we know it's an integer of some sort, but what about the method */
+ lst = cons(sc, mpz_to_big_integer(sc, n), x);
+ mpz_clear(n);
+ method_or_bust(sc, i, sym, lst, T_INTEGER, position_of(x, args));
+ }
+ }
+ x = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(x);
}
return(g_bits(sc, args));
}
@@ -29481,31 +70362,33 @@ static s7_pointer big_bits(s7_scheme *sc, s7_pointer args, const char *name, int
static s7_pointer big_logand(s7_scheme *sc, s7_pointer args)
{
- if (args == sc->NIL)
- return(small_negative_ints[1]);
- return(big_bits(sc, args, "logand", -1, g_logand, mpz_and));
+ if (is_null(args))
+ return(minus_one);
+ return(big_bits(sc, args, sc->LOGAND, -1, g_logand, mpz_and));
}
static s7_pointer big_logior(s7_scheme *sc, s7_pointer args)
{
- if (args == sc->NIL)
+ if (is_null(args))
return(small_int(0));
- return(big_bits(sc, args, "logior", 0, g_logior, mpz_ior));
+ return(big_bits(sc, args, sc->LOGIOR, 0, g_logior, mpz_ior));
}
static s7_pointer big_logxor(s7_scheme *sc, s7_pointer args)
{
- if (args == sc->NIL)
+ if (is_null(args))
return(small_int(0));
- return(big_bits(sc, args, "logxor", 0, g_logxor, mpz_xor));
+ return(big_bits(sc, args, sc->LOGXOR, 0, g_logxor, mpz_xor));
}
static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
{
#define H_rationalize "(rationalize x err) returns the ratio with lowest denominator within err of x"
+ #define Q_rationalize s7_make_signature(sc, 3, sc->IS_RATIONAL, sc->IS_REAL, sc->IS_REAL)
+
/* currently (rationalize 1/0 1e18) -> 0
* remember to pad with many trailing zeros:
*
@@ -29514,49 +70397,69 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
* :(rationalize 0.1000000000000000 0)
* 1/10
*
- * PERHAPS: gmp number reader used if gmp -- could this be the trailing zeros problem? (why is the non-gmp case ok?)
- * also the bignum function is faking it.
+ * perhaps gmp number reader used if gmp -- could this be the trailing zeros problem? (why is the non-gmp case ok?)
+ * also the bignum function is faking it.
+ * (rationalize (real-part (bignum "0.1+i")) 0) -> 3602879701896397/36028797018963968
+ *
+ * a confusing case:
+ * > (rationalize 5925563891587147521650777143.74135805596e05)
+ * should be 148139097289678688041269428593533951399/250000
+ * but that requires more than 128 bits of bignum-precision.
*/
- s7_pointer p0, p1 = NULL;
+
+ s7_pointer p0, p1 = NULL, p;
mpfr_t error, ux, x0, x1;
mpz_t i, i0, i1;
double xx;
p0 = car(args);
if (!s7_is_real(p0))
- return(s7_wrong_type_arg_error(sc, "rationalize", (cdr(args) == sc->NIL) ? 0 : 1, p0, "a real"));
+ method_or_bust(sc, p0, sc->RATIONALIZE, args, T_REAL, 1);
/* p0 can be exact, but we still have to check it for simplification */
- if (cdr(args) != sc->NIL)
+ if (is_not_null(cdr(args)))
{
double err_x;
p1 = cadr(args);
if (!s7_is_real(p1)) /* (rationalize (expt 2 60) -) */
- return(s7_wrong_type_arg_error(sc, "rationalize error limit,", 2, p1, "a real"));
+ method_or_bust(sc, p1, sc->RATIONALIZE, args, T_REAL, 2);
- if (is_c_object(p1))
- mpfr_init_set(error, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p1)), GMP_RNDN);
- else mpfr_init_set_d(error, s7_number_to_real(p1), GMP_RNDN);
+ if (is_big_number(p1))
+ mpfr_init_set(error, big_real(promote_number(sc, T_BIG_REAL, p1)), GMP_RNDN);
+ else mpfr_init_set_d(error, real_to_double(sc, p1, "rationalize"), GMP_RNDN);
err_x = mpfr_get_d(error, GMP_RNDN);
- if (isnan(err_x))
- return(s7_out_of_range_error(sc, "rationalize", 2, cadr(args), "error term is NaN"));
+ if (is_NaN(err_x))
+ {
+ mpfr_clear(error);
+ return(out_of_range(sc, sc->RATIONALIZE, small_int(2), cadr(args), ITS_NAN));
+ }
if (mpfr_inf_p(error) != 0)
- return(small_int(0));
-
+ {
+ mpfr_clear(error);
+ return(small_int(0));
+ }
mpfr_abs(error, error, GMP_RNDN);
}
- else mpfr_init_set_d(error, default_rationalize_error, GMP_RNDN);
-
- if (is_c_object(p0))
- mpfr_init_set(ux, S7_BIG_REAL(promote_number(sc, T_BIG_REAL, p0)), GMP_RNDN);
- else mpfr_init_set_d(ux, s7_number_to_real(p0), GMP_RNDN);
+ else mpfr_init_set_d(error, sc->default_rationalize_error, GMP_RNDN);
- xx = mpfr_get_d(ux, GMP_RNDN);
- if (isnan(xx))
- return(s7_out_of_range_error(sc, "rationalize", 1, car(args), "argument is NaN"));
+ if (is_big_number(p0))
+ mpfr_init_set(ux, big_real(promote_number(sc, T_BIG_REAL, p0)), GMP_RNDN);
+ else mpfr_init_set_d(ux, real_to_double(sc, p0, "rationalize"), GMP_RNDN);
+
+ xx = mpfr_get_d(ux, GMP_RNDN);
+ if (is_NaN(xx))
+ {
+ mpfr_clear(ux);
+ mpfr_clear(error);
+ return(out_of_range(sc, sc->RATIONALIZE, small_int(1), car(args), ITS_NAN));
+ }
if (mpfr_inf_p(ux) != 0)
- return(s7_out_of_range_error(sc, "rationalize", 1, car(args), "argument is infinite"));
+ {
+ mpfr_clear(ux);
+ mpfr_clear(error);
+ return(out_of_range(sc, sc->RATIONALIZE, small_int(1), car(args), ITS_INFINITE));
+ }
mpfr_init_set(x0, ux, GMP_RNDN); /* x0 = ux - error */
mpfr_sub(x0, x0, error, GMP_RNDN);
@@ -29564,61 +70467,63 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
mpfr_add(x1, x1, error, GMP_RNDN);
mpz_init(i);
mpfr_get_z(i, x0, GMP_RNDU); /* i = ceil(x0) */
-
+
if (mpfr_cmp_ui(error, 1) >= 0) /* if (error >= 1.0) */
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
-
+ mpz_t n;
+
if (mpfr_cmp_ui(x0, 0) < 0) /* if (x0 < 0) */
{
if (mpfr_cmp_ui(x1, 0) < 0) /* if (x1 < 0) */
{
- mpz_init(*n);
- mpfr_get_z(*n, x1, GMP_RNDD); /* num = floor(x1) */
+ mpz_init(n);
+ mpfr_get_z(n, x1, GMP_RNDD); /* num = floor(x1) */
}
- else mpz_init_set_ui(*n, 0); /* else num = 0 */
+ else mpz_init_set_ui(n, 0); /* else num = 0 */
}
- else mpz_init_set(*n, i); /* else num = i */
-
+ else mpz_init_set(n, i); /* else num = i */
+
mpz_clear(i);
mpfr_clear(ux);
mpfr_clear(x0);
mpfr_clear(x1);
mpfr_clear(error);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
-
+
if (mpfr_cmp_z(x1, i) >= 0) /* if (x1 >= i) */
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
-
- if (mpz_cmp_ui(i, 0) >= 0) /* if (i >= 0) */
- mpz_init_set(*n, i); /* num = i */
+ mpz_t n;
+
+ if (mpz_cmp_ui(i, 0) >= 0) /* if (i >= 0) */
+ mpz_init_set(n, i); /* num = i */
else
{
- mpz_init(*n);
- mpfr_get_z(*n, x1, GMP_RNDD); /* else num = floor(x1) */
+ mpz_init(n);
+ mpfr_get_z(n, x1, GMP_RNDD); /* else num = floor(x1) */
}
-
+
mpz_clear(i);
mpfr_clear(ux);
mpfr_clear(x0);
mpfr_clear(x1);
mpfr_clear(error);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
-
+
{
mpz_t p0, q0, r, r1, p1, q1, old_p1, old_q1;
mpfr_t val, e0, e1, e0p, e1p, old_e0, old_e1, old_e0p;
-
+
mpz_init(i0);
mpz_init(i1);
mpfr_get_z(i0, x0, GMP_RNDD); /* i0 = floor(x0) */
mpfr_get_z(i1, x1, GMP_RNDU); /* i1 = ceil(x1) */
-
+
mpz_init_set(p0, i0); /* p0 = i0 */
mpz_init_set_ui(q0, 1); /* q0 = 1 */
mpz_init_set(p1, i1); /* p1 = i1 */
@@ -29633,35 +70538,34 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
mpfr_sub_z(e0p, x1, i1, GMP_RNDN); /* e0p = i1 - x1 */
mpfr_neg(e0p, e0p, GMP_RNDN);
mpfr_sub_z(e1p, x1, i0, GMP_RNDN); /* e1p = x1 - i0 */
-
+
mpfr_init(val);
-
+
mpfr_init(old_e0);
mpfr_init(old_e1);
mpfr_init(old_e0p);
-
+
mpz_init(r);
mpz_init(r1);
mpz_init(old_p1);
mpz_init(old_q1);
-
+
while (true)
{
mpfr_set_z(val, p0, GMP_RNDN);
mpfr_div_z(val, val, q0, GMP_RNDN); /* val = p0/q0 */
-
+
if (((mpfr_cmp(x0, val) <= 0) && /* if ((x0 <= val) && (val <= x1)) */
(mpfr_cmp(val, x1) <= 0)) ||
(mpfr_cmp_ui(e1, 0) == 0) ||
- (mpfr_cmp_ui(e1p, 0) == 0))
+ (mpfr_cmp_ui(e1p, 0) == 0))
/* these last 2 are probably not needed -- they protect against running out of bits in the non-gmp case above */
{
- mpq_t *q;
- q = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*q);
- mpq_set_num(*q, p0); /* return(p0/q0) */
- mpq_set_den(*q, q0);
-
+ mpq_t q;
+ mpq_init(q);
+ mpq_set_num(q, p0); /* return(p0/q0) */
+ mpq_set_den(q, q0);
+
mpz_clear(i);
mpz_clear(i0);
mpz_clear(i1);
@@ -29669,7 +70573,7 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
mpfr_clear(x0);
mpfr_clear(x1);
mpfr_clear(error);
-
+
mpz_clear(p0);
mpz_clear(q0);
mpz_clear(r);
@@ -29678,7 +70582,7 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
mpz_clear(q1);
mpz_clear(old_p1);
mpz_clear(old_q1);
-
+
mpfr_clear(val);
mpfr_clear(e0);
mpfr_clear(e1);
@@ -29687,52 +70591,56 @@ static s7_pointer big_rationalize(s7_scheme *sc, s7_pointer args)
mpfr_clear(old_e0);
mpfr_clear(old_e1);
mpfr_clear(old_e0p);
-
- return(s7_make_object(sc, big_ratio_tag, (void *)q));
+
+ p = mpq_to_big_ratio(sc, q);
+ mpq_clear(q);
+ return(p);
}
-
+
mpfr_div(val, e0, e1, GMP_RNDN);
mpfr_get_z(r, val, GMP_RNDD); /* r = floor(e0/e1) */
mpfr_div(val, e0p, e1p, GMP_RNDN);
mpfr_get_z(r1, val, GMP_RNDU); /* r1 = ceil(e0p/e1p) */
if (mpz_cmp(r1, r) < 0) /* if (r1 < r) */
mpz_set(r, r1); /* r = r1 */
-
+
mpz_set(old_p1, p1); /* old_p1 = p1 */
mpz_set(p1, p0); /* p1 = p0 */
mpz_set(old_q1, q1); /* old_q1 = q1 */
mpz_set(q1, q0); /* q1 = q0 */
-
+
mpfr_set(old_e0, e0, GMP_RNDN); /* old_e0 = e0 */
mpfr_set(e0, e1p, GMP_RNDN); /* e0 = e1p */
mpfr_set(old_e0p, e0p, GMP_RNDN); /* old_e0p = e0p */
mpfr_set(e0p, e1, GMP_RNDN); /* e0p = e1 */
mpfr_set(old_e1, e1, GMP_RNDN); /* old_e1 = e1 */
-
+
mpz_mul(p0, p0, r); /* p0 = old_p1 + r * p0 */
- mpz_add(p0, p0, old_p1);
-
+ mpz_add(p0, p0, old_p1);
+
mpz_mul(q0, q0, r); /* q0 = old_q1 + r * q0 */
- mpz_add(q0, q0, old_q1);
-
+ mpz_add(q0, q0, old_q1);
+
mpfr_mul_z(e1, e1p, r, GMP_RNDN); /* e1 = old_e0p - r * e1p */
- mpfr_sub(e1, old_e0p, e1, GMP_RNDN);
-
+ mpfr_sub(e1, old_e0p, e1, GMP_RNDN);
+
mpfr_mul_z(e1p, old_e1, r, GMP_RNDN); /* e1p = old_e0 - r * old_e1 */
- mpfr_sub(e1p, old_e0, e1p, GMP_RNDN);
+ mpfr_sub(e1p, old_e0, e1p, GMP_RNDN);
}
}
}
-
+#if (!WITH_PURE_S7)
static s7_pointer big_exact_to_inexact(s7_scheme *sc, s7_pointer args)
{
#define H_exact_to_inexact "(exact->inexact num) converts num to an inexact number; (exact->inexact 3/2) = 1.5"
+ #define Q_exact_to_inexact pcl_r
+
s7_pointer p;
p = car(args);
if (!s7_is_number(p)) /* apparently (exact->inexact 1+i) is not an error */
- return(s7_wrong_type_arg_error(sc, "exact->inexact", 0, p, "a number"));
+ method_or_bust_with_type(sc, p, sc->EXACT_TO_INEXACT, args, A_NUMBER, 0);
if (!s7_is_rational(p))
return(p);
@@ -29744,6 +70652,7 @@ static s7_pointer big_exact_to_inexact(s7_scheme *sc, s7_pointer args)
static s7_pointer big_inexact_to_exact(s7_scheme *sc, s7_pointer args)
{
#define H_inexact_to_exact "(inexact->exact num) converts num to an exact number; (inexact->exact 1.5) = 3/2"
+ #define Q_inexact_to_exact s7_make_signature(sc, 2, sc->IS_RATIONAL, sc->IS_REAL)
s7_pointer p;
p = car(args);
@@ -29752,132 +70661,132 @@ static s7_pointer big_inexact_to_exact(s7_scheme *sc, s7_pointer args)
return(p);
if (!s7_is_real(p))
- return(s7_wrong_type_arg_error(sc, "inexact->exact", 0, p, "a real number"));
-
+ method_or_bust(sc, p, sc->INEXACT_TO_EXACT, args, T_REAL, 0);
return(big_rationalize(sc, args));
}
+#endif
-
-static s7_pointer big_convert_to_int(s7_scheme *sc, s7_pointer args,
- const char *caller,
+static s7_pointer big_convert_to_int(s7_scheme *sc, s7_pointer args, s7_pointer sym,
void (*div_func)(mpz_ptr, mpz_srcptr, mpz_srcptr),
mp_rnd_t mode)
{
/* we can't go to the normal (non-gmp) functions here */
s7_pointer p;
- p = car(args);
+ mpz_t n;
+ p = car(args);
if (!s7_is_real(p))
- return(s7_wrong_type_arg_error(sc, caller, 0, p, "a real"));
+ method_or_bust(sc, p, sym, args, T_REAL, 0);
if (s7_is_integer(p))
return(p);
p = to_big(sc, p);
-
- if (c_object_type(p) == big_ratio_tag)
+ if (is_t_big_ratio(p))
{
/* apparently we have to do the divide by hand */
mpz_t d;
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, mpq_numref(S7_BIG_RATIO(p)));
- mpz_init_set(d, mpq_denref(S7_BIG_RATIO(p)));
- div_func(*n, *n, d);
+ mpz_init_set(n, mpq_numref(big_ratio(p)));
+ mpz_init_set(d, mpq_denref(big_ratio(p)));
+ div_func(n, n, d);
mpz_clear(d);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
}
+ else
+ {
+ if ((g_is_nan(sc, args) == sc->T) ||
+ (g_is_infinite(sc, args)) == sc->T)
+ return(simple_out_of_range(sc, sym, p, (g_is_nan(sc, args) == sc->T) ? ITS_NAN : ITS_INFINITE));
- if ((big_is_nan(sc, args) == sc->T) ||
- (big_is_infinite(sc, args)) == sc->T)
- return(s7_out_of_range_error(sc, caller, 0, p, "argument is NaN or infinite"));
-
- {
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init(*n);
- mpfr_get_z(*n, S7_BIG_REAL(p), mode);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
- }
+ mpz_init(n);
+ mpfr_get_z(n, big_real(p), mode);
+ }
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
static s7_pointer big_floor(s7_scheme *sc, s7_pointer args)
{
#define H_floor "(floor x) returns the integer closest to x toward -inf"
- return(big_convert_to_int(sc, args, "floor", mpz_fdiv_q, GMP_RNDD));
+ #define Q_floor s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_REAL)
+
+ return(big_convert_to_int(sc, args, sc->FLOOR, mpz_fdiv_q, GMP_RNDD));
}
static s7_pointer big_ceiling(s7_scheme *sc, s7_pointer args)
{
#define H_ceiling "(ceiling x) returns the integer closest to x toward inf"
- return(big_convert_to_int(sc, args, "ceiling", mpz_cdiv_q, GMP_RNDU));
+ #define Q_ceiling s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_REAL)
+
+ return(big_convert_to_int(sc, args, sc->CEILING, mpz_cdiv_q, GMP_RNDU));
}
static s7_pointer big_truncate(s7_scheme *sc, s7_pointer args)
{
#define H_truncate "(truncate x) returns the integer closest to x toward 0"
- return(big_convert_to_int(sc, args, "truncate", mpz_tdiv_q, GMP_RNDZ));
+ #define Q_truncate s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_REAL)
+
+ return(big_convert_to_int(sc, args, sc->TRUNCATE, mpz_tdiv_q, GMP_RNDZ));
}
static s7_pointer big_round(s7_scheme *sc, s7_pointer args)
{
#define H_round "(round x) returns the integer closest to x"
+ #define Q_round s7_make_signature(sc, 2, sc->IS_INTEGER, sc->IS_REAL)
+
s7_pointer p;
+ mpz_t n;
p = car(args);
-
if (!s7_is_real(p))
- return(s7_wrong_type_arg_error(sc, "round", 0, p, "a real"));
+ method_or_bust(sc, p, sc->ROUND, args, T_REAL, 0);
if (s7_is_integer(p))
return(p);
p = to_big(sc, p);
-
- if (c_object_type(p) == big_integer_tag)
+ if (is_t_big_integer(p))
return(p);
- if (c_object_type(p) == big_ratio_tag)
+ if (is_t_big_ratio(p))
{
int rnd;
- mpz_t *n;
mpz_t rm;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, mpq_numref(S7_BIG_RATIO(p)));
+ mpz_init_set(n, mpq_numref(big_ratio(p)));
mpz_init(rm);
- mpz_fdiv_qr(*n, rm, *n, mpq_denref(S7_BIG_RATIO(p)));
+ mpz_fdiv_qr(n, rm, n, mpq_denref(big_ratio(p)));
mpz_mul_ui(rm, rm, 2);
- rnd = mpz_cmpabs(rm, mpq_denref(S7_BIG_RATIO(p)));
- mpz_fdiv_q(rm, rm, mpq_denref(S7_BIG_RATIO(p)));
+ rnd = mpz_cmpabs(rm, mpq_denref(big_ratio(p)));
+ mpz_fdiv_q(rm, rm, mpq_denref(big_ratio(p)));
if (rnd > 0)
- mpz_add(*n, *n, rm);
+ mpz_add(n, n, rm);
else
{
if (rnd == 0)
{
- if (mpz_odd_p(*n))
- mpz_add_ui(*n, *n, 1);
+ if (mpz_odd_p(n))
+ mpz_add_ui(n, n, 1);
}
}
mpz_clear(rm);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
- if ((big_is_nan(sc, args) == sc->T) ||
- (big_is_infinite(sc, args)) == sc->T)
- return(s7_out_of_range_error(sc, "round", 0, p, "argument is NaN or infinite"));
+ if ((g_is_nan(sc, args) == sc->T) ||
+ (g_is_infinite(sc, args)) == sc->T)
+ return(simple_out_of_range(sc, sc->ROUND, p, (g_is_nan(sc, args) == sc->T) ? ITS_NAN : ITS_INFINITE));
{
int cmp_res;
- mpz_t *n;
mpz_t fl, ce;
mpfr_t x, dfl, dce;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpfr_init_set(x, S7_BIG_REAL(p), GMP_RNDN);
+ mpfr_init_set(x, big_real(p), GMP_RNDN);
mpz_init(fl);
mpfr_get_z(fl, x, GMP_RNDD); /* fl = floor(x) */
mpz_init(ce);
@@ -29889,16 +70798,16 @@ static s7_pointer big_round(s7_scheme *sc, s7_pointer args)
mpfr_neg(dce, dce, GMP_RNDN); /* and reversed */
cmp_res = mpfr_cmp(dfl, dce);
if (cmp_res > 0) /* if (dfl > dce) return(ce) */
- mpz_init_set(*n, ce);
+ mpz_init_set(n, ce);
else
{
if (cmp_res < 0) /* if (dfl < dce) return(fl) */
- mpz_init_set(*n, fl);
+ mpz_init_set(n, fl);
else
{
if (mpz_even_p(fl))
- mpz_init_set(*n, fl); /* if (mod(fl, 2) == 0) return(fl) */
- else mpz_init_set(*n, ce); /* else return(ce) */
+ mpz_init_set(n, fl); /* if (mod(fl, 2) == 0) return(fl) */
+ else mpz_init_set(n, ce); /* else return(ce) */
}
}
mpz_clear(fl);
@@ -29906,7 +70815,9 @@ static s7_pointer big_round(s7_scheme *sc, s7_pointer args)
mpfr_clear(dfl);
mpfr_clear(dce);
mpfr_clear(x);
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
}
@@ -29914,67 +70825,75 @@ static s7_pointer big_round(s7_scheme *sc, s7_pointer args)
static s7_pointer big_quotient(s7_scheme *sc, s7_pointer args)
{
#define H_quotient "(quotient x1 x2) returns the integer quotient of x1 and x2; (quotient 4 3) = 1"
+ #define Q_quotient pcl_r
- s7_pointer x, y;
+ s7_pointer x, y, p;
x = car(args);
y = cadr(args);
if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "quotient", 1, x, "a real"));
+ method_or_bust(sc, x, sc->QUOTIENT, args, T_REAL, 1);
+
if (!s7_is_real(y))
- return(s7_wrong_type_arg_error(sc, "quotient", 2, y, "a real"));
+ method_or_bust(sc, y, sc->QUOTIENT, args, T_REAL, 2);
if ((s7_is_integer(x)) &&
(s7_is_integer(y)))
{
- mpz_t *n;
+ mpz_t n;
x = to_big(sc, x);
y = to_big(sc, y);
- if (big_is_zero_1(sc, y) == sc->T)
- return(division_by_zero_error(sc, "quotient", args));
-
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, S7_BIG_INTEGER(x));
- mpz_tdiv_q(*n, *n, S7_BIG_INTEGER(y));
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ if (s7_is_zero(y))
+ return(division_by_zero_error(sc, sc->QUOTIENT, args));
+
+ mpz_init_set(n, big_integer(x));
+ mpz_tdiv_q(n, n, big_integer(y));
+
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
- return(big_truncate(sc, make_list_1(sc, big_divide(sc, args))));
+ return(big_truncate(sc, set_plist_1(sc, big_divide(sc, args))));
}
static s7_pointer big_remainder(s7_scheme *sc, s7_pointer args)
{
#define H_remainder "(remainder x1 x2) returns the integer remainder of x1 and x2; (remainder 10 3) = 1"
- s7_pointer x, y;
+ #define Q_remainder pcl_r
+
+ s7_pointer x, y, p;
x = car(args);
y = cadr(args);
if (!s7_is_real(x))
- return(s7_wrong_type_arg_error(sc, "remainder", 1, x, "a real"));
+ method_or_bust(sc, x, sc->REMAINDER, args, T_REAL, 1);
+
if (!s7_is_real(y))
- return(s7_wrong_type_arg_error(sc, "remainder", 2, y, "a real"));
+ method_or_bust(sc, y, sc->REMAINDER, args, T_REAL, 2);
if ((s7_is_integer(x)) &&
(s7_is_integer(y)))
{
- mpz_t *n;
+ mpz_t n;
x = to_big(sc, x);
y = to_big(sc, y);
- if (big_is_zero_1(sc, y) == sc->T)
- return(division_by_zero_error(sc, "remainder", args));
-
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, S7_BIG_INTEGER(x));
- mpz_tdiv_r(*n, *n, S7_BIG_INTEGER(y));
- return(s7_make_object(sc, big_integer_tag, (void *)n));
- }
+ if (s7_is_zero(y))
+ return(division_by_zero_error(sc, sc->REMAINDER, args));
+
+ mpz_init_set(n, big_integer(x));
+ mpz_tdiv_r(n, n, big_integer(y));
- return(big_subtract(sc,
- make_list_2(sc, x,
- big_multiply(sc,
- make_list_2(sc, y,
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
+ }
+ return(big_subtract(sc,
+ list_2(sc, x,
+ big_multiply(sc,
+ set_plist_2(sc, y,
big_quotient(sc, args))))));
}
@@ -29982,15 +70901,17 @@ static s7_pointer big_remainder(s7_scheme *sc, s7_pointer args)
static s7_pointer big_modulo(s7_scheme *sc, s7_pointer args)
{
#define H_modulo "(modulo x1 x2) returns x1 mod x2; (modulo 4 3) = 1. The arguments can be real numbers."
- s7_pointer a, b;
+ #define Q_modulo pcl_r
+
+ s7_pointer a, b, p;
a = car(args);
if (!s7_is_real(a))
- return(s7_wrong_type_arg_error(sc, "modulo", 1, a, "a real"));
+ method_or_bust(sc, a, sc->MODULO, args, T_REAL, 1);
b = cadr(args);
if (!s7_is_real(b))
- return(s7_wrong_type_arg_error(sc, "modulo", 2, b, "a real"));
+ method_or_bust(sc, b, sc->MODULO, args, T_REAL, 2);
a = to_big(sc, a);
b = to_big(sc, b);
@@ -30000,50 +70921,50 @@ static s7_pointer big_modulo(s7_scheme *sc, s7_pointer args)
{
s7_pointer x, y;
int cy, cz;
- mpz_t *n;
-
+ mpz_t n;
+
y = promote_number(sc, T_BIG_INTEGER, b);
- if (mpz_cmp_ui(S7_BIG_INTEGER(y), 0) == 0)
+ if (mpz_cmp_ui(big_integer(y), 0) == 0)
return(a);
-
+
x = promote_number(sc, T_BIG_INTEGER, a);
/* mpz_mod is too tricky here */
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, S7_BIG_INTEGER(x));
- mpz_fdiv_r(*n, *n, S7_BIG_INTEGER(y));
- cy = mpz_cmp_ui(S7_BIG_INTEGER(y), 0);
- cz = mpz_cmp_ui(*n, 0);
+
+ mpz_init_set(n, big_integer(x));
+ mpz_fdiv_r(n, n, big_integer(y));
+ cy = mpz_cmp_ui(big_integer(y), 0);
+ cz = mpz_cmp_ui(n, 0);
if (((cy < 0) && (cz > 0)) ||
((cy > 0) && (cz < 0)))
- mpz_add(*n, *n, S7_BIG_INTEGER(y));
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ mpz_add(n, n, big_integer(y));
+
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
-
- return(big_subtract(sc,
- make_list_2(sc, a,
- big_multiply(sc,
- make_list_2(sc, b,
- big_floor(sc,
- make_list_1(sc,
- big_divide(sc,
- make_list_2(sc, a, b)))))))));
+ return(big_subtract(sc,
+ list_2(sc, a,
+ big_multiply(sc,
+ list_2(sc, b,
+ big_floor(sc,
+ set_plist_1(sc,
+ big_divide(sc,
+ set_plist_2(sc, a, b)))))))));
}
static int big_real_scan_args(s7_scheme *sc, s7_pointer args)
{
- int i, result_type = NUM_INT;
+ int i, result_type = T_INTEGER;
s7_pointer arg;
- for (i = 1, arg = args; arg != sc->NIL; i++, arg = cdr(arg))
+ for (i = 1, arg = args; is_not_null(arg); i++, arg = cdr(arg))
{
s7_pointer p;
p = car(arg);
- if (!s7_is_real(p))
+ if (!is_real_via_method(sc, p))
return(-i);
- if (IS_BIG(p))
- result_type |= SHIFT_BIGNUM_TYPE(c_object_type(p));
- else result_type |= number_type(p);
+ result_type = get_result_type(sc, result_type, p);
}
return(result_type);
}
@@ -30053,46 +70974,42 @@ static s7_pointer big_max(s7_scheme *sc, s7_pointer args)
{
int result_type;
s7_pointer x, result, arg;
-
+
result_type = big_real_scan_args(sc, args);
if (result_type < 0)
- return(s7_wrong_type_arg_error(sc, "max", -result_type, s7_list_ref(sc, args, -1 - result_type), "a real number"));
+ return(wrong_type_argument(sc, sc->MAX, -result_type, s7_list_ref(sc, args, -1 - result_type), T_REAL));
- if (IS_NUM(result_type))
+ if (result_type < T_BIG_INTEGER)
return(g_max(sc, args));
- result_type = canonicalize_result_type(result_type);
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->MAX, args);
+
result = promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->MAX, cons(sc, result, x));
+
arg = promote_number(sc, result_type, car(x));
switch (result_type)
{
- case T_BIG_INTEGER:
- if (mpz_cmp(S7_BIG_INTEGER(result), S7_BIG_INTEGER(arg)) < 0)
- result = arg;
- break;
-
- case T_BIG_RATIO:
- if (mpq_cmp(S7_BIG_RATIO(result), S7_BIG_RATIO(arg)) < 0)
- result = arg;
- break;
-
- case T_BIG_REAL:
- if (mpfr_cmp(S7_BIG_REAL(result), S7_BIG_REAL(arg)) < 0)
- result = arg;
- break;
+ case T_BIG_INTEGER: if (mpz_cmp(big_integer(result), big_integer(arg)) < 0) result = arg; break;
+ case T_BIG_RATIO: if (mpq_cmp(big_ratio(result), big_ratio(arg)) < 0) result = arg; break;
+ case T_BIG_REAL: if (mpfr_cmp(big_real(result), big_real(arg)) < 0) result = arg; break;
}
}
if (result_type == T_BIG_RATIO) /* maybe actual result was an int */
{
- if (mpz_cmp_ui(mpq_denref(S7_BIG_RATIO(result)), 1) == 0)
+ if (mpz_cmp_ui(mpq_denref(big_ratio(result)), 1) == 0)
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, mpq_numref(S7_BIG_RATIO(result)));
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ mpz_t n;
+ s7_pointer p;
+ mpz_init_set(n, mpq_numref(big_ratio(result)));
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
}
return(result);
@@ -30103,46 +71020,42 @@ static s7_pointer big_min(s7_scheme *sc, s7_pointer args)
{
int result_type;
s7_pointer x, result, arg;
-
+
result_type = big_real_scan_args(sc, args);
if (result_type < 0)
- return(s7_wrong_type_arg_error(sc, "min", -result_type, s7_list_ref(sc, args, -1 - result_type), "a real number"));
+ return(wrong_type_argument(sc, sc->MIN, -result_type, s7_list_ref(sc, args, -1 - result_type), T_REAL));
- if (IS_NUM(result_type))
+ if (result_type < T_BIG_INTEGER)
return(g_min(sc, args));
- result_type = canonicalize_result_type(result_type);
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->MIN, args);
+
result = promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->MIN, cons(sc, result, x));
+
arg = promote_number(sc, result_type, car(x));
switch (result_type)
{
- case T_BIG_INTEGER:
- if (mpz_cmp(S7_BIG_INTEGER(result), S7_BIG_INTEGER(arg)) > 0)
- result = arg;
- break;
-
- case T_BIG_RATIO:
- if (mpq_cmp(S7_BIG_RATIO(result), S7_BIG_RATIO(arg)) > 0)
- result = arg;
- break;
-
- case T_BIG_REAL:
- if (mpfr_cmp(S7_BIG_REAL(result), S7_BIG_REAL(arg)) > 0)
- result = arg;
- break;
+ case T_BIG_INTEGER: if (mpz_cmp(big_integer(result), big_integer(arg)) > 0) result = arg; break;
+ case T_BIG_RATIO: if (mpq_cmp(big_ratio(result), big_ratio(arg)) > 0) result = arg; break;
+ case T_BIG_REAL: if (mpfr_cmp(big_real(result), big_real(arg)) > 0) result = arg; break;
}
}
if (result_type == T_BIG_RATIO) /* maybe actual result was an int */
{
- if (mpz_cmp_ui(mpq_denref(S7_BIG_RATIO(result)), 1) == 0)
+ if (mpz_cmp_ui(mpq_denref(big_ratio(result)), 1) == 0)
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init_set(*n, mpq_numref(S7_BIG_RATIO(result)));
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ mpz_t n;
+ s7_pointer p;
+ mpz_init_set(n, mpq_numref(big_ratio(result)));
+ p = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(p);
}
}
return(result);
@@ -30152,33 +71065,35 @@ static s7_pointer big_min(s7_scheme *sc, s7_pointer args)
static s7_pointer big_less(s7_scheme *sc, s7_pointer args)
{
#define H_less "(< x1 ...) returns #t if its arguments are in increasing order"
+ #define Q_less s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_REAL)
+
int result_type;
s7_pointer x, previous, current;
-
+
result_type = big_real_scan_args(sc, args);
if (result_type < 0)
- return(s7_wrong_type_arg_error(sc, "<", -result_type, s7_list_ref(sc, args, -1 - result_type), "a real number"));
+ return(wrong_type_argument(sc, sc->LT, -result_type, s7_list_ref(sc, args, -1 - result_type), T_REAL));
/* don't try to use g_less here */
- result_type = canonicalize_result_type(result_type);
+ if (result_type < T_BIG_INTEGER)
+ result_type += 4;
+
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->LT, args);
+
previous = promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->LT, cons(sc, previous, x));
+
current = promote_number(sc, result_type, car(x));
switch (result_type)
{
- case T_BIG_INTEGER:
- if (mpz_cmp(S7_BIG_INTEGER(previous), S7_BIG_INTEGER(current)) >= 0) return(sc->F);
- break;
-
- case T_BIG_RATIO:
- if (mpq_cmp(S7_BIG_RATIO(previous), S7_BIG_RATIO(current)) >= 0) return(sc->F);
- break;
-
- case T_BIG_REAL:
- if (mpfr_cmp(S7_BIG_REAL(previous), S7_BIG_REAL(current)) >= 0) return(sc->F);
- break;
+ case T_BIG_INTEGER: if (mpz_cmp(big_integer(previous), big_integer(current)) >= 0) return(sc->F); break;
+ case T_BIG_RATIO: if (mpq_cmp(big_ratio(previous), big_ratio(current)) >= 0) return(sc->F); break;
+ case T_BIG_REAL: if (mpfr_cmp(big_real(previous), big_real(current)) >= 0) return(sc->F); break;
}
previous = current;
}
@@ -30189,32 +71104,34 @@ static s7_pointer big_less(s7_scheme *sc, s7_pointer args)
static s7_pointer big_less_or_equal(s7_scheme *sc, s7_pointer args)
{
#define H_less_or_equal "(<= x1 ...) returns #t if its arguments are in increasing order"
+ #define Q_less_or_equal s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_REAL)
+
int result_type;
s7_pointer x, previous, current;
-
+
result_type = big_real_scan_args(sc, args);
if (result_type < 0)
- return(s7_wrong_type_arg_error(sc, "<=", -result_type, s7_list_ref(sc, args, -1 - result_type), "a real number"));
+ return(wrong_type_argument(sc, sc->LEQ, -result_type, s7_list_ref(sc, args, -1 - result_type), T_REAL));
+
+ if (result_type < T_BIG_INTEGER)
+ result_type += 4;
+
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->LEQ, args);
- result_type = canonicalize_result_type(result_type);
previous = promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->LEQ, cons(sc, previous, x));
+
current = promote_number(sc, result_type, car(x));
switch (result_type)
{
- case T_BIG_INTEGER:
- if (mpz_cmp(S7_BIG_INTEGER(previous), S7_BIG_INTEGER(current)) > 0) return(sc->F);
- break;
-
- case T_BIG_RATIO:
- if (mpq_cmp(S7_BIG_RATIO(previous), S7_BIG_RATIO(current)) > 0) return(sc->F);
- break;
-
- case T_BIG_REAL:
- if (mpfr_cmp(S7_BIG_REAL(previous), S7_BIG_REAL(current)) > 0) return(sc->F);
- break;
+ case T_BIG_INTEGER: if (mpz_cmp(big_integer(previous), big_integer(current)) > 0) return(sc->F); break;
+ case T_BIG_RATIO: if (mpq_cmp(big_ratio(previous), big_ratio(current)) > 0) return(sc->F); break;
+ case T_BIG_REAL: if (mpfr_cmp(big_real(previous), big_real(current)) > 0) return(sc->F); break;
}
previous = current;
}
@@ -30225,32 +71142,33 @@ static s7_pointer big_less_or_equal(s7_scheme *sc, s7_pointer args)
static s7_pointer big_greater(s7_scheme *sc, s7_pointer args)
{
#define H_greater "(> x1 ...) returns #t if its arguments are in decreasing order"
+ #define Q_greater s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_REAL)
+
int result_type;
s7_pointer x, previous, current;
result_type = big_real_scan_args(sc, args);
if (result_type < 0)
- return(s7_wrong_type_arg_error(sc, ">", -result_type, s7_list_ref(sc, args, -1 - result_type), "a real number"));
+ return(wrong_type_argument(sc, sc->GT, -result_type, s7_list_ref(sc, args, -1 - result_type), T_REAL));
+
+ if (result_type < T_BIG_INTEGER)
+ result_type += 4;
+
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->GT, args);
- result_type = canonicalize_result_type(result_type);
previous = promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->GT, cons(sc, previous, x));
current = promote_number(sc, result_type, car(x));
switch (result_type)
{
- case T_BIG_INTEGER:
- if (mpz_cmp(S7_BIG_INTEGER(previous), S7_BIG_INTEGER(current)) <= 0) return(sc->F);
- break;
-
- case T_BIG_RATIO:
- if (mpq_cmp(S7_BIG_RATIO(previous), S7_BIG_RATIO(current)) <= 0) return(sc->F);
- break;
-
- case T_BIG_REAL:
- if (mpfr_cmp(S7_BIG_REAL(previous), S7_BIG_REAL(current)) <= 0) return(sc->F);
- break;
+ case T_BIG_INTEGER: if (mpz_cmp(big_integer(previous), big_integer(current)) <= 0) return(sc->F); break;
+ case T_BIG_RATIO: if (mpq_cmp(big_ratio(previous), big_ratio(current)) <= 0) return(sc->F); break;
+ case T_BIG_REAL: if (mpfr_cmp(big_real(previous), big_real(current)) <= 0) return(sc->F); break;
}
previous = current;
}
@@ -30261,32 +71179,32 @@ static s7_pointer big_greater(s7_scheme *sc, s7_pointer args)
static s7_pointer big_greater_or_equal(s7_scheme *sc, s7_pointer args)
{
#define H_greater_or_equal "(>= x1 ...) returns #t if its arguments are in decreasing order"
+ #define Q_greater_or_equal s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_REAL)
+
int result_type;
s7_pointer x, previous, current;
-
+
result_type = big_real_scan_args(sc, args);
if (result_type < 0)
- return(s7_wrong_type_arg_error(sc, ">=", -result_type, s7_list_ref(sc, args, -1 - result_type), "a real number"));
+ return(wrong_type_argument(sc, sc->GEQ, -result_type, s7_list_ref(sc, args, -1 - result_type), T_REAL));
+
+ if (result_type < T_BIG_INTEGER)
+ result_type += 4;
- result_type = canonicalize_result_type(result_type);
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->GEQ, args);
previous = promote_number(sc, result_type, car(args));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
+ if (!s7_is_number(car(x)))
+ check_method(sc, car(x), sc->GEQ, cons(sc, previous, x));
current = promote_number(sc, result_type, car(x));
switch (result_type)
{
- case T_BIG_INTEGER:
- if (mpz_cmp(S7_BIG_INTEGER(previous), S7_BIG_INTEGER(current)) < 0) return(sc->F);
- break;
-
- case T_BIG_RATIO:
- if (mpq_cmp(S7_BIG_RATIO(previous), S7_BIG_RATIO(current)) < 0) return(sc->F);
- break;
-
- case T_BIG_REAL:
- if (mpfr_cmp(S7_BIG_REAL(previous), S7_BIG_REAL(current)) < 0) return(sc->F);
- break;
+ case T_BIG_INTEGER: if (mpz_cmp(big_integer(previous), big_integer(current)) < 0) return(sc->F); break;
+ case T_BIG_RATIO: if (mpq_cmp(big_ratio(previous), big_ratio(current)) < 0) return(sc->F); break;
+ case T_BIG_REAL: if (mpfr_cmp(big_real(previous), big_real(current)) < 0) return(sc->F); break;
}
previous = current;
}
@@ -30296,67 +71214,64 @@ static s7_pointer big_greater_or_equal(s7_scheme *sc, s7_pointer args)
static s7_pointer big_equal(s7_scheme *sc, s7_pointer args)
{
- int i, result_type = NUM_INT;
+ #define Q_equal s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_NUMBER)
+
+ /* this is morally-equal? for bignums, the other case goes through big_numbers_are_eqv */
+ int result_type = T_INTEGER;
s7_pointer x, y, result;
+ bool got_nan = false;
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
+ for (x = args; is_not_null(x); x = cdr(x))
{
s7_pointer p;
p = car(x);
- if (type(p) != T_NUMBER)
+ if (!s7_is_number(p))
{
- if (!IS_BIG(p))
- return(s7_wrong_type_arg_error(sc, "=", i, p, "a number"));
- else result_type |= SHIFT_BIGNUM_TYPE(c_object_type(p));
+ check_method(sc, car(args), sc->EQ, x);
+ return(wrong_type_argument_with_type(sc, sc->EQ, position_of(x, args), p, A_NUMBER));
}
- else
- {
- switch (number_type(p))
- {
- case NUM_INT:
- case NUM_RATIO:
- break;
- case NUM_REAL:
- case NUM_REAL2:
- if (isnan(real(number(p)))) /* (= (bignum "3") 1/0) */
- return(sc->F);
-
- default:
- if ((isnan(real_part(number(p)))) ||
- (isnan(imag_part(number(p)))))
- return(sc->F);
- }
- result_type |= number_type(p);
- }
+ result_type = get_result_type(sc, result_type, p);
+ if (!got_nan)
+ got_nan = (((is_t_real(p)) && (is_NaN(real(p)))) || /* (= (bignum "3") 1/0) */
+ ((is_t_complex(p)) && ((is_NaN(real_part(p))) || (is_NaN(imag_part(p))))));
}
+ if (got_nan) return(sc->F); /* put this off until here so that non-numbers anywhere in the arg list will raise an error */
- if (IS_NUM(result_type))
+ if (result_type < T_BIG_INTEGER)
return(g_equal(sc, args));
- result_type = canonicalize_result_type(result_type);
result = promote_number(sc, result_type, car(args));
-
- for (y = cdr(args); y != sc->NIL; y = cdr(y))
+ for (y = cdr(args); is_not_null(y); y = cdr(y))
{
s7_pointer arg;
arg = promote_number(sc, result_type, car(y));
switch (result_type)
{
- case T_BIG_INTEGER:
- if (mpz_cmp(S7_BIG_INTEGER(result), S7_BIG_INTEGER(arg)) != 0) return(sc->F);
+ case T_BIG_INTEGER:
+ if (mpz_cmp(big_integer(result), big_integer(arg)) != 0) return(sc->F);
break;
-
- case T_BIG_RATIO:
- if (mpq_cmp(S7_BIG_RATIO(result), S7_BIG_RATIO(arg)) != 0) return(sc->F);
+
+ case T_BIG_RATIO:
+ if (mpq_cmp(big_ratio(result), big_ratio(arg)) != 0) return(sc->F);
break;
-
- case T_BIG_REAL:
- if (mpfr_cmp(S7_BIG_REAL(result), S7_BIG_REAL(arg)) != 0) return(sc->F);
+
+ case T_BIG_REAL:
+ {
+ mpfr_t *a1;
+ a1 = s7_double_to_mpfr(sc->morally_equal_float_epsilon);
+ if (mpfr_cmp(big_real(big_abs(sc, set_plist_1(sc, big_subtract(sc, set_plist_2(sc, result, arg))))), *a1) > 0)
+ return(sc->F);
+ }
break;
-
- case T_BIG_COMPLEX:
- if (mpc_cmp(S7_BIG_COMPLEX(result), S7_BIG_COMPLEX(arg)) != 0) return(sc->F);
+
+ case T_BIG_COMPLEX:
+ {
+ mpfr_t *a1;
+ a1 = s7_double_to_mpfr(sc->morally_equal_float_epsilon);
+ if (mpfr_cmp(big_real(big_magnitude(sc, set_plist_1(sc, big_subtract(sc, set_plist_2(sc, result, arg))))), *a1) > 0)
+ return(sc->F);
+ }
break;
}
}
@@ -30367,49 +71282,73 @@ static s7_pointer big_equal(s7_scheme *sc, s7_pointer args)
static s7_pointer big_gcd(s7_scheme *sc, s7_pointer args)
{
#define H_gcd "(gcd ...) returns the greatest common divisor of its rational arguments"
- int i;
+ #define Q_gcd pcl_f
+
bool rats = false;
- s7_pointer x;
+ s7_pointer x, lst;
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_rational(car(x)))
- return(s7_wrong_type_arg_error(sc, "gcd", i, car(x), "an integer or ratio"));
- else rats = ((rats) || (!s7_is_integer(car(x))));
+ for (x = args; is_not_null(x); x = cdr(x))
+ {
+ if (!is_rational_via_method(sc, car(x)))
+ return(wrong_type_argument_with_type(sc, sc->GCD, position_of(x, args), car(x), A_RATIONAL));
+ if (!rats)
+ rats = (!is_integer_via_method(sc, car(x)));
+ }
- if (cdr(args) == sc->NIL) /* (gcd -2305843009213693951/4611686018427387903) */
- return(big_abs(sc, args));
+ if (is_null(cdr(args))) /* (gcd -2305843009213693951/4611686018427387903) */
+ return(big_abs(sc, args));
if (!rats)
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init(*n);
- for (x = args; x != sc->NIL; x = cdr(x))
+ mpz_t n;
+ mpz_init(n);
+ for (x = args; is_not_null(x); x = cdr(x))
{
- mpz_gcd(*n, *n, S7_BIG_INTEGER(promote_number(sc, T_BIG_INTEGER, car(x))));
- if (mpz_cmp_ui(*n, 1) == 0)
+ if (!s7_is_number(car(x)))
+ {
+ lst = cons(sc, mpz_to_big_integer(sc, n), x);
+ mpz_clear(n);
+ method_or_bust(sc, car(x), sc->GCD, lst, T_INTEGER, position_of(x, args));
+ }
+ mpz_gcd(n, n, big_integer(promote_number(sc, T_BIG_INTEGER, car(x))));
+ if (mpz_cmp_ui(n, 1) == 0)
{
- mpz_clear(*n);
- free(n);
+ mpz_clear(n);
return(small_int(1));
}
}
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ x = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(x);
}
{
s7_pointer rat;
- mpq_t *q;
+ mpq_t q;
mpz_t n, d;
-
+
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->GCD, args);
+
rat = promote_number(sc, T_BIG_RATIO, car(args));
- mpz_init_set(n, mpq_numref(S7_BIG_RATIO(rat)));
- mpz_init_set(d, mpq_denref(S7_BIG_RATIO(rat)));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+ mpz_init_set(n, mpq_numref(big_ratio(rat)));
+ mpz_init_set(d, mpq_denref(big_ratio(rat)));
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
+ if (!s7_is_number(car(x)))
+ {
+ mpq_init(q);
+ mpq_set_num(q, n);
+ mpq_set_den(q, d);
+ lst = cons(sc, mpq_to_big_ratio(sc, q), x);
+ mpz_clear(n);
+ mpz_clear(d);
+ mpq_clear(q);
+ method_or_bust_with_type(sc, car(x), sc->GCD, lst, A_RATIONAL, position_of(x, args));
+ }
rat = promote_number(sc, T_BIG_RATIO, car(x));
- mpz_gcd(n, n, mpq_numref(S7_BIG_RATIO(rat)));
- mpz_lcm(d, d, mpq_denref(S7_BIG_RATIO(rat)));
+ mpz_gcd(n, n, mpq_numref(big_ratio(rat)));
+ mpz_lcm(d, d, mpq_denref(big_ratio(rat)));
}
if (mpz_cmp_ui(d, 1) == 0)
{
@@ -30418,13 +71357,16 @@ static s7_pointer big_gcd(s7_scheme *sc, s7_pointer args)
mpz_clear(d);
return(rat);
}
- q = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*q);
- mpq_set_num(*q, n);
- mpq_set_den(*q, d);
+
+ mpq_init(q);
+ mpq_set_num(q, n);
+ mpq_set_den(q, d);
mpz_clear(n);
mpz_clear(d);
- return(s7_make_object(sc, big_ratio_tag, (void *)q));
+
+ x = mpq_to_big_ratio(sc, q);
+ mpq_clear(q);
+ return(x);
}
}
@@ -30432,62 +71374,89 @@ static s7_pointer big_gcd(s7_scheme *sc, s7_pointer args)
static s7_pointer big_lcm(s7_scheme *sc, s7_pointer args)
{
#define H_lcm "(lcm ...) returns the least common multiple of its rational arguments"
- s7_pointer x;
- int i;
+ #define Q_lcm pcl_f
+
+ s7_pointer x, lst;
bool rats = false;
- for (i = 1, x = args; x != sc->NIL; i++, x = cdr(x))
- if (!s7_is_rational(car(x)))
- return(s7_wrong_type_arg_error(sc, "lcm", i, car(x), "an integer or ratio"));
- else rats = ((rats) || (!s7_is_integer(car(x))));
-
- if (cdr(args) == sc->NIL) /* (lcm -2305843009213693951/4611686018427387903) */
- return(big_abs(sc, args));
-
+ for (x = args; is_not_null(x); x = cdr(x))
+ {
+ if (!is_rational_via_method(sc, car(x)))
+ return(wrong_type_argument_with_type(sc, sc->LCM, position_of(x, args), car(x), A_RATIONAL));
+ if (!rats)
+ rats = (!is_integer_via_method(sc, car(x)));
+ }
+
+ if (is_null(cdr(args))) /* (lcm -2305843009213693951/4611686018427387903) */
+ return(big_abs(sc, args));
+
if (!rats)
{
- mpz_t *n;
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init(*n);
- mpz_set_ui(*n, 1);
- for (x = args; x != sc->NIL; x = cdr(x))
+ mpz_t n;
+ mpz_init(n);
+ mpz_set_ui(n, 1);
+ for (x = args; is_not_null(x); x = cdr(x))
{
- mpz_lcm(*n, *n, S7_BIG_INTEGER(promote_number(sc, T_BIG_INTEGER, car(x))));
- if (mpz_cmp_ui(*n, 0) == 0)
+ if (!s7_is_number(car(x)))
+ {
+ lst = cons(sc, mpz_to_big_integer(sc, n), x);
+ mpz_clear(n);
+ method_or_bust(sc, car(x), sc->LCM, lst, T_INTEGER, position_of(x, args));
+ }
+ mpz_lcm(n, n, big_integer(promote_number(sc, T_BIG_INTEGER, car(x))));
+ if (mpz_cmp_ui(n, 0) == 0)
{
- mpz_clear(*n);
- free(n);
+ mpz_clear(n);
return(small_int(0));
}
}
- return(s7_make_object(sc, big_integer_tag, (void *)n));
+ x = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(x);
}
{
s7_pointer rat;
- mpq_t *q;
+ mpq_t q;
mpz_t n, d;
-
+
+ if (!s7_is_number(car(args)))
+ check_method(sc, car(args), sc->LCM, args);
+
rat = promote_number(sc, T_BIG_RATIO, car(args));
- mpz_init_set(n, mpq_numref(S7_BIG_RATIO(rat)));
+ mpz_init_set(n, mpq_numref(big_ratio(rat)));
if (mpz_cmp_ui(n, 0) == 0)
{
mpz_clear(n);
return(small_int(0));
}
- mpz_init_set(d, mpq_denref(S7_BIG_RATIO(rat)));
- for (x = cdr(args); x != sc->NIL; x = cdr(x))
+
+ mpz_init_set(d, mpq_denref(big_ratio(rat)));
+ for (x = cdr(args); is_not_null(x); x = cdr(x))
{
+ if (!s7_is_number(car(x)))
+ {
+ mpq_init(q);
+ mpq_set_num(q, n);
+ mpq_set_den(q, d);
+ lst = cons(sc, mpq_to_big_ratio(sc, q), x);
+ mpz_clear(n);
+ mpz_clear(d);
+ mpq_clear(q);
+ method_or_bust_with_type(sc, car(x), sc->LCM, lst, A_RATIONAL, position_of(x, args));
+ }
+
rat = promote_number(sc, T_BIG_RATIO, car(x));
- mpz_lcm(n, n, mpq_numref(S7_BIG_RATIO(rat)));
+ mpz_lcm(n, n, mpq_numref(big_ratio(rat)));
if (mpz_cmp_ui(n, 0) == 0)
{
mpz_clear(n);
mpz_clear(d);
return(small_int(0));
}
- mpz_gcd(d, d, mpq_denref(S7_BIG_RATIO(rat)));
+ mpz_gcd(d, d, mpq_denref(big_ratio(rat)));
}
+
if (mpz_cmp_ui(d, 1) == 0)
{
rat = mpz_to_big_integer(sc, n);
@@ -30495,1283 +71464,2110 @@ static s7_pointer big_lcm(s7_scheme *sc, s7_pointer args)
mpz_clear(d);
return(rat);
}
- q = (mpq_t *)malloc(sizeof(mpq_t));
- mpq_init(*q);
- mpq_set_num(*q, n);
- mpq_set_den(*q, d);
+
+ mpq_init(q);
+ mpq_set_num(q, n);
+ mpq_set_den(q, d);
mpz_clear(n);
mpz_clear(d);
- return(s7_make_object(sc, big_ratio_tag, (void *)q));
+ x = mpq_to_big_ratio(sc, q);
+ mpq_clear(q);
+ return(x);
}
}
-static s7_pointer g_bignum_precision(s7_scheme *sc, s7_pointer args)
+static s7_pointer set_bignum_precision(s7_scheme *sc, int precision)
{
- #define H_bignum_precision "(bignum-precision) returns the number of bits used for floats and complex numbers. It can be set."
- return(s7_make_integer(sc, (int)mpfr_get_default_prec()));
+ mp_prec_t bits;
+ if (precision <= 1) /* (set! (*s7* 'bignum-precision) 1) causes mpfr to segfault! (also 0 and -1) */
+ return(s7_out_of_range_error(sc, "set! (*s7* 'bignum-precision)", 0, make_integer(sc, precision), "has to be greater than 1"));
+
+ bits = (mp_prec_t)precision;
+ mpfr_set_default_prec(bits);
+ mpc_set_default_precision(bits);
+ s7_symbol_set_value(sc, sc->PI, big_pi(sc));
+ return(sc->F);
}
-static s7_pointer g_set_bignum_precision(s7_scheme *sc, s7_pointer args)
+static s7_pointer big_random_state(s7_scheme *sc, s7_pointer args)
{
- mp_prec_t bits;
- s7_Int precision;
+ #define H_random_state "(random-state seed) returns a new random number state initialized with 'seed'. \
+Pass this as the second argument to 'random' to get a repeatable random number sequence:\n\
+ (let ((seed (random-state 1234))) (random 1.0 seed))"
+ #define Q_random_state s7_make_circular_signature(sc, 1, 2, sc->IS_RANDOM_STATE, sc->IS_INTEGER)
- if (!s7_is_integer(car(args)))
- return(s7_wrong_type_arg_error(sc, "set! bignum-precision", 0, car(args), "an integer"));
+ s7_pointer r, seed;
+ seed = car(args);
+ if (!s7_is_integer(seed))
+ method_or_bust(sc, seed, sc->RANDOM_STATE, args, T_INTEGER, 0);
- precision = s7_integer(car(args));
- if (precision <= 1) /* (set! (bignum-precision) 1) causes mpfr to segfault! (also 0 and -1) */
- return(s7_out_of_range_error(sc, "set! bignum-precision", 0, car(args), "has to be greater than 1"));
+ if (type(seed) != T_BIG_INTEGER)
+ seed = promote_number(sc, T_BIG_INTEGER, seed);
- bits = (mp_prec_t)precision;
- mpfr_set_default_prec(bits);
- mpc_set_default_precision(bits);
- s7_symbol_set_value(sc, make_symbol(sc, "pi"), big_pi(sc));
- return(car(args));
+ new_cell(sc, r, T_RANDOM_STATE);
+ gmp_randinit_default(random_gmp_state(r));
+ gmp_randseed(random_gmp_state(r), big_integer(seed));
+ return(r);
}
-typedef struct {
- gmp_randstate_t state;
-} s7_big_rng_t;
+static s7_pointer big_random(s7_scheme *sc, s7_pointer args)
+{
+ #define H_random "(random num (state #f)) returns a random number between 0 and num (0 if num=0)."
+ #define Q_random s7_make_signature(sc, 3, sc->IS_NUMBER, sc->IS_NUMBER, sc->IS_RANDOM_STATE)
+ s7_pointer num, state, x;
+ num = car(args);
+ if (!s7_is_number(num))
+ method_or_bust_with_type(sc, num, sc->RANDOM, args, A_NUMBER, 1);
-static char *print_big_rng(s7_scheme *sc, void *val)
-{
- char *buf;
- s7_big_rng_t *r = (s7_big_rng_t *)val;
- buf = (char *)malloc(64 * sizeof(char));
- snprintf(buf, 64, "#<big-rng %p>", r);
- return(buf);
-}
+ state = sc->default_rng;
+ if (is_not_null(cdr(args)))
+ {
+ state = cadr(args);
+ if (!is_random_state(state))
+ return(wrong_type_argument_with_type(sc, sc->RANDOM, 2, state, A_RANDOM_STATE_OBJECT));
+ }
+
+ if (s7_is_zero(num))
+ return(num);
+ if (!is_big_number(num))
+ {
+ switch (type(num))
+ {
+ case T_INTEGER: num = promote_number(sc, T_BIG_INTEGER, num); break;
+ case T_RATIO: num = promote_number(sc, T_BIG_RATIO, num); break;
+ case T_REAL: num = promote_number(sc, T_BIG_REAL, num); break;
+ default: num = promote_number(sc, T_BIG_COMPLEX, num); break;
+ }
+ }
+
+ switch (type(num))
+ {
+ case T_BIG_INTEGER:
+ {
+ mpz_t n;
+ mpz_init(n);
+ mpz_urandomm(n, random_gmp_state(state), big_integer(num));
+
+ /* this does not work if num is a negative number -- you get positive results.
+ * so check num for sign, and negate result if necessary.
+ */
+ if (mpz_cmp_ui(big_integer(num), 0) < 0)
+ mpz_neg(n, n);
+
+ x = mpz_to_big_integer(sc, n);
+ mpz_clear(n);
+ return(x);
+ }
+
+ case T_BIG_RATIO:
+ {
+ mpfr_t n, e;
+ mpfr_t rat;
+
+ mpfr_init_set_ui(n, 1, GMP_RNDN);
+ mpfr_urandomb(n, random_gmp_state(state));
+ mpfr_init_set_q(rat, big_ratio(num), GMP_RNDN);
+ mpfr_mul(n, n, rat, GMP_RNDN);
+
+ mpfr_init_set_str(e, "0.0000001", 10, GMP_RNDN);
+ mpfr_mul(e, e, rat, GMP_RNDN);
+ mpfr_clear(rat);
+ /* as in g_random, small ratios are a problem because the error term (sc->default_rationalize_error = 1e-12 here)
+ * clobbers everything to 0.
+ */
+ x = big_rationalize(sc, set_plist_2(sc, mpfr_to_big_real(sc, n), mpfr_to_big_real(sc, e)));
+ mpfr_clear(n);
+ mpfr_clear(e);
+ return(x);
+ }
+
+ case T_BIG_REAL:
+ {
+ mpfr_t n;
+ mpfr_init_set_ui(n, 1, GMP_RNDN);
+ mpfr_urandomb(n, random_gmp_state(state));
+ mpfr_mul(n, n, big_real(num), GMP_RNDN);
+ x = mpfr_to_big_real(sc, n);
+ mpfr_clear(n);
+ return(x);
+ }
+
+ case T_BIG_COMPLEX:
+ {
+ mpc_t n;
+ mpc_init(n);
+ mpc_urandom(n, random_gmp_state(state));
+ mpfr_mul(mpc_realref(n), mpc_realref(n), mpc_realref(big_complex(num)), GMP_RNDN);
+ mpfr_mul(mpc_imagref(n), mpc_imagref(n), mpc_imagref(big_complex(num)), GMP_RNDN);
+ x = mpc_to_big_complex(sc, n);
+ mpc_clear(n);
+ return(x);
+ }
+ }
+ return(sc->F); /* make the compiler happy */
+}
-static void free_big_rng(void *val)
+s7_double s7_random(s7_scheme *sc, s7_pointer state)
{
- s7_big_rng_t *r = (s7_big_rng_t *)val;
- gmp_randclear(r->state);
- free(r);
+ s7_pointer p;
+ p = big_random(sc, set_plist_1(sc, (state) ? state : sc->default_rng));
+ return((s7_double)mpfr_get_d(big_real(p), GMP_RNDN));
}
-static bool equal_big_rng(void *val1, void *val2)
+static void s7_gmp_init(s7_scheme *sc)
{
- return(val1 == val2);
+ #define big_defun(Scheme_Name, C_Name, Req, Opt, Rst) s7_define_typed_function(sc, Scheme_Name, big_ ## C_Name, Req, Opt, Rst, H_ ## C_Name, Q_ ## C_Name)
+ #define c_big_defun(Scheme_Name, C_Name, Req, Opt, Rst) s7_define_typed_function(sc, Scheme_Name, c_big_ ## C_Name, Req, Opt, Rst, H_ ## C_Name, Q_ ## C_Name)
+
+ sc->ADD = big_defun("+", add, 0, 0, true);
+ sc->SUBTRACT = big_defun("-", subtract, 1, 0, true);
+ sc->MULTIPLY = big_defun("*", multiply, 0, 0, true);
+ sc->DIVIDE = big_defun("/", divide, 1, 0, true);
+ sc->MAX = big_defun("max", max, 1, 0, true);
+ sc->MIN = big_defun("min", min, 1, 0, true);
+ sc->LT = big_defun("<", less, 2, 0, true);
+ sc->LEQ = big_defun("<=", less_or_equal, 2, 0, true);
+ sc->GT = big_defun(">", greater, 2, 0, true);
+ sc->GEQ = big_defun(">=", greater_or_equal, 2, 0, true);
+ sc->EQ = big_defun("=", equal, 2, 0, true);
+ sc->RATIONALIZE = big_defun("rationalize", rationalize, 1, 1, false);
+#if (!WITH_PURE_S7)
+ sc->EXACT_TO_INEXACT = big_defun("exact->inexact", exact_to_inexact, 1, 0, false);
+ sc->INEXACT_TO_EXACT = big_defun("inexact->exact", inexact_to_exact, 1, 0, false);
+ sc->INTEGER_LENGTH = big_defun("integer-length", integer_length, 1, 0, false);
+ sc->MAKE_RECTANGULAR = c_big_defun("make-rectangular", complex, 2, 0, false);
+ sc->MAKE_POLAR = big_defun("make-polar", make_polar, 2, 0, false);
+#endif
+ sc->FLOOR = big_defun("floor", floor, 1, 0, false);
+ sc->CEILING = big_defun("ceiling", ceiling, 1, 0, false);
+ sc->TRUNCATE = big_defun("truncate", truncate, 1, 0, false);
+ sc->ROUND = big_defun("round", round, 1, 0, false);
+ sc->QUOTIENT = big_defun("quotient", quotient, 2, 0, false);
+ sc->REMAINDER = big_defun("remainder", remainder, 2, 0, false);
+ sc->MODULO = big_defun("modulo", modulo, 2, 0, false);
+ sc->GCD = big_defun("gcd", gcd, 0, 0, true);
+ sc->LCM = big_defun("lcm", lcm, 0, 0, true);
+ sc->COMPLEX = c_big_defun("complex", complex, 2, 0, false);
+ sc->MAGNITUDE = big_defun("magnitude", magnitude, 1, 0, false);
+ sc->ANGLE = big_defun("angle", angle, 1, 0, false);
+ sc->ABS = big_defun("abs", abs, 1, 0, false);
+ sc->LOGNOT = big_defun("lognot", lognot, 1, 0, false);
+ sc->LOGIOR = big_defun("logior", logior, 0, 0, true);
+ sc->LOGXOR = big_defun("logxor", logxor, 0, 0, true);
+ sc->LOGAND = big_defun("logand", logand, 0, 0, true);
+ sc->ASH = big_defun("ash", ash, 2, 0, false);
+ sc->EXP = big_defun("exp", exp, 1, 0, false);
+ sc->EXPT = big_defun("expt", expt, 2, 0, false);
+ sc->LOG = big_defun("log", log, 1, 1, false);
+ sc->SQRT = big_defun("sqrt", sqrt, 1, 0, false);
+ sc->SIN = big_defun("sin", sin, 1, 0, false);
+ sc->COS = big_defun("cos", cos, 1, 0, false);
+ sc->TAN = big_defun("tan", tan, 1, 0, false);
+ sc->ASIN = big_defun("asin", asin, 1, 0, false);
+ sc->ACOS = big_defun("acos", acos, 1, 0, false);
+ sc->ATAN = big_defun("atan", atan, 1, 1, false);
+ sc->SINH = big_defun("sinh", sinh, 1, 0, false);
+ sc->COSH = big_defun("cosh", cosh, 1, 0, false);
+ sc->TANH = big_defun("tanh", tanh, 1, 0, false);
+ sc->ASINH = big_defun("asinh", asinh, 1, 0, false);
+ sc->ACOSH = big_defun("acosh", acosh, 1, 0, false);
+ sc->ATANH = big_defun("atanh", atanh, 1, 0, false);
+
+ sc->RANDOM = big_defun("random", random, 1, 1, false);
+ sc->RANDOM_STATE = big_defun("random-state", random_state, 1, 1, false);
+
+ sc->IS_BIGNUM = big_defun("bignum?", is_bignum, 1, 0, false); /* needed by Q_bignum below */
+ sc->BIGNUM = big_defun("bignum", bignum, 1, 1, false);
+
+ sc->bignum_precision = DEFAULT_BIGNUM_PRECISION;
+ mpfr_set_default_prec((mp_prec_t)DEFAULT_BIGNUM_PRECISION);
+ mpc_set_default_precision((mp_prec_t)DEFAULT_BIGNUM_PRECISION);
+
+ s7_symbol_set_value(sc, sc->PI, big_pi(sc));
+
+ /* if these fixnum limits were read as strings, they'd be bignums in the gmp case,
+ * so for consistency make the symbolic versions bignums as well.
+ */
+ s7_symbol_set_value(sc, make_symbol(sc, "most-positive-fixnum"), s7_int_to_big_integer(sc, s7_integer(s7_name_to_value(sc, "most-positive-fixnum"))));
+ s7_symbol_set_value(sc, make_symbol(sc, "most-negative-fixnum"), s7_int_to_big_integer(sc, s7_integer(s7_name_to_value(sc, "most-negative-fixnum"))));
+
+ s7_provide(sc, "gmp");
}
-
-static s7_pointer make_big_random_state(s7_scheme *sc, s7_pointer args)
+#endif
+/* WITH_GMP */
+
+
+
+/* -------------------------------- *s7* environment -------------------------------- */
+
+static void init_s7_let(s7_scheme *sc)
+{
+ sc->stack_top_symbol = s7_make_symbol(sc, "stack-top");
+ sc->stack_size_symbol = s7_make_symbol(sc, "stack-size");
+ sc->stacktrace_defaults_symbol = s7_make_symbol(sc, "stacktrace-defaults");
+ sc->symbol_table_is_locked_symbol = s7_make_symbol(sc, "symbol-table-locked?");
+ sc->heap_size_symbol = s7_make_symbol(sc, "heap-size");
+ sc->free_heap_size_symbol = s7_make_symbol(sc, "free-heap-size");
+ sc->gc_freed_symbol = s7_make_symbol(sc, "gc-freed");
+ sc->gc_protected_objects_symbol = s7_make_symbol(sc, "gc-protected-objects");
+ set_immutable(sc->gc_protected_objects_symbol);
+
+ sc->input_ports_symbol = s7_make_symbol(sc, "input-ports");
+ sc->output_ports_symbol = s7_make_symbol(sc, "output-ports");
+ sc->strings_symbol = s7_make_symbol(sc, "strings");
+ sc->gensyms_symbol = s7_make_symbol(sc, "gensyms");
+ sc->vectors_symbol = s7_make_symbol(sc, "vectors");
+ sc->hash_tables_symbol = s7_make_symbol(sc, "hash-tables");
+ sc->continuations_symbol = s7_make_symbol(sc, "continuations");
+
+ sc->c_objects_symbol = s7_make_symbol(sc, "c-objects");
+ sc->file_names_symbol = s7_make_symbol(sc, "file-names");
+ sc->symbol_table_symbol = s7_make_symbol(sc, "symbol-table");
+ sc->rootlet_size_symbol = s7_make_symbol(sc, "rootlet-size");
+ sc->c_types_symbol = s7_make_symbol(sc, "c-types");
+ sc->safety_symbol = s7_make_symbol(sc, "safety");
+ sc->undefined_identifier_warnings_symbol = s7_make_symbol(sc, "undefined-identifier-warnings");
+ sc->gc_stats_symbol = s7_make_symbol(sc, "gc-stats");
+ sc->max_stack_size_symbol = s7_make_symbol(sc, "max-stack-size");
+ sc->cpu_time_symbol = s7_make_symbol(sc, "cpu-time");
+ sc->catches_symbol = s7_make_symbol(sc, "catches");
+ sc->exits_symbol = s7_make_symbol(sc, "exits");
+ sc->stack_symbol = s7_make_symbol(sc, "stack");
+ sc->max_string_length_symbol = s7_make_symbol(sc, "max-string-length");
+ sc->max_list_length_symbol = s7_make_symbol(sc, "max-list-length");
+ sc->max_vector_length_symbol = s7_make_symbol(sc, "max-vector-length");
+ sc->max_vector_dimensions_symbol = s7_make_symbol(sc, "max-vector-dimensions");
+ sc->default_hash_table_length_symbol = s7_make_symbol(sc, "default-hash-table-length");
+ sc->initial_string_port_length_symbol = s7_make_symbol(sc, "initial-string-port-length");
+ sc->default_rationalize_error_symbol = s7_make_symbol(sc, "default-rationalize-error");
+ sc->default_random_state_symbol = s7_make_symbol(sc, "default-random-state");
+ sc->morally_equal_float_epsilon_symbol = s7_make_symbol(sc, "morally-equal-float-epsilon");
+ sc->hash_table_float_epsilon_symbol = s7_make_symbol(sc, "hash-table-float-epsilon");
+ sc->print_length_symbol = s7_make_symbol(sc, "print-length");
+ sc->bignum_precision_symbol = s7_make_symbol(sc, "bignum-precision");
+ sc->memory_usage_symbol = s7_make_symbol(sc, "memory-usage");
+ sc->float_format_precision_symbol = s7_make_symbol(sc, "float-format-precision");
+}
+
+#ifdef __linux__
+ #include <sys/resource.h>
+#endif
+
+static s7_pointer describe_memory_usage(s7_scheme *sc)
{
- #define H_make_random_state "(make-random-state seed) returns a new random number state initialized with 'seed'. \
-Pass this as the second argument to 'random' to get a repeatable random number sequence:\n\
- (let ((seed (make-random-state 1234))) (random 1.0 seed))"
+ /* heap, permanent, stack?, doc strings, sigs, c_func structs (and ports etc), vcts, mx_alloc, output bufs,
+ * sinc_tables, c-objects, rc_data, strbuf/tmpbuf[reallocs], autoload tables, hash_entrys, symbol_table,
+ * small_ints?
+ */
+ int i, syms = 0, len;
+ s7_pointer x;
- s7_big_rng_t *r;
- s7_pointer seed;
+#ifdef __linux__
+ struct rusage info;
+ getrusage(RUSAGE_SELF, &info);
+ fprintf(stderr, "process size: %lld\n", (s7_int)(info.ru_maxrss * 1024));
+#endif
- seed = car(args);
- if (!s7_is_integer(seed))
- return(s7_wrong_type_arg_error(sc, "make-random-state,", 0, seed, "an integer"));
+ fprintf(stderr, "heap: %u (%lld bytes)", sc->heap_size, (s7_int)(sc->heap_size * (sizeof(s7_pointer) + sizeof(s7_cell))));
+ {
+ unsigned int k;
+ int ts[NUM_TYPES];
+ for (i = 0; i < NUM_TYPES; i++) ts[i] = 0;
+ for (k = 0; k < sc->heap_size; k++)
+ ts[unchecked_type(sc->heap[k])]++;
+ for (i = 0; i < NUM_TYPES; i++)
+ {
+ if ((i % 10) == 0) fprintf(stderr, "\n ");
+ fprintf(stderr, " %d", ts[i]);
+ }
+ fprintf(stderr, "\n");
+ }
+ fprintf(stderr, "permanent cells: %d (%lld bytes)\n", permanent_cells, (s7_int)(permanent_cells * sizeof(s7_cell)));
- if (is_c_object(seed))
- {
- r = (s7_big_rng_t *)calloc(1, sizeof(s7_big_rng_t));
- gmp_randinit_default(r->state);
- gmp_randseed(r->state, S7_BIG_INTEGER(seed));
- return(s7_make_object(sc, big_rng_tag, (void *)r));
- }
+ for (i = 0; i < vector_length(sc->symbol_table); i++)
+ for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+ syms++;
+ fprintf(stderr, "symbol table: %d (%d symbols, %lld bytes)\n", SYMBOL_TABLE_SIZE, syms,
+ (s7_int)(SYMBOL_TABLE_SIZE * sizeof(s7_pointer) + syms * 3 * sizeof(s7_cell)));
- return(s7_make_random_state(sc, args));
-}
+ fprintf(stderr, "stack: %u (%lld bytes)\n", sc->stack_size, (s7_int)(sc->stack_size * sizeof(s7_pointer)));
+ fprintf(stderr, "c_functions: %d (%d bytes)\n", c_functions, (int)(c_functions * sizeof(c_proc_t)));
+ len = 0;
+ for (i = 0; i < (int)(sc->strings_loc); i++)
+ len += string_length(sc->strings[i]);
+ fprintf(stderr, "strings: %u, %d bytes\n", sc->strings_loc, len); /* also doc strings, permanent strings, etc */
-static s7_pointer big_random(s7_scheme *sc, s7_pointer args)
-{
- s7_pointer num, state;
- state = sc->NIL;
+ {
+ int hs;
+ hash_entry_t *p;
+ for (hs = 0, p = hash_free_list; p; p = (hash_entry_t *)(p->next), hs++);
- num = car(args);
- if (!s7_is_number(num))
- return(s7_wrong_type_arg_error(sc, "random", (cdr(args) == sc->NIL) ? 0 : 1, num, "a number"));
+ len = 0;
+ for (i = 0; i < (int)(sc->hash_tables_loc); i++)
+ len += (hash_table_mask(sc->hash_tables[i]) + 1);
+
+ fprintf(stderr, "hash tables: %d (%d %d), ", (int)(sc->hash_tables_loc), len, hs);
+ }
- if (cdr(args) != sc->NIL)
- {
- state = cadr(args);
- if ((!is_c_object(state)) ||
- ((c_object_type(state) != big_rng_tag) &&
- (c_object_type(state) != rng_tag)))
- return(s7_wrong_type_arg_error(sc, "random state,", 2, state, "a random-state object"));
+ {
+ int fs;
+ port_t *p;
+ for (fs = 0, p = sc->port_heap; p; p = (port_t *)(p->next), fs++);
+ fprintf(stderr, "vectors: %u, input: %u, output: %u, free port: %d\ncontinuations: %u, c_objects: %u, gensyms: %u, setters: %u\n",
+ sc->vectors_loc, sc->input_ports_loc, sc->output_ports_loc, fs, sc->continuations_loc, sc->c_objects_loc, sc->gensyms_loc, sc->setters_loc);
+ }
+ return(sc->F);
+}
+
+static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer sym;
+
+ sym = cadr(args);
+ if (!is_symbol(sym))
+ return(simple_wrong_type_argument(sc, sc->LET_REF, sym, T_SYMBOL));
+
+ if (sym == sc->print_length_symbol) /* print-length */
+ return(s7_make_integer(sc, sc->print_length));
+
+ if (sym == sc->stack_top_symbol) /* stack-top = #frames active (4 stack entries per frame) */
+ return(s7_make_integer(sc, (sc->stack_end - sc->stack_start) / 4));
+ if (sym == sc->stack_size_symbol) /* stack-size (max so far) */
+ return(s7_make_integer(sc, sc->stack_size));
+ if (sym == sc->max_stack_size_symbol) /* max-stack-size */
+ return(s7_make_integer(sc, sc->max_stack_size));
+ if (sym == sc->stacktrace_defaults_symbol) /* stacktrace-defaults (used to be *stacktrace*) */
+ return(sc->stacktrace_defaults);
+
+ if (sym == sc->symbol_table_is_locked_symbol) /* symbol-table-locked? */
+ return(make_boolean(sc, sc->symbol_table_is_locked));
+ if (sym == sc->symbol_table_symbol) /* symbol-table (the raw vector) */
+ return(sc->symbol_table);
+ if (sym == sc->rootlet_size_symbol) /* rootlet-size */
+ return(s7_make_integer(sc, sc->rootlet_entries));
+ if (sym == sc->safety_symbol) /* safety */
+ return(s7_make_integer(sc, sc->safety));
+ if (sym == sc->undefined_identifier_warnings_symbol) /* undefined-identifier-warnings */
+ return(s7_make_boolean(sc, sc->undefined_identifier_warnings));
+ if (sym == sc->cpu_time_symbol) /* cpu-time */
+ return(s7_make_real(sc, (double)clock() / (double)CLOCKS_PER_SEC));
+ if (sym == sc->catches_symbol) /* catches */
+ return(active_catches(sc));
+ if (sym == sc->exits_symbol) /* exits */
+ return(active_exits(sc));
+ if (sym == sc->stack_symbol) /* stack */
+ return(stack_entries(sc));
+
+ if (sym == sc->heap_size_symbol) /* heap-size */
+ return(s7_make_integer(sc, sc->heap_size));
+ if (sym == sc->free_heap_size_symbol) /* free-heap-size (number of unused cells in the heap) */
+ return(s7_make_integer(sc, sc->free_heap_top - sc->free_heap));
+ if (sym == sc->gc_freed_symbol) /* gc-freed = # cells freed during last GC sweep */
+ return(s7_make_integer(sc, sc->gc_freed));
+ if (sym == sc->gc_protected_objects_symbol) /* gc-protected-objects */
+ return(sc->protected_objects);
+ if (sym == sc->gc_stats_symbol) /* gc-stats */
+ return(make_integer(sc, sc->gc_stats));
+
+ if (sym == sc->default_rationalize_error_symbol) /* default-rationalize-error */
+ return(make_real(sc, sc->default_rationalize_error));
+ if (sym == sc->default_random_state_symbol) /* default-random-state */
+ return(sc->default_rng);
+
+ if (sym == sc->max_list_length_symbol) /* max-list-length (as arg to make-list) */
+ return(s7_make_integer(sc, sc->max_list_length));
+ if (sym == sc->max_vector_length_symbol) /* max-vector-length (as arg to make-vector and make-hash-table) */
+ return(s7_make_integer(sc, sc->max_vector_length));
+ if (sym == sc->max_vector_dimensions_symbol) /* max-vector-dimensions (make-vector) */
+ return(s7_make_integer(sc, sc->max_vector_dimensions));
+ if (sym == sc->max_string_length_symbol) /* max-string-length (as arg to make-string and read-string) */
+ return(s7_make_integer(sc, sc->max_string_length));
+ if (sym == sc->default_hash_table_length_symbol) /* default size for make-hash-table */
+ return(s7_make_integer(sc, sc->default_hash_table_length));
+ if (sym == sc->morally_equal_float_epsilon_symbol) /* morally-equal-float-epsilon */
+ return(s7_make_real(sc, sc->morally_equal_float_epsilon));
+ if (sym == sc->hash_table_float_epsilon_symbol) /* hash-table-float-epsilon */
+ return(s7_make_real(sc, sc->hash_table_float_epsilon));
+ if (sym == sc->initial_string_port_length_symbol) /* initial-string-port-length */
+ return(s7_make_integer(sc, sc->initial_string_port_length));
+
+ if (sym == sc->input_ports_symbol) /* input-ports */
+ return(make_vector_wrapper(sc, sc->input_ports_loc, sc->input_ports));
+ if (sym == sc->output_ports_symbol) /* output-ports */
+ return(make_vector_wrapper(sc, sc->output_ports_loc, sc->output_ports));
+ if (sym == sc->strings_symbol) /* strings */
+ return(make_vector_wrapper(sc, sc->strings_loc, sc->strings));
+ if (sym == sc->gensyms_symbol) /* gensyms */
+ return(make_vector_wrapper(sc, sc->gensyms_loc, sc->gensyms));
+ if (sym == sc->vectors_symbol) /* vectors */
+ return(make_vector_wrapper(sc, sc->vectors_loc, sc->vectors));
+ if (sym == sc->hash_tables_symbol) /* hash-tables */
+ return(make_vector_wrapper(sc, sc->hash_tables_loc, sc->hash_tables));
+ if (sym == sc->continuations_symbol) /* continuations */
+ return(make_vector_wrapper(sc, sc->continuations_loc, sc->continuations));
+ if (sym == sc->c_objects_symbol) /* c-objects */
+ return(make_vector_wrapper(sc, sc->c_objects_loc, sc->c_objects));
+
+ if (sym == sc->file_names_symbol) /* file-names (loaded files) */
+ return(make_vector_wrapper(sc, sc->file_names_top, sc->file_names));
+ if (sym == sc->c_types_symbol) /* c-types */
+ {
+ s7_pointer res;
+ int i;
+ sc->w = sc->NIL;
+ for (i = 0; i < num_object_types; i++) /* c-object type (tag) is i */
+ sc->w = cons(sc, object_types[i]->scheme_name, sc->w);
+ res = safe_reverse_in_place(sc, sc->w); /* so car(types) has tag 0 */
+ sc->w = sc->NIL;
+ return(res);
}
- if (big_is_zero(sc, args) == sc->T)
- return(num);
+ if (sym == sc->bignum_precision_symbol) /* bignum-precision */
+ return(s7_make_integer(sc, sc->bignum_precision));
+ if (sym == sc->float_format_precision_symbol) /* float-format-precision */
+ return(s7_make_integer(sc, float_format_precision));
+ if (sym == sc->memory_usage_symbol) /* memory-usage */
+ return(describe_memory_usage(sc));
- if ((is_c_object(num)) ||
- ((is_c_object(state)) &&
- (c_object_type(state) == big_rng_tag)))
- {
- /* bignum case -- provide a state if none was passed,
- * promote num if bignum state was passed but num is not a bignum
- * if num==0, just return 0 (above) since gmp otherwise throws an arithmetic exception
- */
- s7_big_rng_t *r = NULL;
+ /* sc->unlet is a scheme vector of slots -- not very useful at the scheme level */
+ return(sc->UNDEFINED);
+}
- if (state == sc->NIL)
- {
- /* no state passed, so make one */
+static s7_pointer g_s7_let_set_fallback(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer sym, val;
- if (!sc->default_big_rng)
- {
- mpz_t seed;
- r = (s7_big_rng_t *)calloc(1, sizeof(s7_big_rng_t));
- mpz_init_set_ui(seed, (unsigned int)time(NULL));
- gmp_randinit_default(r->state);
- gmp_randseed(r->state, seed);
- mpz_clear(seed);
- sc->default_big_rng = (void *)r;
- }
- else r = (s7_big_rng_t *)(sc->default_big_rng);
- }
- else
- {
- /* state was passed, check its type */
+ sym = cadr(args);
+ if (!is_symbol(sym))
+ return(simple_wrong_type_argument(sc, sc->LET_SET, sym, T_SYMBOL));
- if (c_object_type(state) == rng_tag)
+ val = caddr(args);
+
+ if ((sym == sc->print_length_symbol) ||
+ (sym == sc->max_vector_length_symbol) ||
+ (sym == sc->max_vector_dimensions_symbol) ||
+ (sym == sc->max_list_length_symbol) ||
+ (sym == sc->max_string_length_symbol))
+ {
+ if (s7_is_integer(val))
+ {
+ s7_int iv;
+ iv = s7_integer(val); /* might be bignum if gmp */
+ if (iv < 0)
+ return(simple_out_of_range(sc, sym, val, make_string_wrapper(sc, "should be a positive integer")));
+ if (sym == sc->print_length_symbol)
+ sc->print_length = iv;
+ else
{
- /* here "num" is a bignum, the state was passed, but it is intended for non-bignums */
- if (c_object_type(num) == big_real_tag)
- num = s7_make_real(sc, (s7_Double)mpfr_get_d(S7_BIG_REAL(num), GMP_RNDN));
+ if (sym == sc->max_vector_length_symbol)
+ sc->max_vector_length = iv;
else
{
- if (c_object_type(num) == big_integer_tag)
- num = s7_make_integer(sc, big_integer_to_s7_Int(S7_BIG_INTEGER(num)));
+ if (sym == sc->max_vector_dimensions_symbol)
+ sc->max_vector_dimensions = iv;
else
{
- if (c_object_type(num) == big_ratio_tag)
- num = s7_make_ratio(sc,
- big_integer_to_s7_Int(mpq_numref(S7_BIG_RATIO(num))),
- big_integer_to_s7_Int(mpq_denref(S7_BIG_RATIO(num))));
+ if (sym == sc->max_list_length_symbol)
+ sc->max_list_length = iv;
+ else sc->max_string_length = iv;
}
}
- return(g_random(sc, make_list_2(sc, num, state)));
}
- r = (s7_big_rng_t *)s7_object_value(state);
+ return(val);
}
+ return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+ }
+
+ if (sym == sc->gc_stats_symbol)
+ {
+ if (s7_is_boolean(val)) {sc->gc_stats = ((val == sc->T) ? GC_STATS : 0); return(val);}
+ if (s7_is_integer(val)) {sc->gc_stats = s7_integer(val); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_BOOLEAN));
+ }
+
+ if (sym == sc->symbol_table_is_locked_symbol)
+ {
+ if (s7_is_boolean(val)) {sc->symbol_table_is_locked = (val == sc->T); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_BOOLEAN));
+ }
- if (!is_c_object(num))
+ if (sym == sc->max_stack_size_symbol)
+ {
+ if (s7_is_integer(val))
{
- switch (number_type(num))
+ s7_int size;
+ size = s7_integer(val);
+ if (size >= INITIAL_STACK_SIZE)
{
- case NUM_INT:
- num = promote_number(sc, T_BIG_INTEGER, num);
- break;
+ sc->max_stack_size = (unsigned int)size;
+ return(val);
+ }
+ return(simple_out_of_range(sc, sym, val, make_string_wrapper(sc, "should be greater than the initial stack size (512)")));
+ }
+ return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+ }
- case NUM_RATIO:
- num = promote_number(sc, T_BIG_RATIO, num);
- break;
+ if (sym == sc->safety_symbol)
+ {
+ if (s7_is_integer(val)) {sc->safety = s7_integer(val); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+ }
- case NUM_REAL:
- case NUM_REAL2:
- num = promote_number(sc, T_BIG_REAL, num);
- break;
+ if (sym == sc->undefined_identifier_warnings_symbol)
+ {
+ if (s7_is_boolean(val)) {sc->undefined_identifier_warnings = s7_boolean(sc, val); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_BOOLEAN));
+ }
- default:
- num = promote_number(sc, T_BIG_COMPLEX, num);
- break;
- }
- }
+ if (sym == sc->default_hash_table_length_symbol)
+ {
+ if (s7_is_integer(val)) {sc->default_hash_table_length = s7_integer(val); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+ }
- /* finally both the state and the number are big */
-
- if (c_object_type(num) == big_integer_tag)
- {
- mpz_t *n;
+ if (sym == sc->initial_string_port_length_symbol)
+ {
+ if (s7_is_integer(val)) {sc->initial_string_port_length = s7_integer(val); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+ }
- n = (mpz_t *)malloc(sizeof(mpz_t));
- mpz_init(*n);
-#if HAVE_PTHREADS
- pthread_mutex_lock(&rng_lock);
-#endif
- mpz_urandomm(*n, r->state, S7_BIG_INTEGER(num));
- /* this does not work if num is a negative number -- you get positive results.
- * so check num for sign, and negate result if necessary.
- */
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&rng_lock);
+ if (sym == sc->morally_equal_float_epsilon_symbol)
+ {
+ if (s7_is_real(val)) {sc->morally_equal_float_epsilon = s7_real(val); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_REAL));
+ }
+
+ if (sym == sc->hash_table_float_epsilon_symbol)
+ {
+ if (s7_is_real(val)) {sc->hash_table_float_epsilon = s7_real(val); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_REAL));
+ }
+
+ if (sym == sc->float_format_precision_symbol)
+ {
+ if (s7_is_integer(val)) {float_format_precision = s7_integer(val); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+ }
+
+ if (sym == sc->default_rationalize_error_symbol)
+ {
+ if (s7_is_real(val)) {sc->default_rationalize_error = real_to_double(sc, val, "set! default-rationalize-error"); return(val);}
+ return(simple_wrong_type_argument(sc, sym, val, T_REAL));
+ }
+
+ if (sym == sc->default_random_state_symbol)
+ {
+ if (is_random_state(val))
+ {
+#if (!WITH_GMP)
+ random_seed(sc->default_rng) = random_seed(val);
+ random_carry(sc->default_rng) = random_carry(val);
#endif
- if (big_is_negative(sc, make_list_1(sc, num)) == sc->T) /* (random most-negative-fixnum) */
- return(big_negate(sc, make_list_1(sc, s7_make_object(sc, big_integer_tag, (void *)n))));
- return(s7_make_object(sc, big_integer_tag, (void *)n));
- }
-
- if (c_object_type(num) == big_ratio_tag)
- {
- mpfr_t *n, *e;
- mpfr_t rat;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set_ui(*n, 1, GMP_RNDN);
-#if HAVE_PTHREADS
- pthread_mutex_lock(&rng_lock);
-#endif
- mpfr_urandomb(*n, r->state);
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&rng_lock);
-#endif
- mpfr_init_set_q(rat, S7_BIG_RATIO(num), GMP_RNDN);
- mpfr_mul(*n, *n, rat, GMP_RNDN);
-
- e = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set_str(*e, "0.0000001", 10, GMP_RNDN);
- mpfr_mul(*e, *e, rat, GMP_RNDN);
- mpfr_clear(rat);
- /* as in g_random, small ratios are a problem because the error term (default_rationalize_error = 1e-12 here)
- * clobbers everything to 0.
- */
- return(big_rationalize(sc, make_list_2(sc, s7_make_object(sc, big_real_tag, (void *)n), s7_make_object(sc, big_real_tag, (void *)e))));
+ return(val);
}
-
- if (c_object_type(num) == big_real_tag)
+ return(wrong_type_argument_with_type(sc, sym, 1, val, A_RANDOM_STATE_OBJECT));
+ }
+
+ if (sym == sc->stacktrace_defaults_symbol)
+ {
+ if (!is_pair(val))
+ return(simple_wrong_type_argument(sc, sym, val, T_PAIR));
+ if (s7_list_length(sc, val) != 5)
+ return(simple_wrong_type_argument_with_type(sc, sym, val, make_string_wrapper(sc, "a list with 5 entries")));
+ if (!is_integer(car(val)))
+ return(wrong_type_argument_with_type(sc, sym, 1, car(val), make_string_wrapper(sc, "an integer (stack frames)")));
+ if (!is_integer(cadr(val)))
+ return(wrong_type_argument_with_type(sc, sym, 2, cadr(val), make_string_wrapper(sc, "an integer (cols-for-data)")));
+ if (!is_integer(caddr(val)))
+ return(wrong_type_argument_with_type(sc, sym, 3, caddr(val), make_string_wrapper(sc, "an integer (line length)")));
+ if (!is_integer(cadddr(val)))
+ return(wrong_type_argument_with_type(sc, sym, 4, cadddr(val), make_string_wrapper(sc, "an integer (comment position)")));
+ if (!s7_is_boolean(s7_list_ref(sc,val, 4)))
+ return(wrong_type_argument_with_type(sc, sym, 5, s7_list_ref(sc, val, 4), make_string_wrapper(sc, "a boolean (treat-data-as-comment)")));
+ sc->stacktrace_defaults = copy_list(sc, val);
+ return(val);
+ }
+
+ if (sym == sc->bignum_precision_symbol)
+ {
+ if (s7_is_integer(val))
{
- mpfr_t *n;
- n = (mpfr_t *)malloc(sizeof(mpfr_t));
- mpfr_init_set_ui(*n, 1, GMP_RNDN);
-#if HAVE_PTHREADS
- pthread_mutex_lock(&rng_lock);
-#endif
- mpfr_urandomb(*n, r->state);
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&rng_lock);
+ sc->bignum_precision = s7_integer(val);
+#if WITH_GMP
+ set_bignum_precision(sc, sc->bignum_precision);
#endif
- mpfr_mul(*n, *n, S7_BIG_REAL(num), GMP_RNDN);
- return(s7_make_object(sc, big_real_tag, (void *)n));
+ return(val);
}
+ return(simple_wrong_type_argument(sc, sym, val, T_INTEGER));
+ }
+
+ if ((sym == sc->cpu_time_symbol) ||
+ (sym == sc->heap_size_symbol) || (sym == sc->free_heap_size_symbol) ||
+ (sym == sc->gc_freed_symbol) || (sym == sc->gc_protected_objects_symbol) ||
+ (sym == sc->file_names_symbol) || (sym == sc->c_types_symbol) || (sym == sc->catches_symbol) || (sym == sc->exits_symbol) ||
+ (sym == sc->rootlet_size_symbol) ||
+ (sym == sc->stack_top_symbol) || (sym == sc->stack_size_symbol))
+ return(s7_error(sc, sc->ERROR, set_elist_2(sc, make_string_wrapper(sc, "can't set (*s7* '~S)"), sym)));
- if (c_object_type(num) == big_complex_tag)
+ return(sc->UNDEFINED);
+}
+
+/* some procedure-signature support functions */
+
+static s7_pointer g_is_float(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_float "(float? x) returns #t is x is real and not rational."
+ #define Q_is_float pl_bt
+ s7_pointer p;
+ p = car(args);
+ return(make_boolean(sc, ((is_real(p)) && (!is_rational(p)))));
+}
+
+static s7_pointer g_is_proper_list(s7_scheme *sc, s7_pointer args)
+{
+ #define H_is_proper_list "(proper-list? x) returns #t is x is a list that is not circular or dotted."
+ #define Q_is_proper_list pl_bt
+ s7_pointer p;
+ p = car(args);
+ return(make_boolean(sc, is_proper_list(sc, p)));
+}
+
+/* how to handle this? */
+static s7_pointer g_is_integer_or_real_at_end(s7_scheme *sc, s7_pointer args) {return(sc->T);}
+static s7_pointer g_is_integer_or_any_at_end(s7_scheme *sc, s7_pointer args) {return(sc->T);}
+
+
+#ifndef _MSC_VER
+/* gdb stacktrace decoding */
+
+static bool is_decodable(s7_scheme *sc, s7_pointer p)
+{
+ int i;
+ s7_pointer x;
+ s7_pointer *tp, *heap_top;
+
+ if ((void *)p == (void *)sc) return(false);
+
+ /* check basic constants */
+ if ((p == sc->NIL) || (p == sc->T) || (p == sc->F) || (p == sc->EOF_OBJECT) || (p == sc->ELSE) || (p == sc->rootlet) ||
+ (p == sc->UNDEFINED) || (p == sc->UNSPECIFIED) || (p == sc->NO_VALUE) || (p == sc->GC_NIL) ||
+ (p == sc->T1_1) || (p == sc->T2_1) || (p == sc->T3_1) || (p == sc->A1_1) || (p == sc->A2_1) || (p == sc->A3_1) || (p == sc->A4_1))
+ return(true);
+
+ /* check symbol-table */
+ for (i = 0; i < vector_length(sc->symbol_table); i++)
+ for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
+ {
+ s7_pointer sym;
+ sym = car(x);
+ if ((sym == p) ||
+ ((is_global(sym)) && (is_slot(global_slot(sym))) && (p == slot_value(global_slot(sym)))))
+ return(true);
+ }
+
+ for (i = 0; i < NUM_CHARS; i++) if (p == chars[i]) return(true);
+ for (i = 0; i <= NUM_SMALL_INTS; i++) if (p == small_ints[i]) return(true);
+ /* also real_one and friends, sc->safe_lists, tmp_strs? p|elist? */
+
+ /* check the heap */
+ tp = sc->heap;
+ heap_top = (s7_pointer *)(sc->heap + sc->heap_size);
+ while (tp < heap_top)
+ if (p == (*tp++))
+ return(true);
+
+ return(false);
+}
+
+char *s7_decode_bt(void)
+{
+ FILE *fp;
+ fp = fopen("gdb.txt", "r");
+ if (fp)
+ {
+ long i, size;
+ size_t bytes;
+ bool in_quotes = false;
+ unsigned char *bt;
+ s7_scheme *sc;
+ sc = hidden_sc;
+
+ fseek(fp, 0, SEEK_END);
+ size = ftell(fp);
+ rewind(fp);
+
+ bt = (unsigned char *)malloc((size + 1) * sizeof(unsigned char));
+ bytes = fread(bt, sizeof(unsigned char), size, fp);
+ if (bytes != (size_t)size)
{
- mpc_t *n;
- n = (mpc_t *)malloc(sizeof(mpc_t));
- mpc_init(*n);
-#if HAVE_PTHREADS
- pthread_mutex_lock(&rng_lock);
-#endif
- mpc_urandom(*n, r->state);
-#if HAVE_PTHREADS
- pthread_mutex_unlock(&rng_lock);
-#endif
- mpfr_mul(mpc_realref(*n), mpc_realref(*n), mpc_realref(S7_BIG_COMPLEX(num)), GMP_RNDN);
- mpfr_mul(mpc_imagref(*n), mpc_imagref(*n), mpc_imagref(S7_BIG_COMPLEX(num)), GMP_RNDN);
- return(s7_make_object(sc, big_complex_tag, (void *)n));
+ fclose(fp);
+ free(bt);
+ return((char *)" oops ");
+ }
+ bt[size] = '\0';
+ fclose(fp);
+
+ for (i = 0; i < size; i++)
+ {
+ fputc(bt[i], stdout);
+ if ((bt[i] == '"') && ((i == 0) || (bt[i - 1] != '\\')))
+ in_quotes = (!in_quotes);
+ else
+ {
+ if ((!in_quotes) && (i < size - 8))
+ {
+ if ((bt[i] == '=') &&
+ (((bt[i + 1] == '0') && (bt[i + 2] == 'x')) ||
+ ((bt[i + 1] == ' ') && (bt[i + 2] == '0') && (bt[i + 3] == 'x'))))
+ {
+ void *vp;
+ int vals;
+ vals = sscanf((const char *)(bt + i + 1), "%p", &vp);
+ if (vals == 1)
+ {
+ int k;
+ for (k = i + ((bt[i + 2] == 'x') ? 3 : 4); (k < size) && (IS_DIGIT(bt[k], 16)); k++);
+ if ((bt[k] != ' ') || (bt[k + 1] != '"'))
+ {
+ s7_pointer p;
+ p = (s7_pointer)vp;
+ if ((is_decodable(sc, p)) &&
+ (!is_free(p)))
+ {
+ if (bt[i + 1] == ' ') fputc(' ', stdout);
+ i = k - 1;
+ if (s7_is_valid(sc, p))
+ {
+ char *str;
+ str = s7_object_to_c_string(sc, p);
+ fprintf(stdout, "%s%s%s", BOLD_TEXT, str, UNBOLD_TEXT);
+ free(str);
+ }
+ else
+ {
+ if (is_free(p))
+ fprintf(stderr, "%p: %sfree cell%s", p, BOLD_TEXT, UNBOLD_TEXT);
+ else fprintf(stderr, "%p: %sunprintable?%s", p, BOLD_TEXT, UNBOLD_TEXT);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
}
+ free(bt);
}
-
- return(g_random(sc, args));
+ return((char *)"");
}
+#endif
-static void s7_gmp_init(s7_scheme *sc)
-{
- big_integer_tag = s7_new_type_x("<big-integer>", print_big_integer, free_big_integer, equal_big_integer, NULL, NULL, NULL, NULL, copy_big_integer, NULL);
- big_ratio_tag = s7_new_type_x("<big-ratio>", print_big_ratio, free_big_ratio, equal_big_ratio, NULL, NULL, NULL, NULL, copy_big_ratio, NULL);
- big_real_tag = s7_new_type_x("<big-real>", print_big_real, free_big_real, equal_big_real, NULL, NULL, NULL, NULL, copy_big_real, NULL);
- big_complex_tag = s7_new_type_x("<big-complex>", print_big_complex, free_big_complex, equal_big_complex, NULL, NULL, NULL, NULL, copy_big_complex, NULL);
-
- s7_define_function(sc, "+", big_add, 0, 0, true, H_add);
- s7_define_function(sc, "-", big_subtract, 1, 0, true, H_subtract);
- s7_define_function(sc, "*", big_multiply, 0, 0, true, H_multiply);
- s7_define_function(sc, "/", big_divide, 1, 0, true, H_divide);
-
- s7_define_function(sc, "max", big_max, 1, 0, true, H_max);
- s7_define_function(sc, "min", big_min, 1, 0, true, H_min);
- s7_define_function(sc, "<", big_less, 2, 0, true, H_less);
- s7_define_function(sc, "<=", big_less_or_equal, 2, 0, true, H_less_or_equal);
- s7_define_function(sc, ">", big_greater, 2, 0, true, H_greater);
- s7_define_function(sc, ">=", big_greater_or_equal, 2, 0, true, H_greater_or_equal);
- s7_define_function(sc, "=", big_equal, 2, 0, true, H_equal);
-
- s7_define_function(sc, "numerator", big_numerator, 1, 0, false, H_numerator);
- s7_define_function(sc, "denominator", big_denominator, 1, 0, false, H_denominator);
- s7_define_function(sc, "rationalize", big_rationalize, 1, 1, false, H_rationalize);
- s7_define_function(sc, "exact->inexact", big_exact_to_inexact, 1, 0, false, H_exact_to_inexact);
- s7_define_function(sc, "inexact->exact", big_inexact_to_exact, 1, 0, false, H_inexact_to_exact);
- s7_define_function(sc, "floor", big_floor, 1, 0, false, H_floor);
- s7_define_function(sc, "ceiling", big_ceiling, 1, 0, false, H_ceiling);
- s7_define_function(sc, "truncate", big_truncate, 1, 0, false, H_truncate);
- s7_define_function(sc, "round", big_round, 1, 0, false, H_round);
- s7_define_function(sc, "quotient", big_quotient, 2, 0, false, H_quotient);
- s7_define_function(sc, "remainder", big_remainder, 2, 0, false, H_remainder);
- s7_define_function(sc, "modulo", big_modulo, 2, 0, false, H_modulo);
- s7_define_function(sc, "gcd", big_gcd, 0, 0, true, H_gcd);
- s7_define_function(sc, "lcm", big_lcm, 0, 0, true, H_lcm);
-
- s7_define_function(sc, "make-rectangular", big_make_rectangular, 2, 0, false, H_make_rectangular);
- s7_define_function(sc, "make-polar", big_make_polar, 2, 0, false, H_make_polar);
- s7_define_function(sc, "real-part", big_real_part, 1, 0, false, H_real_part);
- s7_define_function(sc, "imag-part", big_imag_part, 1, 0, false, H_imag_part);
- s7_define_function(sc, "angle", big_angle, 1, 0, false, H_angle);
- s7_define_function(sc, "magnitude", big_magnitude, 1, 0, false, H_magnitude);
- s7_define_function(sc, "abs", big_abs, 1, 0, false, H_abs);
-
- s7_define_function(sc, "lognot", big_lognot, 1, 0, false, H_lognot);
- s7_define_function(sc, "logior", big_logior, 0, 0, true, H_logior);
- s7_define_function(sc, "logxor", big_logxor, 0, 0, true, H_logxor);
- s7_define_function(sc, "logand", big_logand, 0, 0, true, H_logand);
- s7_define_function(sc, "ash", big_ash, 2, 0, false, H_ash);
- s7_define_function(sc, "integer-length", big_integer_length, 1, 0, false, H_integer_length);
-
- s7_define_function(sc, "even?", big_is_even, 1, 0, false, H_is_even);
- s7_define_function(sc, "odd?", big_is_odd, 1, 0, false, H_is_odd);
- s7_define_function(sc, "zero?", big_is_zero, 1, 0, false, H_is_zero);
- s7_define_function(sc, "positive?", big_is_positive, 1, 0, false, H_is_positive);
- s7_define_function(sc, "negative?", big_is_negative, 1, 0, false, H_is_negative);
- s7_define_function(sc, "infinite?", big_is_infinite, 1, 0, false, H_is_infinite);
- s7_define_function(sc, "nan?", big_is_nan, 1, 0, false, H_is_nan);
-
- s7_define_function(sc, "exp", big_exp, 1, 0, false, H_exp);
- s7_define_function(sc, "expt", big_expt, 2, 0, false, H_expt);
- s7_define_function(sc, "log", big_log, 1, 1, false, H_log);
- s7_define_function(sc, "sqrt", big_sqrt, 1, 0, false, H_sqrt);
- s7_define_function(sc, "sin", big_sin, 1, 0, false, H_sin);
- s7_define_function(sc, "cos", big_cos, 1, 0, false, H_cos);
- s7_define_function(sc, "tan", big_tan, 1, 0, false, H_tan);
- s7_define_function(sc, "asin", big_asin, 1, 0, false, H_asin);
- s7_define_function(sc, "acos", big_acos, 1, 0, false, H_acos);
- s7_define_function(sc, "atan", big_atan, 1, 1, false, H_atan);
- s7_define_function(sc, "sinh", big_sinh, 1, 0, false, H_sinh);
- s7_define_function(sc, "cosh", big_cosh, 1, 0, false, H_cosh);
- s7_define_function(sc, "tanh", big_tanh, 1, 0, false, H_tanh);
- s7_define_function(sc, "asinh", big_asinh, 1, 0, false, H_asinh);
- s7_define_function(sc, "acosh", big_acosh, 1, 0, false, H_acosh);
- s7_define_function(sc, "atanh", big_atanh, 1, 0, false, H_atanh);
-
- big_rng_tag = s7_new_type("<big-random-number-generator>", print_big_rng, free_big_rng, equal_big_rng, NULL, NULL, NULL);
- s7_define_function(sc, "random", big_random, 1, 1, false, H_random);
- s7_define_function(sc, "make-random-state", make_big_random_state,1, 1, false, H_make_random_state);
-
- s7_define_function(sc, "bignum", g_bignum, 1, 1, false, H_bignum);
- s7_define_function(sc, "bignum?", g_is_bignum, 1, 0, false, H_is_bignum);
- s7_define_function_with_setter(sc, "bignum-precision", g_bignum_precision, g_set_bignum_precision, 0, 0, H_bignum_precision);
-
- add_max = (1 << (s7_int_bits - 1));
- mpfr_set_default_prec((mp_prec_t)DEFAULT_BIGNUM_PRECISION);
- mpc_set_default_precision((mp_prec_t)DEFAULT_BIGNUM_PRECISION);
-
- s7_symbol_set_value(sc, make_symbol(sc, "pi"), big_pi(sc));
- /* if these fixnum limits were read as strings, they'd be bignums in the gmp case,
- * so for consistency make the symbolic versions bignums as well.
- */
- s7_symbol_set_value(sc, make_symbol(sc, "most-positive-fixnum"), s7_Int_to_big_integer(sc, s7_integer(s7_name_to_value(sc, "most-positive-fixnum"))));
- s7_symbol_set_value(sc, make_symbol(sc, "most-negative-fixnum"), s7_Int_to_big_integer(sc, s7_integer(s7_name_to_value(sc, "most-negative-fixnum"))));
+/* -------------------------------- initialization -------------------------------- */
- g_provide(sc, make_list_1(sc, make_symbol(sc, "gmp")));
+static s7_pointer make_unique_object(const char* name, unsigned int typ)
+{
+ s7_pointer p;
+ p = alloc_pointer();
+ set_type(p, typ | T_IMMUTABLE);
+ unique_name_length(p) = safe_strlen(name);
+ unique_name(p) = copy_string_with_length(name, unique_name_length(p));
+ unheap(p);
+ return(p);
}
-#endif
-/* WITH_GMP */
-
-
-
-
-/* -------------------------------- initialization -------------------------------- */
-s7_scheme *s7_init(void)
+s7_scheme *s7_init(void)
{
int i;
s7_scheme *sc;
-
- init_ctables();
-
- sc = (s7_scheme *)calloc(1, sizeof(s7_scheme)); /* malloc is not recommended here */
-#if HAVE_PTHREADS
- sc->orig_sc = sc;
+ s7_pointer sym;
+ static bool already_inited = false;
+
+#ifndef _MSC_VER
+ setlocale(LC_NUMERIC, "C"); /* use decimal point in floats */
#endif
-
- sc->gc_off = (bool *)calloc(1, sizeof(bool));
- (*(sc->gc_off)) = true; /* sc->args and so on are not set yet, so a gc during init -> segfault */
- sc->gc_stats = (bool *)calloc(1, sizeof(bool));
- (*(sc->gc_stats)) = false;
+
+ if (!already_inited)
+ {
+ init_types();
+ init_ctables();
+ init_mark_functions();
+ init_equals();
+ init_hash_maps();
+ init_pows();
+#if (!WITH_GMP)
+ init_add_ops();
+ init_multiply_ops();
+#endif
+ init_uppers();
+ all_x_function_init();
+ init_catchers();
+ /* sizeof(__float128) == sizeof(long double) so how to distinguish them for printf (L vs Q)? */
+ /* if (sizeof(s7_double) >= 16) float_format_g = "%.*Qg"; */ /* __float128 */
+ if (sizeof(s7_double) > 8)
+ float_format_g = "%.*Lg"; /* long double (80-bit precision?) */
+ else float_format_g = "%.*g"; /* float and double */
+ }
+
+ sc = (s7_scheme *)calloc(1, sizeof(s7_scheme)); /* malloc is not recommended here */
+ hidden_sc = sc; /* for gdb/debugging */
+ sc->gc_off = true; /* sc->args and so on are not set yet, so a gc during init -> segfault */
+ sc->gc_stats = 0;
+ init_gc_caches(sc);
sc->longjmp_ok = false;
- sc->symbol_table_is_locked = (bool *)calloc(1, sizeof(bool));
- (*(sc->symbol_table_is_locked)) = false;
+ sc->symbol_table_is_locked = false;
+
+ if (sizeof(s7_int) == 4)
+ sc->max_vector_length = (1 << 24);
+ else sc->max_vector_length = (1LL << 32);
+ sc->max_string_length = 1073741824;
+ sc->max_list_length = 1073741824;
+ sc->max_vector_dimensions = 512;
sc->strbuf_size = INITIAL_STRBUF_SIZE;
sc->strbuf = (char *)calloc(sc->strbuf_size, sizeof(char));
-
+ sc->tmpbuf = (char *)calloc(TMPBUF_SIZE, sizeof(char));
+ sc->print_width = sc->max_string_length;
+
+ sc->initial_string_port_length = 128;
+ sc->format_depth = -1;
+ sc->slash_str_size = 0;
+ sc->slash_str = NULL;
+
+ sc->singletons = (s7_pointer *)calloc(256, sizeof(s7_pointer));
sc->read_line_buf = NULL;
sc->read_line_buf_size = 0;
- sc->NIL = &sc->_NIL;
- sc->T = &sc->_T;
- sc->F = &sc->_F;
- sc->EOF_OBJECT = &sc->_EOF_OBJECT;
- sc->UNSPECIFIED = &sc->_UNSPECIFIED;
- sc->UNDEFINED = &sc->_UNDEFINED;
- sc->NO_VALUE = &sc->_NO_VALUE;
- sc->ELSE = &sc->_ELSE;
- sc->TEMP_CELL = &sc->_TEMP_CELL;
- sc->TEMP_CELL_1 = &sc->_TEMP_CELL_1;
-
- set_type(sc->NIL, T_NIL | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->NIL) = cdr(sc->NIL) = sc->UNSPECIFIED;
-
- set_type(sc->T, T_BOOLEAN | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->T) = cdr(sc->T) = sc->UNSPECIFIED;
-
- set_type(sc->F, T_BOOLEAN | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->F) = cdr(sc->F) = sc->UNSPECIFIED;
-
- set_type(sc->EOF_OBJECT, T_UNTYPED | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->EOF_OBJECT) = cdr(sc->EOF_OBJECT) = sc->UNSPECIFIED;
-
- set_type(sc->UNSPECIFIED, T_UNTYPED | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->UNSPECIFIED) = cdr(sc->UNSPECIFIED) = sc->UNSPECIFIED;
-
- set_type(sc->UNDEFINED, T_UNTYPED | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->UNDEFINED) = cdr(sc->UNDEFINED) = sc->UNSPECIFIED;
-
- set_type(sc->NO_VALUE, T_UNTYPED | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->NO_VALUE) = cdr(sc->NO_VALUE) = sc->UNSPECIFIED;
+ sc->cur_rf = NULL;
+ sc->rf_free_list = NULL;
+ sc->rf_stack = NULL;
+
+ sc->NIL = make_unique_object("()", T_NIL);
+ sc->GC_NIL = make_unique_object("#<nil>", T_UNIQUE);
+ sc->T = make_unique_object("#t", T_BOOLEAN);
+ sc->F = make_unique_object("#f", T_BOOLEAN);
+ sc->EOF_OBJECT = make_unique_object("#<eof>", T_UNIQUE);
+ sc->UNDEFINED = make_unique_object("#<undefined>", T_UNIQUE);
+ sc->ELSE = make_unique_object("else", T_UNIQUE);
+ /* "else" is added to the rootlet below -- can't do it here because the symbol table and environment don't exist yet. */
+ sc->UNSPECIFIED = make_unique_object("#<unspecified>", T_UNSPECIFIED);
+ sc->NO_VALUE = make_unique_object("#<unspecified>", T_UNSPECIFIED);
- set_type(sc->ELSE, T_UNTYPED | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->ELSE) = cdr(sc->ELSE) = sc->UNSPECIFIED;
- /* "else" is added to the global environment below -- can't do it here
- * because the symbol table and environment don't exist yet.
+ car(sc->NIL) = cdr(sc->NIL) = sc->UNSPECIFIED;
+ /* this is mixing two different s7_cell structs, cons and envr, but luckily
+ * envr has two initial s7_pointer fields, equivalent to car and cdr, so
+ * let_id which is the same as opt1 is unaffected. To get the names
+ * built-in, I'll append unique_name and unique_name_length fields to
+ * the envr struct.
*/
+ let_id(sc->NIL) = -1;
+ unique_cdr(sc->UNSPECIFIED) = sc->UNSPECIFIED;
+ unique_cdr(sc->UNDEFINED) = sc->UNDEFINED;
+ /* this way find_symbol of an undefined symbol returns #<undefined> not #<unspecified> */
+
+ sc->temp_cell_1 = permanent_cons(sc->NIL, sc->NIL, T_PAIR | T_IMMUTABLE);
+ sc->temp_cell = permanent_cons(sc->temp_cell_1, sc->NIL, T_PAIR | T_IMMUTABLE);
+ sc->temp_cell_2 = permanent_cons(sc->NIL, sc->NIL, T_PAIR | T_IMMUTABLE);
+
+ sc->T1_1 = permanent_cons(sc->NIL, sc->NIL, T_PAIR | T_IMMUTABLE);
+
+ sc->T2_2 = permanent_cons(sc->NIL, sc->NIL, T_PAIR | T_IMMUTABLE);
+ sc->T2_1 = permanent_cons(sc->NIL, sc->T2_2, T_PAIR | T_IMMUTABLE);
+ sc->Z2_2 = permanent_cons(sc->NIL, sc->NIL, T_PAIR | T_IMMUTABLE);
+ sc->Z2_1 = permanent_cons(sc->NIL, sc->Z2_2, T_PAIR | T_IMMUTABLE);
+
+ sc->T3_3 = permanent_cons(sc->NIL, sc->NIL, T_PAIR | T_IMMUTABLE);
+ sc->T3_2 = permanent_cons(sc->NIL, sc->T3_3, T_PAIR | T_IMMUTABLE);
+ sc->T3_1 = permanent_cons(sc->NIL, sc->T3_2, T_PAIR | T_IMMUTABLE);
+
+ sc->A4_4 = permanent_cons(sc->NIL, sc->NIL, T_PAIR | T_IMMUTABLE);
+ sc->A4_3 = permanent_cons(sc->NIL, sc->A4_4, T_PAIR | T_IMMUTABLE);
+ sc->A4_2 = permanent_cons(sc->NIL, sc->A4_3, T_PAIR | T_IMMUTABLE);
+ sc->A4_1 = permanent_cons(sc->NIL, sc->A4_2, T_PAIR | T_IMMUTABLE);
+
+ sc->A1_1 = sc->A4_4;
+ sc->A2_1 = sc->A4_3;
+ sc->A2_2 = sc->A4_4;
+ sc->A3_1 = sc->A4_2;
+ sc->A3_2 = sc->A4_3;
+ sc->A3_3 = sc->A4_4;
+
+ sc->safe_lists = (s7_pointer *)calloc(NUM_SAFE_LISTS, sizeof(s7_pointer));
+ for (i = 1; i < NUM_SAFE_LISTS; i++)
+ sc->safe_lists[i] = permanent_list(sc, i);
- set_type(sc->TEMP_CELL, T_PAIR | T_STRUCTURE | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- cdr(sc->TEMP_CELL) = sc->NIL;
-
- set_type(sc->TEMP_CELL_1, T_PAIR | T_STRUCTURE | T_GC_MARK | T_IMMUTABLE | T_SIMPLE | T_DONT_COPY);
- car(sc->TEMP_CELL_1) = cdr(sc->TEMP_CELL_1) = sc->NIL;
- car(sc->TEMP_CELL) = sc->TEMP_CELL_1;
-
- sc->input_port = sc->NIL;
- sc->input_is_file = false;
sc->input_port_stack = sc->NIL;
- sc->output_port = sc->NIL;
- sc->error_port = sc->NIL;
-
sc->code = sc->NIL;
- sc->cur_code = ERROR_INFO_DEFAULT;
+ sc->cur_code = sc->F;
sc->args = sc->NIL;
sc->value = sc->NIL;
+ sc->v = sc->NIL;
sc->w = sc->NIL;
sc->x = sc->NIL;
sc->y = sc->NIL;
sc->z = sc->NIL;
- sc->error_exiter = NULL;
+
+ sc->temp1 = sc->NIL;
+ sc->temp2 = sc->NIL;
+ sc->temp3 = sc->NIL;
+ sc->temp4 = sc->NIL;
+ sc->temp5 = sc->NIL;
+ sc->temp6 = sc->NIL;
+ sc->temp7 = sc->NIL;
+ sc->temp8 = sc->NIL;
+ sc->temp9 = sc->NIL;
+ sc->temp10 = sc->NIL;
+
sc->begin_hook = NULL;
- sc->default_rng = NULL;
-
+ sc->autoload_table = sc->NIL;
+ sc->autoload_names = NULL;
+ sc->autoload_names_sizes = NULL;
+ sc->autoloaded_already = NULL;
+ sc->autoload_names_loc = 0;
+
+ sc->port_heap = NULL;
+ sc->permanent_objects = NULL;
+
sc->heap_size = INITIAL_HEAP_SIZE;
+ if ((sc->heap_size % 32) != 0)
+ sc->heap_size = 32 * (int)ceil((double)(sc->heap_size) / 32.0);
sc->heap = (s7_pointer *)malloc(sc->heap_size * sizeof(s7_pointer));
-
+
sc->free_heap = (s7_cell **)malloc(sc->heap_size * sizeof(s7_cell *));
sc->free_heap_top = (s7_cell **)(sc->free_heap + INITIAL_HEAP_SIZE);
- sc->free_heap_trigger = (s7_cell **)(sc->free_heap + GC_TEMPS_SIZE);
+ sc->free_heap_trigger = (s7_cell **)(sc->free_heap + GC_TRIGGER_SIZE);
+ sc->previous_free_heap_top = sc->free_heap_top;
{
- s7_cell *cells = (s7_cell *)calloc(INITIAL_HEAP_SIZE, sizeof(s7_cell));
+ s7_cell *cells;
+ cells = (s7_cell *)calloc(INITIAL_HEAP_SIZE, sizeof(s7_cell));
for (i = 0; i < INITIAL_HEAP_SIZE; i++)
{
sc->heap[i] = &cells[i];
sc->free_heap[i] = sc->heap[i];
- sc->heap[i]->hloc = i;
- }
+ heap_location(sc->heap[i]) = i;
+ i++;
+ sc->heap[i] = &cells[i];
+ sc->free_heap[i] = sc->heap[i];
+ heap_location(sc->heap[i]) = i;
+ }
}
- permanent_heap = (unsigned char *)calloc(PERMANENT_HEAP_SIZE, sizeof(unsigned char));
- permanent_heap_top = (unsigned char *)(permanent_heap + PERMANENT_HEAP_SIZE);
-
/* this has to precede s7_make_* allocations */
- sc->temps_size = GC_TEMPS_SIZE;
- sc->temps_ctr = 0;
- sc->temps = (s7_pointer *)malloc(sc->temps_size * sizeof(s7_pointer));
- for (i = 0; i < sc->temps_size; i++)
- sc->temps[i] = sc->NIL;
-
- sc->protected_objects_size = (int *)malloc(sizeof(int));
- (*(sc->protected_objects_size)) = INITIAL_PROTECTED_OBJECTS_SIZE;
- sc->protected_objects_loc = (int *)malloc(sizeof(int));
- (*(sc->protected_objects_loc)) = 0;
- sc->protected_objects = s7_make_vector(sc, INITIAL_PROTECTED_OBJECTS_SIZE); /* realloc happens to the embedded array, so this pointer is global */
- set_immutable(sc->protected_objects);
- typeflag(sc->protected_objects) |= T_DONT_COPY;
-
+ sc->protected_objects_size = INITIAL_PROTECTED_OBJECTS_SIZE;
+ sc->protected_objects_loc = 0;
+ sc->protected_objects = s7_make_vector(sc, INITIAL_PROTECTED_OBJECTS_SIZE);
+
+ sc->protected_accessors_size = INITIAL_PROTECTED_OBJECTS_SIZE;
+ sc->protected_accessors_loc = 0;
+ sc->protected_accessors = s7_make_vector(sc, INITIAL_PROTECTED_OBJECTS_SIZE);
+
+ for (i = 0; i < INITIAL_PROTECTED_OBJECTS_SIZE; i++)
+ {
+ vector_element(sc->protected_objects, i) = sc->GC_NIL;
+ vector_element(sc->protected_accessors, i) = sc->GC_NIL;
+ }
+
sc->stack = s7_make_vector(sc, INITIAL_STACK_SIZE);
sc->stack_start = vector_elements(sc->stack);
sc->stack_end = sc->stack_start;
sc->stack_size = INITIAL_STACK_SIZE;
sc->stack_resize_trigger = (s7_pointer *)(sc->stack_start + sc->stack_size / 2);
-
+ set_type(sc->stack, T_STACK);
+ sc->max_stack_size = (1 << 30);
+
+ initialize_op_stack(sc);
+
/* keep the symbol table out of the heap */
sc->symbol_table = (s7_pointer)calloc(1, sizeof(s7_cell));
- set_type(sc->symbol_table, T_VECTOR | T_FINALIZABLE | T_DONT_COPY | T_STRUCTURE);
+ set_type(sc->symbol_table, T_VECTOR);
vector_length(sc->symbol_table) = SYMBOL_TABLE_SIZE;
vector_elements(sc->symbol_table) = (s7_pointer *)malloc(SYMBOL_TABLE_SIZE * sizeof(s7_pointer));
+ vector_getter(sc->symbol_table) = default_vector_getter;
+ vector_setter(sc->symbol_table) = default_vector_setter;
s7_vector_fill(sc, sc->symbol_table, sc->NIL);
- sc->symbol_table->hloc = NOT_IN_HEAP;
-
- sc->gensym_counter = (long *)calloc(1, sizeof(long));
- sc->tracing = (bool *)calloc(1, sizeof(bool));
- sc->trace_all = (bool *)calloc(1, sizeof(bool));
-
- sc->trace_list = (s7_pointer *)calloc(INITIAL_TRACE_LIST_SIZE, sizeof(s7_pointer));
- sc->trace_list_size = INITIAL_TRACE_LIST_SIZE;
- sc->trace_top = 0;
- sc->trace_depth = 0;
+ unheap(sc->symbol_table);
+
+ sc->tmp_strs = (s7_pointer *)malloc(2 * sizeof(s7_pointer));
+ for (i = 0; i < 2; i++)
+ {
+ s7_pointer p;
+ p = alloc_pointer();
+ sc->tmp_strs[i] = p;
+ unheap(p);
+ set_type(p, T_STRING | T_SAFE_PROCEDURE);
+ string_hash(p) = 0;
+ string_needs_free(p) = false;
+ string_length(p) = 0;
+ string_value(p) = (char *)malloc(INITIAL_TMP_STR_SIZE * sizeof(char));
+ string_temp_true_length(p) = INITIAL_TMP_STR_SIZE;
+ }
+ sc->typnam = NULL;
+ sc->typnam_len = 0;
+ sc->help_arglist = NULL;
+ sc->default_rationalize_error = 1.0e-12;
+ sc->hash_table_float_epsilon = 1.0e-12;
+ sc->morally_equal_float_epsilon = 1.0e-15;
+ sc->default_hash_table_length = 8;
+ sc->gensym_counter = 0;
+ sc->capture_let_counter = 0;
+ sc->f_class = 0;
+ sc->add_class = 0;
+ sc->equal_class = 0;
+ sc->let_number = 0;
+ sc->format_column = 0;
+ sc->file_names = NULL;
+ sc->file_names_size = 0;
+ sc->file_names_top = -1;
sc->no_values = 0;
sc->s7_call_line = 0;
sc->s7_call_file = NULL;
sc->s7_call_name = NULL;
sc->safety = 0;
+ sc->print_length = 8;
+ sc->baffle_ctr = 0;
+ sc->syms_tag = 0;
+ sc->CLASS_NAME = make_symbol(sc, "class-name");
+ sc->circle_info = NULL;
+ sc->fdats = (format_data **)calloc(8, sizeof(format_data *));
+ sc->num_fdats = 8;
+ sc->plist_1 = permanent_list(sc, 1);
+ sc->plist_2 = permanent_list(sc, 2);
+ sc->plist_3 = permanent_list(sc, 3);
+ sc->elist_1 = permanent_list(sc, 1);
+ sc->elist_2 = permanent_list(sc, 2);
+ sc->elist_3 = permanent_list(sc, 3);
+ sc->elist_4 = permanent_list(sc, 4);
+ sc->elist_5 = permanent_list(sc, 5);
+ sc->direct_str = s7_make_permanent_string(NULL);
+ sc->undefined_identifier_warnings = false;
+ sc->wrap_only = make_wrap_only(sc);
+ sc->dox_slot_symbol = s7_make_symbol(sc, "(dox_slot)");
+
+ sc->rootlet = s7_make_vector(sc, ROOTLET_SIZE);
+ set_type(sc->rootlet, T_LET);
+ sc->rootlet_entries = 0;
+ for (i = 0; i < ROOTLET_SIZE; i++)
+ vector_element(sc->rootlet, i) = sc->NIL;
+ sc->envir = sc->NIL;
+ sc->shadow_rootlet = sc->NIL;
+
+ if (!already_inited)
+ {
+ /* keep the small_ints out of the heap */
+ small_ints = (s7_pointer *)malloc((NUM_SMALL_INTS + 1) * sizeof(s7_pointer));
+ {
+ s7_cell *cells;
+ cells = (s7_cell *)calloc((NUM_SMALL_INTS + 1), sizeof(s7_cell));
+ for (i = 0; i <= NUM_SMALL_INTS; i++)
+ {
+ s7_pointer p;
+ small_ints[i] = &cells[i];
+ p = small_ints[i];
+ typeflag(p) = T_IMMUTABLE | T_INTEGER;
+ unheap(p);
+ integer(p) = i;
+ }
+ }
-#if HAVE_PTHREADS
- sc->thread_ids = (int *)calloc(1, sizeof(int));
- sc->thread_id = 0;
- sc->key_values = sc->NIL;
-#endif
-
- sc->global_env = make_list_1(sc, s7_make_vector(sc, SYMBOL_TABLE_SIZE));
- typeflag(sc->global_env) |= T_ENVIRONMENT;
- sc->envir = sc->global_env;
-
- /* keep the small_ints out of the heap */
- small_ints = (s7_pointer *)malloc((NUM_SMALL_INTS + 1) * sizeof(s7_pointer));
- small_negative_ints = (s7_pointer *)malloc((NUM_SMALL_INTS + 1) * sizeof(s7_pointer));
- for (i = 0; i <= NUM_SMALL_INTS; i++)
- {
- s7_pointer p;
-
- p = (s7_pointer)calloc(1, sizeof(s7_cell));
- p->flag = T_IMMUTABLE | T_NUMBER | T_SIMPLE | T_DONT_COPY;
- p->hloc = NOT_IN_HEAP;
- number_type(p) = NUM_INT;
- integer(number(p)) = (s7_Int)i;
- small_ints[i] = p;
-
- p = (s7_pointer)calloc(1, sizeof(s7_cell));
- p->flag = T_IMMUTABLE | T_NUMBER | T_SIMPLE | T_DONT_COPY;
- p->hloc = NOT_IN_HEAP;
- number_type(p) = NUM_INT;
- integer(number(p)) = (s7_Int)(-i);
- small_negative_ints[i] = p;
- }
-
- real_zero = (s7_pointer)calloc(1, sizeof(s7_cell));
- real_zero->flag = T_IMMUTABLE | T_NUMBER | T_SIMPLE | T_DONT_COPY;
- real_zero->hloc = NOT_IN_HEAP;
- number_type(real_zero) = NUM_REAL;
- real(number(real_zero)) = (s7_Double)0.0;
-
- real_one = (s7_pointer)calloc(1, sizeof(s7_cell));
- real_one->flag = T_IMMUTABLE | T_NUMBER | T_SIMPLE | T_DONT_COPY;
- real_one->hloc = NOT_IN_HEAP;
- number_type(real_one) = NUM_REAL;
- real(number(real_one)) = (s7_Double)1.0;
-
- /* keep the characters out of the heap */
- chars = (s7_pointer *)malloc(NUM_SMALL_INTS * sizeof(s7_pointer));
- for (i = 0; i < NUM_SMALL_INTS; i++)
- {
- s7_pointer p;
- p = (s7_pointer)calloc(1, sizeof(s7_cell));
- p->flag = T_IMMUTABLE | T_CHARACTER | T_SIMPLE | T_DONT_COPY;
- p->hloc = NOT_IN_HEAP;
- character(p) = (unsigned char)i;
- chars[i] = p;
+ real_zero = make_permanent_real(0.0);
+ real_one = make_permanent_real(1.0);
+ real_NaN = make_permanent_real(NAN);
+ real_infinity = make_permanent_real(INFINITY);
+ real_minus_infinity = make_permanent_real(-INFINITY);
+ real_pi = make_permanent_real(3.1415926535897932384626433832795029L); /* M_PI is not good enough for s7_double = long double */
+ arity_not_set = make_permanent_integer_unchecked(CLOSURE_ARITY_NOT_SET);
+ max_arity = make_permanent_integer_unchecked(MAX_ARITY);
+ minus_one = make_permanent_integer_unchecked(-1);
+ minus_two = make_permanent_integer_unchecked(-2);
+ /* prebuilt null string is tricky mainly because it overlaps #u8() */
+
+ /* keep the characters out of the heap */
+ chars = (s7_pointer *)malloc((NUM_CHARS + 1) * sizeof(s7_pointer));
+ chars[0] = sc->EOF_OBJECT;
+ chars++; /* now chars[EOF] == chars[-1] == sc->EOF_OBJECT */
+ {
+ s7_cell *cells;
+ cells = (s7_cell *)calloc(NUM_CHARS, sizeof(s7_cell));
+ for (i = 0; i < NUM_CHARS; i++)
+ {
+ s7_pointer cp;
+ unsigned char c;
+
+ c = (unsigned char)i;
+ cp = &cells[i];
+ typeflag(cp) = T_IMMUTABLE | T_CHARACTER;
+ unheap(cp);
+ character(cp) = c;
+ upper_character(cp) = (unsigned char)toupper(i);
+ is_char_alphabetic(cp) = (bool)isalpha(i);
+ is_char_numeric(cp) = (bool)isdigit(i);
+ is_char_whitespace(cp) = white_space[i];
+ is_char_uppercase(cp) = (((bool)isupper(i)) || ((i >= 192) && (i < 208)));
+ is_char_lowercase(cp) = (bool)islower(i);
+ chars[i] = cp;
+
+ #define make_character_name(C, S) strncat((char *)(&(character_name(C))), S, character_name_length(C) = strlen(S))
+ switch (c)
+ {
+ case ' ': make_character_name(cp, "#\\space"); break;
+ case '\n': make_character_name(cp, "#\\newline"); break;
+ case '\r': make_character_name(cp, "#\\return"); break;
+ case '\t': make_character_name(cp, "#\\tab"); break;
+ case '\0': make_character_name(cp, "#\\null"); break;
+ case (char)0x1b: make_character_name(cp, "#\\escape"); break;
+ case (char)0x7f: make_character_name(cp, "#\\delete"); break;
+ case (char)7: make_character_name(cp, "#\\alarm"); break;
+ case (char)8: make_character_name(cp, "#\\backspace"); break;
+ default:
+ {
+ #define P_SIZE 12
+ int len;
+ if ((c < 32) || (c >= 127))
+ len = snprintf((char *)(&(character_name(cp))), P_SIZE, "#\\x%x", c);
+ else len = snprintf((char *)(&(character_name(cp))), P_SIZE, "#\\%c", c);
+ character_name_length(cp) = len;
+ break;
+ }
+ }
+ }
+ }
}
+#if WITH_COUNTS
+ init_hashes(sc);
+#endif
make_standard_ports(sc);
- assign_syntax(sc, "quote", OP_QUOTE);
- assign_syntax(sc, "if", OP_IF);
- assign_syntax(sc, "begin", OP_BEGIN);
- assign_syntax(sc, "set!", OP_SET);
- assign_syntax(sc, "let", OP_LET);
- assign_syntax(sc, "let*", OP_LET_STAR);
- assign_syntax(sc, "letrec", OP_LETREC);
- assign_syntax(sc, "cond", OP_COND);
- assign_syntax(sc, "and", OP_AND);
- assign_syntax(sc, "or", OP_OR);
- assign_syntax(sc, "case", OP_CASE);
- assign_syntax(sc, "do", OP_DO);
-
- set_immutable(assign_syntax(sc, "with-environment", OP_WITH_ENV));
-
- assign_syntax(sc, "lambda", OP_LAMBDA);
- assign_syntax(sc, "lambda*", OP_LAMBDA_STAR); /* optional, key, rest args */
- assign_syntax(sc, "define", OP_DEFINE);
- assign_syntax(sc, "define*", OP_DEFINE_STAR);
- assign_syntax(sc, "define-constant", OP_DEFINE_CONSTANT); /* unsetabble and unrebindable bindings */
-
- assign_syntax(sc, "defmacro", OP_DEFMACRO); /* CL-style macro syntax */
- assign_syntax(sc, "defmacro*", OP_DEFMACRO_STAR);
- assign_syntax(sc, "define-macro", OP_DEFINE_MACRO); /* Scheme-style macro syntax */
- assign_syntax(sc, "define-macro*", OP_DEFINE_MACRO_STAR);
- assign_syntax(sc, "define-expansion", OP_DEFINE_EXPANSION); /* read-time (immediate) macro expansion */
- assign_syntax(sc, "define-bacro", OP_DEFINE_BACRO); /* macro expansion in calling environment */
- assign_syntax(sc, "define-bacro*", OP_DEFINE_BACRO_STAR);
-
- sc->LAMBDA = make_symbol(sc, "lambda");
- typeflag(sc->LAMBDA) |= T_DONT_COPY;
-
- sc->LAMBDA_STAR = make_symbol(sc, "lambda*");
- typeflag(sc->LAMBDA_STAR) |= T_DONT_COPY;
-
- sc->QUOTE = make_symbol(sc, "quote");
- typeflag(sc->QUOTE) |= T_DONT_COPY;
-
- sc->UNQUOTE = make_symbol(sc, "unquote");
- typeflag(sc->UNQUOTE) |= T_DONT_COPY;
-
- sc->MACROEXPAND = make_symbol(sc, "macroexpand");
- typeflag(sc->MACROEXPAND) |= T_DONT_COPY;
-
- sc->FEED_TO = make_symbol(sc, "=>");
- typeflag(sc->FEED_TO) |= T_DONT_COPY;
-
- #define s_is_type_name "[?]" /* these were "(?)" etc, but the procedure-source needs to be usable */
- sc->S_IS_TYPE = make_symbol(sc, s_is_type_name);
- typeflag(sc->S_IS_TYPE) |= T_DONT_COPY;
-
- #define s_type_make_name "[make]"
- sc->S_TYPE_MAKE = make_symbol(sc, s_type_make_name);
- typeflag(sc->S_TYPE_MAKE) |= T_DONT_COPY;
-
- #define s_type_ref_name "[ref]"
- sc->S_TYPE_REF = make_symbol(sc, s_type_ref_name);
- typeflag(sc->S_TYPE_REF) |= T_DONT_COPY;
-
- #define s_type_arg_name "[arg]"
- sc->S_TYPE_ARG = make_symbol(sc, s_type_arg_name);
- typeflag(sc->S_TYPE_ARG) |= T_DONT_COPY;
-
- sc->APPLY = make_symbol(sc, "apply");
- typeflag(sc->APPLY) |= T_DONT_COPY;
-
- sc->QQ_VALUES = make_symbol(sc, "{values}");
- typeflag(sc->QQ_VALUES) |= T_DONT_COPY;
-
- sc->QQ_LIST = make_symbol(sc, "{list}");
- typeflag(sc->QQ_LIST) |= T_DONT_COPY;
-
- sc->QQ_APPLY = make_symbol(sc, "{apply}");
- typeflag(sc->QQ_APPLY) |= T_DONT_COPY;
-
- sc->QQ_APPEND = make_symbol(sc, "{append}");
- typeflag(sc->QQ_APPEND) |= T_DONT_COPY;
-
-#if WITH_UNQUOTE_SPLICING
- sc->UNQUOTE_SPLICING = make_symbol(sc, "unquote-splicing");
- typeflag(sc->UNQUOTE_SPLICING) |= T_DONT_COPY;
+ sc->syn_docs = (s7_pointer *)calloc(OP_MAX_DEFINED, sizeof(s7_pointer));
+ #define QUOTE_HELP "(quote obj) returns obj unevaluated. 'obj is an abbreviation for (quote obj)."
+ #define IF_HELP "(if expr true-stuff optional-false-stuff) evaluates expr, then if it is true, evaluates true-stuff; otherwise, \
+ if optional-false-stuff exists, it is evaluated."
+ #define WHEN_HELP "(when expr ...) evaluates expr, and if it is true, evaluates each form in its body, returning the value of the last"
+ #define UNLESS_HELP "(unless expr ...) evaluates expr, and if it is false, evaluates each form in its body, returning the value of the last"
+ #define BEGIN_HELP "(begin ...) evaluates each form in its body, returning the value of the last one"
+ #define SET_HELP "(set! variable value) sets the value of variable to value."
+ #define LET_HELP "(let ((var val)...) ...) binds each variable to its initial value, then evaluates its body,\
+ returning the value of the last form. The let variables are local to it, and \
+ are not available for use until all have been initialized."
+ #define LET_STAR_HELP "(let* ((var val)...) ...) binds each variable to its initial value, then evaluates its body, \
+ returning the value of the last form. The let* variables are local to it, and are available immediately."
+ #define LETREC_HELP "(letrec ((var (lambda ...)))...) is like let, but var can refer to itself in its value \
+ (i.e. you can define local recursive functions)"
+ #define LETREC_STAR_HELP "(letrec* ((var val))...) is like letrec, but successive bindings are handled as in let*"
+ #define COND_HELP "(cond (expr clause...)...) is like if..then. Each expr is evaluated in order, and if one is not #f, \
+ the associated clauses are evaluated, whereupon cond returns."
+ #define AND_HELP "(and expr expr ...) evaluates each of its arguments in order, quitting (and returning #f) \
+ as soon as one of them returns #f. If all are non-#f, it returns the last value."
+ #define OR_HELP "(or expr expr ...) evaluates each of its argments in order, quitting as soon as one of them is not #f. \
+ If all are #f, or returns #f."
+ #define CASE_HELP "(case val ((key...) clause...)...) looks for val in the various lists of keys, and if a \
+ match is found (via eqv?), the associated clauses are evaluated, and case returns."
+ #define DO_HELP "(do (vars...) (loop control and return value) ...) is a do-loop."
+ #define LAMBDA_HELP "(lambda args ...) returns a function."
+ #define LAMBDA_STAR_HELP "(lambda* args ...) returns a function; the args list can have default values, \
+ the parameters themselves can be accessed via keywords."
+ #define DEFINE_HELP "(define var val) assigns val to the variable (symbol) var. (define (func args) ...) is \
+ shorthand for (define func (lambda args ...))"
+ #define DEFINE_STAR_HELP "(define* (func args) ...) defines a function with optional/keyword arguments."
+ #define DEFINE_CONSTANT_HELP "(define-constant var val) defines var to be a constant (it can't be set or bound), with the value val."
+ #define DEFINE_MACRO_HELP "(define-macro (mac args) ...) defines mac to be a macro."
+ #define DEFINE_MACRO_STAR_HELP "(define-macro* (mac args) ...) defines mac to be a macro with optional/keyword arguments."
+ #define DEFINE_EXPANSION_HELP "(define-expansion (mac args) ...) defines mac to be a read-time macro."
+ #define DEFINE_BACRO_HELP "(define-bacro (mac args) ...) defines mac to be a bacro."
+ #define DEFINE_BACRO_STAR_HELP "(define-bacro* (mac args) ...) defines mac to be a bacro with optional/keyword arguments."
+ #define WITH_BAFFLE_HELP "(with-baffle ...) evaluates its body in a context that is safe from outside interference."
+ #define MACROEXPAND_HELP "(macroexpand macro-call) returns the result of the expansion phase of evaluating the macro call."
+ #define WITH_LET_HELP "(with-let env ...) evaluates its body in the environment env."
+
+ sc->QUOTE = assign_syntax(sc, "quote", OP_QUOTE, small_int(1), small_int(1), QUOTE_HELP);
+ sc->IF = assign_syntax(sc, "if", OP_IF, small_int(2), small_int(3), IF_HELP);
+ sc->WHEN = assign_syntax(sc, "when", OP_WHEN, small_int(2), max_arity, WHEN_HELP);
+ sc->UNLESS = assign_syntax(sc, "unless", OP_UNLESS, small_int(2), max_arity, UNLESS_HELP);
+ sc->BEGIN = assign_syntax(sc, "begin", OP_BEGIN, small_int(0), max_arity, BEGIN_HELP);
+ sc->SET = assign_syntax(sc, "set!", OP_SET, small_int(2), small_int(2), SET_HELP);
+ sc->LET = assign_syntax(sc, "let", OP_LET, small_int(2), max_arity, LET_HELP);
+ sc->LET_STAR = assign_syntax(sc, "let*", OP_LET_STAR, small_int(2), max_arity, LET_STAR_HELP);
+ sc->LETREC = assign_syntax(sc, "letrec", OP_LETREC, small_int(2), max_arity, LETREC_HELP);
+ sc->LETREC_STAR = assign_syntax(sc, "letrec*", OP_LETREC_STAR, small_int(2), max_arity, LETREC_STAR_HELP);
+ sc->COND = assign_syntax(sc, "cond", OP_COND, small_int(1), max_arity, COND_HELP);
+ sc->AND = assign_syntax(sc, "and", OP_AND, small_int(0), max_arity, AND_HELP);
+ sc->OR = assign_syntax(sc, "or", OP_OR, small_int(0), max_arity, OR_HELP);
+ sc->CASE = assign_syntax(sc, "case", OP_CASE, small_int(2), max_arity, CASE_HELP);
+ sc->DO = assign_syntax(sc, "do", OP_DO, small_int(2), max_arity, DO_HELP); /* 2 because body can be null */
+ sc->LAMBDA = assign_syntax(sc, "lambda", OP_LAMBDA, small_int(2), max_arity, LAMBDA_HELP);
+ sc->LAMBDA_STAR = assign_syntax(sc, "lambda*", OP_LAMBDA_STAR, small_int(2), max_arity, LAMBDA_STAR_HELP);
+ sc->DEFINE = assign_syntax(sc, "define", OP_DEFINE, small_int(2), max_arity, DEFINE_HELP);
+ sc->DEFINE_STAR = assign_syntax(sc, "define*", OP_DEFINE_STAR, small_int(2), max_arity, DEFINE_STAR_HELP);
+ sc->DEFINE_CONSTANT = assign_syntax(sc, "define-constant", OP_DEFINE_CONSTANT, small_int(2), max_arity, DEFINE_CONSTANT_HELP);
+ sc->DEFINE_MACRO = assign_syntax(sc, "define-macro", OP_DEFINE_MACRO, small_int(2), max_arity, DEFINE_MACRO_HELP);
+ sc->DEFINE_MACRO_STAR = assign_syntax(sc, "define-macro*", OP_DEFINE_MACRO_STAR, small_int(2), max_arity, DEFINE_MACRO_STAR_HELP);
+ sc->DEFINE_EXPANSION = assign_syntax(sc, "define-expansion",OP_DEFINE_EXPANSION, small_int(2), max_arity, DEFINE_EXPANSION_HELP);
+ sc->DEFINE_BACRO = assign_syntax(sc, "define-bacro", OP_DEFINE_BACRO, small_int(2), max_arity, DEFINE_BACRO_HELP);
+ sc->DEFINE_BACRO_STAR = assign_syntax(sc, "define-bacro*", OP_DEFINE_BACRO_STAR, small_int(2), max_arity, DEFINE_BACRO_STAR_HELP);
+ sc->WITH_BAFFLE = assign_syntax(sc, "with-baffle", OP_WITH_BAFFLE, small_int(1), max_arity, WITH_BAFFLE_HELP);
+ sc->MACROEXPAND = assign_syntax(sc, "macroexpand", OP_MACROEXPAND, small_int(1), small_int(1), MACROEXPAND_HELP);
+ sc->WITH_LET = assign_syntax(sc, "with-let", OP_WITH_LET, small_int(1), max_arity, WITH_LET_HELP);
+ set_immutable(sc->WITH_LET);
+
+#if WITH_OPTIMIZATION
+ syntax_rp(slot_value(global_slot(sc->SET))) = set_rf;
+ syntax_ip(slot_value(global_slot(sc->SET))) = set_if;
+ syntax_pp(slot_value(global_slot(sc->SET))) = set_pf;
+ syntax_rp(slot_value(global_slot(sc->IF))) = if_rf;
+ syntax_pp(slot_value(global_slot(sc->IF))) = if_pf;
+ syntax_pp(slot_value(global_slot(sc->OR))) = or_pf;
+ syntax_pp(slot_value(global_slot(sc->AND))) = and_pf;
+ syntax_pp(slot_value(global_slot(sc->QUOTE))) = quote_pf;
#endif
-
- sc->CDR = make_symbol(sc, "cdr");
- typeflag(sc->CDR) |= T_DONT_COPY;
-
- add_to_current_environment(sc, make_symbol(sc, "else"), sc->ELSE);
-
- sc->VECTOR = make_symbol(sc, "vector");
- typeflag(sc->VECTOR) |= T_DONT_COPY;
-
- sc->MULTIVECTOR = make_symbol(sc, "{multivector}");
- typeflag(sc->MULTIVECTOR) |= T_DONT_COPY;
-
- sc->ERROR = make_symbol(sc, "error");
- typeflag(sc->ERROR) |= T_DONT_COPY;
-
- sc->READ_ERROR = make_symbol(sc, "read-error");
- typeflag(sc->READ_ERROR) |= T_DONT_COPY;
-
- sc->SYNTAX_ERROR = make_symbol(sc, "syntax-error");
- typeflag(sc->SYNTAX_ERROR) |= T_DONT_COPY;
- sc->WRONG_TYPE_ARG = make_symbol(sc, "wrong-type-arg");
- typeflag(sc->WRONG_TYPE_ARG) |= T_DONT_COPY;
-
- sc->WRONG_TYPE_ARG_INFO = sc->NIL;
- for (i = 0; i < 6; i++)
- sc->WRONG_TYPE_ARG_INFO = permanent_cons(sc->F, sc->WRONG_TYPE_ARG_INFO, T_PAIR | T_STRUCTURE);
- s7_list_set(sc, sc->WRONG_TYPE_ARG_INFO, 0, s7_make_permanent_string("~A argument ~D, ~S, is ~A but should be ~A"));
-
- sc->SIMPLE_WRONG_TYPE_ARG_INFO = sc->NIL;
- for (i = 0; i < 5; i++)
- sc->SIMPLE_WRONG_TYPE_ARG_INFO = permanent_cons(sc->F, sc->SIMPLE_WRONG_TYPE_ARG_INFO, T_PAIR | T_STRUCTURE);
- s7_list_set(sc, sc->SIMPLE_WRONG_TYPE_ARG_INFO, 0, s7_make_permanent_string("~A argument, ~S, is ~A but should be ~A"));
+ sc->QUOTE_UNCHECKED = assign_internal_syntax(sc, "quote", OP_QUOTE_UNCHECKED);
+ sc->BEGIN_UNCHECKED = assign_internal_syntax(sc, "begin", OP_BEGIN_UNCHECKED);
+ sc->WITH_BAFFLE_UNCHECKED = assign_internal_syntax(sc, "with-baffle", OP_WITH_BAFFLE_UNCHECKED);
+ sc->LET_UNCHECKED = assign_internal_syntax(sc, "let", OP_LET_UNCHECKED);
+ sc->LET_STAR_UNCHECKED = assign_internal_syntax(sc, "let*", OP_LET_STAR_UNCHECKED);
+ sc->LETREC_UNCHECKED = assign_internal_syntax(sc, "letrec", OP_LETREC_UNCHECKED);
+ sc->LETREC_STAR_UNCHECKED = assign_internal_syntax(sc, "letrec*", OP_LETREC_STAR_UNCHECKED);
+ sc->LET_NO_VARS = assign_internal_syntax(sc, "let", OP_LET_NO_VARS);
+ sc->LET_C = assign_internal_syntax(sc, "let", OP_LET_C);
+ sc->LET_S = assign_internal_syntax(sc, "let", OP_LET_S);
+ sc->LET_ALL_C = assign_internal_syntax(sc, "let", OP_LET_ALL_C);
+ sc->LET_ALL_S = assign_internal_syntax(sc, "let", OP_LET_ALL_S);
+ sc->LET_ALL_X = assign_internal_syntax(sc, "let", OP_LET_ALL_X);
+ sc->LET_STAR_ALL_X = assign_internal_syntax(sc, "let*", OP_LET_STAR_ALL_X);
+ sc->LET_opCq = assign_internal_syntax(sc, "let", OP_LET_opCq);
+ sc->LET_opSSq = assign_internal_syntax(sc, "let", OP_LET_opSSq);
+ sc->LET_opSq = assign_internal_syntax(sc, "let", OP_LET_opSq);
+ sc->LET_opSq_P = assign_internal_syntax(sc, "let", OP_LET_opSq_P);
+ sc->LET_ONE = assign_internal_syntax(sc, "let", OP_LET_ONE);
+ sc->LET_Z = assign_internal_syntax(sc, "let", OP_LET_Z);
+ sc->LET_ALL_opSq = assign_internal_syntax(sc, "let", OP_LET_ALL_opSq);
+ sc->NAMED_LET_NO_VARS = assign_internal_syntax(sc, "let", OP_NAMED_LET_NO_VARS);
+ sc->NAMED_LET = assign_internal_syntax(sc, "let", OP_NAMED_LET);
+ sc->NAMED_LET_STAR = assign_internal_syntax(sc, "let*", OP_NAMED_LET_STAR);
+ sc->LET_STAR2 = assign_internal_syntax(sc, "let*", OP_LET_STAR2);
+ sc->WITH_LET_UNCHECKED = assign_internal_syntax(sc, "with-let", OP_WITH_LET_UNCHECKED);
+ sc->WITH_LET_S = assign_internal_syntax(sc, "with-let", OP_WITH_LET_S);
+ sc->CASE_UNCHECKED = assign_internal_syntax(sc, "case", OP_CASE_UNCHECKED);
+ sc->CASE_SIMPLE = assign_internal_syntax(sc, "case", OP_CASE_SIMPLE);
+ sc->CASE_SIMPLER = assign_internal_syntax(sc, "case", OP_CASE_SIMPLER);
+ sc->CASE_SIMPLER_1 = assign_internal_syntax(sc, "case", OP_CASE_SIMPLER_1);
+ sc->CASE_SIMPLER_SS = assign_internal_syntax(sc, "case", OP_CASE_SIMPLER_SS);
+ sc->CASE_SIMPLEST = assign_internal_syntax(sc, "case", OP_CASE_SIMPLEST);
+ sc->CASE_SIMPLEST_SS = assign_internal_syntax(sc, "case", OP_CASE_SIMPLEST_SS);
+ sc->COND_UNCHECKED = assign_internal_syntax(sc, "cond", OP_COND_UNCHECKED);
+ sc->COND_SIMPLE = assign_internal_syntax(sc, "cond", OP_COND_SIMPLE);
+ sc->DO_UNCHECKED = assign_internal_syntax(sc, "do", OP_DO_UNCHECKED);
+ sc->LAMBDA_UNCHECKED = assign_internal_syntax(sc, "lambda", OP_LAMBDA_UNCHECKED);
+ sc->LAMBDA_STAR_UNCHECKED = assign_internal_syntax(sc, "lambda*", OP_LAMBDA_STAR_UNCHECKED);
+ sc->DEFINE_UNCHECKED = assign_internal_syntax(sc, "define", OP_DEFINE_UNCHECKED);
+ sc->DEFINE_FUNCHECKED = assign_internal_syntax(sc, "define", OP_DEFINE_FUNCHECKED);
+ sc->DEFINE_STAR_UNCHECKED = assign_internal_syntax(sc, "define*", OP_DEFINE_STAR_UNCHECKED);
+ sc->DEFINE_CONSTANT_UNCHECKED = assign_internal_syntax(sc, "define-constant", OP_DEFINE_CONSTANT_UNCHECKED);
+ sc->SET_UNCHECKED = assign_internal_syntax(sc, "set!", OP_SET_UNCHECKED);
+ sc->SET_SYMBOL_C = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_C);
+ sc->SET_SYMBOL_S = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_S);
+ sc->SET_SYMBOL_Q = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_Q);
+ sc->SET_SYMBOL_opSq = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_opSq);
+ sc->SET_SYMBOL_opSSq = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_opSSq);
+ sc->SET_SYMBOL_opSSSq = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_opSSSq);
+ sc->SET_SYMBOL_opCq = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_opCq);
+ sc->SET_SYMBOL_P = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_P);
+ sc->SET_SYMBOL_Z = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_Z);
+ sc->SET_SYMBOL_A = assign_internal_syntax(sc, "set!", OP_SET_SYMBOL_A);
+ sc->SET_NORMAL = assign_internal_syntax(sc, "set!", OP_SET_NORMAL);
+ sc->SET_PWS = assign_internal_syntax(sc, "set!", OP_SET_PWS);
+ sc->SET_PAIR = assign_internal_syntax(sc, "set!", OP_SET_PAIR);
+ sc->SET_PAIR_P = assign_internal_syntax(sc, "set!", OP_SET_PAIR_P);
+ sc->SET_PAIR_Z = assign_internal_syntax(sc, "set!", OP_SET_PAIR_Z);
+ sc->SET_PAIR_A = assign_internal_syntax(sc, "set!", OP_SET_PAIR_A);
+ sc->SET_PAIR_ZA = assign_internal_syntax(sc, "set!", OP_SET_PAIR_ZA);
+ sc->SET_LET_S = assign_internal_syntax(sc, "set!", OP_SET_LET_S);
+ sc->SET_LET_ALL_X = assign_internal_syntax(sc, "set!", OP_SET_LET_ALL_X);
+ sc->SET_PAIR_C = assign_internal_syntax(sc, "set!", OP_SET_PAIR_C);
+ sc->SET_PAIR_C_P = assign_internal_syntax(sc, "set!", OP_SET_PAIR_C_P);
+ sc->INCREMENT_1 = assign_internal_syntax(sc, "set!", OP_INCREMENT_1);
+ sc->INCREMENT_SS = assign_internal_syntax(sc, "set!", OP_INCREMENT_SS);
+ sc->INCREMENT_SSS = assign_internal_syntax(sc, "set!", OP_INCREMENT_SSS);
+ sc->INCREMENT_SZ = assign_internal_syntax(sc, "set!", OP_INCREMENT_SZ);
+ sc->INCREMENT_SA = assign_internal_syntax(sc, "set!", OP_INCREMENT_SA);
+ sc->INCREMENT_SAA = assign_internal_syntax(sc, "set!", OP_INCREMENT_SAA);
+ sc->DECREMENT_1 = assign_internal_syntax(sc, "set!", OP_DECREMENT_1);
+ sc->SET_CONS = assign_internal_syntax(sc, "set!", OP_SET_CONS);
+ sc->AND_UNCHECKED = assign_internal_syntax(sc, "and", OP_AND_UNCHECKED);
+ sc->AND_P = assign_internal_syntax(sc, "and", OP_AND_P);
+ sc->AND_P2 = assign_internal_syntax(sc, "and", OP_AND_P2);
+ sc->OR_UNCHECKED = assign_internal_syntax(sc, "or", OP_OR_UNCHECKED);
+ sc->OR_P = assign_internal_syntax(sc, "or", OP_OR_P);
+ sc->OR_P2 = assign_internal_syntax(sc, "or", OP_OR_P2);
+ sc->IF_UNCHECKED = assign_internal_syntax(sc, "if", OP_IF_UNCHECKED);
+
+ sc->IF_P_P = assign_internal_syntax(sc, "if", OP_IF_P_P);
+ sc->IF_P_P_P = assign_internal_syntax(sc, "if", OP_IF_P_P_P);
+ sc->IF_ANDP_P = assign_internal_syntax(sc, "if", OP_IF_ANDP_P);
+ sc->IF_ANDP_P_P = assign_internal_syntax(sc, "if", OP_IF_ANDP_P_P);
+ sc->IF_ORP_P = assign_internal_syntax(sc, "if", OP_IF_ORP_P);
+ sc->IF_ORP_P_P = assign_internal_syntax(sc, "if", OP_IF_ORP_P_P);
+ sc->IF_S_P = assign_internal_syntax(sc, "if", OP_IF_S_P);
+ sc->IF_S_P_P = assign_internal_syntax(sc, "if", OP_IF_S_P_P);
+ sc->IF_P_FEED = assign_internal_syntax(sc, "cond", OP_IF_P_FEED);
+ sc->COND_ALL_X = assign_internal_syntax(sc, "cond", OP_COND_ALL_X);
+ sc->COND_ALL_X_2 = assign_internal_syntax(sc, "cond", OP_COND_ALL_X_2);
+ sc->COND_S = assign_internal_syntax(sc, "cond", OP_COND_S);
+ sc->IF_Z_P = assign_internal_syntax(sc, "if", OP_IF_Z_P);
+ sc->IF_Z_P_P = assign_internal_syntax(sc, "if", OP_IF_Z_P_P);
+ sc->IF_A_P = assign_internal_syntax(sc, "if", OP_IF_A_P);
+ sc->IF_A_P_P = assign_internal_syntax(sc, "if", OP_IF_A_P_P);
+ sc->IF_CC_P = assign_internal_syntax(sc, "if", OP_IF_CC_P);
+ sc->IF_CC_P_P = assign_internal_syntax(sc, "if", OP_IF_CC_P_P);
+ sc->IF_CS_P = assign_internal_syntax(sc, "if", OP_IF_CS_P);
+ sc->IF_CS_P_P = assign_internal_syntax(sc, "if", OP_IF_CS_P_P);
+ sc->IF_CSQ_P = assign_internal_syntax(sc, "if", OP_IF_CSQ_P);
+ sc->IF_CSQ_P_P = assign_internal_syntax(sc, "if", OP_IF_CSQ_P_P);
+ sc->IF_CSS_P = assign_internal_syntax(sc, "if", OP_IF_CSS_P);
+ sc->IF_CSS_P_P = assign_internal_syntax(sc, "if", OP_IF_CSS_P_P);
+ sc->IF_CSC_P = assign_internal_syntax(sc, "if", OP_IF_CSC_P);
+ sc->IF_CSC_P_P = assign_internal_syntax(sc, "if", OP_IF_CSC_P_P);
+ sc->IF_S_opCq_P = assign_internal_syntax(sc, "if", OP_IF_S_opCq_P);
+ sc->IF_S_opCq_P_P = assign_internal_syntax(sc, "if", OP_IF_S_opCq_P_P);
+ sc->IF_opSSq_P = assign_internal_syntax(sc, "if", OP_IF_opSSq_P);
+ sc->IF_opSSq_P_P = assign_internal_syntax(sc, "if", OP_IF_opSSq_P_P);
+ sc->IF_IS_PAIR_P = assign_internal_syntax(sc, "if", OP_IF_IS_PAIR_P);
+ sc->IF_IS_PAIR_P_P = assign_internal_syntax(sc, "if", OP_IF_IS_PAIR_P_P);
+ sc->IF_IS_SYMBOL_P = assign_internal_syntax(sc, "if", OP_IF_IS_SYMBOL_P);
+ sc->IF_IS_SYMBOL_P_P = assign_internal_syntax(sc, "if", OP_IF_IS_SYMBOL_P_P);
+ sc->IF_NOT_S_P = assign_internal_syntax(sc, "if", OP_IF_NOT_S_P);
+ sc->IF_NOT_S_P_P = assign_internal_syntax(sc, "if", OP_IF_NOT_S_P_P);
+ sc->IF_AND2_P = assign_internal_syntax(sc, "if", OP_IF_AND2_P);
+ sc->IF_AND2_P_P = assign_internal_syntax(sc, "if", OP_IF_AND2_P_P);
+ sc->WHEN_S = assign_internal_syntax(sc, "when", OP_WHEN_S);
+ sc->UNLESS_S = assign_internal_syntax(sc, "unless", OP_UNLESS_S);
+ sc->WHEN_UNCHECKED = assign_internal_syntax(sc, "when", OP_WHEN_UNCHECKED);
+ sc->UNLESS_UNCHECKED = assign_internal_syntax(sc, "unless", OP_UNLESS_UNCHECKED);
+ sc->DOTIMES_P = assign_internal_syntax(sc, "do", OP_DOTIMES_P);
+ sc->SIMPLE_DO = assign_internal_syntax(sc, "do", OP_SIMPLE_DO);
+ sc->SIMPLE_DO_P = assign_internal_syntax(sc, "do", OP_SIMPLE_DO_P);
+ sc->SIMPLE_DO_A = assign_internal_syntax(sc, "do", OP_SIMPLE_DO_A);
+ sc->SIMPLE_DO_E = assign_internal_syntax(sc, "do", OP_SIMPLE_DO_E);
+ sc->SAFE_DOTIMES = assign_internal_syntax(sc, "do", OP_SAFE_DOTIMES);
+ sc->SAFE_DO = assign_internal_syntax(sc, "do", OP_SAFE_DO);
+ sc->DOX = assign_internal_syntax(sc, "do", OP_DOX);
+
+ sc->DOCUMENTATION = make_symbol(sc, "documentation");
+ sc->SIGNATURE = make_symbol(sc, "signature");
+
+#if WITH_IMMUTABLE_UNQUOTE
+ /* this code solves the various unquote redefinition troubles
+ * if "," -> "(unquote...)" in the reader, (let (, (lambda (x) (+ x 1))) ,,,,1) -> 5
+ * in s7, this requires a quote: (let (, (lambda (x) (+ x 1))) ,,,,'1)
+ */
+ sc->UNQUOTE = make_symbol(sc, ",");
+ set_immutable(sc->UNQUOTE);
+#else
+ sc->UNQUOTE = make_symbol(sc, "unquote");
+#endif
+ sc->FEED_TO = make_symbol(sc, "=>");
+ sc->BAFFLE = make_symbol(sc, "(baffle)");
+ sc->BODY = make_symbol(sc, "body");
+ sc->ERROR = make_symbol(sc, "error");
+ sc->READ_ERROR = make_symbol(sc, "read-error");
+ sc->STRING_READ_ERROR = make_symbol(sc, "string-read-error");
+ sc->SYNTAX_ERROR = make_symbol(sc, "syntax-error");
+ sc->WRONG_TYPE_ARG = make_symbol(sc, "wrong-type-arg");
sc->WRONG_NUMBER_OF_ARGS = make_symbol(sc, "wrong-number-of-args");
- typeflag(sc->WRONG_NUMBER_OF_ARGS) |= T_DONT_COPY;
-
- sc->FORMAT_ERROR = make_symbol(sc, "format-error");
- typeflag(sc->FORMAT_ERROR) |= T_DONT_COPY;
-
- sc->OUT_OF_RANGE = make_symbol(sc, "out-of-range");
- typeflag(sc->OUT_OF_RANGE) |= T_DONT_COPY;
-
- sc->OUT_OF_RANGE_INFO = sc->NIL;
- for (i = 0; i < 5; i++)
- sc->OUT_OF_RANGE_INFO = permanent_cons(sc->F, sc->OUT_OF_RANGE_INFO, T_PAIR | T_STRUCTURE);
- s7_list_set(sc, sc->OUT_OF_RANGE_INFO, 0, s7_make_permanent_string("~A argument ~D, ~S, is out of range (~A)"));
+ sc->FORMAT_ERROR = make_symbol(sc, "format-error");
+ sc->OUT_OF_RANGE = make_symbol(sc, "out-of-range");
+ sc->NO_CATCH = make_symbol(sc, "no-catch");
+ sc->IO_ERROR = make_symbol(sc, "io-error");
+ sc->INVALID_ESCAPE_FUNCTION = make_symbol(sc, "invalid-escape-function");
+ sc->BAFFLED = make_symbol(sc, "baffled!");
- sc->SIMPLE_OUT_OF_RANGE_INFO = sc->NIL;
- for (i = 0; i < 4; i++)
- sc->SIMPLE_OUT_OF_RANGE_INFO = permanent_cons(sc->F, sc->SIMPLE_OUT_OF_RANGE_INFO, T_PAIR | T_STRUCTURE);
- s7_list_set(sc, sc->SIMPLE_OUT_OF_RANGE_INFO, 0, s7_make_permanent_string("~A argument, ~S, is out of range (~A)"));
-
- sc->KEY_KEY = s7_make_keyword(sc, "key");
- typeflag(sc->KEY_KEY) |= T_DONT_COPY;
-
- sc->KEY_OPTIONAL = s7_make_keyword(sc, "optional");
- typeflag(sc->KEY_OPTIONAL) |= T_DONT_COPY;
-
sc->KEY_ALLOW_OTHER_KEYS = s7_make_keyword(sc, "allow-other-keys");
- typeflag(sc->KEY_ALLOW_OTHER_KEYS) |= T_DONT_COPY;
-
- sc->KEY_REST = s7_make_keyword(sc, "rest");
- typeflag(sc->KEY_REST) |= T_DONT_COPY;
+ sc->KEY_REST = s7_make_keyword(sc, "rest");
+ sc->KEY_READABLE = s7_make_keyword(sc, "readable");
sc->__FUNC__ = make_symbol(sc, "__func__");
- typeflag(sc->__FUNC__) |= (T_DONT_COPY | T_LOCAL);
+ s7_make_slot(sc, sc->NIL, sc->else_symbol = make_symbol(sc, "else"), sc->ELSE);
+ sc->owlet = init_owlet(sc);
- sc->SET = make_symbol(sc, "set!");
- typeflag(sc->SET) |= T_DONT_COPY;
+ sc->wrong_type_arg_info = permanent_list(sc, 6);
+ car(sc->wrong_type_arg_info) = s7_make_permanent_string("~A argument ~D, ~S, is ~A but should be ~A");
- sc->s_function_args = permanent_cons(sc->F, sc->NIL, T_PAIR | T_STRUCTURE);
+ sc->simple_wrong_type_arg_info = permanent_list(sc, 5);
+ car(sc->simple_wrong_type_arg_info) = s7_make_permanent_string("~A argument, ~S, is ~A but should be ~A");
+
+ sc->out_of_range_info = permanent_list(sc, 5);
+ car(sc->out_of_range_info) = s7_make_permanent_string("~A argument ~D, ~S, is out of range (~A)");
+
+ sc->simple_out_of_range_info = permanent_list(sc, 4);
+ car(sc->simple_out_of_range_info) = s7_make_permanent_string("~A argument, ~S, is out of range (~A)");
sc->TOO_MANY_ARGUMENTS = s7_make_permanent_string("~A: too many arguments: ~A");
sc->NOT_ENOUGH_ARGUMENTS = s7_make_permanent_string("~A: not enough arguments: ~A");
+ sc->DIVISION_BY_ZERO_ERROR = s7_make_permanent_string("~A: division by zero, ~S");
+ sc->DIVISION_BY_ZERO = make_symbol(sc, "division-by-zero");
+
+ if (!already_inited)
+ init_car_a_list();
+
+ for (i = 0; i < NUM_TYPES; i++)
+ {
+ const char *str;
+ str = type_name_from_type(sc, i, INDEFINITE_ARTICLE);
+ if (str)
+ prepackaged_type_names[i] = s7_make_permanent_string(str);
+ else prepackaged_type_names[i] = sc->F;
+ }
+ /* unset built-ins: T_STACK (can't happen), T_C_OBJECT (want actual name), T_INPUT|OUTPUT_PORT (want string|file|etc included) */
+
+ sc->gc_off = false;
+
+ #define defun(Scheme_Name, C_Name, Req, Opt, Rst) s7_define_typed_function(sc, Scheme_Name, g_ ## C_Name, Req, Opt, Rst, H_ ## C_Name, Q_ ## C_Name)
+ #define unsafe_defun(Scheme_Name, C_Name, Req, Opt, Rst) s7_define_unsafe_typed_function(sc, Scheme_Name, g_ ## C_Name, Req, Opt, Rst, H_ ## C_Name, Q_ ## C_Name)
+
+ /* we need the sc->IS_* symbols first for the procedure signature lists */
+ sc->IS_BOOLEAN = make_symbol(sc, "boolean?");
+ pl_bt = s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->T);
+
+ sc->IS_SYMBOL = defun("symbol?", is_symbol, 1, 0, false);
+ sc->IS_GENSYM = defun("gensym?", is_gensym, 1, 0, false);
+ sc->IS_KEYWORD = defun("keyword?", is_keyword, 1, 0, false);
+ sc->IS_LET = defun("let?", is_let, 1, 0, false);
+ sc->IS_OPENLET = defun("openlet?", is_openlet, 1, 0, false);
+ sc->IS_ITERATOR = defun("iterator?", is_iterator, 1, 0, false);
+ sc->IS_CONSTANT = defun("constant?", is_constant, 1, 0, false);
+ sc->IS_MACRO = defun("macro?", is_macro, 1, 0, false);
+ sc->IS_C_POINTER = defun("c-pointer?", is_c_pointer, 1, 0, false);
+ sc->IS_C_OBJECT = defun("c-object?", is_c_object, 1, 0, false);
+ sc->IS_INPUT_PORT = defun("input-port?", is_input_port, 1, 0, false);
+ sc->IS_OUTPUT_PORT = defun("output-port?", is_output_port, 1, 0, false);
+ sc->IS_EOF_OBJECT = defun("eof-object?", is_eof_object, 1, 0, false);
+ sc->IS_INTEGER = defun("integer?", is_integer, 1, 0, false);
+ sc->IS_NUMBER = defun("number?", is_number, 1, 0, false);
+ sc->IS_REAL = defun("real?", is_real, 1, 0, false);
+ sc->IS_COMPLEX = defun("complex?", is_complex, 1, 0, false);
+ sc->IS_RATIONAL = defun("rational?", is_rational, 1, 0, false);
+ sc->IS_RANDOM_STATE = defun("random-state?", is_random_state, 1, 0, false);
+ sc->IS_CHAR = defun("char?", is_char, 1, 0, false);
+ sc->IS_STRING = defun("string?", is_string, 1, 0, false);
+ sc->IS_LIST = defun("list?", is_list, 1, 0, false);
+ sc->IS_PAIR = defun("pair?", is_pair, 1, 0, false);
+ sc->IS_VECTOR = defun("vector?", is_vector, 1, 0, false);
+ sc->IS_FLOAT_VECTOR = defun("float-vector?", is_float_vector, 1, 0, false);
+ sc->IS_INT_VECTOR = defun("int-vector?", is_int_vector, 1, 0, false);
+ sc->IS_BYTE_VECTOR = defun("byte-vector?", is_byte_vector, 1, 0, false);
+ sc->IS_HASH_TABLE = defun("hash-table?", is_hash_table, 1, 0, false);
+ sc->IS_CONTINUATION = defun("continuation?", is_continuation, 1, 0, false);
+ sc->IS_PROCEDURE = defun("procedure?", is_procedure, 1, 0, false);
+ sc->IS_DILAMBDA = defun("dilambda?", is_dilambda, 1, 0, false);
+ /* set above */ defun("boolean?", is_boolean, 1, 0, false);
+ sc->IS_FLOAT = defun("float?", is_float, 1, 0, false);
+ sc->IS_PROPER_LIST = defun("proper-list?", is_proper_list, 1, 0, false);
+ sc->IS_SEQUENCE = defun("sequence?", is_sequence, 1, 0, false);
+ sc->IS_NULL = defun("null?", is_null, 1, 0, false);
+
+ sc->IS_INTEGER_OR_REAL_AT_END = s7_define_function(sc, "integer:real?", g_is_integer_or_real_at_end, 1, 0, false, "internal signature helper");
+ sc->IS_INTEGER_OR_ANY_AT_END = s7_define_function(sc, "integer:any?", g_is_integer_or_any_at_end, 1, 0, false, "internal signature helper");
+
+ pl_p = s7_make_signature(sc, 2, sc->T, sc->IS_PAIR);
+#if (!WITH_PURE_S7)
+ pl_tp = s7_make_signature(sc, 3, sc->T, sc->T, sc->IS_PAIR);
+#endif
+ pl_bc = s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_CHAR);
+ pl_bn = s7_make_signature(sc, 2, sc->IS_BOOLEAN, sc->IS_NUMBER);
+ pl_sf = s7_make_signature(sc, 3, sc->T, sc->IS_STRING, sc->IS_PROCEDURE);
+ pcl_bt = s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->T);
+ pcl_bc = s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_CHAR);
+ pcl_bs = s7_make_circular_signature(sc, 1, 2, sc->IS_BOOLEAN, sc->IS_STRING);
+
+ pcl_i = s7_make_circular_signature(sc, 0, 1, sc->IS_INTEGER);
+ pcl_t = s7_make_circular_signature(sc, 0, 1, sc->T);
+ pcl_r = s7_make_circular_signature(sc, 0, 1, sc->IS_REAL);
+ pcl_f = s7_make_circular_signature(sc, 0, 1, sc->IS_RATIONAL);
+ pcl_n = s7_make_circular_signature(sc, 0, 1, sc->IS_NUMBER);
+ pcl_s = s7_make_circular_signature(sc, 0, 1, sc->IS_STRING);
+ pcl_v = s7_make_circular_signature(sc, 0, 1, sc->IS_VECTOR);
+ pcl_c = s7_make_circular_signature(sc, 0, 1, sc->IS_CHAR);
+
+ sc->VALUES = make_symbol(sc, "values");
+
+ sc->GENSYM = defun("gensym", gensym, 0, 1, false);
+ defun("symbol-table", symbol_table, 0, 0, false);
+ sc->SYMBOL_TO_STRING = defun("symbol->string", symbol_to_string, 1, 0, false);
+ sc->STRING_TO_SYMBOL = defun("string->symbol", string_to_symbol, 1, 0, false);
+ sc->SYMBOL = defun("symbol", symbol, 1, 0, false);
+ sc->SYMBOL_TO_VALUE = defun("symbol->value", symbol_to_value, 1, 1, false);
+ sc->SYMBOL_TO_DYNAMIC_VALUE = defun("symbol->dynamic-value", symbol_to_dynamic_value, 1, 0, false);
+ s7_typed_dilambda(sc, "symbol-access", g_symbol_access, 1, 1, g_symbol_set_access, 2, 1, H_symbol_access, Q_symbol_access, NULL);
+ sc->SYMBOL_ACCESS = make_symbol(sc, "symbol-access");
+
+ sc->MAKE_KEYWORD = defun("make-keyword", make_keyword, 1, 0, false);
+ sc->SYMBOL_TO_KEYWORD = defun("symbol->keyword", symbol_to_keyword, 1, 0, false);
+ sc->KEYWORD_TO_SYMBOL = defun("keyword->symbol", keyword_to_symbol, 1, 0, false);
+
+ sc->OUTLET = defun("outlet", outlet, 1, 0, false);
+ sc->ROOTLET = defun("rootlet", rootlet, 0, 0, false);
+ sc->CURLET = defun("curlet", curlet, 0, 0, false);
+ sc->UNLET = defun("unlet", unlet, 0, 0, false);
+ set_immutable(sc->UNLET);
+ sc->SUBLET = defun("sublet", sublet, 1, 0, true);
+ sc->VARLET = unsafe_defun("varlet", varlet, 1, 0, true);
+ sc->CUTLET = unsafe_defun("cutlet", cutlet, 1, 0, true);
+ sc->INLET = defun("inlet", inlet, 0, 0, true);
+ sc->OWLET = defun("owlet", owlet, 0, 0, false);
+ sc->COVERLET = defun("coverlet", coverlet, 1, 0, false);
+ sc->OPENLET = defun("openlet", openlet, 1, 0, false);
+ sc->LET_REF = defun("let-ref", let_ref, 2, 0, false);
+ sc->LET_SET = defun("let-set!", let_set, 3, 0, false);
+ sc->LET_REF_FALLBACK = make_symbol(sc, "let-ref-fallback");
+ sc->LET_SET_FALLBACK = make_symbol(sc, "let-set!-fallback");
+
+ sc->MAKE_ITERATOR = defun("make-iterator", make_iterator, 1, 1, false);
+ sc->ITERATE = defun("iterate", iterate, 1, 0, false);
+ sc->ITERATOR_SEQUENCE = defun("iterator-sequence", iterator_sequence, 1, 0, false);
+ sc->ITERATOR_IS_AT_END = defun("iterator-at-end?", iterator_is_at_end, 1, 0, false);
+
+ sc->IS_PROVIDED = defun("provided?", is_provided, 1, 0, false);
+ sc->PROVIDE = defun("provide", provide, 1, 0, false);
+ sc->IS_DEFINED = defun("defined?", is_defined, 1, 2, false);
+
+ sc->C_POINTER = defun("c-pointer", c_pointer, 1, 0, false);
+
+ sc->PORT_LINE_NUMBER = defun("port-line-number", port_line_number, 0, 1, false);
+ sc->PORT_FILENAME = defun("port-filename", port_filename, 0, 1, false);
+ sc->PAIR_LINE_NUMBER = defun("pair-line-number", pair_line_number, 1, 0, false);
+
+ sc->IS_PORT_CLOSED = defun("port-closed?", is_port_closed, 1, 0, false);
+
+ sc->CURRENT_INPUT_PORT = defun("current-input-port", current_input_port, 0, 0, false);
+ sc->CURRENT_OUTPUT_PORT = defun("current-output-port", current_output_port, 0, 0, false);
+ sc->CURRENT_ERROR_PORT = defun("current-error-port", current_error_port, 0, 0, false);
+ defun("set-current-error-port", set_current_error_port, 1, 0, false);
+#if (!WITH_PURE_S7)
+ sc->LET_TO_LIST = defun("let->list", let_to_list, 1, 0, false);
+ defun("set-current-input-port", set_current_input_port, 1, 0, false);
+ defun("set-current-output-port", set_current_output_port, 1, 0, false);
+ sc->IS_CHAR_READY = defun("char-ready?", is_char_ready, 0, 1, false); /* the least-used scheme function */
+#endif
- (*(sc->gc_off)) = false;
-
- /* pws first so that make-procedure-with-setter has a type tag */
- s7_define_function(sc, "make-procedure-with-setter", g_make_procedure_with_setter, 2, 0, false, H_make_procedure_with_setter);
- s7_define_function(sc, "procedure-with-setter?", g_is_procedure_with_setter, 1, 0, false, H_is_procedure_with_setter);
- pws_tag = s7_new_type("<procedure-with-setter>", pws_print, pws_free, pws_equal, pws_mark, pws_apply, pws_set);
-
+ sc->CLOSE_INPUT_PORT = defun("close-input-port", close_input_port, 1, 0, false);
+ sc->CLOSE_OUTPUT_PORT = defun("close-output-port", close_output_port, 1, 0, false);
+ sc->FLUSH_OUTPUT_PORT = defun("flush-output-port", flush_output_port, 0, 1, false);
+ sc->OPEN_INPUT_FILE = defun("open-input-file", open_input_file, 1, 1, false);
+ sc->OPEN_OUTPUT_FILE = defun("open-output-file", open_output_file, 1, 1, false);
+ sc->OPEN_INPUT_STRING = defun("open-input-string", open_input_string, 1, 0, false);
+ defun("open-output-string", open_output_string, 0, 0, false);
+ sc->GET_OUTPUT_STRING = defun("get-output-string", get_output_string, 1, 1, false);
+
+ sc->NEWLINE = defun("newline", newline, 0, 1, false);
+ sc->WRITE = defun("write", write, 1, 1, false);
+ sc->DISPLAY = defun("display", display, 1, 1, false);
+ sc->READ_CHAR = defun("read-char", read_char, 0, 1, false);
+ sc->PEEK_CHAR = defun("peek-char", peek_char, 0, 1, false);
+ sc->WRITE_CHAR = defun("write-char", write_char, 1, 1, false);
+ sc->WRITE_STRING = defun("write-string", write_string, 1, 3, false);
+ sc->READ_BYTE = defun("read-byte", read_byte, 0, 1, false);
+ sc->WRITE_BYTE = defun("write-byte", write_byte, 1, 1, false);
+ sc->READ_LINE = defun("read-line", read_line, 0, 2, false);
+ sc->READ_STRING = defun("read-string", read_string, 1, 1, false);
+ sc->READ = unsafe_defun("read", read, 0, 1, false);
+ /* read can't be safe because it messes with the stack, expecting to be all by itself in the call sequence (not embedded in OP_SAFE_C_opSq for example) */
+
+ sc->CALL_WITH_INPUT_STRING = unsafe_defun("call-with-input-string", call_with_input_string, 2, 0, false);
+ sc->CALL_WITH_INPUT_FILE = unsafe_defun("call-with-input-file", call_with_input_file, 2, 0, false);
+ sc->WITH_INPUT_FROM_STRING = unsafe_defun("with-input-from-string", with_input_from_string, 2, 0, false);
+ sc->WITH_INPUT_FROM_FILE = unsafe_defun("with-input-from-file", with_input_from_file, 2, 0, false);
+
+ sc->CALL_WITH_OUTPUT_STRING = unsafe_defun("call-with-output-string", call_with_output_string, 1, 0, false);
+ sc->CALL_WITH_OUTPUT_FILE = unsafe_defun("call-with-output-file", call_with_output_file, 2, 0, false);
+ sc->WITH_OUTPUT_TO_STRING = unsafe_defun("with-output-to-string", with_output_to_string, 1, 0, false);
+ sc->WITH_OUTPUT_TO_FILE = unsafe_defun("with-output-to-file", with_output_to_file, 2, 0, false);
+
+#if WITH_SYSTEM_EXTRAS
+ sc->IS_DIRECTORY = defun("directory?", is_directory, 1, 0, false);
+ sc->FILE_EXISTS = defun("file-exists?", file_exists, 1, 0, false);
+ sc->DELETE_FILE = defun("delete-file", delete_file, 1, 0, false);
+ sc->GETENV = defun("getenv", getenv, 1, 0, false);
+ sc->SYSTEM = defun("system", system, 1, 1, false);
+#ifndef _MSC_VER
+ sc->DIRECTORY_TO_LIST = defun("directory->list", directory_to_list, 1, 0, false);
+ sc->FILE_MTIME = defun("file-mtime", file_mtime, 1, 0, false);
+#endif
+#endif
- s7_define_function(sc, "gensym", g_gensym, 0, 1, false, H_gensym);
- s7_define_function(sc, "symbol-table", g_symbol_table, 0, 0, false, H_symbol_table);
- s7_define_function(sc, "symbol?", g_is_symbol, 1, 0, false, H_is_symbol);
- s7_define_function(sc, "symbol->string", g_symbol_to_string, 1, 0, false, H_symbol_to_string);
- s7_define_function(sc, "string->symbol", g_string_to_symbol, 1, 0, false, H_string_to_symbol);
- s7_define_function(sc, "symbol", g_symbol, 1, 0, false, H_symbol);
- s7_define_function(sc, "symbol->value", g_symbol_to_value, 1, 1, false, H_symbol_to_value);
-#if WITH_PROFILING
- s7_define_function(sc, "symbol-calls", g_symbol_calls, 1, 0, false, H_symbol_calls);
-#endif
- s7_define_function_with_setter(sc, "symbol-access", g_symbol_get_access, g_symbol_set_access, 1, 0, H_symbol_access);
-
- s7_define_function(sc, "global-environment", g_global_environment, 0, 0, false, H_global_environment);
- s7_define_function(sc, "current-environment", g_current_environment, 0, CURRENT_ENVIRONMENT_OPTARGS, false, H_current_environment);
- s7_define_constant_function(sc, "initial-environment", g_initial_environment, 0, 0, false, H_initial_environment);
- s7_define_function(sc, "augment-environment", g_augment_environment, 1, 0, true, H_augment_environment);
- s7_define_function(sc, "augment-environment!", g_augment_environment_direct, 1, 0, true, H_augment_environment_direct);
- s7_define_function(sc, "environment?", g_is_environment, 1, 0, false, H_is_environment);
- s7_define_function(sc, "provided?", g_is_provided, 1, 0, false, H_is_provided);
- s7_define_function(sc, "provide", g_provide, 1, 0, false, H_provide);
- s7_define_function(sc, "defined?", g_is_defined, 1, 1, false, H_is_defined);
- s7_define_function(sc, "constant?", g_is_constant, 1, 0, false, H_is_constant);
- s7_define_function(sc, "macro?", g_is_macro, 1, 0, false, H_is_macro);
-
-
- s7_define_function(sc, "keyword?", g_is_keyword, 1, 0, false, H_is_keyword);
- s7_define_function(sc, "make-keyword", g_make_keyword, 1, 0, false, H_make_keyword);
- s7_define_function(sc, "symbol->keyword", g_symbol_to_keyword, 1, 0, false, H_symbol_to_keyword);
- s7_define_function(sc, "keyword->symbol", g_keyword_to_symbol, 1, 0, false, H_keyword_to_symbol);
-
+ sc->REAL_PART = defun("real-part", real_part, 1, 0, false);
+ sc->IMAG_PART = defun("imag-part", imag_part, 1, 0, false);
+ sc->NUMERATOR = defun("numerator", numerator, 1, 0, false);
+ sc->DENOMINATOR = defun("denominator", denominator, 1, 0, false);
+ sc->IS_EVEN = defun("even?", is_even, 1, 0, false);
+ sc->IS_ODD = defun("odd?", is_odd, 1, 0, false);
+ sc->IS_ZERO = defun("zero?", is_zero, 1, 0, false);
+ sc->IS_POSITIVE = defun("positive?", is_positive, 1, 0, false);
+ sc->IS_NEGATIVE = defun("negative?", is_negative, 1, 0, false);
+ sc->IS_INFINITE = defun("infinite?", is_infinite, 1, 0, false);
+ sc->IS_NAN = defun("nan?", is_nan, 1, 0, false);
- s7_define_function(sc, "port-line-number", g_port_line_number, 0, 1, false, H_port_line_number);
- s7_define_function(sc, "port-filename", g_port_filename, 0, 1, false, H_port_filename);
-
- s7_define_function(sc, "input-port?", g_is_input_port, 1, 0, false, H_is_input_port);
- s7_define_function(sc, "output-port?", g_is_output_port, 1, 0, false, H_is_output_port);
- s7_define_function(sc, "port-closed?", g_is_port_closed, 1, 0, false, H_is_port_closed);
- s7_define_function(sc, "char-ready?", g_is_char_ready, 0, 1, false, H_is_char_ready);
- s7_define_function(sc, "eof-object?", g_is_eof_object, 1, 0, false, H_is_eof_object);
- /* this should be named eof? (what isn't an object?) */
-
- s7_define_function(sc, "current-input-port", g_current_input_port, 0, 0, false, H_current_input_port);
- s7_define_function(sc, "set-current-input-port", g_set_current_input_port, 1, 0, false, H_set_current_input_port);
- s7_define_function(sc, "current-output-port", g_current_output_port, 0, 0, false, H_current_output_port);
- s7_define_function(sc, "set-current-output-port", g_set_current_output_port, 1, 0, false, H_set_current_output_port);
- s7_define_function(sc, "current-error-port", g_current_error_port, 0, 0, false, H_current_error_port);
- s7_define_function(sc, "set-current-error-port", g_set_current_error_port, 1, 0, false, H_set_current_error_port);
- s7_define_function(sc, "close-input-port", g_close_input_port, 1, 0, false, H_close_input_port);
- s7_define_function(sc, "close-output-port", g_close_output_port, 1, 0, false, H_close_output_port);
- s7_define_function(sc, "open-input-file", g_open_input_file, 1, 1, false, H_open_input_file);
- s7_define_function(sc, "open-output-file", g_open_output_file, 1, 1, false, H_open_output_file);
- s7_define_function(sc, "open-input-string", g_open_input_string, 1, 0, false, H_open_input_string);
- s7_define_function(sc, "open-output-string", g_open_output_string, 0, 0, false, H_open_output_string);
- s7_define_function(sc, "get-output-string", g_get_output_string, 1, 0, false, H_get_output_string);
-
- s7_define_function(sc, "read-char", g_read_char, 0, 1, false, H_read_char);
- s7_define_function(sc, "peek-char", g_peek_char, 0, 1, false, H_peek_char);
- s7_define_function(sc, "read", g_read, 0, 1, false, H_read);
- s7_define_function(sc, "newline", g_newline, 0, 1, false, H_newline);
- s7_define_function(sc, "write-char", g_write_char, 1, 1, false, H_write_char);
- s7_define_function(sc, "write", g_write, 1, 1, false, H_write);
- s7_define_function(sc, "display", g_display, 1, 1, false, H_display);
- s7_define_function(sc, "read-byte", g_read_byte, 0, 1, false, H_read_byte);
- s7_define_function(sc, "write-byte", g_write_byte, 1, 1, false, H_write_byte);
- s7_define_function(sc, "read-line", g_read_line, 0, 2, false, H_read_line);
-
- s7_define_function(sc, "call-with-input-string", g_call_with_input_string, 2, 0, false, H_call_with_input_string);
- s7_define_function(sc, "call-with-input-file", g_call_with_input_file, 2, 0, false, H_call_with_input_file);
- s7_define_function(sc, "with-input-from-string", g_with_input_from_string, 2, 0, false, H_with_input_from_string);
- s7_define_function(sc, "with-input-from-file", g_with_input_from_file, 2, 0, false, H_with_input_from_file);
-
- s7_define_function(sc, "call-with-output-string", g_call_with_output_string, 1, 0, false, H_call_with_output_string);
- s7_define_function(sc, "call-with-output-file", g_call_with_output_file, 2, 0, false, H_call_with_output_file);
- s7_define_function(sc, "with-output-to-string", g_with_output_to_string, 1, 0, false, H_with_output_to_string);
- s7_define_function(sc, "with-output-to-file", g_with_output_to_file, 2, 0, false, H_with_output_to_file);
-
-
#if (!WITH_GMP)
- s7_define_function(sc, "make-polar", g_make_polar, 2, 0, false, H_make_polar);
- s7_define_function(sc, "make-rectangular", g_make_rectangular, 2, 0, false, H_make_rectangular);
- s7_define_function(sc, "magnitude", g_magnitude, 1, 0, false, H_magnitude);
- s7_define_function(sc, "angle", g_angle, 1, 0, false, H_angle);
- s7_define_function(sc, "real-part", g_real_part, 1, 0, false, H_real_part);
- s7_define_function(sc, "imag-part", g_imag_part, 1, 0, false, H_imag_part);
- s7_define_function(sc, "numerator", g_numerator, 1, 0, false, H_numerator);
- s7_define_function(sc, "denominator", g_denominator, 1, 0, false, H_denominator);
- s7_define_function(sc, "rationalize", g_rationalize, 1, 1, false, H_rationalize);
- s7_define_function(sc, "abs", g_abs, 1, 0, false, H_abs);
- s7_define_function(sc, "exp", g_exp, 1, 0, false, H_exp);
- s7_define_function(sc, "log", g_log, 1, 1, false, H_log);
- s7_define_function(sc, "sin", g_sin, 1, 0, false, H_sin);
- s7_define_function(sc, "cos", g_cos, 1, 0, false, H_cos);
- s7_define_function(sc, "tan", g_tan, 1, 0, false, H_tan);
- s7_define_function(sc, "asin", g_asin, 1, 0, false, H_asin);
- s7_define_function(sc, "acos", g_acos, 1, 0, false, H_acos);
- s7_define_function(sc, "atan", g_atan, 1, 1, false, H_atan);
- s7_define_function(sc, "sinh", g_sinh, 1, 0, false, H_sinh);
- s7_define_function(sc, "cosh", g_cosh, 1, 0, false, H_cosh);
- s7_define_function(sc, "tanh", g_tanh, 1, 0, false, H_tanh);
- s7_define_function(sc, "asinh", g_asinh, 1, 0, false, H_asinh);
- s7_define_function(sc, "acosh", g_acosh, 1, 0, false, H_acosh);
- s7_define_function(sc, "atanh", g_atanh, 1, 0, false, H_atanh);
- s7_define_function(sc, "sqrt", g_sqrt, 1, 0, false, H_sqrt);
- s7_define_function(sc, "expt", g_expt, 2, 0, false, H_expt);
- s7_define_function(sc, "floor", g_floor, 1, 0, false, H_floor);
- s7_define_function(sc, "ceiling", g_ceiling, 1, 0, false, H_ceiling);
- s7_define_function(sc, "truncate", g_truncate, 1, 0, false, H_truncate);
- s7_define_function(sc, "round", g_round, 1, 0, false, H_round);
- s7_define_function(sc, "lcm", g_lcm, 0, 0, true, H_lcm);
- s7_define_function(sc, "gcd", g_gcd, 0, 0, true, H_gcd);
- s7_define_function(sc, "+", g_add, 0, 0, true, H_add);
- s7_define_function(sc, "-", g_subtract, 1, 0, true, H_subtract);
- s7_define_function(sc, "*", g_multiply, 0, 0, true, H_multiply);
- s7_define_function(sc, "/", g_divide, 1, 0, true, H_divide);
- s7_define_function(sc, "max", g_max, 1, 0, true, H_max);
- s7_define_function(sc, "min", g_min, 1, 0, true, H_min);
- s7_define_function(sc, "quotient", g_quotient, 2, 0, false, H_quotient);
- s7_define_function(sc, "remainder", g_remainder, 2, 0, false, H_remainder);
- s7_define_function(sc, "modulo", g_modulo, 2, 0, false, H_modulo);
- s7_define_function(sc, "=", g_equal, 2, 0, true, H_equal);
- s7_define_function(sc, "<", g_less, 2, 0, true, H_less);
- s7_define_function(sc, ">", g_greater, 2, 0, true, H_greater);
- s7_define_function(sc, "<=", g_less_or_equal, 2, 0, true, H_less_or_equal);
- s7_define_function(sc, ">=", g_greater_or_equal, 2, 0, true, H_greater_or_equal);
- s7_define_function(sc, "even?", g_is_even, 1, 0, false, H_is_even);
- s7_define_function(sc, "odd?", g_is_odd, 1, 0, false, H_is_odd);
- s7_define_function(sc, "zero?", g_is_zero, 1, 0, false, H_is_zero);
- s7_define_function(sc, "positive?", g_is_positive, 1, 0, false, H_is_positive);
- s7_define_function(sc, "negative?", g_is_negative, 1, 0, false, H_is_negative);
- s7_define_function(sc, "infinite?", g_is_infinite, 1, 0, false, H_is_infinite);
- s7_define_function(sc, "nan?", g_is_nan, 1, 0, false, H_is_nan);
-
- s7_define_function(sc, "inexact->exact", g_inexact_to_exact, 1, 0, false, H_inexact_to_exact);
- s7_define_function(sc, "exact->inexact", g_exact_to_inexact, 1, 0, false, H_exact_to_inexact);
-
- s7_define_function(sc, "random", g_random, 1, 1, false, H_random);
- s7_define_function(sc, "make-random-state", s7_make_random_state, 1, 1, false, H_make_random_state);
-
- s7_define_function(sc, "integer-length", g_integer_length, 1, 0, false, H_integer_length);
- s7_define_function(sc, "logior", g_logior, 0, 0, true, H_logior);
- s7_define_function(sc, "logxor", g_logxor, 0, 0, true, H_logxor);
- s7_define_function(sc, "logand", g_logand, 0, 0, true, H_logand);
- s7_define_function(sc, "lognot", g_lognot, 1, 0, false, H_lognot);
- s7_define_function(sc, "ash", g_ash, 2, 0, false, H_ash);
-#endif
- s7_define_function(sc, "random-state->list", s7_random_state_to_list, 0, 1, false, H_random_state_to_list);
- s7_define_function(sc, "integer-decode-float", g_integer_decode_float, 1, 0, false, H_integer_decode_float);
- s7_define_function(sc, "exact?", g_is_exact, 1, 0, false, H_is_exact);
- s7_define_function(sc, "inexact?", g_is_inexact, 1, 0, false, H_is_inexact);
-
- rng_tag = s7_new_type_x("<random-number-generator>", print_rng, free_rng, equal_rng, NULL, NULL, NULL, NULL, copy_random_state, NULL);
-
- s7_define_function(sc, "number?", g_is_number, 1, 0, false, H_is_number);
- s7_define_function(sc, "integer?", g_is_integer, 1, 0, false, H_is_integer);
- s7_define_function(sc, "real?", g_is_real, 1, 0, false, H_is_real);
- s7_define_function(sc, "complex?", g_is_complex, 1, 0, false, H_is_complex);
- s7_define_function(sc, "rational?", g_is_rational, 1, 0, false, H_is_rational);
-
- s7_define_function(sc, "number->string", g_number_to_string, 1, 1, false, H_number_to_string);
- s7_define_function(sc, "string->number", g_string_to_number, 1, 1, false, H_string_to_number);
+ sc->COMPLEX = defun("complex", complex, 2, 0, false);
+ sc->MAGNITUDE = defun("magnitude", magnitude, 1, 0, false);
+ sc->ANGLE = defun("angle", angle, 1, 0, false);
+ sc->RATIONALIZE = defun("rationalize", rationalize, 1, 1, false);
+ sc->ABS = defun("abs", abs, 1, 0, false);
+ sc->EXP = defun("exp", exp, 1, 0, false);
+ sc->LOG = defun("log", log, 1, 1, false);
+ sc->SIN = defun("sin", sin, 1, 0, false);
+ sc->COS = defun("cos", cos, 1, 0, false);
+ sc->TAN = defun("tan", tan, 1, 0, false);
+ sc->ASIN = defun("asin", asin, 1, 0, false);
+ sc->ACOS = defun("acos", acos, 1, 0, false);
+ sc->ATAN = defun("atan", atan, 1, 1, false);
+ sc->SINH = defun("sinh", sinh, 1, 0, false);
+ sc->COSH = defun("cosh", cosh, 1, 0, false);
+ sc->TANH = defun("tanh", tanh, 1, 0, false);
+ sc->ASINH = defun("asinh", asinh, 1, 0, false);
+ sc->ACOSH = defun("acosh", acosh, 1, 0, false);
+ sc->ATANH = defun("atanh", atanh, 1, 0, false);
+ sc->SQRT = defun("sqrt", sqrt, 1, 0, false);
+ sc->EXPT = defun("expt", expt, 2, 0, false);
+ sc->FLOOR = defun("floor", floor, 1, 0, false);
+ sc->CEILING = defun("ceiling", ceiling, 1, 0, false);
+ sc->TRUNCATE = defun("truncate", truncate, 1, 0, false);
+ sc->ROUND = defun("round", round, 1, 0, false);
+ sc->LCM = defun("lcm", lcm, 0, 0, true);
+ sc->GCD = defun("gcd", gcd, 0, 0, true);
+ sc->ADD = defun("+", add, 0, 0, true);
+ sc->SUBTRACT = defun("-", subtract, 1, 0, true);
+ sc->MULTIPLY = defun("*", multiply, 0, 0, true);
+ sc->DIVIDE = defun("/", divide, 1, 0, true);
+ sc->MAX = defun("max", max, 1, 0, true);
+ sc->MIN = defun("min", min, 1, 0, true);
+ sc->QUOTIENT = defun("quotient", quotient, 2, 0, false);
+ sc->REMAINDER = defun("remainder", remainder, 2, 0, false);
+ sc->MODULO = defun("modulo", modulo, 2, 0, false);
+ sc->EQ = defun("=", equal, 2, 0, true);
+ sc->LT = defun("<", less, 2, 0, true);
+ sc->GT = defun(">", greater, 2, 0, true);
+ sc->LEQ = defun("<=", less_or_equal, 2, 0, true);
+ sc->GEQ = defun(">=", greater_or_equal, 2, 0, true);
+ sc->LOGIOR = defun("logior", logior, 0, 0, true);
+ sc->LOGXOR = defun("logxor", logxor, 0, 0, true);
+ sc->LOGAND = defun("logand", logand, 0, 0, true);
+ sc->LOGNOT = defun("lognot", lognot, 1, 0, false);
+ sc->ASH = defun("ash", ash, 2, 0, false);
+ sc->RANDOM_STATE = defun("random-state", random_state, 1, 1, false);
+ sc->RANDOM = defun("random", random, 1, 1, false);
+#if (!WITH_PURE_S7)
+ sc->INEXACT_TO_EXACT = defun("inexact->exact", inexact_to_exact, 1, 0, false);
+ sc->EXACT_TO_INEXACT = defun("exact->inexact", exact_to_inexact, 1, 0, false);
+ sc->INTEGER_LENGTH = defun("integer-length", integer_length, 1, 0, false);
+ sc->MAKE_POLAR = defun("make-polar", make_polar, 2, 0, false);
+ sc->MAKE_RECTANGULAR = defun("make-rectangular", complex, 2, 0, false);
+#endif
+#endif /* !gmp */
-
- s7_define_function(sc, "char-upcase", g_char_upcase, 1, 0, false, H_char_upcase);
- s7_define_function(sc, "char-downcase", g_char_downcase, 1, 0, false, H_char_downcase);
- s7_define_function(sc, "char->integer", g_char_to_integer, 1, 0, false, H_char_to_integer);
- s7_define_function(sc, "integer->char", g_integer_to_char, 1, 0, false, H_integer_to_char);
-
- s7_define_function(sc, "char-upper-case?", g_is_char_upper_case, 1, 0, false, H_is_char_upper_case);
- s7_define_function(sc, "char-lower-case?", g_is_char_lower_case, 1, 0, false, H_is_char_lower_case);
- s7_define_function(sc, "char-alphabetic?", g_is_char_alphabetic, 1, 0, false, H_is_char_alphabetic);
- s7_define_function(sc, "char-numeric?", g_is_char_numeric, 1, 0, false, H_is_char_numeric);
- s7_define_function(sc, "char-whitespace?", g_is_char_whitespace, 1, 0, false, H_is_char_whitespace);
- s7_define_function(sc, "char?", g_is_char, 1, 0, false, H_is_char);
-
- s7_define_function(sc, "char=?", g_chars_are_equal, 2, 0, true, H_chars_are_equal);
- s7_define_function(sc, "char<?", g_chars_are_less, 2, 0, true, H_chars_are_less);
- s7_define_function(sc, "char>?", g_chars_are_greater, 2, 0, true, H_chars_are_greater);
- s7_define_function(sc, "char<=?", g_chars_are_leq, 2, 0, true, H_chars_are_leq);
- s7_define_function(sc, "char>=?", g_chars_are_geq, 2, 0, true, H_chars_are_geq);
- s7_define_function(sc, "char-ci=?", g_chars_are_ci_equal, 2, 0, true, H_chars_are_ci_equal);
- s7_define_function(sc, "char-ci<?", g_chars_are_ci_less, 2, 0, true, H_chars_are_ci_less);
- s7_define_function(sc, "char-ci>?", g_chars_are_ci_greater, 2, 0, true, H_chars_are_ci_greater);
- s7_define_function(sc, "char-ci<=?", g_chars_are_ci_leq, 2, 0, true, H_chars_are_ci_leq);
- s7_define_function(sc, "char-ci>=?", g_chars_are_ci_geq, 2, 0, true, H_chars_are_ci_geq);
-
-
- s7_define_function(sc, "string?", g_is_string, 1, 0, false, H_is_string);
- s7_define_function(sc, "make-string", g_make_string, 1, 1, false, H_make_string);
- s7_define_function(sc, "string-length", g_string_length, 1, 0, false, H_string_length);
- s7_define_function(sc, "string-ref", g_string_ref, 2, 0, false, H_string_ref);
- s7_define_function(sc, "string-set!", g_string_set, 3, 0, false, H_string_set);
- s7_define_function(sc, "string=?", g_strings_are_equal, 2, 0, true, H_strings_are_equal);
- s7_define_function(sc, "string<?", g_strings_are_less, 2, 0, true, H_strings_are_less);
- s7_define_function(sc, "string>?", g_strings_are_greater, 2, 0, true, H_strings_are_greater);
- s7_define_function(sc, "string<=?", g_strings_are_leq, 2, 0, true, H_strings_are_leq);
- s7_define_function(sc, "string>=?", g_strings_are_geq, 2, 0, true, H_strings_are_geq);
- s7_define_function(sc, "string-ci=?", g_strings_are_ci_equal, 2, 0, true, H_strings_are_ci_equal);
- s7_define_function(sc, "string-ci<?", g_strings_are_ci_less, 2, 0, true, H_strings_are_ci_less);
- s7_define_function(sc, "string-ci>?", g_strings_are_ci_greater, 2, 0, true, H_strings_are_ci_greater);
- s7_define_function(sc, "string-ci<=?", g_strings_are_ci_leq, 2, 0, true, H_strings_are_ci_leq);
- s7_define_function(sc, "string-ci>=?", g_strings_are_ci_geq, 2, 0, true, H_strings_are_ci_geq);
-
- s7_define_function(sc, "string-append", g_string_append, 0, 0, true, H_string_append);
- s7_define_function(sc, "string-fill!", g_string_fill, 2, 0, false, H_string_fill);
- s7_define_function(sc, "string-copy", g_string_copy, 1, 0, false, H_string_copy);
- s7_define_function(sc, "substring", g_substring, 2, 1, false, H_substring);
- s7_define_function(sc, "string", g_string, 0, 0, true, H_string);
- s7_define_function(sc, "list->string", g_list_to_string, 1, 0, false, H_list_to_string);
- s7_define_function(sc, "string->list", g_string_to_list, 1, 0, false, H_string_to_list);
- s7_define_function(sc, "object->string", g_object_to_string, 1, 1, false, H_object_to_string);
- s7_define_function(sc, "format", g_format, 1, 0, true, H_format);
-
-
- s7_define_function(sc, "null?", g_is_null, 1, 0, false, H_is_null);
- s7_define_function(sc, "list?", g_is_list, 1, 0, false, H_is_list);
- s7_define_function(sc, "pair?", g_is_pair, 1, 0, false, H_is_pair);
- s7_define_function(sc, "cons", g_cons, 2, 0, false, H_cons);
- s7_define_function(sc, "car", g_car, 1, 0, false, H_car);
- s7_define_function(sc, "cdr", g_cdr, 1, 0, false, H_cdr);
- s7_define_function(sc, "set-car!", g_set_car, 2, 0, false, H_set_car);
- s7_define_function(sc, "set-cdr!", g_set_cdr, 2, 0, false, H_set_cdr);
- s7_define_function(sc, "caar", g_caar, 1, 0, false, H_caar);
- s7_define_function(sc, "cadr", g_cadr, 1, 0, false, H_cadr);
- s7_define_function(sc, "cdar", g_cdar, 1, 0, false, H_cdar);
- s7_define_function(sc, "cddr", g_cddr, 1, 0, false, H_cddr);
- s7_define_function(sc, "caaar", g_caaar, 1, 0, false, H_caaar);
- s7_define_function(sc, "caadr", g_caadr, 1, 0, false, H_caadr);
- s7_define_function(sc, "cadar", g_cadar, 1, 0, false, H_cadar);
- s7_define_function(sc, "cdaar", g_cdaar, 1, 0, false, H_cdaar);
- s7_define_function(sc, "caddr", g_caddr, 1, 0, false, H_caddr);
- s7_define_function(sc, "cdddr", g_cdddr, 1, 0, false, H_cdddr);
- s7_define_function(sc, "cdadr", g_cdadr, 1, 0, false, H_cdadr);
- s7_define_function(sc, "cddar", g_cddar, 1, 0, false, H_cddar);
- s7_define_function(sc, "caaaar", g_caaaar, 1, 0, false, H_caaaar);
- s7_define_function(sc, "caaadr", g_caaadr, 1, 0, false, H_caaadr);
- s7_define_function(sc, "caadar", g_caadar, 1, 0, false, H_caadar);
- s7_define_function(sc, "cadaar", g_cadaar, 1, 0, false, H_cadaar);
- s7_define_function(sc, "caaddr", g_caaddr, 1, 0, false, H_caaddr);
- s7_define_function(sc, "cadddr", g_cadddr, 1, 0, false, H_cadddr);
- s7_define_function(sc, "cadadr", g_cadadr, 1, 0, false, H_cadadr);
- s7_define_function(sc, "caddar", g_caddar, 1, 0, false, H_caddar);
- s7_define_function(sc, "cdaaar", g_cdaaar, 1, 0, false, H_cdaaar);
- s7_define_function(sc, "cdaadr", g_cdaadr, 1, 0, false, H_cdaadr);
- s7_define_function(sc, "cdadar", g_cdadar, 1, 0, false, H_cdadar);
- s7_define_function(sc, "cddaar", g_cddaar, 1, 0, false, H_cddaar);
- s7_define_function(sc, "cdaddr", g_cdaddr, 1, 0, false, H_cdaddr);
- s7_define_function(sc, "cddddr", g_cddddr, 1, 0, false, H_cddddr);
- s7_define_function(sc, "cddadr", g_cddadr, 1, 0, false, H_cddadr);
- s7_define_function(sc, "cdddar", g_cdddar, 1, 0, false, H_cdddar);
- s7_define_function(sc, "assq", g_assq, 2, 0, false, H_assq);
- s7_define_function(sc, "assv", g_assv, 2, 0, false, H_assv);
- s7_define_function(sc, "assoc", g_assoc, 2, 1, false, H_assoc);
- s7_define_function(sc, "memq", g_memq, 2, 0, false, H_memq);
- s7_define_function(sc, "memv", g_memv, 2, 0, false, H_memv);
- s7_define_function(sc, "member", g_member, 2, 1, false, H_member);
- s7_define_function(sc, "append", g_append, 0, 0, true, H_append);
- s7_define_function(sc, "list", g_list, 0, 0, true, H_list);
- s7_define_function(sc, "list-ref", g_list_ref, 2, 0, true, H_list_ref);
- s7_define_function(sc, "list-set!", g_list_set, 3, 0, true, H_list_set);
- s7_define_function(sc, "list-tail", g_list_tail, 2, 0, false, H_list_tail);
- /* perhaps with setter? */
- s7_define_function(sc, "make-list", g_make_list, 1, 1, false, H_make_list);
-
- s7_define_function(sc, "length", g_length, 1, 0, false, H_length);
- s7_define_function(sc, "copy", g_copy, 1, 0, false, H_copy);
- s7_define_function(sc, "fill!", g_fill, 2, 0, false, H_fill);
- s7_define_function(sc, "reverse", g_reverse, 1, 0, false, H_reverse);
- s7_define_function(sc, "reverse!", g_reverse_in_place, 1, 0, false, H_reverse_in_place); /* used by Snd code */
-
+ sc->LOGBIT = defun("logbit?", logbit, 2, 0, false);
+ sc->INTEGER_DECODE_FLOAT = defun("integer-decode-float", integer_decode_float, 1, 0, false);
+#if (!WITH_PURE_S7)
+ sc->IS_EXACT = defun("exact?", is_exact, 1, 0, false);
+ sc->IS_INEXACT = defun("inexact?", is_inexact, 1, 0, false);
+#endif
+ sc->RANDOM_STATE_TO_LIST = defun("random-state->list", random_state_to_list, 0, 1, false);
+
+ sc->NUMBER_TO_STRING = defun("number->string", number_to_string, 1, 1, false);
+ sc->STRING_TO_NUMBER = defun("string->number", string_to_number, 1, 1, false);
+
+ sc->CHAR_UPCASE = defun("char-upcase", char_upcase, 1, 0, false);
+ sc->CHAR_DOWNCASE = defun("char-downcase", char_downcase, 1, 0, false);
+ sc->CHAR_TO_INTEGER = defun("char->integer", char_to_integer, 1, 0, false);
+ sc->INTEGER_TO_CHAR = defun("integer->char", integer_to_char, 1, 0, false);
+
+ sc->IS_CHAR_UPPER_CASE = defun("char-upper-case?", is_char_upper_case, 1, 0, false);
+ sc->IS_CHAR_LOWER_CASE = defun("char-lower-case?", is_char_lower_case, 1, 0, false);
+ sc->IS_CHAR_ALPHABETIC = defun("char-alphabetic?", is_char_alphabetic, 1, 0, false);
+ sc->IS_CHAR_NUMERIC = defun("char-numeric?", is_char_numeric, 1, 0, false);
+ sc->IS_CHAR_WHITESPACE = defun("char-whitespace?", is_char_whitespace, 1, 0, false);
+
+ sc->CHAR_EQ = defun("char=?", chars_are_equal, 2, 0, true);
+ sc->CHAR_LT = defun("char<?", chars_are_less, 2, 0, true);
+ sc->CHAR_GT = defun("char>?", chars_are_greater, 2, 0, true);
+ sc->CHAR_LEQ = defun("char<=?", chars_are_leq, 2, 0, true);
+ sc->CHAR_GEQ = defun("char>=?", chars_are_geq, 2, 0, true);
+ sc->CHAR_POSITION = defun("char-position", char_position, 2, 1, false);
+ sc->STRING_POSITION = defun("string-position", string_position, 2, 1, false);
+
+ sc->MAKE_STRING = defun("make-string", make_string, 1, 1, false);
+ sc->STRING_REF = defun("string-ref", string_ref, 2, 0, false);
+ sc->STRING_SET = defun("string-set!", string_set, 3, 0, false);
+ sc->STRING_EQ = defun("string=?", strings_are_equal, 2, 0, true);
+ sc->STRING_LT = defun("string<?", strings_are_less, 2, 0, true);
+ sc->STRING_GT = defun("string>?", strings_are_greater, 2, 0, true);
+ sc->STRING_LEQ = defun("string<=?", strings_are_leq, 2, 0, true);
+ sc->STRING_GEQ = defun("string>=?", strings_are_geq, 2, 0, true);
+
+#if (!WITH_PURE_S7)
+ sc->CHAR_CI_EQ = defun("char-ci=?", chars_are_ci_equal, 2, 0, true);
+ sc->CHAR_CI_LT = defun("char-ci<?", chars_are_ci_less, 2, 0, true);
+ sc->CHAR_CI_GT = defun("char-ci>?", chars_are_ci_greater, 2, 0, true);
+ sc->CHAR_CI_LEQ = defun("char-ci<=?", chars_are_ci_leq, 2, 0, true);
+ sc->CHAR_CI_GEQ = defun("char-ci>=?", chars_are_ci_geq, 2, 0, true);
+ sc->STRING_CI_EQ = defun("string-ci=?", strings_are_ci_equal, 2, 0, true);
+ sc->STRING_CI_LT = defun("string-ci<?", strings_are_ci_less, 2, 0, true);
+ sc->STRING_CI_GT = defun("string-ci>?", strings_are_ci_greater, 2, 0, true);
+ sc->STRING_CI_LEQ = defun("string-ci<=?", strings_are_ci_leq, 2, 0, true);
+ sc->STRING_CI_GEQ = defun("string-ci>=?", strings_are_ci_geq, 2, 0, true);
+ sc->STRING_COPY = defun("string-copy", string_copy, 1, 0, false);
+ sc->STRING_FILL = defun("string-fill!", string_fill, 2, 2, false);
+ sc->LIST_TO_STRING = defun("list->string", list_to_string, 1, 0, false);
+ sc->STRING_LENGTH = defun("string-length", string_length, 1, 0, false);
+ sc->STRING_TO_LIST = defun("string->list", string_to_list, 1, 2, false);
+#endif
- s7_define_function(sc, "vector?", g_is_vector, 1, 0, false, H_is_vector);
- s7_define_function(sc, "vector->list", g_vector_to_list, 1, 0, false, H_vector_to_list);
- s7_define_function(sc, "list->vector", g_list_to_vector, 1, 0, false, H_list_to_vector);
- s7_define_function(sc, "vector-fill!", g_vector_fill, 2, 0, false, H_vector_fill);
- s7_define_function(sc, "vector", g_vector, 0, 0, true, H_vector);
- s7_define_function(sc, "vector-length", g_vector_length, 1, 0, false, H_vector_length);
- s7_define_function(sc, "vector-ref", g_vector_ref, 2, 0, true, H_vector_ref);
- s7_define_function(sc, "vector-set!", g_vector_set, 3, 0, true, H_vector_set);
- s7_define_function(sc, "make-vector", g_make_vector, 1, 1, false, H_make_vector);
- s7_define_function(sc, "vector-dimensions", g_vector_dimensions, 1, 0, false, H_vector_dimensions);
- s7_define_function(sc, "sort!", g_sort, 2, 0, false, H_sort);
-
-
- s7_define_function(sc, "hash-table", g_hash_table, 0, 0, true, H_hash_table);
- s7_define_function(sc, "hash-table?", g_is_hash_table, 1, 0, false, H_is_hash_table);
- s7_define_function(sc, "make-hash-table", g_make_hash_table, 0, 1, false, H_make_hash_table);
- s7_define_function(sc, "hash-table-ref", g_hash_table_ref, 2, 0, true, H_hash_table_ref);
- s7_define_function(sc, "hash-table-set!", g_hash_table_set, 3, 0, false, H_hash_table_set);
- s7_define_function(sc, "hash-table-size", g_hash_table_size, 1, 0, false, H_hash_table_size);
- s7_define_function(sc, "make-hash-table-iterator", g_make_hash_table_iterator, 1, 0, false, H_make_hash_table_iterator);
-
-
- s7_define_function(sc, "hook?", g_is_hook, 1, 0, false, H_is_hook);
- s7_define_function(sc, "make-hook", g_make_hook, 0, 2, false, H_make_hook);
- s7_define_function(sc, "hook", g_hook, 0, 0, true, H_hook);
- s7_define_function(sc, "hook-apply", g_hook_apply, 1, 0, true, H_hook_apply);
- s7_define_function(sc, "hook-arity", g_hook_arity, 1, 0, false, H_hook_arity);
- s7_define_function(sc, "hook-documentation", g_hook_documentation, 1, 0, false, H_hook_documentation);
- s7_define_variable(sc, "hook-functions",
- s7_make_procedure_with_setter(sc, "hook-functions", g_hook_functions, 1, 0, g_hook_set_functions, 2, 0, H_hook_functions));
-
-
- s7_define_function(sc, "call/cc", g_call_cc, 1, 0, false, H_call_cc);
- s7_define_function(sc, "call-with-current-continuation", g_call_cc, 1, 0, false, H_call_cc);
- s7_define_function(sc, "call-with-exit", g_call_with_exit, 1, 0, false, H_call_with_exit);
- s7_define_function(sc, "continuation?", g_is_continuation, 1, 0, false, H_is_continuation);
-
- s7_define_function(sc, "load", g_load, 1, 1, false, H_load);
- s7_define_function(sc, "eval", g_eval, 1, 1, false, H_eval);
- s7_define_function(sc, "eval-string", g_eval_string, 1, 1, false, H_eval_string);
- s7_define_function(sc, "apply", g_apply, 1, 0, true, H_apply);
- s7_define_function(sc, "for-each", g_for_each, 2, 0, true, H_for_each);
- s7_define_function(sc, "map", g_map, 2, 0, true, H_map);
-
- s7_define_function(sc, "values", g_values, 0, 0, true, H_values);
- s7_define_function(sc, "dynamic-wind", g_dynamic_wind, 3, 0, false, H_dynamic_wind);
- s7_define_function(sc, "catch", g_catch, 3, 0, false, H_catch);
- s7_define_function(sc, "error", g_error, 0, 0, true, H_error);
-
- /* these are internal for quasiquote's use */
- s7_define_constant_function(sc, "{values}", g_qq_values, 0, 0, true, H_qq_values);
- s7_define_constant_function(sc, "{apply}", g_apply, 1, 0, true, H_apply);
- s7_define_constant_function(sc, "{append}", g_append, 0, 0, true, H_append);
- s7_define_constant_function(sc, "{multivector}", g_qq_multivector, 1, 0, true, H_qq_multivector);
-
- s7_define_constant_function(sc, "{list}", g_qq_list, 0, 0, true, H_qq_list);
- {
- s7_pointer p;
- p = s7_symbol_value(sc, make_symbol(sc, "{list}"));
- set_type(p, (T_C_LST_ARGS_FUNCTION | T_SIMPLE | T_DONT_COPY | T_PROCEDURE | T_DONT_COPY_CDR));
+ sc->STRING_DOWNCASE = defun("string-downcase", string_downcase, 1, 0, false);
+ sc->STRING_UPCASE = defun("string-upcase", string_upcase, 1, 0, false);
+ sc->STRING_APPEND = defun("string-append", string_append, 0, 0, true);
+ sc->SUBSTRING = defun("substring", substring, 2, 1, false);
+ sc->STRING = defun("string", string, 0, 0, true);
+ sc->OBJECT_TO_STRING = defun("object->string", object_to_string, 1, 1, false);
+ sc->FORMAT = defun("format", format, 1, 0, true);
+ /* this was unsafe, but was that due to the (ill-advised) use of temp_call_2 in the arg lists? */
+
+ sc->CONS = defun("cons", cons, 2, 0, false);
+ sc->CAR = defun("car", car, 1, 0, false);
+ sc->CDR = defun("cdr", cdr, 1, 0, false);
+ sc->SET_CAR = defun("set-car!", set_car, 2, 0, false);
+ sc->SET_CDR = unsafe_defun("set-cdr!", set_cdr, 2, 0, false);
+ sc->CAAR = defun("caar", caar, 1, 0, false);
+ sc->CADR = defun("cadr", cadr, 1, 0, false);
+ sc->CDAR = defun("cdar", cdar, 1, 0, false);
+ sc->CDDR = defun("cddr", cddr, 1, 0, false);
+ sc->CAAAR = defun("caaar", caaar, 1, 0, false);
+ sc->CAADR = defun("caadr", caadr, 1, 0, false);
+ sc->CADAR = defun("cadar", cadar, 1, 0, false);
+ sc->CDAAR = defun("cdaar", cdaar, 1, 0, false);
+ sc->CADDR = defun("caddr", caddr, 1, 0, false);
+ sc->CDDDR = defun("cdddr", cdddr, 1, 0, false);
+ sc->CDADR = defun("cdadr", cdadr, 1, 0, false);
+ sc->CDDAR = defun("cddar", cddar, 1, 0, false);
+ sc->CAAAAR = defun("caaaar", caaaar, 1, 0, false);
+ sc->CAAADR = defun("caaadr", caaadr, 1, 0, false);
+ sc->CAADAR = defun("caadar", caadar, 1, 0, false);
+ sc->CADAAR = defun("cadaar", cadaar, 1, 0, false);
+ sc->CAADDR = defun("caaddr", caaddr, 1, 0, false);
+ sc->CADDDR = defun("cadddr", cadddr, 1, 0, false);
+ sc->CADADR = defun("cadadr", cadadr, 1, 0, false);
+ sc->CADDAR = defun("caddar", caddar, 1, 0, false);
+ sc->CDAAAR = defun("cdaaar", cdaaar, 1, 0, false);
+ sc->CDAADR = defun("cdaadr", cdaadr, 1, 0, false);
+ sc->CDADAR = defun("cdadar", cdadar, 1, 0, false);
+ sc->CDDAAR = defun("cddaar", cddaar, 1, 0, false);
+ sc->CDADDR = defun("cdaddr", cdaddr, 1, 0, false);
+ sc->CDDDDR = defun("cddddr", cddddr, 1, 0, false);
+ sc->CDDADR = defun("cddadr", cddadr, 1, 0, false);
+ sc->CDDDAR = defun("cdddar", cdddar, 1, 0, false);
+
+ sc->ASSOC = unsafe_defun("assoc", assoc, 2, 1, false);
+ set_is_possibly_safe(slot_value(global_slot(sc->ASSOC)));
+ sc->MEMBER = unsafe_defun("member", member, 2, 1, false);
+ set_is_possibly_safe(slot_value(global_slot(sc->MEMBER)));
+
+ sc->LIST = defun("list", list, 0, 0, true);
+ sc->LIST_REF = defun("list-ref", list_ref, 2, 0, true);
+ sc->LIST_SET = defun("list-set!", list_set, 3, 0, true);
+ sc->LIST_TAIL = defun("list-tail", list_tail, 2, 0, false);
+ sc->MAKE_LIST = defun("make-list", make_list, 1, 1, false);
+
+ sc->LENGTH = defun("length", length, 1, 0, false);
+ sc->COPY = defun("copy", copy, 1, 3, false);
+ sc->FILL = defun("fill!", fill, 2, 2, false);
+ sc->REVERSE = defun("reverse", reverse, 1, 0, false);
+ sc->REVERSEB = defun("reverse!", reverse_in_place, 1, 0, false);
+ sc->SORT = unsafe_defun("sort!", sort, 2, 0, false);
+ sc->APPEND = defun("append", append, 0, 0, true);
+
+#if (!WITH_PURE_S7)
+ sc->ASSQ = defun("assq", assq, 2, 0, false);
+ sc->ASSV = defun("assv", assv, 2, 0, false);
+ sc->MEMQ = defun("memq", memq, 2, 0, false);
+ sc->MEMV = defun("memv", memv, 2, 0, false);
+ sc->VECTOR_APPEND = defun("vector-append", vector_append, 0, 0, true);
+ sc->LIST_TO_VECTOR = defun("list->vector", list_to_vector, 1, 0, false);
+ sc->VECTOR_FILL = defun("vector-fill!", vector_fill, 2, 2, false);
+ sc->VECTOR_LENGTH = defun("vector-length", vector_length, 1, 0, false);
+ sc->VECTOR_TO_LIST = defun("vector->list", vector_to_list, 1, 2, false);
+#else
+ sc->VECTOR_APPEND = sc->APPEND;
+ sc->VECTOR_FILL = sc->FILL;
+ sc->STRING_FILL = sc->FILL;
+#endif
+ sc->VECTOR_REF = defun("vector-ref", vector_ref, 2, 0, true);
+ sc->VECTOR_SET = defun("vector-set!", vector_set, 3, 0, true);
+ sc->VECTOR_DIMENSIONS = defun("vector-dimensions", vector_dimensions, 1, 0, false);
+ sc->MAKE_VECTOR = defun("make-vector", make_vector, 1, 2, false);
+ sc->MAKE_SHARED_VECTOR = defun("make-shared-vector", make_shared_vector, 2, 1, false);
+ sc->VECTOR = defun("vector", vector, 0, 0, true);
+ set_setter(sc->VECTOR); /* like cons, I guess */
+ sc->Vector = slot_value(global_slot(sc->VECTOR));
+
+ sc->FLOAT_VECTOR = defun("float-vector", float_vector, 0, 0, true);
+ sc->MAKE_FLOAT_VECTOR = defun("make-float-vector", make_float_vector, 1, 1, false);
+ sc->FLOAT_VECTOR_SET = defun("float-vector-set!", float_vector_set, 3, 0, true);
+ sc->FLOAT_VECTOR_REF = defun("float-vector-ref", float_vector_ref, 2, 0, true);
+
+ sc->INT_VECTOR = defun("int-vector", int_vector, 0, 0, true);
+ sc->MAKE_INT_VECTOR = defun("make-int-vector", make_int_vector, 1, 1, false);
+ sc->INT_VECTOR_SET = defun("int-vector-set!", int_vector_set, 3, 0, true);
+ sc->INT_VECTOR_REF = defun("int-vector-ref", int_vector_ref, 2, 0, true);
+
+ sc->TO_BYTE_VECTOR = defun("->byte-vector", to_byte_vector, 1, 0, false);
+ sc->BYTE_VECTOR = defun("byte-vector", byte_vector, 0, 0, true);
+ sc->MAKE_BYTE_VECTOR = defun("make-byte-vector", make_byte_vector, 1, 1, false);
+
+ sc->HASH_TABLE = defun("hash-table", hash_table, 0, 0, true);
+ sc->HASH_TABLE_STAR = defun("hash-table*", hash_table_star, 0, 0, true);
+ sc->MAKE_HASH_TABLE = defun("make-hash-table", make_hash_table, 0, 2, false);
+ sc->HASH_TABLE_REF = defun("hash-table-ref", hash_table_ref, 2, 0, true);
+ sc->HASH_TABLE_SET = defun("hash-table-set!", hash_table_set, 3, 0, false);
+ sc->HASH_TABLE_ENTRIES = defun("hash-table-entries", hash_table_entries, 1, 0, false);
+
+ defun("cyclic-sequences", cyclic_sequences, 1, 0, false);
+ sc->CALL_CC = unsafe_defun("call/cc", call_cc, 1, 0, false);
+ sc->CALL_WITH_CURRENT_CONTINUATION = unsafe_defun("call-with-current-continuation", call_cc, 1, 0, false);
+ sc->CALL_WITH_EXIT = unsafe_defun("call-with-exit", call_with_exit, 1, 0, false);
+
+ sc->LOAD = unsafe_defun("load", load, 1, 1, false);
+ sc->AUTOLOAD = unsafe_defun("autoload", autoload, 2, 0, false);
+ sc->EVAL = unsafe_defun("eval", eval, 1, 1, false);
+ sc->EVAL_STRING = unsafe_defun("eval-string", eval_string, 1, 1, false);
+ sc->APPLY = unsafe_defun("apply", apply, 1, 0, true);
+ sc->Apply = slot_value(global_slot(sc->APPLY));
+ set_type(sc->Apply, type(sc->Apply) | T_COPY_ARGS | T_PROCEDURE);
+ /* (let ((x '((1 2) 3 4))) (catch #t (lambda () (apply apply apply x)) (lambda args 'error)) x) should not mess up x! */
+
+ sc->FOR_EACH = unsafe_defun("for-each", for_each, 2, 0, true);
+ sc->MAP = unsafe_defun("map", map, 2, 0, true);
+ sc->DYNAMIC_WIND = unsafe_defun("dynamic-wind", dynamic_wind, 3, 0, false);
+ /* sc->VALUES = */ unsafe_defun("values", values, 0, 0, true);
+ sc->CATCH = unsafe_defun("catch", catch, 3, 0, false);
+ sc->THROW = unsafe_defun("throw", throw, 1, 0, true);
+ sc->ERROR = unsafe_defun("error", error, 0, 0, true);
+ /* it's faster to leave error/throw unsafe than to set needs_copied_args and use s7_define_safe_function because copy_list overwhelms any other savings */
+ sc->STACKTRACE = defun("stacktrace", stacktrace, 0, 5, false);
+
+ { /* these are internal for quasiquote's use */
+ s7_pointer sym;
+ sym = unsafe_defun("{apply_values}", apply_values, 0, 0, true);
+ set_immutable(sym);
+ sc->QQ_Apply_Values = slot_value(global_slot(sym));
+
+ sym = unsafe_defun("{append}", append, 0, 0, true);
+ set_immutable(sym);
+ sc->QQ_Append = slot_value(global_slot(sym));
+
+ sym = unsafe_defun("{multivector}", qq_multivector, 1, 0, true);
+ set_immutable(sym);
+ sc->Multivector = slot_value(global_slot(sym));
+
+ sym = unsafe_defun("{list}", qq_list, 0, 0, true);
+ set_immutable(sym);
+ sc->QQ_List = slot_value(global_slot(sym));
+ set_type(sc->QQ_List, T_C_RST_ARGS_FUNCTION | T_PROCEDURE | T_COPY_ARGS);
}
-
- s7_define_function(sc, "stacktrace", g_stacktrace, 0, 2, false, H_stacktrace);
- s7_define_function(sc, "trace", g_trace, 0, 0, true, H_trace);
- s7_define_function(sc, "untrace", g_untrace, 0, 0, true, H_untrace);
- s7_define_function(sc, "gc", g_gc, 0, 1, false, H_gc);
-
- s7_define_function(sc, "procedure?", g_is_procedure, 1, 0, false, H_is_procedure);
- s7_define_function(sc, "procedure-documentation", g_procedure_documentation, 1, 0, false, H_procedure_documentation);
- s7_define_function(sc, "help", g_help, 1, 0, false, H_help);
- s7_define_function(sc, "procedure-arity", g_procedure_arity, 1, 0, false, H_procedure_arity);
- s7_define_function(sc, "procedure-source", g_procedure_source, 1, 0, false, H_procedure_source);
- s7_define_function(sc, "procedure-environment", g_procedure_environment, 1, 0, false, H_procedure_environment);
-
- s7_define_function(sc, "not", g_not, 1, 0, false, H_not);
- s7_define_function(sc, "boolean?", g_is_boolean, 1, 0, false, H_is_boolean);
- s7_define_function(sc, "eq?", g_is_eq, 2, 0, false, H_is_eq);
- s7_define_function(sc, "eqv?", g_is_eqv, 2, 0, false, H_is_eqv);
- s7_define_function(sc, "equal?", g_is_equal, 2, 0, false, H_is_equal);
-
- s7_define_function(sc, "s7-version", g_s7_version, 0, 0, false, H_s7_version);
-
- #define object_set_name "(generalized set!)"
- s7_define_function(sc, object_set_name, g_object_set, 1, 0, true, "internal object setter redirection");
- sc->OBJECT_SET = s7_symbol_value(sc, make_symbol(sc, object_set_name));
- typeflag(sc->OBJECT_SET) |= T_DONT_COPY;
-
- s7_define_function(sc, s_is_type_name, s_is_type, 2, 0, false, "internal object type check");
- s7_define_function(sc, s_type_make_name, s_type_make, 2, 0, false, "internal object creation");
- s7_define_function(sc, s_type_ref_name, s_type_ref, 2, 0, false, "internal object value");
- s7_define_function_star(sc, "make-type", g_make_type, "print equal getter setter length name copy fill", H_make_type);
-
-
- s7_define_variable(sc, "*gc-stats*", sc->F);
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*gc-stats*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *gc-stats*)", g_gc_stats_set, 2, 0, false, "called if *gc-stats* is set"),
- s7_make_function(sc, "(bind *gc-stats*)", g_gc_stats_set, 2, 0, false, "called if *gc-stats* is bound")));
-
- s7_define_variable(sc, "*features*", sc->NIL);
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*features*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *features*)", g_features_set, 2, 0, false, "called if *features* is set"),
- s7_make_function(sc, "(bind *features*)", g_features_set, 2, 0, false, "called if *features* is bound")));
-
-
- /* these hook variables should use s7_define_constant, but we need to be backwards compatible */
-
- sc->load_hook = s7_make_hook(sc, 1, 0, false, "*load-hook* is called when a file is loaded. Its functions take one argument, the filename.");
- s7_define_variable(sc, "*load-hook*", sc->load_hook);
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*load-hook*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *load-hook*)", g_load_hook_set, 2, 0, false,
- "called if *load-hook* is set"),
- sc->F));
-
- sc->trace_hook = s7_make_hook(sc, 2, 0, false,
- "*trace-hook* customizes tracing. Its functions take 2 arguments, the function being traced, and its current arguments.");
- s7_define_variable(sc, "*trace-hook*", sc->trace_hook);
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*trace-hook*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *trace-hook*)", g_trace_hook_set, 2, 0, false,
- "called if *trace-hook* is set"),
- sc->F));
- sc->unbound_variable_hook = s7_make_hook(sc, 1, 0, false, "*unbound-variable-hook* is called when an unbound variable is encountered. Its functions \
-take 1 argument, the unbound symbol.");
- s7_define_variable(sc, "*unbound-variable-hook*", sc->unbound_variable_hook);
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*unbound-variable-hook*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *unbound-variable-hook*)", g_unbound_variable_hook_set, 2, 0, false,
- "called if *unbound-variable-hook* is set"),
- sc->F));
-
- sc->error_hook = s7_make_hook(sc, 2, 0, false, "*error-hook* is called when an error is not caught. Its functions take two arguments, \
-the error type and the info passed to the error handler.");
- s7_define_variable(sc, "*error-hook*", sc->error_hook);
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*error-hook*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *error-hook*)", g_error_hook_set, 2, 0, false,
- "called if *error-hook* is set"),
- sc->F));
-
-
- s7_define_variable(sc, "*vector-print-length*", small_ints[8]);
- sc->vector_print_length = symbol_global_slot(make_symbol(sc, "*vector-print-length*"));
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*vector-print-length*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *vector-print-length*)", g_vector_print_length_set, 2, 0, false,
- "called if *vector-print-length* is set"),
- sc->F));
-
- s7_define_variable(sc, "*safety*", small_int(sc->safety));
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*safety*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *safety*)", g_safety_set, 2, 0, false, "called if *safety* is set"),
- s7_make_function(sc, "(bind *safety*)", g_safety_bind, 2, 0, false, "called if *safety* is bound")));
-
-
- /* the next two are for the test suite */
- s7_define_variable(sc, "-s7-symbol-table-locked?",
- s7_make_procedure_with_setter(sc, "-s7-symbol-table-locked?",
- g_symbol_table_is_locked, 0, 0,
- g_set_symbol_table_is_locked, 1, 0,
- H_symbol_table_is_locked));
- s7_define_function(sc, "-s7-stack-size", g_stack_size, 0, 0, false, "current stack size");
-
-
- s7_define_variable(sc, "*load-path*", sc->NIL);
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*load-path*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *load-path*)", g_load_path_set, 2, 0, false, "called if *load-path* is set"),
- s7_make_function(sc, "(bind *load-path*)", g_load_path_set, 2, 0, false, "called if *load-path* is bound")));
-
- s7_define_variable(sc, "*#readers*", sc->NIL);
- sc->sharp_readers = symbol_global_slot(make_symbol(sc, "*#readers*"));
- s7_symbol_set_access(sc, s7_make_symbol(sc, "*#readers*"),
- make_list_3(sc,
- sc->F,
- s7_make_function(sc, "(set *#readers*)", g_sharp_readers_set, 2, 0, false, "called if *#readers* is set"),
- s7_make_function(sc, "(bind *#readers*)", g_sharp_readers_set, 2, 0, false, "called if *#readers* is bound")));
-
- sc->error_info = s7_make_and_fill_vector(sc, ERROR_INFO_SIZE, ERROR_INFO_DEFAULT);
- s7_define_constant(sc, "*error-info*", sc->error_info);
-
- g_provide(sc, make_list_1(sc, make_symbol(sc, "s7")));
-
-#if WITH_PROFILING
- g_provide(sc, make_list_1(sc, make_symbol(sc, "profiling")));
+ sc->PROCEDURE_DOCUMENTATION = defun("procedure-documentation", procedure_documentation, 1, 0, false);
+ sc->PROCEDURE_SIGNATURE = defun("procedure-signature", procedure_signature, 1, 0, false);
+ sc->HELP = defun("help", help, 1, 0, false);
+ sc->PROCEDURE_SOURCE = defun("procedure-source", procedure_source, 1, 0, false);
+ sc->FUNCLET = defun("funclet", funclet, 1, 0, false);
+ s7_typed_dilambda(sc, "procedure-setter", g_procedure_setter, 1, 0, g_procedure_set_setter, 2, 0, H_procedure_setter, Q_procedure_setter, NULL);
+
+ sc->ARITY = defun("arity", arity, 1, 0, false);
+ sc->IS_ARITABLE = defun("aritable?", is_aritable, 2, 0, false);
+
+ sc->NOT = defun("not", not, 1, 0, false);
+ sc->IS_EQ = defun("eq?", is_eq, 2, 0, false);
+ sc->IS_EQV = defun("eqv?", is_eqv, 2, 0, false);
+ sc->IS_EQUAL = defun("equal?", is_equal, 2, 0, false);
+ sc->IS_MORALLY_EQUAL = defun("morally-equal?", is_morally_equal, 2, 0, false);
+
+ sc->GC = defun("gc", gc, 0, 1, false);
+ defun("s7-version", s7_version, 0, 0, false);
+ defun("emergency-exit", emergency_exit, 0, 1, false);
+ defun("exit", exit, 0, 1, false);
+#if DEBUGGING
+ s7_define_function(sc, "abort", g_abort, 0, 0, false, "drop into gdb I hope");
#endif
-#if WITH_EXTRA_EXPONENT_MARKERS
- g_provide(sc, make_list_1(sc, make_symbol(sc, "dfls-exponents")));
-#endif
+ sym = s7_define_function(sc, "(c-object set)", g_internal_object_set, 1, 0, true, "internal object setter redirection");
+ sc->Object_Set = slot_value(global_slot(sym));
-#if HAVE_PTHREADS
- thread_tag = s7_new_type("<thread>", thread_print, thread_free, thread_equal, thread_mark, NULL, NULL);
- lock_tag = s7_new_type("<lock>", lock_print, lock_free, lock_equal, NULL, NULL, NULL);
- key_tag = s7_new_type("<thread-variable>", key_print, key_free, key_equal, NULL, get_key, set_key);
+ /* -------- *features* -------- */
+ sc->S7_FEATURES = s7_define_variable(sc, "*features*", sc->NIL);
+ s7_symbol_set_access(sc, sc->S7_FEATURES, s7_make_function(sc, "(set *features*)", g_features_set, 2, 0, false, "*features* accessor"));
- s7_define_function(sc, "make-thread", g_make_thread, 1, 1, false, H_make_thread);
- s7_define_function(sc, "join-thread", g_join_thread, 1, 0, false, H_join_thread);
- s7_define_function(sc, "thread?", g_is_thread, 1, 0, false, H_is_thread);
+ /* -------- *load-path* -------- */
+ sc->LOAD_PATH = s7_define_variable_with_documentation(sc, "*load-path*", sc->NIL, "*load-path* is a list of directories (strings) that the load function searches if it is passed an incomplete file name");
+ s7_symbol_set_access(sc, sc->LOAD_PATH, s7_make_function(sc, "(set *load-path*)", g_load_path_set, 2, 0, false, "*load-path* accessor"));
- s7_define_function(sc, "make-lock", g_make_lock, 0, 0, false, H_make_lock); /* "mutex" is ugly (and opaque) jargon */
- s7_define_function(sc, "grab-lock", g_grab_lock, 1, 0, false, H_grab_lock);
- s7_define_function(sc, "release-lock", g_release_lock, 1, 0, false, H_release_lock);
- s7_define_function(sc, "lock?", g_is_lock, 1, 0, false, H_is_lock);
- s7_define_function(sc, "make-thread-variable", g_make_thread_variable, 0, 0, false, H_make_thread_variable);
- s7_define_function(sc, "thread-variable?", g_is_thread_variable, 1, 0, false, H_is_thread_variable);
+ /* -------- *autoload* --------
+ * this pretends to be a hash-table or environment, but it's actually a function
+ */
+ sc->AUTOLOADER = s7_define_function(sc, "*autoload*", g_autoloader, 1, 0, false, H_autoloader);
+ sym = s7_define_variable(sc, "*libraries*", sc->NIL);
+ sc->libraries = global_slot(sym);
+
+ s7_autoload(sc, make_symbol(sc, "cload.scm"), s7_make_permanent_string("cload.scm"));
+ s7_autoload(sc, make_symbol(sc, "lint.scm"), s7_make_permanent_string("lint.scm"));
+ s7_autoload(sc, make_symbol(sc, "stuff.scm"), s7_make_permanent_string("stuff.scm"));
+ s7_autoload(sc, make_symbol(sc, "mockery.scm"), s7_make_permanent_string("mockery.scm"));
+ s7_autoload(sc, make_symbol(sc, "write.scm"), s7_make_permanent_string("write.scm"));
+ s7_autoload(sc, make_symbol(sc, "repl.scm"), s7_make_permanent_string("repl.scm"));
+ s7_autoload(sc, make_symbol(sc, "r7rs.scm"), s7_make_permanent_string("r7rs.scm"));
+
+ s7_autoload(sc, make_symbol(sc, "libc.scm"), s7_make_permanent_string("libc.scm"));
+ s7_autoload(sc, make_symbol(sc, "libm.scm"), s7_make_permanent_string("libm.scm"));
+ s7_autoload(sc, make_symbol(sc, "libdl.scm"), s7_make_permanent_string("libdl.scm"));
+ s7_autoload(sc, make_symbol(sc, "libgsl.scm"), s7_make_permanent_string("libgsl.scm"));
+ s7_autoload(sc, make_symbol(sc, "libgdbm.scm"), s7_make_permanent_string("libgdbm.scm"));
+ s7_autoload(sc, make_symbol(sc, "libutf8proc.scm"), s7_make_permanent_string("libutf8proc.scm"));
+
+ sc->REQUIRE = s7_define_macro(sc, "require", g_require, 0, 0, true, H_require);
+ sc->stacktrace_defaults = s7_list(sc, 5, small_int(3), small_int(45), small_int(80), small_int(45), sc->T);
+
+
+ /* -------- *#readers* -------- */
+ sym = s7_define_variable(sc, "*#readers*", sc->NIL);
+ sc->sharp_readers = global_slot(sym);
+ s7_symbol_set_access(sc, sym, s7_make_function(sc, "(set *#readers*)", g_sharp_readers_set, 2, 0, false, "*#readers* accessor"));
+
+ /* sigh... I don't like these! */
+ s7_define_constant(sc, "nan.0", real_NaN);
+ s7_define_constant(sc, "-nan.0", real_NaN);
+ s7_define_constant(sc, "inf.0", real_infinity);
+ s7_define_constant(sc, "-inf.0", real_minus_infinity);
+
+ /* *features* */
+ s7_provide(sc, "s7");
+ s7_provide(sc, "s7-" S7_VERSION);
+ s7_provide(sc, "ratio");
+
+#if WITH_PURE_S7
+ s7_provide(sc, "pure-s7");
+#endif
+#if WITH_EXTRA_EXPONENT_MARKERS
+ s7_provide(sc, "dfls-exponents");
+#endif
+#if WITH_SYSTEM_EXTRAS
+ s7_provide(sc, "system-extras");
+#endif
+#if WITH_IMMUTABLE_UNQUOTE
+ s7_provide(sc, "immutable-unquote");
+#endif
+#if DEBUGGING
+ s7_provide(sc, "debugging");
+#endif
+#if HAVE_COMPLEX_NUMBERS
+ s7_provide(sc, "complex-numbers");
+#endif
+#if WITH_C_LOADER
+ s7_provide(sc, "dlopen");
+#endif
- g_provide(sc, make_list_1(sc, make_symbol(sc, "threads")));
+#ifdef __APPLE__
+ s7_provide(sc, "osx");
+#endif
+#ifdef __linux__
+ s7_provide(sc, "linux");
+#endif
+#ifdef __OpenBSD__
+ s7_provide(sc, "openbsd");
+#endif
+#ifdef __NetBSD__
+ s7_provide(sc, "netbsd");
+#endif
+#ifdef __FreeBSD__
+ s7_provide(sc, "freebsd");
+#endif
+#if MS_WINDOWS
+ s7_provide(sc, "windows");
+#endif
+#ifdef __bfin__
+ s7_provide(sc, "blackfin");
+#endif
+#ifdef __ANDROID__
+ s7_provide(sc, "android");
+#endif
+#ifdef __CYGWIN__
+ s7_provide(sc, "cygwin");
+#endif
+#ifdef __hpux
+ s7_provide(sc, "hpux");
+#endif
+#if defined(__sun) && defined(__SVR4)
+ s7_provide(sc, "solaris");
#endif
- sc->VECTOR_SET = s7_symbol_value(sc, make_symbol(sc, "vector-set!"));
- typeflag(sc->VECTOR_SET) |= T_DONT_COPY;
- sc->LIST_SET = s7_symbol_value(sc, make_symbol(sc, "list-set!"));
- typeflag(sc->LIST_SET) |= T_DONT_COPY;
+ sc->Vector_Set = slot_value(global_slot(sc->VECTOR_SET));
+ set_setter(sc->VECTOR_SET);
+ /* not float-vector-set! here */
- sc->HASH_TABLE_SET = s7_symbol_value(sc, make_symbol(sc, "hash-table-set!"));
- typeflag(sc->HASH_TABLE_SET) |= T_DONT_COPY;
+ sc->List_Set = slot_value(global_slot(sc->LIST_SET));
+ set_setter(sc->LIST_SET);
- sc->HASH_TABLE_ITERATE = s7_make_function(sc, "(hash-table iterate)", g_hash_table_iterate, 1, 0, false, "internal hash-table iteration function");
- typeflag(sc->HASH_TABLE_ITERATE) |= T_DONT_COPY;
+ sc->Hash_Table_Set = slot_value(global_slot(sc->HASH_TABLE_SET));
+ set_setter(sc->HASH_TABLE_SET);
- sc->STRING_SET = s7_symbol_value(sc, make_symbol(sc, "string-set!"));
- typeflag(sc->STRING_SET) |= T_DONT_COPY;
+ sc->Let_Set = slot_value(global_slot(sc->LET_SET));
+ set_setter(sc->LET_SET);
- s7_function_set_setter(sc, "car", "set-car!");
- s7_function_set_setter(sc, "cdr", "set-cdr!");
- s7_function_set_setter(sc, "hash-table-ref", "hash-table-set!");
- s7_function_set_setter(sc, "vector-ref", "vector-set!");
- s7_function_set_setter(sc, "list-ref", "list-set!");
- s7_function_set_setter(sc, "string-ref", "string-set!");
+ set_setter(sc->CONS); /* (this blocks an over-eager do loop optimization -- see do-test-15 in s7test) */
+
+ sc->String_Set = slot_value(global_slot(sc->STRING_SET));
+ set_setter(sc->STRING_SET);
+
+ set_setter(sc->SET_CAR);
+ set_setter(sc->SET_CDR);
+
+#if (!WITH_PURE_S7)
+ set_setter(s7_make_symbol(sc, "set-current-input-port"));
+ set_setter(s7_make_symbol(sc, "set-current-output-port"));
s7_function_set_setter(sc, "current-input-port", "set-current-input-port");
s7_function_set_setter(sc, "current-output-port", "set-current-output-port");
+#endif
+
+ set_setter(s7_make_symbol(sc, "set-current-error-port"));
s7_function_set_setter(sc, "current-error-port", "set-current-error-port");
+ /* despite the similar names, current-error-port is different from the other two, and a setter is needed
+ * in scheme because error and warn send output to it by default. It is not a "dynamic variable" unlike
+ * the other two. In the input/output cases, setting the port can only cause confusion.
+ * current-error-port should simply be an s7 variable with a name like *error-port* and an accessor to
+ * ensure its new value, if any, is an output port.
+ */
+
+ s7_function_set_setter(sc, "car", "set-car!");
+ s7_function_set_setter(sc, "cdr", "set-cdr!");
+ s7_function_set_setter(sc, "hash-table-ref", "hash-table-set!");
+ s7_function_set_setter(sc, "vector-ref", "vector-set!");
+ s7_function_set_setter(sc, "float-vector-ref", "float-vector-set!");
+ s7_function_set_setter(sc, "int-vector-ref", "int-vector-set!");
+ s7_function_set_setter(sc, "list-ref", "list-set!");
+ s7_function_set_setter(sc, "let-ref", "let-set!");
+ s7_function_set_setter(sc, "string-ref", "string-set!");
+ c_function_setter(slot_value(global_slot(sc->OUTLET))) = s7_make_function(sc, "(set! outlet)", g_set_outlet, 2, 0, false, "outlet setter");
{
int i, top;
@@ -31779,21 +73575,21 @@ the error type and the info passed to the error handler.");
#define S7_LOG_LLONG_MAX 36.736800
#define S7_LOG_LONG_MAX 16.6355322
#else
- /* actually not safe = (log (- (expt 2 63) 1)) and (log (- (expt 2 31) 1))
+ /* actually not safe = (log (- (expt 2 63) 1)) and (log (- (expt 2 31) 1))
* (using 63 and 31 bits)
*/
#define S7_LOG_LLONG_MAX 43.668274
#define S7_LOG_LONG_MAX 21.487562
#endif
- top = sizeof(s7_Int);
- s7_int_max = (top == 8) ? S7_LONG_MAX : S7_SHORT_MAX;
- s7_int_min = (top == 8) ? S7_LONG_MIN : S7_SHORT_MIN;
+ top = sizeof(s7_int);
+ s7_int32_max = (top == 8) ? S7_LONG_MAX : S7_SHORT_MAX;
+ s7_int32_min = (top == 8) ? S7_LONG_MIN : S7_SHORT_MIN;
s7_int_bits = (top == 8) ? 63 : 31;
s7_int_digits = (top == 8) ? 18 : 8;
- s7_Int_max = (top == 8) ? S7_LLONG_MAX : S7_LONG_MAX;
- s7_Int_min = (top == 8) ? S7_LLONG_MIN : S7_LONG_MIN;
+ s7_int_max = (top == 8) ? S7_LLONG_MAX : S7_LONG_MAX;
+ s7_int_min = (top == 8) ? S7_LLONG_MIN : S7_LONG_MIN;
s7_int_digits_by_radix[0] = 0;
s7_int_digits_by_radix[1] = 0;
@@ -31801,181 +73597,306 @@ the error type and the info passed to the error handler.");
for (i = 2; i < 17; i++)
s7_int_digits_by_radix[i] = (int)(floor(((top == 8) ? S7_LOG_LLONG_MAX : S7_LOG_LONG_MAX) / log((double)i)));
- s7_define_constant(sc, "most-positive-fixnum", s7_make_integer(sc, (top == 8) ? S7_LLONG_MAX : ((top == 4) ? S7_LONG_MAX : S7_SHORT_MAX)));
- s7_define_constant(sc, "most-negative-fixnum", s7_make_integer(sc, (top == 8) ? S7_LLONG_MIN : ((top == 4) ? S7_LONG_MIN : S7_SHORT_MIN)));
+ s7_define_constant(sc, "most-positive-fixnum", make_permanent_integer_unchecked((top == 8) ? s7_int_max : ((top == 4) ? S7_LONG_MAX : S7_SHORT_MAX)));
+ s7_define_constant(sc, "most-negative-fixnum", make_permanent_integer_unchecked((top == 8) ? s7_int_min : ((top == 4) ? S7_LONG_MIN : S7_SHORT_MIN)));
- if (top == 4) default_rationalize_error = 1.0e-6;
- s7_define_constant(sc, "pi", s7_make_real(sc, 3.1415926535897932384626433832795029L)); /* M_PI is not good enough for s7_Double = long double */
+ if (top == 4) sc->default_rationalize_error = 1.0e-6;
+ s7_define_constant(sc, "pi", real_pi);
+ sc->PI = s7_make_symbol(sc, "pi");
- /* for s7_Double, float gives about 9 digits, double 18, long Double claims 28 but I don't see more than about 22? */
+ {
+ s7_pointer p;
+ new_cell(sc, p, T_RANDOM_STATE);
+#if WITH_GMP
+ {
+ mpz_t seed;
+ mpz_init_set_ui(seed, (unsigned int)time(NULL));
+ gmp_randinit_default(random_gmp_state(p));
+ gmp_randseed(random_gmp_state(p), seed);
+ mpz_clear(seed);
+ }
+#else
+ random_seed(p) = (unsigned long long int)time(NULL);
+ random_carry(p) = 1675393560;
+#endif
+ sc->default_rng = p;
+ }
+
+ for (i = 0; i < 10; i++) sc->singletons[(unsigned char)'0' + i] = small_int(i);
+ sc->singletons[(unsigned char)'+'] = sc->ADD;
+ sc->singletons[(unsigned char)'-'] = sc->SUBTRACT;
+ sc->singletons[(unsigned char)'*'] = sc->MULTIPLY;
+ sc->singletons[(unsigned char)'/'] = sc->DIVIDE;
+ sc->singletons[(unsigned char)'<'] = sc->LT;
+ sc->singletons[(unsigned char)'>'] = sc->GT;
+ sc->singletons[(unsigned char)'='] = sc->EQ;
}
-
#if WITH_GMP
s7_gmp_init(sc);
#endif
-#if WITH_DUMP_HEAP
- s7_define_function(sc, "dump-heap", g_dump_heap, 0, 0, false, "write heap contents to heap.data");
-#endif
+ init_choosers(sc);
- /* macroexpand
- * needs to be a bacro so locally defined macros are expanded:
- * (let () (define-macro (hi a) `(+ ,a 1)) (macroexpand (hi 2)))
- */
- s7_eval_c_string(sc, "(define-bacro (macroexpand __mac__) `(,(procedure-source (car __mac__)) ',__mac__))");
+ s7_define_macro(sc, "quasiquote", g_quasiquote, 1, 0, false, H_quasiquote);
- /* quasiquote
- */
- s7_define_macro(sc, "quasiquote", g_quasiquote, 1, 0, false, "quasiquote");
+ s7_eval_c_string(sc, "(define (dilambda g s) \n\
+ (if (or (not (arity g)) (not (arity s))) \n\
+ (error 'wrong-type-arg \"dilambda takes 2 procedures: ~A ~A\" g s) \n\
+ (set! (procedure-setter g) s)) \n\
+ g)");
- /* letrec* -- the less said the better...
- */
- s7_eval_c_string(sc, "(define-macro (letrec* bindings . body) \n\
- (if (null? body) \n\
- (error 'syntax-error \"letrec* has no body\") \n\
- (if (not (list? bindings)) \n\
- (error 'syntax-error \"letrec* bindings are messed up\") \n\
- `(let (,@(map (lambda (var&init) \n\
- (list (car var&init) #<undefined>)) \n\
- bindings)) \n\
- ,@(map (lambda (var&init) \n\
- (if (not (null? (cddr var&init))) \n\
- (error 'syntax-error \"letrec* variable has more than one value\")) \n\
- (list 'set! (car var&init) (cadr var&init))) \n\
- bindings) \n\
- , at body))))");
-
-
- /* call-with-values is almost a no-op in this context */
- s7_eval_c_string(sc, "(define-macro (call-with-values producer consumer) `(,consumer (,producer)))");
+#if (!WITH_PURE_S7)
+ s7_eval_c_string(sc, "(define hash-table-size length)"); /* backwards compatibility */
+
+ s7_eval_c_string(sc, "(define-macro (defmacro name args . body) `(define-macro ,(cons name args) , at body))");
+ s7_eval_c_string(sc, "(define-macro (defmacro* name args . body) `(define-macro* ,(cons name args) , at body))");
+
+ s7_eval_c_string(sc, "(define-macro (call-with-values producer consumer) `(,consumer (,producer)))");
/* (call-with-values (lambda () (values 1 2 3)) +) */
- s7_eval_c_string(sc, "(define-macro (multiple-value-bind vars expression . body) `((lambda ,vars , at body) ,expression))");
- /* (multiple-value-bind (a b) (values 1 2) (+ a b)) */
- /* named "receive" in srfi-8 which strikes me as perverse */
-
- s7_eval_c_string(sc, "(define-macro (multiple-value-set! vars expr . body) \n\
- (let ((local-vars (map (lambda (n) (gensym)) vars))) \n\
- `((lambda ,local-vars ,@(map (lambda (n ln) `(set! ,n ,ln)) vars local-vars) , at body) ,expr)))");
-
-
- /* cond-expand (uses *features*) */
- s7_eval_c_string(sc, "(define-macro (cond-expand . clauses) \n\
- ;; taken from MIT scheme? \n\
- \n\
- (define (got? fr) \n\
- (cond \n\
- ((memq fr *features*) #t) \n\
- ((not (pair? fr)) #f) \n\
- ((eq? 'and (car fr)) \n\
- (let loop ((clauses (cdr fr))) \n\
- (or (null? clauses) \n\
- (and (got? (car clauses)) \n\
- (loop (cdr clauses))))))\n\
- ((eq? 'or (car fr)) \n\
- (let loop ((clauses (cdr fr))) \n\
- (and (pair? clauses) \n\
- (or (got? (car clauses)) \n\
- (loop (cdr clauses))))))\n\
- ((eq? 'not (car fr)) \n\
- (not (got? (and (pair? (cdr fr)) \n\
- (cadr fr))))) \n\
- (else #f))) \n\
- \n\
- (let loop ((clauses clauses)) \n\
- (if (pair? clauses) \n\
- (let* ((feature (if (pair? (car clauses)) \n\
- (caar clauses) \n\
- (error 'wrong-type-arg \"cond-expand clause ~A is not a list\" (car clauses))))\n\
- (code (cons 'begin (cdar clauses))))\n\
- (cond \n\
- ((and (eq? 'else feature) \n\
- (null? (cdr clauses))) \n\
- code) \n\
- ((got? feature) \n\
- code) \n\
- (else (loop (cdr clauses))))))))");
-
- /* fprintf(stderr, "size: %d %d\n", (int)sizeof(s7_cell), (int)sizeof(s7_num_t)); */
-
- initialize_pows();
- save_initial_environment(sc);
-
- initial_add = s7_symbol_value(sc, make_symbol(sc, "+"));
- initial_subtract = s7_symbol_value(sc, make_symbol(sc, "-"));
- initial_equal = s7_symbol_value(sc, make_symbol(sc, "="));
- initial_lt = s7_symbol_value(sc, make_symbol(sc, "<"));
- initial_gt = s7_symbol_value(sc, make_symbol(sc, ">"));
+ s7_eval_c_string(sc, "(define-macro (multiple-value-bind vars expression . body) \n\
+ (if (or (symbol? vars) (negative? (length vars))) \n\
+ `((lambda ,vars , at body) ,expression) \n\
+ `((lambda* (, at vars . ,(gensym)) , at body) ,expression)))");
+ /* (multiple-value-bind (a b) (values 1 2) (+ a b)), named "receive" in srfi-8 which strikes me as perverse */
+
+ s7_eval_c_string(sc, "(define-macro (multiple-value-set! vars expr . body) \n\
+ (if (pair? vars) \n\
+ (let ((local-vars (map (lambda (n) (gensym)) vars))) \n\
+ `((lambda* (, at local-vars . ,(gensym)) \n\
+ ,@(map (lambda (n ln) `(set! ,n ,ln)) vars local-vars) \n\
+ , at body) \n\
+ ,expr)) \n\
+ (if (and (null? vars) (null? expr)) \n\
+ `(begin , at body) \n\
+ (error \"multiple-value-set! vars/exprs messed up\"))))");
+
+ s7_eval_c_string(sc, "(define-macro (cond-expand . clauses) \n\
+ (letrec ((traverse (lambda (tree) \n\
+ (if (pair? tree) \n\
+ (cons (traverse (car tree)) \n\
+ (if (null? (cdr tree)) () (traverse (cdr tree)))) \n\
+ (if (member tree '(and or not else) eq?) tree \n\
+ (and (symbol? tree) (provided? tree))))))) \n\
+ `(cond ,@(map (lambda (clause) \n\
+ (cons (traverse (car clause)) \n\
+ (if (null? (cdr clause)) '(#f) (cdr clause)))) \n\
+ clauses))))");
+#endif
+
+ s7_eval_c_string(sc, "(define-expansion (reader-cond . clauses) \n\
+ (call-with-exit \n\
+ (lambda (return) \n\
+ (for-each \n\
+ (lambda (clause) \n\
+ (let ((val (eval (car clause)))) \n\
+ (if val \n\
+ (if (null? (cdr clause)) (return val) \n\
+ (if (null? (cddr clause)) (return (cadr clause)) \n\
+ (return (apply values (map quote (cdr clause))))))))) \n\
+ clauses) \n\
+ (values))))");
+
+ s7_eval_c_string(sc, "(define (make-hook . args) \n\
+ (let ((body ())) \n\
+ (apply lambda* args \n\
+ '(let ((result #<unspecified>)) \n\
+ (let ((e (curlet))) \n\
+ (for-each (lambda (f) (f e)) body) \n\
+ result)) \n\
+ ())))");
+
+ s7_eval_c_string(sc, "(define hook-functions \n\
+ (dilambda \n\
+ (lambda (hook) \n\
+ ((funclet hook) 'body)) \n\
+ (lambda (hook lst) \n\
+ (if (or (null? lst) \n\
+ (and (pair? lst) \n\
+ (apply and (map (lambda (f) \n\
+ (and (procedure? f) \n\
+ (aritable? f 1))) \n\
+ lst)))) \n\
+ (set! ((funclet hook) 'body) lst) \n\
+ (error 'wrong-type-arg \"hook-functions must be a list of functions, each accepting one argument: ~S\" lst)))))");
+
+ /* -------- *unbound-variable-hook* -------- */
+ sc->unbound_variable_hook = s7_eval_c_string(sc, "(make-hook 'variable)");
+ s7_define_constant_with_documentation(sc, "*unbound-variable-hook*", sc->unbound_variable_hook,
+ "*unbound-variable-hook* functions are called when an unbound variable is encountered, passed (hook 'variable).");
+
+ /* -------- *missing-close-paren-hook* -------- */
+ sc->missing_close_paren_hook = s7_eval_c_string(sc, "(make-hook)");
+ s7_define_constant_with_documentation(sc, "*missing-close-paren-hook*", sc->missing_close_paren_hook,
+ "*missing-close-paren-hook* functions are called when the reader thinks a close paren is missing");
+
+ /* -------- *load-hook* -------- */
+ sc->load_hook = s7_eval_c_string(sc, "(make-hook 'name)");
+ s7_define_constant_with_documentation(sc, "*load-hook*", sc->load_hook,
+ "*load-hook* functions are invoked by load, passing the to-be-loaded filename as (hook 'name)");
+
+ /* -------- *error-hook* -------- */
+ sc->error_hook = s7_eval_c_string(sc, "(make-hook 'type 'data)");
+ s7_define_constant_with_documentation(sc, "*error-hook*", sc->error_hook,
+ "*error-hook* functions are called in the error handler, passed (hook 'type) and (hook 'data).");
+
+ s7_define_constant(sc, "*s7*",
+ s7_openlet(sc, s7_inlet(sc,
+ s7_list(sc, 2,
+ s7_cons(sc, sc->LET_REF_FALLBACK, s7_make_function(sc, "s7-let-ref", g_s7_let_ref_fallback, 2, 0, false, "*s7* reader")),
+ s7_cons(sc, sc->LET_SET_FALLBACK, s7_make_function(sc, "s7-let-set", g_s7_let_set_fallback, 3, 0, false, "*s7* writer"))))));
+
+
+#if (!DISABLE_DEPRECATED)
+ s7_eval_c_string(sc, "(define global-environment rootlet) \n\
+ (define current-environment curlet) \n\
+ (define make-procedure-with-setter dilambda) \n\
+ (define procedure-with-setter? dilambda?)\n\
+ (define make-random-state random-state) \n\
+ (define make-complex complex) \n\
+ (define (procedure-arity obj) (let ((c (arity obj))) (list (car c) (- (cdr c) (car c)) (> (cdr c) 100000))))");
+#endif
+
+ /* fprintf(stderr, "size: %d, max op: %d, opt: %d\n", (int)sizeof(s7_cell), OP_MAX_DEFINED, OPT_MAX_DEFINED); */
+ /* 64 bit machine: size: 48 [size 72 if gmp], op: 321, opt: 400 */
+
+ if (sizeof(void *) > sizeof(s7_int))
+ fprintf(stderr, "s7_int is too small: it has %d bytes, but void* has %d\n", (int)sizeof(s7_int), (int)sizeof(void *));
+
+ save_unlet(sc);
+#if WITH_COUNTS
+ clear_counts();
+#endif
+ init_s7_let(sc); /* set up *s7* */
+ already_inited = true;
return(sc);
}
-/* --------------------------------------------------------------------------------
- * things to add or fix:
+/* -------------------------------- repl -------------------------------- */
+
+#ifndef USE_SND
+ #define USE_SND 0
+#endif
+#ifndef WITH_MAIN
+ #define WITH_MAIN 0
+#endif
+
+#if (WITH_MAIN && (!USE_SND))
+
+int main(int argc, char **argv)
+{
+ s7_scheme *sc;
+
+ sc = s7_init();
+ if (argc == 2)
+ {
+ fprintf(stderr, "load %s\n", argv[1]);
+ s7_load(sc, argv[1]);
+ }
+ else
+ {
+#ifndef _MSC_VER
+ s7_load(sc, "repl.scm"); /* this is libc dependent */
+ s7_eval_c_string(sc, "((*repl* 'run))");
+#else
+ while (1) /* a minimal repl -- taken from s7.html */
+ {
+ char buffer[512];
+ char response[1024];
+ fprintf(stdout, "\n> ");
+ fgets(buffer, 512, stdin);
+ if ((buffer[0] != '\n') || (strlen(buffer) > 1))
+ {
+ sprintf(response, "(write %s)", buffer);
+ s7_eval_c_string(sc, response);
+ }
+ }
+#endif
+ }
+ return(0);
+}
+
+/* in Linux: gcc s7.c -o repl -DWITH_MAIN -I. -g3 -ldl -lm -Wl,-export-dynamic
+ * in *BSD: gcc s7.c -o repl -DWITH_MAIN -I. -g3 -lm -Wl,-export-dynamic
+ * in OSX: gcc s7.c -o repl -DWITH_MAIN -I. -g3 -lm
+ * (clang also needs LDFLAGS="-Wl,-export-dynamic" in Linux)
+ */
+#endif
+
+
+/* ----------------------------------------------------
+ *
+ * 12 | 13 | 14 | 15 | 16.0 16.1
+ *
+ * s7test 1721 | 1358 | 995 | 1194 | 1122 1117
+ * index 44.3 | 3291 | 1725 | 1276 | 1156 1158
+ * teq | | | 6612 | 2380 2376
+ * tauto 265 | 89 | 9 | 8.4 | 2638 2643
+ * tcopy | | | 13.6 | 3204 3203
+ * bench 42.7 | 8752 | 4220 | 3506 | 3230 3229
+ * tform | | | 6816 | 3627 3589
+ * tmap | | | 9.3 | 4176 4177
+ * titer | | | 7503 | 5218 5219
+ * thash | | | 50.7 | 8491 8484
+ * lg | | | | 20.7
+ * | | | |
+ * tgen | 71 | 70.6 | 38.0 | 12.0 11.7
+ * tall 90 | 43 | 14.5 | 12.7 | 15.0 15.0
+ * calls 359 | 275 | 54 | 34.7 | 37.1 37.0
+ *
+ * ----------------------------------------------------
*
- * could vectors maintain element type like hash-tables? Then "uniform" vectors are
- * automatic, and run would not have to check elements, etc. The obvious problem
- * is shared vectors in the multidimensional case (both directions). (Or maybe
- * :element-type but that requires type names)
+ * mockery.scm needs documentation (and stuff.scm: doc cyclic-seq+stuff under circular lists)
+ * cyclic-seq in stuff.scm, but current code is really clumsy
+ * gtk gl: I can't see how to switch gl in and out as in the motif version -- I guess I need both gl_area and drawing_area
+ * the old mus-audio-* code needs to use play or something, especially bess* -- what about soundio
+ * snd namespaces from <mark> etc mark: (inlet :type 'mark :name "" :home <channel> :sample 0 :sync #f) with name/sync/sample settable
+ * doc c_object_rf stuff? or how cload ties things into rf/sig
+ * libutf8proc.scm doc/examples? cload gtk/sndlib
+ * remove the #t=all sounds business! = (map f (sounds))
+ * gf cases (rf/if also): substring [inlet list vector float-vector int-vector] hash-table(*) sublet string format vector-append string-append append
+ * clm make-* sig should include the actual gen: oscil->(float? oscil? real?), also make->actual not #t in a circle
+ * make-oscil -> '(oscil? real? real)
+ * make-env -> '(env? sequence? real? real? real? real? integer? integer?) [seq here is actually pair? or float-vector?]
*
- * function equality?
- * is it possible for two functions to have the same closure and source and yet give different results to the same args?
- * (equal? (lambda (a) (+ a 1)) (lambda (b) (+ b 1)))
- * copy a function? -- apply lambda[*] to the procedure source + args + local env
+ * how to get at read-error cause in catch? port-data=string, port-position=int, port_data_size=int last-open-paren (sc->current_line)
+ * port-data port-position, length=remaining (unread) chars, copy->string gets that data, so no need for new funcs
+ * also port-filename|line-number could use let syntax, then maybe add position|data etc -- mock let like *s7*
+ * gc troubles with the string wrapper. Another such case: iterator. But how to handle default port as in (port-line-number)?
*
- * nonce-symbols need to be garbage collected
- * map/for-each mess up when the 1st arg is a macro
- * things to add: lint? (can we notice unreachable code, unbound variables, bad args)?
- * if user creates an enormous list, it can seem to hang the listener: *list-print-length* ?
- * or just *print-length* for all, including Snd cases -- in Snd print-length function becomes unneeded,
- * but we have to change the symbol access to make sure Snd's print_length is set if ours is, or
- * make the shadowing complete in the scheme case (but then how to set vct-print-length etc in parallel)?
- * what about trace-output-port? or an arg to trace? [it currently goes to current-output-port]
- * make bignum-precision a variable (not pws) -> *bignum-precision* [not sure about this -- there's alot happening upon set]
- * if the gmp support is fully separated, the bignum function is not needed
- * some way to refer to car/cdr of a cons in format
- * ~^ only acts within {}, so similarly within {} ~<... = car and ~>... = cdr? "~{~<3,1F : ~>A~}" (cons 1.5 2)
- * sort! applied to c|s_object?
- * the help strings use lambda* syntax for optional args, but these are not keyword args.
- * C-side catch, dynamic-wind? (see list in s7.h)
- * s7_quit (s7_call_with_exit?) that closes all files etc
- * s7_kill to free all memory (including "permanent" stuff)
- * settable subsequence function [setter for substring or list-tail?], append for sequences? (needs a make func)
- * position/posq/posv along the lines of member
- * for strings this could recognize upcase?
- * file-exists?, directory?, delete-file, (length|copy file)? even wilder: (file position) or (for-each ... file)
- * perhaps object->list (alongside object->string, but more restricted in what it can handle)
- * perhaps procedure-name, settable procedure-documentation
- * perhaps copy port
- * help should be more general than procedure-documentation (hook strings etc)
- * method lists for c|s_objects
- * checkpoint by saving the heap, stack...
- * complex number can be both nan and infinite -- is that sensible?
- * lots of displays are not readable (hash-table, vct, etc)
- * begin_hook could be coupled with GUI to show variable values during a computation
- * [but in Snd, that requires keeping track of its current value]
- * still mixed arith: * + / - < > <= >= = min max, but I haven't found any bugs
- * segfault in eval-ptree in vct-ref test 4 with-threaded-sound or in test 29 (s7test) -- infinite recursion in mark
+ * append: 44522: what if method not first arg? use 'values: check_values?
+ * (append "asd" ((*mock-string* 'mock-string) "hi")): error: append argument 1, "hi", is mock-string but should be a character
+ * s7 44522 -- method check is unfinished -- should look for append and make arglists, not length
+ * (append "asd" ((*mock-char* 'mock-char) #\g)): error: append argument 1, #\g, is mock-char but should be a sequence
+ * also arg num is incorrect -- always off by 1?
+ * append in string case uses string_append, not g_string_append!
*
- * --------------------------------------------------------------------------------
- * s7test valgrind, time 17-Jul-10 7-Sep-10 15-Oct-10
- * intel core duo (1.83G): 3162 2690 1.921 2426 1.830
- * intel E5200 (2.5G): 1951 1.450 1751 1.28
- * amd opteron 2218 (2.5G): 1859 1.335 1667 1.33
- * amd opteron 8356 (2.3G): 2181 1949 1.201 1752 1.18
- * intel E6850 (3.0G): 1952 1.045 1752 0.945
- * intel Q9650 (3.0G): 2081 1856 0.938 1665 0.840
- * amd phenom 945 (3.0G): 2085 1864 0.894 1667 0.808
- * intel Q9450 (2.66G): 1951 0.857
- * intel Q9550 (2.83G): 2184 1948 0.838 1751 0.800
- * intel E8400 (3.0G): 2372 2082 0.836 1857 0.750
- * intel xeon 5530 (2.4G) 2093 1855 0.811 1675 0.711
- * amd phenom 965 (3.4G): 2083 1862 0.808 1667 0.823
- * intel i7 930 (2.8G): 2084 1864 0.704 1667 0.620
- * intel i7 950 (3.1G): 1667 0.590
+ * lint: simple type->bool outside if et al?? [if car sig boolean? simplify]
+ * closure sig from body (and side-effects), expand args in code for internal lint?
+ * if closure depends only on arg (no free var, no funcs other than built-ins) and has no side-effects, and gets constant arg, eval?
+ * define* lambda* key-opt-key ordering and recognition -- split out arity/type/side-effect/self-contained (are globals in the var list?)
+ * first step done, now make-var -> sublet/inlet, handle the todo's in lint.scm, t330 lambda case
+ * also are defines in begin exported? also when etc.
+ * for class let: arity, procedure?, macro?, object->string, for var: sig and side decisions, macro tests
+ * can we match cc/exit args to the caller? error-args to the catcher?
+ * :rest with default
+ * macros that cause definitions are ignored (this also affects variable usage stats) and cload'ed identifiers are missed
+ * variable not used can be confused (prepend-spaces and display-let in stuff.scm)
+ * catch func arg checks (thunk, any args)
+ * code that can be make-list|string or vector|string etc
+ * morally-equal? for vector equality
+ * do we catch (not (when...))? it's not necessarily a mistake.
+ * letrec -> let (as in index.scm) [if none of letrec vars (including current) occurs in any of the bindings, use let]
+ * can letrec* -> let* if there are no forward refs? ->letrec if no cross dependencies?
+ * can the reverse be recognized (i.e. no occurrence of name in outer env, use in let before decl)?
+ * kw passed to define? non-hygienic macro problem (these should be obvious from the calling args and current env)
*
- * 10.8: 0.684, same in 11.10: 0.380, using no-gui snd (overhead: 0.04)
- * 4-Feb-11 callgrind non-gmp: 1678 0.67, gmp: 9114 2.56 (but it's running lots of additional tests)
+ * static s7_int abs_if_i(s7_scheme *sc, s7_pointer **p){s7_if_t f; s7_int x; f = (s7_if_t)(**p); (*p)++; x = f(sc, p); return(abs(x));}
+ * in libc_s7.c -- this should use llabs or cast the argument, or do abs by hand.
+ * (define (f f) (define* (f (f f)) f) (f)) (f 0): error: lambda* defaults: f is unbound??
+ * (define* (f2 a :rest b) (list a b)), (f2 1 :a 1) is not an error? at least in lint point out that here :a does not set a
+ * (define (f1 f1) f1) is also ok?
*/
diff --git a/s7.h b/s7.h
index 6300091..3f50df7 100644
--- a/s7.h
+++ b/s7.h
@@ -1,109 +1,30 @@
#ifndef S7_H
#define S7_H
-#define S7_VERSION "1.83"
-#define S7_DATE "14-Mar-11"
+#define S7_VERSION "4.2"
+#define S7_DATE "6-Nov-15"
+typedef long long int s7_int; /* This sets the size of integers in Scheme; it needs to be big enough to accomodate a C pointer. */
+typedef double s7_double; /* similarly for Scheme reals; only "double" works in C++ */
-typedef long long int s7_Int;
-/* This sets the size of integers in Scheme and s7.c; s7_Int can be almost any (signed) integer type:
- * "int" is ok, but "short" is problematic -- lots of things assume s7_Int is at least 32 bits.
- */
-
-typedef double s7_Double;
-/* similarly for doubles (reals in Scheme) -- only "double" works in C++, and
- * integer-decode-float assumes s7_Double is double.
- */
-
-
- /* --------------------------------------------------------------------------------
- * s7 itself is based on the types and functions in this file, so the first place to look for examples
- * is s7.c. There are also a few variations on a REPL at the end of s7.html. s7test.scm
- * is a regression test for s7 -- it still turns up a few problems. More tests are certainly welcome!
- * Extended examples of s7 usage are:
- *
- * Snd: ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-12.tar.gz (a sound editor)
- * which includes:
- * libxm: libxm.tar.gz (X, Motif, Gtk, and openGL bindings)
- * sndlib: sndlib.tar.gz (sound file, audio port, and CLM bindings plus an optimizer (run))
- *
- * Common Music by Rick Taube: http://camil.music.uiuc.edu/Software/grace/downloads/cm3.tar.gz (composition)
- * which can use sndlib -- see Snd's grfsnd.html or the cmdist archives for details
- *
- *
- * s7 (Scheme) variables:
- *
- * *features* a list of symbols describing what is currently available (initially '(s7)).
- * "provide" adds a symbol to the list,
- * "provided?" returns #t if its symbol arg is in the list.
- * *vector-print-length* how many elements of a vector are printed (initially 8)
- * __func__ equivalent to C's __func__. The symbol of the function currently being defined.
- * *load-path* a list of directory names that "load" searches for Scheme input files (initially '())
- * *load-hook* hook called before a file is loaded; takes a function of one arg, the name of the file.
- * *error-hook* hook called upon error; takes a function of two args,
- * the error type (a symbol), and the info about it (a list).
- * *error-info* data describing last error (see below).
- * *trace-hook* hook called upon trace; takes a function of two args, the traced function name and its current args
- * *unbound-variable-hook* hook called when an unbound symbol is accessed.
- * *#readers* #... readers
- * *gc-stats* #t to turn on GC statistics
- *
- * s7 constants:
- *
- * most-positive-fixnum
- * most-negative-fixnum integer limits (the names come from Common Lisp)
- * pi 3.1415...
- * *stdin*, *stdout*, *stderr* default IO ports
- *
- * s7 non-standard functions:
- *
- * provided? checks the *features* list for a symbol
- * provide adds a symbol to the *features* list
- * port-line-number current line during loading
- * port-filename current file name during loading
- * gc calls the GC. If its argument is #f, the GC is turned off
- * quit exits s7
- * call-with-exit just like call/cc but jump back into a context
- * continuation? #t if its argument is a continuation (as opposed to an ordinary procedure)
- * procedure-documentation doc string associated with a procedure
- * procedure-arity a list describing the arglist of a function: '(required-args optional-args rest-arg)
- * procedure-source returns the source (a list) of a procedure
- * help tries to find a help string associated with its argument
- * symbol-calls if profiling is enabled, returns the number of times its argument (a symbol) has been called
- * trace and untrace add or subtract functions from the trace list; (trace abs).
- * stacktrace show a stack trace, the stack at the point of an error: (stacktrace *error-info*),
- * or the stack at a break point: (stacktrace break-continuation)
- * macro? returns #t is its argument is a macro or a symbol whose value is a macro
- *
- * and various others mentioned at the start of s7.c -- nearly every Scheme implementation includes
- * stuff like logior, sinh, read-line, format, define*, etc. See also the start of s7.c for choices
- * such as multiprecision arithmetic, multidimensional vectors, initial heap and stack size, etc.
- *
- * The functions map, for-each, length, reverse, copy, and fill! are generic.
- *
- * I think s7 has built-in support for srfi-0 (cond-expand), srfi-6 (basic string ports), srfi-8 (receive), srfi-17 (generalized-set!),
- * srfi-18 (multithreading), srfi-28 (format, also nearly all of srfi-48), srfi-30 (block comments),
- * srfi-88 (keywords), and srfi-89 (define*). It also supports the functionality of many others
- * but under a slightly different syntax: srfi-69 (hash-tables), srfi-16 (define*), srfi-25 (multidimensional
- * arrays). srfi-98 would be trivial to add, and exists in snd as getenv.
- * The srfi-1 (lists) and srfi-60 (bitwise ops) reference implementations can be loaded as is.
- */
-
+/* old forms... */
+typedef s7_int s7_Int;
+typedef s7_double s7_Double;
#include <stdio.h>
+
#ifndef __cplusplus
-#if HAVE_STDBOOL_H
+#ifndef _MSC_VER
#include <stdbool.h>
#else
#ifndef true
- #define bool int
+ #define bool unsigned char
#define true 1
#define false 0
#endif
#endif
#endif
-
#ifdef __cplusplus
extern "C" {
#endif
@@ -113,15 +34,13 @@ typedef struct s7_cell *s7_pointer;
s7_scheme *s7_init(void);
- /* s7_scheme is our interpreter (or each thread's interpreter),
+ /* s7_scheme is our interpreter
* s7_pointer is a Scheme object of any (Scheme) type
- *
* s7_init creates the interpreter.
*/
typedef s7_pointer (*s7_function)(s7_scheme *sc, s7_pointer args); /* that is, obj = func(s7, args) -- args is a list of arguments */
-
s7_pointer s7_f(s7_scheme *sc); /* #f */
s7_pointer s7_t(s7_scheme *sc); /* #t */
s7_pointer s7_nil(s7_scheme *sc); /* () */
@@ -129,18 +48,19 @@ s7_pointer s7_undefined(s7_scheme *sc); /* #<undefi
s7_pointer s7_unspecified(s7_scheme *sc); /* #<unspecified> */
bool s7_is_unspecified(s7_scheme *sc, s7_pointer val); /* returns true if val is #<unspecified> */
s7_pointer s7_eof_object(s7_scheme *sc); /* #<eof> */
+bool s7_is_null(s7_scheme *sc, s7_pointer p); /* null? */
- /* these are the Scheme constants; they do not change in value during a run, and
- * are the same across all threads, so they can be safely assigned to C global variables if desired.
+ /* these are the Scheme constants; they do not change in value during a run,
+ * so they can be safely assigned to C global variables if desired.
*/
-bool s7_is_valid_pointer(s7_pointer arg); /* does 'arg' look like an s7 object? */
+bool s7_is_valid(s7_scheme *sc, s7_pointer arg); /* does 'arg' look like an s7 object? */
bool s7_is_c_pointer(s7_pointer arg);
void *s7_c_pointer(s7_pointer p);
-s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr);
- /* these are for passing uninterpreted C pointers through Scheme */
+s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr); /* these are for passing uninterpreted C pointers through Scheme */
s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str); /* (eval-string str) */
+s7_pointer s7_eval_c_string_with_environment(s7_scheme *sc, const char *str, s7_pointer e);
s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer arg, bool use_write);
/* (object->string obj) */
char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj); /* same as object->string but returns a C char* directly */
@@ -149,30 +69,32 @@ char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj); /* same as
s7_pointer s7_load(s7_scheme *sc, const char *file); /* (load file) */
s7_pointer s7_load_path(s7_scheme *sc); /* *load-path* */
s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir); /* (set! *load-path* (cons dir *load-path*)) */
+s7_pointer s7_autoload(s7_scheme *sc, s7_pointer symbol, s7_pointer file_or_function); /* (autoload symbol file-or-function) */
/* the load path is a list of directories to search if load can't find the file passed as its argument.
*/
void s7_quit(s7_scheme *sc);
/* this tries to break out of the current evaluation, leaving everything else intact */
-bool (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc);
-void s7_set_begin_hook(s7_scheme *sc, bool (*hook)(s7_scheme *sc));
+void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val);
+void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val));
/* call "hook" at the start of any block; use NULL to cancel.
- * see s7.html#replrescue and (in the Snd package) snd-listener.c for examples.
* s7_begin_hook returns the current begin_hook function or NULL.
*/
+s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e); /* (eval code e) -- e is the optional environment */
+s7_pointer s7_eval_form(s7_scheme *sc, s7_pointer form, s7_pointer e);
+
void s7_provide(s7_scheme *sc, const char *feature); /* add feature (as a symbol) to the *features* list */
+bool s7_is_provided(s7_scheme *sc, const char *feature); /* (provided? feature) */
s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info);
-s7_pointer s7_error_and_exit(s7_scheme *sc, s7_pointer type, s7_pointer info);
s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr);
/* set arg_n to 0 to indicate that caller takes only one argument (so the argument number need not be reported */
s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, int arg_n, s7_pointer arg, const char *descr);
s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args);
-void s7_set_error_exiter(s7_scheme *sc, void (*error_exiter)(void));
-s7_pointer s7_stacktrace(s7_scheme *sc, s7_pointer arg);
+s7_pointer s7_stacktrace(s7_scheme *sc);
/* these are equivalent to (error ...) in Scheme
* the first argument to s7_error is a symbol that can be caught (via (catch tag ...))
@@ -182,7 +104,6 @@ s7_pointer s7_stacktrace(s7_scheme *sc, s7_pointer arg);
* a format control string, and passes it to format with the rest of the
* info list as the format function arguments.
*
- * s7_error_and_exit jumps to some arbitrary place provided by s7_set_error_exiter
* s7_wrong_type_arg_error is equivalent to s7_error with a type of 'wrong-type-arg
* and similarly s7_out_of_range_error with type 'out-of-range.
*
@@ -196,29 +117,14 @@ s7_pointer s7_stacktrace(s7_scheme *sc, s7_pointer arg);
* normally printing the error arguments to current-error-port.
*/
- /* *error-info* is a vector of 6 or more elements:
- * 0: the error type or tag ('division-by-zero)
- * 1: the message or information passed by the error function
- * 2: if not #f, the code that s7 thinks triggered the error
- * 3: if not #f, the line number of that code
- * 4: if not #f, the file name of that code
- * 5: the environment at the point of the error
- * 6..top: stack enviroment pointers (giving enough info to reconstruct the current call stack), ending in #f
- *
- * to find a variable's value at the point of the error:
- * (symbol->value var (vector-ref *error-info* 5))
- *
- * to print the stack at the point of the error:
- * (stacktrace *error-info*)
- */
-
-int s7_gc_protect(s7_scheme *sc, s7_pointer x);
+unsigned int s7_gc_protect(s7_scheme *sc, s7_pointer x);
void s7_gc_unprotect(s7_scheme *sc, s7_pointer x);
-void s7_gc_unprotect_at(s7_scheme *sc, int loc);
-s7_pointer s7_gc_protected_at(s7_scheme *sc, int loc);
+void s7_gc_unprotect_at(s7_scheme *sc, unsigned int loc);
+s7_pointer s7_gc_protected_at(s7_scheme *sc, unsigned int loc);
s7_pointer s7_gc_on(s7_scheme *sc, bool on);
void s7_gc_stats(s7_scheme *sc, bool on);
-void s7_remove_from_heap(s7_scheme *sc, s7_pointer x);
+unsigned int s7_heap_size(s7_scheme *sc);
+int s7_gc_freed(s7_scheme *sc);
/* any s7_pointer object held in C (as a local variable for example) needs to be
* protected from garbage collection if there is any chance the GC may run without
@@ -261,27 +167,63 @@ s7_pointer s7_make_boolean(s7_scheme *sc, bool x); /*
bool s7_is_pair(s7_pointer p); /* (pair? p) */
s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b); /* (cons a b) */
+
s7_pointer s7_car(s7_pointer p); /* (car p) */
s7_pointer s7_cdr(s7_pointer p); /* (cdr p) */
+
s7_pointer s7_set_car(s7_pointer p, s7_pointer q); /* (set-car! p q) */
s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q); /* (set-cdr! p q) */
+s7_pointer s7_cadr(s7_pointer p); /* (cadr p) */
+s7_pointer s7_cddr(s7_pointer p); /* (cddr p) */
+s7_pointer s7_cdar(s7_pointer p); /* (cdar p) */
+s7_pointer s7_caar(s7_pointer p); /* (caar p) */
+
+s7_pointer s7_caadr(s7_pointer p); /* etc */
+s7_pointer s7_caddr(s7_pointer p);
+s7_pointer s7_cadar(s7_pointer p);
+s7_pointer s7_caaar(s7_pointer p);
+s7_pointer s7_cdadr(s7_pointer p);
+s7_pointer s7_cdddr(s7_pointer p);
+s7_pointer s7_cddar(s7_pointer p);
+s7_pointer s7_cdaar(s7_pointer p);
+
+s7_pointer s7_caaadr(s7_pointer p);
+s7_pointer s7_caaddr(s7_pointer p);
+s7_pointer s7_caadar(s7_pointer p);
+s7_pointer s7_caaaar(s7_pointer p);
+s7_pointer s7_cadadr(s7_pointer p);
+s7_pointer s7_cadddr(s7_pointer p);
+s7_pointer s7_caddar(s7_pointer p);
+s7_pointer s7_cadaar(s7_pointer p);
+s7_pointer s7_cdaadr(s7_pointer p);
+s7_pointer s7_cdaddr(s7_pointer p);
+s7_pointer s7_cdadar(s7_pointer p);
+s7_pointer s7_cdaaar(s7_pointer p);
+s7_pointer s7_cddadr(s7_pointer p);
+s7_pointer s7_cddddr(s7_pointer p);
+s7_pointer s7_cdddar(s7_pointer p);
+s7_pointer s7_cddaar(s7_pointer p);
+
bool s7_is_list(s7_scheme *sc, s7_pointer p); /* (list? p) -> (or (pair? p) (null? p)) */
int s7_list_length(s7_scheme *sc, s7_pointer a); /* (length a) */
+s7_pointer s7_list(s7_scheme *sc, int num_values, ...); /* (list ...) */
s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a); /* (reverse a) */
s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b); /* (append a b) */
s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, int num); /* (list-ref lst num) */
s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, int num, s7_pointer val); /* (list-set! lst num val) */
-s7_pointer s7_assoc(s7_scheme *sc, s7_pointer sym, s7_pointer lst); /* (assoc sym lst) */
-s7_pointer s7_member(s7_scheme *sc, s7_pointer sym, s7_pointer lst); /* (member sym lst) */
-
+s7_pointer s7_assoc(s7_scheme *sc, s7_pointer obj, s7_pointer lst); /* (assoc obj lst) */
+s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x); /* (assq obj lst) */
+s7_pointer s7_member(s7_scheme *sc, s7_pointer obj, s7_pointer lst); /* (member obj lst) */
+s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x); /* (memq obj lst) */
bool s7_is_string(s7_pointer p); /* (string? p) */
const char *s7_string(s7_pointer p); /* Scheme string -> C string (do not free the string) */
s7_pointer s7_make_string(s7_scheme *sc, const char *str); /* C string -> Scheme string (str is copied) */
s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, int len); /* same as s7_make_string, but provides strlen */
s7_pointer s7_make_permanent_string(const char *str); /* make a string that will never be GC'd */
+unsigned int s7_string_length(s7_pointer str); /* (string-length str) */
bool s7_is_character(s7_pointer p); /* (character? p) */
char s7_character(s7_pointer p); /* Scheme character -> C char */
@@ -289,18 +231,18 @@ s7_pointer s7_make_character(s7_scheme *sc, unsigned int c); /*
bool s7_is_number(s7_pointer p); /* (number? p) */
-bool s7_is_exact(s7_pointer p); /* (exact? p) */
-bool s7_is_inexact(s7_pointer p); /* (inexact? p) */
-
bool s7_is_integer(s7_pointer p); /* (integer? p) */
-s7_Int s7_integer(s7_pointer p); /* Scheme integer -> C int (long long int probably) */
-s7_pointer s7_make_integer(s7_scheme *sc, s7_Int num); /* C long long int -> Scheme integer */
+s7_int s7_integer(s7_pointer p); /* Scheme integer -> C int (long long int probably) */
+s7_pointer s7_make_integer(s7_scheme *sc, s7_int num); /* C long long int -> Scheme integer */
bool s7_is_real(s7_pointer p); /* (real? p) */
-s7_Double s7_real(s7_pointer p); /* Scheme real -> C double */
-s7_pointer s7_make_real(s7_scheme *sc, s7_Double num); /* C double -> Scheme real */
-s7_Double s7_number_to_real(s7_pointer x); /* x can be any kind of number */
-s7_Int s7_number_to_integer(s7_pointer x);
+s7_double s7_real(s7_pointer p); /* Scheme real -> C double */
+s7_pointer s7_make_real(s7_scheme *sc, s7_double num); /* C double -> Scheme real */
+s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n);
+s7_double s7_number_to_real(s7_scheme *sc, s7_pointer x); /* x can be any kind of number */
+s7_double s7_number_to_real_with_caller(s7_scheme *sc, s7_pointer x, const char *caller);
+s7_int s7_number_to_integer(s7_scheme *sc, s7_pointer x);
+s7_int s7_number_to_integer_with_caller(s7_scheme *sc, s7_pointer x, const char *caller);
bool s7_is_ulong(s7_pointer arg); /* returns true if arg is an unsigned long */
unsigned long s7_ulong(s7_pointer p); /* Scheme unsigned long -> C */
@@ -312,36 +254,50 @@ s7_pointer s7_make_ulong_long(s7_scheme *sc, unsigned long long n); /*
bool s7_is_rational(s7_pointer arg); /* (rational? arg) -- integer or ratio */
bool s7_is_ratio(s7_pointer arg); /* true if arg is a ratio, not an integer */
-s7_pointer s7_make_ratio(s7_scheme *sc, s7_Int a, s7_Int b); /* returns the Scheme object a/b */
-s7_pointer s7_rationalize(s7_scheme *sc, s7_Double x, s7_Double error); /* (rationalize x error) */
-s7_Int s7_numerator(s7_pointer x); /* (numerator x) */
-s7_Int s7_denominator(s7_pointer x); /* (denominator x) */
-s7_Double s7_random(s7_scheme *sc, s7_pointer state); /* (random x) */
-s7_pointer s7_make_random_state(s7_scheme *sc, s7_pointer seed); /* (make-random-state seed) */
+s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b); /* returns the Scheme object a/b */
+s7_pointer s7_rationalize(s7_scheme *sc, s7_double x, s7_double error); /* (rationalize x error) */
+s7_int s7_numerator(s7_pointer x); /* (numerator x) */
+s7_int s7_denominator(s7_pointer x); /* (denominator x) */
+s7_double s7_random(s7_scheme *sc, s7_pointer state); /* (random x) */
+s7_pointer s7_random_state(s7_scheme *sc, s7_pointer seed); /* (random-state seed) */
s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args); /* (random-state->list r) */
-void s7_set_default_random_state(s7_scheme *sc, s7_Int seed, s7_Int carry);
+void s7_set_default_random_state(s7_scheme *sc, s7_int seed, s7_int carry);
bool s7_is_complex(s7_pointer arg); /* (complex? arg) */
-s7_pointer s7_make_complex(s7_scheme *sc, s7_Double a, s7_Double b); /* returns the Scheme object a+bi */
-s7_Double s7_real_part(s7_pointer z); /* (real-part z) */
-s7_Double s7_imag_part(s7_pointer z); /* (imag-part z) */
+s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b); /* returns the Scheme object a+bi */
+s7_double s7_real_part(s7_pointer z); /* (real-part z) */
+s7_double s7_imag_part(s7_pointer z); /* (imag-part z) */
char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, int radix); /* (number->string obj radix) */
-bool s7_is_vector(s7_pointer p); /* (vector? p) */
+bool s7_is_vector(s7_pointer p); /* (vector? p) */
+s7_int s7_vector_length(s7_pointer vec); /* (vector-length vec) */
+int s7_vector_rank(s7_pointer vect); /* number of dimensions in vect */
+s7_int *s7_vector_dimensions(s7_pointer vec); /* dimensions */
+s7_int *s7_vector_offsets(s7_pointer vec); /* precalculated offsets to speed-up addressing */
+s7_pointer *s7_vector_elements(s7_pointer vec); /* a pointer to the array of s7_pointers */
+s7_int *s7_int_vector_elements(s7_pointer vec);
+s7_double *s7_float_vector_elements(s7_pointer vec);
+bool s7_is_float_vector(s7_pointer p);
+bool s7_is_int_vector(s7_pointer p);
+
+s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index); /* (vector-ref vec index) */
+s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a); /* (vector-set! vec index a) */
+s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, int indices, ...); /* multidimensional vector-ref */
+s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, int indices, ...); /* multidimensional vector-set! */
+
+s7_pointer s7_make_vector(s7_scheme *sc, s7_int len); /* (make-vector len) */
+s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, int dims, s7_int *dim_info);
+s7_pointer s7_make_float_vector(s7_scheme *sc, s7_int len, int dims, s7_int *dim_info);
+s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *data, int dims, s7_int *dim_info, bool free_data);
+s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill); /* (make-vector len fill) */
+
void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj); /* (vector-fill! vec obj) */
-s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_Int index); /* (vector-ref vec index) */
-s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_Int index, s7_pointer a); /* (vector-set! vec index a) */
-s7_pointer s7_make_vector(s7_scheme *sc, s7_Int len); /* (make-vector len) */
-s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_Int len, s7_pointer fill); /* (make-vector len fill) */
-s7_Int s7_vector_length(s7_pointer vec); /* (vector-length vec) */
-s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect); /* (vector->list vect) */
-s7_pointer *s7_vector_elements(s7_pointer vec); /* a pointer to the array of s7_pointers */
-int s7_vector_rank(s7_pointer vect); /* number of dimensions in vect */
-s7_Int *s7_vector_dimensions(s7_pointer vec); /* dimensions */
-s7_Int *s7_vector_offsets(s7_pointer vec); /* precalculated offsets to speed-up addressing */
-s7_Int s7_vector_print_length(s7_scheme *sc); /* value of *vector-print-length* */
-s7_Int s7_set_vector_print_length(s7_scheme *sc, s7_Int new_len);
+s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect);
+s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect); /* (vector->list vec) */
+
+s7_int s7_print_length(s7_scheme *sc); /* value of (*s7* 'print-length) */
+s7_int s7_set_print_length(s7_scheme *sc, s7_int new_len);
/*
* (vect i) is the same as (vector-ref vect i)
@@ -354,43 +310,20 @@ s7_Int s7_set_vector_print_length(s7_scheme *sc, s7_Int new_len);
bool s7_is_hash_table(s7_pointer p); /* (hash-table? p) */
-s7_pointer s7_make_hash_table(s7_scheme *sc, s7_Int size); /* (make-hash-table size) */
+s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size); /* (make-hash-table size) */
s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key);
/* (hash-table-ref table key) */
s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value);
/* (hash-table-set! table key value) */
- /* a hash-table is a vector of alists '((symbol value)), so to iterate over a hash-table
- * use for-each which calls its function with each of these alists. An entry defaults to nil.
- */
- /* hash-tables are applicable:
- (let ((hash (make-hash-table)))
- (set! (hash 'hi) 32)
- (hash 'hi))
- -> 32
- */
-
-
-s7_pointer s7_make_hook(s7_scheme *sc, int required_args, int optional_args, bool rest_arg, const char *documentation);
- /* (make-hook arity doc) */
-bool s7_is_hook(s7_pointer p); /* (hook? p) */
-s7_pointer s7_hook_functions(s7_pointer hook); /* (hook-functions hook) */
-s7_pointer s7_hook_set_functions(s7_pointer hook, s7_pointer functions); /* (set! (hook-functions hook) ...) */
-s7_pointer s7_hook_arity(s7_pointer hook); /* (hook-arity hook) */
-const char *s7_hook_documentation(s7_pointer hook); /* (hook-documentation hook) */
-s7_pointer s7_hook_apply(s7_scheme *sc, s7_pointer hook, s7_pointer args); /* (<hook> ... ) or (hook-apply hook args) */
-
- /* a hook is a list of functions, each compatible with the hook arity.
- * when a hook is applied to a list of arguments, each function on its functions list
- * is applied to those arguments. In the default case (hook-apply), the value returned
- * is unspecified. The hook-functions list is settable; it is an ordinary Scheme list,
- * and hook-functions is a procedure-with-setter.
- * hooks are sometimes called callback-lists, conditions, watchpoints, etc.
- */
+
+s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook); /* (hook-functions hook) */
+s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions); /* (set! (hook-functions hook) ...) */
bool s7_is_input_port(s7_scheme *sc, s7_pointer p); /* (input-port? p) */
bool s7_is_output_port(s7_scheme *sc, s7_pointer p); /* (output-port? p) */
const char *s7_port_filename(s7_pointer x); /* (port-filename p) */
+int s7_port_line_number(s7_pointer p); /* (port-line-number p) */
s7_pointer s7_current_input_port(s7_scheme *sc); /* (current-input-port) */
s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer p); /* (set-current-input-port) */
@@ -410,12 +343,11 @@ s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string);
s7_pointer s7_open_output_string(s7_scheme *sc); /* (open-output-string) */
const char *s7_get_output_string(s7_scheme *sc, s7_pointer out_port); /* (get-output-string port) -- current contents of output string */
/* don't free the string */
+void s7_flush_output_port(s7_scheme *sc, s7_pointer p); /* (flush-output-port port) */
typedef enum {S7_READ, S7_READ_CHAR, S7_READ_LINE, S7_READ_BYTE, S7_PEEK_CHAR, S7_IS_CHAR_READY} s7_read_t;
s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, unsigned char c, s7_pointer port));
s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port));
-void *s7_port_data(s7_pointer port);
-void *s7_port_set_data(s7_pointer port, void *stuff);
int s7_read_char(s7_scheme *sc, s7_pointer port); /* (read-char port) */
int s7_peek_char(s7_scheme *sc, s7_pointer port); /* (peek-char port) */
@@ -429,22 +361,20 @@ const char *s7_format(s7_scheme *sc, s7_pointer args); /* (
bool s7_is_procedure(s7_pointer x); /* (procedure? x) */
bool s7_is_macro(s7_scheme *sc, s7_pointer x); /* (macro? x) */
-s7_pointer s7_procedure_source(s7_scheme *sc, s7_pointer p); /* (procedure-source x) if it can be found */
-s7_pointer s7_procedure_environment(s7_pointer p); /* (procedure-environment x) */
+s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p); /* (funclet x) */
const char *s7_procedure_documentation(s7_scheme *sc, s7_pointer p); /* (procedure-documentation x) if any (don't free the string) */
-s7_pointer s7_procedure_arity(s7_scheme *sc, s7_pointer x); /* (procedure-arity x) -- returns a list (required optional rest?) */
+s7_pointer s7_make_signature(s7_scheme *sc, int len, ...); /* procedure-signature data */
+s7_pointer s7_make_circular_signature(s7_scheme *sc, int cycle_point, int len, ...);
+bool s7_is_aritable(s7_scheme *sc, s7_pointer x, int args); /* (aritable? x args) */
+s7_pointer s7_arity(s7_scheme *sc, s7_pointer x); /* (arity x) */
-bool s7_is_continuation(s7_pointer p); /* (continuation? p) */
-s7_pointer s7_make_continuation(s7_scheme *sc); /* call/cc... (see example below) */
-
-s7_pointer s7_values(s7_scheme *sc, int num_values, ...); /* (values ...) */
-
- /* for example:
- * return(s7_values(sc, 3, s7_make_integer(sc, 1), s7_make_integer(sc, 2), s7_make_integer(sc, 3)));
- * now call this "v" and:
- * (+ 1 (v) 2) => 9
- */
+const char *s7_help(s7_scheme *sc, s7_pointer obj); /* (help obj) */
+s7_pointer s7_make_continuation(s7_scheme *sc); /* call/cc... (see example below) */
+bool s7_is_syntax(s7_pointer p);
bool s7_is_symbol(s7_pointer p); /* (symbol? p) */
const char *s7_symbol_name(s7_pointer p); /* (symbol->string p) -- don't free the string */
s7_pointer s7_make_symbol(s7_scheme *sc, const char *name); /* (string->symbol name) */
@@ -452,100 +382,63 @@ s7_pointer s7_gensym(s7_scheme *sc, const char *prefix); /* (
bool s7_is_keyword(s7_pointer obj); /* (keyword? obj) */
s7_pointer s7_make_keyword(s7_scheme *sc, const char *key); /* (make-keyword key) */
-#define s7_keyword_eq_p(Obj1, Obj2) s7_is_eq(Obj1, Obj2)
s7_pointer s7_symbol_access(s7_scheme *sc, s7_pointer sym);
-s7_pointer s7_symbol_set_access(s7_scheme *sc, s7_pointer symbol, s7_pointer funcs);
-
-s7_pointer s7_global_environment(s7_scheme *sc); /* (global-environment) */
-s7_pointer s7_current_environment(s7_scheme *sc); /* (current-environment) */
-s7_pointer s7_augment_environment(s7_scheme *sc, s7_pointer env, s7_pointer bindings);
-
- /* each environment is a list of the current frames (alists of symbols and values)
- * and the global (top-level) definitions, a vector of alists (a hash-table).
- * Here is an example of "apropos" that accesses both kinds of environment:
- *
- (define (apropos name)
- ;; (apropos "name") prints out a list of all symbols whose name includes "name" as a substring
-
- (define (substring? subs s) ; from larceny
- (let* ((start 0)
- (ls (string-length s))
- (lu (string-length subs))
- (limit (- ls lu)))
- (let loop ((i start))
- (cond ((> i limit) #f)
- ((do ((j i (+ j 1))
- (k 0 (+ k 1)))
- ((or (= k lu)
- (not (char=? (string-ref subs k) (string-ref s j))))
- (= k lu))) i)
- (else (loop (+ i 1)))))))
-
- (define (apropos-1 alist)
- (for-each
- (lambda (binding)
- (if (substring? name (symbol->string (car binding)))
- (format (current-output-port) "~A: ~A~%"
- (car binding)
- (if (procedure? (cdr binding))
- (procedure-documentation (cdr binding))
- (cdr binding)))))
- alist))
-
- (for-each
- (lambda (frame)
- (if (vector? frame) ; the global environment
- (let ((len (vector-length frame)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (apropos-1 (vector-ref frame i))))
- (apropos-1 frame)))
- (current-environment)))
- */
+s7_pointer s7_symbol_set_access(s7_scheme *sc, s7_pointer symbol, s7_pointer func);
+
+s7_pointer s7_slot(s7_scheme *sc, s7_pointer symbol);
+s7_pointer s7_slot_value(s7_pointer slot);
+s7_pointer s7_slot_set_value(s7_scheme *sc, s7_pointer slot, s7_pointer value);
+s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value);
+
+s7_pointer s7_rootlet(s7_scheme *sc); /* (rootlet) */
+s7_pointer s7_shadow_rootlet(s7_scheme *sc);
+s7_pointer s7_set_shadow_rootlet(s7_scheme *sc, s7_pointer let);
+s7_pointer s7_curlet(s7_scheme *sc); /* (curlet) */
+s7_pointer s7_set_curlet(s7_scheme *sc, s7_pointer e); /* returns previous curlet */
+ s7_pointer s7_outlet(s7_scheme *sc, s7_pointer e); /* (outlet e) */
+s7_pointer s7_sublet(s7_scheme *sc, s7_pointer env, s7_pointer bindings); /* (sublet e ...) */
+s7_pointer s7_inlet(s7_scheme *sc, s7_pointer bindings); /* (inlet ...) */
+s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer env); /* (let->list env) */
+bool s7_is_let(s7_pointer e); /* )let? e) */
+s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer sym); /* (let-ref e sym) */
+s7_pointer s7_let_set(s7_scheme *sc, s7_pointer env, s7_pointer sym, s7_pointer val); /* (let-set! e sym val) */
+ s7_pointer s7_openlet(s7_scheme *sc, s7_pointer e); /* (openlet e) */
+bool s7_is_openlet(s7_pointer e); /* (openlet? e) */
+s7_pointer s7_method(s7_scheme *sc, s7_pointer obj, s7_pointer method);
s7_pointer s7_name_to_value(s7_scheme *sc, const char *name);
+s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name);
s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym);
s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val);
s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer local_env);
-void s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data);
-void s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, s7_pointer value, void *data), void *data);
+char *s7_symbol_documentation(s7_scheme *sc, s7_pointer sym);
+char *s7_symbol_set_documentation(s7_scheme *sc, s7_pointer sym, const char *new_doc);
+bool s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data);
+bool s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, s7_pointer value, void *data), void *data);
/* these access the current environment and symbol table, providing
* a symbol's current binding (s7_name_to_value takes the symbol name as a char*,
* s7_symbol_value takes the symbol itself, s7_symbol_set_value changes the
* current binding, and s7_symbol_local_value uses the environment passed
- * as its third argument.
+ * as its third argument).
*
* To iterate over the complete symbol table, use s7_for_each_symbol_name,
* and s7_for_each_symbol. The latter calls the 'symbol_func' on each
* symbol, passing the symbol name, its current binding, and the uninterpreted
* 'data' pointer. s7_for_each_symbol_name is similar, but does not include
* the current binding.
- */
-
- /* in Scheme, you can use the symbol-table function. In the next example, we scan the symbol table
- * for any function that doesn't have documentation:
*
- (let ((st (symbol-table)))
- (do ((i 0 (+ i 1)))
- ((= i (vector-length st)))
- (let ((lst (vector-ref st i)))
- (for-each
- (lambda (sym)
- (if (defined? sym)
- (let ((val (symbol->value sym)))
- (if (and (procedure? val)
- (string=? "" (procedure-documentation val)))
- (format #t "~A " sym)))))
- lst))))
- */
+ * The for-each loop stops if the symbol_func returns true, or at the end of the table.
+ */
void s7_define(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value);
bool s7_is_defined(s7_scheme *sc, const char *name);
-void s7_define_variable(s7_scheme *sc, const char *name, s7_pointer value);
-void s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value);
+s7_pointer s7_define_variable(s7_scheme *sc, const char *name, s7_pointer value);
+s7_pointer s7_define_variable_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help);
+s7_pointer s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value);
+s7_pointer s7_define_constant_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help);
bool s7_is_constant(s7_pointer p);
/* These three functions add a symbol and its binding to either the top-level environment
@@ -555,24 +448,39 @@ bool s7_is_constant(s7_pointer p);
*
* in s7.c is equivalent to the top level form
*
- * (define *features* '())
+ * (define *features* ())
*
* s7_define_variable is simply s7_define with string->symbol and the global environment.
* s7_define_constant is s7_define but makes its "definee" immutable.
- * s7_define is equivalent to define in Scheme, but takes place in the global environment.
+ * s7_define is equivalent to define in Scheme.
*/
bool s7_is_function(s7_pointer p);
-s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function fnc, int required_args, int optional_args, bool rest_arg, const char *doc);
-void s7_define_function(s7_scheme *sc, const char *name, s7_function fnc, int required_args, int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f,
+ int required_args, int optional_args, bool rest_arg, const char *doc, s7_pointer signature);
+
+s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
+ int required_args, int optional_args, bool rest_arg,
+ const char *doc, s7_pointer signature);
+
void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
-void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc, s7_function set_fnc, int req_args, int opt_args, const char *doc);
+void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
-s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
-s7_pointer s7_make_closure(s7_scheme *sc, s7_pointer c, s7_pointer e);
+void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc,
+ s7_function set_fnc, int req_args, int opt_args, const char *doc);
+ /* this is now the same as s7_dilambda (different args) */
-void s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, int required_args, int optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
+s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, int required_args, int optional_args, bool rest_arg, const char *doc);
/* s7_make_function creates a Scheme function object from the s7_function 'fnc'.
* Its name (for s7_describe_object) is 'name', it requires 'required_args' arguments,
@@ -592,21 +500,15 @@ void s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, int requi
* s7_define_function(sc, "car", g_car, 1, 0, false, "(car obj)");
* one required arg, no optional arg, no "rest" arg
*
- * s7_define_function_with_setter defined a procedure-with-setter.
- *
* s7_is_function returns true if its argument is a function defined in this manner.
* s7_apply_function applies the function (the result of s7_make_function) to the arguments.
*
* s7_define_macro defines a Scheme macro; its arguments are not evaluated (unlike a function),
* but its returned value (assumed to be some sort of Scheme expression) is evaluated.
- *
- * for s7_make_closure, see the "Closure defined in C" example in s7.html.
*/
/* In s7, (define* (name . args) body) or (define name (lambda* args body))
* define a function that takes optional (keyword) named arguments.
- * The keywords :key and :optional are ok, but they are ignored --
- * they exist to be compatible with other define* implementations.
* The "args" is a list that can contain either names (normal arguments),
* or lists of the form (name default-value), in any order. When called,
* the names are bound to their default values (or #f), then the function's
@@ -616,17 +518,11 @@ void s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, int requi
* (as normal for a function). So,
*
* (define* (hi a (b 32) (c "hi")) (list a b c))
+ * (hi 1) -> '(1 32 "hi")
+ * (hi :b 2 :a 3) -> '(3 2 "hi")
+ * (hi 3 2 1) -> '(3 2 1)
*
- * is equivalent to other implementations (define* (hi a :key (b 32) ...))
- * or (define* (hi a :optional (b 32) ...)) -- these args are all
- * "optional-key" args in CLM jargon.
- *
- * (hi 1) -> '(1 32 "hi")
- * (hi :b 2 :a 3) -> '(3 2 "hi")
- * (hi 3 2 1) -> '(3 2 1)
- *
- * and so on. :rest causes its argument to be bound to the rest
- * of the arguments at that point.
+ * :rest causes its argument to be bound to the rest of the arguments at that point.
*
* The C connection to this takes the function name, the C function to call, the argument
* list as written in Scheme, and the documentation string. s7 makes sure the arguments
@@ -645,39 +541,40 @@ s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args
/* s7_call takes a Scheme function (e.g. g_car above), and applies it to 'args' (a list of arguments)
* returning the result.
*
- * s7_integer(s7_call(s7, g_car, s7_cons(s7, s7_make_integer(sc, 123), s7_nil(s7))));
+ * s7_integer(s7_call(s7, g_car, s7_cons(s7, s7_make_integer(s7, 123), s7_nil(s7))));
*
* returns 123.
*
* s7_call_with_location passes some information to the error handler.
*/
-
-bool s7_is_procedure_with_setter(s7_pointer obj);
-s7_pointer s7_make_procedure_with_setter(s7_scheme *sc,
- const char *name,
- s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
- int get_req_args, int get_opt_args,
- s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
- int set_req_args, int set_opt_args,
- const char *documentation);
-s7_pointer s7_procedure_with_setter_setter(s7_pointer obj);
-s7_pointer s7_procedure_with_setter_getter(s7_pointer obj);
-
- /* a procedure_with_setter is an object that can be called either as a normal function,
- * or as the object of set! There is an extended example in s7.html. The 'getter'
- * is the normal (outside set!) function (normally a struct field reader of some sort),
- * and the 'setter' is the set! function (a field writer in most cases).
- *
- * In the example in s7.html we have dax-x as the procedure-with-setter,
- * (dac-x obj) returns the x field of obj
- * (set! (dac-x obj) value) sets that field to value
- *
- * In the set! case, the new value is the last of the args passed to the setter.
- * s7_make_procedure_with_setter is equivalent to s7_make_function, so to bind it
- * to some name, you need to call s7_define_variable.
- */
-
-
+s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish);
+
+
+bool s7_is_dilambda(s7_pointer obj);
+s7_pointer s7_dilambda(s7_scheme *sc,
+ const char *name,
+ s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+ int get_req_args, int get_opt_args,
+ s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+ int set_req_args, int set_opt_args,
+ const char *documentation);
+s7_pointer s7_typed_dilambda(s7_scheme *sc,
+ const char *name,
+ s7_pointer (*getter)(s7_scheme *sc, s7_pointer args),
+ int get_req_args, int get_opt_args,
+ s7_pointer (*setter)(s7_scheme *sc, s7_pointer args),
+ int set_req_args, int set_opt_args,
+ const char *documentation,
+ s7_pointer get_sig, s7_pointer set_sig);
+
+s7_pointer s7_procedure_setter(s7_scheme *sc, s7_pointer obj);
+s7_pointer s7_values(s7_scheme *sc, s7_pointer args);
+s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e);
+bool s7_is_iterator(s7_pointer obj);
+bool s7_iterator_is_at_end(s7_pointer obj);
+s7_pointer s7_iterate(s7_scheme *sc, s7_pointer iter);
+
+ /* ancient form -- backwards compatibility */
int s7_new_type(const char *name,
char *(*print)(s7_scheme *sc, void *value),
void (*free)(void *value),
@@ -686,7 +583,9 @@ int s7_new_type(const char *name,
s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args));
-int s7_new_type_x(const char *name,
+ /* new form */
+int s7_new_type_x(s7_scheme *sc,
+ const char *name,
char *(*print)(s7_scheme *sc, void *value),
void (*free)(void *value),
bool (*equal)(void *val1, void *val2),
@@ -694,15 +593,20 @@ int s7_new_type_x(const char *name,
s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
s7_pointer (*length)(s7_scheme *sc, s7_pointer obj),
- s7_pointer (*copy)(s7_scheme *sc, s7_pointer obj),
- s7_pointer (*fill)(s7_scheme *sc, s7_pointer obj, s7_pointer args));
+ s7_pointer (*copy)(s7_scheme *sc, s7_pointer args),
+ s7_pointer (*reverse)(s7_scheme *sc, s7_pointer obj),
+ s7_pointer (*fill)(s7_scheme *sc, s7_pointer args));
bool s7_is_object(s7_pointer p);
int s7_object_type(s7_pointer obj);
void *s7_object_value(s7_pointer obj);
+void *s7_object_value_checked(s7_pointer obj, int type);
s7_pointer s7_make_object(s7_scheme *sc, int type, void *value);
void s7_mark_object(s7_pointer p);
-
+s7_pointer s7_object_let(s7_pointer obj);
+s7_pointer s7_object_set_let(s7_pointer obj, s7_pointer e);
+void s7_set_object_print_readably(int type, char *(*printer)(s7_scheme *sc, void *val));
+
/* These functions create a new Scheme object type. There is a simple example in s7.html.
*
* s7_new_type describes the type for Scheme:
@@ -734,60 +638,96 @@ void s7_mark_object(s7_pointer p);
*/
-#if HAVE_PTHREADS
- bool s7_is_thread(s7_pointer obj);
- pthread_t *s7_thread(s7_pointer obj);
- s7_pointer s7_make_thread(s7_scheme *sc, void *(*func)(void *obj), void *data, bool local);
- s7_scheme *s7_thread_s7(s7_pointer obj);
- void *s7_thread_data(s7_pointer obj);
- bool s7_is_lock(s7_pointer obj);
- s7_pointer s7_make_lock(s7_scheme *sc);
- pthread_mutex_t *s7_lock(s7_pointer obj);
- bool s7_is_thread_variable(s7_pointer obj);
- s7_pointer s7_thread_variable(s7_scheme *sc, s7_pointer obj);
-
-/* Threads in s7 share the heap and symbol table, but have their own local environment, stack,
- * and evaluator locals. The thread_variable functions above refer to thread-local variables
- * known as "keys" in pthreads. The "lock" functions refer to mutexes. snd-listener.c
- * in the Snd package has example code that would work if the GUI functions were thread-safe.
- *
- * s7_make_thread returns a new s7 evaluator (a clone of the main one), running in its own
- * thread (see s7_thread). The function running in that thread is 'func',
- * its user-specified data is 'data' (see s7_thread_data), and 'local' determines whether
- * the thread's Scheme interpreter is sequestered in its own local environment. If 'local'
- * is true, a top-level 'define' in the Scheme code affects only the current thread.
- *
- * s7_is_thread returns true if its argument is an s7 thread (from s7_make_thread).
- * s7_thread returns the pthread_t* value that the s7 thread is running in.
- * s7_thread_data returns the void* pointer that s7_make_thread received as its 'data' argument.
- * s7_thread_s7 returns the s7 interpreter running in the given s7 thread object.
- *
- * s7_make_lock returns a new lock (a mutex).
- * s7_is_lock return true if its argument is an s7 lock.
- * s7_lock returns the pthread_mutex_t* value held by the s7 lock.
- *
- * s7_is_thread_variable returns true if its argument is an s7 thread-variable.
- * s7_thread_variable_value returns the current thread's value for that key (a Scheme object).
- *
- * In Scheme,
- *
- * (thread? obj) returns #t if 'obj' is a thread object
- * (make-thread thunk) creates a thread that will evaluate 'thunk' (a function with no args)
- * (join-thread thread) causes the current thread to wait for 'thread' to finish
- *
- * (lock? obj) returns #t if 'obj' is a lock (a mutex in pthread jargon)
- * (make-lock) creates a new lock and initializes it (pthread_mutex_init)
- * (grab-lock lock) pthread_mutex_lock
- * (release-lock lock) pthread_mutex_unlock
- *
- * (thread-variable? obj) returns #t if 'obj' is a key
- * (make-thread-variable) returns a new key (pthread_key_create)
- * thereafter (obj) returns the current thread's value for that key (pthread_getspecific), and
- * (set! (obj) value) sets its value (pthread_setspecific)
- *
- * see with-threaded-sound in ws.scm or sndlib-ws.scm for an example.
- */
-#endif
+void s7_autoload_set_names(s7_scheme *sc, const char **names, int size);
+
+s7_pointer s7_copy(s7_scheme *sc, s7_pointer args);
+s7_pointer s7_fill(s7_scheme *sc, s7_pointer args);
+
+
+ /* these are aimed at the CLM optimizer -- they change daily! */
+typedef s7_double (*s7_rf_t)(s7_scheme *sc, s7_pointer **p);
+typedef s7_rf_t (*s7_rp_t)(s7_scheme *sc, s7_pointer expr);
+void s7_rf_set_function(s7_pointer f, s7_rp_t rp);
+s7_rp_t s7_rf_function(s7_scheme *sc, s7_pointer func);
+s7_rf_t s7_rf_1(s7_scheme *sc, s7_pointer expr, s7_rf_t r, s7_rf_t s, s7_rf_t x);
+s7_rf_t s7_rf_2(s7_scheme *sc, s7_pointer expr, s7_rf_t rr, s7_rf_t sr, s7_rf_t xr, s7_rf_t rs, s7_rf_t ss, s7_rf_t xs, s7_rf_t rx, s7_rf_t sx, s7_rf_t xx);
+
+typedef s7_int (*s7_if_t)(s7_scheme *sc, s7_pointer **p);
+typedef s7_if_t (*s7_ip_t)(s7_scheme *sc, s7_pointer expr);
+void s7_if_set_function(s7_pointer f, s7_ip_t rp);
+s7_ip_t s7_if_function(s7_scheme *sc, s7_pointer func);
+
+typedef s7_pointer (*s7_pf_t)(s7_scheme *sc, s7_pointer **p);
+typedef s7_pf_t (*s7_pp_t)(s7_scheme *sc, s7_pointer expr);
+void s7_pf_set_function(s7_pointer f, s7_pp_t rp);
+s7_pp_t s7_pf_function(s7_scheme *sc, s7_pointer func);
+
+void s7_gf_set_function(s7_pointer f, s7_pp_t gp);
+s7_pp_t s7_gf_function(s7_scheme *sc, s7_pointer func);
+
+void *s7_xf_new(s7_scheme *sc, s7_pointer e);
+void s7_xf_free(s7_scheme *sc);
+s7_int s7_xf_store(s7_scheme *sc, s7_pointer val);
+void s7_xf_store_at(s7_scheme *sc, s7_int index, s7_pointer val);
+void *s7_xf_detach(s7_scheme *sc);
+void s7_xf_attach(s7_scheme *sc, void *ur);
+s7_pointer *s7_xf_start(s7_scheme *sc);
+s7_pointer *s7_xf_top(s7_scheme *sc, void *ur);
+bool s7_xf_is_stepper(s7_scheme *sc, s7_pointer sym);
+
+bool s7_arg_to_gf(s7_scheme *sc, s7_pointer a1);
+bool s7_arg_to_pf(s7_scheme *sc, s7_pointer a1);
+bool s7_arg_to_if(s7_scheme *sc, s7_pointer a1);
+bool s7_arg_to_rf(s7_scheme *sc, s7_pointer a1);
+
+s7_int s7_slot_integer_value(s7_pointer slot);
+bool s7_is_stepper(s7_pointer p);
+s7_double s7_slot_real_value(s7_scheme *sc, s7_pointer slot, const char *caller);
+void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value);
+
+void s7_object_type_set_xf(int tag, s7_ip_t ip, s7_ip_t set_ip, s7_rp_t rp, s7_rp_t set_rp);
+void s7_object_type_set_direct(int tag,
+ s7_pointer (*dref)(s7_scheme *sc, s7_pointer obj, s7_int index),
+ s7_pointer (*dset)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val));
+/* end CLM stuff */
+
+
+ /* this is experimental */
+s7_pointer s7_apply_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1));
+s7_pointer s7_apply_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2));
+s7_pointer s7_apply_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3));
+s7_pointer s7_apply_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4));
+s7_pointer s7_apply_5(s7_scheme *sc, s7_pointer args, s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5));
+s7_pointer s7_apply_6(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6));
+s7_pointer s7_apply_7(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7));
+s7_pointer s7_apply_8(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8));
+s7_pointer s7_apply_9(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8, s7_pointer a9));
+
+s7_pointer s7_apply_n_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1));
+s7_pointer s7_apply_n_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2));
+s7_pointer s7_apply_n_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3));
+s7_pointer s7_apply_n_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4));
+s7_pointer s7_apply_n_5(s7_scheme *sc, s7_pointer args, s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5));
+s7_pointer s7_apply_n_6(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6));
+s7_pointer s7_apply_n_7(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7));
+s7_pointer s7_apply_n_8(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8));
+s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args,
+ s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4,
+ s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8, s7_pointer a9));
#if WITH_GMP
#include <gmp.h>
@@ -813,47 +753,123 @@ void s7_mark_object(s7_pointer p);
#endif
-
-#if (!S7_DISABLE_DEPRECATED)
-#define s7_F(Sc) s7_f(Sc)
-#define s7_T(Sc) s7_t(Sc)
-#define s7_NIL(Sc) s7_nil(Sc)
-#define s7_UNDEFINED(Sc) s7_undefined(Sc)
+#if (!DISABLE_DEPRECATED)
+/* cm uses this: */
#define s7_UNSPECIFIED(Sc) s7_unspecified(Sc)
-#define s7_EOF_OBJECT(Sc) s7_eof_object(Sc)
+#define s7_NIL(Sc) s7_nil(Sc)
+#define s7_is_procedure_with_setter s7_is_dilambda
+#define s7_make_procedure_with_setter s7_dilambda
+
+#define s7_define_integer_function s7_define_safe_function
+#define s7_make_random_state s7_random_state
#endif
-/* the following Scheme functions are not currently exported to C:
- *
- * * + - / < <= = > >= abs acos acosh angle ash asin asinh assq assv atan atanh
- * augment-environment! caaaar caaadr caaar caadar caaddr caadr caar cadaar cadadr
- * cadar caddar cadddr caddr cadr call-with-exit call-with-input-file call-with-input-string
- * call-with-output-file call-with-output-string catch cdaaar cdaadr cdaar cdadar cdaddr
- * cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr ceiling char->integer char-alphabetic?
- * char-ci<=? char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase char-lower-case?
- * char-numeric? char-ready? char-upcase char-upper-case? char-whitespace? char<=? char<?
- * char=? char>=? char>? copy cos cosh dynamic-wind environment? eof-object? eval even?
- * exact->inexact exp expt fill! floor for-each gcd hash-table hash-table-size help
- * hook inexact->exact infinite? initial-environment integer->char integer-decode-float
- * integer-length keyword->symbol lcm list list->string list->vector list-tail log logand
- * logior lognot logxor magnitude make-hash-table-iterator make-list make-polar make-random-state
- * make-rectangular map max memq memv min modulo nan? negative? not null? odd? port-closed?
- * port-line-number positive? provided? quotient read-byte read-line remainder round s7-version
- * sin sinh sort! sqrt string string->list string->number string-append string-ci<=? string-ci<?
- * string-ci=? string-ci>=? string-ci>? string-copy string-fill! string-length string-ref
- * string-set! string<=? string<? string=? string>=? string>? substring symbol symbol->keyword
- * symbol-table tan tanh trace truncate untrace vector vector->list with-input-from-file
- * with-input-from-string with-output-to-file with-output-to-string write-byte zero?
- *
- * and these variables: *safety* *#readers* *error-hook* *unbound-variable-hook* *trace-hook*
- *
- * if you need any of these, let me know.
- */
+
/* --------------------------------------------------------------------------------
*
* s7 changes
*
+ * 6-Nov: removed :key and :optional.
+ * 16-Oct: s7_make_random_state -> s7_random_state.
+ * 16-Aug: remove s7_define_integer_function, s7_function_set_removes_temp,
+ * add s7_define_typed_function, s7_make_signature.
+ * 5-Aug: added s7_scheme* arg to s7_openlet and s7_outlet.
+ * 3-Jul: s7_Double -> s7_double, s7_Int -> s7_int. Removed function_chooser_data.
+ * 27-Jun: s7_rf_t, s7_rp_t etc.
+ * 19-Jun: removed the ex_parser stuff, set_step_safe, s7_ex_fallback.
+ * 5-May: s7_make_iterator and friends.
+ * 16-Apr: added s7_fill, changed arg interpretation of s7_copy, s7_dynamic_wind.
+ * 30-Mar: s7_eval_c_string_with_environment (repl experiment).
+ * 19-Mar: repl.scm.
+ * 28-Feb: s7_vector_print_length -> s7_print_length, set case also.
+ * 25-Feb: s7_closure_* funcs to replace clumsy (deprecated) s7_procedure_source.
+ * 29-Jan: changed args to s7_new_type_x (added s7_scheme arg, fill! takes s7_function).
+ * 14-Jan-15: make-iterator, iterator?
+ * --------
+ * 26-Dec: s7_arity replaces s7_procedure_arity. s7_define_integer_function. deprecate s7_procedure_name.
+ * 5-Nov: s7_shadow_rootlet and s7_set_shadow_rootlet.
+ * 30-Aug: s7_make_safe_function (for cload.scm).
+ * 25-July: define and friends now return the value, not the symbol.
+ * procedure_with_setter -> dilambda.
+ * environment -> let. All the replaced names are deprecated.
+ * 30-June: s7_method.
+ * 16-June: remove unoptimize and s7_unoptimize.
+ * 14-May: s7_define_safe_function_star. Removed s7_catch_all.
+ * 22-Apr: remove s7_apply_n_10, s7_is_valid_pointer, s7_keyword_eq_p.
+ * 5-Mar-14: s7_heap_size, s7_gc_freed.
+ * --------
+ * 8-Nov: s7_symbol_documentation, s7_define_constant_with_documentation.
+ * 17-Oct: bignum-precision (procedure-with-setter) is now an integer variable named *bignum-precision*.
+ * 28-Aug: s7_int|float_vector_elements (homogenous vectors), libc.scm.
+ * 16-Aug: ~W directive in format, make-shared-vector.
+ * 23-Jul: s7_autoload_set_names, libm.scm, libdl.scm, libgdbm.scm, r7rs.scm, s7libtest.scm.
+ * 21-Jul: s7_is_valid (replaces deprecated s7_is_valid_pointer).
+ * 24-Jun: some bool-related changes for Windows Visual C++, including change to s7_begin_hook.
+ * 3-June: s7_autoload.
+ * 28-May: export s7_is_provided. Added s7_scheme* arg to s7_procedure_environment.
+ * 21-May: equality predicate optional arg in make-hash-table.
+ * 14-May: glistener.c, glistener.h, s7_symbol_table_find_name (for glistener).
+ * 2-May: r7rs changes: flush-output-port, vector-append, read|write-string, boolean=?, symbol=?.
+ * start/end args for string-fill!, vector-fill!, string->list, vector->list, and copy.
+ * exit, emergency-exit.
+ * 7-Apr: removed s7_scheme* arg from s7_slot_value, added s7_is_local_variable.
+ * 25-Mar: char-position, string-position, environment-ref, environment-set! added to the scheme side.
+ * 9-Jan-13: s7_cos, s7_sin, other optimization changes.
+ * --------
+ * 24-Dec: s7_set_object_array_info and other such changes.
+ * 20-Nov: removed s7_set_error_exiter and s7_error_and_exit which I think have never been used.
+ * 22-Oct: changed args to s7_function_class and s7_function_set_class.
+ * 22-Aug: symbol->dynamic-value.
+ * 10-Aug: exported s7_outer_environment.
+ * 6-Aug: removed WITH_OPTIMIZATION.
+ * 25-July: environment (in scheme). s7_vector_ref_n and s7_vector_set_n. s7_copy.
+ * added s7_scheme arg to s7_number_to_real|integer.
+ * 16-July: s7_function_returns_temp (an experiment).
+ * 2-July: s7_object_set_* functions.
+ * 11-June: throw.
+ * 4-June. s7_object_environment.
+ * 31-May: added s7_scheme argument to all the optimizer chooser functions.
+ * 24-May: open-environment?
+ * 17-May: arity, aritable?
+ * removed trace and untrace.
+ * 14-May: s7_list. s7_procedure_set_setter. Removed s7_procedure_getter.
+ * procedure-setter is settable: removed most of procedure-with-setter.
+ * make-type replaced by open-environment.
+ * 11-May: s7 2.0: hook implementation changed completely.
+ * s7_environment_ref|set.
+ * 4-May: *error-info* replaced by error-environment, and stacktrace has changed.
+ * 22-Apr: #_<name> = startup (built-in) value of name
+ * 17-Apr: with-baffle.
+ * 14-Apr: WITH_SYSTEM_EXTRAS (default 0) has additional OS and IO functions:
+ * directory? file-exists? delete-file getenv directory->list system
+ * 26-Mar: "@" as exponent, WITH_AT_SIGN_AS_EXPONENT switch (default is 1).
+ * 18-Mar: removed *trace-hook*.
+ * 6-Feb: random-state?, hash-table-iterator?, and morally-equal?
+ * 18-Jan: s7_environment_to_list and environment->list return just the local environment's bindings.
+ * outer-environment returns the environment enclosing its argument (an environment).
+ * environments are now applicable objects.
+ * added the object system example to s7.html.
+ * 12-Jan: added reverse argument to s7_new_type_x. This is needed because an object might implement
+ * the apply and set methods, but they might refer to different things.
+ * 6-Jan-12: added (scheme side) logbit?.
+ * --------
+ * 21-Dec: s7_eval, s7_make_slot, s7_slot_set_value.
+ * changed s7_symbol_slot to s7_slot, and s7_symbol_slot_value to s7_slot_value.
+ * 26-Oct: s7_procedure_name.
+ * 6-Oct: changed s7_make_closure args: split the code argument in two (args and body).
+ * s7_make_closure(... code ...) is now s7_make_closure(... car(code), cdr(code) ...)
+ * s7_is_environment.
+ * 19-Aug: s7_function_chooser_data.
+ * 11-Aug: s7_symbol_accessor functions. s7_cxxxxr.
+ * 9-Aug: s7_function_chooser, s7_function_choice, s7_function_choice_set_direct.
+ * 20-Jul: s7_function_class, s7_function_set_class, and s7_function_set_chooser.
+ * 14-Jul: removed thread and profiling support.
+ * 5-June: s7_define_safe_function and s7_unoptimize exported; added unoptimize function in scheme.
+ * 30-May: environment->list and s7_environment_to_list since environments are no longer alists internally.
+ * 26-May: added s7_scheme argument to s7_procedure_setter and getter (old names had "with_setter_").
+ * 28-Apr: s7_help.
+ * 5-Apr: pair-line-number.
* 14-Mar: s7_make_random_state, optional state argument to s7_random, random-state->list, s7_random_state_to_list.
* 10-Feb: s7_vector_print_length, s7_set_vector_print_length.
* 7-Feb: s7_begin_hook, s7_set_begin_hook.
@@ -867,7 +883,7 @@ void s7_mark_object(s7_pointer p);
* --------
* 17-Dec: removed unquote-splicing; replaced by (unquote (apply values ...)).
* 12-Dec: environment?
- * 7-Dec: member and assoc have an optional 3rd arg, the comparison function.
+ * 7-Dec: member and assoc have an optional third arg, the comparison function.
* 1-Dec: *gc-stats* in Scheme, s7_gc_stats in C.
* gmp and gtk-repl examples in s7.html.
* 21-Nov: Load C module example in s7.html.
@@ -931,7 +947,7 @@ void s7_mark_object(s7_pointer p);
* 7-Sep: s7_open_input_function. with-environment. receive.
* 3-Sep: s7.html, s7-slib-init.scm.
* s7_stacktrace in s7.h.
- * 27-Aug: vector and hash-table sizes are now s7_Ints, rather than ints.
+ * 27-Aug: vector and hash-table sizes are now s7_ints, rather than ints.
* 20-Aug: s7_remove_from_heap.
* 17-Aug: *error-info*.
* 14-Aug: define-expansion.
@@ -948,7 +964,6 @@ void s7_mark_object(s7_pointer p);
* 23-Jul: __func__.
* 20-Jul: trace and untrace.
* 14-Jul: replaced s7_make_closure_star with s7_define_function_star.
- * profiling added on WITH_PROFILING switch (symbol-calls).
* 29-Jun: s7_format declaration.
* 12-May: s7_is_constant.
* 20-Apr: changed rationalize to be both r5rs-acceptable and fast.
diff --git a/s7.html b/s7.html
index dca6564..fa23b97 100644
--- a/s7.html
+++ b/s7.html
@@ -1,40 +1,148 @@
-<html>
+<!DOCTYPE html>
+
+<html lang="en">
<!-- documentation for s7 -->
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
+
<title>s7</title>
+
<style type="text/css">
-<!--
EM.red {color:red; font-style:normal}
+ EM.normal {font-style:normal}
+ EM.redb {color:red; font-weight: bold; font-style: normal}
EM.error {color:chocolate; font-style:normal}
- EM.typing {color:maroon; font-style: normal}
- EM.listener {color:darkblue; font-style: normal}
EM.emdef {font-weight: bold; font-style: normal}
+ EM.green {color:green; font-style:normal}
+ EM.gray {color:#505050; font-style:normal}
+ EM.big {font-size: 20px;
+ font-style: normal;
+ }
+ EM.bigger {font-size: 30px;
+ font-style: normal;
+ }
+ EM.def {font-style: normal}
+
H1 {text-align: center}
UL {list-style-type: none}
A {text-decoration:none}
A:hover {text-decoration:underline}
- A.quiet {color:black; text-decoration:none}
- A.quiet:hover {text-decoration:underline}
- A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black}
-
- EM.green {color:green; font-style:normal}
--->
+ A.def {font-weight: bold;
+ font-style: normal;
+ text-decoration:none;
+ text-color:black;
+ }
+
+ PRE.indented {padding-left: 1.0cm;}
+
+ DIV.indented {background-color: #F8F8F0;
+ padding-left: 0.5cm;
+ padding-right: 0.5cm;
+ padding-top: 0.5cm;
+ padding-bottom: 0.5cm;
+ margin-bottom: 0.5cm;
+ border: 1px solid gray;
+ border-radius: 20px;
+ -moz-border-radius: 20px;
+ -webkit-border-radius: 20px;
+ }
+
+ DIV.header {margin-top: 60px;
+ margin-bottom: 30px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #eefdee; /* lightgreen */
+ padding-left: 30px;
+ }
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.separator {margin-top: 30px;
+ margin-bottom: 10px;
+ border: 2px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ padding-top: 4px;
+ width: 30%;
+ border-radius: 4px;
+ -moz-border-radius: 4px;
+ -webkit-border-radius: 4px;
+ }
+
+ DIV.bluishbordered {background-color: #f2f4ff;
+ border: 1px solid #000000;
+ padding-left: 10px;
+ padding-right: 10px;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.brownishbordered {background-color: #fbfbf0;
+ border: 1px solid #000000;
+ padding-left: 10px;
+ padding-right: 10px;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ BODY.body {background-color: #ffffff; /* white */
+ margin-right: 20px;
+ margin-left: 20px;
+ }
+ DIV.orange {background-color: #ffa500; /* orange */
+ padding-left: 6px;
+ padding-right: 6px;
+ padding-top: 4px;
+ padding-bottom: 4px;
+ border: 4px solid #000000;
+ font-family: 'Helvetica';
+ font-size: 12px;
+ font-weight: bold;
+ text-align: center;
+ margin-left: 0.5cm;
+ margin-right: 1.0cm;
+ float: right;
+ border-radius: 8px;
+ -moz-border-radius: 8px;
+ -webkit-border-radius: 8px;
+ }
+ DIV.listener {background-color: #f0f8ff;
+ font-family: 'Monospace';
+ padding-left: 6px;
+ padding-right: 6px;
+ padding-bottom: 4px;
+ margin-left: 1.0cm;
+ margin-right: 4.0cm;
+ border: 2px solid #a0a0a0;
+ }
+ LI.li_header {padding-top: 20px;}
+
+ SUMMARY.indented {background-color: #F8F8F0;
+ padding-top: 8px;
+ padding-bottom: 8px;
+ margin-bottom: 0.5cm;
+ border: 1px solid gray;
+ text-align: center;
+ width: 30%;
+ border-radius: 8px;
+ -moz-border-radius: 8px;
+ -webkit-border-radius: 8px;
+ }
</style>
</head>
-<body bgcolor=white>
+<body class="body">
<!-- INDEX s7doc:s7 scheme -->
-<br>
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="s7doc"></a>
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>s7</h2></td></tr></table>
-</td></tr></table>
+<div class="topheader" id="s7doc">s7
+</div>
<p>s7 is a Scheme implementation intended as an extension language
@@ -51,17 +159,17 @@ s7 is the default extension language of Snd and sndlib (http://ccrma.stanford.ed
and Rick Taube's Common Music (commonmusic at sourceforge). There are X, Motif, Gtk, and openGL bindings
in libxm in the Snd tarball, or at ftp://ccrma-ftp.stanford.edu/pub/Lisp/libxm.tar.gz.
If you're running s7 in a context
-that has getenv, file-exists?, and system (Snd for example), you can use s7-slib-init.scm
+that has getenv, file-exists?, and system, you can use s7-slib-init.scm
to gain easy access to slib. This init file is named "s7.init" in the slib distribution.
</p>
<p>Although it is a descendant of tinyScheme, s7 is closest as a Scheme dialect to Guile 1.8.
-I believe it is compatible with r5rs: you can just ignore all the additions discussed in this file.
+I believe it is compatible with <a href="#s7vsr5rs">r5rs</a> and <a href="#r7rs">r7rs</a>: you can just ignore all the additions discussed in this file.
It has continuations,
ratios, complex numbers,
macros, keywords, hash-tables,
-threads, multiprecision arithmetic,
-generalized set!, and so on.
+multiprecision arithmetic,
+generalized set!, unicode, and so on.
It does not have syntax-rules or any of
its friends, and it does not think there is any such thing
as an inexact integer.
@@ -69,185 +177,202 @@ as an inexact integer.
<p>This file assumes you know about Scheme and all its problems,
and want a quick tour of where s7 is different. (Well, it was quick once upon a time).
+The main difference: if it's in s7, it's a first-class citizen of s7, and that includes
+macros, environments, and syntactic forms.
+</p>
+
+<br>
+<blockquote>
+<div class="indented">
+<p>I originally used a small font for scholia, but now I have to squint
+to read that tiny text, so less-than-vital commentaries are shown in the normal font, but
+indented and on a sort of brownish background.
</p>
+</div>
+</blockquote>
+<br>
+
+<!--
+<div class="orange">
+<p>Danger!</p>
+<p>Men Working</p>
+<p>in Trees</p>
+</div>
+-->
<ul>
- <li><a href="#multiprecision">multiprecision arithmetic</a>
+ <li><a href="#multiprecision">arbitrary precision arithmetic</a>
<li><a href="#math">math functions</a>
- <li><a href="#define*">define*</a>
+ <li><a href="#define*">define*, named let*</a>
<li><a href="#macros">define-macro</a>
- <li><a href="#constants">define-constant, symbol-access</a>
- <li><a href="#maketype1">make-type</a>
- <li><a href="#pws">procedure-with-setter</a>
+ <li><a href="#pws">procedure-setter</a>
<li><a href="#generalizedset">generalized set!</a>
<li><a href="#multidimensionalvectors">multidimensional vectors</a>
<li><a href="#hashtables">hash tables</a>
- <li><a href="#hooks">hooks</a>
- <li><a href="#multithreading">multithreading</a>
+ <li><a href="#environments">environments</a>
<li><a href="#multiplevalues">multiple-values</a>
<li><a href="#callwithexit1">call-with-exit</a>
<li><a href="#format1">format</a>
- <li><a href="#errors">errors, stacktrace, trace</a>
+ <li><a href="#hooks">hooks</a>
<li><a href="#procedureinfo">procedure info</a>
- <li><a href="#environments">environments</a>
<li><a href="#evalstring">eval</a>
- <li><a href="#IO">string IO</a>
- <li><a href="#miscellanea">miscellanea</a>
- <li><a href="#s7rundoc">the run macro</a>
- <li><a href="#FFIexamples">FFI examples</a>
+ <li><a href="#IO">IO and other OS functions</a>
+ <li><a href="#errors">errors</a>
+ <li><a href="#autoload">autoload</a>
+ <li><a href="#constants">define-constant, symbol-access</a>
+ <li><a href="#miscellanea">marvels and curiousities:</a>
+
+ <ul>
+ <li><a href="#loadpath">*load-path*</a>, <a href="#featureslist">*features*</a>, <a href="#sharpreaders">*#readers*</a>,
+ <li><a href="#makelist">make-list</a>, <a href="#charposition">char-position</a>, <a href="#keywords">keywords</a>
+ <li><a href="#symboltable">symbol-table</a>, <a href="#s7help">help</a>, <a href="#s7gc">gc</a>, <a href="#morallyequalp">morally-equal?</a>
+ <li><a href="#expansion">define-expansion</a>, <a href="#s7env">*s7*</a>, <a href="#s7vsr5rs">r5rs</a>, <a href="#r7rs">r7rs</a>,
+ <li><a href="#circle">circular lists</a>, <a href="#legolambda">legolambda</a>, etc...
+ </ul>
+
+ <li class="li_header"><a href="#FFIexamples">FFI examples</a>
<ul>
<li><a href="#repl">read-eval-print loop (and emacs)</a>
<li><a href="#defun">define a function with arguments and a returned value, and define a variable </a>
<li><a href="#defvar">call a Scheme function from C, and get/set Scheme variable values in C</a>
<li><a href="#juce">C++ and Juce</a>
- <li><a href="#sndlib">load sndlib using the XEN functions and macros</a>
- <li><a href="#pwstype">add a new Scheme type and a procedure-with-setter</a>
+ <li><a href="#sndlib">load sndlib using the Xen functions and macros</a>
+ <li><a href="#pwstype">add a new Scheme type and a procedure with a setter</a>
<li><a href="#functionportexample">redirect display output to a C procedure</a>
<li><a href="#extendop">extend a built-in operator ("+" in this case)</a>
<li><a href="#definestar1">C-side define* (s7_define_function_star)</a>
<li><a href="#definemacro1">C-side define-macro (s7_define_macro)</a>
+ <li><a href="#definegeneric">define a generic function in C</a>
<li><a href="#signal">signal handling (C-C to break out of an infinite loop)</a>
<li><a href="#vector">direct multidimensional vector element access</a>
<li><a href="#notify">notification in C that a Scheme variable has been set!</a>
<li><a href="#namespace">Load C defined stuff into a separate namespace</a>
<li><a href="#Cerrors">Error handling in C</a>
- <li><a href="#closure">Closure defined in C</a>
<li><a href="#testhook">Hooks in C and Scheme</a>
- <li><a href="#cload">Load a C module dynamically</a>
+ <li><a href="#dload">Load a C module dynamically</a>
<li><a href="#gmpex">gmp and friends</a>
- <li><a href="#gtkrepl">Gtk-based REPL</a>
- <li><a href="#gtkschemerepl">Gtk/Scheme-based REPL</a>
- <li><a href="#s7inathread">s7 running in a separate thread</a>
- <li><a href="#replrescue">begin_hook to the rescue!</a>
+ <li><a href="#glistener">glistener.c</a>
+ <li><a href="#gdb">gdb</a>
+ </ul>
+
+ <li class="li_header"><a href="#s7examples">s7 examples</a>
+ <ul>
+ <li><a href="#lint">lint.scm</a>
+ <li><a href="#cload">cload.scm</a>
+ <ul>
+ <li><a href="#libc">libc</a>
+ <li><a href="#libgsl">libgsl</a>
+ <li><a href="#libgdbm">libgdbm</a>
+ </ul>
+ <li><a href="#schemerepl">repl.scm</a>
</ul>
</ul>
-<br>
-<dl>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="multiprecision"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>multiprecision arithmetic</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<div class="header" id="multiprecision"><h4>multiprecision arithmetic</h4></div>
-<dd>
<p>All numeric types, integers, ratios, reals, and complex numbers are supported.
The basic integer and real
types are defined in s7.h, defaulting to long long int and double.
+A ratio consists of two integers, a complex number two reals.
pi is predefined, as are
most-positive-fixnum and most-negative-fixnum.
s7 can be built with multiprecision support
for all types, using the gmp, mpfr, and mpc libraries (set WITH_GMP to 1 in s7.c).
If multiprecision arithmetic is
-enabled, the following functions are included: bignum, bignum?, and bignum-precision.
-<a name="bignumprecision">bignum-precision</a>, which defaults to 128, sets the number of bits each float takes.
-pi automatically reflects the current bignum-precision:
+enabled, the following functions are included: bignum, and bignum?, and the variable (*s7* 'bignum-precision).
+(*s7* 'bignum-precision) defaults to 128; it sets the number of bits each float takes.
+pi automatically reflects the current (*s7* 'bignum-precision):
</p>
-<pre>
+<pre class="indented">
> pi
-3.141592653589793238462643383279502884195E0
-
-> (bignum-precision)
-128
-
-> (set! (bignum-precision) 256)
-256
-
+<em class="gray">3.141592653589793238462643383279502884195E0</em>
+> (*s7* 'bignum-precision)
+<em class="gray">128</em>
+> (set! (*s7* 'bignum-precision) 256)
+<em class="gray">256</em>
> pi
-3.141592653589793238462643383279502884197169399375105820974944592307816406286198E0
+<em class="gray">3.141592653589793238462643383279502884197169399375105820974944592307816406286198E0</em>
</pre>
<p>
-<a name="bignump">bignum?</a> returns #t if its argument is a big number of some type; I use "bignum"
+<em class=def id="bignump">bignum?</em> returns #t if its argument is a big number of some type; I use "bignum"
for any big number, not just integers. To create a big number,
-either include enough digits to overflow the default types, or use the <a name="bignum">bignum</a> function.
+either include enough digits to overflow the default types, or use the <em class=def id="bignum">bignum</em> function.
Its argument is a string representing the desired number:
</p>
-<pre>
+<pre class="indented">
> (bignum "123456789123456789")
-123456789123456789
-
+<em class="gray">123456789123456789</em>
> (bignum "1.123123123123123123123123123")
-1.12312312312312312312312312300000000009E0
+<em class="gray">1.12312312312312312312312312300000000009E0</em>
</pre>
-<small>
-<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<blockquote>
+<div class="indented">
-<p>In the non-gmp case, if s7 is built using doubles (s7_Double in s7.h), the float "epsilon" is
-around (expt 2 -53), or about 1e-16. In the gmp case, it is around (expt 2 (- (bignum-precision))).
+<p>In the non-gmp case, if s7 is built using doubles (s7_double in s7.h), the float "epsilon" is
+around (expt 2 -53), or about 1e-16. In the gmp case, it is around (expt 2 (- (*s7* 'bignum-precision))).
So in the default case (precision = 128), using gmp:
</p>
-<pre>
+<pre class="indented">
> (= 1.0 (+ 1.0 (expt 2.0 -128)))
-#t
+<em class="gray">#t</em>
> (= 1.0 (+ 1.0 (expt 2.0 -127)))
-#f
+<em class="gray">#f</em>
</pre>
<p>and in the non-gmp case:
</p>
-<pre>
+<pre class="indented">
> (= 1.0 (+ 1.0 (expt 2 -53)))
-#t
+<em class="gray">#t</em>
> (= 1.0 (+ 1.0 (expt 2 -52)))
-#f
+<em class="gray">#f</em>
</pre>
<p>In the gmp case, integers and ratios are limited only by the size of memory,
-but reals are limited by bignum-precision. This means, for example, that
+but reals are limited by (*s7* 'bignum-precision). This means, for example, that
</p>
-<pre>
-> (floor 1e56) ; bignum-precision is 128
-99999999999999999999999999999999999999927942405962072064
-> (set! (bignum-precision) 256)
-256
+<pre class="indented">
+> (floor 1e56) ; (*s7* 'bignum-precision) is 128
+<em class="gray">99999999999999999999999999999999999999927942405962072064</em>
+> (set! (*s7* 'bignum-precision) 256)
+<em class="gray">256</em>
> (floor 1e56)
-100000000000000000000000000000000000000000000000000000000
+<em class="gray">100000000000000000000000000000000000000000000000000000000</em>
</pre>
<p>The non-gmp case is similar, but it's easy to find the edge cases:
</p>
-<pre>
+<pre class="indented">
> (floor (+ 0.9999999995 (expt 2.0 23)))
-8388609
+<em class="gray">8388609</em>
</pre>
-
+</div>
</blockquote>
-</small>
-</dd>
-<br><br>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="math"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>math functions</h4></td></tr></table>
-</td></tr></table>
-</dt>
-<dd><p>
+<div class="header" id="math"><h4>math functions</h4></div>
+
+
+<p>
s7 includes:
</p>
<ul>
<li>sinh, cosh, tanh, asinh, acosh, atanh
-<li>logior, logxor, logand, lognot, ash, integer-length, integer-decode-float
+<li>logior, logxor, logand, lognot, logbit?, ash, integer-length, integer-decode-float
<li>random
<li>nan?, infinite?
</ul>
@@ -262,82 +387,74 @@ Other math-related differences between s7 and r5rs:
<li>rational? and exact mean integer or ratio (i.e. not floating point), inexact means not exact.
<li>floor, ceiling, truncate, and round return (exact) integer results.
<li>"#" does not stand for an unknown digit.
-<li>the "@" complex number notation is not supported.
+<li>the "@" complex number notation is not supported ("@" is an exponent marker in s7).
<li>"+i" is not considered a number; include the real part.
<li>modulo, remainder, and quotient take integer, ratio, or real arguments.
<li>lcm and gcd can take integer or ratio arguments.
<li>log takes an optional second argument, the base.
<li>'.' and an exponent can occur in a number in any base.
<li>rationalize returns a ratio!
+<li>case is significant in numbers, as elsewhere: #b0 is 0, but #B0 is an error.
</ul>
-<pre>
+<pre class="indented">
> (exact? 1.0)
-#f
+<em class="gray">#f</em>
> (rational? 1.5)
-#f
+<em class="gray">#f</em>
> (floor 1.4)
-1
+<em class="gray">1</em>
> (remainder 2.4 1)
-0.4
+<em class="gray">0.4</em>
> (modulo 1.4 1.0)
-0.4
+<em class="gray">0.4</em>
> (lcm 3/4 1/6)
-3/2
+<em class="gray">3/2</em>
> (log 8 2)
-3
+<em class="gray">3</em>
> (number->string 0.5 2)
-"0.1"
+<em class="gray">"0.1"</em>
> (string->number "0.1" 2)
-0.5
+<em class="gray">0.5</em>
> (rationalize 1.5)
-3/2
-> (make-rectangular 1/2 0)
-1/2
+<em class="gray">3/2</em>
+> (complex 1/2 0)
+<em class="gray">1/2</em>
+> (logbit? 6 1) ; argument order, (logbit? int index), follows gmp, not CL
+<em class="gray">#t</em>
</pre>
-<small>
-<blockquote>
+<p>See <a href="#libgsl">cload and libgsl.scm</a> for easy access to GSL,
+and similarly libm.scm for the C math library.
+</p>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<blockquote>
+<div class="indented">
<p>The exponent itself is always in base 10; this follows gmp usage.
-Since Scheme uses "@" for its useless polar notation, s7 doesn't use it for the exponent marker, but that
+Scheme normally uses "@" for its useless polar notation, but that
means <code>(string->number "1e1" 16)</code> is ambiguous — is the "e" a digit or an exponent marker?
-s7 could perhaps substitute "s" in this case, but instead it just prohibits exponents if the
-radix is greater than 10.
+In s7, "@" is an exponent marker.
</p>
-<pre>
+<pre class="indented">
> (string->number "1e9" 2) ; (expt 2 9)
-512.0
+<em class="gray">512.0</em>
> (string->number "1e1" 12) ; "e" is not a digit in base 12
-#f
+<em class="gray">#f</em>
> (string->number "1e1" 16) ; (+ (* 1 16 16) (* 14 16) 1)
-481
+<em class="gray">481</em>
> (string->number "1.2e1" 3); (* 3 (+ 1 2/3))
-5.0
+<em class="gray">5.0</em>
</pre>
-
-<p>Perhaps s7 should use "@"!
-</p>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>Should s7 predefine the numbers +inf.0, -inf.0, and nan.0? It doesn't currently, but you can
-get them via log:
-</p>
-
-<pre>
-(define -inf.0 (real-part (log 0.0)))
-(define +inf.0 (- (real-part (log 0.0))))
-(define nan.0 (/ +inf.0 +inf.0))
-</pre>
-
-<p>But what is <code>(/ 1.0 0.0)</code>? s7 gives a "division by zero" error here, and also in <code>(/ 1 0)</code>.
+get them via log or 1/0 (see <a href="#r7rs">below</a>).
+But what is <code>(/ 1.0 0.0)</code>? s7 gives a "division by zero" error here, and also in <code>(/ 1 0)</code>.
Guile returns +inf.0 in the first case, which seems reasonable, but a "numerical overflow" error in the second.
Slightly weirder is <code>(expt 0.0 0+i)</code>. Currently s7 returns 0.0, Guile returns +nan.0+nan.0i,
Clisp and sbcl throw an error. Everybody agrees that <code>(expt 0 0)</code> is 1, and Guile thinks
@@ -347,65 +464,160 @@ and so on — what a mess! This mess was made a lot worse than it needs to
0.0 equals -0.0, so we can't tell them apart, but that they produce different results in nearly every use!
</p>
-<pre>
+<pre class="indented">
scheme@(guile-user)> (= -0.0 0.0)
-#t
+<em class="gray">#t</em>
scheme@(guile-user)> (negative? -0.0)
-#f
+<em class="gray">#f</em>
scheme@(guile-user)> (= (/ 1.0 0.0) (/ 1.0 -0.0))
-#f
+<em class="gray">#f</em>
scheme@(guile-user)> (< (/ 1.0 -0.0) -1e100 1e100 (/ 1.0 0.0))
-#t
+<em class="gray">#t</em>
</pre>
<p>
How can they be equal? In s7, the sign
of -0.0 is ignored, and they really are equal.
+One other oddity: two floats can satisfy eq? and yet not be eqv?:
+<code>(eq? nan.0 nan.0)</code> might be #t (it is unspecified), but <code>(eqv? nan.0 nan.0)</code> is #f.
+The same problem afflicts memq and assq.
</p>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
-<p>The <a name="random">random</a> function takes a range and an optional state, and returns a number
+<p>The <em class=def id="random">random</em> function takes a range and an optional state, and returns a number
between zero and the range, of the same type as the range. It is perfectly reasonable
to use a range of 0, in which case random returns 0.
-<a name="makerandomstate">make-random-state</a> creates a new random state from a seed. If no state is passed,
-random uses some default state initialized from the current time.
+<em class=def id="randomstate">random-state</em> creates a new random state from a seed. If no state is passed,
+random uses some default state initialized from the current time. <em class=def id="randomstatep">random-state?</em> returns #t if passed a random state object.
+s7 ought to have a function named random? that always returns #t.
</p>
-<pre>
+<pre class="indented">
> (random 0)
-0
+<em class="gray">0</em>
> (random 1.0)
-0.86331198514245
+<em class="gray">0.86331198514245</em>
> (random 3/4)
-654/1129
+<em class="gray">654/1129</em>
> (random 1+i)
-0.86300308872748+0.83601002730848i
+<em class="gray">0.86300308872748+0.83601002730848i</em>
> (random -1.0)
--0.037691127513267
-> (define r0 (make-random-state 1234))
-r0
+<em class="gray">-0.037691127513267</em>
+> (define r0 (random-state 1234))
+<em class="gray">r0</em>
> (random 100 r0)
-94
+<em class="gray">94</em>
> (random 100 r0)
-19
-> (define r1 (make-random-state 1234))
-r1
+<em class="gray">19</em>
+> (define r1 (random-state 1234))
+<em class="gray">r1</em>
> (random 100 r1)
-94
+<em class="gray">94</em>
> (random 100 r1)
-19
+<em class="gray">19</em>
</pre>
<p>copy the random-state to save a spot in a random number sequence, or save the random-state as a list via
-random-state->list, then to restart from that point, apply make-random-state to that list.
+random-state->list, then to restart from that point, apply random-state to that list.
+</p>
+</div>
+
+
+<div class="indented">
+
+<p>I can't find the right tone for this section; this is the 400-th revision; I wish I were a better writer!
+</p>
+
+<p>In some Schemes,
+"rational" means "could possibly be
+expressed equally well as a ratio: floats are approximations". In s7 it's: "is actually expressed (at the scheme level) as a ratio (or an integer of course)";
+otherwise "rational?" is the same as "real?":
+</p>
+
+<pre class="indented">
+(not-s7)> (rational? (sqrt 2))
+<em class="gray">#t</em>
+</pre>
+
+<p>That 1.0 is represented at the IEEE-float level as a sort of
+ratio does not mean it has to be a scheme ratio; the two notions are independent.
+</p>
+
+<p>But that confusion is trivial compared to the completely nutty "inexact integer".
+As I understand it, "inexact" originally meant "floating point", and "exact" meant integer or ratio of integers.
+But words have a life of their own.
+0.0 somehow became an "inexact" integer (although it can be represented exactly in floating
+point).
++inf.0 must be an integer —
+its fractional part is explicitly zero! But +nan.0...
+And then there's:
+</p>
+
+<pre class="indented">
+(not-s7)> (integer? 9007199254740993.1)
+<em class="gray">#t</em>
+</pre>
+
+<p>
+When does this matter? I often need to index into a vector, but the index is a float (a "real" in Scheme-speak: its
+fractional part can be non-zero).
+In one Scheme:
+</p>
+
+<pre class="indented">
+(not-s7)> (vector-ref #(0) (floor 0.1))
+<em class="gray">ERROR: Wrong type (expecting exact integer): 0.0 </em>; [why? "it's probably a programmer mistake"!]
+</pre>
+
+<p>Not to worry, I'll use inexact->exact:
</p>
+<pre class="indented">
+(not-s7)> (inexact->exact 0.1)
+<em class="gray">3602879701896397/36028797018963968 </em>; [why? "floats are ratios"!]
+</pre>
+
+<p>So I end up using the verbose <code>(floor (inexact->exact ...))</code> everywhere, and even
+then I have no guarantee that I'll get a legal vector index.
+I have never seen any use made of the exact/inexact distinction — just
+wild flailing to try get around it.
+I think the whole idea is confused and useless, and leads
+to verbose and buggy code.
+If we discard it,
+we can maintain backwards compatibility via:
+</p>
+
+<pre class="indented">
+(define exact? rational?)
+(define (inexact? x) (not (rational? x)))
+(define inexact->exact rationalize) ; or floor
+(define (exact->inexact x) (* x 1.0))
+</pre>
+
+<p>#i and #e are also useless because you can
+have any number after, for example, #b:
+</p>
+
+<pre class="indented">
+> #b1.1
+<em class="gray">1.5</em>
+> #b1e2
+<em class="gray">4.0</em>
+> #o17.5+i
+<em class="gray">15.625+1i</em>
+</pre>
+
+<p>Speaking of #b and friends, what should <code>(string->number "#xffff" 2)</code> return?
+</p>
+</div>
+
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<details>
+<summary class="indented">more examples</summary>
+<div class="indented">
<pre>
(define (log-n-of n . ints) ; return the bits on in exactly n of ints
@@ -423,35 +635,26 @@ random-state->list, then to restart from that point, apply make-random-state
(if (= i 0)
(set! 1s (logior 1s (logand cur (apply log-n-of (- n 1) (cdr ints)))))
(let* ((mid (cdr prev))
- (nxt (if (= i (- len 1)) '() (cdr mid))))
+ (nxt (if (= i (- len 1)) () (cdr mid))))
(set! (cdr prev) nxt)
(set! 1s (logior 1s (logand cur (apply log-n-of (- n 1) ints))))
(set! (cdr prev) mid)
(set! prev mid)))))))))
</pre>
-
-<!-- since set-cdr! is so useful, it's too bad we can't do something similar with any sequence:
- apply a function to a truncated portion of a sequence (a vector for example). Currently
- we'd need subvector->list; what about subvector/sublist? subsequence?
--->
+</div>
+</details>
</blockquote>
-</small>
-</dd>
-<br><br>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="define*"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>define*, lambda*</h4></td></tr></table>
-</td></tr></table>
-</dt>
-<dd><p><a name="definestar">define*</a> and <a name="lambdastar">lambda*</a>
-are extensions of define and lambda that make it easier to
+<div class="header" id="define*"><h4>define*, lambda*</h4></div>
+
+
+<p><em class=def id="definestar">define*</em> and
+ <em class=def id="lambdastar">lambda*</em>
+are extensions of define and lambda that make it easier
to deal with optional, keyword, and rest arguments.
The syntax is very simple: every argument to define* has a default value
and is automatically available as a keyword argument. The default value
@@ -460,127 +663,95 @@ the argument name.
The last argument
can be preceded by :rest or a dot to indicate that all other trailing arguments
should be packaged as a list under that argument's name. A trailing or rest
-argument's default value is '().
-You can use
-:optional and :key, but they are ignored.
+argument's default value is ().
</p>
-<pre>
+<pre class="indented">
(<em class=red>define*</em> (hi a (b 32) (c "hi")) (list a b c))
</pre>
<p>Here the argument "a" defaults to #f, "b" to 32, etc.
When the function is called,
-the argument names are bound to their default values, then the function's
-current argument list is scanned. Any name that occurs as a keyword, :arg for example where the parameter name is arg,
+the argument names are set from the values passed the function,
+then any unset arguments are bound to their default values, evaluated in left-to-right order.
+As the current argument list is scanned, any name that occurs as a keyword, :arg for example where the parameter name is arg,
sets that argument's new value. Otherwise, as values occur, they
are plugged into the actual argument list based on their position, counting a keyword/value pair as one argument.
This is called an optional-key list in CLM. So, taking the function
above as an example:
</p>
-<pre>
-(hi 1) -> '(1 32 "hi")
-(hi :b 2 :a 3) -> '(3 2 "hi")
-(hi 3 2 1) -> '(3 2 1)
+<pre class="indented">
+> (hi 1)
+<em class="gray">(1 32 "hi")</em>
+> (hi :b 2 :a 3)
+<em class="gray">(3 2 "hi")</em>
+> (hi 3 2 1)
+<em class="gray">(3 2 1)</em>
</pre>
<p>See s7test.scm for many examples.
</p>
-<pre>
-(<em class=red>define*</em> (make-parameter initial-value converter)
- (let ((value (if (procedure? converter) (converter initial-value) initial-value)))
- (<em class=red>lambda*</em> ((val #<unspecified>))
- (if (not (eq? val #<unspecified>))
- (set! value (if (procedure? converter) (converter val) val)))
- value)))
-
-> (define hiho (make-parameter 12))
-hiho
-> (hiho)
-12
-> (hiho 32)
-32
-> (hiho)
-32
-</pre>
-
-<small>
+
<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>If you want a version of define* that insists
-that any arguments before the keyword :optional are required:
+<div class="indented">
+<p>The combination of optional and keyword arguments is viewed with disfavor in the Lisp
+community, but the problem is in CL's implementation of the idea, not the idea itself.
+I've used the s7 style since around 1976, and have never found it confusing. The mistake
+in CL is to require the optional arguments if a keyword argument occurs, and to consider them as distinct from the
+keyword arguments. So everyone forgets and puts a keyword where CL expects a required-optional
+argument. CL then does something ridiculous, and the programmer stomps around shouting about keywords, but the fault lies with CL.
+If s7's way is considered too loose, one way to tighten it might be to insist that once a keyword
+is used, only keyword argument pairs can follow.
</p>
+</div>
-<pre>
-(define-macro (define** declarations . forms)
- (let ((name (car declarations))
- (args (cdr declarations)))
- (define (position thing lst count)
- (if (or (null? lst)
- (not (pair? (cdr lst)))) ; for dotted arg = "rest" arg
- #f
- (if (eq? thing (car lst))
- count
- (position thing (cdr lst) (+ count 1)))))
- (let ((required-args (position :optional args 0)))
- (if required-args
- `(define* (,name . func-args)
- (if (< (length func-args) ,required-args)
- (error "~A requires ~D argument~A: ~A"
- ',name ,required-args
- (if (> ,required-args 1) "s" "")
- func-args)
- (apply (lambda* ,args , at forms) func-args)))
- `(define* ,declarations , at forms)))))
-
-> (define** (hi a :optional (b 23)) (list a b))
-hi
-> (hi 1)
-(1 23)
-> (hi)
-;hi requires 1 argument: ()
-</pre>
-<!--
- perhaps if :optional occurs in the arglist, make the preceding ones required by changing the arity?
--->
+<div class="indented">
+<p>A natural companion of lambda* is named let*. In named let, the implicit function's
+arguments have initial values, but thereafter, each call requires the full set of arguments.
+Why not treat the initial values as default values?
+</p>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<pre class="indented">
+> (let* func ((i 1) (j 2))
+ (+ i j (if (> i 0) (func (- i 1)) 0)))
+<em class="gray">5</em>
+> (letrec ((func (lambda* ((i 1) (j 2))
+ (+ i j (if (> i 0) (func (- i 1)) 0)))))
+ (func))
+<em class="gray">5</em>
+</pre>
-<p>If a define* argument's default value is an expression, it is evaluated in the definition environment at
-the time of the procedure call:
+<p>This is consistent with the lambda* arguments because their defaults are
+already set in left-to-right order, and as each parameter is set to its default value,
+the binding is added to the default value expression environment (just as if it were a let*).
+The let* name itself (the implicit function) is not defined until after the bindings
+have been evaluated (as in named let).
</p>
-<pre>
-(let ((c 1))
- (define* (a (b (+ c 1))) b)
- (set! c 2)
- (let ((c 123))
- (a))) ; (+ c 1) here is (+ 2 1) so this returns 3
+<p>In CL, keyword default values are handled in the same way:
+</p>
+
+<pre class="indented">
+> (defun foo (&key (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c))
+<em class="gray">FOO </em>
+> (foo :b 2 :a 60)
+<em class="gray">(60 2 67) </em>
</pre>
-<p>Since the expression is not evaluated until the procedure is called, it is ok
-to use variables that are undefined at the definition point:
+<p>In s7, we'd use:
</p>
-<pre>
-> (define* (a (b c)) b)
-a
-> c
-;c: unbound variable
-> (define c 123)
-c
-> (a)
-123
+<pre class="indented">
+(define* (foo (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c))
</pre>
+</div>
+
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>To try to catch what I believe are usually mistakes, I added two
error checks. One is triggered if you set the same parameter twice
@@ -588,14 +759,14 @@ in the same call, and the other if an unknown keyword is encountered
in the key position. These problems arise in a case such as
</p>
-<pre>
+<pre class="indented">
(define* (f (a 1) (b 2)) (list a b))
</pre>
<p>You could do any of the following by accident:
</p>
-<pre>
+<pre class="indented">
(f 1 :a 2) ; what is a?
(f :b 1 2) ; what is b?
(f :c 3) ; did you really want a to be :c and b to be 3?
@@ -607,93 +778,107 @@ argument keyword: <code>(f :a :c)</code>, or make the default value a keyword:
To turn off this error check, add :allow-other-keys at the end of the parameter list.
</p>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<details>
+<summary class="indented">rest arg nits</summary>
+<div class="indented">
<p>s7's lambda* arglist handling is not the same as CL's lambda-list. First,
you can have more than one :rest parameter:
</p>
-<pre>
-> ((lambda* ((a 1) :rest b :rest c) (list a b c)) 1 2 3 4 5)
-(1 (2 3 4 5) (3 4 5))
+<pre class="indented">
+> ((lambda* (:rest a :rest b) (map + a b)) 1 2 3 4 5)
+<em class="gray">'(3 5 7 9)</em>
</pre>
<p>and second, the rest parameter, if any, takes up an argument slot just like any other
argument:
</p>
-<pre>
+<pre class="indented">
> ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32)
-(32 1 ())
-
+<em class="gray">(32 1 ())</em>
> ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5)
-(1 3 (2 3 4 5))
+<em class="gray">(1 3 (2 3 4 5))</em>
</pre>
<p>CL would agree with the first case if we used &key for 'c', but would give an error in the second.
Of course, the major difference is that s7 keyword arguments don't insist that the key be present.
-The :rest argument is needed in cases like these because we can't use expression
+The :rest argument is needed in cases like these because we can't use an expression
such as:
</p>
-<pre>
+<pre class="indented">
> ((lambda* ((a 3) . b c) (list a b c)) 1 2 3 4 5)
-stray dot?
+<em class="red">error: </em><em class="gray">stray dot?</em>
+> ((lambda* (a . (b 1)) b) 1 2) ; the reader turns the arglist into (a b 1)
+<em class="red">error: </em><em class="gray">lambda* parameter '1 is a constant</em>
</pre>
<p>Yet another nit: the :rest argument is not considered a keyword argument, so
</p>
-<pre>
+<pre class="indented">
> (define* (f :rest a) a)
-f
+<em class="gray">f</em>
> (f :a 1)
-(:a 1)
+<em class="gray">(:a 1)</em>
</pre>
+</div>
+</details>
</blockquote>
-</small>
-</dd>
-<br><br>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="macros"></a>
-<table border=0 bordercolor="lightgreen" width=80% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>macros</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<div class="header" id="macros"><h4>macros</h4></div>
+
-<dd><p><a name="definemacro">define-macro</a>, <a name="definemacrostar">define-macro*</a>,
-defmacro, defmacro*, <a name="macroexpand">macroexpand</a>, <a name="gensym">gensym</a>, and <a name="macrop">macro?</a>
-implement the standard (CL-style) macro definers.
+<p><em class=def id="definemacro">define-macro</em>,
+<em class=def id="definemacrostar">define-macro*</em>,
+<em class=def id="macroexpand">macroexpand</em>,
+<em class=def id="gensym">gensym</em>,
+<em class=def id="gensym?">gensym?</em>, and
+<em class=def id="macrop">macro?</em>
+implement the standard old-time macros.
</p>
-<pre>
-(define-macro (add-1 arg) `(+ 1 ,arg))
-(defmacro add-1 (arg) `(+ 1 ,arg))
+<pre class="indented">
+> (define-macro (<em class=def id="trace">trace</em> f)
+ `(define ,f
+ (apply lambda 'args
+ `((format #t "(~A ~{~A~^ ~}) -> " ',',f args)
+ (let ((val (apply ,,f args)))
+ (format #t "~A~%" val)
+ val)))))
+<em class="gray">trace</em>
+> (trace abs)
+<em class="gray">abs</em>
+> (abs -1.5)
+<em class="gray">(abs -1.5) -> 1.5</em>
+<em class="gray">1.5</em>
</pre>
-<p>macroexpand can help debug a macro:
+<p>macroexpand can help debug a macro. I always forget that it
+wants an expression:
</p>
-<pre>
+<pre class="indented">
> (define-macro (add-1 arg) `(+ 1 ,arg))
-add-1
+<em class="gray">add-1</em>
> (macroexpand (add-1 32))
-(+ 1 32)
+<em class="gray">(+ 1 32)</em>
</pre>
<p>gensym returns a symbol that is guaranteed to be unused. It takes an optional string argument
-giving the new symbol name's prefix.
+giving the new symbol name's prefix. gensym? returns #t if its argument is a symbol created by gensym.
</p>
-<pre>
-(defmacro pop! (sym)
+<pre class="indented">
+(define-macro (pop! sym)
(let ((v (<em class=red>gensym</em>)))
`(let ((,v (car ,sym)))
(set! ,sym (cdr ,sym))
@@ -703,1268 +888,724 @@ giving the new symbol name's prefix.
<p>As in define*, the starred forms give optional and keyword arguments:
</p>
-<pre>
+<pre class="indented">
> (define-macro* (add-2 a (b 2)) `(+ ,a ,b))
-add-2
+<em class="gray">add-2</em>
> (add-2 1 3)
-4
+<em class="gray">4</em>
> (add-2 1)
-3
+<em class="gray">3</em>
> (add-2 :b 3 :a 1)
-4
+<em class="gray">4</em>
</pre>
-<p>See s7test.scm for many examples including such perennial favorites as
-when, loop, dotimes, do*, enum, pushnew, and defstruct.
+<p>A bacro is a macro that expands its body and evaluates
+the result in the calling environment.
</p>
-<p>macro? returns #t if its argument is a macro or a symbol whose value is a macro.
-We can use it, and other macro-related stuff to make a version of macroexpand-all:
-</p>
-
-<pre>
-(define-macro (fully-expand form)
- (define (expand form)
- (if (pair? form)
- (if (<em class=red>macro?</em> (car form))
- (expand ((eval (procedure-source (car form))) form))
- (cons (expand (car form))
- (expand (cdr form))))
- form))
- (expand form))
-
-> (define-macro (hi a) `(+ 1 ,a))
-hi
-> (define-macro (ha c) `(hi (+ ,c 1)))
-ha
-> (fully-expand (define (ho b) (+ 1 (ha b))))
-ho
-> (procedure-source ho)
-(lambda (b) (+ 1 (+ 1 (+ b 1))))
+<pre class="indented">
+(define setf
+ (let ((args (gensym))
+ (name (gensym)))
+ (apply <em class=red>define-bacro</em> `((,name . ,args)
+ (unless (null? ,args)
+ (apply set! (car ,args) (cadr ,args) ())
+ (apply setf (cddr ,args)))))))
</pre>
-<p>fully-expand expands each macro it encounters by using the
-procedure-source of that macro, that is, the function that the macro definition
-expanded into:
+
+<p>
+The setf argument is a gensym (created when setf is defined) so that its name does not shadow any existing
+variable. Bacros expand in the calling environment, and a normal argument name
+might shadow something in that environment while the bacro is being expanded.
+Similarly, if you introduce bindings in the bacro expansion code, you need to
+keep track of which environment you want things to happen in. Use with-let
+and gensym liberally.
+stuff.scm has bacro-shaker which can find inadvertent name collisions,
+but it is flighty and easily confused.
+See s7test.scm for many examples of macros including such perennial favorites as
+loop, dotimes, do*, enum, pushnew, and defstruct.
+The calling environment itself is (outlet (curlet)) from within a bacro, so
</p>
-<pre>
-(define-macro (hi a) `(+ ,a 1))
+<pre class="indented">
+(define-bacro (holler)
+ `(format *stderr* "(~S~{ ~S ~S~^~})~%"
+ (let ((f __func__))
+ (if (pair? f) (car f) f))
+ (map (lambda (slot)
+ (values (symbol->keyword (car slot)) (cdr slot)))
+ (reverse (map values ,(outlet (curlet)))))))
-> (procedure-source hi)
-(lambda ({defmac}-18) (apply (lambda (a) ({list} '+ a 1)) (cdr {defmac}-18)))
+(define (f1 a b)
+ (holler)
+ (+ a b))
+
+(f1 2 3) ; prints out "(f1 :a 2 :b 3)" and returns 5
</pre>
-<small>
+
<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>I hesitate to mention this, but macros are first-class entities in s7. You can
-pass one as a function argument, apply it to a list, return it from a function,
-and assign it to a variable:
+<div class="indented">
+
+<p>
+Since a bacro (normally) sheds its define-time environment:
</p>
-<pre>
+<pre class="indented">
+(define call-bac
+ (let ((<em class=red>x</em> 2))
+ (define-bacro (m a) `(+ ,a ,<em class=red>x</em>))))
+
+> (call-bac 1)
+<em class="red">error: </em><em class="gray">x: unbound variable</em>
+</pre>
+<p>
+A macro here returns 3. But don't be hasty! The bacro can get its define-time environment (its closure)
+via funclet, so in fact, define-macro is a special case of define-bacro! We can define
+macros that work in all four ways: the expansion can happen in either the definition or calling environment,
+as can the evaluation of that expansion. In a bacro, both happen in the calling environment
+if we take no other action, and in a normal macro (define-macro), the expansion happens in the definition
+environment, and the evaluation in the calling environment.
+Here's a brief example of all four:
+</p>
+
+<pre class="indented">
+(let ((x 1) (y 2))
+ (define-bacro (bac1 a)
+ `(+ ,x y ,a)) ; expand and eval in calling env
+ (let ((x 32) (y 64))
+ (bac1 3))) ; (with-let (inlet 'x 32 'y 64) (+ 32 y 3))
+-> 99 ; with-let and inlet refer to <a href="#environments">environments</a>
+
+(let ((x 1) (y 2)) ; this is like define-macro
+ (define-bacro (bac2 a)
+ (with-let (sublet (funclet bac2) :a a)
+ `(+ ,x y ,a))) ; expand in definition env, eval in calling env
+ (let ((x 32) (y 64))
+ (bac2 3))) ; (with-let (inlet 'x 32 'y 64) (+ 1 y 3))
+-> 68
+
+(let ((x 1) (y 2))
+ (define-bacro (bac3 a)
+ (let ((e (with-let (sublet (funclet bac3) :a a)
+ `(+ ,x y ,a))))
+ `(with-let ,(sublet (funclet bac3) :a a)
+ ,e))) ; expand and eval in definition env
+ (let ((x 32) (y 64))
+ (bac3 3))) ; (with-let (inlet 'x 1 'y 2) (+ 1 y 3))
+-> 6
+
+(let ((x 1) (y 2))
+ (define-bacro (bac4 a)
+ (let ((e `(+ ,x y ,a)))
+ `(with-let ,(sublet (funclet bac4) :a a)
+ ,e))) ; expand in calling env, eval in definition env
+ (let ((x 32) (y 64))
+ (bac4 3))) ; (with-let (inlet 'x 1 'y 2) (+ 32 y 3))
+-> 37
+</pre>
+</div>
+
+<div class="indented">
+
+<p>As the setf example shows, a macro is a first-class citizen of s7. You can
+pass it as a function argument, apply it to a list, return it from a function,
+call it recursively,
+and assign it to a variable. You can even set its procedure-setter!
+</p>
+
+<pre class="indented">
> (define-macro (hi a) `(+ ,a 1))
-hi
+<em class="gray">hi</em>
> (apply hi '(4))
-5
+<em class="gray">5</em>
> (define (fmac mac) (apply mac '(4)))
-fmac
+<em class="gray">fmac</em>
> (fmac hi)
-5
+<em class="gray">5</em>
> (define (fmac mac) (mac 4))
-fmac
+<em class="gray">fmac</em>
> (fmac hi)
-5
+<em class="gray">5</em>
> (define (make-mac)
- (define-macro (hi a) `(+ ,a 1))
- hi)
-make-mac
-
+ (define-macro (hi a) `(+ ,a 1)))
+<em class="gray">make-mac</em>
> (let ((x (make-mac)))
(x 2))
-3
+<em class="gray">3</em>
+> (define-macro (ref v i) `(vector-ref ,v ,i))
+<em class="gray">ref</em>
+> (define-macro (set v i x) `(vector-set! ,v ,i ,x))
+<em class="gray">set</em>
+> (set! (procedure-setter ref) set)
+<em class="gray">set</em>
+> (let ((v (vector 1 2 3))) (set! (ref v 0) 32) v)
+<em class="gray">#(32 2 3)</em>
+</pre>
+
+<p>To expand all the macros in a piece of code:
+</p>
+<pre class="indented">
+(define-macro (fully-macroexpand form)
+ (define (expand form)
+ (if (pair? form)
+ (if (and (symbol? (car form))
+ (macro? (symbol->value (car form))))
+ (expand (apply macroexpand (list form)))
+ (if (and (eq? (car form) 'set!) ; look for (set! (mac ...) ...) and use mac's procedure-setter
+ (pair? (cdr form))
+ (pair? (cadr form))
+ (macro? (symbol->value (caadr form))))
+ (expand (apply (eval (procedure-source (procedure-setter (symbol->value (caadr form)))))
+ (append (cdadr form) (cddr form))))
+ (cons (expand (car form))
+ (expand (cdr form)))))
+ form))
+ (list 'quote (expand form)))
</pre>
+<p>This does not always handle bacros correctly because their expansion can depend on the run-time
+state.
+</p>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<details>
+<summary class="indented">backquote details</summary>
+<div class="indented">
<p>Backquote (quasiquote) in s7 is almost trivial. Constants are unchanged, symbols are quoted,
",arg" becomes "arg", and ", at arg" becomes "(apply values arg)" — hooray for real multiple values!
It's almost as easy to write the actual macro body as the backquoted version of it.
</p>
-<pre>
+<pre class="indented">
> (define-macro (hi a) `(+ 1 ,a))
-hi
+<em class="gray">hi</em>
> (procedure-source hi)
-(lambda ({defmac}-16) (apply (lambda (a) <em class=red>({list} '+ 1 a))</em> (cdr {defmac}-16)))
-
-;; so (define-macro (hi a) ({list} + 1 a)) is the same
+<em class="gray">(lambda (a) ({list} '+ 1 a))</em>
> (define-macro (hi a) `(+ 1 , at a))
-hi
-> (procedure-source hi)
-(lambda ({defmac}-17) (apply (lambda (a) <em class=red>({list} '+ 1 ({apply} {values} a)))</em> (cdr {defmac}-17)))
-
-;; same: (define-macro (hi a) ({list} + 1 ({apply} {values} a)))
-
-> (define-macro (hi a) ``(+ 1 ,,a))
-hi
+<em class="gray">hi</em>
> (procedure-source hi)
-(lambda ({defmac}-18) (apply (lambda (a) <em class=red>({list} '{list} ({list} 'quote '+) 1 a))</em> (cdr {defmac}-18)))
+<em class="gray">(lambda (a) ({list} '+ 1 ({apply_values} a)))</em>
</pre>
-<p>and so on. "{list}" is a special version of "list" to avoid name collisions
-and handle a few tricky details (similarly for "{values}" and "{apply}"). There is no unquote-splicing
-macro in s7; ",@(...)" becomes "(unquote (apply values ...))" at read-time.
+<p>{list} is a special version of list to avoid name collisions
+and handle a few tricky details (similarly for {apply_values}). There is no unquote-splicing
+macro in s7; ",@(...)" becomes "(unquote ({apply_values} ...))" at read-time. There shouldn't be any unquote
+either. In Scheme the reader turns ,x into (unquote x), so:
</p>
+<pre>
+> (let (,'a) unquote)
+<em class="gray">a</em>
+> (let (, (lambda (x) (+ x 1))) ,,,,'3)
+<em class="gray">7</em>
+</pre>
+<p>comma becomes a sort of symbol macro! I think I'll remove unquote; ,x and , at x will still work
+as expected, but there will not be any "unquote" or "unquote-splicing" in the resultant source code. Just to make life difficult:
+</p>
+<pre>
+> (let (' 1) quote)
+<em class="gray">1</em>
+</pre>
+<p>but that translation is so ingrained in lisp
+that I'm reluctant to change it. The two unquote names, on the
+other hand, seem unnecessary.
+</p>
+</div>
+</details>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
<p>s7 macros are not hygienic. For example,
</p>
-<pre>
- (define-macro (mac b)
+<pre class="indented">
+> (define-macro (mac b)
`(let ((a 12))
(+ a ,b)))
-
- (let ((a 1)
- (+ *))
- (mac a))
-</pre>
-
-<p>returns 144 because "+" has turned into "*", and "a" is the internal "a",
-not the argument "a". We get <code>(* 12 12)</code> where we probably expected <code>(+ 12 1)</code>.
-It is possible to use gensym to clean this up, but that makes the macro
-unreadable in all but the simplest cases. It is also possible, but not very easy, to
-write a macro to do the gensymification for us, but in s7 it is much more straightforward
-to use the environment functions.
-The procedure-environment of a macro is the environment at its definition time, just like a function.
-By wrapping the macro body in with-environment, we make sure anything in that body reflects
-the definition environment, not the calling environment. We then augment that environment
-with the macro arguments getting their values from the call-time environment:
-</p>
-
-<pre>
-(define-macro (define-immaculo name-and-args . body)
- (let* ((gensyms (map (lambda (g) (gensym)) (cdr name-and-args)))
- (args (cdr (copy name-and-args)))
- (name (car name-and-args))
- (set-args (map (lambda (a g) `(list ',g ,a)) args gensyms))
- (get-args (map (lambda (a g) `(quote (cons ',a ,g))) args gensyms)))
-
- `(define-macro ,name-and-args
- `(let ,(list , at set-args) ; get the current macro arg values
- ,(list 'with-environment
- (append (list 'augment-environment)
- (list (list 'procedure-environment ,name))
- (list , at get-args)) ; import the current arg values into the definition environment
- , at body)))))
+<em class="gray">mac</em>
+> (let ((a 1) (+ *)) (mac a))
+<em class="gray">144</em>
</pre>
-<p>In this version of define-immaculo, don't unquote the macro arguments in the body, and
-use <code>(apply values body)</code> in place of ", at body".
+<p>This returns 144 because '+' has turned into '*', and 'a' is the internal 'a',
+not the argument 'a'. We get <code>(* 12 12)</code> where we might have expected
+<code>(+ 12 1)</code>.
+Starting with the '+' problem,
+as long as the redefinition of '+' is local (that is, it happens after the macro definition), we can unquote the +:
</p>
-<pre>
-> (define-immaculo (mac b) `(let ((a 12)) (+ a b)))
-mac
-> (let ((a 21) (+ *)) (mac a))
-33
+<pre class="indented">
+> (define-macro (mac b)
+ `(let ((a 12))
+ (,+ a ,b))) ; ,+ picks up the definition-time +
+<em class="gray">mac</em>
+> (let ((a 1) (+ *)) (mac a))
+<em class="gray">24 ; (+ a a) where a is 12</em>
+</pre>
+
+<p>But the unquote trick won't work if we have previously loaded some file that redefined '+'
+at the top-level (so at macro definition time, + is *, but we want the built-in +).
+Although this example is silly, the problem is real in Scheme
+because Scheme has no reserved words and only one name space.
+</p>
+
+<pre class="indented">
+> (define + *)
+<em class="gray">+</em>
+> (define (add a b) (+ a b))
+<em class="gray">add</em>
+> (add 2 3)
+<em class="gray">6</em>
+> (define (divide a b) (/ a b))
+<em class="gray">divide</em>
+> (divide 2 3)
+<em class="gray">2/3</em>
+> (set! / -) ; a bad idea — this turns off s7's optimizer
+<em class="gray">-</em>
+> (divide 2 3)
+<em class="gray">-1</em>
+</pre>
+
+<p>Obviously macros are not the problem here. Since
+we might be loading
+code written by others, it's sometimes hard to tell what names
+that code depends on or redefines.
+We need a way to get the pristine (start-up, built-in) value of '+'.
+One long-winded way in s7 uses <a href="#unlet">unlet</a>:
+</p>
+
+<pre class="indented">
+> (define + *)
+<em class="gray">+</em>
+> (define (add a b) (with-let (unlet) (+ a b)))
+<em class="gray">add</em>
+> (add 2 3)
+<em class="gray">5</em>
+</pre>
+
+<p>But this is hard to read, and it's not inconceivable that we might want all three
+values of a symbol, the start-up value, the definition-time value, and the
+current value. The latter can be accessed with the bare symbol, the definition-time
+value with unquote (','), and the start-up value with either unlet
+or #_<name>. That is, #_+ is a reader macro for <code>(with-let (unlet) +)</code>.
+</p>
+
+<pre class="indented">
+> (define-macro (mac b)
+ `(<em class=red>#_let</em> ((a 12))
+ (<em class=red>#_+</em> a ,b))) ; #_+ and #_let are start-up values
+<em class="gray">mac</em>
+> (let ((a 1) (+ *)) (mac a))
+<em class="gray">24 ; (+ a a) where a is 12 and + is the start-up +</em>
+
+;;; make + generic (there's a similar C-based example below)
+> (define (+ . args)
+ (if (null? args) 0
+ (apply (if (number? (car args)) <em class=red>#_+ #_string-append</em>) args)))
+<em class="gray">+</em>
+> (+ 1 2)
+<em class="gray">3</em>
+> (+ "hi" "ho")
+<em class="gray">"hiho"</em>
+</pre>
+
+<p>#_<name> could be implemented via *#readers*:
+</p>
+
+<pre class="indented">
+(set! *#readers*
+ (cons (cons #\_ (lambda (str)
+ (with-let (unlet)
+ (string->symbol (substring str 1)))))
+ *#readers*))
</pre>
<p>
-If the slight difference in syntax is a problem
+So, now we have only the variable capture problem ('a' has been captured in the preceding examples).
+This is the only thing that the gigantic "hygienic macro" systems actually deal with:
+a microscopic problem that you'd think, from the hype, was up there with malaria and the
+national debt. gensym is the standard approach:
</p>
-<pre>
-(define-macro (define-immaculo name-and-args . body)
- (let* ((gensyms (map (lambda (g) (gensym)) (cdr name-and-args)))
- (args (cdr (copy name-and-args)))
- (name (car name-and-args))
- (set-args (map (lambda (a g) `(list ',g ,a)) args gensyms))
- (get-args (map (lambda (a g) `(quote (cons ',a ,g))) args gensyms))
- (blocked-args (map (lambda (a) `(,a ',a)) args))
- (new-body (list (eval `(let (, at blocked-args) , at body)))))
-
- `(define-macro ,name-and-args
- `(let ,(list , at set-args)
- ,(list 'with-environment
- (append (list 'augment-environment)
- (list (list 'procedure-environment ,name))
- (list , at get-args))
- ', at new-body)))))
-
-> (define-immaculo (mac c d) `(let ((a 12) (b 3)) (+ a b ,c ,d)))
-mac
-> (let ((a 21) (b 10) (+ *)) (mac a b))
-46
-> (let ((a 21) (b 10) (+ *)) (mac a (+ b 10))) ; here '+' is '*'
-136
-
-> (macroexpand (define-immaculo (mac c d) `(let ((a 12) (b 3)) (+ a b ,c ,d))))
-(define-macro (mac c d)
- ({list} 'let
- (list (list '{gensym}-23 c) ; here we get the call-time macro argument values
- (list '{gensym}-24 d))
- (list 'with-environment
- (append (list 'augment-environment)
- ; now wrap the body in the augmented definition-time environment
- (list (list 'procedure-environment mac))
- ; add the macro args to the definition-time env
- (list '(cons 'c {gensym}-23)
- '(cons 'd {gensym}-24)))
- '(let ((a 12)
- (b 3))
- (+ a b c d)))))
-
-> (let ((a 21) (b 10) (+ *)) (macroexpand (mac a b)))
-
-(let (({gensym}-22 a) ; pick up mac args, this is arg 'c' with the value 'a'
- ({gensym}-23 b))
- (with-environment (augment-environment (procedure-environment #<macro>)
- (cons 'c {gensym}-22) ; add them to definition-time env
- (cons 'd {gensym}-23))
- (let ((a 12)
- (b 3))
- (+ a b c d)))) ; 'a' and 'b' are local, 'c' and 'd' are from the augmented env
-</pre>
-
-
-<p>This is not the end of the story.
-Macro expansion happens
-in two different environments. Leaving aside quasiquote which operates at read-time in the global environment,
-a macro first evaluates its body to form a piece
-of code, a list with the macro's arguments plugged in. Then
-it evaluates that code. So the expansion into a piece of code takes place in one
-environment (the definition-time environment), and the code evaluation takes place
-in another (the call-time environment). This can be very frustrating! Say we
-decide to write a "symbol-set!" macro (borrowed in an oblique way from CL's set).
-<code>(symbol-set! var val)</code> should evaluate "var", getting a symbol as its
-value, then plug that symbol into <code>(set! var-value val)</code>. For example,
-after expansion we want something like:
-</p>
+<pre class="indented">
+> (define-macro (mac b)
+ (let ((var (<em class=red>gensym</em>)))
+ `(#_let ((,var 12))
+ (#_+ ,var ,b))))
+<em class="gray">mac</em>
+> (let ((a 1) (+ *)) (mac a))
+<em class="gray">13</em>
-<pre>
-> (let ((x 32) (y 'x))
- (eval (list 'set! y 123)) ; (symbol-set! y 123) ideally
- (list x y))
-(123 x)
+;; or use lambda:
+> (define-macro (mac b)
+ `((lambda (b) (let ((a 12)) (#_+ a b))) ,b))
+<em class="gray">mac</em>
+> (let ((a 1) (+ *)) (mac a))
+<em class="gray">13</em>
</pre>
-<p>If we define our macro in the local context, then the initial expansion
-into (set! x 123) takes place in a context where "y" is defined:
+<p>But in s7, the simplest approach uses environments. You have complete
+control over the environment at any point:
</p>
<pre>
-> (let ((x 32) (y 'x))
- (define-macro (symbol-set! var val)
- `(set! ,(symbol->value var) ,val))
- (symbol-set! y 123)
- (list x y))
-(123 x)
-</pre>
-
-<p>But if we try to define that at the top level so we can use it anywhere,
-"var" may not be defined in the environment where the initial list is created:
-</p>
+(define-macro (mac b)
+ `(with-let (inlet 'b ,b)
+ (let ((a 12))
+ (+ a b))))
-<pre>
-> (define-macro (symbol-set! var val)
- `(set! ,(symbol->value var) ,val))
-symbol-set!
-> (let ((x 32) (y 'x))
- (symbol-set! y 123)
- (list x y))
-;y: unbound variable, line 3
-; ({list} 'set! (symbol->value var) val)
+> (let ((a 1) (+ *)) (mac a))
+<em class="gray">13</em>
</pre>
-<p>Exactly the same thing happens in CL:
+<p>So s7 does not have syntax-rules because it is not needed.
</p>
+<div class="indented">
<pre>
-> (defmacro symbol-set (var val) `(setf ,(eval var) ,val))
-SYMBOL-SET
-> (let ((x 32) (y 'x)) (symbol-set y 123))
-*** - EVAL: variable Y has no value
-</pre>
+(define-macro (swap a b) ; assume a and b are symbols
+ `(with-let (inlet 'e (curlet) 'tmp ,a)
+ (set! (e ',a) (e ',b))
+ (set! (e ',b) tmp)))
-<p>Our "unhygienic" macros are too clean! We want both the expansion into
-code and the evaluation of the code to happen in the call-time environment.
-Since this is a step backward for computer science, I've called these
-dirty macros, "bacros":
-</p>
+> (let ((b 1) (tmp 2)) (swap b tmp) (list b tmp))
+<em class="gray">(2 1)</em>
-<pre>
-> (define-bacro (symbol-set! var val)
- `(set! ,(symbol->value var) ,val))
-symbol-set!
-> (let ((x 32) (y 'x))
- (symbol-set! y 123)
- (list x y))
-(123 x)
-</pre>
+(define-macro (swap a b) ; here a and b can be any settable expressions
+ `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a)
+ (with-let e (set! ,a ,b))
+ tmp)))
-<p>Or maybe "hacro"? Use eval in place of symbol->value, and...
-</p>
+> (let ((v (vector 1 2))) (swap (v 0) (v 1)) v)
+<em class="gray">#(2 1)</em>
+> (let ((tmp (cons 1 2))) (swap (car tmp) (cdr tmp)) tmp)
+<em class="gray">(2 . 1)</em>
-<pre>
-> (let ((x #(1 2 3))
- (y `(x 1)))
- (symbol-set! y 123)
- (list x y))
-(#(1 123 3) (x 1))
-</pre>
+(set! (procedure-setter swap) (define-macro (set-swap a b c) `(set! ,b ,c)))
-<p>s7 uses a bacro to implement macroexpand so that it can handle locally defined macros.
-By the way, bacros solve part of our original problem:
-</p>
+> (let ((a 1) (b 2) (c 3) (d 4)) (swap a (swap b (swap c d))) (list a b c d))
+<em class="gray">(2 3 4 1)</em>
-<pre>
- (define-bacro (mac b)
- `(let ((a 12))
- (+ a ,(symbol->value b))))
+;;; but this is simpler:
+(define-macro (rotate! . args)
+ `(set! ,(args (- (length args) 1))
+ (with-let (inlet 'e (curlet) 'tmp ,(car args))
+ (with-let e
+ ,@(map (lambda (a b) `(set! ,a ,b)) args (cdr args)))
+ tmp)))
- (let ((a 1))
- (mac a))
+> (let ((a 1) (b 2) (c 3)) (rotate! a b c) (list a b c))
+<em class="gray">(2 3 1)</em>
</pre>
+</div>
-<p>returns 13! No variable capture! Perhaps we can massage this idea a bit:
+<p>
+If you want the macro's expanded result
+to be evaluated in its definition environment:
</p>
-
<pre>
-(set! *#readers*
- (cons (cons #\_ (lambda (str)
- `(with-environment
- (initial-environment)
- ,(string->symbol (substring str 1)))))
- *#readers*))
-
-(define-bacro* (mac b)
- `(#_let ((a 12))
- (#_+ a ,(eval b)))) ; eval rather than symbol->value so that 'b' can be any expression
+(let ((a 3))
+ (define-macro (mac b)
+ `(with-let (inlet 'b ,b (funclet mac))
+ (+ a b))) ; definition-time "a", call-time "b"
+ (define-macro (mac-1 b)
+ `(+ a ,b)) ; call-time "a" and "b"
+ (let ((a 32))
+ (list (mac 1)
+ (mac-1 1))))
</pre>
-<p>Guaranteed hygienic!
-I'm not sure it's a big improvement over immaculos or gensyms, but it works.
-</p>
+<!--
+(define (tree-quote tree args)
+ (if (pair? tree)
+ (if (eq? (car tree) 'quote)
+ tree
+ (cons (tree-quote (car tree) args)
+ (tree-quote (cdr tree) args)))
+ (if (memq tree args)
+ (list 'quote tree)
+ tree)))
+
+(define-macro (define-hacro name-and-args . body)
+ (let ((name (car name-and-args))
+ (args (cdr name-and-args)))
+ `(define-macro ,name-and-args
+ (list 'with-let
+ (list 'inlet ,@(map (lambda (arg)
+ (values (symbol->keyword arg) arg))
+ args))
+ ,@(tree-quote body args)))))
+
+; (define-hacro (mac a b) `(+ ,a ,b))
+; (macroexpand (mac 2 3))
+; (with-let (inlet :a 2 :b 3) (+ a b))
+; (procedure-source mac)
+; (lambda (a b) (list 'with-let (list 'inlet :a a :b b) ({list} '+ 'a 'b)))
+-->
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<details>
+<summary class="indented">loopy macros</summary>
+<div class="indented">
<p>There is another problem with macros: accidental loops. Take the following
example; we're trying to write a macro that defines a function
that returns its argument in a list statement.
</p>
-<pre>
-> (define-macro (hang arg) `(define ,arg `(list (cdr ,,arg)))) ; obvious, no?
-hang
-
+<pre class="indented">
+> (define-macro (hang arg) `(define ,arg `(list (cdr ,,arg))))
+<em class="gray">hang</em>
> (macroexpand (hang (f a)))
-(define #1=(f a) ({list} 'list ({list} 'cdr #1#)))
-
+<em class="gray">(define #1=(f a) ({list} 'list ({list} 'cdr #1#)))</em>
> (hang (f a))
-f
-
+<em class="gray">f</em>
> (procedure-source f)
-(lambda #1=(a) ({list} 'list ({list} 'cdr (f . #1#))))
-
+<em class="gray">(lambda #1=(a) ({list} 'list ({list} 'cdr #1#)))</em>
>(f 1)
</pre>
-<p>And now we are hung. As I think is clear from the procedure source, we've created a procedure with a
-circular list in its definition! This is surprisingly easy to do by accident.
+<p>And now we are hung — we've created a procedure with an
+infinite loop! This is surprisingly easy to do by accident.
Here's one way out:
</p>
-<pre>
+<pre class="indented">
> (define-macro (hang arg) `(define ,arg `(list ,,@(cdr arg))))
-hang
+<em class="gray">hang</em>
> (macroexpand (hang (f a)))
-(define (f a) ({list} 'list a))
+<em class="gray">(define (f a) ({list} 'list a))</em>
> (hang (f a))
-f
+<em class="gray">f</em>
> (f 1)
-(list 1)
+<em class="gray">(list 1)</em>
</pre>
+</div>
+</details>
+
-<p>The moral of this story is: if you see a circular list in macroexpand, break
-the loop! Unfortunately, there are insidious hidden loops:
+<div class="indented">
+
+<p>Here is Peter Seibel's wonderful once-only macro:
</p>
-<pre>
-(define-macro* (mac (env (current-environment)))
- `(display ,env))
+<pre class="indented">
+(define-macro (once-only names . body)
+ (let ((gensyms (map (lambda (n) (gensym)) names)))
+ `(let (,@(map (lambda (g) (list g '(gensym))) gensyms))
+ `(let (,,@(map (lambda (g n) (list list g n)) gensyms names))
+ ,(let (,@(map list names gensyms))
+ , at body)))))
</pre>
-<p>looks innocuous, and its expanded source shows no loops, but we should have quoted the
-env reference! This code is structurally equivalent to
+<!-- this was:
+(define-macro (once-only names . body)
+ (let ((gensyms (map (lambda (n) (gensym)) names)))
+ `(let (,@(map (lambda (g) `(,g (gensym))) gensyms))
+ `(let (,,@(map (lambda (g n) ``(,,g ,,n)) gensyms names))
+ ,(let (,@(map (lambda (n g) `(,n ,g)) names gensyms))
+ , at body)))))
+-->
+
+<p>From the land of sparkling bacros:
</p>
-<pre>
-(let ((lst (list (cons 1 2))))
- (set! (cdr (car lst)) lst)
- (eval lst))
+<pre class="indented">
+(define once-only
+ (let ((names (gensym))
+ (body (gensym)))
+ (apply define-bacro `((,(gensym) ,names . ,body)
+ `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names))
+ ,@,body)))))
</pre>
-
-<p>because the 'env' argument is in the current environment and points to it at the same time.
-This (or its CL equivalent) will cause stack overflow in sbcl and clisp, and
-will segfault s7 due to a stack overflow internally.
+<p>Sadly, with-let is simpler.
</p>
+</div>
+
+</blockquote>
+<!--
+ when is (define-macro (f a) `(+ ,a 1)) not the same as (define (f a) (+ a 1))?
+ (f (values 2 3))
+ (f most-positive-fixnum) but only because the optimizer messes this up
+-->
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>But we should end on a happy note. Here is Peter Seibel's once-only macro:
-</p>
+<div class="header" id="pws"><h4>procedure-setter</h4></div>
-<pre>
- (defmacro once-only (names . body)
- (let ((gensyms (map (lambda (n) (gensym)) names)))
- `(let (,@(map (lambda (g) `(,g (gensym))) gensyms))
- `(let (,,@(map (lambda (g n) ``(,,g ,,n)) gensyms names))
- ,(let (,@(map (lambda (n g) `(,n ,g)) names gensyms))
- , at body)))))
+<pre class="indented">
+(<em class=def>procedure-setter</em> proc)
+(<em class=def id="dilambda">dilambda</em> proc setter)
</pre>
-<p>From the land of sparkling bacros:
+<p>Each function (or macro!) can have an associated setter, much like defsetf in CL. As a convenience, there's also
+a way to associate the two functions under one name: dilambda.
+The setter is called when the procedure is the target of set! Its last argument is the
+value passed to set!:
</p>
-<pre>
-(define-bacro (once-only names . body)
- `(let (,@(map (lambda (name) `(,name ,(eval name))) names))
- , at body))
-</pre>
-
-<!--
-A bacro is expanded in the call-time environment, so it can't be optimized in the same
-way that CL macros sometimes are. Since a CL macro does not evaluate its arguments, and
-its expansion depends only on its definition environment, some lisps conclude that it can be expanded once and
-for all the first time it is encountered, and replaced by its result (some piece of code) —
-self-modifying code in effect. This optimization is available in s7 under the name
-define-expansion, with some caveats. The thing defined by define-expansion is fully
-expanded at read-time, so it must have a globally unique name, and it must depend
-only on the global read-time environment. But the CL way of doing macros is problematic.
-Normally in lisp, if you redefine a function in its definition environment, then evaluate some code that calls
-that function, you get the new version. If a macro has already been expanded out of existence,
-it effectively ignores redefinition. Similar gotchas apply to macros defined after they appear.
-
-example:
-(define (hi a) (+ 1 a))
-(define (use-hi b) (hi b))
-(let ((x (use-hi 1)))
- (format #t "x: ~A~%" x))
-(define (hi a) (+ 2 a))
-(let ((x (use-hi 1)))
- (format #t "x: ~A~%" x))
-
-prints:
-x: 2
-x: 3
-in s7, Guile, clisp, sbcl (using CL syntax of course),
-
-but
-
-(defmacro hi (a) `(+ 1 ,a))
-(define (use-hi b) (hi b))
-(let ((x (use-hi 1)))
- (format #t "x: ~A~%" x))
-(defmacro hi (a) `(+ 2 ,a))
-(let ((x (use-hi 1)))
- (format #t "x: ~A~%" x))
-
-prints:
-x: 2
-x: 2
-
-in every case but s7 which still says the 2nd x is 3.
-
-If we use the macro before defining it (as is perfectly legal for functions):
-
-(define (use-hi b) (hi b))
-(defmacro hi (a) `(+ 1 ,a))
-(let ((x (use-hi 1)))
- (format #t "x: ~A~%" x))
-(defmacro hi (a) `(+ 2 ,a))
-(let ((x (use-hi 1)))
- (format #t "x: ~A~%" x))
-
-s7 still says x is 2 then 3, Guile throws an error: "Wrong type to apply: #<syntax-transformer hi>";
-clisp says 2 then 3! and sbcl gives the error: "HI is being redefined as a macro when it was previously assumed to be a function."
-Incredible.
-
-
-A bacro can be viewed as a function that does not
-evaluate its arguments, but to avoid the extra evaluation after expansion we need
-to quote the result (if the result does not already evaluate to itself):
-
-(define-bacro (when test . body)
- (if (eval test)
- `',(eval `(let () , at body))))
-
-(let ((x 1)) (when (> x 0) '(list '+ x 3)))
--> '(list + x 3)
-
-
--->
-
-
-
-
-</blockquote>
-</small>
-
-</dd>
-<br><br>
-
-
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="constants"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>define-constant, constant?, symbol-access</h4></td></tr></table>
-</td></tr></table>
-</dt>
-
-<dd><p><a name="defineconstant">define-constant</a> defines a constant and <a name="constantp">constant?</a> returns #t if its argument
-is a constant. A constant in s7 is really constant: it can't be set or rebound.
-</p>
-
-<pre>
-> (define-constant var 32)
-var
-
-> (set! var 1)
-;set!: can't alter immutable object: var
-
-> (let ((var 1)) var)
-;can't bind or set an immutable object: var, line 1
-</pre>
-
-<p>This has the possibly surprising side effect that previous uses of the constant name
-become constants:
-</p>
-
-<pre>
- (define (func a) (let ((cvar (+ a 1))) cvar))
- (define-constant cvar 23)
- (func 1)
- ;can't bind or set an immutable object: cvar
-</pre>
-
-<p>So, obviously, choose unique names for your constants, or don't use define-constant.
-A function can also be a constant.
-</p>
-
-<p>Constants are very similar to things such as keywords (no set, always return itself as its value),
-variable trace (informative function upon set or keeping a history of past values), typed variables (restricting a
-variable's values or doing automatic conversions upon set), and notification upon set (either in Scheme
-or in C; I wanted this many years ago in Snd). The notification function is especially useful if
-you have a Scheme variable and want to reflect any change in its value immediately in C (see <a href="#notify">below</a>).
-All of these cases modify
-the path between a symbol and its value.
-s7 gives you a handle on that path via the procedure-with-setter <b><a name="symbolaccess">symbol-access</a></b>.
-<code>(symbol-access symbol)</code> returns that symbol's accessors, and <code>(set! (symbol-access symbol) accessor-list)</code>
-changes them. The accessor-list is a list of three functions, the get, set, and bind functions.
-The set and bind functions take two arguments, the symbol in question
-and the value that it is about to be set or bound to. The variable is set or bound to the value they return.
-We could replace define-constant, and add
-local constants with:
-</p>
-
-<pre>
-(define constant-access
- (list #f
- (lambda (symbol new-value)
- (format #t "can't change constant ~A's value to ~A" symbol new-value)
- 'error)
- (lambda (symbol new-value)
- (format #t "can't bind constant ~A to a new value, ~A" symbol new-value)
- 'error)))
-
-(define-macro (define-constant symbol value)
- `(begin
- (define ,symbol ,value)
- (set! (<em class=red>symbol-access</em> ',symbol) constant-access)
- ',symbol))
-
-(define-macro (let-constant vars . body)
- (let ((varlist (map car vars)))
- `(let ,vars
- ,@(map (lambda (var)
- `(set! (<em class=red>symbol-access</em> ',var) constant-access))
- varlist)
- , at body)))
-</pre>
-
-
-<p>In the next example, we restrict the values a variable can take to integers:
-</p>
-
-<pre>
-(define-macro (define-integer var value)
- `(begin
- (define ,var ,value)
- (set! (<em class=red>symbol-access</em> ',var)
- (list #f
- (lambda (symbol new-value)
- (if (real? new-value)
- (floor new-value) ; or min/max to restrict it to some range etc
- (begin
- (format #t "~A can only take an integer value, not ~S" symbol new-value)
- 'error)))
- #f))
- ',var))
-
-> (define-integer int 123)
-int
-> (set! int 321.67)
-321
-> (set! int (list 1 2))
-;int can only take an integer value, not (1 2)
-</pre>
-
-<p>Here are trace and untrace. We save the previous accessors in trace, restore them upon untrace,
-and in between, call the previous set accessor, if any, after reporting the set:
-</p>
-
-<pre>
-(define (trace var)
- (let* ((cur-access (<em class=red>symbol-access</em> var))
- (cur-set (and cur-access (cadr cur-access))))
- (set! (<em class=red>symbol-access</em> var)
- (list (and cur-access (car cur-access))
- (lambda (symbol new-value)
- (format #t "~A set to ~A~%" symbol new-value)
- (if cur-set
- (cur-set symbol new-value)
- new-value))
- (and cur-access (caddr cur-access))
- cur-access)))) ; save the old version
-
-(define (untrace var)
- (if (and (symbol-access var)
- (cdddr (symbol-access var)))
- (set! (symbol-access var) (cadddr (symbol-access var)))))
-</pre>
-
-<p>The "get" function is currently not implemented.
-I believe symbol-access is similar to Ruby's hooked variables, or perhaps Perl's tied variables.
-We could implement all kinds of things
-with this mechanism, including property lists.
-</p>
-
-</dd>
-<br><br>
-
-
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="maketype1"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>make-type</h4></td></tr></table>
-</td></tr></table>
-</dt>
-
-<dd><p>
-<b><a name="maketype">make-type</a></b>, borrowed from Alaric Snell-Pym,
-returns a type-object: a list of three functions
-'?, 'make, and 'ref. The <b>?</b> func returns #t if its argument
-is of the new type, the <b>make</b> function returns a new object of the new type with the
-value of the argument to the make function, and the <b>ref</b> function returns that value
-when passed that object.
-</p>
-
-<A NAME="recordexample"></a>
-<pre>
-(define special-value ((cadr (<em class=red>make-type</em>)) 'special))
-;; now special-value's value can't be eq? to any other Scheme object
-
-;; expand, for example, (define-record rec (a 1) (b 2))
-(begin
- (define rec? #f)
- (define make-rec #f)
- (define rec-a #f)
- (define rec-b #f)
-
- (let* ((rec-type (<em class=red>make-type</em>))
- (? (car rec-type))
- (make (cadr rec-type))
- (ref (caddr rec-type)))
-
- (set! make-rec (lambda* ((a 1) (b 2))
- (make (vector a b))))
-
- (set! rec? ?)
-
- (set! rec-a (make-procedure-with-setter
- (lambda (obj)
- (and (rec? obj)
- (vector-ref (ref obj) 0)))
- (lambda (obj val)
- (if (rec? obj)
- (vector-set! (ref obj) 0 val)))))
-
- (set! rec-b (make-procedure-with-setter
- (lambda (obj)
- (and (rec? obj)
- (vector-ref (ref obj) 1)))
- (lambda (obj val)
- (if (rec? obj)
- (vector-set! (ref obj) 1 val)))))))
-
-#|
-(let ((hi (make-rec 32 '(1 2))))
- (set! (rec-b hi) 123)
- (format #t "rec: ~A ~A"
- (rec-a hi)
- (rec-b hi)))
-
-"rec: 32 123"
-|#
-</pre>
-
-<p>Currently make-type takes some optional arguments to specify other actions.
-I might change this to be an alist of (operation function) pairs, but for now,
-the optional (optkey) arguments are: print equal getter setter length name copy fill.
-Except for the 'name' argument, these are functions.
-When these functions are called, the argument representing the object is
-the value of the object, not the object itself; see the examples below.
-If no print function is specified, the 'name' argument is used when the
-object is displayed.
-The 'equal' function checks two objects of the new type for equality.
-The 'getter' function applies the object to whatever arguments are
-passed, and the 'setter' function does the same in the context of set!.
-The 'length' function returns the length of the object's value.
-The 'copy function returns a new object of the same type with the copy
-function applied to the old object's value.
-The 'fill' function takes two arguments, the object and what to
-fill its value with.
-So, remembering that (cadr type) is the make function:
-</p>
-
-<pre>
-> ((cadr (make-type)) 3.14)
-#<anonymous-type 3.14>
-
-> ((cadr (make-type :name "hiho")) 123)
-#<hiho 123>
-
-> ((cadr (make-type :print (lambda (a) (format #f "#<typo: |~A|>" a)))) 1)
-#<typo: |1|>
-
-> (((cadr (make-type :getter (lambda (a b) (vector-ref a b)))) (vector 1 2 3)) 1)
-2
-</pre>
-
-<p>The last is easier to read if we separate out the steps:
-</p>
-
-<pre>
-> (let* ((type (make-type
- :getter (lambda (a b)
- (vector-ref a b)))) ; make a new type with its own getter function
- (object ((cadr type) (vector 1 2 3)))) ; create an object of the new type, its value is a vector
- (object 1)) ; apply the object to 1 => (vector-ref object 1) via the getter
-2
-</pre>
-
-<p>The objects created in this way, or via s7_new_type in C, can be passed to map and for-each
-if you supply the length and getter functions to make-type.
-</p>
-
-<pre>
-> (define-macro (enum . args)
- `(for-each define ',args ((cadr (make-type :getter (lambda (a b) b)
- :length (lambda (a) ,(length args)))))))
-enum
-> (enum zero one two three)
-#<unspecified>
-> two
-2
-</pre>
-
-<small>
-<blockquote>
-
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>Here is define-record using make-type. It has a few Common Lisp extensions:
-</p>
-
-<pre>
-(define-macro (define-record struct-name . fields)
- (let* ((name (if (list? struct-name) (car struct-name) struct-name))
- (sname (if (string? name) name (symbol->string name)))
-
- (fsname (if (list? struct-name)
- (let ((cname (assoc :conc-name (cdr struct-name))))
- (if cname
- (symbol->string (cadr cname))
- sname))
- sname))
-
- (make-name (if (list? struct-name)
- (let ((cname (assoc :constructor (cdr struct-name))))
- (if cname
- (cadr cname)
- (string->symbol (string-append "make-" sname))))
- (string->symbol (string-append "make-" sname))))
-
- (is-name (string->symbol (string-append sname "?")))
-
- (copy-name (if (list? struct-name)
- (let ((cname (assoc :copier (cdr struct-name))))
- (if cname
- (cadr cname)
- (string->symbol (string-append "copy-" sname))))
- (string->symbol (string-append "copy-" sname))))
-
- (field-names (map (lambda (n)
- (symbol->string (if (list? n) (car n) n)))
- fields))
-
- (field-types (map (lambda (field)
- (if (list? field)
- (apply (lambda* (val type read-only) type) (cdr field))
- #f))
- fields))
-
- (field-read-onlys (map (lambda (field)
- (if (list? field)
- (apply (lambda* (val type read-only) read-only) (cdr field))
- #f))
- fields)))
- `(begin
-
- ;; declare our globally-accessible names
- (define ,is-name #f)
- (define ,make-name #f)
- (define ,copy-name #f)
-
- ,@(map (lambda (n)
- `(define ,(string->symbol (string-append fsname "-" n)) #f))
- field-names)
-
- (let* ((rec-type (<em class=red>make-type</em>))
- (? (car rec-type))
- (make (cadr rec-type))
- (ref (caddr rec-type)))
-
- (set! ,is-name ?)
-
- (set! ,make-name (lambda* ,(map (lambda (n)
- (if (and (list? n)
- (>= (length n) 2))
- (list (car n) (cadr n))
- (list n #f)))
- fields)
- (make (vector ',(string->symbol sname) ,@(map string->symbol field-names)))))
-
- (set! ,copy-name (lambda (obj)
- (make (copy (ref obj)))))
-
- ,@(map (let ((ctr 1))
- (lambda (n type read-only)
- (let ((val (if read-only
- `(set! ,(string->symbol (string-append fsname "-" n))
- (lambda (arg) ((ref arg) ,ctr)))
- `(set! ,(string->symbol (string-append fsname "-" n))
- (make-procedure-with-setter
- (lambda (arg) ((ref arg) ,ctr))
- (lambda (arg val) (set! ((ref arg) ,ctr) val)))))))
- (set! ctr (+ 1 ctr))
- val)))
- field-names field-types field-read-onlys)
-
- ',struct-name))))
-
-> (define-record point (x 0.0) (y 0.0))
-point
-> (let ((pt (make-point 1.0)))
- (set! (point-y pt) 3.0)
- (list (point? pt) (point-x pt) (point-y pt)))
-(#t 1.0 3.0)
-</pre>
-
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>In the next example, we define a float-vector type:
-</p>
-
-<pre>
-(begin
- (define make-float-vector #f)
- (define float-vector? #f)
- (define float-vector #f)
-
- (let* ((fv-type (<em class=red>make-type</em>
- :getter vector-ref :length length :copy copy :fill fill!
- :setter (lambda (obj index value)
- (if (not (real? value))
- (error 'wrong-type-arg-error "float-vector element must be real: ~S" value))
- (vector-set! obj index (exact->inexact value)))
- :name "float-vector"))
- (fv? (car fv-type))
- (make-fv (cadr fv-type))
- (fv-ref (caddr fv-type)))
-
- (set! make-float-vector
- (lambda* (len (initial-element 0.0))
- (if (not (real? initial-element))
- (error 'wrong-type-arg-error "make-float-vector initial element must be real: ~S" initial-element))
- (make-fv (make-vector len (exact->inexact initial-element)))))
-
- (set! float-vector? fv?)
-
- (set! float-vector
- (lambda args
- (let* ((len (length args))
- (fv (make-float-vector len))
- (v (fv-ref fv)))
- (do ((lst args (cdr lst)))
- (i 0 (+ i 1)))
- ((null? lst) fv)
- (let ((arg (car lst)))
- (if (not (real? arg))
- (error 'wrong-type-arg-error "float-vector element must be real: ~S in ~S" arg args))
- (set! (v i) (exact->inexact arg))))))))
-
-> (let ((v (make-float-vector 3))) (set! (v 1) 32) v)
-#<float-vector #(0.0 32.0 0.0)>
-
-> (let ((v (make-float-vector 3))) (set! (v 1) "hi") v)
-;float-vector element must be real: "hi"
-
-> (map + (list 1 2 3) (float-vector 1 2 3)) ; we have a getter and length, so map and for-each will work
-(2.0 4.0 6.0)
-</pre>
-
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>I seem to be using the same construct over and over; a begin to hold the names defined in the outer
-environment, a let to hold internal stuff, and set!s to give the names values. It's a clumsy, but
-simple way for multiple functions to share a closure.
-Maybe it rates a macro:
-</p>
-
-<pre>
-(define-macro (blet* names bindings . body)
- `(begin
- ,@(map (lambda (name)
- `(define ,name #f))
- names)
- (let* ,bindings
- , at body)))
-
-(blet* (make-adjustable-vector adjustable-vector? adjust-vector)
-
- ((av-type (<em class=red>make-type</em> :name "adjustable-vector"
- :getter (lambda (obj index)
- ((car obj) index))
- :setter (lambda (obj index value)
- (set! ((car obj) index) value))
- :length (lambda (obj)
- (vector-length (car obj)))
- :print (lambda (obj)
- (object->string (car obj)))))
- (av? (car av-type))
- (make-av (cadr av-type))
- (av-ref (caddr av-type)))
-
- (set! make-adjustable-vector (lambda args
- (make-av (list (apply make-vector args)))))
- (set! adjustable-vector? av?)
- (set! adjust-vector (lambda* (obj new-length initial-element)
- (let* ((new-vector (make-vector new-length initial-element))
- (copy-len (min new-length (length obj))))
- (do ((i 0 (+ i 1)))
- ((= i copy-len))
- (set! (new-vector i) (obj i)))
- (set! (car (av-ref obj)) new-vector)))))
-
-> (define v (make-adjustable-vector 3 #f))
-v
-
-> v
-#(#f #f #f)
-
-> (set! (v 1) 32.0)
-32.0
-
-> v
-#(#f 32.0 #f)
-
-> (adjust-vector v 10 #f)
-#(#f 32.0 #f #f #f #f #f #f #f #f)
-</pre>
-
-</blockquote>
-</small>
-
-</dd>
-<br><br>
-
-
-
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="pws"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>procedure-with-setter</h4></td></tr></table>
-</td></tr></table>
-</dt>
-
-<dd><p>A <a name="procedurewithsetter">procedure-with-setter</a> consists of two functions, the "getter" and the "setter".
-The getter is called when the object is encountered as a function, and the setter when
-it is set:
-</p>
-
-<pre>
-(define xx (let ((x 32))
- (<em class=red>make-procedure-with-setter</em>
- (lambda () x)
- (lambda (val) (set! x val) x))))
-(xx) -> 32
-(set! (xx) 1)
-(xx) -> 1
-</pre>
-
-<p>The setter's last argument is the value passed to set!. That is,
-</p>
-
-<pre>
-(define v123
- (let ((vect (vector 1 2 3)))
- (make-procedure-with-setter
- (lambda (index)
- (vector-ref vect index)) ; using explicit indexing -- (vect index) is the same (see "generalized set!" below)
- (lambda (index value)
- (vector-set! vect index value)))))
-
-> (v123 2)
-3
-> (set! (v123 2) 32)
-32
-> (v123 2)
-32
-</pre>
-
-<p>make-procedure-with-setter can add generalized set! support to any function:
-</p>
-
-<pre>
-> (define cadr (make-procedure-with-setter
- cadr
- (lambda (lst val)
- (set! (car (cdr lst) ) val))))
-cadr
-> (cadr '(1 2 3))
-2
+<pre class="indented">
+> (procedure-setter cadr)
+<em class="gray">#f</em>
+> (set! (procedure-setter cadr)
+ (lambda (lst val)
+ (set! (car (cdr lst)) val)))
+<em class="gray">#<lambda (lst val)></em>
+> (procedure-source (procedure-setter cadr))
+<em class="gray">(lambda (lst val) (set! (car (cdr lst)) val))</em>
> (let ((lst (list 1 2 3)))
(set! (cadr lst) 4)
lst)
-(1 4 3)
+<em class="gray">(1 4 3)</em>
</pre>
+<p>In some cases, the setter needs to be a macro:
+</p>
+<pre class="indented">
+> (set! (procedure-setter logbit?)
+ (define-macro (m var index on) ; here we want to set "var", so we need a macro
+ `(if ,on
+ (set! ,var (logior ,var (ash 1 ,index)))
+ (set! ,var (logand ,var (lognot (ash 1 ,index)))))))
+<em class="gray">m</em>
+> (define (mingle a b)
+ (let ((r 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 31) r)
+ (set! (logbit? r (* 2 i)) (logbit? a i))
+ (set! (logbit? r (+ (* 2 i) 1)) (logbit? b i)))))
+<em class="gray">mingle</em>
+> (mingle 6 3) ; the INTERCAL mingle operator?
+<em class="gray">30</em>
+</pre>
-<small>
<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
-<p>Here is a pretty example of make-procedure-with-setter:
+<p>Here is a pretty example of dilambda:
</p>
-<pre>
+<pre class="indented">
(define-macro (c?r path)
;; "path" is a list and "X" marks the spot in it that we are trying to access
- ;; (a (b ((c X)))) -- anything after the X is ignored, other symbols are just placeholders
- ;; c?r returns a procedure-with-setter that gets/sets X
+ ;; (a (b ((c X)))) — anything after the X is ignored, other symbols are just placeholders
+ ;; c?r returns a dilambda that gets/sets X
(define (X-marks-the-spot accessor tree)
(if (pair? tree)
(or (X-marks-the-spot (cons 'car accessor) (car tree))
(X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
- (if (eq? tree 'X) accessor #f)))
+ (and (eq? tree 'X) accessor)))
(let ((body 'lst))
(for-each
(lambda (f)
(set! body (list f body)))
- (reverse (X-marks-the-spot '() path)))
+ (reverse (X-marks-the-spot () path)))
- `(<em class=red>make-procedure-with-setter</em>
+ `(<em class=red>dilambda</em>
(lambda (lst)
,body)
(lambda (lst val)
(set! ,body val)))))
> ((c?r (a b (X))) '(1 2 (3 4) 5))
-3
-
+<em class="gray">3</em>
> (let ((lst (list 1 2 (list 3 4) 5)))
(set! ((c?r (a b (X))) lst) 32)
lst)
-(1 2 (32 4) 5)
-
+<em class="gray">(1 2 (32 4) 5)</em>
> (procedure-source (c?r (a b (X))))
-(lambda (lst) (car (car (cdr (cdr lst)))))
-
+<em class="gray">(lambda (lst) (car (car (cdr (cdr lst)))))</em>
> ((c?r (a b . X)) '(1 2 (3 4) 5))
-((3 4) 5)
-
+<em class="gray">((3 4) 5)</em>
> (let ((lst (list 1 2 (list 3 4) 5)))
(set! ((c?r (a b . X)) lst) '(32))
lst)
-(1 2 32)
-
+<em class="gray">(1 2 32)</em>
> (procedure-source (c?r (a b . X)))
-(lambda (lst) (cdr (cdr lst)))
-
+<em class="gray">(lambda (lst) (cdr (cdr lst)))</em>
> ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6))))))))))
-6
-
+<em class="gray">6</em>
> (let ((lst '(((((1 (2 (3 (4 (5 6)))))))))))
(set! ((c?r (((((a (b (c (d (e X)))))))))) lst) 32)
lst)
-(((((1 (2 (3 (4 (5 32)))))))))
-
+<em class="gray">(((((1 (2 (3 (4 (5 32)))))))))</em>
> (procedure-source (c?r (((((a (b (c (d (e X)))))))))))
-(lambda (lst) (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (car (car (car lst)))))))))))))))
+<em class="gray">(lambda (lst) (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (car (car (car lst)))))))))))))))</em>
</pre>
+</div>
+
-<br>
-<p>We can extend c?r into something incredibly useful! A goto implementation using circular lists:
+<div class="indented">
+<p>Speaking of INTERCAL, COME-FROM:
</p>
-<pre>
-(define-macro (define-with-goto name-and-args . body)
- ;; run through the body collecting label accessors, (label name)
- ;; run through getting goto positions, (goto name)
- ;; tie all the goto's to their respective labels (via set-cdr! essentially)
-
- (define (find-accessor type)
- (let ((labels '()))
- (define (gather-labels accessor tree)
- (if (pair? tree)
- (if (equal? (car tree) type)
- (begin
- (set! labels (cons (cons (cadr tree)
- (let ((body 'lst))
- (for-each
- (lambda (f)
- (set! body (list f body)))
- (reverse (cdr accessor)))
- (make-procedure-with-setter
- (apply lambda '(lst) (list body))
- (apply lambda '(lst val) `((set! ,body val))))))
- labels))
- (gather-labels (cons 'cdr accessor) (cdr tree)))
- (begin
- (gather-labels (cons 'car accessor) (car tree))
- (gather-labels (cons 'cdr accessor) (cdr tree))))))
- (gather-labels '() body)
- labels))
-
- (let ((labels (find-accessor 'label))
- (gotos (find-accessor 'goto)))
- (if (not (null? gotos))
- (for-each
- (lambda (goto)
- (let* ((name (car goto))
- (goto-accessor (cdr goto))
- (label (assoc name labels))
- (label-accessor (and label (cdr label))))
- (if label-accessor
- (set! (goto-accessor body) (label-accessor body))
- (error 'bad-goto "can't find label: ~S" name))))
- gotos))
+<pre class="indented">
+(define-macro (define-with-goto-and-come-from name-and-args . body)
+ (let ((labels ())
+ (gotos ())
+ (come-froms ()))
+
+ (define (collect-jumps tree)
+ (when (pair? tree)
+ (when (pair? (car tree))
+ (case (caar tree)
+ ((label) (set! labels (cons tree labels)))
+ ((goto) (set! gotos (cons tree gotos)))
+ ((come-from) (set! come-froms (cons tree come-froms)))
+ (else (collect-jumps (car tree)))))
+ (collect-jumps (cdr tree))))
+
+ (collect-jumps body)
+
+ (for-each
+ (lambda (goto)
+ (let* ((name (cadr (cadar goto)))
+ (label (member name labels (lambda (a b) (eq? a (cadr (cadar b)))))))
+ (if label
+ (set-cdr! goto (car label))
+ (error 'bad-goto "can't find label: ~S" name))))
+ gotos)
+
+ (for-each
+ (lambda (from)
+ (let* ((name (cadr (cadar from)))
+ (label (member name labels (lambda (a b) (eq? a (cadr (cadar b)))))))
+ (if label
+ (set-cdr! (car label) from)
+ (error 'bad-come-from "can't find label: ~S" name))))
+ come-froms)
`(define ,name-and-args
(let ((label (lambda (name) #f))
- (goto (lambda (name) #f)))
+ (goto (lambda (name) #f))
+ (come-from (lambda (name) #f)))
, at body))))
-
-(define-with-goto (hi)
- (display "start ")
- (<em class=red>goto</em> 'the-end)
- (display "oops")
- (<em class=red>label</em> 'the-end)
- (display "all done"))
-
-(hi) -> "start all done"
</pre>
+</div>
+</blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>
-I wonder if it would be more consistent to use the
-name "procedure/setter" in place of "make-procedure-with-setter".
-Its syntax is closer to
-vector than make-vector, for example.
-Even better: "dilambda":
-</p>
-
-<pre>
-(define-macro (dilambda getter setter)
- `(make-procedure-with-setter
- (lambda , at getter)
- (lambda , at setter)))
-
-(let ((a 32))
- (dilambda (() a)
- ((b) (set! a b))))
-</pre>
-
-<p>"bilambda" would mix Latin and Greek since the Romans used "el", not "lambda", according to Wikipedia.
-</p>
-
-</blockquote>
-</small>
-<br>
-</dd>
-<br><br>
+<div class="header" id="generalizedset"><h4>applicable objects, generalized set!, generic functions</h4></div>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="generalizedset"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>applicable objects, generalized set!, generic functions</h4></td></tr></table>
-</td></tr></table>
-</dt>
-<dd><p>procedure-with-setters can be viewed as one generalization of set!. Another
+<p>A procedure with a setter can be viewed as one generalization of set!. Another
treats objects as having predefined get and set functions. In s7
-lists, strings, vectors, hash-tables, and any cooperating C or Scheme-defined objects
-are both applicable and settable. newLisp calls this implicit indexing, Gauche implements it
+lists, strings, vectors, hash-tables, environments, and any cooperating C or Scheme-defined objects
+are both applicable and settable. newLisp calls this implicit indexing, Kawa has it, Gauche implements it
via object-apply, Guile via procedure-with-setter; CL's funcallable instance might be the same idea.
</p>
@@ -1977,68 +1618,9 @@ as <code>(list-set! lst 1 2)</code>.
I like this syntax: the less noise, the better!
</p>
-<pre>
-;; an example taken from R Cox's website
-
-(define dense (make-vector 128))
-(define sparse (make-vector 128))
-(define n 0)
-
-(define (add-member i)
- (set! (dense n) i)
- (set! (sparse i) n)
- (set! n (+ n 1)))
-
-(define (is-member i)
- (and (number? (sparse i))
- (< (sparse i) n)
- (= (dense (sparse i)) i)))
-
-(define (clear-all) (set! n 0))
-
-(define (remove-member i)
- (if (is-member i)
- (begin
- (let ((j (dense (- n 1))))
- (set! (dense (sparse i)) j)
- (set! (sparse j) (sparse i))
- (set! n (- n 1))))))
-
-(add-member 32)
-1
-(add-member 12)
-2
-(is-member 14)
-#f
-(is-member 12)
-#t
-</pre>
-
-<p>Some more examples:
-</p>
-
-<pre>
-> (let ((lst (list 1 2 3)))
- (set! (lst 1) 32)
- (list (lst 0) (lst 1)))
-(1 32)
-
-> (let ((hash (make-hash-table)))
- (set! (hash 'hi) 32)
- (hash 'hi))
-32
-
-> (let ((str "123"))
- (set! (str 1) #\x) str)
-"1x3"
-</pre>
-
-<small>
<blockquote>
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>Well, maybe applicable strings look weird: <code>("hi" 1)</code> is #\i, but worse,
so is <code>(cond (1 => "hi"))</code>! Even though a string, list, or vector is "applicable", it is
@@ -2046,94 +1628,101 @@ not currently considered to be a procedure, so <code>(procedure? "hi")</code> is
accept anything that apply can handle, so
<code>(map #(0 1) '(1 0))</code> is '(1 0). (On the first call to map in this case, you get the result of
<code>(#(0 1) 1)</code> and so on).
+string->list, vector->list, and let->list are <code>(map values object)</code>.
+Their inverses are (and always have been) equally trivial.
</p>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
<p>The applicable object syntax makes it easy to write generic functions.
For example, s7test.scm has implementations of Common Lisp's sequence functions.
-length, copy, reverse, fill!, map and for-each are generic in this sense (map always returns a list).
+length, copy, reverse, fill!, iterate, map and for-each are generic in this sense (map always returns a list).
</p>
-<pre>
+<pre class="indented">
> (map (lambda (a b) (- a b)) (list 1 2) (vector 3 4))
-(5 -3 9)
-
+<em class="gray">(5 -3 9)</em>
> (length "hi")
-2
+<em class="gray">2</em>
</pre>
<p>
-string->list and vector->list are <code>(map values object)</code>.
-Their inverses are (and always have been) equally trivial.
-Here's an FFT procedure that accepts lists or vectors, or any similar object:
-</p>
-
-<pre>
- (define* (cfft! data n (dir 1)) ; (complex data)
- (if (not n) (set! n (<em class=red>length</em> data)))
- (do ((i 0 (+ i 1))
- (j 0))
- ((= i n))
- (if (> j i)
- (let ((temp (data j)))
- (set! (data j) (data i))
- (set! (data i) temp)))
- (let ((m (/ n 2)))
- (do ()
- ((or (< m 2) (< j m)))
- (set! j (- j m))
- (set! m (/ m 2)))
- (set! j (+ j m))))
- (let ((ipow (floor (log n 2)))
- (prev 1))
- (do ((lg 0 (+ lg 1))
- (mmax 2 (* mmax 2))
- (pow (/ n 2) (/ pow 2))
- (theta (make-rectangular 0.0 (* pi dir)) (* theta 0.5)))
- ((= lg ipow))
- (let ((wpc (exp theta))
- (wc 1.0))
- (do ((ii 0 (+ ii 1)))
- ((= ii prev))
- (do ((jj 0 (+ jj 1))
- (i ii (+ i mmax))
- (j (+ ii prev) (+ j mmax)))
- ((>= jj pow))
- (let ((tc (* wc (data j))))
- (set! (data j) (- (data i) tc))
- (set! (data i) (+ (data i) tc))))
- (set! wc (* wc wpc)))
- (set! prev mmax))))
- data)
-
- > (cfft! (list 0.0 1+i 0.0 0.0))
- (1+1i -1+1i -1-1i 1-1i)
- > (cfft! (vector 0.0 1+i 0.0 0.0))
- #(1+1i -1+1i -1-1i 1-1i)
-</pre>
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+Here's a generic FFT:
+</p>
+
+<pre class="indented">
+(define* (cfft! data n (dir 1)) ; (complex data)
+ (if (not n) (set! n (length data)))
+ (do ((i 0 (+ i 1))
+ (j 0))
+ ((= i n))
+ (if (> j i)
+ (let ((temp (data j)))
+ (set! (data j) (data i))
+ (set! (data i) temp)))
+ (let ((m (/ n 2)))
+ (do ()
+ ((or (< m 2) (< j m)))
+ (set! j (- j m))
+ (set! m (/ m 2)))
+ (set! j (+ j m))))
+ (let ((ipow (floor (log n 2)))
+ (prev 1))
+ (do ((lg 0 (+ lg 1))
+ (mmax 2 (* mmax 2))
+ (pow (/ n 2) (/ pow 2))
+ (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
+ ((= lg ipow))
+ (let ((wpc (exp theta))
+ (wc 1.0))
+ (do ((ii 0 (+ ii 1)))
+ ((= ii prev))
+ (do ((jj 0 (+ jj 1))
+ (i ii (+ i mmax))
+ (j (+ ii prev) (+ j mmax)))
+ ((>= jj pow))
+ (let ((tc (* wc (data j))))
+ (set! (data j) (- (data i) tc))
+ (set! (data i) (+ (data i) tc))))
+ (set! wc (* wc wpc)))
+ (set! prev mmax))))
+ data)
+
+> (cfft! (list 0.0 1+i 0.0 0.0))
+<em class="gray">(1+1i -1+1i -1-1i 1-1i)</em>
+> (cfft! (vector 0.0 1+i 0.0 0.0))
+<em class="gray">#(1+1i -1+1i -1-1i 1-1i)</em>
+</pre>
+
+<p>And a generic function that copies one sequence's elements into another sequence:
+</p>
+<pre class="indented">
+(define (copy-into source dest) ; this is equivalent to (copy source dest)
+ (do ((i 0 (+ i 1)))
+ ((= i (min (length source) (length dest)))
+ dest)
+ (set! (dest i) (source i))))
+</pre>
+
+<p>but that is already built-in as the two-argument version of the copy function.
+</p>
+</div>
+
+
+<div class="indented">
<p>There is one place where list-set! and friends are not the same as set!: the former
evaluate their first argument, but set! does not (with a quibble; see below):
</p>
-<pre>
+<pre class="indented">
> (let ((str "hi")) (string-set! (let () str) 1 #\a) str)
-"ha"
-
+<em class="gray">"ha"</em>
> (let ((str "hi")) (set! (let () str) 1 #\a) str)
-;((let () str) 1 #\a): too many arguments to set!
-
+<em class="gray">;((let () str) 1 #\a): too many arguments to set!</em>
> (let ((str "hi")) (set! ((let () str) 1) #\a) str)
-"ha"
-
+<em class="gray">"ha"</em>
> (let ((str "hi")) (set! (str 1) #\a) str)
-"ha"
+<em class="gray">"ha"</em>
</pre>
<p>set! looks at its first argument to decide what to set.
@@ -2143,180 +1732,384 @@ expression, and tries again. So the second case above is the only one that won'
And of course:
</p>
-<pre>
+<pre class="indented">
> (let ((x (list 1 2)))
(set! ((((lambda () (list x))) 0) 0) 3)
x)
-(3 2)
+<em class="gray">(3 2)</em>
</pre>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>By my count, around 20 of the Scheme built-in functions are already generic in the sense
-that they accept arguments of many types (leaving aside the numeric functions). s7 extends that list with map, for-each, reverse,
-and length, and adds a few others such as copy, fill!, sort!, object->string, and continuation?.
+that they accept arguments of many types (leaving aside the numeric and type checking functions, take for example equal?, display,
+member, assoc, apply, eval, quasiquote, and values). s7 extends that list with map, for-each, reverse,
+and length, and adds a few others such as copy, fill!, sort!, object->string, and append.
newLisp takes a more radical approach than s7: it extends operators such as '>'
to compare strings and lists, as well as numbers. In map and for-each, however, you can mix the argument
types, so I'm not as attracted to making '>' generic; you can't, for example, <code>(> "hi" 32.1)</code>,
or even <code>(> 1 0+i)</code>.
</p>
-
+</div>
</blockquote>
-</small>
-</dd>
-
-<br><br>
-
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="multidimensionalvectors"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>multidimensional vectors</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<div class="separator"></div>
-<dd><p>
-s7 supports
-vectors with any number of dimensions. It is here, in particular, that the generalized
-set! stuff shines. make-vector's second argument can be a list of dimensions, rather than
-an integer as in the one dimensional case:
+<p>The somewhat non-standard generic sequence functions in s7 are:
</p>
-<pre>
- (make-vector (list 2 3 4))
- (make-vector '(2 3) 1.0)
- (vector-dimensions (make-vector (list 2 3 4))) -> (2 3 4)
+<pre class="indented">
+(<em class=def id="sortb">sort!</em> sequence less?)
+(<em class=def id="reverseb">reverse!</em> sequence) and (reverse sequence)
+(<em class=def id="fillb">fill!</em> sequence value (start 0) end)
+(<em class=def id="s7copy">copy</em> obj) and (copy source destination (start 0) end)
+(<em class=def id="objecttostring">object->string</em> obj)
+(length obj)
+(append . sequences)
+(map func . sequences) and (for-each func . sequences)
+(<a href="#morallyequalp">morally-equal?</a> obj1 obj2)
</pre>
-<p>The second example includes the optional initial element.
-<code>(vect i ...)</code> or <code>(vector-ref vect i ...)</code> return the given
-element, and <code>(set! (vect i ...) value)</code> and <code>(vector-set! vect i ... value)</code>
-set it. vector-length (or just length) returns the total number of elements.
-vector-dimensions returns a list of the dimensions.
+<p><b>reverse!</b> is an in-place version of reverse. That is,
+it modifies the sequence passed to it in the process of reversing its contents.
+If the sequence is a list, remember to use set!:
+<code>(set! p (reverse! p))</code>. This is somewhat inconsistent with other cases,
+but historically, lisp programmers have treated the in-place reverse as the fast
+version, so s7 follows suit.
</p>
-<pre>
- > (define v (make-vector '(2 3) 1.0))
- #2D((1.0 1.0 1.0) (1.0 1.0 1.0))
+<p>Leaving aside the weird list case,
+<b>append</b> returns a sequence of the same type as its first argument.
+</p>
- > (set! (v 0 1) 2.0)
- #2D((1.0 2.0 1.0) (1.0 1.0 1.0))
+<pre class="indented">
+> (append #(1 2) '(3 4))
+<em class="gray">#(1 2 3 4)</em>
+> (append (float-vector) '(1 2) (byte-vector 3 4))
+<em class="gray">(float-vector 1.0 2.0 3.0 4.0)</em>
+</pre>
- > (v 0 1)
- 2.0
+<p>
+<b>sort!</b> sorts a sequence using the
+function passed as its second argument:
+</p>
- > (vector-length v)
- 6
+<pre class="indented">
+> (sort! (list 3 4 8 2 0 1 5 9 7 6) <)
+<em class="gray">(0 1 2 3 4 5 6 7 8 9)</em>
</pre>
-<small>
-<blockquote>
+<p>Underlying some of these functions are generic iterators, also built-into s7:
+</p>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<pre class="indented">
+(<em class=def id="makeiterator">make-iterator</em> sequence)
+(<em class=def id="iteratorp">iterator?</em> obj)
+(<em class=def id="iterate">iterate</em> iterator)
+(<em class=def id="iteratorsequence">iterator-sequence</em> iterator)
+(<em class=def id="iteratoratend">iterator-at-end?</em> iterator)
+</pre>
-<p>matrix multiplication:
+<p><b>make-iterator</b> takes a sequence argument and returns an iterator object that traverses
+that sequence as it is called. The iterator itself can be treated as a function of no arguments,
+or (for code clarity) it can be the argument to <b>iterate</b>, which does the same thing.
+That is <code>(iter)</code> is the same as <code>(iterate iter)</code>. The sequence that an iterator is traversing
+is <b>iterator-sequence</b>.
+</p>
+<p>
+If the sequence is a hash-table or let, the iterator normally returns a cons of the key and value.
+There are many cases where this overhead is objectionable, so make-iterator takes a third optional
+argument, the cons to use (changing its car and cdr directly on each call).
</p>
-<pre>
-(define (matrix-multiply A B)
- ;; assume square matrices and so on here for simplicity
- (let* ((size (car (vector-dimensions A)))
- (C (make-vector (list size size) 0)))
- (do ((i 0 (+ i 1)))
- ((= i size) C)
- (do ((j 0 (+ j 1)))
- ((= j size))
- (let ((sum 0))
- (do ((k 0 (+ k 1)))
- ((= k size))
- (set! sum (+ sum (* (A i k) (B k j)))))
- (set! (C i j) sum))))))
+<p>When an iterator reaches the end of its sequence, it returns #<eof>. It used to
+return nil; I can't decide whether this change is an improvement. If an iterator over a
+list notices that its list is circular, it returns #<eof>. map and for-each use
+iterators, so if you pass a circular list to either, it will stop eventually. (An
+arcane consequence for method writers: specialize make-iterator, not map or for-each).
+</p>
+
+<pre class="indented">
+(define (find-if f sequence)
+ (let ((iter (make-iterator sequence)))
+ (do ((x (iter) (iter)))
+ ((or (eof-object? x) (f x))
+ (and (not (eof-object? x)) x)))))
</pre>
+<p>But of course a sequence might contain #<eof>! So to be really safe, use iterator-at-end?
+instead of eof-object?.
+</p>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<p>The argument to make-iterator can also be a function or macro.
+There should be a variable named 'iterator with a non-#f
+value in the closure's environment:
+</p>
+<pre class="indented">
+(define (make-circular-iterator obj)
+ (let ((iter (make-iterator obj)))
+ (make-iterator
+ (let ((iterator? #t))
+ (lambda ()
+ (let ((result (iter)))
+ (if (eof-object? result)
+ ((set! iter (make-iterator obj)))
+ result)))))))
+</pre>
+<p>The 'iterator? variable is similar to the 'documentation variable used by procedure-documentation.
+It gives make-iterator some hope of catching inadvertent bogus function arguments that would
+otherwise cause an infinite loop.
+</p>
-<p>Multidimensional vector constant syntax is modelled after CL: #nd(...) or #nD(...)
-signals that the lists specify the elements of an 'n' dimensional vector: <code>#2D((1 2 3) (4 5 6))</code>
+
+<div class="header" id="multidimensionalvectors"><h4>multidimensional vectors</h4></div>
+
+
+<p>
+s7 supports
+vectors with any number of dimensions. It is here, in particular, that generalized
+set! shines. make-vector's second argument can be a list of dimensions, rather than
+an integer as in the one dimensional case:
+</p>
+
+<pre class="indented">
+(make-vector (list 2 3 4))
+(make-vector '(2 3) 1.0)
+(vector-dimensions (make-vector (list 2 3 4))) -> (2 3 4)
+</pre>
+
+<p>The second example includes the optional initial element.
+<code>(vect i ...)</code> or <code>(vector-ref vect i ...)</code> return the given
+element, and <code>(set! (vect i ...) value)</code> and <code>(vector-set! vect i ... value)</code>
+set it. vector-length (or just length) returns the total number of elements.
+vector-dimensions returns a list of the dimensions.
+</p>
+
+<pre class="indented">
+> (define v (make-vector '(2 3) 1.0))
+<em class="gray">#2D((1.0 1.0 1.0) (1.0 1.0 1.0))</em>
+> (set! (v 0 1) 2.0)
+<em class="gray">#2D((1.0 2.0 1.0) (1.0 1.0 1.0))</em>
+> (v 0 1)
+<em class="gray">2.0</em>
+> (vector-length v)
+<em class="gray">6</em>
+</pre>
+
+<p>This function initializes each element of a multidimensional vector:
+</p>
+
+<pre class="indented">
+(define (make-array dims . inits)
+ (make-shared-vector (apply vector (flatten inits)) dims))
+
+> (make-array '(3 3) '(1 1 1) '(2 2 2) '(3 3 3))
+<em class="gray">#2D((1 1 1) (2 2 2) (3 3 3))</em>
+</pre>
+
+<p>make-vector also takes an optional fourth argument. If it is #t, and the initial-value
+is either an integer or a real, make-vector produces a homogenous vector, a vector that
+can only hold elements of the same type as the initial value (either s7_int or s7_double
+internally). Homogenous vectors are mostly useful in conjunction with C code. These
+homogenous vector functions are currently built-in:
+</p>
+
+<pre class="indented">
+(<em class=def>float-vector?</em> obj)
+(<em class=def>float-vector</em> . args)
+(<em class=def>make-float-vector</em> len (init 0.0))
+(<em class=def>float-vector-ref</em> obj . indices)
+(<em class=def>float-vector-set!</em> obj indices[...] value)
+
+(<em class=def id="intvectorp">int-vector?</em> obj)
+(<em class=def id="intvector">int-vector</em> . args)
+(<em class=def id="makeintvector">make-int-vector</em> len (init 0))
+(<em class=def id="intvectorref">int-vector-ref</em> obj . indices)
+(<em class=def id="intvectorset">int-vector-set!</em> obj indices[...] value)
+</pre>
+
+<div class="indented">
+<p>And also, for completeness:</p>
+<pre class="indented">
+(<em class=def id="bytevectorp">byte-vector?</em> obj)
+(<em class=def id="bytevector">byte-vector</em> . args)
+(<em class=def id="makebytevector">make-byte-vector</em> len (init 0))
+(<em class=def id="tobytevector">->byte-vector</em> str)
+</pre>
+<p>but these are really just strings in disguise.</p>
+</div>
+
+<p>To access a vector's elements with different dimensions than the original had, use
+<code>(make-shared-vector original-vector new-dimensions (offset 0))</code>:
+</p>
+
+<pre class="indented">
+> (let ((v1 #2d((1 2 3) (4 5 6))))
+ (let ((v2 (make-shared-vector v1 '(6)))) ; flatten the original
+ v2))
+<em class="gray">#(1 2 3 4 5 6)</em>
+> (let ((v1 #(1 2 3 4 5 6)))
+ (let ((v2 (make-shared-vector v1 '(3 2))))
+ v2))
+<em class="gray">#2D((1 2) (3 4) (5 6))</em>
+</pre>
+<blockquote>
+
+<div class="indented">
+
+<p>matrix multiplication:
</p>
<pre>
- > (vector-ref #2D((1 2 3) (4 5 6)) 1 2)
- 6
+(define (matrix-multiply A B)
+ ;; assume square matrices and so on for simplicity
+ (let* ((size (car (vector-dimensions A)))
+ (C (make-vector (list size size) 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i size) C)
+ (do ((j 0 (+ j 1)))
+ ((= j size))
+ (let ((sum 0))
+ (do ((k 0 (+ k 1)))
+ ((= k size))
+ (set! sum (+ sum (* (A i k) (B k j)))))
+ (set! (C i j) sum))))))
+</pre>
+</div>
+
+
+<div class="indented">
+
+<p>Conway's game of Life:
+</p>
+
+<pre>
+(define* (life (width 40) (height 40))
+ (let ((state0 (make-vector (list width height) 0))
+ (state1 (make-vector (list width height) 0)))
+
+ ;; initialize with some random pattern
+ (do ((x 0 (+ x 1)))
+ ((= x width))
+ (do ((y 0 (+ y 1)))
+ ((= y height))
+ (set! (state0 x y) (if (< (random 100) 15) 1 0))))
+
+ (do () ()
+ ;; show current state (using terminal escape sequences, borrowed from the Rosetta C code)
+ (format *stderr* "~C[H" #\escape) ; ESC H = tab set
+ (do ((y 0 (+ y 1)))
+ ((= y height))
+ (do ((x 0 (+ x 1)))
+ ((= x width))
+ (if (zero? (state0 x y))
+ (format *stderr* " ") ; ESC 07m below = inverse
+ (format *stderr* "~C[07m ~C[m" #\escape #\escape)))
+ (format *stderr* "~C[E" #\escape)) ; ESC E = next line
+
+ ;; get the next state
+ (do ((x 1 (+ x 1)))
+ ((= x (- width 1)))
+ (do ((y 1 (+ y 1)))
+ ((= y (- height 1)))
+ (let ((n (+ (state0 (- x 1) (- y 1))
+ (state0 x (- y 1))
+ (state0 (+ x 1) (- y 1))
+ (state0 (- x 1) y)
+ (state0 (+ x 1) y)
+ (state0 (- x 1) (+ y 1))
+ (state0 x (+ y 1))
+ (state0 (+ x 1) (+ y 1)))))
+ (set! (state1 x y)
+ (if (or (= n 3)
+ (and (= n 2)
+ (not (zero? (state0 x y)))))
+ 1 0)))))
+ (do ((x 0 (+ x 1)))
+ ((= x width))
+ (do ((y 0 (+ y 1)))
+ ((= y height))
+ (set! (state0 x y) (state1 x y)))))))
+</pre>
+</div>
+
+
+<div class="indented">
- > (matrix-multiply #2d((-1 0) (0 -1)) #2d((2 0) (-2 2)))
- #2D((-2 0) (2 -2))
+<p>Multidimensional vector constant syntax is modelled after CL: #nd(...) or #nD(...)
+signals that the lists specify the elements of an 'n' dimensional vector: <code>#2D((1 2 3) (4 5 6))</code>
+</p>
+
+<pre class="indented">
+> (vector-ref #2D((1 2 3) (4 5 6)) 1 2)
+<em class="gray">6</em>
+> (matrix-multiply #2d((-1 0) (0 -1)) #2d((2 0) (-2 2)))
+<em class="gray">#2D((-2 0) (2 -2))</em>
</pre>
<p>If any dimension has 0 length, you get an n-dimensional empty vector. It is not
equal to a 1-dimensional empty vector.
</p>
-<pre>
- > (make-vector '(10 0 3))
- #3D()
-
- > (equal? #() #3D())
- #f
+<pre class="indented">
+> (make-vector '(10 0 3))
+<em class="gray">#3D()</em>
+> (equal? #() #3D())
+<em class="gray">#f</em>
</pre>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>To save on costly parentheses, and make it easier to write generic multidimensional sequence functions,
you can use this same syntax with lists.
</p>
-<pre>
+<pre class="indented">
> (let ((L '((1 2 3) (4 5 6))))
(L 1 0)) ; same as (list-ref (list-ref L 1) 0) or ((L 1) 0)
-4
-
+<em class="gray">4</em>
> (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))))
(set! (L 1 0 2) 32) ; same as (list-set! (list-ref (list-ref L 1) 0) 2 32) which is unreadable!
L)
-(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))
+<em class="gray">(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))</em>
</pre>
<p>Or with vectors of vectors, of course:
</p>
-<pre>
-> (let ((V '#(#(1 2 3) #(4 5 6))))
+<pre class="indented">
+> (let ((V #(#(1 2 3) #(4 5 6))))
(V 1 2)) ; same as (vector-ref (vector-ref V 1) 2) or ((V 1) 2)
-6
-
+<em class="gray">6</em>
> (let ((V #2d((1 2 3) (4 5 6))))
(V 0))
-#(1 2 3)
+<em class="gray">#(1 2 3)</em>
</pre>
<p>There's one difference between a vector-of-vectors and a multidimensional vector:
in the latter case, you can't clobber one of the inner vectors.
</p>
-<pre>
-> (let ((V '#(#(1 2 3) #(4 5 6)))) (set! (V 1) 32) V)
-#(#(1 2 3) 32)
-
+<pre class="indented">
+> (let ((V #(#(1 2 3) #(4 5 6)))) (set! (V 1) 32) V)
+<em class="gray">#(#(1 2 3) 32)</em>
> (let ((V #2d((1 2 3) (4 5 6)))) (set! (V 1) 32) V)
-;not enough args for vector-set!: (#2D((1 2 3) (4 5 6)) 1 32)
+<em class="gray">;not enough args for vector-set!: (#2D((1 2 3) (4 5 6)) 1 32)</em>
</pre>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<div class="indented">
<p>Using lists to display the inner vectors may not be optimal, especially when the elements are also lists:
</p>
-<pre>
+<pre class="indented">
#2D(((0) (0) ((0))) ((0) 0 ((0))))
</pre>
@@ -2324,501 +2117,1259 @@ in the latter case, you can't clobber one of the inner vectors.
Perhaps we could use different colors? Or different size parentheses?
</p>
-<pre>
+<pre class="indented">
#2D<em class=green>(</em><em class=red>(</em>(0) (0) ((0))<em class=red>)</em> <em class=red>(</em>(0) 0 ((0))<em class=red>)</em><em class=green>)</em>
-#2D<big><big>(</big>(</big>(0) (0) ((0))<big>)</big> <big>(</big>(0) 0 ((0))<big>)<big>)</big></big>
+#2D<em class="bigger">(</em><em class="big">(</em>(0) (0) ((0))<em class="big">)</em> <em class="big">(</em>(0) 0 ((0))<em class="big">)</em><em class="bigger">)</em>
</pre>
+<p>A similar problem afflicts homogenous vectors. We need some reasonable way to express
+such a vector even when it has more than one dimension. My first thought was <code>#(...)#</code>,
+but that makes <code>(let ((b1 0)) (#(1 2)#b1))</code> ambiguous.
+</p>
+
+</div>
+
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+
+<div class="indented">
<p>I'm not sure how to handle vector->list and list->vector in the multidimensional case.
Currently, vector->list flattens the vector, and list->vector always returns a
one dimensional vector, so the two are not inverses.
</p>
-<pre>
+<pre class="indented">
> (vector->list #2d((1 2) (3 4)))
-(1 2 3 4) ; should this be '((1 2) (3 4)) or '(#(1 2) #(3 4))?
+<em class="gray">(1 2 3 4)</em> ; should this be '((1 2) (3 4)) or '(#(1 2) #(3 4))?
> (list->vector '(#(1 2) #(3 4))) ; what about '((1 2) (3 4))?
-#(#(1 2) #(3 4))
+<em class="gray">#(#(1 2) #(3 4)) </em>
</pre>
-<p>Perhaps I should add an optional number-of-dimensions argument?
+<p>
This also affects format and sort!:
</p>
-<pre>
+<pre class="indented">
> (format #f "~{~A~^ ~}" #2d((1 2) (3 4)))
-"1 2 3 4"
-
+<em class="gray">"1 2 3 4"</em>
> (sort! #2d((1 4) (3 2)) >)
-#2D((4 3) (2 1))
+<em class="gray">#2D((4 3) (2 1))</em>
+</pre>
+
+<p>Perhaps make-shared-vector can help:
+</p>
+
+<pre class="indented">
+>(make-shared-vector (list->vector '(1 2 3 4)) '(2 2))
+<em class="gray">#2D((1 2) (3 4))</em>
+</pre>
+
+</div>
+
+<div class="indented">
+
+<p>Another question: should we accept the multi-index syntax in a case such as:
+</p>
+
+<pre class="indented">
+(let ((v #("abc" "def")))
+ (v 0 2))
+</pre>
+
+<p>My first thought was that the indices should all refer to the same
+type of object, so s7 would complain in a mixed case like that.
+If we can nest any applicable objects and apply the whole thing to
+an arbitrary list of indices, ambiguities arise:
+</p>
+
+<pre class="indented">
+((lambda (x) x) "hi" 0)
+((lambda (x) (lambda (y) (+ x y))) 1 2)
+</pre>
+
+<p>I think these should complain that the function got too many arguments,
+but from the implicit indexing point of view, they could be interpreted
+as:
+</p>
+
+<pre class="indented">
+(string-ref ((lambda (x) x) "hi") 0) ; i.e. (((lambda (x) x) "hi") 0)
+(((lambda (x) (lambda (y) (+ x y))) 1) 2)
</pre>
+<p>Add optional and rest arguments, and you can't tell who is supposed to
+take which arguments.
+Currently, you can mix types with implicit indices,
+but a function grabs all remaining indices. Trickier than I expected!
+</p>
+
+</div>
+
</blockquote>
-</small>
-</dd>
-<br><br>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="hashtables"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>hash-tables</h4></td></tr></table>
-</td></tr></table>
-</dt>
-<dd><br>
+
+
+
+<div class="header" id="hashtables"><h4>hash-tables</h4></div>
+
+
<ul>
-<li>(<a name="makehashtable">make-hash-table</a> (size 512))
-<li>(<a name="hashtable">hash-table</a> ...)
-<li>(hash-table-ref ht key)
-<li>(hash-table-set! ht key value)
-<li>(hash-table? obj)
-<li>(hash-table-size ht)
-<li>(make-hash-table-iterator ht)
+<li>(<em class=def id="makehashtable">make-hash-table</em> (size 8) eq-func)
+<li>(<em class=def id="hashtable">hash-table</em> ...)
+<li>(<em class=def id="hashtablestar">hash-table*</em> ...)
+<li>(<em class=def id="hashtablep">hash-table?</em> obj)
+<li>(<em class=def id="hashtableref">hash-table-ref</em> ht key)
+<li>(<em class=def id="hashtableset">hash-table-set!</em> ht key value)
+<li>(<em class=def id="hashtableentries">hash-table-entries</em> ht)
</ul>
<p>
-Any s7 object can be the key or the key's value.
Each hash-table keeps track of the keys it contains, optimizing the search wherever possible.
+Any s7 object can be the key or the key's value.
If you pass a table size that is not a power of 2, make-hash-table rounds it up to the next power of 2.
+The table grows as needed. length returns the current size.
+If a key is not in the table, hash-table-ref returns #f. To remove a key,
+set its value to #f; to remove all keys, <code>(fill! table #f)</code>.
</p>
-<pre>
-(let ((ht (make-hash-table)))
- (set! (ht "hi") 123)
- (ht "hi"))
-
--> 123
+<pre class="indented">
+> (let ((ht (make-hash-table)))
+ (set! (ht "hi") 123)
+ (ht "hi"))
+<em class="gray">123</em>
</pre>
-<p>hash-table (the function) parallels (the functions) vector, list, and string. Its arguments are cons's containing key/value pairs.
+<p>hash-table (the function) parallels the functions vector, list, and string. Its arguments are conses containing key/value pairs.
The result is a new hash-table with those values preinstalled: <code>(hash-table '("hi" . 32) '("ho" . 1))</code>.
-make-hash-table-iterator returns a function of no arguments (a "thunk"). Each time you call this function, it
-returns the next entry in the hash table. When it runs out of entries, it returns nil.
+After much use, I now think it is more convenient here, as in inlet, to use hash-table*; its arguments are
+simply the keys and values, without the consing: <code>(hash-table* 'a 1 'b 2)</code>.
+Implicit indexing gives multilevel hashes:
</p>
+<pre class="indented">
+> (let ((h (hash-table* 'a (hash-table* 'b 2 'c 3)))) (h 'a 'b))
+<em class="gray">2</em>
+> (let ((h (hash-table* 'a (hash-table* 'b 2 'c 3)))) (set! (h 'a 'b) 4) (h 'a 'b))
+<em class="gray">4</em>
+</pre>
-<small>
<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>Since hash-tables accept the same applicable-object syntax that vectors use, we can
treat a hash-table as, for example, a sparse array:
</p>
-<pre>
+<pre class="indented">
> (define make-sparse-array make-hash-table)
-make-sparse-array
-
+<em class="gray">make-sparse-array</em>
> (let ((arr (make-sparse-array)))
(set! (arr 1032) "1032")
(set! (arr -23) "-23")
(list (arr 1032) (arr -23)))
-("1032" "-23")
+<em class="gray">("1032" "-23")</em>
</pre>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>map and for-each accept hash-table arguments. On each iteration, the map or for-each function is passed
-an entry, <code>'(key . value)</code>, in whatever order the entries are encountered in the table. (Both use
-make-hash-table-iterator internally).
+an entry, <code>'(key . value)</code>, in whatever order the entries are encountered in the table.
</p>
-<pre>
+<pre class="indented">
(define (hash-table->alist table)
- (map (lambda (x) x) table)) ; clearer perhaps than (map values table), append would also work here
+ (map values table))
+
+(define (merge-hash-tables . tables) ; probably faster: (define merge-hash-tables append)
+ (apply hash-table
+ (apply append
+ (map hash-table->alist tables))))
</pre>
<p>reverse of a hash-table returns a new table with the keys and values reversed.
-<code>(fill! table '())</code> removes all entries from the hash-table.
-</p>
+fill! sets all the values.
+Two hash-tables are equal if they have the same keys with the same values. This is independent
+of the table sizes, or the order in which the key/value pairs were added.
+</p>
+</div>
+
+<div class="indented">
+<p>The third argument to make-hash-table (eq-func) is slightly complicated. If it is omitted,
+s7 chooses the hashing equality and mapping functions based on the keys in the hash-table.
+There are times when you know
+in advance what equality function you want. If it's one of the built-in s7 equality
+functions, eq?, eqv?, equal?, morally-equal?, =, string=?, string-ci=?, char=?, or char-ci=?,
+you can pass that function as the third argument. In any other case, you need to
+give s7 both the equality function and the mapping function. The latter takes any object
+and returns the hash-table location for it (an integer). The problem here is that
+for the arbitrary equality function to work, objects that are equal according to that
+function have to be mapped to the same hash-table location. There's no way for s7 to intuit
+what this mapping should be except in the built-in cases. So to specify some arbitrary function, the third
+argument is a cons: '(equality-checker mapper).
+</p>
+
+<p>Here's a brief example. In CLM, we have c-objects of type mus-generator (from s7's point of view),
+and we want to hash them using equal? (which will call the generator-specific equality function).
+But s7 doesn't realize that the mus-generator type covers 40 or 50 internal types, so as the mapper we pass mus-type:
+<code>(make-hash-table 64 (cons equal? mus-type))</code>.
+</p>
+</div>
+
+<div class="indented">
+<p>If the hash key is a float (a non-rational number), hash-table-ref uses <a href="#morallyequalp">morally-equal?</a>.
+Otherwise, for example, you could use NaN as a key, but then never be able to access it!
+</p>
+</div>
+
+
+<div class="indented">
+<pre>
+(define-macro (define-memoized name&arg . body)
+ (let ((arg (cadr name&arg))
+ (memo (gensym "memo")))
+ `(define ,(car name&arg)
+ (let ((,memo (<em class=red>make-hash-table</em>)))
+ (lambda (,arg)
+ (or (,memo ,arg) ; check for saved value
+ (set! (,memo ,arg) (begin , at body)))))))) ; set! returns the new value
+
+> (define (fib n)
+ (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
+<em class="gray">fib</em>
+> (define-memoized
+ (memo-fib n)
+ (if (< n 2) n (+ (memo-fib (- n 1)) (memo-fib (- n 2)))))
+<em class="gray">memo-fib</em>
+> (time (fib 34)) ; un-memoized time
+<em class="gray">1.168</em> ; 0.70 on ccrma's i7-3930 machines
+> (time (memo-fib 34)) ; memoized time
+<em class="gray">3.200e-05</em>
+> (outlet (funclet memo-fib))
+<em class="gray">(inlet '{memo}-18 (hash-table
+ '(0 . 0) '(1 . 1) '(2 . 1) '(3 . 2) '(4 . 3) '(5 . 5)
+ '(6 . 8) '(7 . 13) '(8 . 21) '(9 . 34) '(10 . 55) '(11 . 89)
+ '(12 . 144) '(13 . 233) '(14 . 377) '(15 . 610) '(16 . 987)
+ '(17 . 1597) '(18 . 2584) '(19 . 4181) '(20 . 6765) '(21 . 10946)
+ '(22 . 17711) '(23 . 28657) '(24 . 46368) '(25 . 75025) '(26 . 121393)
+ '(27 . 196418) '(28 . 317811) '(29 . 514229) '(30 . 832040) '(31 . 1346269)
+ '(32 . 2178309) '(33 . 3524578) '(34 . 5702887)))</em>
+</pre>
+</div>
</blockquote>
-</small>
-</dd>
-<br><br>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="hooks"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>hooks</h4></td></tr></table>
-</td></tr></table>
-</dt>
-<dd>
-<pre>
- (<a name="makehook">make-hook</a> (arity (0 0 #f)) (documentation "")) ; make a new hook
- (<a name="hook">hook</a> ...) ; make a hook, the args are functions
- (hook? obj) ; return #t if obj is a hook
- (<a name="hookfunctions">hook-functions</a> hook) ; the hook's list of functions
- (<a name="hookarity">hook-arity</a> hook) ; the hook's arity list: (required optional rest)
- (hook-documentation hook) ; the hook's documentation string
- (hook-apply hook ...) and (<hook> ...) ; run the hook (it is an applicable object)
-</pre>
+<div class="header" id="environments"><h4>environments</h4></div>
-<p>A hook holds a list of functions. When something interesting happens,
-the hook is invoked, and it applies its arguments to each function in the list.
-In GUI toolkits hooks are called callback-lists, in CL conditions,
-in other contexts watchpoints or signals. s7 itself has several
-hooks: *trace-hook*, *error-hook*, *unbound-variable-hook*, and *load-hook*.
-A hook is created with make-hook or hook, called either as an applicable object
-or via hook-apply, and recognized via hook?. The list of functions is accessed
-via hook-functions. All the functions on the list have to be compatible with
-the way the hook itself is invoked, so the hook has an arity, hook-arity.
+
+<p>An environment holds symbols and their values. The global environment, for example,
+holds all the variables that are defined at the top level.
+Environments are first class (and applicable) objects in s7.
</p>
-<pre>
-> (let ((h (make-hook '(1 0 #f) "an example hook"))) ; 1 required arg and no others
- (set! (hook-functions h) ; add 1 function to the hook's list
- (list (lambda (x) (format #t "x is ~A" x))))
- (h 23)) ; invoke the hook's functions with argument 23
-"x is 23"
-</pre>
+<pre class="indented">
+(<em class=def id="rootlet">rootlet</em>) the top-level (global) environment
+(<em class=def id="curlet">curlet</em>) the current (innermost) environment
+(<em class=def id="funclet">funclet</em> proc) the environment at the time when proc was defined
+(owlet) the environment at the point of the last error
+(<em class=def id="unlet">unlet</em>) the current environment, but all built-in functions have their original values
-</dd>
-<br><br>
+(<em class=def id="letref">let-ref</em> env sym) get value of sym in env, same as (env sym)
+(<em class=def id="letset">let-set!</em> env sym val)
+
+(<em class=def id="inlet">inlet</em> . bindings) make a new environment with the given bindings
+(<em class=def id="sublet">sublet</em> env . bindings) same as inlet, but the new environment is local to env
+(<em class=def id="varlet">varlet</em> env . bindings) add new bindings directly to env
+(<em class=def id="cutlet">cutlet</em> env . fields) remove bindings from env
+
+(<em class=def id="letp">let?</em> obj) #t if obj is an environment
+(<em class=def id="with-let">with-let</em> env . body) evaluate body in the environment env
+(<em class=def id="outlet">outlet</em> env) the environment that encloses the environment env (settable)
+(<em class=def id="lettolist">let->list</em> env) return the environment bindings as a list of (symbol . value) cons's
+(<em class=def id="openlet">openlet</em> env) mark env as open (see below)
+(<em class=def id="openletp">openlet?</em> env) #t is env is open
+(<em class=def id="coverlet">coverlet</em> env) mark env as closed (undo an earlier openlet)
+</pre>
+<br>
+<blockquote>
+<pre class="indented">
+> (inlet 'a 1 'b 2)
+<em class="gray">(inlet 'a 1 'b 2)</em>
+> (let ((a 1) (b 2)) (curlet))
+<em class="gray">(inlet 'a 1 'b 2)</em>
+> (let ((x (inlet :a 1 :b 2))) (x 'a))
+<em class="gray">1</em>
+> (with-let (inlet 'a 1 'b 2) (+ a b))
+<em class="gray">3</em>
+> (let ((x (inlet :a 1 :b 2))) (set! (x 'a) 4) x)
+<em class="gray">(inlet 'a 4 'b 2)</em>
+> (let ((x (inlet))) (varlet x 'a 1) x)
+<em class="gray">(inlet 'a 1)</em>
+> (let ((a 1)) (let ((b 2)) (outlet (curlet))))
+<em class="gray">(inlet 'a 1)</em>
+> (let ((e (inlet 'a (inlet 'b 1 'c 2)))) (e 'a 'b)) ; in C terms, e->a->b
+<em class="gray">1</em>
+> (let ((e (inlet 'a (inlet 'b 1 'c 2)))) (set! (e 'a 'b) 3) (e 'a 'b))
+<em class="gray">3</em>
+</pre>
+</blockquote>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="multithreading"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>threads</h4></td></tr></table>
-</td></tr></table>
-</dt>
-<dd><p>If s7 is built with HAVE_PTHREADS set, you get multithreading functions.
+<p>As the names suggest, in s7 an environment is viewed as a disembodied let. Environments are equal if they
+contain the same symbols with the same values leaving aside shadowing, and taking into account the environment
+chain up to the rootlet. That is, two environments are equal if any local variable of either has the same value in both.
</p>
+<p>with-let evaluates its body in the given environment, so
+<code>(with-let e . body)</code> is equivalent to
+<code>(eval `(begin , at body) e)</code>, but probably faster.
+Similarly, <code>(let bindings . body)</code> is equivalent to
+<code>(eval `(begin , at body) (apply inlet (flatten bindings)))</code>,
+ignoring the outer (enclosing) environment (the default outer environment
+of inlet is rootlet).
+Or better,
+</p>
+<pre class="indented">
+(define-macro (with-environs e . body)
+ `(apply let (map (lambda (a) (list (car a) (cdr a))) ,e) '(, at body)))
+</pre>
+<p>Or turning it around,</p>
<pre>
- (<a name="makethread">make-thread</a> thunk (stack-size 300)) ; create a thread running thunk, return id: pthread_create
- (<a name="jointhread">join-thread</a> thread) ; wait for thread to finish, return value returned by thunk: pthread_join
- (thread? obj) ; #t if obj is a thread
- (<a name="makelock">make-lock</a>) ; mutex allocation and pthread_mutext_init
- (<a name="grablock">grab-lock</a> lock) ; pthread_mutex_lock
- (<a name="releaselock">release-lock</a> lock) ; pthread_mutex_unlock
- (lock? obj) ; #t if obj is a lock
- (<a name="makethreadvariable">make-thread-variable</a>) ; pthread_key_create
- (thread-variable? obj) ; #t if obj is a thread-variable (pthread_key)
+(define-macro (Let vars . body)
+ `(with-let (sublet (curlet)
+ ,@(map (lambda (var)
+ (values (symbol->keyword (car var)) (cadr var)))
+ vars))
+ , at body))
+
+(Let ((c 4))
+ (Let ((a 2)
+ (b (+ c 2)))
+ (+ a b c)))
</pre>
<p>
-Threads in s7 share the heap and symbol table, but have their own local environment, stack,
-and evaluator locals. I use the term "lock" in place of "mutex", and "thread-variable"
-in place of "pthread_key". The thread-variable is applicable and settable, so instead
-of pthread_getspecific, just call it: <code>(var)</code>.
-</p>
+sublet adds bindings (symbols with associated values) to an environment.
+It does not change the environment passed to it, but
+just prepends the new bindings, shadowing any old ones,
+as if you had called "let".
+To add the bindings directly to the environment,
+use varlet. Both of these functions accept nil as the
+'env' argument as shorthand for <code>(rootlet)</code>.
+Both also accept other environments as well as individual bindings,
+adding all the argument's bindings to the new environment.
+inlet is very similar, but normally omits the environment argument.
+The arguments to sublet and inlet can be passed as
+symbol/value pairs, as a cons, or using keywords as if in define*.
+inlet can also be used to copy an environment without accidentally invoking
+that environment's copy method.
+</p>
+
+<p>One way to add reader and writer functions to an individual environment slot is:
+</p>
+
+<pre class="indented">
+(define e (inlet
+ 'x (let ((local-x 3)) ; x's initial value
+ (dilambda
+ (lambda () local-x)
+ (lambda (val) (set! local-x (max 0 (min val 100))))))))
+> ((e 'x))
+<em class="gray">3</em>
+> (set! ((e 'x)) 123)
+<em class="gray">100</em>
+</pre>
-<pre>
-(let ((a-lock (make-lock))
- (threads '())
- (a-thread-variable (make-thread-variable)))
- (let loop
- ((i 0))
- (set! threads (cons (make-thread
- (lambda ()
- (set! (a-thread-variable) i)
- (grab-lock a-lock)
- (format #t "thread ~A " (a-thread-variable))
- (release-lock a-lock)))
- threads))
- (if (< i 8)
- (loop (+ i 1))))
- (for-each
- (lambda (thread)
- (join-thread thread))
- threads))
-</pre>
-
-<p>join-thread returns the value returned by the function passed to make-thread:
+<blockquote>
+<div class="indented">
+<p>I originally used a bunch of foolishly pompous names for the environment functions.
+Two are still available for backwards compatibility:
</p>
-<pre>
-> (let ((ctr1 1)
- (ctr2 2))
- (let ((t1 (make-thread (lambda () (* ctr1 2))))
- (t2 (make-thread (lambda () (* ctr2 3)))))
- (+ (join-thread t1)
- (join-thread t2))))
-8
+<pre class="indented">
+rootlet global-environment
+curlet current-environment
</pre>
+</div>
+</blockquote>
-<small>
-<blockquote>
+<p>It is possible in Scheme to redefine built-in functions such as car.
+To ensure that some code sees the original built-in function definitions,
+wrap it in <code>(with-let (unlet) ...)</code>:
+</p>
+<pre class="indented">
+> (let ((caar 123))
+ (+ caar (with-let (unlet)
+ (caar '((2) 3)))))
+<em class="gray">125</em>
+</pre>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<p>
+with-let and unlet are constants, so you can
+use them in any context without worrying about whether they've been redefined.
+As mentioned in the macro section, #_<name> is a built-in reader macro
+for <code>(with-let (unlet) <name>)</code>,
+so for example, #_+ is the built-in + function, no matter what.
+<code>(unlet)</code> cleans up the current environment whenever it's called,
+so you can use it to revert the REPL.
+</p>
-<pre>
-(define-macro (thread-let bindings . body)
- ;; just like "let", but each variable is set by running a separate thread
- `(let (,@(map (lambda (variable&value)
- `(,(car variable&value) (make-thread (lambda () ,(cadr variable&value)))))
- bindings))
- ,@(map (lambda (variable&value)
- `(set! ,(car variable&value) (join-thread ,(car variable&value))))
- bindings)
- , at body))
+<blockquote>
-> (thread-let ((x (abs -1))
- (y (* 3 2)))
- (+ x y))
-7
+<div class="indented">
-> (macroexpand (thread-let ((x (abs -1)) (y (* 3 2))) (+ x y)))
-(let ((x (make-thread (lambda () (abs -1))))
- (y (make-thread (lambda () (* 3 2)))))
- (set! x (join-thread x))
- (set! y (join-thread y))
- (+ x y))
+<p>
+I think these functions can implement the notions of libraries,
+separate namespaces, or modules.
+Here's one way: first the library writer just writes his library.
+The normal user simply loads it. The abnormal user worries about everything,
+so first he loads the library in a local let to make sure no bindings escape
+to pollute his code, and then he
+uses unlet to
+make sure that none of his bindings pollute the library code:
+</p>
+<pre class="indented">
+(let ()
+ (with-let (unlet)
+ (load "any-library.scm" (curlet))
+ ;; by default load puts stuff in the global environment
+ ...))
+</pre>
-(define-macro (thread-values . vals)
- ;; just like "values", but each value is evaluated by a separate thread
- (let ((gs (map (lambda (var) (gensym)) vals)))
- `(thread-let (,@(map (lambda (g v) `(,g ,v)) gs vals))
- (values , at gs))))
+<p>Now Abnormal User can do what he wants with the library entities.
+Say he wants to use "lognor" under the name "bitwise-not-or", and
+all the other functions are of no interest:
+</p>
-> (+ 1 (thread-values (* 3 2) (abs -1)) 2)
-10
+<pre class="indented">
+(varlet (curlet)
+ 'bitwise-not-or (with-let (unlet)
+ (load "any-library.scm" (curlet))
+ lognor)) ; lognor is presumably defined in "any-library.scm"
</pre>
+<p>Say he wants to make sure the library is cleanly loaded, but all
+its top-level bindings are imported into the current environment:
+</p>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<pre class="indented">
+(varlet (curlet)
+ (with-let (unlet)
+ (let ()
+ (load "any-library.scm" (curlet))
+ (curlet)))) ; these are the bindings introduced by loading the library
+</pre>
-<p>There is some overhead in handling threads, so I usually
-restrict thread use to long computations. Since the heap is currently
-shared, code like this is problematic:
+<p>To do the same thing, but prepend "library:" to each name:
</p>
-<pre>
-(define (fib n)
- (define (fib-1 n)
- (if (< n 2)
- n
- (+ (fib-1 (- n 1))
- (fib-1 (- n 2)))))
- (apply +
- (map join-thread
- (list (make-thread (lambda () (fib-1 (- n 1))))
- (make-thread (lambda () (fib-1 (- n 2))))))))
+<pre class="indented">
+(apply varlet (curlet)
+ (with-let (unlet)
+ (let ()
+ (load "any-library.scm" (curlet))
+ (map (lambda (binding)
+ (cons (string->symbol
+ (string-append "library:" (symbol->string (car binding))))
+ (cdr binding)))
+ (curlet)))))
</pre>
-<p>Lots of temporaries are being allocated here, causing the s7 internal new-cell lock to be set
-and unset so often that almost 20% of the compute time is wasted.
-Of course in real life you'd get the nth Fibonacci number from the formula for it:
+<p>That's all there is to it! Here is the same idea as a macro:
</p>
<pre>
-(define (fib n)
- (let ((phi (/ (+ 1 (sqrt 5)) 2)))
- (floor (/ (- (expt phi n) ; "floor" to return an integer
- (expt (- 1 phi) n))
- (sqrt 5)))))
+(define-macro (let! init end . body)
+ ;; syntax mimics 'do: (let! (vars&values) ((exported-names) result) body)
+ ;; (let! ((a 1)) ((hiho)) (define (hiho x) (+ a x)))
+ `(let ,init
+ , at body
+ (varlet (outlet (curlet))
+ ,@(map (lambda (export)
+ `(cons ',export ,export))
+ (car end)))
+ ,@(cdr end)))
</pre>
-</blockquote>
-</small>
+<!--
+(define-macro (safe-let! init end . body)
+ `(with-let (#_inlet (unlet)
+ ,@(#_map (#_lambda (b)
+ `(#_cons ',(#_car b) ,(#_cadr b)))
+ init))
+ , at body
+ (#_varlet (#_outlet (#_curlet))
+ ,@(#_map (#_lambda (export)
+ `(#_cons ',export ,export))
+ (#_car end)))
+ ,@(#_cdr end)))
+-->
+</div>
-</dd>
-<br><br>
+<div class="indented">
+<p>Well, almost, darn it. If the loaded library file sets (via set!) a global value
+such as abs, we need to put it back to its original form:
+</p>
+<pre>
+(define (safe-load file)
+ (let ((e (with-let (unlet) ; save the environment before loading
+ (let->list (curlet)))))
+ (<em class=red>load</em> file (curlet))
+ (let ((new-e (with-let (unlet) ; get the environment after loading
+ (let->list (curlet)))))
+ (for-each ; see if any built-in functions were stepped on
+ (lambda (sym)
+ (unless (assoc (car sym) e)
+ (format #t "~S clobbered ~A~%" file (car sym))
+ (apply set! (car sym) (list (cdr (assoc (car sym) new-e))))))
+ new-e))))
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="multiplevalues"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>multiple-values</h4></td></tr></table>
-</td></tr></table>
-</dt>
+;; say libtest.scm has the line (set! abs odd?)
-<dd><p>
-In s7, multiple values are spliced directly into the caller's argument list.
+> (safe-load "libtest.scm")
+<em class="gray">"libtest.scm" clobbered abs</em>
+> (abs -2)
+<em class="gray">2</em>
+</pre>
+
+<p>s7test.scm has two more versions of this idea: local-let and protected-let.
+They restore values of both global variables and outlet variables
+when the let (actually dynamic-wind) exits.
</p>
+</div>
+</blockquote>
-<pre>
- > (+ (values 1 2 3) 4)
- 10
- > (string-ref ((lambda () (values "abcd" 2))))
- #\c
- > ((lambda (a b) (+ a b)) ((lambda () (values 1 2))))
- 3
- > (+ (call/cc (lambda (ret) (ret 1 2 3))) 4) ; call/cc has an implicit "values"
- 10
- > ((lambda* ((a 1) (b 2)) (list a b)) (values :a 3))
- (3 2)
- ;; call-with-values:
- (define-macro (call-with-values producer consumer)
- `(,consumer (,producer)))
+<p>openlet marks its argument, either an environment, a closure, or a c-object
+as open. I need better terminology here! An open object is one that the
+built-in s7 functions handle specially. If they encounter one in their
+argument list, they look in the object for their own name, and call that
+function if it exists. A bare-bones example:
+</p>
- ;; multiple-value-bind ("receive" in srfi-8):
- (define-macro (multiple-value-bind vars expr . body)
- `((lambda ,vars , at body) ,expr))
+<pre class="indented">
+> (abs (openlet (inlet 'abs (lambda (x) 47))))
+<em class="gray">47</em>
+> (define* (f1 (a 1)) (if (real? a) (abs a) ((a 'f1) a)))
+<em class="gray">f1</em>
+> (f1 :a (openlet (inlet 'f1 (lambda (e) 47))))
+<em class="gray">47</em>
+</pre>
- ;; multiple-value-set!:
- (define-macro (multiple-value-set! vars expr . body)
- (let ((local-vars (map (lambda (n) (gensym)) vars)))
- `((lambda ,local-vars ,@(map (lambda (n ln) `(set! ,n ,ln)) vars local-vars) , at body) ,expr)))
+<p>In CLOS, we'd declare a class and a method, and call make-instance,
+and then discover that it wouldn't work anyway.
+Here we have, in effect, an anonymous instance of an anonymous class.
+A slightly more complex example:
+</p>
- ;; let*-values is defined as a macro at the end of s7.c (commented out)
+<pre class="indented">
+(let ((e1 (openlet
+ (inlet
+ 'x 3
+ '* (lambda args
+ (if (number? (car args))
+ (apply * (car args) ((cadr args) 'x) (cddr args))
+ (apply * ((car args) 'x) (cdr args))))))))
+ (let ((e2 (copy e1)))
+ (set! (e2 'x) 4)
+ (* 2 e1 e2))) ; (* 2 3 4) => 24
</pre>
+<p>Perhaps these names would be better: openlet -> with-methods, coverlet -> without-methods,
+and openlet? -> methods?.
+</p>
-<small>
<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<details>
+<summary class="indented">define-class</summary>
+<div class="indented">
-<p>There aren't that many real uses for multiple-values in Scheme. Nearly all can be replaced by
-a normal list. There are two cases, however, that can't be handled easily with a list.
-First, you can use "values" to return any number of values, including 0,
-from map's function application:
+<p>Here is yet another object system. Each class and each instance is an environment.
+A class might be thought of as a template for instances, but
+there's actually no difference between them. To make an instance of a class, copy it. To inherit from
+another class, concatenate the environments. To access (get or set) a field or a method, use the implicit
+indexing syntax with the field or method name. To evaluate a form in the context of an instance
+(CL's with-slots), use with-let. To run through all the fields, use map or for-each.
</p>
<pre>
-> (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3))
-(1 20 3 60)
-</pre>
+(define-macro* (define-class class-name inherited-classes (slots ()) (methods ()))
+ `(let ((outer-env (outlet (curlet)))
+ (new-methods ())
+ (new-slots ()))
+
+ (for-each
+ (lambda (class)
+ ;; each class is a set of nested environments, the innermost (first in the list)
+ ;; holds the local slots which are copied each time an instance is created,
+ ;; the next holds the class slots (global to all instances, not copied);
+ ;; these hold the class name and other such info. The remaining environments
+ ;; hold the methods, with the localmost method first. So in this loop, we
+ ;; are gathering the local slots and all the methods of the inherited
+ ;; classes, and will splice them together below as a new class.
+
+ (set! new-slots (append (let->list class) new-slots))
+ (do ((e (outlet (outlet class)) (outlet e)))
+ ((or (not (let? e))
+ (eq? e (rootlet))))
+ (set! new-methods (append (let->list e) new-methods))))
+ ,inherited-classes)
+
+ (let ((remove-duplicates
+ (lambda (lst) ; if multiple local slots with same name, take the localmost
+ (letrec ((rem-dup
+ (lambda (lst nlst)
+ (cond ((null? lst) nlst)
+ ((assq (caar lst) nlst) (rem-dup (cdr lst) nlst))
+ (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+ (reverse (rem-dup lst ()))))))
+ (set! new-slots
+ (remove-duplicates
+ (append (map (lambda (slot)
+ (if (pair? slot)
+ (cons (car slot) (cadr slot))
+ (cons slot #f)))
+ ,slots) ; the incoming new slots, #f is the default value
+ new-slots)))) ; the inherited slots
+
+ (set! new-methods
+ (append (map (lambda (method)
+ (if (pair? method)
+ (cons (car method) (cadr method))
+ (cons method #f)))
+ ,methods) ; the incoming new methods
+
+ ;; add an object->string method for this class (this is already a generic function).
+ (list (cons 'object->string
+ (lambda* (obj (use-write #t))
+ (if (eq? use-write :readable) ; write readably
+ (format #f "(make-~A~{ :~A ~W~^~})"
+ ',class-name
+ (map (lambda (slot)
+ (values (car slot) (cdr slot)))
+ obj))
+ (format #f "#<~A: ~{~A~^ ~}>"
+ ',class-name
+ (map (lambda (slot)
+ (list (car slot) (cdr slot)))
+ obj))))))
+ (reverse! new-methods))) ; the inherited methods, shadowed automatically
+
+ (let ((new-class (openlet
+ (apply sublet ; the local slots
+ (sublet ; the global slots
+ (apply inlet ; the methods
+ (reverse new-methods))
+ 'class-name ',class-name ; class-name slot
+ 'inherited ,inherited-classes
+ 'inheritors ()) ; classes that inherit from this class
+ new-slots))))
+
+ (varlet outer-env
+ ',class-name new-class ; define the class as class-name in the calling environment
+
+ ;; define class-name? type check
+ (string->symbol (string-append (symbol->string ',class-name) "?"))
+ (lambda (obj)
+ (and (let? obj)
+ (eq? (obj 'class-name) ',class-name))))
+
+ (varlet outer-env
+ ;; define the make-instance function for this class.
+ ;; Each slot is a keyword argument to the make function.
+ (string->symbol (string-append "make-" (symbol->string ',class-name)))
+ (apply lambda* (map (lambda (slot)
+ (if (pair? slot)
+ (list (car slot) (cdr slot))
+ (list slot #f)))
+ new-slots)
+ `((let ((new-obj (copy ,,class-name)))
+ ,@(map (lambda (slot)
+ `(set! (new-obj ',(car slot)) ,(car slot)))
+ new-slots)
+ new-obj))))
+
+ ;; save inheritance info for this class for subsequent define-method
+ (letrec ((add-inheritor (lambda (class)
+ (for-each add-inheritor (class 'inherited))
+ (if (not (memq new-class (class 'inheritors)))
+ (set! (class 'inheritors) (cons new-class (class 'inheritors)))))))
+ (for-each add-inheritor ,inherited-classes))
+
+ ',class-name)))
+
+(define-macro (define-generic name) ; (define (genfun any) ((any 'genfun) any))
+ `(define ,name
+ (lambda args
+ (let ((gf ((car args) ',name))) ; get local definition
+ (if (not (eq? gf ,name)) ; avoid infinite recursion
+ (apply gf args)
+ (error "attempt to call generic function wrapper recursively"))))))
+
+(define-macro (define-slot-accessor name slot)
+ `(define ,name (dilambda
+ (lambda (obj) (obj ',slot))
+ (lambda (obj val) (set! (obj ',slot) val)))))
+
+(define-macro (define-method name-and-args . body)
+ `(let* ((outer-env (outlet (curlet)))
+ (method-name (car ',name-and-args))
+ (method-args (cdr ',name-and-args))
+ (object (caar method-args))
+ (class (symbol->value (cadar method-args)))
+ (old-method (class method-name))
+ (method (apply lambda* method-args ',body)))
+
+ ;; define the method as a normal-looking function
+ ;; s7test.scm has define-method-with-next-method that implements call-next-method here
+ ;; it also has make-instance
+ (varlet outer-env
+ method-name (apply lambda* method-args
+ `(((,object ',method-name)
+ ,@(map (lambda (arg)
+ (if (pair? arg) (car arg) arg))
+ method-args)))))
+
+ ;; add the method to the class
+ (varlet (outlet (outlet class)) method-name method)
+
+ ;; if there are inheritors, add it to them as well, but not if they have a shadowing version
+ (for-each
+ (lambda (inheritor)
+ (if (not (eq? (inheritor method-name) #<undefined>)) ; defined? goes to the global env
+ (if (eq? (inheritor method-name) old-method)
+ (set! (inheritor method-name) method))
+ (varlet (outlet (outlet inheritor)) method-name method)))
+ (class 'inheritors))
+
+ method-name))
+
+(define (all-methods obj method)
+ ;; for arbitrary method combinations: this returns a list of all the methods of a given name
+ ;; in obj's class and the classes it inherits from (see example below)
+ (let* ((base-method (obj method))
+ (methods (if (procedure? base-method) (list base-method) ())))
+ (for-each
+ (lambda (ancestor)
+ (let ((next-method (ancestor method)))
+ (if (and (procedure? next-method)
+ (not (memq next-method methods)))
+ (set! methods (cons next-method methods)))))
+ (obj 'inherited))
+ (reverse methods)))
+
+
+> (define-class class-1 ()
+ '((a 1) (b 2))
+ (list (list 'add (lambda (obj)
+ (with-let obj
+ (+ a b))))))
+<em class="gray">class-1</em>
+> (define v (make-class-1 :a 32))
+<em class="gray">v </em>
+> (v 'a) ; to set the 'a slot, (set! (v 'a) 0)
+<em class="gray">32</em>
+> (object->string v) ; built-in functions are all generic
+<em class="gray">"#<class-1: (a 32) (b 2)>"</em> ; so this uses the method defined in the class definition
+> ((v 'add) v)
+<em class="gray">34</em>
+> (define-generic add)
+<em class="gray">add</em>
+> (add v) ; syntactic sugar for ((v 'add) v)
+<em class="gray">34</em>
+> (define-slot-accessor slot-a a) ; more sugar!
+<em class="gray">slot-a</em>
+> (slot-a v) ; same as (v 'a), set via (set! (slot-a v) 123)
+<em class="gray">32</em>
+> (map car v) ; map and for-each work with environments
+<em class="gray">(a b)</em> ; map cdr would return '(32 2) in this case
+> (define-class class-2 (list class-1)
+ '((c 3))
+ (list (list 'multiply (lambda (obj)
+ (with-let obj
+ (* a b c))))))
+<em class="gray">class-2</em>
+> (define v2 (make-class-2 :a 32))
+<em class="gray">v2</em>
+> v2 ; will use object->string
+<em class="gray">"#<class-2: (c 3) (a 32) (b 2)>"</em>
+> ((v2 'multiply) v2)
+<em class="gray">192</em>
+> (add v2) ; inherited from class-1
+<em class="gray">34</em>
+> (define-method (subtract (obj class-1)) (with-let obj (- a b)))
+<em class="gray">subtract</em>
+> (subtract v2) ; class-2 inherits from class-1 so it knows about subtract
+<em class="gray">30</em>
+> (define v1 (make-class-1))
+<em class="gray">v1</em>
+> (varlet v1 ; change the add method just in this instance
+ 'add (lambda (obj)
+ (with-let obj
+ (+ 1 a (* 2 b)))))
+<em class="gray">#<class-1: (a 1) (b 2) (add #<lambda (obj)>)></em>
+> (add v1)
+<em class="gray">6</em>
+> (add v) ; other class-1 instances are not affected
+<em class="gray">34</em>
+> (define-class class-3 (list class-2) ()
+ (list (list 'multiply (lambda (obj num)
+ (* num
+ ((class-2 'multiply) obj) ; method combination
+ (add obj))))))
+<em class="gray">class-3</em>
+> ((class-3 'multiply) class-3 10)
+<em class="gray">180 ; (* 10 (* 1 2 3) (+ 1 2))</em>
+> (define v3 (make-class-3))
+<em class="gray">v3</em>
+> (all-methods v3 'multiply)
+<em class="gray">(#<lambda (obj num)> #<lambda (obj)>)</em>
+> (for-each (lambda (p) (format #t "~A~%" (procedure-source p))) (all-methods v3 'multiply))
+<em class="gray">(lambda (obj num) (* num ((class-2 'multiply) obj) (add obj)))</em>
+<em class="gray">(lambda (obj) (with-let obj (* a b c)))</em>
+</pre>
+
+<p>with-let (used briefly above) provides an even more striking simplification of syntax
+than implicit indexing or multidimensional vectors, and it is faster as well!
+See Snd's generators.scm for many examples.
+</p>
+
+<!--
+at class definition time:
+ (list 'mac (symbol->value (define-macro (mac a) `(+ ,a 1))))
+-->
+</div>
+</details>
+
-<p>As this example shows, if the map function returns <code>(values)</code>, nothing is added to the map output list.
+<details>
+<summary class="indented">more examples</summary>
+<div class="indented">
+<p>Implicit indexing of a local environment
+does not search the global environment. Since unlet extends the
+current environment chain, it is considered a local environment:
</p>
-<pre>
-> (map (lambda (x) (if #f x (values))) (list 1 2))
-()
+<pre class="indented">
+> ((rootlet) 'abs)
+<em class="gray">abs</em>
+> (let () ((curlet) 'abs))
+<em class="gray">#<undefined></em>
+> ((unlet) 'abs)
+<em class="gray">#<undefined></em>
</pre>
-<p>Second, you can use multiple-values to turn off the short-circuit evaluation
-of 'or' and 'and'. Normally these operators
-stop evaluating their arguments as soon as they hit #t ('or') or #f ('and').
-By wrapping the arguments in 'values', you can force all of them to be evaluated:
-</p>
+</div>
-<pre>
-> (let ((x 1))
- (and (let () #f) ; this returns #f so
- (let () (set! x 3) #f)) ; this is never evaluated
- x)
-1
-> (let ((x 1))
- (and (<em class=red>values</em> (let () #f)
- (let () (set! x 3) #f)))
- x)
-3
+<div class="indented">
+<pre>
+(define-macro (value->symbol expr)
+ `(let ((val ,expr)
+ (e1 (curlet)))
+ (call-with-exit
+ (lambda (return)
+ (do ((e e1 (outlet e))) ()
+ (for-each
+ (lambda (slot)
+ (if (equal? val (cdr slot))
+ (return (car slot))))
+ e)
+ (if (eq? e (rootlet))
+ (return #f)))))))
-> (let ((x 1)) ; (apply and ...) has the same effect
- (apply and (list #f (set! x 3))) x)
-3
+> (let ((a 1) (b "hi"))
+ (value->symbol "hi"))
+<em class="gray">b</em>
</pre>
+</div>
-<p>At the top-level, since there's nothing to splice into, so you simply get your values back:
+
+<div class="indented">
+<p>openlet alerts the rest of s7 that the environment has methods.
</p>
<pre>
-> (values 1 (list 1 2) (+ 3 4 5))
-(values 1 (1 2) 12)
-</pre>
-
-<p>But this printout is just trying to be informative. There is no multiple-values object
-in s7. You can't <code>(set! x (values 1 2))</code>, for example. The values function
-tells s7 that its arguments should be handled in a special way, and the multiple-value indication goes away
-as soon as the arguments are spliced into some caller's arguments.
+(begin
+ (define fvector? #f)
+ (define make-fvector #f)
+ (let ((type (gensym))
+ (->float (lambda (x)
+ (if (real? x)
+ (* x 1.0)
+ (error 'wrong-type-arg "fvector new value is not a real: ~A" x)))))
+ (set! make-fvector
+ (lambda* (len (init 0.0))
+ (<em class=red>openlet</em>
+ (inlet :v (make-vector len (->float init))
+ :type type
+ :length (lambda (f) len)
+ :object->string (lambda (f . args) "#<fvector>")
+ :let-set! (lambda (fv i val) (#_vector-set! (fv 'v) i (->float val)))
+ :let-ref (lambda (fv i) (#_vector-ref (fv 'v) i))))))
+ (set! fvector? (lambda (p)
+ (and (let? p)
+ (eq? (p 'type) type))))))
+
+> (define fv (make-fvector 32))
+<em class="gray">fv</em>
+> fv
+<em class="gray">#<fvector></em>
+> (length fv)
+<em class="gray">32</em>
+> (set! (fv 0) 123)
+<em class="gray">123.0</em>
+> (fv 0)
+<em class="gray">123.0</em>
+</pre>
+
+</div>
+
+
+<div class="indented">
+
+<p>I can't resist adding at least some of a quaternion implementation
+(finally "number?" is not the same
+as "complex?"!):
+</p>
+
+<pre>
+(define-class quaternion ()
+ '((r 0) (i 0) (j 0) (k 0))
+ (list (list 'number? (lambda (obj) #t))
+ (list 'complex? (lambda (obj) #f))
+ (list 'real? (lambda (obj) #f))
+ (list 'integer? (lambda (obj) #f))
+ (list 'rational? (lambda (obj) #f))
+
+ (list '+ (lambda orig-args
+ (let add ((r ()) (i ()) (j ()) (k ()) (args orig-args))
+ (if (null? args)
+ (<em class=red>make-quaternion</em>
+ (apply + r) (apply + i) (apply + j) (apply + k))
+ (let ((n (car args)))
+ (cond
+ ((real? n)
+ (add (cons n r) i j k (cdr args)))
+ ((complex? n)
+ (add (cons (real-part n) r) (cons (imag-part n) i) j k (cdr args)))
+ ((<em class=red>quaternion?</em> n)
+ (add (cons (n 'r) r) (cons (n 'i) i)
+ (cons (n 'j) j) (cons (n 'k) k)
+ (cdr args)))
+ ((<em class=red>openlet?</em> n) ; maybe we'll add octonions later!
+ (if (eq? n (car orig-args))
+ (error 'missing-method "+ can't handle these arguments: ~A" args)
+ (apply (n '+)
+ (make-quaternion
+ (apply + r) (apply + i) (apply + j) (apply + k))
+ (cdr args))))
+ (else (error 'wrong-type-arg "+ argument ~A is not a number" n))))))))
+ ))
+
+> (let ((q1 (make-quaternion 1.0 1.0 0.0 0.0)))
+ (+ 1 q1 2.5+i))
+<em class="gray">#<quaternion: (r 4.5) (i 2.0) (j 0.0) (k 0.0)></em>
+</pre>
+
+</div>
+</details>
+
+<div class="indented">
+<p>If an s7 function ignores the type of an argument, as in cons or vector for example,
+then that argument won't be treated as having any methods.
</p>
-<p>Internally, s7 uses <code>(apply values ...)</code> to implement unquote splicing (",@") in quasiquote.
-</p>
+<p>
+Since outlet is settable, there are two ways an environment can
+become circular. One is to include the current environment as the value of one of its variables.
+The other is: <code>(let () (set! (outlet (curlet)) (curlet)))</code>.
+</p>
+
+<p>If you want to hide an environment's fields from any part of s7 that does not
+know the field names in advance,
+</p>
+<pre class="indented">
+(openlet ; make it appear to be empty to the rest of s7
+ (inlet 'object->string (lambda args "#<let>")
+ 'map (lambda args ())
+ 'for-each (lambda args #<unspecified>)
+ 'let->list (lambda args ())
+ 'length (lambda args 0)
+ 'copy (lambda args (inlet))
+ 'open #t
+ 'coverlet (lambda (e) (set! (e 'open) #f) e)
+ 'openlet (lambda (e) (set! (e 'open) #t) e)
+ 'openlet? (lambda (e) (e 'open))
+ ;; your secret data here
+ ))
+</pre>
+<p>(There are still at least two ways to tell that something is fishy).
+</p>
+<!-- add a field and it disappears, or sublet and read back -->
+</div>
+</blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>In some Schemes, values behaves like CL's prog1:
-</p>
-<pre>
-(not s7)> (let ((x 1)) (cond ((values #f (set! x 2) #t) 3) (#t x)))
-2
-(not s7)> (if (values #f #t) 1 2)
-2
-</pre>
-<p>But in s7 we're trying to implement real multiple values (else why have them at all?).
-There are many ways we could interpret <code>(cond ((values ...))...)</code> and
-<code>(cond ((values...) => func))</code>, but surely
-equivalent uses of "cond" and "if" should give the same result.
-Currently in s7, where a test is in progress, only <code>(values #f)</code> is the same as #f.
+<div class="header" id="multiplevalues"><h4>multiple-values</h4></div>
+
+<p>
+In s7, multiple values are spliced directly into the caller's argument list.
</p>
-<pre>
-> (if (values #f #f) 1 2) ; (values #f #f) is not #f
-1
-> (cond ((values #f #f) 1) (#t 2))
-1
-;;; but if we interpreted this as splicing in the values, we get an inconsistency:
-> (cond (#f #f 1) (#t 2))
-2
+<pre class="indented">
+> (+ (values 1 2 3) 4)
+<em class="gray">10</em>
+> (string-ref ((lambda () (values "abcd" 2))))
+<em class="gray">#\c</em>
+> ((lambda (a b) (+ a b)) ((lambda () (values 1 2))))
+<em class="gray">3</em>
+> (+ (call/cc (lambda (ret) (ret 1 2 3))) 4) ; call/cc has an implicit "values"
+<em class="gray">10</em>
+> ((lambda* ((a 1) (b 2)) (list a b)) (values :a 3))
+<em class="gray">(3 2)</em>
-> (if (values #f) 1 2)
-2
-> (cond ((values #f) 1) (#t 2))
-2
+(define-macro (call-with-values producer consumer)
+ `(,consumer (,producer)))
-> (if (values) 1 2)
-1
-> (cond ((values) 1) (#t 2))
-1
-;;; this is consistent with (cond (1) (#t 2))
+(define-macro (multiple-value-bind vars expr . body)
+ `((lambda ,vars , at body) ,expr))
+
+(define (curry function . args)
+ (if (null? args)
+ function
+ (lambda more-args
+ (if (null? more-args)
+ (apply function args)
+ (function (apply values args) (apply values more-args))))))
</pre>
-<p>
-So "if" and "cond" agree, but it requires that in one case the "values"
-behavior is slightly weird. <code>(or (values #f #f))</code> is #f, but that isn't inconsistent because
+
+
+<blockquote>
+
+<div class="indented">
+
+<p>There aren't that many real uses for multiple-values in Scheme. Nearly all can be replaced by
+a normal list. There are a few cases where multiple-values are handy.
+First, you can use "values" to return any number of values, including 0,
+from map's function application:
+</p>
+
+<pre class="indented">
+> (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3))
+<em class="gray">(1 20 3 60)</em>
+> (map values (list 1 2 3) (list 4 5 6))
+<em class="gray">(1 4 2 5 3 6)</em>
+
+(define (remove-if func lst)
+ (map (lambda (x) (if (func x) (values) x)) lst))
+
+(define (pick-mappings func lst)
+ (map (lambda (x) (or (func x) (values))) lst))
+
+(define (shuffle . args)
+ (apply map values args))
+
+> (shuffle '(1 2 3) #(4 5 6) '(7 8 9))
+<em class="gray">(1 4 7 2 5 8 3 6 9)</em>
+
+(define (concatenate . args)
+ (apply append (map (lambda (arg) (map values arg)) args)))
+</pre>
+
+<p>
+Second, you can use multiple-values to turn off the short-circuit evaluation
+of 'or' and 'and'.
+</p>
+
+<pre class="indented">
+> (let ((x 1)) (and (<em class=red>values</em> #f (let () (set! x 3) #f))) x)
+<em class="gray">3</em>
+</pre>
+
+<p>But 'apply' has the same effect and is easier to read:
+</p>
+
+<pre class="indented">
+(define (and? . args) (apply and args))
+(define (every? f . seqs) (apply and (apply map f seqs)))
+</pre>
+
+<p>More often you want to keep the short-circuiting, but add some action as
+'and' or 'or' marches through its arguments:
+</p>
+
+<pre class="indented">
+(define-macro (every? function . args)
+ `(and ,@(map (lambda (arg) `(,function ,arg)) args)))
+
+(define (map-and proc lst)
+ (or (null? lst)
+ (and (proc (car lst))
+ (map-and proc (cdr lst)))))
+
+(define-macro (and-let* vars . body)
+ `(let () ;; bind vars, if any is #f stop, else evaluate body with those bindings
+ (and ,@(map (lambda (var) `(begin (apply define ',var) ,(car var))) vars)
+ (begin , at body))))
+</pre>
+
+<p>Third, a macro can return multiple values; these are evaluated and spliced,
+exactly like a normal macro,
+so you can use <code>(values '(define a 1) '(define b 2))</code> to
+splice multiple definitions at the macro invocation point.
+If an expansion returns (values), nothing is spliced in. This is
+mostly useful in <a href="#readercond">reader-cond</a>.
+</p>
+
+<pre class="indented">
+> (define-expansion (comment str) (values))
+<em class="gray">comment</em>
+> (+ 1 (comment "one") 2 (comment "two"))
+<em class="gray">3</em>
+</pre>
+
+<p>At the top-level (in the REPL), since there's nothing to splice into, you simply get your values back:
+</p>
+
+<pre class="indented">
+> (values 1 (list 1 2) (+ 3 4 5))
+<em class="gray">(values 1 (1 2) 12)</em>
+</pre>
+
+<p>But this printout is just trying to be informative. There is no multiple-values object
+in s7. You can't <code>(set! x (values 1 2))</code>, for example. The values function
+tells s7 that its arguments should be handled in a special way, and the multiple-value indication goes away
+as soon as the arguments are spliced into some caller's arguments.
+</p>
+
+<p>Internally, s7 uses <code>(apply values ...)</code> to implement unquote splicing (",@") in quasiquote.
+<!--
+Is <code>(apply apply func arglist)</code> the same as <code>(apply func (apply values arglist))</code>,
+or (leaving aside <code>'(()))</code>, <code>(func (apply values (apply values arglist)))</code>?
+-->
+</p>
+</div>
+
+
+<div class="indented">
+
+<p>Since set! does not evaluate its first argument, and
+there is no setter for "values", <code>(set! (values x) ...)</code> is not
+the same as <code>(set! x ...)</code>. <code>(string-set! (values string) ...)</code>
+works because string-set! does evaluate its first argument. <code>((values + 1 2) (values 3 4) 5)</code>
+is 15, as anyone would expect.
+</p>
+
+</div>
+
+<!--
+<details>
+<summary class="indented">more examples</summary>
+
+<pre>
+(define (flatten lst)
+ (define (flatten-1 lst)
+ (cond ((null? lst) (values))
+ ((not (pair? lst)) lst)
+ (#t (values (flatten-1 (car lst))
+ (flatten-1 (cdr lst))))))
+ (map values (list (flatten-1 lst))))
+</pre>
+
+<div class="indented">
+</details>
+-->
+
+
+<details>
+<summary class="indented">more on values</summary>
+<div class="indented">
+
+<p>In some Schemes, values behaves like CL's prog1:
+</p>
+
+<pre class="indented">
+(not s7)> (let ((x 1)) (cond ((values #f (set! x 2) #t) 3) (#t x)))
+<em class="gray">2</em>
+(not s7)> (if (values #f #t) 1 2)
+<em class="gray">2</em>
+</pre>
+
+<p>But in s7 we're trying to implement real multiple values (else why have them at all?).
+There are many ways we could interpret <code>(cond ((values ...))...)</code> and
+<code>(cond ((values...) => func))</code>, but surely
+equivalent uses of "cond" and "if" should give the same result.
+Currently in s7, where a test is in progress, only <code>(values #f)</code> is the same as #f.
+</p>
+
+<pre class="indented">
+> (if (values #f #f) 1 2) ; (values #f #f) is not #f
+<em class="gray">1</em>
+> (cond ((values #f #f) 1) (#t 2))
+<em class="gray">1</em>
+;;; but if we interpreted this as splicing in the values, we get an inconsistency:
+> (cond (#f #f 1) (#t 2))
+<em class="gray">2</em>
+> (if (values #f) 1 2)
+<em class="gray">2</em>
+> (cond ((values #f) 1) (#t 2))
+<em class="gray">2</em>
+> (if (values) 1 2)
+<em class="gray">1</em>
+> (cond ((values) 1) (#t 2))
+<em class="gray">1</em>
+;;; this is consistent with (cond (1) (#t 2))
+</pre>
+
+<p>
+So "if" and "cond" agree, but it requires that in one case the "values"
+behavior is slightly weird. <code>(or (values #f #f))</code> is #f, but that isn't inconsistent because
"or" is not testing anything.
We might choose to say that <code>(if (values #f #f)...)</code>
is an error, but that would be hasty —
our troubles have only begun. First, "cond" can omit the expressions that follow the test, unlike "if":
</p>
-<pre>
+<pre class="indented">
> (cond (3))
-3
+<em class="gray">3</em>
</pre>
<p>and even trickier, "cond" can pass the test value to a function:
</p>
-<pre>
+<pre class="indented">
> (cond (3 => +))
-3
+<em class="gray">3</em>
</pre>
<p>The various standards agree that in the "=>" case, the "fed to" function
receives one argument, so
</p>
-<pre>
+<pre class="indented">
(not s7)> (cond ((values 1 2) => +))
-1
+<em class="gray">1</em>
</pre>
<p>If we were following the "splice immediately" model, this would be <code>(cond (1 2 => +))</code>
@@ -2829,81 +3380,142 @@ looks like a wasted opportunity.
s7 handles it this way:
</p>
-<pre>
+<pre class="indented">
> (+ 1 (cond ((values 2 3))) 4) ; trailing values are not ignored
-10
+<em class="gray">10</em>
> (cond ((values 1 2 3) => +))
-6
+<em class="gray">6</em>
</pre>
<p>Of course, it is unproblematic that the expression can itself involve multiple values:
</p>
-<pre>
+<pre class="indented">
> (+ (cond (#t (values 1 2))))
-3
+<em class="gray">3</em>
</pre>
<p>Now, what have I missed?
</p>
+</div>
+</details>
+</blockquote>
+
+<!-- one place where multiple values might cause surprise:
+ :(define* (a1 (a2 (values 1 2))) a2)
+ :(a1)
+ (values 1 2)
+ :(define (a1 a2) a2)
+ :(a1 (values 1 2))
+ ;(values 1 2): too many arguments: (values 1 2)
+-->
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>Since set! does not evaluate its first argument, and
-there is no setter for "values", <code>(set! (values x) ...)</code> is not
-the same as <code>(set! x ...)</code>. <code>(string-set! (values string) ...)</code>
-works because string-set! does evaluate its first argument. <code>((values + 1 2) (values 3 4) 5)</code>
-is 15, as anyone would expect.
-</p>
-</blockquote>
-</small>
-</dd>
-<br><br>
+<div class="header" id="callwithexit1"><h4>call-with-exit, with-baffle and continuation?</h4></div>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="callwithexit1"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>call-with-exit and continuation?</h4></td></tr></table>
-</td></tr></table>
-</dt>
-<dd><p><b><a name="callwithexit">call-with-exit</a></b> is call/cc without the ability to jump back into the original context,
-similar to "return" in C. This takes the place of CL's catch/throw (s7 uses "catch" for error handling).
+<p><b><em class=def id="callwithexit">call-with-exit</em></b> is call/cc without the ability to jump back into the original context,
+similar to "return" in C. This
+is cleaner than call/cc, and much faster.
</p>
-<pre>
-(define (find-first-even-number arg)
+<pre class="indented">
+(define-macro (block . body)
+ ;; borrowed loosely from CL — predefine "return" as an escape
+ `(<em class=red>call-with-exit</em> (lambda (return) , at body)))
+
+(define-macro (while test . body) ; while loop with predefined break and continue
+ `(<em class=red>call-with-exit</em>
+ (lambda (break)
+ (letrec ((continue (lambda ()
+ (if (let () ,test)
+ (begin
+ (let () , at body)
+ (continue))
+ (break)))))
+ (continue)))))
+
+(define-macro (switch selector . clauses) ; C-style case (branches fall through unless break called)
+ `(<em class=red>call-with-exit</em>
+ (lambda (break)
+ (case ,selector
+ ,@(do ((clause clauses (cdr clause))
+ (new-clauses ()))
+ ((null? clause) (reverse new-clauses))
+ (set! new-clauses (cons `(,(caar clause)
+ ,@(cdar clause)
+ ,@(map (lambda (nc)
+ (apply values (cdr nc))) ; doubly spliced!
+ (if (pair? clause) (cdr clause) ())))
+ new-clauses)))))))
+
+(define (and-for-each func . args)
+ ;; apply func to the first member of each arg, stopping if it returns #f
(<em class=red>call-with-exit</em>
- (lambda (return)
- (for-each
- (lambda (a)
- (if (even? a)
- (return a)))
- arg))))
+ (lambda (quit)
+ (apply for-each (lambda arglist
+ (if (not (apply func arglist))
+ (quit #<unspecified>)))
+ args))))
-(find-first-even-number (list 1 3 9 13 8 2 4)) -> 8
+(define (find-if f . args) ; generic position-if is very similar
+ (<em class=red>call-with-exit</em>
+ (lambda (return)
+ (apply for-each (lambda main-args
+ (if (apply f main-args)
+ (apply return main-args)))
+ args))))
-(define-macro (block . body)
- `(<em class=red>call-with-exit</em>
- (lambda (return)
- , at body)))
+> (find-if even? #(1 3 5 2))
+<em class="gray">2</em>
+> (* (find-if > #(1 3 5 2) '(2 2 2 3)))
+<em class="gray">6</em>
+</pre>
+
+<p>
+The call-with-exit function's argument (the "continuation") is only valid
+within the call-with-exit function. In call/cc, you can save it, then call it later
+to jump back, but if you try that with call-with-exit (from outside the call-with-exit function's body), you'll get an error.
+This is similar to trying to read from a closed input port.
+</p>
+
+
+<p>The other side, so to speak, of call-with-exit, is <em class=def id="withbaffle">with-baffle</em>.
+Both limit the scope of a continuation.
+Sometimes we need a normal call/cc, but want to make sure it is active
+only within a given block of code.
+Normally, if a continuation gets away, there's no telling when it might wreak havoc on us.
+Scheme code with call/cc becomes unpredictable, undebuggable, and completely
+unmaintainable.
+with-baffle blocks all that — no continuation can jump into its body:
+</p>
-(block (display "hi") (return 32) (display "oops")) -> 32
+<pre class="indented">
+(let ((what's-for-breakfast ())
+ (bad-dog 'fido)) ; bad-dog wonders what's for breakfast?
+ (<em class=red>with-baffle</em> ; the syntax is (with-baffle . body)
+ (set! what's-for-breakfast
+ (call/cc
+ (lambda (biscuit?)
+ (set! bad-dog biscuit?) ; bad-dog smells a biscuit!
+ (biscuit? 'biscuit!)))))
+ (if (eq? what's-for-breakfast 'biscuit!)
+ (bad-dog 'biscuit!)) ; now, outside the baffled block, bad-dog wants that biscuit!
+ what's-for-breakfast) ; but s7 says "No!": baffled! ("continuation can't jump into with-baffle")
</pre>
-<p><b>continuation?</b> returns #t if its argument is a continuation,
+<br>
+<p><em class=def id="continuationp">continuation?</em> returns #t if its argument is a continuation,
as opposed to a normal procedure. I don't know why Scheme hasn't had this function from
the very beginning, but it's needed if you want to write a continuable error
handler. Here is a sketch of the situation:
</p>
-<pre>
+<pre class="indented">
(let ()
(catch #t
(lambda ()
@@ -2919,66 +3531,80 @@ handler. Here is a sketch of the situation:
((cadadr args) 2)))
(display "oops"))))
- -> continuing...2
+continuing...2
</pre>
<p>In a more general case, the error handler is separate from the
catch body, and needs a way to distinguish a real continuation
-from a simple procedure. Otherwise, it blithely announces that
-it is continuing from the point of the error, but then fails to do so.
+from a simple procedure.
</p>
-<small>
-<blockquote>
+<pre class="indented">
+(define (continuable-error . args)
+ (call/cc
+ (lambda (continue)
+ (apply error args))))
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+(define (continue-from-error)
+ (if (<em class=red>continuation?</em> ((owlet) 'continue)) ; might be #<undefined> or a function as in the while macro
+ (((owlet) 'continue))
+ 'bummer))
+</pre>
-<p>The call-with-exit function's argument (the "continuation") is only valid
-within the call-with-exit function. In call/cc, you can save it, then call it later
-to jump back, but if you try that with call-with-exit (from outside the call-with-exit function's body), you'll get an error.
-This is similar to trying to read from a closed input port.
-</p>
+<!--
+(define-macro (call-with-exit func)
+ (let ((tag (caadr func)))
+ `(catch ',tag
+ (lambda ()
+ (define-macro (,tag . body)
+ `(throw ',',tag , at body))
+ ,@(cddr func))
+ (lambda (type info)
+ (car info)))))
+-->
-</blockquote>
-</small>
-</dd>
-<br><br>
+<div class="header" id="format1"><h4>format, object->string</h4></div>
+
+<p>object->string returns the string representation of its argument. Its optional second argument
+can be #f (use display), #t (the default, use write), or :readable. In the latter case, object->string
+tries to produce a string that can be evaluated via eval-string to return an object equal to the
+original.
+</p>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="format1"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>format, object->string</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<pre class="indented">
+> (object->string "hiho")
+<em class="gray">"\"hiho\""</em>
+> (format #f "~S" "hiho")
+<em class="gray">"\"hiho\""</em>
+</pre>
-<dd><p>s7's built-in <a name="format">format</a> function is very close to that in srfi-48.
+<br>
+<p>s7's <em class=def id="format">format</em> function is very close to that in srfi-48.
</p>
-<pre>
-(format #f "~A ~D ~F" 'hi 123 3.14)
--> "hi 123 3.140000"
+<pre class="indented">
+> (format #f "~A ~D ~F" 'hi 123 3.14)
+<em class="gray">"hi 123 3.140000"</em>
</pre>
<p>The format directives (tilde chars) are:</p>
-<pre>
+<pre class="indented">
~% insert newline
~& insert newline if preceding char was not newline
~~ insert tilde
~\n (tilde followed by newline): trim white space
~{ begin iteration (take arguments from a list, string, vector, or any other applicable object)
~} end iteration
-~^ jump out of iteration
+~^ ~| jump out of iteration
~* ignore the current argument
+~C print character (numeric argument = how many times to print it)
+~P insert 's' if current argument is not 1 or 1.0 (use ~@P for "ies" or "y")
~A object->string as in display
~S object->string as in write
-~C print as character
-~P insert 's' if current argument is not 1 or 1.0 (use ~@P for "ies" or "y")
~B number->string in base 2
~O number->string in base 8
~D number->string in base 10
@@ -2987,110 +3613,110 @@ This is similar to trying to read from a closed input port.
~F float to string, (format #f "~F" 100.1) -> "100.100000", (%f in C)
~G float to string, (format #f "~G" 100.1) -> "100.1", (%g in C)
~T insert spaces (padding)
+~N get numeric argument from argument list (similar to V in CL)
+~W object->string with :readable (write readably; s7 is the intended reader)
</pre>
-<p>The last eight take the usual numeric arguments to specify field width and precision.
+<p>The eight directives before ~W take the usual numeric arguments to specify field width and precision.
+These can also be ~N or ~n in which case the numeric argument is read from the list of arguments:
</p>
+<pre class="indented">
+(format #f "~ND" 20 1234) ; => (format "~20D" 1234)
+<em class="gray">" 1234"</em>
+</pre>
+
<p>
<code>(format #f ...)</code> simply returns the formatted string; <code>(format #t ...)</code>
-also sends it to *stdout*. To send the string to *stderr* instead, <code>(format *stderr* ...)</code>.
+also sends the string to the current-output-port. <code>(format () ...)</code> sends the output to
+the current-output-port without returning the string (this mimics the other IO routines
+such as display and newline). Other built-in port choices are *stdout* and *stderr*.
</p>
-<small>
-<blockquote>
+<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>Floats can occur in any base, so:
</p>
-<pre>
+<pre class="indented">
> #xf.c
-15.75
+<em class="gray">15.75</em>
</pre>
<p>This also affects format. In most Schemes, <code>(format #f "~X" 1.25)</code> is
an error. In CL, it is equivalent to using ~A which is perverse. But
</p>
-<pre>
+<pre class="indented">
> (number->string 1.25 16)
-"1.4"
+<em class="gray">"1.4"</em>
</pre>
<p>and there's no obvious way to get the same effect from format unless we accept
floats in the "~X" case. So in s7,
</p>
-<pre>
+<pre class="indented">
> (format #f "~X" 21)
-"15"
-
+<em class="gray">"15"</em>
> (format #f "~X" 1.25)
-"1.4"
-
+<em class="gray">"1.4"</em>
> (format #f "~X" 1.25+i)
-"1.4+1.0i"
-
+<em class="gray">"1.4+1.0i"</em>
> (format #f "~X" 21/4)
-"15/4"
+<em class="gray">"15/4"</em>
</pre>
<p>That is, the output choice matches the argument. A case that came up in the Guile mailing lists is:
<code>(format #f "~F" 1/3)</code>. s7 currently returns "1/3", but Clisp returns "0.33333334".
</p>
-
+<br>
<p>The curly bracket directive applies to anything you can map over, not just lists:
</p>
-<pre>
+<pre class="indented">
> (format #f "~{~C~^ ~}" "hiho")
-"h i h o"
+<em class="gray">"h i h o"</em>
+> (format #f "~{~{~C~^ ~}~^...~}" (list "hiho" "test"))
+<em class="gray">"h i h o...t e s t"</em>
+> (with-input-from-string (format #f "(~{~C~^ ~})" (format #f "~B" 1367)) read) ; integer->list
+<em class="gray">(1 0 1 0 1 0 1 0 1 1 1)</em>
</pre>
+<br>
-
-</blockquote>
-</small>
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>object->string returns the string representation of its argument:
+<p>Since any sequence can be passed to ~{~}, we need a way to truncate output and represent
+the rest of the sequence with "...", but ~^ only stops at the end of the sequence. ~|
+is like ~^ but it also stops after it handles (*s7* 'print-length) elements and prints
+"...". So, <code>(format #f "~{~A~| ~}" #(0 1 2 3 4))</code> returns "0 1 2 ..."
+if (*s7* 'print-length) is 3.
</p>
-<pre>
-> (object->string "hiho")
-"\"hiho\""
-
-> (format #f "~S" "hiho")
-"\"hiho\""
-</pre>
+</div>
+</blockquote>
-<small>
<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<p>I added object->string to s7 before deciding to include format. format excites a
vague disquiet — why do we need this ancient unlispy thing?
We can almost replace it with:
</p>
-<pre>
+<pre class="indented">
(define (objects->string . objects)
(apply string-append (map (lambda (obj) (object->string obj #f)) objects)))
</pre>
<p>But how to handle lists (~{...~} in format), or columnized output (~T)?
I wonder whether formatted string output still matters outside a REPL. Even in that context,
-a modern GUI will leave formatting decisions to a text or table widget.
+a modern GUI leaves formatting decisions to a text or table widget.
</p>
-<pre>
+<pre class="indented">
(define-macro (string->objects str . objs)
`(with-input-from-string ,str
(lambda ()
@@ -3137,362 +3763,238 @@ a modern GUI will leave formatting decisions to a text or table widget.
-->
+</div>
</blockquote>
-</small>
-</dd>
-<br><br>
+<div class="header" id="hooks"><h4>hooks</h4></div>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="errors"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>error handling</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<pre class="indented">
+(<em class=def id="makehook">make-hook</em> . fields) ; make a new hook
+(<em class=def id="hookfunctions">hook-functions</em> hook) ; the hook's list of 'body' functions
+</pre>
-<dd><p>s7's error handling mimics that of Guile. An error is signalled
-via the error function, and can be trapped and dealt with via <a name="catch">catch</a>.
+<p>A hook is a function created by make-hook, and called (normally from C) when something interesting happens.
+In GUI toolkits hooks are called callback-lists, in CL conditions,
+in other contexts watchpoints or signals. s7 itself has several
+hooks: <a href="#errorhook">*error-hook*</a>,
+<a href="#unboundvariablehook">*unbound-variable-hook*</a>, *missing-close-paren-hook*,
+and <a href="#loadhook">*load-hook*</a>.
+make-hook is:
</p>
-<pre>
-(<em class=red>catch</em> 'wrong-number-of-args
- (lambda () ; code protected by the catch
- (abs 1 2))
- (lambda args ; the error handler
- (apply format (append (list #t) (cadr args)))))
-
--> "abs: too many arguments: (1 2)"
-
-(<em class=red>catch</em> 'division-by-zero
- (lambda () (/ 1.0 0.0))
- (lambda args (string->number "inf.0")))
-
--> inf.0
+<pre class="indented">
+(define (make-hook . args)
+ (let ((body ()))
+ (apply lambda* args
+ '(let ((result #<unspecified>))
+ (let ((e (curlet)))
+ (for-each (lambda (f) (f e)) body)
+ result))
+ ())))
</pre>
-<p>
-catch has 3 arguments: a tag indicating what error to catch (#t = anything),
-the code, a thunk, that the catch is protecting, and the function to call
-if a matching error occurs during the evaluation of the thunk. The error handler
-takes a rest argument which will hold whatever the error function chooses to pass it.
-The error function itself takes at least 2 arguments, the error type, a symbol,
-and the error message. There may also be other arguments describing the error.
-The default action, in the absence of any catch, is to treat the message as
-a format control string, apply format to it and the other arguments, and
-send that info to the current-error-port.
-</p>
-
-<p>When an error is encountered, the variable <a name="errorinfo">*error-info*</a>, a vector, contains
-additional info about that error:
+<p>So the result of calling make-hook is a function (the lambda* that is applied to args above) that
+contains a list of functions, 'body.
+Each function in that list takes one argument, the hook.
+Each time the hook itself is called, each of the body functions is called, and the value of 'result is returned.
+That variable, and each of the hook's arguments are accessible to the hook's internal
+functions by going through the environment passed to the internal functions. This is a bit circuitous;
+here's a sketch:
</p>
-<ul>
-<li>0: the error type or tag, e.g. 'division-by-zero
-<li>1: the message or information passed by the error function
-<li>2: if not #f, the code that s7 thinks triggered the error
-<li>3: if not #f, the line number of that code
-<li>4: if not #f, the file name of that code
-<li>5: the environment at the point of the error
-<li>6...: stack environment pointers, ending in #f
-</ul>
-
-
-<small>
-<blockquote>
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<pre class="indented">
+> (define h (make-hook '(a 32) 'b)) ; h is a function: (lambda* ((a 32) b) ...)
+<em class="gray">h</em>
+> (set! (hook-functions h) ; this sets ((funclet h) 'body)
+ (list (lambda (hook) ; each hook internal function takes one argument, the environment
+ (set! (hook 'result) ; this is the "result" variable above
+ (format #f "a: ~S, b: ~S" (hook 'a) (hook 'b))))))
+<em class="gray">(#<lambda (hook)>)</em>
+> (h 1 2) ; this calls the hook's internal functions (just one in this case)
+<em class="gray">"a: 1, b: 2" ; we set "result" to this string, so it is returned as the hook application result</em>
+> (h)
+<em class="gray">"a: 32, b: #f"</em>
+</pre>
-<p>To find a variable's value at the point of the error:
+<p>In C, to make a hook:
</p>
-<pre>
-(symbol->value var (vector-ref *error-info* 5))
+<pre class="indented">
+hook = s7_eval_c_string("(make-hook '(a 32) 'b)");
+s7_gc_protect(s7, hook);
</pre>
-<p>To print the stack at the point of the error:
+<p>And call it:
</p>
-<pre>
-(stacktrace *error-info*)
+<pre class="indented">
+result = s7_call(s7, hook, s7_list(s7, 2, s7_make_integer(s7, 1), s7_make_integer(s7, 2)));
</pre>
-<p>To evaluate the error handler in the environment of the error:
-</p>
-
+<div class="indented">
<pre>
-(let ((x 1))
- (catch #t
- (lambda ()
- (let ((y 2))
- (error 'oops)))
- (lambda args
- (with-environment
- (augment-environment
- (*error-info* 5) ; the error env
- (cons 'args args)) ; add the error handler args
- (list args x y))))) ; we have access to 'y'
+(define-macro (hook . body) ; return a new hook with "body" as its body, setting "result"
+ `(let ((h (make-hook)))
+ (set! (hook-functions h) (list (lambda (h) (set! (h 'result) (begin , at body)))))
+ h))
</pre>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-</blockquote>
-</small>
-<p>The hook <a name="errorhook">*error-hook*</a> provides a way to specialize error reporting.
-Its functions take two arguments, the values passed by the error function:
-the error type and whatever other info accompanies it.
-</p>
-<pre>
-(set! (hook-functions *error-hook*) (list (lambda (tag args) (apply format #t args))))
-</pre>
+<div class="header" id="procedureinfo"><h4>procedure info</h4></div>
-<p><a name="stacktrace">stacktrace</a> can be called anytime to see the chain of function calls. Its optional argument
-can be *error-info* to show the stack at the point of the last error,
-a thread object to show that thread's stack, or a continuation to
-show the continuation stack.
-</p>
-<pre>
- (let ()
- (define (a1 a) (+ a #\c))
- (define (a2 b) (+ b (a1 b)))
- (define (a3 c) (+ c (a2 c)))
- (catch #t
- (lambda () (a3 1))
- (lambda args (<em class=red>stacktrace</em> *error-info*))))
+<pre class="indented">
+(<em class=def id="proceduresource">procedure-source</em> proc)
+(<em class=def id="proceduredocumentation">procedure-documentation</em> proc)
+(<em class=def id="proceduresignature">procedure-signature</em> proc)
+(<em class=def id="proceduresetter">procedure-setter</em> proc)
+(funclet proc)
--> (a1 (a . 1))
- (a2 (b . 1))
- (a3 (c . 1))
+(<em class=def id="arity">arity</em> obj)
+(<em class=def id="aritablep">aritable?</em> obj num-args)
</pre>
<p>
-See also trace below. There is a break macro defined in Snd (snd-xen.c)
-which allows you to stop at some point, then evaluate arbitrary expressions in that context.
-<!-- INDEX autoload:autoload -->
-<A NAME="autoload"></A>
-There's yet another hook, <a name="unboundvariablehook">*unbound-variable-hook*</a>, which is called
-before the error is signalled
-when an unbound variable
-is encountered.
-Its functions take one argument,
-the unbound symbol. In Snd, this is used to implement autoloading:
+procedure-setter returns or sets the set function associated with a procedure (set-car! with car, for example).
+funclet returns
+a procedure's environment.
+procedure-source returns the procedure source (a list).
</p>
-<pre>
-(set! (hook-functions <em class=red>*unbound-variable-hook*</em>)
- (list (lambda (sym)
- ;; add your own symbol checks here
- (let ((file (autoload-file (symbol->string sym))))
- ;; autoload-file is a Snd function that knows where a lot of Snd's Scheme functions are
- (if file (load file))
- (symbol->value sym))))) ; this will return #<undefined> if we didn't find its source file
+<pre class="indented">
+(define (procedure-arglist f) (cadr (procedure-source f)))
</pre>
-<!--
-<small>
-<blockquote>
-<p>Sly evil-doers can subvert this hook to provide something similar to Common Lisp's symbol-macros:
+<p>
+procedure-documentation returns the documentation string associated with a procedure. This used to be
+the initial string in the function's body (as in CL), but now it is the value of the 'documentation variable, if any,
+in the procedure's local environment. That is, <code>(define (f a) "doc string" a)</code> is now
+<code>(define f (let ((documentation "doc string")) (lambda (a) a)))</code>. This change gets the
+string out of the body (where it can slow down evaluation of the function to no purpose), and
+makes it possible to extend the function information arbitrarily.
</p>
-<pre>
-> (set! (hook-functions *unbound-variable-hook*)
- (list (lambda (sym)
- (if (eq? sym 'hiho)
- (sin (random 1.0))
- (symbol->value sym)))))
-<closure>
-> hiho
-0.46727567824396
+<p>
+arity takes any object and returns either #f if it is not applicable,
+or a cons containing the minimum and maximum number of arguments acceptable. If the maximum reported
+is a really big number, that means any number of arguments is ok.
+aritable? takes two arguments, an object and an integer, and returns #t if the object can be
+applied to that many arguments.
+</p>
-> hiho
-0.64985453979392
+<pre class="indented">
+> (define add-2 (let ((documentation "add-2 adds its 2 args")) (lambda* (a (b 32)) (+ a b))))
+<em class="gray">add-2</em>
+> (procedure-documentation add-2)
+<em class="gray">"add-2 adds its 2 args"</em>
+> (procedure-source add-2)
+<em class="gray">(lambda* (a (b 32)) (+ a b))</em>
+> (arity add-2)
+<em class="gray">(0 . 2)</em>
</pre>
-</blockquote>
-</small>
--->
+<p>
+procedure-signature is a list describing the argument types and returned value type
+of the function. The first entry in the list is the return type, and the rest are
+argument types. #t means any type is possible, and 'values means the function returns multiple values.
+</p>
-<p>The s7-built-in catch tags are 'wrong-type-arg, 'syntax-error, 'read-error, 'thread-error,
-'out-of-memory, 'wrong-number-of-args, 'format-error, 'out-of-range, 'division-by-zero, 'io-error, and 'bignum-error.
+<pre class="indented">
+> (procedure-signature round)
+<em class="gray">(integer? real?)</em> ; round takes a real argument, returns an integer
+> (procedure-signature vector-ref)
+<em class="gray">(#t vector? . #1=(integer? . #1#))</em> ; trailing args are all integers (indices)
+</pre>
+
+<p>If an entry is a list, any of the listed types can occur:
</p>
-<p><a name="trace">trace</a> and untrace provide tracing:
+<pre class="indented">
+> (procedure-signature char-position)
+<em class="gray">((boolean? integer?) (char? string?) string? integer?)</em>
+</pre>
+
+<p>which says that the first argument to char-position can be a string or a character,
+and the return type can be either boolean or an integer.
+If the function is defined in scheme, its signature is the value of the 'signature variable
+in its closure:
</p>
-<pre>
- (define (hiho arg)
- (if (> arg 0)
- (+ 1 (hiho (- arg 1)))
- 0))
- (<em class=red>trace</em> hiho)
+<pre class="indented">
+> (define f1 (let ((documentation "helpful info")
+ (signature '(boolean? real?)))
+ (lambda (x)
+ (positive? x))))
+<em class="gray">f1</em>
+> (procedure-documentation f1)
+<em class="gray">"helpful info"</em>
+> (procedure-signature f1)
+<em class="gray">(boolean? real?)</em>
+</pre>
- (hiho 3)
+<p>We could do the same thing using methods:
+</p>
- [hiho 3]
- [hiho 2]
- [hiho 1]
- [hiho 0]
- 0
- 1
- 2
- 3
+<pre class="indented">
+> (define f1 (let ((procedure-documentation (lambda (f) "helpful info"))
+ (procedure-signature (lambda (f) '(boolean? real?))))
+ (<em class=red>openlet</em>
+ (lambda (x)
+ (positive? x)))))
+> (procedure-documentation f1)
+<em class="gray">"helpful info"</em>
+> (procedure-signature f1)
+<em class="gray">(boolean? real?)</em>
</pre>
-<p>trace adds a function to the list of functions being traced, and untrace removes it.
-trace with no arguments causes everything to be traced, and untrace with no arguments
-turns this off.
+<p>openlet alerts s7 that f1 has methods.
</p>
+<blockquote>
+<br>
-<p>There is also a hook, <a name="tracehook">*trace-hook*</a>. It takes functions
-of 2 arguments, the currently traced
-function and the list of current arguments. The hook's functions are evaluated in the environment of the
-traced function call (that is, global to the function, not the function's local environment).
+<details>
+<summary class="indented">examples</summary>
+<div class="indented">
+
+<p>procedure-source returns the actual function source. If you
+call the function, the optimizer changes the source to suit itself,
+so if you want to walk over the function body or change it in some way,
+make a clean copy of
+the procedure-source first (using, for example, copy-tree in stuff.scm).
</p>
<pre>
- (define (hiho a b c) (* a b c))
- (set! (hook-functions *trace-hook*) (list (lambda (f args) (format #t "sum of args: ~A~%" (apply + args)))))
- (trace hiho)
- (hiho 2 3 4)
-
- [hiho 2 3 4]
- sum of args: 9
- 24
-</pre>
-
-</dd>
-<br><br>
-
-
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="procedureinfo"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>procedure info</h4></td></tr></table>
-</td></tr></table>
-</dt>
-
-<dd><p><a name="proceduresource">procedure-source</a>, procedure-arity, procedure-documentation, and help provide a look into a
-Scheme function.
-procedure-documentation returns the documentation string associated with a procedure: the initial string in the
-function's body. procedure-arity returns a list describing the argument list of a function: <code>'(required-args optional-args rest-arg?)</code>.
-procedure-source returns the source, as a list, of a procedure. procedure-environment returns
-a procedure's environment.
-</p>
-
-<pre>
-> (define* (add-2 a (b 32)) "add-2 adds its 2 args" (+ a b))
-add-2
-
-> (procedure-documentation add-2)
-"add-2 adds its 2 args"
-
-> (procedure-arity add-2)
-(0 2 #f)
-
-> (procedure-source add-2)
-(lambda* (a (b 32)) "add-2 adds its 2 args" (+ a b))
-</pre>
-
-<p>We can use procedure-environment and <a href="#__func__">__func__</a> to
-write a function that tells us where the source is for a function:
-</p>
-
-<pre>
-(define (where-is func)
- (let ((addr (cdr (assoc <em class=red>'__func__</em> (car (<em class=red>procedure-environment</em> func))))))
- (if (not (pair? addr))
- "not found"
- (format #f "~A is at line ~D of ~A" (car addr) (caddr addr) (cadr addr)))))
-
-> (where-is profile)
-"profile is at line 1048 of extensions.scm"
-</pre>
-
-
-<small>
-<blockquote>
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>procedure-source returns the actual function source —
-more fun than a barrel of monkeys. Here is a self-modifying factorial function:
-</p>
-
-<pre>
-(define fact ; Reini Urban, http://autocad.xarch.at/lisp/self-mod.lsp.txt
- (let ((old '())
- (result '()))
-
- (define (last lst)
- (list-tail lst (- (length lst) 1)))
-
- (define (butlast lis)
- (let ((len (length lis)))
- (if (<= len 1) '()
- (let ((result '()))
- (do ((i 0 (+ i 1))
- (lst lis (cdr lst)))
- ((= i (- len 1)) (reverse result))
- (set! result (cons (car lst) result)))))))
-
- (lambda (n)
- (cond ((zero? n) 1)
- (#t
- (set! old (<em class=red>procedure-source</em> fact))
- (set! fact (apply lambda '(n)
- `((cond
- ,@(butlast (cdr (car (cdr (cdr old)))))
- ((= n ,n) ,(let ()
- (set! result (* n (fact (- n 1))))
- result))
- ,@(last (cdr (car (cdr (cdr old)))))))))
- result)))))
-</pre>
-
-<p>If you modify the procedure source directly, it is safest to redefine the procedure (as above)
-so that everything in s7 knows about the change.
-<a href="#augmentenv">augment-environment</a> serves a similar purpose when editing environments.
-Here's a more useful example; it adds trace and local variable info for debugging:
-</p>
-
-<pre>
-(define-macro (procedure-annotate proc)
- (let ((orig (<em class=red>procedure-source</em> proc)))
+(define-bacro (procedure-annotate proc) ; use "bacro" so we can annotate local functions
+ (let ((orig (<em class=red>procedure-source</em> proc))) ; this assumes we haven't called "proc" yet
(define (proc-walk source)
(if (pair? source)
- (if (or (eq? (car source) 'let) ; if let or let*, show local variables
- (eq? (car source) 'let*))
- (if (symbol? (cadr source))
+ (if (memq (car source) '(let let*)) ; if let or let*, show local variables
+ (if (symbol? (cadr source)) ; named let?
;; (let name vars . body) -> (let name vars print-vars . body)
(append
(list (car source)
(cadr source)
(caddr source)
- `(format #t " (let ~A (~{~A~^ ~}) ...)~%" ,(cadr source) (car (current-environment))))
+ `(format #t " (let ~A (~{~A~^ ~}) ...)~%" ,(cadr source) (curlet)))
(cdddr source))
;; (let(*) vars . body) -> (let vars print-vars . body)
(append
(list (car source)
(cadr source)
- `(format #t " (~A (~{~A~^ ~}) ...)~%" ,(car source) (car (current-environment))))
+ `(format #t " (~A (~{~A~^ ~}) ...)~%" ,(car source) (curlet)))
(cddr source)))
(cons (proc-walk (car source))
(proc-walk (cdr source))))
source))
-
+
(let* ((new-body (proc-walk orig))
(result (gensym))
(new-source
@@ -3500,462 +4002,897 @@ Here's a more useful example; it adds trace and local variable info for debuggin
(let ((,result #<undefined>))
(dynamic-wind
(lambda () ; upon entry, show procedure name and args
- (format #t "(~A~{ ~A~})~%" ',proc (caddr (current-environment))))
+ (format #t "(~A~{ ~A~})~%"
+ ',proc
+ (outlet (outlet (curlet)))))
(lambda ()
- (set! ,result (,new-body ,@(cadr orig)))
- ,result)
+ (set! ,result (,new-body ,@(cadr orig))))
(lambda () ; at exit, show result
(if (eq? ,result #<undefined>)
- (format #t " ~A returns early~%")
+ (format #t " ~A returns early~%" ',proc)
(format #t " ~A returns ~A~%" ',proc ,result))))))))
- `(set! ,proc (eval ,new-source)))))
+ `(define ,proc ,new-source))))
+
> (define (hi a) (let ((b 12)) (+ b a)))
-hi
+<em class="gray">hi</em>
> (procedure-annotate hi)
-#<closure>
+<em class="gray">#<lambda (a)></em>
> (let ((x 32)) (+ 1 (hi x)))
-45
+<em class="gray">45</em>
;; printing:
(hi (a . 32))
(let ((b . 12)) ...)
hi returns 44
</pre>
+<p>But maybe something less invasive is better. Here's a version of let that prints
+its bindings (this is borrowed from "nuntius" at reddit lisp):
+</p>
+
+<pre>
+(define-macro (print-let bindings . body)
+ (let ((temp-symbol (gensym)))
+ `(let ,(map (lambda (var/val)
+ `(,(car var/val)
+ (let ((,temp-symbol ,(cadr var/val)))
+ (format #t ";~S: ~S -> ~S~%"
+ ',(car var/val)
+ ',(cadr var/val)
+ ,temp-symbol)
+ ,temp-symbol)))
+ bindings)
+ , at body)))
+
+;; or simpler:
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+(define-macro (print-let bindings . body)
+ `(let ,bindings
+ (format #t "~{;~A~%~}" (curlet))
+ , at body))
+</pre>
-<p>If procedure-arity is passed
-a procedure-with-setter, it returns 6 values, rather than 3. The first 3 describe the "getter"
-and the following 3 describe the "setter".
-</p>
+</div>
-<p>Since define* accepts multiple rest arguments, perhaps procedure-arity should return that number,
-rather than a boolean. I haven't run into a case where it matters. Another odd case:
-<code>(procedure-arity (lambda* (:allow-other-keys) #f))</code>. How should we indicate
-this in procedure-arity?
+
+<div class="indented">
+
+<p>A minor footnote: there are cases in s7 where aritable? can't tell whether
+a given number of arguments can be applied to an object. For example,
+<code>((list 1 (list 2 3)) 0 1)</code> is an error, but
+<code>((list 1 (list 2 3)) 1 1)</code> is 3. So
+<code>(aritable? (list 1 (list 2 3)) 2)</code> depdends on
+what actual arguments you pass. In these cases, aritable? returns <code>#f</code>.
</p>
+</div>
+</details>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
<pre>
(define (for-each-subset func args)
;; form each subset of args, apply func to the subsets that fit its arity
- (let* ((arity (<em class=red>procedure-arity</em> func))
- (min-args (car arity)) ; required args
- (max-args (if (caddr arity) ; rest arg?
- (length args)
- (+ min-args (cadr arity))))) ; required+optional
- (define (subset source dest len)
- (if (null? source)
- (if (<= min-args len max-args) ; does this subset fit?
- (apply func dest))
+ (define (subset source dest len)
+ (if (null? source)
+ (if (<em class=red>aritable?</em> func len) ; does this subset fit?
+ (apply func dest))
(begin
(subset (cdr source) (cons (car source) dest) (+ len 1))
(subset (cdr source) dest len))))
- (subset args '() 0)))
+ (subset args () 0))
</pre>
-
+</div>
</blockquote>
-</small>
-
-</dd>
-<br><br>
+<div class="header" id="evalstring"><h4>eval</h4></div>
+<p>
+<b>eval</b> evaluates its argument, a list representing a piece of code. It takes an optional
+second argument, the environment in which the evaluation should take place. <b>eval-string</b>
+is similar, but its argument is a string.
+</p>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="environments"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>environment info</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<pre class="indented">
+> (eval '(+ 1 2))
+<em class="gray">3</em>
+> (eval-string "(+ 1 2)")
+<em class="gray">3</em>
+</pre>
-<dd><p>An environment holds symbols and their values. The global environment, for example,
-holds all the variables that are defined at the top level.
-Environments are first class objects in s7.
+<p>Leaving aside a few special cases, eval-string could be defined:
</p>
+<pre class="indented">
+(define-macro* (eval-string x e)
+ `(eval (with-input-from-string ,x read) (or ,e (curlet))))
+</pre>
+
+<blockquote>
+
+
+<div class="indented">
+
+<p>eval's environment argument is handy when implementing break and trace:
+</p>
<pre>
- (environment? obj) #t if obj is an environment
- (<a name="globalenvironment">global-environment</a>) the top-level environment
- (<a name="currentenvironment">current-environment</a>) the currently visible variables and their values
- (procedure-environment proc) the environment at the time when proc was defined
- (initial-environment) the current environment, but all built-in functions have their original values
+(define *breaklet* #f)
+(define *step-hook* (make-hook 'code 'e))
+
+(define-macro* (trace/break code . break-points)
+ (define (caller tree)
+ (if (pair? tree)
+ (cons
+ (if (pair? (car tree))
+ (if (and (symbol? (caar tree))
+ (procedure? (symbol->value (caar tree))))
+ (if (member (car tree) break-points)
+ `(__break__ ,(caller (car tree)))
+ `(__call__ ,(caller (car tree))))
+ (caller (car tree)))
+ (car tree))
+ (caller (cdr tree)))
+ tree))
+ `(call-with-exit (lambda (__top__) ,(caller code))))
+
+(define (go . args)
+ (and (let? *breaklet*)
+ (apply (*breaklet* 'go) args)))
+
+(define (clear-break)
+ (set! *breaklet* #f))
+
+(define-macro (__call__ code)
+ `(*step-hook* ',code (curlet)))
+
+(define-macro (__break__ code)
+ `(begin
+ (call/cc
+ (lambda (go)
+ (set! *breaklet* (curlet))
+ (__top__ (format #f "break at: ~A~%" ',code))))
+ ,code))
+
+(set! (hook-functions *step-hook*)
+ (list (lambda (hook)
+ (set! (hook 'result) (<em class=red>eval (hook 'code) (hook 'e)</em>)))))
+
+(set! ((funclet *step-hook*) 'end)
+ (list (lambda (hook)
+ (define (uncaller tree)
+ (if (pair? tree)
+ (cons
+ (if (and (pair? (car tree))
+ (memq (caar tree) '(__call__ __break__)))
+ (uncaller (cadar tree))
+ (uncaller (car tree)))
+ (uncaller (cdr tree)))
+ tree))
+ (format (current-output-port) ": ~A -> ~A~40T~A~%"
+ (uncaller (hook 'code))
+ (hook 'result)
+ (if (and (not (eq? (hook 'e) (rootlet)))
+ (not (defined? '__top__ (hook 'e))))
+ (map values (hook 'e))
+ "")))))
+
+;;; (trace/break (let ((a (+ 3 1)) (b 2)) (if (> (* 2 a) b) 2 3)))
+;;; (trace/break (let ((a (+ 3 1)) (b 2)) (if (> (* 2 a) b) 2 3)) (* 2 a))
+</pre>
+</div>
+
+</blockquote>
+
+
+
+
+
+<div class="header" id="IO"><h4>IO and other OS functions</h4></div>
- (<a name="withenvironment">with-environment</a> env . body) evaluate body in the environment env
- (<a name="augmentenvironment">augment-environment</a> env . bindings) add bindings to env
- (augment-environment! env . bindings)
- (symbol->value sym (env (current-environment)))
- (defined? sym (env (current-environment)))
- (symbol-table)
-</pre>
-<A NAME="augmentenv"></A>
-<p><code>(with-environment env . body)</code> evaluates its body in the environment env.
-There are several examples of its use in the <a href="#macros">macro</a> section.
-defined? returns #t if the symbol is defined in the environment, and
-symbol->value returns the value associated with it.
-To add or change a symbol's value, use augment-environment:
+<p>Besides files, ports can also represent strings and functions. The string port functions
+are:
</p>
-<pre>
-(let ((a 1))
- (eval '(+ a b)
- (<em class=red>augment-environment</em>
- (current-environment)
- (cons 'b 32)))) ; add 'b with the value 32 to this environment
+<pre class="indented">
+(with-output-to-string thunk) ; open a string port as current-output-port, call thunk, return string
+(with-input-from-string string thunk) ; open string as current-input-port, call thunk
+(call-with-output-string proc) ; open a string port, apply proc to it, return string
+(call-with-input-string string proc) ; open string as current-input-port, apply proc to it
+(open-output-string) ; open a string output port
+(get-output-string port clear) ; return output accumulated in the string output port
+(open-input-string string) ; open a string input port reading string
+</pre>
--> 33
+<pre class="indented">
+> (let ((result #f)
+ (p (<em class=red>open-output-string</em>)))
+ (format p "this ~A ~C test ~D" "is" #\a 3)
+ (set! result (<em class=red>get-output-string</em> p))
+ (close-output-port p)
+ result)
+<em class="gray">"this is a test 3"</em>
</pre>
-<p>augment-environment does not change the environment passed to it. It
-just prepends the new bindings, shadowing any old ones,
-as if you had called "let". To add the bindings directly to the environment,
-use augment-environment!. Both of these functions accept nil as the
-'env' argument. In this case, they return an environment containing
-only the bindings you pass in.
+<p>In get-output-string, if the optional 'clear' argument is #t, the port is cleared (the default in r7rs I think).
+Other functions:
</p>
-<p>It is possible in Scheme to redefine built-in functions such as car.
-To ensure that some code sees the original built-in function definitions,
-wrap it in <code>(with-environment (initial-environment) ...)</code>:
+<ul>
+<li>read-byte and write-byte: binary IO.
+<li>read-line: line-at-a-time reads, optional third argument #t to include the newline.
+<li>current-error-port, set-current-error-port
+</ul>
+
+<p>The variable (*s7* 'print-length) sets
+the upper limit on how many elements of a sequence are printed by object->string and format.
+The end-of-file object is #<eof>.
+When running s7 behind a GUI, you often want input to come from and output to go to
+arbitrary widgets. The function ports provide a way to redirect IO in C. See <a href="#functionportexample">below</a>
+for an example.
</p>
-<pre>
-> (let ((caar 123))
- (+ caar (with-environment (initial-environment)
- (caar '((2) 3)))))
-125
-</pre>
+
+
+<blockquote>
+
+<div class="indented">
<p>
-with-environment and initial-environment are constants, so you can
-use them in any context without worrying about whether they've been redefined.
-I think these functions can implement the notions of libraries,
-separate namespaces, or modules.
-Here's one way: first the library writer just writes his library.
-The normal user simply loads it. The abnormal user worries about everything,
-so first he loads the library in a local let to make sure no bindings escape
-to pollute his code, and then he
-uses initial-environment to
-make sure that none of his bindings pollute the library code:
+The default IO ports are *stdin*, *stdout*, and *stderr*.
+*stderr* is useful if you want to make sure output is flushed out immediately.
+The default output port is *stdout* which buffers output until a newline is seen.
+In most REPLs, the input port is set up by the REPL, so you need to use
+*stdin* if you want to read from the terminal instead:
</p>
-<pre>
-(let ()
- (with-environment (initial-environment)
- (load "any-library.scm" (current-environment)) ; by default load puts stuff in the global environment
- ...))
+<pre class="indented">
+> (read-char)
+<em class="gray">#<eof></em>
+> (read-char *stdin*)
+a ; here s7 waited for me to type "a" in the terminal
+<em class="gray">#\a</em> ; this is the REPL reporting what read-char returned
</pre>
-<p>Now Abnormal User can do what he wants with the library entities.
-Say he wants to use "lognor" under the name "bitwise-not-or", and
-all the other functions are of no interest:
+</div>
+
+
+<div class="indented">
+<p>An environment can be treated as an IO port, providing what Guile calls a "soft port":
</p>
-<pre>
-(begin
- (define bitwise-not-or #f)
- (let ()
- (with-environment (initial-environment)
- (load "any-library.scm" (current-environment))
- (set! bitwise-not-or (symbol->value 'lognor)))))
+<pre class="indented">
+(define (call-with-input-vector v proc)
+ (let ((i -1))
+ (proc (openlet (inlet 'read (lambda (p) (v (set! i (+ i 1)))))))))
</pre>
-<p>Or equivalently:
+<p>Here the IO port is an open environment that redefines the "read" function so that it
+returns the next element of a vector. See stuff.scm for call-with-output-vector.
+The "proc" argument above can also be a macro, giving you a kludgey way to get around
+the dumb "lambda". Here are more useful examples:
</p>
+<pre class="indented">
+(openlet ; a soft port for format that sends its output to *stderr* and returns the string
+ (inlet 'format (lambda (port str . args)
+ (let ((result (apply format #f str args)))
+ (display result *stderr*)
+ result))))
-<pre>
-(augment-environment! (current-environment)
- (cons 'bitwise-not-or
- (symbol->value 'lognor
- (with-environment (initial-environment)
- (load "any-library.scm" (current-environment))
- (current-environment)))))
+(define (open-output-log name)
+ ;; return a soft output port that does not hold its output file open
+ (define (logit name str)
+ (let ((p (open-output-file name "a")))
+ (display str p)
+ (close-output-port p)))
+ (openlet
+ (inlet :name name
+ :format (lambda (p str . args) (logit (p 'name) (apply format #f str args)))
+ :write (lambda (obj p) (logit (p 'name) (object->string obj #t)))
+ :display (lambda (obj p) (logit (p 'name) (object->string obj #f)))
+ :write-string (lambda (str p) (logit (p 'name) str))
+ :write-char (lambda (ch p) (logit (p 'name) (string ch)))
+ :newline (lambda (p) (logit (p 'name) (string #\newline)))
+ :close-output-port (lambda (p) #f)
+ :flush-output-port (lambda (p) #f))))
</pre>
+</div>
-<p>Say he wants to make sure the library is cleanly loaded, but all
-its bindings are exported into the current environment:
+
+<div class="indented">
+
+<p>binary-io.scm in the Snd package has functions that read and write integers and floats in
+both endian choices in a variety of sizes.
</p>
-<pre>
-(apply augment-environment! (current-environment)
- (with-environment (initial-environment)
- (load "any-library.scm" (current-environment))
- (car (current-environment)))) ; these are the bindings introduced by loading the library
-</pre>
+</div>
+</blockquote>
-<p>To do the same thing, but prepend "library:" to each name:
+<p>If the compile time switch WITH_SYSTEM_EXTRAS is 1, several additional OS-related and
+file-related functions are built-in. This is work in progress; currently this switch
+adds:
</p>
-<pre>
-(apply augment-environment! (current-environment)
- (with-environment (initial-environment)
- (load "any-library.scm" (current-environment))
- (map (lambda (binding)
- (cons (string->symbol
- (string-append "library:" (symbol->string (car binding))))
- (cdr binding)))
- (car (current-environment)))))
+<pre class="indented">
+(directory? str) ; return #t if str is the name of a directory
+(file-exists? str) ; return #t if str names an existing file
+(delete-file str) ; try to delete the file, return 0 is successful, else -1
+(getenv var) ; return the value of an environment variable: (getenv "HOME")
+(directory->list dir) ; return contents of directory as a list of strings (if HAVE_DIRENT_H)
+(system command) ; execute command
</pre>
-<p>That's all there is to it!
+<p>But maybe this is not needed; see <a href="#cload">cload.scm</a> below for
+a more direct approach.
</p>
-<p>
-<code>(symbol-table)</code> returns the symbol table, a vector of lists of symbols.
-Here we scan the symbol table looking for any function that doesn't have documentation:
+
+
+
+
+<div class="header" id="errors"><h4>error handling</h4></div>
+
+<pre class="indented">
+(error tag . info) ; signal an error of type tag with addition information
+(catch tag body err) ; if error of type tag signalled in body (a thunk), call err with tag and info
+(throw tag . info) ; jump to corresponding catch
+</pre>
+
+<p>s7's error handling mimics that of Guile. An error is signalled
+via the error function, and can be trapped and dealt with via <em class=def id="catch">catch</em>.
</p>
-<pre>
- (let ((st (<em class=red>symbol-table</em>)))
- (do ((i 0 (+ i 1)))
- ((= i (vector-length st)))
- (let ((lst (vector-ref st i)))
- (for-each
- (lambda (sym)
- (if (<em class=red>defined?</em> sym)
- (let ((val (<em class=red>symbol->value</em> sym)))
- (if (and (procedure? val)
- (string=? "" (procedure-documentation val)))
- (format #t "~A " sym)))))
- lst))))
+<pre class="indented">
+> (<em class=red>catch</em> 'wrong-number-of-args
+ (lambda () ; code protected by the catch
+ (abs 1 2))
+ (lambda args ; the error handler
+ (apply format #t (cadr args))))
+<em class="gray">"abs: too many arguments: (1 2)"</em>
+> (<em class=red>catch</em> 'division-by-zero
+ (lambda () (/ 1.0 0.0))
+ (lambda args (string->number "inf.0")))
+<em class="gray">inf.0</em>
+
+(define-macro (catch-all . body)
+ `(<em class=red>catch</em> #t (lambda () , at body) (lambda args args)))
</pre>
<p>
-To use namespaces from C, see the FFI <a href="#namespace">example</a>
-below.
+catch has 3 arguments: a tag indicating what error to catch (#t = anything),
+the code, a thunk, that the catch is protecting, and the function to call
+if a matching error occurs during the evaluation of the thunk. The error handler
+takes a rest argument which will hold whatever the error function chooses to pass it.
+The error function itself takes at least 2 arguments, the error type, a symbol,
+and the error message. There may also be other arguments describing the error.
+The default action, in the absence of any catch, is to treat the message as
+a format control string, apply format to it and the other arguments, and
+send that info to the current-error-port.
</p>
-<small>
<blockquote>
+<div class="indented">
+<p>Normally when reading a file, we have to check for #<eof>, but we can let s7
+do that:
+</p>
+
+<pre>
+(define (copy-file infile outfile)
+ (call-with-input-file infile
+ (lambda (in)
+ (call-with-output-file outfile
+ (lambda (out)
+ (<em class=red>catch</em> 'wrong-type-arg ; s7 raises this error if write-char gets #<eof>
+ (lambda ()
+ (do () () ; read/write until #<eof>
+ (write-char (read-char in) out)))
+ (lambda err
+ outfile)))))))
+</pre>
+
+<p>catch is not limited to error handling:
+</p>
+
+<pre class="indented">
+(define (map-with-exit func . args)
+ ;; map, but if early exit taken, return the accumulated partial result
+ ;; func takes escape thunk, then args
+ (let* ((result ())
+ (escape-tag (gensym))
+ (escape (lambda () (throw escape-tag))))
+ (<em class=red>catch</em> escape-tag
+ (lambda ()
+ (let ((len (apply max (map length args))))
+ (do ((ctr 0 (+ ctr 1)))
+ ((= ctr len) (reverse result)) ; return the full result if no throw
+ (let ((val (apply func escape (map (lambda (x) (x ctr)) args))))
+ (set! result (cons val result))))))
+ (lambda args
+ (reverse result))))) ; if we catch escape-tag, return the partial result
+
+(define (truncate-if func lst)
+ (map-with-exit (lambda (escape x) (if (func x) (escape) x)) lst))
+
+> (truncate-if even? #(1 3 5 -1 4 6 7 8))
+<em class="gray">(1 3 5 -1)</em>
+</pre>
+
+<p>But this is less useful than map (it can't map over a hash-table for example),
+and is mostly reimplementing built-in code. Perhaps s7 should have an extension
+of map (and more usefully, for-each) that is patterned after dynamic-wind:
+<code>(dynamic-for-each init-func main-func end-func . args)</code> where init-func
+is called with one argument, the length of the shortest sequence argument (for-each
+and map know this in advance); main-func takes n arguments where n matches
+the number of sequences passed; and end-func is called even if a jump out of main-func
+occurs (like dynamic-wind in this regard). In the dynamic-map case, the end-func
+takes one argument, the current, possibly partial, result list. dynamic-for-each
+then could easily (but maybe not efficiently) implement generic functions such as ->list, ->vector, and
+->string (converting any sequence into a sequence of some other type).
+map-with-exit would be
+</p>
+<pre class="indented">
+(define (map-with-exit func . args)
+ (let ((result ()))
+ (call-with-exit
+ (lambda (quit)
+ (apply dynamic-map #f ; no init-func in this case
+ (lambda main-args
+ (apply func quit main-args))
+ (lambda (res)
+ (set! result res))
+ args)))
+ result))
+</pre>
+</div>
+
+<div class="indented">
+<p>With all the lambda boilerplate, nested catches are hard to read:
+</p>
+<pre class="indented">
+(catch #t
+ (lambda ()
+ (catch 'division-by-zero
+ (lambda ()
+ (catch 'wrong-type-arg
+ (lambda ()
+ (abs -1))
+ (lambda args (format #t "got a bad arg~%") -1)))
+ (lambda args 0)))
+ (lambda args 123))
+</pre>
+
+<p>Perhaps we need a macro:
+</p>
+
+<pre class="indented">
+(define-macro (catch-case clauses . body)
+ (let ((base `(lambda () , at body)))
+ (for-each (lambda (clause)
+ (let ((tag (car clause)))
+ (set! base `(lambda ()
+ (catch ',(or (eq? tag 'else) tag)
+ ,base
+ ,@(cdr clause))))))
+ clauses)
+ (caddr base)))
+
+;;; the code above becomes:
+(catch-case ((wrong-type-arg (lambda args (format #t "got a bad arg~%") -1))
+ (division-by-zero (lambda args 0))
+ (else (lambda args 123)))
+ (abs -1))
+</pre>
+
+<p>This is similar to r7rs scheme's "guard", but I don't want a pointless thunk for the body of the catch.
+Along the same lines:
+</p>
+<pre class="indented">
+(define (catch-if test func err)
+ (catch #t
+ func
+ (lambda args
+ (if (test (car args))
+ (apply err args)
+ (apply throw args))))) ; if not caught, re-raise the error
+
+(define (catch-member lst func err)
+ (catch-if (lambda (tag) (member tag lst)) func err))
+
+(define-macro (catch* clauses . error)
+ ;; try each clause until one evaluates without error, else error:
+ ;; (macroexpand (catch* ((+ 1 2) (- 3 4)) 'error))
+ ;; (catch #t (lambda () (+ 1 2)) (lambda args (catch #t (lambda () (- 3 4)) (lambda args 'error))))
+ (define (builder lst)
+ (if (null? lst)
+ (apply values error)
+ `(catch #t (lambda () ,(car lst)) (lambda args ,(builder (cdr lst))))))
+ (builder clauses))
+</pre>
+</div>
+<!--
+(define (or-catch . funks)
+ (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (f)
+ (catch #t
+ (lambda ()
+ (return (f)))
+ (lambda args
+ (case (car args)
+ ((wrong-type-arg) ...)
+ (...)
+ (else (apply throw args))))))
+ funks))))
+-->
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+</blockquote>
-<p>
-I think we could build an object system where each object is an environment (a list of alists),
-and each method looks for itself in that environment.
+<p>When an error is encountered, and when s7 is interrupted via <a href="#beginhook">begin_hook</a>,
+(<em class=def id="owlet">owlet</em>) returns an environment that contains
+additional info about that error:
</p>
-<pre>
-(define object (list (list (cons 'afield 1)
- (cons 'amethod (lambda args
- (+ 1 (apply + args)))))))
+<ul>
+<li>error-type: the error type or tag, e.g. 'division-by-zero
+<li>error-data: the message or information passed by the error function
+<li>error-code: the code that s7 thinks triggered the error
+<li>error-line: the line number of that code
+<li>error-file: the file name of that code
+</ul>
+
+<blockquote>
-(define (amethod obj . args)
- (apply (symbol->value 'amethod obj) args)) ; perhaps pass obj too
-> (amethod object 3 4)
-8
-</pre>
+<div class="indented">
-<p>A class would be an environment with the various fields and methods predefined.
+<p>To find a variable's value at the point of the error: <code>((owlet) var)</code>.
+To list all the local bindings from the error outward:
</p>
+<pre class="indented">
+(do ((e (outlet (owlet)) (outlet e)))
+ ((eq? e (rootlet)))
+ (format #t "~{~A ~}~%" e))
+</pre>
-<!--
-could we use expansions here? (so set! arg would be "evaluated" at read time etc)
--->
+<p>To see the current s7 stack, <code>(stacktrace)</code>. You'll probably
+want to use this in conjunction with *error-hook*.
+To evaluate the error handler in the environment of the error:
+</p>
-</blockquote>
-</small>
+<pre class="indented">
+(let ((x 1))
+ (catch #t
+ (lambda ()
+ (let ((y 2))
+ (error 'oops)))
+ (lambda args
+ (with-let (sublet (owlet) :args args) ; add the error handler args
+ (list args x y))))) ; we have access to 'y'
+</pre>
+<p>To limit the maximum size of the stack, set (*s7* 'max-stack-size).
+</p>
+</div>
-</dd>
-<br><br>
+</blockquote>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="evalstring"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>eval</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<p>The hook <em class=def id="errorhook">*error-hook*</em> provides a way to specialize error reporting.
+Its arguments are named 'type and 'data.
+</p>
-<dd>
+<pre class="indented">
+(set! (hook-functions *error-hook*)
+ (list (lambda (hook)
+ (apply format *stderr* (hook 'data))
+ (newline *stderr*))))
+</pre>
<p>
-<b>eval</b> evaluates its argument, a list representing a piece of code. It takes an optional
-second argument, the environment in which the evaluation should take place. <b>eval-string</b>
-is similar, but its argument is a string.
+There is a break macro defined in Snd (snd-xen.c)
+which allows you to stop at some point, then evaluate arbitrary expressions in that context.
</p>
-<pre>
-> (eval '(+ 1 2))
-3
-> (eval-string "(+ 1 2)")
-3
-</pre>
+<div class="indented">
+<p>The s7-built-in catch tags are 'wrong-type-arg, 'syntax-error, 'read-error,
+'out-of-memory, 'wrong-number-of-args, 'format-error, 'out-of-range, 'division-by-zero, 'io-error, and 'bignum-error.
+</p>
+</div>
-<small>
-<blockquote>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="header" id="autoload"><h4>autoload</h4></div>
-<p>The environment argument is mainly useful in debugging. A breakpoint can be set, for
-example, then any input is evaluated in the environment of the break. Say we have the
-following code in ex.scm:
+<!-- INDEX autoload:autoload -->
+<p>
+If s7 encounters an unbound variable, it first looks to see if it has any autoload information about it.
+This info can be declared via <em class=def>autoload</em>, a function of two arguments, the
+symbol that triggers the autoload, and either a filename or a function. If a filename, s7
+loads that file; if a function, it is called with one argument, the current (calling) environment.
</p>
-<pre>
-(define-macro (break)
- `(let ((break-env (<em class=red>current-environment</em>))
- (prompt (format #f "~%~A > " (if (defined? '__func__) __func__ "break"))))
- (call-with-exit
- (lambda (return)
- (do () () ; our debugger's own REPL
- (display prompt) ; show where we stopped
- (let ((str (read-line '()))) ; read a line of input, :go -> exit the debugger
- ;; the nil argument to read-line makes sure that we read C's stdin. In any normal
- ;; program, we'd get the string from a text widget.
- (if (> (length str) 0)
- (catch #t ; try to handle typing mistakes etc
- (lambda ()
- (let ((val (<em class=red>eval-string</em> str <em class=red>break-env</em>)))
- (if (eq? val :go)
- (return))
- (write val)))
- (lambda args
- (format #t "error: ~A" args))))))))))
-
-;; now some random code that has a breakpoint
-(define (a-function b)
- (let ((x 32))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (if (= i 3)
- (<em class=red>break</em>)))
- x))
+<pre class="indented">
+(autoload 'channel-distance "dsp.scm")
+;; now if we subsequently call channel-distance but forget to load "dsp.scm" first,
+;; s7 loads "dsp.scm" itself, and uses its definition of channel-distance.
+;; The C-side equivalent is s7_autoload.
-(a-function 123)
-(display "done!") (newline)
+;; here is the cload.scm case, loading j0 from the math library if it is called:
+(autoload 'j0
+ (lambda (e)
+ (unless (provided? 'cload.scm)
+ (load "cload.scm"))
+ (c-define '(double j0 (double)) "" "math.h")
+ (varlet e 'j0 j0)))
</pre>
-<p>
-Start up a REPL, and:
+<p>The entity (hash-table or environment probably) that holds the autoload info is named *autoload*.
+If after checking autoload, the symbol is still unbound, s7 calls
+<em class=def id="unboundvariablehook">*unbound-variable-hook*</em>.
+The offending symbol is named 'variable in the hook environment.
+If after running *unbound-variable-hook*, the symbol is still unbound,
+s7 calls the error handler.
</p>
-<pre>
-> (load "ex.scm")
-(a-function "ex.scm" 26) > x ; here we're in the debugger
-32
-(a-function "ex.scm" 26) > (+ b i)
-126
-(a-function "ex.scm" 26) > :go
-done!
-</pre>
-
-</blockquote>
-</small>
-</dd>
-<br><br>
+<p>The autoloader knows about s7 environments used as libraries, so, for example,
+you can <code>(autoload 'j0 "libm.scm")</code>, then use j0 in scheme code. The first
+time s7 encounters j0, j0 is undefined, so
+s7 loads libm.scm. That load returns the C math library as the environment *libm*.
+s7 then automatically looks for j0 in *libm*, and defines it for you.
+So the result is the same as if you had defined j0 yourself in C code.
+You can use the r7rs library mechanism here, or with-let, or
+whatever you want! (In Snd, libc, libm, libdl, and libgdbm are automatically
+tied into s7 via autoload, so if you call, for example, frexp, libm.scm
+is loaded, and frexp is exported from the *libm* environment, then the
+evaluator soldiers on, as if frexp had always been defined in s7).
+</p>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="IO"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>IO functions</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<div class="header" id="constants"><h4>define-constant, constant?, symbol-access</h4></div>
-<dd>
-<p>Besides files, ports can also represent strings and functions. The string port functions
-are:
+<p><em class=def id="defineconstant">define-constant</em> defines a constant and
+<em class=def id="constantp">constant?</em> returns #t if its argument
+is a constant. A constant in s7 is really constant: it can't be set or rebound.
</p>
-<pre>
- (with-output-to-string thunk) ; open a string port as current-output-port, call thunk, return string
- (with-input-from-string string thunk) ; open string as current-input-port, call thunk
- (call-with-output-string proc) ; open a string port, apply proc to it, return string
- (call-with-input-string string proc) ; open string as current-input-port, apply proc to it
- (open-output-string) ; open a string output port
- (get-output-string port) ; return output accumulated in the string output port
- (open-input-string string) ; open a string input port reading string
+<pre class="indented">
+> (define-constant var 32)
+<em class="gray">var</em>
+> (set! var 1)
+<em class="gray">;set!: can't alter immutable object: var</em>
+> (let ((var 1)) var)
+<em class="gray">;can't bind or set an immutable object: var, line 1</em>
</pre>
-<pre>
-(let ((result #f)
- (p (<em class=red>open-output-string</em>)))
- (format p "this ~A ~C test ~D" "is" #\a 3)
- (set! result (<em class=red>get-output-string</em> p))
- (close-output-port p)
- result)
--> "this is a test 3"
+<p>This has the possibly surprising side effect that previous uses of the constant name
+become constants:
+</p>
+
+<pre class="indented">
+(define (func a) (let ((cvar (+ a 1))) cvar))
+(define-constant cvar 23)
+(func 1)
+;can't bind or set an immutable object: cvar
</pre>
-<p>Other functions:
+<p>So, obviously, choose unique names for your constants, or don't use define-constant.
+A function can also be a constant. In some cases, the optimizer can take advantage
+of this information to speed up function calls.
</p>
-<ul>
-<li>read-byte and write-byte: binary IO, named "read-u8" and "write-u8" in r6rs, I think
-<li>read-line: line-at-a-time reads (for write-line, use format or for-each with write-char).
-</ul>
-
-<p>The variable <a name="vectorprintlength">*vector-print-length*</a> sets
-the upper limit on how many vector elements are printed by object->string and format.
+<p>Constants are very similar to things such as keywords (no set, always return itself as its value),
+variable trace (informative function upon set or keeping a history of past values), typed variables (restricting a
+variable's values or doing automatic conversions upon set), and notification upon set (either in Scheme
+or in C; I wanted this many years ago in Snd). The notification function is especially useful if
+you have a Scheme variable and want to reflect any change in its value immediately in C (see <a href="#notify">below</a>).
+In s7, <em class=def id="symbolaccess">symbol-access</em> sets this function.
</p>
-<p>When running s7 behind a GUI, you often want input to come from and output to go to
-arbitrary widgets. The function ports provide a way to redirect IO. See <a href="#functionportexample">below</a>
-for an example.
+<p>Each environment is a set of symbols and their associated values. symbol-access places a function (or macro) between a symbol
+and its value in a given environment. The accessor function takes two arguments, the symbol and the new value, and
+returns the value that is actually set. For example, the function can ensure that a variable is always an integer:
</p>
-<p>s7 also includes current-error-port and set-current-error-port.
+<pre class="indented">
+(define e ; save environment for use below
+ (let ((x 3) ; will always be an integer
+ (y 3) ; will always keep its initial value
+ (z 3)) ; will report set!
+
+ (set! (symbol-access 'x) (lambda (s v) (if (integer? v) v x)))
+ (set! (symbol-access 'y) (lambda (s v) y))
+ (set! (symbol-access 'z) (lambda (s v) (format *stderr* "z ~A -> ~A~%" z v) v))
+
+ (set! x 3.3) ; x does not change because 3.3 is not an integer
+ (set! y 3.3) ; y does not change
+ (set! z 3.3) ; prints "z 3 -> 3.3"
+ (curlet)))
+
+> e
+<em class="gray">(inlet 'x 3 'y 3 'z 3.3)</em>
+>(begin (set! (e 'x) 123) (set! (e 'y) #()) (set! (e 'z) #f))
+;; prints "z 3.3 -> #f"
+> e
+<em class="gray">(inlet 'x 123 'y 3 'z #f)</em>
+> (define-macro (reflective-let vars . body)
+ `(let ,vars
+ ,@(map (lambda (vr)
+ `(set! (symbol-access ',(car vr))
+ (lambda (s v)
+ (format *stderr* "~S -> ~S~%" s v)
+ v)))
+ vars)
+ , at body))
+<em class="gray">reflective-let</em>
+> (reflective-let ((a 1)) (set! a 2))
+<em class="gray">2</em> ; prints "a -> 2"
+>(let ((a 0))
+ (set! (symbol-access 'a)
+ (let ((history (make-vector 3 0))
+ (position 0))
+ (lambda (s v)
+ (set! (history position) v)
+ (set! position (+ position 1))
+ (if (= position 3) (set! position 0))
+ v)))
+ (set! a 1)
+ (set! a 2)
+ ((funclet (symbol-access 'a)) 'history))
+<em class="gray">#(1 2 0)</em>
+</pre>
+
+<p>Or implement reactive programming:
+</p>
+<pre class="indented">
+(let ((a 1)
+ (b 2)
+ (c 3))
+ (set! (symbol-access 'b) (lambda (s v) (set! a (+ v c)) v))
+ (set! (symbol-access 'c) (lambda (s v) (set! a (+ b v)) v))
+ (set! a (+ b c)) ; a will be updated if b or c is set
+ (set! b 4)
+ (set! c 5)
+ a) ; a is 9 = (+ 4 5)
+</pre>
+
+
+<details>
+<summary class="indented">reactive-let</summary>
+<div class="indented">
+
+<p>stuff.scm has reactive-set!, reactive-vector, reactive-let, reactive-let*, and reactive-lambda*:
+</p>
+<pre class="indented">
+> (let ((-a- 1)
+ (b 2))
+ (<em class=red>reactive-set!</em> -a- (* b 2))
+ (set! b 3)
+ -a-)
+<em class="gray">6</em>
+> (let ((a 1))
+ (let ((v (<em class=red>reactive-vector</em> a (+ a 1) 2)))
+ (set! a 4)
+ v))
+<em class="gray">#(4 5 2)</em>
+> (let ((a 1))
+ (<em class=red>reactive-let</em> ((-b- (+ a 1))) ; if 'a changes, '-b- does too
+ (set! a 3) ; so '-b- is now 4
+ -b-))
+<em class="gray">4</em>
+> (let ((a 1))
+ (<em class=red>reactive-lambda*</em> (s v)
+ (format *stderr* "~S -> ~S~%" s v))
+ (set! a 3))
+<em class="gray">"a -> 3"</em>
+</pre>
+
+<p>In the reactive-let example, the macro notices that '-b- depends on 'a, so it sets up a symbol-access on 'a
+so that <code>(set! a 3)</code> triggers <code>(set! -b- (+ a 1))</code>. I'm using -name- to distinguish
+the variables that can change value at any time; in the Lisp community, +name+ is often used to mark a constant,
+so this seems like a natural convention.
+</p>
+
+<p>Here's the standard example of following the mouse (assuming you're using Snd and glistener):
+</p>
+<pre class="indented">
+(let ((*mouse-x* 0) (*mouse-y* 0)
+ (x 0) (y 0))
+
+ (reactive-set! x (let ((val (round *mouse-x*)))
+ (format *stderr* "mouse: ~A ~A~%" x y)
+ val))
+ (reactive-set! y (round *mouse-y*))
+
+ (g_signal_connect (G_OBJECT (listener-text-widget *listener*)) "motion_notify_event"
+ (lambda (w e d)
+ (let ((mxy (gdk_event_get_coords (GDK_EVENT e))))
+ (set! *mouse-x* (cadr mxy))
+ (set! *mouse-y* (caddr mxy))))))
+</pre>
+
+<!--
+(let ((*mouse-x* 0) (*mouse-y* 0))
+
+ (g_signal_connect (G_OBJECT (listener-text-widget *listener*)) "motion_notify_event"
+ (lambda (w e d)
+ (let ((mxy (gdk_event_get_coords (GDK_EVENT e))))
+ (set! *mouse-x* (cadr mxy))
+ (set! *mouse-y* (caddr mxy)))))
+
+ (with-accessors (*mouse-x* *mouse-y*)
+ (let ((x 0) (y 0))
+ (reactive-set! x (let ((val (round *mouse-x*)))
+ (format *stderr* "mouse: ~A ~A~%" x y)
+ val))
+ (reactive-set! y (round *mouse-y*))
+ (gtk_main))))
+-->
+
+<p>reactive-lambda* is aimed at library consistency. Say we have the following library
+that wants A to always be half B:
</p>
+<pre class="indented">
+(define (make-library)
+ (let ((A 1.0)
+ (B 2.0))
+ (reactive-lambda* (s v)
+ (case s
+ ((A) (set! B (* 2 v)))
+ ((B) (set! A (/ v 2)))))
+ (define (f1 x)
+ (+ A (* B x)))
+ (curlet)))
-<small>
-<blockquote>
+(with-let (make-library)
+ (format *stderr* "(f1 3): ~A~%" (f1 3))
+ (set! A 3.0)
+ (format *stderr* "A: ~A, B: ~A, (f1 3): ~A~%" A B (f1 3))
+ (set! B 4.0)
+ (format *stderr* "A: ~A, B: ~A, (f1 3): ~A~%" A B (f1 3)))
+</pre>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<p>reactive-lambda* sets up accessors on the library's top-level variables
+that call the lambda body if one of the variables is set.
+</p>
-<p>binary-io.scm in the Snd package has functions that read and write integers and floats in
-both endian choices in a variety of sizes. Besides read-byte and write-byte, it uses
-integer-decode-float, and the various bitwise operators.
+<p>None of these macros does the right thing yet; I'm sort of following my nose.
</p>
-</blockquote>
-</small>
+</div>
+</details>
-</dd>
-<br><br>
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="miscellanea"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>miscellanea</h4></td></tr></table>
-</td></tr></table>
-</dt>
+<div class="header" id="miscellanea"><h4>marvels and curiousities</h4></div>
-<dd><p><b><a name="loadpath">*load-path*</a></b> is a list of directories to search when loading a file.
-<b><a name="loadhook">*load-hook*</a></b> is a hook whose functions are called just before a file is loaded.
-The hook function argument is the filename.
+<p>
+<b><em class=def id="loadpath">*load-path*</em></b> is a list of directories to search when loading a file.
+<b><em class=def id="loadhook">*load-hook*</em></b> is a hook whose functions are called just before a file is loaded.
+The hook function argument, named 'name, is the filename.
While loading, the port-filename and port-line-number of the current-input-port can tell you
where you are in the file.
</p>
-<pre>
-(set! (hook-functions *load-hook*) (list (lambda (name) (format #t "loading ~S...~%" name))))
+<pre class="indented">
+(set! (hook-functions *load-hook*)
+ (list (lambda (hook)
+ (format #t "loading ~S...~%" (hook 'name)))))
+
+(set! (hook-functions *load-hook*)
+ (cons (lambda (hook)
+ (format *stderr* "~A~%"
+ (system (string-append "./snd lint.scm -e '(begin (lint \"" (hook 'name) "\") (exit))'") #t)))
+ (hook-functions *load-hook*)))
</pre>
<p>Here's a *load-hook* function that adds the loaded file's directory
@@ -3963,11 +4900,12 @@ to the *load-path* variable so that subsequent loads don't need to specify
the directory:
</p>
-<pre>
+<pre class="indented">
(set! (hook-functions <em class=red>*load-hook*</em>)
- (list (lambda (filename)
- (let ((pos -1)
- (len (length filename)))
+ (list (lambda (hook)
+ (let* ((pos -1)
+ (filename (hook 'name))
+ (len (length filename)))
(do ((i 0 (+ i 1)))
((= i len))
(if (char=? (filename i) #\/)
@@ -3978,35 +4916,90 @@ the directory:
(set! <em class=red>*load-path*</em> (cons directory-name *load-path*)))))))))
</pre>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="separator"></div>
-<p>As in Common Lisp, <b><a name="featureslist">*features*</a></b> is a list describing what is currently loaded into s7. You can
+<p>As in Common Lisp, <b><em class=def id="featureslist">*features*</em></b> is a list describing what is currently loaded into s7. You can
check it with the <b>provided?</b> function, or add something to it with <b>provide</b>. In my version of Snd,
at startup *features* is:
</p>
-<pre>
+<pre class="indented">
> *features*
-(snd11 snd snd-s7 snd-motif gsl alsa xm clm4 clm sndlib gmp s7)
+<em class="gray">(snd-16.7 snd15 snd audio snd-s7 snd-gtk gsl alsa gtk2 xg clm6 clm sndlib linux
+ dlopen complex-numbers system-extras ratio s7-3.26 s7) </em>
+> (provided? 'gsl)
+<em class="gray">#t</em>
+</pre>
+
+<p>The other side of <code>provide</code> is <em class=def id="requires7">require</em>.
+<code>(require . things)</code> finds each thing
+(via <a href="#autoload">autoload</a>), and if that thing has not already been loaded,
+loads the associated file. <code>(require integrate-envelope)</code>
+loads "env.scm", for example; in this case it is equivalent to
+simply using integrate-envelope, but if placed at the start of
+a file, it documents that you're using that function.
+In the more normal use, <code>(require snd-ws.scm)</code>
+looks for the file that has <code>(provide 'snd-ws.scm)</code>
+and if it hasn't already been loaded, loads it ("ws.scm" in this case).
+The "thing" passed to <code>require</code> is not quoted.
+To add your own files to this mechanism, add the provided symbol via <a href="#autoload">autoload</a>.
+Since load can take an environment argument, *features* and its friends follow block structure.
+So, for example, (let () (require stuff.scm) ...) loads "stuff.scm" into the local environment,
+not globally.
+</p>
+
+<div class="indented">
+<p>*features* is an odd variable: it is spread out across the chain of environments, and
+can hold features in an intermediate environment that aren't in subsequent (nested) values.
+One simple way this can happen is to load a file in a let, but cause the load to happen
+at the top level. The provided entities get added to the top-level *features* value,
+not the current let's value, but they are actually accessible locally. So *features*
+is a merge of all its currently accessible values, vaguely like call-next-method in
+CLOS. We can mimic this behavior:
+</p>
+<pre class="indented">
+(let ((x '(a)))
+ (let ((x '(b)))
+ (define (transparent-memq sym var e)
+ (let ((val (symbol->value var e)))
+ (or (and (pair? val)
+ (memq sym val))
+ (and (not (eq? e (rootlet)))
+ (transparent-memq sym var (outlet e))))))
+ (let ((ce (curlet)))
+ (list (transparent-memq 'a 'x ce)
+ (transparent-memq 'b 'x ce)
+ (transparent-memq 'c 'x ce)))))
+
+'((a) (b) #f)
+</pre>
+</div>
-> (provided? 'gmp)
-#t
-</pre>
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<!--
+(let ((spread-function (lambda (x e) (+ x 1))))
+ (let ((spread-function (lambda (x e) (+ x 2))))
+ (let ((x 3))
+ (define (spread-function x e)
+ (let ((val x))
+ (do ((e1 e (outlet e1)))
+ ((eq? e1 (rootlet)) val)
+ (let ((f (symbol->value 'spread-function e1)))
+ (if (procedure? f)
+ (set! val (f val (rootlet))))))))
+ (spread-function x (curlet)))))
+ 6
+-->
+<div class="separator"></div>
-<p>Multi-line comments can be enclosed in either #| and |#, or #! and !# (the latter
-is for compatibility with Guile). These are also useful for in-line comments:
+<p>Multi-line and in-line comments can be enclosed in #| and |#.
<code>(+ #| add |# 1 2)</code>.
</p>
-<p>Leaving aside these two cases, and the booleans, #f and #t, you can specify your own handlers for
-tokens that start with "#". <b><a name="sharpreaders">*#readers*</a></b> is a list of pairs: <code>(char . func)</code>.
+<p>Leaving aside this case and the booleans, #f and #t, you can specify your own handlers for
+tokens that start with "#". <b><em class=def id="sharpreaders">*#readers*</em></b> is a list of pairs: <code>(char . func)</code>.
"char" refers to the first character after the sharp sign (#). "func" is a function of
one argument, the string that follows the #-sign up to the next delimiter. "func" is called
when #<char> is encountered. If it returns something other than #f, the #-expression
@@ -4016,94 +5009,137 @@ passed in is not the complete #-expression, the function can use read-char or re
rest. Say we'd like #t<number> to interpret the number in base 12:
</p>
-<pre>
-(set! *#readers*
- (cons (cons #\t (lambda (str)
- (string->number (substring str 1) 12)))
- *#readers*))
+<pre class="indented">
+(set! *#readers* (cons (cons #\t (lambda (str) (string->number (substring str 1) 12))) *#readers*))
> #tb
-11
+<em class="gray">11</em>
> #t11.3
-13.25
+<em class="gray">13.25</em>
+</pre>
+
+<p>Or have #c(real imag) be read as a complex number:
+</p>
+
+<pre class="indented">
+(set! *#readers* (cons (cons #\c (lambda (str) (apply complex (read)))) *#readers*))
+
+> #c(1 2)
+<em class="gray">1+2i</em>
</pre>
+<div class="indented">
<p>I use *#readers* primarily to implement a way to get the current line number and file name, along
the lines of C's __LINE__ and __FILE__. port-line-number works if we're reading a file (during load
-for example), and *error-info* has the same information if an error happens. But during Snd's auto-test
+for example), and (owlet) has the same information if an error happens. But during Snd's auto-test
sequence, there are many cases that aren't errors, and the file is no longer being loaded, but
I need to know where something unexpected happened. So:
</p>
-<pre>
+<pre class="indented">
(set! *#readers*
(cons (cons #\_ (lambda (str)
(if (string=? str "__line__")
(port-line-number)
- (if (string=? str "__file__")
- (port-filename)
- #f))))
+ (and (string=? str "__file__")
+ (port-filename)))))
*#readers*))
</pre>
<p>Here's a reader macro for read-time evaluation:
</p>
-<pre>
+<pre class="indented">
(set! *#readers*
(cons (cons #\. (lambda (str)
- (if (string=? str ".") (eval (read)) #f)))
+ (and (string=? str ".") (eval (read)))))
*#readers*))
> '(1 2 #.(* 3 4) 5)
-(1 2 12 5)
+<em class="gray">(1 2 12 5)</em>
</pre>
+<p>To return no value from a reader, use <code>(values)</code>.
+</p>
+<pre class="indented">
+> (set! *#readers* (cons (cons #\; (lambda (str) (if (string=? str ";") (read)) (values))) *#readers*))
+<em class="gray">((#\; . #<lambda (str)>))</em>
+> (+ 1 #;(* 2 3) 4)
+<em class="gray">5</em>
+</pre>
+<p>Here is CL's #+ reader:
+</p>
+<pre class="indented">
+(define (sharp-plus str)
+ ;; str here is "+", we assume either a symbol or an expression involving symbols follows
+ (let ((e (if (string=? str "+")
+ (read) ; must be #+(...)
+ (string->symbol (substring str 1)))) ; #+feature
+ (expr (read))) ; this is the expression following #+
+ (if (symbol? e)
+ (if (provided? e)
+ expr
+ (values))
+ (if (pair? e)
+ (begin ; evaluate the #+(...) expression as in cond-expand
+ (define (traverse tree)
+ (if (pair? tree)
+ (cons (traverse (car tree))
+ (if (null? (cdr tree)) () (traverse (cdr tree))))
+ (if (memq tree '(and or not)) tree
+ (and (symbol? tree) (provided? tree)))))
+ (if (eval (traverse e))
+ expr
+ (values)))
+ (error "strange #+ chooser: ~S~%" e)))))
+</pre>
+<p>See also the <a href="#circularlistreader">#n=</a> reader below.</p>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
+<div class="separator"></div>
-<p>(<b>make-list</b> length (initial-element #f)) returns a list of 'length' elements defaulting to 'initial-element'.
+<p id="makelist">(<b>make-list</b> length (initial-element #f)) returns a list of 'length' elements defaulting to 'initial-element'.
</p>
-<p><b>reverse!</b> is an in-place version of the built-in function reverse. That is,
-it modifies the list passed to it in the process of reversing its contents.
-<b>list-set!</b> sets a member of a list. <b>sort!</b> sorts a list or a vector using the
-function passed as its second argument to choose the new ordering.
-</p>
+<div class="separator"></div>
-<pre>
-> (sort! (list 3 4 8 2 0 1 5 9 7 6) <)
-(0 1 2 3 4 5 6 7 8 9)
+<pre class="indented">
+(<em class=def id="charposition">char-position</em> char-or-string searched-string (start 0))
+(<em class=def id="stringposition">string-position</em> substring searched-string (start 0))
+</pre>
-(define (mix-notelists . notelists)
- ;; assume the 2nd parameter is the begin time in seconds (the 1st is the instrument name)
- (<em class=red>sort!</em>
- (apply append notelists)
- (lambda (note1 note2)
- (< (cadr note1) (cadr note2)))))
+<p>
+<b>char-position</b> and <b>string-position</b> search a string for the occurrence of a character,
+any of a set of characters, or a string. They return either #f if none is found, or the position
+within the searched string of the first occurrence. The optional third argument sets where the
+search starts in the second argument.
+</p>
-(mix-notelists '((fm-violin 0 1 440 .1)
- (fm-violin 1 1 550 .1))
- '((bird 0 .1 )
- (bird .2 .1)
- (bird 1.2 .3)
- (bird .5 .5)))
+<p>If char-position's first argument is a string, it is treated as a set of characters, and
+char-position looks for the first occurrence of any member of that set.
+Currently, the strings involved are assumed to be C strings (don't expect embedded nulls
+to work right in this context).
+</p>
- -> ((bird 0 0.1) (fm-violin 0 1 440 0.1) (bird 0.2 0.1) (bird 0.5 0.5) (fm-violin 1 1 550 0.1) (bird 1.2 0.3))
+<pre class="indented">
+(call-with-input-file "s7.c" ; report any lines with "static " but no following open paren
+ (lambda (file)
+ (let loop ((line (read-line file #t)))
+ (or (eof-object? line)
+ (let ((pos (<em class=red>string-position</em> "static " line)))
+ (if (and pos
+ (not (<em class=red>char-position</em> #\( (substring line pos))))
+ (if (> (length line) 80)
+ (begin (display (substring line 0 80)) (newline))
+ (display line))))
+ (loop (read-line file #t)))))))
</pre>
-<p>Despite the "!" in its name, sort! actually copies any list argument passed to it,
-but vectors are sorted in place.
-</p>
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="separator"></div>
-<p>
+<p id="keywords">
Keywords exist mainly for define*'s benefit. The keyword functions are:
<b>keyword?</b>, <b>make-keyword</b>, <b>symbol->keyword</b>, and <b>keyword->symbol</b>.
A keyword is a symbol that starts or ends with a colon. The colon
@@ -4112,84 +5148,678 @@ is considered to be a part of the symbol name. A keyword is a constant that eva
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="separator"></div>
+<pre class="indented">
+(<em class=def id="symboltable">symbol-table</em>)
+(<em class=def id="symboltovalue">symbol->value</em> sym (env (curlet)))
+(<em class=def id="symboltodynamicvalue">symbol->dynamic-value</em> sym)
+(<em class=def id="definedp">defined?</em> sym (env (curlet)) ignore-global-env)
+</pre>
-<p><b>help</b> tries to find information about its argument.
+<p>
+<code>defined?</code> returns #t if the symbol is defined in the environment:
</p>
-<pre>
+<pre class="indented">
+(define-macro (defvar name value)
+ `(unless (defined? ',name)
+ (define ,name ,value)))
+</pre>
+
+<p>If ignore-global-env is #t, the search is confined to the given environment.
+<code>symbol->value</code> returns the value (lexically) bound to the symbol, whereas <code>symbol->dynamic-value</code>
+returns the value dynamically bound to it. A variable can access both of its values:
+</p>
+<pre class="indented">
+> (let ((x 32))
+ (define (gx) ; return both bindings of 'x
+ (list x (<em class=red>symbol->value</em> 'x) (<em class=red>symbol->dynamic-value</em> 'x)))
+ (let ((x 100))
+ (let ((x 12))
+ (values (gx))))) ; this 'values' looks dumb, it is dumb, but see my unconvincing explanantion <a href="#weaselwords">below</a>.
+ ; briefly: "dynamic binding" in s7 is not "lexically apparent dynamic binding"
+<em class="gray">(32 32 12)</em>
+</pre>
+
+<p>
+<code>symbol-table</code> returns a vector containing the symbols currently in the symbol-table.
+Here we scan the symbol table looking for any function that doesn't have documentation:
+</p>
+
+<pre class="indented">
+(for-each
+ (lambda (sym)
+ (if (<em class=red>defined?</em> sym)
+ (let ((val (<em class=red>symbol->value</em> sym)))
+ (if (and (procedure? val)
+ (string=? "" (procedure-documentation val)))
+ (format *stderr* "~S " sym)))))
+ (<em class=red>symbol-table</em>))
+</pre>
+
+
+<div class="indented">
+
+<p>Here's a better example, an automatic software tester.
+</p>
+
+<pre class="indented">
+(let ((constants (list #f #t pi () 1 1.5 3/2 1.5+i)))
+
+ (define (autotest func args args-left)
+ (catch #t (lambda () (apply func args)) (lambda any #f))
+ (if (> args-left 0)
+ (for-each
+ (lambda (c)
+ (autotest func (cons c args) (- args-left 1)))
+ constants)))
+
+ (for-each
+ (lambda (sym)
+ (if (<em class=red>defined?</em> sym)
+ (let ((val (<em class=red>symbol->value</em> sym)))
+ (if (procedure? val)
+ (let ((max-args (cdr (arity val))))
+ (if (or (> max-args 4)
+ (memq sym '(exit abort)))
+ (format #t ";skip ~S for now~%" sym)
+ (begin
+ (format #t ";whack on ~S...~%" sym)
+ (autotest val () max-args))))))))
+ (<em class=red>symbol-table</em>)))
+</pre>
+
+<p>Equally useful, a profiler:
+</p>
+
+<pre class="indented">
+(define <em class=def id="profile">profile</em>
+ (let ((documentation "(profile func) evaluates the function, then reports profiling information. \
+The function takes one argument, the environment in which loads and evals should operate."))
+ (lambda (expression)
+ (define calls (make-vector 1024 (cons 'unused -1)))
+ (define call 0)
+
+ (define (profile-1 n)
+ (set! (cdr (calls n)) (+ (cdr (calls n)) 1)))
+
+ (define (wrap-all)
+ (let ((e (inlet)))
+ (for-each
+ (lambda (sym)
+ (if (and (<em class=red>defined?</em> sym)
+ (not (constant? sym)))
+ (let ((val (<em class=red>symbol->value</em> sym)))
+ (if (procedure? val)
+ (let ((new-val (apply lambda 'args `((profile-1 ,call) (apply ,val args)))))
+ (set! (calls call) (cons sym 0))
+ (set! call (+ call 1))
+ (if (>= call (length calls))
+ (set! calls (copy calls (make-vector (* 2 (length calls)) (cons 'unused -1)))))
+ (if (procedure-setter val)
+ (set! (procedure-setter new-val) (procedure-setter val)))
+ (varlet e sym new-val))))))
+ (<em class=red>symbol-table</em>))
+ e))
+
+ (expression (wrap-all))
+ (sort! calls (lambda (a b) (> (cdr a) (cdr b))))
+ (do ((i 0 (+ i 1)))
+ ((= i call))
+ (if (> (cdr (calls i)) 0)
+ (format #t "~S: ~S~%" (car (calls i)) (cdr (calls i))))))))
+
+> (profile (lambda (e)
+ (load "lint.scm" e)
+ (with-let e (lint "dsp.scm"))))
+;;; many lines of data print out
+</pre>
+</div>
+
+<details id="weaselwords">
+<summary class="indented">more on dynamic values</summary>
+<div class="indented">
+<p>Why the useless 'values' in our dynamic binding example? The short answer: tail calls.
+The long winded one goes something like this. symbol->dynamic-value searches the stack to find
+the latest binding of its argument. But because we want to support tail calls, "let" does not
+push anything on the stack. If we call a function as the last thing that happens in that let's body,
+and it tries (internally) to access a dynamic binding, the let that launched the function no longer exists; it might already
+be garbage collected, and it certainly isn't on the stack. Take our earlier example without the
+'values':
+</p>
+
+<pre class="indented">
+(let ((x 32))
+ (define (gx)
+ (symbol->dynamic-value 'x))
+ (let ((x 100))
+ (gx)))
+</pre>
+
+<p>
+This returns 32 because the <code>(x 100)</code> binding no longer exists anywhere when the gx body is evaluated.
+So, in s7, the "dynamic binding" of x is the last binding of x that is accessible
+to s7. This may not be the last binding that we can see in the code text, but I don't see that as
+an inconsistency. It's not lexical after all.
+Leaving aside this special case, so to speak,
+dynamic binding does what you'd expect, even in the context of call/cc. See s7test.scm for
+the MIT-Scheme test of that interaction.
+</p>
+
+<p>There is another way to get the call-time value:
+</p>
+<pre class="indented">
+(define-macro (elambda args . body)
+ `(define-macro (,(gensym) , at args)
+ `((lambda* ,(append ',args `((*env* (curlet))))
+ ,'(begin , at body))
+ ,, at args)))
+
+(define efunc (elambda (x) (+ (*env* 'y) x))) ; add x to the run-time value of y
+(let ((y 3)) (efunc 1)) ; returns 4
+</pre>
+
+<p>elambda does not suffer from the symbol->dynamic-value defects mentioned above, but
+it's probably slower. We have to wrap the function in a macro because lambda*'s argument default
+values are evaluated in the definition environment, but we want the run-time environment.
+</p>
+
+<pre class="indented">
+(define-macro* (rlambda args . body) ; lambda* but eval arg defaults in run-time env
+ (let ((arg-names (map (lambda (arg) (if (pair? arg) (car arg) arg)) args))
+ (arg-defaults (map (lambda (arg) (if (pair? arg) `(,(car arg) (eval ,(cadr arg))) arg)) args)))
+ `(define-bacro* (,(gensym) , at arg-defaults)
+ `((lambda ,',arg-names ,'(begin , at body)) ,, at arg-names))))
+<!-- ( -->
+(let ()
+ (define rx (rlambda ((a x))
+ (if (> a 0)
+ (let ((x (- x 1))) ;:)
+ (rx))
+ 0)))
+ (let ((x 3))
+ (rx)))
+</pre>
+
+<p>Now putting that idea with the procedure-annotation macro given earlier, and the __func__ business
+(to get the caller's name), and taking care to handle default arguments correctly, we make a
+macro that returns an anonymous macro that returns an anonymous function that — where was I?
+</p>
+<pre class="indented">
+(define-macro (Display definition) ; (Display (define (f1 x) (+ x 1))) -> an annotated version of f1
+ (let ((func (caadr definition))
+ (args (cdadr definition)))
+ (let ((arg-names (map (lambda (a) (if (symbol? a) a (car a))) args))
+ (body (proc-walk `(begin ,@(cddr definition))))) ; from procedure-annotation above
+ `(define ,func
+ (define-macro* (,(gensym) , at args)
+ (let ((e (gensym))
+ (result (gensym)))
+ `((lambda* ,(append ',arg-names `((,e (curlet)))) ; the calling environment
+ (let ((,result '?))
+ (dynamic-wind
+ (lambda () ; display the caller, if any, as well as the incoming arguments
+ (format *stderr* "(~A~{~^ ~A~})" ',',func
+ (map (lambda (slot)
+ (if (gensym? (car slot)) (values) slot))
+ (outlet (outlet (curlet)))))
+ (let ((caller (eval '__func__ ,e)))
+ (if (not (eq? caller #<undefined>))
+ (format *stderr* " ;called from ~S" caller))
+ (newline *stderr*)))
+ (lambda () ; evaluate the original function's body with annotations
+ (set! ,result ,',body))
+ (lambda () ; display the result (it is returned by the set! above)
+ (format *stderr* " -> ~S~%" ,result)))))
+ ,, at arg-names)))))))
+</pre>
+<p>stuff.scm has a more mature version of this macro.
+</p>
+</div>
+</details>
+
+<div class="separator"></div>
+
+<p id="s7help"><b>help</b> tries to find information about its argument.
+</p>
+
+<pre class="indented">
> (help 'caadar)
-"(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"
+<em class="gray">"(caadar lst) returns (car (car (cdr (car lst)))): (caadar '((1 (2 3)))) -> 2"</em>
</pre>
-<p>If the initial expression in a function body is a string constant, it is assumed to be a documentation string (accessible via help or procedure-documentation):
+
+
+<div class="separator"></div>
+
+<p id="s7gc"><b>gc</b> calls the garbage collector. <code>(gc #f)</code> turns off the GC, and <code>(gc #t)</code> turns it on.
</p>
-<pre>
-(define (add1 a)
- "(add1 a) adds 1 to its argument"
- (+ a 1))
-> (help add1)
-"(add1 a) adds 1 to its argument"
+<div class="separator"></div>
+
+<pre class="indented">
+(<b><em class=def id="morallyequalp">morally-equal?</em></b> x y)
</pre>
+<p>
+Say we want to check that two different computations came to the same result, and that result might
+involve circular structures. Will equal? be our friend?
+</p>
+
+<pre class="indented">
+> (equal? 2 2.0)
+<em class="gray">#f</em>
+> (let ((x +nan.0)) (equal? x x))
+<em class="gray">#f</em>
+> (equal? .1 1/10)
+<em class="gray">#f </em>
+> (= .1 1/10)
+<em class="gray">#f</em>
+> (= 0.0 0+1e-300i)
+<em class="gray">#f</em>
+</pre>
+
+<p>No! We need an equality check that ignores epsilonic differences in real and
+complex numbers, and knows that NaNs are equal for all practical purposes.
+Leaving aside numbers,
+closed ports are not equal, yet nothing can be done with them.
+#() is not equal to #2d(). And two closures are never equal, even if their
+arguments, environments, and bodies are equal.
+Since there might be circles, it is not easy to write
+a replacement for equal? in Scheme.
+So, in s7, if one thing is basically the same as
+some other thing, they satisfy the function morally-equal?.
+</p>
+
+<pre class="indented">
+> (morally-equal? 2 2.0) ; would "equal!?" be a better name?
+<em class="gray">#t</em>
+> (morally-equal? 1/0 1/0) ; NaN
+<em class="gray">#t</em>
+> (morally-equal? .1 1/10)
+<em class="gray">#t</em> ; floating-point epsilon here is 1.0e-15 or thereabouts
+> (morally-equal? 0.0 1e-300)
+<em class="gray">#t</em>
+> (morally-equal? 0.0 1e-14)
+<em class="gray">#f</em> ; its not always #t!
+> (morally-equal? (lambda () #f) (lambda () #f))
+<em class="gray">#t</em>
+</pre>
+
+<p>The *s7* field morally-equal-float-epsilon sets the floating-point fudge factor.
+I can't decide how bignums should interact with morally-equal?. Currently,
+if a bignum is involved, either here or in a hash-table, s7 uses equal?.
+Finally, if either argument is an environment with a 'morally-equal? method,
+that method is invoked.
+</p>
+
+
+<div class="separator"></div>
+
+<p>
+<b><em class=def id="expansion">define-expansion</em></b> defines a macro that expands at read-time.
+It has the same syntax as
+define-macro, and (in normal use) the same result, but it is much faster because it expands only once.
+(See define-with-macros in s7test.scm for a way to expand macros in a function body at definition time).
+Since the reader knows almost nothing
+about the code it is reading,
+you need to make sure the expansion name is unique!
+The reader does know about global variables, so:
+</p>
+
+<pre class="indented">
+(define *debugging* #t)
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+(define-expansion (assert assertion)
+ (if *debugging* ; or maybe better, (eq? (symbol->value '*debugging*) #t)
+ `(unless ,assertion
+ (format *stderr* "~A: ~A failed~%" __func__ ',assertion))
+ (values)))
+</pre>
-<p><b>gc</b> calls the garbage collector. <code>(gc #f)</code> turns off the GC, and <code>(gc #t)</code> turns it on.
-In the multithread case, don't call gc yourself except from the top-level.
+<p>Now the assertion code is only present in the function body (or wherever)
+if *debugging* is #t; otherwise assert expands into nothing. Leaving aside
+read-time expansion and splicing, the real difference between define-macro and define-expansion
+is that the expansion's result is not evaluated.
+I'm no historian, but I believe that means that define-expansion creates
+a (gasp!) f*xpr. In fact:
</p>
-<!--
+<pre>
+(define-macro (define-f*xpr name-and-args . body)
+ `(define ,(car name-and-args)
+ (apply define-expansion
+ (append (list (append (list (gensym)) ',(cdr name-and-args))) ',body))))
+
+> (define-f*xpr (mac a) `(+ ,a 1))
+<em class="gray">mac</em>
+> (mac (* 2 3))
+<em class="gray">(+ (* 2 3) 1)</em>
+</pre>
+
<p>
-<b>define-expansion</b> defines read-time macros, which are just dangerous enough that
-I probably shouldn't document them. It has the same syntax as
-define-macro, and the same result except that the macro is
-dealt with at read time! (This means it does not respect attempts to
-bind it to something else, which is asking for confusion).
+You can do something similar with a normal macro, or make the indirection explicit:
+</p>
+
+<pre class="indented">
+> (define-macro (fx x) `'(+ 1 ,x)) ; quote result to avoid evaluation
+<em class="gray">fx</em>
+> (let ((a 3)) (fx a))
+<em class="gray">(+ 1 a)</em>
+> (define-expansion (ex x) `(+ 1 ,x))
+<em class="gray">ex</em>
+> (let ((x ex) (a 3)) (x a)) ; avoid read-time splicing
+<em class="gray">(+ 1 a)</em>
+> (let ((a 3)) (ex a)) ; spliced in at read-time
+<em class="gray">4</em>
+</pre>
+
+<p>As this example shows, the reader knows nothing about the program context,
+so if it does not see a list whose first element is a expansion name, it does
+not do anything special. In the <code>(x a)</code> case above, the
+expansion happens when the code is evaluated, and the expansion result
+is simply returned, unevaluated.
+</p>
+
+<p>You can also use macroexpand to cancel the evaluation of a macro's expansion:
</p>
+<pre>
+(define-macro (rmac . args)
+ (if (null? args)
+ ()
+ (if (null? (cdr args))
+ `(display ',(car args))
+ (append (list 'begin `(display ',(car args)))
+ (list (apply macroexpand (list (append '(rmac) (cdr args)))))))))
+
+> (macroexpand (rmac a b c))
+<em class="gray">(begin (display 'a) (begin (display 'b) (display 'c)))</em>
+> (begin (rmac a b c d) (newline))
+<em class="gray">abcd</em>
+</pre>
+
+<p>The main built-in expansion is <b><em class=def id="readercond">reader-cond</em></b>. The syntax is based on cond:
+the car of each clause is evaluated (in the read-time context), and if it is not false,
+the remainder of that clause is spliced into the code as if you had typed it from the start.
+</p>
+
+<pre class="indented">
+> '(1 2 (reader-cond ((> 1 0) 3) (else 4)) 5 6)
+<em class="gray">(1 2 3 5 6)</em>
+> ((reader-cond ((> 1 0) list 1 2) (else cons)) 5 6)
+<em class="gray">(1 2 5 6)</em>
+</pre>
+
+
+<!-- from kanren
+(define-syntax conj*
+ (syntax-rules ()
+ ((conj*) succeed)
+ ((conj* g) g)
+ ((conj* g gs ...)
+ (conj g (lambda (s) ((conj* gs ...) s))))))
+
+is the same (in that context) as:
+
+(define-macro (conj* . args)
+ (if (null? args)
+ succeed
+ (if (null? (cdr args))
+ (car args)
+ `(conj ,(car args)
+ (lambda (s) ((conj* ,@(cdr args)) s))))))
-->
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="separator"></div>
+<p id="s7env"><b>*s7*</b> is an environment that gives access to some of s7's internal
+state:
+</p>
+<pre class="indented">
+print-length number of elements of a sequence to print
+max-string-length max size arg to make-string and read-string
+max-list-length max size arg to make-list
+max-vector-length max size arg to make-vector and make-hash-table
+max-vector-dimensions make-vector dimensions limit
+default-hash-table-length default size for make-hash-table (8, tables resize as needed)
+initial-string-port-length 128, initial size of a string port's buffer
+
+default-rationalize-error 1e-12 (settable)
+morally-equal-float-epsilon 1e-15 (settable)
+hash-table-float-epsilon 1e-12 (settable, but currently limited to less than 1e-3).
+bignum-precision bits for bignum floats (128)
+float-format-precision digits to print for floats (16)
+default-random-state the default arg for random (settable)
+
+cpu-time run time so far
+file-names currently loaded files (a list)
+
+safety 0
+undefined-identifier-warnings #f
+
+catches a list of the currently active catch tags
+exits a list of active call-with-exit exit functions
+c-types a list of c-object type names (from s7_new_type, etc)
+input-ports, output-ports, strings, gensyms, vectors, hash-tables, continuations
+
+stack-top current stack location
+stack-size current stack size
+max-stack-size max stack size (settable)
+stack the current stack entries
+stacktrace-defaults stacktrace formatting info for error handler
+
+symbol-table a vector
+symbol-table-locked? #f (if #t, no new symbols can be added to the symbol table)
+rootlet-size the number of globals
+
+heap-size total cells currently available
+free-heap-size the number of currently unused cells
+gc-freed number of cells freed by the last GC pass
+gc-protected-objects vector of the objects permanently protected from the GC
+gc-stats #f (#t turns on printout of the GC activity)
+memory-usage a description of current memory allocations
+</pre>
+
+<p>
+Use the standard environment syntax to access these fields:
+<code>(*s7* 'stack-top)</code>. stuff.scm has the function
+*s7*->list that returns most of these fields in a list.
+</p>
+
+<p>
+Set (*s7* 'safety) to 2 or higher
+to turn off optimization.
+</p>
+
+<p>stacktrace-defaults is a list of four integers and a boolean that tell the error
+handler how to format stacktrace information. The four integers are:
+how many frames to display,
+how many columns are devoted to code display,
+how many columns are available for a line of data,
+and where to place comments.
+The boolean sets whether the entire output should be displayed as a comment.
+The defaults are '(3 45 80 45 #t).
+</p>
+
+<pre class="indented">
+(<em class=def id="cobject">c-object?</em> obj)
+(<em class=def id="cpointer">c-pointer?</em> obj)
+(<em class=def id="cpoint">c-pointer</em> int)
+</pre>
+
+<p>
+You can wrap up raw C pointers and
+pass them around in s7 code. The function c-pointer returns a wrapped pointer,
+and c-pointer? returns #t if passed one. <code>(define NULL (c-pointer 0))</code>.
+c-object? returns the object's type tag if passed such an object (otherwise #f of course). This tag is also the position
+of the object's type in the (*s7* 'c-types) list.
+(*s7* 'c-types) returns a list of the types created by s7_new_type_x and friends.
+</p>
+
+
+<div class="separator"></div>
+
+<blockquote>
-<p>Some other differences from r5rs:
+<div class="indented">
+<p id="s7vsr5rs">Some other differences from r5rs:
</p>
<ul>
-<li>after the initial binding, do sets its step variables, rather than rebinding them.
-<li>no force or delay (use slib).
+<li>no force or delay (see <a href="#r7rs">below</a>).
<li>no syntax-rules or any of its friends.
-<li>s7-version returns the current s7 version.
-<li>no scheme-report-environment (use initial-environment), null-environment, or interaction-environment (use current-environment).
+<li>no scheme-report-environment, null-environment, or interaction-environment (use curlet).
<li>no transcript-on or transcript-off.
-<li><A NAME="__func__">__func__</a> is the name (or name and location) of the function currently being defined or called, as in C.
<li>begin returns the value of the last form; it can contain both definitions and other statements.
<li>#<unspecified>, #<eof>, and #<undefined> are first-class objects.
<li>for-each and map accept different length arguments; the operation stops when any argument reaches its end.
-<li>for-each and map accept any applicable object as the first argument.
+<li>for-each and map accept any applicable object as the first argument, and any sequence or iterator as a trailing argument.
<li>letrec*, but without conviction.
-<li>set! and *-set! return the new value, not #<unspecified>.
-<li>port-closed?
-<li>current-input-port, current-output-port, and current-error-port have setters
+<li>set! and *-set! return the new value (modulo symbol-access), not #<unspecified>.
+<li>port-closed?
+<li>list? means "pair or null", proper-list? is r5rs list?, float? means "real and not rational", sequence? = length.
+<!-- a vector can be a member of itself, and yet vector? returns #t, why is list? different; we even call it a circular list! -->
+<!-- <li>current-input-port, current-output-port, and current-error-port have setters (but I may remove these) -->
<li>the default IO ports are named *stdin*, *stdout*, and *stderr*.
-<li>*gc-stats* is a boolean that controls whether GC stats are printed.
-<li>member and assoc accept an optional 3rd argument, the comparison function (equal? is the default).
+<li>#f as an output port means nothing is output (#f is /dev/null, I guess).
+<li>member and assoc accept an optional third argument, the comparison function (equal? is the default).
+<li>case accepts => much like cond (the function argument is the selector).
+<li>if WITH_SYSTEM_EXTRAS is 1, the following are built-in: directory?, file-exists?, delete-file, system, directory->list, getenv.
+<li>s7 is case sensitive.
+<li>when and unless (for r7rs), returning the value of the last form.
+<li>the "d", "f", "s", and "l" exponent markers are not supported by default (use "e", "E", or "@").
+<li>quasiquoted vector constants are not supported by default — use reader-cond instead.
</ul>
-<small>
-<blockquote>
+<p>In s7 if a built-in function like gcd is referred to in a function
+body, the optimizer is free to replace it with #_function. That is, <code>(gcd ...)</code> can be changed
+to <code>(#_gcd ...)</code> at s7's whim, if gcd has its original value at the time the optimizer
+sees the expression using it. A subsequent <code>(set! gcd +)</code> does not affect this optimized call.
+I think I could wave my hands and mumble about "aggressive lexical scope" or something, but actually the
+choice here is that speed trumps that ol' hobgoblin consistency. If you want to change gcd to +, do it before
+loading code that calls gcd.
+I think most Schemes handle macros this way: the macro call is replaced by its expansion using its current
+definition, and a later redefinition does not affect earlier uses.
+</p>
+
+<!-- another case: (with-let (inlet '+ -) (+ 2 3)) -> 5 -->
+<!-- also, (eq? (if #f #f) (apply values ())) is #t, but memq and assq don't treat them as equal -->
+
+</div>
+
+<!-- null-environment does not fit very well; how to shadow earlier define-constant for example
+ one of which is unlet; perhaps make a special environment at init time?
+ the code for that is save_null_environment, but it is untested and commented out.
+-->
+
+<div class="indented">
+
+<p>Here are some changes I'd make to s7 if I didn't care about compatibility with other Schemes:
+</p>
+
+<ul>
+<li>remove the exact/inexact distinction including #i and #e
+<li>remove call-with-values and its friends
+<li>remove char-ready?
+<li>change eof-object? to eof? or just omit it (you can use eq? #<eof>)
+<li>change make-rectangular to complex, and remove make-polar.
+<li>remove unquote (the name, not the functionality).
+<li>remove cond-expand.
+<li>remove *-ci functions (they are completely useless)
+</ul>
+
+<p>(most of these are removed if you set the compiler flag WITH_PURE_S7), and perhaps:
+</p>
+
+<ul>
+<li>remove even? and odd?, gcd and lcm.
+<li>remove string-length and vector-length.
+<li>remove list-ref|set!, string-ref|set!, vector-ref|set!, hash-table-ref|set!, set-car!|cdr!, and set-current-output|input|error-port.
+<li>change file-exists? to file? (or omit it and assume the use of libc.scm — why reinvent the wheel?).
+<li>remove all the conversion and copy functions like vector->list and vector-copy (use copy or map).
+<li>add typeq? and perhaps make null? generic (see stuff.scm).
+<li>change string->symbol to symbol (what to do with symbol->string in that case?)
+<li>change with-output-to-* and with-input-from-* to omit the pointless lambda.
+<li>remove the with-* IO functions (e.g. with-input-from-string), keeping the call-with-* versions (call-with-input-string).
+<li>remove assq, assv, memq, and memv (these are pointless now that assoc and member can be passed eq? and eqv?).
+</ul>
+
+<p>There are several less-than-ideal names. Perhaps s7 should use *pi*, *most-negative-fixnum*,
+*most-positive-fixnum* (*fixmost*?) so that all the built-in variables and constants have the
+same kind of name (or +pi+ to show it is a constant?).
+Perhaps object->string should be ->string.
+get-output-string should be current-output-string. write-char behaves like display, not write.
+provided? should be feature? or *features* should be *provisions*.
+</p>
+
+<p>
+The name "cond-expand" is bad — we're not expanding anything, and the macro's point is to make it easy to
+operate with the *features* list; perhaps "cond-provided"? Not only is cond-expand poorly named, but the whole
+idea is clumsy. Take libgsl.scm; different versions of the GSL library have different functions. We need to know
+when we're building the FFI what GSL version we're dealing with. It would be nuts to start pushing and checking dozens
+of library version symbols when all we actually want is <code>(> version 23.19)</code>. (We are also politely
+trying to ignore the ridiculous little language built into cond-expand; are we not running Scheme?).
+In place of cond-expand, s7 uses <a href="#readercond">reader-cond</a>,
+so the read-time decision involves normal evaluation.
+</p>
+
+<p>
+Better ideas are always welcome!
+</p>
+
+<p>Here are the built-in s7 variables:
+</p>
+<ul>
+<li>*features* ; a list of symbols
+<li>*libraries* ; a list of (filename . let) pairs
+<li>*load-path* ; a list of directories
+<li>*autoload* ; autoload info (a function internally)
+<li>*#readers* ; a list of (char . handler) pairs
+</ul>
+
+<p>And the built-in constants:
+</p>
+<ul>
+<li>pi
+<li>*stdin* *stdout* *stderr*
+<li>*s7*
+<li>nan.0 -nan.0 inf.0 -inf.0 (what crappy names! nan.0 is an inexact integer that is not a number?)
+<li>most-positive-fixnum most-negative-fixnum
+<li>*unbound-variable-hook* *missing-close-paren-hook* *load-hook* *error-hook*
+</ul>
+
+<p>__func__ is the name (or name and location) of the function currently being called, as in C.
+</p>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<p>Currently WITH_PURE_S7:
+</p>
+<ul>
+<li>places 'pure-s7 in *features*
+<li>omits char-ready, char-ci*, string-ci*
+<li>omits string-copy, string-fill!, vector-fill!, vector-append
+<li>omits list->string, list->vector, string->list, vector->list, let->list
+<li>omits string-length and vector-length
+<li>omits cond-expand, multiple-values-bind|set!, call-with-values, defmacro(*)
+<li>omits unquote (the name), and quasiquoted vector constants
+<li>omits d/f/s/l exponents
+<li>omits make-polar and make-rectangular (use complex)
+<li>omits integer-length, exact?, inexact?, exact->inexact, inexact->exact, #i and #e
+<li>omits set-current-output-port and set-current-input-port
+<li>omits memq, memv, assq, assv
+</ul>
+
+</div>
+
+
+
+<details>
+<summary class="indented">quotes</summary>
+<div class="indented">
<p>Schemes vary in their treatment of (). s7 considers it a constant that evaluates to itself,
-so you rarely need to quote it. <code>(eq? () '())</code> is #t.
+so you don't need to quote it. <code>(eq? () '())</code> is #t.
This is consistent with, for example,
<code>(eq? #f '#f)</code> which is also #t.
The standard says "the empty list is a special object of its own type", so surely either choice is
@@ -4197,16 +5827,16 @@ acceptable in that regard. One place where the quote matters is in a case state
evaluated but the key is not:
</p>
-<pre>
+<pre class="indented">
> (case '() ((()) 2) (else 1))
-2
+<em class="gray">2</em>
> (case '() (('()) 2) (else 1)) ; (eqv? '() ''()) is #f
-1
+<em class="gray">1</em>
;;; which parallels #f (or a number such as 2 etc):
> (case '#f ((#f) 2) (else 1))
-2
+<em class="gray">2</em>
> (case '#f (('#f) 2) (else 1)) ; (eqv? '#f ''#f) is #f
-1
+<em class="gray">1</em>
</pre>
<p>Similarly, vector constants do not have to be quoted. A list constant is quoted
@@ -4217,24 +5847,25 @@ to keep it from being evaluated, but
<!-- there's another sense in which '() is a constant: you can't apply it to anything. ('() 0) -> error
-->
-
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>Schemes also vary in handling trailing arguments:
-<code>(* 0 "hi")</code> in Guile returns 0, but s7 gives an error.
-<code>(cond (1) (=>))</code> is 1 in both, and
-<code>(or 1 2 . 3)</code> is an
-error in Guile, and 1 in s7!
-Because it flushes trailing arguments, Guile returns 0 from <code>(* 0 +inf.0)</code>, but I think it should return NaN.
+<p>These examples bring up another odd corner of scheme: else. In <code>(cond (else 1))</code>
+the 'else is evaluated (like any cond test), so its value might be #f; in <code>(case 0 (else 1))</code>
+it is not evaluated (like any case key), so it's just a symbol.
+Since symbol accessors are local in s7,
+someone can <code>(let ((else #f)) (cond (else 1)))</code> even if we protect the rootlet 'else.
+Of course, in scheme this kind of trouble is pervasive, so rather than make 'else a constant
+I think the best path is to use unlet:
+<code>(let ((else #f)) (cond (#_else 1)))</code>. This is 1 (not ()) because the initial value of 'else
+can't be changed.
</p>
+</div>
+</details>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<details>
+<summary class="indented">mutable constants</summary>
+<div class="indented">
-<p>And a harder one... How should s7 treat this:
+<p>How should s7 treat this:
<code>(string-set! "hiho" 1 #\z)</code>, or
<code>(vector-set! #(1 2 3) 1 32)</code>, or
<code>(list-set! '(1 2 3) 1 32)</code>?
@@ -4243,15 +5874,13 @@ Guile and Common Lisp accept all three, but that leads to weird cases where we c
into a function's body:
</p>
-<pre>
+<pre class="indented">
> (let ((x (lambda () '(1 2 3)))) (list-set! (x) 1 32) (x))
-(1 32 3) ; s7, Guile
-
+<em class="gray">(1 32 3)</em> ; s7, Guile
> (flet ((x () '(1 2 3))) (setf (nth 1 (x)) 32) (x))
-(1 32 3) ; Clisp
-
+<em class="gray">(1 32 3)</em> ; Clisp
> (let ((x (lambda () (list 1 2 3)))) (list-set! (x) 1 32) (x))
-(1 2 3)
+<em class="gray">(1 2 3)</em>
</pre>
<p>
@@ -4259,23 +5888,22 @@ But it's possible to reach into a function's closure, even when the
closed-over thing is a constant:
</p>
-<pre>
+<pre class="indented">
> (flet ((x () '(1 2 3))) (setf (nth 1 (x)) 32) (x))
-(1 32 3)
-
+<em class="gray">(1 32 3)</em>
> (let ((xx (let ((x '(1 2 3))) (lambda () x)))) (list-set! (xx) 1 32) (xx))
-(1 32 3)
-
+<em class="gray">(1 32 3)</em>
> (let ((xx (let ((x (list 1 2 3))) (lambda () x)))) (list-set! (xx) 1 32) (xx))
-(1 32 3)
+<em class="gray">(1 32 3)</em>
</pre>
-<p>And it's possible to reach into a constant list via list-set! (or set-car! of course):
+<p>
+And it's possible to reach into a constant list via list-set! (or set-car! of course):
</p>
-<pre>
+<pre class="indented">
> (let* ((x '(1 2)) (y (list x)) (z (car y))) (list-set! z 1 32) (list x y z))
-((1 32) ((1 32)) (1 32))
+<em class="gray">((1 32) ((1 32)) (1 32))</em>
</pre>
<p>
@@ -4286,17 +5914,17 @@ If we flush "immutable constant" because it is a ham-fisted, whack-it-with-a-sho
the only real problem I can see is symbol->string. In CL, this is explicitly an error:
</p>
-<pre>
+<pre class="indented">
> (setf (elt (symbol-name 'xyz) 1) #\X)
-*** - Attempt to modify a read-only string: "XYZ"
+<em class="gray">*** - Attempt to modify a read-only string: "XYZ"</em>
</pre>
<p>And in Guile:
</p>
-<pre>
+<pre class="indented">
> (string-set! (symbol->string 'symbol->string) 1 #\X)
-ERROR: string is read-only: "symbol->string"
+<em class="gray">ERROR: string is read-only: "symbol->string"</em>
</pre>
<p>So both have a notion of immutable strings.
@@ -4304,23 +5932,31 @@ I wonder what other Scheme programmers (not implementors!) want in this situatio
Currently, there are no immutable list, string, or vector constants, and
symbol->string
returns a copy of the string.
-One simple way to ensure immutability is to use copy:
+copy can protect some values. Or combine object->string and string->symbol:
</p>
-<pre>
+<pre class="indented">
> (let ((x (lambda () (copy "hiho")))) (string-set! (x) 1 #\x) (x))
-"hiho"
-</pre>
-
-<p>There is one pitfall here. s7 normally tries to optimize garbage collection by
-removing some constants from the heap. If that constant is a list or a vector, and you later
-set some member of it to something that needs GC protection, nobody in the heap points to it, so
+<em class="gray">"hiho"</em>
+> (let ((x (string->symbol "hiho"))) (string-set! (symbol->string x) 1 #\x) (symbol->string x))
+<em class="gray">"hiho"</em>
+> (define (immutable obj) (string->symbol (object->string obj :readable)))
+<em class="gray">immutable</em>
+> (define (symbol->object sym) (eval-string (symbol->string sym)))
+<em class="gray">symbol->object</em>
+> (symbol->object (immutable (list 1 2 3)))
+<em class="gray">(1 2 3)</em>
+</pre>
+
+<p>s7 normally tries to optimize garbage collection by
+removing some list constants from the heap. If you later
+set a member of it to something that needs GC protection, nobody in the heap points to it, so
it is GC'd. Here is an example:
</p>
-<pre>
+<pre class="indented">
(define (bad-idea)
- (let ((lst '(1 2 3))) ; or #(1 2 3) and vector-ref|set
+ (let ((lst '(1 2 3)))
(let ((result (list-ref lst 1)))
(list-set! lst 1 (* 2.0 16.6))
(gc)
@@ -4328,46 +5964,157 @@ it is GC'd. Here is an example:
</pre>
<p>Put this is a file, load it into the interpreter, then call <code>(bad-idea)</code> a
-few times. You can turn off the optimization in question by setting the variable <b>*safety*</b>
-to 1. *safety* defaults to 0. (Also, if *safety* is not 0, sort! is safe from infinite loops).
+few times. You can turn off the optimization in question by setting the variable <code>(*s7* 'safety)</code>
+to 1. <code>(*s7* 'safety)</code> defaults to 0.
</p>
+<!-- there is another problem here: if the list constant in question is a program fragment
+ that can be optimized, then reapplied elsewhere, the optimization info remains in the
+ new, possibly inappropriate context. This can cause segfaults. The fix is to copy
+ the list with 2nd arg :readable. see tgen.scm
+-->
+
+</div>
+</details>
+
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<details id="circle">
+<summary class="indented">circular lists</summary>
+<div class="indented">
<p>s7 handles circular lists and vectors and dotted lists with its customary aplomb.
You can pass them to memq, or print them, for example; you can even evaluate them.
The print syntax is borrowed from CL:
</p>
-<pre>
+<pre class="indented">
> (let ((lst (list 1 2 3)))
(set! (cdr (cdr (cdr lst))) lst)
lst)
-#1=(1 2 3 . #1#)
-
+<em class="gray">#1=(1 2 3 . #1#)</em>
> (let* ((x (cons 1 2))
(y (cons 3 x)))
(list x y))
-(#1=(1 . 2) (3 . #1#)) ; shared lists use the same syntax: '((1 . 2) (3 1 . 2)) spelled out
+<em class="gray">(#1=(1 . 2) (3 . #1#))</em>
</pre>
-<p>But should this syntax be readable as well? I'm inclined to say no because
+<p id="circularlistreader">
+But should this syntax be readable as well? I'm inclined to say no because
then it is part of the language, and it doesn't look like the rest of the language.
-(I think it's kind of ugly). Perhaps we could implement it via *#readers*.
+(I think it's kind of ugly). Perhaps we could implement it via *#readers*:
+</p>
+
+<pre>
+(define circular-list-reader
+ (let ((known-vals #f)
+ (top-n -1))
+ (lambda (str)
+
+ (define (replace-syms lst)
+ ;; walk through the new list, replacing our special keywords
+ ;; with the associated locations
+
+ (define (replace-sym tree getter)
+ (if (keyword? (getter tree))
+ (let ((n (string->number (symbol->string (keyword->symbol (getter tree))))))
+ (if (integer? n)
+ (let ((lst (assoc n known-vals)))
+ (if lst
+ (set! (getter tree) (cdr lst))
+ (format *stderr* "#~D# is not defined~%" n)))))))
+
+ (define (walk-tree tree)
+ (if (pair? tree)
+ (begin
+ (if (pair? (car tree)) (walk-tree (car tree)) (replace-sym tree car))
+ (if (pair? (cdr tree)) (walk-tree (cdr tree)) (replace-sym tree cdr))))
+ tree)
+
+ (walk-tree (cdr lst)))
+
+ ;; str is whatever followed the #, first char is a digit
+ (let* ((len (length str))
+ (last-char (str (- len 1))))
+ (and (memq last-char '(#\= #\#)) ; is it #n= or #n#?
+ (let ((n (string->number (substring str 0 (- len 1)))))
+ (and (integer? n)
+ (begin
+ (if (not known-vals) ; save n so we know when we're done
+ (begin
+ (set! known-vals ())
+ (set! top-n n)))
+
+ (if (char=? last-char #\=) ; #n=
+ (and (char=? (peek-char) #\()
+ (let ((cur-val (assoc n known-vals)))
+ ;; associate the number and the list it points to
+ ;; if cur-val, perhaps complain? (#n# redefined)
+ (let ((lst (catch #t
+ read
+ (lambda args ; a read error
+ (set! known-vals #f) ; so clear our state
+ (apply throw args))))) ; and pass the error on up
+ (if (not cur-val)
+ (set! known-vals
+ (cons (set! cur-val (cons n lst)) known-vals))
+ (set! (cdr cur-val) lst)))
+
+ (if (= n top-n) ; replace our special keywords
+ (let ((result (replace-syms cur-val)))
+ (set! known-vals #f) ; '#1=(#+gsl #1#) -> '(:1)!
+ result)
+ (cdr cur-val))))
+ ; #n=<not a list>?
+ ;; else it's #n# — set a marker for now since we may not
+ ;; have its associated value yet. We use a symbol name that
+ ;; string->number accepts.
+ (symbol->keyword
+ (symbol (string-append (number->string n) (string #\null) " ")))))))
+ ; #n<not an integer>?
+ ))))) ; #n<something else>?
+
+(do ((i 0 (+ i 1)))
+ ((= i 10))
+ ;; load up all the #n cases
+ (set! *#readers*
+ (cons (cons (integer->char (+ i (char->integer #\0))) circular-list-reader)
+ *#readers*)))
+<!-- ) -->
+> '#1=(1 2 . #1#)
+<em class="gray">#1=(1 2 . #1#)</em>
+> '#1=(1 #2=(2 . #2#) . #1#)
+<em class="gray">#2=(1 #1=(2 . #1#) . #2#)</em>
+</pre>
+
+<p>And of course, we can treat these as labels:
+</p>
+
+<pre class="indented">
+(let ((ctr 0)) #1=(begin (format #t "~D " ctr) (set! ctr (+ ctr 1)) (if (< ctr 4) #1# (newline))))
+</pre>
+
+<p>which prints "0 1 2 3" and a newline.
</p>
+<br>
+
+
<p>Length returns +inf.0 if passed a circular list, and returns a negative
number if passed a dotted list. In the dotted case, the absolute value of the length is the list length not counting
the final cdr. <code>(define (circular? lst) (infinite? (length lst)))</code>.
</p>
+<p>
+<em class=def id="cyclicsequences">cyclic-sequences</em> returns a list of the cyclic
+sequences in its argument, or nil.
+<code>(define (cyclic? obj) (pair? (cyclic-sequences obj)))</code>.
+</p>
+
<p>Here's an amusing use of circular lists:
</p>
-<pre>
+<pre class="indented">
(define (for-each-permutation func vals)
;; apply func to every permutation of vals:
;; (for-each-permutation (lambda args (format #t "~{~A~^ ~}~%" args)) '(1 2 3))
@@ -4384,14 +6131,16 @@ the final cdr. <code>(define (circular? lst) (infinite? (length lst)))</code>.
(set! (cdr start) nvals)))))) ; restore original circle
(let ((len (length vals)))
(set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle
- (pinner '() vals len)
- (set-cdr! (list-tail vals (- len 1)) '()))) ; restore its original shape
+ (pinner () vals len)
+ (set-cdr! (list-tail vals (- len 1)) ()))) ; restore its original shape
</pre>
-<br>
+</div>
+</details>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<details>
+<summary class="indented">unprintable symbols</summary>
+<div class="indented">
<p>s7 and Snd use "*" in a variable name, *features* for example, to indicate
that the variable is predefined. It may occur unprotected in a macro, for
@@ -4412,31 +6161,31 @@ name, but ".." is.
These weird symbols have to be printed sometimes:
</p>
-<pre>
+<pre class="indented">
> (list 1 (string->symbol (string #\; #\" #\\)) 2)
-(1 ;"\ 2) <!-- " -->
+<em class="gray">(1 ;"\ 2)</em> <!-- " -->
> (list 1 (string->symbol (string #\.)) 2)
-(1 . 2)
+<em class="gray">(1 . 2)</em>
</pre>
<p>which is a mess. Guile prints the first as <code>(1 #{\;\"\\}# 2)</code>.
In CL and some Schemes:
</p>
-<pre>
+<pre class="indented">
[1]> (list 1 (intern (coerce (list #\; #\" #\\) 'string)) 2) ; thanks to Rob Warnock
-(1 |;"\\| 2) <!-- " -->
+<em class="gray">(1 |;"\\| 2)</em> <!-- " -->
[2]> (equalp 'A '|A|) ; in CL case matters here
-T
+<em class="gray">T</em>
</pre>
<p>This is clean, and has the weight of tradition behind it, but
I think I'll use "symbol" instead:
</p>
-<pre>
+<pre class="indented">
> (list 1 (string->symbol (string #\; #\" #\\)) 2)
-(1 (symbol ";\"\\") 2) <!-- " -->
+<em class="gray">(1 (symbol ";\"\\") 2)</em> <!-- " -->
</pre>
<p>
@@ -4448,423 +6197,326 @@ but then one vertical bar is trouble.
</p>
<p>
-These symbols are not just a silly optimization of string comparison:
+These symbols are not just an optimization of string comparison:
</p>
-<pre>
-(define-macro (hi a)
- (let ((funny-name (string->symbol (string #\;))))
+<pre class="indented">
+> (define-macro (hi a)
+ (let ((funny-name (string->symbol ";")))
`(let ((,funny-name ,a)) (+ 1 ,funny-name))))
-
+<em class="gray">hi</em>
> (hi 2)
-3
+<em class="gray">3</em>
> (macroexpand (hi 2))
-(let ((; 2)) (+ 1 ;)) ; for a good time, try (string #\")
+<em class="gray">(let ((; 2)) (+ 1 ;))</em> ; for a good time, try (string #\")
-(define-macro (hi a)
+> (define-macro (hi a)
(let ((funny-name (string->symbol "| e t c |")))
`(let ((,funny-name ,a)) (+ 1 ,funny-name))))
+<em class="gray">hi</em>
> (hi 2)
-3
+<em class="gray">3</em>
> (macroexpand (hi 2))
-(let ((| e t c | 2)) (+ 1 | e t c |))
-
+<em class="gray">(let ((| e t c | 2)) (+ 1 | e t c |))</em>
> (let ((funny-name (string->symbol "| e t c |"))) ; now use it as a keyword arg to a function
(apply define* `((func (,funny-name 32)) (+ ,funny-name 1)))
;; (procedure-source func) is (lambda* ((| e t c | 32)) (+ | e t c | 1))
(apply func (list (symbol->keyword funny-name) 2)))
-3
+<em class="gray">3</em>
</pre>
<p>I hope that makes you as happy as it makes me!
</p>
+</div>
+</details>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="indented">
-<p>The built-in syntactic names, such as "begin", are almost first-class citizens.
+<p id="legolambda">The built-in syntactic forms, such as "begin", are almost first-class citizens.
</p>
-<pre>
+<pre class="indented">
> (let ((progn begin))
(progn
(define x 1)
(set! x 3)
(+ x 4)))
-7
-
+<em class="gray">7</em>
> (let ((function lambda))
((function (a b) (list a b)) 3 4))
-(3 4)
-
+<em class="gray">(3 4)</em>
> (apply begin '((define x 3) (+ x 2)))
-5
-
+<em class="gray">5</em>
> ((lambda (n) (apply n '(((x 1)) (+ x 2)))) let)
-3
+<em class="gray">3</em>
+
+(define-macro (symbol-set! var val) ; like CL's set
+ `(apply set! ,var ',val ())) ; trailing nil is just to make apply happy — apply*?
-> (define-macro (symbol-set! var val) ; use apply instead of define-bacro
- `(apply set! ,var (list ,val)))
+(define-macro (progv vars vals . body)
+ `(apply (apply lambda ,vars ',body) ,vals))
+
+> (let ((s '(one two)) (v '(1 2))) (progv s v (+ one two)))
+<em class="gray">3</em>
</pre>
<p>We can snap together program fragments ("look Ma, no macros!"):
</p>
-<pre>
+<pre class="indented">
(let* ((x 3)
(arg '(x))
(body `((+ ,x x 1))))
((apply lambda arg body) 12)) ; "legolambda"?
+(define (engulph form)
+ (let ((body `(let ((L ()))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) (reverse L))
+ (set! L (cons ,form L))))))
+ (define function (apply lambda () (list (copy body :readable))))
+ (function)))
+
(let ()
(define (hi a) (+ a x))
((apply let '((x 32)) (list (procedure-source hi))) 12)) ; one function, many closures?
-</pre>
-
-<p>If you apply define or define-macro, the returned value is a symbol, so to apply the
-new function or macro, you need to use either eval or symbol->value:
-</p>
-<pre>
-> ((symbol->value (apply define-macro '((m a) `(+ 1 ,a)))) 3)
-4
-> ((symbol->value (apply define '((hi a) (+ a 1)))) 3)
-4
+(let ((ctr -1)) ; (enum zero one two) but without using a macro
+ (apply begin
+ (map (lambda (symbol)
+ (set! ctr (+ ctr 1))
+ (list 'define symbol ctr)) ; e.g. '(define zero 0)
+ '(zero one two)))
+ (+ zero one two))
</pre>
-<p>This gives us a way to make anonymous macros, just as lambda returns an anonymous function:
+<p>But there's a prettier way to implement enum ("transparent-for-each"):
</p>
-<pre>
-(define-macro (mu args . body)
- (let ((m (gensym)))
- `(symbol->value (apply define-macro '((,m , at args) , at body)))))
-
-> ((mu (a) `(+ 1 ,a)) 3)
-4
+<pre class="indented">
+> (define-macro (enum . args)
+ `(for-each define ',args (iota (length ',args))))
+<em class="gray">enum</em>
+> (enum a b c)
+<em class="gray">#<unspecified></em>
+> b
+<em class="gray">1</em>
</pre>
-<p>
-Currently, you can't set! a built-in syntactic object to some new value:
-<code>(set! if 3)</code>.
-I hope this kind of thing is not actually very useful, but let me
-know if you need it. The issue is purely one of speed.
-</p>
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>
-In s7, there is only one kind of begin statement,
-and it can contain both definitions and expressions. These are evaluated in the order
-in which they occur, and in the environment at the point of the evaluation. I think
-of it as being a little REPL. begin does not introduce a new frame in
-the current environment, so defines happen at the enclosing level.
+<p><code>(apply define ...)</code> is similar to CL's set.
</p>
-<pre>
-> (let ((y 2))
- (let ((x 1))
- (begin
- (define x y) ; x is 2 (this x is the same as the x in the let above it)
- (set! x (* x 2)) ; now it is 4
- (define y 123)) ; this is great, but it doesn't affect x
- x)) ; defines in begin are in the enclosing environment so
- 4 ; we get 4
+<pre class="indented">
+> ((apply define-macro '((m a) `(+ 1 ,a))) 3)
+<em class="gray">4</em>
+> ((apply define '((hi a) (+ a 1))) 3)
+<em class="gray">4</em>
</pre>
+<p>This gives us a way to make anonymous macros, just as lambda returns an anonymous function:
+</p>
+<pre class="indented">
+> (define-macro (mu args . body)
+ `(apply define-macro '((,(gensym) , at args) , at body)))
+<em class="gray">mu</em>
+> ((mu (a) `(+ 1 ,a)) 3)
+<em class="gray">4</em>
+> (define-macro (glambda args) ; returns an anonymous macro that will return a function given a body
+ `(define-macro (,(gensym) . body)
+ `(lambda ,',args , at body)))
+<em class="gray">glambda</em>
+> (let ((gf (glambda (a b)))) ; gf is now ready for any body that involves arguments 'a and 'b
+ ((gf (+ a b)) 1 2)) ; apply (lambda (a b) (+ a b)) to '(1 2)
+<em class="gray">3</em>
+</pre>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<p>I can't find the right tone for this section; this is the 400-th revision; I wish I were a better writer!
-I think the exact/inexact distinction in Scheme is confused and useless, and leads
-to verbose and buggy code.
-In some Schemes,
-"rational" means "could possibly be
-expressed equally well as a ratio (floats are approximations)". In s7 it's: "is actually expressed as a ratio (or an integer of course)";
-otherwise "rational?" is the same as "real?":
+<p>catch, dynamic-wind, and many of the other functions that take function
+arguments in standard Scheme, accept macros in s7.
</p>
+<p>Apply let is very similar to eval:
+</p>
<pre>
-(not-s7-scheme)> (rational? (sqrt 2))
-#t
+> (apply let '((a 2) (b 3)) '((+ a b)))
+<em class="gray">5</em>
+> (eval '(+ a b) (inlet 'a 2 'b 3))
+<em class="gray">5</em>
+> ((apply lambda '(a b) '((+ a b))) 2 3)
+<em class="gray">5</em>
+> (apply let '((a 2) (b 3)) '((list + a b))) ; a -> 2, b -> 3
+<em class="gray">(+ 2 3)</em>
</pre>
-
-<p>As I understand it, "inexact" originally meant "floating point", and "exact" meant integer or ratio of integers.
-But words have a life of their own.
-0.0 somehow became an "inexact" integer (although it can be represented exactly in floating
-point).
-+inf.0 must be an integer —
-its fractional part is explicitly zero! But +nan.0...
-And then there's:
+<p>The redundant-looking double lists are for apply's benefit. We could
+use a trailing null instead (mimicking apply* in some ancient lisps):
</p>
-
<pre>
-(not-s7-scheme)> (integer? 9007199254740993.1)
-#t
+> (apply let '((a 2) (b 3)) '(list + a b) ())
+<em class="gray">(+ 2 3)</em>
</pre>
<p>
-When does this matter? I often need to index into a vector, but the index is a float (a "real" in Scheme-speak: its
-fractional part can be non-zero).
-In one Scheme:
+Currently, you can't set! a built-in syntactic keyword to some new value:
+<code>(set! if 3)</code>.
+I hope this kind of thing is not actually very useful, but let me
+know if you need it. The issue is purely one of speed.
</p>
-<pre>
-(not-s7-scheme)> (vector-ref #(0) (floor 0.1))
-ERROR: Wrong type (expecting exact integer): 0.0 ; [why? "it's probably a programmer mistake"!]
-</pre>
-
-<p>Not to worry, I'll use inexact->exact:
+<p>Speaking of speed... It is widely believed
+that a Scheme with first class everything can't hope to compete with any
+"real" Scheme. Humph I say. Take this little example (which is not
+so misleading that I feel guilty about it):
</p>
+<pre class="indented">
+(define (do-loop n)
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (if (zero? (modulo i 1000))
+ (display ".")))
+ (newline))
-<pre>
-(not-s7-scheme)> (inexact->exact 0.1)
-3602879701896397/36028797018963968 ; [why? "floats are ratios"!]
+(for-each
+ (lambda (n) (do-loop n))
+ (list 1000 1000000 10000000))
</pre>
-<p>So I end up using the verbose <code>(floor (inexact->exact ...))</code> everywhere, and even
-then I have no guarantee that I'll get a legal vector index.
-When I started work on s7, I thought perhaps
-"exact" could mean "is represented exactly in the computer". We'd have integers and ratios exact;
-reals and complex exact if they are exactly
-represented in the current floating point implementation.
-0.0 and 0.5 might be exact if the printout isn't misleading, and 0.1 is inexact.
-"integer?" and friends would refer instead to the programmer's point of view.
-That is, if the programmer uses 1 or if the thing prints as 1, it is the integer 1, whereas 1.0
-means floating point (not integer!).
-And to keep exactness in view, we'd have
-to monitor which operations introduce inexactness — a kind of interval arithmetic.
-But then what would inexact->exact do?
-If we discard the exact/inexact distinction,
-we can maintain backwards compatibility via:
+<p>In s7, that takes 0.24 seconds on my home machine. In tinyScheme, from
+whence we sprang, it takes 85 seconds. In the chicken interpreter, 5.3
+seconds, and after compilation (using -O2) of the chicken compiler output,
+0.75 seconds. So, s7 is comparable to chicken in speed, even though chicken
+is compiling to C. I think Guile 2.0.9 takes about 1 second.
+The equivalent in CL:
+clisp interpreted 9.3 seconds, compiled 0.85 seconds; sbcl 0.21 seconds.
</p>
+</div>
-<pre>
- (define exact? rational?)
- (define (inexact? x) (not (rational? x)))
- (define inexact->exact rationalize) ; or floor
- (define (exact->inexact x) (* x 1.0))
-</pre>
-<p>#i and #e are also useless because you can
-have any number after, for example, #b:
+
+
+<div class="indented">
+
+<p>In s7, there is only one kind of begin statement,
+and it can contain both definitions and expressions. These are evaluated in the order
+in which they occur, and in the environment at the point of the evaluation. I think
+of it as being a little REPL. begin does not introduce a new frame in
+the current environment, so defines happen in the enclosing environment.
</p>
+</div>
-<pre>
- > #b1.1
- 1.5
- > #b1e2
- 4.0
- > #o17.5+i
- 15.625+1i
-</pre>
-<p>Speaking of #b and friends, what should <code>(string->number "#xffff" 2)</code> return?
+<div class="indented">
+
+<p id="r7rs">The r7rs compatibility code is in r7rs.scm. I used to include it here, but
+as r7rs grew, this section got too large. In general, all the conversion routines in
+r7rs are handled in s7 via generic functions, records are classes, byte-vectors are
+strings, and so on.
</p>
+</div>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<details>
+<summary class="indented">threads</summary>
+<div class="indented">
-<p>Here are some additional changes I'd make to s7 if I didn't care about compatibility with other Schemes:
+<p>s7 originally had multithreading support, but I removed it in August, 2011.
+It turned out to be less useful than I hoped,
+mainly because s7 threads shared the heap and therefore had to coordinate
+all cell allocations. It was faster and simpler to use multiple
+processes each running a separate s7 interpreter, rather than one s7
+running multiple s7 threads. In CLM, there was also contention for access
+to the output stream. In GUI-related situations,
+threads were not useful mainly because the GUI toolkits are not thread safe.
+Last but not least, the effort to make the non-threaded
+s7 faster messed up parts of the threaded version. Rather than
+waste a lot of time fixing this, I chose to flush multithreading.
+Here's a very simple example of using an s7 interpreter per thread:
</p>
-<pre>
- remove the exact/inexact distinction including #i and #e
- remove `#(...) support (quasiquoted vector constants)
- remove *-ci functions
- remove string<->list and vector<->list
- change string->symbol to symbol
- remove call-with-values and its friends
- remove char-ready?
- change eof-object? to eof? or end-of-input? or just omit it (you can use eq? #<eof>)
- use @ as the exponent marker if base > 10
- remove the "d", "f", "s", and "l" exponent markers (leaving "e" and "E")
-</pre>
-
-<p>and perhaps:
-</p>
+<pre class="indented">
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <pthread.h>
+#include "s7.h"
-<pre>
- remove even? and odd?
- remove the 4-way cxxxxr functions
- add file-exists?, directory?, and delete-file
- add a generic position function, and perhaps subsequence
- remove string-length, vector-length, and hash-table-size.
- remove list-ref|set!, string-ref|set!, vector-ref|set!, hash-table-ref|set!,
- set-car!|cdr!, and set-current-output|input|error-port.
-</pre>
+typedef struct {
+ s7_scheme *sc;
+ s7_pointer func;
+ pthread_t *thread;
+} thred;
+static void *run_thread(void *obj)
+{
+ thred *f = (thred *)obj;
+ return((void *)s7_call(f->sc, f->func, s7_nil(f->sc)));
+}
+static thred *make_thread(s7_function func)
+{
+ thred *f;
+ f = (thred *)malloc(sizeof(thred));
+ f->sc = s7_init();
+ f->func = s7_make_function(f->sc, "a-test", func, 0, 0, false, "a test");
+ f->thread = (pthread_t *)malloc(sizeof(pthread_t));
+ pthread_create(f->thread, NULL, run_thread, (void *)f);
+ return(f);
+}
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+static s7_pointer a_test(s7_scheme *sc, s7_pointer args)
+{
+ fprintf(stderr, "I am %p\n", sc);
+ /* do something time-consuming... */
+ return(args);
+}
-<p>Scheme needs a more elegant way to define functions that share a closure. The begin+define+let+set! shuffle used
-above is an embarrassment.
-Here's an idle thought:
-</p>
+int main(int argc, char **argv)
+{
+ thred *f1, *f2;
+ f1 = make_thread(a_test);
+ f2 = make_thread(a_test);
-<pre>
-(define f1 (let ((x 23))
- (lambda (a)
- (+ x a))))
-(define f2
- (with-environment (procedure-environment f1) ; import f1's closure ("x") into f2
- (lambda (b)
- (+ b (* 2 x)))))
+ pthread_join(*(f1->thread), NULL);
+ pthread_join(*(f2->thread), NULL);
+}
-> (+ (f1 1) (f2 1))
-71
+/* build s7 with -DWITH_THREADS, then
+ * gcc -o repl repl.c s7.o -g3 -Wl,-export-dynamic -lpthread -lm -I. -ldl
+ */
</pre>
+<p>Unfortunately, there's no way yet to
+free all the resources s7_init allocates (the heap, stack, etc).
+</p>
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+</div>
+</details>
+<div class="indented">
<p>"Life", a poem.
</p>
-<pre>
+<pre class="indented">
(+(*(+))(*)(+(+)(+)(*)))
(((((lambda () (lambda () (lambda () (lambda () 1))))))))
(+ (((lambda () values)) 1 2 3))
(map apply (list map) (list map) (list (list *)) '((((1 2)) ((3 4 5)))))
(do ((do do do)) (do do do))
+(*(*)(*) (+)(+) 1)
</pre>
-</blockquote>
-</small>
-
-</dd>
-<br>
-<br><br>
-
-
-<!--
-for r7rs: (?)
- (define (finite? n) (and (number? n) (not (nan? n)) (not (infinite? n))))
- (define vector-map map)
- (define vector-for-each for-each)
- (define string-map map)
- (define string-for-each for-each)
- (define list-copy copy)
- (define vector-copy copy)
--->
-
-
-
-<!-- -------------------------------------------------------------------------------- -->
-<dt>
-<A NAME="s7rundoc"></a>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0 cellpadding=8><tr><td bgcolor="#EEFDEE" valign="middle"><h4>the run macro</h4></td></tr></table>
-</td></tr></table>
-</dt>
-
-<dd><p>s7 is primarily aimed at computer music, CLM-based sound synthesis in particular.
-A CLM instrument is usually a do-loop running things like oscillators and envelopes
-for zillions of sound samples. These calculations do not involve recursion, or
-complex numbers, or fancy list processing, so it is not too hard to write an
-optimizer for them. In sndlib, that optimizer is called "run". It is a macro (in modern jargon, a JIT byte compiler)
-that can be wrapped around any piece of Scheme code that you want to speed up.
-If it can't optimize the code, it passes it to the s7 interpreter. If run is successful,
-you will normally get a speed up by a factor of 10 to 30. For CLM instruments,
-the result runs close to the speed of the equivalent compiled and optimized
-C code. Here are my timings for two instruments, bird and fm-violin, each running for 100 seconds.
-I've included sbcl times for comparison.
-</p>
-
-<pre>
- s7 interpreted s7+run C (-O2) sbcl
-bird 9.6 .7 .65 .65
-violin 21.6 1.44 1.28 1.28
-</pre>
-
-<p>
-The sbcl and C compiler cases are the same because
-CLM in sbcl uses a version of the run macro that translates the CL code to C, calls the C compiler
-on that, then loads it as a foreign function, so it is essentially the
-same as the straight C case. In s7, however, we're running interpreted; there is
-no separate compilation step. Another comparison: the fft benchmark from the Gabriel
-tests. In s7 interpreted, it runs 1000 1024 point FFTs in 53 seconds; with "run",
-the same takes 2 seconds. In Guile 1.9.5 after compilation, it takes 10 seconds.
-So, in general, s7 is not so slow as to be an annoyance.
-</p>
-
-<!--
-sbcl: (with-sound (:play nil :statistics t) (bird 0 100 440.0 10.0 0.5 '(0 0 1 1) '(0 0 1 1 2 1 3 0)))
- (with-sound (:play nil :statistics t) (fm-violin 0 100 440.0 .4))
-
-C: in sndlib configure make
- gcc time-bird.c -o time-bird -O2 -I. libsndlib.a -lasound -lgsl -lgslcblas
- time time-bird
-
-s7: use the sndlib example in s7.html
- gcc -o ex1 ex1.c s7.o -lm -I. -O2
- ex1
- (load "sndlib-ws.scm")
- (load "bird.scm")
- (load "v.scm")
-
-(with-sound (:play #f :statistics #t) (bird 0 100 440.0 10.0 0.5 '(0 0 1 1) '(0 0 1 1 2 1 3 0)))
-(with-sound (:play #f :statistics #t) (fm-violin 0 100 440.0 .4))
-
-
-fft.sch interpreted: 53, run: 2
-guile 1.9.5 after compilation: 10.5
--->
-
-
-<table border=0 vspace=8 width=30% cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<small>
-<blockquote>
-
-<p>I can't resist giving another example. Here's some vector arithmetic:
-</p>
-
-<pre>
-(let* ((size (* 128 1024))
- (v1 (make-vector size 0.0))
- (v2 (make-vector size 0.0))
- (sum 0.0))
- (<em class=red>run</em>
- (do ((i 0 (+ i 1)))
- ((= i size))
- (set! (v1 i) (- (random 2.0) 1.0))
- (set! (v2 i) (- (random 2.0) 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i size) sum)
- (set! sum (+ sum (* (v1 i) (v2 i)))))))
-</pre>
-
-<p>With run, this takes .092 seconds on my old machine; without run, it takes 1.94 seconds.
-</p>
+</div>
</blockquote>
-</small>
-
-</dd>
<br><br>
-</dl>
-<!-- -------------------------------------------------------------------------------- -->
-<A NAME="FFIexamples"></a>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h3>FFI examples</h3></td></tr></table>
-</td></tr></table>
+<div class="topheader" id="FFIexamples">FFI examples</div>
<p>s7 exists only to serve as an extension of some other application, so
it is primarily a foreign function interface. s7.h has lots of comments about the individual
@@ -4872,20 +6524,24 @@ functions. Here I'll collect some complete examples. s7.c depends on the follo
compile-time flags:
</p>
-<pre>
- HAVE_STDBOOL_H 1 if you have stdbool.h
- HAVE_PTHREADS 1 if you want multithreading support (requires pthreads, default is 0)
- WITH_GMP 1 if you want multiprecision arithmetic (requires gmp, mpfr, and mpc, default is 0)
- WITH_COMPLEX 1 if your compiler supports complex numbers
- HAVE_COMPLEX_TRIG 1 if your math library has complex versions of the trig functions
- WITH_PROFILING 1 if you want profiling support (default is 0)
- S7_DISABLE_DEPRECATED 1 if you want to make sure you're not using any deprecated s7 stuff (default is 0)
- HAVE_GETTIMEOFDAY 1 if you want timing info from the GC (default is 0)
- WITH_EXTRA_EXPONENT_MARKERS 1 if you want "d", "f", "l", and "s" in addition to "e" as exponent markers (default is 1)
+<pre class="indented">
+SIZEOF_VOID_P 8 (default) or 4.
+WITH_GMP 1 if you want multiprecision arithmetic (requires gmp, mpfr, and mpc, default is 0)
+HAVE_COMPLEX_NUMBERS 1 if your compiler supports complex numbers
+HAVE_COMPLEX_TRIG 1 if your math library has complex versions of the trig functions
+DISABLE_DEPRECATED 1 if you want to make sure you're not using any deprecated s7 stuff (default is 0)
+
+WITH_QUASIQUOTE_VECTOR 1 if you want to use the `#(...) junk (defualt is 0)
+WITH_IMMUTATBLE_UNQUOTE 1 if you want "unquote" omitted (default is 0)
+WITH_EXTRA_EXPONENT_MARKERS 1 if you want "d", "f", "l", and "s" in addition to "e" as exponent markers (default is 0)
+ if someone defends these exponent markers, ask him to read 1l11+11l1i
+WITH_SYSTEM_EXTRAS 1 if you want some additional OS-related functions built-in (default is 0)
+WITH_MAIN 1 if you want s7.c to include a main program section that runs a REPL.
+WITH_C_LOADER 1 if you want to be able to load shared object files with load.
</pre>
<p>See the comment at the start of s7.c for more information about these switches.
-s7.h defines the two main number types: s7_Int and s7_Double.
+s7.h defines the two main number types: s7_int and s7_double.
The examples that follow show:
</p>
@@ -4894,78 +6550,55 @@ The examples that follow show:
<li><a href="#defun">define a function with arguments and a returned value, and define a variable </a>
<li><a href="#defvar">call a Scheme function from C, and get/set Scheme variable values in C</a>
<li><a href="#juce">C++ and Juce</a>
-<li><a href="#sndlib">load sndlib using the XEN functions and macros</a>
-<li><a href="#pwstype">add a new Scheme type and a procedure-with-setter</a>
+<li><a href="#sndlib">load sndlib using the Xen functions and macros</a>
+<li><a href="#pwstype">add a new Scheme type and a procedure with a setter</a>
<li><a href="#functionportexample">redirect display output to a C procedure</a>
<li><a href="#extendop">extend a built-in operator ("+" in this case)</a>
<li><a href="#definestar1">C-side define* (s7_define_function_star)</a>
<li><a href="#definemacro1">C-side define-macro (s7_define_macro)</a>
+<li><a href="#definegeneric">define a generic function in C</a>
<li><a href="#signal">signal handling (C-C to break out of an infinite loop)</a>
<li><a href="#vector">direct multidimensional vector element access</a>
<li><a href="#notify">notification in C that a Scheme variable has been set!</a>
<li><a href="#namespace">Load C defined stuff into a separate namespace</a>
<li><a href="#Cerrors">Error handling in C</a>
-<li><a href="#closure">Closure defined in C</a>
<li><a href="#testhook">Hooks in C and Scheme</a>
-<li><a href="#cload">Load a C module dynamically</a>
+<li><a href="#dload">Load a C module dynamically</a>
<li><a href="#gmpex">gmp and friends</a>
-<li><a href="#gtkrepl">Gtk-based REPL</a>
-<li><a href="#gtkschemerepl">Gtk/Scheme-based REPL</a>
-<li><a href="#s7inathread">s7 running in a separate thread</a>
-<li><a href="#replrescue">begin_hook to the rescue!</a>
+<li><a href="#glistener">glistener.c</a>
+<li><a href="#gdb">gdb</a>
</ul>
-<br><br>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<p>
-<A NAME="repl"></a>
-First, a bare REPL:
-</p>
+<div class="header" id="repl"><h4>A simple listener</h4></div>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "s7.h"
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
-{
- /* all added functions have this form, args is a list,
- * s7_car(args) is the 1st arg, etc
- */
- exit(1);
- return(s7_nil(sc)); /* never executed, but makes the compiler happier */
-}
-
int main(int argc, char **argv)
{
s7_scheme *s7;
char buffer[512];
char response[1024];
- s7 = <em class=red>s7_init</em>(); /* initialize the interpreter */
- <em class=red>s7_define_function</em>(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program");
- /* add the function "exit" to the interpreter.
- * 0, 0, false -> no required args,
- * no optional args,
- * no "rest" arg
- */
- while (1) /* fire up a REPL */
+ s7 = <em class=red>s7_init</em>(); /* initialize the interpreter */
+ while (1) /* fire up a read-eval-print loop */
{
- fprintf(stdout, "\n> "); /* prompt for input */
+ fprintf(stdout, "\n> "); /* prompt for input */
fgets(buffer, 512, stdin);
if ((buffer[0] != '\n') ||
(strlen(buffer) > 1))
- {
+ { /* evaluate the input and print the result */
sprintf(response, "(write %s)", buffer);
- <em class=red>s7_eval_c_string</em>(s7, response); /* evaluate input and write the result */
+ <em class=red>s7_eval_c_string</em>(s7, response);
}
}
}
@@ -4973,35 +6606,46 @@ int main(int argc, char **argv)
/* make mus-config.h (it can be empty), then
*
* gcc -c s7.c -I.
- * gcc -o doc7 doc7.c s7.o -lm -I.
+ * gcc -o repl repl.c s7.o -lm -I. -ldl
*
* run it:
*
- * doc7
+ * repl
* > (+ 1 2)
- * 3
+ * <em class="gray">3</em>
* > (define (add1 x) (+ 1 x))
- * add1
+ * <em class="gray">add1</em>
* > (add1 2)
- * 3
+ * <em class="gray">3</em>
* > (exit)
+ *
+ * for long-term happiness in linux use:
+ * gcc -o repl repl.c s7.o -Wl,-export-dynamic -lm -I. -ldl
+ * freebsd:
+ * gcc -o repl repl.c s7.o -Wl,-export-dynamic -lm -I.
+ * osx:
+ * gcc -o repl repl.c s7.o -lm -I.
+ * openbsd:
+ * gcc -o repl repl.c s7.o -I. -ftrampolines -Wl,-export-dynamic -lm
*/
</pre>
-</td></tr></table>
-<br>
+</div>
+
+
<p>Since this reads stdin and writes stdout, it can be run as a Scheme subjob of emacs.
One (inconvenient) way to do this is to set the emacs variable scheme-program-name to
the name of the exectuable created above ("doc7"), then call the emacs function run-scheme:
M-x eval-expression in emacs, followed by (setq scheme-program-name "doc7"), then
M-x run-scheme, and you're talking to s7 in emacs. Of course, this connection can be
-customized indefinitely. See, for example, snd-inf.el in the Snd package.
+customized indefinitely. See, for example, inf-snd.el in the Snd package.
</p>
<p>To read stdin while working in a GUI-based program is trickier. In glib/gtk, you can use
something like this:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+
+<blockquote>
+<div class="indented">
<pre>
static gboolean read_stdin(GIOChannel *source, GIOCondition condition, gpointer data)
{
@@ -5018,232 +6662,458 @@ stdin_id = g_io_add_watch_full(channel, /* and call read_stdin above if
(GIOCondition)(G_IO_IN | G_IO_HUP | G_IO_ERR),
<em class=red>read_stdin</em>, NULL, NULL);
g_io_channel_unref(channel);
-</pre>
-</td></tr></table>
-
-<p>If we accidentally get into an infinite loop in our REPL, we have to exit the program.
-See <a href="#signal">signal handling</a> and <a href="#replrescue">begin_hook to the rescue!</a> below for two ways to fix this.
-</p>
-<br><br>
-
-
-
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+</pre></div>
+</blockquote>
-<A NAME="defun"></a>
-<p>Define a function with arguments and a returned value, and a variable:
+<details>
+<summary class="indented">repl with libtecla</summary>
+<p>Here's a version that uses libtecla for the line editor:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<blockquote>
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
-
+#include <libtecla.h>
#include "s7.h"
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
-{
- exit(1);
- return(s7_nil(sc));
-}
-
-static s7_pointer add1(s7_scheme *sc, s7_pointer args)
-{
- if (<em class=red>s7_is_integer</em>(s7_car(args)))
- return(<em class=red>s7_make_integer</em>(sc, 1 + <em class=red>s7_integer</em>(s7_car(args))));
- return(s7_wrong_type_arg_error(sc, "add1", 1, s7_car(args), "an integer"));
-}
-
int main(int argc, char **argv)
{
s7_scheme *s7;
- char buffer[512];
+ char *buffer;
char response[1024];
+ GetLine *gl; /* The tecla line editor */
- s7 = s7_init(); /* initialize the interpreter */
-
- s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program");
- s7_define_function(s7, "add1", add1, 1, 0, false, "(add1 int) adds 1 to int");
- <em class=red>s7_define_variable</em>(s7, "my-pi", <em class=red>s7_make_real</em>(s7, 3.14159265));
+ gl = new_GetLine(500, 5000);
+ s7 = s7_init();
- while (1) /* fire up a "repl" */
+ while (1)
{
- fprintf(stdout, "\n> "); /* prompt for input */
- fgets(buffer, 512, stdin);
+ buffer = gl_get_line(gl, "> ", NULL, 0);
if ((buffer[0] != '\n') ||
(strlen(buffer) > 1))
{
sprintf(response, "(write %s)", buffer);
- s7_eval_c_string(s7, response); /* evaluate input and write the result */
+ s7_eval_c_string(s7, response);
+ fprintf(stdout, "\n");
}
}
+ gl = del_GetLine(gl);
}
-/* doc7
- * > my-pi
- * 3.14159265
- * > (+ 1 (add1 1))
- * 3
- * > (exit)
+/*
+ * gcc -c s7.c -I. -O2 -g3
+ * gcc -o ex1 ex1.c s7.o -lm -I. -ltecla -ldl
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
+</blockquote>
+</details>
+<p>A repl (based on repl.scm) is built into s7. Include the compiler flag -DWITH_MAIN:
+</p>
+<pre class="indented">
+in Linux: gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -ldl -lm -Wl,-export-dynamic
+in *BSD: gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -lm -Wl,-export-dynamic
+in OSX: gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -lm
+</pre>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="defvar"></a>
-<p>Call a Scheme-defined function from C, and get/set Scheme variable values in C:
+<details>
+<summary class="indented">repl in C++</summary>
+<p>If you prefer C++, here's a C++ version of the listener, extracted from Rick Taube's
+Common Music package:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<blockquote>
+<div class="indented">
<pre>
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
+#include <iostream>
#include "s7.h"
-int main(int argc, char **argv)
+static s7_pointer main_quit(s7_scheme *sc, s7_pointer args);
+static bool is_balanced(std::string str);
+static bool is_not_white(std::string str);
+
+int main(int argc, const char* argv[])
{
- s7_scheme *s7;
- s7 = s7_init();
+ s7_scheme* s7 = s7_init();
+ s7_pointer val;
+ std::string str;
- s7_define_variable(s7, "an-integer", s7_make_integer(s7, 1));
- s7_eval_c_string(s7, "(define (add1 a) (+ a 1))");
-
- fprintf(stderr, "an-integer: %d\n",
- s7_integer(<em class=red>s7_name_to_value</em>(s7, "an-integer")));
+ try
+ {
+ while (std::cin)
+ {
+ std::cout << "\ns7> ";
+ str = "";
+ while (true)
+ {
+ std::string lin;
+ std::getline(std::cin, lin);
+ str = str + lin + "\n";
+ if (is_balanced(str))
+ break;
+ }
+ if (is_not_white(str))
+ {
+ val = s7_eval_c_string(s7, str.c_str());
+ std::cout << s7_object_to_c_string(s7, val);
+ }
+ }
+ }
+ catch(...)
+ {
+ }
+ std::cout << "Bye!\n";
+ return 0;
+}
- <em class=red>s7_symbol_set_value</em>(s7, <em class=red>s7_make_symbol</em>(s7, "an-integer"), s7_make_integer(s7, 32));
+static s7_pointer main_quit(s7_scheme *sc, s7_pointer args)
+{
+ throw 0;
+ return(s7_nil(sc));
+}
- fprintf(stderr, "now an-integer: %d\n",
- s7_integer(<em class=red>s7_name_to_value</em>(s7, "an-integer")));
+static bool is_balanced(std::string str)
+{
+ int parens = 0;
+ int quotes = 0;
+ unsigned i = 0;
+ while (i < str.size())
+ {
+ if (str[i] == ';')
+ {
+ for (i = i + 1; i < str.size(); i++)
+ {
+ if (str[i] == '\n')
+ break;
+ }
+ }
+ else if (str[i] == '"')
+ {
+ if (i == 0 || str[i - 1] != '\\')
+ {
+ quotes = 1;
+ for (i = i + 1; i < str.size(); i++)
+ {
+ if (str[i] == '"' && str[i - 1] != '\\')
+ {
+ quotes = 0;
+ break;
+ }
+ }
+ if (quotes)
+ return false;
+ }
+ }
+ else if (str[i] == '(')
+ parens++;
+ else if (str[i] == ')')
+ parens--;
+ i++;
+ }
+ return (parens == 0) && (quotes == 0);
+}
- fprintf(stderr, "(add1 2): %d\n",
- s7_integer(<em class=red>s7_call</em>(s7,
- s7_name_to_value(s7, "add1"),
- s7_cons(s7, s7_make_integer(s7, 2), s7_nil(s7)))));
+static bool is_not_white(std::string str)
+{
+ for (unsigned i = 0; (i < str.size() && str[i] != ';'); i++)
+ if (str[i] != ' ' && str[i] != '\n' && str[i] != '\t')
+ return true;
+ return false;
}
-/*
- * doc7
- * an-integer: 1
- * now an-integer: 32
- * (add1 2): 3
+/* g++ -I. -c repl.cpp
+ * g++ -o repl repl.o s7.o -ldl
*/
-</pre>
-</td></tr></table>
-<br><br>
-
-
-
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<A NAME="juce"></a>
-<p>C++ and Juce, from Rick Taube:
-</p>
-
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
-<pre>
-int main(int argc, const char* argv[])
-{
- initialiseJuce_NonGUI();
-
- s7_scheme *s7 = s7_init();
- if (!s7)
- {
- std::cout << "Can't start S7!\n";
- return -1;
- }
-
- s7_pointer val;
- std::string str;
- while (true)
- {
- std::cout << "\ns7> ";
- std::getline(std::cin, str);
- val = s7_eval_c_string(s7, str.c_str());
- std::cout << s7_object_to_c_string(s7, val);
- }
-
- free(s7);
- std::cout << "Bye!\n";
- return 0;
-}
-</pre>
-</td></tr></table>
-<br><br>
-
-
+</pre></div>
+</blockquote>
+</details>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="sndlib"></a>
-<p>Load sndlib using the XEN functions and macros into an s7 repl:
+<p id="beginhook">
+Common Lisp has something called "evalhook" that makes it possible
+to insert your own function into the eval loop. In s7, we have a "begin_hook" which sits at the opening of many begin blocks
+(implicit or explicit). begin_hook is a (C) function;
+if it sets its bool argument to true,
+s7 interrupts the current evaluation.
+Here is a version of the REPL in which begin_hook watches for C-g to interrupt
+some long computation:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<blockquote>
+<div class="indented">
<pre>
+/* terminal-based REPL,
+ * an expansion of the <a href="#repl">read-eval-print loop</a> program above.
+ * type C-g to interrupt an evaluation.
+ */
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
-#include <unistd.h>
-
-/* assume we've configured and built sndlib, so it has created a mus-config.h file */
+#include <termios.h>
+#include <signal.h>
-#include "mus-config.h"
#include "s7.h"
-#include "xen.h"
-#include "clm.h"
-#include "clm2xen.h"
-/* we need to redirect clm's mus_error calls to s7_error */
-
-static void mus_error_to_s7(int type, char *msg)
-{
- s7_error(s7, /* s7 is declared in xen.h */
- s7_make_symbol(s7, "mus-error"),
- s7_cons(s7, s7_make_string(s7, msg), s7_nil(s7)));
-}
+static struct termios save_buf, buf;
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
+static void sigcatch(int n)
{
- exit(1);
- return(s7_nil(sc));
+ /* put things back the way they were */
+ tcsetattr(fileno(stdin), TCSAFLUSH, &save_buf);
+ exit(0);
}
-/* the next functions are needed for either with-sound or many standard instruments, like fm-violin */
-/* (these are in the xen-style FFI) */
+static char buffer[512];
+static int type_ahead_point = 0;
-static XEN g_file_exists_p(XEN name)
+static void <em class=red>watch_for_c_g</em>(s7_scheme *sc, bool *all_done)
{
- #define H_file_exists_p "(file-exists? filename): #t if the file exists"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, "file-exists?", "a string");
- return(C_TO_XEN_BOOLEAN(mus_file_probe(XEN_TO_C_STRING(name))));
-}
+ char c;
+ /* watch for C-g without blocking, save other chars as type-ahead */
+ tcsetattr(fileno(stdin), TCSAFLUSH, &buf);
+ if (read(fileno(stdin), &c, 1) == 1)
+ {
+ if (c == 7) /* C-g */
+ {
+ *all_done = true;
+ type_ahead_point = 0;
+ }
+ else buffer[type_ahead_point++] = c;
+ }
+ tcsetattr(fileno(stdin), TCSAFLUSH, &save_buf);
+}
+
+int main(int argc, char **argv)
+{
+ s7_scheme *s7;
+ bool use_begin_hook;
+
+ use_begin_hook = (tcgetattr(fileno(stdin), &save_buf) >= 0);
+ if (use_begin_hook)
+ {
+ buf = save_buf;
+ buf.c_lflag &= ~ICANON;
+ buf.c_cc[VMIN] = 0;
+ buf.c_cc[VTIME] = 0;
+
+ signal(SIGINT, sigcatch);
+ signal(SIGQUIT, sigcatch);
+ signal(SIGTERM, sigcatch);
+ }
+ s7 = s7_init();
+
+ if (argc == 2)
+ {
+ fprintf(stderr, "load %s\n", argv[1]);
+ s7_load(s7, argv[1]);
+ }
+ else
+ {
+ char response[1024];
+ while (1)
+ {
+ fprintf(stdout, "\n> ");
+ fgets((char *)(buffer + type_ahead_point), 512 - type_ahead_point, stdin);
+ type_ahead_point = 0;
+
+ if ((buffer[0] != '\n') ||
+ (strlen(buffer) > 1))
+ {
+ sprintf(response, "(write %s)", buffer);
+
+ if (use_begin_hook)
+ <em class=red>s7_set_begin_hook</em>(s7, watch_for_c_g);
+ s7_eval_c_string(s7, response);
+ if (use_begin_hook)
+ <em class=red>s7_set_begin_hook</em>(s7, NULL);
+ }
+ }
+ }
+ if (use_begin_hook)
+ tcsetattr(fileno(stdin), TCSAFLUSH, &save_buf);
+}
+</pre></div>
+</blockquote>
+
-XEN_NARGIFY_1(g_file_exists_p_w, g_file_exists_p)
-static XEN g_delete_file(XEN name)
+
+<div class="header" id="defun"><h4>Define a function with arguments and a returned value, and a variable</h4></div>
+
+
+<div class="indented">
+<pre>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "s7.h"
+
+static s7_pointer add1(s7_scheme *sc, s7_pointer args)
+{
+ /* all added functions have this form, args is a list,
+ * s7_car(args) is the first arg, etc
+ */
+ if (<em class=red>s7_is_integer</em>(s7_car(args)))
+ return(<em class=red>s7_make_integer</em>(sc, 1 + <em class=red>s7_integer</em>(s7_car(args))));
+ return(s7_wrong_type_arg_error(sc, "add1", 1, s7_car(args), "an integer"));
+}
+
+int main(int argc, char **argv)
+{
+ s7_scheme *s7;
+ char buffer[512];
+ char response[1024];
+
+ s7 = s7_init();
+
+ s7_define_function(s7, "add1", add1, 1, 0, false, "(add1 int) adds 1 to int");
+ /* add the function "add1" to the interpreter.
+ * 1, 0, false -> one required arg,
+ * no optional args,
+ * no "rest" arg
+ */
+ <em class=red>s7_define_variable</em>(s7, "my-pi", <em class=red>s7_make_real</em>(s7, 3.14159265));
+
+ while (1) /* fire up a "repl" */
+ {
+ fprintf(stdout, "\n> "); /* prompt for input */
+ fgets(buffer, 512, stdin);
+ if ((buffer[0] != '\n') ||
+ (strlen(buffer) > 1))
+ {
+ sprintf(response, "(write %s)", buffer);
+ s7_eval_c_string(s7, response); /* evaluate input and write the result */
+ }
+ }
+}
+
+/* doc7
+ * > my-pi
+ * <em class="gray">3.14159265</em>
+ * > (+ 1 (add1 1))
+ * <em class="gray">3</em>
+ * > (exit)
+ */
+</pre></div>
+
+
+
+
+<div class="header" id="defvar"><h4>Call a Scheme-defined function from C, and get/set Scheme variable values in C</h4></div>
+
+
+<div class="indented">
+<pre>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "s7.h"
+
+int main(int argc, char **argv)
{
- #define H_delete_file "(delete-file filename): deletes the file"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, "delete-file", "a string");
- return(C_TO_XEN_BOOLEAN(unlink(XEN_TO_C_STRING(name))));
+ s7_scheme *s7;
+ s7 = s7_init();
+
+ s7_define_variable(s7, "an-integer", s7_make_integer(s7, 1));
+ s7_eval_c_string(s7, "(define (add1 a) (+ a 1))");
+
+ fprintf(stderr, "an-integer: %lld\n",
+ s7_integer(<em class=red>s7_name_to_value</em>(s7, "an-integer")));
+
+ <em class=red>s7_symbol_set_value</em>(s7, <em class=red>s7_make_symbol</em>(s7, "an-integer"), s7_make_integer(s7, 32));
+
+ fprintf(stderr, "now an-integer: %lld\n",
+ s7_integer(<em class=red>s7_name_to_value</em>(s7, "an-integer")));
+
+ fprintf(stderr, "(add1 2): %lld\n",
+ s7_integer(<em class=red>s7_call</em>(s7,
+ s7_name_to_value(s7, "add1"),
+ s7_cons(s7, s7_make_integer(s7, 2), s7_nil(s7)))));
}
-XEN_NARGIFY_1(g_delete_file_w, g_delete_file)
+/*
+ * doc7
+ * an-integer: 1
+ * now an-integer: 32
+ * (add1 2): 3
+ */
+</pre></div>
+
+
+
+
+
+<div class="header" id="juce"><h4>C++ and Juce, from Rick Taube</h4></div>
+
+
+<div class="indented">
+<pre>
+int main(int argc, const char* argv[])
+{
+ initialiseJuce_NonGUI();
+
+ s7_scheme *s7 = s7_init();
+ if (!s7)
+ {
+ std::cout << "Can't start S7!\n";
+ return -1;
+ }
+
+ s7_pointer val;
+ std::string str;
+ while (true)
+ {
+ std::cout << "\ns7> ";
+ std::getline(std::cin, str);
+ val = s7_eval_c_string(s7, str.c_str());
+ std::cout << s7_object_to_c_string(s7, val);
+ }
+
+ free(s7);
+ std::cout << "Bye!\n";
+ return 0;
+}
+</pre></div>
+
+
+
+
+
+<div class="header" id="sndlib"><h4>Load sndlib into an s7 repl</h4></div>
+
+
+<div class="indented">
+<pre>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <unistd.h>
+
+/* assume we've configured and built sndlib, so it has created a mus-config.h file.
+ * also assume we've built s7 with WITH_SYSTEM_EXTRAS set, so we have file-exists? and delete-file
+ */
+
+#include "mus-config.h"
+#include "s7.h"
+#include "xen.h"
+#include "clm.h"
+#include "clm2xen.h"
+
+/* we need to redirect clm's mus_error calls to s7_error */
+
+static void mus_error_to_s7(int type, char *msg)
+{
+ s7_error(s7, /* s7 is declared in xen.h, defined in xen.c */
+ s7_make_symbol(s7, "mus-error"),
+ s7_cons(s7, s7_make_string(s7, msg), s7_nil(s7)));
+}
int main(int argc, char **argv)
{
@@ -5251,15 +7121,11 @@ int main(int argc, char **argv)
char response[1024];
s7 = s7_init(); /* initialize the interpreter */
- xen_initialize(); /* initialize the xen stuff (hooks and the xen s7 FFI used by sndlib) */
+ s7_xen_initialize(s7); /* initialize the xen stuff (hooks and the xen s7 FFI used by sndlib) */
Init_sndlib(); /* initialize sndlib with all the functions linked into s7 */
mus_error_set_handler(mus_error_to_s7); /* catch low-level errors and pass them to s7-error */
- XEN_DEFINE_PROCEDURE("file-exists?", g_file_exists_p_w, 1, 0, 0, H_file_exists_p);
- XEN_DEFINE_PROCEDURE("delete-file", g_delete_file_w, 1, 0, 0, H_delete_file);
- s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program");
-
while (1) /* fire up a "repl" */
{
fprintf(stdout, "\n> "); /* prompt for input */
@@ -5274,30 +7140,98 @@ int main(int argc, char **argv)
}
}
-/* gcc -o doc7 doc7.c -lm -I. /usr/local/lib/libsndlib.a -lasound
+/* gcc -o doc7 doc7.c -lm -I. /usr/local/lib/libsndlib.a -lasound -ldl
*
* (load "sndlib-ws.scm")
* (with-sound () (outa 10 .1))
* (load "v.scm")
* (with-sound () (fm-violin 0 .1 440 .1))
*
- * you might also need -lgsl -lgslcblas
+ * you might also need -lgsl -lgslcblas -lfftw3
*/
</pre>
-</td></tr></table>
-<br><br>
+</div>
+
+<p>If you built libsndlib.so, it is possible to use it directly in the s7 repl:
+</p>
+<pre>
+repl ; this is a bare s7 running repl.scm via -DWITH_MAIN=1
+loading libc_s7.so
+> (load "/home/bil/test/sndlib/libsndlib.so" (inlet 'init_func 's7_init_sndlib))
+#t ; s7_init_sndlib ties all the sndlib functions and variables into s7
+> (load "sndlib-ws.scm")
+tmpnam
+> (set! *clm-player* (lambda (file) (system (format #f "sndplay ~A" file))))
+> (load "v.scm")
+fm-violin
+> (with-sound (:play #t) (fm-violin 0 1 440 .1))
+"test.snd"
+</pre>
+
+<p>You can use autoload to load libsndlib when needed:
+</p>
+
+<pre class="indented">
+(define (find-library name)
+ (if (or (file-exists? name)
+ (char=? (name 0) #\/))
+ name
+ (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (path)
+ (let ((new-name (string-append path "/" name)))
+ (if (file-exists? new-name)
+ (return new-name))))
+ *load-path*)
+ (let ((libs (getenv "LD_LIBRARY_PATH")) ; colon separated directory names
+ (start 0))
+ (do ((colon (char-position #\: libs) (char-position #\: libs start)))
+ ((or (not colon)
+ (let ((new-name (string-append (substring libs start colon) "/" name)))
+ (and (file-exists? new-name)
+ (return new-name)))))
+ (set! start (+ colon 1))))
+ name))))
+
+(<em class=red>autoload</em> 'clm
+ (lambda (e)
+ (load (find-library "libsndlib.so") (inlet '(init_func . s7_init_sndlib)))
+ (set! *features* (cons 'clm *features*))
+ (with-let (rootlet) (define clm #t))
+ (load "sndlib-ws.scm")
+ (set! *clm-player* (lambda (file) (system (format #f "sndplay ~A" file))))))
+</pre>
+
+<p>and use the repl's vt100 stuff to (for example) post the current begin time
+as a note list computes:
+</p>
+
+<pre class="indented">
+(define (clm-notehook . args)
+ ;; assume second arg is begin time (first is instrument name)
+ (when (and (pair? args)
+ (pair? (cdr args))
+ (number? (cadr args)))
+ (with-let (sublet (*repl* 'repl-let) :begin-time (cadr args))
+ (let ((coords (cursor-coords))
+ (col (floor (/ last-col 2))))
+ (let ((str (number->string begin-time)))
+ (format *stderr* "~C[~D;~DH" #\escape prompt-row col)
+ (format *stderr* "~C[K~A" #\escape (if (> (length str) col) (substring str 0 (- col 1)) str)))
+ (format *stderr* "~C[~D;~DH" #\escape (cdr coords) (car coords))))))
+
+(set! *clm-notehook* clm-notehook)
+</pre>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="pwstype"></a>
-<p>Add a new Scheme type and procedure-with-setters:
-</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="header" id="pwstype"><h4>Add a new Scheme type and a procedure with a setter</h4></div>
+
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -5305,12 +7239,6 @@ int main(int argc, char **argv)
#include "s7.h"
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
-{
- exit(1);
- return(s7_nil(sc));
-}
-
/* define *listener-prompt* in scheme, add two accessors for C get/set */
static const char *listener_prompt(s7_scheme *sc)
@@ -5327,7 +7255,7 @@ static void set_listener_prompt(s7_scheme *sc, const char *new_prompt)
/* since the data field is an s7 object, we'll need to mark it to protect it from the GC */
typedef struct {
- s7_Double x;
+ s7_double x;
s7_pointer data;
} dax;
@@ -5368,7 +7296,7 @@ static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
o = (dax *)malloc(sizeof(dax));
o->x = s7_real(s7_car(args));
if (s7_cdr(args) != s7_nil(sc))
- o->data = s7_car(s7_cdr(args));
+ o->data = s7_cadr(args);
else o->data = s7_nil(sc);
return(<em class=red>s7_make_object</em>(sc, dax_type_tag, (void *)o));
}
@@ -5391,8 +7319,8 @@ static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
{
dax *o;
o = (dax *)s7_object_value(s7_car(args));
- o->x = s7_real(s7_car(s7_cdr(args)));
- return(s7_car(s7_cdr(args)));
+ o->x = s7_real(s7_cadr(args));
+ return(s7_cadr(args));
}
static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
@@ -5406,7 +7334,7 @@ static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
{
dax *o;
o = (dax *)s7_object_value(s7_car(args));
- o->data = s7_car(s7_cdr(args));
+ o->data = s7_cadr(args);
return(o->data);
}
@@ -5418,7 +7346,6 @@ int main(int argc, char **argv)
s7 = s7_init();
- s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program");
s7_define_variable(s7, "*listener-prompt*", s7_make_string(s7, ">"));
dax_type_tag = <em class=red>s7_new_type</em>("dax", print_dax, free_dax, equal_dax, mark_dax, NULL, NULL);
@@ -5426,10 +7353,10 @@ int main(int argc, char **argv)
s7_define_function(s7, "dax?", is_dax, 1, 0, false, "(dax? anything) returns #t if its argument is a dax object");
s7_define_variable(s7, "dax-x",
- <em class=red>s7_make_procedure_with_setter</em>(s7, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field"));
+ <em class=red>s7_dilambda</em>(s7, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field"));
s7_define_variable(s7, "dax-data",
- <em class=red>s7_make_procedure_with_setter</em>(s7, "dax-data", dax_data, 1, 0, set_dax_data, 2, 0, "dax data field"));
+ <em class=red>s7_dilambda</em>(s7, "dax-data", dax_data, 1, 0, set_dax_data, 2, 0, "dax data field"));
while (1)
{
@@ -5446,40 +7373,35 @@ int main(int argc, char **argv)
/*
* > *listener-prompt*
- * ">"
+ * <em class="gray">">"</em>
* > (set! *listener-prompt* ":")
- * ":"
+ * <em class="gray">":"</em>
* : (define obj (make-dax 1.0 (list 1 2 3)))
- * obj
+ * <em class="gray">obj</em>
* : obj
- * #<dax 1.000 (1 2 3)>
+ * <em class="gray">#<dax 1.000 (1 2 3)></em>
* : (dax-x obj)
- * 1.0
+ * <em class="gray">1.0</em>
* : (dax-data obj)
- * (1 2 3)
+ * <em class="gray">(1 2 3)</em>
* : (set! (dax-x obj) 123.0)
- * 123.0
+ * <em class="gray">123.0</em>
* : obj
- * #<dax 123.000 (1 2 3)>
+ * <em class="gray">#<dax 123.000 (1 2 3)></em>
* : (dax? obj)
- * #t
+ * <em class="gray">#t</em>
* : (exit)
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="functionportexample"></a>
-<p>Redirect output (and input) to a C procedure:
-</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="header" id="functionportexample"><h4>Redirect output (and input) to a C procedure</h4></div>
+
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -5487,14 +7409,14 @@ int main(int argc, char **argv)
#include "s7.h"
-static void my_print(s7_scheme *sc, char c, s7_pointer port)
+static void my_print(s7_scheme *sc, unsigned char c, s7_pointer port)
{
fprintf(stderr, "[%c] ", c);
}
static s7_pointer my_read(s7_scheme *sc, s7_read_t peek, s7_pointer port)
{
- return(<em class=red>s7_make_character</em>(s7, fgetc(stdin)));
+ return(<em class=red>s7_make_character</em>(sc, fgetc(stdin)));
}
int main(int argc, char **argv)
@@ -5523,32 +7445,30 @@ int main(int argc, char **argv)
/*
* > (+ 1 2)
- * [3]
+ * <em class="gray">[3]</em>
* > (display "hiho")
- * [h] [i] [h] [o] [#] [<] [u] [n] [s] [p] [e] [c] [i] [f] [i] [e] [d] [>]
+ * <em class="gray">[h] [i] [h] [o] [#] [<] [u] [n] [s] [p] [e] [c] [i] [f] [i] [e] [d] [>] </em>
* > (define (add1 x) (+ 1 x))
- * [a] [d] [d] [1]
+ * <em class="gray">[a] [d] [d] [1] </em>
* > (add1 123)
- * [1] [2] [4]
+ * <em class="gray">[1] [2] [4] </em>
* > (read-char io-port)
* a ; here I typed "a" in the shell
- * [#] [\] [a]
+ * <em class="gray">[#] [\] [a] </em>
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
+
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="extendop"></a>
-<p>Extend a built-in operator ("+" in this case):
+<div class="header" id="extendop"><h4>Extend a built-in operator ("+" in this case)</h4></div>
+
+<p>There are several ways to do this. In the first example, we save the original function,
+and replace it with ours, calling the original whenever possible:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -5567,7 +7487,6 @@ static s7_pointer our_add(s7_scheme *sc, s7_pointer args)
if ((s7_is_pair(args)) &&
(s7_is_string(s7_car(args))))
return(<em class=red>s7_apply_function</em>(sc, old_string_append, args));
-
return(s7_apply_function(sc, old_add, args));
}
@@ -5576,7 +7495,6 @@ int main(int argc, char **argv)
s7_scheme *s7;
char buffer[512];
char response[1024];
-
s7 = s7_init();
/* get built-in + and string-append */
@@ -5599,38 +7517,38 @@ int main(int argc, char **argv)
}
}
-/*
- * > (+ 1 2)
- * 3
+/* > (+ 1 2)
+ * <em class="gray">3</em>
* > (+ "hi" "ho")
- * "hiho"
+ * <em class="gray">"hiho"</em>
*/
-</pre>
-</td></tr></table>
-<br><br>
-
-
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<A NAME="definestar1"></a>
-<p>C-side define* (s7_define_function_star):
+<p>In the next example, we use the method (inlet) machinery:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
+#include <math.h>
#include "s7.h"
-static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+static s7_pointer our_abs(s7_scheme *sc, s7_pointer args)
{
- /* (define* (plus (red 32) blue) (+ (* 2 red) blue)) */
- return(s7_make_integer(sc, 2 * s7_integer(s7_car(args)) + s7_integer(s7_car(s7_cdr(args)))));
+ s7_pointer x;
+ x = s7_car(args);
+ if (!s7_is_number(x))
+ {
+ s7_pointer method;
+ method = <em class=red>s7_method</em>(sc, x, s7_make_symbol(sc, "abs"));
+ if (method == s7_undefined(sc)) /* no method found, so raise an error */
+ s7_wrong_type_arg_error(sc, "abs", 1, x, "a real");
+ return(s7_apply_function(sc, method, args)); /* else apply the method to the args */
+ }
+ return(s7_make_real(sc, (s7_double)fabs(s7_number_to_real(sc, x))));
}
int main(int argc, char **argv)
@@ -5640,7 +7558,7 @@ int main(int argc, char **argv)
char response[1024];
s7 = s7_init();
- <em class=red>s7_define_function_star</em>(s7, "plus", plus, "(red 32) blue", "an example of define* from C");
+ s7_define_function(s7, "our-abs", our_abs, 1, 0, false, "abs replacement");
while (1)
{
@@ -5655,33 +7573,78 @@ int main(int argc, char **argv)
}
}
-/*
- * > (plus 2 3)
- * 7
- * > (plus :blue 3)
- * 67
- * > (plus :blue 1 :red 4)
- * 9
+/* > (our-abs -1)
+ * <em class="gray">1.0</em>
+ * > (our-abs (openlet (inlet 'value -3.0 'abs (lambda (x) (abs (x 'value))))))
+ * <em class="gray">3.0</em>
+ */
+
+</pre>
+</div>
+
+
+
+<div class="header" id="definestar1"><h4>C-side define* (s7_define_function_star)</h4></div>
+
+
+<div class="indented">
+<pre>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "s7.h"
+
+static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+{
+ /* (define* (plus (red 32) blue) (+ (* 2 red) blue)) */
+ return(s7_make_integer(sc, 2 * s7_integer(s7_car(args)) + s7_integer(s7_cadr(args))));
+}
+
+int main(int argc, char **argv)
+{
+ s7_scheme *s7;
+ char buffer[512];
+ char response[1024];
+
+ s7 = s7_init();
+ <em class=red>s7_define_function_star</em>(s7, "plus", plus, "(red 32) blue", "an example of define* from C");
+
+ while (1)
+ {
+ fprintf(stdout, "\n> ");
+ fgets(buffer, 512, stdin);
+ if ((buffer[0] != '\n') ||
+ (strlen(buffer) > 1))
+ {
+ sprintf(response, "(write %s)", buffer);
+ s7_eval_c_string(s7, response);
+ }
+ }
+}
+
+/*
+ * > (plus 2 3)
+ * <em class="gray">7</em>
+ * > (plus :blue 3)
+ * <em class="gray">67</em>
+ * > (plus :blue 1 :red 4)
+ * <em class="gray">9</em>
* > (plus 2 :blue 3)
- * 7
+ * <em class="gray">7</em>
* > (plus :blue 3 :red 1)
- * 5
+ * <em class="gray">5</em>
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="definemacro1"></a>
-<p>C-side define-macro (s7_define_macro):
-</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="header" id="definemacro1"><h4>C-side define-macro (s7_define_macro)</h4></div>
+
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -5694,10 +7657,8 @@ static s7_pointer plus(s7_scheme *sc, s7_pointer args)
/* (define-macro (plus a b) `(+ ,a ,b)) */
s7_pointer a, b;
a = s7_car(args);
- b = s7_car(s7_cdr(args));
- return(s7_cons(sc, s7_make_symbol(sc, "+"), /* we are forming the list `(+ ,a ,b) */
- s7_cons(sc, a,
- s7_cons(sc, b, s7_nil(sc)))));
+ b = s7_cadr(args);
+ return(s7_list(sc, 3, s7_make_symbol(sc, "+"), a, b));
}
int main(int argc, char **argv)
@@ -5724,24 +7685,76 @@ int main(int argc, char **argv)
/*
* > (plus 2 3)
- * 5
+ * <em class="gray">5</em>
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="header" id="definegeneric"><h4>define a generic function in C</h4></div>
-<A NAME="signal"></a>
-<p>Signal handling (C-C to break out of an infinite loop), and s7_make_continuation
-to pick up where we were interrupted:
+<p>In scheme, a function becomes generic simply by <code>(apply ((car args) 'func) args)</code>.
+To accomplish the same thing in C, we use s7_method and s7_apply_function:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="indented">
+<pre>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "s7.h"
+
+static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+{
+ #define plus_help "(plus obj ...) applies obj's plus method to obj and any trailing arguments."
+ s7_pointer obj, method;
+ obj = s7_car(args);
+ method = <em class=red>s7_method</em>(sc, obj, s7_make_symbol(sc, "plus"));
+ if (s7_is_procedure(method))
+ return(<em class=red>s7_apply_function</em>(sc, method, args));
+ return(s7_f(sc));
+}
+
+int main(int argc, char **argv)
+{
+ s7_scheme *s7;
+ s7 = s7_init();
+ s7_define_function(s7, "plus", plus, 1, 0, true, plus_help);
+ while (1)
+ {
+ char buffer[512];
+ char response[1024];
+ fprintf(stdout, "\n> ");
+ fgets(buffer, 512, stdin);
+ if ((buffer[0] != '\n') ||
+ (strlen(buffer) > 1))
+ {
+ sprintf(response, "(write %s)", buffer);
+ s7_eval_c_string(s7, response);
+ }
+ }
+}
+
+/* gcc -c s7.c -I.
+ * gcc -o ex15 ex15.c s7.o -I. -lm -ldl
+ *
+ * > (plus 1 2)
+ * <em class="gray">#f</em>
+ * > (define obj (openlet (inlet 'plus (lambda args (apply + 1 (cdr args))))))
+ * <em class="gray">obj</em>
+ * > (plus obj 2 3)
+ * <em class="gray">6</em>
+ */
+</pre>
+</div>
+
+
+
+<div class="header" id="signal"><h4>Signal handling and continuations</h4></div>
+
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -5761,16 +7774,9 @@ static void handle_sigint(int ignored)
s7_quit(s7); /* get out of the eval loop if possible */
}
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
-{
- /* this function is really needed if we are trapping C-C! */
- exit(1);
- return(s7_f(sc));
-}
-
static s7_pointer our_sleep(s7_scheme *sc, s7_pointer args)
{
- /* slow down out infinite loop for demo purposes */
+ /* slow down our infinite loop for demo purposes */
sleep(1);
return(s7_f(sc));
}
@@ -5781,7 +7787,6 @@ int main(int argc, char **argv)
char response[1024];
s7 = s7_init();
- s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits");
s7_define_function(s7, "sleep", our_sleep, 0, 0, false, "(sleep) sleeps");
s7_define_variable(s7, "*interrupt*", s7_f(s7));
/* Scheme variable *interrupt* holds the continuation at the point of the interrupt */
@@ -5819,21 +7824,16 @@ int main(int argc, char **argv)
* > (+ 1 2)
* 3
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="vector"></a>
-<p>Multidimensional vector element access:
-</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="header" id="vector"><h4>Multidimensional vector element access</h4></div>
+
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -5851,12 +7851,12 @@ static s7_pointer multivector_ref(s7_scheme *sc, s7_pointer vector, int indices,
if (ndims == indices)
{
va_list ap;
- s7_Int index = 0;
+ s7_int index = 0;
va_start(ap, indices);
if (ndims == 1)
{
- index = va_arg(ap, s7_Int);
+ index = va_arg(ap, s7_int);
va_end(ap);
return(s7_vector_ref(sc, vector, index));
}
@@ -5864,7 +7864,7 @@ static s7_pointer multivector_ref(s7_scheme *sc, s7_pointer vector, int indices,
{
int i;
s7_pointer *elements;
- s7_Int *offsets, *dimensions;
+ s7_int *offsets, *dimensions;
elements = <em class=red>s7_vector_elements</em>(vector);
dimensions = <em class=red>s7_vector_dimensions</em>(vector);
@@ -5912,20 +7912,20 @@ int main(int argc, char **argv)
/* vect[0,0,0]: 0, vect[1,1,1]: 32
*/
</pre>
-</td></tr></table>
-<br><br>
+</div>
+<p>Much later... I decided to add s7_vector_ref_n and s7_vector_set_n to s7.
+</p>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="notify"></a>
-<p>Notification from Scheme that a given Scheme variable has been set.
-</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+
+
+<div class="header" id="notify"><h4>Notification from Scheme that a given Scheme variable has been set</h4></div>
+
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -5933,34 +7933,23 @@ int main(int argc, char **argv)
#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
-
static s7_pointer scheme_set_notification(s7_scheme *sc, s7_pointer args)
{
/* this function is called when the Scheme variable is set! */
fprintf(stderr, "%s set to %s\n",
s7_object_to_c_string(sc, s7_car(args)),
- s7_object_to_c_string(sc, s7_car(s7_cdr(args))));
- return(s7_car(s7_cdr(args)));
+ s7_object_to_c_string(sc, s7_cadr(args)));
+ return(s7_cadr(args));
}
int main(int argc, char **argv)
{
s7_scheme *s7;
s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
s7_define_function(s7, "notify-C", scheme_set_notification, 2, 0, false, "called if notified-var is set!");
s7_define_variable(s7, "notified-var", s7_make_integer(s7, 0));
- <em class=red>s7_symbol_set_access</em>(s7, /* set symbol-access of notified-var to (list #f notify-C #f) */
- s7_make_symbol(s7, "notified-var"),
- s7_cons(s7,
- s7_f(s7),
- s7_cons(s7,
- s7_name_to_value(s7, "notify-C"),
- s7_cons(s7,
- s7_f(s7),
- s7_nil(s7)))));
+ <em class=red>s7_symbol_set_access</em>(s7, s7_make_symbol(s7, "notified-var"), s7_name_to_value(s7, "notify-C"));
if (argc == 2)
{
@@ -5987,26 +7976,21 @@ int main(int argc, char **argv)
}
/* > notified-var
- * 0
+ * <em class="gray">0</em>
* > (set! notified-var 32)
- * notified-var set to 32
- * 32
+ * <em class="gray">notified-var set to 32</em>
+ * <em class="gray">32</em>
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="namespace"></a>
-<p>Load C defined stuff into a separate namespace.
-</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="header" id="namespace"><h4>Load C defined stuff into a separate namespace</h4></div>
+
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -6014,8 +7998,6 @@ int main(int argc, char **argv)
#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
-
static s7_pointer func1(s7_scheme *sc, s7_pointer args)
{
return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));
@@ -6027,13 +8009,12 @@ int main(int argc, char **argv)
s7_pointer new_env;
s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
/* "func1" and "var1" will be placed in an anonymous environment,
* accessible from Scheme via the global variable "lib-exports"
*/
- new_env = <em class=red>s7_augment_environment</em>(s7, s7_cons(s7, s7_current_environment(s7), s7_nil(s7)), s7_nil(s7));
+ new_env = <em class=red>s7_inlet</em>(s7, s7_curlet(s7), s7_nil(s7));
/* make a private environment for func1 and var1 below (this is our "namespace") */
s7_gc_protect(s7, new_env);
@@ -6045,7 +8026,7 @@ int main(int argc, char **argv)
/* those two symbols are now defined in the new environment */
/* add "lib-exports" to the global environment */
- s7_define_variable(s7, "lib-exports", s7_car(new_env));
+ s7_define_variable(s7, "lib-exports", <em class=red>s7_let_to_list</em>(s7, new_env));
if (argc == 2)
{
@@ -6072,50 +8053,45 @@ int main(int argc, char **argv)
}
/* > func1
- * ;func1: unbound variable, line 1
+ * <em class="gray">;func1: unbound variable, line 1</em>
* > lib-exports
- * ((var1 . 32) (func1 . func1))
+ * <em class="gray">((var1 . 32) (func1 . func1))</em>
* ;; so lib-exports has the C-defined names and values
* ;; we can use these directly:
*
- * > (define lib-env (apply <em class=red>augment-environment</em> (current-environment) lib-exports))
- * lib-env
- * > (<em class=red>with-environment</em> lib-env (func1 var1))
- * 33
+ * > (define lib-env (apply <em class=red>sublet</em> (curlet) lib-exports))
+ * <em class="gray">lib-env</em>
+ * > (<em class=red>with-let</em> lib-env (func1 var1))
+ * <em class="gray">33</em>
*
* ;; or rename them to prepend "lib:"
- * > (define lib-env (apply augment-environment
- (current-environment)
+ * > (define lib-env (apply sublet
+ (curlet)
(map (lambda (binding)
(cons (string->symbol
(string-append "lib:" (symbol->string (car binding))))
(cdr binding)))
lib-exports)))
- * lib-env
- * > (with-environment lib-env (lib:func1 lib:var1))
- * 33
+ * <em class="gray">lib-env</em>
+ * > (with-let lib-env (lib:func1 lib:var1))
+ * <em class="gray">33</em>
*
* ;;; now for convenience, place "func1" in the global environment under the name "func2"
* > (define func2 (cdadr lib-exports))
- * func2
+ * <em class="gray">func2</em>
* > (func2 1)
- * 2
+ * <em class="gray">2</em>
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="Cerrors"></a>
-<p>Handle scheme errors in C.
-</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="header" id="Cerrors"><h4>Handle scheme errors in C</h4></div>
+
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -6123,17 +8099,12 @@ int main(int argc, char **argv)
#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
-
static s7_pointer error_handler(s7_scheme *sc, s7_pointer args)
{
- /* put <<>> around the string so it's obvious who is producing what */
-
- fprintf(stdout, "<<%s>>", s7_string(s7_car(args)));
- return(s7_make_symbol(sc, "our-error"));
+ fprintf(stdout, "error: %s\n", s7_string(s7_car(args)));
+ return(s7_f(sc));
}
-
int main(int argc, char **argv)
{
s7_scheme *s7;
@@ -6142,15 +8113,14 @@ int main(int argc, char **argv)
bool with_error_hook = false;
s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
s7_define_function(s7, "error-handler", error_handler, 1, 0, false, "our error handler");
if (with_error_hook)
s7_eval_c_string(s7, "(set! (hook-functions *error-hook*) \n\
- (list (lambda (tag args) \n\
+ (list (lambda (hook) \n\
(error-handler \n\
- (apply format #f (car args) (cdr args))))))");
-
+ (apply format #f (hook 'data))) \n\
+ (set! (hook 'result) 'our-error))))");
while (1)
{
fprintf(stdout, "\n> ");
@@ -6191,15 +8161,15 @@ int main(int argc, char **argv)
/*
* gcc -c s7.c -I. -g3
- * gcc -o ex3 ex3.c s7.o -lm -I.
+ * gcc -o ex3 ex3.c s7.o -lm -I. -ldl
*
* if with_error_hook is false,
*
* > (+ 1 2)
- * {3}
+ * <em class="gray">{3}</em>
* > (+ 1 #\c)
- * {wrong-type-arg}[
- * ;+ argument 2, #\c, is character but should be a number, line 1
+ * <em class="gray">{wrong-type-arg}[</em>
+ * <em class="gray">;+ argument 2, #\c, is character but should be a number, line 1</em>
* ]
*
* so s7 by default prepends ";" to the error message, and appends "\n",
@@ -6209,147 +8179,22 @@ int main(int argc, char **argv)
* if with_error_hook is true,
*
* > (+ 1 2)
- * {3}
+ * <em class="gray">{3}</em>
* > (+ 1 #\c)
- * <<+ argument 2, #\c, is character but should be a number>>{our-error}
+ * <em class="gray">error: + argument 2, #\c, is character but should be a number</em>
+ * <em class="gray">{our-error}</em>
*
* so now the *error-hook* code handles both the error reporting and
* the value returned ('our-error in this case).
*/
-</pre>
-</td></tr></table>
-<br><br>
-
-
-
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<A NAME="closure"></a>
-<p>We often have hooks or callback lists in Scheme, and would like to place a C-defined
-s7 function on such a list. If the C-side function does not have
-any state, we can just add its name to the list, but if it is effectively a closure, we have a problem. C itself does not
-provide closures, so the standard two-step is to include a void* pointer with the
-C function in a struct, then when that is called, pass the pointer to the function
-by hand. This obviously does not work if we want that function to be a member of
-a normal Scheme list of functions. So in the next example, we define a closure
-in C using s7_make_closure.
-</p>
-
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
-<pre>
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "s7.h"
-
-static s7_pointer closure_func(s7_scheme *sc, s7_pointer args)
-{
- /* closure_func is the function portion of our closure. It assumes its
- * environment has an integer named "x". The function also takes one argument,
- * an integer we'll call it "y".
- */
- return(s7_make_integer(sc, /* return (+ y x) */
- s7_integer(s7_car(args)) + /* this is y */
- s7_integer(s7_name_to_value(sc, "x"))));
-}
-
-static s7_pointer define_closure(s7_scheme *sc, const char *name, s7_pointer func, s7_pointer x_value)
-{
- /* make_closure creates a new closure with x_value as the local value of x,
- * and func as the function. It defines this in Scheme as "name".
- *
- * s7_make_closure's arguments are the closure code as (<args> <code>), and
- * the closure's environment. For the first part, we'll use '((y) (f y)),
- * and for the second, we'll augment the current environment with
- * ((x . x_value) (f . func)).
- */
- s7_define(sc,
- s7_global_environment(sc),
- s7_make_symbol(sc, name),
- <em class=red>s7_make_closure</em>(sc,
- s7_cons(sc,
- s7_cons(sc, /* closure arg list: '(y) */
- s7_make_symbol(sc, "y"),
- s7_nil(sc)),
- s7_cons(sc, /* closure code: (f y) */
- s7_cons(sc,
- s7_make_symbol(sc, "f"),
- s7_cons(sc,
- s7_make_symbol(sc, "y"),
- s7_nil(sc))),
- s7_nil(sc))),
- <em class=red>s7_augment_environment</em>(sc,
- s7_current_environment(sc),
- s7_cons(sc,
- s7_cons(sc, /* the local binding for "x" */
- s7_make_symbol(sc, "x"),
- <em class=red>x_value</em>),
- s7_cons(sc, /* and "f" */
- s7_cons(sc,
- s7_make_symbol(sc, "f"),
- <em class=red>func</em>),
- s7_nil(sc))))));
- return(s7_unspecified(sc));
-}
-
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
-
-int main(int argc, char **argv)
-{
- char buffer[512];
- char response[1024];
- s7_pointer c_func;
- s7_scheme *s7;
-
- s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
-
- c_func = s7_make_function(s7, "#<closure function>", closure_func, 1, 0, false, "function used by define_closure");
-
- define_closure(s7, "closure-1", c_func, s7_make_integer(s7, 32)); /* (let ((x 32)) (lambda (y) (+ y x))) */
- define_closure(s7, "closure-2", c_func, s7_make_integer(s7, 123)); /* (let ((x 123)) (lambda (y) (+ y x))) */
-
- while (1)
- {
- fprintf(stdout, "\n> ");
- fgets(buffer, 512, stdin);
- if ((buffer[0] != '\n') ||
- (strlen(buffer) > 1))
- {
- sprintf(response, "(write %s)", buffer);
- s7_eval_c_string(s7, response);
- }
- }
-}
-
-/*
- * > (closure-1 3)
- * 35
- * > (closure-2 3)
- * 126
- * > (procedure-source closure-1)
- * (lambda (y) (f y))
- * > (procedure-environment closure-1)
- * (((f . #<closure function>) (x . 32)) #(() () () () () ((caar . caar)) () () ...))
- */
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="header" id="testhook"><h4>C and Scheme hooks</h4></div>
-<A NAME="testhook"></a>
-<p>C and Scheme hook handling.
-</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -6357,11 +8202,9 @@ int main(int argc, char **argv)
#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
-
static s7_pointer my_hook_function(s7_scheme *sc, s7_pointer args)
{
- fprintf(stderr, "arg is %s\n", s7_object_to_c_string(sc, s7_car(args)));
+ fprintf(stderr, "a is %s\n", s7_object_to_c_string(sc, s7_symbol_local_value(sc, s7_make_symbol(sc, "a"), s7_car(args))));
return(s7_car(args));
}
@@ -6373,17 +8216,16 @@ int main(int argc, char **argv)
s7_pointer test_hook;
s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
- /* define test_hook in C, test-hook in Scheme */
- test_hook = <em class=red>s7_make_hook</em>(s7, 2, 0, false, "test-hook's functions take 2 arguments");
+ /* define test_hook in C, test-hook in Scheme, arguments are named a and b */
+ test_hook = <em class=red>s7_eval_c_string</em>(s7, "(make-hook 'a 'b)");
s7_define_constant(s7, "test-hook", test_hook);
/* add my_hook_function to the test_hook function list */
- <em class=red>s7_hook_set_functions</em>(test_hook,
+ <em class=red>s7_hook_set_functions</em>(s7, test_hook,
s7_cons(s7,
- s7_make_function(s7, "my-hook-function", my_hook_function, 2, 0, false, "my hook-function"),
- s7_hook_functions(test_hook)));
+ s7_make_function(s7, "my-hook-function", my_hook_function, 1, 0, false, "my hook-function"),
+ s7_hook_functions(s7, test_hook)));
while (1)
{
fprintf(stdout, "\n> ");
@@ -6400,39 +8242,31 @@ int main(int argc, char **argv)
/*
* > test-hook
- * #<hook>
- *
+ * <em class="gray">#<lambda (hook)></em>
* > (hook-functions test-hook)
- * (my-hook-function)
- *
- * > (set! (hook-functions test-hook)
- * (cons (lambda (a b) (format #t "a is ~S~%" a))
- * (hook-functions test-hook)))
- * (#<closure> my-hook-function)
- *
+ * <em class="gray">(my-hook-function)</em>
* > (test-hook 1 2)
- * a is 1
- * arg is 1
- * 1
+ * <em class="gray">a is 1</em>
+ * <em class="gray">#<unspecified></em>
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="cload"></a>
+
+<div class="header" id="dload"><h4>Load a shared library</h4></div>
+
<p>We can use dlopen to load a shared library, and dlsym to initialize
that library in our main program. The tricky part is to conjure up the right
compiler and loader flags.
-First we define a module that defines a new s7 function, add-1:
+First we define a module that defines a new s7 function, add-1 that we'll tie
+into s7 explicitly, and another
+function that we'll try to call by waving a wand.
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -6440,6 +8274,12 @@ First we define a module that defines a new s7 function, add-1:
#include "s7.h"
+double a_function(double an_arg);
+double a_function(double an_arg)
+{
+ return(an_arg + 1.0);
+}
+
static s7_pointer add_1(s7_scheme *sc, s7_pointer args)
{
return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));
@@ -6448,46 +8288,64 @@ static s7_pointer add_1(s7_scheme *sc, s7_pointer args)
void init_ex(s7_scheme *sc);
void init_ex(s7_scheme *sc) /* this needs to be globally accessible (not "static") */
{
+ /* tell s7 about add-1, but leave a_function hidden */
s7_define_function(sc, "add-1", add_1, 1, 0, false, "(add-1 x) adds 1 to x");
}
-</pre>
-</td></tr></table>
+</pre></div>
+
<p>And here is our main program:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "s7.h"
+#include <dlfcn.h>
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
+static void *library = NULL;
+
+static s7_pointer try(s7_scheme *sc, s7_pointer args)
+{
+ /* try tries to call an arbitrary function in the shared library */
+ void *func;
+ func = <em class=red>dlsym</em>(library, s7_string(s7_car(args)));
+ if (func)
+ {
+ /* we'll assume double f(double) */
+ typedef double (*dl_func)(double arg);
+ return(s7_make_real(sc, ((dl_func)<em class=red>func</em>)(s7_real(s7_cadr(args)))));
+ }
+ return(s7_error(sc, s7_make_symbol(sc, "can't find function"),
+ s7_list(sc, 2, s7_make_string(sc, "loader error: ~S"),
+ s7_make_string(sc, dlerror()))));
+}
-#include <dlfcn.h>
static s7_pointer cload(s7_scheme *sc, s7_pointer args)
{
- #define CLOAD_HELP "(cload so-file-name init-func-name) loads the module and calls the init function"
- void *library;
- library = <em class=red>dlopen</em>(s7_string(s7_car(args)), RTLD_LAZY);
+ /* cload loads a shared library */
+ #define CLOAD_HELP "(cload so-file-name) loads the module"
+ library = dlopen(s7_string(s7_car(args)), RTLD_LAZY);
if (library)
{
+ /* call our init func to define add-1 in s7 */
void *init_func;
- init_func = <em class=red>dlsym</em>(library, s7_string(s7_car(s7_cdr(args))));
+ init_func = <em class=red>dlsym</em>(library, s7_string(s7_cadr(args)));
if (init_func)
{
typedef void *(*dl_func)(s7_scheme *sc);
((dl_func)<em class=red>init_func</em>)(sc); /* call the initialization function (init_ex above) */
return(s7_t(sc));
}
- else fprintf(stderr, "loader error: %s\n", <em class=red>dlerror</em>());
}
- else fprintf(stderr, "loader error: %s\n", <em class=red>dlerror</em>());
- return(s7_f(sc));
+ return(s7_error(sc, s7_make_symbol(sc, "load-error"),
+ s7_list(sc, 2, s7_make_string(sc, "loader error: ~S"),
+ s7_make_string(sc, dlerror()))));
}
int main(int argc, char **argv)
@@ -6497,8 +8355,11 @@ int main(int argc, char **argv)
s7_scheme *s7;
s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
+
s7_define_function(s7, "cload", cload, 2, 0, false, CLOAD_HELP);
+ s7_define_function(s7, "try", try, 2, 0, false,
+ "(try name num) tries to call name in the shared library with the argument num.");
+
while (1)
{
fprintf(stdout, "\n> ");
@@ -6520,6 +8381,7 @@ int main(int argc, char **argv)
* gcc ex3a.o -shared -o ex3a.so
* gcc -c s7.c -I. -fPIC -shared
* gcc -o ex3 ex3.c s7.o -lm -ldl -I. -Wl,-export-dynamic
+ * # omit -ldl in freeBSD, openBSD might want -ftrampolines
*
* in Mac OSX:
* gcc -c ex3a.c
@@ -6529,28 +8391,43 @@ int main(int argc, char **argv)
*
* and run it:
* ex3
- * > (cload "/home/bil/snd-12/ex3a.so" "init_ex")
- * #t
+ * > (cload "/home/bil/snd-16/ex3a.so" "init_ex")
+ * <em class="gray">#t</em>
* > (add-1 2)
- * 3
+ * <em class="gray">3</em>
+ * > (try "a_function" 2.5)
+ * <em class="gray">3.5</em>
*/
+</pre></div>
+
+<p>All of this is just boring boilerplate, so with a little support from s7,
+we can write a script to do the entire linkage. The s7 side is an extension
+to "load" that loads a shared object file if its extension is "so", and
+runs an initialization function whose name is defined in the load
+environment (the optional second argument to load). An example of the scheme side is cload.scm,
+included in the s7 tarball. It defines a function that can be
+called:
+</p>
+
+<pre class="indented">
+(c-define '(double j0 (double)) "m" "math.h")
</pre>
-</td></tr></table>
-<br><br>
+
+<p>This links the s7 function m:j0 to the math library
+function j0. See <a href="#cload">cload.scm</a> for more details.
+</p>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
+<div class="header" id="gmpex"><h4>Bignums in C</h4></div>
-<A NAME="gmpex"></a>
<p>Bignum support depends on gmp, mpfr, and mpc. In this example, we define "add-1" which adds
1 to any kind of number. The s7_big_* functions return the underlying gmp/mpfr/mpc pointer,
so we have to copy that into a new number before adding.
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
@@ -6562,8 +8439,6 @@ so we have to copy that into a new number before adding.
#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
-
static s7_pointer big_add_1(s7_scheme *sc, s7_pointer args)
{
/* add 1 to either a normal number or a bignum */
@@ -6632,7 +8507,6 @@ int main(int argc, char **argv)
char response[1024];
s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
s7_define_function(s7, "add-1", big_add_1, 1, 0, false, "(add-1 num) adds 1 to num");
while (1)
@@ -6650,1073 +8524,982 @@ int main(int argc, char **argv)
/*
* gcc -DWITH_GMP=1 -c s7.c -I. -O2 -g3
- * gcc -DWITH_GMP=1 -o ex2 ex2.c s7.o -I. -O2 -lm -lgmp -lmpfr -lmpc
+ * gcc -DWITH_GMP=1 -o ex2 ex2.c s7.o -I. -O2 -lm -ldl -lgmp -lmpfr -lmpc
*
* ex2
* > (add-1 1)
- * 2
+ * <em class="gray">2</em>
* > (add-1 2/3)
- * 5/3
+ * <em class="gray">5/3</em>
* > (add-1 1.4)
- * 2.4
+ * <em class="gray">2.4</em>
* > (add-1 1.5+i)
- * 2.5+1i
+ * <em class="gray">2.5+1i</em>
* > (add-1 (bignum "3"))
- * 4 ; this is the bignum 4
+ * <em class="gray">4</em> ; this is the bignum 4
* > (add-1 (bignum "3/4"))
- * 7/4
+ * <em class="gray">7/4</em>
* > (add-1 (bignum "1.4"))
- * 2.399999999999999911182158029987476766109E0
+ * <em class="gray">2.399999999999999911182158029987476766109E0</em>
* > (add-1 (bignum "1.5+i"))
- * 2.500E0+1.000E0i
+ * <em class="gray">2.500E0+1.000E0i</em>
*/
-</pre>
-</td></tr></table>
-<br><br>
+</pre></div>
+
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="gtkrepl"></A>
-<p>In this example, we use Gtk to make a window with a scrolled text widget, running s7
-in a read-eval-print loop. I've tried to make this as short as possible; see Snd for
-a much more elaborate REPL. From s7's point of view, the only tricky part involves
-catching errors.
+<div class="header" id="glistener"><h4>glistener.c</h4></div>
+
+<p>glistener.c is a gtk-based repl. It is not specific to s7:
+Snd uses it as its Forth and Ruby listener as well as for s7.
+Here's a short example:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="indented">
<pre>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
+#include <stdbool.h>
-/* use Gtk to post a text widget as a REPL.
- */
#include <gtk/gtk.h>
-#if HAVE_GTK_3
- #include <gdk/gdk.h>
- #define Return_Key GDK_KEY_Return
-#else
- #include <gdk/gdkkeysyms.h>
- #define Return_Key GDK_Return
-#endif
-
#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
-
-#define S7_PROMPT "s7> "
-#define S7_PROMPT_LENGTH 4
+#include "glistener.h"
-static GtkWidget* repl; /* the REPL text widget */
-static GtkTextBuffer *repl_buf; /* its text buffer */
-static GtkTextTag *prompt_not_editable = NULL; /* a tag to make sure the prompt can't be erased */
+static s7_scheme *s7;
-static gint quit_repl(GtkWidget *w, GdkEvent *event, gpointer context)
-{
- /* called when we click the 'x' window decoration */
- exit(0);
-}
+static gint quit_repl(GtkWidget *w, GdkEvent *event, gpointer context) {exit(0);}
-static void evaluate_expression(s7_scheme *sc, char *expression)
+static void evaluator(glistener *g, const char *text)
{
- /* evaluate expression, display result, catching and displaying any errors */
- if ((expression) &&
- (*expression))
+ /* this sends "text" to s7 for evaluation, then displays the result */
+ int gc_loc;
+ s7_pointer old_port, result;
+ const char *errmsg = NULL;
+ char *msg = NULL;
+
+ old_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
+ gc_loc = s7_gc_protect(s7, old_port);
+
+ result = s7_eval_c_string(s7, text);
+ errmsg = s7_get_output_string(s7, s7_current_error_port(s7));
+ if ((errmsg) && (*errmsg))
{
- if ((strlen(expression) > 1) ||
- (expression[0] != '\n'))
- {
- const char *errmsg;
- int gc_loc = -1;
- s7_pointer old_port, result;
- GtkTextIter pos;
-
- /* open a port to catch error info */
- old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
- if (old_port != s7_nil(sc))
- gc_loc = s7_gc_protect(sc, old_port);
-
- result = s7_eval_c_string(sc, expression);
-
- errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
- /* if error, display it, else display result of evaluation */
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
-
- if ((errmsg) && (*errmsg))
- gtk_text_buffer_insert(repl_buf, &pos, errmsg, strlen(errmsg));
- else
- {
- char *result_as_string;
- result_as_string = s7_object_to_c_string(sc, result);
- if (result_as_string)
- {
- gtk_text_buffer_insert(repl_buf, &pos, "\n", 1);
- gtk_text_buffer_insert(repl_buf, &pos, result_as_string, strlen(result_as_string));
- free(result_as_string);
- }
- }
-
- s7_close_output_port(sc, s7_current_error_port(sc));
- s7_set_current_error_port(sc, old_port);
- if (gc_loc != -1)
- s7_gc_unprotect_at(sc, gc_loc);
- }
- g_free(expression);
+ msg = (char *)calloc(strlen(errmsg) + 1, sizeof(char));
+ strcpy(msg, errmsg);
}
+
+ s7_close_output_port(s7, s7_current_error_port(s7));
+ s7_set_current_error_port(s7, old_port);
+ s7_gc_unprotect_at(s7, gc_loc);
+
+ glistener_append_text(g, "\n");
+ if (msg) /* some error occurred during evaluation */
+ glistener_append_text(g, msg);
+ else
+ { /* evaluation produced an s7 object which we need to display */
+ msg = s7_object_to_c_string(s7, result);
+ glistener_append_text(g, msg);
+ }
+ if (msg) free(msg);
+ glistener_append_prompt(g); /* prompt for more input */
}
-static char *get_current_expression(void)
+static void listener_init(glistener *g, GtkWidget *w)
{
- /* find the enclosing expression and return it. This could be a lot smarter, but
- * for the current example, I'll just look back to the previous prompt, then
- * forward for the next prompt or the buffer end.
+ /* this is the glistener initialization function. "w" above is the new text-view widget,
+ * "g" is the new glistener pointer, passed to any function that wants to talk to this
+ * listener.
*/
- GtkTextIter pos, previous, next, temp;
- GtkTextMark *m;
-
- m = gtk_text_buffer_get_insert(repl_buf);
- gtk_text_buffer_get_iter_at_mark(repl_buf, &pos, m);
+ unsigned char prompt[4] = {0xce, 0xbb, '>', '\0'}; /* lambda as prompt */
+ GtkTextBuffer *buffer;
+
+ buffer = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
+ glistener_set_font(g, pango_font_description_from_string("Monospace 10"));
+
+ /* our prompt will be a red lambda */
+ glistener_set_prompt_tag(g, gtk_text_buffer_create_tag(buffer, "glistener_prompt_tag",
+ "weight", PANGO_WEIGHT_BOLD,
+ "foreground", "red",
+ NULL));
+ glistener_set_prompt(g, prompt);
+}
- if (gtk_text_iter_backward_search(&pos, S7_PROMPT, 0, &temp, &previous, NULL))
- {
- /* previous now marks the end of the previous prompt */
- if (!gtk_text_iter_forward_search(&pos, S7_PROMPT, 0, &next, &temp, NULL))
- {
- gtk_text_buffer_get_end_iter(repl_buf, &next);
- /* next now marks the end of the buffer, so there's no complication */
- return(gtk_text_buffer_get_text(repl_buf, &previous, &next, true));
- }
- /* here next marks the start of the next prompt, but that probably includes
- * the result printout from an earlier evaluation. s7_eval_c_string evaluates
- * all the expressions in its string, returning the value of the last one,
- * but we want the first. We'll backup two '\n'.
- */
- gtk_text_iter_backward_search(&next, "\n", 0, &pos, &temp, NULL);
- gtk_text_iter_backward_search(&pos, "\n", 0, &next, &temp, NULL);
- return(gtk_text_buffer_get_text(repl_buf, &previous, &next, true));
- }
+static const char *helper(glistener *g, const char *text)
+{
+ /* this function is called whenever the listener thinks help is needed.
+ * Any string it returns is posted in the listener statusbar.
+ */
+ s7_pointer sym;
+ sym = s7_symbol_table_find_name(s7, text);
+ if (sym)
+ return(s7_help(s7, sym));
+ glistener_clear_status(g);
return(NULL);
}
-static gboolean repl_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+static void completer(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
{
- /* called when we type anything in the text widget.
- * 'data' is our s7 interpreter.
+ /* this function is called when <tab> is typed after a partial symbol name.
+ * "symbol_func" above should be called on each member of the symbol-table, passing it
+ * the symbol name (as a string) and the data passed as "completer's" third argument.
+ * If symbol_func returns true, it is done, so the loop through the symbol-table can stop.
*/
- guint key;
- key = event->keyval;
- if (key == Return_Key)
- {
- GtkTextIter pos;
- /* get enclosing expression, evaluate it, display result (or error), prompt for next */
- evaluate_expression((s7_scheme *)data, get_current_expression());
-
- /* prompt for next expression */
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
- gtk_text_buffer_insert_with_tags(repl_buf, &pos,
- "\n" S7_PROMPT, 1 + S7_PROMPT_LENGTH, prompt_not_editable, NULL);
-
- /* make sure the stuff we added is visible */
- gtk_text_buffer_place_cursor(repl_buf, &pos);
- gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(repl), gtk_text_buffer_get_insert(repl_buf));
-
- /* tell Gtk that we already sent the '\n' */
- g_signal_stop_emission((gpointer)w,
- g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
- }
- return(false);
+ s7_for_each_symbol_name(s7, symbol_func, data);
}
int main(int argc, char **argv)
{
- s7_scheme *s7;
- GtkWidget *shell, *scrolled_window;
- GtkTextIter pos;
+ GtkWidget *shell, *frame;
+ glistener *g;
s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
- /* make a window with a scrolled text widget */
gtk_init(&argc, &argv);
shell = gtk_window_new(GTK_WINDOW_TOPLEVEL);
g_signal_connect(G_OBJECT(shell), "delete_event", G_CALLBACK(quit_repl), NULL);
- scrolled_window = gtk_scrolled_window_new(NULL, NULL);
- gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(scrolled_window),
- GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
- gtk_container_add(GTK_CONTAINER(shell), scrolled_window);
+ frame = gtk_frame_new(NULL);
+ gtk_frame_set_shadow_type(GTK_FRAME(frame), GTK_SHADOW_ETCHED_IN);
+ gtk_widget_show(frame);
- repl = gtk_text_view_new();
- repl_buf = gtk_text_buffer_new(NULL);
- gtk_container_add(GTK_CONTAINER(scrolled_window), repl);
+ gtk_container_add(GTK_CONTAINER(shell), frame);
- gtk_text_view_set_buffer(GTK_TEXT_VIEW(repl), repl_buf);
- gtk_text_view_set_editable(GTK_TEXT_VIEW(repl), true);
- gtk_text_view_set_wrap_mode(GTK_TEXT_VIEW(repl), GTK_WRAP_NONE);
- gtk_text_view_set_cursor_visible(GTK_TEXT_VIEW(repl), true);
- gtk_text_view_set_left_margin(GTK_TEXT_VIEW(repl), 4);
+ /* make a new listener */
+ g = glistener_new(frame, listener_init);
+ glistener_set_evaluator(g, evaluator);
+ glistener_set_helper(g, helper);
+ glistener_set_completer(g, completer);
- /* whenever a key is pressed, call repl_key_press */
- gtk_widget_set_events(repl, GDK_ALL_EVENTS_MASK);
- g_signal_connect(G_OBJECT(repl), "key_press_event", G_CALLBACK(repl_key_press), (void *)s7);
-
- gtk_widget_show(repl);
- gtk_widget_show(scrolled_window);
gtk_widget_show(shell);
-
- /* start with a boldface '>' prompt that can't be stepped on */
- prompt_not_editable = gtk_text_buffer_create_tag(repl_buf, "prompt_not_editable",
- "editable", false,
- "weight", PANGO_WEIGHT_BOLD,
- NULL);
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
- gtk_text_buffer_insert_with_tags(repl_buf, &pos,
- S7_PROMPT, S7_PROMPT_LENGTH, prompt_not_editable, NULL);
-
- /* make the initial window size reasonable */
gdk_window_resize(gtk_widget_get_window(shell), 400, 200);
gtk_main();
}
-/*
- * gcc -c s7.c -I.
- * gcc -o listener listener.c s7.o -lm -I. <insert all the gtk flags and libraries here>
+/* in gtk-2: gcc gcall.c -o gcall s7.o glistener.o `pkg-config --libs gtk+-2.0 --cflags` -lm -ldl
+ * in gtk-3: gcc gcall.c -o gcall s7.o glistener.o `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl
*/
-
</pre>
-</td></tr></table>
-<br><br>
+<div class="listener">
+<pre>
+<em class=redb>λ></em> (define λ lambda)
+<em class="gray">λ</em>
+<em class=redb>λ></em> ((λ (a b) (+ a b)) 1 2)
+<em class="gray">3</em>
+<em class=redb>λ></em>
+</pre>
+</div>
+<br>
+<p>The five or six functions supplied by the caller (evaluator, helper,
+completer, checker, colorizer, keyer) all have defaults, so you don't have to supply
+anything but an evaluator. The default evaluator just prints "?" and prompts
+for more input. See glistener.h for the full API and an earnest attempt
+at helpful documentation.
+</p>
+
+<p>A multi-listener test program is the Snd file tools/gcall.c which
+is used by tools/gtest.scm for regression testing. One way to name unicode characters
+is: <code>(define-constant |lambda| #u8(#xce #xbb))</code>. This can be embedded
+in an ordinary s7 string with any string operation: <code>(string-append |lambda| "ambda")</code>
+which returns "λambda". (string-length will still return the number of bytes; to get
+the number of characters in a case like this, use g_utf8_strlen).
+So, to set the prompt to be a red lambda and the font to be "Nimbus mono 10" from Scheme,
+assuming we have the usual Scheme-to-C linkages (see snd-glistener.c):
+</p>
+
+<pre class="indented">
+(set! (listener-prompt) (byte-vector #xce #xbb (char->integer #\>) (char->integer #\space)))
+(set! (listener-font) "Nimbus mono 10")
+(listener-set-prompt-tag *listener* ; ideally this too would be a setter
+ (gtk_text_buffer_create_tag
+ (GTK_TEXT_BUFFER (gtk_text_view_get_buffer (GTK_TEXT_VIEW (listener-text-widget *listener*))))
+ "" (list "weight" PANGO_WEIGHT_BOLD "foreground" "red")))
+</pre>
+
+<p>In Snd, all the gtk code is in the *gtk* environment, so we need to use:
+</p>
+<pre class="indented">
+(listener-set-prompt-tag *listener*
+ (with-let (sublet *gtk* 'textw (listener-text-widget *listener*)) ; use *gtk*
+ (gtk_text_buffer_create_tag
+ (GTK_TEXT_BUFFER (gtk_text_view_get_buffer (GTK_TEXT_VIEW textw)))
+ "" (list "weight" PANGO_WEIGHT_BOLD "foreground" "red"))))
+</pre>
+</div>
+
+
+<div class="header" id="gdb"><h4>gdb</h4></div>
+
+<p>It is possible to make a mistake while writing C code.
+I switched from Common Lisp to Scheme a long time ago
+partly because it was so painful to debug FFI troubles in Common Lisp, and I
+chose Guile at that time partly because I thought gdb would have native support
+for it. As far as I know it is still impossible to debug CL FFI troubles, 20 years later!
+And in gdb Python has muscled Guile aside. Anyway, say you have hit a segfault
+and find yourself staring at a stackful of opaque pointers. Print statements are your
+friend, of course, and at the gdb command level, the main one in this context is
+s7_object_to_c_string. Here are some commands (intended for your .gdbinit file)
+that can speed up the process. They assume the s7_scheme pointer is named "sc".
+(These are now included in the gdbinit file in the s7 tarball).
+</p>
+
+<pre class="indented">
+define s7print
+print s7_object_to_c_string(sc, $arg0)
+end
+document s7print
+interpret the argument as an s7 value and display it
+end
+# the current expression is sc->cur_code
+# the current environment is sc->envir
+# the error environment is sc->owlet
+# so for example, to see the current local variables, s7p sc->envir
+
+define s7eval
+print s7_object_to_c_string(sc, s7_eval_c_string(sc, $arg0))
+end
+document s7eval
+eval the argument (a string)
+end
+
+define s7stack
+print s7_object_to_c_string(sc, s7_stacktrace(sc))
+end
+document s7stack
+display the current stack
+end
+
+define s7value
+print s7_object_to_c_string(sc, s7_name_to_value(sc, $arg0))
+end
+document s7value
+print the value of the variable passed by its print name: s7v "*features*"
+end
+</pre>
+
+<p>gdbinit also has s7cell to decode every field of an s7_pointer, and two backtrace
+decoders: s7bt and s7btfull (heh heh). The bt replacements print the gdb backtrace info,
+replacing bare pointer numbers with their s7 value, wherever possible:
+</p>
+
+<pre class="indented">
+#1 0x000000000042104e in find_symbol_unchecked (sc=0x97edf0, symbol=<b>vars</b>) at s7.c:6677
+ x = <b>(inlet 'f import-lambda-definition-2)</b>
+ __FUNCTION__ = "find_symbol_unchecked"
+#2 0x00000000006e3424 in eval (sc=0x97edf0, first_op=9) at s7.c:63673
+ _x_ = <b>import-lambda-definition-2</b>
+ _slot_ = <b>'form import-lambda-definition-2</b>
+ _sym_ = <b>env</b>
+ _val_ = <b>import-lambda-definition-2</b>
+ args = <b>(vars)</b>
+ p = <b>(env)</b>
+ func = <b>lint-walk</b>
+ e = <b>(inlet 'name import-lambda-definition-2 'form import-lambda-definition-2)</b>
+ code = <b>(lint-walk name f vars)</b>
+ __FUNCTION__ = "eval"
+</pre>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<A NAME="gtkschemerepl"></A>
-
-<p>In the same vein, we can use libxm's Gtk/s7 bindings to make the REPL in Scheme.
-Here is the same code, but now using libxm; first the C side, called gtkex.c:
-</p>
+<br><br>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
-<pre>
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <mus-config.h>
-#include "xen.h"
-void Init_libxg(void);
+<div class="topheader" id="s7examples">s7 examples</div>
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
+<p>The s7 tarball includes several scheme files including s7test.scm,
+lint.scm, cload.scm, write.scm, mockery.scm, and stuff.scm.
+s7test.scm is a regression test for s7,
+lint.scm is the s7 equivalent of the ancient C program named lint (modern equivalent: cppcheck),
+write.scm has a pretty printer,
+mockery.scm has mock data libraries,
+cload.scm is a wrapper for the FFI stuff described above, and
+stuff.scm is just some arbitrary stuff.
+gdbinit has some gdb commands for s7.
+repl.scm is a repl.
+</p>
-int main(int argc, char **argv)
-{
- s7_scheme *s7;
- s7 = s7_init(); /* start s7 */
- s7_xen_initialize(s7); /* start the xen connection to libxm */
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
- Init_libxg(); /* load up all the glib/gdk/gtk/cairo/pango bindings in libxm */
- s7_load(s7, "gtkex.scm"); /* load and run our REPL (below) */
-}
-/* libxm: configure --with-gtk, then make
- * gcc -o gtkex gtkex.c libxg.so -lm -I.
- * ;; you may need to include the libxm directory above
- */
-</pre>
-</td></tr></table>
+<div class="header" id="lint"><h4>lint.scm</h4></div>
-<p>And here is gtkex.scm. The main problem with this code is that Gtk is moving
-rapidly toward gtk3, and libxm is running along behind panting and complaining.
-There are several things that may change once Gtk settles down.
+<p>lint tries to find errors or infelicities in your scheme code.
+To try it:
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
-<pre>
-(gtk_init 0 #f)
+<pre class="indented">
+(load "lint.scm")
+(lint "some-code.scm")
+</pre>
-(let ((shell (gtk_window_new GTK_WINDOW_TOPLEVEL))
- (s7-prompt "s7> ")
- (return-key (if (provided? 'gtk3) GDK_KEY_Return GDK_Return)))
-
- (g_signal_connect (G_OBJECT shell) "delete_event"
- (lambda (window event data)
- (gtk_main_quit)
- (exit)))
- (g_signal_connect (G_OBJECT shell) "destroy"
- (lambda (window data)
- (gtk_main_quit)
- (exit)))
-
- (let ((scrolled_window (gtk_scrolled_window_new #f #f)))
-
- (gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW scrolled_window)
- GTK_POLICY_AUTOMATIC GTK_POLICY_AUTOMATIC)
- (gtk_container_add (GTK_CONTAINER shell) scrolled_window)
-
- (let* ((repl (gtk_text_view_new))
- (repl_buf (gtk_text_buffer_new #f))
- (prompt_not_editable #f))
-
- (define (evaluate-expression expr)
- (let ((pos (GtkTextIter))
- (result (catch #t
- (lambda ()
- (object->string (eval-string expr)))
- (lambda args
- (format #f "~A: ~S" (car args) (apply format #f (cadr args)))))))
- (gtk_text_buffer_get_end_iter repl_buf pos)
- (gtk_text_buffer_insert repl_buf pos "\n" 1)
- (gtk_text_buffer_insert repl_buf pos result (length result))))
-
- (define (get-current-expression)
- (let ((m (gtk_text_buffer_get_insert repl_buf))
- (pos (GtkTextIter))
- (previous (GtkTextIter))
- (next (GtkTextIter))
- (temp (GtkTextIter)))
- (gtk_text_buffer_get_iter_at_mark repl_buf pos m)
- (if (gtk_text_iter_backward_search pos s7-prompt 0 temp previous #f)
- (if (not (gtk_text_iter_forward_search pos s7-prompt 0 next temp #f))
- (begin
- (gtk_text_buffer_get_end_iter repl_buf next)
- (gtk_text_buffer_get_text repl_buf previous next #t))
- (begin
- (gtk_text_iter_backward_search next "\n" 0 pos temp #f)
- (gtk_text_iter_backward_search pos "\n" 0 next temp #f)
- (gtk_text_buffer_get_text repl_buf previous next #t)))
- "")))
-
- (define (repl-key-press w event data)
- (let ((key (gtk_event_keyval event)))
- (if (equal? key return-key)
- (let ((pos (GtkTextIter)))
-
- (evaluate-expression (get-current-expression))
-
- (gtk_text_buffer_get_end_iter repl_buf pos)
- (gtk_text_buffer_insert_with_tags repl_buf pos
- (string-append (string #\newline) s7-prompt)
- (+ 1 (length s7-prompt))
- (list prompt_not_editable))
- (gtk_text_buffer_place_cursor repl_buf pos)
- (gtk_text_view_scroll_mark_onscreen (GTK_TEXT_VIEW repl)
- (gtk_text_buffer_get_insert repl_buf))
- (g_signal_stop_emission (GPOINTER w)
- (g_signal_lookup "key_press_event"
- (G_OBJECT_TYPE (G_OBJECT w)))
- 0)))))
-
- (gtk_container_add (GTK_CONTAINER scrolled_window) repl)
- (gtk_text_view_set_buffer (GTK_TEXT_VIEW repl) repl_buf)
- (gtk_text_view_set_editable (GTK_TEXT_VIEW repl) #t)
- (gtk_text_view_set_wrap_mode (GTK_TEXT_VIEW repl) GTK_WRAP_NONE)
- (gtk_text_view_set_cursor_visible (GTK_TEXT_VIEW repl) #t)
- (gtk_text_view_set_left_margin (GTK_TEXT_VIEW repl) 4)
-
- (gtk_widget_set_events repl GDK_ALL_EVENTS_MASK)
- (g_signal_connect (G_OBJECT repl) "key_press_event" repl-key-press)
- (gtk_widget_show repl)
- (gtk_widget_show scrolled_window)
- (gtk_widget_show shell)
-
- (set! prompt_not_editable
- (gtk_text_buffer_create_tag repl_buf "prompt_not_editable"
- (list "editable" 0 "weight" PANGO_WEIGHT_BOLD)))
- (let ((pos (GtkTextIter)))
- (gtk_text_buffer_get_end_iter repl_buf pos)
- (gtk_text_buffer_insert_with_tags repl_buf pos
- s7-prompt (length s7-prompt)
- (list prompt_not_editable))
- (gdk_window_resize (gtk_widget_get_window shell) 400 200)
- (gtk_main)))))
-
-;; build gtkex as above, then run it and it will load/run this code
-</pre>
-</td></tr></table>
-<br><br>
+<p>lint tries to reduce false positives, so its default behavior is somewhat laconic. There are several
+variables at the start of lint.scm to control additional output:
+</p>
+<pre class="indented">
+*report-unused-parameters* ; if #t, report unused function/macro parameters
+*report-unused-top-level-functions* ; if #t, report unused functions
+*report-undefined-variables* ; if #t, report undefined identifiers
+*report-shadowed-variables* ; if #t, report function parameters that are shadowed
+*report-minor-stuff* ; if #t, report all sorts of other stuff
+</pre>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-<A NAME="s7inathread"></A>
+<p>lint is not smart about functions defined outside the current file, so *report-undefined-variables*
+sometimes gets confused. *report-minor-stuff* adds output about overly complicated boolean and numerical
+expressions, dangerous floating point operations, and
+whatever else it thinks is odd.
+</p>
-<p>There is one major flaw in the two preceding REPLs; if s7 gets caught in an infinite loop (via
-<code>(do () ())</code> for example), you have to kill the main program to stop it. We could use
-Unix interrupts as in the <a href="#signal">signal</a> example earlier, but surely in a modern
-GUI-based program, we'd like to avoid such brute-force stuff. In particular, we want our interface
-to keep running while we clean up the s7 problem. So, in the next example, we use a separate
-thread for the s7 evaluation:
+<p>Also in lint.scm is html-lint. It reads an HTML file looking for
+Scheme code. If any is found, it runs s7 and then lint over it, reporting troubles.
</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
-<pre>
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-<em class=red>/* changes from the Gtk/C REPL above are in red */
-#include <pthread.h></em>
-#include <gtk/gtk.h>
-#if HAVE_GTK_3
- #include <gdk/gdk.h>
- #define Return_Key GDK_KEY_Return
-<em class=red> #define C_Key GDK_KEY_C
- #define c_Key GDK_KEY_c</em>
-#else
- #include <gdk/gdkkeysyms.h>
- #define Return_Key GDK_Return
-<em class=red> #define C_Key GDK_C
- #define c_Key GDK_c</em>
-#endif
-#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
+<div class="header" id="cload"><h4>cload.scm</h4></div>
-#define S7_PROMPT "s7> "
-#define S7_PROMPT_LENGTH 4
+<p>cload.scm defines the macro c-define that reduces the overhead
+involved in (dynamically) linking C entities into s7.
+</p>
-static GtkWidget* repl; /* the REPL text widget */
-static GtkTextBuffer *repl_buf; /* its text buffer */
-static GtkTextTag *prompt_not_editable = NULL; /* a tag to make sure the prompt can't be erased */
-<em class=red>static GdkCursor *arrow, *spinner;</em>
+<pre class="indented">
+(<em class=def id="definecfunction">c-define</em> c-info (prefix "") (headers ()) (cflags "") (ldflags "") output-name)
+</pre>
-static gint quit_repl(GtkWidget *w, GdkEvent *event, gpointer context) {exit(0);}
+<p>For example, <code>(c-define '(double j0 (double)) "m" "math.h")</code>
+links the C math library function j0 into s7 under the name m:j0,
+passing it a double argument and getting a double result (a real in s7).
+</p>
-<em class=red>static s7_scheme *s7;
-static s7_pointer s7_result;
-static bool just_quit = false, s7_is_running = false;
-static pthread_t *s7_thread;
+<p><em>prefix</em> is some arbitrary prefix that you want prepended to various names.
+</p>
-static void *run_s7_thread(void *obj)
-{
- /* make sure we can stop this thread */
- pthread_setcancelstate(PTHREAD_CANCEL_ENABLE, NULL);
- pthread_setcanceltype(PTHREAD_CANCEL_ASYNCHRONOUS, NULL);
+<p><em>headers</em> is a list of headers (as strings) that the c-info relies on, (("math.h") for example).
+</p>
- s7_result = s7_eval_c_string(s7, (const char *)obj);
- s7_is_running = false;
- return(NULL);
-}</em>
+<p><em>cflags</em> are any special C compiler flags that are needed ("-I." in particular), and
+<em>ldflags</em> is the similar case for the loader. <em>output-name</em> is the name of the
+output C file and associated library. It defaults to "temp-s7-output" followed by a number.
+In libm.scm, it is set to "libm_s7" to protect it across cload calls. If cload finds an
+up-to-date output C file and shared library, it simply loads the library, rather than
+going through all the trouble of writing and compling it.
+</p>
-static void evaluate_expression(s7_scheme *sc, char *expression)
-{
- /* evaluate expression, display result, catching and displaying any errors */
- if ((expression) &&
- (*expression))
- {
- if ((strlen(expression) > 1) ||
- (expression[0] != '\n'))
- {
- const char *errmsg = NULL;
- int gc_loc;
- s7_pointer old_port;
- GtkTextIter pos;
+<p><em>c-info</em> is a list that describes the C entities that you want to load into s7.
+It can be either one list describing one entity, or a list of such lists.
+Each description has the form:
+</p>
- /* open a port to catch error info */
- old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
- gc_loc = s7_gc_protect(sc, old_port);
+<pre class="indented">
+(return-type entity-name-in-C (argument-type...))
+</pre>
-<em class=red> /* evaluate the expression in a separate thread */
- s7_thread = (pthread_t *)calloc(1, sizeof(pthread_t));
- just_quit = false;
- s7_is_running = true;
- gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(repl), GTK_TEXT_WINDOW_TEXT), spinner);
+<p>where each entry is a symbol, and C names are used throughout. So, in the j0
+example above, <code>(double j0 (double))</code> says we want access to j0, it returns
+a C double, and it takes one argument, also a C double. s7 tries to figure out
+what the corresponding s7 type is, but in tricky cases, you should tell it
+by replacing the bare type name with a list: <code>(C-type underlying-C-type)</code>. For example,
+the Snd function set_graph_style takes an (enum) argument of type graph_style_t.
+This is actually an int, so we use <code>(graph_style_t int)</code> as the type:
+</p>
- pthread_create(s7_thread, NULL, run_s7_thread, (void *)expression);
+<pre class="indented">
+(void set_graph_style ((graph_style_t int)))
+</pre>
- while (s7_is_running)
- gtk_main_iteration(); /* make sure the GUI is responsive */
+<p>If the C entity is a constant, then the descriptor list has just two entries,
+the C-type and the entity name: <code>(int F_OK)</code> for example. The entity name can also be a list:
+</p>
- if (!just_quit)
- {
- pthread_join(*s7_thread, NULL);
- free(s7_thread);
- s7_thread = NULL;
- gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(repl), GTK_TEXT_WINDOW_TEXT), arrow);
- errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
- }
- else errmsg = "\ngot C-C!";</em>
+<pre class="indented">
+((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS))
+</pre>
- /* if error, display it, else display result of evaluation */
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
-
- if ((errmsg) && (*errmsg))
- gtk_text_buffer_insert(repl_buf, &pos, errmsg, strlen(errmsg));
- else
- {
- char *result_as_string;
- result_as_string = s7_object_to_c_string(sc, s7_result);
- if (result_as_string)
- {
- gtk_text_buffer_insert(repl_buf, &pos, "\n", 1);
- gtk_text_buffer_insert(repl_buf, &pos, result_as_string, strlen(result_as_string));
- free(result_as_string);
- }
- }
- s7_close_output_port(sc, s7_current_error_port(sc));
- s7_set_current_error_port(sc, old_port);
- s7_gc_unprotect_at(sc, gc_loc);
- }
- g_free(expression);
- }
-}
+<p>This defines all the names in the list as integers.
+If the C type has a space ("struct tm*"), use <code>(symbol "struct tm*")</code>
+to construct the corresponding symbol.
+</p>
-static char *get_current_expression(void)
-{
- GtkTextIter pos, previous, next, temp;
- GtkTextMark *m;
+<p>The entity is placed in the current s7 environment under the name <code>(string-append prefix ":" name)</code>
+where the ":" is omitted if the prefix is null. So in the j0 example, we get in s7 the function m:j0.
+c-define returns #t if it thinks the load worked, and #f otherwise.
+</p>
- m = gtk_text_buffer_get_insert(repl_buf);
- gtk_text_buffer_get_iter_at_mark(repl_buf, &pos, m);
+<p>There are times when the only straightforward approach is to write the desired
+C code directly. To insert C code on the fly, use (in-C "code..."). Two more such
+cases that come up all the time: C-function for linkage to functions written
+directly in s7 style using in-C, and C-macro for macros in the C header file that
+need to be wrapped in #ifdefs.
+Here are some examples:
+</p>
- if (gtk_text_iter_backward_search(&pos, S7_PROMPT, 0, &temp, &previous, NULL))
- {
- if (!gtk_text_iter_forward_search(&pos, S7_PROMPT, 0, &next, &temp, NULL))
- {
- gtk_text_buffer_get_end_iter(repl_buf, &next);
- return(gtk_text_buffer_get_text(repl_buf, &previous, &next, true));
- }
- gtk_text_iter_backward_search(&next, "\n", 0, &pos, &temp, NULL);
- gtk_text_iter_backward_search(&pos, "\n", 0, &next, &temp, NULL);
- return(gtk_text_buffer_get_text(repl_buf, &previous, &next, true));
- }
- return(NULL);
-}
+<pre class="indented">
+;;; various math library functions
+(c-define '((double j0 (double))
+ (double j1 (double))
+ (double erf (double))
+ (double erfc (double))
+ (double lgamma (double)))
+ "m" "math.h")
-static void prompt(GtkWidget *w)
-{
- GtkTextIter pos;
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
- gtk_text_buffer_insert_with_tags(repl_buf, &pos, "\n" S7_PROMPT, 1 + S7_PROMPT_LENGTH, prompt_not_editable, NULL);
+;;; getenv and setenv
+(c-define '(char* getenv (char*)))
+(c-define '(int setenv (char* char* int)))
- gtk_text_buffer_place_cursor(repl_buf, &pos);
- gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(repl), gtk_text_buffer_get_insert(repl_buf));
- g_signal_stop_emission((gpointer)w, g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
-}
+;;; file-exists? and delete-file
+(define file-exists? (let () ; define F_OK and access only within this let
+ (c-define '((int F_OK) (int access (char* int))) "" "unistd.h")
+ (lambda (arg) (= (access arg F_OK) 0))))
-static gboolean repl_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
-{
- /* called when you type anything in the text widget.
- * 'data' is our s7 interpreter.
- */
- guint key, state;
- key = event->keyval;
-<em class=red> state = event->state;</em>
+(define delete-file (let ()
+ (c-define '(int unlink (char*)) "" "unistd.h")
+ (lambda (file) (= (unlink file) 0)))) ; 0=success
- if (key == Return_Key)
- {
- if (!s7_is_running)
- evaluate_expression((s7_scheme *)data, get_current_expression());
- prompt(w);
- }
-<em class=red>
- /* if C-C typed, and s7 is running, we're trying to break out of a loop */
- if (((key == C_Key) || (key == c_Key)) &&
- ((state & GDK_CONTROL_MASK) != 0) &&
- (s7_is_running))
- {
- just_quit = true;
- pthread_cancel(*s7_thread);
- pthread_detach(*s7_thread);
- s7_is_running = false;
- s7_quit(s7);
- free(s7_thread);
- s7_thread = NULL;
- gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(repl), GTK_TEXT_WINDOW_TEXT), arrow);
- prompt(w);
- }
-</em>
- return(false);
-}
-int main(int argc, char **argv)
-{
- GtkWidget *shell, *scrolled_window;
- GtkTextIter pos;
+;;; examples from Snd:
+(c-define '(char* version_info ()) "" "snd.h" "-I.")
- s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
+(c-define '(mus_float_t mus_degrees_to_radians (mus_float_t)) "" "snd.h" "-I.")
- /* make a window with a scrolled text widget */
- gtk_init(&argc, &argv);
- <em class=red>
- spinner = gdk_cursor_new(GDK_WATCH);
- arrow = gdk_cursor_new(GDK_LEFT_PTR);
- </em>
- shell = gtk_window_new(GTK_WINDOW_TOPLEVEL);
- g_signal_connect(G_OBJECT(shell), "delete_event", G_CALLBACK(quit_repl), NULL);
+(c-define '(snd_info* any_selected_sound ()) "" "snd.h" "-I.")
+(c-define '(void select_channel (snd_info* int)) "" "snd.h" "-I.")
- scrolled_window = gtk_scrolled_window_new(NULL, NULL);
- gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(scrolled_window), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
- gtk_container_add(GTK_CONTAINER(shell), scrolled_window);
+(c-define '(((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS))
+ (void set_graph_style ((graph_style_t int))))
+ "" "snd.h" "-I.")
+
- repl = gtk_text_view_new();
- repl_buf = gtk_text_buffer_new(NULL);
- gtk_container_add(GTK_CONTAINER(scrolled_window), repl);
+;;; getcwd, strftime
+(c-define '(char* getcwd (char* size_t)) "" "unistd.h")
- gtk_text_view_set_buffer(GTK_TEXT_VIEW(repl), repl_buf);
- gtk_text_view_set_editable(GTK_TEXT_VIEW(repl), true);
- gtk_text_view_set_wrap_mode(GTK_TEXT_VIEW(repl), GTK_WRAP_NONE);
- gtk_text_view_set_cursor_visible(GTK_TEXT_VIEW(repl), true);
- gtk_text_view_set_left_margin(GTK_TEXT_VIEW(repl), 4);
+(c-define (list '(void* calloc (size_t size_t))
+ '(void free (void*))
+ '(void time (time_t*)) ; ignore returned value
+ (list (symbol "struct tm*") 'localtime '(time_t*))
+ (list 'size_t 'strftime (list 'char* 'size_t 'char* (symbol "struct tm*"))))
+ "" "time.h")
- /* whenever a key is pressed, call repl_key_press */
- gtk_widget_set_events(repl, GDK_ALL_EVENTS_MASK);
- g_signal_connect(G_OBJECT(repl), "key_press_event", G_CALLBACK(repl_key_press), (void *)s7);
+> (let ((p (calloc 1 8))
+ (str (make-string 32)))
+ (time p)
+ (strftime str 32 "%a %d-%b-%Y %H:%M %Z" (localtime p))
+ (free p)
+ str)
+<em class="gray">"Sat 11-Aug-2012 08:55 PDT\x00 "</em>
- gtk_widget_show(repl);
- gtk_widget_show(scrolled_window);
- gtk_widget_show(shell);
- /* start with a boldface '>' prompt that can't be stepped on */
- prompt_not_editable = gtk_text_buffer_create_tag(repl_buf, "prompt_not_editable",
- "editable", false,
- "weight", PANGO_WEIGHT_BOLD,
- NULL);
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
- gtk_text_buffer_insert_with_tags(repl_buf, &pos, S7_PROMPT, S7_PROMPT_LENGTH, prompt_not_editable, NULL);
+;;; opendir, read_dir, closedir
+(c-define '((int closedir (DIR*))
+ (DIR* opendir (char*))
+ (in-C "static char *read_dir(DIR *p) \
+ { \
+ struct dirent *dirp; \
+ dirp = readdir(p); \
+ if (!dirp) return(NULL); \
+ return(dirp->d_name); \
+ }")
+ (char* read_dir (DIR*)))
+ "" '("sys/types.h" "dirent.h"))
- /* make the initial window size reasonable */
- gdk_window_resize(gtk_widget_get_window(shell), 400, 200);
- gtk_main();
-}
+(let ((dir (opendir "/home/bil/gtk-snd")))
+ (do ((p (read_dir dir) (read_dir dir)))
+ ((= (length p) 0))
+ (format *stderr* "~A " p))
+ (closedir dir))
</pre>
-</td></tr></table>
-
-
-<p>This code still has a flaw. Any GUI callback can
-call s7_call or s7_eval_c_string directly. In the code above, if the listener
-starts a long evaluation (or falls into an infinite loop), and we start idly poking around
-with the mouse, waiting for the evaluation to finish, a mouse or menu callback can trigger
-a call on the same s7 interpreter that is currently running in the listener.
-We are trying to evaluate two different expressions at the same time! What you
-get depends on where s7 notices the problem. If the evaluator senses that it is lost,
-it will raise some confusing error; otherwise the s7 stack will cause a segfault.
-We need the GUI to stay active so that we can interrupt computation by typing C-C.
-We can't sort through all the events dispatching only the C-C, because that
-confuses subsequent GUI actions, and the whole idea here is to keep the interface
-alive. We can put the listener's s7_eval_c_string in a separate s7 thread
-so that the multiple evaluations can be interleaved, but those evaluations
-can still make calls into Gtk or Motif, and
-unfortunately, neither GUI toolkit is thread-safe. If two threads invoke
-a GUI function, you get a segfault or some other bizarre screwup.
-In Gtk, we have to wrap gdk_threads_enter
-and gdk_threads_leave around any code that calls into Gtk. We'd set it up by
-adding
-</p>
-<pre>
- g_thread_init(NULL);
- gdk_threads_init();
- gdk_threads_enter();
-</pre>
-<p>at the very start of our program, and gdk_threads_leave() at the very end.
-Then whenever an s7 call might involve Gtk, we wrap it within gdk_threads_enter() and
-gdk_threads_leave(). We can't just wrap the outer s7_eval_c_string call above, because
-that locks out the keyboard, and the whole point was to catch C-C
-while in the s7 evaluation. But in Snd, where both normal functions and gtk callbacks can
-trigger arbitrary Scheme code, it would be completely unreasonable to wrap these thread handlers
-around every bit of code that might touch the user interface (consider the xg module!).
-So...
+<p>For the simple cases above, include "-ldl -Wl,-export-dynamic" in the gcc command. So the first
+FFI example is built (this is in Linux):
</p>
-<br>
-
+<pre class="indented">
+gcc -c s7.c -I.
+gcc -o ex1 ex1.c s7.o -lm -I. -ldl -Wl,-export-dynamic
+ex1
+> (load "cload.scm")
+<em class="gray">c-define-1</em>
+> (c-define '(double j0 (double)) "m" "math.h")
+<em class="gray">#t</em>
+> (m:j0 0.5)
+<em class="gray">0.93846980724081</em>
+</pre>
-<table border=0 vspace=8 width=30% hspace=100 cellpadding=0 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width="100%" border=0><tr><td bgcolor="beige" align="center"></td></tr></table></td></tr></table>
-
-<A NAME="replrescue"></A>
-
-<p>
-Common Lisp has something called "evalhook" that makes it possible
-to insert your own function into eval. In s7, we have a "begin_hook" which sits at the opening of any begin block
-(implicit or explicit). Here are two REPLs, one for Gtk, and one for a bare terminal.
+<p>See also r7rs.scm, libc.scm, libgsl.scm, libm.scm, libdl.scm, and libgdbm.scm.
+libutf8proc.scm exists, but I have not tested it at all.
</p>
-
-
-
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
+<div class="indented" id="libc">
<pre>
-/* terminal-based REPL,
- * an expansion of the <a href="#repl">read-eval-print loop</a> program above.
- * type C-g to interrupt an evaluation.
- */
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <termios.h>
-#include <signal.h>
-
-#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
-
-static struct termios save_buf, buf;
-
-static void sigcatch(int n)
-{
- /* put things back the way they were */
- tcsetattr(fileno(stdin), TCSAFLUSH, &save_buf);
- exit(0);
-}
+(require libc.scm)
-static char buffer[512];
-static int type_ahead_point = 0;
+(define (copy-file in-file out-file)
+ (with-let (sublet *libc* :in-file in-file :out-file out-file)
-static bool <em class=red>watch_for_c_g</em>(s7_scheme *sc)
-{
- char c;
- bool all_done = false;
- /* watch for C-g without blocking, save other chars as type-ahead */
- tcsetattr(fileno(stdin), TCSAFLUSH, &buf);
+ ;; the rest of the function body exists in the *libc* environment, with the
+ ;; function parameters in-file and out-file imported, so, for example,
+ ;; (open ...) below calls the libc function open.
- if (read(fileno(stdin), &c, 1) == 1)
- {
- if (c == 7) /* C-g */
- {
- all_done = true;
- type_ahead_point = 0;
- }
- else buffer[type_ahead_point++] = c;
- }
-
- tcsetattr(fileno(stdin), TCSAFLUSH, &save_buf);
- return(all_done);
-}
+ (let ((infd (open in-file O_RDONLY 0)))
+ (if (= infd -1)
+ (error 'io-error "can't find ~S~%" in-file)
+ (let ((outfd (creat out-file #o666)))
+ (if (= outfd -1)
+ (begin
+ (close infd)
+ (error 'io-error "can't open ~S~%" out-file))
+ (let* ((BUF_SIZE 1024)
+ (buf (malloc BUF_SIZE)))
+ (do ((num (read infd buf BUF_SIZE) (read infd buf BUF_SIZE)))
+ ((or (<= num 0)
+ (not (= (write outfd buf num) num)))))
+ (close outfd)
+ (close infd)
+ (free buf)
+ out-file)))))))
+
+(define (glob->list pattern)
+ (with-let (sublet *libc* :pattern pattern)
+ (let ((g (glob.make)))
+ (glob pattern 0 g)
+ (let ((res (glob.gl_pathv g)))
+ (globfree g)
+ res))))
+
+;; now (load "*.scm") is (for-each load (glob->list "*.scm"))
+</pre>
+</div>
+
+
+<div class="indented" id="libgsl">
+<pre>
+(require libgsl.scm)
+
+(define (eigenvalues M)
+ (with-let (sublet *libgsl* :M M)
+ (let* ((len (sqrt (length M)))
+ (gm (gsl_matrix_alloc len len))
+ (m (float-vector->gsl_matrix M gm))
+ (evl (gsl_vector_complex_alloc len))
+ (evc (gsl_matrix_complex_alloc len len))
+ (w (gsl_eigen_nonsymmv_alloc len)))
+
+ (gsl_eigen_nonsymmv m evl evc w)
+ (gsl_eigen_nonsymmv_free w)
+ (gsl_eigen_nonsymmv_sort evl evc GSL_EIGEN_SORT_ABS_DESC)
+
+ (let ((vals (make-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (vals i) (gsl_vector_complex_get evl i)))
+ (gsl_matrix_free gm)
+ (gsl_vector_complex_free evl)
+ (gsl_matrix_complex_free evc)
+ vals))))
+</pre>
+</div>
+
+<p>We can use gdbm (or better yet, mdb), the :readable argument to object->string, and
+the fallback methods in the environments to create name-spaces (lets) with billions of
+thread-safe local variables, which can be saved and communicated between s7 runs:
+</p>
+<div class="indented" id="libgdbm">
+<pre>
+(require libgdbm.scm)
+
+(with-let *libgdbm*
+
+ (define *db*
+ (openlet
+ (inlet :file (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664
+ (lambda (str) (format *stderr* "gdbm error: ~S~%" str)))
+
+ :let-ref-fallback (lambda (obj sym)
+ (eval-string (gdbm_fetch (obj 'file) (symbol->string sym))))
+
+ :let-set!-fallback (lambda (obj sym val)
+ (gdbm_store (obj 'file)
+ (symbol->string sym)
+ (object->string val :readable)
+ GDBM_REPLACE)
+ val)
+
+ :make-iterator (lambda (obj)
+ (let ((key #f)
+ (length (lambda (obj) (expt 2 20))))
+ (#_make-iterator
+ (let ((iterator? #t))
+ (openlet
+ (lambda ()
+ (if key
+ (set! key (gdbm_nextkey (obj 'file) (cdr key)))
+ (set! key (gdbm_firstkey (obj 'file))))
+ (if (pair? key)
+ (cons (string->symbol (car key))
+ (eval-string (gdbm_fetch (obj 'file) (car key))))
+ key))))))))))
+
+ (set! (*db* 'str) "123") ; add a variable named 'str with the value "123"
+ (set! (*db* 'int) 432)
+
+ (with-let *db*
+ (+ int (length str))) ; -> 435
+ (map values *db*) ; -> '((str . "123") (int . 432))
+
+ (gdbm_close (*db* 'file)))
+</pre>
+
+</div>
+
+
+
+<div class="header" id="schemerepl"><h4>repl.scm</h4></div>
+
+<p>repl.scm implements a repl using vt100 codes and libc.scm. It includes
+symbol and filename completion, a history buffer, paren matching,
+indentation, multi-line edits, and a debugger window.
+To move around in the history buffer, use M-p, M-n or M-. (C-p and C-n are used to move the cursor in the current expression).
+You can change the keymap or the prompt; all the repl functions are
+accessible through the *repl* environment. One field is 'repl-let which
+gives you access to all the repl's internal variables and functions.
+Another is 'top-level-let, normally (sublet (rootlet)), which is the environment in
+which the repl's evaluation takes place. You can reset the repl back to its
+starting point with: <code>(set! (*repl* 'top-level-let) (sublet (rootlet)))</code>.
+You can save the current repl state via <code>((*repl* 'save-repl))</code>, and
+restore it later via <code>((*repl* 'restore-repl))</code>. The repl's saved state
+is in the file save.repl, or the filename can be passed as an argument to save-repl and restore-repl.
+The special symbol '** holds the last value.
+</p>
+
+<p>Meta keys are a problem on the Mac. You can use ESC instead, but that requires
+super-human capacities. I stared at replacement control keys, and nothing seemed
+right. I don't know how to remap these commands, but it's easy to do: see repl.scm
+which has a small table of mappings, and try out your own.
+</p>
+
+<p>To run the repl, either build s7 with the compiler flag -DWITH_MAIN,
+or conjure up a wrapper:
+</p>
+
+<pre class="indented">
+#include "s7.h"
int main(int argc, char **argv)
{
- s7_scheme *s7;
- bool use_begin_hook;
-
- use_begin_hook = (tcgetattr(fileno(stdin), &save_buf) >= 0);
- if (use_begin_hook)
- {
- buf = save_buf;
- buf.c_lflag &= ~ICANON;
- buf.c_cc[VMIN] = 0; /* if no chars waiting, just return */
- buf.c_cc[VTIME] = 0;
+ s7_scheme *sc;
+ sc = s7_init();
+ s7_load(sc, "repl.scm");
+ s7_eval_c_string(sc, "((*repl* 'run))");
+ return(0);
+}
- signal(SIGINT, sigcatch);
- signal(SIGQUIT, sigcatch);
- signal(SIGTERM, sigcatch);
- }
+/* gcc -o r r.c s7.o -Wl,-export-dynamic -lm -I. -ldl
+ */
+</pre>
- s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
+<p>Besides evaluating s7 expressions, like any repl,
+you can also type shell commands just as in a shell:
+</p>
- if (argc == 2)
- {
- fprintf(stderr, "load %s\n", argv[1]);
- s7_load(s7, argv[1]);
- }
- else
- {
- char response[1024];
- while (1)
- {
- fprintf(stdout, "\n> ");
- fgets((char *)(buffer + type_ahead_point), 512 - type_ahead_point, stdin);
- type_ahead_point = 0;
+<pre class="indented">
+> pwd
+<em class="gray">/home/bil/cl</em>
+> cd ..
+<em class="gray">/home/bil</em>
+> date
+<em class="gray">Wed 15-Apr-2015 17:32:24 PDT</em>
+> **
+<em class="gray">"Wed 15-Apr-2015 17:32:24 PDT
+"</em>
+</pre>
- if ((buffer[0] != '\n') ||
- (strlen(buffer) > 1))
- {
- sprintf(response, "(write %s)", buffer);
+<p>In most cases, these are handled through *unbound-variable-hook*, checked using "command -v", then passed
+to the underlying shell via the system function. If s7's (as opposed to libc's) system command
+is accessible, the '** variable holds whatever the command printed.
+</p>
- if (use_begin_hook)
- <em class=red>s7_set_begin_hook</em>(s7, watch_for_c_g);
- s7_eval_c_string(s7, response);
- if (use_begin_hook)
- <em class=red>s7_set_begin_hook</em>(s7, NULL);
- }
- }
- }
- if (use_begin_hook)
- tcsetattr(fileno(stdin), TCSAFLUSH, &save_buf);
-}
+<p>The prompt is set by the function (*repl* 'prompt). It gets one argument,
+the current line number, and should set the prompt string and its length.
+</p>
+<pre class="indented">
+(set! (*repl* 'prompt) (lambda (num)
+ (with-let (*repl* 'repl-let)
+ (set! prompt-string "scheme> ")
+ (set! prompt-length (length prompt-string)))))
+</pre>
+<p>or, to use the red lambda example mentioned earlier:
+</p>
+<pre class="indented">
+(set! (*repl* 'prompt)
+ (lambda (num)
+ (with-let (*repl* 'repl-let)
+ (set! prompt-string (bold (red (string #\xce #\xbb #\> #\space))))
+ (set! prompt-length 3)))) ; until we get unicode length calc
</pre>
-</td></tr></table>
-<br>
+<p>The line number provides a quick way to move around in the history buffer.
+To get a previous line without laboriously typing M-p over and over,
+simply type the line number (without control or meta bits), then M-.
+</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
-<pre>
-/* Gtk-based REPL using s7_begin_hook
- */
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <gtk/gtk.h>
+<p>Here is an example of adding to the keymap:
+</p>
+<pre class="indented">
+(set! ((*repl* 'keymap) (integer->char 17)) ; C-q to quit and return to caller
+ (lambda (c)
+ (set! ((*repl* 'repl-let) 'all-done) #t)))
+</pre>
-#if HAVE_GTK_3
- #include <gdk/gdk.h>
- #define Return_Key GDK_KEY_Return
- #define C_Key GDK_KEY_C
- #define c_Key GDK_KEY_c
-#else
- #include <gdk/gdkkeysyms.h>
- #define Return_Key GDK_Return
- #define C_Key GDK_C
- #define c_Key GDK_c
-#endif
+<p>To access the meta keys (in the keymap), use a string:
+<code>((*repl* 'keymap) (string #\escape #\p))</code>; this is Meta-p which normally accesses
+the history buffer.
+</p>
-#include "s7.h"
-static s7_pointer my_exit(s7_scheme *sc, s7_pointer args) {exit(0);}
+<p>You can call the repl from other code, poke around in the current environment (or whatever),
+then return to the caller:
+</p>
-#define S7_PROMPT "s7> "
-#define S7_PROMPT_LENGTH 4
-#define S7_INTERRUPTED_MESSAGE "\ns7 interrupted!"
+<pre class="indented">
+(load "repl.scm")
-static GtkWidget* repl; /* the REPL text widget */
-static GtkTextBuffer *repl_buf; /* its text buffer */
-static GtkTextTag *prompt_not_editable = NULL; /* a tag to make sure the prompt can't be erased */
-static GdkCursor *arrow, *spinner;
+(define (drop-into-repl e)
+ (let ((C-q (integer->char 17))) ; we'll use the C-q example above to get out
+ (let ((old-C-q ((*repl* 'keymap) C-q))
+ (old-top-level (*repl* 'top-level-let)))
+ (dynamic-wind
+ (lambda ()
+ (set! (*repl* 'top-level-let) e)
+ (set! ((*repl* 'keymap) C-q)
+ (lambda (c)
+ (set! ((*repl* 'repl-let) 'all-done) #t))))
+ (lambda ()
+ ((<em class=red>*repl* 'run</em>))) ; run the repl
+ (lambda ()
+ (set! (*repl* 'top-level-let) old-top-level)
+ (set! ((*repl* 'keymap) C-q) old-C-q))))))
-static gint quit_repl(GtkWidget *w, GdkEvent *event, gpointer context) {exit(0);}
+(let ((x 32))
+ (format *stderr* "x: ~A~%" x)
+ (<em class=red>drop-into-repl</em> (curlet))
+ (format *stderr* "now x: ~A~%" x))
+</pre>
-<em class=red>static bool C_c_typed = false;
+<p>Now load that code and:
+</p>
-static bool begin_hook(s7_scheme *sc)
-{
- C_c_typed = false;
- gtk_main_iteration();
- return(C_c_typed);
-}</em>
+<pre class="indented">
+x: 32
+> x
+<em class="gray">32</em>
+> (set! x 91)
+<em class="gray">91</em>
+> x
+<em class="gray">91</em>
+> now x: 91 ; here I typed C-q at the prompt
+</pre>
-static void evaluate_expression(s7_scheme *sc, char *expression)
-{
- /* evaluate expression, display result, catching and displaying any errors */
- if ((expression) &&
- (*expression))
- {
- if ((strlen(expression) > 1) ||
- (expression[0] != '\n'))
- {
- const char *errmsg = NULL;
- int gc_loc;
- s7_pointer old_port, result;
- GtkTextIter pos;
+<p>Another possibility:
+</p>
+<pre class="indented">
+(set! (hook-functions *error-hook*)
+ (list (lambda (hook)
+ (apply format *stderr* (hook 'data))
+ (newline *stderr*)
+ (drop-into-repl (owlet)))))
+</pre>
- old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
- gc_loc = s7_gc_protect(sc, old_port);
- gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(repl), GTK_TEXT_WINDOW_TEXT), spinner);
-
- <em class=red>s7_set_begin_hook(sc, begin_hook);
- result = s7_eval_c_string(sc, expression);
- s7_set_begin_hook(sc, NULL);</em>
+<p>See the end of repl.scm for more examples.
+</p>
- gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(repl), GTK_TEXT_WINDOW_TEXT), arrow);
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
+<!--
+(load "/home/bil/test/sndlib/libsndlib.so" (inlet 'init_func 's7_init_sndlib))
- <em class=red>if (C_c_typed)
- {
- gtk_text_buffer_insert(repl_buf, &pos, S7_INTERRUPTED_MESSAGE, strlen(S7_INTERRUPTED_MESSAGE));
- C_c_typed = false;
- }
- else</em>
- {
- errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
- if ((errmsg) && (*errmsg))
- gtk_text_buffer_insert(repl_buf, &pos, errmsg, strlen(errmsg));
- else
- {
- char *result_as_string;
- result_as_string = s7_object_to_c_string(sc, result);
- if (result_as_string)
- {
- gtk_text_buffer_insert(repl_buf, &pos, "\n", 1);
- gtk_text_buffer_insert(repl_buf, &pos, result_as_string, strlen(result_as_string));
- free(result_as_string);
- }
- }
- }
+not tested:
+(load "/home/bil/test/libxm/libxm.so" (inlet 'init_func 'Init_libxm))
- s7_close_output_port(sc, s7_current_error_port(sc));
- s7_set_current_error_port(sc, old_port);
- s7_gc_unprotect_at(sc, gc_loc);
- }
+-->
- g_free(expression);
- }
-}
-static char *get_current_expression(void)
-{
- GtkTextIter pos, previous, next, temp;
- GtkTextMark *m;
- m = gtk_text_buffer_get_insert(repl_buf);
- gtk_text_buffer_get_iter_at_mark(repl_buf, &pos, m);
- if (gtk_text_iter_backward_search(&pos, S7_PROMPT, 0, &temp, &previous, NULL))
- {
- if (!gtk_text_iter_forward_search(&pos, S7_PROMPT, 0, &next, &temp, NULL))
- {
- gtk_text_buffer_get_end_iter(repl_buf, &next);
- return(gtk_text_buffer_get_text(repl_buf, &previous, &next, true));
- }
- gtk_text_iter_backward_search(&next, "\n", 0, &pos, &temp, NULL);
- gtk_text_iter_backward_search(&pos, "\n", 0, &next, &temp, NULL);
- return(gtk_text_buffer_get_text(repl_buf, &previous, &next, true));
- }
- return(NULL);
+<!-- ================================================================================ -->
+
+<script language=JavaScript>
+
+/** from Remy Sharp at GitHub
+ * Note that this script is intended to be included at the *end* of the document, before </body>
+ */
+(function (window, document) {
+if ('open' in document.createElement('details')) return;
+
+// made global by myself to be reused elsewhere
+var addEvent = (function () {
+ if (document.addEventListener) {
+ return function (el, type, fn) {
+ if (el && el.nodeName || el === window) {
+ el.addEventListener(type, fn, false);
+ } else if (el && el.length) {
+ for (var i = 0; i < el.length; i++) {
+ addEvent(el[i], type, fn);
+ }
+ }
+ };
+ } else {
+ return function (el, type, fn) {
+ if (el && el.nodeName || el === window) {
+ el.attachEvent('on' + type, function () { return fn.call(el, window.event); });
+ } else if (el && el.length) {
+ for (var i = 0; i < el.length; i++) {
+ addEvent(el[i], type, fn);
+ }
+ }
+ };
+ }
+})();
+
+
+/** details support - typically in it's own script */
+// find the first /real/ node
+function firstNode(source) {
+ var node = null;
+ if (source.firstChild.nodeName != "#text") {
+ return source.firstChild;
+ } else {
+ source = source.firstChild;
+ do {
+ source = source.nextSibling;
+ } while (source && source.nodeName == '#text');
+
+ return source || null;
+ }
}
-
-static void prompt(GtkWidget *w)
-{
- GtkTextIter pos;
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
- gtk_text_buffer_insert_with_tags(repl_buf, &pos, "\n" S7_PROMPT, 1 + S7_PROMPT_LENGTH, prompt_not_editable, NULL);
- gtk_text_buffer_place_cursor(repl_buf, &pos);
- gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(repl), gtk_text_buffer_get_insert(repl_buf));
- g_signal_stop_emission((gpointer)w, g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
+
+function isSummary(el) {
+ var nn = el.nodeName.toUpperCase();
+ if (nn == 'DETAILS') {
+ return false;
+ } else if (nn == 'SUMMARY') {
+ return true;
+ } else {
+ return isSummary(el.parentNode);
+ }
}
-
-static gboolean repl_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
-{
- /* called when you type anything in the text widget.
- * 'data' is our s7 interpreter.
- */
- guint key, state;
- s7_scheme *sc;
-
- sc = (s7_scheme *)data;
- key = event->keyval;
- state = event->state;
-
- if (key == Return_Key)
- {
- if (<em class=red>s7_begin_hook(sc) == NULL</em>)
- {
- evaluate_expression(sc, get_current_expression());
- prompt(w);
- }
+
+function toggleDetails(event) {
+ // more sigh - need to check the clicked object
+ var keypress = event.type == 'keypress',
+ target = event.target || event.srcElement;
+ if (keypress || isSummary(target)) {
+ if (keypress) {
+ // if it's a keypress, make sure it was enter or space
+ keypress = event.which || event.keyCode;
+ if (keypress == 32 || keypress == 13) {
+ // all's good, go ahead and toggle
+ } else {
+ return;
+ }
}
-
- if (((key == C_Key) || (key == c_Key)) &&
- ((state & GDK_CONTROL_MASK) != 0))
- <em class=red>C_c_typed = true</em>;
-
- return(false);
+
+ var open = this.getAttribute('open');
+ if (open === null) {
+ this.setAttribute('open', 'open');
+ } else {
+ this.removeAttribute('open');
+ }
+
+ // this.className = open ? 'open' : ''; // Lame
+ // trigger reflow (required in IE - sometimes in Safari too)
+ setTimeout(function () {
+ document.body.className = document.body.className;
+ }, 13);
+
+ if (keypress) {
+ event.preventDefault && event.preventDefault();
+ return false;
+ }
+ }
}
-
-int main(int argc, char **argv)
-{
- GtkWidget *shell, *scrolled_window;
- GtkTextIter pos;
- s7_scheme *s7;
-
- s7 = s7_init();
- s7_define_function(s7, "exit", my_exit, 0, 0, false, "(exit) exits the program");
-
- gtk_init(&argc, &argv);
- spinner = gdk_cursor_new(GDK_WATCH);
- arrow = gdk_cursor_new(GDK_LEFT_PTR);
+
+function addStyle() {
+ var style = document.createElement('style'),
+ head = document.getElementsByTagName('head')[0],
+ key = style.innerText === undefined ? 'textContent' : 'innerText';
+
+ var rules = ['details{display: block;}','details > *{display: none;}','details.open > *{display: block;}','details[open] > *{display: block;}','details > summary:first-child{display: block;cursor: pointer;}','details[open]{display: block;}'];
+ i = rules.length;
- shell = gtk_window_new(GTK_WINDOW_TOPLEVEL);
- g_signal_connect(G_OBJECT(shell), "delete_event", G_CALLBACK(quit_repl), NULL);
-
- scrolled_window = gtk_scrolled_window_new(NULL, NULL);
- gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(scrolled_window), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
- gtk_container_add(GTK_CONTAINER(shell), scrolled_window);
-
- repl = gtk_text_view_new();
- repl_buf = gtk_text_buffer_new(NULL);
- gtk_container_add(GTK_CONTAINER(scrolled_window), repl);
-
- gtk_text_view_set_buffer(GTK_TEXT_VIEW(repl), repl_buf);
- gtk_text_view_set_editable(GTK_TEXT_VIEW(repl), true);
- gtk_text_view_set_wrap_mode(GTK_TEXT_VIEW(repl), GTK_WRAP_NONE);
- gtk_text_view_set_cursor_visible(GTK_TEXT_VIEW(repl), true);
- gtk_text_view_set_left_margin(GTK_TEXT_VIEW(repl), 4);
- gtk_widget_set_events(repl, GDK_ALL_EVENTS_MASK);
- g_signal_connect(G_OBJECT(repl), "key_press_event", G_CALLBACK(repl_key_press), (void *)s7);
-
- gtk_widget_show(repl);
- gtk_widget_show(scrolled_window);
- gtk_widget_show(shell);
-
- prompt_not_editable = gtk_text_buffer_create_tag(repl_buf, "prompt_not_editable",
- "editable", false,
- "weight", PANGO_WEIGHT_BOLD,
- NULL);
- gtk_text_buffer_get_end_iter(repl_buf, &pos);
- gtk_text_buffer_insert_with_tags(repl_buf, &pos, S7_PROMPT, S7_PROMPT_LENGTH, prompt_not_editable, NULL);
- gdk_window_resize(gtk_widget_get_window(shell), 400, 200);
- gtk_main();
+ style[key] = rules.join("\n");
+ head.insertBefore(style, head.firstChild);
}
-</pre>
-</td></tr></table>
-
-<p>In the Gtk case above, begin_hook itself checks the user-interface (via gtk_main_iteration), so a key_press event
-(or any other) can still get through, even if s7_eval_c_string falls into an
-infinite loop. If a GUI event triggers a call on s7, that call happens in the current thread
-at a protected point in the s7 evaluation, so the GUI toolkit is happy because there's
-only the current thread, and s7 is happy because it handles the interleaved expression
-at a point where it can't confuse the current evaluation.
-If the begin_hook function returns true (if C-C is typed),
-s7 itself calls s7_quit, interrupting the current evaluation.
-If return is typed, and s7 is running (begin_hook is not NULL),
-we ignore it. Otherwise return causes our REPL to send
-the current string to s7_eval_c_string. Upon returning from s7_eval_c_string,
-we check whether we were interrupted (C_c_typed is true), and if so, send a surprised
-message to the REPL. Otherwise we handle everything as in the previous REPLs.
-</p>
-
-<p>If the s7 evaluation can't affect the GUI and the GUI can't call s7 itself,
-or if the GUI is thread-safe and you're using s7_threads for the interleaved expressions,
-then you don't need to use begin_hook.
-</p>
-
-<p>begin_hook provides a way to call arbitrary C or Scheme code at any time;
-the mind boggles! In the Snd listener, for example, you can ask for a stack trace
-to see if your long computation is making progress. Since the normal
-begin_hook function keeps the interface alive, a callback can save the current
-begin_hook function, insert its own function to do something useful, then that function can
-replace itself with the original:
-</p>
-
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=16>
-<tr><td bgcolor="#fbfbf0">
-<pre>
-static bool (*current_begin_hook)(s7_scheme *sc); /* this will be the saved original function */
-
-static bool stacktrace_begin_hook(s7_scheme *sc) /* this is our one-shot replacement */
-{
- s7_stacktrace(sc, s7_name_to_value(sc, "*stderr*")); /* it prints a stacktrace */
- s7_set_begin_hook(s7, current_begin_hook); /* then replaces itself with the original */
- return(false);
+
+var details = document.getElementsByTagName('details'),
+ wrapper,
+ i = details.length,
+ j,
+ first = null,
+ label = document.createElement('summary');
+
+label.appendChild(document.createTextNode('Details'));
+
+while (i--) {
+ first = firstNode(details[i]);
+
+ if (first != null && first.nodeName.toUpperCase() == 'SUMMARY') {
+ // we've found that there's a details label already
+ } else {
+ // first = label.cloneNode(true); // cloned nodes weren't picking up styles in IE - random
+ first = document.createElement('summary');
+ first.appendChild(document.createTextNode('Details'));
+ if (details[i].firstChild) {
+ details[i].insertBefore(first, details[i].firstChild);
+ } else {
+ details[i].appendChild(first);
+ }
+ }
+
+ // this feels *really* nasty, but we can't target details :text in css :(
+ j = details[i].childNodes.length;
+ while (j--) {
+ if (details[i].childNodes[j].nodeName === '#text' && (details[i].childNodes[j].nodeValue||'').replace(/\s/g, '').length) {
+ wrapper = document.createElement('text');
+ wrapper.appendChild(details[i].childNodes[j]);
+ details[i].insertBefore(wrapper, details[i].childNodes[j]);
+ }
+ }
+
+ first.legend = true;
+ first.tabIndex = 0;
}
+
+// trigger details in case this being used on it's own
+document.createElement('details');
+addEvent(details, 'click', toggleDetails);
+addEvent(details, 'keypress', toggleDetails);
+addStyle();
+
+})(window, document);
+</script>
-static void listener_stacktrace_callback(...) /* the usual callback boilerplate here */
-{
- current_begin_hook = s7_begin_hook(s7); /* save current begin_hook function */
- if (current_begin_hook) /* s7 is running, so... */
- s7_set_begin_hook(s7, stacktrace_begin_hook); /* insert our stacktrace function in its place */
-}
-</pre>
-</td></tr></table>
+</body>
+</html>
-<br><br>
+<!--
+circular env without set!:
+(let ()
+ (let ((b (curlet)))
+ (curlet)))
-</body>
-</html>
+circular func (implicit set!):
+(letrec* ((b (lambda () (a)))
+ (a (lambda () (b))))
+ (a))
+(letrec ((b (lambda () (a)))
+ (a (lambda () (b))))
+ (a))
+-->
diff --git a/s7test.scm b/s7test.scm
index c346c2f..e5d95c9 100644
--- a/s7test.scm
+++ b/s7test.scm
@@ -3,15 +3,14 @@
;;; sources include
;;; clisp test suite
;;; sbcl test suite
-;;; Paul Dietz's CL test suite
+;;; Paul Dietz's CL test suite (gcl/ansi-tests/*)
;;; R Kelsey, W Clinger, and J Rees r5rs.html (and r6rs.html)
;;; A Jaffer's r4rstest.scm (the inspiration for this...)
;;; guile test suite
;;; gauche test suite
-;;; gambit test suite
;;; sacla test suite
;;; Kent Dybvig's "The Scheme Programming Language"
-;;; Brad Lucier (who also pointed out many bugs)
+;;; Brad Lucier and Peter Bex
;;; GSL tests
;;; Abramowitz and Stegun, "Handbook of Mathematical Functions"
;;; Weisstein, "Encyclopedia of Mathematics"
@@ -21,12 +20,211 @@
;;; N Higham, "Accuracy and Stability of Numerical Algorithms"
;;; various mailing lists and websites (see individual cases below)
+(define full-test #f) ; this includes some time-consuming stuff
(define with-bignums (provided? 'gmp)) ; scheme number has any number of bits
- ; we assume s7_Double is double, and s7_Int is long long int
+ ; we assume s7_double is double, and s7_int is long long int
; a few of the bignum tests assume the default bignum-precision is 128
-;;; (define pi 3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930382)
-;;; (set! *safety* 1)
+(define with-complex (provided? 'complex-numbers))
+(define with-windows (provided? 'windows))
+(define with-qq-vectors (catch #t (lambda () (integer? (`#(,(*s7* 'safety)) 0))) (lambda any #f)))
+(if (not (defined? 's7test-exits)) (define s7test-exits #t))
+
+
+;;; ---------------- pure-s7 ----------------
+(define pure-s7 (provided? 'pure-s7))
+(when pure-s7
+ (define (make-polar mag ang)
+ (if (and (real? mag) (real? ang))
+ (complex (* mag (cos ang)) (* mag (sin ang)))
+ (error 'wrong-type-arg "make-polar args should be real")))
+ (define make-rectangular complex)
+
+ (define (memq a b) (member a b eq?))
+ (define (memv a b) (member a b eqv?))
+ (define (assq a b) (assoc a b eq?))
+ (define (assv a b) (assoc a b eqv?))
+
+ (define (char-ci=? . chars) (apply char=? (map char-upcase chars)))
+ (define (char-ci<=? . chars) (apply char<=? (map char-upcase chars)))
+ (define (char-ci>=? . chars) (apply char>=? (map char-upcase chars)))
+ (define (char-ci<? . chars) (apply char<? (map char-upcase chars)))
+ (define (char-ci>? . chars) (apply char>? (map char-upcase chars)))
+
+ (define (string-ci=? . strs) (apply string=? (map string-upcase strs)))
+ (define (string-ci<=? . strs) (apply string<=? (map string-upcase strs)))
+ (define (string-ci>=? . strs) (apply string>=? (map string-upcase strs)))
+ (define (string-ci<? . strs) (apply string<? (map string-upcase strs)))
+ (define (string-ci>? . strs) (apply string>? (map string-upcase strs)))
+
+ (define (list->string lst) (apply string lst))
+ (define (list->vector lst) (apply vector lst))
+
+ (define (let->list e)
+ (if (let? e)
+ (reverse! (map values e))
+ (error 'wrong-type-arg "let->list argument should be an environment: ~A" str)))
+
+ (define* (string->list str (start 0) end)
+ (if (and (string? str)
+ (integer? start)
+ (not (negative? start))
+ (or (not end)
+ (and (integer? end)
+ (>= end start))))
+ (map values (substring str start (or end (length str))))
+ (error 'wrong-type-arg "string->list argument should be a string: ~A" str)))
+
+ (define (string-copy str)
+ (if (string? str)
+ (copy str)
+ (error 'wrong-type-arg "string-copy argument should be a string: ~A" str)))
+
+ (define (string-length str)
+ (if (string? str)
+ (length str)
+ (error 'wrong-type-arg "string-length argument should be a string: ~A" str)))
+
+ (define (string-fill! str chr . args)
+ (if (string? str)
+ (apply fill! str chr args)
+ (error 'wrong-type-arg "string-fill! argument should be a string: ~A" str)))
+
+ (define* (vector->list vect (start 0) end)
+ (if (and (vector? vect)
+ (integer? start)
+ (not (negative? start))
+ (or (not end)
+ (and (integer? end)
+ (>= end start))))
+ (if start
+ (let ((stop (or end (length vect))))
+ (if (= start stop)
+ ()
+ (map values (make-shared-vector vect (list (- stop start)) start))))
+ (map values vect))
+ (error 'wrong-type-arg "vector->list argument should be a vector: ~A" vect)))
+
+ (define (vector-length vect)
+ (if (vector? vect)
+ (length vect)
+ (error 'wrong-type-arg "vector-length argument should be a vector: ~A" vect)))
+
+ (define (vector-fill! vect val . args)
+ (if (vector? vect)
+ (apply fill! vect val args)
+ (error 'wrong-type-arg "vector-fill! argument should be a vector: ~A" str)))
+
+ (define (vector-append . args)
+ (if (null? args)
+ #()
+ (if (vector? (car args))
+ (apply append args)
+ (error 'wrong-type-arg "vector-append arguments should be vectors: ~A" args))))
+
+ (define (hash-table-size hash)
+ (if (hash-table? hash)
+ (length hash)
+ (error 'wrong-type-arg "hash-table-size argument should be a hash-table: ~A" hash)))
+
+ (define* (char-ready? p)
+ (and p (not (input-port? p))
+ (error 'wrong-type-arg "char-ready? arg should be an input port")))
+
+ (define (set-current-output-port port) (error 'undefined-function "set-current-output-port is not in pure-s7"))
+ (define (set-current-input-port port) (error 'undefined-function "set-current-input-port is not in pure-s7"))
+
+ (define (exact? n)
+ (if (not (number? n))
+ (error 'wrong-type-arg "exact? argument should be a number: ~A" n)
+ (rational? n)))
+
+ (define (inexact? x)
+ (if (not (number? x))
+ (error 'wrong-type-arg "inexact? argument should be a number: ~A" x)
+ (not (rational? x))))
+
+ (define (inexact->exact x)
+ (if (not (number? x))
+ (error 'wrong-type-arg "inexact->exact argument should be a number: ~A" x)
+ (if (rational? x)
+ x
+ (rationalize x))))
+
+ (define (exact->inexact x)
+ (if (not (number? x))
+ (error 'wrong-type-arg "exact->inexact argument should be a number: ~A" x)
+ (* x 1.0)))
+
+ (define (integer-length i)
+ (if (integer? i)
+ (if (zero? i)
+ 0
+ (+ (ceiling (log (abs i) 2))
+ (if (and (positive? i)
+ (zero? (logand i (- i 1))))
+ 1 0)))
+ (error 'wrong-type-arg "integer-length argument should be an integer: ~A" x)))
+
+ (set! *#readers* (list (cons #\i (lambda (str) (* 1.0 (string->number (substring str 1)))))
+ (cons #\e (lambda (str) (floor (string->number (substring str 1)))))))
+ ;; one problem (of many): (string->number "#e0a" 16) -- no simple way to tell the #e reader that we want base 16
+ ;; similarly #x#if -- so in pure-s7, the reader complains
+
+ (define-macro (defmacro name args . body) `(define-macro ,(cons name args) , at body))
+ (define-macro (defmacro* name args . body) `(define-macro* ,(cons name args) , at body))
+
+ (define-macro (call-with-values producer consumer) `(,consumer (,producer)))
+
+ (define-macro (multiple-value-bind vars expression . body) ; named "receive" in srfi-8 which strikes me as perverse
+ (if (or (symbol? vars) (negative? (length vars)))
+ `((lambda ,vars , at body) ,expression)
+ `((lambda* (, at vars . ,(gensym)) , at body) ,expression)))
+
+ (define-macro (multiple-value-set! vars expr . body)
+ (let ((local-vars (map (lambda (n) (gensym)) vars)))
+ `((lambda* (, at local-vars . ,(gensym))
+ ,@(map (lambda (n ln) `(set! ,n ,ln)) vars local-vars)
+ , at body)
+ ,expr)))
+
+ (define-macro (cond-expand . clauses)
+ (letrec ((traverse (lambda (tree)
+ (if (pair? tree)
+ (cons (traverse (car tree))
+ (if (null? (cdr tree)) () (traverse (cdr tree))))
+ (if (memq tree '(and or not else))
+ tree
+ (and (symbol? tree) (provided? tree)))))))
+ `(cond ,@(map (lambda (clause)
+ (cons (traverse (car clause))
+ (if (null? (cdr clause)) '(#f) (cdr clause))))
+ clauses))))
+ )
+;;; ---------------- end pure-s7 ----------------
+
+(define tmp-output-file "tmp1.r5rs")
+(define tmp-data-file "test.dat")
+(define bold-text (format #f "~C[1m" #\escape))
+(define unbold-text (format #f "~C[22m" #\escape))
+(set! (hook-functions *unbound-variable-hook*) ())
+(set! (hook-functions *missing-close-paren-hook*) ())
+(define s7test-output #f) ; if a string, it's treated as a logfile
+;(set! (*s7* 'gc-stats) #t)
+;(set! (*s7* 'undefined-identifier-warnings) #t)
+
+(define old-stdin *stdin*)
+(define old-stdout *stdout*)
+(define old-stderr *stderr*)
+(define *max-arity* #x20000000)
+
+(define (-s7-stack-top-) (*s7* 'stack-top))
+(define -s7-symbol-table-locked? (dilambda
+ (lambda ()
+ (*s7* 'symbol-table-locked?))
+ (lambda (val)
+ (set! (*s7* 'symbol-table-locked?) val))))
+
;;; --------------------------------------------------------------------------------
@@ -34,35 +232,87 @@
(defined? 'mus-rand-seed))
(set! (mus-rand-seed) (current-time)))
-(define (ok? tst result expected)
- (if (not (equal? result expected))
- (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) tst result expected)))
+(define (format-logged . args)
+ ;(if (not (eq? (current-output-port) old-stdout)) (apply format (cons old-stdout (cdr args))))
+ (let ((str (apply format args)))
+ ;(if (eq? (car args) #t) (flush-output-port (current-output-port)))
+ (if (string? s7test-output)
+ (let ((p (open-output-file s7test-output "a")))
+ (display str p)
+ (flush-output-port p)
+ (close-output-port p)))
+ str))
+
+;(define error-port (open-output-file "err"))
+
+(define (show-error args tst)
+ (if (or (not (pair? args))
+ (not (pair? (cdr args)))
+ (not (pair? (cadr args)))
+ (not (string? (caadr args))))
+ (format *stderr* "~S -> ~S?~%" tst args)
+ (let ((type (car args))
+ (info (cadr args)))
+ (let ((str (apply format #f info)))
+ (format error-port "~S -> ~S ~S~%" tst type str)))))
+
+
+(define (ok? otst ola oexp)
+ (let ((result (catch #t ola
+ (lambda args
+ ;(show-error args otst)
+ (if (not (eq? oexp 'error))
+ (begin (display args) (newline)))
+ 'error))))
+ (if (not (equal? result oexp))
+ (format-logged #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp))))
+
+(if (not (defined? 'test))
+ (define-macro (test tst expected) ;(display tst *stderr*) (newline *stderr*)
+ ;; `(ok? ',tst (lambda () (eval-string (format #f "~S" ',tst))) ,expected))
+ ;; `(ok? ',tst (lambda () (eval ',tst)) ,expected))
+ ;; `(ok? ',tst (lambda () ,tst) ,expected))
+ ;; `(ok? ',tst (lambda () (eval-string (object->string ,tst :readable))) ,expected))
+ ;; `(ok? ',tst (let () (define (_s7_) ,tst)) ,expected))
+ ;; `(ok? ',tst (lambda () (let ((_s7_ #f)) (set! _s7_ ,tst))) ,expected))
+ ;; `(ok? ',tst (lambda () (let ((_s7_ ,tst)) _s7_)) ,expected))
+ ;; `(ok? ',tst (catch #t (lambda () (lambda* ((_a_ ,tst)) _a_)) (lambda any (lambda () 'error))) ,expected))
+ ;; `(ok? ',tst (lambda () (do ((_a_ ,tst)) (#t _a_))) ,expected))
+ ;; `(ok? ',tst (lambda () (call-with-exit (lambda (_a_) (_a_ ,tst)))) ,expected))
+ ;; `(ok? ',tst (lambda () (values ,tst)) ,expected))
+ ;; `(ok? ',tst (lambda () (define (_s7_ _a_) _a_) (_s7_ ,tst)) ,expected))
+ ;; `(ok? ',tst (lambda () (define* (_s7_ (_a_ #f)) (or _a_)) (_s7_ ,tst)) ,expected))
+ ({list} 'ok? ({list} quote tst) ({list} lambda () tst) expected))
+ )
+
-(defmacro test (tst expected) ;(display tst) (newline)
- `(let ((result (catch #t
- (lambda () ,tst)
+(define (tok? otst ola)
+ (let* ((data #f)
+ (result (catch #t ola
(lambda args
- (if (not (eq? ,expected 'error))
- (begin (display args) (newline)))
- 'error))))
- (ok? ',tst result ,expected)))
-
-(defmacro test-t (tst) ;(display tst) (newline)
- `(let ((result (catch #t (lambda () ,tst) (lambda args 'error))))
- (if (or (not result)
- (eq? result 'error))
- (format #t "~A: ~A got ~S~%~%" (port-line-number) ',tst result))))
-
-(defmacro test-e (tst op arg) ;(display tst) (newline)
- `(let ((result (catch #t (lambda () ,tst) (lambda args 'error))))
+ ;(show-error args otst)
+ (set! data args)
+ 'error))))
+ (if (or (not result)
+ (eq? result 'error))
+ (format-logged #t "~A: ~A got ~S ~A~%~%" (port-line-number) otst result (or data "")))))
+
+(define-macro (test-t tst) ;(display tst *stderr*) (newline *stderr*)
+ `(tok? ',tst (lambda () ,tst)))
+
+(define-macro (test-e tst op arg) ;(display tst *stderr*) (newline *stderr*)
+ `(let ((result (catch #t (lambda () ,tst)
+ (lambda args
+ ;(show-error args ',tst)
+ 'error))))
(if (not (eq? result 'error))
- (format #t "~A: (~A ~S) got ~S but expected 'error~%~%" (port-line-number) ,op ,arg result))))
+ (format-logged #t "~A: (~A ~S) got ~S but expected 'error~%~%" (port-line-number) ,op ,arg result))))
(define (op-error op result expected)
(define (conjugate n)
- (make-rectangular (real-part n) (- (imag-part n))))
+ (complex (real-part n) (- (imag-part n))))
(if (and (real? result)
(real? expected))
@@ -103,30 +353,15 @@
(define error-6 1e-6)
(define (number-ok? tst result expected)
-#|
- (if (or (and (integer? expected)
- (not (integer? result)))
- (and (rational? expected)
- (not (rational? result)))
- (and (real? expected)
- (not (real? result)))
- (and (nan? expected)
- (not (nan? result)))
- (and (infinite? expected)
- (not (infinite? result))))
- (format #t "~A: ~A got ~A~Abut expected ~A~%"
- (port-line-number) tst result
- (if (and (rational? result) (not (rational? expected)))
- (format #f " (~A) " (* 1.0 result))
- " ")
- expected))
-|#
(if (not (eq? result expected))
(if (or (and (not (number? expected))
(not (eq? result expected)))
- (and (nan? expected)
+ (and (number? expected)
+ (nan? expected)
(not (nan? result)))
- (and (nan? result)
+ (and (number? result)
+ (nan? result)
+ (number? expected)
(not (nan? expected)))
(and (number? expected)
(or (not (number? result))
@@ -138,125 +373,684 @@
(rational? result))
(real? expected)
(real? result)
- (> (abs (- result expected)) error-12))
+ (> (/ (abs (- result expected)) (max 1.0 (abs expected))) error-12))
(and (pair? tst)
(> (op-error (car tst) result expected) error-6)))
- (begin
- (format #t "~A: ~A got ~A~Abut expected ~A~%"
+
+ (format-logged #t "~A: ~A got ~A~Abut expected ~A~%~%"
(port-line-number) tst result
(if (and (rational? result) (not (rational? expected)))
(format #f " (~A) " (* 1.0 result))
" ")
- expected)
-
- (if (and (not (number? expected))
- (not (eq? result expected)))
- (format #t ", (eq? ~A ~A) -> #f" result expected)
- (if (and (number? expected)
- (or (not (number? result))
- (nan? result)))
- (begin
- (if (not (number? result))
- (format #t ", (number? ~A) but not (number? ~A)" expected result)
- (format #t ", (number? ~A) but (nan? ~A)" expected result)))
- (if (and (rational? expected)
- (rational? result)
- (not (= result expected)))
- (format #t ", exact results but not (= ~A ~A): ~A" expected result (= result expected))
- (if (and (or (rational? expected)
- (rational? result))
- (real? expected)
- (real? result)
- (> (abs (- result expected)) error-12))
- (format #t ", rational results but diff > ~A: ~A" error-12 (abs (- result expected)))
- (if (and (pair? tst)
- (< (op-error (car tst) result expected) error-6))
- (let ((n result))
- (format #t ", result not internally consistent")
- (if (and (integer? n)
- (or (not (= (denominator n) 1))
- (not (= n (numerator n)))
- (not (zero? (imag-part n)))
- (not (= (floor n) (ceiling n) (truncate n) (round n) n))
- (not (= n (real-part n)))))
- (format #t ", ~A integer but den: ~A, num: ~A, imag: ~A, real: ~A, floors: ~A ~A ~A ~A"
- n (denominator n) (numerator n) (imag-part n) (real-part n)
- (floor n) (ceiling n) (truncate n) (round n))
- (if (and (rational? n)
- (not (integer? n))
- (or (not (zero? (imag-part n)))
- (= (denominator n) 1)
- (= (denominator n) 0)
- (not (= n (real-part n)))
- (not (= n (/ (numerator n) (denominator n))))))
- (format #t ", ~A ratio but imag: ~A, den: ~A, real: ~A, ~A/~A=~A"
- n (imag-part n) (denominator n) (real-part n)
- (numerator n) (denominator n) (* 1.0 (/ (numerator n) (denominator n))))
- (if (and (real? n)
- (not (rational? n))
- (or (not (zero? (imag-part n)))
- (not (= n (real-part n)))))
- (format #t ", ~A real but rational: ~A, imag: ~A, real: ~A"
- n (rational? n) (imag-part n) (real-part n))
- (format #t ", ~A complex but real? ~A, imag: ~A, ~A+~A=~A"
- n (real? n) (imag-part n) (real-part n) (imag-part n)
- (+ (real-part n) (* 0+i (imag-part n)))))))))))))
- (newline) (newline)))))
-
-(defmacro num-test (tst expected) ;(display tst) (newline)
- `(let ((result (catch #t (lambda () ,tst) (lambda args 'error))))
- (number-ok? ',tst result ,expected)))
+ expected))))
+
+(define (nok? otst ola oexp)
+ (let ((result (catch #t ola
+ (lambda args
+ ;(show-error args otst)
+ 'error))))
+ (number-ok? otst result oexp)))
+
+(if (not (defined? 'num-test))
+ (define-macro (num-test tst expected) ;(display tst *stderr*) (newline *stderr*)
+ ;; `(nok? ',tst (lambda () ,tst) ,expected))
+ ;; `(nok? ',tst (let () (define (_s7_) ,tst)) ,expected))
+ ({list} 'nok? ({list} quote tst) ({list} lambda () tst) expected)))
(define-macro (num-test-1 proc val tst expected)
- `(let ((result (catch #t (lambda () ,tst) (lambda args 'error))))
+ `(let ((result (catch #t (lambda () ,tst)
+ (lambda args
+ ;(show-error args ',tst)
+ 'error))))
(number-ok? (list ,proc ,val) result ,expected)))
(define-macro (num-test-2 proc val1 val2 tst expected)
- `(let ((result (catch #t (lambda () ,tst) (lambda args 'error))))
+ `(let ((result (catch #t (lambda () ,tst)
+ (lambda args
+ ;(show-error args ',tst)
+ 'error))))
(number-ok? (list ,proc ,val1 ,val2) result ,expected)))
-(define-macro (reinvert n op1 op2 arg)
- (let ((body `(,op2 (,op1 ,arg))))
+(define (reinvert n op1 op2 arg)
+ (let ((body (op2 (op1 arg))))
(do ((i 1 (+ i 1)))
- ((= i n))
- (set! body `(,op2 (,op1 ,body))))
- body))
-
-(define-macro (recompose n op arg)
+ ((= i n) body)
+ (set! body (op2 (op1 body))))))
+
+(define (recompose n op arg)
(define (recompose-1 n)
(if (= n 1)
- `(,op ,arg)
- `(,op ,(recompose-1 (- n 1)))))
+ (op arg)
+ (op (recompose-1 (- n 1)))))
(recompose-1 n))
-(define-macro (with-evaluator . body)
- (if (provided? 'threads)
- `(join-thread (make-thread (lambda () , at body) 200))
- ''error)) ; yow! otherwise we get the error procedure, not the symbol 'error!
+(if (symbol-access 'val) (set! (symbol-access 'val) #f)) ; might get here from snd-test
(define _ht_ (make-hash-table))
;;; --------------------------------------------------------------------------------
-;;; GENERIC STUFF
-;;; --------------------------------------------------------------------------------
+;;; before starting, make a test c-object
+
+(define with-block (not (provided? 'windows)))
+
+(if with-block
+ (begin
+ (call-with-output-file "s7test-block.c"
+ (lambda (p)
+ (format p "
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include \"s7.h\"
+static s7_scheme *s7;
+
+/* c-object tests */
+typedef struct {
+ size_t size;
+ double *data;
+} g_block;
+
+static int g_block_type = 0;
+static s7_pointer g_block_methods;
+
+static s7_pointer g_make_block(s7_scheme *sc, s7_pointer args)
+{
+ #define g_make_block_help \"(make-block size) returns a new block of the given size\"
+ g_block *g;
+ s7_pointer new_g;
+ s7_int size;
+ if (!s7_is_integer(s7_car(args)))
+ return(s7_wrong_type_arg_error(sc, \"make-block\", 1, s7_car(args), \"an integer\"));
+ size = s7_integer(s7_car(args));
+ if ((size < 0) ||
+ (size > 1073741824))
+ return(s7_out_of_range_error(sc, \"make-block\", 1, s7_car(args), \"should be something reasonable\"));
+ g = (g_block *)calloc(1, sizeof(g_block));
+ g->size = (size_t)size;
+ g->data = (double *)calloc(g->size, sizeof(double));
+ new_g = s7_make_object(sc, g_block_type, (void *)g);
+ s7_object_set_let(new_g, g_block_methods);
+ s7_openlet(sc, new_g);
+ return(new_g);
+}
+
+static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args)
+{
+ #define g_block_help \"(block ...) returns a block object with the arguments as its contents.\"
+ s7_pointer p, b;
+ size_t i, len;
+ g_block *gb;
+ len = s7_list_length(sc, args);
+ b = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
+ gb = (g_block *)s7_object_value(b);
+ for (i = 0, p = args; i < len; i++, p = s7_cdr(p))
+ gb->data[i] = s7_number_to_real(sc, s7_car(p));
+ return(b);
+}
+
+static char *block_write_readably(s7_scheme *sc, void *value)
+{
+ g_block *b = (g_block *)value;
+ int i, len;
+ char *buf;
+ char flt[64];
+ len = b->size;
+ buf = (char *)calloc((len + 1) * 64, sizeof(char));
+ snprintf(buf, (len + 1) * 64, \"(block\");
+ for (i = 0; i < len; i++)
+ {
+ snprintf(flt, 64, \" %.3f\", b->data[i]);
+ strcat(buf, flt);
+ }
+ strcat(buf, \")\");
+ return(buf);
+}
+
+static char *g_block_display(s7_scheme *sc, void *value)
+{
+ g_block *b = (g_block *)value;
+ if (b->size < 6)
+ return(block_write_readably(sc, value));
+ return(strdup(\"(block ...)\"));
+}
+
+static void g_block_free(void *value)
+{
+ g_block *g = (g_block *)value;
+ free(g->data);
+ free(g);
+}
+
+static bool g_block_is_equal(void *val1, void *val2)
+{
+ int i, len;
+ g_block *b1 = (g_block *)val1;
+ g_block *b2 = (g_block *)val2;
+ if (val1 == val2) return(true);
+ len = b1->size;
+ if (len != b2->size) return(false);
+ for (i = 0; i < len; i++)
+ if (b1->data[i] != b2->data[i])
+ return(false);
+ return(true);
+}
+
+static void g_block_mark(void *val)
+{
+ /* nothing to mark */
+}
+
+static s7_pointer g_is_block(s7_scheme *sc, s7_pointer args)
+{
+ #define g_is_block_help \"(block? obj) returns #t if obj is a block.\"
+ return(s7_make_boolean(sc, s7_object_type(s7_car(args)) == g_block_type));
+}
+
+static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ g_block *g = (g_block *)s7_object_value(obj);
+ size_t index;
+ s7_pointer ind;
+ if (s7_is_null(sc, args)) /* this is for an (obj) test */
+ return(s7_make_integer(sc, 32));
+ ind = s7_car(args);
+ if (!s7_is_integer(ind))
+ {
+ if (s7_is_symbol(ind))
+ return(s7_symbol_local_value(sc, ind, g_block_methods));
+ return(s7_wrong_type_arg_error(sc, \"block-ref\", 1, ind, \"an integer\"));
+ }
+ index = (size_t)s7_integer(ind);
+ if (index < g->size)
+ return(s7_make_real(sc, g->data[index]));
+ return(s7_out_of_range_error(sc, \"block-ref\", 2, ind, \"should be less than block length\"));
+}
+
+static s7_pointer g_block_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ g_block *g = (g_block *)s7_object_value(obj);
+ s7_int index;
+ if (!s7_is_integer(s7_car(args)))
+ return(s7_wrong_type_arg_error(sc, \"block-set!\", 1, s7_car(args), \"an integer\"));
+ index = s7_integer(s7_car(args));
+ if ((index >= 0) && (index < g->size))
+ {
+ g->data[index] = s7_number_to_real(sc, s7_cadr(args));
+ return(s7_cadr(args));
+ }
+ return(s7_out_of_range_error(sc, \"block-set\", 2, s7_car(args), \"should be less than block length\"));
+}
+
+static s7_double c_block_ref(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ s7_if_t xf;
+ g_block *g;
+ g = (g_block *)(**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ ind = xf(sc, p);
+ return(g->data[ind]);
+}
+
+static s7_double c_block_set(s7_scheme *sc, s7_pointer **p)
+{
+ s7_int ind;
+ s7_double x;
+ s7_rf_t rf;
+ s7_if_t xf;
+ g_block *g;
+ g = (g_block *)(**p); (*p)++;
+ xf = (s7_if_t)(**p); (*p)++;
+ ind = xf(sc, p);
+ rf = (s7_rf_t)(**p); (*p)++;
+ x = rf(sc, p);
+ g->data[ind] = x;
+ return(x);
+}
+
+static s7_rf_t block_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer a1, gs;
+ a1 = s7_car(expr);
+ if ((s7_is_symbol(a1)) &&
+ (s7_object_type(gs = s7_symbol_value(sc, a1)) == g_block_type))
+ {
+ s7_xf_store(sc, (s7_pointer)s7_object_value(gs));
+ if (s7_arg_to_if(sc, s7_cadr(expr))) return(c_block_ref);
+ }
+ return(NULL);
+}
+
+static s7_rf_t block_set_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer a1, gs;
+ a1 = s7_cadr(expr);
+ if ((!s7_is_pair(a1)) || (!s7_is_symbol(s7_car(a1))) || (!s7_is_null(sc, s7_cddr(a1)))) return(NULL);
+ gs = s7_symbol_value(sc, s7_car(a1));
+ if (s7_object_type(gs) == g_block_type)
+ {
+ s7_xf_store(sc, (s7_pointer)s7_object_value(gs));
+ if (!s7_arg_to_if(sc, s7_cadr(a1))) return(NULL);
+ if (!s7_arg_to_rf(sc, s7_caddr(expr))) return(NULL);
+ return(c_block_set);
+ }
+ return(NULL);
+}
+
+static s7_pointer block_direct_ref(s7_scheme *sc, s7_pointer obj, s7_int index)
+{
+ g_block *g;
+ g = (g_block *)s7_object_value(obj);
+ return(s7_make_real(sc, g->data[index]));
+}
+
+static s7_pointer block_direct_set(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val)
+{
+ g_block *g;
+ g = (g_block *)s7_object_value(obj);
+ g->data[index] = s7_number_to_real(sc, val);
+ return(val);
+}
+
+static s7_pointer g_block_length(s7_scheme *sc, s7_pointer obj)
+{
+ g_block *g = (g_block *)s7_object_value(obj);
+ return(s7_make_integer(sc, g->size));
+}
+
+static int get_start_and_end(s7_scheme *sc, s7_pointer args, int *start, int end)
+{
+ if (s7_is_pair(s7_cdr(args)))
+ {
+ s7_pointer p;
+ p = s7_cadr(args);
+ if (s7_is_integer(p))
+ {
+ int nstart;
+ nstart = s7_integer(p);
+ if ((nstart < 0) || (nstart >= end))
+ {s7_out_of_range_error(sc, \"subblock\", 2, p, \"should be less than block length\"); return(0);}
+ *start = nstart;
+ }
+ if (s7_is_pair(s7_cddr(args)))
+ {
+ p = s7_caddr(args);
+ if (s7_is_integer(p))
+ {
+ int nend;
+ nend = s7_integer(p);
+ if (nend <= *start)
+ {s7_out_of_range_error(sc, \"subblock\", 3, p, \"should be greater than the start point\"); return(0);}
+ if (nend < end) end = nend;
+ }
+ }
+ }
+ return(end - *start);
+}
+
+static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer new_g, obj;
+ g_block *g, *g1;
+ size_t len;
+ int start = 0;
+ obj = s7_car(args);
+ g = (g_block *)s7_object_value(obj);
+ len = g->size;
+ if (s7_is_pair(s7_cdr(args)))
+ {
+ new_g = s7_cadr(args);
+ if (s7_object_type(new_g) != g_block_type) /* fall back on the float-vector code using a wrapper */
+ {
+ int gc_loc;
+ s7_pointer v;
+ v = s7_make_float_vector_wrapper(sc, len, g->data, 1, NULL, false);
+ gc_loc = s7_gc_protect(sc, v);
+ new_g = s7_copy(sc, s7_append(sc, s7_list(sc, 1, v), s7_cdr(args)));
+ s7_gc_unprotect_at(sc, gc_loc);
+ return(new_g);
+ }
+ if (s7_is_pair(s7_cddr(args)))
+ len = get_start_and_end(sc, s7_cdr(args), &start, len);
+ }
+ else new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
+ g1 = (g_block *)s7_object_value(new_g);
+ if (g1->size < len) len = g1->size;
+ memcpy((void *)(g1->data), (void *)(g->data + start), len * sizeof(double));
+ return(new_g);
+}
+
+static s7_pointer g_block_append(s7_scheme *sc, s7_pointer args)
+{
+ #define g_block_append_help \"(append block...) returns a new block containing the argument blocks concatenated.\"
+ int i, len = 0;
+ s7_pointer p, new_g;
+ g_block *g;
+ for (i = 0, p = args; s7_is_pair(p); p = s7_cdr(p), i++)
+ {
+ g_block *g1;
+ if (s7_object_type(s7_car(p)) != g_block_type)
+ return(s7_wrong_type_arg_error(sc, \"block-append\", i, s7_car(p), \"a block\"));
+ g1 = (g_block *)s7_object_value(s7_car(p));
+ len += g1->size;
+ }
+ new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
+ g = (g_block *)s7_object_value(new_g);
+ for (i = 0, p = args; s7_is_pair(p); p = s7_cdr(p))
+ {
+ g_block *g1;
+ g1 = (g_block *)s7_object_value(s7_car(p));
+ memcpy((void *)(g->data + i), (void *)(g1->data), g1->size * sizeof(double));
+ i += g1->size;
+ }
+ return(new_g);
+}
+
+static s7_pointer g_block_reverse(s7_scheme *sc, s7_pointer args)
+{
+ size_t i, j;
+ g_block *g, *g1;
+ s7_pointer new_g;
+ g = (g_block *)s7_object_value(s7_car(args));
+ new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
+ g1 = (g_block *)s7_object_value(new_g);
+ for (i = 0, j = g->size - 1; i < g->size; i++, j--)
+ g1->data[i] = g->data[j];
+ return(new_g);
+}
+
+static s7_pointer g_block_reverse_in_place(s7_scheme *sc, s7_pointer args)
+{
+ #define g_block_reverse_in_place_help \"(block-reverse! block) returns block with its data reversed.\"
+ size_t i, j;
+ g_block *g;
+ s7_pointer obj;
+ obj = s7_car(args);
+ if (s7_object_type(obj) != g_block_type)
+ return(s7_wrong_type_arg_error(sc, \"block-reverse!\", 0, obj, \"a block\"));
+ g = (g_block *)s7_object_value(obj);
+ if (g->size < 2) return(obj);
+ for (i = 0, j = g->size - 1; i < j; i++, j--)
+ {
+ double temp;
+ temp = g->data[i];
+ g->data[i] = g->data[j];
+ g->data[j] = temp;
+ }
+ return(obj);
+}
+
+static s7_pointer g_block_fill(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer obj, val;
+ size_t i, len;
+ int start = 0;
+ double fill_val;
+ g_block *g;
+ obj = s7_car(args);
+ val = s7_cadr(args);
+ g = (g_block *)s7_object_value(obj);
+ fill_val = s7_number_to_real(sc, val);
+ len = g->size;
+ if (s7_is_pair(s7_cddr(args)))
+ len = get_start_and_end(sc, s7_cdr(args), &start, len);
+ if (fill_val == 0.0)
+ memset((void *)(g->data + start), 0, len * sizeof(double));
+ else
+ {
+ for (i = 0; i < len; i++)
+ g->data[i + start] = fill_val;
+ }
+ return(obj);
+}
+
+static s7_pointer g_blocks(s7_scheme *sc, s7_pointer args)
+{
+ return(s7_copy(sc, s7_list(sc, 1, args)));
+}
+
+static s7_pointer g_subblock(s7_scheme *sc, s7_pointer args)
+{
+ #define g_subblock_help \"(subblock block (start 0) end) returns a portion of the block.\"
+ s7_pointer p, new_g, obj;
+ int start = 0, new_len, i;
+ g_block *g, *g1;
+ obj = s7_car(args);
+ if (s7_object_type(obj) != g_block_type)
+ return(s7_wrong_type_arg_error(sc, \"subblock\", 1, obj, \"a block\"));
+ g = (g_block *)s7_object_value(obj);
+ new_len = get_start_and_end(sc, args, &start, g->size);
+ new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, new_len), s7_nil(sc)));
+ g1 = (g_block *)s7_object_value(new_g);
+ memcpy((void *)(g1->data), (void *)(g->data + start), new_len * sizeof(double));
+ return(new_g);
+}
+
+
+/* function port tests */
+static unsigned char *fout = NULL;
+static unsigned int fout_size = 0, fout_loc = 0;
+static void foutput(s7_scheme *sc, unsigned char c, s7_pointer port)
+{
+ if (fout_size == fout_loc)
+ {
+ if (fout_size == 0)
+ {
+ fout_size = 128;
+ fout = (unsigned char *)malloc(fout_size * sizeof(unsigned char));
+ }
+ else
+ {
+ fout_size += 128;
+ fout = (unsigned char *)realloc(fout, fout_size * sizeof(unsigned char));
+ }
+ }
+ fout[fout_loc++] = c;
+}
+
+static s7_pointer fout_open(s7_scheme *sc, s7_pointer args)
+{
+ return(s7_open_output_function(sc, foutput));
+}
+
+static s7_pointer fout_get_output(s7_scheme *sc, s7_pointer args)
+{
+ foutput(sc, 0, s7_car(args)); /* make sure it's null-terminated */
+ return(s7_make_string_with_length(sc, (const char *)fout, fout_loc - 1));
+}
+
+static s7_pointer fout_close(s7_scheme *sc, s7_pointer args)
+{
+ fout_loc = 0;
+ return(s7_car(args));
+}
+
+static const char *fin = NULL;
+static unsigned int fin_size = 0, fin_loc = 0;
+static s7_pointer finput(s7_scheme *sc, s7_read_t peek, s7_pointer port)
+{
+ switch (peek)
+ {
+ case S7_READ_BYTE:
+ return(s7_make_integer(sc, (int)fin[fin_loc++]));
+ case S7_READ_CHAR:
+ return(s7_make_character(sc, fin[fin_loc++]));
+ case S7_PEEK_CHAR:
+ return(s7_make_character(sc, fin[fin_loc]));
+ case S7_READ_LINE:
+ {
+ unsigned int i;
+ s7_pointer result;
+ for (i = fin_loc; (i < fin_size) && (fin[i] != '\\n'); i++);
+ result = s7_make_string_with_length(sc, (char *)(fin + fin_loc), i - fin_loc);
+ fin_loc = i + 1;
+ return(result);
+ }
+ case S7_IS_CHAR_READY:
+ return(s7_make_boolean(sc, fin_loc < fin_size));
+ case S7_READ:
+ return(s7_error(sc, s7_make_symbol(sc, \"read-error\"), s7_make_string(sc, \"can't read yet!\")));
+ }
+}
+
+static s7_pointer fin_open(s7_scheme *sc, s7_pointer args)
+{
+ /* arg = string to read */
+ s7_pointer str;
+ fin_loc = 0;
+ str = s7_car(args);
+ fin = s7_string(str); /* assume caller will GC protect the string */
+ fin_size = s7_string_length(str);
+ return(s7_open_input_function(sc, finput));
+}
+
+/* dilambda test */
+static s7_pointer g_dilambda_test(s7_scheme *sc, s7_pointer args) {return(s7_f(sc));}
+static s7_pointer g_dilambda_set_test(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+
+/* hash-table tests */
+static s7_pointer g_hloc(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, 0));}
+static s7_pointer g_heq(s7_scheme *sc, s7_pointer args) {return(s7_make_boolean(sc, s7_is_eq(s7_car(args), s7_cadr(args))));}
+
+/* optimizer tests */
+static s7_pointer g_cf10(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf11(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cs11(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+
+static s7_pointer g_cf20(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf21(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf22(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));}
+
+static s7_pointer g_cf30(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf31(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf32(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));}
+static s7_pointer g_cf33(s7_scheme *sc, s7_pointer args) {return(s7_caddr(args));}
+
+static s7_pointer g_cf41(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+static s7_pointer g_cf42(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));}
+static s7_pointer g_cf43(s7_scheme *sc, s7_pointer args) {return(s7_caddr(args));}
+static s7_pointer g_cf44(s7_scheme *sc, s7_pointer args) {return(s7_cadddr(args));}
+static s7_pointer g_rs11(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));}
+
+static s7_pointer g_cf51(s7_scheme *sc, s7_pointer args) {return(s7_car(args));}
+
+void block_init(s7_scheme *sc);
+void block_init(s7_scheme *sc)
+{
+ s7_pointer cur_env;
+ cur_env = s7_outlet(sc, s7_curlet(sc));
+ g_block_type = s7_new_type_x(sc, \"#<block>\",
+ g_block_display, g_block_free,
+ g_block_is_equal, g_block_mark,
+ g_block_ref, g_block_set, g_block_length,
+ g_block_copy, g_block_reverse, g_block_fill);
+ s7_set_object_print_readably(g_block_type, block_write_readably);
+ s7_define_function(sc, \"make-block\", g_make_block, 1, 0, false, g_make_block_help);
+ s7_define_function(sc, \"block\", g_to_block, 0, 0, true, g_block_help);
+ s7_define_function(sc, \"subblock\", g_subblock, 1, 0, true, g_subblock_help);
+ s7_define_function(sc, \"block-append\", g_block_append, 0, 0, true, g_block_append_help);
+ s7_define_function(sc, \"block-reverse!\", g_block_reverse_in_place, 1, 0, true, g_block_reverse_in_place_help);
+ s7_define_function(sc, \"block?\", g_is_block, 1, 0, false, g_is_block_help);
+ s7_define_function_star(sc, \"blocks\", g_blocks, \"(frequency 4) (scaler 1)\", \"test for function*\");
+ g_block_methods = s7_eval_c_string(sc, \"(inlet 'float-vector? (lambda (p) #t) \
+ 'subsequence subblock \
+ 'append block-append \
+ 'reverse! block-reverse!)\");
+ s7_gc_protect(sc, g_block_methods);
+ s7_object_type_set_xf(g_block_type, NULL, NULL, block_rf, block_set_rf);
+ s7_object_type_set_direct(g_block_type, block_direct_ref, block_direct_set);
+
+ s7_define_safe_function(sc, \"function-open-output\", fout_open, 0, 0, false, \"\");
+ s7_define_safe_function(sc, \"function-get-output\", fout_get_output, 1, 0, false, \"\");
+ s7_define_safe_function(sc, \"function-close-output\", fout_close, 1, 0, false, \"\");
+ s7_define_safe_function(sc, \"function-open-input\", fin_open, 1, 0, false, \"\");
+
+ s7_define_function_with_setter(sc, \"dilambda-test\", g_dilambda_test, g_dilambda_set_test, 0, 0, \"dilambda-test info\");
+
+ s7_define_safe_function(sc, \"hash_heq\", g_heq, 2, 0, false, \"hash-table test\");
+ s7_define_safe_function(sc, \"hash_hloc\", g_hloc, 1, 0, false, \"hash-table test\");
+
+ s7_define_safe_function(sc, \"cf10\", g_cf10, 1, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf11\", g_cf11, 1, 0, false, \"\");
+ s7_define_safe_function(sc, \"cs11\", g_cs11, 1, 0, false, \"\");
+ s7_define_safe_function(sc, \"rs11\", g_rs11, 1, 0, false, \"\");
+
+ s7_define_safe_function(sc, \"cf20\", g_cf20, 2, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf21\", g_cf21, 2, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf22\", g_cf22, 2, 0, false, \"\");
+
+ s7_define_safe_function(sc, \"cf30\", g_cf30, 3, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf31\", g_cf31, 3, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf32\", g_cf32, 3, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf33\", g_cf33, 3, 0, false, \"\");
+
+ s7_define_safe_function(sc, \"cf41\", g_cf41, 4, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf42\", g_cf42, 4, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf43\", g_cf43, 4, 0, false, \"\");
+ s7_define_safe_function(sc, \"cf44\", g_cf44, 4, 0, false, \"\");
+
+ s7_define_safe_function(sc, \"cf51\", g_cf51, 5, 0, false, \"\");
+}
+")))
+
+(cond ((provided? 'osx)
+ (system "gcc -c s7test-block.c -O2")
+ (system "gcc s7test-block.o -o s7test-block.so -dynamic -bundle -undefined suppress -flat_namespace"))
+
+ ((or (provided? 'freebsd)
+ (provided? 'netbsd))
+ (system "cc -fPIC -c s7test-block.c -O2")
+ (system "cc s7test-block.o -shared -o s7test-block.so -lm -lc"))
+
+ ((provided? 'openbsd)
+ (system "gcc -fPIC -ftrampolines -c s7test-block.c -O2")
+ (system "gcc s7test-block.o -shared -o s7test-block.so -lm -lc"))
+
+ ((provided? 'solaris)
+ (system "gcc -fPIC -c s7test-block.c")
+ (system "gcc s7test-block.o -shared -o s7test-block.so -G -ldl -lm"))
+
+ (else
+ (system "gcc -fPIC -c s7test-block.c -O2")
+ (system "gcc s7test-block.o -shared -o s7test-block.so -ldl -lm -Wl,-export-dynamic")))
+
+(let ((new-env (sublet (curlet) (cons 'init_func 'block_init)))) ; load calls init_func if possible
+ (load "s7test-block.so" new-env))
+
+(define _c_obj_ (make-block 16))
+)
+(define _c_obj_ (c-pointer 0))) ; not with-block
+
+(define _null_ (c-pointer 0))
+
+(when (and (provided? 'linux)
+ (not (provided? 'gmp)))
+ (system "gcc -o ffitest ffitest.c -g3 -Wall s7.o -lm -I. -ldl")
+ (system "ffitest"))
+
+
+;;; --------------------------------------------------------------------------------
;;; eq?
+
(test (eq? 'a 3) #f)
(test (eq? #t 't) #f)
(test (eq? "abs" 'abc) #f)
(test (eq? "hi" '(hi)) #f)
-(test (eq? "()" '()) #f)
+(test (eq? "hi" "hi") #f)
+(test (eq? "()" ()) #f)
(test (eq? '(1) '(1)) #f)
(test (eq? '(#f) '(#f)) #f)
(test (eq? #\a #\b) #f)
(test (eq? #t #t) #t)
(test (eq? #f #f) #t)
(test (eq? #f #t) #f)
-(test (eq? (null? '()) #t) #t)
+(test (eq? (null? ()) #t) #t)
(test (eq? (null? '(a)) #f) #t)
-(test (eq? (cdr '(a)) '()) #t)
+(test (eq? (cdr '(a)) ()) #t)
(test (eq? 'a 'a) #t)
(test (eq? 'a 'b) #f)
(test (eq? 'a (string->symbol "a")) #t)
@@ -270,7 +1064,6 @@
(test (eq? ':a: 'a:) #f)
(test (eq? 'a (symbol "a")) #t)
(test (eq? :: '::) #t)
-;(test (eq? ': (symbol->keyword (symbol ""))) #t)
(test (eq? ':a (symbol->keyword (symbol "a"))) #t) ; but not a:
(test (eq? '(a) '(b)) #f)
(test (let ((x '(a . b))) (eq? x x)) #t)
@@ -279,18 +1072,19 @@
(test (eq? "abc" "cba") #f)
(test (let ((x "hi")) (eq? x x)) #t)
(test (eq? (string #\h #\i) (string #\h #\i)) #f)
-(test (eq? '#(a) '#(b)) #f)
+(test (eq? #(a) #(b)) #f)
(test (let ((x (vector 'a))) (eq? x x)) #t)
(test (eq? (vector 'a) (vector 'a)) #f)
(test (eq? car car) #t)
(test (eq? car cdr) #f)
(test (let ((x (lambda () 1))) (eq? x x)) #t)
(test (let ((x (lambda () 1))) (let ((y x)) (eq? x y))) #t)
+(test (let ((x (lambda () 1))) (let ((y (lambda () 1))) (eq? x y))) #f)
(test (eq? 'abc 'abc) #t)
(test (eq? eq? eq?) #t)
(test (eq? (if #f 1) 1) #f)
-(test (eq? '() '(#||#)) #t)
-(test (eq? '() '(#!@%$&!#)) #t)
+(test (eq? () '(#||#)) #t)
+(test (eq? () '(#|@%$&|#)) #t)
(test (eq? '#||#hi 'hi) #t) ; ??
(test (eq? '; a comment
hi 'hi) #t) ; similar:
@@ -308,8 +1102,13 @@
(test (eq? '() '( )) #t)
(test (eq? '()'()) #t)
(test (eq? '()(list)) #t)
-(test (eq? '() (list)) #t)
+(test (eq? () (list)) #t)
(test (eq? (begin) (append)) #t)
+(test (let ((lst (list 1 2 3))) (eq? lst (apply list lst))) #f) ; changed 26-Sep-11
+
+;(test (eq? 1/0 1/0) #f)
+;(test (let ((+nan.0 1/0)) (eq? +nan.0 +nan.0)) #f)
+;; these are "unspecified" so any boolean value is ok
(test (eq? ''2 '2) #f)
(test (eq? '2 '2) #t) ; unspecified??
@@ -318,7 +1117,7 @@
(test (eq? ''#\a '#\a) #f)
(test (eq? '#\a #\a) #t) ; was #f
(test (eq? 'car car) #f)
-(test (eq? '() ()) #t)
+(test (eq? '()()) #t)
(test (eq? ''() '()) #f)
(test (eq? '#f #f) #t)
(test (eq? '#f '#f) #t)
@@ -330,9 +1129,40 @@
(test (let ((f (lambda () (cons 1 (string #\H))))) (eq? (f) (f))) #f)
(test (eq? *stdin* *stdin*) #t)
(test (eq? *stdout* *stderr*) #f)
+(test (eq? *stdin* *stderr*) #f)
+(test (eq? else else) #t)
+(test (eq? :else else) #f)
+(test (eq? :else 'else) #f)
+(test (eq? :if if) #f)
+(test (eq? 'if 'if) #t)
+(test (eq? :if :if) #t)
+
+(test (eq? (string) (string)) #f)
+(test (eq? (string) "") #f)
+(test (eq? (vector) (vector)) #f)
+(test (eq? (vector) #()) #f)
+(test (eq? (list) (list)) #t)
+(test (eq? (list) ()) #t)
+(test (eq? (hash-table) (hash-table)) #f)
+(test (eq? (curlet) (curlet)) #t)
+(test (eq? (rootlet) (rootlet)) #t)
+(test (eq? (funclet abs) (funclet abs)) #t) ; or any other built-in...
+(test (eq? letrec* letrec*) #t)
-(display ";this should display #t: ")
-(begin #| ; |# (display #t))
+(test (eq? (current-input-port) (current-input-port)) #t)
+(test (eq? (current-error-port) (current-error-port)) #t)
+(test (eq? (current-output-port) (current-output-port)) #t)
+(test (eq? (current-input-port) (current-output-port)) #f)
+
+(test (eq? (string #\a) (string #\a)) #f)
+(test (eq? "a" "a") #f)
+(test (eq? #(1) #(1)) #f)
+(test (let ((a "hello") (b "hello")) (eq? a b)) #f)
+(test (let ((a "foo")) (eq? a (copy a))) #f)
+(test (let ((p (c-pointer 0))) (eq? p (copy p))) #f)
+(test (let ((p (c-pointer 0))) (let ((p1 p)) (eq? p p1))) #t)
+
+(begin #| ; |# (display ""))
(newline)
(test (;
@@ -340,11 +1170,11 @@
(;)()#
);((")";
;"#|)#""
- '#|";"|#(#!;!#); ;#
+ '#|";"|#(#|;|#); ;#
;\;"#"#f
)#t)
-(test (+ #| this is a comment |# 2 #! and this is another !# 3) 5)
+(test (+ #| this is a comment |# 2 #| and this is another |# 3) 5)
(test (eq? #| a comment |# #f #f) #t)
(test (eq? #| a comment |##f #f) #t) ; ??
(test (eq? #| a comment | ##f|##f #f) #t) ; ??
@@ -357,7 +1187,6 @@
(test (+ #| ; |# 3
4)
7)
-;;; Snd's listener is confused by (eq? #||##||##|a;comment|" ##f|##f #f) etc
(test (eq? (if #f #t) (if #f 3)) #t)
@@ -367,37 +1196,199 @@
(test (eq? #f . 1) 'error)
(test (eq #f #f) 'error)
-(let ((things (vector #t #f #\space '() "" 0 1 3/4 1+i 1.5 '(1 .2) '#() (vector) (vector 1) (list 1) 'f 't #\t)))
- (do ((i 0 (+ i 1)))
- ((= i (- (vector-length things) 1)))
+(let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector) (vector 1) (list 1) 'f 't #\t)))
+ (let ((len (length things)))
+ (do ((i 0 (+ i 1)))
+ ((= i (- len 1)))
(do ((j (+ i 1) (+ j 1)))
- ((= j (vector-length things)))
+ ((= j len))
(if (eq? (vector-ref things i) (vector-ref things j))
- (format #t ";(eq? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))
+ (format-logged #t ";(eq? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
;;; these are defined at user-level in s7 -- why are other schemes so coy about them?
(test (eq? (if #f #f) #<unspecified>) #t)
-(test (eof-object? #<eof>) #t)
(test (eq? (symbol->value '_?__undefined__?_) #<undefined>) #t)
(test (eq? #<eof> #<eof>) #t)
(test (eq? #<undefined> #<undefined>) #t)
(test (eq? #<unspecified> #<unspecified>) #t)
(test (eq? #<eof> #<undefined>) #f)
-(test (eq? #<eof> '()) #f)
+(test (eq? #<eof> ()) #f)
(test (let () (define-macro (hi a) `(+ 1 ,a)) (eq? hi hi)) #t)
(test (let () (define (hi a) (+ 1 a)) (eq? hi hi)) #t)
(test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (eq? x x)) #t)
+
(test (eq? quasiquote quasiquote) #t)
(test (eq? `quasiquote 'quasiquote) #t)
+(test (eq? 'if (keyword->symbol :if)) #t)
+(test (eq? 'if (string->symbol "if")) #t)
+(test (eq? (copy lambda) (copy 'lambda)) #f)
+(test (eq? if 'if) #f)
+(test (eq? if `if) #f)
+(test (eq? if (keyword->symbol :if)) #f)
+(test (eq? if (string->symbol "if")) #f)
+(test (eq? lambda and) #f)
+(test (eq? let let*) #f)
+(test (eq? quote quote) #t)
+(test (eq? '"hi" '"hi") #f) ; guile also
+;(test (eq? '"" "") #f)
+;(test (eq? '"" '"") #f)
+;(test (eq? "" "") #f)
+(test (eq? #() #()) #f)
+(test (eq? '#() #()) #f)
+(test (eq? '#() '#()) #f)
+(test (let ((v #())) (eq? v #())) #f)
+(test (let ((v #())) (eq? v #())) #f)
+(test (let ((v #())) (eq? v v)) #t)
+(test (call/cc (lambda (return) (return (eq? return return)))) #t)
+(test (let ((r #f)) (call/cc (lambda (return) (set! r return) #f)) (eq? r r)) #t)
+(test (eq? _unbound_variable_ #f) 'error)
+
+(when with-block
+ (let ((b (make-block 4)))
+ (test (eq? b b) #t)
+ (test (equal? b b) #t)
+ (test (block? b) #t)
+ (test (block? #()) #f)
+ (test (block? #f) #f)
+ (set! (b 0) 32)
+ (test (b 0) 32.0)
+ (let () (define (hi b i) (b i)) (hi b 0) (test (hi b 0) 32.0))
+ (let () (define (hi b) (b 0)) (hi b) (test (hi b) 32.0))
+ (let () (define (hi b) (b)) (hi b) (test (hi b) 32))
+ (test b (block 32.0 0.0 0.0 0.0))
+ (test (object->string b) "(block 32.000 0.000 0.000 0.000)")
+ (let ((b1 (make-block 4)))
+ (test (eq? b b1) #f)))
+ (test (blocks) (list 4 1))
+ (test (blocks :frequency 2) (list 2 1))
+ (test (blocks :scaler 3 :frequency 2) (list 2 3))
+ (test (blocks :scaler 3 :phase 1) 'error)
+ (test (map blocks '(1 2 3)) '((1 1) (2 1) (3 1)))
+ (test (map blocks '( 1 2 3) '(4 5 6)) '((1 4) (2 5) (3 6)))
+ (test (procedure-documentation blocks) "test for function*")
+ (test (apply blocks '(:frequency 5 :scaler 4)) '(5 4))
+ (test (let () (define (b1) (blocks 100)) (b1)) '(100 1))
+ (test (procedure? blocks) #t)
+
+ (define (fv32)
+ (let ((b (block 1 2 3 4))
+ (f (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) f)
+ (set! (f i) (+ (b i) 1.0)))))
+ (test (fv32) (float-vector 2.0 3.0 4.0 5.0))
+
+ (define (fv33)
+ (let ((b (block 1 2 3 4))
+ (f (make-block 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) f)
+ (set! (f i) (+ (b i) 1.0)))))
+ (test (fv33) (block 2.0 3.0 4.0 5.0))
+ )
+
+(test (c-pointer? 0) #f)
+(test (c-pointer? _null_) #t)
+(if with-block
+ (test (integer? (c-object? _c_obj_)) #t)
+ (test (c-pointer? _c_obj_) #t))
+
+(for-each
+ (lambda (arg)
+ (test (c-pointer? arg) #f)
+ (test (c-object? arg) #f))
+ (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (c-pointer?) 'error)
+(test (c-object?) 'error)
+(test (c-pointer? _c_obj_ 2) 'error)
+(test (c-object? _c_obj_ 2) 'error)
+(when with-bignums
+ (test (c-pointer? (c-pointer (bignum "12341234"))) #t)
+ (test (c-pointer (bignum "1.4")) 'error))
+
+(when with-block
+ (test (pair? (*s7* 'c-types)) #t))
+
+
+;;; a ridiculous optimizer typo...
+(test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a a))) #f)
+(test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a . a))) #t)
+(test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a . b))) #f)
+
+(for-each
+ (lambda (arg)
+ (let ((x arg)
+ (y arg))
+ (if (not (eq? x x))
+ (format-logged #t ";(eq? x x) of ~A -> #f?~%" x))
+ (if (not (eq? x arg))
+ (format-logged #t ";(eq? x arg) of ~A ~A -> #f?~%" x arg))
+ (if (not (eq? x y))
+ (format-logged #t ";(eq? x y) of ~A ~A -> #f?~%" x y))))
+ ;; actually I hear that #f is ok here for numbers
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3/4 #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+;; this used to include 3.14 and 1+i but that means the (eq? x x) case differs from the (eq? 3.14 3.14) case
+
+(define comment-start (port-line-number))
+#|
+:'(1(1))
+(1 (1))
+:'(1#(1))
+(1# (1))
+|#
+(if (not (= (- (port-line-number) comment-start) 7)) (format *stderr* ";block comment newline counter: ~D ~D~%" comment-start (port-line-number)))
+
+;;; this comes from G Sussman
+(let ()
+ (define (counter count)
+ (lambda ()
+ (set! count (+ 1 count))
+ count))
+
+ (define c1 (counter 0))
+ (define c2 (counter 0))
+ (test (eq? c1 c2) #f)
+ (test (eq? c1 c1) #t)
+ (test (eq? c2 c2) #t)
+ (test (let ((p (lambda (x) x))) (eqv? p p)) #t)
+ (for-each
+ (lambda (arg)
+ (if (not ((lambda (p) (eq? p p)) arg))
+ (format-logged #t "~A not eq? to itself?~%" arg)))
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined> '(1 2 . 3)
+ (let ((lst (list 1 2)))
+ (set! (cdr (cdr lst)) lst)
+ lst)
+ (vector) (string) (list)
+ (let ((x 3))
+ (lambda (y) (+ x y))))))
+
+;;; this for r7rs
+(test (eq? #t #true) #t)
+(test (eq? #f #false) #t)
+(test (eq? () (map values ())) #t)
+
+(let () (define (f2) f2) (test (eq? f2 (f2)) #t))
+(letrec ((f2 (lambda () f2))) (test (eq? f2 (f2)) #t))
+
+
+
+
+;;; --------------------------------------------------------------------------------
;;; eqv?
+
(test (eqv? 'a 3) #f)
(test (eqv? #t 't) #f)
(test (eqv? "abs" 'abc) #f)
(test (eqv? "hi" '(hi)) #f)
-(test (eqv? "()" '()) #f)
+(test (eqv? "()" ()) #f)
(test (eqv? '(1) '(1)) #f)
(test (eqv? '(#f) '(#f)) #f)
(test (eqv? #\a #\b) #f)
@@ -409,7 +1400,7 @@
(test (eqv? #t #t) #t)
(test (eqv? #f #f) #t)
(test (eqv? #f #t) #f)
-(test (eqv? (null? '()) #t) #t)
+(test (eqv? (null? ()) #t) #t)
(test (eqv? (null? '(a)) #f) #t)
(test (eqv? (cdr '(a)) '()) #t)
(test (eqv? 'a 'a) #t)
@@ -422,7 +1413,7 @@
(test (eqv? "abc" "cba") #f)
(test (let ((x "hi")) (eqv? x x)) #t)
(test (eqv? (string #\h #\i) (string #\h #\i)) #f)
-(test (eqv? '#(a) '#(b)) #f)
+(test (eqv? #(a) #(b)) #f)
(test (let ((x (vector 'a))) (eqv? x x)) #t)
(test (eqv? (vector 'a) (vector 'a)) #f)
(test (eqv? car car) #t)
@@ -431,6 +1422,12 @@
(test (eqv? (lambda () 1) (lambda () 1)) #f)
(test (let () (define (make-adder x) (lambda (y) (+ x y))) (eqv? (make-adder 1) (make-adder 1))) #f)
(test (eqv? 9/2 9/2) #t)
+(test (eqv? quote quote) #t)
+(test (eqv? () ()) #t)
+(test (eqv? () '()) #t)
+;(test (eqv? "" "") #f)
+(test (eqv? "hi" "hi") #f) ; unspecified
+(test (eqv? #() #()) #f) ; unspecified, but in s7 (eqv? () ()) is #t
(let ((c1 (let ((x 32))
(lambda () x)))
@@ -470,22 +1467,26 @@
(test (eqv? 1/2 0.5) #f)
(test (eqv? 1 1/1) #t)
(test (eqv? 0.5 5e-1) #t)
+(test (eqv? 1/0 1/0) #f)
+(test (let ((+nan.0 1/0)) (eqv? +nan.0 +nan.0)) #f)
(test (eqv? (cons 'a 'b) (cons 'a 'c)) #f)
(test (eqv? eqv? eqv?) #t)
-(test (eqv? '#(1) '#(1)) #f)
+(test (eqv? #(1) #(1)) #f)
(test (eqv? '(1) '(1)) #f)
(test (eqv? '() '()) #t)
(test (eqv? '() (list)) #t)
(test (eqv? '(()) '(())) #f)
+(test (eqv? (list 'abs 'cons) '(abs cons)) #f)
-(let ((things (vector #t #f #\space '() "" 0 1 3/4 1+i 1.5 '(1 .2) '#() (vector) (vector 1) (list 1) 'f 't #\t)))
- (do ((i 0 (+ i 1)))
- ((= i (- (vector-length things) 1)))
- (do ((j (+ i 1) (+ j 1)))
- ((= j (vector-length things)))
- (if (eqv? (vector-ref things i) (vector-ref things j))
- (format #t ";(eqv? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))
+(let ((things (vector #t #f #\space '() "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector) (vector 1) (list 1) 'f 't #\t)))
+ (let ((len (length things)))
+ (do ((i 0 (+ i 1)))
+ ((= i (- len 1)))
+ (do ((j (+ i 1) (+ j 1)))
+ ((= j len))
+ (if (eqv? (vector-ref things i) (vector-ref things j))
+ (format-logged #t ";(eqv? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
(test (eqv?) 'error)
(test (eqv? #t) 'error)
@@ -499,7 +1500,6 @@
(test (eqv? ''#\a '#\a) #f)
(test (eqv? '#\a #\a) #t)
(test (eqv? 'car car) #f)
-(test (eqv? '() ()) #t)
(test (eqv? ''() '()) #f)
(test (eqv? '#f #f) #t)
(test (eqv? '#f '#f) #t)
@@ -512,17 +1512,44 @@
(test (let () (define-macro (hi a) `(+ 1 ,a)) (eqv? hi hi)) #t)
(test (let () (define (hi a) (+ 1 a)) (eqv? hi hi)) #t)
(test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (eqv? x x)) #t)
+(test (eqv? else else) #t)
+(test (let ((p (lambda (x) x))) (eqv? p p)) #t)
(if with-bignums
(begin
(test (eqv? (bignum "1+i") (bignum "1+i")) #t)
(test (eqv? (bignum "1+i") 1+i) #t)
(test (eqv? 1+i (bignum "1+i")) #t)
+ (test (eqv? (bignum "2.0") (bignum "2.0")) #t)
+ (test (eqv? (bignum "2.0") (bignum "1.0")) #f)
))
+;; from M Weaver:
+(test (list (eqv? +0.0 -0.0)
+ (eqv? (complex +0.0 1.0)
+ (complex -0.0 1.0))
+ (eqv? (complex 1.0 +0.0)
+ (complex 1.0 -0.0)))
+ '(#t #t #t))
+(test (list (eq? +0.0 -0.0)
+ (eq? (complex +0.0 1.0)
+ (complex -0.0 1.0))
+ (eq? (complex 1.0 +0.0)
+ (complex 1.0 -0.0)))
+ '(#t #f #f))
+(test (list (eq? +0 -0)
+ (eq? (complex +0 1)
+ (complex -0 1))
+ (eq? (complex 1 +0)
+ (complex 1 -0)))
+ '(#t #f #t))
+
+
+;;; --------------------------------------------------------------------------------
;;; equal?
+
(test (equal? 'a 3) #f)
(test (equal? #t 't) #f)
(test (equal? "abs" 'abc) #f)
@@ -553,24 +1580,24 @@
(test (equal? "abc" "abc") #t)
(test (let ((x "hi")) (equal? x x)) #t)
(test (equal? (string #\h #\i) (string #\h #\i)) #t)
-(test (equal? '#(a) '#(b)) #f)
-(test (equal? '#(a) '#(a)) #t)
+(test (equal? #(a) #(b)) #f)
+(test (equal? #(a) #(a)) #t)
(test (let ((x (vector 'a))) (equal? x x)) #t)
(test (equal? (vector 'a) (vector 'a)) #t)
-(test (equal? '#(1 2) (vector 1 2)) #t)
-(test (equal? '#(1.0 2/3) (vector 1.0 2/3)) #t)
-(test (equal? '#(1 2) (vector 1 2.0)) #f) ; 2 not equal 2.0!
+(test (equal? #(1 2) (vector 1 2)) #t)
+(test (equal? #(1.0 2/3) (vector 1.0 2/3)) #t)
+(test (equal? #(1 2) (vector 1 2.0)) #f) ; 2 not equal 2.0!
(test (equal? '(1 . 2) (cons 1 2)) #t)
(test (equal? '(1 #||# . #||# 2) (cons 1 2)) #t)
(test (- '#||#1) -1) ; hmm
-(test (equal? '#(1 "hi" #\a) (vector 1 "hi" #\a)) #t)
-(test (equal? '#((1 . 2)) (vector (cons 1 2))) #t)
-(test (equal? '#(1 "hi" #\a (1 . 2)) (vector 1 "hi" #\a (cons 1 2))) #t)
-(test (equal? '#(#f hi (1 2) 1 "hi" #\a (1 . 2)) (vector #f 'hi (list 1 2) 1 "hi" #\a (cons 1 2))) #t)
-(test (equal? '#(#(1) #(1)) (vector (vector 1) (vector 1))) #t)
-(test (equal? '#(()) (vector '())) #t)
-(test (equal? '#("hi" "ho") (vector "hi" '"ho")) #t)
-(test (equal? `#(1) '#(1)) #t)
+(test (equal? #(1 "hi" #\a) (vector 1 "hi" #\a)) #t)
+(test (equal? #((1 . 2)) (vector (cons 1 2))) #t)
+(test (equal? #(1 "hi" #\a (1 . 2)) (vector 1 "hi" #\a (cons 1 2))) #t)
+(test (equal? #(#f hi (1 2) 1 "hi" #\a (1 . 2)) (vector #f 'hi (list 1 2) 1 "hi" #\a (cons 1 2))) #t)
+(test (equal? #(#(1) #(1)) (vector (vector 1) (vector 1))) #t)
+(test (equal? #(()) (vector '())) #t)
+(test (equal? #("hi" "ho") (vector "hi" '"ho")) #t)
+(test (equal? `#(1) #(1)) #t)
(test (equal? ``#(1) #(1)) #t)
(test (equal? '`#(1) #(1)) #t)
(test (equal? ''#(1) #(1)) #f)
@@ -578,9 +1605,10 @@
(test (equal? (list 1 "hi" #\a) '(1 "hi" #\a)) #t)
(test (equal? (list 1.0 2/3) '(1.0 2/3)) #t)
(test (equal? (list 1 2) '(1 2.0)) #f)
-(test (equal? '#(1.0+1.0i) (vector 1.0+1.0i)) #t)
+(test (equal? #(1.0+1.0i) (vector 1.0+1.0i)) #t)
(test (equal? (list 1.0+1.0i) '(1.0+1.0i)) #t)
(test (equal? '((())) (list (list (list)))) #t)
+(test (equal? '((())) (cons (cons () ()) ())) #t)
(test (equal? car car) #t)
(test (equal? car cdr) #f)
(test (let ((x (lambda () 1))) (equal? x x)) #t)
@@ -598,12 +1626,23 @@
(test (equal? #<unspecified> #<unspecified>) #t)
(test (equal? (if #f #f) #<unspecified>) #t)
(test (equal? #<eof> #<undefined>) #f)
-(test (equal? #<eof> '()) #f)
+(test (equal? (values) #<eof>) #f)
+(test (equal? (values) (values)) #t)
+(test (equal? #<eof> #<unspecified>) #f)
+(test (equal? (values) #<unspecified>) #t)
+(test (equal? #<unspecified> (values)) #t)
+(test (equal? #<eof> ()) #f)
(test (let () (define-macro (hi a) `(+ 1 ,a)) (equal? hi hi)) #t)
(test (let () (define (hi a) (+ 1 a)) (equal? hi hi)) #t)
(test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (equal? x x)) #t)
(test (equal? ``"" '"") #t)
-(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda (x) x)))) (equal? pws pws)) #t)
+(test (let ((pws (dilambda (lambda () 1) (lambda (x) x)))) (equal? pws pws)) #t)
+(test (equal? if :if) #f)
+(test (equal? (list 'abs 'cons) '(abs cons)) #t)
+(test (equal? '(1) '(list 1)) #f)
+
+(test (equal? (values) #<unspecified>) #t)
+(test (equal? (list (values)) (list #<unspecified>)) #t)
(test (equal? most-positive-fixnum most-positive-fixnum) #t)
(test (equal? most-positive-fixnum most-negative-fixnum) #f)
@@ -625,6 +1664,15 @@
(test (let* ((x 3.141) (y x)) (equal? x y)) #t)
(test (let* ((x 1+i) (y x)) (equal? x y)) #t)
(test (let* ((x 3/4) (y x)) (equal? x y)) #t)
+(test (equal? '(+ '1) '(+ 1)) #f) ; !?
+
+(test (equal? '(1/0) '(1/0)) #f)
+(test (equal? '1/0 '1/0) #f)
+(test (let ((+nan.0 1/0)) (equal? '(+nan.0) '(+nan.0))) #t)
+(test (let ((+nan.0 1/0)) (equal? (list +nan.0) (list +nan.0))) #f)
+;;; in the 1st case we're looking at the symbol, not its value
+(test (let ((+nan.0 1/0)) (equal? (vector +nan.0) (vector +nan.0))) #f)
+(test (let ((+nan.0 1/0)) (equal? #(1/0) #(1/0))) #f)
(test (let ((x 3.141)) (equal? x x)) #t)
(test (equal? 3 3) #t)
@@ -644,25 +1692,35 @@
(test (equal? (recompose 100 list '(1)) (recompose 100 list (list 1))) #t)
(test (equal? (recompose 32 vector 1) (recompose 32 vector 1)) #t)
(test (equal? (reinvert 32 list vector 1) (reinvert 32 list vector 1)) #t)
-(test (equal? (recompose 32 (lambda (a) (cons 1 a)) '()) (recompose 32 (lambda (a) (cons 1 a)) '())) #t)
-(test (equal? (recompose 32 (lambda (a) (list 1 a)) '()) (recompose 32 (lambda (a) (list 1 a)) '())) #t)
+(test (equal? (recompose 32 (lambda (a) (cons 1 a)) ()) (recompose 32 (lambda (a) (cons 1 a)) ())) #t)
+(test (equal? (recompose 32 (lambda (a) (list 1 a)) ()) (recompose 32 (lambda (a) (list 1 a)) ())) #t)
(test (equal? "asd""asd") #t) ; is this the norm?
(let ((streq (lambda (a b) (equal? a b)))) (test (streq "asd""asd") #t))
-(let ((things (vector #t #f #\space '() "" 0 1 3/4 1+i 1.5 '(1 .2) '#() (vector 1) (list 1) 'f 't #\t)))
- (do ((i 0 (+ i 1)))
- ((= i (- (vector-length things) 1)))
- (do ((j (+ i 1) (+ j 1)))
- ((= j (vector-length things)))
- (if (equal? (vector-ref things i) (vector-ref things j))
- (format #t ";(equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))
+(let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector 1) (list 1) 'f 't #\t)))
+ (let ((len (length things)))
+ (do ((i 0 (+ i 1)))
+ ((= i (- len 1)))
+ (do ((j (+ i 1) (+ j 1)))
+ ((= j len))
+ (if (equal? (vector-ref things i) (vector-ref things j))
+ (format-logged #t ";(equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
(test (equal?) 'error)
(test (equal? #t) 'error)
(test (equal? #t #t #t) 'error)
(test (equal #t #t) 'error)
+(when with-block
+ (let ((b (make-block 4)))
+ (test (equal? b b) #t)
+ (let ((b1 (make-block 4)))
+ (test (equal? b b1) #t)
+ (set! (b 1) 1.0)
+ (test (equal? b b1) #f))))
+(test (let ((p (c-pointer 0))) (equal? p (copy p))) #t)
+
(test (call-with-exit (lambda (return) (return (equal? return return)))) #t)
(test (call-with-exit (lambda (return) (call-with-exit (lambda (quit) (return (equal? return quit)))))) #f)
(test (call/cc (lambda (return) (return (equal? return return)))) #t)
@@ -680,9 +1738,8 @@
;; so (eq? 3/4 3/4) is #f, (eqv? 3/4 3/4) is #t,
;; (eqv? #(1) #(1)) is #f, (equal? #(1) #(1)) is #t
;; (equal? 3 3.0) is #f, (= 3 3.0) is #t
-;; in s7 (since real_zero and real_one are separate)
+;; in s7
;; (eq? 0.0 0.0) is #t,
-;; (eq? 1.0 1.0) is #t,
;; (eq? 2.0 2.0) is #f
(test (equal? .0 0.) #t)
(test (equal?
@@ -696,6 +1753,35 @@
(test (equal? (make-string 3) (make-string 3)) #t)
(test (equal? (make-list 3) (make-list 3)) #t)
(test (equal? (make-vector 3) (make-vector 3)) #t)
+(unless with-bignums (test (equal? (random-state 100) (random-state 100)) #t))
+
+(test (equal? (current-input-port) (current-input-port)) #t)
+(test (equal? (current-input-port) (current-output-port)) #f)
+(test (equal? *stdin* *stderr*) #f)
+(test (let ((l1 (list 'a 'b))
+ (l2 (list 'a 'b 'a 'b)))
+ (set! (cdr (cdr l1)) l1)
+ (set! (cdr (cdr (cdr (cdr l2)))) l2)
+ (equal? l1 l2))
+ #t)
+(test (let ((l1 (list 'a 'b))
+ (l2 (list 'a 'b 'a)))
+ (set! (cdr (cdr l1)) l1)
+ (set! (cdr (cdr (cdr l2))) l2)
+ (equal? l1 l2))
+ #f)
+(test (let ((v1 (vector 1 2 3))
+ (v2 (vector 1 2 3)))
+ (set! (v1 1) v1)
+ (set! (v2 1) v2)
+ (equal? v1 v2))
+ #t)
+(test (let ((v1 (vector 1 2 3))
+ (v2 (vector 1 2 4)))
+ (set! (v1 1) v1)
+ (set! (v2 1) v2)
+ (equal? v1 v2))
+ #f)
(if with-bignums
(begin
@@ -703,19 +1789,1019 @@
))
+
+;;; --------------------------------------------------------------------------------
+;;; morally-equal?
+
+(test (morally-equal? 'a 3) #f)
+(test (morally-equal? #t 't) #f)
+(test (morally-equal? "abs" 'abc) #f)
+(test (morally-equal? "hi" '(hi)) #f)
+(test (morally-equal? "()" '()) #f)
+(test (morally-equal? '(1) '(1)) #t)
+(test (morally-equal? '(#f) '(#f)) #t)
+(test (morally-equal? '(()) '(() . ())) #t)
+(test (morally-equal? #\a #\b) #f)
+(test (morally-equal? #\a #\a) #t)
+(test (let ((x (string-ref "hi" 0))) (morally-equal? x x)) #t)
+(test (morally-equal? #t #t) #t)
+(test (morally-equal? #f #f) #t)
+(test (morally-equal? #f #t) #f)
+(test (morally-equal? (null? '()) #t) #t)
+(test (morally-equal? (null? '(a)) #f) #t)
+(test (morally-equal? (cdr '(a)) '()) #t)
+(test (morally-equal? 'a 'a) #t)
+(test (morally-equal? 'a 'b) #f)
+(test (morally-equal? 'a (string->symbol "a")) #t)
+(test (morally-equal? '(a) '(b)) #f)
+(test (morally-equal? '(a) '(a)) #t)
+(test (let ((x '(a . b))) (morally-equal? x x)) #t)
+(test (let ((x (cons 'a 'b))) (morally-equal? x x)) #t)
+(test (morally-equal? (cons 'a 'b) (cons 'a 'b)) #t)
+(test (morally-equal?(cons 'a 'b)(cons 'a 'b)) #t) ; no space
+(test (morally-equal? "abc" "cba") #f)
+(test (morally-equal? "abc" "abc") #t)
+(test (let ((x "hi")) (morally-equal? x x)) #t)
+(test (morally-equal? (string #\h #\i) (string #\h #\i)) #t)
+(test (morally-equal? #(a) #(b)) #f)
+(test (morally-equal? #(a) #(a)) #t)
+(test (let ((x (vector 'a))) (morally-equal? x x)) #t)
+(test (morally-equal? (vector 'a) (vector 'a)) #t)
+(test (morally-equal? #(1 2) (vector 1 2)) #t)
+(test (morally-equal? #(1.0 2/3) (vector 1.0 2/3)) #t)
+(test (morally-equal? #(1 2) (vector 1 2.0)) #t)
+(test (morally-equal? '(1 . 2) (cons 1 2)) #t)
+(test (morally-equal? '(1 #||# . #||# 2) (cons 1 2)) #t)
+(test (- '#||#1) -1) ; hmm
+(test (morally-equal? #(1 "hi" #\a) (vector 1 "hi" #\a)) #t)
+(test (morally-equal? #((1 . 2)) (vector (cons 1 2))) #t)
+(test (morally-equal? #(1 "hi" #\a (1 . 2)) (vector 1 "hi" #\a (cons 1 2))) #t)
+(test (morally-equal? #(#f hi (1 2) 1 "hi" #\a (1 . 2)) (vector #f 'hi (list 1 2) 1 "hi" #\a (cons 1 2))) #t)
+(test (morally-equal? #(#(1) #(1)) (vector (vector 1) (vector 1))) #t)
+(test (morally-equal? #(()) (vector '())) #t)
+(test (morally-equal? #("hi" "ho") (vector "hi" '"ho")) #t)
+(test (morally-equal? `#(1) #(1)) #t)
+(test (morally-equal? ``#(1) #(1)) #t)
+(test (morally-equal? '`#(1) #(1)) #t)
+(test (morally-equal? ''#(1) #(1)) #f)
+(test (morally-equal? ''#(1) '#(1)) #f)
+(test (morally-equal? (list 1 "hi" #\a) '(1 "hi" #\a)) #t)
+(test (morally-equal? (list 1.0 2/3) '(1.0 2/3)) #t)
+(test (morally-equal? (list 1 2) '(1 2.0)) #t)
+(test (morally-equal? #(1.0+1.0i) (vector 1.0+1.0i)) #t)
+(test (morally-equal? (list 1.0+1.0i) '(1.0+1.0i)) #t)
+(test (morally-equal? '((())) (list (list (list)))) #t)
+(test (morally-equal? car car) #t)
+(test (morally-equal? car cdr) #f)
+(test (let ((x (lambda () 1))) (morally-equal? x x)) #t)
+(test (morally-equal? (lambda () 1) (lambda () 1)) #t)
+(test (morally-equal? 9/2 9/2) #t)
+(test (morally-equal? #((())) #((()))) #t)
+(test (morally-equal? "123""123") #t);no space
+(test (morally-equal? """") #t)#|nospace|#
+(test (morally-equal? #()#()) #t)
+(test (morally-equal? #()()) #f)
+(test (morally-equal? ()"") #f)
+(test (morally-equal? "hi""hi") #t)
+(test (morally-equal? #<eof> #<eof>) #t)
+(test (morally-equal? #<undefined> #<undefined>) #t)
+(test (morally-equal? #<unspecified> #<unspecified>) #t)
+(test (morally-equal? (if #f #f) #<unspecified>) #t)
+(test (morally-equal? #<eof> #<undefined>) #f)
+(test (morally-equal? #<eof> '()) #f)
+(test (morally-equal? (values) #<eof>) #f)
+(test (morally-equal? #<eof> (values)) #f)
+(test (morally-equal? (values) (values)) #t)
+(test (morally-equal? #<eof> #<unspecified>) #f)
+(test (morally-equal? (values) #<unspecified>) #t)
+(test (morally-equal? #<unspecified> (values)) #t)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (morally-equal? hi hi)) #t)
+(test (let () (define (hi a) (+ 1 a)) (morally-equal? hi hi)) #t)
+(test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (morally-equal? x x)) #t)
+(test (morally-equal? ``"" '"") #t)
+(test (let ((pws (dilambda (lambda () 1) (lambda (x) x)))) (morally-equal? pws pws)) #t)
+(test (morally-equal? if :if) #f)
+(test (morally-equal? (list 'abs 'cons) '(abs cons)) #t)
+(test (morally-equal? (make-int-vector 2 0) (vector 0 0)) #t)
+(test (morally-equal? (make-vector 2 0 #t) (make-vector 2 0)) #t)
+(test (morally-equal? (make-int-vector 2 0) (make-vector 2 0 #t)) #t)
+(test (morally-equal? (make-vector 2 0 #t) (make-float-vector 2)) #t)
+(test (morally-equal? (vector 0.0 0) (make-vector 2 0.0 #t)) #t)
+(test (morally-equal? (make-int-vector 2 0) (vector 0 1.0)) #f)
+(test (morally-equal? (make-vector 1 1.0 #t) (make-vector 1 1.0 #t)) #t)
+(test (morally-equal? (make-float-vector 1 -nan.0) (make-vector 1 -nan.0 #t)) #t)
+
+(test (morally-equal? (make-iterator "") (make-iterator "")) #t)
+(test (morally-equal? (make-iterator "1") (make-iterator "1" (cons 1 1))) #t)
+(test (morally-equal? (make-iterator "1" (cons 3 4)) (make-iterator "1" (cons 1 1))) #t)
+(test (morally-equal? (make-iterator #()) (make-iterator #())) #t)
+
+(let ((str "123"))
+ (let ((i1 (make-iterator str))
+ (i2 (make-iterator str)))
+ (test (equal? i1 i2) #t)
+ (test (morally-equal? i1 i2) #t)
+ (iterate i1)
+ (test (equal? i1 i2) #f)
+ (test (morally-equal? i1 i2) #f)
+ (iterate i2)
+ (test (equal? i1 i2) #t)
+ (test (morally-equal? i1 i2) #t)))
+
+(let ((i1 (make-iterator "123"))
+ (i2 (make-iterator "123")))
+ (test (morally-equal? i1 i2) #t)
+ (iterate i1)
+ (test (morally-equal? i1 i2) #f)
+ (iterate i2)
+ (test (morally-equal? i1 i2) #t))
+
+(let ((i1 (make-iterator (vector 1 2 3)))
+ (i2 (make-iterator (int-vector 1 2 3))))
+ (test (morally-equal? i1 i2) #t)
+ (iterate i1)
+ (test (morally-equal? i1 i2) #f)
+ (iterate i2)
+ (test (morally-equal? i1 i2) #t))
+
+(let ((i1 (make-iterator (vector 1 2 3)))
+ (i2 (make-iterator (vector 1 2 3))))
+ (test (equal? i1 i2) #t)
+ (test (morally-equal? i1 i2) #t)
+ (iterate i1)
+ (test (equal? i1 i2) #f)
+ (test (morally-equal? i1 i2) #f)
+ (iterate i2)
+ (test (equal? i1 i2) #t)
+ (test (morally-equal? i1 i2) #t))
+
+(let ((str (hash-table* 'a 1 'b 2)))
+ (let ((i1 (make-iterator str))
+ (i2 (make-iterator str)))
+ (test (equal? i1 i2) #t)
+ (test (morally-equal? i1 i2) #t)
+ (iterate i1)
+ (test (equal? i1 i2) #f)
+ (test (morally-equal? i1 i2) #f)
+ (iterate i2)
+ (test (equal? i1 i2) #t)
+ (test (morally-equal? i1 i2) #t)))
+
+
+;;; opt bug
+(test (morally-equal? ''(1) (list 1)) #f)
+(test (morally-equal? ''(1+i) '(1+i)) #f)
+(test (morally-equal? '(1) (list 1)) #t)
+(test (morally-equal? '(1) ''(1)) #f)
+(test (morally-equal? (list 1) ''(1)) #f)
+(test (morally-equal? (list 1) '(1)) #t)
+(test (morally-equal? ''(1) ''(1)) #t)
+(test (morally-equal? '''(1) ''(1)) #f)
+
+(let ()
+ (define-macro (mac a) `(+ 1 ,a))
+ (define-macro (mac1 a) `(+ 1 ,a))
+ (define-macro (mac2 a) `(+ 2 ,a))
+ (define-macro (mac3 a b) `(+ ,b ,a))
+ (test (morally-equal? mac mac1) #t)
+ (test (morally-equal? mac mac2) #f)
+ (test (morally-equal? mac1 mac3) #f)
+ (test (morally-equal? mac3 mac3) #t)
+ (let ()
+ (define-macro (mac4 a) `(+ 1 ,a))
+ (test (morally-equal? mac mac4) #t)) ; was #f
+ (define-bacro (mac5 a) `(+ 1 ,a))
+ (test (morally-equal? mac mac5) #f)
+ (define-bacro (mac6 a) `(+ 1 ,a))
+ (test (morally-equal? mac5 mac6) #t))
+
+(test (morally-equal? most-positive-fixnum most-positive-fixnum) #t)
+(test (morally-equal? most-positive-fixnum most-negative-fixnum) #f)
+(test (morally-equal? pi pi) #t)
+(test (morally-equal? 9223372036854775807 9223372036854775806) #f)
+(test (morally-equal? 9223372036854775807 -9223372036854775808) #f)
+(test (morally-equal? -9223372036854775808 -9223372036854775808) #t)
+(test (morally-equal? 123456789/2 123456789/2) #t)
+(test (morally-equal? 123456789/2 123456787/2) #f)
+(test (morally-equal? -123456789/2 -123456789/2) #t)
+(test (morally-equal? 2/123456789 2/123456789) #t)
+(test (morally-equal? -2/123456789 -2/123456789) #t)
+(test (morally-equal? 2147483647/2147483646 2147483647/2147483646) #t)
+(test (morally-equal? 3/4 12/16) #t)
+(test (morally-equal? 1/1 1) #t)
+(test (morally-equal? 312689/99532 833719/265381) #f)
+(test (let ((x 3.141)) (morally-equal? x x)) #t)
+(test (let ((x 1+i)) (morally-equal? x x)) #t)
+(test (let* ((x 3.141) (y x)) (morally-equal? x y)) #t)
+(test (let* ((x 1+i) (y x)) (morally-equal? x y)) #t)
+(test (let* ((x 3/4) (y x)) (morally-equal? x y)) #t)
+(test (morally-equal? .1 1/10) #t)
+(test (morally-equal? pi '(1 2)) #f)
+
+(test (let ((x 3.141)) (morally-equal? x x)) #t)
+(test (morally-equal? 3 3) #t)
+(test (morally-equal? 3 3.0) #t)
+(test (morally-equal? 3.0 3.0) #t)
+(test (morally-equal? 3-4i 3-4i) #t)
+(test (morally-equal? 1/0 0/0) #t)
+(test (morally-equal? 1/0 (- 1/0)) #t) ; but they print as nan.0 and -nan.0 (this is C based I think), and equal? here is #f
+(test (morally-equal? (real-part (log 0)) (- (real-part (log 0)))) #f)
+(test (morally-equal? (log 0) (log 0)) #t)
+(test (morally-equal? 0/0+i 0/0+i) #t)
+(test (morally-equal? 0/0+i 0/0-i) #f)
+
+(test (morally-equal? (list 3) (list 3.0)) #t)
+(test (morally-equal? (list 3.0) (list 3.0)) #t)
+(test (morally-equal? (list 3-4i) (list 3-4i)) #t)
+(test (morally-equal? (list 1/0) (list 0/0)) #t)
+(test (morally-equal? (list (log 0)) (list (log 0))) #t)
+(test (morally-equal? (list 0/0+i) (list 0/0+i)) #t)
+
+(test (morally-equal? (vector 3) (vector 3.0)) #t)
+(test (morally-equal? (vector 3.0) (vector 3.0)) #t)
+(test (morally-equal? (vector 3-4i) (vector 3-4i)) #t)
+(test (morally-equal? (vector 1/0) (vector 0/0)) #t)
+(test (morally-equal? (vector (log 0)) (vector (log 0))) #t)
+(test (morally-equal? (vector 0/0+i) (vector 0/0+i)) #t)
+
+(test (morally-equal? (string #\c) "c") #t)
+(test (morally-equal? morally-equal? morally-equal?) #t)
+(test (morally-equal? (cons 1 (cons 2 3)) '(1 2 . 3)) #t)
+(test (morally-equal? '() '()) #t)
+(test (morally-equal? '() (list)) #t)
+(test (morally-equal? (cdr ' ''0) '((quote 0))) #t)
+(test (morally-equal? "\n" "\n") #t)
+(test (morally-equal? #f ((lambda () #f))) #t)
+(test (morally-equal? (+) 0) #t)
+(test (morally-equal? (recompose 32 list '(1)) (recompose 32 list (list 1))) #t)
+(test (morally-equal? (recompose 100 list '(1)) (recompose 100 list (list 1))) #t)
+(test (morally-equal? (recompose 32 vector 1) (recompose 32 vector 1)) #t)
+(test (morally-equal? (reinvert 32 list vector 1) (reinvert 32 list vector 1)) #t)
+(test (morally-equal? (recompose 32 (lambda (a) (cons 1 a)) ()) (recompose 32 (lambda (a) (cons 1 a)) ())) #t)
+(test (morally-equal? (recompose 32 (lambda (a) (list 1 a)) ()) (recompose 32 (lambda (a) (list 1 a)) ())) #t)
+
+(test (morally-equal? "asd""asd") #t) ; is this the norm?
+(let ((streq (lambda (a b) (morally-equal? a b)))) (test (streq "asd""asd") #t))
+
+(let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector 1) (list 1) 'f 't #\t)))
+ (let ((len (length things)))
+ (do ((i 0 (+ i 1)))
+ ((= i (- len 1)))
+ (do ((j (+ i 1) (+ j 1)))
+ ((= j len))
+ (if (morally-equal? (vector-ref things i) (vector-ref things j))
+ (format-logged #t ";(morally-equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))
+
+(test (morally-equal?) 'error)
+(test (morally-equal? #t) 'error)
+(test (morally-equal? #t #t #t) 'error)
+(test (equal #t #t) 'error)
+
+(test (call-with-exit (lambda (return) (return (morally-equal? return return)))) #t)
+(test (call-with-exit (lambda (return) (call-with-exit (lambda (quit) (return (morally-equal? return quit)))))) #f)
+(test (call/cc (lambda (return) (return (morally-equal? return return)))) #t)
+(test (let hiho ((i 0)) (morally-equal? hiho hiho)) #t)
+(test (let hiho ((i 0)) (let hoho ((i 0)) (morally-equal? hiho hoho))) #f)
+(test (morally-equal? + *) #f)
+(test (morally-equal? lambda lambda) #t)
+(test (morally-equal? lambda lambda*) #f)
+(test (morally-equal? let let) #t)
+(test (morally-equal? let letrec) #f)
+(test (morally-equal? define define) #t)
+(test (morally-equal? + ((lambda (a) a) +)) #t)
+(test (let ((x "hi")) (define (hi) x) (morally-equal? (hi) (hi))) #t)
+
+(test (morally-equal?
+ (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>)
+ (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>))
+ #t)
+(test (morally-equal?
+ (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>)
+ (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) #<eof> #<undefined>))
+ #t)
+(test (morally-equal? (make-string 3) (make-string 3)) #t)
+(test (morally-equal? (make-list 3) (make-list 3)) #t)
+(test (morally-equal? (make-vector 3) (make-vector 3)) #t)
+(test (morally-equal? (make-float-vector 3 1.0) (vector 1 1 1)) #t)
+(test (morally-equal? (make-vector 3 1.0 #t) (vector 1 1 1.1)) #f)
+(test (morally-equal? (make-vector 0 0.0 #t) (make-vector 0 0)) #t)
+(test (morally-equal? (int-vector 1) (int-vector 2)) #f)
+(test (morally-equal? (int-vector 1) (int-vector 1)) #t)
+(test (morally-equal? (float-vector 0.0) (float-vector nan.0)) #f)
+(test (morally-equal? (float-vector nan.0) (float-vector nan.0)) #t)
+(let ((old-err (*s7* 'morally-equal-float-epsilon)))
+ (set! (*s7* 'morally-equal-float-epsilon) 0.0)
+ (test (morally-equal? (float-vector 0.0) (float-vector nan.0)) #f)
+ (test (morally-equal? (float-vector nan.0) (float-vector nan.0)) #t)
+ (test (morally-equal? (float-vector 0.0) (float-vector 0.0)) #t)
+ (test (morally-equal? (float-vector 0.0) (float-vector 1e-15)) #f)
+ (set! (*s7* 'morally-equal-float-epsilon) 0.01)
+ (test (morally-equal? (float-vector 0.0) (float-vector 1e-15)) #t)
+ (test (morally-equal? (float-vector 0.0) (float-vector 0.005)) #t)
+ (test (morally-equal? (float-vector 0.0) (float-vector 0.02)) #f)
+ (set! (*s7* 'morally-equal-float-epsilon) old-err))
+
+(unless with-bignums (test (morally-equal? (random-state 100) (random-state 100)) #t))
+
+(test (morally-equal? (current-input-port) (current-input-port)) #t)
+(test (morally-equal? (current-input-port) (current-output-port)) #f)
+(test (morally-equal? *stdin* *stderr*) #f)
+
+(test (morally-equal?
+ (let ()
+ (define-macro* (a_func (an_arg (lambda () #t)))
+ `,an_arg)
+ (a_func))
+ (let ()
+ (define-macro (a_func an_arg)
+ `,an_arg)
+ (a_func (lambda () #t))))
+ #t) ; was #f
+
+(test (morally-equal? (- 4/3 1 -63.0) 190/3) #t)
+(test (morally-equal? 190/3 (- 4/3 1 -63.0)) #t)
+
+(if (not with-bignums)
+ (begin
+ (test (morally-equal? (+ 5e-16 nan.0) nan.0) #t)
+ (test (morally-equal? (+ 0+5e-16i nan.0) nan.0) #t)
+ (test (morally-equal? (+ 1/0 0+5e-16i) 1/0) #t)
+ (test (morally-equal? 1/0 (+ 1/0 0+5e-16i)) #t)
+ (test (morally-equal? 0 (+ 0 5e-16)) #t)
+ (test (morally-equal? 0 (- 0 1/1428571428571429)) #t)
+ (test (morally-equal? 0 (+ 0 0+5e-16i)) #t)
+ (test (morally-equal? 0 (+ 0 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 0 (+ 0 1e-11)) #f)
+ (test (morally-equal? 0 0) #t)
+ (test (morally-equal? 0 1/1000) #f)
+ (test (morally-equal? 0 0.0) #t)
+ (test (morally-equal? 0 1e-16) #t)
+ (test (morally-equal? 0 0+i) #f)
+ (test (morally-equal? 0 1e-16+i) #f)
+ (test (morally-equal? 0 0+1e-16i) #t)
+ (test (morally-equal? 0 1e-300) #t)
+ (test (morally-equal? 0 0+1e-300i) #t)
+ (test (morally-equal? 0 1/0) #f)
+ (test (morally-equal? 0 (- 0/0)) #f)
+ (test (morally-equal? 0 (log 0)) #f)
+ (test (morally-equal? 1 (+ 1 5e-16)) #t)
+ (test (morally-equal? 1 (- 1 1/1428571428571429)) #t)
+ (test (morally-equal? 1 (+ 1 0+5e-16i)) #t)
+ (test (morally-equal? 1 (+ 1 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1 (+ 1 1e-11)) #f)
+ (test (morally-equal? 1 1) #t)
+ (test (morally-equal? 1 1.0) #t)
+ (test (morally-equal? 1 1e-16) #f)
+ (test (morally-equal? 1 1e4) #f)
+ (test (morally-equal? 1 0+i) #f)
+ (test (morally-equal? 1 1e-16+i) #f)
+ (test (morally-equal? 1 (complex 1 1/0)) #f)
+ (test (morally-equal? 1 (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? 1 (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? 1000 (+ 1000 5e-16)) #t)
+ (test (morally-equal? 1000 (- 1000 1/1428571428571429)) #t)
+ (test (morally-equal? 1000 (+ 1000 0+5e-16i)) #t)
+ (test (morally-equal? 1000 (+ 1000 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1000 (+ 1000 1e-11)) #f)
+ (test (morally-equal? 1000 1000) #t)
+ (test (morally-equal? 1000 1/1000) #f)
+ (test (morally-equal? 1000 1e4) #f)
+ (test (morally-equal? 1/1000 (+ 1/1000 5e-16)) #t)
+ (test (morally-equal? 1/1000 (- 1/1000 1/1428571428571429)) #t)
+ (test (morally-equal? 1/1000 (+ 1/1000 0+5e-16i)) #t)
+ (test (morally-equal? 1/1000 (+ 1/1000 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1/1000 (+ 1/1000 1e-11)) #f)
+ (test (morally-equal? 1/1000 0) #f)
+ (test (morally-equal? 1/1000 1/1000) #t)
+ (test (morally-equal? 1/1000 0.0) #f)
+ (test (morally-equal? 1/1000 1e-16) #f)
+ (test (morally-equal? 1/1000 1e-16+i) #f)
+ (test (morally-equal? 1/1000 0+1e-16i) #f)
+ (test (morally-equal? 1/1000 1e-300) #f)
+ (test (morally-equal? 1/1000 0+1e-300i) #f)
+ (test (morally-equal? 1/1000 1/0) #f)
+ (test (morally-equal? 0.0 (+ 0.0 5e-16)) #t)
+ (test (morally-equal? 0.0 (- 0.0 1/1428571428571429)) #t)
+ (test (morally-equal? 0.0 (+ 0.0 0+5e-16i)) #t)
+ (test (morally-equal? 0.0 (+ 0.0 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 0.0 (+ 0.0 1e-11)) #f)
+ (test (morally-equal? 0.0 0) #t)
+ (test (morally-equal? 0.0 1/1000) #f)
+ (test (morally-equal? 0.0 0.0) #t)
+ (test (morally-equal? 0.0 1e-16) #t)
+ (test (morally-equal? 0.0 0+i) #f)
+ (test (morally-equal? 0.0 1+i) #f)
+ (test (morally-equal? 0.0 1e-16+i) #f)
+ (test (morally-equal? 0.0 0+1e-16i) #t)
+ (test (morally-equal? 0.0 1e-300) #t)
+ (test (morally-equal? 0.0 0+1e-300i) #t)
+ (test (morally-equal? 0.0 1/0) #f)
+ (test (morally-equal? 0.0 (real-part (log 0))) #f)
+ (test (morally-equal? 0.0 (- (real-part (log 0)))) #f)
+ (test (morally-equal? 0.0 (- 0/0)) #f)
+ (test (morally-equal? 0.0 (log 0)) #f)
+ (test (morally-equal? 1.0 (+ 1.0 5e-16)) #t)
+ (test (morally-equal? 1.0 (- 1.0 1/1428571428571429)) #t)
+ (test (morally-equal? 1.0 (+ 1.0 0+5e-16i)) #t)
+ (test (morally-equal? 1.0 (+ 1.0 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1.0 (+ 1.0 1e-11)) #f)
+ (test (morally-equal? 1.0 1) #t)
+ (test (morally-equal? 1.0 1.0) #t)
+ (test (morally-equal? 1.0 1e-16+i) #f)
+ (test (morally-equal? 1.0 0+1e-16i) #f)
+ (test (morally-equal? 1.0 1e-300) #f)
+ (test (morally-equal? 1.0 0+1e-300i) #f)
+ (test (morally-equal? 1.0 1/0) #f)
+ (test (morally-equal? 1.0 (- 0/0)) #f)
+ (test (morally-equal? 1.0 (complex 1/0 1)) #f)
+ (test (morally-equal? 1.0 (complex 1 1/0)) #f)
+ (test (morally-equal? 1.0 (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? 1e-16 (+ 1e-16 5e-16)) #t)
+ (test (morally-equal? 1e-16 (- 1e-16 1/1428571428571429)) #t)
+ (test (morally-equal? 1e-16 (+ 1e-16 0+5e-16i)) #t)
+ (test (morally-equal? 1e-16 (+ 1e-16 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1e-16 (+ 1e-16 1e-11)) #f)
+ (test (morally-equal? 1e-16 0) #t)
+ (test (morally-equal? 1e-16 1/1000) #f)
+ (test (morally-equal? 1e-16 0.0) #t)
+ (test (morally-equal? 1e-16 1e-16) #t)
+ (test (morally-equal? 1e-16 1e-16+i) #f)
+ (test (morally-equal? 1e-16 0+1e-16i) #t)
+ (test (morally-equal? 1e-16 1e-300) #t)
+ (test (morally-equal? 1e-16 0+1e-300i) #t)
+ (test (morally-equal? 1e-16 1/0) #f)
+ (test (morally-equal? 1e4 (+ 1e4 5e-16)) #t)
+ (test (morally-equal? 1e4 (- 1e4 1/1428571428571429)) #t)
+ (test (morally-equal? 1e4 (+ 1e4 0+5e-16i)) #t)
+ (test (morally-equal? 1e4 (+ 1e4 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1e4 (+ 1e4 1e-11)) #f)
+ (test (morally-equal? 1e4 1000) #f)
+ (test (morally-equal? 1e4 1/1000) #f)
+ (test (morally-equal? 1e4 1e-16) #f)
+ (test (morally-equal? 1e4 1e4) #t)
+ (test (morally-equal? 1e4 1e-16+i) #f)
+ (test (morally-equal? 1e4 0+1e-16i) #f)
+ (test (morally-equal? 1e4 1e-300) #f)
+ (test (morally-equal? 1e4 0+1e-300i) #f)
+ (test (morally-equal? 1e4 1/0) #f)
+ (test (morally-equal? 0+i (+ 0+i 5e-16)) #t)
+ (test (morally-equal? 0+i (- 0+i 1/1428571428571429)) #t)
+ (test (morally-equal? 0+i (+ 0+i 0+5e-16i)) #t)
+ (test (morally-equal? 0+i (+ 0+i 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 0+i (+ 0+i 1e-11)) #f)
+ (test (morally-equal? 0+i 0) #f)
+ (test (morally-equal? 0+i 1/1000) #f)
+ (test (morally-equal? 0+i 0.0) #f)
+ (test (morally-equal? 0+i 1e-16) #f)
+ (test (morally-equal? 0+i 0+i) #t)
+ (test (morally-equal? 0+i 1+i) #f)
+ (test (morally-equal? 0+i 1e-16+i) #t)
+ (test (morally-equal? 0+i 0+1e-16i) #f)
+ (test (morally-equal? 0+i 1e-300) #f)
+ (test (morally-equal? 0+i 0+1e-300i) #f)
+ (test (morally-equal? 0+i 1/0) #f)
+ (test (morally-equal? 0+i (real-part (log 0))) #f)
+ (test (morally-equal? 0+i (- (real-part (log 0)))) #f)
+ (test (morally-equal? 0+i (- 0/0)) #f)
+ (test (morally-equal? 0+i (log 0)) #f)
+ (test (morally-equal? 0+i (complex 1/0 1)) #f)
+ (test (morally-equal? 0+i (complex 1 1/0)) #f)
+ (test (morally-equal? 0+i (complex 1/0 1/0)) #f)
+ (test (morally-equal? 0+i (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? 1+i (+ 1+i 5e-16)) #t)
+ (test (morally-equal? 1+i (- 1+i 1/1428571428571429)) #t)
+ (test (morally-equal? 1+i (+ 1+i 0+5e-16i)) #t)
+ (test (morally-equal? 1+i (+ 1+i 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1+i (+ 1+i 1e-11)) #f)
+ (test (morally-equal? 1+i 0+i) #f)
+ (test (morally-equal? 1+i 1+i) #t)
+ (test (morally-equal? 1+i 1e-16+i) #f)
+ (test (morally-equal? 1+i 0+1e-16i) #f)
+ (test (morally-equal? 1+i 1e-300) #f)
+ (test (morally-equal? 1+i 0+1e-300i) #f)
+ (test (morally-equal? 1e-16+i (+ 1e-16+i 5e-16)) #t)
+ (test (morally-equal? 1e-16+i (- 1e-16+i 1/1428571428571429)) #t)
+ (test (morally-equal? 1e-16+i (+ 1e-16+i 0+5e-16i)) #t)
+ (test (morally-equal? 1e-16+i (+ 1e-16+i 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1e-16+i (+ 1e-16+i 1e-11)) #f)
+ (test (morally-equal? 1e-16+i 0) #f)
+ (test (morally-equal? 1e-16+i 1e-16) #f)
+ (test (morally-equal? 1e-16+i 1e4) #f)
+ (test (morally-equal? 1e-16+i 0+i) #t)
+ (test (morally-equal? 1e-16+i 1+i) #f)
+ (test (morally-equal? 1e-16+i 1e-16+i) #t)
+ (test (morally-equal? 1e-16+i 0+1e-16i) #f)
+ (test (morally-equal? 1e-16+i 1e-300) #f)
+ (test (morally-equal? 1e-16+i 0+1e-300i) #f)
+ (test (morally-equal? 1e-16+i 1/0) #f)
+ (test (morally-equal? 1e-16+i (real-part (log 0))) #f)
+ (test (morally-equal? 1e-16+i (- (real-part (log 0)))) #f)
+ (test (morally-equal? 1e-16+i (- 0/0)) #f)
+ (test (morally-equal? 1e-16+i (log 0)) #f)
+ (test (morally-equal? 1e-16+i (complex 1/0 1)) #f)
+ (test (morally-equal? 1e-16+i (complex 1 1/0)) #f)
+ (test (morally-equal? 1e-16+i (complex 1/0 1/0)) #f)
+ (test (morally-equal? 1e-16+i (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? 0+1e-16i (+ 0+1e-16i 5e-16)) #t)
+ (test (morally-equal? 0+1e-16i (- 0+1e-16i 1/1428571428571429)) #t)
+ (test (morally-equal? 0+1e-16i (+ 0+1e-16i 0+5e-16i)) #t)
+ (test (morally-equal? 0+1e-16i (+ 0+1e-16i 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 0+1e-16i (+ 0+1e-16i 1e-11)) #f)
+ (test (morally-equal? 0+1e-16i 0) #t)
+ (test (morally-equal? 0+1e-16i 1/1000) #f)
+ (test (morally-equal? 0+1e-16i 0.0) #t)
+ (test (morally-equal? 0+1e-16i 1e-16) #t)
+ (test (morally-equal? 0+1e-16i 0+i) #f)
+ (test (morally-equal? 0+1e-16i 1+i) #f)
+ (test (morally-equal? 0+1e-16i 1e-16+i) #f)
+ (test (morally-equal? 0+1e-16i 0+1e-16i) #t)
+ (test (morally-equal? 0+1e-16i 1e-300) #t)
+ (test (morally-equal? 0+1e-16i 0+1e-300i) #t)
+ (test (morally-equal? 0+1e-16i 1/0) #f)
+ (test (morally-equal? 0+1e-16i (real-part (log 0))) #f)
+ (test (morally-equal? 0+1e-16i (- (real-part (log 0)))) #f)
+ (test (morally-equal? 0+1e-16i (- 0/0)) #f)
+ (test (morally-equal? 0+1e-16i (log 0)) #f)
+ (test (morally-equal? 1e-300 (+ 1e-300 5e-16)) #t)
+ (test (morally-equal? 1e-300 (- 1e-300 1/1428571428571429)) #t)
+ (test (morally-equal? 1e-300 (+ 1e-300 0+5e-16i)) #t)
+ (test (morally-equal? 1e-300 (+ 1e-300 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1e-300 (+ 1e-300 1e-11)) #f)
+ (test (morally-equal? 1e-300 0) #t)
+ (test (morally-equal? 1e-300 1/1000) #f)
+ (test (morally-equal? 1e-300 0.0) #t)
+ (test (morally-equal? 1e-300 1e-16) #t)
+ (test (morally-equal? 1e-300 1e-16+i) #f)
+ (test (morally-equal? 1e-300 0+1e-16i) #t)
+ (test (morally-equal? 1e-300 1e-300) #t)
+ (test (morally-equal? 1e-300 0+1e-300i) #t)
+ (test (morally-equal? 1e-300 1/0) #f)
+ (test (morally-equal? 1e-300 (- 0/0)) #f)
+ (test (morally-equal? 1e-300 (log 0)) #f)
+ (test (morally-equal? 0+1e-300i (+ 0+1e-300i 5e-16)) #t)
+ (test (morally-equal? 0+1e-300i (- 0+1e-300i 1/1428571428571429)) #t)
+ (test (morally-equal? 0+1e-300i (+ 0+1e-300i 0+5e-16i)) #t)
+ (test (morally-equal? 0+1e-300i (+ 0+1e-300i 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 0+1e-300i (+ 0+1e-300i 1e-11)) #f)
+ (test (morally-equal? 0+1e-300i 0) #t)
+ (test (morally-equal? 0+1e-300i 1000) #f)
+ (test (morally-equal? 0+1e-300i 1/1000) #f)
+ (test (morally-equal? 0+1e-300i 0.0) #t)
+ (test (morally-equal? 0+1e-300i 1e-16) #t)
+ (test (morally-equal? 0+1e-300i 0+i) #f)
+ (test (morally-equal? 0+1e-300i 1e-16+i) #f)
+ (test (morally-equal? 0+1e-300i 0+1e-16i) #t)
+ (test (morally-equal? 0+1e-300i 1e-300) #t)
+ (test (morally-equal? 0+1e-300i 0+1e-300i) #t)
+ (test (morally-equal? 0+1e-300i 1/0) #f)
+ (test (morally-equal? 0+1e-300i (- 0/0)) #f)
+ (test (morally-equal? 1/0 (+ 1/0 5e-16)) #t)
+ (test (morally-equal? 1/0 (- 1/0 1/1428571428571429)) #t)
+ (test (morally-equal? 1/0 (+ 1/0 0+5e-16i)) #t)
+ (test (morally-equal? 1/0 (+ 1/0 0-1/1428571428571429i)) #t)
+ (test (morally-equal? 1/0 0) #f)
+ (test (morally-equal? 1/0 1/0) #t)
+ (test (morally-equal? 1/0 (real-part (log 0))) #f)
+ (test (morally-equal? 1/0 (- (real-part (log 0)))) #f)
+ (test (morally-equal? 1/0 (- 0/0)) #t)
+ (test (morally-equal? 1/0 (log 0)) #f)
+ (test (morally-equal? 1/0 (complex 1/0 1)) #f)
+ (test (morally-equal? 1/0 (complex 1 1/0)) #f)
+ (test (morally-equal? 1/0 (complex 1/0 1/0)) #f)
+ (test (morally-equal? 1/0 (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? 1/0 (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? 1/0 (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? 1/0 (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? 1/0 (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (real-part (log 0)) (+ (real-part (log 0)) 5e-16)) #t)
+ (test (morally-equal? (real-part (log 0)) (- (real-part (log 0)) 1/1428571428571429)) #t)
+ (test (morally-equal? (real-part (log 0)) (+ (real-part (log 0)) 0+5e-16i)) #t)
+ (test (morally-equal? (real-part (log 0)) (+ (real-part (log 0)) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (real-part (log 0)) 0) #f)
+ (test (morally-equal? (real-part (log 0)) 1e-16+i) #f)
+ (test (morally-equal? (real-part (log 0)) 0+1e-16i) #f)
+ (test (morally-equal? (real-part (log 0)) 1e-300) #f)
+ (test (morally-equal? (real-part (log 0)) 0+1e-300i) #f)
+ (test (morally-equal? (real-part (log 0)) 1/0) #f)
+ (test (morally-equal? (real-part (log 0)) (real-part (log 0))) #t)
+ (test (morally-equal? (real-part (log 0)) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (real-part (log 0)) (- 0/0)) #f)
+ (test (morally-equal? (real-part (log 0)) (log 0)) #f)
+ (test (morally-equal? (real-part (log 0)) (complex 1/0 1)) #f)
+ (test (morally-equal? (real-part (log 0)) (complex 1 1/0)) #f)
+ (test (morally-equal? (real-part (log 0)) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (real-part (log 0)) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (real-part (log 0)) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (real-part (log 0)) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (real-part (log 0)) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (real-part (log 0)) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (- (real-part (log 0))) (+ (- (real-part (log 0))) 5e-16)) #t)
+ (test (morally-equal? (- (real-part (log 0))) (- (- (real-part (log 0))) 1/1428571428571429)) #t)
+ (test (morally-equal? (- (real-part (log 0))) (+ (- (real-part (log 0))) 0+5e-16i)) #t)
+ (test (morally-equal? (- (real-part (log 0))) (+ (- (real-part (log 0))) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (- (real-part (log 0))) 1e-16+i) #f)
+ (test (morally-equal? (- (real-part (log 0))) 0+1e-16i) #f)
+ (test (morally-equal? (- (real-part (log 0))) 1e-300) #f)
+ (test (morally-equal? (- (real-part (log 0))) 0+1e-300i) #f)
+ (test (morally-equal? (- (real-part (log 0))) 1/0) #f)
+ (test (morally-equal? (- (real-part (log 0))) (real-part (log 0))) #f)
+ (test (morally-equal? (- (real-part (log 0))) (- (real-part (log 0)))) #t)
+ (test (morally-equal? (- (real-part (log 0))) (- 0/0)) #f)
+ (test (morally-equal? (- (real-part (log 0))) (log 0)) #f)
+ (test (morally-equal? (- (real-part (log 0))) (complex 1/0 1)) #f)
+ (test (morally-equal? (- (real-part (log 0))) (complex 1 1/0)) #f)
+ (test (morally-equal? (- (real-part (log 0))) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (- (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (- (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (- (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (- (real-part (log 0))) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (- (real-part (log 0))) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (- 0/0) (+ (- 0/0) 5e-16)) #t)
+ (test (morally-equal? (- 0/0) (- (- 0/0) 1/1428571428571429)) #t)
+ (test (morally-equal? (- 0/0) (+ (- 0/0) 0+5e-16i)) #t)
+ (test (morally-equal? (- 0/0) (+ (- 0/0) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (- 0/0) 0) #f)
+ (test (morally-equal? (- 0/0) 1e-300) #f)
+ (test (morally-equal? (- 0/0) 0+1e-300i) #f)
+ (test (morally-equal? (- 0/0) 1/0) #t)
+ (test (morally-equal? (- 0/0) (real-part (log 0))) #f)
+ (test (morally-equal? (- 0/0) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (- 0/0) (- 0/0)) #t)
+ (test (morally-equal? (- 0/0) (log 0)) #f)
+ (test (morally-equal? (- 0/0) (complex 1/0 1)) #f)
+ (test (morally-equal? (- 0/0) (complex 1 1/0)) #f)
+ (test (morally-equal? (- 0/0) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (- 0/0) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (- 0/0) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (- 0/0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (- 0/0) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (- 0/0) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (log 0) (+ (log 0) 5e-16)) #t)
+ (test (morally-equal? (log 0) (- (log 0) 1/1428571428571429)) #t)
+ (test (morally-equal? (log 0) (+ (log 0) 0+5e-16i)) #t)
+ (test (morally-equal? (log 0) (+ (log 0) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (log 0) 0) #f)
+ (test (morally-equal? (log 0) 1/0) #f)
+ (test (morally-equal? (log 0) (real-part (log 0))) #f)
+ (test (morally-equal? (log 0) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (log 0) (- 0/0)) #f)
+ (test (morally-equal? (log 0) (log 0)) #t)
+ (test (morally-equal? (log 0) (complex 1/0 1)) #f)
+ (test (morally-equal? (log 0) (complex 1 1/0)) #f)
+ (test (morally-equal? (log 0) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (log 0) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (log 0) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (log 0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (log 0) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (log 0) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 1) (+ (complex 1/0 1) 5e-16)) #t)
+ (test (morally-equal? (complex 1/0 1) (- (complex 1/0 1) 1/1428571428571429)) #t)
+ (test (morally-equal? (complex 1/0 1) (+ (complex 1/0 1) 0+5e-16i)) #t)
+ (test (morally-equal? (complex 1/0 1) (+ (complex 1/0 1) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (complex 1/0 1) 0) #f)
+ (test (morally-equal? (complex 1/0 1) 1) #f)
+ (test (morally-equal? (complex 1/0 1) 1e-16+i) #f)
+ (test (morally-equal? (complex 1/0 1) 0+1e-16i) #f)
+ (test (morally-equal? (complex 1/0 1) 1e-300) #f)
+ (test (morally-equal? (complex 1/0 1) 0+1e-300i) #f)
+ (test (morally-equal? (complex 1/0 1) 1/0) #f)
+ (test (morally-equal? (complex 1/0 1) (real-part (log 0))) #f)
+ (test (morally-equal? (complex 1/0 1) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 1) (- 0/0)) #f)
+ (test (morally-equal? (complex 1/0 1) (log 0)) #f)
+ (test (morally-equal? (complex 1/0 1) (complex 1/0 1)) #t)
+ (test (morally-equal? (complex 1/0 1) (complex 1 1/0)) #f)
+ (test (morally-equal? (complex 1/0 1) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (complex 1/0 1) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (complex 1/0 1) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 1) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 1) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (complex 1/0 1) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1 1/0) (+ (complex 1 1/0) 5e-16)) #t)
+ (test (morally-equal? (complex 1 1/0) (- (complex 1 1/0) 1/1428571428571429)) #t)
+ (test (morally-equal? (complex 1 1/0) (+ (complex 1 1/0) 0+5e-16i)) #t)
+ (test (morally-equal? (complex 1 1/0) (+ (complex 1 1/0) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (complex 1 1/0) 0) #f)
+ (test (morally-equal? (complex 1 1/0) 1) #f)
+ (test (morally-equal? (complex 1 1/0) 1e-300) #f)
+ (test (morally-equal? (complex 1 1/0) 0+1e-300i) #f)
+ (test (morally-equal? (complex 1 1/0) 1/0) #f)
+ (test (morally-equal? (complex 1 1/0) (real-part (log 0))) #f)
+ (test (morally-equal? (complex 1 1/0) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1 1/0) (- 0/0)) #f)
+ (test (morally-equal? (complex 1 1/0) (log 0)) #f)
+ (test (morally-equal? (complex 1 1/0) (complex 1/0 1)) #f)
+ (test (morally-equal? (complex 1 1/0) (complex 1 1/0)) #t)
+ (test (morally-equal? (complex 1 1/0) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (complex 1 1/0) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (complex 1 1/0) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1 1/0) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (complex 1 1/0) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 1/0) (+ (complex 1/0 1/0) 5e-16)) #t)
+ (test (morally-equal? (complex 1/0 1/0) (- (complex 1/0 1/0) 1/1428571428571429)) #t)
+ (test (morally-equal? (complex 1/0 1/0) (+ (complex 1/0 1/0) 0+5e-16i)) #t)
+ (test (morally-equal? (complex 1/0 1/0) (+ (complex 1/0 1/0) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (complex 1/0 1/0) 0) #f)
+ (test (morally-equal? (complex 1/0 1/0) 1/0) #f)
+ (test (morally-equal? (complex 1/0 1/0) (real-part (log 0))) #f)
+ (test (morally-equal? (complex 1/0 1/0) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 1/0) (- 0/0)) #f)
+ (test (morally-equal? (complex 1/0 1/0) (log 0)) #f)
+ (test (morally-equal? (complex 1/0 1/0) (complex 1/0 1)) #f)
+ (test (morally-equal? (complex 1/0 1/0) (complex 1 1/0)) #f)
+ (test (morally-equal? (complex 1/0 1/0) (complex 1/0 1/0)) #t)
+ (test (morally-equal? (complex 1/0 1/0) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (complex 1/0 1/0) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 1/0) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (complex 1/0 1/0) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 5e-16)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (- (complex (real-part (log 0)) 1/0) 1/1428571428571429)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 0+5e-16i)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 0) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 1) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 1000) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 1/1000) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 0.0) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 1.0) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 1e-16) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 1e4) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) 1/0) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (real-part (log 0))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (- 0/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (log 0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (complex 1/0 1)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (complex 1 1/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) 1/0)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1/0) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 5e-16)) #t)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (- (complex 1/0 (real-part (log 0))) 1/1428571428571429)) #t)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 0+5e-16i)) #t)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (real-part (log 0))) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (- 0/0)) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (log 0)) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (complex 1/0 1)) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (complex 1 1/0)) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #t)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (complex 1/0 (real-part (log 0))) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 5e-16)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (- (complex (real-part (log 0)) (real-part (log 0))) 1/1428571428571429)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 0+5e-16i)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) 0) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) 1/0) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (real-part (log 0))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (- 0/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (log 0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 1)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (complex 1 1/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #t)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) (real-part (log 0))) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 5e-16)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (- (complex (real-part (log 0)) 1) 1/1428571428571429)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 0+5e-16i)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1) 0) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) 1) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) 0+1e-300i) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) 1/0) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (real-part (log 0))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (- 0/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (log 0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (complex 1/0 1)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (complex 1 1/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) 1)) #t)
+ (test (morally-equal? (complex (real-part (log 0)) 1) (complex 1 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 5e-16)) #t)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (- (complex 1 (real-part (log 0))) 1/1428571428571429)) #t)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 0+5e-16i)) #t)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 0-1/1428571428571429i)) #t)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (real-part (log 0))) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (- (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (- 0/0)) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (log 0)) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (complex 1/0 1)) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (complex 1 1/0)) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (complex 1/0 1/0)) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) 1)) #f)
+ (test (morally-equal? (complex 1 (real-part (log 0))) (complex 1 (real-part (log 0)))) #t)
+ )) ; end with-bignums
+
+
+;;; ----------------
+;;; try a bunch of combinations
+(define old-readers *#readers*)
+
+(set! *#readers*
+ (cons (cons #\_ (lambda (str)
+ (if (string=? str "__line__")
+ (port-line-number)
+ #f)))
+ *#readers*))
+
+(let ((lst1 ())
+ (lst2 ()))
+ (if (not (eq? lst1 lst2)) (format-logged #t ";~A: nils are not eq?~%" #__line__))
+ (if (not (eqv? lst1 lst2)) (format-logged #t ";~A: nils are not eqv?~%" #__line__))
+ (if (not (equal? lst1 lst2)) (format-logged #t ";~A: nils are not equal?~%" #__line__))
+
+ (let ((v1 (make-vector 100 #f))
+ (v2 (make-vector 100 #f)))
+ (if (not (equal? v1 v2)) (format-logged #t ";~A: base vectors are not equal?~%" #__line__))
+
+ (let ((h1 (make-hash-table))
+ (h2 (make-hash-table)))
+ (if (not (equal? h1 h2)) (format-logged #t ";~A: base hash-tables are not equal?~%" #__line__))
+
+ (let ((e1 (sublet (curlet)))
+ (e2 (sublet (curlet))))
+ (if (not (equal? e1 e2)) (format-logged #t ";~A: base environments are not equal?~%" #__line__))
+
+ (let ((ctr 0))
+ (for-each
+ (lambda (arg1 arg2)
+ ;; make sure the args are eq? to themselves
+ ;; if equal? and equal to copy place in lst1, place copy in lst2, check that they are still equal
+ ;; similarly for vector, hash-table, envs
+ (let ((a1 arg1)
+ (a2 arg2))
+ (if (not (eq? a1 arg1))
+ (format-logged #t ";~A: ~A is not eq? to itself? ~A~%" #__line__ arg1 a1))
+ (if (and (eq? a1 a2) (not (eqv? a1 a2)))
+ (format-logged #t ";~A: ~A is eq? but not eqv? ~A~%" #__line__ a1 a2))
+
+ (if (equal? a1 a2)
+ (begin
+ (if (and (eq? a1 a2) (not (eqv? a1 a2)))
+ (format-logged #t ";~A: ~A is eq? and equal? but not eqv?? ~A~%" #__line__ a1 a2))
+ (if (not (morally-equal? a1 a2))
+ (format-logged #t ";~A: ~A is equal? but not morally-equal? ~A~%" #__line__ a1 a2))
+ (set! lst1 (cons a1 lst1))
+ (set! lst2 (cons a2 lst2))
+ (set! (v1 ctr) a1)
+ (set! (v2 ctr) a2)
+ (let* ((sym1 (string->symbol (string-append "symbol-" (number->string ctr))))
+ (sym2 (copy sym1)))
+ (set! (h1 sym1) a1)
+ (set! (h2 sym2) a2)
+ (varlet e1 (cons sym1 a1))
+ (varlet e2 (cons sym2 a2))
+
+ (if (not (equal? lst1 lst2))
+ (begin
+ (format-logged #t ";~A: add ~A to lists, now not equal?~%" #__line__ a1)
+ (set! lst1 (cdr lst1))
+ (set! lst2 (cdr lst2))))
+ (if (not (equal? v1 v2))
+ (begin
+ (format-logged #t ";~A: add ~A to vectors, now not equal?~%" #__line__ a1)
+ (set! (v1 ctr) #f)
+ (set! (v2 ctr) #f)))
+ (if (not (equal? h1 h2))
+ (begin
+ (format-logged #t ";~A: add ~A to hash-tables, now not equal?~%" #__line__ a1)
+ (set! (h1 sym1) #f)
+ (set! (h2 sym2) #f)))
+ (if (not (equal? e1 e2))
+ (begin
+ (format-logged #t ";~A: add ~A to environments, now not equal?~% ~A~% ~A~%" #__line__ a1 e1 e2)
+ (eval `(set! ,sym1 #f) e1)
+ (eval `(set! ,sym2 #f) e2)))
+ ))
+ (begin
+ (if (eq? a1 arg1) (format-logged #t ";~A: ~A is eq? but not equal? ~A~%" #__line__ a1 a2))
+ (if (eqv? a1 arg1) (format-logged #t ";~A: ~A is eqv? but not equal? ~A~%" #__line__ a1 a2))
+ (format-logged #t ";~A: ~A is not equal to ~A~%" #__line__ a1 a2)))
+
+ (set! ctr (+ ctr 1))))
+
+ (list "hi" ""
+ (integer->char 65) #\space #\newline #\null
+ 1 3/4
+ ;; 1.0 1+i pi (real-part (log 0)) 1e18
+ most-negative-fixnum most-positive-fixnum
+ 'a-symbol
+ (make-vector 3 #f) #() #2d((1 2) (3 4))
+ abs quasiquote macroexpand (log 0)
+ (hash-table '(a . 1) '(b . 2)) (hash-table)
+ (sublet (curlet) '(a . 1)) (rootlet)
+ #f #t :hi
+ #<eof> #<undefined> #<unspecified>
+ (cons 1 2) () '(1) (list (cons 1 2)) '(1 2 . 3)
+ (let ((lst (cons 1 2))) (set-cdr! lst lst) lst)
+ )
+ (list (string #\h #\i) (string)
+ #\A #\space #\newline (integer->char 0)
+ (- 2 1) (/ 3 4)
+ ;; 1.0 1+i pi (real-part (log 0)) 1e18
+ -9223372036854775808 9223372036854775807
+ (string->symbol "a-symbol")
+ (vector #f #f #f) (vector) #2d((1 2) (3 4))
+ abs quasiquote macroexpand (log 0)
+ (let ((h (make-hash-table 31))) (set! (h 'a) 1) (set! (h 'b) 2) h) (make-hash-table 123)
+ (sublet (curlet) '(a . 1)) (rootlet)
+ #f #t :hi
+ #<eof> #<undefined> (if #f #f)
+ '(1 . 2) (list) (list 1) (list (cons 1 2)) '(1 2 . 3)
+ (let ((lst (cons 1 2))) (set-cdr! lst lst) lst)
+ ))
+
+ (set! (v1 ctr) lst1)
+ (set! (v2 ctr) lst2)
+ (set! ctr (+ ctr 1))
+ (if (not (equal? v1 v2))
+ (format-logged #t ";~A: add lists to vectors, now vectors not equal?~%" #__line__)
+ (begin
+ (set! lst1 (cons v1 lst1))
+ (set! lst2 (cons v2 lst2))
+ (if (not (equal? lst1 lst2))
+ (begin
+ (format-logged #t ";~A: add vectors to lists, now lists not equal?~%" #__line__)
+ (set! (h1 'lst1) lst1)
+ (set! (h2 'lst2) lst2)
+ (if (not (equal? h1 h2))
+ (format-logged #t ";~A: add lists to hash-tables, not hash-tables not equal?~%" #__line__)
+ (begin
+ (set! (v1 ctr) v1)
+ (set! (v2 ctr) v2)
+ (set! ctr (+ ctr 1))
+ (if (not (equal? v1 v2))
+ (format-logged #t ";~A: add vectors to themselves, now vectors not equal?~%" #__line__))
+ (if (not (equal? lst1 lst2))
+ (format-logged #t ";~A: add vectors to themselves, now lists not equal?~%" #__line__))
+ (set! (h1 'h1) h1)
+ (set! (h2 'h2) h2)
+ (if (not (equal? h1 h2))
+ (format-logged #t ";~A: add hash-tables to themselves, not hash-tables not equal?~%" #__line__))
+ )))))))))))
+
+
+(set! *#readers* (cons (cons #\u (lambda (str) (string->number (substring str 1)))) ()))
+(test (eval (with-input-from-string "(+ 10 #u12)" read)) 22)
+(test (eval (with-input-from-string "(+ 10 #u87)" read)) 97)
+
+(do ((i (char->integer #\") (+ i 1)))
+ ((= i 127))
+ (when (not (member (integer->char i) '(#\( #\: #\|)))
+ (set! *#readers* (cons (cons (integer->char i) (lambda (str) (string->number (substring str 1)))) ()))
+ (let ((val (eval (with-input-from-string (string-append "(+ 10 #" (string (integer->char i)) "12)") read))))
+ (if (not (equal? val 22)) (format *stderr* "~D (~C): ~A~%" i (integer->char i) val)))))
+
+(set! *#readers* old-readers)
+
+(when with-block
+ (let ((b (make-block 4)))
+ (test (morally-equal? b b) #t)
+ (let ((b1 (make-block 4)))
+ (test (morally-equal? b b1) #t)
+ (set! (b 1) 1.0)
+ (test (morally-equal? b b1) #f))))
+(test (let ((p (c-pointer 0))) (morally-equal? p (copy p))) #t)
+
+
+
+;;; --------------------------------------------------------------------------------
;;; boolean?
+
(test (boolean? #f) #t)
(test (boolean? #t) #t)
(test (boolean? 0) #f)
(test (boolean? 1) #f)
(test (boolean? "") #f)
(test (boolean? #\0) #f)
-(test (boolean? '()) #f)
-(test (boolean? '#()) #f)
+(test (boolean? ()) #f)
+(test (boolean? #()) #f)
(test (boolean? 't) #f)
(test (boolean? (list)) #f)
(test ( boolean? #t) #t)
(test (boolean? boolean?) #f)
+(test (boolean? or) #f)
(test ( ; a comment
boolean? ;;; and another
#t
@@ -725,9 +2811,9 @@
(for-each
(lambda (arg)
(if (boolean? arg)
- (format #t ";(boolean? ~A) -> #t?~%" arg)))
- (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) (if #f #f) #<eof> #<undefined>))
+ (format-logged #t ";(boolean? ~A) -> #t?~%" arg)))
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
(test (recompose 12 boolean? #f) #t)
@@ -741,26 +2827,32 @@
;(test (boolean? else) #f) ; this could also be an error -> unbound variable, like (symbol? else)
+
+
+;;; --------------------------------------------------------------------------------
;;; not
+
(test (not #f) #t)
(test (not #t) #f)
(test (not (not #t)) #t)
(test (not 0) #f)
(test (not 1) #f)
-(test (not '()) #f)
+(test (not ()) #f)
(test (not 't) #f)
(test (not (list)) #f)
(test (not (list 3)) #f)
(test (not 'nil) #f)
(test (not not) #f)
(test (not "") #f)
+(test (not lambda) #f)
+(test (not quote) #f)
(for-each
(lambda (arg)
(if (not arg)
- (format #t ";(not ~A) -> #t?~%" arg)))
- (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined> (if #f #f)))
+ (format-logged #t ";(not ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi #<eof> #<undefined> (if #f #f)))
(test (recompose 12 not #f) #f)
@@ -769,9 +2861,85 @@
(test (not and) #f)
(test (not case) #f)
+(let () ; check some optimizer branches
+ (define (f1 sym) (not (symbol? sym))) (test (f1 'hi) #f) (test (f1 "hi") #t)
+ (define (f2 sym) (not (integer? sym))) (test (f2 2) #f) (test (f2 'hi) #t)
+ (define (f3 sym) (not (char? sym))) (test (f3 2) #t) (test (f3 #\a) #f)
+ (define (f4 sym) (not (list? sym))) (test (f4 2) #t) (test (f4 '(1 2 3)) #f)
+ (define (f5 sym) (not (boolean? sym))) (test (f5 2) #t) (test (f5 #f) #f)
+ (define (f6 sym) (not (eof-object? sym))) (test (f6 2) #t) (test (f6 #<eof>) #f)
+ (define (f7 sym) (not (pair? (car sym)))) (test (f7 '(hi)) #t) (test (f7 '((1))) #f)
+ (define (f8 sym) (not (eq? sym 'q))) (test (f8 'a) #t) (test (f8 'q) #f)
+ (define (f9 sym) (pair? (cadr sym))) (test (f9 '(1 2 3)) #f) (test (f9 '(1 (2 3) 4)) #t)
+ (define (f10 lst val) (eq? (car lst) val)) (test (f10 '(#f) #f) #t) (test (f10 '(a) 32) #f)
+ (define (f11 lst) (eq? (caar lst) 'q)) (test (f11 '((a))) #f) (test (f11 '((q))) #t)
+ (define (f12 lst) (= (length lst) 2)) (test (f12 '(1 2)) #t) (test (f12 '(1 2 3)) #f)
+ (define (f13 lst) (< (length lst) 2)) (test (f13 '(1 2)) #f) (test (f13 '(1)) #t)
+ (define (f14 lst) (negative? (length lst))) (test (f14 '(1 2)) #f) (test (f14 '(1 . 3)) #t)
+ (define (f15 lst) (memq (car lst) '(a b c))) (test (f15 '(a)) '(a b c)) (test (f15 '(d)) #f)
+ (define (f16 a b) (if a (begin (+ b a) (format #f "~A" a) (+ a a)))) (test (f16 1 2) 2)
+ (define (f17 a) (aritable? a 1)) (test (f17 abs) #t)
+ (define (f18) (set! (-s7-symbol-table-locked?) #f)) (f18) (test (f18) #f)
+ (define (f18a) (set! (-s7-symbol-table-locked?) #f)) (test (f18a) #f) (test (let () (f18a)) #f)
+ (define (f19) (set! (-s7-symbol-table-locked?) #f) 1) (f19) (test (f19) 1)
+ (define (f19a) (set! (-s7-symbol-table-locked?) #f) 1) (test (f19a) 1) (test (let () (f19a)) 1)
+ (define (f20) (set! (-s7-symbol-table-locked?) #f) (+ 1 2)) (f20) (test (f20) 3)
+ (define (f20a) (set! (-s7-symbol-table-locked?) #f) (+ 1 2)) (test (f20a) 3) (test (let () (f20a)) 3)
+ (define (f21) (set! (-s7-symbol-table-locked?) #f) (+ 1 2) 4) (f21) (test (f21) 4)
+ (define (f21a) (set! (-s7-symbol-table-locked?) #f) (+ 1 2) 4) (test (f21a) 4) (test (let () (f21a)) 4)
+ (define (f22) (begin (display ":") (display (object->string 2)) (display ":"))) (test (with-output-to-string (lambda () (f22))) ":2:")
+ (define (f23 a b) (list a b))
+ (define (f24 x y) (f23 (car x) (car y)))
+ (define (f25 x y) (f23 (cdr x) (cdr y)))
+ (test (f24 '(1 2) '(3 4)) '(1 3)) (test (f25 '(1 2) '(3 4)) '((2) (4)))
+ (define (f24a s1 s2 s3) (+ (* s1 s2) (* (- 1.0 s1) s3))) (test (f24a 2.0 3.0 4.0) 2.0)
+ (let () (define (a b) (define c 1) (+ b c)) (define (tst) (a 2)) (tst) (test (tst) 3))
+ (define (f25)
+ (let ((x 0.0) (y 1.0))
+ (call-with-exit
+ (lambda (return)
+ (do ((i y (+ i 1))) ((= i 6))
+ (do ((i i (+ i 1))) ((>= i 7))
+ (set! x (+ x i))
+ (if (> x 123.0) (return x))))))
+ x))
+ (test (f25) 85.0)
+ )
+(let ()
+ (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (ho 2))) (hi)) 7)
+ (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (values 3 4))) (hi)) 10)
+ (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (values 3 4) (ho 1))) (hi)) 10)
+ (test (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) 10)
+ (test (let () (define (ho a) (values a 1)) (define (hi) (- (ho 2))) (hi)) 1)
+ (test (let () (define (ho1) (s7-version)) (define (ho2) (ho1)) (string? (ho2))) #t)
+ (test (let () (define (hi) (vector 0)) (define (ho) (hi)) (ho)) #(0)))
+(let ()
+ (define (make-it . names) (apply vector names))
+ (define (hi) (make-it pi pi pi pi))
+ (test (hi) (vector pi pi pi pi)))
+(test (let () (define (hi a b c d) (+ a (* (- b c) d))) (define (ho) (hi 1 2 3 4)) (ho)) -3)
+(test (let () (define (hi a b c d) (+ a (* d (- b c)))) (define (ho) (hi 1 2 3 4)) (ho)) -3)
+(test (let () (define (hi) (let ((x (values 1 2))) (if x (list x)))) (define (ho) (hi)) (catch #t (lambda () (ho)) (lambda args #f)) (ho)) 'error)
+(test (let () (define (hi a b) (- (+ a (abs b)))) (define (ho) (hi 1 -2)) (ho)) -3)
+
+(let () (define (e1) (((lambda () list)) 'a 'b 'c)) (define (e2) (e1)) (e2) (test (e2) '(a b c)))
+(let () (define (c1 s i) (case (string-ref s i) ((#\a) 1) (else 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2))
+(let () (define (c1 s i) (case (string-ref s i) ((#\a) 1) ((#\i) 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2))
+(let () (define (c1 s i) (case (string-ref s i) ((#\a #\h) 1) ((#\i #\o) 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2))
+(let () (define (c1 s i) (case (string-ref s i) ((#\a #\h) 1) (else 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2))
+(let () (define (d1) (do ((lst () (cons i lst)) (i 0 (+ i 1))) ((> i 6) (reverse lst)))) (define (d2) (d1)) (d2) (test (d2) '(0 1 2 3 4 5 6)))
+(let () (define (d3) ((define (hi a) (+ a 1)) 2)) (define (d4) (d3)) (d4) (test (d4) 3))
+(let () (define (fif) (if (< 2 3) (quote . -1))) (catch #t fif (lambda args 'error)) (test (catch #t fif (lambda args 'error)) 'error))
+;(let () (define (fcond) (cond ((< 2 3) ((lambda (x) x 1 . 5) 2)))) (catch #t fcond (lambda args 'error)) (test (fcond) 'error))
+;(let () (define (fcond1) (cond ((< 2 3) ((lambda* (x) x . 5) 2)))) (catch #t fcond1 (lambda args 'error)) (test (fcond1) 'error))
+; those aren't what they appear to be: the catch does the stray dot check/error, then a call simply does what it can
+(let () (define (incsaa k i) (let ((sum 1)) (set! sum (+ sum (expt k i) (expt (- k) i))) sum)) (define (f1) (incsaa 3 2)) (test (f1) 19))
+(let () (define (unks v1 i) (let ((x 0)) (set! x (v1 i)) x)) (define (f1) (unks (vector 1 2 3) 2)) (test (f1) 3))
+;;; --------------------------------------------------------------------------------
;;; symbol?
+
(test (symbol? 't) #t)
(test (symbol? "t") #f)
(test (symbol? '(t)) #f)
@@ -780,7 +2948,7 @@
(test (symbol? 'foo) #t)
(test (symbol? (car '(a b))) #t)
(test (symbol? 'nil) #t)
-(test (symbol? '()) #f)
+(test (symbol? ()) #f)
(test (symbol? #()) #f)
(test (symbol? #f) #f)
(test (symbol? 'car) #t)
@@ -798,18 +2966,28 @@
;(test (symbol? '#:) #t) ; confusable given guile-style keywords
(test (symbol? #b1) #f)
(test (symbol? 'sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789) #t) ;M Gran
-(test (symbol? (vector-ref '#(1 a 34) 1)) #t)
+(test (symbol? (vector-ref #(1 a 34) 1)) #t)
(test (if (symbol? '1+) (symbol? '0e) #t) #t)
+(test (symbol? 'begin) #t)
+(test (symbol? 'if) #t)
+(test (symbol? (keyword->symbol :if)) #t)
+(test (symbol? (string->symbol "if")) #t)
+(test (symbol? if) #f)
+(test (symbol? quote) #f)
+(test (symbol? '(AB\c () xyz)) #f)
(for-each
(lambda (arg)
(if (symbol? arg)
- (format #t ";(symbol? ~A) -> #t?~%" arg)))
- (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
+ (format-logged #t ";(symbol? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>))
(test (symbol?) 'error)
(test (symbol? 'hi 'ho) 'error)
+(test (symbol? 'hi 3) 'error)
+(test (symbol? 3 3) 'error)
+(test (symbol? 3 'hi) 'error)
(test (symbol 'hi) 'error) ; symbol takes a string
;;; "Returns #t if obj is a symbol, otherwise returns #f" (r5|6rs.html)
@@ -818,6 +2996,7 @@
(test (symbol? if) #f)
(test (symbol? and) #f)
(test (symbol? lambda) #f)
+(test (symbol? 'let) #t)
(test (symbol? call/cc) #f)
(test (symbol? '1.2.3) #t)
(test (symbol? '1.2) #f)
@@ -828,9 +3007,27 @@
(let ((sym000000000000000000001 4))
(+ sym000000000000000000000 sym000000000000000000001)))
7)
+(test (let ((11-1 10)
+ (2012-4-19 21)
+ (1+the-road 18)
+ (-1+2 1)
+ (1e. 2)
+ (0+i' 3)
+ (0.. 4))
+ (+ 11-1 2012-4-19 1+the-road -1+2 1e. 0+i' 0..))
+ 59)
+
+(test (let ((name "hiho"))
+ (string-set! name 2 #\null)
+ (symbol? (string->symbol name)))
+ #t)
+
+
+;;; --------------------------------------------------------------------------------
;;; procedure?
+
(test (procedure? car) #t)
(test (procedure? procedure?) #t)
(test (procedure? 'car) #f)
@@ -846,18 +3043,22 @@
(test (procedure? lambda) #f)
(test (procedure? (lambda* ((a 1)) a)) #t)
(test (procedure? and) #f)
-(test (procedure? (make-procedure-with-setter (lambda () 1) (lambda (x) x))) #t)
+(test (procedure? 'let) #f)
+(test (procedure? (dilambda (lambda () 1) (lambda (x) x))) #t)
(if with-bignums (test (procedure? (bignum "1e100")) #f))
(test (procedure? quasiquote) #f)
(let () (define-macro (hi a) `(+ ,a 1)) (test (procedure? hi) #f))
-(test (procedure? (make-random-state 1234)) #f)
+(test (procedure? (random-state 1234)) #f)
(test (procedure? pi) #f)
+(test (procedure? cond) #f)
+(test (procedure? do) #f)
+(test (procedure? set!) #f)
(for-each
(lambda (arg)
(if (procedure? arg)
- (format #t ";(procedure? ~A) -> #t?~%" arg)))
- (list "hi" _ht_ (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f)))
+ (format-logged #t ";(procedure? ~A) -> #t?~%" arg)))
+ (list "hi" _ht_ _null_ _c_obj_ :hi (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f)))
(test (procedure?) 'error)
(test (procedure? abs car) 'error)
@@ -879,7 +3080,9 @@
(test (eqv? '#\ #\space) #t)
(test (eqv? #\newline '#\newline) #t)
+;;; --------------------------------------------------------------------------------
;;; char?
+
(test (char? #\a) #t)
(test (char? #\() #t)
(test (char? #\space) #t)
@@ -921,16 +3124,16 @@
(for-each
(lambda (arg)
(if (char? arg)
- (format #t ";(char? ~A) -> #t?~%" arg)))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (format-logged #t ";(char? ~A) -> #t?~%" arg)))
+ (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t (if #f #f) :hi (lambda (a) (+ a 1))))
(test (char? begin) #f)
(do ((i 0 (+ i 1)))
((= i 256))
(if (not (char? (integer->char i)))
- (format #t ";(char? (integer->char ~A)) -> #f?~%" i)))
+ (format-logged #t ";(char? (integer->char ~A)) -> #f?~%" i)))
(test (char?) 'error)
(test (char? #\a #\b) 'error)
@@ -948,8 +3151,8 @@
(test (char? #\xff) #t)
;; any larger number is a reader error
+(test (eval-string "(char? #\xbdca2cbec)") 'error) ; this can overflow internally!
(test (eval-string "(char? #\\x#b0)") 'error)
-
(test (eval-string "(char? #\\100)") 'error)
(test (eval-string "(char? #\\x-65)") 'error)
(test (eval-string "(char? #\\x6.5)") 'error)
@@ -981,6 +3184,12 @@
(test (eval-string (string-append "(char? " (format #f "#\\~C" (integer->char 127)) ")")) #t)
(test (apply char? (list (integer->char 255))) #t)
+(test (char? #\escape) #t)
+(test (char? #\alarm) #t)
+(test (char? #\backspace) #t)
+(test (char? #\delete) #t)
+(test (char=? #\delete #\backspace) #f)
+
(num-test (let ((str (make-string 258 #\space)))
(do ((i 1 (+ i 1)))
((= i 256))
@@ -995,22 +3204,25 @@
(mixed-a-to-z (list #\a #\B #\c #\D #\e #\F #\g #\H #\I #\j #\K #\L #\m #\n #\O #\p #\Q #\R #\s #\t #\U #\v #\X #\y #\Z))
(digits (list #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
+;;; --------------------------------------------------------------------------------
;;; char-upper-case?
+
(test (char-upper-case? #\a) #f)
(test (char-upper-case? #\A) #t)
(for-each
(lambda (arg)
(if (not (char-upper-case? arg))
- (format #t ";(char-upper-case? ~A) -> #f?~%" arg)))
+ (format-logged #t ";(char-upper-case? ~A) -> #f?~%" arg)))
cap-a-to-z)
(for-each
(lambda (arg)
(if (char-upper-case? arg)
- (format #t ";(char-upper-case? ~A) -> #t?~%" arg)))
+ (format-logged #t ";(char-upper-case? ~A) -> #t?~%" arg)))
a-to-z)
+ (test (char-upper-case? (integer->char 192)) #t) ; 192..208 for unicode
;; non-alpha chars are "unspecified" here
(test (char-upper-case? 1) 'error)
@@ -1020,21 +3232,24 @@
(test (char-upper-case? #\a #\b) 'error)
(test (char-upper-case #\a) 'error)
+
+;;; --------------------------------------------------------------------------------
;;; char-lower-case?
+
(test (char-lower-case? #\A) #f)
(test (char-lower-case? #\a) #t)
(for-each
(lambda (arg)
(if (not (char-lower-case? arg))
- (format #t ";(char-lower-case? ~A) -> #f?~%" arg)))
+ (format-logged #t ";(char-lower-case? ~A) -> #f?~%" arg)))
a-to-z)
(for-each
(lambda (arg)
(if (char-lower-case? arg)
- (format #t ";(char-lower-case? ~A) -> #t?~%" arg)))
+ (format-logged #t ";(char-lower-case? ~A) -> #t?~%" arg)))
cap-a-to-z)
(test (char-lower-case? 1) 'error)
@@ -1055,7 +3270,9 @@
+;;; --------------------------------------------------------------------------------
;;; char-upcase
+
(test (char-upcase #\A) #\A)
(test (char-upcase #\a) #\A)
(test (char-upcase #\?) #\?)
@@ -1067,14 +3284,19 @@
(test (char-upcase #\%) #\%)
(test (char-upcase #\0) #\0)
(test (char-upcase #\_) #\_)
+ (test (char-upcase #\?) #\?)
(test (char-upcase #\space) #\space)
(test (char-upcase #\newline) #\newline)
(test (char-upcase #\null) #\null)
+ (test (char-upper-case? (char-upcase #\?)) #f) ; !
+ (test (char-lower-case? (char-downcase #\?)) #f)
+ (test (char-upper-case? (char-upcase #\_)) #f)
+ (test (or (char-upper-case? #\?) (char-lower-case? #\?)) #f)
(for-each
(lambda (arg1 arg2)
(if (not (char=? (char-upcase arg1) arg2))
- (format #t ";(char-upcase ~A) != ~A?~%" arg1 arg2)))
+ (format-logged #t ";(char-upcase ~A) != ~A?~%" arg1 arg2)))
a-to-z
cap-a-to-z)
@@ -1082,7 +3304,7 @@
((= i 256))
(if (and (not (char=? (integer->char i) (char-upcase (integer->char i))))
(not (char-alphabetic? (integer->char i))))
- (format #t ";(char-upcase ~A) -> ~A but not alphabetic?~%" (integer->char i) (char-upcase (integer->char i)))))
+ (format-logged #t ";(char-upcase ~A) -> ~A but not alphabetic?~%" (integer->char i) (char-upcase (integer->char i)))))
(test (recompose 12 char-upcase #\a) #\A)
(test (reinvert 12 char-upcase char-downcase #\a) #\a)
@@ -1095,7 +3317,9 @@
+;;; --------------------------------------------------------------------------------
;;; char-downcase
+
(test (char-downcase #\A) #\a)
(test (char-downcase #\a) #\a)
(test (char-downcase #\?) #\?)
@@ -1112,7 +3336,7 @@
(for-each
(lambda (arg1 arg2)
(if (not (char=? (char-downcase arg1) arg2))
- (format #t ";(char-downcase ~A) != ~A?~%" arg1 arg2)))
+ (format-logged #t ";(char-downcase ~A) != ~A?~%" arg1 arg2)))
cap-a-to-z
a-to-z)
@@ -1122,7 +3346,9 @@
(test (char-downcase #\a #\b) 'error)
+;;; --------------------------------------------------------------------------------
;;; char-numeric?
+
(test (char-numeric? #\a) #f)
(test (char-numeric? #\5) #t)
(test (char-numeric? #\A) #f)
@@ -1142,20 +3368,22 @@
(for-each
(lambda (arg)
(if (char-numeric? arg)
- (format #t ";(char-numeric? ~A) -> #t?~%" arg)))
+ (format-logged #t ";(char-numeric? ~A) -> #t?~%" arg)))
cap-a-to-z)
(for-each
(lambda (arg)
(if (char-numeric? arg)
- (format #t ";(char-numeric? ~A) -> #t?~%" arg)))
+ (format-logged #t ";(char-numeric? ~A) -> #t?~%" arg)))
a-to-z)
(test (char-numeric?) 'error)
(test (char-numeric? #\a #\b) 'error)
+;;; --------------------------------------------------------------------------------
;;; char-whitespace?
+
(test (char-whitespace? #\a) #f)
(test (char-whitespace? #\A) #f)
(test (char-whitespace? #\z) #f)
@@ -1175,23 +3403,35 @@
(test (char-whitespace? #\xd) #t) ; #\return
(test (char-whitespace? #\xe) #f)
+ ;; unicode whitespace apparently:
+ (test (char-whitespace? (integer->char 9)) #t)
+ (test (char-whitespace? (integer->char 10)) #t)
+ (test (char-whitespace? (integer->char 11)) #t)
+ (test (char-whitespace? (integer->char 12)) #t)
+ (test (char-whitespace? (integer->char 13)) #t)
+ (test (char-whitespace? (integer->char 32)) #t)
+ (test (char-whitespace? (integer->char 133)) #t)
+ (test (char-whitespace? (integer->char 160)) #t)
+
(for-each
(lambda (arg)
(if (char-whitespace? arg)
- (format #t ";(char-whitespace? ~A) -> #t?~%" arg)))
+ (format-logged #t ";(char-whitespace? ~A) -> #t?~%" arg)))
mixed-a-to-z)
(for-each
(lambda (arg)
(if (char-whitespace? arg)
- (format #t ";(char-whitespace? ~A) -> #t?~%" arg)))
+ (format-logged #t ";(char-whitespace? ~A) -> #t?~%" arg)))
digits)
(test (char-whitespace?) 'error)
(test (char-whitespace? #\a #\b) 'error)
+;;; --------------------------------------------------------------------------------
;;; char-alphabetic?
+
(test (char-alphabetic? #\a) #t)
(test (char-alphabetic? #\$) #f)
(test (char-alphabetic? #\A) #t)
@@ -1213,13 +3453,13 @@
(for-each
(lambda (arg)
(if (char-alphabetic? arg)
- (format #t ";(char-alphabetic? ~A) -> #t?~%" arg)))
+ (format-logged #t ";(char-alphabetic? ~A) -> #t?~%" arg)))
digits)
(for-each
(lambda (arg)
(if (not (char-alphabetic? arg))
- (format #t ";(char-alphabetic? ~A) -> #f?~%" arg)))
+ (format-logged #t ";(char-alphabetic? ~A) -> #f?~%" arg)))
mixed-a-to-z)
(test (char-alphabetic?) 'error)
@@ -1230,19 +3470,28 @@
(for-each
(lambda (arg)
(test (op arg) 'error))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list char-upper-case? char-lower-case? char-upcase char-downcase char-numeric? char-whitespace? char-alphabetic?))
(test
- (let ((unhappy '()))
+ (let ((unhappy ()))
(do ((i 0 (+ i 1)))
((= i 256))
(let* ((ch (integer->char i))
(chu (char-upcase ch))
(chd (char-downcase ch)))
+
+ (if (and (not (char=? ch chu))
+ (not (char-upper-case? chu)))
+ (format-logged #t ";(char-upper-case? (char-upcase ~C)) is #f~%" ch))
+
+ (if (and (not (char=? ch chd))
+ (not (char-lower-case? chd)))
+ (format-logged #t ";(char-lower-case? (char-downcase ~C)) is #f~%" ch))
+
(if (or (and (not (char=? ch chu))
(not (char=? ch (char-downcase chu))))
(and (not (char=? ch chd))
@@ -1270,17 +3519,15 @@
;; 223 for example, or 186 for lower case
(set! unhappy (cons (format #f "~C: ~C ~C (~D)~%" ch chu chd i) unhappy)))))
unhappy)
- '())
-
-
+ ())
(for-each
(lambda (op)
(for-each
(lambda (arg)
(test (op #\a arg) 'error))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?))
(for-each
@@ -1288,12 +3535,14 @@
(for-each
(lambda (arg)
(test (op arg #\a) 'error))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?))
+;;; --------------------------------------------------------------------------------
;;; char=?
+
(test (char=? #\d #\d) #t)
(test (char=? #\A #\a) #f)
(test (char=? #\d #\x) #f)
@@ -1323,7 +3572,9 @@
(test (char=? #\a #\b 0) 'error)
+;;; --------------------------------------------------------------------------------
;;; char<?
+
(test (char<? #\z #\0) #f)
(test (char<? #\d #\x) #t)
(test (char<? #\d #\d) #f)
@@ -1356,7 +3607,9 @@
+;;; --------------------------------------------------------------------------------
;;; char<=?
+
(test (char<=? #\d #\x) #t)
(test (char<=? #\d #\d) #t)
@@ -1389,7 +3642,9 @@
+;;; --------------------------------------------------------------------------------
;;; char>?
+
(test (char>? #\e #\d) #t)
(test (char>? #\z #\a) #t)
(test (char>? #\A #\B) #f)
@@ -1421,7 +3676,9 @@
+;;; --------------------------------------------------------------------------------
;;; char>=?
+
(test (char>=? #\e #\d) #t)
(test (char>=? #\A #\B) #f)
(test (char>=? #\a #\b) #f)
@@ -1451,7 +3708,9 @@
+;;; --------------------------------------------------------------------------------
;;; char-ci=?
+
(test (char-ci=? #\A #\B) #f)
(test (char-ci=? #\a #\B) #f)
(test (char-ci=? #\A #\b) #f)
@@ -1475,7 +3734,9 @@
+;;; --------------------------------------------------------------------------------
;;; char-ci<?
+
(test (char-ci<? #\A #\B) #t)
(test (char-ci<? #\a #\B) #t)
(test (char-ci<? #\A #\b) #t)
@@ -1496,19 +3757,19 @@
(test (char-ci>? (integer->char #xf0) (integer->char #x70)) #t)
#|
-;;; this tries them all:
- (do ((i 0 (+ i 1)))
- ((= i 256))
- (do ((k 0 (+ k 1)))
- ((= k 256))
- (let ((c1 (integer->char i))
- (c2 (integer->char k)))
- (for-each
- (lambda (op1 op2)
- (if (not (eq? (op1 c1 c2) (op2 (string c1) (string c2))))
- (format #t ";(~A|~A ~A ~A) -> ~A|~A~%" op1 op2 c1 c2 (op1 c1 c2) (op2 (string c1) (string c2)))))
- (list char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?)
- (list string=? string<? string<=? string>? string>=? string-ci=? string-ci<? string-ci<=? string-ci>? string-ci>=?)))))
+ ;; this tries them all:
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (do ((k 0 (+ k 1)))
+ ((= k 256))
+ (let ((c1 (integer->char i))
+ (c2 (integer->char k)))
+ (for-each
+ (lambda (op1 op2)
+ (if (not (eq? (op1 c1 c2) (op2 (string c1) (string c2))))
+ (format-logged #t ";(~A|~A ~A ~A) -> ~A|~A~%" op1 op2 c1 c2 (op1 c1 c2) (op2 (string c1) (string c2)))))
+ (list char=? char<? char<=? char>? char>=? char-ci=? char-ci<? char-ci<=? char-ci>? char-ci>=?)
+ (list string=? string<? string<=? string>? string>=? string-ci=? string-ci<? string-ci<=? string-ci>? string-ci>=?)))))
|#
(test (char-ci<? #\d #\D #\d #\d) #f)
@@ -1527,7 +3788,9 @@
+;;; --------------------------------------------------------------------------------
;;; char-ci>?
+
(test (char-ci>? #\A #\B) #f)
(test (char-ci>? #\a #\B) #f)
(test (char-ci>? #\A #\b) #f)
@@ -1556,7 +3819,9 @@
(test (char-ci>? #\d #\C #\a) #t)
+;;; --------------------------------------------------------------------------------
;;; char-ci<=?
+
(test (char-ci<=? #\A #\B) #t)
(test (char-ci<=? #\a #\B) #t)
(test (char-ci<=? #\A #\b) #t)
@@ -1588,7 +3853,9 @@
+;;; --------------------------------------------------------------------------------
;;; char-ci>=?
+
(test (char-ci>=? #\A #\B) #f)
(test (char-ci>=? #\a #\B) #f)
(test (char-ci>=? #\A #\b) #f)
@@ -1623,8 +3890,10 @@
+;;; --------------------------------------------------------------------------------
;;; integer->char
;;; char->integer
+
(test (integer->char (char->integer #\.)) #\.)
(test (integer->char (char->integer #\A)) #\A)
(test (integer->char (char->integer #\a)) #\a)
@@ -1634,7 +3903,7 @@
(do ((i 0 (+ i 1)))
((= i 256))
(if (not (= (char->integer (integer->char i)) i))
- (format #t ";char->integer ~D ~A != ~A~%" i (integer->char i) (char->integer (integer->char i)))))
+ (format-logged #t ";char->integer ~D ~A != ~A~%" i (integer->char i) (char->integer (integer->char i)))))
(test (reinvert 12 integer->char char->integer 60) 60)
@@ -1651,26 +3920,27 @@
(for-each
(lambda (arg)
(test (char->integer arg) 'error))
- (list -1 1 0 123456789 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list -1 1 0 123456789 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (integer->char arg) 'error))
- (list -1 257 123456789 -123456789 #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list -1 257 123456789 -123456789 #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi most-positive-fixnum 1/0 (if #f #f) (lambda (a) (+ a 1))))
(test (#\a) 'error)
(test (#\newline 1) 'error)
-
;;; --------------------------------------------------------------------------------
;;; STRINGS
;;; --------------------------------------------------------------------------------
+;;; --------------------------------------------------------------------------------
;;; string?
+
(test (string? "abc") #t)
(test (string? ':+*/-) #f)
(test (string? "das ist einer der teststrings") #t)
@@ -1684,8 +3954,8 @@
(for-each
(lambda (arg)
(test (string? arg) #f))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (string?) 'error)
(test (string? "hi" "ho") 'error)
@@ -1693,7 +3963,9 @@
+;;; --------------------------------------------------------------------------------
;;; string=?
+
(test (string=? "foo" "foo") #t)
(test (string=? "foo" "FOO") #f)
(test (string=? "foo" "bar") #f)
@@ -1730,10 +4002,8 @@
(test (string=? "" (string-append)) #t)
(test (string=? (string #\space #\newline) " \n") #t)
-(test (string=? "......" "...\ ...") #t)
(test (string=? "......" "...\
...") #t)
-(test (string=? "" "\ \ \ \ \ \ \ ") #t)
(test (string=? "\n" (string #\newline)) #t)
(test (string=? "\
\
@@ -1748,28 +4018,25 @@
(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #f)
(test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #t)
(test (let ((s1 "1234") (s2 "124")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #f)
+(test (string=? (make-string 3 #\space) (let ((s (make-string 4 #\space))) (set! (s 3) #\null) s)) #f)
(test "\x3012" "012")
(for-each
(lambda (arg)
(test (string=? "hi" arg) 'error)
(test (string=? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
;; this strikes me as highly dubious
(test (call-with-input-string "1\n2" (lambda (p) (read p))) 1)
(test (call-with-input-string "1\\ \n2" (lambda (p) (read p))) (symbol "1\\"))
-(test (call-with-input-string "1\ 2" (lambda (p) (read p))) 12)
-(test (call-with-input-string "1\ \ \ 2" (lambda (p) (read p))) 12)
(test (call-with-input-string "1\
2" (lambda (p) (read p))) 12)
-(test (call-with-input-string "1\ \
-2" (lambda (p) (read p))) 12)
-
+;; do we guarantee that read takes place in the current environment?
(test (let ((xyzzy 32)) (call-with-input-string "xy\
zzy" (lambda (p) (read p)))) 'xyzzy)
@@ -1785,14 +4052,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
and more commentary
321)" (lambda (p) (eval (read p)))) xyzzy) 321)
-(test (eval-string "1\ 2") 12)
-(test (length "\ \ \ \ \ \ \ ") 0)
-(test (eval-string "(length \"\\ 1\")") 1)
-(test (eval-string "\"\\ \x30\\ \"") "0") ; (integer->char #x30) = "0"
-
+;;; --------------------------------------------------------------------------------
;;; string<?
+
(test (string<? "aaaa" "aaab") #t)
(test (string<? "aaaa" "aaaaa") #t)
(test (string<? "" "abcdefgh") #t)
@@ -1837,12 +4101,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string<? "hi" arg) 'error)
(test (string<? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string>?
+
(test (string>? "aaab" "aaaa") #t)
(test (string>? "aaaaa" "aaaa") #t)
(test (string>? "" "abcdefgh") #f)
@@ -1886,12 +4152,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string>? "hi" arg) 'error)
(test (string>? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string<=?
+
(test (string<=? "aaa" "aaaa") #t)
(test (string<=? "aaaaa" "aaaa") #f)
(test (string<=? "a" "abcdefgh") #t)
@@ -1933,12 +4201,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string<=? "hi" arg) 'error)
(test (string<=? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string>=?
+
(test (string>=? "aaaaa" "aaaa") #t)
(test (string>=? "aaaa" "aaaa") #t)
(test (string>=? "aaa" "aaaa") #f)
@@ -1983,12 +4253,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string>=? "hi" arg) 'error)
(test (string>=? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string-ci=?
+
(test (string-ci=? "A" "B") #f)
(test (string-ci=? "a" "B") #f)
(test (string-ci=? "A" "b") #f)
@@ -2019,34 +4291,37 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string-ci=? "hi" arg) 'error)
(test (string-ci=? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
-#|
-(let ((size 15)
- (tries 10000))
- (let ((str1 (make-string size))
- (str2 (make-string size)))
- (do ((i 0 (+ i 1)))
- ((= i tries))
- (do ((k 0 (+ k 1)))
- ((= k size))
- (set! (str1 k) (integer->char (random 128)))
- (if (> (random 10) 4)
- (set! (str2 k) (char-upcase (str1 k)))
- (set! (str2 k) (char-downcase (str1 k)))))
- (if (not (string-ci=? str1 str2))
- (format #t "not =: ~S ~S~%" str1 str2))
- (if (and (string-ci<? str1 str2)
- (string-ci>=? str1 str2))
- (format #t "< : ~S ~S~%" str1 str2))
- (if (and (string-ci>? str1 str2)
- (string-ci<=? str1 str2))
- (format #t "> : ~S ~S~%" str1 str2)))))
-|#
+(when full-test
+ (let ((size 15)
+ (tries 10000))
+ (let ((str1 (make-string size))
+ (str2 (make-string size)))
+ (do ((i 0 (+ i 1)))
+ ((= i tries))
+ (do ((k 0 (+ k 1)))
+ ((= k size))
+ (set! (str1 k) (integer->char (random 128)))
+ (if (> (random 10) 4)
+ (set! (str2 k) (char-upcase (str1 k)))
+ (set! (str2 k) (char-downcase (str1 k)))))
+ (if (not (string-ci=? str1 str2))
+ (format-logged #t "not =: ~S ~S~%" str1 str2))
+ (if (and (string-ci<? str1 str2)
+ (string-ci>=? str1 str2))
+ (format-logged #t "< : ~S ~S~%" str1 str2))
+ (if (and (string-ci>? str1 str2)
+ (string-ci<=? str1 str2))
+ (format-logged #t "> : ~S ~S~%" str1 str2))))))
+
+
+;;; --------------------------------------------------------------------------------
;;; string-ci<?
+
(test (string-ci<? "a" "Aa") #t)
(test (string-ci<? "A" "B") #t)
(test (string-ci<? "a" "B") #t)
@@ -2075,7 +4350,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string-ci<? "NX7" "-;h>P" "DMhk3Bg") #f)
(test (string-ci<? "+\\mZl" "bE7\\e(HaW5CDXbPi at U_" "B_") #t)
-(test (string-ci<? (string (integer->char #xf0)) (string (integer->char #x70))) #f)
+(if (char-ci<? (integer->char #xf0) (integer->char #x70))
+ (test (string-ci<? (string (integer->char #xf0)) (string (integer->char #x70))) #t))
(test (string-ci<? "foo" "fo" 1.0) 'error)
(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci<? s1 s2)) #t)
@@ -2091,13 +4367,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string-ci<? "hi" arg) 'error)
(test (string-ci<? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string-ci>?
+
(test (string-ci>? "Aaa" "AA") #t)
(test (string-ci>? "A" "B") #f)
(test (string-ci>? "a" "B") #f)
@@ -2136,13 +4413,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string-ci>? "hi" arg) 'error)
(test (string-ci>? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string-ci<=?
+
(test (string-ci<=? "A" "B") #t)
(test (string-ci<=? "a" "B") #t)
(test (string-ci<=? "A" "b") #t)
@@ -2179,13 +4457,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string-ci<=? "hi" arg) 'error)
(test (string-ci<=? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string-ci>=?
+
(test (string-ci>=? "A" "B") #f)
(test (string-ci>=? "a" "B") #f)
(test (string-ci>=? "A" "b") #f)
@@ -2224,13 +4503,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(test (string-ci>=? "hi" arg) 'error)
(test (string-ci>=? arg "hi") 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string-length
+
(test (string-length "abc") 3)
(test (string-length "") 0)
(test (string-length (string)) 0)
@@ -2257,28 +4537,43 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string-length "(string #\\( #\\+ #\\space #\\1 #\\space #\\3 #\\))") 44)
(test (string-length) 'error)
(test (string-length "hi" "ho") 'error)
-(test (string-length "..\ ..") 4)
(test (string-length (string #\null)) 1) ; ??
(test (string-length (string #\null #\null)) 2) ; ??
(test (string-length (string #\null #\newline)) 2) ; ??
+(test (string-length ``"hi") 2) ; ?? and in s7 ,"hi" is "hi" as with numbers
+
+(test (string-length ";~S ~S") 6)
+(test (string-length "\n;~S ~S") 7)
+(test (string-length "\n\t") 2)
+(test (string-length "#\newline") 8)
+(test (string-length "#\tab") 4)
+(test (string-length "a\x00b") 3)
+
+(test (string-length "123\
+456") 6)
+(test (string-length"123\n
+456") 8)
+(test (string-length"123\n\
+456") 7)
(for-each
(lambda (arg)
(test (string-length arg) 'error))
- (list #\a '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
-
+ (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string
+
(for-each
(lambda (arg)
(test (string #\a arg) 'error)
(test (string #\a #\null arg) 'error)
(test (string arg) 'error))
- (list '() (list 1) '(1 . 2) "a" #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list () (list 1) '(1 . 2) "a" #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (string) "")
(test (string #\a #\b #\c) "abc")
@@ -2291,12 +4586,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string #\\ #\\ #\# #\\ #\# #\#) "\\\\#\\##")
(test (string #\' #\' #\` #\") '"''`\"")
;;; some schemes accept \' and other such sequences in a string, but the spec only mentions \\ and \"
-(test (string '()) 'error)
+(test (string ()) 'error)
(test (string "j" #\a) 'error)
+
+;;; --------------------------------------------------------------------------------
;;; make-string
+
(test (make-string 0) "")
(test (make-string 3 #\a) "aaa")
(test (make-string 0 #\a) "")
@@ -2309,34 +4607,36 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (make-string) 'error)
(test (make-string most-positive-fixnum) 'error)
(test (make-string most-negative-fixnum) 'error)
+(let () (define (hi size) (make-string size (integer->char (+ 1 (random 255))))) (string? (hi 3)))
(for-each
(lambda (arg)
(test (make-string 3 arg) 'error))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (make-string arg #\a) 'error))
- (list #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (make-string arg) 'error))
- (list #\a "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; string-ref
+
(test (string-ref "abcdef-dg1ndh" 0) #\a)
(test (string-ref "abcdef-dg1ndh" 1) #\b)
(test (string-ref "abcdef-dg1ndh" 6) #\-)
(test (string-ref "\"\\\"" 1) #\\)
(test (string-ref "\"\\\"" 2) #\")
-(test (string-ref "12\ 34" 2) #\3)
(test (let ((str (make-string 3 #\x))) (set! (string-ref str 1) #\a) str) "xax")
@@ -2358,14 +4658,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (string-ref arg 0) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (string-ref "hiho" arg) 'error))
- (list #\a -1 123 4 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a -1 123 4 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test ("hi" 1) #\i)
(test (("hi" 1) 0) 'error)
@@ -2379,9 +4679,17 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test ((let () "hi")) 'error)
(test ((let () "hi") 0) #\h)
+(test ("abs" most-negative-fixnum) 'error)
+(test (string-ref "abs" most-negative-fixnum) 'error)
+(test ("abs" (+ 1 most-negative-fixnum)) 'error)
+(test ("abs" most-positive-fixnum) 'error)
+
+
+;;; --------------------------------------------------------------------------------
;;; string-copy
+
(test (let ((hi (string-copy "hi"))) (string-set! hi 0 #\H) hi) "Hi")
(test (let ((hi (string-copy "hi"))) (string-set! hi 1 #\H) hi) "hH")
(test (let ((hi (string-copy "\"\\\""))) (string-set! hi 0 #\a) hi) "a\\\"")
@@ -2402,14 +4710,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (string-copy arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (length (string-copy (string #\null))) 1)
-
+;;; --------------------------------------------------------------------------------
;;; string-set!
+
(let ((str (make-string 10 #\x)))
(string-set! str 3 (integer->char 0))
(test (string=? str "xxx") #f)
@@ -2425,6 +4734,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (set! ("hi" 1) "ho") 'error)
(test (set! ("hi") #\i) 'error)
(test (let ((x "hi") (y 'x)) (string-set! y 0 #\x) x) 'error)
+(test (let ((str "ABS")) (set! (str 0) #\a)) #\a)
+(test (let ((str "ABS")) (string-set! str 0 #\a)) #\a)
+(test (let ((str "ABS")) (set! (string-ref str 0) #\a)) #\a)
(test (let ((hi (make-string 3 #\a)))
(string-set! hi 1 (let ((ho (make-string 4 #\x)))
@@ -2445,37 +4757,45 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((ho (make-string 0 #\x))) (string-set! ho 0 #\a) ho) 'error)
(test (let ((str "hi")) (string-set! (let () str) 1 #\a) str) "ha") ; (also in Guile)
(test (let ((x 2) (str "hi")) (string-set! (let () (set! x 3) str) 1 #\a) (list x str)) '(3 "ha"))
-(test (let ((str "hi")) (set! ((let () str) 1) #\a) str) "ha")
+(test (let ((str "hi")) (set! ((let () str) 1) #\b) str) "hb")
(test (let ((str "hi")) (string-set! (let () (string-set! (let () str) 0 #\x) str) 1 #\x) str) "xx")
(test (let ((str "hi")) (string-set! (let () (set! str "hiho") str) 3 #\x) str) "hihx") ; ! (this works in Guile also)
(for-each
(lambda (arg)
(test (string-set! arg 0 #\a) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (string-set! "hiho" arg #\a) 'error))
- (list #\a -1 123 4 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a -1 123 4 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (string-set! "hiho" 0 arg) 'error))
- (list 1 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list 1 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (equal? (let ((str "hiho")) (string-set! str 2 #\null) str) "hi") #f)
(test (string=? (let ((str "hiho")) (string-set! str 2 #\null) str) "hi") #f)
(test (let* ((s1 "hi") (s2 s1)) (string-set! s2 1 #\x) s1) "hx")
(test (let* ((s1 "hi") (s2 (copy s1))) (string-set! s2 1 #\x) s1) "hi")
+(test (eq? (car (catch #t (lambda () (set! ("hi") #\a)) (lambda args args))) 'wrong-number-of-args) #t)
+(test (eq? (car (catch #t (lambda () (set! ("hi" 0 0) #\a)) (lambda args args))) 'wrong-number-of-args) #t) ; (vector-set! 1 ...)
+(test (eq? (car (catch #t (lambda () (set! (("hi" 0) 0) #\a)) (lambda args args))) 'syntax-error) #t) ; (set! (1 ...))
+
+(test (let ((s "012345")) (set! (apply s 2) #\a) s) 'error)
+(test (string-set! #u8(0 1 0) 0 -9223372036854775808) 'error)
+;;; --------------------------------------------------------------------------------
;;; string-fill!
+
(test (string-fill! "hiho" #\c) #\c)
(test (string-fill! "" #\a) #\a)
(test (string-fill! "hiho" #\a) #\a)
@@ -2495,18 +4815,76 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (let ((hiho "hiho")) (string-fill! hiho arg) hiho) 'error))
- (list 1 "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list 1 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (string-fill! arg #\a) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (let ((str "1234567890")) (string-fill! str #\a 0) str) "aaaaaaaaaa")
+(test (let ((str "1234567890")) (string-fill! str #\a 0 10) str) "aaaaaaaaaa")
+(test (let ((str "1234567890")) (string-fill! str #\a 0 0) str) "1234567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 4 4) str) "1234567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 10 10) str) "1234567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 0 4) str) "aaaa567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 3 4) str) "123a567890")
+(test (let ((str "1234567890")) (string-fill! str #\a 1 9) str) "1aaaaaaaa0")
+(test (let ((str "1234567890")) (string-fill! str #\a 8) str) "12345678aa")
+(test (let ((str "1234567890")) (string-fill! str #\a 1 9 0) str) 'error)
+(test (let ((str "1234567890")) (string-fill! str #\a 1 0) str) 'error)
+(test (let ((str "1234567890")) (string-fill! str #\a 11) str) 'error)
+(test (let ((str "1234567890")) (string-fill! str #\a 9 11) str) 'error)
+(test (string-fill! "" 0 "hi") 'error)
+(test (string-fill! "" 0 -1 3) 'error)
+(test (string-fill! "" 0 1) 'error)
+(test (string-fill! "" 0 0 4/3) 'error)
+
+
+;;; --------------------------------------------------------------------------------
+;;; string-upcase
+;;; string-downcase
+
+(test (string-downcase "") "")
+(test (string-downcase "a") "a")
+(test (string-downcase "A") "a")
+(test (string-downcase "AbC") "abc")
+(test (string-downcase "\"\\\"") "\"\\\"")
+(test (let ((hi "abc")) (eq? hi (string-downcase hi))) #f)
+(test (string-downcase (string-upcase (string-downcase "a"))) "a")
+(test (string-downcase "a\x00b") "a\x00b")
+(test (string-downcase (string #\1 #\null #\2)) (string #\1 #\null #\2))
+(test (string-downcase) 'error)
+(test (string-downcase "hi" "ho") 'error)
+
+(test (string-upcase "") "")
+(test (string-upcase "a") "A")
+(test (string-upcase "A") "A")
+(test (string-upcase "AbC") "ABC")
+(test (string-upcase "\"\\\"") "\"\\\"")
+(test (let ((hi "ABC")) (eq? hi (string-upcase hi))) #f)
+(test (string-upcase (string-downcase (string-upcase "a"))) "A")
+(test (string-upcase "a\x00b") "A\x00B")
+(test (string-upcase (string #\1 #\null #\2)) (string #\1 #\null #\2))
+(test (string-upcase) 'error)
+(test (string-upcase "hi" "ho") 'error)
+
+(for-each
+ (lambda (arg)
+ (test (string-downcase arg) 'error)
+ (test (string-upcase arg) 'error))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+;;; for r7rs, these need to be unicode-aware
+;;; --------------------------------------------------------------------------------
;;; substring
+
(test (substring "ab" 0 0) "")
(test (substring "ab" 1 1) "")
(test (substring "ab" 2 2) "")
@@ -2534,10 +4912,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (substring "hi\"ho" 3 5) "ho")
(test (substring (substring "hi\"ho" 1 4) 2) "h")
(test (substring (substring "hi\"ho" 3 5) 1 2) "o")
-(test (substring "01\ \ 34" 2) "34")
(test (let* ((s1 "0123456789") (s2 (substring s1 1 3))) (string-set! s2 1 #\x) s1) "0123456789")
(test (substring (substring "" 0 0) 0 0) "")
(test (substring (format #f "") 0 0) "")
+(test (string=? (substring (substring (substring "01234567" 1) 1) 1) "34567") #t)
+(let ()
+ (define (hi) (string=? (substring (substring (substring "01234567" 1) 1) 1) "34567"))
+ (define (ho) (hi)) (ho)
+ (test (ho) #t))
(test (substring "012" 3) "")
(test (substring "012" 10) 'error)
@@ -2580,25 +4962,68 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (substring "hiho" arg 0) 'error))
- (list "hi" #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (substring "0123" arg) 'error)
(test (substring "hiho" 1 arg) 'error))
- (list "hi" #\a -1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a -1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (substring arg 1 2) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(define (substring? pattern target) ; taken from net somewhere (umich?) with changes for s7 (which now has string-position, so this is unneeded)
+ (define (build-shift-vector pattern)
+ (let* ((pat-len (length pattern))
+ (shift-vec (make-vector 256 (+ pat-len 1)))
+ (max-pat-index (- pat-len 1)))
+ (let loop ((index 0))
+ (set! (shift-vec (char->integer (pattern index))) (- pat-len index))
+ (if (< index max-pat-index)
+ (loop (+ index 1))
+ shift-vec))))
+ (if (or (not (string? pattern))
+ (not (string? target)))
+ (error 'wrong-type-arg "substring? args should be strings: ~S ~S" pattern target)
+ (let ((pat-len (length pattern)))
+ (if (zero? pat-len)
+ 0
+ (let ((shift-vec (build-shift-vector pattern)))
+ (let* ((tar-len (length target))
+ (max-tar-index (- tar-len 1))
+ (max-pat-index (- pat-len 1)))
+ (let outer ((start-index 0))
+ (if (> (+ pat-len start-index) tar-len)
+ #f
+ (let inner ((p-ind 0) (t-ind start-index))
+ (cond
+ ((> p-ind max-pat-index) #f) ; nothing left to check
+ ((char=? (pattern p-ind) (target t-ind))
+ (if (= p-ind max-pat-index)
+ start-index ; success -- return start index of match
+ (inner (+ p-ind 1) (+ t-ind 1)))) ; keep checking
+ ((> (+ pat-len start-index) max-tar-index) #f) ; fail
+ (else (outer (+ start-index (shift-vec (char->integer (target (+ start-index pat-len)))))))))))))))))
+
+(test (substring? "hiho" "test hiho test") 5)
+(test (substring? "hiho" "test hihptest") #f)
+(test (substring? "hiho" "test hih") #f)
+(test (substring? "hiho" "") #f)
+(test (substring? "hiho" "hiho") 0)
+(test (substring? "" "hiho") 0)
+(test (substring? "abc" 'abc) 'error)
+;;; --------------------------------------------------------------------------------
;;; string-append
+
(test (string-append "hi" "ho") "hiho")
(test (string-append "hi") "hi")
(test (string-append "hi" "") "hi")
@@ -2611,7 +5036,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((hi "hi")) (let ((ho (string-append hi))) (eq? hi ho))) #f)
(test (let ((hi "hi")) (let ((ho (string-append hi))) (string-set! ho 0 #\a) hi)) "hi")
(test (let ((hi "hi")) (set! hi (string-append hi hi hi hi)) hi) "hihihihi")
-(test (string-append '()) 'error)
+(test (string-append ()) 'error)
(test (string=? (string-append "012" (string #\null) "456")
(let ((str "0123456")) (string-set! str 3 #\null) str))
#t)
@@ -2671,8 +5096,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string-append "hiho" arg) 'error)
(test (string-append arg "hi") 'error)
(test (string-append "a" "b" arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (let ((str (make-string 4 #\x))
@@ -2732,20 +5157,23 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string-ci>? str str1) #t)
(test (string-length (string-append str str1)) 2048)
- )))
+ ))))
|#
+
+;;; --------------------------------------------------------------------------------
;;; string->list
;;; list->string
+
(test (string->list "abc") (list #\a #\b #\c))
-(test (string->list "") '())
-(test (string->list (make-string 0)) '())
+(test (string->list "") ())
+(test (string->list (make-string 0)) ())
(test (string->list (string #\null)) '(#\null))
-(test (string->list (string)) '())
-(test (string->list (substring "hi" 0 0)) '())
+(test (string->list (string)) ())
+(test (string->list (substring "hi" 0 0)) ())
(test (string->list (list->string (list #\a #\b #\c))) (list #\a #\b #\c))
-(test (string->list (list->string '())) '())
+(test (string->list (list->string ())) ())
(test (list->string (string->list "abc")) "abc")
(test (list->string (string->list "hi there")) "hi there")
(test (list->string (string->list "&*#%^@%$)~@")) "&*#%^@%$)~@")
@@ -2755,7 +5183,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(and (string=? str "abc")
(equal? lst (list #\a #\b #\c))))
#t)
-(test (list->string '()) "")
+(test (list->string ()) "")
(test (list->string (list #\a #\b #\c)) "abc")
(test (list->string (list)) "")
@@ -2769,15 +5197,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string->list) 'error)
(test (list->string) 'error)
(test (string->list "hi" "ho") 'error)
-(test (list->string '() '(1 2)) 'error)
+(test (list->string () '(1 2)) 'error)
(test (string->list " hi ") '(#\space #\h #\i #\space))
(test (string->list (string (integer->char #xf0) (integer->char #x70))) (list (integer->char #xf0) (integer->char #x70)))
(for-each
(lambda (arg)
(test (string->list arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->string x)) 'error)
(test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (list->string lst)) 'error)
@@ -2786,8 +5214,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (list->string arg) 'error))
- (list "hi" #\a 1 ''foo '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a 1 ''foo '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(let ((str (list->string '(#\x #\space #\null #\x))))
(test (length str) 4)
@@ -2811,42 +5239,43 @@ zzy" (lambda (p) (eval (read p))))) 32)
(newstrlen (length newstr)))
(if (or (not (= lstlen strlen newstrlen))
(not (string=? newstr str)))
- (format #t ";string->list->string: ~S -> ~A -> ~S~%" str lst newstr))))))))
-
-#|
-(define (all-strs len file)
- (let* ((funny-chars (list #\` #\# #\, #\@ #\' #\" #\. #\( #\) #\\))
- (num-chars (length funny-chars)))
- (let ((ctrs (make-vector len 0)))
-
- (do ((i 0 (+ i 1)))
- ((= i (expt num-chars len)))
- (let ((carry #t))
- (do ((k 0 (+ k 1)))
- ((or (= k len)
- (not carry)))
- (vector-set! ctrs k (+ 1 (vector-ref ctrs k)))
- (if (= (vector-ref ctrs k) num-chars)
- (vector-set! ctrs k 0)
- (set! carry #f)))
-
- (let ((strlst '()))
- (do ((k 0 (+ k 1)))
- ((= k len))
- (let ((c (list-ref funny-chars (vector-ref ctrs k))))
- (set! strlst (cons c strlst))))
+ (format-logged #t ";string->list->string: ~S -> ~A -> ~S~%" str lst newstr))))))))
- (let ((str (list->string strlst)))
- (format file "(test (and (string=? ~S (string ~{#\\~C~^ ~})) (equal? '~A (string->list ~S))) #t)~%" str strlst strlst str))))))))
-
-(call-with-output-file "strtst.scm"
- (lambda (p)
- (do ((len 3 (+ len 1)))
- ((= len 5))
- (all-strs len p))))
+(when full-test
+ (let ()
+ (define (all-strs len file)
+ (let* ((funny-chars (list #\` #\# #\, #\@ #\' #\" #\. #\( #\) #\\))
+ (num-chars (length funny-chars)))
+ (let ((ctrs (make-vector len 0)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i (expt num-chars len)))
+ (let ((carry #t))
+ (do ((k 0 (+ k 1)))
+ ((or (= k len)
+ (not carry)))
+ (vector-set! ctrs k (+ 1 (vector-ref ctrs k)))
+ (if (= (vector-ref ctrs k) num-chars)
+ (vector-set! ctrs k 0)
+ (set! carry #f)))
+
+ (let ((strlst ()))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (let ((c (list-ref funny-chars (vector-ref ctrs k))))
+ (set! strlst (cons c strlst))))
+
+ (let ((str (list->string strlst)))
+ (format file "(test (and (string=? ~S (string ~{#\\~C~^ ~})) (equal? '~A (string->list ~S))) #t)~%" str strlst strlst str))))))))
+
+ (call-with-output-file "strtst.scm"
+ (lambda (p)
+ (do ((len 3 (+ len 1)))
+ ((= len 5))
+ (all-strs len p))))
+
+ (load "strtst.scm")))
-(load "strtst.scm")
-|#
(test (and (string=? "\"" (string #\")) (equal? '(#\") (string->list "\""))) #t)
(test (and (string=? "#\\" (string #\# #\\)) (equal? '(#\# #\\) (string->list "#\\"))) #t)
@@ -2878,11 +5307,144 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (and (string=? "\\\"`\"" (string #\\ #\" #\` #\")) (equal? '(#\\ #\" #\` #\") (string->list "\\\"`\""))) #t)
(test (and (string=? "\\\\#\"" (string #\\ #\\ #\# #\")) (equal? '(#\\ #\\ #\# #\") (string->list "\\\\#\""))) #t)
+(test (string->list "" 0 10) 'error)
+(test (string->list "1" 0 2) 'error)
+(test (string->list "" 0 0) ())
+(test (string->list "1" 1) ())
+(test (string->list "1" 0) '(#\1))
+(test (string->list "" #\null) 'error)
+(test (string->list "" 0 #\null) 'error)
+(test (string->list "" -1) 'error)
+(test (string->list "1" -1) 'error)
+(test (string->list "1" 0 -1) 'error)
+(test (string->list "1" -2 -1) 'error)
+(test (string->list "1" most-negative-fixnum) 'error)
+(test (string->list "1" 2) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (string->list "012345" arg) 'error)
+ (test (string->list "012345" 1 arg) 'error))
+ (list #\a "hi" () (list 1) '(1 . 2) 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (string->list "12345" 0) '(#\1 #\2 #\3 #\4 #\5))
+(test (string->list "12345" 0 5) '(#\1 #\2 #\3 #\4 #\5))
+(test (string->list "12345" 5 5) ())
+(test (string->list "12345" 4 5) '(#\5))
+(test (string->list "12345" 2 4) '(#\3 #\4))
+(test (string->list "12345" 2 1) 'error)
+(test (string->list "12345" 2 3 4) 'error)
+(test (string->list (make-string 3 #\null) 2 3) '(#\null))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; char-position
+;;; string-position
+
+(test (char-position) 'error)
+(test (char-position #\a) 'error)
+(test (char-position #\a "abc" #\0) 'error)
+(test (char-position #\a "abc" 0 1) 'error)
+(test (string-position) 'error)
+(test (string-position #\a) 'error)
+(test (string-position "a" "abc" #\0) 'error)
+(test (string-position "a" "abc" 0 1) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (string-position arg "abc") 'error)
+ (test (char-position arg "abc") 'error)
+ (test (string-position "a" arg) 'error)
+ (test (char-position #\a arg) 'error)
+ (test (string-position "a" "abc" arg) 'error)
+ (test (char-position #\a "abc" arg) 'error))
+ (list () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 -1 most-negative-fixnum 1.0+1.0i :hi (if #f #f) (lambda (a) (+ a 1))))
+(test (char-position #\a "abc" most-positive-fixnum) #f)
+(test (char-position "a" "abc" most-positive-fixnum) #f)
+(test (string-position "a" "abc" most-positive-fixnum) #f)
+
+(test (char-position #\b "abc") 1)
+(test (char-position #\b "abc" 0) 1)
+(test (char-position #\b "abc" 1) 1)
+(test (char-position "b" "abc") 1)
+(test (char-position "b" "abc" 1) 1)
+(test (char-position "b" "abc") 1)
+(test (string-position "b" "abc") 1)
+(test (string-position "b" "abc" 1) 1)
+(test (string-position "b" "abc" 2) #f)
+(test (string-position "b" "abc" 3) #f)
+(test (char-position "b" "abc" 2) #f)
+(test (char-position "b" "abc" 3) #f)
+(test (char-position #\b "abc" 2) #f)
+(test (char-position #\b "abc" 3) #f)
+(test (char-position "ab" "abcd") 0)
+(test (char-position "ab" "ffbcd") 2)
+(test (char-position "ab" "ffacd") 2)
+(test (string-position "ab" "ffacd") #f)
+(test (string-position "ab" "ffabd") 2)
+(test (string-position "ab" "ffabab" 2) 2)
+(test (string-position "ab" "ffabab" 3) 4)
+(test (string-position "ab" "ffabab" 4) 4)
+(test (string-position "ab" "ffabab" 5) #f)
+(test (string-position "abc" "ab") #f)
+(test (string-position "abc" "") #f)
+(test (string-position "" "") #f)
+(test (char-position "\"" "a") #f)
+(test (char-position "\"" "a\"b") 1)
+(test (char-position #\" "a\"b") 1)
+(test (string-position "\"hiho\"" "hiho") #f)
+(test (string-position "\"hiho\"" "\"\"hiho\"") 1)
+
+(test (string-position "" "a") #f) ; this is a deliberate choice in s7.c
+(test (char-position "" "a") #f)
+(test (char-position #\null "a") 1) ; ??
+(test (char-position #\null "") #f) ; ??
+(test (string-position (string #\null) "a") 0) ; ??
+(test (string-position (string #\null) "") #f) ; ??
+(test (char-position #\null (string #\null)) 0) ; ??
+(test (char-position #\null (string #\a #\null #\n)) 1)
+(test (char-position "" (string #\a #\null #\n)) #f)
+;(test (char-position #\n (string #\a #\null #\n)) 2) ; ?? returns #f due to assumption of C-style strings
+;(test (char-position "n" (string #\a #\null #\n)) 1) ; oops!
+;(test (string-position "n" (string #\a #\null #\n)) 2) ; oops!
+(test (char-position "" (string #\a #\n)) #f)
+(test (char-position #(1) "asdasd" 63) 'error)
+
+;; if "" as string-pos 1st, -> #f so same for char-pos, even if string contains a null
+
+(let ()
+ ;; actually more of a string-append/temp substring test
+ (define (fixit str)
+ (let ((pos (char-position #\& str)))
+ (if (not pos)
+ str
+ (string-append (substring str 0 pos)
+ (let ((epos (char-position #\; str pos)))
+ (let ((substr (substring str (+ pos 1) epos)))
+ (let ((replacement (if (string=? substr "gt") ">"
+ (if (string=? substr "lt") "<"
+ (if (string=? substr "mdash") "-"
+ (format-logged #t "unknown: ~A~%" substr))))))
+ (string-append replacement
+ (fixit (substring str (+ epos 1)))))))))))
+ (test (fixit "(let ((f (hz->radians 100)) (g (hz->radians 200))) (< f g))")
+ "(let ((f (hz->radians 100)) (g (hz->radians 200))) (< f g))"))
+
+;;; opt bug
+(test (apply char-position '(#\a #u8() #f)) 'error)
+(test (let () (define (f1) (do ((i 0 (+ i 1))) ((= i 1) (char-position #\a #u8() #f)) (char-position #\a #u8() #f))) (f1)) 'error)
+
+;;; --------------------------------------------------------------------------------
;;; symbol->string
;;; string->symbol
+;;; symbol
+
(test (symbol->string 'hi) "hi")
(test (string->symbol (symbol->string 'hi)) 'hi)
(test (eq? (string->symbol "hi") 'hi) #t)
@@ -2906,20 +5468,24 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (symbol->string (string->symbol "hi there")) "hi there")
(test (symbol->string (string->symbol "Hi There")) "Hi There")
(test (symbol->string (string->symbol "HI THERE")) "HI THERE")
-(test (symbol->string (string->symbol "")) "")
+(test (symbol->string (string->symbol "")) 'error) ; this fluctuates
(test (symbol? (string->symbol "(weird name for a symbol!)")) #t)
(test (symbol->string (string->symbol "()")) "()")
(test (symbol->string (string->symbol (string #\"))) "\"")
+(test (symbol->string 'quote) "quote")
+(test (symbol->string if) 'error)
+(test (symbol->string quote) 'error)
(test (symbol? (string->symbol "0")) #t)
(test (symbol? (symbol "0")) #t)
+(test (symbol? (symbol ".")) #t) ; hmmm
+(test (let () (define |.| 1) (+ |.| 2)) 3)
(test (string->symbol "0e") '0e)
(test (string->symbol "1+") '1+)
(test (symbol? (string->symbol "1+i")) #t)
(test (string->symbol ":0") ':0)
(test (symbol? (string->symbol " hi") ) #t)
(test (symbol? (string->symbol "hi ")) #t)
-(test (symbol? (string->symbol "")) #t)
(test (reinvert 12 string->symbol symbol->string "hiho") "hiho")
@@ -2939,28 +5505,25 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (symbol? (string->symbol (string #\x (integer->char 17) #\x))) #t)
(test (symbol? (string->symbol (string #\x (integer->char 170) #\x))) #t)
(test (symbol? (string->symbol (string #\x (integer->char 0) #\x))) #t) ; but the symbol's name here is "x"
-(test (eq? (string->symbol (string #\x (integer->char 0) #\x)) 'x) #t) ; hmmm...
+;(test (eq? (string->symbol (string #\x (integer->char 0) #\x)) 'x) #t) ; hmmm...
(test (symbol? (string->symbol (string #\x #\y (integer->char 127) #\z))) #t) ; xy(backspace)z
(test (symbol? (string->symbol (string #\; #\" #\)))) #t)
(test (let (((symbol ";")) 3) (symbol ";")) 'error)
-(test (symbol? (symbol "")) #t)
-(test (symbol? (symbol (string))) #t)
-(test (symbol? (symbol (make-string 0))) #t)
-(test (symbol? (symbol (string-append))) #t)
+(test (symbol "") 'error)
(for-each
(lambda (arg)
(test (symbol->string arg) 'error))
- (list #\a 1 "hi" '() (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list #\a 1 "hi" () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (string->symbol arg) 'error)
(test (symbol arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
@@ -2971,54 +5534,31 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (symbol) 'error)
(test (symbol "hi" "ho") 'error)
+(let ()
+ (define-macro (string-case selector . clauses)
+ `(case (symbol ,selector)
+ ,@(map (lambda (clause)
+ (if (pair? (car clause))
+ `(,(map symbol (car clause)) ,@(cdr clause))
+ clause))
+ clauses)))
+
+ (test (let ((str "hi"))
+ (string-case str
+ (("hi" "ho") 1 2 3)
+ (("hiho") 2)
+ (else 4)))
+ 3))
+(let ()
+ (apply define (list (symbol "(#)") 3))
+ (test (eval (symbol "(#)")) 3))
-;;; symbol->value
-(let ((sym 0))
- (test (symbol->value 'sym) 0)
- (for-each
- (lambda (arg)
- (set! sym arg)
- (test (symbol->value 'sym) arg))
- (list #\a 1 '() (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1)))))
-
-(for-each
- (lambda (arg)
- (test (symbol->value arg) 'error)
- (test (symbol->value 'abs arg) 'error))
- (list #\a 1 '() (list 1) "hi" '(1 . 2) #f (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
-
-(test (symbol->value) 'error)
-(test (symbol->value 'hi 'ho) 'error)
-
-(test (symbol->value 'abs (initial-environment)) abs)
-(test (symbol->value 'abs (global-environment)) abs)
-(test (symbol->value 'lambda) #<undefined>) ; ?? all "syntax" words are like this, except 'else??
-(test (symbol->value 'do) #<undefined>)
-(test (symbol->value lambda) #<undefined>) ; ??
-(test (symbol->value do) #<undefined>)
-(test (symbol->value 'macroexpand) macroexpand)
-(test (symbol->value 'quasiquote) quasiquote)
-(test (symbol->value 'else) else)
-(test (symbol->value :hi) :hi)
-(test (symbol->value hi:) hi:)
-(test (symbol->value '#<eof>) 'error) ; ??
-(test (symbol? '#<eof>) #f)
-(test (let ((a1 32)) (let () (symbol->value 'a1 (current-environment)))) 32)
-(test (let ((a1 32)) (let ((a1 0)) (symbol->value 'a1 (current-environment)))) 0)
-(test (let ((a1 32)) (let ((a1 0)) (symbol->value 'b1 (current-environment)))) #<undefined>)
-(test (symbol->value 'abs '()) 'error)
-(test (let ((a1 (let ((b1 32)) (lambda () b1)))) (symbol->value 'b1 (procedure-environment a1))) 32)
-(test (let ((x #f)) (set! x (let ((a1 (let ((b1 32)) (lambda () b1)))) a1)) (symbol->value 'b1 (procedure-environment x))) 32)
-
-
-(test (let ((name "hiho"))
- (string-set! name 2 #\null)
- (symbol? (string->symbol name)))
- #t)
-
+(let ()
+ (define (immutable obj) (string->symbol (object->string obj :readable)))
+ (define (symbol->object sym) (eval-string (symbol->string sym)))
+ (test (symbol->object (immutable (list 1 2 3))) (list 1 2 3))
+ (test (symbol->object (immutable "hi")) "hi"))
#|
(let ((str "(let ((X 3)) X)"))
@@ -3032,11 +5572,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (str 7) (integer->char i))
(set! (str 13) (integer->char i))
(let ((val (eval-string str)))
- (format #t "ok: ~S -> ~S~%" str val)))
+ #t)) ;(format-logged #t "ok: ~S -> ~S~%" str val)))
(lambda args
- (format #t "bad but symbol: ~S~%" str))))) ; 11 12 # ' , .
+ (format-logged #t "bad but symbol: ~S~%" str))))) ; 11 12 # ' , .
(lambda args
- (format #t "bad: ~C~%" (integer->char i)))))) ; # ( ) ' " . ` nul 9 10 13 space 0..9 ;
+ (format-logged #t "bad: ~C~%" (integer->char i)))))) ; # ( ) ' " . ` nul 9 10 13 space 0..9 ;
(let ((str "(let ((XY 3)) XY)"))
(do ((i 0 (+ i 1)))
@@ -3053,52 +5593,330 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (str 14) (integer->char i))
(set! (str 15) (integer->char k))
(let ((val (eval-string str)))
- (format #t "ok: ~S -> ~S~%" str val)))
+ #t)) ;(format-logged #t "ok: ~S -> ~S~%" str val)))
(lambda args
- (format #t "bad but symbol: ~S~%" str))))) ; 11 12 # ' , .
+ (format-logged #t "bad but symbol: ~S~%" str))))) ; 11 12 # ' , .
(lambda args
- (format #t "bad: ~C~%" (integer->char i))))))) ; # ( ) ' " . ` nul 9 10 13 space 0..9 ;
+ (format-logged #t "bad: ~C~%" (integer->char i))))))) ; # ( ) ' " . ` nul 9 10 13 space 0..9 ;
|#
+
+;;; --------------------------------------------------------------------------------
+;;; symbol->value
+;;; symbol->dynamic-value
+
+(let ((sym 0))
+ (test (symbol->value 'sym) 0)
+ (test (symbol->dynamic-value 'sym) 0)
+ (for-each
+ (lambda (arg)
+ (set! sym arg)
+ (test (symbol->value 'sym) arg)
+ (test (symbol->dynamic-value 'sym) arg))
+ (list #\a 1 () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+ 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1)))))
+
+(for-each
+ (lambda (arg)
+ (test (symbol->value arg) 'error)
+ (test (symbol->value 'abs arg) 'error)
+ (test (symbol->dynamic-value arg) 'error)
+ (test (symbol->dynamic-value 'abs arg) 'error))
+ (list #\a 1 () (list 1) "hi" '(1 . 2) #f (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (symbol->value) 'error)
+(test (symbol->value 'hi 'ho) 'error)
+(test (symbol->dynamic-value) 'error)
+(test (symbol->dynamic-value 'hi 'ho) 'error)
+
+(test (symbol->value 'abs (unlet)) abs)
+(test (symbol->value 'abs (rootlet)) abs)
+(test (symbol->value 'lambda) lambda)
+(test (symbol->value 'do) do)
+(test (symbol->value do) 'error)
+(test (symbol->value 'macroexpand) macroexpand)
+(test (symbol->value 'quasiquote) quasiquote)
+(test (symbol->value 'else) else)
+(test (symbol->value :hi) :hi)
+(test (symbol->value hi:) hi:)
+
+(test (symbol->dynamic-value 'lambda) lambda)
+(test (symbol->dynamic-value 'do) do)
+(test (symbol->dynamic-value do) 'error)
+(test (symbol->dynamic-value 'macroexpand) macroexpand)
+(test (symbol->dynamic-value 'quasiquote) quasiquote)
+(test (symbol->dynamic-value 'else) else)
+(test (symbol->dynamic-value :hi) :hi)
+(test (symbol->dynamic-value hi:) hi:)
+
+(test (symbol->value '#<eof>) 'error) ; because it's not a symbol:
+(test (symbol? '#<eof>) #f)
+(test (let ((a1 32)) (let () (symbol->value 'a1 (curlet)))) 32)
+(test (let ((a1 32)) (let ((a1 0)) (symbol->value 'a1 (curlet)))) 0)
+(test (let ((a1 32)) (let ((a1 0)) (symbol->value 'b1 (curlet)))) #<undefined>)
+(test (symbol->value 'abs ()) 'error)
+(test (let ((a1 (let ((b1 32)) (lambda () b1)))) (symbol->value 'b1 (funclet a1))) 32)
+(test (let ((x #f)) (set! x (let ((a1 (let ((b1 32)) (lambda () b1)))) a1)) (symbol->value 'b1 (funclet x))) 32)
+(test (symbol->value 'if) if)
+(test (symbol->value if) 'error)
+(test ((define (hi a) (+ a 1)) 2) 3)
+(test ((define-macro (hi a) `(+ ,a 1)) 2) 3)
+(test (let ((mac (define-macro (hi a) `(+ ,a 1)))) (mac 3)) 4)
+
+(test (eq? #_abs (symbol->value 'abs 'unlet)) #t)
+(test (eq? #_lambda (symbol->value 'lambda 'unlet)) #t)
+
+(let ()
+ (define *ds* 0)
+ (define (get-ds) (list *ds* (symbol->dynamic-value '*ds*)))
+ (test (get-ds) '(0 0))
+ (let ((*ds* 32))
+ (test (values (get-ds)) '(0 32)))
+ (let ((*ds* 3))
+ (define (gds) (list *ds* (symbol->dynamic-value '*ds*)))
+ (test (list (get-ds) (gds)) '((0 3) (3 3)))
+ (let ((*ds* 123))
+ (test (list (get-ds) (gds)) '((0 123) (3 123)))))
+ (let ((*ds* 3))
+ (define (gds) (list *ds* (symbol->dynamic-value '*ds*)))
+ (let ((*ds* 123))
+ (set! *ds* 321)
+ (test (list (get-ds) (gds)) '((0 321) (3 321))))))
+
+(test (symbol->dynamic-value 'asdasfasdasfg) #<undefined>)
+
+(let ((x 32))
+ (define (gx) (symbol->dynamic-value 'x))
+ (let ((x 12))
+ (test (values (gx)) 12)))
+
+(let ((x "hi")
+ (y 0)
+ (z '(1 2 3)))
+ (define (gx) (+ (symbol->dynamic-value 'x) (symbol->dynamic-value 'z)))
+ (let ((x 32)
+ (z (+ 123 (car z))))
+ (test (values (gx)) 156)))
+
+(let ((x 32))
+ (define (gx) (symbol->dynamic-value 'x))
+ (let ((x 100))
+ (let ((x 12))
+ (test (values (gx)) 12))))
+
+(let ((x 32))
+ (define (gx) ; return both bindings of 'x
+ (list x (symbol->value 'x) (symbol->dynamic-value 'x)))
+ (let ((x 100))
+ (let ((x 12))
+ (test (values (gx)) '(32 32 12)))))
+
+(let ((bindings ()))
+ ;; taken from the MIT_Scheme documentation (changing fluid-let to let)
+
+ (define (write-line v)
+ (set! bindings (cons v bindings)))
+
+ (define (complicated-dynamic-binding)
+ (let ((variable 1)
+ (inside-continuation #f))
+ (write-line variable)
+ (call-with-current-continuation
+ (lambda (outside-continuation)
+ (let ((variable 2))
+ (write-line variable)
+ (set! variable 3)
+ (call-with-current-continuation
+ (lambda (k)
+ (set! inside-continuation k)
+ (outside-continuation #t)))
+ (write-line variable)
+ (set! inside-continuation #f))))
+ (write-line variable)
+ (if inside-continuation
+ (begin
+ (set! variable 4)
+ (inside-continuation #f)))))
+
+ (complicated-dynamic-binding)
+ (test (reverse bindings) '(1 2 1 3 4)))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; BYTE-VECTORS
+;;; --------------------------------------------------------------------------------
+
+(let ((bv #u8(1 0 3)))
+ (test bv #u8(1 0 3))
+ (test (object->string bv) "#u8(1 0 3)")
+ (test (equal? bv #u8(1 0 3)) #t)
+ (test (eq? bv bv) #t)
+ (test (eqv? bv bv) #t)
+ (test (equal? (byte-vector 1 0 3) #u8(1 0 3)) #t)
+ (test (byte-vector? bv) #t)
+ (test (equal? (make-byte-vector 3) #u8(0 0 0)) #t)
+ (test (string-ref #u8(64 65 66) 1) #\A)
+ (test (let ((nbv (copy bv))) (equal? nbv bv)) #t)
+ (test (let ((rbv (reverse bv))) (equal? rbv #u8(3 0 1))) #t)
+ (test (length bv) 3)
+ )
+
+(test (eval-string "#u8(-1)") 'error)
+(test (eval-string "#u8(1.0)") 'error)
+(test (eval-string "#u8(3/2)") 'error)
+(test (eval-string "#u8(1+i)") 'error)
+(test (eval-string "#u8((32))") 'error)
+(test (eval-string "#u8(#\\a)") 'error)
+(test (eval-string "#u8(256)") 'error)
+(test (eval-string "#u8(1/0)") 'error)
+(test (eval-string "#u8(9223372036854775807)") 'error)
+(test (eval-string "#u8(-9223372036854775808)") 'error)
+(test #u8(#b11 #x8) #u8(3 8))
+(test (eval-string "#u8(1 2 . 3)") 'error)
+
+(test #u8(255) (byte-vector 255))
+(test (object->string #u8()) "#u8()")
+(test (object->string #u8(255)) "#u8(255)")
+(test (object->string #u8(255 255)) "#u8(255 255)")
+(test (object->string #u8(128)) "#u8(128)")
+(test (object->string #u8(128 128)) "#u8(128 128)")
+
+(test (length #u8(0)) 1)
+(test (length #u8(0 0)) 2)
+(test (length #u8()) 0)
+(test (length (byte-vector)) 0)
+(test (byte-vector? #u8()) #t)
+(test (equal? (let ((bv #u8(1 0 3))) (set! (bv 2) 64) bv) #u8(1 0 64)) #t)
+(test (let ((bv #u8(1 0 3))) (map values bv)) '(1 0 3))
+(test (let ((bv #u8(1 0 3)) (lst ())) (for-each (lambda (x) (set! lst (cons x lst))) bv) lst) '(3 0 1))
+(test (let ((bv #u8(1 2 3))) (bv 1)) 2)
+(test (let ((bv #u8(1 2 3))) (reverse bv)) #u8(3 2 1))
+(test (let ((bv #u8(1 2 3))) (object->string (reverse bv))) "#u8(3 2 1)")
+(test (let ((bv #u8(1 2 3))) (copy bv)) #u8(1 2 3))
+(test (#u8(1 2 3) 2) 3)
+(test (let ((v #u8(0 1 2))) (let ((v1 (reverse! v))) (eq? v v1))) #t)
+(test (let ((v #u8(0 1 2))) (reverse! v)) #u8(2 1 0))
+;; should (vector? #u8(1 2)) be #t?
+(test (format #f "~{~A ~}" (byte-vector 255 0)) "255 0 ")
+
+;;; ->byte-vector
+(test (byte-vector? (->byte-vector (string #\0))) #t)
+(test (byte-vector? (->byte-vector "")) #t)
+(test (byte-vector? (->byte-vector "1230")) #t)
+(test (byte-vector? (->byte-vector (->byte-vector (string #\0)))) #t)
+(test (byte-vector? (->byte-vector (string))) #t)
+(test (byte-vector? (->byte-vector #u8(1 2))) #t)
+(test (byte-vector? (->byte-vector #u8())) #t)
+(test (byte-vector? (->byte-vector #(1 2))) 'error)
+(test (byte-vector? (string-append #u8(1 2) #u8(3 4))) #t)
+(for-each
+ (lambda (arg)
+ (test (->byte-vector arg) 'error)
+ (test (byte-vector? arg) #f))
+ (list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+;;; an experiment:
+(test (->byte-vector #x010203) #u8(3 2 1 0 0 0 0 0))
+
+;;; make-byte-vector
+(test (equal? (make-byte-vector 0) #u8()) #t)
+(test (equal? (make-byte-vector 0 32) #u8()) #t)
+(test (equal? (make-byte-vector 1 32) #u8(32)) #t)
+(test (make-byte-vector 0 -32) 'error)
+(test (make-byte-vector 1 -32) 'error)
+(test (make-byte-vector 1 256) 'error)
+(for-each
+ (lambda (arg)
+ (test (make-byte-vector arg) 'error)
+ (test (make-byte-vector 1 arg) 'error))
+ (list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+
+;;; byte-vector
+(test (byte-vector) #u8())
+(test (byte-vector 32) (make-byte-vector 1 32))
+(test (byte-vector 0 256) 'error)
+(test (byte-vector -1) 'error)
+(for-each
+ (lambda (arg)
+ (test (byte-vector arg) 'error))
+ (list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t (if #f #f) #<eof> (lambda (a) (+ a 1))))
+
+(test (map append #u8(0 1 2)) '(0 1 2))
+(test (format #f "~{#x~X~| ~}" #u8(49 50 51)) "#x31 #x32 #x33")
+(test (format #f "~{~D~| ~}" (->byte-vector "abcd")) "97 98 99 100")
+(test (let ((lst ())) (for-each (lambda (c) (set! lst (cons c lst))) #u8(90 91 92)) (reverse lst)) '(90 91 92))
+(test (integer? (#u8(1 2 3) 0)) #t)
+(test (integer? ((->byte-vector "abc") 1)) #t)
+
+(test ((vector (byte-vector 1)) 0 0) 1) ; i.e. not a character
+
+(let ((bv (byte-vector 0 1 2 3)))
+ (fill! bv 4)
+ (test bv #u8(4 4 4 4))
+ (fill! bv 1 1 3)
+ (test bv #u8(4 1 1 4))
+ (let ((bv1 (copy bv)))
+ (test bv1 #u8(4 1 1 4))
+ (fill! bv 1)
+ (copy bv bv1)
+ (test bv1 #u8(1 1 1 1))
+ (fill! bv 255)
+ (copy bv bv1 1 3)
+ (test bv1 #u8(255 255 1 1)))) ; copy and fill do not interpret their indices in the same way (one is source, the other destination)
+
+
+
+
;;; --------------------------------------------------------------------------------
;;; LISTS
;;; --------------------------------------------------------------------------------
+
+;;; --------------------------------------------------------------------------------
;;; cons
-(test (cons 'a '()) '(a))
+
+(test (cons 'a ()) '(a))
(test (cons '(a) '(b c d)) '((a) b c d))
(test (cons "a" '(b c)) '("a" b c))
(test (cons 'a 3) '(a . 3))
(test (cons '(a b) 'c) '((a b) . c))
-(test (cons '() '()) '(()))
-(test (cons '() 1) '(() . 1))
+(test (cons () ()) '(()))
+(test (cons () 1) '(() . 1))
(test (cons 1 2) '(1 . 2))
-(test (cons 1 '()) '(1))
-(test (cons '() 2) '(() . 2))
-(test (cons 1 (cons 2 (cons 3 (cons 4 '())))) '(1 2 3 4))
+(test (cons 1 ()) '(1))
+(test (cons () 2) '(() . 2))
+(test (cons 1 (cons 2 (cons 3 (cons 4 ())))) '(1 2 3 4))
(test (cons 'a 'b) '(a . b))
-(test (cons 'a (cons 'b (cons 'c '()))) '(a b c))
+(test (cons 'a (cons 'b (cons 'c ()))) '(a b c))
(test (cons 'a (list 'b 'c 'd)) '(a b c d))
(test (cons 'a (cons 'b (cons 'c 'd))) '(a b c . d))
(test '(a b c d e) '(a . (b . (c . (d . (e . ()))))))
(test (cons (cons 1 2) (cons 3 4)) '((1 . 2) 3 . 4))
(test (list (cons 1 2) (cons 3 4)) '((1 . 2) (3 . 4)))
(test (cons (cons 1 (cons 2 3)) 4) '((1 . (2 . 3)) . 4))
-(test (cons (cons 1 (cons 2 '())) (cons 1 2)) '((1 2) . (1 . 2)))
+(test (cons (cons 1 (cons 2 ())) (cons 1 2)) '((1 2) . (1 . 2)))
(test (let ((lst (list 1 2))) (list (apply cons lst) lst)) '((1 . 2) (1 2)))
(test (let ((lst (list 1 2))) (list lst (apply cons lst))) '((1 2) (1 . 2)))
(test (cdadr (let ((lst (list 1 2))) (list (apply cons lst) lst))) '(2))
(test (cons '+ '=) '(+ . =))
(test (cons .(cadddr 10)) (cons cadddr 10))
-(test (cons 1 '()) '(
+(test (cons 1 ()) '(
1
))
+;;; --------------------------------------------------------------------------------
;;; car
+
(test (car (list 1 2 3)) 1)
(test (car (cons 1 2)) 1)
(test (car (list 1)) 1)
@@ -3107,7 +5925,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (car '(1 . 2)) 1)
(test (car '((1 2) 3)) '(1 2))
(test (car '(((1 . 2) . 3) 4)) '((1 . 2) . 3))
-(test (car (list (list) (list 1 2))) '())
+(test (car (list (list) (list 1 2))) ())
(test (car '(a b c)) 'a)
(test (car '((a) b c d)) '(a))
(test (car (reverse (list 1 2 3 4))) 4)
@@ -3119,30 +5937,32 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (car '(1 .. 2)) 1)
(test (car ''foo) 'quote)
(test (car '(1 2 . 3)) 1)
-(test (car (cons 1 '())) 1)
+(test (car (cons 1 ())) 1)
(test (car (if #f #f)) 'error)
-(test (car '()) 'error)
+(test (car ()) 'error)
+(test (car #(1 2)) 'error)
(test (car #(1 2)) 'error)
-(test (car '#(1 2)) 'error)
(for-each
(lambda (arg)
- (if (not (equal? (car (cons arg '())) arg))
- (format #t ";(car '(~A)) returned ~A?~%" arg (car (cons arg '()))))
+ (if (not (equal? (car (cons arg ())) arg))
+ (format-logged #t ";(car '(~A)) returned ~A?~%" arg (car (cons arg ()))))
(test (car arg) 'error))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
-(test (reinvert 12 car (lambda (a) (cons a '())) '(1)) '(1))
+(test (reinvert 12 car (lambda (a) (cons a ())) '(1)) '(1))
+;;; --------------------------------------------------------------------------------
;;; cdr
+
(test (cdr (list 1 2 3)) '(2 3))
(test (cdr (cons 1 2)) 2)
-(test (cdr (list 1)) '())
+(test (cdr (list 1)) ())
(test (cdr '(1 2 3)) '(2 3))
-(test (cdr '(1)) '())
+(test (cdr '(1)) ())
(test (cdr '(1 . 2)) 2)
(test (cdr '((1 2) 3)) '(3))
(test (cdr '(((1 . 2) . 3) 4)) '(4))
@@ -3152,22 +5972,22 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (equal? (cdr (reverse (list 1 2 3 4))) 4) #f)
(test (equal? (cdr (list 'a 'b 'c 'd 'e 'f 'g)) 'a) #f)
(test (cdr '((((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f) g)) '(g))
-(test (cdr '(a)) '())
+(test (cdr '(a)) ())
(test (cdr '(a b c d e f g)) '(b c d e f g))
(test (cdr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((((u v w) x) y) ((q w e) r) (a b c) e f g))
(test (cdr ''foo) '(foo))
(test (cdr (cons (cons 1 2) (cons 3 4))) '(3 . 4))
(test (cdr '(1 2 . 3)) '(2 . 3))
(test (cdr (if #f #f)) 'error)
-(test (cdr '()) 'error)
+(test (cdr ()) 'error)
(for-each
(lambda (arg)
- (if (not (equal? (cdr (cons '() arg)) arg))
- (format #t ";(cdr '(() ~A) -> ~A?~%" arg (cdr (cons '() arg))))
+ (if (not (equal? (cdr (cons () arg)) arg))
+ (format-logged #t ";(cdr '(() ~A) -> ~A?~%" arg (cdr (cons () arg))))
(test (cdr arg) 'error))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(let* ((a (list 1 2 3))
(b a))
@@ -3198,9 +6018,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
321)
(cons 1 (cons 2 (cons 3 4)))
(cons (cons 2 (cons 3 4)) 5)
- (cons '() 1)
- (cons 1 '())
- (cons '() '())
+ (cons () 1)
+ (cons 1 ())
+ (cons () ())
(list 1 2 (cons 3 4) 5 (list (list 6) 7))
(cons-r 0 0 4)
(cons-r 0 0 5)
@@ -3212,7 +6032,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
))
+;;; --------------------------------------------------------------------------------
;;; cxr
+
(define (caar-1 x) (car (car x)))
(define (cadr-1 x) (car (cdr x)))
(define (cdar-1 x) (cdr (car x)))
@@ -3249,7 +6071,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
(val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
(if (not (equal? val1 val2))
- (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
+ (format-logged #t ";(~A ~S) -> ~S, (~A-1): ~S?~%" name lst val1 name val2))))
lists))
(list 'caar 'cadr 'cdar 'cddr 'caaar 'caadr 'cadar 'cdaar 'caddr 'cdddr 'cdadr 'cddar
'caaaar 'caaadr 'caadar 'cadaar 'caaddr 'cadddr 'cadadr 'caddar 'cdaaar
@@ -3275,7 +6097,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (equal? (cadar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(6 7)) #t)
(test (equal? (cdaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(5)) #t)
(test (equal? (cdadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(y)) #t)
-(test (equal? (cddar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '()) #t)
+(test (equal? (cddar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) ()) #t)
(test (equal? (caaaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(1 2 3)) #t)
(test (equal? (caadar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 6) #t)
(test (equal? (caaddr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(q w e)) #t)
@@ -3360,7 +6182,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (caddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((q w e) r))
(test (cdaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(5))
(test (cdadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(y))
-(test (cddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '())
+(test (cddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ())
(test (cdddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((a b c) e f g))
(test (caaaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(1 2 3))
(test (caaadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(u v w))
@@ -3373,8 +6195,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (cdaadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(x))
(test (cdadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(7))
(test (cdaddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(r))
-(test (cddaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '())
-(test (cddadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '())
+(test (cddaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ())
+(test (cddadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ())
(test (cddddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(e f g))
(test (cadr '(a b c d e f g)) 'b)
@@ -3444,15 +6266,47 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (cdddar '((a aa aaa . aaaa) b c)) 'aaaa)
(test (cddddr '(a b c d . e)) 'e)
+(let ((lst '((((A . B) C . D) (E . F) G . H) ((I . J) K . L) (M . N) O . P))) ; from comp.lang.lisp I think
+ (test (car lst) '(((A . B) C . D) (E . F) G . H))
+ (test (cdr lst) '(((I . J) K . L) (M . N) O . P))
+ (test (caar lst) '((A . B) C . D))
+ (test (cadr lst) '((I . J) K . L))
+ (test (cdar lst) '((E . F) G . H))
+ (test (cddr lst) '((M . N) O . P))
+ (test (caaar lst) '(A . B))
+ (test (caadr lst) '(I . J))
+ (test (cadar lst) '(E . F))
+ (test (caddr lst) '(M . N))
+ (test (cdaar lst) '(C . D))
+ (test (cdadr lst) '(K . L))
+ (test (cddar lst) '(G . H))
+ (test (cdddr lst) '(O . P))
+ (test (caaaar lst) 'A)
+ (test (caaadr lst) 'I)
+ (test (caadar lst) 'E)
+ (test (caaddr lst) 'M)
+ (test (cadaar lst) 'C)
+ (test (cadadr lst) 'K)
+ (test (caddar lst) 'G)
+ (test (cadddr lst) 'O)
+ (test (cdaaar lst) 'B)
+ (test (cdaadr lst) 'J)
+ (test (cdadar lst) 'F)
+ (test (cdaddr lst) 'N)
+ (test (cddaar lst) 'D)
+ (test (cddadr lst) 'L)
+ (test (cdddar lst) 'H)
+ (test (cddddr lst) 'P))
+
(test (recompose 10 cdr '(1 2 3 4 5 6 7 8 9 10 11 12)) '(11 12))
(test (recompose 10 car '(((((((((((1 2 3)))))))))))) '(1 2 3))
(test (cons 1 . 2) 'error)
(test (eval-string "(1 . 2 . 3)") 'error)
(test (car (list)) 'error)
-(test (car '()) 'error)
+(test (car ()) 'error)
(test (cdr (list)) 'error)
-(test (cdr '()) 'error)
+(test (cdr ()) 'error)
(test (caddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error)
(test (cdddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error)
(test (caar '(a b c d e f g)) 'error)
@@ -3574,29 +6428,60 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (cddddr '(a c . b)) 'error)
(test (cddddr '(a c e . b)) 'error)
+(test (caar '((1))) 1)
+(test (cadr '(1 2)) 2)
+(test (cdar '((1 . 2))) 2)
+(test (cddr '(1 2 . 3)) 3)
+(test (caaar '(((1)))) 1)
+(test (caadr '(1 (2))) 2)
+(test (cadar '((1 2))) 2)
+(test (cdaar '(((1 . 2)))) 2)
+(test (caddr '(1 2 3)) 3)
+(test (cdddr '(1 2 3 . 4)) 4)
+(test (cdadr '(1 (2 . 3))) 3)
+(test (cddar '((1 2 . 3))) 3)
+(test (caaaar '((((1))))) 1)
+(test (caaadr '(1 ((2)))) 2)
+(test (caadar '((1 (2)))) 2)
+(test (cadaar '(((1 2)))) 2)
+(test (caaddr '(1 2 (3))) 3)
+(test (cadddr '(1 2 3 4)) 4)
+(test (cadadr '(1 (2 3))) 3)
+(test (caddar '((1 2 3))) 3)
+(test (cdaaar '((((1 . 2))))) 2)
+(test (cdaadr '(1 ((2 . 3)))) 3)
+(test (cdadar '((1 (2 . 3)))) 3)
+(test (cddaar '(((1 2 . 3)))) 3)
+(test (cdaddr '(1 2 (3 . 4))) 4)
+(test (cddddr '(1 2 3 4 . 5)) 5)
+(test (cddadr '(1 (2 3 . 4))) 4)
+(test (cdddar '((1 2 3 . 4))) 4)
+
+;;; --------------------------------------------------------------------------------
;;; length
+
(test (length (list 'a 'b 'c 'd 'e 'f)) 6)
(test (length (list 'a 'b 'c 'd)) 4)
(test (length (list 'a (list 'b 'c) 'd)) 3)
-(test (length '()) 0)
+(test (length ()) 0)
(test (length '(this-that)) 1)
(test (length '(this - that)) 3)
(test (length '(a b)) 2)
(test (length '(a b c)) 3)
(test (length '(a (b) (c d e))) 3)
(test (length (list 1 (cons 1 2))) 2)
-(test (length (list 1 (cons 1 '()))) 2)
+(test (length (list 1 (cons 1 ()))) 2)
(for-each
(lambda (arg)
- (test (length arg) 'error))
- (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (test (length arg) #f))
+ (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
-(test (length 'x) 'error)
+(test (length 'x) #f)
(test (length (cons 1 2)) -1)
(let ((x (list 1 2)))
(set-cdr! x x)
@@ -3604,14 +6489,21 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (length '(1 2 . 3)) -2)
(test (length) 'error)
(test (length '(1 2 3) #(1 2 3)) 'error)
+(test (integer? (length (funclet cons))) #t)
+(test (length '((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 1)
+(test (length (make-vector 3 0 #t)) 3)
+
+
+;;; --------------------------------------------------------------------------------
;;; reverse
+
(test (reverse '(a b c d)) '(d c b a))
(test (reverse '(a b c)) '(c b a))
(test (reverse '(a (b c) d (e (f)))) '((e (f)) d (b c) a))
-(test (reverse '()) '())
+(test (reverse ()) ())
(test (reverse (list 1 2 3)) '(3 2 1))
(test (reverse (list 1)) '(1))
(test (reverse (list)) (list))
@@ -3644,18 +6536,25 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (reverse '(1 2 3)) '(3 2 1))
(test (reverse '(1 2 3 4)) '(4 3 2 1))
+(when with-block
+ (test (block? (reverse _c_obj_)) #t)
+ (let ((b (block 1 2 3 4)))
+ (let ((b1 (reverse b)))
+ (test b1 (block 4 3 2 1))
+ (test b (block 1 2 3 4)))))
+
(for-each
(lambda (lst)
- (if (list? lst)
+ (if (proper-list? lst)
(if (not (equal? lst (reverse (reverse lst))))
- (format #t ";(reverse (reverse ~A)) -> ~A?~%" (reverse (reverse lst))))))
+ (format-logged #t ";(reverse (reverse ~A)) -> ~A?~%" lst (reverse (reverse lst))))))
lists)
(for-each
(lambda (lst)
- (if (list? lst)
+ (if (proper-list? lst)
(if (not (equal? lst (reverse (reverse (reverse (reverse lst))))))
- (format #t ";(reverse...(4x) ~A) -> ~A?~%" lst (reverse (reverse (reverse (reverse lst))))))))
+ (format-logged #t ";(reverse...(4x) ~A) -> ~A?~%" lst (reverse (reverse (reverse (reverse lst))))))))
lists)
(test (let ((x (list 1 2 3))) (list (recompose 32 reverse x) x)) '((1 2 3) (1 2 3)))
@@ -3666,16 +6565,58 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (reverse '(1 2 . 3)) '(3 2 1))
(test (reverse) 'error)
(test (reverse '(1 2 3) '(3 2 1)) 'error)
+(test (reverse (make-shared-vector (make-int-vector '(2 3) 0) '(6))) (make-vector 6 0 #t))
+(test (reverse (make-vector 6 0.0 #t)) (make-float-vector 6 0.0))
(for-each
(lambda (arg)
(test (reverse arg) 'error))
- (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (reverse "hi") "ih")
+(test (reverse "") "")
+(test (reverse "123") "321")
+(test (reverse "1234") "4321")
+(test (reverse "12") "21")
+(test (reverse "a\x00b") "b\x00a")
+(test (reverse #()) #())
+(test (reverse #(1)) #(1))
+(test (reverse #(1 2)) #(2 1))
+(test (reverse #(1 2 3)) #(3 2 1))
+(test (reverse #(1 2 3 4)) #(4 3 2 1))
+(test (reverse #2D((1 2) (3 4))) #2D((4 3) (2 1)))
+(test (reverse (string #\a #\null #\b)) "b\x00a")
+(test (reverse abs) 'error)
+(test (vector->list (reverse (let ((v (make-int-vector 3))) (set! (v 1) 1) (set! (v 2) 2) v))) '(2 1 0))
+(test (reverse (int-vector)) #())
+(test (reverse (int-vector 1)) (int-vector 1))
+(test (reverse (int-vector 1 2)) (int-vector 2 1))
+(test (reverse (int-vector 1 2 3)) (int-vector 3 2 1))
+(test (reverse (int-vector 1 2 3 4)) (int-vector 4 3 2 1))
+(test (reverse (float-vector)) #())
+(test (reverse (float-vector 1)) (float-vector 1))
+(test (reverse (float-vector 1 2)) (float-vector 2 1))
+(test (reverse (float-vector 1 2 3)) (float-vector 3 2 1))
+(test (reverse (float-vector 1 2 3 4)) (float-vector 4 3 2 1))
+(test (let ((v #(1 2 3))) (reverse v) v) #(1 2 3))
+(test (reverse #u8(1 2 3)) #u8(3 2 1))
+(test (reverse #u8(1 2)) #u8(2 1))
+(test (reverse #u8(1 2 3 4)) #u8(4 3 2 1))
+
+(when with-block
+ (let ((b (block 1.0 2.0 3.0)))
+ (set! (b 1) 32.0)
+ (test (b 1) 32.0)
+ (let ((b1 (reverse b)))
+ (test b1 (block 3.0 32.0 1.0)))))
+
+;;; --------------------------------------------------------------------------------
;;; reverse!
+
(test (reverse! '(1 . 2)) 'error)
(test (reverse! (cons 1 2)) 'error)
(test (reverse! (cons 1 (cons 2 3))) 'error)
@@ -3685,7 +6626,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (reverse! '(a b c d)) '(d c b a))
(test (reverse! '(a b c)) '(c b a))
(test (reverse! '(a (b c) d (e (f)))) '((e (f)) d (b c) a))
-(test (reverse! '()) '())
+(test (reverse! ()) ())
(test (reverse! (list 1 2 3)) '(3 2 1))
(test (reverse! (list 1)) '(1))
(test (reverse! (list)) (list))
@@ -3696,6 +6637,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (reverse! (list (list) (list 1 2))) '((1 2) ()))
(test (reverse! '((a) b c d)) '(d c b (a)))
(test (reverse! (reverse! (list 1 2 3 4))) (list 1 2 3 4))
+(test (reverse! (reverse! (sort! (list 1 2 3 4) >))) (sort! (list 1 2 3 4) >))
(test (reverse! ''foo) '(foo quote))
(test (reverse (reverse! (list 1 2 3))) (list 1 2 3))
(test (reverse (reverse! (reverse! (reverse (list 1 2 3))))) (list 1 2 3))
@@ -3703,17 +6645,310 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((x (list 1 2 3))) (recompose 31 reverse! x)) '(3 2 1))
(test (reverse! '(1 2 . 3)) 'error)
+(let* ((lst1 (list 1 2 3))
+ (lst2 (apply list '(4 5 6)))
+ (lst3 (sort! (reverse! (append lst1 lst2)) <)))
+ (test lst3 '(1 2 3 4 5 6))
+ (define (lt . args)
+ args)
+ (set! lst3 (sort! (apply reverse! (lt lst3)) >))
+ (test lst3 '(6 5 4 3 2 1)))
+
(for-each
(lambda (arg)
(test (reverse! arg) 'error))
- (list (integer->char 65) #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) #(1 2 3) "hiho" (lambda (a) (+ a 1))))
+ (list (integer->char 65) #f 'a-symbol abs _ht_ _null_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+(test (let ((str "1234")) (reverse! str) str) "4321")
+(test (let ((str "123")) (reverse! str) str) "321")
+(test (let ((str "")) (reverse! str) str) "")
+(test (let ((v #(1 2 3))) (reverse! v) v) #(3 2 1))
+(test (let ((v #(1 2 3 4))) (reverse! v) v) #(4 3 2 1))
+(test (let ((v #())) (reverse! v) v) #())
+(test (let ((v (float-vector 1.0 2.0 3.0))) (reverse! v) v) (float-vector 3.0 2.0 1.0))
+(test (let ((v (float-vector 1.0 2.0 3.0 4.0))) (reverse! v) v) (float-vector 4.0 3.0 2.0 1.0))
+(test (let ((v (float-vector))) (reverse! v) v) #())
+(test (let ((v (int-vector 1 2 3))) (reverse! v) v) (int-vector 3 2 1))
+(test (let ((v (int-vector 1 2 3 4))) (reverse! v) v) (int-vector 4 3 2 1))
+(test (let ((v (int-vector))) (reverse! v) v) #())
+(when with-block
+ (test (block? (reverse! _c_obj_)) #t)
+ (let ((b (block 1 2 3 4)))
+ (reverse! b)
+ (test b (block 4 3 2 1))))
+(test (let ((v (make-vector 3 1 #t))) (set! (v 1) 2) (set! (v 2) 3) (reverse! v) v) (let ((v (make-vector 3 3 #t))) (set! (v 1) 2) (set! (v 2) 1) v))
+
+(when full-test
+ (let ()
+ ;; some sequence tests
+
+ (define (fv-tst len)
+ (let ((fv (make-float-vector len)))
+ (if (not (= (length fv) len))
+ (format *stderr* "float-vector length ~A: ~A~%" fv (length fv)))
+ (fill! fv 0.0)
+ (let ((fv-orig (copy fv)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (- (random 1000.0) 500.0)))
+ (let ((fv-ran (copy fv))
+ (fv-ran1 (copy fv)))
+ (sort! fv <)
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (when (> (fv (- i 1)) (fv i))
+ (format *stderr* "float-vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i)
+ (quit)))))
+ (sort! fv-ran (lambda (a b) (< a b)))
+ (if (not (morally-equal? fv fv-ran))
+ (format *stderr* "float-vector closure not equal~%"))
+ (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f))))
+ (if (not (morally-equal? fv fv-ran1))
+ (format *stderr* "float-vector cond closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (reverse! fv)
+ (if (and (not (morally-equal? fv-copy fv))
+ (morally-equal? fv fv-orig))
+ (format *stderr* "float-vector reverse!: ~A ~A~%" fv fv-orig))
+ (reverse! fv)
+ (if (not (morally-equal? fv-copy fv))
+ (format *stderr* "float-vector reverse! twice: ~A ~A~%" fv fv-copy))
+ (let ((fv1 (apply float-vector (make-list len 1.0))))
+ (if (or (not (= (length fv1) len))
+ (not (= (fv1 (- len 1)) 1.0)))
+ (format *stderr* "float-vector apply: ~A ~A~%" len (fv (- len 1)))))
+ ))))
+
+ (define (iv-tst len)
+ (let ((fv (make-int-vector len 0)))
+ (if (not (= (length fv) len))
+ (format *stderr* "int-vector length ~A: ~A~%" fv (length fv)))
+ (fill! fv 0)
+ (let ((fv-orig (copy fv)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (- (random 1000000) 500000)))
+ (let ((fv-ran (copy fv))
+ (fv-ran1 (copy fv)))
+ (sort! fv <)
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (when (> (fv (- i 1)) (fv i))
+ (format *stderr* "int-vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i)
+ (quit)))))
+ (sort! fv-ran (lambda (a b) (< a b)))
+ (if (not (morally-equal? fv fv-ran))
+ (format *stderr* "int-vector closure not equal~%"))
+ (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f))))
+ (if (not (morally-equal? fv fv-ran1))
+ (format *stderr* "int-vector cond closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (reverse! fv)
+ (if (and (not (morally-equal? fv-copy fv))
+ (morally-equal? fv fv-orig))
+ (format *stderr* "int-vector reverse!: ~A ~A~%" fv fv-orig))
+ (reverse! fv)
+ (if (not (morally-equal? fv-copy fv))
+ (format *stderr* "int-vector reverse! twice: ~A ~A~%" fv fv-copy))
+ ))))
+
+ (define (v-tst len)
+ (let ((fv (make-vector len)))
+ (if (not (= (length fv) len))
+ (format *stderr* "vector length ~A: ~A~%" fv (length fv)))
+ (fill! fv 0)
+ (let ((fv-orig (copy fv)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (- (random 1000000) 500000)))
+ (let ((fv-ran (copy fv))
+ (fv-ran1 (copy fv)))
+ (sort! fv <)
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (when (> (fv (- i 1)) (fv i))
+ (format *stderr* "vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i)
+ (quit)))))
+ (sort! fv-ran (lambda (a b) (< a b)))
+ (if (not (morally-equal? fv fv-ran))
+ (format *stderr* "vector closure not equal~%"))
+ (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f))))
+ (if (not (morally-equal? fv fv-ran1))
+ (format *stderr* "vector cond closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (reverse! fv)
+ (if (and (not (morally-equal? fv-copy fv))
+ (morally-equal? fv fv-orig))
+ (format *stderr* "vector reverse!: ~A ~A~%" fv fv-orig))
+ (reverse! fv)
+ (if (not (morally-equal? fv-copy fv))
+ (format *stderr* "vector reverse! twice: ~A ~A~%" fv fv-copy))
+ (let ((fv1 (apply vector (make-list len 1))))
+ (if (or (not (= (length fv1) len))
+ (not (= (fv1 (- len 1)) 1)))
+ (format *stderr* "vector apply: ~A ~A~%" len (fv (- len 1)))))
+ ))))
+
+ (define (s-tst len)
+ (let ((fv (make-string len)))
+ (if (not (= (length fv) len))
+ (format *stderr* "string length ~A: ~A~%" fv (length fv)))
+ (fill! fv #\a)
+ (let ((fv-orig (copy fv)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (integer->char (+ 20 (random 100)))))
+ (let ((fv-ran (copy fv))
+ (fv-ran1 (copy fv)))
+ (sort! fv char<?)
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (when (char>? (fv (- i 1)) (fv i))
+ (format *stderr* "string: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i)
+ (quit)))))
+ (sort! fv-ran (lambda (a b) (char<? a b)))
+ (if (not (morally-equal? fv fv-ran))
+ (format *stderr* "string closure not equal~%"))
+ (sort! fv-ran1 (lambda (a b) (cond ((char<? a b) #t) (#t #f))))
+ (if (not (morally-equal? fv fv-ran))
+ (format *stderr* "string cond closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (reverse! fv)
+ (if (and (not (morally-equal? fv-copy fv))
+ (morally-equal? fv fv-orig))
+ (format *stderr* "string reverse!: ~A ~A~%" fv fv-orig))
+ (reverse! fv)
+ (if (not (morally-equal? fv-copy fv))
+ (format *stderr* "string reverse! twice: ~A ~A~%" fv fv-copy))
+ (let ((fv1 (apply string (make-list len #\a))))
+ (if (or (not (= (length fv1) len))
+ (not (char=? (fv1 (- len 1)) #\a)))
+ (format *stderr* "string apply: ~A ~A~%" len (fv (- len 1)))))
+ ))))
+
+ (define (p-tst len)
+ (let ((fv (make-list len)))
+ (if (not (= (length fv) len))
+ (format *stderr* "list length ~A: ~A~%" fv (length fv)))
+ (fill! fv 0)
+ (let ((fv-orig (copy fv)))
+ (do ((p fv (cdr p)))
+ ((null? p))
+ (set-car! p (- (random 100000) 50000)))
+ (let ((fv-ran (copy fv)))
+ (sort! fv <)
+ (call-with-exit
+ (lambda (quit)
+ (do ((p0 fv (cdr p0))
+ (p1 (cdr fv) (cdr p1))
+ (i 1 (+ i 1)))
+ ((null? p1))
+ (when (> (car p0) (car p1))
+ (format *stderr* "list: ~A > ~A at ~D~%" (car p0) (car p1) i)
+ (quit)))))
+ (sort! fv-ran (lambda (a b) (< a b)))
+ (if (not (morally-equal? fv fv-ran))
+ (format *stderr* "pair closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (set! fv (reverse! fv))
+ (if (and (not (morally-equal? fv-copy fv))
+ (morally-equal? fv fv-orig))
+ (format *stderr* "list reverse!: ~A ~A~%" fv fv-orig))
+ (set! fv (reverse! fv))
+ (if (not (morally-equal? fv-copy fv))
+ (format *stderr* "list reverse! twice: ~A ~A~%" fv fv-copy))
+ ))))
+
+ (for-each
+ (lambda (b p)
+ (do ((k 0 (+ k 1)))
+ ((= k 1000))
+ (fv-tst b)
+ (iv-tst b)
+ (v-tst b)
+ (s-tst b)
+ (p-tst b))
+ (do ((i 0 (+ i 1)))
+ ((= i p))
+ (format *stderr* "~D fv " (expt b i))
+ (fv-tst (expt b i))
+ (format *stderr* "iv ")
+ (iv-tst (expt b i))
+ (format *stderr* "v ")
+ (v-tst (expt b i))
+ (format *stderr* "s ")
+ (s-tst (expt b i))
+ (format *stderr* "p ")
+ (p-tst (expt b i))
+ (newline *stderr*)
+ ))
+ (list 2 3 4 7 10)
+ (list 12 4 3 6 6))
+ ))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3))) (reverse! sv) v)) #(3 2 1 4))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3 1))) (reverse! sv) v)) #(1 4 3 2))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3 1))) (fill! sv 5) v)) #(1 5 5 5))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3 1))) (reverse sv) v)) #(1 2 3 4))
+(test (let ((v (vector 1 2 3 4))) (let ((sv (make-shared-vector v 3 1))) (sort! sv >) v)) #(1 4 3 2))
+(test (let ((v (make-int-vector '(3 3) 1))) (let ((sv (v 1))) (fill! sv 2) v)) (make-shared-vector (int-vector 1 1 1 2 2 2 1 1 1) '(3 3)))
+(test (let ((v (make-int-vector '(3 3) 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! (v i j) (+ j (* i 3)))))
+ (let ((sv (v 1)))
+ (fill! sv 2)
+ v))
+ (make-shared-vector (int-vector 0 1 2 2 2 2 6 7 8) '(3 3)))
+
+(test (let ((v (make-int-vector '(3 3) 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! (v i j) (+ j (* i 3)))))
+ (let ((sv (v 1)))
+ (sort! sv >)
+ v))
+ (make-shared-vector (int-vector 0 1 2 5 4 3 6 7 8) '(3 3)))
+
+(test (let ((v (make-int-vector '(3 3) 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! (v i j) (+ j (* i 3)))))
+ (let ((sv (v 1)))
+ (reverse! sv)
+ v))
+ (make-shared-vector (int-vector 0 1 2 5 4 3 6 7 8) '(3 3)))
+
+
+
+
+;;; --------------------------------------------------------------------------------
;;; pair?
+
(test (pair? 'a) #f)
(test (pair? '()) #f)
+(test (pair? ()) #f)
(test (pair? '(a b c)) #t)
(test (pair? (cons 1 2)) #t)
(test (pair? ''()) #t)
@@ -3721,7 +6956,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (pair? (make-vector 6)) #f)
(test (pair? #t) #f)
(test (pair? '(a . b)) #t)
-(test (pair? '#(a b)) #f)
+(test (pair? #(a b)) #f)
(test (pair? (list 1 2)) #t)
(test (pair? (list)) #f)
(test (pair? ''foo) #t)
@@ -3732,10 +6967,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set-cdr! x x)
(test (pair? x) #t))
(test (pair? (list 1 (cons 1 2))) #t)
-(test (pair? (list 1 (cons 1 '()))) #t)
-(test (pair? (cons 1 '())) #t)
-(test (pair? (cons '() '())) #t)
-(test (pair? (cons '() 1)) #t)
+(test (pair? (list 1 (cons 1 ()))) #t)
+(test (pair? (cons 1 ())) #t)
+(test (pair? (cons () ())) #t)
+(test (pair? (cons () 1)) #t)
(test (pair? (list (list))) #t)
(test (pair? '(())) #t)
(test (pair? (cons 1 (cons 2 3))) #t)
@@ -3749,23 +6984,38 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (pair? arg)
- (format #t ";(pair? ~A) -> #t?~%" arg)))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (format-logged #t ";(pair? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+;;; pair-line-number
+(test (pair-line-number) 'error)
+(test (pair-line-number () ()) 'error)
+(for-each
+ (lambda (arg)
+ (test (pair-line-number arg) 'error))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------------------------------------------------------------------------------
;;; list?
+
(test (list? 'a) #f)
-(test (list? '()) #t)
+(test (list? ()) #t)
(test (list? '(a b c)) #t)
-(test (list? (cons 1 2)) #f)
+(test (list? (cons 1 2)) #t)
(test (list? ''()) #t)
(test (list? #f) #f)
(test (list? (make-vector 6)) #f)
(test (list? #t) #f)
-(test (list? '(a . b)) #f)
-(test (list? '#(a b)) #f)
+(test (list? '(a . b)) #t)
+(test (list? #(a b)) #f)
(test (list? (list 1 2)) #t)
(test (list? (list)) #t)
(test (list? ''foo) #t)
@@ -3775,32 +7025,78 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (list? '(this - that)) #t)
(let ((x (list 1 2)))
(set-cdr! x x)
- (test (list? x) #f))
+ (test (proper-list? x) #f)
+ (test (list? x) #t))
(test (list? (list 1 (cons 1 2))) #t)
-(test (list? (list 1 (cons 1 '()))) #t)
-(test (list? (cons 1 '())) #t)
-(test (list? (cons '() '())) #t)
-(test (list? (cons '() 1)) #f)
+(test (list? (list 1 (cons 1 ()))) #t)
+(test (list? (cons 1 ())) #t)
+(test (list? (cons () ())) #t)
+(test (list? (cons () 1)) #t)
(test (list? (list (list))) #t)
(test (list? '(())) #t)
-(test (list? '(1 2 . 3)) #f)
-(test (list? (cons 1 (cons 2 3))) #f)
+(test (list? '(1 2 . 3)) #t)
+(test (list? (cons 1 (cons 2 3))) #t)
(test (list? '(1 . ())) #t)
-(test (list? '(1 2) '()) 'error)
+(test (list? '(1 2) ()) 'error)
(test (list?) 'error)
(for-each
(lambda (arg)
(if (list? arg)
- (format #t ";(list? ~A) -> #t?~%" arg)))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
-
+ (format-logged #t ";(list? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+
+;;; proper-list?
+
+(test (proper-list? 'a) #f)
+(test (proper-list? ()) #t)
+(test (proper-list? '(a b c)) #t)
+(test (proper-list? (cons 1 2)) #f)
+(test (proper-list? ''()) #t)
+(test (proper-list? #f) #f)
+(test (proper-list? (make-vector 6)) #f)
+(test (proper-list? #t) #f)
+(test (proper-list? '(a . b)) #f)
+(test (proper-list? #(a b)) #f)
+(test (proper-list? (list 1 2)) #t)
+(test (proper-list? (list)) #t)
+(test (proper-list? ''foo) #t)
+(test (proper-list? ''2) #t)
+(test (proper-list? (list 'a 'b 'c 'd 'e 'f)) #t)
+(test (proper-list? '(this-that)) #t)
+(test (proper-list? '(this - that)) #t)
+(let ((x (list 1 2)))
+ (set-cdr! x x)
+ (test (proper-list? x) #f))
+(test (proper-list? (list 1 (cons 1 2))) #t)
+(test (proper-list? (list 1 (cons 1 ()))) #t)
+(test (proper-list? (cons 1 ())) #t)
+(test (proper-list? (cons () ())) #t)
+(test (proper-list? (cons () 1)) #f)
+(test (proper-list? (list (list))) #t)
+(test (proper-list? '(())) #t)
+(test (proper-list? '(1 2 . 3)) #f)
+(test (proper-list? (cons 1 (cons 2 3))) #f)
+(test (proper-list? '(1 . ())) #t)
+
+(test (proper-list? '(1 2) ()) 'error)
+(test (proper-list?) 'error)
+(for-each
+ (lambda (arg)
+ (if (proper-list? arg)
+ (format-logged #t ";(list? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; null?
+
(test (null? 'a) '#f)
-(test (null? '()) #t)
+(test (null? ()) #t)
+(test (null? ()) #t)
(test (null? '(a b c)) #f)
(test (null? (cons 1 2)) #f)
(test (null? ''()) #f)
@@ -3808,7 +7104,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (null? (make-vector 6)) #f)
(test (null? #t) #f)
(test (null? '(a . b)) #f)
-(test (null? '#(a b)) #f)
+(test (null? #(a b)) #f)
(test (null? (list 1 2)) #f)
(test (null? (list)) #t)
(test (null? ''foo) #f)
@@ -3819,42 +7115,47 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set-cdr! x x)
(test (null? x) #f))
(test (null? (list 1 (cons 1 2))) #f)
-(test (null? (list 1 (cons 1 '()))) #f)
-(test (null? (cons 1 '())) #f)
-(test (null? (cons '() '())) #f)
-(test (null? (cons '() 1)) #f)
+(test (null? (list 1 (cons 1 ()))) #f)
+(test (null? (cons 1 ())) #f)
+(test (null? (cons () ())) #f)
+(test (null? (cons () 1)) #f)
(test (null? (list (list))) #f)
(test (null? '(())) #f)
-(test (null? '#()) #f)
+(test (null? #()) #f)
(test (null? (make-vector '(2 0 3))) #f)
(test (null? "") #f)
(test (null? lambda) #f)
(test (null? cons) #f)
+(test (null? (begin)) #t)
+(test (null? (cdr (list 1))) #t)
+(test (null? (cdr (cons () '(())))) #f)
-(test (null? () '()) 'error)
+(test (null? () ()) 'error)
(test (null?) 'error)
(for-each
(lambda (arg)
(if (null? arg)
- (format #t ";(null? ~A) -> #t?~%" arg)))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) #<eof> #<undefined> (values) (lambda (a) (+ a 1))))
+ (format-logged #t ";(null? ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t (if #f #f) :hi #<eof> #<undefined> (values) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; set-car!
+
(test (let ((x (cons 1 2))) (set-car! x 3) x) (cons 3 2))
(test (let ((x (list 1 2))) (set-car! x 3) x) (list 3 2))
(test (let ((x (list (list 1 2) 3))) (set-car! x 22) x) (list 22 3))
-(test (let ((x (cons 1 2))) (set-car! x '()) x) (cons '() 2))
+(test (let ((x (cons 1 2))) (set-car! x ()) x) (cons () 2))
(test (let ((x (list 1 (list 2 3 4)))) (set-car! x (list 5 (list 6))) x) (list (list 5 (list 6)) (list 2 3 4)))
(test (let ((x '(((1) 2) (3)))) (set-car! x '((2) 1)) x) '(((2) 1) (3)))
(test (let ((x ''foo)) (set-car! x "hi") x) (list "hi" 'foo))
(test (let ((x '((1 . 2) . 3))) (set-car! x 4) x) '(4 . 3))
(test (let ((x '(1 . 2))) (set-car! x (cdr x)) x) '(2 . 2))
-(test (let ((x '(1 . 2))) (set-car! x x) (list? x)) #f)
-(test (let ((x (list 1))) (set-car! x '()) x) '(()))
+(test (let ((x '(1 . 2))) (set-car! x x) (proper-list? x)) #f)
+(test (let ((x (list 1))) (set-car! x ()) x) '(()))
(test (let ((x '(((1 2) . 3) 4))) (set-car! x 1) x) '(1 4))
(test (let ((lst (cons 1 (cons 2 3)))) (set-car! (cdr lst) 4) lst) (cons 1 (cons 4 3)))
(test (let ((lst (cons 1 (cons 2 3)))) (set-car! lst 4) lst) (cons 4 (cons 2 3)))
@@ -3863,6 +7164,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((x (list 1 2))) (set-car! x (list 3 4)) x) '((3 4) 2))
(test (let ((x (cons 1 2))) (set-car! x (list 3 4)) x) '((3 4) . 2))
(test (let ((x (cons (list 1 2) 3))) (set-car! (car x) (list 3 4)) x) '(((3 4) 2) . 3))
+(test (let ((lst (list 1 2 3))) (set! (car lst) 32) lst) '(32 2 3))
(test (set-car! '() 32) 'error)
(test (set-car! () 32) 'error)
@@ -3871,13 +7173,20 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (set-car! #f 32) 'error)
(test (set-car!) 'error)
(test (set-car! '(1 2) 1 2) 'error)
+(test (let ((lst (list 1 2))) (set-car! lst (values 2 3)) lst) 'error)
+(test (let ((lst '(1 2))) (set-car! lst 32)) 32)
+(test (let ((lst '(1 2))) (set! (car lst) 32)) 32)
+
(test (let ((c (cons 1 2))) (set-car! c #\a) (car c)) #\a)
(test (let ((c (cons 1 2))) (set-car! c #()) (car c)) #())
(test (let ((c (cons 1 2))) (set-car! c #f) (car c)) #f)
(test (let ((c (cons 1 2))) (set-car! c _ht_) (car c)) _ht_)
+
+;;; --------------------------------------------------------------------------------
;;; set-cdr!
+
(test (let ((x (cons 1 2))) (set-cdr! x 3) x) (cons 1 3))
(test (let ((x (list 1 2))) (set-cdr! x 3) x) (cons 1 3))
(test (let ((x (list (list 1 2) 3))) (set-cdr! x 22) x) '((1 2) . 22))
@@ -3887,7 +7196,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((x ''foo)) (set-cdr! x "hi") x) (cons 'quote "hi"))
(test (let ((x '((1 . 2) . 3))) (set-cdr! x 4) x) '((1 . 2) . 4))
(test (let ((x '(1 . 2))) (set-cdr! x (cdr x)) x) '(1 . 2))
-(test (let ((x '(1 . 2))) (set-cdr! x x) (list? x)) #f)
+(test (let ((x '(1 . 2))) (set-cdr! x x) (proper-list? x)) #f)
(test (let ((x (list 1))) (set-cdr! x '()) x) (list 1))
(test (let ((x '(1 . (2 . (3 (4 5)))))) (set-cdr! x 4) x) '(1 . 4))
(test (let ((lst (cons 1 (cons 2 3)))) (set-cdr! (cdr lst) 4) lst) (cons 1 (cons 2 4)))
@@ -3895,6 +7204,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((x (list 1 2))) (set-cdr! x (list 4 5)) x) '(1 4 5))
(test (let ((x (cons 1 2))) (set-cdr! x (list 4 5)) x) '(1 4 5)) ;!
(test (let ((x (cons 1 2))) (set-cdr! x (cons 4 5)) x) '(1 4 . 5))
+(test (let ((lst (list 1 2 3))) (set! (cdr lst) 32) lst) (cons 1 32))
(test (set-cdr! '() 32) 'error)
(test (set-cdr! () 32) 'error)
@@ -3903,6 +7213,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (set-cdr! #f 32) 'error)
(test (set-cdr!) 'error)
(test (set-cdr! '(1 2) 1 2) 'error)
+(test (let ((lst '(1 2))) (set-cdr! lst 32)) 32)
+(test (let ((lst '(1 2))) (set! (cdr lst) 32)) 32)
+
(test (let ((c (cons 1 2))) (set-cdr! c #\a) (cdr c)) #\a)
(test (let ((c (cons 1 2))) (set-cdr! c #()) (cdr c)) #())
(test (let ((c (cons 1 2))) (set-cdr! c #f) (cdr c)) #f)
@@ -3912,7 +7225,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
+;;; --------------------------------------------------------------------------------
;;; list-ref
+
(test (list-ref (list 1 2) 1) 2)
(test (list-ref '(a b c d) 2) 'c)
(test (list-ref (cons 1 2) 0) 1) ; !!
@@ -3938,7 +7253,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
(val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
(if (not (equal? val1 val2))
- (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
+ (format-logged #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
lists))
(list 'list-ref:0 'list-ref:1 'list-ref:2 'list-ref:3)
(list car cadr caddr cadddr)
@@ -3947,8 +7262,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (list-ref (list 1 arg) 1) arg))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 0)) 1)
(test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 1)) 1)
@@ -4030,7 +7345,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((list-ref (L one) zero) two)) 9))
-(test (list-ref '() 0) 'error)
+(test (list-ref () 0) 'error)
(test (list-ref (list 1 2) 2) 'error)
(test (list-ref (list 1 2) -1) 'error)
(test (list-ref (list 1 2) 1.3) 'error)
@@ -4044,14 +7359,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (list-ref '(1 2)) 'error)
(test ('(0)) 'error)
(test ((0)) 'error)
+(test (list-ref '((1 2) (3 4)) 1 1) 4)
(test ('(1 2 3) 1) 2)
(test ((list 1 2 3) 2) 3)
(test ((list)) 'error)
(test ((list 1) 0 0) 'error)
(test ((list 1 (list 2 3)) 1 1) 3)
-(test ((append '(3) '() '(1 2)) 0) 3)
-(test ((append '(3) '() 1) 0) 3)
-(test ((append '(3) '() 1) 1) 'error)
+(test ((append '(3) () '(1 2)) 0) 3)
+(test ((append '(3) () 1) 0) 3)
+(test ((append '(3) () 1) 1) 'error)
;; this works with 0 because:
(test ((cons 1 2) 0) 1)
(test (list-ref (cons 1 2) 0) 1)
@@ -4061,6 +7377,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((lst (list (list 1 2 3)))) (lst 0 1)) 2)
(test ((list (list 1 2 3)) 0 1) 2)
(test (list-ref (list (list 1 2)) 0 ()) 'error)
+(test (((list +) 0) 1 2 3) 6)
+
(let ((lst (list 1 2)))
(for-each
@@ -4068,13 +7386,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (list-ref (list 1 2) arg) 'error)
(test ((list 1 2) arg) 'error)
(test (lst arg) 'error))
- (list "hi" (integer->char 65) #f '(1 2) '() 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list "hi" (integer->char 65) #f '(1 2) () 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+;;; --------------------------------------------------------------------------------
;;; list-set!
+
(test (let ((x (list 1))) (list-set! x 0 2) x) (list 2))
(test (let ((x (cons 1 2))) (list-set! x 0 3) x) '(3 . 2))
(test (let ((x (cons 1 2))) (list-set! x 1 3) x) 'error)
@@ -4090,16 +7410,19 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (set-car! '(1 2) 4) 4)
(test (set-cdr! '(1 2) 4) 4)
(test (fill! (list 1 2) 4) 4)
-(test (fill! '() 1) 1)
+(test (fill! () 1) 1)
(test (list-set! '(1 2 . 3) 1 23) 23)
(test (list-set! '(1 2 . 3) 2 23) 'error)
(test (set! ('(1 2 . 3) 1) 23) 23)
+(test (let ((lst '(1 2 3))) (list-set! lst 0 32)) 32)
+(test (let ((lst '(1 2 3))) (set! (lst 0) 32)) 32)
+(test (let ((lst '(1 2 3))) (set! (list-ref lst 0) 32)) 32)
(for-each
(lambda (arg)
(test (let ((x (list 1 2))) (list-set! x 0 arg) (list-ref x 0)) arg))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 32) L) '((1 2 3) 32))
(test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 0 32) L) '((1 2 3) (32 5 6)))
@@ -4172,8 +7495,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((x '(1)) (y '(2))) (set! ((if #t x y) 0) 32) (list x y)) '((32) (2)))
-(test (list-set! '() 0 1) 'error)
-(test (list-set! '() -1 1) 'error)
+(test (list-set! () 0 1) 'error)
+(test (list-set! () -1 1) 'error)
(test (list-set! '(1) 1 2) 'error)
(test (list-set! '(1 2 3) -1 2) 'error)
(test (list-set! '(1) 1.5 2) 'error)
@@ -4181,19 +7504,21 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (list-set! '(1) 1+3i 2) 'error)
(test (list-set! '(1 2 3) 1 2 3) 'error)
(test (list-set! (list 1 2 3) (expt 2 32) 0) 'error)
-(test (list-set! (list 1 2) '() 1) 'error)
+(test (list-set! (list 1 2) () 1) 'error)
(for-each
(lambda (arg)
(test (list-set! (list 1 2) arg arg) 'error)
(test (list-set! arg 1 2) 'error)
(test (list-set! (list 1 2) arg 1) 'error))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; list
+
(test (let ((tree1 (list 1 (list 1 2) (list (list 1 2 3)) (list (list (list 1 2 3 4)))))) tree1) '(1 (1 2) ((1 2 3)) (((1 2 3 4)))))
(test (let ((tree2 (list "one" (list "one" "two") (list (list "one" "two" "three"))))) tree2) '("one" ("one" "two") (("one" "two" "three"))))
(test (let ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4)))) tree1) '(1 (1 2) (1 2 3) (1 2 3 4)))
@@ -4206,10 +7531,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((a 1)) (list a 2)) '(1 2))
(test (let ((a 1)) (list 'a '2)) '(a 2))
(test (let ((a 1)) (list 'a 2)) '(a 2))
-(test (list) '())
+(test (list) ())
(test (let ((a (list 1 2))) a) '(1 2))
(test (let ((a (list 1 2))) (list 3 4 'a (car (cons 'b 'c)) (+ 6 -2))) '(3 4 a b 4))
-(test (list) '())
+(test (list) ())
(test (length (list quote do map call/cc lambda define if begin set! let let* cond and or for-each)) 15)
(test (list 1(list 2)) '(1(2)))
(test (list 1 2 . 3) 'error)
@@ -4218,18 +7543,21 @@ zzy" (lambda (p) (eval (read p))))) 32)
+
+;;; --------------------------------------------------------------------------------
;;; list-tail
+
(test (list-tail '(1 2 3) 0) '(1 2 3))
(test (list-tail '(1 2 3) 2) '(3))
-(test (list-tail '(1 2 3) 3) '())
+(test (list-tail '(1 2 3) 3) ())
(test (list-tail '(1 2 3 . 4) 2) '(3 . 4))
(test (list-tail '(1 2 3 . 4) 3) 4)
(test (let ((x (list 1 2 3))) (eq? (list-tail x 2) (cddr x))) #t)
-(test (list-tail '() 0) '())
-(test (list-tail '() 1) 'error)
+(test (list-tail () 0) ())
+(test (list-tail () 1) 'error)
(test (list-tail '(1 2 3) 4) 'error)
-(test (list-tail '() -1) 'error)
-(test (list-tail (list 1 2) 2) '())
+(test (list-tail () -1) 'error)
+(test (list-tail (list 1 2) 2) ())
(test (list-tail (cons 1 2) 0) '(1 . 2))
(test (list-tail (cons 1 2) 1) 2)
(test (list-tail (cons 1 2) 2) 'error)
@@ -4257,7 +7585,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error)))
(val2 (catch #t (lambda () (op2 lst)) (lambda args 'error))))
(if (not (equal? val1 val2))
- (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
+ (format-logged #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2))))
lists))
(list 'list-tail:0 'list-tail:1 'list-tail:2 'list-tail:3 'list-tail:4)
(list (lambda (l) l) cdr cddr cdddr cddddr)
@@ -4282,13 +7610,49 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (list-tail (list 1 2) arg) 'error)
(test (list-tail arg 0) 'error))
(list "hi" -1 3 most-negative-fixnum most-positive-fixnum
- (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
+ (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #\f #t (if #f #f) #<eof> #() #(1 2 3) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
+;;; make-list
+
+(test (make-list 0) ())
+(test (make-list 0 123) ())
+(test (make-list 1) '(#f))
+(test (make-list 1 123) '(123))
+(test (make-list 1 ()) '(()))
+(test (make-list 2) '(#f #f))
+(test (make-list 2 1) '(1 1))
+(test (make-list 2/1 1) '(1 1))
+(test (make-list 2 (make-list 1 1)) '((1) (1)))
+(test (make-list -1) 'error)
+(test (make-list -0) ())
+(test (make-list most-negative-fixnum) 'error)
+(test (make-list most-positive-fixnum) 'error)
+(test (make-list 0 #\a) ())
+(test (make-list 1 #\a) '(#\a))
+(for-each
+ (lambda (arg)
+ (test (make-list arg) 'error))
+ (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i 0.0 1.0 () #t 'hi #(()) (list 1 2 3) '(1 . 2) "hi" (- (real-part (log 0.0)))))
+
+(for-each
+ (lambda (arg)
+ (test ((make-list 1 arg) 0) arg))
+ (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+(test (make-list) 'error)
+(test (make-list 1 2 3) 'error)
+(test (let ((lst (make-list 2 (make-list 1 0)))) (eq? (lst 0) (lst 1))) #t)
+
+
+
+
+;;; --------------------------------------------------------------------------------
;;; assq
+
(let ((e '((a 1) (b 2) (c 3))))
(test (assq 'a e) '(a 1))
(test (assq 'b e) '(b 2))
@@ -4316,18 +7680,18 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (assq 'x (cdr (assq 'a '((b . 32) (a . ((a . 12) (b . 32) (x . 1))) (c . 1))))) '(x . 1))
-(test (assq #f '(#f 2 . 3)) #f)
+(when (not pure-s7) (test (assq #f '(#f 2 . 3)) #f))
(test (assq #f '((#f 2) . 3)) '(#f 2))
-(test (assq '() '((() 1) (#f 2))) '(() 1))
-(test (assq '() '((1) (#f 2))) #f)
+(test (assq () '((() 1) (#f 2))) '(() 1))
+(test (assq () '((1) (#f 2))) #f)
(test (assq #() '((#f 1) (() 2) (#() 3))) #f) ; (eq? #() #()) -> #f
(test (assq 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2))
(test (assq 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
(test (assq 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
-(test (assq 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
-(test (assq 'b (list '(a . 1) '(b . 2) '() '(c . 3) #f)) '(b . 2))
-(test (assq 'asdf (list '(a . 1) '(b . 2) '() '(c . 3) #f)) #f)
+(when (not pure-s7) (test (assq 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3)))
+(test (assq 'b (list '(a . 1) '(b . 2) () '(c . 3) #f)) '(b . 2))
+(test (assq 'asdf (list '(a . 1) '(b . 2) () '(c . 3) #f)) #f)
(test (assq "" (list '("a" . 1) '("" . 2) '(#() . 3))) #f) ; since (eq? "" "") is #f
(test (assq 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified?
(test (assq 'a '((b . 1) (a . 2) (a . 3))) '(a . 2))
@@ -4345,8 +7709,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (assq #(1) even) #f))
+
+;;; --------------------------------------------------------------------------------
;;; assv
-(test (assv 1 '(1 2 . 3)) #f)
+
+(when (not pure-s7) (test (assv 1 '(1 2 . 3)) #f))
(test (assv 1 '((1 2) . 3)) '(1 2))
(let ((e '((a 1) (b 2) (c 3))))
@@ -4378,22 +7745,22 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((e '(((a) 1) (#(a) 2) ("c" 3))))
(test (assv '(a) e) #f)
- (test (assv '#(a) e) #f)
+ (test (assv #(a) e) #f)
(test (assv (string #\c) e) #f))
(let ((lst '((2 . a) (3 . b))))
(set-cdr! (assv 3 lst) 'c)
(test lst '((2 . a) (3 . c))))
-(test (assv '() '((() 1) (#f 2))) '(() 1))
-(test (assv '() '((1) (#f 2))) #f)
+(test (assv () '((() 1) (#f 2))) '(() 1))
+(test (assv () '((1) (#f 2))) #f)
(test (assv #() '((#f 1) (() 2) (#() 3))) #f) ; (eqv? #() #()) -> #f ??
(test (assv 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2))
(test (assv 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
(test (assv 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
-(test (assv 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
-(test (assv 'asdf '((a . 1) (b . 2) () (c . 3) . 4)) #f)
+(when (not pure-s7) (test (assv 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3)))
+(when (not pure-s7) (test (assv 'asdf '((a . 1) (b . 2) () (c . 3) . 4)) #f))
(test (assv 'd '((a . 1) (b . 2) () (c . 3) (d . 5))) '(d . 5))
(test (assv 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified?
(test (assv 'a '((b . 1) (a . 2) (a . 3))) '(a . 2))
@@ -4411,9 +7778,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (assv #(1) odd) #f)
(test (assv #(1) even) #f))
+(test (assv 1/0 '((1/0 . 1) (1.0 . 3))) #f)
+(test (pair? (assv (real-part (log 0)) (list (cons 1/0 1) (cons (real-part (log 0)) 2) (cons -1 3)))) #t)
+(test (pair? (assv (- (real-part (log 0))) (list (cons 1/0 1) (cons (real-part (log 0)) 2) (cons -1 3)))) #f)
+
+;;; --------------------------------------------------------------------------------
;;; assoc
+
(let ((e '((a 1) (b 2) (c 3))))
(test (assoc 'a e) '(a 1))
(test (assoc 'b e) '(b 2))
@@ -4443,25 +7816,26 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((e '(((a) 1) (#(a) 2) ("c" 3))))
(test (assoc '(a) e) '((a) 1))
- (test (assoc '#(a) e) '(#(a) 2))
+ (test (assoc #(a) e) '(#(a) 2))
(test (assoc (string #\c) e) '("c" 3)))
(test (assoc 'a '((b c) (a u) (a i))) '(a u))
(test (assoc 'a '((b c) ((a) u) (a i))) '(a i))
(test (assoc (list 'a) '(((a)) ((b)) ((c)))) '((a)))
(test (assoc 5 '((2 3) (5 7) (11 13))) '(5 7))
-(test (assoc 'key '()) #f)
-(test (assoc 'key '(() ())) #f)
-(test (assoc '() '()) #f)
+(test (assoc 'key ()) #f)
+(test (assoc 'key '(() ())) 'error)
+(test (assoc () ()) #f)
(test (assoc 1 '((1 (2)) (((3) 4)))) '(1 (2)))
+(test (assoc #f () 1/9223372036854775807) 'error)
-(test (assoc '() 1) 'error)
+(test (assoc () 1) 'error)
(test (assoc (cons 1 2) 1) 'error)
(test (assoc (let ((x (cons 1 2))) (set-cdr! x x)) 1) 'error)
(test (assoc '((1 2) .3) 1) 'error)
(test (assoc ''foo quote) 'error)
(test (assoc 3 '((a . 3)) abs =) 'error)
-(test (assoc 1 '(1 2 . 3)) #f)
+(test (assoc 1 '(1 2 . 3)) 'error)
(test (assoc 1 '((1 2) . 3)) '(1 2))
(test (assoc 1 '((1) (1 3) (1 . 2))) '(1))
(test (assoc 1 '((1 2 . 3) (1 . 2))) '(1 2 . 3))
@@ -4470,9 +7844,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (assoc 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified?
(test (assoc 'a '((b . 1) (a . 2) (a . 3))) '(a . 2))
-(test (assoc '() '((() 1) (#f 2))) '(() 1))
-(test (assoc '() '((1) (#f 2))) #f)
+(test (assoc () '((() 1) (#f 2))) '(() 1))
+(test (assoc () '((1) (#f 2))) #f)
(test (assoc #() '((#f 1) (() 2) (#() 3))) '(#() 3))
+(test (assoc #<unspecified> (list (cons (apply values ()) #f))) '(#<unspecified> . #f))
(for-each
(lambda (arg)
@@ -4483,8 +7858,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (assoc 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3))
(test (assoc 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2))
(test (assoc 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3))
-(test (assoc 'c '(() (a . 1) (b . 2) () (c . 3) (c . 4) . 4)) '(c . 3))
-(test (assoc 'asdf '(() (a . 1) (b . 2) () (c . 3) (c . 4) . 4)) #f)
+(test (assoc 'c '((a . 1) (b . 2) () (c . 3) (c . 4) . 4)) '(c . 3))
+(test (assoc 'asdf '((a . 1) (b . 2) () (c . 3) (c . 4) . 4)) #f)
(test (assoc "" (list '("a" . 1) '("" . 2) '(#() . 3))) '("" . 2))
(test (assoc assoc (list (cons abs 1) (cons assoc 2) (cons + 3))) (cons assoc 2))
@@ -4504,7 +7879,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) =) '(3 . c))
(test (assoc 3 '((1 . a) (2 . b) (31 . c) (4 . d)) =) #f)
-(test (assoc 3 '() =) #f)
+(test (assoc 3 () =) #f)
(test (assoc 3.0 '((1 . a) (2 . b) (3 . c) (4 . d)) =) '(3 . c))
(test (assoc #\a '((#\A . 1) (#\b . 2)) char=?) #f)
(test (assoc #\a '((#\A . 1) (#\b . 2)) char-ci=?) '(#\A . 1))
@@ -4515,7 +7890,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b c) (= a b))) 'error)
(test (assoc 3.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda* (a b c) (= a b))) '(3 . c))
(test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a) (= a 1))) 'error)
-(test (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (make-procedure-with-setter = =)) '(4 . d))
+(test (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (dilambda = =)) '(4 . d))
(test (catch #t (lambda () (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b) (error 'assoc a)))) (lambda args (car args))) 'assoc)
(test (call-with-exit (lambda (go) (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b) (go 'assoc))))) 'assoc)
(test (assoc 3 '((#\a . 3) (#() . 2) (3.0 . 1) ("3" . 0))) #f)
@@ -4549,9 +7924,50 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (assoc 1 '((3 . 2) 3) =) 'error)
(test (assoc 1 '((1 . 2) 3) =) '(1 . 2)) ; this is like other trailing error unchecked cases -- should we check?
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a) (eq? a b))) 'error)
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b c) (eq? a b))) 'error)
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b c . d) (eq? a b))) 'error)
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b . c) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda a (apply eq? a))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a . b) (eq? a (car b)))) '(a 1))
+
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a) (eq? a b))) 'error)
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b c) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b c . d) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b . c) (eq? a b))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* a (apply eq? a))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a . b) (eq? a (car b)))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a :rest b) (eq? a (car b)))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a :rest b :rest c) (eq? a (car b)))) '(a 1))
+(test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (:rest a) (apply eq? a))) '(a 1))
+(test (assoc 'a '((a 1) (b 2) (c 3)) (define-macro (_m_ a b) `(eq? ',a ',b))) '(a 1))
+(test (assoc 'c '((a 1) (b 2) (c 3)) (define-macro (_m_ a b) `(eq? ',a ',b))) '(c 3))
+(let ()
+ (define (atest a b)
+ (eq? a b))
+ (atest 1 1)
+ (let ((lst (list (cons 'a 1) (cons 'b 2))))
+ (test (assoc 'b lst atest) '(b . 2))))
+
+(for-each
+ (lambda (arg lst)
+ (test (assoc arg lst eq?) (assq arg lst))
+ (test (assoc arg lst eqv?) (assv arg lst))
+ (test (assoc arg lst equal?) (assoc arg lst)))
+ (list 'a #f (list 'a) 'a 1 3/4 #(1) "hi")
+ (list '((a . 1) (b . 2) (c . 3)) '((1 . 1) ("hi" . 2) (#t . 4) (#f . 5) (2 . 3))
+ '((b . 1) ((a) . 2) (c . 3)) '((d . 1) (a . 2) (b . 4) . (c . 3))
+ '((1 . 1) (3/4 . 2) (23 . 3)) '((a . 1) (1 . 2) (#(1) . 4) (23 . 3))
+ '((1 . 1) ("hi" . 2) (23 . 3))))
+
+
+;;; --------------------------------------------------------------------------------
;;; memq
+
(test (memq 'a '(a b c)) '(a b c))
(test (memq 'a (list 'a 'b 'c)) '(a b c))
(test (memq 'b '(a b c)) '(b c))
@@ -4563,29 +7979,37 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (memq eq? (list 2 eqv? 1 eq?)) (list eq?))
(test (memq eq? (list 2 eqv? 2)) #f)
(test (memq 6 (memq 5 (memq 4 (memq 3 (memq 2 (memq 1 '(1 2 3 4 5 6))))))) '(6))
+(test (memq 1/2 (list (/ 2.0) .5 1/2)) #f)
(test (memq 'a (cons 'a 'b)) '(a . b))
-(test (memq 'a (list a b . c)) 'error)
(test (memq) 'error)
(test (memq 'a) 'error)
(test (memq 'a 'b) 'error)
(test (memq 'a '(a b . c)) '(a b . c))
(test (memq 'b '(a b . c)) '(b . c))
(test (memq 'c '(a b . c)) #f) ; or should it be 'c?
-(test (memq '() '(1 () 3)) '(() 3))
-(test (memq '() '(1 2)) #f)
+(test (memq () '(1 () 3)) '(() 3))
+(test (memq () '(1 2)) #f)
(test (memq 'a '(c d a b c)) '(a b c))
(test (memq 'a '(c d f b c)) #f)
-(test (memq 'a '()) #f)
+(test (memq 'a ()) #f)
(test (memq 'a '(c d a b . c)) '(a b . c))
(test (memq 'a '(c d f b . c)) #f)
+(test (memq #f '(1 "hi" #t)) #f)
+(test (memq () ()) #f)
+(test (memq () (list)) #f)
+(test (memq () (list ())) '(()))
(test (let ((x (cons 1 2))) (memq x (list x (cons 3 4)))) '((1 . 2) (3 . 4)))
(test (pair? (let ((x (lambda () 1))) (memq x (list 1 2 x 3)))) #t)
(test (memq memq (list abs + memq car)) (list memq car))
(test (memq 'a '(a a a)) '(a a a)) ;?
(test (memq 'a '(b a a)) '(a a))
(test (memq "hi" '(1 "hi" 2)) #f)
+(test (let ((str "hi")) (memq str (list 1 str 2))) '("hi" 2))
(test (memq #\a '(1 #f #\a 2)) '(#\a 2))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (memq x lst)) '(#(1 2 3) #(1 2)))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (memq x lst)) #f)
+
(let ((odd '(3 a 3.0 b 3/4 c #(1) d))
(even '(e 3 a 3.0 b 3/4 c #(1) d)))
(test (memq 'a odd) '(a 3.0 b 3/4 c #(1) d))
@@ -4597,19 +8021,36 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (memq #(1) odd) #f)
(test (memq #(1) even) #f))
+;;; but (memq pi (list 1 pi 2)) -> '(3.1415926535898 2)
+
+(test (memq (values #\a '(#\A 97 a))) #f)
+(test (memq (values #\a '(#\A 97 #\a))) '(#\a))
+(test (memq #\a (values #\a '(#\A 97 #\a))) 'error)
+(test (memq #\a (values '(#\A 97 #\a))) '(#\a))
+(test (memq #\a '(1 2) (values)) 'error) ; hmmm
+(test ((values memq (values #\a '(#\A 97 #\a)))) '(#\a))
+
+
+;;; --------------------------------------------------------------------------------
;;; memv
+
(test (memv 101 '(100 101 102)) '(101 102))
(test (memv 101 (list 100 101 102)) '(101 102))
(test (memv 3.4 '(1.2 2.3 3.4 4.5)) '(3.4 4.5))
(test (memv 3.4 '(1.3 2.5 3.7 4.9)) #f)
+(test (memv 1/2 (list (/ 2.0) .5 1/2)) '(1/2))
+(test (memv 1.0 '(1 2 3)) #f)
+(test (memv 1/0 '(1/0 1.0 3)) #f)
+(test (pair? (memv (real-part (log 0)) (list 1/0 (real-part (log 0)) -1))) #t)
+(test (pair? (memv (- (real-part (log 0))) (list 1/0 (real-part (log 0)) -1))) #f)
+
(let ((ls (list 'a 'b 'c)))
(set-car! (memv 'b ls) 'z)
(test ls '(a z c)))
(test (memv 1 (cons 1 2)) '(1 . 2))
(test (memv 'a (list 'a 'b . 'c)) 'error)
-(test (memv 'a (list 'a 'b . ''c)) '(a b quote c))
(test (memv 'a '(a b . c)) '(a b . c))
(test (memv 'asdf '(a b . c)) #f)
(test (memv) 'error)
@@ -4624,6 +8065,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (memv 'a '(b a a)) '(a a))
(test (memv "hi" '(1 "hi" 2)) #f)
(test (memv #\a '(1 #f #\a 2)) '(#\a 2))
+(test (memv cons (list car cdr cons +)) (list cons +))
+(test (memv (apply values ()) (list #<unspecified>)) (list #<unspecified>))
(let ((odd '(3 a 3.0 b 3/4 c #(1) d))
(even '(e 3 a 3.0 b 3/4 c #(1) d)))
@@ -4635,10 +8078,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (memv 3.0 even) '(3.0 b 3/4 c #(1) d))
(test (memv #(1) odd) #f)
(test (memv #(1) even) #f))
+(test (memv #(1) '(1 #(1) 2)) #f)
+(test (memv () '(1 () 2)) '(() 2))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (memv x lst)) '(#(1 2 3) #(1 2)))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (memv x lst)) #f)
+;;; --------------------------------------------------------------------------------
;;; member
+
(test (member (list 'a) '(b (a) c)) '((a) c))
(test (member "b" '("a" "c" "b")) '("b"))
(test (member 1 '(3 2 1 4)) '(1 4))
@@ -4652,16 +8101,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (member 'd '(a b c d)) '(d))
(test (member 'e '(a b c d)) #f)
(test (member 1 (cons 1 2)) '(1 . 2))
-(test (member 'a (list a b . c)) 'error)
(test (member 1 '(1 2 . 3)) '(1 2 . 3))
(test (member 2 '(1 2 . 3)) '(2 . 3))
(test (member 3 '(1 2 . 3)) #f)
(test (member 4 '(1 2 . 3)) #f)
+(test (member 1/2 (list (/ 2.0) .5 1/2)) '(1/2))
(test (member) 'error)
(test (member 'a) 'error)
(test (member 'a 'b) 'error)
-(test (member '() '(1 2 3)) #f)
-(test (member '() '(1 2 ())) '(()))
+(test (member () '(1 2 3)) #f)
+(test (member () '(1 2 ())) '(()))
(test (member #() '(1 () 2 #() 3)) '(#() 3))
(test (member #2d((1 2) (3 4)) '(1 #() #2d((1 2) (1 2)))) #f)
(test (member #2d((1 2) (3 4)) '(1 #() #2d((1 2) (3 4)))) '(#2d((1 2) (3 4))))
@@ -4673,6 +8122,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (member (member 3 '(1 2 3 4)) '((1 2) (2 3) (3 4) (4 5))) '((3 4) (4 5)))
(test (member "hi" '(1 "hi" 2)) '("hi" 2))
(test (member #\a '(1 #f #\a 2)) '(#\a 2))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (member x lst)) '(#(1 2 3) #(1 2)))
+(test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (member x lst)) '(#(1 2 3)))
(for-each
(lambda (arg)
@@ -4686,11 +8137,12 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (member . (3 '(1 2 3))) '(3))
(test (member '(1 2) '(1 2)) #f)
(test (member '(1 2) '((1 2))) '((1 2)))
-(test (member . '(quote . ((quote)))) '(quote))
-(test (member . '(quote . ((quote) .()))) '(quote))
+(test (member . '(quote . ((quote)))) #f)
+(test (member . '(quote . ((quote) .()))) #f)
(test (member '(((1))) '((((1).()).()).())) '((((1)))))
(test (member '((1)) '(1 (1) ((1)) (((1))))) '(((1)) (((1)))))
(test (member member (list abs car memq member +)) (list member +))
+(test (member () () "") 'error)
(let ((odd '(3 a 3.0 b 3/4 c #(1) d))
(even '(e 3 a 3.0 b 3/4 c #(1) d)))
@@ -4704,17 +8156,25 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (member #(1) even) '(#(1) d)))
(test (member 3 '(1 2 3 4) =) '(3 4))
-(test (member 3 '() =) #f)
+(test (member 3 () =) #f)
(test (member 3 '(1 2 4 5) =) #f)
(test (member 4.0 '(1 2 4 5) =) '(4 5))
(test (member #\a '(#\b #\A #\c) char=?) #f)
(test (member #\a '(#\b #\A #\c) char-ci=?) '(#\A #\c))
(test (member #\a '(#\b #\A #\c) (lambda (a b) (char-ci=? a b))) '(#\A #\c))
+(test (char=? (car (member #\a '(#\b #\a))) #\a) #t)
+(test (char=? (car (member #\a '(#\b #\a) (lambda (a b) (char=? a b)))) #\a) #t)
+(test (member 3 '(1 2 3 4) <) '(4))
+(test (member 3 '((1 2) (3 4)) member) '((3 4)))
+(test (member 3 '(((1 . 2) (4 . 5)) ((3 . 4))) assoc) '(((3 . 4))))
+(test (member '(#f #f #t) '(0 1 2) list-ref) '(2))
+(test (let ((v (vector 1 2 3))) (member v (list 0 v) vector-fill!)) '(0 #(0 0 0)))
+
(test (member 3 '(1 2 3) abs) 'error)
(test (member 3 '(1 2 3) quasiquote) 'error)
(test (member 3 '(1 2 3) (lambda (a b c) (= a b))) 'error)
(test (member 3 '(1 2 3) (lambda* (a b c) (= a b))) '(3))
-(test (member 3 '(1 2 3 4) (make-procedure-with-setter = =)) '(3 4))
+(test (member 3 '(1 2 3 4) (dilambda = =)) '(3 4))
(test (catch #t (lambda () (member 3 '(1 2 3) (lambda (a b) (error 'member a)))) (lambda args (car args))) 'member)
(test (call-with-exit (lambda (go) (member 3 '(1 2 3) (lambda (a b) (go 'member))))) 'member)
(test (member 'a '(a a a) eq?) '(a a a))
@@ -4727,6 +8187,33 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (member 4 '(1 2 3) member) 'error)
(test (member 4 '((1 2) (3 5) 7) (lambda (a b) (member a (map (lambda (c) (+ c 1)) b)))) '((3 5) 7))
(test (member 4 '((1 2) (3 5) 7) (lambda (a b) (assoc a (map (lambda (c) (cons (+ c 1) c)) b)))) '((3 5) 7))
+(test (let ((f #f)) (member 'a '(a b c) (lambda (a b) (if (eq? b 'a) (set! f (lambda () b))) (eq? a 123))) (f)) 'a)
+(test (let ((i 0) (f (make-vector 3))) (member 'a '(a b c) (lambda (a b) (vector-set! f i b) (set! i (+ i 1)) (eq? a 123))) f) #(a b c))
+(test (member 1 '(0 1 2) (lambda (a b . c) (= a b))) '(1 2))
+(test (member 1 '(0 1 2) (lambda* (a b c) (= a b))) '(1 2))
+(test (member 1 '(0 1 2) (lambda (a) (= a b))) 'error)
+(test (member 1 '(0 1 2) (lambda a (= (car a) (cadr a)))) '(1 2))
+
+(test (member 'a '(c 3 a 1 b 2) (lambda (a) (eq? a b))) 'error)
+(test (member 'a '(c 3 a 1 b 2) (lambda (a b) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda (a b c) (eq? a b))) 'error)
+(test (member 'a '(c 3 a 1 b 2) (lambda (a b c . d) (eq? a b))) 'error)
+(test (member 'a '(c 3 a 1 b 2) (lambda (a b . c) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda a (apply eq? a))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda (a . b) (eq? a (car b)))) '(a 1 b 2))
+
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a) (eq? a b))) 'error)
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a b) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a b c) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a b c . d) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a b . c) (eq? a b))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* a (apply eq? a))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a . b) (eq? a (car b)))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a :rest b) (eq? a (car b)))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (a :rest b :rest c) (eq? a (car b)))) '(a 1 b 2))
+(test (member 'a '(c 3 a 1 b 2) (lambda* (:rest a) (apply eq? a))) '(a 1 b 2))
+(test (member 'a '(a b c) (define-macro (_m_ a b) `(eq? ',a ',b))) '(a b c))
+(test (member 'c '(a b c) (define-macro (_m_ a b) `(eq? ',a ',b))) '(c))
(test (member 4 '(1 2 3 4 . 5)) '(4 . 5))
(test (member 4 '(1 2 3 4 . 5) =) '(4 . 5))
@@ -4743,7 +8230,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr lst))) (cdr lst)) (member 4 lst =)) #f)
(test (let ((lst '(1 2 3 5 6 9 10))) (member 3 lst (let ((last (car lst))) (lambda (a b) (let ((result (= (- b last) a))) (set! last b) result))))) '(9 10))
(test (let ((lst '(1 2 3 5 6 9 10))) (member 2 lst (let ((last (car lst))) (lambda (a b) (let ((result (= (- b last) a))) (set! last b) result))))) '(5 6 9 10))
-(test (member 1 '() =) #f)
+(test (member 1 () =) #f)
(test (member 1 #(1) =) 'error)
(test (member 3 '(5 4 3 2 1) >) '(2 1))
(test (member 3 '(5 4 3 2 1) >=) '(3 2 1))
@@ -4751,6 +8238,22 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (member '(1 2 . 3) '((1) (1 . 2) (1 2 . 3) (1 2 3) (1 2) 1 . 2)) '((1 2 . 3) (1 2 3) (1 2) 1 . 2))
(let ()
+ (define (sfind obj lst)
+ (member obj lst (lambda (a b)
+ (catch #t
+ (lambda ()
+ (and (equal? a b)
+ (member obj lst (lambda (a b)
+ (catch #t
+ (lambda ()
+ (error 'oops))
+ (lambda args
+ (equal? a b)))))))
+ (lambda args
+ 'oops)))))
+ (test (sfind 'a '(b c a d)) '(a d)))
+
+(let ()
(define-macro (do-list lst . body)
`(member #t ,(cadr lst) (lambda (a b)
(let ((,(car lst) b))
@@ -4801,14 +8304,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(let ((result (catch #t (lambda () (op arg)) (lambda args 'error))))
(if (not (eq? result 'error))
- (format #t ";(~A ~A) returned ~A?~%" op arg result))
- (test (op arg '() arg) 'error)
+ (format-logged #t ";(~A ~A) returned ~A?~%" op arg result))
+ (test (op arg () arg) 'error)
(test (op arg) 'error)))
- (list '() "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list () "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar
caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar
- assq assv assoc memq memv member list-ref list-tail))
+ assq assv memq memv list-ref list-tail))
(for-each
(lambda (op)
@@ -4823,63 +8326,68 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg)
(let ((result (catch #t (lambda () (op #f arg)) (lambda args 'error))))
(if (not (eq? result 'error))
- (format #t ";(~A #f ~A) returned ~A?~%" op arg result))))
- (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (format-logged #t ";(~A #f ~A) returned ~A?~%" op arg result))))
+ (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list assq assv assoc memq memv member))
+;;; --------------------------------------------------------------------------------
;;; append
-(test (append '(a b c) '()) '(a b c))
-(test (append '() '(a b c)) '(a b c))
+
+(test (append '(a b c) ()) '(a b c))
+(test (append () '(a b c)) '(a b c))
(test (append '(a b) '(c d)) '(a b c d))
(test (append '(a b) 'c) '(a b . c))
-(test (equal? (append (list 'a 'b 'c) (list 'd 'e 'f) '() '(g)) '(a b c d e f g)) #t)
-(test (append (list 'a 'b 'c) (list 'd 'e 'f) '() (list 'g)) '(a b c d e f g))
+(test (equal? (append (list 'a 'b 'c) (list 'd 'e 'f) () '(g)) '(a b c d e f g)) #t)
+(test (append (list 'a 'b 'c) (list 'd 'e 'f) () (list 'g)) '(a b c d e f g))
(test (append (list 'a 'b 'c) 'd) '(a b c . d))
-(test (append '() '()) '())
-(test (append '() (list 'a 'b 'c)) '(a b c))
-(test (append) '())
-(test (append '() 1) 1)
+(test (append () ()) ())
+(test (append () (list 'a 'b 'c)) '(a b c))
+(test (append) ())
+(test (append () 1) 1)
(test (append 'a) 'a)
(test (append '(x) '(y)) '(x y))
(test (append '(a) '(b c d)) '(a b c d))
(test (append '(a (b)) '((c))) '(a (b) (c)))
(test (append '(a b) '(c . d)) '(a b c . d))
-(test (append '() 'a) 'a)
+(test (append () 'a) 'a)
(test (append '(a b) (append (append '(c)) '(e) 'f)) '(a b c e . f))
(test (append ''foo 'foo) '(quote foo . foo))
-(test (append '() (cons 1 2)) '(1 . 2))
-(test (append '() '() '()) '())
+(test (append () (cons 1 2)) '(1 . 2))
+(test (append () () ()) ())
(test (append (cons 1 2)) '(1 . 2))
(test (append #f) #f)
-(test (append '() #f) #f)
+(test (append () #f) #f)
(test (append '(1 2) #f) '(1 2 . #f))
-(test (append '() '() #f) #f)
-(test (append '() '(1 2) #f) '(1 2 . #f))
-(test (append '(1 2) '() #f) '(1 2 . #f))
+(test (append () () #f) #f)
+(test (append () '(1 2) #f) '(1 2 . #f))
+(test (append '(1 2) () #f) '(1 2 . #f))
(test (append '(1 2) '(3 4) #f) '(1 2 3 4 . #f))
-(test (append '() '() '() #f) #f)
+(test (append () () () #f) #f)
(test (append '(1 2) '(3 4) '(5 6) #f) '(1 2 3 4 5 6 . #f))
(test (append () () #()) #())
(test (append () ((lambda () #f))) #f)
+(test (append (begin) do) do)
+(test (append if) if)
+(test (append quote) quote)
(test (append 0) 0) ; is this correct?
-(test (append '() 0) 0)
-(test (append '() '() 0) 0)
-(test (let* ((x '(1 2 3)) (y (append x '()))) (eq? x y)) #f) ; check that append returns a new list
-(test (let* ((x '(1 2 3)) (y (append x '()))) (equal? x y)) #t)
+(test (append () 0) 0)
+(test (append () () 0) 0)
+(test (let* ((x '(1 2 3)) (y (append x ()))) (eq? x y)) #f) ; check that append returns a new list
+(test (let* ((x '(1 2 3)) (y (append x ()))) (equal? x y)) #t)
(test (let* ((x (list 1 2 3)) (y (append x (list)))) (eq? x y)) #f)
(test (append '(1) 2) '(1 . 2))
(let ((x (list 1 2 3)))
- (let ((y (append x '())))
+ (let ((y (append x ())))
(set-car! x 0)
(test (= (car y) 1) #t)))
(let ((x (list 1 2 3)))
- (let ((y (append x '())))
+ (let ((y (append x ())))
(set-cdr! x 0)
(test (and (= (car y) 1)
(= (cadr y) 2)
@@ -4889,8 +8397,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((xx (list 1 2))) (recompose 12 (lambda (x) (append (list (car x)) (cdr x))) xx)) '(1 2))
(test (append 'a 'b) 'error)
-(test (append 'a '()) 'error)
-(test (append (cons 1 2) '()) 'error)
+(test (append 'a ()) 'error)
+(test (append (cons 1 2) ()) 'error)
(test (append '(1) 2 '(3)) 'error)
(test (append '(1) 2 3) 'error)
(test (let ((lst (list 1 2 3))) (append lst lst)) '(1 2 3 1 2 3))
@@ -4898,63 +8406,164 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (append '(1 2 . 3) '(4)) 'error)
(test (append '(1 2 . 3)) '(1 2 . 3))
(test (append '(4) '(1 2 . 3)) '(4 1 2 . 3))
-(test (append '() 12 . ()) 12)
+(test (append () 12 . ()) 12)
(test (append '(1) 12) '(1 . 12))
(test (append '(1) 12 . ()) '(1 . 12))
-(test (append '() '() '(1) 12) '(1 . 12))
+(test (append () () '(1) 12) '(1 . 12))
(test (append '(1) '(2) '(3) 12) '(1 2 3 . 12))
(test (append '(((1))) '(((2)))) '(((1)) ((2))))
-(test (append '() . (2)) 2)
+(test (append () . (2)) 2)
(test (append . (2)) 2)
-(test (append ''() '()) ''())
+(test (append ''() ()) ''())
+(test (let ((i 1)) (logior 123 (append i))) 123) ; !
(for-each
(lambda (arg)
(test (append arg) arg)
- (test (append '() arg) arg)
- (test (append '() '() '() arg) arg))
- (list "hi" #\a #f 'a-symbol _ht_ (make-vector 3) abs 1 3.14 3/4 1.0+1.0i 0/0 #t #<unspecified> #<eof> '() #() (list 1 2) (cons 1 2) #(0) (lambda (a) (+ a 1))))
+ (test (append () arg) arg)
+ (test (append () () () arg) arg))
+ (list "hi" #\a #f 'a-symbol _ht_ _null_ (make-vector 3) abs 1 3.14 3/4 1.0+1.0i #t #<unspecified> #<eof> () #() (list 1 2) (cons 1 2) #(0) (lambda (a) (+ a 1))))
(test (append not) not)
-
-
-(test (eval-string "(list #b)") 'error)
-(test (eval-string "(char? #\\spaces)") 'error)
-(test (eval-string "(car '( . 1))") 'error)
-(test (eval-string "(car '(. ))") 'error)
-(test (eval-string "(car '( . ))") 'error)
-(test (eval-string "(car '(. . . ))") 'error)
-(test (eval-string "'#( . 1)") 'error)
-(test (eval-string "'(1 2 . )") 'error)
-(test (eval-string "'#(1 2 . )") 'error)
-(test (eval-string "(+ 1 . . )") 'error)
-(test (eval-string "(car '(1 . ))") 'error)
-(test (eval-string "(car '(1 . . 2))") 'error)
-(test (eval-string "'#( . )") 'error)
-(test (eval-string "'#(1 . )") 'error)
-(test (eval-string "'#(. . . )") 'error)
-(test (eval-string "'#(1 . . 2)") 'error)
-(test (eval-string "'(. 1)") 'error)
-(test (eval-string "'#(. 1)") 'error)
-(test (eval-string "'(. )") 'error)
-(test (eval-string "'#(. )") 'error)
-(test (eval-string "(list 1 . 2)") 'error)
-(test (eval-string "(+ 1 . 2)") 'error)
-(test (eval-string "(car '@#`')") 'error)
-(test (eval-string "(list . )") 'error)
-(test (eval-string "'#( .)") 'error)
-(test (eval-string "(car '( .))") 'error)
-(test (eval-string "(let ((. 3)) .)") 'error)
-(test (eval-string "#0d()") 'error)
-(test (eval-string "`#0d()") 'error)
-(test (eval-string "'#t:") 'error) ; guile interprets this as #t : and complains unbound variable :
-(test (eval-string "#t1") 'error) ; similarly this is #t 1 in guile
-(test (eval-string "'#(1 . 2)") 'error)
-(test (eval-string "#(1 2 . 3)") 'error)
-(test (eval-string "'#'") 'error)
-(test (eval-string "#b") 'error)
-
-
+(test (let ((l0 (list 0))
+ (l1 (list 0)))
+ (let ((m0 (append '(2) l0))
+ (m1 (append '(2) l1 '())))
+ (and (equal? l0 l1)
+ (equal? m0 m1)
+ (let ()
+ (list-set! m0 1 3)
+ (list-set! m1 1 3)
+ (list l0 l1)))))
+ '((3) (0)))
+
+;;; generic append
+(test (append "asdasd" '("asd")) 'error)
+(test (append "asdasd" #("asd")) 'error)
+(test (append (->byte-vector "asdasd") '("asd")) 'error)
+(test (append (->byte-vector "asdasd") #("asd")) 'error)
+
+(test (let ((h1 (hash-table* 'a 1 'b 2)) (h2 (hash-table* 'c 3))) (append h1 h2)) (hash-table '(c . 3) '(a . 1) '(b . 2)))
+(test (let ((i1 (inlet 'a 1)) (i2 (inlet 'b 2 'c 3))) (append i1 i2)) (inlet 'a 1 'c 3 'b 2))
+(test (let ((s1 "abc") (s2 "def")) (append s1 s2)) "abcdef")
+(test (let ((v1 #(0 1)) (v2 #(2 3))) (append v1 v2)) #(0 1 2 3))
+(test (let ((p1 '(1 2)) (p2 '(3 4))) (append p1 p2)) '(1 2 3 4))
+(test (vector? (append #())) #t)
+(test (float-vector? (append (float-vector))) #t)
+(test (int-vector? (append (int-vector))) #t)
+(test (append "12" '(1 . 2) "3") 'error)
+(for-each
+ (lambda (arg)
+ (test (append arg) arg)
+ (test (append () arg) arg))
+ (list "" #u8() () #() (int-vector) (float-vector) (inlet) (hash-table)
+ "123" #u8(101 102)
+ '(1 2 3) '((e . 5) (f . 6))
+ #(1 2 3) #((g . 8) (h . 9)) (int-vector 1 2 3) (float-vector 1 2 3)
+ (inlet 'a 1 'b 2)
+ (hash-table* 'c 3 'd 4)))
+(test (append #u8() (int-vector 1 2 3)) #u8(1 2 3))
+(test (append #u8() "123") #u8(49 50 51))
+(test (append "" "123") "123")
+(test (append #() (hash-table)) #())
+(test (append #() #u8(101 102)) #(101 102))
+(test (append (float-vector) #u8(101 102)) (float-vector 101.0 102.0))
+(test (append (int-vector) #u8(101 102)) (int-vector 101 102))
+(test (append (hash-table) '((e . 5) (f . 6))) (hash-table '(e . 5) '(f . 6)))
+(test (append (inlet) #((g . 8) (h . 9))) (inlet 'g 8 'h 9))
+(test (append '(1 2 3) #u8()) '(1 2 3))
+(test (append '(1 2 3) #u8(101 102)) '(1 2 3 101 102))
+(test (append '(1 2 3) (inlet 'a 1 'b 2)) '(1 2 3 (b . 2) (a . 1)))
+(test (let ((lst (append '((e . 5) (f . 6)) (hash-table '(c . 3) '(d . 4)))))
+ (or (equal? lst '((e . 5) (f . 6) (c . 3) (d . 4)))
+ (equal? lst '((e . 5) (f . 6) (d . 4) (c . 3))))) #t)
+(test (append #(1 2 3) "123") #(1 2 3 #\1 #\2 #\3))
+(test (append (int-vector 1 2 3) #(1 2 3)) (int-vector 1 2 3 1 2 3))
+(test (append (int-vector 1 2 3) "123") (int-vector 1 2 3 49 50 51))
+(test (append (float-vector 1.0 2.0 3.0) (int-vector 1 2 3)) (float-vector 1.0 2.0 3.0 1.0 2.0 3.0))
+(test (append (int-vector 1 2 3) (float-vector 1.0 2.0 3.0)) (int-vector 1 2 3 1 2 3))
+(test (append (inlet 'a 1 'b 2) '((e . 5) (f . 6))) (inlet 'b 2 'a 1 'e 5 'f 6))
+(test (append (inlet 'a 1 'b 2) (hash-table '(c . 3) '(d . 4))) (inlet 'b 2 'a 1 'c 3 'd 4))
+(test (append "" #() #u8(101 102)) "ef")
+(test (append "" #u8(101 102) (hash-table)) "ef")
+(test (append #u8() #() #u8(101 102)) #u8(101 102))
+(test (append #u8() (inlet) "") #u8())
+(test (append #u8() #u8(101 102) "123") #u8(101 102 49 50 51))
+(test (append () "" (int-vector 1 2 3)) (int-vector 1 2 3))
+(test (let ((v (append #() #u8() (hash-table '(c . 3) '(d . 4)))))
+ (or (equal? v #((c . 3) (d . 4)))
+ (equal? v #((d . 4) (c . 3))))) #t)
+(test (append #() #(1 2 3) (inlet)) #(1 2 3))
+(test (append #() (float-vector 1.0 2.0 3.0) ()) #(1.0 2.0 3.0))
+(test (append (float-vector) "" "123") (float-vector 49.0 50.0 51.0))
+(test (append (float-vector) (int-vector 1 2 3) #u8(101 102)) (float-vector 1.0 2.0 3.0 101.0 102.0))
+(test (append (inlet) #() #((g . 8) (h . 9))) (inlet 'g 8 'h 9))
+(test (append (inlet) '((e . 5) (f . 6)) (hash-table '(c . 3) '(d . 4))) (inlet 'e 5 'f 6 'c 3 'd 4))
+(test (append (hash-table) "" (inlet 'a 1 'b 2)) (hash-table '(b . 2) '(a . 1)))
+(test (append (hash-table) '((e . 5) (f . 6)) (inlet 'a 1 'b 2)) (hash-table '(b . 2) '(e . 5) '(f . 6) '(a . 1)))
+(test (append (hash-table) #((g . 8) (h . 9)) '((e . 5) (f . 6))) (hash-table '(e . 5) '(g . 8) '(f . 6) '(h . 9)))
+(test (append "123" #u8(101 102) (hash-table)) "123ef")
+(test (append #u8(101 102) #u8() #u8(101 102)) #u8(101 102 101 102))
+(test (append #u8(101 102) "123" (int-vector 1 2 3)) #u8(101 102 49 50 51 1 2 3))
+(test (append #u8(101 102) '(1 2 3) "") #u8(101 102 1 2 3))
+(test (append '(1 2 3) #u8(101 102) #(1 2 3)) '(1 2 3 101 102 1 2 3))
+(test (let ((lst (append '(1 2 3) (hash-table '(c . 3) '(d . 4)) "")))
+ (or (equal? lst '(1 2 3 (c . 3) (d . 4)))
+ (equal? lst '(1 2 3 (d . 4) (c . 3))))) #t)
+(test (append (int-vector 1 2 3) #u8(101 102) (float-vector 1.0 2.0 3.0)) (int-vector 1 2 3 101 102 1 2 3))
+(test (append (int-vector 1 2 3) '(1 2 3) #u8(101 102)) (int-vector 1 2 3 1 2 3 101 102))
+(test (append (hash-table '(c . 3) '(d . 4)) (hash-table '(c . 3) '(d . 4)) '((e . 5) (f . 6))) (hash-table '(e . 5) '(f . 6) '(c . 3) '(d . 4)))
+(when with-block
+ (test (append (block 1 2) (block 3 4)) (block 1 2 3 4)))
+
+(test (random-state? (cdr (append '(1) (random-state 123)))) #t)
+(test (append '(1) (random-state 123) ()) 'error)
+(test (random-state? (append () (random-state 123))) #t)
+
+(when full-test
+ (let ((seqs (list "" #u8() () #() (int-vector) (float-vector) (inlet) (hash-table)
+ "123" #u8(101 102)
+ '(1 2 3) '((e . 5) (f . 6))
+ #(1 2 3) #((g . 8) (h . 9)) (int-vector 1 2 3) (float-vector 1 2 3)
+ (inlet 'a 1 'b 2)
+ (hash-table* 'c 3 'd 4)
+ 1 #f '(1 . 2) (let ((lst (list 1))) (set-cdr! lst lst)))))
+ (define (test-append)
+ (for-each
+ (lambda (s1)
+ (catch #t
+ (lambda ()
+ (append s1)
+ (for-each
+ (lambda (s2)
+ (catch #t
+ (lambda ()
+ (append s1 s2)
+ (for-each
+ (lambda (s3)
+ (catch #t
+ (lambda ()
+ (append s1 s2 s3)
+ (for-each
+ (lambda (s4)
+ (catch #t
+ (lambda ()
+ (append s1 s2 s3 s4)
+ (for-each
+ (lambda (s5)
+ (catch #t (lambda ()
+ (append s1 s2 s3 s4 s5))
+ (lambda args 'error)))
+ seqs))
+ (lambda args 'error)))
+ seqs))
+ (lambda args 'error)))
+ seqs))
+ (lambda args 'error)))
+ seqs))
+ (lambda args 'error)))
+ seqs))
+ (test-append)))
@@ -4963,22 +8572,24 @@ zzy" (lambda (p) (eval (read p))))) 32)
;;; --------------------------------------------------------------------------------
+;;; --------------------------------------------------------------------------------
;;; vector?
+
(test (vector? (make-vector 6)) #t)
(test (vector? (make-vector 6 #\a)) #t)
(test (vector? (make-vector 0)) #t)
;; (test (vector? #*1011) #f)
-(test (vector? '#(0 (2 2 2 2) "Anna")) #t)
-(test (vector? '#()) #t)
-(test (vector? '#("hi")) #t)
+(test (vector? #(0 (2 2 2 2) "Anna")) #t)
+(test (vector? #()) #t)
+(test (vector? #("hi")) #t)
(test (vector? (vector 1)) #t)
(test (let ((v (vector 1 2 3))) (vector? v)) #t)
(for-each
(lambda (arg)
(test (vector? arg) #f))
- (list #\a 1 '() (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (vector?) 'error)
(test (vector? #() #(1)) 'error)
@@ -4996,30 +8607,42 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (avect i j) (cons i j))))
(set! check-shared-vector-after-gc (avect 3)))
+(test (vector? (make-vector 3 1 #t)) #t)
+(if (not with-bignums)
+ (test (vector? (make-vector 3 pi #t)) #t))
+(test (vector? (make-vector 3 pi #f)) #t)
+(test (vector? (make-shared-vector (make-int-vector '(2 3)) '(3 2))) #t)
+
+
+;;; --------------------------------------------------------------------------------
;;; make-vector
+
(test (let ((v (make-vector 3 #f))) (and (vector? v) (= (vector-length v) 3) (eq? (vector-ref v 1) #f))) #t)
(test (let ((v (make-vector 1 1))) (and (vector? v) (= (vector-length v) 1) (vector-ref v 0))) 1)
(test (let ((v (make-vector 0 1))) (and (vector? v) (= (vector-length v) 0))) #t)
-(test (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) '#(0 1 2 3 4))
-(test (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) '#(0 1 4 9 16))
-(test (make-vector 2 'hi) '#(hi hi))
-(test (make-vector 0) '#())
+(test (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) #(0 1 2 3 4))
+(test (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) #(0 1 4 9 16))
+(test (make-vector 2 'hi) #(hi hi))
+(test (make-vector 0) #())
(test (make-vector -0) #())
-(test (make-vector 0 'hi) '#())
-(test (make-vector 3 (make-vector 1 'hi)) '#(#(hi) #(hi) #(hi)))
-(test (make-vector 3 '#(hi)) '#(#(hi) #(hi) #(hi)))
-(test (make-vector 9/3 (list)) '#(() () ()))
-(test (make-vector 3/1 (make-vector 1 (make-vector 1 'hi))) '#(#(#(hi)) #(#(hi)) #(#(hi))))
+(test (make-vector 0 'hi) #())
+(test (make-vector 3 (make-vector 1 'hi)) #(#(hi) #(hi) #(hi)))
+(test (make-vector 3 #(hi)) #(#(hi) #(hi) #(hi)))
+(test (make-vector 9/3 (list)) #(() () ()))
+(test (make-vector 3/1 (make-vector 1 (make-vector 1 'hi))) #(#(#(hi)) #(#(hi)) #(#(hi))))
+(test (make-vector 0 0.0 #t) #())
+(test (make-vector 0 0.0) #())
(test (let ((v (make-vector 3 0))) (set! (vector-ref v 1) 32) v) #(0 32 0))
+(test (let ((v (make-int-vector 3))) (set! (vector-ref v 1) 0) v) (make-int-vector 3 0))
(for-each
(lambda (arg)
(test (vector-ref (make-vector 1 arg) 0) arg))
- (list #\a 1 '() (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
(test (make-vector) 'error)
@@ -5033,72 +8656,402 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (make-vector '(2 3 . 4)) 'error)
(test (make-vector '(2 (3))) 'error)
(test (make-vector most-negative-fixnum) 'error)
+(test (make-vector 3 0 #f 1) 'error)
(for-each
(lambda (arg)
(test (make-vector arg) 'error)
(test (make-vector (list 2 arg)) 'error))
- (list #\a '() -1 #f "hi" 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(test (eval-string "#2147483649D()") 'error)
+(test (eval-string "#-9223372036854775808D()") 'error)
+(test (eval-string "#922D()") 'error)
+
+
+;;; make-shared-vector
+(test (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (make-shared-vector v1 '(6)))) v2)) #(1 2 3 4 5 6))
+(test (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (make-shared-vector v1 '(3 2)))) v2)) #2D((1 2) (3 4) (5 6)))
+(test (make-shared-vector #2d() '(0)) #())
+(test (make-shared-vector '(1) '(1)) 'error)
+(test (make-shared-vector #(1) '(2)) 'error)
+(test (make-shared-vector #(1) '(1 2)) 'error)
+(test (make-shared-vector #(1 2 3 4) ()) 'error)
+(test (make-shared-vector #(1 2 3 4) most-positive-fixnum) 'error)
+(test (make-shared-vector #(1 2 3 4) most-negative-fixnum) 'error)
+(test (make-shared-vector #(1 2 3 4) -1) 'error)
+(test (make-shared-vector #(1 2 3 4) 5) 'error)
+(test (make-shared-vector #(1 2 3 4) 0) #())
+(test (make-shared-vector #(1 2 3 4) '(2)) #(1 2))
+(test (make-shared-vector #(1 2 3 4) '(2 1)) #2D((1) (2)))
+(test (make-shared-vector #(1 2 3 4) '(0)) #())
+(for-each
+ (lambda (arg)
+ (test (make-shared-vector arg) 'error)
+ (test (make-shared-vector #(1 2 3) arg) 'error))
+ (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(let ((v #2d((1 2) (3 4))))
+ (test (make-shared-vector v '((1 2) (3 4))) 'error)
+ (test (make-shared-vector v ()) 'error)
+ (test (make-shared-vector v '(1.4)) 'error)
+ (test (make-shared-vector v '(14 15)) 'error)
+ (test (make-shared-vector v (list most-positive-fixnum)) 'error)
+ (test (make-shared-vector v '(-1 0)) 'error)
+ (test (make-shared-vector v '(1) most-positive-fixnum) 'error))
+
+(let ((v (float-vector 0.0 1.0 2.0)))
+ (let ((v1 (make-shared-vector v (list 1 3))))
+ (test (float-vector? v1) #t)
+ (test (morally-equal? (v 0) (v1 0 0)) #t)))
+
+(let ((v (int-vector 0 1 2)))
+ (let ((v1 (make-shared-vector v (list 1 3))))
+ (test (int-vector? v1) #t)
+ (test (morally-equal? (v 0) (v1 0 0)) #t)))
+
+(let ((v (make-int-vector 3)))
+ (set! (v 1) 1)
+ (set! (v 2) 2)
+ (let ((v1 (make-shared-vector v (list 1 3))))
+ (test (float-vector? v1) #f)
+ (test (int-vector? v1) #t)
+ (test (integer? (v1 0 2)) #t)
+ (test (= (v 2) (v1 0 2)) #t)))
+
+(let ((v (vector 0 1 2 3 4 5 6 7 8)))
+ (test (make-shared-vector v (list 3 2) 1) #2D((1 2) (3 4) (5 6)))
+ (test (make-shared-vector v (list 3 2) 2) #2D((2 3) (4 5) (6 7)))
+ (test (make-shared-vector v (list 3) 2) #(2 3 4))
+ (test (make-shared-vector v (list 3) 0) (make-shared-vector v (list 3)))
+ (test (make-shared-vector v (list 3) -1) 'error)
+ (test (make-shared-vector v (list 3) 10) 'error)
+ (test (make-shared-vector v (list 3) 3.2) 'error)
+ (test (make-shared-vector v (list 3) "0") 'error)
+ )
+
+(test (make-shared-vector (make-shared-vector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(0)) #())
+(test (make-shared-vector (make-shared-vector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(1)) (float-vector 1.0))
+(test ((make-shared-vector (make-shared-vector (float-vector 1.0 2.0 3.0 4.0) '(2 2)) '(4 1)) 2 0) 3.0)
+(if with-bignums
+ (let ((v (float-vector (bignum "1.0") (bignum "2.0"))))
+ (test (float-vector? v) #t)
+ (test (v 0) 1.0)))
+
+(test (vector? (float-vector)) #t)
+(test (vector? (int-vector)) #t)
+(when with-block (test (float-vector? _c_obj_) #t))
+(test (float-vector? 1 2) 'error)
+(test (float-vector?) 'error)
+(test (int-vector? 1 2) 'error)
+(test (int-vector?) 'error)
+(for-each
+ (lambda (arg)
+ (if (float-vector? arg) (format *stderr* ";~A is a float-vector?~%" arg))
+ (test (float-vector arg) 'error)
+ (if (int-vector? arg) (format *stderr* ";~A is an int-vector?~%" arg))
+ (test (int-vector arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _null_ quasiquote macroexpand #() #t (vector 1 2 3) (lambda (a) (+ a 1))))
+
+
+;;; make-float-vector
+(test (float-vector? (make-float-vector 3)) #t)
+(test (float-vector? (make-float-vector 3 pi)) #t)
+(test ((make-float-vector 3) 1) 0.0)
+(test (float-vector? (float-vector)) #t)
+(test (float-vector? (make-float-vector 0)) #t)
+(test (float-vector? (int-vector)) #f)
+(test (equal? (float-vector) (int-vector)) #t)
+(test (equal? (vector) (int-vector)) #t)
+
+(test (equal? (make-float-vector 3 1.0) (float-vector 1.0 1.0 1.0)) #t)
+(test ((make-float-vector '(2 3) 2.0) 1 2) 2.0)
+(test (nan? ((make-float-vector 3 1/0) 0)) #t)
+(for-each
+ (lambda (arg)
+ (test (make-float-vector arg) 'error)
+ (test (make-float-vector 3 arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(test (equal? (vector) (float-vector)) #t)
+(test (float-vector? (make-float-vector 3 0)) #t)
+(test (float-vector? (make-float-vector 3 1/2)) #t)
+
+
+;;; make-int-vector
+(test (int-vector? (make-int-vector 3)) #t)
+(test (int-vector? (make-int-vector 3 2)) #t)
+(test ((make-int-vector 3) 1) 0)
+(test (int-vector? (int-vector)) #t)
+(test (int-vector? (make-int-vector 0)) #t)
+(test (int-vector? (float-vector)) #f)
+(test (int-vector? (vector)) #f)
+
+(test (equal? (make-int-vector 3 1) (int-vector 1 1 1)) #t)
+(test ((make-int-vector '(2 3) 2) 1 2) 2)
+(for-each
+ (lambda (arg)
+ (test (make-int-vector arg) 'error)
+ (test (make-int-vector 3 arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i 1/2 pi #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(test (equal? (vector) (int-vector)) #t)
+
+
+;;; float-vector-ref
+;;; float-vector-set!
+
+(test (float-vector-ref (float-vector 1.0 2.0) 1) 2.0)
+(for-each
+ (lambda (arg)
+ (test (float-vector-ref arg 0) 'error)
+ (test (float-vector-ref (float-vector 1.0) arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(let ((v (make-float-vector (list 2 3) 1.0))
+ (v1 (make-float-vector 3)))
+ (set! (v 1 1) 2.0)
+ (test (v 1 1) 2.0)
+ (test (v 0 1) 1.0)
+ (test (float-vector-ref v 1 1) 2.0)
+ (test (float-vector-ref v 0) (float-vector 1.0 1.0 1.0))
+ (test (float-vector-set! v 0 0 3.0) 3.0)
+ (test (float-vector-ref v 0 0) 3.0)
+ (test (float-vector-ref v1 3) 'error)
+ (test (float-vector-ref v 1 3) 'error)
+ (test (float-vector-ref v 2 2) 'error)
+ (test (float-vector-ref v1 most-positive-fixnum) 'error)
+ (test (float-vector-ref v1 most-negative-fixnum) 'error)
+ (test (float-vector-set! v1 3 0.0) 'error)
+ (test (float-vector-set! v 1 3 0.0) 'error)
+ (test (float-vector-set! v 2 2 0.0) 'error)
+ (test (float-vector-set! v1 most-positive-fixnum 0.0) 'error)
+ (test (float-vector-set! v1 most-negative-fixnum 0.0) 'error)
+ (test (float-vector-set! v1 0 0+i) 'error)
+ (for-each
+ (lambda (arg)
+ (test (float-vector-ref v 0 arg) 'error)
+ (test (float-vector-set! arg 0 1.0) 'error)
+ (test (float-vector-set! v1 arg) 'error)
+ (test (float-vector-set! v1 0 arg) 'error)
+ (test (float-vector-set! v 0 arg 1.0) 'error))
+ (list #\a () #f "hi" 1+i 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand #t (vector 1 2 3) (lambda (a) (+ a 1))))
+ (test (float-vector-ref v) 'error)
+ (test (float-vector-set! v) 'error)
+ (test (float-vector-ref v1 0 1) 'error)
+ (test (float-vector-ref v 0 1 0) 'error)
+ (test (float-vector-ref v1 -1) 'error)
+ (float-vector-set! v1 0 2/5)
+ (test (float-vector-ref v1 0) 0.4)
+ (test (float-vector-set! v1 1 4) 4)
+ (test (float-vector-ref v1 1) 4.0)
+ (test (float-vector-ref v 3 0) 'error)
+ (test (float-vector-ref v 1 3) 'error)
+ (test (fill! v 0.0) 0.0))
+(test (float-vector-ref (float-vector) 0) 'error)
+(let ((v (float-vector 1 2 3)))
+ (set! (float-vector-ref v 1) 32)
+ (test v (float-vector 1 32 3))
+ (set! (v 0) 64)
+ (test v (float-vector 64 32 3))
+ (test (float-vector-set! v 2 (float-vector-set! v 1 0.0)) 0.0)
+ (test v (float-vector 64 0 0)))
+(let ((v0 (make-float-vector '(3 0)))
+ (v1 (make-float-vector '(0 3)))
+ (v2 (make-float-vector '(2 3)))
+ (v3 (make-float-vector '(1 3)))
+ (v4 (make-float-vector '(3 1))))
+ (test (float-vector? v0) #t)
+ (test (float-vector-ref v0 0 0) 'error)
+ (test (vector? v0) #t)
+ (test (vector-ref v0 0 0) 'error)
+ (test (v0 0 0) 'error)
+ (test (float-vector? v1) #t)
+ (test (float-vector-ref v1 0 0) 'error)
+ (test (vector? v1) #t)
+ (test (vector-ref v1 0 0) 'error)
+ (test (v1 0 0) 'error)
+ (test (equal? v0 v1) #f)
+ (test (float-vector? (float-vector-ref v2 1)) #t)
+ (test (float-vector-set! v2 1 32.0) 'error)
+ (test (float-vector-set! (float-vector-ref v2 1) 1 32.0) 32.0)
+ (test (float-vector-ref v2 1 1) 32.0)
+ (test (float-vector-ref v3 0) (float-vector 0 0 0))
+ (test (float-vector-ref v4 0) (float-vector 0))
+ )
+(let ()
+ (define (hi) (let ((v2 (make-float-vector '(2 3)))) (float-vector-set! v2 1 12.0) v2))
+ (test (hi) 'error))
+
+
+;;; int-vector-ref
+;;; int-vector-set!
+
+(test (int-vector-ref (int-vector 1 2) 1) 2)
+(for-each
+ (lambda (arg)
+ (test (int-vector-ref arg 0) 'error)
+ (test (int-vector-ref (int-vector 1) arg) 'error))
+ (list #\a () #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+(let ((v (make-int-vector (list 2 3) 1))
+ (v1 (make-int-vector 3)))
+ (set! (v 1 1) 2)
+ (test (v 1 1) 2)
+ (test (v 0 1) 1)
+ (test (int-vector-ref v 1 1) 2)
+ (test (int-vector-ref v 0) (int-vector 1 1 1))
+ (test (int-vector-set! v 0 0 3) 3)
+ (test (int-vector-ref v 0 0) 3)
+ (test (int-vector-ref v1 3) 'error)
+ (test (int-vector-ref v 1 3) 'error)
+ (test (int-vector-ref v 2 2) 'error)
+ (test (int-vector-ref v1 most-positive-fixnum) 'error)
+ (test (int-vector-ref v1 most-negative-fixnum) 'error)
+ (test (int-vector-set! v1 3 0) 'error)
+ (test (int-vector-set! v 1 3 0) 'error)
+ (test (int-vector-set! v 2 2 0) 'error)
+ (test (int-vector-set! v1 most-positive-fixnum 0) 'error)
+ (test (int-vector-set! v1 most-negative-fixnum 0) 'error)
+ (test (int-vector-set! v1 0 0+i) 'error)
+ (for-each
+ (lambda (arg)
+ (test (int-vector-ref v 0 arg) 'error)
+ (test (int-vector-set! arg 0 1) 'error)
+ (test (int-vector-set! v1 arg) 'error)
+ (test (int-vector-set! v1 0 arg) 'error)
+ (test (int-vector-set! v 0 arg 1) 'error))
+ (list #\a () #f "hi" 1+i 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand #t (vector 1 2 3) (lambda (a) (+ a 1))))
+ (test (int-vector-ref v) 'error)
+ (test (int-vector-set! v) 'error)
+ (test (int-vector-ref v1 0 1) 'error)
+ (test (int-vector-ref v 0 1 0) 'error)
+ (test (int-vector-ref v1 -1) 'error)
+ (int-vector-set! v1 0 2)
+ (test (int-vector-ref v1 0) 2)
+ (test (int-vector-set! v1 1 4) 4)
+ (test (int-vector-ref v1 1) 4)
+ (test (int-vector-ref v 3 0) 'error)
+ (test (int-vector-ref v 1 3) 'error)
+ (test (fill! v 0) 0))
+(test (int-vector-ref (int-vector) 0) 'error)
+(let ((v (int-vector 1 2 3)))
+ (set! (int-vector-ref v 1) 32)
+ (test v (int-vector 1 32 3))
+ (set! (v 0) 64)
+ (test v (int-vector 64 32 3))
+ (test (int-vector-set! v 2 (int-vector-set! v 1 0)) 0)
+ (test v (int-vector 64 0 0)))
+(let ((v0 (make-int-vector '(3 0)))
+ (v1 (make-int-vector '(0 3)))
+ (v2 (make-int-vector '(2 3)))
+ (v3 (make-int-vector '(1 3)))
+ (v4 (make-int-vector '(3 1))))
+ (test (int-vector? v0) #t)
+ (test (int-vector-ref v0 0 0) 'error)
+ (test (vector? v0) #t)
+ (test (vector-ref v0 0 0) 'error)
+ (test (v0 0 0) 'error)
+ (test (int-vector? v1) #t)
+ (test (int-vector-ref v1 0 0) 'error)
+ (test (vector? v1) #t)
+ (test (vector-ref v1 0 0) 'error)
+ (test (v1 0 0) 'error)
+ (test (equal? v0 v1) #f)
+ (test (int-vector? (int-vector-ref v2 1)) #t)
+ (test (int-vector-set! v2 1 32) 'error)
+ (test (int-vector-set! (int-vector-ref v2 1) 1 32) 32)
+ (test (int-vector-ref v2 1 1) 32)
+ (test (int-vector-ref v3 0) (int-vector 0 0 0))
+ (test (int-vector-ref v4 0) (int-vector 0))
+ )
+(let ()
+ (define (hi) (let ((v2 (make-int-vector '(2 3)))) (int-vector-set! v2 1 12) v2))
+ (test (hi) 'error))
+
+(let ()
+ (define (f1)
+ (let ((x (float-vector 0.0)))
+ (set! (x 0) (complex 1 2))))
+ (test (let ((x (float-vector 0.0))) (set! (x 0) 1+i)) 'error)
+ (test (f1) 'error)
+
+ (define (f2)
+ (let ((x (int-vector 0)))
+ (int-vector-set! x 0 (complex 1 2))))
+ (test (let ((x (int-vector 0))) (set! (x 0) 0+i)) 'error)
+ (test (f2) 'error)
+
+ (define (f3)
+ (let ((x (float-vector 0.0)))
+ (float-vector-set! x 0 (complex 1 2))))
+ (test (f3) 'error)
+
+ (define (f4)
+ (let ((x (int-vector 0)))
+ (set! (x 0) (complex 1 2))))
+ (test (f4) 'error))
+
+
+;;; --------------------------------------------------------------------------------
;;; vector
-(test (vector 1 2 3) '#(1 2 3))
-(test (vector 1 '(2) 3) '#(1 (2) 3))
-(test (vector) '#())
-(test (vector (vector (vector))) '#(#(#())))
-(test (vector (vector) (vector) (vector)) '#(#() #() #()))
-(test (vector (list)) '#(()))
-(test '#(1 #\a "hi" hi) (vector 1 #\a "hi" 'hi))
+
+(test (vector 1 2 3) #(1 2 3))
+(test (vector 1 '(2) 3) #(1 (2) 3))
+(test (vector) #())
+(test (vector (vector (vector))) #(#(#())))
+(test (vector (vector) (vector) (vector)) #(#() #() #()))
+(test (vector (list)) #(()))
+(test #(1 #\a "hi" hi) (vector 1 #\a "hi" 'hi))
(test (let ((v (make-vector 4 "hi")))
(vector-set! v 0 1)
(vector-set! v 1 #\a)
(vector-set! v 3 'hi)
v)
- '#(1 #\a "hi" hi))
+ #(1 #\a "hi" hi))
(let ((x 34))
- (test (vector x 'x) '#(34 x)))
+ (test (vector x 'x) #(34 x)))
(for-each
(lambda (arg)
(test (vector-ref (vector arg) 0) arg))
- (list #\a 1 '() (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; vector->list
;;; list->vector
-(test (vector->list '#(0)) (list 0))
-(test (vector->list (vector)) '())
-(test (vector->list '#(a b c)) '(a b c))
-(test (vector->list '#(#(0) #(1))) '(#(0) #(1)))
+
+(test (vector->list #(0)) (list 0))
+(test (vector->list (vector)) ())
+(test (vector->list #(a b c)) '(a b c))
+(test (vector->list #(#(0) #(1))) '(#(0) #(1)))
(test (vector? (list-ref (let ((v (vector 1 2))) (vector-set! v 1 v) (vector->list v)) 1)) #t)
-(test (list->vector '()) '#())
-(test (list->vector '(a b c)) '#(a b c))
-(test (list->vector (list (list 1 2) (list 3 4))) '#((1 2) (3 4)))
-(test (list->vector ''foo) '#(quote foo))
-(test (list->vector (list)) '#())
-(test (list->vector (list 1)) '#(1))
-(test (list->vector (list (list))) '#(()))
-(test (list->vector (list 1 #\a "hi" 'hi)) '#(1 #\a "hi" hi))
+(test (list->vector ()) #())
+(test (list->vector '(a b c)) #(a b c))
+(test (list->vector (list (list 1 2) (list 3 4))) #((1 2) (3 4)))
+(test (list->vector ''foo) #(quote foo))
+(test (list->vector (list)) #())
+(test (list->vector (list 1)) #(1))
+(test (list->vector (list (list))) #(()))
+(test (list->vector (list 1 #\a "hi" 'hi)) #(1 #\a "hi" hi))
(test (list->vector ''1) #(quote 1))
(test (list->vector '''1) #(quote '1))
(for-each
(lambda (arg)
- (if (list? arg)
+ (if (proper-list? arg)
(test (vector->list (list->vector arg)) arg)))
lists)
-(set! lists '())
+(set! lists ())
-(test (list->vector (vector->list (vector))) '#())
-(test (list->vector (vector->list (vector 1))) '#(1))
-(test (vector->list (list->vector (list))) '())
+(test (list->vector (vector->list (vector))) #())
+(test (list->vector (vector->list (vector 1))) #(1))
+(test (vector->list (list->vector (list))) ())
(test (vector->list (list->vector (list 1))) '(1))
(test (reinvert 12 vector->list list->vector #(1 2 3)) #(1 2 3))
@@ -5111,8 +9064,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (vector->list arg) 'error))
- (list #\a 1 '() (list 1) '(1 . 2) #f 'a-symbol "hi" abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol "hi" abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->vector x)) 'error)
(test (list->vector (cons 1 2)) 'error)
@@ -5123,23 +9076,63 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (list->vector arg) 'error))
- (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (vector->list #(1 2 3 4) 0) '(1 2 3 4))
+(test (vector->list #(1 2 3 4) 2) '(3 4))
+(test (vector->list #(1 2 3 4) 0 4) '(1 2 3 4))
+(test (vector->list #(1 2 3 4) 4 4) ())
+(test (vector->list #(1 2 3 4) 1 2) '(2))
+
+(test (vector->list #(1 2 3 4) -1 4) 'error)
+(test (vector->list #(1 2 3 4) 1 0) 'error)
+(test (vector->list #(1 2 3 4) 5) 'error)
+(test (vector->list #(1 2 3 4) 1 5) 'error)
+(test (vector->list #(1 2 3 4) 1 2 3) 'error)
+
+(test (vector->list #() 0 10) 'error)
+(test (vector->list #(1) 0 2) 'error)
+(test (vector->list #() 0 0) ())
+(test (vector->list #(1) 1) ())
+(test (vector->list #(1) 0) '(1))
+(test (vector->list #() #\null) 'error)
+(test (vector->list #() 0 #\null) 'error)
+(test (vector->list #() -1) 'error)
+(test (vector->list #(1) -1) 'error)
+(test (vector->list #(1) 0 -1) 'error)
+(test (vector->list #(1) -2 -1) 'error)
+(test (vector->list #(1) most-negative-fixnum) 'error)
+(test (vector->list #(1) 2) 'error)
+
+(test (vector->list (make-int-vector 3)) '(0 0 0))
+(test (vector->list (make-float-vector 3)) '(0.0 0.0 0.0))
+(for-each
+ (lambda (arg)
+ (test (vector->list #(0 1 2 3 4 5) arg) 'error)
+ (test (vector->list #(0 1 2 3 4 5) 1 arg) 'error))
+ (list #\a "hi" () (list 1) '(1 . 2) 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; vector-length
+
(test (vector-length (vector)) 0)
(test (vector-length (vector 1)) 1)
(test (vector-length (make-vector 128)) 128)
-(test (vector-length '#(a b c d e f)) 6)
-(test (vector-length '#()) 0)
+(test (vector-length #(a b c d e f)) 6)
+(test (vector-length #()) 0)
(test (vector-length (vector #\a (list 1 2) (vector 1 2))) 3)
-(test (vector-length '#(#(#(hi)) #(#(hi)) #(#(hi)))) 3)
+(test (vector-length #(#(#(hi)) #(#(hi)) #(#(hi)))) 3)
(test (vector-length (vector 1 2 3 4)) 4)
(test (vector-length (let ((v (vector 1 2))) (vector-set! v 1 v) v)) 2)
(test (vector-length (let ((v (vector 1 2))) (vector-set! v 1 v) (vector-ref v 1))) 2)
+(test (vector-length (make-vector 3 0 #t)) 3)
+(if (not with-bignums) (test (vector-length (make-vector 3 pi #t)) 3))
+(if (not with-bignums) (test (vector-length (make-vector '(2 3) pi #t)) 6))
(test (vector-length) 'error)
(test (vector-length #(1) #(2)) 'error)
@@ -5147,40 +9140,47 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (vector-length arg) 'error))
- (list "hi" #\a 1 '() '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; --------------------------------------------------------------------------------
;;; vector-ref
-(test (vector-ref '#(1 1 2 3 5 8 13 21) 5) 8)
-(test (vector-ref '#(1 1 2 3 5 8 13 21) (let ((i (round (* 2 (acos -1))))) (if (inexact? i) (inexact->exact i) i))) 13)
+
+(test (vector-ref #(1 1 2 3 5 8 13 21) 5) 8)
+(test (vector-ref #(1 1 2 3 5 8 13 21) (let ((i (round (* 2 (acos -1))))) (if (inexact? i) (inexact->exact i) i))) 13)
(test (let ((v (make-vector 1 0))) (vector-ref v 0)) 0)
(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref v 1)) (list 2))
-(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref v 2)) '#(#\a #\a #\a))
+(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref v 2)) #(#\a #\a #\a))
(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 2) 1)) #\a)
-(test (vector-ref '#(a b c) 1) 'b)
-(test (vector-ref '#(()) 0) '())
-(test (vector-ref '#(#()) 0) '#())
-(test (vector-ref (vector-ref (vector-ref '#(1 (2) #(3 (4) #(5))) 2) 2) 0) 5)
+(test (vector-ref #(a b c) 1) 'b)
+(test (vector-ref #(()) 0) ())
+(test (vector-ref #(#()) 0) #())
+(test (vector-ref (vector-ref (vector-ref #(1 (2) #(3 (4) #(5))) 2) 2) 0) 5)
(test (let ((v (vector 1 2))) (vector-set! v 1 v) (eq? (vector-ref v 1) v)) #t)
+(test (let ((v (make-int-vector 3))) (vector-ref v 1)) 0)
+(test (let ((v (make-vector 3 0 #f))) (vector-ref v 1)) 0)
+(test (let ((v (make-float-vector 3 1.0))) (vector-ref v 1)) 1.0)
+(test (let ((v (make-vector 6 0 #t))) (vector-set! v 3 32) (let ((v1 (make-shared-vector v '(2 3)))) (vector-ref v1 1 0))) 32)
(test (vector-ref) 'error)
(test (vector-ref #(1)) 'error)
(test (vector-ref #(1) 0 0) 'error)
-(test (vector-ref '() 0) 'error)
+(test (vector-ref () 0) 'error)
(test (let ((v (make-vector 1 0))) (vector-ref v 1)) 'error)
(test (let ((v (make-vector 1 0))) (vector-ref v -1)) 'error)
(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 2) 3)) 'error)
(test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 3) 0)) 'error)
(test (vector-ref (vector) 0) 'error)
-(test (vector-ref '#() 0) 'error)
-(test (vector-ref '#() -1) 'error)
-(test (vector-ref '#() 1) 'error)
+(test (vector-ref #() 0) 'error)
+(test (vector-ref #() -1) 'error)
+(test (vector-ref #() 1) 'error)
(test (vector-ref #(1 2 3) (floor .1)) 1)
(test (vector-ref #(1 2 3) (floor 0+0i)) 1)
+(test (vector-ref #10D((((((((((0 1)))))))))) 0 0 0 0 0 0 0 0 0 1) 1)
(test (#(1 2) 1) 2)
(test (#(1 2) 1 2) 'error)
@@ -5198,59 +9198,68 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (eval-string "#2/3d(1 2)") 'error)
(test (eval-string "#2.1d(1 2)") 'error)
+(test (eval-string "#(1 2 . 3)") 'error)
(test (#(#(#(#t))) 0 0 0) #t)
-
+(test (let ((v (make-vector 3 0 #t))) (v 0 0)) 'error)
+(test (let ((v (make-int-vector '(2 2)))) (v 0 0 0)) 'error)
+(test (let ((v (make-float-vector 3))) (vector-ref v 0 0)) 'error)
+(test (let ((v (make-vector '(2 2) 0.0 #t))) (vector-ref v 0 0 0)) 'error)
+(test (let ((v (make-vector 3 0))) (v 0 0)) 'error)
+(test (let ((v (make-vector '(2 2) 0))) (v 0 0 0)) 'error)
+(test (let ((v (make-vector 3 0 #t))) (vector-set! v 0 0 3)) 'error)
+(test (let ((v (make-vector '(2 2) 0 #t))) (set! (v 0 0 0) 3)) 'error)
(let ((v #(1 2 3)))
(for-each
(lambda (arg)
+ ; (format *stderr* "~A~%" arg)
(test (vector-ref arg 0) 'error)
(test (v arg) 'error)
(test (v arg 0) 'error)
(test (vector-ref v arg) 'error)
(test (vector-ref v arg 0) 'error)
(test (vector-ref #2d((1 2) (3 4)) 0 arg) 'error))
- (list "hi" '() #() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list "hi" () #() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)) (make-hash-table))))
-(test (vector-ref '#(#(1 2 3) #(4 5 6)) 1) '#(4 5 6))
-(test (vector-ref '#(#(1 2 3) #(4 5 6)) 1 2) 6)
-(test (vector-ref '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1) '#(#(7 8 9) #(10 11 12)))
-(test (vector-ref '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0) '#(7 8 9))
-(test (vector-ref '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2) 9)
-(test (vector-ref '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 3) 'error)
-(test (vector-ref '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2 0) 'error)
-
-(test ('#(#(1 2 3) #(4 5 6)) 1) '#(4 5 6))
-(test ('#(#(1 2 3) #(4 5 6)) 1 2) 6)
-(test ('#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1) '#(#(7 8 9) #(10 11 12)))
-(test ('#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0) '#(7 8 9))
-(test ('#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2) 9)
-(test ('#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 3) 'error)
-(test ('#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2 0) 'error)
-
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (L 1)) '#(4 5 6))
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (L 1 2)) 6)
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (L 1 2 3)) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1)) '#(#(7 8 9) #(10 11 12)))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0)) '#(7 8 9))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0 2)) 9)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0 2 3)) 'error)
-
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) ((L 1) 2)) 6)
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (((L 1) 2) 3)) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1) 0)) '#(7 8 9))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (((L 1) 0) 2)) 9)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1 0) 2)) 9)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1) 0 2)) 9)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((((L 1) 0) 2) 3)) 'error)
-
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (vector-ref (L 1) 2)) 6)
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (vector-ref ((L 1) 2) 3)) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (L 1) 0)) '#(7 8 9))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((vector-ref (L 1) 0) 2)) 9)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (((L 1) 0) 2) 3)) 'error)
+(test (vector-ref #(#(1 2 3) #(4 5 6)) 1) #(4 5 6))
+(test (vector-ref #(#(1 2 3) #(4 5 6)) 1 2) 6)
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1) #(#(7 8 9) #(10 11 12)))
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0) #(7 8 9))
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2) 9)
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 3) 'error)
+(test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2 0) 'error)
+
+(test (#(#(1 2 3) #(4 5 6)) 1) #(4 5 6))
+(test (#(#(1 2 3) #(4 5 6)) 1 2) 6)
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1) #(#(7 8 9) #(10 11 12)))
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0) #(7 8 9))
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2) 9)
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 3) 'error)
+(test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2 0) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1)) #(4 5 6))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1 2)) 6)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1 2 3)) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1)) #(#(7 8 9) #(10 11 12)))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0)) #(7 8 9))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0 2 3)) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) ((L 1) 2)) 6)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (((L 1) 2) 3)) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1) 0)) #(7 8 9))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (((L 1) 0) 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1 0) 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1) 0 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((((L 1) 0) 2) 3)) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref (L 1) 2)) 6)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref ((L 1) 2) 3)) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (L 1) 0)) #(7 8 9))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((vector-ref (L 1) 0) 2)) 9)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (((L 1) 0) 2) 3)) 'error)
(let ((zero 0)
@@ -5258,54 +9267,120 @@ zzy" (lambda (p) (eval (read p))))) 32)
(two 2)
(three 3)
(thirty-two 32))
- (test (vector-ref '#(#(1 2 3) #(4 5 6)) one) '#(4 5 6))
- (test (vector-ref '#(#(1 2 3) #(4 5 6)) one two) 6)
- (test (vector-ref '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one) '#(#(7 8 9) #(10 11 12)))
- (test (vector-ref '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero) '#(7 8 9))
- (test (vector-ref '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero two) 9)
-
- (test ('#(#(1 2 3) #(4 5 6)) one) '#(4 5 6))
- (test ('#(#(1 2 3) #(4 5 6)) one two) 6)
- (test ('#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one) '#(#(7 8 9) #(10 11 12)))
- (test ('#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero) '#(7 8 9))
- (test ('#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero two) 9)
-
- (test (let ((L '#(#(1 2 3) #(4 5 6)))) (L one)) '#(4 5 6))
- (test (let ((L '#(#(1 2 3) #(4 5 6)))) (L one two)) 6)
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one)) '#(#(7 8 9) #(10 11 12)))
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one zero)) '#(7 8 9))
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one zero two)) 9)
-
- (test (let ((L '#(#(1 2 3) #(4 5 6)))) ((L one) two)) 6)
- (test (let ((L '#(#(1 2 3) #(4 5 6)))) (((L one) two) 3)) 'error)
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one) zero)) '#(7 8 9))
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (((L one) zero) two)) 9)
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one zero) two)) 9)
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one) zero two)) 9)
-
- (test (let ((L '#(#(1 2 3) #(4 5 6)))) (vector-ref (L one) two)) 6)
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (L one) zero)) '#(7 8 9))
- (test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((vector-ref (L one) zero) two)) 9))
+ (test (vector-ref #(#(1 2 3) #(4 5 6)) one) #(4 5 6))
+ (test (vector-ref #(#(1 2 3) #(4 5 6)) one two) 6)
+ (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one) #(#(7 8 9) #(10 11 12)))
+ (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero) #(7 8 9))
+ (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero two) 9)
+
+ (test (#(#(1 2 3) #(4 5 6)) one) #(4 5 6))
+ (test (#(#(1 2 3) #(4 5 6)) one two) 6)
+ (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one) #(#(7 8 9) #(10 11 12)))
+ (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero) #(7 8 9))
+ (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero two) 9)
+
+ (test (let ((L #(#(1 2 3) #(4 5 6)))) (L one)) #(4 5 6))
+ (test (let ((L #(#(1 2 3) #(4 5 6)))) (L one two)) 6)
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one)) #(#(7 8 9) #(10 11 12)))
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one zero)) #(7 8 9))
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one zero two)) 9)
+
+ (test (let ((L #(#(1 2 3) #(4 5 6)))) ((L one) two)) 6)
+ (test (let ((L #(#(1 2 3) #(4 5 6)))) (((L one) two) 3)) 'error)
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one) zero)) #(7 8 9))
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (((L one) zero) two)) 9)
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one zero) two)) 9)
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one) zero two)) 9)
+
+ (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref (L one) two)) 6)
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (L one) zero)) #(7 8 9))
+ (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((vector-ref (L one) zero) two)) 9))
(test ((#(#(:hi) #\a (3)) (#("hi" 2) 1)) (#2d((#() ()) (0 #(0))) 1 ('(cons 0) 1))) 3)
(test (#(1 2 3) (#(1 2 3) 1)) 3)
(test ((#(#(1 2)) (#(1 0) 1)) (#(3 2 1 0) 2)) 2)
(test (apply min (#(1 #\a (3)) (#(1 2) 1))) 3) ; i.e vector ref here 2 levels -- (#(1 2) 1) is 2 and (#(1 #\a (3)) 2) is (3)
+;;; vector-ref optimizer checks
+(define global_vector (vector 1 2 3))
+(let ()
+ (define (hi i) (vector-ref global_vector i))
+ (test (hi 1) 2))
+(let ()
+ (define (hi i) (vector-ref global_vector (vector-ref global_vector i)))
+ (test (hi 0) 2))
+
+(test (let ((v #(0 1 2 3 4 5))) (define (f1) (v 4/3)) (f1)) 'error)
+(test (let ((v "012345")) (define (f1) (v 4/3)) (f1)) 'error)
+(test (let ((v (list 0 1 2 3 4 5))) (define (f1) (v 4/3)) (f1)) 'error)
+
+(define-constant -a-global-vector- (vector 1 2 3))
+(let ()
+ (define (fg a) (vector-ref -a-global-vector- a))
+ (test (fg 0) 1))
+
+(let ()
+ (define (f1)
+ (let ((v (vector #f)) (X #2D((1 2) (3 4))))
+ (do ((i 0 (+ i 1))) ((= i 1) v)
+ (vector-set! v 0 (vector-ref X 1)))))
+ (test (f1) #(#(3 4))))
+
+(let ()
+ (define (f1)
+ (let ((v (vector #f)) (X #2D((1 2) (3 4))))
+ (do ((i 0 (+ i 1))) ((= i 1) v)
+ (vector-set! v 0 (vector-ref X 2)))))
+ (test (f1) 'error))
+
+(let ()
+ (define (f1)
+ (let ((I 0) (v (vector #f)) (X #2D((1 2) (3 4))))
+ (do ((i 0 (+ i 1))) ((= i 1) v)
+ (vector-set! v 0 (vector-ref X (+ I 1))))))
+ (test (f1) #(#(3 4))))
+
+(let ()
+ (define (f1)
+ (let ((I 1) (v (vector #f)) (X #2D((1 2) (3 4))))
+ (do ((i 0 (+ i 1))) ((= i 1) v)
+ (vector-set! v 0 (vector-ref X (+ I 1))))))
+ (test (f1) 'error))
+
+(set! global_vector #2D((1 2) (3 4)))
+(let ()
+ (define (f1)
+ (let ((I 1) (v (vector #f)))
+ (do ((i 0 (+ i 1))) ((= i 1) v)
+ (vector-set! v 0 (vector-ref global_vector I)))))
+ (test (f1) #(#(3 4))))
+
+(let ()
+ (define (f1)
+ (let ((I 2) (v (vector #f)))
+ (do ((i 0 (+ i 1))) ((= i 1) v)
+ (vector-set! v 0 (vector-ref global_vector I)))))
+ (test (f1) 'error))
+
+
+;;; --------------------------------------------------------------------------------
;;; vector-set!
-(test (let ((vec (vector 0 '(2 2 2 2) "Anna"))) (vector-set! vec 1 '("Sue" "Sue")) vec) '#(0 ("Sue" "Sue") "Anna"))
-(test (let ((v (vector 1 2 3))) (vector-set! v 1 32) v) '#(1 32 3))
+
+(test (let ((vec (vector 0 '(2 2 2 2) "Anna"))) (vector-set! vec 1 '("Sue" "Sue")) vec) #(0 ("Sue" "Sue") "Anna"))
+(test (let ((v (vector 1 2 3))) (vector-set! v 1 32) v) #(1 32 3))
(let ((v (make-vector 8 #f)))
(for-each
(lambda (arg)
(vector-set! v 1 arg)
(test (vector-ref v 1) arg))
- (list #\a 1 '() (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))))
-(test (let ((v (vector 1 2 3))) (vector-set! v 1 0) v) '#(1 0 3))
-(test (let ((v (vector #f))) (vector-set! v 0 (vector)) v) '#(#()))
-(test (let ((v (vector 1 (list 2) (vector 1 2 3)))) (vector-set! (vector-ref v 2) 0 21) v) '#(1 (2) #(21 2 3)))
+(test (let ((v (vector 1 2 3))) (vector-set! v 1 0) v) #(1 0 3))
+(test (let ((v (vector #f))) (vector-set! v 0 (vector)) v) #(#()))
+(test (let ((v (vector 1 (list 2) (vector 1 2 3)))) (vector-set! (vector-ref v 2) 0 21) v) #(1 (2) #(21 2 3)))
+(test (let ((v (make-int-vector 3))) (vector-set! v 1 32) (vector->list v)) '(0 32 0))
+(test (let ((v (make-vector 3 0 #t))) (set! (v 1) 32) (vector->list v)) '(0 32 0))
(test (vector-set! (vector 1 2) 0 4) 4)
(test (vector-set!) 'error)
@@ -5314,27 +9389,42 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (vector-set! #(1) 0 0 1) 'error)
(test (vector-set! #(1) 0 0 1 2 3) 'error)
(test (vector-set! #(1) #(0) 1) 'error)
-(test (vector-set! '#(1 2) 0 2) 2)
+(test (vector-set! #(1 2) 0 2) 2)
(test (let ((x 2) (v (vector 1 2))) (vector-set! (let () (set! x 3) v) 1 23) (list x v)) '(3 #(1 23)))
+(test (let ((v #(1 2))) (vector-set! v 0 32)) 32)
+(test (let ((v #(1 2))) (set! (v 0) 32)) 32)
+(test (let ((v #(1 2))) (set! (vector-ref v 0) 32)) 32)
(for-each
(lambda (arg)
(test (vector-set! arg 0 0) 'error))
- (list "hi" '() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list "hi" () #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)) (make-hash-table)))
(let ((v (vector 1 2 3)))
(for-each
(lambda (arg)
(test (vector-set! v arg 0) 'error))
- (list "hi" '() #() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list "hi" () #() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #t (make-vector 3) (lambda (a) (+ a 1)))))
(for-each
(lambda (arg)
(test (vector-set! arg 0 0) 'error))
- (list "hi" '() #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" () #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((v #(#(0 1) #(2 3))))
+ (vector-set! (vector-ref v 1) 1 4)
+ (test (v 1 1) 4)
+ (set! ((vector-ref v 1) 1) 5)
+ (test (v 1 1) 5)
+ (set! ((v 1) 1) 6)
+ (test (v 1 1) 6)
+ (vector-set! (v 1) 1 7)
+ (test (v 1 1) 7)
+ (set! (v 1 1) 8)
+ (test (v 1 1) 8))
(let ((v (vector)))
(test (vector-set! v 0 0) 'error)
@@ -5346,84 +9436,98 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((v #(1 2 3))) (set! (v '(+ 1 1)) 2) v) 'error)
(test (let ((v #(1 2 3))) (set! (v (+ 1 1)) 2) v) #(1 2 2))
-(test (let ((g (lambda () '#(1 2 3)))) (vector-set! (g) 0 #\?) (g)) #(#\? 2 3))
+(test (let ((g (lambda () #(1 2 3)))) (vector-set! (g) 0 #\?) (g)) #(#\? 2 3))
(test (let ((g (lambda () '(1 . 2)))) (set-car! (g) 123) (g)) '(123 . 2))
(test (let ((g (lambda () '(1 2)))) (list-set! (g) 0 123) (g)) '(123 2))
(test (let ((g (lambda () (symbol->string 'hi)))) (string-set! (g) 1 #\a) (symbol->string 'hi)) "hi")
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (vector-set! L 1 32) L) '#(#(1 2 3) 32))
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (vector-set! L 1 0 32) L) '#(#(1 2 3) #(32 5 6)))
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (vector-set! L 1 0 2 32) L) 'error)
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (vector-set! L 1 3 32) L) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 32) L) '#(#(#(1 2 3) #(4 5 6)) 32))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 32) L) '#(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 2 32) L) '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 2 1 32) L) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 4 2 32) L) 'error)
-
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (set! (L 1) 32) L) '#(#(1 2 3) 32))
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (set! (L 1 0) 32) L) '#(#(1 2 3) #(32 5 6)))
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (set! (L 1 0 2) 32) L) 'error)
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (set! (L 1 3) 32) L) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1) 32) L) '#(#(#(1 2 3) #(4 5 6)) 32))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0) 32) L) '#(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0 2) 32) L) '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0 2 1) 32) L) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 4 2) 32) L) 'error)
-
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (set! ((L 1) 0) 32) L) '#(#(1 2 3) #(32 5 6)))
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (set! (((L 1) 0) 2) 32) L) 'error)
-(test (let ((L '#(#(1 2 3) #(4 5 6)))) (set! ((L 1) 3) 32) L) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((L 1) 0) 32) L) '#(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (((L 1) 0) 2) 32) L) '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((((L 1) 0) 2) 1) 32) L) 'error)
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (((L 1) 4) 2) 32) L) 'error)
-(test (let ((L '#(#(#(1 2 3))))) (set! ((L 0) 0 1) 32) L) '#(#(#(1 32 3))))
-(test (let ((L '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((L 1 0) 2) 32) L) '#(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
-
-(test (let ((L '#(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 32) L) #(#(1 2 3) 32))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 0 32) L) #(#(1 2 3) #(32 5 6)))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 0 2 32) L) 'error)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 3 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 32) L) #(#(#(1 2 3) #(4 5 6)) 32))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 2 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 2 1 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 4 2 32) L) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1) 32) L) #(#(1 2 3) 32))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 0) 32) L) #(#(1 2 3) #(32 5 6)))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 0 2) 32) L) 'error)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 3) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1) 32) L) #(#(#(1 2 3) #(4 5 6)) 32))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0) 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0 2 1) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 4 2) 32) L) 'error)
+
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1) 0) 32) L) #(#(1 2 3) #(32 5 6)))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (((L 1) 0) 2) 32) L) 'error)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1) 3) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((L 1) 0) 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (((L 1) 0) 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((((L 1) 0) 2) 1) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (((L 1) 4) 2) 32) L) 'error)
+(test (let ((L #(#(#(1 2 3))))) (set! ((L 0) 0 1) 32) L) #(#(#(1 32 3))))
+(test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((L 1 0) 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12))))
+
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
(set! (L 0 0 1) 32)
L)
- '#(#(#(#(1 2 3) 32) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
-(test (let ((L '#(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+ #(#(#(#(1 2 3) 32) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
(set! ((L 0) 0 1 2) 32)
L)
- '#(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
-(test (let ((L '#(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+ #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
(set! ((L 0 0) 1 2) 32)
L)
- '#(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
-(test (let ((L '#(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+ #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
(set! ((L 0 0 1) 2) 32)
L)
- '#(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
-(test (let ((L '#(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+ #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
(set! (((L 0) 0) 1 2) 32)
L)
- '#(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
-(test (let ((L '#(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+ #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
(set! (((L 0 0) 1) 2) 32)
L)
- '#(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
-(test (let ((L '#(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
+ #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15))))
(set! ((((L 0) 0) 1) 2) 32)
L)
- '#(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+ #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))
+(test (eq? (car (catch #t (lambda () (set! (#(1)) 2)) (lambda args args))) 'wrong-number-of-args) #t)
+(test (eq? (car (catch #t (lambda () (set! (#(1) 0 0) 2)) (lambda args args))) 'syntax-error) #t)
+(test (eq? (car (catch #t (lambda () (set! ((#(1) 0) 0) 2)) (lambda args args))) 'syntax-error) #t) ; (set! (1 ...))
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L) 1) 32) L) (lambda args args))) 'wrong-number-of-args)) #t)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L)) 32) L) (lambda args args))) 'wrong-number-of-args)) #t)
+(test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L 1) 2)) L) (lambda args args))) 'syntax-error)) #t)
+(let ((v #(1 2 3))) (define (vr v a) (vector-ref v (+ a 1))) (test (vr v 1) 3))
+(let () (define (fillv) (let ((v (make-vector 10))) (do ((i 0 (+ i 1))) ((= i 10) v) (vector-set! v i i)))) (test (fillv) #(0 1 2 3 4 5 6 7 8 9)))
+(let () (define (vv) (let ((v #(0 1)) (i 0) (x 2)) (vector-set! v i (+ (vector-ref v i) x)))) (test (vv) 2))
+(let () (define (hi) (let ((v1 #(0 1)) (i 0) (j 1)) (vector-set! v1 i (vector-ref v1 j)))) (hi) 1)
+
+
+;;; --------------------------------------------------------------------------------
;;; vector-fill!
+
(test (fill! (vector 1 2) 4) 4)
-(test (let ((v (vector 1 2 3))) (vector-fill! v 0) v) '#(0 0 0))
-(test (let ((v (vector))) (vector-fill! v #f) v) '#())
+(test (let ((v (vector 1 2 3))) (vector-fill! v 0) v) #(0 0 0))
+(test (let ((v (vector))) (vector-fill! v #f) v) #())
(let ((v (make-vector 8 #f)))
(for-each
(lambda (arg)
(vector-fill! v arg)
(test (vector-ref v 1) arg))
- (list #\a 1 '() (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
+ (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))))
(test (let ((str "hi") (v (make-vector 3))) (vector-fill! v str) (string-set! (vector-ref v 0) 1 #\a) str) "ha")
@@ -5431,7 +9535,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((v (vector 1 2 3))) (vector-set! v -1 0)) 'error)
(test (let ((v (vector 1 2 3))) (vector-set! v 3 0)) 'error)
-(test (vector-fill! '#(1 2) 2) 2)
+(test (vector-fill! #(1 2) 2) 2)
(test (vector-fill! #() 0) 0)
(test (vector-fill! (vector) 0) 0)
(test (let ((v (vector 1))) (vector-fill! v 32) (v 0)) 32)
@@ -5439,12 +9543,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((v (make-vector 16 0))) (vector-fill! v 32) (v 15)) 32)
(test (let ((v (make-vector 3 0))) (vector-fill! v 32) (v 1)) 32)
(test (let ((v (make-vector 3 0))) (fill! v 32) (v 1)) 32)
+(test (let ((v #2d((1 2 3) (4 5 6)))) (vector-fill! (v 1) 12) v) #2D((1 2 3) (12 12 12)))
(for-each
(lambda (arg)
(test (vector-fill! arg 0) 'error))
- (list "hi" #\a '() 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a () 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
(if with-bignums
(let ((v (make-vector 2 0.0)))
@@ -5454,15 +9559,185 @@ zzy" (lambda (p) (eval (read p))))) 32)
(num-test (v 0) 3/1180591620717411303424)
(vector-fill! v 1180591620717411303424.0)
(num-test (v 1) 1180591620717411303424.0)
- (vector-fill! v (make-rectangular (expt 2 70) 1.0))
- (num-test (v 0) (make-rectangular (expt 2 70) 1.0))))
+ (vector-fill! v (complex (expt 2 70) 1.0))
+ (num-test (v 0) (complex (expt 2 70) 1.0))
+ (set! v (float-vector 1.0))
+ (vector-fill! v (bignum "2.0"))
+ (num-test (v 0) 2.0)
+ (vector-fill! v pi)
+ (num-test (v 0) pi)
+ (set! v (float-vector 0.0 0.0 0.0))
+ (vector-fill! v (bignum "2.0") 1 2)
+ (num-test (v 0) 0.0)
+ (num-test (v 1) 2.0)
+ (set! v (make-int-vector 1))
+ (vector-fill! v (bignum "2"))
+ (num-test (v 0) 2)
+ (set! v (make-vector 3 0 #t))
+ (vector-fill! v (bignum "2") 1 2)
+ (num-test (v 0) 0)
+ (num-test (v 1) 2)))
(let ((v (make-vector 3)))
(vector-fill! v v)
(test (v 0) v)
(set! (v 1) 32)
(test ((v 0) 1) 32))
+
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0) v) #(21 21 21 21 21))
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0 5) v) #(21 21 21 21 21))
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0 3) v) #(21 21 21 4 5))
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 2 3) v) #(1 2 21 4 5))
+(test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 3 3) v) #(1 2 3 4 5))
+
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v 2) (vector->list v)) '(2 2 2))
+(if (not with-bignums) (test (let ((v (make-vector 3 pi #t))) (vector-fill! v 0.0) (vector->list v)) '(0.0 0.0 0.0)))
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v "2.5")) 'error)
+(test (let ((v (make-vector 3 pi #t))) (vector-fill! v #\a)) 'error)
+(test (let ((v (make-float-vector 3))) (vector-fill! v 1+i) v) 'error)
+(test (let ((v (make-vector 3 0.0 #t))) (vector-fill! v 3/4) (vector->list v)) '(0.75 0.75 0.75))
+(test (let ((v (make-vector 3 0.0 #t))) (vector-fill! v 3) (vector->list v)) '(3.0 3.0 3.0))
+(test (let ((v (make-int-vector 3))) (vector-fill! v 1+i) v) 'error)
+(test (let ((v (make-vector 3 0 #t))) (vector-fill! v 3/4) v) 'error)
+(test (let ((v (make-vector 3 0 #t))) (vector-fill! v 3.0) v) 'error)
+
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v 2 1) (vector->list v)) '(1 2 2))
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v 2 1 1) (vector->list v)) '(1 1 1))
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v 2 1 2) (vector->list v)) '(1 2 1))
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v 2 1 3) (vector->list v)) '(1 2 2))
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v 2 0 3) (vector->list v)) '(2 2 2))
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v 2 1 4) (vector->list v)) 'error)
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v 2 -1) (vector->list v)) 'error)
+(test (let ((v (make-vector 3 0.0 #t))) (vector-fill! v 1.0 1) (vector->list v)) '(0.0 1.0 1.0))
+(test (let ((v (make-vector 3 1 #t))) (vector-fill! v "2.5" 1)) 'error)
+(test (let ((v (make-vector 3 pi #t))) (vector-fill! v #\a 0 1)) 'error)
+(test (let ((v (make-vector 3 0.0 #t))) (vector-fill! v 1+i 1) v) 'error)
+(test (let ((v (make-vector 3 0.0 #t))) (vector-fill! v 3/4 1) (vector->list v)) '(0.0 0.75 0.75))
+(test (let ((v (make-float-vector 3))) (vector-fill! v 3 2) (vector->list v)) '(0.0 0.0 3.0))
+(test (let ((v (make-vector 3 0 #t))) (vector-fill! v 1+i 2) v) 'error)
+(test (let ((v (make-vector 3 0 #t))) (vector-fill! v 3/4 0 1) v) 'error)
+(test (let ((v (make-int-vector 3))) (vector-fill! v 3.0 2) v) 'error)
+(test (vector-fill! #() 0 "hi") 'error)
+(test (vector-fill! #() 0 -1 3) 'error)
+(test (vector-fill! #() 0 1) 'error)
+(test (vector-fill! #() 0 0 4/3) 'error)
+
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; vector-append
+
+(test (vector-append #() #2d()) #())
+(test (vector-append) #())
+(test (vector-append #()) #())
+(test (vector-append #(1 2)) #(1 2))
+(test (vector-append #(1) #(2 3) #() #(4)) #(1 2 3 4))
+(test (vector-append #(1) #2d((2 3) (4 5)) #3d()) #(1 2 3 4 5))
+(test (vector-append #2d((1 2) (3 4)) #3d(((5 6) (7 8)) ((9 10) (11 12)))) #(1 2 3 4 5 6 7 8 9 10 11 12))
+
+(test (vector-append (vector 1 2) (make-vector 1 3 #t) #(4)) #(1 2 3 4))
+(test (vector-append (vector 1 2) (make-float-vector 1) #(4)) #(1 2 0.0 4))
+(test (vector->list (vector-append (make-vector 1 3 #t) (make-vector 2 1 #t))) '(3 1 1))
+(test (vector->list (vector-append (make-vector 1 0.0 #t) (make-vector 2 1.0 #t))) '(0.0 1.0 1.0))
+
+(for-each
+ (lambda (arg)
+ (test (vector-append arg) 'error)
+ (test (vector-append #(1 2) arg) 'error))
+ (list "hi" #\a () 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (equal? (make-vector 3 1) (make-vector 3 1 #t)) #f)
+
+(let ((iv (make-vector 3 1 #t))
+ (fv (make-vector 3 2.0 #t))
+ (vv (make-vector 3 #f)))
+ (test (equal? (vector-append iv iv iv) (make-vector 9 1 #t)) #t)
+ (test (vector-append iv iv vv) 'error)
+ (test (vector-append iv fv iv) (int-vector 1 1 1 2 2 2 1 1 1))
+ (test (vector-append iv fv fv) (int-vector 1 1 1 2 2 2 2 2 2))
+ (test (vector-append iv fv vv) 'error)
+ (test (vector-append iv vv iv) 'error)
+ (test (vector-append fv iv iv) (float-vector 2.0 2.0 2.0 1 1 1 1 1 1)) ; #(2.0 2.0 2.0 1 1 1 1 1 1))
+ (test (vector-append fv iv fv) (float-vector 2.0 2.0 2.0 1 1 1 2.0 2.0 2.0)) ; #(2.0 2.0 2.0 1 1 1 2.0 2.0 2.0))
+ (test (vector-append fv fv iv) (float-vector 2.0 2.0 2.0 2.0 2.0 2.0 1 1 1)) ; #(2.0 2.0 2.0 2.0 2.0 2.0 1 1 1))
+ (test (vector-append fv fv fv) (make-vector 9 2.0 #t))
+ (test (vector-append fv fv vv) 'error)
+ (test (vector-append vv iv iv) #(#f #f #f 1 1 1 1 1 1))
+ (test (vector-append vv iv fv) #(#f #f #f 1 1 1 2.0 2.0 2.0))
+ (test (vector-append vv iv vv) #(#f #f #f 1 1 1 #f #f #f))
+ (test (vector-append vv fv iv) #(#f #f #f 2.0 2.0 2.0 1 1 1))
+ (test (vector-append vv fv fv) #(#f #f #f 2.0 2.0 2.0 2.0 2.0 2.0))
+ (test (vector-append vv fv vv) #(#f #f #f 2.0 2.0 2.0 #f #f #f))
+ (test (vector-append vv vv iv) #(#f #f #f #f #f #f 1 1 1))
+ (test (vector-append vv vv fv) #(#f #f #f #f #f #f 2.0 2.0 2.0))
+ (test (vector-append vv vv vv) #(#f #f #f #f #f #f #f #f #f)))
+
+(test (equal? (vector-append (float-vector 1 2 3) #()) (float-vector 1 2 3)) #t)
+(test (equal? (vector-append (float-vector) #(1 2 3) #() (make-vector 0 0 #t)) (float-vector 1 2 3)) #t)
+(test (equal? (float-vector) (vector-append (float-vector))) #t)
+(test (equal? (vector-append #() (float-vector) (make-vector 3 1 #t) (vector)) (make-vector 3 1)) #t)
+(test (equal? (vector-append (int-vector 1 2 3) #()) (int-vector 1 2 3)) #t)
+(test (equal? (vector-append (int-vector) #(1 2 3) #() (make-vector 0 0 #t)) (int-vector 1 2 3)) #t)
+(test (equal? (int-vector) (vector-append (int-vector))) #t)
+(test (equal? (vector-append #() (int-vector) (make-vector 3 1 #t) (vector)) (make-vector 3 1)) #t)
+
+(when full-test
+ (define (test-append size)
+ (let ((strs ())
+ (vecs ())
+ (fvecs ())
+ (ivecs ())
+ (ifvecs ())
+ (allvecs ())
+ (bvecs ())
+ (lsts ()))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! strs (cons (make-string size (integer->char (+ 1 (random 255)))) strs))
+ (set! bvecs (cons (->byte-vector (make-string size (integer->char (random 256)))) bvecs))
+ (set! vecs (cons (make-vector size i) vecs))
+ (set! ivecs (cons (make-int-vector size i) ivecs))
+ (set! fvecs (cons (make-float-vector size (* i 1.0)) fvecs))
+ (set! ifvecs (cons (make-vector size (if (even? i) (* i 1.0) i) #t) ifvecs))
+ (set! allvecs (cons (make-vector size (if (even? i) (* i 1.0) i) (not (zero? (modulo i 3)))) allvecs))
+ (set! lsts (cons (make-list size i) lsts)))
+ (let ((lst (apply append lsts))
+ (vec (apply vector-append vecs))
+ (fvec (apply vector-append fvecs))
+ (ivec (apply vector-append ivecs))
+ (ifvec (apply vector-append ifvecs))
+ (allvec (apply vector-append allvecs))
+ (str (apply string-append strs))
+ (bvec (->byte-vector (apply string-append bvecs))))
+ (test (vector? vec) #t)
+ (test (length vec) (* size size))
+ (test (float-vector? fvec) #t)
+ (test (length fvec) (* size size))
+ (test (int-vector? ivec) #t)
+ (test (length ivec) (* size size))
+ (test (vector? allvec) #t)
+ (test (length allvec) (* size size))
+ (test (vector? ifvec) #t)
+ (test (length ifvec) (* size size))
+ (test (pair? lst) #t)
+ (test (length lst) (* size size))
+ (test (string? str) #t)
+ (test (length str) (* size size))
+ (test (byte-vector? bvec) #t)
+ (test (length bvec) (* size size))
+ )))
+ (do ((i 1 (* i 10)))
+ ((> i 1000))
+ (test-append i)))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; miscellaneous vectors
(test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6)
(test (let ((sum 0)) (for-each (lambda (n m) (set! sum (+ sum n (- m)))) (vector 1 2 3) (vector 4 5 6)) sum) -9)
@@ -5499,7 +9774,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(begin
(set! (v (inexact->exact y)) 100)
(set! y x)
- (exit x))
+ (exit x))
(set! y x)))
v)))))
@@ -5508,12 +9783,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((correct (vector 0 100 2 100 4 100 6 100 8 9)))
(do ((i 0 (+ i 1)))
- ((= i 10))
+ ((= i (length v)))
(if (not (= (correct i) (inexact->exact (v i))))
- (format #t ";for-each call/cc data: ~A~%" v))))))
+ (format-logged #t ";for-each call/cc data: ~A~%" v))))))
(list (make-vector 10)
-; (make-vct 10)
(make-list 10)))
@@ -5524,21 +9798,12 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (call/cc (lambda (return) (map (lambda (n) (return "oops")) (vector 1 2 3)))) "oops")
(test (call/cc (lambda (return) (map (lambda (n) (if (even? n) (return n))) (vector 1 3 8 7 9 10)))) 8)
+(test (map (lambda (x) x) (make-vector 3 0 #t)) '(0 0 0))
+(test (map (lambda (x) x) (let ((v (make-vector 3 0 #t))) (set! (v 1) 1) (set! (v 2) 2) v)) '(0 1 2))
+(test (map (lambda (x) x) (make-vector 3 0.0 #t)) '(0.0 0.0 0.0))
+(test (let ((lst ())) (for-each (lambda (n) (set! lst (cons n lst))) (let ((v (make-vector 3 0 #t))) (set! (v 1) 1) v)) lst) '(0 1 0))
(test (vector? (symbol-table)) #t)
-(test (symbol? (((symbol-table) 0) 0)) #t)
-(let ((old-table (symbol-table))
- (old-list ((symbol-table) 0)))
- ;; try to clobber it...
- (vector-fill! (symbol-table) #())
- (set! ((symbol-table) 0) 1)
- (test (list? ((symbol-table) 0)) #t)
- (test (symbol? (((symbol-table) 0) 0)) #t)
- (test (sort! (symbol-table) <) 'error)
- (test (equal? old-list ((symbol-table) 0)) #t)
- (test (vector? (sort! (symbol-table) (lambda (a b) (< (length a) (length b))))) #t)
- (test (equal? old-list ((symbol-table) 0)) #t))
-
(let ((v (make-vector 3 (vector 1 2))))
(test (equal? (v 0) (v 1)) #t)
@@ -5557,7 +9822,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test ((((v 0) 0) 0) 1) 2))
(test (make-vector 1 (make-vector 1 (make-vector 1 0))) #(#(#(0))))
-
+(test (vector->list (let ((v (make-vector 3 0 #t))) (set! (v 0) 32) (set! (v 1) -1) (set! (v 2) 2) (sort! v <))) '(-1 2 32))
(let ((v1 (make-vector 3 1)))
(num-test (v1 1) 1)
@@ -5607,15 +9872,20 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (vector-dimensions (vector-ref #3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) 0 1)) '(3))
(test (set! (vector-dimensions #(1 2)) 1) 'error)
(test (let ((v #(1 2 3))) (set! (car (vector-dimensions v)) 0) v) #(1 2 3))
+(test (vector-dimensions (make-vector '(2 3) 0 #t)) '(2 3))
-(let ((old-len *vector-print-length*))
+(let ((old-len (*s7* 'print-length)))
(let ((vect1 #3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))))
(vect2 #2d((1 2 3 4 5 6) (7 8 9 10 11 12)))
(vect3 #(1 2 3 4 5 6 7 8 9 10 11 12 13 14))
- (vect4 #3D(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))))
+ (vect4 #3D(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))))
+ (vect1t (make-vector '(2 2 3) 0 #t)))
+ (let ((v (make-shared-vector vect1t '(12))))
+ (set! (v 0) 1) (set! (v 1) 2) (set! (v 2) 3) (set! (v 3) 3) (set! (v 4) 4) (set! (v 5) 5)
+ (set! (v 6) 5) (set! (v 7) 6) (set! (v 8) 1) (set! (v 9) 7) (set! (v 10) 8) (set! (v 11) 2))
(do ((i 1 (+ i 1)))
((= i 15))
- (set! *vector-print-length* i)
+ (set! (*s7* 'print-length) i)
(let ((str (object->string vect1)))
(test str (case i
((1) "#3D(((1 ...)...)...)")
@@ -5633,6 +9903,24 @@ zzy" (lambda (p) (eval (read p))))) 32)
((13) "#3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")
((14) "#3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))"))))
+ (let ((str (object->string vect1t)))
+ (test str (case i
+ ((1) "(make-shared-vector (int-vector 1 ...) '(2 2 3))")
+ ((2) "(make-shared-vector (int-vector 1 2 ...) '(2 2 3))")
+ ((3) "(make-shared-vector (int-vector 1 2 3 ...) '(2 2 3))")
+ ((4) "(make-shared-vector (int-vector 1 2 3 3 ...) '(2 2 3))")
+ ((5) "(make-shared-vector (int-vector 1 2 3 3 4 ...) '(2 2 3))")
+ ((6) "(make-shared-vector (int-vector 1 2 3 3 4 5 ...) '(2 2 3))")
+ ((7) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 ...) '(2 2 3))")
+ ((8) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 ...) '(2 2 3))")
+ ((9) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 ...) '(2 2 3))")
+ ((10) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 ...) '(2 2 3))")
+ ((11) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 8 ...) '(2 2 3))")
+ ((12) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 8 2) '(2 2 3))")
+ ((13) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 8 2) '(2 2 3))")
+ ((14) "(make-shared-vector (int-vector 1 2 3 3 4 5 5 6 1 7 8 2) '(2 2 3))"))))
+
+
(let ((str (object->string vect4)))
(test str (case i
((1) "#3D(((1 ...)...)...)")
@@ -5694,7 +9982,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(do ((i 1 (+ i 1)))
((= i 15))
- (set! *vector-print-length* i)
+ (set! (*s7* 'print-length) i)
(let ((str (object->string vect5)))
(test str (case i
@@ -5713,8 +10001,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
((13) "#2D((#3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2D((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 13 ...)) (#3D(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2D()))")
((14) "#2D((#3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2D((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 13 14)) (#3D(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2D()))")))))))
- (set! *vector-print-length* old-len))
+ (set! (*s7* 'print-length) old-len))
+(test (object->string (make-vector 3 0 #t)) "(int-vector 0 0 0)")
+
(let ((v (make-vector '(2 2))))
(set! (v 0 0) 1)
(set! (v 0 1) 2)
@@ -5735,9 +10025,17 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (v i j) (list i j))))
(test (v 0 0) '(0 0))
(test ((v 1 2) 0) 1)
- (test (v 1 2 0) 'error)
+ (test (v 1 2 0) 1)
+ (test (v 1 2 0 0) 'error)
(test (object->string v) "#2D(((0 0) (0 1) (0 2)) ((1 0) (1 1) (1 2)))"))
+(test (object->string (make-vector 3 1.0 #t)) "(float-vector 1.0 1.0 1.0)")
+(test (object->string (make-vector 3 -1.5 #t)) "(float-vector -1.5 -1.5 -1.5)")
+(test (object->string (make-vector 3 1 #t)) "(int-vector 1 1 1)")
+(test (object->string (make-vector 3 -1 #t)) "(int-vector -1 -1 -1)")
+(test (object->string (make-vector 0 0 #t)) "#()")
+(test (object->string (make-vector '(3 2 0) 0.0 #t)) "#()")
+
(test (let ((v1 (make-vector '(3 2) 1))
(v2 (make-vector '(3 2) 2))
(sum 0))
@@ -5747,7 +10045,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (vector->list (make-vector '(2 3) 1)) '(1 1 1 1 1 1))
(test (vector->list #2d((1 2) (3 4))) '(1 2 3 4))
(test (list->vector '((1 2) (3 4))) #((1 2) (3 4)))
-(test (vector->list (make-vector (list 2 0))) '())
+(test (vector->list (make-vector (list 2 0))) ())
(test (vector-dimensions #2d((1 2 3))) '(1 3))
(test (#2d((1 2 3) (4 5 6)) 0 0) 1)
@@ -5765,7 +10063,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (apply v (make-list 100 0)) 0)
(test (v 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) 0))
-;;; eval-string here else these are read errors
+;; eval-string here else these are read errors
(test (eval-string "#3D(((1 2) (3 4)) ((5 6) (7)))") 'error)
(test (eval-string "#3D(((1 2) (3 4)) ((5) (7 8)))") 'error)
(test (eval-string "#3D(((1 2) (3 4)) (() (7 8)))") 'error)
@@ -5784,9 +10082,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (length #2d((1 2 3) (4 5 6))) 6)
(test (#2d((1 (2) 3) (4 () 6)) 0 1) '(2))
-(test (#2d((1 (2) 3) (4 () 6)) 1 1) '())
-(test (#2d((1 (2) 3) (4 6 ())) 1 2) '())
-(test (#2d((() (2) ()) (4 5 6)) 0 2) '())
+(test (#2d((1 (2) 3) (4 () 6)) 1 1) ())
+(test (#2d((1 (2) 3) (4 6 ())) 1 2) ())
+(test (#2d((() (2) ()) (4 5 6)) 0 2) ())
(test (equal? (make-vector 0) (make-vector '(0))) #t)
(test (equal? #() (make-vector '(0))) #t)
@@ -5798,6 +10096,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (make-vector (cons 1 2) "hi") 'error)
(test (equal? (make-vector 0) (vector)) #t)
(test (equal? #() (vector)) #t)
+(test (equal? (make-vector 0 0 #t) (make-vector 0 0 #t)) #t)
+(test (equal? #() (make-vector 0 0 #t)) #t)
+(test (equal? (make-vector '(2 0)) (make-vector '(2 0) 0 #t)) #t)
+(test (equal? (make-vector '(2 0)) (make-vector '(0 2) 0 #t)) #f)
(let ((v (make-vector '(2 3) 0)))
(num-test (vector-length v) 6)
@@ -5827,6 +10129,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (v 1 1 1) 'error)
(test (set! (v 1 1 1) 1) 'error))
+
(let ((v1 (make-vector '(3 2) 0))
(v2 (make-vector '(2 3) 0))
(v3 (make-vector '(2 3 4) 0))
@@ -5849,9 +10152,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(num-test (vector-ref v3 1 2 3) 32)
(vector-set! v3 1 2 3 -32)
(num-test (v3 1 2 3) -32)
- (test (v3 1 2) '#(0 0 0 -32))
+ (test (v3 1 2) #(0 0 0 -32))
(test (set! (v3 1 2) 3) 'error)
- (test (vector-ref v3 1 2) '#(0 0 0 -32))
+ (test (vector-ref v3 1 2) #(0 0 0 -32))
(test (vector-set! v3 1 2 32) 'error))
(test (let ((v #2d((1 2) (3 4)))) (vector-fill! v #t) v) #2D((#t #t) (#t #t)))
@@ -5886,7 +10189,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (vector->list #3D(((32)))) '(32))
(test (#3D(((32))) 0) '#2D((32)))
(test (set! (#3D(((32))) 0) 0) 'error)
-(test (#3D(((32))) 0 0) '#(32))
+(test (#3D(((32))) 0 0) #(32))
(test (set! (#3D(((32))) 0 0) 0) 'error)
(test (#3D(((32))) 0 0 0) 32)
(test (vector-length #3D(((32)))) 1)
@@ -5897,7 +10200,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((v1 (make-vector '(1 0))))
(test (vector? v1) #t)
(test (equal? v1 #()) #f)
- (test (vector->list v1) '())
+ (test (vector->list v1) ())
(test (vector-ref v1 0) 'error)
(test (vector-set! v1 0 0) 'error)
(test (vector-ref v1 0 0) 'error)
@@ -5910,7 +10213,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((v2 (make-vector '(10 3 0))))
(test (vector? v2) #t)
(test (equal? v2 #()) #f)
- (test (vector->list v2) '())
+ (test (vector->list v2) ())
(test (vector-ref v2) 'error)
(test (vector-set! v2 0) 'error)
(test (vector-ref v2 0) 'error)
@@ -5927,7 +10230,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((v3 (make-vector '(10 0 3))))
(test (vector? v3) #t)
(test (equal? v3 #()) #f)
- (test (vector->list v3) '())
+ (test (vector->list v3) ())
(test (vector-ref v3) 'error)
(test (vector-set! v3 0) 'error)
(test (vector-ref v3 0) 'error)
@@ -5954,7 +10257,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (set! (vector) 1) 'error)
(test (set! (make-vector 1) 1) 'error)
-(test (equal? (make-vector 10 '()) (make-hash-table 10)) #f)
+(test (equal? (make-vector 10 ()) (make-hash-table 10)) #f)
(test (equal? #() (copy #())) #t)
(test (equal? #2d() (copy #2d())) #t)
(test (fill! #() 1) 1)
@@ -5971,6 +10274,21 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (equal? (make-vector '(3 0 1)) (make-vector '(3 0 2))) #f)
(test (eval-string "#0d()") 'error)
+(let ((v #2d((1 2 3) (4 5 6))))
+ (let ((v1 (v 0))
+ (v2 (v 1)))
+ (if (not (equal? v1 #(1 2 3)))
+ (format-logged #t ";(v 0) subvector: ~A~%" v1))
+ (if (not (equal? v2 #(4 5 6)))
+ (format-logged #t ";(v 1) subvector: ~A~%" v2))
+ (let ((v3 (copy v1)))
+ (if (not (equal? v3 #(1 2 3)))
+ (format-logged #t ";(v 0) copied subvector: ~A~%" v3))
+ (if (not (= (length v3) 3))
+ (format-logged #t ";(v 0) copied length: ~A~%" (length v3)))
+ (if (not (equal? v3 (copy (v 0))))
+ (format-logged #t ";(v 0) copied subvectors: ~A ~A~%" v3 (copy (v 0)))))))
+
(let ((v1 (make-vector '(3 2 1) #f))
(v2 (make-vector '(3 2 1) #f)))
(test (equal? v1 v2) #t)
@@ -5979,9 +10297,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (equal? (make-vector '(3 2 1) #f) (make-vector '(1 2 3) #f)) #f)
(test (map (lambda (n) n) #2d((1 2) (3 4))) '(1 2 3 4))
-(test (let ((vals '())) (for-each (lambda (n) (set! vals (cons n vals))) #2d((1 2) (3 4))) vals) '(4 3 2 1))
+(test (let ((vals ())) (for-each (lambda (n) (set! vals (cons n vals))) #2d((1 2) (3 4))) vals) '(4 3 2 1))
(test (map (lambda (x y) (+ x y)) #2d((1 2) (3 4)) #1d(4 3 2 1)) '(5 5 5 5))
-(test (let ((vals '())) (for-each (lambda (x y) (set! vals (cons (+ x y) vals))) #2d((1 2) (3 4)) #1d(4 3 2 1)) vals) '(5 5 5 5))
+(test (let ((vals ())) (for-each (lambda (x y) (set! vals (cons (+ x y) vals))) #2d((1 2) (3 4)) #1d(4 3 2 1)) vals) '(5 5 5 5))
(let ((v #2D((#(1 2) #(3 4)) (#2d((5 6) (7 8)) #2D((9 10 11) (12 13 14))))))
(test (v 0 0) #(1 2))
@@ -6003,18 +10321,18 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (((v 1 1) 0 0) 1 0) 11))
-(test (let ((V #2D((1 2 3) (4 5 6)))) (V 0)) '#(1 2 3))
-(test (let ((V #2D((1 2 3) (4 5 6)))) (V 1)) '#(4 5 6))
+(test (let ((V #2D((1 2 3) (4 5 6)))) (V 0)) #(1 2 3))
+(test (let ((V #2D((1 2 3) (4 5 6)))) (V 1)) #(4 5 6))
(test (let ((V #2D((1 2 3) (4 5 6)))) (V 2)) 'error)
(test (let ((V #2D((1 2 3) (4 5 6)))) (set! (V 1) 0)) 'error)
(test (let ((V #2D((1 2 3) (4 5 6)))) (let ((V1 (V 0))) (set! (V1 1) 32) V)) '#2D((1 32 3) (4 5 6)))
(test (let ((V #2D((1 2 3) (4 5 6)))) (let ((V1 (V 0))) (set! (V1 3) 32) V)) 'error)
(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 1)) '#2D((7 8 9) (10 11 12)))
-(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 1 1)) '#(10 11 12))
-(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 0 1)) '#(4 5 6))
+(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 1 1)) #(10 11 12))
+(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 0 1)) #(4 5 6))
(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 2 1)) 'error)
-(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((V 0) 1)) '#(4 5 6))
+(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((V 0) 1)) #(4 5 6))
(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((V 0) 1) 1) 32) V) '#3D(((1 2 3) (4 32 6)) ((7 8 9) (10 11 12))))
(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-set! V 0 1 1 32) V) '#3D(((1 2 3) (4 32 6)) ((7 8 9) (10 11 12))))
(test (let ((V '#3D(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-set! V 1 1 0 32) V) '#3D(((1 2 3) (4 5 6)) ((7 8 9) (32 11 12))))
@@ -6038,17 +10356,17 @@ zzy" (lambda (p) (eval (read p))))) 32)
sum))
78)
-(let ((old-vlen *vector-print-length*))
- (set! *vector-print-length* 32)
+(let ((old-vlen (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 32)
(test (object->string (make-vector '(8 8) 0)) "#2D((0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0)...)")
(test (object->string (make-vector 64 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...)")
(test (object->string (make-vector 32 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)")
(test (object->string (make-vector 33 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...)")
(test (object->string (make-vector '(8 4) 0)) "#2D((0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0))")
- (set! *vector-print-length* old-vlen))
+ (set! (*s7* 'print-length) old-vlen))
-(let ((old-vlen *vector-print-length*))
- (set! *vector-print-length* 1024) ; check the many-() case
+(let ((old-vlen (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 1024) ; check the many-() case
(test (object->string (make-vector '(2 1 2 1 2 1 2 1 2 1 2 1 2 1) 0)) "#14D((((((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))) (((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))))) (((((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))) (((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))))))")
(test (object->string (make-vector '(16 1 1 1 1 1 1 1 1 1 1 1 1 1) 0)) "#14D((((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))))")
@@ -6061,31 +10379,151 @@ zzy" (lambda (p) (eval (read p))))) 32)
((= i 6) happy)
(if (or (not (pair? (check-shared-vector-after-gc i)))
(not (equal? (check-shared-vector-after-gc i) (cons 3 i))))
- (set! haappy #f))))
+ (set! happy #f))))
#t)
(set! check-shared-vector-after-gc #f)
- (set! *vector-print-length* old-vlen))
-
+ (set! (*s7* 'print-length) old-vlen))
;;; -------- circular structures --------
+;;; here's an oddity:
+
+(let ((l1 (make-list 1 #f))
+ (l2 (make-list 3 #f)))
+ (set-cdr! l1 l1)
+ (set-cdr! (list-tail l2 2) l2)
+ (test (equal? l1 l2) #t)) ; but (eq? l1 (cdr l1)): #t, and (eq? l2 (cdr l2)): #f
+
+(let ((l1 (make-list 1 #f))
+ (l2 (make-list 3 #f)))
+ (set-car! l1 #t)
+ (set-car! l2 #t)
+ (set-cdr! l1 l1)
+ (set-cdr! (list-tail l2 2) l2)
+ (test (equal? l1 l2) #f))
+
+;;; Guile agrees on the first, but hangs on the second
+;;; CL says the first is false, but hangs on the second
+;;; r7rs agrees with s7 here, to my dismay.
+
+;;; other cases:
+(let ((l1 (list #f #f))
+ (l2 (list #f #f)))
+ (set-cdr! l1 l1)
+ (set-cdr! (cdr l2) l2)
+ (test (equal? l1 l2) #t))
+
+(let ((l1 (list #f #f #f))
+ (l2 (list #f #f #f)))
+ (set-cdr! (cdr l1) l1)
+ (set-cdr! (cddr l2) l2)
+ (test (equal? l1 l2) #f)) ; r7rs says #t I think
+
+(let ((l1 (list #f #f #f))
+ (l2 (list #f #f #f)))
+ (set-cdr! (cdr l1) l1)
+ (set-cdr! (cddr l2) (cdr l2))
+ (test (equal? l1 l2) #t))
+
+;;; Gauche says #t #f #t #t #t, as does chibi
+;;; Guile-2.0 hangs on all, as does Chicken
+
+(let ((l1 (list #t #f #f))
+ (l2 (list #t #f #t)))
+ (set-cdr! (cdr l1) l1)
+ (set-cdr! (cddr l2) (cdr l2))
+ (test (equal? l1 l2) #t))
+
+(let ((l1 (list #t #f #f))
+ (l2 (list #t #f #f #t)))
+ (set-cdr! (cddr l1) l1)
+ (set-cdr! (cdddr l2) (cdr l2))
+ (test (equal? l1 l2) #t))
+
+
+;;; cyclic-sequences
+
+(define* (make-circular-list n init)
+ (let ((l (make-list n init)))
+ (set-cdr! (list-tail l (- n 1)) l)))
+
+(define (cyclic? obj) (not (null? (cyclic-sequences obj))))
+
+(for-each
+ (lambda (arg)
+ (test (cyclic? arg) #f))
+ (list "hi" "" #\null #\a () #() 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))
+ (let ((x '(1 2))) (list x x))
+ (let ((x #(1 2))) (vector x x))
+ (let ((x "a")) (list (vector x) x))
+ (let ((x (hash-table '(a . 1)))) (vector x (list x x) (inlet 'b x)))
+ (let ((x '(1))) (let ((y (list x))) (list x (list y))))))
+
+(test (cyclic-sequences) 'error)
+(test (cyclic-sequences (list 1 2) (list 3 4)) 'error)
+
+(test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences y))) (list (length x) (eq? (car x) y)))) '(1 #t))
+(test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences (vector y)))) (list (length x) (eq? (car x) y)))) '(1 #t))
+(test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences (list y (vector y))))) (list (length x) (eq? (car x) y)))) '(1 #t))
+(test (let* ((y (list 1)) (x (vector y))) (set! (y 0) x) (eq? x (car (cyclic-sequences x)))) #t)
+(test (let ((x (hash-table (cons 'a (make-circular-list 1))))) (eq? (car (cyclic-sequences x)) (x 'a))) #t)
+(test (let ((x (list (make-circular-list 1) (make-circular-list 2)))) (length (cyclic-sequences x))) 2)
+(test (let ((l1 '(1))) (let ((l2 (cons l1 l1))) (cyclic-sequences l2))) ())
+(test (let ((l1 '(1))) (let ((l2 (list l1 l1))) (cyclic-sequences l2))) ())
+(test (let ((y '(1)))
+ (let ((x (list (make-circular-list 1) y y)))
+ (set-cdr! (cddr x) (cdr x))
+ (let ((z (cyclic-sequences x)))
+ (list (length z) (and (memq (cdr x) z) #t))))) ; "and" here just to make the result easier to check
+ '(2 #t))
+(test (let ((z (vector 1 2)))
+ (let ((y (list 1 z 2)))
+ (let ((x (hash-table (cons 'x y))))
+ (set! (z 1) x)
+ (length (cyclic-sequences z)))))
+ 1)
+(test (let ((x '(1 2)))
+ (let ((y (list x x)))
+ (let ((z (vector x y)))
+ (null? (cyclic-sequences z)))))
+ #t)
+(test (let ((v (vector 1 2 3 4)))
+ (let ((lst (list 1 2)))
+ (set-cdr! (cdr lst) lst)
+ (set! (v 0) v)
+ (set! (v 3) lst)
+ (length (cyclic-sequences v))))
+ 2)
+
+(test (infinite? (length (make-circular-list 3))) #t)
+(test (object->string (make-circular-list 3)) "#1=(#f #f #f . #1#)")
+
(let ((lst (list 1 2 3)))
(set! (cdr (cddr lst)) lst)
- (test (apply + lst) 'error))
+ (test (apply + lst) 'error)
+ (test (cyclic? lst) #t)
+ (test (eq? (car (cyclic-sequences lst)) lst) #t))
(let ((l1 (list 1)))
- (test (object->string (list l1 1 l1)) "(#1=(1) 1 #1#)"))
+ (test (object->string (list l1 1 l1)) "((1) 1 (1))") ; was "(#1=(1) 1 #1#)"
+ (test (cyclic? (list l1 1 l1)) #f))
+
+(let ((lst (list 1 2)))
+ (set! (cdr (cdr lst)) (cdr lst))
+ (test (object->string lst) "(1 . #1=(2 . #1#))")
+ (test (object->string lst :readable) "(let (({1} #f)) (let (({lst} (make-list 2))) (let (({x} {lst})) (set-car! {x} 1) (set! {x} (cdr {x})) (set-car! {x} 2) (set-cdr! {x} (set! {1} (let (({lst} (make-list 1))) (set! {1} {lst}) (let (({x} {lst})) (set-car! {x} 2) (set-cdr! {x} {1}) ) {lst}))) ) {lst}))"))
(let ((lst (list 1 2 3)))
(set! (cdr (cddr lst)) lst)
(test (object->string (append '(1) lst)) "(1 . #1=(1 2 3 . #1#))"))
(let ((lst (list 1 2 3)))
(set! (cdr (cddr lst)) lst)
- (test (append lst '()) 'error))
+ (test (append lst ()) 'error))
(let ((lst (list 1 2 3)))
(set! (cdr (cddr lst)) lst)
@@ -6111,7 +10549,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((x (list 1 2)))
(test (equal? x x) #t)
(test (equal? x (cdr x)) #f)
- (test (equal? x '()) #f))
+ (test (equal? x ()) #f))
(let ((x (list 1 (list 2 3) (list (list 4 (list 5)))))
(y (list 1 (list 2 3) (list (list 4 (list 5))))))
(test (equal? x y) #t))
@@ -6119,30 +10557,20 @@ zzy" (lambda (p) (eval (read p))))) 32)
(y (list 1 (list 2 3) (list (list 4 (list 5) 6)))))
(test (equal? x y) #f))
-(test (length '()) 0)
+(test (length ()) 0)
(test (length (cons 1 2)) -1)
(test (length '(1 2 3)) 3)
-(test (let ((lst (list))) (fill! lst 0) lst) '())
-(test (let ((lst (list 1))) (fill! lst 0) lst) '(0))
-(test (let ((lst (list 1 2))) (fill! lst 0) lst) '(0 0))
-(test (let ((lst (list 1 (list 2 3)))) (fill! lst 0) lst) '(0 0))
-(test (let ((lst (cons 1 2))) (fill! lst 0) lst) '(0 . 0))
-(test (let ((lst (cons 1 (cons 2 3)))) (fill! lst 0) lst) '(0 0 . 0))
-(let ((lst (make-list 3)))
- (fill! lst lst)
- (test lst (lst 0))
- (set! (lst 1) 32)
- (test ((lst 0) 1) 32))
-
(let ((lst1 (list 1 2)))
(test (length lst1) 2)
(list-set! lst1 0 lst1)
(test (length lst1) 2) ; its car is a circular list, but it isn't
+ (test (eq? ((cyclic-sequences lst1) 0) lst1) #t)
(test (list->string lst1) 'error)
(let ((lst2 (list 1 2)))
(set-car! lst2 lst2)
(test (equal? lst1 lst2) #t)
+ (test (morally-equal? lst1 lst2) #t)
(test (eq? lst1 lst2) #f)
(test (eqv? lst1 lst2) #f)
(test (pair? lst1) #t)
@@ -6158,13 +10586,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (length lst1) 1)
(set-cdr! lst1 lst1)
(test (infinite? (length lst1)) #t)
+ (test (eq? (cdr ((cyclic-sequences lst1) 0)) lst1) #t)
(test (null? lst1) #f)
(test (pair? lst1) #t)
- (let ((lst2 (cons 1 '())))
+ (let ((lst2 (cons 1 ())))
(set-cdr! lst2 lst2)
(test (equal? lst1 lst2) #t)
+ (test (morally-equal? lst1 lst2) #t)
(set-car! lst2 0)
(test (equal? lst1 lst2) #f)
+ (test (morally-equal? lst1 lst2) #f)
(test (infinite? (length lst2)) #t)))
(let ((lst1 (list 1)))
@@ -6183,11 +10614,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set-car! lst1 lst2)
(set-car! lst2 lst1)
(test (equal? lst1 lst2) #t)
+ (test (morally-equal? lst1 lst2) #t)
(test (length lst1) 1)
(let ((lst3 (list 1)))
(test (equal? lst1 lst3) #f)
+ (test (morally-equal? lst1 lst3) #f)
(set-cdr! lst3 lst3)
- (test (equal? lst1 lst3) #f)))
+ (test (equal? lst1 lst3) #f)
+ (test (morally-equal? lst1 lst3) #f)))
(let ((lst1 (list 'a 'b 'c)))
(set! (cdr (cddr lst1)) lst1)
@@ -6207,28 +10641,67 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (list-set! lst1 9223372036854775807 2) 'error)
(test (list-tail lst1 9223372036854775807) 'error)
(test (make-vector lst1 9223372036854775807) 'error)
- (test (map (lambda (x) x) lst1) 'error)
- (test (map (lambda (x y) x) lst1 lst1) 'error)
- (test (for-each (lambda (x) x) lst1) 'error)
- (test (for-each (lambda (x y) x) lst1 lst1) 'error)
- (test (map (lambda (x y) (+ x y)) lst1 '(1 2 3)) '(2 3 4))
+ (let ((os (*s7* 'safety)))
+ (set! (*s7* 'safety) 1)
+ (test (not (member (map (lambda (x) x) lst1) (list () '(1)))) #f) ; geez -- just want to allow two possible ok results
+ (test (not (member (map (lambda (x y) x) lst1 lst1) (list () '(1)))) #f)
+ (test (for-each (lambda (x) x) lst1) #<unspecified>) ; was 'error
+ (test (for-each (lambda (x y) x) lst1 lst1) #<unspecified>) ; was 'error
+ (test (not (member (map (lambda (x y) (+ x y)) lst1 '(1 2 3)) (list () '(2)))) #f)
+ (set! (*s7* 'safety) os))
)
-(test (copy (list 1 2 (list 3 4))) '(1 2 (3 4)))
-(test (copy (cons 1 2)) '(1 . 2))
-(test (copy '(1 2 (3 4) . 5)) '(1 2 (3 4) . 5))
-(test (copy '()) '())
+(let ((lst1 (list 1 -1)))
+ (set-cdr! (cdr lst1) lst1)
+ (let ((vals (map * '(1 2 3 4) lst1)))
+ (test vals '(1)))) ; was '(1 -2 3 -4) -- as in other cases above, map/for-each stop when a cycle is encountered
+
+(test (let ((lst '(a b c)))
+ (set! (cdr (cddr lst)) lst)
+ (map cons lst '(0 1 2 3 4 5)))
+ '((a . 0) (b . 1) (c . 2)))
(test (object->string (let ((l1 (list 0 1))) (set! (l1 1) l1) (copy l1))) "(0 #1=(0 #1#))")
-(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) (copy lst))) "(1 . #1=(1 . #1#))")
-(test (object->string (let ((l1 (list 1 2))) (copy (list l1 4 l1)))) "(#1=(1 2) 4 #1#)")
-(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) (copy lst))) "(1 2 3 . #1=(2 3 . #1#))")
+
+;;; this changed 11-Mar-15
+;;;(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) (copy lst))) "(1 . #1=(1 . #1#))")
+(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) (copy lst))) "#1=(1 . #1#)")
+(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) lst)) "#1=(1 . #1#)")
+
+(test (object->string (let ((l1 (list 1 2))) (copy (list l1 4 l1)))) "((1 2) 4 (1 2))") ; was "(#1=(1 2) 4 #1#)"
+;;;(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) (copy lst))) "(1 2 3 . #1=(2 3 . #1#))")
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) (copy lst))) "(1 . #1=(2 3 . #1#))")
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) lst)) "(1 . #1=(2 3 . #1#))")
+
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cddr lst)) (copy lst))) "(1 2 . #1=(3 . #1#))")
+(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cddr lst)) lst)) "(1 2 . #1=(3 . #1#))")
+
+;;;(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) (copy lst))) "(1 2 3 4 . #1=(3 4 . #1#))")
+(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) (copy lst))) "(1 2 . #1=(3 4 . #1#))")
+(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) lst)) "(1 2 . #1=(3 4 . #1#))")
+
+;;;(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) (copy lst))) "(1 2 3 4 . #1=(2 3 4 . #1#))")
+(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) (copy lst))) "(1 . #1=(2 3 4 . #1#))")
+(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) lst)) "(1 . #1=(2 3 4 . #1#))")
+
+(test (object->string (vector (let ((lst (list 1))) (set-cdr! lst lst)))) "#(#1=(1 . #1#))")
+(test (object->string (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (set! (car lst) (vector lst)) lst)) "#1=(#(#1#) 2 . #1#)")
+
+;; these are ugly!
+(test (object->string (vector (let ((lst (list 1))) (set-cdr! lst lst))) :readable)
+ "(let (({1} #f)) (vector (set! {1} (let (({lst} (make-list 1))) (set! {1} {lst}) (let (({x} {lst})) (set-car! {x} 1) (set-cdr! {x} {1}) ) {lst}))))")
+(test (object->string (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (set! (car lst) (vector lst)) lst) :readable)
+ "(let (({1} #f)) (set! {1} (let (({lst} (make-list 2))) (set! {1} {lst}) (let (({x} {lst})) (set-car! {x} (vector {1})) (set! {x} (cdr {x})) (set-car! {x} 2) (set-cdr! {x} {1}) ) {lst})))")
+(test (let ((v (vector 1 2))) (set! (v 0) v) (object->string v :readable))
+ "(let (({1} #f)) (set! {1} (let (({v} (make-vector 2))) (set! {1} {v}) (set! ({v} 0) {1}) (set! ({v} 1) 2) {v})))")
+(test (let ((v (make-vector '(2 2) 0))) (set! (v 1 1) v) (object->string v :readable))
+ "(let (({1} #f)) (set! {1} (let (({v} (make-vector '(2 2 )))) (set! {1} {v}) (set! ({v} 0 0) 0) (set! ({v} 0 1) 0) (set! ({v} 1 0) 0) (set! ({v} 1 1) {1}) {v})))")
(test (reverse '(1 2 (3 4))) '((3 4) 2 1))
(test (reverse '(1 2 3)) '(3 2 1))
-(test (reverse '()) '())
+(test (reverse ()) ())
(test (let ((lst (list 1 2 3))) (set! (lst 2) lst) (object->string (reverse lst))) "(#1=(1 2 #1#) 2 1)")
-(test (let ((l1 (cons 1 '()))) (set-cdr! l1 l1) (object->string (reverse l1))) "(#1=(1 . #1#) 1 1 1)")
+(test (let ((l1 (cons 1 ()))) (set-cdr! l1 l1) (object->string (reverse l1))) "(#1=(1 . #1#) 1 1 1)")
(test (equal? (vector 0) (vector 0)) #t)
@@ -6258,6 +10731,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (v2 0) v1)
(test (equal? v1 v2) #t))
+(test (vector? (let ((v (vector 0))) (set! (v 0) v) (v 0 0 0 0))) #t) ; ?
+
(let* ((l1 (list 1 2))
(v1 (vector 1 2))
(l2 (list 1 l1 2))
@@ -6274,15 +10749,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((v1 (make-vector 1 0)))
(set! (v1 0) v1)
+ (test (eq? ((cyclic-sequences v1) 0) v1) #t)
(test (object->string v1) "#1=#(#1#)"))
-(let ((l1 (cons 0 '())))
+(let ((l1 (cons 0 ())))
(set-cdr! l1 l1)
(test (list->vector l1) 'error))
(let ((lst (list "nothing" "can" "go" "wrong")))
(let ((slst (cddr lst))
- (result '()))
+ (result ()))
(set! (cdr (cdddr lst)) slst)
(test (do ((i 0 (+ i 1))
(l lst (cdr l)))
@@ -6344,10 +10820,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) (object->string lst)) "#1=(1 2 3 . #1#)")
(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) (cdr lst)) (object->string lst)) "(1 . #1=(2 3 . #1#))")
(test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) (cdr (cdr lst))) (object->string lst)) "(1 2 . #1=(3 . #1#))")
-(test (let ((lst (list 1 2 3))) (set! (car lst) (cdr lst)) (object->string lst)) "(#1=(2 3) . #1#)")
+(test (let ((lst (list 1 2 3))) (set! (car lst) (cdr lst)) (object->string lst)) "((2 3) 2 3)") ; was "(#1=(2 3) . #1#)"
(test (let ((lst (list 1 2 3))) (set! (car (cdr lst)) (cdr lst)) (object->string lst)) "(1 . #1=(#1# 3))")
(test (let ((lst (list 1 2 3))) (set! (car (cdr lst)) lst) (object->string lst)) "#1=(1 #1# 3)")
-(test (let ((l1 (list 1))) (let ((l2 (list l1 l1))) (object->string l2))) "(#1=(1) #1#)")
+(test (let ((l1 (list 1))) (let ((l2 (list l1 l1))) (object->string l2))) "((1) (1))") ; was "(#1=(1) #1#)"
(test (let* ((v1 (vector 1 2)) (v2 (vector v1)))
(vector-set! v1 1 v1)
@@ -6358,14 +10834,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(string=? (object->string v1) "#1=#((3 . #1#) 1 1)"))
#t)
(test (let ((h1 (make-hash-table 11))
- (old-print-length *vector-print-length*))
- (set! *vector-print-length* 32)
+ (old-print-length (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 32)
(hash-table-set! h1 "hi" h1)
(let ((result (object->string h1)))
- (set! *vector-print-length* old-print-length)
- (let ((val (string=? result "#1=#<hash-table (\"hi\" . #1#)>")))
+ (set! (*s7* 'print-length) old-print-length)
+ (let ((val (string=? result "#1=(hash-table '(\"hi\" . #1#))")))
(if (not val)
- (format #t ";hash display:~% ~A~%" (object->string h1)))
+ (format-logged #t ";hash display:~% ~A~%" (object->string h1)))
val)))
#t)
@@ -6431,10 +10907,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (eq? lst l1) #f)
(test (eqv? lst l1) #f)))
-(test (let ((lst (list "hi" "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi"))) #t)
-(test (let ((lst (list "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi"))) #t)
-(test (let ((lst (list 1 2 3 4))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi" "hi"))) #t)
-
(let ((lst '(#\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{ #\| #\} #\~)))
(let ((str (apply string lst)))
@@ -6480,13 +10952,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (equal? l2 vect) #t)
(test (equal? s2 lst) #t)))))
-(let* ((vals (list "hi" #\A 1 'a #(1) abs _ht_ quasiquote macroexpand make-type hook-functions
+(let* ((vals (list "hi" #\A 1 'a #(1) abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
3.14 3/4 1.0+1.0i #\f '(1 . 2)))
(vlen (length vals)))
(do ((i 0 (+ i 1)))
((= i 20))
(let* ((size (max 1 (random 20)))
- (vect (make-vector size '())))
+ (vect (make-vector size ())))
(do ((n 0 (+ n 1)))
((= n size))
(let ((choice (random 4))
@@ -6537,9 +11009,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (car lst2) lst2)
(set! (cdr (cddr lst1)) base)
(set! (cdr (cddr lst2)) base)
+ (test (length (cyclic-sequences lst2)) 1)
(test (equal? lst1 lst2) #t)
(test (equal? vec1 vec2) #t)
- (test (object->string lst1) "#1=(#1# 2 #(1 2 #2=(#f)) . #2#)")))
+ (test (object->string lst1) "#1=(#1# 2 #(1 2 (#f)) #f)"))) ; was "#1=(#1# 2 #(1 2 #2=(#f)) . #2#)"
(let ((base (list 0 #f)))
(let ((lst1 (list 1 base 2))
@@ -6559,24 +11032,24 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ()
(define-macro (c?r path)
- (define (X-marks-the-spot accessor tree)
- (if (pair? tree)
- (or (X-marks-the-spot (cons 'car accessor) (car tree))
- (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
- (if (eq? tree 'X) accessor #f)))
-
- (let ((body 'lst))
- (for-each
- (lambda (f)
- (set! body (list f body)))
- (reverse (X-marks-the-spot '() path)))
-
- `(make-procedure-with-setter
- (lambda (lst)
- ,body)
- (lambda (lst val)
- (set! ,body val)))))
-
+ (define (X-marks-the-spot accessor tree)
+ (if (pair? tree)
+ (or (X-marks-the-spot (cons 'car accessor) (car tree))
+ (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
+ (if (eq? tree 'X) accessor #f)))
+
+ (let ((body 'lst))
+ (for-each
+ (lambda (f)
+ (set! body (list f body)))
+ (reverse (X-marks-the-spot () path)))
+
+ `(dilambda
+ (lambda (lst)
+ ,body)
+ (lambda (lst val)
+ (set! ,body val)))))
+
(define (copy-tree lis)
(if (pair? lis)
(cons (copy-tree (car lis))
@@ -6666,6 +11139,30 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (acc2 lst) (acc1 lst))
(test (eval lst) 11))))
)
+
+(let ()
+ ;; anonymous recursion...
+ (define (fc?r path)
+ (define (X-marks-the-spot accessor tree)
+ (if (pair? tree)
+ (or (X-marks-the-spot (cons 'car accessor) (car tree))
+ (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
+ (if (eq? tree 'X) accessor #f)))
+ (let ((body 'lst))
+ (for-each
+ (lambda (f)
+ (set! body (list f body)))
+ (reverse (X-marks-the-spot () path)))
+ (let ((getter (apply lambda '(lst) body ()))
+ (setter (apply lambda '(lst val) `(set! ,body val) ())))
+ (dilambda getter setter))))
+
+ (let ((body '(if (not (pair? (cdr lst))) lst (begin (set! lst (cdr lst)) X)))) ; X is where we jump back to the start
+ (let ((recurse (fc?r body)))
+ (set! (recurse body) body)
+ (test ((apply lambda '(lst) body ()) '(1 2 3)) '(3)))))
+
+
(let ((v #2d((1 2) (3 4))))
(set! (v 1 0) v)
@@ -6694,10 +11191,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (object->string q) "#1=(2 3 4 5 . #1#)"))
(let ()
- (define (make-node prev data next) (vector prev data next))
- (define prev (make-procedure-with-setter (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
- (define next (make-procedure-with-setter (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
- (define data (make-procedure-with-setter (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
+ (define make-node vector)
+ (define prev (dilambda (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
+ (define next (dilambda (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
+ (define data (dilambda (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
(let* ((head (make-node () 0 ()))
(cur head))
(do ((i 1 (+ i 1)))
@@ -6723,20 +11220,20 @@ zzy" (lambda (p) (eval (read p))))) 32)
(format t "~A~%" head)) -> "#1=#(#2=#(#3=#(#4=#(#5=#(#6=#(#7=#(#8=#(#1# 1 #7#) 2 #6#) 3 #5#) 4 #4#) 5 #3#) 6 #2#) 7 #1#) 0 #8#)"
|#
(let ((ahead (do ((cur head (next cur))
- (dat '() (cons (data cur) dat)))
+ (dat () (cons (data cur) dat)))
((member (data cur) dat)
(reverse dat)))))
(let ((behind (do ((cur (prev head) (prev cur))
- (dat '() (cons (data cur) dat)))
+ (dat () (cons (data cur) dat)))
((member (data cur) dat)
dat))))
(test (equal? ahead behind) #t)))))
(let ()
- (define (make-node prev data next) (list prev data next))
- (define prev (make-procedure-with-setter (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
- (define next (make-procedure-with-setter (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
- (define data (make-procedure-with-setter (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
+ (define make-node list)
+ (define prev (dilambda (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
+ (define next (dilambda (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
+ (define data (dilambda (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
(let* ((head (make-node () 0 ()))
(cur head))
(do ((i 1 (+ i 1)))
@@ -6748,11 +11245,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (prev head) cur)
(test (object->string head) "#1=(#7=(#6=(#5=(#4=(#3=(#2=(#8=(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #1#) 0 #8#)")
(let ((ahead (do ((cur head (next cur))
- (dat '() (cons (data cur) dat)))
+ (dat () (cons (data cur) dat)))
((member (data cur) dat)
(reverse dat)))))
(let ((behind (do ((cur (prev head) (prev cur))
- (dat '() (cons (data cur) dat)))
+ (dat () (cons (data cur) dat)))
((member (data cur) dat)
dat))))
(test (equal? ahead behind) #t))))
@@ -6772,7 +11269,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((ht (make-hash-table 3)))
(set! (ht "hi") ht)
- (test (object->string ht) "#1=#<hash-table (\"hi\" . #1#)>")
+ (test (object->string ht) "#1=(hash-table '(\"hi\" . #1#))")
(test (equal? (ht "hi") ht) #t))
(let ((l1 '(0)) (l2 '(0)))
@@ -6782,7 +11279,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (cdr l1) l2)
(test (object->string l1) "#1=(#1# . #2=(#2# . #2#))")
(test (equal? l1 l2) #t)
- (set! (cdr l1) '())
+ (set! (cdr l1) ())
(test (equal? l1 l2) #f))
(let ((lst (list 1 2 3)))
@@ -6793,7 +11290,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
lst)
'(5 7 9)))
(test (let ((lst (list 1 2 3))
- (result '()))
+ (result ()))
(set! (cdr (cddr lst)) lst)
(for-each (lambda (a b)
(set! result (cons (+ a b) result)))
@@ -6814,49 +11311,47 @@ zzy" (lambda (p) (eval (read p))))) 32)
(+ a b))
(vector 4 5 6 7 8 9 10)
lst))
- '(5 7 9 8 10 12 11))
+ '(5 7 9)) ; this now quits when it sees the cycle
+ ;'(5 7 9 8 10 12 11))
(test (map (lambda (a) a) '(0 1 2 . 3)) '(0 1 2))
(test (let ((ctr 0)) (for-each (lambda (a) (set! ctr (+ ctr a))) '(1 2 . 3)) ctr) 3)
(let ((lst (list 1 2 3)))
(set! (cdr (cddr lst)) lst)
(test (map (lambda (a b)
(+ a b))
- '()
+ ()
lst)
- '()))
+ ()))
(test (let ((lst (list 1 2 3))
(ctr 0))
(set! (cdr (cddr lst)) lst)
(for-each (lambda (a b)
(set! ctr (+ ctr (+ a b))))
- lst '())
+ lst ())
ctr)
0)
(test (let ((lst (list 1))) (set! (cdr lst) (car lst)) (object->string lst)) "(1 . 1)")
(test (let ((lst (list 1))) (set! (car lst) (cdr lst)) (object->string lst)) "(())")
-(test (let ((lst (list 1 2 3))) (fill! lst lst) (object->string lst)) "#1=(#1# #1# #1#)")
-(test (let ((lst (vector 1 2 3))) (fill! lst lst) (object->string lst)) "#1=#(#1# #1# #1#)")
-(test (let ((lst #2d((1) (1)))) (fill! lst lst) (object->string lst)) "#1=#2D((#1#) (#1#))")
-
(let ((ctr 0) (lst `(let ((x 3)) (set! ctr (+ ctr 1)) (set! (cdr (cddr lst)) `((+ x ctr))) (+ x 1))))
(test (eval lst) 4)
(test (eval lst) 5)
(test (eval lst) 6))
+
(let ()
(define fact ; Reini Urban, http://autocad.xarch.at/lisp/self-mod.lsp.txt
- (let ((old '())
- (result '()))
+ (let ((old ())
+ (result ()))
(define (last lst)
(list-tail lst (- (length lst) 1)))
(define (butlast lis)
(let ((len (length lis)))
- (if (<= len 1) '()
- (let ((result '()))
+ (if (<= len 1) ()
+ (let ((result ()))
(do ((i 0 (+ i 1))
(lst lis (cdr lst)))
((= i (- len 1)) (reverse result))
@@ -6867,12 +11362,12 @@ zzy" (lambda (p) (eval (read p))))) 32)
(#t
(set! old (procedure-source fact))
(set! fact (apply lambda '(n)
- `((cond
- ,@(butlast (cdr (car (cdr (cdr old)))))
- ((= n ,n) ,(let ()
- (set! result (* n (fact (- n 1))))
- result))
- ,@(last (cdr (car (cdr (cdr old)))))))))
+ `((cond
+ ,@(butlast (cdr (car (cdr (cdr old)))))
+ ((= n ,n) ,(let ()
+ (set! result (* n (fact (- n 1))))
+ result))
+ ,@(last (cdr (car (cdr (cdr old)))))))))
result)))))
(test (fact 3) 6)
@@ -6896,52 +11391,547 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set-car! x 6)
(set-car! y 7)
(set-cdr! (cdr x) (list 8))
- (test (object->string (list x y z w v)) "((6 . #3=(2 8)) (7 . #1=(5)) #2=(1 . #1#) (4 5 . #2#) (#3# . #1#))"))
-;; guile gets this result, but prints it as: ((6 2 8) (7 5) (1 5) (4 5 1 5) ((2 8) 5))
+ (test (object->string (list x y z w v)) "((6 2 8) (7 5) (1 5) (4 5 1 5) ((2 8) 5))"))
+;; was "((6 . #3=(2 8)) (7 . #1=(5)) #2=(1 . #1#) (4 5 . #2#) (#3# . #1#))"
+
+;; circular eval
+(test (let ((e (list (list '+ 1)))) (set-cdr! (car e) e) (eval e)) 'error)
+(test (let ((e (list (list '+ 1 2)))) (set-cdr! (cdar e) e) (eval e)) 'error)
+(test (let ((e (list (list '+ 1 2) 3))) (set-cdr! (cdar e) e) (eval e)) 'error)
+(test (let ((e (list (list '+ 1) 3 4))) (set-cdr! (cdar e) e) (eval e)) 'error)
+(test (let ((x '(1 2 3)))
+ (set! (x 0) (cons x 2))
+ (eval ({list} 'let () ({list} 'define '(f1) ({list} 'list-set! x 0 ({list} 'cons x 2))) '(catch #t f1 (lambda a 'error)))))
+ 'error)
+(test (let ((x '(car (list 1 2 3))))
+ (set! (x 0) x)
+ (eval ({list} 'let () ({list} 'define '(f1) x) '(catch #t f1 (lambda a 'error)))))
+ 'error)
+
+
+#|
+(define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below
+ "(for-each-permutation func vals) applies func to every permutation of vals"
+ ;; (for-each-permutation (lambda args (format-logged #t "~{~A~^ ~}~%" args)) '(1 2 3))
+ (define (pinner cur nvals len)
+ (if (= len 1)
+ (apply func (cons (car nvals) cur))
+ (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish
+ ((= i len))
+ (let ((start nvals))
+ (set! nvals (cdr nvals))
+ (let ((cur1 (cons (car nvals) cur))) ; add (car nvals) to our arg list
+ (set! (cdr start) (cdr nvals)) ; splice out that element and
+ (pinner cur1 (cdr start) (- len 1)) ; pass a smaller circle on down
+ (set! (cdr start) nvals)))))) ; restore original circle
+ (let ((len (length vals)))
+ (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle
+ (pinner () vals len)
+ (set-cdr! (list-tail vals (- len 1)) ()))) ; restore its original shape
+|#
+#|
+;; a slightly faster version (avoids consing and some recursion)
+(define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below
+ "(for-each-permutation func vals) applies func to every permutation of vals"
+ ;; (for-each-permutation (lambda args (format-logged #t "~A~%" args)) '(1 2 3))
+ (let ((cur (make-list (length vals))))
+
+ (define (pinner nvals len)
+ (if (= len 2)
+ (begin
+ (set! (cur 0) (car nvals))
+ (set! (cur 1) (cadr nvals))
+ (apply func cur)
+ (set! (cur 1) (car nvals))
+ (set! (cur 0) (cadr nvals))
+ (apply func cur))
+
+ (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish
+ ((= i len))
+ (let ((start nvals))
+ (set! nvals (cdr nvals))
+ (set! (cur (- len 1)) (car nvals))
+ (set! (cdr start) (cdr nvals)) ; splice out that element and
+ (pinner (cdr start) (- len 1)) ; pass a smaller circle on down
+ (set! (cdr start) nvals))))) ; restore original circle
+
+ (let ((len (length vals)))
+ (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle
+ (pinner vals len)
+ (set-cdr! (list-tail vals (- len 1)) ())))) ; restore its original shape
+|#
+
+;; and continuing down that line...
+(define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below
+ "(for-each-permutation func vals) applies func to every permutation of vals"
+ ;; (for-each-permutation (lambda args (format-logged #t "~A~%" args)) '(1 2 3))
+ (let ((cur (make-list (length vals))))
+
+ (define (pinner nvals len)
+ (if (= len 3)
+ (let ((a0 (car nvals))
+ (a1 (cadr nvals))
+ (a2 (caddr nvals))
+ (c1 (cdr cur))
+ (c2 (cddr cur)))
+ (set-car! cur a2)
+ (set-car! c1 a0)
+ (set-car! c2 a1)
+ (apply func cur)
+ (set-car! cur a0)
+ (set-car! c1 a2)
+ ;(set-car! c2 a1)
+ (apply func cur)
+ ;(set-car! cur a0)
+ (set-car! c1 a1)
+ (set-car! c2 a2)
+ (apply func cur)
+ (set-car! cur a1)
+ (set-car! c1 a0)
+ ;(set-car! c2 a2)
+ (apply func cur)
+ ;(set-car! cur a1)
+ (set-car! c1 a2)
+ (set-car! c2 a0)
+ (apply func cur)
+ (set-car! cur a2)
+ (set-car! c1 a1)
+ ;(set-car! c2 a0)
+ (apply func cur)
+ )
+
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((start nvals))
+ (set! nvals (cdr nvals))
+ (list-set! cur (- len 1) (car nvals))
+ (set! (cdr start) (cdr nvals)) ; splice out that element and
+ (pinner (cdr start) (- len 1)) ; pass a smaller circle on down
+ (set! (cdr start) nvals))))) ; restore original circle
+
+ (let ((len (length vals)))
+ (if (< len 2)
+ (apply func vals)
+ (if (= len 2)
+ (let ((c1 (cdr cur)))
+ (set-car! cur (car vals))
+ (set-car! c1 (cadr vals))
+ (apply func cur)
+ (set-car! c1 (car vals))
+ (set-car! cur (cadr vals))
+ (apply func cur))
+ (begin
+ (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle
+ (pinner vals len)
+ (set-cdr! (list-tail vals (- len 1)) ()))))))) ; restore its original shape
+
+
+(when full-test
+ (let()
+ (define ops '(+ *))
+ (define args '(1 pi 1+i 2/3 x y))
+
+ (define (listify lst)
+ ((if (memq (car lst) ops) list
+ (if (null? (cdr lst)) append values))
+ (if (null? (cdr lst))
+ (car lst)
+ (values (car lst) (listify (cdr lst))))))
+
+ (call-with-output-file "t923.scm"
+ (lambda (p)
+ (let ((fctr 0))
+ (for-each-permutation
+ (lambda lst
+ (let ((expr (list (listify lst))))
+ (format p "(define (f~D x y) ~{~^~S ~})~%" fctr expr)
+ (format p "(let ((e1 (f~D 3 4)))~%" fctr)
+ (format p " (let ((e2 (let ((x 3) (y 4)) ~{~^~S ~})))~%" expr)
+ (format p " (let ((e3 (let ((x 3) (y 4)) (f~D x y))))~%" fctr)
+ (format p " (if (not (= e1 e2 e3))~% (format *stderr* \"~{~^~S ~}: ~~A ~~A ~~A~~%\" e1 e2 e3)))))~%~%" expr))
+ (set! fctr (+ fctr 1)))
+ (append ops args)))))
+
+ (load "t923.scm")))
+
+ ;; t224 also applies this to +/*
+
+(let ((perms '((3 1 2) (1 3 2) (1 2 3) (2 1 3) (2 3 1) (3 2 1)))
+ (pos ()))
+ (for-each-permutation
+ (lambda args
+ (call-with-exit
+ (lambda (ok)
+ (let ((ctr 0))
+ (for-each
+ (lambda (a)
+ (if (equal? a args)
+ (begin
+ (set! pos (cons ctr pos))
+ (ok)))
+ (set! ctr (+ ctr 1)))
+ perms)))))
+ '(1 2 3))
+ (test pos '(5 4 3 2 1 0)))
+
+(test (let ((v1 (make-vector 16 0))
+ (v2 (make-vector 16 0)))
+ (set! (v2 12) v2)
+ (set! (v1 12) v1)
+ (equal? v1 v2)) ; hmmm -- not sure this is correct
+ #t)
+(test (let ((lst1 (list 1))
+ (lst2 (list 1)))
+ (set-cdr! lst1 lst1)
+ (set-cdr! lst2 lst2)
+ (equal? lst1 lst2))
+ #t)
+
+
+(test (let ((hi 3))
+ (let ((e (curlet)))
+ (set! hi (curlet))
+ (object->string e)))
+ "#1=(inlet 'hi (inlet 'e #1#))")
+(let ((e (inlet 'a 0 'b 1)))
+ (let ((e1 (inlet 'a e)))
+ (set! (e 'b) e1)
+ (test (equal? e (copy e)) #t)
+ (test (object->string e) "#1=(inlet 'a 0 'b (inlet 'a #1#))")))
+
+;; eval circles -- there are many more of these that will cause stack overflow
+(test (let ((x '(1 2 3))) (set! (x 0) (cons x 2)) (eval `(let () (define (f1) (list-set! ,x 0 (cons ,x 2))) (catch #t f1 (lambda a 'error))))) 'error)
+(test (let ((x '(car (list 1 2 3)))) (set! (x 0) x) (eval `(let () (define (f1) ,x) (catch #t f1 (lambda a 'error))))) 'error)
+
+
+(test (apply + (cons 1 2)) 'error)
+(test (let ((L (list 0))) (set-cdr! L L) (apply + L)) 'error)
+(test (let ((L (list 0))) (set-cdr! L L) (format #f "(~S~{~^ ~S~})~%" '+ L)) 'error)
+(test (apply + (list (let ((L (list 0 1))) (set-cdr! L L) L))) 'error)
+(test (apply + (let ((L (list 0 1))) (set-cdr! L L) L)) 'error)
+(test (length (let ((E (inlet 'value 0))) (varlet E 'self E))) 2)
+;(test (apply case 2 (list (let ((L (list (list 0 1)))) (set-cdr! L L) L))) 'error)
+;(test (apply cond (list (let ((L (list 0 1))) (set-cdr! L L) L))) 'error)
+;(test (apply quote (let ((L (list 0 1))) (set-car! L L) L)) 'error)
+;(test (apply letrec (hash-table) (let ((L (list 0 1))) (set-car! L L) L)) 'error)
+;I now think the caller should check for these, not s7
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; HOOKS
+;;; make-hook
+;;; hook-functions
+;;; --------------------------------------------------------------------------------
+
+(let ((old-hook (hook-functions *error-hook*)))
+ (for-each
+ (lambda (arg)
+ (test (set! *unbound-variable-hook* arg) 'error)
+ (test (set! *missing-close-paren-hook* arg) 'error)
+ (test (set! *load-hook* arg) 'error)
+
+ (test (set! (hook-functions *unbound-variable-hook*) arg) 'error)
+ (test (set! (hook-functions *missing-close-paren-hook*) arg) 'error)
+ (test (set! (hook-functions *error-hook*) arg) 'error)
+ (test (set! (hook-functions *load-hook*) arg) 'error)
+
+ (test (set! (hook-functions *unbound-variable-hook*) (list arg)) 'error)
+ (test (set! (hook-functions *missing-close-paren-hook*) (list arg)) 'error)
+ (test (set! (hook-functions *error-hook*) (list arg)) 'error)
+ (test (set! (hook-functions *load-hook*) (list arg)) 'error)
+ )
+ (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi #<eof> #(1 2 3) #(()) "hi" '(1 . 2) '(1 2 3)))
+ (set! (hook-functions *error-hook*) old-hook))
+
+(let ((old-hook (hook-functions *unbound-variable-hook*))
+ (hook-val #f))
+ (set! (hook-functions *unbound-variable-hook*)
+ (list (lambda (hook)
+ (set! hook-val (hook 'variable))
+ (set! (hook 'result) 123))))
+ (let ((val (catch #t
+ (lambda ()
+ (+ 1 one-two-three))
+ (lambda args 'error))))
+ (test val 124))
+ (test (equal? one-two-three 123) #t)
+ (test (equal? hook-val 'one-two-three) #t)
+ (set! (hook-functions *unbound-variable-hook*) old-hook))
+
+(let ((old-hook (hook-functions *unbound-variable-hook*)))
+ (set! (hook-functions *unbound-variable-hook*)
+ (list (lambda (hook)
+ (set! (hook 'result) 32))))
+ (let ((val (+ 1 _an_undefined_variable_i_hope_)))
+ (test val 33))
+ (let ((val (* _an_undefined_variable_i_hope_ _an_undefined_variable_i_hope_)))
+ (test val 1024))
+ (set! (hook-functions *unbound-variable-hook*) old-hook))
+
+(let ((old-hook (hook-functions *unbound-variable-hook*))
+ (x #f))
+ (set! (hook-functions *unbound-variable-hook*)
+ (list
+ (lambda (hook)
+ (set! x 0)
+ (set! (hook 'result) #<undefined>))
+ (lambda (hook)
+ (set! (hook 'result) 32))
+ (lambda (hook)
+ (if (not (number? (hook 'result)))
+ (format *stderr* "oops -- *unbound-variable-hook* func called incorrectly~%")))))
+ (let ((val (+ 1 _an_undefined_variable_i_hope_)))
+ (test val 33))
+ (test x 0)
+ (test (+ 1 _an_undefined_variable_i_hope_) 33)
+ (set! (hook-functions *unbound-variable-hook*) old-hook))
+
+(let ((old-load-hook (hook-functions *load-hook*))
+ (val #f))
+ (with-output-to-file "load-hook-test.scm"
+ (lambda ()
+ (format-logged #t "(define (load-hook-test val) (+ val 1))")))
+ (set! (hook-functions *load-hook*)
+ (list (lambda (hook)
+ (if (or val
+ (defined? 'load-hook-test))
+ (format-logged #t ";*load-hook*: ~A ~A?~%" val load-hook-test))
+ (set! val (hook 'name)))))
+ (load "load-hook-test.scm")
+ (if (or (not (string? val))
+ (not (string=? val "load-hook-test.scm")))
+ (format-logged #t ";*load-hook-test* file: ~S~%" val))
+ (if (not (defined? 'load-hook-test))
+ (format-logged #t ";load-hook-test function not defined?~%")
+ (if (not (= (load-hook-test 1) 2))
+ (format-logged #t ";load-hook-test: ~A~%" (load-hook-test 1))))
+ (set! (hook-functions *load-hook*) old-load-hook))
+
+(let ((old-hook (hook-functions *error-hook*)))
+ (set! (hook-functions *error-hook*) ())
+ (test (hook-functions *error-hook*) ())
+ (set! (hook-functions *error-hook*) (list (lambda (hook) #f)))
+ (test (list? (hook-functions *error-hook*)) #t)
+ (set! (hook-functions *error-hook*) ())
+; (set! *error-hook* (lambda (tag args) #f)) ; this no longer works (21-Sep-12)
+; (test (list? (hook-functions *error-hook*)) #t)
+ (set! (hook-functions *error-hook*) old-hook))
+
+(let ((old-hook (hook-functions *missing-close-paren-hook*)))
+ (set! (hook-functions *missing-close-paren-hook*) (list (lambda (h) (set! (h 'result) 'incomplete-expr))))
+ (test (catch #t (lambda () (eval-string "(+ 1 2")) (lambda args (car args))) 'incomplete-expr)
+ (test (catch #t (lambda () (eval-string "(")) (lambda args (car args))) 'incomplete-expr)
+ (test (catch #t (lambda () (eval-string "(abs ")) (lambda args (car args))) 'incomplete-expr)
+ (set! (hook-functions *missing-close-paren-hook*) old-hook))
+
+
+(let ((h (make-hook 'x)))
+ (test (procedure? h) #t)
+ (test (eq? h h) #t)
+ (test (eqv? h h) #t)
+ (test (equal? h h) #t)
+ (test (morally-equal? h h) #t)
+ (let ((h1 (copy h)))
+ (test (eq? h h1) #f) ; fluctutates...
+ (test (morally-equal? h h1) #t))
+ (test (hook-functions h) ())
+ (test (h) #<unspecified>)
+ (test (h 1) #<unspecified>)
+ (test (h 1 2) 'error)
+ (let ((f1 (lambda (hook) (set! (hook 'result) (hook 'x)))))
+ (set! (hook-functions h) (list f1))
+ (test (member f1 (hook-functions h)) (list f1))
+ (test (hook-functions h) (list f1))
+ (test (h 1) 1)
+ (set! (hook-functions h) ())
+ (test (hook-functions h) ())
+ (let ((f2 (lambda* args (set! ((car args) 'result) ((car args) 'x)))))
+ (set! (hook-functions h) (list f2))
+ (test (hook-functions h) (list f2))
+ (test (h 1) 1)))
+ (for-each
+ (lambda (arg)
+ (test (set! (hook-functions h) arg) 'error))
+ (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi #<eof> #<undefined> #<unspecified>)))
+
+(let ((h (make-hook)))
+ (test (procedure? h) #t)
+ (test (procedure-documentation h) "")
+ (test (hook-functions h) ())
+ (test (h) #<unspecified>)
+ (test (h 1) 'error)
+ (let ((f1 (lambda (hook) (set! (hook 'result) 123))))
+ (set! (hook-functions h) (list f1))
+ (test (member f1 (hook-functions h)) (list f1))
+ (test (hook-functions h) (list f1))
+ (test (h) 123)
+ (set! (hook-functions h) ())
+ (test (hook-functions h) ())
+ (let ((f2 (lambda* args (set! ((car args) 'result) 321))))
+ (set! (hook-functions h) (list f2))
+ (test (hook-functions h) (list f2))
+ (test (h) 321))))
+
+(let ((h (make-hook '(a 32) 'b)))
+ (test (procedure? h) #t)
+ (test (hook-functions h) ())
+ (test (h) #<unspecified>)
+ (test (h 1) #<unspecified>)
+ (test (h 1 2) #<unspecified>)
+ (test (h 1 2 3) 'error)
+ (let ((f1 (lambda (hook) (set! (hook 'result) (+ (hook 'a) (or (hook 'b) 0))))))
+ (set! (hook-functions h) (list f1))
+ (test (member f1 (hook-functions h)) (list f1))
+ (test (hook-functions h) (list f1))
+ (test (h) 32)
+ (test (h 1) 1)
+ (test (h 1 2) 3)
+ (set! (hook-functions h) ())
+ (test (hook-functions h) ())))
(let ()
- (define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below
- ;; apply func to every permutation of vals:
- ;; (for-each-permutation (lambda args (format #t "~{~A~^ ~}~%" args)) '(1 2 3))
- (define (pinner cur nvals len)
- (if (= len 1)
- (apply func (cons (car nvals) cur))
- (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish
- ((= i len))
- (let ((start nvals))
- (set! nvals (cdr nvals))
- (let ((cur1 (cons (car nvals) cur))) ; add (car nvals) to our arg list
- (set! (cdr start) (cdr nvals)) ; splice out that element and
- (pinner cur1 (cdr start) (- len 1)) ; pass a smaller circle on down
- (set! (cdr start) nvals)))))) ; restore original circle
- (let ((len (length vals)))
- (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle
- (pinner '() vals len)
- (set-cdr! (list-tail vals (- len 1)) '()))) ; restore its original shape
-
- ;; t224 applies this to +/*
-
- (let ((perms '((3 1 2) (1 3 2) (1 2 3) (2 1 3) (2 3 1) (3 2 1)))
- (pos '()))
- (for-each-permutation
- (lambda args
- (call-with-exit
- (lambda (ok)
- (let ((ctr 0))
- (for-each
- (lambda (a)
- (if (equal? a args)
- (begin
- (set! pos (cons ctr pos))
- (ok)))
- (set! ctr (+ ctr 1)))
- perms)))))
- '(1 2 3))
- (test pos '(5 4 3 2 1 0)))
+ (for-each
+ (lambda (arg)
+ (test (make-hook arg) 'error))
+ (list "hi" #f 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi #<eof> #<undefined> #<unspecified>)))
+
+(let ((h (make-hook)))
+ (let ((f1 (lambda (hook) (if (number? (hook 'result)) (set! (hook 'result) (+ (hook 'result) 1)) (set! (hook 'result) 0)))))
+ (test (h) #<unspecified>)
+ (set! (hook-functions h) (list f1))
+ (test (h) 0)
+ (set! (hook-functions h) (list f1 f1 f1))
+ (test (h) 2)))
+
+(if (not (defined? 'hook-push))
+ (define (hook-push hook func)
+ (set! (hook-functions hook) (cons func (hook-functions hook)))))
+
+(let ((h (make-hook)))
+ (hook-push h (lambda (hook) (set! (hook 'result) 32)))
+ (test (dynamic-wind h h h) 32)
+ (test (catch h h h) 32)
+ )
+
+(let ((h (make-hook 'x)))
+ (hook-push h (lambda (hook) (set! (hook 'result) (hook 'x))))
+ (test (continuation? (call/cc h)) #t)
+ (set! (hook-functions h) (list (lambda (hook) (set! (hook 'result) (+ 1 (hook 'x))))))
+ (test (map h '(1 2 3)) '(2 3 4))
)
+
+(let ()
+ (define-macro (hook . body)
+ `(let ((h (make-hook)))
+ (set! (hook-functions h)
+ (list (lambda (h)
+ (set! (h 'result) (begin , at body)))))
+ h))
+ (let ((x 0))
+ (define hi (hook (set! x 32) (+ 2 3 1)))
+ (test (hi) 6)
+ (test x 32)))
+
+(let ()
+ (define-macro (hooked-catch hook . body)
+ `(catch #t
+ (lambda ()
+ , at body)
+ (lambda args
+ (let ((val (apply ,hook args)))
+ (if (eq? val #<unspecified>) ; hook did not do anything
+ (apply error args) ; so re-raise the error
+ val)))))
+
+ (let ((a-hook (make-hook 'error-type :rest 'error-info)))
+ (set! (hook-functions a-hook)
+ (list (lambda (hook)
+ ;(format-logged #t "hooked-catch: ~A~%" (apply format #t (car (hook 'error-info))))
+ (set! (hook 'result) 32))))
+ (test (hooked-catch a-hook (abs "hi")) 32)
+
+ (set! (hook-functions a-hook) ())
+
+ (test (catch #t
+ (lambda ()
+ (hooked-catch a-hook (abs "hi")))
+ (lambda args
+ 123))
+ 123)
+ ))
+
+(let ()
+ (define *breaklet* #f)
+ (define *step-hook* (make-hook 'code 'e))
+
+ (define-macro* (trace/break code . break-points)
+ (define (caller tree)
+ (if (pair? tree)
+ (cons
+ (if (pair? (car tree))
+ (if (and (symbol? (caar tree))
+ (procedure? (symbol->value (caar tree))))
+ (if (member (car tree) break-points)
+ `(__break__ ,(caller (car tree)))
+ `(__call__ ,(caller (car tree))))
+ (caller (car tree)))
+ (car tree))
+ (caller (cdr tree)))
+ tree))
+ `(call-with-exit (lambda (__top__) ,(caller code))))
+
+ (define (go . args)
+ (and (let? *breaklet*)
+ (apply (*breaklet* 'go) args)))
+ (define (clear-break)
+ (set! *breaklet* #f))
+ (define-macro (__call__ code)
+ `(*step-hook* ',code (curlet)))
+
+ (define-macro (__break__ code)
+ `(begin
+ (call/cc
+ (lambda (go)
+ (set! *breaklet* (curlet))
+ (__top__ (format #f "break at: ~A~%" ',code))))
+ ,code))
+
+ (set! (hook-functions *step-hook*)
+ (list (lambda (hook)
+ (set! (hook 'result) (eval (hook 'code) (hook 'e))))
+ (lambda (hook)
+ (define (uncaller tree)
+ (if (pair? tree)
+ (cons
+ (if (and (pair? (car tree))
+ (memq (caar tree) '(__call__ __break__)))
+ (uncaller (cadar tree))
+ (uncaller (car tree)))
+ (uncaller (cdr tree)))
+ tree))
+ (format (current-output-port) ": ~A -> ~A~40T~A~%"
+ (uncaller (hook 'code))
+ (hook 'result)
+ (if (and (not (eq? (hook 'e) (rootlet)))
+ (not (defined? '__top__ (hook 'e))))
+ (map values (hook 'e))
+ "")))))
+
+ (let ((str (with-output-to-string
+ (lambda ()
+ (trace/break (let ((a (+ 3 1)) (b 2)) (if (> (* 2 a) b) 2 3)))))))
+ (test (or (string=? str ": (+ 3 1) -> 4
+: (* 2 a) -> 8 ((a . 4) (b . 2))
+: (> (* 2 a) b) -> #t ((a . 4) (b . 2))
+")
+ (string=? str ": (+ 3 1) -> 4
+: (* 2 a) -> 8 ((b . 2) (a . 4))
+: (> (* 2 a) b) -> #t ((b . 2) (a . 4))
+")) #t)))
@@ -6962,6 +11952,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (hash-table-ref ht "123") #f)
(let ((ht1 (copy ht)))
(test (hash-table? ht1) #t)
+ (test (iterator? ht1) #f)
+ (test (iterator? (make-iterator ht1)) #t)
(test (= (length ht) (length ht1)) #t)
(test (equal? ht ht1) #t)
(test (eq? ht ht) #t)
@@ -6975,59 +11967,205 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (ht 123) 43)
(set! (ht "123") 45)
(test (ht 123) 43)
- (test (ht "123") 45))
+ (test (ht "123") 45)
+ (test (hash-table-set! ht "1" 1) 1)
+ (test (set! (ht "2") 1) 1)
+ (test (set! (hash-table-ref ht "3") 1) 1)
+ (test (hash-table-ref ht "3") 1))
(test (let () (set! (hash-table-ref ht 'key) 32) (hash-table-ref ht 'key)) 32)
(for-each
(lambda (arg)
(test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
(for-each
(lambda (arg)
+ (test (iterator? arg) #f)
(test (hash-table-set! arg 'key 32) 'error))
- (list "hi" '() -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((ht1 (make-hash-table 31))
+ (ht2 (make-hash-table 31)))
+ (if (not (equal? ht1 ht2))
+ (format-logged #t ";ht1 and ht2 are empty, but not equal??~%"))
+
+ ;; these 1st tests take advantage of s7's hashing function
+ (hash-table-set! ht1 'abc 1)
+ (hash-table-set! ht1 'abcabc 2)
+ (hash-table-set! ht1 'abcabcabc 3)
+ (hash-table-set! ht2 'abcabcabc 3)
+ (hash-table-set! ht2 'abcabc 2)
+ (hash-table-set! ht2 'abc 1)
+ (if (not (equal? ht1 ht2))
+ (format-logged #t ";ht1 and ht2 have the same key value pairs, but are not equal??~%"))
+
+ (test (make-hash-table 1 (call-with-exit (lambda (goto) goto))) 'error)
+
+ (set! ht2 (make-hash-table 31))
+ (hash-table-set! ht2 'abc 1)
+ (hash-table-set! ht2 'abcabc 2)
+ (hash-table-set! ht2 'abcabcabc 3)
+ (if (not (equal? ht1 ht2))
+ (format-logged #t ";ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%"))
+
+ (hash-table-set! ht2 'abc "1")
+ (if (equal? ht1 ht2)
+ (format-logged #t ";ht1 and ht2 are equal but values are not~%"))
+ (hash-table-set! ht2 'abc 1)
+ (if (not (equal? ht1 ht2))
+ (format-logged #t ";after reset ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%"))
+ (hash-table-set! ht2 1 'abc)
+ (if (equal? ht1 ht2)
+ (format-logged #t ";ht1 and ht2 are equal but entries are not~%"))
+ (hash-table-set! ht1 1 'abc)
+ (if (not (equal? ht1 ht2))
+ (format-logged #t ";after add ht1 and ht2 have the same key value pairs, but are not equal??~%"))
+
+ ;; these should force chaining in any case
+ (set! ht1 (make-hash-table 31))
+ (set! ht2 (make-hash-table 60))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (hash-table-set! ht1 i (* i 2))
+ (hash-table-set! ht2 i (* i 2)))
+ (if (not (equal? ht1 ht2))
+ (format-logged #t ";ht1 and ht2 have the same (integer) key value pairs in the same order, but are not equal??~%"))
+
+ (let ((h1 (hash-table* "a" 1))
+ (h2 (hash-table* 'a 1)))
+ (set! (h2 "a") 1)
+ (set! (h2 'a) #f)
+ test (equal? h1 h2) #t)
+
+ (let ((ht (make-hash-table)))
+ (set! (ht (expt 2 40)) 40)
+ (set! (ht (expt 2 50)) 50)
+ (set! (ht (- (expt 2 60))) -60) ; these all hash into 0 unfortunately -- maybe fold halves?
+ (test (ht (expt 2 40)) 40)
+ (test (ht (expt 2 50)) 50)
+ (test (ht (expt 2 60)) #f)
+ (test (ht (- (expt 2 60))) -60)
+ (test (ht (expt 2 41)) #f))
+
+ (set! ht2 (make-hash-table 31))
+ (do ((i 99 (- i 1)))
+ ((< i 0))
+ (hash-table-set! ht2 i (* i 2)))
+ (test (hash-table-entries ht2) 100)
+ (if (not (equal? ht1 ht2))
+ (format-logged #t ";ht1 and ht2 have the same (integer) key value pairs, but are not equal??~%"))
+
+ (fill! ht1 ())
+ (test (hash-table-entries ht1) 100)
+ (test (ht1 32) ()))
+
+(let ((h (make-hash-table)))
+ (test (hash-table-entries h) 0)
+ (set! (h 'a) 1)
+ (test (hash-table-entries h) 1)
+ (set! (h 'a) #f)
+ (test (hash-table-entries h) 0))
+
+(let ((ht (make-hash-table))
+ (l1 '(x y z))
+ (l2 '(y x z)))
+ (set! (hash-table-ref ht 'x) 123)
+ (define (hi)
+ (hash-table-ref ht (cadr l1))) ; 123
+ (test (hi) #f))
+
+(test (make-hash-table most-positive-fixnum) 'error)
+;(test (make-hash-table (+ 1 (expt 2 31))) 'error) ; out-of-memory error except in clang
+(test (make-hash-table most-negative-fixnum) 'error)
+(test (make-hash-table 21 eq? 12) 'error)
+(test (make-hash-table 21 12) 'error)
+(test (make-hash-table eq? eq?) 'error)
+(test (make-hash-table eq? eq? 12) 'error)
+(test (make-hash-table ()) 'error)
+(test (make-hash-table 3 ()) 'error)
+(test (make-hash-table eq? ()) 'error)
+(test (make-hash-table 0) 'error)
+(test (make-hash-table -4) 'error)
+(for-each
+ (lambda (arg)
+ (test (make-hash-table arg) 'error))
+ (list "hi" #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((ht (hash-table* :a 1/0)))
+ (test (nan? (ht :a)) #t)
+ (set! (ht 1/0) :a)
+ (test (ht 1/0) :a)) ; is this just by chance?
+
+(let ((ht (make-hash-table)))
+ (define (f1) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i #t)))
+ (f1)
+ (test (hash-table-entries ht) 100)
+ (set! ht (make-hash-table))
+ (define (f2) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i 0)))
+ (f2)
+ (test (hash-table-entries ht) 100)
+ (set! ht (make-hash-table))
+ (define (f3) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i i)))
+ (f3)
+ (test (hash-table-entries ht) 100))
+
+(let ((ht (make-hash-table)))
+ (define (f1) (do ((i 0 (+ i 1))) ((= i 1000)) (hash-table-set! ht i #t)))
+ (f1)
+ (test (hash-table-entries ht) 1000))
(let ((hi (make-hash-table 7)))
- (test (object->string hi) "#<hash-table>")
+ (test (object->string hi) "(hash-table)")
(set! (hi 1) "1")
- (test (object->string hi) "#<hash-table (1 . \"1\")>")
+ (test (object->string hi) "(hash-table '(1 . \"1\"))")
(set! (hi -1) "-1")
- (test (object->string hi) "#<hash-table (-1 . \"-1\") (1 . \"1\")>")
+ (test (or (string=? (object->string hi) "(hash-table '(-1 . \"-1\") '(1 . \"1\"))")
+ (string=? (object->string hi) "(hash-table '(1 . \"1\") '(-1 . \"-1\"))"))
+ #t)
(set! (hi 9) "9")
- (test (object->string hi) "#<hash-table (9 . \"9\") (-1 . \"-1\") (1 . \"1\")>")
+ (test (or (string=? (object->string hi) "(hash-table '(9 . \"9\") '(-1 . \"-1\") '(1 . \"1\"))")
+ (string=? (object->string hi) "(hash-table '(9 . \"9\") '(1 . \"1\") '(-1 . \"-1\"))"))
+ #t)
(set! (hi -9) "-9")
- (test (object->string hi) "#<hash-table (-9 . \"-9\") (9 . \"9\") (-1 . \"-1\") (1 . \"1\")>")
+ (test (or (string=? (object->string hi) "(hash-table '(-9 . \"-9\") '(9 . \"9\") '(-1 . \"-1\") '(1 . \"1\"))")
+ (string=? (object->string hi) "(hash-table '(9 . \"9\") '(1 . \"1\") '(-9 . \"-9\") '(-1 . \"-1\"))"))
+ #t)
(test (hi 1) "1")
+ (test (hi -1) "-1")
(test (hi -9) "-9")
(set! (hi 2) "2")
- (test (object->string hi) "#<hash-table (-9 . \"-9\") (9 . \"9\") (-1 . \"-1\") (1 . \"1\") (2 . \"2\")>")
-
- (let ((old-plen *vector-print-length*))
- (set! *vector-print-length* 3)
- (test (object->string hi) "#<hash-table (-9 . \"-9\") (9 . \"9\") (-1 . \"-1\") ...>")
- (set! *vector-print-length* 0)
- (test (object->string hi) "#<hash-table ...>")
- (test (object->string (hash-table)) "#<hash-table>")
- (set! *vector-print-length* old-plen))
+ (test (or (string=? (object->string hi) "(hash-table '(-9 . \"-9\") '(9 . \"9\") '(-1 . \"-1\") '(1 . \"1\") '(2 . \"2\"))")
+ (string=? (object->string hi) "(hash-table '(9 . \"9\") '(1 . \"1\") '(2 . \"2\") '(-9 . \"-9\") '(-1 . \"-1\"))"))
+ #t)
+ (let ((old-plen (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 3)
+ (test (or (string=? (object->string hi) "(hash-table '(-9 . \"-9\") '(9 . \"9\") '(-1 . \"-1\") ...)")
+ (string=? (object->string hi) "(hash-table '(9 . \"9\") '(1 . \"1\") '(2 . \"2\") ...)"))
+ #t)
+ (set! (*s7* 'print-length) 0)
+ (test (object->string hi) "(hash-table ...)")
+ (test (object->string (hash-table)) "(hash-table)")
+ (set! (*s7* 'print-length) old-plen))
)
(let ((ht (make-hash-table 277)))
(test (hash-table? ht) #t)
- (test (>= (hash-table-size ht) 277) #t)
+ (test (>= (length ht) 277) #t)
+ (test (hash-table-entries ht) 0)
(test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14)
(test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14)
(for-each
(lambda (arg)
(test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))))
(for-each
(lambda (arg)
(test (hash-table? arg) #f))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
-(test (hash-table? (make-vector 3 '())) #f)
+(test (hash-table? (make-vector 3 ())) #f)
(test (let ((ht (make-hash-table))) (set! (ht 'a) 123) (map values ht)) '((a . 123)))
(let ((ht (make-hash-table)))
@@ -7043,17 +12181,68 @@ zzy" (lambda (p) (eval (read p))))) 32)
(hash-table-set! ht 'asd 1234)
(test (hash-table-ref ht 'asd) 1234))
+(let ((ht (make-hash-table)))
+ (define (ht-add h)
+ (+ (h 1) (h 2)))
+ (hash-table-set! ht 1 2)
+ (hash-table-set! ht 2 3)
+ (test (ht-add ht) 5))
+
+(let ((let1 (inlet 'a 1))
+ (let2 (inlet 'a 1))
+ (let3 (inlet 'a 2))
+ (let4 (inlet 'b 1))
+ (let5 (inlet 'a 2 'a 1)))
+ (test (equal? let1 let2) #t)
+ (test (equal? let1 let3) #f)
+ (test (equal? let1 let5) #t)
+ (let ((hash1 (hash-table* let1 32)))
+ (test (integer? (hash1 let1)) #t)
+ (test (integer? (hash1 let2)) #t)
+ (test (integer? (hash1 let3)) #f)
+ (test (integer? (hash1 let4)) #f)
+ (test (integer? (hash1 let5)) #t)))
+
+(test ((hash-table* 1.5 #t #f #t) #f) #t) ; this is checking hash_float if debugging
+(test ((hash-table* 1.5 #t 1 #t) 1) #t)
+
+(let ((let1 (inlet 'a 1 'b 2))
+ (let2 (inlet 'b 2 'a 1))
+ (let3 (inlet 'a 1 'b 1)))
+ (test (equal? let1 let2) #t)
+ (let ((hash1 (hash-table* let1 32)))
+ (test (integer? (hash1 let1)) #t)
+ (test (integer? (hash1 let2)) #t)
+ (test (integer? (hash1 let3)) #f)))
+
+(let ((hash1 (hash-table* 'a 1 'b 2))
+ (hash2 (hash-table* 'b 2 'a 1)))
+ (test (equal? hash1 hash2) #t)
+ (let ((hash3 (hash-table* hash1 32)))
+ (test (integer? (hash3 hash1)) #t)
+ (test (integer? (hash3 hash2)) #t)))
+
+(let ((hash1 (hash-table* 'b 2 'a 1)))
+ (let ((hash2 (make-hash-table (* (length hash1) 2))))
+ (set! (hash2 'a) 1)
+ (set! (hash2 'b) 2)
+ (test (equal? hash1 hash2) #t)
+ (let ((hash3 (make-hash-table (* 2 (length hash2)))))
+ (set! (hash3 hash1) 32)
+ (test (integer? (hash3 hash1)) #t)
+ (test (integer? (hash3 hash2)) #t))))
+
(for-each
(lambda (arg)
(test (hash-table-ref arg 'key) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(let ((ht1 (make-hash-table 653))
(ht2 (make-hash-table 277)))
- (test (equal? ht1 ht2) #f)
+ (test (equal? ht1 ht2) #t) ; equal? because both are empty
(hash-table-set! ht1 'key 'hiho)
(hash-table-set! ht2 (hash-table-ref ht1 'key) 3.14)
- (test (>= (hash-table-size ht1) 653) #t)
+ (test (>= (length ht1) 653) #t)
(test (hash-table-ref ht2 'hiho) 3.14)
(test (hash-table-ref ht2 (hash-table-ref ht1 'key)) 3.14))
@@ -7063,6 +12252,67 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (ht2 1) ht1)
(test ((ht2 1) 1) 'hi)))
+(let ((ht1 (make-hash-table)))
+ (set! (ht1 1/0) "NaN!")
+ (let ((nan 1/0))
+ (test (ht1 nan) "NaN!")
+ (set! (ht1 nan) 0)
+ (test (ht1 nan) 0)
+ (if (not with-windows)
+ (test (object->string ht1) "(hash-table '(nan.0 . 0))"))))
+
+(if (not with-bignums)
+ (let ((ht1 (make-hash-table)))
+ (set! (ht1 1) "1")
+ (set! (ht1 1.0) "1.0")
+ (test (ht1 1) "1")
+ (set! (ht1 1/0) "nan")
+ (test (ht1 0/0) "nan")
+ (set! (ht1 (/ (log 0) (log 0))) "nan-nani")
+ (test (ht1 (/ (log 0) (log 0))) "nan-nani")
+ (test (ht1 (- 0/0)) "nan")
+ (test (ht1 (real-part (/ (log 0) (log 0)))) "nan")
+ (test (ht1 (complex 0/0 1/0)) "nan-nani")
+ (set! (ht1 (real-part (log 0))) "-inf")
+ (test (ht1 (real-part (log 0))) "-inf")
+ (set! (ht1 (- (real-part (log 0)))) "inf")
+ (test (ht1 (- (real-part (log 0)))) "inf")
+ (set! (ht1 (log 0)) "log(0)")
+ (test (ht1 (log 0)) "log(0)")
+ (set! (ht1 (complex 80143857/25510582 1)) "pi+i")
+ (test (ht1 (complex pi (- 1.0 1e-16))) "pi+i")))
+
+(let ((ht (make-hash-table)))
+ (set! (ht (string #\a #\null #\b)) 1)
+ (test (ht (string #\a #\null #\b)) 1)
+ (test (ht (string #\a)) #f)
+ (set! (ht (string #\a #\null #\b)) 12)
+ (test (ht (string #\a #\null #\b)) 12)
+ (fill! ht #f)
+ (test (hash-table-entries ht) 0)
+ (set! (ht #u8(3 0 21)) 1)
+ (test (ht #u8(3 0 21)) 1))
+
+(let ((ht (hash-table* 'a #t)))
+ (test (hash-table-entries ht) 1)
+ (do ((i 0 (+ i 1))) ((= i 10)) (set! (ht 'a) #f) (set! (ht 'a) #t))
+ (test (hash-table-entries ht) 1))
+
+(when with-bignums
+ (let ((ht (make-hash-table)))
+ (set! (ht pi) 1)
+ (test (ht pi) 1)
+ (set! (ht (bignum "1")) 32)
+ (test (ht (bignum "1")) 32)
+ (set! (ht (/ (bignum "11") (bignum "3"))) 12)
+ (test (ht (/ (bignum "11") (bignum "3"))) 12)
+ (set! (ht (bignum "1+i")) -1)
+ (test (ht (bignum "1+i")) -1)
+ (set! (ht 3) 2)
+ (test (ht 3) 2)
+ (set! (ht 3.0) 3)
+ (test (ht 3.0) 3)))
+
(test (hash-table?) 'error)
(test (hash-table? 1 2) 'error)
@@ -7079,68 +12329,98 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (hash-table-set! ht) 'error)
(test (hash-table-set! ht #\a) 'error)
(test (hash-table-set! ht #\a #\b #\c) 'error)
- (test (fill! ht 123) 'error)
+ (set! (ht 'key) 32)
+ (test (fill! ht 123) 123)
+ (test (ht 'key) 123)
(set! (ht 'key) 32)
(test (ht 'key) 32)
(set! (ht :key) 123)
(test (ht 'key) 32)
(test (ht :key) 123)
- (fill! ht '())
- (test (ht 'key) #f))
+ (fill! ht ())
+ (test (ht 'key) ()))
(let ((ht (make-hash-table)))
(test (hash-table-set! ht #\a 'key) 'key)
(for-each
(lambda (arg)
(test (hash-table-set! ht arg 3.14) 3.14))
- (list #\a '#(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list #\a #(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (hash-table-ref ht arg) 3.14))
- (list #\a '#(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
- (test (hash-table-size ht 123) 'error))
+ (list #\a #(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (test (length ht 123) 'error))
(for-each
(lambda (arg)
- (test (hash-table-size arg) 'error))
- (list "hi" -1 0 #\a 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
-(test (hash-table-size) 'error)
-
-(for-each
- (lambda (arg)
- (test (make-hash-table arg) 'error)
- (test (make-hash-table-iterator arg) 'error))
- (list "hi" -1 0 #\a 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (test (make-hash-table arg) 'error))
+ (list "hi" -1 0 #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(let ()
(define ht (make-hash-table))
(set! (ht 123) "123")
(set! (ht 456) "456")
- (define hti (make-hash-table-iterator ht))
+ (define hti (make-iterator ht))
+ (test (iterator? hti) #t)
+ (test (object->string hti) "#<iterator: hash-table>")
+ (test (equal? hti hti) #t)
+ (test (eq? hti hti) #t)
+ (test (eqv? hti hti) #t)
+ (test (morally-equal? hti hti) #t)
+
+ (let ((hti2 hti))
+ (test (equal? hti2 hti) #t)
+ (test (morally-equal? hti2 hti) #t)
+ (set! hti2 (copy hti))
+ (test (equal? hti2 hti) #t)
+ (test (morally-equal? hti2 hti) #t)
+ (test (let ((val (hti2))) (or (equal? val '(123 . "123")) (equal? val '(456 . "456")))) #t) ; order depends on table size
+ (test (equal? hti2 hti) #f)
+ (test (morally-equal? hti2 hti) #f)
+ )
+
(let ((vals (list (hti) (hti))))
(if (not (equal? (sort! vals (lambda (a b) (< (car a) (car b)))) '((123 . "123") (456 . "456"))))
- (format #t ";hash-table-iterator: ~A~%" vals))
+ (format-logged #t ";iterator: ~A~%" vals))
(let ((val (hti)))
- (if (not (null? val))
- (format #t ";hash-table-iterator at end: ~A~%" val)))
+ (if (not (eof-object? val))
+ (format-logged #t ";iterator at end: ~A~%" val)))
(let ((val (hti)))
- (if (not (null? val))
- (format #t ";hash-table-iterator at end (2): ~A~%" val)))))
+ (if (not (eof-object? val))
+ (format-logged #t ";iterator at end (2): ~A~%" val)))))
-(test (make-hash-table-iterator) 'error)
-(test (make-hash-table-iterator (make-hash-table) 1) 'error)
+(test (make-iterator) 'error)
+(test (make-iterator (make-hash-table) 1) 'error)
+(test (iterator?) 'error)
+(test (iterator? 1 2) 'error)
+
+(let ()
+ (define (get-iter)
+ (let ((ht (hash-table '(a . 1) '(b . 2))))
+ (test (hash-table-entries ht) 2)
+ (make-iterator ht)))
+ (let ((hti (get-iter)))
+ (gc)
+ (let ((a (hti)))
+ (let ((b (hti)))
+ (let ((c (hti)))
+ (test (let ((lst (list a b c)))
+ (or (equal? lst '((a . 1) (b . 2) #<eof>))
+ (equal? lst '((b . 2) (a . 1) #<eof>))))
+ #t))))))
(let ((ht1 (make-hash-table))
(ht2 (make-hash-table)))
(test (equal? ht1 ht2) #t)
- (test (equal? ht1 (make-vector (hash-table-size ht1) '())) #f)
+ (test (equal? ht1 (make-vector (length ht1) ())) #f)
(hash-table-set! ht1 'key 'hiho)
(test (equal? ht1 ht2) #f)
(hash-table-set! ht2 'key 'hiho)
(test (equal? ht1 ht2) #t)
- (hash-table-set! ht1 'a '())
- (test (ht1 'a) '())
+ (hash-table-set! ht1 'a ())
+ (test (ht1 'a) ())
)
(let ((ht (make-hash-table 1)))
@@ -7149,34 +12429,62 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (>= (length ht) 1) #t))
(let ((ht (hash-table '("hi" . 32) '("ho" . 1))))
+ (test (hash-table-entries ht) 2)
+ (test (ht "hi") 32)
+ (test (ht "ho") 1))
+
+(let ((ht (hash-table* "hi" 32 "ho" 1)))
+ (test (hash-table-entries ht) 2)
(test (ht "hi") 32)
(test (ht "ho") 1))
(let ((ht (hash-table)))
(test (hash-table? ht) #t)
- (test (>= (length ht) 461) #t)
+ (test (>= (length ht) 1) #t)
+ (test (ht 1) #f))
+
+(let ((ht (hash-table*)))
+ (test (hash-table? ht) #t)
+ (test (>= (length ht) 1) #t)
(test (ht 1) #f))
(for-each
(lambda (arg)
- (test (hash-table arg) 'error))
- (list "hi" -1 0 #\a 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
+ (test (hash-table arg) 'error)
+ (test (hash-table* arg) 'error)
+ (test ((hash-table* 'a arg) 'a) arg)
+ (test ((hash-table* arg 'a) arg) 'a))
+ (list "hi" -1 0 #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
+
+(let ((ht (make-hash-table))
+ (lst (list 1)))
+ (set-cdr! lst lst)
+ (set! (ht lst) lst)
+ (let ((lst1 (list 1 2)))
+ (set-cdr! (cdr lst1) lst1)
+ (set! (ht lst1) lst1)
+ (test (ht lst) lst)
+ (test (ht lst1) lst1)
+ (test (or (string=? (object->string ht) "(hash-table '(#1=(1 2 . #1#) . #1#) '(#2=(1 . #2#) . #2#))")
+ (string=? (object->string ht) "(hash-table '(#1=(1 . #1#) . #1#) '(#2=(1 2 . #2#) . #2#))"))
+ #t)))
(test (set! (hash-table) 1) 'error)
+(test (set! (hash-table*) 1) 'error)
(test (set! (make-hash-table) 1) 'error)
;; no null hash-tables?
(let ((ht (make-hash-table)))
- (test (map (lambda (x) x) ht) '())
+ (test (map (lambda (x) x) ht) ())
(test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 0)
- (test (map (lambda (x y) (cons x y)) (list 1 2 3) ht) '())
- (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) #(1 2 3) ht) ctr) 0)
- (test (map (lambda (x y) (cons x y)) ht "123") '())
- (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht '()) ctr) 0)
+ (test (map (lambda (x y) (cons x y)) (list 1 2 3) ht) ())
+ ;(test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) #(1 2 3) ht) ctr) 0) ; this is now an error 15-Jan-15
+ (test (map (lambda (x y) (cons x y)) ht "123") ())
+ (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht ()) ctr) 'error) ; 2 args
(let ((rt (reverse ht)))
- (test (map (lambda (x) x) rt) '())
+ (test (map (lambda (x) x) rt) ())
(test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) rt) ctr) 0))
(set! (ht 1) 32)
@@ -7184,7 +12492,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (sort! (map (lambda (x) (cdr x)) ht) <) '(32))
(test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 1)
- (test (map (lambda (x y) (cons x y)) '() ht) '())
+ (test (map (lambda (x y) (cons x y)) () ht) ())
(test (let ((ctr 0)) (for-each (lambda (x y) (set! ctr (+ ctr 1))) ht "") ctr) 0)
(test (sort! (map (lambda (x y) (max (cdr x) y)) ht (list 1 2 3)) <) '(32))
(test (let ((ctr 0)) (for-each (lambda (x y) (set! ctr (max (cdr x) y))) ht #(1 2 3)) ctr) 32)
@@ -7215,6 +12523,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (sort! (map (lambda (x y) (max x (cdr y))) (list -1 -2 -3 -4) ht) <) '(1 32 123))
(test (let ((sum 0)) (for-each (lambda (x y) (set! sum (+ sum x (cdr y)))) #(10 20 30) ht) sum) 216)
+
(let ((rt (reverse ht)))
(for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht))
@@ -7238,11 +12547,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (rt 123) 321)
(test (ht 3) 123))
- (fill! ht '())
+ (fill! ht 0)
(set! (ht "hi") 1)
(set! (ht "hoi") 2)
- (test (sort! (map (lambda (x) (cdr x)) ht) <) '(1 2))
- (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 2)
+ (test (sort! (map (lambda (x) (cdr x)) ht) <) '(0 0 0 0 1 2))
+ (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 6)
(let ((rt (reverse ht)))
(test (rt 2) "hoi")
@@ -7253,21 +12562,42 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (ht #\a) #\b)
(test (ht "hi") 1)
- (fill! ht '())
+ (set! ht (hash-table))
(set! (ht #(1)) #(2))
(test (ht #(1)) #(2))
(set! (ht '(1)) '(3))
(set! (ht "1") "4")
- (set! (ht ht) "5")
- (test (ht ht) "5")
+ ;(set! (ht ht) "5")
+ ;(test (ht ht) "5")
(test (ht '(1)) '(3))
- (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 4)
+ (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 3)
(let ((rt (reverse ht)))
- (test (rt "5") ht)
- (for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht))
+ ;(test (rt "5") ht)
+ (test (rt "4") "1")
+ (for-each (lambda (x)
+ (test (ht (rt (cdr x))) (cdr x))
+ (test (rt (ht (car x))) (car x)))
+ ht))
)
+(let ((ht (make-hash-table)))
+ (let ((str (string (integer->char 255)))
+ (u8 #u8(254 0))
+ (rl 1e18)
+ (int most-negative-fixnum)
+ (rat (/ 1 most-negative-fixnum)))
+ (set! (ht str) 1)
+ (set! (ht u8) 2)
+ (set! (ht rl) 3)
+ (set! (ht int) 4)
+ (set! (ht rat) 5)
+ (test (ht str) 1)
+ (test (ht u8) 2)
+ (test (ht rl) 3)
+ (test (ht int) 4)
+ (test (ht rat) 5)))
+
(let ((ht1 (make-hash-table 32))
(ht2 (make-hash-table 1024)))
(do ((i 0 (+ i 1)))
@@ -7279,27 +12609,30 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (a b)
(if (not (equal? (string->number (car a)) (cdr a)))
- (format #t ";hash-table for-each (str . i): ~A?~%" a))
+ (format-logged #t ";hash-table for-each (str . i): ~A?~%" a))
(if (not (equal? (number->string (car b)) (cdr b)))
- (format #t ";hash-table for-each (i . str): ~A?~%" b))
+ (format-logged #t ";hash-table for-each (i . str): ~A?~%" b))
(set! cases (+ cases 1)))
ht1 ht2)
(if (not (= cases 256))
- (format #t ";hash-table for-each cases: ~A~%" cases)))
- (let ((iter1 (make-hash-table-iterator ht1))
- (iter2 (make-hash-table-iterator ht2)))
+ (format-logged #t ";hash-table for-each cases: ~A~%" cases)))
+ (let ((iter1 (make-iterator ht1))
+ (iter2 (make-iterator ht2)))
+ (test (equal? iter1 iter2) #f)
+ (test (morally-equal? iter1 iter2) #f)
+ (test (iterator? iter2) #t)
(let ((cases 0))
(do ((a (iter1) (iter1))
(b (iter2) (iter2)))
- ((or (null? a)
- (null? b)))
+ ((or (eof-object? a)
+ (eof-object? b)))
(if (not (equal? (string->number (car a)) (cdr a)))
- (format #t ";hash-table iter1 (str . i): ~A?~%" a))
+ (format-logged #t ";hash-table iter1 (str . i): ~A?~%" a))
(if (not (equal? (number->string (car b)) (cdr b)))
- (format #t ";hash-table iter2 (i . str): ~A?~%" b))
+ (format-logged #t ";hash-table iter2 (i . str): ~A?~%" b))
(set! cases (+ cases 1)))
(if (not (= cases 256))
- (format #t ";hash-table iter1/2 cases: ~A~%" cases)))))
+ (format-logged #t ";hash-table iter1/2 cases: ~A~%" cases)))))
(let ((ht (make-hash-table 31)))
(let ((ht1 (make-hash-table 31)))
@@ -7309,6 +12642,56 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (hash-table-ref ht 'a0 'a1) 'b1)
(test (ht 'a0 'a1) 'b1)))
+(let ((ht (make-hash-table 31))
+ (e (curlet)))
+ (define (a-func a) (+ a 1))
+ (define-macro (a-macro a) `(+ 1 , a))
+ (define (any-func a) (let ((x a)) (lambda () x)))
+
+ (set! (ht abs) 1)
+ (set! (ht begin) 2)
+ (set! (ht quasiquote) 3)
+ (set! (ht a-func) 4)
+ (set! (ht a-macro) 5)
+ (set! (ht (any-func 6)) 6)
+ (set! (ht e) 7)
+ (test (ht e) 7)
+ (set! (ht (rootlet)) 8)
+ (test (ht abs) 1)
+ (test (ht round) #f)
+ (test (ht quasiquote) 3)
+ (test (ht begin) 2)
+ (test (ht lambda) #f)
+ (test (ht a-func) 4)
+ (test (ht a-macro) 5)
+ (test (ht (any-func 6)) #f)
+ (test (ht (rootlet)) 8)
+ (call-with-exit
+ (lambda (return)
+ (set! (ht return) 9)
+ (test (ht return) 9)))
+ ;(set! (ht ht) 10)
+ ;(test (ht ht) 10)
+ )
+
+
+(test (let ((h1 (hash-table '(a . 1) '(b . 2))) (h2 (make-hash-table 31))) (set! (h2 'a) 1) (set! (h2 'b) 2.0) (morally-equal? h1 h2)) #t)
+(test (let ((h1 (hash-table '(a . 1) '(b . 2))) (h2 (make-hash-table 31))) (set! (h2 'a) 1.0) (set! (h2 'b) 2) (morally-equal? (list h1) (list h2))) #t)
+
+(test (let ((h1 (hash-table* 'a 1 'b 2)) (h2 (make-hash-table 31))) (set! (h2 'a) 1) (set! (h2 'b) 2.0) (morally-equal? h1 h2)) #t)
+(test (let ((h1 (hash-table* 'a 1 'b 2)) (h2 (make-hash-table 31))) (set! (h2 'a) 1.0) (set! (h2 'b) 2) (morally-equal? (list h1) (list h2))) #t)
+
+;(test (let ((ht (make-hash-table))) (hash-table-set! ht ht 1) (ht ht)) #f)
+; this is #f now because the old ht is not equal to the new one (different number of entries)
+;(test (let ((ht (make-hash-table))) (hash-table-set! ht ht ht) (equal? (ht ht) ht)) #t)
+
+(test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (object->string ht)) "#1=(hash-table '(a . #1#))")
+(test (let ((h1 (make-hash-table))) (hash-table-set! h1 "hi" h1) (object->string h1)) "#1=(hash-table '(\"hi\" . #1#))")
+(test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (morally-equal? ht (copy ht))) #t)
+(test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (equal? ht (copy ht))) #t)
+
+(test (hash-table 'a 1 'b) 'error)
+
;; there's no real need for multidim hashes:
(let ((ht (make-hash-table)))
@@ -7318,7 +12701,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (ht '(a . 1)) 'b)
(test (ht '(b . 1)) 'd)
(set! (ht '(a . 2)) 32)
- (test (ht '(a . 2)) 32))
+ (test (ht '(a . 2)) 32)
+ (let ((lst1 (list 1))
+ (lst2 (list 1)))
+ (set-car! lst1 lst2)
+ (set-car! lst2 lst1)
+ (set! (ht lst1) 32)
+ (set! (ht lst2) 3)
+ (test (equal? lst1 lst2) #t)
+ (test (ht lst1) 3)
+ (test (ht lst2) 3)))
(let ((ht (make-hash-table)))
(set! (ht 1.0) 'a)
@@ -7334,322 +12726,810 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (ht) 'error)
(test (ht 0 1) 'error))
+(let ((h (hash-table* 'a (hash-table* 'b 2 'c 3)
+ 'b (hash-table* 'b 3 'c 4))))
+ (test (h 'a 'b) 2)
+ (test (h 'b 'b) 3)
+ (test (h 'a 'c) 3))
+
(let ()
(define-macro (memoize f)
`(define ,f (let ((ht (make-hash-table))
(old-f ,f))
(lambda args
- (let ((val (ht args)))
- (if val
- (val 0)
- (let ((new-val (apply old-f args)))
- (set! (ht args) (list new-val))
- new-val)))))))
+ (or (ht args)
+ (let ((new-val (apply old-f args)))
+ (set! (ht args) new-val)
+ new-val))))))
(define (our-abs num) (abs num))
(memoize our-abs)
(num-test (our-abs -1) 1)
- (with-environment (procedure-environment our-abs)
- (test (ht '(-1)) '(1))))
+ (with-let (funclet our-abs)
+ (test (ht '(-1)) 1)))
+(let ()
+ (define-macro (define-memoized name&arg . body)
+ (let ((arg (cadr name&arg))
+ (memo (gensym "memo")))
+ `(define ,(car name&arg)
+ (let ((,memo (make-hash-table)))
+ (lambda (,arg)
+ (or (,memo ,arg)
+ (set! (,memo ,arg) (begin , at body))))))))
+
+ (define-memoized (f1 abc) (+ abc 2))
+ (test (f1 3) 5)
+ (test (f1 3) 5)
+ (test (f1 2) 4)
+ (let ((ht (call-with-exit
+ (lambda (return)
+ (for-each (lambda (x)
+ (if (hash-table? (cdr x))
+ (return (cdr x))))
+ (outlet (funclet f1)))
+ #f))))
+ (if (not (hash-table? ht))
+ (format-logged #t ";can't find memo? ~A~%" (let->list (outlet (funclet f1))))
+ (test (length (map (lambda (x) x) ht)) 2))))
-(test (error) 'error)
-(test (let ((x 1))
- (let ((val (catch #\a
- (lambda ()
- (set! x 0)
- (error #\a "an error")
- (set! x 2))
- (lambda args
- (if (equal? (car args) #\a)
- (set! x (+ x 3)))
- x))))
- (= x val 3)))
- #t)
-(test (let ((x 1))
- (let ((val (catch 32
- (lambda ()
- (catch #\a
- (lambda ()
- (set! x 0)
- (error #\a "an error: ~A" (error 32 "another error!"))
- (set! x 2))
- (lambda args
- (if (equal? (car args) #\a)
- (set! x (+ x 3)))
- x)))
- (lambda args
- (if (equal? (car args) 32)
- (set! x (+ x 30)))))))
- (= x val 30)))
- #t)
+(let ()
+ (define-macro (define-memoized name&args . body)
+ (let ((args (cdr name&args))
+ (memo (gensym "memo")))
+ `(define ,(car name&args)
+ (let ((,memo (make-hash-table)))
+ (lambda ,args
+ (or (,memo (list , at args))
+ (set! (,memo (list , at args)) (begin , at body))))))))
+
+ (define (ack m n)
+ (cond ((= m 0) (+ n 1))
+ ((= n 0) (ack (- m 1) 1))
+ (else (ack (- m 1) (ack m (- n 1))))))
+
+ (define-memoized (ack1 m n)
+ (cond ((= m 0) (+ n 1))
+ ((= n 0) (ack1 (- m 1) 1))
+ (else (ack1 (- m 1)
+ (ack1 m (- n 1))))))
+
+ (test (ack 2 3) (ack1 2 3)))
-#|
-(let ((old-error-hook (hook-functions *error-hook*))
- (tag #f)
- (args #f))
- (set! (hook-functions *error-hook*)
- (list (lambda (etag eargs)
- (set! tag etag)
- (set! args eargs))))
- (error 'tag 1 2 3)
- (test (and (equal? tag 'tag)
- (equal? args '(1 2 3))))
- (set! (hook-functions *error-hook*) old-error-hook))
-|#
-;;; can't include this because it interrupts the load
+
+(let ((ht (make-hash-table)))
+ (test (eq? (car (catch #t (lambda () (set! (ht) 2)) (lambda args args))) 'wrong-number-of-args) #t)
+ (test (eq? (car (catch #t (lambda () (set! (ht 0 0) 2)) (lambda args args))) 'syntax-error) #t) ; attempt to apply boolean #f to (0)
+ (test (eq? (car (catch #t (lambda () (set! ((ht 0) 0) 2)) (lambda args args))) 'syntax-error) #t))
+(let ()
+ (define (merge-hash-tables . tables)
+ (apply hash-table (apply append (map (lambda (table) (map values table)) tables))))
+ (let ((ht (merge-hash-tables (hash-table '(a . 1) '(b . 2)) (hash-table '(c . 3)))))
+ (test (ht 'c) 3))
+ (test ((append (hash-table '(a . 1) '(b . 2)) (hash-table '(c . 3))) 'c) 3))
+
+;;; test the eq-func business
+
+(let ((ht (make-hash-table 8 eq?)))
+ (test (hash-table-ref ht 'a) #f)
+ (hash-table-set! ht 'a 1)
+ (hash-table-set! ht 'c 'd)
+ (test (hash-table-ref ht 'a) 1)
+ (hash-table-set! ht "hi" 3)
+ (test (hash-table-ref ht "hi") #f)
+ (set! (ht '(a . 1)) "ho")
+ (test (ht '(a . 1)) #f)
+ (let ((ht1 (copy ht)))
+ (test (ht1 'a) 1)
+ (test (ht1 "hi") #f)
+ (set! (ht1 #\a) #\b)
+ (test (ht1 #\a) #\b)
+ (test (ht #\a) #f)
+ (let ((ht2 (reverse ht1)))
+ (test (ht1 #\a) #\b)
+ (test (ht2 #\b) #\a)
+ (test (ht2 'd) 'c)))
+ (do ((i 0 (+ i 1)))
+ ((= i 32))
+ (set! (ht (string->symbol (string-append "g" (number->string i)))) i))
+ (test (ht 'a) 1)
+ (test (ht 'g3) 3)
+ (set! (ht ht) 123)
+ (test (ht ht) 123))
+
+(let ((ht (make-hash-table 31 string=?)))
+ (test (length ht) 32)
+ (set! (ht "hi") 'a)
+ (test (ht "hi") 'a)
+ (test (ht "Hi") #f)
+ (set! (ht 32) 'b)
+ (test (ht 32) #f)
+ )
+(let ((ht (make-hash-table 31 char=?)))
+ (test (length ht) 32)
+ (set! (ht #\a) 'a)
+ (test (ht #\a) 'a)
+ (test (ht #\A) #f)
+ (set! (ht 32) 'b)
+ (test (ht 32) #f)
+ )
+(unless pure-s7
+ (let ((ht (make-hash-table 31 string-ci=?)))
+ (test (length ht) 32)
+ (set! (ht "hi") 'a)
+ (test (ht "hi") 'a)
+ (test (ht "Hi") 'a)
+ (test (ht "HI") 'a)
+ (set! (ht 32) 'b)
+ (test (ht 32) #f)
+ )
+
+ (let ((ht (make-hash-table 31 char-ci=?)))
+ (test (length ht) 32)
+ (set! (ht #\a) 'a)
+ (test (ht #\a) 'a)
+ (test (ht #\A) 'a)
+ (set! (ht 32) 'b)
+ (test (ht 32) #f)
+ ))
-;;; --------------------------------------------------------------------------------
-;;; HOOKS
-;;; --------------------------------------------------------------------------------
+(let ((ht (make-hash-table 31 =)))
+ (test (length ht) 32)
+ (set! (ht 1) 'a)
+ (test (ht 1.0) 'a)
+ (test (ht 1+i) #f)
+ (set! (ht 32) 'b)
+ (test (ht 32) 'b)
+ (set! (ht 1/2) 'c)
+ (test (ht 0.5) 'c)
+ )
-;;; hook?
-;;; hook-arity
-;;; hook-functions
-;;; hook-documentation
-;;; make-hook
-;;; hook-apply
-;;; hook
+(let ((ht (make-hash-table 31 eqv?)))
+ (test (length ht) 32)
+ (set! (ht 1) 'a)
+ (test (ht 1.0) #f)
+ (set! (ht 2.0) 'b)
+ (test (ht 2.0) 'b)
+ (set! (ht 32) 'b)
+ (test (ht 32) 'b)
+ (set! (ht #\a) 1)
+ (test (ht #\a) 1)
+ (set! (ht ()) 2)
+ (test (ht ()) 2)
+ (set! (ht abs) 3)
+ (test (ht abs) 3)
+ )
+
+(let ((ht (make-hash-table 8 (cons string=? (lambda (a) (string-length a))))))
+ (set! (ht "a") 'a)
+ (test (ht "a") 'a)
+ (set! (ht "abc") 'abc)
+ (test (ht "abc") 'abc))
+
+(let ((ht (make-hash-table 8 (cons (lambda (a b) (string=? a b)) string-length))))
+ (set! (ht "a") 'a)
+ (test (ht "a") 'a)
+ (set! (ht "abc") 'abc)
+ (test (ht "abc") 'abc))
+
+(let ((ht (make-hash-table 8 (cons (lambda (a b) (string=? a b)) (lambda (a) (string-length a))))))
+ (set! (ht "a") 'a)
+ (test (ht "a") 'a)
+ (set! (ht "abc") 'abc)
+ (test (ht "abc") 'abc))
+
+(let ((ht (make-hash-table 8 (cons string=? string-length))))
+ (set! (ht "a") 'a)
+ (test (ht "a") 'a)
+ (set! (ht "abc") 'abc)
+ (test (ht "abc") 'abc))
+
+(let ((h (make-hash-table 8 equal?)))
+ (set! (h (make-int-vector 3 0)) 3)
+ (test (h (make-int-vector 3 0)) 3)
+ (test (h (make-vector 3 0)) #f)
+ (test (h (make-float-vector 3 0)) #f)
+ (let ((x 1.0)
+ (y (+ 1.0 (* 0.5 (*s7* 'morally-equal-float-epsilon))))
+ (z (+ 1.0 (* 2 (*s7* 'morally-equal-float-epsilon)))))
+ (set! (h x) 12)
+ (test (h x) 12)
+ ;(test (h y) #f)
+ ;(test (h z) #f)
+ ;default vs explicit equal? here -- sigh
+ ))
+(let ((h (make-hash-table 8 morally-equal?)))
+ (set! (h (make-int-vector 3 0)) 3)
+ (test (h (make-int-vector 3 0)) 3)
+ (test (h (make-vector 3 0)) 3)
+ (test (h (make-float-vector 3 0)) 3)
+ (let ((x 1.0)
+ (y (+ 1.0 (* 0.5 (*s7* 'morally-equal-float-epsilon))))
+ (z (+ 1.0 (* 2 (*s7* 'morally-equal-float-epsilon)))))
+ (set! (h x) 12)
+ (test (h x) 12)
+ (test (h y) 12)
+ (test (h z) #f)
+ (set! (h 1/10) 3)
+ (test (h 0.1) 3)
+ (set! (h #(1 2.0)) 4)
+ (test (h (vector 1 2)) 4)
+ (set! (h 1.0) 5)
+ (test (h 1) 5)
+ (set! (h (list 3)) 6)
+ (test (h (list 3.0)) 6)
+ ))
+
+(when with-block
+ (let ((ht (make-hash-table 31 (cons hash_heq hash_hloc))))
+ (test (length ht) 32)
+ (set! (ht 'a) 'b)
+ (test (ht 'a) 'b)
+ (test (ht 1) #f)
+ (let ((ht1 (reverse ht)))
+ (test (ht1 'b) 'a))
+ ))
+
+(let ((ht (make-hash-table 31 morally-equal?))
+ (ht1 (make-hash-table 31)))
+ (test (length ht) 32)
+ (test (equal? ht ht1) #t)
+ (set! (ht 3) 1)
+ (test (ht 3) 1)
+ (set! (ht1 3) 1)
+ (test (equal? ht ht1) #f)
+ (set! (ht 3.14) 'a)
+ (test (ht 3.14) 'a)
+ (set! (ht "hi") 123)
+ (test (ht "hi") 123)
+ (set! (ht 1/0) #<eof>)
+ (test (ht 1/0) #<eof>))
+
+(let ((ht (make-hash-table 31 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))))
+ (test (hash-table-ref ht 'a) #f)
+ (hash-table-set! ht 'a 1)
+ (hash-table-set! ht 'c 'd)
+ (test (hash-table-ref ht 'a) 1)
+ (hash-table-set! ht "hi" 3)
+ (test (hash-table-ref ht "hi") #f)
+ (set! (ht '(a . 1)) "ho")
+ (test (ht '(a . 1)) #f)
+ (let ((ht1 (copy ht)))
+ (test (ht1 'a) 1)
+ (test (ht1 "hi") #f)
+ (set! (ht1 #\a) #\b)
+ (test (ht1 #\a) #\b)
+ (test (ht #\a) #f)))
+
+(when (provided? 'snd)
+ (let ((ht (make-hash-table 31 (cons equal? mus-type))))
+ (let ((g1 (make-oscil 100))
+ (g2 (make-oscil 100)))
+ (set! (ht g1) 32)
+ (test (ht g1) 32)
+ (test (ht g2) 32)
+ (test (equal? g1 g2) #t))))
+
+
+#|
+(define constants (vector 1)) ; etc -- see tauto.scm
+(define ops (list eq? eqv? equal? morally-equal? = char=? string=? char-ci=? string-ci=?
+ (cons string=? (lambda (a) (string-length a)))
+ (cons (lambda (a b) (string=? a b)) string-length)))
(for-each
- (lambda (arg)
+ (lambda (op)
(for-each
- (lambda (func)
- (let ((val (catch #t (lambda () (func arg)) (lambda args 'error))))
- (if (not (eq? val 'error))
- (format #t ";(~A ~A) got ~A, but expected 'error~%" func arg val))))
- (list hook-arity hook-documentation hook-functions hook hook-apply))
- (test (hook? arg) #f))
- (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #<eof> #<undefined> #<unspecified>))
-
-(let ((h (make-hook '(1 0 #f) "a hook")))
- (test (hook? h) #t)
- (test (hook-functions h) '())
- (test (hook-arity h) '(1 0 #f))
- (test (hook-documentation h) "a hook")
- (test (hook-apply h '(0)) (h 0))
- (let ((f1 (lambda (x) x)))
- (set! (hook-functions h) (list f1))
- (test (member f1 (hook-functions h)) (list f1))
- (test (hook-functions h) (list f1))
- (test (hook-apply h '(1)) (h 1))
- (test (apply (car (hook-functions h)) '(1)) 1)
- (set! (hook-functions h) '())
- (test (hook-functions h) '())
- (test (set! (hook-functions h) (list (lambda (x y) (+ x y)))) 'error)
- (let ((f2 (lambda* args (car args))))
- (set! (hook-functions h) (list f1 f2))
- (test (hook-functions h) (list f1 f2))
- (test (hook-apply h '(23)) (h 23))))
- (for-each
- (lambda (arg)
- (test (set! (hook-functions h) arg) 'error))
- (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #<eof> #<undefined> #<unspecified>)))
-
-(let ((h (make-hook '(1 1 #f))))
- (test (hook? h) #t)
- (test (hook-functions h) '())
- (test (hook-arity h) '(1 1 #f))
- (test (hook-documentation h) "")
- (test (hook-apply h '(0 1)) (h 0 1))
- (let ((f1 (lambda* (x (y 12)) (+ x y))))
- (set! (hook-functions h) (list f1))
- (test (member f1 (hook-functions h)) (list f1))
- (test (hook-functions h) (list f1))
- (test (hook-apply h '(1 2)) (h 1 2))
- (test (apply (car (hook-functions h)) '(1 2)) 3)
- (set! (hook-functions h) '())
- (test (hook-functions h) '())
- (set! (hook-functions h) (list (lambda* ((x 1) (y 2)) (+ x y))))
- (test (hook-apply h '(23)) (h 23))))
+ (lambda (val)
+ (let ((h (make-hash-table 8 op)))
+ (catch #t
+ (lambda ()
+ (set! (h val) #t)
+ (if (not (eq? (h val) (op val val)))
+ (format *stderr* "~A ~A: ~A ~A~%" op val (h val) (op val val))))
+ (lambda any #f))))
+ constants))
+ ops)
+|#
-(let ((h (make-hook)))
- (test (hook? h) #t)
- (test (hook-functions h) '())
- (test (hook-arity h) '(0 0 #f))
- (test (hook-documentation h) "")
- (test (hook-apply h '()) (h))
- (let ((f1 (lambda () 0)))
- (set! (hook-functions h) (list f1))
- (test (member f1 (hook-functions h)) (list f1))
- (test (hook-functions h) (list f1))
- (test (hook-apply h '()) (h))
- (test (apply (car (hook-functions h)) '()) 0)
- (set! (hook-functions h) '())
- (test (hook-functions h) '())))
+(let ()
+ (let ((ht (make-hash-table 31 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))))
+ (hash-table-set! ht 'a 1)
+ (test (ht 'a) 1))
+ (let ((ht (make-hash-table 31 (cons (lambda* (a b) (eq? a b)) (lambda (a) 0)))))
+ (hash-table-set! ht 'a 1)
+ (test (ht 'a) 1))
+ (let ((ht (make-hash-table 31 (cons (lambda* (a (b 0)) (eq? a b)) (lambda (a) 0)))))
+ (hash-table-set! ht 'a 1)
+ (test (ht 'a) 1))
+ (test (let ((ht (make-hash-table 31 (list (eq? a b)))))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error)
+ (test (let ((ht (make-hash-table 31 (cons abs +))))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error)
+ (test (let ((ht (make-hash-table 31 (cons eq? float-vector-ref))))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error)
+ (test (let ((ht (make-hash-table 31 (dilambda (lambda (a) (eq? a b)) (lambda (a) 0)))))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error)
+ (test (let ((ht (make-hash-table 31 (lambda a (eq? car a) (cadr s)))))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error)
+ (test (let ((ht (make-hash-table 31 (cons (lambda (a b c) (eq? a b)) (lambda (a) 0)))))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error)
+ (test (let ((ht (make-hash-table 31 (define-macro (_m_ . args) #f))))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error)
+ (test (let ((ht (make-hash-table 31 abs)))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error)
+ (test (let ((ht (make-hash-table 31 list-set!)))
+ (hash-table-set! ht 'a 1)
+ (ht 'a))
+ 'error))
-(let ((h (hook (lambda x (error 'out-of-hook 32)))))
- (let ((val (catch 'out-of-hook
- (lambda ()
- (h 123)
- (error 'oops "too far"))
- (lambda args args))))
- (if (not (equal? val '(out-of-hook (32))))
- (format #t ";hook error 1: ~A~%" val))
-
- (let ((val (call-with-exit
- (lambda (return)
- (set! (hook-functions h) (list (lambda x (return x))))
- (hook-apply h (list "hi"))
- 123))))
- (if (not (equal? val '("hi")))
- (format #t ";hook error 2: ~A~%" val)))))
-
-(test (make-hook '(1 2 #f) "hi" 3) 'error)
-(let ((h (make-hook)))
- (test (hook-functions) 'error)
- (test (hook-functions h h) 'error)
- (test (hook-arity) 'error)
- (test (hook-arity h h) 'error)
- (test (hook-documentation) 'error)
- (test (hook-documentation h h) 'error)
- (test (hook-apply) 'error)
- (test (hook-apply h 1) 'error)
- (test (hook?) 'error)
- (test (hook? h h) 'error)
- (test (hook h) 'error)
- (test (hook? (hook)) #t)
- (test (hook-arity (hook)) '(0 0 #f))
- (test (hook-functions (hook)) '())
- (test (hook-documentation (hook)) ""))
-(test (make-hook '()) 'error)
-(test (make-hook '(1)) 'error)
-(test (make-hook '(1 2)) 'error)
-(test (make-hook '(1 2 #f 3)) 'error)
-(test (make-hook '(1.0 2 #f)) 'error)
-(test (make-hook '(1 2/3 #f)) 'error)
-(test (make-hook '(1 0 1)) 'error)
-(test (make-hook '(-1 0 #f)) 'error)
-(test (make-hook '(1 -1 #f)) 'error)
-(test (make-hook '(1 . 2)) 'error)
-(test (make-hook '(1 2 . #f)) 'error)
-(test (make-hook (list 1 0/0 #f)) 'error)
-(test (make-hook (list 1 1/0 #f)) 'error)
-(test (hook? (make-hook 1)) #t)
-(test (make-hook -1) 'error)
-(test (let ((lst (list 1 2 #f))) (set! (cdr (cdr (cdr lst))) lst) (make-hook lst)) 'error)
-
-(let ((h (make-hook '(1 0 #f)))
- (x 0))
- (set! (hook-functions h) (list (lambda (y) (set! x (+ x y))) (lambda (z) (set! x (+ x z)))))
- (h 2)
- (num-test x 4)
- (apply h (list 3))
- (num-test x 10)
- (hook-apply h '(4))
- (num-test x 18))
-
-(let ((h1 (make-hook))
- (h2 (make-hook))
- (x 0))
- (let ((f1 (lambda () (h2)))
- (f2 (lambda () (set! x (+ x 123)))))
- (set! (hook-functions h1) (list f1 f2))
- (set! (hook-functions h2) (list (lambda () (set! x (+ x 321)))))
- (h1)
- (num-test x 444)))
-
-(let ((h (make-hook))
- (x 0))
- (define (f1) (if (< x 10) (begin (set! x (+ x 1)) (f1))))
- (set! (hook-functions h) (list f1))
- (h)
- (num-test x 10))
-
-(let ((h (make-hook '(1 0 #f))))
- (define-macro (mac a) `(+ 1 ,a))
- (test (set! (hook-functions h) (list (lambda () 3))) 'error)
- (test (set! (hook-functions h) (list (lambda (x y) 3))) 'error)
- (test (pair? (set! (hook-functions h) (list (lambda x 3)))) #t)
- (test (pair? (set! (hook-functions h) (list (lambda* ((x 1)) 3)))) #t)
- (test (pair? (set! (hook-functions h) (list (lambda* (x (y 1)) 3)))) #t)
- (test (pair? (set! (hook-functions h) (list (lambda (x . z) 3)))) #t)
- (test (pair? (set! (hook-functions h) (list abs sin list + /))) #t)
- (test (set! (hook-functions h) (list quasiquote)) 'error)
- (test (call-with-exit (lambda (return) (set! (hook-functions h) (list return)))) 'error)
- (test (set! (hook-functions h) (list mac)) 'error)
- (test (set! (hook-functions h) (list h)) 'error)
- (test (pair? (set! (hook-functions h) (list hook-functions))) #t)
- )
+(let ()
+ (define (test-hash size)
+ (let ((c #t))
+ (let ((int-hash (make-hash-table (max size 511) (cons (lambda (a b) (= a b)) (lambda (a) a)))))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! int-hash i i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (let ((x (hash-table-ref int-hash i)))
+ (if (not (= x i)) (format *stderr* ";test-hash(0) ~D -> ~D~%" i x)))))
+ (let ((int-hash (make-hash-table (max size 511) (cons (lambda (a b) (and c (= a b))) (lambda (a) a)))))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! int-hash i i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (let ((x (hash-table-ref int-hash i)))
+ (if (not (= x i)) (format *stderr* ";test-hash(1) ~D -> ~D~%" i x)))))
+ (let ((int-hash (make-hash-table (max size 511) (let ((c #f)) (cons (lambda (a b) (and (not c) (= a b))) (lambda (a) a))))))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! int-hash i i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (let ((x (hash-table-ref int-hash i)))
+ (if (not (= x i)) (format *stderr* ";test-hash(2) ~D -> ~D~%" i x)))))
+ ))
-(test (hook-arity (hook (lambda () 1))) '(0 0 #f))
-(test (hook-arity (hook (lambda (x) 1))) '(1 0 #f))
-(test (hook-arity (hook (lambda (x . y) 1))) '(1 0 #t))
-(test (hook-arity (hook (lambda* ((x 1) (y 2)) 1))) '(0 2 #f))
-
-(test (hook? (hook (lambda (x) x) (lambda (y) 1))) #t)
-(test (hook (lambda (x) x) (lambda () 1)) 'error)
-(test (hook (lambda (x) x) (lambda (x y) 1)) 'error)
-(test (hook? (hook (lambda (x) x) (lambda x 1))) #t)
-(test (hook? (hook (lambda () 1) (lambda x 1))) #t)
-(test (hook? (hook (lambda x 1) (lambda x 1))) #t)
-(test (hook? (hook (lambda (x y) x) (lambda* (x (y 1) (z 2)) 1))) #t)
-(test (hook (lambda (x y) x) (lambda* (x) 1)) 'error)
-(test (hook (lambda* (x (y 1)) x) (lambda* (x) 1)) 'error)
-
-(let ((h (make-hook '(1 1 #f))))
- (set! (hook-functions h) (list (lambda* (x (y 1)) (+ x y)) (lambda z 2)))
- (test (hook-apply h '(0)) (h 0))
- (test (hook-apply h '(1 2)) (h 1 2))
- (test (hook-apply h '(1 2 3)) 'error)
- (test (h 1 2 3) 'error)
- (test (hook-apply h '()) 'error)
- (test (h) 'error)
- (set! (hook-functions h) (list (lambda x x)))
- (test (pair? (hook-functions h)) #t)
- (set! (hook-functions h) '())
- (test (hook-apply h '(1 2)) (h 1 2))
- )
+ (test-hash 10))
-(let ((h (make-hook '(1 0 #t))))
- (test (object->string h) "#<hook>")
- (test (reverse h) 'error)
- (test (length h) 'error)
- (test (fill! h) 'error)
- (test (hook-arity h) '(1 0 #t))
- (set! (hook-functions h) (list (lambda (x . y) x)))
- (test (hook-apply h '(1 2 3)) (h 1 2 3))
- (test (set! (hook-functions h) (cons (lambda (x . y) x) (lambda (x . y) x))) 'error)
- (let ((lst (list (lambda (x . y) x))))
- (set! (cdr lst) lst)
- (test (set! (hook-functions h) lst) 'error)))
-
-(let ((h (make-hook '(1 0 #f)))
- (sum 0))
- (set! (hook-functions h) (list (lambda (x) (set! sum (+ sum 1)) (if (> x 0) (h (- x 1)) 0))))
- (h 3)
- (if (not (= sum 4)) (format #t ";hook called by hook function: ~A~%" sum)))
-
-(let ((h1 (make-hook '(1 0 #f))))
- (let ((h2 (copy h1)))
- (test (hook-arity h2) '(1 0 #f))
- (test (hook-functions h2) '())
- (test (equal? h1 h2) #t)
- (test (eq? h1 h2) #f)
- (set! (hook-functions h1) (list (lambda (a) (+ a 1))))
- (test (hook-functions h2) '())
- (set! (hook-functions h1) '())
- (set! (hook-functions h2) (list (lambda (a) (+ a 1))))
- (test (hook-functions h1) '())
- (let ((x 0))
- (set! (hook-functions h1) (list (lambda (a) (set! x (+ a 1)))))
- (test (let () (h1 3) (= x 4)) #t)
- (let ((h3 (copy h1)))
- (test (equal? (hook-functions h1) (hook-functions h3)) #t)
- (test (equal? h1 h3) #t)
- (test (equal? h2 h3) #f)
- (h3 4)
- (test x 5)))))
-
-(let* ((h1 (make-hook '(1 0 #f)))
- (x 0)
- (p1 (make-procedure-with-setter (lambda (a) (set! x a)) (lambda (a b) (set! x (+ a b))))))
- (set! (hook-functions h1) (list p1))
- (h1 123)
- (test x 123))
+#|
+;; another problem
+(let ((ht (make-hash-table))
+ (lst (list 1)))
+ (set! (ht lst) 32)
+ (let ((v1 (ht '(1)))
+ (v2 (ht '(2))))
+ (set-car! lst 2)
+ (let ((v3 (ht '(1)))
+ (v4 (ht '(2))))
+ (list v1 v2 v3 v4)))) ; 32 #f #f #f
+
+(let ((ht (make-hash-table))
+ (lst (list 1)))
+ (set! (ht (copy lst)) 32)
+ (let ((v1 (ht '(1)))
+ (v2 (ht '(2))))
+ (set-car! lst 2)
+ (let ((v3 (ht '(1)))
+ (v4 (ht '(2))))
+ (list v1 v2 v3 v4)))) ; 32 #f 32 #f
+
+;; so copy the key if it might be changed
+|#
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; some implicit index tests
+
+(test (#(#(1 2) #(3 4)) 1 1) 4)
+(test (#("12" "34") 0 1) #\2)
+(test (#((1 2) (3 4)) 1 0) 3)
+(test (#((1 (2 3))) 0 1 0) 2)
+(test ((vector (hash-table '(a . 1) '(b . 2))) 0 'a) 1)
+(test ((list (lambda (x) x)) 0 "hi") "hi")
+(test (let ((lst '("12" "34"))) (lst 0 1)) #\2)
+(test (let ((lst (list #(1 2) #(3 4)))) (lst 0 1)) 2)
+(test (#2d(("hi" "ho") ("ha" "hu")) 1 1 0) #\h)
+(test ((list (lambda (a) (+ a 1)) (lambda (b) (* b 2))) 1 2) 4)
+(test ((lambda (arg) arg) "hi" 0) 'error)
+
+(let ((L1 (list 1 2 3))
+ (V1 (vector 1 2 3))
+ (M1 #2d((1 2 3) (4 5 6) (7 8 9)))
+ (S1 "123")
+ (H1 (hash-table '(1 . 1) '(2 . 2) '(3 . 3))))
+ (let ((L2 (list L1 V1 M1 S1 H1))
+ (V2 (vector L1 V1 M1 S1 H1))
+ (H2 (hash-table (cons 0 L1) (cons 1 V1) (cons 2 M1) (cons 3 S1) (cons 4 H1)))
+ (M2 (let ((v (make-vector '(3 3))))
+ (set! (v 0 0) L1)
+ (set! (v 0 1) V1)
+ (set! (v 0 2) M1)
+ (set! (v 1 0) S1)
+ (set! (v 1 1) H1)
+ (set! (v 1 2) L1)
+ (set! (v 2 0) S1)
+ (set! (v 2 1) H1)
+ (set! (v 2 2) L1)
+ v)))
+#|
+ ;; this code generates the tests below
+ (for-each
+ (lambda (arg)
+ (let* ((val (symbol->value arg))
+ (len (min 5 (length val))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (format *stderr* "(test (~S ~S) ~S)~%" arg i
+ (catch #t (lambda () (val i)) (lambda args 'error)))
+ (let ((len1 (catch #t (lambda () (min 5 (length (val i)))) (lambda args 0))))
+ (if (> len1 0)
+ (do ((k 0 (+ k 1)))
+ ((= k len1))
+ (format *stderr* "(test (~S ~S ~S) ~S)~%" arg i k
+ (catch #t (lambda () (val i k)) (lambda args 'error)))
+ (let ((len2 (catch #t (lambda () (min 5 (length (val i k)))) (lambda args 0))))
+ (if (> len2 0)
+ (do ((m 0 (+ m 1)))
+ ((= m len2))
+ (format *stderr* "(test (~S ~S ~S ~S) ~S)~%" arg i k m
+ (catch #t (lambda () (val i k m)) (lambda args 'error)))
+ (let ((len3 (catch #t (lambda () (min 5 (length (val i k m)))) (lambda args 0))))
+ (if (> len3 0)
+ (do ((n 0 (+ n 1)))
+ ((= n len3))
+ (format *stderr* "(test (~S ~S ~S ~S ~S) ~S)~%" arg i k m n
+ (catch #t (lambda () (val i k m n)) (lambda args 'error)))))))))))))))
+ (list 'L2 'V2 'M2 'H2))
+|#
+
+ (test (L2 0) '(1 2 3))
+ (test (L2 0 0) 1)
+ (test (L2 0 1) 2)
+ (test (L2 0 2) 3)
+ (test (L2 1) #(1 2 3))
+ (test (L2 1 0) 1)
+ (test (L2 1 1) 2)
+ (test (L2 1 2) 3)
+ (test (L2 2) #2D((1 2 3) (4 5 6) (7 8 9)))
+ (test (L2 2 0) #(1 2 3))
+ (test (L2 2 0 0) 1)
+ (test (L2 2 0 1) 2)
+ (test (L2 2 0 2) 3)
+ (test (L2 2 1) #(4 5 6))
+ (test (L2 2 1 0) 4)
+ (test (L2 2 1 1) 5)
+ (test (L2 2 1 2) 6)
+ (test (L2 2 2) #(7 8 9))
+ (test (L2 2 2 0) 7)
+ (test (L2 2 2 1) 8)
+ (test (L2 2 2 2) 9)
+ (test (L2 2 3) 'error)
+ (test (L2 2 4) 'error)
+ (test (L2 3) "123")
+ (test (L2 3 0) #\1)
+ (test (L2 3 1) #\2)
+ (test (L2 3 2) #\3)
+ (test (L2 4) H1)
+ (test (L2 4 0) #f)
+ (test (L2 4 1) 1)
+ (test (L2 4 2) 2)
+ (test (L2 4 3) 3)
+ (test (L2 4 4) #f)
+ (test (V2 0) '(1 2 3))
+ (test (V2 0 0) 1)
+ (test (V2 0 1) 2)
+ (test (V2 0 2) 3)
+ (test (V2 1) #(1 2 3))
+ (test (V2 1 0) 1)
+ (test (V2 1 1) 2)
+ (test (V2 1 2) 3)
+ (test (V2 2) #2D((1 2 3) (4 5 6) (7 8 9)))
+ (test (V2 2 0) #(1 2 3))
+ (test (V2 2 0 0) 1)
+ (test (V2 2 0 1) 2)
+ (test (V2 2 0 2) 3)
+ (test (V2 2 1) #(4 5 6))
+ (test (V2 2 1 0) 4)
+ (test (V2 2 1 1) 5)
+ (test (V2 2 1 2) 6)
+ (test (V2 2 2) #(7 8 9))
+ (test (V2 2 2 0) 7)
+ (test (V2 2 2 1) 8)
+ (test (V2 2 2 2) 9)
+ (test (V2 2 3) 'error)
+ (test (V2 2 4) 'error)
+ (test (V2 3) "123")
+ (test (V2 3 0) #\1)
+ (test (V2 3 1) #\2)
+ (test (V2 3 2) #\3)
+ (test (V2 4) H1)
+ (test (V2 4 0) #f)
+ (test (V2 4 1) 1)
+ (test (V2 4 2) 2)
+ (test (V2 4 3) 3)
+ (test (V2 4 4) #f)
+ (test (M2 0) #((1 2 3) #(1 2 3) #2D((1 2 3) (4 5 6) (7 8 9))))
+ (test (M2 0 0) '(1 2 3))
+ (test (M2 0 0 0) 1)
+ (test (M2 0 0 1) 2)
+ (test (M2 0 0 2) 3)
+ (test (M2 0 1) #(1 2 3))
+ (test (M2 0 1 0) 1)
+ (test (M2 0 1 1) 2)
+ (test (M2 0 1 2) 3)
+ (test (M2 0 2) #2D((1 2 3) (4 5 6) (7 8 9)))
+ (test (M2 0 2 0) #(1 2 3))
+ (test (M2 0 2 0 0) 1)
+ (test (M2 0 2 0 1) 2)
+ (test (M2 0 2 0 2) 3)
+ (test (M2 0 2 1) #(4 5 6))
+ (test (M2 0 2 1 0) 4)
+ (test (M2 0 2 1 1) 5)
+ (test (M2 0 2 1 2) 6)
+ (test (M2 0 2 2) #(7 8 9))
+ (test (M2 0 2 2 0) 7)
+ (test (M2 0 2 2 1) 8)
+ (test (M2 0 2 2 2) 9)
+ (test (M2 0 2 3) 'error)
+ (test (M2 0 2 4) 'error)
+ (test (M2 1) (vector "123" H1 '(1 2 3)))
+ (test (M2 1 0) "123")
+ (test (M2 1 0 0) #\1)
+ (test (M2 1 0 1) #\2)
+ (test (M2 1 0 2) #\3)
+ (test (M2 1 1) H1)
+ (test (M2 1 1 0) #f)
+ (test (M2 1 1 1) 1)
+ (test (M2 1 1 2) 2)
+ (test (M2 1 1 3) 3)
+ (test (M2 1 1 4) #f)
+ (test (M2 1 2) '(1 2 3))
+ (test (M2 1 2 0) 1)
+ (test (M2 1 2 1) 2)
+ (test (M2 1 2 2) 3)
+ (test (M2 2) (vector "123" H1 '(1 2 3)))
+ (test (M2 2 0) "123")
+ (test (M2 2 0 0) #\1)
+ (test (M2 2 0 1) #\2)
+ (test (M2 2 0 2) #\3)
+ (test (M2 2 1) H1)
+ (test (M2 2 1 0) #f)
+ (test (M2 2 1 1) 1)
+ (test (M2 2 1 2) 2)
+ (test (M2 2 1 3) 3)
+ (test (M2 2 1 4) #f)
+ (test (M2 2 2) '(1 2 3))
+ (test (M2 2 2 0) 1)
+ (test (M2 2 2 1) 2)
+ (test (M2 2 2 2) 3)
+ (test (M2 3) 'error)
+ (test (M2 4) 'error)
+ (test (H2 0) '(1 2 3))
+ (test (H2 0 0) 1)
+ (test (H2 0 1) 2)
+ (test (H2 0 2) 3)
+ (test (H2 1) #(1 2 3))
+ (test (H2 1 0) 1)
+ (test (H2 1 1) 2)
+ (test (H2 1 2) 3)
+ (test (H2 2) #2D((1 2 3) (4 5 6) (7 8 9)))
+ (test (H2 2 0) #(1 2 3))
+ (test (H2 2 0 0) 1)
+ (test (H2 2 0 1) 2)
+ (test (H2 2 0 2) 3)
+ (test (H2 2 1) #(4 5 6))
+ (test (H2 2 1 0) 4)
+ (test (H2 2 1 1) 5)
+ (test (H2 2 1 2) 6)
+ (test (H2 2 2) #(7 8 9))
+ (test (H2 2 2 0) 7)
+ (test (H2 2 2 1) 8)
+ (test (H2 2 2 2) 9)
+ (test (H2 2 3) 'error)
+ (test (H2 2 4) 'error)
+ (test (H2 3) "123")
+ (test (H2 3 0) #\1)
+ (test (H2 3 1) #\2)
+ (test (H2 3 2) #\3)
+ (test (H2 4) H1)
+ (test (H2 4 0) #f)
+ (test (H2 4 1) 1)
+ (test (H2 4 2) 2)
+ (test (H2 4 3) 3)
+ (test (H2 4 4) #f)
+ ))
+
+(let* ((L1 (cons 1 2))
+ (L2 (list L1 3)))
+ (test (L1 0) 1)
+ (test (L1 1) 'error)
+ (test (L1 2) 'error)
+ (test (L2 0 0) 1)
+ (test (L2 0 1) 'error)
+ (test ((cons "123" 0) 0 1) #\2))
+
+(let ((L1 (list "123" "456" "789")))
+ (set-cdr! (cdr L1) L1)
+ (test (L1 0 1) #\2)
+ (test (L1 1 1) #\5)
+ (test (L1 2 1) #\2)
+ (test (L1 12 0) #\1))
+
+(let ((L1 (list "123" "456" "789")))
+ (set-car! (cdr L1) L1)
+ (test (L1 1 1 1 1 1 0 0) #\1))
+
+(test ((list (list) "") 1 0) 'error)
+(test ((list (list) "") 0 0) 'error)
+(test (#(1 2) 0 0) 'error)
+(test (#(1 #()) 1 0) 'error)
+
+(test ('(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((12))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) 12)
+
+;;; implicit index as expression (_A cases)
+
+(let ((L1 (list 1 2 3))
+ (V1 (vector 1 2 3))
+ (S1 "123")
+ (H1 (hash-table '(1 . 1) '(2 . 2) '(3 . 3)))
+ (E1 (inlet :a 1 :b 2)))
+ (define (f1 i s L V S H E)
+ (vector (L (+ i 1)) (V (+ i 1)) (S (+ i 1)) (H (+ i 1)) (E (string->symbol s))))
+ (test (f1 0 "a" L1 V1 S1 H1 E1) (vector 2 2 #\2 1 1))
+ (test (f1 1 "b" L1 V1 S1 H1 E1) (vector 3 3 #\3 2 2))
+ (define (f2 i s L V S H E)
+ (vector (L (abs i)) (V (abs i)) (S (abs i)) (H (abs i)) (E (vector-ref s 0))))
+ (test (f2 -2 #(b a) L1 V1 S1 H1 E1) (vector 3 3 #\3 2 2)))
+
+(when with-block
+ (define (f3 B i) (B (+ i 1)))
+ (define (f4 B i) (B (abs i)))
+ (let ((b (make-block 4)))
+ (set! (b 0) 1.0)
+ (set! (b 1) 2.0)
+ (test (f3 b -1) 1.0)
+ (test (f4 b -1) 2.0)))
+
+(let ((v1 #(0 1 2 3 4 5 6 7))
+ (v2 #2D((0 1 2 3) (4 5 6 7)))
+ (e1 (inlet :a 1))
+ (p1 (list 0 1 2 3))
+ (s1 "0123")
+ )
+ (define (call-1 func arg1 arg2) (func arg1 arg2))
+ (define (call-2 func arg1 arg2) (func arg1 arg2))
+ (define (call-3 func arg1 arg2) (func arg1 arg2))
+ (define (call-4 func arg1 arg2) (func arg1 arg2))
+ (define (call-5 func arg1 arg2) (func arg1 arg2))
+ (define (call-6 func) (func 'a))
+ (define (call-7 func) (func 'a))
+ (define (call-8 func arg) (func (* 2 (+ arg 1))))
+ (define (call-9 func arg) (func (* 2 (+ arg 1))))
+ (define (call-10 func arg) (func arg))
+ (define (call-11 func arg) (func arg))
+ (define (call-12 func) (func 0))
+ (define (call-13 func) (func 0))
+ (define (call-14 func arg) (func arg 2))
+ (define (call-15 func arg) (func 2 arg))
+
+ (define (f+ x y) (+ x y))
+ (define (f- x y) (- x y))
+ (define* (f++ (x 0) y) (+ x y))
+ (define* (f-- x (y 0)) (- x y))
+ (define (fabs x) (abs x))
+ (define-macro (m+ x y) `(+ ,x ,y))
+
+ (test (call-1 + 5 2) 7)
+ (test (call-1 f- 5 2) 3)
+ (test (call-2 f+ 5 2) 7)
+ (test (call-2 - 5 2) 3)
+ (test (call-3 v2 0 3) 3)
+ (test (call-3 list 0 3) (list 0 3))
+ (test (call-4 f++ 5 2) 7)
+ (test (call-4 f-- 5 2) 3)
+ (test (call-5 m+ 5 2) 7)
+ (test (call-5 - 5 2) 3)
+ (test (call-6 e1) 1)
+ (test (call-6 symbol?) #t)
+ (test (call-7 symbol?) #t)
+ (test (call-7 list) (list 'a))
+ (test (call-8 abs -3) 4)
+ (test (call-8 f-- 10) 22)
+ (test (call-9 fabs -3) 4)
+ (test (call-9 list -3) (list -4))
+ (test (call-10 e1 'a) 1)
+ (test (call-10 list 'a) (list 'a))
+ (test (call-11 symbol? 'a) #t)
+ (test (call-11 e1 'a) 1)
+ (test (call-12 p1) 0)
+ (test (call-12 s1) #\0)
+ (test (call-13 v1) 0)
+ (test (call-13 (lambda (x) (+ x 1))) 1)
+ (test (call-14 * 3) 6)
+ (test (call-14 (lambda (x y) (- x y)) 3) 1)
+ (test (call-15 (lambda (x y) (- x y)) 3) -1)
+ (test (call-15 - 3) -1)
+ )
+
+;; multi-index get/set
+(let ((v (vector (hash-table* 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5))
+(let ((v (vector (inlet 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5))
+(let ((v (vector (list 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (vector (string #\1 #\2)))) (test (v 0 1) #\2) (set! (v 0 1) #\5) (test (v 0 1) #\5))
+(let ((v (vector (vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (vector (byte-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(when with-block (let ((v (vector (block 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0)))
+(let ((v (vector (float-vector 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0))
+(let ((v (vector (int-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (list (hash-table* 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5))
+(let ((v (list (inlet 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5))
+(let ((v (list (list 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (list (string #\1 #\2)))) (test (v 0 1) #\2) (set! (v 0 1) #\5) (test (v 0 1) #\5))
+(let ((v (list (vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (list (byte-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(when with-block (let ((v (list (block 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0)))
+(let ((v (list (float-vector 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0))
+(let ((v (list (int-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5))
+(let ((v (hash-table* 'a (hash-table* 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5))
+(let ((v (hash-table* 'a (inlet 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5))
+(let ((v (hash-table* 'a (list 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (hash-table* 'a (string #\1 #\2)))) (test (v 'a 1) #\2) (set! (v 'a 1) #\5) (test (v 'a 1) #\5))
+(let ((v (hash-table* 'a (vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (hash-table* 'a (byte-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(when with-block (let ((v (hash-table* 'a (block 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0)))
+(let ((v (hash-table* 'a (float-vector 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0))
+(let ((v (hash-table* 'a (int-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (inlet 'a (hash-table* 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5))
+(let ((v (inlet 'a (inlet 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5))
+(let ((v (inlet 'a (list 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (inlet 'a (string #\1 #\2)))) (test (v 'a 1) #\2) (set! (v 'a 1) #\5) (test (v 'a 1) #\5))
+(let ((v (inlet 'a (vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(let ((v (inlet 'a (byte-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+(when with-block (let ((v (inlet 'a (block 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0)))
+(let ((v (inlet 'a (float-vector 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0))
+(let ((v (inlet 'a (int-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5))
+
+(let ((ind 0) (sym 'a) (v (vector (hash-table* 'a 1 'b 2)))) (test (v ind sym) 1) (set! (v (+ ind ind) sym) (+ ind 5)) (test (v 0 'a) 5))
+(let ((v (vector (hash-table* 'a "123" 'b 2)))) (test (v 0 'a 1) #\2) (set! (v 0 'a 1) #\5) (test (v 0 'a) "153"))
+
+(let ((iv (make-vector '(2 2))))
+ (set! (iv 1 0) 2)
+ (set! (iv 1 1) 4)
+ (let ((v (vector iv)))
+ (test (v 0 1 0) 2)
+ (set! (v 0 1 0) 5)
+ (test (v 0 1) #(5 4))))
+
+(let ((ov (make-vector '(2 2)))
+ (iv (make-vector '(2 2))))
+ (set! (ov 1 0) iv)
+ (set! (iv 0 1) 3)
+ (test (ov 1 0 0 1) 3)
+ (set! (ov 1 0 0 1) 5)
+ (test (ov 1 0 0 1) 5))
@@ -7657,7 +13537,6 @@ zzy" (lambda (p) (eval (read p))))) 32)
;;; PORTS
;;; --------------------------------------------------------------------------------
-
(define start-input-port (current-input-port))
(define start-output-port (current-output-port))
@@ -7671,24 +13550,29 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (input-port? arg)
- (format #t ";(input-port? ~A) -> #t?~%" arg)))
- (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #<eof> #<undefined> #<unspecified>))
+ (format-logged #t ";(input-port? ~A) -> #t?~%" arg)))
+ (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi #<eof> #<undefined> #<unspecified>))
(test (call-with-input-file "s7test.scm" input-port?) #t)
(if (not (eq? start-input-port (current-input-port)))
- (format #t "call-with-input-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+ (format-logged #t "call-with-input-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
(test (let ((this-file (open-input-file "s7test.scm"))) (let ((res (input-port? this-file))) (close-input-port this-file) res)) #t)
(if (not (eq? start-input-port (current-input-port)))
- (format #t "open-input-file clobbered current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+ (format-logged #t "open-input-file clobbered current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
(test (call-with-input-string "(+ 1 2)" input-port?) #t)
(test (let ((this-file (open-input-string "(+ 1 2)"))) (let ((res (input-port? this-file))) (close-input-port this-file) res)) #t)
+(test (let ((this-file (open-input-string "(+ 1 2)"))) (let ((len (length this-file))) (close-input-port this-file) len)) 7)
+
+;;; (test (let ((str "1234567890")) (let ((p (open-input-string str))) (string-set! str 0 #\a) (let ((c (read-char p))) (close-input-port p) c))) #\1)
+;;; is that result demanded by the scheme spec? perhaps make str immutable if so?
;;; read
;;; write
(test (+ 100 (call-with-input-string "123" (lambda (p) (values (read p) 1)))) 224)
+
(test (call-with-input-string
"1234567890"
(lambda (p)
@@ -7714,6 +13598,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-line p)))) #t)
(test (load "empty-file") #<unspecified>)
(test (call-with-input-file "empty-file" (lambda (p) (port-closed? p))) #f)
+(test (eof-object? (call-with-input-string "" (lambda (p) (read p)))) #t)
+(test (eof-object? #<eof>) #t)
+(test (let () (define (hi a) (eof-object? a)) (hi #<eof>)) #t)
(let ()
(define (io-func) (lambda (p) (eof-object? (read-line p))))
@@ -7768,26 +13655,423 @@ zzy" (lambda (p) (eval (read p))))) 32)
(eof-object? (read-line p)))))
#t)
(test (load "empty-file") 3)
-(let ((p1 (make-procedure-with-setter (lambda (p) (and (= (read p) 3) (eof-object? (read p)))) (lambda (p) #f))))
+(let ((p1 (dilambda (lambda (p) (and (= (read p) 3) (eof-object? (read p)))) (lambda (p) #f))))
(test (call-with-input-file "empty-file" p1) #t))
-(test (reverse *stdin*) 'error)
-(test (fill! (current-output-port)) 'error)
-(test (length *stderr*) 'error)
-
-;; these apparently jump out of the enclosing load too
+;;; load
(for-each
(lambda (arg)
(test (load arg) 'error)
(test (load "empty-file" arg) 'error))
- (list '() (list 1) '(1 . 2) #f #\a 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list () (list 1) '(1 . 2) #f #\a 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (load) 'error)
-(test (load "empty-file" (current-environment) 1) 'error)
+(test (load "empty-file" (curlet) 1) 'error)
(test (load "not a file") 'error)
(test (load "") 'error)
(test (load "/home/bil/cl") 'error)
+(test (call-with-input-string "(display (+ 1 2))" load) 'error)
+
+(call-with-output-file "empty-file" (lambda (p) (write '(+ 1 2 3) p)))
+(let ((x 4))
+ (test (+ x (load "empty-file")) 10))
+
+(call-with-output-file "empty-file" (lambda (p) (write '(list 1 2 3) p)))
+(let ((x 4))
+ (test (cons x (load "empty-file")) '(4 1 2 3)))
+
+(call-with-output-file "empty-file" (lambda (p) (write '(values 1 2 3) p)))
+(let ((x 4))
+ (test (+ x (load "empty-file")) 10))
+(test (+ 4 (eval (call-with-input-file "empty-file" (lambda (p) (read p))))) 10)
+
+(call-with-output-file "empty-file" (lambda (p) (write '(+ x 1) p)))
+(let ((x 2))
+ (test (load "empty-file" (curlet)) 3))
+
+(call-with-output-file "empty-file" (lambda (p) (write '(set! x 1) p)))
+(let ((x 2))
+ (load "empty-file" (curlet))
+ (test x 1))
+
+(call-with-output-file "empty-file" (lambda (p) (write '(define (hi a) (values a 2)) p) (write '(hi x) p)))
+(let ((x 4))
+ (test (+ x (load "empty-file" (curlet))) 10))
+
+(let ((x 1)
+ (e #f))
+ (set! e (curlet))
+ (let ((x 4))
+ (test (+ x (load "empty-file" e)) 7)))
+
+(let ()
+ (let ()
+ (call-with-output-file "empty-file" (lambda (p) (write '(define (load_hi a) (+ a 1)) p)))
+ (load "empty-file" (curlet))
+ (test (load_hi 2) 3))
+ (test (defined? 'load_hi) #f))
+
+(let ()
+ (apply load '("empty-file"))
+ (test (load_hi 2) 3))
+
+(call-with-output-file "empty-file" (lambda (p) (display "\"empty-file\"" p)))
+(test (load (load "empty-file")) "empty-file")
+
+;;; autoload
+(test (autoload) 'error)
+(test (autoload 'abs) 'error)
+(test (autoload :abs "dsp.scm") 'error)
+(for-each
+ (lambda (arg)
+ (test (autoload arg "dsp.scm") 'error)
+ (test (autoload 'hi arg) 'error))
+ (list #f () (integer->char 65) 1 (list 1 2) _ht_ _null_ _c_obj_ '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
+(test (autoload 'abs "dsp.scm" 123) 'error)
+(test (autoload "" "dsp.scm") 'error)
+
+(autoload 'auto_test_var "empty-file")
+(test (defined? 'auto_test_var) #f)
+(call-with-output-file "empty-file" (lambda (p) (format p "(define auto_test_var 123)~%")))
+(load "empty-file")
+(test (+ 1 auto_test_var) 124)
+
+(autoload 'auto_test_var_2 (lambda (e) (varlet e (cons 'auto_test_var_2 1))))
+(test (let () (+ 1 auto_test_var_2)) 2)
+
+(autoload 'auto_test_var_3 (lambda (e) (varlet e (cons 'auto_test_var_3 1))))
+(autoload 'auto_test_var_4 (lambda (e) (varlet e (cons 'auto_test_var_4 (+ auto_test_var_3 1)))))
+(test (let () (+ auto_test_var_4 1)) 3)
+(test (autoload 'auto_test_var_1 (lambda () #f)) 'error)
+(test (autoload 'auto_test_var_1 (lambda (a b) #f)) 'error)
+
+(let ((str3 #f))
+ ;; IO tests mainly
+
+ (set! str3 "0123456789")
+ (set! str3 (string-append str3 str3 str3 str3 str3 str3 str3 str3 str3 str3))
+ (set! str3 (string-append str3 str3 str3 str3 str3 str3 str3 str3 str3 str3))
+ (set! str3 (string-append str3 str3 str3))
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-string)~%")
+ (format p " \"")
+ (display str3 p)
+ (format p "\\\n") ; this becomes \<newline> in the midst of a string which we ignore
+ (display str3 p)
+ (format p "\"")
+ (format p ")~%")))
+
+ (load "test.scm")
+ (let ((str (big-string)))
+ (test (length str) 6000))
+
+
+ (let ((big-string (eval (call-with-input-string
+ (call-with-output-string
+ (lambda (p)
+ (format p "(lambda ()~%")
+ (format p " \"")
+ (display str3 p)
+ (format p "\\\n") ; this becomes \<newline> in the midst of a string which we ignore
+ (display str3 p)
+ (format p "\"")
+ (format p ")~%")))
+ read))))
+ (let ((str (big-string)))
+ (test (length str) 6000)))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-string)~%")
+ (format p " \"")
+ (display str3 p)
+ (format p "\\\"")
+ (display str3 p)
+ (format p "\"")
+ (format p ")~%")))
+
+ (load "test.scm")
+ (let ((str (big-string)))
+ (test (length str) 6001))
+
+
+ (let ((big-string (eval (call-with-input-string
+ (call-with-output-string
+ (lambda (p)
+ (format p "(lambda ()~%")
+ (format p " \"")
+ (display str3 p)
+ (format p "\\\"")
+ (display str3 p)
+ (format p "\"")
+ (format p ")~%")))
+ read))))
+ (let ((str (big-string)))
+ (test (length str) 6001)))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "")))
+ (load "test.scm") ; #<unspecified>
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p ";")
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (let ((c (integer->char (random 128))))
+ (if (char<? c #\space)
+ (display #\space p)
+ (display c p))))
+ (format p "~%32~%")))
+ (test (load "test.scm") 32)
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-list)~% (list ")
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (format p "~D " i))
+ (format p "))~%")))
+
+ (load "test.scm")
+ (let ((lst (big-list)))
+ (test (length lst) 2000))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-list)~% ")
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (format p "(cons ~D " i))
+ (format p "()")
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (format p ")"))
+ (format p ")~%")))
+
+ (load "test.scm")
+ (let ((lst (big-list)))
+ (test (length lst) 2000))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (a-char)~% #\\a)~%")))
+
+ (load "test.scm")
+ (test (a-char) #\a)
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (let ((a (char->integer #\a)))
+ (format p "(define (big-char)~% (string ")
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (format p "#\\~C " (integer->char (+ a (modulo i 26)))))
+ (format p "))~%"))))
+
+ (load "test.scm")
+ (let ((chars (big-char)))
+ (test (length chars) 2000))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (let ((a (char->integer #\a)))
+ (format p "(define (big-xchar)~% (string ")
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (format p "#\\x~X " (+ a (modulo i 26))))
+ (format p "))~%"))))
+
+ (load "test.scm")
+ (let ((chars (big-xchar)))
+ (test (length chars) 2000))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (ychar) #\\~C)" (integer->char 255))))
+ (load "test.scm")
+ (test (ychar) (integer->char 255))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (format p "~D" i))
+ (format p "~%")
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (format p "~D" i))))
+
+ (call-with-input-file "test.scm"
+ (lambda (p)
+ (let ((s1 (read-line p))
+ (s2 (read-line p)))
+ (test (and (string=? s1 s2)
+ (= (length s1) 2890))
+ #t))))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-int)~%")
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (format p "0"))
+ (format p "123)~%")))
+
+ (load "test.scm")
+ (test (big-int) 123)
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-rat)~%")
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (format p "0"))
+ (format p "123/")
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (format p "0"))
+ (format p "2)~%")))
+
+ (load "test.scm")
+ (test (big-rat) 123/2)
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-hash)~% (hash-table ")
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (format p "'(~D . ~D) " i (+ i 1)))
+ (format p "))~%")))
+
+ (load "test.scm")
+ (let ((ht (big-hash)))
+ (let ((entries 0))
+ (for-each
+ (lambda (htv)
+ (set! entries (+ entries 1))
+ (if (not (= (+ (car htv) 1) (cdr htv)))
+ (format *stderr* ";hashed: ~A~%" htv)))
+ ht)
+ (test entries 2000)))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-hash)~% (apply hash-table (list ")
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (format p "(cons ~D ~D) " i (+ i 1)))
+ (format p ")))~%")))
+
+ (load "test.scm")
+ (let ((ht (big-hash)))
+ (let ((entries 0))
+ (for-each
+ (lambda (htv)
+ (set! entries (+ entries 1))
+ (if (not (= (+ (car htv) 1) (cdr htv)))
+ (format *stderr* ";hashed: ~A~%" htv)))
+ ht)
+ (test entries 2000)))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (let ((a (char->integer #\a)))
+ (format p "(define (big-env)~% (inlet ")
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (format p "'(~A . ~D) "
+ (string (integer->char (+ a (modulo i 26)))
+ (integer->char (+ a (modulo (floor (/ i 26)) 26)))
+ (integer->char (+ a (modulo (floor (/ i (* 26 26))) 26))))
+ i))
+ (format p "))~%"))))
+
+ (load "test.scm")
+ (let ((E (big-env))
+ (a (char->integer #\a)))
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (let ((sym (string->symbol
+ (string (integer->char (+ a (modulo i 26)))
+ (integer->char (+ a (modulo (floor (/ i 26)) 26)))
+ (integer->char (+ a (modulo (floor (/ i (* 26 26))) 26)))))))
+ (let ((val (E sym)))
+ (if (not (equal? val i))
+ (format *stderr* ";env: ~A -> ~A, not ~D~%" sym val i))))))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "")))
+
+ (let ((val (call-with-input-file "test.scm"
+ (lambda (p)
+ (read p)))))
+ (if (not (eof-object? val))
+ (format *stderr* ";read empty file: ~A~%" val)))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p " ;")
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (let ((c (integer->char (random 128))))
+ (if (char<? c #\space)
+ (display #\space p)
+ (display c p))))
+ (format p "~%")))
+
+ (let ((val (call-with-input-file "test.scm"
+ (lambda (p)
+ (read p)))))
+ (if (not (eof-object? val))
+ (format *stderr* ";read comment file: ~A~%" val)))
+
+
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "\"~3001TT\"~%")))
+
+ (let ((str (call-with-input-file "test.scm"
+ (lambda (p)
+ (read p)))))
+ (test (length str) 3000)))
+
+#|
+(let ((c #f)
+ (i 0)
+ (e #f))
+ (set! e (curlet))
+ (call-with-output-file "empty-file" (lambda (p) (write '(call/cc (lambda (c1) (set! c c1) (set! i (+ i 1)))) p)))
+ (load "empty-file" e)
+ (test (c) 'error)) ; ;read-error ("our input port got clobbered!")
+|#
+
+
+(test (reverse *stdin*) 'error)
+(test (fill! (current-output-port)) 'error)
+(test (length *stderr*) #f)
(test (output-port? (current-input-port)) #f)
(test (output-port? *stdin*) #f)
@@ -7796,30 +14080,30 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (output-port? (current-error-port)) #t)
(test (output-port? *stderr*) #t)
-(write-char #\space (current-output-port))
-(write " " (current-output-port))
+;(write-char #\space (current-output-port))
+;(write " " (current-output-port))
(newline (current-output-port))
(for-each
(lambda (arg)
(if (output-port? arg)
- (format #t ";(output-port? ~A) -> #t?~%" arg)))
- (list "hi" #f '() 'hi (integer->char 65) 1 (list 1 2) _ht_ '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
+ (format-logged #t ";(output-port? ~A) -> #t?~%" arg)))
+ (list "hi" #f () 'hi (integer->char 65) 1 (list 1 2) _ht_ _null_ _c_obj_ '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
(for-each
(lambda (arg)
- (test (read-line '() arg) 'error)
+ (test (read-line () arg) 'error)
(test (read-line arg) 'error))
- (list "hi" (integer->char 65) 1 #f _ht_ (list) (cons 1 2) (list 1 2) (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
+ (list "hi" (integer->char 65) 1 #f _ht_ _null_ _c_obj_ (list) (cons 1 2) (list 1 2) (make-vector 3) 3.14 3/4 1.0+1.0i #\f))
-(test (call-with-output-file "tmp1.r5rs" output-port?) #t)
+(test (call-with-output-file tmp-output-file output-port?) #t)
(if (not (eq? start-output-port (current-output-port)))
- (format #t "call-with-output-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+ (format-logged #t "call-with-output-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
-(test (let ((this-file (open-output-file "tmp1.r5rs"))) (let ((res (output-port? this-file))) (close-output-port this-file) res)) #t)
+(test (let ((this-file (open-output-file tmp-output-file))) (let ((res (output-port? this-file))) (close-output-port this-file) res)) #t)
(if (not (eq? start-output-port (current-output-port)))
- (format #t "open-output-file clobbered current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+ (format-logged #t "open-output-file clobbered current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
(test (let ((val #f)) (call-with-output-string (lambda (p) (set! val (output-port? p)))) val) #t)
(test (let ((res #f)) (let ((this-file (open-output-string))) (set! res (output-port? this-file)) (close-output-port this-file) res)) #t)
@@ -7827,8 +14111,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(if (eof-object? arg)
- (format #t ";(eof-object? ~A) -> #t?~%" arg)))
- (list "hi" '() '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
+ (format-logged #t ";(eof-object? ~A) -> #t?~%" arg)))
+ (list "hi" () '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #f #t (if #f #f) #<undefined> (lambda (a) (+ a 1))))
(for-each
@@ -7837,32 +14121,33 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda () (port-closed? arg))
(lambda args 'error))))
(if (not (eq? val 'error))
- (format #t ";(port-closed? ~A) -> ~S?~%" arg val))))
- (list "hi" '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
+ (format-logged #t ";(port-closed? ~A) -> ~S?~%" arg val))))
+ (list "hi" '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #f #t (if #f #f) #<undefined> #<eof> (lambda (a) (+ a 1))))
(test (port-closed?) 'error)
(test (port-closed? (current-input-port) (current-output-port)) 'error)
-(call-with-output-file "tmp1.r5rs" (lambda (p) (display "3.14" p)))
-(test (call-with-input-file "tmp1.r5rs" (lambda (p) (read p) (let ((val (read p))) (eof-object? val)))) #t)
+(call-with-output-file tmp-output-file (lambda (p) (display "3.14" p)))
+(test (call-with-input-file tmp-output-file (lambda (p) (read p) (let ((val (read p))) (eof-object? val)))) #t)
-(test (call-with-input-file "tmp1.r5rs" (lambda (p) (read-char p))) #\3)
-(test (call-with-input-file "tmp1.r5rs" (lambda (p) (peek-char p))) #\3)
-(test (call-with-input-file "tmp1.r5rs" (lambda (p) (peek-char p) (read-char p))) #\3)
-(test (call-with-input-file "tmp1.r5rs" (lambda (p) (list->string (list (read-char p) (read-char p) (read-char p) (read-char p))))) "3.14")
-(test (call-with-input-file "tmp1.r5rs" (lambda (p) (list->string (list (read-char p) (peek-char p) (read-char p) (read-char p) (peek-char p) (read-char p))))) "3..144")
+(test (call-with-input-file tmp-output-file (lambda (p) (read-char p))) #\3)
+(test (call-with-input-file tmp-output-file (lambda (p) (peek-char p))) #\3)
+(test (call-with-input-file tmp-output-file (lambda (p) (peek-char p) (read-char p))) #\3)
+(test (call-with-input-file tmp-output-file (lambda (p) (list->string (list (read-char p) (read-char p) (read-char p) (read-char p))))) "3.14")
+(test (call-with-input-file tmp-output-file (lambda (p) (list->string (list (read-char p) (peek-char p) (read-char p) (read-char p) (peek-char p) (read-char p))))) "3..144")
(for-each
(lambda (arg)
- (call-with-output-file "tmp1.r5rs" (lambda (p) (write arg p)))
- (test (call-with-input-file "tmp1.r5rs" (lambda (p) (read p))) arg))
+ (call-with-output-file tmp-output-file (lambda (p) (write arg p)))
+ (if (not (morally-equal? (call-with-input-file tmp-output-file (lambda (p) (read p))) arg))
+ (format *stderr* "~A different after write~%" arg)))
(list "hi" -1 #\a 1 'a-symbol (make-vector 3 0) 3.14 3/4 .6 1.0+1.0i #f #t (list 1 2 3) (cons 1 2)
- '(1 2 . 3) '() '((1 2) (3 . 4)) '(()) (list (list 'a "hi") #\b 3/4) ''a
+ '(1 2 . 3) () '((1 2) (3 . 4)) '(()) (list (list 'a "hi") #\b 3/4) ''a
(string #\a #\null #\b) "" "\"hi\""
(integer->char 128) (integer->char 127) (integer->char 255) #\space #\null #\newline #\tab
#() #2d((1 2) (3 4)) #3d()
- #<eof> #<undefined> #<unspecified>
+ :hi #<eof> #<undefined> #<unspecified>
most-negative-fixnum
(if with-bignums 1239223372036854775808 123)
(if with-bignums 144580536300674537151081081515762353325831/229154728370723013560448485454219755525522 11/10)
@@ -7873,8 +14158,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
- (call-with-output-file "tmp1.r5rs" (lambda (p) (write arg p)))
- (test (call-with-input-file "tmp1.r5rs" (lambda (p) (eval (read p)))) arg)) ; so read -> symbol?
+ (call-with-output-file tmp-output-file (lambda (p) (write arg p)))
+ (test (call-with-input-file tmp-output-file (lambda (p) (eval (read p)))) arg)) ; so read -> symbol?
(list *stdout* *stdin* *stderr*
abs + quasiquote
@@ -7884,15 +14169,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
; (lambda (a) (+ a 1))
; pws?
; (current-output-port)
-; (make-random-state 1234)
+; (random-state 1234)
; (symbol ":\"")
-
-;;; macroexpand
-;;; (let () (define-macro (hi1 a) `(+ ,a 1)) hi1)
+; (let () (define-macro (hi1 a) `(+ ,a 1)) hi1)
;;; and how could a continuation work in general?
))
-;;; (call-with-input-file "tmp1.r5rs" (lambda (p) (read p))) got (symbol ":\"") but expected (symbol ":\"")
+;;; (call-with-input-file tmp-output-file (lambda (p) (read p))) got (symbol ":\"") but expected (symbol ":\"")
;;; r4rstest
@@ -7908,10 +14191,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (eof-object? (read-char test-file)) #t)
(input-port? test-file)))))
(if (not (eq? val #t))
- (format #t "input-port? in call-with-input-file? returned ~A from ~A~%" val name))))
+ (format-logged #t "input-port? in call-with-input-file? returned ~A from ~A~%" val name))))
(test (call-with-output-file
- "tmp1.r5rs"
+ tmp-output-file
(lambda (test-file)
(write-char #\; test-file)
(display #\; test-file)
@@ -7920,7 +14203,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(newline test-file)
(write load-test-obj test-file)
(output-port? test-file))) #t)
- (check-test-file "tmp1.r5rs")
+ (check-test-file tmp-output-file)
(let ((test-file (open-output-file "tmp2.r5rs")))
(test (port-closed? test-file) #f)
@@ -7935,16 +14218,17 @@ zzy" (lambda (p) (eval (read p))))) 32)
(check-test-file "tmp2.r5rs")))
-(call-with-output-file "tmp1.r5rs" (lambda (p) (display "3.14" p)))
-(test (with-input-from-file "tmp1.r5rs" (lambda () (read))) 3.14)
+(call-with-output-file tmp-output-file (lambda (p) (display "3.14" p)))
+(test (with-input-from-file tmp-output-file read) 3.14)
(if (not (eq? start-input-port (current-input-port)))
- (format #t "with-input-from-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
+ (format-logged #t "with-input-from-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port)))
-(test (with-input-from-file "tmp1.r5rs" (lambda () (eq? (current-input-port) start-input-port))) #f)
+(test (with-input-from-file tmp-output-file (lambda () (eq? (current-input-port) start-input-port))) #f)
+(test (char->integer ((with-input-from-string (string (integer->char 255))(lambda () (read-string 1))) 0)) 255)
-(test (with-output-to-file "tmp1.r5rs" (lambda () (eq? (current-output-port) start-output-port))) #f)
+(test (with-output-to-file tmp-output-file (lambda () (eq? (current-output-port) start-output-port))) #f)
(if (not (eq? start-output-port (current-output-port)))
- (format #t "with-output-to-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
+ (format-logged #t "with-output-to-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port)))
(let ((newly-found-sonnet-probably-by-shakespeare
@@ -7965,18 +14249,18 @@ zzy" (lambda (p) (eval (read p))))) 32)
He was paid many dollars, and spent them with glee,\
But his employer might mutter, this result were he to see."))
- (call-with-output-file "tmp1.r5rs"
+ (call-with-output-file tmp-output-file
(lambda (p)
(write newly-found-sonnet-probably-by-shakespeare p)))
- (let ((sonnet (with-input-from-file "tmp1.r5rs"
+ (let ((sonnet (with-input-from-file tmp-output-file
(lambda ()
(read)))))
(if (or (not (string? sonnet))
(not (string=? sonnet newly-found-sonnet-probably-by-shakespeare)))
- (format #t "write/read long string returned: ~A~%" sonnet)))
+ (format-logged #t "write/read long string returned: ~A~%" sonnet)))
- (let ((file (open-output-file "tmp1.r5rs")))
+ (let ((file (open-output-file tmp-output-file)))
(let ((len (string-length newly-found-sonnet-probably-by-shakespeare)))
(write-char #\" file)
(do ((i 0 (+ i 1)))
@@ -7988,42 +14272,42 @@ zzy" (lambda (p) (eval (read p))))) 32)
(write-char #\" file)
(close-output-port file)))
- (let ((file (open-input-file "tmp1.r5rs")))
+ (let ((file (open-input-file tmp-output-file)))
(let ((sonnet (read file)))
(close-input-port file)
(if (or (not (string? sonnet))
(not (string=? sonnet newly-found-sonnet-probably-by-shakespeare)))
- (format #t "write-char/read long string returned: ~A~%" sonnet)))))
+ (format-logged #t "write-char/read long string returned: ~A~%" sonnet)))))
-(let ((file (open-output-file "tmp1.r5rs")))
+(let ((file (open-output-file tmp-output-file)))
(for-each
(lambda (arg)
(write arg file)
(write-char #\space file))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
(close-output-port file))
-(let ((file (open-input-file "tmp1.r5rs")))
+(let ((file (open-input-file tmp-output-file)))
(for-each
(lambda (arg)
(let ((val (read file)))
(if (not (equal? val arg))
- (format #t "read/write ~A returned ~A~%" arg val))))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+ (format-logged #t "read/write ~A returned ~A~%" arg val))))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
(close-input-port file))
-(with-output-to-file "tmp1.r5rs"
+(with-output-to-file tmp-output-file
(lambda ()
(write lists)))
-(let ((val (with-input-from-file "tmp1.r5rs"
+(let ((val (with-input-from-file tmp-output-file
(lambda ()
(read)))))
(if (not (equal? val lists))
- (format #t "read/write lists returned ~A~%" val)))
+ (format-logged #t "read/write lists returned ~A~%" val)))
(if (not (string=? "" (with-output-to-string (lambda () (display "")))))
- (format #t "with-output-to-string null string?"))
+ (format-logged #t "with-output-to-string null string?"))
(let ((str (with-output-to-string
(lambda ()
@@ -8033,34 +14317,199 @@ zzy" (lambda (p) (eval (read p))))) 32)
((eof-object? c))
(display c))))))))
(if (not (string=? str "hiho123"))
- (format #t "with string ports: ~S?~%" str)))
+ (format-logged #t "with string ports 0: ~S?~%" str)))
+
+(let ((p1 (open-input-string "123"))
+ (p2 (open-input-string "123")))
+ (test (morally-equal? p1 p2) #t)
+ (read-char p1)
+ (test (morally-equal? p1 p2) #f)
+ (read-char p2)
+ (test (morally-equal? p1 p2) #t)
+ (close-input-port p1)
+ (close-input-port p2))
+
+(let ((p1 (open-input-string "1234"))
+ (p2 (open-input-string "123")))
+ (test (morally-equal? p1 p2) #f)
+ (read-char p1)
+ (test (morally-equal? p1 p2) #f)
+ (close-input-port p1)
+ (close-input-port p2))
+
+(let ((p1 (open-output-string))
+ (p2 (open-output-string)))
+ (test (morally-equal? p1 p2) #t)
+ (write-char #\a p1)
+ (test (morally-equal? p1 p2) #f)
+ (close-output-port p1)
+ (close-output-port p2))
+
+(let ()
+ (define* (f1 (b 123)) (display b))
+ (test (with-output-to-string f1) "123")
+ (define (f2) (display "123"))
+ (test (with-output-to-string f2) "123")
+ (define (f3 . args) (display 123))
+ (test (with-output-to-string f3) "123")
+ (define-macro (m1) `(write 123))
+ (test (with-output-to-string m1) "123")
+ (define-macro (m2) (write 123))
+ (test (with-output-to-string m2) "123")
+ (define (f4 a b) (display 123))
+ (test (with-output-to-string f4) 'error)
+ (test (with-output-to-string s7-version) "")) ; the output is a string -- not written to stdout or whatever
+
+(let ()
+ (define* (f1 a (b 123)) (display b a))
+ (test (call-with-output-string f1) "123")
+ (define (f2 a) (display "123" a))
+ (test (call-with-output-string f2) "123")
+ (define (f3 . args) (display 123 (car args)))
+ (test (call-with-output-string f3) "123")
+ (define-macro (m1 p) `(write 123 ,p))
+ (test (call-with-output-string m1) "123")
+ (define-macro* (m2 (p #f)) (write 123 p))
+ (test (call-with-output-string m2) "123")
+ (define (f4 a b) (display 123 a))
+ (test (call-with-output-string f4) 'error)
+ (test (call-with-output-string s7-version) 'error))
+
+(let ()
+ (define* (f1 (a #f)) (read))
+ (test (with-input-from-string "(+ 1 2 3)" f1) '(+ 1 2 3))
+ (define* (f2 . args) (read))
+ (test (with-input-from-string "(+ 1 2 3)" f2) '(+ 1 2 3))
+ (define f3 read)
+ (test (with-input-from-string "(+ 1 2 3)" f3) '(+ 1 2 3))
+ (define (f4) (read))
+ (test (with-input-from-string "(+ 1 2 3)" f4) '(+ 1 2 3))
+ (define-macro (m1) `(read))
+ (test (with-input-from-string "(+ 1 2 3)" m1) '(+ 1 2 3))
+ (define-macro (m2) (read))
+ (test (with-input-from-string "(+ 1 2 3)" m2) 6)
+ (define (f5 a) (read a))
+ (test (with-input-from-string "(+ 1 2 3)" f5) 'error)
+ (test (with-input-from-string "(+ 1 2 3)" s7-version) (s7-version)))
+
+(let ()
+ (define* (f1 (a #f)) (read a))
+ (test (call-with-input-string "(+ 1 2 3)" f1) '(+ 1 2 3))
+ (define* (f2 . args) (read (car args)))
+ (test (call-with-input-string "(+ 1 2 3)" f2) '(+ 1 2 3))
+ (define f3 read)
+ (test (call-with-input-string "(+ 1 2 3)" f3) '(+ 1 2 3))
+ (define-macro (m1 p) `(read ,p))
+ (test (call-with-input-string "(+ 1 2 3)" m1) '(+ 1 2 3))
+ (define-macro* (m2 (p #f)) (read p))
+ (test (call-with-input-string "(+ 1 2 3)" m2) 6)
+ (define (f4) (read))
+ (test (call-with-input-string "(+ 1 2 3)" f4) 'error)
+ (test (call-with-input-string "(+ 1 2 3)" s7-version) 'error))
+(let ()
+ (with-output-to-file tmp-output-file
+ (lambda ()
+ (display "(+ 1 2 3)")))
+ (define* (f1 (a #f)) (read))
+ (test (with-input-from-file tmp-output-file f1) '(+ 1 2 3))
+ (define* (f2 . args) (read))
+ (test (with-input-from-file tmp-output-file f2) '(+ 1 2 3))
+ (define f3 read)
+ (test (with-input-from-file tmp-output-file f3) '(+ 1 2 3))
+ (define (f4) (read))
+ (test (with-input-from-file tmp-output-file f4) '(+ 1 2 3))
+ (define-macro (m1) `(read))
+ (test (with-input-from-file tmp-output-file m1) '(+ 1 2 3))
+ (define-macro (m2) (read))
+ (test (with-input-from-file tmp-output-file m2) 6)
+ (define (f5 a) (read a))
+ (test (with-input-from-file tmp-output-file f5) 'error)
+ (test (with-input-from-file tmp-output-file s7-version) (s7-version)))
+
+(let ()
+ (define (eval-from-string-1 str)
+ (define-macro (m) (read))
+ (with-input-from-string str m))
+ (test (eval-from-string-1 "(+ 1 2 3)") 6)
+ (define (eval-from-string str)
+ (with-input-from-string str (define-macro (m) (read))))
+ (test (eval-from-string "(+ 1 2 3)") 6))
+
+(let ()
+ (define* (f1 (a #f)) (read a))
+ (test (call-with-input-file tmp-output-file f1) '(+ 1 2 3))
+ (define* (f2 . args) (read (car args)))
+ (test (call-with-input-file tmp-output-file f2) '(+ 1 2 3))
+ (define f3 read)
+ (test (call-with-input-file tmp-output-file f3) '(+ 1 2 3))
+ (define-macro (m1 p) `(read ,p))
+ (test (call-with-input-file tmp-output-file m1) '(+ 1 2 3))
+ (define-macro* (m2 (p #f)) (read p))
+ (test (call-with-input-file tmp-output-file m2) 6)
+ (define (f4) (read))
+ (test (call-with-input-file tmp-output-file f4) 'error)
+ (test (call-with-input-file tmp-output-file s7-version) 'error))
+
+(let ((ofile tmp-output-file))
+ (define (get-file-contents)
+ (with-input-from-file ofile read-line))
+
+ (define* (f1 (b 123)) (display b))
+ (test (let () (with-output-to-file ofile f1) (get-file-contents)) "123")
+ (define (f2) (display "123"))
+ (test (let () (with-output-to-file ofile f2) (get-file-contents)) "123")
+ (define (f3 . args) (display 123))
+ (test (let () (with-output-to-file ofile f3) (get-file-contents)) "123")
+ (define-macro (m1) `(write 123))
+ (test (let () (with-output-to-file ofile m1) (get-file-contents)) "123")
+ (define-macro (m2) (write 123))
+ (test (let () (with-output-to-file ofile m2) (get-file-contents)) "123")
+ (define (f4 a b) (display 123))
+ (test (let () (with-output-to-file ofile f4) (get-file-contents)) 'error)
+ (test (let () (with-output-to-file ofile s7-version) (get-file-contents)) #<eof>)
+
+ (define* (f11 a (b 123)) (display b a))
+ (test (let () (call-with-output-file ofile f11) (get-file-contents)) "123")
+ (define (f21 a) (display "123" a))
+ (test (let () (call-with-output-file ofile f21) (get-file-contents)) "123")
+ (define (f31 . args) (display 123 (car args)))
+ (test (let () (call-with-output-file ofile f31) (get-file-contents)) "123")
+ (define-macro (m3 p) `(write 123 ,p))
+ (test (let () (call-with-output-file ofile m3) (get-file-contents)) "123")
+ (define-bacro* (m2 (p 123)) `(write 123 ,p))
+ (test (let () (call-with-output-file ofile m2) (get-file-contents)) "123")
+ (define (f41 a b) (display 123 a))
+ (test (let () (call-with-output-file ofile f41) (get-file-contents)) 'error)
+ (test (let () (call-with-output-file ofile s7-version) (get-file-contents)) 'error))
+
(if (not (eof-object? (with-input-from-string "" (lambda () (read-char)))))
- (format #t ";input from null string not #<eof>?~%")
+ (format-logged #t ";input from null string not #<eof>?~%")
(let ((EOF (with-input-from-string "" (lambda () (read-char)))))
(if (not (eq? (with-input-from-string "" (lambda () (read-char)))
(with-input-from-string "" (lambda () (read-char)))))
- (format #t "#<eof> is not eq? to itself?~%"))
+ (format-logged #t "#<eof> is not eq? to itself?~%"))
(if (char? EOF)
(do ((c 0 (+ c 1)))
((= c 256))
(if (char=? EOF (integer->char c))
- (format #t "#<eof> is char=? to ~C~%" (integer->char c)))))))
+ (format-logged #t "#<eof> is char=? to ~C~%" (integer->char c)))))))
(test (+ 100 (call-with-output-file "tmp.r5rs" (lambda (p) (write "1" p) (values 1 2)))) 103)
(test (+ 100 (with-output-to-file "tmp.r5rs" (lambda () (write "2") (values 1 2)))) 103)
-(let ((str (with-output-to-string
- (lambda ()
- (with-input-from-string "hiho123"
+(if (not pure-s7)
+ (let ((str (with-output-to-string
(lambda ()
- (do ((c (read-char) (read-char)))
- ((or (not (char-ready?))
- (eof-object? c)))
- (display c))))))))
- (if (not (string=? str "hiho123"))
- (format #t "with string ports: ~S?~%" str)))
+ (with-input-from-string "hiho123"
+ (lambda ()
+ (do ((c (read-char) (read-char)))
+ ((or (not (char-ready?))
+ (eof-object? c)))
+ (display c))))))))
+ (if (not (string=? str "hiho123"))
+ (format-logged #t "with string ports 1: ~S?~%" str))))
(let ((str (with-output-to-string
(lambda ()
@@ -8070,7 +14519,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
((eof-object? c))
(display c))))))))
(if (not (string=? str ""))
- (format #t "with string ports and null string: ~S?~%" str)))
+ (format-logged #t "with string ports and null string: ~S?~%" str)))
(let ((str (with-output-to-string ; this is from the guile-user mailing list, I think -- don't know who wrote it
(lambda ()
@@ -8125,9 +14574,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(outx c))))
(outx)))))))))
(if (not (string=? str "ABB BEE EEE E44 446 66F GZY W22 220 0PQ 999 999 999 R."))
- (format #t "call/cc with-input-from-string str: ~A~%" str)))
+ (format-logged #t "call/cc with-input-from-string str: ~A~%" str)))
-(let ((badfile "tmp1.r5rs"))
+(let ((badfile tmp-output-file))
(let ((p (open-output-file badfile)))
(close-output-port p))
(load badfile))
@@ -8136,38 +14585,38 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (str)
;;(test (eval-string str) 'error)
;; eval-string is confused somehow
- (test (with-input-from-string str (lambda () (read))) 'error))
+ (test (with-input-from-string str read) 'error))
(list "\"\\x" "\"\\x0" "`(+ ," "`(+ ,@" "#2d(" "#\\"))
-(let ((loadit "tmp1.r5rs"))
- (let ((p (open-output-file loadit)))
- (display "(define s7test-var 314) (define (s7test-func) 314) (define-macro (s7test-mac a) `(+ ,a 2))" p)
- (newline p)
- (close-output-port p)
+(let ((loadit tmp-output-file))
+ (let ((p1 (open-output-file loadit)))
+ (display "(define s7test-var 314) (define (s7test-func) 314) (define-macro (s7test-mac a) `(+ ,a 2))" p1)
+ (newline p1)
+ (close-output-port p1)
(load loadit)
(test (= s7test-var 314) #t)
(test (s7test-func) 314)
(test (s7test-mac 1) 3)
- (set! p (open-output-file loadit)) ; hopefully this starts a new file
- (display "(define s7test-var 3) (define (s7test-func) 3) (define-macro (s7test-mac a) `(+ ,a 1))" p)
- (newline p)
- (close-output-port p)
- (load loadit)
- (test (= s7test-var 3) #t)
- (test (s7test-func) 3)
- (test (s7test-mac 1) 2)
- ))
+ (let ((p2 (open-output-file loadit))) ; hopefully this starts a new file
+ (display "(define s7test-var 3) (define (s7test-func) 3) (define-macro (s7test-mac a) `(+ ,a 1))" p2)
+ (newline p2)
+ (close-output-port p2)
+ (load loadit)
+ (test (= s7test-var 3) #t)
+ (test (s7test-func) 3)
+ (test (s7test-mac 1) 2)
+ (test (morally-equal? p1 p2) #t))))
(test (+ 100 (with-input-from-string "123" (lambda () (values (read) 1)))) 224)
(for-each
(lambda (op)
(for-each
- (lambda (arg) ;(format #t ";(~A ~A)~%" op arg)
+ (lambda (arg) ;(format-logged #t ";(~A ~A)~%" op arg)
(test (op arg) 'error))
- (list (integer->char 65) 1 0 -1 (list 1) (cons 1 2) #f 'a-symbol (make-vector 3) abs lambda with-environment
- _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list (integer->char 65) 1 0 -1 (list 1) (cons 1 2) 'a-symbol (make-vector 3) abs lambda with-let
+ _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list char-ready? set-current-output-port set-current-input-port set-current-error-port
close-input-port close-output-port open-input-file open-output-file
read-char peek-char read
@@ -8176,19 +14625,19 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (arg) (display "hi" arg))
call-with-input-file with-input-from-file call-with-output-file with-output-to-file))
-(with-output-to-file "tmp1.r5rs"
+(with-output-to-file tmp-output-file
(lambda ()
(display "this is a test")
(newline)))
-(test (call-with-input-file "tmp1.r5rs" (lambda (p) (integer->char (read-byte p)))) #\t)
+(test (call-with-input-file tmp-output-file (lambda (p) (integer->char (read-byte p)))) #\t)
(test (with-input-from-string "123" (lambda () (read-byte))) 49)
-;(test (with-input-from-string "1/0" (lambda () (read))) 'error) ; this is a reader error in CL
+;(test (with-input-from-string "1/0" read) 'error) ; this is a reader error in CL
;;; this test causes trouble when s7test is called from snd-test -- I can't see why
(let ((bytes (vector #o000 #o000 #o000 #o034 #o000 #o001 #o215 #o030 #o000 #o000 #o000 #o022 #o000
#o000 #o126 #o042 #o000 #o000 #o000 #o001 #o000 #o000 #o000 #o000 #o000 #o001)))
- (with-output-to-file "tmp1.r5rs"
+ (with-output-to-file tmp-output-file
(lambda ()
(for-each
(lambda (b)
@@ -8196,62 +14645,72 @@ zzy" (lambda (p) (eval (read p))))) 32)
bytes)))
(let ((ctr 0))
- (call-with-input-file "tmp1.r5rs"
+ (call-with-input-file tmp-output-file
(lambda (p)
- (if (not (string=? (port-filename p) "tmp1.r5rs")) (display (port-filename p)))
+ (if (not (string=? (port-filename p) tmp-output-file)) (display (port-filename p)))
(let loop ((val (read-byte p)))
(if (eof-object? val)
(if (not (= ctr 26))
- (format #t "read-byte done at ~A~%" ctr))
+ (format-logged #t "read-byte done at ~A~%" ctr))
(begin
(if (not (= (bytes ctr) val))
- (format #t "read-byte bytes[~D]: ~A ~A~%" ctr (bytes ctr) val))
+ (format-logged #t "read-byte bytes[~D]: ~A ~A~%" ctr (bytes ctr) val))
(set! ctr (+ 1 ctr))
(loop (read-byte p))))))))
(let ((ctr 0))
- (call-with-input-file "tmp1.r5rs"
+ (call-with-input-file tmp-output-file
(lambda (p)
(let loop ((val (read-char p)))
(if (eof-object? val)
(if (not (= ctr 26))
- (format #t "read-char done at ~A~%" ctr))
+ (format-logged #t "read-char done at ~A~%" ctr))
(begin
(if (not (= (bytes ctr) (char->integer val)))
- (format #t "read-char bytes[~D]: ~A ~A~%" ctr (bytes ctr) (char->integer val)))
+ (format-logged #t "read-char bytes[~D]: ~A ~A~%" ctr (bytes ctr) (char->integer val)))
(set! ctr (+ 1 ctr))
(loop (read-char p))))))))
)
-(with-output-to-file "tmp1.r5rs"
+(with-output-to-file tmp-output-file
(lambda ()
- (if (not (string=? (port-filename (current-output-port)) "tmp1.r5rs")) (display (port-filename (current-output-port))))
+ (if (not (string=? (port-filename (current-output-port)) tmp-output-file)) (display (port-filename (current-output-port))))
(display "(+ 1 2) 32")
(newline)
(display "#\\a -1")))
-(with-input-from-file "tmp1.r5rs"
+(with-input-from-file tmp-output-file
(lambda ()
- (if (not (string=? (port-filename (current-input-port)) "tmp1.r5rs")) (display (port-filename (current-input-port))))
+ (if (not (string=? (port-filename (current-input-port)) tmp-output-file)) (display (port-filename (current-input-port))))
(let ((val (read)))
(if (not (equal? val (list '+ 1 2)))
- (format #t "read: ~A~%" val)))
+ (format-logged #t ";file read +: ~A~%" val)))
(let ((val (read)))
(if (not (equal? val 32))
- (format #t "read: ~A~%" val)))
+ (format-logged #t "file read 32: ~A~%" val)))
(let ((val (read)))
(if (not (equal? val #\a))
- (format #t "read: ~A~%" val)))
+ (format-logged #t "file read a: ~A~%" val)))
(let ((val (read)))
(if (not (equal? val -1))
- (format #t "read: ~A~%" val)))
+ (format-logged #t "file read -1: ~A~%" val)))
(let ((val (read)))
(if (not (eof-object? val))
- (format #t "read: ~A~%" val)))
+ (format-logged #t "file read #<eof>: ~A~%" val)))
(let ((val (read)))
(if (not (eof-object? val))
- (format #t "read again: ~A~%" val)))))
+ (format-logged #t "file read #<eof> again: ~A~%" val)))))
+(let ()
+ (call-with-input-string "012"
+ (lambda (p)
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (let ((c (peek-char p)))
+ (let ((r (read-char p)))
+ (if (not (equal? c r))
+ (format-logged #t ";peek-char: ~A ~A~%" c r))))))))
+
(let ((port #f))
(call-with-exit
(lambda (go)
@@ -8259,31 +14718,31 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format #t ";peek-char input-string: ~A~%" (peek-char p)))
+ (format-logged #t ";peek-char input-string: ~A~%" (peek-char p)))
(go)))))
(if (not (input-port? port))
- (format #t ";c/e-> c/is -> port? ~A~%" port)
+ (format-logged #t ";c/e-> c/is -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format #t ";c/e -> c/is -> closed? ~A~%" port)
+ (format-logged #t ";c/e -> c/is -> closed? ~A~%" port)
(close-input-port port)))))
-(call-with-output-file "tmp1.r5rs" (lambda (p) (display "0123456789" p)))
+(call-with-output-file tmp-output-file (lambda (p) (display "0123456789" p)))
(let ((port #f))
(call-with-exit
(lambda (go)
- (call-with-input-file "tmp1.r5rs"
+ (call-with-input-file tmp-output-file
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format #t ";peek-char input-file: ~A~%" (peek-char p)))
+ (format-logged #t ";peek-char input-file: ~A~%" (peek-char p)))
(go)))))
(if (not (input-port? port))
- (format #t ";c/e -> c/if -> port? ~A~%" port)
+ (format-logged #t ";c/e -> c/if -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format #t ";c/e -> c/if -> closed? ~A~%" port)
+ (format-logged #t ";c/e -> c/if -> closed? ~A~%" port)
(close-input-port port)))))
(let ((port #f))
@@ -8296,15 +14755,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format #t ";peek-char input-string 1: ~A~%" (peek-char p)))
+ (format-logged #t ";peek-char input-string 1: ~A~%" (peek-char p)))
(go))))
(lambda ()
(close-input-port port)))))
(if (not (input-port? port))
- (format #t ";c/e -> dw -> c/is -> port? ~A~%" port)
+ (format-logged #t ";c/e -> dw -> c/is -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format #t ";c/e -> dw -> c/is -> closed? ~A~%" port)
+ (format-logged #t ";c/e -> dw -> c/is -> closed? ~A~%" port)
(close-input-port port)))))
(let ((port #f))
@@ -8313,19 +14772,19 @@ zzy" (lambda (p) (eval (read p))))) 32)
(dynamic-wind
(lambda () #f)
(lambda ()
- (call-with-input-file "tmp1.r5rs"
+ (call-with-input-file tmp-output-file
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format #t ";peek-char input-file: ~A~%" (peek-char p)))
+ (format-logged #t ";peek-char input-file: ~A~%" (peek-char p)))
(go))))
(lambda ()
(close-input-port port)))))
(if (not (input-port? port))
- (format #t ";c/e -> dw -> c/if -> port? ~A~%" port)
+ (format-logged #t ";c/e -> dw -> c/if -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format #t ";c/e -> dw -> c/if -> closed? ~A~%" port)
+ (format-logged #t ";c/e -> dw -> c/if -> closed? ~A~%" port)
(close-input-port port)))))
(let ((port #f))
@@ -8335,31 +14794,31 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format #t ";peek-char input-string: ~A~%" (peek-char p)))
+ (format-logged #t ";peek-char input-string: ~A~%" (peek-char p)))
(error 'oops))))
(lambda args #f))
(if (not (input-port? port))
- (format #t ";catch -> c/is -> error -> port? ~A~%" port)
+ (format-logged #t ";catch -> c/is -> error -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format #t ";catch -> c/is -> error -> closed? ~A~%" port)
+ (format-logged #t ";catch -> c/is -> error -> closed? ~A~%" port)
(close-input-port port)))))
(let ((port #f))
(catch #t
(lambda ()
- (call-with-input-file "tmp1.r5rs"
+ (call-with-input-file tmp-output-file
(lambda (p)
(set! port p)
(if (not (char=? (peek-char p) #\0))
- (format #t ";peek-char input-file: ~A~%" (peek-char p)))
+ (format-logged #t ";peek-char input-file: ~A~%" (peek-char p)))
(error 'oops))))
(lambda args #f))
(if (not (input-port? port))
- (format #t ";catch -> c/if -> error -> port? ~A~%" port)
+ (format-logged #t ";catch -> c/if -> error -> port? ~A~%" port)
(if (not (port-closed? port))
(begin
- (format #t ";catch -> c/if -> error -> closed? ~A~%" port)
+ (format-logged #t ";catch -> c/if -> error -> closed? ~A~%" port)
(close-input-port port)))))
(test (with-output-to-string (lambda () (write (string (integer->char 4) (integer->char 8) (integer->char 20) (integer->char 30))))) "\"\\x04\\x08\\x14\\x1e\"")
@@ -8374,12 +14833,133 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string=? "\x61\x42\x63" "aBc") #t)
+(if (provided? 'system-extras)
+ (begin
-(for-each
- (lambda (arg)
- (test (char-ready? arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #f #t (if #f #f) (lambda (a) (+ a 1))))
+ ;;; directory?
+ (test (directory? tmp-output-file) #f)
+ (test (directory? ".") #t)
+ (test (directory?) 'error)
+ (test (directory? "." 0) 'error)
+ (for-each
+ (lambda (arg)
+ (test (directory? arg) 'error))
+ (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+ ;;; file-exists?
+ (test (file-exists? tmp-output-file) #t)
+ (test (file-exists? "not-a-file-I-hope") #f)
+ (test (file-exists?) 'error)
+ (test (file-exists? tmp-output-file 0) 'error)
+ (for-each
+ (lambda (arg)
+ (test (file-exists? arg) 'error))
+ (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+ ;;; delete-file
+ (test (delete-file tmp-output-file) 0)
+ (test (file-exists? tmp-output-file) #f)
+ (test (delete-file "not-a-file-I-hope") -1)
+ (test (delete-file) 'error)
+ (test (delete-file tmp-output-file 0) 'error)
+ (for-each
+ (lambda (arg)
+ (test (delete-file arg) 'error))
+ (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+ ;;; getenv
+ (test (pair? (member (getenv "HOME") '("/usr/home/bil" "/Users/bil" "/home/bil") string=?)) #t)
+ (test (getenv "NO-ENV") "")
+ (test (getenv) 'error)
+ (test (getenv "HOME" #t) 'error)
+ (for-each
+ (lambda (arg)
+ (test (getenv arg) 'error))
+ (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+ ;;; directory->list
+ (test (directory->list) 'error)
+ (test (directory->list "." 0) 'error)
+ (for-each
+ (lambda (arg)
+ (test (directory->list arg) 'error))
+ (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+ ;;; system
+ (test (system "test -f s7test.scm") 0)
+ (test (system) 'error)
+ (test (let ((str (system "man fgrep" #t)))
+ (and (string? str)
+ (> (length str) 10000))) ; osx: 14479, linux: 40761
+ #t)
+ (for-each
+ (lambda (arg)
+ (test (system arg) 'error))
+ (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+ ))
+
+(let ()
+ (define (args2)
+ (with-output-to-file tmp-data-file
+ (lambda ()
+ (write-byte 1)
+ (write-byte 2)
+ (write-byte 1)
+ (write-byte 2)))
+
+ (let ((v (with-input-from-file tmp-data-file
+ (lambda ()
+ (vector (+ (read-byte) (ash (read-byte) 8))
+ (+ 1 (ash 2 8))
+ (+ (ash (read-byte) 8) (read-byte))
+ (+ (ash 1 8) 2))))))
+ (if (not (equal? v #(513 513 258 258)))
+ (format *stderr* ";2 arg order check: ~A~%" v))))
+
+
+ (args2)
+
+ (define (args3)
+ (with-output-to-file tmp-data-file
+ (lambda ()
+ (do ((i 0 (+ i 1)))
+ ((= i 8))
+ (write-byte 1)
+ (write-byte 2)
+ (write-byte 3))))
+
+ (let ((v (with-input-from-file tmp-data-file
+ (lambda ()
+ (vector (+ (read-byte) (ash (read-byte) 8) (ash (read-byte) 16))
+ (+ 1 (ash 2 8) (ash 3 16))
+ (+ (read-byte) (read-byte) (ash (read-byte) 8))
+ (+ 1 2 (ash 3 8))
+ (+ (read-byte) (ash (read-byte) 8) (read-byte))
+ (+ 1 (ash 2 8) 3)
+ (+ (ash (read-byte) 8) (read-byte) (read-byte))
+ (+ (ash 1 8) 2 3)
+ (+ (ash (read-byte) 8) (ash (read-byte) 16) (read-byte))
+ (+ (ash 1 8) (ash 2 16) 3)
+ (+ (ash (read-byte) 8) (read-byte) (ash (read-byte) 16))
+ (+ (ash 1 8) 2 (ash 3 16)))))))
+ (if (not (equal? v #(197121 197121 771 771 516 516 261 261 131331 131331 196866 196866)))
+ (format *stderr* ";3 arg order check: ~A~%" v))))
+
+ (args3))
+
+(if (not pure-s7)
+ (for-each
+ (lambda (arg)
+ (test (char-ready? arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
;;; -------- format --------
@@ -8389,14 +14969,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "") "")
(test (format #f "" 1) 'error)
(test (format #f "a") "a")
-(test (format #f "a\x00b") "a")
+;(test (format #f "a\x00b") "a")
(test (format #f "~~") "~") ; guile returns this, but clisp thinks it's an error
(test (format #f "~~~~") "~~")
(test (format #f "a~~") "a~")
(test (format #f "~~a") "~a")
(test (format #f "~A" "") "")
-(test (format #f "~{~^~A~}" '()) "")
+(test (format #f "~{~^~A~}" ()) "")
(test (format #f "~{~^~{~^~A~}~}" '(())) "")
(test (format #f "~P" 1) "")
(test (format #f "~P" #\a) 'error)
@@ -8405,16 +14985,182 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~*~*" 1 2) "")
(test (format #f "~20,'~D" 3) "~~~~~~~~~~~~~~~~~~~3")
(test (format #f "~0D" 123) "123")
+(test (format #f "~{~S~}" ()) "")
(test (format #f "~-1D" 123) 'error)
(test (format #f "~+1D" 123) 'error)
(test (format #f "~1.D" 123) 'error)
+(test (format #f "~1+iD" 123) 'error)
+(test (format #f "~1/2D" 123) 'error)
+(test (format #f "~1/1D" 123) 'error)
(test (format #f "~20,'-1D" 123) 'error)
+(for-each
+ (lambda (arg)
+ (test (format arg "~D" 1) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (directive)
+ (for-each
+ (lambda (arg)
+ (test (format #f directive arg) 'error)
+ (test (format #f directive) 'error))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand
+ #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
+ (list "~D" "~F" "~G" "~X" "~B" "~O" "~E" "~P"))
+
+(test (format #f "~,1" 123) 'error)
+;format "~,1" 123: numeric argument, but no directive!
+; (format #f "~,1" 123)
+
+(test (format #f "~,123456789123456789123456789d" 1) 'error)
+;format "~,123456789123456789123456789d" 1: numeric argument too large
+; (format-logged #t "~,123456789123456789123456789d" 1)
+(test (format #f "~969424987x" 12) 'error)
+
+(test (format #f "~D" 1 2) 'error)
+;format: "~D" 1 2
+; ^: too many arguments
+; (format #f "~D" 1 2)
+
+(test (format #f "~D~" 1) 'error)
+;format: "~D~" 1
+; ^: control string ends in tilde
+; (format #f "~D~" 1)
+(test (format #f "~") 'error)
+(test (format #f " ~") 'error)
+(test (format #f "~~~") 'error)
+(test (format #f " ~~~") 'error)
+
+(test (format #f "~@D" 1) 'error)
+;format "~@D" 1: unknown '@' directive
+; (format #f "~@D" 1)
+
+(test (format #f "~@p" #\a) 'error)
+;format "~@p" #\a: '@P' directive argument is not an integer
+; (format #f "~@p" #\a)
+
+(test (format #f "~P" 1+i) 'error)
+;format "~P" 1+1i: 'P' directive argument is not a real number
+; (format #f "~P" 1+1i)
+
+(test (format #f "~P" (real-part (log 0))) "s")
+
+(test (format #f "~@p" 0+i) 'error)
+;format "~@p" 0+1i: '@P' directive argument is not a real number
+; (format #f "~@p" 0+1i)
+
+(test (format #f "~{~}") 'error)
+;format "~{~}": missing argument
+; (format #f "~{~}")
+
+(test (format #f "~{~a" '(1 2 3)) 'error)
+;format "~{~a" (1 2 3): '{' directive, but no matching '}'
+; (format #f "~{~a" '(1 2 3))
+
+(test (format #f "~{~a~}" '(1 . 2)) 'error)
+;format "~{~a~}" (1 . 2): '{' directive argument should be a proper list or something we can turn into a list
+; (format #f "~{~a~}" '(1 . 2))
+
+(test (let ((lst (cons 1 2))) (set-cdr! lst lst) (format #f "~{~A~}" lst)) 'error)
+;format "~{~A~}" #1=(1 . #1#): '{' directive argument should be a proper list or something we can turn into a list
+; (format #f "~{~A~}" lst)
+
+(test (format #f "~{~a~}" 'asdf) 'error)
+;format "~{~a~}" asdf: '{' directive argument should be a proper list or something we can turn into a list
+; (format #f "~{~a~}" 'asdf)
+
+(test (format #f "~{~a~}" ()) "")
+(test (format #f "~{asd~}" '(1 2 3)) 'error)
+;format: "~{asd~}" (1 2 3)
+; ^: '{...}' doesn't consume any arguments!
+; (format #f "~{asd~}" '(1 2 3))
+
+(test (format #f "~}" '(1 2 3)) 'error)
+;format "~}" (1 2 3): unmatched '}'
+; (format #f "~}" '(1 2 3))
+
+(test (format #f "~C") 'error)
+;format "~C": ~C: missing argument
+; (format #f "~C")
+
+(test (format #f "~A ~C" #\a) 'error)
+;format: "~A ~C" #\a
+; ^: ~C: missing argument
+; (format #f "~A ~C" #\a)
+
+(test (format #f "~C" 1) 'error)
+;format "~C" 1: 'C' directive requires a character argument
+; (format #f "~C" 1)
+
+(test (format #f "~C" #<eof>) 'error)
+;format "~C" #<eof>: 'C' directive requires a character argument
+; (format #f "~C" #<eof>)
+
+(test (format #f "~1,9223372036854775807f" 1) 'error)
+;format "~1,9223372036854775807f" 1: numeric argument too large
+; (format #f "~1,9223372036854775807f" 1)
+
+(test (format #f "~1,2A" 1) 'error)
+;format "~1,2A" 1: extra numeric argument
+; (format #f "~1,2A" 1)
+
+(test (format #f "~F" #\a) 'error)
+;format "~F" #\a: ~F: numeric argument required
+; (format #f "~F" #\a)
+
+(test (format #f "~1,") 'error)
+;format "~1,": format directive does not take a numeric argument
+; (format #f "~1,")
+
+(test (format #f "~-1,") 'error)
+;format "~-1,": unimplemented format directive
+; (format #f "~-1,")
+
+(test (format #f "~L" 1) 'error)
+;format "~L" 1: unimplemented format directive
+; (format #f "~L" 1)
+
+(test (format #f "~*") 'error)
+;format "~*": can't skip argument!
+
+(test (format #f "~*~A") 'error)
+(test (format #f "~*~*" 1) 'error)
+(test (format #f "~N") 'error)
+(test (format #f "~N" 2) 'error)
+(test (format #f "~N." 2) 'error)
+(test (format #f "~NT" 2.1) 'error)
+(test (format #f "~NT" #\a) 'error)
+(test (format #f "~N," 1) 'error)
+(test (format #f "~N,N" 1 2) 'error)
+(test (format #f "~N,N." 1 2) 'error)
+(test (format #f "~,N" 1) 'error)
+(test (format #f "~,N." 1) 'error)
+(test (format #f "~ND" 123456789) 'error)
+(test (format #f "~ND" -1) 'error)
+
+(for-each
+ (lambda (c)
+ (test (apply format #f (string-append "~" (string c)) '(a)) 'error))
+ (list #\H #\I #\J #\K #\L #\M #\Q #\R #\U #\V #\Y #\Z
+ #\[ #\\ #\] #\_ #\` #\$ #\# #\! #\" #\' #\( #\) #\+ #\, #\- #\. #\/ #\< #\= #\> #\?
+ #\h #\i #\j #\k #\l #\m #\q #\r #\u #\v #\y #\z))
+
+(test (format #f "~A" 1 2) 'error)
+;format: "~A" 1 2
+; ^: too many arguments
+; (format #f "~A" 1 2)
+
(test (format #f "hiho~%ha") (string-append "hiho" (string #\newline) "ha"))
(test (format #f "~%") (string #\newline))
(test (format #f "~%ha") (string-append (string #\newline) "ha"))
(test (format #f "hiho~%") (string-append "hiho" (string #\newline)))
+(test (eq? #\tab ((format #f "\t") 0)) #t)
+(test (eq? #\newline ((format #f "\n") 0)) #t)
+(test (eq? #\\ ((format #f "\\") 0)) #t)
+(test (eq? #\" ((format #f "\"") 0)) #t)
+
(for-each
(lambda (arg res)
(let ((val (catch #t (lambda () (format #f "~A" arg)) (lambda args 'error))))
@@ -8424,7 +15170,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(display " returned \"") (display val)
(display "\" but expected \"") (display res) (display "\"")
(newline)))))
- (list "hiho" -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.5+1.5i '() '#(()) (list 1 2 3) '(1 . 2) 'hi)
+ (list "hiho" -1 #\a 1 #f #t #(1 2 3) 3.14 3/4 1.5+1.5i () #(()) (list 1 2 3) '(1 . 2) 'hi)
(list "hiho" "-1" "a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i" "()" "#(())" "(1 2 3)" "(1 . 2)" "hi"))
(test (format #f "hi ~A ho" 1) "hi 1 ho")
@@ -8442,18 +15188,28 @@ zzy" (lambda (p) (eval (read p))))) 32)
(display " returned \"") (display val)
(display "\" but expected \"") (display res) (display "\"")
(newline)))))
- (list "hiho" -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.5+1.5i '() '#(()) (list 1 2 3) '(1 . 2) 'hi)
+ (list "hiho" -1 #\a 1 #f #t #(1 2 3) 3.14 3/4 1.5+1.5i () #(()) (list 1 2 3) '(1 . 2) 'hi)
(list "\"hiho\"" "-1" "#\\a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i" "()" "#(())" "(1 2 3)" "(1 . 2)" "hi"))
(test (format #f "hi ~S ho" 1) "hi 1 ho")
(test (format #f "hi ~S ho" "abc") "hi \"abc\" ho")
(test (format #f "~s~a" #\a #\b) "#\\ab")
(test (format #f "~C~c~C" #\a #\b #\c) "abc")
+;(test (format #f "1 2~C 3 4" #\null) "1 2") ; ?? everyone does something different here
+;; s7 used to return "1 2 3 4" because it treated ~C as a string (empty in this case)
+(test (format #f "1 2~C 3 4" #\null) "1 2\x00 3 4") ; this is also what Guile returns
+(test (format #f "~nc" 3 #\a) "aaa")
+(test (format #f "~nc" 0 #\a) "")
+(test (format #f "~nc" -1 #\a) 'error)
+(test (format #f "~nc" most-positive-fixnum #\a) 'error)
+(test (format #f "~nc" 1.0 #\a) 'error)
+(test (format #f "~n~nc" 1 2 #\a) 'error)
+(test (format #f "~na" 1 #\a) 'error)
(test (format #f "~{~A~}" '(1 2 3)) "123")
(test (format #f "asb~{~A ~}asb" '(1 2 3 4)) "asb1 2 3 4 asb")
(test (format #f "asb~{~A ~A.~}asb" '(1 2 3 4)) "asb1 2.3 4.asb")
-(test (format #f ".~{~A~}." '()) "..")
+(test (format #f ".~{~A~}." ()) "..")
(test (format #f "~{~A ~A ~}" '(1 "hi" 2 "ho")) "1 hi 2 ho ")
(test (format #f "~{.~{+~A+~}.~}" (list (list 1 2 3) (list 4 5 6))) ".+1++2++3+..+4++5++6+.")
@@ -8482,10 +15238,35 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~{~A~}" #2D((1 2) (3 4))) "1234") ; this seems inconsistent with:
(test (format #f "~{~A~}" '((1 2) (3 4))) "(1 2)(3 4)")
(test (format #f "~{~A ~}" #2d((1 2) (3 4))) "1 2 3 4 ")
+(test (format #f "1~\
+a2" 3) "132")
+(test (format #f "~{~{~C~^ ~}~^...~}" (list "hiho" "test")) "h i h o...t e s t")
;; ~nT handling is a mess -- what are the defaults? which is column 1? do we space up to or up to and including?
+(test (format #f "~A:~8T~A" 100 'a) "100: a")
+(test (format #f "~A:~nT~A" 100 8 'a) "100: a")
+(test (format #f "~A:~8T~A" 0 'a) "0: a")
+(test (format #f "~A:~8T~A" 10000 'a) "10000: a")
+(test (format #f "~8T~A" 'a) " a")
+(test (format #f "1212:~8T~A" 'a) "1212: a")
+(test (format #f "~D:~8T~A" 100 'a) "100: a")
+(test (format #f "~D:~8T~A" 0 'a) "0: a")
+(test (format #f "~D:~8T~A" 10000 'a) "10000: a")
+(test (format #f "~a~10,7Tb" 1) "1 b")
+(test (format #f "~a~10,7Tb" 10000) "10000 b")
+(test (format #f "~a~10,12Tb" 1) "1 b")
+(test (format #f "~a~10,12Tb" 10000) "10000 b")
+(test (format #f "~a~n,nTb" 10000 10 12) "10000 b")
+(test (format #f "~n,'xT" 8) "xxxxxxx")
+(test (format #f "~n,' T" 8) " ")
+
+(test (length (format #f "~{~A~}~40T." '(1 2 3))) 40)
+(test (length (format #f "~{~A ~}~40T." '(1 2 3))) 40)
+(test (length (format #f "~{~,3F ~}~40T." '(1.0 2.0 3.0))) 40)
+(test (length (format #f "~S~40T." pi)) (if with-bignums 44 40))
+
(test (format #f "asdh~20Thiho") "asdh hiho")
(test (format #f "asdh~2Thiho") "asdhhiho")
(test (format #f "a~Tb") "ab")
@@ -8513,6 +15294,92 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "X~0,TX~0,TX") "XXX")
(test (format #f "X~,0TX~,0TX") "XXX")
+(test (format #f "~0D" 123) "123")
+(test (format #f "~0F" 123.123) "123.123000")
+(test (format #f "~,0D" 123) "123")
+(test (format #f "~,0F" 123.123) "123.0")
+(test (format #f "~,D" 123) "123")
+(test (format #f "~,F" 123.123) "123.123000")
+(test (format #f "~0,D" 123) "123")
+(test (format #f "~0,F" 123.123) "123.123000")
+(test (format #f "~0,0D" 123) "123")
+(test (format #f "~n,nD" 0 0 123) "123")
+(test (format #f "~0,0F" 123.123) "123.0")
+(test (format #f "~0,0,D" 123) 'error)
+(test (format #f "~n,n,D" 0 0 123) 'error)
+(test (format #f "~0,0,F" 123.123) 'error)
+
+(test (format #f "~,3F" 1+i) "1.000+1.000i")
+(test (format #f "~,nF" 3 1+i) "1.000+1.000i")
+(test (format #f "~,3G" 1+i) "1+1i")
+(test (format #f "~,3E" 1+i) "1.000e+00+1.000e+00i")
+(test (format #f "~,3F" 1-i) "1.000-1.000i")
+(test (format #f "~,3G" 1-i) "1-1i")
+(test (format #f "~,3E" 1-i) "1.000e+00-1.000e+00i")
+
+;; not sure about these:
+(test (format #f "~X" 1-i) "1.0-1.0i")
+(test (format #f "~,3D" 1-i) "1.000e+00-1.000e+00i")
+(test (format #f "~A" 1-i) "1-1i")
+
+(test (format #f "~W" 3) "3")
+(test (format #f "~W" 3/4) "3/4")
+(test (format #f "~W" 3.4) "3.4")
+(if with-bignums
+ (test (format #f "~W" pi) "3.141592653589793238462643383279502884195E0")
+ (test (format #f "~W" pi) "3.141592653589793"))
+(test (format #f "~W" 3+4i) "3+4i")
+(test (format #f "~W" 3-4i) "3-4i")
+(if (not with-bignums)
+ (let ((name (if pure-s7 'complex 'complex))
+ (func (if pure-s7 complex complex)))
+ (test (format #f "~W" (func 1/0 0)) "nan.0")
+ (test (format #f "~W" (func 1/0 1)) (format #f "(~S nan.0 1)" name))
+ (test (format #f "~W" (func inf.0 1/0)) (format #f "(~S inf.0 nan.0)" name))
+ (test (format #f "~W" (log 0)) (format #f "(~S -inf.0 3.141592653589793)" name))))
+
+;; see also object->string with :readable
+
+(test (format #f "~000000000000000000000000000000000000000000003F" 123.123456789) "123.123457")
+(test (format #f "~922337203685477580F" 123.123) 'error) ; numeric argument too large
+(test (format #f "~,922337203685477580F" 123.123) 'error)
+(test (format #f "~1,922337203685477580F" 123.123) 'error)
+(test (format #f "~1 ,2F" 123.456789) 'error)
+(test (format #f "~1, 2F" 123.456789) 'error)
+(test (format #f "~1, F" 123.456789) 'error)
+
+(if with-bignums
+ (begin
+ (test (format #f "~o" 1e19) "1.053071060221172E21")
+ (test (format #f "~o" -1e19) "-1.053071060221172E21")
+ (test (format #f "~x" 1e19) "8.ac7230489e8 at 15")
+ (test (format #f "~b" 1e19) "1.00010101100011100100011000001001000100111101E63")
+ (test (format #f "~o" 1e308) "1.071474702753621177617256074117252375235444E341")
+ (test (format #f "~o" -1e308) "-1.071474702753621177617256074117252375235444E341")
+ (test (format #f "~x" 1e308) "8.e679c2f5e44ff8f570f09eaa7ea7648 at 255")
+ (test (format #f "~x" 9.22e18) "7.ff405267d1a at 15")
+ (test (format #f "~b" 1e308) "1.0001110011001111001110000101111010111100100010011111111100011110101011100001111000010011110101010100111111010100111011001001E1023")
+ (test (format #f "~,791o" 1e308) "1.071474702753621177617256074117252375235444E341")
+ (test (format #f "~1200,2g" 1e308) " 9.999999999999999999999999999999999999982E307")
+ (test (format #f "~o" 1e19-1e20i) "1.053071060221172E21-1.2657072742654304E22i")
+ (test (format #f "~x" 1e308+1e300i) "8.e679c2f5e44ff8f570f09eaa7ea7648 at 255+1.7e43c8800759ba59c08e14c7cd7aad86@249i"))
+ (begin
+ (test (format #f "~o" 1e19) "1.053071e21")
+ (test (format #f "~o" -1e19) "-1.053071e21")
+ (test (format #f "~x" 1e19) "8.ac723e15")
+ (test (format #f "~b" 1e19) "1.000101e63")
+ (test (format #f "~o" 1e308) "1.071474e341")
+ (test (format #f "~o" -1e308) "-1.071474e341")
+ (test (format #f "~x" 1e308) "8.e679c2e255")
+ (test (or (string=? (format #f "~x" 9.22e18) "7ff405267d1a0000.0")
+ (string=? (format #f "~x" 9.22e18) "7.ff4052e15"))
+ #t) ; this depends on a cutoff point in s7.c, L8850, number_to_string_with_radix
+ (test (format #f "~b" 1e308) "1.000111e1023")
+ (test (format #f "~,791o" 1e308) "1.0714747027536212e341")
+ (test (format #f "~1200,2g" 1e308) " 1e+308")
+ (test (format #f "~o" 1e19-1e20i) "1.053071e21-1.265707e22i")
+ (test (format #f "~x" 1e308+1e300i) "8.e679c2e255+1.7e43c8e249i")))
+
(test (= (length (substring (format #f "~%~10T.") 1)) (length (format #f "~10T."))) #t)
(test (= (length (substring (format #f "~%-~10T.~%") 1)) (length (format #f "-~10T.~%"))) #t)
(test (string=? (format #f "~%|0 1 2|~21T|5 8 3 2|~%~
@@ -8526,6 +15393,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
|3 0 1| |2 3 0 1| |2 6 6 10|
") #t)
+
+(if (not with-windows) (test (format #f "~S" '(+ 1/0 1/0)) "(+ nan.0 nan.0)")) ; !?
+(if (not with-windows) (test (format #f "~S" '(+ '1/0 1/0)) "(+ 'nan.0 nan.0)")) ; !?
+(test (format #f "~S" '(+ 1/0 1.0/0.0)) (format #f "~S" (list '+ '1/0 '1.0/0.0)))
+(test (format #f "~S" (quote (+ '1 1))) "(+ '1 1)")
+
+
(test (format #f "~12,''D" 1) "'''''''''''1")
(test (let ((str "~12,'xD")) (set! (str 5) #\space) (format #f str 1)) " 1")
(test (format #f "~12,' D" 1) " 1")
@@ -8535,12 +15409,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~12,',d" 1) ",,,,,,,,,,,1")
(test (format #f "~12,',,d" 1) 'error)
(test (format #f "~12,,d" 1) 'error)
+(test (format #f "~n,,d" 12 1) 'error)
(test (string=? (format #f "~%~&" ) (string #\newline)) #t)
(test (string=? (format #f "~%a~&" ) (string #\newline #\a #\newline)) #t)
(test (string=? (format #f "~%~%") (string #\newline #\newline)) #t)
(test (string=? (format #f "~10T~%~&~10T.") (format #f "~10T~&~&~10T.")) #t)
(test (string=? (format #f "~10T~&~10T.") (format #f "~10T~%~&~&~&~&~10T.")) #t)
+(test (length (format #f "~%~&~%")) 2)
+(test (length (format #f "~%~&~&~&~&~%")) 2)
+(test (length (format #f "~&~%")) 1)
(test (format #f "~2,1F" 0.5) "0.5")
(test (format #f "~:2T") 'error)
@@ -8552,7 +15430,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "{~}" '(1 2)) 'error)
(test (format #f "~{~{~}}" '(1 2)) 'error)
(test (format #f "~}" ) 'error)
-(test (format #f "#|~|#|") 'error)
+;(test (format #f "#|~|#|") 'error) ; ~| is ~^+ now
(test (format #f "~1.5F" 1.5) 'error)
(test (format #f "~1+iF" 1.5) 'error)
(test (format #f "~1,1iF" 1.5) 'error)
@@ -8563,12 +15441,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~1.0F" 1.0) 'error)
(test (format #f "~-1F" 1.0) 'error)
(test (format #f "~^") "")
-(test (format #f "~D~" 9) "9~") ; error?
+(test (format #f "~A ~A~|this is not printed" 1 2) "1 2")
+(test (format #f "~^~A~^~A~^this is not printed" 1 2) "12")
+(test (format #f "~|") "")
+(test (format #f "~D~" 9) 'error)
(test (format #f "~&" 9) 'error)
(test (format #f "~D~100T~D" 1 1) "1 1")
(test (format #f ".~P." 1) "..")
(test (format #f ".~P." 1.0) "..")
(test (format #f ".~P." 1.2) ".s.")
+(test (format #f ".~P." 2/3) ".s.")
(test (format #f ".~P." 2) ".s.")
(test (format #f ".~p." 1) "..")
(test (format #f ".~p." 1.0) "..")
@@ -8582,15 +15464,33 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f ".~@p." 1.0) ".y.")
(test (format #f ".~@p." 1.2) ".ies.")
(test (format #f ".~@p." 2) ".ies.")
+(test (format #f ".~P." 1.0+i) 'error)
+(test (format #f ".~P." 1/0) ".s.")
+(test (format #f "~P" 1) "") ; Clisp does this
+(if (not with-windows) (test (format #f ".~P." (real-part (log 0))) ".s."))
(test (format #f (string #\~ #\a) 1) "1")
(test (format #f (format #f "~~a") 1) "1")
(test (format #f (format #f "~~a") (format #f "~D" 1)) "1")
+(test (format #f "~A" (quasiquote quote)) "quote")
(test (format #f "~f" (/ 1 3)) "1/3") ; hmmm -- should it call exact->inexact?
(test (format #f "~f" 1) "1")
(test (format #f "~F" most-positive-fixnum) "9223372036854775807")
+(if (not with-bignums)
+ (begin
+ (test (format #f "~,20F" 1e-20) "0.00000000000000000001")
+ (test (format #f "~,40F" 1e-40) "0.0000000000000000000000000000000000000001")))
+;; if with bignums, these needs more bits
+
+;;; the usual troubles here with big floats:
+;;; (format #f "~F" 922337203685477580.9) -> "922337203685477632.000000"
+;;; (format #f "~F" 9223372036854775.9) -> "9223372036854776.000000"
+;;; (format #f "~F" 1e25) -> "10000000000000000905969664.000000"
+;;; or small:
+;;; (format #f "~,30F" 1e-1) -> "0.100000000000000005551115123126"
+
(if with-bignums
(begin
(test (format #f "~A" -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601) "-7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601")
@@ -8600,21 +15500,30 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~{testing ~D ~C ~}" (list 0 #\( 1 #\) 2 #\* 3 #\+ 4 #\, 5 #\- 6 #\. 7 #\/ 8 #\0 9 #\1 10 #\2 11 #\3 12 #\4 13 #\5 14 #\6 15 #\7 16 #\8 17 #\9 18 #\: 19 #\; 20 #\< 21 #\= 22 #\> 23 #\? 24 #\@ 25 #\A 26 #\B 27 #\C 28 #\D 29 #\E 30 #\F 31 #\G 32 #\H 33 #\I 34 #\J 35 #\K 36 #\L 37 #\M 38 #\N 39 #\O 40 #\P 41 #\Q 42 #\R 43 #\S 44 #\T 45 #\U 46 #\V 47 #\W 48 #\X 49 #\Y 50 #\( 51 #\) 52 #\* 53 #\+ 54 #\, 55 #\- 56 #\. 57 #\/ 58 #\0 59 #\1 60 #\2 61 #\3 62 #\4 63 #\5 64 #\6 65 #\7 66 #\8 67 #\9 68 #\: 69 #\; 70 #\< 71 #\= 72 #\> 73 #\? 74 #\@ 75 #\A 76 #\B 77 #\C 78 #\D 79 #\E 80 #\F 81 #\G 82 #\H 83 #\I 84 #\J 85 #\K 86 #\L 87 #\M 88 #\N 89 #\O 90 #\P 91 #\Q 92 #\R 93 #\S 94 #\T 95 #\U 96 #\V 97 #\W 98 #\X 99 #\Y))
"testing 0 ( testing 1 ) testing 2 * testing 3 + testing 4 , testing 5 - testing 6 . testing 7 / testing 8 0 testing 9 1 testing 10 2 testing 11 3 testing 12 4 testing 13 5 testing 14 6 testing 15 7 testing 16 8 testing 17 9 testing 18 : testing 19 ; testing 20 < testing 21 = testing 22 > testing 23 ? testing 24 @ testing 25 A testing 26 B testing 27 C testing 28 D testing 29 E testing 30 F testing 31 G testing 32 H testing 33 I testing 34 J testing 35 K testing 36 L testing 37 M testing 38 N testing 39 O testing 40 P testing 41 Q testing 42 R testing 43 S testing 44 T testing 45 U testing 46 V testing 47 W testing 48 X testing 49 Y testing 50 ( testing 51 ) testing 52 * testing 53 + testing 54 , testing 55 - testing 56 . testing 57 / testing 58 0 testing 59 1 testing 60 2 testing 61 3 testing 62 4 testing 63 5 testing 64 6 testing 65 7 testing 66 8 testing 67 9 testing 68 : testing 69 ; testing 70 < testing 71 = testing 72 > testing 73 ? testing 74 @ testing 75 A testing 76 B testing 77 C testing 78 D testing 79 E testing 80 F testing 81 G testing 82 H testing 83 I testing 84 J testing 85 K testing 86 L testing 87 M testing 88 N testing 89 O testing 90 P testing 91 Q testing 92 R testing 93 S testing 94 T testing 95 U testing 96 V testing 97 W testing 98 X testing 99 Y ")
-(let ((old-len *vector-print-length*))
+(let ((old-len (*s7* 'print-length)))
(let ((vect1 #3D(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))))
(vect2 #2d((1 2 3 4 5 6) (7 8 9 10 11 12)))
(vect3 #(1 2 3 4 5 6 7 8 9 10 11 12 13 14))
(vect4 #3D(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))))
(do ((i 0 (+ i 2)))
((>= i 10))
- (set! *vector-print-length* i)
+ (set! (*s7* 'print-length) i)
(test (object->string vect1) (format #f "~A" vect1))
(test (object->string vect2) (format #f "~A" vect2))
(test (object->string vect3) (format #f "~A" vect3))
(test (object->string vect4) (format #f "~A" vect4))))
- (set! *vector-print-length* 0)
+ (set! (*s7* 'print-length) 0)
(test (format #f "~A" #()) "#()")
- (set! *vector-print-length* old-len))
+ (set! (*s7* 'print-length) old-len))
+
+(let ((old-pl (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 3)
+ (let ((lst (list 1)))
+ (set-car! lst lst)
+ (let ((v (vector 1 1 1 1 1 1 1 1 1 lst)))
+ (let ((str (format #f "~A" v)))
+ (test (string=? str "#(1 1 1 ...)") #t))))
+ (set! (*s7* 'print-length) old-pl))
(test (format #f "~D" 123) "123")
(test (format #f "~X" 123) "7b")
@@ -8622,6 +15531,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~O" 123) "173")
(test (format #f "~10D" 123) " 123")
+(test (format #f "~nD" 10 123) " 123")
(test (format #f "~10X" 123) " 7b")
(test (format #f "~10B" 123) " 1111011")
(test (format #f "~10O" 123) " 173")
@@ -8687,7 +15597,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(display " returned ") (display result)
(display " but expected 'error")
(newline)))))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi #<eof> abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi #<eof> abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
@@ -8697,7 +15607,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(display " returned ") (display result)
(display " but expected 'error")
(newline)))))
- (list -1 #\a 1 #f #t '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
+ (list -1 #\a 1 #f #t #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2)))
(test (format #f "hi ~A ho" 1 2) 'error)
(test (format #f "hi ~A ho") 'error)
@@ -8723,41 +15633,102 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "asb~{ . ~}asd" '(1 2 3)) 'error)
(test (format #f "asb~{ hiho~~~}asd" '(1 2 3)) 'error)
+(test (format #f "~12C" #\a) "aaaaaaaaaaaa")
+(test (format #f ".~0C." #\a) "..")
+(test (format #f "~10C" #\space) " ")
+
+(test (format #f "~12P" #\a) 'error)
+(test (format #f "~12*" #\a) 'error)
+(test (format #f "~12%" #\a) 'error)
+(test (format #f "~12^" #\a) 'error)
+(test (format #f "~12{" #\a) 'error)
+(test (format #f "~12,2A" #\a) 'error)
+
+(test (format #f "~12,A" #\a) 'error) ; s7 misses padding errors such as (format #f "~12,' A" #\a)
+
+
+;;; I removed this feature 21-Jun-12
+;(test (format #f "~12A" "012345678901234567890") "012345678...")
+;(test (format #f "~1A" "012345678901234567890") "0")
+;(test (format #f "~40A" "012345678901234567890") "012345678901234567890")
+;(test (format #f "~12s" "012345678901234567890") "\"0123456...\"")
+;
+;(let ((old-len (*s7* 'print-length)))
+; (set! (*s7* 'print-length) 32)
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~A" v)) "#(1 2 3 4 5 6 7 8 9 10)")
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~10A" v)) "#(1 2 3...")
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~20A" v)) "#(1 2 3 4 5 6 7 8...")
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~30A" v)) "#(1 2 3 4 5 6 7 8 9 10)")
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~-10A" v)) 'error)
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~10.0A" v)) 'error)
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~10,0A" v)) 'error)
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~10,A" v)) "#(1 2 3...")
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~10,,A" v)) 'error)
+; (test (let ((v (vector 1 2 3 4 5 6 7 8 9 10))) (format #f "~,10A" v)) 'error)
+; (set! (*s7* 'print-length) old-len))
+;
+;(test (let ((v (hash-table '(a . 1) '(b . 2) '(c . 3) '(d . 4)))) (format #f "~20A" v)) "(hash-table '(a ....")
+;(test (let ((v (hash-table '(a . 1) '(b . 2) '(c . 3) '(d . 4)))) (format #f "~40A" v)) "(hash-table '(a . 1) '(b . 2) '(c . 3)...")
+;
+;(test (let ((v (list 1 2 3 4 5 6 7 8 9 10))) (format #f "~20A" v)) "(1 2 3 4 5 6 7 8...")
+
+
#|
+(let ((v (vector 1 2 3 4 5 6 7 8 9 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (let ((str (string-append "~" (number->string i) "A")))
+ (let ((nstr (format #f str v)))
+ (format *stderr* "~D: ~A: ~D~%" i nstr (length nstr))))))
+
+(let ((v (hash-table '(a . 1) '(b . 2) '(c . 3) '(d . 4))))
+ (do ((i 0 (+ i 1)))
+ ((= i 50))
+ (let ((str (string-append "~" (number->string i) "A")))
+ (let ((nstr (format #f str v)))
+ (format *stderr* "~D: ~A: ~D~%" i nstr (length nstr))))))
+
+(let ((v (list 1 2 3 4 5 6 7 8 9 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 24))
+ (let ((str (string-append "~" (number->string i) "A")))
+ (let ((nstr (format #f str v)))
+ (format *stderr* "~D: ~A: ~D~%" i nstr (length nstr))))))
+
(do ((i 0 (+ i 1))) ((= i 256))
(let ((chr (integer->char i)))
- (format #t "~D: ~A ~A ~D~%" i (format #f "~S" (string chr)) (string chr) (length (format #f "~S" (string chr))))))
+ (format-logged #t "~D: ~A ~A ~D~%" i (format #f "~S" (string chr)) (string chr) (length (format #f "~S" (string chr))))))
|#
(for-each
(lambda (arg)
(test (format #f "~F" arg) 'error))
- (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (format #f "~D" arg) 'error))
- (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (format #f "~P" arg) 'error))
- (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (format #f "~X" arg) 'error))
- (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (format #f "~C" arg) 'error))
- (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(for-each
(lambda (arg)
(test (format #f arg 123) 'error))
- (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (format #f "~{~A ~A ~}" '(1 "hi" 2)) 'error)
(for-each
@@ -8768,7 +15739,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(display ") returned ") (display result)
(display " but expected 'error")
(newline)))))
- (list #\a '#(1 2 3) "hi" '() 'hi abs (lambda () 1) '#(()) (list 1 2 3) '(1 . 2)))
+ (list #\a #(1 2 3) "hi" () 'hi abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2)))
(test (format #f "~D") 'error)
(test (format () "hi") 'error)
@@ -8797,7 +15768,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (format arg) 'error))
- (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))
(test (format "hi") "hi") ; !?
(test (format "~A ~D" 1/3 2) "1/3 2")
(test (format "") "")
@@ -8810,8 +15781,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string=? (format #f "~a" #t) "#t") #t)
(test (string=? (format #f "~a" #f) "#f") #t)
(test (string=? (format #f "~a" "abc") "abc") #t)
-(test (string=? (format #f "~a" '#(1 2 3)) "#(1 2 3)") #t)
-(test (string=? (format #f "~a" '()) "()") #t)
+(test (string=? (format #f "~a" #(1 2 3)) "#(1 2 3)") #t)
+(test (string=? (format #f "~a" ()) "()") #t)
(test (string=? (format #f "~a" '(a)) "(a)") #t)
(test (string=? (format #f "~a" '(a b)) "(a b)") #t)
(test (string=? (format #f "~a" '(a (b c) d)) "(a (b c) d)") #t)
@@ -8854,7 +15825,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string=? (format #f "abc~
") "abc") #t)
(test (string=? (format #f "~{ ~a ~}" '(a b c)) " a b c ") #t)
-(test (string=? (format #f "~{ ~a ~}" '()) "") #t)
+(test (string=? (format #f "~{ ~a ~}" ()) "") #t)
(test (string=? (format #f "~{ ~a ~}" "") "") #t)
(test (string=? (format #f "~{ ~a ~}" #()) "") #t)
(test (string=? (format #f "~{ ~a,~a ~}" '(a 1 b 2 c 3)) " a,1 b,2 c,3 ") #t)
@@ -8887,7 +15858,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (string=? (format #f "~A" arg) (format #f "~S" arg)) #t))
- (list 1 1.0 #(1 2 3) '(1 2 3) '(1 . 2) '() #f #t abs #<eof> #<unspecified> 'hi '\a))
+ (list 1 1.0 #(1 2 3) '(1 2 3) '(1 . 2) () #f #t abs #<eof> #<unspecified> 'hi '\a))
(test (length (format #f "~S" (string #\\))) 4) ; "\"\\\\\""
(test (length (format #f "~S" (string #\a))) 3) ; "\"a\""
(test (length (format #f "~S" (string #\null))) 6) ; "\"\\x00\""
@@ -8896,27 +15867,29 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~F" 3.0) "3.000000")
(test (format #f "~G" 3.0) "3.0")
-(test (format #f "~E" 3.0) "3.000000e+00")
+(test (format #f "~E" 3.0) (if (not with-windows) "3.000000e+00" "3.000000e+000"))
(test (format #f "~F" 3.14159) "3.141590")
(test (format #f "~G" 3.14159) "3.14159")
-(test (format #f "~E" 3.14159) "3.141590e+00")
+(test (format #f "~E" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000"))
(test (format #f "~,2F" 3.14159) "3.14")
(test (format #f "~,2G" 3.14159) "3.1")
-(test (format #f "~,2E" 3.14159) "3.14e+00")
+(test (format #f "~,2E" 3.14159) (if (not with-windows) "3.14e+00" "3.14e+000"))
(test (format #f "~12F" 3.14159) " 3.141590")
(test (format #f "~12G" 3.14159) " 3.14159")
-(test (format #f "~12E" 3.14159) "3.141590e+00")
+(test (format #f "~12E" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000"))
(test (format #f "~12,3F" 3.14159) " 3.142")
+(test (format #f "~n,nF" 12 3 3.14159) " 3.142")
+(test (format #f "~12,nF" 3 3.14159) " 3.142")
(test (format #f "~12,3G" 3.14159) " 3.14")
-(test (format #f "~12,3E" 3.14159) " 3.142e+00")
+(test (format #f "~12,3E" 3.14159) (if (not with-windows) " 3.142e+00" " 3.142e+000"))
(test (format #f "~12,'xD" 1) "xxxxxxxxxxx1")
(test (format #f "~12,'xF" 3.14159) "xxxx3.141590")
(test (format #f "~12,'xG" 3.14159) "xxxxx3.14159")
-(test (format #f "~12,'xE" 3.14159) "3.141590e+00")
+(test (format #f "~12,'xE" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000"))
(test (format #f "~12,'\\F" 3.14159) "\\\\\\\\3.141590")
(test (format #f "~20,20G" 3.0) " 3.0")
(test (format #f "~20,20F" 3.0) "3.00000000000000000000")
-(test (format #f "~20,20E" 3.0) "3.00000000000000000000e+00")
+(test (format #f "~20,20E" 3.0) (if (not with-windows) "3.00000000000000000000e+00" "3.00000000000000000000e+000"))
(test (format #f "~,3B" 0.99999) "0.111")
(test (format #f "~,3O" 0.99999) "0.777")
@@ -8929,13 +15902,19 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~2.3F" 0.0) 'error)
(test (format #f "~2,1,3,4F" 0.0) 'error)
(test (format #f "~'xF" 0.0) 'error)
+(test (format #f "~3,3" pi) 'error)
+(test (format #f "~3," pi) 'error)
+(test (format #f "~3" pi) 'error)
+(test (format #f "~," pi) 'error)
+(test (format #f "~'," pi) 'error)
+(test (format #f "~'" pi) 'error)
(test (format #f "~*" 1.0) "")
-(test (format #f "~D" 1.0) "1.000000e+00")
+(test (format #f "~D" 1.0) (if (not with-windows) "1.000000e+00" "1.000000e+000"))
(test (format #f "~O" 1.0) "1.0")
(test (format #f "~P" 1.0) "")
(test (format #f "~P" '(1 2 3)) 'error)
-(test (format #f "~\x00T") "~")
+(test (format #f "~\x00T") 'error)
(test (format #f "~9,'(T") "((((((((")
(test (format #f "~0F" 1+1i) "1.000000+1.000000i")
(test (format #f "~9F" 1) " 1")
@@ -8943,28 +15922,44 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~,0F" 1+1i) "1+1i")
(test (format #f "~,0X" 1+1i) "1.0+1.0i")
(test (format #f "~,9g" 1+1i) "1+1i")
-(test (format #f "~,1e" 3.14) "3.1e+00")
+(test (format #f "~,1e" 3.14) (if (not with-windows) "3.1e+00" "3.1e+000"))
(test (format #f "~9,0F" 3.14) " 3.0")
(test (format #f "~9,1F" 3.14) " 3.1")
(test (format #f "~9,2F" 3.14) " 3.14")
(test (format #f "~9,3F" 3.14) " 3.140")
(test (format #f "~9,4F" 3.14) " 3.1400")
+(test (format #f "~n,4F" 9 3.14) " 3.1400")
+(test (format #f "~9,nF" 4 3.14) " 3.1400")
+(test (format #f "~n,nF" 9 4 3.14) " 3.1400")
(test (format #f "~9,5F" 3.14) " 3.14000")
(test (format #f "~9,6F" 3.14) " 3.140000")
(test (format #f "~9,7F" 3.14) "3.1400000")
(test (format #f "~9,8F" 3.14) "3.14000000")
(test (format #f "~9,9F" 3.14) "3.140000000")
(test (format #f "~9,9G" 1+1i) " 1+1i")
-(test (format #f "~9,0e" 1+1i) "1e+00+1e+00i")
-(test (format #f "~9,1e" 1+1i) "1.0e+00+1.0e+00i")
-(test (format #f "~9,2e" 1+1i) "1.00e+00+1.00e+00i")
-(test (format #f "~9,3e" 1+1i) "1.000e+00+1.000e+00i")
-(test (format #f "~9,4e" 1+1i) "1.0000e+00+1.0000e+00i")
-(test (format #f "~9,5e" 1+1i) "1.00000e+00+1.00000e+00i")
-(test (format #f "~9,6e" 1+1i) "1.000000e+00+1.000000e+00i")
-(test (format #f "~9,7e" 1+1i) "1.0000000e+00+1.0000000e+00i")
-(test (format #f "~9,8e" 1+1i) "1.00000000e+00+1.00000000e+00i")
-(test (format #f "~9,9e" 1+1i) "1.000000000e+00+1.000000000e+00i")
+(if (not with-windows)
+ (begin
+ (test (format #f "~9,0e" 1+1i) "1e+00+1e+00i")
+ (test (format #f "~9,1e" 1+1i) "1.0e+00+1.0e+00i")
+ (test (format #f "~9,2e" 1+1i) "1.00e+00+1.00e+00i")
+ (test (format #f "~9,3e" 1+1i) "1.000e+00+1.000e+00i")
+ (test (format #f "~9,4e" 1+1i) "1.0000e+00+1.0000e+00i")
+ (test (format #f "~9,5e" 1+1i) "1.00000e+00+1.00000e+00i")
+ (test (format #f "~9,6e" 1+1i) "1.000000e+00+1.000000e+00i")
+ (test (format #f "~9,7e" 1+1i) "1.0000000e+00+1.0000000e+00i")
+ (test (format #f "~9,8e" 1+1i) "1.00000000e+00+1.00000000e+00i")
+ (test (format #f "~9,9e" 1+1i) "1.000000000e+00+1.000000000e+00i"))
+ (begin
+ (test (format #f "~9,0e" 1+1i) "1e+000+1e+000i")
+ (test (format #f "~9,1e" 1+1i) "1.0e+000+1.0e+000i")
+ (test (format #f "~9,2e" 1+1i) "1.00e+000+1.00e+000i")
+ (test (format #f "~9,3e" 1+1i) "1.000e+000+1.000e+000i")
+ (test (format #f "~9,4e" 1+1i) "1.0000e+000+1.0000e+000i")
+ (test (format #f "~9,5e" 1+1i) "1.00000e+000+1.00000e+000i")
+ (test (format #f "~9,6e" 1+1i) "1.000000e+000+1.000000e+000i")
+ (test (format #f "~9,7e" 1+1i) "1.0000000e+000+1.0000000e+000i")
+ (test (format #f "~9,8e" 1+1i) "1.00000000e+000+1.00000000e+000i")
+ (test (format #f "~9,9e" 1+1i) "1.000000000e+000+1.000000000e+000i")))
(test (format #f "~9,0x" 3.14) " 3.0")
(test (format #f "~9,1x" 3.14) " 3.2")
(test (format #f "~9,2x" 3.14) " 3.23")
@@ -9015,6 +16010,26 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~@p" #(())) 'error)
(test (format #f "~@p" 'hi) 'error)
(test (format #f "~@p" abs) 'error)
+(let ((old-vp (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 3)
+ (test (format #f "~{~A~| ~}" '(1 2 3 4 5 6)) "1 2 3 ...")
+ (test (format #f "~{~A~| ~}" #(1 2 3 4 5 6)) "1 2 3 ...")
+ (test (format #f "~{~A~| ~}" #(1 2)) "1 2")
+ (test (format #f "~{~A~| ~}" #(1 2 3)) "1 2 3")
+ (test (format #f "~{~A~| ~}" #(1 2 3 4)) "1 2 3 ...")
+ (test (format #f "~{~A~| ~}" (inlet 'a 1 'b 2 'c 3 'd 4 'e 5)) "(a . 1) (b . 2) (c . 3) ...")
+ (test (format #f "~{~{~A~| ~}~}" '((1 2 3 4 5 6))) "1 2 3 ...")
+ (test (format #f "~{~{~A~| ~}~|~}" '((1 2) (3 4 5 6 7 8) (15) (16) ())) "1 23 4 5 ...15 ...")
+ (test (format #f "~{~|~|~|~A ~}" '(1 2 3 4 5)) "1 2 3 ...")
+ (test (format #f "~{~C~| ~}" "1234567") "1 2 3 ...")
+ (test (format #f "~{~{~A~|~} ~}" '((1 2) (3 4))) "12 34 ")
+ (test (format #f "~C ~^" #\a) "a ")
+ (test (format #f "~{~{~{~A~| ~}~| ~}~}" '(((1 2) (3 4)))) "1 2 3 4")
+ (test (format #f "~{~{~{~A~| ~}~| ~}~}" '((#(1 2) #(3 4)))) "1 2 3 4")
+ (test (format #f "~{~{~{~A~| ~}~| ~}~}" #(((1 2) (3 4)))) "1 2 3 4")
+ (test (format #f "~{~{~{~A~| ~}~| ~}~}" #(#((1 2) (3 4)))) "1 2 3 4")
+ (test (format #f "~{~{~C~| ~}~| ~}" (list "hiho" "xxx")) "h i h ... x x x")
+ (set! (*s7* 'print-length) old-vp))
(test (format #f "~{~{~A~^~} ~}" '((hi 1))) "hi1 ")
(test (format #f "~{~{~A~^~} ~}" '((1 2) (3 4))) "12 34 ")
(test (format #f "~{~{~A~} ~}" '((1 2) (3 4))) "12 34 ")
@@ -9022,7 +16037,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~{~{~A~} ~}" '((()))) "() ")
(test (format #f "~{~{~F~} ~}" '(())) " ")
(test (format #f "~{~{~C~} ~}" '(())) " ")
-(test (format #f "~{~C ~}" '()) "")
+(test (format #f "~{~C ~}" ()) "")
(test (format #f "~C ~^" #\a) "a ") ; CL ignores pointless ~^
(test (format #f "~^~A" #f) "#f")
(test (format #f "~^~^~A" #f) "#f")
@@ -9034,6 +16049,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~{~A~}" '(1 2 3 . 4)) 'error)
(test (format #f "~20,vF" 3.14) 'error)
(test (format #f "~{~C~^ ~}" "hiho") "h i h o")
+(test (format #f "~{~{~C~^ ~}~}" (list "hiho")) "h i h o")
(test (format #f "~{~A ~}" #(1 2 3 4)) "1 2 3 4 ")
(test (let ((v (vector 1))) (set! (v 0) v) (format #f "~A" v)) "#1=#(#1#)")
(test (let ((v (vector 1))) (set! (v 0) v) (format #f "~{~A~}" v)) "#1=#(#1#)")
@@ -9046,19 +16062,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~{~{~C~^ ~}~^ ~}" (list "hiho" "xxx")) "h i h o x x x")
(test (format #f "~{~{~A~}~}" '((1 . 2) (3 . 4))) 'error)
(test (format #f "~{~A~^ ~}" '((1 . 2) (3 . 4))) "(1 . 2) (3 . 4)")
-(test (format #f "~{~A ~}" (hash-table '(a . 1) '(b . 2))) "(b . 2) (a . 1) ")
(test (format #f "~{~A ~}" (hash-table)) "")
-
-(let ((ctr ((cadr (make-type :getter (lambda (a b) b) :length (lambda (a) 4))))))
- (test (format #f "~{~A~^ ->~}" ctr) "0 ->1 ->2 ->3"))
-(let ((ctr ((cadr (make-type :getter (lambda (a b) (+ b 3)) :length (lambda (a) 4))))))
- (test (format #f "~{~A~^ ->~}" ctr) "3 ->4 ->5 ->6"))
-
-(test (format #f "~{ ~,-tF ~}" '()) "") ; hmm -- it's ignoring the unimplemented format directive -- should we add an error check?
-(let ((ctr ((cadr (make-type :getter (lambda (a b) (car b)) :length (lambda (a) 4))))))
- (test (format #f "~{~A~^ ->~}" ctr) 'error))
-(let ((ctr ((cadr (make-type :getter (lambda (a b) (+ b 1)) :length (lambda (a) 'hi))))))
- (test (format #f "~{~A~^ ->~}" ctr) 'error))
+(test (format #f "~{~^~S ~}" (make-iterator '(1 2 3))) "1 2 3 ")
+(test (format #f "~{~^~S ~}" (make-iterator (let ((lst (list 1))) (set-cdr! lst lst)))) "1 ")
+(test (format #f "~{~^~S ~}" (make-iterator "")) "")
+(test (format #f "~{~^~S ~}" (make-iterator #(1 2 3))) "1 2 3 ")
(test (format #f "~10,'-T") "---------")
(test (format #f "~10,'\\T") "\\\\\\\\\\\\\\\\\\")
@@ -9070,10 +16078,85 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~,0F" 1.5) "2.0")
(test (format #f "~,0F" 1.6) "2.0")
(test (format #f "~,0F" 0.4) "0.0")
-(test (format #f "~,0F" 0.5) "0.0")
+(test (format #f "~,0F" 0.5) (if (not with-windows) "0.0" "1.0")) ; !!
(test (format #f "~,0F" 0.6) "1.0")
(test (format #f "~,-0F" 1.4) 'error)
(test (format #f "~, 0F" 1.4) 'error)
+(test (format #f "~*1~*" 1) 'error)
+(test (format #f "~*1~A" 1) 'error)
+
+(let* ((str1 #t) (str2 (with-output-to-string (lambda () (set! str1 (format () "~D" 1)))))) (test (and (not str1) (equal? str2 "1")) #t))
+
+(test (format #f "~,'") 'error)
+(if with-bignums
+ (begin
+ (test (format #f "~F" 1e300) "9.999999999999999999999999999999999999987E299")
+ (test (format #f "~F" 1e308) "9.999999999999999999999999999999999999982E307")
+ (test (format #f "~G" 1e308) "9.999999999999999999999999999999999999982E307")
+ (test (format #f "~E" 1e308) "9.999999999999999999999999999999999999982E307")
+ (test (format #f "~E" 1e308+1e308i) "9.999999999999999999999999999999999999982E307+9.999999999999999999999999999999999999982E307i")
+ (test (format #f "~F" 1e308+1e308i) "9.999999999999999999999999999999999999982E307+9.999999999999999999999999999999999999982E307i")
+ (test (format #f "~F" -1e308-1e308i) "-9.999999999999999999999999999999999999982E307-9.999999999999999999999999999999999999982E307i")
+ (test (format #f "~,32f" (/ 1.0 most-positive-fixnum)) "1.084202172485504434125002235952170462235E-19")
+ (test (format #f "~{~^~f ~}" (vector 1e308)) "9.999999999999999999999999999999999999982E307 ")
+ (test (object->string (vector 1e308)) "#(9.999999999999999999999999999999999999982E307)"))
+ (begin
+ (test (format #f "~F" 1e300) "1000000000000000052504760255204420248704468581108159154915854115511802457988908195786371375080447864043704443832883878176942523235360430575644792184786706982848387200926575803737830233794788090059368953234970799945081119038967640880074652742780142494579258788820056842838115669472196386865459400540160.000000")
+ (test (format #f "~F" 1e308) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000")
+ (test (format #f "~G" 1e308) "1e+308")
+ (test (format #f "~E" 1e308) "1.000000e+308")
+ (test (format #f "~E" 1e308+1e308i) "1.000000e+308+1.000000e+308i")
+ (test (format #f "~F" 1e308+1e308i) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000+100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000i")
+ (test (format #f "~F" -1e308-1e308i) "-100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000-100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000i")
+ (test (format #f "~,32f" (/ 1.0 most-positive-fixnum)) "0.00000000000000000010842021724855")
+ (test (format #f "~{~^~f ~}" (vector 1e308)) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000 ")
+ (test (object->string (vector 1e308)) "#(1e+308)")))
+
+
+(when full-test
+ (let ()
+ (define ctrl-chars (vector ;#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\W
+ #\, #\{ #\} #\@ #\P #\* #\< #\>
+ #\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\n #\w
+ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+ #\~ #\T #\& #\% #\^ #\|
+ #\~ #\~ #\~ #\~
+ #\, #\, #\, #\, #\" #\" #\\ #\'
+ #\+ #\- #\@ #\. #\/ #\; #\:
+ ))
+ (define ctrl-chars-len (length ctrl-chars))
+
+ (define (test-chars)
+ (do ((size 1 (+ size 1)))
+ ((= size 7))
+ (let ((tries (* size size 10000)))
+ (format *stderr* "~D " size)
+ (let ((ctrl-str (make-string (+ size 1)))
+ (x 12)
+ (y '(1 2))
+ (z #\a))
+ (string-set! ctrl-str 0 #\~)
+ (do ((i 0 (+ i 1)))
+ ((= i tries))
+ (do ((j 1 (+ j 1)))
+ ((> j size))
+ (string-set! ctrl-str j (vector-ref ctrl-chars (random ctrl-chars-len))))
+ ;(format *stderr* "~S " ctrl-str)
+ ;(catch #t (lambda () (format *stderr* "~S: ~A~%" ctrl-str (format #f ctrl-str))) (lambda arg 'error))
+ ;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str x (format #f ctrl-str x))) (lambda arg 'error))
+ ;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str y (format #f ctrl-str y))) (lambda arg 'error))
+ ;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str z (format #f ctrl-str z))) (lambda arg 'error)))))
+ (catch #t (lambda () (format #f ctrl-str)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str x)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str y)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str x x)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str x y)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str y z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str x y z)) (lambda arg 'error)))))
+ ))
+ (test-chars)))
+
(test (reverse (format #f "~{~A~}" '((1 2) (3 4)))) ")4 3()2 1(")
(test (string->symbol (format #f "~A" '(1 2))) (symbol "(1 2)"))
@@ -9124,14 +16207,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(num-test (string->number (format #f "~X" 0+1i)) 0+1i)
(num-test (string->number (format #f "~O" 0+1i)) 0+1i)
-(test (format "~G" 1e10) "1e+10")
+(test (format "~G" 1e10) (if (not with-windows) "1e+10" "1e+010"))
(test (format "~F" 1e10) "10000000000.000000")
-(test (format "~E" 1e10) "1.000000e+10")
+(test (format "~E" 1e10) (if (not with-windows) "1.000000e+10" "1.000000e+010"))
(test (format "~A" 1e10) "10000000000.0")
-(test (format "~D" 1e10) "1.000000e+10")
+(test (format "~D" 1e10) (if (not with-windows) "1.000000e+10" "1.000000e+010"))
(test (format #f "~P{T}'" 1) "{T}'")
-(test (format #f "~") "~")
+(test (format #f "~") 'error)
(test (format #f "~B&B~X" 1.5 1.5) "1.1&B1.8")
(test (format #f ",~~~A~*1" 1 1) ",~11")
(test (format #f "~D~20B" 0 0) "0 0")
@@ -9154,6 +16237,26 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~20x" 17+23i) " 11.0+17.0i")
(test (length (format #f "~20x" 17+23i)) 20)
+(test (format #f "~{~{~A~^~} ~}" (hash-table '((a . 1) (b . 2)))) "(a . 1)(b . 2) ")
+(test (format #f "~{~{~A~^~}~^~}" (hash-table '((a . 1) (b . 2)))) "(a . 1)(b . 2)")
+(test (format #f "~{~{~A~^ ~}~^~}" (hash-table '((a . 1) (b . 2)))) "(a . 1) (b . 2)")
+(test (format #f "~{~{~{~A~^~} ~}~}" #(())) "")
+(test (format #f "~{~{~{~P~^~} ~}~}" '((()))) " ")
+(test (format #f "~{~{~{~P~^~}~}~}" '(((2 3 4)))) "sss")
+(test (apply format #f "~T~~{~{~{~*~~0~1~*~}~@~}" '(())) "~{")
+(test (format #f "~{~S}%~}" '(a b c)) "a}%b}%c}%")
+(test (format #f "~&~^%~F." 0) "%0.")
+(test (format #f "1~^2") "1")
+(test (apply format #f "~P~d~B~~" '(1 2 3)) "211~")
+(test (format #f "~T1~~^~P" 0) "1~^s")
+(test (format #f "~S~^~{~^" '(+ x 1)) "(+ x 1)")
+(test (format #f "1~^~{2") "1")
+(test (format #f "~A~{~0~g~@~B~}" () ()) "()")
+(test (format #f "1~^~^~^2") "1")
+(test (format #f "~{~{~~}~~,~}~*" '(()) '(())) "~,")
+(test (format #f "~~S~S~T~~C~g~~" 0 0) "~S0~C0~")
+(test (format #f "~{~~e~}~~{~*~~" "" "") "~{~")
+
(let ()
(define* (clean-string e (precision 3))
(format #f (format #f "(~~{~~,~DF~~^ ~~})" precision) e))
@@ -9163,8 +16266,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(if with-bignums
(begin
- (test (format #f "~P" (bignum "1")) "s")
- (test (format #f "~P" (bignum "1.0")) "s")
+ (test (format #f "~P" (bignum "1")) "")
+ (test (format #f "~P" (bignum "1.0")) "")
+ (test (format #f "~P" (bignum "2")) "s")
+ (test (format #f "~P" (bignum "2.0")) "s")
(test (format #f "~10,' D" (bignum "1")) " 1")
(test (format #f "~10,' D" (bignum "3/4")) " 3/4")
(test (format #f "~10,'.D" (bignum "3/4")) ".......3/4")
@@ -9174,8 +16279,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
))
-(call-with-output-file "tmp1.r5rs" (lambda (p) (format p "this ~A ~C test ~D" "is" #\a 3)))
-(let ((res (call-with-input-file "tmp1.r5rs" (lambda (p) (read-line p)))))
+(call-with-output-file tmp-output-file (lambda (p) (format p "this ~A ~C test ~D" "is" #\a 3)))
+(let ((res (call-with-input-file tmp-output-file (lambda (p) (read-line p)))))
(if (not (string=? res "this is a test 3"))
(begin
(display "call-with-input-file + format to \"tmp1.r5rs\" ... expected \"this is a test 3\", but got \"")
@@ -9220,6 +16325,60 @@ zzy" (lambda (p) (eval (read p))))) 32)
(display "open-output-string + format ... expected \"this is a test 3\", but got \"")
(display res) (display "\"?") (newline))))
+(test (with-output-to-string (lambda () (display 123) (flush-output-port))) "123")
+(test (with-output-to-string (lambda () (display 123) (flush-output-port) (display 124))) "123124")
+
+(test (call-with-output-string
+ (lambda (p)
+ (write 1 p)
+ (display 2 p)
+ (format p "~D" 3)
+ (write-byte (char->integer #\4) p)
+ (write-char #\5 p)
+ (write-string "6" p)
+ (write 1 #f)
+ (display 2 #f)
+ (format #f "~D" 3)
+ (write-byte (char->integer #\4) #f)
+ (write-char #\5 #f)
+ (write-string "6" #f)))
+ "123456")
+
+(test (write-byte most-positive-fixnum #f) 'error)
+(test (write-byte -1 #f) 'error)
+(test (write-byte 256 #f) 'error)
+
+(let ((res #f))
+ (let ((this-file (open-output-string)))
+ (format this-file "this is a test")
+ (set! res (get-output-string this-file))
+ (if (not (string=? res "this is a test"))
+ (format-logged #t "open-output-string + format expected \"this is a test\", but got ~S~%" res))
+ (flush-output-port this-file)
+ (set! res (get-output-string this-file))
+ (if (not (string=? res "this is a test"))
+ (format-logged #t "flush-output-port of string port expected \"this is a test\", but got ~S~%" res))
+ (format this-file "this is a test")
+ (set! res (get-output-string this-file))
+ (if (not (string=? res "this is a testthis is a test"))
+ (format-logged #t "open-output-string after flush expected \"this is a testthis is a test\", but got ~S~%" res))
+ (close-output-port this-file)
+ (test (flush-output-port this-file) this-file)))
+
+(test (flush-output-port "hiho") 'error)
+(test (flush-output-port *stdin*) 'error)
+
+(call-with-output-file tmp-output-file
+ (lambda (p)
+ (format p "123456~%")
+ (format p "67890~%")
+ (flush-output-port p)
+ (test (call-with-input-file tmp-output-file
+ (lambda (p)
+ (read-line p)))
+ "123456")
+ (close-output-port p)))
+
(let ((res1 #f)
(res2 #f)
(res3 #f))
@@ -9229,9 +16388,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(format p2 "~D" 1)
(let ((p3 (open-output-string)))
(if (not (string=? (get-output-string p1) "0"))
- (format #t ";format to nested ports, p1: ~S~%" (get-output-string p1)))
+ (format-logged #t ";format to nested ports, p1: ~S~%" (get-output-string p1)))
(if (not (string=? (get-output-string p2) "1"))
- (format #t ";format to nested ports, p2: ~S~%" (get-output-string p2)))
+ (format-logged #t ";format to nested ports, p2: ~S~%" (get-output-string p2)))
(format p3 "~D" 2)
(format p2 "~D" 3)
(format p1 "~D" 4)
@@ -9239,24 +16398,26 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! res3 (get-output-string p3))
(close-output-port p3)
(if (not (string=? (get-output-string p1) "04"))
- (format #t ";format to nested ports after close, p1: ~S~%" (get-output-string p1)))
+ (format-logged #t ";format to nested ports after close, p1: ~S~%" (get-output-string p1)))
(if (not (string=? (get-output-string p2) "13"))
- (format #t ";format to nested ports after close, p2: ~S~%" (get-output-string p2))))
+ (format-logged #t ";format to nested ports after close, p2: ~S~%" (get-output-string p2))))
(format (or p1 p3) "~D" 6)
(format (and p1 p2) "~D" 7)
(set! res1 (get-output-string p1))
(close-output-port p1)
(if (not (string=? (get-output-string p2) "137"))
- (format #t ";format to nested ports after 2nd close, p2: ~S~%" (get-output-string p2)))
+ (format-logged #t ";format to nested ports after 2nd close, p2: ~S~%" (get-output-string p2)))
(format p2 "~D" 8)
(set! res2 (get-output-string p2))
+ (test (get-output-string p1) 'error)
+ (test (get-output-string p2 "hi") 'error)
(close-output-port p2)))
(if (not (string=? res1 "046"))
- (format #t ";format to nested ports, res1: ~S~%" res1))
+ (format-logged #t ";format to nested ports, res1: ~S~%" res1))
(if (not (string=? res2 "1378"))
- (format #t ";format to nested ports, res2: ~S~%" res2))
+ (format-logged #t ";format to nested ports, res2: ~S~%" res2))
(if (not (string=? res3 "25"))
- (format #t ";format to nested ports, res3: ~S~%" res3)))
+ (format-logged #t ";format to nested ports, res3: ~S~%" res3)))
(test (call/cc (lambda (return)
(let ((val (format #f "line 1~%line 2~%line 3")))
@@ -9264,10 +16425,12 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p) (return "oops"))))))
"oops")
-(format #t "format #t: ~D" 1)
-(format (current-output-port) " output-port: ~D! (this is testing output ports)~%" 2)
+(test (get-output-string #f 64) 'error)
-(call-with-output-file "tmp1.r5rs"
+;(format-logged #t "format #t: ~D" 1)
+;(format (current-output-port) " output-port: ~D! (this is testing output ports)~%" 2)
+
+(call-with-output-file tmp-output-file
(lambda (p)
(display 1 p)
(write 2 p)
@@ -9287,88 +16450,204 @@ zzy" (lambda (p) (eval (read p))))) 32)
(display (read-line pin) p)))
(newline p)))
-(test (call-with-input-file "tmp1.r5rs"
+(test (call-with-input-file tmp-output-file
(lambda (p)
(read-line p)))
"1234567890")
-(call-with-output-file "tmp1.r5rs"
+(call-with-output-file tmp-output-file
(lambda (p)
(format p "12345~%")
(format p "67890~%")))
-(call-with-input-file "tmp1.r5rs"
+(call-with-input-file tmp-output-file
(lambda (p)
(test (read-char p) #\1)
(test (read-byte p) (char->integer #\2))
(test (peek-char p) #\3)
- (test (char-ready? p) #t)
+ (if (not pure-s7) (test (char-ready? p) #t))
(test (read-line p) "345")
(test (read-line p) "67890")))
-(let ((op1 (set-current-output-port (open-output-file "tmp1.r5rs"))))
- (display 1)
- (write 2)
- (write-char #\3)
- (format #t "~D" 4) ; #t -> output port
- (write-byte (char->integer #\5))
- (let ((op2 (set-current-output-port (open-output-file "tmp2.r5rs"))))
- (display 6)
- (write 7)
- (write-char #\8)
- (format #t "~D" 9)
- (write-byte (char->integer #\0))
- (newline)
- (close-output-port (current-output-port))
- (set-current-output-port op2)
- (let ((ip1 (set-current-input-port (open-input-file "tmp2.r5rs"))))
- (display (read-line))
- (close-input-port (current-input-port))
- (set-current-input-port ip1))
- (newline)
- (close-output-port (current-output-port))
- (set-current-output-port op1)))
-
-(let ((old-op1 (current-output-port))
- (op1 (open-output-file "tmp1.r5rs")))
- (set! (current-output-port) op1)
- (display 1)
- (write 2)
- (write-char #\3)
- (format #t "~D" 4) ; #t -> output port
- (write-byte (char->integer #\5))
- (let ((old-op2 (current-output-port))
- (op2 (open-output-file "tmp2.r5rs")))
- (set! (current-output-port) op2)
- (display 6)
- (write 7)
- (write-char #\8)
- (format #t "~D" 9)
- (write-byte (char->integer #\0))
- (newline)
- (close-output-port (current-output-port))
- (set! (current-output-port) old-op2)
- (let ((old-ip1 (current-input-port))
- (ip1 (open-input-file "tmp2.r5rs")))
- (set! (current-input-port) ip1)
- (display (read-line))
- (close-input-port (current-input-port))
- (set! (current-input-port) old-ip1))
- (newline)
- (close-output-port (current-output-port))
- (set! (current-output-port) old-op1)))
+(call-with-output-file tmp-output-file
+ (lambda (p)
+ (write-string "123" p)
+ (write-string "" p)
+ (write-string "456\n789" p)))
-(test (call-with-input-file "tmp1.r5rs"
- (lambda (p)
- (read-line p)))
- "1234567890")
+(call-with-input-file tmp-output-file
+ (lambda (p)
+ (test (read-line p) "123456")
+ (test (read-char p) #\7)
+ (test (read-char p) #\8)
+ (test (read-char p) #\9)
+ (test (eof-object? (read-char p)) #t)))
+
+(test (with-output-to-string
+ (lambda ()
+ (write-string "123")
+ (write-string "")
+ (write-string "456")))
+ "123456")
+
+(test (with-output-to-string
+ (lambda ()
+ (write-string "123" (current-output-port))
+ (write-string "" (current-output-port))
+ (write-string "456" (current-output-port))
+ (write-string "678" (current-output-port) 1)
+ (write-string "679" (current-output-port) 2 3)
+ (write-string "079" (current-output-port) 0 1)
+ (write-string "123" (current-output-port) 0 3)
+ (write-string "123" (current-output-port) 3 3)
+ (write-string "" (current-output-port) 0 0)
+ (write-string "1423" (current-output-port) 1 1) ; 1.3.3: end is exclusive, if start=end, empty result
+ (write-string "1423" (current-output-port) 1 4/2)
+ (write-string "5423" (current-output-port) -0 1)))
+ "123456789012345")
+
+(test (write-string "12345" -1) 'error)
+(test (write-string "12345" 0 -1) 'error)
+(test (write-string "12345" 0 18) 'error)
+(test (write-string "12345" 18) 'error)
+(test (write-string "12345" 2 1) 'error)
+(test (write-string "12345" 5 5) 'error)
+(test (write-string "12345" 0.0 2) 'error)
+(test (write-string "12345" 0 2.0) 'error)
+(test (write-string "12345" 0 1+i) 'error)
+(test (write-string "12345" 0 2/3) 'error)
+(test (write-string "12345" 0 #\a) 'error)
+(test (write-string "12345" #\null) 'error)
+(test (write-string "12345" most-negative-fixnum) 'error)
+(test (write-string "12345" 0 most-positive-fixnum) 'error)
+(test (write-string "12345" 0 4294967296) 'error)
+(test (write-string "a" #f 1) "")
+(test (write-string "abc" #f 3) "")
+(test (write-string "ab" #f 1) "b")
+(test (write-string "ab" #f 2) "")
+(test (write-string "abc" #f 1 2) "b")
+(test (write-string "abc" #f 1 3) "bc")
+
+(test (with-input-from-string "12345" (lambda () (read-string 3))) "123")
+(test (with-input-from-string "" (lambda () (read-string 3))) #<eof>)
+(test (with-input-from-string "" (lambda () (read-string 0))) "")
+(test (with-input-from-string "1" (lambda () (read-string 0))) "")
+(test (with-input-from-string "1" (lambda () (read-string -1))) 'error)
+(test (with-input-from-string "1" (lambda () (read-string #f))) 'error)
+(test (with-input-from-string "123" (lambda () (read-string 10))) "123")
+(test (call-with-input-string "123" (lambda (p) (read-string 2 p))) "12")
+(test (call-with-input-string "123" (lambda (p) (read-string 2 #f))) 'error)
+(test (call-with-input-string "123" (lambda (p) (read-string 2 (current-output-port)))) 'error)
+(test (call-with-input-string "123" (lambda (p) (read-string 0 #<unspecified>))) 'error)
+(test (call-with-input-string "123" (lambda (p) (read-string 0 123))) 'error)
+
+(test (read-string most-positive-fixnum) 'error)
+(test (read-string -1) 'error)
+(test (read-string most-negative-fixnum) 'error)
+;(test (read-string 0) "")
+; (test (read-string 123) "")
+; s7 considers this file (during load) to be the current-input-file, so the above read-string ruins the load
+; the other choice is to hang (waiting for stdin)
+; perhaps this choice should be documented since it is specifically contrary to r7rs
+
+(test (write 1 (current-input-port)) 'error)
+(test (write-char #\a (current-input-port)) 'error)
+(test (write-byte 0 (current-input-port)) 'error)
+(test (read (current-output-port)) 'error)
+(test (read-char (current-output-port)) 'error)
+(test (read-byte (current-output-port)) 'error)
+(test (read-line (current-output-port)) 'error)
+(test (display 3) 3)
+(test (display 3 #f) 3)
+
+(when (not pure-s7)
+ (let ((op1 (set-current-output-port (open-output-file tmp-output-file))))
+ (display 1)
+ (write 2)
+ (write-char #\3)
+ (format-logged #t "~D" 4) ; #t -> output port
+ (write-byte (char->integer #\5))
+ (let ((op2 (set-current-output-port (open-output-file "tmp2.r5rs"))))
+ (display 6)
+ (write 7)
+ (write-char #\8)
+ (format-logged #t "~D" 9)
+ (write-byte (char->integer #\0))
+ (newline)
+ (close-output-port (current-output-port))
+ (set-current-output-port op2)
+ (let ((ip1 (set-current-input-port (open-input-file "tmp2.r5rs"))))
+ (display (read-line))
+ (close-input-port (current-input-port))
+ (set-current-input-port ip1))
+ (newline)
+ (close-output-port (current-output-port)))
+
+ (set-current-output-port #f)
+ (test (string? (format #t "~%")) #t)
+ (write "write: should not appear" #f) (newline #f)
+ (display "display: should not appear" #f) (newline #f)
+ (format #f "format: should not appear") (newline #f)
+ (write-string "write-string: should not appear" #f) (newline #f)
+ (write-char #\! #f)
+ (write-byte 123 #f)
+
+ (write "write: should not appear" (current-output-port)) (newline (current-output-port))
+ (display "display: should not appear" (current-output-port)) (newline (current-output-port))
+ (format (current-output-port) "format: should not appear") (newline (current-output-port))
+ (write-string "write-string: should not appear" (current-output-port)) (newline (current-output-port))
+ (write-char #\! (current-output-port))
+ (write-byte 123 (current-output-port))
+
+ (write "write: should not appear") (newline)
+ (display "display: should not appear") (newline)
+ (format #t "format: should not appear") (newline)
+ (write-string "write-string: should not appear") (newline)
+ (write-char #\!)
+ (write-byte 123)
+
+ (set-current-output-port op1))
+
+ (let ((old-op1 (current-output-port))
+ (op1 (open-output-file tmp-output-file)))
+ (set! (current-output-port) op1)
+ (display 1)
+ (write 2)
+ (write-char #\3)
+ (format-logged #t "~D" 4) ; #t -> output port
+ (write-byte (char->integer #\5))
+ (let ((old-op2 (current-output-port))
+ (op2 (open-output-file "tmp2.r5rs")))
+ (set! (current-output-port) op2)
+ (display 6)
+ (write 7)
+ (write-char #\8)
+ (format-logged #t "~D" 9)
+ (write-byte (char->integer #\0))
+ (newline)
+ (close-output-port (current-output-port))
+ (set! (current-output-port) old-op2)
+ (let ((old-ip1 (current-input-port))
+ (ip1 (open-input-file "tmp2.r5rs")))
+ (set! (current-input-port) ip1)
+ (display (read-line))
+ (close-input-port (current-input-port))
+ (set! (current-input-port) old-ip1))
+ (newline)
+ (close-output-port (current-output-port))
+ (set! (current-output-port) old-op1)))
+
+ (test (call-with-input-file tmp-output-file
+ (lambda (p)
+ (read-line p)))
+ "1234567890"))
(for-each
(lambda (op)
(for-each
(lambda (arg)
(test (op arg display) 'error))
- (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list call-with-output-file call-with-input-file
call-with-output-string call-with-input-string
with-input-from-string with-input-from-file
@@ -9379,7 +16658,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (op arg) 'error))
- (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list open-output-file open-input-file
open-input-string))
@@ -9388,7 +16667,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (op "hi" arg) 'error))
- (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t (if #f #f) (lambda (a) (+ a 1)))))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1)))))
(list write display write-byte newline write-char
read read-char read-byte peek-char char-ready? read-line))
@@ -9398,15 +16677,49 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (write-byte arg) 'error)
(test (read-char arg) 'error)
(test (read-byte arg) 'error)
- (test (peek-char arg) 'error))
- (list "hi" 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t (if #f #f) (lambda (a) (+ a 1))))
+ (test (peek-char arg) 'error)
+ (test (write-char #\a arg) 'error)
+ (test (write-byte 1 arg) 'error))
+ (list "hi" 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (write-byte -1) 'error)
+(test (write-byte most-positive-fixnum) 'error)
+(test (write-byte 300) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (write-string arg) 'error)
+ (test (write-string "hi" arg) 'error))
+ (list 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(test (with-output-to-string (lambda () (newline #f))) "")
+(test (with-output-to-string (lambda () (write-byte 95 #f))) "")
+(test (with-output-to-string (lambda () (write-char #\a #f))) "")
+(test (with-output-to-string (lambda () (write-string "a" #f))) "")
+(test (with-output-to-string (lambda () (write "hiho" #f))) "")
+(test (with-output-to-string (lambda () (display "hiho" #f))) "")
+(test (with-output-to-string (lambda () (format #f "hiho"))) "")
+
+(when (not pure-s7)
+ (test (with-output-to-string
+ (lambda ()
+ (set! (current-output-port) #f)
+ (newline (current-output-port))
+ (write-byte 95 (current-output-port))
+ (write-char #\a (current-output-port))
+ (write-string "a" (current-output-port))
+ (write "hiho" (current-output-port))
+ (display "hiho" (current-output-port))
+ (format (current-output-port) "hiho")))
+ "")
+ (set! (current-output-port) *stdout*))
(for-each
(lambda (op)
(for-each
(lambda (arg)
(test (op arg) 'error))
- (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs (if #f #f) (lambda (a) (+ a 1)))))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs :hi (if #f #f) (lambda (a) (+ a 1)))))
(list set-current-input-port set-current-error-port set-current-output-port close-input-port close-output-port))
(let ((hi (open-output-string)))
@@ -9423,7 +16736,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (arg)
(test (get-output-string arg) 'error))
- (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((p (open-output-string)))
+ (write 123 p)
+ (test (get-output-string p) "123")
+ (write 124 p)
+ (test (get-output-string p #t) "123124")
+ (test (get-output-string p #t) "")
+ (write 123 p)
+ (test (get-output-string p) "123"))
;; since read of closed port will generate garbage, it needs to be an error,
;; so I guess write of closed port should also be an error
@@ -9438,8 +16760,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (p) (write-char #\a p))
(lambda (p) (write-byte 0 p))
(lambda (p) (format p "hiho"))
- set-current-output-port
- set-current-input-port
+ (if pure-s7 newline set-current-output-port)
+ (if pure-s7 newline set-current-input-port)
set-current-error-port
newline)))
@@ -9449,30 +16771,51 @@ zzy" (lambda (p) (eval (read p))))) 32)
(for-each
(lambda (op)
(test-e (op hi) (object->string op) 'closed-port))
- (list read read-char read-byte peek-char char-ready? read-line
+ (list read read-char read-byte peek-char read-line
port-filename port-line-number
- set-current-output-port
- set-current-input-port
+ (if pure-s7 read-line char-ready?)
+ (if pure-s7 read-line set-current-output-port)
+ (if pure-s7 read-line set-current-input-port)
set-current-error-port
)))
(test (close-output-port (open-input-string "hiho")) 'error)
(test (close-input-port (open-output-string)) 'error)
(test (set! (port-filename) "hiho") 'error)
-(test (set! (port-closed (current-output-port)) "hiho") 'error)
+(test (set! (port-closed? (current-output-port)) "hiho") 'error)
+(test (begin (close-output-port *stderr*) (port-closed? *stderr*)) #f)
+(test (begin (close-output-port *stdout*) (port-closed? *stdout*)) #f)
+(test (begin (close-input-port *stdin*) (port-closed? *stdin*)) #f)
+
+(test (let ((str ""))
+ (with-input-from-string "1234567890" (lambda ()
+ (with-input-from-string "1234567890" (lambda ()
+ (with-input-from-string "1234567890" (lambda ()
+ (with-input-from-string "1234567890" (lambda ()
+ (with-input-from-string "1234567890" (lambda ()
+ (with-input-from-string "1234567890" (lambda ()
+ (with-input-from-string "1234567890" (lambda ()
+ (set! str (string-append str (string (read-char))))))
+ (set! str (string-append str (string (read-char) (read-char))))))
+ (set! str (string-append str (string (read-char) (read-char) (read-char))))))
+ (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char))))))
+ (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char))))))
+ (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char) (read-char))))))
+ (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char) (read-char) (read-char))))))
+ str)
+ "1121231234123451234561234567")
(let* ((new-error-port (open-output-string))
(old-error-port (set-current-error-port new-error-port)))
(catch #t
- (lambda ()
- (format #f "~R" 123))
- (lambda args
- (format (current-error-port) "oops")))
+ (lambda ()
+ (format #f "~R" 123))
+ (lambda args
+ (format (current-error-port) "oops")))
(let ((str (get-output-string new-error-port)))
(set-current-error-port old-error-port)
(test str "oops")))
-
(let ((hi (open-input-string "hiho")))
(for-each
(lambda (op)
@@ -9485,6 +16828,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
newline))
(close-input-port hi))
+(let ((hi (open-output-file tmp-output-file)))
+ (write-byte 1 hi)
+ (close-output-port hi)
+ (test (write-byte 1 hi) 'error))
+
(let ((hi (open-output-string)))
(for-each
(lambda (op)
@@ -9495,29 +16843,34 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (output-port? (current-error-port)) #t)
(test (and (not (null? (current-error-port))) (input-port? (current-error-port))) #f)
-(call-with-output-file "tmp1.r5rs"
+(call-with-output-file tmp-output-file
(lambda (p)
(test (get-output-string p) 'error)
(do ((i 0 (+ i 1)))
((= i 256))
(write-byte i p))))
-(call-with-input-file "tmp1.r5rs"
+(call-with-input-file tmp-output-file
(lambda (p)
(test (get-output-string p) 'error)
- (do ((i 0 (+ i 1)))
- ((= i 256))
- (let ((b (read-byte p)))
- (if (not (= b i))
- (format #t "read-byte got ~A, expected ~A~%" b i))))
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (let ((b (read-byte p)))
+ (if (or (not (number? b))
+ (not (= b i)))
+ (begin
+ (format-logged #t "read-byte got ~A, expected ~A~%" b i)
+ (quit)))))))
(let ((eof (read-byte p)))
(if (not (eof-object? eof))
- (format #t "read-byte at end: ~A~%" eof)))
+ (format-logged #t "read-byte at end: ~A~%" eof)))
(let ((eof (read-byte p)))
(if (not (eof-object? eof))
- (format #t "read-byte at end: ~A~%" eof)))))
+ (format-logged #t "read-byte at end: ~A~%" eof)))))
-(call-with-output-file "tmp1.r5rs"
+(call-with-output-file tmp-output-file
(lambda (p)
(do ((i 0 (+ i 1)))
((= i 256))
@@ -9525,21 +16878,25 @@ zzy" (lambda (p) (eval (read p))))) 32)
(define our-eof #f)
-(call-with-input-file "tmp1.r5rs"
+(call-with-input-file tmp-output-file
(lambda (p)
- (do ((i 0 (+ i 1)))
- ((= i 256))
- (let ((b (read-char p)))
- (if (or (not (char? b))
- (not (char=? b (integer->char i))))
- (format #t "read-char got ~A, expected ~A (~D: char? ~A)~%" b (integer->char i) i (char? (integer->char i))))))
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (let ((b (read-char p)))
+ (if (or (not (char? b))
+ (not (char=? b (integer->char i))))
+ (begin
+ (format-logged #t "read-char got ~A, expected ~A (~D: char? ~A)~%" b (integer->char i) i (char? (integer->char i)))
+ (quit)))))))
(let ((eof (read-char p)))
(if (not (eof-object? eof))
- (format #t "read-char at end: ~A~%" eof))
+ (format-logged #t "read-char at end: ~A~%" eof))
(set! our-eof eof))
(let ((eof (read-char p)))
(if (not (eof-object? eof))
- (format #t "read-char again at end: ~A~%" eof)))))
+ (format-logged #t "read-char again at end: ~A~%" eof)))))
(test (eof-object? (integer->char 255)) #f)
(test (eof-object? our-eof) #t)
@@ -9553,17 +16910,19 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (op *stderr*) 'error)
(test (op (current-output-port)) 'error)
(test (op (current-error-port)) 'error)
- (test (op '()) 'error))
+ (test (op ()) 'error))
(list read read-line read-char read-byte peek-char char-ready?))
(for-each
(lambda (op)
(test (op #\a *stdin*) 'error)
(test (op #\a (current-input-port)) 'error)
- (test (op #\a '()) 'error))
+ (test (op #\a ()) 'error))
(list write display write-char))
(test (write-byte 0 *stdin*) 'error)
+(test (write-byte (char->integer #\space) *stdout*) (char->integer #\space))
+(test (write-byte (char->integer #\space) *stderr*) (char->integer #\space))
(test (newline *stdin*) 'error)
(test (format *stdin* "hiho") 'error)
@@ -9600,16 +16959,16 @@ zzy" (lambda (p) (eval (read p))))) 32)
(with-output-to-file "tmp.r5rs"
(lambda ()
(write-char #\a)
- (with-output-to-file "tmp1.r5rs"
+ (with-output-to-file tmp-output-file
(lambda ()
- (format #t "~C" #\b)
+ (format-logged #t "~C" #\b)
(with-output-to-file "tmp2.r5rs"
(lambda ()
(display #\c)))
(display (with-input-from-file "tmp2.r5rs"
(lambda ()
(read-char))))))
- (with-input-from-file "tmp1.r5rs"
+ (with-input-from-file tmp-output-file
(lambda ()
(write-byte (read-byte))
(write-char (read-char))))))
@@ -9628,11 +16987,12 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (read) '(+ 3 4))))
(test (read-char) #\c)))
-(test (eval-string (object->string (with-input-from-string "(+ 1 2)" (lambda () (read))))) 3)
-(test (eval (eval-string "(with-input-from-string \"(+ 1 2)\" (lambda () (read)))")) 3)
-(test (eval-string "(eval (with-input-from-string \"(+ 1 2)\" (lambda () (read))))") 3)
+(test (eval-string (object->string (with-input-from-string "(+ 1 2)" read))) 3)
+(test (eval (eval-string "(with-input-from-string \"(+ 1 2)\" read)")) 3)
+(test (eval-string "(eval (with-input-from-string \"(+ 1 2)\" read))") 3)
(test (eval-string (object->string (eval-string (format #f "(+ 1 2)")))) 3)
+
;;; -------- test that we can plow past errors --------
(if (and (defined? 'file-exists?) ; (ifdef name ...)?
@@ -9654,7 +17014,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(read-line p)))))
(if (or (not (string? str))
(not (string=? str "start next done")))
- (format #t ";call-with-output-file + error -> ~S~%" str)))
+ (format-logged #t ";call-with-output-file + error -> ~S~%" str)))
(let ((str (call-with-input-file "tests.data"
(lambda (p)
@@ -9666,8 +17026,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda args "s"))))))
(if (or (not (string? str))
(not (string=? str "s")))
- (format #t ";call-with-input-file + error -> ~S~%" str)))
-
+ (format-logged #t ";call-with-input-file + error -> ~S~%" str)))
(if (and (defined? 'file-exists?)
(file-exists? "tests.data"))
@@ -9675,20 +17034,20 @@ zzy" (lambda (p) (eval (read p))))) 32)
(with-output-to-file "tests.data"
(lambda ()
- (format #t "start ")
+ (format-logged #t "start ")
(catch #t
(lambda ()
- (format #t "next ") (abs "hi") (format #t "oops "))
+ (format-logged #t "next ") (abs "hi") (format-logged #t "oops "))
(lambda args
'error))
- (format #t "done\n")))
+ (format-logged #t "done\n")))
(let ((str (with-input-from-file "tests.data"
(lambda ()
(read-line)))))
(if (or (not (string? str))
(not (string=? str "start next done")))
- (format #t ";with-output-to-file + error -> ~S~%" str)))
+ (format-logged #t ";with-output-to-file + error -> ~S~%" str)))
(let ((str (with-input-from-file "tests.data"
(lambda ()
@@ -9700,7 +17059,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda args "s"))))))
(if (or (not (string? str))
(not (string=? str "s")))
- (format #t ";with-input-from-file + error -> ~S~%" str)))
+ (format-logged #t ";with-input-from-file + error -> ~S~%" str)))
(test (call-with-output-string newline) (string #\newline))
(test (call-with-output-string append) "")
@@ -9716,24 +17075,37 @@ zzy" (lambda (p) (eval (read p))))) 32)
(format p "done")))))
(if (or (not (string? str))
(not (string=? str "start next done")))
- (format #t ";call-with-output-string + error -> ~S~%" str)))
+ (format-logged #t ";call-with-output-string + error -> ~S~%" str)))
(let ((str (with-output-to-string
(lambda ()
- (format #t "start ")
+ (format-logged #t "start ")
(catch #t
(lambda ()
- (format #t "next ") (abs "hi") (format #t "oops "))
+ (format-logged #t "next ") (abs "hi") (format-logged #t "oops "))
(lambda args
'error))
- (format #t "done")))))
+ (format-logged #t "done")))))
(if (or (not (string? str))
(not (string=? str "start next done")))
- (format #t ";with-output-to-string + error -> ~S~%" str)))
+ (format-logged #t ";with-output-to-string + error -> ~S~%" str)))
(test (with-output-to-string (lambda () (format (current-output-port) "a test ~D" 123))) "a test 123")
;(test (with-output-to-string (lambda () (format *stdout* "a test ~D" 1234))) "a test 1234")
+(test (string=? (with-output-to-string (lambda () (write #\null))) "#\\null") #t)
+(test (string=? (with-output-to-string (lambda () (write #\space))) "#\\space") #t)
+(test (string=? (with-output-to-string (lambda () (write #\return))) "#\\return") #t)
+(test (string=? (with-output-to-string (lambda () (write #\escape))) "#\\escape") #t)
+(test (string=? (with-output-to-string (lambda () (write #\tab))) "#\\tab") #t)
+(test (string=? (with-output-to-string (lambda () (write #\newline))) "#\\newline") #t)
+(test (string=? (with-output-to-string (lambda () (write #\backspace))) "#\\backspace") #t)
+(test (string=? (with-output-to-string (lambda () (write #\alarm))) "#\\alarm") #t)
+(test (string=? (with-output-to-string (lambda () (write #\delete))) "#\\delete") #t)
+
+(test (string=? (with-output-to-string (lambda () (write-char #\space))) " ") #t) ; weird -- the name is backwards
+(test (string=? (with-output-to-string (lambda () (display #\space))) " ") #t)
+
(let ((str (call-with-input-string "12345"
(lambda (p)
(catch #t
@@ -9744,7 +17116,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda args "s"))))))
(if (or (not (string? str))
(not (string=? str "s")))
- (format #t ";call-with-input-string + error -> ~S~%" str)))
+ (format-logged #t ";call-with-input-string + error -> ~S~%" str)))
(let ((str (with-input-from-string "12345"
(lambda ()
@@ -9756,13 +17128,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda args "s"))))))
(if (or (not (string? str))
(not (string=? str "s")))
- (format #t ";with-input-from-string + error -> ~S~%" str)))
+ (format-logged #t ";with-input-from-string + error -> ~S~%" str)))
(for-each
(lambda (arg)
(test (port-line-number arg) 'error)
(test (port-filename arg) 'error))
- (list "hi" -1 0 #\a 'a-symbol '#(1 2 3) '(1 . 2) '(1 2 3) 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
+ (list "hi" -1 0 #\a 'a-symbol #(1 2 3) '(1 . 2) '(1 2 3) 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
(test (catch #t (lambda () (eval-string (port-filename))) (lambda args #f)) #f)
(test (symbol? (string->symbol (port-filename))) #t)
@@ -9776,12 +17148,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
arg))
(list 1 3/4 '(1 2) #(1 2) :hi #f #t))
-(num-test (with-input-from-string "3.14" (lambda () (read))) 3.14)
-(num-test (with-input-from-string "3.14+2i" (lambda () (read))) 3.14+2i)
-(num-test (with-input-from-string "#x2.1" (lambda () (read))) 2.0625)
-(test (with-input-from-string "'hi" (lambda () (read))) ''hi)
-(test (with-input-from-string "'(1 . 2)" (lambda () (read))) ''(1 . 2))
-
+(num-test (with-input-from-string "3.14" read) 3.14)
+(num-test (with-input-from-string "3.14+2i" read) 3.14+2i)
+(num-test (with-input-from-string "#x2.1" read) 2.0625)
+(test (with-input-from-string "'hi" read) ''hi)
+(test (with-input-from-string "'(1 . 2)" read) ''(1 . 2))
(test
(let ((cin #f)
@@ -9795,10 +17166,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda args
(set! cerr #t)))
(format #f "~A ~A" cin cerr))
- "<port string input (closed)> #t")
+ "<input-string-port (closed)> #t")
+
+;;; old form: "<port string input (closed)> #t")
(test
- (let ((cout #f)
+ (let ((cp (current-output-port))
+ (cout #f)
(cerr #f))
(catch #t
(lambda ()
@@ -9809,9 +17183,17 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda args
(set! cerr #t)))
(format #f "~A ~A" cout cerr))
- "<port string output (closed)> #t")
+ "<output-string-port (closed)> #t")
+(if (not (eq? *stdout* old-stdout))
+ (format *stderr* ";~D: stdout clobbered~%" (port-line-number)))
-(call-with-output-file "tmp1.r5rs"
+;;; old form: "<port string output (closed)> #t")
+
+(let ((port (open-input-file #u8(115 55 116 101 115 116 46 115 99 109 0) #u8(114 0 98)))) ; "s7test.scm" "r\x00b"
+ (test (input-port? port) #t) ; ??
+ (close-input-port port))
+
+(call-with-output-file tmp-output-file
(lambda (p)
(display "1" p)
(newline p)
@@ -9819,22 +17201,24 @@ zzy" (lambda (p) (eval (read p))))) 32)
(display "2345" p)
(newline p)))
-(call-with-input-file "tmp1.r5rs"
+(call-with-input-file tmp-output-file
(lambda (p)
(test (read-line p) "1")
(test (read-line p) "")
(test (read-line p) "2345")
(test (eof-object? (read-line p)) #t)))
-(let ((p (open-output-file "tmp1.r5rs" "a")))
+(let ((p (open-output-file tmp-output-file "a")))
(display "678" p)
(newline p)
(close-output-port p))
-(test (let ((p (open-output-file "tmp1.r5rs" "xyzzy"))) (close-output-port p)) 'error)
-(test (let ((p (open-input-file "tmp1.r5rs" "xyzzy"))) (close-input-port p)) 'error)
+(if (not with-windows) ; "xyzzy" is legit in windows??
+ (begin
+ (test (let ((p (open-output-file tmp-output-file "xyzzy"))) (close-output-port p)) 'error)
+ (test (let ((p (open-input-file tmp-output-file "xyzzy"))) (close-input-port p)) 'error)))
-(call-with-input-file "tmp1.r5rs"
+(call-with-input-file tmp-output-file
(lambda (p)
(test (read-line p) "1")
(test (read-line p) "")
@@ -9842,31 +17226,55 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (read-line p) "678")
(test (eof-object? (read-line p)) #t)))
+(test (let ((a 1))
+ (define-macro (m1) `(set! a (read)))
+ (with-input-from-string "123" m1)
+ a)
+ 123)
+
+(test (let ((a 1))
+ (define-macro (m3 p) `(set! a (read ,p)))
+ (call-with-input-string "123" m3)
+ a)
+ 123)
+
+(test (let ()
+ (define-macro (m1) `(define a (read)))
+ (with-input-from-string "123" m1)
+ a)
+ 123)
+
+(test (let ()
+ (define-macro (m3 p) `(define a (read ,p)))
+ (call-with-input-string "123" m3)
+ a)
+ 123)
+
(for-each
(lambda (arg)
(test (port-filename arg) 'error))
- (list "hi" -1 #\a 1 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '() (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t () (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (port-filename arg) 'error))
- (list "hi" -1 #\a 1 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '() (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t () (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (open-input-file "s7test.scm" arg) 'error)
- (test (open-output-file "test.data" arg) 'error))
- (list -1 #\a 1 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '() (list 1 2 3) '(1 . 2)))
+ (test (open-output-file tmp-data-file arg) 'error))
+ (list -1 #\a 1 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t () (list 1 2 3) '(1 . 2)))
-(test (current-input-port '()) 'error)
-(test (current-output-port '()) 'error)
-(test (current-error-port '()) 'error)
+(test (current-input-port ()) 'error)
+(test (current-output-port ()) 'error)
+(test (current-error-port ()) 'error)
(for-each
(lambda (op)
(let ((tag (catch #t (lambda () (op)) (lambda args 'error))))
(if (not (eq? tag 'error))
- (format #t ";(~A) -> ~A (expected 'error)~%" op tag))))
+ (format-logged #t ";(~A) -> ~A (expected 'error)~%" op tag))))
(list set-current-input-port set-current-error-port set-current-output-port
close-input-port close-output-port
write display write-byte write-char format ; newline
@@ -9882,7 +17290,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda (op)
(let ((tag (catch #t (lambda () (op 1 2 3 4 5)) (lambda args 'error))))
(if (not (eq? tag 'error))
- (format #t ";(~A 1 2 3 4 5) -> ~A (expected 'error)~%" op tag))))
+ (format-logged #t ";(~A 1 2 3 4 5) -> ~A (expected 'error)~%" op tag))))
(list set-current-input-port set-current-error-port set-current-output-port
close-input-port close-output-port
write display write-byte write-char format newline
@@ -9894,7 +17302,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
open-output-file open-input-file
open-input-string))
-;;; (string-set! (with-input-from-string "\"1234\"" (lambda () (read))) 1 #\a)
+;;; (string-set! (with-input-from-string "\"1234\"" read) 1 #\a)
+(test (with-input-from-string "(+ 1 2)" read) '(+ 1 2))
(test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\tab))))) 512) #t)
(test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\newline))))) 512) #t)
@@ -9908,15 +17317,61 @@ zzy" (lambda (p) (eval (read p))))) 32)
(with-output-to-file "/home/bil/test/load-path-test.scm"
(lambda ()
- (format #t "(define (load-path-test) *load-path*)~%")))
+ (format-logged #t "(define (load-path-test) *load-path*)~%")))
(load "load-path-test.scm")
(if (or (not (defined? 'load-path-test))
(not (equal? *load-path* (load-path-test))))
- (format #t ";*load-path*: ~S, but ~S~%" *load-path* (load-path-test)))
+ (format-logged #t ";*load-path*: ~S, but ~S~%" *load-path* (load-path-test)))
(set! *load-path* old-path)))
+;;; function ports
+(when with-block
+
+ (let ((p (function-open-output)))
+ (write-char #\a p)
+ (let ((val (function-get-output p)))
+ (function-close-output p)
+ (if (not (string=? val "a"))
+ (format *stderr* ";function port write #\\a: ~S (~D, ~A)~%" val (length val) (string->vector val)))))
+
+ (let ((p (function-open-output)))
+ (display "123" p)
+ (format p "4~D6" 5)
+ (write-string "789" p)
+ (write-byte (char->integer #\0) p)
+ (newline p)
+ (let ((val (function-get-output p)))
+ (function-close-output p)
+ (if (not (string=? val "1234567890\n"))
+ (format *stderr* ";function port outputs: ~S (~D, ~A)~%" val (length val) (string->vector val)))))
+
+ (let ((str "0123"))
+ (let ((p (function-open-input str)))
+ (let ((val (read-char p)))
+ (if (not (char=? val #\0))
+ (format *stderr* ";function port read #\\0: ~S~%" val)))))
+
+ (let ((str "0123\n45678"))
+ (let ((p (function-open-input str)))
+ (let ((val (read-line p)))
+ (if (not (string=? val "0123"))
+ (format *stderr* ";function port read-line: ~S~%" val))
+ (set! val (read-byte p))
+ (if (not (= val (char->integer #\4)))
+ (format *stderr* ";function port read-byte: ~S~%" val))
+ (set! val (peek-char p))
+ (if (not (char=? val #\5))
+ (format *stderr* ";function port peek-char: ~S~%" val))
+ (set! val (read-string 2 p))
+ (if (not (string=? val "56"))
+ (format *stderr* ";function port read-string: ~S~%" val))
+ (if (and (not pure-s7)
+ (not (char-ready? p)))
+ (format *stderr* ";function port has no char ready?~%"))
+ (close-input-port p)))))
+
;;; -------- poke at the reader --------
@@ -9940,8 +17395,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (equal? '("hi"."ho") ' ("hi" . "ho")) #t)
(test (equal? '("hi""ho") '("hi" "ho")) #t)
(test '("""""") '("" "" ""))
-(test '(#|;"();|#) '())
-(test '(#||##\# #!!##b1) '(#\# 1))
+(test '(#|;"();|#) ())
+(test '(#||##\# #||##b1) '(#\# 1))
+(test (#|s'!'|#*) 1)
+(test (#|==|#) ())
+(test -#|==|#1 'error) ; unbound variable
(test '((). '()) '(() quote ()))
(test '(1. . .2) '(1.0 . 0.2))
(test (equal? '(().()) '(())) #t)
@@ -9955,14 +17413,22 @@ zzy" (lambda (p) (eval (read p))))) 32)
2) '(1 . 2))
(test (vector .(1 .(2))) #(1 2))
(test (vector 0. .(.1)) #(0.0 0.1))
+(test '(a #|foo||# b) '(a b)) ; from bug-guile
+(test '(a #|foo|||# b) '(a b))
+(test '(a #|foo||||# b) '(a b))
+(test '(a #|foo|||||# b) '(a b))
+
+(test (let () (define (f' x) (+ x x)) (f' 10)) 20) ; from /r/scheme
+(test (let () (define (f'' a'b) (+ a'b a'b)) (f'' 10)) 20)
+(test (symbol? 'a'b) #t)
-;; currently \ -> (), ` -> #<eof> etc -- not sure these matter
(test (char? #\#) #t)
-(test (eval-string "'#<vct>") 'error)
-(test (eval-string "'(#<vct>)") 'error)
+(test (eval-string "'#<float-vector>") 'error)
+(test (eval-string "'(#<float-vector>)") 'error)
(test (car `(,.1e0)) .1)
(test (car `(,.1E0)) .1)
(test (let ((x "hi")) (set! x"asdf") x) "asdf")
+(test (let* ((x "hi") (y x)) (set! x "asdf") y) "hi")
(test (let ((x 1)) (set! x(list 1 2)) x) '(1 2))
(num-test (let ((x 1)) (set!;"
x;)
@@ -9970,7 +17436,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
);#|
x) 12.0)
(test (let ((\x00}< 1) (@:\t{ 2)) (+ \x00}< @:\t{)) 3)
-(test (let ((?#||#\ 1) (\n\r\t 2) (.1e+2+ie 3)) (+ ?#||#\ \n\r\t .1e+2+ie)) 6)
+(test (let ((| 1) (|| 2) (||| 3)) (+ || | |||)) 6)
+(test (let ((|a#||#b| 1)) |a#||#b|) 1)
(test (let ((@,@'[1] 1) (\,| 2)) (+ @,@'[1] \,|)) 3)
(test (list"0"0()#()#\a"""1"'x(list)+(cons"""")#f) (list "0" 0 () #() #\a "" "1" 'x (list) + '("" . "") #f))
(test (let ((x, 1)) x,) 1)
@@ -9980,13 +17447,13 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (+ `,0(angle ```,`11)) 0)
(test (map . (char->integer "123")) '(49 50 51))
(test (map .(values "0'1")) '(#\0 #\' #\1))
-(test (map /""'(123)) '())
+(test (map /""'(123)) ())
(num-test (+ 1 .()) 1)
+(test (let () (define (x .()) (list .())) (x)) ())
;; how is ...#(... parsed?
(test (eval-string "'(# (1))") 'error)
(test (let ((lst (eval-string "'(#(1))"))) (and (= (length lst) 1) (vector? (car lst)))) #t) ; '(#(1))
-(test (let ((lst (eval-string "'(#\ (1))"))) (and (= (length lst) 1) (vector? (car lst)))) #t) ; '(#(1))
(test (let ((lst (eval-string "'(-#(1))"))) (and (= (length lst) 2) (symbol? (car lst)) (pair? (cadr lst)))) #t) ; '(-# (1))
(test (let ((lst (eval-string "'(1#(1))"))) (and (= (length lst) 2) (symbol? (car lst)) (pair? (cadr lst)))) #t) ; '(1# (1))
(test (let ((lst (eval-string "'('#(1))"))) (and (= (length lst) 1) (vector? (cadar lst)))) #t) ; '((quote #(1)))
@@ -10015,76 +17482,132 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (eval-string "'(#<eof>#<eof>)") 'error)
(test (eval-string "'(#<eof>#())") 'error)
(test (equal? '('#()) '(#())) #f)
-(test (equal? (list '#()) '(#())) #t)
-(test (equal? '('#()) '('#())) #t)
-(test (equal? '('#()) '(`#())) #f) ; ! [guile agrees]
+(test (equal? (list #()) '(#())) #t)
+(test (equal? '(#()) '(#())) #t)
+(test (equal? '('#()) '(`#())) #f) ; [guile agrees]
(test (equal? '('()) '(`())) #f) ; ! quote != quasiquote [guile agrees]
-(test (equal? '('(1)) '(`(1))) #t) ; !! but lists are different? [guile says #f]
-(test (equal? '('#(1)) '(`#(1))) #f) ; ! [guile agrees]
+(test (equal? '('(1)) '(`(1))) #t) ; but lists are different? [guile says #f]
+(test (equal? '('#(1)) '(`#(1))) #f) ; [guile agrees]
(test (equal? '('#()) '(#())) #f)
(test (equal? '(`#()) '(`#())) #t)
-(test (equal? '#() `#()) #t)
-(test (equal? (list '#()) (list `#())) #t)
-(test (equal? (list '#()) '(`#())) #t)
+(test (equal? #() `#()) #t)
+(test (equal? (list #()) (list `#())) #t)
+(test (equal? (list #()) '(`#())) #t)
(test (equal? '(`#()) '(#())) #t)
-(test (equal? `#() '#()) #t) ; and also (1) () #(1) etc
-(test (equal? `'#() ''#()) #t) ; "
-(test (equal? '`#() ''#()) #f) ; ! it equals '#()
+(test (equal? `#() #()) #t) ; and also (1) () #(1) etc
+(test (equal? `#() '#()) #t) ; "
+(test (equal? '`#() ''#()) #f) ; it equals #() -- this is consistent -- see below
(test (equal? '`#() ``#()) #t)
-;; gah -- `#(...) should be removed from s7
-;; but there is still the strangeness that `'() is not the same as '`() -- quasiquote returns '() not (), and similarly for #() except...
-;; there are actually 3 cases here, the 3rd is (equal? `''() ``'()) -> #f, but the #() case is #t
+
+(test (equal? '() '()) #t)
+(test (equal? (quote ()) '()) #t)
+(test (equal? '() (quote ())) #t)
+(test (equal? (quote ()) (quote ())) #t)
+(test (equal? `(1) '(1)) #t)
+(test (equal? (quasiquote (1)) '(1)) #t)
+(test (equal? `(1) (quote (1))) #t)
+(test (equal? (quasiquote (1)) (quote (1))) #t)
+(test (equal? ``''1 '``'1) #t)
+(test (equal? (quasiquote `(quote (quote 1))) '``'1) #t)
+(test (equal? ``''1 (quote ``(quote 1))) #t)
+(test (equal? (quasiquote `(quote (quote 1))) (quote ``(quote 1))) #t)
+(test (equal? '``'#f ```'#f) #t)
+(test (equal? (quote ``(quote #f)) ```'#f) #t)
+(test (equal? '``'#f (quasiquote ``(quote #f))) #t)
+(test (equal? (quote ``(quote #f)) (quasiquote ``(quote #f))) #t)
+;;; etc:
#|
-"(equal? ''() ``())" -> #f
-"(equal? ''(1) ``(1))" -> #t
-"(equal? ''#() ``#())" -> #f
-"(equal? ''#(1) ``#(1))" -> #f
-"(equal? ''1 ``1)" -> #f
-"(equal? ''#f ``#f)" -> #f
-
-"(equal? `''() ``'())" -> #f
-"(equal? `''(1) ``'(1))" -> #t
-"(equal? `''#() ``'#())" -> #t
-"(equal? `''#(1) ``'#(1))" -> #t
-"(equal? `''1 ``'1)" -> #t
-"(equal? `''#f ``'#f)" -> #t
-
-;; see t242.scm
+(equal? (quote `1) (quote (quasiquote 1))) -> #f
+the reader sees `1 and turns it into 1 in the 1st case, but does not collapse the 2nd case to 1
+ (who knows, quasiquote might have been redefined in context... but ` can't be redefined):
+:(define (` a) a)
+;define: define a non-symbol? 'a
+; (define ('a) a)
+
+this is different from guile which does not handle ` at read time except to expand it:
+
+guile> (quote `1)
+(quasiquote 1)
+
+:(quote `1)
+1
+
+so anything that quotes ` is not going to equal quote quasiquote
(define (check-strs str1 str2)
- (let* ((expr (format #f "(equal? ~A ~A)" (string-append str1 "()") (string-append str2 "()")))
- (val (catch #t
- (lambda () (eval-string expr))
- (lambda args 'error))))
- (format #t "--------~%~S -> ~S~%" expr val)
- (set! expr (format #f "(equal? ~A ~A)" (string-append str1 "(1)") (string-append str2 "(1)")))
- (let ((val (catch #t
- (lambda () (eval-string expr))
- (lambda args 'error))))
- (format #t "~S -> ~S~%" expr val))
- (set! expr (format #f "(equal? ~A ~A)" (string-append str1 "#()") (string-append str2 "#()")))
- (let ((val (catch #t
- (lambda () (eval-string expr))
- (lambda args 'error))))
- (format #t "~S -> ~S~%" expr val))
- (set! expr (format #f "(equal? ~A ~A)" (string-append str1 "#(1)") (string-append str2 "#(1)")))
- (let ((val (catch #t
- (lambda () (eval-string expr))
- (lambda args 'error))))
- (format #t "~S -> ~S~%" expr val))
- (set! expr (format #f "(equal? ~A ~A)" (string-append str1 "1") (string-append str2 "1")))
- (let ((val (catch #t
- (lambda () (eval-string expr))
- (lambda args 'error))))
- (format #t "~S -> ~S~%" expr val))
- (set! expr (format #f "(equal? ~A ~A)" (string-append str1 "#f") (string-append str2 "#f")))
- (let ((val (catch #t
- (lambda () (eval-string expr))
- (lambda args 'error))))
- (format #t "~S -> ~S~%" expr val))))
-
-(let ((strs '()))
+ (for-each
+ (lambda (arg)
+ (let ((expr (format #f "(equal? ~A~A ~A~A)" str1 arg str2 arg)))
+ (let ((val (catch #t
+ (lambda () (eval-string expr))
+ (lambda args 'error))))
+ (format #t "--------~%~S -> ~S" expr val)
+ (let* ((parens3 0)
+ (parens4 0)
+ (str3 (apply string-append (map (lambda (c)
+ (if (char=? c #\`)
+ (if (= parens3 0)
+ (begin
+ (set! parens3 (+ parens3 1))
+ "(quasiquote ")
+ "`")
+ (if (char=? c #\')
+ (begin
+ (set! parens3 (+ parens3 1))
+ "(quote ")
+ (string c))))
+ str1)))
+ (str4 (apply string-append (map (lambda (c)
+ (if (char=? c #\`)
+ (if (= parens4 0)
+ (begin
+ (set! parens4 (+ parens4 1))
+ "(quasiquote ")
+ "`")
+ (if (char=? c #\')
+ (begin
+ (set! parens4 (+ parens4 1))
+ "(quote ")
+ (string c))))
+ str2))))
+ (let ((expr (format #f "(equal? ~A~A~A ~A~A)" str3 arg (make-string parens3 #\)) str2 arg)))
+ (let* ((val1 (catch #t
+ (lambda () (eval-string expr))
+ (lambda args 'error)))
+ (trouble (and (not (eq? val1 'error))
+ (not (eq? val1 val)))))
+ (if trouble
+ (format #t "~%~8T~A~S -> ~S~A" bold-text expr val1 unbold-text)
+ (format #t "~%~8T~S -> ~S" expr val1))))
+ (let ((expr (format #f "(equal? ~A~A ~A~A~A)" str1 arg str4 arg (make-string parens4 #\)))))
+ (let* ((val1 (catch #t
+ (lambda () (eval-string expr))
+ (lambda args 'error)))
+ (trouble (and (not (eq? val1 'error))
+ (not (eq? val1 val)))))
+ (if trouble
+ (format #t "~%~8T~A~S -> ~S~A" bold-text expr val1 unbold-text)
+ (format #t "~%~8T~S -> ~S" expr val1))))
+ (let ((expr (format #f "(equal? ~A~A~A ~A~A~A)" str3 arg (make-string parens3 #\)) str4 arg (make-string parens4 #\)))))
+ (let* ((val1 (catch #t
+ (lambda () (eval-string expr))
+ (lambda args 'error)))
+ (trouble (and (not (eq? val1 'error))
+ (not (eq? val1 val)))))
+ (if trouble
+ (format #t "~%~8T~A~S -> ~S~A~%" bold-text expr val1 unbold-text)
+ (format #t "~%~8T~S -> ~S~%" expr val1))))
+ ))))
+ (list "()" "(1)" "#()" "#(1)" "1" "#f")))
+ ;; (list ",(+ 1 2)" "\"\"" "(())" "#\\1" "3/4" ",1")
+
+(check-strs "'" "'")
+(check-strs "`" "'")
+(check-strs "'" "`")
+(check-strs "`" "`")
+
+(let ((strs ()))
(do ((i 0 (+ i 1)))
((= i 4))
(let ((c1 ((vector #\' #\` #\' #\`) i))
@@ -10101,7 +17624,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! strs (cons (list str1 str2) strs))
(set! strs (cons (list str2 str1) strs))))))))))
-(let ((strs '()))
+(let ((strs ()))
(do ((i 0 (+ i 1)))
((= i 8))
(let ((c1 ((vector #\' #\` #\' #\` #\' #\` #\' #\`) i))
@@ -10119,9 +17642,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(check-strs str1 str2)
(set! strs (cons (list str1 str2) strs))
(set! strs (cons (list str2 str1) strs))))))))))
-|#
-#|
+
+;;; --------------------------------
+
(do ((i 0 (+ i 1)))
((= i 256))
(if (and (not (= i (char->integer #\))))
@@ -10134,7 +17658,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(lambda args
(format #t "[~D] ~A -> ~A~%" i str args))))))
-(let ((chars (vector (integer->char 0) #\newline #\space #\tab #\. #\, #\@ #\= #\x #\b #\' #\` #\# #\] #\[ #\} #\{ #\( #\) #\1 #\i #\+ #\- #\e #\_ #\\ #\" #\: #\; #\> #\<)))
+(let ((chars (vector (integer->char 0) #\newline #\space #\tab #\. #\, #\@ #\= #\x #\b #\' #\`
+ #\# #\] #\[ #\} #\{ #\( #\) #\1 #\i #\+ #\- #\e #\_ #\\ #\" #\: #\; #\> #\<)))
(let ((nchars (vector-length chars)))
(do ((len 2 (+ len 1)))
((= len 3))
@@ -10160,9 +17685,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(catch #t
(lambda ()
(let ((val (eval-string str)))
- (format #t " ~S (~S ~S)~%" val (car val) (cdr val))))
+ (format #t " ~S -> ~S~%" str val)))
(lambda args
- (format #t " ~A~%" args))))))))
+ ;(format #t " ~A~%" args)
+ #f
+ )))))))
|#
(let ((äåæéîå define)
@@ -10206,20 +17733,108 @@ zzy" (lambda (p) (eval (read p))))) 32)
;; still sees the full string when it evaluates, not the string that results from
;; the inner call.
-(test (let ((name '+))
- (let ((+ *))
- (eval (list name 2 3))))
- 6)
-(test (let ((name +))
- (let ((+ *))
- (eval (list name 2 3))))
- 5)
-;; why is this considered confusing? It has nothing to do with eval!
-(test (let ((call/cc (lambda (x)
- (let ((c (call/cc x))) c))))
- (call/cc (lambda (r) (r 1))))
- 1)
+(let () ; from scheme bboard
+ (define (maxlist list)
+ (define (maxlist' l max)
+ (if (null? l) max
+ (if (> (car l) max)
+ (maxlist' (cdr l) (car l))
+ (maxlist' (cdr l) max))))
+ (if (null? list) 'undef
+ (maxlist' list (car list))))
+ (test (maxlist '(1 2 3)) 3) ; quote is ok in s7 if not the initial char (sort of like a number)
+
+ (let ((h'a 3))
+ (test h'a 3))
+ (let ((1'2 32))
+ (test 1'2 32))
+ (let ((1'`'2 32))
+ (test 1'`'2 32))
+ (let ((1'`, at 2 32))
+ (test 1'`, at 2 32))
+
+; (test (define '3 32) 'error) ;define quote: syntactic keywords tend to behave badly if redefined
+ )
+
+(let ((|,``:,*|',## 1)
+ (0,,&:@'>>.<# 2)
+ (@.*0`#||\<,, 3)
+ (*&:`&'>#,*<` 4)
+ (*0,,`&|#*:`> 5)
+ (>:|<*.<@:\|` 6)
+ (*',>>:.'@,** 7)
+ (0|.'@<<:,##< 8)
+ (<>,\',\.>>#` 9)
+ (@#.>|&#&,\0* 10)
+ (0'.`&<','<<. 11)
+ (&@@*<*\'&|., 12)
+ (|0*&,':|0\** 13)
+ (<:'*@<>*,<&` 14)
+ (>@<@<|>,`&'. 15)
+ (@#,00:<:@*.\ 16)
+ (*&.`\>#&,&., 17)
+ (0|0|`,,..<@, 18)
+ (0@,'>\,,&.@# 19)
+ (>@@>,000`\#< 20)
+ (|>*'',<:&@., 21)
+ (|>,0>0|,@'|. 22)
+ (0,`'|'`,:`@` 23)
+ (<>#'>,,\'.'& 24)
+ (*..,|,.,&&@0 25))
+ (test (+ |,``:,*|',## 0,,&:@'>>.<# @.*0`#||\<,, *&:`&'>#,*<` *0,,`&|#*:`> >:|<*.<@:\|` *',>>:.'@,**
+ 0|.'@<<:,##< <>,\',\.>>#` @#.>|&#&,\0* 0'.`&<','<<. &@@*<*\'&|., |0*&,':|0\** <:'*@<>*,<&`
+ >@<@<|>,`&'. @#,00:<:@*.\ *&.`\>#&,&., 0|0|`,,..<@, 0@,'>\,,&.@# >@@>,000`\#<
+ |>*'',<:&@., |>,0>0|,@'|. 0,`'|'`,:`@` <>#'>,,\'.'& *..,|,.,&&@0)
+ 325))
+
+(when full-test
+ (let ((first-chars (list #\. #\0 #\@ #\! #\& #\| #\* #\< #\>))
+ (rest-chars (list #\. #\0 #\@ #\! #\| #\, #\# #\' #\\ #\` #\, #\: #\& #\* #\< #\>)))
+ (let ((first-len (length first-chars))
+ (rest-len (length rest-chars)))
+ (let ((n 100)
+ (size 12))
+ (let ((str (make-string size #\space)))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (set! (str 0) (first-chars (random first-len)))
+ (do ((k 1 (+ 1 k)))
+ ((= k size))
+ (set! (str k) (rest-chars (random rest-len))))
+ (catch #t (lambda ()
+ (let ((val (eval-string (format #f "(let () (define ~A 3) ~A)" str str))))
+ (format #f "~A -> ~A~%" str val)))
+ (lambda args
+ (format #f "~A error: ~A~%" str args)))))))))
+
+(let ((List 1)
+ (LIST 2)
+ (lIsT 3)
+ (-list 4)
+ (_list 5)
+ (+list 6))
+ (test (apply + (list List LIST lIsT -list _list +list)) 21))
+
+(let ()
+ (define (\ arg) (+ arg 1))
+ (test (+ 1 (\ 2)) 4)
+ (define (@\ arg) (+ arg 1))
+ (test (+ 1 (@\ 2)) 4)
+ (define (@,\ arg) (+ arg 1))
+ (test (+ 1 (@,\ 2)) 4)
+ (define (\,@\ arg) (+ arg 1))
+ (test (+ 1 (\,@\ 2)) 4)
+ )
+
+;;; these are from the r7rs discussions
+(test (let ((a'b 3)) a'b) 3) ; allow variable names like "can't-go-on" or "don't-ask"
+(test (let () (define (f x y) (+ x y)) (let ((a 3) (b 4)) (f a, b))) 'error) ; unbound variable a,
+(test (let () (define (f x y) (+ x y)) (let ((a 3) (b 4)) (f a ,b))) 'error) ; unquote outside quasiquote
+
+(test (vector? (owlet 0. 3/4 #(reader-cond ))) 'error)
+(test (vector? #(reader-cond)) #t)
+(test ((cond-expand (string (integer->char 255)) (hash-table '(a . 2) 0 (abs (append (string (integer->char 255)) (make-block 32) (inlet 'value 1 '+ (lambda args 1)) (int-vector 1 2 3))))) cdddr) 'error)
@@ -10234,7 +17849,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string=? (object->string 'symb) "symb") #t)
(test (string=? (object->string (list 1 2 3)) "(1 2 3)") #t)
(test (string=? (object->string (cons 1 2)) "(1 . 2)") #t)
-(test (string=? (object->string '#(1 2 3)) "#(1 2 3)") #t)
+(test (string=? (object->string #(1 2 3)) "#(1 2 3)") #t)
(test (string=? (object->string +) "+") #t)
(test (object->string (object->string (object->string "123"))) "\"\\\"\\\\\\\"123\\\\\\\"\\\"\"")
(test (object->string #<eof>) "#<eof>")
@@ -10242,22 +17857,42 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (object->string #<undefined>) "#<undefined>")
(test (object->string #f) "#f")
(test (object->string #t) "#t")
-(test (object->string '()) "()")
+(test (object->string ()) "()")
(test (object->string #()) "#()")
(test (object->string "") "\"\"")
(test (object->string abs) "abs")
+(test (object->string lambda) "lambda")
+(test (object->string (lambda () a)) "#<lambda ()>")
+(test (object->string (lambda a a)) "#<lambda a>")
+(test (object->string (lambda (a) a)) "#<lambda (a)>")
+(test (object->string (lambda (a . b) a)) "#<lambda (a . b)>")
+(test (object->string (lambda (a b) a)) "#<lambda (a b)>")
+(test (object->string (lambda (a b c) a)) "#<lambda (a b ...)>")
+(test (object->string (lambda (a b . c) a)) "#<lambda (a b ...)>")
+(test (object->string (lambda* (a :rest b) a)) "#<lambda* (a :rest b)>")
+(test (object->string (lambda* (:rest a) a)) "#<lambda* (:rest a)>")
+(test (object->string (lambda* (a b :rest c) a)) "#<lambda* (a b ...)>")
+(let () (define-macro (mac a) a) (test (object->string mac) "mac"))
+(let ((m (define-macro (mac a) a))) (test (object->string m) "#<macro (a)>"))
+(let ((m (define-macro* (mac a) a))) (test (object->string m) "#<macro* (a)>"))
+(let ((m (define-bacro (mac a) a))) (test (object->string m) "#<bacro (a)>"))
+(let ((m (define-bacro* (mac a) a))) (test (object->string m) "#<bacro* (a)>"))
+(let ((_?_m (define-expansion (_?_mac a) a))) (test (object->string _?_m) "#<expansion (a)>"))
(test (object->string +) "+")
(test (object->string +) "+")
(test (object->string '''2) "''2")
-(test (object->string (lambda () #f)) "#<closure>")
+(test (object->string (lambda () #f)) "#<lambda ()>") ;"#<closure>"
(test (call-with-exit (lambda (return) (object->string return))) "#<goto>")
(test (call/cc (lambda (return) (object->string return))) "#<continuation>")
-(test (let () (define-macro (hi a) `(+ 1 ,a)) (object->string hi)) "#<macro>")
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (object->string hi)) "hi")
(test (let () (define (hi a) (+ 1 a)) (object->string hi)) "hi")
(test (let () (define* (hi a) (+ 1 a)) (object->string hi)) "hi")
(test (object->string dynamic-wind) "dynamic-wind")
-(test (object->string (make-procedure-with-setter (lambda () 1) (lambda (val) val))) "#<procedure-with-setter>")
+(test (object->string (dilambda (lambda () 1) (lambda (val) val))) "#<lambda ()>") ;"#<closure>"
(test (object->string object->string) "object->string")
+(test (object->string 'if) "if")
+(test (object->string begin) "begin")
+(test (object->string let) "let")
(test (object->string #\n #f) "n")
(test (object->string #\n) "#\\n")
@@ -10267,7 +17902,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (object->string #\t) "#\\t")
(test (object->string "a\x00b" #t) "\"a\\x00b\"")
-(test (object->string "a\x00b" #f) "a")
+(test (object->string "a\x00b" #f) "a\x00b")
#|
(do ((i 0 (+ i 1)))
@@ -10277,10 +17912,10 @@ zzy" (lambda (p) (eval (read p))))) 32)
(if (and (not (= (length str) 3)) ; "#\\a"
(or (not (char=? (str 2) #\x))
(not (= (length str) 5)))) ; "#\\xee"
- (format #t "(#t) ~C: ~S~%" c str))
+ (format-logged #t "(#t) ~C: ~S~%" c str))
(set! str (object->string c #f))
(if (not (= (length str) 1))
- (format #t "(#f) ~C: ~S~%" c str)))))
+ (format-logged #t "(#f) ~C: ~S~%" c str)))))
this prints:
(#t) : "#\\null"
(#f) : ""
@@ -10316,6 +17951,7 @@ this prints:
(test (object->string #\tab) "#\\tab")
(test (object->string #\null) "#\\null")
(test (object->string #\space) "#\\space")
+(test (object->string (integer->char 8)) "#\\backspace")
(test (object->string ''#\a) "'#\\a")
(test (object->string (list 1 '.' 2)) "(1 .' 2)")
(test (object->string (quote (quote))) "(quote)")
@@ -10337,21 +17973,578 @@ this prints:
(test (object->string catch) "catch")
(test (object->string lambda) "lambda")
(test (object->string dynamic-wind) "dynamic-wind")
+(test (object->string quasiquote) "quasiquote")
;(test (object->string else) "else") ; this depends on previous code
(test (object->string do) "do")
(for-each
(lambda (arg)
- (test (object->string 1 arg) 'error))
- (list "hi" -1 #\a 1 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i '() (list 1 2 3) '(1 . 2)))
+ (test (object->string 1 arg) 'error)
+ (test (object->string arg) (with-output-to-string (lambda () (write arg))))
+ (test (object->string arg #t) (with-output-to-string (lambda () (write arg))))
+ (test (object->string arg #f) (with-output-to-string (lambda () (display arg)))))
+ (list "hi" -1 #\a 1 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i () (list 1 2 3) '(1 . 2)))
-(test (symbol? (string->symbol (object->string "" #f))) #t)
(test (string->symbol (object->string #(1 #\a (3)) #f)) (symbol "#(1 #\\a (3))"))
(test (string->list (object->string #(1 2) #f)) '(#\# #\( #\1 #\space #\2 #\)))
(test (string->list (object->string #(1 #\a (3)) #f)) '(#\# #\( #\1 #\space #\# #\\ #\a #\space #\( #\3 #\) #\)))
(test (reverse (object->string #2D((1 2) (3 4)) #f)) "))4 3( )2 1((D2#")
+;; write readably (this affects ~W in format as well)
+;; :readable special things
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (not (eq? n obj))
+ (format *stderr* "~A not eq? ~A (~S)~%" n obj str)))))
+ (list #<eof> #<undefined> #<unspecified> #t #f #true #false else ()
+ lambda lambda* begin case if do quote set! let let* letrec
+ cond and or define define* define-constant define-macro
+ define-macro* define-bacro define-bacro*
+ with-baffle
+ *stdin* *stdout* *stderr*))
+
+;; :readable characters
+(do ((i 0 (+ i 1)))
+ ((= i 256))
+ (let ((c (integer->char i)))
+ (let ((str (object->string c :readable)))
+ (let ((nc (with-input-from-string str
+ (lambda ()
+ (eval (read)))))) ; no need for eval here or in some other cases, but might as well be consistent
+ (if (not (eq? c nc))
+ (format *stderr* "~C (~D) != ~C (~S)~%" c i nc str))))))
+
+;; :readable integers
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((nn (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (integer? n))
+ (not (integer? nn))
+ (not (= n nn)))
+ (format *stderr* "~D != ~D (~S)~%" n nn str)))))
+ (list 0 1 3 most-positive-fixnum -0 -1 -3 most-negative-fixnum
+ -9223372036854775808 9223372036854775807))
+;; but unless gmp at read end we'll fail with most-positive-fixnum+1
+;; -> check *features* at start of read
+
+;; :readable ratios
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((nn (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (rational? n))
+ (not (rational? nn))
+ (not (= n nn)))
+ (format *stderr* "~A != ~A (~S)~%" n nn str)))))
+ (list 1/2 -1/2 123456789/2 -2/123456789 2147483647/2147483646 312689/99532
+ -9223372036854775808/3 9223372036854775807/2 1/1428571428571429 1/1152921504606846976))
+
+(when (not (provided? 'solaris))
+ ;; :readable reals
+ (for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((nn (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (real? n))
+ (not (real? nn))
+ (not (morally-equal? n nn)))
+ (format *stderr* "~A != ~A (~S)~%" n nn str)))))
+ (list 1.0 0.0 -0.0 pi 0.1 -0.1 0.9999999995 9007199254740993.1 (sqrt 2) 1/100000000000
+ 1.5e-16 1.5e16 3.141592653589793238462643383279502884197169399375105820 1e-300 8.673617379884e-19
+ 1/0 (- 1/0) (real-part (log 0)) (- (real-part (log 0)))))
+
+ ;; :readable complex
+ (for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((nn (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (complex? n))
+ (not (complex? nn))
+ (not (morally-equal? n nn)))
+ (format *stderr* "~A != ~A (~S)~%" n nn str)))))
+ (list 0+i 0-i 1+i 1.4+i 3.0+1.5i
+ (log 0) (- (log 0))
+ (complex 1/0 1.0) (complex 1/0 1/0) (complex 1.0 1/0) ; default: nan+1i nannani 1nani!
+ (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1/0)
+ 1e-14+1e14i 0+1e-16i (complex pi pi))))
+
+
+;; :readable strings/byte-vectors
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (string? n))
+ (not (string? obj))
+ (not (string=? n obj))
+ (and (byte-vector? n)
+ (not (byte-vector? obj))))
+ (format *stderr* "~S not string=? ~S (~S)~%" n obj str)))))
+ (list "" "abc" (string #\newline) "#<abc>" "a\"b\"c" "a\\b\nc" "aBc"
+ (let ((s (make-string 4 #\space))) (set! (s 3) #\null) s) ; writes as " \x00"
+ "ab
+c"
+ (string #\a #\b #\null #\c #\escape #\newline)
+ (string #\x (integer->char #xf0) #\x)
+ (string #\null)
+ #u8() #u8(0 1 2 3)
+ (let ((str (make-string 256 #\null)))
+ (do ((i 0 (+ i 1)))
+ ((= i 256) str)
+ (set! (str i) (integer->char i))))))
+
+;; :readable symbols/keywords
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (symbol? n))
+ (not (symbol? obj))
+ (not (eq? n obj)))
+ (format *stderr* "~A not eq? ~A (~S)~%" n obj str)))))
+ (list 'abc :abc abc:
+ (symbol "a") (symbol "#<>")
+ (gensym "|") (gensym "#<>") (gensym "}")
+ :: ':abc
+ (gensym "\\")))
+
+;; :readable environments
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (let? n))
+ (not (let? obj))
+ (not (equal? n obj)))
+ (format *stderr* "~A not equal?~%~A~% (~S)~%" n obj str)))))
+ (list (inlet '(a . 1))
+ (inlet)
+ (rootlet)
+ (inlet (cons 't12 "12") (cons (symbol "#<") 12))
+ (inlet 'a 1 'a 2)))
+
+;(test (object->string (list (owlet)) :readable) "(list (owlet))")
+
+;; :readable hash-tables
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (hash-table? n))
+ (not (hash-table? obj))
+ (not (equal? n obj)))
+ (format *stderr* ";readable hash-tables, ~A not equal? ~A (~S)~%" n obj str)))))
+ (list (hash-table '(a . 1))
+ (hash-table '(a . 1) (cons 'b "hi"))
+ (let ((ht (make-hash-table 31)))
+ (set! (ht 1) 321)
+ (set! (ht 2) 123)
+ ht)
+ (let ((ht (make-hash-table)))
+ (set! (ht 'b) 1)
+ (set! (ht 'a) ht)
+ ht)
+ ;(let ((ht (make-hash-table))) (set! (ht ht) 123) ht)
+ ;(let ((ht (make-hash-table))) (set! (ht ht) ht) ht)
+ (hash-table)))
+
+;; :readable vectors
+(let ((old-plen (*s7* 'print-length)))
+ (for-each
+ (lambda (p)
+ (set! (*s7* 'print-length) p)
+ (for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (vector? n))
+ (not (vector? obj))
+ (not (equal? n obj)))
+ (format *stderr* ";readable vectors, ~A not equal? ~A (~S)~%" n obj str)))))
+ (list #() #(1) #(1 #(2)) #2d((1 2) (3 4))
+ #3d(((1 2 3) (4 5 6) (7 8 9)) ((9 8 7) (6 5 4) (3 2 1)))
+ #2d()
+ #(1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0)
+ (let ((v (vector 1 2 3))) (set! (v 1) v) v)
+ (let ((v (vector 1 #(2) 3))) (set! ((v 1) 0) v) v)
+ (let ((v #2d((1 2 3) (4 5 6)))) (set! (v 1 1) v) v)
+ (make-vector 3 0 #t)
+ (make-vector 3 0.0 #t)
+ (make-vector '(2 3) 1 #t)
+ )))
+ (list old-plen 8 2 1))
+ (set! (*s7* 'print-length) old-plen))
+
+(test (object->string (vector 1 2 3) :readable) "(vector 1 2 3)")
+
+;; :readable lists (circular, dotted)
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (pair? n))
+ (not (pair? obj))
+ (not (equal? n obj)))
+ (format *stderr* ";readable lists, ~A not equal? ~A (~S)~%" n obj str)))))
+ (list '(1) '(1 . 2) '((1 ()) 3) '((1 2) (3 4))
+ '(1 2 . 3) '(1 2 3 . 4) '(())
+ (let ((lst (cons 1 2))) (set-cdr! lst lst) lst)
+ (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst)
+ (let ((lst (list 1 2 3))) (set-car! (cddr lst) lst) lst)
+ ))
+
+;; :readable macros
+(let ()
+ (define-macro (mac1) `(+ 1 2))
+ (test ((eval-string (object->string mac1 :readable))) 3)
+ (define-macro (mac2 a) `(+ ,a 2))
+ (test ((eval-string (object->string mac2 :readable)) 1) 3)
+ (define-macro* (mac3 (a 1)) `(+ ,a 2))
+ (test ((eval-string (object->string mac3 :readable))) 3)
+ (define-macro (mac4 . a) `(+ , at a 2))
+ (test ((eval-string (object->string mac4 :readable)) 1 3) 6)
+ (define-macro (mac5 a b . c) `(+ ,a ,b , at c 2))
+ (test ((eval-string (object->string mac5 :readable)) 1 5 3 4) 15)
+ (define-macro (mac7 a) (let ((b (+ a 1))) `(+ ,b ,a)))
+ (test ((eval-string (object->string mac7 :readable)) 2) 5)
+ )
+
+;; :readable closures/functions/built-in (C) functions + the setters thereof
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (procedure? n))
+ (not (procedure? obj))
+ (not (equal? (procedure-source n) (procedure-source obj))))
+ (format *stderr* "'~A not equal? '~A (~S)~%" n obj str)))))
+ (list abs
+ (lambda () 1)
+ (lambda (a) (+ a 1))
+ (lambda args (display args) (cdr args))
+ (lambda* (a b) (or a b))
+ (let ((a 1)) (lambda (b) (+ a b)))
+ (let ((b 2)) (let ((a 1)) (lambda* (c . d) (display (+ a b c) *stdout*) d)))
+ (lambda* (:rest b) b)
+ ))
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (test ((eval-string str) 21) (n 21))))
+ (list (lambda (a) (+ a 1))
+ (lambda args (cdr args))
+ (lambda* (a b) (or a b))
+ (let ((a 1)) (lambda (b) (+ a b)))
+ (let ((b 2)) (let ((a 1)) (lambda* (c . d) (+ a b c))))
+ (lambda* (:rest b) b)
+ ))
+
+(let ()
+ (define* (f1 a :allow-other-keys) (+ a 1))
+ (let ((str (object->string f1 :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (test (f1 2 :b 3) 3)
+ (test (obj 2) 3)
+ (test (obj 2 :b 3) 3)))) ; too many args
+
+
+;; :readable ports
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (input-port? n))
+ (not (input-port? obj))
+ (not (equal? (port-closed? n) (port-closed? obj))))
+ (format *stderr* "~A not equal? ~A (~S)~%" n obj str)
+ (if (and (not (port-closed? n))
+ (not (eq? n *stdin*))
+ (not (eq? n (current-input-port))))
+ (let ((c1 (read-char n))
+ (c2 (read-char obj)))
+ (if (not (equal? c1 c2))
+ (format *stderr* "read-char results ~A not equal? ~A (~S)~%" c1 c2 str)))))
+ (if (and (not (eq? n *stdin*))
+ (not (eq? n (current-input-port))))
+ (begin
+ (close-input-port n)
+ (close-input-port obj))))))
+ (list *stdin*
+ (open-input-string "a test")
+ (call-with-input-string "a test" (lambda (p) p))
+ (let ((p (open-input-string "a test"))) (read-char p) p)
+ (call-with-input-file "s7test.scm" (lambda (p) p))
+ (open-input-file "write.scm")
+ (let ((p (open-input-file "write.scm"))) (read-char p) p)))
+
+;; :readable environments
+(for-each
+ (lambda (n)
+ (let ((str (object->string n :readable)))
+ (let ((obj (with-input-from-string str
+ (lambda ()
+ (eval (read))))))
+ (if (or (not (let? n))
+ (not (let? obj))
+ (not (equal? n obj)))
+ (format *stderr* "~A not equal? ~A (~S)~%" n obj str)))))
+ (list (rootlet)
+ (let ((a 1)) (curlet))
+ (let ((a 1) (b 2)) (curlet))))
+
+(when with-block
+ (let ((b (block 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0)))
+ (test (format #f "~W" b) "(block 1.000 2.000 3.000 4.000 5.000 6.000 7.000 8.000)")
+ (test (format #f "~A" b) "(block ...)")))
+
+(test (object->string (define (ex1 a b) (+ a b)) :readable) "(lambda (a b) (+ a b))")
+(test (object->string (let ((c 3)) (define (ex1 a b) (+ a c b))) :readable) "(let ((c 3)) (lambda (a b) (+ a c b)))")
+(test (object->string (let ((c 3)) (define (ex1) (+ c 1))) :readable) "(let ((c 3)) (lambda () (+ c 1)))")
+(test (object->string (define* (ex1 a (b 0)) (+ a b)) :readable) "(lambda* (a (b 0)) (+ a b))")
+(test (object->string (define (ex1 a . b) (+ a b)) :readable) "(lambda (a . b) (+ a b))")
+
+ (let ((oldpl (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 4)
+ (define (f1) (vector-ref #(0 1 2 3 4 5 6 7 8) 2))
+ (test (object->string f1 :readable) "(lambda () (vector-ref #(0 1 2 3 4 5 6 7 8) 2))")
+ (set! (*s7* 'print-length) oldpl))
+
+(test (object->string (make-iterator #u8(12 41 2)) :readable) "(make-iterator #u8(12 41 2))")
+(test (object->string (inlet) :readable) "(inlet)")
+(test (object->string (inlet 'a 1) :readable) "(inlet 'a 1)")
+(test (object->string (inlet 'a 1 'b 2) :readable) "(inlet 'a 1 'b 2)")
+(test (object->string (inlet 'a #\1) :readable) "(inlet 'a #\\1)")
+(test (object->string (inlet 'a #\newline) :readable) "(inlet 'a #\\newline)")
+(test (object->string (inlet 'a #\null) :readable) "(inlet 'a #\\null)")
+(test (object->string (inlet 'a 3.0) :readable) "(inlet 'a 3.0)")
+(test (object->string (inlet 'a 1/2) :readable) "(inlet 'a 1/2)")
+(test (object->string (inlet 'a 1+i) :readable) "(inlet 'a 1+1i)")
+(test (object->string (inlet 'a (log 0)) :readable) (format #f "(inlet 'a (~S -inf.0 3.141592653589793))" (if pure-s7 'complex 'complex)))
+(test (object->string (inlet 'a 1/0) :readable) "(inlet 'a nan.0)")
+(test (object->string (inlet 'a "1") :readable) "(inlet 'a \"1\")")
+(test (object->string (inlet 'a "") :readable) "(inlet 'a \"\")")
+(test (object->string (inlet 'a #<undefined>) :readable) "(inlet 'a #<undefined>)")
+(test (object->string (inlet 'a #<unspecified>) :readable) "(inlet 'a #<unspecified>)")
+(test (object->string (inlet 'a #<eof>) :readable) "(inlet 'a (begin #<eof>))")
+(test (object->string (inlet 'a lambda) :readable) "(inlet 'a lambda)")
+(test (object->string (inlet 'a 'b) :readable) "(inlet 'a 'b)")
+(test (object->string (inlet 'a (symbol "( a b c )")) :readable) "(inlet 'a (symbol \"( a b c )\"))")
+(test (object->string (inlet 'a else) :readable) "(inlet 'a else)")
+(test (object->string (inlet 'a (cons 1 2)) :readable) "(inlet 'a (cons 1 2))")
+(test (object->string (inlet 'a (list 1 2)) :readable) "(inlet 'a (list 1 2))")
+(test (object->string (inlet 'a (list "hi")) :readable) "(inlet 'a (list \"hi\"))")
+(test (object->string (inlet 'a ()) :readable) "(inlet 'a ())")
+(test (object->string (inlet 'a '(1 2 . 3)) :readable) "(inlet 'a (cons 1 (cons 2 3)))")
+(test (object->string (inlet 'a #t) :readable) "(inlet 'a #t)")
+(test (object->string (inlet 'a #f) :readable) "(inlet 'a #f)")
+(test (object->string (inlet 'a :b) :readable) "(inlet 'a :b)")
+(test (object->string (inlet 'a (hash-table)) :readable) "(inlet 'a (hash-table))")
+(test (object->string (inlet 'a (hash-table* 'b 1)) :readable) "(inlet 'a (hash-table (cons 'b 1)))")
+(test (object->string (inlet 'a (hash-table* 'b "hi")) :readable) "(inlet 'a (hash-table (cons 'b \"hi\")))")
+(test (object->string (inlet 'a (hash-table* 'b "h\"i")) :readable) "(inlet 'a (hash-table (cons 'b \"h\\\"i\")))")
+(test (object->string (inlet 'a #()) :readable) "(inlet 'a #())")
+(test (object->string (inlet 'a #(1 2 3)) :readable) "(inlet 'a (vector 1 2 3))")
+(test (object->string (inlet 'a (vector "hi" #\a 'b)) :readable) "(inlet 'a (vector \"hi\" #\\a 'b))")
+(test (object->string (inlet 'a (float-vector 1 2 3)) :readable) "(inlet 'a (float-vector 1.0 2.0 3.0))")
+(test (object->string (inlet 'a (int-vector 1 2 3)) :readable) "(inlet 'a (int-vector 1 2 3))")
+(test (object->string (inlet 'a #2d((1 2 3) (4 5 6))) :readable) "(inlet 'a (make-shared-vector (vector 1 2 3 4 5 6) '(2 3)))")
+(test (object->string (inlet 'a abs) :readable) "(inlet 'a abs)")
+(test (object->string (inlet 'a (lambda (b) (+ b 1))) :readable) "(inlet 'a (lambda (b) (+ b 1)))")
+(test (object->string (inlet 'a (lambda b (list b 1))) :readable) "(inlet 'a (lambda b (list b 1)))")
+(test (object->string (inlet 'a (lambda (a . b) (list a b))) :readable) "(inlet 'a (lambda (a . b) (list a b)))")
+(test (object->string (inlet 'a (define-macro (_m_ b) `(+ ,b 1))) :readable) "(inlet 'a (define-macro (_m_ b) ({list} '+ b 1)))")
+(test (object->string (inlet 'a (define-bacro (_m_ b) `(+ ,b 1))) :readable) "(inlet 'a (define-bacro (_m_ b) ({list} '+ b 1)))")
+(test (object->string (inlet 'a (lambda* ((b 1)) (+ b 1))) :readable) "(inlet 'a (lambda* ((b 1)) (+ b 1)))")
+(test (object->string (inlet 'a (lambda* a (list a))) :readable) "(inlet 'a (lambda* a (list a)))")
+(test (object->string (inlet 'a (lambda* (a (b 1) c) (list a b c))) :readable) "(inlet 'a (lambda* (a (b 1) c) (list a b c)))")
+(test (object->string (inlet 'a (define-macro* (_m_ (b 1)) `(+ ,b 1))) :readable) "(inlet 'a (define-macro* (_m_ (b 1)) ({list} '+ b 1)))")
+(test (object->string (inlet 'a (define-bacro* (_m_ (b 1)) `(+ ,b 1))) :readable) "(inlet 'a (define-bacro* (_m_ (b 1)) ({list} '+ b 1)))")
+(when with-block
+ (test (object->string (inlet 'a (block)) :readable) "(inlet 'a (block))")
+ (test (object->string (inlet 'a blocks) :readable) "(inlet 'a blocks)")
+ (test (object->string (inlet 'a (block 1 2 3)) :readable) "(inlet 'a (block 1.000 2.000 3.000))"))
+(test (object->string (inlet 'a (c-pointer 0)) :readable) "(inlet 'a (c-pointer 0))")
+(test (object->string (inlet 'a (c-pointer 1)) :readable) "(inlet 'a (c-pointer 1))")
+(test (object->string (inlet 'a quasiquote) :readable) "(inlet 'a quasiquote)")
+(test (object->string (inlet 'a (dilambda (lambda () 1) (lambda (x) x))) :readable) "(inlet 'a (dilambda (lambda () 1) (lambda (x) x)))")
+(test (object->string (inlet 'a (inlet 'b 1)) :readable) "(inlet 'a (inlet 'b 1))")
+(test (object->string (inlet 'a (let ((b 1)) (lambda () b))) :readable) "(inlet 'a (let ((b 1)) (lambda () b)))")
+(test (object->string
+ (inlet 'a (let ((y 1)) (dilambda (lambda () y) (lambda (x) (set! y x))))) :readable)
+ "(inlet 'a (let ((y 1)) (dilambda (lambda () y) (lambda (x) (set! y x)))))")
+(test (object->string (inlet 'a (open-input-string "123456")) :readable) "(inlet 'a (open-input-string \"123456\"))")
+(test (object->string (inlet 'a (let ((p (open-input-string "123456"))) (read-char p) p)) :readable) "(inlet 'a (open-input-string \"23456\"))")
+(test (object->string (inlet 'a (let ((p (open-input-string "1"))) (read-char p) p)) :readable) "(inlet 'a (open-input-string \"\"))")
+(test (object->string (inlet 'a (let ((p (open-input-string "1"))) (read-char p) (read-char p) p)) :readable) "(inlet 'a (open-input-string \"\"))")
+(test (object->string (inlet 'a (call-with-input-string "1" (lambda (p) p))) :readable) "(inlet 'a (call-with-input-string \"\" (lambda (p) p)))")
+(test (object->string (inlet 'a (let ((p (open-input-string "1"))) (close-input-port p) p)) :readable) "(inlet 'a (call-with-input-string \"\" (lambda (p) p)))")
+(test (object->string (inlet 'a *stdin*) :readable) "(inlet 'a *stdin*)")
+(test (object->string (inlet 'a *stdout*) :readable) "(inlet 'a *stdout*)")
+(test (object->string (inlet 'a *stderr*) :readable) "(inlet 'a *stderr*)")
+(test (object->string
+ (inlet 'a (let ((p (open-output-string))) (close-output-port p) p)) :readable)
+ "(inlet 'a (let ((p (open-output-string))) (close-output-port p) p))")
+(test (object->string (inlet 'a (open-output-string)) :readable) "(inlet 'a (let ((p (open-output-string))) p))")
+(test (object->string
+ (inlet 'a (let ((p (open-output-string))) (display 32 p) p)) :readable)
+ "(inlet 'a (let ((p (open-output-string))) (display \"32\" p) p))")
+(test (object->string (inlet 'a (open-output-file "test.test")) :readable) "(inlet 'a (open-output-file \"test.test\" \"a\"))")
+(test (object->string (inlet 'a (open-input-file "test.test")) :readable) "(inlet 'a (open-input-file \"test.test\"))")
+(test (object->string (inlet 'a (make-iterator "123")) :readable) "(inlet 'a (make-iterator \"123\"))")
+(test (object->string (inlet 'a (let ((iter (make-iterator "123"))) (iter) iter)) :readable) "(inlet 'a (make-iterator \"23\"))")
+(test (object->string (inlet 'a (make-iterator #(1 2 3))) :readable) "(inlet 'a (make-iterator (vector 1 2 3)))")
+(test (object->string (inlet 'a (make-iterator '(1 2 3))) :readable) "(inlet 'a (make-iterator (list 1 2 3)))")
+(test (object->string
+ (inlet 'a (let ((iter (make-iterator (float-vector 1 2 3)))) (iter) iter)) :readable)
+ "(inlet 'a (let ((iter (make-iterator (float-vector 1.0 2.0 3.0)))) (do ((i 0 (+ i 1))) ((= i 1) iter) (iterate iter))))")
+
+(test (object->string (let () (define (f1) (+ a 1)) (curlet)) :readable) "(inlet 'f1 (lambda () (+ a 1)))")
+(test (object->string (let () (define (f1) 1) (let () (define f2 f1) (curlet))) :readable) "(inlet 'f2 (lambda () 1))")
+(test (object->string
+ (let ((a 1)) (define d (let ((b 1)) (lambda (c) (+ a b c)))) (curlet)) :readable)
+ "(inlet 'a 1 'd (let ((b 1) (a 1)) (lambda (c) (+ a b c))))")
+(test (object->string
+ (let () (define a (let ((b 1) (c 2)) (lambda (d) (+ b c d)))) (curlet)) :readable)
+ "(inlet 'a (let ((c 2) (b 1)) (lambda (d) (+ b c d))))")
+(test (object->string (let ((a 1)) (define d (let ((b 1)) (let ((c b)) (lambda (e) (+ a b c e))))) (curlet)) :readable)
+ "(inlet 'a 1 'd (let ((c 1) (b 1) (a 1)) (lambda (e) (+ a b c e))))")
+(test (object->string (inlet 'a (let ((b 1)) (lambda () (+ b c)))) :readable) "(inlet 'a (let ((b 1)) (lambda () (+ b c))))")
+(test (object->string (inlet 'a (let ((b 1)) (lambda () (+ b pi)))) :readable) "(inlet 'a (let ((b 1)) (lambda () (+ b pi))))")
+(test (object->string (let* ((a 1) (b a)) (curlet)) :readable) "(inlet 'b 1)")
+(test (object->string (let ((a 1)) (define (b c) (+ c a)) (curlet)) :readable) "(inlet 'a 1 'b (let ((a 1)) (lambda (c) (+ c a))))")
+;;; ideally we'd catch the documentation setting
+
+(test (string? (object->string (let ((lst (list 1))) (set-cdr! lst lst) (make-iterator lst)) :readable)) #t)
+
+;;; these are not readable:
+(test (object->string (inlet 'a (call-with-exit (lambda (return) return))) :readable) "(inlet 'a goto)")
+(test (object->string (inlet 'a (call/cc (lambda (return) return))) :readable) "(inlet 'a continuation)")
+
+;;; these are incorrect:
+;(test (object->string (let ((b 1)) (set! (symbol-access 'b) (lambda (val) val)) (curlet)) :readable) "(inlet 'b 1)")
+;(test (object->string (let () (define-constant a 32) (curlet)) :readable) "(inlet 'a 32)")
+;(test (object->string #('1)) "(vector '1)")
+;(test (object->string (inlet 'a ''()) :readable) "(inlet 'a '())")
+(test (object->string (c-pointer 1234) :readable) "(c-pointer 1234)")
+
+(test (string? (object->string (*s7* 'gc-protected-objects) :readable)) #t)
+(test (string? (object->string (*s7* 'c-objects) :readable)) #t)
+(test (string? (object->string (*s7* 'file-names) :readable)) #t)
+(test (string? (object->string (*s7* 'c-types) :readable)) #t)
+(test (string? (object->string (*s7* 'cpu-time) :readable)) #t)
+(test (string? (object->string (*s7* 'catches) :readable)) #t)
+(test (string? (object->string (*s7* 'exits) :readable)) #t)
+(test (string? (object->string (*s7* 'stack) :readable)) #t)
+
+(let ((ht (hash-table* 'a 1))
+ (lt (inlet :b 1))
+ (lst (list 1)))
+ (set! (ht 'a) lst)
+ (set! (lst 0) lt)
+ (set! (lt 'b) ht)
+ (test (object->string ht) "#1=(hash-table '(a (inlet 'b #1#)))"))
+
+(let ((ht (hash-table* 'a 1)))
+ (fill! ht ht)
+ (test (object->string ht) "#1=(hash-table '(a . #1#))"))
+
+(let ((ht (hash-table* 'a 1)))
+ (set! (ht 'a) ht)
+ (fill! ht (list ht))
+ (test (object->string ht) "#1=(hash-table '(a #1#))"))
+
+(let ((ht (hash-table* 'a 1)))
+ (let ((lt (curlet)))
+ (set! (ht 'a) ht)
+ (fill! ht (list lt))
+ (test (object->string ht) "#1=(hash-table '(a (inlet 'ht #1#)))")))
+
+(if (not with-bignums)
+ (begin
+ (test (object->string (random-state 123 321)) "#<rng 123 321>")
+ (test (object->string (random-state 9223372036854775807 9223372036854775807)) "#<rng 9223372036854775807 9223372036854775807>")
+ (test (object->string (random-state 123 321) :readable) "(random-state 123 321)")
+ (test (object->string (random-state 9223372036854775807 9223372036854775807) :readable) "(random-state 9223372036854775807 9223372036854775807)"))
+ (begin
+ (test (substring (object->string (random-state 9223372036854775807 9223372036854775807)) 0 6) "#<rng ")
+ (test (object->string (random-state 9223372036854775807 9223372036854775807) :readable) "#<unprint-readable object>")))
+
+(if full-test
+ (let ()
+ (define (testlet e)
+ (let ((data (cons #f #f)))
+ (let ((iter (make-iterator e data)))
+ (do ((val (iterate iter) (iterate iter)))
+ ((iterator-at-end? iter))
+ (let ((sym (car val))
+ (fnc (cdr val)))
+ (if (procedure? fnc)
+ (let ((sig (catch #t (lambda () (procedure-signature fnc)) (lambda args #f)))
+ (doc (catch #t (lambda () (procedure-documentation fnc)) (lambda args #f)))
+ (src (catch #t (lambda () (procedure-source fnc)) (lambda args #f)))
+ (ari (catch #t (lambda () (arity fnc)) (lambda args #f))))
+ (let ((lst (list sym fnc sig doc src ari)))
+ (object->string lst)
+ (object->string lst :readable)))
+ (begin
+ (object->string val)
+ (object->string val :readable))))))))
+
+ (testlet (rootlet))
+
+ (require libc.scm)
+ (testlet *libc*)
+
+ (require libm.scm)
+ (when (defined? '*libm*) (testlet *libm*))
+
+ (when (provided? 'gtk)
+ (testlet *gtk*))
+
+ (require libgsl.scm)
+ (when (defined? '*libgsl*) (testlet *libgsl*))
+
+ (require libgdbm.scm)
+ (when (defined? '*libgdbm*) (testlet *libgdbm*))
+
+ (require libdl.scm)
+ (when (defined? '*libdl*) (testlet *libdl*))
+
+ (require libutf8proc.scm)
+ (when (defined? '*libutf8proc*) (testlet *libutf8proc*))))
+
;;; --------------------------------------------------------------------------------
@@ -10363,19 +18556,19 @@ this prints:
(for-each
(lambda (op)
(if (not (eq? op op))
- (format #t "~A not eq? to itself?~%" op)))
+ (format-logged #t "~A not eq? to itself?~%" op)))
control-ops)
(for-each
(lambda (op)
(if (not (eqv? op op))
- (format #t "~A not eqv? to itself?~%" op)))
+ (format-logged #t "~A not eqv? to itself?~%" op)))
control-ops)
(for-each
(lambda (op)
(if (not (equal? op op))
- (format #t "~A not equal? to itself?~%" op)))
+ (format-logged #t "~A not equal? to itself?~%" op)))
control-ops)
(define question-ops (list boolean? eof-object? string?
@@ -10387,7 +18580,7 @@ this prints:
(for-each
(lambda (op)
(if (ques op)
- (format #t ";(~A ~A) returned #t?~%" ques op)))
+ (format-logged #t ";(~A ~A) returned #t?~%" ques op)))
control-ops))
question-ops)
@@ -10395,13 +18588,13 @@ this prints:
(for-each
(lambda (op)
(if (op unspecified)
- (format #t ";(~A #<unspecified>) returned #t?~%" op)))
+ (format-logged #t ";(~A #<unspecified>) returned #t?~%" op)))
question-ops))
(for-each
(lambda (s)
(if (not (symbol? s))
- (format #t ";(symbol? ~A returned #f?~%" s)))
+ (format-logged #t ";(symbol? ~A returned #f?~%" s)))
'(+ - ... !.. $.+ %.- &.! *.: /:. <-. =. >. ?. ~. _. ^.))
@@ -10418,7 +18611,7 @@ this prints:
(test (if '() 1 2) 1)
(test (if 't 1 2) 1)
(test (if #t 1 2) 1)
-(test (if '#() 1 2) 1)
+(test (if #() 1 2) 1)
(test (if 1 2 3) 2)
(test (if 0 2 3) 2)
(test (if (list) 2 3) 2)
@@ -10436,26 +18629,22 @@ this prints:
(for-each
(lambda (arg)
(test (if a arg 'gad) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))))
(let ((a #t))
(for-each
(lambda (arg)
(test (if (not a) 'gad arg) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))))
(test (let ((ctr 0) (a #t)) (if a (let ((b ctr)) (set! ctr (+ ctr 1)) (list b ctr)) (let ((c ctr)) (set! ctr (+ ctr 100)) (list c ctr)))) (list 0 1))
(test (if if if if) if)
(test (((if if if) if if) if if 'gad) if)
(test (if if (if if if) if) if)
-(test (let ((car if)) (car #t 0 1)) 0)
(test ((car (list if)) #t 0 1) 0)
(test (symbol->string 'if) "if")
(test (if (and if (if if if)) if 'gad) if)
-(test (let ((if #t)) (or if)) #t)
-;(test (let ((if +)) (if 1 2 3)) 6)
-; this is another of the "syntax" as car choices
(test (let ((ctr 0)) (if (let () (set! ctr (+ ctr 1)) (= ctr 1)) 0 1)) 0)
(test (let ((ctr 0)) (if (let () (set! ctr (+ ctr 1)) (if (= ctr 1) (> 3 2) (< 3 2))) 0 1)) 0)
(test ( if (> 3 2) 1 2) 1)
@@ -10473,9 +18662,9 @@ this prints:
(test (let ((ctr 0)) (if (= ctr 0) (let () (set! ctr (+ ctr 1)) (if (= ctr 1) 2 3)) (let () (set! ctr (+ ctr 1)) (if (= ctr 1) 4 5)))) 2)
(test (let ((x (cons 1 2))) (set-cdr! x x) (if x 1 2)) 1)
(test (let ((ctr 0)) (if (let ((ctr 123)) (set! ctr (+ ctr 1)) (= ctr 124)) (let () (set! ctr (+ ctr 100)) ctr) (let () (set! ctr (+ ctr 1000)) ctr)) ctr) 100)
-(test (if (let ((if 3)) (> 2 if)) 4 5) 5)
(test (let () (if #t (define (hi a) a)) (hi 1)) 1)
(test (let () (if #f (define (hi a) (+ a 1)) (define (hi a) a)) (hi 1)) 1)
+(test (let ((oddp (lambda (a) (not (even? a))))) (define (hi a) (if (a 123) (a 321))) (hi oddp)) #t)
(test (let ((ctr 0)) (call/cc (lambda (exit) (if (> 3 2) (let () (exit ctr) (set! ctr 100) ctr) #f)))) 0)
(test (let ((ctr 0)) (call/cc (lambda (exit) (if (< 3 2) #f (let () (exit ctr) (set! ctr 100) ctr))))) 0)
@@ -10548,7 +18737,60 @@ this prints:
(test (if _no_var_ 1) 'error)
(test (if (values) (values) (values) 1) 'error)
(num-test (+ 1 (if #t (values 3 4) (values 5 6)) 2) 10)
+(let ()
+ (define (bad a) (if a 1 2 3))
+ (test (bad #f) 'error)
+ (test (bad #t) 'error))
+
+
+;;; when
+(test (when #f #f) #<unspecified>)
+(test (when #t #f) #f)
+(test (when) 'error)
+(test (when #t) 'error)
+(test (when . #t) 'error)
+(test (when #t . 1) 'error)
+(test (when when when) when)
+(test (symbol->string 'when) "when")
+(test (when #t 1 2 3) 3)
+(test (when #t (define a 1) (+ a 1)) 2)
+(test ((when #t +) 2 3) 5)
+(test (when #t (when #f #f)) #<unspecified>)
+(test (+ (when #t (values 2 3))) 5)
+(test (when (when #t #t) 2) 2)
+(test (apply when '(< 2 3) '((+ 2 1))) 3)
+
+(let ((x 0))
+ (define (t1 a) (when a (set! x (+ x 1)) x))
+ (test (t1 #t) 1)
+ (test (t1 #f) #<unspecified>)
+ (test (t1 #t) 2))
+
+
+;;; unless
+(test (unless #t #f) #<unspecified>)
+(test (unless #f #f) #f)
+(test (unless) 'error)
+(test (unless #f) 'error)
+(test (unless . #t) 'error)
+(test (unless #f . 1) 'error)
+(test (unless (not unless) unless) unless)
+(test (symbol->string 'unless) "unless")
+(test (unless #f 1 2 3) 3)
+(test (unless #f (define a 1) (+ a 1)) 2)
+(test ((unless #f +) 2 3) 5)
+(test (unless #f (unless #t #f)) #<unspecified>)
+(test (+ (unless #f (values 2 3))) 5)
+(test (unless (unless #f #f) 2) 2)
+(test (apply unless '(= 2 3) '((+ 2 1))) 3)
+(let ((x 0))
+ (define (t1 a) (unless a (set! x (+ x 1)) x))
+ (test (t1 #f) 1)
+ (test (t1 #t) #<unspecified>)
+ (test (t1 #f) 2))
+
+(test (when (unless (= 2 3) #t) 1) 1)
@@ -10567,10 +18809,10 @@ this prints:
(test '#f #f)
(test '#t #t)
(test '#b1 1)
-(test (= 1/2 '#e#b1e-1) #t)
+(when (not pure-s7) (test (= 1/2 '#e#b1e-1) #t))
(test '() '())
(test '(1 . 2) (cons 1 2))
-(test #(1 2) '#(1 2))
+(test #(1 2) #(1 2))
(test (+ '1 '2) 3)
(test (+ '1 '2) '3)
(test (+ ' 1 ' 2) ' 3)
@@ -10579,7 +18821,7 @@ this prints:
(test (boolean? '#t) #t)
(test (if '#f 2 3) 3)
(test (if '#t 2 3) 2)
-(test (vector? '#()) #t)
+(test (vector? #()) #t)
(test (char? (quote #\a)) #t)
(test (string? (quote "hi")) #t)
(test (boolean? (quote #t)) #t)
@@ -10603,14 +18845,11 @@ this prints:
' ' 4)) 7)
(test (+ '#| a comment |#2 3) 5)
(test (+ ' #| a comment |# 2 3) 5)
-(test (eq? lambda 'lambda) #t)
+(test (eq? lambda 'lambda) #f)
(test (equal? + '+) #f)
(test (eq? '() ()) #t) ; s7 specific
-(test (let ((quote 1)) (+ quote 1)) 2)
-(test ((lambda (quote) (+ quote 1)) 2) 3)
-(test ((lambda (quote . args) (list quote args)) 1 2 3) '(1 (2 3)))
-
+(test (quote) 'error)
(test (quote . -1) 'error)
(test (quote 1 1) 'error)
(test (quote . 1) 'error)
@@ -10618,6 +18857,8 @@ this prints:
(test (quote 1 . 2) 'error)
(test (symbol? '1'1) #t)
(test (apply '+ (list 1 2)) 'error)
+(test ((quote . #\h) (2 . #\i)) 'error)
+(test ((quote "hi") 1) #\i)
(test (equal? '(1 2 '(3 4)) '(1 2 (3 4))) #f)
(test (equal? '(1 2 '(3 4)) (quote (list 1 2 (quote (list 3 4))))) #f)
@@ -10627,7 +18868,7 @@ this prints:
(test (equal? '('3 4) (list (list 'quote 3) 4)) #t)
(test (equal? '('3 4) (list 3 4)) #f)
(test (equal? '('() 4) (list (list 'quote '()) 4)) #t)
-(test (equal? '('('4)) (list (list quote (list (list quote 4))))) #t) ; weird... (guile wants quoted quotes)
+(test (equal? '('('4)) (list (list quote (list (list quote 4))))) #f)
(test (equal? '('('4)) (list (list 'quote (list (list 'quote 4))))) #t)
(test (equal? '('('4)) '((quote ((quote 4))))) #t)
(test (equal? '1 ''1) #f)
@@ -10636,6 +18877,7 @@ this prints:
(test (equal? #(1 #(2 3)) '#(1 '#(2 3))) #f)
(test (equal? #(1) #('1)) #f)
(test (equal? #(()) #('())) #f)
+(test (equal? cons 'cons) #f)
(test (eqv? #\a (quote #\a)) #t)
(test (eqv? 1 (quote 1)) #t)
@@ -10652,6 +18894,24 @@ this prints:
(test ('abs -1) 'error)
(test ('"hi" 0) #\h)
+(test (''begin 1) 'begin)
+(test (''let ((x 1)) ('set! x 3) x) 'error)
+(test ('and #f) 'error)
+(test ('and 1 #f) 'error)
+(test ('begin 1) 'error)
+(test ('cond ('define '#f)) 'error)
+(test ('let ((x 1)) ('set! x 3) x) 'error)
+(test ('let* () ('define x 3) x) 'error)
+(test ('or #f) 'error)
+(test ('quote 3) 'error)
+(test ((copy quote) 1) 1)
+(test ((copy quote) quote) 'quote)
+(test ((lambda (q) (let ((x 1)) (q x))) quote) 'x) ; these two are strange -- not sure about them, but Guile 1.8 is the same
+(test ((lambda (s c) (s c)) quote #f) 'c)
+;;; ((lambda (lambda) (lambda (else))) quote) -> '(else)
+(test ((quote and) #f) 'error)
+(test ((values quote) 1) 1)
+
;; see also quasiquote
@@ -10661,26 +18921,28 @@ this prints:
;;; for-each
;;; --------------------------------------------------------------------------------
-(test (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) '#(0 1 4 9 16))
-(test (let ((ctr 0) (v (make-vector 5))) (for-each (lambda (i) (vector-set! v ctr (* i i)) (set! ctr (+ ctr 1))) '(0 1 2 3 4)) v) '#(0 1 4 9 16))
-(for-each (lambda (x) (display "for-each should not have called this")) '())
+(test (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) #(0 1 4 9 16))
+(test (let ((ctr 0) (v (make-vector 5))) (for-each (lambda (i) (vector-set! v ctr (* i i)) (set! ctr (+ ctr 1))) '(0 1 2 3 4)) v) #(0 1 4 9 16))
+(for-each (lambda (x) (display "for-each should not have called this")) ())
(test (let ((ctr 0)) (for-each (lambda (x y) (if (= x y) (set! ctr (+ ctr 1)))) '(1 2 3 4 5 6) '(2 3 3 4 7 6)) ctr) 3)
(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5)) ctr) 15)
(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) '(5)) ctr) 9)
-(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '() '() '()) ctr) 0)
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) () () ()) ctr) 0)
(test (let () (for-each abs '(1 2)) 1) 1)
(test (let ((ctr 0)) (for-each (lambda (a) (for-each (lambda (b) (set! ctr (+ ctr 1))) '(0 1))) '(2 3 4)) ctr) 6)
(test (let ((sum 0)) (for-each (lambda args (set! sum (+ sum (apply + args)))) '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) sum) 72)
(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) sum) 72)
(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2) '(2 1 0)) sum) 6)
(test (let () (for-each + '(0 1 2) '(2 1 0)) 0) 0)
-(test (let () () ()) '())
+(test (let () () ()) ())
(test (for-each + ()) #<unspecified>)
(test (let ((sum 0)) (for-each (lambda a (set! sum (+ sum (apply + a)))) '(1 2 3)) sum) 6)
(test (let ((sum 0)) (for-each (lambda* ((a 1)) (set! sum (+ sum a))) '(1 2 3)) sum) 6)
(test (let ((sum 0)) (for-each (lambda (a . b) (set! sum (+ sum a))) '(1 2 3)) sum) 6)
(test (let ((sum 0) (lst (list 1 2 3))) (for-each (lambda (a b c) (set! sum (+ sum a b c))) lst lst lst) sum) 18)
(test (let ((sum 0) (lst (vector 1 2 3))) (for-each (lambda (a b c) (set! sum (+ sum a b c))) lst lst lst) sum) 18)
+(test (let ((v (vector 1 2 3))) (for-each vector-set! (list v v v) (list 0 1 2) (list 32 33 34)) v) #(32 33 34))
+(test (let () (define (hi) (for-each (lambda (x) (+ x 1)) (list 1 2 3))) (hi) (hi)) #<unspecified>)
(test (let ((d 0))
(for-each (let ((a 0))
@@ -10719,7 +18981,7 @@ this prints:
(test (let ((ctr 0)
(cont #f)
- (lst '()))
+ (lst ()))
(let ((val (call/cc
(lambda (exit)
(for-each (lambda (a)
@@ -10736,9 +18998,9 @@ this prints:
(list ctr val lst)))
(list 5 5 (list 4 3 2 1 0)))
-(test (let ((lst '()))
+(test (let ((lst ()))
(for-each (lambda (a) (set! lst (cons a lst)))
- (let ((lst '()))
+ (let ((lst ()))
(for-each (lambda (b) (set! lst (cons b lst)))
(list 1 2 3))
lst))
@@ -10749,6 +19011,33 @@ this prints:
; (let ((cont #f)) (call/cc (lambda (x) (set! cont x))) (for-each cont (list 1 2 3)))
(test (call/cc (lambda (x) (for-each x (list 1 2 3)))) 1) ; map also gives 1 ... perhaps not actually legal?
+(let ((args (list 0 1 2))
+ (xx (list 4)))
+ (define (it1)
+ (for-each
+ (lambda (x)
+ (catch #t
+ (lambda ()
+ (set-car! xx x))
+ (lambda any 'error)))
+ (cdr args))
+ (car xx))
+ (test (it1) 2))
+
+(let ((args (list 0 1 2))
+ (xx (list 4)))
+ (define (it1)
+ (for-each
+ (lambda (x)
+ (catch #t
+ (lambda ()
+ (set-car! xx x))
+ (lambda any 'error))
+ (set-car! xx (+ (car xx) 32)))
+ (cdr args))
+ (car xx))
+ (test (it1) 34))
+
(test (let ((ctr 0))
(for-each
(lambda (x)
@@ -10769,7 +19058,7 @@ this prints:
(for-each
(lambda (a)
(if (not (string=? a "hi"))
- (format #t "yow: ~S" a)))
+ (format-logged #t "yow: ~S" a)))
(list "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi"))
@@ -10782,8 +19071,8 @@ this prints:
(test (let* ((x (list (list 1 2 3))) (y (apply for-each abs x))) x) '((1 2 3)))
(test (for-each (lambda (x) (display "for-each should not have called this"))) 'error)
-(test (for-each (lambda () 1) '()) #<unspecified>)
-(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) '()) ctr) 0)
+(test (for-each (lambda () 1) ()) 'error) ; #<unspecified>
+(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) ()) ctr) 0)
(test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6)) ctr) 15)
(test (for-each (lambda (a b) (+ a b)) (list 1)) 'error)
(test (for-each (lambda (a b) (+ a b)) (list 1) (list)) #<unspecified>)
@@ -10793,13 +19082,15 @@ this prints:
(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) #<unspecified>)
(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) #<unspecified>)
(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) #<unspecified>)
-(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) #<unspecified>)
+(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) 'error) ; #<unspecified>
(test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error)
(test (for-each (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) #<unspecified>)
(test (for-each (lambda (a b) (+ a b)) (cons 1 2) (list 1 2)) #<unspecified>)
(test (for-each (lambda (a) (+ a 1)) (list 1) (list 2)) 'error)
(test (for-each (lambda (a) (+ a 1)) #\a) 'error)
(test (for-each (lambda (a) (+ a 1)) (cons 1 2)) #<unspecified>)
+(test (for-each (lambda (x) x) (openlet (inlet 'make-iterator (lambda (v) v)))) 'error)
+(test (for-each (lambda (x) x) (openlet (inlet 'make-iterator (let ((iterator? #t)) (lambda (v) v))))) 'error)
(test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2)) sum) 'error)
(test (for-each (lambda (a) a) '(1 2 . 3)) #<unspecified>)
(test (for-each #(0 1 2) #(2 1 0)) #<unspecified>)
@@ -10810,11 +19101,11 @@ this prints:
(for-each
(lambda (op)
- (test (for-each op '()) 'error)
+ (test (for-each op ()) 'error)
(test (for-each op "") 'error)
- (test (for-each op #(1 2 3) '()) 'error)
+ (test (for-each op #(1 2 3) ()) 'error)
(test (for-each op #() (list) (string)) 'error))
- (list 0 '() #f #t 'a-symbol :hi #\a #<eof> #<unspecified> #<undefined> 0.0 1+i 1/2 1/0 0/0 *stdout* (current-input-port)))
+ (list 0 () #f #t 'a-symbol :hi #\a #<eof> #<unspecified> #<undefined> 0.0 1+i 1/2 1/0 0/0 *stdout* (current-input-port)))
(for-each
(lambda (arg)
(test (for-each arg (list 1)) 'error))
@@ -10832,78 +19123,81 @@ this prints:
(test (for-each #t) 'error)
(test (for-each map #t) 'error)
-(test (for-each abs '() abs) 'error)
-(test (for-each abs '(1) '#(1)) 'error)
-(test (let ((vals '())) (for-each for-each (list (lambda (a) (set! vals (cons (abs a) vals)))) (list (list -1 -2))) vals) '(2 1))
+(test (for-each abs () abs) 'error)
+(test (for-each abs '(1) #(1)) 'error)
+(test (let ((vals ())) (for-each for-each (list (lambda (a) (set! vals (cons (abs a) vals)))) (list (list -1 -2))) vals) '(2 1))
(test (let ((c #f)) (for-each (lambda (x) (set! c x)) "a") c) #\a)
(test (let ((c #f)) (for-each (lambda (x) (set! c x)) "") c) #f)
(test (let ((c #f)) (for-each (lambda (x) (set! c x)) (string #\null)) c) #\null)
(test (let ((L (list 1 2 3 4 5)) (sum 0)) (for-each (lambda (x) (set-cdr! (cddr L) 5) (set! sum (+ sum x))) L) sum) 6)
; map (below) has more tests along this line
-
-(test (for-each ="") #<unspecified>)
+(test (let ((f #f)) (for-each (lambda (a) (if (eq? a 'a) (set! f (lambda () a)))) '(a b c)) (f)) 'a)
+(test (let ((i 0) (f (make-vector 3))) (for-each (lambda (b) (vector-set! f i b) (set! i (+ i 1))) '(a b c)) f) #(a b c))
+(test (let ((i 0) (f (make-vector 3)) (lst '(a b c))) (define (hi) (for-each (lambda (b) (vector-set! f i b) (set! i (+ i 1))) lst)) (hi) f) #(a b c))
+(test (let ((i 0) (f (make-vector 3)) (lst '(a b c))) (define (hi) (for-each (lambda (b) (let () (vector-set! f i b) (set! i (+ i 1)))) lst)) (hi) f) #(a b c))
+(test (let ((i 0) (f (make-vector 3)) (lst (list 1 2 3))) (define (hi) (for-each (lambda (b) (vector-set! f i (let ((b (+ b 1))) b)) (set! i (+ i 1))) lst)) (hi) f) #(2 3 4))
+(test (let ((i 0) (f (make-vector 3)) (lst (list 1 2 3))) (define (hi) (for-each (lambda (b) (let ((b (+ b 1))) (vector-set! f i (let ((b (+ b 1))) b)) (set! i (+ i 1)))) lst)) (hi) f) #(3 4 5))
+(test (let ((f #f)) (define (hi) (for-each (lambda (a) (if (eq? a 'a) (set! f (lambda () (let () a))))) '(a b c))) (hi) (f)) 'a)
+(test (let ((lst '((a b c) (1 2 3)))) (define (hi) (for-each (lambda (a) a) (apply values lst))) (hi)) 'error)
+(test (let ((lst ())) (for-each (lambda args (set! lst (cons args lst))) (values (list 1 2 3) '(4 5 6) (list 7 8 9))) lst) '((3 6 9) (2 5 8) (1 4 7)))
+
+(test (for-each ="") 'error) ; #<unspecified>
(test (for-each =""=) 'error)
(test (for-each = "" 123) 'error)
(test (for-each = () 123) 'error)
(test (for-each =()=) 'error)
(test (for-each abs "") #<unspecified>)
-(test (for-each null? () #() "") #<unspecified>)
+(test (for-each null? () #() "") 'error) ; #<unspecified>
(test (for-each null? () #() 0 "") 'error)
(test (for-each define '(a) '(3)) #<unspecified>)
+(test (let () (for-each define '(a b c) '(1 2 3)) (list a b c)) '(1 2 3))
+(test (let () (for-each define '(first second third fourth) '(car cadr caddr cadddr)) (third '(1 2 3 4 5))) 3)
(test (for-each '(()) #()) #<unspecified>)
(test (for-each '(1 2 . 3) '(1 . 2)) #<unspecified>)
-(test (for-each '(()) '()) #<unspecified>)
+(test (for-each '(()) ()) #<unspecified>)
(test (for-each #2D((1 2) (3 4)) '(1)) #<unspecified>)
(test (for-each "a\x00b" #(1 2)) #<unspecified>)
(test (for-each #(1 (3)) '(1)) #<unspecified>)
(test (for-each '((1 (2)) (((3) 4))) '(1)) #<unspecified>)
(test (for-each "hi" '(1)) #<unspecified>)
-(test (for-each #() #()) #<unspecified>)
+(test (for-each #() #()) 'error) ; #<unspecified>
(test (for-each '(1 . 2) #()) #<unspecified>)
(test (let ((ht (hash-table '(a . 1) '(b . 2)))) (for-each ht ht)) #<unspecified>)
(test (let ((ht (hash-table '(a . 1) '(b . 2)))) (let ((sum 0)) (for-each (lambda (c) (set! sum (+ sum (cdr c)))) ht) sum)) 3)
(test (let ((ht (hash-table '(a . 1) '(b . 2)))) (for-each ht '(a b))) #<unspecified>)
(test (for-each ''2 '(1)) #<unspecified>)
-(let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (for-each lst lst) 'error))
-(let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (for-each #() lst) 'error))
-(test (for-each 1 "hi" '()) 'error)
-(test (for-each 0 #() '()) 'error)
+(let ((os (*s7* 'safety)))
+ (set! (*s7* 'safety) 1)
+ (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (for-each lst lst) #<unspecified>)) ; 'error
+ (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (for-each #() lst) 'error))
+ (set! (*s7* 'safety) os))
+(test (for-each 1 "hi" ()) 'error)
+(test (for-each 0 #() ()) 'error)
(test (for-each #\a #(1 2) '(3 4) "") 'error)
+(test (for-each '2 ()) 'error)
+(test (let ((a 1) (b 2)) (for-each apply (list set! set!) '(a b) '((12) (32))) (list a b)) '(12 32))
+(test (let ((a 1) (b 2) (c 3)) (for-each apply (make-list 3 set!) '(a b c) '((12) (32) (0))) (list a b c)) '(12 32 0))
+(test (let ((a 1) (b 2) (c 3)) (for-each set! '(a b c) '(12 32 0)) (list a b c)) '(12 32 0))
-(let ((ctr ((cadr (make-type :getter (lambda (a b) b) :length (lambda (a) (- (expt 2 31) 1))))))
- (sum 0))
- (test (call-with-exit
- (lambda (go)
- (for-each (lambda (a)
- (set! sum (+ sum a))
- (if (> sum 100)
- (go sum)))
- ctr)))
- 105))
-
-(let ((ctr ((cadr (make-type :getter (lambda (a b) b) :length (lambda (a) most-positive-fixnum)))))
- (sum 0))
- (gc)
- (test (call-with-exit
- (lambda (go)
- (for-each (lambda (a)
- (set! sum (+ sum a))
- (if (> sum 100)
- (go sum)))
- ctr)))
- 105))
-
-(let ((ctr ((cadr (make-type :getter (lambda (a b) (+ b 1))
- :length (lambda (a) 'hi))))))
- (test (for-each (lambda (x) x) ctr) 'error))
-
-(let ((ctr ((cadr (make-type :getter (lambda (a b) (car b))
- :length (lambda (a) 4))))))
- (test (for-each (lambda (x) x) ctr) 'error))
+(let ()
+ (define (hi)
+ (let ((lst '(1 2 3)))
+ (for-each
+ (lambda (x)
+ (catch #t
+ (lambda ()
+ (if (defined? 'local-x)
+ (format-logged #t ";for-each catch local env not cleared: ~A~%" local-x))
+ (define local-x x)
+ local-x)
+ (lambda args #f)))
+ lst)))
+ (hi)
+ (hi))
(let ((x 0))
- (let ((p1 (make-procedure-with-setter (lambda (a) (set! x (+ x a))) (lambda (a b) (+ a b)))))
+ (let ((p1 (dilambda (lambda (a) (set! x (+ x a))) (lambda (a b) (+ a b)))))
(for-each p1 '(1 2 3))
(test x 6))
(set! x 0)
@@ -10922,6 +19216,259 @@ this prints:
(for-each (lambda* (a (b 2)) (set! x (+ x a b))) '(1 2 3))
(test x 12))
+(test (let ((lst '(1 2 3)) (sum 0)) (define-macro (hi a) `(set! sum (+ sum (+ 1 ,a)))) (for-each hi lst) sum) 9)
+(test (let ((lst '(1 2 3)) (sum 0)) (define-bacro (hi a) `(set! sum (+ sum (+ 1 ,a)))) (for-each hi lst) sum) 9)
+
+(let ((sum 0))
+ (define (and-for-each func . args)
+ ;; apply func to first of each arg, stopping if func returns #f
+ (call-with-exit
+ (lambda (quit)
+ (apply for-each
+ (lambda arglist
+ (if (not (apply func arglist))
+ (quit #<unspecified>)))
+ args))))
+
+ (test (and-for-each (lambda (arg)
+ (and (not (null? arg))
+ (set! sum (+ sum arg))))
+ (list 1 2 () 3 4))
+ #<unspecified>)
+ (test sum 3)
+ (set! sum 0)
+
+ (and-for-each (lambda (arg)
+ (and (not (null? arg))
+ (set! sum (+ sum arg))))
+ (list 1 2 3 4))
+ (test sum 10)
+ (set! sum 0)
+
+ (and-for-each (lambda (arg1 arg2)
+ (and (not (null? arg1))
+ (not (null? arg2))
+ (set! sum (+ sum arg1 arg2))))
+ (list 1 2 3 4)
+ (list 5 6 () 7 8))
+ (test sum 14))
+
+
+(define (and-map func . args)
+ (call-with-exit
+ (lambda (quit)
+ (let ((result ()))
+ (apply for-each
+ (lambda arglist
+ (let ((val (apply func arglist)))
+ (if (not val)
+ (quit (reverse result))
+ (set! result (cons val result)))))
+ args)
+ (reverse result)))))
+
+(test (and-map even? '(0 2 4 5 6)) '(#t #t #t))
+
+(define (find-if f . args)
+ (call-with-exit
+ (lambda (return)
+ (apply for-each (lambda main-args
+ (if (apply f main-args)
+ (apply return main-args)))
+ args))))
+
+(test (find-if even? #(1 3 5 2)) 2)
+(test (* (find-if > #(1 3 5 2) '(2 2 2 3))) 6)
+
+(define (position-if f . args)
+ (let ((pos 0))
+ (call-with-exit
+ (lambda (return)
+ (apply for-each (lambda main-args
+ (if (apply f main-args)
+ (return pos))
+ (set! pos (+ pos 1)))
+ args)))))
+
+(test (position-if even? #(1 3 5 2)) 3)
+(test (position-if > #(1 3 5 2) '(2 2 2 3)) 1)
+
+(let ((summer (lambda (v)
+ (let ((sum 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) sum)
+ (set! sum (+ sum ((v i)))))))))
+
+ (test (let ((saved-args (make-vector 10))
+ (i 0))
+ (for-each
+ (lambda (arg)
+ (set! (saved-args i) arg)
+ (set! i (+ i 1)))
+ (list 0 1 2 3 4 5 6 7 8 9))
+ (set! (saved-args 0) 32)
+ saved-args)
+ #(32 1 2 3 4 5 6 7 8 9))
+
+ (test (let ((f #f))
+ (for-each
+ (lambda (i)
+ (let ()
+ (define (x) i)
+ (if (= i 1) (set! f x))))
+ (list 0 1 2 3))
+ (f))
+ 1)
+
+ (test (let ((saved-args (make-vector 10))
+ (i 0))
+ (for-each
+ (lambda (arg)
+ (set! (saved-args i) (lambda () arg))
+ (set! i (+ i 1)))
+ (list 0 1 2 3 4 5 6 7 8 9))
+ (summer saved-args))
+ 45)
+
+ (test (let ((saved-args (make-list 10))
+ (i 0))
+ (for-each
+ (lambda (arg)
+ (list-set! saved-args i (lambda () arg))
+ (set! i (+ i 1)))
+ (list 0 1 2 3 4 5 6 7 8 9))
+ (summer saved-args))
+ 45)
+
+;;; these are the same but use map
+ (test (let ((saved-args (make-vector 10))
+ (i 0))
+ (map
+ (lambda (arg)
+ (set! (saved-args i) arg)
+ (set! i (+ i 1)))
+ (list 0 1 2 3 4 5 6 7 8 9))
+ (set! (saved-args 0) 32)
+ saved-args)
+ #(32 1 2 3 4 5 6 7 8 9))
+
+ (test (let ((f #f))
+ (map
+ (lambda (i)
+ (let ()
+ (define (x) i)
+ (if (= i 1) (set! f x))))
+ (list 0 1 2 3))
+ (f))
+ 1)
+
+ (test (let ((saved-args (make-vector 10))
+ (i 0))
+ (map
+ (lambda (arg)
+ (set! (saved-args i) (lambda () arg))
+ (set! i (+ i 1)))
+ (list 0 1 2 3 4 5 6 7 8 9))
+ (summer saved-args))
+ 45)
+
+ ;; and again but with named let
+ (test (let ((saved-args (make-vector 10)))
+ (let runner ((arg 0))
+ (set! (saved-args arg) arg)
+ (if (< arg 9)
+ (runner (+ arg 1))))
+ (set! (saved-args 0) 32)
+ saved-args)
+ #(32 1 2 3 4 5 6 7 8 9))
+
+ (test (let ((f #f))
+ (let runner ((i 0))
+ (let ()
+ (define (x) i)
+ (if (= i 1) (set! f x))
+ (if (< i 3)
+ (runner (+ i 1)))))
+ (f))
+ 1)
+
+ (test (let ((saved-args (make-vector 10)))
+ (let runner ((i 0))
+ (set! (saved-args i) (lambda () i))
+ (if (< i 9)
+ (runner (+ i 1))))
+ (summer saved-args))
+ 45)
+
+
+;;; and recursion
+ (test (let ((saved-args (make-vector 10)))
+ (define (runner arg)
+ (set! (saved-args arg) arg)
+ (if (< arg 9)
+ (runner (+ arg 1))))
+ (runner 0)
+ (set! (saved-args 0) 32)
+ saved-args)
+ #(32 1 2 3 4 5 6 7 8 9))
+
+ (test (let ((f #f))
+ (define (runner i)
+ (let ()
+ (define (x) i)
+ (if (= i 1) (set! f x))
+ (if (< i 3)
+ (runner (+ i 1)))))
+ (runner 0)
+ (f))
+ 1)
+
+ (test (let ((saved-args (make-vector 10)))
+ (define (runner i)
+ (set! (saved-args i) (lambda () i))
+ (if (< i 9)
+ (runner (+ i 1))))
+ (runner 0)
+ (summer saved-args))
+ 45)
+
+
+;;; and member/assoc
+ (test (let ((saved-args (make-vector 10)))
+ (member 'a '(0 1 2 3 4 5 6 7 8 9)
+ (lambda (a b)
+ (set! (saved-args b) (lambda () b))
+ #f))
+ (summer saved-args))
+ 45)
+
+ (test (let ((saved-args (make-vector 10)))
+ (assoc 'a '((0 b) (1 b) (2 b) (3 b) (4 b) (5 b) (6 b) (7 b) (8 b) (9 b))
+ (lambda (a b)
+ (set! (saved-args b) (lambda () b))
+ #f))
+ (summer saved-args))
+ 45)
+
+ (test (let ((saved-args (make-vector 10 #f)))
+ (sort! '(3 2 1 4 6 5 9 8 7 0)
+ (lambda (a b)
+ (if (not (saved-args b))
+ (set! (saved-args b) (lambda () b)))
+ (< a b)))
+ (summer saved-args))
+ 45)
+
+;;; and do which has never worked in this way
+#|
+ (test (let ((saved-args (make-vector 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (saved-args i) (lambda () i)))
+ (summer saved-args))
+ 45)
+|#
+ )
@@ -10933,12 +19480,12 @@ this prints:
(test (map (lambda (n) (expt n n)) '(1 2 3 4 5)) '(1 4 27 256 3125))
(test (map + '(1 2 3) '(4 5 6)) '(5 7 9))
-(test (apply vector (map (lambda (i) (* i i)) '(0 1 2 3 4))) '#(0 1 4 9 16))
-(map (lambda (x) (display "map should not have called this")) '())
+(test (apply vector (map (lambda (i) (* i i)) '(0 1 2 3 4))) #(0 1 4 9 16))
+(map (lambda (x) (display "map should not have called this")) ())
(test (let ((ctr 0)) (map (lambda (x y) (if (= x y) (set! ctr (+ ctr 1))) ctr) '(1 2 3 4 5 6) '(2 3 3 4 7 6))) (list 0 0 1 2 2 3))
(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(0 1) '(2 3) '(4 5))) (list 6 15))
(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) '(5))) (list 9))
-(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '() '() '())) '())
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) () () ())) ())
(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2)) (list 2 4))
(test (map abs '(1 -2)) (list 1 2))
(test (map + '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) (list 24 24 24))
@@ -10949,7 +19496,7 @@ this prints:
(test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2) '(3 4 5)) '(3 5 7))
(test (map (lambda args args) '(1 2 3)) '((1) (2) (3)))
(test (map + () ()) ())
-(test (map + (#(#() #()) 1)) '())
+(test (map + (#(#() #()) 1)) ())
(test (map + #(1) #(1) #(1)) '(3))
(test (map list '(a b c)) '((a) (b) (c)))
(test (map (lambda (a b) (- a b)) (list 1 2) (vector 3 4)) '(-2 -2))
@@ -10957,6 +19504,15 @@ this prints:
(test (map vector (memv 1 (list 1 2 3))) '(#(1) #(2) #(3)))
(test (map append #(1 2 3)) '(1 2 3))
(test (map eval '((+ 1 2) (* 3 4))) '(3 12))
+(test (map (map + (list 1 2 3)) (list 0 1 2)) '(1 2 3))
+(test (let ((a #t) (b #f) (c #t)) (map when '(a b c) '(12 32 0))) '(12 #<unspecified> 0))
+(test (let ((a #t) (b #f)) (map if '(a b) '(1 2) '(3 4))) '(1 4))
+(test (let ((a #t) (b #f)) (map unless '(a b) '(1 2))) '(#<unspecified> 2))
+(test (let ((a #t) (b #f)) (list (map set! '(a b) '(1 2)) a b)) '((1 2) 1 2))
+(test (let ((a #t) (b #f)) (map begin '(a b))) '(#t #f))
+(test (let () (map apply (map lambda '(a b) '((car a) (car b))) '((2) (3)))) '(2 3))
+(test (let () (map apply (map lambda* '(((a 1)) ((b 2))) '(a b)) '((3) ()))) '(3 2))
+(test (map + '(1 2 3) '(4 5 6) '(7 8 9)) '(12 15 18))
(test (let* ((x (list (list 1 2 3))) (y (apply map abs x))) (list x y)) '(((1 2 3)) (1 2 3)))
(test (let* ((x (quote ((1 2) (3 4)))) (y (apply map ash x))) (list x y)) '(((1 2) (3 4)) (8 32)))
@@ -10965,6 +19521,11 @@ this prints:
(test (apply map * (apply map + '(1 2 3) '((4 5 6))) '((1 2 3))) '(5 14 27))
(test (let* ((x (lambda () '(1 2 3))) (y (apply map - (list (x))))) (x)) '(1 2 3))
+;(test (map car (list (list 0) (list (values)) (list 2))) (map (lambda (x) (car x)) (list (list 0) (list (values)) (list 2))))
+(test (apply append (map list '((a . 1) (b . 2) #<eof>))) '((a . 1) (b . 2) #<eof>))
+(test (apply append (map list '(a b #<eof> d))) '(a b #<eof> d))
+(test (map values (vector 1 2 #<eof> 3)) '(1 2 #<eof> 3))
+
(test (let ((d 0))
(map (let ((a 0))
(map (lambda (b) (set! a (+ a b))) (list 1 2))
@@ -11002,7 +19563,7 @@ this prints:
(test (let ((ctr 0)
(cont #f)
- (lst '()))
+ (lst ()))
(let ((val (call/cc
(lambda (exit)
(map (lambda (a)
@@ -11047,14 +19608,35 @@ this prints:
(test (procedure? (car (map lambda '(()) '((1))))) #t)
(test (procedure? (car (map lambda '((x)) '(((+ x 1)))))) #t)
(test (map #(0 1 2) #(2 1 0)) '(2 1 0))
-(test (map quasiquote '((quasiquote 1) (quasiquote 2))) '(1 2))
+;(test (map quasiquote '((quasiquote 1) (quasiquote 2))) '(1 2)) -- this has changed (12-May-14)
(test (map (lambda (a b) (a b)) (map lambda '((x) (y) (z)) '((+ x x) (* y y) (expt z z))) (list 1 2 3)) '(2 4 27))
(test (map apply (map lambda '((x) (y) (z)) '((+ x x) (* y y) (expt z z))) '((1) (2) (3))) '(2 4 27))
+(test (let () (define (add-some x) (define (add-some x) (+ x 2)) (+ x 1)) (map add-some '(1 2 3 4))) '(2 3 4 5)) ; from some CL website -- kinda ridiculous
+(test (map gcd #(1 2)) '(1 2))
+(test (apply vector (map values #(1 2) #(3 4))) #(1 3 2 4))
+(test (map values '(1 2 3) '(4 5 6) '(7 8 9)) '(1 4 7 2 5 8 3 6 9))
+(test (map eval (list (+ 1 2) (+ 3 4))) '(3 7))
+(test (map apply (list + - * /) (list 1 2 3 4) '((5) (6) (7) (8))) '(6 -4 21 1/2))
+
+;;; (let ((val ())) (list (map (lambda a (set! val (cons a val)) a) '(1 2 3)) val)) -> ((#3=(1) #2=(2) #1=(3)) (#1# #2# #3#))
+(test (map if '(#f #f #t) '(0 1 2) '(3 4 5)) '(3 4 2))
+(test (map apply (map lambda '(() (a) (a b)) '(1 (+ a 1) (+ a b 1))) '(() (2) (3 4))) '(1 3 8))
+(test (map values (list 1 2 3) (list 4 5 6)) '(1 4 2 5 3 6))
+(test (map map (list values) '((1 2)) '((3 4))) '((1 3 2 4)))
+(test (map values '((1 2)) '((3 4))) '((1 2) (3 4)))
+(test (map map (list map) (list (list values)) '(((1 2))) '(((3 4)))) '(((1 3 2 4))))
+(test (map apply (list values) '(((1 2))) '(((3 4)))) (apply map values '(((1 2))) '(((3 4))))) ; !
+(test (let ((x '((1 2)))) (eval `(apply apply values x)) (object->string x)) "((1 2))") ; not "((values 1 2))" -- 24-Aug-12
+(test (map (lambda (x) x) #u8(255)) (list 255))
-#|
-(let ((val '())) (list (map (lambda a (set! val (cons a val)) a) '(1 2 3)) val))
-((#3=(1) #2=(2) #1=(3)) (#1# #2# #3#))
-|#
+(let ()
+ (define (shuffle . args)
+ (apply map values args))
+ (test (shuffle '(1 2 3) #(4 5 6) '(7 8 9)) '(1 4 7 2 5 8 3 6 9))
+ (test (shuffle '(1 2 3)) '(1 2 3))
+ (test (shuffle '(1 2 3) '(4)) '(1 4))
+ (test (shuffle '(1 2 3) ()) ())
+ )
(test (map list "hi") '((#\h) (#\i)))
(test (map string "hi") '("h" "i"))
@@ -11062,14 +19644,13 @@ this prints:
(test (map char-upcase "hi") '(#\H #\I))
(test (map append #(#() #())) '(#() #()))
-(test (map abs '() abs) 'error)
+(test (map abs () abs) 'error)
(test (map (lambda (x) (display "map should not have called this"))) 'error)
-(test (map (lambda () 1) '()) '())
-(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) '())) '())
+(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) ())) ())
(test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6))) '(6 15))
(test (map (lambda (a b) (+ a b)) (list 1)) 'error)
-(test (map (lambda (a b) (+ a b)) (list 1) (list)) '())
+(test (map (lambda (a b) (+ a b)) (list 1) (list)) ())
(test (map (lambda (a b) (+ a b)) (list 1) (list 2)) (list 3))
(test (map (lambda (a b) (+ a b)) (list 1)) 'error)
(test (map (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error)
@@ -11077,10 +19658,29 @@ this prints:
(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) '(2))
(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) '(2 4))
(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) '(2))
-(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) '())
+(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) 'error) ; ()
(test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error)
(test (map (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) '(2))
+(test (map (lambda* (x . args) args) '(1 2 3)) '(() () ()))
+(test (map (lambda (x . args) args) '(1 2 3)) '(() () ()))
+(test (map (lambda* (x . args) (list x args)) '(1 2 3)) '((1 ()) (2 ()) (3 ())))
+(test (map (lambda (x . args) (list x args)) '(1 2 3)) '((1 ()) (2 ()) (3 ())))
+(test (map (lambda args args) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda* args args) '(1 2 3)) '((1) (2) (3)))
+(test (map (lambda (x y . args) args) '(1 2 3)) 'error)
+(test (map (lambda* (x y . args) args) '(1 2 3)) '(() () ())) ; all args are optional in lambda*
+(test (map (lambda (x y . args) args) '(1 2 3) '(4 5 6)) '(() () ()))
+(test (map (lambda* (x y . args) args) '(1 2 3) '(4 5 6)) '(() () ()))
+(test (map (lambda (x y . args) (list x y args)) '(1 2 3) '(4 5 6)) '((1 4 ()) (2 5 ()) (3 6 ())))
+(test (map (lambda* (x y . args) (list x y args)) '(1 2 3) '(4 5 6)) '((1 4 ()) (2 5 ()) (3 6 ())))
+(test (map (lambda (x y . args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9))))
+(test (map (lambda* (x y . args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9))))
+(test (map (lambda* (x y :rest args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9))))
+
+(test (map (lambda . (x y z 8)) '(1 2 3)) 'error) ; (y unbound) but other schemes ignore unused args
+(test (map (lambda . (x 8)) '(1 2)) '(8 8))
+
(test (map (lambda (a) (+ a 1)) (list 1) (list 2)) 'error)
(test (map (lambda (a) (+ a 1)) #\a) 'error)
(test (map (lambda (a) (+ a 1)) (cons 1 2)) '(2))
@@ -11097,9 +19697,20 @@ this prints:
(test (apply apply map ((lambda () abs)) (list (list (list -1 -2 -3)))) '(1 2 3))
(test (apply apply apply map ((lambda () abs)) '((((-1 -2 -3))))) '(1 2 3))
(test (apply apply apply (list (list map abs (list (list -1 -2 -3))))) '(1 2 3))
+(test (apply apply list 1 '((1 2) (3 4))) '(1 (1 2) 3 4))
(test (apply + (apply apply apply (list (list map abs (list (list -1 -2 -3)))))) 6)
+(test (apply (apply apply lambda '(a) '(((+ a 1)))) '(14)) 15)
+(test (let ((a 14)) (apply apply quasiquote '(((+ ,a 1))))) '(+ 14 1))
(test (apply map vector (values (list (vector 1 2)))) '(#(1) #(2)))
(test (apply map string (list "123")) '("1" "2" "3"))
+(test (apply map string '("123" "456")) '("14" "25" "36"))
+(test (apply map list '((1 2) (3 4))) '((1 3) (2 4))) ; matrix transpose
+
+;;; Is <code>(apply apply func arglist)</code> the same as <code>(apply func (apply values arglist))</code>,
+;;; or (leaving aside <code>'(()))</code>, <code>(func (apply values (apply values arglist)))</code>?
+(test (apply apply + '((1 2 3))) (apply + (apply values '((1 2 3)))))
+(test (apply apply + '((1 2 3))) (+ (apply values (apply values '((1 2 3))))))
+
(test (map string "123") '("1" "2" "3"))
(test (map "hi" '(0 1)) '(#\h #\i))
(test (map (list 2 3) '(0 1)) '(2 3))
@@ -11117,6 +19728,15 @@ this prints:
(test (map (lambda (a) a) arg) 'error))
(list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+(let ()
+ (define (concatenate . args)
+ (apply append (map (lambda (arg) (map values arg)) args)))
+ (test (concatenate "hi" #(#\h #\o)) '(#\h #\i #\h #\o))
+ (test (let ((lst (concatenate '(1 2) (let ((a 2) (b 3)) (curlet)) (hash-table* 'c 4))))
+ (or (equal? lst '(1 2 (b . 3) (a . 2) (c . 4)))
+ (equal? lst '(1 2 (a . 2) (b . 3) (c . 4)))))
+ #t))
+
(test (map (lambda (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
(max a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
(list 6 7 8 9 10)
@@ -11131,6 +19751,48 @@ this prints:
(list 31 32 33 34 35))
(list 46 47 48 49 50))
+(test (map (lambda (a1 a2 a3 a4 a5 a6 a7 a8 a9 . a10)
+ (apply max a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
+ (list 6 7 8 9 10)
+ (list 21 22 23 24 25)
+ (list 16 17 18 19 20)
+ (list 11 12 13 14 15)
+ (list 26 27 28 29 30)
+ (list 1 2 3 4 5)
+ (list 36 37 38 39 40)
+ (list 41 42 43 44 45)
+ (list 46 47 48 49 50)
+ (list 31 32 33 34 35))
+ (list 46 47 48 49 50))
+
+(test (map (lambda* (a1 a2 a3 . a10)
+ (apply max a1 a2 a3 a10))
+ (list 6 7 8 9 10)
+ (list 21 22 23 24 25)
+ (list 16 17 18 19 20)
+ (list 11 12 13 14 15)
+ (list 26 27 28 29 30)
+ (list 1 2 3 4 5)
+ (list 36 37 38 39 40)
+ (list 41 42 43 44 45)
+ (list 46 47 48 49 50)
+ (list 31 32 33 34 35))
+ (list 46 47 48 49 50))
+
+(test (map (lambda args
+ (apply max args))
+ (list 6 7 8 9 10)
+ (list 21 22 23 24 25)
+ (list 16 17 18 19 20)
+ (list 11 12 13 14 15)
+ (list 26 27 28 29 30)
+ (list 1 2 3 4 5)
+ (list 36 37 38 39 40)
+ (list 41 42 43 44 45)
+ (list 46 47 48 49 50)
+ (list 31 32 33 34 35))
+ (list 46 47 48 49 50))
+
(test (map map (list abs) (list (list -1))) '((1)))
(test (map map (list map) (list (list abs)) (list (list (list -1)))) '(((1))))
(test (map map (list map) (list (list map)) (list (list (list abs))) (list (list (list (list -1 -3))))) '((((1 3)))))
@@ -11162,29 +19824,32 @@ this prints:
;; from scheme working group
(test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! (cddr L) 5) x) L)) '(1 2 3))
-(test (let ((L (list 1 2))) (map (lambda (x) (set! (cdr (cdr L)) L) x) L)) '(1 2))
+(test (let ((L (list 1 2))) (map (lambda (x) (set! (cdr (cdr L)) L) x) L)) '(1)) ;'(1 2)
(test (let ((L (list 1 2))) (object->string (map (lambda (x) (set! (car (cdr L)) L) x) L))) "(1 #1=(1 #1#))")
;;;(test (let ((L (list 1 2))) (map (lambda (x) (set-cdr! L L) x) L)) '(1 2)) ;?? this depends on when we cdr? infinite loop in Guile
-;;;(let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! L '()) x) L)) ; another similar case -- s7 doesn't notice what happened
+;;;(let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! L ()) x) L)) ; another similar case -- s7 doesn't notice what happened
;;; does that mean a GC during this map would leave us accessing freed memory?
;;; I think not because the original list is held by map (eval) locals that are protected
;;; we simply stepped on something after looking at it, similar to:
(test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-car! L 123) x) L)) '(1 2 3 4 5))
-(test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! (cddr L) (list 6 7 8)) x) L)) '(1 2 3 6 7))
+(test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! (cddr L) (list 6 7 8)) x) L)) '(1 2 3 6 7 8))
;;; we could do something similar with strings:
(test (let ((S "12345")) (map (lambda (x) (set! (S 2) #\null) x) S)) '(#\1 #\2 #\null #\4 #\5))
;;; (length S) is still 5 even with the embedded null
(test (let ((L (list 1 2 3))) (map (lambda (x) (set! L (list 6 7 8)) x) L)) '(1 2 3))
-(test (let ((L1 (list 1 2 3)) (L2 (list 4 5 6 7))) (map (lambda (x1 x2) (set-cdr! (cdr L1) '()) (cons x1 x2)) L1 L2)) '((1 . 4) (2 . 5)))
+(test (let ((L1 (list 1 2 3)) (L2 (list 4 5 6 7))) (map (lambda (x1 x2) (set-cdr! (cdr L1) ()) (cons x1 x2)) L1 L2)) '((1 . 4) (2 . 5)))
(test (let ((L (list 1 2 3))) (map (lambda (x) (set-car! (cddr L) 32) x) L)) '(1 2 32))
;;; should these notice the increased length?:
-(test (let ((L1 (list 1 2)) (L2 (list 6 7 8 9))) (map (lambda (x y) (set-cdr! (cdr L1) (list 10 11 12 13 14)) (cons x y)) L1 L2)) '((1 . 6) (2 . 7)))
+(test (let ((L1 (list 1 2)) (L2 (list 6 7 8 9))) (map (lambda (x y) (set-cdr! (cdr L1) (list 10 11 12 13 14)) (cons x y)) L1 L2)) '((1 . 6) (2 . 7) (10 . 8) (11 . 9)))
(test (let ((L1 (list 1)) (L2 (list 6 7 8))) (map (lambda (x y) (set-cdr! L1 (list 10 11 12)) (cons x y)) L1 L2)) '((1 . 6)))
-(test (let ((L1 (list 1 2))) (map (lambda (x) (set-cdr! (cdr L1) (list 10 11 12)) x) L1)) '(1 2))
+(test (let ((L1 (list 1 2))) (map (lambda (x) (set-cdr! (cdr L1) (list 10 11 12)) x) L1)) '(1 2 10 11 12))
;;; a similar case could be made from hash-tables
-(test (let ((H (hash-table '(a . 3) '(b . 4)))) (map (lambda (x) (set! (H 'c) 32) (cdr x)) H)) '(3 4))
-(test (let ((H (hash-table '(a . 3) '(b . 4)))) (map (lambda (x) (set! (H 'b) 32) (cdr x)) H)) '(3 32))
-
+(test (let ((H (hash-table '(a . 3) '(b . 4)))) (pair? (map (lambda (x) (set! (H 'c) 32) (cdr x)) H))) #t)
+(test (let ((H (hash-table '(a . 3) '(b . 4))))
+ (let ((L (map (lambda (x) (set! (H 'b) 32) (cdr x)) H)))
+ (or (equal? L '(3 32))
+ (equal? L '(4 3)))))
+ #t)
;; in that 1st example, the set-cdr! is not the problem (map supposedly can treat its args in any order),
;; any set! will do:
(test (let ((x 0)) (map (lambda (y) (set! x (+ x y)) x) '(1 2 3 4))) '(1 3 6 10))
@@ -11195,58 +19860,67 @@ this prints:
(test ((cadr funcs) 2) 3))
(test (map = #() =) 'error)
-(test (map ="") '())
+(test (map ="") 'error)
(test (map abs ()) ())
(test (map abs "") ())
-(test (map abs "123" "") ()) ; should this be an error -- arity is wrong?
+(test (map abs "123" "") 'error)
(test (map abs "123" "" #f) 'error)
-(test (map null? () #() "") ())
+(test (map null? () #() "") 'error)
(test (map null? () #() 0 "") 'error)
-(test (map '(()) #()) '())
+(test (map '(()) #()) ())
(test (map '(1 2 . 3) '(1 . 2)) '(2))
-(test (map '(()) '()) '())
+(test (map '(()) ()) ())
(test (map #2D((1 2) (3 4)) '(1)) '(#(3 4)))
(test (map "a\x00b" #(1 2)) '(#\null #\b))
(test (map #(1 (3)) '(1)) '((3)))
(test (map '((1 (2)) (((3) 4))) '(1)) '((((3) 4))))
(test (map "hi" '(1)) '(#\i))
-(test (map #() #()) '())
-(test (map '(1 . 2) #()) '())
+(test (map #() #()) 'error)
+(test (map '(1 . 2) #()) ())
(test (map ''2 '(1)) '(2))
(test (((map lambda '((x)) '(1 2 . 3)) 0) 0) 1)
(test (((map lambda '(()) #(1 2)) 0)) 1)
(test (((map lambda '((x)) '((+ x 1))) 0) 32) 33)
-(test (map #() '()) '()) ; hmmm -- (map '() '()) is an error
-(test (map "" "") '())
+(test (map #() ()) 'error)
+(test (map () ()) 'error)
+(test (map "" "") 'error)
(test (map (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) lst) '(0)) '(1))
-(let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map lst lst) 'error))
-(test (map 1 "hi" '()) 'error)
-(test (map 0 #() '()) 'error)
+(let ((lst (list 1 2)) (os (*s7* 'safety))) (set! (*s7* 'safety) 1) (set! (cdr (cdr lst)) lst) (test (map lst lst) '(2)) (set! (*s7* 'safety) os))
+(test (map 1 "hi" ()) 'error)
+(test (map 0 #() ()) 'error)
(test (map #\a #(1 2) '(3 4) "") 'error)
(test (map or '(1 2 . 3)) '(1 2))
(test (map or "a\x00b") '(#\a #\null #\b))
(test (map cond '((1 2) (3 4))) '(2 4)) ; (cond (1 2)) -> 2
(test (map begin "hi") '(#\h #\i))
(test (map quote "hi") '(#\h #\i))
+(test (map quote '(a b c)) '(a b c)) ; when are (map quote ...) and (map values ...) different?
(test (map (begin #(1 (3))) '(1)) '((3)))
-(test (map (''2 0) ''2) ''2) ; (''2 0) -> quote
+(test (map (''2 0) ''2) 'error)
(test (map (apply lambda 'a '(-1)) '((1 2))) '(-1))
-(test (map do '(()) '((1 2))) '(2))
+(test (map (apply lambda 'a '(-1)) '(1 2)) '(-1 -1))
+(test (map do '(()) '((1 2))) '(2)) ; (list 2) because it's map, not just do
(test (map case '(1) '(((-1 1) 2) 3)) '(2))
(test (map let '(()) "a\x00b") '(#\a))
(test (map "hi" '(0 1) '(0 1)) 'error)
(test (map '((1 2) (3 4)) '(0 1) '(0 1)) '(1 4))
(test (map #2d((1 2) (3 4)) '(0 1) '(0 1)) '(1 4))
(test (map #2d((1 2) (3 4)) '(0 1)) '(#(1 2) #(3 4)))
-(let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst) 'error))
-(let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst lst) 'error))
+(let ((os (*s7* 'safety)))
+ (set! (*s7* 'safety) 1)
+ (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst) '(1)))
+ (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst lst) 'error))
+ (set! (*s7* 'safety) os))
(test (map "hi" ('((1)) 0)) '(#\i))
(test (map "hi" ('((1 0)) 0)) '(#\i #\h))
(test (let ((ht (hash-table '(a . 1) '(b . 2)))) (map ht ht)) '(#f #f))
(test (let ((ht (hash-table '(a . 1) '(b . 2)))) (let ((lst (map (lambda (c) (cdr c)) ht))) (or (equal? lst '(1 2)) (equal? lst '(2 1))))) #t)
(test (let ((ht (hash-table '(a . 1) '(b . 2)))) (map ht '(a b))) '(1 2))
-(let ((pws (make-procedure-with-setter (lambda (a) a) (lambda (a b) b))))
+(test (map '((1 2) (3 4)) #(1) #(1)) '(4))
+(test (map (quasiquote ((1 2) (3 4))) #(1) #(1 2)) '(4))
+
+(let ((pws (dilambda (lambda (a) a) (lambda (a b) b))))
(test (map append pws) 'error)
(test (map pws '(1 2 3)) '(1 2 3)))
@@ -11257,39 +19931,19 @@ this prints:
(test (map abs '(1 . "hi")) '(1))
(test (map floor '(1 . "hi")) '(1))
-(let ((ctr ((cadr (make-type :getter (lambda (a b) b) :length (lambda (a) (- (expt 2 31) 1))))))
- (sum 0))
- (test (call-with-exit
- (lambda (go)
- (map (lambda (a)
- (set! sum (+ sum a))
- (if (> sum 100)
- (go sum))
- sum)
- ctr)))
- 105))
-
-(let ((ctr ((cadr (make-type :getter (lambda (a b) (+ b 1))
- :length (lambda (a) 'hi))))))
- (test (map (lambda (x) x) ctr) 'error))
-
-(let ((ctr ((cadr (make-type :getter (lambda (a b) (car b))
- :length (lambda (a) 4))))))
- (test (map (lambda (x) x) ctr) 'error))
-
(for-each
(lambda (op)
- (test (map op '()) 'error)
+ (test (map op ()) 'error)
(test (map op "") 'error)
(test (map op #() (list) (string)) 'error))
- (list 0 '() #f #t 'a-symbol :hi #\a #<eof> #<unspecified> #<undefined> 0.0 1+i 1/2 1/0 0/0 *stdout* (current-input-port)))
+ (list 0 () #f #t 'a-symbol :hi #\a #<eof> #<unspecified> #<undefined> 0.0 1+i 1/2 1/0 0/0 *stdout* (current-input-port)))
-(test (map append (make-vector (list 2 0))) '())
-(let ((p1 (make-procedure-with-setter (lambda (a) (+ a 1)) (lambda (a b) (+ a b)))))
+(test (map append (make-vector (list 2 0))) ())
+(let ((p1 (dilambda (lambda (a) (+ a 1)) (lambda (a b) (+ a b)))))
(test (map p1 '(1 2 3)) '(2 3 4)))
(test (map (lambda args (+ (car args) 1)) '(1 2 3)) '(2 3 4))
(test (map (lambda* (a (b 2)) (+ a 1)) '(1 2 3)) '(2 3 4))
-(let ((p1 (make-procedure-with-setter (lambda (a b) (+ a b)) (lambda (a b c) (+ a b c)))))
+(let ((p1 (dilambda (lambda (a b) (+ a b)) (lambda (a b c) (+ a b c)))))
(test (map p1 '(1 2 3) '(3 2 1)) '(4 4 4)))
(test (map (lambda args (+ (car args) (cadr args))) '(1 2 3) '(3 2 1)) '(4 4 4))
(test (map (lambda* (a (b 2)) (+ a b)) '(1 2 3) '(3 2 1)) '(4 4 4))
@@ -11297,6 +19951,733 @@ this prints:
(test (map (lambda* ((a 1) (b (map (lambda (c) (+ c 1)) (list 1 2)))) (+ a (apply + b))) (list 4 5 6)) '(9 10 11))
(test (let ((lst (list 0 1 2))) (map (lambda* ((a 1) (b (for-each (lambda (c) (set! (lst c) (+ (lst c) 1))) (list 0 1 2)))) a) lst)) '(0 2 4))
+(test (let ((lst '(1 2 3))) (define-macro (hiho a) `(+ 1 ,a)) (map hiho lst)) '(2 3 4))
+(test (let ((lst '(1 2 3))) (define-bacro (hiho a) `(+ 1 ,a)) (map hiho lst)) '(2 3 4))
+(test (let ((lst '(1 2 3))) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst lst)) '(4 7 10))
+(test (let ((lst '(1 2 3))) (define-macro (hi1 a) `(+ 1 ,a)) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst (map hi1 lst))) '(6 9 12))
+(test (let ((lst '(1 2 3))) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst (map (define-macro (hi1 a) `(+ 1 ,a)) lst))) '(6 9 12))
+(test (let ((lst '(1 2 3))) (define-macro (hi a) `(+ 1 ,a)) (define-macro (ho b) `(+ 1 (hi ,b))) (map ho lst)) '(3 4 5))
+(test (let ((lst '(1 2 3))) (define-macro* (hi a (b 2)) `(+ 1 ,a (* 2 ,b))) (map hi lst)) '(6 7 8))
+(test (let ((lst '(1 2 3))) (define-macro* (hi a (b 2)) `(+ 1 ,a (* 2 ,b))) (map hi lst (map hi lst))) '(14 17 20))
+
+(let ()
+ (define (hi)
+ (map (lambda (a) (a 0))
+ (list (vector 1 2 3)
+ (string #\a #\b #\c)
+ (list 'e 'f 'g))))
+ (test (hi) '(1 #\a e)))
+
+(let ((ctr -1))
+ (apply begin (map (lambda (symbol)
+ (set! ctr (+ ctr 1))
+ (list 'define symbol ctr))
+ '(_zero_ _one_ _two_)))
+ (+ _zero_ _one_ _two_))
+
+(let ()
+ (define (map-with-exit func . args)
+ ;; func takes escape thunk, then args
+ (let* ((result ())
+ (escape-tag (gensym))
+ (escape (lambda () (throw escape-tag))))
+ (catch escape-tag
+ (lambda ()
+ (let ((len (apply max (map length args))))
+ (do ((ctr 0 (+ ctr 1)))
+ ((= ctr len) (reverse result)) ; return the full result if no throw
+ (let ((val (apply func escape (map (lambda (x) (x ctr)) args))))
+ (set! result (cons val result))))))
+ (lambda args
+ (reverse result))))) ; if we catch escape-tag, return the partial result
+
+ (define (truncate-if func lst)
+ (map-with-exit (lambda (escape x) (if (func x) (escape) x)) lst))
+
+ (test (truncate-if even? #(1 3 5 -1 4 6 7 8)) '(1 3 5 -1))
+ (test (truncate-if negative? (truncate-if even? #(1 3 5 -1 4 6 7 8))) '(1 3 5))
+ )
+
+;;; this is testing the one-liner unsafe closure optimizations
+(test (let ()
+ (define (fib n)
+ (if (< n 2)
+ n
+ (+ (fib (- n 1))
+ (fib (- n 2)))))
+ (let ((x 0)
+ (ctr -1))
+ (map
+ (lambda (f)
+ (let ((z 1))
+ (set! ctr (+ ctr 1))
+ (case ctr
+ ((0 1 2 3) (f z))
+ ((4 5) (f z z))
+ ((6 7) (values (f (+ 1)) (f (+ 2)))))))
+ (list
+ (lambda (i)
+ (set! x (list i)))
+ (lambda (i)
+ (set! x (list i))
+ (set! x (list (+ i 1))))
+ (vector 1 2 3)
+ (list 3 2 1)
+ (lambda (a b)
+ (+ a b))
+ (lambda (a b)
+ (+ a b)
+ (+ a b a))
+ (lambda (a)
+ (if (< a 2) a (+ (fib (- a 1)) (fib (- a 2)))))
+ (lambda (a)
+ (if (zero? a) a (list a))
+ (list (+ a 10)))
+ ))))
+ '((1) (2) 2 2 2 3 1 1 (11) (12)))
+;;; more along the same lines
+(test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a)) (f1 12)) -12)
+(test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a 1)) (define (f2 a b) (- a b)) (f1 12)) 11)
+(test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a 1)) (f1 12)) 11)
+
+(test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define* (f2 a) (- a)) (f1 12)) -12)
+(test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a 1)) (define* (f2 a b) (- a b)) (f1 12)) 11)
+(test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define* (f2 a) (- a 1)) (f1 12)) 11)
+
+(test (map symbol->value (let ((lst (list 'integer? 'boolean?))) (set-cdr! (cdr lst) lst) lst)) (list integer?))
+;;; I think this depends on when the list iterator notices the cycle
+
+
+#|
+;;; this is from the r6rs comment site
+(let ((resume #f)
+ (results ()))
+ (set! results
+ (cons (map (lambda (x)
+ (call/cc (lambda (k)
+ (if (not resume) (set! resume k))
+ 0)))
+ '(#f #f))
+ results ))
+ (display results) (newline)
+ (if resume
+ (let ((resume* resume))
+ (set! resume #f)
+ (resume* 1))))
+
+With a careful implementation of MAP, a new list is returned every
+time, so that the displayed results are
+
+ ((0 0))
+ ((1 0) (0 0))
+ ((1 1) (1 0) (0 0))
+
+in s7:
+((0 0))
+((1 0) (0 0))
+((0 . #1=(1 1)) #1# (0 0))
+
+|#
+
+;; from Doug Hoyte, Let Over Lambda
+(let ()
+ (define (batcher n)
+ (let* ((network ())
+ (tee (ceiling (log n 2)))
+ (p (ash 1 (- tee 1))))
+ (do ()
+ ((= p 0) (reverse network))
+ (let ((q (ash 1 (- tee 1)))
+ (r 0)
+ (d p))
+ (do ()
+ ((= d 0))
+ (do ((i 0 (+ i 1)))
+ ((= i (- n d)))
+ (if (= (logand i p) r)
+ (set! network (cons (list i (+ i d)) network))))
+ (set! d (- q p))
+ (set! q (ash q -1))
+ (set! r p)))
+ (set! p (ash p -1)))))
+
+ (define-macro (sortf comparator . places)
+ (let ((tmp (gensym))
+ (net (batcher (length places))))
+ `(begin
+ ,@(map (lambda (a b)
+ `(if (,comparator ,a ,b) ; we're ignoring the fancy CL getf|setf business
+ (let ((,tmp ,a)) ; I suppose if it's a list, get procedure-setter?
+ (set! ,a ,b)
+ (set! ,b ,tmp))))
+ (map (lambda (ab) (places (car ab))) net)
+ (map (lambda (ab) (places (cadr ab))) net)))))
+
+ (test (let ((a 1) (b 3) (c 0))
+ (sortf > a b c)
+ (list a b c))
+ '(0 1 3))
+ (test (let ((a 1) (b 3) (c 0))
+ (sortf < a b c)
+ (list a b c))
+ '(3 1 0))
+ (test (let ((v #(1 3 2)))
+ (sortf > (v 0) (v 1) (v 2))
+ v)
+ #(1 2 3)))
+
+;;; fftf?
+
+(let ()
+ (define-macro (shiftf . places)
+ (let ((tmp (gensym)))
+ `(let ((,tmp ,(car places)))
+ ,@(map (lambda (a b)
+ `(set! ,a ,b))
+ places
+ (cdr places))
+ ,tmp)))
+
+ (define-macro (rotatef . places)
+ (let ((tmp (gensym))
+ (last (car (list-tail places (- (length places) 1)))))
+ `(let ((,tmp ,(car places)))
+ ,@(map (lambda (a b)
+ `(set! ,a ,b))
+ places
+ (cdr places))
+ (set! ,last ,tmp))))
+
+ (test (let ((a 1) (b 2) (c 3))
+ (rotatef a b c)
+ (list a b c))
+ '(2 3 1))
+ (test (let ((a 1) (b 2) (c 3))
+ (rotatef a b c)
+ (rotatef a b c)
+ (list a b c))
+ '(3 1 2))
+ (test (let ((v #(1 3 2)))
+ (rotatef (v 0) (v 1) (v 2))
+ v)
+ #(3 2 1))
+
+ (test (let ((a 1) (b 2) (c 3))
+ (let ((d (shiftf a b c (+ 3 2))))
+ (list a b c d)))
+ '(2 3 5 1))
+
+ (test (let ((a 1) (b 2) (c 3))
+ (let ((d (shiftf a b c (shiftf a b c))))
+ (list a b c d)))
+ '(3 3 2 1))
+ ;; this expands to:
+ ;; (let ((a 1) (b 2) (c 3))
+ ;; (let (({gensym}-22 a))
+ ;; (set! a b)
+ ;; (set! b c)
+ ;; (set! c (let (({gensym}-23 a))
+ ;; (set! a b)
+ ;; (set! b c)
+ ;; (set! c (* 2 3))
+ ;; {gensym}-23))
+ ;; (list a b c {gensym}-22)))
+
+ (test (let ((v #(1 3 2)))
+ (let ((d (shiftf (v 0) (v 1) (v 2) (* 4 3))))
+ (list d v)))
+ '(1 #(3 2 12))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; iterate
+;;; make-iterator
+;;; iterator?
+;;; iterator-sequence
+;;; iterator-at-end?
+;;; --------------------------------------------------------------------------------
+
+(test (iterate) 'error)
+(test (iterator?) 'error)
+(test (iterator-sequence) 'error)
+(test (iterator-at-end?) 'error)
+(test (make-iterator) 'error)
+(test (make-iterator "hi" "ho") 'error)
+(test (iterator? "hi" "ho") 'error)
+(test (iterator-sequence "hi" "ho") 'error)
+(test (iterator-at-end? "hi" "ho") 'error)
+(test (iterate "hi" "ho") 'error)
+
+(for-each
+ (lambda (arg)
+ (if (iterator? arg)
+ (format-logged #t ";~A: (iterator? ~A) -> #t?~%" (port-line-number) arg)))
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (iterate arg) 'error)
+ (test (iterator-sequence arg) 'error)
+ (test (iterate-at-end? arg) 'error))
+ (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (make-iterator arg) 'error)
+ (test (make-iterator #(1 2) arg) 'error))
+ (list 1 'a-symbol quasiquote macroexpand 3.14 3/4 1.0+1.0i #\f :hi (if #f #f) #<eof> #<undefined>))
+
+(let ((str "12345"))
+ (let ((s1 (make-iterator str)))
+ (test (iterator? s1) #t)
+ (test (iterator? str) #f)
+ (test (make-iterator s1) 'error)
+ (test (iterator-sequence s1) str)
+ (test (iterator-at-end? s1) #f)
+ (test (iterate s1) #\1)
+ (test (iterate s1 s1) 'error)
+ (test (object->string s1) "#<iterator: string>")
+ (test (s1) #\2)
+ (test (list (s1) (s1) (s1)) (list #\3 #\4 #\5))
+ (test (s1) #<eof>)
+ (test (iterator-at-end? s1) #t)
+ (let ((s2 (copy s1)))
+ (test (equal? s1 s2) #t)
+ (test (morally-equal? s1 s2) #t)
+ (test (eq? s1 s2) #f)
+ (test (eqv? s1 s2) #f))))
+
+(let ((str ""))
+ (let ((s1 (make-iterator str)))
+ (let ((s2 (copy s1)))
+ (test (equal? s1 s2) #t)
+ (test (iterator? s1) #t)
+ (test (iterator-sequence s1) str)
+ (test (s1) #<eof>)
+ (test (iterator-at-end? s1) #t)
+ (test (iterator? s1) #t))))
+
+(let ((s1 (make-iterator "1234")))
+ (test (iterator? s1) #t)
+ (test (s1) #\1))
+
+(let ((str (vector #\1 #\2 #\3 #\4 #\5)))
+ (let ((s1 (make-iterator str)))
+ (let ((s2 (copy s1)))
+ (test (equal? s1 s2) #t)
+ (test (iterator? s1) #t)
+ (test (iterator? str) #f)
+ (test (make-iterator s1) 'error)
+ (test (iterator-sequence s1) str)
+ (test (iterate s1) #\1)
+ (test (object->string s1) "#<iterator: vector>")
+ (test (equal? s1 s2) #f)
+ (s2)
+ (test (equal? s1 s2) #t)
+ (test (iterate s1 s1) 'error)
+ (test (s1) #\2)
+ (test (list (s1) (s1) (s1)) (list #\3 #\4 #\5))
+ (test (s1) #<eof>))))
+
+(let ((str #()))
+ (let ((s1 (make-iterator str)))
+ (test (iterator? s1) #t)
+ (test (iterator-sequence s1) str)
+ (test (s1) #<eof>)
+ (test (iterator-at-end? s1) #t)
+ (test (iterator? s1) #t)))
+
+(let ((str #2d((1 2) (3 4))))
+ (let ((s1 (make-iterator str)))
+ (test (iterator-at-end? s1) #f)
+ (test (s1) 1)
+ (test (iterate s1) 2)
+ (test (s1) 3)))
+
+
+(let ((str (float-vector 1.0 2.0 3.0 4.0)))
+ (let ((s1 (make-iterator str)))
+ (test (iterator? s1) #t)
+ (test (iterator? str) #f)
+ (test (iterator-sequence s1) str)
+ (test (iterate s1) 1.0)
+ (test (s1) 2.0)
+ (test (list (s1) (s1)) (list 3.0 4.0))
+ (test (s1) #<eof>)))
+
+(let ((str (float-vector)))
+ (let ((s1 (make-iterator str)))
+ (test (iterator? s1) #t)
+ (test (iterator-sequence s1) str)
+ (test (s1) #<eof>)
+ (test (iterator-at-end? s1) #t)
+ (test (iterator? s1) #t)))
+
+
+(let ((str (make-vector 4 0 #t)))
+ (do ((i 1 (+ i 1))) ((= i 4)) (set! (str i) i))
+ (let ((s1 (make-iterator str)))
+ (test (iterator? s1) #t)
+ (test (iterator-sequence s1) str)
+ (test (iterate s1) 0)
+ (test (s1) 1)
+ (test (list (s1) (s1) (s1)) (list 2 3 #<eof>))
+ (test (s1) #<eof>)))
+
+
+(let ((str (list 0 1 2 3)))
+ (let ((s1 (make-iterator str)))
+ (test (iterator? s1) #t)
+ (test (iterator-sequence s1) str)
+ (test (iterate s1) 0)
+ (test (s1) 1)
+ (test (s1 0) 'error)
+ (test (iterate s1 0) 'error)
+ (test (list (s1) (s1) (s1)) (list 2 3 #<eof>))
+ (test (s1) #<eof>)))
+
+(let ((str ()))
+ (test (make-iterator str) 'error))
+
+(let ((str '((1 2) (3 4))))
+ (let ((s1 (make-iterator str)))
+ (test (s1) '(1 2))
+ (test (iterate s1) '(3 4))
+ (test (s1) #<eof>)))
+
+(let ((str (list 0 1)))
+ (set! (cdr (cdr str)) str)
+ (let ((s1 (make-iterator str)))
+ (test (iterator? s1) #t)
+ (test (iterator-sequence s1) str)
+ (test (iterate s1) 0)
+ (test (s1) 1)
+ (test (s1) #<eof>)))
+
+(let ((p (cons #f #f))
+ (h (hash-table* 'a 1 'b 2)))
+ (let ((iter (make-iterator h p)))
+ (let ((v (iter)))
+ (test (pair? v) #t)
+ (test (eq? v p) #t)
+ (test (pair? (memq (car v) '(a b))) #t)
+ (set! v (iter))
+ (test (pair? v) #t)
+ (test (eq? v p) #t)
+ (test (pair? (memq (car v) '(a b))) #t))))
+
+;; hash-table and let dealt with elsewhere
+
+(when with-block
+ (let ((b (block 0.0 1.0 2.0)))
+ (let ((b1 (make-iterator b)))
+ (test (iterator? b1) #t)
+ ;(test (iterator-sequence b1) b) ; this is now a function
+ (test (b1) 0.0)
+ (test (iterate b1) 1.0)
+ (test (list (b1) (b1)) '(2.0 #<eof>)))))
+
+(let ((c1 (let ((iterator? #t) (a 0)) (lambda () (set! a (+ a 1))))))
+ (let ((iter (make-iterator c1)))
+ (test (iterate iter) 1)
+ (test (iterator? c1) #t)
+ (test (iterator? iter) #t)
+ (test (eq? (iterator-sequence iter) c1) #t)))
+
+(let ()
+ (define c1 #f)
+ (let ((length (lambda (x) 3))
+ (iterator? #t)
+ (x 0))
+ (set! c1 (openlet (lambda () (let ((res (* x 2))) (set! x (+ x 1)) res)))))
+ (let ((c2 (make-iterator c1)))
+ (test (iterator? c2) #t)
+ (test (iterator-sequence c2) c1)
+ (test (c2) 0)
+ (test (c2) 2)
+ (test (c2) 4)))
+
+(let ((lst (list 1))) (set-cdr! lst lst) (let ((i (make-iterator lst))) (test (map values i) '(1))))
+(let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (let ((i (make-iterator lst))) (test (map values i) '(1 2))))
+(let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) (let ((i (make-iterator lst))) (test (> (length (map values i)) 2) #t))) ; '(1 2 3) ideally
+(let ((lst (list 1 2 3 4))) (set-cdr! (cdddr lst) lst) (let ((i (make-iterator lst))) (test (> (length (map values i)) 3) #t))) ; '(1 2 3 4)?
+
+(test (format #f "~{~{[~A ~A]~}~}"
+ (make-iterator
+ (let ((lst '((a . 1) (b . 2) (c . 2)))
+ (iterator? #t))
+ (lambda ()
+ (if (pair? lst)
+ (let ((res (list (caar lst) (cdar lst))))
+ (set! lst (cdr lst))
+ res)
+ #<eof>)))))
+ "[a 1][b 2][c 2]")
+
+(let ()
+ (define (make-diagonal-iterator matrix)
+ (if (or (= (length (vector-dimensions matrix)) 1)
+ (< (length matrix) 2))
+ (make-iterator matrix)
+ (make-iterator (let ((inds (length (vector-dimensions matrix)))
+ (len (apply min (vector-dimensions matrix))))
+ (let ((length (lambda (obj) len))
+ (iterator? #t)
+ (pos 0))
+ (openlet
+ (lambda ()
+ (if (>= pos len)
+ #<eof>
+ (let ((res (apply matrix (make-list inds pos))))
+ (set! pos (+ pos 1))
+ res)))))))))
+
+ (define v #2d((1 2 3 4) (5 6 7 8)))
+
+ (let ((iv (make-diagonal-iterator v)))
+ (let ((vals (map values iv)))
+ (test vals '(1 6)))))
+
+(test (let ((iter (make-iterator "123"))) (map values iter)) '(#\1 #\2 #\3))
+(test (let ((iter (make-iterator '(1 2 3))) (str "456") (vals ()))
+ (for-each (lambda (x y) (set! vals (cons (cons y x) vals))) iter str) vals)
+ '((#\6 . 3) (#\5 . 2) (#\4 . 1)))
+
+(let ()
+ (define* (make-full-let-iterator lt (stop (rootlet)))
+ (if (eq? stop lt)
+ (make-iterator #())
+ (let ((iter (make-iterator lt)))
+ (if (eq? stop (outlet lt))
+ iter
+ (letrec ((iterloop
+ (let ((iterator? #t))
+ (lambda ()
+ (let ((result (iter)))
+ (if (and (eof-object? result)
+ (iterator-at-end? iter))
+ (if (eq? stop (outlet (iterator-sequence iter)))
+ result
+ (begin
+ (set! iter (make-iterator (outlet (iterator-sequence iter))))
+ (iterloop)))
+ (if (not (char=? ((symbol->string (car result)) 0) #\_))
+ result
+ (iterloop))))))))
+ (make-iterator iterloop))))))
+ (let ((stop #f))
+ (set! stop (curlet))
+ (test (let ((a 1)) (map values (make-full-let-iterator (curlet) stop))) '((a . 1))))
+ (let ((stop #f))
+ (set! stop (curlet))
+ (test (let ((b 2)) (let ((a 1)) (map values (make-full-let-iterator (curlet) stop)))) '((a . 1) (b . 2))))
+ (let ((stop #f))
+ (set! stop (curlet))
+ (test (let ((b 2) (c 3)) (let () (let ((a 1)) (map values (make-full-let-iterator (curlet) stop))))) '((a . 1) (c . 3) (b . 2))))
+ )
+
+(let ()
+ (define (make-range lo hi)
+ (make-iterator
+ (let ((iterator? #t)
+ (now lo))
+ (lambda ()
+ (if (> now hi)
+ #<eof>
+ (let ((result now))
+ (set! now (+ now 1))
+ result))))))
+ (test (map values (make-range 4 8)) '(4 5 6 7 8)))
+
+(let ()
+ (define (make-input-iterator port)
+ (make-iterator (let ((iterator? #t)) (lambda () (read-char port)))))
+
+ (test (let ((p (open-input-string "12345")))
+ (let ((ip (make-input-iterator p)))
+ (let ((res (map values ip)))
+ (close-input-port p)
+ res)))
+ '(#\1 #\2 #\3 #\4 #\5)))
+
+(let ()
+ (define (make-input-iterator port)
+ (make-iterator (let ((iterator? #t)) (define-macro (_m_) `(read-char ,port)))))
+
+ (test (let ((p (open-input-string "12345")))
+ (let ((ip (make-input-iterator p)))
+ (let ((res (map values ip)))
+ (close-input-port p)
+ res)))
+ '(#\1 #\2 #\3 #\4 #\5)))
+
+(let ((iter (make-iterator (let ((iterator? #t)
+ (pos 0))
+ (lambda ()
+ (if (< pos 3)
+ (let ((p pos))
+ (set! pos (+ pos 1))
+ (values p (* p 2))) ; ?? maybe this is inconsistent?
+ #<eof>))))))
+ (test (map values iter) '(0 0 1 2 2 4)))
+
+(let ()
+ (define (make-row-iterator v)
+ (make-iterator (let ((iterator? #t)
+ (col 0))
+ (lambda ()
+ (if (< col (car (vector-dimensions v)))
+ (let ((c col))
+ (set! col (+ col 1))
+ (make-shared-vector v (cadr (vector-dimensions v)) (* c (cadr (vector-dimensions v)))))
+ #<eof>)))))
+
+ (let ((v #2d((0 1 2) (4 5 6))))
+ (let ((iter (make-row-iterator v)))
+ (test (map values iter) '(#(0 1 2) #(4 5 6))))))
+
+(let ()
+ (define (make-semi-complete-iterator obj)
+ (make-iterator
+ (let ((iters ())
+ (iter (make-iterator obj)))
+ (define (iterloop)
+ (let ((result (iter)))
+ (if (length result) ; i.e. result is a sequence
+ (begin
+ (set! iters (cons iter iters))
+ (set! iter (make-iterator result))
+ result) ; this returns the sequence before we descend into it
+ ; we could also call iterloop here to skip that step
+ (if (eof-object? result)
+ (if (null? iters)
+ result ; return #<eof>
+ (begin
+ (set! iter (car iters))
+ (set! iters (cdr iters))
+ (iterloop)))
+ result))))
+ (let ((iterator? #t))
+ (lambda ()
+ (iterloop))))))
+
+ (test (let ((v '(1 2 (4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 (4 5) 4 5))
+ (test (let ((v #(1 2 (4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 (4 5) 4 5))
+ (test (let ((v '((1 2 (4 5))))) (let ((i (make-semi-complete-iterator v))) (map values i))) '((1 2 (4 5)) 1 2 (4 5) 4 5))
+ (test (let ((v '(1 2 #(4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5))
+ (test (let ((v '(1 2 #(4 5) ("67")))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5 ("67") "67" #\6 #\7)))
+
+(let ()
+ (define (make-settable-iterator obj)
+ (make-iterator (let ((iterator? #t)
+ (pos 0))
+ (dilambda (lambda ()
+ (let ((res (obj pos)))
+ (set! pos (+ pos 1))
+ res))
+ (lambda (val)
+ (set! (obj pos) val))))))
+ (test (procedure? (procedure-setter (make-settable-iterator (vector 1 2 3)))) #t)
+ (let ((v (vector 1 2 3)))
+ (let ((iter (make-settable-iterator v)))
+ (set! (iter) 32)
+ (test v #(32 2 3)))))
+
+(let ()
+ (define (make-circular-iterator obj)
+ (let ((iter (make-iterator obj)))
+ (make-iterator
+ (let ((iterator? #t))
+ (lambda ()
+ (let ((result (iter)))
+ (if (eof-object? result)
+ ((set! iter (make-iterator obj)))
+ result)))))))
+
+ (let ((iter (make-circular-iterator '(1 2 3)))
+ (lst ()))
+ (do ((i 0 (+ i 1)))
+ ((= i 10)
+ (test (reverse lst) '(1 2 3 1 2 3 1 2 3 1)))
+ (set! lst (cons (iter) lst))))
+
+ (let ((iter (make-circular-iterator (hash-table* :a 1 :b 2)))
+ (lst ()))
+ (do ((i 0 (+ i 1)))
+ ((= i 4)
+ (test (let ((r (reverse lst)))
+ (or (equal? r '((:a . 1) (:b . 2) (:a . 1) (:b . 2)))
+ (equal? r '((:b . 2) (:a . 1) (:b . 2) (:a . 1)))))
+ #t))
+ (set! lst (cons (iter) lst)))))
+
+
+(test (procedure-setter (make-iterator "123")) #f)
+(test (procedure-setter (make-iterator #(1))) #f)
+(test (procedure-setter (make-iterator '(1))) #f)
+(test (procedure-setter (make-iterator (float-vector pi))) #f)
+
+(test (copy (make-iterator '(1 2 3)) (vector 1)) 'error)
+
+(let ()
+ (define (make-file-iterator file)
+ ;; reads a text file, returning one word at a time
+ (let* ((port (open-input-file file))
+ (line (read-line port #t))
+ (pos -1)
+ (new-pos 0)
+ (eol (string #\space #\tab #\newline #\linefeed)))
+
+ (define (next-word)
+ (set! pos (char-position eol line (+ pos 1)))
+ (if (not pos)
+ (begin
+ (set! pos -1)
+ (set! new-pos 0)
+ (set! line (read-line port #t))
+ (if (eof-object? line)
+ (begin
+ (close-input-port port)
+ line)
+ (next-word)))
+ (if (= new-pos pos)
+ (next-word)
+ (let ((start (do ((k new-pos (+ k 1)))
+ ((or (= k pos)
+ (char-alphabetic? (string-ref line k))
+ (char-numeric? (string-ref line k)))
+ k))))
+ (if (< start pos)
+ (let ((end (do ((k (- pos 1) (- k 1)))
+ ((or (= k start)
+ (char-alphabetic? (string-ref line k))
+ (char-numeric? (string-ref line k)))
+ (+ k 1)))))
+ (set! new-pos (+ pos 1))
+ (if (> end start)
+ (substring line start end)
+ (next-word)))
+ (next-word))))))
+
+ (make-iterator
+ (let ((iterator? #t))
+ (lambda* (p)
+ (if (eq? p :eof)
+ (begin
+ (close-input-port port)
+ #<eof>)
+ (next-word)))))))
+
+ (define iter (make-file-iterator "s7.c"))
+ (test (iter) "s7")
+ (test (iter) "a")
+ (test (iter) "Scheme")
+ (test (iter) "interpreter")
+ (test ((iterator-sequence iter) :eof) #<eof>)
+ )
+
@@ -11308,24 +20689,26 @@ this prints:
(for-each
(lambda (arg)
(test (do () (#t arg)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (do ((i arg)) (#t i)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
(test (do ((i 0 (+ i 1))) ((= i 3) #f)) #f)
(test (do ((i 0 (+ i 1))) ((= i 3) i)) 3)
-(test (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) '#(0 1 2 3 4))
+(test (do ((i 1/2 (+ i 1/8))) ((= i 2) i)) 2)
+(test (do ((i 1/2 (+ i 1/8))) ((> i 2) i)) 17/8)
+(test (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) #(0 1 2 3 4))
(test (let ((x '(1 3 5 7 9))) (do ((x x (cdr x)) (sum 0 (+ sum (car x)))) ((null? x) sum))) 25)
(test (do ((i 4 (- i 1)) (a 1 (* a i))) ((zero? i) a)) 24)
(test (do ((i 2 (+ i 1))) ((> i 0) 123)) 123)
-(test (do () (() ()) ()) '())
-(test (do () ('() '())) '())
-(test (do () ('())) '())
-(test (do () (())) '())
+(test (do () (() ()) ()) ())
+(test (do () ('() ())) ())
+(test (do () ('())) ())
+(test (do () (())) ())
(test (do) 'error)
(test (let ((x 0) (y 0)) (set! y (do () (#t (set! x 32) 123))) (list x y)) (list 32 123))
@@ -11351,11 +20734,9 @@ this prints:
(test (do ((i 0 (+ i j)) (j 0 (+ j 1))) (#t 1)) 1)
(test (do ((i 0 j) (j 0 (+ j 1))) ((= j 3) i)) 2) ; uh, lessee... lexical scoping...
(test (do ((i 1 j) (j 0 k) (k 0 m) (m 0 (+ i j k))) ((> m 10) (list i j k m))) (list 4 5 8 11))
-(test (do ((do 1 (+ do do))) ((> do 3) do)) 4)
-(test (do ((do 1 do) (j do do)) (do do)) 1)
-(test (do ((do do do)) (do do)) do)
-(test (do ((do do do)) (do do do)) do) ; ok ok!
(test (let ((i 10) (j 11) (k 12)) (do ((i i j) (j j k) (k k m) (m (+ i j k) (+ i j k))) ((> m 100) (list i j k m)))) (list 33 56 78 122))
+(test (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x) 44)
+(test (let () (define (hi) (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x)) (hi)) 44)
(test (do ((i 0 (let () (set! j 3) (+ i 1))) (j 0 (+ j 1))) ((= i 3) j)) 4)
(test (let ((i 0)) (do () ((= i 3) (* i 2)) (set! i (+ i 1)))) 6)
(num-test (do ((i 0 (- i 1))) ((= i -3) i)) -3)
@@ -11379,7 +20760,6 @@ this prints:
(test (let ((j 1)) (do ((i 0 j)) ((= i j) i) (set! j 2))) 2)
(test (do ((j 1 2) (i 0 j)) ((= i j) i)) 2)
(test (let ((old+ +) (j 0)) (do ((i 0 (old+ i 1))) ((or (< i -3) (> i 3))) (set! old+ -) (set! j (+ j i))) j) -6)
-(test (let ((old+ +) (j 0)) (do ((i 0 (+ i 1))) ((or (< i -3) (> i 3))) (set! + -) (set! j (old+ j i))) (set! + old+) j) -6)
(test (do ((i 0 (case i ((0) 1) ((1) "hi")))) ((string? i) i)) "hi")
(test (do ((i if +)) ((equal? i +) i)) +)
(test (let ((k 0)) (do ((j 0 (+ j 1)) (i 0 ((if (= i 0) + -) i 1))) ((= j 5)) (set! k (+ k i))) k) 2)
@@ -11399,6 +20779,20 @@ this prints:
(num-test (do ((i 0 (+ i 1))) ((> i 3) i) (set! i (* .9 i))) 3.439)
(test (let ((v #(0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (set! (v i) i))) #(0 1 2))
(test (let ((v (list 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (set! (v i) i))) '(0 1 2))
+(test (let ((sum 0)) ((do ((i 0 (+ i 1))) ((> i 64) (lambda () sum)) (set! sum (+ sum i))))) 2080)
+(test (do ((lst () (cons i lst)) (i 0 (+ i 1))) ((> i 6) (reverse lst))) '(0 1 2 3 4 5 6))
+(let ()
+ (define (d1) (do ((i 0 (+ i 1))) ((= i 10) i)))
+ (define (d2) (do ((i 0 (+ i 1))) ((= i 10) i) i))
+ (test (d1) 10)
+ (test (d1) (d2)))
+
+(test (do () (1)) ())
+(test (do () (1 2)) 2)
+(test (do () '2) 2)
+(test (do () (())) ())
+
+(test (let ((x (do ((i 0 (+ i 1))) (#t)))) x) ()) ; guile: #<unspecified>
(test (let ((lst '(1 2 3))
(v (vector 0 0 0)))
@@ -11408,6 +20802,8 @@ this prints:
v)
#(5 7 6))
+(test (do ((i 0 (+ i 1)) (j 1 2)) ((= i 4) j) (set! j 3)) 2)
+
(test (let ((lst '(1 2 3)))
(map (lambda (a)
(let ((! 1))
@@ -11423,6 +20819,42 @@ this prints:
(set! sum (+ sum i_0 i_1 i_2 i_3 i_4 i_5 i_6 i_7 i_8 i_9 i_10 i_11 i_12 i_13 i_14 i_15 i_16 i_17 i_18 i_19 i_20 i_21 i_22 i_23 i_24 i_25 i_26 i_27 i_28 i_29 i_30 i_31 i_32 i_33 i_34 i_35 i_36 i_37 i_38 i_39))))
35100)
+(let () (define (jtest) (let ((j 0)) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set! j i))))) (test (jtest) 3))
+(let () (define (jtest1) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (j 0) i))))) (test (jtest1) 3))
+(let () (define (jtest2) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (vector-set! j 0 i))))) (test (jtest2) 3))
+(let () (define (jtest3) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (vector-ref j 0) i))))) (test (jtest3) 3))
+(let () (define (jtest4) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (j 0) i))))) (test (jtest4) 3))
+(let () (define (jtest5) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (car j) i))))) (test (jtest5) 3))
+(let () (define (jtest6) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set-car! j i))))) (test (jtest6) 3))
+(let () (define (jtest7) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (list-set! j 0 i))))) (test (jtest7) 3))
+(let () (define (jtest8) (let ((j #f)) (do ((i 0 (+ i 1))) ((= i 10) (car j)) (if (= i 3) (set! j (list i)))))) (test (jtest8) 3))
+(let () (define (jtest9) (let ((j #f)) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! j (vector i)))))) (test (jtest9) 3))
+(let () (define (jtest10) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set-car! j i))))) (test (jtest10) '(3 . 2)))
+(let () (define (jtest10a) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (list-set! j 0 i))))) (test (jtest10a) '(3 . 2)))
+(let () (define (jtest11) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set! j (cons 0 i)))))) (test (jtest11) '(0 . 3)))
+;; (let ((f #f)) (define (jtest12) (do ((i 0 (+ i 1))) ((= i 10) (f)) (if (= i 3) (set! f (lambda () i))))) (test (jtest12) 3))
+;; this lambda business is a separate issue (s7 returns 10 here)
+
+;; do_all_x:
+(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
+(let () (define (f1) (let ((v (vector 0 0 0)) (x #f)) (do ((i 0 (+ i 1))) ((= i 3) (set! x v) x) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
+(let () (define (f1) (let ((end 3) (v (vector 0 0 0))) (vector (do ((i 0 (+ i 1))) ((= i end)) (vector-set! v i (abs i))) v))) (test (f1) #(() #(0 1 2))))
+(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (display i #f) (vector-set! v i (abs i))))) (test (f1) #(0 1 2)))
+
+(let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 0) v) (vector-set! v i (abs i))))) (test (f1) #(0 0 0)))
+
+(let () (define (safe-do-all-x)
+ (let ((v1 (vector 1 2 3 4 5 6))
+ (v2 (vector 10 11 12 13 14 15)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (vector-set! v1 i (vector-ref v2 (+ i 1))))
+ v1))
+ (test (safe-do-all-x) (vector 11 12 13 4 5 6)))
+
+
+(test (let () (define (step-it a) (+ a 1)) (define (hi) (do ((i 0 (step-it i))) ((= i 3) i))) (hi) (hi)) 3)
+
(test (call-with-exit (lambda (return) (do () () (if #t (return 123))))) 123)
(test (call-with-exit (lambda (return) (do () (#f) (if #t (return 123))))) 123)
(test (call-with-exit (lambda (return) (do ((i 0 (+ i 1))) () (if (= i 100) (return 123))))) 123)
@@ -11430,7 +20862,7 @@ this prints:
(test (call-with-exit (lambda (return) (do () (#t (return 123))))) 123)
(test (do () (/ 0)) 0)
-(test (do () (+)) '())
+(test (do () (+)) ())
(test (do () (+ +) *) +)
(if with-bignums
@@ -11484,7 +20916,6 @@ this prints:
(test (let ((happy #f)) (do ((i 0 (+ i 1))) (happy happy) (if (> i 3) (set! happy i)))) 4)
(test (+ (do ((i 0 (+ i 1))) ((= i 3) i)) (do ((j 0 (+ j 1))) ((= j 4) j))) 7)
-(test (let ((do 1) (map 2) (for-each 3) (quote 4)) (+ do map for-each quote)) 10)
(test (do ((i (if #f #f))) (i i)) (if #f #f))
(test (do ((i (if #f #f)) (j #f i)) (j j)) (if #f #f))
@@ -11513,19 +20944,19 @@ this prints:
;; from sacla tests
(test (let ((rev (lambda (list)
(do ((x list (cdr x))
- (reverse '() (cons (car x) reverse)))
+ (reverse () (cons (car x) reverse)))
((null? x) reverse)))))
- (and (null? (rev '()))
+ (and (null? (rev ()))
(equal? (rev '(0 1 2 3 4)) '(4 3 2 1 0))))
#t)
(test (let ((nrev (lambda (list)
- (do ((f1st (if (null? list) '() (cdr list)) (if (null? f1st) '() (cdr f1st)))
+ (do ((f1st (if (null? list) () (cdr list)) (if (null? f1st) () (cdr f1st)))
(s2nd list f1st)
- (t3rd '() s2nd))
+ (t3rd () s2nd))
((null? s2nd) t3rd)
(set-cdr! s2nd t3rd)))))
- (and (null? (nrev '()))
+ (and (null? (nrev ()))
(equal? (nrev (list 0 1 2 3 4)) '(4 3 2 1 0))))
#t)
@@ -11547,7 +20978,7 @@ this prints:
(set! n (vector-ref vec i))
(vector-set! vec i (vector-ref vec j))
(vector-set! vec j n))
- '#(9 8 7 6 5 4 3 2 1 0)))
+ #(9 8 7 6 5 4 3 2 1 0)))
(test (do ((i 0 (+ i 1))) (#t i) (error "do evaluated its body?")) 0)
(test (do '() (#t 1)) 'error)
@@ -11578,8 +21009,6 @@ this prints:
(test (do ((i 0 (abs ()))) ((not (= i 0)) i)) 'error)
(test (do ((i j) (j i)) (i i)) 'error)
(test (do ((i 0 0) . ((j 0 j))) (#t j)) 0)
-(test (do ((i 0 0) '(+ 0 1)) ((= i 0) i)) 0) ; guile also! (do ((i 0 0) (quote list (+ 0 1))) ((= i 0) i))?
-(test (do ((i 0 1) '(list)) (#t quote)) '())
(test (do ((i 0 1 . 2)) (#t i)) 'error)
(test (do ((i 0 "hi")) ((string? i) . i)) 'error)
(test (do ((i 0 j)) (#t i)) 0) ; guile also -- (do ((i 0 (abs "hi"))) (#t i)) etc (do ((i 0 1)) (#t i) (abs "hi"))
@@ -11593,10 +21022,14 @@ this prints:
(test (do ((#() 1)) ()) 'error)
(test (do ((1)) ()) 'error)
(test (do ((i 1) . #(a 1)) ()) 'error)
-(test (do ((i 1)) '()) '())
+(test (do () ((3 4))) 'error)
+(test (do ((i 1)) '()) ())
(test (do . (() (#t 1))) 1)
(test (do () . ((#t 1))) 1)
-(test (do ((i 1 (+ i 1))) . ((() . ()))) '())
+(test (do ((i 1 (+ i 1))) . ((() . ()))) ())
+(test (do ((a . 1) (b . 2)) () a) 'error)
+(let () (define (d1) (do ((i 0 (+ i 1))) ((= i 3) . i) (display i))) (test (d1) 'error))
+(let () (define (d1) (do ((i 0 (+ i 1))) ((= i 3) i) . i)) (test (d1) 'error))
(test (define-constant) 'error)
(test (define-constant _asdf_ 2 3) 'error)
@@ -11604,16 +21037,12 @@ this prints:
(test (define-constant pi . 3) 'error)
(define-constant __do_step_var_check__ 1)
(test (do ((__do_step_var_check__ 2 3)) (#t #t)) 'error)
-(test (let ((__do_step_var_access_1__ #f))
- (set! (symbol-access '__do_step_var_access_1__) (list #f #f #f))
- (do ((__do_step_var_access_1__ 1 2)) (#t __do_step_var_access_1__)))
- 1)
-
-(test (let ((__do_step_var_access_1__ #f))
- (set! (symbol-access '__do_step_var_access_1__) (list #f (lambda (x y) (error "do step var is being set!"))
- (lambda (x y) (+ y 1))))
- (do ((__do_step_var_access_1__ 1 32)) (#t __do_step_var_access_1__)))
- 2)
+(test (let ((__do_step_var_check__ 2)) 1) 'error)
+(test (let () (set! __do_step_var_check__ 2)) 'error)
+(test (let ((__a_var__ 123))
+ (set! (symbol-access '__a_var__) (lambda (val sym) 0))
+ (set! __a_var__ -1123))
+ 0)
(test (do ((hi #3d(((1 2) (3 4)) ((5 6) (7 8))) (hi 1))) ((equal? hi 8) hi)) 8)
(test (do ((i 0 ('((1 2) (3 4)) 0 1))) ((not (= i 0)) i)) 2)
(test (do () (#t (+ 1 2 3))) 6)
@@ -11706,6 +21135,286 @@ this prints:
(num-test (do ((i 10 (- i 1))) ((= i 0) i)) 0)
(num-test (do ((i 10 (- 1 i))) ((< i 0) i)) -9)
(num-test (do ((i 10 (- i 3))) ((< i 0) i)) -2)
+(let () (define (hi) (do ((i 1 (+ 1 i))) ((= i 1) i))) (hi) (test (hi) 1))
+(let () (define (hi) (do ((i 10 (+ i 1))) ((= i 10) i) (abs i))) (hi) (test (hi) 10))
+(let ((sum 0)) (define (hi) (do ((i 10 (+ i 1))) ((= i 10) i) (set! sum (+ sum i)))) (hi) (test (hi) 10))
+(let () (define (hi a) (do ((i a (+ i 1))) ((= i a) i) (+ a 1))) (hi 1) (test (hi 1) 1))
+(let ()
+ (define (fx)
+ (let ((iter (make-iterator #(1 2 3))))
+ (do () ((or (string? (iterate iter)) (iterator-at-end? iter)) (not (iterator-at-end? iter))))))
+ (test (fx) #f))
+(let ()
+ (define (fx1)
+ (let ((iter (make-iterator #(1 2 3))))
+ (do () ((or (= (iterate iter) 2) (iterator-at-end? iter)) (iterate iter)))))
+ (test (fx1) 3))
+(let ()
+ (define (fx2)
+ (let ((iter (make-iterator #(1 2 3))))
+ (do () ((= (iterate iter) 2) (iterate iter)))))
+ (test (fx2) 3))
+(let ()
+ (define (fdo1)
+ (let ((abs (lambda (x) (+ x 1)))
+ (x '(1 2 3)))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (if (not (equal? (map abs x) '(2 3 4)))
+ (display "fdo1 map case")))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (if (not (equal? (for-each abs x) #<unspecified>))
+ (display "fdo1 for-each case")))))
+ (define (fdo2)
+ (let ((abs (lambda (x y) (= x y)))
+ (x '(1 2 3)))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (if (not (member 2 x abs))
+ (display "fdo2 member case")))))
+ (define (fdo3)
+ (let ((abs (lambda (x y) (= x y)))
+ (x '((1 a) (2 b) (3 c))))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (if (not (assoc 2 x abs))
+ (display "fdo3 assoc case")))))
+ (define (fdo4)
+ (let ((abs (lambda (x y) (> x y)))
+ (x (list 1 2 3)))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (if (not (equal? (sort! x abs) '(3 2 1)))
+ (display "fdo4 sort! case")))))
+ (fdo1)
+ (fdo2)
+ (fdo3)
+ (fdo4))
+
+(let () (define (fdo5) (do ((si () '())) ((null? si) 'mi))) (test (fdo5) 'mi))
+(let () (define (fdo5) (do ((si '() '())) ((null? si) 'mi))) (test (fdo5) 'mi))
+(let () (define (fdo5) (do ((si () ())) ((null? si) 'mi))) (test (fdo5) 'mi))
+(let () (define (fdo5) (do ((si () ())) ((null? si) 'mi))) (test (fdo5) 'mi))
+
+
+;;; check an optimizer bug
+(define _do_call_cc_end_ 1)
+(define (call-cc-do-test)
+ (do ((i 0 (+ i 1)))
+ ((= i _do_call_cc_end_))
+ (let ((ctr 0))
+ (call/cc (lambda (exit)
+ (if (> 3 2)
+ (let ()
+ (exit ctr)
+ (set! ctr 100) ctr)
+ #f)))))
+ (do ((i 0 (+ 1 i)))
+ ((= i _do_call_cc_end_))
+ (let ((ctr 0))
+ (call/cc (lambda (exit)
+ (if (> 3 2)
+ (let ()
+ (exit ctr)
+ (set! ctr 100) ctr)
+ #f))))))
+(call-cc-do-test)
+
+;;; and another
+(let()
+ (define (hi)
+ (let ((checker (lambda (nlst v)
+ (let ((chr (car nlst)))
+ (if (not (char-alphabetic? chr))
+ (if (not (char=? v chr))
+ (format-logged #t ";(char-downcase #\\~A) -> ~A" chr v))
+ (if (and (not (char=? chr v))
+ (not (char=? chr (char-upcase v))))
+ (format-logged #t ";(char-downcase #\\~A) -> ~A~%" chr v))))))
+ (result 0))
+ (let ((try 0))
+ (do ((i 0 (+ i 1)))
+ ((> i 10))
+ (set! try i)
+ (checker '(#\a) #\a)
+ (checker '(#\a) #\a)))))
+ (test (hi) ()))
+
+(define (__a-func__ a)
+ (format-logged #t ";oops called first a-func by mistake: ~A~%" a)
+ (if (> a 0)
+ (__a-func__ (- a 1))))
+
+(define (__a-func__ a)
+ (if (> a 0)
+ (__a-func__ (- a 1))))
+
+(__a-func__ 3)
+
+(define (__c-func__ a)
+ (format-logged #t ";oops called first __c-func__ by mistake: ~A~%" a)
+ (if (> a 0)
+ (__c-func__ (- a 1))))
+
+(let ()
+ (define (__c-func__ a)
+ (if (> a 0)
+ (__c-func__ (- a 1))))
+
+ (__c-func__ 3))
+
+;;; more optimizer checks
+(let ()
+ (define (do-test-1) (do ((i 0 (+ i 1))) ((= i 10)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-1))) "0123456789"))
+
+(let ()
+ (define (do-test-2) (do ((i 0 (+ 1 i))) ((= i 10)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-2))) "0123456789"))
+
+(let ((start 0))
+ (define (do-test-3) (do ((i start (+ i 1))) ((= i 10)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-3))) "0123456789"))
+
+(let ((start 0) (end 10))
+ (define (do-test-4) (do ((i start (+ i 1))) ((= i end)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-4))) "0123456789"))
+
+(let ((start 0) (end 10))
+ (define (do-test-5) (do ((i start (+ i 1))) ((= end i)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-5))) "0123456789"))
+
+(let ()
+ (define (do-test-6) (do ((i 0 (+ i 1))) ((= i 10)) (let ((k i)) (display k))))
+ (test (with-output-to-string (lambda () (do-test-6))) "0123456789"))
+
+(let ()
+ (define (do-test-7) (do ((i 0 (+ i 2))) ((= i 20)) (display (/ i 2))))
+ (test (with-output-to-string (lambda () (do-test-7))) "0123456789"))
+
+(let ()
+ (define (do-test-8) (do ((i 0 (+ i 1))) ((= i 10)) (let ((a (+ 1 2))) (display #\0))))
+ (test (with-output-to-string (lambda () (do-test-8))) "0000000000"))
+
+(let ()
+ (define (do-test-9) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (set! j i) (display j))))
+ (test (with-output-to-string (lambda () (do-test-9))) "0123456789"))
+
+(let ()
+ (define (do-test-10) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (display i))))
+ (test (with-output-to-string (lambda () (do-test-10))) "0123456789"))
+
+(let ()
+ (define (do-test-11) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (set! j 32) (display i))))
+ (test (with-output-to-string (lambda () (do-test-11))) "0123456789"))
+
+(let ()
+ (define (do-test-12) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j i)) (display j))))
+ (test (with-output-to-string (lambda () (do-test-12))) "0123456789"))
+
+(let ()
+ (define (do-test-13) (do ((i 0 (+ i 1))) ((= i 5)) (let ((j (+ i 1))) (let ((i j)) (display (- i 1))))))
+ (test (with-output-to-string (lambda () (do-test-13))) "01234"))
+
+(let ()
+ (define (do-test-14) (do ((i 0 (+ i 1))) ((= i 10)) (set! i (+ i 1)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-14))) "13579"))
+
+(let ((lst ()))
+ (define (do-test-15) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (set! lst (cons i lst))) lst)
+ (test (do-test-15) '(9 8 7 6 5 4 3 2 1 0)))
+
+(let ((lst ()))
+ (define (do-test-15a) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (set! lst (append (list i) lst))) lst)
+ (test (do-test-15a) '(9 8 7 6 5 4 3 2 1 0)))
+
+(let ((lst (list 9 8 7 6 5 4 3 2 1 0)))
+ (define (do-test-16) (do ((i 0 (+ i 1))) ((= i 10)) (list-set! lst i i)) lst)
+ (test (do-test-16) '(0 1 2 3 4 5 6 7 8 9)))
+
+(let ((lst ()))
+ (define (do-test-17) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j i)) (set! lst (cons j lst)))) lst)
+ (test (do-test-17) '(9 8 7 6 5 4 3 2 1 0)))
+
+(let ((lst ()))
+ (define (do-test-17a) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j (min i 100))) (set! lst (cons j lst)))) lst)
+ (test (do-test-17a) '(9 8 7 6 5 4 3 2 1 0)))
+
+(let ()
+ (define (do-test-18) (do ((i 0 (+ i 1)) (j 0)) ((= i 10) j) (if (= i 3) (set! j i))))
+ (test (do-test-18) 3))
+
+(let ((end 10))
+ (define (do-test-19) (do ((i 0 (+ i 1))) ((= i end)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-19))) "0123456789"))
+
+(let ((end 10))
+ (define (do-test-19A) (do ((i 0 (+ 1 i))) ((= end i)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-19A))) "0123456789"))
+
+(let ((end 10))
+ (define (do-test-20) (do ((i 0 (+ i 1))) ((= i end)) (set! end 8) (display i)))
+ (test (with-output-to-string (lambda () (do-test-20))) "01234567"))
+
+(let ((end 10))
+ (define (do-test-20A) (do ((i 0 (+ 1 i))) ((= end i)) (set! end 8) (display i)))
+ (test (with-output-to-string (lambda () (do-test-20A))) "01234567"))
+
+(let ()
+ (define (do-test-21) (do ((i 0 (+ i 1))) ((= i 3)) (with-let (rootlet) (+ 1 2))))
+ (do-test-21))
+
+(let ((v (vector 0 0 0)))
+ (define (hi a) (do ((i 0 (+ i 1))) ((> i a)) (vector-set! v i 1))) (hi 2)
+ (test v (vector 1 1 1)))
+
+(let () ; dotimes_c_c case can't involve set so we use write-char
+ (define (hi a)
+ (do ((i 0 (+ i 1)))
+ ((= i a))
+ (write-char #\a)))
+ (with-output-to-file tmp-output-file
+ (lambda ()
+ (hi 3)))
+ (let ((str (with-input-from-file tmp-output-file
+ (lambda ()
+ (read-line)))))
+ (test str "aaa")))
+
+(let ()
+ (define (do-test-22) (do ((i 0 (+ i 1))) ((= i 10)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-22))) "0123456789"))
+
+(let ((v (make-list 10)))
+ (define (do-test-23) (do ((i 0 (+ i 1))) ((= i 10)) (list-set! v i i)))
+ (do-test-23)
+ (test v '(0 1 2 3 4 5 6 7 8 9)))
+
+;;; safe simple h_safe_c_s
+(let ()
+ (define (do-test-24) (do ((i 0 (+ i 1))) ((> i 10)) (display i)))
+ (test (with-output-to-string (lambda () (do-test-24))) "012345678910"))
+
+;;; safe simple h_safe_c_ss
+(let ()
+ (define (do-test-25 p) (do ((i 0 (+ i 1))) ((> i 10)) (display i p)))
+ (test (call-with-output-string (lambda (p) (do-test-25 p))) "012345678910"))
+
+;;; safe simple h_safe_c_c
+(let ()
+ (define (do-test-26) (do ((i 0 (+ i 1))) ((> i 10)) (display 0)))
+ (test (with-output-to-string (lambda () (do-test-26))) "00000000000"))
+
+;;; safe simple h_safe_c_opsq_s
+(let ()
+ (define (do-test-27 p) (do ((i 0 (+ i 1))) ((> i 10)) (display (- i) p)))
+ (test (call-with-output-string (lambda (p) (do-test-27 p))) "0-1-2-3-4-5-6-7-8-9-10"))
+
+(let ()
+ (define (do-test-22 i o) (catch #t (lambda () (do () () (write-char (read-char i) o))) (lambda err (get-output-string o))))
+ (test (call-with-output-string (lambda (out) (call-with-input-string "0123" (lambda (in) (do-test-22 in out))))) "0123"))
+
@@ -11718,7 +21427,7 @@ this prints:
(for-each
(lambda (arg)
(test (let ((a 0)) (set! a arg) a) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))
(test (let ((a 1)) (call/cc (lambda (r) (set! a (let () (if (= a 1) (r 123)) 321)))) a) 1)
(test (let ((a (lambda (b) (+ b 1)))) (set! a (lambda (b) (+ b 2))) (a 3)) 5)
@@ -11749,7 +21458,7 @@ this prints:
(test (set! (let () 'a) 1) 'error)
(test (set!) 'error)
(test (set! #t #f) 'error)
-(test (set! '() #f) 'error)
+(test (set! () #f) 'error)
(test (set! #(1 2 3) 1) 'error)
(test (set! (call/cc (lambda (a) a)) #f) 'error)
(test (set! 3 1) 'error)
@@ -11759,6 +21468,12 @@ this prints:
(test (set! (1 2) #t) 'error)
(test (set! _not_a_var_ 1) 'error)
(test (set! (_not_a_pws_) 1) 'error)
+(test (let ((x 1)) (set! ((lambda () 'x)) 3) x) 'error)
+(test (let ((x '(1 2 3))) (set! (((lambda () 'x)) 0) 3) x) '(3 2 3))
+(test (let ((x '(1 2 3))) (set! (((lambda () x)) 0) 3) x) '(3 2 3)) ; ??
+(test (let ((x '(1 2 3))) (set! ('x 0) 3) x) '(3 2 3)) ; ??? I suppose that's similar to
+(test (let ((x '((1 2 3)))) (set! ((car x) 0) 3) x) '((3 2 3)))
+(test (let ((x '((1 2 3)))) (set! ('(1 2 3) 0) 32) x) '((1 2 3))) ; this still looks wrong... (expands to (list-set! '(1 2 3) 0 3) I guess)
(test (let ((a (lambda (x) (set! a 3) x))) (list (a 1) a)) 'error)
(test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error)
@@ -11773,7 +21488,8 @@ this prints:
(test (set! (cons 1 2) 3) 'error)
(test (let ((var 1) (val 2)) (set! var set!) (var val 3) val) 3)
(test (let ((var 1) (val 2)) (set! var +) (var val 3)) 5)
-(test (let ((sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 1))
+(test (let ((sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 1)
+ (sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456780 3))
(set! sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 2)
sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789)
2)
@@ -11812,13 +21528,41 @@ this prints:
(test (set! (#(a 0 (3)) 1) 0) 0)
(test (set! ('(a 0) 1) 0) 0)
(test (apply set! (apply list (list ''(1 2 3) 1)) '(32)) 32)
+
(let ()
- (define-macro (symbol-set! var val) `(apply set! ,var (list ,val)))
+ (define-macro (symbol-set! var val) `(apply set! ,var (list ,val))) ; but this evals twice
(test (let ((x 32) (y 'x)) (symbol-set! y 123) (list x y)) '(123 x)))
+(let ()
+ (define-macro (symbol-set! var val) ; like CL's set
+ `(apply set! ,var ',val ()))
+ (test (let ((var '(+ 1 2)) (val 'var)) (symbol-set! val 3) (list var val)) '(3 var))
+ (test (let ((var '(+ 1 2)) (val 'var)) (symbol-set! val '(+ 1 3)) (list var val)) '((+ 1 3) var)))
+
(test (set! ('(1 2) 1 . 2) 1) 'error)
(test (set! ('((1 2) 1) () . 1) 1) 'error)
(test (set! ('(1 1) () . 1) 1) 'error)
+(test (let () (define (hi) (let ((x 1000)) (set! x (+ x 1)) x)) (hi) (hi)) 1001)
+(test (let () (define (hi) (let ((x 1000.5)) (set! x (+ x 1)) x)) (hi) (hi)) 1001.5)
+(test (let () (define (hi) (let ((x 3/2)) (set! x (+ x 1)) x)) (hi) (hi)) 5/2)
+(test (let () (define (hi) (let ((x 3/2)) (set! x (- x 1)) x)) (hi) (hi)) 1/2)
+(test (let () (define (hi) (let ((x 3/2)) (set! x (- x 2)) x)) (hi) (hi)) -1/2)
+(test (let () (define (hi) (let ((x "asdf")) (set! x (+ x 1)) x)) (hi) (hi)) 'error)
+
+(let ()
+ ;; check an optimizer bug
+ (define (bad-increment a b)
+ (cons a b))
+
+ (define (use-bad-increment b)
+ (let ((x ()))
+ (set! x (bad-increment x b))
+ x))
+
+ (use-bad-increment 1)
+ (use-bad-increment 1)
+ (use-bad-increment 1))
+
@@ -11837,8 +21581,10 @@ this prints:
(for-each
(lambda (arg)
- (test (or arg) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) #<eof> #<unspecified> '(1 . 2)))
+ (test (or arg) arg)
+ (test (or #f arg) arg)
+ (test (or arg (error "oops or ")) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) #<eof> #<unspecified> '(1 . 2)))
(test (call-with-input-file "s7test.scm"
(lambda (p)
@@ -11847,7 +21593,7 @@ this prints:
(or (eof-object? val)
(> loc 1000) ; try to avoid the read-error stuff
(begin
- (set! loc (+ 1 loc))
+ (set! loc (+ loc 1))
(loop (read-char p)))))
(> loc 1000))))
#t)
@@ -11857,11 +21603,10 @@ this prints:
(test (or (or (or))) #f)
(test (or (or (or) (and))) #t)
(test (let ((a 1)) (or (let () (set! a 2) #f) (= a 1) (let () (set! a 3) #f) (and (= a 3) a) (let () (set! a 4) #f) a)) 3)
-(test (or (let ((or #t)) or)) #t)
-(test (or '#f '()) '())
+(test (or '#f ()) ())
(test (call/cc (lambda (r) (or #f (> 3 2) (r 123) 321))) #t)
(test (call/cc (lambda (r) (or #f (< 3 2) (r 123) 321))) 123)
-(test (+ (or #f (not (null? '())) 3) (or (zero? 1) 2)) 5)
+(test (+ (or #f (not (null? ())) 3) (or (zero? 1) 2)) 5)
(test (or 0) 0)
(test (if (or) 1 2) 2)
@@ -11869,6 +21614,7 @@ this prints:
(test (or #f . 1) 'error)
(test (or . (1 2)) 1)
(test (or . ()) (or))
+; (test (or 1 . 2) 1) ; this fluctuates
(test (let () (or (define (hi a) a)) (hi 1)) 1)
(test (let () (or #t (define (hi a) a)) (hi 1)) 'error)
@@ -11898,11 +21644,14 @@ this prints:
(test (if (+) 1 2) 1)
(test (if (*) 1 2) 1)
(test (and (if #f #f)) (if #f #f))
+(test (let ((x '(1))) (eq? (and x) x)) #t)
(for-each
(lambda (arg)
- (test (and arg) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (test (and arg) arg)
+ (test (and #t arg) arg)
+ (test (and arg #t) #t))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (call-with-input-file "s7test.scm"
(lambda (p)
@@ -11911,7 +21660,7 @@ this prints:
(and (not (eof-object? val))
(< loc 1000)
(begin
- (set! loc (+ 1 loc))
+ (set! loc (+ loc 1))
(loop (read-char p)))))
(>= loc 1000))))
#t)
@@ -11921,11 +21670,10 @@ this prints:
(test (and (and (and))) #t)
(test (and (and (and (and (or))))) #f)
(test (let ((a 1)) (and (let () (set! a 2) #t) (= a 1) (let () (set! a 3) #f) (and (= a 3) a) (let () (set! a 4) #f) a)) #f)
-(test (and (let ((and #t)) and)) #t)
-(test (and '#t '()) '())
+(test (and '#t ()) ())
(test (call/cc (lambda (r) (and #t (> 3 2) (r 123) 321))) 123)
(test (call/cc (lambda (r) (and #t (< 3 2) (r 123) 321))) #f)
-(test (+ (and (null? '()) 3) (and (zero? 0) 2)) 5)
+(test (+ (and (null? ()) 3) (and (zero? 0) 2)) 5)
(test (and . #t) 'error)
(test (and 1 . 2) 'error)
@@ -11935,6 +21683,39 @@ this prints:
(test (let () (and #f (define (hi a) a)) (hi 1)) 'error)
(test (+ 1 (and (define (hi a) a) (hi 2))) 3)
+;;; from some net site
+(let ()
+ (define (fold fn accum list)
+ (if (null? list)
+ accum
+ (fold fn
+ (fn accum
+ (car list))
+ (cdr list))))
+ (test (fold and #t '(#t #f #t #t)) #f))
+
+(test (let ((and! and)) (and! #f (error "oops"))) #f)
+(test (let ((and! #f)) (set! and! and) (and! #f (error "oops"))) #f)
+(test (let () (define (try and!) (and! #f (error "oops"))) (try and)) #f)
+
+;;; here are some tests from S. Lewis in the r7rs mailing list
+(let ()
+ (define myand and)
+ (test (myand #t (+ 1 2 3)) 6)
+ (define (return-op) and)
+ (define myop (return-op))
+ (test (myop #t (+ 1 2 3)) 6)
+ (test (and #t (+ 1 2 3)) 6)
+ (test ((return-op) #t (+ 1 2 3)) 6)
+ (test ((and and) #t (+ 1 2 3)) 6)
+ (define ops `(,* ,and))
+ (test ((car ops) 2 3) 6)
+ (test ((cadr ops) #t #f) #f)
+ (test (and #f never) #f)
+ (test (and #f and) #f)
+ (test ((and #t and) #t (+ 1 2 3)) 6))
+
+
@@ -11980,11 +21761,23 @@ this prints:
(test (cond (+ 0)) 0)
(test (cond (lambda ())) ())
(test (cond . ((1 2) ((3 4)))) 2)
+(test (cond (define #f)) #f)
+(test (let () (cond ((> 2 1) (define x 32) x) (#t 1)) x) 32) ; ? a bit strange
+(test (let ((x 1)) (+ x (cond ((> x 0) (define x 32) x)) x)) 65)
+(test (cond (("hi" 1))) #\i)
+(test (cond (()())) ())
+(test (let ((a 0)) (let ((b (lambda () (set! a 1) #f))) (cond ((> a 0) 3) ((b) 4) ((> a 0) 5) (#t 6)))) 5)
+(test (let ((a #t)) (let ((b (lambda () (set! a (not a)) a))) (cond ((b) 1) ((b) 2) (t 3)))) 2)
+(test (let ((otherwise else)) (cond ((= 1 2) 1) (otherwise 3))) 3)
+(test (let ((otherwise #t)) (cond ((= 1 2) 1) (otherwise 3))) 3) ; or actually anything... 12 for example
+(test (let ((else #f)) (cond ((= 1 2) 1) (else 3))) ())
+(test (let ((else #f)) (cond ((= 1 2) 1) (#_else 3))) 3)
+(test (let ((else 1)) (let ((otherwise else)) (case 0 (otherwise 1)))) 'error)
(for-each
(lambda (arg)
(test (cond ((or arg) => (lambda (x) x))) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (cond ((+ 1 2) => (lambda (x) (+ 1 x)))) 4)
(test (cond ((cons 1 2) => car)) 1)
@@ -11997,6 +21790,7 @@ this prints:
(test (cond ((* 2 3) => (cond ((+ 3 4) => (lambda (a) (lambda (b) (+ b a))))))) 13)
(test (let ((x 1)) ((cond ((let () (set! x 2) #f) => boolean?) (lambda => (lambda (a) (apply a '((b) (+ b 123)))))) x)) 125)
(test (cond ((values 1 2 3) => '(1 (2 3 (4 5 6 7 8))))) 7)
+(test (cond ((values 1 2 3) => +)) 6)
(test (cond ((values #f #f) => equal?)) #t) ; (values #f #f) is not #f
(test (let () (cond (#t (define (hi a) a))) (hi 1)) 1)
(test (let () (cond (#f (define (hi a) a))) (hi 1)) 'error)
@@ -12008,37 +21802,39 @@ this prints:
(test (symbol? (cond (else else))) #f)
(test (equal? else (cond (else else))) #t)
(test (cond (#f 2) ((cond (else else)) 1)) 1)
+(test (let ((x #f) (y #t)) (cond (x 1) (y 2))) 2)
+(test (cond ((- 3 2)) ((< 2 3))) (or (- 3 2) (< 3 2))) ; (cond (e) ...)) is the same as (or e ...)
(for-each
(lambda (arg)
(test (cond (#t arg)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (cond (arg)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (cond (#f 1) (else arg)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (cond (arg => (lambda (x) x))) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (cond ((let () 1) => (let ((x 2)) (lambda (n) (+ n x))))) 3)
(test (cond ((let () 1) => (let ((x 2)) (cond (3 => (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y))))))))) 10)
(test (let ((=> 3)) (cond (=> =>))) 3)
-(test (let ((=> 3) (cond 4)) (+ => cond)) 7)
(test (cond (cond 'cond)) 'cond)
(test (cond (3 => (lambda args (car args)))) 3)
(test (cond (3 => (lambda (a . b) a))) 3)
-(test (cond ((list 3 4) => (lambda (a . b) b))) '())
+(test (cond ((list 3 4) => (lambda (a . b) b))) ())
(test (cond) 'error)
+(test (let () (define-macro (mac x) `(+ ,x 1)) (cond (1 => mac))) 2)
;(test (cond ((= 1 2) 3) (else 4) (4 5)) 'error) ; trailing ignored
(test (cond ((+ 1 2) => (lambda (a b) (+ a b)))) 'error)
(test (equal? (cond (else)) else) #t)
@@ -12048,6 +21844,7 @@ this prints:
(test (cond ((values -1) =>)) 'error)
(test (cond (cond (#t 1))) 'error)
(test (cond 1) 'error)
+(test (cond) 'error)
(test (cond (1 . 2) (else 3)) 'error)
(test (cond (#f 2) (else . 4)) 'error)
(test (cond ((values 1 2) => (lambda (x y) #t))) #t)
@@ -12061,10 +21858,15 @@ this prints:
(test (cond (1 => + abs)) 'error)
(test (cond (1 =>)) 'error)
(test (cond ((values 1 2) => + abs)) 'error)
-(test (cond (else => not)) 'error)
+(test (cond (else => symbol?)) #f) ; (symbol? else) -> #f
+(test (eq? (cond (else => or)) else) #t)
+(test (cond ((values #f 1) => or)) 1)
+(test (+ (cond ((values 1 2 3)))) 6)
(test (let ((else 3)) (cond ((= else 3) 32) (#t 1))) 32)
(test (let ((else #f)) (cond (else 32) (#t 1))) 1)
(test (cond #((1 2))) 'error)
+(test (cond (/ 0)) 0) ; / is not #f, so return 0
+(test (cond (string-ref 2)) 2)
(test (let ((=> 3)) (cond (1 =>))) 3)
(test (let ((=> 3)) (cond (1 => abs))) abs)
@@ -12112,7 +21914,7 @@ this prints:
(hi 1))
1)
(test (let ((x 0))
- (cond-expand (guile (format #t ";oops~%"))
+ (cond-expand (guile (format-logged #t ";oops~%"))
(else (set! x 32)))
x)
32)
@@ -12132,6 +21934,7 @@ this prints:
(define (hi a) (+ a 1))))
(hi 1))
1)
+
(test (let ()
(cond-expand
((and s7 dfls-exponents)
@@ -12139,7 +21942,38 @@ this prints:
(else
(define (hi a) (+ a 1))))
(hi 1))
+ (if (provided? 'dfls-exponents) 1 2))
+(test (let ()
+ (cond-expand
+ ((or s7 guile)
+ (define (hi a) a))
+ (else
+ (define (hi a) (+ a 1))))
+ (hi 1))
+ 1)
+(test (let ()
+ (cond-expand
+ ((and s7 dfls-exponents unlikely-feature)
+ (define (hi a) a))
+ (else
+ (define (hi a) (+ a 1))))
+ (hi 1))
+ 2)
+(test (let ()
+ (cond-expand
+ ((and s7 (not s7)) 'oops)
+ (else 1)))
1)
+(test (let ()
+ (cond-expand
+ ("not a pair" 1)
+ (2 2)
+ (#t 3)
+ ((1 . 2) 4)
+ (() 6)
+ (list 7)
+ (else 5)))
+ 'error)
@@ -12167,16 +22001,19 @@ this prints:
(test (let ((x 1)) (case x ((1) "hi") (else "ho"))) "hi")
(test (let ((x 1)) (case x (('x) "hi") (else "ho"))) "ho")
(test (let ((x 1)) (case 'x ((x) "hi") (else "ho"))) "hi")
-(test (case '() ((()) 1)) 1)
-;;; but not (case #() ((#()) 1)) because (eqv? #() #()) is #f
-(test (let ((x '(1))) (eval `(case ',x ((,x) 1) (else 0)))) 1) ; but we can overcome that!
+(test (case () ((()) 1)) 1)
+(test (case #() ((#()) 1) (else 2)) 2)
+(test (let ((x '(1))) (eval `(case ',x ((,x) 1) (else 0)))) 1) ; but we can overcome that! (also via apply)
(test (let ((x #())) (eval `(case ',x ((,x) 1) (else 0)))) 1)
(test (case ''2 (('2) 1) (else 0)) 0)
+(test (let ((otherwise else)) (case 1 ((0) 123) (otherwise 321))) 321)
+(test (case 1 ((0) 123) (#t 321)) 'error)
(test (case else ((#f) 2) ((#t) 3) ((else) 4) (else 5)) 5) ; (eqv? 'else else) is #f (Guile says "unbound variable: else")
(test (case #t ((#f) 2) ((else) 4) (else 5)) 5) ; else is a symbol here
(test (equal? (case 0 ((0) else)) else) #t)
(test (cond ((case 0 ((0) else)) 1)) 1)
+;(test (let () (case (define b 3) ((b) b))) 3) ; changed define 25-Jul-14
(test (let ((x 1)) (case x ((2) 3) (else (* x 2) (+ x 3)))) 4)
(test (let ((x 1)) (case x ((1) (* x 2) (+ x 3)) (else 32))) 4)
@@ -12186,13 +22023,13 @@ this prints:
(test (let((x 1))(case x((2)3)(else(let()(set! x(* x 2)))(+ x 3)))) 5)
(test (let ((x 1)) (case x ((2) 3) (else 4) (else 5))) 'error)
-(test (case '() ((()) 2) (else 1)) 2) ; car: (), value: (), eqv: 1, null: 1 1
-(test (case '() (('()) 2) (else 1)) 1) ; car: (quote ()), value: (), eqv: 0, null: 0 1
+(test (case () ((()) 2) (else 1)) 2) ; car: (), value: (), eqv: 1, null: 1 1
+(test (case () (('()) 2) (else 1)) 1) ; car: (quote ()), value: (), eqv: 0, null: 0 1
(test (case () (('()) 2) (else 1)) 1) ; car: (quote ()), value: (), eqv: 0, null: 0 1
(test (case () ((()) 2) (else 1)) 2) ; car: (), value: (), eqv: 1, null: 1 1
-;;; this is a difference between '() and () ?
-;;; (eqv? '() '()) -> #t and (eqv? '() ()) is #t so it's the lack of evaluation in the search case whereas the index is evaluated
+;;; this is a difference between () and () ?
+;;; (eqv? () ()) -> #t and (eqv? () ()) is #t so it's the lack of evaluation in the search case whereas the index is evaluated
;;; equivalent to:
(test (case 2 (('2) 3) (else 1)) 1) ; car: (quote 2), value: 2, eqv: 0, null: 0 0
@@ -12209,35 +22046,65 @@ this prints:
(test (let ((x 1)) (case x ((0) (set! x 12)) ((2) (set! x 32))) x) 1)
(test (case 1 (else #f)) #f)
-(test (case 1 ((1 2) (let ((case 3)) (+ case 1))) ((3 4) 0)) 4)
(test (let () (case 0 ((0) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 1)
(test (let () (case 1 ((0) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 2)
-(test (let () (case (define (hi a) a) ((hi) (hi 1)))) 1)
+;(test (let () (case (define (hi a) a) ((hi) (hi 1)))) 1) ; 25-Jul-14
(for-each
(lambda (arg)
(test (case 1 ((0) 'gad) ((1 2 3) arg) (else 'gad)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (case arg ((0) 'gad) ((1 2 3) arg) (else 'gad)) 'gad))
- (list "hi" -1 #\a 0 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (call/cc (lambda (r) (case 1 ((1) (r 123) #t) (else #f)))) 123)
(test (call/cc (lambda (r) (case 1 ((0) 0) (else (r 123) #f)))) 123)
-(test (case '() ((1) 1) ('() 2)) 2)
+(test (case () ((1) 1) ('() 2)) 2)
(test (case (list) ((1) 1) ('() 2)) 2)
-(test (case '() ((1) 1) ((()) 2)) 2)
+(test (case () ((1) 1) ((()) 2)) 2)
(test (case (list) ((1) 1) ((()) 2)) 2)
(test (case #<eof> ((#<eof>) 1)) 1)
(test (case #\newline ((#\newline) 1)) 1)
+(test (case 'c (else => (lambda (x) (symbol? x)))) #t)
+(test (case 1.0 ((1e0) 3) ((1.0) 4) (else 5)) 3)
+(test (case 1.0 ((#i1) 2) ((1e0) 3) ((1.0) 4) (else 5)) 2)
+(test (case 1 ((#i1) 2) ((1e0) 3) ((1.0) 4) (else 5)) 5)
-; case use eqv? -- why not case-equal?
+(let ()
+ (define (c1 x)
+ (case x
+ ((3001) 1)
+ ((12345) 2)
+ ((8589934592) 3)
+ (else 4)))
+ (test (c1 3001) 1)
+ (test (c1 12345) 2)
+ (test (c1 8589934592) 3)
+ (test (c1 -1) 4)
+
+ (define (c2 x)
+ (case x
+ ((0 1 -1) 3)
+ ((9223372036854775807 -9223372036854775808) 4)
+ ((1.5) 5)
+ ((2/3 1+i) 6)))
+
+ (test (c2 -1) 3)
+ (test (c2 most-positive-fixnum) 4)
+ (test (c2 1.5) 5)
+ (test (c2 2/3) 6)
+ (test (c2 1+i) 6))
+
+; case uses eqv? -- why not case-equal?
(test (case "" (("") 1)) #<unspecified>)
(test (case abs ((abs) 1)) #<unspecified>)
+(test (case (if #f #f) ((1) 1) ((#<unspecified>) 2) (else 3)) 2)
+(test (case) 'error)
(test (case 1) 'error)
(test (case 1 . "hi") 'error)
(test (case 1 ("hi")) 'error)
@@ -12249,7 +22116,9 @@ this prints:
(test (case 1 . 1) 'error)
(test (case 1 (#t #f) ((1) #t)) 'error)
(test (case 1 (#t #f)) 'error)
-(test (case -1 ((-1) => abs)) 'error)
+(test (case -1 ((-1) => abs)) 1)
+(test (case 1 (else =>)) 'error)
+(test (case 1 (else => + - *)) 'error)
(test (case #t ((1 2) (3 4)) -1) 'error)
(test (case 1 1) 'error)
(test (case 1 ((2) 1) . 1) 'error)
@@ -12265,24 +22134,36 @@ this prints:
(test (case 1 ((1 2)) (else 3)) 'error)
(test (case 1 ('(1 2) 3) (else 4)) 4)
(test (case 1 (('1 2) 3) (else 4)) 4)
-;;; (test (case 1 ((1 . 2) 3) (else 4)) 'error) ; ?? in guile it's an error
-;;; (test (case 1 ((1 2 . 3) 3) (else 4)) 'error)
+(test (case 1 ((1 . 2) 3) (else 4)) 'error) ; ?? in guile it's an error
+(test (case 1 ((1 2 . 3) 3) (else 4)) 'error)
(test (case 1 (('1 . 2) 3) (else 4)) 'error)
(test (case 1 ((1 . (2)) 3) (else 4)) 3)
(test (case 1 ((1 2) . (3)) (else 4)) 3)
(test (case 1 ((2) 3) (else)) 'error)
(test (case 1 ((2) 3) ()) 'error)
(test (case 1 ((2) 3) (() 2)) 'error) ; ?? in Guile this is #<unspecified>; our error is confusing: ;case clause key list () is not a list or 'else'
-(test (case '() ('() 2)) 2) ; ?? error??
-(test (case '() ((()) 2)) 2)
+(test (case () ('() 2)) 2) ; ?? error??
+(test (case () ((()) 2)) 2)
(test (case 1 else) 'error)
(test (case 1 (((1) 1) 2) (else 3)) 2) ; the (1) can't be matched -- should it be an error?
(test (case 1 ((1) . (else 3))) 3) ; ?? guile says "unbound variable: else"
(test (case . (1 ((2) 3) ((1) 2))) 2)
(test (case 1 (#(1 2) 3)) 'error)
(test (case 1 #((1 2) 3)) 'error)
+(test (case 1 ((2) 3) () ((1) 2)) 'error)
+(test (case 1 ((2) 3) (1 2) ((1) 2)) 'error)
+(test (case 1 ((2) 3) (1 . 2) ((1) 2)) 'error)
+(test (case 1 ((2) 3) (1) ((1) 2)) 'error)
+(test (case 1 ((2) 3) ((1)) ((1) 2)) 'error)
+(test (case 1 ((1) 2) ((1) 3)) 2) ; should this be an errror?
+(test (let () (define-macro (mac x) `(+ ,x 1)) (case 1 ((1) => mac))) 2)
+
+(let ()
+ (define (hi x) (case x ((a) 'a) ((b) 'b) (else 'c)))
+ (test (hi 'a) 'a)
+ (test (hi 'd) 'c))
-(test (case case ((case) 1) ((cond) 3)) 1)
+(test (case 'case ((case) 1) ((cond) 3)) 1)
(test (case 101 ((0 1 2) 200) ((3 4 5 6) 600) ((7) 700) ((8) 800) ((9 10 11 12 13) 1300) ((14 15 16) 1600) ((17 18 19 20) 2000) ((21 22 23 24 25) 2500) ((26 27 28 29) 2900) ((30 31 32) 3200) ((33 34 35) 3500) ((36 37 38 39) 3900) ((40) 4000) ((41 42) 4200) ((43) 4300) ((44 45 46) 4600) ((47 48 49 50 51) 5100) ((52 53 54) 5400) ((55) 5500) ((56 57) 5700) ((58 59 60) 6000) ((61 62) 6200) ((63 64 65) 6500) ((66 67 68 69) 6900) ((70 71 72 73) 7300) ((74 75 76 77) 7700) ((78 79 80) 8000) ((81) 8100) ((82 83) 8300) ((84 85 86 87) 8700) ((88 89 90 91 92) 9200) ((93 94 95) 9500) ((96 97 98) 9800) ((99) 9900) ((100 101 102) 10200) ((103 104 105 106 107) 10700) ((108 109) 10900) ((110 111) 11100) ((112 113 114 115) 11500) ((116) 11600) ((117) 11700) ((118) 11800) ((119 120) 12000) ((121 122 123 124 125) 12500) ((126 127) 12700) ((128) 12800) ((129 130) 13000) ((131 132) 13200) ((133 134 135 136) 13600) ((137 138) 13800)) 10200)
(test (case most-positive-fixnum ((-1231234) 0) ((9223372036854775807) 1) (else 2)) 1)
(test (case most-negative-fixnum ((123123123) 0) ((-9223372036854775808) 1) (else 2)) 1)
@@ -12293,15 +22174,73 @@ this prints:
(test (case 3 ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 4)
(test (case 0 ((values 0 1) 2) (else 3)) 2)
-(test (let ((else 3)) (case 0 ((1) 2) (else 3))) 'error) ; also if else is set!
+(test (let ((else 3)) (case 0 ((1) 2) (else 3))) 3) ; changed my mind about this -- else is not evaluated here unless it's some other symbol
+(test (let ((otherwise else)) (case 0 ((1) 2) (otherwise 3))) 3) ; maybe this isn't a great idea...
(test (let ((else 3)) (case else ((3) else))) 3)
+(test (case 0 ((1) 2) (else (let ((else 3)) else))) 3)
(test (case 0 ((1) #t) ((2 else 3) #f) ((0) 0)) 0) ; should this be an error? (it isn't in Guile)
(test (case 0 ((1) #t) ((else) #f) ((0) 0)) 0)
+(test (apply case 1 '(((0) -1) ((1) 2))) 2)
+(test (let ((x #(1))) (apply case x (list (list (list #()) 1) (list (list #(1)) 2) (list (list x) 3) (list 'else 4)))) 3)
+
(test (let ((x 0)) (let ((y (case 1 ((2) (set! x (+ x 3))) ((1) (set! x (+ x 4)) (+ x 2))))) (list x y))) '(4 6))
+(let ()
+ (define (hi a)
+ (case a
+ ((0) 1)
+ ((1) 2)
+ (else 3)))
+ (test (hi 1) 2)
+ (test (hi 2) 3)
+ (test (hi "hi") 3))
+
+(if with-bignums
+ (begin
+ (test (case 8819522415901031498123 ((1) 2) ((8819522415901031498123) 3) (else 4)) 3)
+ (test (case -9223372036854775809 ((1 9223372036854775807) 2) (else 3)) 3)
+ ))
;;; one thing that will hang case I think: circular key list
+;;; C-style case
+(define-macro (switch selector . clauses)
+ `(call-with-exit
+ (lambda (break)
+ (case ,selector
+ ,@(do ((clause clauses (cdr clause))
+ (new-clauses ()))
+ ((null? clause) (reverse new-clauses))
+ (set! new-clauses (cons `(,(caar clause)
+ ,@(cdar clause)
+ ,@(map (lambda (nc)
+ (apply values (cdr nc)))
+ (if (pair? clause) (cdr clause) ())))
+ new-clauses)))))))
+
+(test (switch 1 ((1) (break 1)) ((2) 3) (else 4)) 1)
+(test (switch 2 ((1) (break 1)) ((2) 3) (else 4)) 4)
+(test (switch 4 ((1) (break 1)) ((2) 3) (else 4)) 4)
+
+(let ()
+ (call-with-output-file "test.scm"
+ (lambda (p)
+ (format p "(define (big-cond x)~%")
+ (format p " (cond~%")
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (format p " ((= x ~D) x)~%" i))
+ (format p " ))~%~%")
+ (format p "(define (big-case x)~%")
+ (format p " (case x~%")
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (format p " ((~D) x)~%" i))
+ (format p " ))~%~%")))
+ (load "test.scm" (curlet))
+ (test (big-cond 541) 541)
+ (test (big-case 541) 541))
+
;;; --------------------------------------------------------------------------------
@@ -12325,7 +22264,18 @@ this prints:
(test (let ((x 5)) (define foo (lambda (y) (bar x y))) (define bar (lambda (a b) (+ (* a b) a))) (foo (+ x 3))) 45)
(test (let ((x 5)) (letrec ((foo (lambda (y) (bar x y))) (bar (lambda (a b) (+ (* a b) a)))) (foo (+ x 3)))) 45)
+
(num-test (let () (define compose (lambda (f g) (lambda args (f (apply g args))))) ((compose sqrt *) 12 75)) 30.0)
+(let ()
+ (define (compose . args) ; this just removes parens
+ (if (procedure? (car args))
+ (if (null? (cdr args))
+ ((car args))
+ ((car args) (apply compose (cdr args))))
+ (apply values args)))
+ (test (compose - + (lambda (a b c) (values a (* b c))) 2 3 4) -14)
+ (test (- (+ ((lambda (a b c) (values a (* b c))) 2 3 4))) -14)) ; I prefer this
+
(test (let ((f (lambda () (lambda (x y) (+ x y))))) ((f) 1 2)) 3)
(test ((lambda (x) (define y 4) (+ x y)) 1) 5)
(test ((lambda(x)(define y 4)(+ x y))1) 5)
@@ -12352,7 +22302,7 @@ this prints:
(for-each
(lambda (arg)
(test ((lambda (x) x) arg) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(let ((list-length
(lambda (obj)
@@ -12381,11 +22331,10 @@ this prints:
(vector 0 2 4 6 8 10 12 14 16 18 20))
(test ((lambda (x . y) y) 1 2 '(3 . 4)) '(2 (3 . 4)))
-(test ((lambda (x . y) y) 1) '())
-(test ((lambda x x) '()) '(()))
-(test ((lambda x x)) '())
-(test ((lambda (x) x) '()) '())
-(test (let ((lambda 4)) (+ lambda 1)) 5)
+(test ((lambda (x . y) y) 1) ())
+(test ((lambda x x) ()) '(()))
+(test ((lambda x x)) ())
+(test ((lambda (x) x) ()) ())
(test ((lambda (x) (+ x ((lambda (x) (+ x 1)) 2))) 3) 6)
(test ((lambda (x) (define y 1) (+ x y)) 2) 3)
(test ((lambda (a) "this is a doc string" a) 1) 1)
@@ -12393,9 +22342,6 @@ this prints:
(test (let ((g (lambda () '3))) (= (g) 3)) #t)
(test ((((lambda () lambda)) () 1)) 1)
-(test ((lambda lambda lambda) 'x) '(x))
- ;(test ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda)) 3)
-
(test (let () ; PLP Scott p168
(define A
(lambda ()
@@ -12453,6 +22399,46 @@ this prints:
((vector-ref funcs 2))))
6)
+(test (let ((funcs (make-vector 3 #f)))
+ (for-each
+ (lambda (i)
+ (vector-set! funcs i (lambda () (+ i 1))))
+ (list 0 1 2))
+ (+ ((vector-ref funcs 0))
+ ((vector-ref funcs 1))
+ ((vector-ref funcs 2))))
+ 6)
+
+(test (let ((funcs (make-vector 3 #f)))
+ (sort! (list 0 1 2)
+ (lambda (i j)
+ (vector-set! funcs i (lambda () (+ i 1)))
+ (> i j)))
+ (+ ((vector-ref funcs 0))
+ ((vector-ref funcs 1))
+ ((vector-ref funcs 2))))
+ 6)
+
+(test (let ((funcs (make-vector 3 #f)))
+ (member 4 (list 0 1 2)
+ (lambda (j i)
+ (vector-set! funcs i (lambda () (+ i 1)))
+ #f))
+ (+ ((vector-ref funcs 0))
+ ((vector-ref funcs 1))
+ ((vector-ref funcs 2))))
+ 6)
+
+(test (let ((funcs (make-vector 3 #f)))
+ (assoc 4 (list (cons 0 0) (cons 1 0) (cons 2 0))
+ (lambda (j i)
+ (vector-set! funcs i (lambda () (+ i 1)))
+ #f))
+ (+ ((vector-ref funcs 0))
+ ((vector-ref funcs 1))
+ ((vector-ref funcs 2))))
+ 6)
+
(test (let ((func #f))
(define (func1 x)
(set! func (lambda () (+ x 1))))
@@ -12539,14 +22525,21 @@ this prints:
(define hiho (function (a) (+ a 1)))
(hiho 2))
3)
-(test ((lambda (let) (let* ((letrec 1)) (+ letrec let))) 123) 124)
-(test ((lambda (let*) (let ((letrec 1)) (+ letrec let*))) 123) 124)
(test ((lambda (a b c d e f g h i j k l m n o p q r s t u v x y z)
(+ a b c d e f g h i j k l m n o p q r s t u v x y z))
1 2 3 4 5 6 7 8 9 11 12 13 14 15 16 17 18 19 21 22 23 24 25 26 27)
348)
(test ((lambda (x) "a useless string" x) 32) 32)
(test ((lambda (>< =0=? .arg.) (+ >< =0=? .arg.)) 1 2 3) 6)
+(test ((apply ((lambda () lambda)) ((lambda () (list 'a))) ((lambda () '((+ a 1))))) 3) 4)
+
+(define-constant (_?_3 a) #f)
+(let () (define (hi x) (_?_3 x)) (hi 1) (test (let ((x 1)) (hi x)) #f))
+(let () (define (_?_4 x y) x) (define (hi x) (_?_4 x (* x x (+ 1 x)))) (hi 1) (test (let ((x 1)) (hi x)) 1))
+(define-constant (_?_5 x) (if (zero? x) x (+ x (_?_5 (- x 1)))))
+(let () (define (hi x) (_?_5 x)) (hi 1) (test (let ((x 1)) (hi x)) 1))
+(let () (define (hi x) (_?_5 (_?_5 1))) (hi 1) (test (hi 1) 1))
+(let ((x 1)) (define (hi y) (set! x (* y y y))) (hi 1) (test (hi 1) 1))
(test
(let ()
@@ -12569,6 +22562,14 @@ this prints:
(test (lambda (a) ) 'error)
;; should this be an error: (lambda (a) (define x 1)) ?
(test (lambda . 1) 'error)
+(test ((lambda . (x 1))) 1)
+(test ((lambda . ((x . y) 2)) 1) 2)
+(test ((lambda (x) . (x)) 1) 1)
+(test ((lambda . ((x) . (x))) 1) 1)
+(test ((lambda . (x . (x))) 1) '(1))
+(test ((lambda . ((x . ()) x)) 1) 1)
+(test (eval-string "((lambda . (x 1 . 3)) 1)") 'error)
+
(test (lambda 1) 'error)
(test (lambda (x 1) x) 'error)
(test (lambda "hi" 1) 'error)
@@ -12588,6 +22589,10 @@ this prints:
(test ((lambda ("x") x)) 'error)
(test ((lambda "x" x)) 'error)
(test ((lambda (x . "hi") x)) 'error)
+(test (lambda ((:hi . "hi") . "hi") 1) 'error)
+(test ((lambda (x) (* quote ((x . 1) . 2))) 1) 'error)
+(test ((lambda* (a (quote . -1)) a)) 'error)
+
(test (let ((hi (lambda (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error)
(test (object->string
((lambda (arg)
@@ -12598,7 +22603,8 @@ this prints:
(list arg
(list (quote quote)
arg))))))
- "(#1=(lambda (arg) (list arg (list 'quote arg))) '#1#)")
+ "((lambda (arg) (list arg (list 'quote arg))) '(lambda (arg) (list arg (list 'quote arg))))")
+ ;; was "(#1=(lambda (arg) (list arg (list 'quote arg))) '#1#)"
(test ((apply lambda '((a) (+ a 1))) 2) 3)
(test ((apply lambda '(() #f))) #f)
@@ -12606,16 +22612,63 @@ this prints:
(test ((apply lambda* '((a (b 1)) (+ a b))) 3 4) 7)
(test ((apply lambda* '((a (b 1)) (+ a b))) 3) 4)
+(let ()
+ (define-macro (progv vars vals . body)
+ `(apply (apply lambda ,vars ',body) ,vals))
+ (test (let ((s '(one two)) (v '(1 2))) (progv s v (+ one two))) 3)
+ (test (progv '(one two) '(1 2) (+ one two)) 3))
+
(test (lambda #(a b) a) 'error)
(test (lambda* (#(a 1)) a) 'error)
(test ((lambda (a) a) #<eof>) #<eof>)
(test ((lambda () (let ((a #<undefined>)) a))) #<undefined>)
+(test (let () (define* (foo (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c)) (foo :b 2 :a 60)) '(60 2 67))
+(test (let () (define* (f1 (a 0) (b (* 2 a))) (+ a b)) (f1 2)) 6) ; this used to be 2
+;; one oddness:
+(test (let () (define* (f1 (a (* b 2)) (b 3)) (list a b)) (f1 :b 1)) '(2 1))
+;; (f1) however would be an error? or should we preset args if we can?
+
(let ()
- (define (hi a) (+ a x))
- (test ((apply let '((x 32)) (list (procedure-source hi))) 12) 44))
-;; i.e. make a closure from (let ((x 32)) <procedure-source hi>)
+ (define* (f1 (a (+ b 1)) (b (+ a 1))) (list a b))
+ (test (f1 1) '(1 2))
+ (test (f1 :b 1) '(2 1))
+ (test (f1 :b 0 :a 1) '(1 0))
+ (test (f1 :a 1) '(1 2))
+ (test (f1 2 3) '(2 3))
+ (test (f1) 'error))
+
+(let ()
+ (define* (f1 (a (if (number? b) (+ b 1) 3)) (b (+ a 1))) (list a b))
+ (test (f1) '(3 4)))
+
+(let ()
+ (define* (f1 (a 1) (b (+ a 1))) (+ a b))
+ (define* (f2 (a (f1))) a)
+ (test (f2) 3))
+
+(let ()
+ (define* (f1 (a 1) (b (+ a 1))) (+ a b))
+ (define* (f2 (a (f1)) (b (f1 2))) (list a b))
+ (test (f2) '(3 5)))
+
+(let ()
+ (define-macro (define-f*xpr name-and-args . body)
+ `(define ,(car name-and-args)
+ (apply define-expansion
+ (append (list (append (list (gensym)) ',(cdr name-and-args))) ',body))))
+
+ (define-f*xpr (quoth x) x)
+ (test (quoth a) 'a)
+ (test (quoth (+ 1 2)) '(+ 1 2))
+
+ (define-f*xpr (mac a) `(+ ,a 1))
+ (test (mac (* 2 3)) '(+ (* 2 3) 1))
+
+ (define-f*xpr (mac1 a . b) `(, at b ,a))
+ (test (mac1 1 2 3) '(2 3 1)))
+
@@ -12623,8 +22676,9 @@ this prints:
;;; begin
;;; --------------------------------------------------------------------------------
-(test (begin) '()) ; I think Guile returns #<unspecified> here
-(test (begin (begin)) '())
+(test (begin) ()) ; I think Guile returns #<unspecified> here
+(test (begin (begin)) ())
+(test ((lambda () (begin))) ())
(test (let () (begin) #f) #f)
(test (let () (begin (begin (begin (begin)))) #f) #f)
(test (let () (begin (define x 2) (define y 1)) (+ x y)) 3)
@@ -12643,6 +22697,7 @@ this prints:
(test (begin . ()) (begin))
(test (begin . 1) 'error)
(test (begin 1 . 2) 'error)
+(test (begin ("hi" 1)) #\i)
(if (equal? (begin 1) 1)
(begin
@@ -12664,12 +22719,11 @@ this prints:
(for-each
(lambda (arg)
(test (begin arg) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (if (= 1 1) (begin 2) (begin 3)) 2)
))
-(test (let ((begin 3)) (+ begin 1)) 4)
(test ((lambda (x) (begin (set! x 1) (let ((a x)) (+ a 1)))) 2) 2)
;;; apparently these can be considered errors or not (guile says error, stklos and gauche do not)
(test (begin (define x 0) (+ x 1)) 1)
@@ -12703,37 +22757,45 @@ this prints:
(test (apply (lambda (a b) (+ a b)) (list 3 4)) 7)
(test (apply + 10 (list 3 4)) 17)
-(test (apply list '()) '())
+(test (apply list ()) ())
(test (apply + '(1 2)) 3)
(test (apply - '(1 2)) -1)
(test (apply max 3 5 '(2 7 3)) 7)
(test (apply cons '((+ 2 3) 4)) '((+ 2 3) . 4))
-(test (apply + '()) 0)
+(test (apply + ()) 0)
(test (apply + (list 3 4)) 7)
-(test (apply + '()) 0)
+(test (apply + ()) 0)
(test (apply + 2 '(3)) 5)
-(test (apply + 2 3 '()) 5)
+(test (apply + 2 3 ()) 5)
(test (apply + '(2 3)) 5)
(test (apply list 1 '(2 3)) (list 1 2 3))
(test (apply apply (list list 1 2 '(3))) (list 1 2 3))
(test (vector? (apply make-vector '(1))) #t)
-(test (apply make-vector '(1 1)) '#(1))
-(test (apply make-vector '((1) 1)) '#(1))
+(test (apply make-vector '(1 1)) #(1))
+(test (apply make-vector '((1) 1)) #(1))
(test (let ((f +)) (apply f '(1 2))) 3)
-(test (let* ((x '(1 2 3)) (y (apply list x))) (eq? x y)) #t) ; is this standard? -- no, Guile says #f
(test (apply min '(1 2 3 5 4 0 9)) 0)
(test (apply min 1 2 4 3 '(4 0 9)) 0)
-(test (apply vector 1 2 '(3)) '#(1 2 3))
+(test (apply vector 1 2 '(3)) #(1 2 3))
+(test (apply vector ()) #())
(test (apply (lambda (x . y) x) (list 1 2 3)) 1)
(test (apply * (list 2 (apply + 1 2 '(3)))) 12)
(test (apply (if (> 3 2) + -) '(3 2)) 5)
-(test (let ((x (list 1 2))) (eq? x (append '() x))) #t) ;; ?? guile says #t also
+(test (let ((x (list 1 2))) (eq? x (append () x))) #t) ;; ?? guile says #t also
(test (apply (lambda* args args) 1 2 3 '(4 5 6 (7))) '(1 2 3 4 5 6 (7))) ; from lisp bboard
+(test (apply (list 1 2) '(0)) 1)
+
+(test (apply (cons 1 2) '(0)) 1) ; ! (apply (cons 1 2) '(1)) is an error
+(test (procedure? apply) #t)
+(test (help apply) "(apply func ...) applies func to the rest of the arguments")
+(let ((lst (list 'values 'procedure? #t))) ; values rather than #t since (+ (apply values '(1 2))) -> 3
+ (set-cdr! (cddr lst) (cddr lst))
+ (test (equal? lst (procedure-signature apply)) #t))
(for-each
(lambda (arg)
(test (apply (lambda (x) x) (list arg)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (apply cadadr (list '''4)) 4)
(test (apply string-ref "hi" '(0)) #\h)
@@ -12744,7 +22806,73 @@ this prints:
(test ((apply cdr '((1 2) (3 4)) ()) 0) '(3 4))
(test ((apply car '((1 2) (3 4)) ()) 1) 2)
(test ((apply cadr '((1 2) (3 4)) ()) 1) 4)
-
+(test (apply append ()) ())
+(test (apply apply append ()) ())
+(test (apply apply apply append '(())) ())
+(test (apply apply + ()) 0)
+(test (apply apply * ()) 1)
+(test (apply apply not not () ()) #f)
+(test (apply apply apply eq? eq? eq? () () ()) #t)
+(test (apply apply apply list list list () () ()) (list list list))
+(test (apply apply vector cons (list '1 '2) ()) (vector cons 1 2))
+
+(test (let ((x '(((1 2)) ((3 4))))) (catch #t (lambda () (apply apply apply apply x)) (lambda args 'error)) x) '(((1 2)) ((3 4))))
+(test (let ((x '((1 2) (3 4)))) (catch #t (lambda () (apply apply apply apply x)) (lambda args 'error)) x) '((1 2) (3 4)))
+(test (let ((x '((1 2) 3 4))) (catch #t (lambda () (apply apply apply x)) (lambda args 'error)) x) '((1 2) 3 4))
+(test (let ((x '((1 2) (3 4)))) (catch #t (lambda () (apply apply apply not x)) (lambda args 'error)) x) '((1 2) (3 4)))
+
+(test (eq? (apply apply apply values '(())) #<unspecified>) #t)
+(test (eqv? (apply apply apply values '(())) #<unspecified>) #t)
+(test (equal? (apply apply apply values '(())) #<unspecified>) #t)
+
+(test (apply apply apply + '(((1)))) 1)
+(test (apply apply map + '(((1)))) '(1))
+(test (apply apply map quote '(((1)))) '(1))
+(test (apply apply map values '(((1)) ((2)))) '((1) 2))
+(test (apply apply map append '(((1)) ((2)))) '((1 . 2)))
+(test (apply apply apply quote '(((1)))) 1)
+(test (apply map cdr '(((1 2) (3 4)))) '((2) (4)))
+(test (apply apply + '((1 2))) 3)
+(test (apply apply cons '(((1 2) (3 4)))) '((1 2) 3 4))
+(test (apply apply append '(((1 2) (3 4)))) '(1 2 3 4))
+(test (apply map + '((1 2) (3 4))) '(4 6))
+(test (apply map reverse '(((1 2) (3 4)))) '((2 1) (4 3)))
+(test (apply apply map cons '(((1 2) (3 4)))) '((1 . 3) (2 . 4)))
+(test (apply apply map list-tail '(((1 2) (3 4))) '(((1)))) '(((3 4))))
+(test (apply apply map reverse '((1 2) (3 4)) '(())) '((2 1) (4 3)))
+(test (apply apply map values '(((1)) ((2))) '(((1 2) (3 4)))) '(((1)) 1 3 ((2)) 2 4))
+(test (apply apply map append '(((1 2) (3 4))) '(((1)) ((2)))) '(((1 2) (3 4) 1 . 2)))
+(test (apply apply map append '(()) '(((1)) ((2)))) '((1 . 2)))
+(test (apply apply map cdr '(((1 2) (3 4))) ()) '((2) (4)))
+(test (apply apply apply list-tail '((1 2) (3 4)) '(((1)))) '((3 4)))
+(test (apply apply apply reverse '(((1 2) (3 4))) '(())) '((3 4) (1 2)))
+(test (apply apply apply values '(1) '(())) 1)
+(test (apply apply apply values '(1) '((()))) '(1))
+(test (apply apply apply values '((1)) ()) 1)
+(test (apply apply apply values '((1)) '(())) '(1))
+(test (apply apply reverse '(((1 2) (3 4))) ()) '((3 4) (1 2)))
+(test (apply apply append () '(((1 2) (3 4)))) '(1 2 3 4))
+(test (apply apply length '(()) ()) 0)
+(test (apply apply let () '((1))) 1)
+(test (apply apply apply apply + '((()))) 0)
+(test (apply apply apply map reverse '((1 2) (3 4)) '((()))) '((2 1) (4 3)))
+(test (apply apply apply map values '(((1 2) (3 4))) ()) '(1 3 2 4))
+(test (apply apply apply apply + '(1) '((()))) 1)
+
+(test (apply apply apply append (reverse '(((1)) ((2))))) '((2) . 1))
+(test (apply apply map append (reverse '(((1)) ((2))))) '((2 . 1)))
+(test (apply (apply apply lambda (quote '(1)))) 1)
+(test (apply quote (map reverse (reverse '((1 2))))) '(2 1))
+(test (map quote (apply map + '((1 2) (3 4)))) '(4 6))
+(test (map car (apply map quote '(((1 2) (3 4))))) '(1 3))
+(test (apply length (apply map append '(((1)) ((2))) '((1)))) -1)
+(test (apply append (apply map list-tail '(((1 2) (3 4))) '((1)))) '((3 4)))
+(test (apply append (apply map values '(((1)) ((2))) '(((1 2) (3 4))))) '((1) 1 2 (2) 3 4))
+(test (apply append (apply map values '((1 2) (3 4)) '(((1 2) (3 4))))) '(1 2 1 2 3 4 3 4))
+(test (apply append '((1) () (2 3 4) (5 6) ())) '(1 2 3 4 5 6))
+(test (apply append '((1) () (2 3 4) (5 6) 7)) '(1 2 3 4 5 6 . 7))
+
+(test (apply +) 0)
(test (apply + #f) 'error)
(test (apply #f '(2 3)) 'error)
(test (apply make-vector '(1 2 3)) 'error)
@@ -12755,10 +22883,33 @@ this prints:
(test (apply car ''foo) 'error)
(test (apply + '(1 . 2)) 'error)
(test (apply + '(1 2 . 3)) 'error)
-(test (apply '() '()) 'error)
-(test (apply list '(1 . 2) '()) '((1 . 2)))
-(test (apply (lambda (x) x) _ht_) 'error)
-(test (apply + '#(1 2 3)) 'error)
+(test (apply () ()) 'error)
+(test (apply list '(1 . 2) ()) '((1 . 2)))
+(test (apply (lambda (x) x) _ht_ _null_ _c_obj_) 'error)
+(test (apply + #(1 2 3)) 'error)
+(test (apply (lambda (a b) (+ a b)) '(1 . 2)) 'error)
+(test (apply (lambda args (apply + args)) 1 2 3) 'error)
+(test (apply (lambda args (apply + args)) 1 2 #f) 'error)
+(test (apply (lambda args (apply list args)) 1 2 #f) 'error)
+(test (apply (lambda args (apply + args)) 1 2 ()) 3)
+(test (apply (lambda args (apply list args)) 1 2 ()) '(1 2))
+(test (apply (lambda args (apply list args)) 1 '(2)) '(1 2))
+(test (apply (lambda args (apply list args)) 1 '2) 'error)
+(test (apply (lambda args (apply list args)) 1 'abs) 'error)
+(test (apply (lambda args (apply list args)) 1 ''2) '(1 quote 2))
+(test (apply (lambda args (apply list args)) () ()) '(()))
+(test (apply (lambda args (apply list args)) () (cons 1 2)) 'error)
+(test (apply (lambda args (apply list args)) (cons 1 2)) 'error)
+
+(test (apply "hi" '(1 2)) 'error)
+(test ("hi" 1 2) 'error)
+(test (apply '(1 2) '(1 2)) 'error)
+(test ((list 1 2 3) 1 2) 'error)
+
+(test (apply "hi" '(1)) #\i)
+(test ("hi" 1) #\i)
+(test (apply '(1 2) '(1)) 2)
+(test ((list 1 2 3) 1) 2)
(for-each
(lambda (arg)
@@ -12782,13 +22933,17 @@ this prints:
(set! (cdr (cddr lst)) lst)
(test (apply + lst) 'error))
+(test (let ((lst '(1 2 3))) (let ((lst1 (apply list lst))) (set! (car lst1) 21) lst)) '(1 2 3))
+(test (let ((lst '(1 2))) (let ((lst1 (apply cons lst))) (set! (car lst1) 21) lst)) '(1 2))
+(test (let* ((x '(1 2 3)) (y (apply list x))) (eq? x y)) #f) ; this was #t until 26-Sep-11
+
(test (apply values (values (cons 1 ()))) 1)
(test (+ (apply values (values (list 1 2)))) 3)
(test (port-filename) (apply port-filename (list)))
(num-test (apply atan (#(1 #\a (3)) (max (values 1 2)))) 1.2490457723983)
(test (apply #2D((1 2) (3 4)) (list (floor (acosh 1)))) #(1 2))
(test ((apply values (list + 1 2)) 3) 6)
-(num-test (* 0-2i (acosh (asin 0.0))) pi)
+(if with-complex (num-test (* 0-2i (acosh (asin 0.0))) pi))
(test (apply truncate (lognot (min 1)) (list)) -2)
(num-test (apply /(list 11 11)) 1)
@@ -12797,25 +22952,28 @@ this prints:
(test (apply call-with-exit (list (lambda (exit) (exit 1) 32))) 1)
(test (apply catch (list #t (lambda () 1) (lambda args 'error))) 1)
(test (apply eval '((+ 1 2))) 3)
-(test (apply eval '()) 'error) ; (eval) is an error -- should it be? (eval ()) is ()
-(test (apply eval '(())) '())
+(test (apply eval ()) 'error) ; (eval) is an error -- should it be? (eval ()) is () so perhaps (following values), (eval) -> #<unspecified>?
+(test (apply eval '(())) ())
(test (apply eval-string '("(+ 1 2)")) 3)
(test (let () (apply begin '((define x 1) (define y x) (+ x y)))) 2)
-(test (apply begin '()) (begin))
+(test (apply begin ()) (begin))
(test (apply if '(#f 1 2)) 2)
+(test (apply if '(#f)) 'error)
(test (let ((x 1)) (apply set! '(x 3)) x) 3)
(test (let ((x 3)) (apply set! (list (values 'x 32))) x) 32)
(test (let ((x 1)) (apply cond '(((= x 2) 3) ((= x 1) 32)))) 32)
(test (apply and '((= 1 1) (> 2 3))) #f)
-(test (apply and '()) (and))
+(test (apply and ()) (and))
(test (apply or '((= 1 1) (> 2 3))) #t)
-(test (apply or '()) (or))
+(test (apply or ()) (or))
(test (let () (apply define '(x 32)) x) 32)
(test (let () (apply define* '((hi (a 1) (b 2)) (+ a b))) (hi 32)) 34)
(test ((apply lambda '((n) (+ n 1))) 2) 3)
(test ((apply lambda* '(((n 1)) (+ n 1)))) 2)
(test (apply let '(((x 1)) (+ x 2))) 3)
(test (apply let* '(((x 1) (y (* 2 x))) (+ x y))) 3)
+(test (equal? (apply let* '((a 2) (b (+ a 3))) '(list + a b) ()) (list + 2 5)) #t)
+(test (apply let 'func '((i 1) (j 2)) '((+ i j (if (> i 0) (func (- i 1) j) 0)))) 5)
(test (let () (apply define-macro `((hiho a) `(+ ,a 1))) (hiho 2)) 3)
(test (let () (apply defmacro `(hiho (a) `(+ ,a 1))) (hiho 2)) 3)
(test (let () (apply defmacro* `(hiho ((a 2)) `(+ ,a 1))) (hiho)) 3)
@@ -12824,13 +22982,33 @@ this prints:
(test (apply case '(1 ((2 3) 4) ((1 5) 32))) 32)
(test (+ (apply values '(1 2 3))) 6)
(test (apply quote '(1)) 1)
-(test (apply quote '()) 'error) ; (quote) is an error
+(test (apply quote ()) 'error) ; (quote) is an error
(test (let () (apply letrec '(() (define x 9) x))) 9)
(test ((lambda (n) (apply n '(((x 1)) (+ x 2)))) let) 3)
(test ((apply lambda (list (apply let (list (list) (quote (list (apply case '(0 ((0 1) 'n))))))) (quasiquote (+ n 1)))) 2) 3)
(test (apply let '((x 1)) '((+ x 1))) 2)
-(test ((apply make-procedure-with-setter (list (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) 23) 24)
-(test (apply (apply make-procedure-with-setter (list (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) '(23)) 24)
+(test ((apply dilambda (list (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) 23) 24)
+(test (apply (apply dilambda (list (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) '(23)) 24)
+(test (apply map list '((1 one) (2 two) (3 three))) '((1 2 3) (one two three))) ; from scheme bboard
+;;; so (define (unzip l) (apply values (apply map list l)))
+
+(test (apply 'begin) 'error)
+(test (apply and) #t)
+(test (apply begin) ())
+(test (apply if '((> 1 2) 3 4)) 4)
+(test (apply or) #f)
+(test (apply quote '(1)) 1)
+
+(let ()
+ (define (min-max arg . args)
+ (if (null? args)
+ (apply max arg)
+ (min (apply max arg)
+ (apply min-max args))))
+
+ (test (min-max '(1 2 3) '(0 -1 4)) 3)
+ (test (min-max '(1 2 3) '(0 -1 4) '(1 2)) 2))
+
@@ -12873,12 +23051,13 @@ this prints:
(for-each
(lambda (arg)
(test (let () (define x arg) x) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test ((lambda (x) (define (hi a) (+ a 1)) (hi x)) 1) 2)
(test (let ((x 2)) (define f (lambda (y) (+ y x))) (f 3)) 5)
(begin (define r5rstest-plus (lambda (x y) (+ x y))) (define r5rstest-x 32))
(test (r5rstest-plus r5rstest-x 3) 35)
+(test (let ((x 2.0)) (define (hi a) (set! a 3.0)) (hi x) x) 2.0)
(test (let () (define (asdf a) (define (asdf a) (+ a 1)) (+ a (asdf a))) (asdf 4)) 9)
(test (let ((asdf 1)) (define (asdf a) (define (asdf a) (+ a 1)) (+ a (asdf a))) (asdf 4)) 9)
@@ -12900,6 +23079,9 @@ this prints:
'(2 2))
(test (procedure? (let () (define (a) a) (a))) #t)
+(let ((oddp (lambda (a) (not (even? a)))))
+ (define (hi a) (and (a 123) (a 321)))
+ (test (hi oddp) #t))
(test (define) 'error)
(test (define*) 'error)
@@ -12907,6 +23089,14 @@ this prints:
(test (define . x) 'error)
(test (define x 1 2) 'error)
(test (define x x) 'error)
+(test (define x x x) 'error)
+(test (define x x . x) 'error)
+(test (let ((x 0)) (define x (x . x))) 'error)
+(test (define (x x) . x) 'error)
+(test (eval-string "(define (x .) 1)") 'error) ; need eval-string else a read error that halts our tests
+(test (eval-string "(define (x) (+ 1 .))") 'error)
+(test (define (x x) x . x) 'error)
+(test (let () (define (x x) x) (x 0)) 0)
(test (define (x 1)) 'error)
(test (define (x)) 'error)
(test (define 1 2) 'error)
@@ -12922,10 +23112,35 @@ this prints:
(test (define (hi: a) a) 'error)
(test (define (#b1 a) a) 'error)
(test (define (hi #b1) #b1) 'error)
+(test (define () 1) 'error)
(test (let() (define #(hi a) a)) 'error)
- ;(test (define 'hi 1) 'error) ; this redefines quote, which maybe isn't an error
+(test (let () (define hi (lambda args args)) (hi 1 . 2)) 'error)
(test (let () (define . 1) 1) 'error)
(test (let () (define func (do () (#t (lambda (y) 2)))) (func 1)) 2)
+(test (let () (define* x 3)) 'error)
+(test (let () (define (hi) 1 . 2)) 'error)
+(test (let () (define (hi) (1) . "hi")) 'error)
+
+(let ()
+ (define a#b 3)
+ (define a'b 4)
+ (define a,b 5)
+ (define a[b 6)
+ (define a at b 7)
+ (define a\b 8)
+ (define a|b 9)
+ (test (+ a#b a'b a,b a[b a at b a\b a|b) 42))
+
+(let ()
+ (define (make-func) (define (a-func a) (+ a 1)))
+ (test (procedure? (make-func)) #t))
+
+(let () (test (if (and (define x 3) (define y 4)) (+ x y)) 7))
+(let () (test (if (not (and (define x 2) (define y 4))) (+ x y) (if (define x 3) x)) 3))
+(let () (test (if (and (define x 2) (not (define y 4))) (+ x y) (- x y)) -2))
+(test (let () (define (f a) (lambda () a)) (+ ((f 1)) ((f 2)))) 3)
+(test (let () (define (hi) (let ((a 1)) (set! a 2) (define (ho) a) (set! a 3) (ho))) (hi)) 3)
+;;; (define-macro (make-lambda args . body) `(apply lambda* ',args '(, at body))): (make-lambda (a b) (+ a b))
;; y combinator example from some CS website
(let ()
@@ -12960,6 +23175,43 @@ this prints:
5)
120)
+;;; from a paper by Mayer Goldberg
+(let ()
+ (define curry-fps
+ (lambda fs
+ (let ((xs
+ (map
+ (lambda (fi)
+ (lambda xs
+ (apply fi
+ (map
+ (lambda (xi)
+ (lambda args
+ (apply (apply xi xs) args)))
+ xs))))
+ fs)))
+ (map (lambda (xi)
+ (apply xi xs)) xs))))
+
+ (define E
+ (lambda (even? odd?)
+ (lambda (n)
+ (if (zero? n) #t ; return Boolean True
+ (odd? (- n 1))))))
+
+ (define O
+ (lambda (even? odd?)
+ (lambda (n)
+ (if (zero? n) #f ; return Boolean False
+ (even? (- n 1))))))
+
+ (define list-even?-odd? (curry-fps E O))
+ (define new-even? (car list-even?-odd?))
+ (define new-odd? (cadr list-even?-odd?))
+
+ (test (new-even? 6) #t)
+ (test (new-odd? 6) #f))
+
(let ()
(define (Cholesky:decomp P)
;; from Marco Maggi based on a Scheme bboard post
@@ -12967,7 +23219,7 @@ this prints:
(define (Cholesky:make-square L)
(define (zero-vector n)
(if (zero? n)
- '()
+ ()
(cons 0 (zero-vector (- n 1)))))
(map (lambda (v)
(append v (zero-vector (- (length L) (length v)))))
@@ -12975,7 +23227,7 @@ this prints:
(define (Cholesky:add-element P L i j)
(define (Cholesky:smaller P)
(if (null? (cdr P))
- '()
+ ()
(reverse (cdr (reverse P)))))
(define (Cholesky:last-row L)
(car (reverse L)))
@@ -13004,7 +23256,7 @@ this prints:
(Cholesky:last-row L)
(list (Cholesky:make-element P L i j)))))))
(Cholesky:make-square
- (let iter ((i 0) (j 0) (L '()))
+ (let iter ((i 0) (j 0) (L ()))
(if (>= i (length P))
L
(iter (if (= i j) (+ 1 i) i)
@@ -13017,7 +23269,7 @@ this prints:
(not (= (cadr lst0) 0))
(> (abs (+ (car lst1) (sqrt 2))) .0001)
(> (abs (- (cadr lst1) (sqrt 3))) .0001))
- (format #t ";cholesky decomp: ~A~%" lst))))
+ (format-logged #t ";cholesky decomp: ~A~%" lst))))
(let ()
(define* (a1 (b (let ()
@@ -13027,6 +23279,506 @@ this prints:
(test (a1) 32)
(test (a1 1) 1))
+(test (let ((x 1)) (cond (else (define x 2))) x) 2)
+(test (let ((x 1)) (and (define x 2)) x) 2)
+(test (let () (begin 1)) 1)
+(test (let () (begin (define x 1) x)) 1)
+(test (let () (let ((lst (define abc 1))) #f) abc) 1) ; ??
+(test (let () (let ((lst (define abc 1))) abc)) 1) ; abcd is in the outer let
+(test (let () (letrec ((lst (define abcd 1))) #f) abcd) 'error) ; abcd: unbound variable
+(test (let () (letrec ((lst (define abcd 1))) abcd)) 1)
+(test (let? (let () (letrec ((lst (define abcd 1))) (curlet)))) #t)
+(test (let () (letrec* ((lst (define abcd 1))) abcd)) 1) ; unproblematic because no pending value
+;(test (let () (define (f a) (if (symbol? a) b 0)) (f (define b 3))) 3) ; 25-Jul-14
+(test (let () (+ (define b 1) (* b 2))) 3)
+(test (let () (if (define b 3) b)) 3)
+(test (let () (do ((i (define b 3)) (j 0 (+ j 1))) ((= j 0) b))) 3)
+(test (let () (define* (f (a (define b 3))) a) (f) b) 'error) ; ?? where is b?
+(test (let () (define* (f (a (define b 3))) b) (f)) 3) ; inside the func apparently! 3 cases? let->outer letrec->cur, func->inner!
+;(test (let () (define* (f (a (define a 3))) a) (f)) 'a) ; yow -- no duplicate id check! 25-Jul-14
+(test (let () (define* (f (a 1) (b (define a 3))) a) (f 2)) 3)
+(test (let () (define-macro* (f (a 1) (b (define a 3))) a) (f 2)) 2) ; also bacro -- b is '(define a 3)!
+;(test (let () (letrec ((a (define a 3))) a)) 'a) ; letrec is the same (it checks normally) 25-Jul-14
+(test (let () (letrec ((a 1) (b (define a 3))) a)) 1)
+(test (let () (letrec* ((a 1) (b (define a 3))) a)) 3) ; same difference in let/let*
+(test (let () (letrec ((a 1) (b (set! a 3))) a)) 1)
+(test (let () (letrec* ((a 1) (b (set! a 3))) a)) 3) ; here the let case is an error, let* is 3
+;(test (let () (list (with-let (sublet (curlet) (cons 'b (define b 3))) b) ((curlet) 'b))) '(b 3)) ; 2 b's with 1 define
+;(test (let () (list (with-let (varlet (curlet) (cons 'b (define b 3))) b) ((curlet) 'b))) '(b b))
+
+(let ()
+ (define (f64 arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64)
+ (+ arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64))
+ (test (f64 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64)
+ 2080))
+
+#|
+(let ((n 12))
+ (let ((nums (do ((lst () (cons i lst))
+ (i 0 (+ i 1)))
+ ((> i n) (reverse lst)))))
+ (format-logged #t "(let ((f~D (lambda (~{arg~D~^ ~})~% (+ ~{arg~D~^ ~}))))~% (f~D ~{~D~^ ~}))~%" n nums nums n nums)))
+|#
+
+(test (let ((f128 (lambda (arg128 arg127 arg126 arg125 arg124 arg123 arg122 arg121 arg120 arg119 arg118 arg117 arg116 arg115 arg114 arg113 arg112 arg111 arg110 arg109 arg108 arg107 arg106 arg105 arg104 arg103 arg102 arg101 arg100 arg99 arg98 arg97 arg96 arg95 arg94 arg93 arg92 arg91 arg90 arg89 arg88 arg87 arg86 arg85 arg84 arg83 arg82 arg81 arg80 arg79 arg78 arg77 arg76 arg75 arg74 arg73 arg72 arg71 arg70 arg69 arg68 arg67 arg66 arg65 arg64 arg63 arg62 arg61 arg60 arg59 arg58 arg57 arg56 arg55 arg54 arg53 arg52 arg51 arg50 arg49 arg48 arg47 arg46 arg45 arg44 arg43 arg42 arg41 arg40 arg39 arg38 arg37 arg36 arg35 arg34 arg33 arg32 arg31 arg30 arg29 arg28 arg27 arg26 arg25 arg24 arg23 arg22 arg21 arg20 arg19 arg18 arg17 arg16 arg15 arg14 arg13 arg12 arg11 arg10 arg9 arg8 arg7 arg6 arg5 arg4 arg3 arg2 arg1 arg0)
+ (+ arg128 arg127 arg126 arg125 arg124 arg123 arg122 arg121 arg120 arg119 arg118 arg117 arg116 arg115 arg114 arg113 arg112 arg111 arg110 arg109 arg108 arg107 arg106 arg105 arg104 arg103 arg102 arg101 arg100 arg99 arg98 arg97 arg96 arg95 arg94 arg93 arg92 arg91 arg90 arg89 arg88 arg87 arg86 arg85 arg84 arg83 arg82 arg81 arg80 arg79 arg78 arg77 arg76 arg75 arg74 arg73 arg72 arg71 arg70 arg69 arg68 arg67 arg66 arg65 arg64 arg63 arg62 arg61 arg60 arg59 arg58 arg57 arg56 arg55 arg54 arg53 arg52 arg51 arg50 arg49 arg48 arg47 arg46 arg45 arg44 arg43 arg42 arg41 arg40 arg39 arg38 arg37 arg36 arg35 arg34 arg33 arg32 arg31 arg30 arg29 arg28 arg27 arg26 arg25 arg24 arg23 arg22 arg21 arg20 arg19 arg18 arg17 arg16 arg15 arg14 arg13 arg12 arg11 arg10 arg9 arg8 arg7 arg6 arg5 arg4 arg3 arg2 arg1 arg0))))
+ (f128 128 127 126 125 124 123 122 121 120 119 118 117 116 115 114 113 112 111 110 109 108 107 106 105 104 103 102 101 100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0))
+ 8256)
+
+(test (let ((f512 (lambda (arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64 arg65 arg66 arg67 arg68 arg69 arg70 arg71 arg72 arg73 arg74 arg75 arg76 arg77 arg78 arg79 arg80 arg81 arg82 arg83 arg84 arg85 arg86 arg87 arg88 arg89 arg90 arg91 arg92 arg93 arg94 arg95 arg96 arg97 arg98 arg99 arg100 arg101 arg102 arg103 arg104 arg105 arg106 arg107 arg108 arg109 arg110 arg111 arg112 arg113 arg114 arg115 arg116 arg117 arg118 arg119 arg120 arg121 arg122 arg123 arg124 arg125 arg126 arg127 arg128 arg129 arg130 arg131 arg132 arg133 arg134 arg135 arg136 arg137 arg138 arg139 arg140 arg141 arg142 arg143 arg144 arg145 arg146 arg147 arg148 arg149 arg150 arg151 arg152 arg153 arg154 arg155 arg156 arg157 arg158 arg159 arg160 arg161 arg162 arg163 arg164 arg165 arg166 arg167 arg168 arg169 arg170 arg171 arg172 arg173 arg174 arg175 arg176 arg177 arg178 arg179 arg180 arg181 arg182 arg183 arg184 arg185 arg186 arg187 arg188 arg189 arg190 arg191 arg192 arg193 arg194 arg195 arg196 arg197 arg198 arg199 arg200 arg201 arg202 arg203 arg204 arg205 arg206 arg207 arg208 arg209 arg210 arg211 arg212 arg213 arg214 arg215 arg216 arg217 arg218 arg219 arg220 arg221 arg222 arg223 arg224 arg225 arg226 arg227 arg228 arg229 arg230 arg231 arg232 arg233 arg234 arg235 arg236 arg237 arg238 arg239 arg240 arg241 arg242 arg243 arg244 arg245 arg246 arg247 arg248 arg249 arg250 arg251 arg252 arg253 arg254 arg255 arg256 arg257 arg258 arg259 arg260 arg261 arg262 arg263 arg264 arg265 arg266 arg267 arg268 arg269 arg270 arg271 arg272 arg273 arg274 arg275 arg276 arg277 arg278 arg279 arg280 arg281 arg282 arg283 arg284 arg285 arg286 arg287 arg288 arg289 arg290 arg291 arg292 arg293 arg294 arg295 arg296 arg297 arg298 arg299 arg300 arg301 arg302 arg303 arg304 arg305 arg306 arg307 arg308 arg309 arg310 arg311 arg312 arg313 arg314 arg315 arg316 arg317 arg318 arg319 arg320 arg321 arg322 arg323 arg324 arg325 arg326 arg327 arg328 arg329 arg330 arg331 arg332 arg333 arg334 arg335 arg336 arg337 arg338 arg339 arg340 arg341 arg342 arg343 arg344 arg345 arg346 arg347 arg348 arg349 arg350 arg351 arg352 arg353 arg354 arg355 arg356 arg357 arg358 arg359 arg360 arg361 arg362 arg363 arg364 arg365 arg366 arg367 arg368 arg369 arg370 arg371 arg372 arg373 arg374 arg375 arg376 arg377 arg378 arg379 arg380 arg381 arg382 arg383 arg384 arg385 arg386 arg387 arg388 arg389 arg390 arg391 arg392 arg393 arg394 arg395 arg396 arg397 arg398 arg399 arg400 arg401 arg402 arg403 arg404 arg405 arg406 arg407 arg408 arg409 arg410 arg411 arg412 arg413 arg414 arg415 arg416 arg417 arg418 arg419 arg420 arg421 arg422 arg423 arg424 arg425 arg426 arg427 arg428 arg429 arg430 arg431 arg432 arg433 arg434 arg435 arg436 arg437 arg438 arg439 arg440 arg441 arg442 arg443 arg444 arg445 arg446 arg447 arg448 arg449 arg450 arg451 arg452 arg453 arg454 arg455 arg456 arg457 arg458 arg459 arg460 arg461 arg462 arg463 arg464 arg465 arg466 arg467 arg468 arg469 arg470 arg471 arg472 arg473 arg474 arg475 arg476 arg477 arg478 arg479 arg480 arg481 arg482 arg483 arg484 arg485 arg486 arg487 arg488 arg489 arg490 arg491 arg492 arg493 arg494 arg495 arg496 arg497 arg498 arg499 arg500 arg501 arg502 arg503 arg504 arg505 arg506 arg507 arg508 arg509 arg510 arg511 arg512)
+ (+ arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64 arg65 arg66 arg67 arg68 arg69 arg70 arg71 arg72 arg73 arg74 arg75 arg76 arg77 arg78 arg79 arg80 arg81 arg82 arg83 arg84 arg85 arg86 arg87 arg88 arg89 arg90 arg91 arg92 arg93 arg94 arg95 arg96 arg97 arg98 arg99 arg100 arg101 arg102 arg103 arg104 arg105 arg106 arg107 arg108 arg109 arg110 arg111 arg112 arg113 arg114 arg115 arg116 arg117 arg118 arg119 arg120 arg121 arg122 arg123 arg124 arg125 arg126 arg127 arg128 arg129 arg130 arg131 arg132 arg133 arg134 arg135 arg136 arg137 arg138 arg139 arg140 arg141 arg142 arg143 arg144 arg145 arg146 arg147 arg148 arg149 arg150 arg151 arg152 arg153 arg154 arg155 arg156 arg157 arg158 arg159 arg160 arg161 arg162 arg163 arg164 arg165 arg166 arg167 arg168 arg169 arg170 arg171 arg172 arg173 arg174 arg175 arg176 arg177 arg178 arg179 arg180 arg181 arg182 arg183 arg184 arg185 arg186 arg187 arg188 arg189 arg190 arg191 arg192 arg193 arg194 arg195 arg196 arg197 arg198 arg199 arg200 arg201 arg202 arg203 arg204 arg205 arg206 arg207 arg208 arg209 arg210 arg211 arg212 arg213 arg214 arg215 arg216 arg217 arg218 arg219 arg220 arg221 arg222 arg223 arg224 arg225 arg226 arg227 arg228 arg229 arg230 arg231 arg232 arg233 arg234 arg235 arg236 arg237 arg238 arg239 arg240 arg241 arg242 arg243 arg244 arg245 arg246 arg247 arg248 arg249 arg250 arg251 arg252 arg253 arg254 arg255 arg256 arg257 arg258 arg259 arg260 arg261 arg262 arg263 arg264 arg265 arg266 arg267 arg268 arg269 arg270 arg271 arg272 arg273 arg274 arg275 arg276 arg277 arg278 arg279 arg280 arg281 arg282 arg283 arg284 arg285 arg286 arg287 arg288 arg289 arg290 arg291 arg292 arg293 arg294 arg295 arg296 arg297 arg298 arg299 arg300 arg301 arg302 arg303 arg304 arg305 arg306 arg307 arg308 arg309 arg310 arg311 arg312 arg313 arg314 arg315 arg316 arg317 arg318 arg319 arg320 arg321 arg322 arg323 arg324 arg325 arg326 arg327 arg328 arg329 arg330 arg331 arg332 arg333 arg334 arg335 arg336 arg337 arg338 arg339 arg340 arg341 arg342 arg343 arg344 arg345 arg346 arg347 arg348 arg349 arg350 arg351 arg352 arg353 arg354 arg355 arg356 arg357 arg358 arg359 arg360 arg361 arg362 arg363 arg364 arg365 arg366 arg367 arg368 arg369 arg370 arg371 arg372 arg373 arg374 arg375 arg376 arg377 arg378 arg379 arg380 arg381 arg382 arg383 arg384 arg385 arg386 arg387 arg388 arg389 arg390 arg391 arg392 arg393 arg394 arg395 arg396 arg397 arg398 arg399 arg400 arg401 arg402 arg403 arg404 arg405 arg406 arg407 arg408 arg409 arg410 arg411 arg412 arg413 arg414 arg415 arg416 arg417 arg418 arg419 arg420 arg421 arg422 arg423 arg424 arg425 arg426 arg427 arg428 arg429 arg430 arg431 arg432 arg433 arg434 arg435 arg436 arg437 arg438 arg439 arg440 arg441 arg442 arg443 arg444 arg445 arg446 arg447 arg448 arg449 arg450 arg451 arg452 arg453 arg454 arg455 arg456 arg457 arg458 arg459 arg460 arg461 arg462 arg463 arg464 arg465 arg466 arg467 arg468 arg469 arg470 arg471 arg472 arg473 arg474 arg475 arg476 arg477 arg478 arg479 arg480 arg481 arg482 arg483 arg484 arg485 arg486 arg487 arg488 arg489 arg490 arg491 arg492 arg493 arg494 arg495 arg496 arg497 arg498 arg499 arg500 arg501 arg502 arg503 arg504 arg505 arg506 arg507 arg508 arg509 arg510 arg511 arg512))))
+ (f512 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512))
+ 131328)
+
+
+(let ((x 32))
+ (define (f1) x)
+ (define x 33)
+ (test (f1) 33))
+
+(let ()
+ (define (c-2)
+ (let ((v (vector 1 2 3)))
+ (define (c-1 a b) (+ (vector-ref a 0) (* b 32)))
+ (let ((c (c-1 v 1)))
+ (test c 33)
+ (set! c-1 vector-ref))
+ (let ((d (c-1 v 1)))
+ (test d 2))))
+ (c-2))
+
+(let ()
+ (define (c-2)
+ (let ((v (vector 1 2 3)))
+ (let ()
+ (define (c-1 a b) (+ (vector-ref a 0) (* b 32)))
+ (let ((c (c-1 v 1)))
+ (set! c-1 vector-ref)))
+ (test (c-1 v 1) 'error)))
+ (c-2))
+(let ()
+ (define (f4 a b c d e) (list a b c d e))
+ (test (f4 1 2 3 4 5) '(1 2 3 4 5)))
+
+(define (redef-1 a) (+ a 1))
+(define (use-redef-1 b) (+ (redef-1 b) 2)) ; [use-redef](+ [redef-1](+ b 1) 2)
+(test (use-redef-1 3) 6) ; b=6
+(define (redef-1 a) (+ a 4))
+(test (use-redef-1 3) 9) ; [use-redef-1](+ [redef-1](+ a 4) 2), a=3
+(let ()
+ (define (use-redef-2 c) (+ (redef-1 c) 5)) ; [use-redef-2](+ [redef-1](+ a 4) 5)
+ (test (use-redef-2 6) 15) ; a=6
+ (define (redef-1 a) (+ a 7)) ; so use-redef-1 is still [use-redef-1](+ [redef-1](+ a 4) 2)
+ (test (use-redef-1 8) 14) ; a=8 -> 14
+ (test (use-redef-2 8) 20)) ; but use-redef-2 (same let as shadowing use-redef-1) is (+ [new redef-1](+ a 7) 5), a=8 -> 20
+
+(test (let () (define (f1 x) (abs x)) (define (f2 x) (f1 x)) (f2 -1)) 1) ; just trying to hit a portion of the s7 code
+
+(when with-block
+ (let ()
+ (define (f1) ((lambda (x) (cf11 x)) 3)) (f1)
+ (define (f2) ((lambda () (cf21 3 4)))) (f2)
+ (define (f3) ((lambda () (cf11 3)))) (f3)
+ (define (f4) ((lambda (x) (cf11 'x)) 4)) (f4)
+
+ (define (f5) ((lambda (x) (cf21 x 4)) 3)) (f5)
+ (define (f6) ((lambda (x) (cf21 3 x)) 4)) (f6)
+ (define (f7) ((lambda (x) (cf21 3 4)) 4)) (f7)
+ (define (f8) ((lambda (x y) (cf21 x y)) 3 4)) (f8)
+
+ (define (f9) ((lambda (x) (cf21 x 'y)) 'x)) (f9)
+ (define (f10) ((lambda (x) (cf21 'y x)) 'x)) (f10)
+ (define (f11) ((lambda (x) (cf21 'y 'x)) 'x)) (f11)
+ (define (f12) ((lambda (x) (cf21 1 'x)) 'x)) (f12)
+ (define (f13) ((lambda (x) (cf21 'x 1)) 'x)) (f13)
+
+ (define (f14) ((lambda (x y z) (cf31 x y z)) 1 2 3)) (f14)
+ (define (f15) ((lambda (x y z) (cf31 x 2 z)) 1 2 3)) (f15)
+ (define (f16) ((lambda (x y z) (cf31 x y 2)) 1 2 3)) (f16)
+ (define (f17) ((lambda (x y z) (cf31 2 y z)) 1 2 3)) (f17)
+
+ (define (f18) ((lambda (w x y z) (cf41 w x y z)) 1 2 3 4)) (f18)
+ (define (f19) ((lambda (x y z) (cf31 x 'y z)) 1 2 3)) (f19)
+ (define (f20) ((lambda (x y z) (cf41 'q x y z)) 1 2 3)) (f20)
+ (define (f21) ((lambda (x y) (cf31 x y (+ x 6))) 1 2)) (f21)
+ (define (f22) ((lambda (x y) (cf31 1 y (+ x 6))) 1 2)) (f22)
+ (define (f23) ((lambda (x y) (cf31 x 1 (+ x 6))) 1 2)) (f23)
+ (define (f24) ((lambda (x y) (cf31 1 (+ x 6) y)) 1 2)) (f24)
+ (define (f25) ((lambda (x) (cf11 (cf11 'x))) 1)) (f25)
+
+ (define (f26) ((lambda (w x y z) (cf51 'q w x y z)) 1 2 3 4)) (f26)
+ (define (f27) ((lambda (w x y) (cf21 (cf21 (cf11 w) (cf11 x)) (cf11 y))) 1 2 3)) (f27)
+ (define (f28) ((lambda (w x y) (cf31 (cf21 w x) 2 y)) 1 2 3)) (f28)
+
+ (define (f29) ((lambda () (cf11 (cf11 0))))) (f29)
+ (define (f30) ((lambda (x) (cf11 (cf11 x))) 0)) (f30)
+ (define (f31) ((lambda (x) (cf11 (cf10 x))) 0)) (f31)
+ (define (f32) ((lambda (x) (cf11 (cf10 'x))) 1)) (f32)
+ (define (f33) ((lambda (w x y) (cf31 (cf20 w x) 2 y)) 1 2 3)) (f33)
+ (define (f34) ((lambda (w x y) (cf22 (cf21 (cf11 w) (cf11 x)) (cf10 y))) 1 2 3)) (f34)
+ (define (f35) ((lambda (w x y) (cf21 (cf20 (cf11 w) (cf11 x)) (cf11 y))) 1 2 3)) (f35)
+ (define (f36) ((lambda (w x y) (cf21 (cf21 (cf10 w) (cf11 x)) (cf11 y))) 1 2 3)) (f36)
+
+ (define (f37) ((lambda (x y) (cf33 x y (cf20 x 6))) 1 2)) (f37)
+ (define (f38) ((lambda (x y) (cf33 1 y (cf20 x 6))) 1 2)) (f38)
+ (define (f39) ((lambda (x y) (cf33 x 1 (cf20 x 6))) 1 2)) (f39)
+ (define (f40) ((lambda (x y) (cf32 1 (cf20 x 6) y)) 1 2)) (f40)
+
+ (define (f41) ((lambda (x y) (cf11 (cf21 x y))) 1 2)) (f41)
+ (define (f42) ((lambda (x y) (cf11 (cf21 x 2))) 1 2)) (f42)
+ (define (f43) ((lambda (x y) (cf11 (cf21 1 x))) 1 2)) (f43)
+ (define (f44) ((lambda (x y) (cf21 x (cf11 y))) 1 2)) (f44)
+ (define (f45) ((lambda (x y) (cf21 (cf11 x) y)) 1 2)) (f45)
+ (define (f46) ((lambda (x y) (cf21 (cf11 x) 2)) 1 2)) (f46)
+ (define (f47) ((lambda (x y) (cf21 (cf11 x) (cf11 y))) 1 2)) (f47)
+
+ (define (f48) ((lambda (x y) (cf11 (cf20 x y))) 1 2)) (f48)
+ (define (f49) ((lambda (x y) (cf11 (cf20 x 2))) 1 2)) (f49)
+ (define (f50) ((lambda (x y) (cf11 (cf20 1 x))) 1 2)) (f50)
+ (define (f51) ((lambda (x y) (cf22 x (cf10 y))) 1 2)) (f51)
+ (define (f52) ((lambda (x y) (cf21 (cf10 x) y)) 1 2)) (f52)
+ (define (f53) ((lambda (x y) (cf21 (cf10 x) 2)) 1 2)) (f53)
+ (define (f54) ((lambda (x y) (cf21 (cf10 x) (cf11 y))) 1 2)) (f54)
+ (define (f55) ((lambda (x y) (cf22 (cf11 x) (cf10 y))) 1 2)) (f55)
+
+ (define (f56) ((lambda (x y) (cf21 1 (cf11 y))) 1 2)) (f56)
+ (define (f57) ((lambda (x y) (cf22 1 (cf10 y))) 1 2)) (f57)
+ (define (f58) ((lambda (x y z) (cf21 x (cf21 y z))) 1 2 3)) (f58)
+ (define (f59) ((lambda (x y z) (cf22 x (cf20 y z))) 1 2 3)) (f59)
+ (define (f60) ((lambda (x y z) (cf21 x (cf21 2 z))) 1 2 3)) (f60)
+ (define (f61) ((lambda (x y z) (cf22 x (cf20 2 z))) 1 2 3)) (f61)
+ (define (f62) ((lambda (x y z) (cf21 x (cf21 y 3))) 1 2 3)) (f62)
+ (define (f63) ((lambda (x y z) (cf22 x (cf20 y 3))) 1 2 3)) (f63)
+ (define (f64) ((lambda (x y z) (cf21 1 (cf21 2 z))) 1 2 3)) (f64)
+ (define (f65) ((lambda (x y z) (cf22 1 (cf20 2 z))) 1 2 3)) (f65)
+ (define (f66) ((lambda (x y z) (cf21 1 (cf21 y 3))) 1 2 3)) (f66)
+ (define (f67) ((lambda (x y z) (cf22 1 (cf20 y 3))) 1 2 3)) (f67)
+
+ (define (f68) ((lambda (x) (cf21 (cf21 2 x) 3)) 1)) (f68)
+ (define (f69) ((lambda (x) (cf21 (cf20 2 x) 3)) 1)) (f69)
+ (define (f70) ((lambda (x y) (cf21 1 (cf21 x y))) 2 3)) (f70)
+ (define (f71) ((lambda (x y) (cf22 1 (cf20 x y))) 2 3)) (f71)
+ (define (f72) ((lambda (x y) (cf21 (cf21 x y) 3)) 1 2)) (f72)
+ (define (f73) ((lambda (x y) (cf21 (cf20 x y) 3)) 1 2)) (f73)
+
+ (define (f74) ((lambda (x) (cf11 (cf21 x 'y))) 1)) (f74)
+ (define (f75) ((lambda (x) (cf11 (cf20 x 'y))) 1)) (f75)
+ (define (f76) ((lambda (x) (cf21 x (cf11 2))) 1)) (f76)
+ (define (f77) ((lambda (x) (cf22 x (cf10 2))) 1)) (f77)
+ (define (f78) ((lambda (x) (cf21 1 (cf11 2))) 1)) (f78)
+ (define (f79) ((lambda (x) (cf22 1 (cf10 2))) 1)) (f79)
+ (define (f80) ((lambda (x) (cf21 (cf11 1) x)) 2)) (f80)
+ (define (f81) ((lambda (x) (cf21 (cf10 1) x)) 2)) (f81)
+ (define (f82) ((lambda (x y z) (cf21 (cf21 x y) z)) 1 2 3)) (f82)
+ (define (f83) ((lambda (x y z) (cf21 (cf20 x y) z)) 1 2 3)) (f83)
+ (define (f84) ((lambda (x y z) (cf21 (cf21 x 2) z)) 1 2 3)) (f84)
+ (define (f85) ((lambda (x y z) (cf21 (cf20 x 2) z)) 1 2 3)) (f85)
+ (define (f86) ((lambda (x y z) (cf21 (cf21 1 y) z)) 1 2 3)) (f86)
+ (define (f87) ((lambda (x y z) (cf21 (cf20 1 y) z)) 1 2 3)) (f87)
+ (define (f88) ((lambda (x y z) (cf21 (cf21 x 2) 3)) 1 2 3)) (f88)
+ (define (f89) ((lambda (x y z) (cf21 (cf20 x 2) 3)) 1 2 3)) (f89)
+ (define (f90) ((lambda (x) (cf21 (cf11 1) 2)) 2)) (f90)
+ (define (f91) ((lambda (x) (cf21 (cf10 1) 2)) 2)) (f91)
+
+ (define (f92) ((lambda (w x y z) (cf21 (cf21 w x) (cf21 y z))) 1 2 3 4)) (f92)
+ (define (f93) ((lambda (w x y z) (cf22 (cf21 w x) (cf20 y z))) 1 2 3 4)) (f93)
+ (define (f94) ((lambda (w x y z) (cf21 (cf20 w x) (cf21 y z))) 1 2 3 4)) (f94)
+ (define (f95) ((lambda (w x y z) (cf21 (cf21 w 2) (cf21 y 4))) 1 2 3 4)) (f95)
+ (define (f96) ((lambda (w x y z) (cf22 (cf21 w 2) (cf20 y 4))) 1 2 3 4)) (f96)
+ (define (f97) ((lambda (w x y z) (cf21 (cf20 w 2) (cf21 y 4))) 1 2 3 4)) (f97)
+ (define (f98) ((lambda (x y z) (cf21 (cf11 x) (cf21 y z))) 1 2 3)) (f98)
+ (define (f99) ((lambda (x y z) (cf22 (cf11 x) (cf20 y z))) 1 2 3)) (f99)
+ (define (f100) ((lambda (x y z) (cf21 (cf10 x) (cf21 y z))) 1 2 3)) (f100)
+ (define (f101) ((lambda (x y z) (cf21 (cf21 x y) (cf11 z))) 1 2 3)) (f101)
+ (define (f102) ((lambda (x y z) (cf22 (cf21 x y) (cf10 z))) 1 2 3)) (f102)
+ (define (f103) ((lambda (x y z) (cf21 (cf20 x y) (cf11 z))) 1 2 3)) (f103)
+ (define (f104) ((lambda (x y z) (cf21 (cf21 x y) (cf11 3))) 1 2 3)) (f104)
+ (define (f105) ((lambda (x y z) (cf22 (cf21 x y) (cf10 3))) 1 2 3)) (f105)
+ (define (f106) ((lambda (x y z) (cf21 (cf20 x y) (cf11 3))) 1 2 3)) (f106)
+ (define (f107) ((lambda (x y z) (cf21 (cf11 1) (cf21 y z))) 1 2 3)) (f107)
+ (define (f108) ((lambda (x y z) (cf22 (cf11 1) (cf20 y z))) 1 2 3)) (f108)
+ (define (f109) ((lambda (x y z) (cf21 (cf10 1) (cf21 y z))) 1 2 3)) (f109)
+ (define (f110) ((lambda () (cf21 (cf11 1) (cf11 2))))) (f110)
+ (define (f111) ((lambda () (cf22 (cf11 1) (cf10 2))))) (f111)
+ (define (f112) ((lambda () (cf21 (cf10 1) (cf11 2))))) (f112)
+
+ (define (f113) ((lambda (x) (cf11 (cf11 (cf11 x)))) 1)) (f113)
+ (define (f114) ((lambda (x) (cf11 (cf11 (cf10 x)))) 1)) (f114)
+ (define (f115) ((lambda (x) (cf11 (cf10 (cf11 x)))) 1)) (f115)
+ (define (f116) ((lambda (w x y z) (cf22 w (cf21 (cf21 x y) z))) 1 2 3 4)) (f116)
+ (define (f117) ((lambda (w x y z) (cf22 w (cf20 (cf21 x y) z))) 1 2 3 4)) (f117)
+ (define (f118) ((lambda (w x y z) (cf22 w (cf21 (cf20 x y) z))) 1 2 3 4)) (f118)
+
+ (define (f119) ((lambda (w x y z) (cf22 w (cf22 x (cf21 y z)))) 1 2 3 4)) (f119)
+ (define (f120) ((lambda (w x y z) (cf22 w (cf20 x (cf21 y z)))) 1 2 3 4)) (f120)
+ (define (f121) ((lambda (w x y z) (cf22 w (cf22 x (cf20 y z)))) 1 2 3 4)) (f121)
+
+ (define (f122) ((lambda (x y) (cf11 (cf32 1 (cf21 x y) 4))) 2 3)) (f122) ; c_z
+ (define (f123) ((lambda (x y) (cf11 (cf32 1 (cf20 x y) 4))) 2 3)) (f123)
+ (define (f124) ((lambda (x y) (cf11 (cf30 1 (cf21 x y) 4))) 2 3)) (f124)
+
+ (define (f125) ((lambda (x y) (cf21 (cf11 (cf21 x y)) 3)) 1 2)) (f125)
+ (define (f126) ((lambda (x y) (cf21 (cf10 (cf21 x y)) 3)) 1 2)) (f126)
+ (define (f127) ((lambda (x y) (cf21 (cf11 (cf20 x y)) 3)) 1 2)) (f127)
+
+ (define (f128) ((lambda (x) (cf22 1 (cf21 x (cf11 3)))) 2)) (f128)
+ (define (f129) ((lambda (x) (cf22 1 (cf20 x (cf11 3)))) 2)) (f129)
+ (define (f130) ((lambda (x) (cf22 1 (cf22 x (cf10 3)))) 2)) (f130)
+
+ (define (f131) ((lambda (x y z) (cf22 x (cf21 (cf21 y z) (cf21 z y)))) 1 2 3)) (f131)
+ (define (f132) ((lambda (x y z) (cf22 x (cf20 (cf21 y z) (cf21 z y)))) 1 2 3)) (f132)
+ (define (f133) ((lambda (x y z) (cf22 x (cf21 (cf20 y z) (cf21 z y)))) 1 2 3)) (f133)
+ (define (f134) ((lambda (x y z) (cf22 x (cf22 (cf21 y z) (cf20 z y)))) 1 2 3)) (f134)
+
+ (define (f135) ((lambda (x y z) (cf21 (cf21 x y) (cf11 (cf21 y z)))) 1 2 3)) (f135)
+ (define (f136) ((lambda (x y z) (cf21 (cf20 x y) (cf11 (cf21 y z)))) 1 2 3)) (f136)
+ (define (f137) ((lambda (x y z) (cf22 (cf21 x y) (cf10 (cf21 y z)))) 1 2 3)) (f137)
+ (define (f138) ((lambda (x y z) (cf22 (cf21 x y) (cf11 (cf20 y z)))) 1 2 3)) (f138)
+
+ (define (f139) ((lambda (x y z) (cf21 (cf21 (cf21 x y) z) (cf21 y z))) 1 2 3)) (f139)
+ (define (f140) ((lambda (x y z) (cf21 (cf20 (cf21 x y) z) (cf21 y z))) 1 2 3)) (f140)
+ (define (f141) ((lambda (x y z) (cf21 (cf21 (cf20 x y) z) (cf21 y z))) 1 2 3)) (f141)
+ (define (f142) ((lambda (x y z) (cf22 (cf21 (cf21 x y) z) (cf20 y z))) 1 2 3)) (f142)
+
+ (define (f143) ((lambda (x y z) (cf22 x (cf21 (cf11 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f143)
+ (define (f144) ((lambda (x y z) (cf22 x (cf20 (cf11 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f144)
+ (define (f145) ((lambda (x y z) (cf22 x (cf21 (cf10 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f145)
+ (define (f146) ((lambda (x y z) (cf22 x (cf21 (cf11 (cf20 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f146)
+ (define (f147) ((lambda (x y z) (cf22 x (cf22 (cf11 (cf21 x y)) (cf10 (cf21 y z))))) 1 2 3)) (f147)
+ (define (f148) ((lambda (x y z) (cf22 x (cf22 (cf11 (cf21 x y)) (cf11 (cf20 y z))))) 1 2 3)) (f148)
+
+ (define (f149) ((lambda (x y z) (cf22 x (cf31 (cf11 y) (cf11 z) (cf11 z)))) 1 2 3)) (f149)
+ (define (f150) ((lambda (x y z) (cf22 x (cf30 (cf11 y) (cf11 z) (cf11 z)))) 1 2 3)) (f150)
+ (define (f151) ((lambda (x y z) (cf22 x (cf31 (cf10 y) (cf11 z) (cf11 z)))) 1 2 3)) (f151)
+ (define (f152) ((lambda (x y z) (cf22 x (cf32 (cf11 y) (cf10 z) (cf11 z)))) 1 2 3)) (f152)
+ (define (f153) ((lambda (x y z) (cf22 x (cf33 (cf11 y) (cf11 z) (cf10 z)))) 1 2 3)) (f153)
+
+ (define (f154) ((lambda (x y z) (cf21 (cf32 1 (cf21 x y) 4) (cf32 1 (cf21 y z) 4))) 1 2 3)) (f154)
+ (define (f155) ((lambda (x y z) (cf21 (cf32 1 (cf20 x y) 4) (cf32 1 (cf21 y z) 4))) 1 2 3)) (f155)
+ (define (f156) ((lambda (x y z) (cf22 (cf32 1 (cf21 x y) 4) (cf30 1 (cf21 y z) 4))) 1 2 3)) (f156)
+
+ (define (f157) ((lambda (x y z) (cf22 x (cf32 1 (cf21 y z) 4))) 1 2 3)) (f157)
+ (define (f158) ((lambda (x y z) (cf22 x (cf32 1 (cf20 y z) 4))) 1 2 3)) (f158)
+
+ (define (f159) ((lambda (x y z) (cf21 (cf32 1 (cf21 y z) 4) x)) 1 2 3)) (f159)
+ (define (f160) ((lambda (x y z) (cf21 (cf30 1 (cf20 y z) 4) x)) 1 2 3)) (f160)
+
+ (define (f161) ((lambda (x y z) (cf22 1 (cf32 1 (cf21 y z) 4))) 1 2 3)) (f161)
+ (define (f162) ((lambda (x y z) (cf22 1 (cf32 1 (cf20 y z) 4))) 1 2 3)) (f162)
+
+ (define (f163) ((lambda (x y z) (cf21 (cf32 1 (cf21 y z) 4) x)) 1 2 3)) (f163)
+ (define (f164) ((lambda (x y z) (cf21 (cf30 1 (cf20 y z) 4) x)) 1 2 3)) (f164)
+
+ ;; --------
+ (test (f1) 3) (test (f2) 3) (test (f3) 3) (test (f4) 'x) (test (f5) 3) (test (f6) 3) (test (f7) 3)
+ (test (f8) 3) (test (f9) 'x) (test (f10) 'y) (test (f11) 'y) (test (f12) 1) (test (f13) 'x) (test (f14) 1)
+ (test (f15) 1) (test (f16) 1) (test (f17) 2) (test (f18) 1) (test (f19) 1) (test (f20) 'q) (test (f21) 1)
+ (test (f22) 1) (test (f23) 1) (test (f24) 1) (test (f25) 'x) (test (f26) 'q) (test (f27) 1) (test (f28) 1)
+ (test (f29) 0) (test (f30) 0) (test (f31) 0) (test (f32) 'x) (test (f33) 1) (test (f34) 3) (test (f35) 1)
+ (test (f36) 1) (test (f37) 1) (test (f38) 1) (test (f39) 1) (test (f40) 1) (test (f41) 1) (test (f42) 1)
+ (test (f43) 1) (test (f44) 1) (test (f45) 1) (test (f46) 1) (test (f47) 1) (test (f48) 1) (test (f49) 1)
+ (test (f50) 1) (test (f51) 2) (test (f52) 1) (test (f53) 1) (test (f54) 1) (test (f55) 2) (test (f56) 1)
+ (test (f57) 2) (test (f58) 1) (test (f59) 2) (test (f60) 1) (test (f61) 2) (test (f62) 1) (test (f63) 2)
+ (test (f64) 1) (test (f65) 2) (test (f66) 1) (test (f67) 2) (test (f68) 2) (test (f69) 2) (test (f70) 1)
+ (test (f71) 2) (test (f72) 1) (test (f73) 1) (test (f74) 1) (test (f75) 1) (test (f76) 1) (test (f77) 2)
+ (test (f78) 1) (test (f79) 2) (test (f80) 1) (test (f81) 1) (test (f82) 1) (test (f83) 1) (test (f84) 1)
+ (test (f85) 1) (test (f86) 1) (test (f87) 1) (test (f88) 1) (test (f89) 1) (test (f90) 1) (test (f91) 1)
+ (test (f92) 1) (test (f93) 3) (test (f94) 1) (test (f95) 1) (test (f96) 3) (test (f97) 1) (test (f98) 1)
+ (test (f99) 2) (test (f100) 1) (test (f101) 1) (test (f102) 3) (test (f103) 1) (test (f104) 1) (test (f105) 3)
+ (test (f106) 1) (test (f107) 1) (test (f108) 2) (test (f109) 1) (test (f110) 1) (test (f111) 2) (test (f112) 1)
+ (test (f113) 1) (test (f114) 1) (test (f115) 1) (test (f116) 2) (test (f117) 2) (test (f118) 2)
+ (test (f119) 3) (test (f120) 2) (test (f121) 3) (test (f122) 2) (test (f123) 2) (test (f124) 1)
+ (test (f125) 1) (test (f126) 1) (test (f127) 1) (test (f128) 2) (test (f129) 2) (test (f130) 3)
+ (test (f131) 2) (test (f132) 2) (test (f133) 2) (test (f134) 3)
+ (test (f135) 1) (test (f136) 1) (test (f137) 2) (test (f138) 2)
+ (test (f139) 1) (test (f140) 1) (test (f141) 1) (test (f142) 2)
+ (test (f143) 1) (test (f144) 1) (test (f145) 1) (test (f146) 1) (test (f147) 2) (test (f148) 2)
+ (test (f149) 2) (test (f150) 2) (test (f151) 2) (test (f152) 3) (test (f153) 3)
+ (test (f154) 1) (test (f155) 1) (test (f156) 1) (test (f157) 2) (test (f158) 2) (test (f159) 2) (test (f160) 1)
+ (test (f161) 2) (test (f162) 2) (test (f163) 2) (test (f164) 1)
+ ))
+
+(when with-block
+ (let ()
+ (define (thunk1) 3)
+ (define (thunk2) 4)
+ (define (f1) ((lambda (x) (thunk1)) 0)) (f1)
+ (test (f1) 3)
+ (define thunk1 thunk2)
+ (test (f1) 4)
+
+ (define (thunk3) (*s7* 'max-stack-size) 5)
+ (define (thunk4) (*s7* 'max-stack-size) 6)
+ (define (f2) ((lambda (x) (thunk3)) 0)) (f2)
+ (test (f2) 5)
+ (define thunk3 thunk4)
+ (test (f2) 6)
+
+ (define (close1 x) (*s7* 'max-stack-size) (+ x 1))
+ (define (close2 x) (*s7* 'max-stack-size) (+ x 2))
+ (define (qclose1 x) (*s7* 'max-stack-size) (eq? x 'q))
+ (define (qclose2 x) (*s7* 'max-stack-size) (eq? x 'r))
+ (define (sclose1 x) (+ x 1))
+ (define (sclose2 x) (+ x 2))
+ (define (qsclose1 x) (eq? x 'q))
+ (define (qsclose2 x) (eq? x 'r))
+ (define* (s*close1 (x 1)) (+ x 1))
+ (define* (s*close2 (x 1)) (+ x 2))
+ (define* (u*close1 (x 1)) (*s7* 'max-stack-size) (+ x 1))
+ (define* (u*close2 (x 1)) (*s7* 'max-stack-size) (+ x 2))
+
+ (define (close3 x y) (*s7* 'max-stack-size) (+ x y))
+ (define (close4 x y) (*s7* 'max-stack-size) (+ x y 1))
+ (define (sclose3 x y) (+ x y))
+ (define (sclose4 x y) (+ x y 1))
+ (define* (s*close3 (x 1) (y 0.0)) (+ x y))
+ (define* (s*close4 (x 1) (y 0.0)) (+ x y 1))
+ (define* (u*close3 (x 1) (y 0)) (*s7* 'max-stack-size) (+ x y))
+ (define* (u*close4 (x 1) (y 0)) (*s7* 'max-stack-size) (+ x y 1))
+
+ (define (f3) (close1 1)) (f3)
+ (define (f4) (sclose1 1)) (f4)
+ (define (f5 x) (close1 x)) (f5 0)
+ (define (f6 x) (sclose1 x)) (f6 0)
+ (define (f7 x) (close1 ((lambda () (cs11 x))))) (f7 0)
+ (define (f8 x) (sclose1 ((lambda () (cs11 x))))) (f8 0)
+ (define (f9 x) (close1 ((lambda () (cs11 1))))) (f9 0)
+ (define (f10 x) (sclose1 ((lambda () (cs11 1))))) (f10 0)
+ (define (f11 x) (s*close1 x)) (f11 0)
+ (define (f12 x) (s*close1)) (f12 0)
+ (define (f13 x) (u*close1 x)) (f13 0)
+ (define (f14 x) (u*close1)) (f14 0)
+ (define (f15) (qclose1 'q)) (f15)
+ (define (f16) (qsclose1 'q)) (f16)
+ (define (f17 x) (close1 (cdr x))) (f17 '(0 . 0))
+ (define (f18) (close3 1 2)) (f18)
+ (define (f19) (sclose3 1 2)) (f19)
+ (define (f20) (s*close3 1 2)) (f20)
+ (define (f21) (u*close3 1 2)) (f21)
+ (define (f22 x) (close3 x 2)) (f22 0)
+ (define (f23 x) (sclose3 x 2)) (f23 0)
+ (define (f24 x) (s*close3 x 2)) (f24 0)
+ (define (f25 x) (u*close3 x 2)) (f25 0)
+ (define (f26 x) (close3 1 x)) (f26 0)
+ (define (f27 x) (sclose3 1 x)) (f27 0)
+ (define (f28 x) (s*close3 1 x)) (f28 0)
+ (define (f29 x) (u*close3 1 x)) (f29 0)
+ (define (f30 x y) (close3 x y)) (f30 0 0)
+ (define (f31 x y) (sclose3 x y)) (f31 0 0)
+ (define (f32 x y) (s*close3 x y)) (f32 0 0)
+ (define (f33 x y) (u*close3 x y)) (f33 0 0)
+
+ (test (f3) 2) (test (f4) 2) (test (f5 1) 2) (test (f6 1) 2) (test (f7 1) 2) (test (f8 1) 2) (test (f9 1) 2)
+ (test (f10 1) 2) (test (f11 1) 2) (test (f12 1) 2) (test (f13 1) 2) (test (f14 1) 2) (test (f15) #t)
+ (test (f16) #t) (test (f17 '(1 . 1)) 2) (test (f18) 3) (test (f19) 3) (test (f20) 3) (test (f21) 3)
+ (test (f22 1) 3) (test (f23 1) 3) (test (f24 1) 3) (test (f25 1) 3) (test (f26 2) 3) (test (f27 2) 3)
+ (test (f28 2) 3)
+ (test (f29 2) 3)
+ (test (f30 1 2) 3)
+ (test (f31 1 2) 3)
+ (test (f32 1 2) 3)
+ (test (f33 1 2) 3)
+
+ (define cs11 rs11)
+ ;;;(test (f7 1) 3) (test (f8 1) 3) (test (f9 1) 3) (test (f10 1) 3)
+
+ (define close1 close2)
+ (define close3 close4)
+ (define qclose1 qclose2)
+ (define sclose1 sclose2)
+ (define sclose3 sclose4)
+ (define qsclose1 qsclose2)
+ (define s*close1 s*close2)
+ (define s*close3 s*close4)
+ (define u*close1 u*close2)
+ (define u*close3 u*close4)
+
+ (define (f31 x y) (sclose3 x y))
+
+ (test (f3) 3) (test (f4) 3) (test (f5 1) 3) (test (f6 1) 3)
+ ;;; (test (f7 -1) 2) (test (f8 -1) 2) (test (f9 -1) 4) (test (f10 -1) 4)
+ (test (f11 1) 3) (test (f12 1) 3) (test (f13 1) 3) (test (f14 1) 3) (test (f15) #f)
+ (test (f16) #f) (test (f17 '(1 . 1)) 3) (test (f18) 4) (test (f19) 4) (test (f20) 4) (test (f21) 4)
+ (test (f22 1) 4) (test (f23 1) 4) (test (f24 1) 4) (test (f25 1) 4) (test (f26 2) 4) (test (f27 2) 4)
+ (test (f28 2) 4) (test (f29 2) 4) (test (f30 1 2) 4) (test (f31 1 2) 4)
+ (test (f32 1 2) 4) (test (f33 1 2) 4)
+ ))
+
+;;; global name opts (or lack thereof)
+;;; the funny names used here must be nonce words
+
+;;; op_unknown (thunk):
+(define *x1* #f) (define (test*x1*) (*x1*)) (define (set*x1* n) (set! *x1* (lambda () n))) (set*x1* 1) (test (test*x1*) 1) (set*x1* 2) (test (test*x1*) 2)
+(define *x2* #f) (define (test*x2*) (*x2*)) (define (set*x2* n) (set! *x2* (define* (_) n))) (set*x2* 1) (test (test*x2*) 1) (set*x2* 2) (test (test*x2*) 2)
+
+;;; op_unknown_q:
+(define *x3* #f) (define (test*x3*) (*x3* 'a)) (define (set*x3* n) (set! *x3* (lambda (x) n))) (set*x3* 1) (test (test*x3*) 1) (set*x3* 2) (test (test*x3*) 2)
+
+;;; op_unknown_s:
+(define *x4* #f) (define (test*x4* a) (*x4* a)) (define (set*x4* n) (set! *x4* (lambda (x) n))) (set*x4* 1) (test (test*x4* 0) 1) (set*x4* 2) (test (test*x4* 0) 2)
+(define *x5* #f) (define (test*x5* a) (*x5* a)) (define (set*x5* n) (set! *x5* (define* (_ __) n))) (set*x5* 1) (test (test*x5* 0) 1) (set*x5* 2) (test (test*x5* 0) 2)
+
+;;; op_unknown_c:
+(define *x6* #f) (define (test*x6*) (*x6* 0)) (define (set*x6* n) (set! *x6* (lambda (x) n))) (set*x6* 1) (test (test*x6*) 1) (set*x6* 2) (test (test*x6*) 2)
+
+;;; op_unknown_ss:
+(define *x7* #f) (define (test*x7* a b) (*x7* a b)) (define (set*x7* n) (set! *x7* (lambda (x y) n)))
+ (set*x7* 1) (test (test*x7* 0 0) 1) (set*x7* 2) (test (test*x7* 0 0) 2)
+(define *x8* #f) (define (test*x8* a b) (*x8* a b)) (define (set*x8* n) (set! *x8* (define* (_ x y) n)))
+ (set*x8* 1) (test (test*x8* 0 0) 1) (set*x8* 2) (test (test*x8* 0 0) 2)
+
+;;; op_unknown_sc:
+(define *x9* #f) (define (test*x9* a b) (*x9* a 0)) (define (set*x9* n) (set! *x9* (lambda (x y) n)))
+ (set*x9* 1) (test (test*x9* 0 0) 1) (set*x9* 2) (test (test*x9* 0 0) 2)
+(define *x10* #f) (define (test*x10* a b) (*x10* a 0)) (define (set*x10* n) (set! *x10* (define* (_ x y) n)))
+ (set*x10* 1) (test (test*x10* 0 0) 1) (set*x10* 2) (test (test*x10* 0 0) 2)
+
+;;; op_unknown_cs:
+(define *x11* #f) (define (test*x11* a b) (*x11* 0 b)) (define (set*x11* n) (set! *x11* (lambda (x y) n)))
+ (set*x11* 1) (test (test*x11* 0 0) 1) (set*x11* 2) (test (test*x11* 0 0) 2)
+(define *x12* #f) (define (test*x12* a b) (*x12* 0 b)) (define (set*x12* n) (set! *x12* (define* (_ x y) n)))
+ (set*x12* 1) (test (test*x12* 0 0) 1) (set*x12* 2) (test (test*x12* 0 0) 2)
+
+;;; globals
+(test (let () (define (call-func func arg1 arg2) (define (call) (func arg1 arg2)) (call)) (call-func + 1 2.5) (call-func - 5 2)) 3)
+(test (let () (define (call-func arg1 arg2) (let ((func (if (= arg1 1) + -))) (define (call) (func arg1 arg2)) (call))) (call-func 1 2.5) (call-func 5 2)) 3)
+
+;;; safe/unsafe troubles
+(let ()
+ (define (testit)
+ (define (f1 x y z) (car z))
+ (define (f2 lst) (cond ((null? lst) ()) (else (f1 lst (f2 (cdr lst)) lst))))
+ (test (f2 '(abs -1)) 'abs))
+ (testit))
+(let ()
+ (define (testit)
+ (define (f1 x y z) (car z))
+ (define (f2 lst) (cond ((null? lst) ()) (else (f1 (f2 (cdr lst)) (f2 (cdr lst)) lst))))
+ (test (f2 '(abs -1)) 'abs))
+ (testit))
+
+;;; changing a function's environment
+(let ()
+ (let ((e (let ((a 1) (b 2)) (curlet))))
+ (define (f1 c)
+ (+ a b c))
+ (set! (outlet (funclet f1)) e)
+ (test (f1 4) 7))
+
+ (let ((e (let ((a 1) (b 2)) (curlet))))
+ (define f2 (let ((d 10))
+ (lambda (c)
+ (+ a b c d))))
+ ;; (set! (outlet (funclet f2)) e) ; 'd unbound
+ (set! (outlet (outlet (funclet f2))) e)
+ (test (f2 4) 17))
+
+ (let ((e (let ((a 1) (b 2)) (curlet))))
+ (define f3
+ (with-let e
+ (lambda (c)
+ (+ a b c))))
+ (test (f3 4) 7)))
@@ -13052,7 +23804,7 @@ this prints:
(test (equal? (values #t #t)) #t)
(test (call-with-values (lambda () 4) (lambda (x) x)) 4)
(test (let () (values 1 2 3) 4) 4)
-(test (apply + (values '())) 0)
+(test (apply + (values ())) 0)
(test (+ (values 1 2 3)) 6)
(test (let ((f (lambda () (values 1 2 3)))) (+ (f))) 6)
(num-test (log (values 8 2)) 3)
@@ -13091,8 +23843,19 @@ this prints:
(test (vector 1 (values 2 3) 4) #(1 2 3 4))
(test (vector (values 1 (values 2 3) (values (values 4)))) #(1 2 3 4))
(test(+ 1 (values (values (values 2) 3) (values (values (values 4)) 5) 6) 7) 28)
-
-(test (let ((x 1)) (set! x (values)) x) 'error)
+(test (map (values values #(1 2))) '(1 2))
+(test ((values values) (values 0)) 0)
+(test (((values values values) 0)) 0)
+(test ((apply (values values values '((1 2))))) '(1 2))
+(test (apply begin (values (list 1))) 1)
+(test (apply begin (values '(values "hi"))) (apply (values begin '(values "hi"))))
+(test ((object->string values) (abs 1)) #\a)
+(test (list? (values 1 2 3)) 'error)
+(test (list? (values 1)) #f)
+(test (list? (values (list 1 2 3))) #t)
+
+(test (let ((x 1)) (set! x (values)) x) #<unspecified>)
+(test ((lambda () (let ((x 1)) (set! x (boolean? (values)))))) #f)
(test (let ((x 1)) (set! x (values 1 2 3)) x) 'error)
(test (let ((x 1)) (set! x (values 2)) x) 2)
(test (let ((x 1)) (set! (values x) 2) x) 'error) ; (no generalized set for values, so (values x) is not the same as x
@@ -13102,14 +23865,49 @@ this prints:
(test (letrec ((var (values 1 2 3))) var) 'error)
(test (let ((x ((lambda () (values 1 2))))) x) 'error)
(test (+ 1 ((lambda () ((lambda () (values 2 3)))))) 6)
+(test (let () (define (hi) (symbol? (values 1 2 3))) (hi)) 'error)
+(test (let () (define (hi) (symbol? (values))) (hi)) #f) ; this is consistent with earlier such cases: (boolean? (values))
+(test (let () (define (hi) (symbol? (values 'a))) (hi)) #t)
+(test (let () (define (hi) (symbol? (values 1))) (hi)) #f)
+(test (let () (define (hi a) (log (values 1 2) a)) (hi 2)) 'error)
+(test (let () (define (arg2 a) (let ((b 1)) (set! b (+ a b)) (values b a))) (define (hi c) (expt (abs c) (arg2 2))) (hi 2)) 'error)
+(test (let () (define (arg2 a) (let ((b 1)) (set! b (+ a b)) (values b))) (define (hi c) (expt (abs c) (arg2 2))) (hi 2)) 8)
+(test (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) 10)
(test (let ((str "hi")) (string-set! (values str 0 #\x)) str) "xi")
+(test (values if) if)
+(test (values quote) quote)
(test ((values '(1 (2 3)) 1 1)) 3)
(test (let ((x #(32 33))) ((values x 0))) 32)
(test (+ 1 (apply values '(2 3 4))) 10)
+(test (eq? (values) (apply values ())) #t)
(test (+ 1 ((lambda args (apply values args)) 2 3 4)) 10)
(test (apply begin '(1 2 3)) 3)
+(test (let ((x 1)) ((values set!) x 32) x) 32)
+(let ((x 0)) (test (list (set! x 10)) (call-with-values (lambda () (set! x 10)) list))) ; from r7rs discussion
+
+(let ()
+ (define (curry function . args)
+ (lambda more-args
+ (function (apply values args) (apply values more-args)))) ; unfortunately this doesn't handle 0 args
+ (test ((curry + 1 2) 3 4) 10))
+
+(let ()
+ (define (curry function . args)
+ (if (null? args)
+ function
+ (lambda more-args
+ (if (null? more-args)
+ (apply function args)
+ (function (apply values args) (apply values more-args))))))
+ (test ((curry + 1 2) 3 4) 10)
+ (test ((curry + 2) 3 4) 9)
+ (test ((curry +) 3 4) 7)
+ (test ((curry +)) 0)
+ (test ((curry + 1 2)) 3)
+ (test ((curry + 1)) 1)
+ (test ((curry +) 1) 1))
(test (or (values #t #f) #f) #t)
(test (or (values #f #f) #f) #f)
@@ -13121,7 +23919,7 @@ this prints:
(test (and (values) 1) 1)
(test (and (values 1 2 #f) 4) #f)
(test (and (values 1 2 3) 4) 4)
-(test (length (values '())) 0)
+(test (length (values ())) 0)
(test (length (values #(1 2 3 4))) 4)
(test (vector? (values #())) #t)
(test (map + (values '(1 2 3) #(1 2 3))) '(2 4 6))
@@ -13149,9 +23947,11 @@ this prints:
(test ((lambda* ((a 1) (b 2)) (list a b)) (values :a 3)) '(3 2))
(test (+ (values (values 1 2) (values 4 5))) 12)
(test (+ (begin 3 (values 1 2) 4)) 4)
-(test (map (lambda (x) (if #f x (values))) (list 1 2)) '())
-(test (map (lambda (x) (if #f x (begin (values)))) (list 1 2)) '())
+(test (map (lambda (x) (if #f x (values))) (list 1 2)) ())
+(test (map (lambda (x) (if #f x (begin (values)))) (list 1 2)) ())
(test (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4)) '(1 20 3 60))
+(test (map (lambda (x) (if (odd? x) (values x (* x 20)) (if #f #f))) (list 1 2 3 4)) '(1 20 #<unspecified> 3 60 #<unspecified>))
+(test (map (lambda (x) (if (odd? x) (apply values '(1 2 3)) (values))) (list 1 2 3 4)) '(1 2 3 1 2 3))
(test (object->string (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4))) "(1 20 3 60)") ; make sure no "values" floats through
(test (map (lambda (x) (if (odd? x) (values x (* x 20) (cons x (+ x 1))) (values))) (list 1 2 3 4 5 6)) '(1 20 (1 . 2) 3 60 (3 . 4) 5 100 (5 . 6)))
(test (* 2 (case 1 ((2) (values 3 4)) ((1) (values 5 6)))) 60)
@@ -13168,21 +23968,27 @@ this prints:
(for-each
(lambda (arg)
(test (values arg) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(for-each
+ (lambda (arg)
+ (test (apply values arg) 'error)
+ (test (apply values (list arg)) arg))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t '(1 . 2)))
(for-each
(lambda (arg)
(test (call-with-values (lambda () (values arg arg)) (lambda (a b) b)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (call-with-values (lambda () (values "hi" 1 3/2 'a)) (lambda (a b c d) (+ b c))) 5/2)
- ;(test (call-with-values values (lambda arg arg)) '())
+ ;(test (call-with-values values (lambda arg arg)) ())
(test (string-ref (values "hi") 1) #\i)
(test ((lambda (a b) (+ a b)) ((lambda () (values 1 2)))) 3)
(test (list (letrec ((split (lambda (ls)
(if (or (null? ls) (null? (cdr ls)))
- (values ls '())
+ (values ls ())
(call-with-values
(lambda () (split (cddr ls)))
(lambda (odds evens)
@@ -13191,6 +23997,13 @@ this prints:
(split '(a b c d e f))))
'((a c e) (b d f)))
+(let ()
+ (define (f1 . args)
+ (apply values (+ (car args) (cadr args)) (cddr args)))
+ (test (* (f1 2 3 4)) 20)
+ (test (* (f1 2 3 4) (f1 1 2 3)) 180)
+ (test (- (f1 2 3 4) (f1 1 2 3)) -5))
+
(test (call-with-values (lambda () (call/cc (lambda (k) (k 2 3)))) (lambda (x y) (list x y))) '(2 3))
(test (+ (call/cc (lambda (return) (return (values 1 2 3)))) 4) 10)
@@ -13233,12 +24046,23 @@ this prints:
(test (multiple-value-bind (a) 1 a) 1)
(test (multiple-value-bind (a . rest) (values 1 2 3) (+ a (apply + rest))) 6)
(test (multiple-value-bind a (values 1 2 3) a) '(1 2 3))
+(test (multiple-value-bind (x y z) (values 1 2 3) (list z y x)) '(3 2 1))
+(test (multiple-value-bind (x y z) (values 1 2 3) (let ((x 4)) (list x y z))) '(4 2 3))
+(test (multiple-value-bind (x y z) (values 1 2 3 4 5 6) (list x y z)) '(1 2 3))
+(test (multiple-value-bind (x y z) (values 1 2) (list x y z)) '(1 2 #f))
+(test (multiple-value-bind (x y z) (multiple-value-bind () (values 1 2) (values 'a 'b 'c)) (list x y z)) '(a b c))
+
+(test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64)) (+ a b)) 96)
+(test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64) (set! a (+ b 1))) (+ a b)) 129)
+(test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64 12)) (+ a b)) 96)
+(test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32)) (cons a b)) '(32 . #f))
+
+(test (multiple-value-set! #() "1234" #(0 1 2 3 4)) 'error)
+(test (multiple-value-set! "" #(0 1 2 3 4) :readable) 'error)
+(test (multiple-value-set! () #(0 1 2 3 4) :readable) 'error)
+(test (multiple-value-set! () ()) ())
+(test (multiple-value-set! () () 1 2) 2)
-(test (let ((a 1)
- (b 2))
- (multiple-value-set! (a b) (values 32 64))
- (+ a b))
- 96)
(test (let ((add (lambda (a b) (values (+ a 1) (+ b 1))))) (+ 1 (add 2 3))) 8)
(test (min (values 1 2) (values 3 0)) 0)
(test ((lambda* ((a 1) (b 2)) (list a b)) (values :b 231)) '(1 231))
@@ -13296,14 +24120,12 @@ this prints:
(test (cons (values 1 2)) '(1 . 2))
(test (number->string (values 1 2)) "1")
(test (object->string (values)) "#<unspecified>")
-(test (equal? (values) #<unspecified>) #f) ; hmmm -- this means that
-(test (equal? (begin) (begin (values))) #f) ; maybe this is a bug, but we want this:
+(test (equal? (values) #<unspecified>) #t)
+(test (equal? (begin) (begin (values))) #f) ; () but #<unspecified>
(test (map (lambda (x) (if #f x #<unspecified>)) (list 1 2)) '(#<unspecified> #<unspecified>))
-(test (equal? (values) (if #f #f)) #f)
+(test (equal? (values) (if #f #f)) #t)
(test (substring (values "hi") (values 1 2)) "i")
(test (cond (call-with-exit (values "hi"))) "hi")
-(test (procedure-arity (cond (values))) '(0 0 #t)) ; values as a procedure here
-(test (procedure-arity 'values) '(0 0 #t))
(test (values (begin (values "hi"))) "hi")
(test (< (values (values 1 2))) #t)
@@ -13312,6 +24134,285 @@ this prints:
(format (values #f "~A" lst)))
"#1=(0 . #1#)")
+(let ()
+ (define (mv n)
+ (define (mv-1 a)
+ (values a (+ a 1)))
+ (define (mv-2 b)
+ (values b (* b 2)))
+ (values n (mv-1 n) (mv-2 n)))
+ (test (list (mv 2)) '(2 2 3 2 4))
+ (test (+ (mv 1) (mv 3)) 26))
+
+(let ()
+ (define (fib n)
+ (define (1st a b)
+ a)
+ (define (fib-1 n)
+ (if (< n 3)
+ (values 1 1)
+ (values (+ (fib-1 (- n 1)))
+ (1st (fib-1 (- n 1))))))
+ (1st (fib-1 n)))
+ (test (fib 8) 21)
+ (test (fib 13) 233))
+
+(let ()
+ (define (fib n)
+ (define (1st a b)
+ a)
+ (define (2nd a b)
+ (values (+ a b) a))
+ (define (fib-1 n)
+ (if (< n 3)
+ (2nd 1 0)
+ (2nd (fib-1 (- n 1)))))
+ (1st (fib-1 n)))
+
+ (define (real-fib n)
+ (let ((phi (/ (+ 1 (sqrt 5)) 2)))
+ (floor (real-part (/ (- (expt phi n) ; "floor" to return an integer, real-part to guard against epsilonic imag-parts from expt
+ (expt (- 1 phi) n))
+ (sqrt 5))))))
+
+ (test (fib 8) (real-fib 8))
+ (test (fib 13) (real-fib 13)))
+
+(let ()
+ (define (cfib z) ; wikipedia "generalized fibonacci numbers"
+ (let ((phi (/ (+ 1 (sqrt 5)) 2)))
+ (/ (- (expt phi z)
+ (* (expt phi (- z)) (cos (* pi z))))
+ (sqrt 5))))
+
+ (num-test (cfib 3) 2.0)
+ (num-test (cfib 8) 21.0)
+ (num-test (cfib 3+4i) -5248.5113072837-14195.962288353i))
+
+(num-test (let ((f- -) (f+ +)) (define (fb n) (if (< n 2.0) n (f+ (fb (f- n 1.0)) (fb (f- n 2.0))))) (fb 12.0)) 144.0)
+
+(let ()
+ (define (flatten lst) ; flatten via values and map
+ (define (flatten-1 lst)
+ (cond ((null? lst) (values))
+ ((not (pair? lst)) lst)
+ (#t (values (flatten-1 (car lst))
+ (flatten-1 (cdr lst))))))
+ (map values (list (flatten-1 lst))))
+
+ (test (flatten '(1 2 3)) '(1 2 3))
+ (test (flatten ()) ())
+ (test (flatten '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7))
+ (test (flatten '(1 ((((2)) 3)))) '(1 2 3))
+ (test (flatten '(1 () 2)) '(1 2))
+ (test (flatten '((1 () 2) ())) '(1 2))
+ (test (flatten '(() 1 ((2 (3)) () 4))) '(1 2 3 4))
+ (test (flatten '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8))
+ (test (flatten '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2))
+ )
+
+(let ()
+ (define (flatten! lst) ; in-place flatten
+ (if (not (pair? lst))
+ lst
+ (let loop ((L lst))
+ (if (pair? (car L))
+ (let ((end (cdr L))
+ (p (car L)))
+ (set! (car L) (car p))
+ (set! (cdr L) (cdr p))
+ (set! (cdr (list-tail L (- (length p) 1))) end)
+ (loop L))
+ (if (not (null? (cdr L)))
+ (if (null? (car L))
+ (begin
+ (set! (car L) (cadr L))
+ (set! (cdr L) (cddr L))
+ (loop L))
+ (loop (cdr L)))))
+ (if (equal? lst '(()))
+ ()
+ (let ((len (length lst)))
+ (if (null? (car (list-tail lst (- len 1))))
+ (set! (cdr (list-tail lst (- len 2))) ()))
+ lst)))))
+
+ (test (flatten! '(1 2 3)) '(1 2 3))
+ (test (flatten! ()) ())
+ (test (flatten! '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7))
+ (test (flatten! '(1 ((((2)) 3)))) '(1 2 3))
+ (test (flatten! '(1 () 2)) '(1 2))
+ (test (flatten! '((1 () 2) ())) '(1 2))
+ (test (flatten! '(() 1 ((2 (3)) () 4))) '(1 2 3 4))
+ (test (flatten! '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8))
+ (test (flatten! '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2))
+ )
+
+(let ()
+ (define (flatten x) ; standard flatten
+ (cond ((null? x) ())
+ ((not (pair? x)) (list x))
+ (#t (append (flatten (car x))
+ (flatten (cdr x))))))
+
+ (test (flatten '(1 2 3)) '(1 2 3))
+ (test (flatten ()) ())
+ (test (flatten '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7))
+ (test (flatten '(1 ((((2)) 3)))) '(1 2 3))
+ (test (flatten '(1 () 2)) '(1 2))
+ (test (flatten '((1 () 2) ())) '(1 2))
+ (test (flatten '(() 1 ((2 (3)) () 4))) '(1 2 3 4))
+ (test (flatten '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8))
+ (test (flatten '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2))
+ )
+
+(test (let () (define (hi a) (+ (abs a) (values 1 2 3))) (hi -4)) 10)
+(let ()
+ (define (hi a)
+ (let ((x 0)
+ (again #f))
+ (let ((y (+ (abs a) (call/cc (lambda (r) (set! again r) 1)))))
+ (set! x (+ x y))
+ (if (< x 3) (again 1))
+ x)))
+ (test (hi 0) 3))
+
+(let ()
+ (define-macro (define-values vars . body)
+ `(apply begin (map (lambda (var val) `(define ,var ,val)) ',vars (list (begin , at body)))))
+
+ (define-macro (let*-values vars . body)
+ `(let ()
+ ,@(map (lambda (nvars . nbody)
+ `(apply define-values ',nvars ', at nbody))
+ (map car vars) (map cdr vars))
+ , at body))
+
+ (let ()
+ (define-values (a b) (values 3 2))
+ (test (* a b) 6))
+
+ (let ()
+ (test (let*-values (((a b) (values 3 2))) (* a b)) 6)))
+
+(define __p__ 123)
+(define current-rootlet (curlet))
+
+(let ((__p__ 321))
+ (set! __p__ 432))
+
+(if (not (= __p__ 123)) (format-logged #t "__p__: ~A~%" __p__))
+
+(let ()
+ (define (args) (values __p__ (* __p__ 2)))
+ (let ((__p__ 0)
+ (q 1))
+ (call-with-values args (lambda (a b) (set! __p__ a) (set! q b)))
+ (if (not (= __p__ 123)) (format-logged #t " local __p__: ~A~%" __p__))
+ (set! __p__ 432)
+ (call-with-values args (lambda (__p__ q) (set! __p__ 321)))
+ (if (not (= __p__ 432)) (format-logged #t " local __p__: ~A~%" __p__))))
+
+(if (not (= __p__ 123)) (format-logged #t "__p__: ~A~%" __p__))
+
+(let ()
+ (define-macro (args a b) `(values ,a ,b))
+ (define (sp a b)
+ (set! a 121))
+ (define (pq __p__ q)
+ (set! __p__ q))
+ (sp (args __p__ __p__))
+ (pq (args __p__ 567)))
+
+(if (not (= __p__ 123)) (format-logged #t "__p__: ~A~%" __p__))
+
+(let ((__p__ 321))
+ (eval '(set! __p__ 432) current-rootlet)
+ (if (not (= __p__ 321)) (format-logged #t " local __p__: ~A~%" __p__))
+ (eval '(set! __p__ 123))
+ (if (not (= __p__ 123)) (format-logged #t " local __p__: ~A~%" __p__)))
+
+(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+
+(let ()
+ (eval '(let ((__p__ 321)) (set! __p__ 456)) current-rootlet))
+
+(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+
+(let ((__p__ (values __p__)))
+ (if (not (= __p__ 432)) (format-logged #t " local __p__: ~A~%" __p__))
+ (set! __p__ 123))
+
+(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+
+(let ()
+ (define (sp __p__ q) (values __p__ q))
+ (call-with-values (lambda () (sp __p__ (* __p__ 2))) (let ((__p__ 1)) (lambda (a b) (set! __p__ a)))))
+
+(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+
+(let ((lst (list __p__ (* __p__ 2))))
+ (define-macro (sp a) `(set! __p__ ,a))
+ (let ((__p__ 0)
+ (q 1))
+ (define (pq a) (set! __p__ a))
+ (map sp (list __p__ q))
+ (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__))
+ (for-each sp (list __p__ q))
+ (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__))
+ (map sp lst)
+ (if (not (= __p__ (* 432 2))) (format-logged #t " local __p__: ~A~%" __p__))
+ (for-each sp lst)
+ (if (not (= __p__ (* 432 2))) (format-logged #t " local __p__: ~A~%" __p__))
+ (set! __p__ 0)
+ (set! q 1)
+ (map pq (list __p__ q))
+ (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__))
+ (for-each pq (list __p__ q))
+ (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__))
+ (map pq lst)
+ (if (not (= __p__ (* 432 2))) (format-logged #t " local __p__: ~A~%" __p__))
+ (for-each pq lst)
+ (if (not (= __p__ (* 432 2))) (format-logged #t " local __p__: ~A~%" __p__))))
+
+(if (not (= __p__ 432)) (format-logged #t "__p__: ~A~%" __p__))
+
+(if (eq? (curlet) (rootlet)) (begin
+(let ((__p__ 1))
+ (eval `(define (__p__ a) (+ a ,__p__)) current-rootlet)
+ (if (not (= __p__ 1)) (format-logged #t " local __p__: ~A~%" __p__)))
+
+(if (not (procedure? __p__)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= (__p__ 2) 3)) (format-logged #t "(__p__ 2): ~A~%" (__p__ 2)))
+
+(let ((__p__ 1))
+ (eval `(define __p__ 32))
+ (if (not (= __p__ 32)) (format-logged #t " local __p__: ~A~%" __p__)))
+
+(if (not (procedure? __p__)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= (__p__ 2) 3)) (format-logged #t "(__p__ 2): ~A~%" (__p__ 2)))
+
+(let ((__p__ 1))
+ (eval `(define __p__ 32) (curlet))
+ (if (not (= __p__ 32)) (format-logged #t " local __p__: ~A~%" __p__)))
+
+(if (not (procedure? __p__)) (format-logged #t "__p__: ~A~%" __p__))
+(if (not (= (__p__ 2) 3)) (format-logged #t "(__p__ 2): ~A~%" (__p__ 2)))
+))
+
+(let ()
+ (define-macro (m1) (values))
+ (define-macro (m2) (values 2 3))
+ (define-macro (m3) (values '(+ 1 2) '(* 3 4)))
+ (define-macro (m4) (values '(define a 1) '(define b 2)))
+ (define-macro (m5 a b) (values `(define a ,a) `(define b (+ ,b 1))))
+
+ (test (begin (m1)) #<unspecified>)
+ (test (+ (m2)) 5)
+ (test (+ 1 (m3) 3) 19)
+ (test (let () (m4) (+ a b)) 3)
+ (test (let () (m5 1 2) (+ a b)) 4))
+
@@ -13319,6 +24420,7 @@ this prints:
;;; let
;;; let*
;;; letrec
+;;; letrec*
;;; --------------------------------------------------------------------------------
(test (let ((x 2) (y 3)) (* x y)) 6)
@@ -13326,10 +24428,10 @@ this prints:
(test (let ((x 32)) (let* ((x 3) (y x)) y)) 3)
(test (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))) 35)
(test (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x))) 70)
-(test (letrec ((even? (lambda (n) (if (zero? n) #t (odd? (- n 1))))) (odd? (lambda (n) (if (zero? n) #f (even? (- n 1)))))) (even? 88)) #t)
+(test (letrec ((is-even (lambda (n) (if (zero? n) #t (is-odd (- n 1))))) (is-odd (lambda (n) (if (zero? n) #f (is-even (- n 1)))))) (is-even 88)) #t)
(test (let loop ((numbers '(3 -2 1 6 -5))
- (nonneg '())
- (neg '()))
+ (nonneg ())
+ (neg ()))
(cond ((null? numbers)
(list nonneg neg))
((>= (car numbers) 0)
@@ -13346,6 +24448,7 @@ this prints:
(test (let foo () 1) 1)
(test (let ((f -)) (let f ((n (f 1))) n)) -1)
(test (let () 1 2 3 4) 4)
+(test (+ 3 (let () (+ 1 2))) 6)
(test (let ((x 1)) (let ((x 32) (y x)) y)) 1)
(test (let ((x 1)) (letrec ((y (if #f x 1)) (x 32)) 1)) 1)
@@ -13362,20 +24465,41 @@ this prints:
(test (let ((x 0) (y 1)) (let ((x y) (y x)) (list x y))) (list 1 0))
(test (let ((x 0) (y 1)) (let* ((x y) (y x)) (list x y))) (list 1 1))
(test (letrec ((sum (lambda (x) (if (zero? x) 0 (+ x (sum (- x 1))))))) (sum 5)) 15)
-(test (let ((divisors (lambda (n) (let f ((i 2)) (cond ((>= i n) '()) ((integer? (/ n i)) (cons i (f (+ i 1)))) (else (f (+ i 1)))))))) (divisors 32)) '(2 4 8 16))
+(test (let ((divisors (lambda (n) (let f ((i 2)) (cond ((>= i n) ()) ((integer? (/ n i)) (cons i (f (+ i 1)))) (else (f (+ i 1)))))))) (divisors 32)) '(2 4 8 16))
(test (let ((a -1)) (let loop () (if (not (positive? a)) (begin (set! a (+ a 1)) (loop)))) a) 1)
-(test (let* ((let 3) (x let)) (+ x let)) 6)
-(test (let () (let () (let () '()))) '())
+(test (let () (let () (let () ()))) ())
(test (let ((x 1)) (let ((y 0)) (begin (let ((x (* 2 x))) (set! y x))) y)) 2)
(test (let* ((x 1) (x (+ x 1)) (x (+ x 2))) x) 4)
(test (let ((.. 2) (.... 4) (..... +)) (..... .. ....)) 6)
(test (let () (begin (define x 1)) x) 1)
+(test (let ((define 1)) define) 1)
(test (let ((y 1)) (begin (define x 1)) (+ x y)) 2)
(test (let ((: 0)) (- :)) 0)
;; this only works if we haven't called (string->symbol "") making : into a keyword (see also other cases below)
;; perhaps I should document this weird case -- don't use : as a variable name
+;;; optimizer troubles
+(test (let () (define (f x) (let asd ())) (f 1)) 'error)
+(test (let () (define (f x) (let ())) (f 1)) 'error)
+
+(test (let ((pi 3)) pi) 'error)
+(test (let ((:key 1)) :key) 'error)
+(test (let ((:3 1)) 1) 'error)
+(test (let ((3 1)) 1) 'error)
+(test (let ((3: 1)) 1) 'error)
+(test (let ((optional: 1)) 1) 'error)
+(test (let ((x_x_x 32)) (let () (define-constant x_x_x 3) x_x_x) (set! x_x_x 31) x_x_x) 'error)
+(test (let ((x 1)) (+ (let ((a (begin (define x 2) x))) a) x)) 4)
+(test (let ((x 1)) (+ (letrec ((a (begin (define x 2) x))) a) x)) 3)
+(test (let ((a #<eof>)) (eof-object? a)) #t)
+(test (let ((a #<unspecified>)) (eq? a #<unspecified>)) #t)
+(test (let* ((x 1) (x (+ x 1))) x) 2) ; ??
+
+(test (let _name_ ((x 1) (y (_name_ 2))) (+ x y)) 'error)
+(test (let* _name_ ((x 1) (y (_name_ 2))) (+ x y)) 'error)
+(let () (define (hi) (let* named-let ((i 0) (j (+ i 1))) j)) (hi) (test (hi) 1))
+
(test ((let ((x 2))
(let ((x 3))
(lambda (arg) (+ arg x))))
@@ -13547,6 +24671,22 @@ this prints:
(g))))
1)
+(test (let ((a 1))
+ (let ()
+ (if (> a 1)
+ (begin
+ (define a 2)))
+ a))
+ 1)
+
+(test (let ((a 1))
+ (let ()
+ (if (= a 1)
+ (begin
+ (define a 2)))
+ a))
+ 2)
+
(let ((x 123))
(define (hi b) (+ b x))
(let ((x 321))
@@ -13579,12 +24719,15 @@ this prints:
(list 16 4))
(test (let ((x 123)) (begin (define x 0)) x) 0) ; this strikes me as weird, since (let ((x 123) (x 0)) x) is illegal, so...
+(test (let ((x 0)) (define x 1) (define x 2) x) 2)
(test (let ((x 123)) (begin (define (hi a) (+ x a)) (define x 0)) (hi 1)) 1) ; is non-lexical reference?
+(test (let ((x 123)) (define (hi a) (+ x a)) (define x 0) (hi 1)) 1)
+(test (let ((x 123) (y 0)) (define (hi a) (+ y a)) (define y x) (define x 0) (hi 1)) 124)
(for-each
(lambda (arg)
(test (let ((x arg)) x) arg))
- (list "hi" -1 #\a "" '() '#() (current-output-port) 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t abs (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a "" () #() (current-output-port) 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t abs (list 1 2 3) '(1 . 2)))
(test (let ((x 1)) (= 1 (let ((y 2)) (set! x y) x)) (+ x 1)) 3)
(test (let ((x 1)) (let ((xx (lambda (a) (set! x a) a))) (= 1 (xx 2))) (+ x 1)) 3)
@@ -13595,35 +24738,35 @@ this prints:
;(let ((initial-chars "aA!$%&*/:<=>?^_~")
; (subsequent-chars "9aA!$%&*+-./:<=>?@^_~")
; (ctr 0))
- ; (format #t ";(let (")
+ ; (format-logged #t ";(let (")
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
- ; (format #t ";(~A ~D) " (string (string-ref initial-chars i)) ctr)
+ ; (format-logged #t ";(~A ~D) " (string (string-ref initial-chars i)) ctr)
; (set! ctr (+ ctr 1)))
;
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (format #t ";(~A ~D) " (string (string-ref initial-chars i) (string-ref subsequent-chars k)) ctr)
+ ; (format-logged #t ";(~A ~D) " (string (string-ref initial-chars i) (string-ref subsequent-chars k)) ctr)
; (set! ctr (+ ctr 1))))
;
- ; (format #t ")~% (+ ")
+ ; (format-logged #t ")~% (+ ")
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
- ; (format #t "~A " (string (string-ref initial-chars i))))
+ ; (format-logged #t "~A " (string (string-ref initial-chars i))))
;
; (do ((i 0 (+ i 1)))
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (format #t "~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k)))))
+ ; (format-logged #t "~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k)))))
;
- ; (format #t "))~%"))
+ ; (format-logged #t "))~%"))
-(num-test (let ((a 0) (A 1) (! 2) ($ 3) (% 4) (& 5) (* 6) (/ 7) (| 8) (< 9) (= 10) (> 11) (? 12) (^ 13) (_ 14) (~ 15) (a9 16) (aa 17) (aA 18) (a! 19) (a$ 20) (a% 21) (a& 22) (a* 23) (a+ 24) (a- 25) (a. 26) (a/ 27) (a| 28) (a< 29) (a= 30) (a> 31) (a? 32) (a@ 33) (a^ 34) (a_ 35) (a~ 36) (A9 37) (Aa 38) (AA 39) (A! 40) (A$ 41) (A% 42) (A& 43) (A* 44) (A+ 45) (A- 46) (A. 47) (A/ 48) (A| 49) (A< 50) (A= 51) (A> 52) (A? 53) (A@ 54) (A^ 55) (A_ 56) (A~ 57) (!9 58) (!a 59) (!A 60) (!! 61) (!$ 62) (!% 63) (!& 64) (!* 65) (!+ 66) (!- 67) (!. 68) (!/ 69) (!| 70) (!< 71) (!= 72) (!> 73) (!? 74) (!@ 75) (!^ 76) (!_ 77) (!~ 78) ($9 79) ($a 80) ($A 81) ($! 82) ($$ 83) ($% 84) ($& 85) ($* 86) ($+ 87) ($- 88) ($. 89) ($/ 90) ($| 91) ($< 92) ($= 93) ($> 94) ($? 95) ($@ 96) ($^ 97) ($_ 98) ($~ 99) (%9 100) (%a 101) (%A 102) (%! 103) (%$ 104) (%% 105) (%& 106) (%* 107) (%+ 108) (%- 109) (%. 110) (%/ 111) (%| 112) (%< 113) (%= 114) (%> 115) (%? 116) (%@ 117) (%^ 118) (%_ 119) (%~ 120) (&9 121) (&a 122) (&A 123) (&! 124) (&$ 125) (&% 126) (&& 127) (&* 128) (&+ 129) (&- 130) (&. 131) (&/ 132) (&| 133) (&< 134) (&= 135) (&> 136) (&? 137) (&@ 138) (&^ 139) (&_ 140) (&~ 141) (*9 142) (*a 143) (*A 144) (*! 145) (*$ 146) (*% 147) (*& 148) (** 149) (*+ 150) (*- 151) (*. 152) (*/ 153) (*| 154) (*< 155) (*= 156) (*> 157) (*? 158) (*@ 159) (*^ 160) (*_ 161) (*~ 162) (/9 163) (/a 164) (/A 165) (/! 166) (/$ 167) (/% 168) (/& 169) (/* 170) (/+ 171) (/- 172) (/. 173) (// 174) (/| 175) (/< 176) (/= 177) (/> 178) (/? 179) (/@ 180) (/^ 181) (/_ 182) (/~ 183) (|9 184) (ca 185) (CA 186) (|! 187) (|$ 188) (|% 189) (|& 190) (|* 191) (|+ 192) (|- 193) (|. 194) (|/ 195) (cc 196) (|< 197) (|= 198) (|> 199) (|? 200) (|@ 201) (|^ 202) (|_ 203) (|~ 204) (<9 205) (<a 206) (<A 207) (<! 208) (<$ 209) (<% 210) (<& 211) (<* 212) (<+ 213) (<- 214) (<. 215) (</ 216) (<| 217) (<< 218) (<= 219) (<> 220) (<? 221) (<@ 222) (<^ 223) (<_ 224) (<~ 225) (=9 226) (=a 227) (=A 228) (=! 229) (=$ 230) (=% 231) (=& 232) (=* 233) (=+ 234) (=- 235) (=. 236) (=/ 237) (=| 238) (=< 239) (== 240) (=> 241) (=? 242) (=@ 243) (=^ 244) (=_ 245) (=~ 246) (>9 247) (>a 248) (>A 249) (>! 250) (>$ 251) (>% 252) (>& 253) (>* 254) (>+ 255) (>- 256) (>. 257) (>/ 258) (>| 259) (>< 260) (>= 261) (>> 262) (>? 263) (>@ 264) (>^ 265) (>_ 266) (>~ 267) (?9 268) (?a 269) (?A 270) (?! 271) (?$ 272) (?% 273) (?& 274) (?* 275) (?+ 276) (?- 277) (?. 278) (?/ 279) (?| 280) (?< 281) (?= 282) (?> 283) (?? 284) (?@ 285) (?^ 286) (?_ 287) (?~ 288) (^9 289) (^a 290) (^A 291) (^! 292) (^$ 293) (^% 294) (^& 295) (^* 296) (^+ 297) (^- 298) (^. 299) (^/ 300) (^| 301) (^< 302) (^= 303) (^> 304) (^? 305) (^@ 306) (^^ 307) (^_ 308) (^~ 309) (_9 310) (_a 311) (_A 312) (_! 313) (_$ 314) (_% 315) (_& 316) (_* 317) (_+ 318) (_- 319) (_. 320) (_/ 321) (_| 322) (_< 323) (_= 324) (_> 325) (_? 326) (_@ 327) (_^ 328) (__ 329) (_~ 330) (~9 331) (~a 332) (~A 333) (~! 334) (~$ 335) (~% 336) (~& 337) (~* 338) (~+ 339) (~- 340) (~. 341) (~/ 342) (~| 343) (~< 344) (~= 345) (~> 346) (~? 347) (~@ 348) (~^ 349) (~_ 350) (~~ 351) )
- (+ a A ! $ % & * / | < = > ? ^ _ ~ a9 aa aA a! a$ a% a& a* a+ a- a. a/ a| a< a= a> a? a@ a^ a_ a~ A9 Aa AA A! A$ A% A& A* A+ A- A. A/ A| A< A= A> A? A@ A^ A_ A~ !9 !a !A !! !$ !% !& !* !+ !- !. !/ !| !< != !> !? !@ !^ !_ !~ $9 $a $A $! $$ $% $& $* $+ $- $. $/ $| $< $= $> $? $@ $^ $_ $~ %9 %a %A %! %$ %% %& %* %+ %- %. %/ %| %< %= %> %? %@ %^ %_ %~ &9 &a &A &! &$ &% && &* &+ &- &. &/ &| &< &= &> &? &@ &^ &_ &~ *9 *a *A *! *$ *% *& ** *+ *- *. */ *| *< *= *> *? *@ *^ *_ *~ /9 /a /A /! /$ /% /& /* /+ /- /. // /| /< /= /> /? /@ /^ /_ /~ |9 ca CA |! |$ |% |& |* |+ |- |. |/ cc |< |= |> |? |@ |^ |_ |~ <9 <a <A <! <$ <% <& <* <+ <- <. </ <| << <= <> <? <@ <^ <_ <~ =9 =a =A =! =$ =% =& =* =+ =- =. =/ =| =< == => =? =@ =^ =_ =~ >9 >a >A >! >$ >% >& >* >+ >- >. >/ >| >< >= >> >? >@ >^ >_ >~ ?9 ?a ?A ?! ?$ ?% ?& ?* ?+ ?- ?. ?/ ?| ?< ?= ?> ?? ?@ ?^ ?_ ?~ ^9 ^a ^A ^! ^$ ^% ^& ^* ^+ ^- ^. ^/ ^| ^< ^= ^> ^? ^@ ^^ ^_ ^~ _9 _a _A _! _$ _% _& _* _+ _- _. _/ _| _< _= _> _? _@ _^ __ _~ ~9 ~a ~A ~! ~$ ~% ~& ~* ~+ ~- ~. ~/ ~| ~< ~= ~> ~? ~@ ~^ ~_ ~~ ))
- 61776)
+(num-test (let ((a 0) (A 1) (! 2) ($ 3) (% 4) (& 5) (| 8) (? 12) (^ 13) (_ 14) (~ 15) (a9 16) (aa 17) (aA 18) (a! 19) (a$ 20) (a% 21) (a& 22) (a* 23) (a+ 24) (a- 25) (a. 26) (a/ 27) (a| 28) (a< 29) (a= 30) (a> 31) (a? 32) (a@ 33) (a^ 34) (a_ 35) (a~ 36) (A9 37) (Aa 38) (AA 39) (A! 40) (A$ 41) (A% 42) (A& 43) (A* 44) (A+ 45) (A- 46) (A. 47) (A/ 48) (A| 49) (A< 50) (A= 51) (A> 52) (A? 53) (A@ 54) (A^ 55) (A_ 56) (A~ 57) (!9 58) (!a 59) (!A 60) (!! 61) (!$ 62) (!% 63) (!& 64) (!* 65) (!+ 66) (!- 67) (!. 68) (!/ 69) (!| 70) (!< 71) (!= 72) (!> 73) (!? 74) (!@ 75) (!^ 76) (!_ 77) (!~ 78) ($9 79) ($a 80) ($A 81) ($! 82) ($$ 83) ($% 84) ($& 85) ($* 86) ($+ 87) ($- 88) ($. 89) ($/ 90) ($| 91) ($< 92) ($= 93) ($> 94) ($? 95) ($@ 96) ($^ 97) ($_ 98) ($~ 99) (%9 100) (%a 101) (%A 102) (%! 103) (%$ 104) (%% 105) (%& 106) (%* 107) (%+ 108) (%- 109) (%. 110) (%/ 111) (%| 112) (%< 113) (%= 114) (%> 115) (%? 116) (%@ 117) (%^ 118) (%_ 119) (%~ 120) (&9 121) (&a 122) (&A 123) (&! 124) (&$ 125) (&% 126) (&& 127) (&* 128) (&+ 129) (&- 130) (&. 131) (&/ 132) (&| 133) (&< 134) (&= 135) (&> 136) (&? 137) (&@ 138) (&^ 139) (&_ 140) (&~ 141) (*9 142) (*a 143) (*A 144) (*! 145) (*$ 146) (*% 147) (*& 148) (** 149) (*+ 150) (*- 151) (*. 152) (*/ 153) (*| 154) (*< 155) (*= 156) (*> 157) (*? 158) (*@ 159) (*^ 160) (*_ 161) (*~ 162) (/9 163) (/a 164) (/A 165) (/! 166) (/$ 167) (/% 168) (/& 169) (/* 170) (/+ 171) (/- 172) (/. 173) (// 174) (/| 175) (/< 176) (/= 177) (/> 178) (/? 179) (/@ 180) (/^ 181) (/_ 182) (/~ 183) (|9 184) (ca 185) (CA 186) (|! 187) (|$ 188) (|% 189) (|& 190) (|* 191) (|+ 192) (|- 193) (|. 194) (|/ 195) (cc 196) (|< 197) (|= 198) (|> 199) (|? 200) (|@ 201) (|^ 202) (|_ 203) (|~ 204) (<9 205) (<a 206) (<A 207) (<! 208) (<$ 209) (<% 210) (<& 211) (<* 212) (<+ 213) (<- 214) (<. 215) (</ 216) (<| 217) (<< 218) (<> 220) (<? 221) (<@ 222) (<^ 223) (<_ 224) (<~ 225) (=9 226) (=a 227) (=A 228) (=! 229) (=$ 230) (=% 231) (=& 232) (=* 233) (=+ 234) (=- 235) (=. 236) (=/ 237) (=| 238) (=< 239) (== 240) (=> 241) (=? 242) (=@ 243) (=^ 244) (=_ 245) (=~ 246) (>9 247) (>a 248) (>A 249) (>! 250) (>$ 251) (>% 252) (>& 253) (>* 254) (>+ 255) (>- 256) (>. 257) (>/ 258) (>| 259) (>< 260) (>> 262) (>? 263) (>@ 264) (>^ 265) (>_ 266) (>~ 267) (?9 268) (?a 269) (?A 270) (?! 271) (?$ 272) (?% 273) (?& 274) (?* 275) (?+ 276) (?- 277) (?. 278) (?/ 279) (?| 280) (?< 281) (?= 282) (?> 283) (?? 284) (?@ 285) (?^ 286) (?_ 287) (?~ 288) (^9 289) (^a 290) (^A 291) (^! 292) (^$ 293) (^% 294) (^& 295) (^* 296) (^+ 297) (^- 298) (^. 299) (^/ 300) (^| 301) (^< 302) (^= 303) (^> 304) (^? 305) (^@ 306) (^^ 307) (^_ 308) (^~ 309) (_9 310) (_a 311) (_A 312) (_! 313) (_$ 314) (_% 315) (_& 316) (_* 317) (_+ 318) (_- 319) (_. 320) (_/ 321) (_| 322) (_< 323) (_= 324) (_> 325) (_? 326) (_@ 327) (_^ 328) (__ 329) (_~ 330) (~9 331) (~a 332) (~A 333) (~! 334) (~$ 335) (~% 336) (~& 337) (~* 338) (~+ 339) (~- 340) (~. 341) (~/ 342) (~| 343) (~< 344) (~= 345) (~> 346) (~? 347) (~@ 348) (~^ 349) (~_ 350) (~~ 351) )
+ (+ a A ! $ % & | ? ^ _ ~ a9 aa aA a! a$ a% a& a* a+ a- a. a/ a| a< a= a> a? a@ a^ a_ a~ A9 Aa AA A! A$ A% A& A* A+ A- A. A/ A| A< A= A> A? A@ A^ A_ A~ !9 !a !A !! !$ !% !& !* !+ !- !. !/ !| !< != !> !? !@ !^ !_ !~ $9 $a $A $! $$ $% $& $* $+ $- $. $/ $| $< $= $> $? $@ $^ $_ $~ %9 %a %A %! %$ %% %& %* %+ %- %. %/ %| %< %= %> %? %@ %^ %_ %~ &9 &a &A &! &$ &% && &* &+ &- &. &/ &| &< &= &> &? &@ &^ &_ &~ *9 *a *A *! *$ *% *& ** *+ *- *. */ *| *< *= *> *? *@ *^ *_ *~ /9 /a /A /! /$ /% /& /* /+ /- /. // /| /< /= /> /? /@ /^ /_ /~ |9 ca CA |! |$ |% |& |* |+ |- |. |/ cc |< |= |> |? |@ |^ |_ |~ <9 <a <A <! <$ <% <& <* <+ <- <. </ <| << <> <? <@ <^ <_ <~ =9 =a =A =! =$ =% =& =* =+ =- =. =/ =| =< == => =? =@ =^ =_ =~ >9 >a >A >! >$ >% >& >* >+ >- >. >/ >| >< >> >? >@ >^ >_ >~ ?9 ?a ?A ?! ?$ ?% ?& ?* ?+ ?- ?. ?/ ?| ?< ?= ?> ?? ?@ ?^ ?_ ?~ ^9 ^a ^A ^! ^$ ^% ^& ^* ^+ ^- ^. ^/ ^| ^< ^= ^> ^? ^@ ^^ ^_ ^~ _9 _a _A _! _$ _% _& _* _+ _- _. _/ _| _< _= _> _? _@ _^ __ _~ ~9 ~a ~A ~! ~$ ~% ~& ~* ~+ ~- ~. ~/ ~| ~< ~= ~> ~? ~@ ~^ ~_ ~~ ))
+ 61253)
(test (let ()(+ (let ((x 0) (y 1) (z 2) )(+ x y (let ((x 3) )(+ x (let ()(+ (let ()
(+ (let ((x 0) (y 1) (z 2) )(+ x y z (let ((x 3) )(+ x (let ((x 4) (y 5) (z 6) )
@@ -13645,12 +24788,13 @@ this prints:
(test (let ((hi: 1)) hi) 'error)
(let ((1.0+2j (lambda (a) (+ a 1.0+2i))))
(num-test (1.0+2j 3+i) 4.0+3i))
+(test (let ((*1.11* 3)) *1.11*) 3)
(test (let func ((a 1) (b 2)) (set! b a) (if (> b 0) (func (- a 1) b)) b) 1)
(test (let func ((a 1) (b 2)) (set! b a) (if (> b 0) (func (- a 1) b) b)) 0)
(test (let loop ((numbers '(3 -2 1 6 -5))
- (nonneg '())
- (neg '()))
+ (nonneg ())
+ (neg ()))
(cond ((null? numbers) (list nonneg neg))
((>= (car numbers) 0)
(loop (cdr numbers)
@@ -13675,7 +24819,12 @@ this prints:
x))
0)
(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1) (- b 1) (- c 1)) 0))) 6)
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1) (- b 1)) 0))) 6) ; these work only because we don't try to call func -- maybe they should anyway?
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1)) 0))) 6)
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func) 0))) 6)
(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 0) (func (- a 1) (- b 1) (- c 1)) 0))) 9)
+
+(test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 0) (func (- a 1) (- b 1)) 0))) 'error)
(test (let func () 1) 1)
(test (let ((a 1)) (let func () (if (> a 1) (begin (set! a (- a 1)) (func)) 0))) 0)
(test (let func1 ((a 1)) (+ (let func2 ((a 2)) a) a)) 3)
@@ -13685,7 +24834,6 @@ this prints:
(test (let func ((a 1)) (define (func a) 2) (func 1)) 2)
(test (let func ((a 1)) (define func (lambda (a) (func a))) (if (> a 1) (func (- a 1)) 0)) 0)
(test (let loop ((i 0)) (let loop ((i 0)) (if (< i 1) (loop (+ i 1)))) i) 0)
-(test (let * ((i 0)) (if (< i 1) (* (+ i 1))) i) 0)
(test (let ((j 123)) (define (f g) (set! j 0) (g 0)) (let loop ((i 1)) (if (> i 0) (f loop))) j) 0)
(test (procedure? (let loop () loop)) #t)
(test (let loop1 ((func 0)) (let loop2 ((i 0)) (if (not (procedure? func)) (loop1 loop2)) func)) 0)
@@ -13694,6 +24842,11 @@ this prints:
(test (let ((hi''' 3) (a'''b 2)) (+ hi''' a'''b)) 5)
(test (let ((f (let func ((i 0)) (if (= i 0) func (if (> i 1) (+ i (func (- i 1))) 1))))) (map f '(1 2 3))) '(1 3 6))
(test (let ((x 0)) (let ((f (lambda (a) (+ a x)))) (map (let () (set! x (+ x 1)) f) '(1 2 3)))) '(2 3 4))
+(test (let x ((x (lambda (y) y))) (x 2)) 2)
+
+(test (let () (define (f4) (let loop ((i 0)) (set! loop 3) loop)) (f4)) 3)
+(test (let () (define (f5) (let loop ((i 0)) (set! loop (lambda () 2)) (loop))) (f5)) 2)
+(test (let () (define (f6) (let loop ((i 0)) (define (loop) 2) (loop))) (f6)) 2)
(let ((enter 0)
(exit 0)
@@ -13727,10 +24880,10 @@ this prints:
a comment
|#
1 #| this is a |#
-#!
+#|
another comment
-!#
- 2 #! this is b !# 3)))
+|#
+ 2 #| this is b |# 3)))
(test val 6)))
@@ -13782,6 +24935,21 @@ this prints:
(test (let* ((x -1) 2) 3) 'error)
(test (let ((x -1) 2) 3) 'error)
(test (letrec ((x -1) 2) 3) 'error)
+(test (let ((pi 3)) pi) 'error)
+(test (let* ((pi 3)) pi) 'error)
+(test (letrec ((pi 3)) pi) 'error)
+
+(test (let ((a 1) (a 2)) a) 'error)
+(test (letrec ((a 1) (a 2)) a) 'error)
+(test (letrec* ((a 1) (a 2)) a) 'error)
+(test (let* ((a 1) (a (+ a 1))) a) 2) ; ??
+
+(test (let hiho ((a 3) (hiho 4)) a) 3)
+(test (let hiho ((hiho 4)) hiho) 4) ; guile=4
+(test (let hiho ((hiho hiho)) hiho) 'error) ; guile sez error
+(test (let ((hiho 4) (hiho 5)) hiho) 'error) ; guile sez error
+(test (let hiho ((a (hiho 1))) a) 'error) ; guile sez error
+(test (let hiho ((hiho 3)) (hiho hiho)) 'error) ; guile sez error
(test (let) 'error)
(test (let*) 'error)
@@ -13834,8 +25002,7 @@ this prints:
;; (test (let ((#z1 2)) 1) 'error)
(test (let ('a 3) 1) 'error)
(test (let 'a 1) 'error)
-;; what about: (let ('1 ) quote) -> 1
-(test (let* func ((a 1)) a) 'error)
+(test (let* func ((a 1)) a) 1)
(test (letrec func ((a 1)) a) 'error)
(test (letrec* func ((a 1)) a) 'error)
@@ -13851,6 +25018,7 @@ this prints:
(test (let "hi" ((i 0)) i) 'error)
(test (let #\c ((i 0)) i) 'error)
(test (let :hi ((i 0)) i) 'error)
+(test (let pi () #f) 'error)
(test (let func ((a 1) . b) a) 'error)
(test (let func a . b) 'error)
@@ -13867,7 +25035,7 @@ this prints:
(test (let ((x 0)) (set! x (+ x 1)) (begin (define y 1)) (+ x y)) 2)
(test (let loop loop) 'error)
(test (let loop (loop)) 'error)
-(test (let loop ((i 0) (loop 1)) i) 'error)
+(test (let loop ((i 0) (loop 1)) i) 0) ; this used to be an error, Guile also returns 0
(test (letrec ((cons 1 (quote ())) . #(1)) 1) 'error)
(test (letrec ((a 1) . 2) 1) 'error)
@@ -13876,12 +25044,39 @@ this prints:
(test (let "hi" 1) 'error)
(test (let #(1) 1) 'error)
(test (let __hi__ #t) 'error)
-(test (let* hi () 1) 'error)
(test (letrec (1 2) #t) 'error)
(test (letrec* (1 2) #t) 'error)
(test (let hi (()) 1) 'error)
(test (let hi a 1) 'error)
+;;; named let*
+(test (let* hi #t) 'error)
+(test (let* "hi" () #f) 'error)
+(test (let* hi ()) 'error)
+(test (let* pi () #f) 'error)
+(test (let* hi x 1) 'error)
+(test (let* hi (c) 1) 'error)
+(test (let* hi ((x . 1)) #f) 'error)
+;(test (let* hi . a 1) 'error) -- reader error in this context
+(test (let* hi ((a 1) . b) a) 'error)
+(test (let* hi ((a 1) :key b) a) 'error)
+(test (let* hi ((a 1) :allow-other-keys) a) 'error)
+(test (let* hi (a b) a) 'error)
+
+(test (let* hi () 1) 1)
+(test (let* func ((i 1) (j 2)) (+ i j (if (> i 0) (func (- i 1)) 0))) 5)
+(test (let* func ((i 1) (j 2) (k (+ j 1))) (+ i j k (if (> i 0) (func (- i 1)) 0))) 11)
+(test (let* func ((i 1) (j 2) (k (+ j 1))) (+ i j k (let () (set! j -123) (if (> i 0) (func (- i 1)) 0)))) 11)
+(test (let* func1 ((a 1) (b 2)) (+ a b (let* func2 ((a -1) (b (- a 1))) (if (< a 0) (func2 (+ a 1)) b)))) 2) ; 2nd b is -1 -- this changed 8-Jan-14
+(test (procedure? (let* func ((i 1) (j 2) (k (+ j 1))) func)) #t)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func (- a 1) (- b 1)) 0))) 4)
+(test (let* func ((a 1) (b 2)) (+ a b)) 3)
+(test (let* func ((a (+ 1 2)) (b (+ a 2))) (+ a b)) 8)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func (- a 1) :b (- b 1)) 0))) 4)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :a (- a 1) :b (- b 1)) 0))) 4)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :b (- b 1) :a (- a 1)) 0))) 4)
+(test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :a (- a 1)) 0))) 5)
+
;;; these ought to work, but see s7.c under EVAL: (it's a speed issue)
;(test (let let ((i 0)) (if (< i 3) (let (+ i 1)) i)) 3)
;(test (let () (define (if a) a) (if 1)) 1)
@@ -13897,7 +25092,7 @@ this prints:
(let loop ((p 3) ; Maintains invariant p = 2j + 1
(q 4) ; Maintains invariant q = 2j + 2jj
(j 1)
- (k '())
+ (k ())
(vec pvector))
(letrec ((lp (lambda (p q j k vec)
(loop (+ 2 p)
@@ -14011,7 +25206,14 @@ this prints:
(test (letrec* ()) 'error)
(test (letrec* ((x 1 x)) x) 'error)
-(test (letrec ((x (let () (set! y 1) y)) (y (let () (set! y (+ y 1)) y))) (list x y)) '(1 2)) ; !
+(test (letrec* ((x x)) x) #<undefined>) ;??
+(test (let ((x 1)) (letrec* ((x x)) x)) #<undefined>)
+(test (letrec ((x x)) x) #<undefined>)
+(test (let ((x 1)) (letrec ((x x)) x)) #<undefined>)
+;; here they are different:
+(test (let ((x 1)) (letrec* ((x 0) (y x)) y)) 0)
+(test (let ((x 1)) (letrec ((x 0) (y x)) y)) #<undefined>)
+;(test (letrec ((x (let () (set! y 1) y)) (y (let () (set! y (+ y 1)) y))) (list x y)) '(1 2)) ; ! this depends on letrec binding order
(test (letrec ((x 1) (y x)) (list x y)) '(1 #<undefined>)) ; guile says '(1 1)
(test (letrec ((y x) (x 1)) (list x y)) '(1 #<undefined>)) ; guile says '(1 1)
@@ -14019,7 +25221,7 @@ this prints:
(test (letrec ((history (list 9))) ((lambda (n) (begin (set! history (cons history n)) history)) 8)) '((9) . 8))
(test (((call/cc (lambda (k) k)) (lambda (x) x)) 'HEY!) 'HEY!)
-(let ((sequence '()))
+(let ((sequence ()))
((call-with-current-continuation
(lambda (goto)
(letrec ((start
@@ -14070,10 +25272,39 @@ this prints:
(test (let ((x 1)) (+ (begin (set! x 2) x) x)) 4)
(test (let ((x 1)) ((if (= x 1) + -) x (begin (set! x 2) x))) 3)
+(let ()
+ (define-constant _letrec_x_ 32)
+ (test (letrec ((_letrec_x_ 1)) _letrec_x_) 'error))
+(let ()
+ (define-constant _let_x_ 32)
+ (test (let ((_let_x_ 1)) _let_x_) 'error))
+(let ()
+ (define-constant _let*_x_ 32)
+ (test (let* ((_let*_x_ 1)) _let*_x_) 'error))
+
+#|
+;;; here is the old letrec* macro:
+(define-macro (letrec* bindings . body)
+ (if (null? body)
+ (error 'syntax-error "letrec* has no body")
+ (if (not (list? bindings))
+ (error 'syntax-error "letrec* variables are messed up")
+ `(let (,@(map (lambda (var&init)
+ (list (car var&init) #<undefined>))
+ bindings))
+ ,@(map (lambda (var&init)
+ (if (not (null? (cddr var&init)))
+ (error 'syntax-error "letrec* variable has more than one value"))
+ (list 'set! (car var&init) (cadr var&init)))
+ bindings)
+ , at body))))
+|#
+
;;; --------------------------------------------------------------------------------
;;; call/cc
+;;; call-with-current-continuation
;;; --------------------------------------------------------------------------------
;;; some of these were originally from Al Petrovsky, Scott G Miller, Matthias Radestock, J H Brown, Dorai Sitaram,
;;; and probably others.
@@ -14231,7 +25462,7 @@ this prints:
(let ((x 0)
(c1 #f)
- (results '()))
+ (results ()))
(set! x (call/cc
(lambda (r1)
(set! c1 r1)
@@ -14336,7 +25567,7 @@ this prints:
2))))
(define (check states)
(set! state 0)
- (let* ((res '())
+ (let* ((res ())
(r (fn)))
(set! res (cons r res))
(if (null? states)
@@ -14350,13 +25581,70 @@ this prints:
(map check '((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))))
'((-1 4 5 3) (4 -1 5 3) (-1 5 4 3) (5 -1 4 3) (4 5 -1 3) (5 4 -1 3)))
+(let () ; Matt Might perhaps or maybe Paul Hollingsworth?
+ (define (current-continuation)
+ (call/cc (lambda (cc) (cc cc))))
+ (define fail-stack ())
+ (define (fail)
+ (if (not (pair? fail-stack))
+ (error "back-tracking stack exhausted!")
+ (begin
+ (let ((back-track-point (car fail-stack)))
+ (set! fail-stack (cdr fail-stack))
+ (back-track-point back-track-point)))))
+ (define (amb choices)
+ (let ((cc (current-continuation)))
+ (cond
+ ((null? choices) (fail))
+ ((pair? choices) (let ((choice (car choices)))
+ (set! choices (cdr choices))
+ (set! fail-stack (cons cc fail-stack))
+ choice)))))
+ (define (assert condition)
+ (if (not condition)
+ (fail)
+ #t))
+ (let ((a (amb (list 1 2 3 4 5 6 7)))
+ (b (amb (list 1 2 3 4 5 6 7)))
+ (c (amb (list 1 2 3 4 5 6 7))))
+ (assert (= (* c c) (+ (* a a) (* b b))))
+ (assert (< b a))
+ (test (list a b c) (list 4 3 5))))
+
+(let () ; a shorter version
+ (define (current-continuation)
+ (call/cc (lambda (cc) cc)))
+ (define fail-stack ())
+ (define (fail)
+ (if (not (pair? fail-stack))
+ (error "back-tracking stack exhausted!")
+ (let ((back-track-point (car fail-stack)))
+ (set! fail-stack (cdr fail-stack))
+ (back-track-point back-track-point))))
+ (define (amb choices)
+ (let ((cc (current-continuation)))
+ (if (null? choices)
+ (fail)
+ (let ((choice (car choices)))
+ (set! choices (cdr choices))
+ (set! fail-stack (cons cc fail-stack))
+ choice))))
+ (define (assert condition)
+ (or condition (fail)))
+ (let ((a (amb (list 1 2 3 4 5 6 7)))
+ (b (amb (list 1 2 3 4 5 6 7)))
+ (c (amb (list 1 2 3 4 5 6 7))))
+ (assert (= (* c c) (+ (* a a) (* b b))))
+ (assert (< b a))
+ (test (list a b c) (list 4 3 5))))
+
(let ((c1 #f))
(let ((x ((call/cc (lambda (r1) (set! c1 r1) (r1 "hiho"))) 0)))
(if (char=? x #\h)
(c1 "asdf"))
(test x #\a)))
-(test (let ((x '())
+(test (let ((x ())
(y 0))
(call/cc
(lambda (escape)
@@ -14375,8 +25663,56 @@ this prints:
(yin yang)))))
'(10 9 8 7 6 5 4 3 2 1 0))
+(let ()
+ ;; taken from wikipedia
+ (define readyList ())
+
+ (define (i-run)
+ (if (not (null? readyList))
+ (let ((cont (car readyList)))
+ (set! readyList (cdr readyList))
+ (cont ()))))
+
+ (define (fork fn arg)
+ (set! readyList
+ (append readyList
+ (cons
+ (lambda (x)
+ (fn arg)
+ (i-run))
+ ()))))
+
+ (define (yield)
+ (call-with-current-continuation
+ (lambda (thisCont)
+ (set! readyList
+ (append readyList
+ (cons thisCont ())))
+ (let ((cont (car readyList)))
+ (set! readyList (cdr readyList))
+ (cont ())))))
+
+ (define data (make-vector 10 0))
+ (define data-loc 0)
+
+ (define (process arg)
+ (if (< data-loc 10)
+ (begin
+ (set! (data data-loc) arg)
+ (set! data-loc (+ data-loc 1))
+ (yield)
+ (process (+ arg 1)))
+ (i-run)))
+
+ (fork process 0)
+ (fork process 10)
+ (fork process 20)
+ (i-run)
+
+ (test data #(0 10 20 1 11 21 2 12 22 3)))
+
(test (let ((c #f))
- (let ((r '()))
+ (let ((r ()))
(let ((w (let ((v 1))
(set! v (+ (call-with-current-continuation
(lambda (c0) (set! c c0) v))
@@ -14386,8 +25722,22 @@ this prints:
(if (<= w 1024) (c w) r))))
'(2048 1024 512 256 128 64 32 16 8 4 2))
+(test (let ((c #f))
+ (let ((r ()))
+ (let ((w (let ((v 1))
+ (set! v (+ (values v (call-with-current-continuation
+ (lambda (c0) (set! c c0) v)))
+ v))
+ (set! r (cons v r))
+ v)))
+ (if (<= w 1024) (c w) r))))
+ '(2047 1023 511 255 127 63 31 15 7 3))
+
+;;; the 1st v is 1, the 3rd reflects the previous call/cc which reflects the
+;;; env+slot that had the subsequent set! -- weird.
+
(test (let ((cc #f)
- (r '()))
+ (r ()))
(let ((s (list 1 2 3 4 (call/cc (lambda (c) (set! cc c) 5)) 6 7 8)))
(if (null? r)
(begin (set! r s) (cc -1))
@@ -14402,24 +25752,24 @@ this prints:
(set! first-time? #f)
(set! count (+ count 1))
(k values))
- (void)))
+ (void))) ; what is this?
count)
2)
(let ((c #f)
- (vals '()))
+ (vals ()))
(let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3))))))
(set! vals (cons val vals))
(if (< val 20) (c (+ val 1)))
(test vals '(22 18 14 10 6))))
(let ((c #f)
- (vals '()))
+ (vals ()))
(let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3))))))
(set! vals (cons val vals))
(if (< val 20) (apply c vals))
(test vals '(36 18 9 6))))
(let ((c #f)
- (vals '()))
+ (vals ()))
(let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3))))))
(set! vals (cons val vals))
(if (< val 20) (c (apply values vals)))
@@ -14450,7 +25800,10 @@ this prints:
(test (+ 1 (call-with-exit (lambda (k) (k #\a)))) 'error)
(test ((call/cc (lambda (return) (call/cc (lambda (cont) (return cont))) list)) 1) '(1)) ; from Guile mailing list -- this strikes me as very strange
-(let ((p1 (make-procedure-with-setter (lambda (k) (k 3)) (lambda (k a) (k a)))))
+(test (call/cc begin) 'error)
+(test (call/cc quote) 'error)
+
+(let ((p1 (dilambda (lambda (k) (k 3)) (lambda (k a) (k a)))))
(test (call/cc p1) 3)
(test (call-with-exit p1) 3))
@@ -14479,7 +25832,7 @@ this prints:
(product '(1 2 3 0 4 5 6)))
0)
-(test (let ((lst '()))
+(test (let ((lst ()))
((call/cc
(lambda (goto)
(letrec ((start (lambda () (set! lst (cons "start" lst)) (goto next)))
@@ -14488,7 +25841,7 @@ this prints:
start)))))
'("start" "next" "last"))
-(test (let ((cont #f))
+(test (let ((cont #f)) ; Al Petrovsky
(letrec ((x (call-with-current-continuation (lambda (c) (set! cont c) 0)))
(y (call-with-current-continuation (lambda (c) (set! cont c) 0))))
(if cont
@@ -14539,6 +25892,8 @@ this prints:
(test ((call-with-exit (lambda (return) (return + 1 2 3)))) 6)
(test ((call-with-exit (lambda (return) (apply return (list + 1 2 3))))) 6)
(test ((call/cc (lambda (return) (return + 1 2 3)))) 6)
+(test (+ 2 (call-with-exit (lambda (return) (let ((rtn (copy return))) (* 5 (rtn 4)))))) 6)
+(test (let () (define (f1) (+ (call-with-exit (lambda (return) (define (f2) (+ 1 (return 2))) (f2))) 3)) (f1)) 5)
(test (+ 2 (values 3 (call-with-exit (lambda (k1) (k1 4))) 5)) 14)
(test (+ 2 (call-with-exit (lambda (k1) (values 3 (k1 4) 5))) 8) 14)
@@ -14551,12 +25906,64 @@ this prints:
(test (call-with-exit (lambda arg ((car arg) 32)) "oops!") 'error)
(test (call-with-exit (lambda (a b) a)) 'error)
(test (call-with-exit (lambda (return) (apply return '(3)))) 3)
-(test (call-with-exit (lambda (return) (apply return (list (cons 1 2))) (format #t "; call-with-exit: we shouldn't be here!"))) (cons 1 2))
-(test (call/cc (lambda (return) (apply return (list (cons 1 2))) (format #t "; call/cc: we shouldn't be here!"))) (cons 1 2))
+(test (call-with-exit (lambda (return) (apply return (list (cons 1 2))) (format-logged #t "; call-with-exit: we shouldn't be here!"))) (cons 1 2))
+(test (call/cc (lambda (return) (apply return (list (cons 1 2))) (format-logged #t "; call/cc: we shouldn't be here!"))) (cons 1 2))
(test (procedure? (call-with-exit (lambda (return) (call-with-exit return)))) #t)
(test (call-with-exit (lambda (return) #f) 1) 'error)
(test (+ (call-with-exit ((lambda () (lambda (k) (k 1 2 3)))))) 6)
+(test (call-with-exit (lambda (a . b) (a 1))) 1)
+(test (call/cc (lambda (a . b) (a 1))) 1)
+(test (call-with-exit (lambda* (a b) (a 1))) 1)
+
+(test (call-with-exit (lambda (c) (0 (c 1)))) 1)
+(test (call-with-exit (lambda (k) (k "foo"))) "foo")
+(test (call-with-exit (lambda (k) "foo")) "foo")
+(test (call-with-exit (lambda (k) (k "foo") "oops")) "foo")
+(test (call-with-exit (lambda (x) (set! x abs) (x -1))) 1)
+(test (call/cc (lambda (x) (set! x abs) (x -1))) 1)
+(test (let ((memb (lambda (x ls)
+ (call-with-exit
+ (lambda (break)
+ (do ((ls ls (cdr ls)))
+ ((null? ls) #f)
+ (if (equal? x (car ls))
+ (break ls))))))))
+ (list (memb 'd '(a b c))
+ (memb 'b '(a b c))))
+ '(#f (b c)))
+
+(let* ((sum 0)
+ (val1 (call-with-exit
+ (lambda (return)
+ (set! sum (+ sum 1))
+ (let ((val2 (call-with-exit
+ (lambda (return)
+ (set! sum (+ sum 1))
+ (if #t (return sum))
+ 123))))
+ (set! sum (+ sum val2))
+ (return sum)
+ 32)))))
+ (test (list val1 sum) '(4 4)))
+
+(let ()
+ (define c #f)
+ (define (yow f)
+ (call-with-exit
+ (lambda (return)
+ (set! c return)
+ (f))))
+ (test (yow (lambda () (c 32))) 32))
+
+(let ((x 1))
+ (define y (call-with-exit (lambda (return) (set! x (return 32)))))
+ (test (and (= x 1) (= y 32)) #t)
+ (set! y (call-with-exit (lambda (return) ((lambda (a b c) (set! x a)) 1 2 (return 33)))))
+ (test (and (= x 1) (= y 33)) #t)
+ (set! y (call-with-exit (lambda (return) ((lambda (a b) (return a) (set! x b)) 2 3))))
+ (test (and (= x 1) (= y 2)) #t))
+
(test (let ((x 0))
(define (quit z1) (z1 1) (set! x 1))
(call-with-exit
@@ -14574,7 +25981,7 @@ this prints:
(test (((call/cc (lambda (k) k)) (lambda (x) x)) "hi") "hi")
(test (let ((return #f)
- (lst '()))
+ (lst ()))
(let ((val (+ 1 (call/cc
(lambda (cont)
(set! return cont)
@@ -14589,7 +25996,7 @@ this prints:
(test (let ((r1 #f)
(r2 #f)
- (lst '()))
+ (lst ()))
(define (somefunc x y)
(+ (* 2 (expt x 2)) (* 3 y) 1))
(let ((val (somefunc (call/cc
@@ -14626,7 +26033,7 @@ this prints:
(lambda ()
(rest-of-tree 'resume)))
(caller tree))))))
- (caller '()))))
+ (caller ()))))
(lambda ()
(call/cc
(lambda (k)
@@ -14692,7 +26099,7 @@ this prints:
(and (equal? val arg)
(= ctr 2))))
#t))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
@@ -14706,7 +26113,7 @@ this prints:
(and (equal? val arg)
(= ctr 10))))
#t))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (let ((c #f)
(r (string-copy "testing-hiho")))
@@ -14761,7 +26168,7 @@ this prints:
(for-each
(lambda (arg)
(test (call/cc (lambda (a) arg)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(let ((a (call/cc (lambda (a) a))))
(test (eq? a a) #t)
@@ -14770,11 +26177,11 @@ this prints:
(for-each
(lambda (ques)
(if (ques a)
- (format #t ";(~A ~A) returned #t?~%" ques a)))
+ (format-logged #t ";(~A ~A) returned #t?~%" ques a)))
question-ops))
(test (let ((conts (make-vector 4 #f)))
- (let ((lst '()))
+ (let ((lst ()))
(set! lst (cons (+ (call/cc (lambda (a) (vector-set! conts 0 a) 0))
(call/cc (lambda (a) (vector-set! conts 1 a) 0))
(call/cc (lambda (a) (vector-set! conts 2 a) 0))
@@ -14786,8 +26193,8 @@ this prints:
(reverse lst)))))
'(0 2 5 9))
-(test (let ((conts '()))
- (let ((lst '()))
+(test (let ((conts ()))
+ (let ((lst ()))
(set! lst (cons (+ (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1))
(* (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1))
(+ (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1))
@@ -14805,7 +26212,7 @@ this prints:
'(4 6 6 13 8))
(test (let ((conts (make-vector 4 #f)))
- (let ((lst '()))
+ (let ((lst ()))
(set! lst (cons (+ (call/cc (lambda (a) (if (not (vector-ref conts 0)) (vector-set! conts 0 a)) 0))
(call/cc (lambda (a) (if (not (vector-ref conts 1)) (vector-set! conts 1 a)) 0))
(call/cc (lambda (a) (if (not (vector-ref conts 2)) (vector-set! conts 2 a)) 0))
@@ -14817,8 +26224,8 @@ this prints:
(reverse lst)))))
'(0 2 3 4))
-(test (let ((conts '()))
- (let ((lst '()))
+(test (let ((conts ()))
+ (let ((lst ()))
(set! lst (cons (+ (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 1 0)
(* (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 2 1)
(+ (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 1 0)
@@ -14857,7 +26264,7 @@ this prints:
(#f)
(set! a (+ (* a1 tt) a2))
(set! b (+ (* tt b1) b2))
- ;(format #t "~A ~A~%" a (- b a))
+ ;(format-logged #t "~A ~A~%" a (- b a))
(if (or (<= (abs (- ux (/ a b))) err)
(> ctr 1000))
(return (/ a b)))
@@ -14892,11 +26299,11 @@ this prints:
(set! max-diff diff)
(set! max-case x))))
(if (> (abs (- r1 x)) (+ err epsilon))
- (format #t "(rationalize ~A ~A) is off: ~A -> ~A~%" x err r1 (abs (- r1 x))))
+ (format-logged #t "(rationalize ~A ~A) is off: ~A -> ~A~%" x err r1 (abs (- r1 x))))
(if (> (abs (- r2 x)) (+ err epsilon))
- (format #t "(ratify ~A ~A) is off: ~A -> ~A~%" x err r2 (abs (- r2 x))))
+ (format-logged #t "(ratify ~A ~A) is off: ~A -> ~A~%" x err r2 (abs (- r2 x))))
(if (< (denominator r2) (denominator r1))
- (format #t "(ratify ~A ~A) is simpler? ~A ~A~%" x err r1 r2)))))))
+ (format-logged #t "(ratify ~A ~A) is simpler? ~A ~A~%" x err r1 r2)))))))
(list max-case max-diff (cr max-case err)))
|#
@@ -14911,7 +26318,7 @@ this prints:
(list 0 1 2 3 arg 5))))))
(list ctr val)))
(list 4 arg)))
- (list "hi" -1 #\a 11 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #f #t '(1 . 2)))
+ (list "hi" -1 #\a 11 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t '(1 . 2)))
(test (+ 2 (call/cc (lambda (rtn) (+ 1 (let () (begin (define x (+ 1 (rtn 3)))) x))))) 5)
@@ -15029,6 +26436,9 @@ this prints:
(test (call/cc (lambda () 0)) 'error)
(test (call/cc (lambda (a) 0) 123) 'error)
+(test (call/cc (lambda (3) 9)) 'error)
+(test (call/cc (lambda arg 0)) 0)
+(test (call-with-exit (lambda arg 0)) 0)
(test (call/cc) 'error)
(test (call/cc abs) 'error)
(for-each
@@ -15036,7 +26446,7 @@ this prints:
(test (call-with-exit arg) 'error)
(test (call-with-current-continuation arg) 'error)
(test (call/cc arg) 'error))
- (list "hi" -1 '() #(1 2) _ht_ #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 () #(1 2) _ht_ _null_ _c_obj_ #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (call/cc . 1) 'error)
(test (call/cc abs) 'error)
@@ -15044,11 +26454,65 @@ this prints:
(test (+ 1 (call/cc (lambda (r1) (+ 5 (call/cc (lambda (r2) (r2 2 3)))))) 4) 15)
+;;; from Andy Wingo's Guile blog
+(let ()
+ (define (test1 get)
+ (let ((v (make-vector 2 #f)))
+ (vector-set! v 0 (get 0))
+ (vector-set! v 1 (get 1))
+ v))
+
+ (define (test2 get)
+ (let* ((a (get 0))
+ (b (get 1)))
+ (vector a b)))
+
+ (define (discriminate f)
+ (let ((get-zero-cont #t)
+ (first-result #f))
+ (define (get n)
+ (if (zero? n)
+ (call/cc (lambda (k)
+ (set! get-zero-cont k))))
+ n)
+ (let ((result (f get)))
+ (cond
+ (first-result
+ (eq? result first-result))
+ (else
+ (set! first-result result)
+ (get-zero-cont))))))
+
+ (test (discriminate test1) #t)
+ (test (discriminate test2) #f)
+
+ (define (discriminate2 f)
+ (let ((get-zero-cont #f)
+ (escape #f))
+ (define (get n)
+ (case n
+ ((0) (call/cc (lambda (k)
+ (set! get-zero-cont k)
+ 0)))
+ ((1) (if escape
+ (escape)
+ 1))))
+ (let ((result (f get)))
+ (call/cc
+ (lambda (k)
+ (set! escape k)
+ (get-zero-cont 42)))
+ result)))
+
+ (test (discriminate2 test1) #(42 1))
+ (test (discriminate2 test2) #(0 1)))
+
+
#|
;;; from bug-guile
(define k #f)
(define result #f)
-(define results '())
+(define results ())
(set! result (map (lambda (x)
(if x x (call/cc (lambda (c)
(set! k c)
@@ -15073,7 +26537,7 @@ but I think that depends on how we interpret the sequence of top-level statement
The test should be written:
(let* ((k #f)
- (results '()))
+ (results ()))
(let ((result (map (lambda (x)
(if x x (call/cc (lambda (c)
(set! k c)
@@ -15106,7 +26570,6 @@ who says the continuation has to restart the map from the top?
;; Guile handles this very differently
-
(test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return))) (cont 1)) 'error)
(test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return))) (apply cont)) 'error)
(test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return) (cont 1))) (apply cont)) 'error)
@@ -15120,6 +26583,13 @@ who says the continuation has to restart the map from the top?
(test (vector? (call-with-exit vector)) #t)
(test (call-with-exit ((lambda args procedure?))) #t)
(test (call-with-exit (let ((x 3)) (define (return y) (y x)) return)) 3)
+(test (call-with-exit (lambda (return) (with-input-from-string "hi" return))) ()) ; because thunk? -- does it close the port?
+(test (call-with-exit (lambda (return) (call-with-input-string "hi" return))) 'error)
+(test (call-with-exit (lambda (return) (set! (procedure-setter return) abs))) 'error)
+(test (call-with-exit (lambda (return) (dynamic-wind return (lambda () 1) (lambda () (error "oops"))))) ())
+(test (call-with-exit (lambda (return) (map return '(1 2 3)))) 1)
+(test (call-with-exit (lambda (return) (dynamic-wind (lambda () 2) (lambda () 1) return))) ()) ; ?? is this a bug?
+(test (call-with-exit (lambda (return) (dynamic-wind (lambda () 2) (lambda () 1) (lambda () (return 3))))) 3) ; I guess not
(test (let ((c1 #f)) (call-with-exit (lambda (c2) (call-with-exit (lambda (c3) (set! c1 c3) (c2))))) (c1)) 'error)
(test (let ((c1 #f)) (call/cc (lambda (c2) (call-with-exit (lambda (c3) (set! c1 c3) (c2))))) (c1)) 'error)
@@ -15139,7 +26609,7 @@ who says the continuation has to restart the map from the top?
2)
(test (let ((val (call-with-exit (lambda (ret) (let ((ret1 ret)) (ret1 2) 3))))) val) 2)
-(test (call-with-exit (lambda (return) (sort! '(3 2 1) return))) 'error)
+(test (call-with-exit (lambda (return) (sort! '(3 2 1) return))) 'error) ; "sort! argument 2, #<goto>, is a goto ..."
;;; this one from Rick
(test (eval '(call/cc (lambda (go) (go 9) 0))) 9)
@@ -15169,9 +26639,11 @@ who says the continuation has to restart the map from the top?
(test (call-with-exit (lambda (go) (case 'go ((go 2) 3) (else 4)))) 3)
(test (call-with-exit (lambda (go) (go (go (go 1))))) 1)
(test (call-with-exit (lambda (go) (quasiquote (go 1)))) '(go 1))
-(test (call-with-exit (lambda (go) ((lambda* (a (go 1)) a) (go 2) 3))) 2)
-(test (call-with-exit (lambda (go) ((lambda* (a (go 1)) a) 2))) 2) ; default arg not evaluated if not needed
-(test (call-with-exit (lambda (go) ((lambda* (a (go 1)) a)))) #f) ; lambda_star_argument_default_value in s7 explicitly desires this
+
+;; these tests were messed up -- I forgot the outer parens
+(test (call-with-exit (lambda (go) ((lambda* ((a (go 1))) a) (go 2) 3))) 2)
+(test (call-with-exit (lambda (go) ((lambda* ((a (go 1))) a)))) 1)
+
(test (call-with-exit (lambda (go) ((lambda (go) go) 1))) 1)
(test (call-with-exit (lambda (go) (quote (go 1)) 2)) 2)
(test (call-with-exit (lambda (go) (and (go 1) #f))) 1)
@@ -15232,6 +26704,89 @@ who says the continuation has to restart the map from the top?
val))
5)
+(let ()
+ (define-macro (while test . body)
+ `(call-with-exit
+ (lambda (break)
+ (letrec ((continue (lambda ()
+ (if (let () ,test)
+ (begin
+ (let () , at body)
+ (continue))
+ (break)))))
+ (continue)))))
+ (test (let ((i 0)
+ (sum 0)
+ (break 32)
+ (continue 48))
+ (while (begin
+ (define break 10)
+ (define continue 0)
+ (< i (+ break continue)))
+ (set! sum (+ sum 1))
+ (set! i (+ i 1))
+ (if (< i 5) (continue))
+ (set! sum (+ sum 10))
+ (if (> i 7) (break))
+ (set! sum (+ sum 100)))
+ sum)
+ 348))
+
+;;; (define-macro (while test . body) `(do () ((not ,test)) , at body)) ?
+
+
+;;; with-baffle
+
+(test (with-baffle) ()) ; ?? -- like begin I guess
+(test (with-baffle 0) 0)
+(test (+ 1 (with-baffle (values 2 3)) 4) 10)
+(test (with-baffle . 1) 'error)
+(test (with-baffle 1 2 . 3) 'error)
+
+(test (with-baffle
+ (let ((x 0)
+ (c1 #f)
+ (results ()))
+ (set! x (call/cc
+ (lambda (r1)
+ (set! c1 r1)
+ (r1 2))))
+ (set! results (cons x results))
+ (if (= x 2) (c1 32))
+ results))
+ '(32 2))
+
+(test (let ((x 0)
+ (c1 #f)
+ (results ()))
+ (with-baffle
+ (set! x (call/cc
+ (lambda (r1)
+ (set! c1 r1)
+ (r1 2))))
+ (set! results (cons x results)))
+ (if (= x 2) (c1 32))
+ results)
+ 'error)
+
+(test (let ((what's-for-breakfast ())
+ (bad-dog 'fido)) ; bad-dog will try to sneak in
+ (with-baffle ; the syntax is (with-baffle . body)
+ (set! what's-for-breakfast
+ (call/cc
+ (lambda (biscuit?)
+ (set! bad-dog biscuit?) ; bad-dog smells a biscuit!
+ (biscuit? 'biscuit!)))))
+ (if (eq? what's-for-breakfast 'biscuit!)
+ (bad-dog 'biscuit!)) ; now, outside the baffled block, bad-dog tries to sneak back in
+ results) ; but s7 says "No!": baffled! ("continuation can't jump across with-baffle")
+ 'error)
+
+(test (+ (with-baffle (let ((c1 #f)) (call/cc (lambda (c2) (set! c1 c2) (c2 2))))) 1) 3)
+(test (+ (let ((c1 #f)) (with-baffle (call/cc (lambda (c2) (set! c1 c2) (c2 2)))) (c1 3)) 1) 'error)
+(test (let () (define (c3 a) (a 2)) (c3 (with-baffle (call/cc (lambda (c2) c2))))) 'error)
+(test (call-with-exit (lambda (return) (with-baffle (do () () (return 1))))) 1)
+(test (let () (define (hi) (null? (with-baffle))) (hi)) #t)
@@ -15354,7 +26909,7 @@ who says the continuation has to restart the map from the top?
(= ctr3 ctr4 0))))
#t)
-(test (let ((path '())
+(test (let ((path ())
(c #f))
(let ((add (lambda (s)
(set! path (cons s path)))))
@@ -15372,13 +26927,27 @@ who says the continuation has to restart the map from the top?
(for-each
(lambda (arg)
(test (dynamic-wind (lambda () #f) (lambda () arg) (lambda () #f)) arg))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (dynamic-wind (lambda () #f) (lambda () #f) (lambda () #f)) #f)
(test (+ 1 (dynamic-wind (lambda () #f) (lambda () (values 2 3 4)) (lambda () #f)) 5) 15)
+(test (let () (define-macro (makef val) `(lambda () ,val)) (dynamic-wind (lambda () #f) (makef 123) (lambda () #f))) 123)
+(test (dynamic-wind (lambda () #f) (define-macro (_m_) 32) (lambda () #f)) 32)
+
+(let ()
+ (define-macro (m) `(+ 1 2 3))
+ (test (dynamic-wind m m m) 6)
+ (test (dynamic-wind m (lambda () 123) m) 123)
+ (test (dynamic-wind (lambda () #f) m (lambda () #f)) 6)
+ (test (dynamic-wind (lambda () #f) m m) 6))
+;;; so... dynamic-wind init load quit would place the loaded defs in the current env -- transparent dw
+(let ()
+ (define-macro* (m (a 1)) `(define __asdf__ ,a))
+ (dynamic-wind (lambda () #f) m (lambda () #f))
+ (test __asdf__ 1))
(test (let ((identity (lambda (a) a)))
- (let ((x '())
+ (let ((x ())
(c #f))
(dynamic-wind
(lambda () (set! x (cons 'a x)))
@@ -15406,8 +26975,6 @@ who says the continuation has to restart the map from the top?
(lambda () #f)))
(list 'a 'b 'c))
-(test (let ((dynamic-wind 1)) (+ dynamic-wind 2)) 3)
-
(test (let ((ctr1 0)
(ctr2 0)
(ctr3 0))
@@ -15525,14 +27092,18 @@ who says the continuation has to restart the map from the top?
(test (dynamic-wind (lambda () 1) #f (lambda () 2)) 'error)
(test (dynamic-wind . 1) 'error)
(test (dynamic-wind () () ()) 'error)
-(test (dynamic-wind () _ht_ ()) 'error)
+(test (dynamic-wind () _ht_ _null_ _c_obj_ ()) 'error)
+(test (dynamic-wind + + +) 0)
+(test (dynamic-wind (values + + +)) 0)
+(test (dynamic-wind s7-version s7-version s7-version) (s7-version))
+(test (+ (dynamic-wind (lambda () (values 1 2 3)) (lambda () (values 4 5 6)) (lambda () (values 7 8 9)))) 15)
(for-each
(lambda (arg)
(test (dynamic-wind arg (lambda () #f) (lambda () #f)) 'error)
(test (dynamic-wind (lambda () #f) arg (lambda () #f)) 'error)
(test (dynamic-wind (lambda () #f) (lambda () #f) arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(test (dynamic-wind (let ((x 1)) (lambda () x)) ((lambda () (lambda () 2))) s7-version) 2)
(test (let ((x 0)) (dynamic-wind (lambda () (set! x 1)) ((lambda () (set! x 32) (lambda () x))) (let () (set! x 44) (lambda () x)))) 1)
@@ -15544,6 +27115,71 @@ who says the continuation has to restart the map from the top?
(define-macro (make-thunk val) `(lambda () ,val))
(test (dynamic-wind (make-thunk 0) (make-thunk 1) (make-thunk 2)) 1))
+(let ((jumps 4))
+
+ (define (test1 f)
+ (let ((c #f) (ctr 0))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1)))
+ (lambda () #f))
+ (if (< ctr f) (c))
+ ctr))
+
+ (define (test2 f)
+ (let ((c #f) (ctr 0))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))))
+ (lambda () #f))
+ (if (< ctr f) (c))
+ ctr))
+
+ (test (catch #t (lambda () (test2 jumps)) (lambda args 'error)) 'error)
+ (test (test1 jumps) 4)
+
+ (define (test3 f)
+ (let ((c #f) (ctr 0))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () #f)
+ (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))))
+ (if (< ctr f) (c))
+ ctr))
+
+ (define (test4 f)
+ (let ((c #f) (ctr 0))
+ (dynamic-wind
+ (lambda () #f)
+ (lambda () #f)
+ (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1)))))
+ (if (< ctr f) (c))
+ ctr))
+
+ (test (catch #t (lambda () (test4 jumps)) (lambda args 'error)) 'error)
+ (test (test3 jumps) 5)
+
+ (define (test5 f)
+ (let ((c #f) (ctr 0))
+ (dynamic-wind
+ (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))) ; this is a very bad idea! (infinite loop etc)
+ (lambda () #f)
+ (lambda () #f))
+ (if (< ctr f) (c))
+ ctr))
+
+ (define (test6 f)
+ (let ((c #f) (ctr 0))
+ (dynamic-wind
+ (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))))
+ (lambda () #f)
+ (lambda () #f))
+ (if (< ctr f) (c))
+ ctr))
+
+ (test (catch #t (lambda () (test6 jumps)) (lambda args 'error)) 'error)
+ (test (test5 jumps) 5))
+#|
;;; from scheme wiki
;;; http://community.schemewiki.org/?hose-the-repl
;;; jorgen-schafer
@@ -15561,33 +27197,37 @@ who says the continuation has to restart the map from the top?
(test (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) (lambda () (let loop () (loop))) k))) 'error)
(test (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) k (lambda () #t)))) 'error)
(test (call-with-exit (lambda (k) (dynamic-wind k (lambda () #f) (lambda () #t)))) 'error)
+|#
+
+
+
(test (call-with-exit (lambda (k) (procedure-documentation k))) "")
-(test (call-with-exit (lambda (k) (procedure-arity k))) '(0 0 #t))
-(test (call-with-exit (lambda (k) (procedure-source k))) '())
-(test (procedure-arity (call-with-exit (lambda (k) (make-procedure-with-setter k k)))) '(0 0 #t 0 0 #t))
-(test (procedure-arity (make-procedure-with-setter vector-ref vector-set!)) '(2 0 #t 3 0 #t))
-(test (let ((pws (make-procedure-with-setter vector-ref vector-set!)))
- (let ((pws1 (make-procedure-with-setter pws vector-set!)))
+(test (call-with-exit (lambda (k) (procedure-source k))) ())
+
+(test (let ((pws (dilambda vector-ref vector-set!)))
+ (let ((pws1 (dilambda pws vector-set!)))
(let ((v (vector 1 2)))
(set! (pws1 v 1) 32)
(pws1 v 1))))
32)
(test (call-with-exit (lambda (k) (map k '(1 2 3)))) 1)
(test (call-with-exit (lambda (k) (for-each k '(1 2 3)))) 1)
-(test (call-with-exit (lambda (k) (catch #t k k))) 'error)
+(test (call-with-exit (lambda (k) (catch #t k k))) ()) ; was 'error until 14-May-14
(test (call-with-exit (lambda (k) (catch #t (lambda () #f) k))) #f)
-(test (call-with-exit (lambda (k) (catch #t (lambda () (error 'an-error)) k))) 'error)
+;(test (call-with-exit (lambda (k) (catch #t (lambda () (error 'an-error)) k))) 'error) ; this seems like it could be either
(test (procedure? (call-with-exit (lambda (return) (call-with-exit return)))) #t)
-;(test (call-with-exit (lambda (k) (sort! '(1 2 3) k))) 'error) -- currently returns (values 2 3) which is plausible
+(test (call-with-exit (lambda (k) (sort! '(1 2 3) k))) 'error) ; "sort! argument 2, #<goto>, is a goto"
(test (sort! '(1 2 3) (lambda () #f)) 'error)
(test (sort! '(1 2 3) (lambda (a) #f)) 'error)
(test (sort! '(1 2 3) (lambda (a b c) #f)) 'error)
-(test (let () (define-macro (asdf a b) `(< ,a ,b)) (sort! '(1 2 3) asdf)) 'error)
+;(test (let () (define-macro (asdf a b) `(< ,a ,b)) (sort! '(1 2 3) asdf)) 'error)
(test (let () (let asdf () (sort! '(1 2 3) asdf))) 'error)
(test (let () (let asdf () (map asdf '(1 2 3)))) 'error)
(test (let () (let asdf () (for-each asdf '(1 2 3)))) 'error)
(test (dynamic-wind quasiquote s7-version s7-version) 'error)
+(test (sort! '(1 2 3) (define-macro (_m_ a b) `(> ,a ,b))) '(3 2 1))
+(test (sort! '(2 1 3) (define-macro (_m_ a b) `(< ,a ,b))) '(1 2 3))
(test (let ((ctr 0))
(call-with-exit
@@ -15623,12 +27263,57 @@ who says the continuation has to restart the map from the top?
(test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r2 12) (r2 1))) (r1 2))) 3)) 3)
(test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r3 12) (r2 1))) (r1 2))) 3)) 2)
-(let ((pws (make-procedure-with-setter < >))) (test (sort! '(2 3 1 4) pws) '(1 2 3 4)))
+;; make sure call-with-exit closes ports
+(test (let ((p (call-with-exit (lambda (return)
+ (call-with-input-file tmp-output-file
+ (lambda (port)
+ (return port)))))))
+ (port-closed? p))
+ #t)
+(test (let ((p (call-with-exit (lambda (return)
+ (call-with-input-file tmp-output-file
+ (lambda (port)
+ (if (not (port-closed? port)) (return port))))))))
+ (port-closed? p))
+ #t)
+(test (let ((p (call-with-exit (lambda (return)
+ (with-input-from-file tmp-output-file
+ (lambda ()
+ (return (current-input-port))))))))
+ (port-closed? p))
+ #t)
+(test (let ((p (call-with-exit (lambda (return)
+ (with-output-to-file "empty-file"
+ (lambda ()
+ (return (current-output-port))))))))
+ (port-closed? p))
+ #t)
+(test (let ((p (call-with-exit (lambda (return)
+ (call-with-output-file "empty-file"
+ (lambda (port)
+ (return port)))))))
+ (port-closed? p))
+ #t)
+(test (let ((p (call-with-exit (lambda (return)
+ (call-with-input-string "this is a test"
+ (lambda (port)
+ (return port)))))))
+ (port-closed? p))
+ #t)
+(test (let ((p (call-with-exit (lambda (return)
+ (call-with-output-string
+ (lambda (port)
+ (return port)))))))
+ (port-closed? p))
+ #t)
+
+(let ((pws (dilambda < >))) (test (sort! '(2 3 1 4) pws) '(1 2 3 4)))
(test (call-with-exit (lambda (k) (call-with-input-string "123" k))) 'error)
-(test (call-with-exit (lambda (k) (call-with-input-file "tmp1.r5rs" k))) 'error)
-(test (call-with-exit (lambda (k) (call-with-output-file "tmp1.r5rs" k))) 'error)
+(test (call-with-exit (lambda (k) (call-with-input-file tmp-output-file k))) 'error)
+(test (call-with-exit (lambda (k) (call-with-output-file tmp-output-file k))) 'error)
(test (call-with-exit (lambda (k) (call-with-output-string k))) 'error)
-(let ((pws (make-procedure-with-setter (lambda (a) (+ a 1)) (lambda (a b) b))))
+(test (call-with-output-string (hash-table* 'b 2)) "") ;??
+(let ((pws (dilambda (lambda (a) (+ a 1)) (lambda (a b) b))))
(test (procedure? pws) #t)
(test (map pws '(1 2 3)) '(2 3 4))
(test (apply pws '(1)) 2))
@@ -15638,7 +27323,7 @@ who says the continuation has to restart the map from the top?
(test (+ 5 (call-with-exit (lambda (return) (return 1)))) 6)
(test (+ 5 (call-with-exit (lambda (return) (return)))) 'error)
-(test (let ((cur '()))
+(test (let ((cur ()))
(define (step pos)
(dynamic-wind
(lambda ()
@@ -15655,7 +27340,7 @@ who says the continuation has to restart the map from the top?
'(0 1 10 11 20 21 30 31 40 41 42 43 32 33 22 23 12 13 2))
-(test (let ((cur '()))
+(test (let ((cur ()))
(define (step pos)
(dynamic-wind
(lambda ()
@@ -15675,7 +27360,7 @@ who says the continuation has to restart the map from the top?
(lambda args (reverse cur))))
'(0 1 10 11 20 21 30 31 40 41 43 33 23 13 3))
-(test (let ((cur '()))
+(test (let ((cur ()))
(define (step pos ret)
(dynamic-wind
(lambda ()
@@ -15859,6 +27544,12 @@ who says the continuation has to restart the map from the top?
(lambda args 'error))))
(test val 'error)))
+(test (dynamic-wind
+ (lambda () (eq? (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (call/cc (lambda (k) k))))
+ (lambda () #f)
+ (lambda () #f))
+ #f)
+
@@ -15867,13 +27558,10 @@ who says the continuation has to restart the map from the top?
;;; --------------------------------------------------------------------------------
(test `(1 2 3) '(1 2 3))
-(test `() '())
+(test `() ())
(test `(list ,(+ 1 2) 4) '(list 3 4))
(test `(1 ,@(list 1 2) 4) '(1 1 2 4))
-(test `#(1 ,@(list 1 2) 4) '#(1 1 2 4))
(test `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b) '(a 3 4 5 6 b))
-(if (eqv? 2 (sqrt 4))
- (test `#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8) '#(10 5 2 4 3 8))) ; inexactness foolishness
(test `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f) '(a `(b ,(+ 1 2) ,(foo 4 d) e) f))
(test (let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e)) '(a `(b ,x ,'y d) e))
(test `(1 2 ,(* 9 9) 3 4) '(1 2 81 3 4))
@@ -15917,8 +27605,73 @@ who says the continuation has to restart the map from the top?
(test (eval (eval ``(,- ,@,@'(1())))) -1)
(test (eval (eval ``(,- ,@'(,@()1)))) -1)
(test (eval (eval ``(- ,@,@',().(1)))) -1)
+(test (quasiquote quote) 'quote)
+(test (eval (list quasiquote (list values #t))) (list values #t))
+
+(test (eq? (cadr `(a, b, c,)) 'b,) #t)
+(test (eq? (cadr '(a, b, c,)) 'b,) #t)
+(test (let ((b, 32)) `(a , b, c,)) '(a 32 c,))
+(test (let ((b, 32)) `(a, , b, c,)) '(a, 32 c,))
+(if (not (provided? 'immutable-unquote)) (test (equal? (let ((b, 32)) '(a, , b, c,)) '(a, (unquote b,) c,)) #t)) ; comma by itself (no symbol) is an error
+(if (not (provided? 'immutable-unquote)) (test (equal? (let ((b, 32)) '(a, , , b, c,)) '(a, (unquote (unquote b,)) c,)) #t))
+;(test (equal? (let ((b 32)) (let ((b, b)) ``(a, , , b, c,))) '({list} 'a, 32 'c,)) #t)
+(if (not pure-s7)
+ (test (let ((func abs)) (quasiquote (sym . (unquote func)))) (cons 'sym abs))) ; guile mailing list
+(test (eval ``(,@,@())) ())
+
+(if (provided? 'immutable-unquote)
+ (begin
+ (test (let () (define* ,() (abs ))) 'error)
+ (test (let (,'a) unquote) 'error)
+ (test (let (, '1) unquote) 'error)
+ (test (let (, (lambda (x) (+ x 1))) ,,,,'3) 'error)
+ (test (let (,@ '(1)) unquote) 'error)
+ (test (let (,@ ()) ,2) 'error)
+ (test (let (' 1) quote) 1)
+ )
+ (begin
+ (test (let () (define* ,() (abs ))) 'error)
+ (test (let (,'a) unquote) 'a)
+ (test (let (, '1) unquote) 1)
+ (test (let (, (lambda (x) (+ x 1))) ,,,,'3) 7)
+ (test (let (,@ '(1)) unquote) 1)
+ (test (let (,@ ()) ,2) 2)
+ (test (let (' 1) quote) 1)
+ ))
+
+;; mostly from gauche
+;;; the vector quasiquote comma-eval takes place in the global environment so
+;;; (let ((x 0)) (let ((y `#(,(begin (define x 32) x)))) (list x y))) -> '(0 #(32)) and defines x=32 in the top level
+
+(if with-qq-vectors (begin
+ (test `#(1 ,@(list 1 2) 4) #(1 1 2 4))
+ (if (eqv? 2 (sqrt 4))
+ (test `#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8) #(10 5 2 4 3 8))) ; inexactness foolishness
+ (test `#(,(cons 1 2) 3) #((1 . 2) 3))
+ ; (test `#(,quasi0 3) #(99 3)) ; and (let ((quasi0 99)) (quasiquote #(,quasi0 3))) -> #((unquote quasi0) 3)
+ ; (test `#(,(+ quasi0 1) 3) #(100 3))
+ ; (test `#(3 ,quasi1) #(3 101))
+ ; (test `#(3 ,(+ quasi1 1)) #(3 102))
+ (test `#(1 ,@(list 2 3) 4) #(1 2 3 4))
+ (test `#(1 2 ,@(list 3 4)) #(1 2 3 4))
+ ; (test `#(, at quasi2 , at quasi3) #(a b c d))
+ ; (test `#(, at quasi2 ,quasi3) #(a b (c d)))
+ ; (test `#(,quasi2 , at quasi3) #((a b) c d))
+ (test `#(,@(list)) #())
+ (test `#(,@(list 1 2) ,@(list 1 2)) #(1 2 1 2))
+ (test `#(,@(list 1 2) a ,@(list 1 2)) #(1 2 a 1 2))
+ (test `#(a ,@(list 1 2) ,@(list 1 2)) #(a 1 2 1 2))
+ (test `#(,@(list 1 2) ,@(list 1 2) a) #(1 2 1 2 a))
+ (test `#(,@(list 1 2) ,@(list 1 2) a b) #(1 2 1 2 a b))
+ ; (test `#(1 `(1 ,2 ,,(+ 1 2)) 1) #(1 `(1 ,2 ,3) 1))
+ ; (test `#(1 `(1 ,,quasi0 ,,quasi1) 1) #(1 `(1 ,99 ,101) 1))
+ (test `#(1 `(1 , at 2 ,@,(list 1 2))) #(1 `(1 , at 2 ,@(1 2))))
+ ; (test `#(1 `(1 ,@,quasi2 ,@,quasi3)) #(1 `(1 ,@(a b) ,@(c d))))
+ ; (test `#(1 `(1 ,(, at quasi2 x) ,(y , at quasi3))) #(1 `(1 ,(a b x) ,(y c d))))
+ (test (eval-string "`#(1 2 3 unquote abs)") 'error) ; guile mailing list says it should work, but unquote is translated at the reader level
+ ;; which does not know it's in a vector here, so s7 sees `#(1 2 3 . abs) which is indeed an error
+ ))
-;; from gauche
(let ((quasi0 99)
(quasi1 101)
(quasi2 '(a b))
@@ -15940,22 +27693,8 @@ who says the continuation has to restart the map from the top?
(test `(, at quasi2 , at quasi3) '(a b c d))
(test `(1 2 . ,(list 3 4)) '(1 2 3 4))
(test `(, at quasi2 . ,quasi3) '(a b c d))
- (test `#(,(cons 1 2) 3) '#((1 . 2) 3))
-; (test `#(,quasi0 3) '#(99 3))
-; (test `#(,(+ quasi0 1) 3) '#(100 3))
-; (test `#(3 ,quasi1) '#(3 101))
-; (test `#(3 ,(+ quasi1 1)) '#(3 102))
- (test `#(1 ,@(list 2 3) 4) '#(1 2 3 4))
- (test `#(1 2 ,@(list 3 4)) '#(1 2 3 4))
-; (test `#(, at quasi2 , at quasi3) '#(a b c d))
-; (test `#(, at quasi2 ,quasi3) '#(a b (c d)))
-; (test `#(,quasi2 , at quasi3) '#((a b) c d))
-;;; the vector quasiquote comma-eval takes place in the global environment so
-;;; (let ((x 0)) (let ((y `#(,(begin (define x 32) x)))) (list x y))) -> '(0 #(32)) and defines x=32 in the top level
-
- (test `#() '#())
- (test `#(,@(list)) '#())
+ (test `#() #())
(test `(,@(list 1 2) ,@(list 1 2)) '(1 2 1 2))
(test `(,@(list 1 2) a ,@(list 1 2)) '(1 2 a 1 2))
(test `(a ,@(list 1 2) ,@(list 1 2)) '(a 1 2 1 2))
@@ -15966,27 +27705,19 @@ who says the continuation has to restart the map from the top?
(test `(,@(list 1 2) ,@(list 1 2) . ,quasi2) '(1 2 1 2 a b))
(test `(,@(list 1 2) ,@(list 1 2) a . ,(cons 1 2)) '(1 2 1 2 a 1 . 2))
(test `(,@(list 1 2) ,@(list 1 2) a . ,quasi3) '(1 2 1 2 a c d))
- (test `#(,@(list 1 2) ,@(list 1 2)) '#(1 2 1 2))
- (test `#(,@(list 1 2) a ,@(list 1 2)) '#(1 2 a 1 2))
- (test `#(a ,@(list 1 2) ,@(list 1 2)) '#(a 1 2 1 2))
- (test `#(,@(list 1 2) ,@(list 1 2) a) '#(1 2 1 2 a))
- (test `#(,@(list 1 2) ,@(list 1 2) a b) '#(1 2 1 2 a b))
; (test `(1 `(1 ,2 ,,(+ 1 2)) 1) '(1 `(1 ,2 ,3) 1))
; (test `(1 `(1 ,,quasi0 ,,quasi1) 1) '(1 `(1 ,99 ,101) 1))
(test `(1 `(1 , at 2 ,@,(list 1 2))) '(1 `(1 , at 2 ,@(1 2))))
(test `(1 `(1 ,@,quasi2 ,@,quasi3)) '(1 `(1 ,@(a b) ,@(c d))))
(test `(1 `(1 ,(, at quasi2 x) ,(y , at quasi3))) '(1 `(1 ,(a b x) ,(y c d))))
-; (test `#(1 `(1 ,2 ,,(+ 1 2)) 1) '#(1 `(1 ,2 ,3) 1))
-; (test `#(1 `(1 ,,quasi0 ,,quasi1) 1) '#(1 `(1 ,99 ,101) 1))
- (test `#(1 `(1 , at 2 ,@,(list 1 2))) '#(1 `(1 , at 2 ,@(1 2))))
-; (test `#(1 `(1 ,@,quasi2 ,@,quasi3)) '#(1 `(1 ,@(a b) ,@(c d))))
-; (test `#(1 `(1 ,(, at quasi2 x) ,(y , at quasi3))) '#(1 `(1 ,(a b x) ,(y c d))))
; (test `(1 `#(1 ,(, at quasi2 x) ,(y , at quasi3))) '(1 `#(1 ,(a b x) ,(y c d))))
)
-(test `#2d((1 ,(* 3 2)) (,@(list 2) 3)) #2D((1 6) (2 3)))
-(test `#3d() #3D())
-(test `#3D((,(list 1 2) (,(+ 1 2) 4)) (,@(list (list 5 6)) (7 8))) #3D(((1 2) (3 4)) ((5 6) (7 8))))
+(if with-qq-vectors (begin
+ (test `#2d((1 ,(* 3 2)) (,@(list 2) 3)) #2D((1 6) (2 3)))
+ (test `#3d() #3D())
+ (test `#3D((,(list 1 2) (,(+ 1 2) 4)) (,@(list (list 5 6)) (7 8))) #3D(((1 2) (3 4)) ((5 6) (7 8))))))
+
(test (eval-string "`#2d(1 2)") 'error)
(test (eval-string "`#2d((1) 2)") 'error)
(test (eval-string "`#2d((1 2) (3 4) (5 6 7))") 'error)
@@ -16010,8 +27741,8 @@ who says the continuation has to restart the map from the top?
(test `(,y , at y) '((a b c) a b c))
(test `(, at y . ,y) '(a b c a b c))
- (test (object->string `(,y . ,y)) "(#1=(a b c) . #1#)")
- (test (object->string `(y ,y , at y ,y . y)) "(y #1=(a b c) a b c #1# . y)")
+ (test (object->string `(,y . ,y)) "((a b c) a b c)") ; was "(#1=(a b c) . #1#)"
+ (test (object->string `(y ,y , at y ,y . y)) "(y (a b c) a b c (a b c) . y)") ; was "(y #1=(a b c) a b c #1# . y)"
(test (eval ``(1 . ,,2)) '(1 . 2))
(test (eval ``(y . ,,x)) '(y . 3))
@@ -16021,6 +27752,7 @@ who says the continuation has to restart the map from the top?
(test (eval ``(,,x . y)) '(3 . y))
(test (eval ``(,,x , at y)) '(3 a b c)) ;; in clisp `(,y . ,@(y)) -> *** - READ: the syntax `( ... . , at form) is invalid
)
+
(test (let ((.' '(1 2))) `(, at .')) '(1 2))
(test (let ((hi (lambda (a) `(+ 1 ,a))))
@@ -16063,8 +27795,10 @@ who says the continuation has to restart the map from the top?
`(1 , at x 4))
'(1 2 3 4))
-(test `#(1 ,(/ 12 2)) '#(1 6))
-(test ((lambda () `#(1 ,(/ 12 2)))) '#(1 6))
+(if with-qq-vectors (begin
+ (test `#(1 ,(/ 12 2)) #(1 6))
+ (test `#(,most-positive-fixnum 2) #(9223372036854775807 2))
+ (test ((lambda () `#(1 ,(/ 12 2)))) #(1 6))))
(test (let ((x '(2 3)))
`(1 ,@(map (lambda (a) (+ a 1)) x)))
@@ -16073,10 +27807,11 @@ who says the continuation has to restart the map from the top?
;;; these are from the scheme bboard
(test (let ((x '(1 2 3))) `(0 . ,x)) '(0 1 2 3))
(test (let ((x '(1 2 3))) `(0 ,x)) '(0 (1 2 3)))
-;(test (let ((x '(1 2 3))) `#(0 ,x)) '#(0 (1 2 3)))
-;(test (let ((x '(1 2 3))) `#(0 . ,x)) '#(0 1 2 3))
+;(test (let ((x '(1 2 3))) `#(0 ,x)) #(0 (1 2 3))) ; local var
+;(test (let ((x '(1 2 3))) `#(0 . ,x)) #(0 1 2 3)) ; same
-(test `#(,most-positive-fixnum 2) #(9223372036854775807 2))
+;; unbound variable x, but (let ((x '(1 2 3))) (quasiquote #(0 . ,x))) -> #(0 unquote x)
+;; so ` and (quasiquote...) are not the same in the vector case
(test (let () (define-macro (tryqv . lst) `(map abs ',lst)) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5))
(test (let () (define-macro (tryqv . lst) `(map abs '(, at lst))) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5))
@@ -16088,26 +27823,30 @@ who says the continuation has to restart the map from the top?
(lambda () (eval-string str))
(lambda args 'error))))
(if (not (eqv? val -1))
- (format #t "~S = ~S?~%" str val))))
- (list "( `,@` '-1)" "( '(.1 -1)1)" "( - '`-00 1)" "( - .(,`1/1))" "( - .(`1) )" "( -(/ .(1)))" "( / 01 -1 )" "(' '` -1(/ ' 1))" "(' (-01 )0)"
+ (format-logged #t "~S = ~S?~%" str val))))
+ (list "( '(.1 -1)1)" "( - '`-00 1)" "( - .(,`1/1))" "( - .(`1) )" "( -(/ .(1)))" "( / 01 -1 )" "(' '` -1(/ ' 1))" "(' (-01 )0)"
"(' `'`` -1 1 01)" "(''-1 .(1))" "('(, -1 )0)" "('(,-1)'000)" "('(,-1)00)" "('(-1 -.0)0)" "('(-1 '1`)0)" "('(-1 .-/-)0)" "('(-1()),0)"
"('(-1) 0)" "('(10. -1 )1)" "(- '`1)" "(- `1 1 1)" "(- ' 1)" "(- ' 1)" "(- '1 .())" "(- '` ,``1)" "(- '` 1)" "(- '`, `1)" "(- '`,`1)"
"(- '``1)" "(- (''1 1))" "(- (- ' 1 0))" "(- (-(- `1)))" "(- (` (1)0))" "(- ,`, `1)" "(- ,`1 . ,())" "(- . ( 0 1))" "(- . ( `001))"
"(- .(', 01))" "(- .('`,1))" "(- .('``1))" "(- .(,,1))" "(- .(01))" "(- .(1))" "(- .(`,1))" "(- .(`,`1))" "(- .(`1))" "(- ` ,'1)"
"(- ` -0 '1)" "(- ` 1 )" "(- ` `1)" "(- `, 1)" "(- `,1)" "(- `,`,1)" "(- `,`1)" "(- ``,,1)" "(- ``,1)" "(- ``1 )" "(- ```,1)"
"(- ```1)" "(-( / 1))" "(-( - -1 ))" "(-( `,- 1 0))" "(-(' (1)0))" "(-('(,1)00))" "(-(- '`1) 0)" "(-(- -1))" "(-(/(/(/ 1))))"
- "(-(`'1 '1))" "(-(`(,1 )'0))" "(-(`,/ ,1))" "(-(`,@''1))" "(/ '-1 '1 )" "(/ ,, `,-1)" "(/ ,11 -11)" "(/ 01 (- '1))" "(/ `1 '`-1)"
+ "(-(`'1 '1))" "(-(`(,1 )'0))" "(-(`,/ ,1))" "(/ '-1 '1 )" "(/ ,, `,-1)" "(/ ,11 -11)" "(/ 01 (- '1))" "(/ `1 '`-1)"
"(/(- '1) )" "(/(- '1)1)" "(/(- 001)1)" "(/(- 1),,1)" "(/(/ -1))" "(` ,- 1)" "(` `,(-1)0)" "(`' , -1 1)" "(/(- -001(+)))"
"(`' -1 '1/1)" "(`','-1 ,1)" "(`(,-1)-00)" "(`(-0 -1)1)" "(`(-1 -.')0)" "(`(-1 1')0)" "(`(` -1)'`0)" "(`, - 1)" "(`,- '1)" "(`,- .(1))"
"(`,- 1 )" "(`,- `,1)" "(`,- `1)" "(`,/ . (-1))" "(``,,- `01)" "('''-1 '1 '1)" "(/ `-1 1)" "(/ .( -1))" "(-(+(+)0)1)" "(/ ,`,`-1/1)"
"(-(*).())" "(*(- +1))" "(-(`,*))" "(-(+)'1)" "(+(-(*)))" "(-(+(*)))" "(-(+)(*))" "(-(/(*)))" "(*(-(*)))" "(-(*(*)))" "(/(-(*)))" "(-(+(*)))"
"(/ .(-1))" "(-(*))" "(- 000(*))" "(-(*(+ 1)))" "(- .((*)))" "(- +0/10(*))" "(-(`,/ .(1)))" "(+ .(' -01))" "(-(''1 01))" "(- -1/1 +0)"
"(- `,'0 `01)" "( - `,(+)'1)" "(+(- . (`1)))" "(* '`,``-1)" "(-(+ -0)1)" "(+ +0(-(*)))" "(+(- '+1 ))" "(+ '-01(+))" "(`, -(+)1)"
- "(`,+ 0 -1)" "(-(/(/(*))))" "(`,* .( -1))" "(-(*(*(*))))" "(`,@(list +)-1)" "(+(`,@''-1))" "(* (- 1) )" "(`, - (* ))" "(/(- (* 1)))"
+ "(`,+ 0 -1)" "(-(/(/(*))))" "(`,* .( -1))" "(-(*(*(*))))" "(`,@(list +)-1)" "(* (- 1) )" "(`, - (* ))" "(/(- (* 1)))"
"(- -0/1(*))" "(`(,-1)0)" "(/(-(*).()))" "(* ````-1)" "(-(+(*)0))" "(-(* `,(*)))" "(- +1(*)1)" "(- (` ,* ))" "(/(-(+ )1))" "(`,* -1(*))"
"(` ,- .(1))" "(+(`,-( *)))" "( /(`,- 1))" "(`(1 -1)1)" "(*( -(/(*))))" "(- -1(-(+)))" "(* ``,,-1)" "(-(+(+))1)" "( +(*(-(*))))"
"(-(+)`0(*))" "(-(+(+(*))))" "(-(+ .(01)))" "(/(*(-(* ))))" "(/ (-(* 1)))" "( /(-(/(*))))" "(+ -1 0/1)" "(/(-( +(*))))" "(*( -(`,*)))"
"(* 1(/ 1)-1)" "(+ 0(- ',01))" "(+(-(-(+ -1))))" "(- 0(/(+(* ))))" "(-(+)( *)0)"
+ "(`,- '01/1)" "(`, - ',,1)" "(/ .(`-1 1))" "(- ``,,'`1)" "(- 10 0011)" "(-(- ``1 0))" "( -(/ 01/1))" "(-(- 1)`,0)" "(/(/ -1 .()))"
+ "(/ ,,``-1)" "( `,`, - 1)" "(- .(`1/01 ))" "('(-1) ',``0)" "('( ,/ -1 )1)" "(- ,,`,`0 +1)" "(`(-1) `,0)" "(+(* (-(*))))"
+ "(-(`,* ,,1))" "(+(+ 0)-1)" "(+(-(+ ,1)))" "(* ,`-01/1)" "(*(- '` `1))" "(-(*(* 1 1)))" "(-(*(/ .(1))))" "(-(- 1(*)-1))"
+ "(- -00 (* 1))" "(- (*(+ ,01)))" "(-(*), +1(* ))" "(- `,@'(1))" "`,@`(-1)" "(`'`-1 1)" "',@*(-(*))" "`,@(list `,@`(-1))"
))
#|
@@ -16115,11 +27854,10 @@ who says the continuation has to restart the map from the top?
(size 14))
(let ((str (make-string size))
(clen (length chars)))
- (set! (str 0) #\()
(do ((i 0 (+ i 1)))
((= i 10000000))
- (let ((parens 1))
- (do ((k 1 (+ k 1)))
+ (let ((parens 0))
+ (do ((k 0 (+ k 1)))
((= k size))
(set! (str k) (chars (random clen)))
(if (char=? (str k) #\()
@@ -16148,11 +27886,11 @@ who says the continuation has to restart the map from the top?
(let ((num (eval-string str1)))
(if (and (number? num)
(eqv? num -1))
- (format #t "~S ~%" str1))))
+ (format *stderr* "~S ~%" str1))))
(lambda args
'error)))
(set! (-s7-symbol-table-locked?) #f))))))
-#|
+|#
(test (= 1 '+1 `+1 '`1 `01 ``1) #t)
(test (''- 1) '-)
@@ -16171,14 +27909,25 @@ who says the continuation has to restart the map from the top?
(test (- `,-1) 1)
;;; some weirder cases...
(test (begin . `''1) ''1)
-(test (`,@''1) 1)
-(test (`,@ `'1) 1)
-(test (`,@''.'.) '.'.)
-(test #(`,1) #(1))
-(test `#(,@'(1)) #(1))
-(test `#(,`,@''1) #(quote 1))
-(test `#(,@'(1 2 3)) #(1 2 3))
-(test `#(,`,@'(1 2 3)) #(1 2 3)) ; but #(`,@'(1 2 3)) -> #(({apply} {values} '(1 2 3)))
+ ;(test (`,@''1) 1)
+ ; (syntax-error ("attempt to apply the ~A ~S to ~S?" "symbol" quote (1))) ??
+ ; (({apply_values} ''values 1)) got error but expected 1
+ ;(test (`,@ `'1) 1)
+ ; (({apply_values} ''values 1)) got error but expected 1
+ ;(test (`,@''.'.) '.'.)
+ ; (({apply_values} ''values .'.)) got error but expected .'.
+(if with-qq-vectors (begin
+ (test #(`,1) #(1))
+ (test `#(,@'(1)) #(1))
+ (test `#(,`,@''1) #(quote 1))
+ (test `#(,@'(1 2 3)) #(1 2 3))
+ (test `#(,`,@'(1 2 3)) #(1 2 3)) ; but #(`,@'(1 2 3)) -> #(({apply_values} '(1 2 3)))
+ (test `#(,`#(1 2 3)) #(#(1 2 3)))
+ (test `#(,`#(1 ,(+ 2 3))) #(#(1 5)))
+ (test (quasiquote #(,`#(1 ,(+ 2 3)))) #(#(1 5)))
+ (test `#(,`#(1 ,(+ `,@'(2 3)))) #(#(1 5)))
+ (test `#(1 `,,(+ 2 3)) #(1 5))))
+
(test (apply . `''1) 'error) ; '(quote quote 1)) ; (apply {list} 'quote ({list} 'quote 1)) -> ;quote: too many arguments '1
(test (apply - 1( )) -1) ; (apply - 1 ())
(num-test (apply - 1.()) -1.0)
@@ -16186,31 +27935,30 @@ who says the continuation has to restart the map from the top?
(num-test (apply - .1 .(())) -0.1)
(num-test (apply - .1 .('(1))) -0.9)
(test (apply - -1()) 1) ; (apply - -1 ())
-(test (apply . `(())) '()) ; (apply {list} ())
+(test (apply . `(())) ()) ; (apply {list} ())
(test (apply . ''(1)) 1) ; (apply quote '(1))
(test (apply . '`(1)) 1) ; (apply quote ({list} 1))
-(test (apply . `(,())) '()) ; (apply {list} ())
+(test (apply . `(,())) ()) ; (apply {list} ())
(test (apply . `('())) ''()) ; (apply {list} ({list} 'quote ()))
-(test (apply . `(`())) '()) ; (apply {list} ())
+(test (apply . `(`())) ()) ; (apply {list} ())
(test (apply - `,1()) -1) ; (apply - 1 ())
(test (apply - ``1()) -1) ; (apply - 1 ())
(test (apply ''1 1()) 1) ; (apply ''1 1 ())
(test (apply .(- 1())) -1) ; (apply - 1 ())
(test (apply - .(1())) -1) ; (apply - 1 ())
(test (apply . `(1())) '(1)) ; (apply {list} 1 ())
-(test (apply . ''(())) '())
+(test (apply . ''(())) ())
(test (apply . `((()))) '(()))
+;;; comp.lang.lisp (test (with-input-from-string "(a `(aaa ,(/ 0.9)))" read) '(a ({list} 'aaa (/ 0.9))))
+
;; make sure the macro funcs really are constants
(test (defined? '{list}) #t)
(test (let () (set! {list} 2)) 'error)
(test (let (({list} 2)) {list}) 'error)
-(test (defined? '{values}) #t)
-(test (let () (set! {values} 2)) 'error)
-(test (let (({values} 2)) {values}) 'error)
-(test (defined? '{apply}) #t)
-(test (let () (set! {apply} 2)) 'error)
-(test (let (({apply} 2)) {apply}) 'error)
+;(test (defined? '{apply}) #t)
+;(test (let () (set! {apply} 2)) 'error)
+;(test (let (({apply} 2)) {apply}) 'error)
(test (defined? '{append}) #t)
(test (let () (set! {append} 2)) 'error)
(test (let (({append} 2)) {append}) 'error)
@@ -16218,16 +27966,19 @@ who says the continuation has to restart the map from the top?
(test (let () (set! {multivector} 2)) 'error)
(test (let (({multivector} 2)) {multivector}) 'error)
-(test (+ 1 ((`#(,(lambda () 0) ,(lambda () 2) ,(lambda () 4)) 1))) 3) ; this calls vector each time, just like using vector directly
-(test (+ 1 ((`(,(lambda () 0) ,(lambda () 2) ,(lambda () 4)) 1))) 3)
+(if with-qq-vectors (begin
+ (test (+ 1 ((`#(,(lambda () 0) ,(lambda () 2) ,(lambda () 4)) 1))) 3) ; this calls vector each time, just like using vector directly
+ (test `#(,@(list 1 2 3)) #(1 2 3)) ; but #(,@(list 1 2 3)) -> #((unquote ({apply_values} (list 1 2 3))))
+ (test (+ 1 ((`(,(lambda () 0) ,(lambda () 2) ,(lambda () 4)) 1))) 3)))
(test (object->string (list 'quote 1 2)) "(quote 1 2)")
(test (object->string (list 'quote 'quote 1)) "(quote quote 1)")
(test (object->string (list 'quote 1 2 3)) "(quote 1 2 3)")
-;;; but (object->string (list 'quote 1)) -> "'1" -- is this correct?
-;;; (equal? (quote 1) '1) -> #t and (equal? (list 'quote 1) ''1) -> #t
+(test (object->string (list 'quote 1)) "'1") ; confusing but this is (quote 1)
+(test (equal? (quote 1) '1) #t)
+(test (equal? (list 'quote 1) ''1) #t)
+(test (equal? (list 'quote 1) '''1) #f)
;;; see comment s7.c in list_to_c_string -- we're following Clisp here
-(test (object->string (list 'quote 1)) "'1")
(test (object->string (cons 'quote 1)) "(quote . 1)")
(test (object->string (list 'quote)) "(quote)")
(let ((lst (list 'quote 1)))
@@ -16238,38 +27989,38 @@ who says the continuation has to restart the map from the top?
(test (object->string lst) "#1=(quote . #1#)"))
(test (object->string quasiquote) "quasiquote")
+;; from Guile mailing list -- just a bit strange, even confuses emacs!
+(if (not with-windows)
+ (test (let ((v '(\())))
+ (and (pair? v)
+ (symbol? (car v)) ; \ -> ((symbol "\\") ())
+ (null? (cadr v)))) #t))
+
+(test #(,1) #(1))
+(test #(,,,1) #(1))
+(test #(`'`1) #(''1))
+(test (',- 1) '-) ; this is implicit indexing
#|
-unquote outside qq:
-(',- 1)
-(',1 1 )
(',,= 1) -> (unquote =)
-(', at 1 1) -> 1
-#(,1) -> #((unquote 1)) i.e. vector has 1 element the list '(unquote 1)
-#(, at 1) -> #((unquote ({apply} {values} 1)))
-#(,,,1) -> #((unquote (unquote (unquote 1))))
-is this a bug?
-#(`'`1) -> #(({list} 'quote 1))
-
-why are these different (read-time `#() ? )
-:`#(,@(list 1 2 3))
-#(1 2 3)
-:(quasiquote #(,@(list 1 2 3)))
-#((unquote ({apply} {values} (list 1 2 3))))
-|#
+(test (equal? (car (',,= 1)) 'unquote) #t) ; but that's kinda horrible
-(test (`,@''()) '())
-(test (`,@'''()) ''())
-(test (`,@''(())) '(()))
+(', at 1 1) -> ({apply_values} 1)
+#(, at 1) -> #((unquote ({apply_values} 1)))
+(quasiquote #(,@(list 1 2 3))) -> #((unquote ({apply_values} (list 1 2 3))))
+
+(quote ,@(for-each)) -> (unquote ({apply_values} (for-each)))
+;;; when is (quote ...) not '...?
+|#
(test (quasiquote) 'error)
(test (quasiquote 1 2 3) 'error)
(let ((d 1)) (test (quasiquote (a b c ,d)) '(a b c 1)))
(test (let ((a 2)) (quasiquote (a ,a))) (let ((a 2)) `(a ,a)))
(test (quasiquote 4) 4)
-(test (quasiquote (list (unquote (+ 1 2)) 4)) '(list 3 4))
+(if (not (provided? 'immutable-unquote)) (test (quasiquote (list (unquote (+ 1 2)) 4)) '(list 3 4)))
(test (quasiquote (1 2 3)) '(1 2 3))
-(test (quasiquote ()) '())
+(test (quasiquote ()) ())
(test (quasiquote (list ,(+ 1 2) 4)) '(list 3 4))
(test (quasiquote (1 ,@(list 1 2) 4)) '(1 1 2 4))
(test (quasiquote (a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) '(a 3 4 5 6 b))
@@ -16287,7 +28038,8 @@ why are these different (read-time `#() ? )
(test (quasiquote (,1 ,(quasiquote ,@(quasiquote (,1))))) '(1 1))
(test (quasiquote (,1 ,@(quasiquote ,@(list (list 1))))) '(1 1))
(test `(+ ,(apply values '(1 2))) '(+ 1 2))
-(test `(apply + (unquote '(1 2))) '(apply + (1 2)))
+(if (not (provided? 'immutable-unquote)) (test `(apply + (unquote '(1 2))) '(apply + (1 2))))
+(test (eval (list (list quasiquote +) -1)) -1)
(test (apply quasiquote '((1 2 3))) '(1 2 3))
(test (quasiquote (',,= 1)) 'error)
@@ -16300,13 +28052,13 @@ why are these different (read-time `#() ? )
(test `(1 , @ (list 2 3)) 'error) ; unbound @ ! (guile also)
(test (call-with-exit quasiquote) 'error)
-(test (call-with-output-string quasiquote) 'error)
-(test (map quasiquote '(1 2 3)) 'error)
-(test (for-each quasiquote '(1 2 3)) 'error)
+(test (call-with-output-string quasiquote) "")
+(test (map quasiquote '(1 2 3)) '(1 2 3)) ; changed 12-May-14
+(test (for-each quasiquote '(1 2 3)) #<unspecified>)
(test (sort! '(1 2 3) quasiquote) 'error)
(test (quasiquote . 1) 'error)
(test (let ((x 3)) (quasiquote . x)) 'error)
-(num-test `,#e.1 1/10)
+(when (not pure-s7) (num-test `,#e.1 1/10))
(num-test `,,,-1 -1)
(num-test `,``,1 1)
(test (equal? ` 1 ' 1) #t)
@@ -16315,19 +28067,32 @@ why are these different (read-time `#() ? )
(test (quasiquote #(1)) `#(1))
(test `(+ ,@(map sqrt '(1 4 9)) 2) '(+ 1 2 3 2))
-(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,@(map sqrt '(1 4 9)) 2)) '(+ 1 16 81 2))
(test `(+ ,(sqrt 9) 4) '(+ 3 4))
-(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(sqrt 9) 4)) '(+ 81 4))
-(test `(+ ,(let ((sqrt (lambda (a) (* a a)))) (sqrt 9)) 4) '(+ 81 4))
-(test `(+ (let ((sqrt (lambda (a) (* a a)))) ,(sqrt 9)) 4) '(+ (let ((sqrt (lambda (a) (* a a)))) 3) 4))
(test `(+ ,(apply values (map sqrt '(1 4 9))) 2) '(+ 1 2 3 2))
-(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(apply values (map sqrt '(1 4 9))) 2)) '(+ 1 16 81 2))
-(test (let ((sqrt (lambda (a) (* a a)))) `(+ (unquote (apply values (map sqrt '(1 4 9)))) 2)) '(+ 1 16 81 2))
+
+;; here is the difference between ,@ and apply values:
+(test (let ((x ())) `(+ , at x)) '(+))
+(test (let ((x ())) (+ (apply values x))) 'error) ; ;+ argument, #<unspecified>, is untyped
+(test (let ((x ())) (list + (apply values x))) (list + (values)))
+
+;; (apply + ({list} ({apply_values} ()))) -> 0 -- this is a special quasiquote list handling of ,@ that
+;; is not the same as (apply + ({list} (apply values ()))) -> error. quasiquote turns list into {list}
+;; and {list} treats (apply values...) specially. Maybe s7 should be less timid about (values). I used to
+;; think (abs -1 (values)) had to be an error, but now it looks fine.
+;;
+;; (let ((x ())) `(+ , at x)) -> (+)
+;; via (+ (unquote ({apply_values} x))) -> ({list} '+ ({apply_values} x))
+;;
+;; (let ((x ())) (list + (apply values x))) -> (+ #<unspecified>)
+;; via (+ (apply values (unquote x))) -> ({list} '+ ({list} 'apply 'values x))
+;; because (values) -> #<unspecified> but everywhere else , at x is the same as (apply values x)
+
+
;;; --------------------------------------------------------------------------------
-;;; -------- s7 specific stuff --------
+;;; keywords
;;; --------------------------------------------------------------------------------
;;; keyword?
@@ -16338,16 +28103,29 @@ why are these different (read-time `#() ? )
(for-each
(lambda (arg)
(test (keyword? arg) #f))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
(test (cond ((cond (())) ':)) ':)
(test (keyword? :#t) #t)
(test (eq? #t :#t) #f)
;(test (keyword? '#:t) #f) ; these 2 are fooled by the Guile-related #: business (which is still supported)
;(test (keyword? '#:#t) #f)
+;#:1.0e8 is also a keyword(!)
+;#:# is also, so #:#() is interpreted as #:# ()
+
(test (keyword? :-1) #t)
+(test (keyword? :0/0) #t)
+(test (keyword? :1+i) #t)
+(test (keyword? :1) #t)
+(test (keyword? 0/0:) #t)
+(test (keyword? 1+i:) #t)
+(test (keyword? 1:) #t)
+;;; bizarre...
+
(test (keyword? (symbol ":#(1 #\\a (3))")) #t)
(test (keyword? (make-keyword (object->string #(1 #\a (3)) #f))) #t)
+(test (keyword? begin) #f)
+(test (keyword? if) #f)
(let ((kw (make-keyword "hiho")))
(test (keyword? kw) #t)
@@ -16370,6 +28148,7 @@ why are these different (read-time `#() ? )
(test (make-keyword "3") :3)
(test (keyword? :3) #t)
(test (keyword? ':3) #t)
+ (test (eq? (keyword->symbol :hi) (keyword->symbol hi:)) #t)
(test (equal? :3 3) #f)
(test (equal? (keyword->symbol :3) 3) #f)
(test (equal? (symbol->value (keyword->symbol :3)) 3) #f) ; 3 as a symbol has value #<undefined>
@@ -16379,7 +28158,9 @@ why are these different (read-time `#() ? )
(apply define (symbol "3") '(32))
(test (symbol->value (symbol "3")) 32) ; hmmm
(apply define (list (symbol "3") (lambda () 32)))
- (test (symbol->value (symbol "3")) 32))
+ (test (symbol->value (symbol "3")) 32)
+ (apply define (symbol ".") '(123))
+ (test (+ (symbol->value (symbol ".")) 321) 444))
|#
(test (keyword? '3) #f)
@@ -16389,13 +28170,12 @@ why are these different (read-time `#() ? )
(test (keyword? ::a) #t)
(test (eq? ::a ::a) #t)
(test (eq? (keyword->symbol ::a) :a) #t)
- (test (eq? (symbol->keyword :a) ::a) #t)
+ (test (eq? (symbol->keyword :a) ::a) #t) ; ?? -- :a is already a keyword
(test (symbol->string ::a) "::a")
(test ((lambda* (:a 32) ::a) 0) 'error) ; :a is a constant
(test (eq? :::a::: :::a:::) #t)
(test (keyword? a::) #t)
(test (keyword->symbol ::) ':)
- (test (keyword? :optional) #t)
(test (symbol->string (keyword->symbol hi:)) "hi")
(test (symbol->string (keyword->symbol :hi)) "hi")
(test (keyword? (make-keyword (string #\x (integer->char 128) #\x))) #t)
@@ -16407,6 +28187,15 @@ why are these different (read-time `#() ? )
(test (keyword->symbol (make-keyword (string #\"))) (symbol "\""))
)
+(test (symbol->keyword 'begin) :begin)
+(test (symbol->keyword 'quote) :quote)
+(test (symbol->keyword if) 'error)
+(test (symbol->keyword quote) 'error)
+(test (symbol->keyword :a) ::a)
+(test (keyword->symbol ::a) :a)
+(test (symbol->keyword (symbol "(a)")) (symbol ":(a)"))
+(test (keyword? (symbol ":(a)")) #t)
+
(test (let ((:hi 3)) :hi) 'error)
(test (set! :hi 2) 'error)
(test (define :hi 3) 'error)
@@ -16421,7 +28210,7 @@ why are these different (read-time `#() ? )
(let ((key (make-keyword str)))
(let ((newstr (symbol->string (keyword->symbol key))))
(if (not (string=? newstr str))
- (format #t ";make-keyword -> string: ~S -> ~A -> ~S~%" str key newstr)))))))
+ (format-logged #t ";make-keyword -> string: ~S -> ~A -> ~S~%" str key newstr)))))))
(let ()
(define* (hi a b) (+ a b))
@@ -16432,17 +28221,17 @@ why are these different (read-time `#() ? )
(for-each
(lambda (arg)
(test (make-keyword arg) 'error))
- (list -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+ (list -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (keyword->symbol arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (symbol->keyword arg) 'error))
- (list "hi" -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+ (list "hi" -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
(test (keyword?) 'error)
(test (keyword? 1 2) 'error)
@@ -16455,11 +28244,12 @@ why are these different (read-time `#() ? )
+;;; --------------------------------------------------------------------------------
;;; gensym
(for-each
(lambda (arg)
(test (gensym arg) 'error))
- (list -1 #\a 1 'hi _ht_ '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+ (list -1 #\a 1 'hi _ht_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
(test (gensym "hi" "ho") 'error)
@@ -16471,6 +28261,10 @@ why are these different (read-time `#() ? )
(test (keyword? (gensym)) #f)
(test (let* ((a (gensym)) (b a)) (eq? a b)) #t)
(test (let* ((a (gensym)) (b a)) (eqv? a b)) #t)
+(test (keyword? (symbol->keyword (gensym))) #t)
+(test (let ((g (gensym))) (set! g 12) g) 12)
+(test (->byte-vector (substring (symbol->string (gensym #u8(124 255 127))) 0 5)) #u8(123 124 255 127 125))
+(test (->byte-vector (substring (symbol->string (gensym #u8(124 0 127))) 0 3)) #u8(123 124 125)) ; nul->end of symbol string
(let ((sym (gensym)))
(test (eval `(let ((,sym 32)) (+ ,sym 1))) 33))
@@ -16478,6 +28272,12 @@ why are these different (read-time `#() ? )
(let ((sym1 (gensym))
(sym2 (gensym)))
(test (eval `(let ((,sym1 32) (,sym2 1)) (+ ,sym1 ,sym2))) 33))
+(test (eval (let ((var (gensym "a b c"))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym ""))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym "."))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym "{"))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym "}"))) `(let ((,var 2)) (+ ,var 1)))) 3)
+(test (eval (let ((var (gensym (string #\newline)))) `(let ((,var 2)) (+ ,var 1)))) 3)
(test (let ((hi (gensym))) (eq? hi (string->symbol (symbol->string hi)))) #t)
(test (let () (define-macro (hi a) (let ((var (gensym ";"))) `(let ((,var ,a)) (+ 1 ,var)))) (hi 1)) 2)
@@ -16499,15 +28299,37 @@ why are these different (read-time `#() ? )
(test (apply func (list (symbol->keyword funny-name) 2)) 3))
+;;; gensym?
+
+(for-each
+ (lambda (arg)
+ (test (gensym? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () car abs (lambda () 1) #2d((1 2) (3 4)) _ht_ _null_ _c_obj_ #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+(test (gensym?) 'error)
+(let ((g (gensym)))
+ (test (gensym? g) #t)
+ (test (gensym? g g) 'error))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; provided?
+;;; provide
(test (provided?) 'error)
-(test (provide) 'error)
(test (or (null? *features*) (pair? *features*)) #t)
(test (provided? 1 2 3) 'error)
-(test (provide 1 2 3) 'error)
(provide 's7test)
(test (provided? 's7test) #t)
(test (provided? 'not-provided!) #f)
+(test (provided? 'begin) #f)
+(test (provided? if) 'error)
+(test (provided? quote) 'error)
+
+(test (provide quote) 'error)
+(test (provide 1 2 3) 'error)
+(test (provide) 'error)
(test (provide lambda) 'error)
(provide 's7test) ; should be a no-op
@@ -16517,128 +28339,116 @@ why are these different (read-time `#() ? )
(if (eq? p 's7test)
(set! count (+ count 1)))
(if (not (provided? p))
- (format #t ";~A is in *features* but not provided? ~A~%" p *features*)))
+ (format-logged #t ";~A is in *features* but not provided? ~A~%" p *features*)))
*features*)
(if (not (= count 1))
- (format #t ";*features* has ~D 's7test entries? ~A~%" count *features*)))
+ (format-logged #t ";*features* has ~D 's7test entries? ~A~%" count *features*)))
+
+(test (let ((*features* 123)) (provided? 's7)) #t)
(for-each
(lambda (arg)
(test (provide arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
(test (provided? arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) (list 1 2 3) '(1 . 2)))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
- (test (set! *gc-stats* arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() '#(()) (list 1 2 3) '(1 . 2)))
-(test *gc-stats* #f)
+ (test (set! (*s7* 'gc-stats) arg) 'error))
+ (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #(()) (list 1 2 3) '(1 . 2)))
+(test (*s7* 'gc-stats) 0)
-(let ((f (sort! *features* (lambda (a b) (string<? (object->string a #f) (object->string b #f))))))
+(let ((f (sort! (copy *features*) (lambda (a b) (string<? (object->string a #f) (object->string b #f))))))
(let ((last 'not-in-*features*))
(for-each
(lambda (p)
(if (eq? p last)
- (format #t ";*features has multiple ~A? ~A~%" p *features*))
+ (format-logged #t ";*features has multiple ~A? ~A~%" p *features*))
(set! last p))
f)))
+(let ()
+ (provide 'locals)
+ (test (provided? 'locals) #t)
+ (test (defined? 'locals) #t))
+(test (provided? 'locals) #f)
+(test (defined? 'locals) #f)
+
+(let ()
+ (require stuff.scm)
+ (test (provided? 'stuff.scm) #t))
+(test (provided? 'stuff.scm) #f)
+
+(let ()
+ (provide 'local-stuff)
+ (call-with-output-file tmp-output-file
+ (lambda (p)
+ (format p "(provide 'tmp-output)~%(define (tmp-output-func a) a)~%")))
+ (load tmp-output-file)
+ (test (provided? 'tmp-output) #t))
+(test (provided? 'local-stuff) #f)
+(test (provided? 'tmp-output) #t)
+
(for-each
(lambda (arg)
- (test (set! *safety* arg) 'error)
+ (test (set! (*s7* 'safety) arg) 'error)
(test (set! *features* arg) 'error)
(test (set! *load-path* arg) 'error)
(test (set! *#readers* arg) 'error)
)
- (list #\a '#(1 2 3) 3.14 3/4 1.0+1.0i abs 'hi #t #f '#(())))
-(test (let ((*features* 123)) *features*) 'error)
-(test (let ((*safety* '(1 2 3))) *safety*) 'error)
+ (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i abs 'hi #t #f #(())))
+;(test (let ((*features* 123)) *features*) 'error)
+;(test (let (((*s7* 'safety) '(1 2 3))) (*s7* 'safety)) 'error)
+;(test (let (((*s7* 'safety) 1)) 2) 'error)
(test (set! *load-path* (list 1 2 3)) 'error)
+(set! *#readers* old-readers)
+
+;;; (*s7* 'print-length)
-(test (integer? *vector-print-length*) #t)
+(test (integer? (*s7* 'print-length)) #t)
(test (or (null? *#readers*) (pair? *#readers*)) #t)
(test (or (null? *load-path*) (pair? *load-path*)) #t)
-(test (vector? *error-info*) #t)
-
-(test (let () (set! *error-info* 2)) 'error)
-(test (let ((*error-info* 2)) *error-info*) 'error)
-(let ((old-len *vector-print-length*))
+(let ((old-len (*s7* 'print-length)))
(for-each
(lambda (arg)
- (test (set! *vector-print-length* arg) 'error))
- (list -1 #\a '#(1 2 3) 3.14 3/4 1.0+1.0i abs 'hi '() #t #f '#(()) (list 1 2 3) '(1 . 2)))
- (set! *vector-print-length* old-len))
-
-(let ((old-hook (hook-functions *unbound-variable-hook*))
- (hook-val #f))
- (set! (hook-functions *unbound-variable-hook*) (list (lambda (sym) (set! hook-val sym) 123)))
- (catch #t
- (lambda ()
- (+ 1 one-two-three))
- (lambda args 'error))
- (test (equal? one-two-three 123) #t)
- (test (equal? hook-val 'one-two-three) #t)
- (set! (hook-functions *unbound-variable-hook*) old-hook))
+ (test (set! (*s7* 'print-length) arg) 'error))
+ (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i abs 'hi () #t #f #(()) (list 1 2 3) '(1 . 2)))
+ (set! (*s7* 'print-length) old-len))
-(for-each
- (lambda (arg)
- (test (set! *unbound-variable-hook* arg) 'error)
- (test (set! *error-hook* arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '#(())))
-(let ((old-load-hook (hook-functions *load-hook*))
- (val #f))
- (with-output-to-file "load-hook-test.scm"
- (lambda ()
- (format #t "(define (load-hook-test val) (+ val 1))")))
- (set! *load-hook*
- (lambda (file)
- (if (or val
- (defined? 'load-hook-test))
- (format #t ";*load-hook*: ~A ~A?~%" val load-hook-test))
- (set! val file)))
- (load "load-hook-test.scm")
- (if (or (not (string? val))
- (not (string=? val "load-hook-test.scm")))
- (format #t ";*load-hook-test* file: ~S~%" val))
- (if (not (defined? 'load-hook-test))
- (format #t ";load-hook-test function not defined?~%")
- (if (not (= (load-hook-test 1) 2))
- (format #t ";load-hook-test: ~A~%" (load-hook-test 1))))
- (set! (hook-functions *load-hook*) old-load-hook))
-
-(let ((old-vlen *vector-print-length*))
- (set! *vector-print-length* 0)
+(let ((old-vlen (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 0)
(test (format #f "~A" #()) "#()")
(test (format #f "~A" #(1 2 3 4)) "#(...)")
- (set! *vector-print-length* 1)
+ (set! (*s7* 'print-length) 1)
(test (format #f "~A" #()) "#()")
(test (format #f "~A" #(1)) "#(1)")
(test (format #f "~A" #(1 2 3 4)) "#(1 ...)")
- (set! *vector-print-length* 2)
+ (set! (*s7* 'print-length) 2)
(test (format #f "~A" #(1 2 3 4)) "#(1 2 ...)")
- (set! *vector-print-length* old-vlen))
+ (set! (*s7* 'print-length) old-vlen))
(if with-bignums
- (let ((old-vlen *vector-print-length*))
- (set! *vector-print-length* (bignum "0"))
+ (let ((old-vlen (*s7* 'print-length)))
+ (set! (*s7* 'print-length) (bignum "0"))
(test (format #f "~A" #()) "#()")
- (test (format #f "~A" #(1 2 3 4)) "#(...)")
- (set! *vector-print-length* (bignum "1"))
+ (test (format #f "~A" #(1 2 3 4)) "#(1 ...)")
+ (set! (*s7* 'print-length) (bignum "1"))
(test (format #f "~A" #()) "#()")
(test (format #f "~A" #(1)) "#(1)")
(test (format #f "~A" #(1 2 3 4)) "#(1 ...)")
- (set! *vector-print-length* (bignum "2"))
- (test (format #f "~A" #(1 2 3 4)) "#(1 2 ...)")
- (set! *vector-print-length* old-vlen)))
+ (set! (*s7* 'print-length) (bignum "2"))
+ (test (format #f "~A" #(1 2 3 4)) "#(1 ...)")
+ (set! (*s7* 'print-length) old-vlen)))
+
-;;; -------- sort!
+;;; --------------------------------------------------------------------------------
;;; sort!
(test (sort! '(2 3) <) '(2 3))
@@ -16841,7 +28651,7 @@ why are these different (read-time `#() ? )
(test (sort! #(1 2 3) (lambda (a b) (> a b))) #(3 2 1))
(test (equal? (sort! (list 3 4 8 2 0 1 5 9 7 6) <) (list 0 1 2 3 4 5 6 7 8 9)) #t)
(test (equal? (sort! (list 3 4 8 2 0 1 5 9 7 6) (lambda (a b) (< a b))) (list 0 1 2 3 4 5 6 7 8 9)) #t)
-(test (equal? (sort! (list) <) '()) #t)
+(test (equal? (sort! (list) <) ()) #t)
(test (equal? (sort! (list 1) <) '(1)) #t)
(test (equal? (sort! (list 1 1 1) <) '(1 1 1)) #t)
(test (equal? (sort! (list 0 1 2 3 4 5 6 7 8 9) <) '(0 1 2 3 4 5 6 7 8 9)) #t)
@@ -16862,49 +28672,61 @@ why are these different (read-time `#() ? )
(test (sort! #2d((1 4) (3 2)) >) #2D((4 3) (2 1))) ; ??!!?? this is not what anyone would expect
(test (sort! '(3 2 1) (lambda (a b c) #f)) 'error)
(test (sort! '(3 2 1) (lambda* (a b c) (< a b))) '(1 2 3))
+(test (sort! '(3 2 1) (lambda (a b . c) (< a b))) '(1 2 3))
(test (sort! '(3 2 1) (lambda (a) #f)) 'error)
(test (sort! '(3 2 1) (lambda* (a) #f)) 'error)
(test (sort! '(3 1 2 4) (lambda args (< (car args) (cadr args)))) '(1 2 3 4))
+(test (sort! (rootlet) <) 'error)
+(test (sort! () #f) 'error)
(test (equal? (sort! (vector 3 4 8 2 0 1 5 9 7 6) <) (vector 0 1 2 3 4 5 6 7 8 9)) #t)
-(test (equal? (sort! '#() <) '#()) #t)
+(test (equal? (sort! (make-vector 3 0 #t) (lambda* (a b) (< a b))) (make-vector 3 0 #t)) #t)
+(test (equal? (sort! (make-vector 3 1.0 #t) >) (float-vector 1.0 1.0 1.0)) #t)
+(test (morally-equal? (let ((v (make-vector 3 0 #t))) (set! (v 1) 3) (set! (v 2) -1) (sort! v <)) #(-1 0 3)) #t)
+(test (morally-equal? (let ((v (make-vector 3 0 #t))) (set! (v 1) 3) (set! (v 2) -1) (sort! v (lambda (a b) (< a b)))) #(-1 0 3)) #t)
+(test (morally-equal? (let ((v (make-vector 3 0 #t))) (set! (v 1) 3) (set! (v 2) -1) (sort! v (lambda* (a b) (< a b)))) #(-1 0 3)) #t)
+
+(test (equal? (sort! #() <) #()) #t)
(test (sort! '(1 2 . 3) <) 'error)
(test (sort! #(1 3 8 7 5 6 4 2) (lambda (a b) (if (even? a) (or (odd? b) (< a b)) (and (odd? b) (< a b))))) #(2 4 6 8 1 3 5 7))
(let ((ninf (real-part (log 0.0))) (pinf (- (real-part (log 0.0))))) (test (sort! (list pinf 0.0 ninf) <) (list ninf 0.0 pinf)))
(test (sort! '(1 1 1) <) '(1 1 1))
-(test (call/cc (lambda (return) (sort! '(1 2 3) (lambda (a b) (return "oops"))))) "oops")
-(let ((p1 (make-procedure-with-setter (lambda (a b) (< a b)) (lambda (a b) (error 'oops)))))
+(test (call/cc (lambda (return) (sort! '(1 2 3) (lambda (a b) (return "oops"))))) "oops") ; segfault outside s7test.scm??
+(let ((p1 (dilambda (lambda (a b) (< a b)) (lambda (a b) (error 'oops)))))
(test (sort! '(3 1 2 4) p1) '(1 2 3 4)))
-(let ((p1 (make-procedure-with-setter (lambda* (a (b 2)) (< a b)) (lambda (a b) (error 'oops)))))
+(let ((p1 (dilambda (lambda* (a (b 2)) (< a b)) (lambda (a b) (error 'oops)))))
(test (sort! '(3 1 2 4) p1) '(1 2 3 4)))
-(let ((p1 (make-procedure-with-setter (lambda args (< (car args) (cadr args))) (lambda (a b) (error 'oops)))))
+(let ((p1 (dilambda (lambda args (< (car args) (cadr args))) (lambda (a b) (error 'oops)))))
(test (sort! '(3 1 2 4) p1) '(1 2 3 4)))
-(test (let ((v (make-vector 1000)))
+(test (let ((v (make-float-vector 1000)))
(do ((i 0 (+ i 1)))
((= i 1000))
- (vector-set! v i (random 100.0)))
+ (float-vector-set! v i (random 100.0)))
(set! v (sort! v >))
(call-with-exit
(lambda (return)
(do ((i 0 (+ i 1)))
((= i 999) #t)
- (if (<= (v i) (v (+ i 1)))
- (return #f))))))
+ (if (< (v i) (v (+ i 1)))
+ (begin
+ (format-logged #t "random vals after sort: ~A ~A~%" (v i) (v (+ i 1)))
+ (return #f)))))))
#t)
-(test (let ((v '()))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (set! v (cons (random 100.0) v)))
- (set! v (sort! v >))
- (apply > v))
- #t)
+(let ((v ()))
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (set! v (cons (random 100.0) v)))
+ (set! v (sort! v >))
+ (if (not (apply >= v))
+ (format-logged #t ";sort!: v not sorted by >: ~A~%" )))
+
(test (sort! (list 3 2 1) (lambda (m n) (let ((vals (sort! (list m n) <))) (< m n)))) '(1 2 3))
-(test (let ((lst '()))
+(test (let ((lst ()))
(do ((i 0 (+ i 1)))
((= i 4))
(set! lst (cons (random 1.0) lst)))
@@ -16925,7 +28747,7 @@ why are these different (read-time `#() ? )
(let ((v1 (copy v)))
(sort! v <)
(if (not (apply < (vector->list v)))
- (format #t ";(sort! ~A <) -> ~A?" v1 v)))))
+ (format-logged #t ";(sort! ~A <) -> ~A?" v1 v)))))
(test (sort!) 'error)
(test (sort! '(1 2 3) < '(3 2 1)) 'error)
@@ -16938,12 +28760,37 @@ why are these different (read-time `#() ? )
(test (sort! '(1 2 #t) <) 'error)
(test (sort! '(1 2 . #t) <) 'error)
(test (sort! '(#\c #\a #\b) <) 'error)
-
-(test (sort! (list) <) '())
+(test (sort! (begin) if) 'error)
+
+(test (let ((v #(1 2 3))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v (float-vector 1 2 3))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v (make-vector 3 0 #t))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v #u8(0 1 2))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v (list 0 1 2))) (let ((v1 (sort! v >))) (eq? v v1))) #t)
+(test (let ((v "012")) (let ((v1 (sort! v char>?))) (eq? v v1))) #t)
+
+(test (let ((v "adcb")) (sort! v char>?) v) "dcba")
+(test (let ((v "adcb")) (sort! v <) v) 'error)
+(test (let ((v "adecb")) (sort! v char<?) v) "abcde")
+(test (let ((v "db")) (sort! v char<?)) "bd")
+(test (let ((v "d")) (sort! v char<?) v) "d")
+(test (let ((v "")) (sort! v char<?) v) "")
+(test (let ((v "adecfb")) (sort! v (lambda (a b) (char<? a b)))) "abcdef")
+
+(test (let ((v #u8(3 0 1 2))) (sort! v <) v) #u8(0 1 2 3))
+(test (let ((v #u8(3 0 1 2))) (sort! v >)) #u8(3 2 1 0))
+(test (let ((v #u8(3 0 1 2))) (sort! v char>?) v) 'error)
+(test (let ((v #u8(3))) (sort! v >) v) #u8(3))
+(test (let ((v #u8(3 1))) (sort! v <) v) #u8(1 3))
+(test (let ((v #u8())) (sort! v <) v) #u8())
+(test (let ((v #u8(1 4 3 2 0))) (sort! v (lambda (a b) (< a b)))) #u8(0 1 2 3 4))
+(test (let ((v #("123" "321" "132" "432" "0103" "123"))) (sort! v string>?)) #("432" "321" "132" "123" "123" "0103"))
+
+(test (sort! (list) <) ())
(test (sort! (vector) <) #())
(test (sort! (list #\a) <) '(#\a)) ; I guess this is reasonable
(test (sort! (list #("hi")) <) '(#("hi")))
-(test (sort! (append (sort! (append (sort! () <) ()) <) ()) <) '())
+(test (sort! (append (sort! (append (sort! () <) ()) <) ()) <) ())
(test (sort! (append (sort! (append (sort! '(1 2) <) '(1 2)) <) '(1 2)) <) '(1 1 1 2 2 2))
(test (let ((lst (list 3 1 12 4 1)))
(sort! lst (lambda (a b)
@@ -16952,10 +28799,13 @@ why are these different (read-time `#() ? )
'(1 1 3 4 12))
(test (sort! '(#\c #\a #\b) (lambda (a b) (string<? (string a) (string b)))) '(#\a #\b #\c))
+(test (let ((ov #(0 1 2)) (uv #(5 4 3 2 1))) (sort! uv (lambda (a b) (sort! ov >) (< a b))) ov) #(2 1 0))
+
(for-each
(lambda (arg)
- (test (sort! arg <) 'error))
- (list -1 #\a 1 0 "" "hiho" (make-hash-table) :hi 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
+ (test (sort! arg <) 'error)
+ (test (sort! () arg) 'error))
+ (list -1 #\a 1 0 "hiho" (make-hash-table) :hi 'a-symbol 3.14 3/4 1.0+1.0i #f #t))
(for-each
(lambda (arg)
@@ -16977,8 +28827,13 @@ why are these different (read-time `#() ? )
(lambda () (sort! '(1 2 "hi" 3) <))
(lambda () (set! ok #t))))
(lambda args 'error))
- (if (not ok) (format #t "dynamic-wind out of sort! skipped cleanup?~%")))
+ (if (not ok) (format-logged #t "dynamic-wind out of sort! skipped cleanup?~%")))
+(test (let ((v (float-vector 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (float-vector 3 2 1))
+(test (let ((v (int-vector 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (int-vector 3 2 1))
+(test (let ((v (list 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (list 3 2 1))
+(test (let ((v "123")) (sort! v (lambda (a b) (call-with-exit (lambda (r) (char>? a b))))) v) "321")
+(test (let ((v #u8(1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) #u8(3 2 1))
(let ((lst (list 1 2 3 9 8 7)))
(let ((val (catch #t
@@ -16989,7 +28844,7 @@ why are these different (read-time `#() ? )
#t)))
(lambda args (car args)))))
(if (not (eq? val 'sort-error))
- (format #t ";sort! with error: ~A~%" val)))
+ (format-logged #t ";sort! with error: ~A~%" val)))
(let ((val (call-with-exit
(lambda (return)
@@ -16998,7 +28853,7 @@ why are these different (read-time `#() ? )
(if (< a b) (return 'sort-error))
#t))))))
(if (not (eq? val 'sort-error))
- (format #t ";sort! call-with-exit: ~A~%" val)))
+ (format-logged #t ";sort! call-with-exit: ~A~%" val)))
(let ((val (call/cc
(lambda (return)
@@ -17007,23 +28862,23 @@ why are these different (read-time `#() ? )
(if (< a b) (return 'sort-error))
#t))))))
(if (not (eq? val 'sort-error))
- (format #t ";sort! call/cc: ~A~%" val)))
+ (format-logged #t ";sort! call/cc: ~A~%" val)))
)
-(let ((old-safety *safety*))
- (set! *safety* 1)
- (test (sort! #(1 2 3) =) 'error)
- (set! *safety* old-safety))
-
+(let ((old-safety (*s7* 'safety)))
+ (set! (*s7* 'safety) 1)
+ (test (sort! #(1 2 3) (lambda (a b) (and #t (= a b)))) 'error)
+ ;(test (* 524288 19073486328125) 'error) ; maybe someday...
+ (set! (*s7* 'safety) old-safety))
-;;; -------- catch --------
+;;; --------------------------------------------------------------------------------
;;; catch
(define (catch-test sym)
- (let ((errs '()))
+ (let ((errs ()))
(catch 'a1
(lambda ()
(catch 'a2
@@ -17053,7 +28908,7 @@ why are these different (read-time `#() ? )
(test (catch-test 'a4) '(a4))
(define (catch-test-1 sym)
- (let ((errs '()))
+ (let ((errs ()))
(catch 'a1
(lambda ()
(catch 'a2
@@ -17095,41 +28950,161 @@ why are these different (read-time `#() ? )
(test (catch #t ((lambda () (lambda () 1))) (lambda b a)) 1)
(test (map (catch #t (lambda () abs) abs) '(-1 -2 -3)) '(1 2 3))
(test (catch + (((lambda () lambda)) () 1) +) 1)
-(test (catch #t + +) 'error)
+;(test (catch #t + +) 'error) ; changed 12-May-14
(test (string? (catch + s7-version +)) #t)
(test (string? (apply catch + s7-version (list +))) #t)
(test (catch #t (lambda () (catch '#t (lambda () (error '#t)) (lambda args 1))) (lambda args 2)) 1)
(test (catch #t (lambda () (catch "hi" (lambda () (error "hi")) (lambda args 1))) (lambda args 2)) 2) ; guile agrees with this
(test (let ((str (list 1 2))) (catch #t (lambda () (catch str (lambda () (error str)) (lambda args 1))) (lambda args 2))) 1)
-(test (let ((str "hi")) (catch #t (lambda () (catch str (lambda () (error str)) (lambda args 1))) (lambda args 2))) 2) ; this doesn't make sense
+(test (let () (abs (catch #t (lambda () -1) (lambda args 0)))) 1)
+;(test (let ((e #f)) (catch #t (lambda () (+ 1 "asdf")) (lambda args (set! e (owlet)))) (eq? e (owlet))) #t)
+(test (+ (catch 'oops (lambda () (error 'oops)) (lambda args (values 1 2 3)))) 6)
+(test (catch #t (lambda () (error 1 2 3)) (lambda* ((a 2) (b 3) (c 4)) (list a b c))) '(1 (2 3) 4))
-#|
-(for-each
- (lambda (str)
- (format #t "~A ~A~%" str (catch #t (lambda ()
- (catch str (lambda ()
- (error str)) ; use throw for guile
- (lambda args 1)))
- (lambda args 2))))
- (list "hi" '() (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+;;; various catch macros from s7.html
+(let ()
+ (define-macro (catch-all . body)
+ `(catch #t (lambda () , at body) (lambda args args)))
+ (let ((val (catch-all (+ 1 asdf))))
+ (test (car val) 'syntax-error)
+ (let ((x 32))
+ (test (catch-all (set! x (+ x 1)) (* x 2)) 66)
+ (test (car (catch-all (string=? x "hi"))) 'wrong-type-arg))))
- s7 Guile
-"hi" 2 2
-() 1 2
-(1) 1 2
-(1 . 2) 1 2
-#f 1 2
-a-symbol 1 1
-#(#<unspecified> #<unspecified> #<unspecified>) 1 2
-abs 1 2
-3.14 1 2
-3/4 1 2
-1+1i 1 2
-#t 1 1
-#<unspecified> 1 2
-#<closure> 1 2
-|#
+(let ()
+ (define-macro (catch-case clauses . body)
+ (let ((base `(lambda () , at body)))
+ (for-each (lambda (clause)
+ (let ((tag (car clause)))
+ (set! base `(lambda ()
+ (catch ',(if (eq? tag 'else) #t tag)
+ ,base
+ ,@(cdr clause))))))
+ clauses)
+ (caddr base)))
+
+ (test (catch-case ((wrong-type-arg (lambda args (format #t "got a bad arg~%") -1))
+ (division-by-zero (lambda args 0))
+ (else (lambda args 123)))
+ (abs -1))
+ 1)
+ (test (catch-case ((wrong-type-arg (lambda args (format #t "got a bad arg~%") -1))
+ (division-by-zero (lambda args 0))
+ (else (lambda args 123)))
+ (let ((x 0)) (/ 32 x)))
+ 0)
+ (test (catch-case ((wrong-type-arg (lambda args -1))
+ (division-by-zero (lambda args 0))
+ (else (lambda args 123)))
+ (abs "hi"))
+ -1)
+ (test (catch-case ((wrong-type-arg (lambda args (format #t "got a bad arg~%") -1))
+ (division-by-zero (lambda args 0))
+ (else (lambda args 123)))
+ (throw 'oops -1))
+ 123))
+
+(let ()
+ (define (catch-if test func err)
+ (catch #t
+ func
+ (lambda args
+ (if (test (car args))
+ (apply err args)
+ (apply throw args))))) ; if not caught, re-raise the error
+
+ (test (catch #t
+ (lambda ()
+ (catch-if
+ (lambda (tag)
+ (eq? tag 'oops))
+ (lambda ()
+ (error 'oops 123))
+ (lambda args
+ 32)))
+ (lambda args 47))
+ 32)
+ (test (catch #t
+ (lambda ()
+ (catch-if
+ (lambda (tag)
+ (eq? tag 'oops))
+ (lambda ()
+ (error 'err 123))
+ (lambda args
+ 32)))
+ (lambda args (car args)))
+ 'err)
+
+ (define (catch-member lst func err)
+ (catch-if (lambda (tag) (member tag lst)) func err))
+ (test (catch-member '(oops err)
+ (lambda ()
+ (error 'oops))
+ (lambda args 47))
+ 47))
+
+(let ()
+ (define-macro (catch* clauses . error)
+ (define (builder lst)
+ (if (null? lst)
+ (apply values error)
+ `(catch #t (lambda () ,(car lst)) (lambda args ,(builder (cdr lst))))))
+ (builder clauses))
+ (test (catch* ((+ 1 2) (- 3 4)) 'error) 3)
+ (test (catch* ((+ 1 "hi") (- 3 4)) 'error) -1)
+ (test (catch* ((+ 1 "hi") (- 3 #\a)) 'error) 'error))
+
+
+(multiple-value-bind (err-type err-data)
+ (call-with-exit
+ (lambda (return)
+ (catch #t
+ (lambda () _asdf_)
+ return)))
+ (test err-type 'syntax-error)
+ (test err-data '("~A: unbound variable" _asdf_)))
+
+(test (catch #t (lambda () _asdf_) "asdf") 'error)
+(when with-block (test (catch #t (lambda () _asdf_) blocks) '(syntax-error ("~A: unbound variable" _asdf_))))
+
+;;; since catch is a function, everything is evaluated:
+(test
+ (catch (#(0 #t 1) 1)
+ ((lambda (a)
+ (lambda ()
+ (+ a "asdf")))
+ 1)
+ ((lambda (b)
+ (lambda args
+ (format #f "got: ~A" b)))
+ 2))
+ "got: 2")
+
+(let ()
+ (define (hi c)
+ (catch c
+ ((lambda (a)
+ (lambda ()
+ (+ a "asdf")))
+ 1)
+ ((lambda (b)
+ (lambda args
+ (format #f "got: ~A" b)))
+ 2)))
+ (test (hi #t) "got: 2"))
+
+(test
+ (catch (#(0 #t 1) 1)
+ (values ((lambda (a)
+ (lambda ()
+ (+ a "asdf")))
+ 1)
+ ((lambda (b)
+ (lambda args
+ (format #f "got: ~A" b)))
+ 2)))
+ "got: 2")
(let ((x 0))
(catch #t
@@ -17161,11 +29136,157 @@ abs 1 2
x)
1)
+(test (+ (catch #t (lambda () (values 3 4)) (lambda args (values 1 2 3)))) 7)
+
(test (catch) 'error)
(test (catch s7-version) 'error)
(test (catch #t s7-version) 'error)
(test (catch #t s7-version + +) 'error)
+(let ()
+ (define* (f1 a) a)
+ (define (f2 . args) args)
+ (define* (f3) 1)
+ (define* (f4 (a 1) (b 2)) a)
+ (test (catch #t s7-version f2) (s7-version))
+ (test (catch #t f1 f2) #f)
+ (test (catch #t f3 f2) 1)
+ (test (catch #t f4 f2) 1)
+ (define (f5 a) a)
+ (test (catch #t f5 (lambda args 'local-error)) 'local-error))
+
+(test (let () (define-macro (m) `(+ 1 2)) (catch #t m (lambda any any))) 3)
+;(test (let () (define-macro (m) `(define __asdf__ 3)) (catch #t m (lambda any "__asdf__ must be a constant?"))) '__asdf__) ;25-Jul-14
+(test (let () (define-macro* (m (a 1) (b 2)) `(define __asdf__ (+ ,a ,b))) (catch #t m (lambda any any)) __asdf__) 3)
+;;; so this is useful where we want to call a macro that defines something in the current environment,
+;;; but might hit some error that we want to catch.
+(test (let () (define-macro (m . args) `(display ,args)) (catch #t (lambda () #f) m)) #f)
+(test (let () (define-macro (m . args) (apply (car args) (cadr args))) (catch #t (lambda () (error abs -1)) m)) 1)
+(test (let () (define-macro (m . args) `(apply ,(car args) ',(cadr args))) (catch #t (lambda () (error abs -1)) m)) 1)
+
+;;; throw
+(define (catch-test sym)
+ (let ((errs ()))
+ (catch 'a1
+ (lambda ()
+ (catch 'a2
+ (lambda ()
+ (catch 'a3
+ (lambda ()
+ (catch 'a4
+ (lambda ()
+ (throw sym "hit error!"))
+ (lambda args
+ (set! errs (cons 'a4 errs))
+ 'a4)))
+ (lambda args
+ (set! errs (cons 'a3 errs))
+ 'a3)))
+ (lambda args
+ (set! errs (cons 'a2 errs))
+ 'a2)))
+ (lambda args
+ (set! errs (cons 'a1 errs))
+ 'a1))
+ errs))
+
+(test (catch-test 'a1) '(a1))
+(test (catch-test 'a2) '(a2))
+(test (catch-test 'a3) '(a3))
+(test (catch-test 'a4) '(a4))
+
+(define (catch-test-1 sym)
+ (let ((errs ()))
+ (catch 'a1
+ (lambda ()
+ (catch 'a2
+ (lambda ()
+ (catch 'a3
+ (lambda ()
+ (catch 'a4
+ (lambda ()
+ (throw sym "hit error!"))
+ (lambda args
+ (set! errs (cons 'a4 errs))
+ (throw 'a3)
+ 'a4)))
+ (lambda args
+ (set! errs (cons 'a3 errs))
+ (throw 'a2)
+ 'a3)))
+ (lambda args
+ (set! errs (cons 'a2 errs))
+ (throw 'a1)
+ 'a2)))
+ (lambda args
+ (set! errs (cons 'a1 errs))
+ 'a1))
+ errs))
+
+(test (catch-test-1 'a1) '(a1))
+(test (catch-test-1 'a2) '(a1 a2))
+(test (catch-test-1 'a3) '(a1 a2 a3))
+(test (catch-test-1 'a4) '(a1 a2 a3 a4))
+(test (catch #t (catch #t (lambda () (throw 'oops)) (lambda args (lambda () 1))) (lambda args 'error)) 1)
+(test ((catch #t (lambda () (throw 'oops)) (lambda args (lambda () 1)))) 1)
+(test ((catch #t (lambda () (throw 'oops)) (catch #t (lambda () (lambda args (lambda () 1))) (lambda args 'error)))) 1)
+(test (catch #t (lambda () (catch '#t (lambda () (throw '#t)) (lambda args 1))) (lambda args 2)) 1)
+(test (catch #t (lambda () (catch "hi" (lambda () (throw "hi")) (lambda args 1))) (lambda args 2)) 2) ; guile agrees with this
+(test (let ((str (list 1 2))) (catch #t (lambda () (catch str (lambda () (throw str)) (lambda args 1))) (lambda args 2))) 1)
+
+(test (throw) 'error)
+(test (catch #f (lambda () (throw #f 1 2 3)) (lambda args (cadr args))) '(1 2 3))
+
+(for-each
+ (lambda (arg)
+ (catch #t
+ (lambda ()
+ (test (catch arg
+ (lambda ()
+ (throw arg 1 2 3))
+ (lambda args (cadr args)))
+ '(1 2 3)))
+ (lambda args
+ (format-logged #t "~A not caught~%" (car args)))))
+ (list #\a 'a-symbol #f #t abs #<unspecified>))
+
+(test (let ((e #f))
+ (catch #t
+ (lambda ()
+ (catch #t
+ (lambda () (+ 1 "asdf"))
+ (lambda args (set! e (let->list (owlet))))))
+ (lambda args #f)) (equal? e (let->list (owlet)))) #t)
+
+(let ((e 1))
+ (catch #t
+ (lambda ()
+ (catch #t
+ (lambda ()
+ (error 'an-error "an-error"))
+ (lambda args
+ (set! e (let->list (owlet)))))
+ (throw #t "not an error"))
+ (lambda args
+ #f))
+ (test (equal? e (let->list (owlet))) #t))
+
+(let ()
+ (define (t1 x)
+ (catch #t
+ (lambda ()
+ (throw x))
+ (lambda args (car args))))
+ (define (tt)
+ (do ((i 0 (+ i 1)))
+ ((= i 100) i)
+ (t1 'a)))
+ (test (tt) 100))
+
+
+
+
+;;; --------------------------------------------------------------------------------
;;; error
(test (catch #t (lambda () (error 'oops 1)) (let () (lambda args (caadr args)))) 1)
@@ -17174,13 +29295,13 @@ abs 1 2
(test (catch #t (let ((x 2)) (lambda () (error 'oops x))) (let ((x 3)) (lambda args (+ x (caadr args))))) 5)
(test (catch #t (let ((x 2)) ((lambda () (lambda () (error 'oops x))))) (let ((x 3)) (lambda args (+ x (caadr args))))) 5)
-(test (let ((pws (make-procedure-with-setter (lambda () (+ 1 2)) (lambda (a) (+ a 2)))))
+(test (let ((pws (dilambda (lambda () (+ 1 2)) (lambda (a) (+ a 2)))))
(catch #t pws (lambda (tag type) tag)))
3)
-(test (let ((pws (make-procedure-with-setter (lambda () (error 'pws 3) 4) (lambda (a) (+ a 2)))))
+(test (let ((pws (dilambda (lambda () (error 'pws 3) 4) (lambda (a) (+ a 2)))))
(catch #t pws (lambda (tag type) tag)))
'pws)
-(test (let ((pws (make-procedure-with-setter (lambda (a b) a) (lambda (a b) (+ a 2)))))
+(test (let ((pws (dilambda (lambda (a b) a) (lambda (a b) (+ a 2)))))
(catch #t (lambda () (error 'pws-error 3)) pws))
'pws-error)
@@ -17188,33 +29309,33 @@ abs 1 2
(lambda (tag)
(let ((val (catch tag (lambda () (error tag "an error") 123) (lambda args (car args)))))
(if (not (equal? tag val))
- (format #t ";catch ~A -> ~A~%" tag val))))
- (list :hi '() #() #<eof> #f #t #<unspecified> car #\a 32 9/2))
+ (format-logged #t ";catch ~A -> ~A~%" tag val))))
+ (list :hi () #() #<eof> #f #t #<unspecified> car #\a 32 9/2))
(for-each
(lambda (tag)
(let ((val (catch #t (lambda () (error tag "an error") 123) (lambda args (car args)))))
(if (not (equal? tag val))
- (format #t ";catch #t (~A) -> ~A~%" tag val))))
- (list :hi '() #<eof> #f #t #<unspecified> car #\a 32 9/2 '(1 2 3) '(1 . 2) #(1 2 3) #()))
+ (format-logged #t ";catch #t (~A) -> ~A~%" tag val))))
+ (list :hi () #<eof> #f #t #<unspecified> car #\a 32 9/2 '(1 2 3) '(1 . 2) #(1 2 3) #()))
(for-each
(lambda (tag)
- (test (catch #t tag (lambda args (car args))) 'error)
+ (test (catch #t tag (lambda args 'local-error)) 'local-error)
(test (catch #t (lambda () #f) tag) 'error))
- (list :hi '() #<eof> #f #t #<unspecified> #\a 32 9/2 '(1 2 3) '(1 . 2) #(1 2 3) #()))
+ (list :hi () #<eof> #f #t #<unspecified> #\a 32 9/2)) ;'(1 2 3) '(1 . 2) #(1 2 3) #()
;; (error <string>...) throws 'no-catch which makes it harder to check
(let ((val (catch #t (lambda () (error "hi") 123) (lambda args (car args)))))
(if (not (eq? val 'no-catch))
- (format #t ";catch #t, tag is string -> ~A~%" val)))
+ (format-logged #t ";catch #t, tag is string -> ~A~%" val)))
(for-each
(lambda (tag)
(let ((val (catch tag (lambda () (error #t "an error") 123) (lambda args (car args)))))
(if (not (equal? #t val))
- (format #t ";catch ~A -> ~A (#t)~%" tag val))))
- (list :hi '() #<eof> #f #t #<unspecified> car #\a 32 9/2))
+ (format-logged #t ";catch ~A -> ~A (#t)~%" tag val))))
+ (list :hi () #<eof> #f #t #<unspecified> car #\a 32 9/2))
(let ((tag 'tag)) (test (catch (let () tag) (lambda () (set! tag 123) (error 'tag "tag") tag) (lambda args (car args))) 'tag))
@@ -17278,6 +29399,41 @@ abs 1 2
3)
+(test (error) 'error)
+(test (let ((x 1))
+ (let ((val (catch #\a
+ (lambda ()
+ (set! x 0)
+ (error #\a "an error")
+ (set! x 2))
+ (lambda args
+ (if (equal? (car args) #\a)
+ (set! x (+ x 3)))
+ x))))
+ (= x val 3)))
+ #t)
+(test (let ((x 1))
+ (let ((val (catch 32
+ (lambda ()
+ (catch #\a
+ (lambda ()
+ (set! x 0)
+ (error #\a "an error: ~A" (error 32 "another error!"))
+ (set! x 2))
+ (lambda args
+ (if (equal? (car args) #\a)
+ (set! x (+ x 3)))
+ x)))
+ (lambda args
+ (if (equal? (car args) 32)
+ (set! x (+ x 30)))))))
+ (= x val 30)))
+ #t)
+
+
+
+
+
;;; --------------------------------------------------------------------------------
(define (last-pair l) ; needed also by loop below
@@ -17300,7 +29456,7 @@ abs 1 2
`(let ((body (lambda (,label) , at forms))
(tag (gensym "return-")))
(catch tag
- (lambda () (body (lambda (val) (error tag val))))
+ (lambda () (body (lambda (val) (throw tag val))))
(lambda (tag val) val))))
;; (with-return FORMS...)
@@ -17326,8 +29482,8 @@ abs 1 2
(let ((start-tag (gensym "start-"))
(block-tag (gensym "block-")))
(let loop ((cur-tag start-tag)
- (cur-code '())
- (tags-and-code '())
+ (cur-code ())
+ (tags-and-code ())
(forms forms))
(cond
((null? forms)
@@ -17366,2567 +29522,4449 @@ abs 1 2
(let ((val (first_even '(1 3 5 6 7 8 9))))
(if (not (equal? val (list 6)))
- (format #t "first_even (tagbody, gensym, reverse!) (6): '~A~%" val)))
-
- (let ((hi (lambda* (a) a)))
- (test (hi 1) 1)
- (test (hi) #f) ; all args are optional
- (test (hi :a 32) 32) ; all args are keywords
- (test (hi 1 2) 'error) ; extra args
-
- (for-each
- (lambda (arg)
- (test (hi arg) arg)
- (test (hi :a arg) arg))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2)))
-
- (test (hi :b 1) 'error))
-
- (let ((hi (lambda* ((a 1)) a)))
- (test (hi 2) 2)
- (test (hi) 1)
- (test (hi :a 2) 2)
-
- (for-each
- (lambda (arg)
- (test (hi arg) arg)
- (test (hi :a arg) arg))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2))))
-
- (let ((hi (lambda* (a (b "hi")) (list a b))))
- (test (hi) (list #f "hi"))
- (test (hi 1) (list 1 "hi"))
- (test (hi 1 2) (list 1 2))
- (test (hi :b 1) (list #f 1))
- (test (hi :a 1) (list 1 "hi"))
- (test (hi 1 :b 2) (list 1 2))
- (test (hi :b 3 :a 1) (list 1 3))
- (test (hi :a 3 :b 1) (list 3 1))
- (test (hi 1 :a 3) 'error)
- (test (hi 1 2 :a 3) 'error) ; trailing (extra) args
- (test (hi :a 2 :c 1) 'error)
- (test (hi 1 :c 2) 'error)
-
- (for-each
- (lambda (arg)
- (test (hi :a 1 :b arg) (list 1 arg))
- (test (hi :a arg) (list arg "hi"))
- (test (hi :b arg) (list #f arg))
- (test (hi arg arg) (list arg arg)))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2))))
-
- (let ((hi (lambda* (a :key (b 3) :optional c) (list a b c))))
- (test (hi) (list #f 3 #f))
- (test (hi 1) (list 1 3 #f))
- (test (hi :c 32) (list #f 3 32))
- (test (hi :c 32 :b 43 :a 54) (list 54 43 32))
- (test (hi 1 2 3) (list 1 2 3))
- (test (hi :b 32) (list #f 32 #f))
- (test (hi 1 2 :c 32) (list 1 2 32)))
-
- (let ((hi (lambda* (a :rest b) (list a b))))
- (test (hi 1 2 3) (list 1 (list 2 3)))
- (test (hi) (list #f ()))
- (test (hi :a 2) (list 2 '()))
- (test (hi :b 3) (list #f 3)))
-
- (let ((hi (lambda* (a :rest b :rest c) (list a b c))))
- (test (hi 1 2 3 4 5) (list 1 (list 2 3 4 5) (list 3 4 5))))
-
- (let ((hi (lambda* ((a 3) :key (b #t) :optional (c pi) :rest d) (list a b c d))))
- (test (hi) (list 3 #t pi ()))
- (test (hi 1 2 3 4) (list 1 2 3 (list 4))))
-
- (let ((hi (lambda* ((a 'hi)) (equal? a 'hi))))
- (test (hi) #t)
- (test (hi 1) #f)
- (test (hi 'hi) #t)
- (test (hi :a 1) #f))
-
- (let* ((x 32)
- (hi (lambda* (a (b x)) (list a b))))
- (test (hi) (list #f 32))
- (test (hi :a 1) (list 1 32)))
-
- (let ((hi (lambda* (a . b) (list a b))))
- (test (hi 1 2 3) (list 1 (list 2 3)))
- (test (hi) (list #f ()))
- (test (hi :a 2) (list 2 '()))
- (test (hi :b 3) (list #f 3)))
-
- (let ((hi (lambda* ((a 0.0) :optional (b 0.0)) (+ a b))))
- (num-test (hi 1.0) 1.0)
- (num-test (hi 1.0 2.0) 3.0)
- (num-test (hi) 0.0)
- (num-test (+ (hi) (hi 1.0) (hi 1.0 2.0)) 4.0)
- (num-test (+ (hi 1.0) (hi) (hi 1.0 2.0)) 4.0)
- (num-test (+ (hi 1.0) (hi 1.0 2.0) (hi)) 4.0)
- (num-test (+ (hi 1.0 2.0) (hi) (hi 1.0)) 4.0))
-
- (test (let ((hi (lambda*))) (hi)) 'error)
- (test (let ((hi (lambda* #f))) (hi)) 'error)
- (test (let ((hi (lambda* "hi" #f))) (hi)) 'error)
- (test (let ((hi (lambda* ("hi") #f))) (hi)) 'error)
- (test (let ((hi (lambda* (a 0.0) a))) (hi)) 'error)
- (test (let ((hi (lambda* (a . 0.0) a))) (hi)) 'error)
- (test (let ((hi (lambda* ((a . 0.0)) a))) (hi)) 'error)
- (test (let ((hi (lambda* ((a 0.0 "hi")) a))) (hi)) 'error)
- (test (let ((hi (lambda* ((a 0.0 . "hi")) a))) (hi)) 'error)
- (test (let ((hi (lambda* ((a)) a))) (hi)) 'error)
- (test (let ((hi (lambda* (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error)
-
- (test (let () (define* (hi) 0) (hi)) 0)
- (test (let () (define* (hi a . b) b) (hi 1 2 3)) '(2 3))
- (test (let () (define* (hi a . b) b) (hi :a 1 2 3)) '(2 3))
- (test (let () (define* (hi a . b) b) (hi 1)) '())
- (test (let () (define* (hi a . b) b) (hi :a 1)) '())
- (test (let () (define* (hi a . b) b) (hi)) '())
-
- (test (let () (define* (hi a :rest b) b) (hi 1 2 3)) '(2 3))
- (test (let () (define* (hi a :rest b) b) (hi :a 1 2 3)) '(2 3))
- (test (let () (define* (hi a :rest b) b) (hi 1)) '())
- (test (let () (define* (hi a :rest b) b) (hi :a 1)) '())
- (test (let () (define* (hi a :rest b) b) (hi)) '())
-
- (test (let () (define* (hi :key a :rest b) b) (hi 1 2 3)) '(2 3))
- (test (let () (define* (hi :key a :rest b) b) (hi :a 1 2 3)) '(2 3))
- (test (let () (define* (hi :key a :rest b) b) (hi 1)) '())
- (test (let () (define* (hi :key a :rest b) b) (hi :a 1)) '())
- (test (let () (define* (hi :key a :rest b) b) (hi)) '())
-
- (test (let () (define* (hi :optional a :rest b) b) (hi 1 2 3)) '(2 3))
- (test (let () (define* (hi :optional a :rest b) b) (hi :a 1 2 3)) '(2 3))
- (test (let () (define* (hi :optional a :rest b) b) (hi 1)) '())
- (test (let () (define* (hi :optional a :rest b) b) (hi :a 1)) '())
- (test (let () (define* (hi :optional a :rest b) b) (hi)) '())
-
- (test (let () (define* (hi (a 1) . b) b) (hi 1 2 3)) '(2 3))
- (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi)) '(#f 22 ()))
- (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :a 1)) '(1 22 ()))
- (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1)) '(#f 1 ()))
- (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :c 1)) '(#f 22 1))
- (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :a 1 2)) '(1 2 ()))
- (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1 2 3)) 'error) ; b set twice
- (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :c 1 2 3)) '(#f 2 (3)))
- (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1 :a 2 3)) '(2 1 (3)))
-
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi)) 1)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :b :a :a 3)) 3)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :b 3)) 1)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 3)) 3)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi a: 3)) 3)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3)) 3)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3 :b 2)) 3)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) 3)
- (test (let () (define* (hi (a 1) :optional :key :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) 3)
- (test (let () (define* (hi :optional :key :rest a :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) '(:c 1 :a 3 :b 2))
-
- (test (let () (define* (hi :optional (a 1) :optional (b 2)) a)) 'error)
- (test (let () (define* (hi :optional :optional (a 2)) a) (hi 21)) 'error)
- (test (let () (define* (hi optional: (a 1)) a) (hi 1)) 'error)
- (test (let () (define* (hi :optional: (a 1)) a) (hi 1)) 'error)
- (test (let () (define* (hi :key (a 1) :key (b 2)) a)) 'error)
- (test (let () (define* (hi :key (a 1) :optional (b 2) :allow-other-keys :allow-other-keys) a)) 'error)
- (test (let () (define* (hi :optional (a 1) :key :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) 3)
- (test (let () (define* (hi :key :optional :allow-other-keys) 1) (hi :c 1 :a 3 :b 2)) 1)
- (test (let () (define* (hi :key :optional :allow-other-keys) 1) (hi)) 1)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) 'error)
- (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 2 32)) 'error)
-
- (test (let () (define* (hi (a 1) :rest c :allow-other-keys) (list a c)) (hi :a 3 :b 2)) '(3 (:b 2)))
- (test (let () (define* (hi (a 1) :rest c) (list a c)) (hi :a 3 :b 2)) '(3 (:b 2)))
-
- (test (let () (define* (hi (a 1) (b 2) :allow-other-keys) (list a b)) (hi :c 21 :b 2)) '(1 2))
- (test (let () (define hi (lambda* ((a 1) (b 2) :allow-other-keys) (list a b))) (hi :c 21 :b 2)) '(1 2))
- (test (let () (define-macro* (hi (a 1) (b 2) :allow-other-keys) `(list ,a ,b)) (hi :c 21 :b 2)) '(1 2))
-
- (test (let () (define* (f (a :b)) a) (list (f) (f 1) (f :c) (f :a :c) (f :a 1) (f))) '(:b 1 :c :c 1 :b))
- (test (let () (define* (f a (b :c)) b) (f :b 1 :d)) 'error)
-
- ;; some of these are questionable
- (test ((lambda* ((x (lambda () 1))) (x))) 1)
- (test ((lambda* ((x x) else) (+ x else)) 1 2) 3)
- (test (symbol? ((lambda* ((y y)) y))) #t)
- (test (symbol? ((lambda* ((y y) :key) y))) #t)
- (test (procedure-arity (lambda* ((a 1) :allow-other-keys) a)) '(0 1 #f))
- (test (procedure-arity (lambda* (:allow-other-keys) 34)) '(0 0 #f))
- (test ((lambda* (:allow-other-keys) 34) :a 32) 34)
- (test (procedure-arity (lambda* ((a 1) :rest b :allow-other-keys) a)) '(0 1 #t))
- (test ((lambda* ((y x) =>) (list y =>)) 1 2) '(1 2))
- (test ((lambda* (=> (y x)) (list y =>)) 1) '(x 1))
- (test ((lambda* ((y #2D((1 2) (3 4)))) (y 1 0))) 3)
- (test ((lambda* ((y (symbol "#(1 #\\a (3))")) x) -1)) -1)
- (test ((lambda* ((y (symbol "#(1 #\\a (3))")) x) y)) (symbol "#(1 #\\a (3))"))
- (test ((lambda* ((y #(1 #\a (3)))) (y 0))) 1)
- (test ((lambda* ((y ()) ()) y)) 'error)
- (test ((lambda* ((y ()) (x)) y)) 'error)
- (test ((lambda* ((=> "") else) else) else) #f)
- (test ((lambda* (x (y x)) y) 1) #f)
- (test ((lambda* (x (y x)) (let ((x 32)) y)) 1) #f)
- (test ((lambda* ((x 1) (y x)) y)) 1)
- (test ((lambda* ((x 1) (y (+ x 1))) y)) 2)
- (test ((lambda* ((x y) (y x)) y)) 'y) ; I'd expect unbound variable or something here
- (test (let ((z 2)) ((lambda* ((x z) (y x)) y))) 2) ; hmmm
- (test (keyword? ((lambda* ((x :-)) x))) #t)
- (test ((lambda* ((- 0)) -) :- 1) 1)
- (test ((apply lambda* (list (list (list (string->symbol "a") 1)) (string->symbol "a"))) (symbol->keyword (string->symbol "a")) 3) 3)
- (test ((lambda* (:allow-other-keys) 1) :a 321) 1)
- (test ((lambda* (:rest (a 1)) a)) 'error)
- (test ((lambda* (:rest a) a)) '())
- (test ((lambda* (:rest (a 1)) 1)) 'error)
- (test (let ((b 2)) ((lambda* (:rest (a (let () (set! b 3) 4))) b))) 'error)
- (test (let ((b 2)) ((lambda* ((a (let () (set! b 3) 4))) b))) 3)
- (test ((lambda* (:rest hi :allow-other-keys (x x)) x)) 'error)
- (test ((lambda* (:rest x y) (list x y)) 1 2 3) '((1 2 3) 2))
- (test ((lambda* (:rest '((1 2) (3 4)) :rest (y 1)) 1)) 'error)
- (test ((lambda* (:rest (list (quote (1 2) (3 4))) :rest (y 1)) 1)) 'error)
- (test ((lambda* ((x ((list 1 2) 1))) x)) 2)
- (test ((lambda* ((y ("hi" 0))) y)) #\h)
- (test ((lambda* ((x ((lambda* ((x 1)) x)))) x)) 1)
- (test ((lambda* (:rest) 3)) 'error)
- (test ((lambda* (:rest 1) 3)) 'error)
- (test ((lambda* (:rest :rest) 3)) 'error)
- (test ((lambda* (:rest :key) 3)) 'error)
- (test ((lambda* ((: 1)) :)) 1)
- (test ((lambda* ((: 1)) :) :: 21) 21)
- (test ((lambda* ((a 1)) a) a: 21) 21)
- (test ((lambda* ((a 1)) a) :a: 21) 'error)
- (test (let ((func (let ((a 3)) (lambda* ((b (+ a 1))) b)))) (let ((a 21)) (func))) 4)
- (test (let ((a 21)) (let ((func (lambda* ((b (+ a 1))) b))) (let ((a 3)) (func)))) 22)
- (test (let ((a 21)) (begin (define-macro* (func (b (+ a 1))) b) (let ((a 3)) (func)))) 4)
- (test ((lambda* (:rest x :allow-other-keys y) x) 1) 'error)
- (test ((lambda* (:allow-other-keys x) x) 1) 'error)
- (test ((lambda* (:allow-other-keys . x) x) 1 2) 'error)
- (test ((lambda* (:optional . y) y) 1 2 3) '(1 2 3))
- (test ((lambda* (:optional . y) y)) '())
- (test ((lambda* (:rest . (x)) x) 1 2) '(1 2))
- (test ((lambda* (:rest . (x 1)) x) 1 2) 'error)
- (test ((lambda* (:rest . (x)) x)) '())
- (test ((lambda* (:optional . (x)) x) 1) 1)
- (test ((lambda* (:optional . (x 1)) x) 1) 'error)
- (test ((lambda* (:optional . (x)) x)) #f)
- (test ((lambda* (:optional . (x)) x) 1 2) 'error)
- (test ((lambda* (x :key) x) 1) 1)
- (test ((lambda* (:key :optional :rest x :allow-other-keys) x) 1) '(1))
- (test (lambda* (key: x) x) 'error)
- (test (lambda* (:key: x) x) 'error)
- (test ((lambda* x x) 1) '(1))
- (test (lambda* (((x) 1)) x) 'error)
- (test ((lambda* ((a: 3)) a:) :a: 4) 'error)
- (test ((lambda* ((a 3)) a) a: 4) 4)
-
- ;; not sure the next 4 aren't errors
- (test ((lambda* (:key . x) x) :x 1) '(:x 1))
- (test ((lambda* (:key . x) x)) '())
- (test ((lambda* (:optional . y) y) :y 1) '(:y 1))
- (test ((lambda* (:rest a b c) (list a b c)) 1 2 3 4) '((1 2 3 4) 2 3))
-
- (test (let ((x 3)) (define* (f (x x)) x) (let ((x 32)) (f))) 3)
- (test (let ((x 3)) (define-macro* (f (x x)) `,x) (let ((x 32)) (f))) 32)
-
- (test (let () (define (x x) x) (x 1)) 1)
- (test (procedure? (let () (define* (x (x #t)) x) (x x))) #t)
- (test (procedure? (let () (define* (x (x x)) x) (x (x x)))) #t)
- (test (procedure? (let () (define* (x (x x)) x) (x))) #t)
- (test (apply + ((lambda* ((x (values 1 2 3))) x))) 6)
- (test ((lambda* ((x (lambda* ((y (+ 1 2))) y))) (x))) 3)
- ;; (let () (define* (x (x (x))) :optional) (x (x x))) -> segfault infinite loop in prepare_closure_star
+ (format-logged #t "first_even (tagbody, gensym, reverse!) (6): '~A~%" val)))
+ )
- ;;; define-macro
- ;;; define-macro*
- ;;; define-bacro
- ;;; define-bacro*
+#|
+so prog is something like (define-macro (prog vars . body) `(with-return (tagbody (let ,vars , at body))))
+or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (tagbody (let ,vars , at body)))))
+|#
- (test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ 1 ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((1 0) 0))
- (test (let ((x 0)) (define-bacro* (hi (a (let () (set! x (+ x 1)) x))) `(+ 1 ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((1 0) 0))
- (test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ x ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((-1 0) 0))
- (test (let ((x 0)) (define-bacro* (hi (a (let () (set! x (+ x 1)) x))) `(+ x ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((-1 0) 0))
-
- (test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(let ((x -1)) (+ x ,a))) (list (hi) x)) '(-1 0))
- (test (let ((x 0)) (let ((x -1)) (+ x (let () (set! x (+ x 1)) x)))) -1)
- (test (let ((x 0)) (define-macro (hi a) `(let ((x -1)) (+ x ,a))) (list (hi (let () (set! x (+ x 1)) x)) x)) '(-1 0))
- (test (let () (define-macro (hi a) `(let ((b 1)) (+ ,a b))) (hi (+ 1 b))) 3)
- (test (let ((b 321)) (define-macro (hi a) `(let ((b 1)) (+ ,a b))) (hi b)) 2)
- (test (let ((b 321)) (define-macro* (hi (a b)) `(let ((b 1)) (+ ,a b))) (hi b)) 2)
- (test (let ((b 321)) (define-macro* (hi (a b)) `(let ((b 1)) (+ ,a b))) (hi)) 2) ; ???
- (test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ ,a ,a)) (hi)) 3) ; ??? -- default val is substituted directly
- ;; but (let () (define-macro* (hi a (b a)) `(+ ,a ,b)) (hi 1)) -> "a: unbound variable" -- "a" itself is substituted, but does not exist at expansion(?)
-
- ;; can we implement bacros via define-macro* default args?
- ;; I don't think so -- macro arguments can't be evaluated in that environment because
- ;; only the default values have been set (on the previous parameters).
-
- ;; bacro ignores closure in expansion but macro does not:
- (test (let ((x 1)) (define-macro (ho a) `(+ ,x ,a)) (let ((x 32)) (ho 3))) 4)
- (test (let ((x 1)) (define-macro (ho a) `(+ x ,a)) (let ((x 32)) (ho 3))) 35)
- (test (let ((x 1)) (define-bacro (ho a) `(+ ,x ,a)) (let ((x 32)) (ho 3))) 35)
- (test (let ((x 1)) (define-bacro (ho a) `(+ x ,a)) (let ((x 32)) (ho 3))) 35)
-
- (test (let ((x 1)) (define-macro* (ho (a x)) `(+ ,x ,a)) (let ((x 32)) (ho))) 33)
- (test (let ((x 1)) (define-macro* (ho (a x)) `(+ x ,a)) (let ((x 32)) (ho))) 64)
- (test (let ((x 1)) (define-bacro* (ho (a x)) `(+ x ,a)) (let ((x 32)) (ho))) 64)
- (test (let ((x 1)) (define-bacro* (ho (a x)) `(+ ,x ,a)) (let ((x 32)) (ho))) 64)
-
- (test (let ((x 1)) (define-macro* (ho (a (+ x 0))) `(+ ,x ,a)) (let ((x 32)) (ho))) 33) ;; (+ 32 (+ x 0)) !?! macroexpand is confusing?
- (test (let ((x 1)) (define-macro* (ho (a (+ x 0))) `(+ x ,a)) (let ((x 32)) (ho))) 64) ;; (+ x (+ x 0))
- (test (let ((x 1)) (define-bacro* (ho (a (+ x 0))) `(+ x ,a)) (let ((x 32)) (ho))) 64 )
- (test (let ((x 1)) (define-bacro* (ho (a (+ x 0))) `(+ ,x ,a)) (let ((x 32)) (ho))) 64 )
-
- (test (let () (define-macro* (hi :rest a) `(list , at a)) (hi)) '())
- (test (let () (define-macro* (hi :rest a) `(list , at a)) (hi 1)) '(1))
- (test (let () (define-macro* (hi :rest a) `(list , at a)) (hi 1 2 3)) '(1 2 3))
- (test (let () (define-macro* (hi a :rest b) `(list ,a , at b)) (hi 1 2 3)) '(1 2 3))
- (test (let () (define-macro* (hi (a 1) :rest b) `(list ,a , at b)) (hi)) '(1))
- (test (let () (define-macro* (hi (a 1) :rest b) `(list ,a , at b)) (hi 2)) '(2))
- (test (let () (define-macro* (hi (a 1) :rest b) `(list ,a , at b)) (hi :a 2)) '(2))
- (test (let () (define-macro* (hi (a 1) :rest b :allow-other-keys) `(list ,a , at b)) (hi :a 2 :b 3)) '(2 :b 3))
-
- (test ((lambda* ((a 1) :allow-other-keys) a) :b 1 :a 3) 3)
- (test (let () (define-macro* (hi (a 1) :allow-other-keys) `(list ,a)) (hi :b 2 :a 3)) '(3))
- (test ((lambda* ((a 1) :rest b :allow-other-keys) b) :c 1 :a 3) '())
- (test ((lambda* ((a 1) :rest b :allow-other-keys) b) :b 1 :a 3) 'error)
- ;; that is the rest arg is not settable via a keyword and it's an error to try to
- ;; do so, even if :allow-other-keys -- ??
-
- (test (let ((x 1)) (define* (hi (a x)) a) (let ((x 32)) (hi))) 1)
- (test (let ((x 1)) (define* (hi (a (+ x 0))) a) (let ((x 32)) (hi))) 1)
- (test (let ((x 1)) (define* (hi (a (+ x "hi"))) a) (let ((x 32)) (hi))) 'error)
- (test (let ((x 1)) (define-macro* (ho (a (+ x "hi"))) `(+ x ,a)) (let ((x 32)) (ho))) 'error)
-
- ;; define-macro* default arg expr does not see definition-time closure:
- (test (let ((mac #f))
- (let ((a 32))
- (define-macro* (hi (b (+ a 1))) `(+ ,b 2))
- (set! mac hi))
- (mac))
- 'error) ; ";a: unbound variable, line 4"
-
- (test ((lambda* ((x (let ()
- (define-macro (hi a)
- `(+ ,a 1))
- (hi 2))))
- (+ x 1)))
- 4)
- (test (let ()
- (define-macro* (hi (x (let ()
- (define-macro (hi a)
- `(+ ,a 1))
- (hi 2))))
- `(+ ,x 1))
- (hi))
- 4)
- (test (let () (define* (hi b) b) (procedure? hi)) #t)
-
- (test (let ()
- (define (hi a) a)
- (let ((tag (catch #t
- (lambda () (hi 1 2 3))
- (lambda args (car args)))))
- (eq? tag 'wrong-number-of-args)))
- #t)
+
+;;; --------------------------------------------------------------------------------
+;;; define*
+;;; lambda*
+
+(let ((hi (lambda* (a) a)))
+ (test (hi 1) 1)
+ (test (hi) #f) ; all args are optional
+ (test (hi :a 32) 32) ; all args are keywords
+ (test (hi 1 2) 'error) ; extra args
- (test (let ()
- (define (hi a) a)
- (let ((tag (catch #t
- (lambda () (hi))
- (lambda args (car args)))))
- (eq? tag 'wrong-number-of-args)))
- #t)
+ (for-each
+ (lambda (arg)
+ (test (hi arg) arg)
+ (test (hi :a arg) arg))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2)))
- (test (let ()
- (define* (hi a) a)
- (let ((tag (catch #t
- (lambda () (hi 1 2 3))
- (lambda args (car args)))))
- (eq? tag 'wrong-number-of-args)))
- #t)
+ (test (hi :b 1) 'error))
- (test (let () (define (hi :a) :a) (hi 1)) 'error)
- (test (let () (define* (hi :a) :a) (hi 1)) 'error)
- (test (let () (define* (hi (:a 2)) a) (hi 1)) 'error)
- (test (let () (define* (hi (a 1) (:a 2)) a) (hi 1)) 'error)
- (test (let () (define* (hi (pi 1)) pi) (hi 2)) 'error)
- (test (let () (define* (hi (:b 1) (:a 2)) a) (hi)) 'error)
-
- (test (let () (define* (hi (a 1) (a 2)) a) (hi 2)) 'error)
- (test (let () (define (hi a a) a) (hi 1 2)) 'error)
- (test (let () (define hi (lambda (a a) a)) (hi 1 1)) 'error)
- (test (let () (define hi (lambda* ((a 1) (a 2)) a)) (hi 1 2)) 'error)
- (test (let () (define (hi (a 1)) a) (hi 1)) 'error)
-
- (let ()
- (define* (hi (a #2d((1 2) (3 4)))) (a 1 0))
- (test (hi) 3)
- (test (hi #2d((7 8) (9 10))) 9))
-
- (let () (define* (f :rest a) a) (test (f :a 1) '(:a 1)))
- (let () (define* (f :rest a :rest b) (list a b)) (test (f :a 1 :b 2) '((:a 1 :b 2) (1 :b 2))))
-
- (test (lambda :hi 1) 'error)
- (test (lambda (:hi) 1) 'error)
- (test (lambda (:hi . :hi) 1) 'error)
- (test (lambda (i . i) 1 . 2) 'error)
- (test (lambda (i i i i) (i)) 'error)
- (test (lambda "hi" 1) 'error)
- (test (lambda* ((i 1) i i) i) 'error)
- (test (lambda* ((a 1 2)) a) 'error)
- (test (lambda* ((a . 1)) a) 'error)
- (test (lambda* ((0.0 1)) 0.0) 'error)
-
- (test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32) '(32 1 ()))
- (test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5) '(1 3 (2 3 4 5)))
- ;; these are in s7.html
- (test ((lambda* ((a 1) :rest b :rest c) (list a b c)) 1 2 3 4 5) '(1 (2 3 4 5) (3 4 5)))
-
- (test (let () (define-macro (hi a a) `(+ ,a 1)) (hi 1 2)) 'error)
-
- ;;; procedure-arity
- (test (procedure-arity car) '(1 0 #f))
- (test (procedure-arity 'car) '(1 0 #f))
- (test (procedure-arity +) '(0 0 #t))
- (test (procedure-arity '+) '(0 0 #t))
- (test (procedure-arity log) '(1 1 #f))
- (test (procedure-arity '/) '(1 0 #t))
- (test (procedure-arity catch) '(3 0 #f))
- (test (procedure-arity) 'error)
- (test (procedure-arity abs abs) 'error)
- (test (procedure-arity "hi") 'error)
- (test (let () (set! (car (procedure-arity abs)) 0) (procedure-arity abs)) '(1 0 #f))
-
- (test (procedure-arity vector-set!) '(3 0 #t))
- (test (let ((hi (lambda () 1))) (procedure-arity hi)) '(0 0 #f))
- (test (let ((hi (lambda (a) 1))) (procedure-arity hi)) '(1 0 #f))
- (test (let ((hi (lambda (a b) 1))) (procedure-arity hi)) '(2 0 #f))
- (test (let ((hi (lambda (a . b) 1))) (procedure-arity hi)) '(1 0 #t))
- (test (let ((hi (lambda a 1))) (procedure-arity hi)) '(0 0 #t))
-
- (test (let () (define (hi) 1) (procedure-arity hi)) '(0 0 #f))
- (test (let () (define (hi a) a) (procedure-arity hi)) '(1 0 #f))
- (test (let () (define* (hi a) a) (procedure-arity hi)) '(0 1 #f))
- (test (let () (define* (hi a . b) a) (procedure-arity hi)) '(0 1 #t))
- (test (let () (define* (hi (a 1) (b 2)) a) (procedure-arity hi)) '(0 2 #f))
- (test (let ((hi (lambda* (a) 1))) (procedure-arity hi)) '(0 1 #f))
- (test (call/cc (lambda (func) (procedure-arity func))) '(0 0 #t))
-
- (test (procedure-arity (lambda* (a :rest b) a)) '(0 1 #t))
- (test (procedure-arity (lambda* (:optional a :rest b) a)) '(0 1 #t))
- (test (procedure-arity (lambda* (:optional a :key b :rest c) a)) '(0 2 #t))
- (test (procedure-arity (lambda* (:optional a b) a)) '(0 2 #f))
- (test (procedure-arity (lambda* (:rest args) args)) '(0 0 #t))
- (test (procedure-arity (lambda* (a :optional b . c) a)) '(0 2 #t))
- (test (procedure-arity (lambda* (:rest a . b) a)) '(0 0 #t))
- (test (procedure-arity (lambda* (:key :optional a) a)) '(0 1 #f))
- (test (procedure-arity (lambda* a a)) '(0 0 #t))
- (test (let () (define-macro (hi a) `(+ ,a 1)) (procedure-arity hi)) 'error)
- (test (procedure-arity (make-procedure-with-setter (lambda (a) a) (lambda (a b) a))) '(1 0 #f 2 0 #f))
- (test (procedure-arity (make-procedure-with-setter (lambda (a . b) a) (lambda (a b) a))) '(1 0 #t 2 0 #f))
- (test (procedure-arity (make-procedure-with-setter (lambda* (a :optional b) a) (lambda (a b) a))) '(0 2 #f 2 0 #f))
-
+(let ((hi (lambda* ((a 1)) a)))
+ (test (hi 2) 2)
+ (test (hi) 1)
+ (test (hi :a 2) 2)
+
(for-each
(lambda (arg)
- (test (procedure-arity arg) 'error))
- (list -1 #\a #f _ht_ 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
-
- (define (for-each-subset func args)
- (let* ((arity (procedure-arity func))
- (min-args (car arity))
- (max-args (if (caddr arity)
- (length args)
- (+ min-args (cadr arity))))
- (subsets '()))
-
- (define (subset source dest len)
- (if (null? source)
- (begin
- (if (member dest subsets)
- (format #t ";got ~S twice in for-each-subset: ~S~%" dest args))
- (set! subsets (cons dest subsets))
- (if (<= min-args len max-args)
- (apply func dest)))
- (begin
- (subset (cdr source) (cons (car source) dest) (+ len 1))
- (subset (cdr source) dest len))))
-
- (subset args '() 0)))
-
- (test (let ((ctr 0))
- (for-each-subset (lambda args (set! ctr (+ ctr 1))) '(1 2 3 4))
- ctr)
- 16)
- (test (let ((ctr 0))
- (for-each-subset (lambda (arg) (set! ctr (+ ctr 1))) '(1 2 3 4))
- ctr)
- 4)
- (test (let ((ctr 0))
- (for-each-subset (lambda (arg1 arg2 arg3) (set! ctr (+ ctr 1))) '(1 2 3 4))
- ctr)
- 4)
- (test (let ((ctr 0))
- (for-each-subset (lambda* (arg1 arg2 arg3) (set! ctr (+ ctr 1))) '(1 2 3 4))
- ctr)
- 15)
- (test (let ((ctr 0))
- (for-each-subset (lambda () (set! ctr (+ ctr 1))) '(1 2 3 4))
- ctr)
- 1)
-
- (define (snarf func lst)
- "(snarf func lst) repeatedly applies func to as many elements of lst as func can take"
- (let ((arity (procedure-arity func)))
- (if (caddr arity)
- (apply func lst)
- (let ((n (+ (car arity) (cadr arity)))
- (lst-len (length lst)))
- (if (< lst-len (car arity))
- (error 'wrong-number-of-args ";snarf func requires ~A args, but got ~A, ~A" (car arity) lst-len lst)
- (if (<= lst-len n)
- (apply func lst)
- (if (not (zero? (modulo (length lst) n)))
- (error 'wrong-number-of-args ";snarf will take ~A args at a time, but got ~A in ~A" n lst-len lst)
- ;; ideally this would accept partial lists (i.e. left-over < req),
- ;; but then we also need to notice that case in the list-tail below
- (let ()
-
- (define (snarf-1 len f args)
- (if (not (null? args))
- (let* ((last (list-tail args (- len 1)))
- (rest (cdr last)))
- (dynamic-wind
- (lambda ()
- (set! (cdr last) '()))
- (lambda ()
- (apply func args))
- (lambda ()
- (set! (cdr last) rest)))
- (snarf-1 len f rest))))
-
- (snarf-1 n func lst)))))))))
-
- (test (let ((lst '(1 2 3 4))) (catch #t (lambda () (snarf (lambda (a b) (format #t "~A ~A~%" a b c)) lst)) (lambda args 'error)) lst) '(1 2 3 4))
- (test (snarf (lambda (a b) (format #t "~A ~A~%" a b)) '(1 2 3 4 5)) 'error)
- (test (snarf (lambda (a b) (format #t "~A ~A~%" a b)) '(1)) 'error)
- (test (let ((x 0)) (snarf (lambda (a) (set! x (+ x a))) '(1 2 3)) x) 6)
- (test (let ((x 0)) (snarf (lambda (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10)
- (test (let ((x 0)) (snarf (lambda* (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10)
- (test (let ((x 0)) (snarf (lambda a (set! x (apply + a))) '(1 2 3 4)) x) 10)
- (test (let ((x 0)) (snarf (lambda* (a b (c 0)) (set! x (+ x a b c))) '(1 2)) x) 3)
-
- (test (let ((c 1))
- (define* (a :optional (b c)) b)
- (set! c 2)
- (a))
- 2)
-
- (test (let ((c 1))
- (define* (a :optional (b c)) b)
- (let ((c 32))
- (a)))
- 1)
+ (test (hi arg) arg)
+ (test (hi :a arg) arg))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2))))
+
+(let ((hi (lambda* (a (b "hi")) (list a b))))
+ (test (hi) (list #f "hi"))
+ (test (hi 1) (list 1 "hi"))
+ (test (hi 1 2) (list 1 2))
+ (test (hi :b 1) (list #f 1))
+ (test (hi :a 1) (list 1 "hi"))
+ (test (hi 1 :b 2) (list 1 2))
+ (test (hi :b 3 :a 1) (list 1 3))
+ (test (hi :a 3 :b 1) (list 3 1))
+ (test (hi 1 :a 3) 'error)
+ (test (hi 1 2 :a 3) 'error) ; trailing (extra) args
+ (test (hi :a 2 :c 1) 'error)
+ (test (hi 1 :c 2) 'error)
- (test (let ((c 1))
- (define* (a (b (+ c 1))) b)
- (set! c 2)
- (a))
- 3)
-
- (test (let ((c 1))
- (define* (a (b (+ c 1))) b)
- (set! c 2)
- (let ((c 123))
- (a)))
- 3)
-
- (test (let* ((cc 1)
- (c (lambda () (set! cc (+ cc 1)) cc)))
- (define* (a (b (c))) b)
- (list cc (a) cc))
- (list 1 2 2))
-
(for-each
(lambda (arg)
- (test (trace arg) 'error)
- (test (untrace arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
+ (test (hi :a 1 :b arg) (list 1 arg))
+ (test (hi :a arg) (list arg "hi"))
+ (test (hi :b arg) (list #f arg))
+ (test (hi arg arg) (list arg arg)))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2))))
+
+(let ((hi (lambda* (a (b 3) c) (list a b c))))
+ (test (hi) (list #f 3 #f))
+ (test (hi 1) (list 1 3 #f))
+ (test (hi :c 32) (list #f 3 32))
+ (test (hi :c 32 :b 43 :a 54) (list 54 43 32))
+ (test (hi 1 2 3) (list 1 2 3))
+ (test (hi :b 32) (list #f 32 #f))
+ (test (hi 1 2 :c 32) (list 1 2 32)))
+
+(let ((hi (lambda* (a :rest b) (list a b))))
+ (test (hi 1 2 3) (list 1 (list 2 3)))
+ (test (hi) (list #f ()))
+ (test (hi :a 2) (list 2 ()))
+ (test (hi :b 3) (list #f 3)))
+
+(let ((hi (lambda* (a :rest b :rest c) (list a b c))))
+ (test (hi 1 2 3 4 5) (list 1 (list 2 3 4 5) (list 3 4 5))))
+
+(let ((hi (lambda* ((a 3) (b #t) (c pi) :rest d) (list a b c d))))
+ (test (hi) (list 3 #t pi ()))
+ (test (hi 1 2 3 4) (list 1 2 3 (list 4))))
+
+(let ((hi (lambda* ((a 'hi)) (equal? a 'hi))))
+ (test (hi) #t)
+ (test (hi 1) #f)
+ (test (hi 'hi) #t)
+ (test (hi :a 1) #f))
+
+(let* ((x 32)
+ (hi (lambda* (a (b x)) (list a b))))
+ (test (hi) (list #f 32))
+ (test (hi :a 1) (list 1 32)))
+
+(let ((hi (lambda* (a . b) (list a b))))
+ (test (hi 1 2 3) (list 1 (list 2 3)))
+ (test (hi) (list #f ()))
+ (test (hi :a 2) (list 2 ()))
+ (test (hi :b 3) (list #f 3)))
+
+(let ((hi (lambda* ((a 0.0) (b 0.0)) (+ a b))))
+ (num-test (hi 1.0) 1.0)
+ (num-test (hi 1.0 2.0) 3.0)
+ (num-test (hi) 0.0)
+ (num-test (+ (hi) (hi 1.0) (hi 1.0 2.0)) 4.0)
+ (num-test (+ (hi 1.0) (hi) (hi 1.0 2.0)) 4.0)
+ (num-test (+ (hi 1.0) (hi 1.0 2.0) (hi)) 4.0)
+ (num-test (+ (hi 1.0 2.0) (hi) (hi 1.0)) 4.0))
+
+(test (let ((hi (lambda*))) (hi)) 'error)
+(test (let ((hi (lambda* #f))) (hi)) 'error)
+(test (let ((hi (lambda* "hi" #f))) (hi)) 'error)
+(test (let ((hi (lambda* ("hi") #f))) (hi)) 'error)
+(test (let ((hi (lambda* (a 0.0) a))) (hi)) 'error)
+(test (let ((hi (lambda* (a . 0.0) a))) (hi)) 'error)
+(test (let ((hi (lambda* ((a . 0.0)) a))) (hi)) 'error)
+(test (let ((hi (lambda* ((a 0.0 "hi")) a))) (hi)) 'error)
+(test (let ((hi (lambda* ((a 0.0 . "hi")) a))) (hi)) 'error)
+(test (let ((hi (lambda* ((a)) a))) (hi)) 'error)
+(test (let ((hi (lambda* (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error)
+(test (lambda (:key) 1) 'error)
+(test (let () (define hi (let ((x 1)) (lambda* ((y x)) y))) (hi)) 1)
+(test (let () (define hi (let ((x 1)) (lambda* ((y x)) y))) (let ((x 2)) (hi))) 1)
+(test ((lambda* (:key) 1)) 'error)
+(test (let ((akey :a) (bkey :b)) ((lambda* (a b) (list a b)) akey 32)) '(32 #f))
+(test (let ((akey :a) (bkey :b)) ((lambda* (a b) (list a b)) bkey 12 akey 43)) '(43 12))
+(test (let ((x 0)) (for-each (lambda* (a) (set! x (+ x a))) (list :a :a :a) (list 1 2 3)) x) 'error)
+
+(test (let () (define* (hi) 0) (hi)) 0)
+(test (let () (define* (hi) 0) (hi 1)) 'error)
+(test (let () (define* (hi a . b) b) (hi 1 2 3)) '(2 3))
+(test (let () (define* (hi a . b) b) (hi :a 1 2 3)) '(2 3))
+(test (let () (define* (hi a . b) b) (hi 1)) ())
+(test (let () (define* (hi a . b) b) (hi :a 1)) ())
+(test (let () (define* (hi a . b) b) (hi)) ())
+(test (let () (define* (hi a . a) a) (hi)) 'error)
+(test (let () (define* (hi (a 1) . a) a) (hi)) 'error)
+(test (let () (define* (hi (a 1) . b) b) (hi 2 3 4)) '(3 4))
+
+(test (let () (define* (hi a :rest b) b) (hi 1 2 3)) '(2 3))
+(test (let () (define* (hi a :rest b) b) (hi :a 1 2 3)) '(2 3))
+(test (let () (define* (hi a :rest b) b) (hi 1)) ())
+(test (let () (define* (hi a :rest b) b) (hi :a 1)) ())
+(test (let () (define* (hi a :rest b) b) (hi)) ())
+
+(test (let () (define* (hi (a 1) . b) b) (hi 1 2 3)) '(2 3))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi)) '(#f 22 ()))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :a 1)) '(1 22 ()))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1)) '(#f 1 ()))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :c 1)) '(#f 22 1))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :a 1 2)) '(1 2 ()))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1 2 3)) 'error) ; b set twice
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :c 1 2 3)) '(#f 2 (3)))
+(test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1 :a 2 3)) '(2 1 (3)))
+
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi)) 1)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :b :a :a 3)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :b 3)) 1)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 3)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi a: 3)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3 :b 2)) 3)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) 3)
+(test (let () (define* (hi :rest a :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) '(:c 1 :a 3 :b 2))
+
+(test (let () (define* (hi (a 1) (b 2) :allow-other-keys :allow-other-keys) a)) 'error)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) 'error)
+(test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 2 32)) 'error)
+
+(test (let () (define* (hi (a 1) :rest c :allow-other-keys) (list a c)) (hi :a 3 :b 2)) '(3 (:b 2)))
+(test (let () (define* (hi (a 1) :rest c) (list a c)) (hi :a 3 :b 2)) '(3 (:b 2)))
+
+(test (let () (define* (hi (a 1) (b 2) :allow-other-keys) (list a b)) (hi :c 21 :b 2)) '(1 2))
+(test (let () (define hi (lambda* ((a 1) (b 2) :allow-other-keys) (list a b))) (hi :c 21 :b 2)) '(1 2))
+(test (let () (define-macro* (hi (a 1) (b 2) :allow-other-keys) `(list ,a ,b)) (hi :c 21 :b 2)) '(1 2))
+
+(test (let () (define* (f1 :allow-other-keys) 123) (f1 :a 1 :b 2)) 'error)
+(test (let ((f1 (lambda* (:allow-other-keys) 123))) (f1 :a 1 :b 2)) 'error)
+(let ()
+ (define* (f1 a :allow-other-keys) :allow-other-keys)
+ (test (keyword? (f1 3)) #t)
+ (test (eq? (f1) ':allow-other-keys) #t)
+ (test (keyword? :allow-other-keys) #t))
+(test (keyword? :allow-other-keys) #t)
+(test (eq? :allow-other-keys ':allow-other-keys) #t)
+(test (keyword? :rest) #t)
+(test (eq? :rest ':rest) #t)
+
+(test (let () (define* (f (a :b)) a) (list (f) (f 1) (f :c) (f :a :c) (f :a 1) (f))) '(:b 1 :c :c 1 :b))
+(test (let () (define* (f a (b :c)) b) (f :b 1 :d)) 'error)
+(test ((lambda* (:rest (b 1)) b)) 'error) ; "lambda* :rest parameter can't have a default value." ?
+(test ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c)))) 7)
+(test ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c))) :b 3) 10)
+(test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c))) :b a)) 370)
+(test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (let ((a -2)) (* b a))))) c))))) -3)
+(test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ (let ((a -2)) (* b a)) a))) c))))) -3)
+(test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ (let ((a 0)) (/ b a)) a))) c))))) 'error)
+(test ((lambda* ((c (call/cc (lambda (return) (return 3))))) c)) 3)
+(test ((lambda* ((a (do ((i 0 (+ i 1)) (sum 0)) ((= i 3) sum) (set! sum (+ sum i))))) (+ a 100))) 103)
+(test ((lambda* ((a (do ((i 0 (+ i 1)) (sum 0)) ((= i 3) sum) (set! sum (+ sum i)))) b) (+ a b)) 1 2) 3)
+
+;; some of these are questionable
+(test ((lambda* ((x (lambda () 1))) (x))) 1)
+(test ((lambda* ((x x) else) (+ x else)) 1 2) 3) ; this has fluctuated between 3 and 'error (unbound variable 'x)
+(test (symbol? ((lambda* ((y y)) y))) 'error) ; this used to be #t but now y is undefined
+(test ((lambda* (:allow-other-keys) 34) :a 32) 'error)
+(test ((lambda* ((y x) =>) (list y =>)) 1 2) '(1 2)) ; was also 'error
+(test ((lambda* (=> (y x)) (list y =>)) 1) 'error) ; used to be '(x 1))
+(test ((lambda* ((y #2D((1 2) (3 4)))) (y 1 0))) 3)
+(test ((lambda* ((y (symbol "#(1 #\\a (3))")) x) -1)) -1)
+(test ((lambda* ((y (symbol "#(1 #\\a (3))")) x) y)) (symbol "#(1 #\\a (3))"))
+(test ((lambda* ((y #(1 #\a (3)))) (y 0))) 1)
+(test ((lambda* ((y ()) ()) y)) 'error)
+(test ((lambda* ((y ()) (x)) y)) 'error)
+(test ((lambda* ((=> "") else) else) else) #f)
+(test ((lambda* (x (y x)) y) 1) 1) ; was #f
+(test ((lambda* (x (y x)) (let ((x 32)) y)) 1) 1) ; was #f
+(test ((lambda* ((x 1) (y x)) y)) 1)
+(test ((lambda* ((x 1) (y (+ x 1))) y)) 2)
+(test ((lambda* ((x y) (y x)) y)) 'error) ; used to be 'y
+(test (let ((z 2)) ((lambda* ((x z) (y x)) y))) 2) ; hmmm
+(test (keyword? ((lambda* ((x :-)) x))) #t)
+(test ((apply lambda* (list (list (list (string->symbol "a") 1)) (string->symbol "a"))) (symbol->keyword (string->symbol "a")) 3) 3)
+(test ((lambda* (:allow-other-keys) 1) :a 321) 'error)
+(test ((lambda* (:rest (a 1)) a)) 'error)
+(test ((lambda* (:rest a) a)) ())
+(test ((lambda* (:rest (a 1)) 1)) 'error)
+(test (let ((b 2)) ((lambda* (:rest (a (let () (set! b 3) 4))) b))) 'error)
+(test (let ((b 2)) ((lambda* ((a (let () (set! b 3) 4))) b))) 3)
+(test ((lambda* (:rest hi :allow-other-keys (x x)) x)) 'error)
+(test ((lambda* (:rest x y) (list x y)) 1 2 3) '((1 2 3) 2))
+(test ((lambda* (:rest '((1 2) (3 4)) :rest (y 1)) 1)) 'error)
+(test ((lambda* (:rest (list (quote (1 2) (3 4))) :rest (y 1)) 1)) 'error)
+(test ((lambda* ((x ((list 1 2) 1))) x)) 2)
+(test ((lambda* ((y ("hi" 0))) y)) #\h)
+(test ((lambda* ((x ((lambda* ((x 1)) x)))) x)) 1)
+(test ((lambda* (:rest) 3)) 'error)
+(test ((lambda* (:rest 1) 3)) 'error)
+(test ((lambda* (:rest :rest) 3)) 'error)
+(test ((lambda* ((: 1)) :)) 1)
+(test ((lambda* ((: 1)) :) :: 21) 21)
+(test ((lambda* ((a 1)) a) a: 21) 21)
+(test ((lambda* ((a 1)) a) :a: 21) 'error)
+(test (let ((func (let ((a 3)) (lambda* ((b (+ a 1))) b)))) (let ((a 21)) (func))) 4)
+(test (let ((a 21)) (let ((func (lambda* ((b (+ a 1))) b))) (let ((a 3)) (func)))) 22)
+(test (let ((a 21)) (begin (define-macro* (func (b (+ a 1))) b) (let ((a 3)) (func)))) 4)
+(test ((lambda* (:rest x :allow-other-keys y) x) 1) 'error)
+(test ((lambda* (:allow-other-keys x) x) 1) 'error)
+(test ((lambda* (:allow-other-keys . x) x) 1 2) 'error)
+(test ((lambda* (:rest . (x)) x) 1 2) '(1 2))
+(test ((lambda* (:rest . (x 1)) x) 1 2) 'error)
+(test ((lambda* (:rest . (x)) x)) ())
+(test ((lambda* x x) 1) '(1))
+(test (lambda* (((x) 1)) x) 'error)
+(test ((lambda* ((a: 3)) a:) :a: 4) 'error)
+(test ((lambda* ((a 3)) a) a: 4) 4)
+(test ((lambda* ((a (lambda* ((b 1)) (+ b 1)))) (a))) 2)
+;(define hi (call-with-exit (lambda (return) (lambda* ((a (return "hey I need an argument"))) a)))) -> error call goto outside block?
+(test (let () (define hi (with-let (inlet 'a 3) (lambda (b) (+ a b)))) (hi 2)) 5) ; but this blocks the local env chain:
+;(let ((y 2)) (define hi (with-let (inlet) (lambda (a) (+ a y)))) (hi 1)) -> error y unbound
+;quick circular env: (define* (hi (a (curlet))) a) (hi) -- need a lambda equivalent of bacro for defargs
+(test (let () (define hi (do ((i 0 (+ i 1))) ((= i 3) (lambda (a) (+ a i))))) (hi 1)) 4)
+
+(test ((lambda* a (list a)) 1 2 3) '((1 2 3)))
+(test ((lambda* () #f) 1 2 3) 'error)
+(test ((lambda* (a ) (list a)) 1) '(1))
+(test ((lambda* (a b ) (list a b)) 1 2) '(1 2))
+(test ((lambda* (a b :allow-other-keys ) (list a b)) 1 2 :c 3) '(1 2))
+(test ((lambda* (a . b ) (list a b)) 1 2 3) '(1 (2 3)))
+(test ((lambda* (a :rest b ) (list a b)) 1 2 3) '(1 (2 3)))
+(test ((lambda* (a :rest b :allow-other-keys ) (list a b)) 1 2 :c 3) '(1 (2 :c 3)))
+(test ((lambda* (a b :allow-other-keys ) (list a b)) 1) '(1 #f))
+(test ((lambda* (a :allow-other-keys ) (list a)) :b 2) '(#f))
+(test ((lambda* (:rest a ) (list a)) 1 2 3) '((1 2 3)))
+(test ((lambda* (:rest a b ) (list a b)) 1 2 3) '((1 2 3) 2))
+(test ((lambda* (:rest a b :allow-other-keys ) (list a b)) :c 1 2 3) '((:c 1 2 3) 1)) ; seems inconsistent
+(test ((lambda* (:rest a . b ) (list a b)) 1 2 3) '((1 2 3) (2 3)))
+(test ((lambda* (:rest a :rest b ) (list a b)) 1 2 3) '((1 2 3) (2 3)))
+(test ((lambda* (:rest a :rest b :allow-other-keys ) (list a b)) 1 2 3) '((1 2 3) (2 3)))
+(test ((lambda* (:rest a :allow-other-keys ) (list a)) 1 2 3) '((1 2 3)))
+(test ((lambda* (:allow-other-keys ) (list)) :a 1 :c 3) 'error)
+
+(test ((lambda* (:rest a :rest b) (map + a b)) 1 2 3 4 5) '(3 5 7 9))
+(test ((lambda* (:rest a c :rest b) (map (lambda (a b) (+ a b c)) a b)) 1 2 3 4 5) '(6 8 10))
+(test ((lambda* (a :rest (b 2)) (list a b)) 1 2 3 4) 'error)
- (let ((sum 0))
- (define (hiho a b c) (* a b c))
- (set! *trace-hook* (lambda (f args) (set! sum (apply + args))))
- (trace hiho)
- (hiho 2 3 4)
- (untrace hiho)
- (set! *trace-hook* '())
- (test sum 9))
-
- (test (hook-arity *trace-hook*) '(2 0 #f))
- (test (hook-documentation *trace-hook*) "*trace-hook* customizes tracing. Its functions take 2 arguments, the function being traced, and its current arguments.")
- (test (hook-functions *trace-hook*) '())
+(let ()
+ (define* (f1 (a 0) :allow-other-keys) (+ a 1))
+ (let ((f2 (copy f1)))
+ (test (f2 :a 1) 2)
+ (test (f2 :b 1) 1)))
- (let ((sum 0))
- (define (hiho a b c) (* a b c))
- (set! *trace-hook* (list (lambda (f args) (set! sum (apply + args)))))
- (trace hiho)
- (hiho 2 3 4)
- (untrace hiho)
- (set! *trace-hook* '())
- (test sum 9))
+;;; one place where :rest can't be handled by dotted list:
+(let ()
+ (define* (f1 :rest args :allow-other-keys) args)
+ (test (f1 :a 1 :b 2) '(:a 1 :b 2)))
+;;; but its :allow-other-keys isn't needed here anyway:
+(let ()
+ (define* (f1 . args) args)
+ (test (f1 :a 1 :b 2) '(:a 1 :b 2)))
+;;; but
+(let ()
+ (define* (f1 (c 0) . args) args)
+ (test (f1 :a 1 :b 2) 'error) ; unknown key
+ (test (f1 :c 1 :b 2) '(:b 2)))
+
+(define* (-nxy- gen (fm 0.0)) ; optimizer test (safe_closure_star_s0)
+ (let-set! gen 'fm fm)
+ (with-let gen
+ fm))
+(let ((g (inlet 'fm 1.0)))
+ (test (-nxy- g) 0.0)
+ (test (-nxy- g) 0.0)
+ (test (-nxy- g 0.5) 0.5)
+ (test (-nxy- g) 0.0))
- (for-each
- (lambda (arg)
- (test (set! *trace-hook* arg) 'error)
- (test (set! *unbound-variable-hook* arg) 'error)
- (test (set! *error-hook* arg) 'error)
- (test (set! *load-hook* arg) 'error)
+#|
+(let ((choices (list "a " "b " " . " ":rest " ":allow-other-keys "))
+ (args (list "1 " ":a " ":b " ":c ")))
- (test (set! (hook-functions *trace-hook*) arg) 'error)
- (test (set! (hook-functions *unbound-variable-hook*) arg) 'error)
- (test (set! (hook-functions *error-hook*) arg) 'error)
- (test (set! (hook-functions *load-hook*) arg) 'error)
+ (define-bacro (display-abc)
+ `(format #f "~A ~A" (if (defined? 'a) (symbol->value 'a) '?) (if (defined? 'b) (symbol->value 'b) '?)))
- (test (set! (hook-functions *trace-hook*) (list arg)) 'error)
- (test (set! (hook-functions *unbound-variable-hook*) (list arg)) 'error)
- (test (set! (hook-functions *error-hook*) (list arg)) 'error)
- (test (set! (hook-functions *load-hook*) (list arg)) 'error)
- )
- (list -1 #\a '#(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi #<eof> #(1 2 3) '#(()) "hi" '(1 . 2) '(1 2 3)))
+ (define (next-arg str n)
- (for-each
- (lambda (arg)
- (eval-string (format #f "(define (func) ~S)" arg))
- (let ((source (procedure-source func)))
- (let ((val (func)))
- (test val arg))))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i #t #f '() '#(()) ':hi "hi"))
-
- (test (string=? (let () (define (hi) "this is a string" 1) (procedure-documentation hi)) "this is a string") #t)
- (test (string=? (let () (define (hi) "this is a string" 1) (help hi)) "this is a string") #t)
- (test (string=? (let () (define (hi) "this is a string") (procedure-documentation hi)) "this is a string") #t)
- (test (string=? (let () (define (hi) "this is a string") (hi)) "this is a string") #t)
- (test (string=? (let () (define* (hi (a "a string")) a) (procedure-documentation hi)) "") #t)
- (test (string=? (let () (define* (hi (a "a string")) "another string" a) (procedure-documentation hi)) "another string") #t)
- (test (string=? (let () (define (hi a) "hi doc" (define (ho b) "ho doc" b) (ho a)) (procedure-documentation hi)) "hi doc") #t)
- (test (set! (procedure-documentation abs) "X the unknown") 'error)
- (test (let ((str (procedure-documentation abs))) (set! ((procedure-documentation abs) 1) #\x) (equal? str (procedure-documentation abs))) #t)
- (test (let ((str (procedure-documentation abs))) (fill! (procedure-documentation abs) #\x) (equal? str (procedure-documentation abs))) #t)
- (let ()
- (define-macro (amac a) "this is a string" `(+ ,a 1))
- (test (procedure-documentation amac) "this is a string"))
+ (let ((expr (string-append str ")")))
+ (catch #t
+ (lambda ()
+ (let ((val (eval-string expr)))
+ (format-logged #t "~A -> ~A~%" expr val)))
+ (lambda args
+ ;(format-logged #t " ~A: ~A~%" expr (apply format #f (cadr args)))
+ 'error)))
+
+ (if (< n 6)
+ (for-each
+ (lambda (arg)
+ (next-arg (string-append str arg) (+ n 1)))
+ args)))
+
+ (define (next-choice str n)
+ (next-arg (string-append str ") (display-abc)) ") 0)
+ (if (< n 4)
+ (for-each
+ (lambda (choice)
+ (next-choice (string-append str choice) (+ n 1)))
+ choices)))
(for-each
- (lambda (arg)
- (test (procedure-environment arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
+ (lambda (choice)
+ (next-arg (string-append "((lambda* " choice "(display-abc)) ") 0))
+ choices)
- (test (let ()
- (define (hi a)
- (let ((func (cdr (assoc '__func__ (car (procedure-environment hi))))))
- (list (if (symbol? func) func (car func))
- a)))
- (hi 1))
- (list 'hi 1))
+ (next-choice "((lambda* (" 0))
+|#
- (test (let ()
- (define hi (let ((a 32))
- (lambda (b)
- (+ a b))))
- (define ho (with-environment
- (procedure-environment hi)
- (lambda (b)
- (+ a b))))
- (list (hi 1) (ho 1)))
- (list 33 33))
+(let ()
+ (define* (s0-test gen (fm 0.0))
+ (let-set! gen 'fm fm)
+ (with-let gen
+ (+ fm 1.0)))
+ (define (tst)
+ (let ((g (inlet 'fm 0.0)))
+ (num-test (s0-test g) 1.0))
+ (let ((g (inlet 'fm 0.0)))
+ (num-test (s0-test g 0.0) 1.0)))
+ (tst))
+
+;;; here be bugs...
+(test ((lambda* a a) :a) '(:a))
+(test ((lambda* (a . b) (list a b)) :b 1) '(#f 1)) ; ??? why doesn't the 1st arg work this way?
+(test ((lambda* (a :rest b) (list a b)) :b 1) '(#f 1))
+(test ((lambda* (:rest a) (list a)) :a 1) '((:a 1))) ; surely these are inconsistent
+(test ((lambda* (a . b ) (list a b)) :b 1 1) '(#f (1))) ; so if trailer, overwrite is not error?
+
+(test ((lambda* (:rest a b ) (list a b)) 1 1) '((1 1) 1))
+(test ((lambda* (:rest a :rest b ) (list a b)) :a 1) '((:a 1) (1)))
+(test ((lambda* (:allow-other-keys) #f) :c 1) 'error)
+(test ((lambda* (a :allow-other-keys) a) :a) :a)
+(test ((lambda* (a) a) :a) :a)
+(test ((lambda* (a :allow-other-keys) a) :a 1 :a 2) 1) ; this is very tricky to catch
+(test ((lambda* (a :allow-other-keys) a) :c :c :c :c) #f)
+(test ((lambda* (a :allow-other-keys) a) :c) :c)
+(test ((lambda* (a b :allow-other-keys ) (list a b)) :b :a :c 1) '(#f :a))
+
+(test ((lambda* (a :allow-other-keys ) a) :c 1 1) 1) ; ??
+(test ((lambda* (:rest b (a 1)) (list a b))) '(1 ()))
+(test ((lambda* (:rest a b c) (list a b c)) 1 2 3 4) '((1 2 3 4) 2 3))
+
+;(test (let ((x 3)) (define* (f (x x)) x) (let ((x 32)) (f))) 3)
+(test (let ((x 3)) (define-macro* (f (x x)) `,x) (let ((x 32)) (f))) 32) ; ?? inconsistent with define* perhaps?
+
+(test (let () (define (x x) x) (x 1)) 1)
+(test (procedure? (let () (define* (x (x #t)) x) (x x))) #t)
+(test (procedure? (let () (define* (x (x x)) x) (x (x x)))) #t)
+;(test (procedure? (let () (define* (x (x x)) x) (x))) #t)
+(test (apply + ((lambda* ((x (values 1 2 3))) x))) 6)
+(test ((lambda* ((x (lambda* ((y (+ 1 2))) y))) (x))) 3)
- (test (let ()
- (define (hi a) (+ a 1))
- (with-environment (procedure-environment hi)
- ((eval (procedure-source hi)) 2)))
- 3)
+ ;;; define-macro
+ ;;; define-macro*
+ ;;; define-bacro
+ ;;; define-bacro*
- (let ()
- (define (where-is func)
- (let* ((env (procedure-environment func))
- (cenv (and (pair? env)
- (car env)))
- (f (and (pair? cenv)
- (assoc '__func__ cenv)))
- (addr (and (pair? f)
- (cdr f))))
- (if (not (pair? addr))
- ""
- (list (format #f "~A[~D]" (cadr addr) (caddr addr))
- addr))))
- (let ((e (where-is ok?)))
- (test (and (pair? (cadr e))
- (< ((cadr e) 2) 100)) ; this depends on where ok? is in this file
- #t)
- (test (and (pair? (cadr e))
- (string=? (symbol->string (car (cadr e))) "ok?"))
- #t)
- (test (and (pair? (cadr e))
- (let ((name (cadr (cadr e))))
- (and (string? name)
- (call-with-exit
- (lambda (oops)
- (let ((len (length name)))
- (do ((i 0 (+ i 1)))
- ((= i len) #t)
- (if (and (not (char-alphabetic? (name i)))
- (not (char=? (name i) #\/))
- (not (char=? (name i) #\\))
- (not (char=? (name i) #\.))
- (not (char=? (name i) #\-))
- (not (char-numeric? (name i))))
- (begin
- (format #t "ok? file name: ~S~%" name)
- (oops #f))))))))))
- #t)))
-
- (let ()
- (define-macro (window func beg end . body)
- `(call-with-exit
- (lambda (quit)
- (do ((notes ',body (cdr notes)))
- ((null? notes))
- (let* ((note (car notes))
- (note-beg (cadr note)))
- (if (<= ,beg note-beg)
- (if (> note-beg (+ ,beg ,end))
- (quit)
- (,func note))))))))
-
- (test
- (let ((n 0))
- (window (lambda (a-note) (set! n (+ n 1))) 0 1
- (fm-violin 0 1 440 .1)
- (fm-violin .5 1 550 .1)
- (fm-violin 3 1 330 .1))
- n)
- 2)
-
- (test
- (let ((notes 0)
- (env #f))
- (set! env (current-environment))
- (window (with-environment env (lambda (n) (set! notes (+ notes 1)))) 0 1
- (fm-violin 0 1 440 .1)
- (fm-violin .5 1 550 .1)
- (fm-violin 3 1 330 .1))
- notes)
- 2))
+(test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ 1 ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((1 0) 0))
+(test (let ((x 0)) (define-bacro* (hi (a (let () (set! x (+ x 1)) x))) `(+ 1 ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((1 0) 0))
+(test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ x ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((-1 0) 0))
+(test (let ((x 0)) (define-bacro* (hi (a (let () (set! x (+ x 1)) x))) `(+ x ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((-1 0) 0))
+
+(test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(let ((x -1)) (+ x ,a))) (list (hi) x)) '(-1 0))
+(test (let ((x 0)) (let ((x -1)) (+ x (let () (set! x (+ x 1)) x)))) -1)
+(test (let ((x 0)) (define-macro (hi a) `(let ((x -1)) (+ x ,a))) (list (hi (let () (set! x (+ x 1)) x)) x)) '(-1 0))
+(test (let () (define-macro (hi a) `(let ((b 1)) (+ ,a b))) (hi (+ 1 b))) 3)
+(test (let ((b 321)) (define-macro (hi a) `(let ((b 1)) (+ ,a b))) (hi b)) 2)
+(test (let ((b 321)) (define-macro* (hi (a b)) `(let ((b 1)) (+ ,a b))) (hi b)) 2)
+(test (let ((b 321)) (define-macro* (hi (a b)) `(let ((b 1)) (+ ,a b))) (hi)) 2) ; ???
+(test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ ,a ,a)) (hi)) 3) ; ??? -- default val is substituted directly
+;; but (let () (define-macro* (hi a (b a)) `(+ ,a ,b)) (hi 1)) -> "a: unbound variable" -- "a" itself is substituted, but does not exist at expansion(?)
+
+;; can we implement bacros via define-macro* default args?
+;; I don't think so -- macro arguments can't be evaluated in that environment because
+;; only the default values have been set (on the previous parameters).
+
+;; bacro ignores closure in expansion but macro does not:
+(test (let ((x 1)) (define-macro (ho a) `(+ ,x ,a)) (let ((x 32)) (ho 3))) 4)
+(test (let ((x 1)) (define-macro (ho a) `(+ x ,a)) (let ((x 32)) (ho 3))) 35)
+(test (let ((x 1)) (define-bacro (ho a) `(+ ,x ,a)) (let ((x 32)) (ho 3))) 35)
+(test (let ((x 1)) (define-bacro (ho a) `(+ x ,a)) (let ((x 32)) (ho 3))) 35)
+
+(test (let ((x 1)) (define-macro* (ho (a x)) `(+ ,x ,a)) (let ((x 32)) (ho))) 33)
+(test (let ((x 1)) (define-macro* (ho (a x)) `(+ x ,a)) (let ((x 32)) (ho))) 64)
+(test (let ((x 1)) (define-bacro* (ho (a x)) `(+ x ,a)) (let ((x 32)) (ho))) 64)
+(test (let ((x 1)) (define-bacro* (ho (a x)) `(+ ,x ,a)) (let ((x 32)) (ho))) 64)
+
+(test (let ((x 1)) (define-macro* (ho (a (+ x 0))) `(+ ,x ,a)) (let ((x 32)) (ho))) 33) ;; (+ 32 (+ x 0)) !?! macroexpand is confusing?
+(test (let ((x 1)) (define-macro* (ho (a (+ x 0))) `(+ x ,a)) (let ((x 32)) (ho))) 64) ;; (+ x (+ x 0))
+(test (let ((x 1)) (define-bacro* (ho (a (+ x 0))) `(+ x ,a)) (let ((x 32)) (ho))) 64 )
+(test (let ((x 1)) (define-bacro* (ho (a (+ x 0))) `(+ ,x ,a)) (let ((x 32)) (ho))) 64 )
+
+(test (let () (define-macro* (hi :rest a) `(list , at a)) (hi)) ())
+(test (let () (define-macro* (hi :rest a) `(list , at a)) (hi 1)) '(1))
+(test (let () (define-macro* (hi :rest a) `(list , at a)) (hi 1 2 3)) '(1 2 3))
+(test (let () (define-macro* (hi a :rest b) `(list ,a , at b)) (hi 1 2 3)) '(1 2 3))
+(test (let () (define-macro* (hi (a 1) :rest b) `(list ,a , at b)) (hi)) '(1))
+(test (let () (define-macro* (hi (a 1) :rest b) `(list ,a , at b)) (hi 2)) '(2))
+(test (let () (define-macro* (hi (a 1) :rest b) `(list ,a , at b)) (hi :a 2)) '(2))
+(test (let () (define-macro* (hi (a 1) :rest b :allow-other-keys) `(list ,a , at b)) (hi :a 2 :b 3)) '(2 :b 3))
+(test (let () (define-macro* (mac1 a :rest b) `(,a , at b)) (mac1 + 2 3 4)) 9)
+
+ ; (test (let () (define-macro , at a 23)) 'error)
+ ; (test (let () (define-macro ,a 23)) 'error)
+ ; maybe this isn't right
+(let ()
+ (define-macro (dw-fs x)
+ `(values (lambda () #f) (lambda () ,x) (lambda () #f)))
+ (test (dynamic-wind (dw-fs 3)) 3))
- (test (let ()
- (define-macro (window func beg end . body)
- `(let ((e (current-environment)))
- (call-with-exit
- (lambda (quit)
- (do ((notes ',body (cdr notes)))
- ((null? notes))
- (let* ((note (car notes))
- (note-beg (cadr note)))
- (if (<= ,beg note-beg)
- (if (> note-beg (+ ,beg ,end))
- (quit)
- ((with-environment e ,func) note)))))))))
-
- (let ((notes 0))
- (window (lambda (n) (set! notes (+ notes 1))) 0 1
- (fm-violin 0 1 440 .1)
- (fm-violin .5 1 550 .1)
- (fm-violin 3 1 330 .1))
- notes))
- 2)
+(let ()
+ (define-macro (flam . args) `(apply format #f "~{~A~^ ~}" '(,args)))
+ (test (flam this is a test) "this is a test"))
+
+(test ((lambda* ((a 1) :allow-other-keys) a) :b 1 :a 3) 3)
+(test (let () (define-macro* (hi (a 1) :allow-other-keys) `(list ,a)) (hi :b 2 :a 3)) '(3))
+(test ((lambda* ((a 1) :rest b :allow-other-keys) b) :c 1 :a 3) ())
+(test ((lambda* ((a 1) :rest b :allow-other-keys) b) :b 1 :a 3) 'error)
+;; that is the rest arg is not settable via a keyword and it's an error to try to
+;; do so, even if :allow-other-keys -- ??
+
+(test (let ((x 1)) (define* (hi (a x)) a) (let ((x 32)) (hi))) 1)
+(test (let ((x 1)) (define* (hi (a (+ x 0))) a) (let ((x 32)) (hi))) 1)
+(test (let ((x 1)) (define* (hi (a (+ x "hi"))) a) (let ((x 32)) (hi))) 'error)
+(test (let ((x 1)) (define-macro* (ho (a (+ x "hi"))) `(+ x ,a)) (let ((x 32)) (ho))) 'error)
+(test (let ((x 1)) (define-macro (f1) `(+ x 1)) (f1)) 2)
+(let ()
+ (define-macro (until test . body) `(do () (,test) , at body))
+ (test (let ((i 0) (sum 0)) (until (= i 4) (set! sum (+ sum i)) (set! i (+ i 1))) sum) 6))
- (for-each
- (lambda (arg)
- (test (continuation? arg) #f))
- (list -1 #\a 1 #f _ht_ '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) "hi" (lambda () 1)))
-
- (test (let ((cont #f))
- (and (call/cc (lambda (x) (set! cont x) (continuation? x)))
- (continuation? cont)))
- #t)
- (test (let ((cont #f))
- (or (call-with-exit (lambda (x) (set! cont x) (continuation? x)))
- (continuation? cont)))
- #f) ; x is not a continuation
-
- (test (continuation?) 'error)
- (test (continuation? 1 2) 'error)
+(let ()
+ (define-macro (glambda args) ; returns an anonymous macro that will return a function given a body
+ `(define-macro (,(gensym) . body)
+ `(lambda ,',args , at body)))
+ (test (let ((gf (glambda (a b)))) ; gf is now ready for any body that involves arguments 'a and 'b
+ ((gf (+ a b)) 1 2)) ; apply (lambda (a b) (+ a b)) to '(1 2)
+ 3))
+
+(let ()
+ (define-macro (alambda pars . body)
+ `(letrec ((self (lambda* ,pars , at body)))
+ self))
- (test (string? (s7-version)) #t)
- (test (s7-version 1) 'error)
+ (test ((alambda (n) (if (<= n 0) () (cons n (self (- n 1))))) 9) '(9 8 7 6 5 4 3 2 1))
+
+ (define-macro* (aif test then (else #<unspecified>))
+ `(let ((it ,test))
+ (if it ,then ,else)))
+
+ (test (aif (+ 3 2) it) 5)
+ (test (aif (> 2 3) it) #<unspecified>)
+ (test (aif (> 2 3) #f it) #f)
+ )
-;;; eval
-;;; eval-string
+(let ()
+ (define-macro (enum . args)
+ `(for-each (let ((ctr -1))
+ (define-macro (m a)
+ (set! ctr (+ ctr 1))
+ `(apply define ',a ,ctr ())))
+ ',args))
- (test (eval-string "(+ 1 2)") 3)
- (test (eval '(+ 1 2)) 3)
- (test (eval `(+ 1 (eval `(* 2 3)))) 7)
- (test (eval `(+ 1 (eval-string "(* 2 3)"))) 7)
- (test (eval-string "(+ 1 (eval-string \"(* 2 3)\"))") 7)
- (test (eval `(+ 1 2 . 3)) 'error)
- (test (eval-string) 'error)
- (test (eval) 'error)
- (test (eval-string "") #f)
- (test (eval ()) ())
- (test (eval-string "1" () ()) 'error)
- (test (eval () () ()) 'error)
- (test (eval "1") "1")
- (test (eval-string #t) 'error)
- (test (eval #(+ 1 2)) #(+ 1 2))
-
- (test (apply "hi" 1 ()) #\i)
- (test (eval ("hi" 1)) #\i)
- (test (apply + 1 1 (cons 1 (quote ()))) 3)
- (test (eq? (eval (quote (quote ()))) ()) #t)
- (test (apply (cons (quote cons) (cons 1 (quote ((quote ()))))) 1 ()) 1) ; essentially ((list 'cons 1 ...) 1) => 1
- (test (eval ((cons (quote cons) (cons 1 (quote ((quote ()))))) 1)) 1)
- (test (eval (eval (list '+ 1 2))) 3)
-
-
- (test (apply + (+ 1) ()) 1)
- (test (apply #(1) (+) ()) 1)
- (test (apply + (+) ()) 0)
- (test (eval #()) #())
- (test (apply (lambda () #f)) #f)
- (test (eval '(if #f #f)) (if #f #f))
- (test (let ((ho 32)) (symbol? (eval (eval (eval (eval '''''ho)))))) #t)
- (test (eval '(case 0 ((1) 2) ((0) 1))) 1)
- (test (eval '(cond ((= 1 2) 3) (#t 4))) 4)
-
- (test (eval-string (string-append "(list 1 2 3)" (string #\newline) (string #\newline))) (list 1 2 3))
- (eval-string (string-append "(define evalstr_1 32)" (string #\newline) "(define evalstr_2 2)"))
- (test (eval-string "(+ evalstr_1 evalstr_2)") 34)
- (eval-string (string-append "(set! evalstr_1 3)" "(set! evalstr_2 12)"))
- (test (eval-string "(+ evalstr_1 evalstr_2)") 15)
-
- (test (+ (eval `(values 1 2 3)) 4) 10)
- (test (+ (eval-string "(values 1 2 3)") 4) 10)
- (test (+ 1 (eval-string "(+ 2 3)") 4) 10)
- (test ((eval-string "(lambda (a) (+ a 1))") 2) 3)
- (test (eval ((eval-string "(lambda (a) (list '+ a 1))") 2)) 3)
- (test (eval-string "(+ 1 (eval (list '+ 1 2)))") 4)
-
- (num-test (eval-string "\ +\ \ 1") 1)
- (num-test (eval-string "'\ `\ 1") 1)
- (num-test (eval-string "\ 1\ +i") 1+1i)
- (num-test (eval-string "\x32\x37/\x37\ ") 27/7)
- (num-test (eval-string "\ '-1\ ") -1)
- (num-test (eval-string "\ .\ 10") 0.1)
- (num-test (eval-string "#\ i\ -\x34") -4.0)
- (num-test (eval-string "1\ 1.\x37\ ") 11.7)
- (num-test (eval-string "1/\ \ 1\x30") 1/10)
- (num-test (eval-string "#\ xe\ \x36\ ") 230)
- (num-test (eval-string "\ \ \x35\ . ") 5.0)
- (num-test (eval-string "#x01/\ \x34") 1/4)
- (num-test (eval-string "-\ 1\ .\x35\ e\ 0") -1.5)
+ (enum a b c)
+ (test b 1)
+ (test (+ a b c) 3))
- (for-each
- (lambda (arg)
- (test (eval-string arg) 'error))
- (list -1 0 1 512 #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
- (for-each
- (lambda (arg)
- (test (eval-string "(+ 1 2)" arg) 'error))
- (list -1 0 1 512 #\a '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i 'hi abs "hi" '#(()) (lambda () 1)))
-
-
- (test (string=? (procedure-documentation abs) "(abs x) returns the absolute value of the real number x") #t)
- (test (string=? (help abs) "(abs x) returns the absolute value of the real number x") #t)
- (test (string=? (procedure-documentation 'abs) "(abs x) returns the absolute value of the real number x") #t)
- (test (let ((hi (lambda (x) "this is a test" (+ x 1))))
- (list (hi 1) (procedure-documentation hi)))
- (list 2 "this is a test"))
- (test (procedure-documentation (lambda* (a b) "docs" a)) "docs")
- (test (procedure-documentation (lambda* (a b) "" a)) "")
- (test (procedure-documentation (lambda* (a b) a)) "")
- (test (procedure-documentation (call-with-exit (lambda (c) c))) "")
- (test (procedure-documentation (call/cc (lambda (c) c))) "")
- (test (procedure-arity (call-with-exit (lambda (c) c))) '(0 0 #t))
- (test (procedure-arity (call/cc (lambda (c) c))) '(0 0 #t))
-
-
- (if (not (provided? 'snd))
- (for-each
- (lambda (arg)
- (test (procedure-documentation arg) 'error)
- (test (help arg) 'error))
- (list -1 #\a #f _ht_ 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi")))
-
- (test (let ((hi (lambda (x) (+ x 1)))) (procedure-source hi)) '(lambda (x) (+ x 1)))
- (test (procedure-with-setter? symbol-access) #t)
- (test (procedure-documentation symbol-access) "(symbol-access sym) is a procedure-with-setter that adds or removes controls on how a symbol accesses its current binding.")
+(let ()
+ (define-bacro* (m (a b)) a)
+ (test (let ((b 2)) (m)) 2)
+ (test (let ((b 2)) (let ((b 23)) (m))) 23))
+
+(let ()
+ (let ((x 1) (y 2))
+ (define-bacro (bac1 a) `(+ ,x y ,a))
+ (let ((x 32) (y 64))
+ (test (bac1 3) 99)))
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac2 a)
+ (with-let (sublet (funclet bac2) (cons 'a a))
+ `(+ ,x y ,a)))
+ (let ((x 32) (y 64))
+ (test (bac2 3) 68)))
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac3 a)
+ (with-let (sublet (funclet bac3) (cons 'a a))
+ (eval `(+ ,x y ,a))))
+ (let ((x 32) (y 64))
+ (test (bac3 3) 6)))
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac4 a)
+ (eval `(+ ,x y ,a) (sublet (funclet bac4) (cons 'a a))))
+ (let ((x 32) (y 64))
+ (test (bac4 3) 37)))
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac1 a)
+ `(+ ,x y ,a)) ; -> (+ 32 y x)
+ (let ((x 32) (y 64))
+ (test (bac1 x) 128))) ; x=32
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac2 a)
+ (with-let (sublet (funclet bac2) (cons 'a a))
+ `(+ ,x y ,a))) ; (+ 1 y x)
+ (let ((x 32) (y 64))
+ (test (bac2 x) 97))) ; x=32
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac3 a)
+ (with-let (sublet (funclet bac3) (cons 'a a))
+ (eval `(+ ,x y ,a)))) ; (eval (+ 1 2 1)) -> 4
+ (let ((x 32) (y 64))
+ (test (bac3 x) 4))) ; x=1
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac4 a)
+ (eval `(+ ,x y ,a) (sublet (funclet bac4) (cons 'a a))))
+ ; (eval (+ 32 2 1)) -> 35
+ (let ((x 32) (y 64))
+ (test (bac4 x) 35))) ; x=1
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac3 a)
+ (let ((e (with-let (sublet (funclet bac3) (cons 'a a))
+ `(+ ,x y ,a))))
+ `(with-let ,(sublet (funclet bac3) (cons 'a a))
+ ,e)))
+ (let ((x 32) (y 64))
+ (test (bac3 3) 6)))
+
+ (let ((x 1) (y 2))
+ (define-bacro (bac4 a)
+ (let ((e `(+ ,x y ,a)))
+ `(with-let ,(sublet (funclet bac4) (cons 'a a))
+ ,e)))
+ (let ((x 32) (y 64))
+ (test (bac4 3) 37))))
- (for-each
- (lambda (arg)
- (test (procedure-source arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
-
- (test (procedure-documentation) 'error)
- (test (procedure-documentation abs abs) 'error)
- (test (procedure-arity) 'error)
- (test (procedure-arity abs abs) 'error)
- (test (procedure-source) 'error)
- (test (procedure-source abs abs) 'error)
- (test (procedure-source quasiquote) 'error)
- (test (let () (define-macro (hi a) `(+ 1 ,a)) (cadr (caddr (procedure-source hi)))) '(lambda (a) ({list} '+ 1 a)))
-
- (let ((p (make-procedure-with-setter (lambda (a) (+ a 1)) (lambda (a b) (+ a b)))))
- (test (object->string (procedure-source p)) "(lambda (a) (+ a 1))")
- (let ((p1 p)
- (p2 (make-procedure-with-setter (lambda (a) "pws doc" (+ a 1)) (lambda (a b) (+ a b)))))
- (test (equal? p p1) #t)
- (test (equal? p1 p2) #f)
- (test (procedure-documentation p2) "pws doc")
- (test (apply p2 '(2)) 3)))
-
- (test (procedure-documentation hook-functions) "(hook-functions hook) returns the list of functions on the hook. It is settable; (set! (hook-functions hook) (cons func (hook-functions hook))) adds func to the current list.")
-
- (test (make-list 0) '())
- (test (make-list 0 123) '())
- (test (make-list 1) '(#f))
- (test (make-list 1 123) '(123))
- (test (make-list 1 '()) '(()))
- (test (make-list 2) '(#f #f))
- (test (make-list 2 1) '(1 1))
- (test (make-list 2/1 1) '(1 1))
- (test (make-list 2 (make-list 1 1)) '((1) (1)))
- (test (make-list -1) 'error)
- (test (make-list -0) '())
- (test (make-list most-negative-fixnum) 'error)
- (test (make-list most-positive-fixnum) 'error)
+(let () ; need this, else the define-macro below leaks into rootlet
+ (let ((e (inlet
+ 'mac (apply define-macro
+ (list (list (gensym) 'a) '`(+ ,a 1))))))
+ (test ((e 'mac) 3) 4)))
+
+(let ()
+ (define-macro (swap a b)
+ `(with-let (inlet :e (curlet) :tmp ,a)
+ (set! (e ',a) (e ',b))
+ (set! (e ',b) tmp)))
- (for-each
- (lambda (arg)
- (test (make-list arg) 'error))
- (list #\a '#(1 2 3) 3.14 3/4 1.0+1.0i 0.0 1.0 '() #t 'hi '#(()) (list 1 2 3) '(1 . 2) "hi" (- (real-part (log 0.0)))))
+ (let ((a 1) (b 2)) (swap b a) (test (list a b) '(2 1)))
+ (let ((tmp 1) (b 2)) (swap b tmp) (test (list tmp b) '(2 1)))
+ (let ((a 1) (tmp 2)) (swap a tmp) (test (list a tmp) '(2 1)))
+ (let ((tmp 1) (b 2)) (swap tmp b) (test (list tmp b) '(2 1)))
+ (let ((a 1) (tmp 2)) (swap tmp a) (test (list a tmp) '(2 1))))
- (for-each
- (lambda (arg)
- (test ((make-list 1 arg) 0) arg))
- (list #\a '#(1 2 3) 3.14 3/4 1.0+1.0i '() #f 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
-
- (test (make-list) 'error)
- (test (make-list 1 2 3) 'error)
- (test (let ((lst (make-list 2 (make-list 1 0)))) (eq? (lst 0) (lst 1))) #t)
-
-
- (test (let () (defmacro hiho (a) `(+ ,a 1)) (hiho 3)) 4)
- (test (let () (defmacro hiho () `(+ 3 1)) (hiho)) 4)
- (test (let () (defmacro hiho () `(+ 3 1)) (hiho 1)) 'error)
- (test (let () (defmacro hi (a) `(+ , at a)) (hi (1 2 3))) 6)
- (test (let () (defmacro hi (a) `(+ ,a 1) #f) (hi 2)) #f)
-
- (test (let () (define-macro (hiho a) `(+ ,a 1)) (hiho 3)) 4)
- (test (let () (define-macro (hiho) `(+ 3 1)) (hiho)) 4)
- (test (let () (define-macro (hiho) `(+ 3 1)) (hiho 1)) 'error)
- (test (let () (define-macro (hi a) `(+ , at a)) (hi (1 2 3))) 6)
- (test (let () (define-macro (hi a) `(+ ,a 1) #f) (hi 2)) #f)
- (test (let () (define-macro (mac1 a) `',a) (equal? (mac1 (+ 1 2)) '(+ 1 2))) #t)
- (test (let () (define-macro (hi . a) `, at a) (hi 1)) 1)
-
- (test (let () (defmacro hi (a) `(+ , a 1)) (hi 1)) 2)
- (test (let () (defmacro hi (a) `(eval `(+ ,,a 1))) (hi 1)) 2)
- (test (let () (defmacro hi (a) `(eval (let ((a 12)) `(+ ,,a 1)))) (hi 1)) 2)
- (test (let () (defmacro hi (a) `(eval (let ((a 12)) `(+ ,a 1)))) (hi 1)) 13)
- (test (let () (defmacro hi (a) `(eval (let ((a 12)) `(let ((a 100)) (+ ,a 1))))) (hi 1)) 13)
- (test (let () (defmacro hi (a) `(eval (let ((a 12)) `(let ((a 100)) (+ a 1))))) (hi 1)) 101)
-
- (test (let () (defmacro hi (q) ``(,,q)) (hi (* 2 3))) '(6))
- (test (let () (defmacro hi (q) `(let ((q 32)) `(,,q))) (hi (* 2 3))) '(6))
- (test (let () (defmacro hi (q) `(let ((q 32)) `(,q))) (hi (* 2 3))) '(32))
- (test (let () (defmacro hi (q) `(let () ,@(list q))) (hi (* 2 3))) 6)
-
- (test (let () (define-macro (tst a) ``(+ 1 ,,a)) (tst 2)) '(+ 1 2))
- (test (let () (define-macro (tst a) ```(+ 1 ,,,a)) (eval (tst 2))) '(+ 1 2))
- (test (let () (define-macro (tst a) ``(+ 1 ,,a)) (tst (+ 2 3))) '(+ 1 5))
- (test (let () (define-macro (tst a) ``(+ 1 ,@,a)) (tst '(2 3))) '(+ 1 2 3))
- (test (let () (define-macro (tst a) ``(+ 1 ,, at a)) (tst (2 3))) '(+ 1 2 3))
- (test (let () (define-macro (tst a) ```(+ 1 ,,, at a)) (eval (tst (2 3)))) '(+ 1 2 3))
- (test (let () (define-macro (tst a) ```(+ 1 ,,@, at a)) (eval (tst ('(2 3))))) '(+ 1 2 3))
- (test (let () (define-macro (tst a) ````(+ 1 ,,,, at a)) (eval (eval (eval (tst (2 3)))))) 6)
- (test (let () (define-macro (tst a) ``(+ 1 ,@, at a)) (tst ('(2 3)))) '(+ 1 2 3))
- (test (let () (define-macro (tst a b) `(+ 1 ,a (apply * `(2 ,, at b)))) (tst 3 (4 5))) 44)
- (test (let () (define-macro (tst . a) `(+ 1 , at a)) (tst 2 3)) 6)
- (test (let () (define-macro (tst . a) `(+ 1 , at a (apply * `(2 ,, at a)))) (tst 2 3)) 18)
- (test (let () (define-macro (tst a) ```(+ 1 ,@,@, at a)) (eval (tst ('('(2 3)))))) '(+ 1 2 3))
-
- (test (let () (define-macro (hi a) `(+ ,a 1)) (procedure? hi)) #f)
- (test (let () (define-macro (hi a) `(let ((@ 32)) (+ @ ,a))) (hi @)) 64)
- (test (let () (define-macro (hi @) `(+ 1 ,@@)) (hi (2 3))) 6) ; ,@ is ambiguous
- (test (let () (define-macro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4)
- (test (let () (define-macro (hi a) (if (list? a) `(+ 1 , at a) `(+ 1 ,a))) (* (hi 1) (hi (2 3)))) 12)
-
- (test (let ((x 1)) (eval `(+ 3 ,x))) 4)
- (test (let ((x 1)) (eval (eval `(let ((x 2)) `(+ 3 ,x ,,x))))) 6)
- (test (let ((x 1)) (eval (eval (eval `(let ((x 2)) `(let ((x 3)) `(+ 10 ,x ,,x ,,,x))))))) 16)
- (test (let ((x 1)) (eval (eval (eval (eval `(let ((x 2)) `(let ((x 3)) `(let ((x 30)) `(+ 100 ,x ,,x ,,,x ,,,,x))))))))) 136)
-
- (test (let () (define-bacro (hiho a) `(+ ,a 1)) (hiho 3)) 4)
- (test (let () (define-bacro (hiho) `(+ 3 1)) (hiho)) 4)
- (test (let () (define-bacro (hiho) `(+ 3 1)) (hiho 1)) 'error)
- (test (let () (define-bacro (hi a) `(+ , at a)) (hi (1 2 3))) 6)
- (test (let () (define-bacro (hi a) `(+ ,a 1) #f) (hi 2)) #f)
- (test (let () (define-bacro (mac1 a) `',a) (equal? (mac1 (+ 1 2)) '(+ 1 2))) #t)
- (test (let () (define-bacro (tst a) ``(+ 1 ,,a)) (tst 2)) '(+ 1 2))
- (test (let () (define-bacro (tst a) ```(+ 1 ,,,a)) (eval (tst 2))) '(+ 1 2))
- (test (let () (define-bacro (tst a) ``(+ 1 ,,a)) (tst (+ 2 3))) '(+ 1 5))
- (test (let () (define-bacro (tst a) ``(+ 1 ,@,a)) (tst '(2 3))) '(+ 1 2 3))
- (test (let () (define-bacro (tst a) ``(+ 1 ,, at a)) (tst (2 3))) '(+ 1 2 3))
- (test (let () (define-bacro (tst a) ```(+ 1 ,,, at a)) (eval (tst (2 3)))) '(+ 1 2 3))
- (test (let () (define-bacro (tst a) ```(+ 1 ,,@, at a)) (eval (tst ('(2 3))))) '(+ 1 2 3))
- (test (let () (define-bacro (tst a) ````(+ 1 ,,,, at a)) (eval (eval (eval (tst (2 3)))))) 6)
- (test (let () (define-bacro (tst a) ``(+ 1 ,@, at a)) (tst ('(2 3)))) '(+ 1 2 3))
- (test (let () (define-bacro (tst a b) `(+ 1 ,a (apply * `(2 ,, at b)))) (tst 3 (4 5))) 44)
- (test (let () (define-bacro (tst . a) `(+ 1 , at a)) (tst 2 3)) 6)
- (test (let () (define-bacro (tst . a) `(+ 1 , at a (apply * `(2 ,, at a)))) (tst 2 3)) 18)
- (test (let () (define-bacro (tst a) ```(+ 1 ,@,@, at a)) (eval (tst ('('(2 3)))))) '(+ 1 2 3))
- (test (let () (define-bacro (hi a) `(+ ,a 1)) (procedure? hi)) #f)
- (test (let () (define-bacro (hi a) `(let ((@ 32)) (+ @ ,a))) (hi @)) 64)
- (test (let () (define-bacro (hi @) `(+ 1 ,@@)) (hi (2 3))) 6) ; ,@ is ambiguous
- (test (let () (define-bacro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4)
- (test (let () (define-bacro (hi a) (if (list? a) `(+ 1 , at a) `(+ 1 ,a))) (* (hi 1) (hi (2 3)))) 12)
-
- (test (let () (define-bacro (hiho a) `(+ ,a 1)) (macro? hiho)) #t)
- (test (let () (define-bacro* (hiho (a 1)) `(+ ,a 1)) (macro? hiho)) #t)
- (test (let () (define-macro (hiho a) `(+ ,a 1)) (macro? hiho)) #t)
- (test (let () (define-macro* (hiho (a 1)) `(+ ,a 1)) (macro? hiho)) #t)
+(let ()
+ (define-macro (swap a b)
+ `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a)
+ (with-let e (set! ,a ,b))
+ tmp)))
- (let ()
- (define-macro (i_ arg)
- `(with-environment (initial-environment) ,arg))
+ (test (let ((v (vector 1 2))) (swap (v 0) (v 1)) v) #(2 1))
+ (test (let ((tmp (cons 1 2))) (swap (car tmp) (cdr tmp)) tmp) '(2 . 1))
- (define-bacro* (mac b)
- `((i_ let) ((a 12))
- ((i_ +) a ,(symbol->value b))))
- ;; this assumes the 'b' value is a symbol
- ;; (let ((a 1)) (mac (* a 2))) is an error
- ;; use eval, not symbol->value to generalize it
+ (define-macro (set-swap a b c) `(set! ,b ,c))
+ (set! (procedure-setter swap) set-swap)
- (test (let ((a 32)
- (+ -))
- (mac a))
- 44))
+ (test (let ((a 1) (b 2) (c 3) (d 4)) (swap a (swap b (swap c d))) (list a b c d)) '(2 3 4 1))
-#|
- (define-macro (when test . body)
- `((apply lambda (list '(test) '(if test (let () , at body)))) ,test))
+ (define-macro (rotate . args)
+ `(set! ,(args (- (length args) 1))
+ (with-let (inlet 'e (curlet) 'tmp ,(car args))
+ (with-let e
+ ,@(map (lambda (a b) `(set! ,a ,b)) args (cdr args)))
+ tmp)))
+
+ (test (let ((a 1) (b 2) (c 3)) (rotate a b c) (list a b c)) '(2 3 1))
- (define-macro (when test . body)
- `(if ,test (let () , at body)))
+ (define-macro (mac a) `(+ ,a 1))
+ (define-macro* (mac1 (a 32)) `(+ ,a 1))
- (define-macro (when test . body)
- `((lambda (test) (if test (let () , at body))) ,test))
+ (define-macro (fm form)
+ (define (expand form)
+ (if (pair? form)
+ (if (and (symbol? (car form))
+ (macro? (symbol->value (car form))))
+ (expand (apply macroexpand (list form)))
+ (if (and (eq? (car form) 'set!)
+ (pair? (cdr form))
+ (pair? (cadr form))
+ (macro? (symbol->value (caadr form))))
+ (expand (apply (eval (procedure-source (procedure-setter (symbol->value (caadr form)))))
+ (append (cdadr form) (cddr form))))
+ (cons (expand (car form))
+ (expand (cdr form)))))
+ form))
+ (list 'quote (expand form)))
+
+ (test (fm (mac 2)) '(+ 2 1))
+ (test (fm (mac x)) '(+ x 1))
+ (test (fm (mac1 2)) '(+ 2 1))
+ (test (fm (mac1)) '(+ 32 1))
+ (test (fm (mac (mac1))) '(+ (+ 32 1) 1))
+ (test (fm (+ (mac x) (mac1 y))) '(+ (+ x 1) (+ y 1)))
+ (test (fm (swap a b)) '(set! b (with-let (inlet 'e (curlet) 'tmp a) (with-let e (set! a b)) tmp)))
+ (test (fm (swap a (swap b c))) '(set! c (with-let (inlet 'e (curlet) 'tmp a) (with-let e (set! a (set! c (with-let (inlet 'e (curlet) 'tmp b) (with-let e (set! b c)) tmp)))) tmp)))
+ (test (fm (rotate a b c)) '(set! c (with-let (inlet 'e (curlet) 'tmp a) (with-let e (set! a b) (set! b c)) tmp)))
+ )
- (define-macro (when test . body)
- `(let ((func (apply lambda `(() ,, at body))))
- (if ,test (func))))
+#|
+;;; would this work in MIT-scheme?
+(define-macro (swap a b)
+ `(set! ,b (eval `(let ((e ,(the-environment)))
+ (eval `(set! ,',',a ,',',b) e)
+ tmp)
+ (let ((e (the-environment))
+ (tmp ,a))
+ (the-environment)))))
|#
- (test (defmacro) 'error)
- (test (define-macro) 'error)
- (test (defmacro 1 2 3) 'error)
- (test (define-macro (1 2) 3) 'error)
- (test (defmacro a) 'error)
- (test (define-macro (a)) 'error)
- (test (defmacro a (1) 2) 'error)
- (test (define-macro (a 1) 2) 'error)
- (test (defmacro . a) 'error)
- (test (define-macro . a) 'error)
- (test (define :hi 1) 'error)
- (test (define hi: 1) 'error)
- (test (define-macro (:hi a) `(+ ,a 1)) 'error)
- (test (defmacro :hi (a) `(+ ,a 1)) 'error)
- (test (defmacro hi (1 . 2) 1) 'error)
- (test (defmacro hi 1 . 2) 'error)
- (test (defmacro : "" . #(1)) 'error)
- (test (defmacro : #(1) . :) 'error)
- (test (defmacro hi ()) 'error)
- (test (define-macro (mac . 1) 1) 'error)
- (test (define-macro (mac 1) 1) 'error)
- (test (define-macro (a #()) 1) 'error)
- (test (define-macro (i 1) => (j 2)) 'error)
- (test (define hi 1 . 2) 'error)
- (test (defmacro hi hi . hi) 'error)
- (test (define-macro (hi hi) . hi) 'error)
- (test (((lambda () (define-macro (hi a) `(+ 1 ,a)) hi)) 3) 4)
-
- (test (let () (define-macro (hi a b) `(list , at a . , at b)) (hi (1 2) ((2 3)))) '(1 2 2 3))
- (test (let () (define-macro (hi a b) `(list , at a . ,b)) (hi (1 2) (2 3))) '(1 2 2 3))
- (test (let () (define-macro (hi a b) `(list , at a , at b)) (hi (1 2) (2 3))) '(1 2 2 3))
-
- (let ((vals #(0 0)))
- (let ()
- (define (hi a) (+ 1 a))
- (define (use-hi b) (hi b))
- (set! (vals 0) (use-hi 1))
- (define (hi a) (+ 2 a))
- (set! (vals 1) (use-hi 1))
- (test vals #(2 3)))
- (let ()
- (defmacro hi (a) `(+ 1 ,a))
- (define (use-hi b) (hi b))
- (set! (vals 0) (use-hi 1))
- (defmacro hi (a) `(+ 2 ,a))
- (set! (vals 1) (use-hi 1))
- (test vals #(2 3)))
- (let ()
- (define (use-hi b) (hhi b))
- (defmacro hhi (a) `(+ 1 ,a))
- (set! (vals 0) (use-hi 1))
- (defmacro hhi (a) `(+ 2 ,a))
- (set! (vals 1) (use-hi 1))
- (test vals #(2 3))))
+(let ()
+ ;; how to protect a recursive macro call from being stepped on
+ ;; (define-macro (mac a b) `(if (> ,b 0) (let ((,a (- ,b 1))) (mac ,a (- ,b 1))) ,b))
+ ;; (mac mac 1)
+ ;; attempt to apply the integer 0 to (0 1)?
+ ;; (mac mac 1)
+ (define-macro (mac a b)
+ (let ((gmac (gensym)))
+ (set! gmac mac)
+ `(if (> ,b 0)
+ (let ((,a (- ,b 1)))
+ (,gmac ,a (- ,b 1)))
+ ,b)))
+ (test (mac mac 10) 0))
- (test (let ()
- (define-macro (hanger name-and-args)
- `(define ,(car name-and-args)
- (+ ,@(map (lambda (arg) arg) (cdr name-and-args)))))
- (hanger (hi 1 2 3))
- hi)
- 6)
- (test (let ()
- (define-macro (hanger name-and-args)
- `(define-macro (,(car name-and-args))
- `(+ ,@(map (lambda (arg) arg) (cdr ',name-and-args)))))
- (hanger (hi 1 2 3))
- (hi))
- 6)
+(let ()
+ (define-bacro* (incf var (inc 1)) `(set! ,var (+ ,var ,inc)))
+ (define-bacro* (decf var (inc 1)) `(set! ,var (- ,var ,inc)))
- (let ()
- ;; inspired by Doug Hoyte, "Let Over Lambda"
- (define (mcxr path lst)
- (define (cxr-1 path lst)
- (if (null? path)
- lst
- (if (char=? (car path) #\a)
- (cxr-1 (cdr path) (car lst))
- (cxr-1 (cdr path) (cdr lst)))))
- (let ((p (string->list (symbol->string path))))
- (if (char=? (car p) #\c)
- (set! p (cdr p)))
- (let ((p (reverse p)))
- (if (char=? (car p) #\r)
- (set! p (cdr p)))
- (cxr-1 p lst))))
-
- (test (mcxr 'cr '(1 2 3)) '(1 2 3))
- (test (mcxr 'cadddddddr '(1 2 3 4 5 6 7 8)) 8)
- (test (mcxr 'caadadadadadadadr '(1 (2 (3 (4 (5 (6 (7 (8))))))))) 8)
-
- (define-macro (cxr path lst)
- (let ((p (string->list (symbol->string path))))
- (if (char=? (car p) #\c)
- (set! p (cdr p)))
- (let ((p (reverse p)))
- (if (char=? (car p) #\r)
- (set! p (cdr p)))
- (let ((func 'arg))
- (for-each
- (lambda (f)
- (set! func (list (if (char=? f #\a) 'car 'cdr) func)))
- p)
- `((lambda (arg) ,func) ,lst)))))
-
- (test (cxr car '(1 2 3)) 1)
- (test (cxr cadddddddr '(1 2 3 4 5 6 7 8)) 8)
- (test (cxr caadadadadadadadr '(1 (2 (3 (4 (5 (6 (7 (8))))))))) 8)
- )
+ (test (let ((x 0)) (incf x)) 1)
+ (test (let ((x 1.5)) (incf x 2.5) x) 4.0)
+ (test (let ((x 10)) (decf x (decf x 1)) x) 1)
- ;; this is the best of them!
- (let ()
- (define-macro (c?r path)
- ;; here "path" is a list and "X" marks the spot in it that we are trying to access
- ;; (a (b ((c X)))) -- anything after the X is ignored, other symbols are just placeholders
- ;; c?r returns a function that gets X
+ ;; ! -- left to right order I think (let ((x 10)) (set! x (- x (set! x (- x 1))))) so the 3rd x is 10
+ ;; Clisp and sbcl return 0: (let ((x 10)) (decf x (decf x (decf x))) x) is also 0
+ ;; but in clisp (let ((x 10)) (setf x (- x (setf x (- x 1)))) x) is 1
+ ;; I didn't know these cases were different
+ ;; (let ((x 10)) (set! x (- x (let () (set! x (- x 1)) x))) x) 1, Guile also says 1
+ ;; cltl2 p 134ff is an unreadable discussion of this, but I think it says in this case CL goes right to left
+ ;; weird! in CL (decf x (decf x)) != (setf x (- x (setf x (- x 1))))
+ ;; and (let ((x 10)) (let ((val (decf x))) (decf x val) x))?
+ ;; so by adhering to one evaluation order, we lose "referential transparency"?
- ;; maybe ... for cdr? (c?r (a ...); right now it's using dot: (c?r (a . X)) -> cdr
-
- ;; (c?r (a b X)) -> caddr,
- ;; (c?r (a (b X))) -> cadadr
- ;; ((c?r (a a a X)) '(1 2 3 4 5 6)) -> 4
- ;; ((c?r (a (b c X))) '(1 (2 3 4))) -> 4
- ;; ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 6
- ;; ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 4
- ;; (procedure-source (c?r (((((a (b (c (X (e f))))))))))) -> (lambda (lst) (car (car (cdr (car (cdr (car (cdr (car (car (car (car lst))))))))))))
-
- (define (X-marks-the-spot accessor tree)
- (if (pair? tree)
- (or (X-marks-the-spot (cons 'car accessor) (car tree))
- (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
- (if (eq? tree 'X)
- accessor
- #f)))
-
- (let ((accessor (X-marks-the-spot '() path)))
- (if (not accessor)
- (error "can't find the spot! ~A" path)
- (let ((len (length accessor)))
- (if (< len 5) ; it's a built-in function
- (let ((name (make-string (+ len 2))))
- (set! (name 0) #\c)
- (set! (name (+ len 1)) #\r)
- (do ((i 0 (+ i 1))
- (a accessor (cdr a)))
- ((= i len))
- (set! (name (+ i 1)) (if (eq? (car a) 'car) #\a #\d)))
- (string->symbol name))
- (let ((body 'lst)) ; make a new function to find the spot
- (for-each
- (lambda (f)
- (set! body (list f body)))
- (reverse accessor))
- `(lambda (lst) ,body)))))))
-
- (test ((c?r (a b X)) (list 1 2 3 4)) 3)
- (test ((c?r (a (b X))) '(1 (2 3) ((4)))) 3)
- (test ((c?r (a a a X)) '(1 2 3 4 5 6)) 4)
- (test ((c?r (a (b c X))) '(1 (2 3 4))) 4)
- (test ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 6)
- (test ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 4))
+ (test (let ((x 1+i)) (decf x 0+i)) 1.0))
- (let ()
- (define-macro (nested-for-each args func . lsts)
- (let ((body `(,func , at args)))
- (for-each
- (lambda (arg lst)
- (set! body `(for-each
- (lambda (,arg)
- ,body)
- ,lst)))
- args lsts)
- body))
-
- ;;(nested-for-each (a b) + '(1 2) '(3 4)) ->
- ;; (for-each (lambda (b) (for-each (lambda (a) (+ a b)) '(1 2))) '(3 4))
-
- (define-macro (nested-map args func . lsts)
- (let ((body `(,func , at args)))
- (for-each
- (lambda (arg lst)
- (set! body `(map
- (lambda (,arg)
- ,body)
- ,lst)))
- args lsts)
- body))
-
- ;;(nested-map (a b) + '(1 2) '(3 4))
- ;; ((4 5) (5 6))
- ;;(nested-map (a b) / '(1 2) '(3 4))
- ;; ((1/3 2/3) (1/4 1/2))
+(let ()
- (test (nested-map (a b) + '(1 2) '(3 4)) '((4 5) (5 6)))
- (test (nested-map (a b) / '(1 2) '(3 4)) '((1/3 2/3) (1/4 1/2)))
- )
-
- (let ()
- (define-macro (define-curried name-and-args . body)
- `(define ,@(let ((newlst `(begin , at body)))
- (define (rewrap lst)
- (if (pair? (car lst))
- (begin
- (set! newlst (cons 'lambda (cons (cdr lst) (list newlst))))
- (rewrap (car lst)))
- (list (car lst) (list 'lambda (cdr lst) newlst))))
- (rewrap name-and-args))))
-
- (define-curried (((((f a) b) c) d) e) (* a b c d e))
- (test (((((f 1) 2) 3) 4) 5) 120)
- (define-curried (((((f a b) c) d e) f) g) (* a b c d e f g))
- (test (((((f 1 2) 3) 4 5) 6) 7) 5040)
- (define-curried (((foo)) x) (+ x 34))
- (test (((foo)) 300) 334)
- (define-curried ((foo-1) x) (+ x 34))
- (test ((foo-1) 200) 234)
- )
+ ;; (define-bacro* (incf var (inc 1)) (set! var (+ (eval var) (eval inc))))
+ ;; this form does not actually set the incoming variable (it sets the argument)
+ ;; at OP_SET we see set (var (+ (eval var) (eval inc)))
+ ;; set1 var 1
+ ;; which leaves x unset
+ ;; but below we see set (x 1)
+ ;; set1 x 1
+ (define-bacro* (incf var (inc 1)) (apply set! var (+ (eval var) (eval inc)) ()))
+ (define-bacro* (decf var (inc 1)) (apply set! var (- (eval var) (eval inc)) ()))
-
- (define-macro (eval-case key . clauses)
- ;; case with evaluated key-lists
- `(cond ,@(map (lambda (lst)
- (if (pair? (car lst))
- (cons `(member ,key (list ,@(car lst)))
- (cdr lst))
- lst))
- clauses)))
+ (test (let ((x 0)) (incf x)) 1)
+ (test (let ((x 1.5)) (incf x 2.5) x) 4.0)
+ (test (let ((x 10)) (decf x (decf x 1)) x) 1)
+ (test (let ((x 1+i)) (decf x 0+i)) 1.0))
- (test (let ((a 1) (b 2)) (eval-case 1 ((a) 123) ((b) 321) (else 0))) 123)
- (test (let ((a 1) (b 2) (c 3)) (eval-case 3 ((a c) 123) ((b) 321) (else 0))) 123)
- (test (let ((a 1) (b 2)) (eval-case 3 ((a) 123) ((b) 321) (((+ a b)) -1) (else 0))) -1)
- (test (let ((a 1) (b 2)) (eval-case 6 ((a (* (+ a 2) b)) 123) ((b) 321) (((+ a b)) -1) (else 0))) 123)
- (test (let ()
- (define (set-cadr! a b)
- (set-car! (cdr a) b)
- b)
- (let ((lst (list 1 2 3)))
- (set-cadr! lst 32)
- lst))
- '(1 32 3))
-
- (test (macro? eval-case) #t)
- (test (macro? pi) #f)
- (test (macro? quasiquote) #t) ; s7_define_macro in s7.c
- (test (let ((m quasiquote)) (macro? m)) #t)
- (test (macro? macroexpand) #t)
- ;; not ideal: (let () (define (hi a) (+ a 1)) (macroexpand (hi 2))) ->
- ;; ;+ argument 1, (hi 2), is pair but should be a number
- ;; ; (+ a 1)
- (for-each
- (lambda (arg)
- (test (macro? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() car abs (lambda () 1) #2d((1 2) (3 4)) _ht_ #f 'hi '#(()) (list 1 2 3) '(1 . 2) "hi"))
- (test (macro?) 'error)
-
- (define-macro (fully-expand form)
- (define (expand form)
- ;; walk form looking for macros, expand any that are found
- (if (pair? form)
- (if (macro? (car form))
- (expand ((eval (procedure-source (car form))) form))
- (cons (expand (car form))
- (expand (cdr form))))
- form))
- (expand form))
-
- (define fe1-called #f)
- (define-macro (fe1 a) (set! fe1-called #t) `(+ ,a 1))
- (define fe2-called #f)
- (define-macro (fe2 b) (set! fe2-called #f) `(+ (fe1 ,b) 2))
- (fully-expand (define (fe3 c) (+ (fe2 c) (fe1 (+ c 1)))))
- (set! fe1-called #f)
- (set! fe2-called #f)
- (let ((val (fe3 3)))
- (if (or (not (= val 11))
- fe1-called
- fe2-called)
- (format #t "fully-expand: ~A ~A ~A ~A~%" val (procedure-source fe3) fe1-called fe2-called)))
+(let ()
+ (define-macro (and-call function . args)
+ ;; apply function to each arg, stopping if returned value is #f
+ `(and ,@(map (lambda (arg) `(,function ,arg)) args)))
- (test (let ()
- (define-macro (pop sym)
- (let ((v (gensym "v")))
- `(let ((,v (car ,sym)))
- (set! ,sym (cdr ,sym))
- ,v)))
- (let ((lst (list 1 2 3)))
- (let ((val (pop lst)))
- (and (= val 1)
- (equal? lst (list 2 3))))))
- #t)
+ (let ((lst ()))
+ (and-call (lambda (a) (and a (set! lst (cons a lst)))) (+ 1 2) #\a #f (format-logged #t "oops!~%"))
+ (test lst (list #\a 3))))
- (define-macro (destructuring-bind lst expr . body)
- `(let ((ex ,expr))
-
- (define (flatten lst)
- (cond ((null? lst) '())
- ((pair? lst)
- (if (pair? (car lst))
- (append (flatten (car lst)) (flatten (cdr lst)))
- (cons (car lst) (flatten (cdr lst)))))
- (#t lst)))
-
- (define (structures-equal? l1 l2)
- (if (pair? l1)
- (and (pair? l2)
- (structures-equal? (car l1) (car l2))
- (structures-equal? (cdr l1) (cdr l2)))
- (not (pair? l2))))
-
- (if (not (structures-equal? ',lst ex))
- (error "~A and ~A do not match" ',lst ex))
-
- (let ((names (flatten ',lst))
- (vals (flatten ex)))
- (apply (eval (list 'lambda names ', at body)) vals))))
-
- (test (destructuring-bind (a b) (list 1 2) (+ a b)) 3)
- (test (destructuring-bind ((a) b) (list (list 1) 2) (+ a b)) 3)
- (test (destructuring-bind (a (b c)) (list 1 (list 2 3)) (+ a b c)) 6)
- (test (let ((x 1)) (destructuring-bind (a b) (list x 2) (+ a b))) 3)
-
- (defmacro once-only (names . body)
- (let ((gensyms (map (lambda (n) (gensym)) names)))
- `(let (,@(map (lambda (g) `(,g (gensym))) gensyms))
- `(let (,,@(map (lambda (g n) ``(,,g ,,n)) gensyms names))
- ,(let (,@(map (lambda (n g) `(,n ,g)) names gensyms))
- , at body)))))
+(let ()
+ (define-macro (add a . b)
+ `(if (null? ',b)
+ ,a
+ (+ ,a (add , at b))))
+ (test (add 1 2 3) 6)
+ (test (add 1 (add 2 3) 4) 10))
- (let ()
- (defmacro hiho (start end)
- (once-only (start end)
- `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
-
- (test (let ((ctr 0))
- (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
- (let () (set! ctr (+ ctr 1)) ctr))))
- (list ctr lst)))
- '(2 (1 2 3 4))))
-
- (define-bacro (once-only-1 names . body)
- `(let (,@(map (lambda (name) `(,name ,(eval name))) names))
- , at body))
+(let ()
+ (define mac (let ((var (gensym)))
+ (define-macro (mac-inner b)
+ `(#_let ((,var 12)) (#_+ ,var ,b)))
+ mac-inner))
+ (test (mac 1) 13)
+ (test (let ((a 1)) (mac a)) 13))
+
+(test (eq? call/cc #_call/cc) #t)
+
+(let ((val #f))
+ (define-macro (add-1 var)
+ `(+ 1 (let ()
+ (set! val ',var)
+ ,var)))
+ (define (add-2 var)
+ (set! val var)
+ (+ 1 var))
+ (let ((free #t))
+ (let ((res ((if free add-1 add-2) (+ 1 2 3))))
+ (if (or (not (equal? val '(+ 1 2 3)))
+ (not (= res 7)))
+ (format-logged #t ";mac/proc[#t]: ~A ~A~%" val res)))
+ (set! free #f)
+ (let ((res ((if free add-1 add-2) (+ 1 2 3))))
+ (if (or (not (equal? val '6))
+ (not (= res 7)))
+ (format-logged #t ";mac/proc[#f]: ~A ~A~%" val res)))))
+
+;; define-macro* default arg expr does not see definition-time closure:
+(test (let ((mac #f))
+ (let ((a 32))
+ (define-macro* (hi (b (+ a 1))) `(+ ,b 2))
+ (set! mac hi))
+ (mac))
+ 'error) ; ";a: unbound variable, line 4"
+
+(test ((lambda* ((x (let ()
+ (define-macro (hi a)
+ `(+ ,a 1))
+ (hi 2))))
+ (+ x 1)))
+ 4)
+(test (let ()
+ (define-macro* (hi (x (let ()
+ (define-macro (hi a)
+ `(+ ,a 1))
+ (hi 2))))
+ `(+ ,x 1))
+ (hi))
+ 4)
- (let ()
- (define-bacro (hiho start end)
- (once-only-1 (start end)
- `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
-
- (test (let ((ctr 0))
- (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
- (let () (set! ctr (+ ctr 1)) ctr))))
- (list ctr lst)))
- '(2 (1 2 3 4))))
-
- (defmacro with-gensyms (names . body)
- `(let ,(map (lambda (n) `(,n (gensym))) names)
- , at body))
+(test (let () (define* (hi b) b) (procedure? hi)) #t)
- (define-macro (define-clean-macro name-and-args . body)
- ;; the new backquote implementation breaks this slightly -- it's currently confused about unquoted nil in the original
- (let ((syms ()))
-
- (define (walk func lst)
- (if (and (func lst)
- (pair? lst))
- (begin
- (walk func (car lst))
- (walk func (cdr lst)))))
-
- (define (car-member sym lst)
- (if (null? lst)
- #f
- (if (eq? sym (caar lst))
- (cdar lst)
- (car-member sym (cdr lst)))))
-
- (define (walker val)
- (if (pair? val)
- (if (eq? (car val) 'quote)
- (or (car-member (cadr val) syms)
- (and (pair? (cadr val))
- (or (and (eq? (caadr val) 'quote) ; 'sym -> (quote (quote sym))
- val)
- (append (list 'list)
- (walker (cadr val)))))
- (cadr val))
- (cons (walker (car val))
- (walker (cdr val))))
- (or (car-member val syms)
- val)))
-
- (walk (lambda (val)
- (if (and (pair? val)
- (eq? (car val) 'quote)
- (symbol? (cadr val))
- (not (car-member (cadr val) syms)))
- (set! syms (cons
- (cons (cadr val)
- (gensym (symbol->string (cadr val))))
- syms)))
- (or (not (pair? val))
- (not (eq? (car val) 'quote))
- (not (pair? (cadr val)))
- (not (eq? (caadr val) 'quote))))
- body)
-
- (let* ((new-body (walker body))
- (new-syms (map (lambda (slot)
- (list (cdr slot) '(gensym)))
- syms))
- (new-globals
- (let ((result '()))
- (for-each
- (lambda (slot)
- (if (defined? (car slot))
- (set! result (cons
- (list 'set! (cdr slot) (car slot))
- result))))
- syms)
- result)))
-
- `(define-macro ,name-and-args
- (let ,new-syms
- , at new-globals
- `(begin ,, at new-body))))))
-
-
- (define-macro (define-immaculo name-and-args . body)
- (let* ((gensyms (map (lambda (g) (gensym)) (cdr name-and-args)))
- (args (cdr (copy name-and-args)))
- (name (car name-and-args))
- (set-args (map (lambda (a g) `(list ',g ,a)) args gensyms))
- (get-args (map (lambda (a g) `(quote (cons ',a ,g))) args gensyms))
- (blocked-args (map (lambda (a) `(,a ',a)) args))
- (new-body (list (eval `(let (, at blocked-args) , at body)))))
- `(define-macro ,name-and-args
- `(let ,(list , at set-args)
- ,(list 'with-environment
- (append (list 'augment-environment)
- (list (list 'procedure-environment ,name))
- (list , at get-args))
- ', at new-body)))))
-
- (test (let ()
- (define-clean-macro (hi a) `(+ ,a 1))
- (hi 1))
- 2)
-
- (test (let ()
- (define-immaculo (hi a) `(+ ,a 1))
- (hi 1))
- 2)
-
- (test (let ()
- (define-clean-macro (hi a) `(+ ,a 1))
- (let ((+ *)
- (a 12))
- (hi a)))
- 13)
-
- (test (let ()
- (define-immaculo (hi a) `(+ ,a 1))
- (let ((+ *)
- (a 12))
- (hi a)))
- 13)
-
-;; define-clean-macro is making no-longer-correct assumptions about quasiquote -- I think I'll just put these aside
-; (test (let ()
-; (define-clean-macro (hi a) `(let ((b 23)) (+ b ,a)))
-; (hi 2))
-; 25)
+(test (let ()
+ (define (hi a) a)
+ (let ((tag (catch #t
+ (lambda () (hi 1 2 3))
+ (lambda args (car args)))))
+ (eq? tag 'wrong-number-of-args)))
+ #t)
+
+(test (let ()
+ (define (hi a) a)
+ (let ((tag (catch #t
+ (lambda () (hi))
+ (lambda args (car args)))))
+ (eq? tag 'wrong-number-of-args)))
+ #t)
+
+(test (let ()
+ (define* (hi a) a)
+ (let ((tag (catch #t
+ (lambda () (hi 1 2 3))
+ (lambda args (car args)))))
+ (eq? tag 'wrong-number-of-args)))
+ #t)
+
+(let ()
+ ;; shouldn't this be let-if or let-if-and, not if-let?
+ ;; and why not add short-circuiting to it (at the variable bindings point)?
+ ;; not pretty, but we could do this via and-call + sublet
+ ;; maybe use and-let* instead
+ (define-macro* (if-let bindings true false)
+ (let* ((binding-list (if (and (pair? bindings) (symbol? (car bindings)))
+ (list bindings)
+ bindings))
+ (variables (map car binding-list)))
+ `(let ,binding-list
+ (if (and , at variables)
+ ,true
+ ,false))))
+
+ (test (if-let ((a 1) (b 2)) (list a b) "oops") '(1 2)))
+
+(let ()
+ (defmacro old-and-let* (vars . body) ; from guile/1.8/ice-9/and-let-star.scm
+
+ (define (expand vars body)
+ (cond
+ ((null? vars)
+ (if (null? body)
+ #t
+ `(begin , at body)))
+ ((pair? vars)
+ (let ((exp (car vars)))
+ (cond
+ ((pair? exp)
+ (cond
+ ((null? (cdr exp))
+ `(and ,(car exp) ,(expand (cdr vars) body)))
+ (else
+ (let ((var (car exp)))
+ `(let (,exp)
+ (and ,var ,(expand (cdr vars) body)))))))
+ (else
+ `(and ,exp ,(expand (cdr vars) body))))))
+ (else
+ (error "not a proper list" vars))))
+
+ (expand vars body))
+
+ (test (old-and-let* ((hi 3) (ho #f)) (+ hi 1)) #f))
+
+(let ()
+ (define-macro (and-let* vars . body)
+ `(let ()
+ (and ,@(map (lambda (var)
+ `(apply define ',var))
+ vars)
+ (begin , at body))))
+
+ (test (and-let* ((hi 3) (ho #f)) (+ hi 1)) #f)
+ (test (and-let* ((hi 3) (ho #t)) (+ hi 1)) 4))
+
+
+(let () ; from the pro CL mailing list
+ (define-macro (do-leaves var tree . body)
+ `(let ()
+ (define (rec ,var)
+ (if (not (null? ,var))
+ (if (pair? ,var)
+ (begin
+ (rec (car ,var))
+ (rec (cdr ,var)))
+ (begin
+ , at body))))
+ (rec ,tree)))
+
+ (test (let ((lst ()))
+ (do-leaves hiho '(+ 1 (* 2 3))
+ (set! lst (cons hiho lst)))
+ (reverse lst))
+ '(+ 1 * 2 3)))
+
+
+(test (let () (define (hi :a) :a) (hi 1)) 'error)
+(test (let () (define* (hi :a) :a) (hi 1)) 'error)
+(test (let () (define* (hi (:a 2)) a) (hi 1)) 'error)
+(test (let () (define* (hi (a 1) (:a 2)) a) (hi 1)) 'error)
+(test (let () (define* (hi (pi 1)) pi) (hi 2)) 'error)
+(test (let () (define* (hi (:b 1) (:a 2)) a) (hi)) 'error)
+
+(test (let () (define* (hi (a 1) (a 2)) a) (hi 2)) 'error)
+(test (let () (define (hi a a) a) (hi 1 2)) 'error)
+(test (let () (define hi (lambda (a a) a)) (hi 1 1)) 'error)
+(test (let () (define hi (lambda* ((a 1) (a 2)) a)) (hi 1 2)) 'error)
+(test (let () (define (hi (a 1)) a) (hi 1)) 'error)
+
+(test (let ((_?_0 #f))
+ (set! (symbol-access '_?_0) (lambda args #f))
+ (define-macro (_?_0 a) `(+ ,a 1))
+ (_?_0 2))
+ 'error)
+
+(test (let ((_?_1 #f))
+ (set! (symbol-access '_?_1) (lambda args 'error))
+ (define-macro (_?_1 a) `(+ ,a 1))
+ (_?_1 2))
+ 'error)
+
+(test (let ((_?_2 #f))
+ (set! (symbol-access '_?_2) (lambda (s v) v))
+ (define-macro (_?_2 a) `(+ ,a 1))
+ (_?_2 2))
+ 3)
+
+(let ()
+ (define* (hi (a #2d((1 2) (3 4)))) (a 1 0))
+ (test (hi) 3)
+ (test (hi #2d((7 8) (9 10))) 9))
+
+(let () (define* (f :rest a) a) (test (f :a 1) '(:a 1)))
+(let () (define* (f :rest a :rest b) (list a b)) (test (f :a 1 :b 2) '((:a 1 :b 2) (1 :b 2))))
+
+(test (lambda :hi 1) 'error)
+(test (lambda (:hi) 1) 'error)
+(test (lambda (:hi . :hi) 1) 'error)
+(test (lambda (i . i) 1 . 2) 'error)
+(test (lambda (i i i i) (i)) 'error)
+(test (lambda "hi" 1) 'error)
+(test (lambda* ((i 1) i i) i) 'error)
+(test (lambda* ((a 1 2)) a) 'error)
+(test (lambda* ((a . 1)) a) 'error)
+(test (lambda* ((0.0 1)) 0.0) 'error)
+
+(test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32) '(32 1 ()))
+(test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5) '(1 3 (2 3 4 5)))
+;; these are in s7.html
+(test ((lambda* ((a 1) :rest b :rest c) (list a b c)) 1 2 3 4 5) '(1 (2 3 4 5) (3 4 5)))
+(test (let () (define-macro (hi a a) `(+ ,a 1)) (hi 1 2)) 'error)
+(test (let ((c 1)) (define* (a (b c)) b) (set! c 2) (a)) 2)
+(test (let ((c 1)) (define* (a (b c)) b) (let ((c 32)) (a))) 1)
+(test (let ((c 1)) (define* (a (b (+ c 1))) b) (set! c 2) (a)) 3)
+(test (let ((c 1)) (define* (a (b (+ c 1))) b) (set! c 2) (let ((c 123)) (a))) 3)
+
+(test (let* ((cc 1)
+ (c (lambda () (set! cc (+ cc 1)) cc)))
+ (define* (a (b (c))) b)
+ (list cc (a) cc))
+ (list 1 2 2))
+
+(let ()
+ (define* (func (val ((lambda (a) (+ a 1)) 2))) val)
+ (test (func) 3)
+ (test (func 1) 1))
+
+(let ()
+ (define-macro (mac-free-x y)
+ `(set! x ,y))
- (test (let ()
- (define-immaculo (hi a) `(let ((b 23)) (+ b ,a)))
- (hi 2))
- 25)
+ (define (mac-y1)
+ (let ((x .1))
+ (do ((i 0 (+ i 1))
+ (y 0.5 (+ y x)))
+ ((= i 10) y)
+ (if (= i 2)
+ (mac-free-x 1.1)))))
-; (test (let ()
-; (define-clean-macro (hi a) `(let ((b 23)) (+ b ,a)))
-; (let ((+ *)
-; (b 12))
-; (hi b)))
-; 35)
+ (define (mac-y0)
+ (let ((x .1))
+ (do ((i 0 (+ i 1))
+ (y 0.5 (+ y x)))
+ ((= i 10) y)
+ (if (= i 2)
+ (set! x 1.1)))))
- (test (let ()
- (define-immaculo (hi a) `(let ((b 23)) (+ b ,a)))
- (let ((+ *)
- (b 12))
- (hi b)))
- 35)
+ (define-macro (mac-free-v)
+ `(v 1))
-; (test (let ()
-; (define-clean-macro (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d))))
-; (mac 2 3))
-; 360)
+ (define-macro (set-mac-free-v z)
+ `(vector-set! v 1 ,z))
- (test (let ()
- (define-immaculo (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d))))
- (mac 2 3))
- 360)
+ (set! (procedure-setter mac-free-v) set-mac-free-v)
-; (test (let ()
-; (define-clean-macro (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d))))
-; (let ((c 2)
-; (d 3))
-; (mac c d)))
-; 360)
+ (define (mac-y2)
+ (let ((v (vector 1.0 0.1 1.2)))
+ (do ((i 0 (+ i 1))
+ (y 0.5 (+ y (vector-ref v 1))))
+ ((= i 10) y)
+ (if (= i 2)
+ (set! (mac-free-v) 1.1)))))
- (test (let ()
- (define-immaculo (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d))))
- (let ((c 2)
- (d 3))
- (mac c d)))
- 360)
+ (define (mac-y3)
+ (let ((v (vector 1.0 0.1 1.2)))
+ (do ((i 0 (+ i 1))
+ (y 0.5 (+ y (vector-ref v 1))))
+ ((= i 10) y)
+ (if (= i 2)
+ (vector-set! v 1 1.1)))))
- (test (let ()
- (define-clean-macro (mac a . body)
- `(+ ,a , at body))
- (mac 2 3 4))
- 9)
+ (let ((y0 (mac-y0))
+ (y1 (mac-y1))
+ (y2 (mac-y2))
+ (y3 (mac-y3)))
+ (if (not (morally-equal? y0 y1))
+ (format-logged #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y0 y1))
+ (if (not (morally-equal? y2 y3))
+ (format-logged #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y2 y2 y3)))
- (test (let ()
- (define-clean-macro (mac a . body)
- `(+ ,a , at body))
- (let ((a 2)
- (+ *))
- (mac a (- 5 a) (* a 2))))
- 9)
+ (let ((y (+ (mac-y0) (mac-y1) (mac-y2) (mac-y3))))
+ (if (> (abs (- y (* 4 9.5))) 1e-9)
+ (format-logged #t "(2) ~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y (* 4 9.5)))))
- (test (let ()
- (define-clean-macro (mac) (let ((a 1)) `(+ ,a 1)))
- (mac))
- 2)
- (test (let ()
- (define-immaculo (mac) (let ((a 1)) `(+ ,a 1)))
- (mac))
- 2)
- (test (let ()
- (define-immaculo (hi a) `(list 'a ,a))
- (hi 1))
- (list 'a 1))
- (test (let ()
- (define-immaculo (mac c d) `(let ((a 12) (b 3)) (+ a b ,c ,d)))
- (let ((a 21) (b 10) (+ *)) (mac a b)))
- 46)
-
-; (test (let ((values 32)) (define-macro (hi a) `(+ 1 , at a)) (hi (2 3))) 6)
-; (test (let ((list 32)) (define-macro (hi a) `(+ 1 , at a)) (hi (2 3))) 6)
-; (test (let () (define-macro (hi a) `(let ((apply 32)) (+ apply , at a))) (hi (2 3))))
- (test (let () (define-macro (hi a) `(+ 1 (if ,(= a 0) 0 (hi ,(- a 1))))) (hi 3)) 4)
- (test (let () (define-macro (hi a) `(+ 1 ,a)) ((if #t hi abs) -3)) -2)
- (test (let () (apply define-macro '((m a) `(+ 1 ,a))) (m 2)) 3)
- (test (let () (apply (eval (apply define-macro '((m a) `(+ 1 ,a)))) '(3))) 4)
- (test (let () (apply (eval (apply define '((hi a) (+ a 1)))) '(2))) 3)
- (test (let () ((eval (apply define '((hi a) (+ a 1)))) 3)) 4)
- (test (let () ((eval (apply define-macro '((m a) `(+ 1 ,a)))) 3)) 4)
- (test (let () ((symbol->value (apply define '((hi a) (+ a 1)))) 3)) 4)
- (test (let () ((symbol->value (apply define-macro '((m a) `(+ 1 ,a)))) 3)) 4)
- (test (let ()
- (define-macro (mu args . body)
- (let ((m (gensym)))
- `(symbol->value (apply define-macro '((,m , at args) , at body)))))
- ((mu (a) `(+ 1 ,a)) 3))
- 4)
- (test (let () (define-macro (hi a) `(+ 1 ,a)) (map hi '(1 2 3))) 'error)
- (test (let () (define-macro (hi a) `(+ ,a 1)) (apply hi '(4))) 5)
- (test (let ()
- (define-macro (hi a) `(+ ,a 1))
- (define (fmac mac) (apply mac '(4)))
- (fmac hi))
- 5)
- (test (let ()
- (define (make-mac)
- (define-macro (hi a) `(+ ,a 1))
- hi)
- (let ((x (make-mac)))
- (x 2)))
- 3)
-
- (define-macro* (_mac1_) `(+ 1 2))
- (test (_mac1_) 3)
- (define-macro* (_mac2_ a) `(+ ,a 2))
- (test (_mac2_ 1) 3)
- (test (_mac2_ :a 2) 4)
- (define-macro* (_mac3_ (a 1)) `(+ ,a 2))
- (test (_mac3_) 3)
- (test (_mac3_ 3) 5)
- (test (_mac3_ :a 0) 2)
- (define-macro* (_mac4_ (a 1) (b 2)) `(+ ,a ,b))
- (test (_mac4_) 3)
- (test (_mac4_ :b 3) 4)
- (test (_mac4_ 2 :b 3) 5)
- (test (_mac4_ :b 10 :a 12) 22)
- (test (_mac4_ :a 4) 6)
-
- (define-bacro* (_mac21_) `(+ 1 2))
- (test (_mac21_) 3)
- (define-bacro* (_mac22_ a) `(+ ,a 2))
- (test (_mac22_ 1) 3)
- (test (_mac22_ :a 2) 4)
- (define-bacro* (_mac23_ (a 1)) `(+ ,a 2))
- (test (_mac23_) 3)
- (test (_mac23_ 3) 5)
- (test (_mac23_ :a 0) 2)
- (define-bacro* (_mac24_ (a 1) (b 2)) `(+ ,a ,b))
- (test (_mac24_) 3)
- (test (_mac24_ :b 3) 4)
- (test (_mac24_ 2 :b 3) 5)
- (test (_mac24_ :b 10 :a 12) 22)
- (test (_mac24_ :a 4) 6)
-
- (defmacro* _mac11_ () `(+ 1 2))
- (test (_mac11_) 3)
- (defmacro* _mac12_ (a) `(+ ,a 2))
- (test (_mac12_ 1) 3)
- (test (_mac12_ :a 2) 4)
- (defmacro* _mac13_ ((a 1)) `(+ ,a 2))
- (test (_mac13_) 3)
- (test (_mac13_ 3) 5)
- (test (_mac13_ :a 0) 2)
- (defmacro* _mac14_ ((a 1) (b 2)) `(+ ,a ,b))
- (test (_mac14_) 3)
- (test (_mac14_ :b 3) 4)
- (test (_mac14_ 2 :b 3) 5)
- (test (_mac14_ :b 10 :a 12) 22)
- (test (_mac14_ :a 4) 6)
-
- (define-bacro (symbol-set! var val) `(set! ,(symbol->value var) ,val))
- (test (let ((x 32) (y 'x)) (symbol-set! y 123) (list x y)) '(123 x))
-
- (define-bacro (symbol-eset! var val) `(set! ,(eval var) ,val))
- (test (let ((x '(1 2 3)) (y `(x 1))) (symbol-eset! y 123) (list x y)) '((1 123 3) (x 1)))
- (test (let ((x #(1 2 3)) (y `(x 1))) (symbol-eset! y 123) (list x y)) '(#(1 123 3) (x 1)))
+;;; --------------------------------------------------------------------------------
+;;; aritable?
- (let ()
- (define-macro (hi a) `````(+ ,,,,,a 1))
- (test (eval (eval (eval (eval (hi 2))))) 3)
+(for-each
+ (lambda (arg)
+ (if (aritable? arg 0)
+ (format-logged #t ";(aritable? ~A) -> #t?~%" arg)))
+ (list :hi (integer->char 65) 1 #t 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified>))
- (define-macro (hi a) `(+ ,@@a))
- (test (hi (1 2 3)) 'error)
+(for-each
+ (lambda (arg)
+ (let ((val (catch #t (lambda () (aritable? abs arg)) (lambda args 'error))))
+ (if (not (eq? val 'error))
+ (format-logged #t ";(aritable? abs ~A) -> ~A?~%" arg val))))
+ (list :hi (integer->char 65) -1 most-negative-fixnum macroexpand quasiquote (lambda () #f)
+ car #() "hi" (list 1 2) 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified>))
+
+(test (aritable?) 'error)
+(test (aritable? abs) 'error)
+
+(test (aritable? car 0) #f)
+(test (aritable? car 1) #t)
+(test (aritable? car 2) #f)
+(test (aritable? car 3) #f)
+(test (aritable? car most-negative-fixnum) 'error)
+(test (aritable? car most-positive-fixnum) #f)
+(test (aritable? + most-positive-fixnum) #t)
+(test (aritable? + 0) #t)
+(test (aritable? log 2) #t)
+(test (aritable? catch 2) #f)
+(test (aritable? set! 0) #f)
+(test (aritable? begin 0) #t)
+(test (aritable? (random-state 123) 0) #f)
+;;; more tests under arity
+
+(test (let () (define-macro (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 2)) #f)
+(test (let () (define-macro (mac1 a b . c) `(+ ,a ,b)) (aritable? mac1 2)) #t)
+(test (let () (define-bacro (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 1)) #f)
+(test (let () (define-bacro (mac1 a b . c) `(+ ,a ,b)) (aritable? mac1 3)) #t)
+(test (let () (defmacro mac1 (a b c) `(+ ,a ,b)) (aritable? mac1 4)) #f)
+(test (let () (defmacro mac1 (a b . c) `(+ ,a ,b)) (aritable? mac1 2)) #t)
+(test (let () (define-macro (mac1 a) `(+ 1 ,a)) (aritable? mac1 0)) #f)
+
+(test (let () (define-macro* (mac1 . a) `(+ ,a ,b)) (aritable? mac1 3)) #t)
+(test (let () (define-macro* (mac1 a) `(+ 1 ,a)) (aritable? mac1 0)) #t)
+
+(test (let () (define-macro* (mac1 a :rest b) `(+ 1 ,a)) (aritable? mac1 21)) #t)
+(test (let () (define-macro* (mac1 a . b) `(,a , at b)) (aritable? mac1 4)) #t)
+(test (let () (define-macro* (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 2)) #t)
+
+(test (aritable? "hiho" 0) #f)
+(test (aritable? "" 1) #f)
+(test (aritable? () 0) #f)
+(test (aritable? #() 1) #f)
+(test (aritable? #(1 2 3) 0) #f)
+(test (aritable? #(1 2 3) -1) 'error)
+(test (aritable? #(1 2 3) 1) #t)
+(test (aritable? #(1 2 3) 2) #f)
+(test (aritable? (hash-table '(a . 1)) 1) #t)
+(test (aritable? (hash-table '(a . 1)) 2) #f)
+(test (aritable? (curlet) 1) #t)
+(test (let () (call-with-exit (lambda (goto) (aritable? goto 1)))) #t)
+(test (aritable? (make-iterator (hash-table '(a . 1))) 0) #t)
+(test (aritable? (make-iterator (hash-table '(a . 1))) 1) #f)
+(test (aritable? "" 0) #f)
+(test (aritable? "12" 2) #f)
+(test (aritable? "12" 1) #t)
+(test (aritable? #() 0) #f) ; since (#() 0) or any other arg is an error
+(test (aritable? #2d((1 2) (3 4)) 0) #f)
+(test (aritable? #2d((1 2) (3 4)) 1) #t)
+(test (aritable? #2d((1 2) (3 4)) 2) #t)
+(test (aritable? #2d((1 2) (3 4)) 3) #f)
+(test (aritable? '((1 2) (3 4)) 2) #f)
+
+(test (aritable? '(1 2 . 3) 9223372036854775806) #f)
+(test (aritable? #2D((1 3) (2 4)) 9223372036854775807) #f)
+(test (aritable? '2 1) #f)
+(test (aritable? ''2 1) #t)
- (define-macro (hi @a) `(+ ,@@a))
- (test (hi (1 2 3)) 6))
- (let ((old-readers *#readers*))
+;;; --------------------------------------------------------------------------------
+;;; arity
- ;; testing *#readers* is slightly tricky because the reader runs before we evaluate the test expression
- ;; so in these cases, the new reader use is always in a string
+(test (arity) 'error)
+(test (arity abs 1) 'error)
- (set! *#readers* (list (cons #\s (lambda (str) 123))))
- (let ((val (eval-string "(+ 1 #s1)"))) ; force this into the current reader
- (test val 124))
- (set! *#readers* '())
+(for-each
+ (lambda (arg)
+ (if (arity arg)
+ (format-logged #t ";(arity ~A) -> ~A?~%" arg (arity arg))))
+ (list :hi (integer->char 65) 1 #t 3.14 3/4 1.0+1.0i #\f #<eof> #<unspecified> #<undefined> () 'a))
- (set! *#readers*
- (cons (cons #\t (lambda (str)
- (string->number (substring str 1) 12)))
- *#readers*))
- (num-test (string->number "#tb") 11)
- (num-test (string->number "#t11.3") 13.25)
- (num-test (string->number "#e#t11.3") 53/4)
- (num-test (string->number "#t#e1.5") 17/12)
- (num-test (string->number "#i#t1a") 22.0)
- (num-test (string->number "#t#i1a") 22.0) ; ??? this is analogous to #x#i1a = 26.0
- (num-test (string->number "#t#t1a") 22.0)
- (num-test (string->number "#t#t#t1a") 22.0)
- (test (eval-string "#t") #t)
- (test (eval-string "#T1") 'error)
-
- (set! *#readers*
- (cons (cons #\. (lambda (str)
- (if (string=? str ".") (eval (read)) #f)))
- *#readers*))
-
- (test (eval-string "'(1 2 #.(* 3 4) 5)") '(1 2 12 5))
- (num-test (string->number "#t1a") 22)
- (test (eval-string "'(1 #t(2))") '(1 #t (2)))
- (test (string->number "#t1r") #f)
-
- (set! *#readers* (list (cons #\t (lambda (str)
- ;; in the duplicated case: "t#t..."
- (if (< (length str) 3)
- (string->number (substring str 1) 12)
- (and (not (char=? (str 1) #\#))
- (not (char=? (str 2) #\t))
- (string->number (substring str 1) 12)))))))
- (test (string->number "#t#t1a") #f)
-
- (set! *#readers* (cons (cons #\x (lambda (str)
- (or (if (< (length str) 3)
- (string->number (substring str 1) 7)
- (and (not (char=? (str 1) #\#))
- (not (char=? (str 2) #\x))
- (string->number (substring str 1) 7)))
- 'error)))
- *#readers*))
-
- (num-test (string->number "#x12") 9)
- (num-test (string->number "#x-142.1e-1") -11.30612244898)
- (num-test (string->number "#e#x-142.1e-1") -554/49)
- (num-test (string->number "#t460.88") 648.72222222222)
- (num-test (string->number "#e#ta.a") 65/6)
- (num-test (string->number "#x1") 1)
- (test (string->number "#te") #f)
- (num-test (string->number "#x10") 7)
- (test (string->number "#x17") #f)
- (num-test (string->number "#x106") 55)
- (test (string->number "#x#t1") #f)
- (let ()
- (define (read-in-radix str radix)
- ;; no error checking, only integers
- (define (char->digit c)
- (cond ((char-numeric? c)
- (- (char->integer c) (char->integer #\0)))
- ((char-lower-case? c)
- (+ 10 (- (char->integer c) (char->integer #\a))))
- (#t
- (+ 10 (- (char->integer c) (char->integer #\A))))))
- (let* ((negative (char=? (str 0) #\-))
- (len (length str))
- (j (if (or negative (char=? (str 0) #\+)) 2 1))) ; 1st char is "z"
- (do ((sum (char->digit (str j))
- (+ (* sum radix) (char->digit (str j)))))
- ((= j (- len 1)) sum)
- (set! j (+ j 1)))))
-
- (set! *#readers* (list (cons #\z (lambda (str) (read-in-radix str 32)))))
- (num-test (string->number "#z1p") 57)
- )
-
- (let ((p1 (make-procedure-with-setter (lambda (str) (string->number (substring str 1) 12)) (lambda (a) a))))
- (set! *#readers* (list (cons #\t p1)))
- (num-test (string->number "#ta") 10)
- (num-test (string->number "#t11.6") 13.5)
- (num-test (string->number "#e#t11.6") 27/2))
+#|
+(let ((choices (list "a " "b " " . " ":rest " ":allow-other-keys ")))
+ (define (next-arg expr)
+ (catch #t
+ (lambda ()
+ ;(format #t "expr: ~A~%" expr)
+ (let ((func (eval-string expr)))
+ (let ((min-max (arity func)))
+ (format #t "(test (arity ~A) ~70T'~A)~%" expr min-max)
+ (if (> (cdr min-max) 6)
+ (set! (cdr min-max) 6))
+ (do ((i 0 (+ i 1)))
+ ((= i (car min-max)))
+ (if (aritable? func i)
+ (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i)))
+ (do ((i (car min-max) (+ i 1)))
+ ((> i (cdr min-max)))
+ (if (not (aritable? func i))
+ (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i)))
+ (do ((i (+ 1 (cdr min-max)) (+ i 1)))
+ ((>= i 6))
+ (if (aritable? func i)
+ (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i)))
+ )))
+ (lambda args
+ ;(format #t " ~A: ~A~%" expr (apply format #f (cadr args)))
+ 'error)))
- (set! *#readers* old-readers)
-
- (num-test (string->number "#x106") 262)
- (num-test (string->number "#x17") 23)
- )
+ (define (next-choice str n)
+ (next-arg (string-append str ") #f)"))
+ (if (< n 6)
+ (for-each
+ (lambda (choice)
+ (next-choice (string-append str choice) (+ n 1)))
+ choices)))
-;;; (call-with-exit (lambda (exit) (set! *#readers* (cons (cons #\p (lambda (str) (exit 23))) *#readers*)) #p123))
-
- (begin
- (define-macro (hi a) `(+ ,a 1))
- (test (hi 2) 3)
- (let ()
- (define (ho b) (+ 1 (hi b)))
- (test (ho 1) 3))
- (let ((hi 32))
- (test (+ hi 1) 33))
- (letrec ((hi (lambda (a) (if (= a 0) 0 (+ 2 (hi (- a 1)))))))
- (test (hi 3) 6))
- (letrec* ((hi (lambda (a) (if (= a 0) 0 (+ 2 (hi (- a 1)))))))
- (test (hi 3) 6))
- (test (equal? '(hi 1) (quote (hi 1))) #t)
- (test (list? '(hi 1)) #t)
- (test (list? '(((hi 1)))) #t)
- (test (equal? (vector (hi 1)) '#(2)) #t)
- (test (symbol? (vector-ref '#(hi) 0)) #t))
-
- (define-macro (define-with-goto name-and-args . body)
- ;; run through the body collecting label accessors, (label name)
- ;; run through getting goto positions, (goto name)
- ;; tie all the goto's to their respective labels (via set-cdr! essentially)
-
- (define (find-accessor type)
- (let ((labels '()))
- (define (gather-labels accessor tree)
- (if (pair? tree)
- (if (equal? (car tree) type)
- (begin
- (set! labels (cons (cons (cadr tree)
- (let ((body 'lst))
- (for-each
- (lambda (f)
- (set! body (list f body)))
- (reverse (cdr accessor)))
- (make-procedure-with-setter
- (apply lambda '(lst) (list body))
- (apply lambda '(lst val) `((set! ,body val))))))
- labels))
- (gather-labels (cons 'cdr accessor) (cdr tree)))
- (begin
- (gather-labels (cons 'car accessor) (car tree))
- (gather-labels (cons 'cdr accessor) (cdr tree))))))
- (gather-labels '() body)
- labels))
- (let ((labels (find-accessor 'label))
- (gotos (find-accessor 'goto)))
- (if (not (null? gotos))
- (for-each
- (lambda (goto)
- (let* ((name (car goto))
- (goto-accessor (cdr goto))
- (label (assoc name labels))
- (label-accessor (and label (cdr label))))
- (if label-accessor
- (set! (goto-accessor body) (label-accessor body))
- (error 'bad-goto "can't find label: ~S" name))))
- gotos))
- `(define ,name-and-args
- (let ((label (lambda (name) #f))
- (goto (lambda (name) #f)))
- , at body))))
-
- (let ()
- (define-with-goto (g1 a)
- (let ((x 1))
- (if a
- (begin
- (set! x 2)
- (goto 'the-end)
- (set! x 3))
- (set! x 4))
- (label 'the-end)
- x))
-
- (define-with-goto (g2 a)
- (let ((x a))
- (label 'start)
- (if (< x 4)
- (begin
- (set! x (+ x 1))
- (goto 'start)))
- x))
-
- (test (g1 #f) 4)
- (test (g1 #t) 2)
- (test (g2 1) 4)
- (test (g2 32) 32))
+ (for-each
+ (lambda (choice)
+ (next-arg (string-append "(lambda* " choice "#f)")))
+ choices)
-
- (let ()
- (define special-value
- (let ((type (make-type)))
- ((cadr type) 'special)))
-
- (test (eq? special-value special-value) #t)
- (test (eqv? special-value special-value) #t)
- (test (equal? special-value special-value) #t)
- (test (procedure? special-value) #f)
- (for-each
- (lambda (arg)
- (test (or (eq? arg special-value)
- (eqv? arg special-value)
- (equal? arg special-value))
- #f))
- (list "hi" -1 #\a 1 'special 3.14 3/4 1.0+1.0i #f #t '(1 . 2) #<unspecified> #<undefined>))
+ (next-choice "(lambda* (" 0))
+|#
- (begin
- (define rec? #f)
- (define make-rec #f)
- (define rec-a #f)
- (define rec-b #f)
-
- (let* ((rec-type (make-type))
- (? (car rec-type))
- (make (cadr rec-type))
- (ref (caddr rec-type)))
-
- (set! make-rec (lambda* ((a 1) (b 2))
- (make (vector a b))))
-
- (set! rec? (lambda (obj)
- (? obj)))
-
- (set! rec-a (make-procedure-with-setter
- (lambda (obj)
- (and (rec? obj)
- (vector-ref (ref obj) 0)))
- (lambda (obj val)
- (if (rec? obj)
- (vector-set! (ref obj) 0 val)))))
-
- (set! rec-b (make-procedure-with-setter
- (lambda (obj)
- (and (rec? obj)
- (vector-ref (ref obj) 1)))
- (lambda (obj val)
- (if (rec? obj)
- (vector-set! (ref obj) 1 val)))))))
-
- (let ((hi (make-rec 32 '(1 2))))
- (test (rec? hi) #t)
- (test (equal? hi hi) #t)
- (test (rec? 32) #f)
- (test (rec-a hi) 32)
- (test (rec-b hi) '(1 2))
- (set! (rec-b hi) 123)
- (test (rec-b hi) 123)
- (let ((ho (make-rec 32 '(1 2))))
- (test (eq? hi ho) #f)
- (test (eqv? hi ho) #f)
- (test (equal? hi ho) #f)
- (set! (rec-b ho) 123)
- (test (equal? hi ho) #t))
- (let ((ho (make-rec 123 '())))
- (test (eq? hi ho) #f)
- (test (eqv? hi ho) #f)
- (test (equal? hi ho) #f))
- (test (copy hi) 'error)
- (test (fill! hi 1.0) 'error)
- (test (object->string hi) "#<anonymous-type #(32 123)>")
- (test (length hi) 'error)
- (test (reverse hi) 'error)
- (test (for-each abs hi) 'error)
- (test (map abs hi) 'error)
- (test (hi 1) 'error)
- (test (set! (hi 1) 2) 'error)
- )
+(test (arity (lambda a a)) (cons 0 *max-arity*))
+(test (arity (define (_m_ . a) a)) (cons 0 *max-arity*))
+(test (arity (lambda (a . b) a)) (cons 1 *max-arity*))
+(test (arity (define (_m_ a . b) a)) (cons 1 *max-arity*))
+(test (arity (lambda (a b . c) a)) (cons 2 *max-arity*))
+(test (arity (define (_m_ a b . c) a)) (cons 2 *max-arity*))
+(test (arity (define* (a b . c) a)) (cons 0 *max-arity*))
+(test (arity (define-macro (_m_ a . b) a)) (cons 1 *max-arity*))
+
+(test (arity (lambda* a #f)) (cons 0 *max-arity*))
+(test (arity (lambda* () #f)) '(0 . 0))
+(test (arity (lambda* (a ) #f)) '(0 . 1))
+(test (arity (lambda* (a b ) #f)) '(0 . 2))
+(test (arity (lambda* (a b :allow-other-keys ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (a . b ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (a :rest b ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (a :rest b :allow-other-keys ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (a :allow-other-keys ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a b ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a b :allow-other-keys ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a . b ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a :rest b ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a :rest b :allow-other-keys ) #f)) (cons 0 *max-arity*))
+(test (arity (lambda* (:rest a :allow-other-keys ) #f)) (cons 0 *max-arity*))
+
+(test (arity (define* (__a_ . a) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_) #f)) '(0 . 0))
+(test (arity (define* (__a_ a) #f)) '(0 . 1))
+(test (arity (define* (__a_ a b) #f)) '(0 . 2))
+(test (arity (define* (__a_ a b :allow-other-keys) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ a . b) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ a :rest b) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ a :rest b :allow-other-keys) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ a :allow-other-keys) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a b) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a b :allow-other-keys) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a . b) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a :rest b) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a :rest b :allow-other-keys) #f)) (cons 0 *max-arity*))
+(test (arity (define* (__a_ :rest a :allow-other-keys) #f)) (cons 0 *max-arity*))
- (let ((typo (make-type :equal (lambda (a b) (equal? a b)))))
- (let ((a ((cadr typo) 123))
- (b ((cadr typo) 321))
- (c ((cadr typo) 123)))
- (test (procedure? a) #f)
- (test (equal? a b) #f)
- (test (eq? a a) #t)
- (test (eq? a b) #f)
- (test (eqv? a a) #t)
- (test (eqv? a b) #f)
- (test (equal? a c) #t)
- (test (equal? b c) #f)))
-
- (test (let ((typo (make-type :equal (lambda (a b) (= (abs (- a b)) 2)))))
- (let ((a ((cadr typo) 1))
- (b ((cadr typo) 3))
- (c ((cadr typo) 1)))
- (and (equal? a b)
- (not (equal? a c))
- (equal? b c))))
- #t)
+#|
+(let ((st (symbol-table)))
+ (for-each
+ (lambda (sym)
+ (if (defined? sym)
+ (let ((func (symbol->value sym)))
+
+ (catch #t
+ (lambda ()
+ (let ((min-max (arity func)))
+ (format-logged #t "(test (arity ~A) ~70T'~A)~%" sym min-max)
+ (if min-max
+ (begin
+ (if (> (cdr min-max) 6)
+ (set! (cdr min-max) 6))
+ (do ((i 0 (+ i 1)))
+ ((= i (car min-max)))
+ (if (aritable? func i)
+ (format-logged #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+ (do ((i (car min-max) (+ i 1)))
+ ((> i (cdr min-max)))
+ (if (not (aritable? func i))
+ (format-logged #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+ (do ((i (+ 1 (cdr min-max)) (+ i 1)))
+ ((>= i 6))
+ (if (aritable? func i)
+ (format-logged #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i)))
+ ))))
+
+ (lambda args
+ (format-logged #t " ~A: ~A~%" sym (apply format #f (cadr args)))
+ 'error)))))
+ st))
+|#
- (test (((cadr (make-type :getter (lambda (a b) (vector-ref a b)))) (vector 1 2 3)) 1) 2)
- (test (((cadr (make-type :getter (lambda (a b) (+ 100 (vector-ref a b))))) (vector 1 2 3)) 1) 102)
- (test (length ((cadr (make-type :length (lambda (a) (vector-length a)))) (vector 1 2 3))) 3)
- (test (length ((cadr (make-type :length (lambda (a) (+ 100 (vector-length a))))) (vector 1 2 3))) 103)
- (test (string=? (object->string ((cadr (make-type)) 1)) "#<anonymous-type 1>") #t)
- (test (string=? (object->string ((cadr (make-type :name "hiho")) 123)) "#<hiho 123>") #t)
- (test (string=? (object->string ((cadr (make-type :print (lambda (a) (format #f "#<typo: ~A>" a)))) 1)) "#<typo: 1>") #t)
-
- (test (let* ((type (make-type :setter (lambda (a b c) (vector-set! a b c))))
- (t? (car type))
- (make-t (cadr type))
- (t-ref (caddr type))
- (newt (make-t (vector 1 2 3))))
- (set! (newt 1) 123)
- (vector-ref (t-ref newt) 1))
- 123)
-
- (let ((rec1 (make-type))
- (rec2 (make-type)))
- (let ((rec1? (car rec1))
- (rec2? (car rec2))
- (make-rec1 (cadr rec1))
- (make-rec2 (cadr rec2))
- (rec1-ref (caddr rec1))
- (rec2-ref (caddr rec2)))
- (let ((r1 (make-rec1 123))
- (r2 (make-rec2 123)))
- (test (and (rec1? r1)
- (rec2? r2)
- (not (rec1? r2))
- (not (rec2? r1))
- (= (rec1-ref r1) (rec2-ref r2)))
- #t))))
-
- (let ((rec3? (car (make-type)))
- (rec4? (car (make-type #f))))
- (for-each
- (lambda (arg)
- (test (rec3? arg) #f)
- (test (rec4? arg) #f))
- (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t '(1 . 2))))
-
- (test (number? ((cadr (make-type #f #f)) 0)) #f)
- (test ((cadr (make-type :name 123))) 'error)
- (test ((cadr (make-type :length "hiho"))) 'error)
- (test ((cadr (make-type :print (lambda (a b) (= a b)))) "hi") 'error)
- (test ((cadr (make-type :length (lambda () 1))) "hi") 'error)
- (test (length ((cadr (make-type :length (lambda (a) (+ 1 a)))) (vector 1 2 3))) 'error)
- (test (call-with-exit (lambda (exit) (length ((cadr (make-type :length (lambda (a) (exit 32)))) 1)))) 32)
- (test (call-with-exit (lambda (exit) (fill! ((cadr (make-type :fill (lambda (a n) (exit 32)))) 1) 0))) 32)
-
- (test (let* ((vzt (make-type :name "vzt"
- :length (lambda (v) (vector-length v))
- :getter (lambda (v n) (vector-ref v n))))
- (make-vzt (cadr vzt)))
- (let ((v (make-vzt (vector 1 2 3))))
- (let ((sum 0))
- (for-each (lambda (n) (set! sum (+ sum n))) v)
- sum)))
- 6)
-
- (test (let* ((rec-type (make-type))
- (? (car rec-type))
- (make (cadr rec-type))
- (ref (caddr rec-type)))
- (let ((val-1 (make "hi")))
- (let ((val-2 (make val-1)))
- (let ((val-3 (make val-2)))
- (ref (ref (ref val-3)))))))
- "hi")
-
- (test (let* ((rec1-type (make-type))
- (?1 (car rec1-type))
- (make1 (cadr rec1-type))
- (ref1 (caddr rec1-type)))
- (let* ((rec2-type (make-type))
- (?2 (car rec2-type))
- (make2 (cadr rec2-type))
- (ref2 (caddr rec2-type)))
- (let ((val-1 (make1 "hi")))
- (let ((val-2 (make2 "hi")))
- (let ((val-3 (make1 val-2)))
- (and (string=? (ref2 (ref1 val-3)) "hi")
- (not (equal? val-1 val-2))
- (?1 val-1)
- (?2 val-2)
- (not (?2 val-3))))))))
- #t)
+(test (arity *) (cons 0 *max-arity*))
+(test (arity +) (cons 0 *max-arity*))
+(test (arity -) (cons 1 *max-arity*))
+(test (arity /) (cons 1 *max-arity*))
+(test (arity curlet) '(0 . 0))
+(test (arity <) (cons 2 *max-arity*))
+(test (arity =) (cons 2 *max-arity*))
+(test (arity >) (cons 2 *max-arity*))
+(test (arity lambda*) (cons 2 *max-arity*))
+(test (arity unlet) '(0 . 0))
+(test (arity call-with-output-file) '(2 . 2))
+(test (arity round) '(1 . 1))
+(test (arity keyword?) '(1 . 1))
+(test (arity openlet) '(1 . 1))
+(test (arity varlet) (cons 1 *max-arity*))
+(test (arity quote) '(1 . 1))
+(test (arity <=) (cons 2 *max-arity*))
+(test (arity with-baffle) (cons 1 *max-arity*))
+(test (arity >=) (cons 2 *max-arity*))
+(test (arity sort!) '(2 . 2))
+(test (arity let->list) '(1 . 1))
+(test (arity cdaddr) '(1 . 1))
+(test (arity do) (cons 2 *max-arity*))
+(test (arity if) '(2 . 3))
+(test (arity pi) '#f)
+(test (arity or) (cons 0 *max-arity*))
+(test (arity *stdin*) '#f)
+(test (arity complex) '(2 . 2))
+(test (arity values) (cons 0 *max-arity*))
+(test (arity string->number) '(1 . 2))
+(test (arity most-negative-fixnum) '#f)
+(test (arity char-downcase) '(1 . 1))
+(test (arity char->integer) '(1 . 1))
+(test (arity vector) (cons 0 *max-arity*))
+(test (arity call/cc) '(1 . 1))
+(when (not pure-s7) (test (arity set-current-input-port) '(1 . 1)))
+(test (arity current-input-port) '(0 . 0))
+(test (arity write) '(1 . 2))
+(test (arity zero?) '(1 . 1))
+(test (arity char<?) (cons 2 *max-arity*))
+(test (arity char-ci<?) (cons 2 *max-arity*))
+(test (arity infinite?) '(1 . 1))
+(test (arity open-input-file) '(1 . 2))
+(test (arity with-let) (cons 1 *max-arity*))
+(test (arity write-char) '(1 . 2))
+(test (arity car) '(1 . 1))
+(test (arity and) (cons 0 *max-arity*))
+(test (arity cdr) '(1 . 1))
+(test (arity ash) '(2 . 2))
+(test (arity define) (cons 2 *max-arity*))
+(test (arity exp) '(1 . 1))
+(test (arity lcm) (cons 0 *max-arity*))
+(test (arity map) (cons 2 *max-arity*))
+(test (arity let) (cons 2 *max-arity*))
+(test (arity max) (cons 1 *max-arity*))
+(test (arity write-byte) '(1 . 2))
+(test (arity min) (cons 1 *max-arity*))
+(test (arity log) '(1 . 2))
+(test (arity not) '(1 . 1))
+(test (arity append) (cons 0 *max-arity*))
+(test (arity list-ref) (cons 2 *max-arity*))
+(test (arity *stderr*) '#f)
+(test (arity object->string) '(1 . 2))
+(test (arity string) (cons 0 *max-arity*))
+(test (arity dynamic-wind) '(3 . 3))
+(test (arity symbol-access) '(1 . 2))
+(test (arity sublet) (cons 1 *max-arity*))
+(test (arity vector-length) '(1 . 1))
+(test (arity char-ready?) '(0 . 1))
+(test (arity random-state->list) '(0 . 1))
+(test (arity with-output-to-file) '(2 . 2))
+(test (arity s7-version) '(0 . 0))
+(test (arity peek-char) '(0 . 1))
+(test (arity :rest) '#f)
+(test (arity aritable?) '(2 . 2))
+(test (arity ceiling) '(1 . 1))
+(test (arity define-bacro*) (cons 2 *max-arity*))
+(test (arity :allow-other-keys) '#f)
+(test (arity call-with-exit) '(1 . 1))
+(test (arity gensym) '(0 . 1))
+(test (arity make-hash-table) '(0 . 2))
+(test (arity multiple-value-bind) (cons 2 *max-arity*))
+(test (arity procedure-setter) '(1 . 1))
+(test (arity define-bacro) (cons 2 *max-arity*))
+(test (arity string-append) (cons 0 *max-arity*))
+(test (arity port-line-number) '(0 . 1))
+(test (arity dilambda) '(2 . 2))
+(test (arity letrec*) (cons 2 *max-arity*))
+(test (arity multiple-value-set!) (cons 2 *max-arity*))
+(test (arity make-iterator) '(1 . 2))
+(test (arity random-state) '(1 . 2))
+(test (arity format) (cons 1 *max-arity*))
+(test (arity vector-ref) (cons 2 *max-arity*))
+(test (arity with-input-from-file) '(2 . 2))
+(test (arity cadr) '(1 . 1))
+(test (arity cond-expand) (cons 0 *max-arity*))
+(test (arity case) (cons 2 *max-arity*))
+(test (arity string-set!) '(3 . 3))
+(test (arity rationalize) '(1 . 2))
+(test (arity atan) '(1 . 2))
+(test (arity asin) '(1 . 1))
+(test (arity assq) '(2 . 2))
+(test (arity assv) '(2 . 2))
+(test (arity cond) (cons 1 *max-arity*))
+(test (arity cons) '(2 . 2))
+(test (arity copy) '(1 . 4))
+(test (arity else) '#f)
+(test (arity eqv?) '(2 . 2))
+(test (arity define*) (cons 2 *max-arity*))
+(test (arity eval) '(1 . 2))
+(test (arity let*) (cons 2 *max-arity*))
+(test (arity define-macro) (cons 2 *max-arity*))
+(test (arity nan?) '(1 . 1))
+(test (arity memq) '(2 . 2))
+(test (arity memv) '(2 . 2))
+(test (arity list) (cons 0 *max-arity*))
+(test (arity load) '(1 . 2))
+(test (arity for-each) (cons 2 *max-arity*))
+(test (arity read) '(0 . 1))
+(test (arity set!) '(2 . 2))
+(test (arity lambda) (cons 2 *max-arity*))
+(test (arity set-car!) '(2 . 2))
+(test (arity set-cdr!) '(2 . 2))
+(test (arity *features*) (cons 1 *max-arity*))
+(test (arity *load-hook*) '(0 . 1))
+(test (arity list-set!) (cons 3 *max-arity*))
+(test (arity list-tail) '(2 . 2))
+(test (arity *error-hook*) '(0 . 2))
+(test (arity current-error-port) '(0 . 0))
+(test (arity define-expansion) (cons 2 *max-arity*))
+(test (arity symbol->value) '(1 . 2))
+(test (arity letrec) (cons 2 *max-arity*))
+(test (arity symbol->string) '(1 . 1))
+(test (arity funclet) '(1 . 1))
+(test (arity make-vector) '(1 . 3))
+(test (arity member) '(2 . 3))
+(unless pure-s7 (test (arity string-fill!) '(2 . 4)))
+(test (arity hook-functions) '(1 . 1))
+(test (arity make-hook) (cons 0 *max-arity*))
+(test (arity number->string) '(1 . 2))
+(test (arity make-list) '(1 . 2))
+(test (arity owlet) '(0 . 0))
+(test (arity open-output-string) '(0 . 0))
+(test (arity rational?) '(1 . 1))
+(test (arity open-input-string) '(1 . 1))
+(test (arity procedure-documentation) '(1 . 1))
+(test (arity hash-table-set!) '(3 . 3))
+(test (arity hash-table-ref) (cons 2 *max-arity*))
+(test (arity call-with-values) '(2 . 2))
+(test (arity logand) (cons 0 *max-arity*))
+(test (arity logior) (cons 0 *max-arity*))
+(test (arity lognot) '(1 . 1))
+(test (arity logbit?) '(2 . 2))
+(test (arity make-string) '(1 . 2))
+(test (arity logxor) (cons 0 *max-arity*))
+(test (arity vector-set!) (cons 3 *max-arity*))
+(test (arity modulo) '(2 . 2))
+(test (arity begin) (cons 0 *max-arity*))
+(test (arity catch) '(3 . 3))
+(test (arity apply) (cons 1 *max-arity*))
+(test (arity denominator) '(1 . 1))
+(test (arity arity) '(1 . 1))
+(test (arity most-positive-fixnum) '#f)
+(test (arity with-output-to-string) '(1 . 1))
+(test (arity assoc) '(2 . 3))
+(test (arity call-with-input-file) '(2 . 2))
+(test (arity quasiquote) '(1 . 1))
+(test (arity fill!) '(2 . 4))
+(test (arity newline) '(0 . 1))
+(test (arity provided?) '(1 . 1))
+(test (arity call-with-current-continuation) '(1 . 1))
+(test (arity char-whitespace?) '(1 . 1))
+(test (arity random) '(1 . 2))
+(test (arity floor) '(1 . 1))
+(test (arity read-char) '(0 . 1))
+(test (arity even?) '(1 . 1))
+(test (arity error) (cons 0 *max-arity*))
+(test (arity defined?) '(1 . 3))
+(test (arity read-byte) '(0 . 1))
+(test (arity macroexpand) '(1 . 1))
+(test (arity output-port?) '(1 . 1))
+(test (arity substring) '(2 . 3))
+(test (arity string-ref) '(2 . 2))
+(test (arity *unbound-variable-hook*) '(0 . 1))
+(test (arity display) '(1 . 2))
+(test (arity read-line) '(0 . 2))
+(test (arity define-macro*) (cons 2 *max-arity*))
+(test (arity eval-string) '(1 . 2))
+(test (arity port-filename) '(0 . 1))
+(test (arity define-constant) (cons 2 *max-arity*))
+(test (arity list?) '(1 . 1))
+(test (arity open-output-file) '(1 . 2))
+(test (arity rootlet) '(0 . 0))
+(test (arity quotient) '(2 . 2))
+(test (arity pair?) '(1 . 1))
+(test (arity call-with-input-string) '(2 . 2))
+(test (arity random-state?) '(1 . 1))
+(test (arity with-input-from-string) '(2 . 2))
+(test (arity null?) '(1 . 1))
+(test (arity eof-object?) '(1 . 1))
+(test (arity hash-table?) '(1 . 1))
+(test (arity hash-table) (cons 0 *max-arity*))
+(test (arity close-output-port) '(1 . 1))
+
+(test (let () (define-macro (mac1 a b c) `(+ ,a ,b)) (arity mac1)) '(3 . 3))
+(test (let () (define-macro (mac1 a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*))
+(test (let () (define-bacro (mac1 a b c) `(+ ,a ,b)) (arity mac1)) '(3 . 3))
+(test (let () (define-bacro (mac1 a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*))
+(test (let () (defmacro mac1 (a b c) `(+ ,a ,b)) (arity mac1)) '(3 . 3))
+(test (let () (defmacro mac1 (a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*))
+(test (let () (define-macro (mac1 a) `(+ 1 ,a)) (arity mac1)) '(1 . 1))
+
+(test (let () (define-macro* (mac1 . a) `(+ ,a ,b)) (arity mac1)) (cons 0 *max-arity*))
+(test (let () (define-macro* (mac1 a) `(+ 1 ,a)) (arity mac1)) '(0 . 1))
+
+(test (let () (define-macro* (mac1 a :rest b) `(+ 1 ,a)) (arity mac1)) (cons 0 *max-arity*))
+(test (let () (define-macro* (mac1 a . b) `(,a , at b)) (arity mac1)) (cons 0 *max-arity*))
+(test (let () (define-macro* (mac1 a b c) `(+ ,a ,b)) (arity mac1)) '(0 . 3))
+
+(test (arity "hiho") '(1 . 1))
+(test (arity "") #f)
+(test (arity ()) #f)
+(test (arity #()) #f)
+(test (arity #(1 2 3)) (cons 1 *max-arity*))
+(test (arity (hash-table '(a . 1))) (cons 1 *max-arity*))
+(test (arity (curlet)) '(1 . 1))
+(test (let () (call-with-exit (lambda (goto) (arity goto)))) (cons 0 *max-arity*))
+(test (arity (make-iterator (hash-table '(a . 1)))) (cons 0 0))
+(test (arity (let ((a 1)) (make-iterator (curlet)))) (cons 0 0))
+(test (arity (random-state 123)) #f)
+
+
+
+(define (for-each-subset func args)
+ (define (subset source dest len)
+ (if (null? source)
+ (if (aritable? func len)
+ (apply func dest))
+ (begin
+ (subset (cdr source) (cons (car source) dest) (+ len 1))
+ (subset (cdr source) dest len))))
+ (subset args () 0))
+#|
+(define (for-each-subset func args)
+ (let ((subsets ()))
+ (define (subset source dest len)
+ (if (null? source)
+ (begin
+ (if (member dest subsets)
+ (format-logged #t ";got ~S twice in for-each-subset: ~S~%" dest args))
+ (set! subsets (cons dest subsets))
+ (if (aritable? func len)
+ (apply func dest)))
+ (begin
+ (subset (cdr source) (cons (car source) dest) (+ len 1))
+ (subset (cdr source) dest len))))
+ (subset args () 0)))
+|#
- (test (let* ((rec-type (make-type :name "rec"))
- (make (cadr rec-type))
- (ref (caddr rec-type)))
- (let ((val (make "hi")))
- (ref (ref val))))
- 'error)
-
- (test (let* ((rec1-type (make-type))
- (make1 (cadr rec1-type))
- (ref1 (caddr rec1-type)))
- (let* ((rec2-type (make-type))
- (make2 (cadr rec2-type)))
- (let ((val-1 (make1 "hi")))
- (let ((val-2 (make2 val-1)))
- (ref1 val-2)))))
- 'error)
-
- (test (make-type (make-type)) 'error)
- (for-each
- (lambda (arg)
- (test (make-type arg) 'error)
- (test (make-type :getter arg) 'error)
- (test (make-type :setter arg) 'error)
- (test (make-type :length arg) 'error)
- (test (make-type :print arg) 'error)
- (test (make-type :equal arg) 'error)
- (test (make-type :copy arg) 'error)
- (test (make-type :fill arg) 'error)
- (test (make-type :name arg) 'error))
- (list #\a 'a-symbol 1.0+1.0i #t #(1 2) '() 3/4 3.14 '(1 . 2)))
- (test (make-type :print (lambda () #f)) 'error)
- (test (make-type :print (lambda (a b) #f)) 'error)
- (test (make-type :getter (lambda () #f)) 'error)
- (test (make-type :setter (lambda () #f)) 'error)
- (test (make-type :setter (lambda (a) #f)) 'error)
- (test (make-type :length (lambda () #f)) 'error)
- (test (make-type :length (lambda (a b) #f)) 'error)
- (test (make-type :equal (lambda () #f)) 'error)
- (test (make-type :equal (lambda (a) #f)) 'error)
- (test (make-type :equal (lambda (a b c) #f)) 'error)
- (test (make-type :copy (lambda () #f)) 'error)
- (test (make-type :copy (lambda (a b) #f)) 'error)
- (test (make-type :fill (lambda () #f)) 'error)
- (test (make-type :fill (lambda (a) #f)) 'error)
- (test (make-type :fill (lambda (a b c) #f)) 'error)
-
- (let ((t (make-type)))
- (let ((t? (car t))
- (make-t (cadr t))
- (t-ref (caddr t)))
- (test (make-t 1 2) 'error)
- (test (t? (make-t)) #t)
- (test (t-ref (make-t)) #f)
- (test (t? 1 2) 'error)
- (test (t?) 'error)
- (test (t-ref) 'error)
- (test (t-ref 1 2) 'error)
- (for-each
- (lambda (arg)
- (test (t-ref arg) 'error))
- (list #\a 'a-symbol 1.0+1.0i #t #(1 2) '() 3/4 3.14 #() "hi" :hi 1 #f #t '(1 . 2)))))
+(test (let ((ctr 0)) (for-each-subset (lambda args (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 16)
+(test (let ((ctr 0)) (for-each-subset (lambda (arg) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 4)
+(test (let ((ctr 0)) (for-each-subset (lambda (arg1 arg2 arg3) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 4)
+(test (let ((ctr 0)) (for-each-subset (lambda* (arg1 arg2 arg3) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 15)
+(test (let ((ctr 0)) (for-each-subset (lambda () (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 1)
+
+;; from stackoverflow scheme
+(define (power-set set)
+ (if (null? set)
+ '(())
+ (let ((power-set-of-rest (power-set (cdr set))))
+ (append power-set-of-rest
+ (map (lambda (subset)
+ (cons (car set) subset))
+ power-set-of-rest)))))
+
+(define (for-each-powerset f s)
+ (for-each (lambda (lst) (apply f lst)) (power-set s)))
+
+(test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args))) '(1)) sum) 1)
+(test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args))) '(1 2)) sum) 6)
+(test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args))) '(1 2 3)) sum) 24)
+
+
+(define (snarf func lst)
+ "(snarf func lst) repeatedly applies func to as many elements of lst as func can take"
+ (let ((arity (arity func)))
+ (if (> (cdr arity) 100)
+ (apply func lst)
+ (let ((n (cdr arity))
+ (lst-len (length lst)))
+ (if (< lst-len (car arity))
+ (error 'wrong-number-of-args ";snarf func requires ~A args, but got ~A, ~A" (car arity) lst-len lst)
+ (if (<= lst-len n)
+ (apply func lst)
+ (if (not (zero? (modulo (length lst) n)))
+ (error 'wrong-number-of-args ";snarf will take ~A args at a time, but got ~A in ~A" n lst-len lst)
+ ;; ideally this would accept partial lists (i.e. left-over < req),
+ ;; but then we also need to notice that case in the list-tail below
+ (let ()
+
+ (define (snarf-1 len f args)
+ (if (not (null? args))
+ (let* ((last (list-tail args (- len 1)))
+ (rest (cdr last)))
+ (dynamic-wind
+ (lambda ()
+ (set! (cdr last) ()))
+ (lambda ()
+ (apply func args))
+ (lambda ()
+ (set! (cdr last) rest)))
+ (snarf-1 len f rest))))
+
+ (snarf-1 n func lst)))))))))
- (let ()
- (define make-float-vector #f)
- (define float-vector? #f)
- (define float-vector #f)
-
- (let* ((fv-type (make-type
- :getter vector-ref :length length :copy copy :fill fill!
- :setter (lambda (obj index value)
- (if (not (real? value))
- (error 'wrong-type-arg-error "float-vector element must be real: ~S" value))
- (vector-set! obj index (* 1.0 value)))
- :name "float-vector"))
- (fv? (car fv-type))
- (make-fv (cadr fv-type))
- (fv-ref (caddr fv-type)))
-
- (set! make-float-vector
- (lambda* (len (initial-element 0.0))
- (if (not (real? initial-element))
- (error 'wrong-type-arg-error "make-float-vector initial element must be real: ~S" initial-element))
- (make-fv (make-vector len (* 1.0 initial-element)))))
-
- (set! float-vector? fv?)
-
- (set! float-vector
- (lambda args
- (let* ((len (length args))
- (fv (make-float-vector len))
- (v (fv-ref fv)))
- (do ((lst args (cdr lst))
- (i 0 (+ i 1)))
- ((null? lst) fv)
- (let ((arg (car lst)))
- (if (not (real? arg))
- (error 'wrong-type-arg-error "float-vector element must be real: ~S in ~S" arg args))
- (set! (v i) (* 1.0 arg))))))))
-
- (let ((val (catch #t
- (lambda ()
- (let ((t (make-type)))
- (for-each
- (lambda (n)
- (format #t ";for-each called non-applicable type!~%"))
- ((cadr t) 0))))
- (lambda args 'error))))
- (if (not (eq? val 'error))
- (format #t ";for-each on non-applicable type: ~A~%" val)))
-
- (let ((val (catch #t
- (lambda ()
- (let ((t (make-type :length (lambda (x) 3))))
- (for-each
- (lambda (n)
- (format #t ";for-each called non-applicable type!~%"))
- ((cadr t) 0))))
- (lambda args 'error))))
- (if (not (eq? val 'error))
- (format #t ";for-each on non-applicable type: ~A~%" val)))
-
- (let ((v (make-float-vector 3 0.0)))
- (test (length v) 3)
- (set! (v 1) 32.0)
- (test (v 0) 0.0)
- (test (v 1) 32.0)
- (test (eq? v v) #t)
- (test (eq? v (float-vector 0.0 32.0 0.0)) #f)
- (test (equal? v (float-vector 0.0 32.0 0.0)) #t)
- (test (map + (list 1 2 3) (float-vector 1 2 3)) '(2.0 4.0 6.0))
- (test (reverse (float-vector 1.0 2.0 3.0)) (float-vector 3.0 2.0 1.0))
- (test (copy (float-vector 1.0 2.0 3.0)) (float-vector 1.0 2.0 3.0))
- (test (let () (fill! v 1.0) v) (float-vector 1.0 1.0 1.0))
- (test (object->string v) "#<float-vector #(1.0 1.0 1.0)>")
- (test (let ((v (float-vector 1.0 2.0 3.0))) (map v (list 2 1 0))) '(3.0 2.0 1.0))
- (test (v -1) 'error)
- (test (v 32) 'error)
- (for-each
- (lambda (arg)
- (test (v arg) 'error))
- (list #\a 'a-symbol 1.0+1.0i #f #t abs #(1 2) '() 3/4 3.14 '(1 . 2)))
+(test (let ((lst '(1 2 3 4))) (catch #t (lambda () (snarf (lambda (a b) (format-logged #t "~A ~A~%" a b c)) lst)) (lambda args 'error)) lst) '(1 2 3 4))
+(test (snarf (lambda (a b) (format-logged #t "~A ~A~%" a b)) '(1 2 3 4 5)) 'error)
+(test (snarf (lambda (a b) (format-logged #t "~A ~A~%" a b)) '(1)) 'error)
+(test (let ((x 0)) (snarf (lambda (a) (set! x (+ x a))) '(1 2 3)) x) 6)
+(test (let ((x 0)) (snarf (lambda (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10)
+(test (let ((x 0)) (snarf (lambda* (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10)
+(test (let ((x 0)) (snarf (lambda a (set! x (apply + a))) '(1 2 3 4)) x) 10)
+(test (let ((x 0)) (snarf (lambda* (a b (c 0)) (set! x (+ x a b c))) '(1 2)) x) 3)
- (test (map (lambda (a b)
- (floor (apply + (map + (list a b) (float-vector a b)))))
- (float-vector 1 2 3) (float-vector 4 5 6))
- '(10 14 18))
- (test (set! (v 0) "hi") 'error)
- (test (set! (v -1) "hi") 'error)
- (test (set! (v 32) "hi") 'error)
- (for-each
- (lambda (arg)
- (test (set! (v 0) arg) 'error))
- (list #\a 'a-symbol 1.0+1.0i #f #t abs #(1 2) '() '(1 . 2)))
- (test (let ((sum 0.0))
- (for-each
- (lambda (x)
- (set! sum (+ sum x)))
- (float-vector 1.0 2.0 3.0))
- sum)
- 6.0)
- (test (length v) 3)
- ))
- (let ()
- (define-macro (blet* names bindings . body)
- `(begin
- ,@(map (lambda (name)
- `(define ,name #f))
- names)
- (let* ,bindings
- , at body)))
-
- (blet* (make-adjustable-vector adjustable-vector? adjust-vector)
-
- ((av-type (make-type :name "adjustable-vector"
- :getter (lambda (obj index)
- ((car obj) index))
- :setter (lambda (obj index value)
- (set! ((car obj) index) value))
- :length (lambda (obj)
- (vector-length (car obj)))
- :print (lambda (obj)
- (object->string (car obj)))))
- (av? (car av-type))
- (make-av (cadr av-type))
- (av-ref (caddr av-type)))
-
- (set! make-adjustable-vector (lambda args
- (make-av (list (apply make-vector args)))))
- (set! adjustable-vector? av?)
- (set! adjust-vector (lambda* (obj new-length initial-element)
- (let* ((new-vector (make-vector new-length initial-element))
- (copy-len (min new-length (length obj))))
- (do ((i 0 (+ i 1)))
- ((= i copy-len))
- (set! (new-vector i) (obj i)))
- (set! (car (av-ref obj)) new-vector)))))
-
- (let ((v (make-adjustable-vector 3 #f)))
- (test (length v) 3)
- (test (v 0) #f)
- (set! (v 1) 32.0)
- (adjust-vector v 10 #f)
- (test (length v) 10)
- (test (v 1) 32.0))
-
- (blet* (rec-a rec? rec-b make-rec)
-
- ((rec-type (make-type :name "rec" :length length :copy copy :fill fill!))
- (? (car rec-type))
- (make (cadr rec-type))
- (ref (caddr rec-type)))
-
- (set! make-rec (lambda* ((a 1) (b 2))
- (make (vector a b))))
-
- (set! rec? ?)
-
- (set! rec-a (make-procedure-with-setter
- (lambda (obj)
- (and (rec? obj)
- (vector-ref (ref obj) 0)))
- (lambda (obj val)
- (if (rec? obj)
- (vector-set! (ref obj) 0 val)))))
-
- (set! rec-b (make-procedure-with-setter
- (lambda (obj)
- (and (rec? obj)
- (vector-ref (ref obj) 1)))
- (lambda (obj val)
- (if (rec? obj)
- (vector-set! (ref obj) 1 val))))))
-
- (let ((r1 (make-rec)))
- (let ((r2 (copy r1)))
- (test (eq? r1 r2) #f)
- (test (rec? r2) #t)
- (test (rec-a r1) 1)
- (test (rec-b r1) 2)
- (test (rec-a r2) 1)
- (test (rec-b r2) 2)
- (set! (rec-b r2) 32)
- (test (rec-b r2) 32)
- (test (rec-b r1) 2)
- (fill! r2 123)
- (test (rec-a r1) 1)
- (test (rec-b r1) 2)
- (test (rec-a r2) 123)
- (test (rec-b r2) 123)
- )
- ))
+;;; --------------------------------------------------------------------------------
+;;; procedure-source
+(for-each
+ (lambda (arg)
+ (eval-string (format #f "(define (func) ~S)" arg))
+ (let ((source (procedure-source func)))
+ (let ((val (func)))
+ (test val arg))))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) ':hi "hi"))
- (define (notify-if-set var notifier)
- (set! (symbol-access var) (list #f notifier #f)))
-
- (define constant-access
- (list #f
- (lambda (symbol new-value)
- (error "can't change constant ~A's value to ~A" symbol new-value))
- (lambda (symbol new-value)
- (error "can't bind constant ~A to a new value, ~A" symbol new-value))))
-
- (define-macro (define-global-constant symbol value)
- `(begin
- (define ,symbol ,value)
- (set! (symbol-access ',symbol) constant-access)
- ',symbol))
-
- (define-macro (let-constant vars . body)
- (let ((varlist (map car vars)))
- `(let ,vars
- ,@(map (lambda (var)
- `(set! (symbol-access ',var) constant-access))
- varlist)
- , at body)))
-
- (define-macro (define-integer var value)
- `(begin
- (define ,var ,value)
- (set! (symbol-access ',var)
- (list #f
- (lambda (symbol new-value)
- (if (real? new-value)
- (floor new-value)
- (error "~A can only take an integer value, not ~S" symbol new-value)))
- #f))
- ',var))
-
- (define (trace-var var)
- (let* ((cur-access (symbol-access var))
- (cur-set (and cur-access (cadr cur-access))))
- (set! (symbol-access var)
- (list (and cur-access (car cur-access))
- (lambda (symbol new-value)
- (format #t "~A set to ~A~%" symbol new-value)
- (if cur-set
- (cur-set symbol new-value)
- new-value))
- (and cur-access (caddr cur-access))
- cur-access))))
-
- (define (untrace-var var)
- (if (and (symbol-access var)
- (cdddr (symbol-access var)))
- (set! (symbol-access var) (cadddr (symbol-access var)))))
+(for-each
+ (lambda (arg)
+ (test (procedure-source arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi :hi #(()) (list 1 2 3) '(1 . 2) "hi"))
- (define-integer _int_ 32)
- (test _int_ 32)
- (set! _int_ 1.5)
- (test _int_ 1)
+(test (let ((hi (lambda (x) (+ x 1)))) (procedure-source hi)) '(lambda (x) (+ x 1)))
+(test (procedure-source) 'error)
+(test (procedure-source abs abs) 'error)
+(test (procedure-source quasiquote) ())
+(test (procedure-source abs) ())
+;(test (let () (define-macro (hi a) `(+ 1 ,a)) (cadr (caddr (procedure-source hi)))) '(lambda (a) ({list} '+ 1 a)))
- (for-each
- (lambda (arg)
- (test (symbol-access arg) 'error)
- (test (set! (symbol-access _int_) arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() '#(()) (list 1 2 3) '(1 . 2) "hi"))
-
- (test (symbol-access) 'error)
- (test (symbol-access '_int_ 2) 'error)
- (test (symbol-access 'abs) #f)
- (test (symbol-access 'xyzzy) #f)
- (test (set! (symbol-access _int_) '()) 'error)
- (test (set! (symbol-access _int_) '(#f)) 'error)
- (test (set! (symbol-access _int_) '(#f #f)) 'error)
- (test (set! (symbol-access _int_) '(#f #f #f #f)) 'error)
-
- (let ((_x1_ #f))
- (set! (symbol-access '_x1_) (list #f
- (lambda (x y) 'error)
- (lambda (x y) 'error)))
- (test (set! _x1_ 32) 'error)
- (test (let ((_x1_ 32)) 2) 'error))
- (let ((_x1_ 0))
- (set! (symbol-access '_x1_) (list #f
- (lambda (x y) 'error)
- #f))
- (test (set! _x1_ 32) 'error)
- (test (let ((_x1_ 32)) _x1_) 32))
- (let ((_x1_ 0))
- (set! (symbol-access '_x1_) (list #f
- (lambda (x y) 0)
- (lambda (x y) (* y 2))))
- (test (begin (set! _x1_ 32) _x1_) 0)
- (test (let ((_x1_ 32)) _x1_) 64))
- (let ((_x1_ 0))
- (set! (symbol-access '_x1_) (list #f
- (lambda (x y) (symbol->value x))
- (lambda (x y) (+ 2 (symbol->value x)))))
- (test (begin (set! _x1_ 32) _x1_) 0)
- (test (let ((_x1_ 32)) _x1_) 2))
-
- (let ((ctr ((cadr (make-type :getter (lambda (a b) b) :length (lambda (a) 3)))))
- (sum 0))
- (for-each (lambda (a b) (set! sum (+ sum a b))) ctr ctr)
- (test sum 6))
+(let ()
+ (define (hi a) (+ a x))
+ (test ((apply let '((x 32)) (list (procedure-source hi))) 12) 44))
+;; i.e. make a closure from (let ((x 32)) <procedure-source hi>)
- (let ()
- (define-macro (enum . args)
- `(for-each define ',args ((cadr (make-type :getter (lambda (a b) b)
- :length (lambda (a) ,(length args)))))))
- (enum zero one two three)
- (test (+ zero one two three) 6))
-
- (let ((ctr ((cadr (make-type :getter (lambda (a b) b) :length (lambda (a) 4))))) (sum 0))
- (test (map (lambda (a b) (+ a b)) ctr ctr) '(0 2 4 6))
- (test (map (lambda (a b c) (+ a b c)) ctr ctr ctr) '(0 3 6 9))
- (test (map (lambda (a b) (+ a b)) #(0 1 2 3) ctr) '(0 2 4 6))
- (test (map (lambda (a b) (+ a b)) ctr #(0 1 2 3)) '(0 2 4 6))
- (test (map (lambda (a) a) ctr) '(0 1 2 3))
- (test (map ctr '(1 2 3 4)) '(1 2 3 4))
- (test (map ctr ctr) '(0 1 2 3))
- (test (for-each ctr ctr) #<unspecified>)
- (test (map ctr '()) '())
- (test (for-each ctr #()) #<unspecified>)
- )
+(let ()
+ (define (arg-info f n)
+ ((procedure-source f) 1 n 1 0 2)) ; get the documentation string of f's n-th argument
- (let ((ctr ((cadr (make-type :getter (lambda (a b) (car (map append (list b a)))) :length (lambda (a) (length (map abs '(-1 -2 -3))))))))
- (sum 0))
- (for-each (lambda (a b) (set! sum (+ sum a b))) ctr ctr)
- (test sum 6))
+ (define* (add-1 (arg ((lambda () "arg should be an integer" 0))))
+ (+ arg 1)) ; the default value of arg is 0
- (let ((ctr ((cadr (make-type :getter (lambda (a b) (for-each append (list b a)) b) :length (lambda (a) (for-each abs '(-1 -2 -3)) 3)))))
- (sum 0))
- (for-each (lambda (a b) (set! sum (+ sum a b))) ctr ctr)
- (test sum 6))
+ (test (add-1) 1)
+ (test (add-1 1) 2)
- (let ((ctr ((cadr (make-type :getter (lambda (a b) (car (map append (list b a)))) :length (lambda (a) (length (map abs '(-1 -2 -3)))))))))
- (test (map (lambda (a b) (+ a b)) ctr ctr) '(0 2 4)))
+ (test (arg-info add-1 0) "arg should be an integer"))
- ))
-
-#|
-;;; these tests are problematic -- they might not fail as hoped, or they might generate unwanted troubles
-(let ((bad-ideas "
- (define (bad-idea)
- (let ((lst '(1 2 3)))
- (let ((result (list-ref lst 1)))
- (list-set! lst 1 (* 2.0 16.6))
- (gc)
- result)))
- (define (bad-idea-1)
- (let ((lst #(1 2 3)))
- (let ((result (vector-ref lst 1)))
- (vector-set! lst 1 (* 2.0 16.6))
- (gc)
- result)))
- "))
- (with-output-to-file "tmp1.r5rs" (lambda () (display bad-ideas)))
- (load "tmp1.r5rs"))
+;;; --------------------------------------------------------------------------------
+;;; procedure-setter
+
+(test (procedure-setter) 'error)
+(test (procedure-setter car cons) 'error)
+(test (procedure-setter car) set-car!)
+(test (procedure-setter vector-ref) vector-set!)
+(test (procedure-setter make-string) #f)
+(test (procedure-setter quasiquote) #f)
+
+(test (procedure-setter cdr) set-cdr!)
+(test (procedure-setter hash-table-ref) hash-table-set!)
+(test (procedure-setter list-ref) list-set!)
+(test (procedure-setter string-ref) string-set!)
+(when (not pure-s7)
+ (test (procedure-setter current-input-port) set-current-input-port)
+ (test (procedure-setter current-output-port) set-current-output-port))
+(test (procedure-setter current-error-port) set-current-error-port)
-(num-test (bad-idea) 2)
-(let ((val (bad-idea)))
- (if (equal? val 33.2)
- (set! val (bad-idea)))
- (if (equal? val 33.2)
- (format #t ";bad-idea 3rd time: ~A~%" val)))
-(num-test (bad-idea-1) 2)
-(let ((val (bad-idea-1)))
- (if (equal? val 33.2)
- (set! val (bad-idea-1)))
- (if (equal? val 33.2)
- (format #t ";bad-idea-1 3rd time: ~A~%" val)))
-(set! *safety* 1)
-(load "tmp1.r5rs")
-(num-test (bad-idea) 2)
-(num-test (bad-idea) 33.2)
-(num-test (bad-idea) 33.2)
-(num-test (bad-idea-1) 2)
-(num-test (bad-idea-1) 33.2)
-(num-test (bad-idea-1) 33.2)
-(set! *safety* 0)
-|#
+(for-each
+ (lambda (arg)
+ (test (procedure-setter arg) 'error))
+ (list -1 #\a #f _ht_ 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi 'car "car" :hi #(()) (list 1 2 3) '(1 . 2) "hi"))
-(test (quit 0) 'error)
+(for-each
+ (lambda (arg)
+ (test (set! (procedure-setter abs) arg) 'error))
+ (list -1 #\a #t _ht_ 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi 'car "car" :hi #(()) (list 1 2 3) '(1 . 2) "hi"))
-(define-expansion (_expansion_ a) `(+ ,a 1))
-(test (_expansion_ 3) 4)
-(test (macroexpand (_expansion_ 3)) `(+ 3 1))
-(let () (define-macro (hi a) `(+ ,a 1)) (test (macroexpand (hi 2)) '(+ 2 1)))
-(test '(_expansion_ 3) (quote (_expansion_ 3)))
-(test (_expansion_ (+ (_expansion_ 1) 2)) 5)
+(let ()
+ (define (hiho a) a)
+ (define-macro (hiha a) `(+ 1 ,a))
+ (define-bacro* (hoha a) `(+ 1 ,a))
+ (define pws (dilambda (lambda () 1) (lambda (x) x)))
+ (test (procedure-setter hiho) #f)
+ (test (procedure-setter hiha) #f)
+ (test (procedure-setter hoha) #f)
+ (test (procedure? (procedure-setter pws)) #t)
+ (test ((procedure-setter pws) 32) 32)
+ )
-(test (let () (define-constant __c1__ 32) __c1__) 32)
-(test (let () __c1__) 'error)
-(test (let ((__c1__ 3)) __c1__) 'error)
-(test (let* ((__c1__ 3)) __c1__) 'error)
-(test (letrec ((__c1__ 3)) __c1__) 'error)
-(test (let () (define (__c1__ a) a) (__c1__ 3)) 'error)
-(test (let () (set! __c1__ 3)) 'error)
+(test (let ((v #(1 2 3)))
+ ((procedure-setter vector-ref) v 0 32)
+ v)
+ #(32 2 3))
+(test (let ((v #(1 2 3)))
+ ((procedure-setter vector-ref) (let () v) 0 32)
+ v)
+ #(32 2 3))
+(let ()
+ (define (vref v i) (vector-ref v i))
+ (set! (procedure-setter vref) vector-set!)
+ (test (let ((v (vector 1 2 3))) (set! (vref v 1) 32) v) #(1 32 3)))
+
+(let ((old-setter (procedure-setter cadr)))
+ (set! (procedure-setter cadr)
+ (lambda (lst val)
+ (set! (car (cdr lst)) val)))
+ (test (let ((lst (list 1 2 3)))
+ (set! (cadr lst) 4)
+ lst)
+ '(1 4 3))
+ (test (procedure? (procedure-setter cadr)) #t)
+ (gc) (gc) ; lint.scm tests this exhaustively
+ (test (procedure? (procedure-setter cadr)) #t)
+ (if (not (procedure? (procedure-setter cadr)))
+ (format *stderr* " setter: ~A~%" (procedure-setter cadr)))
+ (set! (procedure-setter cadr) old-setter))
-;;; constant?
-(test (constant? '__c1__) #t)
-(test (constant? pi) #t)
-(test (constant? 'pi) #t) ; take that, Clisp!
-(test (constant? 12345) #t)
-(test (constant? 3.14) #t)
-(test (constant? :asdf) #t)
-(test (constant? 'asdf) #f)
-(test (constant? "hi") #t)
-(test (constant? #\a) #t)
-(test (constant? #f) #t)
-(test (constant? #t) #t)
-(test (constant? '()) #t)
-(test (constant? ()) #t)
+(let ()
+ (define-macro (vref v a) `(vector-ref ,v ,a))
+ (define-macro (vset! v a x) `(vector-set! ,v ,a ,x))
+ (set! (procedure-setter vref) vset!)
+
+ (let ((v (vector 1 2 3)))
+ (set! (vref v 1) 32)
+ (test v #(1 32 3)))
+
+ (define hi 0)
+ (define-macro (xx) `hi)
+ (define-macro (set-xx val) `(set! hi ,val))
+ (set! (procedure-setter xx) set-xx)
+
+ (set! (xx) 32)
+ (test hi 32))
+
+(let ()
+ (set! (procedure-setter logbit?)
+ (define-macro (m var index on) ; here we want to set "var", so we need a macro
+ `(if ,on
+ (set! ,var (logior ,var (ash 1 ,index)))
+ (set! ,var (logand ,var (lognot (ash 1 ,index)))))))
+ (test (let ((int #b1010)) (set! (logbit? int 0) #t) int) 11))
+
+(let ((old-setter (procedure-setter <)))
+ (set! (procedure-setter <) <)
+ (test (set! (< 3 2) 3) #f)
+ (test (set! (< 1) 2) #t)
+ (set! (procedure-setter <) old-setter))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; procedure-documentation
+
+(test (let () (define hi (let ((documentation "this is a string")) (lambda () 1))) (procedure-documentation hi)) "this is a string")
+(test (let () (define hi (let ((documentation "this is a string")) (lambda () 1))) (help hi)) "this is a string")
+(test (let () (define hi (let ((documentation "this is a string")) (lambda () 1))) (#_help hi)) "this is a string")
+(test (let ((documentation "oops")) (let () (define hi (lambda () 1)) (help hi))) #f)
+(test (let ((documentation "oops")) (define hi (let () (lambda () 1))) (procedure-documentation hi)) "")
+(test (let () (define (hi) "this is a string") (hi)) "this is a string")
+
+(test (set! (procedure-documentation abs) "X the unknown") 'error)
+(test (let ((str (procedure-documentation abs))) (set! ((procedure-documentation abs) 1) #\x) (equal? str (procedure-documentation abs))) #t)
+(test (let ((str (procedure-documentation abs))) (fill! (procedure-documentation abs) #\x) (equal? str (procedure-documentation abs))) #t)
+
+(let ()
+ (define amac (let ((documentation "this is a string")) (define-macro (_ a) `(+ ,a 1))))
+ (test (procedure-documentation amac) "this is a string"))
+(let ()
+ (define amac (let ((documentation "this is a string")) (define-macro* (_ (a 1)) `(+ ,a 1))))
+ (test (procedure-documentation amac) "this is a string"))
+(let ()
+ (define amac (let ((documentation "this is a string")) (define-bacro (_ a) `(+ ,a 1))))
+ (test (procedure-documentation amac) "this is a string"))
+(let ()
+ (define amac (let ((documentation "this is a string")) (define-bacro* (_ (a 1)) `(+ ,a 1))))
+ (test (procedure-documentation amac) "this is a string"))
+(let ()
+ (define-macro (amac a) `(+ ,a 1))
+ (test (procedure-documentation amac) ""))
+(let ()
+ (define-bacro (amac a) ,a)
+ (test (procedure-documentation amac) ""))
+
+(test (procedure-documentation abs) "(abs x) returns the absolute value of the real number x")
+(test (#_help abs) "(abs x) returns the absolute value of the real number x")
+(test (procedure-documentation 'abs) "(abs x) returns the absolute value of the real number x")
+(test (let ((hi (let ((documentation "this is a test")) (lambda (x) (+ x 1)))))
+ (list (hi 1) (procedure-documentation hi)))
+ (list 2 "this is a test"))
+(test (procedure-documentation (let ((documentation "docs")) (lambda* (a b) a))) "docs")
+(test (procedure-documentation (let ((documentation "")) (lambda* (a b) a))) "")
+(test (procedure-documentation (let ((documentation "args: (a b)")) (lambda* (a b) a))) "args: (a b)")
+(test (procedure-documentation (call-with-exit (lambda (c) c))) "")
+(test (procedure-documentation (call/cc (lambda (c) c))) "")
+(test (procedure-documentation) 'error)
+(test (procedure-documentation abs abs) 'error)
+
+(if (not (provided? 'snd))
+ (for-each
+ (lambda (arg)
+ (test (procedure-documentation arg) 'error)
+ (test (help arg) #f))
+ (list -1 #\a #f _ht_ 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi #(()) (list 1 2 3) '(1 . 2) "hi" :hi)))
+
+
+(let ((p (dilambda (lambda (a) (+ a 1)) (lambda (a b) (+ a b)))))
+ (test (object->string (procedure-source p)) "(lambda (a) (+ a 1))")
+ (let ((p1 p)
+ (p2 (dilambda (let ((documentation "pws doc")) (lambda (a) (+ a 1))) (lambda (a b) (+ a b)))))
+ (test (equal? p p1) #t)
+ (test (equal? p1 p2) #f)
+ (test (procedure-documentation p2) "pws doc")
+ (test (apply p2 '(2)) 3)))
+
+(let ((func (eval '(let ((documentation "this is from eval")) (lambda (a) (+ a 1))))))
+ (test (func 3) 4)
+ (test (procedure-documentation func) "this is from eval"))
+(test (let ((e (inlet '(x . 3))))
+ (let ((func (eval '(lambda (a) (+ a x)) e)))
+ (func 2)))
+ 5)
+
+(let ((e (openlet (inlet 'help (lambda (obj) "this is helpful")))))
+ (test ((if (provided? 'snd) s7-help help) e) "this is helpful"))
+
+
+;;; --------------------------------------------------------------------------------
+;;; procedure-signature
+
+(test (procedure-signature boolean?) '(boolean? #t))
+(if (not with-bignums)
+ (test (procedure-signature round) '(integer? real?)))
+(test (procedure-signature quasiquote) #f)
+(test (procedure-signature test) #f)
+
+(for-each
+ (lambda (arg)
+ (test (procedure-documentation arg) 'error))
+ (list -1 #\a #f _ht_ 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi #(()) (list 1 2 3) '(1 . 2) "hi" :hi))
+
+(test (procedure-signature round abs) 'error)
+(test (procedure-signature) 'error)
+(let ()
+ (define f1 (let ((signature '(real? boolean?)))
+ (lambda (x)
+ (if x 1.0 2.0))))
+ (test (procedure-signature f1) '(real? boolean?)))
+
+(test (procedure-signature cddddr) '(#t pair?))
+(test (procedure-signature *) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature +) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature -) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature /) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature <) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature =) (let ((L (list 'boolean? 'number?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature >) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature symbol->keyword) '(keyword? symbol?))
+(test (procedure-signature close-input-port) '(#t input-port?))
+(test (procedure-signature string-append) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (procedure-signature caar) '(#t pair?))
+(test (procedure-signature make-polar) '(number? real? real?))
+(test (procedure-signature provided?) '(boolean? symbol?))
+(test (procedure-signature make-byte-vector) (let ((L (list 'byte-vector? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature string-copy) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (procedure-signature append) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature cosh) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature positive?) '(boolean? real?))
+(test (procedure-signature input-port?) '(boolean? #t))
+(test (procedure-signature complex?) '(boolean? #t))
+(test (procedure-signature lognot) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (procedure-signature logand) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (procedure-signature reverse!) '(sequence? sequence?))
+(test (procedure-signature s7-version) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (procedure-signature pair?) '(boolean? #t))
+(test (procedure-signature write-byte) '(integer? integer? output-port?))
+(test (procedure-signature delete-file) '(integer? string?))
+(test (procedure-signature sequence?) '(boolean? #t))
+(test (procedure-signature directory?) '(boolean? string?))
+(test (procedure-signature cdar) '(#t pair?))
+(test (procedure-signature hash-table-entries) '(integer? hash-table?))
+(test (procedure-signature copy) (let ((L (list #t 'sequence? 'sequence? 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (procedure-signature char-ci>=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature cadadr) '(#t pair?))
+(test (procedure-signature openlet) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature set-cdr!) '(#t pair? #t))
+(test (procedure-signature rootlet) '(let?))
+(test (procedure-signature object->string) '(string? #t (boolean? keyword?)))
+(test (procedure-signature stacktrace) '(string? integer? integer? integer? integer? boolean?))
+(test (procedure-signature make-hook) #f)
+(test (procedure-signature string-length) '(integer? string?))
+(test (procedure-signature char-whitespace?) '(boolean? char?))
+(test (procedure-signature random) '(number? number? random-state?))
+(test (procedure-signature hash-table*) (let ((L (list 'hash-table? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature string-ci<=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature arity) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature number?) '(boolean? #t))
+(test (procedure-signature infinite?) '(boolean? number?))
+(test (procedure-signature logbit?) (let ((L (list 'boolean? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature cddadr) '(#t pair?))
+(test (procedure-signature char-alphabetic?) '(boolean? char?))
+(test (procedure-signature keyword->symbol) '(symbol? keyword?))
+(test (procedure-signature random-state?) '(boolean? #t))
+(test (procedure-signature expt) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature logior) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (procedure-signature string=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature <=) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature >=) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature throw) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature string-ci>=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature eqv?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature vector-ref) (let ((L (list #t 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature float-vector-set!) (let ((L (list 'real? 'float-vector? 'integer? 'integer:real?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (procedure-signature procedure-signature) '((pair? boolean?) #t))
+(test (procedure-signature hash-table-set!) '(#t hash-table? #t #t))
+(test (procedure-signature round) '(integer? real?))
+(test (procedure-signature char-position) '((integer? boolean?) (char? string?) string? integer?))
+(test (procedure-signature make-iterator) '(iterator? sequence? pair?))
+(test (procedure-signature complex) '(number? real? real?))
+(test (procedure-signature tan) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature eval-string) '(values string? let?))
+(test (procedure-signature caadr) '(#t pair?))
+(test (procedure-signature current-output-port) '(output-port?))
+(test (procedure-signature null?) '(boolean? #t))
+(test (procedure-signature caddar) '(#t pair?))
+(test (procedure-signature let-ref) '(#t let? symbol?))
+(test (procedure-signature nan?) '(boolean? number?))
+(test (procedure-signature make-string) '(string? integer? char?))
+(test (procedure-signature int-vector) (let ((L (list 'int-vector? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature truncate) '(integer? real?))
+(test (procedure-signature set-current-output-port) '(output-port? output-port?))
+(test (procedure-signature list-ref) (let ((L (list #t 'pair? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature char-ci<?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature aritable?) '(boolean? #t integer?))
+(test (procedure-signature read-char) '((char? eof-object?) input-port?))
+(test (procedure-signature char-ready?) '(boolean? input-port?))
+(test (procedure-signature eof-object?) '(boolean? #t))
+(test (procedure-signature gensym?) '(boolean? #t))
+(test (procedure-signature output-port?) '(boolean? #t))
+(test (procedure-signature autoload) '(#t symbol? #t))
+(test (procedure-signature cdadr) '(#t pair?))
+(test (procedure-signature iterator-at-end?) '(boolean? iterator?))
+(test (procedure-signature gensym) '(gensym? string?))
+(test (procedure-signature cdddar) '(#t pair?))
+(test (procedure-signature string-fill!) (let ((L (list '(char? integer?) 'string? 'char? 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (procedure-signature (symbol "(c-object set)")) #f)
+(test (procedure-signature curlet) '(let?))
+(test (procedure-signature quotient) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (procedure-signature let?) '(boolean? #t))
+(test (procedure-signature integer?) '(boolean? #t))
+(test (procedure-signature display) '(#t #t output-port?))
+(test (procedure-signature make-shared-vector) '(vector? vector? (pair? integer?) integer?))
+(test (procedure-signature exp) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature float-vector) (let ((L (list 'float-vector? 'real?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature iterator-sequence) '(sequence? iterator?))
+(test (procedure-signature getenv) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (procedure-signature string-position) '((integer? boolean?) string? string? integer?))
+(test (procedure-signature integer-decode-float) '(pair? float?))
+(test (procedure-signature acos) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature make-keyword) '(keyword? string?))
+(test (procedure-signature write-char) '(char? char? output-port?))
+(test (procedure-signature float-vector-ref) (let ((L (list 'float? 'float-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature cyclic-sequences) '(list? #t))
+(test (procedure-signature reverse) '(sequence? sequence?))
+(test (procedure-signature with-output-to-file) '(#t string? procedure?))
+(test (procedure-signature procedure-documentation) '(string? procedure?))
+(test (procedure-signature open-output-string) '(output-port?))
+(test (procedure-signature let->list) '(pair? let?))
+(test (procedure-signature string<?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature caaar) '(#t pair?))
+(test (procedure-signature equal?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature min) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (procedure-signature sin) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature cadaar) '(#t pair?))
+(test (procedure-signature list) (let ((L (list 'pair? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature make-rectangular) '(number? real? real?))
+(test (procedure-signature macro?) '(boolean? #t))
+(test (procedure-signature inlet) (let ((L (list 'let? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature procedure-setter) '(#t procedure?))
+(test (procedure-signature hash-table-ref) '(#t hash-table? #t))
+(test (procedure-signature unlet) '(let?))
+(test (procedure-signature int-vector?) '(boolean? #t))
+(test (procedure-signature char<?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature abs) '(real? real?))
+(test (procedure-signature open-input-file) '(input-port? string? string?))
+(test (procedure-signature keyword?) '(boolean? #t))
+(test (procedure-signature acosh) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature make-hash-table) '(hash-table? integer? pair?))
+(test (procedure-signature string->list) (let ((L (list 'list? 'string? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature hash-table-size) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature cdaar) '(#t pair?))
+(test (procedure-signature set-car!) '(#t pair? #t))
+(test (procedure-signature lcm) (let ((L (list 'rational?))) (set-cdr! L L) L))
+(test (procedure-signature ->byte-vector) '(byte-vector? string?))
+(test (procedure-signature magnitude) '(real? number?))
+(test (procedure-signature cddaar) '(#t pair?))
+(test (procedure-signature list-tail) '(list? pair? integer?))
+(test (procedure-signature vector-length) '(integer? vector?))
+(test (procedure-signature read) '(#t input-port?))
+(test (procedure-signature vector-fill!) (let ((L (list #t 'vector? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (procedure-signature for-each) (let ((L (list #t 'procedure? 'length))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature memq) '(#t #t pair?))
+(test (procedure-signature int-vector-set!) (let ((L (list 'integer? 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature call-with-input-file) '(#t string? procedure?))
+(test (procedure-signature call-with-input-string) '(#t string? procedure?))
+(test (procedure-signature dilambda) #f)
+(test (procedure-signature hash-table?) '(boolean? #t))
+(test (procedure-signature dilambda?) '(boolean? #t))
+(test (procedure-signature not) '(boolean? #t))
+(test (procedure-signature logxor) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (procedure-signature char-ci=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature c-object?) '(boolean? #t))
+(test (procedure-signature vector?) '(boolean? #t))
+(test (procedure-signature length) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature caaddr) '(#t pair?))
+(test (procedure-signature vector) (let ((L (list 'vector? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature error) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature eq?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature proper-list?) '(boolean? #t))
+(test (procedure-signature char-upper-case?) '(boolean? char?))
+(test (procedure-signature symbol->dynamic-value) '(#t symbol?))
+(test (procedure-signature remainder) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (procedure-signature format) (let ((L (list '(string? boolean?) #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature hash-table) (let ((L (list 'hash-table? 'list?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature file-mtime) '(integer? string?))
+(test (procedure-signature vector-append) (let ((L (list 'vector?))) (set-cdr! L L) L))
+(test (procedure-signature constant?) '(boolean? #t))
+(test (procedure-signature string-ci<?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature random-state->list) '(pair? random-state?))
+(test (procedure-signature boolean?) '(boolean? #t))
+(test (procedure-signature max) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (procedure-signature cadr) '(#t pair?))
+(test (procedure-signature cdaddr) '(#t pair?))
+(test (procedure-signature string-ci=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature car) '(#t pair?))
+(test (procedure-signature integer->char) '(char? integer?))
+(test (procedure-signature char>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature asin) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature current-error-port) '(output-port?))
+(test (procedure-signature flush-output-port) '(#t output-port?))
+(test (procedure-signature owlet) '(let?))
+(test (procedure-signature c-pointer) '(c-pointer? integer?))
+(test (procedure-signature string-ci>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature with-output-to-string) '(string? procedure?))
+(test (procedure-signature memv) '(#t #t pair?))
+(test (procedure-signature char?) '(boolean? #t))
+(test (procedure-signature ash) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (procedure-signature denominator) '(integer? rational?))
+(test (procedure-signature string>=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature make-float-vector) '(float-vector? (integer? pair?) real?))
+(test (procedure-signature call-with-output-file) '(#t string? procedure?))
+(test (procedure-signature call-with-output-string) '(string? procedure?))
+(test (procedure-signature char<=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature cddr) '(#t pair?))
+(test (procedure-signature current-input-port) '(input-port?))
+(test (procedure-signature open-input-string) '(input-port? string?))
+(test (procedure-signature write) '(#t #t output-port?))
+(test (procedure-signature cdr) '(#t pair?))
+(test (procedure-signature list->string) '(string? proper-list?))
+(test (procedure-signature catch) (let ((L (list 'values #t 'procedure?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature call/cc) '(values procedure?))
+(test (procedure-signature port-filename) '(string? #t))
+(test (procedure-signature caaadr) '(#t pair?))
+(test (procedure-signature symbol?) '(boolean? #t))
+(test (procedure-signature values) (let ((L (list 'values #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature integer-length) (let ((L (list 'integer?))) (set-cdr! L L) L))
+(test (procedure-signature symbol) '(symbol? string?))
+(test (procedure-signature asinh) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature pair-line-number) '(integer? pair?))
+(test (procedure-signature load) '(values string? let?))
+(test (procedure-signature cos) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature iterate) '(#t iterator?))
+(test (procedure-signature substring) (let ((L (list 'string? 'string? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature tanh) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature symbol-access) '(#t symbol? let?))
+(test (procedure-signature provide) '(symbol? symbol?))
+(test (procedure-signature rational?) '(boolean? #t))
+(test (procedure-signature vector-set!) (let ((L (list #t 'vector? 'integer? 'integer:any?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (procedure-signature string-set!) '(char? string? integer? char?))
+(test (procedure-signature assoc) '((pair? boolean?) #t list? procedure?))
+(test (procedure-signature string-ref) '(char? string? integer?))
+(test (procedure-signature float-vector?) '(boolean? #t))
+(test (procedure-signature log) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature char-ci>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature fill!) (let ((L (list #t 'sequence? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (procedure-signature cdaadr) '(#t pair?))
+(test (procedure-signature even?) '(boolean? integer?))
+(test (procedure-signature make-list) '(list? integer? #t))
+(test (procedure-signature modulo) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (procedure-signature defined?) '(boolean? symbol? let? boolean?))
+(test (procedure-signature with-input-from-file) '(#t string? procedure?))
+(test (procedure-signature with-input-from-string) '(#t string? procedure?))
+(test (procedure-signature char-ci<=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature real-part) '(real? number?))
+(test (procedure-signature sqrt) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature char-downcase) (let ((L (list 'char?))) (set-cdr! L L) L))
+(test (procedure-signature symbol->value) '(#t symbol? let?))
+(test (procedure-signature set-current-input-port) '(input-port? input-port?))
+(test (procedure-signature assq) '((pair? boolean?) #t list?))
+(test (procedure-signature make-vector) '(vector? (integer? pair?) #t boolean?))
+(test (procedure-signature eval) '(values list? let?))
+(test (procedure-signature caddr) '(#t pair?))
+(test (procedure-signature cons) '(pair? #t #t))
+(test (procedure-signature port-closed?) '(boolean? #t))
+(test (procedure-signature char-upcase) (let ((L (list 'char?))) (set-cdr! L L) L))
+(test (procedure-signature list->vector) '(vector? proper-list?))
+(test (procedure-signature sort!) '(#t sequence? procedure?))
+(test (procedure-signature write-string) (let ((L (list 'string? 'string? 'output-port? 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
+(test (procedure-signature char>=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature caadar) '(#t pair?))
+(test (procedure-signature file-exists?) '(boolean? string?))
+(test (procedure-signature vector-dimensions) '(pair? vector?))
+(test (procedure-signature exact?) '(boolean? number?))
+(test (procedure-signature imag-part) '(real? number?))
+(test (procedure-signature exact->inexact) (let ((L (list 'real?))) (set-cdr! L L) L))
+(test (procedure-signature make-int-vector) '(int-vector? (integer? pair?) integer?))
+(test (procedure-signature procedure-source) '(list? procedure?))
+(test (procedure-signature zero?) '(boolean? number?))
+(test (procedure-signature dynamic-wind) (let ((L (list 'values 'procedure?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature cdddr) '(#t pair?))
+(test (procedure-signature list?) '(boolean? #t))
+(test (procedure-signature string-downcase) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (procedure-signature sinh) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature get-output-string) '(string? output-port? boolean?))
+(test (procedure-signature real?) '(boolean? #t))
+(test (procedure-signature char->integer) '(integer? char?))
+(test (procedure-signature numerator) '(integer? rational?))
+(test (procedure-signature cdadar) '(#t pair?))
+(test (procedure-signature assv) '((pair? boolean?) #t list?))
+(test (procedure-signature read-line) '((string? eof-object?) input-port? boolean?))
+(test (procedure-signature ceiling) '(integer? real?))
+(test (procedure-signature char-lower-case?) '(boolean? char?))
+(test (procedure-signature call-with-current-continuation) '(values procedure?))
+(test (procedure-signature newline) '(#t output-port?))
+(test (procedure-signature symbol-table) '(vector?))
+(test (procedure-signature set-current-error-port) '(output-port? output-port?))
+(test (procedure-signature char-numeric?) '(boolean? char?))
+(test (procedure-signature string-upcase) (let ((L (list 'string?))) (set-cdr! L L) L))
+(test (procedure-signature member) '(#t #t list? procedure?))
+(test (procedure-signature close-output-port) '(#t output-port?))
+(test (procedure-signature byte-vector) (let ((L (list 'byte-vector? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature cadar) '(#t pair?))
+(test (procedure-signature morally-equal?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature call-with-exit) '(values procedure?))
+(test (procedure-signature funclet) '(let? procedure?))
+(test (procedure-signature floor) '(integer? real?))
+(test (procedure-signature let-set!) '(#t let? symbol? #t))
+(test (procedure-signature system) '(#t string? boolean?))
+(test (procedure-signature map) (let ((L (list 'list? 'procedure? 'length))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature caaaar) '(#t pair?))
+(test (procedure-signature port-line-number) '(integer? input-port?))
+(test (procedure-signature c-pointer?) '(boolean? #t))
+(test (procedure-signature int-vector-ref) (let ((L (list 'integer? 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature gc) '(#t boolean?))
+(test (procedure-signature angle) '(real? number?))
+(test (procedure-signature coverlet) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature float?) '(boolean? #t))
+(test (procedure-signature cddar) '(#t pair?))
+(test (procedure-signature atan) '(number? number? real?))
+(test (procedure-signature varlet) (let ((L (list 'let? 'let? #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature random-state) (let ((L (list 'random-state? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature emergency-exit) (let ((L (list #t))) (set-cdr! L L) L))
+(test (procedure-signature peek-char) '((char? eof-object?) input-port?))
+(test (procedure-signature directory->list) '(pair? string?))
+(test (procedure-signature cdaaar) '(#t pair?))
+(test (procedure-signature string?) '(boolean? #t))
+(test (procedure-signature negative?) '(boolean? real?))
+(test (procedure-signature gcd) (let ((L (list 'rational?))) (set-cdr! L L) L))
+(test (procedure-signature string) (let ((L (list 'string? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature string<=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature cutlet) (let ((L (list 'let? 'let? 'symbol?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature outlet) '(let? let?))
+(test (procedure-signature continuation?) '(boolean? #t))
+(test (procedure-signature byte-vector?) '(boolean? #t))
+(test (procedure-signature openlet?) '(boolean? #t))
+(test (procedure-signature char=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature cadddr) '(#t pair?))
+(test (procedure-signature apply) (let ((L (list 'values 'procedure? #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature inexact?) '(boolean? number?))
+(test (procedure-signature open-output-file) '(output-port? string? string?))
+(test (procedure-signature rationalize) '(rational? real? real?))
+(test (procedure-signature inexact->exact) '(rational? real?))
+(test (procedure-signature string>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L))
+(test (procedure-signature iterator?) '(boolean? #t))
+(test (procedure-signature string->symbol) '(symbol? string?))
+(test (procedure-signature symbol->string) '(string? symbol?))
+(test (procedure-signature read-string) '((string? eof-object?) integer? input-port?))
+(test (procedure-signature vector->list) (let ((L (list 'list? 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature odd?) '(boolean? integer?))
+(test (procedure-signature atanh) (let ((L (list 'number?))) (set-cdr! L L) L))
+(test (procedure-signature read-byte) '((integer? eof-object?) input-port?))
+(test (procedure-signature procedure?) '(boolean? #t))
+(test (procedure-signature sublet) (let ((L (list 'let? '(let? null?) #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature list-set!) (let ((L (list #t 'pair? #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature string->number) '((number? boolean?) string? integer?))
+(test (procedure-signature number->string) '(string? number? integer?))
+
+#|
+(define (show-cycle sig)
+ (format *stderr* "(let ((L (list")
+ (do ((L sig (cdr L))
+ (k 0 (+ k 1))
+ (done #f))
+ (done)
+ (if (not (boolean? (car L)))
+ (format *stderr* " '~A" (car L))
+ (format *stderr* " #t"))
+ (let ((inner-done #f))
+ (do ((LL sig (cdr LL))
+ (i 0 (+ i 1)))
+ (inner-done)
+ (if (eq? LL (cdr L))
+ (begin
+ (set! done #t)
+ (set! inner-done #t)
+ (format *stderr* "))) (set-cdr! ~A ~A) L)"
+ (if (= k 0) "L" (format #f "(c~NCr L)" k #\d))
+ (if (= i 0) "L" (format #f "(c~NCr L)" i #\d))))
+ (if (eq? LL L)
+ (set! inner-done #t)))))))
+
+(define (test-sym sym)
+ (let ((f (symbol->value sym)))
+ (when (procedure? f)
+ (let ((sig (procedure-signature f)))
+ (if (pair? sig)
+ (if (infinite? (length sig))
+ (begin (format *stderr* "(test (procedure-signature ~A) " sym) (show-cycle sig) (format *stderr* ")~%"))
+ (format *stderr* "(test (procedure-signature ~A) '~A)~%" sym sig))
+ (format *stderr* "(test (procedure-signature ~A) ~A)~%" sym sig))))))
+
+(let ((st (symbol-table)))
+ (for-each test-sym st))
+|#
+
+;;; --------------------------------------------------------------------------------
+;;; funclet
+
+(let ((f1 (lambda (a) (+ a 1)))
+ (f2 (lambda* ((a 2)) (+ a 1))))
+ (define (hi a) (+ a 1))
+ (define* (ho (a 1)) (+ a 1))
+ (test (let? (funclet hi)) #t)
+ (test (let? (funclet ho)) #t)
+ (test (let? (funclet f1)) #t)
+ (test (let? (funclet f2)) #t)
+ (test (let? (funclet abs)) #t)
+ (test (> (length (funclet abs)) 100) #t)
+ (test (fill! (funclet abs) 0) 'error)
+ (test (reverse (funclet abs)) 'error)
+ (test (fill! (funclet ho) 0) 'error)
+ (test (reverse (funclet ho)) 'error))
+
+(test (funclet quasiquote) (rootlet))
+(test (funclet lambda) 'error)
+(test (funclet abs) (rootlet))
+(test (funclet cond-expand) (rootlet))
+
+(let ()
+ (define func (let ((lst (list 1 2 3)))
+ (lambda (a)
+ (((funclet func) 'lst) a))))
+ (test (func 1) 2))
+
+#|
+;;; but:
+:(define func (let ((lst (list 1 2 3)))
+ (lambda (a)
+ ((funclet func) 'lst a))))
+func
+:(func 1)
+;environment as applicable object takes one argument: (lst 1)
+; 'lst
+
+which seems inconsistent
+
+:(define func (let ((lst (list 1 2 3)))
+ (lambda (a)
+ ((list (funclet func)) 0 'lst))))
+func
+:(func 1)
+(1 2 3)
+|#
+
+(for-each
+ (lambda (arg)
+ (test (funclet arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+
+(test (let ()
+ (define (hi a)
+ (let ((func __func__))
+ (list (if (symbol? func) func (car func))
+ a)))
+ (hi 1))
+ (list 'hi 1))
+
+(set! (hook-functions *unbound-variable-hook*) ())
+(catch #t
+ (lambda ()
+ (let ()
+ (define (f1 e)
+ (with-let e
+ (hash-table-set! ht :a (abs x))))
+ (f1 (inlet :ht (make-hash-table) :x -1))
+ (f1 (inlet :ht (make-hash-table) :x -1))
+ (test (f1 (inlet :ht (make-hash-table))) 'error)))
+ (lambda args #f))
+
+(catch #t
+ (lambda ()
+ (let ()
+ (let ((x 1))
+ (let ((ht (make-hash-table)))
+ (define (f1)
+ (hash-table-set! ht :a (abs x)))
+ (f1)
+ (set! (outlet (curlet)) (inlet))
+ (test (f1) 'error)))))
+ (lambda args #f))
+
+(let ()
+ (define (f1)
+ (with-output-to-string
+ (lambda ()
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (with-let (inlet 'x 1)
+ (display x))))))
+ (test (f1) "111"))
+
+(let ()
+ (define (f1 e)
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (with-let e
+ (hash-table-set! ht :a (abs x)))))
+ (f1 (inlet :ht (make-hash-table) :x -1))
+ (test (f1 (inlet :ht (make-hash-table) :x -1)) ()))
+
+(test (let ()
+ (define hi (let ((a 32))
+ (lambda (b)
+ (+ a b))))
+ (define ho (with-let
+ (funclet hi)
+ (lambda (b)
+ (+ a b))))
+ (list (hi 1) (ho 1)))
+ (list 33 33))
+
+(test (let ()
+ (define (hi a) (+ a 1))
+ (with-let (funclet hi)
+ ((eval (procedure-source hi)) 2)))
+ 3)
+
+(let ()
+ (define (where-is func)
+ (let ((addr (with-let (funclet func) __func__)))
+ (if (not (pair? addr))
+ ""
+ (list (format #f "~A[~D]" (cadr addr) (caddr addr))
+ addr))))
+ (let ((e (where-is ok?)))
+ (test (and (pair? (cadr e))
+ (< ((cadr e) 2) 1000)) ; this depends on where ok? is in this file
+ #t)
+ (test (and (pair? (cadr e))
+ (string=? (symbol->string (car (cadr e))) "ok?"))
+ #t)
+ (test (and (pair? (cadr e))
+ (let ((name (cadr (cadr e))))
+ (and (string? name)
+ (call-with-exit
+ (lambda (oops)
+ (let ((len (length name)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) #t)
+ (if (and (not (char-alphabetic? (name i)))
+ (not (char=? (name i) #\/))
+ (not (char=? (name i) #\\))
+ (not (char=? (name i) #\.))
+ (not (char=? (name i) #\-))
+ (not (char-numeric? (name i))))
+ (begin
+ (format-logged #t "ok? file name: ~S~%" name)
+ (oops #f))))))))))
+ #t)))
+
+(test (let () (define (f1 a) __func__) (f1 1)) 'f1)
+(test (let () (define (f1 a) (define (f2 b) __func__) (f2 a)) (f1 1)) 'f2)
+(test (let () (define (f1 a) (define (f2 b) (define (f3 c) __func__) (f3 b)) (f2 a)) (f1 2)) 'f3)
+(test (let () (define (f1 a) (define (f2 b) (define (f3 c) (define (f4 d) __func__) (f4 c)) (f3 b)) (f2 a)) (f1 1)) 'f4)
+(test (let () (define (f1 a) (let () (define (f2 b) __func__) (f2 a))) (f1 1)) 'f2)
+;(test (with-let (funclet dilambda) __func__) 'dilambda) ; make-procedure-with-setter!?
+(test (with-let (funclet abs) __func__) #<undefined>)
+(test (with-let (funclet quasiquote) __func__) #<undefined>)
+(test (with-let (funclet reader-cond) __func__) #<undefined>)
+(test (with-let (funclet *error-hook*) __func__) 'make-hook)
+
+(let ()
+ (define-macro (window func beg end . body)
+ `(call-with-exit
+ (lambda (quit)
+ (do ((notes ',body (cdr notes)))
+ ((null? notes))
+ (let* ((note (car notes))
+ (note-beg (cadr note)))
+ (if (<= ,beg note-beg)
+ (if (> note-beg (+ ,beg ,end))
+ (quit)
+ (,func note))))))))
+
+ (test
+ (let ((n 0))
+ (window (lambda (a-note) (set! n (+ n 1))) 0 1
+ (fm-violin 0 1 440 .1)
+ (fm-violin .5 1 550 .1)
+ (fm-violin 3 1 330 .1))
+ n)
+ 2)
+
+ (test
+ (let ((notes 0)
+ (env #f))
+ (set! env (curlet))
+ (window (with-let env (lambda (n) (set! notes (+ notes 1)))) 0 1
+ (fm-violin 0 1 440 .1)
+ (fm-violin .5 1 550 .1)
+ (fm-violin 3 1 330 .1))
+ notes)
+ 2))
+
+(test (let ()
+ (define-macro (window func beg end . body)
+ `(let ((e (curlet)))
+ (call-with-exit
+ (lambda (quit)
+ (do ((notes ',body (cdr notes)))
+ ((null? notes))
+ (let* ((note (car notes))
+ (note-beg (cadr note)))
+ (if (<= ,beg note-beg)
+ (if (> note-beg (+ ,beg ,end))
+ (quit)
+ ((with-let e ,func) note)))))))))
+
+ (let ((notes 0))
+ (window (lambda (n) (set! notes (+ notes 1))) 0 1
+ (fm-violin 0 1 440 .1)
+ (fm-violin .5 1 550 .1)
+ (fm-violin 3 1 330 .1))
+ notes))
+ 2)
+
+;;; this is version dependent
+;;;(let ((a 32))
+;;; (define (hi x) (+ x a))
+;;; (test (defined? 'bbbbb (funclet hi)) #f)
+;;; (let ((xdef (defined? 'x (funclet hi))))
+;;; (test xdef #t))
+;;; (test (symbol->value 'a (funclet hi)) 32))
+
+(let ()
+ (let ((x 32))
+ (define (hi a) (+ a x))
+ (let ((xx ((funclet hi) 'x)))
+ (test xx 32))
+ (let ((s7-version 321))
+ (test s7-version 321)
+ (let ((xxx ((unlet) 'x)))
+ (test xxx 32)
+ (let ((str (with-let (unlet) (s7-version))))
+ (test (string? str) #t))))))
+
+;;; funclet is a mess but it's hard to test mainly because it's different in different versions of s7
+;;; and the test macro affects it
+;;;
+;;; (test (let () (define (func3 a b) (+ a b)) (let->list (funclet func3))) '((b) (a)))
+;;; or is it ((__func__ . func3)) in context?
+;;;
+;;; ;;; troubles:
+;;; (let ((func1 (lambda (a b) (+ a b)))) (symbol->value '__func__ (funclet func1))) -> #<undefined>
+;;; (let ((func1 (lambda (a b) (+ a b)))) (eq? (funclet func1) (rootlet))) -> #t
+;;;
+;;; (letrec ((func1 (lambda (a b) (+ a b)))) (eq? (funclet func1) (rootlet))) -> #f
+;;; (letrec ((func1 (lambda (a b) (+ a b)))) (let->list (funclet func1))) -> ((func1 . #<closure>))
+;;;
+;;; (let () (define* (func4 (a 1) b) (+ a b)) (let->list (funclet func4))) -> ((__func__ . func4))
+;;; (let () (define-macro (func4 a b) `(+ ,a ,b)) (let->list (funclet func4))) -> ((func4 . #<macro>))
+;;;
+;;; (let () (let ((func2 (lambda (a b) (+ a b)))) (let->list (funclet func2)))) -> ()
+;;;
+;;; (funclet #<continuation>) -> (rootlet)
+;;; (funclet #<goto>) -> (rootlet)
+;;; and setter of pws is either global or ()
+;;;
+;;; ;;; this returns #t because the fallback in g_procedure_environment is the global env
+;;; (eq? (rootlet)
+;;; (let ((a 32))
+;;; (call-with-exit ; or call/cc
+;;; (lambda (return)
+;;; (funclet return)))))
+;;;
+;;; (funclet values) -> global env! (like catch/dynamic-wind it's a procedure)
+;;; this is also true of (funclet (lambda () 1))
+;;;
+;;; :(funclet (float-vector 1 2))
+;;; (inlet)
+;;; :(funclet (vector 1 2))
+;;; ;funclet argument, #(1 2), is a vector but should be a procedure or a macro
+;;; ; (vector 1 2)
+;;;
+;;; :(let ((a 1)) (define-macro (m1 b) `(+ ,a ,b)) (let->list (funclet m1)))
+;;; ((a . 1) (m1 . #<macro>))
+;;; :(let ((a 1)) (define (m1 b) (+ a b)) (let->list (funclet m1)))
+;;; ((b))
+;;; :(let ((a 1)) (define (m1 b) (+ a b)) (let->list (outlet (funclet m1))))
+;;; ((__func__ . m1))
+;;;
+;;; (procedure-documentation macroexpand) -> "" ; also cond-expand
+
+#|
+;;; this checks existing procedures
+(let ((st (symbol-table))
+ (p (open-output-file "pinfo")))
+ (for-each
+ (lambda (sym)
+ (if (defined? sym)
+ (let ((val (symbol->value sym)))
+ (format p "---------------- ~A ----------------~%" sym)
+ (catch #t
+ (lambda ()
+ (let ((str (procedure-documentation val))
+ (sym-name (symbol->string sym)))
+ (if (procedure? val)
+ (if (= (length str) 0)
+ (format p "~A: [no doc]~%" sym)
+ (let ((pos (substring? sym-name str)))
+ (if (and (not pos)
+ (not (char-upper-case? (sym-name 0)))
+ (not (char=? (sym-name 0) #\.))
+ (not (char=? (sym-name 0) #\[)))
+ (format p "~A documentation [no matched name]: ~A~%" sym str))))
+ (if (> (length str) 0)
+ (format p "~A (not a procedure) documentation: ~A~%" str)))))
+ (lambda args
+ (if (procedure? val)
+ (format p "~A documentation: error: ~A~%" sym (apply format #f (cadr args))))))
+ (catch #t
+ (lambda ()
+ (let ((lst (procedure-source val)))
+ (if (not lst)
+ (if (procedure? val)
+ (format p "~A: [no source]~%" sym))
+ (if (and (not (pair? lst))
+ (not (null? lst)))
+ (format p "~A source: ~A~%" sym lst)))))
+ (lambda args
+ (if (procedure? val)
+ (format p "~A source: error: ~A~%" sym (apply format #f (cadr args))))))
+ (catch #t
+ (lambda ()
+ (let ((pe (funclet val)))
+ (if (not pe)
+ (if (procedure? val)
+ (format p "~A: [no environment]~%" sym))
+ (if (not (let? pe))
+ (format p "~A environment:~%" sym pe)
+ (if (not (eq? (rootlet) pe))
+ (format p "~A env: ~A~%" sym (let->list pe)))))))
+ (lambda args
+ (if (procedure? val)
+ (format p "~A environment: error: ~A~%" sym (apply format #f (cadr args))))))
+ )))
+ st)
+ (close-output-port p))
+|#
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; continuation?
+
+(for-each
+ (lambda (arg)
+ (test (continuation? arg) #f))
+ (list -1 #\a 1 #f _ht_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) "hi" (lambda () 1)))
+
+(test (let ((cont #f))
+ (and (call/cc (lambda (x) (set! cont x) (continuation? x)))
+ (continuation? cont)))
+ #t)
+(test (let ((cont #f))
+ (or (call-with-exit (lambda (x) (set! cont x) (continuation? x)))
+ (continuation? cont)))
+ #f) ; x is not a continuation
+
+(test (continuation?) 'error)
+(test (continuation? 1 2) 'error)
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; s7-version
+
+(test (string? (s7-version)) #t)
+(test (s7-version 1) 'error)
+(test (s7-version) (s7-version))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; eval
+;;; eval-string
+
+(test (eval-string "(list #b)") 'error)
+(test (eval-string "(char? #\\spaces)") 'error)
+(test (eval-string "(car '( . 1))") 'error)
+(test (eval-string "(car '(. ))") 'error)
+(test (eval-string "(car '( . ))") 'error)
+(test (eval-string "(car '(. . . ))") 'error)
+(test (eval-string "#( . 1)") 'error)
+(test (eval-string "'(1 2 . )") 'error)
+(test (eval-string "#(1 2 . )") 'error)
+(test (eval-string "#'(1 2)") 'error)
+(test (eval-string "#`(1 2)") 'error)
+(test (eval-string "#,(1 2)") 'error)
+(test (eval-string "#`,(1 2)") 'error)
+(test (eval-string "#1(2)") 'error)
+(test (eval-string "(+ 1 . . )") 'error)
+(test (eval-string "(car '(1 . ))") 'error)
+(test (eval-string "(car '(1 . . 2))") 'error)
+(test (eval-string "#( . )") 'error)
+(test (eval-string "#(1 . )") 'error)
+(test (eval-string "#(. . . )") 'error)
+(test (eval-string "#(1 . . 2)") 'error)
+(test (eval-string "'(. 1)") 'error)
+(test (eval-string "#(. 1)") 'error)
+(test (eval-string "'(. )") 'error)
+(test (eval-string "#(. )") 'error)
+(test (eval-string "(list 1 . 2)") 'error)
+(test (eval-string "(+ 1 . 2)") 'error)
+(test (eval-string "(car '@#`')") 'error)
+(test (eval-string "(list . )") 'error)
+(test (eval-string "#( .)") 'error)
+(test (eval-string "(car '( .))") 'error)
+(test (eval-string "(let ((. 3)) .)") 'error)
+(test (eval-string "#0d()") 'error)
+(test (eval-string "`#0d()") 'error)
+(test (eval-string "'#t:") 'error) ; guile interprets this as #t : and complains unbound variable :
+(test (eval-string "#t1") 'error) ; similarly this is #t 1 in guile
+(test (eval-string "#(1 . 2)") 'error)
+(test (eval-string "#(1 2 . 3)") 'error)
+(test (eval-string "'#'") 'error)
+(test (eval-string "#b") 'error)
+(test (eval-string "(+ 123") 'error)
+(test (eval-string "(+ 123 0000000000") 'error)
+
+(test (eval-string "(+ 1 2)") 3)
+(test (eval '(+ 1 2)) 3)
+(test (eval `(,+ ,1 ,2)) 3)
+(test (eval (list + 1 2)) 3)
+(test (eval `(+ 1 (eval `(* 2 3)))) 7)
+(test (eval `(+ 1 (eval-string "(* 2 3)"))) 7)
+(test (eval-string "(+ 1 (eval-string \"(* 2 3)\"))") 7)
+(test (eval `(+ 1 2 . 3)) 'error)
+(test (eval-string) 'error)
+(test (eval) 'error)
+(test (eval-string "") #f)
+(test (eval ()) ())
+(test (eval ()) ())
+(test (eval-string "1" () ()) 'error)
+(test (eval () () ()) 'error)
+(test (eval "1") "1")
+(test (eval-string #t) 'error)
+(test (eval #(+ 1 2)) #(+ 1 2))
+(test (+ 1 (values (eval-string "(catch #t (lambda () asdf) (lambda args 2))") (eval-string "(catch #t (lambda () asdf) (lambda args 3))"))) 6)
+
+(let () (define e1 (let ((a 10)) (curlet))) (test (eval 'a e1) 10)) ; from andy wingo
+(let () (define e1 (let ((a 10)) (curlet))) (eval '(set! a 32) e1) (test (eval 'a e1) 32))
+
+(test (eval '(begin (define __eval_var__ 1) __eval_var__) (rootlet)) 1)
+(test (let () __eval_var__) 1)
+(test (eval-string "(begin (define __eval_var1__ 12) __eval_var1__)" (rootlet)) 12)
+(test (let () __eval_var1__) 12)
+(test (let () (eval '(begin (define __eval_var2__ 123) __eval_var__) (curlet)) __eval_var2__) 123)
+(test (let () __eval_var2__) 'error)
+
+;; from scheme wg
+(let ((x (list 'cons 1 2))
+ (y (list (list 'quote 'cons) 1 2)))
+ (set-car! x cons)
+ (set-car! (cdar y) cons)
+ (test (eval x) (eval y)))
+(test (eval (list 'cons 1 2)) (eval (list cons 1 2)))
+(let ((f (lambda (a) (+ a 1))))
+ (test (eval (list 'f 2)) (eval (list f 2))))
+
+(test (apply "hi" 1 ()) #\i)
+(test (eval ("hi" 1)) #\i)
+(test (apply + 1 1 (cons 1 (quote ()))) 3)
+(test (eq? (eval (quote (quote ()))) ()) #t)
+(test (apply (cons (quote cons) (cons 1 (quote ((quote ()))))) 1 ()) 1) ; essentially ((list 'cons 1 ...) 1) => 1
+(test (eval ((cons (quote cons) (cons 1 (quote ((quote ()))))) 1)) 1)
+(test (eval (eval (list '+ 1 2))) 3)
+
+(test (eval if) if)
+(test (eval quote) quote)
+(test (eval (eval (list define* #(1)))) 'error)
+(test (eval (eval (list lambda* ()))) 'error)
+(test (eval (eval (list letrec "hi"))) 'error)
+(test (eval (eval (cons define-macro 1))) 'error)
+(test (eval (eval (cons quote "hi"))) 'error)
+(test (eval (eval (list and "hi"))) "hi")
+
+(test (apply + (+ 1) ()) 1)
+(test (apply #(1) (+) ()) 1)
+(test (apply + (+) ()) 0)
+(test (eval #()) #())
+(test (apply (lambda () #f)) #f)
+(test (eval '(if #f #f)) (if #f #f))
+(test (let ((ho 32)) (symbol? (eval (eval (eval (eval '''''ho)))))) #t)
+(test (eval '(case 0 ((1) 2) ((0) 1))) 1)
+(test (eval '(cond ((= 1 2) 3) (#t 4))) 4)
+
+(test (eval-string (string-append "(list 1 2 3)" (string #\newline) (string #\newline))) (list 1 2 3))
+(eval-string (string-append "(define evalstr_1 32)" (string #\newline) "(define evalstr_2 2)"))
+(test (eval-string "(+ evalstr_1 evalstr_2)") 34)
+(eval-string (string-append "(set! evalstr_1 3)" "(set! evalstr_2 12)"))
+(test (eval-string "(+ evalstr_1 evalstr_2)") 15)
+
+(test (+ (eval `(values 1 2 3)) 4) 10)
+(test (+ (eval-string "(values 1 2 3)") 4) 10)
+(test (+ 1 (eval-string "(+ 2 3)") 4) 10)
+(test ((eval-string "(lambda (a) (+ a 1))") 2) 3)
+(test (eval ((eval-string "(lambda (a) (list '+ a 1))") 2)) 3)
+(test (eval-string "(+ 1 (eval (list '+ 1 2)))") 4)
+
+(test (eq? (eval-string "else") else) #t)
+(test (eq? (with-input-from-string "else" read) else) #f)
+(test (eq? (with-input-from-string "lambda" read) lambda) #f)
+(test (eq? (eval-string "lambda") lambda) #t)
+(test (((eval-string "lambda") () (+ 1 2))) 3)
+(test (symbol? (eval-string "lambda")) #f)
+(test (symbol? (with-input-from-string "lambda" read)) #t)
+(test (eq? (with-input-from-string "else" (lambda () (eval (read)))) else) #t)
+
+(test (eval-string "'___a ; b") '___a)
+(test (eval-string "'___a #| b |#") '___a)
+(test (eval-string "'___a 1") 1)
+(test (eval-string "'___a ; 2\n3") 3)
+
+(for-each
+ (lambda (arg)
+ (test (eval-string arg) 'error))
+ (list -1 0 1 512 #\a #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi :hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+(for-each
+ (lambda (arg)
+ (test (eval-string "(+ 1 2)" arg) 'error))
+ (list -1 0 1 512 #\a #(1 2 3) 3.14 2/3 1.5+0.3i 1+i 'hi abs "hi" :hi #(()) (lambda () 1)))
+
+
+(test (let () (define-macro (hiho a) `(+ ,a 1)) (hiho 3)) 4)
+(test (let () (define-macro (hiho) `(+ 3 1)) (hiho)) 4)
+(test (let () (define-macro (hiho) `(+ 3 1)) (hiho 1)) 'error)
+(test (let () (define-macro (hi a) `(+ , at a)) (hi (1 2 3))) 6)
+(test (let () (define-macro (hi a) `(+ ,a 1) #f) (hi 2)) #f)
+(test (let () (define-macro (mac1 a) `',a) (equal? (mac1 (+ 1 2)) '(+ 1 2))) #t)
+(test (let () (define-macro (hi . a) `, at a) (hi 1)) 1)
+
+(test (let () (define-macro (hi a) `(+ , a 1)) (hi 1)) 2)
+(test (let () (define-macro (hi a) `(eval `(+ ,,a 1))) (hi 1)) 2)
+(test (let () (define-macro (hi a) `(eval (let ((a 12)) `(+ ,,a 1)))) (hi 1)) 2)
+(test (let () (define-macro (hi a) `(eval (let ((a 12)) `(+ ,a 1)))) (hi 1)) 13)
+(test (let () (define-macro (hi a) `(eval (let ((a 12)) `(let ((a 100)) (+ ,a 1))))) (hi 1)) 13)
+(test (let () (define-macro (hi a) `(eval (let ((a 12)) `(let ((a 100)) (+ a 1))))) (hi 1)) 101)
+
+(test (let () (define-macro (hi q) ``(,,q)) (hi (* 2 3))) '(6))
+(test (let () (define-macro (hi q) `(let ((q 32)) `(,,q))) (hi (* 2 3))) '(6))
+(test (let () (define-macro (hi q) `(let ((q 32)) `(,q))) (hi (* 2 3))) '(32))
+(test (let () (define-macro (hi q) `(let () ,@(list q))) (hi (* 2 3))) 6)
+
+(test (let () (define-macro (tst a) ``(+ 1 ,,a)) (tst 2)) '(+ 1 2))
+(test (let () (define-macro (tst a) ```(+ 1 ,,,a)) (eval (tst 2))) '(+ 1 2))
+(test (let () (define-macro (tst a) ``(+ 1 ,,a)) (tst (+ 2 3))) '(+ 1 5))
+(test (let () (define-macro (tst a) ``(+ 1 ,@,a)) (tst '(2 3))) '(+ 1 2 3))
+(test (let () (define-macro (tst a) ``(+ 1 ,, at a)) (tst (2 3))) '(+ 1 2 3))
+(test (let () (define-macro (tst a) ```(+ 1 ,,, at a)) (eval (tst (2 3)))) '(+ 1 2 3))
+(test (let () (define-macro (tst a) ```(+ 1 ,,@, at a)) (eval (tst ('(2 3))))) '(+ 1 2 3))
+(test (let () (define-macro (tst a) ````(+ 1 ,,,, at a)) (eval (eval (eval (tst (2 3)))))) 6)
+(test (let () (define-macro (tst a) ``(+ 1 ,@, at a)) (tst ('(2 3)))) '(+ 1 2 3))
+(test (let () (define-macro (tst a b) `(+ 1 ,a (apply * `(2 ,, at b)))) (tst 3 (4 5))) 44)
+(test (let () (define-macro (tst . a) `(+ 1 , at a)) (tst 2 3)) 6)
+(test (let () (define-macro (tst . a) `(+ 1 , at a (apply * `(2 ,, at a)))) (tst 2 3)) 18)
+(test (let () (define-macro (tst a) ```(+ 1 ,@,@, at a)) (eval (tst ('('(2 3)))))) '(+ 1 2 3))
+
+(test (let () (define-macro (hi a) `(+ ,a 1)) (procedure? hi)) #f)
+(test (let () (define-macro (hi a) `(let ((@ 32)) (+ @ ,a))) (hi @)) 64)
+(test (let () (define-macro (hi @) `(+ 1 ,@@)) (hi (2 3))) 6) ; ,@ is ambiguous
+(test (let () (define-macro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4)
+(test (let () (define-macro (hi a) (if (list? a) `(+ 1 , at a) `(+ 1 ,a))) (* (hi 1) (hi (2 3)))) 12)
+
+(test (let ((x 1)) (eval `(+ 3 ,x))) 4)
+(test (let ((x 1)) (eval (eval `(let ((x 2)) `(+ 3 ,x ,,x))))) 6)
+(test (let ((x 1)) (eval (eval (eval `(let ((x 2)) `(let ((x 3)) `(+ 10 ,x ,,x ,,,x))))))) 16)
+(test (let ((x 1)) (eval (eval (eval (eval `(let ((x 2)) `(let ((x 3)) `(let ((x 30)) `(+ 100 ,x ,,x ,,,x ,,,,x))))))))) 136)
+
+(test (let () (define-bacro (hiho a) `(+ ,a 1)) (hiho 3)) 4)
+(test (let () (define-bacro (hiho) `(+ 3 1)) (hiho)) 4)
+(test (let () (define-bacro (hiho) `(+ 3 1)) (hiho 1)) 'error)
+(test (let () (define-bacro (hi a) `(+ , at a)) (hi (1 2 3))) 6)
+(test (let () (define-bacro (hi a) `(+ ,a 1) #f) (hi 2)) #f)
+(test (let () (define-bacro (mac1 a) `',a) (equal? (mac1 (+ 1 2)) '(+ 1 2))) #t)
+(test (let () (define-bacro (tst a) ``(+ 1 ,,a)) (tst 2)) '(+ 1 2))
+(test (let () (define-bacro (tst a) ```(+ 1 ,,,a)) (eval (tst 2))) '(+ 1 2))
+(test (let () (define-bacro (tst a) ``(+ 1 ,,a)) (tst (+ 2 3))) '(+ 1 5))
+(test (let () (define-bacro (tst a) ``(+ 1 ,@,a)) (tst '(2 3))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a) ``(+ 1 ,, at a)) (tst (2 3))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a) ```(+ 1 ,,, at a)) (eval (tst (2 3)))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a) ```(+ 1 ,,@, at a)) (eval (tst ('(2 3))))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a) ````(+ 1 ,,,, at a)) (eval (eval (eval (tst (2 3)))))) 6)
+(test (let () (define-bacro (tst a) ``(+ 1 ,@, at a)) (tst ('(2 3)))) '(+ 1 2 3))
+(test (let () (define-bacro (tst a b) `(+ 1 ,a (apply * `(2 ,, at b)))) (tst 3 (4 5))) 44)
+(test (let () (define-bacro (tst . a) `(+ 1 , at a)) (tst 2 3)) 6)
+(test (let () (define-bacro (tst . a) `(+ 1 , at a (apply * `(2 ,, at a)))) (tst 2 3)) 18)
+(test (let () (define-bacro (tst a) ```(+ 1 ,@,@, at a)) (eval (tst ('('(2 3)))))) '(+ 1 2 3))
+(test (let () (define-bacro (hi a) `(+ ,a 1)) (procedure? hi)) #f)
+(test (let () (define-bacro (hi a) `(let ((@ 32)) (+ @ ,a))) (hi @)) 64)
+(test (let () (define-bacro (hi @) `(+ 1 ,@@)) (hi (2 3))) 6) ; ,@ is ambiguous
+(test (let () (define-bacro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4)
+(test (let () (define-bacro (hi a) (if (list? a) `(+ 1 , at a) `(+ 1 ,a))) (* (hi 1) (hi (2 3)))) 12)
+
+(test (let () (define-bacro (hiho a) `(+ ,a 1)) (macro? hiho)) #t)
+(test (let () (define-bacro* (hiho (a 1)) `(+ ,a 1)) (macro? hiho)) #t)
+(test (let () (define-macro (hiho a) `(+ ,a 1)) (macro? hiho)) #t)
+(test (let () (define-macro* (hiho (a 1)) `(+ ,a 1)) (macro? hiho)) #t)
+
+#|
+(define-macro (when2 test . body)
+ `((apply lambda (list '(test) '(if test (let () , at body)))) ,test))
+
+(define-macro (when2 test . body)
+ `(if ,test (let () , at body)))
+
+(define-macro (when2 test . body)
+ `((lambda (test) (if test (let () , at body))) ,test))
+
+(define-macro (when2 test . body)
+ `(let ((func (apply lambda `(() ,, at body))))
+ (if ,test (func))))
+|#
+
+(test (define-macro) 'error)
+(test (define-macro 1) 'error)
+(test (define-macro . 1) 'error)
+(test (apply define-macro '(1)) 'error)
+(test (define-macro (1 2 3)) 'error)
+(test (define-macro (1 2) 3) 'error)
+(test (define-macro (a)) 'error)
+(test (define-macro (a)) 'error)
+(test (define-macro (a 1) 2) 'error)
+(test (define-macro . a) 'error)
+(test (define :hi 1) 'error)
+(test (define hi: 1) 'error)
+(test (define-macro (:hi a) `(+ ,a 1)) 'error)
+(test (define-macro (:hi a) `(+ ,a 1)) 'error)
+(test (define-macro (hi 1 . 2) 1) 'error)
+(test (define-macro (hi) 1 . 2) 'error)
+(test (define-macro (:) "" . #(1)) 'error)
+(test (defmacro : #(1) . :) 'error)
+(test (defmacro hi ()) 'error)
+(test (define-macro (mac . 1) 1) 'error)
+(test (define-macro (mac 1) 1) 'error)
+(test (define-macro (a #()) 1) 'error)
+(test (define-macro (i 1) => (j 2)) 'error)
+(test (define hi 1 . 2) 'error)
+(test (defmacro hi hi . hi) 'error)
+(test (define-macro (hi hi) . hi) 'error)
+(test (((lambda () (define-macro (hi a) `(+ 1 ,a)) hi)) 3) 4)
+
+(test (let () (define-macro (hi a b) `(list , at a . , at b)) (hi (1 2) ((2 3)))) '(1 2 2 3))
+(test (let () (define-macro (hi a b) `(list , at a . ,b)) (hi (1 2) (2 3))) '(1 2 2 3))
+(test (let () (define-macro (hi a b) `(list , at a , at b)) (hi (1 2) (2 3))) '(1 2 2 3))
+
+
+(let ((vals #(0 0)))
+
+#|
+ (let ()
+ (define (hi a) (+ 1 a))
+ (define (use-hi b) (hi b))
+ (set! (vals 0) (use-hi 1))
+ (define (hi a) (+ 2 a))
+ (set! (vals 1) (use-hi 1))
+ (test vals #(2 3))) ; hmmm, or possibly #(2 2)... see comment above (line 13494 or thereabouts)
+|#
+
+ (let ()
+ (define-macro (hi a) `(+ 1 ,a))
+ (define (use-hi b) (hi b))
+ (set! (vals 0) (use-hi 1))
+ (define-macro (hi a) `(+ 2 ,a))
+ (set! (vals 1) (use-hi 1))
+ (test vals #(2 3)))
+ (let ()
+ (define (use-hi b) (hhi b))
+ (define-macro (hhi a) `(+ 1 ,a))
+ (set! (vals 0) (use-hi 1))
+ (define-macro (hhi a) `(+ 2 ,a))
+ (set! (vals 1) (use-hi 1))
+ (test vals #(2 3))))
+
+(test (let ()
+ (define-macro (hanger name-and-args)
+ `(define ,(car name-and-args)
+ (+ ,@(map (lambda (arg) arg) (cdr name-and-args)))))
+ (hanger (hi 1 2 3))
+ hi)
+ 6)
+(test (let ()
+ (define-macro (hanger name-and-args)
+ `(define-macro (,(car name-and-args))
+ `(+ ,@(map (lambda (arg) arg) (cdr ',name-and-args)))))
+ (hanger (hi 1 2 3))
+ (hi))
+ 6)
+
+(let ()
+ ;; inspired by Doug Hoyte, "Let Over Lambda"
+ (define (mcxr path lst)
+ (define (cxr-1 path lst)
+ (if (null? path)
+ lst
+ (if (char=? (car path) #\a)
+ (cxr-1 (cdr path) (car lst))
+ (cxr-1 (cdr path) (cdr lst)))))
+ (let ((p (string->list (symbol->string path))))
+ (if (char=? (car p) #\c)
+ (set! p (cdr p)))
+ (let ((p (reverse p)))
+ (if (char=? (car p) #\r)
+ (set! p (cdr p)))
+ (cxr-1 p lst))))
+
+ (test (mcxr 'cr '(1 2 3)) '(1 2 3))
+ (test (mcxr 'cadddddddr '(1 2 3 4 5 6 7 8)) 8)
+ (test (mcxr 'caadadadadadadadr '(1 (2 (3 (4 (5 (6 (7 (8))))))))) 8)
+
+ (define-macro (cxr path lst)
+ (let ((p (string->list (symbol->string path))))
+ (if (char=? (car p) #\c)
+ (set! p (cdr p)))
+ (let ((p (reverse p)))
+ (if (char=? (car p) #\r)
+ (set! p (cdr p)))
+ (let ((func 'arg))
+ (for-each
+ (lambda (f)
+ (set! func (list (if (char=? f #\a) 'car 'cdr) func)))
+ p)
+ `((lambda (arg) ,func) ,lst)))))
+
+ (test (cxr car '(1 2 3)) 1)
+ (test (cxr cadddddddr '(1 2 3 4 5 6 7 8)) 8)
+ (test (cxr caadadadadadadadr '(1 (2 (3 (4 (5 (6 (7 (8))))))))) 8)
+ )
+
+;; this is the best of them!
+(let ()
+ (define-macro (c?r path)
+ ;; here "path" is a list and "X" marks the spot in it that we are trying to access
+ ;; (a (b ((c X)))) -- anything after the X is ignored, other symbols are just placeholders
+ ;; c?r returns a function that gets X
+
+ ;; maybe ... for cdr? (c?r (a ...); right now it's using dot: (c?r (a . X)) -> cdr
+
+ ;; (c?r (a b X)) -> caddr,
+ ;; (c?r (a (b X))) -> cadadr
+ ;; ((c?r (a a a X)) '(1 2 3 4 5 6)) -> 4
+ ;; ((c?r (a (b c X))) '(1 (2 3 4))) -> 4
+ ;; ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 6
+ ;; ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 4
+ ;; (procedure-source (c?r (((((a (b (c (X (e f))))))))))) -> (lambda (lst) (car (car (cdr (car (cdr (car (cdr (car (car (car (car lst))))))))))))
+
+ (define (X-marks-the-spot accessor tree)
+ (if (pair? tree)
+ (or (X-marks-the-spot (cons 'car accessor) (car tree))
+ (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
+ (if (eq? tree 'X)
+ accessor
+ #f)))
+
+ (let ((accessor (X-marks-the-spot () path)))
+ (if (not accessor)
+ (error "can't find the spot! ~A" path)
+ (let ((len (length accessor)))
+ (if (< len 5) ; it's a built-in function
+ (let ((name (make-string (+ len 2))))
+ (set! (name 0) #\c)
+ (set! (name (+ len 1)) #\r)
+ (do ((i 0 (+ i 1))
+ (a accessor (cdr a)))
+ ((= i len))
+ (set! (name (+ i 1)) (if (eq? (car a) 'car) #\a #\d)))
+ (string->symbol name))
+ (let ((body 'lst)) ; make a new function to find the spot
+ (for-each
+ (lambda (f)
+ (set! body (list f body)))
+ (reverse accessor))
+ `(lambda (lst) ,body)))))))
+
+ (test ((c?r (a b X)) (list 1 2 3 4)) 3)
+ (test ((c?r (a (b X))) '(1 (2 3) ((4)))) 3)
+ (test ((c?r (a a a X)) '(1 2 3 4 5 6)) 4)
+ (test ((c?r (a (b c X))) '(1 (2 3 4))) 4)
+ (test ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 6)
+ (test ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 4))
+
+(let ()
+ (define-macro (nested-for-each args func . lsts)
+ (let ((body `(,func , at args)))
+ (for-each
+ (lambda (arg lst)
+ (set! body `(for-each
+ (lambda (,arg)
+ ,body)
+ ,lst)))
+ args lsts)
+ body))
+
+ ;;(nested-for-each (a b) + '(1 2) '(3 4)) ->
+ ;; (for-each (lambda (b) (for-each (lambda (a) (+ a b)) '(1 2))) '(3 4))
+
+ (define-macro (nested-map args func . lsts)
+ (let ((body `(,func , at args)))
+ (for-each
+ (lambda (arg lst)
+ (set! body `(map
+ (lambda (,arg)
+ ,body)
+ ,lst)))
+ args lsts)
+ body))
+
+ ;;(nested-map (a b) + '(1 2) '(3 4))
+ ;; ((4 5) (5 6))
+ ;;(nested-map (a b) / '(1 2) '(3 4))
+ ;; ((1/3 2/3) (1/4 1/2))
+
+ (test (nested-map (a b) + '(1 2) '(3 4)) '((4 5) (5 6)))
+ (test (nested-map (a b) / '(1 2) '(3 4)) '((1/3 2/3) (1/4 1/2)))
+ )
+
+(let ()
+ (define-macro (define-curried name-and-args . body)
+ `(define ,@(let ((newlst `(begin , at body)))
+ (define (rewrap lst)
+ (if (pair? (car lst))
+ (begin
+ (set! newlst (cons 'lambda (cons (cdr lst) (list newlst))))
+ (rewrap (car lst)))
+ (list (car lst) (list 'lambda (cdr lst) newlst))))
+ (rewrap name-and-args))))
+
+ (define-curried (((((f a) b) c) d) e) (* a b c d e))
+ (test (((((f 1) 2) 3) 4) 5) 120)
+ (define-curried (((((f a b) c) d e) f) g) (* a b c d e f g))
+ (test (((((f 1 2) 3) 4 5) 6) 7) 5040)
+ (define-curried (((foo)) x) (+ x 34))
+ (test (((foo)) 300) 334)
+ (define-curried ((foo-1) x) (+ x 34))
+ (test ((foo-1) 200) 234)
+ )
+
+
+(test (let ()
+ (define (set-cadr! a b)
+ (set-car! (cdr a) b)
+ b)
+ (let ((lst (list 1 2 3)))
+ (set-cadr! lst 32)
+ lst))
+ '(1 32 3))
+
+ ;;; macro?
+(test (macro? pi) #f)
+(test (macro? quasiquote) #t) ; s7_define_macro in s7.c
+(test (let ((m quasiquote)) (macro? m)) #t)
+(test (macro? macroexpand) #f) ; it's now syntactic
+(test (macro? cond) #f)
+(test (macro? letrec) #f)
+
+(for-each
+ (lambda (arg)
+ (test (macro? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () car abs (lambda () 1) #2d((1 2) (3 4)) _ht_ _null_ _c_obj_ #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi"))
+(test (macro?) 'error)
+
+(define-macro (fully-expand form)
+ (define (expand form)
+ (if (pair? form)
+ (if (and (symbol? (car form))
+ (macro? (symbol->value (car form))))
+ (expand (apply (eval (procedure-source (symbol->value (car form)))) (cdr form)))
+ (cons (expand (car form))
+ (expand (cdr form))))
+ form))
+ (expand form)) ; use (list 'quote (expand form)) to get fully-macroexpand of s7.html (see below)
+
+(define fe1-called #f)
+(define-macro (fe1 a) (set! fe1-called #t) `(+ ,a 1))
+(define fe2-called #f)
+(define-macro (fe2 b) (set! fe2-called #f) `(+ (fe1 ,b) 2))
+(fully-expand (define (fe3 c) (+ (fe2 c) (fe1 (+ c 1)))))
+(set! fe1-called #f)
+(set! fe2-called #f)
+(let ((val (fe3 3)))
+ (if (or (not (= val 11))
+ fe1-called
+ fe2-called)
+ (format-logged #t "fully-expand: ~A ~A ~A ~A~%" val (procedure-source fe3) fe1-called fe2-called)))
+
+(let ()
+ (define-macro (swap a b)
+ `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a)
+ (with-let e (set! ,a ,b))
+ tmp)))
+
+ ;; this doesn't know when to use the setter
+ (define-macro (fully-macroexpand form)
+ (define (expand form)
+ (if (pair? form)
+ (if (and (symbol? (car form))
+ (macro? (symbol->value (car form))))
+ (expand (apply (eval (procedure-source (symbol->value (car form)))) (cdr form)))
+ (cons (expand (car form))
+ (expand (cdr form))))
+ form))
+ (list 'quote (expand form)))
+
+ (define-macro (define-with-macros name&args . body)
+ `(apply define ',name&args (fully-macroexpand `(begin ,, at body))))
+
+ (define-with-macros (call3 x)
+ (let ((a 1) (b x))
+ (swap a b)
+ (list a b)))
+
+ (test (call3 4) '(4 1)))
+#|
+;;; here is the setter-aware form...
+
+(define-macro (fm1 form)
+ (define (expand form)
+ (if (pair? form)
+ (if (and (symbol? (car form))
+ (macro? (symbol->value (car form))))
+ (expand (apply macroexpand (list form)))
+ (if (and (eq? (car form) 'set!)
+ (pair? (cdr form))
+ (pair? (cadr form))
+ (macro? (symbol->value (caadr form))))
+ (expand (apply (eval (procedure-source (procedure-setter (symbol->value (caadr form)))))
+ (append (cdadr form) (cddr form))))
+ (cons (expand (car form))
+ (expand (cdr form)))))
+ form))
+ (list 'quote (expand form)))
+
+;this is broken
+(define-macro (define-safe-macro name&args . body)
+ `(define-macro ,name&args
+ (with-let (#_inlet (unlet)
+ ,@(#_let ((rest (#_if (#_list? name&args)
+ #f
+ (#_list-tail name&args (#_abs (#_length name&args))))))
+ (#_append
+ (#_map (#_lambda (b)
+ `(#_cons ',b ,b))
+ (#_cdr name&args))
+ (#_if rest `((#_cons ',rest ,rest)) ()))))
+ , at body)))
+
+|#
+
+(test (let ()
+ (define-macro (pop sym)
+ (let ((v (gensym "v")))
+ `(let ((,v (car ,sym)))
+ (set! ,sym (cdr ,sym))
+ ,v)))
+
+ (test (macro? pop) #t)
+
+ (let ((lst (list 1 2 3)))
+ (let ((val (pop lst)))
+ (and (= val 1)
+ (equal? lst (list 2 3))))))
+ #t)
+
+(define-macro (destructuring-bind lst expr . body)
+ `(let ((ex ,expr))
+
+ (define (flatten lst)
+ (cond ((null? lst) ())
+ ((pair? lst)
+ (if (pair? (car lst))
+ (append (flatten (car lst)) (flatten (cdr lst)))
+ (cons (car lst) (flatten (cdr lst)))))
+ (#t lst)))
+
+ (define (structures-equal? l1 l2)
+ (if (pair? l1)
+ (and (pair? l2)
+ (structures-equal? (car l1) (car l2))
+ (structures-equal? (cdr l1) (cdr l2)))
+ (not (pair? l2))))
+
+ (if (not (structures-equal? ',lst ex))
+ (error "~A and ~A do not match" ',lst ex))
+
+ (let ((names (flatten ',lst))
+ (vals (flatten ex)))
+ (apply (eval (list 'lambda names ', at body)) vals))))
+
+(test (destructuring-bind (a b) (list 1 2) (+ a b)) 3)
+(test (destructuring-bind ((a) b) (list (list 1) 2) (+ a b)) 3)
+(test (destructuring-bind (a (b c)) (list 1 (list 2 3)) (+ a b c)) 6)
+(test (let ((x 1)) (destructuring-bind (a b) (list x 2) (+ a b))) 3)
+
+#|
+(define-macro (destructuring-bind lst expr . body)
+ `(let ,(letrec ((flatten (lambda (lst1 lst2 args)
+ (cond ((null? lst1) args)
+ ((not (pair? lst1))
+ (cons (list lst1 lst2) args))
+ (#t (flatten (car lst1) (car lst2)
+ (flatten (cdr lst1) (cdr lst2) args)))))))
+ (flatten lst expr ()))
+ , at body))
+
+(format #t "~A~%" (destructuring-bind (a b) (1 2) (+ a b)))
+(format #t "~A~%" (destructuring-bind (a (b)) (1 (2)) (+ a b)))
+(format #t "~A~%" (destructuring-bind ((a b)) ((1 2)) (+ a b)))
+(format #t "~A~%" (destructuring-bind ((a (b c))) ((1 (2 1))) (+ a b)))
+(format #t "~A~%" (destructuring-bind (a b) (0 (+ 1 2)) (+ a b)))
+(format #t "~A~%" (destructuring-bind (a ((b))) ((+ 1 3) (((- 1 2)))) (+ a b)))
+(format #t "~A~%" (destructuring-bind (a ((b c)) d e) (1 ((2 3)) (+ 4 5) 6) (list a b c d e)))
+
+;; CL version:
+(define-macro (destructuring-bind-1 lst expr . body)
+ `(let ,(letrec ((flatten (lambda (lst1 lst2 args)
+ (cond ((null? lst1) args)
+ ((not (pair? lst1))
+ (cons (list lst1 (list 'quote lst2)) args))
+ (#t (flatten (car lst1) (car lst2)
+ (flatten (cdr lst1) (cdr lst2) args)))))))
+ (flatten lst (eval expr) ()))
+ , at body))
+
+(format #t "~A~%" (destructuring-bind-1 (a b) '(1 2) (list a b)))
+(format #t "~A~%" (destructuring-bind-1 (a (b)) '(1 (2)) (list a b)))
+(format #t "~A~%" (destructuring-bind-1 ((a b)) '((1 2)) (list a b)))
+(format #t "~A~%" (destructuring-bind-1 ((a (b c))) '((1 (2 1))) (list a b)))
+(format #t "~A~%" (destructuring-bind-1 (a b) '(0 (+ 1 2)) (list a b)))
+(format #t "~A~%" (destructuring-bind-1 (a ((b))) '((+ 1 3) (((- 1 2)))) (list a b)))
+(format #t "~A~%" (destructuring-bind-1 (a ((b c)) d e) '(1 ((2 3)) (4 5) 6) (list a b c d e)))
+
+;; CL version but values not quoted (I like this one)
+(define-macro (destructuring-bind-2 lst expr . body)
+ `(let ,(letrec ((flatten (lambda (lst1 lst2 args)
+ (cond ((null? lst1) args)
+ ((not (pair? lst1))
+ (cons (list lst1 lst2) args))
+ (#t (flatten (car lst1) (car lst2)
+ (flatten (cdr lst1) (cdr lst2) args)))))))
+ (flatten lst (eval expr) ()))
+ , at body))
+
+(format #t "~A~%" (destructuring-bind-2 (a b) (list 1 2) (+ a b)))
+(format #t "~A~%" (destructuring-bind-2 (a (b)) '(1 (2)) (+ a b)))
+(format #t "~A~%" (destructuring-bind-2 ((a b)) '((1 2)) (+ a b)))
+(format #t "~A~%" (destructuring-bind-2 ((a (b c))) '((1 (2 1))) (+ a b)))
+(format #t "~A~%" (destructuring-bind-2 (a b) '(0 (+ 1 2)) (+ a b)))
+(format #t "~A~%" (destructuring-bind-2 (a ((b))) '((+ 1 3) (((- 1 2)))) (+ a b)))
+(format #t "~A~%" (destructuring-bind-2 (a ((b c)) d e) '(1 ((2 3)) (+ 4 5) 6) (list a b c d e)))
+(format #t "~A~%" (let ((x 1)) (destructuring-bind-2 (a ((b))) '((+ x 3) (((- x 2)))) (+ a b))))
+|#
+
+
+(define-macro (once-only names . body)
+ (let ((gensyms (map (lambda (n) (gensym)) names)))
+ `(let (,@(map (lambda (g) `(,g (gensym))) gensyms))
+ `(let (,,@(map (lambda (g n) ``(,,g ,,n)) gensyms names))
+ ,(let (,@(map (lambda (n g) `(,n ,g)) names gensyms))
+ , at body)))))
+
+(let ()
+ (define-macro (hiho start end)
+ (once-only (start end)
+ `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
+
+ (test (let ((ctr 0))
+ (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
+ (let () (set! ctr (+ ctr 1)) ctr))))
+ (list ctr lst)))
+ '(2 (1 2 3 4))))
+
+(define-macro (once-only-2 names . body)
+ (let ((gensyms (map (lambda (n) (gensym)) names)))
+ `(let (,@(map (lambda (g) (list g '(gensym))) gensyms))
+ `(let (,,@(map (lambda (g n) (list list g n)) gensyms names))
+ ,(let (,@(map (lambda (n g) (list n g)) names gensyms))
+ , at body)))))
+
+(let ()
+ (define-macro (hiho start end)
+ (once-only-2 (start end)
+ `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
+
+ (test (let ((ctr 0))
+ (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
+ (let () (set! ctr (+ ctr 1)) ctr))))
+ (list ctr lst)))
+ '(2 (1 2 3 4))))
+
+;;; (define-bacro (once-only-1 names . body)
+;;; `(let (,@(map (lambda (name) `(,name ,(eval name))) names))
+;;; , at body))
+;;; can't be right: (let ((names 1)) (once-only (names) (+ names 1)))
+;;; if define-macro used here: syntax-error ("~A: unbound variable" start) in the example below
+
+(define once-only-1
+ (let ((names (gensym))
+ (body (gensym)))
+ (apply define-bacro
+ `((once ,names . ,body)
+ `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names))
+ ,@,body)))
+ once))
+
+(let ()
+ (define-bacro (hiho start end) ; note the bacro! not a macro here
+ (once-only-1 (start end)
+ `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
+
+ (test (let ((ctr 0))
+ (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
+ (let () (set! ctr (+ ctr 1)) ctr))))
+ (list ctr lst)))
+ '(2 (1 2 3 4)))
+
+ (test (let ((names 1)) (once-only-1 (names) (+ names 1))) 2)
+ (test (let ((body 1)) (once-only-1 (body) (+ body 1))) 2) ; so body above also has to be gensym'd
+ )
+
+
+(define once-only-3
+ (let ((names (gensym))
+ (body (gensym)))
+ (apply define-bacro `((,(gensym) ,names . ,body)
+ `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names))
+ ,@,body)))))
+
+(let ()
+ (define-bacro (hiho start end) ; note the bacro! not a macro here
+ (once-only-3 (start end)
+ `(list ,start ,end (+ 2 ,start) (+ ,end 2))))
+
+ (test (let ((ctr 0))
+ (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr)
+ (let () (set! ctr (+ ctr 1)) ctr))))
+ (list ctr lst)))
+ '(2 (1 2 3 4)))
+
+ (test (let ((names 1)) (once-only-3 (names) (+ names 1))) 2)
+ (test (let ((body 1)) (once-only-3 (body) (+ body 1))) 2) ; so body above also has to be gensym'd
+ )
+
+
+(let ()
+#|
+ (define setf
+ (let ((args (gensym)))
+ (apply define-bacro
+ `((setf-1 . ,args)
+ (if (not (null? ,args))
+ (begin
+ (apply set! (car ,args) (cadr ,args) ())
+ (apply setf (cddr ,args)))))) ; not setf-1 -- it's not defined except during the definition
+ setf-1))
+|#
+(define setf
+ (let ((args (gensym))
+ (name (gensym)))
+ (apply define-bacro `((,name . ,args)
+ (unless (null? ,args)
+ (apply set! (car ,args) (cadr ,args) ())
+ (apply setf (cddr ,args)))))))
+#|
+;; the bad form:
+(define-bacro (setf . args)
+ (if (not (null? args))
+ (begin
+ (apply set! (car args) (eval (cadr args)) ())
+ (apply setf (cddr args)))))
+|#
+
+ (define-macro (psetf . args)
+ (let ((bindings ())
+ (settings ()))
+ (do ((arglist args (cddr arglist)))
+ ((null? arglist))
+ (let* ((g (gensym)))
+ (set! bindings (cons (list g (cadr arglist)) bindings))
+ (set! settings (cons `(set! ,(car arglist) ,g) settings))))
+ `(let ,bindings , at settings)))
+
+ (test (let ((a 1) (b 2)) (setf a b b 3) (list a b)) '(2 3))
+ (test (let ((a 1) (b 2)) (setf a b b (+ a 3)) (list a b)) '(2 5))
+ (test (let ((a #(1)) (b 2)) (setf (a 0) b b (+ (a 0) 3)) (list a b)) '(#(2) 5))
+ (test (let ((a 1) (b 2)) (setf a b b a) (list a b)) '(2 2))
+ (test (let ((a 1) (b 2)) (setf a '(+ 1 2) b a) (list a b)) '((+ 1 2) (+ 1 2)))
+ (test (let ((args 1) (arg 1)) (setf args 2 arg 3) (list args arg)) '(2 3))
+ (test (let ((args 1) (arg 1)) (setf args (+ 2 3) arg args) (list args arg)) '(5 5))
+ (test (let ((args 1) (arg 1)) (setf args '(+ 2 3) arg (car args)) (list args arg)) '((+ 2 3) +))
+
+ (test (let ((a 1) (b 2)) (psetf a b b a) (list a b)) '(2 1))
+ (test (let ((a #(1)) (b 2)) (psetf (a 0) b b (+ (a 0) 3)) (list a b)) '(#(2) 4))
+ (test (let ((a 1) (b 2)) (psetf a '(+ 1 2) b a) (list a b)) '((+ 1 2) 1))
+ (test (let ((new-args 1)) (psetf new-args (+ new-args 1)) new-args) 2)
+ (test (let ((args 1) (arg 1)) (psetf args 2 arg 3) (list args arg)) '(2 3))
+ (test (let ((args 1) (arg 1)) (psetf args (+ 2 3) arg args) (list args arg)) '(5 1))
+ (test (let ((args 1) (arg 1)) (psetf args '(+ 2 3) arg (car args)) (list args arg)) 'error)
+ (test (let ((args '(1 2)) (arg 1)) (psetf args '(+ 2 3) arg (car args)) (list args arg)) '((+ 2 3) 1))
+ )
+
+(define-macro (with-gensyms names . body)
+ `(let ,(map (lambda (n) `(,n (gensym))) names)
+ , at body))
+
+(define-macro (define-clean-macro name-and-args . body)
+ ;; the new backquote implementation breaks this slightly -- it's currently confused about unquoted nil in the original
+ (let ((syms ()))
+
+ (define (walk func lst)
+ (if (and (func lst)
+ (pair? lst))
+ (begin
+ (walk func (car lst))
+ (walk func (cdr lst)))))
+
+ (define (car-member sym lst)
+ (if (null? lst)
+ #f
+ (if (eq? sym (caar lst))
+ (cdar lst)
+ (car-member sym (cdr lst)))))
+
+ (define (walker val)
+ (if (pair? val)
+ (if (eq? (car val) 'quote)
+ (or (car-member (cadr val) syms)
+ (and (pair? (cadr val))
+ (or (and (eq? (caadr val) 'quote) ; 'sym -> (quote (quote sym))
+ val)
+ (append (list 'list)
+ (walker (cadr val)))))
+ (cadr val))
+ (cons (walker (car val))
+ (walker (cdr val))))
+ (or (car-member val syms)
+ val)))
+
+ (walk (lambda (val)
+ (if (and (pair? val)
+ (eq? (car val) 'quote)
+ (symbol? (cadr val))
+ (not (car-member (cadr val) syms)))
+ (set! syms (cons
+ (cons (cadr val)
+ (gensym (symbol->string (cadr val))))
+ syms)))
+ (or (not (pair? val))
+ (not (eq? (car val) 'quote))
+ (not (pair? (cadr val)))
+ (not (eq? (caadr val) 'quote))))
+ body)
+
+ (let* ((new-body (walker body))
+ (new-syms (map (lambda (slot)
+ (list (cdr slot) '(gensym)))
+ syms))
+ (new-globals
+ (let ((result ()))
+ (for-each
+ (lambda (slot)
+ (if (defined? (car slot))
+ (set! result (cons
+ (list 'set! (cdr slot) (car slot))
+ result))))
+ syms)
+ result)))
+
+ `(define-macro ,name-and-args
+ (let ,new-syms
+ , at new-globals
+ `(begin ,, at new-body))))))
+
+
+(define-macro (define-immaculo name-and-args . body)
+ (let* ((gensyms (map (lambda (g) (gensym)) (cdr name-and-args)))
+ (args (cdr (copy name-and-args)))
+ (name (car name-and-args))
+ (set-args (map (lambda (a g) `(list ',g ,a)) args gensyms))
+ (get-args (map (lambda (a g) `(quote (cons ',a ,g))) args gensyms))
+ (blocked-args (map (lambda (a) `(,a ',a)) args))
+ (new-body (list (apply let blocked-args body))))
+ `(define-macro ,name-and-args
+ `(let ,(list , at set-args)
+ ,(list 'with-let
+ (append (list 'sublet)
+ (list (list 'funclet ,name))
+ (list , at get-args))
+ ', at new-body)))))
+
+;;; this is not perfect: if unquote is on expr involving an arg, it's going to be unhappy,
+;;; but we can always move the unquote in, so it's purely stylistic. Another way would
+;;; be to remove one level of unquotes throughout -- then the blocked-args and new-body
+;;; would be unneeded.
+
+;;; in fact, it's wrong -- in the body we need to make explicit let refs to avoid collisions
+;;; these tests are pointless
+(test (let () (define-clean-macro (hi a) `(+ ,a 1)) (hi 1)) 2)
+(test (let () (define-immaculo (hi a) `(+ ,a 1)) (hi 1)) 2)
+(test (let () (define-immaculo (hi a) `(let ((b 23)) (+ b ,a))) (hi 2)) 25)
+(test (let () (define-immaculo (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d)))) (mac 2 3)) 360)
+(test (let () (define-immaculo (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d)))) (let ((c 2) (d 3)) (mac c d))) 360)
+(test (let () (define-clean-macro (mac a . body) `(+ ,a , at body)) (mac 2 3 4)) 9)
+(test (let () (define-clean-macro (mac) (let ((a 1)) `(+ ,a 1))) (mac)) 2)
+(test (let () (define-immaculo (mac) (let ((a 1)) `(+ ,a 1))) (mac)) 2)
+(test (let () (define-immaculo (hi a) `(list 'a ,a)) (hi 1)) (list 'a 1))
+
+
+(test (let () (define-macro (hi a) `(+ 1 (if ,(= a 0) 0 (hi ,(- a 1))))) (hi 3)) 4)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) ((if #t hi abs) -3)) -2)
+(test (let () (apply define-macro '((m a) `(+ 1 ,a))) (m 2)) 3)
+(test (let () (apply (eval (apply define-macro '((m a) `(+ 1 ,a)))) '(3))) 4)
+(test (let () (apply (eval (apply define '((hi a) (+ a 1)))) '(2))) 3)
+(test (let () ((eval (apply define '((hi a) (+ a 1)))) 3)) 4)
+(test (let () ((eval (apply define-macro '((m a) `(+ 1 ,a)))) 3)) 4)
+(test (let () ((apply define '((hi a) (+ a 1))) 3)) 4)
+(test (let () ((apply define-macro '((m a) `(+ 1 ,a))) 3)) 4)
+(test (let ()
+ (define-macro (mu args . body)
+ (let ((m (gensym)))
+ `(apply define-macro '((,m , at args) , at body))))
+ ((mu (a) `(+ 1 ,a)) 3))
+ 4)
+(test (let () (define-macro (hi a) `(+ 1 ,a)) (map hi '(1 2 3))) '(2 3 4))
+(test (let () (define-macro (hi a) `(+ ,a 1)) (apply hi '(4))) 5)
+(test (let ()
+ (define-macro (hi a) `(+ ,a 1))
+ (define (fmac mac) (apply mac '(4)))
+ (fmac hi))
+ 5)
+(test (let ()
+ (define (make-mac)
+ (define-macro (hi a) `(+ ,a 1))
+ hi)
+ (let ((x (make-mac)))
+ (x 2)))
+ 3)
+
+(define-macro* (_mac1_) `(+ 1 2))
+(test (_mac1_) 3)
+(define-macro* (_mac2_ a) `(+ ,a 2))
+(test (_mac2_ 1) 3)
+(test (_mac2_ :a 2) 4)
+(define-macro* (_mac3_ (a 1)) `(+ ,a 2))
+(test (_mac3_) 3)
+(test (_mac3_ 3) 5)
+(test (_mac3_ :a 0) 2)
+(define-macro* (_mac4_ (a 1) (b 2)) `(+ ,a ,b))
+(test (_mac4_) 3)
+(test (_mac4_ :b 3) 4)
+(test (_mac4_ 2 :b 3) 5)
+(test (_mac4_ :b 10 :a 12) 22)
+(test (_mac4_ :a 4) 6)
+
+(define-bacro* (_mac21_) `(+ 1 2))
+(test (_mac21_) 3)
+(define-bacro* (_mac22_ a) `(+ ,a 2))
+(test (_mac22_ 1) 3)
+(test (_mac22_ :a 2) 4)
+(define-bacro* (_mac23_ (a 1)) `(+ ,a 2))
+(test (_mac23_) 3)
+(test (_mac23_ 3) 5)
+(test (_mac23_ :a 0) 2)
+(define-bacro* (_mac24_ (a 1) (b 2)) `(+ ,a ,b))
+(test (_mac24_) 3)
+(test (_mac24_ :b 3) 4)
+(test (_mac24_ 2 :b 3) 5)
+(test (_mac24_ :b 10 :a 12) 22)
+(test (_mac24_ :a 4) 6)
+
+(define-macro* (_mac11_) `(+ 1 2))
+(test (_mac11_) 3)
+(define-macro* (_mac12_ a) `(+ ,a 2))
+(test (_mac12_ 1) 3)
+(test (_mac12_ :a 2) 4)
+(define-macro* (_mac13_ (a 1)) `(+ ,a 2))
+(test (_mac13_) 3)
+(test (_mac13_ 3) 5)
+(test (_mac13_ :a 0) 2)
+(define-macro* (_mac14_ (a 1) (b 2)) `(+ ,a ,b))
+(test (_mac14_) 3)
+(test (_mac14_ :b 3) 4)
+(test (_mac14_ 2 :b 3) 5)
+(test (_mac14_ :b 10 :a 12) 22)
+(test (_mac14_ :a 4) 6)
+
+(define-bacro (symbol-set! var val) `(set! ,(symbol->value var) ,val))
+(test (let ((x 32) (y 'x)) (symbol-set! y 123) (list x y)) '(123 x))
+
+(define-bacro (symbol-eset! var val) `(set! ,(eval var) ,val))
+(test (let ((x '(1 2 3)) (y `(x 1))) (symbol-eset! y 123) (list x y)) '((1 123 3) (x 1)))
+(test (let ((x #(1 2 3)) (y `(x 1))) (symbol-eset! y 123) (list x y)) '(#(1 123 3) (x 1)))
+
+(let ()
+ (define-macro (hi a) `````(+ ,,,,,a 1))
+ (test (eval (eval (eval (eval (hi 2))))) 3)
+
+ (define-macro (hi a) `(+ ,@@a))
+ (test (hi (1 2 3)) 'error)
+
+ (define-macro (hi @a) `(+ ,@@a))
+ (test (hi (1 2 3)) 6))
+
+
+;;; --------------------------------------------------------------------------------
+;;; # readers
+;;; *#readers*
+;;;
+;;; #\; reader:
+
+(let ((old-readers *#readers*))
+
+ ;; testing *#readers* is slightly tricky because the reader runs before we evaluate the test expression
+ ;; so in these cases, the new reader use is always in a string
+
+ (set! *#readers* (list (cons #\s (lambda (str) 123))))
+ (let ((val (eval-string "(+ 1 #s1)"))) ; force this into the current reader
+ (test val 124))
+ (set! *#readers* ())
+
+ (set! *#readers*
+ (cons (cons #\t (lambda (str)
+ (string->number (substring str 1) 12)))
+ *#readers*))
+ (num-test (string->number "#tb") 11)
+ (num-test (string->number "#t11.3") 13.25)
+ (when (not pure-s7)
+ (num-test (string->number "#e#t11.3") 53/4)
+ (num-test (string->number "#t#e1.5") 17/12)
+ (num-test (string->number "#i#t1a") 22.0)
+ (num-test (string->number "#t#i1a") 22.0)) ; ??? this is analogous to #x#i1a = 26.0
+ (num-test (string->number "#t#t1a") 22.0)
+ (num-test (string->number "#t#t#t1a") 22.0)
+ (test (eval-string "#t") #t)
+ (test (eval-string "#T1") 'error)
+
+ (set! *#readers*
+ (cons (cons #\. (lambda (str)
+ (if (string=? str ".") (eval (read)) #f)))
+ *#readers*))
+
+ (test (eval-string "'(1 2 #.(* 3 4) 5)") '(1 2 12 5))
+ (num-test (string->number "#t1a") 22)
+ (test (eval-string "'(1 #t(2))") '(1 #t (2)))
+ (test (string->number "#t1r") #f)
+
+ (set! *#readers* (list (cons #\t (lambda (str)
+ ;; in the duplicated case: "t#t..."
+ (if (< (length str) 3)
+ (string->number (substring str 1) 12)
+ (and (not (char=? (str 1) #\#))
+ (not (char=? (str 2) #\t))
+ (string->number (substring str 1) 12)))))))
+ (test (string->number "#t#t1a") #f)
+
+ (set! *#readers* (cons (cons #\x (lambda (str)
+ (or (if (< (length str) 3)
+ (string->number (substring str 1) 7)
+ (and (not (char=? (str 1) #\#))
+ (not (char=? (str 2) #\x))
+ (string->number (substring str 1) 7)))
+ 'error)))
+ *#readers*))
+
+ (num-test (string->number "#x12") 9)
+ (num-test (string->number "#x-142.1e-1") -11.30612244898)
+ (when (not pure-s7)
+ (num-test (string->number "#e#x-142.1e-1") -554/49)
+ (num-test (string->number "#e#ta.a") 65/6))
+ (num-test (string->number "#t460.88") 648.72222222222)
+ (num-test (string->number "#x1") 1)
+ (test (string->number "#te") #f)
+ (num-test (string->number "#x10") 7)
+ (test (string->number "#x17") #f)
+ (num-test (string->number "#x106") 55)
+ (test (string->number "#x#t1") #f)
+
+ (let ()
+ (define (read-in-radix str radix)
+ ;; no error checking, only integers
+ (define (char->digit c)
+ (cond ((char-numeric? c)
+ (- (char->integer c) (char->integer #\0)))
+ ((char-lower-case? c)
+ (+ 10 (- (char->integer c) (char->integer #\a))))
+ (#t
+ (+ 10 (- (char->integer c) (char->integer #\A))))))
+ (let* ((negative (char=? (str 0) #\-))
+ (len (length str))
+ (j (if (or negative (char=? (str 0) #\+)) 2 1))) ; 1st char is "z"
+ (do ((sum (char->digit (str j))
+ (+ (* sum radix) (char->digit (str j)))))
+ ((= j (- len 1)) sum)
+ (set! j (+ j 1)))))
+
+ (set! *#readers* (list (cons #\z (lambda (str) (read-in-radix str 32)))))
+ (num-test (string->number "#z1p") 57)
+ )
+
+ (let ((p1 (dilambda (lambda (str) (string->number (substring str 1) 12)) (lambda (a) a))))
+ (set! *#readers* (list (cons #\t p1)))
+ (num-test (string->number "#ta") 10)
+ (num-test (string->number "#t11.6") 13.5)
+ (when (not pure-s7) (num-test (string->number "#e#t11.6") 27/2)))
+
+ (set! *#readers* old-readers)
+
+ (num-test (string->number "#x106") 262)
+ (num-test (string->number "#x17") 23)
+ )
+
+(let ((old-readers *#readers*)
+ (reader-file tmp-output-file))
+ ;; to test readers in a file, we need to write the file and load it, so here we go...
+ (set! *#readers* ())
+
+ (define circular-list-reader
+ (let ((known-vals #f)
+ (top-n -1))
+ (lambda (str)
+
+ (define (replace-syms lst)
+ ;; walk through the new list, replacing our special keywords
+ ;; with the associated locations
+
+ (define (replace-sym tree getter)
+ (if (keyword? (getter tree))
+ (let ((n (string->number (symbol->string (keyword->symbol (getter tree))))))
+ (if (integer? n)
+ (let ((lst (assoc n known-vals)))
+ (if lst
+ (set! (getter tree) (cdr lst))
+ (format *stderr* "#~D# is not defined~%" n)))))))
+
+ (define (walk-tree tree)
+ (if (pair? tree)
+ (begin
+ (if (pair? (car tree)) (walk-tree (car tree)) (replace-sym tree car))
+ (if (pair? (cdr tree)) (walk-tree (cdr tree)) (replace-sym tree cdr))))
+ tree)
+
+ (walk-tree (cdr lst)))
+
+ ;; str is whatever followed the #, first char is a digit
+ (let* ((len (length str))
+ (last-char (str (- len 1))))
+ (and (memq last-char '(#\= #\#)) ; is it #n= or #n#?
+ (let ((n (string->number (substring str 0 (- len 1)))))
+ (and (integer? n)
+ (begin
+ (if (not known-vals)
+ (begin
+ (set! known-vals ())
+ (set! top-n n)))
+
+ (if (char=? last-char #\=) ; #n=
+ (and (char=? (peek-char) #\()
+ (let ((cur-val (assoc n known-vals)))
+ ;; associate the number and the list it points to
+ ;; if cur-val, perhaps complain? (#n# redefined)
+ (let ((lst (catch #t
+ (lambda ()
+ (read))
+ (lambda args ; a read error
+ (set! known-vals #f) ; so clear our state
+ (apply throw args))))) ; and pass the error on up
+ (if (not cur-val)
+ (set! known-vals
+ (cons (set! cur-val (cons n lst)) known-vals))
+ (set! (cdr cur-val) lst)))
+
+ (if (= n top-n) ; replace our special keywords
+ (let ((result (replace-syms cur-val)))
+ (set! known-vals #f)
+ result)
+ (cdr cur-val))))
+ ; #n=<not a list>?
+
+ ;; else it's #n# -- set a marker for now since we may not
+ ;; have its associated value yet. We use a symbol name that
+ ;; string->number accepts.
+ (symbol->keyword
+ (symbol (string-append (number->string n) (string #\null) " ")))))))
+ ; #n<not an integer>?
+ ))))) ; #n<something else>?
+
+ (define (sharp-plus str)
+ ;; str here is "+", we assume either a symbol or a expression involving symbols follows
+ (let* ((e (if (string=? str "+")
+ (read) ; must be #+(...)
+ (string->symbol (substring str 1)))) ; #+feature
+ (expr (read)))
+ (if (symbol? e)
+ (if (provided? e)
+ expr
+ (values))
+ (if (pair? e)
+ (begin
+ (define (traverse tree)
+ (if (pair? tree)
+ (cons (traverse (car tree))
+ (if (null? (cdr tree)) () (traverse (cdr tree))))
+ (if (memq tree '(and or not))
+ tree
+ (and (symbol? tree)
+ (provided? tree)))))
+ (if (eval (traverse e))
+ expr
+ (values)))
+ (error "strange #+ chooser: ~S~%" e)))))
+
+ (set! *#readers*
+ (cons (cons #\+ sharp-plus)
+ (cons (cons #\. (lambda (str) (if (string=? str ".") (eval (read)) #f)))
+ (cons (cons #\; (lambda (str) (if (string=? str ";") (read)) (values)))
+ *#readers*))))
+
+ (when pure-s7 (set! *#readers* (append *#readers* old-readers)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! *#readers*
+ (cons (cons (integer->char (+ i (char->integer #\0))) circular-list-reader)
+ *#readers*)))
+
+ (call-with-output-file reader-file
+ (lambda (port)
+ (format port "(define x #.(+ 1 2 3))~%")
+ (format port "(define xlst '(1 2 3 #.(* 2 2)))~%")
+
+ (format port "(define y '#1=(2 . #1#))~%")
+ (format port "(define y1 '#1=(2 #2=(3 #3=(#1#) . #3#) . #2#))~%")
+ (format port "(define y2 #2D((1 2) (3 4)))~%")
+
+ (format port "#+s7 (define z 32)~%#+asdf (define z 123)~%")
+ (format port "#+(and complex-numbers (or snd s7)) (define z1 1)~%#+(and (not complex-numbers) (or asdf s7)) (define z1 123)~%")
+
+ (format port "(define x2 (+ 1 #;(* 2 3) 4))~%")
+ (format port "(define x3 (+ #;32 1 2))~%")
+ (format port "(define x4 (+ #; 32 1 2))~%")
+
+ (format port "(define y3 (+ 1 (car '#1=(2 . #1#))))~%")
+ (format port "(define y4 #.(+ 1 (car '#1=(2 . #1#))))~%")
+ (format port "(define y5 (+ 1 #.(* 2 3) #.(* 4 #.(+ 5 6))))~%")
+
+ (format port "(define r1 '(1 #. #;(+ 2 3) 4))~%")
+ (format port "(define r2 '(1 #. #;(+ 2 3) (* 2 4)))~%")
+ (format port "(define r3 '(1 #; #.(+ 2 3) (* 2 4)))~%")
+ (format port "(define r4 '(1 #. #1=(+ 2 3) (* 2 4)))~%")
+ (format port "(define r5 '(1 #. #1=(+ 2 #. 3) (* 2 4)))~%")
+ ;; but #.3 is ambiguous: '(1 #. #1=(+ 2 #.3) (* 2 4))
+ (format port "(define r6 '(1 #. #1=(+ 2 #+pi 3) (* 2 4)))~%")
+ (format port "(define r7 '(1 #. #1=(+ 2 #+pi #1#) (* 2 4)))~%")
+ (format port "(define r8 '(1 #+s7 #1=(1 2) 3))~%")
+ (format port "(define r9 '(1 #+asdf #1=(1 2) 3))~%")
+ (format port "(define r10 #. #1#)~%")
+ (format port "(define r13 #+s7 #e0.0)~%")
+ (format port "(define r14 #. #o1)~%")
+ (format port "(define r15 #. #_-)~%")
+ (format port "(define r16 (#+s7 #_- #d0))~%")
+ (format port "(define r17 (#. #_- #o1))~%")
+ (format port "(define r18 (#. #. #_+))~%")
+ (format port "(define r19 (#. #+s7 #_+))~%")
+ (format port "(define r20 (#+s7 #+s7 #_+))~%")
+ (format port "(define r21 (#_-(#_+ 1 2)3))~%")
+ (format port "(define r22 (#(#_+ 1 2)#o1))~%")
+ (format port "(define r23 (+ #;#1.##+asdf ))~%")
+ (format port "(define r24 (+ #. #;(#_+ 1 2)))~%")
+ (format port "(define r25 (+ #;#1=#2=))~%")
+ (format port "(define r26 (+ #;#2#(#_+ 1 2)))~%")
+ (format port "(define r27 (+ #;#1=.))~%")
+ (format port "(define r28 (+ #; #; #; ()))~%")
+ (format port "(define r29 (+ 3(#_+ 1 2)#;#. ))~%")
+ (format port "(define r30 (+ #;#2=#+asdf#+s7))~%")
+ (format port "(define r31 (+ #;#f#=#\\))~%")
+ (format port "(define r32 (#. + (#_-(#_+ 1 2))))~%")
+ (format port "(define r33 (+ 1 #+asdf #\\a 2))~%")
+ (format port "(define r34 (+ #++(#. #\\a)))~%")
+ (format port "(define r35 (+ #+s7 #; (33)))~%")
+
+ (format port "(define r36 (cos #. #. #. `(string->symbol \"pi\")))~%")
+ ))
+
+ (let ()
+ (load reader-file (curlet))
+ (if (not (= x 6)) (format-logged #t ";#.(+ 1 2 3) -> ~A~%" x))
+ (if (not (equal? xlst '(1 2 3 4))) (format-logged #t ";#.(* 2 2) -> ~A~%" xlst))
+ (if (not (equal? (object->string y) "#1=(2 . #1#)")) (format-logged #t ";'#1=(2 . #1#) -> ~S~%" (object->string y)))
+ (if (not (equal? (object->string y1) "#1=(2 #3=(3 #2=(#1#) . #2#) . #3#)"))
+ (format-logged #t ";'#1=(2 #2=(3 #3=(#1#) . #3#) . #2#) -> ~S~%" (object->string y1)))
+ (if (not (equal? y2 #2d((1 2) (3 4)))) (format-logged #t ";#2d((1 2) (3 4)) -> ~A~%" y2))
+ (if (not (= z 32)) (format-logged #t ";#+asdf? -> ~A~%" z))
+ (if (not (= z1 1)) (format-logged #t ";#(or ... +asdf)? -> ~A~%" z1))
+ (if (not (= x2 5)) (format-logged #t ";(+ 1 #;(* 2 3) 4) -> ~A~%" x2))
+ (if (not (= x3 3)) (format-logged #t ";(+ #;32 1 2) -> ~A~%" x3))
+ (if (not (= x4 3)) (format-logged #t ";(+ #; 32 1 2) -> ~A~%" x4))
+ (if (not (= y3 3)) (format-logged #t ";(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y3))
+ (if (not (= y4 3)) (format-logged #t ";#.(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y4))
+ (if (not (= y5 51)) (format-logged #t ";(+ 1 #.(* 2 3) #.(* 4 #.(+ 5 6))) -> ~A~%" y5))
+
+ (if (not (equal? r1 '(1 4))) (format-logged #t ";'(1 #. #;(+ 2 3) 4) -> ~A~%" r1))
+ (if (not (equal? r2 '(1 (* 2 4)))) (format-logged #t ";'(1 #. #;(+ 2 3) (* 2 4)) -> ~A~%" r2))
+ (if (not (equal? r3 '(1 (* 2 4)))) (format-logged #t ";'(1 #; #.(+ 2 3) (* 2 4)) -> ~A~%" r3))
+ (if (not (equal? r4 '(1 5 (* 2 4)))) (format-logged #t ";'(1 #. #1=(+ 2 3) (* 2 4)) -> ~A~%" r4))
+ (if (not (equal? r5 '(1 5 (* 2 4)))) (format-logged #t ";'(1 #. #1=(+ 2 #. 3) (* 2 4)) -> ~A~%" r5))
+ (if (not (equal? r6 '(1 2 (* 2 4)))) (format-logged #t ";'(1 #. #1=(+ 2 #+pi 3) (* 2 4)) -> ~A~%" r6))
+ (if (not (equal? r7 '(1 2 (* 2 4)))) (format-logged #t ";'(1 #. #1=(+ 2 #+pi #1#) (* 2 4)) -> ~A~%" r7))
+ (if (not (equal? r8 '(1 (1 2) 3))) (format-logged #t ";'(1 #+s7 #1=(1 2) 3) -> ~A~%" r8))
+ (if (not (equal? r9 '(1 3))) (format-logged #t ";'(1 #+asdf #1=(1 2) 3)) -> ~A~%" r9))
+ (if (not (equal? r10 ':1)) (format-logged #t ";#. #1# -> ~A~%" r10))
+ (if (not (equal? r13 0)) (format-logged #t ";#+s7 #e0.0 -> ~A~%" r13))
+ (if (not (equal? r14 1)) (format-logged #t ";#. #o1 -> ~A~%" r14))
+ (if (not (equal? r15 -)) (format-logged #t ";#. #_- -> ~A~%" r15))
+ (if (not (equal? r16 0)) (format-logged #t ";(#+s7 #_- #d0) -> ~A~%" r16))
+ (if (not (equal? r17 -1)) (format-logged #t ";(#. #_- #o1) -> ~A~%" r17))
+ (if (not (equal? r18 0)) (format-logged #t ";(#. #. #_+) -> ~A~%" r18))
+ (if (not (equal? r19 0)) (format-logged #t ";(#. #+s7 #_+) -> ~A~%" r19))
+ (if (not (equal? r20 0)) (format-logged #t ";(#+s7 #+s7 #_+) -> ~A~%" r20))
+ (if (not (equal? r21 0)) (format-logged #t ";(#_-(#_+ 1 2)3) -> ~A~%" r21))
+ (if (not (equal? r22 1)) (format-logged #t ";(#(#_+ 1 2)#o1) -> ~A~%" r22))
+ (if (not (equal? r23 0)) (format-logged #t ";(+ #;#1.##+asdf ) -> ~A~%" r23))
+ (if (not (equal? r24 0)) (format-logged #t ";(+ #. #;(#_+ 1 2)) -> ~A~%" r24))
+ (if (not (equal? r25 0)) (format-logged #t ";(+ #;#1=#2=) -> ~A~%" r25))
+ (if (not (equal? r26 3)) (format-logged #t ";(+ #;#2#(#_+ 1 2)) -> ~A~%" r26))
+ (if (not (equal? r27 0)) (format-logged #t ";(+ #;#1=.) -> ~A~%" r27))
+ (if (not (equal? r28 0)) (format-logged #t ";(+ #; #; #; ()) -> ~A~%" r28))
+ (if (not (equal? r29 6)) (format-logged #t ";(+ 3(#_+ 1 2)#;#. ) -> ~A~%" r29))
+ (if (not (equal? r30 0)) (format-logged #t ";(+ #;#2=#+asdf#+s7) -> ~A~%" r30))
+ (if (not (equal? r31 0)) (format-logged #t ";(+ #;#f#=#\\) -> ~A~%" r31))
+ (if (not (equal? r32 -3)) (format-logged #t ";(#. + (#_-(#_+ 1 2))) -> ~A~%" r32))
+ (if (not (equal? r33 3)) (format-logged #t ";(+ 1 #+asdf #\\a 2) -> ~A~%" r33))
+ (if (not (equal? r34 0)) (format-logged #t ";(+ #++(#. #\\a)) -> ~A~%" r34))
+ (if (not (equal? r35 0)) (format-logged #t ";(+ #+s7 #; (33)) -> ~A~%" r35))
+
+ (if (not (morally-equal? r36 -1.0)) (format-logged #t ";(cos #. #. #. `(string->symbol \"pi\")) -> ~A~%" r36))
+ )
+
+ (set! *#readers* old-readers)
+ )
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(begin
+ (define-macro (hi a) `(+ ,a 1))
+ (test (hi 2) 3)
+ (let ()
+ (define (ho b) (+ 1 (hi b)))
+ (test (ho 1) 3))
+ (let ((hi 32))
+ (test (+ hi 1) 33))
+ (letrec ((hi (lambda (a) (if (= a 0) 0 (+ 2 (hi (- a 1)))))))
+ (test (hi 3) 6))
+ (letrec* ((hi (lambda (a) (if (= a 0) 0 (+ 2 (hi (- a 1)))))))
+ (test (hi 3) 6))
+ (test (equal? '(hi 1) (quote (hi 1))) #t)
+ (test (list? '(hi 1)) #t)
+ (test (list? '(((hi 1)))) #t)
+ (test (equal? (vector (hi 1)) #(2)) #t)
+ (test (symbol? (vector-ref #(hi) 0)) #t))
+
+(define-macro (define-with-goto name-and-args . body)
+ ;; run through the body collecting label accessors, (label name)
+ ;; run through getting goto positions, (goto name)
+ ;; tie all the goto's to their respective labels (via set-cdr! essentially)
+
+ (define (find-accessor type)
+ (let ((labels ()))
+ (define (gather-labels accessor tree)
+ (if (pair? tree)
+ (if (equal? (car tree) type)
+ (begin
+ (set! labels (cons (cons (cadr tree)
+ (let ((body 'lst))
+ (for-each
+ (lambda (f)
+ (set! body (list f body)))
+ (reverse (cdr accessor)))
+ (dilambda
+ (apply lambda '(lst) (list body))
+ (apply lambda '(lst val) `((set! ,body val))))))
+ labels))
+ (gather-labels (cons 'cdr accessor) (cdr tree)))
+ (begin
+ (gather-labels (cons 'car accessor) (car tree))
+ (gather-labels (cons 'cdr accessor) (cdr tree))))))
+ (gather-labels () body)
+ labels))
+ (let ((labels (find-accessor 'label))
+ (gotos (find-accessor 'goto)))
+ (if (not (null? gotos))
+ (for-each
+ (lambda (goto)
+ (let* ((name (car goto))
+ (goto-accessor (cdr goto))
+ (label (assoc name labels))
+ (label-accessor (and label (cdr label))))
+ (if label-accessor
+ (set! (goto-accessor body) (label-accessor body))
+ (error 'bad-goto "can't find label: ~S" name))))
+ gotos))
+ `(define ,name-and-args
+ (let ((label (lambda (name) #f))
+ (goto (lambda (name) #f)))
+ , at body))))
+
+(let ()
+ (define-with-goto (g1 a)
+ (let ((x 1))
+ (if a
+ (begin
+ (set! x 2)
+ (goto 'the-end)
+ (set! x 3))
+ (set! x 4))
+ (label 'the-end)
+ x))
+
+ (define-with-goto (g2 a)
+ (let ((x a))
+ (label 'start)
+ (if (< x 4)
+ (begin
+ (set! x (+ x 1))
+ (goto 'start)))
+ x))
+
+ (test (g1 #f) 4)
+ (test (g1 #t) 2)
+ (test (g2 1) 4)
+ (test (g2 32) 32))
+
+(let ((sum 0))
+ (define-macro (define-with-goto-and-come-froms name-and-args . body)
+ (let ((labels ())
+ (gotos ())
+ (come-froms ()))
+
+ (define (collect-jumps tree)
+ (when (pair? tree)
+ (when (pair? (car tree))
+ (case (caar tree)
+ ((label) (set! labels (cons tree labels)))
+ ((goto) (set! gotos (cons tree gotos)))
+ ((come-from) (set! come-froms (cons tree come-froms)))
+ (else (collect-jumps (car tree)))))
+ (collect-jumps (cdr tree))))
+
+ (collect-jumps body)
+
+ (for-each
+ (lambda (goto)
+ (let* ((name (cadr (cadar goto)))
+ (label (member name labels (lambda (a b) (eq? a (cadr (cadar b)))))))
+ (if label
+ (set-cdr! goto (car label))
+ (error 'bad-goto "can't find label: ~S" name))))
+ gotos)
+
+ (for-each
+ (lambda (from)
+ (let* ((name (cadr (cadar from)))
+ (label (member name labels (lambda (a b) (eq? a (cadr (cadar b)))))))
+ (if label
+ (set-cdr! (car label) from)
+ (error 'bad-come-from "can't find label: ~S" name))))
+ come-froms)
+
+ `(define ,name-and-args
+ (let ((label (lambda (name) #f))
+ (goto (lambda (name) #f))
+ (come-from (lambda (name) #f)))
+ , at body))))
+
+ (define-with-goto-and-come-froms (hi)
+ (set! sum (+ sum 1))
+ (goto 'the-end)
+ (set! sum (+ sum 2))
+ (label 'the-end)
+ (set! sum (+ sum 4))
+ (label 'not-done)
+ (set! sum (+ sum 8))
+ (come-from 'not-done)
+ (set! sum (+ sum 16))
+ (newline)
+ sum)
+
+ (test (hi) 21))
+
+
+;;; --------------------------------------------------------------------------------
+;;; symbol-access
+
+(let ((p (open-output-string)))
+ (define e ; save environment for use below
+ (let ((x 3) ; always an integer
+ (y 3) ; always 3
+ (z 3)) ; report set!
+ (set! (symbol-access 'x) (lambda (s v) (if (integer? v) v x)))
+ (set! (symbol-access 'y) (lambda (s v) y))
+ (set! (symbol-access 'z) (lambda (s v) (format p "z ~A -> ~A~%" z v) v))
+ (set! x 3.3)
+ (set! y 3.3)
+ (set! z 3.3)
+ (curlet)))
+ (test (and (equal? (e 'x) 3) (equal? (e 'y) 3) (equal? (e 'z) 3.3)
+ (string=? (get-output-string p) "z 3 -> 3.3\n"))
+ #t)
+ (close-output-port p))
+
+(for-each
+ (lambda (arg)
+ (test (symbol-access arg) 'error)
+ (test (set! (symbol-access _int_) arg) 'error)
+ (let ((x 1))
+ (if (not (null? arg))
+ (test (set! (symbol-access 'x arg) (lambda (s v) 1)) 'error)))
+ (let ((_x_ 1))
+ (set! (symbol-access '_x_) (lambda (s v) v))
+ (set! _x_ arg)
+ (test _x_ arg)))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () #(()) (list 1 2 3) '(1 . 2) "hi"))
+
+(let ((_x_ 1))
+ (set! (symbol-access '_x_) (lambda (s v) v))
+ (define _x_ 32)
+ (test _x_ 32)
+ (define (_x_) 32)
+ (test (_x_) 32)
+ (let ((_x_ 3))
+ (test _x_ 3))
+ (define (hi _x_) _x_)
+ (test (hi 4) 4)
+ (test (do ((_x_ 0 (+ _x_ 1))) ((= _x_ 2) _x_)) 2)
+ (test ((inlet '_x_ -1) '_x_) -1)
+ (set! _x_ 32)
+ (test _x_ 32))
+
+(let ((_x_ 1))
+ (set! (symbol-access '_x_) (lambda (s v) #f))
+ (define _x_ 32) (test _x_ #f)
+ (test (set! _x_ 32) #f))
+
+(test (symbol-access) 'error)
+(let ((xyzzy 1)
+ (_int_ 'xyzzy))
+ (test (symbol-access 'xyzzy) #f)
+ (test (set! (symbol-access _int_) ()) 'error)
+ (test (set! (symbol-access _int_) '(#f)) 'error))
+
+(let ((_x1_ #f))
+ (set! (symbol-access '_x1_) (lambda (x y) 'error))
+ (test (set! _x1_ 32) 'error))
+
+(let ((x 1))
+ (set! (symbol-access 'x) (lambda (s v) x))
+ (let ((x 2))
+ (set! x 3)
+ (test x 3)
+ (set! (symbol-access 'x (curlet)) (lambda (s v) 32))
+ (set! x 1)
+ (test x 32))
+ (test x 1)
+ (set! x 2)
+ (test x 1))
+
+(let ()
+ (define (f1 x)
+ (let ((a x)
+ (b 2)
+ (c 3))
+ (set! (symbol-access 'b) (lambda (s v) (set! a (+ v c)) v))
+ (set! (symbol-access 'c) (lambda (s v) (set! a (+ b v)) v))
+ (set! a (+ b c))
+ (set! b (+ b 1))
+ (set! c 5)
+ a))
+ (f1 0)
+ (test (f1 0) 8))
+
+(test (symbol-access :rest) #f)
+(test (set! (symbol-access :allow-other-keys) #f) 'error)
+
+
+#|
+;;; these tests are problematic -- they might not fail as hoped, or they might generate unwanted troubles
+(let ((bad-ideas "
+ (define (bad-idea)
+ (let ((lst '(1 2 3)))
+ (let ((result (list-ref lst 1)))
+ (list-set! lst 1 (* 2.0 16.6))
+ (gc)
+ result)))
+
+ (define (bad-idea-1)
+ (let ((lst #(1 2 3)))
+ (let ((result (vector-ref lst 1)))
+ (vector-set! lst 1 (* 2.0 16.6))
+ (gc)
+ result)))
+ "))
+ (with-output-to-file tmp-output-file (lambda () (display bad-ideas)))
+ (load tmp-output-file))
+
+(num-test (bad-idea) 2)
+(let ((val (bad-idea)))
+ (if (equal? val 33.2)
+ (set! val (bad-idea)))
+ (if (equal? val 33.2)
+ (format-logged #t ";bad-idea 3rd time: ~A~%" val)))
+(num-test (bad-idea-1) 2)
+(let ((val (bad-idea-1)))
+ (if (equal? val 33.2)
+ (set! val (bad-idea-1)))
+ (if (equal? val 33.2)
+ (format-logged #t ";bad-idea-1 3rd time: ~A~%" val)))
+(set! (*s7* 'safety) 1)
+(load tmp-output-file)
+(num-test (bad-idea) 2)
+(num-test (bad-idea) 33.2)
+(num-test (bad-idea) 33.2)
+(num-test (bad-idea-1) 2)
+(num-test (bad-idea-1) 33.2)
+(num-test (bad-idea-1) 33.2)
+(set! (*s7* 'safety) 0)
+|#
+
+;(test (quit 0) 'error)
+
+;;; macroexpand
+(let ()
+ (define-macro (hi a) `(+ ,a 1))
+ (test (macroexpand (hi 2)) '(+ 2 1))
+ (test (macroexpand (hi (abs 2))) '(+ (abs 2) 1))
+ (define-macro (ho a) `(+ , at a 1))
+ (test (macroexpand (ho (2 3 4))) '(+ 2 3 4 1))
+ (define-macro* (hi1 a (b 2)) `(+ ,a ,b))
+ (test (macroexpand (hi1 3)) '(+ 3 2))
+ (define-bacro* (hi2 a (b 2)) `(+ ,a ,b))
+ (test (macroexpand (hi2 3)) '(+ 3 2))
+ )
+
+(let ()
+ (define-macro (Let vars . body)
+ `(with-let (sublet (curlet)
+ ,@(map (lambda (var)
+ (values (symbol->keyword (car var)) (cadr var)))
+ vars))
+ , at body))
+ (test (Let ((c 4)) (Let ((a 2) (b (+ c 2))) (+ a b c))) 12)
+ (test (macroexpand (Let ((a 2) (b (+ c 2))) (+ a b c))) '(with-let (sublet (curlet) :a 2 :b (+ c 2)) (+ a b c))))
+
+(let ()
+ (define-macro (m1 . args) `(begin , at args))
+ (test (macroexpand (m1 (display 1) (newline))) '(begin (display 1) (newline))))
+
+(test (let ((a 3) (b (list 2 3 4))) (quasiquote (+ ,a 1 , at b))) '(+ 3 1 2 3 4))
+(test (let ((a 3) (b (list 2 3 4))) (macroexpand (quasiquote (+ ,a 1 , at b)))) (list {list} ''+ 'a 1 (list {apply_values} 'b)))
+
+(let ()
+ (define-macro* (m2 (a 3) (b 2)) `(+ ,a ,b))
+ (test (macroexpand (m2)) '(+ 3 2))
+ (test (macroexpand ((symbol->value 'm2) (* 2 3))) '(+ (* 2 3) 2)))
+
+(let ()
+ (define-bacro (m3 b) `(+ ,a ,b))
+ (test (let ((a 3)) (macroexpand (m3 2))) '(+ 3 2)))
+
+(let ()
+ (define-macro (progv vars vals . body) `(apply (apply lambda ,vars ',body) ,vals))
+ (test (macroexpand (progv '(one two) '(1 2) (+ one two))) '(apply (apply lambda '(one two) '((+ one two))) '(1 2))))
+
+(let ()
+ (define-macro (Letrec* bindings . body)
+ (if (null? body)
+ (error 'syntax-error "letrec* has no body")
+ (if (not (list? bindings))
+ (error 'syntax-error "letrec* variables are messed up")
+ `(let (,@(map (lambda (var&init)
+ (list (car var&init) #<undefined>))
+ bindings))
+ ,@(map (lambda (var&init)
+ (if (not (null? (cddr var&init)))
+ (error 'syntax-error "letrec* variable has more than one value"))
+ (list 'set! (car var&init) (cadr var&init)))
+ bindings)
+ , at body))))
+ (test (macroexpand (Letrec* ((p (lambda (x) (+ 1 (q (- x 1)))))
+ (q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1))))))
+ (x (p 5))
+ (y x))
+ y))
+ '(let ((p #<undefined>) (q #<undefined>) (x #<undefined>) (y #<undefined>)) (set! p (lambda (x) (+ 1 (q (- x 1))))) (set! q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (set! x (p 5)) (set! y x) y)))
+
+(let ()
+ (define-macro (m5 a) `(define-macro (m6 b) `(+ 1 ,b ,,a)))
+ (test (macroexpand ((m5 3) 4)) '(+ 1 4 3)))
+
+(test (macroexpand) 'error)
+(test (macroexpand 1) 'error)
+(test (macroexpand . 1) 'error)
+(test (macroexpand (* 1 2)) 'error)
+(test (macroexpand (* 1 2) . 3) 'error)
+(test (macroexpand (* 1 2) 3) 'error)
+(test (macroexpand ((symbol->value 'abs) -1)) 'error)
+(test (macroexpand (1 2)) 'error)
+
+(let ()
+ (define-macro (rmac . args)
+ (if (null? args)
+ ()
+ (if (null? (cdr args))
+ `(display ',(car args))
+ (append (list 'begin `(display ',(car args)))
+ (append (list (apply macroexpand (list (append '(rmac) (cdr args))))))))))
+ (test (with-output-to-string
+ (lambda ()
+ (rmac a b c (+ 1 2) d)))
+ "abc(+ 1 2)d"))
+
+
+
+;;; define-expansion
+(define-expansion (_expansion_ a) `(+ ,a 1))
+(test (_expansion_ 3) 4)
+(test (macroexpand (_expansion_ 3)) `(+ 3 1))
+(test '(_expansion_ 3) (quote (_expansion_ 3)))
+(test (_expansion_ (+ (_expansion_ 1) 2)) 5)
+(test (let ((x _expansion_)) (x 3)) '(+ 3 1))
+(test (let ((x 3)) (define (hi a) (a x)) (hi _expansion_)) '(+ x 1))
+
+(define-expansion (whatever->zero . whatever) 0)
+(let ((val (+ 1 (whatever->zero 2 3) 4)))
+ (if (not (= val 5))
+ (format *stderr* "whatever->zero: ~A?" val)))
+
+
+
+;;; define-constant
+(test (let () (define-constant __c1__ 32) __c1__) 32)
+;(test (let () __c1__) 'error) ; changed my mind here -- s7 treats define-constant as a global operation now
+(test (let ((__c1__ 3)) __c1__) 'error)
+(test (let* ((__c1__ 3)) __c1__) 'error)
+(test (letrec ((__c1__ 3)) __c1__) 'error)
+(test (let () (define (__c1__ a) a) (__c1__ 3)) 'error)
+(test (let () (set! __c1__ 3)) 'error)
+
+(let ()
+ (define (df1 a) (set! pi a))
+ (test (df1 3.0) 'error)
+ (test (df1 #\a) 'error)
+ (define (df2 a b) (set! pi (+ a b)))
+ (test (df2 1.0 2.0) 'error)
+ (define (df3 a) (set! pi (+ pi 1)))
+ (test (df3 1) 'error)
+ (test (set! pi (abs pi)) 'error)
+ (test (set! pi pi) 'error) ; hmmm...
+ (test (define-constant pi pi) pi) ; but this is ok -- define-constant can be a no-op
+ (test (define-constant pi 3.0) 'error)
+ (test (define pi 3.0) 'error)
+ (test (define (pi a) a) 'error)
+ (test (define (f1 pi) pi) 'error)
+ (test (let ((pi 3.0)) pi) 'error)
+ (test (let* ((pi 3.0)) pi) 'error)
+ (test (letrec ((pi 3.0)) pi) 'error)
+ (test (letrec* ((pi 3.0)) pi) 'error)
+ (test (do ((pi 0 (+ pi 1))) ((= pi 3))) 'error)
+ )
+
+(let ((old-stdin *stdin*)
+ (old-closed (port-closed? *stdin*)))
+ (let ((tag (catch #t (lambda () (set! *stdin* #f)) (lambda args 'error))))
+ (if (or (not (eq? *stdin* old-stdin))
+ (not (eq? old-closed (port-closed? *stdin*))))
+ (format *stderr* ";*stdin* mutable?~%"))
+ (if (not (eq? tag 'error))
+ (format *stderr* ";set! *stdin* no error? ~A~%" tag))))
+
+(let ((old-stdout *stdout*)
+ (old-closed (port-closed? *stdout*)))
+ (let ((tag (catch #t (lambda () (set! *stdout* #f)) (lambda args 'error))))
+ (if (or (not (eq? *stdout* old-stdout))
+ (not (eq? old-closed (port-closed? *stdout*))))
+ (format *stderr* ";*stdout* mutable?~%"))
+ (if (not (eq? tag 'error))
+ (format *stderr* ";set! *stdout* no error? ~A~%" tag))))
+
+(let ((old-stderr *stderr*)
+ (old-closed (port-closed? *stderr*)))
+ (let ((tag (catch #t (lambda () (set! *stderr* #f)) (lambda args 'error))))
+ (if (or (not (eq? *stderr* old-stderr))
+ (not (eq? old-closed (port-closed? *stderr*))))
+ (format *stderr* ";*stderr* mutable?~%"))
+ (if (not (eq? tag 'error))
+ (format *stderr* ";set! *stderr* no error? ~A~%" tag))))
+
+(let ((old-pi pi))
+ (let ((tag (catch #t (lambda () (set! pi #f)) (lambda args 'error))))
+ (if (not (eq? pi old-pi))
+ (format pi ";pi mutable?~%"))
+ (if (not (eq? tag 'error))
+ (format pi ";set! pi no error? ~A~%" tag))))
+
+(let ((old-with-let with-let))
+ (let ((tag (catch #t (lambda () (set! with-let #f)) (lambda args 'error))))
+ (if (not (eq? with-let old-with-let))
+ (format with-let ";with-let mutable?~%"))
+ (if (not (eq? tag 'error))
+ (format with-let ";set! with-let no error? ~A~%" tag))))
+
+(let ((old-*s7* *s7*))
+ (let ((tag (catch #t (lambda () (set! *s7* #f)) (lambda args 'error))))
+ (if (not (eq? *s7* old-*s7*))
+ (format *s7* ";*s7* mutable?~%"))
+ (if (not (eq? tag 'error))
+ (format *s7* ";set! *s7* no error? ~A~%" tag))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; constant?
+
+(test (constant? '__c1__) #t)
+(test (constant? pi) #t)
+(test (constant? 'pi) #t) ; take that, Clisp!
+(test (constant? 12345) #t)
+(test (constant? 3.14) #t)
+(test (constant? :asdf) #t)
+(test (constant? 'asdf) #f)
+(test (constant? "hi") #t)
+(test (constant? #\a) #t)
+(test (constant? #f) #t)
+(test (constant? #t) #t)
+(test (constant? ()) #t)
+(test (constant? ()) #t)
(test (constant? '(a)) #t)
(test (constant? '*features*) #f)
(test (let ((a 3)) (constant? 'a)) #f)
@@ -19944,6 +33982,8 @@ abs 1 2
(test (constant? '''-) #t)
(test (constant? '1) #t)
(test (constant? 1/2) #t)
+(test (constant? 'with-let) #t)
+(test (constant? with-let) #t)
;; and some I wonder about -- in CL's terms, these always evaluate to the same thing, so they're constantp
;; but Clisp:
@@ -19968,7 +34008,7 @@ abs 1 2
(test (constant? 1624540914719833702142058941.4) #t)
(test (constant? 7151305879464824441563197685/828567267217721441067369971) #t)))
-(test (constant? lambda) #f) ; I guess it can be rebound?
+(test (constant? lambda) #t) ; like abs?
(test (constant? (lambda () 1)) #t)
(test (constant? ''3) #t)
(test (constant? (if #f #f)) #t)
@@ -19997,321 +34037,885 @@ abs 1 2
;; that is, hi is the constant as a vector, not the vector elements
+
+;;; --------------------------------------------------------------------------------
;;; defined?
+
(test (defined? 'pi) #t)
-(test (defined? 'pi (global-environment)) #t)
-(test (defined? 'abs (global-environment)) #t)
-(test (defined? 'abs (current-environment)) #t)
+(test (defined? 'pi (rootlet)) #t)
+(test (defined? 'abs (rootlet)) #t)
+(test (defined? 'abs (curlet)) #t)
(test (let ((__c2__ 32)) (defined? '__c2__)) #t)
-(test (let ((__c2__ 32)) (defined? '__c2__ (current-environment))) #t)
-(test (let ((__c2__ 32)) (defined? '__c3__ (current-environment))) #f)
-(test (let ((__c2__ 32)) (defined? '__c2__ (global-environment))) #f)
-(test (let ((__c2__ 32)) (defined? '__c3__ (global-environment))) #f)
+(test (let ((__c2__ 32)) (defined? '__c2__ (curlet))) #t)
+(test (let ((__c2__ 32)) (defined? '__c3__ (curlet))) #f)
+(test (let ((__c2__ 32)) (defined? '__c2__ (rootlet))) #f)
+(test (let ((__c2__ 32)) (defined? '__c3__ (rootlet))) #f)
+(test (let ((ge (rootlet))) (ge 'abs)) abs)
+(test (let ((ge (rootlet))) (ge 'rootlet)) rootlet)
+(test (let ((ge (rootlet))) (ge 'define)) define)
+(test (let ((ge (rootlet))) (ge 'if)) if)
+(test (let ((ge (rootlet))) (let ((abc 1)) (ge 'abc))) #<undefined>)
(test (defined?) 'error)
(test (defined? 'a 'b) 'error)
+(test (defined? 'abs (curlet)) #t)
+(test (defined? 'abs (curlet) #()) 'error)
+(test (defined? 'abs 0) 'error)
+(test (let () (defined? 'abs (curlet) #())) 'error)
(for-each
(lambda (arg)
(test (defined? arg) 'error)
(test (defined? 'abs arg) 'error))
- (list -1 #\a 1 _ht_ '#(1 2 3) 3.14 3/4 1.0+1.0i '() #f '#(()) (list 1 2 3) '(1 . 2) "hi"))
+ (list -1 #\a 1 _ht_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi"))
(test (defined? 'lambda car) 'error)
(test (defined? lambda gensym) 'error)
(test (defined? 'lambda defined?) 'error)
(test (defined? 'define car) 'error)
-(test (defined? 'abs (augment-environment '())) #f)
-(test (defined? lambda) #t)
+(test (defined? 'abs (sublet ())) #t) ; nil = global now
+(test (defined? lambda) 'error)
(test (defined? 'lambda) #t)
(test (defined? 'dynamic-wind) #t)
(test (defined? 'asdaf) #f)
-(test (defined? ':asdaf) #f)
-(test (defined? :asdaf) #f)
+;(test (defined? ':asdaf) #f) ; keywords are defined in the sense that they evaluate to themselves
+;(test (defined? :asdaf) #f)
(test (defined? 'ok?) #t)
(test (defined? 'test-t) #t)
(test (defined? 'quasiquote) #t)
(test (defined? (symbol "123")) #f)
(test (defined? (symbol "+")) #t)
(test (defined? ''+) 'error)
+(test (defined? 'if) #t)
+(test (defined? if) 'error)
+(test (defined? quote) 'error)
+(test (let () (defined? 'abs (curlet) #t)) #f)
+(test (let () (defined? 'abs (curlet))) #t)
+(test (let () (defined? 'abs (curlet) #f)) #t)
+
+(test (let ((b 2))
+ (let ((e (curlet)))
+ (let ((a 1))
+ (if (defined? 'a e)
+ (format #f "a: ~A in ~{~A ~}" (symbol->value 'a e) e)))))
+ #<unspecified>) ; not "a: 1 in (b . 2)")
+
+(test (let ((b 2))
+ (let ((e (curlet)))
+ (let ((a 1))
+ (format #f "~A: ~A" (defined? 'abs e) (eval '(abs -1) e)))))
+ "#t: 1")
-;;; environment?
-;;; global-environment
-;;; initial-environment
-;;; current-environment
-;;; augment-environment
-;;; with-environment
+
+;;; --------------------------------------------------------------------------------
+;;; let?
+;;; inlet
+;;; rootlet
+;;; curlet
+;;; sublet
+;;; with-let
+;;; let->list
+;;; outlet
+;;; let-ref
+;;; let-set!
+;;; varlet
+;;; cutlet
+;;; coverlet
+;;; openlet
+;;; unlet
+
+(test (let () (length (curlet))) 0)
+(test (let ((a 1) (b 2) (c 3)) (length (curlet))) 3)
(for-each
(lambda (arg)
- (test (environment? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() #f '#(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
-(let () (test (environment? (initial-environment)) #t))
-(test (environment? (current-environment)) #t)
-(test (environment? (global-environment)) #t)
-(test (environment? (augment-environment '())) #t)
-(test (environment? (augment-environment! '())) #t)
-(test (environment? (augment-environment (augment-environment '()) '(a . 1))) #t)
-(test (environment? (augment-environment! (augment-environment! '()) '(a . 1))) #t)
-(test (environment? (augment-environment '() '(a . 1))) #t)
-(test (environment? (augment-environment! '() '(a . 1))) #t)
-(let ((f1 (lambda (a) (+ a 1)))
- (f2 (lambda* ((a 2)) (+ a 1))))
- (define (hi a) (+ a 1))
- (define* (ho (a 1)) (+ a 1))
- (test (environment? (procedure-environment hi)) #t)
- (test (environment? (procedure-environment ho)) #t)
- (test (environment? (procedure-environment f1)) #t)
- (test (environment? (procedure-environment f2)) #t)
- (test (environment? (procedure-environment abs)) #t))
-
-(test (current-environment 1) 'error)
-(test (global-environment 1) 'error)
-(test (initial-environment 1) 'error)
-(test (let () (set! initial-environment 2)) 'error)
-(test (let ((initial-environment 2)) initial-environment) 'error)
-
-(test (let () (augment-environment! (initial-environment) (cons 'a 32)) (symbol->value 'a (initial-environment))) #<undefined>)
-(test (let ((caar 123)) (+ caar (with-environment (initial-environment) (caar '((2) 3))))) 125)
-(test (let ()
- (+ (let ((caar 123))
- (+ caar (with-environment (initial-environment)
+ (test (let? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+(let () (test (let? (unlet)) #t))
+(test (let? (curlet)) #t)
+(test (let? (rootlet)) #t)
+(test (let? (sublet ())) #t)
+(test (let? (varlet ())) #t)
+(test (let? (sublet (sublet ()) '(a . 1))) #t)
+(test (let? (sublet () '(a . 1))) #t)
+(test (eq? abs ((rootlet) 'abs)) #t)
+(test (eq? abs #_abs) #t)
+(test (eq? abs (with-let (unlet) abs)) #t)
+(test ((sublet () '(asdf . 32)) 'asdf) 32)
+(test ((sublet () '(asdf . 32)) 'asd) #<undefined>)
+(test (let? (sublet (curlet))) #t) ; no bindings is like (let () ...)
+(test (varlet (rootlet) '(quote . 1)) 'error)
+
+(test (eq? (curlet) (let ((a (curlet))) a)) #t)
+(test (eq? (curlet) (let* ((a (curlet))) a)) #t)
+(test (eq? (curlet) (letrec ((a (curlet))) a)) #f)
+(test (eq? (curlet) (letrec* ((a (curlet))) a)) #f)
+(test (let ((a (curlet))) (eq? a (curlet))) #f)
+(test (letrec ((a (curlet))) (eq? a (curlet))) #t)
+
+(test (let ((e (inlet 'e (inlet '+ -)))) (((e 'e) '+) 2 3)) -1)
+(test (let ((confused (inlet '+ -))) ((confused '+) 2 3)) -1)
+;;; (with-let (inlet '+ -) (+ 2 3)) -> 5
+;;; (with-let (inlet '+ -) (((curlet) '+) 2 3)) -> -1
+;;; (with-let (inlet 'plus -) (plus 2 3)) -> -1
+;;; which is consistent, so to speak, with the (set! gcd +) example mentioned in s7.html
+
+(test (((let ((x (lambda (y) (+ y 1)))) (curlet)) 'x) 2) 3)
+
+(test (equal? (inlet 'a 1) (inlet 'a 1)) #t)
+(test (morally-equal? (inlet 'a 1) (inlet 'a 1)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 2 'a 1)) #t)
+(test (equal? (inlet 'a 3 'a 1) (inlet 'a 2 'a 1)) #t)
+(test (morally-equal? (inlet 'a 1) (inlet 'a 2 'a 1)) #t)
+(test (equal? (inlet 'a 1 'b "hi") (inlet 'a 1 'b "hi")) #t)
+(test (morally-equal? (inlet 'a 1 'b "hi") (inlet 'a 1 'b "hi")) #t)
+(test (equal? (inlet 'b "hi" 'a 1) (inlet 'a 1 'b "hi")) #t)
+(test (morally-equal? (inlet 'b "hi" 'a 1) (inlet 'a 1 'b "hi")) #t)
+(test (equal? (inlet 'a 2 'b "hi" 'a 1) (inlet 'b "hi" 'a 2 'a 1)) #t)
+(test (equal? (inlet 'a (vector 1.0)) (inlet 'a (float-vector 1.0))) #f)
+(test (morally-equal? (inlet 'a (vector 1.0)) (inlet 'a (float-vector 1.0))) #t)
+(test (equal? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1.0)) #f)
+(test (morally-equal? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1.0)) #t)
+(test (equal? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1/2)) #f)
+(test (morally-equal? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1/2)) #f)
+(test (equal? (inlet 'a 1) (inlet 'b "hi" 'a 1)) #f)
+(test (equal? (inlet 'a 1 'b "hi") (inlet 'a 1)) #f)
+(test (equal? (inlet 'a 1 'a 1) (inlet 'a 1)) #t)
+(test (equal? (inlet 'a (inlet 'b 1)) (inlet 'a (inlet 'b 1))) #t)
+(test (equal? (inlet 'a (inlet 'b 1)) (inlet 'a (inlet 'b 1))) #t)
+(test (equal? (inlet 'b (inlet 'b 1)) (inlet 'b (inlet 'b 1))) #t)
+(test (equal? (inlet) (inlet)) #t)
+(test (equal? (inlet 'a 1) (inlet)) #f)
+(test (equal? (inlet) (inlet 'a 1)) #f)
+(test (object->string (inlet 'a 1 'a 3)) "(inlet 'a 1 'a 3)")
+(test ((inlet 'a 1 'a 3) 'a) 3) ; so the print form follows the input order, but the earlier entries (as printed) are shadowed
+(test (equal? (inlet) (sublet (inlet))) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 2)) #f)
+(test (equal? (inlet 'a 1) (inlet 'b 1)) #f)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'b 1)) #f)
+(test (equal? (inlet 'a 1 'b 1) (inlet 'a 1 'c 1)) #f)
+(test (equal? (inlet 'a 1 'b 1) (inlet 'a 1 'b 1)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'a 1)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'a 2)) #f)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1) 'b 2)) #t)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 2) 'b 2)) #f)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1) 'b 1)) #f)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1))) #f)
+(test (equal? (sublet (inlet 'a 1)) (sublet (inlet))) #f)
+(test (equal? (sublet (inlet 'a 1)) (inlet 'a 1)) #t)
+(test (equal? (sublet (sublet (inlet 'a 1))) (sublet (inlet 'a 1))) #t)
+(test (let ((e (inlet 'a 1))) (equal? (sublet e 'a 1) (sublet e 'a 1))) #t)
+(test (equal? (inlet 'a 1 'b 2 'c 3) (inlet 'c 3 'b 2 'a 1)) #t)
+(test (equal? (inlet 'a 1 'b 2 'c 3) (inlet 'c 3 'b 1 'a 1)) #f)
+(test (equal? (inlet 'a 1 'a 2) (inlet 'a 3 'a 2)) #t)
+(test (equal? (sublet (inlet 'a 1 'a 3) 'a 2) (sublet (inlet 'a 3) 'a 2)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'b 2)) #f)
+(test (equal? (inlet 'a 1) (sublet (inlet 'a 1))) #t)
+(test (equal? (sublet (inlet 'a 1)) (inlet 'a 1)) #t)
+
+(test (let ((e (inlet 'a 1 'a 2)))
+ (let ((c (copy e)))
+ (list (e 'a) (c 'a))))
+ '(2 2))
+
+(test (equal? (inlet 'a 1) (sublet (inlet 'a 1))) #t)
+(test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1 'b 2) 'b 2)) #t)
+(test (equal? (sublet (inlet 'a 3) 'a 2) (sublet (inlet 'a 1) 'a 2)) #t) ; ((sublet (inlet 'a 1) 'a 2) 'a) -> 2
+(test (equal? (sublet (inlet) 'a 2) (sublet (inlet 'a 1) 'a 2)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 3 'a 2 'a 1)) #t)
+
+(let ((f (inlet 'sym 'sam 'sam 'sym))
+ (g (inlet 'sam 'sym 'sym 'sam)))
+ (test (f (g 'sym)) 'sym)
+ (test (f (f 'sym)) 'sym)
+ (test (g (f 'sam)) 'sam)
+ (test (g (f (g (f (f 'sym))))) 'sam))
+
+(test (apply inlet (map values (hash-table '(a . 1) '(b . 2)))) (inlet 'b 2 'a 1))
+(test (apply hash-table (map values (inlet 'a 1 'b 2))) (hash-table '(a . 1) '(b . 2)))
+
+(let ((e (inlet 'a 1 'a 2)))
+ (test (e 'a) ((copy e) 'a)))
+
+(let ((e1 (inlet 'a 1 'a 2)))
+ (let ((e2 (copy e1)))
+ (test (list (equal? e1 e2) (equal? (e1 'a) (e2 'a))) '(#t #t))))
+
+(let ()
+ (define-bacro (let/ e . body)
+ `(with-let (sublet (curlet) ,e)
+ , at body))
+ (test (let ((a 1))
+ (let/ (inlet 'b 2)
+ (+ a b)))
+ 3))
+
+(let ((e (inlet 'a (inlet 'b 1 'c 2) 'b (inlet 'b 3 'c 4))))
+ (test (e 'a 'b) 1)
+ (test (e 'b 'b) 3)
+ (test (e 'b 'c) 4))
+
+(let ()
+ (define (f1) (let ((e (inlet 'a 1))) (e '(1))))
+ (test (f1) 'error))
+
+(test (equal? (inlet 'a 1) (cutlet (inlet 'a 1 'b 2) 'b)) #t)
+(test (equal? (inlet 'a 1) (inlet 'a 1 'b 2)) #f)
+(test (length (cutlet (inlet 'a 1 'b 2 'c 3) 'b 'a)) 1)
+(test (length (cutlet (inlet 'a 1 'b 2 'c 3) 'd)) 3)
+(test (let->list (cutlet (inlet 'a 1 'b 2 'c 3) 'b 'a)) '((c . 3)))
+(test ((cutlet (inlet 'a 1 'b 2) 'a) 'a) #<undefined>)
+(test ((cutlet (inlet 'a 1 'b 2 'c 3) 'a) 'b) 2)
+(test ((cutlet (inlet 'a 1 'b 2) 'a) 'b) 2)
+(test ((cutlet (inlet 'a 1 'b 2 'c 3) 'a 'b 'c) 'a) #<undefined>)
+(test ((cutlet (inlet 'a 1 'b 2 'c 3 'a 4) 'a) 'a) 1) ; shadowed in order added
+(define ___a 32) (cutlet (rootlet) '___a) (test ___a #<undefined>)
+(test (cutlet (inlet)) (inlet))
+(test (cutlet (inlet 'a 1) 'a) (inlet))
+(test ((cutlet (inlet 'a 1 'a 2) 'a) 'a) 1)
+(test (let ((g (gensym))) (cutlet (inlet g '1) g)) (inlet))
+(test (cutlet (sublet (inlet 'a 1) 'b 2) 'a) (sublet (inlet 'a 1) 'b 2))
+(test (let ((b 2)) (cutlet (curlet) 'b) b) 'error) ; unbound variable
+(test (let ((b 1)) (let ((b 2)) (cutlet (curlet) 'b)) b) 1)
+
+(test (let ((#_+ 3)) #_+) 'error)
+(test (define #_+ 3) 'error)
+(test (set! #_+ 3) 'error)
+
+(let ()
+ (define hi (inlet 'x 12))
+ (let ((x 32)
+ (y 1))
+ (let ((old-out (outlet hi)))
+ (set! (outlet hi) (curlet))
+ (with-let hi ; x 12 y 1
+ (test (+ x y) 13))
+ (set! (outlet hi) old-out) ; x 32 y 1
+ (test (+ x y) 33)
+ (with-let hi ; x 12 y #<undefined>
+ (test x 12)
+ (test (defined? 'y) #f)))))
+
+(test (let ()
+ (with-let (curlet) (define hiho 43))
+ hiho)
+ 43)
+(let ()
+ (define-macro (define! env . args)
+ `(with-let ,env (define , at args)))
+ (test (let ()
+ (define! (curlet) (hiho x) (+ x 1))
+ (hiho 2))
+ 3))
+
+(test (let () (with-let (curlet) (define (f3 a) (+ a 2))) (f3 1)) 3)
+
+(let ()
+ (with-let (rootlet)
+ (define (this-is-global a) (+ a 1))))
+
+(test (this-is-global 2) 3)
+
+(let ()
+ (with-let (inlet)
+ (define (this-is-not-global a) (+ a 1))))
+
+(test (this-is-not-global 2) 'error)
+
+
+(let ()
+ (apply varlet (curlet)
+ (with-let (unlet)
+ (let ()
+ (define (lognor n1 n2) (lognot (logior n1 n2)))
+ (define (logit n1) n1)
+
+ (map (lambda (binding)
+ (cons (string->symbol
+ (string-append "library:" (symbol->string (car binding))))
+ (cdr binding)))
+ (curlet)))))
+ (test (library:lognor 1 2) -4))
+
+(let ()
+ (define (f1)
+ (let ((a 0)
+ (v (make-vector 3)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) v)
+ (vector-set! v i a)
+ (varlet (curlet) 'a i))))
+
+ (test (f1) #(0 0 1))
+
+ (define (f2)
+ (let ((v (make-vector 3)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) v)
+ (varlet (curlet) 'a i)
+ (vector-set! v i a))))
+
+ (test (f2) #(0 1 2)))
+
+
+(test (null? (let->list (rootlet))) #f)
+
+(test (let? (inlet)) #t)
+(test (length (inlet)) 0)
+(test (length (inlet '(a . 2))) 1)
+(test (with-let (inlet '(a . 2)) a) 2)
+(test (with-let (inlet '(a . 2) '(b . 3)) (+ a b)) 5)
+(test (eq? (inlet) (rootlet)) #f)
+(test ((inlet (inlet '(a . 1))) 'a) 1)
+(test ((inlet (inlet '(a . 1)) '(b . 2)) 'b) 2)
+(test ((inlet '(b . 3) (inlet '(a . 1))) 'b) 3)
+(test (let ((a 1)) ((inlet (curlet)) 'a)) 1)
+(test (let ((a 1)) ((inlet '(b . 2)) 'a)) #<undefined>)
+(test (let ((a (inlet 'b 2))) (set! (let-ref a 'b) 3) (a 'b)) 3) ; let-ref setter is let-set!
+
+(for-each
+ (lambda (arg)
+ (test (sublet arg) 'error)
+ (test (varlet arg) 'error)
+ (test (cutlet arg) 'error)
+ (test (cutlet (curlet) arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+(test (let ((e (inlet '(a . 1)))) ((lambda (x) (x *)) e)) 'error)
+(test (let ((e (inlet '(a . 1)))) ((lambda (x) (x pi)) e)) 'error)
+(test (let () (inlet (cons pi 1))) 'error)
+(test (let () (inlet (cons "hi" 1))) 'error)
+
+
+(test (let? (inlet)) #t)
+(test (length (inlet)) 0)
+(test (length (inlet 'a 2)) 1)
+(test (with-let (inlet 'a 2) a) 2)
+(test (with-let (inlet 'a 2 'b 3) (+ a b)) 5)
+(test (eq? (inlet) (rootlet)) #f)
+(test ((inlet (inlet 'a 1)) 'a) 1)
+(test ((inlet (inlet 'a 1) '(b . 2)) 'b) 2)
+
+(for-each
+ (lambda (arg)
+ (test (inlet arg) 'error)
+ (test (apply inlet arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi"))
+
+(test (inlet 'a) 'error)
+(test (inlet 1 2) 'error)
+(test (inlet 'a 2 'b) 'error)
+(test (with-let (inlet 'a (let ((p (open-output-string))) (display "32" p) p)) (get-output-string a)) "32")
+
+
+(for-each
+ (lambda (arg)
+ (test (let->list arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+(for-each
+ (lambda (arg)
+ (test (openlet arg) 'error)
+ (test (coverlet arg) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand () #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+(let ()
+ (let ((_xxx_ 0))
+ (let ((e (curlet)))
+ (for-each
+ (lambda (arg)
+ (let-set! e '_xxx_ arg)
+ (test (let-ref e '_xxx_) arg))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand () #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))))))
+
+(test (let-ref) 'error)
+(test (let-ref (curlet)) 'error)
+(test (let-ref a b c) 'error)
+(test (let-ref (sublet ()) '_asdf_) #<undefined>)
+(test (let-ref (sublet () '(a . 3)) 'a) 3)
+(test (let-ref (sublet () '(a . 3)) 'A) #<undefined>)
+(test (let-ref (rootlet) '+) +)
+(test (let-ref (rootlet) +) 'error)
+(test (let-ref () '+) 'error)
+(test (let-ref (funclet (let ((a 2)) (lambda (b) (+ a b)))) 'a) 2)
+(let ((etest (let ((a 2)) (lambda (b) (+ a b)))))
+ (let-set! (funclet etest) 'a 32)
+ (test (etest 1) 33))
+(test (let-set!) 'error)
+(test (let-set! a b) 'error)
+(let ((e (inlet (cons 'a 1))))
+ (define (eref a) (e a))
+ (define (eset a b) (set! (e a) b))
+ (for-each
+ (lambda (arg)
+ (test (let-ref arg 'a) 'error)
+ (test (let-set! arg 'a 1) 'error)
+ (test (let-ref e arg) 'error)
+ (test (let-set! e arg #f) 'error)
+ (test (e arg) 'error)
+ (test (set! (e arg) #f) 'error)
+ (test (eref arg) 'error)
+ (test (eset (e arg) #f) 'error))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand () #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))))
+
+(let () (define (ft) (let ((a (vector #f)) (b 0)) (*s7* (vector-ref a b)))) (test (ft) 'error))
+
+(test (inlet :a 1) (inlet (cons 'a 1)))
+(test (inlet :a 1 :b 2) (inlet 'a 1 'b 2))
+(test (inlet 'pi 3.0) 'error)
+
+(let ((e (inlet 'a 1)))
+ (test (let-set! e :a 2) #<undefined>)
+ (test (let-ref e :a) #<undefined>)
+ (test (let-ref e 'a) 1))
+
+(for-each
+ (lambda (arg)
+ (test (openlet? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () abs macroexpand #<eof> #<unspecified> #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
+
+(test (openlet) 'error)
+(test (openlet 1 2) 'error)
+(test (openlet?) 'error)
+(test (openlet? 1 2) 'error)
+(test (openlet (rootlet)) 'error)
+
+(let ((e (openlet (inlet 'a 1))))
+ (test (openlet? (sublet e '(b . 2))) #t))
+
+(let ((f (lambda (x) (+ x 1))))
+ (test (openlet? f) #f)
+ (openlet f)
+ (test (openlet? f) #t)
+ (coverlet f)
+ (test (openlet? f) #f))
+
+(let ((f (lambda* (x) (+ x 1))))
+ (test (openlet? f) #f)
+ (openlet f)
+ (test (openlet? f) #t)
+ (coverlet f)
+ (test (openlet? f) #f))
+
+(let ((f (sublet ())))
+ (test (openlet? f) #f)
+ (openlet f)
+ (test (openlet? f) #t)
+ (coverlet f)
+ (test (openlet? f) #f))
+
+(let ((e1 (openlet (inlet 'f1 (define-macro (f1 a) `(+ ,a 1))))))
+ (test ((e1 'f1) 3) 4))
+
+(let ()
+ (define-macro (f x) `(+ ,x 1))
+ (test (openlet? f) #f)
+ (test (openlet f) f)
+ (test (openlet? f) #t)
+ (test (coverlet f) f))
+
+(let ()
+ (define-bacro* (f x) `(+ ,x 1))
+ (test (openlet? f) #f)
+ (test (openlet f) f)
+ (test (openlet? f) #t)
+ (test (coverlet f) f))
+
+(test (curlet 1) 'error)
+(test (rootlet 1) 'error)
+(test (unlet 1) 'error)
+(test (set! (curlet) 1) 'error)
+(test (set! (rootlet) 1) 'error)
+(test (set! (unlet) 1) 'error)
+(test (let () (set! unlet 2)) 'error)
+(test (let ((unlet 2)) unlet) 'error)
+
+(test (let ((e (sublet () '(a . 1)))) ((lambda (x) (x *)) e)) 'error)
+(test (let ((e (sublet () '(a . 1)))) ((lambda (x) (x pi)) e)) 'error)
+(test (let () (sublet () (cons pi 1))) 'error)
+(test (let () (sublet () (cons "hi" 1))) 'error)
+(test (let () (varlet () (cons pi 1))) 'error)
+(test (let () (varlet () (cons "hi" 1))) 'error)
+
+(test (let ((lt (openlet (inlet 'x (list 1 2 3) 'make-iterator (let ((iterator? #t)) (lambda (e) (#_make-iterator (e 'x)))))))) (format #f "~{~A~^ ~}" lt)) "1 2 3")
+(when (not pure-s7) (test (let ((lt (openlet (inlet 'x (list 1 2 3) 'let->list (lambda (e) (e 'x)))))) (format #f "~{~A~^ ~}" lt)) "1 2 3"))
+
+(test (eq? (rootlet) ()) #f)
+(test (eq? (rootlet) (rootlet)) #t)
+(test (eq? (rootlet) (unlet)) #f)
+(test (eqv? (rootlet) (rootlet)) #t)
+(test (eqv? (rootlet) (unlet)) #f)
+(test (equal? (rootlet) (rootlet)) #t)
+(test (equal? (rootlet) (unlet)) #f)
+;(test (equal? (curlet) (unlet)) #f)
+(let ((e #f) (g #f))
+ (set! e (curlet))
+ (set! g (rootlet))
+ (if (not (equal? e (curlet))) ; test here introduces a new environment
+ (format-logged #t ";(equal? e (curlet)) -> #f?~%"))
+ (test g (rootlet))
+ (test (equal? e g) #f)
+ (let ()
+ (if (not (equal? e (curlet)))
+ (format-logged #t ";2nd case (equal? e (curlet)) -> #f?~%"))))
+
+(let ()
+ (define global-env (rootlet))
+ (test (equal? global-env (rootlet)) #t)
+ (test (equal? (list global-env) (list (rootlet))) #t)
+ (test (morally-equal? global-env (rootlet)) #t)
+ (test (morally-equal? (list global-env) (list (rootlet))) #t))
+
+(test (pair? (member (let ((a 1) (b 2)) (map cdr (curlet))) '((1 2) (2 1)))) #t)
+(test (let () (map cdr (curlet))) ())
+(test (pair? (member (let ((vals ())) (let ((a 1) (b 2)) (for-each (lambda (slot) (set! vals (cons (cdr slot) vals))) (curlet))) vals) '((2 1) (1 2)))) #t)
+(test (let ((a '(1 2 3)) (b '(3 4 5)) (c '(6 7 8))) (map + a b c (apply values (map cdr (curlet))))) '(20 26 32))
+(test (pair? (member (let ((a 1) (b 2) (c 3)) (map (lambda (a b) (+ a (cdr b))) (list 1 2 3) (curlet))) '((2 4 6) (4 4 4)))) #t)
+
+(test (let () (format #f "~A" (curlet))) "(inlet)")
+;(test (let ((a 32) (b '(1 2 3))) (format #f "~A" (curlet))) "(inlet)")
+;(test (let ((a 1)) (object->string (curlet))) "(inlet)")
+(test (let ((a 1)) (object->string (rootlet))) "(rootlet)")
+(test (format #f "~A" (rootlet)) "(rootlet)")
+(test (let ((a 32) (b #(1 2 3))) (format #f "~{~A~^ ~}" (curlet))) "(a . 32) (b . #(1 2 3))")
+
+(test (object->string (rootlet)) "(rootlet)")
+(test (let () (object->string (curlet))) "(inlet)")
+(test (let ((a 3)) (object->string (curlet))) "(inlet 'a 3)")
+(test (let ((a 3) (b "hi")) (object->string (curlet))) "(inlet 'a 3 'b \"hi\")")
+(test (let ()
+ (define (hi a b) (curlet))
+ (object->string (hi 3 4))) "(inlet 'a 3 'b 4)")
+
+
+(test (let () (varlet (unlet) (cons 'a 32)) (symbol->value 'a (unlet))) #<undefined>)
+(test (let ((caar 123)) (+ caar (with-let (unlet) (caar '((2) 3))))) 125)
+(test (let ()
+ (+ (let ((caar 123))
+ (+ caar (with-let (unlet)
(let ((val (caar '((2) 3))))
(set! caar -1)
(+ val caar))))) ; 124
(let ((caar -123))
- (+ caar (with-environment (initial-environment)
+ (+ caar (with-let (unlet)
(let ((val (caar '((20) 3))))
(set! caar -2)
(+ val caar))))) ; -105
(caar '((30) 3)))) ; 30 + 19
49)
-
-(let ((old+ +))
- (let ((vals
- (list (let ()
- (define a 32)
- (define p +)
- (define (f b) (+ a b))
- (set! a 1)
- (let ((t1 (f 2)))
- (set! + -)
- (let ((t2 (f 2)))
- (let ((t3 (equal? p +)))
- (list t1 t2 t3)))))
-
- ;; s7: (3 -1 #f)
- ;; guile: (3 3 #f)
-
- (let ()
- (define a 32)
- (define p old+)
- (define (f b) (p a b))
- (set! a 1)
- (let ((t1 (f 2)))
- (set! p -)
- (let ((t2 (f 2)))
- (let ((t3 (equal? p old+)))
- (list t1 t2 t3)))))
-
- ;; s7 (3 -1 #t)
- ;; guile (3 -1 #t)
- )))
- (set! + old+)
- (test (car vals) (cadr vals))))
-(let ((old+ +))
- (define (f x) (with-environment (initial-environment) (+ x 1)))
- (set! + -)
- (test (+ 1 1) 0)
- (test (f 1) 2)
- (set! + old+))
+(test (let ((a 1)) (eval '(+ a b) (sublet (curlet) (cons 'b 32)))) 33)
+(test (let ((a 1)) (+ (eval '(+ a b) (sublet (curlet) (cons 'b 32))) a)) 34)
+(test (let ((a 1)) (+ (eval '(+ a b) (sublet (curlet) (cons 'b 32) (cons 'a 12))) a)) 45)
+(test (let ((a 2)) (eval '(+ a 1) (sublet (curlet)))) 3)
+(test (let ((a 1)) (+ (eval '(+ a b) (sublet (sublet (curlet) (cons 'b 32)) (cons 'a 12))) a)) 45)
+(test (eval (list + 'a (eval (list - 'b) (sublet (unlet) (cons 'b 1))))
+ (sublet (unlet) (cons 'a 2)))
+ 1)
-(let ((old+ +))
- (let ((f #f))
- (let ((+ -))
- (set! f (lambda (a) (+ 1 a))))
- (test (f 2) -1)
- (set! + *)
- (test (f 2) -1)
- (set! + old+)))
+(let ((e (openlet ; make it appear to be empty to the rest of s7
+ (inlet 'object->string (lambda args "(inlet)")
+ 'map (lambda args ())
+ 'for-each (lambda args #<unspecified>)
+ 'let->list (lambda args ())
+ 'length (lambda args 0)
+ 'copy (lambda args (inlet))
+ 'open #t
+ 'coverlet (lambda (e) (set! (e 'open) #f) e)
+ 'openlet (lambda (e) (set! (e 'open) #t) e)
+ 'openlet? (lambda (e) (e 'open))
+ ;; your secret data here
+ 'secret 'gray-cat
+ ))))
+ (test (object->string e) "(inlet)")
+ ;(test (map values e) ())
+ (when (not pure-s7) (test (let->list e) ()))
+ (test (length e) 0)
+ (test (object->string (copy e)) "(inlet)")
+ (coverlet e)
+ (test (object->string e) "(inlet)")
+ (test (openlet? e) #f)
+ (openlet e)
+ (test (openlet? e) #t))
-(test (let ((a 1)) (eval '(+ a b) (augment-environment (current-environment) (cons 'b 32)))) 33)
-(test (let ((a 1)) (+ (eval '(+ a b) (augment-environment (current-environment) (cons 'b 32))) a)) 34)
-(test (let ((a 1)) (+ (eval '(+ a b) (augment-environment (current-environment) (cons 'b 32) (cons 'a 12))) a)) 45)
-(test (let ((a 2)) (eval '(+ a 1) (augment-environment (current-environment)))) 3)
-(test (let ((a 1)) (+ (eval '(+ a b) (augment-environment (augment-environment (current-environment) (cons 'b 32)) (cons 'a 12))) a)) 45)
-(test (eval (list + 'a (eval (list - 'b) (augment-environment (initial-environment) (cons 'b 1))))
- (augment-environment (initial-environment) (cons 'a 2)))
- 1)
+(let ()
+ (define (lets . args)
+ (apply sublet () args))
+ (let ((e (lets '(a . 1) '(b . 2))))
+ (test (eval '(+ a b 3) e) 6)))
+
+;(test (eval 'a (sublet () '(a . 1) '(a . 2))) 'error) ; no longer an error, mainly for repl's convenience
+;(test (eval 'a (varlet () '(a . 1) '(a . 2))) 'error)
+(test (eval 'pi (sublet () '(pi . 1) '(a . 2))) 'error)
+(test (eval 'pi (varlet () '(pi . 1) '(a . 2))) 'error)
+(test (eval 'pi (sublet () (cons 'pi pi))) 'error) ; changed 25-Jun-14
+(test (eval 'pi (varlet () (cons 'pi pi))) 'error)
+(test (map (sublet () '(asdf . 32) '(bsdf . 3)) '(bsdf asdf)) '(3 32))
+(test (equal? (map (rootlet) '(abs cons car)) (list abs cons car)) #t)
+
+(test (with-let (sublet (inlet) '(a . 1)) a) 1)
+(test (with-let (sublet (inlet '(b . 2)) '(a . 1)) (+ a b)) 3)
+(test (with-let (sublet () (inlet) '(a . 1)) a) 1)
+(test (with-let (sublet () (inlet '(b . 2)) '(a . 1)) (+ a b)) 3)
+(test (with-let (sublet (inlet '(b . 2) '(c . 3)) '(a . 1)) (+ a b c)) 6)
+
+(let ()
+ (define (e1) (let ((e (curlet))) (with-let e 0)))
+ (define (e2 a) (let ((e (curlet))) (with-let e a)))
+ (define (e3) (let ((e (curlet))) (with-let e 1 . 2)))
+ (define (e4) (let ((e (curlet))) (with-let e 0 1)))
+ (define (e5) (let ((e (curlet))) (with-let e (+ 1 2) (+ 2 3))))
+ (test (e2 10) 10) (e1)
+ (test (e1) (e2 0))
+ (test (e3) 'error) (e4)
+ (test (e4) 1) (e5)
+ (test (e5) 5))
-(test (let ((a 1)) (eval-string "(+ a b)" (augment-environment (current-environment) (cons 'b 32)))) 33)
-(test (let ((a 1)) (+ (eval-string "(+ a b)" (augment-environment (current-environment) (cons 'b 32))) a)) 34)
-(test (let ((a 1)) (+ (eval-string "(+ a b)" (augment-environment (current-environment) (cons 'b 32) (cons 'a 12))) a)) 45)
-(test (let ((a 2)) (eval-string "(+ a 1)" (augment-environment (current-environment)))) 3)
-(test (let ((a 1)) (+ (eval-string "(+ a b)" (augment-environment (augment-environment (current-environment) (cons 'b 32)) (cons 'a 12))) a)) 45)
-(test (eval-string (string-append "(+ a " (number->string (eval (list - 'b) (augment-environment (initial-environment) (cons 'b 1)))) ")")
- (augment-environment (initial-environment) (cons 'a 2)))
+(let ()
+ (define-constant _a_constant_ 32)
+ (test (eval '_a_constant_ (sublet () (cons '_a_constant_ 1))) 'error)
+ (test (eval '_a_constant_ (sublet () (cons '_a_constant_ 32))) 'error))
+
+(test (let ((a 1)) (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32)))) 33)
+(test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32))) a)) 34)
+(test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32) (cons 'a 12))) a)) 45)
+(test (let ((a 2)) (eval-string "(+ a 1)" (sublet (curlet)))) 3)
+(test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (sublet (curlet) (cons 'b 32)) (cons 'a 12))) a)) 45)
+(test (eval-string (string-append "(+ a " (number->string (eval (list - 'b) (sublet (unlet) (cons 'b 1)))) ")")
+ (sublet (unlet) (cons 'a 2)))
1)
-(test (augment-environment) 'error)
+(test (sublet) 'error)
(for-each
(lambda (arg)
- (test (augment-environment arg '(a . 32)) 'error)
- (test (augment-environment! arg '(a . 32)) 'error))
- (list -1 #\a 1 3.14 3/4 1.0+1.0i "hi" 'hi #() #f _ht_))
+ (test (sublet arg '(a . 32)) 'error)
+ (test (varlet arg '(a . 32)) 'error))
+ (list -1 #\a 1 3.14 3/4 1.0+1.0i "hi" 'hi #() #f _ht_ _null_ _c_obj_))
-(let ((e (augment-environment (current-environment)
+(let ((e (sublet (curlet)
(cons 'a 32)
(cons 'b 12))))
(test (eval '(+ a b) e) 44)
- (test (eval '(+ a b c) (augment-environment e (cons 'c 3))) 47)
- (test (eval '(+ a b) (augment-environment e (cons 'b 3))) 35)
+ (test (eval '(+ a b c) (sublet e (cons 'c 3))) 47)
+ (test (eval '(+ a b) (sublet e (cons 'b 3))) 35)
(test (eval-string "(+ a b)" e) 44)
- (test (eval-string "(+ a b c)" (augment-environment e (cons 'c 3))) 47)
- (test (eval-string "(+ a b)" (augment-environment e (cons 'b 3))) 35)
+ (test (eval-string "(+ a b c)" (sublet e (cons 'c 3))) 47)
+ (test (eval-string "(+ a b)" (sublet e (cons 'b 3))) 35)
)
-(test (defined? 'a (augment-environment '() '(a . 1))) #t)
-(test (defined? 'b (augment-environment '() '(a . 1))) #f)
+(test (with-let (sublet () '(a . 1)) (defined? 'a)) #t)
+(test (defined? 'a (sublet () '(a . 1))) #t)
+(test (defined? 'b (sublet () '(a . 1))) #f)
(test (defined? 'a '((a . 1))) 'error)
(test (defined? 'a '((a . 1) 2)) 'error)
-(test (defined? 'a (augment-environment '())) #f)
+(test (defined? 'a (sublet ())) #f)
-(test (symbol->value 'a (augment-environment '() '(a . 1))) 1)
-(test (symbol->value 'b (augment-environment '() '(a . 1))) #<undefined>)
+(test (symbol->value 'a (sublet () '(a . 1))) 1)
+(test (symbol->value 'b (sublet () '(a . 1))) #<undefined>)
(test (symbol->value 'a '((a . 1))) 'error)
(test (symbol->value 'a '((a . 1) 2)) 'error)
-(test (eval 'a (augment-environment '() '(a . 1))) 1)
-(test (eval 'a (augment-environment '() '(b . 1))) 'error)
+(test (eval 'a (sublet () '(a . 1))) 1)
+(test (eval 'a (sublet () '(b . 1))) 'error)
(test (eval 'a '((a . 1))) 'error)
(test (eval 'a '((a . 1) 2)) 'error)
-(test (eval-string "a" (augment-environment '() '(a . 1))) 1)
-(test (eval-string "a" (augment-environment '() '(b . 1))) 'error)
+(test (eval-string "a" (sublet () '(a . 1))) 1)
+(test (eval-string "a" (sublet () '(b . 1))) 'error)
(test (eval-string "a" '((a . 1))) 'error)
(test (eval-string "a" '((a . 1) 2)) 'error)
-(test (with-environment (augment-environment '() '(a . 1)) a) 1)
-(test (with-environment (augment-environment '()) 1) 1)
-(test (with-environment (augment-environment '() '(b . 1)) a) 'error)
-(test (with-environment '((a . 1)) a) 'error)
-(test (with-environment '((a . 1) 2) a) 'error)
+(test (with-let (sublet () '(a . 1)) a) 1)
+(test (with-let (sublet ()) 1) 1)
+(test (with-let (sublet () '(b . 1)) a) 'error)
+(test (with-let '((a . 1)) a) 'error)
+(test (with-let '((a . 1) 2) a) 'error)
+(test (let ((a 1)) (set! ((curlet) 'a) 32) a) 32)
(for-each
(lambda (arg)
- (test (augment-environment (current-environment) arg) 'error)
- (test (augment-environment! (current-environment) arg) 'error))
- (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
-(test (with-environment (augment-environment (current-environment) (cons '+ (lambda args (apply * args)))) (+ 1 2 3 4)) 24)
-(test (with-environment (current-environment) (let ((x 1)) x)) 1)
+ (test (sublet (curlet) arg) 'error)
+ (test (varlet (curlet) arg) 'error))
+ (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi "hi" abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(test (with-let (curlet) (let ((x 1)) x)) 1)
+
+(let ((old-safety (*s7* 'safety)))
+ (set! (*s7* 'safety) 1)
+ (define (hi)
+ (let ((e (sublet (curlet)
+ (cons 'abs (lambda (a) (- a 1))))))
+ (with-let e
+ (abs -1))))
+ (test (hi) -2)
+ (test (hi) -2)
+ (test (let ((e (sublet (curlet)
+ (cons 'abs (lambda (a) (- a 1))))))
+ (with-let e
+ (abs -1)))
+ -2)
+ (set! (*s7* 'safety) old-safety))
(test (let ((x 12))
- (let ((e (current-environment)))
+ (let ((e (curlet)))
(let ((x 32))
- (with-environment e (* x 2)))))
+ (with-let e (* x 2)))))
24)
-(test (let ((e #f)) (let ((x 2) (y 3)) (set! e (current-environment))) (let ((x 0) (y 0)) (with-environment e (+ x y)))) 5)
-(test (let ((e #f)) (let () (define (func a b) (set! e (current-environment)) (+ a b)) (func 1 2)) (with-environment e (+ a b))) 3)
+(test (let ((e #f)) (let ((x 2) (y 3)) (set! e (curlet))) (let ((x 0) (y 0)) (with-let e (+ x y)))) 5)
+(test (let ((e #f)) (let () (define (func a b) (set! e (curlet)) (+ a b)) (func 1 2)) (with-let e (+ a b))) 3)
(test (let ((e #f)
(f #f))
(let ()
(define (func a b)
- (set! e (current-environment))
+ (set! e (curlet))
(+ a b))
(set! f func)
(func 1 2))
- (let ((val (with-environment e (+ a b))))
+ (let ((val (with-let e (+ a b))))
(f 3 4)
- (list val (with-environment e (+ a b)))))
+ (list val (with-let e (+ a b)))))
'(3 7))
-(test (with-environment) 'error)
-(test (with-environment 1) 'error)
-(test (with-environment () 1) 'error)
-(test (with-environment (current-environment)) 'error) ; ?? perhaps this should be #<unspecified>
+(test (with-let) 'error)
+(test (with-let 1) 'error)
+(test (with-let () 1) 'error)
+(test (with-let (curlet)) 'error) ; ?? perhaps this should be #<unspecified>
+(test (outlet) 'error)
+(test (outlet (curlet) #f) 'error)
+(test (eq? (outlet (rootlet)) (rootlet)) #t)
+(test (set! (outlet (curlet)) #f) 'error)
+(test (set! (outlet) #f) 'error)
+
+(let ()
+ (test (let ()
+ (set! (outlet (curlet))
+ (let ((a 1)
+ (b 2))
+ (set! (outlet (curlet)) (rootlet))
+ (curlet)))
+ (+ a b))
+ 3))
+;; equivalent to (let ((a 1) (b 2)) (let () (curlet)))
+;; that is, we've turned the let structure inside out
+
+
+(test (let ()
+ (set! (outlet (curlet)) (rootlet))
+ (eq? (outlet (curlet)) (rootlet)))
+ #t)
+(test (let ((a 1))
+ (let ((b 2))
+ (set! (outlet (curlet)) (rootlet))
+ ((curlet) 'a)))
+ #<undefined>)
+(test (let ((a 1)
+ (e #f))
+ (set! e (curlet))
+ (let ((b 2))
+ (let ((c 3))
+ (set! (outlet (curlet)) e)
+ (and (equal? ((curlet) 'a) 1)
+ (equal? ((curlet) 'b) #<undefined>)
+ (equal? ((curlet) 'c) 3)
+ (equal? (outlet (curlet)) e)))))
+ #t)
+
(for-each
(lambda (arg)
- (test (with-environment arg #f) 'error))
- (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
-(test (with-environment (augment-environment (augment-environment '()) '(a . 1)) 1) 1)
-(test (with-environment (augment-environment (augment-environment '()) '(a . 1)) a) 1)
-(test (with-environment (current-environment) 1) 1)
+ (test (with-let arg #f) 'error)
+ (test (outlet arg) 'error)
+ (test (set! (outlet (curlet)) arg) 'error))
+ (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi "hi" abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+
+(test (with-let (sublet (sublet ()) '(a . 1)) 1) 1)
+(test (with-let (sublet (sublet ()) '(a . 1)) a) 1)
+(test (with-let (curlet) 1) 1)
(test (let ((a 1))
- (+ (with-environment
- (augment-environment (current-environment) (cons 'a 10))
+ (+ (with-let
+ (sublet (curlet) (cons 'a 10))
a)
a))
11)
(test (let ((a 1))
- (+ (with-environment
- (augment-environment (current-environment) (cons 'a 10))
+ (+ (with-let
+ (sublet (curlet) (cons 'a 10))
(+ a
- (with-environment
- (augment-environment (current-environment) (cons 'a 100))
+ (with-let
+ (sublet (curlet) (cons 'a 100))
a)))
a))
111)
(test (let ((a 1))
- (+ (with-environment
- (augment-environment (current-environment) (cons 'a 10))
+ (+ (with-let
+ (sublet (curlet) (cons 'a 10))
(+ a
- (with-environment
- (augment-environment (current-environment) (cons 'b 100))
+ (with-let
+ (sublet (curlet) (cons 'b 100))
a)))
a))
21)
(test (let ((a 1))
- (let ((e (current-environment)))
- (+ (with-environment
- (augment-environment (current-environment) (cons 'a 10))
+ (let ((e (curlet)))
+ (+ (with-let
+ (sublet (curlet) (cons 'a 10))
(+ a
- (with-environment e a)))
+ (with-let e a)))
a)))
12)
(test (let ((a 1))
- (let ((e (current-environment)))
- (+ (with-environment
- (augment-environment! (augment-environment (current-environment) (cons 'a 10)) (cons 'a 20))
+ (let ((e (curlet)))
+ (+ (with-let
+ (varlet (sublet (curlet) (cons 'a 10)) (cons 'a 20))
(+ a
- (with-environment e a)))
+ (with-let e a)))
a)))
22)
+(test (= ((inlet 'a 1 'a 2) 'a) (with-let (inlet 'a 1 'a 2) a)) #t)
+(test (= ((varlet (inlet 'a 1) 'a 2) 'a) (with-let (varlet (inlet 'a 1) 'a 2) a)) #t)
(test (let ((a 1))
- (+ (with-environment
- (augment-environment (current-environment) (cons 'a 10))
+ (+ (with-let
+ (sublet (curlet) (cons 'a 10))
(+ (let ((b a))
- (augment-environment! (current-environment) (cons 'a 20))
+ (varlet (curlet) (cons 'a 20))
(+ a b))
a))
a))
41)
+
+(test (let ((a 1)) (+ (let ((a 2)) (+ (let ((a 3)) a) a)) a)) 6)
+(test (let ((a 1)) (+ (let () (+ (let ((a 3)) (varlet (outlet (curlet)) '(a . 2)) a) a)) a)) 6)
+(test (let () (let ((a 1)) (varlet (outlet (curlet)) '(a . 2))) a) 2)
+
(test (let ((a 1))
- (let ((e (current-environment)))
- (+ (with-environment
- (augment-environment e (cons 'a 10))
+ (let ((e (curlet)))
+ (+ (with-let
+ (sublet e (cons 'a 10))
(+ a
- (with-environment e a)))
+ (with-let e a)))
a)))
- 'error) ; "e" is not in the current-environment at the top, so it's not in the nested env
+ 'error) ; "e" is not in the curlet at the top, so it's not in the nested env
(test (let ((x 3))
- (augment-environment! (current-environment)
+ (varlet (curlet)
(cons 'y 123))
(+ x y))
126)
-
+#|
+;; can't decide about these -- safe closures prebuild the funclet from the arglist so two of these fail
(test (let ()
(define (hiho a) (+ a b))
- (augment-environment! (procedure-environment hiho) (cons 'b 21)) ; hmmm...
+ (varlet (funclet hiho) (cons 'b 21))
(hiho 1))
22)
(test (let ()
(define hiho (let ((x 32)) (lambda (a) (+ a x b))))
- (augment-environment! (procedure-environment hiho) (cons 'b 10) (cons 'x 100))
+ (varlet (funclet hiho) (cons 'b 10) (cons 'x 100))
+ (hiho 1))
+ 111)
+
+(test (let ()
+ (define hiho (let ((x 32)) (lambda* (a) (+ a x b))))
+ (varlet (funclet hiho) (cons 'b 10) (cons 'x 100))
(hiho 1))
111)
@@ -20321,49 +34925,51 @@ abs 1 2
(+ b 1))
(lambda (a)
(hi a))))
- (augment-environment! (procedure-environment hiho) (cons 'hi (lambda (b) (+ b 123))))
+ (varlet (funclet hiho) (cons 'hi (lambda (b) (+ b 123))))
(hiho 2))
125)
-
+|#
(test (let () ; here's one way for multiple functions to share a normal scheme closure
(define f1 (let ((x 23))
(lambda (a)
(+ x a))))
(define f2
- (with-environment (procedure-environment f1)
+ (with-let (funclet f1)
(lambda (b)
(+ b (* 2 x)))))
(+ (f1 1) (f2 1)))
71)
-(test (augment-environment!) 'error)
-(test (augment-environment 3) 'error)
-(test (augment-environment! 3) 'error)
-
-(test (let ((e (current-environment))) (environment? e)) #t)
-(test (let ((f (lambda (x) (environment? x)))) (f (current-environment))) #t)
-(test (let ((e (augment-environment! '() '(a . 1)))) (environment? e)) #t)
-(test (let ((e (augment-environment! '() '(a . 1)))) ((lambda (x) (environment? x)) e)) #t)
-(test (environment? ((lambda () (current-environment)))) #t)
-(test (environment? ((lambda (x) x) (current-environment))) #t)
-(test (let ((e (let ((x 32)) (lambda (y) (let ((z 123)) (current-environment))))))
+(test (varlet) 'error)
+(test (sublet 3) 'error)
+(test (varlet 3) 'error)
+
+(test (let ((e (curlet))) (let? e)) #t)
+(test (let ((f (lambda (x) (let? x)))) (f (curlet))) #t)
+(test (let ((e (varlet () '(a . 1)))) (let? e)) #t)
+(test (let ((e (varlet () '(a . 1)))) ((lambda (x) (let? x)) e)) #t)
+(test (let? ((lambda () (curlet)))) #t)
+(test (let? ((lambda (x) x) (curlet))) #t)
+(test (let ((e (let ((x 32)) (lambda (y) (let ((z 123)) (curlet))))))
(eval `(+ x y z) (e 1)))
156)
-(test (let ((e #f)) (set! e (let ((x 32)) (lambda (y) (let ((z 123)) (procedure-environment e)))))
+(test (let ((e #f)) (set! e (let ((x 32)) (lambda (y) (let ((z 123)) (funclet e)))))
(eval `(+ x 1) (e 1)))
33)
+(test (let () ((curlet) 'abs)) #<undefined>)
+(test ((rootlet) 'abs) abs)
(test (catch #t
(lambda ()
- (with-environment (current-environment)
+ (with-let (curlet)
(error 'testing "a test")
32))
(lambda args (car args)))
'testing)
(test (call-with-exit
(lambda (go)
- (with-environment (current-environment)
+ (with-let (curlet)
(go 1)
32)))
1)
@@ -20371,14 +34977,14 @@ abs 1 2
(test (let ((x 0))
(call-with-exit
(lambda (go)
- (with-environment (augment-environment! (current-environment) (cons 'x 123))
+ (with-let (varlet (curlet) (cons 'x 123))
(go 1))))
x)
0)
(test (let ((x 1))
(+ x (call-with-exit
(lambda (go)
- (with-environment (augment-environment! (current-environment) (cons 'x 123))
+ (with-let (varlet (curlet) (cons 'x 123))
(go x))))
x))
125)
@@ -20386,282 +34992,994 @@ abs 1 2
(test (let ((x 0))
(catch #t
(lambda ()
- (with-environment (augment-environment! (current-environment) (cons 'x 123))
+ (with-let (varlet (curlet) (cons 'x 123))
(error 'oops) x))
(lambda args x)))
0)
-(test (call-with-exit (lambda (c) (0 (c 1)))) 1)
-(test (call-with-exit (lambda (k) (k "foo"))) "foo")
-(test (call-with-exit (lambda (k) "foo")) "foo")
-(test (call-with-exit (lambda (k) (k "foo") "oops")) "foo")
-(test (let ((memb (lambda (x ls)
- (call-with-exit
- (lambda (break)
- (do ((ls ls (cdr ls)))
- ((null? ls) #f)
- (if (equal? x (car ls))
- (break ls))))))))
- (list (memb 'd '(a b c))
- (memb 'b '(a b c))))
- '(#f (b c)))
-(let ((x 1))
- (define y (call-with-exit (lambda (return) (set! x (return 32)))))
- (test (and (= x 1) (= y 32)) #t)
- (set! y (call-with-exit (lambda (return) ((lambda (a b c) (set! x a)) 1 2 (return 33)))))
- (test (and (= x 1) (= y 33)) #t)
- (set! y (call-with-exit (lambda (return) ((lambda (a b) (return a) (set! x b)) 2 3))))
- (test (and (= x 1) (= y 2)) #t))
+(let ((a 1))
+ (test ((curlet) 'a) 1)
+ (set! ((curlet) 'a) 32)
+ (test ((curlet) 'a) 32))
-(if (and (defined? 'provided?)
- (provided? 'threads))
- (begin
-
- (test (let ((ctr 0))
- (let ((t1 (make-thread (lambda () (set! ctr (+ ctr 1))))))
- (join-thread t1))
- ctr)
- 1)
-
- (test (let ((ctr 0))
- (let ((t1 (make-thread (lambda () (set! ctr (+ ctr 1))))))
- (join-thread t1)
- (thread? t1)))
- #t)
-
- (test (let ((ctr 0)
- (loc (make-thread-variable)))
- (let ((t1 (make-thread (lambda () (set! (loc) (+ ctr 1)) (set! ctr (loc))))))
- (join-thread t1)
- ctr))
- 1)
+(let () (test (equal? (curlet) (rootlet)) #f))
+(test (let ((a 1)) (let ((e (curlet))) (set! (e 'a) 2)) a) 2)
+(let () (define (hi e) (set! (e 'a) 2)) (test (let ((a 1)) (hi (curlet)) a) 2))
+(let () (define (hi) (let ((a 1)) (let ((e (curlet)) (i 'a)) (set! (e i) #\a)) a)) (hi) (hi) (test (hi) #\a))
+
+(test (let ((a 1)) (let ((e (curlet))) (e :hi))) #<undefined>) ; global env is not searched in this case
+
+(let ((e1 #f) (e2 #f))
+ (let ((a 1)) (set! e1 (curlet)))
+ (let ((a 1)) (set! e2 (curlet)))
+ (test (equal? e1 e2) #t)
+ (test (eqv? e1 e2) #f))
+
+(let ((e1 #f) (e2 #f))
+ (let ((a 1)) (set! e1 (curlet)))
+ (let ((a 2)) (set! e2 (curlet)))
+ (test (equal? e1 e2) #f))
+
+(let ((e1 #f) (e2 #f))
+ (let ((a 1)) (set! e1 (curlet)))
+ (let ((a 1) (b 2)) (set! e2 (curlet)))
+ (test (equal? e1 e2) #f))
+
+(let ((e1 #f) (e2 #f))
+ (let ((a 1) (b 2)) (set! e1 (curlet)))
+ (let ((a 1) (b 2)) (set! e2 (curlet)))
+ (test (equal? e1 e2) #t))
+
+(let ((e1 #f) (e2 #f))
+ (let () (set! e1 (curlet)))
+ (let ((a 1)) (set! e2 (curlet)))
+ (test (equal? e1 e2) #f))
+
+(test (let ((a #(1 2 3))) ((curlet) 'a 1)) 2)
+(test (let ((a #(1 2 3))) (let ((e (curlet))) ((curlet) 'e 'a 1))) 2)
+
+(let ((x (openlet (inlet 'let-ref-fallback (lambda args args)))))
+ (test (x) (list x #f)) ; let-ref expects 2 args
+ (test (x 1) (list x 1)))
+
+(let ((x (openlet (inlet 'let-set!-fallback (lambda args args)))))
+ ; (test (set! (x) 1) (list x 1)) ; doesn't work yet
+ (test (set! (x 1) 2) (list x 1 2)))
+
+(let ()
+ (define (f1)
+ (let ((v (vector #f)) (X 0))
+ (do ((i 0 (+ i 1))) ((= i 1) v)
+ (vector-set! v 0 (let-ref X 'a)))))
+ (test (f1) 'error))
+
+(let ((x '(a)))
+ (let ((x '(c)))
+ x)
+ (let ((x '(b)))
+ (define (transparent-memq sym var e)
+ (let ((val (symbol->value var e)))
+ (or (and (pair? val)
+ (memq sym val))
+ (and (not (eq? e (rootlet)))
+ (transparent-memq sym var (outlet e))))))
+ (let ((ce (curlet)))
+ (test (list (transparent-memq 'a 'x ce)
+ (transparent-memq 'b 'x ce)
+ (transparent-memq 'c 'x ce))
+ '((a) (b) #f)))))
+
+(test (let-set! (rootlet) :rest #f) 'error)
+
+
+(test (make-iterator) 'error)
+(test (make-iterator (curlet) 1) 'error)
+(test (iterator?) 'error)
+(test (iterator? 1 2) 'error)
+(test (arity make-iterator) '(1 . 2))
+
+(for-each
+ (lambda (arg)
+ (test (iterator? arg) #f))
+ (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+
+(let ((a 1))
+ (let ((lti (make-iterator (curlet))))
+ (test (cdr (lti)) 1)
+ (test (lti) #<eof>)
+ (test (lti) #<eof>)))
+
+(let () (let ((lti (make-iterator (curlet)))) (test (lti) #<eof>)))
+(let ((lti (make-iterator (inlet 'a 1 'b 2))))
+ ;(test (length lti) #f)
+ (test (reverse lti) 'error)
+ (test (iterator? lti) #t)
+ (test (lti) '(b . 2))
+ (test (lti) '(a . 1))
+ (test (lti) #<eof>)
+ (test (set! (lti) 32) 'error))
+
+(let ((lti (make-iterator (rootlet))))
+ (test (defined? (car (lti))) #t)
+ (test (let ((b (lti))) (equal? (symbol->value (car b)) (cdr b))) #t))
+
+
+
+;;; make-type ----------------
+(let ()
+ (define (make-type . args)
+ (let* ((type (gensym "make-type type")) ; built-in type and value slots have gensym'd names
+ (value (gensym "make-type value"))
+ (obj (openlet
+ (sublet ()
+ (cons type type)
+ (cons value #<unspecified>)))))
- (test (let ((ctr 0)
- (loc (make-thread-variable)))
- (let ((t1 (make-thread (lambda () (set! (loc) (+ ctr 1)) (set! ctr (thread-variable? loc))))))
- (join-thread t1)
- ctr))
- #t)
+ ;; load up any methods/slots
+ (do ((arg args (cddr arg)))
+ ((null? arg))
+ (varlet obj
+ (cons (keyword->symbol (car arg)) (cadr arg))))
- (test (let ((ctr 0)
- (lock (make-lock)))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
- (join-thread t1))
- ctr)
- 1)
+ ;; return a list of '(? make ref) funcs
+ (list (lambda (x)
+ (and (let? x)
+ (eq? (x type) type)))
+ (lambda* (new-value)
+ (let ((new-obj (copy obj)))
+ (set! (new-obj value) new-value)
+ new-obj))
+ (lambda (x)
+ (x value)))))
+
+ (define special-value
+ (let ((type (make-type)))
+ ((cadr type) 'special)))
+
+ (test (eq? special-value special-value) #t)
+ (test (eqv? special-value special-value) #t)
+ (test (equal? special-value special-value) #t)
+ (test (procedure? special-value) #f)
+ (for-each
+ (lambda (arg)
+ (test (or (eq? arg special-value)
+ (eqv? arg special-value)
+ (equal? arg special-value))
+ #f))
+ (list "hi" -1 #\a 1 'special 3.14 3/4 1.0+1.0i #f #t '(1 . 2) #<unspecified> #<undefined>))
+
+ (test (let ((obj ((cadr (make-type :type "hi" :value 123)) 0))) (list (obj 'type) (obj 'value))) '("hi" 123))
+ (test (let ((obj ((cadr (make-type :type "hi" :value 123))))) (list (obj 'type) (obj 'value))) '("hi" 123))
+
+ (test (let* ((rec-type (make-type))
+ (? (car rec-type))
+ (make (cadr rec-type))
+ (ref (caddr rec-type)))
+ (let ((val-1 (make "hi")))
+ (let ((val-2 (make val-1)))
+ (let ((val-3 (make val-2)))
+ (ref (ref (ref val-3)))))))
+ "hi")
+
+ (test (let* ((rec1-type (make-type))
+ (?1 (car rec1-type))
+ (make1 (cadr rec1-type))
+ (ref1 (caddr rec1-type)))
+ (let* ((rec2-type (make-type))
+ (?2 (car rec2-type))
+ (make2 (cadr rec2-type))
+ (ref2 (caddr rec2-type)))
+ (let ((val-1 (make1 "hi")))
+ (let ((val-2 (make2 "hi")))
+ (let ((val-3 (make1 val-2)))
+ (and (string=? (ref2 (ref1 val-3)) "hi")
+ (not (equal? val-1 val-2))
+ (?1 val-1)
+ (?2 val-2)
+ (not (?2 val-3))))))))
+ #t)
+
+ (test (let* ((rec1-type (make-type))
+ (make1 (cadr rec1-type))
+ (ref1 (caddr rec1-type)))
+ (let* ((rec2-type (make-type))
+ (make2 (cadr rec2-type)))
+ (let ((val-1 (make1 "hi")))
+ (let ((val-2 (make2 val-1)))
+ (ref1 val-2)))))
+ #<undefined>)
+
+ (test (make-type (make-type)) 'error)
+ (let ((t (make-type)))
+ (let ((t? (car t))
+ (make-t (cadr t))
+ (t-ref (caddr t)))
+ (test (make-t 1 2) 'error)
+ (test (t? (make-t)) #t)
+ (test (t-ref (make-t)) #f)
+ (test (t? 1 2) 'error)
+ (test (t?) 'error)
+ (test (t-ref) 'error)
+ (test (t-ref 1 2) 'error)
+ (for-each
+ (lambda (arg)
+ (test (t-ref arg) 'error))
+ (list #\a 'a-symbol 1.0+1.0i #t #(1 2) () 3/4 3.14 #() "hi" :hi 1 #f #t '(1 . 2)))))
+
+ (begin
+ (define rec? #f)
+ (define make-rec #f)
+ (define rec-a #f)
+ (define rec-b #f)
+
+ (let* ((rec-type (make-type))
+ (? (car rec-type))
+ (make (cadr rec-type))
+ (ref (caddr rec-type)))
- (test (let ((ctr 0)
- (lock (make-lock)))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (lock? lock)) (release-lock lock)))))
- (join-thread t1))
- ctr)
- #t)
+ (set! make-rec (lambda* ((a 1) (b 2))
+ (make (vector a b))))
- (test (let ((ctr 0)
- (lock (make-lock)))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock))))
- (t2 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
- (join-thread t1)
- (join-thread t2))
- ctr)
- 2)
-
- (test (let ((ctr1 0) (ctr2 0))
- (let ((t1 (make-thread (lambda () (set! ctr1 (+ ctr1 1)) (* ctr1 2))))
- (t2 (make-thread (lambda () (set! ctr2 (+ ctr2 1)) (* ctr2 3)))))
- (+ (join-thread t1)
- (join-thread t2))))
- 5)
+ (set! rec? (lambda (obj)
+ (? obj)))
- (test (let ((ctr 0)
- (lock (make-lock)))
- (let ((threads '()))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (release-lock lock)))))
- (set! threads (cons t1 threads))))
- (for-each
- (lambda (tn)
- (join-thread tn))
- threads))
- ctr)
- 8)
+ (set! rec-a (dilambda
+ (lambda (obj)
+ (and (rec? obj)
+ (vector-ref (ref obj) 0)))
+ (lambda (obj val)
+ (if (rec? obj)
+ (vector-set! (ref obj) 0 val)))))
- (let ((biglist '())
- (lock (make-lock)))
- (let ((threads '()))
- (for-each
- (lambda (lst)
- (set! threads (cons (make-thread
- (let ((my-lst lst))
- (lambda ()
- (for-each
- (lambda (arg)
- (grab-lock lock)
- (set! biglist (cons arg biglist))
- (release-lock lock))
- my-lst))))
- threads)))
- (list (list 1 2 3)
- (list 4 5)
- (list 6 7 8 9 10)))
-
- (for-each
- (lambda (thread)
- (join-thread thread))
- threads))
-
- (test (sort! biglist <) '(1 2 3 4 5 6 7 8 9 10)))
-
- (test (let ((ctr 0)
- (ctr1 0)
- (ctr2 0)
- (lock (make-lock))
- (var (make-thread-variable)))
- (let ((t1 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (set! (var) ctr) (release-lock lock) (set! ctr1 (var)))))
- (t2 (make-thread (lambda () (grab-lock lock) (set! ctr (+ ctr 1)) (set! (var) ctr) (release-lock lock) (set! ctr2 (var))))))
- (join-thread t1)
- (join-thread t2))
- (and (= ctr 2)
- (= (+ ctr1 ctr2) 3)))
- #t)
- (let ((v1 (make-vector 4096))
- (v2 (make-vector 4096))
- (dsum 0.0)
- (dlock (make-lock)))
-
- (do ((i 0 (+ i 1)))
- ((= i 4096))
- (set! (v1 i) (- (random 2.0) 1.0))
- (set! (v2 i) (- (random 2.0) 1.0)))
+ (set! rec-b (dilambda
+ (lambda (obj)
+ (and (rec? obj)
+ (vector-ref (ref obj) 1)))
+ (lambda (obj val)
+ (if (rec? obj)
+ (vector-set! (ref obj) 1 val)))))))
+
+ (let ((hi (make-rec 32 '(1 2))))
+ (test (rec? hi) #t)
+ (test (equal? hi hi) #t)
+ (test (rec? 32) #f)
+ (test (rec-a hi) 32)
+ (test (rec-b hi) '(1 2))
+ (set! (rec-b hi) 123)
+ (test (rec-b hi) 123)
+ (let ((ho (make-rec 32 '(1 2))))
+ (test (eq? hi ho) #f)
+ (test (eqv? hi ho) #f)
+ (test (equal? hi ho) #f)
+ (set! (rec-b ho) 123)
+ (test (equal? hi ho) #t))
+ (let ((ho (make-rec 123 ())))
+ (test (eq? hi ho) #f)
+ (test (eqv? hi ho) #f)
+ (test (equal? hi ho) #f))
+ (test (equal? (copy hi) hi) #t)
+ (test (fill! hi 1) 'error)
+ ;(test (object->string hi) "(inlet)")
+ (test (length hi) 2)
+ (test (reverse hi) 'error)
+ (test (for-each abs hi) 'error)
+ (test (map abs hi) 'error)
+ (test (hi 1) 'error)
+ (test (set! (hi 1) 2) 'error)
+ )
- (let ((threads '()))
- (let loop
- ((i 0))
- (set! threads (cons (make-thread
- (lambda ()
- (let ((sum 0.0)
- (end (+ i 1024)))
- (do ((k i (+ k 1)))
- ((= k end))
- (set! sum (+ sum (* (v1 k) (v2 k)))))
- (grab-lock dlock)
- (set! dsum (+ dsum sum))
- (release-lock dlock))))
- threads))
- (if (< i 3072)
- (loop (+ i 1024))))
-
- (for-each
- (lambda (thread)
- (join-thread thread))
- threads))
-
- (let ((xsum 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 4096))
- (set! xsum (+ xsum (* (v1 i) (v2 i)))))
+ (let ((rec3? (car (make-type)))
+ (rec4? (car (make-type :value 21))))
+ (for-each
+ (lambda (arg)
+ (test (rec3? arg) #f)
+ (test (rec4? arg) #f))
+ (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t '(1 . 2))))
+
+ )
- (test (< (abs (- xsum dsum)) .001) #t)))
- (let ()
- (define (fib n)
- (define (fib-1 n)
- (if (< n 2)
- n
- (+ (fib-1 (- n 1))
- (fib-1 (- n 2)))))
- (apply +
- (map join-thread
- (list (make-thread (lambda () (fib-1 (- n 1))))
- (make-thread (lambda () (fib-1 (- n 2))))))))
-
- (define (fib-2 n)
- (let ((phi (/ (+ 1 (sqrt 5)) 2)))
- (floor (/ (- (expt phi n) ; "floor" to return an integer
- (expt (- 1 phi) n))
- (sqrt 5)))))
-
- (test (= (fib-2 10) 55 (fib 10)) #t)
- (test (fib 20) 6765))
-
- (test (join-thread (make-thread (lambda () (catch #t (lambda () (+ 1 "hi")) (lambda args 'error))))) 'error)
+;;; pfloat-vector
+(let ()
+ (begin
+ (define pfloat-vector? #f)
+ (define make-pfloat-vector #f)
+
+ (let ((type (gensym))
+ (->float (lambda (x)
+ (if (real? x)
+ (* x 1.0)
+ (error 'wrong-type-arg "pfloat-vector new value is not a real: ~A" x)))))
- (for-each
- (lambda (arg)
- (test (thread? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (varlet (curlet)
+ (cons 'length (lambda (p) ((funclet p) 'len)))
+ (cons 'object->string (lambda* (p (use-write #t)) "#<pfloat-vector>"))
+ (cons 'vector? (lambda (p) #t))
+ (cons 'vector-length (lambda (p) ((funclet p) 'len)))
+ (cons 'vector-dimensions (lambda (p) (list ((funclet p) 'len))))
+ (cons 'vector-ref (lambda (p ind) (#_vector-ref ((funclet p) 'obj) ind)))
+ (cons 'vector-set! (lambda (p ind val) (#_vector-set! ((funclet p) 'obj) ind (->float val))))
+ (cons 'vector-fill! (lambda (p val) (#_vector-fill! ((funclet p) 'obj) (->float val))))
+ (cons 'fill! (lambda (p val) (#_vector-fill! ((funclet p) 'obj) (->float val))))
+ (cons 'vector->list (lambda (p) (#_vector->list ((funclet p) 'obj))))
+ (cons 'equal? (lambda (x y) (#_equal? ((funclet x) 'obj) ((funclet y) 'obj))))
+ (cons 'morally-equal? (lambda (x y) (#_morally-equal? ((funclet x) 'obj) ((funclet y) 'obj))))
+ (cons 'reverse (lambda (p) (vector->pfloat-vector (#_reverse ((funclet p) 'obj)))))
+ (cons 'copy (lambda (p) (vector->pfloat-vector ((funclet p) 'obj))))
+ (cons 'sort! (lambda (p f) (vector->pfloat-vector (#_sort! ((funclet p) 'obj) f))))
+ )
- (for-each
- (lambda (arg)
- (test (lock? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (set! make-pfloat-vector
+ (lambda* (len (init 0.0))
+ (let ((obj (make-vector len (->float init))))
+ (openlet
+ (dilambda
+ (lambda (i) (#_vector-ref obj i))
+ (lambda (i val) (#_vector-set! obj i (->float val))))))))
+ (set! pfloat-vector?
+ (lambda (obj)
+ (and (procedure? obj)
+ (eq? ((funclet obj) 'type) type))))))
+
+ (define pfloat-vector
+ (lambda args
+ (let* ((len (length args))
+ (v (make-pfloat-vector len)))
+ (do ((i 0 (+ i 1))
+ (arg args (cdr arg)))
+ ((= i len) v)
+ (set! (v i) (car arg))))))
+
+ (define (vector->pfloat-vector v)
+ (let* ((len (length v))
+ (fv (make-pfloat-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (v i)))
+ fv))
+
+ (let ((v (make-pfloat-vector 3 0.0)))
+ (test (length v) 3)
+ (set! (v 1) 32.0)
+ (test (v 0) 0.0)
+ (test (v 1) 32.0)
+ (test (eq? v v) #t)
+ (test (eq? v (pfloat-vector 0.0 32.0 0.0)) #f)
+ (test (equal? v (pfloat-vector 0.0 32.0 0.0)) #t)
+ (test (morally-equal? v (pfloat-vector 0.0 32.0 0.0)) #t)
+ (test (reverse (pfloat-vector 1.0 2.0 3.0)) (pfloat-vector 3.0 2.0 1.0))
+ (test (copy (pfloat-vector 1.0 2.0 3.0)) (pfloat-vector 1.0 2.0 3.0))
+ (test (let () (fill! v 1.0) v) (pfloat-vector 1.0 1.0 1.0))
+ (test (object->string v) "#<pfloat-vector>")
+ (test (let ((v (pfloat-vector 1.0 2.0 3.0))) (map v (list 2 1 0))) '(3.0 2.0 1.0))
+ (test (v -1) 'error)
+ (test (v 32) 'error)
+ (for-each
+ (lambda (arg)
+ (test (v arg) 'error))
+ (list #\a 'a-symbol 1.0+1.0i #f #t abs #(1 2) () 3/4 3.14 '(1 . 2)))
+
+ (test (set! (v 0) "hi") 'error)
+ (test (set! (v -1) "hi") 'error)
+ (test (set! (v 32) "hi") 'error)
+ (for-each
+ (lambda (arg)
+ (test (set! (v 0) arg) 'error))
+ (list #\a 'a-symbol 1.0+1.0i #f #t abs #(1 2) () '(1 . 2)))
+ (test (length v) 3)
+ )
+
+ (let ((v1 (pfloat-vector 3 1 4 8 2)))
+ (let ((v2 (sort! v1 <))
+ (one 1))
+ (test (equal? v2 (pfloat-vector 1 2 3 4 8)) #t)
+ (test (vector? v1) #t)
+ (test (pfloat-vector? v1) #t)
+ (test (vector-length v1) 5)
+ (if (not pure-s7) (test (vector->list v1) '(1.0 2.0 3.0 4.0 8.0)))
+ (test (vector-ref v1 one) 2.0)
+ (test (vector-set! v1 1 3/2) 1.5)
+ (test (vector-ref v1 1) 1.5)
+ (test (vector-dimensions v1) '(5))
+ (fill! v1 32)
+ (test v1 (pfloat-vector 32.0 32.0 32.0 32.0 32.0))
+ (test (pfloat-vector? #(1 2 3)) #f)
+
(for-each
(lambda (arg)
- (test (thread-variable? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (test (pfloat-vector? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
(for-each
(lambda (arg)
- (test (make-thread arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))
+ (test (make-pfloat-vector arg) 'error))
+ (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) '(1 . 2) "hi" '((a . 1))))
(for-each
(lambda (arg)
- (test (grab-lock arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))
+ (test (make-pfloat-vector 3 arg) 'error))
+ (list #\a #(1 2 3) 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
(for-each
(lambda (arg)
- (test (release-lock arg) 'error))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) (list 1 2 3) '(1 . 2)))))
+ (test (pfloat-vector (list arg)) 'error))
+ (list #\a #(1 2 3) 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))
-(test (apply "hi" '(1 2)) 'error)
-(test ("hi" 1 2) 'error)
-(test (apply '(1 2) '(1 2)) 'error)
-(test ((list 1 2 3) 1 2) 'error)
+ )))
-(test (apply "hi" '(1)) #\i)
-(test ("hi" 1) #\i)
-(test (apply '(1 2) '(1)) 2)
-(test ((list 1 2 3) 1) 2)
-(test (let ((pi 3)) pi) 'error)
-(test (let ((:key 1)) :key) 'error)
-(test (let ((:3 1)) 1) 'error)
-(test (let ((3 1)) 1) 'error)
-(test (let ((3: 1)) 1) 'error)
-(test (let ((optional: 1)) 1) 'error)
-(test (let ((x_x_x 32)) (let () (define-constant x_x_x 3) x_x_x) (set! x_x_x 31) x_x_x) 'error)
+;;; environments as objects
+
+(define-bacro* (define-class class-name inherited-classes (slots ()) (methods ()))
+
+ ;; a bacro is needed so that the calling environment is accessible via outlet
+ ;; we could also use the begin/let shuffle, but it's too embarrassing
+
+ `(let ((outer-env (outlet (curlet)))
+ (new-methods ())
+ (new-slots ())
+ (new-type (gensym "define-class")))
+
+ (for-each
+ (lambda (class)
+ ;; each class is a set of nested environments, the innermost (first in the list)
+ ;; holds the local slots which are copied each time an instance is created,
+ ;; the next holds the class slots (global to all instances, not copied);
+ ;; these hold the class name and other such info. The remaining environments
+ ;; hold the methods, with the localmost method first. So in this loop, we
+ ;; are gathering the local slots and all the methods of the inherited
+ ;; classes, and will splice them together below as a new class.
+
+ (set! new-slots (append (let->list class) new-slots))
+ (do ((e (outlet (outlet class)) (outlet e)))
+ ((or (not (let? e))
+ (eq? e (rootlet))))
+ (set! new-methods (append (let->list e) new-methods))))
+ ,inherited-classes)
+
+ (let ((remove-duplicates
+ (lambda (lst) ; if multiple local slots with same name, take the localmost
+ (letrec ((rem-dup
+ (lambda (lst nlst)
+ (cond ((null? lst) nlst)
+ ((assq (caar lst) nlst) (rem-dup (cdr lst) nlst))
+ (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+ (reverse (rem-dup lst ()))))))
+ (set! new-slots
+ (remove-duplicates
+ (append (map (lambda (slot)
+ (if (pair? slot)
+ (cons (car slot) (cadr slot))
+ (cons slot #f)))
+ ,slots) ; the incoming new slots, #f is the default value
+ new-slots)))) ; the inherited slots
+
+ (set! new-methods
+ (append (map (lambda (method)
+ (if (pair? method)
+ (cons (car method) (cadr method))
+ (cons method #f)))
+ ,methods) ; the incoming new methods
+
+ ;; add an object->string method for this class.
+ (list (cons 'object->string
+ (lambda* (obj (port #f))
+ (format port "#<~A: ~{~A~^ ~}>"
+ ',class-name
+ (map (lambda (slot)
+ (list (car slot) (cdr slot)))
+ obj)))))
+ (reverse! new-methods))) ; the inherited methods, shadowed automatically
+
+ (let ((new-class (openlet
+ (apply sublet ; the local slots
+ (sublet ; the global slots
+ (apply sublet () ; the methods
+ (reverse new-methods))
+ (cons 'class-name ',class-name) ; class-name slot
+ (cons 'class-type new-type) ; save a unique type identifier (unneeded if class-names are unique)
+ (cons 'inherited ,inherited-classes)
+ (cons 'inheritors ())) ; classes that inherit from this class
+ new-slots))))
+
+ (varlet outer-env
+ (cons ',class-name new-class) ; define the class as class-name in the calling environment
+
+ ;; define class-name? type check
+ (cons (string->symbol (string-append (symbol->string ',class-name) "?"))
+ (lambda (obj)
+ (and (let? obj)
+ (eq? (obj 'class-type) new-type)))))
+
+ (varlet outer-env
+ ;; define the make-instance function for this class.
+ ;; Each slot is a keyword argument to the make function.
+ (cons (string->symbol (string-append "make-" (symbol->string ',class-name)))
+ (apply lambda* (map (lambda (slot)
+ (if (pair? slot)
+ (list (car slot) (cdr slot))
+ (list slot #f)))
+ new-slots)
+ `((let ((new-obj (copy ,,class-name)))
+ ,@(map (lambda (slot)
+ `(set! (new-obj ',(car slot)) ,(car slot)))
+ new-slots)
+ new-obj)))))
+
+ ;; save inheritance info for this class for subsequent define-method
+ (letrec ((add-inheritor (lambda (class)
+ (for-each add-inheritor (class 'inherited))
+ (if (not (memq new-class (class 'inheritors)))
+ (set! (class 'inheritors) (cons new-class (class 'inheritors)))))))
+ (for-each add-inheritor ,inherited-classes))
+
+ ',class-name)))
+
+
+(define-macro (define-generic name)
+ `(define ,name (lambda args (apply ((car args) ',name) args))))
+
+
+(define-macro (define-slot-accessor name slot)
+ `(define ,name (dilambda
+ (lambda (obj) (obj ',slot))
+ (lambda (obj val) (set! (obj ',slot) val)))))
+
+
+(define-bacro (define-method name-and-args . body)
+ `(let* ((outer-env (outlet (curlet)))
+ (method-name (car ',name-and-args))
+ (method-args (cdr ',name-and-args))
+ (object (caar method-args))
+ (class (symbol->value (cadar method-args)))
+ (old-method (class method-name))
+ (method (apply lambda* method-args ',body)))
+
+ ;; define the method as a normal-looking function
+ ;; s7test.scm has define-method-with-next-method that implements call-next-method here
+ ;; it also has make-instance
+ (varlet outer-env
+ (cons method-name
+ (apply lambda* method-args
+ `(((,object ',method-name)
+ ,@(map (lambda (arg)
+ (if (pair? arg) (car arg) arg))
+ method-args))))))
+
+ ;; add the method to the class
+ (varlet (outlet (outlet class))
+ (cons method-name method))
+
+ ;; if there are inheritors, add it to them as well, but not if they have a shadowing version
+ (for-each
+ (lambda (inheritor)
+ (if (not (eq? (inheritor method-name) #<undefined>)) ; defined? goes to the global env
+ (if (eq? (inheritor method-name) old-method)
+ (set! (inheritor method-name) method))
+ (varlet (outlet (outlet inheritor))
+ (cons method-name method))))
+ (class 'inheritors))
+
+ method-name))
+
+
+(define (all-methods obj method)
+ ;; for arbitrary method combinations: this returns a list of all the methods of a given name
+ ;; in obj's class and the classes it inherits from (see example below)
+ (let* ((base-method (obj method))
+ (methods (if (procedure? base-method) (list base-method) ())))
+ (for-each
+ (lambda (ancestor)
+ (let ((next-method (ancestor method)))
+ (if (and (procedure? next-method)
+ (not (memq next-method methods)))
+ (set! methods (cons next-method methods)))))
+ (obj 'inherited))
+ (reverse methods)))
+
+(define (make-instance class . args)
+ (let* ((cls (if (symbol? class) (symbol->value class) class))
+ (make (symbol->value (string->symbol (string-append "make-" (symbol->string (cls 'class-name)))))))
+ (apply make args)))
+
+(define-bacro (define-method-with-next-method name-and-args . body)
+ `(let* ((outer-env (outlet (curlet)))
+ (method-name (car ',name-and-args))
+ (method-args (cdr ',name-and-args))
+ (object (caar method-args))
+ (class (symbol->value (cadar method-args)))
+ (old-method (class method-name))
+ (arg-names (map (lambda (arg)
+ (if (pair? arg) (car arg) arg))
+ method-args))
+ (next-class (and (pair? (class 'inherited))
+ (car (class 'inherited)))) ; or perhaps the last member of this list?
+ (nwrap-body (if next-class
+ `((let ((call-next-method
+ (lambda new-args
+ (apply (,next-class ',method-name)
+ (or new-args ,arg-names)))))
+ ,@',body))
+ ',body))
+ (method (apply lambda* method-args nwrap-body)))
+
+ ;; define the method as a normal-looking function
+ (varlet outer-env
+ (cons method-name
+ (apply lambda* method-args
+ `(((,object ',method-name) , at arg-names)))))
+
+ ;; add the method to the class
+ (varlet (outlet (outlet class))
+ (cons method-name method))
+
+ ;; if there are inheritors, add it to them as well, but not if they have a shadowing version
+ (for-each
+ (lambda (inheritor)
+ (if (not (eq? (inheritor method-name) #<undefined>)) ; defined? goes to the global env
+ (if (eq? (inheritor method-name) old-method)
+ (set! (inheritor method-name) method))
+ (varlet (outlet (outlet inheritor))
+ (cons method-name method))))
+ (class 'inheritors))
+
+ method-name))
+
+(let ()
+ (define-class class-1 ()
+ '((a 1) (b 2))
+ (list (list 'add (lambda (obj)
+ (with-let obj
+ (+ a b))))))
+
+ (define-slot-accessor slot-a a)
+
+ (let ()
+ (test (let? (outlet (curlet))) #t)
+ (test (class-1? class-1) #t)
+ (test (class-1 'a) 1)
+ (test (class-1 'b) 2)
+ (test (class-1 'class-name) 'class-1)
+ (test (class-1 'divide) #<undefined>)
+ (test (class-1 'inheritors) ())
+ (test ((class-1 'add) class-1) 3)
+ (test (pair? (member (object->string class-1) '("#<class-1: (a 1) (b 2)>" "#<class-1: (b 2) (a 1)>"))) #t)
+ (test (format #f "~{~A~^ ~}" class-1) "(a . 1) (b . 2)"))
+
+ (let ((v (make-class-1)))
+ (test (class-1? v) #t)
+ (test (v 'a) 1)
+ (test (v 'b) 2)
+ (test (v 'class-name) 'class-1)
+ (test (v 'inheritors) ())
+ (test ((v 'add) v) 3)
+ (test (pair? (member (object->string v) '("#<class-1: (a 1) (b 2)>" "#<class-1: (b 2) (a 1)>"))) #t)
+ (test (format #f "~{~A~^ ~}" v) "(a . 1) (b . 2)")
+ (set! (v 'a) 32)
+ (test ((v 'add) v) 34)
+ (test (equal? v v) #t)
+ (test (equal? v (make-class-1 :a 32)) #t)
+ (test (slot-a v) 32)
+ (set! (slot-a v) 1)
+ (test (slot-a v) 1)
+ (test (pair? (member (map cdr v) '((1 2) (2 1)))) #t))
+
+ (let ((v (make-class-1 :a 32))
+ (v1 (make-class-1))
+ (v2 (make-class-1 :a 32)))
+ (test (class-1? v) #t)
+ (test (v 'a) 32)
+ (test (v 'b) 2)
+ (test (v 'class-name) 'class-1)
+ (test (v 'inheritors) ())
+ (test ((v 'add) v) 34)
+ (test (pair? (member (object->string v) '("#<class-1: (a 32) (b 2)>" "#<class-1: (b 2) (a 32)>"))) #t)
+ (test (eq? v v) #t)
+ (test (eq? v v1) #f)
+ (test (eqv? v v) #t)
+ (test (eqv? v v1) #f)
+ (test (eqv? v v2) #f)
+ (test (equal? v v) #t)
+ (test (equal? v v1) #f)
+ (test (equal? v v2) #t))
+
+ (let ((v (make-class-1 32 3)))
+ (test (class-1? v) #t)
+ (test (v 'a) 32)
+ (test (v 'b) 3)
+ (test (v 'class-name) 'class-1)
+ (test (v 'inheritors) ())
+ (test ((v 'add) v) 35)
+ (test (pair? (member (object->string v) '("#<class-1: (a 32) (b 3)>" "#<class-1: (b 3) (a 32)>"))) #t))
+
+ (define-generic add)
+
+ (let ()
+ (test (add class-1) 3)
+ (test (add (make-class-1 :b 0)) 1)
+ (test (add 2) 'error))
+
+ (define-class class-2 (list class-1)
+ '((c 3))
+ (list (list 'multiply (lambda (obj)
+ (with-let obj
+ (* a b c))))))
+
+ (let ((v (make-class-2 :a 32)))
+ (test (class-1? v) #f)
+ (test (class-2? v) #t)
+ (test (equal? v (make-class-1 :a 32)) #f)
+ (test (equal? v (make-class-2 :a 32)) #t)
+ (test (v 'a) 32)
+ (test (v 'b) 2)
+ (test (v 'c) 3)
+ (test (v 'class-name) 'class-2)
+ (test (v 'inheritors) ())
+ (test (class-1 'inheritors) (list class-2))
+ (test ((v 'add) v) 34)
+ (test (pair? (member (object->string v) '("#<class-2: (c 3) (a 32) (b 2)>" "#<class-2: (b 2) (a 32) (c 3)>"))) #t)
+ (test ((v 'multiply) v) 192)
+ (test (add v) 34))
+
+ (let ((v1 (make-class-1))
+ (v2 (make-class-1)))
+ (test (add v1) 3)
+ (test (add v2) 3)
+ (varlet v2 (cons 'add (lambda (obj) (with-let obj (+ 1 a (* 2 b))))))
+ (test (add v1) 3)
+ (test (add v2) 6))
+
+ (define-class class-3 (list class-2)
+ ()
+ (list (list 'multiply (lambda (obj num)
+ (* num
+ ((class-2 'multiply) obj)
+ (add obj))))))
+
+ (let ((v (make-class-3)))
+ (test (class-1? v) #f)
+ (test (class-2? v) #f)
+ (test (class-3? v) #t)
+ (test (v 'a) 1)
+ (test (v 'b) 2)
+ (test (v 'c) 3)
+ (test (v 'class-name) 'class-3)
+ (test (v 'inheritors) ())
+ (test (class-1 'inheritors) (list class-3 class-2))
+ (test (class-2 'inheritors) (list class-3))
+ (test ((v 'add) v) 3)
+ (test (pair? (member (object->string v) '("#<class-3: (c 3) (a 1) (b 2)>" "#<class-3: (b 2) (a 1) (c 3)>"))) #t)
+ (test ((v 'multiply) v) 'error)
+ (test ((v 'multiply) v 4) (* 4 6 3))
+ (test (add v) 3))
+
+ (define-method (subtract (obj class-1))
+ (with-let obj
+ (- a b)))
+
+ (let ((v1 (make-class-1))
+ (v2 (make-class-2))
+ (v3 (make-class-3)))
+ (test (subtract v1) -1)
+ (test (subtract v2) -1)
+ (test (subtract v3) -1))
+
+ ;; class-2|3 have their own multiply so...
+ (define-method (multiply (obj class-1)) (with-let obj (* a b 100)))
+
+ (let ((v1 (make-class-1))
+ (v2 (make-class-2))
+ (v3 (make-class-3)))
+ (test (multiply v1) 200)
+ (test (multiply v2) 6)
+ (test (multiply v3) 'error))
+
+ (define-method-with-next-method (add-1 (obj class-1)) (+ (obj 'a) 1))
+ (define-method-with-next-method (add-1 (obj class-2)) (+ 1 (call-next-method)))
+ (define-method-with-next-method (add-1 (obj class-3)) (+ 1 (call-next-method obj)))
+
+ (test (add-1 (make-class-1)) 2)
+ (test (add-1 (make-class-2)) 3)
+ (test (add-1 (make-class-3)) 4)
+ (test ((make-instance class-1) 'class-name) 'class-1)
+ (test ((make-instance 'class-1) 'class-name) 'class-1)
+ (test ((make-instance class-2) 'class-name) 'class-2)
+ (test ((make-instance class-1 :a 123) 'class-name) 'class-1)
+
+ (test ((make-instance class-1) 'b) 2)
+ (test ((make-instance 'class-1) 'b) 2)
+ (test ((make-instance class-1 :b 12 :a 123) 'b) 12)
+
+ (test ((make-instance 'class-3 :a "hi" :c 21) 'c) 21)
+
+ )
+
+
+;;; --------------------------------------------------------------------------------
+;;; owlet
+(test (vector? (owlet)) #f)
+(test (let? (owlet)) #t)
+(test (let () (set! (owlet) 2)) 'error)
+(test (owlet 123) 'error)
+
+(let ((val (catch #t (lambda () (/ 1 0.0)) (lambda args args))))
+ (with-let (owlet)
+ (test error-type 'division-by-zero)
+ (test (equal? error-code '(/ 1 0.0)) #t)
+ (test (list? error-data) #t)
+ (test (string? error-file) #t)
+ (test (integer? error-line) #t)
+ (test ((owlet) 'error-file) error-file)
+ ))
+
+
+;;; stacktrace
+
+(test (string? (stacktrace)) #t)
+;(test (stacktrace 123) 'error)
+
+(let ((str ""))
+
+ (define testtrace (lambda () (set! str (stacktrace 3))))
+ (define (hi1 a) (testtrace))
+ (define (hi2 b) (string-append (hi1 b) ""))
+ (define (hi3 c) (string-append (hi2 c) ""))
+ (define (hi4 d) (string-append (hi3 d) ""))
+ (define (hi5 e) (string-append (hi4 e) ""))
+ (define (hi6 f) (string-append (hi5 f) ""))
+ (hi6 12)
+ (test str "hi2: (string-append (hi1 b) \"\") ; b: 12
+hi3: (string-append (hi2 c) \"\") ; c: 12
+hi4: (string-append (hi3 d) \"\") ; d: 12
+"))
+
+(let ((str ""))
+ (define testtrace (lambda () (set! str (stacktrace 5))))
+ (define (hi1 a) (testtrace))
+ (define (hi2 b) (string-append (hi1 b) ""))
+ (define (hi3 c) (string-append (hi2 c) ""))
+ (define (hi4 d) (string-append (hi3 d) ""))
+ (define (hi5 e) (string-append (hi4 e) ""))
+ (define (hi6 f) (string-append (hi5 f) ""))
+ (hi6 12)
+ (test str "hi2: (string-append (hi1 b) \"\") ; b: 12
+hi3: (string-append (hi2 c) \"\") ; c: 12
+hi4: (string-append (hi3 d) \"\") ; d: 12
+hi5: (string-append (hi4 e) \"\") ; e: 12
+hi6: (string-append (hi5 f) \"\") ; f: 12
+"))
+
+(let ((str ""))
+ (define testtrace (lambda () (set! str (stacktrace 5 20 40 20))))
+ (define (hi1 a) (testtrace))
+ (define (hi2 b) (string-append (hi1 b) ""))
+ (define (hi3 c) (string-append (hi2 c) ""))
+ (define (hi4 d) (string-append (hi3 d) ""))
+ (define (hi5 e) (string-append (hi4 e) ""))
+ (define (hi6 f) (string-append (hi5 f) ""))
+ (hi6 12)
+ (test str "hi2: (string-app... ; b: 12
+hi3: (string-app... ; c: 12
+hi4: (string-app... ; d: 12
+hi5: (string-app... ; e: 12
+hi6: (string-app... ; f: 12
+"))
+
+(let ((str ""))
+ (define testtrace (lambda () (set! str (stacktrace 5 20 40 8))))
+ (define (hi1 a) (testtrace))
+ (define (hi2 b) (string-append (hi1 b) ""))
+ (define (hi3 c) (string-append (hi2 c) ""))
+ (define (hi4 d) (string-append (hi3 d) ""))
+ (define (hi5 e) (string-append (hi4 e) ""))
+ (define (hi6 f) (string-append (hi5 f) ""))
+ (hi6 12)
+ (test str "hi2: (string-app...
+ ; b: 12
+hi3: (string-app...
+ ; c: 12
+hi4: (string-app...
+ ; d: 12
+hi5: (string-app...
+ ; e: 12
+hi6: (string-app...
+ ; f: 12
+"))
+
+(let ((str ""))
+ (define testtrace (lambda () (set! str (stacktrace 5 20 40 8 #t))))
+ (define (hi1 a) (testtrace))
+ (define (hi2 b) (string-append (hi1 b) ""))
+ (define (hi3 c) (string-append (hi2 c) ""))
+ (define (hi4 d) (string-append (hi3 d) ""))
+ (define (hi5 e) (string-append (hi4 e) ""))
+ (define (hi6 f) (string-append (hi5 f) ""))
+ (hi6 12)
+ (test str "; hi2: (string-app...
+; b: 12
+; hi3: (string-app...
+; c: 12
+; hi4: (string-app...
+; d: 12
+; hi5: (string-app...
+; e: 12
+; hi6: (string-app...
+; f: 12
+"))
+
+(let ((str ""))
+ (define testtrace (lambda () (set! str (stacktrace 5 40 80 8 #t))))
+ (define (hi1 a) (testtrace))
+ (define (hi2 b) (string-append (hi1 b) ""))
+ (define (hi3 c) (string-append (hi2 c) ""))
+ (define (hi4 d) (string-append (hi3 d) ""))
+ (define (hi5 e) (string-append (hi4 e) ""))
+ (define (hi6 f) (string-append (hi5 f) ""))
+ (hi6 12)
+ (test str "; hi2: (string-append (hi1 b) \"\")
+; b: 12
+; hi3: (string-append (hi2 c) \"\")
+; c: 12
+; hi4: (string-append (hi3 d) \"\")
+; d: 12
+; hi5: (string-append (hi4 e) \"\")
+; e: 12
+; hi6: (string-append (hi5 f) \"\")
+; f: 12
+"))
+
+(test (set! (*s7* 'max-stack-size) -1) 'error)
+(test (set! (*s7* 'max-stack-size) 0) 'error)
+(test (set! (*s7* 'max-stack-size) 32) 'error) ; this depends on INITIAL_STACK_SIZE (512)
+(test (set! (*s7* 'max-stack-size) #\a) 'error)
+(test (set! (*s7* 'max-stack-size) 3/4) 'error)
+(test (set! (*s7* 'max-stack-size) 123123.123) 'error)
+(test (integer? (*s7* 'max-stack-size)) #t)
+
+
+;;; --------------------------------------------------------------------------------
+;;; dilambda
+
+(when with-block
+ (test (dilambda-test) #f)
+ (test (set! (dilambda-test) 32) 32)
+ (let () (define (hi) (set! (dilambda-test) 32)) (hi) (test (hi) 32)))
-;;; make-procedure-with-setter
(test (let ((local 123))
- (define pws-test (make-procedure-with-setter
+ (define pws-test (dilambda
(lambda () local)
(lambda (val) (set! local val))))
(pws-test))
123)
(test (let ((local 123))
- (define pws-test (make-procedure-with-setter
+ (define pws-test (dilambda
(lambda () local)
(lambda (val) (set! local val))))
(pws-test 32))
'error)
(test (let ((local 123))
- (define pws-test (make-procedure-with-setter
+ (define pws-test (dilambda
(lambda () local)
(lambda (val) (set! local val))))
(set! (pws-test 32) 123))
'error)
+(let ()
+ (define-constant -dl1- (let ((x 1)) (dilambda (lambda () x) (lambda (y) (set! x y)))))
+ (test (-dl1-) 1)
+ (set! (-dl1-) 3)
+ (test (-dl1-) 3)
+ (define (f1) (set! (-dl1-) 32) (-dl1-))
+ (test (f1) 32))
+
(test (call-with-exit
(lambda (return)
(let ((local 123))
- (define pws-test (make-procedure-with-setter
+ (define pws-test (dilambda
(lambda () (return "oops"))
(lambda (val) (set! local val))))
(pws-test))))
@@ -20669,14 +35987,14 @@ abs 1 2
(test (call-with-exit
(lambda (return)
(let ((local 123))
- (define pws-test (make-procedure-with-setter
+ (define pws-test (dilambda
(lambda () 123)
(lambda (val) (return "oops"))))
(set! (pws-test) 1))))
"oops")
(test (let ((local 123))
- (define pws-test (make-procedure-with-setter
+ (define pws-test (dilambda
(lambda () local)
(lambda (val) (set! local val))))
(set! (pws-test) 321)
@@ -20684,7 +36002,7 @@ abs 1 2
321)
(test (let ((v (vector 1 2 3)))
- (define vset (make-procedure-with-setter
+ (define vset (dilambda
(lambda (loc)
(vector-ref v loc))
(lambda (loc val)
@@ -20698,10 +36016,10 @@ abs 1 2
(list 2 32 3))
(let ((local 123))
- (define pws-test (make-procedure-with-setter
+ (define pws-test (dilambda
(lambda () local)
(lambda (val) (set! local val))))
- (test (procedure-with-setter? pws-test) #t)
+ (test (dilambda? pws-test) #t)
(test (pws-test) 123)
(set! (pws-test) 32)
(test (pws-test) 32)
@@ -20709,7 +36027,7 @@ abs 1 2
(test (pws-test) 0))
(let ((local 123))
- (define pws-test (make-procedure-with-setter
+ (define pws-test (dilambda
(lambda (val) (+ local val))
(lambda (val new-val) (set! local new-val) (+ local val))))
(test (pws-test 1) 124)
@@ -20718,81 +36036,154 @@ abs 1 2
(set! (pws-test 3) 0)
(test (pws-test 3) 3))
+(let ((ho (dilambda (lambda* ((a 1)) a) (lambda* (a (b 2)) (set! a b) a))))
+ (test (ho) 1)
+ (test (ho 3) 3)
+ (test (set! (ho) 32) 2)
+ (test (set! (ho 3) 32) 32))
+
+
+(test (dilambda) 'error)
+(test (dilambda abs) 'error)
+(test (dilambda 1 2) 'error)
+(test (dilambda (lambda () 1) (lambda (a) a) (lambda () 2)) 'error)
+(test (dilambda (lambda () 1) 2) 'error)
+(test (call-with-exit (lambda (return) (let ((g (dilambda return (lambda (s v) s)))) (g 0)))) 'error)
+(test (call-with-exit (lambda (return) (let ((g (dilambda (lambda (s) s) return))) (g 0)))) 0) ; ??
+(test (+ (call-with-exit (lambda (return) (let ((g (dilambda (lambda (s) s) return))) (set! (g 1) 2))))) 3) ; ??
-(test (make-procedure-with-setter) 'error)
-(test (make-procedure-with-setter abs) 'error)
-(test (make-procedure-with-setter 1 2) 'error)
-(test (make-procedure-with-setter (lambda () 1) (lambda (a) a) (lambda () 2)) 'error)
-(test (make-procedure-with-setter (lambda () 1) 2) 'error)
+(for-each
+ (lambda (arg)
+ (test (dilambda arg (lambda () #f)) 'error)
+ (test (dilambda (lambda () #f) arg) 'error))
+ (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
(for-each
(lambda (arg)
- (test (make-procedure-with-setter arg (lambda () #f)) 'error)
- (test (make-procedure-with-setter (lambda () #f) arg) 'error))
- (list "hi" -1 #\a 1 'a-symbol '#(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+ (test (dilambda? arg) #f))
+ (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi "hi" #(()) abs (lambda () #f) (list (lambda () #f) (lambda (val) val)) (list 1 2 3) '(1 . 2) #<eof> #<unspecified> #<undefined>))
-(let ((pws (make-procedure-with-setter vector-ref vector-set!)))
+(let ((pws (dilambda vector-ref vector-set!)))
(let ((v (vector 1 2 3)))
- (test (procedure-with-setter? pws) #t)
- (test (procedure-with-setter? pws pws) 'error)
+ (test (dilambda? pws) #t)
+ (test (dilambda? pws pws) 'error)
(test (pws v 1) 2)
(set! (pws v 1) 32)
- (test (pws v 1) 32)
- (test (procedure-arity pws) '(2 0 #t 3 0 #t))))
+ (test (pws v 1) 32)))
-(for-each
- (lambda (arg)
- (test (procedure-with-setter? arg) #f))
- (list -1 #\a 1 '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi "hi" '#(()) abs (lambda () #f) (list (lambda () #f) (lambda (val) val)) (list 1 2 3) '(1 . 2) #<eof> #<unspecified> #<undefined>))
+(test (dilambda?) 'error)
+
+(let ()
+ (define macfun (dilambda
+ (define-macro (_m_ a) `(+ ,a 1))
+ (define-macro (_m_ a b) `(- ,a 1))))
+
+ (test (macfun (+ 2 3)) 6)
+ (test (set! (macfun (+ 2 3)) 3) 4))
+
+(let () ; reality check...
+ (set! (procedure-setter logbit?)
+ (define-macro (_m_ var index on)
+ `(if ,on
+ (set! ,var (logior ,var (ash 1 ,index)))
+ (set! ,var (logand ,var (lognot (ash 1 ,index)))))))
+
+ (define (mingle a b)
+ (let ((r 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 31) r)
+ (set! (logbit? r (* 2 i)) (logbit? a i))
+ (set! (logbit? r (+ (* 2 i) 1)) (logbit? b i)))))
+
+ (test (mingle 6 3) 30)
+ (set! (procedure-setter logbit?) #f))
+
+(let ()
+ (dilambda logbit?
+ (define-macro (_m_ var index on)
+ `(if ,on
+ (set! ,var (logior ,var (ash 1 ,index)))
+ (set! ,var (logand ,var (lognot (ash 1 ,index)))))))
+ (define (mingle a b)
+ (let ((r 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 31) r)
+ (set! (logbit? r (* 2 i)) (logbit? a i))
+ (set! (logbit? r (+ (* 2 i) 1)) (logbit? b i)))))
-(test (procedure-with-setter?) 'error)
-(test (call-with-exit (lambda (return) (procedure-with-setter? return))) #f)
-(test (procedure-with-setter? quasiquote) #f)
-(test (procedure-with-setter? -s7-symbol-table-locked?) #t)
-(test (procedure-with-setter? '-s7-symbol-table-locked?) #f) ; this parallels (procedure? 'abs) -> #f but seems inconsistent with other *? funcs
+ (test (mingle 6 3) 30)
+ (set! (procedure-setter logbit?) #f))
-(define (procedure-with-setter-setter-arity proc) (cdddr (procedure-arity proc)))
-(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda (a) a)))) (procedure-with-setter-setter-arity pws)) '(1 0 #f))
-(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda (a b c) a)))) (procedure-with-setter-setter-arity pws)) '(3 0 #f))
-(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda (a . b) a)))) (procedure-with-setter-setter-arity pws)) '(1 0 #t))
-(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda* (a (b 1)) a)))) (procedure-with-setter-setter-arity pws)) '(0 2 #f))
-(test (let ((pws (make-procedure-with-setter (lambda () 1) (lambda* (a :rest b) a)))) (procedure-with-setter-setter-arity pws)) '(0 1 #t))
-(test (procedure-with-setter-setter-arity symbol-access) '(2 0 #f))
-(test (let ((pws (make-procedure-with-setter (lambda args (apply + args)) (lambda args (apply * args))))) (pws 2 3 4)) 9)
-(test (let ((pws (make-procedure-with-setter (lambda args (apply + args)) (lambda args (apply * args))))) (set! (pws 2 3 4) 5)) 120)
+
+#|
+(let ()
+ (define pws-args (dilambda
+ (lambda args args)
+ (lambda args (set-car! args 0) args)))
+ (let ((lst (list 1 2 3)))
+ (let ((l1 (apply pws-args lst)))
+ (test l1 '(1 2 3))
+ (set-car! l1 32)
+ (test lst '(1 2 3))
+ (set! (pws-args l1) 3)
+ (test l1 '(32 2 3))
+ (test lst '(1 2 3))
+ (let ()
+ (define (pws1)
+ (pws-args lst))
+ (let ((l2 (pws1)))
+ (set! l2 (pws1))
+ (test lst '(1 2 3)))))))
+|#
+
+(test (call-with-exit (lambda (return) (dilambda? return))) #f)
+(test (dilambda? quasiquote) #f)
+(test (dilambda? -s7-symbol-table-locked?) #t)
+
+;; (test (dilambda? '-s7-symbol-table-locked?) #f) ; this parallels (procedure? 'abs) -> #f but seems inconsistent with other *? funcs
+
+(test (let ((pws (dilambda (lambda args (apply + args)) (lambda args (apply * args))))) (pws 2 3 4)) 9)
+(test (let ((pws (dilambda (lambda args (apply + args)) (lambda args (apply * args))))) (set! (pws 2 3 4) 5)) 120)
(let ((x 0))
- (let ((pws (make-procedure-with-setter
+ (let ((pws (dilambda
(let ((y 1)) ((lambda () (set! x (+ x y)) (lambda () x))))
(let ((y 2)) ((lambda () (set! x (* x y)) (lambda (z) (set! x (+ x z)))))))))
(test x 2)
(set! (pws) 3)
(test x 5)))
-(let ((p1 (make-procedure-with-setter (lambda () 1) (lambda (a) a))))
- (let ((p2 (make-procedure-with-setter p1 p1)))
+(let ((p1 (dilambda (lambda () 1) (lambda (a) a))))
+ (let ((p2 (dilambda p1 p1)))
(test (p2) 1)))
-(let () (define-macro (hi a) `(+ ,a 1)) (test (make-procedure-with-setter hi hi) 'error))
-(test (make-procedure-with-setter quasiquote call/cc) 'error)
-(test ((make-procedure-with-setter call-with-exit call/cc) (lambda (a) (a 1))) 1)
-(test (length (make-procedure-with-setter < >)) 'error)
+(test ((dilambda call-with-exit call/cc) (lambda (a) (a 1))) 1)
+(test (length (dilambda < >)) #f)
-(let ((p1 (make-procedure-with-setter (lambda (a) (+ a 1)) (lambda (a b) (+ a b)))))
- (let ((p2 (make-procedure-with-setter p1 p1)))
+(let ((p1 (dilambda (lambda (a) (+ a 1)) (lambda (a b) (+ a b)))))
+ (let ((p2 (dilambda p1 p1)))
(test (p2 1) 2)))
+(let ()
+ (define sf1 (let ((val 0))
+ (dilambda
+ (let ((signature '(integer?))
+ (documentation "getter help"))
+ (lambda ()
+ val))
+ (let ((signature '(integer? integer?))
+ (documentation "setter help"))
+ (lambda (new-val)
+ (if (integer? new-val)
+ (set! val new-val)
+ (error 'wrong-type-arg ";sf1 new value should be an integer: ~A" new-val)))))))
+ (test (procedure-documentation sf1) "getter help")
+ (test (procedure-documentation (procedure-setter sf1)) "setter help")
+ (test (procedure-signature sf1) '(integer?))
+ (test (procedure-signature (procedure-setter sf1)) '(integer? integer?)))
-;; generic length/reverse/copy/fill!
-;;; copy
-;;; fill!
-(test (length (list 1 2)) 2)
-(test (length "hiho") 4)
-(test (length (vector 1 2)) 2)
-(test (>= (length (make-hash-table 7)) 7) #t)
-(test (length '()) 0)
-(test (length (#(#() #()) 1)) 0)
-(test (length abs) 'error)
+;;; --------------------------------------------------------------------------------
+;;; copy
(test (copy 3) 3)
(test (copy 3/4) 3/4)
@@ -20814,11 +36205,13 @@ abs 1 2
(test (copy +) +)
(test (copy (#(#() #()) 1)) #())
(test (copy #f) #f)
-(test (copy '()) '())
+(test (copy ()) ())
(test (copy #()) #())
(test (copy #2d((1 2) (3 4))) #2d((1 2) (3 4)))
-(test (let ((f (lambda () 1))) ((copy f))) 1) ; here copy actually returns f:
-(test (let ((f (lambda () 1))) (eq? (copy f) f)) #t)
+(test (let ((f (lambda () 1))) ((copy f))) 1)
+(test (let ((f (lambda () 1))) (eq? (copy f) f)) #f)
+(test (let ((f (lambda* ((a 2)) (+ a 1)))) ((copy f))) 3)
+(test (let ((f (lambda* ((a 2)) (+ a 1)))) (eq? (copy f) f)) #f)
(test (copy 1.0) 1.0)
(test (copy 1.0+i) 1.0+i)
(test (copy "") "")
@@ -20828,27 +36221,499 @@ abs 1 2
(test ((copy abs) -123) 123)
(test (copy ''1) ''1)
(test (copy '''1) '''1)
-(test (hook? (copy (make-hook 1))) #t)
(test (copy not) not)
(test (copy "a\x00b") "a\x00b")
(test (infinite? (copy (log 0.0))) #t)
(test (nan? (copy 1/0)) #t)
+(test (copy if) if)
+(test (copy quote) quote)
+(test (let ((a 1) (b 2)) (equal? (copy (curlet)) (curlet))) #t)
+(test (copy (rootlet)) (rootlet))
+(test (copy (funclet abs)) (rootlet))
+(test (copy (funclet quasiquote)) (rootlet))
+(test (eval '(+ a 1) (copy (sublet (curlet) '(a . 2)))) 3)
+(test (copy (list 1 2 (list 3 4))) '(1 2 (3 4)))
+(test (copy (cons 1 2)) '(1 . 2))
+(test (copy '(1 2 (3 4) . 5)) '(1 2 (3 4) . 5))
+(test (copy ()) ())
-(test (reverse "hi") "ih")
-(test (reverse "") "")
-(test (reverse "123") "321")
-(test (reverse "1234") "4321")
-(test (reverse "a\x00b") "b\x00a")
-(test (reverse #()) #())
-(test (reverse #(1 2 3)) #(3 2 1))
-(test (reverse #(1 2 3 4)) #(4 3 2 1))
-(test (reverse #2D((1 2) (3 4))) #2D((4 3) (2 1)))
-(test (reverse (string #\a #\null #\b)) "b\x00a")
-(test (reverse abs) 'error)
+(test (copy) 'error)
+(test (copy () () ()) 'error)
+(test (copy (make-hash-table) pi) 'error)
+(test (copy 1 3) 'error)
+(test (copy #() abs) 'error)
+
+;;; 2 arg version of copy
+(test (copy (list 1 2) (vector 0 0)) #(1 2))
+(test (copy (list 1 2) (vector 0)) #(1))
+(test (copy (list 1 2) (vector)) #())
+(test (copy (list) (vector)) #())
+(test (copy (list 1 2) (vector 0 0 3 4)) #(1 2 3 4))
+; should (copy 1 2) be an error?
+(test (copy #2d((1 2) (3 4)) (vector 0 0 0 0 0)) #(1 2 3 4 0))
+(test (copy (vector 0 0 0 0 0) #2d((1 2) (3 4))) #2d((0 0) (0 0)))
+(test (copy (vector 1 2 3 4 5) #2d((0 0) (0 0))) #2d((1 2) (3 4)))
+(test (copy "12345" (make-list 5)) '(#\1 #\2 #\3 #\4 #\5))
+(test (copy (list #\0 #\1 #\2) (make-string 3)) "012")
+(test (copy '(0 1 2 3) (list 4 3 2 1)) '(0 1 2 3))
+(test (copy #(0 1 2 3) (vector 4 3 2 1)) #(0 1 2 3))
+(test (copy "12345" (make-string 5)) "12345")
+(test (copy '(4 3 2 1) '(1 . 2)) '(4 . 2))
+(test (copy (string (integer->char 255)) (vector 0)) #(#\xff))
+(test (copy (vector (integer->char 255)) (string #\a)) (string (integer->char 255)))
+(test (copy #() "") "")
+(test (copy "" #()) #())
+(test (copy #() (vector 1 2 3)) #(1 2 3))
+(test (copy (make-vector 3 0.0 #t)) (make-vector 3 0.0 #t))
+(test (copy (make-vector 3 0 #t)) (make-vector 3 0 #t))
+(test (copy (make-vector '(2 3) 0 #t)) (make-vector '(2 3) 0 #t))
+(test (eq? (copy 1) 1) #f)
+(test (eq? (copy 1.0) 1.0) #f)
+(test (eq? (copy 2/3) 2/3) #f)
+(test (eq? (copy "") "") #f)
+(test (copy #u8(101 102) (vector 1 2)) #(101 102))
+
+(when with-block
+ (let ((b (copy (block 1 2 3 4))))
+ (test b (block 1 2 3 4))
+ (fill! b 0 1 3)
+ (test b (block 1 0 0 4))
+ (let ((b1 (block 1 1 1 1 1)))
+ (copy b b1)
+ (test b1 (block 1 0 0 4 1)))
+ (let ((b2 (block 1 2 3)))
+ (let ((b3 (copy b b2)))
+ (test (eq? b2 b3) #t)
+ (test b3 (block 1 0 0))))
+ (let ((b4 (block 5 6 7 8)))
+ (copy b4 b 1)
+ (test b (block 6 7 8 4)))))
+
+(let ((lst (list 1 2 3)))
+ (set! (cdr (cddr lst)) lst)
+ (test (copy lst lst) lst)
+ (test (copy lst (make-list 15 5)) '(1 2 3 5 5 5 5 5 5 5 5 5 5 5 5))) ; was going around twice
+
+(let ((v (vector 1 2 3)))
+ (test (copy v v) v)
+ (test (copy v v 1 3) #(2 3 3)))
+
+(test (copy #(1 2 3 4 5 6) (make-list 3) 0 3) '(1 2 3))
+(test (copy #(1 2 3 4 5 6) (make-list 3) 0) '(1 2 3))
+(test (copy #(1 2 3 4 5 6) (make-list 3) 1) '(2 3 4))
+(test (copy #(1 2 3 4 5 6) (make-list 3 0) 5) '(6 0 0))
+(test (copy #(1 2 3 4 5 6) (make-list 3)) '(1 2 3))
+(test (copy #(1 2 3 4 5 6) (make-list 3) 1 4) '(2 3 4))
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 2) '(2 #f #f))
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 1) '(#f #f #f))
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) -1 1) 'error)
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 7) 'error)
+(test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 0) 'error)
+(test (copy #(1 2 3 4 5 6) () 1 2) ())
+(test (copy #(1 2 3 4 5 6) ()) ())
+(test (copy #(1 2 3 4 5 6) (make-list 6 #f) 2) '(3 4 5 6 #f #f))
+(test (copy #(1 2 3 4 5 6) '(0 0 0 . 3)) '(1 2 3 . 3))
+
+(let ((lst (list 7 8 9)))
+ (set! (cdr (cddr lst)) lst)
+ (copy #(1 2 3 4 5 6) lst 0 1)
+ (test (car lst) 1)
+ (copy #(1 2 3 4 5 6) lst 1 5)
+ (test (car lst) 2))
+
+(test (copy #(#\a #\b #\c) (make-string 2) 1) "bc")
+(test (copy '(#\a #\b #\c) (make-string 2) 1) "bc")
+(test (copy "abc" (make-string 2) 1) "bc")
+(test (copy "abc" (make-vector 2) 1) #(#\b #\c))
+(test (copy "abc" (make-list 2) 1) '(#\b #\c))
+(test (copy '(1 2 3) (make-list 2) 1) '(2 3))
+(test (copy '(1 2 3) (make-vector 2) 1) #(2 3))
+(test (copy #(1 2 3) (make-vector 2) 1) #(2 3))
+(test (copy #(1 2 3) (make-list 2) 1) '(2 3))
+(test (copy (make-vector 3 0 #t)) (make-vector 3 0 #t))
+(let ((orig "0123456789"))
+ (let ((iv (copy (->byte-vector orig) (make-int-vector 10))))
+ (test (copy iv (make-string 10)) orig)))
+(test (copy "0123456789" (make-float-vector 10)) (float-vector 48 49 50 51 52 53 54 55 56 57))
+
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f)) (inlet 'd 4 'c 3 'b 2 'a 1))
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 0)) (inlet 'd 4 'c 3 'b 2 'a 1))
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 1)) (inlet 'd 4 'b 2 'a 1))
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 1 2)) (inlet 'd 4 'b 2))
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy f e)) (inlet 'a 1 'b 2 'c 3 'd 4))
+;; printout is confusing (is this a reversal in this slot list, or a let-id side-effect?)
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'a 100 'b 200 'c 300 'd 400))) ((copy e f) 'a)) 1)
+(test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'a 100 'b 200 'c 300 'd 400))) (copy e f)) (inlet 'a 100 'b 200 'c 300 'd 400 'c 3 'b 2 'a 1))
+
+(let ((e1 (inlet 'a 1 'b 2))
+ (e2 (inlet 'a 3 'c 3))
+ (v1 (vector 1 2))
+ (v2 (vector 3 4))
+ (i1 (int-vector 5 6))
+ (i2 (int-vector 7 8))
+ (h1 (hash-table* 'd 4 'e 5))
+ (h2 (hash-table* 'f 6 'e 7))
+ (f1 (float-vector 9 10))
+ (f2 (float-vector 11 12))
+ (p1 (list 13 14))
+ (p2 (list 15 16))
+ (b1 (if with-block (block 17 18) (vector 17 18)))
+ (b2 (if with-block (block 19 20) (vector 19 20)))
+ (s1 (make-string 2 #\a))
+ (s2 (make-string 2 #\b)))
+ (test (copy e1 e2) (inlet 'a 3 'c 3 'b 2 'a 1))
+ (test (copy e1 v2) #((b . 2) (a . 1)))
+ (test (copy e1 i2) 'error)
+ (test (copy e1 f2) 'error)
+ (test (copy e1 h2) (hash-table '(a . 1) '(b . 2) '(e . 7) '(f . 6)))
+ (test (copy e1 p2) '((b . 2) (a . 1)))
+ (test (copy e1 b2) 'error)
+ (test (copy e1 s2) 'error)
+ (test (copy v1 e2) 'error)
+ (test (copy v1 v2) #(1 2))
+ (test (copy v1 i2) (int-vector 1 2))
+ (test (copy v1 f2) (float-vector 1.0 2.0))
+ (test (copy v1 h2) 'error)
+ (test (copy v1 p2) '(1 2))
+ (test (copy v1 b2) (block 1.000 2.000))
+ (test (copy v1 s2) 'error)
+ (test (copy i1 e2) 'error)
+ (test (copy i1 v2) #(5 6))
+ (test (copy i1 i2) (int-vector 5 6))
+ (test (copy i1 f2) (float-vector 5.0 6.0))
+ (test (copy i1 h2) 'error)
+ (test (copy i1 p2) '(5 6))
+ (test (copy i1 b2) (block 5.000 6.000))
+ (test (copy i1 s2) "\x05\x06")
+ (test (copy f1 e2) 'error)
+ (test (copy f1 v2) #(9.0 10.0))
+ (test (copy f1 i2) (int-vector 9 10))
+ (test (copy f1 f2) (float-vector 9.0 10.0))
+ (test (copy f1 h2) 'error)
+ (test (copy f1 p2) '(9.0 10.0))
+ (test (copy f1 b2) (block 9.000 10.000))
+ (test (copy f1 s2) 'error)
+ (test (copy h1 e2) (inlet 'a 3 'c 3 'b 2 'a 1 'd 4 'e 5))
+ (test (let ((h (copy h1 v2)))
+ (or (equal? h #((d . 4) (e . 5)))
+ (equal? h #((e . 5) (d . 4)))))
+ #t)
+ (test (copy h1 i2) 'error)
+ (test (copy h1 f2) 'error)
+ (test (copy h1 h2) (hash-table '(a . 1) '(b . 2) '(d . 4) '(e . 5) '(f . 6)))
+ (test (let ((p (copy h1 p2)))
+ (or (equal? p '((d . 4) (e . 5)))
+ (equal? p '((e . 5) (d . 4)))))
+ #t)
+ (test (copy h1 b2) 'error)
+ (test (copy h1 s2) 'error)
+ (test (copy p1 e2) 'error)
+ (test (copy p1 v2) #(13 14))
+ (test (copy p1 i2) (int-vector 13 14))
+ (test (copy p1 f2) (float-vector 13.0 14.0))
+ (test (copy p1 h2) 'error)
+ (test (copy p1 p2) '(13 14))
+ (test (copy p1 b2) (block 13.000 14.000))
+ (test (copy p1 s2) 'error)
+ (test (copy b1 e2) 'error)
+ (test (copy b1 v2) #(17.0 18.0))
+ (test (copy b1 i2) (int-vector 17 18))
+ (test (copy b1 f2) (float-vector 17.0 18.0))
+ (test (copy b1 h2) 'error)
+ (test (copy b1 p2) '(17.0 18.0))
+ (test (copy b1 b2) (block 17.000 18.000))
+ (test (copy b1 s2) 'error)
+ (test (copy s1 e2) 'error)
+ (test (copy s1 v2) #(#\a #\a))
+ (test (copy s1 i2) (int-vector 97 97))
+ (test (copy s1 f2) (float-vector 97.0 97.0))
+ (test (copy s1 h2) 'error)
+ (test (copy s1 p2) '(#\a #\a))
+ (test (copy s1 b2) 'error)
+ (test (copy s1 s2) "aa"))
+
+(let ((e1 (inlet 'a 1 'b 2))
+ (e2 (inlet 'a 3 'c 3))
+ (v1 (vector 1 2))
+ (v2 (vector 3 4))
+ (i1 (int-vector 5 6))
+ (i2 (int-vector 7 8))
+ (h1 (hash-table* 'd 4 'e 5))
+ (h2 (hash-table* 'f 6 'e 7))
+ (f1 (float-vector 9 10))
+ (f2 (float-vector 11 12))
+ (p1 (list 13 14))
+ (p2 (list 15 16))
+ (b1 (if with-block (block 17 18) (vector 17 18)))
+ (b2 (if with-block (block 19 20) (vector 19 20)))
+ (s1 (make-string 2 #\a))
+ (s2 (make-string 2 #\b)))
+ (test (copy e1 e2 1) (inlet 'a 3 'c 3 'a 1))
+ (test (copy e1 v2 1) #((a . 1) 4))
+ (test (copy e1 i2 1) 'error)
+ (test (copy e1 f2 1) 'error)
+ (test (copy e1 h2 1) (hash-table '(a . 1) '(e . 7) '(f . 6)))
+ (test (copy e1 p2 1) '((a . 1) 16))
+ (test (copy e1 b2 1) 'error)
+ (test (copy e1 s2 1) 'error)
+ (test (copy v1 e2 1) 'error)
+ (test (copy v1 v2 1) #(2 4))
+ (test (copy v1 i2 1) (int-vector 2 8))
+ (test (copy v1 f2 1) (float-vector 2.0 12.0))
+ (test (copy v1 h2 1) 'error)
+ (test (copy v1 p2 1) '(2 16))
+ (test (copy v1 b2 1) (block 2.000 20.000))
+ (test (copy v1 s2 1) 'error)
+ (test (copy i1 e2 1) 'error)
+ (test (copy i1 v2 1) #(6 4))
+ (test (copy i1 i2 1) (int-vector 6 8))
+ (test (copy i1 f2 1) (float-vector 6.0 12.0))
+ (test (copy i1 h2 1) 'error)
+ (test (copy i1 p2 1) '(6 16))
+ (test (copy i1 b2 1) (block 6.000 20.000))
+ (test (copy i1 s2 1) "\x06b")
+ (test (copy f1 e2 1) 'error)
+ (test (copy f1 v2 1) #(10.0 4))
+ (test (copy f1 i2 1) (int-vector 10 8))
+ (test (copy f1 f2 1) (float-vector 10.0 12.0))
+ (test (copy f1 h2 1) 'error)
+ (test (copy f1 p2 1) '(10.0 16))
+ (test (copy f1 b2 1) (block 10.000 20.000))
+ (test (copy f1 s2 1) 'error)
+ (test (let ((e (copy h1 e2 1)))
+ (or (equal? e (inlet 'a 3 'c 3 'a 1 'e 5))
+ (equal? e (inlet 'a 3 'c 3 'a 1 'd 4))))
+ #t)
+ (test (let ((v (copy h1 v2 1)))
+ (or (equal? v #((e . 5) 4))
+ (equal? v #((d . 4) 4))))
+ #t)
+ (test (copy h1 i2 1) 'error)
+ (test (copy h1 f2 1) 'error)
+ (test (let ((h (copy h1 h2 1)))
+ (or (equal? h (hash-table '(a . 1) '(e . 5) '(f . 6)))
+ (equal? h (hash-table '(e . 7) '(a . 1) '(f . 6) '(d . 4))))) ; ??
+ #t)
+ (test (let ((p (copy h1 p2 1)))
+ (or (equal? p '((e . 5) 16))
+ (equal? p '((d . 4) 16))))
+ #t)
+ (test (copy h1 b2 1) 'error)
+ (test (copy h1 s2 1) 'error)
+ (test (copy p1 e2 1) 'error)
+ (test (copy p1 v2 1) #(14 4))
+ (test (copy p1 i2 1) (int-vector 14 8))
+ (test (copy p1 f2 1) (float-vector 14.0 12.0))
+ (test (copy p1 h2 1) 'error)
+ (test (copy p1 p2 1) '(14 16))
+ (test (copy p1 b2 1) (block 14.000 20.000))
+ (test (copy p1 s2 1) 'error)
+ (test (copy b1 e2 1) 'error)
+ (test (copy b1 v2 1) #(18.0 4))
+ (test (copy b1 i2 1) (int-vector 18 8))
+ (test (copy b1 f2 1) (float-vector 18.0 12.0))
+ (test (copy b1 h2 1) 'error)
+ (test (copy b1 p2 1) '(18.0 16))
+ (test (copy b1 b2 1) (block 18.000 20.000))
+ (test (copy b1 s2 1) 'error)
+ (test (copy s1 e2 1) 'error)
+ (test (copy s1 v2 1) #(#\a 4))
+ (test (copy s1 i2 1) (int-vector 97 8))
+ (test (copy s1 f2 1) (float-vector 97.0 12.0))
+ (test (copy s1 h2 1) 'error)
+ (test (copy s1 p2 1) '(#\a 16))
+ (test (copy s1 b2 1) 'error)
+ (test (copy s1 s2 1) "ab"))
+
+#|
+(let ((e1 (inlet 'a 1 'b 2))
+ (e2 (inlet 'a 3 'c 3))
+ (v1 (vector 1 2))
+ (v2 (vector 3 4))
+ (i1 (int-vector 5 6))
+ (i2 (int-vector 7 8))
+ (h1 (hash-table* 'd 4 'e 5))
+ (h2 (hash-table* 'f 6 'e 7))
+ (f1 (float-vector 9 10))
+ (f2 (float-vector 11 12))
+ (p1 (list 13 14))
+ (p2 (list 15 16))
+ (b1 (if with-block (block 17 18) (vector 17 18)))
+ (b2 (if with-block (block 19 20) (vector 19 20)))
+ (s1 (make-string 2 #\a))
+ (s2 (make-string 2 #\b)))
+ (for-each
+ (lambda (o1 o1name)
+ (for-each
+ (lambda (o2 o2name)
+ (let ((val (catch #t (lambda () (copy o1 o2)) (lambda any 'error))))
+ (format *stderr* "(test (copy ~S ~S) '~S)~%" o1name o2name val)))
+ (list e2 v2 i2 f2 h2 p2 b2 s2)
+ (list 'e2 'v2 'i2 'f2 'h2 'p2 'b2 's2)))
+ (list e1 v1 i1 f1 h1 p1 b1 s1)
+ (list 'e1 'v1 'i1 'f1 'h1 'p1 'b1 's1)))
+|#
+
+(let ()
+ (define* (copy-1 s d start end)
+ (let ((dend (length d))
+ (send (or end (length s))))
+ (if (not end)
+ (set! end (length s)))
+ (do ((i (or start 0) (+ i 1))
+ (j 0 (+ j 1)))
+ ((or (= i end)
+ (= j dend))
+ d)
+ (set! (d j) (s i)))))
+
+ (for-each
+ (lambda (s1 s2)
+ (for-each
+ (lambda (start)
+ (for-each
+ (lambda (end)
+ (for-each
+ (lambda (d1 d2)
+ (catch #t
+ (lambda ()
+ (if end
+ (copy s1 d1 (or start 0) end)
+ (if start
+ (copy s1 d1 start)
+ (copy s1 d1)))
+ (copy-1 s2 d2 start end)
+ (if (not (equal? d1 d2))
+ (format *stderr* "(copy ~A ~A ~A) -> ~A ~A?~%" s1 start end d1 d2)))
+ (lambda args 'error)))
+ (list (vector 0 0 0)
+ (make-vector 2 1 #t)
+ (make-vector 2 0.0 #t)
+ (string #\a #\b #\c #\d #\e)
+ (string) (list) (vector)
+ (if with-block (block 1.0 1.0) (float-vector 1.0 1.0))
+ (cons 1 2))
+ (list (vector 0 0 0)
+ (make-vector 2 1 #t)
+ (make-vector 2 0.0 #t)
+ (string #\a #\b #\c #\d #\e)
+ (string) (list) (vector)
+ (if with-block (block 1.0 1.0) (float-vector 1.0 1.0))
+ (cons 1 2))))
+ (list #f 0 1 3)))
+ (list #f 0 1 2)))
+ (list (vector 1 2 3 4)
+ (let ((v (make-vector 3 0 #t))) (set! (v 0) 32) (set! (v 1) 16) (set! (v 2) 8) v)
+ (list 1 2 3 4 5)
+ (string #\a #\b)
+ (string) (list) (vector)
+ (cons 1 (cons 2 3))
+ (if with-block (block 1.0 2.0 3.0 4.0) (float-vector 1.0 2.0 3.0 4.0)))
+ (list (vector 1 2 3 4)
+ (let ((v (make-vector 3 0 #t))) (set! (v 0) 32) (set! (v 1) 16) (set! (v 2) 8) v)
+ (list 1 2 3 4 5)
+ (string #\a #\b)
+ (string) (list) (vector)
+ (cons 1 (cons 2 3))
+ (if with-block (block 1.0 2.0 3.0 4.0) (float-vector 1.0 2.0 3.0 4.0)))))
+
+(test (copy -1 6) 'error)
+(for-each
+ (lambda (arg)
+ (test (copy arg #(1 2 3)) 'error)
+ (test (copy #(1 2 3) arg) 'error))
+ (list -1 #\a 3.14 3/4 1.0+1.0i 'hi abs (lambda () #f) #<eof> #<unspecified> #<undefined>))
+
+(let ((ht (hash-table (cons 'a 1))))
+ (test (copy ht (make-vector 3 #f)) #((a . 1) #f #f))
+ (let ((e (inlet)))
+ (copy ht e)
+ (test (eval '(+ a 2) e) 3)
+ (test (copy e #(1 2 3)) #((a . 1) 2 3))
+ (copy (list (cons 'b 2)) ht)
+ (test (ht 'b) 2)))
+
+(let ((ht1 (hash-table* 'a 1))
+ (ht2 (hash-table* 123 2)))
+ (copy ht2 ht1)
+ (test (ht1 123) 2)
+ (copy ht1 ht2)
+ (test (ht2 'a) 1)
+ (test (hash-table-entries ht2) 2)
+ (test (let ((str (object->string ht2)))
+ (or (string=? str "(hash-table '(a . 1) '(123 . 2))")
+ (string=? str "(hash-table '(123 . 2) '(a . 1))")))
+ #t)
+ (test (equal? ht1 ht2) #t))
+
+(let ((ht1 (hash-table* 'a 1))
+ (ht2 (make-hash-table)))
+ (copy ht1 ht2)
+ (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t)
+ (test (equal? ht1 ht2) #t))
+
+(let ((ht1 (hash-table* 'a 1 'b 2 'c 3))
+ (ht2 (make-hash-table)))
+ (copy ht1 ht2)
+ (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t)
+ (test (equal? ht1 ht2) #t))
+
+(let ((ht1 (hash-table* 'a 1 'b 2 'c 3))
+ (ht2 (make-hash-table)))
+ (copy ht1 ht2 0 3)
+ (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t)
+ (test (equal? ht1 ht2) #t))
+
+(let ((ht1 (hash-table* 'a 1 'b 2 'c 3))
+ (ht2 (make-hash-table)))
+ (copy ht1 ht2 1) ; either can be skipped here
+ (test (= (hash-table-entries ht1) (+ (hash-table-entries ht2) 1)) #t)
+ (test (equal? ht1 ht2) #f)
+ (test (ht1 'a) 1)
+ (test (ht1 'c) 3))
+
+(let ((ht1 (hash-table* 'a 1 'b 2 'c 3))
+ (ht2 (make-hash-table)))
+ (copy ht1 ht2 1 2)
+ (test (= (hash-table-entries ht1) (+ (hash-table-entries ht2) 2)) #t)
+ (test (equal? ht1 ht2) #f)
+ (test (ht1 'a) 1)
+ (test (ht1 'c) 3))
+
+(let ((ht1 (hash-table* 'a 1))
+ (ht2 (hash-table* "a" 2)))
+ (copy ht1 ht2)
+ (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #f)
+ (test (equal? ht1 ht2) #f)
+ (test (ht2 "a") 2)
+ (test (ht2 'a) 1)
+ (test (hash-table-entries ht2) 2))
+
+(let ((ht1 (hash-table* 'a 1 "a" 3))
+ (ht2 (hash-table* "a" 2)))
+ (copy ht1 ht2)
+ (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t)
+ (test (equal? ht1 ht2) #t)
+ (test (ht2 "a") 3)
+ (test (ht2 'a) 1)
+ (test (hash-table-entries ht2) 2))
+
+(if with-bignums
+ (begin
+ (test (let ((x (bignum "1"))) (eq? x (copy x))) #f)
+ (test (let ((x (bignum "1/2"))) (eq? x (copy x))) #f)
+ (test (let ((x (bignum "1.0"))) (eq? x (copy x))) #f)
+ (test (let ((x (bignum "1+i"))) (eq? x (copy x))) #f)))
+(test (let ((x 1)) (eq? x (copy x))) #f)
+(test (= 1 (copy 1)) #t)
+(test (= 1.5 (copy 1.5)) #t)
+(test (= 1/2 (copy 1/2)) #t)
+(test (= 1+i (copy 1+i)) #t)
+(test (let ((x "str")) (eq? x (copy x))) #f)
(if (not (provided? 'gmp))
- (let ((r1 (make-random-state 1234)))
+ (let ((r1 (random-state 1234)))
(random 1.0 r1)
(let ((r2 (copy r1)))
(let ((v1 (random 1.0 r1))
@@ -20870,44 +36735,40 @@ abs 1 2
(test (= f (bignum "1.5")) #t)
(test (= c (bignum "1.0+1.0i")) #t)))
-(let ((str (string #\1 #\2 #\3)))
- (fill! str #\x)
- (test str "xxx"))
-(let ((v (vector 1 2 3)))
- (fill! v 0.0)
- (test v (vector 0.0 0.0 0.0)))
-(let ((lst (list 1 2 (list (list 3) 4))))
- (fill! lst 100)
- (test lst '(100 100 100)))
-(let ((cn (cons 1 2)))
- (fill! cn 100)
- (test cn (cons 100 100)))
-(test (fill! 1 0) 'error)
-(test (fill! 'hi 0) 'error)
+(let ()
+ (define (f1 a) (+ a 1))
+ (define f2 (copy f1))
+ (test (f1 1) (f2 1))
+ (define* (f3 (a 2)) (* a 2))
+ (define f4 (copy f3))
+ (test (f3 3) (f4 3))
+ (test (f3) (f4))
+ (define-macro (f5 a) `(+ ,a 1))
+ (define f6 (copy f5))
+ (test (f5 2) (f6 2)))
-(test (fill!) 'error)
-(test (copy) 'error)
-(test (fill! '"hi") 'error)
+(let ()
+ (define (engulph form)
+ (let ((body `(let ((L ()))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) (reverse L))
+ (set! L (cons ,form L))))))
+ (define function (apply lambda () (list (copy body :readable)))) ; an optimizable no-macro macro?
+ (function)))
-(for-each
- (lambda (arg)
- (test (fill! arg 1) 'error))
- (list (integer->char 65) #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1))))
+ (test (engulph '(+ i 1)) '(1 2 3 4 5 6 7 8 9 10)))
-(for-each
- (lambda (arg)
- (let ((str (string #\a #\b)))
- (test (fill! str arg) 'error)))
- (list "hi" '(1 2 3) #() #f 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1))))
+
+
+
+;;; --------
(let ((c1 #f))
(call/cc
(lambda (c)
(test (reverse c) 'error)
(test (fill! c) 'error)
- (test (length c) 'error)
+ (test (length c) #f)
(test (eq? c c) #t) ; is this the norm?
(test (equal? c c) #t)
(test (equal? c (copy c)) #t)
@@ -20919,21 +36780,166 @@ abs 1 2
(lambda (c)
(test (reverse c) 'error)
(test (fill! c) 'error)
- (test (length c) 'error)
+ (test (length c) #f)
(test (eq? c c) #t)
(test (equal? c c) #t)
(test (equal? c (copy c)) #t)
(set! c1 c)))
(test (procedure? c1) #t))
+
+;;; length
+(test (length (list 1 2)) 2)
+(test (length "hiho") 4)
+(test (length (vector 1 2)) 2)
+(test (>= (length (make-hash-table 7)) 7) #t)
+(test (length ()) 0)
+(test (length (#(#() #()) 1)) 0)
+(test (length abs) #f)
+(when with-block (test (length (block 1.0 2.0 3.0)) 3))
+(test (length (make-iterator "123")) 3) ; this is not completely correct in all cases
+
+
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; fill!
+
+(let ((str (string #\1 #\2 #\3)))
+ (fill! str #\x)
+ (test str "xxx"))
+(let ((v (vector 1 2 3)))
+ (fill! v 0.0)
+ (test v (vector 0.0 0.0 0.0)))
+(let ((lst (list 1 2 (list (list 3) 4))))
+ (fill! lst 100)
+ (test lst '(100 100 100)))
+(let ((cn (cons 1 2)))
+ (fill! cn 100)
+ (test cn (cons 100 100)))
+(test (fill! 1 0) 'error)
+(test (fill! 'hi 0) 'error)
+(test (let ((x (cons 1 2))) (fill! x 3) x) '(3 . 3))
+(test (let ((x "")) (fill! x #\c) x) "")
+(test (let ((x ())) (fill! x #\c) x) ())
+(test (let ((x #())) (fill! x #\c) x) #())
+(test (let ((x #(0 1))) (fill! x -1) (set! (x 0) -2) x) #(-2 -1))
+(test (let ((x #(0 0))) (fill! x #(1)) (object->string x)) "#(#(1) #(1))") ; was "#(#1=#(1) #1#)"
+(test (let ((lst (list "hi" "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi"))) #t)
+(test (let ((lst (list "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi"))) #t)
+(test (let ((lst (list 1 2 3 4))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi" "hi"))) #t)
+(test (let ((lst (list 1 2 3))) (fill! lst lst) (object->string lst)) "#1=(#1# #1# #1#)")
+(test (let ((lst (vector 1 2 3))) (fill! lst lst) (object->string lst)) "#1=#(#1# #1# #1#)")
+(test (let ((lst #2d((1) (1)))) (fill! lst lst) (object->string lst)) "#1=#2D((#1#) (#1#))")
(test (let ((lst '(1 2 3))) (fill! lst (cons 1 2)) (set! (car (car lst)) 3) (caadr lst)) 3)
+(test (let ((lst (list))) (fill! lst 0) lst) ())
+(test (let ((lst (list 1))) (fill! lst 0) lst) '(0))
+(test (let ((lst (list 1 2))) (fill! lst 0) lst) '(0 0))
+(test (let ((lst (list 1 (list 2 3)))) (fill! lst 0) lst) '(0 0))
+(test (let ((lst (cons 1 2))) (fill! lst 0) lst) '(0 . 0))
+(test (let ((lst (cons 1 (cons 2 3)))) (fill! lst 0) lst) '(0 0 . 0))
+(let ((lst (make-list 3)))
+ (fill! lst lst)
+ (test lst (lst 0))
+ (set! (lst 1) 32)
+ (test ((lst 0) 1) 32))
+
+(when with-block
+ (let ((b (make-block 4)))
+ (fill! b 32.0)
+ (test b (block 32.0 32.0 32.0 32.0))))
+
+(test (fill!) 'error)
+(test (fill! '"hi") 'error)
+(test (fill! (begin) if) if)
+(test (fill! (rootlet) 3) 'error)
+(test (fill! (curlet) 3) 'error)
+(test (fill! "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" #f) 'error)
+(let ((v (make-vector 3 0 #t))) (fill! v 32) (test v (make-vector 3 32 #t)))
+
+(for-each
+ (lambda (arg)
+ (test (fill! arg 1) 'error))
+ (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0) #<eof> #<unspecified> #<undefined> (lambda (a) (+ a 1))
+ 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(for-each
+ (lambda (arg)
+ (let ((str (string #\a #\b)))
+ (test (fill! str arg) 'error)))
+ (list "hi" '(1 2 3) #() #f 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+
+(let ((ht (hash-table* :a 1)))
+ (for-each
+ (lambda (arg)
+ (test (fill! ht arg) arg)
+ (test (ht :a) arg))
+ (list "hi" '(1 2 3) #() 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand (log 0)
+ 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)) #f)))
+
+(let ((str (make-string 10 #\a)))
+ (fill! str #\b 0 2)
+ (test str "bbaaaaaaaa")
+ (fill! str #\c 8)
+ (test str "bbaaaaaacc")
+ (test (fill! str #\d -1) 'error)
+ (test (fill! str #\d 1 0) 'error)
+ (fill! str #\d 4 4)
+ (test str "bbaaaaaacc"))
+
+(let ((v (vector 1 2 3 4)))
+ (fill! v 5 2 3)
+ (test v #(1 2 5 4))
+ (fill! v 6 2)
+ (test v #(1 2 6 6)))
+
+(let ((v (float-vector 1.0 2.0 3.0)))
+ (test (fill! v 0.0 0 4) 'error)
+ (test (fill! v 0.0 4 4) 'error)
+ (fill! v 0.0 1)
+ (test v (float-vector 1.0 0.0 0.0)))
+
+(let ((v (int-vector 1 2 3)))
+ (test (fill! v 0 0 4) 'error)
+ (test (fill! v 0 4 4) 'error)
+ (fill! v 0 1)
+ (test v (int-vector 1 0 0)))
+
+(let ((p (list 0 1 2 3 4)))
+ (fill! p 5 3)
+ (test p (list 0 1 2 5 5))
+ (fill! p 6 0 3)
+ (test p (list 6 6 6 5 5)))
+
+(let ((p (cons 1 2)))
+ (fill! p 3 0)
+ (test p (cons 3 3))
+ (set! p (cons 0 (cons 1 2)))
+ (fill! p 4 0 1) ; "end" is ambiguous here
+ (test p '(4 1 . 2))
+ (fill! p 5 1)
+ (test p '(4 5 . 5)))
+
;; generic for-each/map
(test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6)
(test (map (lambda (n) (+ n 1)) (vector 1 2 3)) '(2 3 4))
(test (map (lambda (a b) (/ a b)) (list 1 2 3) (list 4 5 6)) '(1/4 2/5 1/2))
+(when with-block
+ (let ((b (block 1.0 2.0 3.0)))
+ (test (map (lambda (x) (floor x)) b) '(1 2 3))
+ (let ((sum 0))
+ (for-each
+ (lambda (x)
+ (set! sum (+ sum (floor x))))
+ b)
+ (test sum 6))))
+
;; try some applicable stuff
(test (let ((lst (list 1 2 3)))
(set! (lst 1) 32)
@@ -20962,264 +36968,216 @@ abs 1 2
#t))
-
-(let ()
- (define (a1 a) (stacktrace) (+ a 1))
- (define (a2 b) (+ b (a1 b)))
- (define (a3 c) (+ c (a2 c)))
- (let ((str (with-output-to-string
- (lambda ()
- (a3 1)))))
- (let ((str1 "")
- (len (- (length str) 1))
- (happy #t)
- (last-char #\x))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (if happy
- (set! str1 (string-append str1 (string (string-ref str i)))))
- (let ((c (string-ref str (+ i 1))))
- (if (char=? c #\()
- (set! happy #t)
- (if (and (char=? last-char #\))
- (char-whitespace? c))
- (set! happy #f)))
- (set! last-char c)))
- (if (and (not (string=? str1 "(a1 (a . 1))(a2 (b . 1))(a3 (c . 1))"))
- (not (string=? str1 "(a1 (a . 1))(a2 (b . 1))(a3 (c . 1))(snd_test_28)")))
- (format #t ";stacktrace: ~A from ~A~%" str1 str)))))
-
-(test (stacktrace #(23)) 'error)
-(for-each
- (lambda (arg)
- (test (stacktrace arg) 'error))
- (list "hi" '(1 2 3) 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i 1 '() "" (if #f #f) #<eof> (lambda (a) (+ a 1))))
-(test (stacktrace *error-info* 1) 'error)
-
-(let ((val (catch #t (lambda () (/ 1 0.0)) (lambda args args))))
- (let* ((tag (car val))
- (descr (cadr val))
- (cur-info *error-info*))
- (test tag 'division-by-zero)
- (test descr '("~A: division by zero, ~A" "/" (1 0.0)))
- (test (vector? cur-info) #t)
- (test (> (length cur-info) 5) #t)
- (test tag (cur-info 0))
- (test descr (cur-info 1))
- (test (equal? (cur-info 2) '(/ 1 0.0)) #t)
- (test (or (not (cur-info 3)) (integer? (cur-info 3))) #t) ; line-number
- (test (or (not (cur-info 4)) (string? (cur-info 4))) #t) ; file name
- ))
-
-
-
+;;; gc
(for-each
(lambda (arg)
(test (gc arg) 'error))
- (list "hi" '(1 2 3) #() 'a-symbol abs _ht_ quasiquote macroexpand make-type hook-functions
- 3.14 3/4 1.0+1.0i 1 '() "" (if #f #f) (lambda (a) (+ a 1))))
+ (list "hi" '(1 2 3) #() 'a-symbol abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i 1 () "" :hi (if #f #f) (lambda (a) (+ a 1))))
(test (gc #f #t) 'error)
-;(test (catch #t (lambda () (gc) #f) (lambda args 'error)) #f)
-;(test (dynamic-wind (lambda () (gc)) (lambda () (gc) #f) (lambda () (gc))) #f)
-;;; -------- tail recursion tests
+
+
+;;; --------------------------------------------------------------------------------
+;;; tail recursion tests
(let ((max-stack 0))
(define (tc-1 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (< b c)
(tc-1 b c))))
(tc-1 0 32)
- (if (> max-stack 10) (format #t "tc-1 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-1 max: ~D~%" max-stack))) ; 18 here and below in repl.scm
(let ((max-stack 0))
(define (tc-1 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (< a c)
(tc-2 (+ a 1) c)))
(define (tc-2 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (< a c)
(tc-1 (+ a 1) c)))
(tc-1 0 32)
- (if (> max-stack 10) (format #t "tc-1-1 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-1-1 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-2 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (= b c)
#f
(tc-2 b c))))
(tc-2 0 32)
- (if (> max-stack 10) (format #t "tc-2 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-2 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-2 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (< b c)
(tc-2 b c)
#f)))
(tc-2 0 32)
- (if (> max-stack 10) (format #t "tc-2-1 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-2-1 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-3 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(cond ((= b c) #f)
((< b c)
(tc-3 b c)))))
(tc-3 0 32)
- (if (> max-stack 10) (format #t "tc-3 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-3 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-4 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(cond ((= b c) #f)
(else (tc-4 b c)))))
(tc-4 0 32)
- (if (> max-stack 10) (format #t "tc-4 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-4 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-5 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(case b
((32) #f)
(else (tc-5 b c)))))
(tc-5 0 32)
- (if (> max-stack 10) (format #t "tc-5 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-5 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-6 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(case b
((17) #f)
((0 1 2 3 4 5 6 7 8) (tc-6 b c))
((9 10 11 12 13 14 15 16) (tc-6 b c)))))
(tc-6 0 32)
- (if (> max-stack 10) (format #t "tc-6 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-6 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-7 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(or (>= b c)
(tc-7 b c))))
(tc-7 0 32)
- (if (> max-stack 10) (format #t "tc-7 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-7 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-8 a c)
(let ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(and (< b c)
(tc-8 b c))))
(tc-8 0 32)
- (if (> max-stack 10) (format #t "tc-8 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-8 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-9 a c)
(let tc-9a ((b a))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (< b c)
(tc-9a (+ b 1)))))
(tc-9 0 32)
- (if (> max-stack 10) (format #t "tc-9 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-9 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-10 a c)
(let* ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(and (< b c)
(tc-10 b c))))
(tc-10 0 32)
- (if (> max-stack 10) (format #t "tc-10 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-10 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-11 a c)
(letrec ((b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(and (< b c)
(tc-11 b c))))
(tc-11 0 32)
- (if (> max-stack 10) (format #t "tc-11 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-11 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-12 a c)
(if (< a c)
(begin
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(tc-12 (+ a 1) c))))
(tc-12 0 32)
- (if (> max-stack 10) (format #t "tc-12 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-12 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-13 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(cond ((= a c) #f)
((< a c)
(if (> a c) (display "oops"))
(tc-13 (+ a 1) c))))
(tc-13 0 32)
- (if (> max-stack 10) (format #t "tc-13 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-13 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-14 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(cond ((>= a c) #f)
((values (+ a 1) c) => tc-14)))
(tc-14 0 32)
- (if (> max-stack 10) (format #t "tc-14 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-14 max: ~D~%" max-stack)))
(let ((max-stack 0))
(define (tc-15 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(or (>= a c)
(apply tc-15 (list (+ a 1) c))))
(tc-15 0 32)
- (if (> max-stack 10) (format #t "tc-15 max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-15 max: ~D~%" max-stack)))
-(let ((max-stack 0))
+(let ((max-stack 0)
+ (e #f))
+ (set! e (curlet))
(define (tc-17 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(or (and (>= a c) a)
- (eval `(tc-17 (+ ,a 1) ,c))))
+ (eval `(tc-17 (+ ,a 1) ,c) e)))
(let ((val (tc-17 0 32)))
(test (and (= val 32) (< max-stack 28)) #t)))
#|
(let ((max-stack 0))
(define (tc-19 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(call/cc
(lambda (r)
(if (>= a c) (r a))
@@ -21234,22 +37192,32 @@ abs 1 2
(do ((i (- a 1) (+ i 1)))
((= i a)
(tc-21 (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size))))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-))))
a))
(let ((val (tc-21 0)))
- (if (> max-stack 10) (format #t "tc-21 max: ~D~%" max-stack))
- (if (not (= val 32)) (format #t "tc-21 returned: ~A~%" val))))
+ (if (> max-stack 10) (format-logged #t "tc-21 max: ~D~%" max-stack))
+ (if (not (= val 32)) (format-logged #t "tc-21 returned: ~A~%" val))))
(let ((max-stack 0))
(define (tc-env a c)
- (with-environment (augment-environment (current-environment) (cons 'b (+ a 1)))
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (with-let (sublet (curlet) (cons 'b (+ a 1)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (< b c)
(tc-env b c))))
(tc-env 0 32)
- (if (> max-stack 10) (format #t "tc-env max: ~D~%" max-stack)))
+ (if (> max-stack 10) (format-logged #t "tc-env max: ~D~%" max-stack)))
+
+(let ((max-stack 0))
+ (define (tc-env-1 a)
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
+ (if (> a 0)
+ (with-let (curlet)
+ (tc-env-1 (- a 1)))))
+ (tc-env-1 32)
+ (if (> max-stack 10) (format-logged #t "tc-env-1 max: ~D~%" max-stack)))
;;; make sure for-each and map aren't messed up
@@ -21257,8 +37225,8 @@ abs 1 2
(let ((max-stack 0))
(for-each
(lambda (a)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (not (= a 1))
(error 'wrong-type-arg ";for-each arg is ~A" a)))
(make-list 100 1))
@@ -21267,8 +37235,8 @@ abs 1 2
(let ((max-stack 0))
(map
(lambda (a)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(if (not (= a 1))
(error 'wrong-type-arg ";map arg is ~A" a)))
(make-list 100 1))
@@ -21281,19 +37249,21 @@ abs 1 2
;;; OP_DEACTIVATE_GOTO in call-with-exit
;;; OP_DYNAMIC_WIND in the dynamic-wind case
-(let ((max-stack 0))
+(let ((max-stack 0)
+ (e #f))
+ (set! e (curlet))
(define (tc-17 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(or (and (>= a c) a)
- (eval-string (format #f "(tc-17 (+ ~A 1) ~A)" a c))))
+ (eval-string (format #f "(tc-17 (+ ~A 1) ~A)" a c) e)))
(let ((val (tc-17 0 32)))
(test (and (= val 32) (< max-stack 28)) #f)))
(let ((max-stack 0))
(define (tc-16 a c)
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
(call-with-exit
(lambda (r)
(if (>= a c) (r a))
@@ -21305,8 +37275,8 @@ abs 1 2
(define (tc-18 a c)
(dynamic-wind
(lambda ()
- (if (> (-s7-stack-size) max-stack)
- (set! max-stack (-s7-stack-size))))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-))))
(lambda ()
(or (and (>= a c) a)
(tc-18 (+ a 1) c)))
@@ -21315,6 +37285,9 @@ abs 1 2
(let ((val (tc-18 0 32)))
(test (and (= val 32) (> max-stack 28)) #t)))
+(test (let ((f #f)) (let tr ((i 10)) (if (= i 3) (set! f (lambda () i))) (if (> i 0) (tr (- i 1)))) (f)) 3)
+(test (let ((f ())) (let tr ((i 4)) (set! f (cons i f)) (if (> i 0) (tr (- i 1)))) f) '(0 1 2 3 4))
+
@@ -21330,23 +37303,19 @@ abs 1 2
(test ((((values append) begin) object->string) car) "car")
(test ((((((values and) or) append) begin) object->string) car) "car")
(test (((((((values values) and) or) append) begin) object->string) car) "car")
-(test (((lambda case lcm))) 1)
-(test (((lambda let* *))) 1)
-(test ((((eval lambda) lcm gcd))) 0)
(test (((append s7-version)) 0) #\s)
(test ((values (lambda hi #()))) #())
(test (((((lambda () (lambda () (lambda () (lambda () 1)))))))) 1)
(test (((cond (cond => cond)) (cond)) ((cond (#t #t)))) #t)
(test ((object->string #f) (ceiling 3/4)) #\f)
-(test (((lambda* ((a :optional) (b :key)) (apply lambda* (list (list a b 'c) 'c)))) 1) 1) ; (lambda* (:optional :key c) c)
(test (procedure? ((((((lambda* ((x (lambda () x))) x))))))) #t)
(test (procedure? ((((((letrec ((x (lambda () x))) x))))))) #t)
(test (procedure? ((((((letrec ((x (lambda () y)) (y (lambda () x))) x))))))) #t)
(test (procedure? ((((((let x () x))))))) #t)
(test (procedure? ((((((lambda (x) (set! x (lambda () x))) (lambda () x))))))) #t)
+(test (procedure? ````,,,,((((let x () x))))) #t)
(test ((do ((i 0 (+ i 1))) ((= i 1) (lambda () 3)))) 3)
(test (dynamic-wind s7-version s7-version s7-version) (s7-version))
-(test ((((lambda - -) -) 0) 1) -1)
(num-test ((list .(log 0)) 1) 0)
(num-test (((cons .(log 0)) 0) 1) 0.0)
@@ -21354,7 +37323,7 @@ abs 1 2
(test (modulo (lcm) (gcd)) 1)
(test (max (+) (*)) 1)
(test (min (gcd) (lcm)) 0)
-(test (symbol->value (gensym) (global-environment)) #<undefined>)
+(test (symbol->value (gensym) (rootlet)) #<undefined>)
(test (string-ref (s7-version) (*)) #\7)
(test (string>=? (string-append) (string)) #t)
(test (substring (string-append) (+)) "")
@@ -21414,8 +37383,7 @@ abs 1 2
(test (cond (((values '(1 2) '(3 4)) 0 0))) 'error)
(test (cond (((#2d((1 2) (3 4)) 0) 0) 32)) 32)
(test (cond ((apply < '(1 2)))) #t)
-(test (dynamic-wind lcm gcd *) 'error)
-(test ((lambda (let) (+)) 0) 0)
+(test (dynamic-wind lcm gcd *) 0) ; was 'error but Peter Bex tells me this is normal
(test (case 0 ((> 0 1) 32)) 32)
(test (char-downcase (char-downcase #\newline)) #\newline)
(test (and (and) (and (and)) (and (and (and (or))))) #f)
@@ -21424,24 +37392,14 @@ abs 1 2
(test ((((lambda () begin)) (values begin 1))) 1)
(test (+ (((lambda* () values)) 1 2 3)) 6)
(test ((values ('((1 2) (3 4)) 1) (abs -1))) 4)
-(test ((apply lambda '() '(() ()))) '())
+(test ((apply lambda () '(() ()))) ())
(test ((lambda* ((symbol "#(1 #\\a (3))")) #t)) #t)
(test (apply if ('((1 2) (3 4)) 1)) 4)
-(test (let () (define (hi cond) (+ cond 1)) (hi 2)) 3)
-(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi 2)) 3)
-(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi)) 2)
-(test (let () ((lambda (cond) (+ cond 1)) 2)) 3)
-(test (let () ((lambda* (cond) (+ cond 1)) 2)) 3)
-(test (let () (define-macro (hi cond) `(+ 1 ,cond)) (hi 2)) 3)
-(test (let () (define-macro* (hi (cond 1)) `(+ 1 ,cond)) (hi)) 2)
-(test (let () (define (hi abs) (+ abs 1)) (hi 2)) 3)
-(test (let () (define (hi if) (+ if 1)) (hi 2)) 3)
-(test (let () (define* (hi (lambda 1)) (+ lambda 1)) (hi)) 2)
(test (((lambda #\newline gcd))) 'error)
-(test (symbol? (let () (define (hi) (+ 1 2)))) #t)
-(test (symbol? (begin (define (x y) y) (x (define (x y) y)))) #t)
-(test (symbol? (do () ((define (x) 1) (define (y) 2)))) #t)
+(test (symbol? (let () (define (hi) (+ 1 2)))) #f)
+(test (symbol? (begin (define (x y) y) (x (define (x y) y)))) #f)
+(test (symbol? (do () ((define (x) 1) (define (y) 2)))) #f)
(test (cond (0 (define (x) 3) (x))) 3)
(test (let ((x (lambda () 3))) (if (define (x) 4) (x) 0)) 4)
(test (and (define (x) 4) (+ (x) 1)) 5)
@@ -21468,15 +37426,16 @@ abs 1 2
(test (let ((x (list 1 2))) (list-set! (list-set! x 0 (list 4 3)) 0 32) x) '((32 3) 2))
(test (set! (('((0 2) (3 4)) 0) 0) 0) 0)
(test (set! ((map abs '(1 2)) 1) 0) 0)
+(test (let () (set! ((define x #(1 2)) 0) 12) x) #(12 2))
(test (let ((x (list 1 2))) (set! ((call-with-exit (lambda (k) (k x))) 0) 12) x) '(12 2))
(test (let ((x #2d((1 2) (3 4)))) (set! (((values x) 0) 1) 12) x) #2D((1 12) (3 4)))
-(test (let ((x 0)) (set! ((make-procedure-with-setter (lambda () x) (lambda (y) (set! x y)))) 12) x) 12)
+(test (let ((x 0)) (set! ((dilambda (lambda () x) (lambda (y) (set! x y)))) 12) x) 12)
(test (let ((x 0) (str "hiho")) (string-set! (let () (set! x 32) str) 0 #\x) (list x str)) '(32 "xiho"))
(test (let ((x "hi") (y "ho")) (set! ((set! x y) 0) #\x) (list x y)) '("xo" "xo"))
(test (let ((x "hi") (y "ho")) (set! x y) (set! (y 0) #\x) (list x y)) '("xo" "xo")) ; Guile gets the same result
(test (let ((x (lambda (a) (a z 1) z))) (x define)) 1) ; !
(test (let ((x (lambda (a) (a z (lambda (b) (+ b 1))) (z 2)))) (x define)) 3)
-(test (let ((x (lambda (a b c) (apply a (list b c))))) (x let '() 3)) 3)
+(test (let ((x (lambda (a b c) (apply a (list b c))))) (x let () 3)) 3)
(test (let ((x (lambda (a b c) (apply a (list b c))))) (x let '((y 2)) '(+ y 1))) 3)
(let () (test ((values let '((x 1))) '(+ x 1)) 2)) ; !
@@ -21489,7 +37448,7 @@ abs 1 2
(let ()
(define (bcase start end func)
- (let ((body '()))
+ (let ((body ()))
(do ((i start (+ i 1)))
((= i end))
(set! body (cons `((,i) ,(func i)) body)))
@@ -21499,8 +37458,6 @@ abs 1 2
-
-
;;; ------ CLisms ------------------------------------------------------------------------
@@ -21536,8 +37493,8 @@ abs 1 2
;; (gensym string)
;;
- (defmacro when (test . forms)
- `(if ,test (begin , at forms)))
+; (define-macro (when test . forms)
+; `(if ,test (begin , at forms)))
(define-macro (loop . args)
(let ()
@@ -21578,7 +37535,7 @@ abs 1 2
(define (loop-returning-set! c x) (vector-set! c 8 x))
(define (make-loop-clause . args)
- (let ((v (vector #f '() '() '() '() '() '() '() '())))
+ (let ((v (vector #f () () () () () () () ())))
(if (null? args) v
(do ((a args (cddr a)))
((null? a) v)
@@ -21598,7 +37555,7 @@ abs 1 2
(let ((gather-clause
(lambda (clauses accessor)
;; append data from clauses
- (do ((l '()))
+ (do ((l ()))
((null? clauses) l)
(set! l (append l (accessor (car clauses))))
(set! clauses (cdr clauses))))))
@@ -21643,7 +37600,7 @@ abs 1 2
(lambda (lst ops)
;; return tail of expr up to next op in cdr of tail
(do ((h lst)
- (l '()))
+ (l ()))
((or (null? lst)
;; ignore op if in front.
(and (not (eq? h lst))
@@ -21692,10 +37649,10 @@ abs 1 2
(define (parse-numerical-for forms clauses ops)
;; forms is (FOR <var> <OP> ...)
;; where <OP> is guaranteed to be one of: FROM TO BELOW ABOVE DOWNTO
- clauses
+ ;; (bil) clauses
(let ((var (cadr forms))
(tail (cddr forms))
- (bind '())
+ (bind ())
(from #f)
(head #f)
(last #f)
@@ -21776,7 +37733,7 @@ abs 1 2
'bindings (reverse bind)
'stepping (list step)
'end-tests (if (not stop)
- '() (list stop)))
+ () (list stop)))
tail)))
(define (parse-repeat forms clauses ops)
@@ -21795,18 +37752,18 @@ abs 1 2
(define (parse-sequence-iteration forms clauses ops)
;; tail is (FOR <var> <OP> ...)
;; <OP> is guaranteed to be one of: IN ON ACROSS
- clauses
+ ;; (bil) clauses
(let ((head forms)
(var (cadr forms))
(seq (gensym "v"))
(tail (cddr forms))
- (bind '())
+ (bind ())
(data #f)
- (init '())
- (loop '())
+ (init ())
+ (loop ())
(incr #f)
- (stop '())
- (step '())
+ (stop ())
+ (step ())
(type #f))
(do ((next #f))
@@ -21835,13 +37792,13 @@ abs 1 2
(push (make-binding seq data) bind)
(if (eq? type 'across)
(let ((pos (gensym "v"))
- (max (gensym "v")))
+ (mx (gensym "v")))
(push (make-binding pos 0) bind)
- (push (make-binding max #f) bind)
- (push `(set! ,max (vector-length ,seq)) init)
+ (push (make-binding mx #f) bind)
+ (push `(set! ,mx (vector-length ,seq)) init)
(push `(set! ,pos (+ 1 ,pos)) step)
(push `(set! ,var (vector-ref ,seq ,pos)) loop)
- (push `(>= ,pos ,max) stop))
+ (push `(>= ,pos ,mx) stop))
(begin
(if incr
(if (and (list? incr) (eq? (car incr) 'quote))
@@ -21864,7 +37821,7 @@ abs 1 2
(define (parse-general-iteration forms clauses ops)
;; forms is (FOR <var> = ...)
- clauses
+ ;; (bil) clauses
(let ((head forms)
(var (cadr forms))
(tail (cddr forms))
@@ -21894,21 +37851,21 @@ abs 1 2
(values (make-loop-clause 'operator 'for
'bindings (list (make-binding var #f))
- 'initially (if init (list init) '())
- 'looping (if loop (list loop) '())
- 'stepping (if step (list step) '()))
+ 'initially (if init (list init) ())
+ 'looping (if loop (list loop) ())
+ 'stepping (if step (list step) ()))
tail)))
(define (parse-with forms clauses ops)
;; forms is (WITH <var> = ...)
- clauses
+ ;; (bil) clauses
(let ((head forms)
(tail (cdr forms))
(var #f)
(expr #f)
(and? #f)
- (bind '())
- (init '()))
+ (bind ())
+ (init ()))
(do ((need #t)
(next #f))
((or (null? tail) (loop-op? (car tail) ops)))
@@ -21963,10 +37920,10 @@ abs 1 2
tail)))
(define (parse-do forms clauses ops)
- clauses
+ ;; (bil) clauses
(let ((head forms)
(oper (pop forms))
- (body '()))
+ (body ()))
(do ()
((or (null? forms)
(loop-op? (car forms) ops))
@@ -21980,7 +37937,7 @@ abs 1 2
forms)))
(define (parse-finally forms clauses ops)
- clauses
+ ;; (bil) clauses
(let ((oper (pop forms))
(expr #f))
(if (null? forms)
@@ -21990,7 +37947,7 @@ abs 1 2
forms)))
(define (parse-initially forms clauses ops)
- clauses
+ ;; (bil) clauses
(let ((oper (pop forms))
(expr #f))
(if (null? forms)
@@ -22041,11 +37998,11 @@ abs 1 2
(coll #f)
(new? #f)
(into #f)
- (loop '())
- (bind '())
- (init '())
- (tests '())
- (return '()))
+ (loop ())
+ (bind ())
+ (init ())
+ (tests ())
+ (return ()))
(if (null? forms)
(loop-error ops forms "Missing '" oper "' expression."))
@@ -22159,7 +38116,7 @@ abs 1 2
'initially (reverse init)
'looping (reverse loop)
'returning (reverse return)
- 'collectors (if new? (list coll) '())
+ 'collectors (if new? (list coll) ())
'end-tests (reverse tests))
forms)))
@@ -22170,7 +38127,7 @@ abs 1 2
`(return ,expr))
(define (parse-while-until forms clauses ops)
- clauses
+ ;; (bil) clauses
(let ((head forms)
(oper (pop forms))
(test #f)
@@ -22187,7 +38144,7 @@ abs 1 2
forms)))
(define (parse-thereis forms clauses ops)
- clauses
+ ;; (bil) clauses
(let ((oper (car forms))
(expr #f)
(bool #f)
@@ -22220,7 +38177,7 @@ abs 1 2
forms)))
(define (parse-return forms clauses ops)
- clauses
+ ;; (bil) clauses
(let ((oper (car forms))
(expr #f)
(func #f))
@@ -22248,7 +38205,7 @@ abs 1 2
(define (parse-then-else-dependents forms clauses ops)
(let ((previous forms)
(stop? #f)
- (parsed '()))
+ (parsed ()))
(do ((op #f)
(clause #f)
@@ -22265,7 +38222,7 @@ abs 1 2
(lambda () ( (cadr op) forms (append clauses parsed) ops))
(lambda (a b) (set! clause a) (set! remains b)))
- ;(format #t "~%after call clause=~s forms=~S" clause forms)
+ ;(format-logged #t "~%after call clause=~s forms=~S" clause forms)
(set! parsed (append parsed (list clause)))
(set! previous forms)
@@ -22287,7 +38244,7 @@ abs 1 2
(let ((ops (cons '(else ) ops))
(save forms)
(oper (car forms))
- (loop (list)) ; avoid '() because of acl bug
+ (loop (list)) ; avoid () because of acl bug
(expr (list))
(then (list))
(else (list)))
@@ -22330,12 +38287,12 @@ abs 1 2
ops))
(lambda (a b) (set! else a) (set! forms b)))
(if (not (null? (cdr else)))
- (set! else (gather-clauses '() else))
+ (set! else (gather-clauses () else))
(set! else (car else)))
(set-car! (cdddr loop) `(begin ,@(loop-looping else)))
;; flush loop forms so we dont gather actions.
- (loop-looping-set! then '())
- (loop-looping-set! else '())
+ (loop-looping-set! then ())
+ (loop-looping-set! else ())
(set! then (gather-clauses 'if (list then else)))))
(loop-looping-set! then (list loop))
(values then forms)))
@@ -22348,11 +38305,11 @@ abs 1 2
(and (not (null? (cddr op)))
(eq? (caddr op) type)))))
(let ((previous forms)
- (clauses '()))
+ (clauses ()))
(do ((op #f)
(clause #f)
- (remains '())
- (body '()) )
+ (remains ())
+ (body ()) )
((null? forms))
(if (and cond? (eq? (car forms) 'and))
(pop forms))
@@ -22380,7 +38337,7 @@ abs 1 2
clauses))))
(define (parse-iteration caller forms ops)
- (gather-clauses caller (parse-clauses forms '() ops)))
+ (gather-clauses caller (parse-clauses forms () ops)))
;;
;; loop implementation
@@ -22433,7 +38390,7 @@ abs 1 2
(define (scheme-loop forms)
(let ((name (gensym "v"))
(parsed (parse-iteration 'loop forms *loop-operators*))
- (end-test '())
+ (end-test ())
(done '(go #t)) ; :done
(return #f))
;(write (list :parsed-> parsed))
@@ -22466,7 +38423,7 @@ abs 1 2
(set! end-test
(let ((ends (loop-end-tests parsed)))
(if (null? ends)
- '()
+ ()
(list
`(if ,(if (null? (cdr ends))
(car ends)
@@ -22503,7 +38460,6 @@ abs 1 2
(test (loop for i below 10 collect i) '(0 1 2 3 4 5 6 7 8 9))
(test (loop for i to 10 sum i) 55)
(test (loop for i downto -10 count (even? i)) 6)
- (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) thereis (= x 4)) #t)
(test (loop for x in '(0 1 2 3 4 5 6 7 8 9) by 'cddr collect x) '(0 2 4 6 8))
(test (loop for x on '(0 1 2 3) by 'cddr collect x) '((0 1 2 3) (2 3)))
(test (loop for x in '(0 1 2 3 4 5 6 7 8 9) thereis (= x 4)) #t)
@@ -22516,11 +38472,11 @@ abs 1 2
(test (loop repeat 10 count #f) 0)
(test (loop for i to 10 collect i collect (* 2 i)) '(0 0 1 2 2 4 3 6 4 8 5 10 6 12 7 14 8 16 9 18 10 20))
(test (loop for i from -10 to 10 by 2 nconc (list i (- i))) '(-10 10 -8 8 -6 6 -4 4 -2 2 0 0 2 -2 4 -4 6 -6 8 -8 10 -10))
- (test (loop for i from -10 downto 10 by -1 collect i) '())
+ (test (loop for i from -10 downto 10 by -1 collect i) ())
(test (loop for i downfrom 10 downto -10 by 2 collect i) '(10 8 6 4 2 0 -2 -4 -6 -8 -10))
- (test (loop for i from 10 to -10 by 1 collect i) '())
+ (test (loop for i from 10 to -10 by 1 collect i) ())
(test (loop for i to 10 for j downfrom 10 collect i collect j) '(0 10 1 9 2 8 3 7 4 6 5 5 6 4 7 3 8 2 9 1 10 0))
- (test (loop for i below 0 collect i into foo finally (return foo)) '())
+ (test (loop for i below 0 collect i into foo finally (return foo)) ())
(test (loop for i below 0 sum i into foo finally (return foo)) 0)
(test (loop for i below 0 maximize i into foo finally (return foo)) #f)
(test (loop with a and b = 'x and c = 2 repeat 10 for x = 1 then 'fred collect (list x a b c))
@@ -22534,9 +38490,7 @@ abs 1 2
;; end loop
;; more macros from Rick's stuff
-
- (defmacro dolist (spec . body)
- ;; spec = (var list . return)
+ (define-macro (dolist spec . body) ;; spec = (var list . return)
(let ((v (gensym)))
`(do ((,v ,(cadr spec) (cdr ,v))
(,(car spec) #f))
@@ -22546,25 +38500,63 @@ abs 1 2
(test (let ((sum 0)) (dolist (v (list 1 2 3) sum) (set! sum (+ sum v)))) 6)
- (defmacro dotimes (spec . body)
- ;; spec = (var end . return)
+ (define-macro (dotimes spec . body) ;; spec = (var end . return)
(let ((e (gensym))
(n (car spec)))
`(do ((,e ,(cadr spec))
- (,n 0))
+ (,n 0 (+ ,n 1)))
((>= ,n ,e) ,@(cddr spec))
- , at body
- (set! ,n (+ ,n 1)))))
+ , at body)))
(test (let ((sum 0)) (dotimes (i 3 sum) (set! sum (+ sum i)))) 3)
- (defmacro do* (spec end . body)
+ (define-macro (do* spec end . body)
`(let* (,@(map (lambda (var) (list (car var) (cadr var))) spec))
(do () ,end
, at body
- ,@(map (lambda (var) (list 'set! (car var) (caddr var))) spec))))
+ ,@(map (lambda (var) (if (pair? (cddr var))
+ `(set! ,(car var) ,(caddr var))
+ (values)))
+ spec))))
+
+ (define (1+ x) (+ x 1))
(test (let ((sum 0)) (do* ((i 0 (+ i 1)) (j i (+ i 1))) ((= i 3) sum) (set! sum (+ sum j)))) 5)
+ (test (do* ((a 1 (+ a 1)) (b a)) ((> a 9) b)) 1)
+ (test (let ((a 0)) (do* ((a 1 (+ a 1)) (b a)) ((> a 9) a)) a) 0)
+ (test (do* ((i 0 (1+ i))) ((>= i 10) i)) 10)
+ (test (do* ((i 0 (1+ j)) (j 0 (1+ i))) ((>= i 10) (+ i j))) 23)
+ (test (let ((x ())) (do* ((i 0 (1+ i))) ((>= i 10) x) (set! x (cons i x)))) '(9 8 7 6 5 4 3 2 1 0))
+ (test (call-with-exit (lambda (return) (do* ((i 0 (1+ i))) () (when (> i 10) (return i))))) 11)
+ (test (do* ((i 0 (+ i 10))) ((> i -1) i) (error 'bad)) 0)
+ (test (do* ((i 0 (1+ i)) (x ())) ((>= i 10) x) (set! x (cons 'a x))) '(a a a a a a a a a a))
+ (test (let ((i 0)) (do* () ((>= i 10) i) (set! i (+ i 1)))) 10)
+ (test (do* ((i 0 (1+ i))) ((> i 10) (values))) #<unspecified>)
+ (test (+ 1 (do* ((i 0 (1+ i))) ((> i 10) (values i (1+ i))))) 24)
+ (test (do* ((i 0 (1+ i))) ((> i 10) (set! i (+ i 1)) (set! i (+ i 1)) i)) 13)
+ (test (do* ((i 0 (1+ i))) ((> i 10))) ())
+ (test (map (lambda (f) (f)) (let ((x ())) (do* ((i 0 (+ i 1))) ((= i 5) x) (set! x (cons (lambda () i) x))))) '(5 5 5 5 5))
+ (test (do* ((lst (list 0 1 2 3 4 5 6 7 8 9) (cdr lst))
+ (elm (car lst) (and (pair? lst) (car lst)))
+ (n 0 (+ n (or elm 0))))
+ ((null? lst) n))
+ 45)
+ (test (do* ((lst (list 0 1 2 3 4 5 6 7 8 9) (cdr lst))
+ (elm (car lst) (and (pair? lst) (car lst)))
+ (n 0))
+ ((null? lst) n)
+ (set! n (+ n elm)))
+ 45)
+ (test (let ((vec (vector 0 1 2 3 4 5 6 7 8 9)))
+ (and (null? (do* ((n #f)
+ (i 0 (+ i 1))
+ (j (- 9 i) (- 9 i)))
+ ((>= i j))
+ (set! n (vec i))
+ (set! (vec i) (vec j))
+ (set! (vec j) n)))
+ (equal? vec #(9 8 7 6 5 4 3 2 1 0))))
+ #t)
(define-macro (fluid-let xexe . body)
;; taken with changes from Teach Yourself Scheme
@@ -22623,13 +38615,12 @@ abs 1 2
(set! y (gx))))
(list x y))
'(32 32))
- ;; oops! fluid-let doesn't actually work!
+ ;; oops! fluid-let doesn't actually work
;; in CL: (defvar x 32) (let ((y 0)) (defun gx () x) (let ((x 12)) (setf y (gx))) (list x y)) -> '(32 12)
;; (let ((y 0)) (defun gx () x) (let ((x 100)) (let ((x 12)) (setf y (gx)))) (list x y)) -> '(32 12)
;; (let ((y 0)) (defun gx () x) (let ((x 100)) (let ((x 12)) (setf y (gx)) (setf x 123)) (list x y))) -> '(100 12) !
;; (the defvar makes x dynamic)
-
;; define** treats args before :optional as required args
(define-macro (define** declarations . forms)
@@ -22642,15 +38633,28 @@ abs 1 2
(if (eq? thing (car lst))
count
(position thing (cdr lst) (+ count 1)))))
+ (define (no-opt old-args new-args)
+ (if (null? old-args)
+ (reverse new-args)
+ (no-opt (cdr old-args)
+ (if (eq? (car old-args) :optional)
+ new-args
+ (cons (car old-args) new-args)))))
(let ((required-args (position :optional args 0)))
(if required-args
`(define* (,name . func-args)
(if (< (length func-args) ,required-args)
(error "~A requires ~D argument~A: ~A"
',name ,required-args (if (> ,required-args 1) "s" "") func-args)
- (apply (lambda* ,args , at forms) func-args)))
+ (apply (lambda* ,(no-opt args ()) , at forms) func-args)))
`(define* ,declarations , at forms)))))
+ (let ()
+ (define** (f1 a :optional b) (+ a (or b 1)))
+ (test (f1 1) 2)
+ (test (f1 1 2) 3)
+ (test (f1) 'error))
+
;; Rick's with-optkeys
(define-macro (with-optkeys spec . body)
@@ -22760,7 +38764,7 @@ abs 1 2
(test (let ((args '(1 2 3))) (with-optkeys (args a b c) (list a b c))) '(1 2 3))
(test (let ((args '(1 2 3 4))) (with-optkeys (args a b c) (list a b c))) 'error)
(test (let ((args '(1 2))) (with-optkeys (args a b (c 33)) (list a b c))) '(1 2 33))
- (test (let ((args '())) (with-optkeys (args a b (c 33)) (list a b c))) '(#f #f 33))
+ (test (let ((args ())) (with-optkeys (args a b (c 33)) (list a b c))) '(#f #f 33))
(test (let ((args '(:b 22))) (with-optkeys (args a b (c 33)) (list a b c))) '(#f 22 33))
(test (let ((args '(-1 :z 22))) (with-optkeys (args a b (c 33)) (list a b c))) 'error)
(test (let ((args '(:b 99 :z 22))) (with-optkeys (args a b (c 33)) (list a b c))) 'error)
@@ -22785,28 +38789,339 @@ abs 1 2
;; ... later ... I've run out of gas.
;(define-macro (progn . body) `(let () , at body))
+ (define (null obj) (or (not obj) (null? obj)))
+ (define t #t)
+ (define nil ())
+
+ (define eq eq?)
+ (define eql eqv?)
+ (define equal equal?)
+ (define (equalp x y)
+ (or (equal x y)
+ (and (char? x) (char? y) (char-ci=? x y))
+ (and (number? x) (number? y) (= x y))
+ (and (string? x) (string? y) (string-ci=? x y))))
+
+ (define (identity x) x)
+ (define (complement fn) (lambda args (not (apply fn args))))
+
+ ;; -------- numbers
+
+ (define (conjugate z) (complex (real-part z) (- (imag-part z))))
+ (define zerop zero?)
+ (define oddp odd?)
+ (define evenp even?)
+ (define plusp positive?)
+ (define minusp negative?)
+ (define realpart real-part)
+ (define imagpart imag-part)
+ (define* (float x ignore) (* 1.0 x))
+ (define rational rationalize)
+ (define mod modulo)
+ (define rem remainder)
+
+ (define (logtest i1 i2) (not (zero? (logand i1 i2))))
+ (define (logbitp index integer) (logbit? integer index)) ;(logtest (expt 2 index) integer))
+ (define (lognand n1 n2) (lognot (logand n1 n2)))
+ (define (lognor n1 n2) (lognot (logior n1 n2)))
+ (define (logandc1 n1 n2) (logand (lognot n1) n2))
+ (define (logandc2 n1 n2) (logand n1 (lognot n2)))
+ (define (logorc1 n1 n2) (logior (lognot n1) n2))
+ (define (logorc2 n1 n2) (logior n1 (logior n2)))
+ (define (logeqv . ints) (lognot (apply logxor ints)))
+
+ ;; from slib
+ (define (logcount n)
+ (define bitwise-bit-count
+ (letrec ((logcnt (lambda (n tot)
+ (if (zero? n)
+ tot
+ (logcnt (quotient n 16)
+ (+ (vector-ref
+ #(0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4)
+ (modulo n 16))
+ tot))))))
+ (lambda (n)
+ (cond ((negative? n) (lognot (logcnt (lognot n) 0)))
+ ((positive? n) (logcnt n 0))
+ (else 0)))))
+ (cond ((negative? n) (bitwise-bit-count (lognot n)))
+ (else (bitwise-bit-count n))))
+
+ (define-constant boole-clr 0)
+ (define-constant boole-set 1)
+ (define-constant boole-1 2)
+ (define-constant boole-2 3)
+ (define-constant boole-c1 4)
+ (define-constant boole-c2 5)
+ (define-constant boole-and 6)
+ (define-constant boole-ior 7)
+ (define-constant boole-xor 8)
+ (define-constant boole-eqv 9)
+ (define-constant boole-nand 10)
+ (define-constant boole-nor 11)
+ (define-constant boole-andc1 12)
+ (define-constant boole-andc2 13)
+ (define-constant boole-orc1 14)
+ (define-constant boole-orc2 15)
+
+ (define (boole op int1 int2)
+ (cond
+ ((= op boole-clr) 0)
+ ((= op boole-set) -1) ;; all ones -- "always 1" is misleading
+ ((= op boole-1) int1)
+ ((= op boole-2) int2)
+ ((= op boole-c1) (lognot int1))
+ ((= op boole-c2) (lognot int2))
+ ((= op boole-and) (logand int1 int2))
+ ((= op boole-ior) (logior int1 int2))
+ ((= op boole-xor) (logxor int1 int2))
+ ((= op boole-eqv) (logeqv int1 int2))
+ ((= op boole-nand) (lognot (logand int1 int2)))
+ ((= op boole-nor) (lognot (logior int1 int2)))
+ ((= op boole-andc1) (logand (lognot int1) int2))
+ ((= op boole-andc2) (logand int1 (lognot int2)))
+ ((= op boole-orc1) (logior (lognot int1) int2))
+ ((= op boole-orc2) (logior int1 (lognot int2)))))
+
+ ;; from Rick
+ (define (byte siz pos)
+ ;; cache size, position and mask.
+ (list siz pos (ash (- (ash 1 siz) 1) pos)))
+
+ (define byte-size car)
+ (define byte-position cadr)
+ (define byte-mask caddr)
+
+ (define (ldb bytespec integer)
+ (ash (logand integer (byte-mask bytespec))
+ (- (byte-position bytespec))))
+
+ (define (dpb integer bytespec into)
+ (logior (ash (logand integer (- (ash 1 (byte-size bytespec)) 1)) (byte-position bytespec))
+ (logand into (lognot (byte-mask bytespec)))))
+
+ (define (ldb-test byte int) (not (zero? (ldb byte int))))
+ (define (mask-field byte int) (logand int (dpb -1 byte 0)))
+ (define (deposit-field byte spec int) (logior (logand byte (byte-mask spec)) (logand int (lognot (byte-mask spec)))))
+ (define (scale-float x k) (* x (expt 2.0 k)))
+
+ ;; from clisp -- can't see any point to most of these
+ (define-constant double-float-epsilon 1.1102230246251568e-16)
+ (define-constant double-float-negative-epsilon 5.551115123125784e-17)
+ (define-constant least-negative-double-float -2.2250738585072014e-308)
+ (define-constant least-negative-long-float -5.676615526003731344e-646456994)
+ (define-constant least-negative-normalized-double-float -2.2250738585072014e-308)
+ (define-constant least-negative-normalized-long-float -5.676615526003731344e-646456994)
+ (define-constant least-negative-normalized-short-float -1.1755e-38)
+ (define-constant least-negative-normalized-single-float -1.1754944e-38)
+ (define-constant least-negative-short-float -1.1755e-38)
+ (define-constant least-negative-single-float -1.1754944e-38)
+ (define-constant least-positive-double-float 2.2250738585072014e-308)
+ (define-constant least-positive-long-float 5.676615526003731344e-646456994)
+ (define-constant least-positive-normalized-double-float 2.2250738585072014e-308)
+ (define-constant least-positive-normalized-long-float 5.676615526003731344e-646456994)
+ (define-constant least-positive-normalized-short-float 1.1755e-38)
+ (define-constant least-positive-normalized-single-float 1.1754944e-38)
+ (define-constant least-positive-short-float 1.1755e-38)
+ (define-constant least-positive-single-float 1.1754944e-38)
+ (define-constant long-float-epsilon 5.4210108624275221706e-20)
+ (define-constant long-float-negative-epsilon 2.7105054312137610853e-20)
+ (define-constant most-negative-double-float -1.7976931348623157e308)
+ ;; most-negative-fixnum
+ (define-constant most-negative-long-float -8.8080652584198167656e646456992)
+ (define-constant most-negative-short-float -3.4028e38)
+ (define-constant most-negative-single-float -3.4028235e38)
+ (define-constant most-positive-double-float 1.7976931348623157e308)
+ ;; most-positive-fixnum
+ (define-constant most-positive-long-float 8.8080652584198167656e646456992)
+ (define-constant most-positive-short-float 3.4028e38)
+ (define-constant most-positive-single-float 3.4028235e38)
+ (define-constant short-float-epsilon 7.6295e-6)
+ (define-constant short-float-negative-epsilon 3.81476e-6)
+ (define-constant single-float-epsilon 5.960465e-8)
+ (define-constant single-float-negative-epsilon 2.9802326e-8)
+
+ (define (lisp-implementation-type) "s7")
+ (define lisp-implementation-version s7-version)
+ (define (software-type) "s7")
+ (define software-version s7-version)
+
+ (define (machine-version)
+ (if (and (defined? 'file-exists?)
+ (file-exists? "/proc/cpuinfo"))
+ (call-with-input-file "/proc/cpuinfo"
+ (lambda (cpufile)
+ (do ((line (read-line cpufile) (read-line cpufile)))
+ ((or (eof-object? line)
+ (string=? (substring line 0 10) "model name"))
+ (if (string? line)
+ (string-trim " " (substring line (+ 1 (position #\: line))))
+ "unknown")))))
+ "unknown"))
+
+ ;; = < <= > >= are the same, also min max + - * / lcm gcd exp expt log sqrt
+ ;; sin cos tan acos asin atan pi sinh cosh tanh asinh acosh atanh
+ ;; numerator denominator logior logxor logand ash integer-length random
+
+ ;; slightly different: floor ceiling truncate round and the ff cases thereof
+ ;; abs of complex -> magnitude
+ (define (cl-abs x) (if (not (zero? (imag-part x))) (magnitude x) (abs x)))
+
+ ;; these actually return multiple values
+ (define* (cl-floor x (divisor 1)) (floor (/ x divisor)))
+ (define* (cl-ceiling x (divisor 1)) (ceiling (/ x divisor)))
+ (define* (cl-truncate x (divisor 1)) (truncate (/ x divisor)))
+ (define* (cl-round x (divisor 1)) (round (/ x divisor)))
+ (define* (ffloor x divisor) (* 1.0 (cl-floor x divisor)))
+ (define* (fceling x divisor) (* 1.0 (cl-ceiling x divisor)))
+ (define* (ftruncate x divisor) (* 1.0 (cl-truncate x divisor)))
+ (define* (fround x divisor) (* 1.0 (cl-round x divisor)))
+
+ (define (/= . args)
+ (if (null? (cdr args))
+ #t
+ (if (member (car args) (cdr args))
+ #f
+ (apply /= (cdr args)))))
+
+ (define (1- x) (- x 1))
+ (define (isqrt x) (floor (sqrt x)))
+ (define phase angle)
+ (define* (complex rl (im 0.0)) (complex rl im))
+ (define (signum x) (if (zerop x) x (/ x (abs x))))
+ (define (cis x) (exp (complex 0.0 x)))
+
+
+ ;; -------- characters
+
+ (define char-code-limit 256)
+ (define alpha-char-p char-alphabetic?)
+ (define upper-case-p char-upper-case?)
+ (define lower-case-p char-lower-case?)
+ (define* (digit-char-p c (radix 10)) (string->number (string c) radix))
+ (define (alphanumericp c) (or (char-alphabetic? c) (char-numeric? c)))
+
+ (define* (char= . args) (or (< (length args) 2) (apply char=? args)))
+ (define* (char< . args) (or (< (length args) 2) (apply char<? args)))
+ (define* (char<= . args) (or (< (length args) 2) (apply char<=? args)))
+ (define* (char> . args) (or (< (length args) 2) (apply char>? args)))
+ (define* (char>= . args) (or (< (length args) 2) (apply char>=? args)))
+ (define* (char-equal . args) (or (< (length args) 2) (apply char-ci=? args)))
+ (define* (char-lessp . args) (or (< (length args) 2) (apply char-ci<? args)))
+ (define* (char-greaterp . args) (or (< (length args) 2) (apply char-ci>? args)))
+ (define* (char-not-lessp . args) (or (< (length args) 2) (apply char-ci>=? args)))
+ (define* (char-not-greaterp . args) (or (< (length args) 2) (apply char-ci<=? args)))
+
+ (define (char/= . args)
+ (if (null? (cdr args))
+ #t
+ (if (member (car args) (cdr args))
+ #f
+ (apply char/= (cdr args)))))
+
+ (define (char-not-equal . args)
+ (if (null? (cdr args))
+ #t
+ (if (or (member (char-upcase (car args)) (cdr args))
+ (member (char-downcase (car args)) (cdr args)))
+ #f
+ (apply char-not-equal (cdr args)))))
+
+ (define char-code char->integer)
+ (define code-char integer->char)
+
+ (define (character c)
+ (if (char? c)
+ c
+ (if (integer? c)
+ (integer->char c)
+ (if (string? c)
+ (c 0)
+ (if (symbol? c)
+ ((symbol->string c) 0))))))
+
+ ;; char-upcase and char-downcase are ok
+ (define char-int char->integer)
+ (define int-char integer->char)
+
+ (define* (digit-char w (radix 10))
+ (let ((str (number->string w radix)))
+ (and str (= (length str) 1) (str 0))))
+
+ (define (both-case-p c) "unimplemented")
+ (define (standard-char-p c) "unimplemented")
+ (define (char-name c) "unimplemented")
+ (define (name-char s) "unimplemented")
+
+ ;; --------
+
+ (define terpri newline)
+
+
+ ;; -------- types
+
+ (define vectorp vector?)
+ (define simple-vector-p vector?)
+ (define symbolp symbol?)
+ (define (atom obj) (not (pair? obj)))
+ (define consp pair?)
+ (define (listp obj) (or (null? obj) (pair? obj)))
+ (define numberp number?)
+ (define integerp integer?)
+ (define rationalp rational?)
+ (define (floatp l) (and (number? l) (not (rational? l)) (zero? (imag-part l)))) ; clisp
+ (define (complexp l) (and (complex? l) (not (real? l))))
+ (define realp real?)
+ (define characterp char?)
+ (define stringp string?)
+ (define simple-string-p string?)
+ (define arrayp vector?)
+ (define simple-bit-vector-p vector?)
+ (define keywordp keyword?)
+ (define functionp procedure?)
+
+ (define symbol-value symbol->value)
+ (define symbol-function symbol->value)
+ (define fdefinition symbol->value)
+ (define boundp defined?)
+ (define fboundp defined?)
+ (define (funcall fn . arguments) (apply fn arguments))
+ (define-constant call-arguments-limit 65536)
+
+
+ ;; --------
(define progn begin)
(define-macro (prog1 first . body) (let ((result (gensym))) `(let ((,result ,first)) , at body ,result)))
(define-macro (prog2 first second . body) `(prog1 (progn ,first ,second) , at body))
- (defmacro the (type form) form)
+ (define-macro (the type form) form)
(define-macro (defvar var . args) `(define ,var (or ,(and (not (null? args)) (car args)) #f)))
- (defmacro incf (sym . val) `(let () (set! ,sym (+ ,sym ,(if (null? val) 1 (car val)))) ,sym))
- (defmacro decf (sym . val) `(let () (set! ,sym (- ,sym ,(if (null? val) 1 (car val)))) ,sym))
+ (define-macro* (incf sym (inc 1))
+ `(set! ,sym (+ ,sym ,inc)))
+
+ (define-macro* (decf sym (dec 1))
+ `(set! ,sym (- ,sym ,dec)))
+
+ ;; the simple version seems to work ok, but just for lafs:
+ (define incf-b
+ (let ((arg (gensym))
+ (inc (gensym))
+ (name (gensym)))
+ (apply define-bacro* `((,name ,arg (,inc 1))
+ `(set! ,,arg (+ ,,arg ,,inc))))))
- (defmacro push (val sym)
- `(let ()
- (setf ,sym (cons ,val ,sym))
- ,sym))
+ (define-macro (push val sym)
+ `(setf ,sym (cons ,val ,sym)))
- (defmacro pop (sym)
+ (define-macro (pop sym)
(let ((v (gensym)))
`(let ((,v (car ,sym)))
(setf ,sym (cdr ,sym))
,v)))
- (defmacro* pushnew (val sym (test equal?) (key identity))
+ (define-macro* (pushnew val sym (test equal?) (key identity))
(let ((g (gensym))
(k (if (procedure? key) key identity))) ; can be explicit nil!
`(let ((,g ,val))
@@ -22814,9 +39129,8 @@ abs 1 2
(push ,g ,sym))
,sym)))
- (defmacro unless (test . forms) `(if (not ,test) (begin , at forms)))
(define-macro (declare . args) #f)
- (defmacro set (a b) `(set! ,(symbol->value a) ,b))
+ (define-macro (set a b) `(set! ,(symbol->value a) ,b))
(define-macro (setf . pairs)
(if (not (even? (length pairs)))
@@ -22840,7 +39154,7 @@ abs 1 2
val)
(begin
(set! var p)
- '())))
+ ())))
pairs))))
(define-macro (setq . pairs)
@@ -22854,12 +39168,12 @@ abs 1 2
val)
(begin
(set! var p)
- '())))
+ ())))
pairs))))
(define-macro (psetq . pairs)
- (let ((vals '())
- (vars '()))
+ (let ((vals ())
+ (vars ()))
(do ((var-val pairs (cddr var-val)))
((null? var-val))
(let ((interval (gensym)))
@@ -22873,36 +39187,32 @@ abs 1 2
;; and args can be any sequence type (all mixed together)
(define (mapcar-seqs func seqs)
(if (null? seqs)
- '()
+ ()
(cons (func (car seqs))
(mapcar-seqs func (cdr seqs)))))
(define (mapcar-1 index lens func seqs)
(if (member index lens)
- '()
+ ()
(cons (apply func (mapcar-seqs (lambda (obj) (obj index)) seqs))
(mapcar-1 (+ index 1) lens func seqs))))
(let ((lens (map length lists)))
(mapcar-1 0 lens func lists)))
-#|
-(define (mapcar func . lists)
- ;; not scheme's map because lists can be different lengths
- (if (member '() lists)
- '()
- (cons (apply func (map car lists))
- (apply mapcar func (map cdr lists)))))
-|#
+
+ ;; (define (mapcar func . lists)
+ ;; not scheme's map because lists can be different lengths
+ ;; (if (member () lists) () (cons (apply func (map car lists)) (apply mapcar func (map cdr lists)))))
(define (maplist function . lists)
- (if (member '() lists)
- '()
+ (if (member () lists)
+ ()
(cons (apply function lists)
(apply maplist function (map cdr lists)))))
(define (mapc function . lists)
(define (mapc-1 function . lists)
- (if (not (member '() lists))
+ (if (not (member () lists))
(begin
(apply function (map car lists))
(apply mapc-1 function (map cdr lists)))))
@@ -22911,7 +39221,7 @@ abs 1 2
(define (mapl function . lists)
(define (mapl-1 function . lists)
- (if (not (member '() lists))
+ (if (not (member () lists))
(begin
(apply function lists)
(apply mapl-1 function (map cdr lists)))))
@@ -22940,25 +39250,61 @@ abs 1 2
(define output-stream-p output-port?)
+ ;; -------- vectors
+
+ ;; vector is ok
+
+ (define svref vector-ref)
+ (define aref vector-ref)
+ (define array-dimensions vector-dimensions)
+ (define array-total-size vector-length)
+ (define (array-dimension array num) (list-ref (vector-dimensions array) num))
+
+ (define-constant array-dimension-limit 16777215)
+ (define-constant array-rank-limit 4096)
+ (define-constant array-total-size-limit 16777215)
+
+ (define* (make-array dimensions element-type initial-element initial-contents adjustable fill-pointer displaced-to displaced-index-offset)
+ (if (eq? element-type 'character)
+ (or (and initial-contents
+ (string-copy initial-contents))
+ (cl-make-string dimensions initial-element))
+ (make-vector (or dimensions 1) initial-element)))
+
+ (define (array-in-bounds-p array . subscripts)
+ (define (in-bounds dims subs)
+ (or (null? subs)
+ (null? dims)
+ (and (< (car subs) (car dims))
+ (in-bounds (cdr dims) (cdr subs)))))
+ (in-bounds (vector-dimensions array) subscripts))
+
+ (define (row-major-index array . subscripts)
+ (apply + (maplist (lambda (x y)
+ (* (car x) (apply * (cdr y))))
+ subscripts
+ (vector-dimensions array))))
+
+
;; -------- lists
- ;; in CL (cdr '()) is nil
-
- (define (first l) (if (not (null? l)) (list-ref l 0) '()))
- (define (second l) (if (> (length l) 1) (list-ref l 1) '()))
- (define (third l) (if (> (length l) 2) (list-ref l 2) '()))
- (define (fourth l) (if (> (length l) 3) (list-ref l 3) '()))
- (define (fifth l) (if (> (length l) 4) (list-ref l 4) '()))
- (define (sixth l) (if (> (length l) 5) (list-ref l 5) '()))
- (define (seventh l) (if (> (length l) 6) (list-ref l 6) '()))
- (define (eighth l) (if (> (length l) 7) (list-ref l 7) '()))
- (define (ninth l) (if (> (length l) 8) (list-ref l 8) '()))
- (define (tenth l) (if (> (length l) 9) (list-ref l 9) '()))
- (define (nth n l) (if (< n (length l)) (list-ref l n) '()))
+ ;; in CL (cdr ()) is nil
+
+ (define (first l) (if (not (null? l)) (list-ref l 0) ()))
+ (define (second l) (if (> (length l) 1) (list-ref l 1) ()))
+ (define (third l) (if (> (length l) 2) (list-ref l 2) ()))
+ (define (fourth l) (if (> (length l) 3) (list-ref l 3) ()))
+ (define (fifth l) (if (> (length l) 4) (list-ref l 4) ()))
+ (define (sixth l) (if (> (length l) 5) (list-ref l 5) ()))
+ (define (seventh l) (if (> (length l) 6) (list-ref l 6) ()))
+ (define (eighth l) (if (> (length l) 7) (list-ref l 7) ()))
+ (define (ninth l) (if (> (length l) 8) (list-ref l 8) ()))
+ (define (tenth l) (if (> (length l) 9) (list-ref l 9) ()))
+ (define (nth n l) (if (< n (length l)) (list-ref l n) ()))
(define (endp val) (if (null? val) #t (if (pair? val) #f (error "bad arg to endp"))))
(define rest cdr)
(define list-length length)
- (define* (cl-make-list size (initial-element '())) (make-list size initial-element))
+ (define* (cl-make-list size (initial-element ())) (make-list size initial-element))
(define (copy-list lis)
(if (not (pair? lis))
@@ -22977,8 +39323,8 @@ abs 1 2
(define* (butlast lis (n 1))
(let ((len (length lis)))
(if (<= len n)
- '()
- (let ((result '()))
+ ()
+ (let ((result ()))
(do ((i 0 (+ i 1))
(lst lis (cdr lst)))
((= i (- len n)) (reverse result))
@@ -23009,20 +39355,6 @@ abs 1 2
(define (acons key datum alist) (cons (cons key datum) alist))
- (define* (subst-if new test tree (key identity))
- (if (test (key tree))
- new
- (if (not (pair? tree))
- tree
- (cons (subst-if new test (car tree) key)
- (subst-if new test (cdr tree) key)))))
-
- (define* (subst-if-not new test tree (key identity))
- (subst-if new (lambda (obj) (not (test obj))) tree key))
-
- (define* (subst new old tree (test eql) (key identity))
- (subst-if new (lambda (obj) (test old obj)) tree key))
-
(define (list* obj1 . objs)
(define (list-1 obj)
(if (null? (cdr obj))
@@ -23034,7 +39366,7 @@ abs 1 2
(define* (assoc-if predicate alist (key car))
(if (null? alist)
- '()
+ ()
(if (and (not (null? (car alist)))
(predicate (key (car alist))))
(car alist)
@@ -23048,8 +39380,8 @@ abs 1 2
(define* (rassoc-if predicate alist (key cdr))
(if (null? alist)
- '()
- (if (and (not (null? (car alist)))
+ ()
+ (if (and (pair? (car alist))
(predicate (key (car alist))))
(car alist)
(rassoc-if predicate (cdr alist) key))))
@@ -23062,7 +39394,7 @@ abs 1 2
(define (copy-alist alist)
(if (null? alist)
- '()
+ ()
(cons (if (pair? (car alist))
(cons (caar alist) (cdar alist))
(car alist))
@@ -23074,7 +39406,7 @@ abs 1 2
(define* (pairlis keys data alist)
(if (not (= (length keys) (length data)))
(error "pairlis keys and data lists should have the same length"))
- (let ((lst (or alist '())))
+ (let ((lst (or alist ())))
(if (null? keys)
lst
(do ((key keys (cdr key))
@@ -23104,24 +39436,159 @@ abs 1 2
subtree)))))
(sub tree))
- (define* (nsubst-if new predicate tree (key identity)) ; sacla
- (define (sub subtree)
- (if (predicate (key subtree))
+ (let ()
+ (define* (subst-if new test tree (key identity))
+ (if (test (key tree))
new
- (if (not (pair? subtree))
- subtree
- (let ()
- (set-car! subtree (sub (car subtree)))
- (set-cdr! subtree (sub (cdr subtree)))
- subtree))))
- (sub tree))
-
- (define* (nsubst-if-not new predicate tree (key identity))
- (nsubst-if new (lambda (obj) (not (predicate obj))) tree key))
-
- (define* (nsubst new old tree (test eql) (key identity))
- (nsubst-if new (lambda (obj) (test old obj)) tree key))
-
+ (if (not (pair? tree))
+ tree
+ (cons (subst-if new test (car tree) key)
+ (subst-if new test (cdr tree) key)))))
+
+ (define* (subst-if-not new test tree (key identity))
+ (subst-if new (lambda (obj) (not (test obj))) tree key))
+
+ (define* (subst new old tree (test eql) (key identity))
+ (subst-if new (lambda (obj) (test old obj)) tree key))
+
+ (define* (nsubst-if new predicate tree (key identity)) ; sacla
+ (define (sub subtree)
+ (if (predicate (key subtree))
+ new
+ (if (not (pair? subtree))
+ subtree
+ (let ()
+ (set-car! subtree (sub (car subtree)))
+ (set-cdr! subtree (sub (cdr subtree)))
+ subtree))))
+ (sub tree))
+
+ (define* (nsubst-if-not new predicate tree (key identity))
+ (nsubst-if new (lambda (obj) (not (predicate obj))) tree key))
+
+ (define* (nsubst new old tree (test eql) (key identity))
+ (nsubst-if new (lambda (obj) (test old obj)) tree key))
+
+ (test-t (let ((tree '(old (old) ((old))))) (equal (subst 'new 'old tree) '(new (new) ((new))))))
+ (test-t (eq (subst 'new 'old 'old) 'new))
+ (test-t (eq (subst 'new 'old 'not-old) 'not-old))
+ (test-t (equal (subst 'new '(b) '(a ((b))) :test equal) '(a (new))))
+ (test-t (equal (subst 'x 3 '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
+ (test-t (equal (subst 'x "D" '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+ :test equalp
+ :key (lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") x)))
+ (test-t (equal (subst-if 'new (lambda (x) (eq x 'old)) '(old old)) '(new new)))
+ (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
+ (test-t (equal (subst-if 'x (lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
+ (test-t (let ((tree '(old (old) ((old))))) (equal (subst-if 'new (lambda (x) (eq x 'old)) tree) '(new (new) ((new))))))
+ (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
+ (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'not-old) 'not-old))
+ (test-t (equal (subst-if 'new (lambda (x) (equal x '(b))) '(a ((b)))) '(a (new))))
+ (test-t (equal (subst-if 'x (lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
+ (test-t (equal (subst-if 'x
+ (lambda (x) (equalp x "D"))
+ '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+ :key (lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") x)))
+ (test-t (equal (subst-if-not 'new (lambda (x) (not (eq x 'old))) '(old old)) '(new new)))
+ (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
+ (test-t (equal (subst-if-not 'x (lambda (x) (not (eql x 3)))
+ '(1 (1 2) (1 2 3) (1 2 3 4))
+ :key (lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x)))
+ (test-t (let ((tree '(old (old) ((old)))))
+ (equal (subst-if-not 'new (lambda (x) (not (eq x 'old))) tree)
+ '(new (new) ((new))))))
+ (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
+ (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'not-old) 'not-old))
+ (test-t (equal (subst-if-not 'new (lambda (x) (not (equal x '(b)))) '(a ((b)))) '(a (new))))
+ (test-t (equal (subst-if-not 'x
+ (lambda (x) (not (eql x 3)))
+ '(1 (1 2) (1 2 3) (1 2 3 4))
+ :key (lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x)))
+ (test-t (equal (subst-if-not 'x
+ (lambda (x) (not (equalp x "D")))
+ '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
+ :key (lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") x)))
+ (test-t (let ((tree '(old (old) ((old)))))
+ (equal (nsubst 'new 'old (copy-tree tree))
+ '(new (new) ((new))))))
+ (test-t (let* ((tree (copy-tree '(old (old) ((old)))))
+ (new-tree (nsubst 'new 'old tree)))
+ (and (eq tree new-tree)
+ (equal tree '(new (new) ((new)))))))
+ (test-t (eq (nsubst 'new 'old 'old) 'new))
+ (test-t (eq (nsubst 'new 'old 'not-old) 'not-old))
+ (test-t (equal (nsubst 'new '(b) (copy-tree '(a ((b)))) :test equal) '(a (new))))
+ (test-t (equal (nsubst 'x 3 (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key (lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x)))
+ (test-t (equal (nsubst 'x "D"
+ (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+ :test equalp
+ :key (lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") x)))
+ (test-t (equal (nsubst-if 'new (lambda (x) (eq x 'old)) (list 'old 'old)) '(new new)))
+ (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
+ (test-t (let* ((x (copy-tree '(old (old) ((old)) (old) old)))
+ (y (nsubst-if 'new (lambda (x) (eq x 'old)) x)))
+ (and (eq x y)
+ (equal x '(new (new) ((new)) (new) new)))))
+ (test-t (equal (nsubst-if 'x
+ (lambda (x) (eql x 3))
+ (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key (lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x)))
+ (test-t (let ((tree '(old (old) ((old)))))
+ (equal (nsubst-if 'new (lambda (x) (eq x 'old)) (copy-tree tree))
+ '(new (new) ((new))))))
+ (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
+ (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'not-old) 'not-old))
+ (test-t (equal (nsubst-if 'new (lambda (x) (equal x '(b))) (copy-tree '(a ((b))))) '(a (new))))
+ (test-t (equal (nsubst-if 'x
+ (lambda (x) (eql x 3))
+ (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key (lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x)))
+ (test-t (equal (nsubst-if 'x
+ (lambda (x) (equalp x "D"))
+ (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+ :key (lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") x)))
+ (test-t (equal (nsubst-if-not 'new (lambda (x) (not (eq x 'old)))
+ (list 'old 'old))
+ '(new new)))
+ (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
+ (test-t (let* ((x (copy-tree '(old (old) ((old)) (old) old)))
+ (y (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) x)))
+ (and (eq x y)
+ (equal x '(new (new) ((new)) (new) new)))))
+ (test-t (equal (nsubst-if-not 'x (lambda (x) (not (eql x 3)))
+ (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key (lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x)))
+ (test-t (let ((tree '(old (old) ((old)))))
+ (equal (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) (copy-tree tree))
+ '(new (new) ((new))))))
+ (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
+ (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'not-old) 'not-old))
+ (test-t (equal (nsubst-if-not 'new (lambda (x) (not (equal x '(b)))) (copy-tree '(a ((b))))) '(a (new))))
+ (test-t (equal (nsubst-if-not 'x
+ (lambda (x) (not (eql x 3)))
+ (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
+ :key (lambda (y) (and (listp y) (third y))))
+ '(1 (1 2) x x)))
+ (test-t (equal
+ (nsubst-if-not 'x
+ (lambda (x) (not (equalp x "D")))
+ (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
+ :key (lambda (y) (and (listp y) (fourth y))))
+ '("a" ("a" "b") ("a" "b" "c") x)))
+ )
+
(define (ldiff lst object) ; sacla
(if (not (eqv? lst object))
(let* ((result (list (car lst)))
@@ -23131,16 +39598,16 @@ abs 1 2
(do ((l (cdr lst) (cdr l)))
((not (pair? l))
(if (eql l object)
- (set-cdr! splice '()))
+ (set-cdr! splice ()))
result)
(if (eqv? l object)
(return result)
(set! splice (cdr (rplacd splice (list (car l))))))))))
- '()))
-
+ ()))
+
(define* (member-if predicate list (key identity))
(if (null? list)
- '()
+ ()
(if (predicate (key (car list)))
list
(member-if predicate (cdr list) key))))
@@ -23150,7 +39617,7 @@ abs 1 2
(define* (cl-member item list (test eql) (key identity))
(if (null? list)
- '()
+ ()
(if (test item (key (car list)))
list
(cl-member item (cdr list) test key))))
@@ -23165,56 +39632,10 @@ abs 1 2
(and (not (null? list))
(tailp sublist (cdr list)))))
- (define* (union list1 list2 (test eql) (key identity))
- (let ((new-list (copy list1)))
- (do ((obj list2 (cdr obj)))
- ((null? obj) new-list)
- (set! new-list (adjoin (car obj) new-list test key)))))
-
- (define nunion union) ; this is not required to be destructive
-
- (define* (intersection list1 list2 (test eql) (key identity))
- (let ((new-list '()))
- (do ((obj list1 (cdr obj)))
- ((null? obj) new-list)
- (if (not (null? (cl-member (key (car obj)) list2 test key)))
- (set! new-list (adjoin (car obj) new-list test key))))))
-
- (define nintersection intersection)
-
- (define* (set-difference list1 list2 (test eql) (key identity))
- (let ((new-list '()))
- (do ((obj list1 (cdr obj)))
- ((null? obj) new-list)
- (if (null? (cl-member (key (car obj)) list2 test key))
- (set! new-list (adjoin (car obj) new-list test key))))))
-
- (define nset-difference set-difference)
-
- (define* (set-exclusive-or list1 list2 (test eql) (key identity))
- (let ((new-list '()))
- (do ((obj list1 (cdr obj)))
- ((null? obj))
- (if (null? (cl-member (key (car obj)) list2 test key))
- (set! new-list (adjoin (car obj) new-list test key))))
- (do ((obj list2 (cdr obj)))
- ((null? obj) new-list)
- (if (null? (cl-member (key (car obj)) list1 test key))
- (set! new-list (adjoin (car obj) new-list test key))))))
-
- (define nset-exclusive-or set-exclusive-or)
-
- (define* (subsetp list1 list2 (test eql) (key identity))
- (call-with-exit
- (lambda (return)
- (do ((obj list1 (cdr obj)))
- ((null? obj) #t)
- (if (null? (cl-member (key (car obj)) list2 test key))
- (return nil))))))
(define* (nbutlast list (n 1)) ; sacla
(if (null? list)
- '()
+ ()
(let ((length (do ((p (cdr list) (cdr p))
(i 1 (+ i 1)))
((not (pair? p)) i))))
@@ -23223,21 +39644,21 @@ abs 1 2
(2nd list 1st)
(count (- length n 1) (- count 1)))
((zero? count)
- (set-cdr! 2nd '())
+ (set-cdr! 2nd ())
list))
- '()))))
+ ()))))
(define (nconc . lists) ; sacla sort of
(let ((ls (let ()
(define (strip-nulls lst)
(if (null? lst)
- '()
+ ()
(if (null? (car lst))
(strip-nulls (cdr lst))
lst)))
(strip-nulls lists))))
(if (null? ls)
- '()
+ ()
(let* ((top (car ls))
(splice top))
(do ((here (cdr ls) (cdr here)))
@@ -23250,333 +39671,230 @@ abs 1 2
- ;; -------- numbers
-
- (define (conjugate z) (make-rectangular (real-part z) (- (imag-part z))))
- (define zerop zero?)
- (define oddp odd?)
- (define evenp even?)
- (define plusp positive?)
- (define minusp negative?)
- (define realpart real-part)
- (define imagpart imag-part)
- (define* (float x ignore) (* 1.0 x))
- (define rational rationalize)
- (define mod modulo)
- (define rem remainder)
-
- (define (logtest i1 i2) (not (zero? (logand i1 i2))))
- (define (logbitp index integer) (logtest (expt 2 index) integer))
- (define (lognand n1 n2) (lognot (logand n1 n2)))
- (define (lognor n1 n2) (lognot (logior n1 n2)))
- (define (logandc1 n1 n2) (logand (lognot n1) n2))
- (define (logandc2 n1 n2) (logand n1 (lognot n2)))
- (define (logorc1 n1 n2) (logior (lognot n1) n2))
- (define (logorc2 n1 n2) (logior n1 (logior n2)))
- (define (logeqv . ints) (lognot (apply logxor ints)))
-
- ;; from slib
- (define (logcount n)
- (define bitwise-bit-count
- (letrec ((logcnt (lambda (n tot)
- (if (zero? n)
- tot
- (logcnt (quotient n 16)
- (+ (vector-ref
- '#(0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4)
- (modulo n 16))
- tot))))))
- (lambda (n)
- (cond ((negative? n) (lognot (logcnt (lognot n) 0)))
- ((positive? n) (logcnt n 0))
- (else 0)))))
- (cond ((negative? n) (bitwise-bit-count (lognot n)))
- (else (bitwise-bit-count n))))
-
- (define-constant boole-clr 0)
- (define-constant boole-set 1)
- (define-constant boole-1 2)
- (define-constant boole-2 3)
- (define-constant boole-c1 4)
- (define-constant boole-c2 5)
- (define-constant boole-and 6)
- (define-constant boole-ior 7)
- (define-constant boole-xor 8)
- (define-constant boole-eqv 9)
- (define-constant boole-nand 10)
- (define-constant boole-nor 11)
- (define-constant boole-andc1 12)
- (define-constant boole-andc2 13)
- (define-constant boole-orc1 14)
- (define-constant boole-orc2 15)
-
- (define (boole op int1 int2)
- (cond
- ((= op boole-clr) 0)
- ((= op boole-set) -1) ;; all ones -- "always 1" is misleading
- ((= op boole-1) int1)
- ((= op boole-2) int2)
- ((= op boole-c1) (lognot int1))
- ((= op boole-c2) (lognot int2))
- ((= op boole-and) (logand int1 int2))
- ((= op boole-ior) (logior int1 int2))
- ((= op boole-xor) (logxor int1 int2))
- ((= op boole-eqv) (logeqv int1 int2))
- ((= op boole-nand) (lognot (logand int1 int2)))
- ((= op boole-nor) (lognot (logior int1 int2)))
- ((= op boole-andc1) (logand (lognot int1) int2))
- ((= op boole-andc2) (logand int1 (lognot int2)))
- ((= op boole-orc1) (logior (lognot int1) int2))
- ((= op boole-orc2) (logior int1 (lognot int2)))))
-
- ;; from Rick
- (define (byte siz pos)
- ;; cache size, position and mask.
- (list siz pos (ash (- (ash 1 siz) 1) pos)))
-
- (define (byte-size bytespec) (car bytespec))
- (define (byte-position bytespec) (cadr bytespec))
- (define (byte-mask bytespec) (caddr bytespec))
-
- (define (ldb bytespec integer)
- (ash (logand integer (byte-mask bytespec))
- (- (byte-position bytespec))))
-
- (define (dpb integer bytespec into)
- (logior (ash (logand integer (- (ash 1 (byte-size bytespec)) 1)) (byte-position bytespec))
- (logand into (lognot (byte-mask bytespec)))))
-
- (define (ldb-test byte int) (not (zero? (ldb byte int))))
- (define (mask-field byte int) (logand int (dpb -1 byte 0)))
- (define (deposit-field byte spec int) (logior (logand byte (byte-mask spec)) (logand int (lognot (byte-mask spec)))))
- (define (scale-float x k) (* x (expt 2.0 k)))
-
- ;; from clisp -- can't see any point to most of these
- (define-constant double-float-epsilon 1.1102230246251568e-16)
- (define-constant double-float-negative-epsilon 5.551115123125784e-17)
- (define-constant least-negative-double-float -2.2250738585072014e-308)
- (define-constant least-negative-long-float -5.676615526003731344e-646456994)
- (define-constant least-negative-normalized-double-float -2.2250738585072014e-308)
- (define-constant least-negative-normalized-long-float -5.676615526003731344e-646456994)
- (define-constant least-negative-normalized-short-float -1.1755e-38)
- (define-constant least-negative-normalized-single-float -1.1754944e-38)
- (define-constant least-negative-short-float -1.1755e-38)
- (define-constant least-negative-single-float -1.1754944e-38)
- (define-constant least-positive-double-float 2.2250738585072014e-308)
- (define-constant least-positive-long-float 5.676615526003731344e-646456994)
- (define-constant least-positive-normalized-double-float 2.2250738585072014e-308)
- (define-constant least-positive-normalized-long-float 5.676615526003731344e-646456994)
- (define-constant least-positive-normalized-short-float 1.1755e-38)
- (define-constant least-positive-normalized-single-float 1.1754944e-38)
- (define-constant least-positive-short-float 1.1755e-38)
- (define-constant least-positive-single-float 1.1754944e-38)
- (define-constant long-float-epsilon 5.4210108624275221706e-20)
- (define-constant long-float-negative-epsilon 2.7105054312137610853e-20)
- (define-constant most-negative-double-float -1.7976931348623157e308)
- ;; most-negative-fixnum
- (define-constant most-negative-long-float -8.8080652584198167656e646456992)
- (define-constant most-negative-short-float -3.4028e38)
- (define-constant most-negative-single-float -3.4028235e38)
- (define-constant most-positive-double-float 1.7976931348623157e308)
- ;; most-positive-fixnum
- (define-constant most-positive-long-float 8.8080652584198167656e646456992)
- (define-constant most-positive-short-float 3.4028e38)
- (define-constant most-positive-single-float 3.4028235e38)
- (define-constant short-float-epsilon 7.6295e-6)
- (define-constant short-float-negative-epsilon 3.81476e-6)
- (define-constant single-float-epsilon 5.960465e-8)
- (define-constant single-float-negative-epsilon 2.9802326e-8)
-
- (define (lisp-implementation-type) "s7")
- (define (lisp-implementation-version) (s7-version))
- (define (software-type) "s7")
- (define (software-version) (s7-version))
-
- (define (machine-version)
- (if (and (defined? 'file-exists?)
- (file-exists? "/proc/cpuinfo"))
- (call-with-input-file "/proc/cpuinfo"
- (lambda (cpufile)
- (do ((line (read-line cpufile) (read-line cpufile)))
- ((or (eof-object? line)
- (string=? (substring line 0 10) "model name"))
- (if (string? line)
- (string-trim " " (substring line (+ 1 (position #\: line))))
- "unknown")))))
- "unknown"))
-
- ;; = < <= > >= are the same, also min max + - * / lcm gcd exp expt log sqrt
- ;; sin cos tan acos asin atan pi sinh cosh tanh asinh acosh atanh
- ;; numerator denominator logior logxor logand ash integer-length random
-
- ;; slightly different: floor ceiling truncate round and the ff cases thereof
- ;; abs of complex -> magnitude
- (define (cl-abs x) (if (not (zero? (imag-part x))) (magnitude x) (abs x)))
-
- ;; these actually return multiple values
- (define* (cl-floor x (divisor 1)) (floor (/ x divisor)))
- (define* (cl-ceiling x (divisor 1)) (ceiling (/ x divisor)))
- (define* (cl-truncate x (divisor 1)) (truncate (/ x divisor)))
- (define* (cl-round x (divisor 1)) (round (/ x divisor)))
- (define* (ffloor x divisor) (* 1.0 (cl-floor x divisor)))
- (define* (fceling x divisor) (* 1.0 (cl-ceiling x divisor)))
- (define* (ftruncate x divisor) (* 1.0 (cl-truncate x divisor)))
- (define* (fround x divisor) (* 1.0 (cl-round x divisor)))
-
- (define (/= . args)
- (if (null? (cdr args))
- #t
- (if (member (car args) (cdr args))
- #f
- (apply /= (cdr args)))))
-
- (define (1+ x) (+ x 1))
- (define (1- x) (- x 1))
- (define (isqrt x) (floor (sqrt x)))
- (define phase angle)
- (define* (complex rl (im 0.0)) (make-rectangular rl im))
- (define (signum x) (if (zerop x) x (/ x (abs x))))
- (define (cis x) (exp (make-rectangular 0.0 x)))
-
-
- ;; -------- characters
-
- (define char-code-limit 256)
- (define alpha-char-p char-alphabetic?)
- (define upper-case-p char-upper-case?)
- (define lower-case-p char-lower-case?)
- (define* (digit-char-p c (radix 10)) (string->number (string c) radix))
- (define (alphanumericp c) (or (char-alphabetic? c) (char-numeric? c)))
-
- (define* (char= . args) (or (< (length args) 2) (apply char=? args)))
- (define* (char< . args) (or (< (length args) 2) (apply char<? args)))
- (define* (char<= . args) (or (< (length args) 2) (apply char<=? args)))
- (define* (char> . args) (or (< (length args) 2) (apply char>? args)))
- (define* (char>= . args) (or (< (length args) 2) (apply char>=? args)))
- (define* (char-equal . args) (or (< (length args) 2) (apply char-ci=? args)))
- (define* (char-lessp . args) (or (< (length args) 2) (apply char-ci<? args)))
- (define* (char-greaterp . args) (or (< (length args) 2) (apply char-ci>? args)))
- (define* (char-not-lessp . args) (or (< (length args) 2) (apply char-ci>=? args)))
- (define* (char-not-greaterp . args) (or (< (length args) 2) (apply char-ci<=? args)))
-
- (define (char/= . args)
- (if (null? (cdr args))
- #t
- (if (member (car args) (cdr args))
- #f
- (apply char/= (cdr args)))))
-
- (define (char-not-equal . args)
- (if (null? (cdr args))
- #t
- (if (or (member (char-upcase (car args)) (cdr args))
- (member (char-downcase (car args)) (cdr args)))
- #f
- (apply char-not-equal (cdr args)))))
-
- (define char-code char->integer)
- (define code-char integer->char)
-
- (define (character c)
- (if (char? c)
- c
- (if (integer? c)
- (integer->char c)
- (if (string? c)
- (c 0)
- (if (symbol? c)
- ((symbol->string c) 0))))))
-
- ;; char-upcase and char-downcase are ok
- (define char-int char->integer)
- (define int-char integer->char)
-
- (define* (digit-char w (radix 10))
- (let ((str (number->string w radix)))
- (and str (= (length str) 1) (str 0))))
-
- (define (both-case-p c) "unimplemented")
- (define (standard-char-p c) "unimplemented")
- (define (char-name c) "unimplemented")
- (define (name-char s) "unimplemented")
-
- ;; --------
-
- (define terpri newline)
-
-
- ;; -------- types
-
- (define vectorp vector?)
- (define simple-vector-p vector?)
- (define symbolp symbol?)
- (define (atom obj) (not (pair? obj)))
- (define consp pair?)
- (define (null obj) (or (not obj) (null? obj)))
- (define (listp obj) (or (null? obj) (pair? obj)))
- (define numberp number?)
- (define integerp integer?)
- (define rationalp rational?)
- (define (floatp l) (and (number? l) (not (rational? l)) (zero? (imag-part l)))) ; clisp
- (define (complexp l) (and (complex? l) (not (real? l))))
- (define realp real?)
- (define characterp char?)
- (define stringp string?)
- (define simple-string-p string?)
- (define arrayp vector?)
- (define simple-bit-vector-p vector?)
- (define keywordp keyword?)
- (define functionp procedure?)
-
- (define-constant t #t)
- (define-constant nil '())
-
- (define eq eq?)
- (define eql eqv?)
- (define equal equal?)
-
- (define (equalp x y)
- (or (equal x y)
- (and (char? x) (char? y) (char-ci=? x y))
- (and (number? x) (number? y) (= x y))
- (and (string? x) (string? y) (string-ci=? x y))))
-
- (define symbol-value symbol->value)
- (define symbol-function symbol->value)
- (define fdefinition symbol->value)
- (define boundp defined?)
- (define fboundp defined?)
- (define (funcall fn . arguments) (apply fn arguments))
- (define-constant call-arguments-limit 65536)
-
- (define (identity x) x)
-
;; -------- sequences
- (define* (count-if predicate sequence from-end (start 0) end (key identity))
- (let* ((counts 0)
- (len (length sequence))
- (nd (or (and (number? end) end) len))) ; up to but not including end
- (if (< nd start)
- (error "count-if :start ~A is greater than ~A ~A" start (if end ":end" "length") nd))
- (if (not from-end)
- (do ((i start (+ i 1)))
- ((= i nd))
- (if (predicate (key (sequence i)))
- (set! counts (+ counts 1))))
- (do ((i (- nd 1) (- i 1)))
- ((< i start))
- (if (predicate (key (sequence i)))
- (set! counts (+ counts 1)))))
- counts))
-
- (define* (count-if-not predicate sequence from-end (start 0) end (key identity))
- (count-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
-
- (define* (count item sequence from-end (test eql) (start 0) end (key identity))
- (count-if (lambda (arg) (test item arg)) sequence from-end start end key))
+ (define-macro (with-iterator it . body)
+ `(let ((,(car it) (let ((f (make-iterator ,(cadr it)))
+ (iterator? #t))
+ (lambda ()
+ (let ((val (f)))
+ (and val (values #t (car val) (cdr val))))))))
+ , at body))
+ (define hash-table-p hash-table?)
+ (define* (gethash k h (d ())) (or (hash-table-ref k h) d))
+ (define maphash map)
+ (define clrhash fill!)
+ (define hash-table-count hash-table-entries)
+ (let ()
+ (define* (count-if predicate sequence from-end (start 0) end (key identity))
+ (let* ((counts 0)
+ (len (length sequence))
+ (nd (or (and (number? end) end) len))) ; up to but not including end
+ (if (< nd start)
+ (error "count-if :start ~A is greater than ~A ~A" start (if end ":end" "length") nd))
+ (if (not from-end)
+ (do ((i start (+ i 1)))
+ ((= i nd))
+ (if (predicate (key (sequence i)))
+ (set! counts (+ counts 1))))
+ (do ((i (- nd 1) (- i 1)))
+ ((< i start))
+ (if (predicate (key (sequence i)))
+ (set! counts (+ counts 1)))))
+ counts))
+
+ (define* (count-if-not predicate sequence from-end (start 0) end (key identity))
+ (count-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
+
+ (define* (count item sequence from-end (test eql) (start 0) end (key identity))
+ (count-if (lambda (arg) (test item arg)) sequence from-end start end key))
+
+ (test-t (eql (count-if-not oddp '((1) (2) (3) (4)) :key car) 2))
+ (test-t (eql (count-if upper-case-p "The Crying of Lot 49" :start 4) 2))
+ ;(test-t (eql (count #\a (concatenate 'list "how many A's are there in here?")) 2))
+ (test-t (eql (count-if alpha-char-p "-a-b-c-0-1-2-3-4-") 3))
+ (test-t (eql (count-if alphanumericp "-a-b-c-0-1-2-3-4-") 8))
+ (test-t (eql (count nil (list t nil t nil t nil)) 3))
+ (test-t (eql (count nil (vector t nil t nil t nil)) 3))
+ (test-t (zerop (count 9 '(0 1 2 3 4))))
+ (test-t (zerop (count 'a '(0 1 2 3 4))))
+ (test-t (eql (count 0 '(0 0 0 0 0) :start 1) 4))
+ (test-t (eql (count 0 '(0 0 0 0 0) :start 1 :end nil) 4))
+ (test-t (eql (count 0 '(0 0 0 0 0) :start 2) 3))
+ (test-t (zerop (count 0 '(0 0 0 0) :start 0 :end 0)))
+ (test-t (zerop (count 0 '(0 0 0 0) :start 2 :end 2)))
+ (test-t (zerop (count 0 '(0 0 0 0) :start 4 :end 4)))
+ (test-t (eql (count 0 '(0 0 0 0) :start 2 :end 3) 1))
+ (test-t (eql (count #\a "abcABC" :test equalp) 2))
+ (test-t (eql (count #\a "abcABC" :test char-equal) 2))
+ (test-t (eql (count '(a) '((x) (y) (z) (a) (b) (c)) :test equalp) 1))
+ (test-t (eql (count 'a '((x) (y) (z) (a) (b) (c)) :key car :test eq) 1))
+ (test-t (eql (count nil '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr :test eq) 3))
+ (test-t (let ((list nil))
+ (and (eql (count 'a '(a b c d)
+ :test (lambda (a b) (setq list (cons b list)) (eq a b)))
+ 1)
+ (equal list '(d c b a)))))
+ (test-t (let ((list nil))
+ (and (eql (count 'a '(a b c d)
+ :test (lambda (a b) (setq list (cons b list)) (eq a b))
+ :from-end t)
+ 1)
+ (equal list '(a b c d)))))
+ (test-t (zerop (count 9 #(0 1 2 3 4))))
+ (test-t (zerop (count 'a #(0 1 2 3 4))))
+ (test-t (eql (count 0 #(0 0 0 0 0) :start 1) 4))
+ (test-t (eql (count 0 #(0 0 0 0 0) :start 1 :end nil) 4))
+ (test-t (eql (count 0 #(0 0 0 0 0) :start 2) 3))
+ (test-t (zerop (count 0 #(0 0 0 0) :start 0 :end 0)))
+ (test-t (zerop (count 0 #(0 0 0 0) :start 2 :end 2)))
+ (test-t (zerop (count 0 #(0 0 0 0) :start 4 :end 4)))
+ (test-t (eql (count 0 #(0 0 0 0) :start 2 :end 3) 1))
+ (test-t (eql (count '(a) #((x) (y) (z) (a) (b) (c)) :test equalp) 1))
+ (test-t (eql (count 'a #((x) (y) (z) (a) (b) (c)) :key car :test eq) 1))
+ (test-t (eql (count nil #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr :test eq) 3))
+ (test-t (let ((list nil))
+ (and (eql (count 'a #(a b c d)
+ :test (lambda (a b) (setq list (cons b list)) (eq a b)))
+ 1)
+ (equal list '(d c b a)))))
+ (test-t (let ((list nil))
+ (and (eql (count 'a #(a b c d)
+ :test (lambda (a b) (setq list (cons b list)) (eq a b))
+ :from-end t)
+ 1)
+ (equal list '(a b c d)))))
+ (test-t (eql (count-if null (list t nil t nil t nil)) 3))
+ (test-t (zerop (count-if (lambda (x) (eql x 9)) #(0 1 2 3 4))))
+ (test-t (zerop (count-if (lambda (a) (eq 'x a)) #(0 1 2 3 4))))
+ (test-t (eql (count-if zerop '(0 0 0 0 0) :start 1) 4))
+ (test-t (eql (count-if zerop '(0 0 0 0 0) :start 1 :end nil) 4))
+ (test-t (eql (count-if zerop '(0 0 0 0 0) :start 2) 3))
+ (test-t (zerop (count-if zerop '(0 0 0 0) :start 0 :end 0)))
+ (test-t (zerop (count-if zerop '(0 0 0 0) :start 2 :end 2)))
+ (test-t (zerop (count-if zerop '(0 0 0 0) :start 4 :end 4)))
+ (test-t (eql (count-if zerop '(0 0 0 0) :start 2 :end 3) 1))
+ (test-t (eql (count-if (lambda (x) (equalp #\a x)) "abcABC") 2))
+ (test-t (eql (count-if (lambda (x) (char-equal #\a x)) "abcABC") 2))
+ (test-t (eql (count-if (lambda (x) (equal x '(a))) '((x) (y) (z) (a) (b) (c))) 1))
+ (test-t (eql (count-if (lambda (x) (eq x 'a)) '((x) (y) (z) (a) (b) (c)) :key car) 1))
+ (test-t (eql (count-if null '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+ (test-t (eql (count-if (lambda (x) (equal x '(a))) '((x) (y) (z) (a) (b) (c))) 1))
+ (test-t (eql (count-if (lambda (x) (eq x 'a)) '((x) (y) (z) (a) (b) (c)) :key car) 1))
+ (test-t (eql (count-if null '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+ (test-t (let ((list nil))
+ (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
+ '(a b c d))
+ 1)
+ (equal list '(d c b a)))))
+ (test-t (let ((list nil))
+ (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
+ '(a b c d)
+ :from-end t)
+ 1)
+ (equal list '(a b c d)))))
+ (test-t (eql (count-if null (vector t nil t nil t nil)) 3))
+ (test-t (eql (count-if zerop #(0 0 0 0 0) :start 1) 4))
+ (test-t (eql (count-if zerop #(0 0 0 0 0) :start 1 :end nil) 4))
+ (test-t (eql (count-if zerop #(0 0 0 0 0) :start 2) 3))
+ (test-t (zerop (count-if zerop #(0 0 0 0) :start 0 :end 0)))
+ (test-t (zerop (count-if zerop #(0 0 0 0) :start 2 :end 2)))
+ (test-t (zerop (count-if zerop #(0 0 0 0) :start 4 :end 4)))
+ (test-t (eql (count-if zerop #(0 0 0 0) :start 2 :end 3) 1))
+ (test-t (eql (count-if (lambda (x) (equal x '(a))) #((x) (y) (z) (a) (b) (c))) 1))
+ (test-t (eql (count-if (lambda (x) (eq x 'a)) #((x) (y) (z) (a) (b) (c)) :key car) 1))
+ (test-t (eql (count-if null #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+ (test-t (eql (count-if (lambda (x) (equal x '(a))) #((x) (y) (z) (a) (b) (c))) 1))
+ (test-t (eql (count-if (lambda (x) (eq x 'a)) #((x) (y) (z) (a) (b) (c)) :key car) 1))
+ (test-t (eql (count-if null #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+ (test-t (let ((list nil))
+ (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
+ #(a b c d))
+ 1)
+ (equal list '(d c b a)))))
+ (test-t (let ((list nil))
+ (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
+ #(a b c d)
+ :from-end t)
+ 1)
+ (equal list '(a b c d)))))
+ (test-t (eql (count-if-not (complement null) (list t nil t nil t nil)) 3))
+ (test-t (zerop (count-if-not (lambda (x) (not (eql x 9))) #(0 1 2 3 4))))
+ (test-t (zerop (count-if-not (lambda (a) (not (eq 'x a))) #(0 1 2 3 4))))
+ (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 1) 4))
+ (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 1 :end nil) 4))
+ (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 2) 3))
+ (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 0 :end 0)))
+ (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 2 :end 2)))
+ (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 4 :end 4)))
+ (test-t (eql (count-if-not (complement zerop) '(0 0 0 0) :start 2 :end 3) 1))
+ (test-t (eql (count-if-not (lambda (x) (not (equalp #\a x))) "abcABC") 2))
+ (test-t (eql (count-if-not (lambda (x) (not (char-equal #\a x))) "abcABC") 2))
+ (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) '((x) (y) (z) (a) (b) (c))) 1))
+ (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) '((x) (y) (z) (a) (b) (c)) :key car) 1))
+ (test-t (eql (count-if-not (complement null) '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+ (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) '((x) (y) (z) (a) (b) (c))) 1))
+ (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) '((x) (y) (z) (a) (b) (c)) :key car) 1))
+ (test-t (eql (count-if-not (complement null) '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+ (test-t (let ((list nil))
+ (and (eql (count-if-not (lambda (x)
+ (setq list (cons x list))
+ (not (eq x 'a)))
+ '(a b c d))
+ 1)
+ (equal list '(d c b a)))))
+ (test-t (let ((list nil))
+ (and (eql (count-if-not (lambda (x)
+ (setq list (cons x list))
+ (not (eq x 'a)))
+ '(a b c d)
+ :from-end t)
+ 1)
+ (equal list '(a b c d)))))
+ (test-t (eql (count-if-not (complement null) (vector t nil t nil t nil)) 3))
+ (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 1) 4))
+ (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 1 :end nil) 4))
+ (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 2) 3))
+ (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 0 :end 0)))
+ (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 2 :end 2)))
+ (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 4 :end 4)))
+ (test-t (eql (count-if-not (complement zerop) #(0 0 0 0) :start 2 :end 3) 1))
+ (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) #((x) (y) (z) (a) (b) (c))) 1))
+ (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) #((x) (y) (z) (a) (b) (c)) :key car) 1))
+ (test-t (eql (count-if-not (complement null) #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+ (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) #((x) (y) (z) (a) (b) (c))) 1))
+ (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) #((x) (y) (z) (a) (b) (c)) :key car) 1))
+ (test-t (eql (count-if-not (complement null) #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
+ (test-t (let ((list nil))
+ (and (eql (count-if-not (lambda (x)
+ (setq list (cons x list))
+ (not (eq x 'a)))
+ #(a b c d))
+ 1)
+ (equal list '(d c b a)))))
+ (test-t (let ((list nil))
+ (and (eql (count-if-not (lambda (x)
+ (setq list (cons x list))
+ (not (eq x 'a)))
+ #(a b c d)
+ :from-end t)
+ 1)
+ (equal list '(a b c d)))))
+ (test (count-if zero? '(0 1 2 0)) 2)
+ (test (count-if-not zero? '(0 1 2 0 3)) 3)
+ (test (count-if zero? #(0 1 2 0)) 2)
+ (test (count-if zero? '((0 1) (1 0) (2 3) (0 1)) :key car) 2)
+ (test (count-if zero? '(0 1 2 0) :from-end #t) 2)
+ (test (count-if zero? '(0 1 2 0) :start 1) 1)
+ (test (count-if zero? '(0 1 2 0) :start 1 :end 3) 0)
+ (test (count-if zero? '(0 1 2 0) :end 3) 1)
+ (test (count-if zero? '(0 1 2 0) :end 4) 2)
+ (test (count-if zero? '(0 1 2 0) :end 4 :from-end #t) 2)
+ (test-t (eql (count #\a "how many A's are there in here?") 2))
+ )
+
(define* (find-if predicate sequence from-end (start 0) end (key identity))
(let* ((len (length sequence))
(nd (or (and (number? end) end) len))) ; up to but not including end
@@ -23594,507 +39912,504 @@ abs 1 2
(if (predicate (key (sequence i)))
(return (sequence i)))))))))
- (define* (find-if-not predicate sequence from-end (start 0) end (key identity))
- (find-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
-
(define* (find item sequence from-end (test eql) (start 0) end (key identity))
(find-if (lambda (arg) (test item arg)) sequence from-end start end key))
-
- (define* (position-if predicate sequence from-end (start 0) end (key identity))
- (let* ((len (length sequence))
- (nd (or (and (number? end) end) len))) ; up to but not including end
- (if (< nd start)
- (error "~A :start ~A is greater than ~A ~A" __func__ start (if end ":end" "length") nd))
- (call-with-exit
- (lambda (return)
- (if (not from-end)
- (do ((i start (+ i 1)))
- ((= i nd) #f)
- (if (predicate (key (sequence i)))
- (return i)))
- (do ((i (- nd 1) (- i 1)))
- ((< i start) #f)
- (if (predicate (key (sequence i)))
- (return i))))))))
-
- (define* (position-if-not predicate sequence from-end (start 0) end (key identity))
- (position-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
-
- (define* (position item sequence from-end (test eql) (start 0) end (key identity))
- (position-if (lambda (arg) (test item arg)) sequence from-end start end key))
-
-
- (define* (nsubstitute-if new-item test sequence from-end (start 0) end count (key identity))
- (if (and (number? count)
- (not (positive? count)))
- sequence
- (let* ((len (length sequence))
- (nd (or (and (number? end) end) len))) ; up to but not including end
- (if (< nd start)
- (error "~A :start ~A is greater than ~A ~A" __func__ start (if end ":end" "length") nd))
- (let ((cur-count 0))
- (if (not (number? count))
- (set! count len))
- (if (not from-end)
- (do ((i start (+ i 1)))
- ((or (= cur-count count)
- (= i nd))
- sequence)
- (if (test (key (sequence i)))
- (begin
- (set! cur-count (+ cur-count 1))
- (set! (sequence i) new-item))))
- (do ((i (- nd 1) (- i 1)))
- ((or (= cur-count count)
- (< i start))
- sequence)
- (if (test (key (sequence i)))
- (begin
- (set! cur-count (+ cur-count 1))
- (set! (sequence i) new-item)))))))))
-
- (define* (nsubstitute-if-not new-item test sequence from-end (start 0) end count (key identity))
- (nsubstitute-if new-item (lambda (obj) (not (test obj))) sequence from-end start end count key))
- (define* (nsubstitute new-item old-item sequence from-end (test eql) (start 0) end count (key identity))
- (nsubstitute-if new-item (lambda (arg) (test old-item arg)) sequence from-end start end count key))
+ (let ()
+ (define* (find-if-not predicate sequence from-end (start 0) end (key identity))
+ (find-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
+
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c)) 'a))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c)) 'b))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c)) 'c))
+ (test-t (null (find-if-not (lambda (arg) (not (eq arg 'x))) '(a b c))))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :start 2)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :start 3)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0 :from-end t)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1 :from-end t)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2 :from-end t)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3 :from-end t)))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end nil) 'a))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end nil) 'b))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end nil) 'c))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 1) 'a))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 2) 'b))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 3) 'c))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 0)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 1)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 2)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)))))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key car) '(a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key car) '(b)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key car) '(c)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key car)))
+ (test-t (let ((list '((a) (b) (c))))
+ (and (eq (find-if-not (lambda (x) (not (eq x 'a))) list :key car)
+ (car list))
+ (eq (find-if-not (lambda (x) (not (eq x 'b))) list :key car)
+ (cadr list))
+ (eq (find-if-not (lambda (x) (not (eq x 'c))) list :key car)
+ (caddr list))
+ (null (find-if-not (lambda (x) (not (eq x 'z))) list :key car)))))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c)) 'a))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c)) 'b))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c)) 'c))
+ (test-t (null (find-if-not (lambda (arg) (not (eq arg 'x))) #(a b c))))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :start 2)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :start 3)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0 :from-end t)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1 :from-end t)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2 :from-end t)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3 :from-end t)))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end nil) 'a))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end nil) 'b))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end nil) 'c))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 1) 'a))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 2) 'b))
+ (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 3) 'c))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 0)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 1)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 2)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)))))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key car) '(a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key car) '(b)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key car) '(c)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key car)))
+ (test-t (let ((vector #((a) (b) (c))))
+ (and (eq (find-if-not (lambda (x) (not (eq x 'a))) vector :key car)
+ (aref vector 0))
+ (eq (find-if-not (lambda (x) (not (eq x 'b))) vector :key car)
+ (aref vector 1))
+ (eq (find-if-not (lambda (x) (not (eq x 'c))) vector :key car)
+ (aref vector 2))
+ (null (find-if-not (lambda (x) (not (eq x 'z))) vector :key car)))))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
+ (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
+ (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+ )
+
+ (let ()
+ (define* (position-if predicate sequence from-end (start 0) end (key identity))
+ (let* ((len (length sequence))
+ (nd (or (and (number? end) end) len))) ; up to but not including end
+ (if (< nd start)
+ (error "~A :start ~A is greater than ~A ~A" __func__ start (if end ":end" "length") nd))
+ (call-with-exit
+ (lambda (return)
+ (if (not from-end)
+ (do ((i start (+ i 1)))
+ ((= i nd) #f)
+ (if (predicate (key (sequence i)))
+ (return i)))
+ (do ((i (- nd 1) (- i 1)))
+ ((< i start) #f)
+ (if (predicate (key (sequence i)))
+ (return i))))))))
+
+ (define* (position-if-not predicate sequence from-end (start 0) end (key identity))
+ (position-if (lambda (obj) (not (predicate obj))) sequence from-end start end key))
+
+ (define* (position item sequence from-end (test eql) (start 0) end (key identity))
+ (position-if (lambda (arg) (test item arg)) sequence from-end start end key))
+
+ (test-t (eql (position #\a "baobab" :from-end t) 4))
+ (test-t (eql (position-if oddp '((1) (2) (3) (4)) :start 1 :key car) 2))
+ (test-t (null (position 595 ())))
+ (test-t (eql (position-if-not integerp '(1 2 3 4 5.0)) 4))
+ (test-t (eql (position 'a '(a b c)) 0))
+ (test-t (eql (position 'b '(a b c)) 1))
+ (test-t (eql (position 'c '(a b c)) 2))
+ (test-t (null (position 'x '(a b c))))
+ (test-t (null (position 'a '(a b c) :start 1)))
+ (test-t (null (position 'b '(a b c) :start 2)))
+ (test-t (null (position 'c '(a b c) :start 3)))
+ (test-t (null (position 'a '(a b c) :start 0 :end 0)))
+ (test-t (null (position 'a '(a b c) :start 0 :end 0 :from-end t)))
+ (test-t (null (position 'a '(a b c) :start 1 :end 1)))
+ (test-t (null (position 'a '(a b c) :start 1 :end 1 :from-end t)))
+ (test-t (null (position 'a '(a b c) :start 2 :end 2)))
+ (test-t (null (position 'a '(a b c) :start 2 :end 2 :from-end t)))
+ (test-t (null (position 'a '(a b c) :start 3 :end 3)))
+ (test-t (null (position 'a '(a b c) :start 3 :end 3 :from-end t)))
+ (test-t (eql (position 'a '(a b c) :end nil) '0))
+ (test-t (eql (position 'b '(a b c) :end nil) '1))
+ (test-t (eql (position 'c '(a b c) :end nil) '2))
+ (test-t (eql (position 'a '(a b c) :end 1) '0))
+ (test-t (eql (position 'b '(a b c) :end 2) '1))
+ (test-t (eql (position 'c '(a b c) :end 3) '2))
+ (test-t (null (position 'a '(a b c) :end 0)))
+ (test-t (null (position 'b '(a b c) :end 1)))
+ (test-t (null (position 'c '(a b c) :end 2)))
+ (test-t (null (position 'a '((a) (b) (c)))))
+ (test-t (eql (position 'a '((a) (b) (c)) :key car) 0))
+ (test-t (eql (position 'b '((a) (b) (c)) :key car) 1))
+ (test-t (eql (position 'c '((a) (b) (c)) :key car) 2))
+ (test-t (null (position 'z '((a) (b) (c)) :key car)))
+ (test-t (null (position '(a) '((a) (b) (c)))))
+ (test-t (eql (position '(a) '((a) (b) (c)) :test equal) 0))
+ (test-t (null (position '("a") '(("a") ("b") ("c")))))
+ (test-t (eql (position 3 '(0 1 2 3 4 5)) 3))
+ (test-t (eql (position 3 '(0 1 2 3 4 5) :test <) 4))
+ (test-t (eql (position 3 '(0 1 2 3 4 5) :test >) 0))
+ (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+ (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+ (test-t (eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+ (test-t (eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+ (test-t (eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+ (test-t (eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+ (test-t (null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+ (test-t (null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+ (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+ (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+ (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+ (test-t (null (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+ (test-t (eql (position 'a #(a b c)) 0))
+ (test-t (eql (position 'b #(a b c)) 1))
+ (test-t (eql (position 'c #(a b c)) 2))
+ (test-t (null (position 'x #(a b c))))
+ (test-t (null (position 'a #(a b c) :start 1)))
+ (test-t (null (position 'b #(a b c) :start 2)))
+ (test-t (null (position 'c #(a b c) :start 3)))
+ (test-t (null (position 'a #(a b c) :start 0 :end 0)))
+ (test-t (null (position 'a #(a b c) :start 0 :end 0 :from-end t)))
+ (test-t (null (position 'a #(a b c) :start 1 :end 1)))
+ (test-t (null (position 'a #(a b c) :start 1 :end 1 :from-end t)))
+ (test-t (null (position 'a #(a b c) :start 2 :end 2)))
+ (test-t (null (position 'a #(a b c) :start 2 :end 2 :from-end t)))
+ (test-t (null (position 'a #(a b c) :start 3 :end 3)))
+ (test-t (null (position 'a #(a b c) :start 3 :end 3 :from-end t)))
+ (test-t (eql (position 'a #(a b c) :end nil) 0))
+ (test-t (eql (position 'b #(a b c) :end nil) 1))
+ (test-t (eql (position 'c #(a b c) :end nil) 2))
+ (test-t (eql (position 'a #(a b c) :end 1) 0))
+ (test-t (eql (position 'b #(a b c) :end 2) 1))
+ (test-t (eql (position 'c #(a b c) :end 3) 2))
+ (test-t (null (position 'a #(a b c) :end 0)))
+ (test-t (null (position 'b #(a b c) :end 1)))
+ (test-t (null (position 'c #(a b c) :end 2)))
+ (test-t (null (position 'a #((a) (b) (c)))))
+ (test-t (eql (position 'a #((a) (b) (c)) :key car) 0))
+ (test-t (eql (position 'b #((a) (b) (c)) :key car) 1))
+ (test-t (eql (position 'c #((a) (b) (c)) :key car) 2))
+ (test-t (null (position 'z #((a) (b) (c)) :key car)))
+ (test-t (null (position '(a) #((a) (b) (c)))))
+ (test-t (eql (position '(a) #((a) (b) (c)) :test equal) 0))
+ (test-t (null (position '("a") #(("a") ("b") ("c")))))
+ (test-t (eql (position 3 #(0 1 2 3 4 5)) 3))
+ (test-t (eql (position 3 #(0 1 2 3 4 5) :test <) 4))
+ (test-t (eql (position 3 #(0 1 2 3 4 5) :test >) 0))
+ (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+ (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+ (test-t (eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+ (test-t (eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+ (test-t (eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+ (test-t (eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+ (test-t (null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+ (test-t (null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+ (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+ (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+ (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+ (test-t (null (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+ (test-t (null (position #\z "abcABC")))
+ (test-t (eql (position #\a "abcABC") 0))
+ (test-t (eql (position #\A "abcABC") 3))
+ (test-t (eql (position #\A "abcABC" :test char-equal) 0))
+ (test-t (eql (position #\A "abcABC" :test char-equal :from-end t) 3))
+ (test-t (eql (position #\a "abcABC" :test char-equal :from-end t) 3))
+ (test-t (eql (position #\a "abcABC" :test char-equal :from-end t :end 4) 3))
+ (test-t (eql (position #\a "abcABC" :test char-equal :from-end t :end 3) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c)) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c)) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c)) 2))
+ (test-t (null (position-if (lambda (arg) (eq arg 'x)) '(a b c))))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1)))
+ (test-t (null (position-if (lambda (x) (eq x 'b)) '(a b c) :start 2)))
+ (test-t (null (position-if (lambda (x) (eq x 'c)) '(a b c) :start 3)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0 :from-end t)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1 :from-end t)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2 :from-end t)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3 :from-end t)))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c) :end nil) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c) :end nil) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c) :end nil) 2))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c) :end 1) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c) :end 2) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c) :end 3) 2))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :end 0)))
+ (test-t (null (position-if (lambda (x) (eq x 'b)) '(a b c) :end 1)))
+ (test-t (null (position-if (lambda (x) (eq x 'c)) '(a b c) :end 2)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '((a) (b) (c)))))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c)) :key car) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c)) :key car) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c)) :key car) 2))
+ (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c)) :key car)))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+ (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+ (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c)) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c)) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c)) 2))
+ (test-t (null (position-if (lambda (arg) (eq arg 'x)) #(a b c))))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1)))
+ (test-t (null (position-if (lambda (x) (eq x 'b)) #(a b c) :start 2)))
+ (test-t (null (position-if (lambda (x) (eq x 'c)) #(a b c) :start 3)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0 :from-end t)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1 :from-end t)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2 :from-end t)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3 :from-end t)))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c) :end nil) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c) :end nil) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c) :end nil) 2))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c) :end 1) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c) :end 2) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c) :end 3) 2))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :end 0)))
+ (test-t (null (position-if (lambda (x) (eq x 'b)) #(a b c) :end 1)))
+ (test-t (null (position-if (lambda (x) (eq x 'c)) #(a b c) :end 2)))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #((a) (b) (c)))))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c)) :key car) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c)) :key car) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c)) :key car) 2))
+ (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c)) :key car)))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+ (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+ (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+ (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+ (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+ (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+ (test-t (null (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c)) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c)) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c)) 2))
+ (test-t (null (position-if-not (lambda (arg) (not (eq arg 'x))) '(a b c))))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :start 2)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :start 3)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0 :from-end t)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1 :from-end t)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2 :from-end t)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3 :from-end t)))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end nil) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end nil) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end nil) 2))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 1) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 2) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 3) 2))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 0)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 1)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 2)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)))))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key car) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key car) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key car) 2))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key car)))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c)) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c)) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c)) 2))
+ (test-t (null (position-if-not (lambda (arg) (not (eq arg 'x))) #(a b c))))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :start 2)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :start 3)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0 :from-end t)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1 :from-end t)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2 :from-end t)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3 :from-end t)))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end nil) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end nil) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end nil) 2))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 1) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 2) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 3) 2))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 0)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 1)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 2)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)))))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key car) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key car) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key car) 2))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key car)))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
+ (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
+ (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
+ )
- (define* (substitute-if new-item test sequence from-end (start 0) end count (key identity))
- (nsubstitute-if new-item test (copy sequence) from-end start end count key))
+ (define copy-seq copy)
+
- (define* (substitute-if-not new-item test sequence from-end (start 0) end count (key identity))
- (substitute-if new-item (lambda (obj) (not (test obj))) (copy sequence) from-end start end count key))
+ ;; -------- strings
+
+ (define char string-ref)
+ (define schar string-ref)
+ (define* (cl-make-string size (initial-element #\null)) (make-string size initial-element))
+
+ (define (cl-string x)
+ (if (string? x) x
+ (if (char? x)
+ (string x)
+ (if (symbol? x) (symbol->string x)
+ (error "string ~A?" x)))))
+
+ (define* (string= str-1 str-2 (start1 0) end1 (start2 0) end2)
+ (let* ((str1 (cl-string str-1))
+ (str2 (cl-string str-2))
+ (nd1 (if (number? end1) end1 (length str1)))
+ (nd2 (if (number? end2) end2 (length str2))))
+ (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+ (string=? str1 str2)
+ (string=? (subseq str1 start1 nd1)
+ (subseq str2 start2 nd2)))))
+
+ (define* (string-equal str-1 str-2 (start1 0) end1 (start2 0) end2)
+ (let* ((str1 (cl-string str-1))
+ (str2 (cl-string str-2))
+ (nd1 (if (number? end1) end1 (length str1)))
+ (nd2 (if (number? end2) end2 (length str2))))
+ (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+ (string-ci=? str1 str2)
+ (string-ci=? (subseq str1 start1 nd1)
+ (subseq str2 start2 nd2)))))
+
+ (define (string-prefixes-equal str1 str2 start1 nd1 start2 nd2)
+ (do ((i start1 (+ i 1))
+ (j start2 (+ j 1)))
+ ((or (= i nd1)
+ (= j nd2)
+ (not (char=? (str1 i) (str2 j))))
+ i)))
+
+ (define (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2)
+ (do ((i start1 (+ i 1))
+ (j start2 (+ j 1)))
+ ((or (= i nd1)
+ (= j nd2)
+ (not (char-ci=? (str1 i) (str2 j))))
+ i)))
+
+ (define* (string< str-1 str-2 (start1 0) end1 (start2 0) end2)
+ (let* ((str1 (cl-string str-1))
+ (str2 (cl-string str-2))
+ (nd1 (if (number? end1) end1 (length str1)))
+ (nd2 (if (number? end2) end2 (length str2)))
+ (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+ (string<? str1 str2)
+ (string<? (subseq str1 start1 nd1)
+ (subseq str2 start2 nd2)))))
+ (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
- (define* (substitute new-item old-item sequence from-end (test eql) (start 0) end count (key identity))
- (nsubstitute new-item old-item (copy sequence) from-end test start end count key))
+ (define* (string-lessp str-1 str-2 (start1 0) end1 (start2 0) end2)
+ (let* ((str1 (cl-string str-1))
+ (str2 (cl-string str-2))
+ (nd1 (if (number? end1) end1 (length str1)))
+ (nd2 (if (number? end2) end2 (length str2)))
+ (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+ (string-ci<? str1 str2)
+ (string-ci<? (subseq str1 start1 nd1)
+ (subseq str2 start2 nd2)))))
+ (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
- (define* (reduce function sequence from-end (start 0) end initial-value (key identity))
- (let* ((slen (length sequence))
- (nd (or (and (number? end) end) slen))
- (len (min slen (- nd start))))
- (if (< nd start)
- (error "~A :start ~A is greater than ~A ~A" __func__ start (if end ":end" "length") nd))
- (if (not (positive? len))
- (or initial-value
- (function))
- (if (and (= len 1)
- (not initial-value))
- (sequence start)
- (if (and (not from-end) (not (null? from-end)))
- (let* ((first-arg (or initial-value (key (sequence start))))
- (second-arg (if initial-value (key (sequence start)) (key (sequence (+ start 1)))))
- (val (function first-arg second-arg)))
- (do ((i (if initial-value (+ start 1) (+ start 2)) (+ i 1)))
- ((= i nd) val)
- (set! val (function val (key (sequence i))))))
- (let* ((second-arg (or initial-value (key (sequence (- nd 1)))))
- (first-arg (if initial-value (key (sequence (- nd 1))) (key (sequence (- nd 2)))))
- (val (function first-arg second-arg)))
- (do ((i (if initial-value (- nd 2) (- nd 3)) (- i 1)))
- ((< i start) val)
- (set! val (function (key (sequence i)) val)))))))))
+ (define* (string<= str-1 str-2 (start1 0) end1 (start2 0) end2)
+ (let* ((str1 (cl-string str-1))
+ (str2 (cl-string str-2))
+ (nd1 (if (number? end1) end1 (length str1)))
+ (nd2 (if (number? end2) end2 (length str2)))
+ (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+ (string<=? str1 str2)
+ (string<=? (subseq str1 start1 nd1)
+ (subseq str2 start2 nd2)))))
+ (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
- (define (nreverse sequence)
- (let ((len (length sequence)))
- (do ((i 0 (+ i 1))
- (j (- len 1) (- j 1)))
- ((>= i j) sequence)
- (let ((tmp (sequence i)))
- (set! (sequence i) (sequence j))
- (set! (sequence j) tmp)))))
-
- (define (cl-reverse sequence)
- (nreverse (copy sequence)))
-
- (define copy-seq copy)
- (define (complement fn) (lambda args (not (apply fn args))))
- (define (elt sequence index) (sequence index))
- ;; length is ok
-
- (define* (some predicate . sequences)
- (call-with-exit
- (lambda (return)
- (apply for-each
- (lambda args
- (let ((val (apply predicate args)))
- (if val (return val))))
- sequences)
- #f)))
-
- (define* (notany predicate . sequences)
- (not (apply some predicate sequences)))
-
- (define* (every predicate . sequences)
- (call-with-exit
- (lambda (return)
- (apply for-each
- (lambda args
- (if (not (apply predicate args))
- (return #f)))
- sequences)
- #t)))
-
- (define* (notevery predicate . sequences)
- (not (apply every predicate sequences)))
-
- (define* (cl-fill sequence item (start 0) end) ; actuall "fill" doesn't collide, but it's confusing
- (let ((nd (or (and (not (null? end)) end)
- (length sequence))))
- (if (and (= start 0)
- (= nd (length sequence)))
- (fill! sequence item)
- (do ((i start (+ i 1)))
- ((= i nd))
- (set! (sequence i) item)))
- sequence))
-
- ;; many of the sequence functions return a different length sequence, but
- ;; for user-defined sequence types, we can't use the 'type kludge (or
- ;; at least it's ugly), so we need either (make obj size initial-value)
- ;; where obj is a representative of the desired type, or another
- ;; arg to copy giving the new object's size. For now, I'll cobble up
- ;; something explicit.
- ;;
- ;; perhaps the extended type could give its type symbol as well as the make function?
- ;; 'vct and make-vct etc
-
- (define (make obj size)
- (cond ((vector? obj) (make-vector size))
- ((list? obj) (make-list size))
- ((string? obj) (make-string size))
- ((hash-table? obj) (make-hash-table size)))) ; does this make any sense?
-
- (define* (make-sequence type size initial-element)
- (case type
- ((vector bit-vector simple-vector) (make-vector size initial-element))
- ((hash-table) (make-hash-table size))
- ((string) (cl-make-string size (or initial-element #\null))) ; not #f!
- ((list) (cl-make-list size initial-element))
- (else '())))
-
- (define (cl-map type func . lists)
- (let* ((vals (apply mapcar func lists))
- (len (length vals)))
- (let ((obj (make-sequence (or type 'list) len)))
- (if (> (length obj) 0)
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (obj i) (vals i))))
- obj)))
-
- (define* (subseq sequence start end)
- (let* ((len (length sequence))
- (nd (or (and (number? end) end) len))
- (size (- nd start))
- (obj (make sequence size)))
- (do ((i start (+ i 1))
- (j 0 (+ j 1)))
- ((= i nd) obj)
- (set! (obj j) (sequence i)))))
-
- (define (concatenate type . sequences)
- (let* ((len (apply + (map length sequences)))
- (new-obj (make-sequence type len))
- (ctr 0))
- (for-each
- (lambda (sequence)
- (for-each
- (lambda (obj)
- (set! (new-obj ctr) obj)
- (set! ctr (+ ctr 1)))
- sequence))
- sequences)
- new-obj))
-
- ;; :(concatenate 'list "hiho" '#(1 2)) -> (#\h #\i #\h #\o 1 2)
-
- (define* (replace seq1 seq2 (start1 0) end1 (start2 0) end2)
- (let* ((len1 (length seq1))
- (len2 (length seq2))
- (nd1 (or (and (number? end1) end1) len1))
- (nd2 (or (and (number? end2) end2) len2)))
- (if (and (eq? seq1 seq2)
- (> start1 start2))
- (let ((offset (- start1 start2)))
- (do ((i (- nd1 1) (- i 1)))
- ((< i start1) seq1)
- (set! (seq1 i) (seq1 (- i offset)))))
- (do ((i start1 (+ i 1))
- (j start2 (+ j 1)))
- ((or (= i nd1)
- (= j nd2))
- seq1)
- (set! (seq1 i) (seq2 j))))))
-
- (define* (remove-if predicate sequence from-end (start 0) end count (key identity))
- (let* ((len (length sequence))
- (nd (or (and (number? end) end) len))
- (num (if (number? count) count len))
- (changed 0))
- (if (not (positive? num))
- sequence
- (let ((result '()))
- (if (null from-end)
- (do ((i 0 (+ i 1)))
- ((= i len))
- (if (or (< i start)
- (>= i nd)
- (>= changed num)
- (not (predicate (key (sequence i)))))
- (set! result (cons (sequence i) result))
- (set! changed (+ changed 1))))
- (do ((i (- len 1) (- i 1)))
- ((< i 0))
- (if (or (< i start)
- (>= i nd)
- (>= changed num)
- (not (predicate (key (sequence i)))))
- (set! result (cons (sequence i) result))
- (set! changed (+ changed 1)))))
- (let* ((len (length result))
- (obj (make sequence len))
- (vals (if (null from-end) (reverse result) result)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (set! (obj i) (vals i)))
- obj)))))
-
- (define* (remove-if-not predicate sequence from-end (start 0) end count (key identity))
- (remove-if (lambda (obj) (not (predicate obj))) sequence from-end start end count key))
-
- (define* (remove item sequence from-end (test eql) (start 0) end count (key identity))
- (remove-if (lambda (arg) (test item arg)) sequence from-end start end count key))
-
- (define-macro* (delete-if predicate sequence from-end (start 0) end count (key identity))
- `(let ((obj (remove-if ,predicate ,sequence ,from-end ,start ,end ,count ,key)))
- (if (symbol? ',sequence)
- (set! ,sequence obj))
- obj))
-
- (define-macro* (delete-if-not predicate sequence from-end (start 0) end count (key identity))
- `(let ((obj (remove-if-not ,predicate ,sequence ,from-end ,start ,end ,count ,key)))
- (if (symbol? ',sequence)
- (set! ,sequence obj))
- obj))
-
- (define-macro* (delete item sequence from-end (test eql) (start 0) end count (key identity))
- `(let ((obj (remove ,item ,sequence ,from-end ,test ,start ,end ,count ,key)))
- (if (symbol? ',sequence)
- (set! ,sequence obj))
- obj))
-
- (define* (remove-duplicates sequence from-end (test eql) (start 0) end (key identity))
- (let* ((result '())
- (start-seq (+ start 1))
- (len (length sequence))
- (nd (if (number? end) end len)))
- (do ((i start (+ i 1)))
- ((= i nd))
- (let* ((orig-obj (sequence i))
- (obj (key orig-obj)))
- (if (null from-end)
- (begin
- (if (not (find obj sequence :start start-seq :end nd :test test :key key))
- (set! result (cons orig-obj result)))
- (set! start-seq (+ start-seq 1)))
- (if (not (find obj result :test test :key key))
- (set! result (cons orig-obj result))))))
- (let* ((res (reverse result))
- (new-len (+ (length result) start (- len nd)))
- (new-seq (make sequence new-len)))
- (let ((n 0))
- (do ((i 0 (+ i 1)))
- ((= i len) new-seq)
- (if (or (< i start)
- (>= i nd))
- (begin
- (set! (new-seq n) (sequence i))
- (set! n (+ n 1)))
- (if (not (null? res))
- (begin
- (set! (new-seq n) (car res))
- (set! res (cdr res))
- (set! n (+ n 1))))))))))
-
- (define-macro* (delete-duplicates sequence from-end (test eql) (start 0) end (key identity))
- `(let ((obj (remove-duplicates ,sequence ,from-end ,test ,start ,end ,key)))
- (if (symbol? ,sequence)
- (set! ,sequence obj))
- obj))
-
- (define* (merge result-type seq1 seq2 predicate (key identity))
- (let* ((len1 (length seq1))
- (len2 (length seq2))
- (size (+ len1 len2))
- (obj (make-sequence result-type size))
- (i 0)
- (j 0))
- (do ((n 0 (+ n 1)))
- ((or (= i len1)
- (= j len2))
- (if (< i len1)
- (do ((k i (+ k 1)))
- ((= k len1) obj)
- (set! (obj n) (seq1 k))
- (set! n (+ n 1)))
- (if (< j len2)
- (do ((k j (+ k 1)))
- ((= k len2) obj)
- (set! (obj n) (seq2 k))
- (set! n (+ n 1)))
- obj)))
- (if (null (predicate (key (seq1 i)) (key (seq2 j))))
- (begin
- (set! (obj n) (seq2 j))
- (set! j (+ j 1)))
- (begin
- (set! (obj n) (seq1 i))
- (set! i (+ i 1)))))))
-
- (define* (search seq1 seq2 from-end (test eql) (key identity) (start1 0) (start2 0) end1 end2)
- (let* ((len1 (length seq1))
- (len2 (length seq2))
- (nd1 (or (and (number? end1) end1) len1))
- (nd2 (or (and (number? end2) end2) len2)))
- (set! len1 (min len1 (- nd1 start1)))
- (set! len2 (min len2 (- nd2 start2)))
- (if (or (= len2 0)
- (> len1 len2))
- '()
- (call-with-exit
- (lambda (return)
- (if (or (not from-end) (null? from-end))
- (do ((i start2 (+ i 1)))
- ((> i (- nd2 len1)) '())
- (do ((j start1 (+ j 1))
- (k i (+ k 1)))
- ((or (= j nd1)
- (not (test (key (seq1 j)) (key (seq2 k)))))
- (if (= j nd1)
- (return i)))))
- (do ((i (- nd2 len1) (- i 1)))
- ((< i start2) '())
- (do ((j start1 (+ j 1))
- (k i (+ k 1)))
- ((or (= j nd1)
- (not (test (key (seq1 j)) (key (seq2 k)))))
- (if (= j nd1)
- (return i)))))))))))
-
- (define* (mismatch seq1 seq2 from-end (test eql) (key identity) (start1 0) (start2 0) end1 end2)
- (let* ((nd1 (or (and (number? end1) end1) (length seq1)))
- (nd2 (or (and (number? end2) end2) (length seq2))))
- (if (not from-end)
- (do ((i start1 (+ i 1))
- (j start2 (+ j 1)))
- ((or (= i nd1)
- (= j nd2)
- (not (test (key (seq1 i)) (key (seq2 j)))))
- (if (and (= i nd1) (= j nd2))
- '()
- i)))
- (do ((i (- nd1 1) (- i 1))
- (j (- nd2 1) (- j 1)))
- ((or (< i start1)
- (< j start2)
- (not (test (key (seq1 i)) (key (seq2 j)))))
- (if (and (< i start1) (< j start2))
- '()
- (+ i 1)))))))
-
-
- ;; -------- strings
-
- (define char string-ref)
- (define schar string-ref)
- (define* (cl-make-string size (initial-element #\null)) (make-string size initial-element))
-
- (define (cl-string x)
- (if (string? x) x
- (if (char? x)
- (string x)
- (if (symbol? x) (symbol->string x)
- (error "string ~A?" x)))))
-
- (define* (string= str-1 str-2 (start1 0) end1 (start2 0) end2)
- (let* ((str1 (cl-string str-1))
- (str2 (cl-string str-2))
- (nd1 (if (number? end1) end1 (length str1)))
- (nd2 (if (number? end2) end2 (length str2))))
- (if (and (not end1) (not end2) (= start1 0) (= start2 0))
- (string=? str1 str2)
- (string=? (subseq str1 start1 nd1)
- (subseq str2 start2 nd2)))))
-
- (define* (string-equal str-1 str-2 (start1 0) end1 (start2 0) end2)
- (let* ((str1 (cl-string str-1))
- (str2 (cl-string str-2))
- (nd1 (if (number? end1) end1 (length str1)))
- (nd2 (if (number? end2) end2 (length str2))))
- (if (and (not end1) (not end2) (= start1 0) (= start2 0))
- (string-ci=? str1 str2)
- (string-ci=? (subseq str1 start1 nd1)
- (subseq str2 start2 nd2)))))
-
- (define (string-prefixes-equal str1 str2 start1 nd1 start2 nd2)
- (do ((i start1 (+ i 1))
- (j start2 (+ j 1)))
- ((or (= i nd1)
- (= j nd2)
- (not (char=? (str1 i) (str2 j))))
- i)))
-
- (define (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2)
- (do ((i start1 (+ i 1))
- (j start2 (+ j 1)))
- ((or (= i nd1)
- (= j nd2)
- (not (char-ci=? (str1 i) (str2 j))))
- i)))
-
- (define* (string< str-1 str-2 (start1 0) end1 (start2 0) end2)
- (let* ((str1 (cl-string str-1))
- (str2 (cl-string str-2))
- (nd1 (if (number? end1) end1 (length str1)))
- (nd2 (if (number? end2) end2 (length str2)))
- (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
- (string<? str1 str2)
- (string<? (subseq str1 start1 nd1)
- (subseq str2 start2 nd2)))))
- (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
-
- (define* (string-lessp str-1 str-2 (start1 0) end1 (start2 0) end2)
- (let* ((str1 (cl-string str-1))
- (str2 (cl-string str-2))
- (nd1 (if (number? end1) end1 (length str1)))
- (nd2 (if (number? end2) end2 (length str2)))
- (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
- (string-ci<? str1 str2)
- (string-ci<? (subseq str1 start1 nd1)
- (subseq str2 start2 nd2)))))
- (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
-
- (define* (string<= str-1 str-2 (start1 0) end1 (start2 0) end2)
- (let* ((str1 (cl-string str-1))
- (str2 (cl-string str-2))
- (nd1 (if (number? end1) end1 (length str1)))
- (nd2 (if (number? end2) end2 (length str2)))
- (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
- (string<=? str1 str2)
- (string<=? (subseq str1 start1 nd1)
- (subseq str2 start2 nd2)))))
- (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2))))
-
- (define* (string-not-greaterp str-1 str-2 (start1 0) end1 (start2 0) end2)
- (let* ((str1 (cl-string str-1))
- (str2 (cl-string str-2))
- (nd1 (if (number? end1) end1 (length str1)))
- (nd2 (if (number? end2) end2 (length str2)))
- (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
- (string-ci<=? str1 str2)
- (string-ci<=? (subseq str1 start1 nd1)
- (subseq str2 start2 nd2)))))
- (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
+ (define* (string-not-greaterp str-1 str-2 (start1 0) end1 (start2 0) end2)
+ (let* ((str1 (cl-string str-1))
+ (str2 (cl-string str-2))
+ (nd1 (if (number? end1) end1 (length str1)))
+ (nd2 (if (number? end2) end2 (length str2)))
+ (val (if (and (not end1) (not end2) (= start1 0) (= start2 0))
+ (string-ci<=? str1 str2)
+ (string-ci<=? (subseq str1 start1 nd1)
+ (subseq str2 start2 nd2)))))
+ (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2))))
(define* (string> str-1 str-2 (start1 0) end1 (start2 0) end2)
(let* ((str1 (cl-string str-1))
@@ -24193,7 +40508,7 @@ abs 1 2
((= i nd) str)
(set! (str i) (char-upcase (str i))))))
- (define* (string-upcase str-1 (start 0) end)
+ (define* (cl-string-upcase str-1 (start 0) end)
(let ((str (cl-string str-1)))
(nstring-upcase (copy str) start end)))
@@ -24203,7 +40518,7 @@ abs 1 2
((= i nd) str)
(set! (str i) (char-downcase (str i))))))
- (define* (string-downcase str-1 (start 0) end)
+ (define* (cl-string-downcase str-1 (start 0) end)
(let ((str (cl-string str-1)))
(nstring-downcase (copy str) start end)))
@@ -24225,43 +40540,2784 @@ abs 1 2
(let ((str (cl-string str-1)))
(nstring-capitalize (copy str) start end)))
+ (let ()
+ (define* (union list1 list2 (test eql) (key identity))
+ (let ((new-list (copy list1)))
+ (do ((obj list2 (cdr obj)))
+ ((null? obj) new-list)
+ (set! new-list (adjoin (car obj) new-list test key)))))
+
+ (define nunion union) ; this is not required to be destructive
+
+ (define* (intersection list1 list2 (test eql) (key identity))
+ (let ((new-list ()))
+ (do ((obj list1 (cdr obj)))
+ ((null? obj) new-list)
+ (if (not (null? (cl-member (key (car obj)) list2 test key)))
+ (set! new-list (adjoin (car obj) new-list test key))))))
+
+ (define nintersection intersection)
+
+ (define* (set-difference list1 list2 (test eql) (key identity))
+ (let ((new-list ()))
+ (do ((obj list1 (cdr obj)))
+ ((null? obj) new-list)
+ (if (null? (cl-member (key (car obj)) list2 test key))
+ (set! new-list (adjoin (car obj) new-list test key))))))
+
+ (define nset-difference set-difference)
+
+ (define* (set-exclusive-or list1 list2 (test eql) (key identity))
+ (let ((new-list ()))
+ (do ((obj list1 (cdr obj)))
+ ((null? obj))
+ (if (null? (cl-member (key (car obj)) list2 test key))
+ (set! new-list (adjoin (car obj) new-list test key))))
+ (do ((obj list2 (cdr obj)))
+ ((null? obj) new-list)
+ (if (null? (cl-member (key (car obj)) list1 test key))
+ (set! new-list (adjoin (car obj) new-list test key))))))
+
+ (define nset-exclusive-or set-exclusive-or)
+
+ (define* (subsetp list1 list2 (test eql) (key identity))
+ (call-with-exit
+ (lambda (return)
+ (do ((obj list1 (cdr obj)))
+ ((null? obj) #t)
+ (if (null? (cl-member (key (car obj)) list2 test key))
+ (return nil))))))
+
+ (test-t (subsetp '(1 2 3) '(1 2 3)))
+ (test-t (subsetp '(1 2 3) '(3 2 1)))
+ (test-t (subsetp '(1 2 3) '(2 1 3)))
+ (test-t (null (subsetp '(1 2 3 4) '(2 1 3))))
+ (test-t (subsetp '(1) '(2 1 3)))
+ (test-t (subsetp '(1 2) '(1 2 3 4 5 6 7 8)))
+ (test-t (subsetp '(1 2 3 4 5) '(8 7 6 5 4 3 2 1)))
+ (test-t (null (subsetp '("car" "ship" "airplane" "submarine") '("car" "ship" "horse" "airplane" "submarine" "camel"))))
+ (test-t (subsetp '("car" "ship" "airplane" "submarine")
+ '("car" "ship" "horse" "airplane" "submarine" "camel")
+ :test equal))
+ (test-t (subsetp '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+ '("car" "ship" "horse" "airplane" "submarine" "camel")
+ :test equalp))
+ (test-t (subsetp '(("car") ("ship") ("airplane") ("submarine"))
+ '(("car") ("ship") ("horse") ("airplane") ("submarine") ("camel"))
+ :test string=
+ :key car))
+
+ (test-t (null (union () ())))
+ (test-t (null (nunion () ())))
+ (test-t (null (set-difference (union '(1 2 3) '(2 3 4)) '(1 2 3 4))))
+ (test-t (null (set-difference (nunion (list 1 2 3) (list 2 3 4)) '(1 2 3 4))))
+ (test-t (null (set-difference (union '(1 2 3) '(1 2 3)) '(1 2 3))))
+ (test-t (null (set-difference (nunion (list 1 2 3) (list 1 2 3)) '(1 2 3))))
+ (test-t (null (set-difference (union '(1) '(3 2 1)) '(1 2 3))))
+ (test-t (null (set-difference (nunion (list 1) (list 3 2 1)) '(1 2 3))))
+ (test-t (null (set-difference (union '(1 2 3) ()) '(1 2 3))))
+ (test-t (null (set-difference (nunion (list 1 2 3) ()) '(1 2 3))))
+ (test-t (null (set-difference (union () '(1 2 3)) '(1 2 3))))
+ (test-t (null (set-difference (nunion () (list 1 2 3)) '(1 2 3))))
+ (test-t (null (set-difference (union '(1 2 3) '(2)) '(1 2 3))))
+ (test-t (null (set-difference (nunion (list 1 2 3) (list 2)) '(1 2 3))))
+
+ (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
+ (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
+ (test-t (null (set-exclusive-or (intersection list1 list2) '(c b 4 1 1))))
+ (test-t (null (set-exclusive-or (intersection list1 list2 :test equal)
+ '("B" c b 4 1 1)
+ :test equal)))
+ (test-t (null (set-exclusive-or (intersection list1 list2 :test equalp)
+ '("d" "C" "B" "A" c b 4 1 1)
+ :test equalp))))
+ (test-t (null (intersection '(0 1 2) ())))
+ (test-t (null (intersection () ())))
+ (test-t (null (intersection () '(0 1 2))))
+ (test-t (equal (intersection '(0) '(0)) '(0)))
+ (test-t (equal (intersection '(0 1 2 3) '(2)) '(2)))
+ (test-t (cl-member 0 (intersection '(0 0 0 0 0) '(0 1 2 3 4 5))))
+ (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0)) '(4 3 2 1 0))))
+ (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(0 1 2 3 4)) '(0 1 2 3 4))))
+ (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0)) '(0 1 2 3 4))))
+ (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+ (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (intersection list1 list2
+ :test char=
+ :key (lambda (x) (char x 0)))
+ '("B" "F" "h")
+ :test char=
+ :key (lambda (x) (char x 0))))))
+ (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+ (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (intersection list1 list2
+ :test char-equal
+ :key (lambda (x) (char x 0)))
+ '("A" "B" "C" "d" "e" "F" "G" "h")
+ :test char-equal
+ :key (lambda (x) (char x 0))))))
+ (test-t (let ((list1 (list "A" "B" "C" "d"))
+ (list2 (list "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (intersection list1 list2
+ :test char-equal
+ :key (lambda (x) (char x 0)))
+ '("d")
+ :test char-equal
+ :key (lambda (x) (char x 0))))))
+ (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
+ (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
+ (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2) '(c b 4 1 1))))
+ (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2 :test equal)
+ '("B" c b 4 1 1)
+ :test equal)))
+ (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2 :test equalp)
+ '("d" "C" "B" "A" c b 4 1 1)
+ :test equalp))))
+ (test-t (null (nintersection (list 0 1 2) ())))
+ (test-t (null (nintersection () ())))
+ (test-t (null (nintersection () '(0 1 2))))
+ (test-t (equal (nintersection (list 0) '(0)) '(0)))
+ (test-t (equal (nintersection (list 0 1 2 3) '(2)) '(2)))
+ (test-t (cl-member 0 (nintersection (list 0 0 0 0 0) '(0 1 2 3 4 5))))
+ (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0)) '(4 3 2 1 0))))
+ (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(0 1 2 3 4)) '(0 1 2 3 4))))
+ (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0)) '(0 1 2 3 4))))
+ (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+ (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (nintersection list1 list2
+ :test char=
+ :key (lambda (x) (char x 0)))
+ '("B" "F" "h")
+ :test char=
+ :key (lambda (x) (char x 0))))))
+ (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
+ (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (nintersection list1 list2
+ :test char-equal
+ :key (lambda (x) (char x 0)))
+ '("A" "B" "C" "d" "e" "F" "G" "h")
+ :test char-equal
+ :key (lambda (x) (char x 0))))))
+ (test-t (let ((list1 (list "A" "B" "C" "d"))
+ (list2 (list "D" "E" "F" "g" "h")))
+ (null (set-exclusive-or (nintersection list1 list2
+ :test char-equal
+ :key (lambda (x) (char x 0)))
+ '("d")
+ :test char-equal
+ :key (lambda (x) (char x 0))))))
+
+
+ (test-t (null (set-difference (set-difference '(1 2 3 4 5 6 7 8 9)
+ '(2 4 6 8))
+ '(1 3 5 7 9))))
+ (test-t (null (nset-difference (set-difference (list 1 2 3 4 5 6 7 8 9)
+ '(2 4 6 8))
+ '(1 3 5 7 9))))
+ (test-t (null (set-difference () ())))
+ (test-t (null (set-difference () () :test equal :key 'identity)))
+ (test-t (null (nset-difference () ())))
+ (test-t (null (set-difference () '(1 2 3))))
+ (test-t (null (set-difference () '(1 2 3) :test equal :key 'identity)))
+ (test-t (null (nset-difference () '(1 2 3))))
+ (test-t (null (set-difference '(1 2 3 4) '(4 3 2 1))))
+ (test-t (null (nset-difference (list 1 2 3 4) '(4 3 2 1))))
+ (test-t (null (set-difference '(1 2 3 4) '(2 4 3 1))))
+ (test-t (null (nset-difference (list 1 2 3 4) '(2 4 3 1))))
+ (test-t (null (set-difference '(1 2 3 4) '(1 3 4 2))))
+ (test-t (null (nset-difference (list 1 2 3 4) '(1 3 4 2))))
+ (test-t (null (set-difference '(1 2 3 4) '(1 3 2 4))))
+ (test-t (null (nset-difference (list 1 2 3 4) '(1 3 2 4))))
+ (test-t (eq (set-difference (set-difference '(1 2 3) ()) '(1 2 3)) ()))
+ (test-t (eq (nset-difference (nset-difference (list 1 2 3) ()) '(1 2 3)) ()))
+ (test-t (eq (set-difference (set-difference '(1 2 3) '(1)) '(2 3)) ()))
+ (test-t (eq (nset-difference (nset-difference (list 1 2 3) '(1)) '(2 3)) ()))
+ (test-t (eq (set-difference (set-difference '(1 2 3) '(1 2)) '(3)) ()))
+ (test-t (eq (nset-difference (nset-difference (list 1 2 3) '(1 2)) '(3)) ()))
+ (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '(2 3 4)) '(1 4))))
+ (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(2 3 4)) '(1 4))))
+ (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '(1 3)) '(2))))
+ (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(1 3)) '(2))))
+ (test-t (null (set-exclusive-or () ())))
+ (test-t (null (nset-exclusive-or () ())))
+ (test-t (null (set-exclusive-or '(1 2 3) '(3 2 1))))
+ (test-t (null (nset-exclusive-or (list 1 2 3) '(3 2 1))))
+ (test-t (null (set-exclusive-or '(1 2 3) '(2 3 1))))
+ (test-t (null (nset-exclusive-or (list 1 2 3) '(2 3 1))))
+ (test-t (null (set-exclusive-or '(1 2 3) '(1 3 2))))
+ (test-t (null (nset-exclusive-or (list 1 2 3) '(1 3 2))))
+ (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) ()) '(3 2 1))))
+ (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) ()) '(3 2 1))))
+ (test-t (null (set-exclusive-or (set-exclusive-or () '(1 2 3)) '(2 1 3))))
+ (test-t (null (nset-exclusive-or (nset-exclusive-or () '(1 2 3)) '(2 1 3))))
+ (test-t (null (set-exclusive-or '("car" "ship" "airplane" "submarine")
+ '("car" "ship" "airplane" "submarine")
+ :test equal)))
+ (test-t (null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
+ '("car" "ship" "airplane" "submarine")
+ :test equal)))
+ (test-t (null (set-exclusive-or '("car" "ship" "airplane" "submarine")
+ '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+ :test equalp)))
+ (test-t (null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
+ '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
+ :test equalp)))
+ (test-t (null (set-exclusive-or '(("car") ("ship") ("airplane") ("submarine"))
+ '(("car") ("ship") ("airplane") ("submarine"))
+ :test string=
+ :key car)))
+ (test-t (null (nset-exclusive-or (copy-tree
+ '(("car") ("ship") ("airplane") ("submarine")))
+ '(("car") ("ship") ("airplane") ("submarine"))
+ :test string=
+ :key car)))
+ )
+
+ (let ()
+ (define* (nsubstitute-if new-item test sequence from-end (start 0) end count (key identity))
+ (if (and (number? count)
+ (not (positive? count)))
+ sequence
+ (let* ((len (length sequence))
+ (nd (or (and (number? end) end) len))) ; up to but not including end
+ (if (< nd start)
+ (error "~A :start ~A is greater than ~A ~A" __func__ start (if end ":end" "length") nd))
+ (let ((cur-count 0))
+ (if (not (number? count))
+ (set! count len))
+ (if (not from-end)
+ (do ((i start (+ i 1)))
+ ((or (= cur-count count)
+ (= i nd))
+ sequence)
+ (if (test (key (sequence i)))
+ (begin
+ (set! cur-count (+ cur-count 1))
+ (set! (sequence i) new-item))))
+ (do ((i (- nd 1) (- i 1)))
+ ((or (= cur-count count)
+ (< i start))
+ sequence)
+ (if (test (key (sequence i)))
+ (begin
+ (set! cur-count (+ cur-count 1))
+ (set! (sequence i) new-item)))))))))
+
+ (define* (nsubstitute-if-not new-item test sequence from-end (start 0) end count (key identity))
+ (nsubstitute-if new-item (lambda (obj) (not (test obj))) sequence from-end start end count key))
+
+ (define* (nsubstitute new-item old-item sequence from-end (test eql) (start 0) end count (key identity))
+ (nsubstitute-if new-item (lambda (arg) (test old-item arg)) sequence from-end start end count key))
+
+ (define* (substitute-if new-item test sequence from-end (start 0) end count (key identity))
+ (nsubstitute-if new-item test (copy sequence) from-end start end count key))
+
+ (define* (substitute-if-not new-item test sequence from-end (start 0) end count (key identity))
+ (substitute-if new-item (lambda (obj) (not (test obj))) (copy sequence) from-end start end count key))
+
+ (define* (substitute new-item old-item sequence from-end (test eql) (start 0) end count (key identity))
+ (nsubstitute new-item old-item (copy sequence) from-end test start end count key))
+
+
+ (test-t (equal (substitute #\. #\space "0 2 4 6") "0.2.4.6"))
+ (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5)) '(1 2 9 1 3 9 5)))
+ (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 9 1 3 4 5)))
+ (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5)))
+ (test-t (equal (substitute 9 3 '(1 2 4 1 3 4 5) :test >) '(9 9 4 9 3 4 5)))
+ (test-t (equal (substitute-if 0 evenp '((1) (2) (3) (4)) :start 2 :key car) '((1) (2) (3) 0)))
+ (test-t (equal (substitute-if 9 oddp '(1 2 4 1 3 4 5)) '(9 2 4 9 9 4 9)))
+ (test-t (equal (substitute-if 9 evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5)))
+
+ (test-t (let ((some-things (list 'a 'car 'b 'cdr 'c)))
+ (and (equal (nsubstitute-if "function was here" fboundp some-things
+ :count 1 :from-end t)
+ '(a car b "function was here" c))
+ (equal some-things '(a car b "function was here" c)))))
+ (test-t (let ((alpha-tester (copy-seq "ab "))) (and (equal (nsubstitute-if-not #\z alpha-char-p alpha-tester) "abz") (equal alpha-tester "abz"))))
+ (test-t (equal (substitute 'a 'x '(x y z)) '(a y z)))
+ (test-t (equal (substitute 'b 'y '(x y z)) '(x b z)))
+ (test-t (equal (substitute 'c 'z '(x y z)) '(x y c)))
+ (test-t (equal (substitute 'a 'p '(x y z)) '(x y z)))
+ (test-t (equal (substitute 'a 'x ()) ()))
+ (test-t (equal (substitute #\x #\b '(#\a #\b #\c #\d #\e) :test char<) '(#\a #\b #\x #\x #\x)))
+ (test-t (equal (substitute '(a) 'x '((x) (y) (z)) :key car) '((a) (y) (z))))
+ (test-t (equal (substitute 'c 'b '(a b a b a b a b)) '(a c a c a c a c)))
+ (test-t (equal (substitute 'a 'b '(b b b)) '(a a a)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f)) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count nil) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 0) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count -100) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 1) '(a z b x c x d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 2) '(a z b z c x d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 3) '(a z b z c z d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 4) '(a z b z c z d z e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 5) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 6) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 7) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count nil :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 0 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count -100 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 1 :from-end t) '(a x b x c x d x e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 2 :from-end t) '(a x b x c x d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 3 :from-end t) '(a x b x c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 4 :from-end t) '(a x b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 5 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 6 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 7 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+ (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+ (test-t (equal (substitute #\z #\c '(#\a #\b #\c #\d #\e #\f) :test char<) '(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equal (substitute "peace" "war" '("war" "War" "WAr" "WAR") :test string-equal) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :test string=) '("war" "War" "WAr" "peace")))
+ (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :start 1 :end 2 :test string= :key cl-string-upcase) '("war" "peace" "WAr" "WAR")))
+ (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :start 1 :end nil :test string= :key cl-string-upcase) '("war" "peace" "peace" "peace")))
+ (test-t (equal (substitute "peace" "war" '("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) '("war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute 'a 'x #(x y z)) #(a y z)))
+ (test-t (equalp (substitute 'b 'y #(x y z)) #(x b z)))
+ (test-t (equalp (substitute 'c 'z #(x y z)) #(x y c)))
+ (test-t (equalp (substitute 'a 'p #(x y z)) #(x y z)))
+ (test-t (equalp (substitute 'a 'x #()) #()))
+ (test-t (equalp (substitute #\x #\b #(#\a #\b #\c #\d #\e) :test char<) #(#\a #\b #\x #\x #\x)))
+ (test-t (equalp (substitute '(a) 'x #((x) (y) (z)) :key car) #((a) (y) (z))))
+ (test-t (equalp (substitute 'c 'b #(a b a b a b a b)) #(a c a c a c a c)))
+ (test-t (equalp (substitute 'a 'b #(b b b)) #(a a a)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+ (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+ (test-t (equalp (substitute #\z #\c #(#\a #\b #\c #\d #\e #\f) :test char<) #(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equalp (substitute "peace" "war" #("love" "hate" "war" "peace") :test equal) #("love" "hate" "peace" "peace")))
+ (test-t (equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR") :test string-equal) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :test string=) #("war" "War" "WAr" "peace")))
+ (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :start 1 :end 2 :test string= :key cl-string-upcase) #("war" "peace" "WAr" "WAR")))
+ (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :start 1 :end nil :test string= :key cl-string-upcase) #("war" "peace" "peace" "peace")))
+ (test-t (equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) #("war" "War" "WAr" "WAR")))
+ (test-t (string= (substitute #\A #\a "abcabc") "AbcAbc"))
+ (test-t (string= (substitute #\A #\a "") ""))
+ (test-t (string= (substitute #\A #\a "xyz") "xyz"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
+ (test-t (string= (substitute #\x #\5 "0123456789" :test char<) "012345xxxx"))
+ (test-t (string= (substitute #\x #\5 "0123456789" :test char>) "xxxxx56789"))
+ (test-t (string= (substitute #\x #\D "abcdefg" :key char-upcase :test char>) "xxxdefg"))
+ (test-t (string= (substitute #\x #\D "abcdefg" :start 1 :end 2 :key char-upcase :test char>) "axcdefg"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
+ (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
+ (test-t (string= (substitute #\x #\A "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
+ (test-t (string= (substitute #\X #\A "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
+ (test-t (string= (substitute #\X #\D "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :test char< :count 3) "abcdeXXXij"))
+ (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'x)) '(x y z)) '(a y z)))
+ (test-t (equal (substitute-if 'b (lambda (arg) (eq arg 'y)) '(x y z)) '(x b z)))
+ (test-t (equal (substitute-if 'c (lambda (arg) (eq arg 'z)) '(x y z)) '(x y c)))
+ (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'p)) '(x y z)) '(x y z)))
+ (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'x)) ()) ()))
+ (test-t (equal (substitute-if #\x (lambda (arg) (char< #\b arg)) '(#\a #\b #\c #\d #\e)) '(#\a #\b #\x #\x #\x)))
+ (test-t (equal (substitute-if '(a) (lambda (arg) (eq arg 'x)) '((x) (y) (z)) :key car) '((a) (y) (z))))
+ (test-t (equal (substitute-if 'c (lambda (arg) (eq arg 'b)) '(a b a b a b a b)) '(a c a c a c a c)))
+ (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'b)) '(b b b)) '(a a a)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f)) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count nil) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 0) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count -100) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 1) '(a z b x c x d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 2) '(a z b z c x d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 3) '(a z b z c z d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 4) '(a z b z c z d z e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 5) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 6) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 7) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count nil :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 0 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count -100 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 1 :from-end t) '(a x b x c x d x e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 2 :from-end t) '(a x b x c x d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 3 :from-end t) '(a x b x c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 4 :from-end t) '(a x b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 5 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 6 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 7 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+ (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+ (test-t (equal (substitute-if #\z (lambda (arg) (char< #\c arg)) '(#\a #\b #\c #\d #\e #\f)) '(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (equal "war" arg)) '("love" "hate" "war" "peace")) '("love" "hate" "peace" "peace")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string-equal "war" arg)) '("war" "War" "WAr" "WAR")) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :key cl-string-upcase) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "war" arg)) '("war" "War" "WAr" "WAR") :key string-upcase) '("war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+
+ (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'x)) #(x y z)) #(a y z)))
+ (test-t (equalp (substitute-if 'b (lambda (arg) (eq arg 'y)) #(x y z)) #(x b z)))
+ (test-t (equalp (substitute-if 'c (lambda (arg) (eq arg 'z)) #(x y z)) #(x y c)))
+ (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'p)) #(x y z)) #(x y z)))
+ (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'x)) #()) #()))
+ (test-t (equalp (substitute-if #\x (lambda (arg) (char< #\b arg)) #(#\a #\b #\c #\d #\e)) #(#\a #\b #\x #\x #\x)))
+ (test-t (equalp (substitute-if '(a) (lambda (arg) (eq arg 'x)) #((x) (y) (z)) :key car) #((a) (y) (z))))
+ (test-t (equalp (substitute-if 'c (lambda (arg) (eq arg 'b)) #(a b a b a b a b)) #(a c a c a c a c)))
+ (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'b)) #(b b b)) #(a a a)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+ (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+ (test-t (equalp (substitute-if #\z (lambda (arg) (char< #\c arg)) #(#\a #\b #\c #\d #\e #\f)) #(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (equal "war" arg)) #("love" "hate" "war" "peace")) #("love" "hate" "peace" "peace")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string-equal "war" arg)) #("war" "War" "WAr" "WAR")) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :key string-upcase) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "war" arg)) #("war" "War" "WAr" "WAR") :key string-upcase) #("war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "abcabc") "AbcAbc"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "") ""))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "xyz") "xyz"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
+ (test-t (string= (substitute-if #\x (lambda (arg) (char< #\5 arg)) "0123456789") "012345xxxx"))
+ (test-t (string= (substitute-if #\x (lambda (arg) (char> #\5 arg)) "0123456789") "xxxxx56789"))
+ (test-t (string= (substitute-if #\x (lambda (arg) (char> #\D arg)) "abcdefg" :key char-upcase) "xxxdefg"))
+ (test-t (string= (substitute-if #\x (lambda (arg) (char> #\D arg)) "abcdefg" :start 1 :end 2 :key char-upcase) "axcdefg"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
+ (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
+ (test-t (string= (substitute-if #\x (lambda (arg) (eql #\A arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
+ (test-t (string= (substitute-if #\X (lambda (arg) (eql #\A arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
+ (test-t (string= (substitute-if #\X (lambda (arg) (char< #\D arg)) "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :count 3) "abcdeXXXij"))
+ (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) '(x y z)) '(a y z)))
+ (test-t (equal (substitute-if-not 'b (lambda (arg) (not (eq arg 'y))) '(x y z)) '(x b z)))
+ (test-t (equal (substitute-if-not 'c (lambda (arg) (not (eq arg 'z))) '(x y z)) '(x y c)))
+ (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'p))) '(x y z)) '(x y z)))
+ (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) ()) ()))
+ (test-t (equal (substitute-if-not #\x (lambda (arg) (not (char< #\b arg))) '(#\a #\b #\c #\d #\e)) '(#\a #\b #\x #\x #\x)))
+ (test-t (equal (substitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) '((x) (y) (z)) :key car) '((a) (y) (z))))
+ (test-t (equal (substitute-if-not 'c (lambda (arg) (not (eq arg 'b))) '(a b a b a b a b)) '(a c a c a c a c)))
+ (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'b))) '(b b b)) '(a a a)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f)) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count nil) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 0) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count -100) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 1) '(a z b x c x d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 2) '(a z b z c x d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 3) '(a z b z c z d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 4) '(a z b z c z d z e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 5) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 6) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 7) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count nil :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 0 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count -100 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 1 :from-end t) '(a x b x c x d x e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 2 :from-end t) '(a x b x c x d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 3 :from-end t) '(a x b x c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 4 :from-end t) '(a x b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 5 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 6 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 7 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+ (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+ (test-t (equal (substitute-if-not #\z (lambda (arg) (not (char< #\c arg))) '(#\a #\b #\c #\d #\e #\f)) '(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (equal "war" arg))) '("love" "hate" "war" "peace")) '("love" "hate" "peace" "peace")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string-equal "war" arg))) '("war" "War" "WAr" "WAR")) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :key string-upcase) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "war" arg))) '("war" "War" "WAr" "WAR") :key string-upcase) '("war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) #(x y z)) #(a y z)))
+ (test-t (equalp (substitute-if-not 'b (lambda (arg) (not (eq arg 'y))) #(x y z)) #(x b z)))
+ (test-t (equalp (substitute-if-not 'c (lambda (arg) (not (eq arg 'z))) #(x y z)) #(x y c)))
+ (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'p))) #(x y z)) #(x y z)))
+ (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) #()) #()))
+ (test-t (equalp (substitute-if-not #\x (lambda (arg) (not (char< #\b arg))) #(#\a #\b #\c #\d #\e)) #(#\a #\b #\x #\x #\x)))
+ (test-t (equalp (substitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) #((x) (y) (z)) :key car) #((a) (y) (z))))
+ (test-t (equalp (substitute-if-not 'c (lambda (arg) (not (eq arg 'b))) #(a b a b a b a b)) #(a c a c a c a c)))
+ (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'b))) #(b b b)) #(a a a)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+ (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+ (test-t (equalp (substitute-if-not #\z (lambda (arg) (not (char< #\c arg))) #(#\a #\b #\c #\d #\e #\f)) #(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (equal "war" arg))) #("love" "hate" "war" "peace")) #("love" "hate" "peace" "peace")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string-equal "war" arg))) #("war" "War" "WAr" "WAR")) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :key string-upcase) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "war" arg))) #("war" "War" "WAr" "WAR") :key string-upcase) #("war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "abcabc") "AbcAbc"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "") ""))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "xyz") "xyz"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
+ (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char< #\5 arg))) "0123456789") "012345xxxx"))
+ (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\5 arg))) "0123456789") "xxxxx56789"))
+ (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\D arg))) "abcdefg" :key char-upcase) "xxxdefg"))
+ (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\D arg))) "abcdefg" :start 1 :end 2 :key char-upcase) "axcdefg"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
+ (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
+ (test-t (string= (substitute-if-not #\x (lambda (arg) (not (eql #\A arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
+ (test-t (string= (substitute-if-not #\X (lambda (arg) (not (eql #\A arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
+ (test-t (string= (substitute-if-not #\X (lambda (arg) (not (char< #\D arg))) "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :count 3) "abcdeXXXij"))
+ (test-t (equal (nsubstitute 'a 'x (copy-seq '(x y z))) '(a y z)))
+ (test-t (equal (nsubstitute 'b 'y (copy-seq '(x y z))) '(x b z)))
+ (test-t (equal (nsubstitute 'c 'z (copy-seq '(x y z))) '(x y c)))
+ (test-t (equal (nsubstitute 'a 'p (copy-seq '(x y z))) '(x y z)))
+ (test-t (equal (nsubstitute 'a 'x (copy-seq ())) ()))
+ (test-t (equal (nsubstitute #\x #\b (copy-seq '(#\a #\b #\c #\d #\e)) :test char<) '(#\a #\b #\x #\x #\x)))
+ (test-t (equal (nsubstitute '(a) 'x (copy-seq '((x) (y) (z))) :key car) '((a) (y) (z))))
+ (test-t (equal (nsubstitute 'c 'b (copy-seq '(a b a b a b a b))) '(a c a c a c a c)))
+ (test-t (equal (nsubstitute 'a 'b (copy-seq '(b b b))) '(a a a)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count nil) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 0) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count -100) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 1) '(a z b x c x d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 2) '(a z b z c x d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 3) '(a z b z c z d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 4) '(a z b z c z d z e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 5) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 6) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 7) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count nil :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 0 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count -100 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 1 :from-end t) '(a x b x c x d x e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 2 :from-end t) '(a x b x c x d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 3 :from-end t) '(a x b x c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 4 :from-end t) '(a x b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 5 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 6 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 7 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+ (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+ (test-t (equal (nsubstitute #\z #\c (copy-seq '(#\a #\b #\c #\d #\e #\f)) :test char<) '(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equal (nsubstitute "peace" "war" (copy-seq '("love" "hate" "war" "peace")) :test equal) '("love" "hate" "peace" "peace")))
+ (test-t (equal (nsubstitute "peace" "war" (copy-seq '("war" "War" "WAr" "WAR")) :test string-equal) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR")) :test string=) '("war" "War" "WAr" "peace")))
+ (test-t (equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR")) :test string= :key string-upcase) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR")) :start 1 :end 2 :test string= :key string-upcase) '("war" "peace" "WAr" "WAR")))
+ (test-t (equalp (nsubstitute 'a 'x (copy-seq #(x y z))) #(a y z)))
+ (test-t (equalp (nsubstitute 'b 'y (copy-seq #(x y z))) #(x b z)))
+ (test-t (equalp (nsubstitute 'c 'z (copy-seq #(x y z))) #(x y c)))
+ (test-t (equalp (nsubstitute 'a 'p (copy-seq #(x y z))) #(x y z)))
+ (test-t (equalp (nsubstitute 'a 'x (copy-seq #())) #()))
+ (test-t (equalp (nsubstitute #\x #\b (copy-seq #(#\a #\b #\c #\d #\e)) :test char<) #(#\a #\b #\x #\x #\x)))
+ (test-t (equalp (nsubstitute '(a) 'x (copy-seq #((x) (y) (z))) :key car) #((a) (y) (z))))
+ (test-t (equalp (nsubstitute 'c 'b (copy-seq #(a b a b a b a b))) #(a c a c a c a c)))
+ (test-t (equalp (nsubstitute 'a 'b (copy-seq #(b b b))) #(a a a)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count nil) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 0) #(a x b x c x d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count -100) #(a x b x c x d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 1) #(a z b x c x d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 2) #(a z b z c x d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 3) #(a z b z c z d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 4) #(a z b z c z d z e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 5) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 6) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 7) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count nil :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 0 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count -100 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 1 :from-end t) #(a x b x c x d x e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 2 :from-end t) #(a x b x c x d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 3 :from-end t) #(a x b x c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 4 :from-end t) #(a x b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 5 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 6 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 7 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+ (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+ (test-t (equalp (nsubstitute #\z #\c (copy-seq #(#\a #\b #\c #\d #\e #\f)) :test char<) #(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equalp (nsubstitute "peace" "war" (copy-seq #("love" "hate" "war" "peace")) :test equal) #("love" "hate" "peace" "peace")))
+ (test-t (equalp (nsubstitute "peace" "war" (copy-seq #("war" "War" "WAr" "WAR")) :test string-equal) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR")) :test string=) #("war" "War" "WAr" "peace")))
+ (test-t (equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR")) :test string= :key string-upcase) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR")) :start 1 :end 2 :test string= :key string-upcase) #("war" "peace" "WAr" "WAR")))
+ (test-t (equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR")) :start 1 :end nil :test string= :key cl-string-upcase) #("war" "peace" "peace" "peace")))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "abcabc")) "AbcAbc"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "")) ""))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "xyz")) "xyz"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :start 5 :end nil) "aaaaaAAAAA"))
+ (test-t (string= (nsubstitute #\x #\5 (copy-seq "0123456789") :test char<) "012345xxxx"))
+ (test-t (string= (nsubstitute #\x #\5 (copy-seq "0123456789") :test char>) "xxxxx56789"))
+ (test-t (string= (nsubstitute #\x #\D (copy-seq "abcdefg") :key char-upcase :test char>) "xxxdefg"))
+ (test-t (string= (nsubstitute #\x #\D (copy-seq "abcdefg") :start 1 :end 2 :key char-upcase :test char>) "axcdefg"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 2) "AAaaaaaaaa"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count -1) "aaaaaaaaaa"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 0) "aaaaaaaaaa"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count nil) "AAAAAAAAAA"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 100) "AAAAAAAAAA"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 9) "AAAAAAAAAa"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 9 :from-end t) "aAAAAAAAAA"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :start 2 :end 8 :count 3) "aaAAAaaaaa"))
+ (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
+ (test-t (string= (nsubstitute #\x #\A (copy-seq "aaaaaaaaaa") :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
+ (test-t (string= (nsubstitute #\X #\A (copy-seq "aaaaaaaaaa") :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
+ (test-t (string= (nsubstitute #\X #\D (copy-seq "abcdefghij") :start 2 :end 8 :from-end t :key char-upcase :test char< :count 3) "abcdeXXXij"))
+ (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy-seq '(x y z))) '(a y z)))
+ (test-t (equal (nsubstitute-if 'b (lambda (arg) (eq arg 'y)) (copy-seq '(x y z))) '(x b z)))
+ (test-t (equal (nsubstitute-if 'c (lambda (arg) (eq arg 'z)) (copy-seq '(x y z))) '(x y c)))
+ (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'p)) (copy-seq '(x y z))) '(x y z)))
+ (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy-seq ())) ()))
+ (test-t (equal (nsubstitute-if #\x (lambda (arg) (char< #\b arg)) (copy-seq '(#\a #\b #\c #\d #\e))) '(#\a #\b #\x #\x #\x)))
+ (test-t (equal (nsubstitute-if '(a) (lambda (arg) (eq arg 'x)) (copy-seq '((x) (y) (z))) :key car) '((a) (y) (z))))
+ (test-t (equal (nsubstitute-if 'c (lambda (arg) (eq arg 'b)) (copy-seq '(a b a b a b a b))) '(a c a c a c a c)))
+ (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'b)) (copy-seq '(b b b))) '(a a a)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f))) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count nil) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 0) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count -100) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 1) '(a z b x c x d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 2) '(a z b z c x d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 3) '(a z b z c z d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 4) '(a z b z c z d z e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 5) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 6) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 7) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count nil :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 0 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count -100 :from-end t) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 1 :from-end t) '(a x b x c x d x e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 2 :from-end t) '(a x b x c x d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 3 :from-end t) '(a x b x c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 4 :from-end t) '(a x b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 5 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 6 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 7 :from-end t) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
+ (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
+ (test-t (equal (nsubstitute-if #\z (lambda (arg) (char< #\c arg)) (copy-seq '(#\a #\b #\c #\d #\e #\f))) '(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (equal "war" arg)) (copy-seq '("love" "hate" "war" "peace"))) '("love" "hate" "peace" "peace")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string-equal "war" arg)) (copy-seq '("war" "War" "WAr" "WAR"))) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR")) :key string-upcase) '("peace" "peace" "peace" "peace")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR")) :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR")) :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "war" arg)) (copy-seq '("war" "War" "WAr" "WAR")) :key string-upcase) '("war" "War" "WAr" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
+ (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy-seq #(x y z))) #(a y z)))
+ (test-t (equalp (nsubstitute-if 'b (lambda (arg) (eq arg 'y)) (copy-seq #(x y z))) #(x b z)))
+ (test-t (equalp (nsubstitute-if 'c (lambda (arg) (eq arg 'z)) (copy-seq #(x y z))) #(x y c)))
+ (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'p)) (copy-seq #(x y z))) #(x y z)))
+ (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy-seq #())) #()))
+ (test-t (equalp (nsubstitute-if #\x (lambda (arg) (char< #\b arg)) (copy-seq #(#\a #\b #\c #\d #\e))) #(#\a #\b #\x #\x #\x)))
+ (test-t (equalp (nsubstitute-if '(a) (lambda (arg) (eq arg 'x)) (copy-seq #((x) (y) (z))) :key car) #((a) (y) (z))))
+ (test-t (equalp (nsubstitute-if 'c (lambda (arg) (eq arg 'b)) (copy-seq #(a b a b a b a b))) #(a c a c a c a c)))
+ (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'b)) (copy-seq #(b b b))) #(a a a)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f))) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count nil) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 0) #(a x b x c x d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count -100) #(a x b x c x d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 1) #(a z b x c x d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 2) #(a z b z c x d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 3) #(a z b z c z d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 4) #(a z b z c z d z e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 5) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 6) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 7) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count nil :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 0 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count -100 :from-end t) #(a x b x c x d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 1 :from-end t) #(a x b x c x d x e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 2 :from-end t) #(a x b x c x d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 3 :from-end t) #(a x b x c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 4 :from-end t) #(a x b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 5 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 6 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 7 :from-end t) #(a z b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
+ (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
+ (test-t (equalp (nsubstitute-if #\z (lambda (arg) (char< #\c arg)) (copy-seq #(#\a #\b #\c #\d #\e #\f))) #(#\a #\b #\c #\z #\z #\z)))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (equal "war" arg)) (copy-seq #("love" "hate" "war" "peace"))) #("love" "hate" "peace" "peace")))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string-equal "war" arg)) (copy-seq #("war" "War" "WAr" "WAR"))) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR")) :key string-upcase) #("peace" "peace" "peace" "peace")))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR")) :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR")) :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "war" arg)) (copy-seq #("war" "War" "WAr" "WAR")) :key string-upcase) #("war" "War" "WAr" "WAR")))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
+ (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "abcabc")) "AbcAbc"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "")) ""))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "xyz")) "xyz"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :start 5 :end nil) "aaaaaAAAAA"))
+ (test-t (string= (nsubstitute-if #\x (lambda (arg) (char< #\5 arg)) (copy-seq "0123456789")) "012345xxxx"))
+ (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\5 arg)) (copy-seq "0123456789")) "xxxxx56789"))
+ (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\D arg)) (copy-seq "abcdefg") :key char-upcase) "xxxdefg"))
+ (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\D arg)) (copy-seq "abcdefg") :start 1 :end 2 :key char-upcase) "axcdefg"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 2) "AAaaaaaaaa"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count -1) "aaaaaaaaaa"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 0) "aaaaaaaaaa"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count nil) "AAAAAAAAAA"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 100) "AAAAAAAAAA"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 9) "AAAAAAAAAa"))
+ (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 9 :from-end t) "aAAAAAAAAA"))
+ (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'x))) (copy-seq '(x y z))) '(a y z)))
+ (test-t (equal (nsubstitute-if-not 'b (lambda (arg) (not (eq arg 'y))) (copy-seq '(x y z))) '(x b z)))
+ (test-t (equal (nsubstitute-if-not 'c (lambda (arg) (not (eq arg 'z))) (copy-seq '(x y z))) '(x y c)))
+ (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'p))) (copy-seq '(x y z))) '(x y z)))
+ (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'x))) (copy-seq ())) ()))
+ (test-t (equal (nsubstitute-if-not #\x (lambda (arg) (not (char< #\b arg))) (copy-seq '(#\a #\b #\c #\d #\e))) '(#\a #\b #\x #\x #\x)))
+ (test-t (equal (nsubstitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) (copy-seq '((x) (y) (z))) :key car) '((a) (y) (z))))
+ (test-t (equal (nsubstitute-if-not 'c (lambda (arg) (not (eq arg 'b))) (copy-seq '(a b a b a b a b))) '(a c a c a c a c)))
+ (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'b))) (copy-seq '(b b b))) '(a a a)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f))) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count nil) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 0) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count -100) '(a x b x c x d x e x f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 1) '(a z b x c x d x e x f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 2) '(a z b z c x d x e x f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 3) '(a z b z c z d x e x f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 4) '(a z b z c z d z e x f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 5) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 6) '(a z b z c z d z e z f)))
+ (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 7) '(a z b z c z d z e z f)))
+ )
+
+ (let ()
+ (define* (reduce function sequence from-end (start 0) end initial-value (key identity))
+ (let* ((slen (length sequence))
+ (nd (or (and (number? end) end) slen))
+ (len (min slen (- nd start))))
+ (if (< nd start)
+ (error "~A :start ~A is greater than ~A ~A" __func__ start (if end ":end" "length") nd))
+ (if (not (positive? len))
+ (or initial-value
+ (function))
+ (if (and (= len 1)
+ (not initial-value))
+ (sequence start)
+ (if (and (not from-end) (not (null? from-end)))
+ (let* ((first-arg (or initial-value (key (sequence start))))
+ (second-arg (if initial-value (key (sequence start)) (key (sequence (+ start 1)))))
+ (val (function first-arg second-arg)))
+ (do ((i (if initial-value (+ start 1) (+ start 2)) (+ i 1)))
+ ((= i nd) val)
+ (set! val (function val (key (sequence i))))))
+ (let* ((second-arg (or initial-value (key (sequence (- nd 1)))))
+ (first-arg (if initial-value (key (sequence (- nd 1))) (key (sequence (- nd 2)))))
+ (val (function first-arg second-arg)))
+ (do ((i (if initial-value (- nd 2) (- nd 3)) (- i 1)))
+ ((< i start) val)
+ (set! val (function (key (sequence i)) val)))))))))
+
+ (test-t (eql (reduce * '(1 2 3 4 5)) 120))
+ (test-t (equal (reduce append '((1) (2)) :initial-value '(i n i t)) '(i n i t 1 2)))
+ (test-t (equal (reduce append '((1) (2)) :from-end t :initial-value '(i n i t)) '(1 2 i n i t)))
+ (test-t (eql (reduce - '(1 2 3 4)) -8))
+ (test-t (eql (reduce - '(1 2 3 4) :from-end t) -2))
+ (test-t (eql (reduce + ()) 0))
+ (test-t (eql (reduce + '(3)) 3))
+ (test-t (eq (reduce + '(foo)) 'foo))
+ (test-t (equal (reduce list '(1 2 3 4)) '(((1 2) 3) 4)))
+ (test-t (equal (reduce list '(1 2 3 4) :from-end t) '(1 (2 (3 4)))))
+ (test-t (equal (reduce list '(1 2 3 4) :initial-value 'foo) '((((foo 1) 2) 3) 4)))
+ (test-t (equal (reduce list '(1 2 3 4) :from-end t :initial-value 'foo) '(1 (2 (3 (4 foo))))))
+ (test-t (equal (reduce list '(0 1 2 3)) '(((0 1) 2) 3)))
+ (test-t (equal (reduce list '(0 1 2 3) :start 1) '((1 2) 3)))
+ (test-t (equal (reduce list '(0 1 2 3) :start 1 :end nil) '((1 2) 3)))
+ (test-t (equal (reduce list '(0 1 2 3) :start 2) '(2 3)))
+ (test-t (eq (reduce list '(0 1 2 3) :start 0 :end 0) ()))
+ (test-t (eq (reduce list '(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value) 'initial-value))
+ (test-t (eq (reduce list '(0 1 2 3) :start 2 :end 2) ()))
+ (test-t (eq (reduce list '(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value) 'initial-value))
+ (test-t (eq (reduce list '(0 1 2 3) :start 4 :end 4) ()))
+ (test-t (eq (reduce list '(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value) 'initial-value))
+ (test-t (eql (reduce list '(0 1 2 3) :start 2 :end 3) 2))
+ (test-t (equal (reduce list '(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value) '(initial-value 2)))
+ (test-t (eql (reduce + '(0 1 2 3 4 5 6 7 8 9)) 45))
+ (test-t (eql (reduce - '(0 1 2 3 4 5 6 7 8 9)) -45))
+ (test-t (eql (reduce - '(0 1 2 3 4 5 6 7 8 9) :from-end t) -5))
+ (test-t (equal (reduce list '(0 1 2 3) :initial-value 'initial-value) '((((initial-value 0) 1) 2) 3)))
+ (test-t (equal (reduce list '(0 1 2 3) :from-end t) '(0 (1 (2 3)))))
+ (test-t (equal (reduce list '((1) (2) (3) (4)) :key car) '(((1 2) 3) 4)))
+ ;(test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end nil) '(((1 2) 3) 4)))
+ (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :initial-value 0) '((((0 1) 2) 3) 4)))
+ (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end t) '(1 (2 (3 4)))))
+ (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end t :initial-value 5) '(1 (2 (3 (4 5))))))
+ (test-t (equal (reduce list #(0 1 2 3)) '(((0 1) 2) 3)))
+ (test-t (equal (reduce list #(0 1 2 3) :start 1) '((1 2) 3)))
+ (test-t (equal (reduce list #(0 1 2 3) :start 1 :end nil) '((1 2) 3)))
+ (test-t (equal (reduce list #(0 1 2 3) :start 2) '(2 3)))
+ (test-t (eq (reduce list #(0 1 2 3) :start 0 :end 0) ()))
+ (test-t (eq (reduce list #(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value) 'initial-value))
+ (test-t (eq (reduce list #(0 1 2 3) :start 2 :end 2) ()))
+ (test-t (eq (reduce list #(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value) 'initial-value))
+ (test-t (eq (reduce list #(0 1 2 3) :start 4 :end 4) ()))
+ (test-t (eq (reduce list #(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value) 'initial-value))
+ (test-t (eql (reduce list #(0 1 2 3) :start 2 :end 3) 2))
+ (test-t (equal (reduce list #(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value) '(initial-value 2)))
+ (test-t (eql (reduce + #(0 1 2 3 4 5 6 7 8 9)) 45))
+ (test-t (eql (reduce - #(0 1 2 3 4 5 6 7 8 9)) -45))
+ (test-t (eql (reduce - #(0 1 2 3 4 5 6 7 8 9) :from-end t) -5))
+ (test-t (equal (reduce list #(0 1 2 3) :initial-value 'initial-value) '((((initial-value 0) 1) 2) 3)))
+ (test-t (equal (reduce list #(0 1 2 3) :from-end t) '(0 (1 (2 3)))))
+ (test-t (equal (reduce list #((1) (2) (3) (4)) :key car) '(((1 2) 3) 4)))
+ ;(test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end nil) '(((1 2) 3) 4)))
+ (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :initial-value 0) '((((0 1) 2) 3) 4)))
+ (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end t) '(1 (2 (3 4)))))
+ (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end t :initial-value 5) '(1 (2 (3 (4 5))))))
+ )
- ;; -------- vectors
+ (define (nreverse sequence)
+ (let ((len (length sequence)))
+ (do ((i 0 (+ i 1))
+ (j (- len 1) (- j 1)))
+ ((>= i j) sequence)
+ (let ((tmp (sequence i)))
+ (set! (sequence i) (sequence j))
+ (set! (sequence j) tmp)))))
- ;; vector is ok
+ (define (cl-reverse sequence)
+ (nreverse (copy sequence)))
+
+ (define (elt sequence index) (sequence index))
+ ;; length is ok
- (define svref vector-ref)
- (define aref vector-ref)
- (define array-dimensions vector-dimensions)
- (define array-total-size vector-length)
- (define (array-dimension array num) (list-ref (vector-dimensions array) num))
+ (define* (some predicate . sequences)
+ (call-with-exit
+ (lambda (return)
+ (apply for-each
+ (lambda args
+ (let ((val (apply predicate args)))
+ (if val (return val))))
+ sequences)
+ #f)))
- (define-constant array-dimension-limit 16777215)
- (define-constant array-rank-limit 4096)
- (define-constant array-total-size-limit 16777215)
+ (define* (notany predicate . sequences)
+ (not (apply some predicate sequences)))
- (define* (make-array dimensions element-type initial-element initial-contents adjustable fill-pointer displaced-to displaced-index-offset)
- (if (eq? element-type 'character)
- (or (and initial-contents
- (string-copy initial-contents))
- (cl-make-string dimensions initial-element))
- (make-vector (or dimensions 1) initial-element)))
+ (define* (every predicate . sequences)
+ (call-with-exit
+ (lambda (return)
+ (apply for-each
+ (lambda args
+ (if (not (apply predicate args))
+ (return #f)))
+ sequences)
+ #t)))
- (define (array-in-bounds-p array . subscripts)
- (define (in-bounds dims subs)
- (or (null? subs)
- (null? dims)
- (and (< (car subs) (car dims))
- (in-bounds (cdr dims) (cdr subs)))))
- (in-bounds (vector-dimensions array) subscripts))
+ (define* (notevery predicate . sequences)
+ (not (apply every predicate sequences)))
- (define (row-major-index array . subscripts)
- (apply + (maplist (lambda (x y)
- (* (car x) (apply * (cdr y))))
- subscripts
- (vector-dimensions array))))
+ (define* (cl-fill sequence item (start 0) end) ; actuall "fill" doesn't collide, but it's confusing
+ (let ((nd (or (and (not (null? end)) end)
+ (length sequence))))
+ (if (and (= start 0)
+ (= nd (length sequence)))
+ (fill! sequence item)
+ (do ((i start (+ i 1)))
+ ((= i nd))
+ (set! (sequence i) item)))
+ sequence))
+
+ ;; many of the sequence functions return a different length sequence, but
+ ;; for user-defined sequence types, we can't use the 'type kludge (or
+ ;; at least it's ugly), so we need either (make obj size initial-value)
+ ;; where obj is a representative of the desired type, or another
+ ;; arg to copy giving the new object's size. For now, I'll cobble up
+ ;; something explicit.
+ ;;
+ ;; perhaps the extended type could give its type symbol as well as the make function?
+
+ (define (make obj size)
+ (cond ((vector? obj) (make-vector size))
+ ((list? obj) (make-list size))
+ ((string? obj) (make-string size))
+ ((hash-table? obj) (make-hash-table size)))) ; does this make any sense?
+
+ (define* (make-sequence type size initial-element)
+ (case type
+ ((vector bit-vector simple-vector) (make-vector size initial-element))
+ ((hash-table) (make-hash-table size))
+ ((string) (cl-make-string size (or initial-element #\null))) ; not #f!
+ ((list) (cl-make-list size initial-element))
+ (else ())))
+
+ (define (cl-map type func . lists)
+ (let* ((vals (apply mapcar func lists))
+ (len (length vals)))
+ (let ((obj (make-sequence (or type 'list) len)))
+ (if (> (length obj) 0)
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (obj i) (vals i))))
+ obj)))
+
+ (define* (subseq sequence start end)
+ (let* ((len (length sequence))
+ (nd (or (and (number? end) end) len))
+ (size (- nd start))
+ (obj (make sequence size)))
+ (do ((i start (+ i 1))
+ (j 0 (+ j 1)))
+ ((= i nd) obj)
+ (set! (obj j) (sequence i)))))
+
+ (define (concatenate type . sequences)
+ (let* ((len (apply + (map length sequences)))
+ (new-obj (make-sequence type len))
+ (ctr 0))
+ (for-each
+ (lambda (sequence)
+ (for-each
+ (lambda (obj)
+ (set! (new-obj ctr) obj)
+ (set! ctr (+ ctr 1)))
+ sequence))
+ sequences)
+ new-obj))
+ ;; :(concatenate 'list "hiho" #(1 2)) -> (#\h #\i #\h #\o 1 2)
+ (define* (replace seq1 seq2 (start1 0) end1 (start2 0) end2)
+ (let* ((len1 (length seq1))
+ (len2 (length seq2))
+ (nd1 (or (and (number? end1) end1) len1))
+ (nd2 (or (and (number? end2) end2) len2)))
+ (if (and (eq? seq1 seq2)
+ (> start1 start2))
+ (let ((offset (- start1 start2)))
+ (do ((i (- nd1 1) (- i 1)))
+ ((< i start1) seq1)
+ (set! (seq1 i) (seq1 (- i offset)))))
+ (do ((i start1 (+ i 1))
+ (j start2 (+ j 1)))
+ ((or (= i nd1)
+ (= j nd2))
+ seq1)
+ (set! (seq1 i) (seq2 j))))))
+
+ (let ()
+ (define* (remove-if predicate sequence from-end (start 0) end count (key identity))
+ (let* ((len (length sequence))
+ (nd (or (and (number? end) end) len))
+ (num (if (number? count) count len))
+ (changed 0))
+ (if (not (positive? num))
+ sequence
+ (let ((result ()))
+ (if (null from-end)
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (if (or (< i start)
+ (>= i nd)
+ (>= changed num)
+ (not (predicate (key (sequence i)))))
+ (set! result (cons (sequence i) result))
+ (set! changed (+ changed 1))))
+ (do ((i (- len 1) (- i 1)))
+ ((< i 0))
+ (if (or (< i start)
+ (>= i nd)
+ (>= changed num)
+ (not (predicate (key (sequence i)))))
+ (set! result (cons (sequence i) result))
+ (set! changed (+ changed 1)))))
+ (let* ((len (length result))
+ (obj (make sequence len))
+ (vals (if (null from-end) (reverse result) result)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (obj i) (vals i)))
+ obj)))))
+
+ (define* (remove-if-not predicate sequence from-end (start 0) end count (key identity))
+ (remove-if (lambda (obj) (not (predicate obj))) sequence from-end start end count key))
+
+ (define* (remove item sequence from-end (test eql) (start 0) end count (key identity))
+ (remove-if (lambda (arg) (test item arg)) sequence from-end start end count key))
+
+ (define-macro* (delete-if predicate sequence from-end (start 0) end count (key identity))
+ `(let ((obj (remove-if ,predicate ,sequence ,from-end ,start ,end ,count ,key)))
+ (if (symbol? ',sequence)
+ (set! ,sequence obj))
+ obj))
+
+ (define-macro* (delete-if-not predicate sequence from-end (start 0) end count (key identity))
+ `(let ((obj (remove-if-not ,predicate ,sequence ,from-end ,start ,end ,count ,key)))
+ (if (symbol? ',sequence)
+ (set! ,sequence obj))
+ obj))
+
+ (define-macro* (delete item sequence from-end (test eql) (start 0) end count (key identity))
+ `(let ((obj (remove ,item ,sequence ,from-end ,test ,start ,end ,count ,key)))
+ (if (symbol? ',sequence)
+ (set! ,sequence obj))
+ obj))
+
+ (define* (remove-duplicates sequence from-end (test eql) (start 0) end (key identity))
+ (let* ((result ())
+ (start-seq (+ start 1))
+ (len (length sequence))
+ (nd (if (number? end) end len)))
+ (do ((i start (+ i 1)))
+ ((= i nd))
+ (let* ((orig-obj (sequence i))
+ (obj (key orig-obj)))
+ (if (null from-end)
+ (begin
+ (if (not (find obj sequence :start start-seq :end nd :test test :key key))
+ (set! result (cons orig-obj result)))
+ (set! start-seq (+ start-seq 1)))
+ (if (not (find obj result :test test :key key))
+ (set! result (cons orig-obj result))))))
+ (let* ((res (reverse result))
+ (new-len (+ (length result) start (- len nd)))
+ (new-seq (make sequence new-len)))
+ (let ((n 0))
+ (do ((i 0 (+ i 1)))
+ ((= i len) new-seq)
+ (if (or (< i start)
+ (>= i nd))
+ (begin
+ (set! (new-seq n) (sequence i))
+ (set! n (+ n 1)))
+ (if (not (null? res))
+ (begin
+ (set! (new-seq n) (car res))
+ (set! res (cdr res))
+ (set! n (+ n 1))))))))))
+
+ (define-macro* (delete-duplicates sequence from-end (test eql) (start 0) end (key identity))
+ `(let ((obj (remove-duplicates ,sequence ,from-end ,test ,start ,end ,key)))
+ (if (symbol? ,sequence)
+ (set! ,sequence obj))
+ obj))
+
+
+ (test-t (equal (remove 4 '(1 3 4 5 9)) '(1 3 5 9)))
+ (test-t (equal (remove 4 '(1 2 4 1 3 4 5)) '(1 2 1 3 5)))
+ (test-t (equal (remove 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5)))
+ (test-t (equal (remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
+ (test-t (equal (remove 3 '(1 2 4 1 3 4 5) :test >) '(4 3 4 5)))
+ (test-t (let* ((lst '(list of four elements)) (lst2 (copy-seq lst)) (lst3 (delete 'four lst))) (and (equal lst3 '(list of elements)) (not (equal lst lst2)))))
+ (test-t (equal (remove-if oddp '(1 2 4 1 3 4 5)) '(2 4 4)))
+ (test-t (equal (remove-if evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
+ (test-t (equal (remove-if-not evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t) '(1 2 3 4 5 6 8)))
+ (test-t (equal (delete 4 (list 1 2 4 1 3 4 5)) '(1 2 1 3 5)))
+ (test-t (equal (delete 4 (list 1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5)))
+ (test-t (equal (delete 4 (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
+ (test-t (equal (delete 3 (list 1 2 4 1 3 4 5) :test >) '(4 3 4 5)))
+ (test-t (equal (delete-if oddp (list 1 2 4 1 3 4 5)) '(2 4 4)))
+ (test-t (equal (delete-if evenp (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
+ (test-t (equal (delete-if evenp (list 1 2 3 4 5 6)) '(1 3 5)))
+ (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove 3 list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+ (test-t (equal (remove 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+ (test-t (equal (remove 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+ (test-t (equal (remove 'a (list 'a 'a 'a)) ()))
+ (test-t (equal (remove 'z (list 'a 'b 'c)) '(a b c)))
+ (test-t (equal (remove 'a ()) ()))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+ (test-t (equal (remove 'a (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) ()))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) '(("Love") ("LOve"))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+ (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove 3 vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+ (test-t (equalp (remove 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+ (test-t (equalp (remove 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+ (test-t (equalp (remove 'a (vector 'a 'a 'a)) #()))
+ (test-t (equalp (remove 'z (vector 'a 'b 'c)) #(a b c)))
+ (test-t (equalp (remove 'a #()) #()))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+ (test-t (equalp (remove 'a (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) #()))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+ (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (string= (remove #\a (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (remove #\a (copy-seq "")) ""))
+ (test-t (string= (remove #\a (copy-seq "xyz")) "xyz"))
+ (test-t (string= (remove #\a (copy-seq "ABCABC")) "ABCABC"))
+ (test-t (string= (remove #\a (copy-seq "ABCABC") :key char-downcase) "BCBC"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (let* ((str0 (copy-seq "abc")) (str (remove #\a str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (remove #\b (copy-seq "abcabc")) "acac"))
+ (test-t (string= (remove #\c (copy-seq "abcabc")) "abab"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 2) "bcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 3) "bcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 4) "bcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count -1) "abcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabc") :count -100) "abcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+ (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+ (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove-if (lambda (arg) (eql arg 3)) list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) ()))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) ()) ()))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+ (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equal (remove-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ()))
+ (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+ (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
+ (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+ (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove-if (lambda (arg) (eql arg 3)) vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'b)) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'c)) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'a 'a)) #()))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'z)) (vector 'a 'b 'c)) #(a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) #()) #()))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+ (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "")) ""))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "xyz")) "xyz"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "ABCABC") :key char-downcase) "BCBC"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (let* ((str0 (copy-seq "abc")) (str (remove-if (lambda (arg) (string-equal arg #\a)) str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\b)) (copy-seq "abcabc")) "acac"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\c)) (copy-seq "abcabc")) "abab"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 2) "bcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 3) "bcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 4) "bcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -1) "abcabc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -100) "abcabc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
+ (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+ (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+ (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove-if-not (lambda (arg) (not (eql arg 3))) list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'b))) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'c))) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'a 'a)) ()))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'z))) (list 'a 'b 'c)) '(a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) ()) ()))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ()))
+ (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+ (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove-if-not (lambda (arg) (not (eql arg 3))) vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'b))) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'c))) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'a 'a)) #()))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'z))) (vector 'a 'b 'c)) #(a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) #()) #()))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+ (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "")) ""))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "xyz")) "xyz"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "ABCABC") :key char-downcase) "BCBC"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (let* ((str0 (copy-seq "abc")) (str (remove-if-not (lambda (arg) (not (string-equal arg #\a))) str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\b))) (copy-seq "abcabc")) "acac"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\c))) (copy-seq "abcabc")) "abab"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 2) "bcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 3) "bcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 4) "bcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -1) "abcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -100) "abcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+ (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+ (test-t (equal (delete 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+ (test-t (equal (delete 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+ (test-t (equal (delete 'a (list 'a 'a 'a)) ()))
+ (test-t (equal (delete 'z (list 'a 'b 'c)) '(a b c)))
+ (test-t (equal (delete 'a ()) ()))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+ (test-t (equal (delete 'a (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) ()))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) '(("Love") ("LOve"))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+ (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+ (test-t (equalp (delete 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+ (test-t (equalp (delete 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+ (test-t (equalp (delete 'a (vector 'a 'a 'a)) #()))
+ (test-t (equalp (delete 'z (vector 'a 'b 'c)) #(a b c)))
+ (test-t (equalp (delete 'a #()) #()))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+ (test-t (equalp (delete 'a (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) #()))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+ (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (string= (delete #\a (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (delete #\a (copy-seq "")) ""))
+ (test-t (string= (delete #\a (copy-seq "xyz")) "xyz"))
+ (test-t (string= (delete #\a (copy-seq "ABCABC")) "ABCABC"))
+ (test-t (string= (delete #\a (copy-seq "ABCABC") :key char-downcase) "BCBC"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (delete #\b (copy-seq "abcabc")) "acac"))
+ (test-t (string= (delete #\c (copy-seq "abcabc")) "abab"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 2) "bcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 3) "bcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 4) "bcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count -1) "abcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabc") :count -100) "abcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+ (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) ()))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) ()) ()))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+ (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equal (delete-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ()))
+ (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+ (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
+ (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+ (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'b)) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'c)) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'a 'a)) #()))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'z)) (vector 'a 'b 'c)) #(a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) #()) #()))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+ (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "")) ""))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "xyz")) "xyz"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "ABCABC") :key char-downcase) "BCBC"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\b)) (copy-seq "abcabc")) "acac"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\c)) (copy-seq "abcabc")) "abab"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 2) "bcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 3) "bcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 4) "bcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -1) "abcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -100) "abcabc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
+ (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+ (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'b))) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'c))) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'a 'a)) ()))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'z))) (list 'a 'b 'c)) '(a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) ()) ()))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ()))
+ (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
+ (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'b))) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'c))) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'a 'a)) #()))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'z))) (vector 'a 'b 'c)) #(a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) #()) #()))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
+ (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "")) ""))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "xyz")) "xyz"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "ABCABC") :key char-downcase) "BCBC"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc")) "bcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\b))) (copy-seq "abcabc")) "acac"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\c))) (copy-seq "abcabc")) "abab"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1) "bcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 2) "bcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 3) "bcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 4) "bcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -1) "abcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -10) "abcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -100) "abcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
+ (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
+ (test-t (equal (remove-duplicates "aBcDAbCd" :test char-equal :from-end t) "aBcD"))
+ (test-t (equal (remove-duplicates '(a b c b d d e)) '(a c b d e)))
+ (test-t (equal (remove-duplicates '(a b c b d d e) :from-end t) '(a b c d e)))
+ (test-t (let* ((list0 (list 0 1 2 3 4 5 6)) (list (delete-duplicates list0 :key oddp :start 1 :end 6))) (equal list '(0 4 5 6))))
+ (test-t (let* ((list0 (list 2 1 0 1 0 1 2)) (list (remove-duplicates list0))) (and (not (eq list0 list)) (equal list0 '(2 1 0 1 0 1 2)) (equal list '(0 1 2)))))
+ (test-t (let* ((vector0 (vector 2 1 0 1 0 1 2)) (vector (remove-duplicates vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(2 1 0 1 0 1 2)) (equalp vector #(0 1 2)))))
+ (test-t (equal (remove-duplicates (list 0 1 2 2 3 3 3)) '(0 1 2 3)))
+ (test-t (equal (remove-duplicates (list 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) '(0 1 2)))
+ (test-t (equal (remove-duplicates (list 'a 'a 'b 'c 'c)) '(a b c)))
+ (test-t (equal (remove-duplicates (list 0 1 2)) '(0 1 2)))
+ (test-t (equal (remove-duplicates (list 2 0 2 1 1 1 0 0 0 1 2)) '(0 1 2)))
+ (test-t (equal (remove-duplicates (list)) ()))
+ (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr) '((a . 0) (b . 1) (c . 2))))
+ (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr :test (lambda (a b) (and (oddp a) (oddp b)))) '((x . 0) (z . 2) (a . 0) (b . 1) (c . 2))))
+ (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr :test (lambda (a b) (and (evenp a) (evenp b)))) '((y . 1) (b . 1) (c . 2))))
+ (test-t (equal (remove-duplicates (list 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9) '(0 1 2 0 1 2 0 1 2)))
+ (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11))) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11))))
+ (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :key car) '((0 . 9) (1 . 10) (2 . 11))))
+ (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2))))
+ (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :key car) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 9) '(1 . 10) '(2 . 11))))
+ (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5))))
+ (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end nil :key car) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 9) '(1 . 10) '(2 . 11))))
+ (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end 9 :key car) '((0 . 0) (1 . 1) (2 . 2) (0 . 6) (1 . 7) (2 . 8) (0 . 9) (1 . 10) (2 . 11))))
+ (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end 9 :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 9) '(1 . 10) '(2 . 11))))
+ (test-t (equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key length) (list "Tuesday" "Wednesday" "Saturday" "Sunday")))
+ (test-t (equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key (lambda (arg) (char arg 0)) :test char=) (list "Monday" "Wednesday" "Thursday" "Friday" "Sunday")))
+ (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key char-upcase) '(#\A #\B #\C)))
+ (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key char-upcase :from-end t) '(#\a #\b #\c)))
+ (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char=) (list #\a #\b #\c #\A #\B #\C)))
+ (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char-equal) (list #\A #\B #\C)))
+ (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char-equal :from-end t) (list #\a #\b #\c)))
+ (test-t (equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alpha-char-p) (list #\C #\9)))
+ (test-t (equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alphanumericp) (list #\9)))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car) (list '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9 :test char-equal) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9 :test char-equal :from-end t) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end nil) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :from-end t) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8))))
+ (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :end 9) (list '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
+ (test-t (equalp (remove-duplicates (vector 0 1 2 2 3 3 3)) #(0 1 2 3)))
+ (test-t (equalp (remove-duplicates (vector 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) #(0 1 2)))
+ (test-t (equalp (remove-duplicates (vector 'a 'a 'b 'c 'c)) #(a b c)))
+ (test-t (equalp (remove-duplicates (vector 0 1 2)) #(0 1 2)))
+ (test-t (equalp (remove-duplicates (vector 2 0 2 1 1 1 0 0 0 1 2)) #(0 1 2)))
+ (test-t (equalp (remove-duplicates (vector)) #()))
+ (test-t (equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr) #((a . 0) (b . 1) (c . 2))))
+ (test-t (equalp (remove-duplicates (vector 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9) #(0 1 2 0 1 2 0 1 2)))
+ (test-t (equalp (remove-duplicates (vector "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key length) (vector "Tuesday" "Wednesday" "Saturday" "Sunday")))
+ (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key char-upcase) #(#\A #\B #\C)))
+ (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key char-upcase :from-end t) #(#\a #\b #\c)))
+ (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char=) (vector #\a #\b #\c #\A #\B #\C)))
+ (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char-equal) (vector #\A #\B #\C)))
+ (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char-equal :from-end t) (vector #\a #\b #\c)))
+ (test-t (equalp (remove-duplicates (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alpha-char-p) (vector #\C #\9)))
+ (test-t (equalp (remove-duplicates (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alphanumericp) (vector #\9)))
+ (test-t (string= (remove-duplicates (copy-seq "")) ""))
+ (test-t (string= (remove-duplicates (copy-seq "abc")) "abc"))
+ (test-t (string= (remove-duplicates (copy-seq "abcabc")) "abc"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabc")) "abc"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabc") :from-end t) "cba"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA")) "abcCBA"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :from-end t) "cbaABC"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :key char-downcase) "CBA"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :key char-downcase :from-end t) "cba"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3) "cbaabcCBA"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :from-end t) "cbaabcABC"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9) "cbaabcABCCBA"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :key char-upcase) "cbaABCCBA"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :key char-upcase :from-end t) "cbaabcCBA"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :test char-equal :from-end t) "cbaabcCBA"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :key upper-case-p :test eq) "cbacCCBA"))
+ (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :key upper-case-p :test eq :from-end t) "cbaaACBA"))
+ )
+
+ (let ()
+ (define* (merge result-type seq1 seq2 predicate (key identity))
+ (let* ((len1 (length seq1))
+ (len2 (length seq2))
+ (size (+ len1 len2))
+ (obj (make-sequence result-type size))
+ (i 0)
+ (j 0))
+ (do ((n 0 (+ n 1)))
+ ((or (= i len1)
+ (= j len2))
+ (if (< i len1)
+ (do ((k i (+ k 1)))
+ ((= k len1) obj)
+ (set! (obj n) (seq1 k))
+ (set! n (+ n 1)))
+ (if (< j len2)
+ (do ((k j (+ k 1)))
+ ((= k len2) obj)
+ (set! (obj n) (seq2 k))
+ (set! n (+ n 1)))
+ obj)))
+ (if (null (predicate (key (seq1 i)) (key (seq2 j))))
+ (begin
+ (set! (obj n) (seq2 j))
+ (set! j (+ j 1)))
+ (begin
+ (set! (obj n) (seq1 i))
+ (set! i (+ i 1)))))))
+
+ (test-t (let ((test1 (list 1 3 4 6 7)) (test2 (list 2 5 8))) (equal (merge 'list test1 test2 <) '(1 2 3 4 5 6 7 8))))
+ (test-t (let ((test1 (vector '(red . 1) '(blue . 4))) (test2 (vector '(yellow . 2) '(green . 7)))) (equalp (merge 'vector test1 test2 < :key cdr) #((red . 1) (yellow . 2) (blue . 4) (green . 7)))))
+ (test-t (equal (merge 'list (list 1 3 5 7 9) (list 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equal (merge 'list (list 0 1 2) nil <) '(0 1 2)))
+ (test-t (equal (merge 'list nil (list 0 1 2) <) '(0 1 2)))
+ (test-t (equal (merge 'list nil nil <) nil))
+ (test-t (equal (merge 'list (list '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+ (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+ (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+ (test-t (equal (merge 'list (list 3 1 9 5 7) (list 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
+ (test-t (equal (merge 'list (vector 1 3 5 7 9) (list 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equal (merge 'list (vector 0 1 2) nil <) '(0 1 2)))
+ (test-t (equal (merge 'list #() (list 0 1 2) <) '(0 1 2)))
+ (test-t (equal (merge 'list #() #() <) nil))
+ (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+ (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+ (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+ (test-t (equal (merge 'list (vector 3 1 9 5 7) (list 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
+ (test-t (equal (merge 'list (list 1 3 5 7 9) (vector 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equal (merge 'list (list 0 1 2) #() <) '(0 1 2)))
+ (test-t (equal (merge 'list nil (vector 0 1 2) <) '(0 1 2)))
+ (test-t (equal (merge 'list nil #() <) nil))
+ (test-t (equal (merge 'list (list '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+ (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+ (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+ (test-t (equal (merge 'list (list 3 1 9 5 7) (vector 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
+ (test-t (equal (merge 'list (vector 1 3 5 7 9) (vector 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equal (merge 'list (vector 0 1 2) #() <) '(0 1 2)))
+ (test-t (equal (merge 'list #() (vector 0 1 2) <) '(0 1 2)))
+ (test-t (equal (merge 'list #() #() <) nil))
+ (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+ (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+ (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+ (test-t (equal (merge 'list (vector 3 1 9 5 7) (vector 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
+ (test-t (equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equalp (merge 'vector (list 0 1 2) nil <) #(0 1 2)))
+ (test-t (equalp (merge 'vector nil (list 0 1 2) <) #(0 1 2)))
+ (test-t (equalp (merge 'vector nil nil <) #()))
+ (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+ (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+ (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+ (test-t (equalp (merge 'vector (list 3 1 9 5 7) (list 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
+ (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equalp (merge 'vector (vector 0 1 2) nil <) #(0 1 2)))
+ (test-t (equalp (merge 'vector #() (list 0 1 2) <) #(0 1 2)))
+ (test-t (equalp (merge 'vector #() #() <) #()))
+ (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+ (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+ (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+ (test-t (equalp (merge 'vector (vector 3 1 9 5 7) (list 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
+ (test-t (equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equalp (merge 'vector (list 0 1 2) #() <) #(0 1 2)))
+ (test-t (equalp (merge 'vector nil (vector 0 1 2) <) #(0 1 2)))
+ (test-t (equalp (merge 'vector nil #() <) #()))
+ (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+ (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+ (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+ (test-t (equalp (merge 'vector (list 3 1 9 5 7) (vector 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
+ (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
+ (test-t (equalp (merge 'vector (vector 0 1 2) #() <) #(0 1 2)))
+ (test-t (equalp (merge 'vector #() (vector 0 1 2) <) #(0 1 2)))
+ (test-t (equalp (merge 'vector #() #() <) #()))
+ (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
+ (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
+ (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
+ (test-t (equalp (merge 'vector (vector 3 1 9 5 7) (vector 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
+ (test-t (string= (merge 'string (list #\a #\c #\e) (list #\b #\d #\f) char<) "abcdef"))
+ (test-t (string= (merge 'string (list #\a #\b #\c) (list #\d #\e #\f) char<) "abcdef"))
+ (test-t (string= (merge 'string (list #\a #\b #\c) () char<) "abc"))
+ (test-t (string= (merge 'string () (list #\a #\b #\c) char<) "abc"))
+ (test-t (string= (merge 'string (list #\a #\b #\c) (copy-seq "") char<) "abc"))
+ (test-t (string= (merge 'string (list #\a #\b #\z) #(#\c #\x #\y) char<) "abcxyz"))
+ )
+
+ (let ()
+ (define* (search seq1 seq2 from-end (test eql) (key identity) (start1 0) (start2 0) end1 end2)
+ (let* ((len1 (length seq1))
+ (len2 (length seq2))
+ (nd1 (or (and (number? end1) end1) len1))
+ (nd2 (or (and (number? end2) end2) len2)))
+ (set! len1 (min len1 (- nd1 start1)))
+ (set! len2 (min len2 (- nd2 start2)))
+ (if (or (= len2 0)
+ (> len1 len2))
+ ()
+ (call-with-exit
+ (lambda (return)
+ (if (or (not from-end) (null? from-end))
+ (do ((i start2 (+ i 1)))
+ ((> i (- nd2 len1)) ())
+ (do ((j start1 (+ j 1))
+ (k i (+ k 1)))
+ ((or (= j nd1)
+ (not (test (key (seq1 j)) (key (seq2 k)))))
+ (if (= j nd1)
+ (return i)))))
+ (do ((i (- nd2 len1) (- i 1)))
+ ((< i start2) ())
+ (do ((j start1 (+ j 1))
+ (k i (+ k 1)))
+ ((or (= j nd1)
+ (not (test (key (seq1 j)) (key (seq2 k)))))
+ (if (= j nd1)
+ (return i)))))))))))
+
+ (define* (mismatch seq1 seq2 from-end (test eql) (key identity) (start1 0) (start2 0) end1 end2)
+ (let* ((nd1 (or (and (number? end1) end1) (length seq1)))
+ (nd2 (or (and (number? end2) end2) (length seq2))))
+ (if (not from-end)
+ (do ((i start1 (+ i 1))
+ (j start2 (+ j 1)))
+ ((or (= i nd1)
+ (= j nd2)
+ (not (test (key (seq1 i)) (key (seq2 j)))))
+ (if (and (= i nd1) (= j nd2))
+ ()
+ i)))
+ (do ((i (- nd1 1) (- i 1))
+ (j (- nd2 1) (- j 1)))
+ ((or (< i start1)
+ (< j start2)
+ (not (test (key (seq1 i)) (key (seq2 j)))))
+ (if (and (< i start1) (< j start2))
+ ()
+ (+ i 1)))))))
+
+ (test-t (eql (search "dog" "it's a dog's life") 7))
+ (test-t (eql (search '(0 1) '(2 4 6 1 3 5) :key oddp) 2))
+ (test-t (null (search '(a b c) '(x y z))))
+ (test-t (eql (search () '(x y z)) 0))
+ (test-t (eql (search '(a) '(a)) 0))
+ (test-t (eql (search '(a b c) '(a b c x y z)) 0))
+ (test-t (eql (search '(a b c) '(x a b c y z)) 1))
+ (test-t (eql (search '(a b c) '(x y a b c z)) 2))
+ (test-t (eql (search '(a b c) '(x y z a b c)) 3))
+ (test-t (eql (search '(a b c) '(a b c a b c) :start2 1) 3))
+ (test-t (eql (search '(a b c) '(a b c a b c) :start2 1 :end2 nil) 3))
+ (test-t (eql (search '(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
+ (test-t (eql (search '(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
+ (test-t (null (search '(a b c) '(a b c a b c) :start2 0 :end2 0)))
+ (test-t (null (search '(a b c) '(a b c a b c) :start2 1 :end2 1)))
+ (test-t (null (search '(a b c) '(a b c a b c) :start2 2 :end2 2)))
+ (test-t (null (search '(a b c) '(a b c a b c) :start2 3 :end2 3)))
+ (test-t (null (search '(a b c) '(a b c a b c) :start2 4 :end2 4)))
+ (test-t (null (search '(a b c) '(a b c a b c) :start2 5 :end2 5)))
+ (test-t (null (search '(a b c) '(a b c a b c) :start2 6 :end2 6)))
+ (test-t (eql (search '(a b c) '(a b c a b c)) 0))
+ (test-t (eql (search '(a b c) '(a b c a b c) :from-end t) 3))
+ (test-t (eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6) 3))
+ (test-t (eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
+ (test-t (eql (search '(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
+ (test-t (eql (search '(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
+ (test-t (null (search '(#\a #\b #\c) '(#\A #\B #\C))))
+ (test-t (eql (search '(#\a #\b #\c) '(#\A #\B #\C) :test char-equal) 0))
+ (test-t (eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z)) 0))
+ (test-t (eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z) :test char<) 1))
+ (test-t (null (search '((a) (b)) '((x) (y) (z) (a) (b) (c)))))
+ (test-t (eql (search '((a) (b)) '((x) (y) (z) (a) (b) (c)) :key car) 3))
+ (test-t (eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+ (test-t (eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
+ (test-t (eql (search '((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+ (test-t (eql (search '((a a) (b b)) '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
+ (test-t (eql (search '(("a" a) ("b" b))
+ '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+ ("A" 0) ("B" 1) ("C" 2))
+ :start1 1
+ :end1 2
+ :start2 3
+ :end2 nil
+ :key car
+ :test string-equal
+ :from-end t)
+ 7))
+ (test-t (null (search #(a b c) '(x y z))))
+ (test-t (eql (search #() '(x y z)) 0))
+ (test-t (eql (search #(a) '(a)) 0))
+ (test-t (eql (search #(a b c) '(a b c x y z)) 0))
+ (test-t (eql (search #(a b c) '(x a b c y z)) 1))
+ (test-t (eql (search #(a b c) '(x y a b c z)) 2))
+ (test-t (eql (search #(a b c) '(x y z a b c)) 3))
+ (test-t (eql (search #(a b c) '(a b c a b c) :start2 1) 3))
+ (test-t (eql (search #(a b c) '(a b c a b c) :start2 1 :end2 nil) 3))
+ (test-t (eql (search #(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
+ (test-t (eql (search #(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
+ (test-t (null (search #(a b c) '(a b c a b c) :start2 0 :end2 0)))
+ (test-t (null (search #(a b c) '(a b c a b c) :start2 1 :end2 1)))
+ (test-t (null (search #(a b c) '(a b c a b c) :start2 2 :end2 2)))
+ (test-t (null (search #(a b c) '(a b c a b c) :start2 3 :end2 3)))
+ (test-t (null (search #(a b c) '(a b c a b c) :start2 4 :end2 4)))
+ (test-t (null (search #(a b c) '(a b c a b c) :start2 5 :end2 5)))
+ (test-t (null (search #(a b c) '(a b c a b c) :start2 6 :end2 6)))
+ (test-t (eql (search #(a b c) '(a b c a b c)) 0))
+ (test-t (eql (search #(a b c) '(a b c a b c) :from-end t) 3))
+ (test-t (eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6) 3))
+ (test-t (eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
+ (test-t (eql (search #(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
+ (test-t (eql (search #(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
+ (test-t (null (search #(#\a #\b #\c) '(#\A #\B #\C))))
+ (test-t (eql (search #(#\a #\b #\c) '(#\A #\B #\C) :test char-equal) 0))
+ (test-t (eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z)) 0))
+ (test-t (eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z) :test char<) 1))
+ (test-t (null (search #((a) (b)) '((x) (y) (z) (a) (b) (c)))))
+ (test-t (eql (search #((a) (b)) '((x) (y) (z) (a) (b) (c)) :key car) 3))
+ (test-t (eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+ (test-t (eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
+ (test-t (eql (search #((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+ (test-t (eql (search #((a a) (b b)) '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
+ (test-t (eql (search #(("a" a) ("b" b))
+ '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+ ("A" 0) ("B" 1) ("C" 2))
+ :start1 1
+ :end1 2
+ :start2 3
+ :end2 nil
+ :key car
+ :test string-equal
+ :from-end t)
+ 7))
+ (test-t (null (search '(a b c) #(x y z))))
+ (test-t (eql (search () #(x y z)) 0))
+ (test-t (eql (search '(a) #(a)) 0))
+ (test-t (eql (search '(a b c) #(a b c x y z)) 0))
+ (test-t (eql (search '(a b c) #(x a b c y z)) 1))
+ (test-t (eql (search '(a b c) #(x y a b c z)) 2))
+ (test-t (eql (search '(a b c) #(x y z a b c)) 3))
+ (test-t (eql (search '(a b c) #(a b c a b c) :start2 1) 3))
+ (test-t (eql (search '(a b c) #(a b c a b c) :start2 1 :end2 nil) 3))
+ (test-t (eql (search '(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
+ (test-t (eql (search '(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
+ (test-t (null (search '(a b c) #(a b c a b c) :start2 0 :end2 0)))
+ (test-t (null (search '(a b c) #(a b c a b c) :start2 1 :end2 1)))
+ (test-t (null (search '(a b c) #(a b c a b c) :start2 2 :end2 2)))
+ (test-t (null (search '(a b c) #(a b c a b c) :start2 3 :end2 3)))
+ (test-t (null (search '(a b c) #(a b c a b c) :start2 4 :end2 4)))
+ (test-t (null (search '(a b c) #(a b c a b c) :start2 5 :end2 5)))
+ (test-t (null (search '(a b c) #(a b c a b c) :start2 6 :end2 6)))
+ (test-t (eql (search '(a b c) #(a b c a b c)) 0))
+ (test-t (eql (search '(a b c) #(a b c a b c) :from-end t) 3))
+ (test-t (eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6) 3))
+ (test-t (eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
+ (test-t (eql (search '(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
+ (test-t (eql (search '(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
+ (test-t (null (search '(#\a #\b #\c) #(#\A #\B #\C))))
+ (test-t (eql (search '(#\a #\b #\c) #(#\A #\B #\C) :test char-equal) 0))
+ (test-t (eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z)) 0))
+ (test-t (eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z) :test char<) 1))
+ (test-t (null (search '((a) (b)) #((x) (y) (z) (a) (b) (c)))))
+ (test-t (eql (search '((a) (b)) #((x) (y) (z) (a) (b) (c)) :key car) 3))
+ (test-t (eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+ (test-t (eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
+ (test-t (eql (search '((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+ (test-t (eql (search '((a a) (b b)) #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
+ (test-t (eql (search '(("a" a) ("b" b))
+ #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+ ("A" 0) ("B" 1) ("C" 2))
+ :start1 1
+ :end1 2
+ :start2 3
+ :end2 nil
+ :key car
+ :test string-equal
+ :from-end t)
+ 7))
+ (test-t (null (search #(a b c) #(x y z))))
+ (test-t (eql (search #() #(x y z)) 0))
+ (test-t (eql (search #(a) #(a)) 0))
+ (test-t (eql (search #(a b c) #(a b c x y z)) 0))
+ (test-t (eql (search #(a b c) #(x a b c y z)) 1))
+ (test-t (eql (search #(a b c) #(x y a b c z)) 2))
+ (test-t (eql (search #(a b c) #(x y z a b c)) 3))
+ (test-t (eql (search #(a b c) #(a b c a b c) :start2 1) 3))
+ (test-t (eql (search #(a b c) #(a b c a b c) :start2 1 :end2 nil) 3))
+ (test-t (eql (search #(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
+ (test-t (eql (search #(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
+ (test-t (null (search #(a b c) #(a b c a b c) :start2 0 :end2 0)))
+ (test-t (null (search #(a b c) #(a b c a b c) :start2 1 :end2 1)))
+ (test-t (null (search #(a b c) #(a b c a b c) :start2 2 :end2 2)))
+ (test-t (null (search #(a b c) #(a b c a b c) :start2 3 :end2 3)))
+ (test-t (null (search #(a b c) #(a b c a b c) :start2 4 :end2 4)))
+ (test-t (null (search #(a b c) #(a b c a b c) :start2 5 :end2 5)))
+ (test-t (null (search #(a b c) #(a b c a b c) :start2 6 :end2 6)))
+ (test-t (eql (search #(a b c) #(a b c a b c)) 0))
+ (test-t (eql (search #(a b c) #(a b c a b c) :from-end t) 3))
+ (test-t (eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6) 3))
+ (test-t (eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
+ (test-t (eql (search #(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
+ (test-t (eql (search #(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
+ (test-t (null (search #(#\a #\b #\c) #(#\A #\B #\C))))
+ (test-t (eql (search #(#\a #\b #\c) #(#\A #\B #\C) :test char-equal) 0))
+ (test-t (eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z)) 0))
+ (test-t (eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z) :test char<) 1))
+ (test-t (null (search #((a) (b)) #((x) (y) (z) (a) (b) (c)))))
+ (test-t (eql (search #((a) (b)) #((x) (y) (z) (a) (b) (c)) :key car) 3))
+ (test-t (eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+ (test-t (eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
+ (test-t (eql (search #((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
+ (test-t (eql (search #((a a) (b b)) #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
+ (test-t (eql (search #(("a" a) ("b" b))
+ #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
+ ("A" 0) ("B" 1) ("C" 2))
+ :start1 1
+ :end1 2
+ :start2 3
+ :end2 nil
+ :key car
+ :test string-equal
+ :from-end t)
+ 7))
+ (test-t (null (search "peace" "LOVE&PEACE")))
+ (test-t (eql (search "peace" "LOVE&PEACE" :test char-equal) 5))
+ (test-t (null (search "PeAcE" "LoVe&pEaCe")))
+ (test-t (eql (search "PeAcE" "LoVe&pEaCe" :key char-upcase) 5))
+ (test-t (eql (search "abc" "abc xyz abc" :from-end t) 8))
+ (test-t (eql (search "abc" "abc xyz abc xyz abc xyz abc" :start2 8 :end2 19) 8))
+ (test-t (eql (search "abc" "abc xyz abc xyz abc xyz abc" :from-end t :start2 8 :end2 19) 16))
+ (test-t (eql (mismatch "abcd" "ABCDE" :test char-equal) 4))
+ (test-t (eql (mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t) 3))
+ (test-t (null (mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4)))
+ (test-t (null (mismatch () ())))
+ (test-t (eql (mismatch '(a b c) '(x y z)) 0))
+ (test-t (eql (mismatch () '(x y z)) 0))
+ (test-t (eql (mismatch '(x y z) ()) 0))
+ (test-t (null (mismatch '(a) '(a))))
+ (test-t (eql (mismatch '(a b c x y z) '(a b c)) 3))
+ (test-t (null (mismatch '(a b c) '(a b c))))
+ (test-t (eql (mismatch '(a b c d e f) '(a b c)) 3))
+ (test-t (eql (mismatch '(a b c) '(a b c d e f)) 3))
+ (test-t (eql (mismatch '(a b c) '(a b x)) 2))
+ (test-t (eql (mismatch '(a b c) '(a x c)) 1))
+ (test-t (eql (mismatch '(a b c) '(x b c)) 0))
+ (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3) 6))
+ (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6))
+ (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4))
+ (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3))
+ (test-t (null (mismatch '(x y z) () :start1 0 :end1 0)))
+ (test-t (null (mismatch '(x y z) () :start1 1 :end1 1)))
+ (test-t (null (mismatch '(x y z) () :start1 2 :end1 2)))
+ (test-t (null (mismatch '(x y z) () :start1 3 :end1 3)))
+ (test-t (null (mismatch '(x y z) () :start1 0 :end1 0 :start2 0 :end2 0)))
+ (test-t (null (mismatch '(x y z) () :start1 1 :end1 1 :start2 1 :end2 1)))
+ (test-t (null (mismatch '(x y z) () :start1 2 :end1 2 :start2 2 :end2 2)))
+ (test-t (null (mismatch '(x y z) () :start1 3 :end1 3 :start2 3 :end2 3)))
+ (test-t (null (mismatch '(x y z) () :start1 0 :end1 0 :start2 3 :end2 3)))
+ (test-t (null (mismatch '(x y z) () :start1 1 :end1 1 :start2 2 :end2 2)))
+ (test-t (null (mismatch '(x y z) () :start1 2 :end1 2 :start2 1 :end2 1)))
+ (test-t (null (mismatch '(x y z) () :start1 3 :end1 3 :start2 0 :end2 0)))
+ (test-t (eql (mismatch '(x y z) '(a b c) :start1 0 :end1 0) 0))
+ (test-t (eql (mismatch '(x y z) '(a b c) :start1 1 :end1 1) 1))
+ (test-t (eql (mismatch '(x y z) '(a b c) :start1 2 :end1 2) 2))
+ (test-t (eql (mismatch '(x y z) '(a b c) :start1 3 :end1 3) 3))
+ (test-t (eql (mismatch '(x y z) '(x y z) :start1 0 :end1 1) 1))
+ (test-t (eql (mismatch '(x y z) '(x y z) :start1 0 :end1 2) 2))
+ (test-t (eql (mismatch '(x y z) '(x y z Z) :start1 0 :end1 3) 3))
+ (test-t (null (mismatch '(x y z) '(x y z) :start1 0 :end1 3)))
+ (test-t (eql (mismatch '(a b c x y z) '(x y z a b c)) 0))
+ (test-t (eql (mismatch '(a b c x y z) '(x y z a b c) :start1 3) 6))
+ (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9))
+ (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6))
+ (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3) 9))
+ (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3) 6))
+ (test-t (eql (mismatch '(a b c) '(a b c x y z)) 3))
+ (test-t (eql (mismatch '(a b c) '(x a b c y z)) 0))
+ (test-t (eql (mismatch '(a b c) '(x a b c y z) :start2 1) 3))
+ (test-t (eql (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 nil) 3))
+ (test-t (null (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 4)))
+ (test-t (eql (mismatch '(a b c d e) '(c d)) 0))
+ (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2) 4))
+ (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :end1 3) 3))
+ (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :start2 1) 2))
+ (test-t (eql (mismatch '(a b c d e) '(c d) :start1 3 :start2 1) 4))
+ (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :end2 1) 3))
+ (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
+ (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
+ (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
+ (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
+ (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
+ (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
+ (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
+ (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1))
+ (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2))
+ (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3))
+ (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1)))
+ (test-t (null (mismatch '(a b c) '(a b c) :from-end t)))
+ (test-t (eql (mismatch '(a b c d) '(a b c) :from-end t) 4))
+ (test-t (eql (mismatch '(a b c) '(c) :from-end t) 2))
+ (test-t (eql (mismatch '(a b c) '(z a b c) :from-end t) 0))
+ (test-t (eql (mismatch '(a b c) '(x y z a b c) :from-end t) 0))
+ (test-t (eql (mismatch '(x y z a b c) '(a b c) :from-end t) 3))
+ (test-t (eql (mismatch '(x y z a b c) '(a b c) :end1 3 :from-end t) 3))
+ (test-t (eql (mismatch '(x y z a b c) '(a b c) :end1 5 :from-end t) 5))
+ (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3))
+ (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3))
+ (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
+ (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
+ (test-t (eql (mismatch '((a) (b) (c)) '((a) (b) (c))) 0))
+ (test-t (null (mismatch '((a) (b) (c)) '((a) (b) (c)) :key car)))
+ (test-t (null (mismatch '((a) (b) (c)) '((a) (b) (c)) :test equal)))
+ (test-t (eql (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0))
+ (test-t (null (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test equalp)))
+ (test-t (eql (mismatch '((a) (b) (c) (d)) '((a) (b) (c)) :key car) 3))
+ (test-t (eql (mismatch '((a) (b) (c)) '((a) (b) (c) (d)) :key car) 3))
+ (test-t (eql (mismatch '(#\a #\b #\c) '(#\A #\B #\C)) 0))
+ (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase)))
+ (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-downcase)))
+ (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
+ (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
+ (test-t (eql (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f))) 0))
+ (test-t (eql (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr) 0))
+ (test-t (null (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal)))
+ (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
+ (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
+ (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
+ (test-t (null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
+ (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
+ (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
+ (test-t (null (mismatch #() ())))
+ (test-t (eql (mismatch #(a b c) '(x y z)) 0))
+ (test-t (eql (mismatch #() '(x y z)) 0))
+ (test-t (eql (mismatch #(x y z) ()) 0))
+ (test-t (null (mismatch #(a) '(a))))
+ (test-t (eql (mismatch #(a b c x y z) '(a b c)) 3))
+ (test-t (null (mismatch #(a b c) '(a b c))))
+ (test-t (eql (mismatch #(a b c d e f) '(a b c)) 3))
+ (test-t (eql (mismatch #(a b c) '(a b c d e f)) 3))
+ (test-t (eql (mismatch #(a b c) '(a b x)) 2))
+ (test-t (eql (mismatch #(a b c) '(a x c)) 1))
+ (test-t (eql (mismatch #(a b c) '(x b c)) 0))
+ (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3) 6))
+ (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6))
+ (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4))
+ (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3))
+ (test-t (null (mismatch #(x y z) () :start1 0 :end1 0)))
+ (test-t (null (mismatch #(x y z) () :start1 1 :end1 1)))
+ (test-t (null (mismatch #(x y z) () :start1 2 :end1 2)))
+ (test-t (null (mismatch #(x y z) () :start1 3 :end1 3)))
+ (test-t (eql (mismatch #(x y z) '(a b c) :start1 0 :end1 0) 0))
+ (test-t (eql (mismatch #(x y z) '(a b c) :start1 1 :end1 1) 1))
+ (test-t (eql (mismatch #(x y z) '(a b c) :start1 2 :end1 2) 2))
+ (test-t (eql (mismatch #(x y z) '(a b c) :start1 3 :end1 3) 3))
+ (test-t (eql (mismatch #(x y z) '(x y z) :start1 0 :end1 1) 1))
+ (test-t (eql (mismatch #(x y z) '(x y z) :start1 0 :end1 2) 2))
+ (test-t (eql (mismatch #(x y z) '(x y z Z) :start1 0 :end1 3) 3))
+ (test-t (null (mismatch #(x y z) '(x y z) :start1 0 :end1 3)))
+ (test-t (eql (mismatch #(a b c x y z) '(x y z a b c)) 0))
+ (test-t (eql (mismatch #(a b c x y z) '(x y z a b c) :start1 3) 6))
+ (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9))
+ (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6))
+ (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3) 9))
+ (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3) 6))
+ (test-t (eql (mismatch #(a b c) '(a b c x y z)) 3))
+ (test-t (eql (mismatch #(a b c) '(x a b c y z)) 0))
+ (test-t (eql (mismatch #(a b c) '(x a b c y z) :start2 1) 3))
+ (test-t (eql (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 nil) 3))
+ (test-t (null (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 4)))
+ (test-t (eql (mismatch #(a b c d e) '(c d)) 0))
+ (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2) 4))
+ (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :end1 3) 3))
+ (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :start2 1) 2))
+ (test-t (eql (mismatch #(a b c d e) '(c d) :start1 3 :start2 1) 4))
+ (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :end2 1) 3))
+ (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
+ (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
+ (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
+ (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
+ (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
+ (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
+ (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
+ (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1))
+ (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2))
+ (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3))
+ (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1)))
+ (test-t (null (mismatch #(a b c) '(a b c) :from-end t)))
+ (test-t (eql (mismatch #(a b c d) '(a b c) :from-end t) 4))
+ (test-t (eql (mismatch #(a b c) '(c) :from-end t) 2))
+ (test-t (eql (mismatch #(a b c) '(z a b c) :from-end t) 0))
+ (test-t (eql (mismatch #(a b c) '(x y z a b c) :from-end t) 0))
+ (test-t (eql (mismatch #(x y z a b c) '(a b c) :from-end t) 3))
+ (test-t (eql (mismatch #(x y z a b c) '(a b c) :end1 3 :from-end t) 3))
+ (test-t (eql (mismatch #(x y z a b c) '(a b c) :end1 5 :from-end t) 5))
+ (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3))
+ (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3))
+ (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
+ (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
+ (test-t (eql (mismatch #((a) (b) (c)) '((a) (b) (c))) 0))
+ (test-t (null (mismatch #((a) (b) (c)) '((a) (b) (c)) :key car)))
+ (test-t (null (mismatch #((a) (b) (c)) '((a) (b) (c)) :test equal)))
+ (test-t (eql (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0))
+ (test-t (null (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test equalp)))
+ (test-t (eql (mismatch #((a) (b) (c) (d)) '((a) (b) (c)) :key car) 3))
+ (test-t (eql (mismatch #((a) (b) (c)) '((a) (b) (c) (d)) :key car) 3))
+ (test-t (eql (mismatch #(#\a #\b #\c) '(#\A #\B #\C)) 0))
+ (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase)))
+ (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-downcase)))
+ (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
+ (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
+ (test-t (eql (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f))) 0))
+ (test-t (eql (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr) 0))
+ (test-t (null (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal)))
+ (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
+ (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
+ (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
+ (test-t (null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
+ (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
+ (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
+ (test-t (null (mismatch () #())))
+ (test-t (eql (mismatch '(a b c) #(x y z)) 0))
+ (test-t (eql (mismatch () #(x y z)) 0))
+ (test-t (eql (mismatch '(x y z) #()) 0))
+ (test-t (null (mismatch '(a) #(a))))
+ (test-t (eql (mismatch '(a b c x y z) #(a b c)) 3))
+ (test-t (null (mismatch '(a b c) #(a b c))))
+ (test-t (eql (mismatch '(a b c d e f) #(a b c)) 3))
+ (test-t (eql (mismatch '(a b c) #(a b c d e f)) 3))
+ (test-t (eql (mismatch '(a b c) #(a b x)) 2))
+ (test-t (eql (mismatch '(a b c) #(a x c)) 1))
+ (test-t (eql (mismatch '(a b c) #(x b c)) 0))
+ (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3) 6))
+ (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6))
+ (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4))
+ (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3))
+ (test-t (null (mismatch '(x y z) #() :start1 0 :end1 0)))
+ (test-t (null (mismatch '(x y z) #() :start1 1 :end1 1)))
+ (test-t (null (mismatch '(x y z) #() :start1 2 :end1 2)))
+ (test-t (null (mismatch '(x y z) #() :start1 3 :end1 3)))
+ (test-t (eql (mismatch '(x y z) #(a b c) :start1 0 :end1 0) 0))
+ (test-t (eql (mismatch '(x y z) #(a b c) :start1 1 :end1 1) 1))
+ (test-t (eql (mismatch '(x y z) #(a b c) :start1 2 :end1 2) 2))
+ (test-t (eql (mismatch '(x y z) #(a b c) :start1 3 :end1 3) 3))
+ (test-t (eql (mismatch '(x y z) #(x y z) :start1 0 :end1 1) 1))
+ (test-t (eql (mismatch '(x y z) #(x y z) :start1 0 :end1 2) 2))
+ (test-t (eql (mismatch '(x y z) #(x y z Z) :start1 0 :end1 3) 3))
+ (test-t (null (mismatch '(x y z) #(x y z) :start1 0 :end1 3)))
+ (test-t (eql (mismatch '(a b c x y z) #(x y z a b c)) 0))
+ (test-t (eql (mismatch '(a b c x y z) #(x y z a b c) :start1 3) 6))
+ (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9))
+ (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6))
+ (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3) 9))
+ (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3) 6))
+ (test-t (eql (mismatch '(a b c) #(a b c x y z)) 3))
+ (test-t (eql (mismatch '(a b c) #(x a b c y z)) 0))
+ (test-t (eql (mismatch '(a b c) #(x a b c y z) :start2 1) 3))
+ (test-t (eql (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 nil) 3))
+ (test-t (null (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 4)))
+ (test-t (eql (mismatch '(a b c d e) #(c d)) 0))
+ (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2) 4))
+ (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :end1 3) 3))
+ (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :start2 1) 2))
+ (test-t (eql (mismatch '(a b c d e) #(c d) :start1 3 :start2 1) 4))
+ (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :end2 1) 3))
+ (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
+ (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
+ (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
+ (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
+ (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
+ (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
+ (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
+ (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1))
+ (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2))
+ (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3))
+ (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1)))
+ (test-t (null (mismatch '(a b c) #(a b c) :from-end t)))
+ (test-t (eql (mismatch '(a b c d) #(a b c) :from-end t) 4))
+ (test-t (eql (mismatch '(a b c) #(c) :from-end t) 2))
+ (test-t (eql (mismatch '(a b c) #(z a b c) :from-end t) 0))
+ (test-t (eql (mismatch '(a b c) #(x y z a b c) :from-end t) 0))
+ (test-t (eql (mismatch '(x y z a b c) #(a b c) :from-end t) 3))
+ (test-t (eql (mismatch '(x y z a b c) #(a b c) :end1 3 :from-end t) 3))
+ (test-t (eql (mismatch '(x y z a b c) #(a b c) :end1 5 :from-end t) 5))
+ (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3))
+ (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3))
+ (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
+ (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
+ (test-t (eql (mismatch '((a) (b) (c)) #((a) (b) (c))) 0))
+ (test-t (null (mismatch '((a) (b) (c)) #((a) (b) (c)) :key car)))
+ (test-t (null (mismatch '((a) (b) (c)) #((a) (b) (c)) :test equal)))
+ (test-t (eql (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0))
+ (test-t (null (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test equalp)))
+ (test-t (eql (mismatch '((a) (b) (c) (d)) #((a) (b) (c)) :key car) 3))
+ (test-t (eql (mismatch '((a) (b) (c)) #((a) (b) (c) (d)) :key car) 3))
+ (test-t (eql (mismatch '(#\a #\b #\c) #(#\A #\B #\C)) 0))
+ (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase)))
+ (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-downcase)))
+ (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
+ (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
+ (test-t (eql (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f))) 0))
+ (test-t (eql (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr) 0))
+ (test-t (null (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal)))
+ (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
+ (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
+ (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
+ (test-t (null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
+ (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
+ (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
+ (test-t (null (mismatch #() #())))
+ (test-t (eql (mismatch #(a b c) #(x y z)) 0))
+ (test-t (eql (mismatch #() #(x y z)) 0))
+ (test-t (eql (mismatch #(x y z) #()) 0))
+ (test-t (null (mismatch #(a) #(a))))
+ (test-t (eql (mismatch #(a b c x y z) #(a b c)) 3))
+ (test-t (null (mismatch #(a b c) #(a b c))))
+ (test-t (eql (mismatch #(a b c d e f) #(a b c)) 3))
+ (test-t (eql (mismatch #(a b c) #(a b c d e f)) 3))
+ (test-t (eql (mismatch #(a b c) #(a b x)) 2))
+ (test-t (eql (mismatch #(a b c) #(a x c)) 1))
+ (test-t (eql (mismatch #(a b c) #(x b c)) 0))
+ (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3) 6))
+ (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6))
+ (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4))
+ (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3))
+ (test-t (null (mismatch #(x y z) #() :start1 0 :end1 0)))
+ (test-t (null (mismatch #(x y z) #() :start1 1 :end1 1)))
+ (test-t (null (mismatch #(x y z) #() :start1 2 :end1 2)))
+ (test-t (null (mismatch #(x y z) #() :start1 3 :end1 3)))
+ (test-t (eql (mismatch #(x y z) #(a b c) :start1 0 :end1 0) 0))
+ (test-t (eql (mismatch #(x y z) #(a b c) :start1 1 :end1 1) 1))
+ (test-t (eql (mismatch #(x y z) #(a b c) :start1 2 :end1 2) 2))
+ (test-t (eql (mismatch #(x y z) #(a b c) :start1 3 :end1 3) 3))
+ (test-t (eql (mismatch #(x y z) #(x y z) :start1 0 :end1 1) 1))
+ (test-t (eql (mismatch #(x y z) #(x y z) :start1 0 :end1 2) 2))
+ (test-t (eql (mismatch #(x y z) #(x y z Z) :start1 0 :end1 3) 3))
+ (test-t (null (mismatch #(x y z) #(x y z) :start1 0 :end1 3)))
+ (test-t (eql (mismatch #(a b c x y z) #(x y z a b c)) 0))
+ (test-t (eql (mismatch #(a b c x y z) #(x y z a b c) :start1 3) 6))
+ (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9))
+ (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6))
+ (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3) 9))
+ (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3) 6))
+ (test-t (eql (mismatch #(a b c) #(a b c x y z)) 3))
+ (test-t (eql (mismatch #(a b c) #(x a b c y z)) 0))
+ (test-t (eql (mismatch #(a b c) #(x a b c y z) :start2 1) 3))
+ (test-t (eql (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 nil) 3))
+ (test-t (null (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 4)))
+ (test-t (eql (mismatch #(a b c d e) #(c d)) 0))
+ (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2) 4))
+ (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :end1 3) 3))
+ (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :start2 1) 2))
+ (test-t (eql (mismatch #(a b c d e) #(c d) :start1 3 :start2 1) 4))
+ (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :end2 1) 3))
+ (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
+ (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
+ (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
+ (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
+ (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
+ (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
+ (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
+ (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1))
+ (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2))
+ (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3))
+ (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1)))
+ (test-t (null (mismatch #(a b c) #(a b c) :from-end t)))
+ (test-t (eql (mismatch #(a b c d) #(a b c) :from-end t) 4))
+ (test-t (eql (mismatch #(a b c) #(c) :from-end t) 2))
+ (test-t (eql (mismatch #(a b c) #(z a b c) :from-end t) 0))
+ (test-t (eql (mismatch #(a b c) #(x y z a b c) :from-end t) 0))
+ (test-t (eql (mismatch #(x y z a b c) #(a b c) :from-end t) 3))
+ (test-t (eql (mismatch #(x y z a b c) #(a b c) :end1 3 :from-end t) 3))
+ (test-t (eql (mismatch #(x y z a b c) #(a b c) :end1 5 :from-end t) 5))
+ (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3))
+ (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3))
+ (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
+ (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
+ (test-t (eql (mismatch #((a) (b) (c)) #((a) (b) (c))) 0))
+ (test-t (null (mismatch #((a) (b) (c)) #((a) (b) (c)) :key car)))
+ (test-t (null (mismatch #((a) (b) (c)) #((a) (b) (c)) :test equal)))
+ (test-t (eql (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0))
+ (test-t (null (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test equalp)))
+ (test-t (eql (mismatch #((a) (b) (c) (d)) #((a) (b) (c)) :key car) 3))
+ (test-t (eql (mismatch #((a) (b) (c)) #((a) (b) (c) (d)) :key car) 3))
+ (test-t (eql (mismatch #(#\a #\b #\c) #(#\A #\B #\C)) 0))
+ (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase)))
+ (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-downcase)))
+ (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
+ (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
+ (test-t (eql (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f))) 0))
+ (test-t (eql (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr) 0))
+ (test-t (null (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal)))
+ (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
+ (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
+ (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
+ (test-t (null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
+ (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
+ (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
+ (test-t (eql (mismatch "abc" "xyz") 0))
+ (test-t (null (mismatch "" "")))
+ (test-t (null (mismatch "a" "a")))
+ (test-t (null (mismatch "abc" "abc")))
+ (test-t (null (mismatch "abc" "ABC" :key char-downcase)))
+ (test-t (null (mismatch "abc" "ABC" :test char-equal)))
+ (test-t (eql (mismatch "abcde" "abc") 3))
+ (test-t (eql (mismatch "abc" "abcde") 3))
+ (test-t (eql (mismatch "abc" "abxyz") 2))
+ (test-t (eql (mismatch "abcde" "abx") 2))
+ (test-t (null (mismatch "abc" "abc" :from-end t)))
+ (test-t (eql (mismatch "abcxyz" "xyzxyz" :from-end t) 3))
+ (test-t (eql (mismatch "abcxyz" "xyz" :from-end t) 3))
+ (test-t (eql (mismatch "xyz" "abcxyz" :from-end t) 0))
+ (test-t (eql (mismatch "ayz" "abcxyz" :from-end t) 1))
+ (test-t (null (mismatch "abc" "xyz" :test char<)))
+ (test-t (eql (mismatch "abc" "xyz" :test char>) 0))
+ (test-t (eql (mismatch "abcxyz" "abcdefg") 3))
+ (test-t (eql (mismatch "1xyz" "22xyz" :from-end t) 1))
+ )
+
;; -------- defstruct
(defmacro defstruct (struct-name . fields)
@@ -24328,7 +43384,7 @@ abs 1 2
`(define ,(string->symbol (string-append fsname "-" n))
(lambda (arg) (arg ,ctr)))
`(define ,(string->symbol (string-append fsname "-" n))
- (make-procedure-with-setter
+ (dilambda
(lambda (arg) (arg ,ctr))
(lambda (arg val) (set! (arg ,ctr) val)))))))
(set! ctr (+ 1 ctr))
@@ -24340,7 +43396,7 @@ abs 1 2
(define-macro (enum . args) ; (enum zero one two)
`(begin
- ,@(let ((names '()))
+ ,@(let ((names ()))
(do ((arg args (cdr arg))
(i 0 (+ i 1)))
((null? arg) names)
@@ -24349,8 +43405,8 @@ abs 1 2
names))))))
(define-macro (let*-values vals . body)
- (let ((args '())
- (exprs '()))
+ (let ((args ())
+ (exprs ()))
(for-each
(lambda (arg+expr)
(set! args (cons (car arg+expr) args))
@@ -24368,8 +43424,6 @@ abs 1 2
(let ()
;; this is the nbody computer shootout benchmark taken from mzscheme
- ;; if we were serious about benchmarks, this could use run.
-
(define +days-per-year+ 365.24)
(define +solar-mass+ (* 4 pi pi))
(defstruct body x y z vx vy vz mass)
@@ -24844,7 +43898,6 @@ abs 1 2
(test-t (not (lower-case-p #\A)))
(test-t (lower-case-p #\a))
(test-t (not (lower-case-p #\-)))
-; (test-t (char= #\ (name-char (char-name #\ ))))
; (test-t (char= #\Space (name-char (char-name #\Space))))
; (test-t (char= #\Newline (name-char (char-name #\Newline))))
@@ -24864,14 +43917,14 @@ abs 1 2
(test-t (string= (cl-string 'abc) "abc"))
(test-t (string= (cl-string 'a) "a"))
(test-t (string= (cl-string #\a) "a"))
- (test-t (string= (string-upcase "abcde") "ABCDE"))
- (test-t (string= (string-upcase "Dr. Livingston, I presume?") "DR. LIVINGSTON, I PRESUME?"))
- (test-t (string= (string-upcase "Dr. Livingston, I presume?" :start 6 :end 10) "Dr. LiVINGston, I presume?"))
- (test-t (string= (string-upcase 'Kludgy-HASH-Search) "KLUDGY-HASH-SEARCH"))
- (test-t (string= (string-upcase "abcde" :start 2 :end nil) "abCDE"))
- (test-t (string= (string-downcase "Dr. Livingston, I presume?") "dr. livingston, i presume?"))
- (test-t (string= (string-downcase 'Kludgy-HASH-Search) "kludgy-hash-search"))
- (test-t (string= (string-downcase "A FOOL" :start 2 :end nil) "A fool"))
+ (test-t (string= (cl-string-upcase "abcde") "ABCDE"))
+ (test-t (string= (cl-string-upcase "Dr. Livingston, I presume?") "DR. LIVINGSTON, I PRESUME?"))
+ (test-t (string= (cl-string-upcase "Dr. Livingston, I presume?" :start 6 :end 10) "Dr. LiVINGston, I presume?"))
+ (test-t (string= (cl-string-upcase 'Kludgy-HASH-Search) "KLUDGY-HASH-SEARCH"))
+ (test-t (string= (cl-string-upcase "abcde" :start 2 :end nil) "abCDE"))
+ (test-t (string= (cl-string-downcase "Dr. Livingston, I presume?") "dr. livingston, i presume?"))
+ (test-t (string= (cl-string-downcase 'Kludgy-HASH-Search) "kludgy-hash-search"))
+ (test-t (string= (cl-string-downcase "A FOOL" :start 2 :end nil) "A fool"))
(test-t (string= (string-capitalize "elm 13c arthur;fig don't") "Elm 13c Arthur;Fig Don'T"))
(test-t (string= (string-capitalize " hello ") " Hello "))
(test-t (string= (string-capitalize "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") "Occluded Casements Forestall Inadvertent Defenestration"))
@@ -25264,11 +44317,11 @@ abs 1 2
(test-t (= 3 (let ((x 0)) (dotimes (i 3 x) (incf x)))))
(test-t (= 3 (dotimes (i 3 i) )))
(test-t (= 3 (let ((x 0)) (dotimes (i 3 x) (declare (fixnum i)) (incf x)))))
- (test-t (null (dolist (x '()))))
+ (test-t (null (dolist (x ()))))
(test-t (null (dolist (x '(a)))))
(test-t (eq t (dolist (x nil t))))
(test-t (= 6 (let ((sum 0)) (dolist (x '(0 1 2 3) sum) (incf sum x)))))
- (test-t (let ((temp-two '())) (equal (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two)) '(4 3 2 1))))
+ (test-t (let ((temp-two ())) (equal (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two)) '(4 3 2 1))))
(test-t (let ((temp-two 0)) (and (null (dolist (temp-one '(1 2 3 4)) (incf temp-two))) (eql temp-two 4))))
(test-t (null (dolist (var nil var))))
(test-t (let ((list nil)) (equal (dolist (var '(0 1 2 3) list) (push var list)) '(3 2 1 0))))
@@ -25359,7 +44412,7 @@ abs 1 2
(test-t (let ((a (cons 1 2))) (and (eql (car a) 1) (eql (cdr a) 2))))
(test-t (equal (cons 1 nil) '(1)))
(test-t (equal (cons nil nil) '(())))
- (test-t (equal (cons 'a (cons 'b (cons 'c '()))) '(a b c)))
+ (test-t (equal (cons 'a (cons 'b (cons 'c ()))) '(a b c)))
(test-t (atom 'a))
(test-t (atom nil))
(test-t (atom 1))
@@ -25373,13 +44426,13 @@ abs 1 2
(test-t (listp (cons 'a 'b)))
(test-t (not (listp 1)))
(test-t (not (listp 't)))
- (test-t (null '()))
+ (test-t (null ()))
(test-t (null nil))
(test-t (not (null t)))
(test-t (null (cdr '(a))))
(test-t (not (null (cdr '(1 . 2)))))
(test-t (not (null 'a)))
- (test-t (endp '()))
+ (test-t (endp ()))
(test-t (not (endp '(1))))
(test-t (not (endp '(1 2))))
(test-t (not (endp '(1 2 3))))
@@ -25459,9 +44512,9 @@ abs 1 2
(and (equal (sublis '((a . 1) (b . 2) (c . 3)) x)
'(1 2 3 d))
(equal x '(a b c d)))))
- (test-t (eq (sublis '() '()) '()))
- (test-t (equal (sublis '() '(1 2 3)) '(1 2 3)))
- (test-t (eq (sublis '((a . 1) (b . 2)) '()) nil))
+ (test-t (eq (sublis () ()) ()))
+ (test-t (equal (sublis () '(1 2 3)) '(1 2 3)))
+ (test-t (eq (sublis '((a . 1) (b . 2)) ()) nil))
(test-t (equal (sublis '((a . 1) (b . 2) (c . 3)) '(((a)) (b) c)) '(((1)) (2) 3)))
(test-t (equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3)) '((((a))) ((b)) (c))) '((((a))) ((b)) (c))))
(test-t (equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3)) '((((a))) ((b)) (c)) :test equal) '(((1)) (2) 3)))
@@ -25479,131 +44532,13 @@ abs 1 2
(eq (cdr m) n)
(eq (car n) 'n)
(eq (cdr n) nil))))
- (test-t (eq (nsublis '() '()) '()))
- (test-t (equal (nsublis '() '(1 2 3)) '(1 2 3)))
- (test-t (eq (nsublis '((a . 1) (b . 2)) '()) nil))
+ (test-t (eq (nsublis () ()) ()))
+ (test-t (equal (nsublis () '(1 2 3)) '(1 2 3)))
+ (test-t (eq (nsublis '((a . 1) (b . 2)) ()) nil))
(test-t (equal (nsublis '((a b c) (b c d) (c d e)) (list 'a 'b 'c)) '((b c) (c d) (d e))))
(test-t (equal (nsublis '((a . 1) (b . 2) (c . 3)) (copy-tree '(((a)) (b) c))) '(((1)) (2) 3)))
(test-t (equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3)) (copy-tree '((((a))) ((b)) (c)))) '((((a))) ((b)) (c))))
(test-t (equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3)) (copy-tree '((((a))) ((b)) (c))) :test equal) '(((1)) (2) 3)))
- (test-t (let ((tree '(old (old) ((old))))) (equal (subst 'new 'old tree) '(new (new) ((new))))))
- (test-t (eq (subst 'new 'old 'old) 'new))
- (test-t (eq (subst 'new 'old 'not-old) 'not-old))
- (test-t (equal (subst 'new '(b) '(a ((b))) :test equal) '(a (new))))
- (test-t (equal (subst 'x 3 '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
- (test-t (equal (subst 'x "D" '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
- :test equalp
- :key (lambda (y) (and (listp y) (fourth y))))
- '("a" ("a" "b") ("a" "b" "c") x)))
- (test-t (equal (subst-if 'new (lambda (x) (eq x 'old)) '(old old)) '(new new)))
- (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
- (test-t (equal (subst-if 'x (lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
- (test-t (let ((tree '(old (old) ((old))))) (equal (subst-if 'new (lambda (x) (eq x 'old)) tree) '(new (new) ((new))))))
- (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
- (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'not-old) 'not-old))
- (test-t (equal (subst-if 'new (lambda (x) (equal x '(b))) '(a ((b)))) '(a (new))))
- (test-t (equal (subst-if 'x (lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x)))
- (test-t (equal (subst-if 'x
- (lambda (x) (equalp x "D"))
- '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
- :key (lambda (y) (and (listp y) (fourth y))))
- '("a" ("a" "b") ("a" "b" "c") x)))
- (test-t (equal (subst-if-not 'new (lambda (x) (not (eq x 'old))) '(old old)) '(new new)))
- (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
- (test-t (equal (subst-if-not 'x (lambda (x) (not (eql x 3)))
- '(1 (1 2) (1 2 3) (1 2 3 4))
- :key (lambda (y) (and (listp y) (third y))))
- '(1 (1 2) x x)))
- (test-t (let ((tree '(old (old) ((old)))))
- (equal (subst-if-not 'new (lambda (x) (not (eq x 'old))) tree)
- '(new (new) ((new))))))
- (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
- (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'not-old) 'not-old))
- (test-t (equal (subst-if-not 'new (lambda (x) (not (equal x '(b)))) '(a ((b)))) '(a (new))))
- (test-t (equal (subst-if-not 'x
- (lambda (x) (not (eql x 3)))
- '(1 (1 2) (1 2 3) (1 2 3 4))
- :key (lambda (y) (and (listp y) (third y))))
- '(1 (1 2) x x)))
- (test-t (equal (subst-if-not 'x
- (lambda (x) (not (equalp x "D")))
- '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))
- :key (lambda (y) (and (listp y) (fourth y))))
- '("a" ("a" "b") ("a" "b" "c") x)))
- (test-t (let ((tree '(old (old) ((old)))))
- (equal (nsubst 'new 'old (copy-tree tree))
- '(new (new) ((new))))))
- (test-t (let* ((tree (copy-tree '(old (old) ((old)))))
- (new-tree (nsubst 'new 'old tree)))
- (and (eq tree new-tree)
- (equal tree '(new (new) ((new)))))))
- (test-t (eq (nsubst 'new 'old 'old) 'new))
- (test-t (eq (nsubst 'new 'old 'not-old) 'not-old))
- (test-t (equal (nsubst 'new '(b) (copy-tree '(a ((b)))) :test equal) '(a (new))))
- (test-t (equal (nsubst 'x 3 (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
- :key (lambda (y) (and (listp y) (third y))))
- '(1 (1 2) x x)))
- (test-t (equal (nsubst 'x "D"
- (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
- :test equalp
- :key (lambda (y) (and (listp y) (fourth y))))
- '("a" ("a" "b") ("a" "b" "c") x)))
- (test-t (equal (nsubst-if 'new (lambda (x) (eq x 'old)) (list 'old 'old)) '(new new)))
- (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
- (test-t (let* ((x (copy-tree '(old (old) ((old)) (old) old)))
- (y (nsubst-if 'new (lambda (x) (eq x 'old)) x)))
- (and (eq x y)
- (equal x '(new (new) ((new)) (new) new)))))
- (test-t (equal (nsubst-if 'x
- (lambda (x) (eql x 3))
- (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
- :key (lambda (y) (and (listp y) (third y))))
- '(1 (1 2) x x)))
- (test-t (let ((tree '(old (old) ((old)))))
- (equal (nsubst-if 'new (lambda (x) (eq x 'old)) (copy-tree tree))
- '(new (new) ((new))))))
- (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'old) 'new))
- (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'not-old) 'not-old))
- (test-t (equal (nsubst-if 'new (lambda (x) (equal x '(b))) (copy-tree '(a ((b))))) '(a (new))))
- (test-t (equal (nsubst-if 'x
- (lambda (x) (eql x 3))
- (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
- :key (lambda (y) (and (listp y) (third y))))
- '(1 (1 2) x x)))
- (test-t (equal (nsubst-if 'x
- (lambda (x) (equalp x "D"))
- (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
- :key (lambda (y) (and (listp y) (fourth y))))
- '("a" ("a" "b") ("a" "b" "c") x)))
- (test-t (equal (nsubst-if-not 'new (lambda (x) (not (eq x 'old)))
- (list 'old 'old))
- '(new new)))
- (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
- (test-t (let* ((x (copy-tree '(old (old) ((old)) (old) old)))
- (y (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) x)))
- (and (eq x y)
- (equal x '(new (new) ((new)) (new) new)))))
- (test-t (equal (nsubst-if-not 'x (lambda (x) (not (eql x 3)))
- (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
- :key (lambda (y) (and (listp y) (third y))))
- '(1 (1 2) x x)))
- (test-t (let ((tree '(old (old) ((old)))))
- (equal (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) (copy-tree tree))
- '(new (new) ((new))))))
- (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new))
- (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'not-old) 'not-old))
- (test-t (equal (nsubst-if-not 'new (lambda (x) (not (equal x '(b)))) (copy-tree '(a ((b))))) '(a (new))))
- (test-t (equal (nsubst-if-not 'x
- (lambda (x) (not (eql x 3)))
- (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4)))
- :key (lambda (y) (and (listp y) (third y))))
- '(1 (1 2) x x)))
- (test-t (equal
- (nsubst-if-not 'x
- (lambda (x) (not (equalp x "D")))
- (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")))
- :key (lambda (y) (and (listp y) (fourth y))))
- '("a" ("a" "b") ("a" "b" "c") x)))
(test-t (tree-equal 'a 'a))
(test-t (not (tree-equal 'a 'b)))
(test-t (tree-equal '(a (b (c))) '(a (b (c)))))
@@ -25611,7 +44546,7 @@ abs 1 2
(test-t (not (tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c"))))))
(test-t (tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c"))) :test equal))
(test-t (not (tree-equal '(a b) '(a (b)))))
- (test-t (eq (copy-list '()) '()))
+ (test-t (eq (copy-list ()) ()))
(test-t (equal (copy-list '(a b c)) '(a b c)))
(test-t (equal (copy-list '(a . b)) '(a . b)))
(test-t (let* ((x '(a b c)) (y (copy-list x))) (and (equal x y) (not (eq x y)))))
@@ -25635,7 +44570,7 @@ abs 1 2
(test-t (equal (list* 1 2 'x) '(1 2 . x)))
(test-t (equal (list* 1 2 '(3 4)) '(1 2 3 4)))
(test-t (eq (list* 'x) 'x))
- (test-t (eql (list-length '()) 0))
+ (test-t (eql (list-length ()) 0))
(test-t (eql (list-length '(1)) 1))
(test-t (eql (list-length '(1 2)) 2))
(test-t (equal (cl-make-list 5) '(() () () () ())))
@@ -25670,15 +44605,15 @@ abs 1 2
(test-t (equal (nthcdr 0 '(0 1 2)) '(0 1 2)))
(test-t (equal (nthcdr 1 '(0 1 2)) '(1 2)))
(test-t (equal (nthcdr 2 '(0 1 2)) '(2)))
- (test-t (equal (nthcdr 3 '(0 1 2)) '()))
+ (test-t (equal (nthcdr 3 '(0 1 2)) ()))
(test-t (eql (nthcdr 1 '(0 . 1)) 1))
(test-t (eql (nth 0 '(a b c)) 'a))
(test-t (eql (nth 1 '(a b c)) 'b))
(test-t (eql (nth 2 '(a b c)) 'c))
- (test-t (eql (nth 3 '(a b c)) '()))
- (test-t (eql (nth 4 '(a b c)) '()))
- (test-t (eql (nth 5 '(a b c)) '()))
- (test-t (eql (nth 6 '(a b c)) '()))
+ (test-t (eql (nth 3 '(a b c)) ()))
+ (test-t (eql (nth 4 '(a b c)) ()))
+ (test-t (eql (nth 5 '(a b c)) ()))
+ (test-t (eql (nth 6 '(a b c)) ()))
(test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 0 x) 'z) 'z) (equal x '(z b c)))))
(test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 1 x) 'z) 'z) (equal x '(a z c)))))
(test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 2 x) 'z) 'z) (equal x '(a b z)))))
@@ -25700,13 +44635,13 @@ abs 1 2
(eq (second list) 'b)
(eq z (cddr list))
(eq (third list) 'c))))
- (test-t (equal (append '(a b) '() '(c d) '(e f)) '(a b c d e f)))
+ (test-t (equal (append '(a b) () '(c d) '(e f)) '(a b c d e f)))
(test-t (null (append)))
- (test-t (null (append '())))
- (test-t (null (append '() '())))
+ (test-t (null (append ())))
+ (test-t (null (append () ())))
(test-t (eq (append 'a) 'a))
- (test-t (eq (append '() 'a) 'a))
- (test-t (eq (append '() '() 'a) 'a))
+ (test-t (eq (append () 'a) 'a))
+ (test-t (eq (append () () 'a) 'a))
(test-t (equal (append '(a b) 'c) '(a b . c)))
(test-t (let* ((x '(a b c))
(y '(d e f))
@@ -25721,12 +44656,12 @@ abs 1 2
(and (equal z '(c b a d e f))
(not (eq x z))
(eq (nthcdr 3 z) y))))
- (test-t (let ((x '(a b c))) (eq (revappend '() x) x)))
- (test-t (null (revappend '() '())))
- (test-t (eq (revappend '() 'a) 'a))
+ (test-t (let ((x '(a b c))) (eq (revappend () x) x)))
+ (test-t (null (revappend () ())))
+ (test-t (eq (revappend () 'a) 'a))
(test-t (equal (revappend '(a) 'b) '(a . b)))
- (test-t (equal (revappend '(a) '()) '(a)))
- (test-t (equal (revappend '(1 2 3) '()) '(3 2 1)))
+ (test-t (equal (revappend '(a) ()) '(a)))
+ (test-t (equal (revappend '(1 2 3) ()) '(3 2 1)))
(test-t (equal (nreconc (list 'a 'b 'c) '(d e f)) '(c b a d e f)))
(test-t (let* ((x (list 'a 'b 'c))
(y '(d e f))
@@ -25734,8 +44669,8 @@ abs 1 2
(and (equal z '(c b a d e f))
(eq (nthcdr 3 z) y))))
(test-t (equal (nreconc (list 'a) 'b) '(a . b)))
- (test-t (equal (nreconc (list 'a) '()) '(a)))
- (test-t (equal (nreconc (list 1 2 3) '()) '(3 2 1)))
+ (test-t (equal (nreconc (list 'a) ()) '(a)))
+ (test-t (equal (nreconc (list 1 2 3) ()) '(3 2 1)))
(test-t (null (butlast nil)))
(test-t (null (butlast nil 1)))
(test-t (null (butlast nil 2)))
@@ -25745,9 +44680,9 @@ abs 1 2
(test-t (equal (butlast '(1 2 3 4 5) 2) '(1 2 3)))
(test-t (equal (butlast '(1 2 3 4 5) 3) '(1 2)))
(test-t (equal (butlast '(1 2 3 4 5) 4) '(1)))
- (test-t (equal (butlast '(1 2 3 4 5) 5) '()))
- (test-t (equal (butlast '(1 2 3 4 5) 6) '()))
- (test-t (equal (butlast '(1 2 3 4 5) 7) '()))
+ (test-t (equal (butlast '(1 2 3 4 5) 5) ()))
+ (test-t (equal (butlast '(1 2 3 4 5) 6) ()))
+ (test-t (equal (butlast '(1 2 3 4 5) 7) ()))
(test-t (let ((a '(1 2 3 4 5))) (equal (butlast a 3) '(1 2)) (equal a '(1 2 3 4 5))))
(test-t (null (nbutlast nil)))
(test-t (null (nbutlast nil 1)))
@@ -25758,17 +44693,17 @@ abs 1 2
(test-t (equal (nbutlast (list 1 2 3 4 5) 2) '(1 2 3)))
(test-t (equal (nbutlast (list 1 2 3 4 5) 3) '(1 2)))
(test-t (equal (nbutlast (list 1 2 3 4 5) 4) '(1)))
- (test-t (equal (nbutlast (list 1 2 3 4 5) 5) '()))
- (test-t (equal (nbutlast (list 1 2 3 4 5) 6) '()))
- (test-t (equal (nbutlast (list 1 2 3 4 5) 7) '()))
+ (test-t (equal (nbutlast (list 1 2 3 4 5) 5) ()))
+ (test-t (equal (nbutlast (list 1 2 3 4 5) 6) ()))
+ (test-t (equal (nbutlast (list 1 2 3 4 5) 7) ()))
(test-t (equal (nbutlast (list* 1 2 3 4 5 6)) '(1 2 3 4)))
(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 1) '(1 2 3 4)))
(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 2) '(1 2 3)))
(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 3) '(1 2)))
(test-t (equal (nbutlast (list* 1 2 3 4 5 6) 4) '(1)))
- (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 5) '()))
- (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 6) '()))
- (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 7) '()))
+ (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 5) ()))
+ (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 6) ()))
+ (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 7) ()))
(test-t (let* ((a '(1 2 3 4 5)) (b (nbutlast a 3))) (and (eq a b) (equal a '(1 2)))))
(test-t (let ((x '(0 1 2 3 4 5 6 7 8 9))) (eq (last x) (nthcdr 9 x))))
(test-t (let ((x '(0 1 2 3 4))) (eq (last x 0) nil)))
@@ -25781,17 +44716,17 @@ abs 1 2
(test-t (let ((x '(0 1 2 3 4))) (eq (last x 6) x)))
(test-t (let ((x '(0 1 2 3 4))) (eq (last x 7) x)))
(test-t (let ((x '(0 1 2 3 4))) (eq (last x 8) x)))
- (test-t (tailp '() '()))
- (test-t (tailp '() '(1)))
- (test-t (tailp '() '(1 2 3 4 5 6 7 8 9)))
+ (test-t (tailp () ()))
+ (test-t (tailp () '(1)))
+ (test-t (tailp () '(1 2 3 4 5 6 7 8 9)))
(test-t (let ((x '(1 2 3))) (and (tailp x x) (tailp (cdr x) x) (tailp (cddr x) x) (tailp (cdddr x) x))))
(test-t (let ((x '(1 . 2))) (and (tailp x x) (tailp (cdr x) x))))
(test-t (not (tailp 'x '(1 2 3 4 5 6))))
(test-t (not (tailp (list 1 2 3) '(1 2 3))))
(test-t (define (ldiff . args) #f))
- (test-t (null (ldiff '() '())))
+ (test-t (null (ldiff () ())))
(test-t (equal (ldiff '(1 . 2) 2) '(1)))
- (test-t (equal (ldiff '(1 2 3 4 5 6 7 8 9) '()) '(1 2 3 4 5 6 7 8 9)))
+ (test-t (equal (ldiff '(1 2 3 4 5 6 7 8 9) ()) '(1 2 3 4 5 6 7 8 9)))
(test-t (let ((x '(1 2 3)))
(and (null (ldiff x x))
(equal (ldiff x (cdr x)) '(1))
@@ -25806,8 +44741,8 @@ abs 1 2
(test-t (equal (cl-member 'b '(a b c d)) '(b c d)))
(test-t (equal (cl-member 'c '(a b c d)) '(c d)))
(test-t (equal (cl-member 'd '(a b c d)) '(d)))
- (test-t (equal (cl-member 'e '(a b c d)) '()))
- (test-t (equal (cl-member 'f '(a b c d)) '()))
+ (test-t (equal (cl-member 'e '(a b c d)) ()))
+ (test-t (equal (cl-member 'f '(a b c d)) ()))
(test-t (let ((x '(a b c d)))
(eq (cl-member 'a x) x)
(eq (cl-member 'b x) (cdr x))
@@ -25818,9 +44753,9 @@ abs 1 2
(test-t (equal (cl-member 'b '(a b c d) :test eq) '(b c d)))
(test-t (equal (cl-member 'c '(a b c d) :test eq) '(c d)))
(test-t (equal (cl-member 'd '(a b c d) :test eq) '(d)))
- (test-t (equal (cl-member 'e '(a b c d) :test eq) '()))
- (test-t (equal (cl-member 'f '(a b c d) :test eq) '()))
- (test-t (null (cl-member 'a '())))
+ (test-t (equal (cl-member 'e '(a b c d) :test eq) ()))
+ (test-t (equal (cl-member 'f '(a b c d) :test eq) ()))
+ (test-t (null (cl-member 'a ())))
(test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
(y (cl-member 'd x :key cdr :test eq)))
(and (equal y '((4 . d) (5 . e)))
@@ -25833,9 +44768,9 @@ abs 1 2
(test-t (equal (member-if (lambda (x) (eql x 'b)) '(a b c d)) '(b c d)))
(test-t (equal (member-if (lambda (x) (eql x 'c)) '(a b c d)) '(c d)))
(test-t (equal (member-if (lambda (x) (eql x 'd)) '(a b c d)) '(d)))
- (test-t (equal (member-if (lambda (x) (eql x 'e)) '(a b c d)) '()))
- (test-t (equal (member-if (lambda (x) (eql x 'f)) '(a b c d)) '()))
- (test-t (null (member-if (lambda (x) (eql x 'a)) '())))
+ (test-t (equal (member-if (lambda (x) (eql x 'e)) '(a b c d)) ()))
+ (test-t (equal (member-if (lambda (x) (eql x 'f)) '(a b c d)) ()))
+ (test-t (null (member-if (lambda (x) (eql x 'a)) ())))
(test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
(y (member-if (lambda (p) (eq p 'd)) x :key cdr)))
(and (equal y '((4 . d) (5 . e)))
@@ -25845,9 +44780,9 @@ abs 1 2
(test-t (equal (member-if-not (lambda (x) (not (eql x 'b))) '(a b c d)) '(b c d)))
(test-t (equal (member-if-not (lambda (x) (not (eql x 'c))) '(a b c d)) '(c d)))
(test-t (equal (member-if-not (lambda (x) (not (eql x 'd))) '(a b c d)) '(d)))
- (test-t (equal (member-if-not (lambda (x) (not (eql x 'e))) '(a b c d)) '()))
- (test-t (equal (member-if-not (lambda (x) (not (eql x 'f))) '(a b c d)) '()))
- (test-t (null (member-if-not (lambda (x) (not (eql x 'a))) '())))
+ (test-t (equal (member-if-not (lambda (x) (not (eql x 'e))) '(a b c d)) ()))
+ (test-t (equal (member-if-not (lambda (x) (not (eql x 'f))) '(a b c d)) ()))
+ (test-t (null (member-if-not (lambda (x) (not (eql x 'a))) ())))
(test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)))
(y (member-if-not (lambda (p) (not (eq p 'd))) x :key cdr)))
@@ -25895,16 +44830,16 @@ abs 1 2
(list-1 '(1 2 3)))
(and (eq (mapc (lambda (a b) (setq result (cons (cons a b) result)))
list-1
- '())
+ ())
list-1)
(eq result 'initial-value))))
(test-t (equal (mapcar car '((1 2) (2 3) (3 4) (4 5))) '(1 2 3 4)))
- (test-t (null (mapcar identity '())))
+ (test-t (null (mapcar identity ())))
(test-t (equal (mapcar list '(0 1 2 3) '(a b c d) '(w x y z)) '((0 a w) (1 b x) (2 c y) (3 d z))))
- (test-t (null (mapcar list '() '(0 1 2 3) '(1 2 3 4) '(2 3 4 5))))
- (test-t (null (mapcar list '(0 1 2 3) '() '(1 2 3 4) '(2 3 4 5))))
- (test-t (null (mapcar list '(0 1 2 3) '(1 2 3 4) '() '(2 3 4 5))))
- (test-t (null (mapcar list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '())))
+ (test-t (null (mapcar list () '(0 1 2 3) '(1 2 3 4) '(2 3 4 5))))
+ (test-t (null (mapcar list '(0 1 2 3) () '(1 2 3 4) '(2 3 4 5))))
+ (test-t (null (mapcar list '(0 1 2 3) '(1 2 3 4) () '(2 3 4 5))))
+ (test-t (null (mapcar list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) ())))
(test-t (equal (mapcar list '(0) '(a b) '(x y z)) '((0 a x))))
(test-t (equal (mapcar list '(a b) '(0) '(x y z)) '((a 0 x))))
(test-t (equal (mapcar list '(a b) '(x y z) '(0)) '((a x 0))))
@@ -25915,20 +44850,20 @@ abs 1 2
'((a) (b c) (d e f))
(list (list 'x 'y 'z) (list 'y 'z) (list 'z)))
'(1 2 3 a x y z 4 5 6 b c y z 7 8 9 d e f z)))
- (test-t (null (mapcan append '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c)) '())))
- (test-t (null (mapcan append '((1 2 3) (4 5 6) (7 8 9)) '() '((a) (b c)))))
- (test-t (null (mapcan append '() '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c)))))
+ (test-t (null (mapcan append '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c)) ())))
+ (test-t (null (mapcan append '((1 2 3) (4 5 6) (7 8 9)) () '((a) (b c)))))
+ (test-t (null (mapcan append () '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c)))))
(test-t (equal (mapcan list
(list 1 2 3 4 5)
(list 2 3 4 5 6)
(list 3 4 5 6 7)
(list 4 5 6 7 8))
'(1 2 3 4 2 3 4 5 3 4 5 6 4 5 6 7 5 6 7 8)))
- (test-t (equal (mapcan (lambda (x y) (if (null x) '() (list x y)))
+ (test-t (equal (mapcan (lambda (x y) (if (null x) () (list x y)))
'(() () () d e)
'(1 2 3 4 5 6))
'(d 4 e 5)))
- (test-t (equal (mapcan (lambda (x) (if (numberp x) (list x) '()))
+ (test-t (equal (mapcan (lambda (x) (if (numberp x) (list x) ()))
'(a 1 b c 3 4 d 5))
'(1 3 4 5)))
(test-t (equal (maplist identity '(a b c d)) '((a b c d) (b c d) (c d) (d))))
@@ -25939,33 +44874,33 @@ abs 1 2
((c) (d) (e)))))
(test-t (equal (maplist append '(a b c) '(b c d) '(c d e)) '((a b c b c d c d e) (b c c d d e) (c d e))))
(test-t (equal (maplist append '(a b c) '(b c) '(c)) '((a b c b c c))))
- (test-t (null (maplist append '() '(a b c) '(b c) '(c))))
- (test-t (null (maplist append '(a b c) '() '(b c) '(c))))
- (test-t (null (maplist append '(a b c) '(b c) '(c) '())))
+ (test-t (null (maplist append () '(a b c) '(b c) '(c))))
+ (test-t (null (maplist append '(a b c) () '(b c) '(c))))
+ (test-t (null (maplist append '(a b c) '(b c) '(c) ())))
(test-t (let ((x '((1 2) (2 3) (3 4) (4 5)))
(y nil))
(and (eq (mapl (lambda (a) (push (car a) y)) x) x)
(equal y '((4 5) (3 4) (2 3) (1 2))))))
(test-t (let ((x nil))
- (and (null (mapl (lambda rest (push rest x)) '() '(0) '(0 1)))
+ (and (null (mapl (lambda rest (push rest x)) () '(0) '(0 1)))
(null x))))
(test-t (let ((x nil))
- (and (equal (mapl (lambda rest (push rest x)) '(0) '() '(0 1))
+ (and (equal (mapl (lambda rest (push rest x)) '(0) () '(0 1))
'(0))
(null x))))
(test-t (let ((x nil))
- (and (equal (mapl (lambda rest (push rest x)) '(0) '(0 1) '())
+ (and (equal (mapl (lambda rest (push rest x)) '(0) '(0 1) ())
'(0))
(null x))))
(test-t (equal (mapcon car (copy-tree '((1 2) (2 3) (3 4) (4 5)))) '(1 2 2 3 3 4 4 5)))
(test-t (equal (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))
'((0 1 2 3) (1 2 3 4) (2 3 4 5) (3 4 5 6) (1 2 3) (2 3 4) (3 4 5)
(4 5 6) (2 3) (3 4) (4 5) (5 6) (3) (4) (5) (6))))
- (test-t (null (mapcon list '() '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))))
- (test-t (null (mapcon list '(0 1 2 3) '() '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))))
- (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '() '(2 3 4 5) '(3 4 5 6))))
- (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '() '(3 4 5 6))))
- (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6) '())))
+ (test-t (null (mapcon list () '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))))
+ (test-t (null (mapcon list '(0 1 2 3) () '(1 2 3 4) '(2 3 4 5) '(3 4 5 6))))
+ (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) () '(2 3 4 5) '(3 4 5 6))))
+ (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) () '(3 4 5 6))))
+ (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6) ())))
(test-t (let* ((x '((apple . 1) (orange . 2) (grapes . 3)))
(y (acons 'plum 9 x)))
(and (equal y '((plum . 9) (apple . 1) (orange . 2) (grapes . 3)))
@@ -25976,22 +44911,22 @@ abs 1 2
(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist) (cadr alist))))
(test-t (null (cl-assoc 'no-such-key '((x . 100) (y . 200) (z . 50)))))
(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist :test eq) (cadr alist))))
- (test-t (null (cl-assoc 'key '())))
- (test-t (null (cl-assoc '() '(()))))
- (test-t (null (cl-assoc '() '(() ()))))
+ (test-t (null (cl-assoc 'key ())))
+ (test-t (null (cl-assoc () '(()))))
+ (test-t (null (cl-assoc () '(() ()))))
(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist) (car (cddddr alist)))))
- (test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (cl-assoc '() alist) (cadddr alist))))
+ (test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (cl-assoc () alist) (cadddr alist))))
(test-t (let ((alist '((x . 100) (y . 200) (x . 100) (z . 50)))) (eq (cl-assoc 'y alist) (cadr alist))))
(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (assoc-if (lambda (arg) (eq arg 'y)) alist) (cadr alist))))
(test-t (null (assoc-if consp '((x . 100) (y . 200) (z . 50)))))
- (test-t (null (assoc-if (lambda (x) (eq x 'key)) '())))
+ (test-t (null (assoc-if (lambda (x) (eq x 'key)) ())))
(test-t (null (assoc-if identity '(()))))
(test-t (null (assoc-if identity '(() ()))))
(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (assoc-if (lambda (arg) (eq arg 'y)) alist) (car (cddddr alist)))))
(test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (assoc-if (lambda (arg) (null arg)) alist) (cadddr alist))))
(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (assoc-if-not (lambda (arg) (not (eq arg 'y))) alist) (cadr alist))))
(test-t (null (assoc-if-not (complement consp) '((x . 100) (y . 200) (z . 50)))))
- (test-t (null (assoc-if-not (lambda (x) (not (eq x 'key))) '())))
+ (test-t (null (assoc-if-not (lambda (x) (not (eq x 'key))) ())))
(test-t (null (assoc-if-not identity '(()))))
(test-t (null (assoc-if-not identity '(() ()))))
(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50))))
@@ -26033,111 +44968,27 @@ abs 1 2
(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist) (cadr alist))))
(test-t (null (rassoc 'no-such-datum '((x . 100) (y . 200) (z . 50)))))
(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist :test =) (cadr alist))))
- (test-t (null (rassoc 'key '())))
- (test-t (null (rassoc '() '(()))))
- (test-t (null (rassoc '() '(() ()))))
+ (test-t (null (rassoc 'key ())))
+ (test-t (null (rassoc () '(()))))
+ (test-t (null (rassoc () '(() ()))))
(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist) (car (cddddr alist)))))
- (test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (rassoc '() alist) (cadddr alist))))
+ (test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (rassoc () alist) (cadddr alist))))
(test-t (let ((alist '((x . 100) (y . 200) (x . 100) (z . 50)))) (eq (rassoc '200 alist) (cadr alist))))
(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc-if (lambda (arg) (= arg 200)) alist) (cadr alist))))
(test-t (null (rassoc-if consp '((x . 100) (y . 200) (z . 50)))))
- (test-t (null (rassoc-if (lambda (x) (eq x 'key)) '())))
+ (test-t (null (rassoc-if (lambda (x) (eq x 'key)) ())))
(test-t (null (rassoc-if identity '(()))))
(test-t (null (rassoc-if identity '(() ()))))
(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (rassoc-if (lambda (arg) (= arg 200)) alist) (car (cddddr alist)))))
(test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (rassoc-if (lambda (arg) (null arg)) alist) (cadddr alist))))
(test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc-if-not (lambda (arg) (not (= arg 200))) alist) (cadr alist))))
(test-t (null (rassoc-if-not (complement consp) '((x . 100) (y . 200) (z . 50)))))
- (test-t (null (rassoc-if-not (lambda (x) (not (eq x 'key))) '())))
+ (test-t (null (rassoc-if-not (lambda (x) (not (eq x 'key))) ())))
(test-t (null (rassoc-if-not identity '(()))))
(test-t (null (rassoc-if-not identity '(() ()))))
(test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50))))
(eq (rassoc-if-not (lambda (arg) (not (= arg 200))) alist)
(car (cddddr alist)))))
- (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
- (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
- (test-t (null (set-exclusive-or (intersection list1 list2) '(c b 4 1 1))))
- (test-t (null (set-exclusive-or (intersection list1 list2 :test equal)
- '("B" c b 4 1 1)
- :test equal)))
- (test-t (null (set-exclusive-or (intersection list1 list2 :test equalp)
- '("d" "C" "B" "A" c b 4 1 1)
- :test equalp))))
- (test-t (null (intersection '(0 1 2) '())))
- (test-t (null (intersection '() '())))
- (test-t (null (intersection '() '(0 1 2))))
- (test-t (equal (intersection '(0) '(0)) '(0)))
- (test-t (equal (intersection '(0 1 2 3) '(2)) '(2)))
- (test-t (cl-member 0 (intersection '(0 0 0 0 0) '(0 1 2 3 4 5))))
- (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0)) '(4 3 2 1 0))))
- (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(0 1 2 3 4)) '(0 1 2 3 4))))
- (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0)) '(0 1 2 3 4))))
- (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
- (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
- (null (set-exclusive-or (intersection list1 list2
- :test char=
- :key (lambda (x) (char x 0)))
- '("B" "F" "h")
- :test char=
- :key (lambda (x) (char x 0))))))
- (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
- (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
- (null (set-exclusive-or (intersection list1 list2
- :test char-equal
- :key (lambda (x) (char x 0)))
- '("A" "B" "C" "d" "e" "F" "G" "h")
- :test char-equal
- :key (lambda (x) (char x 0))))))
- (test-t (let ((list1 (list "A" "B" "C" "d"))
- (list2 (list "D" "E" "F" "g" "h")))
- (null (set-exclusive-or (intersection list1 list2
- :test char-equal
- :key (lambda (x) (char x 0)))
- '("d")
- :test char-equal
- :key (lambda (x) (char x 0))))))
- (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d"))
- (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D")))
- (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2) '(c b 4 1 1))))
- (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2 :test equal)
- '("B" c b 4 1 1)
- :test equal)))
- (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2 :test equalp)
- '("d" "C" "B" "A" c b 4 1 1)
- :test equalp))))
- (test-t (null (nintersection (list 0 1 2) '())))
- (test-t (null (nintersection '() '())))
- (test-t (null (nintersection '() '(0 1 2))))
- (test-t (equal (nintersection (list 0) '(0)) '(0)))
- (test-t (equal (nintersection (list 0 1 2 3) '(2)) '(2)))
- (test-t (cl-member 0 (nintersection (list 0 0 0 0 0) '(0 1 2 3 4 5))))
- (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0)) '(4 3 2 1 0))))
- (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(0 1 2 3 4)) '(0 1 2 3 4))))
- (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0)) '(0 1 2 3 4))))
- (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
- (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
- (null (set-exclusive-or (nintersection list1 list2
- :test char=
- :key (lambda (x) (char x 0)))
- '("B" "F" "h")
- :test char=
- :key (lambda (x) (char x 0))))))
- (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h"))
- (list2 (list "a" "B" "c" "D" "E" "F" "g" "h")))
- (null (set-exclusive-or (nintersection list1 list2
- :test char-equal
- :key (lambda (x) (char x 0)))
- '("A" "B" "C" "d" "e" "F" "G" "h")
- :test char-equal
- :key (lambda (x) (char x 0))))))
- (test-t (let ((list1 (list "A" "B" "C" "d"))
- (list2 (list "D" "E" "F" "g" "h")))
- (null (set-exclusive-or (nintersection list1 list2
- :test char-equal
- :key (lambda (x) (char x 0)))
- '("d")
- :test char-equal
- :key (lambda (x) (char x 0))))))
(test-t (let ((set '(a b c))) (eq (adjoin 'a set) set)))
(test-t (let* ((set '(a b c)) (new-set (adjoin 'x set))) (and (equal new-set '(x a b c)) (eq set (cdr new-set)))))
(test-t (equal (adjoin 1 nil) '(1)))
@@ -26168,101 +45019,6 @@ abs 1 2
(original list))
(and (equal (pushnew '(1) list :test equal :key nil) '((1) (1 2) (1 2 3)))
(eq list original))))
- (test-t (null (set-difference (set-difference '(1 2 3 4 5 6 7 8 9)
- '(2 4 6 8))
- '(1 3 5 7 9))))
- (test-t (null (nset-difference (set-difference (list 1 2 3 4 5 6 7 8 9)
- '(2 4 6 8))
- '(1 3 5 7 9))))
- (test-t (null (set-difference '() '())))
- (test-t (null (set-difference '() '() :test equal :key 'identity)))
- (test-t (null (nset-difference '() '())))
- (test-t (null (set-difference '() '(1 2 3))))
- (test-t (null (set-difference '() '(1 2 3) :test equal :key 'identity)))
- (test-t (null (nset-difference '() '(1 2 3))))
- (test-t (null (set-difference '(1 2 3 4) '(4 3 2 1))))
- (test-t (null (nset-difference (list 1 2 3 4) '(4 3 2 1))))
- (test-t (null (set-difference '(1 2 3 4) '(2 4 3 1))))
- (test-t (null (nset-difference (list 1 2 3 4) '(2 4 3 1))))
- (test-t (null (set-difference '(1 2 3 4) '(1 3 4 2))))
- (test-t (null (nset-difference (list 1 2 3 4) '(1 3 4 2))))
- (test-t (null (set-difference '(1 2 3 4) '(1 3 2 4))))
- (test-t (null (nset-difference (list 1 2 3 4) '(1 3 2 4))))
- (test-t (eq (set-difference (set-difference '(1 2 3) '()) '(1 2 3)) '()))
- (test-t (eq (nset-difference (nset-difference (list 1 2 3) '()) '(1 2 3)) '()))
- (test-t (eq (set-difference (set-difference '(1 2 3) '(1)) '(2 3)) '()))
- (test-t (eq (nset-difference (nset-difference (list 1 2 3) '(1)) '(2 3)) '()))
- (test-t (eq (set-difference (set-difference '(1 2 3) '(1 2)) '(3)) '()))
- (test-t (eq (nset-difference (nset-difference (list 1 2 3) '(1 2)) '(3)) '()))
- (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '(2 3 4)) '(1 4))))
- (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(2 3 4)) '(1 4))))
- (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '(1 3)) '(2))))
- (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(1 3)) '(2))))
- (test-t (null (set-exclusive-or '() '())))
- (test-t (null (nset-exclusive-or '() '())))
- (test-t (null (set-exclusive-or '(1 2 3) '(3 2 1))))
- (test-t (null (nset-exclusive-or (list 1 2 3) '(3 2 1))))
- (test-t (null (set-exclusive-or '(1 2 3) '(2 3 1))))
- (test-t (null (nset-exclusive-or (list 1 2 3) '(2 3 1))))
- (test-t (null (set-exclusive-or '(1 2 3) '(1 3 2))))
- (test-t (null (nset-exclusive-or (list 1 2 3) '(1 3 2))))
- (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '()) '(3 2 1))))
- (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '()) '(3 2 1))))
- (test-t (null (set-exclusive-or (set-exclusive-or '() '(1 2 3)) '(2 1 3))))
- (test-t (null (nset-exclusive-or (nset-exclusive-or '() '(1 2 3)) '(2 1 3))))
- (test-t (null (set-exclusive-or '("car" "ship" "airplane" "submarine")
- '("car" "ship" "airplane" "submarine")
- :test equal)))
- (test-t (null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
- '("car" "ship" "airplane" "submarine")
- :test equal)))
- (test-t (null (set-exclusive-or '("car" "ship" "airplane" "submarine")
- '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
- :test equalp)))
- (test-t (null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine"))
- '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
- :test equalp)))
- (test-t (null (set-exclusive-or '(("car") ("ship") ("airplane") ("submarine"))
- '(("car") ("ship") ("airplane") ("submarine"))
- :test string=
- :key car)))
- (test-t (null (nset-exclusive-or (copy-tree
- '(("car") ("ship") ("airplane") ("submarine")))
- '(("car") ("ship") ("airplane") ("submarine"))
- :test string=
- :key car)))
- (test-t (subsetp '(1 2 3) '(1 2 3)))
- (test-t (subsetp '(1 2 3) '(3 2 1)))
- (test-t (subsetp '(1 2 3) '(2 1 3)))
- (test-t (null (subsetp '(1 2 3 4) '(2 1 3))))
- (test-t (subsetp '(1) '(2 1 3)))
- (test-t (subsetp '(1 2) '(1 2 3 4 5 6 7 8)))
- (test-t (subsetp '(1 2 3 4 5) '(8 7 6 5 4 3 2 1)))
- (test-t (null (subsetp '("car" "ship" "airplane" "submarine") '("car" "ship" "horse" "airplane" "submarine" "camel"))))
- (test-t (subsetp '("car" "ship" "airplane" "submarine")
- '("car" "ship" "horse" "airplane" "submarine" "camel")
- :test equal))
- (test-t (subsetp '("CAR" "SHIP" "AIRPLANE" "SUBMARINE")
- '("car" "ship" "horse" "airplane" "submarine" "camel")
- :test equalp))
- (test-t (subsetp '(("car") ("ship") ("airplane") ("submarine"))
- '(("car") ("ship") ("horse") ("airplane") ("submarine") ("camel"))
- :test string=
- :key car))
- (test-t (null (union '() '())))
- (test-t (null (nunion '() '())))
- (test-t (null (set-difference (union '(1 2 3) '(2 3 4)) '(1 2 3 4))))
- (test-t (null (set-difference (nunion (list 1 2 3) (list 2 3 4)) '(1 2 3 4))))
- (test-t (null (set-difference (union '(1 2 3) '(1 2 3)) '(1 2 3))))
- (test-t (null (set-difference (nunion (list 1 2 3) (list 1 2 3)) '(1 2 3))))
- (test-t (null (set-difference (union '(1) '(3 2 1)) '(1 2 3))))
- (test-t (null (set-difference (nunion (list 1) (list 3 2 1)) '(1 2 3))))
- (test-t (null (set-difference (union '(1 2 3) '()) '(1 2 3))))
- (test-t (null (set-difference (nunion (list 1 2 3) '()) '(1 2 3))))
- (test-t (null (set-difference (union '() '(1 2 3)) '(1 2 3))))
- (test-t (null (set-difference (nunion '() (list 1 2 3)) '(1 2 3))))
- (test-t (null (set-difference (union '(1 2 3) '(2)) '(1 2 3))))
- (test-t (null (set-difference (nunion (list 1 2 3) (list 2)) '(1 2 3))))
(test-t (eql (length "abc") 3))
(test-t (zerop (length "")))
@@ -26289,7 +45045,7 @@ abs 1 2
(test-t (eql (length (make-sequence 'bit-vector 64)) 64))
(test-t (eql (length (make-sequence 'simple-vector 64)) 64))
(test-t (string= (copy-seq "love") "love"))
- (test-t (equalp (copy-seq '#(a b c d)) '#(a b c d)))
+ (test-t (equalp (copy-seq #(a b c d)) #(a b c d)))
(test-t (equal (copy-seq '(love)) '(love)))
(test-t (equal (copy-seq '(love hate war peace)) '(love hate war peace)))
(test-t (null (copy-seq nil)))
@@ -26302,7 +45058,7 @@ abs 1 2
(and (equal seq '((love) (peace)))
(eq (car seq) c0)
(eq (cadr seq) c1))))
- (test-t (let* ((seq0 '#(t nil t nil))
+ (test-t (let* ((seq0 #(t nil t nil))
(seq (copy-seq seq0)))
(and (not (eq seq0 seq))
(equalp seq seq0))))
@@ -26329,15 +45085,15 @@ abs 1 2
(test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :start 1 :end 3) list) (equal list '(0 9 9 3)))))
(test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :start 1 :end nil) list) (equal list '(0 9 9 9)))))
(test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :end 1) list) (equal list '(9 1 2 3)))))
- (test-t (let ((vector (vector 0 1 2 3))) (and (eq (cl-fill vector 't :start 3) vector) (equalp vector '#(0 1 2 t)))))
- (test-t (let ((vector (vector 0 1 2 3))) (and (eq (cl-fill vector 't :start 2 :end 4) vector) (equalp vector '#(0 1 t t)))))
- (test-t (let ((vector (vector 0 1 2 3))) (and (eq (cl-fill vector 't :start 2 :end nil) vector) (equalp vector '#(0 1 t t)))))
- (test-t (let ((vector (vector 0 1 2 3))) (and (eq (cl-fill vector 't :end 3) vector) (equalp vector '#(t t t 3)))))
+ (test-t (let ((vector (vector 0 1 2 3))) (and (eq (cl-fill vector 't :start 3) vector) (equalp vector #(0 1 2 t)))))
+ (test-t (let ((vector (vector 0 1 2 3))) (and (eq (cl-fill vector 't :start 2 :end 4) vector) (equalp vector #(0 1 t t)))))
+ (test-t (let ((vector (vector 0 1 2 3))) (and (eq (cl-fill vector 't :start 2 :end nil) vector) (equalp vector #(0 1 t t)))))
+ (test-t (let ((vector (vector 0 1 2 3))) (and (eq (cl-fill vector 't :end 3) vector) (equalp vector #(t t t 3)))))
(test-t (null (make-sequence 'list 0)))
(test-t (string= (make-sequence 'string 26 :initial-element #\.) ".........................."))
(test-t (equal (make-sequence 'list 3 :initial-element 'a) '(a a a)))
(test-t (null (make-sequence 'null 0 :initial-element 'a)))
- (test-t (equalp (make-sequence 'vector 3 :initial-element 'z) '#(z z z)))
+ (test-t (equalp (make-sequence 'vector 3 :initial-element 'z) #(z z z)))
(test-t (string= (make-sequence 'string 4 :initial-element '#\z) "zzzz"))
(test-t (vectorp (make-sequence 'vector 10)))
(test-t (string= (subseq "012345" 2) "2345"))
@@ -26346,7 +45102,7 @@ abs 1 2
(test-t (equal (subseq '(0 1 2 3) 1) '(1 2 3)))
(test-t (equal (subseq '(0 1 2 3) 2) '(2 3)))
(test-t (equal (subseq '(0 1 2 3) 3) '(3)))
- (test-t (equal (subseq '(0 1 2 3) 4) '()))
+ (test-t (equal (subseq '(0 1 2 3) 4) ()))
(test-t (equalp (subseq #(a b c d) 0) #(a b c d)))
(test-t (equalp (subseq #(a b c d) 1) #(b c d)))
(test-t (equalp (subseq #(a b c d) 2) #(c d)))
@@ -26362,12 +45118,12 @@ abs 1 2
(test-t (let* ((list0 '(0 1 2 3)) (list (subseq list0 0 4))) (and (not (eq list0 list)) (equal list0 list))))
(test-t (let* ((list0 '(0 1 2 3)) (list (subseq list0 0 nil))) (and (not (eq list0 list)) (equal list0 list))))
(test-t (equal (subseq '(0 1 2 3) 1 3) '(1 2)))
- (test-t (equal (subseq '(0 1 2 3) 2 2) '()))
- (test-t (equal (subseq '(0 1 2 3) 0 0) '()))
- (test-t (equal (subseq '(0 1 2 3) 1 1) '()))
- (test-t (equal (subseq '(0 1 2 3) 2 2) '()))
- (test-t (equal (subseq '(0 1 2 3) 3 3) '()))
- (test-t (equal (subseq '(0 1 2 3) 4 4) '()))
+ (test-t (equal (subseq '(0 1 2 3) 2 2) ()))
+ (test-t (equal (subseq '(0 1 2 3) 0 0) ()))
+ (test-t (equal (subseq '(0 1 2 3) 1 1) ()))
+ (test-t (equal (subseq '(0 1 2 3) 2 2) ()))
+ (test-t (equal (subseq '(0 1 2 3) 3 3) ()))
+ (test-t (equal (subseq '(0 1 2 3) 4 4) ()))
(test-t (equalp (subseq #(0 1 2 3) 0 4) #(0 1 2 3)))
(test-t (equalp (subseq #(0 1 2 3) 0 nil) #(0 1 2 3)))
(test-t (let* ((vec0 #(0 1 2 3)) (vec (subseq vec0 0 4))) (and (not (eq vec0 vec)) (equalp vec0 vec))))
@@ -26384,11 +45140,11 @@ abs 1 2
(test-t (string= (cl-map 'string (lambda (x) (if (oddp x) #\1 #\0)) '(1 2 3 4)) "1010"))
(test-t (equal (cl-map 'list + '(0 1) '(1 0)) '(1 1)))
(test-t (equal (cl-map 'list - '(0 1) '(1 0)) '(-1 1)))
- (test-t (every null (list (cl-map 'list + '())
- (cl-map 'list + '() '())
- (cl-map 'list + '() '() '())
- (cl-map 'list + '() '() '() '())
- (cl-map 'list + '() '() '() '() '()))))
+ (test-t (every null (list (cl-map 'list + ())
+ (cl-map 'list + () ())
+ (cl-map 'list + () () ())
+ (cl-map 'list + () () () ())
+ (cl-map 'list + () () () () ()))))
(test-t (equal (cl-map 'list + '(0 1 2)) '(0 1 2)))
(test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3)) '(1 3 5)))
(test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4)) '(3 6 9)))
@@ -26396,15 +45152,15 @@ abs 1 2
(test-t (equal (cl-map 'list + '(1 2) '(1 2 3)) '(2 4)))
(test-t (equal (cl-map 'list + '(0 1 2) '(2 3) '(2 3 4)) '(4 7)))
(test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2) '(3 4 5)) '(6)))
- (test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) '()) '()))
- (test-t (null (cl-map 'null + '())))
+ (test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) ()) ()))
+ (test-t (null (cl-map 'null + ())))
(test-t (equalp (cl-map 'vector + #()) #()))
(test-t (equalp (cl-map 'vector + #() #()) #()))
(test-t (equalp (cl-map 'vector + #() #() #()) #()))
(test-t (equalp (cl-map 'vector + #() #() #() #()) #()))
(test-t (equalp (cl-map 'vector + #() #() #() #() #()) #()))
- (test-t (equalp (cl-map 'vector + '() #()) #()))
- (test-t (equalp (cl-map 'vector + '() #() "") #()))
+ (test-t (equalp (cl-map 'vector + () #()) #()))
+ (test-t (equalp (cl-map 'vector + () #() "") #()))
(test-t (equalp (cl-map 'vector + '(0 1 2)) #(0 1 2)))
(test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3)) #(1 3 5)))
(test-t (equalp (cl-map 'vector + #(0 1 2) '(1 2 3) #(2 3 4)) #(3 6 9)))
@@ -26412,20 +45168,20 @@ abs 1 2
(test-t (equalp (cl-map 'vector + '(1 2) '(1 2 3)) #(2 4)))
(test-t (equalp (cl-map 'vector + '(0 1 2) '(2 3) '(2 3 4)) #(4 7)))
(test-t (equalp (cl-map 'vector + '(0 1 2) '(1 2 3) '(2) '(3 4 5)) #(6)))
- (test-t (equalp (cl-map 'vector + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) '()) #()))
+ (test-t (equalp (cl-map 'vector + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) ()) #()))
(test-t (equalp (cl-map 'vector + #(1 2) #(1 2 3)) #(2 4)))
(test-t (equalp (cl-map 'vector + #(0 1 2) #(2 3) #(2 3 4)) #(4 7)))
(test-t (equalp (cl-map 'vector + #(0 1 2) '(1 2 3) #(2) '(3 4 5)) #(6)))
- (test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3) '(2 3 4) '(3 4 5) '()) #()))
+ (test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3) '(2 3 4) '(3 4 5) ()) #()))
(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "") ""))
(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "") ""))
(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "") ""))
(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "" "") ""))
(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "" "" "") ""))
(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "") ""))
- (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" '()) ""))
- (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" #() '()) ""))
- (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) '() '() "" "") ""))
+ (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" ()) ""))
+ (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" #() ()) ""))
+ (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) () () "" "") ""))
(test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) #() #() #() #() #()) ""))
(test-t (string= (cl-map 'string (lambda (a b) (if (char< a b) b a)) "axbycz" "xaybzc") "xxyyzz"))
(test-t (string= (cl-map 'string (lambda (a b) (if (char< a b) b a)) "axbycz" "xayb") "xxyy"))
@@ -26461,13 +45217,13 @@ abs 1 2
(test-t (let ((a '(11 12 13 14)) (k '(one two three))) (equal (map-into a cons k a) '((one . 11) (two . 12) (three . 13) 14))))
(test-t (null (map-into nil identity)))
(test-t (null (map-into nil identity)))
- (test-t (null (map-into nil identity '())))
+ (test-t (null (map-into nil identity ())))
(test-t (null (map-into nil identity '(0 1 2) '(9 8 7))))
(test-t (let ((list (list 0 1 2))) (and (eq (map-into list identity) list) (equal list '(0 1 2)))))
- (test-t (let ((list (list 0 1 2))) (and (eq (map-into list identity '()) list) (equal list '(0 1 2)))))
+ (test-t (let ((list (list 0 1 2))) (and (eq (map-into list identity ()) list) (equal list '(0 1 2)))))
(test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec identity) vec) (equalp vec #(0 1 2)))))
(test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec identity #()) vec) (equalp vec #(0 1 2)))))
- (test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec + #() '() #()) vec) (equalp vec #(0 1 2)))))
+ (test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec + #() () #()) vec) (equalp vec #(0 1 2)))))
(test-t (equal (map-into (list nil nil) + '(0 1) '(1 0)) '(1 1)))
(test-t (equal (map-into (list nil nil) - '(0 1) '(1 0)) '(-1 1)))
(test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(0 1 2)) list) (equal list '(0 1 2)))))
@@ -26482,234 +45238,6 @@ abs 1 2
(test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(1 2) #(1 2 3)) vec) (equalp vec #(2 4 ())))))
(test-t (let ((vec (make-sequence 'vector 1 :initial-element nil))) (and (eq (map-into vec + '(1 2) #(1 2 3)) vec) (equalp vec #(2)))))
(test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(1 2 3 4) #(1 2 3) '(0)) vec) (equalp vec #(2 () ())))))
- (test-t (eql (reduce * '(1 2 3 4 5)) 120))
- (test-t (equal (reduce append '((1) (2)) :initial-value '(i n i t)) '(i n i t 1 2)))
- (test-t (equal (reduce append '((1) (2)) :from-end t :initial-value '(i n i t)) '(1 2 i n i t)))
- (test-t (eql (reduce - '(1 2 3 4)) -8))
- (test-t (eql (reduce - '(1 2 3 4) :from-end t) -2))
- (test-t (eql (reduce + '()) 0))
- (test-t (eql (reduce + '(3)) 3))
- (test-t (eq (reduce + '(foo)) 'foo))
- (test-t (equal (reduce list '(1 2 3 4)) '(((1 2) 3) 4)))
- (test-t (equal (reduce list '(1 2 3 4) :from-end t) '(1 (2 (3 4)))))
- (test-t (equal (reduce list '(1 2 3 4) :initial-value 'foo) '((((foo 1) 2) 3) 4)))
- (test-t (equal (reduce list '(1 2 3 4) :from-end t :initial-value 'foo) '(1 (2 (3 (4 foo))))))
- (test-t (equal (reduce list '(0 1 2 3)) '(((0 1) 2) 3)))
- (test-t (equal (reduce list '(0 1 2 3) :start 1) '((1 2) 3)))
- (test-t (equal (reduce list '(0 1 2 3) :start 1 :end nil) '((1 2) 3)))
- (test-t (equal (reduce list '(0 1 2 3) :start 2) '(2 3)))
- (test-t (eq (reduce list '(0 1 2 3) :start 0 :end 0) '()))
- (test-t (eq (reduce list '(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value) 'initial-value))
- (test-t (eq (reduce list '(0 1 2 3) :start 2 :end 2) '()))
- (test-t (eq (reduce list '(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value) 'initial-value))
- (test-t (eq (reduce list '(0 1 2 3) :start 4 :end 4) '()))
- (test-t (eq (reduce list '(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value) 'initial-value))
- (test-t (eql (reduce list '(0 1 2 3) :start 2 :end 3) 2))
- (test-t (equal (reduce list '(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value) '(initial-value 2)))
- (test-t (eql (reduce + '(0 1 2 3 4 5 6 7 8 9)) 45))
- (test-t (eql (reduce - '(0 1 2 3 4 5 6 7 8 9)) -45))
- (test-t (eql (reduce - '(0 1 2 3 4 5 6 7 8 9) :from-end t) -5))
- (test-t (equal (reduce list '(0 1 2 3) :initial-value 'initial-value) '((((initial-value 0) 1) 2) 3)))
- (test-t (equal (reduce list '(0 1 2 3) :from-end t) '(0 (1 (2 3)))))
- (test-t (equal (reduce list '((1) (2) (3) (4)) :key car) '(((1 2) 3) 4)))
- ;(test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end nil) '(((1 2) 3) 4)))
- (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :initial-value 0) '((((0 1) 2) 3) 4)))
- (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end t) '(1 (2 (3 4)))))
- (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end t :initial-value 5) '(1 (2 (3 (4 5))))))
- (test-t (equal (reduce list #(0 1 2 3)) '(((0 1) 2) 3)))
- (test-t (equal (reduce list #(0 1 2 3) :start 1) '((1 2) 3)))
- (test-t (equal (reduce list #(0 1 2 3) :start 1 :end nil) '((1 2) 3)))
- (test-t (equal (reduce list #(0 1 2 3) :start 2) '(2 3)))
- (test-t (eq (reduce list #(0 1 2 3) :start 0 :end 0) '()))
- (test-t (eq (reduce list #(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value) 'initial-value))
- (test-t (eq (reduce list #(0 1 2 3) :start 2 :end 2) '()))
- (test-t (eq (reduce list #(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value) 'initial-value))
- (test-t (eq (reduce list #(0 1 2 3) :start 4 :end 4) '()))
- (test-t (eq (reduce list #(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value) 'initial-value))
- (test-t (eql (reduce list #(0 1 2 3) :start 2 :end 3) 2))
- (test-t (equal (reduce list #(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value) '(initial-value 2)))
- (test-t (eql (reduce + #(0 1 2 3 4 5 6 7 8 9)) 45))
- (test-t (eql (reduce - #(0 1 2 3 4 5 6 7 8 9)) -45))
- (test-t (eql (reduce - #(0 1 2 3 4 5 6 7 8 9) :from-end t) -5))
- (test-t (equal (reduce list #(0 1 2 3) :initial-value 'initial-value) '((((initial-value 0) 1) 2) 3)))
- (test-t (equal (reduce list #(0 1 2 3) :from-end t) '(0 (1 (2 3)))))
- (test-t (equal (reduce list #((1) (2) (3) (4)) :key car) '(((1 2) 3) 4)))
- ;(test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end nil) '(((1 2) 3) 4)))
- (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :initial-value 0) '((((0 1) 2) 3) 4)))
- (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end t) '(1 (2 (3 4)))))
- (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end t :initial-value 5) '(1 (2 (3 (4 5))))))
- (test-t (eql (count #\a "how many A's are there in here?") 2))
- (test-t (eql (count-if-not oddp '((1) (2) (3) (4)) :key car) 2))
- (test-t (eql (count-if upper-case-p "The Crying of Lot 49" :start 4) 2))
- (test-t (eql (count #\a (concatenate 'list "how many A's are there in here?")) 2))
- (test-t (eql (count-if alpha-char-p "-a-b-c-0-1-2-3-4-") 3))
- (test-t (eql (count-if alphanumericp "-a-b-c-0-1-2-3-4-") 8))
- (test-t (eql (count nil (list t nil t nil t nil)) 3))
- (test-t (eql (count nil (vector t nil t nil t nil)) 3))
- (test-t (zerop (count 9 '(0 1 2 3 4))))
- (test-t (zerop (count 'a '(0 1 2 3 4))))
- (test-t (eql (count 0 '(0 0 0 0 0) :start 1) 4))
- (test-t (eql (count 0 '(0 0 0 0 0) :start 1 :end nil) 4))
- (test-t (eql (count 0 '(0 0 0 0 0) :start 2) 3))
- (test-t (zerop (count 0 '(0 0 0 0) :start 0 :end 0)))
- (test-t (zerop (count 0 '(0 0 0 0) :start 2 :end 2)))
- (test-t (zerop (count 0 '(0 0 0 0) :start 4 :end 4)))
- (test-t (eql (count 0 '(0 0 0 0) :start 2 :end 3) 1))
- (test-t (eql (count #\a "abcABC" :test equalp) 2))
- (test-t (eql (count #\a "abcABC" :test char-equal) 2))
- (test-t (eql (count '(a) '((x) (y) (z) (a) (b) (c)) :test equalp) 1))
- (test-t (eql (count 'a '((x) (y) (z) (a) (b) (c)) :key car :test eq) 1))
- (test-t (eql (count nil '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr :test eq) 3))
- (test-t (let ((list nil))
- (and (eql (count 'a '(a b c d)
- :test (lambda (a b) (setq list (cons b list)) (eq a b)))
- 1)
- (equal list '(d c b a)))))
- (test-t (let ((list nil))
- (and (eql (count 'a '(a b c d)
- :test (lambda (a b) (setq list (cons b list)) (eq a b))
- :from-end t)
- 1)
- (equal list '(a b c d)))))
- (test-t (zerop (count 9 #(0 1 2 3 4))))
- (test-t (zerop (count 'a #(0 1 2 3 4))))
- (test-t (eql (count 0 #(0 0 0 0 0) :start 1) 4))
- (test-t (eql (count 0 #(0 0 0 0 0) :start 1 :end nil) 4))
- (test-t (eql (count 0 #(0 0 0 0 0) :start 2) 3))
- (test-t (zerop (count 0 #(0 0 0 0) :start 0 :end 0)))
- (test-t (zerop (count 0 #(0 0 0 0) :start 2 :end 2)))
- (test-t (zerop (count 0 #(0 0 0 0) :start 4 :end 4)))
- (test-t (eql (count 0 #(0 0 0 0) :start 2 :end 3) 1))
- (test-t (eql (count '(a) #((x) (y) (z) (a) (b) (c)) :test equalp) 1))
- (test-t (eql (count 'a #((x) (y) (z) (a) (b) (c)) :key car :test eq) 1))
- (test-t (eql (count nil #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr :test eq) 3))
- (test-t (let ((list nil))
- (and (eql (count 'a #(a b c d)
- :test (lambda (a b) (setq list (cons b list)) (eq a b)))
- 1)
- (equal list '(d c b a)))))
- (test-t (let ((list nil))
- (and (eql (count 'a #(a b c d)
- :test (lambda (a b) (setq list (cons b list)) (eq a b))
- :from-end t)
- 1)
- (equal list '(a b c d)))))
- (test-t (eql (count-if null (list t nil t nil t nil)) 3))
- (test-t (zerop (count-if (lambda (x) (eql x 9)) #(0 1 2 3 4))))
- (test-t (zerop (count-if (lambda (a) (eq 'x a)) #(0 1 2 3 4))))
- (test-t (eql (count-if zerop '(0 0 0 0 0) :start 1) 4))
- (test-t (eql (count-if zerop '(0 0 0 0 0) :start 1 :end nil) 4))
- (test-t (eql (count-if zerop '(0 0 0 0 0) :start 2) 3))
- (test-t (zerop (count-if zerop '(0 0 0 0) :start 0 :end 0)))
- (test-t (zerop (count-if zerop '(0 0 0 0) :start 2 :end 2)))
- (test-t (zerop (count-if zerop '(0 0 0 0) :start 4 :end 4)))
- (test-t (eql (count-if zerop '(0 0 0 0) :start 2 :end 3) 1))
- (test-t (eql (count-if (lambda (x) (equalp #\a x)) "abcABC") 2))
- (test-t (eql (count-if (lambda (x) (char-equal #\a x)) "abcABC") 2))
- (test-t (eql (count-if (lambda (x) (equal x '(a))) '((x) (y) (z) (a) (b) (c))) 1))
- (test-t (eql (count-if (lambda (x) (eq x 'a)) '((x) (y) (z) (a) (b) (c)) :key car) 1))
- (test-t (eql (count-if null '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
- (test-t (eql (count-if (lambda (x) (equal x '(a))) '((x) (y) (z) (a) (b) (c))) 1))
- (test-t (eql (count-if (lambda (x) (eq x 'a)) '((x) (y) (z) (a) (b) (c)) :key car) 1))
- (test-t (eql (count-if null '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
- (test-t (let ((list nil))
- (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
- '(a b c d))
- 1)
- (equal list '(d c b a)))))
- (test-t (let ((list nil))
- (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
- '(a b c d)
- :from-end t)
- 1)
- (equal list '(a b c d)))))
- (test-t (eql (count-if null (vector t nil t nil t nil)) 3))
- (test-t (eql (count-if zerop #(0 0 0 0 0) :start 1) 4))
- (test-t (eql (count-if zerop #(0 0 0 0 0) :start 1 :end nil) 4))
- (test-t (eql (count-if zerop #(0 0 0 0 0) :start 2) 3))
- (test-t (zerop (count-if zerop #(0 0 0 0) :start 0 :end 0)))
- (test-t (zerop (count-if zerop #(0 0 0 0) :start 2 :end 2)))
- (test-t (zerop (count-if zerop #(0 0 0 0) :start 4 :end 4)))
- (test-t (eql (count-if zerop #(0 0 0 0) :start 2 :end 3) 1))
- (test-t (eql (count-if (lambda (x) (equal x '(a))) #((x) (y) (z) (a) (b) (c))) 1))
- (test-t (eql (count-if (lambda (x) (eq x 'a)) #((x) (y) (z) (a) (b) (c)) :key car) 1))
- (test-t (eql (count-if null #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
- (test-t (eql (count-if (lambda (x) (equal x '(a))) #((x) (y) (z) (a) (b) (c))) 1))
- (test-t (eql (count-if (lambda (x) (eq x 'a)) #((x) (y) (z) (a) (b) (c)) :key car) 1))
- (test-t (eql (count-if null #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
- (test-t (let ((list nil))
- (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
- #(a b c d))
- 1)
- (equal list '(d c b a)))))
- (test-t (let ((list nil))
- (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a))
- #(a b c d)
- :from-end t)
- 1)
- (equal list '(a b c d)))))
- (test-t (eql (count-if-not (complement null) (list t nil t nil t nil)) 3))
- (test-t (zerop (count-if-not (lambda (x) (not (eql x 9))) #(0 1 2 3 4))))
- (test-t (zerop (count-if-not (lambda (a) (not (eq 'x a))) #(0 1 2 3 4))))
- (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 1) 4))
- (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 1 :end nil) 4))
- (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 2) 3))
- (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 0 :end 0)))
- (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 2 :end 2)))
- (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 4 :end 4)))
- (test-t (eql (count-if-not (complement zerop) '(0 0 0 0) :start 2 :end 3) 1))
- (test-t (eql (count-if-not (lambda (x) (not (equalp #\a x))) "abcABC") 2))
- (test-t (eql (count-if-not (lambda (x) (not (char-equal #\a x))) "abcABC") 2))
- (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) '((x) (y) (z) (a) (b) (c))) 1))
- (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) '((x) (y) (z) (a) (b) (c)) :key car) 1))
- (test-t (eql (count-if-not (complement null) '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
- (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) '((x) (y) (z) (a) (b) (c))) 1))
- (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) '((x) (y) (z) (a) (b) (c)) :key car) 1))
- (test-t (eql (count-if-not (complement null) '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
- (test-t (let ((list nil))
- (and (eql (count-if-not (lambda (x)
- (setq list (cons x list))
- (not (eq x 'a)))
- '(a b c d))
- 1)
- (equal list '(d c b a)))))
- (test-t (let ((list nil))
- (and (eql (count-if-not (lambda (x)
- (setq list (cons x list))
- (not (eq x 'a)))
- '(a b c d)
- :from-end t)
- 1)
- (equal list '(a b c d)))))
- (test-t (eql (count-if-not (complement null) (vector t nil t nil t nil)) 3))
- (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 1) 4))
- (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 1 :end nil) 4))
- (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 2) 3))
- (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 0 :end 0)))
- (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 2 :end 2)))
- (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 4 :end 4)))
- (test-t (eql (count-if-not (complement zerop) #(0 0 0 0) :start 2 :end 3) 1))
- (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) #((x) (y) (z) (a) (b) (c))) 1))
- (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) #((x) (y) (z) (a) (b) (c)) :key car) 1))
- (test-t (eql (count-if-not (complement null) #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
- (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) #((x) (y) (z) (a) (b) (c))) 1))
- (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) #((x) (y) (z) (a) (b) (c)) :key car) 1))
- (test-t (eql (count-if-not (complement null) #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3))
- (test-t (let ((list nil))
- (and (eql (count-if-not (lambda (x)
- (setq list (cons x list))
- (not (eq x 'a)))
- #(a b c d))
- 1)
- (equal list '(d c b a)))))
- (test-t (let ((list nil))
- (and (eql (count-if-not (lambda (x)
- (setq list (cons x list))
- (not (eq x 'a)))
- #(a b c d)
- :from-end t)
- 1)
- (equal list '(a b c d)))))
(test-t (null (cl-reverse nil)))
(test-t (string= (cl-reverse "") ""))
(test-t (equalp (cl-reverse #()) #()))
@@ -26933,950 +45461,6 @@ abs 1 2
(test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
(test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
(test-t (null (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c)) 'a))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c)) 'b))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c)) 'c))
- (test-t (null (find-if-not (lambda (arg) (not (eq arg 'x))) '(a b c))))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :start 2)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :start 3)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0 :from-end t)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1 :from-end t)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2 :from-end t)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3 :from-end t)))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end nil) 'a))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end nil) 'b))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end nil) 'c))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 1) 'a))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 2) 'b))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 3) 'c))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 0)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 1)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 2)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)))))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key car) '(a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key car) '(b)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key car) '(c)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key car)))
- (test-t (let ((list '((a) (b) (c))))
- (and (eq (find-if-not (lambda (x) (not (eq x 'a))) list :key car)
- (car list))
- (eq (find-if-not (lambda (x) (not (eq x 'b))) list :key car)
- (cadr list))
- (eq (find-if-not (lambda (x) (not (eq x 'c))) list :key car)
- (caddr list))
- (null (find-if-not (lambda (x) (not (eq x 'z))) list :key car)))))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c)) 'a))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c)) 'b))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c)) 'c))
- (test-t (null (find-if-not (lambda (arg) (not (eq arg 'x))) #(a b c))))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :start 2)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :start 3)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0 :from-end t)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1 :from-end t)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2 :from-end t)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3 :from-end t)))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end nil) 'a))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end nil) 'b))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end nil) 'c))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 1) 'a))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 2) 'b))
- (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 3) 'c))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 0)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 1)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 2)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)))))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key car) '(a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key car) '(b)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key car) '(c)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key car)))
- (test-t (let ((vector #((a) (b) (c))))
- (and (eq (find-if-not (lambda (x) (not (eq x 'a))) vector :key car)
- (aref vector 0))
- (eq (find-if-not (lambda (x) (not (eq x 'b))) vector :key car)
- (aref vector 1))
- (eq (find-if-not (lambda (x) (not (eq x 'c))) vector :key car)
- (aref vector 2))
- (null (find-if-not (lambda (x) (not (eq x 'z))) vector :key car)))))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(b)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(c)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a)))
- (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a)))
- (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
- (test-t (eql (position #\a "baobab" :from-end t) 4))
- (test-t (eql (position-if oddp '((1) (2) (3) (4)) :start 1 :key car) 2))
- (test-t (null (position 595 '())))
- (test-t (eql (position-if-not integerp '(1 2 3 4 5.0)) 4))
- (test-t (eql (position 'a '(a b c)) 0))
- (test-t (eql (position 'b '(a b c)) 1))
- (test-t (eql (position 'c '(a b c)) 2))
- (test-t (null (position 'x '(a b c))))
- (test-t (null (position 'a '(a b c) :start 1)))
- (test-t (null (position 'b '(a b c) :start 2)))
- (test-t (null (position 'c '(a b c) :start 3)))
- (test-t (null (position 'a '(a b c) :start 0 :end 0)))
- (test-t (null (position 'a '(a b c) :start 0 :end 0 :from-end t)))
- (test-t (null (position 'a '(a b c) :start 1 :end 1)))
- (test-t (null (position 'a '(a b c) :start 1 :end 1 :from-end t)))
- (test-t (null (position 'a '(a b c) :start 2 :end 2)))
- (test-t (null (position 'a '(a b c) :start 2 :end 2 :from-end t)))
- (test-t (null (position 'a '(a b c) :start 3 :end 3)))
- (test-t (null (position 'a '(a b c) :start 3 :end 3 :from-end t)))
- (test-t (eql (position 'a '(a b c) :end nil) '0))
- (test-t (eql (position 'b '(a b c) :end nil) '1))
- (test-t (eql (position 'c '(a b c) :end nil) '2))
- (test-t (eql (position 'a '(a b c) :end 1) '0))
- (test-t (eql (position 'b '(a b c) :end 2) '1))
- (test-t (eql (position 'c '(a b c) :end 3) '2))
- (test-t (null (position 'a '(a b c) :end 0)))
- (test-t (null (position 'b '(a b c) :end 1)))
- (test-t (null (position 'c '(a b c) :end 2)))
- (test-t (null (position 'a '((a) (b) (c)))))
- (test-t (eql (position 'a '((a) (b) (c)) :key car) 0))
- (test-t (eql (position 'b '((a) (b) (c)) :key car) 1))
- (test-t (eql (position 'c '((a) (b) (c)) :key car) 2))
- (test-t (null (position 'z '((a) (b) (c)) :key car)))
- (test-t (null (position '(a) '((a) (b) (c)))))
- (test-t (eql (position '(a) '((a) (b) (c)) :test equal) 0))
- (test-t (null (position '("a") '(("a") ("b") ("c")))))
- (test-t (eql (position 3 '(0 1 2 3 4 5)) 3))
- (test-t (eql (position 3 '(0 1 2 3 4 5) :test <) 4))
- (test-t (eql (position 3 '(0 1 2 3 4 5) :test >) 0))
- (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
- (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
- (test-t (eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
- (test-t (eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
- (test-t (eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
- (test-t (eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
- (test-t (null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key car)))
- (test-t (null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
- (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
- (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
- (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
- (test-t (null (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
- (test-t (eql (position 'a #(a b c)) 0))
- (test-t (eql (position 'b #(a b c)) 1))
- (test-t (eql (position 'c #(a b c)) 2))
- (test-t (null (position 'x #(a b c))))
- (test-t (null (position 'a #(a b c) :start 1)))
- (test-t (null (position 'b #(a b c) :start 2)))
- (test-t (null (position 'c #(a b c) :start 3)))
- (test-t (null (position 'a #(a b c) :start 0 :end 0)))
- (test-t (null (position 'a #(a b c) :start 0 :end 0 :from-end t)))
- (test-t (null (position 'a #(a b c) :start 1 :end 1)))
- (test-t (null (position 'a #(a b c) :start 1 :end 1 :from-end t)))
- (test-t (null (position 'a #(a b c) :start 2 :end 2)))
- (test-t (null (position 'a #(a b c) :start 2 :end 2 :from-end t)))
- (test-t (null (position 'a #(a b c) :start 3 :end 3)))
- (test-t (null (position 'a #(a b c) :start 3 :end 3 :from-end t)))
- (test-t (eql (position 'a #(a b c) :end nil) 0))
- (test-t (eql (position 'b #(a b c) :end nil) 1))
- (test-t (eql (position 'c #(a b c) :end nil) 2))
- (test-t (eql (position 'a #(a b c) :end 1) 0))
- (test-t (eql (position 'b #(a b c) :end 2) 1))
- (test-t (eql (position 'c #(a b c) :end 3) 2))
- (test-t (null (position 'a #(a b c) :end 0)))
- (test-t (null (position 'b #(a b c) :end 1)))
- (test-t (null (position 'c #(a b c) :end 2)))
- (test-t (null (position 'a #((a) (b) (c)))))
- (test-t (eql (position 'a #((a) (b) (c)) :key car) 0))
- (test-t (eql (position 'b #((a) (b) (c)) :key car) 1))
- (test-t (eql (position 'c #((a) (b) (c)) :key car) 2))
- (test-t (null (position 'z #((a) (b) (c)) :key car)))
- (test-t (null (position '(a) #((a) (b) (c)))))
- (test-t (eql (position '(a) #((a) (b) (c)) :test equal) 0))
- (test-t (null (position '("a") #(("a") ("b") ("c")))))
- (test-t (eql (position 3 #(0 1 2 3 4 5)) 3))
- (test-t (eql (position 3 #(0 1 2 3 4 5) :test <) 4))
- (test-t (eql (position 3 #(0 1 2 3 4 5) :test >) 0))
- (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
- (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
- (test-t (eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
- (test-t (eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
- (test-t (eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
- (test-t (eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
- (test-t (null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key car)))
- (test-t (null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
- (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
- (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
- (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
- (test-t (null (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
- (test-t (null (position #\z "abcABC")))
- (test-t (eql (position #\a "abcABC") 0))
- (test-t (eql (position #\A "abcABC") 3))
- (test-t (eql (position #\A "abcABC" :test char-equal) 0))
- (test-t (eql (position #\A "abcABC" :test char-equal :from-end t) 3))
- (test-t (eql (position #\a "abcABC" :test char-equal :from-end t) 3))
- (test-t (eql (position #\a "abcABC" :test char-equal :from-end t :end 4) 3))
- (test-t (eql (position #\a "abcABC" :test char-equal :from-end t :end 3) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c)) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c)) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c)) 2))
- (test-t (null (position-if (lambda (arg) (eq arg 'x)) '(a b c))))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1)))
- (test-t (null (position-if (lambda (x) (eq x 'b)) '(a b c) :start 2)))
- (test-t (null (position-if (lambda (x) (eq x 'c)) '(a b c) :start 3)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0 :from-end t)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1 :from-end t)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2 :from-end t)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3 :from-end t)))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c) :end nil) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c) :end nil) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c) :end nil) 2))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c) :end 1) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c) :end 2) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c) :end 3) 2))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :end 0)))
- (test-t (null (position-if (lambda (x) (eq x 'b)) '(a b c) :end 1)))
- (test-t (null (position-if (lambda (x) (eq x 'c)) '(a b c) :end 2)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '((a) (b) (c)))))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c)) :key car) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c)) :key car) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c)) :key car) 2))
- (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c)) :key car)))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
- (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
- (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
- (test-t (null (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c)) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c)) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c)) 2))
- (test-t (null (position-if (lambda (arg) (eq arg 'x)) #(a b c))))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1)))
- (test-t (null (position-if (lambda (x) (eq x 'b)) #(a b c) :start 2)))
- (test-t (null (position-if (lambda (x) (eq x 'c)) #(a b c) :start 3)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0 :from-end t)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1 :from-end t)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2 :from-end t)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3 :from-end t)))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c) :end nil) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c) :end nil) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c) :end nil) 2))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c) :end 1) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c) :end 2) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c) :end 3) 2))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :end 0)))
- (test-t (null (position-if (lambda (x) (eq x 'b)) #(a b c) :end 1)))
- (test-t (null (position-if (lambda (x) (eq x 'c)) #(a b c) :end 2)))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #((a) (b) (c)))))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c)) :key car) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c)) :key car) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c)) :key car) 2))
- (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c)) :key car)))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
- (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
- (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
- (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
- (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
- (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
- (test-t (null (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c)) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c)) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c)) 2))
- (test-t (null (position-if-not (lambda (arg) (not (eq arg 'x))) '(a b c))))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :start 2)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :start 3)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0 :from-end t)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1 :from-end t)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2 :from-end t)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3 :from-end t)))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end nil) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end nil) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end nil) 2))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 1) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 2) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 3) 2))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 0)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 1)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 2)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)))))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key car) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key car) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key car) 2))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key car)))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c)) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c)) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c)) 2))
- (test-t (null (position-if-not (lambda (arg) (not (eq arg 'x))) #(a b c))))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :start 2)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :start 3)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0 :from-end t)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1 :from-end t)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2 :from-end t)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3 :from-end t)))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end nil) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end nil) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end nil) 2))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 1) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 2) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 3) 2))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 0)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 1)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 2)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)))))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key car) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key car) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key car) 2))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key car)))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 0))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 1))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 2))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car)))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t)))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6))
- (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3))
- (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3)))
-
- (test-t (eql (search "dog" "it's a dog's life") 7))
- (test-t (eql (search '(0 1) '(2 4 6 1 3 5) :key oddp) 2))
- (test-t (null (search '(a b c) '(x y z))))
- (test-t (eql (search '() '(x y z)) 0))
- (test-t (eql (search '(a) '(a)) 0))
- (test-t (eql (search '(a b c) '(a b c x y z)) 0))
- (test-t (eql (search '(a b c) '(x a b c y z)) 1))
- (test-t (eql (search '(a b c) '(x y a b c z)) 2))
- (test-t (eql (search '(a b c) '(x y z a b c)) 3))
- (test-t (eql (search '(a b c) '(a b c a b c) :start2 1) 3))
- (test-t (eql (search '(a b c) '(a b c a b c) :start2 1 :end2 nil) 3))
- (test-t (eql (search '(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
- (test-t (eql (search '(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
- (test-t (null (search '(a b c) '(a b c a b c) :start2 0 :end2 0)))
- (test-t (null (search '(a b c) '(a b c a b c) :start2 1 :end2 1)))
- (test-t (null (search '(a b c) '(a b c a b c) :start2 2 :end2 2)))
- (test-t (null (search '(a b c) '(a b c a b c) :start2 3 :end2 3)))
- (test-t (null (search '(a b c) '(a b c a b c) :start2 4 :end2 4)))
- (test-t (null (search '(a b c) '(a b c a b c) :start2 5 :end2 5)))
- (test-t (null (search '(a b c) '(a b c a b c) :start2 6 :end2 6)))
- (test-t (eql (search '(a b c) '(a b c a b c)) 0))
- (test-t (eql (search '(a b c) '(a b c a b c) :from-end t) 3))
- (test-t (eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6) 3))
- (test-t (eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
- (test-t (eql (search '(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
- (test-t (eql (search '(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
- (test-t (null (search '(#\a #\b #\c) '(#\A #\B #\C))))
- (test-t (eql (search '(#\a #\b #\c) '(#\A #\B #\C) :test char-equal) 0))
- (test-t (eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z)) 0))
- (test-t (eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z) :test char<) 1))
- (test-t (null (search '((a) (b)) '((x) (y) (z) (a) (b) (c)))))
- (test-t (eql (search '((a) (b)) '((x) (y) (z) (a) (b) (c)) :key car) 3))
- (test-t (eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
- (test-t (eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
- (test-t (eql (search '((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
- (test-t (eql (search '((a a) (b b)) '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
- (test-t (eql (search '(("a" a) ("b" b))
- '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
- ("A" 0) ("B" 1) ("C" 2))
- :start1 1
- :end1 2
- :start2 3
- :end2 nil
- :key car
- :test string-equal
- :from-end t)
- 7))
- (test-t (null (search #(a b c) '(x y z))))
- (test-t (eql (search #() '(x y z)) 0))
- (test-t (eql (search #(a) '(a)) 0))
- (test-t (eql (search #(a b c) '(a b c x y z)) 0))
- (test-t (eql (search #(a b c) '(x a b c y z)) 1))
- (test-t (eql (search #(a b c) '(x y a b c z)) 2))
- (test-t (eql (search #(a b c) '(x y z a b c)) 3))
- (test-t (eql (search #(a b c) '(a b c a b c) :start2 1) 3))
- (test-t (eql (search #(a b c) '(a b c a b c) :start2 1 :end2 nil) 3))
- (test-t (eql (search #(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
- (test-t (eql (search #(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
- (test-t (null (search #(a b c) '(a b c a b c) :start2 0 :end2 0)))
- (test-t (null (search #(a b c) '(a b c a b c) :start2 1 :end2 1)))
- (test-t (null (search #(a b c) '(a b c a b c) :start2 2 :end2 2)))
- (test-t (null (search #(a b c) '(a b c a b c) :start2 3 :end2 3)))
- (test-t (null (search #(a b c) '(a b c a b c) :start2 4 :end2 4)))
- (test-t (null (search #(a b c) '(a b c a b c) :start2 5 :end2 5)))
- (test-t (null (search #(a b c) '(a b c a b c) :start2 6 :end2 6)))
- (test-t (eql (search #(a b c) '(a b c a b c)) 0))
- (test-t (eql (search #(a b c) '(a b c a b c) :from-end t) 3))
- (test-t (eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6) 3))
- (test-t (eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
- (test-t (eql (search #(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
- (test-t (eql (search #(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
- (test-t (null (search #(#\a #\b #\c) '(#\A #\B #\C))))
- (test-t (eql (search #(#\a #\b #\c) '(#\A #\B #\C) :test char-equal) 0))
- (test-t (eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z)) 0))
- (test-t (eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z) :test char<) 1))
- (test-t (null (search #((a) (b)) '((x) (y) (z) (a) (b) (c)))))
- (test-t (eql (search #((a) (b)) '((x) (y) (z) (a) (b) (c)) :key car) 3))
- (test-t (eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
- (test-t (eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
- (test-t (eql (search #((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
- (test-t (eql (search #((a a) (b b)) '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
- (test-t (eql (search #(("a" a) ("b" b))
- '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
- ("A" 0) ("B" 1) ("C" 2))
- :start1 1
- :end1 2
- :start2 3
- :end2 nil
- :key car
- :test string-equal
- :from-end t)
- 7))
- (test-t (null (search '(a b c) #(x y z))))
- (test-t (eql (search '() #(x y z)) 0))
- (test-t (eql (search '(a) #(a)) 0))
- (test-t (eql (search '(a b c) #(a b c x y z)) 0))
- (test-t (eql (search '(a b c) #(x a b c y z)) 1))
- (test-t (eql (search '(a b c) #(x y a b c z)) 2))
- (test-t (eql (search '(a b c) #(x y z a b c)) 3))
- (test-t (eql (search '(a b c) #(a b c a b c) :start2 1) 3))
- (test-t (eql (search '(a b c) #(a b c a b c) :start2 1 :end2 nil) 3))
- (test-t (eql (search '(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
- (test-t (eql (search '(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
- (test-t (null (search '(a b c) #(a b c a b c) :start2 0 :end2 0)))
- (test-t (null (search '(a b c) #(a b c a b c) :start2 1 :end2 1)))
- (test-t (null (search '(a b c) #(a b c a b c) :start2 2 :end2 2)))
- (test-t (null (search '(a b c) #(a b c a b c) :start2 3 :end2 3)))
- (test-t (null (search '(a b c) #(a b c a b c) :start2 4 :end2 4)))
- (test-t (null (search '(a b c) #(a b c a b c) :start2 5 :end2 5)))
- (test-t (null (search '(a b c) #(a b c a b c) :start2 6 :end2 6)))
- (test-t (eql (search '(a b c) #(a b c a b c)) 0))
- (test-t (eql (search '(a b c) #(a b c a b c) :from-end t) 3))
- (test-t (eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6) 3))
- (test-t (eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
- (test-t (eql (search '(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
- (test-t (eql (search '(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
- (test-t (null (search '(#\a #\b #\c) #(#\A #\B #\C))))
- (test-t (eql (search '(#\a #\b #\c) #(#\A #\B #\C) :test char-equal) 0))
- (test-t (eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z)) 0))
- (test-t (eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z) :test char<) 1))
- (test-t (null (search '((a) (b)) #((x) (y) (z) (a) (b) (c)))))
- (test-t (eql (search '((a) (b)) #((x) (y) (z) (a) (b) (c)) :key car) 3))
- (test-t (eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
- (test-t (eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
- (test-t (eql (search '((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
- (test-t (eql (search '((a a) (b b)) #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
- (test-t (eql (search '(("a" a) ("b" b))
- #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
- ("A" 0) ("B" 1) ("C" 2))
- :start1 1
- :end1 2
- :start2 3
- :end2 nil
- :key car
- :test string-equal
- :from-end t)
- 7))
- (test-t (null (search #(a b c) #(x y z))))
- (test-t (eql (search #() #(x y z)) 0))
- (test-t (eql (search #(a) #(a)) 0))
- (test-t (eql (search #(a b c) #(a b c x y z)) 0))
- (test-t (eql (search #(a b c) #(x a b c y z)) 1))
- (test-t (eql (search #(a b c) #(x y a b c z)) 2))
- (test-t (eql (search #(a b c) #(x y z a b c)) 3))
- (test-t (eql (search #(a b c) #(a b c a b c) :start2 1) 3))
- (test-t (eql (search #(a b c) #(a b c a b c) :start2 1 :end2 nil) 3))
- (test-t (eql (search #(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1))
- (test-t (eql (search #(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1))
- (test-t (null (search #(a b c) #(a b c a b c) :start2 0 :end2 0)))
- (test-t (null (search #(a b c) #(a b c a b c) :start2 1 :end2 1)))
- (test-t (null (search #(a b c) #(a b c a b c) :start2 2 :end2 2)))
- (test-t (null (search #(a b c) #(a b c a b c) :start2 3 :end2 3)))
- (test-t (null (search #(a b c) #(a b c a b c) :start2 4 :end2 4)))
- (test-t (null (search #(a b c) #(a b c a b c) :start2 5 :end2 5)))
- (test-t (null (search #(a b c) #(a b c a b c) :start2 6 :end2 6)))
- (test-t (eql (search #(a b c) #(a b c a b c)) 0))
- (test-t (eql (search #(a b c) #(a b c a b c) :from-end t) 3))
- (test-t (eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6) 3))
- (test-t (eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3))
- (test-t (eql (search #(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0))
- (test-t (eql (search #(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3))
- (test-t (null (search #(#\a #\b #\c) #(#\A #\B #\C))))
- (test-t (eql (search #(#\a #\b #\c) #(#\A #\B #\C) :test char-equal) 0))
- (test-t (eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z)) 0))
- (test-t (eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z) :test char<) 1))
- (test-t (null (search #((a) (b)) #((x) (y) (z) (a) (b) (c)))))
- (test-t (eql (search #((a) (b)) #((x) (y) (z) (a) (b) (c)) :key car) 3))
- (test-t (eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
- (test-t (eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6))
- (test-t (eql (search #((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0))
- (test-t (eql (search #((a a) (b b)) #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6))
- (test-t (eql (search #(("a" a) ("b" b))
- #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z")
- ("A" 0) ("B" 1) ("C" 2))
- :start1 1
- :end1 2
- :start2 3
- :end2 nil
- :key car
- :test string-equal
- :from-end t)
- 7))
- (test-t (null (search "peace" "LOVE&PEACE")))
- (test-t (eql (search "peace" "LOVE&PEACE" :test char-equal) 5))
- (test-t (null (search "PeAcE" "LoVe&pEaCe")))
- (test-t (eql (search "PeAcE" "LoVe&pEaCe" :key char-upcase) 5))
- (test-t (eql (search "abc" "abc xyz abc" :from-end t) 8))
- (test-t (eql (search "abc" "abc xyz abc xyz abc xyz abc" :start2 8 :end2 19) 8))
- (test-t (eql (search "abc" "abc xyz abc xyz abc xyz abc" :from-end t :start2 8 :end2 19) 16))
- (test-t (eql (mismatch "abcd" "ABCDE" :test char-equal) 4))
- (test-t (eql (mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t) 3))
- (test-t (null (mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4)))
- (test-t (null (mismatch '() '())))
- (test-t (eql (mismatch '(a b c) '(x y z)) 0))
- (test-t (eql (mismatch '() '(x y z)) 0))
- (test-t (eql (mismatch '(x y z) '()) 0))
- (test-t (null (mismatch '(a) '(a))))
- (test-t (eql (mismatch '(a b c x y z) '(a b c)) 3))
- (test-t (null (mismatch '(a b c) '(a b c))))
- (test-t (eql (mismatch '(a b c d e f) '(a b c)) 3))
- (test-t (eql (mismatch '(a b c) '(a b c d e f)) 3))
- (test-t (eql (mismatch '(a b c) '(a b x)) 2))
- (test-t (eql (mismatch '(a b c) '(a x c)) 1))
- (test-t (eql (mismatch '(a b c) '(x b c)) 0))
- (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3) 6))
- (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6))
- (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4))
- (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3))
- (test-t (null (mismatch '(x y z) '() :start1 0 :end1 0)))
- (test-t (null (mismatch '(x y z) '() :start1 1 :end1 1)))
- (test-t (null (mismatch '(x y z) '() :start1 2 :end1 2)))
- (test-t (null (mismatch '(x y z) '() :start1 3 :end1 3)))
- (test-t (null (mismatch '(x y z) '() :start1 0 :end1 0 :start2 0 :end2 0)))
- (test-t (null (mismatch '(x y z) '() :start1 1 :end1 1 :start2 1 :end2 1)))
- (test-t (null (mismatch '(x y z) '() :start1 2 :end1 2 :start2 2 :end2 2)))
- (test-t (null (mismatch '(x y z) '() :start1 3 :end1 3 :start2 3 :end2 3)))
- (test-t (null (mismatch '(x y z) '() :start1 0 :end1 0 :start2 3 :end2 3)))
- (test-t (null (mismatch '(x y z) '() :start1 1 :end1 1 :start2 2 :end2 2)))
- (test-t (null (mismatch '(x y z) '() :start1 2 :end1 2 :start2 1 :end2 1)))
- (test-t (null (mismatch '(x y z) '() :start1 3 :end1 3 :start2 0 :end2 0)))
- (test-t (eql (mismatch '(x y z) '(a b c) :start1 0 :end1 0) 0))
- (test-t (eql (mismatch '(x y z) '(a b c) :start1 1 :end1 1) 1))
- (test-t (eql (mismatch '(x y z) '(a b c) :start1 2 :end1 2) 2))
- (test-t (eql (mismatch '(x y z) '(a b c) :start1 3 :end1 3) 3))
- (test-t (eql (mismatch '(x y z) '(x y z) :start1 0 :end1 1) 1))
- (test-t (eql (mismatch '(x y z) '(x y z) :start1 0 :end1 2) 2))
- (test-t (eql (mismatch '(x y z) '(x y z Z) :start1 0 :end1 3) 3))
- (test-t (null (mismatch '(x y z) '(x y z) :start1 0 :end1 3)))
- (test-t (eql (mismatch '(a b c x y z) '(x y z a b c)) 0))
- (test-t (eql (mismatch '(a b c x y z) '(x y z a b c) :start1 3) 6))
- (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9))
- (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6))
- (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3) 9))
- (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3) 6))
- (test-t (eql (mismatch '(a b c) '(a b c x y z)) 3))
- (test-t (eql (mismatch '(a b c) '(x a b c y z)) 0))
- (test-t (eql (mismatch '(a b c) '(x a b c y z) :start2 1) 3))
- (test-t (eql (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 nil) 3))
- (test-t (null (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 4)))
- (test-t (eql (mismatch '(a b c d e) '(c d)) 0))
- (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2) 4))
- (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :end1 3) 3))
- (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :start2 1) 2))
- (test-t (eql (mismatch '(a b c d e) '(c d) :start1 3 :start2 1) 4))
- (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :end2 1) 3))
- (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
- (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
- (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
- (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
- (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
- (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
- (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
- (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1))
- (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2))
- (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3))
- (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1)))
- (test-t (null (mismatch '(a b c) '(a b c) :from-end t)))
- (test-t (eql (mismatch '(a b c d) '(a b c) :from-end t) 4))
- (test-t (eql (mismatch '(a b c) '(c) :from-end t) 2))
- (test-t (eql (mismatch '(a b c) '(z a b c) :from-end t) 0))
- (test-t (eql (mismatch '(a b c) '(x y z a b c) :from-end t) 0))
- (test-t (eql (mismatch '(x y z a b c) '(a b c) :from-end t) 3))
- (test-t (eql (mismatch '(x y z a b c) '(a b c) :end1 3 :from-end t) 3))
- (test-t (eql (mismatch '(x y z a b c) '(a b c) :end1 5 :from-end t) 5))
- (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3))
- (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3))
- (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
- (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
- (test-t (eql (mismatch '((a) (b) (c)) '((a) (b) (c))) 0))
- (test-t (null (mismatch '((a) (b) (c)) '((a) (b) (c)) :key car)))
- (test-t (null (mismatch '((a) (b) (c)) '((a) (b) (c)) :test equal)))
- (test-t (eql (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0))
- (test-t (null (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test equalp)))
- (test-t (eql (mismatch '((a) (b) (c) (d)) '((a) (b) (c)) :key car) 3))
- (test-t (eql (mismatch '((a) (b) (c)) '((a) (b) (c) (d)) :key car) 3))
- (test-t (eql (mismatch '(#\a #\b #\c) '(#\A #\B #\C)) 0))
- (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase)))
- (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-downcase)))
- (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
- (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
- (test-t (eql (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f))) 0))
- (test-t (eql (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr) 0))
- (test-t (null (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal)))
- (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
- (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
- (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
- (test-t (null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
- (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
- (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
- (test-t (null (mismatch #() '())))
- (test-t (eql (mismatch #(a b c) '(x y z)) 0))
- (test-t (eql (mismatch #() '(x y z)) 0))
- (test-t (eql (mismatch #(x y z) '()) 0))
- (test-t (null (mismatch #(a) '(a))))
- (test-t (eql (mismatch #(a b c x y z) '(a b c)) 3))
- (test-t (null (mismatch #(a b c) '(a b c))))
- (test-t (eql (mismatch #(a b c d e f) '(a b c)) 3))
- (test-t (eql (mismatch #(a b c) '(a b c d e f)) 3))
- (test-t (eql (mismatch #(a b c) '(a b x)) 2))
- (test-t (eql (mismatch #(a b c) '(a x c)) 1))
- (test-t (eql (mismatch #(a b c) '(x b c)) 0))
- (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3) 6))
- (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6))
- (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4))
- (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3))
- (test-t (null (mismatch #(x y z) '() :start1 0 :end1 0)))
- (test-t (null (mismatch #(x y z) '() :start1 1 :end1 1)))
- (test-t (null (mismatch #(x y z) '() :start1 2 :end1 2)))
- (test-t (null (mismatch #(x y z) '() :start1 3 :end1 3)))
- (test-t (eql (mismatch #(x y z) '(a b c) :start1 0 :end1 0) 0))
- (test-t (eql (mismatch #(x y z) '(a b c) :start1 1 :end1 1) 1))
- (test-t (eql (mismatch #(x y z) '(a b c) :start1 2 :end1 2) 2))
- (test-t (eql (mismatch #(x y z) '(a b c) :start1 3 :end1 3) 3))
- (test-t (eql (mismatch #(x y z) '(x y z) :start1 0 :end1 1) 1))
- (test-t (eql (mismatch #(x y z) '(x y z) :start1 0 :end1 2) 2))
- (test-t (eql (mismatch #(x y z) '(x y z Z) :start1 0 :end1 3) 3))
- (test-t (null (mismatch #(x y z) '(x y z) :start1 0 :end1 3)))
- (test-t (eql (mismatch #(a b c x y z) '(x y z a b c)) 0))
- (test-t (eql (mismatch #(a b c x y z) '(x y z a b c) :start1 3) 6))
- (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9))
- (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6))
- (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3) 9))
- (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3) 6))
- (test-t (eql (mismatch #(a b c) '(a b c x y z)) 3))
- (test-t (eql (mismatch #(a b c) '(x a b c y z)) 0))
- (test-t (eql (mismatch #(a b c) '(x a b c y z) :start2 1) 3))
- (test-t (eql (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 nil) 3))
- (test-t (null (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 4)))
- (test-t (eql (mismatch #(a b c d e) '(c d)) 0))
- (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2) 4))
- (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :end1 3) 3))
- (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :start2 1) 2))
- (test-t (eql (mismatch #(a b c d e) '(c d) :start1 3 :start2 1) 4))
- (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :end2 1) 3))
- (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
- (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
- (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
- (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
- (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
- (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
- (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
- (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1))
- (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2))
- (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3))
- (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1)))
- (test-t (null (mismatch #(a b c) '(a b c) :from-end t)))
- (test-t (eql (mismatch #(a b c d) '(a b c) :from-end t) 4))
- (test-t (eql (mismatch #(a b c) '(c) :from-end t) 2))
- (test-t (eql (mismatch #(a b c) '(z a b c) :from-end t) 0))
- (test-t (eql (mismatch #(a b c) '(x y z a b c) :from-end t) 0))
- (test-t (eql (mismatch #(x y z a b c) '(a b c) :from-end t) 3))
- (test-t (eql (mismatch #(x y z a b c) '(a b c) :end1 3 :from-end t) 3))
- (test-t (eql (mismatch #(x y z a b c) '(a b c) :end1 5 :from-end t) 5))
- (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3))
- (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3))
- (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
- (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
- (test-t (eql (mismatch #((a) (b) (c)) '((a) (b) (c))) 0))
- (test-t (null (mismatch #((a) (b) (c)) '((a) (b) (c)) :key car)))
- (test-t (null (mismatch #((a) (b) (c)) '((a) (b) (c)) :test equal)))
- (test-t (eql (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0))
- (test-t (null (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test equalp)))
- (test-t (eql (mismatch #((a) (b) (c) (d)) '((a) (b) (c)) :key car) 3))
- (test-t (eql (mismatch #((a) (b) (c)) '((a) (b) (c) (d)) :key car) 3))
- (test-t (eql (mismatch #(#\a #\b #\c) '(#\A #\B #\C)) 0))
- (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase)))
- (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-downcase)))
- (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
- (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
- (test-t (eql (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f))) 0))
- (test-t (eql (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr) 0))
- (test-t (null (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal)))
- (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
- (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
- (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
- (test-t (null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
- (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
- (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
- (test-t (null (mismatch '() #())))
- (test-t (eql (mismatch '(a b c) #(x y z)) 0))
- (test-t (eql (mismatch '() #(x y z)) 0))
- (test-t (eql (mismatch '(x y z) #()) 0))
- (test-t (null (mismatch '(a) #(a))))
- (test-t (eql (mismatch '(a b c x y z) #(a b c)) 3))
- (test-t (null (mismatch '(a b c) #(a b c))))
- (test-t (eql (mismatch '(a b c d e f) #(a b c)) 3))
- (test-t (eql (mismatch '(a b c) #(a b c d e f)) 3))
- (test-t (eql (mismatch '(a b c) #(a b x)) 2))
- (test-t (eql (mismatch '(a b c) #(a x c)) 1))
- (test-t (eql (mismatch '(a b c) #(x b c)) 0))
- (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3) 6))
- (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6))
- (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4))
- (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3))
- (test-t (null (mismatch '(x y z) #() :start1 0 :end1 0)))
- (test-t (null (mismatch '(x y z) #() :start1 1 :end1 1)))
- (test-t (null (mismatch '(x y z) #() :start1 2 :end1 2)))
- (test-t (null (mismatch '(x y z) #() :start1 3 :end1 3)))
- (test-t (eql (mismatch '(x y z) #(a b c) :start1 0 :end1 0) 0))
- (test-t (eql (mismatch '(x y z) #(a b c) :start1 1 :end1 1) 1))
- (test-t (eql (mismatch '(x y z) #(a b c) :start1 2 :end1 2) 2))
- (test-t (eql (mismatch '(x y z) #(a b c) :start1 3 :end1 3) 3))
- (test-t (eql (mismatch '(x y z) #(x y z) :start1 0 :end1 1) 1))
- (test-t (eql (mismatch '(x y z) #(x y z) :start1 0 :end1 2) 2))
- (test-t (eql (mismatch '(x y z) #(x y z Z) :start1 0 :end1 3) 3))
- (test-t (null (mismatch '(x y z) #(x y z) :start1 0 :end1 3)))
- (test-t (eql (mismatch '(a b c x y z) #(x y z a b c)) 0))
- (test-t (eql (mismatch '(a b c x y z) #(x y z a b c) :start1 3) 6))
- (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9))
- (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6))
- (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3) 9))
- (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3) 6))
- (test-t (eql (mismatch '(a b c) #(a b c x y z)) 3))
- (test-t (eql (mismatch '(a b c) #(x a b c y z)) 0))
- (test-t (eql (mismatch '(a b c) #(x a b c y z) :start2 1) 3))
- (test-t (eql (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 nil) 3))
- (test-t (null (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 4)))
- (test-t (eql (mismatch '(a b c d e) #(c d)) 0))
- (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2) 4))
- (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :end1 3) 3))
- (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :start2 1) 2))
- (test-t (eql (mismatch '(a b c d e) #(c d) :start1 3 :start2 1) 4))
- (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :end2 1) 3))
- (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
- (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
- (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
- (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
- (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
- (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
- (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
- (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1))
- (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2))
- (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3))
- (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1)))
- (test-t (null (mismatch '(a b c) #(a b c) :from-end t)))
- (test-t (eql (mismatch '(a b c d) #(a b c) :from-end t) 4))
- (test-t (eql (mismatch '(a b c) #(c) :from-end t) 2))
- (test-t (eql (mismatch '(a b c) #(z a b c) :from-end t) 0))
- (test-t (eql (mismatch '(a b c) #(x y z a b c) :from-end t) 0))
- (test-t (eql (mismatch '(x y z a b c) #(a b c) :from-end t) 3))
- (test-t (eql (mismatch '(x y z a b c) #(a b c) :end1 3 :from-end t) 3))
- (test-t (eql (mismatch '(x y z a b c) #(a b c) :end1 5 :from-end t) 5))
- (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3))
- (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3))
- (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
- (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
- (test-t (eql (mismatch '((a) (b) (c)) #((a) (b) (c))) 0))
- (test-t (null (mismatch '((a) (b) (c)) #((a) (b) (c)) :key car)))
- (test-t (null (mismatch '((a) (b) (c)) #((a) (b) (c)) :test equal)))
- (test-t (eql (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0))
- (test-t (null (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test equalp)))
- (test-t (eql (mismatch '((a) (b) (c) (d)) #((a) (b) (c)) :key car) 3))
- (test-t (eql (mismatch '((a) (b) (c)) #((a) (b) (c) (d)) :key car) 3))
- (test-t (eql (mismatch '(#\a #\b #\c) #(#\A #\B #\C)) 0))
- (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase)))
- (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-downcase)))
- (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
- (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
- (test-t (eql (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f))) 0))
- (test-t (eql (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr) 0))
- (test-t (null (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal)))
- (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
- (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
- (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
- (test-t (null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
- (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
- (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
- (test-t (null (mismatch #() #())))
- (test-t (eql (mismatch #(a b c) #(x y z)) 0))
- (test-t (eql (mismatch #() #(x y z)) 0))
- (test-t (eql (mismatch #(x y z) #()) 0))
- (test-t (null (mismatch #(a) #(a))))
- (test-t (eql (mismatch #(a b c x y z) #(a b c)) 3))
- (test-t (null (mismatch #(a b c) #(a b c))))
- (test-t (eql (mismatch #(a b c d e f) #(a b c)) 3))
- (test-t (eql (mismatch #(a b c) #(a b c d e f)) 3))
- (test-t (eql (mismatch #(a b c) #(a b x)) 2))
- (test-t (eql (mismatch #(a b c) #(a x c)) 1))
- (test-t (eql (mismatch #(a b c) #(x b c)) 0))
- (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3) 6))
- (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6))
- (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4))
- (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3))
- (test-t (null (mismatch #(x y z) #() :start1 0 :end1 0)))
- (test-t (null (mismatch #(x y z) #() :start1 1 :end1 1)))
- (test-t (null (mismatch #(x y z) #() :start1 2 :end1 2)))
- (test-t (null (mismatch #(x y z) #() :start1 3 :end1 3)))
- (test-t (eql (mismatch #(x y z) #(a b c) :start1 0 :end1 0) 0))
- (test-t (eql (mismatch #(x y z) #(a b c) :start1 1 :end1 1) 1))
- (test-t (eql (mismatch #(x y z) #(a b c) :start1 2 :end1 2) 2))
- (test-t (eql (mismatch #(x y z) #(a b c) :start1 3 :end1 3) 3))
- (test-t (eql (mismatch #(x y z) #(x y z) :start1 0 :end1 1) 1))
- (test-t (eql (mismatch #(x y z) #(x y z) :start1 0 :end1 2) 2))
- (test-t (eql (mismatch #(x y z) #(x y z Z) :start1 0 :end1 3) 3))
- (test-t (null (mismatch #(x y z) #(x y z) :start1 0 :end1 3)))
- (test-t (eql (mismatch #(a b c x y z) #(x y z a b c)) 0))
- (test-t (eql (mismatch #(a b c x y z) #(x y z a b c) :start1 3) 6))
- (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9))
- (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6))
- (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3) 9))
- (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3) 6))
- (test-t (eql (mismatch #(a b c) #(a b c x y z)) 3))
- (test-t (eql (mismatch #(a b c) #(x a b c y z)) 0))
- (test-t (eql (mismatch #(a b c) #(x a b c y z) :start2 1) 3))
- (test-t (eql (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 nil) 3))
- (test-t (null (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 4)))
- (test-t (eql (mismatch #(a b c d e) #(c d)) 0))
- (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2) 4))
- (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :end1 3) 3))
- (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :start2 1) 2))
- (test-t (eql (mismatch #(a b c d e) #(c d) :start1 3 :start2 1) 4))
- (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :end2 1) 3))
- (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2)))
- (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3)))
- (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4)))
- (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1))
- (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2))
- (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3))
- (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4)))
- (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1))
- (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2))
- (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3))
- (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1)))
- (test-t (null (mismatch #(a b c) #(a b c) :from-end t)))
- (test-t (eql (mismatch #(a b c d) #(a b c) :from-end t) 4))
- (test-t (eql (mismatch #(a b c) #(c) :from-end t) 2))
- (test-t (eql (mismatch #(a b c) #(z a b c) :from-end t) 0))
- (test-t (eql (mismatch #(a b c) #(x y z a b c) :from-end t) 0))
- (test-t (eql (mismatch #(x y z a b c) #(a b c) :from-end t) 3))
- (test-t (eql (mismatch #(x y z a b c) #(a b c) :end1 3 :from-end t) 3))
- (test-t (eql (mismatch #(x y z a b c) #(a b c) :end1 5 :from-end t) 5))
- (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3))
- (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3))
- (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4))
- (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2))
- (test-t (eql (mismatch #((a) (b) (c)) #((a) (b) (c))) 0))
- (test-t (null (mismatch #((a) (b) (c)) #((a) (b) (c)) :key car)))
- (test-t (null (mismatch #((a) (b) (c)) #((a) (b) (c)) :test equal)))
- (test-t (eql (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0))
- (test-t (null (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test equalp)))
- (test-t (eql (mismatch #((a) (b) (c) (d)) #((a) (b) (c)) :key car) 3))
- (test-t (eql (mismatch #((a) (b) (c)) #((a) (b) (c) (d)) :key car) 3))
- (test-t (eql (mismatch #(#\a #\b #\c) #(#\A #\B #\C)) 0))
- (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase)))
- (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-downcase)))
- (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2)))
- (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 2 :start2 2)))
- (test-t (eql (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f))) 0))
- (test-t (eql (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr) 0))
- (test-t (null (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal)))
- (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal) 3))
- (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4))
- (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1))
- (test-t (null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4)))
- (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5))
- (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2))
- (test-t (eql (mismatch "abc" "xyz") 0))
- (test-t (null (mismatch "" "")))
- (test-t (null (mismatch "a" "a")))
- (test-t (null (mismatch "abc" "abc")))
- (test-t (null (mismatch "abc" "ABC" :key char-downcase)))
- (test-t (null (mismatch "abc" "ABC" :test char-equal)))
- (test-t (eql (mismatch "abcde" "abc") 3))
- (test-t (eql (mismatch "abc" "abcde") 3))
- (test-t (eql (mismatch "abc" "abxyz") 2))
- (test-t (eql (mismatch "abcde" "abx") 2))
- (test-t (null (mismatch "abc" "abc" :from-end t)))
- (test-t (eql (mismatch "abcxyz" "xyzxyz" :from-end t) 3))
- (test-t (eql (mismatch "abcxyz" "xyz" :from-end t) 3))
- (test-t (eql (mismatch "xyz" "abcxyz" :from-end t) 0))
- (test-t (eql (mismatch "ayz" "abcxyz" :from-end t) 1))
- (test-t (null (mismatch "abc" "xyz" :test char<)))
- (test-t (eql (mismatch "abc" "xyz" :test char>) 0))
- (test-t (eql (mismatch "abcxyz" "abcdefg") 3))
- (test-t (eql (mismatch "1xyz" "22xyz" :from-end t) 1))
(test-t (let ((lst (copy-seq "012345678"))) (and (equal (replace lst lst :start1 2 :start2 0) "010123456") (equal lst "010123456"))))
(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z)))) (and (eq list0 list) (equal list0 '(x y z d e)))))
@@ -27893,7 +45477,7 @@ abs 1 2
(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 5 :end1 5))) (and (eq list0 list) (equal list0 '(a b c d e)))))
(test-t (null (replace nil nil)))
(test-t (null (replace nil '(a b c))))
- (test-t (let* ((list0 (list 'a 'b 'c)) (list (replace list0 '()))) (and (eq list0 list) (equal list0 '(a b c)))))
+ (test-t (let* ((list0 (list 'a 'b 'c)) (list (replace list0 ()))) (and (eq list0 list) (equal list0 '(a b c)))))
(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0))) (and (eq list0 list) (equal list0 '(a b c d e)))))
(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0 :start1 3))) (and (eq list0 list) (equal list0 '(a b c a b)))))
(test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0 :start1 1))) (and (eq list0 list) (equal list0 '(a a b c d)))))
@@ -27913,7 +45497,7 @@ abs 1 2
(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 5 :end1 5))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
(test-t (null (replace nil #())))
(test-t (null (replace nil #(a b c))))
- (test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 '()))) (and (eq vector0 vector) (equalp vector0 #(a b c)))))
+ (test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 ()))) (and (eq vector0 vector) (equalp vector0 #(a b c)))))
(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0))) (and (eq vector0 vector) (equalp vector0 #(a b c d e)))))
(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 3))) (and (eq vector0 vector) (equalp vector0 #(a b c a b)))))
(test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 1))) (and (eq vector0 vector) (equalp vector0 #(a a b c d)))))
@@ -27948,621 +45532,13 @@ abs 1 2
(test-t (let* ((str0 (copy-seq "abcdef")) (str (replace str0 "xyz" :start1 1 :end1 2 :start2 1))) (and (eq str0 str) (equalp str0 "aycdef"))))
(test-t (let* ((str0 (copy-seq "abcdef")) (str (replace str0 "xyz" :start1 1 :start2 1 :end2 2))) (and (eq str0 str) (equalp str0 "aycdef"))))
(test-t (let* ((str0 (copy-seq "abcdef")) (str (replace str0 str0 :start1 1))) (and (eq str0 str) (equalp str0 "aabcde"))))
- (test-t (equal (substitute #\. #\space "0 2 4 6") "0.2.4.6"))
- (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5)) '(1 2 9 1 3 9 5)))
- (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 9 1 3 4 5)))
- (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5)))
- (test-t (equal (substitute 9 3 '(1 2 4 1 3 4 5) :test >) '(9 9 4 9 3 4 5)))
- (test-t (equal (substitute-if 0 evenp '((1) (2) (3) (4)) :start 2 :key car) '((1) (2) (3) 0)))
- (test-t (equal (substitute-if 9 oddp '(1 2 4 1 3 4 5)) '(9 2 4 9 9 4 9)))
- (test-t (equal (substitute-if 9 evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5)))
- (test-t (let ((some-things (list 'a 'car 'b 'cdr 'c)))
- (and (equal (nsubstitute-if "function was here" fboundp some-things
- :count 1 :from-end t)
- '(a car b "function was here" c))
- (equal some-things '(a car b "function was here" c)))))
- (test-t (let ((alpha-tester (copy-seq "ab "))) (and (equal (nsubstitute-if-not #\z alpha-char-p alpha-tester) "abz") (equal alpha-tester "abz"))))
- (test-t (equal (substitute 'a 'x '(x y z)) '(a y z)))
- (test-t (equal (substitute 'b 'y '(x y z)) '(x b z)))
- (test-t (equal (substitute 'c 'z '(x y z)) '(x y c)))
- (test-t (equal (substitute 'a 'p '(x y z)) '(x y z)))
- (test-t (equal (substitute 'a 'x '()) '()))
- (test-t (equal (substitute #\x #\b '(#\a #\b #\c #\d #\e) :test char<) '(#\a #\b #\x #\x #\x)))
- (test-t (equal (substitute '(a) 'x '((x) (y) (z)) :key car) '((a) (y) (z))))
- (test-t (equal (substitute 'c 'b '(a b a b a b a b)) '(a c a c a c a c)))
- (test-t (equal (substitute 'a 'b '(b b b)) '(a a a)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f)) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count nil) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 0) '(a x b x c x d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count -100) '(a x b x c x d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 1) '(a z b x c x d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 2) '(a z b z c x d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 3) '(a z b z c z d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 4) '(a z b z c z d z e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 5) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 6) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 7) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count nil :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 0 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count -100 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 1 :from-end t) '(a x b x c x d x e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 2 :from-end t) '(a x b x c x d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 3 :from-end t) '(a x b x c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 4 :from-end t) '(a x b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 5 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 6 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :count 7 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
- (test-t (equal (substitute 'z 'x '(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
- (test-t (equal (substitute #\z #\c '(#\a #\b #\c #\d #\e #\f) :test char<) '(#\a #\b #\c #\z #\z #\z)))
- (test-t (equal (substitute "peace" "war" '("war" "War" "WAr" "WAR") :test string-equal) '("peace" "peace" "peace" "peace")))
- (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :test string=) '("war" "War" "WAr" "peace")))
- (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :test string= :key string-upcase) '("peace" "peace" "peace" "peace")))
- (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :start 1 :end 2 :test string= :key string-upcase) '("war" "peace" "WAr" "WAR")))
- (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :start 1 :end nil :test string= :key string-upcase) '("war" "peace" "peace" "peace")))
- (test-t (equal (substitute "peace" "war" '("war" "War" "WAr" "WAR") :test string= :key string-upcase) '("war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute 'a 'x #(x y z)) #(a y z)))
- (test-t (equalp (substitute 'b 'y #(x y z)) #(x b z)))
- (test-t (equalp (substitute 'c 'z #(x y z)) #(x y c)))
- (test-t (equalp (substitute 'a 'p #(x y z)) #(x y z)))
- (test-t (equalp (substitute 'a 'x #()) #()))
- (test-t (equalp (substitute #\x #\b #(#\a #\b #\c #\d #\e) :test char<) #(#\a #\b #\x #\x #\x)))
- (test-t (equalp (substitute '(a) 'x #((x) (y) (z)) :key car) #((a) (y) (z))))
- (test-t (equalp (substitute 'c 'b #(a b a b a b a b)) #(a c a c a c a c)))
- (test-t (equalp (substitute 'a 'b #(b b b)) #(a a a)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
- (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
- (test-t (equalp (substitute #\z #\c #(#\a #\b #\c #\d #\e #\f) :test char<) #(#\a #\b #\c #\z #\z #\z)))
- (test-t (equalp (substitute "peace" "war" #("love" "hate" "war" "peace") :test equal) #("love" "hate" "peace" "peace")))
- (test-t (equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR") :test string-equal) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :test string=) #("war" "War" "WAr" "peace")))
- (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :test string= :key string-upcase) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :start 1 :end 2 :test string= :key string-upcase) #("war" "peace" "WAr" "WAR")))
- (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :start 1 :end nil :test string= :key string-upcase) #("war" "peace" "peace" "peace")))
- (test-t (equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR") :test string= :key string-upcase) #("war" "War" "WAr" "WAR")))
- (test-t (string= (substitute #\A #\a "abcabc") "AbcAbc"))
- (test-t (string= (substitute #\A #\a "") ""))
- (test-t (string= (substitute #\A #\a "xyz") "xyz"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
- (test-t (string= (substitute #\x #\5 "0123456789" :test char<) "012345xxxx"))
- (test-t (string= (substitute #\x #\5 "0123456789" :test char>) "xxxxx56789"))
- (test-t (string= (substitute #\x #\D "abcdefg" :key char-upcase :test char>) "xxxdefg"))
- (test-t (string= (substitute #\x #\D "abcdefg" :start 1 :end 2 :key char-upcase :test char>) "axcdefg"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
- (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
- (test-t (string= (substitute #\x #\A "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
- (test-t (string= (substitute #\X #\A "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
- (test-t (string= (substitute #\X #\D "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :test char< :count 3) "abcdeXXXij"))
- (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'x)) '(x y z)) '(a y z)))
- (test-t (equal (substitute-if 'b (lambda (arg) (eq arg 'y)) '(x y z)) '(x b z)))
- (test-t (equal (substitute-if 'c (lambda (arg) (eq arg 'z)) '(x y z)) '(x y c)))
- (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'p)) '(x y z)) '(x y z)))
- (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'x)) '()) '()))
- (test-t (equal (substitute-if #\x (lambda (arg) (char< #\b arg)) '(#\a #\b #\c #\d #\e)) '(#\a #\b #\x #\x #\x)))
- (test-t (equal (substitute-if '(a) (lambda (arg) (eq arg 'x)) '((x) (y) (z)) :key car) '((a) (y) (z))))
- (test-t (equal (substitute-if 'c (lambda (arg) (eq arg 'b)) '(a b a b a b a b)) '(a c a c a c a c)))
- (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'b)) '(b b b)) '(a a a)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f)) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count nil) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 0) '(a x b x c x d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count -100) '(a x b x c x d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 1) '(a z b x c x d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 2) '(a z b z c x d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 3) '(a z b z c z d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 4) '(a z b z c z d z e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 5) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 6) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 7) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count nil :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 0 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count -100 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 1 :from-end t) '(a x b x c x d x e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 2 :from-end t) '(a x b x c x d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 3 :from-end t) '(a x b x c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 4 :from-end t) '(a x b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 5 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 6 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :count 7 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
- (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) '(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
- (test-t (equal (substitute-if #\z (lambda (arg) (char< #\c arg)) '(#\a #\b #\c #\d #\e #\f)) '(#\a #\b #\c #\z #\z #\z)))
- (test-t (equal (substitute-if "peace" (lambda (arg) (equal "war" arg)) '("love" "hate" "war" "peace")) '("love" "hate" "peace" "peace")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string-equal "war" arg)) '("war" "War" "WAr" "WAR")) '("peace" "peace" "peace" "peace")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :key string-upcase) '("peace" "peace" "peace" "peace")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "war" arg)) '("war" "War" "WAr" "WAR") :key string-upcase) '("war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
-
- (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'x)) #(x y z)) #(a y z)))
- (test-t (equalp (substitute-if 'b (lambda (arg) (eq arg 'y)) #(x y z)) #(x b z)))
- (test-t (equalp (substitute-if 'c (lambda (arg) (eq arg 'z)) #(x y z)) #(x y c)))
- (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'p)) #(x y z)) #(x y z)))
- (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'x)) #()) #()))
- (test-t (equalp (substitute-if #\x (lambda (arg) (char< #\b arg)) #(#\a #\b #\c #\d #\e)) #(#\a #\b #\x #\x #\x)))
- (test-t (equalp (substitute-if '(a) (lambda (arg) (eq arg 'x)) #((x) (y) (z)) :key car) #((a) (y) (z))))
- (test-t (equalp (substitute-if 'c (lambda (arg) (eq arg 'b)) #(a b a b a b a b)) #(a c a c a c a c)))
- (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'b)) #(b b b)) #(a a a)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
- (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
- (test-t (equalp (substitute-if #\z (lambda (arg) (char< #\c arg)) #(#\a #\b #\c #\d #\e #\f)) #(#\a #\b #\c #\z #\z #\z)))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (equal "war" arg)) #("love" "hate" "war" "peace")) #("love" "hate" "peace" "peace")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string-equal "war" arg)) #("war" "War" "WAr" "WAR")) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :key string-upcase) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "war" arg)) #("war" "War" "WAr" "WAR") :key string-upcase) #("war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "abcabc") "AbcAbc"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "") ""))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "xyz") "xyz"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
- (test-t (string= (substitute-if #\x (lambda (arg) (char< #\5 arg)) "0123456789") "012345xxxx"))
- (test-t (string= (substitute-if #\x (lambda (arg) (char> #\5 arg)) "0123456789") "xxxxx56789"))
- (test-t (string= (substitute-if #\x (lambda (arg) (char> #\D arg)) "abcdefg" :key char-upcase) "xxxdefg"))
- (test-t (string= (substitute-if #\x (lambda (arg) (char> #\D arg)) "abcdefg" :start 1 :end 2 :key char-upcase) "axcdefg"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
- (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
- (test-t (string= (substitute-if #\x (lambda (arg) (eql #\A arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
- (test-t (string= (substitute-if #\X (lambda (arg) (eql #\A arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
- (test-t (string= (substitute-if #\X (lambda (arg) (char< #\D arg)) "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :count 3) "abcdeXXXij"))
- (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) '(x y z)) '(a y z)))
- (test-t (equal (substitute-if-not 'b (lambda (arg) (not (eq arg 'y))) '(x y z)) '(x b z)))
- (test-t (equal (substitute-if-not 'c (lambda (arg) (not (eq arg 'z))) '(x y z)) '(x y c)))
- (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'p))) '(x y z)) '(x y z)))
- (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) '()) '()))
- (test-t (equal (substitute-if-not #\x (lambda (arg) (not (char< #\b arg))) '(#\a #\b #\c #\d #\e)) '(#\a #\b #\x #\x #\x)))
- (test-t (equal (substitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) '((x) (y) (z)) :key car) '((a) (y) (z))))
- (test-t (equal (substitute-if-not 'c (lambda (arg) (not (eq arg 'b))) '(a b a b a b a b)) '(a c a c a c a c)))
- (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'b))) '(b b b)) '(a a a)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f)) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count nil) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 0) '(a x b x c x d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count -100) '(a x b x c x d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 1) '(a z b x c x d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 2) '(a z b z c x d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 3) '(a z b z c z d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 4) '(a z b z c z d z e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 5) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 6) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 7) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count nil :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 0 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count -100 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 1 :from-end t) '(a x b x c x d x e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 2 :from-end t) '(a x b x c x d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 3 :from-end t) '(a x b x c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 4 :from-end t) '(a x b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 5 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 6 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :count 7 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
- (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) '(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
- (test-t (equal (substitute-if-not #\z (lambda (arg) (not (char< #\c arg))) '(#\a #\b #\c #\d #\e #\f)) '(#\a #\b #\c #\z #\z #\z)))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (equal "war" arg))) '("love" "hate" "war" "peace")) '("love" "hate" "peace" "peace")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string-equal "war" arg))) '("war" "War" "WAr" "WAR")) '("peace" "peace" "peace" "peace")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :key string-upcase) '("peace" "peace" "peace" "peace")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "war" arg))) '("war" "War" "WAr" "WAR") :key string-upcase) '("war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) #(x y z)) #(a y z)))
- (test-t (equalp (substitute-if-not 'b (lambda (arg) (not (eq arg 'y))) #(x y z)) #(x b z)))
- (test-t (equalp (substitute-if-not 'c (lambda (arg) (not (eq arg 'z))) #(x y z)) #(x y c)))
- (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'p))) #(x y z)) #(x y z)))
- (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) #()) #()))
- (test-t (equalp (substitute-if-not #\x (lambda (arg) (not (char< #\b arg))) #(#\a #\b #\c #\d #\e)) #(#\a #\b #\x #\x #\x)))
- (test-t (equalp (substitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) #((x) (y) (z)) :key car) #((a) (y) (z))))
- (test-t (equalp (substitute-if-not 'c (lambda (arg) (not (eq arg 'b))) #(a b a b a b a b)) #(a c a c a c a c)))
- (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'b))) #(b b b)) #(a a a)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f)) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
- (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
- (test-t (equalp (substitute-if-not #\z (lambda (arg) (not (char< #\c arg))) #(#\a #\b #\c #\d #\e #\f)) #(#\a #\b #\c #\z #\z #\z)))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (equal "war" arg))) #("love" "hate" "war" "peace")) #("love" "hate" "peace" "peace")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string-equal "war" arg))) #("war" "War" "WAr" "WAR")) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :key string-upcase) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "war" arg))) #("war" "War" "WAr" "WAR") :key string-upcase) #("war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "abcabc") "AbcAbc"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "") ""))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "xyz") "xyz"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA"))
- (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char< #\5 arg))) "0123456789") "012345xxxx"))
- (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\5 arg))) "0123456789") "xxxxx56789"))
- (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\D arg))) "abcdefg" :key char-upcase) "xxxdefg"))
- (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\D arg))) "abcdefg" :start 1 :end 2 :key char-upcase) "axcdefg"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 2) "AAaaaaaaaa"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count -1) "aaaaaaaaaa"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 0) "aaaaaaaaaa"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count nil) "AAAAAAAAAA"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 100) "AAAAAAAAAA"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 9) "AAAAAAAAAa"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa"))
- (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
- (test-t (string= (substitute-if-not #\x (lambda (arg) (not (eql #\A arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
- (test-t (string= (substitute-if-not #\X (lambda (arg) (not (eql #\A arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
- (test-t (string= (substitute-if-not #\X (lambda (arg) (not (char< #\D arg))) "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :count 3) "abcdeXXXij"))
- (test-t (equal (nsubstitute 'a 'x (copy-seq '(x y z))) '(a y z)))
- (test-t (equal (nsubstitute 'b 'y (copy-seq '(x y z))) '(x b z)))
- (test-t (equal (nsubstitute 'c 'z (copy-seq '(x y z))) '(x y c)))
- (test-t (equal (nsubstitute 'a 'p (copy-seq '(x y z))) '(x y z)))
- (test-t (equal (nsubstitute 'a 'x (copy-seq '())) '()))
- (test-t (equal (nsubstitute #\x #\b (copy-seq '(#\a #\b #\c #\d #\e)) :test char<) '(#\a #\b #\x #\x #\x)))
- (test-t (equal (nsubstitute '(a) 'x (copy-seq '((x) (y) (z))) :key car) '((a) (y) (z))))
- (test-t (equal (nsubstitute 'c 'b (copy-seq '(a b a b a b a b))) '(a c a c a c a c)))
- (test-t (equal (nsubstitute 'a 'b (copy-seq '(b b b))) '(a a a)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f))) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count nil) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 0) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count -100) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 1) '(a z b x c x d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 2) '(a z b z c x d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 3) '(a z b z c z d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 4) '(a z b z c z d z e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 5) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 6) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 7) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count nil :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 0 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count -100 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 1 :from-end t) '(a x b x c x d x e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 2 :from-end t) '(a x b x c x d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 3 :from-end t) '(a x b x c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 4 :from-end t) '(a x b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 5 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 6 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :count 7 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
- (test-t (equal (nsubstitute 'z 'x (copy-seq '(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
- (test-t (equal (nsubstitute #\z #\c (copy-seq '(#\a #\b #\c #\d #\e #\f)) :test char<) '(#\a #\b #\c #\z #\z #\z)))
- (test-t (equal (nsubstitute "peace" "war" (copy-seq '("love" "hate" "war" "peace")) :test equal) '("love" "hate" "peace" "peace")))
- (test-t (equal (nsubstitute "peace" "war" (copy-seq '("war" "War" "WAr" "WAR")) :test string-equal) '("peace" "peace" "peace" "peace")))
- (test-t (equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR")) :test string=) '("war" "War" "WAr" "peace")))
- (test-t (equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR")) :test string= :key string-upcase) '("peace" "peace" "peace" "peace")))
- (test-t (equal (nsubstitute "peace" "WAR" (copy-seq '("war" "War" "WAr" "WAR")) :start 1 :end 2 :test string= :key string-upcase) '("war" "peace" "WAr" "WAR")))
- (test-t (equalp (nsubstitute 'a 'x (copy-seq #(x y z))) #(a y z)))
- (test-t (equalp (nsubstitute 'b 'y (copy-seq #(x y z))) #(x b z)))
- (test-t (equalp (nsubstitute 'c 'z (copy-seq #(x y z))) #(x y c)))
- (test-t (equalp (nsubstitute 'a 'p (copy-seq #(x y z))) #(x y z)))
- (test-t (equalp (nsubstitute 'a 'x (copy-seq #())) #()))
- (test-t (equalp (nsubstitute #\x #\b (copy-seq #(#\a #\b #\c #\d #\e)) :test char<) #(#\a #\b #\x #\x #\x)))
- (test-t (equalp (nsubstitute '(a) 'x (copy-seq #((x) (y) (z))) :key car) #((a) (y) (z))))
- (test-t (equalp (nsubstitute 'c 'b (copy-seq #(a b a b a b a b))) #(a c a c a c a c)))
- (test-t (equalp (nsubstitute 'a 'b (copy-seq #(b b b))) #(a a a)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f))) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count nil) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 0) #(a x b x c x d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count -100) #(a x b x c x d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 1) #(a z b x c x d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 2) #(a z b z c x d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 3) #(a z b z c z d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 4) #(a z b z c z d z e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 5) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 6) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 7) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count nil :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 0 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count -100 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 1 :from-end t) #(a x b x c x d x e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 2 :from-end t) #(a x b x c x d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 3 :from-end t) #(a x b x c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 4 :from-end t) #(a x b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 5 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 6 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :count 7 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
- (test-t (equalp (nsubstitute 'z 'x (copy-seq #(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
- (test-t (equalp (nsubstitute #\z #\c (copy-seq #(#\a #\b #\c #\d #\e #\f)) :test char<) #(#\a #\b #\c #\z #\z #\z)))
- (test-t (equalp (nsubstitute "peace" "war" (copy-seq #("love" "hate" "war" "peace")) :test equal) #("love" "hate" "peace" "peace")))
- (test-t (equalp (nsubstitute "peace" "war" (copy-seq #("war" "War" "WAr" "WAR")) :test string-equal) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR")) :test string=) #("war" "War" "WAr" "peace")))
- (test-t (equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR")) :test string= :key string-upcase) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR")) :start 1 :end 2 :test string= :key string-upcase) #("war" "peace" "WAr" "WAR")))
- (test-t (equalp (nsubstitute "peace" "WAR" (copy-seq #("war" "War" "WAr" "WAR")) :start 1 :end nil :test string= :key string-upcase) #("war" "peace" "peace" "peace")))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "abcabc")) "AbcAbc"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "")) ""))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "xyz")) "xyz"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :start 5 :end nil) "aaaaaAAAAA"))
- (test-t (string= (nsubstitute #\x #\5 (copy-seq "0123456789") :test char<) "012345xxxx"))
- (test-t (string= (nsubstitute #\x #\5 (copy-seq "0123456789") :test char>) "xxxxx56789"))
- (test-t (string= (nsubstitute #\x #\D (copy-seq "abcdefg") :key char-upcase :test char>) "xxxdefg"))
- (test-t (string= (nsubstitute #\x #\D (copy-seq "abcdefg") :start 1 :end 2 :key char-upcase :test char>) "axcdefg"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 2) "AAaaaaaaaa"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count -1) "aaaaaaaaaa"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 0) "aaaaaaaaaa"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count nil) "AAAAAAAAAA"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 100) "AAAAAAAAAA"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 9) "AAAAAAAAAa"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :count 9 :from-end t) "aAAAAAAAAA"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :start 2 :end 8 :count 3) "aaAAAaaaaa"))
- (test-t (string= (nsubstitute #\A #\a (copy-seq "aaaaaaaaaa") :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa"))
- (test-t (string= (nsubstitute #\x #\A (copy-seq "aaaaaaaaaa") :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa"))
- (test-t (string= (nsubstitute #\X #\A (copy-seq "aaaaaaaaaa") :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa"))
- (test-t (string= (nsubstitute #\X #\D (copy-seq "abcdefghij") :start 2 :end 8 :from-end t :key char-upcase :test char< :count 3) "abcdeXXXij"))
- (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy-seq '(x y z))) '(a y z)))
- (test-t (equal (nsubstitute-if 'b (lambda (arg) (eq arg 'y)) (copy-seq '(x y z))) '(x b z)))
- (test-t (equal (nsubstitute-if 'c (lambda (arg) (eq arg 'z)) (copy-seq '(x y z))) '(x y c)))
- (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'p)) (copy-seq '(x y z))) '(x y z)))
- (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy-seq '())) '()))
- (test-t (equal (nsubstitute-if #\x (lambda (arg) (char< #\b arg)) (copy-seq '(#\a #\b #\c #\d #\e))) '(#\a #\b #\x #\x #\x)))
- (test-t (equal (nsubstitute-if '(a) (lambda (arg) (eq arg 'x)) (copy-seq '((x) (y) (z))) :key car) '((a) (y) (z))))
- (test-t (equal (nsubstitute-if 'c (lambda (arg) (eq arg 'b)) (copy-seq '(a b a b a b a b))) '(a c a c a c a c)))
- (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'b)) (copy-seq '(b b b))) '(a a a)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f))) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count nil) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 0) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count -100) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 1) '(a z b x c x d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 2) '(a z b z c x d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 3) '(a z b z c z d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 4) '(a z b z c z d z e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 5) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 6) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 7) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count nil :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 0 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count -100 :from-end t) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 1 :from-end t) '(a x b x c x d x e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 2 :from-end t) '(a x b x c x d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 3 :from-end t) '(a x b x c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 4 :from-end t) '(a x b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 5 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 6 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :count 7 :from-end t) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end nil :count 1) '(a x b z c x d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end 6 :count 100) '(a x b z c z d x e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end 11 :count 100) '(a x b z c z d z e z f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end 8 :count 10) '(a x b z c z d z e x f)))
- (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq '(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f)))
- (test-t (equal (nsubstitute-if #\z (lambda (arg) (char< #\c arg)) (copy-seq '(#\a #\b #\c #\d #\e #\f))) '(#\a #\b #\c #\z #\z #\z)))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (equal "war" arg)) (copy-seq '("love" "hate" "war" "peace"))) '("love" "hate" "peace" "peace")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string-equal "war" arg)) (copy-seq '("war" "War" "WAr" "WAR"))) '("peace" "peace" "peace" "peace")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR")) :key string-upcase) '("peace" "peace" "peace" "peace")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR")) :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR")) :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "war" arg)) (copy-seq '("war" "War" "WAr" "WAR")) :key string-upcase) '("war" "War" "WAr" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR")))
- (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy-seq #(x y z))) #(a y z)))
- (test-t (equalp (nsubstitute-if 'b (lambda (arg) (eq arg 'y)) (copy-seq #(x y z))) #(x b z)))
- (test-t (equalp (nsubstitute-if 'c (lambda (arg) (eq arg 'z)) (copy-seq #(x y z))) #(x y c)))
- (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'p)) (copy-seq #(x y z))) #(x y z)))
- (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy-seq #())) #()))
- (test-t (equalp (nsubstitute-if #\x (lambda (arg) (char< #\b arg)) (copy-seq #(#\a #\b #\c #\d #\e))) #(#\a #\b #\x #\x #\x)))
- (test-t (equalp (nsubstitute-if '(a) (lambda (arg) (eq arg 'x)) (copy-seq #((x) (y) (z))) :key car) #((a) (y) (z))))
- (test-t (equalp (nsubstitute-if 'c (lambda (arg) (eq arg 'b)) (copy-seq #(a b a b a b a b))) #(a c a c a c a c)))
- (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'b)) (copy-seq #(b b b))) #(a a a)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f))) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count nil) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 0) #(a x b x c x d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count -100) #(a x b x c x d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 1) #(a z b x c x d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 2) #(a z b z c x d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 3) #(a z b z c z d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 4) #(a z b z c z d z e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 5) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 6) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 7) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count nil :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 0 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count -100 :from-end t) #(a x b x c x d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 1 :from-end t) #(a x b x c x d x e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 2 :from-end t) #(a x b x c x d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 3 :from-end t) #(a x b x c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 4 :from-end t) #(a x b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 5 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 6 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :count 7 :from-end t) #(a z b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end nil :count 1) #(a x b z c x d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end 6 :count 100) #(a x b z c z d x e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end 11 :count 100) #(a x b z c z d z e z f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end 8 :count 10) #(a x b z c z d z e x f)))
- (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy-seq #(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f)))
- (test-t (equalp (nsubstitute-if #\z (lambda (arg) (char< #\c arg)) (copy-seq #(#\a #\b #\c #\d #\e #\f))) #(#\a #\b #\c #\z #\z #\z)))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (equal "war" arg)) (copy-seq #("love" "hate" "war" "peace"))) #("love" "hate" "peace" "peace")))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string-equal "war" arg)) (copy-seq #("war" "War" "WAr" "WAR"))) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR")) :key string-upcase) #("peace" "peace" "peace" "peace")))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR")) :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR")))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR")) :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace")))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "war" arg)) (copy-seq #("war" "War" "WAr" "WAR")) :key string-upcase) #("war" "War" "WAr" "WAR")))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR")))
- (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy-seq #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR")))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "abcabc")) "AbcAbc"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "")) ""))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "xyz")) "xyz"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :start 5 :end nil) "aaaaaAAAAA"))
- (test-t (string= (nsubstitute-if #\x (lambda (arg) (char< #\5 arg)) (copy-seq "0123456789")) "012345xxxx"))
- (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\5 arg)) (copy-seq "0123456789")) "xxxxx56789"))
- (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\D arg)) (copy-seq "abcdefg") :key char-upcase) "xxxdefg"))
- (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\D arg)) (copy-seq "abcdefg") :start 1 :end 2 :key char-upcase) "axcdefg"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 2) "AAaaaaaaaa"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count -1) "aaaaaaaaaa"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 0) "aaaaaaaaaa"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count nil) "AAAAAAAAAA"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 100) "AAAAAAAAAA"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 9) "AAAAAAAAAa"))
- (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy-seq "aaaaaaaaaa") :count 9 :from-end t) "aAAAAAAAAA"))
- (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'x))) (copy-seq '(x y z))) '(a y z)))
- (test-t (equal (nsubstitute-if-not 'b (lambda (arg) (not (eq arg 'y))) (copy-seq '(x y z))) '(x b z)))
- (test-t (equal (nsubstitute-if-not 'c (lambda (arg) (not (eq arg 'z))) (copy-seq '(x y z))) '(x y c)))
- (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'p))) (copy-seq '(x y z))) '(x y z)))
- (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'x))) (copy-seq '())) '()))
- (test-t (equal (nsubstitute-if-not #\x (lambda (arg) (not (char< #\b arg))) (copy-seq '(#\a #\b #\c #\d #\e))) '(#\a #\b #\x #\x #\x)))
- (test-t (equal (nsubstitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) (copy-seq '((x) (y) (z))) :key car) '((a) (y) (z))))
- (test-t (equal (nsubstitute-if-not 'c (lambda (arg) (not (eq arg 'b))) (copy-seq '(a b a b a b a b))) '(a c a c a c a c)))
- (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'b))) (copy-seq '(b b b))) '(a a a)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f))) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count nil) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 0) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count -100) '(a x b x c x d x e x f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 1) '(a z b x c x d x e x f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 2) '(a z b z c x d x e x f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 3) '(a z b z c z d x e x f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 4) '(a z b z c z d z e x f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 5) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 6) '(a z b z c z d z e z f)))
- (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy-seq '(a x b x c x d x e x f)) :count 7) '(a z b z c z d z e z f)))
(test-t (string= (concatenate 'string "all" " " "together" " " "now") "all together now"))
- (test-t (equal (concatenate 'list '() '(a b c) '(x y z)) '(a b c x y z)))
+ (test-t (equal (concatenate 'list () '(a b c) '(x y z)) '(a b c x y z)))
(test-t (equal (concatenate 'list '(a) #(b) '(c) #(x y) '(z)) '(a b c x y z)))
(test-t (null (concatenate 'list)))
(test-t (let* ((list0 '(a b c)) (list (concatenate 'list list0))) (and (not (eq list0 list)) (equal list list0) (equal list '(a b c)))))
- (test-t (equalp (concatenate 'vector '() '(a b c) '(x y z)) #(a b c x y z)))
+ (test-t (equalp (concatenate 'vector () '(a b c) '(x y z)) #(a b c x y z)))
(test-t (equalp (concatenate 'vector '(a) #(b) '(c) #(x y) '(z)) #(a b c x y z)))
(test-t (equalp (concatenate 'vector) #()))
(test-t (let* ((vector0 #(a b c)) (vector (concatenate 'vector vector0))) (and (not (eq vector0 vector)) (equalp vector vector0) (equalp vector #(a b c)))))
@@ -28570,920 +45546,6 @@ abs 1 2
(test-t (string= (concatenate 'string "" "abc" "" "def" "" "ghi" "" "" "jkl" "" "mno" "" "pqr" "" "") "abcdefghijklmnopqr"))
(test-t (string= (concatenate 'string) ""))
(test-t (string= (concatenate 'string "abc" '(#\d #\e #\f #\g) #(#\h #\i #\j #\k #\l)) "abcdefghijkl"))
- (test-t (let ((test1 (list 1 3 4 6 7)) (test2 (list 2 5 8))) (equal (merge 'list test1 test2 <) '(1 2 3 4 5 6 7 8))))
- (test-t (let ((test1 (vector '(red . 1) '(blue . 4))) (test2 (vector '(yellow . 2) '(green . 7)))) (equalp (merge 'vector test1 test2 < :key cdr) #((red . 1) (yellow . 2) (blue . 4) (green . 7)))))
- (test-t (equal (merge 'list (list 1 3 5 7 9) (list 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equal (merge 'list (list 0 1 2) nil <) '(0 1 2)))
- (test-t (equal (merge 'list nil (list 0 1 2) <) '(0 1 2)))
- (test-t (equal (merge 'list nil nil <) nil))
- (test-t (equal (merge 'list (list '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
- (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
- (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
- (test-t (equal (merge 'list (list 3 1 9 5 7) (list 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
- (test-t (equal (merge 'list (vector 1 3 5 7 9) (list 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equal (merge 'list (vector 0 1 2) nil <) '(0 1 2)))
- (test-t (equal (merge 'list #() (list 0 1 2) <) '(0 1 2)))
- (test-t (equal (merge 'list #() #() <) nil))
- (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
- (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
- (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
- (test-t (equal (merge 'list (vector 3 1 9 5 7) (list 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
- (test-t (equal (merge 'list (list 1 3 5 7 9) (vector 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equal (merge 'list (list 0 1 2) #() <) '(0 1 2)))
- (test-t (equal (merge 'list nil (vector 0 1 2) <) '(0 1 2)))
- (test-t (equal (merge 'list nil #() <) nil))
- (test-t (equal (merge 'list (list '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
- (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
- (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
- (test-t (equal (merge 'list (list 3 1 9 5 7) (vector 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
- (test-t (equal (merge 'list (vector 1 3 5 7 9) (vector 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equal (merge 'list (vector 0 1 2) #() <) '(0 1 2)))
- (test-t (equal (merge 'list #() (vector 0 1 2) <) '(0 1 2)))
- (test-t (equal (merge 'list #() #() <) nil))
- (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
- (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
- (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
- (test-t (equal (merge 'list (vector 3 1 9 5 7) (vector 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7)))
- (test-t (equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equalp (merge 'vector (list 0 1 2) nil <) #(0 1 2)))
- (test-t (equalp (merge 'vector nil (list 0 1 2) <) #(0 1 2)))
- (test-t (equalp (merge 'vector nil nil <) #()))
- (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
- (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
- (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
- (test-t (equalp (merge 'vector (list 3 1 9 5 7) (list 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
- (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equalp (merge 'vector (vector 0 1 2) nil <) #(0 1 2)))
- (test-t (equalp (merge 'vector #() (list 0 1 2) <) #(0 1 2)))
- (test-t (equalp (merge 'vector #() #() <) #()))
- (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
- (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
- (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
- (test-t (equalp (merge 'vector (vector 3 1 9 5 7) (list 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
- (test-t (equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equalp (merge 'vector (list 0 1 2) #() <) #(0 1 2)))
- (test-t (equalp (merge 'vector nil (vector 0 1 2) <) #(0 1 2)))
- (test-t (equalp (merge 'vector nil #() <) #()))
- (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
- (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
- (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
- (test-t (equalp (merge 'vector (list 3 1 9 5 7) (vector 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
- (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9)))
- (test-t (equalp (merge 'vector (vector 0 1 2) #() <) #(0 1 2)))
- (test-t (equalp (merge 'vector #() (vector 0 1 2) <) #(0 1 2)))
- (test-t (equalp (merge 'vector #() #() <) #()))
- (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2))))
- (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2))))
- (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2))))
- (test-t (equalp (merge 'vector (vector 3 1 9 5 7) (vector 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7)))
- (test-t (string= (merge 'string (list #\a #\c #\e) (list #\b #\d #\f) char<) "abcdef"))
- (test-t (string= (merge 'string (list #\a #\b #\c) (list #\d #\e #\f) char<) "abcdef"))
- (test-t (string= (merge 'string (list #\a #\b #\c) '() char<) "abc"))
- (test-t (string= (merge 'string '() (list #\a #\b #\c) char<) "abc"))
- (test-t (string= (merge 'string (list #\a #\b #\c) (copy-seq "") char<) "abc"))
- (test-t (string= (merge 'string (list #\a #\b #\z) #(#\c #\x #\y) char<) "abcxyz"))
- (test-t (equal (remove 4 '(1 3 4 5 9)) '(1 3 5 9)))
- (test-t (equal (remove 4 '(1 2 4 1 3 4 5)) '(1 2 1 3 5)))
- (test-t (equal (remove 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5)))
- (test-t (equal (remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
- (test-t (equal (remove 3 '(1 2 4 1 3 4 5) :test >) '(4 3 4 5)))
- (test-t (let* ((lst '(list of four elements)) (lst2 (copy-seq lst)) (lst3 (delete 'four lst))) (and (equal lst3 '(list of elements)) (not (equal lst lst2)))))
- (test-t (equal (remove-if oddp '(1 2 4 1 3 4 5)) '(2 4 4)))
- (test-t (equal (remove-if evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
- (test-t (equal (remove-if-not evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t) '(1 2 3 4 5 6 8)))
- (test-t (equal (delete 4 (list 1 2 4 1 3 4 5)) '(1 2 1 3 5)))
- (test-t (equal (delete 4 (list 1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5)))
- (test-t (equal (delete 4 (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
- (test-t (equal (delete 3 (list 1 2 4 1 3 4 5) :test >) '(4 3 4 5)))
- (test-t (equal (delete-if oddp (list 1 2 4 1 3 4 5)) '(2 4 4)))
- (test-t (equal (delete-if evenp (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5)))
- (test-t (equal (delete-if evenp (list 1 2 3 4 5 6)) '(1 3 5)))
- (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove 3 list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
- (test-t (equal (remove 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
- (test-t (equal (remove 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
- (test-t (equal (remove 'a (list 'a 'a 'a)) '()))
- (test-t (equal (remove 'z (list 'a 'b 'c)) '(a b c)))
- (test-t (equal (remove 'a '()) '()))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
- (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
- (test-t (equal (remove 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
- (test-t (equal (remove 'a (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) '()))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) '(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) '(("Love") ("LOve"))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
- (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove 3 vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
- (test-t (equalp (remove 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
- (test-t (equalp (remove 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
- (test-t (equalp (remove 'a (vector 'a 'a 'a)) #()))
- (test-t (equalp (remove 'z (vector 'a 'b 'c)) #(a b c)))
- (test-t (equalp (remove 'a #()) #()))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
- (test-t (equalp (remove 'a (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) #()))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
- (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (string= (remove #\a (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (remove #\a (copy-seq "")) ""))
- (test-t (string= (remove #\a (copy-seq "xyz")) "xyz"))
- (test-t (string= (remove #\a (copy-seq "ABCABC")) "ABCABC"))
- (test-t (string= (remove #\a (copy-seq "ABCABC") :key char-downcase) "BCBC"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (let* ((str0 (copy-seq "abc")) (str (remove #\a str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (remove #\b (copy-seq "abcabc")) "acac"))
- (test-t (string= (remove #\c (copy-seq "abcabc")) "abab"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 2) "bcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 3) "bcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 4) "bcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count -1) "abcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabc") :count -100) "abcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
- (test-t (string= (remove #\a (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
- (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove-if (lambda (arg) (eql arg 3)) list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) '()))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) '()) '()))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
- (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
- (test-t (equal (remove-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '()))
- (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
- (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
- (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
- (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
- (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove-if (lambda (arg) (eql arg 3)) vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'b)) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'c)) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'a 'a)) #()))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'z)) (vector 'a 'b 'c)) #(a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) #()) #()))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
- (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
- (test-t (equalp (remove-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
- (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "")) ""))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "xyz")) "xyz"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "ABCABC") :key char-downcase) "BCBC"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (let* ((str0 (copy-seq "abc")) (str (remove-if (lambda (arg) (string-equal arg #\a)) str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\b)) (copy-seq "abcabc")) "acac"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\c)) (copy-seq "abcabc")) "abab"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 2) "bcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 3) "bcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 4) "bcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -1) "abcabc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -100) "abcabc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
- (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
- (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
- (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove-if-not (lambda (arg) (not (eql arg 3))) list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4)))))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'b))) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'c))) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'a 'a)) '()))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'z))) (list 'a 'b 'c)) '(a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) '()) '()))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '()))
- (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
- (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
- (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
- (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
- (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove-if-not (lambda (arg) (not (eql arg 3))) vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4)))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'b))) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'c))) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'a 'a)) #()))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'z))) (vector 'a 'b 'c)) #(a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) #()) #()))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
- (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "")) ""))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "xyz")) "xyz"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "ABCABC") :key char-downcase) "BCBC"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (let* ((str0 (copy-seq "abc")) (str (remove-if-not (lambda (arg) (not (string-equal arg #\a))) str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc"))))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\b))) (copy-seq "abcabc")) "acac"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\c))) (copy-seq "abcabc")) "abab"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 2) "bcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 3) "bcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 4) "bcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -1) "abcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -100) "abcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
- (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
- (test-t (equal (delete 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
- (test-t (equal (delete 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
- (test-t (equal (delete 'a (list 'a 'a 'a)) '()))
- (test-t (equal (delete 'z (list 'a 'b 'c)) '(a b c)))
- (test-t (equal (delete 'a '()) '()))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
- (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
- (test-t (equal (delete 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
- (test-t (equal (delete 'a (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) '()))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) '(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) '(("Love") ("LOve"))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
- (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
- (test-t (equalp (delete 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
- (test-t (equalp (delete 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
- (test-t (equalp (delete 'a (vector 'a 'a 'a)) #()))
- (test-t (equalp (delete 'z (vector 'a 'b 'c)) #(a b c)))
- (test-t (equalp (delete 'a #()) #()))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
- (test-t (equalp (delete 'a (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) #()))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
- (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (string= (delete #\a (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (delete #\a (copy-seq "")) ""))
- (test-t (string= (delete #\a (copy-seq "xyz")) "xyz"))
- (test-t (string= (delete #\a (copy-seq "ABCABC")) "ABCABC"))
- (test-t (string= (delete #\a (copy-seq "ABCABC") :key char-downcase) "BCBC"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (delete #\b (copy-seq "abcabc")) "acac"))
- (test-t (string= (delete #\c (copy-seq "abcabc")) "abab"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 2) "bcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 3) "bcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 4) "bcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count -1) "abcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabc") :count -100) "abcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
- (test-t (string= (delete #\a (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) '()))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) '()) '()))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
- (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
- (test-t (equal (delete-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '()))
- (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
- (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
- (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
- (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
- (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'b)) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'c)) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'a 'a)) #()))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'z)) (vector 'a 'b 'c)) #(a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) #()) #()))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
- (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
- (test-t (equalp (delete-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
- (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "")) ""))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "xyz")) "xyz"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "ABCABC") :key char-downcase) "BCBC"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\b)) (copy-seq "abcabc")) "acac"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\c)) (copy-seq "abcabc")) "abab"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 2) "bcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 3) "bcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 4) "bcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -1) "abcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabc") :count -100) "abcabc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
- (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
- (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c)) '(b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'b))) (list 'a 'b 'c 'a 'b 'c)) '(a c a c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'c))) (list 'a 'b 'c 'a 'b 'c)) '(a b a b)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'a 'a)) '()))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'z))) (list 'a 'b 'c)) '(a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) '()) '()))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c)))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c))))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c))))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '()))
- (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe"))))
- (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve"))))
- (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE"))))
- (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE"))))
- (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'b))) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'c))) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'a 'a)) #()))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'z))) (vector 'a 'b 'c)) #(a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) #()) #()))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c)))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #()))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE"))))
- (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE"))))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "")) ""))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "xyz")) "xyz"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "ABCABC") :key char-downcase) "BCBC"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc")) "bcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\b))) (copy-seq "abcabc")) "acac"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\c))) (copy-seq "abcabc")) "abab"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 0) "abcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1) "bcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 1 :from-end t) "abcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 2) "bcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 2 :from-end t) "bcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 3) "bcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 3 :from-end t) "bcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 4) "bcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count 4 :from-end t) "bcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -1) "abcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -10) "abcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabc") :count -100) "abcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabcabcabc") :start 1) "abcbcbcbc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy-seq "abcabcabcabc") :start 1 :count 1) "abcbcabcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :count 2) "abcbcbcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8) "abcbcbcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 1 :end 1) "abcabcabcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 2 :end 2) "abcabcabcabc"))
- (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy-seq "abcabcabcabc") :start 12 :end 12) "abcabcabcabc"))
- (test-t (equal (remove-duplicates "aBcDAbCd" :test char-equal :from-end t) "aBcD"))
- (test-t (equal (remove-duplicates '(a b c b d d e)) '(a c b d e)))
- (test-t (equal (remove-duplicates '(a b c b d d e) :from-end t) '(a b c d e)))
- (test-t (let* ((list0 (list 0 1 2 3 4 5 6)) (list (delete-duplicates list0 :key oddp :start 1 :end 6))) (equal list '(0 4 5 6))))
- (test-t (let* ((list0 (list 2 1 0 1 0 1 2)) (list (remove-duplicates list0))) (and (not (eq list0 list)) (equal list0 '(2 1 0 1 0 1 2)) (equal list '(0 1 2)))))
- (test-t (let* ((vector0 (vector 2 1 0 1 0 1 2)) (vector (remove-duplicates vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(2 1 0 1 0 1 2)) (equalp vector #(0 1 2)))))
- (test-t (equal (remove-duplicates (list 0 1 2 2 3 3 3)) '(0 1 2 3)))
- (test-t (equal (remove-duplicates (list 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) '(0 1 2)))
- (test-t (equal (remove-duplicates (list 'a 'a 'b 'c 'c)) '(a b c)))
- (test-t (equal (remove-duplicates (list 0 1 2)) '(0 1 2)))
- (test-t (equal (remove-duplicates (list 2 0 2 1 1 1 0 0 0 1 2)) '(0 1 2)))
- (test-t (equal (remove-duplicates (list)) '()))
- (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr) '((a . 0) (b . 1) (c . 2))))
- (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr :test (lambda (a b) (and (oddp a) (oddp b)))) '((x . 0) (z . 2) (a . 0) (b . 1) (c . 2))))
- (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr :test (lambda (a b) (and (evenp a) (evenp b)))) '((y . 1) (b . 1) (c . 2))))
- (test-t (equal (remove-duplicates (list 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9) '(0 1 2 0 1 2 0 1 2)))
- (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11))) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11))))
- (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :key car) '((0 . 9) (1 . 10) (2 . 11))))
- (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2))))
- (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :key car) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 9) '(1 . 10) '(2 . 11))))
- (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5))))
- (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end nil :key car) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 9) '(1 . 10) '(2 . 11))))
- (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end 9 :key car) '((0 . 0) (1 . 1) (2 . 2) (0 . 6) (1 . 7) (2 . 8) (0 . 9) (1 . 10) (2 . 11))))
- (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end 9 :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 9) '(1 . 10) '(2 . 11))))
- (test-t (equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key length) (list "Tuesday" "Wednesday" "Saturday" "Sunday")))
- (test-t (equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key (lambda (arg) (char arg 0)) :test char=) (list "Monday" "Wednesday" "Thursday" "Friday" "Sunday")))
- (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key char-upcase) '(#\A #\B #\C)))
- (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key char-upcase :from-end t) '(#\a #\b #\c)))
- (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char=) (list #\a #\b #\c #\A #\B #\C)))
- (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char-equal) (list #\A #\B #\C)))
- (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char-equal :from-end t) (list #\a #\b #\c)))
- (test-t (equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alpha-char-p) (list #\C #\9)))
- (test-t (equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alphanumericp) (list #\9)))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car) (list '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9 :test char-equal) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9 :test char-equal :from-end t) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end nil) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :from-end t) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8))))
- (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :end 9) (list '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))))
- (test-t (equalp (remove-duplicates (vector 0 1 2 2 3 3 3)) #(0 1 2 3)))
- (test-t (equalp (remove-duplicates (vector 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) #(0 1 2)))
- (test-t (equalp (remove-duplicates (vector 'a 'a 'b 'c 'c)) #(a b c)))
- (test-t (equalp (remove-duplicates (vector 0 1 2)) #(0 1 2)))
- (test-t (equalp (remove-duplicates (vector 2 0 2 1 1 1 0 0 0 1 2)) #(0 1 2)))
- (test-t (equalp (remove-duplicates (vector)) #()))
- (test-t (equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr) #((a . 0) (b . 1) (c . 2))))
- (test-t (equalp (remove-duplicates (vector 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9) #(0 1 2 0 1 2 0 1 2)))
- (test-t (equalp (remove-duplicates (vector "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key length) (vector "Tuesday" "Wednesday" "Saturday" "Sunday")))
- (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key char-upcase) #(#\A #\B #\C)))
- (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key char-upcase :from-end t) #(#\a #\b #\c)))
- (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char=) (vector #\a #\b #\c #\A #\B #\C)))
- (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char-equal) (vector #\A #\B #\C)))
- (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char-equal :from-end t) (vector #\a #\b #\c)))
- (test-t (equalp (remove-duplicates (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alpha-char-p) (vector #\C #\9)))
- (test-t (equalp (remove-duplicates (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alphanumericp) (vector #\9)))
- (test-t (string= (remove-duplicates (copy-seq "")) ""))
- (test-t (string= (remove-duplicates (copy-seq "abc")) "abc"))
- (test-t (string= (remove-duplicates (copy-seq "abcabc")) "abc"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabc")) "abc"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabc") :from-end t) "cba"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA")) "abcCBA"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :from-end t) "cbaABC"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :key char-downcase) "CBA"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :key char-downcase :from-end t) "cba"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3) "cbaabcCBA"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :from-end t) "cbaabcABC"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9) "cbaabcABCCBA"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :key char-upcase) "cbaABCCBA"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :key char-upcase :from-end t) "cbaabcCBA"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :test char-equal :from-end t) "cbaabcCBA"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :key upper-case-p :test eq) "cbacCCBA"))
- (test-t (string= (remove-duplicates (copy-seq "cbaabcABCCBA") :start 3 :end 9 :key upper-case-p :test eq :from-end t) "cbaaACBA"))
-
;;
;; ----------------------------------- end sacla ---------------------------------------------
;;
@@ -29496,20 +45558,20 @@ abs 1 2
(do ((n 0 (+ n 1)))
((= n 16))
(if (not (= n (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111)))
- (format #t "~A: ~A ~A~%" n (boole-n-vector n) (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111))))
- (let ((lst '()))
+ (format-logged #t "~A: ~A ~A~%" n (boole-n-vector n) (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111))))
+ (let ((lst ()))
(do ((n #b0000 (+ n 1)))
((> n #b1111))
(set! lst (cons (boole (boole-n-vector n) 5 3) lst)))
(if (not (equal? (reverse lst)
(list 0 1 2 3 4 5 6 7 -8 -7 -6 -5 -4 -3 -2 -1)))
- (format #t ";boole: ~A~%" (reverse lst)))))
+ (format-logged #t ";boole: ~A~%" (reverse lst)))))
(test (digit-char-p #\a) #f)
(test (digit-char-p #\a 16) 10)
- (test (let ((v (vector 1 2 3 4 5))) (cl-fill v 32 :start 2 :end 3)) '#(1 2 32 4 5))
- (test (let ((v (vector 1 2 3 4 5))) (cl-fill v 32 :start 2)) '#(1 2 32 32 32))
- (test (let ((v (vector 1 2 3))) (cl-fill v 32)) '#(32 32 32))
+ (test (let ((v (vector 1 2 3 4 5))) (cl-fill v 32 :start 2 :end 3)) #(1 2 32 4 5))
+ (test (let ((v (vector 1 2 3 4 5))) (cl-fill v 32 :start 2)) #(1 2 32 32 32))
+ (test (let ((v (vector 1 2 3))) (cl-fill v 32)) #(32 32 32))
(test (let ((lst (list 1 2 3))) (cl-fill lst "hi")) '("hi" "hi" "hi"))
(test (some zero? '(1 2 3)) #f)
(test (some zero? '(1 0 3)) #t)
@@ -29579,16 +45641,6 @@ abs 1 2
(test (deposit-field #xabcdef (byte 8 8) 0) #xcd00)
(test (deposit-field #xabcdef (byte 8 4) 0) #xde0)
(test (deposit-field #xabcdef (byte 8 8) #xffffffff) #xffffcdff)
- (test (count-if zero? '(0 1 2 0)) 2)
- (test (count-if-not zero? '(0 1 2 0 3)) 3)
- (test (count-if zero? '#(0 1 2 0)) 2)
- (test (count-if zero? '((0 1) (1 0) (2 3) (0 1)) :key car) 2)
- (test (count-if zero? '(0 1 2 0) :from-end #t) 2)
- (test (count-if zero? '(0 1 2 0) :start 1) 1)
- (test (count-if zero? '(0 1 2 0) :start 1 :end 3) 0)
- (test (count-if zero? '(0 1 2 0) :end 3) 1)
- (test (count-if zero? '(0 1 2 0) :end 4) 2)
- (test (count-if zero? '(0 1 2 0) :end 4 :from-end #t) 2)
(test (identity 1) 1)
(test (stringp "hi") #t)
(test (stringp #\h) #f)
@@ -29610,35 +45662,35 @@ abs 1 2
(test (integerp 3) #t)
(test (numberp 3) #t)
(test (numberp "hiho") #f)
- (test (consp '()) #f)
+ (test (consp ()) #f)
(test (consp '(1 2)) #t)
(test (consp 3) #f)
(test (atom 3) #t)
- (test (atom '()) #t)
+ (test (atom ()) #t)
(test (atom '(1 2 3)) #f)
- (test (vectorp '#(1 2 3)) #t)
+ (test (vectorp #(1 2 3)) #t)
(test (vectorp "hiho") #f)
(test (symbolp 'hi) #t)
(test (symbolp "hiho") #f)
(test (last '(1 2 3)) '(3))
- (test (last '()) '())
- (test (tree-equal '() '()) #t)
+ (test (last ()) ())
+ (test (tree-equal () ()) #t)
(test (tree-equal (list 1 2 (list 3 5) 5) (list 1 2 (list 3 4) 5)) #f)
(test (tree-equal (list 1 2 (list 3 4) 5) (list 1 2 (list 3 4) 5)) #t)
(test (nthcdr 0 '(1 2 3)) '(1 2 3))
(test (nthcdr 2 '(1 2 3)) '(3))
- (test (nthcdr 4 '(1 2 3)) '())
- (test (listp '()) #t)
+ (test (nthcdr 4 '(1 2 3)) ())
+ (test (listp ()) #t)
(test (listp 3) #f)
(test (listp '(1 . 2)) #t)
(test (listp (list 1 2)) #t)
- (test (null '()) #t)
+ (test (null ()) #t)
(test (null '(1 2 3)) #f)
(test (butlast '(1 2 3 4)) '(1 2 3))
(test (butlast '((1 2) (3 4))) '((1 2)))
- (test (butlast '(1)) '())
- (test (butlast '()) '())
- (test (copy-list '()) '())
+ (test (butlast '(1)) ())
+ (test (butlast ()) ())
+ (test (copy-list ()) ())
(test (copy-list '(1 2 3)) '(1 2 3))
(test (copy-tree '(1 (2 3) 4)) '(1 (2 3) 4))
(test (rest '(1 2 3)) '(2 3))
@@ -29670,7 +45722,7 @@ abs 1 2
(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (ninth val)) 9)
(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (tenth val)) 10)
(test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 7 val)) 8)
- (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 17 val)) '())
+ (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 17 val)) ())
(test (let*-values (((x) (values 1))) x) 1)
(test (let*-values ((x (values 1))) x) '(1))
@@ -29724,1135 +45776,7 @@ abs 1 2
)
) ; end CL
-
-(let ()
- ;; tiny-clos
-
- ; Mode: Scheme
- ;
- ;
- ; *************************************************************************
- ; Copyright (c) 1992 Xerox Corporation.
- ; All Rights Reserved.
- ;
- ; Use, reproduction, and preparation of derivative works are permitted.
- ; Any copy of this software or of any derivative work must include the
- ; above copyright notice of Xerox Corporation, this paragraph and the
- ; one after it. Any distribution of this software or derivative works
- ; must comply with all applicable United States export control laws.
- ;
- ; This software is made available AS IS, and XEROX CORPORATION DISCLAIMS
- ; ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION THE
- ; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
- ; PURPOSE, AND NOTWITHSTANDING ANY OTHER PROVISION CONTAINED HEREIN, ANY
- ; LIABILITY FOR DAMAGES RESULTING FROM THE SOFTWARE OR ITS USE IS
- ; EXPRESSLY DISCLAIMED, WHETHER ARISING IN CONTRACT, TORT (INCLUDING
- ; NEGLIGENCE) OR STRICT LIABILITY, EVEN IF XEROX CORPORATION IS ADVISED
- ; OF THE POSSIBILITY OF SUCH DAMAGES.
- ; *************************************************************************
-
- ;
- ; In order to make this code more easily portable, we have to be
- ; explicit about its implementation dependencies. To do this, we
- ; have the following variable. Please adjust it before trying to
- ; run this code. See also the macro, scheme-implementation-case,
- ; which follows shortly.
- ;
- ; Note that some of these dependencies (i.e. gsort) are purely for
- ; convenience (i.e. saving me from writing sort from scratch).
- ; Others are more pressing, like define-macro.
- ;
- ;
- (define what-scheme-implementation
- 's7
- ; 'mit
- ;'chez
- ;'scm
- ;'scheme48
- )
-
- (case what-scheme-implementation
- ((scm)
- (require 'sort)))
-
- (define gsort
- (case what-scheme-implementation
- ((s7) (lambda (predicate list) (sort! list predicate)))
- ((mit) (lambda (predicate list) (sort list predicate)))
- ((chez) (lambda (predicate list) (sort predicate list)))
- ((scheme48) (lambda (predicate list) (sort-list predicate list)))
- ((scm) (lambda (predicate list) (sort list predicate)))))
-
- (define simple-printer (lambda () barf))
- (define ??? 'unspecified-result)
-
- (define list*
- (lambda args
- (letrec ((chase
- (lambda (args)
- (cond ((null? args) '())
- ((null? (cdr args)) (car args))
- (else (cons (car args) (chase (cdr args))))))))
- (chase args))))
-
- (define apply*
- (lambda (proc . args)
- (apply proc (apply list* args))))
-
- (define position-of
- (lambda (x lst)
- (if (eq? x (car lst)) 0 (+ 1 (position-of x (cdr lst))))))
-
- (define map-append
- (lambda (proc . lists)
- (apply append (apply map (cons proc lists)))))
-
- (define last
- (lambda (l)
- (if (null? l)
- #f
- (if (null? (cdr l))
- (car l)
- (last (cdr l))))))
-
- (define every
- (lambda (test . lists)
- (let scan ((tails lists))
- (if (member #t (map null? tails)) ;(any null? lists)
- #t
- (and (apply test (map car tails))
- (scan (map cdr tails)))))))
-
- (define remove
- (lambda (x list)
- (cond ((null? list) '())
- ((eq? (car list) x) (cdr list))
- (else (cons (car list) (remove x (cdr list)))))))
-
- (define getl
- (lambda (initargs name . not-found)
- (letrec ((scan (lambda (tail)
- (cond ((null? tail)
- (if (pair? not-found)
- (car not-found)
- (error "GETL couldn't find ~A" name)))
- ((eq? (car tail) name) (cadr tail))
- (else (scan (cddr tail)))))))
- (scan initargs))))
-
- (define union
- (lambda lists
- (letrec ((clean (lambda (list result)
- (cond ((null? list) result)
- ((memq (car list) result)
- (clean (cdr list) result))
- (else
- (clean (cdr list) (cons (car list) result)))))))
- (clean (apply append lists) '()))))
-
- (define collect-if
- (lambda (test? list)
- (cond ((null? list) '())
- ((test? (car list)) (cons (car list) (collect-if test? (cdr list))))
- (else (collect-if test? (cdr list))))))
-
- (define remove-duplicates
- (lambda (list)
- (let loop ((result-so-far '())
- (remaining list))
- (if (null? remaining)
- result-so-far
- (if (null? (memq (car remaining) result-so-far))
- (loop (cons (car remaining) result-so-far)
- (cdr remaining))
- (loop result-so-far
- (cdr remaining)))))))
- ;
- ; A simple topological sort.
- ;
- ; It's in this file so that both TinyClos and Objects can use it.
- ;
- ; This is a fairly modified version of code I originally got from Anurag
- ; Mendhekar <anurag at moose.cs.indiana.edu>.
- ;
- ;
-
- (define compute-std-cpl
- (lambda (c get-direct-supers)
- (top-sort ((build-transitive-closure get-direct-supers) c)
- ((build-constraints get-direct-supers) c)
- (std-tie-breaker get-direct-supers))))
-
- (define top-sort
- (lambda (elements constraints tie-breaker)
- (let loop ((elements elements)
- (constraints constraints)
- (result '()))
- (if (null? elements)
- result
- (let ((can-go-in-now
- (collect-if
- (lambda (x)
- (every (lambda (constraint)
- (or (not (eq? (cadr constraint) x))
- (memq (car constraint) result)))
- constraints))
- elements)))
- (if (null? can-go-in-now)
- (error 'top-sort "Invalid constraints")
- (let ((choice (if (null? (cdr can-go-in-now))
- (car can-go-in-now)
- (tie-breaker result
- can-go-in-now))))
- (loop
- (collect-if (lambda (x) (not (eq? x choice)))
- elements)
- constraints
- (append result (list choice))))))))))
-
- (define std-tie-breaker
- (lambda (get-supers)
- (lambda (partial-cpl min-elts)
- (let loop ((pcpl (reverse partial-cpl)))
- (let ((current-elt (car pcpl)))
- (let ((ds-of-ce (get-supers current-elt)))
- (let ((common (collect-if (lambda (x)
- (memq x ds-of-ce))
- min-elts)))
- (if (null? common)
- (if (null? (cdr pcpl))
- (error 'std-tie-breaker "Nothing valid")
- (loop (cdr pcpl)))
- (car common)))))))))
-
- (define build-transitive-closure
- (lambda (get-follow-ons)
- (lambda (x)
- (let track ((result '())
- (pending (list x)))
- (if (null? pending)
- result
- (let ((next (car pending)))
- (if (memq next result)
- (track result (cdr pending))
- (track (cons next result)
- (append (get-follow-ons next)
- (cdr pending))))))))))
-
- (define build-constraints
- (lambda (get-follow-ons)
- (lambda (x)
- (let loop ((elements ((build-transitive-closure get-follow-ons) x))
- (this-one '())
- (result '()))
- (if (or (null? this-one) (null? (cdr this-one)))
- (if (null? elements)
- result
- (loop (cdr elements)
- (cons (car elements)
- (get-follow-ons (car elements)))
- result))
- (loop elements
- (cdr this-one)
- (cons (list (car this-one) (cadr this-one))
- result)))))))
-
- (define tiny-clos-version "1.7")
-
- ; A very simple CLOS-like language, embedded in Scheme, with a simple
- ; MOP. The features of the default base language are:
- ;
- ; * Classes, with instance slots, but no slot options.
- ; * Multiple-inheritance.
- ; * Generic functions with multi-methods and class specializers only.
- ; * Primary methods and call-next-method; no other method combination.
- ; * Uses Scheme's lexical scoping facilities as the class and generic
- ; function naming mechanism. Another way of saying this is that
- ; class, generic function and methods are first-class (meta)objects.
- ;
- ; While the MOP is simple, it is essentially equal in power to both MOPs
- ; in AMOP. This implementation is not at all optimized, but the MOP is
- ; designed so that it can be optimized. In fact, this MOP allows better
- ; optimization of slot access extenstions than those in AMOP.
- ;
- ;
- ;
- ; In addition to calling a generic, the entry points to the default base
- ; language are:
- ;
- ; (MAKE-CLASS list-of-superclasses list-of-slot-names)
- ; (MAKE-GENERIC)
- ; (MAKE-METHOD list-of-specializers procedure)
- ; (ADD-METHOD generic method)
- ;
- ; (MAKE class . initargs)
- ; (INITIALIZE instance initargs) ;Add methods to this,
- ; ;don't call it directly.
- ;
- ; (SLOT-REF object slot-name)
- ; (SLOT-SET! object slot-name new-value)
- ;
- ;
- ; So, for example, one might do:
- ;
- ; (define <position> (make-class (list <object>) (list 'x 'y)))
- ; (add-method initialize
- ; (make-method (list <position>)
- ; (lambda (call-next-method pos initargs)
- ; (for-each (lambda (initarg-name slot-name)
- ; (slot-set! pos
- ; slot-name
- ; (getl initargs initarg-name 0)))
- ; '(x y)
- ; '(x y)))))
- ;
- ; (set! p1 (make <position> 'x 1 'y 3))
- ;
- ;
- ;
- ; NOTE! Do not use EQUAL? to compare objects! Use EQ? or some hand
- ; written procedure. Objects have a pointer to their class,
- ; and classes are circular structures, and ...
- ;
- ;
- ;
- ; The introspective part of the MOP looks like the following. Note that
- ; these are ordinary procedures, not generics.
- ;
- ; CLASS-OF
- ;
- ; CLASS-DIRECT-SUPERS
- ; CLASS-DIRECT-SLOTS
- ; CLASS-CPL
- ; CLASS-SLOTS
- ;
- ; GENERIC-METHODS
- ;
- ; METHOD-SPECIALIZERS
- ; METHOD-PROCEDURE
- ;
- ;
- ; The intercessory protocol looks like (generics in uppercase):
- ;
- ; make
- ; ALLOCATE-INSTANCE
- ; INITIALIZE (really a base-level generic)
- ;
- ; class initialization
- ; COMPUTE-CPL
- ; COMPUTE-SLOTS
- ; COMPUTE-GETTER-AND-SETTER
- ;
- ; add-method (Notice this is not a generic!)
- ; COMPUTE-APPLY-GENERIC
- ; COMPUTE-METHODS
- ; COMPUTE-METHOD-MORE-SPECIFIC?
- ; COMPUTE-APPLY-METHODS
- ;
-
- ;
- ; OK, now let's get going. But, as usual, before we can do anything
- ; interesting, we have to muck around for a bit first. First, we need
- ; to load the support library.
- ;
- ; Note that there is no extension on the filename in the following load,
- ; in particular, it isn't "support.scm" even though that is the name of
- ; the file in the distribution at PARC. The idea is that when people
- ; install the code at their site, they should rename all the files to
- ; the appropriate extension, and then not change the load. This should
- ; also make things work with binary files and the like. This comes from
- ; my understanding of the CL world... I hope it is right.
- ;
- ;
- ;
- ; Then, we need to build what, in a more real implementation, would be
- ; the interface to the memory subsystem: instances and entities. The
- ; former are used for instances of instances of <class>; the latter
- ; are used for instances of instances of <entity-class>. In this MOP,
- ; none of this is visible to base- or MOP-level programmers.
- ;
- ; A few things to note, that have influenced the way all this is done:
- ;
- ; - R4RS doesn't provide a mechanism for specializing the
- ; behavior of the printer for certain objects.
- ;
- ; - Some Scheme implementations bomb when printing circular
- ; structures -- that is, arrays and/or lists that somehow
- ; point back to themselves.
- ;
- ; So, the natural implementation of instances -- vectors whose first
- ; field point to the class -- is straight on out. Instead, we use a
- ; procedure to `encapsulate' that natural representation.
- ;
- ; Having gone that far, it makes things simpler to unify the way normal
- ; instances and entities are handled, at least in the lower levels of
- ; the system. Don't get faked out by this -- the user shouldn't think
- ; of normal instances as being procedures, they aren't. (At least not
- ; in this language.) If you are using this to teach, you probably want
- ; to hide the implementation of instances and entities from people.
- ;
- ;
- (define %allocate-instance
- (lambda (class nfields)
- (%allocate-instance-internal
- class
- #t
- (lambda args
- (error "An instance isn't a procedure -- can't apply it."))
- nfields)))
-
- (define %allocate-entity
- (lambda (class nfields)
- (%allocate-instance-internal
- class
- #f
- (lambda args
- (error "Tried to call an entity before its proc is set."))
- nfields)))
-
- (define %allocate-instance-internal ???)
- (define %instance? ???)
- (define %instance-class ???)
- (define %set-instance-class-to-self ???) ;This is used only once
- ;as part of bootstrapping
- ;the braid.
- (define %set-instance-proc! ???)
- (define %instance-ref ???)
- (define %instance-set! ???)
-
- (letrec ((instances '())
- (get-vector
- (lambda (closure)
- (let ((cell (assq closure instances)))
- (if cell (cdr cell) #f)))))
-
- (set! %allocate-instance-internal
- (lambda (class lock proc nfields)
- (letrec ((vector (make-vector (+ nfields 3) #f))
- (closure (lambda args
- (apply (vector-ref vector 0) args))))
- (vector-set! vector 0 proc)
- (vector-set! vector 1 lock)
- (vector-set! vector 2 class)
- (set! instances (cons (cons closure vector) instances))
- closure)))
-
- (set! %instance?
- (lambda (x) (not (null? (get-vector x)))))
-
- (set! %instance-class
- (lambda (closure)
- (let ((vector (get-vector closure)))
- (vector-ref vector 2))))
-
- (set! %set-instance-class-to-self
- (lambda (closure)
- (let ((vector (get-vector closure)))
- (vector-set! vector 2 closure))))
-
- (set! %set-instance-proc!
- (lambda (closure proc)
- (let ((vector (get-vector closure)))
- (if (vector-ref vector 1)
- (error "Can't set procedure of instance.")
- (vector-set! vector 0 proc)))))
-
- (set! %instance-ref
- (lambda (closure index)
- (let ((vector (get-vector closure)))
- (vector-ref vector (+ index 3)))))
-
- (set! %instance-set!
- (lambda (closure index new-value)
- (let ((vector (get-vector closure)))
- (vector-set! vector (+ index 3) new-value))))
- )
-
- ; %allocate-instance, %allocate-entity, %instance-ref, %instance-set!
- ; and class-of are the normal interface, from the rest of the code, to
- ; the low-level memory system. One thing to take note of is that the
- ; protocol does not allow the user to add low-level instance
- ; representations. I have never seen a way to make that work.
- ;
- ; Note that this implementation of class-of assumes the name of a the
- ; primitive classes that are set up later.
- ;
- (define class-of
- (lambda (x)
- (cond ((%instance? x) (%instance-class x))
-
- ((pair? x) <pair>) ;If all Schemes were IEEE
- ((null? x) <null>) ;compliant, the order of
- ((boolean? x) <boolean>) ;these wouldn't matter?
- ((symbol? x) <symbol>)
- ((procedure? x) <procedure>)
- ((number? x) <number>)
- ((vector? x) <vector>)
- ((char? x) <char>)
- ((string? x) <string>)
- (( input-port? x) <input-port>)
- ((output-port? x) <output-port>)
-
-
- )))
-
- ; Now we can get down to business. First, we initialize the braid.
- ;
- ; For Bootstrapping, we define an early version of MAKE. It will be
- ; changed to the real version later on. String search for ``set! make''.
- ;
-
- (define make
- (lambda (class . initargs)
- (cond ((or (eq? class <class>)
- (eq? class <entity-class>))
- (let* ((new (%allocate-instance
- class
- (length the-slots-of-a-class)))
- (dsupers (getl initargs 'direct-supers '()))
- (dslots (map list
- (getl initargs 'direct-slots '())))
- (cpl (let loop ((sups dsupers)
- (so-far (list new)))
- (if (null? sups)
- (reverse so-far)
- (loop (class-direct-supers
- (car sups))
- (cons (car sups)
- so-far)))))
- (slots (apply append
- (cons dslots
- (map class-direct-slots
- (cdr cpl)))))
- (nfields 0)
- (field-initializers '())
- (allocator
- (lambda (init)
- (let ((f nfields))
- (set! nfields (+ nfields 1))
- (set! field-initializers
- (cons init field-initializers))
- (list (lambda (o) (%instance-ref o f))
- (lambda (o n) (%instance-set! o f n))))))
- (getters-n-setters
- (map (lambda (s)
- (cons (car s)
- (allocator (lambda () '()))))
- slots)))
-
- (slot-set! new 'direct-supers dsupers)
- (slot-set! new 'direct-slots dslots)
- (slot-set! new 'cpl cpl)
- (slot-set! new 'slots slots)
- (slot-set! new 'nfields nfields)
- (slot-set! new 'field-initializers (reverse
- field-initializers))
- (slot-set! new 'getters-n-setters getters-n-setters)
- new))
- ((eq? class <generic>)
- (let ((new (%allocate-entity class
- (length (class-slots class)))))
- (slot-set! new 'methods '())
- new))
- ((eq? class <method>)
- (let ((new (%allocate-instance
- class
- (length (class-slots class)))))
- (slot-set! new
- 'specializers
- (getl initargs 'specializers))
- (slot-set! new
- 'procedure
- (getl initargs 'procedure))
- new)))))
-
- ; These are the real versions of slot-ref and slot-set!. Because of the
- ; way the new slot access protocol works, with no generic call in line,
- ; they can be defined up front like this. Cool eh?
- ;
- ;
- (define slot-ref
- (lambda (object slot-name)
- (let* ((info (lookup-slot-info (class-of object) slot-name))
- (getter (list-ref info 0)))
- (getter object))))
-
- (define slot-set!
- (lambda (object slot-name new-value)
- (let* ((info (lookup-slot-info (class-of object) slot-name))
- (setter (list-ref info 1)))
- (setter object new-value))))
-
- (define lookup-slot-info
- (lambda (class slot-name)
- (let* ((getters-n-setters
- (if (eq? class <class>) ;* This grounds out
- getters-n-setters-for-class ;* the slot-ref tower.
- (slot-ref class 'getters-n-setters)))
- (entry (assq slot-name getters-n-setters)))
- (if entry
- (cdr entry)
- (error "No slot ~A in instances of ~A" slot-name class)))))
- ;
- ; Given that the early version of MAKE is allowed to call accessors on
- ; class metaobjects, the definitions for them come here, before the
- ; actual class definitions, which are coming up right afterwards.
- ;
- ;
- (define class-direct-slots
- (lambda (class) (slot-ref class 'direct-slots)))
- (define class-direct-supers
- (lambda (class) (slot-ref class 'direct-supers)))
- (define class-slots
- (lambda (class) (slot-ref class 'slots)))
- (define class-cpl
- (lambda (class) (slot-ref class 'cpl)))
-
- (define generic-methods
- (lambda (generic) (slot-ref generic 'methods)))
-
- (define method-specializers
- (lambda (method) (slot-ref method 'specializers)))
- (define method-procedure
- (lambda (method) (slot-ref method 'procedure)))
-
- ; The next 7 clusters define the 6 initial classes. It takes 7 to 6
- ; because the first and fourth both contribute to <class>.
- ;
- (define the-slots-of-a-class ;
- '(direct-supers ;(class ...)
- direct-slots ;((name . options) ...)
- cpl ;(class ...)
- slots ;((name . options) ...)
- nfields ;an integer
- field-initializers ;(proc ...)
- getters-n-setters)) ;((slot-name getter setter) ...)
- ;
- (define getters-n-setters-for-class ;see lookup-slot-info
- ;
- ; I know this seems like a silly way to write this. The
- ; problem is that the obvious way to write it seems to
- ; tickle a bug in MIT Scheme!
- ;
- (let ((make-em (lambda (s f)
- (list s
- (lambda (o) (%instance-ref o f))
- (lambda (o n) (%instance-set! o f n))))))
- (map (lambda (s)
- (make-em s (position-of s the-slots-of-a-class)))
- the-slots-of-a-class)))
- (define <class> (%allocate-instance #f (length the-slots-of-a-class)))
- (%set-instance-class-to-self <class>)
-
- (define <top> (make <class>
- 'direct-supers (list)
- 'direct-slots (list)))
-
- (define <object> (make <class>
- 'direct-supers (list <top>)
- 'direct-slots (list)))
-
- ;
- ; This cluster, together with the first cluster above that defines
- ; <class> and sets its class, have the effect of:
- ;
- ; (define <class>
- ; (make <class>
- ; 'direct-supers (list <object>)
- ; 'direct-slots (list 'direct-supers ...)))
- ;
- (slot-set! <class> 'direct-supers (list <object>))
- (slot-set! <class> 'direct-slots (map list the-slots-of-a-class))
- (slot-set! <class> 'cpl (list <class> <object> <top>))
- (slot-set! <class> 'slots (map list the-slots-of-a-class))
- (slot-set! <class> 'nfields (length the-slots-of-a-class))
- (slot-set! <class> 'field-initializers (map (lambda (s)
- (lambda () '()))
- the-slots-of-a-class))
- (slot-set! <class> 'getters-n-setters '())
-
-
- (define <procedure-class> (make <class>
- 'direct-supers (list <class>)
- 'direct-slots (list)))
-
- (define <entity-class> (make <class>
- 'direct-supers (list <procedure-class>)
- 'direct-slots (list)))
-
- (define <generic> (make <entity-class>
- 'direct-supers (list <object>)
- 'direct-slots (list 'methods)))
-
- (define <method> (make <class>
- 'direct-supers (list <object>)
- 'direct-slots (list 'specializers
- 'procedure)))
-
-
- ; These are the convenient syntax we expose to the base-level user.
- ;
- ;
- (define make-class
- (lambda (direct-supers direct-slots)
- (make <class>
- 'direct-supers direct-supers
- 'direct-slots direct-slots)))
-
- (define make-generic
- (lambda ()
- (make <generic>)))
-
- (define make-method
- (lambda (specializers procedure)
- (make <method>
- 'specializers specializers
- 'procedure procedure)))
-
-
- ; The initialization protocol
- ;
- (define initialize (make-generic))
-
- ; The instance structure protocol.
- ;
- (define allocate-instance (make-generic))
- (define compute-getter-and-setter (make-generic))
- ;
- ; The class initialization protocol.
- ;
- (define compute-cpl (make-generic))
- (define compute-slots (make-generic))
-
- ;
- ; The generic invocation protocol.
- ;
- (define compute-apply-generic (make-generic))
- (define compute-methods (make-generic))
- (define compute-method-more-specific? (make-generic))
- (define compute-apply-methods (make-generic))
- ;
- ; The next thing to do is bootstrap generic functions.
- ;
- (define generic-invocation-generics (list compute-apply-generic
- compute-methods
- compute-method-more-specific?
- compute-apply-methods))
-
- (define add-method
- (lambda (generic method)
- (slot-set! generic
- 'methods
- (cons method
- (collect-if
- (lambda (m)
- (not (every eq?
- (method-specializers m)
- (method-specializers method))))
- (slot-ref generic 'methods))))
- (%set-instance-proc! generic (compute-apply-generic generic))))
-
- ;
- ; Adding a method calls COMPUTE-APPLY-GENERIC, the result of which calls
- ; the other generics in the generic invocation protocol. Two, related,
- ; problems come up. A chicken and egg problem and a infinite regress
- ; problem.
- ;
- ; In order to add our first method to COMPUTE-APPLY-GENERIC, we need
- ; something sitting there, so it can be called. The first definition
- ; below does that.
- ;
- ; Then, the second definition solves both the infinite regress and the
- ; not having enough of the protocol around to build itself problem the
- ; same way: it special cases invocation of generics in the invocation
- ; protocol.
- ;
- ;
- (%set-instance-proc! compute-apply-generic
- (lambda (generic)
- (let ((method (car (generic-methods generic))))
- ((method-procedure method) #f generic))))
-
- (add-method compute-apply-generic
- (make-method (list <generic>)
- (lambda (call-next-method generic)
- (lambda args
- (if (and (memq generic generic-invocation-generics) ;* G c
- (memq (car args) generic-invocation-generics)) ;* r a
- (apply (method-procedure ;* o s
- (last (generic-methods generic))) ;* u e
- (cons #f args)) ;* n
- ;* d
- ((compute-apply-methods generic)
- ((compute-methods generic) args)
- args))))))
-
- (add-method compute-methods
- (make-method (list <generic>)
- (lambda (call-next-method generic)
- (lambda (args)
- (let ((applicable
- (collect-if (lambda (method)
- ;
- ; Note that every only goes as far as the
- ; shortest list!
- ;
- (every applicable?
- (method-specializers method)
- args))
- (generic-methods generic))))
- (gsort (lambda (m1 m2)
- ((compute-method-more-specific? generic)
- m1
- m2
- args))
- applicable))))))
-
- (add-method compute-method-more-specific?
- (make-method (list <generic>)
- (lambda (call-next-method generic)
- (lambda (m1 m2 args)
- (let loop ((specls1 (method-specializers m1))
- (specls2 (method-specializers m2))
- (args args))
- (cond ((and (null? specls1) (null? specls2))
- (error
- "Two methods are equally specific."))
- ((or (null? specls1) (null? specls2))
- (error
- "Two methods have a different number of specializers."))
- ((null? args)
- (error
- "Fewer arguments than specializers."))
- (else
- (let ((c1 (car specls1))
- (c2 (car specls2))
- (arg (car args)))
- (if (eq? c1 c2)
- (loop (cdr specls1)
- (cdr specls2)
- (cdr args))
- (more-specific? c1 c2 arg))))))))))
-
- (add-method compute-apply-methods
- (make-method (list <generic>)
- (lambda (call-next-method generic)
- (lambda (methods args)
- (letrec ((one-step
- (lambda (tail)
- (lambda ()
- (if (null? tail)
- (error "No applicable methods/next methods.")
- (apply (method-procedure (car tail))
- (cons (one-step (cdr tail)) args)))))))
- ((one-step methods)))))))
-
- (define applicable?
- (lambda (c arg)
- (memq c (class-cpl (class-of arg)))))
-
- (define more-specific?
- (lambda (c1 c2 arg)
- (memq c2 (memq c1 (class-cpl (class-of arg))))))
-
- (add-method initialize
- (make-method (list <object>)
- (lambda (call-next-method object initargs) object)))
-
- (add-method initialize
- (make-method (list <class>)
- (lambda (call-next-method class initargs)
- (call-next-method)
- (slot-set! class
- 'direct-supers
- (getl initargs 'direct-supers '()))
- (slot-set! class
- 'direct-slots
- (map (lambda (s)
- (if (pair? s) s (list s)))
- (getl initargs 'direct-slots '())))
- (slot-set! class 'cpl (compute-cpl class))
- (slot-set! class 'slots (compute-slots class))
- (let* ((nfields 0)
- (field-initializers '())
- (allocator
- (lambda (init)
- (let ((f nfields))
- (set! nfields (+ nfields 1))
- (set! field-initializers
- (cons init field-initializers))
- (list (lambda (o) (%instance-ref o f))
- (lambda (o n) (%instance-set! o f n))))))
- (getters-n-setters
- (map (lambda (slot)
- (cons (car slot)
- (compute-getter-and-setter class
- slot
- allocator)))
- (slot-ref class 'slots))))
- (slot-set! class 'nfields nfields)
- (slot-set! class 'field-initializers field-initializers)
- (slot-set! class 'getters-n-setters getters-n-setters)))))
-
- (add-method initialize
- (make-method (list <generic>)
- (lambda (call-next-method generic initargs)
- (call-next-method)
- (slot-set! generic 'methods '())
- (%set-instance-proc! generic
- (lambda args (error "Has no methods."))))))
-
- (add-method initialize
- (make-method (list <method>)
- (lambda (call-next-method method initargs)
- (call-next-method)
- (slot-set! method 'specializers (getl initargs 'specializers))
- (slot-set! method 'procedure (getl initargs 'procedure)))))
-
- (add-method allocate-instance
- (make-method (list <class>)
- (lambda (call-next-method class)
- (let* ((field-initializers (slot-ref class 'field-initializers))
- (new (%allocate-instance
- class
- (length field-initializers))))
- (let loop ((n 0)
- (inits field-initializers))
- (if (pair? inits)
- (begin
- (%instance-set! new n ((car inits)))
- (loop (+ n 1)
- (cdr inits)))
- new))))))
-
- (add-method allocate-instance
- (make-method (list <entity-class>)
- (lambda (call-next-method class)
- (let* ((field-initializers (slot-ref class 'field-initializers))
- (new (%allocate-entity
- class
- (length field-initializers))))
- (let loop ((n 0)
- (inits field-initializers))
- (if (pair? inits)
- (begin
- (%instance-set! new n ((car inits)))
- (loop (+ n 1)
- (cdr inits)))
- new))))))
-
- (add-method compute-cpl
- (make-method (list <class>)
- (lambda (call-next-method class)
- (compute-std-cpl class class-direct-supers))))
-
- (add-method compute-slots
- (make-method (list <class>)
- (lambda (call-next-method class)
- (let collect ((to-process (apply append
- (map class-direct-slots
- (class-cpl class))))
- (result '()))
- (if (null? to-process)
- (reverse result)
- (let* ((current (car to-process))
- (name (car current))
- (others '())
- (remaining-to-process
- (collect-if (lambda (o)
- (if (eq? (car o) name)
- (begin
- (set! others (cons o others))
- #f)
- #t))
- (cdr to-process))))
- (collect remaining-to-process
- (cons (append current
- (apply append (map cdr others)))
- result))))))))
-
- (add-method compute-getter-and-setter
- (make-method (list <class>)
- (lambda (call-next-method class slot allocator)
- (allocator (lambda () '())))))
- ;
- ; Now everything works, both generic functions and classes, so we can
- ; turn on the real MAKE.
- ;
- ;
-
- (set! make
- (lambda (class . initargs)
- (let ((instance (allocate-instance class)))
- (initialize instance initargs)
- instance)))
-
- ;
- ; Now define what CLOS calls `built in' classes.
- ;
- ;
- (define <primitive-class>
- (make <class>
- 'direct-supers (list <class>)
- 'direct-slots (list)))
-
- (define make-primitive-class
- (lambda class
- (make (if (null? class) <primitive-class> (car class))
- 'direct-supers (list <top>)
- 'direct-slots (list))))
-
- (define <pair> (make-primitive-class))
- (define <null> (make-primitive-class))
- (define <symbol> (make-primitive-class))
- (define <boolean> (make-primitive-class))
- (define <procedure> (make-primitive-class <procedure-class>))
- (define <number> (make-primitive-class))
- (define <vector> (make-primitive-class))
- (define <char> (make-primitive-class))
- (define <string> (make-primitive-class))
- (define <input-port> (make-primitive-class))
- (define <output-port> (make-primitive-class))
-
- ; This is a useful sort of helper function. Note how it uses the
- ; introspective part of the MOP. The first few pages of chapter
- ; two of the AMOP discuss this.
- ;
- ; Note that this introspective MOP doesn't support back-links from
- ; the classes to methods and generic functions. Is that worth adding?
- ;
- ;
- (define initialize-slots
- (lambda (object initargs)
- (let ((not-there (list 'shes-not-there)))
- (for-each (lambda (slot)
- (let ((name (car slot)))
- (let ((value (getl initargs name not-there)))
- (if (eq? value not-there)
- 'do-nothing
- (slot-set! object name value)))))
- (class-slots (class-of object))))))
-
- ;***
- ;
- ; A simple class, just an instance of <class>. Note that we are using
- ; make and <class> rather than make-class to make it. See Section 2.4
- ; of AMOP for more on this.
- ;
- ;
-
- (define <pos> (make <class> ;[make-class
- 'direct-supers (list <object>) ; (list <object>)
- 'direct-slots (list 'x 'y))) ; (list 'x 'y)]
-
- (add-method initialize
- (make-method (list <pos>)
- (lambda (call-next-method pos initargs)
- (call-next-method)
- (initialize-slots pos initargs))))
-
- (define p1 (make <pos> 'x 1 'y 2))
- (define p2 (make <pos> 'x 3 'y 5))
-
- ;***
- ;
- ; Another way of writing that class definition, that achieves better
- ; `encapsulation' by using slot names that are unique keys, rather
- ; than symbols.
- ;
- ;
-
- (define <pos> #f)
- (define pos-x (make-generic))
- (define pos-y (make-generic))
- (define move (make-generic))
-
- (let ((x (vector 'x))
- (y (vector 'y)))
-
- (set! <pos> (make <class>
- 'direct-supers (list <object>)
- 'direct-slots (list x y)))
-
- (add-method pos-x
- (make-method (list <pos>)
- (lambda (call-next-method pos) (slot-ref pos x))))
- (add-method pos-y
- (make-method (list <pos>)
- (lambda (call-next-method pos) (slot-ref pos y))))
-
- (add-method move
- (make-method (list <pos>)
- (lambda (call-next-method pos new-x new-y)
- (slot-set! pos x new-x)
- (slot-set! pos y new-y))))
-
- (add-method initialize
- (make-method (list <pos>)
- (lambda (call-next-method pos initargs)
- (move pos (getl initargs 'x 0) (getl initargs 'y 0)))))
- )
-
-
- (define p3 (make <pos> 'x 1 'y 2))
- (define p4 (make <pos> 'x 3 'y 5))
-
- ;***
- ;
- ; Class allocated slots.
- ;
- ; In Scheme, this extension isn't worth a whole lot, but what the hell.
- ;
- ;
-
- (define <class-slots-class>
- (make-class (list <class>)
- (list)))
-
- (add-method compute-getter-and-setter
- (make-method (list <class-slots-class>)
- (lambda (call-next-method class slot allocator)
- (if (null? (memq ':class-allocation slot))
- (call-next-method)
- (let ((cell '()))
- (list (lambda (o) cell)
- (lambda (o new) (set! cell new) new)))))))
-
- ;
- ; Here's a silly program that uses class allocated slots.
- ;
- ;
- (define <ship>
- (make <class-slots-class>
- 'direct-supers (list <object>)
- 'direct-slots (list 'name
- '(all-ships :class-allocation))))
-
- (add-method initialize
- (make-method (list <ship>)
- (lambda (call-next-method ship initargs)
- (call-next-method)
- (initialize-slots ship initargs)
- (slot-set! ship
- 'all-ships
- (cons ship (slot-ref ship 'all-ships))))))
-
- (define siblings (make-generic))
- (add-method siblings
- (make-method (list <ship>)
- (lambda (call-next-method ship)
- (remove ship (slot-ref ship 'all-ships)))))
-
- (define s1 (make <ship> 'name 's1))
- (define s2 (make <ship> 'name 's2))
- (define s3 (make <ship> 'name 's3))
-
- ) ;; end tiny-clos
-
-
-
-
-
+(if (not (eq? else #_else)) (set! else #_else)) ; loop sets else!
@@ -30868,30 +45792,32 @@ abs 1 2
(test (let () (set! pi 2)) 'error)
(test (let ((pi 2)) pi) 'error)
-(define-constant nan.0 (string->number "nan.0"))
-(if (not (nan? nan.0)) (format #t ";(string->number \"nan.0\") returned ~A~%" nan.0))
-(if (infinite? nan.0) (format #t ";nan.0 is infinite?~%"))
+;;; already a constant now (define-constant nan.0 (string->number "nan.0"))
+(test (constant? nan.0) #t)
+(if (not (nan? nan.0)) (format-logged #t ";(string->number \"nan.0\") returned ~A~%" nan.0))
+(if (infinite? nan.0) (format-logged #t ";nan.0 is infinite?~%"))
(define-constant +inf.0 (string->number "+inf.0"))
-(if (not (infinite? +inf.0)) (format #t ";(string->number \"+inf.0\") returned ~A~%" +inf.0))
-(if (nan? +inf.0) (format #t ";+inf.0 is NaN?~%"))
+(if (not (infinite? +inf.0)) (format-logged #t ";(string->number \"+inf.0\") returned ~A~%" +inf.0))
+(if (nan? +inf.0) (format-logged #t ";+inf.0 is NaN?~%"))
-(define-constant -inf.0 (string->number "-inf.0"))
-(if (not (infinite? -inf.0)) (format #t ";(string->number \"-inf.0\") returned ~A~%" -inf.0))
-(if (nan? -inf.0) (format #t ";-inf.0 is NaN?~%"))
+(test (constant? -inf.0) #t)
+;;; (define-constant -inf.0 (string->number "-inf.0"))
+(if (not (infinite? -inf.0)) (format-logged #t ";(string->number \"-inf.0\") returned ~A~%" -inf.0))
+(if (nan? -inf.0) (format-logged #t ";-inf.0 is NaN?~%"))
-(define-constant inf.0 +inf.0)
-(define-constant inf+infi (make-rectangular inf.0 inf.0))
-(define-constant nan+nani (make-rectangular nan.0 nan.0))
-(define-constant 0+infi (make-rectangular 0 inf.0))
-(define-constant 0+nani (make-rectangular 0 nan.0))
+;;; (define-constant inf.0 +inf.0)
+(define-constant inf+infi (complex inf.0 inf.0))
+(define-constant nan+nani (complex nan.0 nan.0))
+(define-constant 0+infi (complex 0 inf.0))
+(define-constant 0+nani (complex 0 nan.0))
(test (equal? +inf.0 inf.0) #t)
(test (equal? +inf.0 -inf.0) #f)
(test (equal? nan.0 inf.0) #f)
-(test (= nan.0 nan.0) #f) ; equal? is #t I guess because they are the same object, i.e. (eq? nan.0 nan.0) -> #t
+(test (= nan.0 nan.0) #f)
(test (equal? inf.0 nan.0) #f)
-(test (equal? nan.0 nan.0) (eqv? nan.0 nan.0)) ; these are confusing: (equal? 0/0 0/0) is a different case
+; (test (equal? nan.0 nan.0) (eqv? nan.0 nan.0)) ; these are confusing: (equal? 0/0 0/0) is a different case
@@ -30930,11 +45856,12 @@ abs 1 2
(test (number? 0+nani) #t)
(test (number? pi) #t)
(test (number? 0/0) #t)
+(test (number? 1/-4) 'error)
(for-each
(lambda (n)
(let ((nb (catch #t (lambda () (number? n)) (lambda args 'error))))
- (if (not nb) (format #t ";(number? ~A) -> #f?~%" n))))
+ (if (not nb) (format-logged #t ";(number? ~A) -> #f?~%" n))))
(list '1e311 '1e-311 '0e311 '2.1e40000))
(if with-bignums
@@ -30953,10 +45880,11 @@ abs 1 2
(for-each
(lambda (arg)
(if (op arg)
- (format #t ";(~A ~A) -> #t?~%" op arg)))
- (list "hi" '() (integer->char 65) #f #t '(1 2) _ht_ 'a-symbol (cons 1 2) (make-vector 3) abs #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>)))
- (list number? complex? real? rational? integer?)
- (list 'number? 'complex? 'real? 'rational? 'integer?))
+ (format-logged #t ";(~A ~A) -> #t?~%" op arg)))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>)))
+ (list number? complex? real? rational? integer? float?)
+ (list 'number? 'complex? 'real? 'rational? 'integer? float?))
;;; --------------------------------------------------------------------------------
@@ -30981,13 +45909,13 @@ abs 1 2
(test (complex? 3) #t )
(test (complex? +inf.0) #t)
(test (complex? -inf.0) #t)
-(test (complex? nan.0) #t)
+(test (complex? nan.0) #t) ; this should be #f
(test (complex? pi) #t)
(for-each
(lambda (arg)
(if (not (complex? arg))
- (format #t ";(complex? ~A) -> #f?~%" arg)))
+ (format-logged #t ";(complex? ~A) -> #f?~%" arg)))
(list 1 1.0 1.0+0.5i 1/2))
(if with-bignums
@@ -31020,8 +45948,10 @@ abs 1 2
(test (real? (* 0+i 0+i)) #t)
(test (real? (magnitude 1+i)) #t)
(test (real? (string->number "1+0i")) #t)
-(test (real? (make-rectangular 1 0)) #t)
-(test (real? (make-rectangular 0 0)) #t)
+(test (real? (complex 1 0)) #t)
+(test (real? (complex 0 0)) #t)
+(test (real? (complex 1 0.0)) #t)
+(test (real? (complex 0.0 -0.0)) #t)
(test (real? (make-polar 0 0)) #t)
(test (real? (make-polar 1 0)) #t)
(test (real? (angle 1+i)) #t)
@@ -31032,12 +45962,22 @@ abs 1 2
(test (real? (real-part (log 0))) #t)
(test (real? +inf.0) #t)
(test (real? -inf.0) #t)
-(test (real? nan.0) #t)
+(test (real? nan.0) #t) ; see below
(test (real? pi) #t)
(test (real? 0+i) #f)
(test (real? 1.0-0.1i) #f)
(test (real? (sqrt 2)) #t)
(test (real? 1+i) #f)
+(test (real? 1e9-0i) #t)
+(test (real? 0+0i) #t)
+(test (real? 1.0+0i) #t)
+(test (real? 1.0+0.0i) #t)
+(test (real? 1+0.0i) #t)
+(test (real? 1-0.0i) #t)
+(test (real? 1+0i) #t)
+(test (real? -0+1e22i) #f)
+(test (real? -0+1e-22i) #f)
+(test (real? 0+1e-322i) #f)
(test (real? 1+0/0i) #f) ; bignum direct 1+0/0i -> 1.0
(test (real? 1.0000000000000000000000000000+0.0000000000000000000000000000i) #t)
(test (real? 1.0+0.0000000000000000000000000000i) #t)
@@ -31052,19 +45992,38 @@ abs 1 2
(test (real? 1.110223024625156799999999999999999999997E-16) #t)
(test (real? 9223372036854775807) #t)
-(if with-bignums
- (begin
- (test (real? 9.92209574402351949043519108941671096176E-1726-4.788930572030484370393069119625570107346E-1726i) #f)
- (test (real? 1234567891234567890/1234567) #t)
- (test (real? 9223372036854775808) #t)
- (test (real? 9223372036854775808.1) #t)
- (test (real? 9223372036854775808.1+1.5i) #f)
- (test (real? 9223372036854775808/3) #t)
- ))
+(when with-bignums
+ (test (real? 9.92209574402351949043519108941671096176E-1726-4.788930572030484370393069119625570107346E-1726i) #f)
+ (test (real? 1234567891234567890/1234567) #t)
+ (test (real? 9223372036854775808) #t)
+ (test (real? 9223372036854775808.1) #t)
+ (test (real? 9223372036854775808.1+1.5i) #f)
+ (test (real? 9223372036854775808/3) #t))
+(test (real? case) #f)
(test (real?) 'error)
(test (real? 1 2) 'error)
+(test (real? (real-part (log 0.0))) #t) ; -inf
+(test (real? (/ (real-part (log 0.0)) (real-part (log 0.0)))) #t) ; nan -- I think this should be #f
+(test (real? (real-part (log 0))) #t)
+
+
+;;; float?
+
+(test (float? 1) #f)
+(test (float? 1/2) #f)
+(test (float? 1.4) #t)
+(test (float? 1+i) #f)
+(test (float?) 'error)
+(test (float? 1.0 1.0) 'error)
+(test (float? #\a) #f)
+(test (float? (real-part (log 0.0))) #t)
+(test (float? 1/0) #t)
+(when (not with-bignums)
+ (test (float? pi) #t)
+ (test (float? 1e-308) #t))
+
;;; --------------------------------------------------------------------------------
@@ -31081,6 +46040,9 @@ abs 1 2
(test (rational? 0/0) #f) ; I like this
(test (rational? 1/0) #f)
(test (rational? (/ 1 2)) #t)
+(test (rational? (/ 1 2/3)) #t)
+(test (rational? (/ 2/5 2/3)) #t)
+(test (rational? (/ 2/5 -3)) #t)
(test (rational? (/ -4 4)) #t)
(test (rational? (/ 1.0 2)) #f)
(test (rational? 1/2+i) #f)
@@ -31091,9 +46053,11 @@ abs 1 2
(test (rational? 9223372036854775807) #t)
(test (rational? +inf.0) #f)
(test (rational? -inf.0) #f)
-(test (rational? nan.0) #f)
+(test (rational? nan.0) #f) ; guile says #t!
(test (rational? pi) #f)
(test (rational? 9223372036854775806/9223372036854775807) #t)
+(test (rational? 1+0i) #f) ; ??
+(test (rational? 1+0.0i) #f) ; ?? see integer?
(if with-bignums
(begin
@@ -31113,6 +46077,7 @@ abs 1 2
;;; integer?
;;; --------------------------------------------------------------------------------
+(test (integer? 0.0) #f)
(test (integer? 3) #t)
(test (integer? 1/2) #f)
(test (integer? 1/1) #t)
@@ -31122,7 +46087,7 @@ abs 1 2
(test (integer? 1+i) #f)
(test (integer? most-negative-fixnum) #t)
(test (integer? 250076005727/500083) #t)
-(test (integer? 1+0i) #f) ; hmmm
+(test (integer? 1+0i) #f) ; hmmm -- guile says #t, but it thinks 1.0 is an integer
(test (integer? 0/0) #f)
(test (integer? 1/0) #f)
(test (integer? #e.1e010) #t)
@@ -31144,6 +46109,7 @@ abs 1 2
(test (integer? nan.0) #f)
(test (integer? pi) #f)
(test (integer? 9223372036854775806/9223372036854775807) #f)
+(test (integer? 1+0.0i) #f)
(if with-bignums
(begin
@@ -31153,6 +46119,7 @@ abs 1 2
(test (integer? 9223372036854775808.1+1.5i) #f)
(test (integer? 9223372036854775808/3) #f)
(test (integer? 9223372036854775808/9223372036854775808) #t)
+ (test (integer? 21345678912345678912345678913456789123456789123456789) #t)
))
(test (integer?) 'error)
@@ -31166,8 +46133,8 @@ abs 1 2
;;; (define (infinite? x) (and (number? x) (or (= x inf.0) (= x -inf.0)))) but this misses complex cases
;;;
;;; a number can be both NaN and infinite...:
-(test (nan? (make-rectangular 0/0 (real-part (log 0)))) #t)
-(test (infinite? (make-rectangular 0/0 (real-part (log 0)))) #t)
+(test (nan? (complex 0/0 (real-part (log 0)))) #t)
+(test (infinite? (complex 0/0 (real-part (log 0)))) #t)
;;; maybe we should restrict nan? and infinite? to reals?
(test (infinite? 0) #f)
@@ -31180,8 +46147,8 @@ abs 1 2
(test (infinite? nan.0) #f)
(test (infinite? pi) #f)
(test (infinite? (imag-part (sinh (log 0.0)))) #t)
-(test (infinite? (make-rectangular -inf.0 inf.0)) #t)
-(test (infinite? (+ (make-rectangular 1 inf.0))) #t)
+(test (infinite? (complex -inf.0 inf.0)) #t)
+(test (infinite? (+ (complex 1 inf.0))) #t)
(test (infinite? most-negative-fixnum) #f)
(test (infinite? -1.797693134862315699999999999999999999998E308) #f)
(test (infinite? -2.225073858507201399999999999999999999996E-308) #f)
@@ -31190,15 +46157,15 @@ abs 1 2
(test (infinite? (imag-part inf+infi)) #t)
(test (infinite? (imag-part 0+infi)) #t)
-(test (infinite? (imag-part (make-rectangular 0.0 (real-part (log 0))))) #t)
-(test (infinite? (real-part (make-rectangular 0.0 (real-part (log 0))))) #f)
-(test (infinite? (make-rectangular 0.0 (real-part (log 0)))) #t)
-(test (infinite? (real-part (make-rectangular (real-part (log 0)) 1.0))) #t)
-(test (infinite? (imag-part (make-rectangular (real-part (log 0)) 1.0))) #f)
-(test (infinite? (make-rectangular (real-part (log 0)) 1.0)) #t)
-(test (infinite? (imag-part (make-rectangular (real-part (log 0)) (real-part (log 0))))) #t)
-(test (infinite? (real-part (make-rectangular (real-part (log 0)) (real-part (log 0))))) #t)
-(test (infinite? (make-rectangular (real-part (log 0)) (real-part (log 0)))) #t)
+(test (infinite? (imag-part (complex 0.0 (real-part (log 0))))) #t)
+(test (infinite? (real-part (complex 0.0 (real-part (log 0))))) #f)
+(test (infinite? (complex 0.0 (real-part (log 0)))) #t)
+(test (infinite? (real-part (complex (real-part (log 0)) 1.0))) #t)
+(test (infinite? (imag-part (complex (real-part (log 0)) 1.0))) #f)
+(test (infinite? (complex (real-part (log 0)) 1.0)) #t)
+(test (infinite? (imag-part (complex (real-part (log 0)) (real-part (log 0))))) #t)
+(test (infinite? (real-part (complex (real-part (log 0)) (real-part (log 0))))) #t)
+(test (infinite? (complex (real-part (log 0)) (real-part (log 0)))) #t)
;; if mpc version > 0.8.2
;; (test (infinite? (sin 1+1e10i)) #t)
@@ -31296,7 +46263,7 @@ abs 1 2
(let ((num (string->number (substring str 0 j))))
(if (or (nan? num)
(infinite? num))
- (format #t "~A: ~S -> ~A~%" (if (infinite? num) 'inf 'nan) str num)))
+ (format-logged #t "~A: ~S -> ~A~%" (if (infinite? num) 'inf 'nan) str num)))
)))
|#
@@ -31315,7 +46282,7 @@ abs 1 2
(test (>= nan.0 inf.0) #f)
(test (>= nan.0 nan.0) #f)
(test (floor inf.0) 'error)
- (test (inexact->exact (make-rectangular 1 inf.0)) 'error)
+ (test (inexact->exact (complex 1 inf.0)) 'error)
(test (nan? (expt 0 nan.0)) #t)
(test (nan? (expt 1 nan.0)) #t)
(test (nan? (expt nan.0 inf.0)) #t)
@@ -31380,9 +46347,9 @@ abs 1 2
(test (= (log inf.0) inf.0) #t)
(test (= (magnitude -inf.0) inf.0) #t)
(test (= (magnitude inf.0) inf.0) #t)
-(test (= (make-polar inf.0 0) inf.0) #t)
-(test (= (make-rectangular 0 inf.0) (sqrt -inf.0)) #t) ; (sqrt -inf.0) -> 0+infi !
-(test (= (make-rectangular inf.0 0) inf.0) #t)
+(if (not (provided? 'pure-s7)) (test (= (make-polar inf.0 0) inf.0) #t))
+(test (= (complex 0 inf.0) (sqrt -inf.0)) #t) ; (sqrt -inf.0) -> 0+infi !
+(test (= (complex inf.0 0) inf.0) #t)
(test (= (max -inf.0 inf.0) inf.0) #t)
(test (= (min -inf.0 inf.0) -inf.0) #t)
(test (= (sqrt inf.0) inf.0) #t)
@@ -31424,7 +46391,7 @@ abs 1 2
(test (complex? nan+nani) #t)
(test (cosh inf.0) inf.0)
(test (even? inf.0) 'error)
-(test (exact? (make-rectangular 1 inf.0)) #f)
+(test (exact? (complex 1 inf.0)) #f)
(test (exp inf.0) inf.0)
(test (expt nan.0) 'error)
(test (floor inf.0) 'error)
@@ -31432,9 +46399,9 @@ abs 1 2
(test (gcd -inf.0 inf.0) 'error)
(test (gcd nan.0 inf.0) 'error)
(test (gcd nan.0 nan.0) 'error)
-(test (imag-part (make-rectangular 1 inf.0)) inf.0)
+(test (imag-part (complex 1 inf.0)) inf.0)
(test (imag-part nan.0) 0.0)
-(test (inexact? (make-rectangular 1 inf.0)) #t)
+(test (inexact? (complex 1 inf.0)) #t)
(test (infinite? 1 2) 'error)
(test (infinite?) 'error)
(test (lcm -inf.0 inf.0) 'error)
@@ -31449,15 +46416,17 @@ abs 1 2
(test (logior -inf.0 inf.0) 'error)
(test (logior nan.0 inf.0) 'error)
(test (logior nan.0 nan.0) 'error)
-(test (lognot -inf.0 inf.0) 'error)
-(test (lognot nan.0 inf.0) 'error)
-(test (lognot nan.0 nan.0) 'error)
+(test (lognot -inf.0) 'error)
+(test (lognot nan.0) 'error)
+(test (logbit? -inf.0 inf.0) 'error)
+(test (logbit? nan.0 inf.0) 'error)
+(test (logbit? nan.0 nan.0) 'error)
(test (logxor -inf.0 inf.0) 'error)
(test (logxor nan.0 inf.0) 'error)
(test (logxor nan.0 nan.0) 'error)
(test (magnitude inf.0) inf.0)
-(test (make-random-state inf.0) 'error)
-(test (make-random-state nan.0) 'error)
+(test (random-state inf.0) 'error)
+(test (random-state nan.0) 'error)
(test (max -inf.0 inf.0) inf.0)
(test (max 0 inf.0 -inf.0) inf.0)
(test (max 0 inf.0) inf.0)
@@ -31476,7 +46445,7 @@ abs 1 2
(test (nan? (/ -1 nan.0 -inf.0)) #t)
(test (nan? (/ -inf.0 -inf.0)) #t)
(test (nan? (/ 0 nan.0)) #t)
-(test (nan? (/ 0 (log 0))) #t)
+;(test (nan? (/ 0 (log 0))) #t) ;why not just 0.0?
(test (nan? (/ inf.0 -inf.0)) #t)
(test (nan? (/ inf.0 inf.0)) #t)
(test (nan? (/ inf.0 nan.0)) #t)
@@ -31489,7 +46458,7 @@ abs 1 2
;(test (nan? (asin inf.0)) #t)
(test (nan? (asin nan.0)) #t)
(test (nan? (exp nan.0)) #t)
-(test (nan? (imag-part (make-rectangular 0 nan.0))) #t)
+(test (nan? (imag-part (complex 0 nan.0))) #t)
(test (nan? (imag-part nan+nani)) #t)
(test (nan? (imag-part nan+nani)) #t)
(test (nan? (log 8.0 nan.0)) #t)
@@ -31498,7 +46467,7 @@ abs 1 2
(test (nan? (magnitude nan.0)) #t)
(test (nan? (make-polar -inf.0 inf.0)) #t)
(test (nan? (make-polar nan.0 0)) #t)
-(test (nan? (make-rectangular nan.0 0)) #t)
+(test (nan? (complex nan.0 0)) #t)
(test (nan? (max 0 inf.0 nan.0)) #t)
(test (nan? (max 1 nan.0)) #t)
(test (nan? (min 0 inf.0 nan.0)) #t)
@@ -31511,7 +46480,7 @@ abs 1 2
(test (nan? (real-part (exp nan+nani))) #t)
(test (nan? (real-part (log nan+nani))) #t)
(test (nan? (real-part (log nan.0))) #t)
-(test (nan? (real-part (make-rectangular -inf.0 0))) #f)
+(test (nan? (real-part (complex -inf.0 0))) #f)
(test (nan? (real-part (sqrt nan.0))) #t)
(test (nan? (real-part nan+nani)) #t)
(test (nan? (sin -inf.0)) #t)
@@ -31539,7 +46508,7 @@ abs 1 2
(test (rationalize nan.0 nan.0) 'error)
(test (rationalize nan.0) 'error)
(test (rationalize nan.0) 'error)
-(test (real-part (make-rectangular 1 inf.0)) 1.0)
+(test (real-part (complex 1 inf.0)) 1.0)
(test (real? nan+nani) #f)
(test (remainder 1 nan.0) 'error)
(test (remainder nan.0 1) 'error)
@@ -31550,8 +46519,8 @@ abs 1 2
(test (tanh inf.0) 1.0)
(test (truncate inf.0) 'error)
(test (truncate nan.0) 'error)
-(test (zero? (make-rectangular 1 inf.0)) #f)
-(test (zero? (real-part (make-rectangular 0 -inf.0))) #t)
+(test (zero? (complex 1 inf.0)) #f)
+(test (zero? (real-part (complex 0 -inf.0))) #t)
(test (zero? 0/0) #f)
(test (zero? inf.0) #f)
(test (zero? nan.0) #f)
@@ -31567,8 +46536,8 @@ abs 1 2
;;(test (= (expt nan.0 0) 1.0) #t) ;hmmm
;;(test (= (expt nan.0 nan.0) 0) #t)
;;(test (>= 0 inf.0 -inf.0) #t)
-;;(test (angle (make-rectangular 1 inf.0)) 1.5707963267949)
-;;(test (atanh (make-rectangular 1 inf.0)) -0+1.5707963267949i)
+;;(test (angle (complex 1 inf.0)) 1.5707963267949)
+;;(test (atanh (complex 1 inf.0)) -0+1.5707963267949i)
;;(test (nan? (atan -inf.0 inf.0)) #t) ; ??
;;(test (nan? (expt 0 inf.0)) #t)
;;(test (nan? (quotient -inf.0 inf.0)) #t)
@@ -31576,14 +46545,14 @@ abs 1 2
;;(test (nan? (quotient nan.0 1)) #t)
;;(test (nan? (quotient nan.0 inf.0)) #t)
;;(test (nan? (quotient nan.0 nan.0)) #t)
-;;(test (tan (make-rectangular 1 inf.0)) 0+1i)
+;;(test (tan (complex 1 inf.0)) 0+1i)
;;(log nan.0 0) (log 0 inf.0) (log 0 -inf.0)
(for-each
(lambda (x)
- (test (infinite? x) #f)
- (test (nan? x) #f))
- (list #\a "hi" #f #(1 2) '() '(1 . 2) _ht_ 'hi abs #<eof> #<unspecified>))
+ (test (infinite? x) 'error)
+ (test (nan? x) 'error))
+ (list #\a "hi" #f #(1 2) () '(1 . 2) _ht_ _null_ _c_obj_ 'hi abs #<eof> #<unspecified>))
(for-each
(lambda (n)
@@ -31610,7 +46579,7 @@ abs 1 2
(lambda (op)
(test (number? (op inf.0 inf.0)) #t)
(test (number? (op nan.0 -inf.0)) #t))
- (list + - * / expt make-rectangular make-polar))
+ (list + - * / expt complex make-polar))
(for-each
(lambda (op)
@@ -31630,20 +46599,21 @@ abs 1 2
(test (op inf.0) 'error)
(test (op nan.0) 'error))
(list even? odd? numerator denominator lcm gcd inexact->exact
- logior logxor logand lognot ash integer-length))
+ logior logxor logand lognot logbit? ash integer-length))
(let ((d1 1e-312)
(d2 1e-316)
(d3 1e-320))
(if (not (zero? d3))
(begin
- (test (= d1 d2 d3) #f)
+ (when (not with-bignums)
+ (test (= d1 d2 d3) #f)
+ (test (not (= d2 (* 2 d1))) #t))
(test (< d1 d2 d3) #f)
(test (> d1 d2 d3) #t)
(test (rationalize d1) 0)
(test (rationalize d3) 0)
(test (rationalize (- d1)) 0)
- (test (not (= d2 (* 2 d1))) #t)
(num-test (string->number (number->string d1)) d1)
(test (< (sin d3) (sin d2) (sin d1)) #t)
@@ -31680,6 +46650,14 @@ abs 1 2
(test (zero? 1e-20) #f)
(test (zero? -1.797693134862315699999999999999999999998E308) #f)
(test (zero? -2.225073858507201399999999999999999999996E-308) #f)
+(test (zero? 2.2250738585072012e-308) #f) ; gauche says one of these can hang
+(test (zero? 2.2250738585072013e-308) #f)
+(test (zero? 2.2250738585072014e-308) #f)
+(test (zero? 2.2250738585072015e-308) #f)
+(test (zero? 2.2250738585072011e-308) #f)
+(test (zero? 2.2250738585072010e-308) #f)
+(test (zero? 2.2250738585072010e-309) #f)
+(test (zero? 2.2250738585072010e-310) #f)
(test (zero? -9223372036854775808) #f)
(test (zero? 1.110223024625156799999999999999999999997E-16) #f)
(test (zero? 9223372036854775807) #f)
@@ -31715,6 +46693,15 @@ abs 1 2
(test (zero?) 'error)
(test (zero? 1 2) 'error)
+(test (zero? 0. at 2211) #t)
+(test (zero? 0 at 0) #t) ; ?? (expt 0 0) -> 1 but 0 at 0 -> 0.0 because (expt 0.0 0) -> 0.0?
+
+(for-each
+ (lambda (arg)
+ (test (zero? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -31741,23 +46728,23 @@ abs 1 2
(test (positive? +inf.0) #t)
(test (positive? -inf.0) #f)
(test (positive? nan.0) #f)
-(test (positive? 1000000000000000000000000000000000) #t)
-(test (positive? -1000000000000000000000000000000000) #f)
(for-each
(lambda (n)
(if (not (positive? n))
- (format #t ";(positive? ~A) -> #f?~%") n))
+ (format-logged #t ";(positive? ~A) -> #f?~%") n))
(list 1 123 123456123 1.4 0.001 1/2 124124124.2))
(for-each
(lambda (n)
(if (positive? n)
- (format #t ";(positive? ~A) -> #t?~%" n)))
+ (format-logged #t ";(positive? ~A) -> #t?~%" n)))
(list -1 -123 -123456123 -3/2 -0.00001 -1.4 -123124124.1))
(if with-bignums
(begin
+ (test (positive? 1000000000000000000000000000000000) #t)
+ (test (positive? -1000000000000000000000000000000000) #f)
(test (positive? 9.92209574402351949043519108941671096176E-1726) #t)
(test (positive? 12345678901234567890) #t)
(test (positive? -12345678901234567890) #f)
@@ -31773,6 +46760,12 @@ abs 1 2
(test (positive?) 'error)
(test (positive? 1 2) 'error)
+(for-each
+ (lambda (arg)
+ (test (positive? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
;;; --------------------------------------------------------------------------------
@@ -31788,6 +46781,7 @@ abs 1 2
(test (negative? -0) #f )
(test (negative? 0.0) #f )
(test (negative? -0.0) #f )
+(test (negative? (- 0.0)) #f )
(test (negative? (expt -0.0 1)) #f)
(test (negative? (/ -0.0 1.0)) #f)
(test (negative? (* -0.0 1.0)) #f)
@@ -31803,21 +46797,22 @@ abs 1 2
(test (negative? +inf.0) #f)
(test (negative? -inf.0) #t)
(test (negative? nan.0) #f)
-(test (negative? 1000000000000000000000000000000000) #f)
-(test (negative? -1000000000000000000000000000000000) #t)
(test (negative? most-negative-fixnum) #t)
(test (negative? most-positive-fixnum) #f)
+;; (negative? -1/0): #f? (positive? 1/0) is also #f, but (negative? -nan.0): #f (guile agrees) -- so what's the point of -nan.0??
+;; chibi says (negative? -nan.0) #t, but (positive? +nan.0) #f??
+
(for-each
(lambda (n)
(if (negative? n)
- (format #t ";(negative? ~A) -> #t?~%" n)))
+ (format-logged #t ";(negative? ~A) -> #t?~%" n)))
(list 1 123 123456123 1.4 0.001 1/2 12341243124.2))
(for-each
(lambda (n)
(if (not (negative? n))
- (format #t ";(negative? ~A) -> #f?~%" n)))
+ (format-logged #t ";(negative? ~A) -> #f?~%" n)))
(list -1 -123 -123456123 -2/3 -0.00001 -1.4 -123124124.1))
(let ((val1 (catch #t (lambda () (negative? 0.0)) (lambda args 'error)))
@@ -31826,6 +46821,8 @@ abs 1 2
(if with-bignums
(begin
+ (test (negative? 1000000000000000000000000000000000) #f)
+ (test (negative? -1000000000000000000000000000000000) #t)
(test (negative? -9.92209574402351949043519108941671096176E-1726) #t)
(test (negative? 12345678901234567890) #f)
(test (negative? -12345678901234567890) #t)
@@ -31841,6 +46838,13 @@ abs 1 2
(test (negative?) 'error)
(test (negative? 1 2) 'error)
+(for-each
+ (lambda (arg)
+ (test (negative? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
;;; --------------------------------------------------------------------------------
@@ -31867,13 +46871,13 @@ abs 1 2
(for-each
(lambda (n)
(if (odd? n)
- (format #t ";(odd? ~A) -> #t?~%" n)))
+ (format-logged #t ";(odd? ~A) -> #t?~%" n)))
(list 0 2 1234 -4 -10000002 1000000006))
(for-each
(lambda (n)
(if (not (odd? n))
- (format #t ";(odd? ~A) -> #f?~%" n)))
+ (format-logged #t ";(odd? ~A) -> #f?~%" n)))
(list 1 -1 31 50001 543321))
(if with-bignums
@@ -31901,6 +46905,12 @@ abs 1 2
(test (odd? nan.0) 'error)
(test (odd? 1/2) 'error)
+(for-each
+ (lambda (arg)
+ (test (odd? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
;;; --------------------------------------------------------------------------------
@@ -31926,13 +46936,13 @@ abs 1 2
(for-each
(lambda (n)
(if (not (even? n))
- (format #t ";(even? ~A) -> #f?~%" n)))
+ (format-logged #t ";(even? ~A) -> #f?~%" n)))
(list 0 2 1234 -4 -10000002 1000000006))
(for-each
(lambda (n)
(if (even? n)
- (format #t ";(even? ~A) -> #t?~%" n)))
+ (format-logged #t ";(even? ~A) -> #t?~%" n)))
(list 1 -1 31 50001 543321))
(let ((top-exp 60))
@@ -31980,6 +46990,13 @@ abs 1 2
(test (even? nan.0) 'error)
(test (even? 1/2) 'error)
+(for-each
+ (lambda (arg)
+ (test (even? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
;;; --------------------------------------------------------------------------------
@@ -32007,6 +47024,9 @@ abs 1 2
(test (exact? +inf.0) #f)
(test (exact? -inf.0) #f)
(test (exact? nan.0) #f)
+(test (exact? (imag-part 1+0i)) #f)
+(test (exact? (imag-part 1+0.0i)) #f)
+(test (exact? (imag-part 1+1i)) #f)
(if with-bignums
(begin
@@ -32021,6 +47041,12 @@ abs 1 2
(test (exact? "hi") 'error)
(test (exact? 1.0+23.0i 1.0+23.0i) 'error)
+(for-each
+ (lambda (arg)
+ (test (exact? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
;;; --------------------------------------------------------------------------------
@@ -32055,6 +47081,13 @@ abs 1 2
(test (inexact? 1.0+23.0i 1.0+23.0i) 'error)
(test (inexact?) 'error)
+(for-each
+ (lambda (arg)
+ (test (inexact? arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
;;; --------------------------------------------------------------------------------
@@ -32113,6 +47146,15 @@ abs 1 2
(test (exact->inexact 1.0+23.0i 1.0+23.0i) 'error)
(test (exact->inexact) 'error)
+(for-each
+ (lambda (arg)
+ (test (exact->inexact arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(test (integer? (* 0 1.0)) #f) ; s7.html check -- we want 0.0 here, not 0 [for exact->inexact replacement code]
+(test (rational? (* 1.0 0)) #f)
+
;;; --------------------------------------------------------------------------------
@@ -32170,6 +47212,13 @@ abs 1 2
(test (inexact->exact 1.0+23.0i 1.0+23.0i) 'error)
(test (inexact->exact) 'error)
+(for-each
+ (lambda (arg)
+ (test (inexact->exact arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
;;; --------------------------------------------------------------------------------
@@ -32270,7 +47319,7 @@ abs 1 2
(num-test (numerator (/ 9223372036854775808 -9223372036854775807)) -9223372036854775808)
(num-test (numerator 1234567891234567890/1234567) 1234567891234567890)
(num-test (numerator 9223372036854775808/9223372036854775807) 9223372036854775808)
- (test (numerator? 0+92233720368547758081.0i) 'error)
+ (test (numerator 0+92233720368547758081.0i) 'error)
))
(test (numerator 0.0) 'error) ; guile thinks this is ok
@@ -32283,6 +47332,12 @@ abs 1 2
(test (numerator 1+i) 'error)
(test (numerator 2.3+0.5i) 'error)
+(for-each
+ (lambda (arg)
+ (test (numerator arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -32324,6 +47379,7 @@ abs 1 2
(num-test (denominator -500029/1234000000) 1234000000)
(num-test (denominator -500029/2) 2)
(num-test (denominator -500029/362880) 362880)
+(num-test (denominator 0) 1)
(num-test (denominator 0/1) 1)
(num-test (denominator 0/10) 1)
(num-test (denominator 0/1234) 1)
@@ -32383,7 +47439,7 @@ abs 1 2
(num-test (denominator (/ 9223372036854775808 -9223372036854775807)) 9223372036854775807)
(num-test (denominator 1234567891234567890/1234567) 1234567)
(num-test (denominator 9223372036854775808/9223372036854775807) 9223372036854775807)
- (test (denominator? 0+92233720368547758081.0i) 'error)
+ (test (denominator 0+92233720368547758081.0i) 'error)
))
(test (denominator 0.0) 'error)
@@ -32396,6 +47452,12 @@ abs 1 2
(test (denominator 1+i) 'error)
(test (denominator 2.3+0.5i) 'error)
+(for-each
+ (lambda (arg)
+ (test (denominator arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -32481,6 +47543,12 @@ abs 1 2
(test (real-part 1.0+23.0i 1.0+23.0i) 'error)
(test (real-part) 'error)
+(for-each
+ (lambda (arg)
+ (test (real-part arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -32550,9 +47618,12 @@ abs 1 2
(num-test (imag-part -9223372036854775808) 0)
(num-test (imag-part 1.110223024625156799999999999999999999997E-16) 0.0)
(num-test (imag-part 9223372036854775807) 0)
-(test (imag-part inf.0) 0.0)
-(num-test (imag-part (+ 2 0+1/0i)) inf.0)
+(if (not with-bignums) (test (nan? (imag-part (+ 2 0+1/0i))) #t))
(num-test (imag-part 0/0+0i) 0.0)
+(num-test (imag-part 1/0) 0.0)
+;(num-test (imag-part (log 1/0)) pi) ; hmmm -- I could imagine other choices here and below
+;(num-test (imag-part (sqrt 1/0)) 0.0)
+;(test (nan? (imag-part (sqrt (log 1/0)))) #t)
(if with-bignums
(begin
@@ -32567,496 +47638,525 @@ abs 1 2
(test (imag-part 1.0+23.0i 1.0+23.0i) 'error)
(test (imag-part) 'error)
+(for-each
+ (lambda (arg)
+ (test (imag-part arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; complex
;;; --------------------------------------------------------------------------------
-;;; make-rectangular
-;;; --------------------------------------------------------------------------------
-
-(num-test (make-rectangular -0 -1) -0.0-1.0i)
-(num-test (make-rectangular -0 -10) -0.0-10.0i)
-(num-test (make-rectangular -0 -1234) -0.0-1234.0i)
-(num-test (make-rectangular -0 -1234000000) -0.0-1234000000.0i)
-(num-test (make-rectangular -0 -2) -0.0-2.0i)
-(num-test (make-rectangular -0 -3) -0.0-3.0i)
-(num-test (make-rectangular -0 -362880) -0.0-362880.0i)
-(num-test (make-rectangular -0 -500029) -0.0-500029.0i)
-(num-test (make-rectangular -0 1) -0.0+1.0i)
-(num-test (make-rectangular -0 10) -0.0+10.0i)
-(num-test (make-rectangular -0 1234) -0.0+1234.0i)
-(num-test (make-rectangular -0 1234000000) -0.0+1234000000.0i)
-(num-test (make-rectangular -0 2) -0.0+2.0i)
-(num-test (make-rectangular -0 3) -0.0+3.0i)
-(num-test (make-rectangular -0 362880) -0.0+362880.0i)
-(num-test (make-rectangular -0 500029) -0.0+500029.0i)
-(num-test (make-rectangular -0.0 -0.00000001) -0.0-0.00000001i)
-(num-test (make-rectangular -0.0 -1.0) -0.0-1.0i)
-(num-test (make-rectangular -0.0 -1234.0) -0.0-1234.0i)
-(num-test (make-rectangular -0.0 -1234000000.0) -0.0-1234000000.0i)
-(num-test (make-rectangular -0.0 -2.71828182845905) -0.0-2.71828182845905i)
-(num-test (make-rectangular -0.0 -3.14159265358979) -0.0-3.14159265358979i)
-(num-test (make-rectangular -0.0 0.00000001) -0.0+0.00000001i)
-(num-test (make-rectangular -0.0 1.0) -0.0+1.0i)
-(num-test (make-rectangular -0.0 1234.0) -0.0+1234.0i)
-(num-test (make-rectangular -0.0 1234000000.0) -0.0+1234000000.0i)
-(num-test (make-rectangular -0.0 2.71828182845905) -0.0+2.71828182845905i)
-(num-test (make-rectangular -0.0 pi) -0.0+3.14159265358979i)
-(num-test (make-rectangular -0.00000001 -0.00000001) -0.00000001-0.00000001i)
-(num-test (make-rectangular -0.00000001 -1.0) -0.00000001-1.0i)
-(num-test (make-rectangular -0.00000001 -1234.0) -0.00000001-1234.0i)
-(num-test (make-rectangular -0.00000001 -1234000000.0) -0.00000001-1234000000.0i)
-(num-test (make-rectangular -0.00000001 -2.71828182845905) -0.00000001-2.71828182845905i)
-(num-test (make-rectangular -0.00000001 -3.14159265358979) -0.00000001-3.14159265358979i)
-(num-test (make-rectangular -0.00000001 0.00000001) -0.00000001+0.00000001i)
-(num-test (make-rectangular -0.00000001 1.0) -0.00000001+1.0i)
-(num-test (make-rectangular -0.00000001 1234.0) -0.00000001+1234.0i)
-(num-test (make-rectangular -0.00000001 1234000000.0) -0.00000001+1234000000.0i)
-(num-test (make-rectangular -0.00000001 2.71828182845905) -0.00000001+2.71828182845905i)
-(num-test (make-rectangular -0.00000001 pi) -0.00000001+3.14159265358979i)
-(num-test (make-rectangular -1 -1) -1.0-1.0i)
-(num-test (make-rectangular -1 -10) -1.0-10.0i)
-(num-test (make-rectangular -1 -1234) -1.0-1234.0i)
-(num-test (make-rectangular -1 -1234000000) -1.0-1234000000.0i)
-(num-test (make-rectangular -1 -2) -1.0-2.0i)
-(num-test (make-rectangular -1 -3) -1.0-3.0i)
-(num-test (make-rectangular -1 -362880) -1.0-362880.0i)
-(num-test (make-rectangular -1 -500029) -1.0-500029.0i)
-(num-test (make-rectangular -1 1) -1.0+1.0i)
-(num-test (make-rectangular -1 10) -1.0+10.0i)
-(num-test (make-rectangular -1 1234) -1.0+1234.0i)
-(num-test (make-rectangular -1 1234000000) -1.0+1234000000.0i)
-(num-test (make-rectangular -1 2) -1.0+2.0i)
-(num-test (make-rectangular -1 3) -1.0+3.0i)
-(num-test (make-rectangular -1 362880) -1.0+362880.0i)
-(num-test (make-rectangular -1 500029) -1.0+500029.0i)
-(num-test (make-rectangular -1.0 -0.00000001) -1.0-0.00000001i)
-(num-test (make-rectangular -1.0 -1.0) -1.0-1.0i)
-(num-test (make-rectangular -1.0 -1234.0) -1.0-1234.0i)
-(num-test (make-rectangular -1.0 -1234000000.0) -1.0-1234000000.0i)
-(num-test (make-rectangular -1.0 -2.71828182845905) -1.0-2.71828182845905i)
-(num-test (make-rectangular -1.0 -3.14159265358979) -1.0-3.14159265358979i)
-(num-test (make-rectangular -1.0 0.00000001) -1.0+0.00000001i)
-(num-test (make-rectangular -1.0 1.0) -1.0+1.0i)
-(num-test (make-rectangular -1.0 1234.0) -1.0+1234.0i)
-(num-test (make-rectangular -1.0 1234000000.0) -1.0+1234000000.0i)
-(num-test (make-rectangular -1.0 2.71828182845905) -1.0+2.71828182845905i)
-(num-test (make-rectangular -1.0 pi) -1.0+3.14159265358979i)
-(num-test (make-rectangular -10 -1) -10.0-1.0i)
-(num-test (make-rectangular -10 -10) -10.0-10.0i)
-(num-test (make-rectangular -10 -1234) -10.0-1234.0i)
-(num-test (make-rectangular -10 -1234000000) -10.0-1234000000.0i)
-(num-test (make-rectangular -10 -2) -10.0-2.0i)
-(num-test (make-rectangular -10 -3) -10.0-3.0i)
-(num-test (make-rectangular -10 -362880) -10.0-362880.0i)
-(num-test (make-rectangular -10 -500029) -10.0-500029.0i)
-(num-test (make-rectangular -10 1) -10.0+1.0i)
-(num-test (make-rectangular -10 10) -10.0+10.0i)
-(num-test (make-rectangular -10 1234) -10.0+1234.0i)
-(num-test (make-rectangular -10 1234000000) -10.0+1234000000.0i)
-(num-test (make-rectangular -10 2) -10.0+2.0i)
-(num-test (make-rectangular -10 3) -10.0+3.0i)
-(num-test (make-rectangular -10 362880) -10.0+362880.0i)
-(num-test (make-rectangular -10 500029) -10.0+500029.0i)
-(num-test (make-rectangular -1234 -1) -1234.0-1.0i)
-(num-test (make-rectangular -1234 -10) -1234.0-10.0i)
-(num-test (make-rectangular -1234 -1234) -1234.0-1234.0i)
-(num-test (make-rectangular -1234 -1234000000) -1234.0-1234000000.0i)
-(num-test (make-rectangular -1234 -2) -1234.0-2.0i)
-(num-test (make-rectangular -1234 -3) -1234.0-3.0i)
-(num-test (make-rectangular -1234 -362880) -1234.0-362880.0i)
-(num-test (make-rectangular -1234 -500029) -1234.0-500029.0i)
-(num-test (make-rectangular -1234 1) -1234.0+1.0i)
-(num-test (make-rectangular -1234 10) -1234.0+10.0i)
-(num-test (make-rectangular -1234 1234) -1234.0+1234.0i)
-(num-test (make-rectangular -1234 1234000000) -1234.0+1234000000.0i)
-(num-test (make-rectangular -1234 2) -1234.0+2.0i)
-(num-test (make-rectangular -1234 3) -1234.0+3.0i)
-(num-test (make-rectangular -1234 362880) -1234.0+362880.0i)
-(num-test (make-rectangular -1234 500029) -1234.0+500029.0i)
-(num-test (make-rectangular -1234.0 -0.00000001) -1234.0-0.00000001i)
-(num-test (make-rectangular -1234.0 -1.0) -1234.0-1.0i)
-(num-test (make-rectangular -1234.0 -1234.0) -1234.0-1234.0i)
-(num-test (make-rectangular -1234.0 -1234000000.0) -1234.0-1234000000.0i)
-(num-test (make-rectangular -1234.0 -2.71828182845905) -1234.0-2.71828182845905i)
-(num-test (make-rectangular -1234.0 -3.14159265358979) -1234.0-3.14159265358979i)
-(num-test (make-rectangular -1234.0 0.00000001) -1234.0+0.00000001i)
-(num-test (make-rectangular -1234.0 1.0) -1234.0+1.0i)
-(num-test (make-rectangular -1234.0 1234.0) -1234.0+1234.0i)
-(num-test (make-rectangular -1234.0 1234000000.0) -1234.0+1234000000.0i)
-(num-test (make-rectangular -1234.0 2.71828182845905) -1234.0+2.71828182845905i)
-(num-test (make-rectangular -1234.0 pi) -1234.0+3.14159265358979i)
-(num-test (make-rectangular -1234000000 -1) -1234000000.0-1.0i)
-(num-test (make-rectangular -1234000000 -10) -1234000000.0-10.0i)
-(num-test (make-rectangular -1234000000 -1234) -1234000000.0-1234.0i)
-(num-test (make-rectangular -1234000000 -1234000000) -1234000000.0-1234000000.0i)
-(num-test (make-rectangular -1234000000 -2) -1234000000.0-2.0i)
-(num-test (make-rectangular -1234000000 -3) -1234000000.0-3.0i)
-(num-test (make-rectangular -1234000000 -362880) -1234000000.0-362880.0i)
-(num-test (make-rectangular -1234000000 -500029) -1234000000.0-500029.0i)
-(num-test (make-rectangular -1234000000 1) -1234000000.0+1.0i)
-(num-test (make-rectangular -1234000000 10) -1234000000.0+10.0i)
-(num-test (make-rectangular -1234000000 1234) -1234000000.0+1234.0i)
-(num-test (make-rectangular -1234000000 1234000000) -1234000000.0+1234000000.0i)
-(num-test (make-rectangular -1234000000 2) -1234000000.0+2.0i)
-(num-test (make-rectangular -1234000000 3) -1234000000.0+3.0i)
-(num-test (make-rectangular -1234000000 362880) -1234000000.0+362880.0i)
-(num-test (make-rectangular -1234000000 500029) -1234000000.0+500029.0i)
-(num-test (make-rectangular -1234000000.0 -0.00000001) -1234000000.0-0.00000001i)
-(num-test (make-rectangular -1234000000.0 -1.0) -1234000000.0-1.0i)
-(num-test (make-rectangular -1234000000.0 -1234.0) -1234000000.0-1234.0i)
-(num-test (make-rectangular -1234000000.0 -1234000000.0) -1234000000.0-1234000000.0i)
-(num-test (make-rectangular -1234000000.0 -2.71828182845905) -1234000000.0-2.71828182845905i)
-(num-test (make-rectangular -1234000000.0 -3.14159265358979) -1234000000.0-3.14159265358979i)
-(num-test (make-rectangular -1234000000.0 0.00000001) -1234000000.0+0.00000001i)
-(num-test (make-rectangular -1234000000.0 1.0) -1234000000.0+1.0i)
-(num-test (make-rectangular -1234000000.0 1234.0) -1234000000.0+1234.0i)
-(num-test (make-rectangular -1234000000.0 1234000000.0) -1234000000.0+1234000000.0i)
-(num-test (make-rectangular -1234000000.0 2.71828182845905) -1234000000.0+2.71828182845905i)
-(num-test (make-rectangular -1234000000.0 pi) -1234000000.0+3.14159265358979i)
-(num-test (make-rectangular -2 -1) -2.0-1.0i)
-(num-test (make-rectangular -2 -10) -2.0-10.0i)
-(num-test (make-rectangular -2 -1234) -2.0-1234.0i)
-(num-test (make-rectangular -2 -1234000000) -2.0-1234000000.0i)
-(num-test (make-rectangular -2 -2) -2.0-2.0i)
-(num-test (make-rectangular -2 -3) -2.0-3.0i)
-(num-test (make-rectangular -2 -362880) -2.0-362880.0i)
-(num-test (make-rectangular -2 -500029) -2.0-500029.0i)
-(num-test (make-rectangular -2 1) -2.0+1.0i)
-(num-test (make-rectangular -2 10) -2.0+10.0i)
-(num-test (make-rectangular -2 1234) -2.0+1234.0i)
-(num-test (make-rectangular -2 1234000000) -2.0+1234000000.0i)
-(num-test (make-rectangular -2 2) -2.0+2.0i)
-(num-test (make-rectangular -2 3) -2.0+3.0i)
-(num-test (make-rectangular -2 362880) -2.0+362880.0i)
-(num-test (make-rectangular -2 500029) -2.0+500029.0i)
-(num-test (make-rectangular -2.71828182845905 -0.00000001) -2.71828182845905-0.00000001i)
-(num-test (make-rectangular -2.71828182845905 -1.0) -2.71828182845905-1.0i)
-(num-test (make-rectangular -2.71828182845905 -1234.0) -2.71828182845905-1234.0i)
-(num-test (make-rectangular -2.71828182845905 -1234000000.0) -2.71828182845905-1234000000.0i)
-(num-test (make-rectangular -2.71828182845905 -2.71828182845905) -2.71828182845905-2.71828182845905i)
-(num-test (make-rectangular -2.71828182845905 -3.14159265358979) -2.71828182845905-3.14159265358979i)
-(num-test (make-rectangular -2.71828182845905 0.00000001) -2.71828182845905+0.00000001i)
-(num-test (make-rectangular -2.71828182845905 1.0) -2.71828182845905+1.0i)
-(num-test (make-rectangular -2.71828182845905 1234.0) -2.71828182845905+1234.0i)
-(num-test (make-rectangular -2.71828182845905 1234000000.0) -2.71828182845905+1234000000.0i)
-(num-test (make-rectangular -2.71828182845905 2.71828182845905) -2.71828182845905+2.71828182845905i)
-(num-test (make-rectangular -2.71828182845905 pi) -2.71828182845905+3.14159265358979i)
-(num-test (make-rectangular -3 -1) -3.0-1.0i)
-(num-test (make-rectangular -3 -10) -3.0-10.0i)
-(num-test (make-rectangular -3 -1234) -3.0-1234.0i)
-(num-test (make-rectangular -3 -1234000000) -3.0-1234000000.0i)
-(num-test (make-rectangular -3 -2) -3.0-2.0i)
-(num-test (make-rectangular -3 -3) -3.0-3.0i)
-(num-test (make-rectangular -3 -362880) -3.0-362880.0i)
-(num-test (make-rectangular -3 -500029) -3.0-500029.0i)
-(num-test (make-rectangular -3 1) -3.0+1.0i)
-(num-test (make-rectangular -3 10) -3.0+10.0i)
-(num-test (make-rectangular -3 1234) -3.0+1234.0i)
-(num-test (make-rectangular -3 1234000000) -3.0+1234000000.0i)
-(num-test (make-rectangular -3 2) -3.0+2.0i)
-(num-test (make-rectangular -3 3) -3.0+3.0i)
-(num-test (make-rectangular -3 362880) -3.0+362880.0i)
-(num-test (make-rectangular -3 500029) -3.0+500029.0i)
-(num-test (make-rectangular -3.14159265358979 -0.00000001) -3.14159265358979-0.00000001i)
-(num-test (make-rectangular -3.14159265358979 -1.0) -3.14159265358979-1.0i)
-(num-test (make-rectangular -3.14159265358979 -1234.0) -3.14159265358979-1234.0i)
-(num-test (make-rectangular -3.14159265358979 -1234000000.0) -3.14159265358979-1234000000.0i)
-(num-test (make-rectangular -3.14159265358979 -2.71828182845905) -3.14159265358979-2.71828182845905i)
-(num-test (make-rectangular -3.14159265358979 -3.14159265358979) -3.14159265358979-3.14159265358979i)
-(num-test (make-rectangular -3.14159265358979 0.00000001) -3.14159265358979+0.00000001i)
-(num-test (make-rectangular -3.14159265358979 1.0) -3.14159265358979+1.0i)
-(num-test (make-rectangular -3.14159265358979 1234.0) -3.14159265358979+1234.0i)
-(num-test (make-rectangular -3.14159265358979 1234000000.0) -3.14159265358979+1234000000.0i)
-(num-test (make-rectangular -3.14159265358979 2.71828182845905) -3.14159265358979+2.71828182845905i)
-(num-test (make-rectangular -3.14159265358979 pi) -3.14159265358979+3.14159265358979i)
-(num-test (make-rectangular -362880 -1) -362880.0-1.0i)
-(num-test (make-rectangular -362880 -10) -362880.0-10.0i)
-(num-test (make-rectangular -362880 -1234) -362880.0-1234.0i)
-(num-test (make-rectangular -362880 -1234000000) -362880.0-1234000000.0i)
-(num-test (make-rectangular -362880 -2) -362880.0-2.0i)
-(num-test (make-rectangular -362880 -3) -362880.0-3.0i)
-(num-test (make-rectangular -362880 -362880) -362880.0-362880.0i)
-(num-test (make-rectangular -362880 -500029) -362880.0-500029.0i)
-(num-test (make-rectangular -362880 1) -362880.0+1.0i)
-(num-test (make-rectangular -362880 10) -362880.0+10.0i)
-(num-test (make-rectangular -362880 1234) -362880.0+1234.0i)
-(num-test (make-rectangular -362880 1234000000) -362880.0+1234000000.0i)
-(num-test (make-rectangular -362880 2) -362880.0+2.0i)
-(num-test (make-rectangular -362880 3) -362880.0+3.0i)
-(num-test (make-rectangular -362880 362880) -362880.0+362880.0i)
-(num-test (make-rectangular -362880 500029) -362880.0+500029.0i)
-(num-test (make-rectangular -500029 -1) -500029.0-1.0i)
-(num-test (make-rectangular -500029 -10) -500029.0-10.0i)
-(num-test (make-rectangular -500029 -1234) -500029.0-1234.0i)
-(num-test (make-rectangular -500029 -1234000000) -500029.0-1234000000.0i)
-(num-test (make-rectangular -500029 -2) -500029.0-2.0i)
-(num-test (make-rectangular -500029 -3) -500029.0-3.0i)
-(num-test (make-rectangular -500029 -362880) -500029.0-362880.0i)
-(num-test (make-rectangular -500029 -500029) -500029.0-500029.0i)
-(num-test (make-rectangular -500029 1) -500029.0+1.0i)
-(num-test (make-rectangular -500029 10) -500029.0+10.0i)
-(num-test (make-rectangular -500029 1234) -500029.0+1234.0i)
-(num-test (make-rectangular -500029 1234000000) -500029.0+1234000000.0i)
-(num-test (make-rectangular -500029 2) -500029.0+2.0i)
-(num-test (make-rectangular -500029 3) -500029.0+3.0i)
-(num-test (make-rectangular -500029 362880) -500029.0+362880.0i)
-(num-test (make-rectangular -500029 500029) -500029.0+500029.0i)
-(num-test (make-rectangular 0 -1) 0.0-1.0i)
-(num-test (make-rectangular 0 -10) 0.0-10.0i)
-(num-test (make-rectangular 0 -1234) 0.0-1234.0i)
-(num-test (make-rectangular 0 -1234000000) 0.0-1234000000.0i)
-(num-test (make-rectangular 0 -2) 0.0-2.0i)
-(num-test (make-rectangular 0 -3) 0.0-3.0i)
-(num-test (make-rectangular 0 -362880) 0.0-362880.0i)
-(num-test (make-rectangular 0 -500029) 0.0-500029.0i)
-(num-test (make-rectangular 0 0) 0)
-(num-test (make-rectangular 0 1) 0.0+1.0i)
-(num-test (make-rectangular 0 10) 0.0+10.0i)
-(num-test (make-rectangular 0 1234) 0.0+1234.0i)
-(num-test (make-rectangular 0 1234000000) 0.0+1234000000.0i)
-(num-test (make-rectangular 0 2) 0.0+2.0i)
-(num-test (make-rectangular 0 3) 0.0+3.0i)
-(num-test (make-rectangular 0 362880) 0.0+362880.0i)
-(num-test (make-rectangular 0 500029) 0.0+500029.0i)
-(num-test (make-rectangular 0.0 -0.00000001) 0.0-0.00000001i)
-(num-test (make-rectangular 0.0 -1.0) 0.0-1.0i)
-(num-test (make-rectangular 0.0 -1234.0) 0.0-1234.0i)
-(num-test (make-rectangular 0.0 -1234000000.0) 0.0-1234000000.0i)
-(num-test (make-rectangular 0.0 -2.71828182845905) 0.0-2.71828182845905i)
-(num-test (make-rectangular 0.0 -3.14159265358979) 0.0-3.14159265358979i)
-(num-test (make-rectangular 0.0 0.0) 0.0)
-(num-test (make-rectangular 0.0 0.00000001) 0.0+0.00000001i)
-(num-test (make-rectangular 0.0 1.0) 0.0+1.0i)
-(num-test (make-rectangular 0.0 1234.0) 0.0+1234.0i)
-(num-test (make-rectangular 0.0 1234000000.0) 0.0+1234000000.0i)
-(num-test (make-rectangular 0.0 2.71828182845905) 0.0+2.71828182845905i)
-(num-test (make-rectangular 0.0 pi) 0.0+3.14159265358979i)
-(num-test (make-rectangular 0.00000001 -0.00000001) 0.00000001-0.00000001i)
-(num-test (make-rectangular 0.00000001 -1.0) 0.00000001-1.0i)
-(num-test (make-rectangular 0.00000001 -1234.0) 0.00000001-1234.0i)
-(num-test (make-rectangular 0.00000001 -1234000000.0) 0.00000001-1234000000.0i)
-(num-test (make-rectangular 0.00000001 -2.71828182845905) 0.00000001-2.71828182845905i)
-(num-test (make-rectangular 0.00000001 -3.14159265358979) 0.00000001-3.14159265358979i)
-(num-test (make-rectangular 0.00000001 0.00000001) 0.00000001+0.00000001i)
-(num-test (make-rectangular 0.00000001 1.0) 0.00000001+1.0i)
-(num-test (make-rectangular 0.00000001 1234.0) 0.00000001+1234.0i)
-(num-test (make-rectangular 0.00000001 1234000000.0) 0.00000001+1234000000.0i)
-(num-test (make-rectangular 0.00000001 2.71828182845905) 0.00000001+2.71828182845905i)
-(num-test (make-rectangular 0.00000001 pi) 0.00000001+3.14159265358979i)
-(num-test (make-rectangular 1 -1) 1.0-1.0i)
-(num-test (make-rectangular 1 -10) 1.0-10.0i)
-(num-test (make-rectangular 1 -1234) 1.0-1234.0i)
-(num-test (make-rectangular 1 -1234000000) 1.0-1234000000.0i)
-(num-test (make-rectangular 1 -2) 1.0-2.0i)
-(num-test (make-rectangular 1 -3) 1.0-3.0i)
-(num-test (make-rectangular 1 -362880) 1.0-362880.0i)
-(num-test (make-rectangular 1 -500029) 1.0-500029.0i)
-(num-test (make-rectangular 1 1) 1.0+1.0i)
-(num-test (make-rectangular 1 10) 1.0+10.0i)
-(num-test (make-rectangular 1 1234) 1.0+1234.0i)
-(num-test (make-rectangular 1 1234000000) 1.0+1234000000.0i)
-(num-test (make-rectangular 1 2) 1.0+2.0i)
-(num-test (make-rectangular 1 3) 1.0+3.0i)
-(num-test (make-rectangular 1 362880) 1.0+362880.0i)
-(num-test (make-rectangular 1 500029) 1.0+500029.0i)
-(num-test (make-rectangular 1.0 -0.00000001) 1.0-0.00000001i)
-(num-test (make-rectangular 1.0 -1.0) 1.0-1.0i)
-(num-test (make-rectangular 1.0 -1234.0) 1.0-1234.0i)
-(num-test (make-rectangular 1.0 -1234000000.0) 1.0-1234000000.0i)
-(num-test (make-rectangular 1.0 -2.71828182845905) 1.0-2.71828182845905i)
-(num-test (make-rectangular 1.0 -3.14159265358979) 1.0-3.14159265358979i)
-(num-test (make-rectangular 1.0 0.00000001) 1.0+0.00000001i)
-(num-test (make-rectangular 1.0 1.0) 1.0+1.0i)
-(num-test (make-rectangular 1.0 1234.0) 1.0+1234.0i)
-(num-test (make-rectangular 1.0 1234000000.0) 1.0+1234000000.0i)
-(num-test (make-rectangular 1.0 2.71828182845905) 1.0+2.71828182845905i)
-(num-test (make-rectangular 1.0 pi) 1.0+3.14159265358979i)
-(num-test (make-rectangular 10 -1) 10.0-1.0i)
-(num-test (make-rectangular 10 -10) 10.0-10.0i)
-(num-test (make-rectangular 10 -1234) 10.0-1234.0i)
-(num-test (make-rectangular 10 -1234000000) 10.0-1234000000.0i)
-(num-test (make-rectangular 10 -2) 10.0-2.0i)
-(num-test (make-rectangular 10 -3) 10.0-3.0i)
-(num-test (make-rectangular 10 -362880) 10.0-362880.0i)
-(num-test (make-rectangular 10 -500029) 10.0-500029.0i)
-(num-test (make-rectangular 10 1) 10.0+1.0i)
-(num-test (make-rectangular 10 10) 10.0+10.0i)
-(num-test (make-rectangular 10 1234) 10.0+1234.0i)
-(num-test (make-rectangular 10 1234000000) 10.0+1234000000.0i)
-(num-test (make-rectangular 10 2) 10.0+2.0i)
-(num-test (make-rectangular 10 3) 10.0+3.0i)
-(num-test (make-rectangular 10 362880) 10.0+362880.0i)
-(num-test (make-rectangular 10 500029) 10.0+500029.0i)
-(num-test (make-rectangular 1234 -1) 1234.0-1.0i)
-(num-test (make-rectangular 1234 -10) 1234.0-10.0i)
-(num-test (make-rectangular 1234 -1234) 1234.0-1234.0i)
-(num-test (make-rectangular 1234 -1234000000) 1234.0-1234000000.0i)
-(num-test (make-rectangular 1234 -2) 1234.0-2.0i)
-(num-test (make-rectangular 1234 -3) 1234.0-3.0i)
-(num-test (make-rectangular 1234 -362880) 1234.0-362880.0i)
-(num-test (make-rectangular 1234 -500029) 1234.0-500029.0i)
-(num-test (make-rectangular 1234 1) 1234.0+1.0i)
-(num-test (make-rectangular 1234 10) 1234.0+10.0i)
-(num-test (make-rectangular 1234 1234) 1234.0+1234.0i)
-(num-test (make-rectangular 1234 1234000000) 1234.0+1234000000.0i)
-(num-test (make-rectangular 1234 2) 1234.0+2.0i)
-(num-test (make-rectangular 1234 3) 1234.0+3.0i)
-(num-test (make-rectangular 1234 362880) 1234.0+362880.0i)
-(num-test (make-rectangular 1234 500029) 1234.0+500029.0i)
-(num-test (make-rectangular 1234.0 -0.00000001) 1234.0-0.00000001i)
-(num-test (make-rectangular 1234.0 -1.0) 1234.0-1.0i)
-(num-test (make-rectangular 1234.0 -1234.0) 1234.0-1234.0i)
-(num-test (make-rectangular 1234.0 -1234000000.0) 1234.0-1234000000.0i)
-(num-test (make-rectangular 1234.0 -2.71828182845905) 1234.0-2.71828182845905i)
-(num-test (make-rectangular 1234.0 -3.14159265358979) 1234.0-3.14159265358979i)
-(num-test (make-rectangular 1234.0 0.00000001) 1234.0+0.00000001i)
-(num-test (make-rectangular 1234.0 1.0) 1234.0+1.0i)
-(num-test (make-rectangular 1234.0 1234.0) 1234.0+1234.0i)
-(num-test (make-rectangular 1234.0 1234000000.0) 1234.0+1234000000.0i)
-(num-test (make-rectangular 1234.0 2.71828182845905) 1234.0+2.71828182845905i)
-(num-test (make-rectangular 1234.0 pi) 1234.0+3.14159265358979i)
-(num-test (make-rectangular 1234000000 -1) 1234000000.0-1.0i)
-(num-test (make-rectangular 1234000000 -10) 1234000000.0-10.0i)
-(num-test (make-rectangular 1234000000 -1234) 1234000000.0-1234.0i)
-(num-test (make-rectangular 1234000000 -1234000000) 1234000000.0-1234000000.0i)
-(num-test (make-rectangular 1234000000 -2) 1234000000.0-2.0i)
-(num-test (make-rectangular 1234000000 -3) 1234000000.0-3.0i)
-(num-test (make-rectangular 1234000000 -362880) 1234000000.0-362880.0i)
-(num-test (make-rectangular 1234000000 -500029) 1234000000.0-500029.0i)
-(num-test (make-rectangular 1234000000 1) 1234000000.0+1.0i)
-(num-test (make-rectangular 1234000000 10) 1234000000.0+10.0i)
-(num-test (make-rectangular 1234000000 1234) 1234000000.0+1234.0i)
-(num-test (make-rectangular 1234000000 1234000000) 1234000000.0+1234000000.0i)
-(num-test (make-rectangular 1234000000 2) 1234000000.0+2.0i)
-(num-test (make-rectangular 1234000000 3) 1234000000.0+3.0i)
-(num-test (make-rectangular 1234000000 362880) 1234000000.0+362880.0i)
-(num-test (make-rectangular 1234000000 500029) 1234000000.0+500029.0i)
-(num-test (make-rectangular 1234000000.0 -0.00000001) 1234000000.0-0.00000001i)
-(num-test (make-rectangular 1234000000.0 -1.0) 1234000000.0-1.0i)
-(num-test (make-rectangular 1234000000.0 -1234.0) 1234000000.0-1234.0i)
-(num-test (make-rectangular 1234000000.0 -1234000000.0) 1234000000.0-1234000000.0i)
-(num-test (make-rectangular 1234000000.0 -2.71828182845905) 1234000000.0-2.71828182845905i)
-(num-test (make-rectangular 1234000000.0 -3.14159265358979) 1234000000.0-3.14159265358979i)
-(num-test (make-rectangular 1234000000.0 0.00000001) 1234000000.0+0.00000001i)
-(num-test (make-rectangular 1234000000.0 1.0) 1234000000.0+1.0i)
-(num-test (make-rectangular 1234000000.0 1234.0) 1234000000.0+1234.0i)
-(num-test (make-rectangular 1234000000.0 1234000000.0) 1234000000.0+1234000000.0i)
-(num-test (make-rectangular 1234000000.0 2.71828182845905) 1234000000.0+2.71828182845905i)
-(num-test (make-rectangular 1234000000.0 pi) 1234000000.0+3.14159265358979i)
-(num-test (make-rectangular 2 -1) 2.0-1.0i)
-(num-test (make-rectangular 2 -10) 2.0-10.0i)
-(num-test (make-rectangular 2 -1234) 2.0-1234.0i)
-(num-test (make-rectangular 2 -1234000000) 2.0-1234000000.0i)
-(num-test (make-rectangular 2 -2) 2.0-2.0i)
-(num-test (make-rectangular 2 -3) 2.0-3.0i)
-(num-test (make-rectangular 2 -362880) 2.0-362880.0i)
-(num-test (make-rectangular 2 -500029) 2.0-500029.0i)
-(num-test (make-rectangular 2 1) 2.0+1.0i)
-(num-test (make-rectangular 2 10) 2.0+10.0i)
-(num-test (make-rectangular 2 1234) 2.0+1234.0i)
-(num-test (make-rectangular 2 1234000000) 2.0+1234000000.0i)
-(num-test (make-rectangular 2 2) 2.0+2.0i)
-(num-test (make-rectangular 2 3) 2.0+3.0i)
-(num-test (make-rectangular 2 362880) 2.0+362880.0i)
-(num-test (make-rectangular 2 500029) 2.0+500029.0i)
-(num-test (make-rectangular 2.71828182845905 -0.00000001) 2.71828182845905-0.00000001i)
-(num-test (make-rectangular 2.71828182845905 -1.0) 2.71828182845905-1.0i)
-(num-test (make-rectangular 2.71828182845905 -1234.0) 2.71828182845905-1234.0i)
-(num-test (make-rectangular 2.71828182845905 -1234000000.0) 2.71828182845905-1234000000.0i)
-(num-test (make-rectangular 2.71828182845905 -2.71828182845905) 2.71828182845905-2.71828182845905i)
-(num-test (make-rectangular 2.71828182845905 -3.14159265358979) 2.71828182845905-3.14159265358979i)
-(num-test (make-rectangular 2.71828182845905 0.00000001) 2.71828182845905+0.00000001i)
-(num-test (make-rectangular 2.71828182845905 1.0) 2.71828182845905+1.0i)
-(num-test (make-rectangular 2.71828182845905 1234.0) 2.71828182845905+1234.0i)
-(num-test (make-rectangular 2.71828182845905 1234000000.0) 2.71828182845905+1234000000.0i)
-(num-test (make-rectangular 2.71828182845905 2.71828182845905) 2.71828182845905+2.71828182845905i)
-(num-test (make-rectangular 2.71828182845905 pi) 2.71828182845905+3.14159265358979i)
-(num-test (make-rectangular 3 -1) 3.0-1.0i)
-(num-test (make-rectangular 3 -10) 3.0-10.0i)
-(num-test (make-rectangular 3 -1234) 3.0-1234.0i)
-(num-test (make-rectangular 3 -1234000000) 3.0-1234000000.0i)
-(num-test (make-rectangular 3 -2) 3.0-2.0i)
-(num-test (make-rectangular 3 -3) 3.0-3.0i)
-(num-test (make-rectangular 3 -362880) 3.0-362880.0i)
-(num-test (make-rectangular 3 -500029) 3.0-500029.0i)
-(num-test (make-rectangular 3 1) 3.0+1.0i)
-(num-test (make-rectangular 3 10) 3.0+10.0i)
-(num-test (make-rectangular 3 1234) 3.0+1234.0i)
-(num-test (make-rectangular 3 1234000000) 3.0+1234000000.0i)
-(num-test (make-rectangular 3 2) 3.0+2.0i)
-(num-test (make-rectangular 3 3) 3.0+3.0i)
-(num-test (make-rectangular 3 362880) 3.0+362880.0i)
-(num-test (make-rectangular 3 500029) 3.0+500029.0i)
-(num-test (make-rectangular 3.14159265358979 -0.00000001) 3.14159265358979-0.00000001i)
-(num-test (make-rectangular 3.14159265358979 -1.0) 3.14159265358979-1.0i)
-(num-test (make-rectangular 3.14159265358979 -1234.0) 3.14159265358979-1234.0i)
-(num-test (make-rectangular 3.14159265358979 -1234000000.0) 3.14159265358979-1234000000.0i)
-(num-test (make-rectangular 3.14159265358979 -2.71828182845905) 3.14159265358979-2.71828182845905i)
-(num-test (make-rectangular 3.14159265358979 -3.14159265358979) 3.14159265358979-3.14159265358979i)
-(num-test (make-rectangular 3.14159265358979 0.00000001) 3.14159265358979+0.00000001i)
-(num-test (make-rectangular 3.14159265358979 1.0) 3.14159265358979+1.0i)
-(num-test (make-rectangular 3.14159265358979 1234.0) 3.14159265358979+1234.0i)
-(num-test (make-rectangular 3.14159265358979 1234000000.0) 3.14159265358979+1234000000.0i)
-(num-test (make-rectangular 3.14159265358979 2.71828182845905) 3.14159265358979+2.71828182845905i)
-(num-test (make-rectangular 3.14159265358979 pi) 3.14159265358979+3.14159265358979i)
-(num-test (make-rectangular 362880 -1) 362880.0-1.0i)
-(num-test (make-rectangular 362880 -10) 362880.0-10.0i)
-(num-test (make-rectangular 362880 -1234) 362880.0-1234.0i)
-(num-test (make-rectangular 362880 -1234000000) 362880.0-1234000000.0i)
-(num-test (make-rectangular 362880 -2) 362880.0-2.0i)
-(num-test (make-rectangular 362880 -3) 362880.0-3.0i)
-(num-test (make-rectangular 362880 -362880) 362880.0-362880.0i)
-(num-test (make-rectangular 362880 -500029) 362880.0-500029.0i)
-(num-test (make-rectangular 362880 1) 362880.0+1.0i)
-(num-test (make-rectangular 362880 10) 362880.0+10.0i)
-(num-test (make-rectangular 362880 1234) 362880.0+1234.0i)
-(num-test (make-rectangular 362880 1234000000) 362880.0+1234000000.0i)
-(num-test (make-rectangular 362880 2) 362880.0+2.0i)
-(num-test (make-rectangular 362880 3) 362880.0+3.0i)
-(num-test (make-rectangular 362880 362880) 362880.0+362880.0i)
-(num-test (make-rectangular 362880 500029) 362880.0+500029.0i)
-(num-test (make-rectangular 500029 -1) 500029.0-1.0i)
-(num-test (make-rectangular 500029 -10) 500029.0-10.0i)
-(num-test (make-rectangular 500029 -1234) 500029.0-1234.0i)
-(num-test (make-rectangular 500029 -1234000000) 500029.0-1234000000.0i)
-(num-test (make-rectangular 500029 -2) 500029.0-2.0i)
-(num-test (make-rectangular 500029 -3) 500029.0-3.0i)
-(num-test (make-rectangular 500029 -362880) 500029.0-362880.0i)
-(num-test (make-rectangular 500029 -500029) 500029.0-500029.0i)
-(num-test (make-rectangular 500029 1) 500029.0+1.0i)
-(num-test (make-rectangular 500029 10) 500029.0+10.0i)
-(num-test (make-rectangular 500029 1234) 500029.0+1234.0i)
-(num-test (make-rectangular 500029 1234000000) 500029.0+1234000000.0i)
-(num-test (make-rectangular 500029 2) 500029.0+2.0i)
-(num-test (make-rectangular 500029 3) 500029.0+3.0i)
-(num-test (make-rectangular 500029 362880) 500029.0+362880.0i)
-(num-test (make-rectangular 500029 500029) 500029.0+500029.0i)
-(num-test (make-rectangular 1/2 0) 1/2)
-(num-test (make-rectangular 1/2 1/2) 0.5+0.5i)
-(num-test (make-rectangular 0 1/2) 0+0.5i)
-
-(test (nan? (make-rectangular nan.0 nan.0)) #t)
-(test (nan? (make-rectangular nan.0 inf.0)) #t)
+
+(num-test (complex -0 -1) -0.0-1.0i)
+(num-test (complex -0 -10) -0.0-10.0i)
+(num-test (complex -0 -1234) -0.0-1234.0i)
+(num-test (complex -0 -1234000000) -0.0-1234000000.0i)
+(num-test (complex -0 -2) -0.0-2.0i)
+(num-test (complex -0 -3) -0.0-3.0i)
+(num-test (complex -0 -362880) -0.0-362880.0i)
+(num-test (complex -0 -500029) -0.0-500029.0i)
+(num-test (complex -0 1) -0.0+1.0i)
+(num-test (complex -0 10) -0.0+10.0i)
+(num-test (complex -0 1234) -0.0+1234.0i)
+(num-test (complex -0 1234000000) -0.0+1234000000.0i)
+(num-test (complex -0 2) -0.0+2.0i)
+(num-test (complex -0 3) -0.0+3.0i)
+(num-test (complex -0 362880) -0.0+362880.0i)
+(num-test (complex -0 500029) -0.0+500029.0i)
+(num-test (complex -0.0 -0.00000001) -0.0-0.00000001i)
+(num-test (complex -0.0 -1.0) -0.0-1.0i)
+(num-test (complex -0.0 -1234.0) -0.0-1234.0i)
+(num-test (complex -0.0 -1234000000.0) -0.0-1234000000.0i)
+(num-test (complex -0.0 -2.71828182845905) -0.0-2.71828182845905i)
+(num-test (complex -0.0 -3.14159265358979) -0.0-3.14159265358979i)
+(num-test (complex -0.0 0.00000001) -0.0+0.00000001i)
+(num-test (complex -0.0 1.0) -0.0+1.0i)
+(num-test (complex -0.0 1234.0) -0.0+1234.0i)
+(num-test (complex -0.0 1234000000.0) -0.0+1234000000.0i)
+(num-test (complex -0.0 2.71828182845905) -0.0+2.71828182845905i)
+(num-test (complex -0.0 pi) -0.0+3.14159265358979i)
+(num-test (complex -0.00000001 -0.00000001) -0.00000001-0.00000001i)
+(num-test (complex -0.00000001 -1.0) -0.00000001-1.0i)
+(num-test (complex -0.00000001 -1234.0) -0.00000001-1234.0i)
+(num-test (complex -0.00000001 -1234000000.0) -0.00000001-1234000000.0i)
+(num-test (complex -0.00000001 -2.71828182845905) -0.00000001-2.71828182845905i)
+(num-test (complex -0.00000001 -3.14159265358979) -0.00000001-3.14159265358979i)
+(num-test (complex -0.00000001 0.00000001) -0.00000001+0.00000001i)
+(num-test (complex -0.00000001 1.0) -0.00000001+1.0i)
+(num-test (complex -0.00000001 1234.0) -0.00000001+1234.0i)
+(num-test (complex -0.00000001 1234000000.0) -0.00000001+1234000000.0i)
+(num-test (complex -0.00000001 2.71828182845905) -0.00000001+2.71828182845905i)
+(num-test (complex -0.00000001 pi) -0.00000001+3.14159265358979i)
+(num-test (complex -1 -1) -1.0-1.0i)
+(num-test (complex -1 -10) -1.0-10.0i)
+(num-test (complex -1 -1234) -1.0-1234.0i)
+(num-test (complex -1 -1234000000) -1.0-1234000000.0i)
+(num-test (complex -1 -2) -1.0-2.0i)
+(num-test (complex -1 -3) -1.0-3.0i)
+(num-test (complex -1 -362880) -1.0-362880.0i)
+(num-test (complex -1 -500029) -1.0-500029.0i)
+(num-test (complex -1 1) -1.0+1.0i)
+(num-test (complex -1 10) -1.0+10.0i)
+(num-test (complex -1 1234) -1.0+1234.0i)
+(num-test (complex -1 1234000000) -1.0+1234000000.0i)
+(num-test (complex -1 2) -1.0+2.0i)
+(num-test (complex -1 3) -1.0+3.0i)
+(num-test (complex -1 362880) -1.0+362880.0i)
+(num-test (complex -1 500029) -1.0+500029.0i)
+(num-test (complex -1.0 -0.00000001) -1.0-0.00000001i)
+(num-test (complex -1.0 -1.0) -1.0-1.0i)
+(num-test (complex -1.0 -1234.0) -1.0-1234.0i)
+(num-test (complex -1.0 -1234000000.0) -1.0-1234000000.0i)
+(num-test (complex -1.0 -2.71828182845905) -1.0-2.71828182845905i)
+(num-test (complex -1.0 -3.14159265358979) -1.0-3.14159265358979i)
+(num-test (complex -1.0 0.00000001) -1.0+0.00000001i)
+(num-test (complex -1.0 1.0) -1.0+1.0i)
+(num-test (complex -1.0 1234.0) -1.0+1234.0i)
+(num-test (complex -1.0 1234000000.0) -1.0+1234000000.0i)
+(num-test (complex -1.0 2.71828182845905) -1.0+2.71828182845905i)
+(num-test (complex -1.0 pi) -1.0+3.14159265358979i)
+(num-test (complex -10 -1) -10.0-1.0i)
+(num-test (complex -10 -10) -10.0-10.0i)
+(num-test (complex -10 -1234) -10.0-1234.0i)
+(num-test (complex -10 -1234000000) -10.0-1234000000.0i)
+(num-test (complex -10 -2) -10.0-2.0i)
+(num-test (complex -10 -3) -10.0-3.0i)
+(num-test (complex -10 -362880) -10.0-362880.0i)
+(num-test (complex -10 -500029) -10.0-500029.0i)
+(num-test (complex -10 1) -10.0+1.0i)
+(num-test (complex -10 10) -10.0+10.0i)
+(num-test (complex -10 1234) -10.0+1234.0i)
+(num-test (complex -10 1234000000) -10.0+1234000000.0i)
+(num-test (complex -10 2) -10.0+2.0i)
+(num-test (complex -10 3) -10.0+3.0i)
+(num-test (complex -10 362880) -10.0+362880.0i)
+(num-test (complex -10 500029) -10.0+500029.0i)
+(num-test (complex -1234 -1) -1234.0-1.0i)
+(num-test (complex -1234 -10) -1234.0-10.0i)
+(num-test (complex -1234 -1234) -1234.0-1234.0i)
+(num-test (complex -1234 -1234000000) -1234.0-1234000000.0i)
+(num-test (complex -1234 -2) -1234.0-2.0i)
+(num-test (complex -1234 -3) -1234.0-3.0i)
+(num-test (complex -1234 -362880) -1234.0-362880.0i)
+(num-test (complex -1234 -500029) -1234.0-500029.0i)
+(num-test (complex -1234 1) -1234.0+1.0i)
+(num-test (complex -1234 10) -1234.0+10.0i)
+(num-test (complex -1234 1234) -1234.0+1234.0i)
+(num-test (complex -1234 1234000000) -1234.0+1234000000.0i)
+(num-test (complex -1234 2) -1234.0+2.0i)
+(num-test (complex -1234 3) -1234.0+3.0i)
+(num-test (complex -1234 362880) -1234.0+362880.0i)
+(num-test (complex -1234 500029) -1234.0+500029.0i)
+(num-test (complex -1234.0 -0.00000001) -1234.0-0.00000001i)
+(num-test (complex -1234.0 -1.0) -1234.0-1.0i)
+(num-test (complex -1234.0 -1234.0) -1234.0-1234.0i)
+(num-test (complex -1234.0 -1234000000.0) -1234.0-1234000000.0i)
+(num-test (complex -1234.0 -2.71828182845905) -1234.0-2.71828182845905i)
+(num-test (complex -1234.0 -3.14159265358979) -1234.0-3.14159265358979i)
+(num-test (complex -1234.0 0.00000001) -1234.0+0.00000001i)
+(num-test (complex -1234.0 1.0) -1234.0+1.0i)
+(num-test (complex -1234.0 1234.0) -1234.0+1234.0i)
+(num-test (complex -1234.0 1234000000.0) -1234.0+1234000000.0i)
+(num-test (complex -1234.0 2.71828182845905) -1234.0+2.71828182845905i)
+(num-test (complex -1234.0 pi) -1234.0+3.14159265358979i)
+(num-test (complex -1234000000 -1) -1234000000.0-1.0i)
+(num-test (complex -1234000000 -10) -1234000000.0-10.0i)
+(num-test (complex -1234000000 -1234) -1234000000.0-1234.0i)
+(num-test (complex -1234000000 -1234000000) -1234000000.0-1234000000.0i)
+(num-test (complex -1234000000 -2) -1234000000.0-2.0i)
+(num-test (complex -1234000000 -3) -1234000000.0-3.0i)
+(num-test (complex -1234000000 -362880) -1234000000.0-362880.0i)
+(num-test (complex -1234000000 -500029) -1234000000.0-500029.0i)
+(num-test (complex -1234000000 1) -1234000000.0+1.0i)
+(num-test (complex -1234000000 10) -1234000000.0+10.0i)
+(num-test (complex -1234000000 1234) -1234000000.0+1234.0i)
+(num-test (complex -1234000000 1234000000) -1234000000.0+1234000000.0i)
+(num-test (complex -1234000000 2) -1234000000.0+2.0i)
+(num-test (complex -1234000000 3) -1234000000.0+3.0i)
+(num-test (complex -1234000000 362880) -1234000000.0+362880.0i)
+(num-test (complex -1234000000 500029) -1234000000.0+500029.0i)
+(num-test (complex -1234000000.0 -0.00000001) -1234000000.0-0.00000001i)
+(num-test (complex -1234000000.0 -1.0) -1234000000.0-1.0i)
+(num-test (complex -1234000000.0 -1234.0) -1234000000.0-1234.0i)
+(num-test (complex -1234000000.0 -1234000000.0) -1234000000.0-1234000000.0i)
+(num-test (complex -1234000000.0 -2.71828182845905) -1234000000.0-2.71828182845905i)
+(num-test (complex -1234000000.0 -3.14159265358979) -1234000000.0-3.14159265358979i)
+(num-test (complex -1234000000.0 0.00000001) -1234000000.0+0.00000001i)
+(num-test (complex -1234000000.0 1.0) -1234000000.0+1.0i)
+(num-test (complex -1234000000.0 1234.0) -1234000000.0+1234.0i)
+(num-test (complex -1234000000.0 1234000000.0) -1234000000.0+1234000000.0i)
+(num-test (complex -1234000000.0 2.71828182845905) -1234000000.0+2.71828182845905i)
+(num-test (complex -1234000000.0 pi) -1234000000.0+3.14159265358979i)
+(num-test (complex -2 -1) -2.0-1.0i)
+(num-test (complex -2 -10) -2.0-10.0i)
+(num-test (complex -2 -1234) -2.0-1234.0i)
+(num-test (complex -2 -1234000000) -2.0-1234000000.0i)
+(num-test (complex -2 -2) -2.0-2.0i)
+(num-test (complex -2 -3) -2.0-3.0i)
+(num-test (complex -2 -362880) -2.0-362880.0i)
+(num-test (complex -2 -500029) -2.0-500029.0i)
+(num-test (complex -2 1) -2.0+1.0i)
+(num-test (complex -2 10) -2.0+10.0i)
+(num-test (complex -2 1234) -2.0+1234.0i)
+(num-test (complex -2 1234000000) -2.0+1234000000.0i)
+(num-test (complex -2 2) -2.0+2.0i)
+(num-test (complex -2 3) -2.0+3.0i)
+(num-test (complex -2 362880) -2.0+362880.0i)
+(num-test (complex -2 500029) -2.0+500029.0i)
+(num-test (complex -2.71828182845905 -0.00000001) -2.71828182845905-0.00000001i)
+(num-test (complex -2.71828182845905 -1.0) -2.71828182845905-1.0i)
+(num-test (complex -2.71828182845905 -1234.0) -2.71828182845905-1234.0i)
+(num-test (complex -2.71828182845905 -1234000000.0) -2.71828182845905-1234000000.0i)
+(num-test (complex -2.71828182845905 -2.71828182845905) -2.71828182845905-2.71828182845905i)
+(num-test (complex -2.71828182845905 -3.14159265358979) -2.71828182845905-3.14159265358979i)
+(num-test (complex -2.71828182845905 0.00000001) -2.71828182845905+0.00000001i)
+(num-test (complex -2.71828182845905 1.0) -2.71828182845905+1.0i)
+(num-test (complex -2.71828182845905 1234.0) -2.71828182845905+1234.0i)
+(num-test (complex -2.71828182845905 1234000000.0) -2.71828182845905+1234000000.0i)
+(num-test (complex -2.71828182845905 2.71828182845905) -2.71828182845905+2.71828182845905i)
+(num-test (complex -2.71828182845905 pi) -2.71828182845905+3.14159265358979i)
+(num-test (complex -3 -1) -3.0-1.0i)
+(num-test (complex -3 -10) -3.0-10.0i)
+(num-test (complex -3 -1234) -3.0-1234.0i)
+(num-test (complex -3 -1234000000) -3.0-1234000000.0i)
+(num-test (complex -3 -2) -3.0-2.0i)
+(num-test (complex -3 -3) -3.0-3.0i)
+(num-test (complex -3 -362880) -3.0-362880.0i)
+(num-test (complex -3 -500029) -3.0-500029.0i)
+(num-test (complex -3 1) -3.0+1.0i)
+(num-test (complex -3 10) -3.0+10.0i)
+(num-test (complex -3 1234) -3.0+1234.0i)
+(num-test (complex -3 1234000000) -3.0+1234000000.0i)
+(num-test (complex -3 2) -3.0+2.0i)
+(num-test (complex -3 3) -3.0+3.0i)
+(num-test (complex -3 362880) -3.0+362880.0i)
+(num-test (complex -3 500029) -3.0+500029.0i)
+(num-test (complex -3.14159265358979 -0.00000001) -3.14159265358979-0.00000001i)
+(num-test (complex -3.14159265358979 -1.0) -3.14159265358979-1.0i)
+(num-test (complex -3.14159265358979 -1234.0) -3.14159265358979-1234.0i)
+(num-test (complex -3.14159265358979 -1234000000.0) -3.14159265358979-1234000000.0i)
+(num-test (complex -3.14159265358979 -2.71828182845905) -3.14159265358979-2.71828182845905i)
+(num-test (complex -3.14159265358979 -3.14159265358979) -3.14159265358979-3.14159265358979i)
+(num-test (complex -3.14159265358979 0.00000001) -3.14159265358979+0.00000001i)
+(num-test (complex -3.14159265358979 1.0) -3.14159265358979+1.0i)
+(num-test (complex -3.14159265358979 1234.0) -3.14159265358979+1234.0i)
+(num-test (complex -3.14159265358979 1234000000.0) -3.14159265358979+1234000000.0i)
+(num-test (complex -3.14159265358979 2.71828182845905) -3.14159265358979+2.71828182845905i)
+(num-test (complex -3.14159265358979 pi) -3.14159265358979+3.14159265358979i)
+(num-test (complex -362880 -1) -362880.0-1.0i)
+(num-test (complex -362880 -10) -362880.0-10.0i)
+(num-test (complex -362880 -1234) -362880.0-1234.0i)
+(num-test (complex -362880 -1234000000) -362880.0-1234000000.0i)
+(num-test (complex -362880 -2) -362880.0-2.0i)
+(num-test (complex -362880 -3) -362880.0-3.0i)
+(num-test (complex -362880 -362880) -362880.0-362880.0i)
+(num-test (complex -362880 -500029) -362880.0-500029.0i)
+(num-test (complex -362880 1) -362880.0+1.0i)
+(num-test (complex -362880 10) -362880.0+10.0i)
+(num-test (complex -362880 1234) -362880.0+1234.0i)
+(num-test (complex -362880 1234000000) -362880.0+1234000000.0i)
+(num-test (complex -362880 2) -362880.0+2.0i)
+(num-test (complex -362880 3) -362880.0+3.0i)
+(num-test (complex -362880 362880) -362880.0+362880.0i)
+(num-test (complex -362880 500029) -362880.0+500029.0i)
+(num-test (complex -500029 -1) -500029.0-1.0i)
+(num-test (complex -500029 -10) -500029.0-10.0i)
+(num-test (complex -500029 -1234) -500029.0-1234.0i)
+(num-test (complex -500029 -1234000000) -500029.0-1234000000.0i)
+(num-test (complex -500029 -2) -500029.0-2.0i)
+(num-test (complex -500029 -3) -500029.0-3.0i)
+(num-test (complex -500029 -362880) -500029.0-362880.0i)
+(num-test (complex -500029 -500029) -500029.0-500029.0i)
+(num-test (complex -500029 1) -500029.0+1.0i)
+(num-test (complex -500029 10) -500029.0+10.0i)
+(num-test (complex -500029 1234) -500029.0+1234.0i)
+(num-test (complex -500029 1234000000) -500029.0+1234000000.0i)
+(num-test (complex -500029 2) -500029.0+2.0i)
+(num-test (complex -500029 3) -500029.0+3.0i)
+(num-test (complex -500029 362880) -500029.0+362880.0i)
+(num-test (complex -500029 500029) -500029.0+500029.0i)
+(num-test (complex 0 -1) 0.0-1.0i)
+(num-test (complex 0 -10) 0.0-10.0i)
+(num-test (complex 0 -1234) 0.0-1234.0i)
+(num-test (complex 0 -1234000000) 0.0-1234000000.0i)
+(num-test (complex 0 -2) 0.0-2.0i)
+(num-test (complex 0 -3) 0.0-3.0i)
+(num-test (complex 0 -362880) 0.0-362880.0i)
+(num-test (complex 0 -500029) 0.0-500029.0i)
+(num-test (complex 0 0) 0)
+(num-test (complex 0 1) 0.0+1.0i)
+(num-test (complex 0 10) 0.0+10.0i)
+(num-test (complex 0 1234) 0.0+1234.0i)
+(num-test (complex 0 1234000000) 0.0+1234000000.0i)
+(num-test (complex 0 2) 0.0+2.0i)
+(num-test (complex 0 3) 0.0+3.0i)
+(num-test (complex 0 362880) 0.0+362880.0i)
+(num-test (complex 0 500029) 0.0+500029.0i)
+(num-test (complex 0.0 -0.00000001) 0.0-0.00000001i)
+(num-test (complex 0.0 -1.0) 0.0-1.0i)
+(num-test (complex 0.0 -1234.0) 0.0-1234.0i)
+(num-test (complex 0.0 -1234000000.0) 0.0-1234000000.0i)
+(num-test (complex 0.0 -2.71828182845905) 0.0-2.71828182845905i)
+(num-test (complex 0.0 -3.14159265358979) 0.0-3.14159265358979i)
+(num-test (complex 0.0 0.0) 0.0)
+(num-test (complex 0.0 0.00000001) 0.0+0.00000001i)
+(num-test (complex 0.0 1.0) 0.0+1.0i)
+(num-test (complex 0.0 1234.0) 0.0+1234.0i)
+(num-test (complex 0.0 1234000000.0) 0.0+1234000000.0i)
+(num-test (complex 0.0 2.71828182845905) 0.0+2.71828182845905i)
+(num-test (complex 0.0 pi) 0.0+3.14159265358979i)
+(num-test (complex 0.00000001 -0.00000001) 0.00000001-0.00000001i)
+(num-test (complex 0.00000001 -1.0) 0.00000001-1.0i)
+(num-test (complex 0.00000001 -1234.0) 0.00000001-1234.0i)
+(num-test (complex 0.00000001 -1234000000.0) 0.00000001-1234000000.0i)
+(num-test (complex 0.00000001 -2.71828182845905) 0.00000001-2.71828182845905i)
+(num-test (complex 0.00000001 -3.14159265358979) 0.00000001-3.14159265358979i)
+(num-test (complex 0.00000001 0.00000001) 0.00000001+0.00000001i)
+(num-test (complex 0.00000001 1.0) 0.00000001+1.0i)
+(num-test (complex 0.00000001 1234.0) 0.00000001+1234.0i)
+(num-test (complex 0.00000001 1234000000.0) 0.00000001+1234000000.0i)
+(num-test (complex 0.00000001 2.71828182845905) 0.00000001+2.71828182845905i)
+(num-test (complex 0.00000001 pi) 0.00000001+3.14159265358979i)
+(num-test (complex 1 -1) 1.0-1.0i)
+(num-test (complex 1 -10) 1.0-10.0i)
+(num-test (complex 1 -1234) 1.0-1234.0i)
+(num-test (complex 1 -1234000000) 1.0-1234000000.0i)
+(num-test (complex 1 -2) 1.0-2.0i)
+(num-test (complex 1 -3) 1.0-3.0i)
+(num-test (complex 1 -362880) 1.0-362880.0i)
+(num-test (complex 1 -500029) 1.0-500029.0i)
+(num-test (complex 1 1) 1.0+1.0i)
+(num-test (complex 1 10) 1.0+10.0i)
+(num-test (complex 1 1234) 1.0+1234.0i)
+(num-test (complex 1 1234000000) 1.0+1234000000.0i)
+(num-test (complex 1 2) 1.0+2.0i)
+(num-test (complex 1 3) 1.0+3.0i)
+(num-test (complex 1 362880) 1.0+362880.0i)
+(num-test (complex 1 500029) 1.0+500029.0i)
+(num-test (complex 1.0 -0.00000001) 1.0-0.00000001i)
+(num-test (complex 1.0 -1.0) 1.0-1.0i)
+(num-test (complex 1.0 -1234.0) 1.0-1234.0i)
+(num-test (complex 1.0 -1234000000.0) 1.0-1234000000.0i)
+(num-test (complex 1.0 -2.71828182845905) 1.0-2.71828182845905i)
+(num-test (complex 1.0 -3.14159265358979) 1.0-3.14159265358979i)
+(num-test (complex 1.0 0.00000001) 1.0+0.00000001i)
+(num-test (complex 1.0 1.0) 1.0+1.0i)
+(num-test (complex 1.0 1234.0) 1.0+1234.0i)
+(num-test (complex 1.0 1234000000.0) 1.0+1234000000.0i)
+(num-test (complex 1.0 2.71828182845905) 1.0+2.71828182845905i)
+(num-test (complex 1.0 pi) 1.0+3.14159265358979i)
+(num-test (complex 10 -1) 10.0-1.0i)
+(num-test (complex 10 -10) 10.0-10.0i)
+(num-test (complex 10 -1234) 10.0-1234.0i)
+(num-test (complex 10 -1234000000) 10.0-1234000000.0i)
+(num-test (complex 10 -2) 10.0-2.0i)
+(num-test (complex 10 -3) 10.0-3.0i)
+(num-test (complex 10 -362880) 10.0-362880.0i)
+(num-test (complex 10 -500029) 10.0-500029.0i)
+(num-test (complex 10 1) 10.0+1.0i)
+(num-test (complex 10 10) 10.0+10.0i)
+(num-test (complex 10 1234) 10.0+1234.0i)
+(num-test (complex 10 1234000000) 10.0+1234000000.0i)
+(num-test (complex 10 2) 10.0+2.0i)
+(num-test (complex 10 3) 10.0+3.0i)
+(num-test (complex 10 362880) 10.0+362880.0i)
+(num-test (complex 10 500029) 10.0+500029.0i)
+(num-test (complex 1234 -1) 1234.0-1.0i)
+(num-test (complex 1234 -10) 1234.0-10.0i)
+(num-test (complex 1234 -1234) 1234.0-1234.0i)
+(num-test (complex 1234 -1234000000) 1234.0-1234000000.0i)
+(num-test (complex 1234 -2) 1234.0-2.0i)
+(num-test (complex 1234 -3) 1234.0-3.0i)
+(num-test (complex 1234 -362880) 1234.0-362880.0i)
+(num-test (complex 1234 -500029) 1234.0-500029.0i)
+(num-test (complex 1234 1) 1234.0+1.0i)
+(num-test (complex 1234 10) 1234.0+10.0i)
+(num-test (complex 1234 1234) 1234.0+1234.0i)
+(num-test (complex 1234 1234000000) 1234.0+1234000000.0i)
+(num-test (complex 1234 2) 1234.0+2.0i)
+(num-test (complex 1234 3) 1234.0+3.0i)
+(num-test (complex 1234 362880) 1234.0+362880.0i)
+(num-test (complex 1234 500029) 1234.0+500029.0i)
+(num-test (complex 1234.0 -0.00000001) 1234.0-0.00000001i)
+(num-test (complex 1234.0 -1.0) 1234.0-1.0i)
+(num-test (complex 1234.0 -1234.0) 1234.0-1234.0i)
+(num-test (complex 1234.0 -1234000000.0) 1234.0-1234000000.0i)
+(num-test (complex 1234.0 -2.71828182845905) 1234.0-2.71828182845905i)
+(num-test (complex 1234.0 -3.14159265358979) 1234.0-3.14159265358979i)
+(num-test (complex 1234.0 0.00000001) 1234.0+0.00000001i)
+(num-test (complex 1234.0 1.0) 1234.0+1.0i)
+(num-test (complex 1234.0 1234.0) 1234.0+1234.0i)
+(num-test (complex 1234.0 1234000000.0) 1234.0+1234000000.0i)
+(num-test (complex 1234.0 2.71828182845905) 1234.0+2.71828182845905i)
+(num-test (complex 1234.0 pi) 1234.0+3.14159265358979i)
+(num-test (complex 1234000000 -1) 1234000000.0-1.0i)
+(num-test (complex 1234000000 -10) 1234000000.0-10.0i)
+(num-test (complex 1234000000 -1234) 1234000000.0-1234.0i)
+(num-test (complex 1234000000 -1234000000) 1234000000.0-1234000000.0i)
+(num-test (complex 1234000000 -2) 1234000000.0-2.0i)
+(num-test (complex 1234000000 -3) 1234000000.0-3.0i)
+(num-test (complex 1234000000 -362880) 1234000000.0-362880.0i)
+(num-test (complex 1234000000 -500029) 1234000000.0-500029.0i)
+(num-test (complex 1234000000 1) 1234000000.0+1.0i)
+(num-test (complex 1234000000 10) 1234000000.0+10.0i)
+(num-test (complex 1234000000 1234) 1234000000.0+1234.0i)
+(num-test (complex 1234000000 1234000000) 1234000000.0+1234000000.0i)
+(num-test (complex 1234000000 2) 1234000000.0+2.0i)
+(num-test (complex 1234000000 3) 1234000000.0+3.0i)
+(num-test (complex 1234000000 362880) 1234000000.0+362880.0i)
+(num-test (complex 1234000000 500029) 1234000000.0+500029.0i)
+(num-test (complex 1234000000.0 -0.00000001) 1234000000.0-0.00000001i)
+(num-test (complex 1234000000.0 -1.0) 1234000000.0-1.0i)
+(num-test (complex 1234000000.0 -1234.0) 1234000000.0-1234.0i)
+(num-test (complex 1234000000.0 -1234000000.0) 1234000000.0-1234000000.0i)
+(num-test (complex 1234000000.0 -2.71828182845905) 1234000000.0-2.71828182845905i)
+(num-test (complex 1234000000.0 -3.14159265358979) 1234000000.0-3.14159265358979i)
+(num-test (complex 1234000000.0 0.00000001) 1234000000.0+0.00000001i)
+(num-test (complex 1234000000.0 1.0) 1234000000.0+1.0i)
+(num-test (complex 1234000000.0 1234.0) 1234000000.0+1234.0i)
+(num-test (complex 1234000000.0 1234000000.0) 1234000000.0+1234000000.0i)
+(num-test (complex 1234000000.0 2.71828182845905) 1234000000.0+2.71828182845905i)
+(num-test (complex 1234000000.0 pi) 1234000000.0+3.14159265358979i)
+(num-test (complex 2 -1) 2.0-1.0i)
+(num-test (complex 2 -10) 2.0-10.0i)
+(num-test (complex 2 -1234) 2.0-1234.0i)
+(num-test (complex 2 -1234000000) 2.0-1234000000.0i)
+(num-test (complex 2 -2) 2.0-2.0i)
+(num-test (complex 2 -3) 2.0-3.0i)
+(num-test (complex 2 -362880) 2.0-362880.0i)
+(num-test (complex 2 -500029) 2.0-500029.0i)
+(num-test (complex 2 1) 2.0+1.0i)
+(num-test (complex 2 10) 2.0+10.0i)
+(num-test (complex 2 1234) 2.0+1234.0i)
+(num-test (complex 2 1234000000) 2.0+1234000000.0i)
+(num-test (complex 2 2) 2.0+2.0i)
+(num-test (complex 2 3) 2.0+3.0i)
+(num-test (complex 2 362880) 2.0+362880.0i)
+(num-test (complex 2 500029) 2.0+500029.0i)
+(num-test (complex 2.71828182845905 -0.00000001) 2.71828182845905-0.00000001i)
+(num-test (complex 2.71828182845905 -1.0) 2.71828182845905-1.0i)
+(num-test (complex 2.71828182845905 -1234.0) 2.71828182845905-1234.0i)
+(num-test (complex 2.71828182845905 -1234000000.0) 2.71828182845905-1234000000.0i)
+(num-test (complex 2.71828182845905 -2.71828182845905) 2.71828182845905-2.71828182845905i)
+(num-test (complex 2.71828182845905 -3.14159265358979) 2.71828182845905-3.14159265358979i)
+(num-test (complex 2.71828182845905 0.00000001) 2.71828182845905+0.00000001i)
+(num-test (complex 2.71828182845905 1.0) 2.71828182845905+1.0i)
+(num-test (complex 2.71828182845905 1234.0) 2.71828182845905+1234.0i)
+(num-test (complex 2.71828182845905 1234000000.0) 2.71828182845905+1234000000.0i)
+(num-test (complex 2.71828182845905 2.71828182845905) 2.71828182845905+2.71828182845905i)
+(num-test (complex 2.71828182845905 pi) 2.71828182845905+3.14159265358979i)
+(num-test (complex 3 -1) 3.0-1.0i)
+(num-test (complex 3 -10) 3.0-10.0i)
+(num-test (complex 3 -1234) 3.0-1234.0i)
+(num-test (complex 3 -1234000000) 3.0-1234000000.0i)
+(num-test (complex 3 -2) 3.0-2.0i)
+(num-test (complex 3 -3) 3.0-3.0i)
+(num-test (complex 3 -362880) 3.0-362880.0i)
+(num-test (complex 3 -500029) 3.0-500029.0i)
+(num-test (complex 3 1) 3.0+1.0i)
+(num-test (complex 3 10) 3.0+10.0i)
+(num-test (complex 3 1234) 3.0+1234.0i)
+(num-test (complex 3 1234000000) 3.0+1234000000.0i)
+(num-test (complex 3 2) 3.0+2.0i)
+(num-test (complex 3 3) 3.0+3.0i)
+(num-test (complex 3 362880) 3.0+362880.0i)
+(num-test (complex 3 500029) 3.0+500029.0i)
+(num-test (complex 3.14159265358979 -0.00000001) 3.14159265358979-0.00000001i)
+(num-test (complex 3.14159265358979 -1.0) 3.14159265358979-1.0i)
+(num-test (complex 3.14159265358979 -1234.0) 3.14159265358979-1234.0i)
+(num-test (complex 3.14159265358979 -1234000000.0) 3.14159265358979-1234000000.0i)
+(num-test (complex 3.14159265358979 -2.71828182845905) 3.14159265358979-2.71828182845905i)
+(num-test (complex 3.14159265358979 -3.14159265358979) 3.14159265358979-3.14159265358979i)
+(num-test (complex 3.14159265358979 0.00000001) 3.14159265358979+0.00000001i)
+(num-test (complex 3.14159265358979 1.0) 3.14159265358979+1.0i)
+(num-test (complex 3.14159265358979 1234.0) 3.14159265358979+1234.0i)
+(num-test (complex 3.14159265358979 1234000000.0) 3.14159265358979+1234000000.0i)
+(num-test (complex 3.14159265358979 2.71828182845905) 3.14159265358979+2.71828182845905i)
+(num-test (complex 3.14159265358979 pi) 3.14159265358979+3.14159265358979i)
+(num-test (complex 362880 -1) 362880.0-1.0i)
+(num-test (complex 362880 -10) 362880.0-10.0i)
+(num-test (complex 362880 -1234) 362880.0-1234.0i)
+(num-test (complex 362880 -1234000000) 362880.0-1234000000.0i)
+(num-test (complex 362880 -2) 362880.0-2.0i)
+(num-test (complex 362880 -3) 362880.0-3.0i)
+(num-test (complex 362880 -362880) 362880.0-362880.0i)
+(num-test (complex 362880 -500029) 362880.0-500029.0i)
+(num-test (complex 362880 1) 362880.0+1.0i)
+(num-test (complex 362880 10) 362880.0+10.0i)
+(num-test (complex 362880 1234) 362880.0+1234.0i)
+(num-test (complex 362880 1234000000) 362880.0+1234000000.0i)
+(num-test (complex 362880 2) 362880.0+2.0i)
+(num-test (complex 362880 3) 362880.0+3.0i)
+(num-test (complex 362880 362880) 362880.0+362880.0i)
+(num-test (complex 362880 500029) 362880.0+500029.0i)
+(num-test (complex 500029 -1) 500029.0-1.0i)
+(num-test (complex 500029 -10) 500029.0-10.0i)
+(num-test (complex 500029 -1234) 500029.0-1234.0i)
+(num-test (complex 500029 -1234000000) 500029.0-1234000000.0i)
+(num-test (complex 500029 -2) 500029.0-2.0i)
+(num-test (complex 500029 -3) 500029.0-3.0i)
+(num-test (complex 500029 -362880) 500029.0-362880.0i)
+(num-test (complex 500029 -500029) 500029.0-500029.0i)
+(num-test (complex 500029 1) 500029.0+1.0i)
+(num-test (complex 500029 10) 500029.0+10.0i)
+(num-test (complex 500029 1234) 500029.0+1234.0i)
+(num-test (complex 500029 1234000000) 500029.0+1234000000.0i)
+(num-test (complex 500029 2) 500029.0+2.0i)
+(num-test (complex 500029 3) 500029.0+3.0i)
+(num-test (complex 500029 362880) 500029.0+362880.0i)
+(num-test (complex 500029 500029) 500029.0+500029.0i)
+(num-test (complex 1/2 0) 1/2)
+(num-test (complex 1/2 1/2) 0.5+0.5i)
+(num-test (complex 0 1/2) 0+0.5i)
+
+(test (nan? (complex nan.0 nan.0)) #t)
+(test (nan? (complex nan.0 inf.0)) #t)
(if with-bignums
(begin
- (test (nan? (make-rectangular (bignum "0/0") 0)) #t)
- (test (nan? (make-rectangular 0 (bignum "0/0"))) #t)
- (num-test (make-rectangular 0 (* 2 most-positive-fixnum)) 0.0+1.8446744073709551614E19i)
- (num-test (- (make-rectangular 2e20 (* 2 most-positive-fixnum)) 0+1.8446744073709551614E19i) 2e20)
- (num-test (imag-part (make-rectangular 1.0 1180591620717411303424/717897987691852588770249)) 1.644511672909387396372163624382128338027E-3)
- (test (make-rectangular 0.0 0+92233720368547758081.0i) 'error)
+ (test (nan? (complex (bignum "0/0") 0)) #t)
+ (test (nan? (complex 0 (bignum "0/0"))) #t)
+ (num-test (complex 0 (* 2 most-positive-fixnum)) 0.0+1.8446744073709551614E19i)
+ (num-test (- (complex 2e20 (* 2 most-positive-fixnum)) 0+1.8446744073709551614E19i) 2e20)
+ (num-test (imag-part (complex 1.0 1180591620717411303424/717897987691852588770249)) 1.644511672909387396372163624382128338027E-3)
+ (test (complex 0.0 0+92233720368547758081.0i) 'error)
))
-(test (make-rectangular 0 0+0/0i) 'error)
-(test (make-rectangular 0+0/0i 0) 'error)
-(test (make-rectangular 1.23 1.23 1.23) 'error)
-(test (make-rectangular 1.23) 'error)
-(test (make-rectangular 1.23+1.0i 1.23+1.0i) 'error)
-(test (make-rectangular) 'error)
-(test (make-rectangular 1.0 1.0+0.1i) 'error)
-(test (make-rectangular 1.0+0.1i 1.0) 'error)
+(test (complex 0 0+0/0i) 'error)
+(test (complex 0+0/0i 0) 'error)
+(test (complex 1.23 1.23 1.23) 'error)
+(test (complex 1.23) 'error)
+(test (complex 1.23+1.0i 1.23+1.0i) 'error)
+(test (complex) 'error)
+(test (complex 1.0 1.0+0.1i) 'error)
+(test (complex 1.0+0.1i 1.0) 'error)
+(for-each
+ (lambda (x)
+ (test (complex x 0-i) 'error))
+ (list 0 1 1/2 1.0 0.0 0+i))
+(for-each
+ (lambda (x)
+ (test (complex 0-i x) 'error))
+ (list 0 1 pi (- pi) 1/2 0.0 1.0 0+i))
+(for-each
+ (lambda (arg)
+ (test (complex arg 0.0) 'error)
+ (test (complex 0.0 arg) 'error)
+ (test (complex arg nan.0) 'error)
+ (test (complex nan.0 arg) 'error)
+ (test (complex arg inf.0) 'error)
+ (test (complex inf.0 arg) 'error)
+ (test (complex 1 arg) 'error)
+ (test (complex 1/2 arg) 'error)
+ (test (complex 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
@@ -33567,6 +48667,28 @@ abs 1 2
(test (make-polar) 'error)
(test (make-polar 1.0 1.0+0.1i) 'error)
(test (make-polar 1.0+0.1i 0.0) 'error)
+(for-each
+ (lambda (x)
+ (test (make-polar x 0-i) 'error))
+ (list 0 1 1/2 1.0 0.0 0+i))
+(for-each
+ (lambda (x)
+ (test (make-polar 0-i x) 'error))
+ (list 0 1 1/2 pi (- pi) 0.0 1.0 0+i))
+
+(for-each
+ (lambda (arg)
+ (test (make-polar arg 0.0) 'error)
+ (test (make-polar 0.0 arg) 'error)
+ (test (make-polar 1 arg) 'error)
+ (test (make-polar 1/2 arg) 'error)
+ (test (make-polar 1+i arg) 'error)
+ (test (make-polar arg nan.0) 'error)
+ (test (make-polar nan.0 arg) 'error)
+ (test (make-polar arg inf.0) 'error)
+ (test (make-polar inf.0 arg) 'error))
+ (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
@@ -33760,7 +48882,7 @@ abs 1 2
(num-test (abs pi) pi)
(num-test (abs -2.225073858507201399999999999999999999996E-308) 2.225073858507201399999999999999999999996E-308)
-(num-test (abs -9223372036854775808) 9223372036854775808)
+(num-test (abs -9223372036854775808) (if with-bignums 9223372036854775808 9223372036854775807)) ; changed 28-Apr-15
(num-test (abs 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16)
(num-test (abs 9223372036854775807) 9223372036854775807)
(test (= (abs (+ most-negative-fixnum 1)) most-positive-fixnum) #t)
@@ -33815,7 +48937,16 @@ abs 1 2
(test (abs) 'error)
(test (nan? (abs 1/0)) #t)
(test (positive? (abs (real-part (log 0.0)))) #t)
-(test (abs 1.0+0.1i) 'error)
+(if (not pure-s7) (test (abs 1.0+0.1i) 'error))
+
+;; an optimizer bug
+(let () (define (t1) (let ((a 1+i) (b 0+i)) (abs (- a b)))) (num-test (t1) 1.0))
+
+(for-each
+ (lambda (arg)
+ (test (abs arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
@@ -33823,9 +48954,9 @@ abs 1 2
;;; magnitude
;;; --------------------------------------------------------------------------------
-(num-test (magnitude (make-rectangular (expt 2 62) (expt 2 62))) 6.521908912666391106174785903126254184439E18)
-(num-test (magnitude (make-rectangular most-positive-fixnum most-negative-fixnum)) 1.30438178253327822116424650250659608445E19)
-(num-test (magnitude (make-rectangular most-positive-fixnum most-positive-fixnum)) 1.304381782533278221093535824387941332006E19)
+(num-test (magnitude (complex (expt 2 62) (expt 2 62))) 6.521908912666391106174785903126254184439E18)
+(num-test (magnitude (complex most-positive-fixnum most-negative-fixnum)) 1.30438178253327822116424650250659608445E19)
+(num-test (magnitude (complex most-positive-fixnum most-positive-fixnum)) 1.304381782533278221093535824387941332006E19)
(num-test (magnitude -0) 0)
(num-test (magnitude -0.0) 0.0)
(num-test (magnitude -0.0+0.00000001i) 0.00000001)
@@ -34299,7 +49430,8 @@ abs 1 2
(num-test (magnitude most-positive-fixnum) most-positive-fixnum)
(num-test (magnitude pi) pi)
(num-test (magnitude -2.225073858507201399999999999999999999996E-308) 2.225073858507201399999999999999999999996E-308)
-(num-test (magnitude -9223372036854775808) 9223372036854775808)
+(if (not with-bignums)
+ (num-test (magnitude -9223372036854775808) 9223372036854775807)) ; changed 28-Apr-15
(num-test (magnitude 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16)
(num-test (magnitude 9223372036854775807) 9223372036854775807)
@@ -34317,7 +49449,7 @@ abs 1 2
(if with-bignums
(begin
- (num-test (magnitude (make-rectangular (expt 2 63) (expt 2 63))) 1.304381782533278221234957180625250836888E19)
+ (num-test (magnitude (complex (expt 2 63) (expt 2 63))) 1.304381782533278221234957180625250836888E19)
(num-test (magnitude most-negative-fixnum) 9223372036854775808)
(num-test (magnitude 1e400+1e400i) 1.414213562373095048801688724209698078569E400)
(num-test (magnitude .1e400+.1e400i) 1.41421356237309504880168872420969807857E399)
@@ -34337,6 +49469,13 @@ abs 1 2
(test (magnitude 1.0+23.0i 1.0+23.0i) 'error)
(test (magnitude) 'error)
+(for-each
+ (lambda (arg)
+ (test (magnitude arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+;;; (magnitude -9223372036854775808) -> -9223372036854775808?
@@ -34806,15 +49945,22 @@ abs 1 2
(if with-bignums
(begin
(num-test (angle -1.797693134862315699999999999999999999998E308) 3.141592653589793238462643383279502884195E0)
- (num-test (angle (make-rectangular 1.0 1.0)) (angle (make-rectangular (expt 2 70) (expt 2 70))))
+ (num-test (angle (complex 1.0 1.0)) (angle (complex (expt 2 70) (expt 2 70))))
(num-test (angle (make-polar 1000000000000000000000000.0 (* .1 pi))) (* .1 pi))
- (num-test (angle (make-rectangular most-positive-fixnum most-positive-fixnum)) 7.853981633974483096156608458198757210488E-1)
+ (num-test (angle (complex most-positive-fixnum most-positive-fixnum)) 7.853981633974483096156608458198757210488E-1)
))
(test (angle) 'error)
(test (angle "hi") 'error)
(test (angle 1.0+23.0i 1.0+23.0i) 'error)
+(for-each
+ (lambda (arg)
+ (test (angle arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
;;; --------------------------------------------------------------------------------
@@ -34850,9 +49996,10 @@ abs 1 2
(num-test (integer-length -127) 7)
(num-test (integer-length -128) 7)
(num-test (integer-length -129) 8)
+(when (or (not with-bignums) (not pure-s7))
+ (num-test (integer-length most-negative-fixnum) 63)
+ (num-test (integer-length -9223372036854775808) 63))
(num-test (integer-length most-positive-fixnum) 63)
-(num-test (integer-length most-negative-fixnum) 63)
-(num-test (integer-length -9223372036854775808) 63)
(num-test (integer-length 9223372036854775807) 63)
(test (integer-length) 'error)
@@ -34860,19 +50007,27 @@ abs 1 2
(test (integer-length 1/2) 'error)
(test (integer-length 1.2) 'error)
(test (integer-length 1+2i) 'error)
+(test (integer-length 1/0) 'error)
+(test (integer-length (log 0)) 'error)
(if with-bignums
(begin
(test (integer-length (bignum "100000000000000000000000000000000000")) (ceiling (log (bignum "100000000000000000000000000000000000") 2)))
(num-test (integer-length (+ (expt 2 48) (expt 2 46))) 49)
(num-test (integer-length (ash 1 64)) 65)
- (num-test (integer-length 9223372036854775808) 64)
+ (num-test (integer-length 9223372036854775808) 64) ; ??
(num-test (integer-length (* 4 most-positive-fixnum)) 65)
(num-test (integer-length (* most-positive-fixnum most-positive-fixnum)) 126)
(test (integer-length 0+92233720368547758081.0i) 'error)
(test (integer-length 92233720368547758081.0) 'error)
))
+(for-each
+ (lambda (arg)
+ (test (integer-length arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -34885,7 +50040,7 @@ abs 1 2
(test (cadr val1) (cadr val2))
(test (caddr val1) (caddr val2))
(test (< (abs (- (car val1) (car val2))) 1000) #t))
-
+
(idf-test (integer-decode-float 0.0) '(0 0 1))
(idf-test (integer-decode-float -0.0) '(0 0 1))
(idf-test (integer-decode-float 1.0) '(4503599627370496 -52 1))
@@ -34931,7 +50086,7 @@ abs 1 2
(let ((val (integer-decode-float 1.0e-307)))
(if (and (not (equal? val '(5060056332682765 -1072 1)))
(not (equal? val '(5060056332682766 -1072 1))))
- (format #t ";(integer-decode-float 1.0e-307) got ~A?~%" val)))
+ (format-logged #t ";(integer-decode-float 1.0e-307) got ~A?~%" val)))
(test (integer-decode-float (/ 1.0e-307 100.0e0)) '(4706001880677807 -1075 1)) ; denormal
(test (integer-decode-float (/ (log 0.0))) '(6755399441055744 972 -1)) ; nan
@@ -34943,19 +50098,22 @@ abs 1 2
(test (integer-decode-float (expt 2.0 52)) (list #x10000000000000 0 1))
(test (integer-decode-float 1e23) '(5960464477539062 24 1))
-;(test (integer-decode-float 1/0) '(6755399441055744 972 1))
-;(test (integer-decode-float (real-part (log 0))) '(4503599627370496 972 -1))
-
(if with-bignums
(begin
(test (integer-decode-float 2.225e-308) '(9007049763458157 -1075 1))
(test (integer-decode-float (bignum "3.1")) (integer-decode-float 3.1))
- (test (integer-decode-float (bignum "1E430")) 'error)
- (test (integer-decode-float (bignum "1E310")) 'error)
- (test (integer-decode-float (bignum "-1E310")) 'error)
- ;(test (integer-decode-float (bignum "1/0")) 'error) -- see above: (6755399441055744 972 1)
+ (test (integer-decode-float (bignum "1E430")) '(4503599627370496 972 1))
+ (test (integer-decode-float (bignum "1E310")) '(4503599627370496 972 1))
+ (test (integer-decode-float (bignum "-1E310")) '(4503599627370496 972 -1))
(test (integer-decode-float 0+92233720368547758081.0i) 'error)
(test (integer-decode-float 92233720368547758081/123) 'error)
+ )
+ (begin
+ (test (integer-decode-float 1/0) '(6755399441055744 972 1)) ; nan
+ (test (integer-decode-float (real-part (log 0))) '(4503599627370496 972 -1)) ; -inf
+ (test (integer-decode-float (- (real-part (log 0)))) '(4503599627370496 972 1)) ; inf
+ (test (integer-decode-float (/ (real-part (log 0)) (real-part (log 0)))) '(6755399441055744 972 -1)) ; -nan
+ (test (integer-decode-float (- (/ (real-part (log 0)) (real-part (log 0))))) '(6755399441055744 972 1)) ; nan
))
(do ((i 0 (+ i 1)))
@@ -34971,7 +50129,7 @@ abs 1 2
(for-each
(lambda (arg)
(test (integer-decode-float arg) 'error))
- (list -1 0 #\a '#(1 2 3) 2/3 1.5+0.3i 1+i '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (list -1 0 #\a #(1 2 3) 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
(test (integer-decode-float 1.0 1.0) 'error)
@@ -34987,9 +50145,9 @@ abs 1 2
(lambda (arg)
(let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
(if (not (equal? val 'error))
- (format #t ";(~A ~A) -> ~A?~%" op arg val))))
- (list "hi" _ht_ '() '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 3/4 3.1+i abs #\f (lambda (a) (+ a 1)))))
- (list logior logand lognot logxor ash integer-length))
+ (format-logged #t ";(~A ~A) -> ~A?~%" op arg val))))
+ (list "hi" _ht_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 3/4 3.1+i abs #\f (lambda (a) (+ a 1)))))
+ (list logior logand lognot logxor logbit? ash integer-length))
(for-each
(lambda (op)
@@ -34997,9 +50155,9 @@ abs 1 2
(lambda (arg)
(let ((val (catch #t (lambda () (op 1 arg)) (lambda args 'error))))
(if (not (equal? val 'error))
- (format #t ";(~A ~A) -> ~A?~%" op arg val))))
- (list "hi" _ht_ '() '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 -1/2 1+i abs #\f (lambda (a) (+ a 1)))))
- (list logior logand logxor lognot))
+ (format-logged #t ";(~A ~A) -> ~A?~%" op arg val))))
+ (list "hi" _ht_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 -1/2 1+i abs #\f (lambda (a) (+ a 1)))))
+ (list logior logand logxor lognot logbit?))
(num-test (lognot 0) -1)
@@ -35080,6 +50238,7 @@ abs 1 2
+
;;; --------------------------------------------------------------------------------
;;; logand
;;; --------------------------------------------------------------------------------
@@ -35133,7 +50292,7 @@ abs 1 2
(test (logand 1/2 0) 'error)
(test (logand 0 #\a) 'error)
(test (logand 0 "hi") 'error)
-(test (logand #f '()) 'error)
+(test (logand #f ()) 'error)
@@ -35156,6 +50315,8 @@ abs 1 2
;; to get the bits that are on in just 1 argument? (logxor (logxor a b c) (logand a b c))
(num-test (logxor 1 2 3 4) 4)
(num-test (logxor 1 3 5 7) 0)
+(num-test (logxor -1 8 8) -1)
+(num-test (logxor 8 8 8) 8)
(num-test (logxor -1 most-positive-fixnum) most-negative-fixnum)
(num-test (logxor most-negative-fixnum most-positive-fixnum) -1)
(num-test (logxor -100 -100 -100) -100)
@@ -35205,7 +50366,7 @@ abs 1 2
((= len 3)
(logxor (apply logxor ints) (apply logand ints)))
(#t
- (do ((iors '())
+ (do ((iors ())
(i 0 (+ i 1)))
((= i len) (apply logior iors))
(let ((cur (ints i)))
@@ -35249,30 +50410,30 @@ abs 1 2
((= i 10))
(let ((len (+ 1 (random 10)))
- (ints '()))
+ (ints ()))
(do ((k 0 (+ k 1)))
((= k len))
(set! ints (cons (- (random 1000) 500) ints)))
(let ((result (apply log-1-of ints)))
- ;;(format #t "(test (log-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
+ ;;(format-logged #t "(test (log-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
(do ((b 0 (+ b 1)))
((= b top-checked-bit))
(let ((counts 0))
(for-each
(lambda (int)
- (if (not (zero? (logand int (ash 1 b))))
+ (if (logbit? int b) ;(not (zero? (logand int (ash 1 b))))
(set! counts (+ counts 1))))
ints)
- (if (not (zero? (logand result (ash 1 b))))
+ (if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
(if (not (= counts 1))
- (format #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
+ (format-logged #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
(if (= counts 1)
- (format #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts = 1 but we're off]~%" ints result (ash 1 b)))))))))
+ (format-logged #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts = 1 but we're off]~%" ints result (ash 1 b)))))))))
-#|
+
(define (log-n-1-of . ints) ; bits on in exactly n-1 of ints
(let ((len (length ints)))
(cond ((= len 0)
@@ -35284,7 +50445,7 @@ abs 1 2
((= len 3)
(logand (lognot (apply logxor ints)) (apply logior ints)))
(#t
- (do ((iors '())
+ (do ((iors ())
(i 0 (+ i 1)))
((= i len) (apply logior iors))
(let ((cur (ints i)))
@@ -35335,28 +50496,28 @@ abs 1 2
((= i 10))
(let ((len (+ 1 (random 10)))
- (ints '()))
+ (ints ()))
(do ((k 0 (+ k 1)))
((= k len))
(set! ints (cons (- (random 1000) 500) ints)))
(let ((result (apply log-n-1-of ints)))
- ;;(format #t "(test (log-n-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
+ ;;(format-logged #t "(test (log-n-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result)
(do ((b 0 (+ b 1)))
((= b top-checked-bit))
(let ((counts 0))
(for-each
(lambda (int)
- (if (not (zero? (logand int (ash 1 b))))
+ (if (logbit? int b) ;(not (zero? (logand int (ash 1 b))))
(set! counts (+ counts 1))))
ints)
- (if (not (zero? (logand result (ash 1 b))))
+ (if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
(if (not (= counts (- len 1)))
- (format #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
+ (format-logged #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts))
(if (and (> len 1) (= counts (- len 1)))
- (format #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" ints result (ash 1 b) counts))))))))
+ (format-logged #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" ints result (ash 1 b) counts))))))))
(define (log-n-of n . ints) ; bits on in exactly n of ints
(let ((len (length ints)))
@@ -35381,7 +50542,7 @@ abs 1 2
;; now n is between 2 and len-2, and len is 3 or more
;; I think it would be less inefficient here to choose either this or the n-1 case based on n<=len/2
(#t
- (do ((1s '())
+ (do ((1s ())
(prev ints)
(i 0 (+ i 1)))
((= i len) (apply logior 1s))
@@ -35389,7 +50550,7 @@ abs 1 2
(if (= i 0)
(set! 1s (cons (logand cur (apply log-n-of (- n 1) (cdr ints))) 1s))
(let* ((mid (cdr prev))
- (nxt (if (= i (- len 1)) '() (cdr mid))))
+ (nxt (if (= i (- len 1)) () (cdr mid))))
(set! (cdr prev) nxt)
(set! 1s (cons (logand cur (apply log-n-of (- n 1) ints)) 1s))
(set! (cdr prev) mid)
@@ -35459,7 +50620,7 @@ abs 1 2
((= i 10))
(let ((len (+ 1 (random 10)))
- (ints '())
+ (ints ())
(n (random 5)))
(do ((k 0 (+ k 1)))
@@ -35467,23 +50628,23 @@ abs 1 2
(set! ints (cons (- (random 1000) 500) ints)))
(let ((result (apply log-n-of n ints)))
- ;;(format #t "(test (log-n-of ~D ~{~D~^ ~}) #b~B) ; (~D)~%" n ints result result)
+ ;;(format-logged #t "(test (log-n-of ~D ~{~D~^ ~}) #b~B) ; (~D)~%" n ints result result)
(do ((b 0 (+ b 1)))
((= b top-checked-bit))
(let ((counts 0))
(for-each
(lambda (int)
- (if (not (zero? (logand int (ash 1 b))))
+ (if (logbit? int b) ;(not (zero? (logand int (ash 1 b))))
(set! counts (+ counts 1))))
ints)
- (if (not (zero? (logand result (ash 1 b))))
+ (if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
(if (not (= counts n))
- (format #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
+ (format-logged #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
(if (and (> len 1) (= counts n))
- (format #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts))))))))
-|#
+ (format-logged #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts))))))))
+
(define (simple-log-n-of n . ints) ; bits on in exactly n of ints
(let ((len (length ints)))
@@ -35500,7 +50661,7 @@ abs 1 2
(if (= i 0)
(set! 1s (logior 1s (logand cur (apply simple-log-n-of (- n 1) (cdr ints)))))
(let* ((mid (cdr prev))
- (nxt (if (= i (- len 1)) '() (cdr mid))))
+ (nxt (if (= i (- len 1)) () (cdr mid))))
(set! (cdr prev) nxt)
(set! 1s (logior 1s (logand cur (apply simple-log-n-of (- n 1) ints))))
(set! (cdr prev) mid)
@@ -35517,7 +50678,7 @@ abs 1 2
((= i 10))
(let ((len (+ 1 (random 10)))
- (ints '())
+ (ints ())
(n (random 5)))
(do ((k 0 (+ k 1)))
@@ -35530,15 +50691,117 @@ abs 1 2
(let ((counts 0))
(for-each
(lambda (int)
- (if (not (zero? (logand int (ash 1 b))))
+ (if (logbit? int b) ;(not (zero? (logand int (ash 1 b))))
(set! counts (+ counts 1))))
ints)
- (if (not (zero? (logand result (ash 1 b))))
+ (if (logbit? result b) ;(not (zero? (logand result (ash 1 b))))
(if (not (= counts n))
- (format #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
+ (format-logged #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts))
(if (and (> len 1) (= counts n))
- (format #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts)))))))))
+ (format-logged #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts)))))))))
+
+(let () ; from sbcl/contrib/sb-rotate-byte
+ (define (rotate-byte count bytespec integer) ; logrot?
+ (let* ((size (car bytespec))
+ (count (- count (* (round (/ count size)) size)))
+ (mask (ash (- (ash 1 size) 1) (cdr bytespec)))
+ (field (logand mask integer)))
+ (logior (logand integer (lognot mask))
+ (logand mask
+ (logior (ash field count)
+ (ash field ((if (positive? count) - +) count size)))))))
+
+ (test (rotate-byte 6 (cons 8 0) -3) -129)
+ (test (rotate-byte 3 (cons 32 0) 3) 24)
+ (test (rotate-byte 3 (cons 16 0) 3) 24)
+ (test (rotate-byte 5 (cons 32 0) 5) 160)
+ (test (rotate-byte 5 (cons 32 0) (ash 1 26)) (ash 1 31)))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; logbit?
+;;; --------------------------------------------------------------------------------
+
+(test (logbit? 0 1) #f)
+(test (logbit? 0 0) #f)
+(test (logbit? 0 -1) 'error)
+(test (logbit? #b101 1) #f)
+(test (logbit? #b101 0) #t)
+(test (logbit? 1 3 6) 'error)
+(test (logbit? -1 3) #t)
+(test (logbit? -1 0) #t)
+(test (logbit? -6 0) #f)
+(test (logbit? -6 3) #t)
+(test (logbit? 4 1) #f)
+(test (logbit? 1 1) #f)
+(test (logbit? 1 0) #t)
+(test (logbit? -9223372036854775808 1) #f)
+(test (logbit? most-positive-fixnum 31) #t)
+(test (logbit? most-positive-fixnum 68) #f)
+(test (logbit? most-positive-fixnum 63) #f)
+(test (logbit? most-positive-fixnum 62) #t)
+(test (logbit? (ash 1 12) 12) #t)
+(test (logbit? (ash 1 12) 11) #f)
+(test (logbit? (ash 1 32) 32) #t)
+(test (logbit? (ash 1 31) 31) #t)
+(test (logbit? (ash 1 31) 30) #f)
+(test (logbit? (ash 1 31) 32) #f)
+(test (logbit? (ash 1 32) 31) #f)
+(test (logbit? (ash 1 62) 62) #t)
+(test (logbit? (ash 1 62) 61) #f)
+(test (logbit? -1 most-negative-fixnum) 'error)
+(test (logbit? most-negative-fixnum 63) #t)
+(test (logbit? most-negative-fixnum 62) #f)
+(test (logbit? -31 63) #t)
+(test (logbit? 1 most-positive-fixnum) #f)
+(test (logbit? 0 most-positive-fixnum) #f)
+(test (logbit? -1 most-positive-fixnum) #t)
+(test (logbit? -1 64) #t)
+(test (logbit? 1 64) #f)
+
+;;; (test (logbit? most-negative-fixnum most-positive-fixnum) #t) ;??
+(test (logbit? most-negative-fixnum most-negative-fixnum) 'error)
+(test (logbit? most-positive-fixnum most-positive-fixnum) #f)
+(test (logbit? (ash most-negative-fixnum 1) 1) #f)
+
+(if with-bignums
+ (begin
+ (test (logbit? (ash 1 64) 64) #t)
+ (test (logbit? (ash 1 64) 63) #f)
+ (test (logbit? most-negative-fixnum 63) #t)
+ (test (logbit? (bignum "-1") 64) #t)
+ ))
+
+(test (logbit? 0 1.0) 'error)
+(test (logbit? 1+i) 'error)
+(test (logbit? 1+i 0) 'error)
+(test (logbit? 0 1/2) 'error)
+(test (logbit? 1.0 0) 'error)
+(test (logbit? 1/2 0) 'error)
+(test (logbit? -1/2 0) 'error)
+(test (logbit? 1/2 123123123) 'error)
+(test (logbit? 0 #\a) 'error)
+(test (logbit? 0 "hi") 'error)
+(test (logbit? #f ()) 'error)
+(test (logbit?) 'error)
+(test (logbit? 0) 'error)
+
+(test (logbit? -1/9223372036854775807 7) 'error)
+(test (logbit? -1/9223372036854775807 123123123) 'error)
+(test (logbit? 1/0 123123123) 'error)
+(test (logbit? (c-pointer 0) 123123123) 'error)
+
+(do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((x (random most-positive-fixnum)) ; or most-negative-fixnum
+ (index (random 63)))
+ (let ((on? (logbit? x index))
+ (ash? (not (zero? (logand x (ash 1 index))))))
+ (if (not (eq? on? ash?))
+ (format-logged #t "(logbit? ~A ~A): ~A ~A~%" x index on? ash?)))))
+
@@ -35561,6 +50824,7 @@ abs 1 2
(num-test (ash -129876 -1026) -1)
(num-test (ash -2 -3) -1)
(num-test (ash -3 -3) -1)
+(num-test (ash -3 3) -24)
(num-test (ash -31 -100) -1)
(num-test (ash -31 -20) -1)
(num-test (ash -31 -60) -1)
@@ -35589,6 +50853,11 @@ abs 1 2
(num-test (ash 2 -2) 0)
(test (> (ash 1 30) 1) #t)
(test (> (ash 1 62) 1) #t)
+(test (ash most-positive-fixnum -2) 2305843009213693951)
+(test (ash most-positive-fixnum -62) 1)
+(test (ash (ash most-negative-fixnum -2) 2) most-negative-fixnum)
+;; (test (ash most-positive-fixnum 2) 'error) if not bignums?
+(num-test (ash 1000000000 -100000000000) 0)
(do ((i 0 (+ i 1)))
((= i 15))
@@ -35602,6 +50871,7 @@ abs 1 2
(if with-bignums
(begin
(num-test (ash 1 48) 281474976710656)
+ (num-test (ash most-positive-fixnum 2) 36893488147419103228)
(num-test (ash 281474976710656 -48) 1)
(num-test (ash -100000000000000000000000000000000 -100) -79)
;; (floor (/ -100000000000000000000000000000000 (expt 2 100))) = -79
@@ -35629,7 +50899,7 @@ abs 1 2
(lambda (arg)
(test (ash 1 arg) 'error)
(test (ash arg 1) 'error))
- (list #\a #f _ht_ '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (list #\a #f _ht_ _null_ _c_obj_ #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
(let ()
;; fails if x=0: (define (2^n? x) (zero? (logand x (- x 1))))
@@ -35663,6 +50933,28 @@ abs 1 2
(test (let ((x 1) (y 321)) (<=> x y) (list x y)) (list 321 1))
)
+(let ()
+
+ (define (bit-reverse int)
+ ;; from "Hacker's Delight" Henry Warren p101, but 64 bit
+ (let ((x int))
+ (set! x (logior (ash (logand x #x5555555555555555) 1)
+ (ash (logand x #xAAAAAAAAAAAAAAAA) -1)))
+ (set! x (logior (ash (logand x #x3333333333333333) 2)
+ (ash (logand x #xCCCCCCCCCCCCCCCC) -2)))
+ (set! x (logior (ash (logand x #x0F0F0F0F0F0F0F0F) 4)
+ (ash (logand x #xF0F0F0F0F0F0F0F0) -4)))
+ (set! x (logior (ash (logand x #x00FF00FF00FF00FF) 8)
+ (ash (logand x #xFF00FF00FF00FF00) -8)))
+ (set! x (logior (ash (logand x #x0000FFFF0000FFFF) 16)
+ (ash (logand x #xFFFF0000FFFF0000) -16)))
+ (logior (ash (logand x #x00000000FFFFFFFF) 32)
+ (ash (logand x #xFFFFFFFF00000000) -32))))
+
+ ;(let ((x (ash (bit-reverse #x01234566) -32))) (num-test x 1721943168))
+ )
+
+
;; from CL spec
(test (let ((str ""))
(let ((show (lambda (m x y)
@@ -35678,6 +50970,18 @@ abs 1 2
"[m = #o007750, x = #o452576, y = #o317407] [m = #o007750, x = #o457426, y = #o312557] ")
+#|
+ (DEFUN HAULONG (ARG)
+ (INTEGER-LENGTH (ABS ARG)))
+
+ (DEFUN HAIPART (X N)
+ (SETQ X (ABS X))
+ (IF (MINUSP N)
+ (LOGAND X (- (ASH 1 (- N)) 1))
+ (ASH X (MIN (- N (HAULONG X)) 0))))
+|#
+
+
;;; --------------------------------------------------------------------------------
@@ -35737,6 +51041,7 @@ abs 1 2
(num-test (truncate 9223372036854775807) 9223372036854775807)
(num-test (truncate most-negative-fixnum) most-negative-fixnum)
(num-test (truncate most-positive-fixnum) most-positive-fixnum)
+(num-test (truncate 1+0i) 1)
(if with-bignums
(begin
@@ -35775,8 +51080,8 @@ abs 1 2
(num-test (truncate 200000000000000000000000000000000/3) 66666666666666666666666666666666)
(num-test (truncate -200000000000000000000000000000000/3) -66666666666666666666666666666666)
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 512)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 512)
(test (= (truncate (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301 1.0))
(truncate (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902))) #f)
@@ -35811,12 +51116,19 @@ abs 1 2
(test (= (truncate (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0))
(truncate (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #f)
- (set! (bignum-precision) old-prec))
+ (set! (*s7* 'bignum-precision) old-prec))
))
(test (truncate) 'error)
(test (truncate 1.23+1.0i) 'error)
+(for-each
+ (lambda (arg)
+ (test (truncate arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
;;; --------------------------------------------------------------------------------
@@ -35889,7 +51201,12 @@ abs 1 2
(num-test (floor 9007199254740993.95) 9007199254740993)
(num-test (floor (+ 0.995 (expt 2.0 46))) 70368744177664)
(num-test (floor (+ 0.9995 (expt 2.0 45))) 35184372088832)
- ))
+ )
+ (begin
+ (test (floor 1e308) 'error)
+ (test (floor 1e19) 'error)
+ (test (floor -1e308) 'error)
+ (test (floor -1e19) 'error)))
(test (= (floor (* 111738283365989051/177100989030047175 1.0)) (floor 130441933147714940/206745572560704147)) #t)
(test (= (floor (* 114243/80782 114243/80782 1.0)) (floor (* 275807/195025 275807/195025))) #f)
@@ -35952,6 +51269,18 @@ abs 1 2
(test (floor 1.23+1.0i) 'error)
(test (floor 1.23 1.23) 'error)
+(let ()
+ (define (f1 x) (floor (/ x 3)))
+ (test (f1 6) 2)
+ (test (f1 7) 2)
+ (test (f1 7.3) 2))
+
+(for-each
+ (lambda (arg)
+ (test (floor arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -36018,12 +51347,25 @@ abs 1 2
(num-test (ceiling 9223372036854775807) 9223372036854775807)
(num-test (ceiling most-negative-fixnum) most-negative-fixnum)
(num-test (ceiling most-positive-fixnum) most-positive-fixnum)
+(num-test (ceiling 8922337203685477.9) 8922337203685478)
(if with-bignums
(begin
(num-test (ceiling 8388608.0000000005) 8388609)
(num-test (ceiling 8388609.0000000005) 8388610)
- (num-test (ceiling 8388607.9999999995) 8388608)))
+ (num-test (ceiling 8388607.9999999995) 8388608)
+ (num-test (ceiling 9223372036854775806.9) 9223372036854775807)
+ )
+ (begin
+ (test (ceiling 1e308) 'error)
+ (test (ceiling 1e19) 'error)
+ (test (ceiling -1e308) 'error)
+ (test (ceiling -1e19) 'error)
+
+ ;; but unfortunately (ceiling 9223372036854775806.9) => -9223372036854775808
+ ;; (ceiling 922337203685477580.9) => 922337203685477632
+ ;; (ceiling 9223372036854770.9) => 9223372036854770
+ ))
(test (= (ceiling (* 111738283365989051/177100989030047175 1.0)) (ceiling 130441933147714940/206745572560704147)) #t)
(test (= (ceiling (* 114243/80782 114243/80782 1.0)) (ceiling (* 275807/195025 275807/195025))) #f)
@@ -36097,6 +51439,13 @@ abs 1 2
(test (ceiling 1.23+1.0i) 'error)
(test (ceiling 1.23 1.23) 'error)
+(for-each
+ (lambda (arg)
+ (test (ceiling arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
;;; --------------------------------------------------------------------------------
@@ -36169,7 +51518,12 @@ abs 1 2
(if with-bignums
(begin
(num-test (round 9007199254740992.51) 9007199254740993)
- (num-test (round 9007199254740993.99) 9007199254740994)))
+ (num-test (round 9007199254740993.99) 9007199254740994))
+ (begin
+ (test (round 1e308) 'error)
+ (test (round 1e19) 'error)
+ (test (round -1e308) 'error)
+ (test (round -1e19) 'error)))
(test (= (round (* 111738283365989051/177100989030047175 1.0)) (round 130441933147714940/206745572560704147)) #t)
(test (= (round (* 114243/80782 114243/80782 1.0)) (round (* 275807/195025 275807/195025))) #t)
@@ -36190,6 +51544,12 @@ abs 1 2
(test (round 1.23+1.0i) 'error)
(test (round) 'error)
+(for-each
+ (lambda (arg)
+ (test (round arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(num-test (round 400000000000000000/800000000000000001) 0)
(num-test (round 400000000000000000/799999999999999999) 1)
@@ -36231,22 +51591,22 @@ abs 1 2
(round (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729))) #t)
))
-(test (equal? (let ((vals '()))
+(test (equal? (let ((vals ()))
(do ((k 1/3 (+ k 1/3))) ((> k 2) (reverse vals))
(set! vals (cons (round k) vals))))
(list 0 1 1 1 2 2))
#t)
-(test (equal? (let ((vals '()))
+(test (equal? (let ((vals ()))
(do ((k 1/3 (+ k 1/3))) ((> k 2) (reverse vals))
(set! vals (cons (round (- k)) vals))))
(list 0 -1 -1 -1 -2 -2))
#t)
-(test (equal? (let ((vals '()))
+(test (equal? (let ((vals ()))
(do ((k 1/2 (+ k 1/2))) ((> k 3) (reverse vals))
(set! vals (cons (round k) vals))))
(list 0 1 2 2 2 3))
#t)
-(test (equal? (let ((vals '()))
+(test (equal? (let ((vals ()))
(do ((k 1/2 (+ k 1/2))) ((> k 3) (reverse vals))
(set! vals (cons (round (- k)) vals))))
(list 0 -1 -2 -2 -2 -3))
@@ -36266,13 +51626,13 @@ abs 1 2
(cv (ceiling val1))
(tv (truncate val1)))
(if (not (= fv (- val2 1)))
- (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv val2))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv (- val2 1)))
- (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (not (= rv val2))
- (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -36284,13 +51644,13 @@ abs 1 2
(cv (ceiling val1))
(tv (truncate val1)))
(if (not (= fv val2))
- (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv (+ val2 1)))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv val2))
- (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (not (= rv val2))
- (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -36298,13 +51658,13 @@ abs 1 2
(let* ((val1 (expt 2 i))
(val2 (- val1 1)))
(if (= (floor val1) (floor val2))
- (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
(if (= (ceiling val1) (ceiling val2))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
(if (= (truncate val1) (truncate val2))
- (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
(if (= (round val1) (round val2))
- (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -36312,13 +51672,13 @@ abs 1 2
(let* ((val1 (/ (- (expt 2 i) 1) 2))
(val2 (/ (- (expt 2 i) 3) 2)))
(if (= (floor val1) (floor val2))
- (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
(if (= (ceiling val1) (ceiling val2))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
(if (= (truncate val1) (truncate val2))
- (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
(if (= (round val1) (round val2))
- (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
(let ((happy #t)
(off-by 1/3))
@@ -36330,16 +51690,16 @@ abs 1 2
(tv (truncate val1))
(rv (round val1)))
(if (not (= fv (- val1 off-by)))
- (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv (- val1 off-by)))
- (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (= off-by 1/3)
(if (not (= rv (- val1 off-by)))
- (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv)))
(if (not (= rv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))
(if (= off-by 1/3)
(set! off-by 2/3)
(set! off-by 1/3)))))
@@ -36354,13 +51714,13 @@ abs 1 2
(cv (ceiling val1))
(tv (truncate val1)))
(if (not (= fv val2))
- (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv (+ val2 1)))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv (+ val2 1)))
- (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (not (= rv val2))
- (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -36372,13 +51732,13 @@ abs 1 2
(cv (ceiling val1))
(tv (truncate val1)))
(if (not (= fv (- val2 1)))
- (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv val2))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv val2))
- (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (not (= rv val2))
- (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -36386,13 +51746,13 @@ abs 1 2
(let* ((val1 (- (expt 2 i)))
(val2 (+ val1 1)))
(if (= (floor val1) (floor val2))
- (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
(if (= (ceiling val1) (ceiling val2))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
(if (= (truncate val1) (truncate val2))
- (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
(if (= (round val1) (round val2))
- (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -36400,13 +51760,13 @@ abs 1 2
(let* ((val1 (- (/ (- (expt 2 i) 1) 2)))
(val2 (- (/ (- (expt 2 i) 3) 2))))
(if (= (floor val1) (floor val2))
- (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = (floor ~S)?~%" val1 val2)))
(if (= (ceiling val1) (ceiling val2))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2)))
(if (= (truncate val1) (truncate val2))
- (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2)))
(if (= (round val1) (round val2))
- (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = (round ~S)?~%" val1 val2))))))
(let ((happy #t)
(off-by 2/3))
@@ -36418,16 +51778,16 @@ abs 1 2
(tv (truncate val1))
(rv (round val1)))
(if (not (= fv (- val1 off-by)))
- (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv)))
+ (begin (set! happy #f) (format-logged #t ";(floor ~S) = ~S?~%" val1 fv)))
(if (not (= cv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv)))
+ (begin (set! happy #f) (format-logged #t ";(ceiling ~S) = ~S?~%" val1 cv)))
(if (not (= tv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv)))
+ (begin (set! happy #f) (format-logged #t ";(truncate ~S) = ~S?~%" val1 tv)))
(if (= off-by 1/3)
(if (not (= rv (- val1 off-by)))
- (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv)))
(if (not (= rv (+ val1 (- 1 off-by))))
- (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))))
+ (begin (set! happy #f) (format-logged #t ";(round ~S) = ~S?~%" val1 rv))))
(if (= off-by 1/3)
(set! off-by 2/3)
(set! off-by 1/3)))))
@@ -36465,6 +51825,7 @@ abs 1 2
(num-test (modulo -1.5 2) 0.5)
(num-test (modulo -1/2 -1) -1/2)
(num-test (modulo -1/2 -1.0) -0.5)
+(num-test (modulo -1/2 2) 3/2)
(num-test (modulo -1/9223372036854775807 -1/3) -1/9223372036854775807)
(num-test (modulo -10 -1) 0)
(num-test (modulo -10 -10) 0)
@@ -36852,8 +52213,17 @@ abs 1 2
(num-test (modulo 171928773/272500658 54608393/38613965) 171928773/272500658)
(num-test (modulo 4178406761/630138897 131836323/93222358) 28610075152269757/29371516922929563)
+(num-test (modulo 1/9223372036 9223372036) 1/9223372036)
+(num-test (modulo 1/9223372036854775807 9223372036854775807) 1/9223372036854775807)
+(num-test (modulo 3/2 most-positive-fixnum) 3/2)
+(num-test (modulo most-negative-fixnum -1) 0)
+
+(if (not with-bignums)
+ (num-test (modulo 3/2 most-negative-fixnum) 'error))
+
(if with-bignums
(begin
+ (num-test (modulo 3/2 most-negative-fixnum) -18446744073709551613/2)
(num-test (modulo (+ 2 (* 3 499127 495037 490459 468803)) (* 499127 495037 490459 468803)) 2)
(num-test (modulo -9223372036854775808 5.551115123125783999999999999999999999984E-17) 3.258027528318940824192395666614174842834E-17)
(num-test (modulo 12345678901234567890 12345678901234567) 890)
@@ -37227,6 +52597,28 @@ abs 1 2
(test (modulo 2.3 1.0+0.1i) 'error)
(test (modulo 3.0+2.3i 3) 'error)
+(for-each
+ (lambda (arg)
+ (test (modulo arg nan.0) 'error)
+ (test (modulo nan.0 arg) 'error)
+ (test (modulo arg inf.0) 'error)
+ (test (modulo inf.0 arg) 'error)
+ (test (modulo arg 2) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (modulo 2 arg) 'error)
+ (test (modulo 1/2 arg) 'error)
+ (test (modulo 2.0 arg) 'error)
+ (test (modulo 2+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+;; check an optimizer bug
+(test (let () (define (f x) (modulo x 12)) (f 3/4)) 3/4)
+
;;; --------------------------------------------------------------------------------
@@ -37565,6 +52957,10 @@ abs 1 2
(num-test (quotient 9223372036854775807 -9223372036854775808) 0)
(num-test (quotient 9223372036854775807 9223372036854775807) 1)
+(if (not with-bignums)
+ (test (quotient most-negative-fixnum -1) 'error)
+ (num-test (quotient most-negative-fixnum -1) 9223372036854775808))
+
(num-test (quotient 3 1.5) 2)
(num-test (quotient 3 1.75) 1)
(num-test (quotient pi 1) 3)
@@ -37622,6 +53018,10 @@ abs 1 2
(num-test (quotient 110.123 4.0) 27)
(num-test (quotient 110.123 1000.1) 0)
+(num-test (quotient 1e+18 8) 125000000000000000)
+(num-test (quotient 1/9223372036854775807 -1/9223372036854775807) -1)
+(num-test (quotient -4611686018427387904 1/2) -9223372036854775808)
+
(test (= (quotient (* 99/70 99/70) 2) (quotient (* 577/408 577/408) 2)) #t)
(test (= (quotient 2.0 (* 99/70 99/70)) (quotient (* 577/408 577/408) 2.0)) #f)
(test (= (quotient 99/70 577/408) (floor (/ 99/70 577/408))) #t)
@@ -37644,14 +53044,15 @@ abs 1 2
(test (= (quotient 2.0 (* 54608393/38613965 54608393/38613965)) (quotient (* 131836323/93222358 131836323/93222358) 2.0)) #t)
(test (= (quotient 54608393/38613965 131836323/93222358) (floor (/ 54608393/38613965 131836323/93222358))) #t)
(test (= (quotient (* 131836323/93222358 131836323/93222358) 2) (quotient (* 318281039/225058681 318281039/225058681) 2)) #f)
-(if with-bignums (test (= (quotient 2.0 (* 131836323/93222358 131836323/93222358)) (quotient (* 318281039/225058681 318281039/225058681) 2.0)) #f))
+;(if with-bignums (test (= (quotient 2.0 (* 131836323/93222358 131836323/93222358)) ; this should be 1 I think
+; (quotient (* 318281039/225058681 318281039/225058681) 2.0)) #f))
(test (= (quotient 131836323/93222358 318281039/225058681) (floor (/ 131836323/93222358 318281039/225058681))) #t)
(if with-bignums (test (= (quotient (* 318281039/225058681 318281039/225058681) 2) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2)) #t))
(if with-bignums (test (= (quotient 2.0 (* 318281039/225058681 318281039/225058681)) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #f))
(test (= (quotient 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #t)
(if with-bignums (test (= (quotient (* 1855077841/1311738121 1855077841/1311738121) 2) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2)) #f))
(test (= (quotient 2.0 (* 1855077841/1311738121 1855077841/1311738121)) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2.0)) #t)
-(test (= (quotient 1855077841/1311738121 4478554083/3166815962) (floor (/ 1855077841/1311738121 4478554083/3166815962))) #t)
+(test (= (quotient 1855077842/1311738121 4478554083/3166815962) (floor (/ 1855077842/1311738121 4478554083/3166815962))) #t)
;;; there's one really dumb problem here:
;;; (quotient 1e-12 1E-16) -> 9999
@@ -37660,6 +53061,10 @@ abs 1 2
;;; for 1e-14 however, there is no number of zeros that will work, but you can set precision to 1024
;;; or you can spell it out: (quotient 0.0000000000001 0.00000000000000001) -> 10000
+;;; (quotient 1e+18 3/4) -> 1333333333333333248
+;;; which should be 333 at the end of course
+;;; (quotient 1e+15 3/4) -> 1333333333333333
+
(num-test (quotient 1e16 1e14) 100)
(if with-bignums
@@ -37735,6 +53140,27 @@ abs 1 2
(test (quotient 3 0) 'error)
(test (quotient) 'error)
(test (quotient 3 1+i) 'error)
+(test (quotient 3 0.0) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (quotient arg nan.0) 'error)
+ (test (quotient nan.0 arg) 'error)
+ (test (quotient arg inf.0) 'error)
+ (test (quotient inf.0 arg) 'error)
+ (test (quotient arg 2) 'error))
+ (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (quotient 2 arg) 'error)
+ (test (quotient 1/2 arg) 'error)
+ (test (quotient 2.0 arg) 'error)
+ (test (quotient 2+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t 0 0.0 0+i '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -38118,6 +53544,10 @@ abs 1 2
(num-test (remainder 110.123 4.0) 2.123)
(num-test (remainder 110.123 1000.1) 110.123)
+(num-test (remainder 3/2 most-negative-fixnum) 3/2)
+(num-test (remainder 3/2 most-positive-fixnum) 3/2)
+(num-test (remainder most-negative-fixnum -1) 0)
+
(test (= (remainder (* 577/408 577/408) 2) (remainder (* 1393/985 1393/985) 2)) #f)
(test (= (remainder 2.0 (* 577/408 577/408)) (remainder (* 1393/985 1393/985) 2.0)) #f)
(test (= (remainder 577/408 1393/985) (floor (/ 577/408 1393/985))) #f)
@@ -38255,6 +53685,26 @@ abs 1 2
(test (remainder) 'error)
(test (remainder 2.3 1.0+0.1i) 'error)
(test (remainder 3.0+2.3i 3) 'error)
+(test (remainder 3 0.0) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (remainder arg nan.0) 'error)
+ (test (remainder nan.0 arg) 'error)
+ (test (remainder arg inf.0) 'error)
+ (test (remainder inf.0 arg) 'error)
+ (test (remainder arg 2) 'error))
+ (list "hi" () (integer->char 65) 0+i #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (remainder 2 arg) 'error)
+ (test (remainder 2.0 arg) 'error)
+ (test (remainder 1/2 arg) 'error)
+ (test (remainder 2+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t 0 0+i '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
(if with-bignums
@@ -38795,6 +54245,25 @@ abs 1 2
(test (gcd 0/0) 'error)
(test (gcd 2 1.0+0.5i) 'error)
+(for-each
+ (lambda (arg)
+ (test (gcd arg nan.0) 'error)
+ (test (gcd nan.0 arg) 'error)
+ (test (gcd arg inf.0) 'error)
+ (test (gcd inf.0 arg) 'error)
+ (test (gcd arg 2) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (gcd 2 arg) 'error)
+ (test (gcd 1/2 arg) 'error)
+ (test (gcd 2.0 arg) 'error)
+ (test (gcd 2+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(if with-bignums
(begin
(num-test (gcd -9223372036854775808 -9223372036854775808) 9223372036854775808)
@@ -39961,6 +55430,25 @@ abs 1 2
(test (lcm 1.4 2.3) 'error)
(test (lcm 2 1.0+0.5i) 'error)
+(for-each
+ (lambda (arg)
+ (test (lcm arg nan.0) 'error)
+ (test (lcm nan.0 arg) 'error)
+ (test (lcm arg inf.0) 'error)
+ (test (lcm inf.0 arg) 'error)
+ (test (lcm 2 arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (lcm arg 2) 'error)
+ (test (lcm arg 1/2) 'error)
+ (test (lcm arg 2.0) 'error)
+ (test (lcm arg 2+i) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -40187,6 +55675,14 @@ abs 1 2
(num-test (rationalize 1/3 1/4) 1/2)
(num-test (rationalize 3/10 1/10) 1/3)
+(num-test (rationalize 1/4 1/11) 1/3)
+(num-test (rationalize 1/4 1/12) 1/4)
+(num-test (rationalize pi 1/10) 16/5)
+(num-test (rationalize pi 1/100) 22/7)
+(num-test (rationalize pi 1/10000) 333/106)
+
+;; currently (rationalize pi 0) -> 245850922/78256779, but should it return the actual (float-style) ratio?
+
(num-test (rationalize 1 .1) 1)
(num-test (rationalize 1 1) 0)
(num-test (rationalize 1 1/2) 1)
@@ -40253,18 +55749,20 @@ abs 1 2
(num-test (rationalize 1.0000001 0.00000001) 9090911/9090910)
(num-test (rationalize 0.000000015 0.0000000009999999) 1/62500001)
(num-test (rationalize 0.00000001 1e-16) 1/100000000)
-(num-test (rationalize 0.1 0) 1/10)
+(num-test (rationalize 0.1 0) (if with-bignums 3602879701896397/36028797018963968 1/10))
(num-test (rationalize 0.1 .00000000000000001) 1/10)
+(num-test (/ 0.(rationalize .1)) 0.0)
-(num-test (rationalize .1 0) 1/10)
-;;; but (rationalize 0.1 0) -> 1526457681181556/15264576811815559? independent of precision
-;;; and (rationalize 0.1000000000000000 0) -> 1/10 so once again it's either the idiotic reader or the bignum promotion process
-;;; (rationalize 0.00000001 0) 3022314549036573/302231454903657293676544?
+(when (not with-bignums)
+ (num-test (rationalize .1 0) 1/10)
+ ;; but (rationalize 0.1 0) -> 1526457681181556/15264576811815559? independent of precision
+ ;; and (rationalize 0.1000000000000000 0) -> 1/10 so once again it's either the idiotic reader or the bignum promotion process
+ ;; (rationalize 0.00000001 0) 3022314549036573/302231454903657293676544?
-(num-test (rationalize 1e-3 0) 1/1000)
-(num-test (rationalize 1e-12 0) 1/1000000000000)
-(num-test (rationalize 1e-15 0) 1/1000000000000000)
-(num-test (rationalize (+ 1e2 1e-2) 0) 10001/100)
+ (num-test (rationalize 1e-3 0) 1/1000)
+ (num-test (rationalize 1e-12 0) 1/1000000000000)
+ (num-test (rationalize 1e-15 0) 1/1000000000000000)
+ (num-test (rationalize (+ 1e2 1e-2) 0) 10001/100))
(num-test (rationalize -1 -1) 0) ;; spec says "differs by no more than", but that seems to imply a comparison
;; on either side, so a negative error doesn't change the result??
@@ -40398,9 +55896,9 @@ abs 1 2
(num-test (rationalize 1e-19 1e-21) 1/9900990099009900991)
(num-test (rationalize 1e-19 1e-30) 1/9999999999900000001)
(num-test (rationalize 1e-30 0.0) 1/1000000000000000000000000000000)
- (num-test (rationalize (+ .1 1e-18) 0) 100000000000000001/1000000000000000000)
- (num-test (rationalize (+ .1 1e-18) 1e-20) 9900990099009902/99009900990099019)
- (num-test (rationalize (- .1 1e-18) 1e-20) 9900990099009901/99009900990099011)
+ (num-test (rationalize (+ .1 1e-18) 0) 1894333982346309985/18943339823463098609)
+ (num-test (rationalize (+ .1 1e-18) 1e-20) 1524131159466061/15241311594660609)
+ (num-test (rationalize (- .1 1e-18) 1e-20) 2192446305355891/21924463053558909)
(num-test (rationalize 1e18 1e19) 0)
(num-test (rationalize 1180591620717411303424) 1180591620717411303424)
@@ -40421,11 +55919,11 @@ abs 1 2
(test (< (abs (- (rationalize 3796553736732654909229441/2684568892382786771291329)3796553736732654909229441/2684568892382786771291329)) 1e-12) #t)
(num-test (rationalize 3796553736732654909229441/2684568892382786771291329 1) 1)
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 1024)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 1024)
(num-test (rationalize (expt 2 1/3) 1e-40) 77270484057362988877/61329623839374997455)
(num-test (rationalize 3796553736732654909229441/2684568892382786771291329 0) 3796553736732654909229441/2684568892382786771291329)
- (set! (bignum-precision) old-prec))
+ (set! (*s7* 'bignum-precision) old-prec))
))
@@ -40445,7 +55943,7 @@ abs 1 2
(vector-set! diffs i diff)
(if (> diff err)
(begin
- (format #t "|~A - ~A| = ~A > ~A (2^~A)?" val rat diff err (log err 2))
+ (format-logged #t "|~A - ~A| = ~A > ~A (2^~A -> 2^~A)?~%" val rat diff err (log diff 2) (log err 2))
(return #f)))))
(and (apply >= (vector->list diffs))
(apply <= (map denominator ratios)))))))
@@ -40460,30 +55958,29 @@ abs 1 2
(let ((val (- (random 2.0) 1.0)))
(let ((rat (check-rationalize val 40)))
(if (not rat)
- (format #t "rationalize trouble with ~A~%" val)))))
+ (format-logged #t "rationalize trouble with ~A~%" val)))))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 4096)
- (test (bignum-precision) 4096)
- (test (apply bignum-precision '()) 4096)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 4096)
+ (test (*s7* 'bignum-precision) 4096)
(test (check-rationalize pi 100) #t)
(test (check-rationalize (/ pi) 100) #t)
(for-each
(lambda (arg)
- (test (set! (bignum-precision) arg) 'error))
- (list "hi" #\a 'a-symbol '#(1 2 3) -1 0 1 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
+ (test (set! (*s7* 'bignum-precision) arg) 'error))
+ (list "hi" #\a 'a-symbol #(1 2 3) -1 0 1 3.14 3/4 1.0+1.0i #t abs #<eof> #<unspecified> (lambda () 1)))
(test (bignum-precision 213) 'error)
(test (set! (bignum-precision 213) 123) 'error)
- (set! (bignum-precision) 2)
- (test (bignum-precision) 2)
+ (set! (*s7* 'bignum-precision) 2)
+ (test (*s7* 'bignum-precision) 2)
(test (object->string pi) "3.0E0")
- (set! (bignum-precision) old-prec))))
+ (set! (*s7* 'bignum-precision) old-prec))))
(test (rationalize) 'error)
(test (rationalize 1.23+1.0i 1.23+1.0i) 'error)
@@ -40492,6 +55989,25 @@ abs 1 2
(test (rationalize 1 nan.0) 'error)
(test (rationalize (expt 2 60) -) 'error)
+(for-each
+ (lambda (arg)
+ (test (rationalize arg 0.1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (rationalize arg nan.0) 'error)
+ (test (rationalize nan.0 arg) 'error)
+ (test (rationalize arg inf.0) 'error)
+ (test (rationalize inf.0 arg) 'error)
+ (test (rationalize 0.1 arg) 'error)
+ (test (rationalize 1 arg) 'error)
+ (test (rationalize 1/2 arg) 'error)
+ (test (rationalize 0+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(if with-bignums
(begin
(num-test (rationalize .1e20) 10000000000000000000)
@@ -40513,10 +56029,57 @@ abs 1 2
((= i 100))
(if (not (zero? (random fraction)))
(ok))))
- (format #t ";random of small ratios is always 0 below ca. ~A~%" (expt 10.0 k))
+ (format-logged #t ";random of small ratios is always 0 below ca. ~A~%" (expt 10.0 k))
(done))))))
+;;; Bill Gosper's farint:
+
+(let ()
+ (define* (farint x (err 1/1000000)) ; this err term is not the same as the s7 rationalize error term
+
+ (define* (farint-1 x nhi dhi (ln 0) (ld 1) (hn 1) (hd 0))
+ (if (> (+ ln hn) (* (+ ld hd) x))
+ (let* ((m (min (if (= 0 ln)
+ nhi
+ (floor (/ (- nhi hn) ln)))
+ (floor (/ (- dhi hd) ld))))
+ (d (- (* x ld) ln))
+ (k (if (= 0 d)
+ m
+ (ceiling (/ (- hn (* x hd)) d)))))
+ (if (< k m)
+ (let ((hn1 (+ (* k ln) hn))
+ (hd1 (+ (* k ld) hd)))
+ (farint-1 x nhi dhi hn1 hd1 (- hn1 ln) (- hd1 ld)))
+
+ (let* ((n (+ (* m ln) hn)) (d (+ (* m ld) hd)))
+ (if (< (* 2 d ld x) (+ (* ld n) (* ln d)))
+ (/ ln ld)
+ (/ n d)))))
+
+ (let* ((m (min (floor (/ (- nhi ln) hn))
+ (if (= 0 hd)
+ dhi
+ (floor (/ (- dhi ld) hd)))))
+ (d (- hn (* x hd)))
+ (k (if (= 0 d)
+ m
+ (ceiling (/ (- (* x ld) ln) d)))))
+ (if (< k m)
+ (let ((ln1 (+ (* k hn) ln))
+ (ld1 (+ (* k hd) ld)))
+ (farint-1 x nhi dhi (- ln1 hn) (- ld1 hd) ln1 ld1))
+ (let* ((n (+ (* m hn) ln)) (d (+ (* m hd) ld)))
+ (if (< (* 2 d hd x) (+ (* hd n) (* hn d)))
+ (/ n d)
+ (/ hn hd)))))))
+
+ (farint-1 x (/ err) (/ err)))
+
+ (num-test (farint .1) 1/10))
+
+
;;; --------------------------------------------------------------------------------
@@ -40849,6 +56412,11 @@ abs 1 2
(num-test (min 2.168404344971008869895696563055543437233E-17 2.168404344971008681816600431489558149231E-17 ) 2.168404344971008681816600431489558149231E-17)
(num-test (min 2.168404344971008681816600431489558149231E-17 1/46116860184273879) 2.168404344971008681816600431489558149231E-17)
(num-test (min 1/46116860184273883 2.168404344971008869895696563055543437233E-17) 2.168404344971008681816600431489558149231E-17)
+
+ (num-test (let ((n (list 2.0 (bignum "3")))) (eval `(let () (define (f1) (min , at n)) (f1)))) 2.0)
+ (num-test (let ((n (list 2.0 (bignum "0")))) (eval `(let () (define (f1) (min , at n)) (f1)))) 0)
+ (num-test (let ((n (list 2.0 (bignum "3")))) (eval `(let () (define (f1) (max , at n)) (f1)))) 3)
+ (num-test (let ((n (list 2.0 (bignum "0")))) (eval `(let () (define (f1) (max , at n)) (f1)))) 2.0)
))
(test (min 1.23+1.0i) 'error)
@@ -40867,6 +56435,23 @@ abs 1 2
(test (min inf.0 1+i) 'error)
(test (min inf.0 nan.0 0-i 1) 'error)
+(test (nan? (min 3/4 1/0)) #t)
+(test (nan? (min 3/4 nan.0)) #t)
+(test (min 3/4 nan.0 #\a) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (min arg nan.0) 'error)
+ (test (min nan.0 arg) 'error)
+ (test (min arg inf.0) 'error)
+ (test (min inf.0 arg) 'error)
+ (test (min 0 arg) 'error)
+ (test (min 0.0 arg) 'error)
+ (test (min 1/2 arg) 'error)
+ (test (min 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -41250,6 +56835,23 @@ abs 1 2
(test (max inf.0 1+i) 'error)
(test (max inf.0 nan.0 0-i 1) 'error)
+(test (nan? (max 3/4 1/0)) #t)
+(test (nan? (max 3/4 nan.0)) #t)
+(test (max 3/4 nan.0 #\a) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (max arg nan.0) 'error)
+ (test (max nan.0 arg) 'error)
+ (test (max arg inf.0) 'error)
+ (test (max inf.0 arg) 'error)
+ (test (max 0 arg) 'error)
+ (test (max 0.0 arg) 'error)
+ (test (max 1/2 arg) 'error)
+ (test (max 0+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(let ((top-exp 60))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -41478,6 +57080,20 @@ abs 1 2
(test (< 3 5) #t)
(test (< 3.0 3) #f)
+(for-each
+ (lambda (arg)
+ (test (< arg nan.0) 'error)
+ (test (< nan.0 arg) 'error)
+ (test (< arg inf.0) 'error)
+ (test (< inf.0 arg) 'error)
+ (test (< 1 0 arg) 'error)
+ (test (< 1 arg) 'error)
+ (test (< 1.0 arg) 'error)
+ (test (< 1/2 arg) 'error)
+ (test (< arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(test (< 1/123400000000 .000000000001) #f)
(test (< -1/9223372036854775807 -1/9223372036854775806) #f)
(test (< -10/3147483647 -40/12345678901) #f)
@@ -41620,7 +57236,7 @@ abs 1 2
(test (< (* 253/401 1.0) (* 665/1054 1.0)) #t)
(test (< (* 253/401 1.0) 665/1054) #t)
(if with-bignums (test (< (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #t))
-;;; fraction -> double troubles -- this is ok if s7_Double is long double in s7.h
+;;; fraction -> double troubles -- this is ok if s7_double is long double in s7.h
(test (< (* 397573379/630138897 1.0) 4201378396/6659027209) #t)
(test (< (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #f)
(if with-bignums (test (< (* 4201378396/6659027209 1.0) 6189245291/9809721694) #f))
@@ -41987,6 +57603,21 @@ abs 1 2
(test (<= 1267650600228229401496703205376) 'error)
))
+(for-each
+ (lambda (arg)
+ (test (<= arg nan.0) 'error)
+ (test (<= nan.0 arg) 'error)
+ (test (<= arg inf.0) 'error)
+ (test (<= inf.0 arg) 'error)
+ (test (<= 1 0 arg) 'error)
+ (test (<= 1 arg) 'error)
+ (test (<= 1.0 arg) 'error)
+ (test (<= 1/2 arg) 'error)
+ (test (<= arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
;;; --------------------------------------------------------------------------------
@@ -42016,6 +57647,7 @@ abs 1 2
(test (= 0 1 1234) #f)
(test (= 0 1 1234/11) #f)
(test (= 0 1) #f)
+(test (= 0 -0) #t)
(test (= 0 1.0 -1.0+1.0i) #f)
(test (= 0 1.0 0.0+1.0i) #f)
(test (= 0 1.0 1) #f)
@@ -42558,6 +58190,7 @@ abs 1 2
(test (= 0/1) 'error)
(test (= 1.0) 'error)
(test (= 1.0+1.0i) 'error)
+(test (= 1 lambda) 'error)
(test (= 10/3) 'error)
(test (= 1234000000.0+2.71828182845905i) 'error)
(test (= 2) 'error)
@@ -42565,6 +58198,7 @@ abs 1 2
(test (= 2.5+0.0i 5/2) #t)
(test (= 2.5+1.0i 5/2) #f)
(test (= 2.71828182845905+3.14159265358979i) 'error)
+(test (= pi '(1)) 'error) ; for gmp
(test (= 3 2 3) #f)
(test (= 3 3 3 3) #t)
(test (= 3 3 5 3) #f)
@@ -42578,6 +58212,21 @@ abs 1 2
(test (= 5/2 2.5+0.0i) #t)
(test (= 5/2 2.5+1.0i) #f)
+(for-each
+ (lambda (arg)
+ (test (= arg nan.0) 'error)
+ (test (= nan.0 arg) 'error)
+ (test (= arg inf.0) 'error)
+ (test (= inf.0 arg) 'error)
+ (test (= 1 0 arg) 'error)
+ (test (= 1 arg) 'error)
+ (test (= 1.0 arg) 'error)
+ (test (= 1/2 arg) 'error)
+ (test (= 1+i arg) 'error)
+ (test (= arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(test (= +0 -0 0/100 00 -0/9223372036854775807) #t)
(test (= +1/2 1/2) #t)
(test (= 0 0) #t)
@@ -42618,6 +58267,7 @@ abs 1 2
(test (= most-positive-fixnum most-negative-fixnum) #f)
(test (= most-positive-fixnum most-positive-fixnum) #t)
+;; these are a mess -- they depend on optimizer choices, etc
(test (= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #f)
(test (= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #f)
(test (= 1 1.0 9223372036854775806/9223372036854775807) #f)
@@ -42628,6 +58278,8 @@ abs 1 2
(test (= 9223372036854775807/9223372036854775806 1.0 1) #f)
(test (= 9223372036854775807/9223372036854775806 1.0) #f)
(test (= 1.0 9223372036854775807/9223372036854775806) #f)
+;(test (= 1.0 9223372036854775807/9223372036854775806) (= 9223372036854775807/9223372036854775806 1.0))
+;(test (= (* 397573379/630138897 1.0) 4201378396/6659027209) (= 4201378396/6659027209 (* 397573379/630138897 1.0)))
(test (= (* 10400200/16483927 1.0) (* 10781274/17087915 1.0)) #f)
(test (= (* 10400200/16483927 1.0) 10781274/17087915) #f)
@@ -42641,7 +58293,7 @@ abs 1 2
(test (= (* 15601/24727 1.0) 79335/125743) #f)
;;; (if with-bignums (test (= (* 171928773/272500658 1.0) (* 397573379/630138897 1.0)) #f)) -- needs more bits
-(test (= (* 171928773/272500658 1.0) 397573379/630138897) #f)
+;;; (test (= (* 171928773/272500658 1.0) 397573379/630138897) #f)
(test (= (* 190537/301994 1.0) (* 7161071/11350029 1.0)) #f)
(test (= (* 190537/301994 1.0) 7161071/11350029) #f)
@@ -42659,7 +58311,7 @@ abs 1 2
(test (= (* 53/84 1.0) 253/401) #f)
;;; (if with-bignums (test (= (* 53715833/85137581 1.0) (* 171928773/272500658 1.0)) #f)) -- more bits
-(if with-bignums (test (= (* 53715833/85137581 1.0) 171928773/272500658) #f))
+;;; (if with-bignums (test (= (* 53715833/85137581 1.0) 171928773/272500658) #f))
(test (= (* 665/1054 1.0) (* 12941/20511 1.0)) #f)
(test (= (* 665/1054 1.0) 12941/20511) #f)
@@ -42705,6 +58357,13 @@ abs 1 2
;;; (= (sqrt 2) 5964153172084899/4217293152016490) -> #f
+(test (= 0 '(1 . 2) . 3) 'error)
+(test (append 0 '(1 . 2) . 3) 'error)
+(test (= 0 ''0 . 0) 'error)
+(test (= . 0) 'error)
+(test (= 0 . (0)) #t)
+
+
;;; --------------------------------------------------------------------------------
@@ -42878,6 +58537,7 @@ abs 1 2
(test (> 2 2 1) #f)
(test (> 3 -6246) #t )
(test (> 9 9 -2424) #f )
+(test (> quote if) 'error)
(test (> 0) 'error)
(test (> 0.0 0.0) #f)
@@ -42999,6 +58659,8 @@ abs 1 2
(test (> (* 5/8 1.0) 12/19) #f)
(test (> (* 53/84 1.0) (* 253/401 1.0)) #t)
(test (> (* 53/84 1.0) 253/401) #t)
+(test (> (abs (- .1 .2)) .3) #f)
+(test (> (abs (- .1 .2)) .03) #t)
;;; (if with-bignums (test (> (* 53715833/85137581 1.0) (* 171928773/272500658 1.0)) #t)) -- more bits
;;; (if with-bignums (test (> (* 53715833/85137581 1.0) 171928773/272500658) #t))
@@ -43049,6 +58711,21 @@ abs 1 2
(test (> 2646693125139304345/842468587426513207 21053343141/6701487259) #t)
))
+(for-each
+ (lambda (arg)
+ (test (> arg nan.0) 'error)
+ (test (> nan.0 arg) 'error)
+ (test (> arg inf.0) 'error)
+ (test (> inf.0 arg) 'error)
+ (test (> 0 1 arg) 'error)
+ (test (> 1 arg) 'error)
+ (test (> 1/2 arg) 'error)
+ (test (> 1.0 arg) 'error)
+ (test (> 1+i arg) 'error)
+ (test (> arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
;;; --------------------------------------------------------------------------------
@@ -43208,6 +58885,7 @@ abs 1 2
(test (>= 1234/11 1234) #f)
(test (>= 1234/11 1234/11) #t)
+(test (>= 0+i 0+i) 'error) ;??
(test (>= 1 0+i) 'error)
(test (>= 1 0-i) 'error)
(test (>= 1 1 2) #f)
@@ -43331,6 +59009,21 @@ abs 1 2
(test (>=- 1 2) 'error)
(for-each
+ (lambda (arg)
+ (test (>= arg nan.0) 'error)
+ (test (>= nan.0 arg) 'error)
+ (test (>= arg inf.0) 'error)
+ (test (>= inf.0 arg) 'error)
+ (test (>= 0 1 arg) 'error)
+ (test (>= 1 arg) 'error)
+ (test (>= 1/2 arg) 'error)
+ (test (>= 1.0 arg) 'error)
+ (test (>= 1+i arg) 'error)
+ (test (>= arg 1) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
(lambda (op)
(for-each
(lambda (arg1)
@@ -43340,16 +59033,16 @@ abs 1 2
(for-each
(lambda (arg2)
(test (op arg1 arg2) 'error))
- (list "hi" '() 1 1.5 3/2 1+i (cons 1 2) (list 1 2) #\a 'a-symbol #(1) abs #f (lambda (a) (+ a 1)) #<unspecified> #<eof> #<undefined>)))
- (list "hi" '() (cons 1 2) (list 1 2) #\a 'a-symbol #(1) abs #f (lambda (a) (+ a 1)) #<unspecified> #<eof> #<undefined>)))
+ (list "hi" () 1 1.5 3/2 1+i (cons 1 2) (list 1 2) #\a 'a-symbol #(1) abs #f (lambda (a) (+ a 1)) #<unspecified> :hi #<eof> #<undefined>)))
+ (list "hi" () (cons 1 2) (list 1 2) #\a 'a-symbol #(1) abs #f (lambda (a) (+ a 1)) #<unspecified> :hi #<eof> #<undefined>)))
(list + - * / > < >= <= ))
(for-each
(lambda (op)
(let ((val1 (catch #t (lambda () (op 1.0)) (lambda args 'error)))
(val2 (catch #t (lambda () (op 1.0+0i)) (lambda args 'error))))
- (if (not (equal? val1 val2))
- (format #t ";(~A 1) != (~A 1+0i)? (~A ~A)~%" op op val1 val2))))
+ (if (not (morally-equal? val1 val2)) ; ignore nans
+ (format-logged #t ";(~A 1) != (~A 1+0i)? (~A ~A)~%" op op val1 val2))))
(list magnitude angle rationalize abs exp log sin cos tan asin acos atan
sinh cosh tanh asinh acosh atanh sqrt floor ceiling truncate round + - * /
max min number? integer? real? complex? rational?
@@ -43806,6 +59499,12 @@ abs 1 2
(test (sin 1.0+23.0i 1.0+23.0i) 'error)
(test (sin 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (sin arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(if with-bignums
(letrec ((sin-m*pi/n
(lambda (m1 n1)
@@ -44002,7 +59701,7 @@ abs 1 2
(set! max-case (/ m n))
(set! maxerr err)))))))))
(if (> maxerr 1e-35)
- (format #t "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case))))
+ (format-logged #t "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case))))
)
(let ((sins (list
@@ -44046,11 +59745,11 @@ abs 1 2
(let ((err (abs (- (sin x) (list-ref sins i)))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format #t "sin err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format-logged #t "sin err: ~A~%" mxerr))))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((sin-vals (list ;arprec mathtool table[Sin[k/10], {k, 0, 30}]
"0.00000000000000000000000000000000000000000000000000000000000000000000"
"0.09983341664682815230681419841062202698991538801798225999276686156165"
@@ -44087,7 +59786,7 @@ abs 1 2
((= k 30))
(let ((sin-val-2 (number->string (sin (/ k (bignum "10"))))))
(if (not (string=? (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59)))
- (format #t ";(sin (/ ~A 10)) mp: ~A does not match~%~A~%" k (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59))))))
+ (format-logged #t ";(sin (/ ~A 10)) mp: ~A does not match~%~A~%" k (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59))))))
(let ((sin-vals (list ;arprec mathtool table[Sin[k/10], {k, 0, 30}]
0.00000000000000000000000000000000000000000000000000000000000000000000
@@ -44132,8 +59831,8 @@ abs 1 2
(if (> err mxerr)
(set! mxerr err)))))))
(if (> mxerr 1e-35)
- (format #t ";(sin big-angle) max error: ~A" mxerr)))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(sin big-angle) max error: ~A" mxerr)))
+ (set! (*s7* 'bignum-precision) old-prec)))
@@ -44590,6 +60289,12 @@ abs 1 2
(test (cos 1.0+23.0i 1.0+23.0i) 'error)
(test (cos 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (cos arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(let* ((angle 0.0)
(z 1.18)
(result (* z (cos angle))))
@@ -44609,38 +60314,48 @@ abs 1 2
;; 47? calls here so we're at around .812 (oscillating around .8119)
(test (< (abs (- x result)) .001) #t)))
-(let ((dht (lambda (data)
- ; the Hartley transform of 'data'
- (let* ((len (vector-length data))
- (arr (make-vector len 0.0))
- (w (/ (* 2.0 pi) len)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (do ((j 0 (+ 1 j)))
- ((= j len))
- (vector-set! arr i (+ (vector-ref arr i)
- (* (vector-ref data j)
- (+ (cos (* i j w))
- (sin (* i j w))))))))
- arr)))
- (data (list->vector '(0.9196 0.9457 0.0268 0.0839 0.1974 0.1060 0.1463 0.3513 0.0391 0.6310
- 0.9556 0.6259 0.9580 0.8848 0.0104 0.1440 0.0542 0.3001 0.1844 0.3781
- 0.9641 0.6051 0.3319 0.6143 0.1828 0.2290 0.4026 0.5990 0.7906 0.0403
- 0.7882 0.1591)))
- (saved-data (make-vector 32 0.0)))
- (do ((i 0 (+ i 1)))
- ((= i 32))
- (vector-set! saved-data i (vector-ref data i)))
- (dht data)
- (dht data)
- (let ((mx 0.0))
- (do ((i 0 (+ i 1)))
- ((= i 32))
- (let ((err (abs (- (vector-ref data i) (vector-ref saved-data i)))))
- (if (> err mx)
- (set! mx err))))
- (if (> mx 1e-6)
- (format #t "dht error: ~A~%" mx))))
+(when full-test
+(let () ; this is trying to cause a stack overflow
+ (define (f1 z)
+ (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos 0.0)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+
+ (num-test (f1 0.5) 0.4501836112948736)
+ (let ((c #f) (i 0)) (call/cc (lambda (c1) (set! c c1))) (set! i (+ i 1)) (let ((result (f1 0.5))) (if (< i 2) (c)) (num-test result 0.4501836112948736)))))
+
+
+(let ()
+ (define (dht data)
+ ;; the Hartley transform of 'data'
+ (let* ((len (vector-length data))
+ (arr (make-vector len 0.0))
+ (w (/ (* 2.0 pi) len)))
+ (do ((i 0 (+ 1 i)))
+ ((= i len))
+ (do ((j 0 (+ 1 j)))
+ ((= j len))
+ (vector-set! arr i (+ (vector-ref arr i)
+ (* (vector-ref data j)
+ (+ (cos (* i j w))
+ (sin (* i j w))))))))
+ arr))
+ (let ((data (list->vector '(0.9196 0.9457 0.0268 0.0839 0.1974 0.1060 0.1463 0.3513 0.0391 0.6310
+ 0.9556 0.6259 0.9580 0.8848 0.0104 0.1440 0.0542 0.3001 0.1844 0.3781
+ 0.9641 0.6051 0.3319 0.6143 0.1828 0.2290 0.4026 0.5990 0.7906 0.0403
+ 0.7882 0.1591)))
+ (saved-data (make-vector 32 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 32))
+ (vector-set! saved-data i (vector-ref data i)))
+ (dht data)
+ (dht data)
+ (let ((mx 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 32))
+ (let ((err (abs (- (vector-ref data i) (vector-ref saved-data i)))))
+ (if (> err mx)
+ (set! mx err))))
+ (if (> mx 1e-6)
+ (format-logged #t "dht error: ~A~%" mx)))))
(let ((coss (list
1.00000000000000000000000000000000000000000000000000000000000000000000
@@ -44683,7 +60398,7 @@ abs 1 2
(let ((err (abs (- (cos x) (list-ref coss i)))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format #t "cos err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format-logged #t "cos err: ~A~%" mxerr))))
(if with-bignums
(begin
@@ -44692,8 +60407,8 @@ abs 1 2
))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((cos-vals (list ; arprec mathtool table[Cos[k/20], {k, 0, 30}]
"1.00000000000000000000000000000000000000000000000000000000000000000000"
"0.99875026039496624656287081115652109495898026202467575301500996478674"
@@ -44730,8 +60445,8 @@ abs 1 2
((= k 30))
(let ((cos-val-2 (number->string (cos (/ k (bignum "20"))))))
(if (not (string=? (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59)))
- (format #t ";(cos (/ ~A 20)) mp: ~A does not match~%~A~%" k (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59))))))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(cos (/ ~A 20)) mp: ~A does not match~%~A~%" k (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59))))))
+ (set! (*s7* 'bignum-precision) old-prec)))
@@ -45172,7 +60887,7 @@ abs 1 2
(set! mxerr err)
(set! mxcase i))))))
(if (> mxerr 1e-35)
- (format #t "sum-cot max error ~A at ~A~%" mxerr mxcase))))
+ (format-logged #t "sum-cot max error ~A at ~A~%" mxerr mxcase))))
))
(for-each
@@ -45191,8 +60906,8 @@ abs 1 2
(list 1e+16+1e+16i 0+1i) (list 1e-16+1e-16i 1e-16+1e-16i) ))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((tans (list ; table[Tan[k/10], {k, 0, 30}]
0.00000000000000000000000000000000000000000000000000000000000000000000e0
0.10033467208545054505808004578111153681900480457644204002220806579803
@@ -45229,14 +60944,20 @@ abs 1 2
((= i 30))
(let ((val (tan (/ i (bignum "10")))))
(if (> (magnitude (- val (list-ref tans i))) 1e-35)
- (format #t ";(tan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref tans i) (magnitude (- val (list-ref tans i))))))))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(tan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref tans i) (magnitude (- val (list-ref tans i))))))))
+ (set! (*s7* 'bignum-precision) old-prec)))
(test (tan) 'error)
(test (tan "hi") 'error)
(test (tan 1.0+23.0i 1.0+23.0i) 'error)
(test (tan 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (tan arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
;;; --------------------------------------------------------------------------------
@@ -45740,7 +61461,7 @@ abs 1 2
(let ((y (magnitude (- x (sin (asin x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-12)
- (format #t ";(sin (asin ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(sin (asin ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -45750,13 +61471,19 @@ abs 1 2
(let ((y (magnitude (- x (sin (asin x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-9)
- (format #t ";(sin (asin ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(sin (asin ~A)) error: ~A~%" mx err)))
(test (asin) 'error)
(test (asin "hi") 'error)
(test (asin 1.0+23.0i 1.0+23.0i) 'error)
(test (asin 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (asin arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(let ((asins (list
0.00000000000000000000000000000000000000000000000000000000000000000000
0.02500260489936113599406838915349107150195748368840710160729904233944
@@ -45806,11 +61533,11 @@ abs 1 2
(let ((err (abs (- (asin x) (list-ref asins i)))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format #t "asin err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format-logged #t "asin err: ~A~%" mxerr))))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((asins (list ; table[Arcsin[k/30], {k, 0, 30}]
0.00000000000000000000000000000000000000000000000000000000000000000000e0
0.03333950926130208699143488077083860917565937855129663393680393744362
@@ -45847,8 +61574,8 @@ abs 1 2
((= i 30))
(let ((val (asin (/ i (bignum "30")))))
(if (> (magnitude (- val (list-ref asins i))) 1e-36)
- (format #t ";(asin ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref asins i) (magnitude (- val (list-ref asins i))))))))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(asin ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref asins i) (magnitude (- val (list-ref asins i))))))))
+ (set! (*s7* 'bignum-precision) old-prec)))
@@ -46352,7 +62079,7 @@ abs 1 2
(let ((y (magnitude (- x (cos (acos x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-12)
- (format #t ";(cos (acos ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(cos (acos ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -46362,16 +62089,22 @@ abs 1 2
(let ((y (magnitude (- x (cos (acos x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-10)
- (format #t ";(cos (acos ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(cos (acos ~A)) error: ~A~%" mx err)))
(test (acos) 'error)
(test (acos "hi") 'error)
(test (acos 1.0+23.0i 1.0+23.0i) 'error)
(test (acos 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (acos arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((acoss (list ; table[Arccos[k/30], {k, 0, 30}]
1.57079632679489661923132169163975144209858469968755291048747229615390
1.53745681753359453223988681086891283292292532113625627655066835871028
@@ -46408,8 +62141,8 @@ abs 1 2
((= i 30))
(let ((val (acos (/ i (bignum "30")))))
(if (> (magnitude (- val (list-ref acoss i))) 1e-36)
- (format #t ";(acos ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref acoss i) (magnitude (- val (list-ref acoss i))))))))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(acos ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref acoss i) (magnitude (- val (list-ref acoss i))))))))
+ (set! (*s7* 'bignum-precision) old-prec)))
@@ -47127,6 +62860,37 @@ abs 1 2
(test (atan 0 1 2) 'error)
(test (atan 0 0-i) 'error)
(test (atan 1+i 0-i) 'error)
+(test (atan 1 0-i) 'error)
+
+(for-each
+ (lambda (arg)
+ (test (atan arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (atan arg nan.0) 'error)
+ (test (atan nan.0 arg) 'error)
+ (test (atan arg inf.0) 'error)
+ (test (atan inf.0 arg) 'error)
+ (test (atan 1 arg) 'error)
+ (test (atan 1.0 arg) 'error)
+ (test (atan 1/2 arg) 'error)
+ (test (atan 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (atan arg 1) 'error)
+ (test (atan arg 1/2) 'error)
+ (test (atan arg 1.0) 'error)
+ (test (atan arg 1+i) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
(let ((formulas
'((1/4 (1 1))
@@ -47353,7 +63117,7 @@ abs 1 2
(set! mxerr err)))))
formulas)
(if (> mxerr 1e-30)
- (format #t "big max error: ~A~%" mxerr)))))
+ (format-logged #t "big max error: ~A~%" mxerr)))))
(let ((atans (list
0.00000000000000000000000000000000000000000000000000000000000000000000
@@ -47404,11 +63168,11 @@ abs 1 2
(let ((err (abs (- (atan x) (list-ref atans i)))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format #t "atan err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format-logged #t "atan err: ~A~%" mxerr))))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((atans (list ; table[Arctan[k/10], {k, 0, 30}]
0.00000000000000000000000000000000000000000000000000000000000000000000e0
0.09966865249116202737844611987802059024327832250431464801550877681002
@@ -47445,8 +63209,8 @@ abs 1 2
((= i 30))
(let ((val (atan (/ i (bignum "10")))))
(if (> (magnitude (- val (list-ref atans i))) 1e-36)
- (format #t ";(atan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref atans i) (magnitude (- val (list-ref atans i))))))))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(atan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref atans i) (magnitude (- val (list-ref atans i))))))))
+ (set! (*s7* 'bignum-precision) old-prec)))
@@ -47867,6 +63631,12 @@ abs 1 2
(test (sinh 1.0+23.0i 1.0+23.0i) 'error)
(test (sinh 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (sinh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
;;; --------------------------------------------------------------------------------
@@ -48298,9 +64068,9 @@ abs 1 2
(set! max-sh-error err)
(set! max-sh-error-case x))))))
(if (> max-s-error 1e-35)
- (format #t "s^2 + c^2 error: ~A at ~A~%" max-s-error max-s-error-case))
+ (format-logged #t "s^2 + c^2 error: ~A at ~A~%" max-s-error max-s-error-case))
(if (> max-sh-error 1e-33)
- (format #t "sh^2 + ch^2 error: ~A at ~A~%" max-sh-error max-sh-error-case)))
+ (format-logged #t "sh^2 + ch^2 error: ~A at ~A~%" max-sh-error max-sh-error-case)))
(num-test (sinh 1000.0) 9.850355570085234969444396761216615626576E433)
(num-test (cosh 1000.0) 9.850355570085234969444396761216615626576E433)
@@ -48312,6 +64082,12 @@ abs 1 2
(test (cosh 0 1) 'error)
(num-test (cosh 1/9223372036854775807) 1.000000000000000000000000000000000000006E0)
+(for-each
+ (lambda (arg)
+ (test (cosh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -48768,6 +64544,12 @@ abs 1 2
(test (tanh 1.0+23.0i 1.0+23.0i) 'error)
(test (tanh 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (tanh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
;;; --------------------------------------------------------------------------------
@@ -49251,6 +65033,12 @@ abs 1 2
(test (asinh 1.0+23.0i 1.0+23.0i) 'error)
(test (asinh 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (asinh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -49785,6 +65573,12 @@ abs 1 2
(test (acosh 1.0+23.0i 1.0+23.0i) 'error)
(test (acosh 0 1) 'error)
+(for-each
+ (lambda (arg)
+ (test (acosh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
@@ -50218,14 +66012,10 @@ abs 1 2
(test (atanh 0 1) 'error)
(for-each
- (lambda (op)
- (for-each
- (lambda (arg)
- (let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
- (if (not (eq? val 'error))
- (format #t ";(~A ~S) returned ~S but expected 'error~%" op arg val))))
- (list "hi" '() #\a (list 1) '(1 . 2) '#(0) #f 'a-symbol (make-vector 3) abs #t (if #f #f) (lambda (a) (+ a 1)))))
- (list cosh sinh tanh acosh asinh atanh))
+ (lambda (arg)
+ (test (atanh arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
(let ((err 0.0)
(mx 0.0))
@@ -50235,7 +66025,7 @@ abs 1 2
(let ((y (abs (- x (cosh (acosh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-14)
- (format #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -50245,7 +66035,7 @@ abs 1 2
(let ((y (magnitude (- x (cosh (acosh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-14)
- (format #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(cosh (acosh ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -50255,7 +66045,7 @@ abs 1 2
(let ((y (abs (- x (sinh (asinh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-14)
- (format #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -50265,7 +66055,7 @@ abs 1 2
(let ((y (magnitude (- x (sinh (asinh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-9)
- (format #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(sinh (asinh ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -50275,7 +66065,7 @@ abs 1 2
(let ((y (magnitude (- x (tanh (atanh x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-12)
- (format #t ";(tanh (atanh ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(tanh (atanh ~A)) error: ~A~%" mx err)))
(for-each
(lambda (num-and-val)
@@ -50830,6 +66620,9 @@ abs 1 2
(num-test (sqrt 9000000000000000000) 3000000000)
;; but unfortunately in non-gmp, 9400000000000000000 -> -9046744073709551616
+(test (and (integer? (sqrt 9007199136250226)) (exact? (sqrt 9007199136250226))) #f)
+(test (and (integer? (sqrt 9007199136250225)) (exact? (sqrt 9007199136250225))) #t)
+
(if (integer? (sqrt 4))
(begin
(for-each
@@ -50838,7 +66631,7 @@ abs 1 2
(let ((val (sqrt n)))
(if (or (not (integer? val))
(not (eqv? sqn val)))
- (format #t ";(sqrt ~A) expected ~A but got ~A~%" n sqn val)))))
+ (format-logged #t ";(sqrt ~A) expected ~A but got ~A~%" n sqn val)))))
(list 9 491401 19439281 1248844921 235565593201)
(list 3 701 4409 35339 485351))
@@ -50848,7 +66641,7 @@ abs 1 2
(let ((val (sqrt n)))
(if (or (integer? val)
(> (abs (- (* val val) n)) .001))
- (format #t ";(sqrt ~A) expected ~A but got ~A~%" n (sqrt (* 1.0 n)) val)))))
+ (format-logged #t ";(sqrt ~A) expected ~A but got ~A~%" n (sqrt (* 1.0 n)) val)))))
(list 10 491400 19439282 1248844920 235565593200))
(test (eqv? (expt 2 3) 8) #t)
@@ -50867,7 +66660,7 @@ abs 1 2
(let ((y (magnitude (- x (* (sqrt x) (sqrt x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-14)
- (format #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -50877,7 +66670,7 @@ abs 1 2
(let ((y (magnitude (- x (* (sqrt x) (sqrt x))))))
(if (> y err) (begin (set! mx x) (set! err y)))))
(if (> err 1e-12)
- (format #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(sqr (sqrt ~A)) error: ~A~%" mx err)))
(num-test (* (/ 4 (sqrt 522))
(log (* (expt (/ (+ 5 (sqrt 29)) (sqrt 2)) 3)
@@ -50936,11 +66729,16 @@ abs 1 2
(num-test (sqrt 0+340282366920938463463374607431768211456i) 1.304381782533278221234957180625250836888E19+1.304381782533278221234957180625250836888E19i)
))
-
(test (sqrt) 'error)
(test (sqrt "hi") 'error)
(test (sqrt 1.0+23.0i 1.0+23.0i) 'error)
+(for-each
+ (lambda (arg)
+ (test (sqrt arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
(num-test (sqrt 1/1073741824) 1/32768)
(num-test (sqrt 1/274877906944) 1/524288)
(num-test (sqrt 9223372030926249001) 3037000499)
@@ -51020,7 +66818,7 @@ abs 1 2
(let ((err (abs (- (sqrt i) (list-ref sqrts (- i 1))))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format #t "sqrt err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format-logged #t "sqrt err: ~A~%" mxerr))))
(if with-bignums
(begin
@@ -51031,8 +66829,8 @@ abs 1 2
))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((sqrts (list ; table[Sqrt[k/10], {k, 0, 30}]
0.00000000000000000000000000000000000000000000000000000000000000000000e0
0.31622776601683793319988935444327185337195551393252168268575048527925
@@ -51069,8 +66867,8 @@ abs 1 2
((= i 30))
(let ((val (sqrt (/ i (bignum "10")))))
(if (> (magnitude (- val (list-ref sqrts i))) 1e-36)
- (format #t ";(sqrt ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref sqrts i) (magnitude (- val (list-ref sqrts i))))))))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(sqrt ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref sqrts i) (magnitude (- val (list-ref sqrts i))))))))
+ (set! (*s7* 'bignum-precision) old-prec)))
@@ -51519,8 +67317,8 @@ abs 1 2
(num-test (exp -2.0e+00-9.42512322775237976202e+00i) -1.3533527517000128919e-1+4.6726804008183852982e-5i)
(num-test (exp -1000) 0.0)
(num-test (exp -1000000) 0.0)
-(num-test (exp (make-rectangular 0.0 (* 0.5 pi))) 0+i)
-(num-test (exp (make-rectangular 0.0 pi)) -1)
+(num-test (exp (complex 0.0 (* 0.5 pi))) 0+i)
+(num-test (exp (complex 0.0 pi)) -1)
(num-test (exp 100.0) 2.688117141816135e43)
(num-test (exp 500.0) 1.40359221785284E+217)
(num-test (exp -100.0) 3.720075976020836E-44)
@@ -51537,7 +67335,7 @@ abs 1 2
(num-test (exp (* pi (sqrt 22))) 2508951.998257424)
(num-test (exp (* pi (sqrt 6))) 2197.9908695437)
(num-test (exp (* pi (sqrt 719))) 3.8426143735395488914902942778058291929999e+36)
-(num-test (exp (make-rectangular 0.0 pi)) -1.0)
+(num-test (exp (complex 0.0 pi)) -1.0)
(for-each
(lambda (num-and-val)
@@ -51557,12 +67355,25 @@ abs 1 2
(test (exp "hi") 'error)
(test (exp 1.0+23.0i 1.0+23.0i) 'error)
+(for-each
+ (lambda (arg)
+ (test (exp arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(if (not with-bignums)
+ (begin
+ (test (infinite? (exp (expt 2 16))) #t)
+ (test (infinite? (exp (expt 2 54))) #t)
+ (test (infinite? (exp (exp 1e3))) #t)
+ ))
+
(if with-bignums
(begin
(let ((val1 (* 1000 (- (exp 30) 10686474581524)))
(val2 (* 1000 (- (exp (bignum "30")) 10686474581524))))
(if (> (abs (- val1 val2)) 1)
- (format #t "(exp 30): ~A ~A~%" val1 val2)))
+ (format-logged #t "(exp 30): ~A ~A~%" val1 val2)))
(num-test (exp (* 172.60813659204 (log 172.60813659204))) 1.364508485146898675293943657160611234948E386) ; not inf!
(num-test (exp 800.0) 2.726374572112566567364779546367269757963E347)
(num-test (exp -800.0) 3.667874584177687213455495654260798215465E-348)
@@ -51570,8 +67381,8 @@ abs 1 2
(num-test (exp 50.0) 5.184705528587072464087453322933485384827E21)))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((exps (list ; table[Exp[k/10], {k, 0, 30}]
1.00000000000000000000000000000000000000000000000000000000000000000000
1.10517091807564762481170782649024666822454719473751871879286328944096
@@ -51608,8 +67419,8 @@ abs 1 2
((= i 30))
(let ((val (exp (/ i (bignum "10")))))
(if (> (magnitude (- val (list-ref exps i))) 1e-36)
- (format #t ";(exp ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref exps i) (magnitude (- val (list-ref exps i))))))))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(exp ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref exps i) (magnitude (- val (list-ref exps i))))))))
+ (set! (*s7* 'bignum-precision) old-prec)))
@@ -51679,7 +67490,7 @@ abs 1 2
(num-test (log -0.00000001-1234000000.0i) 20.93352676242961-1.57079632679490i)
(num-test (log -0.00000001-2.71828182845905i) 1.0-1.57079633047369i)
(num-test (log -0.00000001-3.14159265358979i) 1.14472988584940-1.57079632997800i)
-(num-test (log -0.1e001) (make-rectangular 0.0 pi))
+(num-test (log -0.1e001) (complex 0.0 pi))
(num-test (log -1 -1) 1.0)
(num-test (log -1) 0.0+3.141592653589793238462643383279502884197169399375105820974944592307816406286198E0i)
(num-test (log -1) 0.0+3.14159265358979i)
@@ -51937,8 +67748,8 @@ abs 1 2
(num-test (log -8.3886080e+06-8.3886080e+06i) 1.6288958743158714771e1-2.3561944901923449288e0i)
(num-test (log -9223372036854775808) 4.366827237527655449328562365186512378885E1+3.141592653589793238462643383279502884195E0i)
(num-test (log .3678794411714423) -1.0)
-(num-test (log 0+i) (make-rectangular 0.0 (* 0.5 pi)))
-(num-test (log 0-i) (make-rectangular 0.0 (* -0.5 pi)))
+(num-test (log 0+i) (complex 0.0 (* 0.5 pi)))
+(num-test (log 0-i) (complex 0.0 (* -0.5 pi)))
(num-test (log 0.0+0.00000001i) -18.42068074395237+1.57079632679490i)
(num-test (log 0.0+1.0i) 0.0+1.57079632679490i)
(num-test (log 0.0+1234.0i) 7.11801620446533+1.57079632679490i)
@@ -52062,7 +67873,7 @@ abs 1 2
(num-test (log 1/500029) -13.12242137572239)
(num-test (log 1/65536 2) -16)
(num-test (log 1/8192 2) -13)
-(num-test (log 10 (real-part (log 0))) 0.0) ; ???
+;(num-test (log 10 (real-part (log 0))) 0.0) ; ??? -- this returns -nan-nani in clang, 0.0 in gcc
(num-test (log 10) 2.30258509299405)
(num-test (log 10.0 (exp -1)) (- (log 10.0)))
(num-test (log 10.0 (exp 1)) (log 10.0))
@@ -52293,10 +68104,24 @@ abs 1 2
(num-test (log 9.0 3.0) 2.0)
(num-test (log 9223372036854775807) 4.366827237527655449317720343461657334526E1)
(num-test (log pi) 1.14472988584940)
+(num-test (log (/ 1+i)) (log (/ 1 1+i)))
(test (< (real-part (log 0.0)) (real-part (- (log 0.0)))) #t)
-(test (infinite? (random (log 0.0))) #t) ; should (random inf.0 inf.0) be 0?
+
+(test (infinite? (random (log 0.0))) #t)
+(test (infinite? (random inf.0)) #t)
;(num-test (log 1 1) 'error) ; (expt 1 0) is 1 but so is (expt 1 1) -- an ambiguous case (returns NaN in gmp)
;(num-test (log 2 1) 'error) ; now returns infinity
+;; this is actually inconsistent in one way:
+;; (log 1/0 2) -> nannani, (log 1/0 1) -> inf.0
+
+(num-test (log -1) (complex 0 pi))
+
+(do ((i 0 (+ i 1))
+ (n 1 (* n 2)))
+ ((= i 60))
+ (let ((x (log n 2)))
+ (if (not (= (expt 2 i) n))
+ (format *stderr* "(log ~D 2): ~A~%" n x))))
(for-each
(lambda (num-and-val)
@@ -52323,7 +68148,7 @@ abs 1 2
(let ((y (magnitude (- x (exp (log x))))))
(if (> y err) (begin (set! mx x) (set! err y))))))
(if (> err 1e-14)
- (format #t ";(exp (log ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(exp (log ~A)) error: ~A~%" mx err)))
(let ((err 0.0)
(mx 0.0))
@@ -52334,7 +68159,7 @@ abs 1 2
(let ((y (magnitude (- x (exp (log x))))))
(if (> y err) (begin (set! err y) (set! mx x))))))
(if (> err 1e-14)
- (format #t ";(exp (log ~A)) error: ~A~%" mx err)))
+ (format-logged #t ";(exp (log ~A)) error: ~A~%" mx err)))
(do ((i 0 (+ i 1)))
((= i 100))
@@ -52378,8 +68203,8 @@ abs 1 2
(if (> (random 1.0) 0.5) (set! val2 (- val2)))
(if (> (random 1.0) 0.5) (set! base1 (- base1)))
(if (> (random 1.0) 0.5) (set! base2 (- base2)))
- (let ((val (make-rectangular val1 val2))
- (base (make-rectangular base1 base2)))
+ (let ((val (complex val1 val2))
+ (base (complex base1 base2)))
(num-test (log val base) (/ (log val) (log base))))))
(if (not with-bignums)
@@ -52453,11 +68278,11 @@ abs 1 2
(abs (- (log y) (list-ref logs-2 i))))))
(if (> err mxerr)
(set! mxerr err))))
- (if (> mxerr 1e-12) (format #t "log err: ~A~%" mxerr))))
+ (if (> mxerr 1e-12) (format-logged #t "log err: ~A~%" mxerr))))
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 500)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 500)
(let ((logs (list ; table[Log[k/10 + 1.0], {k, 0, 30}]
0.00000000000000000000000000000000000000000000000000000000000000000000e0
0.09531017980432486004395212328076509222060536530864419918523980816300
@@ -52495,8 +68320,8 @@ abs 1 2
((= i 30))
(let ((val (log (+ (/ i (bignum "10")) (bignum "1.0")))))
(if (> (magnitude (- val (list-ref logs i))) 1e-36)
- (format #t ";(log ~A) -> ~A ~A~%[~A]~%" (+ 1.0 (/ i 10)) val (list-ref logs i) (magnitude (- val (list-ref logs i))))))))
- (set! (bignum-precision) old-prec)))
+ (format-logged #t ";(log ~A) -> ~A ~A~%[~A]~%" (+ 1.0 (/ i 10)) val (list-ref logs i) (magnitude (- val (list-ref logs i))))))))
+ (set! (*s7* 'bignum-precision) old-prec)))
(test (log) 'error)
(test (log "hi") 'error)
@@ -52508,8 +68333,25 @@ abs 1 2
(for-each
(lambda (arg)
- (test (log 10.0 arg) 'error))
- (list "hi" #\a 0 '#(1 2 3) #t #f '() abs 'hi (list 1 2 3) '(1 . 2)))
+ (test (log arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (log arg nan.0) 'error)
+ (test (log nan.0 arg) 'error)
+ (test (log arg inf.0) 'error)
+ (test (log inf.0 arg) 'error)
+ (test (log 10 arg) 'error)
+ (test (log arg 10) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+;;; do these make sense?
+;;; (log -nan.0 1) -> inf.0
+;;; (log 1+infi 1) -> inf.0
@@ -52616,17 +68458,17 @@ abs 1 2
(num-test (expt -0.00000001 0.00000001) 0.99999981579321+0.00000003141592i)
(num-test (expt -0.00000001 1) -0.00000001+0.0i)
(num-test (expt -0.00000001 1.0) -0.00000001+0.0i)
-(num-test (expt -0.00000001 10) 0.0-0.0i)
+(num-test (expt -0.00000001 10) 1e-80)
(num-test (expt -0.00000001 1234) 0.0)
(num-test (expt -0.00000001 1234.0) 0.0)
(num-test (expt -0.00000001 1234000000) 0.0)
(num-test (expt -0.00000001 1234000000.0) 0.0)
-(num-test (expt -0.00000001 2) 0.0-0.0i)
-(num-test (expt -0.00000001 2.71828182845905) -0.0+0.0i)
-(num-test (expt -0.00000001 3) -0.0+0.0i)
+(num-test (expt -0.00000001 2) 1e-16)
+(num-test (expt -0.00000001 2.71828182845905) -1.135859060227e-22+1.388206815575e-22i)
+(num-test (expt -0.00000001 3) -1e-24)
(num-test (expt -0.00000001 362880) 0.0)
(num-test (expt -0.00000001 500029) 0.0)
-(num-test (expt -0.00000001 pi) -0.0-0.0i)
+(num-test (expt -0.00000001 pi) -6.6495946361558e-26-3.1697962381573e-26i)
(num-test (expt -0.00000001+0.00000001i 1.0-0.0i) -0.00000001+0.00000001i)
(num-test (expt -0.00000001+0.0i 0.00000001-0.00000001i) 0.99999984720911+0.00000021562270i)
(num-test (expt -0.00000001-0.00000001i -1.0-0.0i) -50000000.00000003725290+50000000.00000004470348i)
@@ -52710,7 +68552,7 @@ abs 1 2
(num-test (expt -1.0e+00+0.0e+00i 5.0e-01+1.00000000000000005551e-01i) 0+7.3040269104864559813e-1i)
(num-test (expt -1.0e+00+0.0e+00i 5.0e-01-1.00000000000000005551e-01i) 0+1.3691077706248469087e0i)
(num-test (expt -1/10 1234/1234000000) 0.99999769741262+0.00000314158542i)
-(num-test (expt -1/2 (- (real-part (log 0)))) (expt -0.5 (- (real-part (log 0)))))
+(if (not (provided? 'freebsd)) (num-test (expt -1/2 (- (real-part (log 0)))) (expt -0.5 (- (real-part (log 0))))))
(num-test (expt -1/2 3/362880) 0.99999426929571+0.00002597201266i)
(num-test (expt -1/3 10/500029) 0.99997802729625+0.00006282682861i)
(num-test (expt -1/362880 0/2) 1)
@@ -52769,7 +68611,7 @@ abs 1 2
(num-test (expt -1234000000.0 0) 1.0)
(num-test (expt -1234000000.0 0.0) 1.0)
(num-test (expt -1234000000.0 0.00000001) 1.00000020933529+0.00000003141593i)
-(num-test (expt -1234000000.0-1234.0i -2.71828182845905-0.00000001i) -0.0+0.0i)
+(num-test (expt -1234000000.0-1234.0i -2.71828182845905-0.00000001i) -1.2269326149532e-25+1.4995226540245e-25i)
(num-test (expt -1234000000/10 1/2) 0.00000000000068+11108.55526159905094i)
(num-test (expt -1234000000/3 0/3) 1)
(num-test (expt -1234000000/362880 1234/500029) 1.02023991975054+0.00791007960266i)
@@ -52870,7 +68712,7 @@ abs 1 2
(num-test (expt -500029/1 362880/1234000000) 1.00386591183654+0.00092741384842i)
(num-test (expt -500029/10 2/3) -678.63064326537926+1175.42275370878747i)
(num-test (expt -500029/1234 3/2) -0.00000000000150-8156.80442672750178i)
-(num-test (expt -500029/1234000000 10/1) 0.0-0.0i)
+(num-test (expt -500029/1234000000 10/1) 0.0)
(num-test (expt -500029/2 0/1234) 1)
(num-test (expt -500029/3 1/10) 3.16514579334680+1.02841820970710i)
(num-test (expt .1 -1) 10.0)
@@ -52884,7 +68726,9 @@ abs 1 2
(num-test (expt 0 -0.0) 0.0)
(num-test (expt 0 -0/4) 1)
(num-test (expt 0 0) 1)
+(num-test (expt 0 -0) 1)
(num-test (expt 0 0.0) 0.0)
+(num-test (expt 0 -0.0) 0.0)
(num-test (expt 0 0.00000001) 0.0)
(num-test (expt 0 1) 0)
(num-test (expt 0 1.0) 0.0)
@@ -52912,7 +68756,7 @@ abs 1 2
(num-test (expt 0+i 0+i) 2.078795763507619085469556198349787700342E-1)
(num-test (expt 0+i 0+i) (exp (/ pi -2)))
(num-test (expt 0+i 0-i) 4.810477380965351655473035666703833126401E0)
-(num-test (expt 0+i 1/2) (make-rectangular (/ (sqrt 2)) (/ (sqrt 2))))
+(num-test (expt 0+i 1/2) (complex (/ (sqrt 2)) (/ (sqrt 2))))
(num-test (expt 0+i 2) -1.0)
(num-test (expt 0-i 1+i) 0.0-4.810477380965351655473035666703833126401E0i)
(num-test (expt 0-i 1-i) 0.0-2.078795763507619085469556198349787700342E-1i)
@@ -52983,6 +68827,32 @@ abs 1 2
(num-test (expt 0/3 3/1234000000) 0.0)
(num-test (expt 0/362880 362880/1) 0)
(num-test (expt 0/500029 500029/2) 0.0)
+(num-test (expt -0.0 most-positive-fixnum) 0.0)
+(num-test (expt 0 most-positive-fixnum) 0)
+(test (expt 0 (- (expt 2 32))) 'error)
+(test (expt 0 (- (expt 2.0 60))) 'error)
+(test (expt 0 (complex (- (expt 2 60)) 1.0)) 'error)
+(test (expt 0 -255) 'error)
+(test (expt 0 -1) 'error)
+(test (expt 0 -1.0) 'error)
+(test (expt 0 -1/2) 'error)
+(num-test (expt 0 1/2) 0) ; or 0.0
+(num-test (expt 0 -0+i) 0.0)
+(num-test (expt 0 -0-i) 0.0)
+(test (expt 0 -1+i) 'error)
+(test (expt 0 most-negative-fixnum) 'error)
+(test (expt 0.0 most-negative-fixnum) 'error)
+(test (expt 0.0 -255) 'error)
+(test (expt 0.0 -1) 'error)
+(test (expt 0.0 -1.0) 'error)
+(test (expt 0.0 -1/2) 'error)
+(num-test (expt 0.0 1/2) 0.0)
+(num-test (expt 0.0 -0+i) 0.0)
+(num-test (expt 0.0 -0-i) 0.0)
+(test (expt 0.0 -1+i) 'error)
+(test (expt 0.0 most-negative-fixnum) 'error)
+(test (expt 0.0 most-negative-fixnum) 'error)
+(num-test (expt 1 1/2) 1)
(num-test (expt 1 (- (expt 2 32))) 1)
(num-test (expt 1 (expt 2 32)) 1)
(num-test (expt 1 (real-part (log 0))) (expt 1.0 (real-part (log 0))))
@@ -53100,6 +68970,9 @@ abs 1 2
(num-test (expt 1/64 1/3) 1/4)
(num-test (expt 1/64 2/3) 1/16)
(num-test (expt 1/64 3/2) 1/512)
+(num-test (expt 1/9223372036854775807 -1) 9223372036854775807)
+(num-test (expt 1/9223372036854775807 1) 1/9223372036854775807)
+(num-test (expt 9223372036854775807 -1) 1/9223372036854775807)
(num-test (expt 10 -0.0) 1.0)
(num-test (expt 10 -0.00000001) 0.99999997697415)
(num-test (expt 10 -1) 1/10)
@@ -53180,7 +69053,7 @@ abs 1 2
(num-test (expt 1234000000.0 0) 1.0)
(num-test (expt 1234000000.0 0.0) 1.0)
(num-test (expt 1234000000.0 0.00000001) 1.00000020933529)
-(num-test (expt 1234000000.0-1234.0i -2.71828182845905+0.00000001i) 0.0+0.0i)
+(num-test (expt 1234000000.0-1234.0i -2.71828182845905+0.00000001i) 1.9375066625441e-25+5.672277629054e-31i)
(num-test (expt 1234000000/10 1/2) 11108.55526159905094)
(num-test (expt 1234000000/3 0/3) 1)
(num-test (expt 1234000000/362880 1234/500029) 1.02027058333165)
@@ -53196,6 +69069,10 @@ abs 1 2
(num-test (expt 1e-15 1e100) 0.0)
(num-test (expt 1e15 -1e1) 1e-150)
(num-test (expt 1e15 1e1) 1e150)
+(num-test (expt 1e18 -3) 1e-54)
+(if (not with-bignums) (num-test (expt 1e18 -63) 0.0)) ; 1e-1134
+(num-test (expt 1+1i -63) 2.3283064365386962890625E-10+2.3283064365386962890625E-10i)
+(num-test (expt 1+1i -3) -0.25-0.25i)
(num-test (expt 2 (real-part (log 0))) (expt 2.0 (real-part (log 0))))
(num-test (expt 2 -0.0) 1.0)
(num-test (expt 2 -0.00000001) 0.99999999306853)
@@ -53219,6 +69096,7 @@ abs 1 2
(num-test (expt 2 2.71828182845905) 6.58088599101792)
(num-test (expt 2 3) 8)
(num-test (expt 2 9) 512)
+(if (not with-bignums) (test (infinite? (expt 2 1000000000000)) #t))
(num-test (expt 2 pi) 8.82497782707629)
(num-test (expt 2.0 -1.0220000e+03) 2.225073858507201383090232717332404063624E-308)
(num-test (expt 2.0 1.0230000e+03) 8.98846567431157953864652595394512365232E307)
@@ -53367,7 +69245,11 @@ abs 1 2
(num-test (expt 500029/1 362880/1234000000) 1.00386634022855)
(num-test (expt 500029/10 2/3) 1357.26128653075921)
(num-test (expt 500029/1234 3/2) 8156.80442672750178)
-(num-test (expt 500029/1234000000 10/1) 0.0)
+
+(if (not with-bignums)
+ (num-test (expt 500029/1234000000 10/1) 0.0)
+ (num-test (expt 500029/1234000000 10/1) 977129054104898258427314355689841897479681961836578300201/8187505353567209228244052427776000000000000000000000000000000000000000000000000000000000000))
+
(num-test (expt 500029/2 0/1234) 1)
(num-test (expt 500029/3 1/10) 3.32803123591083)
(num-test (expt 50664/22466 50664/22466) 6.258302816095884603297081160883745414829E0)
@@ -53402,15 +69284,67 @@ abs 1 2
(num-test (sqrt (- 161 (* 12 (expt 5 1/4)))) (+ (* 2 (expt 5 3/4)) (- (* 3 (sqrt 5))) (* 4 (sqrt (sqrt 5))) 6))
(num-test (sqrt (- 2 (expt 2 1/7))) (/ (* (expt 2 1/14) (+ (- (expt 2 6/7)) (expt 2 5/7) (expt 2 3/7) (* 2 (expt 2 1/7)) -1)) (sqrt 7)))
(test (= (+ (expt 2421 3) (expt 19083 3)) (+ (expt 5436 3) (expt 18948 3)) (+ (expt 10200 3) (expt 18072 3)) (+ (expt 13322 3) (expt 16630 3))) #t)
-(test (expt -0.0 most-positive-fixnum) 0.0)
-(test (expt 0 most-positive-fixnum) 0)
-(test (expt 0 (- (expt 2 32))) 'error)
-(test (expt 0 (- (expt 2.0 60))) 'error)
-(test (expt 0 (make-rectangular (- (expt 2 60)) 1.0)) 'error)
-(test (expt 0 -255) 'error)
-(test (expt 0 most-negative-fixnum) 'error)
-(test (expt 0.0 most-negative-fixnum) 'error)
+;;; amol sasane MAA Monthly
+(num-test (expt (sqrt 2) (log 3 2)) (sqrt 3))
+(num-test (expt (expt 2 (sqrt 2)) 1/2) (expt (sqrt 2) (sqrt 2)))
+(num-test (expt (sqrt 2) (* 2 (log 3 2))) 3)
+(num-test (expt (sqrt 2) (+ (sqrt 2) 1)) (* (sqrt 2) (expt (sqrt 2) (sqrt 2))))
+(num-test (expt (expt (sqrt 2) (sqrt 2)) (sqrt 2)) 2)
+
+(if (not with-bignums)
+ (begin
+ (num-test (expt (+ 1 (/ 1000000)) 100) 1.0001000049501534764)
+ (num-test (expt (+ 1 (/ 1000000000)) 100000000) 1.1051709271646142850)
+ (num-test (expt (+ 1 (/ 1000000000)) 10000000000) 2.20264839094613347809362152246750859877E4)
+ (test (infinite? (expt 3/4 most-negative-fixnum)) #t)
+ (num-test (expt 4/3 most-negative-fixnum) 0)
+ (num-test (expt 1.0 most-negative-fixnum) 1.0)
+ (num-test (expt -1.0 most-negative-fixnum) 1.0)
+ (num-test (expt 1.0 most-positive-fixnum) 1.0)
+ (num-test (expt -1.0 most-positive-fixnum) -1.0)
+ (num-test (expt -1.0 (+ (expt 2 53) 1)) -1.0)
+ (num-test (expt -1.0 (- 1 (expt 2 54))) -1.0)
+ (num-test (expt -1.0 (expt 2 54)) 1.0)
+ (num-test (expt 2.0 (- (expt 2 53))) 0.0)
+ (num-test (expt 2 most-negative-fixnum) 0)
+ (test (nan? (expt 1/0 0)) #t)
+ (test (nan? (expt (complex 0 1/0) 0)) #t)
+ (test (nan? (expt (complex 1/0 1/0) 0)) #t)
+ (test (nan? (expt (complex 1/0 0) 0)) #t)
+ (num-test (expt most-negative-fixnum 8) 5.237424972633826992021103514924158643547E151)
+ (num-test (expt most-negative-fixnum 2) 8.5070591730234615865843651857942052864E37)
+ (num-test (expt most-negative-fixnum -1) -1.084202172485504434007452800869941711426E-19)
+ (num-test (expt most-negative-fixnum -2) 1.175494350822287507968736537222245677819E-38)))
+
+(num-test (expt 1 most-negative-fixnum) 1)
+(num-test (expt -1 most-negative-fixnum) 1)
+(num-test (expt 1 most-positive-fixnum) 1)
+(num-test (expt -1 most-positive-fixnum) -1)
+(num-test (expt most-positive-fixnum 1) most-positive-fixnum)
+(num-test (expt most-positive-fixnum -1) (/ most-positive-fixnum))
+(num-test (expt most-negative-fixnum 1) most-negative-fixnum)
+(num-test (expt most-negative-fixnum 0) 1)
+(num-test (expt 1/9223372036854775807 9223372036854775807) 0.0)
+(test (infinite? (expt 1/9223372036854775807 -9223372036854775807)) #t)
+(test (infinite? (expt 9223372036854775807 9223372036854775807)) #t)
+
+(num-test (expt 0+i (+ 0 (expt 2 16))) 1.0)
+(num-test (expt 0+i (+ 1 (expt 2 16))) 0+i)
+(num-test (expt 0+i (+ 2 (expt 2 16))) -1.0)
+(num-test (expt 0+i (+ 3 (expt 2 16))) 0-i)
+(num-test (expt 0-i (+ 0 (expt 2 16))) 1.0)
+(num-test (expt 0-i (+ 1 (expt 2 16))) 0-i)
+(num-test (expt 0-i (+ 2 (expt 2 16))) -1.0)
+(num-test (expt 0-i (+ 3 (expt 2 16))) 0+i)
+(num-test (expt 0+i (+ 0 (expt 2 54))) 1.0)
+(num-test (expt 0+i (+ 1 (expt 2 54))) 0+i)
+(num-test (expt 0+i (+ 2 (expt 2 54))) -1.0)
+(num-test (expt 0+i (+ 3 (expt 2 54))) 0-i)
+(num-test (expt 0-i (+ 0 (expt 2 54))) 1.0)
+(num-test (expt 0-i (+ 1 (expt 2 54))) 0-i)
+(num-test (expt 0-i (+ 2 (expt 2 54))) -1.0)
+(num-test (expt 0-i (+ 3 (expt 2 54))) 0+i)
(let ((val1 (catch #t (lambda () (expt 0.0 0.0)) (lambda args 'error)))
(val2 (catch #t (lambda () (expt 0.0 -0.0)) (lambda args 'error))))
@@ -53426,7 +69360,7 @@ abs 1 2
#|
(do ((i 30 (+ i 1)))
((= i 63))
- (format #t "~D: (- ~A ~A) -> ~A~%" i (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100) (- (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100))))
+ (format-logged #t "~D: (- ~A ~A) -> ~A~%" i (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100) (- (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100))))
55: (- 3.6028797018964e+16 3.6028797018964e+16) -> 400.0
56: (- 7.2057594037928e+16 7.2057594037928e+16) -> 400.0
@@ -53442,7 +69376,7 @@ abs 1 2
(< (magnitude (- (expt -2/362880 1/3) 0.00883199860790-0.01529747032127i)) 1e-6)
(< (magnitude (- (expt -2/362880 1/3) -0.017663997215805)) 1e-6)) #t)
-(test (< (abs (- (+ (make-rectangular 1.0 0.0) (make-polar 1.0 0.0) 1.0+0i (* -1.0 -1.0) (/ 1.0)
+(test (< (abs (- (+ (complex 1.0 0.0) (make-polar 1.0 0.0) 1.0+0i (* -1.0 -1.0) (/ 1.0)
(exp 0.0) (abs -1.0) (cos 0.0) (log (exp 1)) (magnitude 1.0+0i) (max 0.0 1.0) (min 1.0 2.0))
12.0))
1e-12)
@@ -53456,7 +69390,7 @@ abs 1 2
(lambda (y)
(num-test (expt (expt x y) (/ y)) x)
;; (if (> (magnitude (- (expt (expt x y) (/ y)) x)) 1e-6)
- ;; (format #t ";(expt (expt ~A ~A) (/ ~A)) -> ~A (~A)~%" x y y (expt (expt x y) (/ y)) (magnitude (- (expt (expt x y) (/ y)) x))))
+ ;; (format-logged #t ";(expt (expt ~A ~A) (/ ~A)) -> ~A (~A)~%" x y y (expt (expt x y) (/ y)) (magnitude (- (expt (expt x y) (/ y)) x))))
)
ys))
xs))
@@ -53473,7 +69407,7 @@ abs 1 2
(g2 (gx (expt 10 (- i)))))
(let ((diff (abs (- g1 g2))))
(if (or (nan? diff) (> diff (expt 10 (- -7 i))))
- (format #t ";g(1e-~D) -> ~A ~A, diff: ~A~%" i g1 g2 (abs (- g1 g2))))))))
+ (format-logged #t ";g(1e-~D) -> ~A ~A, diff: ~A~%" i g1 g2 (abs (- g1 g2))))))))
(let ((p (lambda (x y) (+ (* 2 y y) (* 9 x x x x) (* -1 y y y y)))))
(num-test (p 408855776 708158977) 1))
@@ -53550,8 +69484,8 @@ abs 1 2
((= i 10))
(let ((v (vector i (- i) (/ i) (/ i (+ i 1)) (- (/ i)) (/ (- i) (+ i 1))
(random (* i 10.0)) (sqrt i) (+ i (random (sqrt i))) (- (random (* i 2.0)) i)
- (make-rectangular i i)
- (make-rectangular (- i) (- i))
+ (complex i i)
+ (complex (- i) (- i))
)))
(let ((len (length v)))
(do ((k 0 (+ k 1)))
@@ -53566,7 +69500,7 @@ abs 1 2
(min (magnitude (- val1 val2))
(magnitude (- val1 val3)))))
(if (> (/ diff (max (magnitude val1) 1)) 1e-12)
- (format #t ";(expt ~A ~A), ~A ~A ~A: ~A~%" (v k) (v j) val1 val2 val3 diff)))))))))))
+ (format-logged #t ";(expt ~A ~A), ~A ~A ~A: ~A~%" (v k) (v j) val1 val2 val3 diff)))))))))))
(if with-bignums
(num-test (let ((dickey (lambda (x y) ; from Kawa
@@ -53637,7 +69571,7 @@ abs 1 2
)
(begin
(num-test (* (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 4398046513152/1048577)
- (test (expt 1/2 9223372036854775807) 'error) ; gmp overflow
+ (test (expt 1/2 9223372036854775807) 0.0)
(num-test (expt (expt -4722366482869645213696/6561 1/2) 2) -4722366482869645213696/6561)
(num-test (expt 324518553658426726783156020576256.0 1/3) 68719476736.0)
(num-test (expt 4722366482869645213696 1/2) 68719476736)
@@ -53670,387 +69604,419 @@ abs 1 2
(test (zero? (- (expt 2 1/3) 1.2599210498949)) #f) ; make sure it's not just libm's cbrt
))
-(for-each
- (lambda (data)
- (let ((num1 (car data)) (num2 (cadr data)) (val (caddr data))) (num-test-2 'expt num1 num2 (expt num1 num2) val)))
- (vector (list 0 0 1) (list 0 1 0) (list 0 2 0) (list 0 3 0) (list 0 1/2 0) (list 0 1/3 0)
- (list 0 0.0 0.0) (list 0 1.0 0.0) (list 0 2.0 0.0) (list 0 1.000000000000000000000000000000000000002E-309 0.0)
- (list 0 1e+16 0.0) (list 0 inf.0 0.0) (list 0 0+1i 0.0) (list 0 0+2i 0.0)
- (list 0 0-1i 0.0) (list 0 1+1i 0.0) (list 0 1-1i 0.0) (list 0 0.1+0.1i 0.0) (list 0 1e+16+1e+16i 0.0)
- (list 0 1e-16+1e-16i 0.0) (list 1 0 1) (list 1 1 1) (list 1 2 1) (list 1 3 1) (list 1 -1 1)
- (list 1 -2 1) (list 1 -3 1) (list 1 1/2 1) (list 1 1/3 1.0) (list 1 -1/2 1.000E0)
- (list 1 -1/3 1.000E0) (list 1 0.0 1.000E0) (list 1 1.0 1.000E0) (list 1 2.0 1.000E0)
- (list 1 -2.0 1.000E0) (list 1 1.000000000000000000000000000000000000002E-309 1.000E0)
- (list 1 1e+16 1.000E0) (list 1 inf.0 1.000E0) (list 1 -inf.0 1.000E0)
- (list 1 0+1i 1.0) (list 1 0+2i 1.0) (list 1 0-1i 1.0) (list 1 1+1i 1.0) (list 1 1-1i 1.0) (list 1 -1+1i 1.0)
- (list 1 -1-1i 1.0) (list 1 0.1+0.1i 1.0) (list 1 1e+16+1e+16i 1.0) (list 1 1e-16+1e-16i 1.0)
- (list 2 0 1) (list 2 1 2) (list 2 2 4) (list 2 3 8) (list 2 -1 1/2) (list 2 -2 1/4)
- (list 2 -3 1/8) (list 2 1/2 1.4142135623731) (list 2 1/3 1.2599210498949) (list 2 -1/2 7.071067811865475244008443621048490392845E-1)
- (list 2 -1/3 7.937005259840997475556964875637659160371E-1) (list 2 0.0 1.000E0) (list 2 1.0 2.000E0)
- (list 2 2.0 4.000E0) (list 2 -2.0 2.500E-1) (list 2 1.000000000000000000000000000000000000002E-309 1.000E0)
- (list 2 -inf.0 0.0) (list 2 0+1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
- (list 2 0+2i 1.83456974743301676839941236809235104518E-1+9.830277404112437205861648503427281526099E-1i)
- (list 2 0-1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
- (list 2 1+1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
- (list 2 1-1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
- (list 2 -1+1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
- (list 2 -1-1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
- (list 2 0.1+0.1i 1.069199809265204517687304849996528484166E0+7.423020183379063973209835788737470580225E-2i)
- (list 2 1e-16+1e-16i 1.00000000000000006931471805599452949289E0+6.931471805599453429742233135802455373554E-17i)
- (list 3 0 1) (list 3 1 3) (list 3 2 9) (list 3 3 27) (list 3 -1 1/3) (list 3 -2 1/9)
- (list 3 -3 1/27) (list 3 1/2 1.7320508075689) (list 3 1/3 1.4422495703074) (list 3 -1/2 5.773502691896257645091487805019574556475E-1)
- (list 3 -1/3 6.933612743506347189382852083362015558497E-1) (list 3 0.0 1.000E0) (list 3 1.0 3.000E0)
- (list 3 2.0 9.000E0) (list 3 -2.0 1.111111111111111111111111111111111111113E-1) (list 3 1.000000000000000000000000000000000000002E-309 1.000E0)
- (list 3 -inf.0 0.0) (list 3 0+1i 4.548324228266097550275651435950424840878E-1+8.905770416677470590749273065651780951036E-1i)
- (list 3 0+2i -5.862549342913521629213761016900936427016E-1+8.101266271509919688171526765177844453941E-1i)
- (list 3 0-1i 4.548324228266097550275651435950424840878E-1-8.905770416677470590749273065651780951036E-1i)
- (list 3 1+1i 1.364497268479829265082695430785127452266E0+2.671731125003241177224781919695534285314E0i)
- (list 3 1-1i 1.364497268479829265082695430785127452266E0-2.671731125003241177224781919695534285314E0i)
- (list 3 -1+1i 1.516108076088699183425217145316808280297E-1+2.968590138892490196916424355217260317017E-1i)
- (list 3 -1-1i 1.516108076088699183425217145316808280297E-1-2.968590138892490196916424355217260317017E-1i)
- (list 3 0.1+0.1i 1.109394427306365911813022078881836880638E0+1.223721548273860448930668229757603279477E-1i)
- (list 3 1e-16+1e-16i 1.00000000000000010986122886681096684318E0+1.098612288668109789126712952843432012306E-16i)
- (list -1 0 1) (list -1 1 -1) (list -1 2 1) (list -1 3 -1) (list -1 -1 -1) (list -1 -2 1)
- (list -1 -3 -1) (list -1 1/2 0+1i) (list -1 1/3 -1.0) (list -1 -1/2 0.0-1.00E0i)
- (list -1 -1/3 5.000000000000000503430454055824822034062E-1-8.660254037844386176981523540143355578944E-1i)
- (list -1 0.0 1.000E0) (list -1 1.0 -1.00E0) (list -1 2.0 1.000E0) (list -1 -2.0 1.000E0)
- (list -1 1e+16 1.000E0) (list -1 0+1i 4.321391826377224977441773717172801127579E-2)
- (list -1 0+2i 1.86744273170798881443021293482703039342E-3) (list -1 0-1i 2.314069263277926900572908636794854738031E1)
- (list -1 1+1i -4.321391826377224977441773717172801127579E-2) (list -1 1-1i -2.314069263277926900572908636794854738031E1)
- (list -1 -1+1i -4.321391826377224977441773717172801127579E-2) (list -1 -1-1i -2.314069263277926900572908636794854738031E1)
- (list -1 0.1+0.1i 6.946542388413302284911578278489504217747E-1+2.257068442712257901873502529761755278285E-1i)
- (list -1 1e+16+1e+16i 0.0) (list -1 1e-16+1e-16i 9.999999999999996858407346410206827203587E-1+3.141592653589792185835963602803850622895E-16i)
- (list -2 0 1) (list -2 1 -2) (list -2 2 4) (list -2 3 -8) (list -2 -1 -1/2) (list -2 -2 1/4)
- (list -2 -3 -1/8) (list -2 1/2 0+1.4142135623731i) (list -2 1/3 -1.2599210498949)
- (list -2 -1/2 0.0-7.071067811865475244008443621048490392845E-1i) (list -2 -1/3 3.968502629920499137351498618341152884837E-1-6.873648184993012989383839761489500939792E-1i)
- (list -2 0.0 1.000E0) (list -2 1.0 -2.00E0) (list -2 2.0 4.000E0) (list -2 -2.0 2.500E-1)
- (list -2 -inf.0 0.0) (list -2 0+1i 3.324182700885665525901791766265082328307E-2+2.761202036833300995082465454051316449496E-2i)
- (list -2 0+2i 3.425953940655147934023229852954811989202E-4+1.835748008898304681163796172161682131024E-3i)
- (list -2 0-1i 1.780072097764048857359856955378859222048E1-1.478600649942216768260366593652156810413E1i)
- (list -2 1+1i -6.648365401771331051803583532530164656613E-2-5.522404073666601990164930908102632898992E-2i)
- (list -2 1-1i -3.560144195528097714719713910757718444095E1+2.957201299884433536520733187304313620826E1i)
- (list -2 -1+1i -1.662091350442832762950895883132541164153E-2-1.380601018416650497541232727025658224748E-2i)
- (list -2 -1-1i -8.900360488820244286799284776894296110238E0+7.393003249711083841301832968260784052065E0i)
- (list -2 0.1+0.1i 7.259699150688950609812198701314241029302E-1+2.928900391985359860022641767906842987898E-1i)
- (list -2 1e+16+1e+16i 0.0) (list -2 1e-16+1e-16i 9.999999999999997551554526970151686615297E-1+3.834739834149737528810186916384012655492E-16i)
- (list -3 0 1) (list -3 1 -3) (list -3 2 9) (list -3 3 -27) (list -3 -1 -1/3) (list -3 -2 1/9)
- (list -3 -3 -1/27) (list -3 1/2 0+1.7320508075689i) (list -3 1/3 -1.4422495703074)
- (list -3 -1/2 0.0-5.773502691896257645091487805019574556475E-1i) (list -3 -1/3 3.466806371753173943750607212746369268463E-1-6.004684775880013553913614575447052401843E-1i)
- (list -3 0.0 1.000E0) (list -3 1.0 -3.00E0) (list -3 2.0 9.000E0) (list -3 -2.0 1.111111111111111111111111111111111111113E-1)
- (list -3 -inf.0 0.0) (list -3 0+1i 1.965509114374261361108537566165204334024E-2+3.848532348622211453375207440262631065206E-2i)
- (list -3 0+2i -1.094797515970330168691448329739632503045E-3+1.512865081636227781901948390654863520171E-3i)
- (list -3 0-1i 1.052513729605287378161514526579733692066E1-2.060856958704319044776041543097331663996E1i)
- (list -3 1+1i -5.896527343122784083325612698495613002091E-2-1.15455970458666343601256223207878931956E-1i)
- (list -3 1-1i -3.157541188815862134484543579739201076193E1+6.182570876112957134328124629291994991979E1i)
- (list -3 -1+1i -6.551697047914204537028458553884014446755E-3-1.282844116207403817791735813420877021735E-2i)
- (list -3 -1-1i -3.508379098684291260538381755265778973549E0+6.869523195681063482586805143657772213312E0i)
- (list -3 0.1+0.1i 7.430253085825579186796890883432274992943E-1+3.354042513063949187690186935389269335405E-1i)
- (list -3 1e+16+1e+16i 0.0) (list -3 1e-16+1e-16i 9.999999999999997957019635078315805356955E-1+4.240204942257901974962676555647136289098E-16i)
- (list 1/2 0 1) (list 1/2 1 1/2) (list 1/2 2 1/4) (list 1/2 3 1/8) (list 1/2 -1 2)
- (list 1/2 -2 4) (list 1/2 -3 8) (list 1/2 1/2 0.70710678118655) (list 1/2 1/3 0.7937005259841)
- (list 1/2 -1/2 1.414213562373095048801688724209698078569E0) (list 1/2 -1/3 1.259921049894873148607716059938123324722E0)
- (list 1/2 0.0 1.000E0) (list 1/2 1.0 5.000E-1) (list 1/2 2.0 2.500E-1) (list 1/2 -2.0 4.000E0)
- (list 1/2 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1/2 1e+16 0.0)
- (list 1/2 inf.0 0.0) (list 1/2 0+1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
- (list 1/2 0+2i 1.83456974743301676839941236809235104518E-1-9.830277404112437205861648503427281526099E-1i)
- (list 1/2 0-1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
- (list 1/2 1+1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
- (list 1/2 1-1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
- (list 1/2 -1+1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
- (list 1/2 -1-1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
- (list 1/2 0.1+0.1i 9.307924962319322751032548220951692988141E-1-6.462114401999142796156052473887795907618E-2i)
- (list 1/2 1e+16+1e+16i 0.0) (list 1/2 1e-16+1e-16i 9.999999999999999306852819440054705071071E-1-6.931471805599452468836205299399646209468E-17i)
- (list 1/3 0 1) (list 1/3 1 1/3) (list 1/3 2 1/9) (list 1/3 3 1/27) (list 1/3 -1 3)
- (list 1/3 -2 9) (list 1/3 -3 27) (list 1/3 1/2 0.57735026918963) (list 1/3 1/3 0.69336127435063)
- (list 1/3 -1/2 1.732050807568877341601513501094972563495E0) (list 1/3 -1/3 1.442249570307408379689974332217791378498E0)
- (list 1/3 0.0 1.000E0) (list 1/3 1.0 3.333333333333333148296162562473909929395E-1)
- (list 1/3 2.0 1.111111111111110987752997263871498932361E-1) (list 1/3 -2.0 9.000000000000000999200722162640969581442E0)
- (list 1/3 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1/3 1e+16 0.0)
- (list 1/3 inf.0 0.0) (list 1/3 0+1i 4.548324228266097055906083004905301340071E-1-8.905770416677470843231987149725161148001E-1i)
- (list 1/3 0+2i -5.862549342913522528634995341851693014879E-1-8.101266271509919037297800414810374565267E-1i)
- (list 1/3 0-1i 4.548324228266097055906083004905301340071E-1+8.905770416677470843231987149725161148001E-1i)
- (list 1/3 1+1i 1.516108076088698934474456306943980624137E-1-2.968590138892490116287472906226681453643E-1i)
- (list 1/3 1-1i 1.516108076088698934474456306943980624137E-1+2.968590138892490116287472906226681453643E-1i)
- (list 1/3 -1+1i 1.364497268479829192516639126693602447003E0-2.671731125003241401280466674231091613441E0i)
- (list 1/3 -1-1i 1.364497268479829192516639126693602447003E0+2.671731125003241401280466674231091613441E0i)
- (list 1/3 0.1+0.1i 8.905570151840088631186184238937353595899E-1-9.823321468210062916108146236871209771647E-2i)
- (list 1/3 1e+16+1e+16i 0.0) (list 1/3 1e-16+1e-16i 9.999999999999998901387711331890276057033E-1-1.098612288668109603248072021584861739285E-16i)
- (list -1/2 0 1) (list -1/2 1 -1/2) (list -1/2 2 1/4) (list -1/2 3 -1/8) (list -1/2 -1 -2)
- (list -1/2 -2 4) (list -1/2 -3 -8) (list -1/2 1/2 0+0.70710678118655i) (list -1/2 1/3 -0.7937005259841)
- (list -1/2 -1/2 0.0-1.414213562373095048801688724209698078569E0i) (list -1/2 -1/3 6.299605249474366377321206522758126486977E-1-1.09112363597172135294521532465807648133E0i)
- (list -1/2 0.0 1.000E0) (list -1/2 1.0 -5.00E-1) (list -1/2 2.0 2.500E-1) (list -1/2 -2.0 4.000E0)
- (list -1/2 1e+16 0.0) (list -1/2 inf.0 0.0) (list -1/2 0+1i 3.324182700885665525901791766265082328307E-2-2.761202036833300995082465454051316449496E-2i)
- (list -1/2 0+2i 3.425953940655147934023229852954811989202E-4-1.835748008898304681163796172161682131024E-3i)
- (list -1/2 0-1i 1.780072097764048857359856955378859222048E1+1.478600649942216768260366593652156810413E1i)
- (list -1/2 1+1i -1.662091350442832762950895883132541164153E-2+1.380601018416650497541232727025658224748E-2i)
- (list -1/2 1-1i -8.900360488820244286799284776894296110238E0-7.393003249711083841301832968260784052065E0i)
- (list -1/2 -1+1i -6.648365401771331051803583532530164656613E-2+5.522404073666601990164930908102632898992E-2i)
- (list -1/2 -1-1i -3.560144195528097714719713910757718444095E1-2.957201299884433536520733187304313620826E1i)
- (list -1/2 0.1+0.1i 6.611643874791633083240145101585573999158E-1+1.651968853835831321053883592233542783317E-1i)
- (list -1/2 1e+16+1e+16i 0.0) (list -1/2 1e-16+1e-16i 9.999999999999996165260165850261967791906E-1+2.448445473029846938952343072863939318955E-16i)
- (list -1/3 0 1) (list -1/3 1 -1/3) (list -1/3 2 1/9) (list -1/3 3 -1/27) (list -1/3 -1 -3)
- (list -1/3 -2 9) (list -1/3 -3 -27) (list -1/3 1/2 0+0.57735026918963i) (list -1/3 1/3 -0.69336127435063)
- (list -1/3 -1/2 0.0-1.732050807568877341601513501094972563495E0i) (list -1/3 -1/3 7.211247851537042624522227702765802634347E-1-1.249024766483406435214284662923064132397E0i)
- (list -1/3 0.0 1.000E0) (list -1/3 1.0 -3.333333333333333148296162562473909929395E-1)
- (list -1/3 2.0 1.111111111111110987752997263871498932361E-1) (list -1/3 -2.0 9.000000000000000999200722162640969581442E0)
- (list -1/3 1e+16 0.0) (list -1/3 inf.0 0.0) (list -1/3 0+1i 1.965509114374261147472076343409745270744E-2-3.848532348622211562482881134707887874423E-2i)
- (list -1/3 0+2i -1.094797515970330336653213008135348071651E-3-1.512865081636227660355007437386042651667E-3i)
- (list -1/3 0-1i 1.052513729605287263760972225954207976974E1+2.060856958704319103202290360191646176391E1i)
- (list -1/3 1+1i -6.551697047914203461214675496548324731564E-3+1.282844116207403782948806637317477237465E-2i)
- (list -1/3 1-1i -3.508379098684290684449078029532994204954E0-6.869523195681063296005826865220406716345E0i)
- (list -1/3 -1+1i -5.896527343122783769739250113564997536121E-2+1.154559704586663532835802707239006768699E-1i)
- (list -1/3 -1-1i -3.15754118881586196656166312914556280733E1-6.182570876112957652808497982451530065146E1i)
- (list -1/3 0.1+0.1i 6.408011144159694212372342969009069525835E-1+1.327666945668531521695779387535105337549E-1i)
- (list -1/3 1e+16+1e+16i 0.0) (list -1/3 1e-16+1e-16i 9.999999999999995759795057742097793539085E-1+2.042980364921682582587891581219059394882E-16i)
- (list 0.0 0 0.0) (list 0.0 1 0.0) (list 0.0 2 0.0) (list 0.0 3 0.0) (list 0.0 1/2 0.0)
- (list 0.0 1/3 0.0) (list 0.0 0.0 0.0) (list 0.0 1.0 0.0) (list 0.0 2.0 0.0) (list 0.0 1.000000000000000000000000000000000000002E-309 0.0)
- (list 0.0 1e+16 0.0) (list 0.0 inf.0 0.0) (list 0.0 0+1i 0.0)
- (list 0.0 0+2i 0.0) (list 0.0 0-1i 0.0) (list 0.0 1+1i 0.0) (list 0.0 1-1i 0.0) (list 0.0 0.1+0.1i 0.0)
- (list 0.0 1e+16+1e+16i 0.0) (list 0.0 1e-16+1e-16i 0.0) (list 1.0 0 1.0) (list 1.0 1 1.0)
- (list 1.0 2 1.0) (list 1.0 3 1.0) (list 1.0 -1 1.0) (list 1.0 -2 1.0) (list 1.0 -3 1.0)
- (list 1.0 1/2 1.0) (list 1.0 1/3 1.0) (list 1.0 -1/2 1.000E0) (list 1.0 -1/3 1.000E0)
- (list 1.0 0.0 1.000E0) (list 1.0 1.0 1.000E0) (list 1.0 2.0 1.000E0) (list 1.0 -2.0 1.000E0)
- (list 1.0 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1.0 1e+16 1.000E0)
- (list 1.0 inf.0 1.000E0) (list 1.0 -inf.0 1.000E0) (list 1.0 0+1i 1)
- (list 1.0 0+2i 1) (list 1.0 0-1i 1) (list 1.0 1+1i 1) (list 1.0 1-1i 1) (list 1.0 -1+1i 1)
- (list 1.0 -1-1i 1) (list 1.0 0.1+0.1i 1) (list 1.0 1e+16+1e+16i 1) (list 1.0 1e-16+1e-16i 1)
- (list 2.0 0 1.0) (list 2.0 1 2.0) (list 2.0 2 4.000E0) (list 2.0 3 8.000E0) (list 2.0 -1 5.000E-1)
- (list 2.0 -2 2.500E-1) (list 2.0 -3 1.250E-1) (list 2.0 1/2 1.4142135623731) (list 2.0 1/3 1.2599210498949)
- (list 2.0 -1/2 7.071067811865475244008443621048490392845E-1) (list 2.0 -1/3 7.937005259840997475556964875637659160371E-1)
- (list 2.0 0.0 1.000E0) (list 2.0 1.0 2.000E0) (list 2.0 2.0 4.000E0) (list 2.0 -2.0 2.500E-1)
- (list 2.0 1.000000000000000000000000000000000000002E-309 1.000E0) (list 2.0 -inf.0 0.0)
- (list 2.0 0+1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
- (list 2.0 0+2i 1.83456974743301676839941236809235104518E-1+9.830277404112437205861648503427281526099E-1i)
- (list 2.0 0-1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
- (list 2.0 1+1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
- (list 2.0 1-1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
- (list 2.0 -1+1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
- (list 2.0 -1-1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
- (list 2.0 0.1+0.1i 1.069199809265204517687304849996528484166E0+7.423020183379063973209835788737470580225E-2i)
- (list 2.0 1e-16+1e-16i 1.00000000000000006931471805599452949289E0+6.931471805599453429742233135802455373554E-17i)
- (list -2.0 0 1.0) (list -2.0 1 -2.0) (list -2.0 2 4.000E0) (list -2.0 3 -8.00E0)
- (list -2.0 -1 -5.00E-1) (list -2.0 -2 2.500E-1) (list -2.0 -3 -1.25E-1) (list -2.0 1/2 0+1.4142135623731i)
- (list -2.0 1/3 -1.2599210498949) (list -2.0 -1/2 0.0-7.071067811865475244008443621048490392845E-1i)
- (list -2.0 -1/3 3.968502629920499137351498618341152884837E-1-6.873648184993012989383839761489500939792E-1i)
- (list -2.0 0.0 1.000E0) (list -2.0 1.0 -2.00E0) (list -2.0 2.0 4.000E0) (list -2.0 -2.0 2.500E-1)
- (list -2.0 -inf.0 0.0) (list -2.0 0+1i 3.324182700885665525901791766265082328307E-2+2.761202036833300995082465454051316449496E-2i)
- (list -2.0 0+2i 3.425953940655147934023229852954811989202E-4+1.835748008898304681163796172161682131024E-3i)
- (list -2.0 0-1i 1.780072097764048857359856955378859222048E1-1.478600649942216768260366593652156810413E1i)
- (list -2.0 1+1i -6.648365401771331051803583532530164656613E-2-5.522404073666601990164930908102632898992E-2i)
- (list -2.0 1-1i -3.560144195528097714719713910757718444095E1+2.957201299884433536520733187304313620826E1i)
- (list -2.0 -1+1i -1.662091350442832762950895883132541164153E-2-1.380601018416650497541232727025658224748E-2i)
- (list -2.0 -1-1i -8.900360488820244286799284776894296110238E0+7.393003249711083841301832968260784052065E0i)
- (list -2.0 0.1+0.1i 7.259699150688950609812198701314241029302E-1+2.928900391985359860022641767906842987898E-1i)
- (list -2.0 1e+16+1e+16i 0.0) (list -2.0 1e-16+1e-16i 9.999999999999997551554526970151686615297E-1+3.834739834149737528810186916384012655492E-16i)
- (list 1.000000000000000000000000000000000000002E-309 0 1.0) (list 1.000000000000000000000000000000000000002E-309 1 1.000000000000000000000000000000000000002E-309)
- (list 1.000000000000000000000000000000000000002E-309 2 1.000000000000000000000000000000000000006E-618)
- (list 1.000000000000000000000000000000000000002E-309 3 1.000000000000000000000000000000000000006E-927)
- (list 1.000000000000000000000000000000000000002E-309 1/2 3.162277660168379331998893544432718533725E-155)
- (list 1.000000000000000000000000000000000000002E-309 1/3 1.000000000000000000000000000000000000001E-103)
- (list 1.000000000000000000000000000000000000002E-309 -1/2 3.162277660168379331998893544432718533715E154)
- (list 1.000000000000000000000000000000000000002E-309 -1/3 9.999999999999868346276200367559315452517E102)
- (list 1.000000000000000000000000000000000000002E-309 0.0 1.000E0) (list 1.000000000000000000000000000000000000002E-309 1.0 1.000000000000000000000000000000000000002E-309)
- (list 1.000000000000000000000000000000000000002E-309 2.0 1.000000000000000000000000000000000000006E-618)
- (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309 1.000E0)
- (list 1.000000000000000000000000000000000000002E-309 1e+16 0.0) (list 1.000000000000000000000000000000000000002E-309 inf.0 0.0)
- (list 1.000000000000000000000000000000000000002E-309 0+1i 7.188026041688456386956035152151008205727E-2-9.974132684912512522858369772702724490842E-1i)
- (list 1.000000000000000000000000000000000000002E-309 0+2i -9.896664563248017162886921042023427507381E-1-1.433886509648142863446390724753118562651E-1i)
- (list 1.000000000000000000000000000000000000002E-309 0-1i 7.188026041688456386956035152151008205727E-2+9.974132684912512522858369772702724490842E-1i)
- (list 1.000000000000000000000000000000000000002E-309 1+1i 7.188026041688456386956035152151008205733E-311-9.974132684912512522858369772702724490883E-310i)
- (list 1.000000000000000000000000000000000000002E-309 1-1i 7.188026041688456386956035152151008205733E-311+9.974132684912512522858369772702724490883E-310i)
- (list 1.000000000000000000000000000000000000002E-309 0.1+0.1i -5.63455610426506242496256141630861088283E-32-1.125793483521731083006048050604051624164E-31i)
- (list 1.000000000000000000000000000000000000002E-309 1e+16+1e+16i 0.0)
- (list 1.000000000000000000000000000000000000002E-309 1e-16+1e-16i 9.999999999999288501206264839898510340166E-1-7.114987937351094784363111696637191907549E-14i)
- (list 1e+16 0 1.0) (list 1e+16 1 1e+16) (list 1e+16 2 1.000E32) (list 1e+16 3 1.000E48)
- (list 1e+16 -1 1.000000000000000000000000000000000000001E-16) (list 1e+16 -2 9.999999999999999999999999999999999999998E-33)
- (list 1e+16 -3 9.999999999999999999999999999999999999991E-49) (list 1e+16 1/2 100000000.0)
- (list 1e+16 1/3 215443.46900319) (list 1e+16 -1/2 9.99999999999999999999999999999999999999E-9)
- (list 1e+16 -1/3 4.641588833612782056591069448235278756067E-6) (list 1e+16 0.0 1.000E0)
- (list 1e+16 1.0 1.000E16) (list 1e+16 2.0 1.000E32) (list 1e+16 -2.0 9.999999999999999999999999999999999999998E-33)
- (list 1e+16 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1e+16 -inf.0 0.0)
- (list 1e+16 0+1i 6.541406923671771082966425998087477095845E-1-7.563728938753623529733450264648351927405E-1i)
- (list 1e+16 0+2i -1.441999091787803208994630162235380065937E-1-9.895485769747898065837021120946943010267E-1i)
- (list 1e+16 0-1i 6.541406923671771082966425998087477095845E-1+7.563728938753623529733450264648351927405E-1i)
- (list 1e+16 1+1i 6.541406923671771082966425998087477095832E15-7.563728938753623529733450264648351927387E15i)
- (list 1e+16 1-1i 6.541406923671771082966425998087477095832E15+7.563728938753623529733450264648351927387E15i)
- (list 1e+16 -1+1i 6.541406923671771082966425998087477095825E-17-7.563728938753623529733450264648351927399E-17i)
- (list 1e+16 -1-1i 6.541406923671771082966425998087477095825E-17+7.563728938753623529733450264648351927399E-17i)
- (list 1e+16 0.1+0.1i -3.409382666305111714726686098434812471081E1-2.055490637125206804018448749591854294103E1i)
- (list 1e+16 1e-16+1e-16i 1.000000000000003684136148790473017422188E0+3.684136148790486590281349632497736627823E-15i)
- (list inf.0 0 1.0) (list inf.0 -1 0.0) (list inf.0 -2 0.0)
- (list inf.0 -3 0.0) (list inf.0 -1/2 0.0) (list inf.0 -1/3 0.0) (list inf.0 0.0 1.000E0)
- (list inf.0 -2.0 0.0) (list inf.0 -inf.0 0.0) (list inf.0 -1+1i 0.0) (list inf.0 -1-1i 0.0)
- (list -inf.0 0 1.0) (list -inf.0 -1 0.0) (list -inf.0 -2 0.0) (list -inf.0 -3 0.0)
- (list -inf.0 -1/2 0.0) (list -inf.0 -1/3 0.0) (list -inf.0 0.0 1.000E0) (list -inf.0 -2.0 0.0)
- (list -inf.0 -inf.0 0.0) (list -inf.0 -1+1i 0.0) (list -inf.0 -1-1i 0.0) (list 0+1i 0 1.0)
- (list 0+1i 1 0+1i) (list 0+1i 2 -1.00E0) (list 0+1i 3 0.0-1.00E0i) (list 0+1i -1 0.0-1.00E0i)
- (list 0+1i -2 -1.00E0) (list 0+1i -3 0.0+1.000E0i) (list 0+1i 1/2 0.70710678118655+0.70710678118655i)
- (list 0+1i 1/3 8.660254037844386612965085791222353988232E-1+4.999999999999999748284772972087582646907E-1i)
- (list 0+1i -1/2 7.071067811865475244008443621048490392845E-1-7.071067811865475244008443621048490392845E-1i)
- (list 0+1i -1/3 8.660254037844386612965085791222353988232E-1-4.999999999999999748284772972087582646907E-1i)
- (list 0+1i 0.0 1.000E0) (list 0+1i 1.0 0.0+1.000E0i) (list 0+1i 2.0 -1.00E0) (list 0+1i -2.0 -1.00E0)
- (list 0+1i 1.000000000000000000000000000000000000002E-309 1.000E0+1.570796326794896619231321691639751442098E-309i)
- (list 0+1i 1e+16 1.000E0) (list 0+1i 0+1i 2.078795763507619085469556198349787700342E-1)
- (list 0+1i 0+2i 4.321391826377224977441773717172801127579E-2) (list 0+1i 0-1i 4.810477380965351655473035666703833126401E0)
- (list 0+1i 1+1i 0.0+2.078795763507619085469556198349787700342E-1i) (list 0+1i 1-1i 0.0+4.810477380965351655473035666703833126401E0i)
- (list 0+1i -1+1i 0.0-2.078795763507619085469556198349787700342E-1i) (list 0+1i -1-1i 0.0-4.810477380965351655473035666703833126401E0i)
- (list 0+1i 0.1+0.1i 8.441140118165246481415723784169170682829E-1+1.336945253316592796595429310740609657101E-1i)
- (list 0+1i 1e+16+1e+16i 0.0) (list 0+1i 1e-16+1e-16i 9.999999999999998429203673205103413601794E-1+1.570796326794896339658091828635841709635E-16i)
- (list 0+2i 0 1.0) (list 0+2i 1 0+2i) (list 0+2i 2 -4.00E0) (list 0+2i 3 0.0-8.00E0i)
- (list 0+2i -1 0.0-5.00E-1i) (list 0+2i -2 -2.50E-1) (list 0+2i -3 0.0+1.250E-1i)
- (list 0+2i 1/2 1+1i) (list 0+2i 1/3 1.09112363597172140787570207348670009638E0+6.299605249474365425897267188156853709001E-1i)
- (list 0+2i -1/2 5.000E-1-5.00E-1i) (list 0+2i -1/3 6.873648184993013335424222440592397343418E-1-3.968502629920498537991974347557662898919E-1i)
- (list 0+2i 0.0 1.000E0) (list 0+2i 1.0 0.0+2.000E0i) (list 0+2i 2.0 -4.00E0) (list 0+2i -2.0 -2.50E-1)
- (list 0+2i 1.000000000000000000000000000000000000002E-309 1.000E0+1.570796326794896619231321691639751442098E-309i)
- (list 0+2i -inf.0 0.0) (list 0+2i 0+1i 1.599090569280680525199117755445296515815E-1+1.328269994246205222492823642245871455648E-1i)
- (list 0+2i 0+2i 7.927894711475968677072935966913922424434E-3+4.248048042515221109836149914964543748435E-2i)
- (list 0+2i 0-1i 3.700406335570025108741522919010577122043E0-3.073708767019492322385562434551223151799E0i)
- (list 0+2i 1+1i -2.656539988492410444985647284491742911296E-1+3.19818113856136105039823551089059303163E-1i)
- (list 0+2i 1-1i 6.147417534038984644771124869102446303599E0+7.400812671140050217483045838021154244087E0i)
- (list 0+2i -1+1i 6.641349971231026112464118211229357278239E-2-7.995452846403402625995588777226482579074E-2i)
- (list 0+2i -1-1i -1.5368543835097461611927812172756115759E0-1.850203167785012554370761459505288561022E0i)
- (list 0+2i 0.1+0.1i 8.926023688328728424160522546503419745435E-1+2.056049144522835172454080598405456305612E-1i)
- (list 0+2i 1e+16+1e+16i 0.0) (list 0+2i 1e-16+1e-16i 9.999999999999999122350853765048490772098E-1+2.263943507354841682632315142216062597333E-16i)
- (list 0-1i 0 1.0) (list 0-1i 1 0-1i) (list 0-1i 2 -1.00E0) (list 0-1i 3 0.0+1.000E0i)
- (list 0-1i -1 0.0+1.000E0i) (list 0-1i -2 -1.00E0) (list 0-1i -3 0.0-1.00E0i) (list 0-1i 1/2 0.70710678118655-0.70710678118655i)
- (list 0-1i 1/3 8.660254037844386612965085791222353988232E-1-4.999999999999999748284772972087582646907E-1i)
- (list 0-1i -1/2 7.071067811865475244008443621048490392845E-1+7.071067811865475244008443621048490392845E-1i)
- (list 0-1i -1/3 8.660254037844386612965085791222353988232E-1+4.999999999999999748284772972087582646907E-1i)
- (list 0-1i 0.0 1.000E0) (list 0-1i 1.0 0.0-1.00E0i) (list 0-1i 2.0 -1.00E0) (list 0-1i -2.0 -1.00E0)
- (list 0-1i 1.000000000000000000000000000000000000002E-309 1.000E0-1.570796326794896619231321691639751442098E-309i)
- (list 0-1i 1e+16 1.000E0) (list 0-1i 0+1i 4.810477380965351655473035666703833126401E0)
- (list 0-1i 0+2i 2.314069263277926900572908636794854738031E1) (list 0-1i 0-1i 2.078795763507619085469556198349787700342E-1)
- (list 0-1i 1+1i 0.0-4.810477380965351655473035666703833126401E0i) (list 0-1i 1-1i 0.0-2.078795763507619085469556198349787700342E-1i)
- (list 0-1i -1+1i 0.0+4.810477380965351655473035666703833126401E0i) (list 0-1i -1-1i 0.0+2.078795763507619085469556198349787700342E-1i)
- (list 0-1i 0.1+0.1i 1.15568305287131774105188044357174956096E0-1.830422135215751576397991439148491080012E-1i)
- (list 0-1i 1e-16+1e-16i 1.000000000000000157079632679489658639818E0-1.570796326794896833138311883103752021701E-16i)
- (list 1+1i 0 1.0) (list 1+1i 1 1+1i) (list 1+1i 2 0.0+2.000E0i) (list 1+1i 3 -2.00E0+2.000E0i)
- (list 1+1i -1 5.000E-1-5.00E-1i) (list 1+1i -2 0.0-5.00E-1i) (list 1+1i -3 -2.50E-1-2.50E-1i)
- (list 1+1i 1/2 1.0986841134678+0.45508986056223i) (list 1+1i 1/3 1.084215081491351179148689172984121435876E0+2.905145555072514268841073782856571173254E-1i)
- (list 1+1i -1/2 7.768869870150186536720794765315734740815E-1-3.217971264527913123677217187091049044625E-1i)
- (list 1+1i -1/3 8.605420804595790018414012402960957705697E-1-2.305815555121423995608566442452670487351E-1i)
- (list 1+1i 0.0 1.000E0) (list 1+1i 1.0 1.000E0+1.000E0i) (list 1+1i 2.0 0.0+2.000E0i)
- (list 1+1i -2.0 0.0-5.00E-1i) (list 1+1i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
- (list 1+1i -inf.0 0.0) (list 1+1i 0+1i 4.288290062943678493226520070973354996125E-1+1.548717524642467781923098896798325813036E-1i)
- (list 1+1i 0+2i 1.599090569280680525199117755445296515815E-1+1.328269994246205222492823642245871455648E-1i)
- (list 1+1i 0-1i 2.062872235080904951706990637170143171029E0-7.450070621797240878593548325920103204625E-1i)
- (list 1+1i 1+1i 2.739572538301210711303421174175029183081E-1+5.837007587586146275149618967771680809154E-1i)
- (list 1+1i 1-1i 2.807879297260629039566345469762153491497E0+1.317865172901180863847635804578132850572E0i)
- (list 1+1i -1+1i 2.918503793793073137574809483885840404577E-1-1.369786269150605355651710587087514591541E-1i)
- (list 1+1i -1-1i 6.589325864505904319238179022890664252861E-1-1.403939648630314519783172734881076745749E0i)
- (list 1+1i 0.1+0.1i 9.509412581367732262071184402582209392577E-1+1.08106001655210286400223506650660553711E-1i)
- (list 1+1i 1e+16+1e+16i 0.0) (list 1+1i 1e-16+1e-16i 9.99999999999999956117542688252429982572E-1+1.131971753677420890989859729961488955736E-16i)
- (list 1-1i 0 1.0) (list 1-1i 1 1-1i) (list 1-1i 2 0.0-2.00E0i) (list 1-1i 3 -2.00E0-2.00E0i)
- (list 1-1i -1 5.000E-1+5.000E-1i) (list 1-1i -2 0.0+5.000E-1i) (list 1-1i -3 -2.50E-1+2.500E-1i)
- (list 1-1i 1/2 1.0986841134678-0.45508986056223i) (list 1-1i 1/3 1.084215081491351179148689172984121435876E0-2.905145555072514268841073782856571173254E-1i)
- (list 1-1i -1/2 7.768869870150186536720794765315734740815E-1+3.217971264527913123677217187091049044625E-1i)
- (list 1-1i -1/3 8.605420804595790018414012402960957705697E-1+2.305815555121423995608566442452670487351E-1i)
- (list 1-1i 0.0 1.000E0) (list 1-1i 1.0 1.000E0-1.00E0i) (list 1-1i 2.0 0.0-2.00E0i)
- (list 1-1i -2.0 0.0+5.000E-1i) (list 1-1i 1.000000000000000000000000000000000000002E-309 1.000E0-7.853981633974483096156608458198757210488E-310i)
- (list 1-1i -inf.0 0.0) (list 1-1i 0+1i 2.062872235080904951706990637170143171029E0+7.450070621797240878593548325920103204625E-1i)
- (list 1-1i 0+2i 3.700406335570025108741522919010577122043E0+3.073708767019492322385562434551223151799E0i)
- (list 1-1i 0-1i 4.288290062943678493226520070973354996125E-1-1.548717524642467781923098896798325813036E-1i)
- (list 1-1i 1+1i 2.807879297260629039566345469762153491497E0-1.317865172901180863847635804578132850572E0i)
- (list 1-1i 1-1i 2.739572538301210711303421174175029183081E-1-5.837007587586146275149618967771680809154E-1i)
- (list 1-1i -1+1i 6.589325864505904319238179022890664252861E-1+1.403939648630314519783172734881076745749E0i)
- (list 1-1i -1-1i 2.918503793793073137574809483885840404577E-1+1.369786269150605355651710587087514591541E-1i)
- (list 1-1i 0.1+0.1i 1.118774658142734663065880800594211744947E0-4.912611879174141197780391086654035970153E-2i)
- (list 1-1i 1e-16+1e-16i 1.000000000000000113197175367742099510321E0-4.388245731174756954083421259082963337401E-17i)
- (list -1+1i 0 1.0) (list -1+1i 1 -1+1i) (list -1+1i 2 0.0-2.00E0i) (list -1+1i 3 2.000E0+2.000E0i)
- (list -1+1i -1 -5.00E-1-5.00E-1i) (list -1+1i -2 0.0+5.000E-1i) (list -1+1i -3 2.500E-1-2.50E-1i)
- (list -1+1i 1/2 0.45508986056223+1.0986841134678i) (list -1+1i 1/3 7.937005259840997668899692535826356354889E-1+7.937005259840996976818927177620594283082E-1i)
- (list -1+1i -1/2 3.217971264527913123677217187091049044625E-1-7.768869870150186536720794765315734740815E-1i)
- (list -1+1i -1/3 6.299605249474366138887223148884515164688E-1-6.299605249474365589582355660598282273075E-1i)
- (list -1+1i 0.0 1.000E0) (list -1+1i 1.0 -1.00E0+1.000E0i) (list -1+1i 2.0 0.0-2.00E0i)
- (list -1+1i -2.0 0.0+5.000E-1i) (list -1+1i 1.000000000000000000000000000000000000002E-309 1.000E0+2.35619449019234492884698253745962716315E-309i)
- (list -1+1i -inf.0 0.0) (list -1+1i 0+1i 8.914479215539140039333169785416699948907E-2+3.219467429096768688435430339284927790439E-2i)
- (list -1+1i 0+2i 6.910296915726436425237112293342453374671E-3+5.7399750963576748986151091014202337188E-3i)
- (list -1+1i 0-1i 9.923400226678132867281183645053121674554E0-3.583839621275010020102858511593195855531E0i)
- (list -1+1i 1+1i -1.213394664463590872776860012470162773935E-1+5.695011786442371350897739446131772158468E-2i)
- (list -1+1i 1-1i -6.339560605403122847178325133459925819034E0+1.350723984795314288738404215664631753007E1i)
- (list -1+1i -1+1i -2.847505893221185675448869723065886079234E-2-6.066973322317954363884300062350813869673E-2i)
- (list -1+1i -1-1i -6.753619923976571443692021078323158765037E0-3.169780302701561423589162566729962909517E0i)
- (list -1+1i 0.1+0.1i 7.882496598308880991233017323974702727041E-1+2.1838943088351018304792416348997040808E-1i)
- (list -1+1i 1e+16+1e+16i 0.0) (list -1+1i 1e-16+1e-16i 9.999999999999997990379100087627604548201E-1+2.702768080472316983907841531363385588262E-16i)
- (list -1-1i 0 1.0) (list -1-1i 1 -1-1i) (list -1-1i 2 0.0+2.000E0i) (list -1-1i 3 2.000E0-2.00E0i)
- (list -1-1i -1 -5.00E-1+5.000E-1i) (list -1-1i -2 0.0-5.00E-1i) (list -1-1i -3 2.500E-1+2.500E-1i)
- (list -1-1i 1/2 0.45508986056223-1.0986841134678i) (list -1-1i 1/3 7.937005259840997668899692535826356354889E-1-7.937005259840996976818927177620594283082E-1i)
- (list -1-1i -1/2 3.217971264527913123677217187091049044625E-1+7.768869870150186536720794765315734740815E-1i)
- (list -1-1i -1/3 6.299605249474366138887223148884515164688E-1+6.299605249474365589582355660598282273075E-1i)
- (list -1-1i 0.0 1.000E0) (list -1-1i 1.0 -1.00E0-1.00E0i) (list -1-1i 2.0 0.0+2.000E0i)
- (list -1-1i -2.0 0.0-5.00E-1i) (list -1-1i 1.000000000000000000000000000000000000002E-309 1.000E0-2.35619449019234492884698253745962716315E-309i)
- (list -1-1i -inf.0 0.0) (list -1-1i 0+1i 9.923400226678132867281183645053121674554E0+3.583839621275010020102858511593195855531E0i)
- (list -1-1i 0+2i 8.562996562781501151982322359385576132148E1+7.112774982027701655978420905114385775416E1i)
- (list -1-1i 0-1i 8.914479215539140039333169785416699948907E-2-3.219467429096768688435430339284927790439E-2i)
- (list -1-1i 1+1i -6.339560605403122847178325133459925819034E0-1.350723984795314288738404215664631753007E1i)
- (list -1-1i 1-1i -1.213394664463590872776860012470162773935E-1-5.695011786442371350897739446131772158468E-2i)
- (list -1-1i -1+1i -6.753619923976571443692021078323158765037E0+3.169780302701561423589162566729962909517E0i)
- (list -1-1i -1-1i -2.847505893221185675448869723065886079234E-2+6.066973322317954363884300062350813869673E-2i)
- (list -1-1i 0.1+0.1i 1.283956758872096257591990187677552600208E0-2.615572127992484175251616566885584992446E-1i)
- (list -1-1i 1e-16+1e-16i 1.000000000000000270276808047231769038073E0-2.009620899912372775286764036246047795846E-16i)
- (list 0.1+0.1i 0 1.0) (list 0.1+0.1i 1 0.1+0.1i) (list 0.1+0.1i 2 0.0+2.000000000000000222044604925031314247702E-2i)
- (list 0.1+0.1i 3 -2.000000000000000333066907387546980616012E-3+2.000000000000000333066907387546980616012E-3i)
- (list 0.1+0.1i -1 4.999999999999999722444243843710880301532E0-4.999999999999999722444243843710880301532E0i)
- (list 0.1+0.1i -2 0.0-4.999999999999999444888487687421776010503E1i)
- (list 0.1+0.1i -3 -2.499999999999999583666365765566343563457E2-2.499999999999999583666365765566343563457E2i)
- (list 0.1+0.1i 1/2 0.34743442276012+0.14391204994251i) (list 0.1+0.1i 1/3 5.032480615484825043523903544407412355396E-1+1.348449116844438143505188591437346924604E-1i)
- (list 0.1+0.1i -1/2 2.45673236351311521671469493547019420871E0-1.017611864088040968689409531603674348818E0i)
- (list 0.1+0.1i -1/3 1.853981710374325315321217484547221353494E0-4.967729020768720696346827580207236635648E-1i)
- (list 0.1+0.1i 0.0 1.000E0) (list 0.1+0.1i 1.0 1.000000000000000055511151231257827021182E-1+1.000000000000000055511151231257827021182E-1i)
- (list 0.1+0.1i 2.0 0.0+2.000000000000000222044604925031314247702E-2i) (list 0.1+0.1i -2.0 0.0-4.999999999999999444888487687421776010503E1i)
- (list 0.1+0.1i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
- (list 0.1+0.1i 1e+16 0.0) (list 0.1+0.1i inf.0 0.0) (list 0.1+0.1i 0+1i -1.713226510357599956083331913106303247236E-1-4.22525887482460786856087271691853977193E-1i)
- (list 0.1+0.1i 0+2i -1.491766748349203175549260651566533449245E-1+1.447765103494648437770214174856742113327E-1i)
- (list 0.1+0.1i 0-1i -8.241437376545436347801862567004657850891E-1+2.032551224606688826869616254728598600103E0i)
- (list 0.1+0.1i 1+1i 2.512032364467008051923349285554493285946E-2-5.938485385182208154296364931488770060654E-2i)
- (list 0.1+0.1i 1-1i -2.856694962261232620228228583084710444815E-1+1.208407486952145259169520755212883935691E-1i)
- (list 0.1+0.1i -1+1i -2.969242692591103747496022164280467138525E0-1.256016182233503886515866161034993752114E0i)
- (list 0.1+0.1i -1-1i 6.042037434760725625046696204216927090118E0+1.428347481130616151535688219886713564214E1i)
- (list 0.1+0.1i 0.1+0.1i 7.550220306566742029451631510549876832316E-1-8.878982993466537268563019824356751882119E-2i)
- (list 0.1+0.1i 1e+16+1e+16i 0.0) (list 0.1+0.1i 1e-16+1e-16i 9.999999999999997258590333888479081137213E-1-1.170613339316624318801081266623392933101E-16i)
- (list 1e+16+1e+16i 0 1.0) (list 1e+16+1e+16i 1 1e+16+1e+16i) (list 1e+16+1e+16i 2 0.0+2.000E32i)
- (list 1e+16+1e+16i 3 -2.00E48+2.000E48i) (list 1e+16+1e+16i -1 5.000000000000000000000000000000000000004E-17-5.000000000000000000000000000000000000004E-17i)
- (list 1e+16+1e+16i -2 0.0-4.999999999999999999999999999999999999999E-33i)
- (list 1e+16+1e+16i -3 -2.499999999999999999999999999999999999998E-49-2.499999999999999999999999999999999999998E-49i)
- (list 1e+16+1e+16i 1/2 109868411.34678+45508986.056223i) (list 1e+16+1e+16i 1/3 2.335870583020711134947889498537726801442E5+6.258946363440152792122310286091229534238E4i)
- (list 1e+16+1e+16i -1/2 7.76886987015018653672079476531573474081E-9-3.217971264527913123677217187091049044617E-9i)
- (list 1e+16+1e+16i -1/3 3.994282511515094148675512812353991597295E-6-1.070264773302225997506194769200154785053E-6i)
- (list 1e+16+1e+16i 0.0 1.000E0) (list 1e+16+1e+16i 1.0 1.000E16+1.000E16i) (list 1e+16+1e+16i 2.0 0.0+2.000E32i)
- (list 1e+16+1e+16i -2.0 0.0-4.999999999999999999999999999999999999999E-33i)
- (list 1e+16+1e+16i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
- (list 1e+16+1e+16i -inf.0 0.0) (list 1e+16+1e+16i 0+1i 3.97655298675457451476815297378330384373E-1-2.23046721083486532799277949440696753733E-1i)
- (list 1e+16+1e+16i 0+2i 1.083798967785726369788640263558841648425E-1-1.773914209820705797251910148995630479122E-1i)
- (list 1e+16+1e+16i 0-1i 1.912911819699309232365644880468914363155E0+1.072961206670599579011330828139081101248E0i)
- (list 1e+16+1e+16i 1+1i 6.207020197589439842760932468190271381067E15+1.746085775919709186775373479376336306396E15i)
- (list 1e+16+1e+16i 1-1i 8.39950613028709653354314052329833261908E15+2.985873026369908811376975708607995464407E16i)
- (list 1e+16+1e+16i -1+1i 8.730428879598545933876867396881681532013E-18-3.103510098794719921380466234095135690525E-17i)
- (list 1e+16+1e+16i -1-1i 1.492936513184954405688487854303997732202E-16-4.19975306514354826677157026164916630953E-17i)
- (list 1e+16+1e+16i 0.1+0.1i -3.019911767946562559553699791129052056384E1-2.323225580723027414176687762549620584343E1i)
- (list 1e+16+1e+16i 1e-16+1e-16i 1.000000000000003640253691478724868702006E0+3.797333324158228934745194038802400084708E-15i)
- (list 1e-16+1e-16i 0 1.0) (list 1e-16+1e-16i 1 1e-16+1e-16i) (list 1e-16+1e-16i 2 0.0+1.999999999999999916391146896138415121169E-32i)
- (list 1e-16+1e-16i 3 -1.999999999999999874586720344207623992465E-48+1.999999999999999874586720344207623992465E-48i)
- (list 1e-16+1e-16i -1 5.000000000000000104511066379826984375319E15-5.000000000000000104511066379826984375319E15i)
- (list 1e-16+1e-16i -2 0.0-5.00000000000000020902213275965397093513E31i)
- (list 1e-16+1e-16i -3 -2.500000000000000156766599569740479839725E47-2.500000000000000156766599569740479839725E47i)
- (list 1e-16+1e-16i 1/2 1.0986841134678e-08+4.5508986056223e-09i)
- (list 1e-16+1e-16i 1/3 5.032480615484828131577934532998162284517E-6+1.348449116844438970946772378503363059943E-6i)
- (list 1e-16+1e-16i -1/2 7.768869870150186617914082234866133300043E7-3.217971264527913157308578030636299721171E7i)
- (list 1e-16+1e-16i -1/3 1.853981710374324177672385518009559821262E5-4.967729020768717648025969623769604859166E4i)
- (list 1e-16+1e-16i 0.0 1.000E0) (list 1e-16+1e-16i 1.0 9.999999999999999790977867240346035618411E-17+9.999999999999999790977867240346035618411E-17i)
- (list 1e-16+1e-16i 2.0 0.0+1.999999999999999916391146896138415121169E-32i) (list 1e-16+1e-16i -2.0 0.0-5.00000000000000020902213275965397093513E31i)
- (list 1e-16+1e-16i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
- (list 1e-16+1e-16i 1e+16 0.0) (list 1e-16+1e-16i inf.0 0.0)
- (list 1e-16+1e-16i 0+1i 1.633737074935952277071942452600366041402E-1+4.256625518536474393286932017574035701805E-1i)
- (list 1e-16+1e-16i 0+2i -1.544976397503562816275493845355474590488E-1+1.390841384750302156856253710476447606724E-1i)
- (list 1e-16+1e-16i 0-1i 7.859055245423894167511168257029299588438E-1-2.047640077615962126490396474363177248838E0i)
- (list 1e-16+1e-16i 1+1i -2.622888443600522061390815917770620324788E-17+5.890362593472426547237259268645081580369E-17i)
- (list 1e-16+1e-16i 1-1i 2.833545602158351484014138796578448096738E-16-1.26173455307357268336623492266154970137E-16i)
- (list 1e-16+1e-16i -1+1i 2.945181296736213396740244835851862239781E15+1.311444221800261085519581606088360070987E15i)
- (list 1e-16+1e-16i -1-1i -6.308672765367863680561621873294727149409E15-1.416772801079175801234443901776883778303E16i)
- (list 1e-16+1e-16i 0.1+0.1i -2.185846675892145203322615268234771243738E-2+1.000746379588156995072970612624735653063E-2i)
- (list 1e-16+1e-16i 1e+16+1e+16i 0.0) (list 1e-16+1e-16i 1e-16+1e-16i 9.999999999999962719813938977799891729155E-1-3.570938973422717612919117771011138615376E-15i)
- ))
-
+(when (and (not (provided? 'freebsd)) (not (provided? 'openbsd)))
+ (for-each
+ (lambda (data)
+ (let ((num1 (car data)) (num2 (cadr data)) (val (caddr data))) (num-test-2 'expt num1 num2 (expt num1 num2) val)))
+ (vector (list 0 0 1) (list 0 1 0) (list 0 2 0) (list 0 3 0) (list 0 1/2 0) (list 0 1/3 0)
+ (list 0 0.0 0.0) (list 0 1.0 0.0) (list 0 2.0 0.0) (list 0 1.000000000000000000000000000000000000002E-309 0.0)
+ (list 0 1e+16 0.0) (list 0 inf.0 0.0) (list 0 0+1i 0.0) (list 0 0+2i 0.0)
+ (list 0 0-1i 0.0) (list 0 1+1i 0.0) (list 0 1-1i 0.0) (list 0 0.1+0.1i 0.0) (list 0 1e+16+1e+16i 0.0)
+ (list 0 1e-16+1e-16i 0.0) (list 1 0 1) (list 1 1 1) (list 1 2 1) (list 1 3 1) (list 1 -1 1)
+ (list 1 -2 1) (list 1 -3 1) (list 1 1/2 1) (list 1 1/3 1.0) (list 1 -1/2 1.000E0)
+ (list 1 -1/3 1.000E0) (list 1 0.0 1.000E0) (list 1 1.0 1.000E0) (list 1 2.0 1.000E0)
+ (list 1 -2.0 1.000E0) (list 1 1.000000000000000000000000000000000000002E-309 1.000E0)
+ (list 1 1e+16 1.000E0) (list 1 inf.0 1.000E0) (list 1 -inf.0 1.000E0)
+ (list 1 0+1i 1.0) (list 1 0+2i 1.0) (list 1 0-1i 1.0) (list 1 1+1i 1.0) (list 1 1-1i 1.0) (list 1 -1+1i 1.0)
+ (list 1 -1-1i 1.0) (list 1 0.1+0.1i 1.0) (list 1 1e+16+1e+16i 1.0) (list 1 1e-16+1e-16i 1.0)
+ (list 2 0 1) (list 2 1 2) (list 2 2 4) (list 2 3 8) (list 2 -1 1/2) (list 2 -2 1/4)
+ (list 2 -3 1/8) (list 2 1/2 1.4142135623731) (list 2 1/3 1.2599210498949) (list 2 -1/2 7.071067811865475244008443621048490392845E-1)
+ (list 2 -1/3 7.937005259840997475556964875637659160371E-1) (list 2 0.0 1.000E0) (list 2 1.0 2.000E0)
+ (list 2 2.0 4.000E0) (list 2 -2.0 2.500E-1) (list 2 1.000000000000000000000000000000000000002E-309 1.000E0)
+ (list 2 -inf.0 0.0) (list 2 0+1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
+ (list 2 0+2i 1.83456974743301676839941236809235104518E-1+9.830277404112437205861648503427281526099E-1i)
+ (list 2 0-1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
+ (list 2 1+1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
+ (list 2 1-1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
+ (list 2 -1+1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
+ (list 2 -1-1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
+ (list 2 0.1+0.1i 1.069199809265204517687304849996528484166E0+7.423020183379063973209835788737470580225E-2i)
+ (list 2 1e-16+1e-16i 1.00000000000000006931471805599452949289E0+6.931471805599453429742233135802455373554E-17i)
+ (list 3 0 1) (list 3 1 3) (list 3 2 9) (list 3 3 27) (list 3 -1 1/3) (list 3 -2 1/9)
+ (list 3 -3 1/27) (list 3 1/2 1.7320508075689) (list 3 1/3 1.4422495703074) (list 3 -1/2 5.773502691896257645091487805019574556475E-1)
+ (list 3 -1/3 6.933612743506347189382852083362015558497E-1) (list 3 0.0 1.000E0) (list 3 1.0 3.000E0)
+ (list 3 2.0 9.000E0) (list 3 -2.0 1.111111111111111111111111111111111111113E-1) (list 3 1.000000000000000000000000000000000000002E-309 1.000E0)
+ (list 3 -inf.0 0.0) (list 3 0+1i 4.548324228266097550275651435950424840878E-1+8.905770416677470590749273065651780951036E-1i)
+ (list 3 0+2i -5.862549342913521629213761016900936427016E-1+8.101266271509919688171526765177844453941E-1i)
+ (list 3 0-1i 4.548324228266097550275651435950424840878E-1-8.905770416677470590749273065651780951036E-1i)
+ (list 3 1+1i 1.364497268479829265082695430785127452266E0+2.671731125003241177224781919695534285314E0i)
+ (list 3 1-1i 1.364497268479829265082695430785127452266E0-2.671731125003241177224781919695534285314E0i)
+ (list 3 -1+1i 1.516108076088699183425217145316808280297E-1+2.968590138892490196916424355217260317017E-1i)
+ (list 3 -1-1i 1.516108076088699183425217145316808280297E-1-2.968590138892490196916424355217260317017E-1i)
+ (list 3 0.1+0.1i 1.109394427306365911813022078881836880638E0+1.223721548273860448930668229757603279477E-1i)
+ (list 3 1e-16+1e-16i 1.00000000000000010986122886681096684318E0+1.098612288668109789126712952843432012306E-16i)
+ (list -1 0 1) (list -1 1 -1) (list -1 2 1) (list -1 3 -1) (list -1 -1 -1) (list -1 -2 1)
+ (list -1 -3 -1) (list -1 1/2 0+1i) (list -1 1/3 -1.0) (list -1 -1/2 0.0-1.00E0i)
+ (list -1 -1/3 5.000000000000000503430454055824822034062E-1-8.660254037844386176981523540143355578944E-1i)
+ (list -1 0.0 1.000E0) (list -1 1.0 -1.00E0) (list -1 2.0 1.000E0) (list -1 -2.0 1.000E0)
+ ;(list -1 1e+16 1.000E0)
+ (list -1 0+1i 4.321391826377224977441773717172801127579E-2)
+ (list -1 0+2i 1.86744273170798881443021293482703039342E-3) (list -1 0-1i 2.314069263277926900572908636794854738031E1)
+ (list -1 1+1i -4.321391826377224977441773717172801127579E-2) (list -1 1-1i -2.314069263277926900572908636794854738031E1)
+ (list -1 -1+1i -4.321391826377224977441773717172801127579E-2) (list -1 -1-1i -2.314069263277926900572908636794854738031E1)
+ (list -1 0.1+0.1i 6.946542388413302284911578278489504217747E-1+2.257068442712257901873502529761755278285E-1i)
+ (list -1 1e+16+1e+16i 0.0) (list -1 1e-16+1e-16i 9.999999999999996858407346410206827203587E-1+3.141592653589792185835963602803850622895E-16i)
+ (list -2 0 1) (list -2 1 -2) (list -2 2 4) (list -2 3 -8) (list -2 -1 -1/2) (list -2 -2 1/4)
+ (list -2 -3 -1/8) (list -2 1/2 0+1.4142135623731i) (list -2 1/3 -1.2599210498949)
+ (list -2 -1/2 0.0-7.071067811865475244008443621048490392845E-1i)
+ (list -2 -1/3 3.968502629920499137351498618341152884837E-1-6.873648184993012989383839761489500939792E-1i)
+ (list -2 0.0 1.000E0) (list -2 1.0 -2.00E0) (list -2 2.0 4.000E0) (list -2 -2.0 2.500E-1)
+ (list -2 -inf.0 0.0) (list -2 0+1i 3.324182700885665525901791766265082328307E-2+2.761202036833300995082465454051316449496E-2i)
+ (list -2 0+2i 3.425953940655147934023229852954811989202E-4+1.835748008898304681163796172161682131024E-3i)
+ (list -2 0-1i 1.780072097764048857359856955378859222048E1-1.478600649942216768260366593652156810413E1i)
+ (list -2 1+1i -6.648365401771331051803583532530164656613E-2-5.522404073666601990164930908102632898992E-2i)
+ (list -2 1-1i -3.560144195528097714719713910757718444095E1+2.957201299884433536520733187304313620826E1i)
+ (list -2 -1+1i -1.662091350442832762950895883132541164153E-2-1.380601018416650497541232727025658224748E-2i)
+ (list -2 -1-1i -8.900360488820244286799284776894296110238E0+7.393003249711083841301832968260784052065E0i)
+ (list -2 0.1+0.1i 7.259699150688950609812198701314241029302E-1+2.928900391985359860022641767906842987898E-1i)
+ (list -2 1e+16+1e+16i 0.0) (list -2 1e-16+1e-16i 9.999999999999997551554526970151686615297E-1+3.834739834149737528810186916384012655492E-16i)
+ (list -3 0 1) (list -3 1 -3) (list -3 2 9) (list -3 3 -27) (list -3 -1 -1/3) (list -3 -2 1/9)
+ (list -3 -3 -1/27) (list -3 1/2 0+1.7320508075689i) (list -3 1/3 -1.4422495703074)
+ (list -3 -1/2 0.0-5.773502691896257645091487805019574556475E-1i)
+ (list -3 -1/3 3.466806371753173943750607212746369268463E-1-6.004684775880013553913614575447052401843E-1i)
+ (list -3 0.0 1.000E0) (list -3 1.0 -3.00E0) (list -3 2.0 9.000E0) (list -3 -2.0 1.111111111111111111111111111111111111113E-1)
+ (list -3 -inf.0 0.0) (list -3 0+1i 1.965509114374261361108537566165204334024E-2+3.848532348622211453375207440262631065206E-2i)
+ (list -3 0+2i -1.094797515970330168691448329739632503045E-3+1.512865081636227781901948390654863520171E-3i)
+ (list -3 0-1i 1.052513729605287378161514526579733692066E1-2.060856958704319044776041543097331663996E1i)
+ (list -3 1+1i -5.896527343122784083325612698495613002091E-2-1.15455970458666343601256223207878931956E-1i)
+ (list -3 1-1i -3.157541188815862134484543579739201076193E1+6.182570876112957134328124629291994991979E1i)
+ (list -3 -1+1i -6.551697047914204537028458553884014446755E-3-1.282844116207403817791735813420877021735E-2i)
+ (list -3 -1-1i -3.508379098684291260538381755265778973549E0+6.869523195681063482586805143657772213312E0i)
+ (list -3 0.1+0.1i 7.430253085825579186796890883432274992943E-1+3.354042513063949187690186935389269335405E-1i)
+ (list -3 1e+16+1e+16i 0.0) (list -3 1e-16+1e-16i 9.999999999999997957019635078315805356955E-1+4.240204942257901974962676555647136289098E-16i)
+ (list 1/2 0 1) (list 1/2 1 1/2) (list 1/2 2 1/4) (list 1/2 3 1/8) (list 1/2 -1 2)
+ (list 1/2 -2 4) (list 1/2 -3 8) (list 1/2 1/2 0.70710678118655) (list 1/2 1/3 0.7937005259841)
+ (list 1/2 -1/2 1.414213562373095048801688724209698078569E0) (list 1/2 -1/3 1.259921049894873148607716059938123324722E0)
+ (list 1/2 0.0 1.000E0) (list 1/2 1.0 5.000E-1) (list 1/2 2.0 2.500E-1) (list 1/2 -2.0 4.000E0)
+ (list 1/2 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1/2 1e+16 0.0)
+ (list 1/2 inf.0 0.0) (list 1/2 0+1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
+ (list 1/2 0+2i 1.83456974743301676839941236809235104518E-1-9.830277404112437205861648503427281526099E-1i)
+ (list 1/2 0-1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
+ (list 1/2 1+1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
+ (list 1/2 1-1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
+ (list 1/2 -1+1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
+ (list 1/2 -1-1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
+ (list 1/2 0.1+0.1i 9.307924962319322751032548220951692988141E-1-6.462114401999142796156052473887795907618E-2i)
+ (list 1/2 1e+16+1e+16i 0.0) (list 1/2 1e-16+1e-16i 9.999999999999999306852819440054705071071E-1-6.931471805599452468836205299399646209468E-17i)
+ (list 1/3 0 1) (list 1/3 1 1/3) (list 1/3 2 1/9) (list 1/3 3 1/27) (list 1/3 -1 3)
+ (list 1/3 -2 9) (list 1/3 -3 27) (list 1/3 1/2 0.57735026918963) (list 1/3 1/3 0.69336127435063)
+ (list 1/3 -1/2 1.732050807568877341601513501094972563495E0) (list 1/3 -1/3 1.442249570307408379689974332217791378498E0)
+ (list 1/3 0.0 1.000E0) (list 1/3 1.0 3.333333333333333148296162562473909929395E-1)
+ (list 1/3 2.0 1.111111111111110987752997263871498932361E-1) (list 1/3 -2.0 9.000000000000000999200722162640969581442E0)
+ (list 1/3 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1/3 1e+16 0.0)
+ (list 1/3 inf.0 0.0) (list 1/3 0+1i 4.548324228266097055906083004905301340071E-1-8.905770416677470843231987149725161148001E-1i)
+ (list 1/3 0+2i -5.862549342913522528634995341851693014879E-1-8.101266271509919037297800414810374565267E-1i)
+ (list 1/3 0-1i 4.548324228266097055906083004905301340071E-1+8.905770416677470843231987149725161148001E-1i)
+ (list 1/3 1+1i 1.516108076088698934474456306943980624137E-1-2.968590138892490116287472906226681453643E-1i)
+ (list 1/3 1-1i 1.516108076088698934474456306943980624137E-1+2.968590138892490116287472906226681453643E-1i)
+ (list 1/3 -1+1i 1.364497268479829192516639126693602447003E0-2.671731125003241401280466674231091613441E0i)
+ (list 1/3 -1-1i 1.364497268479829192516639126693602447003E0+2.671731125003241401280466674231091613441E0i)
+ (list 1/3 0.1+0.1i 8.905570151840088631186184238937353595899E-1-9.823321468210062916108146236871209771647E-2i)
+ (list 1/3 1e+16+1e+16i 0.0)
+ (list 1/3 1e-16+1e-16i 9.999999999999998901387711331890276057033E-1-1.098612288668109603248072021584861739285E-16i)
+ (list -1/2 0 1) (list -1/2 1 -1/2) (list -1/2 2 1/4) (list -1/2 3 -1/8) (list -1/2 -1 -2)
+ (list -1/2 -2 4) (list -1/2 -3 -8) (list -1/2 1/2 0+0.70710678118655i) (list -1/2 1/3 -0.7937005259841)
+ (list -1/2 -1/2 0.0-1.414213562373095048801688724209698078569E0i)
+ (list -1/2 -1/3 6.299605249474366377321206522758126486977E-1-1.09112363597172135294521532465807648133E0i)
+ (list -1/2 0.0 1.000E0) (list -1/2 1.0 -5.00E-1) (list -1/2 2.0 2.500E-1) (list -1/2 -2.0 4.000E0)
+ (list -1/2 1e+16 0.0) (list -1/2 inf.0 0.0)
+ (list -1/2 0+1i 3.324182700885665525901791766265082328307E-2-2.761202036833300995082465454051316449496E-2i)
+ (list -1/2 0+2i 3.425953940655147934023229852954811989202E-4-1.835748008898304681163796172161682131024E-3i)
+ (list -1/2 0-1i 1.780072097764048857359856955378859222048E1+1.478600649942216768260366593652156810413E1i)
+ (list -1/2 1+1i -1.662091350442832762950895883132541164153E-2+1.380601018416650497541232727025658224748E-2i)
+ (list -1/2 1-1i -8.900360488820244286799284776894296110238E0-7.393003249711083841301832968260784052065E0i)
+ (list -1/2 -1+1i -6.648365401771331051803583532530164656613E-2+5.522404073666601990164930908102632898992E-2i)
+ (list -1/2 -1-1i -3.560144195528097714719713910757718444095E1-2.957201299884433536520733187304313620826E1i)
+ (list -1/2 0.1+0.1i 6.611643874791633083240145101585573999158E-1+1.651968853835831321053883592233542783317E-1i)
+ (list -1/2 1e+16+1e+16i 0.0)
+ (list -1/2 1e-16+1e-16i 9.999999999999996165260165850261967791906E-1+2.448445473029846938952343072863939318955E-16i)
+ (list -1/3 0 1) (list -1/3 1 -1/3) (list -1/3 2 1/9) (list -1/3 3 -1/27) (list -1/3 -1 -3)
+ (list -1/3 -2 9) (list -1/3 -3 -27) (list -1/3 1/2 0+0.57735026918963i) (list -1/3 1/3 -0.69336127435063)
+ (list -1/3 -1/2 0.0-1.732050807568877341601513501094972563495E0i)
+ (list -1/3 -1/3 7.211247851537042624522227702765802634347E-1-1.249024766483406435214284662923064132397E0i)
+ (list -1/3 0.0 1.000E0) (list -1/3 1.0 -3.333333333333333148296162562473909929395E-1)
+ (list -1/3 2.0 1.111111111111110987752997263871498932361E-1) (list -1/3 -2.0 9.000000000000000999200722162640969581442E0)
+ (list -1/3 1e+16 0.0) (list -1/3 inf.0 0.0)
+ (list -1/3 0+1i 1.965509114374261147472076343409745270744E-2-3.848532348622211562482881134707887874423E-2i)
+ (list -1/3 0+2i -1.094797515970330336653213008135348071651E-3-1.512865081636227660355007437386042651667E-3i)
+ (list -1/3 0-1i 1.052513729605287263760972225954207976974E1+2.060856958704319103202290360191646176391E1i)
+ (list -1/3 1+1i -6.551697047914203461214675496548324731564E-3+1.282844116207403782948806637317477237465E-2i)
+ (list -1/3 1-1i -3.508379098684290684449078029532994204954E0-6.869523195681063296005826865220406716345E0i)
+ (list -1/3 -1+1i -5.896527343122783769739250113564997536121E-2+1.154559704586663532835802707239006768699E-1i)
+ (list -1/3 -1-1i -3.15754118881586196656166312914556280733E1-6.182570876112957652808497982451530065146E1i)
+ (list -1/3 0.1+0.1i 6.408011144159694212372342969009069525835E-1+1.327666945668531521695779387535105337549E-1i)
+ (list -1/3 1e+16+1e+16i 0.0)
+ (list -1/3 1e-16+1e-16i 9.999999999999995759795057742097793539085E-1+2.042980364921682582587891581219059394882E-16i)
+ (list 0.0 0 0.0) (list 0.0 1 0.0) (list 0.0 2 0.0) (list 0.0 3 0.0) (list 0.0 1/2 0.0)
+ (list 0.0 1/3 0.0) (list 0.0 0.0 0.0) (list 0.0 1.0 0.0) (list 0.0 2.0 0.0)
+ (list 0.0 1.000000000000000000000000000000000000002E-309 0.0)
+ (list 0.0 1e+16 0.0) (list 0.0 inf.0 0.0) (list 0.0 0+1i 0.0)
+ (list 0.0 0+2i 0.0) (list 0.0 0-1i 0.0) (list 0.0 1+1i 0.0) (list 0.0 1-1i 0.0) (list 0.0 0.1+0.1i 0.0)
+ (list 0.0 1e+16+1e+16i 0.0) (list 0.0 1e-16+1e-16i 0.0) (list 1.0 0 1.0) (list 1.0 1 1.0)
+ (list 1.0 2 1.0) (list 1.0 3 1.0) (list 1.0 -1 1.0) (list 1.0 -2 1.0) (list 1.0 -3 1.0)
+ (list 1.0 1/2 1.0) (list 1.0 1/3 1.0) (list 1.0 -1/2 1.000E0) (list 1.0 -1/3 1.000E0)
+ (list 1.0 0.0 1.000E0) (list 1.0 1.0 1.000E0) (list 1.0 2.0 1.000E0) (list 1.0 -2.0 1.000E0)
+ (list 1.0 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1.0 1e+16 1.000E0)
+ (list 1.0 inf.0 1.000E0) (list 1.0 -inf.0 1.000E0) (list 1.0 0+1i 1)
+ (list 1.0 0+2i 1) (list 1.0 0-1i 1) (list 1.0 1+1i 1) (list 1.0 1-1i 1) (list 1.0 -1+1i 1)
+ (list 1.0 -1-1i 1) (list 1.0 0.1+0.1i 1) (list 1.0 1e+16+1e+16i 1) (list 1.0 1e-16+1e-16i 1)
+ (list 2.0 0 1.0) (list 2.0 1 2.0) (list 2.0 2 4.000E0) (list 2.0 3 8.000E0) (list 2.0 -1 5.000E-1)
+ (list 2.0 -2 2.500E-1) (list 2.0 -3 1.250E-1) (list 2.0 1/2 1.4142135623731) (list 2.0 1/3 1.2599210498949)
+ (list 2.0 -1/2 7.071067811865475244008443621048490392845E-1) (list 2.0 -1/3 7.937005259840997475556964875637659160371E-1)
+ (list 2.0 0.0 1.000E0) (list 2.0 1.0 2.000E0) (list 2.0 2.0 4.000E0) (list 2.0 -2.0 2.500E-1)
+ (list 2.0 1.000000000000000000000000000000000000002E-309 1.000E0) (list 2.0 -inf.0 0.0)
+ (list 2.0 0+1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i)
+ (list 2.0 0+2i 1.83456974743301676839941236809235104518E-1+9.830277404112437205861648503427281526099E-1i)
+ (list 2.0 0-1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i)
+ (list 2.0 1+1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i)
+ (list 2.0 1-1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i)
+ (list 2.0 -1+1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i)
+ (list 2.0 -1-1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i)
+ (list 2.0 0.1+0.1i 1.069199809265204517687304849996528484166E0+7.423020183379063973209835788737470580225E-2i)
+ (list 2.0 1e-16+1e-16i 1.00000000000000006931471805599452949289E0+6.931471805599453429742233135802455373554E-17i)
+ (list -2.0 0 1.0) (list -2.0 1 -2.0) (list -2.0 2 4.000E0) (list -2.0 3 -8.00E0)
+ (list -2.0 -1 -5.00E-1) (list -2.0 -2 2.500E-1) (list -2.0 -3 -1.25E-1) (list -2.0 1/2 0+1.4142135623731i)
+ (list -2.0 1/3 -1.2599210498949) (list -2.0 -1/2 0.0-7.071067811865475244008443621048490392845E-1i)
+ (list -2.0 -1/3 3.968502629920499137351498618341152884837E-1-6.873648184993012989383839761489500939792E-1i)
+ (list -2.0 0.0 1.000E0) (list -2.0 1.0 -2.00E0) (list -2.0 2.0 4.000E0) (list -2.0 -2.0 2.500E-1)
+ (list -2.0 -inf.0 0.0) (list -2.0 0+1i 3.324182700885665525901791766265082328307E-2+2.761202036833300995082465454051316449496E-2i)
+ (list -2.0 0+2i 3.425953940655147934023229852954811989202E-4+1.835748008898304681163796172161682131024E-3i)
+ (list -2.0 0-1i 1.780072097764048857359856955378859222048E1-1.478600649942216768260366593652156810413E1i)
+ (list -2.0 1+1i -6.648365401771331051803583532530164656613E-2-5.522404073666601990164930908102632898992E-2i)
+ (list -2.0 1-1i -3.560144195528097714719713910757718444095E1+2.957201299884433536520733187304313620826E1i)
+ (list -2.0 -1+1i -1.662091350442832762950895883132541164153E-2-1.380601018416650497541232727025658224748E-2i)
+ (list -2.0 -1-1i -8.900360488820244286799284776894296110238E0+7.393003249711083841301832968260784052065E0i)
+ (list -2.0 0.1+0.1i 7.259699150688950609812198701314241029302E-1+2.928900391985359860022641767906842987898E-1i)
+ (list -2.0 1e+16+1e+16i 0.0)
+ (list -2.0 1e-16+1e-16i 9.999999999999997551554526970151686615297E-1+3.834739834149737528810186916384012655492E-16i)
+ (list 1.000000000000000000000000000000000000002E-309 0 1.0)
+ (list 1.000000000000000000000000000000000000002E-309 1 1.000000000000000000000000000000000000002E-309)
+ (list 1.000000000000000000000000000000000000002E-309 2 1.000000000000000000000000000000000000006E-618)
+ (list 1.000000000000000000000000000000000000002E-309 3 1.000000000000000000000000000000000000006E-927)
+ (list 1.000000000000000000000000000000000000002E-309 1/2 3.162277660168379331998893544432718533725E-155)
+ (list 1.000000000000000000000000000000000000002E-309 1/3 1.000000000000000000000000000000000000001E-103)
+ (list 1.000000000000000000000000000000000000002E-309 -1/2 3.162277660168379331998893544432718533715E154)
+ (list 1.000000000000000000000000000000000000002E-309 -1/3 9.999999999999868346276200367559315452517E102)
+ (list 1.000000000000000000000000000000000000002E-309 0.0 1.000E0)
+ (list 1.000000000000000000000000000000000000002E-309 1.0 1.000000000000000000000000000000000000002E-309)
+ (list 1.000000000000000000000000000000000000002E-309 2.0 1.000000000000000000000000000000000000006E-618)
+ (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309 1.000E0)
+ (list 1.000000000000000000000000000000000000002E-309 1e+16 0.0) (list 1.000000000000000000000000000000000000002E-309 inf.0 0.0)
+ (list 1.000000000000000000000000000000000000002E-309 0+1i 7.188026041688456386956035152151008205727E-2-9.974132684912512522858369772702724490842E-1i)
+ (list 1.000000000000000000000000000000000000002E-309 0+2i -9.896664563248017162886921042023427507381E-1-1.433886509648142863446390724753118562651E-1i)
+ (list 1.000000000000000000000000000000000000002E-309 0-1i 7.188026041688456386956035152151008205727E-2+9.974132684912512522858369772702724490842E-1i)
+ (list 1.000000000000000000000000000000000000002E-309 1+1i 7.188026041688456386956035152151008205733E-311-9.974132684912512522858369772702724490883E-310i)
+ (list 1.000000000000000000000000000000000000002E-309 1-1i 7.188026041688456386956035152151008205733E-311+9.974132684912512522858369772702724490883E-310i)
+ (list 1.000000000000000000000000000000000000002E-309 0.1+0.1i -5.63455610426506242496256141630861088283E-32-1.125793483521731083006048050604051624164E-31i)
+ (list 1.000000000000000000000000000000000000002E-309 1e+16+1e+16i 0.0)
+ (list 1.000000000000000000000000000000000000002E-309 1e-16+1e-16i 9.999999999999288501206264839898510340166E-1-7.114987937351094784363111696637191907549E-14i)
+ (list 1e+16 0 1.0) (list 1e+16 1 1e+16) (list 1e+16 2 1.000E32) (list 1e+16 3 1.000E48)
+ (list 1e+16 -1 1.000000000000000000000000000000000000001E-16) (list 1e+16 -2 9.999999999999999999999999999999999999998E-33)
+ (list 1e+16 -3 9.999999999999999999999999999999999999991E-49) (list 1e+16 1/2 100000000.0)
+ (list 1e+16 1/3 215443.46900319) (list 1e+16 -1/2 9.99999999999999999999999999999999999999E-9)
+ (list 1e+16 -1/3 4.641588833612782056591069448235278756067E-6) (list 1e+16 0.0 1.000E0)
+ (list 1e+16 1.0 1.000E16) (list 1e+16 2.0 1.000E32) (list 1e+16 -2.0 9.999999999999999999999999999999999999998E-33)
+ (list 1e+16 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1e+16 -inf.0 0.0)
+ (list 1e+16 0+1i 6.541406923671771082966425998087477095845E-1-7.563728938753623529733450264648351927405E-1i)
+ (list 1e+16 0+2i -1.441999091787803208994630162235380065937E-1-9.895485769747898065837021120946943010267E-1i)
+ (list 1e+16 0-1i 6.541406923671771082966425998087477095845E-1+7.563728938753623529733450264648351927405E-1i)
+ (list 1e+16 1+1i 6.541406923671771082966425998087477095832E15-7.563728938753623529733450264648351927387E15i)
+ (list 1e+16 1-1i 6.541406923671771082966425998087477095832E15+7.563728938753623529733450264648351927387E15i)
+ (list 1e+16 -1+1i 6.541406923671771082966425998087477095825E-17-7.563728938753623529733450264648351927399E-17i)
+ (list 1e+16 -1-1i 6.541406923671771082966425998087477095825E-17+7.563728938753623529733450264648351927399E-17i)
+ (list 1e+16 0.1+0.1i -3.409382666305111714726686098434812471081E1-2.055490637125206804018448749591854294103E1i)
+ (list 1e+16 1e-16+1e-16i 1.000000000000003684136148790473017422188E0+3.684136148790486590281349632497736627823E-15i)
+ (list inf.0 0 1.0) (list inf.0 -1 0.0) (list inf.0 -2 0.0)
+ (list inf.0 -3 0.0) (list inf.0 -1/2 0.0) (list inf.0 -1/3 0.0) (list inf.0 0.0 1.000E0)
+ (list inf.0 -2.0 0.0) (list inf.0 -inf.0 0.0) (list inf.0 -1+1i 0.0) (list inf.0 -1-1i 0.0)
+ (list -inf.0 0 1.0) (list -inf.0 -1 0.0) (list -inf.0 -2 0.0) (list -inf.0 -3 0.0)
+ (list -inf.0 -1/2 0.0) (list -inf.0 -1/3 0.0) (list -inf.0 0.0 1.000E0) (list -inf.0 -2.0 0.0)
+ (list -inf.0 -inf.0 0.0) (list -inf.0 -1+1i 0.0) (list -inf.0 -1-1i 0.0) (list 0+1i 0 1.0)
+ (list 0+1i 1 0+1i) (list 0+1i 2 -1.00E0) (list 0+1i 3 0.0-1.00E0i) (list 0+1i -1 0.0-1.00E0i)
+ (list 0+1i -2 -1.00E0) (list 0+1i -3 0.0+1.000E0i) (list 0+1i 1/2 0.70710678118655+0.70710678118655i)
+ (list 0+1i 1/3 8.660254037844386612965085791222353988232E-1+4.999999999999999748284772972087582646907E-1i)
+ (list 0+1i -1/2 7.071067811865475244008443621048490392845E-1-7.071067811865475244008443621048490392845E-1i)
+ (list 0+1i -1/3 8.660254037844386612965085791222353988232E-1-4.999999999999999748284772972087582646907E-1i)
+ (list 0+1i 0.0 1.000E0) (list 0+1i 1.0 0.0+1.000E0i) (list 0+1i 2.0 -1.00E0) (list 0+1i -2.0 -1.00E0)
+ (list 0+1i 1.000000000000000000000000000000000000002E-309 1.000E0+1.570796326794896619231321691639751442098E-309i)
+ ;(list 0+1i 1e+16 1.000E0)
+ (list 0+1i 0+1i 2.078795763507619085469556198349787700342E-1)
+ (list 0+1i 0+2i 4.321391826377224977441773717172801127579E-2) (list 0+1i 0-1i 4.810477380965351655473035666703833126401E0)
+ (list 0+1i 1+1i 0.0+2.078795763507619085469556198349787700342E-1i) (list 0+1i 1-1i 0.0+4.810477380965351655473035666703833126401E0i)
+ (list 0+1i -1+1i 0.0-2.078795763507619085469556198349787700342E-1i) (list 0+1i -1-1i 0.0-4.810477380965351655473035666703833126401E0i)
+ (list 0+1i 0.1+0.1i 8.441140118165246481415723784169170682829E-1+1.336945253316592796595429310740609657101E-1i)
+ (list 0+1i 1e+16+1e+16i 0.0) (list 0+1i 1e-16+1e-16i 9.999999999999998429203673205103413601794E-1+1.570796326794896339658091828635841709635E-16i)
+ (list 0+2i 0 1.0) (list 0+2i 1 0+2i) (list 0+2i 2 -4.00E0) (list 0+2i 3 0.0-8.00E0i)
+ (list 0+2i -1 0.0-5.00E-1i) (list 0+2i -2 -2.50E-1) (list 0+2i -3 0.0+1.250E-1i)
+ (list 0+2i 1/2 1+1i) (list 0+2i 1/3 1.09112363597172140787570207348670009638E0+6.299605249474365425897267188156853709001E-1i)
+ (list 0+2i -1/2 5.000E-1-5.00E-1i) (list 0+2i -1/3 6.873648184993013335424222440592397343418E-1-3.968502629920498537991974347557662898919E-1i)
+ (list 0+2i 0.0 1.000E0) (list 0+2i 1.0 0.0+2.000E0i) (list 0+2i 2.0 -4.00E0) (list 0+2i -2.0 -2.50E-1)
+ (list 0+2i 1.000000000000000000000000000000000000002E-309 1.000E0+1.570796326794896619231321691639751442098E-309i)
+ (list 0+2i -inf.0 0.0) (list 0+2i 0+1i 1.599090569280680525199117755445296515815E-1+1.328269994246205222492823642245871455648E-1i)
+ (list 0+2i 0+2i 7.927894711475968677072935966913922424434E-3+4.248048042515221109836149914964543748435E-2i)
+ (list 0+2i 0-1i 3.700406335570025108741522919010577122043E0-3.073708767019492322385562434551223151799E0i)
+ (list 0+2i 1+1i -2.656539988492410444985647284491742911296E-1+3.19818113856136105039823551089059303163E-1i)
+ (list 0+2i 1-1i 6.147417534038984644771124869102446303599E0+7.400812671140050217483045838021154244087E0i)
+ (list 0+2i -1+1i 6.641349971231026112464118211229357278239E-2-7.995452846403402625995588777226482579074E-2i)
+ (list 0+2i -1-1i -1.5368543835097461611927812172756115759E0-1.850203167785012554370761459505288561022E0i)
+ (list 0+2i 0.1+0.1i 8.926023688328728424160522546503419745435E-1+2.056049144522835172454080598405456305612E-1i)
+ (list 0+2i 1e+16+1e+16i 0.0) (list 0+2i 1e-16+1e-16i 9.999999999999999122350853765048490772098E-1+2.263943507354841682632315142216062597333E-16i)
+ (list 0-1i 0 1.0) (list 0-1i 1 0-1i) (list 0-1i 2 -1.00E0) (list 0-1i 3 0.0+1.000E0i)
+ (list 0-1i -1 0.0+1.000E0i) (list 0-1i -2 -1.00E0) (list 0-1i -3 0.0-1.00E0i) (list 0-1i 1/2 0.70710678118655-0.70710678118655i)
+ (list 0-1i 1/3 8.660254037844386612965085791222353988232E-1-4.999999999999999748284772972087582646907E-1i)
+ (list 0-1i -1/2 7.071067811865475244008443621048490392845E-1+7.071067811865475244008443621048490392845E-1i)
+ (list 0-1i -1/3 8.660254037844386612965085791222353988232E-1+4.999999999999999748284772972087582646907E-1i)
+ (list 0-1i 0.0 1.000E0) (list 0-1i 1.0 0.0-1.00E0i) (list 0-1i 2.0 -1.00E0) (list 0-1i -2.0 -1.00E0)
+ (list 0-1i 1.000000000000000000000000000000000000002E-309 1.000E0-1.570796326794896619231321691639751442098E-309i)
+ ;(list 0-1i 1e+16 1.000E0)
+ (list 0-1i 0+1i 4.810477380965351655473035666703833126401E0)
+ (list 0-1i 0+2i 2.314069263277926900572908636794854738031E1) (list 0-1i 0-1i 2.078795763507619085469556198349787700342E-1)
+ (list 0-1i 1+1i 0.0-4.810477380965351655473035666703833126401E0i) (list 0-1i 1-1i 0.0-2.078795763507619085469556198349787700342E-1i)
+ (list 0-1i -1+1i 0.0+4.810477380965351655473035666703833126401E0i) (list 0-1i -1-1i 0.0+2.078795763507619085469556198349787700342E-1i)
+ (list 0-1i 0.1+0.1i 1.15568305287131774105188044357174956096E0-1.830422135215751576397991439148491080012E-1i)
+ (list 0-1i 1e-16+1e-16i 1.000000000000000157079632679489658639818E0-1.570796326794896833138311883103752021701E-16i)
+ (list 1+1i 0 1.0) (list 1+1i 1 1+1i) (list 1+1i 2 0.0+2.000E0i) (list 1+1i 3 -2.00E0+2.000E0i)
+ (list 1+1i -1 5.000E-1-5.00E-1i) (list 1+1i -2 0.0-5.00E-1i) (list 1+1i -3 -2.50E-1-2.50E-1i)
+ (list 1+1i 1/2 1.0986841134678+0.45508986056223i)
+ (list 1+1i 1/3 1.084215081491351179148689172984121435876E0+2.905145555072514268841073782856571173254E-1i)
+ (list 1+1i -1/2 7.768869870150186536720794765315734740815E-1-3.217971264527913123677217187091049044625E-1i)
+ (list 1+1i -1/3 8.605420804595790018414012402960957705697E-1-2.305815555121423995608566442452670487351E-1i)
+ (list 1+1i 0.0 1.000E0) (list 1+1i 1.0 1.000E0+1.000E0i) (list 1+1i 2.0 0.0+2.000E0i)
+ (list 1+1i -2.0 0.0-5.00E-1i)
+ (list 1+1i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
+ (list 1+1i -inf.0 0.0) (list 1+1i 0+1i 4.288290062943678493226520070973354996125E-1+1.548717524642467781923098896798325813036E-1i)
+ (list 1+1i 0+2i 1.599090569280680525199117755445296515815E-1+1.328269994246205222492823642245871455648E-1i)
+ (list 1+1i 0-1i 2.062872235080904951706990637170143171029E0-7.450070621797240878593548325920103204625E-1i)
+ (list 1+1i 1+1i 2.739572538301210711303421174175029183081E-1+5.837007587586146275149618967771680809154E-1i)
+ (list 1+1i 1-1i 2.807879297260629039566345469762153491497E0+1.317865172901180863847635804578132850572E0i)
+ (list 1+1i -1+1i 2.918503793793073137574809483885840404577E-1-1.369786269150605355651710587087514591541E-1i)
+ (list 1+1i -1-1i 6.589325864505904319238179022890664252861E-1-1.403939648630314519783172734881076745749E0i)
+ (list 1+1i 0.1+0.1i 9.509412581367732262071184402582209392577E-1+1.08106001655210286400223506650660553711E-1i)
+ (list 1+1i 1e+16+1e+16i 0.0) (list 1+1i 1e-16+1e-16i 9.99999999999999956117542688252429982572E-1+1.131971753677420890989859729961488955736E-16i)
+ (list 1-1i 0 1.0) (list 1-1i 1 1-1i) (list 1-1i 2 0.0-2.00E0i) (list 1-1i 3 -2.00E0-2.00E0i)
+ (list 1-1i -1 5.000E-1+5.000E-1i) (list 1-1i -2 0.0+5.000E-1i) (list 1-1i -3 -2.50E-1+2.500E-1i)
+ (list 1-1i 1/2 1.0986841134678-0.45508986056223i)
+ (list 1-1i 1/3 1.084215081491351179148689172984121435876E0-2.905145555072514268841073782856571173254E-1i)
+ (list 1-1i -1/2 7.768869870150186536720794765315734740815E-1+3.217971264527913123677217187091049044625E-1i)
+ (list 1-1i -1/3 8.605420804595790018414012402960957705697E-1+2.305815555121423995608566442452670487351E-1i)
+ (list 1-1i 0.0 1.000E0) (list 1-1i 1.0 1.000E0-1.00E0i) (list 1-1i 2.0 0.0-2.00E0i)
+ (list 1-1i -2.0 0.0+5.000E-1i)
+ (list 1-1i 1.000000000000000000000000000000000000002E-309 1.000E0-7.853981633974483096156608458198757210488E-310i)
+ (list 1-1i -inf.0 0.0) (list 1-1i 0+1i 2.062872235080904951706990637170143171029E0+7.450070621797240878593548325920103204625E-1i)
+ (list 1-1i 0+2i 3.700406335570025108741522919010577122043E0+3.073708767019492322385562434551223151799E0i)
+ (list 1-1i 0-1i 4.288290062943678493226520070973354996125E-1-1.548717524642467781923098896798325813036E-1i)
+ (list 1-1i 1+1i 2.807879297260629039566345469762153491497E0-1.317865172901180863847635804578132850572E0i)
+ (list 1-1i 1-1i 2.739572538301210711303421174175029183081E-1-5.837007587586146275149618967771680809154E-1i)
+ (list 1-1i -1+1i 6.589325864505904319238179022890664252861E-1+1.403939648630314519783172734881076745749E0i)
+ (list 1-1i -1-1i 2.918503793793073137574809483885840404577E-1+1.369786269150605355651710587087514591541E-1i)
+ (list 1-1i 0.1+0.1i 1.118774658142734663065880800594211744947E0-4.912611879174141197780391086654035970153E-2i)
+ (list 1-1i 1e-16+1e-16i 1.000000000000000113197175367742099510321E0-4.388245731174756954083421259082963337401E-17i)
+ (list -1+1i 0 1.0) (list -1+1i 1 -1+1i) (list -1+1i 2 0.0-2.00E0i) (list -1+1i 3 2.000E0+2.000E0i)
+ (list -1+1i -1 -5.00E-1-5.00E-1i) (list -1+1i -2 0.0+5.000E-1i) (list -1+1i -3 2.500E-1-2.50E-1i)
+ (list -1+1i 1/2 0.45508986056223+1.0986841134678i)
+ (list -1+1i 1/3 7.937005259840997668899692535826356354889E-1+7.937005259840996976818927177620594283082E-1i)
+ (list -1+1i -1/2 3.217971264527913123677217187091049044625E-1-7.768869870150186536720794765315734740815E-1i)
+ (list -1+1i -1/3 6.299605249474366138887223148884515164688E-1-6.299605249474365589582355660598282273075E-1i)
+ (list -1+1i 0.0 1.000E0) (list -1+1i 1.0 -1.00E0+1.000E0i) (list -1+1i 2.0 0.0-2.00E0i)
+ (list -1+1i -2.0 0.0+5.000E-1i)
+ (list -1+1i 1.000000000000000000000000000000000000002E-309 1.000E0+2.35619449019234492884698253745962716315E-309i)
+ (list -1+1i -inf.0 0.0) (list -1+1i 0+1i 8.914479215539140039333169785416699948907E-2+3.219467429096768688435430339284927790439E-2i)
+ (list -1+1i 0+2i 6.910296915726436425237112293342453374671E-3+5.7399750963576748986151091014202337188E-3i)
+ (list -1+1i 0-1i 9.923400226678132867281183645053121674554E0-3.583839621275010020102858511593195855531E0i)
+ (list -1+1i 1+1i -1.213394664463590872776860012470162773935E-1+5.695011786442371350897739446131772158468E-2i)
+ (list -1+1i 1-1i -6.339560605403122847178325133459925819034E0+1.350723984795314288738404215664631753007E1i)
+ (list -1+1i -1+1i -2.847505893221185675448869723065886079234E-2-6.066973322317954363884300062350813869673E-2i)
+ (list -1+1i -1-1i -6.753619923976571443692021078323158765037E0-3.169780302701561423589162566729962909517E0i)
+ (list -1+1i 0.1+0.1i 7.882496598308880991233017323974702727041E-1+2.1838943088351018304792416348997040808E-1i)
+ (list -1+1i 1e+16+1e+16i 0.0)
+ (list -1+1i 1e-16+1e-16i 9.999999999999997990379100087627604548201E-1+2.702768080472316983907841531363385588262E-16i)
+ (list -1-1i 0 1.0) (list -1-1i 1 -1-1i) (list -1-1i 2 0.0+2.000E0i) (list -1-1i 3 2.000E0-2.00E0i)
+ (list -1-1i -1 -5.00E-1+5.000E-1i) (list -1-1i -2 0.0-5.00E-1i) (list -1-1i -3 2.500E-1+2.500E-1i)
+ (list -1-1i 1/2 0.45508986056223-1.0986841134678i)
+ (list -1-1i 1/3 7.937005259840997668899692535826356354889E-1-7.937005259840996976818927177620594283082E-1i)
+ (list -1-1i -1/2 3.217971264527913123677217187091049044625E-1+7.768869870150186536720794765315734740815E-1i)
+ (list -1-1i -1/3 6.299605249474366138887223148884515164688E-1+6.299605249474365589582355660598282273075E-1i)
+ (list -1-1i 0.0 1.000E0) (list -1-1i 1.0 -1.00E0-1.00E0i) (list -1-1i 2.0 0.0+2.000E0i)
+ (list -1-1i -2.0 0.0-5.00E-1i) (list -1-1i 1.000000000000000000000000000000000000002E-309 1.000E0-2.35619449019234492884698253745962716315E-309i)
+ (list -1-1i -inf.0 0.0) (list -1-1i 0+1i 9.923400226678132867281183645053121674554E0+3.583839621275010020102858511593195855531E0i)
+ (list -1-1i 0+2i 8.562996562781501151982322359385576132148E1+7.112774982027701655978420905114385775416E1i)
+ (list -1-1i 0-1i 8.914479215539140039333169785416699948907E-2-3.219467429096768688435430339284927790439E-2i)
+ (list -1-1i 1+1i -6.339560605403122847178325133459925819034E0-1.350723984795314288738404215664631753007E1i)
+ (list -1-1i 1-1i -1.213394664463590872776860012470162773935E-1-5.695011786442371350897739446131772158468E-2i)
+ (list -1-1i -1+1i -6.753619923976571443692021078323158765037E0+3.169780302701561423589162566729962909517E0i)
+ (list -1-1i -1-1i -2.847505893221185675448869723065886079234E-2+6.066973322317954363884300062350813869673E-2i)
+ (list -1-1i 0.1+0.1i 1.283956758872096257591990187677552600208E0-2.615572127992484175251616566885584992446E-1i)
+ (list -1-1i 1e-16+1e-16i 1.000000000000000270276808047231769038073E0-2.009620899912372775286764036246047795846E-16i)
+ (list 0.1+0.1i 0 1.0) (list 0.1+0.1i 1 0.1+0.1i) (list 0.1+0.1i 2 0.0+2.000000000000000222044604925031314247702E-2i)
+ (list 0.1+0.1i 3 -2.000000000000000333066907387546980616012E-3+2.000000000000000333066907387546980616012E-3i)
+ (list 0.1+0.1i -1 4.999999999999999722444243843710880301532E0-4.999999999999999722444243843710880301532E0i)
+ (list 0.1+0.1i -2 0.0-4.999999999999999444888487687421776010503E1i)
+ (list 0.1+0.1i -3 -2.499999999999999583666365765566343563457E2-2.499999999999999583666365765566343563457E2i)
+ (list 0.1+0.1i 1/2 0.34743442276012+0.14391204994251i)
+ (list 0.1+0.1i 1/3 5.032480615484825043523903544407412355396E-1+1.348449116844438143505188591437346924604E-1i)
+ (list 0.1+0.1i -1/2 2.45673236351311521671469493547019420871E0-1.017611864088040968689409531603674348818E0i)
+ (list 0.1+0.1i -1/3 1.853981710374325315321217484547221353494E0-4.967729020768720696346827580207236635648E-1i)
+ (list 0.1+0.1i 0.0 1.000E0) (list 0.1+0.1i 1.0 1.000000000000000055511151231257827021182E-1+1.000000000000000055511151231257827021182E-1i)
+ (list 0.1+0.1i 2.0 0.0+2.000000000000000222044604925031314247702E-2i) (list 0.1+0.1i -2.0 0.0-4.999999999999999444888487687421776010503E1i)
+ (list 0.1+0.1i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
+ (list 0.1+0.1i 1e+16 0.0) (list 0.1+0.1i inf.0 0.0)
+ (list 0.1+0.1i 0+1i -1.713226510357599956083331913106303247236E-1-4.22525887482460786856087271691853977193E-1i)
+ (list 0.1+0.1i 0+2i -1.491766748349203175549260651566533449245E-1+1.447765103494648437770214174856742113327E-1i)
+ (list 0.1+0.1i 0-1i -8.241437376545436347801862567004657850891E-1+2.032551224606688826869616254728598600103E0i)
+ (list 0.1+0.1i 1+1i 2.512032364467008051923349285554493285946E-2-5.938485385182208154296364931488770060654E-2i)
+ (list 0.1+0.1i 1-1i -2.856694962261232620228228583084710444815E-1+1.208407486952145259169520755212883935691E-1i)
+ (list 0.1+0.1i -1+1i -2.969242692591103747496022164280467138525E0-1.256016182233503886515866161034993752114E0i)
+ (list 0.1+0.1i -1-1i 6.042037434760725625046696204216927090118E0+1.428347481130616151535688219886713564214E1i)
+ (list 0.1+0.1i 0.1+0.1i 7.550220306566742029451631510549876832316E-1-8.878982993466537268563019824356751882119E-2i)
+ (list 0.1+0.1i 1e+16+1e+16i 0.0)
+ (list 0.1+0.1i 1e-16+1e-16i 9.999999999999997258590333888479081137213E-1-1.170613339316624318801081266623392933101E-16i)
+ (list 1e+16+1e+16i 0 1.0) (list 1e+16+1e+16i 1 1e+16+1e+16i) (list 1e+16+1e+16i 2 0.0+2.000E32i)
+ (list 1e+16+1e+16i 3 -2.00E48+2.000E48i)
+ (list 1e+16+1e+16i -1 5.000000000000000000000000000000000000004E-17-5.000000000000000000000000000000000000004E-17i)
+ (list 1e+16+1e+16i -2 0.0-4.999999999999999999999999999999999999999E-33i)
+ (list 1e+16+1e+16i -3 -2.499999999999999999999999999999999999998E-49-2.499999999999999999999999999999999999998E-49i)
+ (list 1e+16+1e+16i 1/2 109868411.34678+45508986.056223i)
+ (list 1e+16+1e+16i 1/3 2.335870583020711134947889498537726801442E5+6.258946363440152792122310286091229534238E4i)
+ (list 1e+16+1e+16i -1/2 7.76886987015018653672079476531573474081E-9-3.217971264527913123677217187091049044617E-9i)
+ (list 1e+16+1e+16i -1/3 3.994282511515094148675512812353991597295E-6-1.070264773302225997506194769200154785053E-6i)
+ (list 1e+16+1e+16i 0.0 1.000E0) (list 1e+16+1e+16i 1.0 1.000E16+1.000E16i) (list 1e+16+1e+16i 2.0 0.0+2.000E32i)
+ (list 1e+16+1e+16i -2.0 0.0-4.999999999999999999999999999999999999999E-33i)
+ (list 1e+16+1e+16i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
+ (list 1e+16+1e+16i -inf.0 0.0)
+ (list 1e+16+1e+16i 0+1i 3.97655298675457451476815297378330384373E-1-2.23046721083486532799277949440696753733E-1i)
+ (list 1e+16+1e+16i 0+2i 1.083798967785726369788640263558841648425E-1-1.773914209820705797251910148995630479122E-1i)
+ (list 1e+16+1e+16i 0-1i 1.912911819699309232365644880468914363155E0+1.072961206670599579011330828139081101248E0i)
+ (list 1e+16+1e+16i 1+1i 6.207020197589439842760932468190271381067E15+1.746085775919709186775373479376336306396E15i)
+ (list 1e+16+1e+16i 1-1i 8.39950613028709653354314052329833261908E15+2.985873026369908811376975708607995464407E16i)
+ (list 1e+16+1e+16i -1+1i 8.730428879598545933876867396881681532013E-18-3.103510098794719921380466234095135690525E-17i)
+ (list 1e+16+1e+16i -1-1i 1.492936513184954405688487854303997732202E-16-4.19975306514354826677157026164916630953E-17i)
+ (list 1e+16+1e+16i 0.1+0.1i -3.019911767946562559553699791129052056384E1-2.323225580723027414176687762549620584343E1i)
+ (list 1e+16+1e+16i 1e-16+1e-16i 1.000000000000003640253691478724868702006E0+3.797333324158228934745194038802400084708E-15i)
+ (list 1e-16+1e-16i 0 1.0) (list 1e-16+1e-16i 1 1e-16+1e-16i) (list 1e-16+1e-16i 2 0.0+1.999999999999999916391146896138415121169E-32i)
+ (list 1e-16+1e-16i 3 -1.999999999999999874586720344207623992465E-48+1.999999999999999874586720344207623992465E-48i)
+ (list 1e-16+1e-16i -1 5.000000000000000104511066379826984375319E15-5.000000000000000104511066379826984375319E15i)
+ (list 1e-16+1e-16i -2 0.0-5.00000000000000020902213275965397093513E31i)
+ (list 1e-16+1e-16i -3 -2.500000000000000156766599569740479839725E47-2.500000000000000156766599569740479839725E47i)
+ (list 1e-16+1e-16i 1/2 1.0986841134678e-08+4.5508986056223e-09i)
+ (list 1e-16+1e-16i 1/3 5.032480615484828131577934532998162284517E-6+1.348449116844438970946772378503363059943E-6i)
+ (list 1e-16+1e-16i -1/2 7.768869870150186617914082234866133300043E7-3.217971264527913157308578030636299721171E7i)
+ (list 1e-16+1e-16i -1/3 1.853981710374324177672385518009559821262E5-4.967729020768717648025969623769604859166E4i)
+ (list 1e-16+1e-16i 0.0 1.000E0) (list 1e-16+1e-16i 1.0 9.999999999999999790977867240346035618411E-17+9.999999999999999790977867240346035618411E-17i)
+ (list 1e-16+1e-16i 2.0 0.0+1.999999999999999916391146896138415121169E-32i) (list 1e-16+1e-16i -2.0 0.0-5.00000000000000020902213275965397093513E31i)
+ (list 1e-16+1e-16i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i)
+ (list 1e-16+1e-16i 1e+16 0.0) (list 1e-16+1e-16i inf.0 0.0)
+ (list 1e-16+1e-16i 0+1i 1.633737074935952277071942452600366041402E-1+4.256625518536474393286932017574035701805E-1i)
+ (list 1e-16+1e-16i 0+2i -1.544976397503562816275493845355474590488E-1+1.390841384750302156856253710476447606724E-1i)
+ (list 1e-16+1e-16i 0-1i 7.859055245423894167511168257029299588438E-1-2.047640077615962126490396474363177248838E0i)
+ (list 1e-16+1e-16i 1+1i -2.622888443600522061390815917770620324788E-17+5.890362593472426547237259268645081580369E-17i)
+ (list 1e-16+1e-16i 1-1i 2.833545602158351484014138796578448096738E-16-1.26173455307357268336623492266154970137E-16i)
+ (list 1e-16+1e-16i -1+1i 2.945181296736213396740244835851862239781E15+1.311444221800261085519581606088360070987E15i)
+ (list 1e-16+1e-16i -1-1i -6.308672765367863680561621873294727149409E15-1.416772801079175801234443901776883778303E16i)
+ (list 1e-16+1e-16i 0.1+0.1i -2.185846675892145203322615268234771243738E-2+1.000746379588156995072970612624735653063E-2i)
+ (list 1e-16+1e-16i 1e+16+1e+16i 0.0)
+ (list 1e-16+1e-16i 1e-16+1e-16i 9.999999999999962719813938977799891729155E-1-3.570938973422717612919117771011138615376E-15i)
+ )))
+
;; there's a difference here between gmp/non-gmp:
; (test (expt 0 (real-part (log 0))) (expt 0.0 (real-part (log 0))))
; (num-test (expt 1.0 (/ (real-part (log 0)) (real-part (log 0)))) (expt 1 (/ (real-part (log 0)) (real-part (log 0)))))
@@ -54068,9 +70034,9 @@ abs 1 2
(for-each
(lambda (e)
(if (> (magnitude (- (expt rval e) (expt frval e))) eps)
- (format #t "~A: ;(expt ~A e) != (expt ~A e) -> ~A~%" e rval frval (magnitude (- (expt rval e) (expt frval e)))))
+ (format-logged #t "~A: ;(expt ~A e) != (expt ~A e) -> ~A~%" e rval frval (magnitude (- (expt rval e) (expt frval e)))))
(if (> (magnitude (- (expt ival e) (expt fival e))) eps)
- (format #t "~A ;(expt ~A e) != (expt ~A e) -> ~A~%" e ival fival (magnitude (- (expt ival e) (expt fival e))))))
+ (format-logged #t "~A ;(expt ~A e) != (expt ~A e) -> ~A~%" e ival fival (magnitude (- (expt ival e) (expt fival e))))))
(list 0 0.0 (log 0) (real-part (log 0)) (- (real-part (log 0))))))))))
|#
@@ -54118,7 +70084,8 @@ abs 1 2
(if (> (abs (- val (list-ref expts (- i 1)))) 1e-6)
(begin
(set! happy #f)
- (display "expt error > 1e-6 around 2^") (display (/ (log (expt .1 i)) (log 2))) (newline)))))
+ (if (or with-bignums (< (abs (log (expt .1 i) 2)) 46))
+ (begin (display "expt error > 1e-6 around 2^") (display (log (expt .1 i) 2)) (newline)))))))
(lambda args
(display "expt not accurate below around 2^") (display (/ (log (expt .1 i)) (log 2))) (newline))))))
@@ -54135,6 +70102,25 @@ abs 1 2
(test (expt 0 -1.0) 'error)
(test (expt 0 -1.0+i) 'error)
+(when (not with-bignums)
+ (test (nan? (expt 0 0+0/0i)) #t)
+ (test (nan? (expt 0 0-0/0i)) #t)
+ (test (nan? (expt 0 0/0+i)) #t)
+ (test (nan? (expt 0 nan.0)) #t))
+(for-each
+ (lambda (arg)
+ (test (expt arg nan.0) 'error)
+ (test (expt nan.0 arg) 'error)
+ (test (expt arg inf.0) 'error)
+ (test (expt inf.0 arg) 'error)
+ (test (expt arg 2) 'error)
+ (test (expt 2 arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
+
;;; --------------------------------------------------------------------------------
@@ -54208,15 +70194,15 @@ abs 1 2
(if with-bignums
(begin
- (let ((old-precision (bignum-precision)))
+ (let ((old-precision (*s7* 'bignum-precision)))
; these checked against arprec (digits = 512)
- (set! (bignum-precision) 512)
+ (set! (*s7* 'bignum-precision) 512)
(num-test (sin (bignum "696898287454081973170944403677937368733396.0")) -0.01999904696709900707248379699203543861700131080741493395453090012397)
(num-test (cos (bignum "696898287454081973170944403677937368733396.0")) -0.99979999906001588673892554498680272502063995303949755633430660411025)
(num-test (tan (bignum "696898287454081973170944403677937368733396.0")) 0.02000304759542063815661565629241173304757896817099118262507840447691)
(num-test (log (bignum "696898287454081973170944403677937368733396.0")) 96.34745809783239800899232787971326647885871562509641009125683617504293)
(num-test (sqrt (bignum "696898287454081973170944403677937368733396.0")) 8.34804340821298061589146684184612401904558331041225568173326261228620e20)
- (set! (bignum-precision) old-precision))
+ (set! (*s7* 'bignum-precision) old-precision))
;; these can be checked against arprec -- get tables of the others as well
;; (num-test (sin 31415926535897932384626433832795028841.971693993751058209749445) 6.8290634690588564658126265428876656461078982456442870201741792E-24)
@@ -55028,6 +71014,22 @@ abs 1 2
(num-test (* 92233720/9221 -92233720/9221 9221/92233720 -9221/92233720) 1)
(num-test (* 9221/92233720 -9221/92233720 92233720/9221 -92233720/9221) 1)
+(for-each-permutation
+ (lambda args
+ (if (not (< (magnitude (- (apply * args) 0.25+0.25i)) 1e-15))
+ (format-logged #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))))
+ '(1 1/2 0.5 1+i))
+
+(for-each-permutation
+ (lambda args
+ (if (not (< (magnitude (- (apply * args) 1.0)) 1e-15))
+ (format-logged #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))))
+ '(5 1/3 0.5 1+i 1/5 3 2.0 0.5-0.5i))
+
+(num-test (* 7/1000 1000/999 999/7 most-positive-fixnum) most-positive-fixnum)
+(num-test (* 7/1000000 1/999 999/7 (- most-positive-fixnum 775807)) 9223372036854)
+(num-test (* 7/100000000000 1/999 999/7 (- most-positive-fixnum 36854775807)) 92233720)
+
(num-test (* -0.2554913394465045E0 0.27042187315261135E0) -6.909044658739340841916780452607499999997E-2)
(num-test (* -0.4489211233229662E0 -0.42892136850270857E0) 1.925518625654598642702435865603340000003E-1)
(num-test (* -0.44586465919973783E0 -0.15168042462027043E0) 6.762894083058839862686475970136690000031E-2)
@@ -55236,6 +71238,10 @@ abs 1 2
(num-test (* 1/98947 2/97499 3/76847 4/61981) 5.2230351951008e-19)
(num-test (* 500009/500029 500057/500041 500083/500069) 1.00001999432878)
(num-test (* 98947 2/97499 76847 4/61981 5/59981) 304151204360/362470312515139) ;0.00083910652502692
+
+ (num-test (* 256 2048 35184372088832) 1.8446744073709551616E19)
+ (num-test (* 64 67108864 4294967296) 1.8446744073709551616E19)
+ (num-test (* 65535/131072 2305843009213693952 1048576/524287) 2.30581222282939585599978637654567059645E18)
))
(if with-bignums
@@ -55248,13 +71254,13 @@ abs 1 2
(do ((i 0 (+ i 1)))
((= i 29))
(if (not (= (twos (+ i 1)) (* 8 (twos i))))
- (format #t "~A * 8 -> ~A (~A)~%" (twos i) (* 8 (twos i)) (twos (+ i 1))))
+ (format-logged #t "~A * 8 -> ~A (~A)~%" (twos i) (* 8 (twos i)) (twos (+ i 1))))
(if (not (= (+ (twos (+ i 1)) (* 8 (twos i))) (* 2 (twos (+ i 1)))))
- (format #t "~A + ~A -> ~A (~A)~%" (* 8 (twos i)) (twos (+ i 1)) (* 2 (twos (+ i 1)))))
+ (format-logged #t "~A + ~A -> ~A (~A)~%" (* 8 (twos i)) (twos (+ i 1)) (* 2 (twos (+ i 1)))))
(if (not (= (/ (twos (+ i 1)) (twos i)) 8))
- (format #t "~A / ~A = ~A (8)~%" (twos (+ i 1)) (twos i) (/ (twos (+ i 1)) (twos i))))
+ (format-logged #t "~A / ~A = ~A (8)~%" (twos (+ i 1)) (twos i) (/ (twos (+ i 1)) (twos i))))
(if (not (= (- (twos (+ i 1)) (* 8 (twos i))) 0))
- (format #t "~A - ~A -> ~A (0)~%" (* 8 (twos i)) (twos (+ i 1)) (- (twos (+ i 1)) (* 8 (twos i)))))))
+ (format-logged #t "~A - ~A -> ~A (0)~%" (* 8 (twos i)) (twos (+ i 1)) (- (twos (+ i 1)) (* 8 (twos i)))))))
(letrec ((factorial (lambda (n i) (if (positive? n) (factorial (- n 1) (* i n)) i))))
(num-test (/ (factorial 100 1) (factorial 99 1)) 100)
@@ -55577,6 +71583,14 @@ abs 1 2
(val2 (catch #t (lambda () (* 1.0 -0.0)) (lambda args 'error))))
(test (equal? val1 val2) #t))
+(if with-bignums
+ (begin
+ (num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 1099511627776/12157665459056928801)
+ (num-test (expt 2 40) 1099511627776)
+ (num-test (expt 3 40) 12157665459056928801)
+ )
+ (num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 9.043772683816628192400549525035572818665E-8))
+
(test (* 0 1 "hi") 'error)
(test (* 0.0 "hi") 'error)
(test (* 0.0+0.0i "hi") 'error)
@@ -55584,6 +71598,27 @@ abs 1 2
(test (* 1 0.0 #\a) 'error)
(test (* 2 2 2.0 2) 16.0)
+(for-each
+ (lambda (arg)
+ (test (* arg nan.0) 'error)
+ (test (* nan.0 arg) 'error)
+ (test (* arg inf.0) 'error)
+ (test (* inf.0 arg) 'error)
+ (test (* 0 arg nan.0) 'error)
+ (test (* 0 nan.0 arg) 'error)
+ (test (* 0 arg inf.0) 'error)
+ (test (* 0 inf.0 arg) 'error)
+ (test (* 0 arg) 'error)
+ (test (* 0.0 arg) 'error)
+ (test (* 1 arg) 'error)
+ (test (* 1.0 arg) 'error)
+ (test (* 1/2 arg) 'error)
+ (test (* 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+
+
;;; --------------------------------------------------------------------------------
@@ -56357,11 +72392,34 @@ abs 1 2
(num-test (+ 362880) 362880)
(num-test (+ 362880/1234) 362880/1234)
+(for-each-permutation
+ (lambda args
+ (if (not (= (apply + args) 3+i))
+ (format-logged #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))))
+ '(1 1/2 0.5 1+i))
+
+(for-each-permutation
+ (lambda args
+ (if (not (zero? (apply + args)))
+ (format-logged #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))))
+ '(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i))
+
+(num-test (+ 10.0+0.i) 10.0)
+(num-test (+ +10.+.0i) 10.0)
+(test (integer? (+ 1/2 1/2)) #t)
+(test (real? (+ 1+i 1-i)) #t)
+(test (integer? (+ 1/100 99/100 (- most-positive-fixnum 2))) #t) ; of course reversing the args won't work
+(test (integer? (+ 1/1000 999/1000 (- most-positive-fixnum 9223372036854775807))) #t)
+(num-test (+ 1/1000 999/1000 (- most-positive-fixnum 9223372036854775807)) 1)
+(test (integer? (+ 1/1000 999/1000 (- most-positive-fixnum 9200000000000000000))) #t)
+(num-test (+ 1/1000 999/1000 (- most-positive-fixnum 9200000000000000000)) 23372036854775808)
+(test (+ (rootlet) 1) 'error)
+
(test (< (+ 0.7 8388608) 8388609) #t) ; false in clisp!
(num-test (+ -1.797693134862315699999999999999999999998E308 -9223372036854775808) -1.797693134862315699999999999999999999998E308)
(num-test (+ -9223372036854775808 5.551115123125783999999999999999999999984E-17) -9.223372036854775807999999999999999944489E18)
-(num-test (+ -9223372036854775808 9223372036854775807 -9223372036854775808) -9223372036854775809)
+(num-test (+ -9223372036854775808 9223372036854775807 -9223372036854775808) -9.223372036854775809e18)
(num-test (+ -9223372036854775808) -9223372036854775808)
(num-test (+ 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -9.223372036854775807999999999999999888978E18)
(num-test (+ 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 1.665876638023977952217059999999999999994E-16)
@@ -56377,6 +72435,18 @@ abs 1 2
(num-test (+ -9223372036854775808 9223372036854775807) -1)
(num-test (+ -9221/92233720 -92233720/9221 9221/92233720 92233720/9221) 0)
+(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2)) -9223372036854775808)
+(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2) 1) -9223372036854775807)
+(num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2) -1) (if with-bignums -9223372036854775809 -9.223372036854776e+18))
+(num-test (- (/ most-negative-fixnum 2) (/ most-positive-fixnum 2) 1) (if with-bignums -18446744073709551617/2 -9.223372036854776e+18))
+(num-test (* 3037000499 3037000500) 9223372033963249500)
+(num-test (* 3037000499 3037000499) 9223372030926249001)
+(num-test (* 3037000500 3037000500) (if with-bignums 9223372037000250000 9.223372037000249e+18))
+(num-test (/ (* (/ 3037000499) (/ 3037000498))) 9223372027889248502)
+(num-test (/ (* (/ 3037000500) (/ 3037000500))) (if with-bignums 9223372037000250000 9.223372037000251e+18))
+(num-test (/ 3037000499 (/ 3037000499)) 9223372030926249001)
+(num-test (/ 3037000500 (/ 3037000500)) (if with-bignums 9223372037000250000 9.223372037000251e+18))
+
(num-test (+ 0.6049332056786565E0 -0.9611373574853808E0) -3.562041518067242999999999999999999999981E-1)
(num-test (+ -0.4763715667865308E0 0.25936932107685584E0) -2.170022457096749600000000000000000000008E-1)
(num-test (+ 0.2666481927718355E0 -0.04984768063142031E0) 2.168005121404151899999999999999999999994E-1)
@@ -56549,7 +72619,7 @@ abs 1 2
(num-test (+ 38673/65491 57303/2569 40991/55309) 219956905519979/9305538976111)
(num-test (+ 1/98947 2/97499 3/76847) 51641766530/741360956847391)
-(num-test (+ 123456789/3 3/123456789 -123456789/3 -3/123456789) 0)
+(test (> (+ 123456789/3 3/123456789 -123456789/3 -3/123456789) 2e-12) #f) ; it's really 0, but fp inaccuracies catch us
(num-test (+ 1e100 -1e100) 0.0)
(num-test (+ 1e100 1e100) 2e100)
(num-test (+ 1e200 -1e200) 0.0)
@@ -56563,13 +72633,44 @@ abs 1 2
(num-test (+) 0 )
(num-test (+ 123123123123123 123123123123123) 246246246246246)
-(num-test (+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99) 4950)
-
-(num-test (+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999) 499500)
+(if (not with-bignums)
+ (begin
+ (num-test (+ 3/4 4611686018427387904) 4.61168601842738790475E18)
+ (num-test (+ 1/17179869184 1073741824) 1.073741824000000000058207660913467407227E9)
+ (num-test (+ 1/8589934592 1073741824) 1.073741824000000000116415321826934814453E9)
+ (num-test (+ 100000 1/142857142857140) 1.000000000000000000070000000000001400001E5)
+ (num-test (+ 4611686018427387904 3/4) 4.61168601842738790475E18)
+ (num-test (+ -63 8 1/9223372036854775807) -55.0)
+ (num-test (+ 8 8 1/9223372036854775807) 16.0)
+ (num-test (+ -1 -63 1/9223372036854775807) -64.0)
+ (num-test (+ 32768 -1 562949953421312/281474976710655) 32769.0)
+ (num-test (+ -63 262144 70368744177664/35184372088831) 262083.0)
+ (num-test (+ 2147483648 -1 8589934592/4294967295) 2147483649.0)
+ (num-test (+ 8589934592/4294967295 2147483648 -1) 2147483649.0)
+ (num-test (+ 8589934592/4294967295 -1 2147483648) 2147483649.0)
+ (num-test (+ -1 8589934592/4294967295 2147483648) 2147483649.0)
+
+; (num-test (+ 4611686018427387904 4611686018427387904) 9.223372036854775808e18)
+; (num-test (+ most-positive-fixnum most-positive-fixnum) 1.8446744073709551614e19)
+; (num-test (+ most-negative-fixnum most-negative-fixnum) -1.8446744073709551616e19)
+ ))
-(num-test (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 (+ 10 (+ 11 (+ 12 (+ 13 (+ 14 (+ 15 (+ 16 (+ 17 (+ 18 (+ 19 (+ 20 (+ 21 (+ 22 (+ 23 (+ 24 (+ 25 (+ 26 (+ 27 (+ 28 (+ 29 (+ 30 (+ 31 (+ 32 (+ 33 (+ 34 (+ 35 (+ 36 (+ 37 (+ 38 (+ 39 (+ 40 (+ 41 (+ 42 (+ 43 (+ 44 (+ 45 (+ 46 (+ 47 (+ 48 (+ 49 (+ 50 (+ 51 (+ 52 (+ 53 (+ 54 (+ 55 (+ 56 (+ 57 (+ 58 (+ 59 (+ 60 (+ 61 (+ 62 (+ 63 (+ 64 (+ 65 (+ 66 (+ 67 (+ 68 (+ 69 (+ 70 (+ 71 (+ 72 (+ 73 (+ 74 (+ 75 (+ 76 (+ 77 (+ 78 (+ 79 (+ 80 (+ 81 (+ 82 (+ 83 (+ 84 (+ 85 (+ 86 (+ 87 (+ 88 (+ 89 (+ 90 (+ 91 (+ 92 (+ 93 (+ 94 (+ 95 (+ 96 (+ 97 (+ 98 (+ 99))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 4950)
+(let ()
+ (define (add1)
+ (+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99))
+ (num-test (add1) 4950)
+
+ (define (add2)
+ (+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999))
+ (num-test (add2) 499500)
+
+ (define (add3)
+ (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 (+ 10 (+ 11 (+ 12 (+ 13 (+ 14 (+ 15 (+ 16 (+ 17 (+ 18 (+ 19 (+ 20 (+ 21 (+ 22 (+ 23 (+ 24 (+ 25 (+ 26 (+ 27 (+ 28 (+ 29 (+ 30 (+ 31 (+ 32 (+ 33 (+ 34 (+ 35 (+ 36 (+ 37 (+ 38 (+ 39 (+ 40 (+ 41 (+ 42 (+ 43 (+ 44 (+ 45 (+ 46 (+ 47 (+ 48 (+ 49 (+ 50 (+ 51 (+ 52 (+ 53 (+ 54 (+ 55 (+ 56 (+ 57 (+ 58 (+ 59 (+ 60 (+ 61 (+ 62 (+ 63 (+ 64 (+ 65 (+ 66 (+ 67 (+ 68 (+ 69 (+ 70 (+ 71 (+ 72 (+ 73 (+ 74 (+ 75 (+ 76 (+ 77 (+ 78 (+ 79 (+ 80 (+ 81 (+ 82 (+ 83 (+ 84 (+ 85 (+ 86 (+ 87 (+ 88 (+ 89 (+ 90 (+ 91 (+ 92 (+ 93 (+ 94 (+ 95 (+ 96 (+ 97 (+ 98 (+ 99))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+ (num-test (add3) 4950)
-(num-test (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 (+ 10 (+ 11 (+ 12 (+ 13 (+ 14 (+ 15 (+ 16 (+ 17 (+ 18 (+ 19 (+ 20 (+ 21 (+ 22 (+ 23 (+ 24 (+ 25 (+ 26 (+ 27 (+ 28 (+ 29 (+ 30 (+ 31 (+ 32 (+ 33 (+ 34 (+ 35 (+ 36 (+ 37 (+ 38 (+ 39 (+ 40 (+ 41 (+ 42 (+ 43 (+ 44 (+ 45 (+ 46 (+ 47 (+ 48 (+ 49 (+ 50 (+ 51 (+ 52 (+ 53 (+ 54 (+ 55 (+ 56 (+ 57 (+ 58 (+ 59 (+ 60 (+ 61 (+ 62 (+ 63 (+ 64 (+ 65 (+ 66 (+ 67 (+ 68 (+ 69 (+ 70 (+ 71 (+ 72 (+ 73 (+ 74 (+ 75 (+ 76 (+ 77 (+ 78 (+ 79 (+ 80 (+ 81 (+ 82 (+ 83 (+ 84 (+ 85 (+ 86 (+ 87 (+ 88 (+ 89 (+ 90 (+ 91 (+ 92 (+ 93 (+ 94 (+ 95 (+ 96 (+ 97 (+ 98 (+ 99 (+ 100 (+ 101 (+ 102 (+ 103 (+ 104 (+ 105 (+ 106 (+ 107 (+ 108 (+ 109 (+ 110 (+ 111 (+ 112 (+ 113 (+ 114 (+ 115 (+ 116 (+ 117 (+ 118 (+ 119 (+ 120 (+ 121 (+ 122 (+ 123 (+ 124 (+ 125 (+ 126 (+ 127 (+ 128 (+ 129 (+ 130 (+ 131 (+ 132 (+ 133 (+ 134 (+ 135 (+ 136 (+ 137 (+ 138 (+ 139 (+ 140 (+ 141 (+ 142 (+ 143 (+ 144 (+ 145 (+ 146 (+ 147 (+ 148 (+ 149 (+ 150 (+ 151 (+ 152 (+ 153 (+ 154 (+ 155 (+ 156 (+ 157 (+ 158 (+ 159 (+ 160 (+ 161 (+ 162 (+ 163 (+ 164 (+ 165 (+ 166 (+ 167 (+ 168 (+ 169 (+ 170 (+ 171 (+ 172 (+ 173 (+ 174 (+ 175 (+ 176 (+ 177 (+ 178 (+ 179 (+ 180 (+ 181 (+ 182 (+ 183 (+ 184 (+ 185 (+ 186 (+ 187 (+ 188 (+ 189 (+ 190 (+ 191 (+ 192 (+ 193 (+ 194 (+ 195 (+ 196 (+ 197 (+ 198 (+ 199 (+ 200 (+ 201 (+ 202 (+ 203 (+ 204 (+ 205 (+ 206 (+ 207 (+ 208 (+ 209 (+ 210 (+ 211 (+ 212 (+ 213 (+ 214 (+ 215 (+ 216 (+ 217 (+ 218 (+ 219 (+ 220 (+ 221 (+ 222 (+ 223 (+ 224 (+ 225 (+ 226 (+ 227 (+ 228 (+ 229 (+ 230 (+ 231 (+ 232 (+ 233 (+ 234 (+ 235 (+ 236 (+ 237 (+ 238 (+ 239 (+ 240 (+ 241 (+ 242 (+ 243 (+ 244 (+ 245 (+ 246 (+ 247 (+ 248 (+ 249 (+ 250 (+ 251 (+ 252 (+ 253 (+ 254 (+ 255 (+ 256 (+ 257 (+ 258 (+ 259 (+ 260 (+ 261 (+ 262 (+ 263 (+ 264 (+ 265 (+ 266 (+ 267 (+ 268 (+ 269 (+ 270 (+ 271 (+ 272 (+ 273 (+ 274 (+ 275 (+ 276 (+ 277 (+ 278 (+ 279 (+ 280 (+ 281 (+ 282 (+ 283 (+ 284 (+ 285 (+ 286 (+ 287 (+ 288 (+ 289 (+ 290 (+ 291 (+ 292 (+ 293 (+ 294 (+ 295 (+ 296 (+ 297 (+ 298 (+ 299 (+ 300 (+ 301 (+ 302 (+ 303 (+ 304 (+ 305 (+ 306 (+ 307 (+ 308 (+ 309 (+ 310 (+ 311 (+ 312 (+ 313 (+ 314 (+ 315 (+ 316 (+ 317 (+ 318 (+ 319 (+ 320 (+ 321 (+ 322 (+ 323 (+ 324 (+ 325 (+ 326 (+ 327 (+ 328 (+ 329 (+ 330 (+ 331 (+ 332 (+ 333 (+ 334 (+ 335 (+ 336 (+ 337 (+ 338 (+ 339 (+ 340 (+ 341 (+ 342 (+ 343 (+ 344 (+ 345 (+ 346 (+ 347 (+ 348 (+ 349 (+ 350 (+ 351 (+ 352 (+ 353 (+ 354 (+ 355 (+ 356 (+ 357 (+ 358 (+ 359 (+ 360 (+ 361 (+ 362 (+ 363 (+ 364 (+ 365 (+ 366 (+ 367 (+ 368 (+ 369 (+ 370 (+ 371 (+ 372 (+ 373 (+ 374 (+ 375 (+ 376 (+ 377 (+ 378 (+ 379 (+ 380 (+ 381 (+ 382 (+ 383 (+ 384 (+ 385 (+ 386 (+ 387 (+ 388 (+ 389 (+ 390 (+ 391 (+ 392 (+ 393 (+ 394 (+ 395 (+ 396 (+ 397 (+ 398 (+ 399 (+ 400 (+ 401 (+ 402 (+ 403 (+ 404 (+ 405 (+ 406 (+ 407 (+ 408 (+ 409 (+ 410 (+ 411 (+ 412 (+ 413 (+ 414 (+ 415 (+ 416 (+ 417 (+ 418 (+ 419 (+ 420 (+ 421 (+ 422 (+ 423 (+ 424 (+ 425 (+ 426 (+ 427 (+ 428 (+ 429 (+ 430 (+ 431 (+ 432 (+ 433 (+ 434 (+ 435 (+ 436 (+ 437 (+ 438 (+ 439 (+ 440 (+ 441 (+ 442 (+ 443 (+ 444 (+ 445 (+ 446 (+ 447 (+ 448 (+ 449 (+ 450 (+ 451 (+ 452 (+ 453 (+ 454 (+ 455 (+ 456 (+ 457 (+ 458 (+ 459 (+ 460 (+ 461 (+ 462 (+ 463 (+ 464 (+ 465 (+ 466 (+ 467 (+ 468 (+ 469 (+ 470 (+ 471 (+ 472 (+ 473 (+ 474 (+ 475 (+ 476 (+ 477 (+ 478 (+ 479 (+ 480 (+ 481 (+ 482 (+ 483 (+ 484 (+ 485 (+ 486 (+ 487 (+ 488 (+ 489 (+ 490 (+ 491 (+ 492 (+ 493 (+ 494 (+ 495 (+ 496 (+ 497 (+ 498 (+ 499 (+ 500 (+ 501 (+ 502 (+ 503 (+ 504 (+ 505 (+ 506 (+ 507 (+ 508 (+ 509 (+ 510 (+ 511 (+ 512 (+ 513 (+ 514 (+ 515 (+ 516 (+ 517 (+ 518 (+ 519 (+ 520 (+ 521 (+ 522 (+ 523 (+ 524 (+ 525 (+ 526 (+ 527 (+ 528 (+ 529 (+ 530 (+ 531 (+ 532 (+ 533 (+ 534 (+ 535 (+ 536 (+ 537 (+ 538 (+ 539 (+ 540 (+ 541 (+ 542 (+ 543 (+ 544 (+ 545 (+ 546 (+ 547 (+ 548 (+ 549 (+ 550 (+ 551 (+ 552 (+ 553 (+ 554 (+ 555 (+ 556 (+ 557 (+ 558 (+ 559 (+ 560 (+ 561 (+ 562 (+ 563 (+ 564 (+ 565 (+ 566 (+ 567 (+ 568 (+ 569 (+ 570 (+ 571 (+ 572 (+ 573 (+ 574 (+ 575 (+ 576 (+ 577 (+ 578 (+ 579 (+ 580 (+ 581 (+ 582 (+ 583 (+ 584 (+ 585 (+ 586 (+ 587 (+ 588 (+ 589 (+ 590 (+ 591 (+ 592 (+ 593 (+ 594 (+ 595 (+ 596 (+ 597 (+ 598 (+ 599 (+ 600 (+ 601 (+ 602 (+ 603 (+ 604 (+ 605 (+ 606 (+ 607 (+ 608 (+ 609 (+ 610 (+ 611 (+ 612 (+ 613 (+ 614 (+ 615 (+ 616 (+ 617 (+ 618 (+ 619 (+ 620 (+ 621 (+ 622 (+ 623 (+ 624 (+ 625 (+ 626 (+ 627 (+ 628 (+ 629 (+ 630 (+ 631 (+ 632 (+ 633 (+ 634 (+ 635 (+ 636 (+ 637 (+ 638 (+ 639 (+ 640 (+ 641 (+ 642 (+ 643 (+ 644 (+ 645 (+ 646 (+ 647 (+ 648 (+ 649 (+ 650 (+ 651 (+ 652 (+ 653 (+ 654 (+ 655 (+ 656 (+ 657 (+ 658 (+ 659 (+ 660 (+ 661 (+ 662 (+ 663 (+ 664 (+ 665 (+ 666 (+ 667 (+ 668 (+ 669 (+ 670 (+ 671 (+ 672 (+ 673 (+ 674 (+ 675 (+ 676 (+ 677 (+ 678 (+ 679 (+ 680 (+ 681 (+ 682 (+ 683 (+ 684 (+ 685 (+ 686 (+ 687 (+ 688 (+ 689 (+ 690 (+ 691 (+ 692 (+ 693 (+ 694 (+ 695 (+ 696 (+ 697 (+ 698 (+ 699 (+ 700 (+ 701 (+ 702 (+ 703 (+ 704 (+ 705 (+ 706 (+ 707 (+ 708 (+ 709 (+ 710 (+ 711 (+ 712 (+ 713 (+ 714 (+ 715 (+ 716 (+ 717 (+ 718 (+ 719 (+ 720 (+ 721 (+ 722 (+ 723 (+ 724 (+ 725 (+ 726 (+ 727 (+ 728 (+ 729 (+ 730 (+ 731 (+ 732 (+ 733 (+ 734 (+ 735 (+ 736 (+ 737 (+ 738 (+ 739 (+ 740 (+ 741 (+ 742 (+ 743 (+ 744 (+ 745 (+ 746 (+ 747 (+ 748 (+ 749 (+ 750 (+ 751 (+ 752 (+ 753 (+ 754 (+ 755 (+ 756 (+ 757 (+ 758 (+ 759 (+ 760 (+ 761 (+ 762 (+ 763 (+ 764 (+ 765 (+ 766 (+ 767 (+ 768 (+ 769 (+ 770 (+ 771 (+ 772 (+ 773 (+ 774 (+ 775 (+ 776 (+ 777 (+ 778 (+ 779 (+ 780 (+ 781 (+ 782 (+ 783 (+ 784 (+ 785 (+ 786 (+ 787 (+ 788 (+ 789 (+ 790 (+ 791 (+ 792 (+ 793 (+ 794 (+ 795 (+ 796 (+ 797 (+ 798 (+ 799 (+ 800 (+ 801 (+ 802 (+ 803 (+ 804 (+ 805 (+ 806 (+ 807 (+ 808 (+ 809 (+ 810 (+ 811 (+ 812 (+ 813 (+ 814 (+ 815 (+ 816 (+ 817 (+ 818 (+ 819 (+ 820 (+ 821 (+ 822 (+ 823 (+ 824 (+ 825 (+ 826 (+ 827 (+ 828 (+ 829 (+ 830 (+ 831 (+ 832 (+ 833 (+ 834 (+ 835 (+ 836 (+ 837 (+ 838 (+ 839 (+ 840 (+ 841 (+ 842 (+ 843 (+ 844 (+ 845 (+ 846 (+ 847 (+ 848 (+ 849 (+ 850 (+ 851 (+ 852 (+ 853 (+ 854 (+ 855 (+ 856 (+ 857 (+ 858 (+ 859 (+ 860 (+ 861 (+ 862 (+ 863 (+ 864 (+ 865 (+ 866 (+ 867 (+ 868 (+ 869 (+ 870 (+ 871 (+ 872 (+ 873 (+ 874 (+ 875 (+ 876 (+ 877 (+ 878 (+ 879 (+ 880 (+ 881 (+ 882 (+ 883 (+ 884 (+ 885 (+ 886 (+ 887 (+ 888 (+ 889 (+ 890 (+ 891 (+ 892 (+ 893 (+ 894 (+ 895 (+ 896 (+ 897 (+ 898 (+ 899 (+ 900 (+ 901 (+ 902 (+ 903 (+ 904 (+ 905 (+ 906 (+ 907 (+ 908 (+ 909 (+ 910 (+ 911 (+ 912 (+ 913 (+ 914 (+ 915 (+ 916 (+ 917 (+ 918 (+ 919 (+ 920 (+ 921 (+ 922 (+ 923 (+ 924 (+ 925 (+ 926 (+ 927 (+ 928 (+ 929 (+ 930 (+ 931 (+ 932 (+ 933 (+ 934 (+ 935 (+ 936 (+ 937 (+ 938 (+ 939 (+ 940 (+ 941 (+ 942 (+ 943 (+ 944 (+ 945 (+ 946 (+ 947 (+ 948 (+ 949 (+ 950 (+ 951 (+ 952 (+ 953 (+ 954 (+ 955 (+ 956 (+ 957 (+ 958 (+ 959 (+ 960 (+ 961 (+ 962 (+ 963 (+ 964 (+ 965 (+ 966 (+ 967 (+ 968 (+ 969 (+ 970 (+ 971 (+ 972 (+ 973 (+ 974 (+ 975 (+ 976 (+ 977 (+ 978 (+ 979 (+ 980 (+ 981 (+ 982 (+ 983 (+ 984 (+ 985 (+ 986 (+ 987 (+ 988 (+ 989 (+ 990 (+ 991 (+ 992 (+ 993 (+ 994 (+ 995 (+ 996 (+ 997 (+ 998 (+ 999))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 499500)
+ (define (add4)
+ (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 (+ 10 (+ 11 (+ 12 (+ 13 (+ 14 (+ 15 (+ 16 (+ 17 (+ 18 (+ 19 (+ 20 (+ 21 (+ 22 (+ 23 (+ 24 (+ 25 (+ 26 (+ 27 (+ 28 (+ 29 (+ 30 (+ 31 (+ 32 (+ 33 (+ 34 (+ 35 (+ 36 (+ 37 (+ 38 (+ 39 (+ 40 (+ 41 (+ 42 (+ 43 (+ 44 (+ 45 (+ 46 (+ 47 (+ 48 (+ 49 (+ 50 (+ 51 (+ 52 (+ 53 (+ 54 (+ 55 (+ 56 (+ 57 (+ 58 (+ 59 (+ 60 (+ 61 (+ 62 (+ 63 (+ 64 (+ 65 (+ 66 (+ 67 (+ 68 (+ 69 (+ 70 (+ 71 (+ 72 (+ 73 (+ 74 (+ 75 (+ 76 (+ 77 (+ 78 (+ 79 (+ 80 (+ 81 (+ 82 (+ 83 (+ 84 (+ 85 (+ 86 (+ 87 (+ 88 (+ 89 (+ 90 (+ 91 (+ 92 (+ 93 (+ 94 (+ 95 (+ 96 (+ 97 (+ 98 (+ 99 (+ 100 (+ 101 (+ 102 (+ 103 (+ 104 (+ 105 (+ 106 (+ 107 (+ 108 (+ 109 (+ 110 (+ 111 (+ 112 (+ 113 (+ 114 (+ 115 (+ 116 (+ 117 (+ 118 (+ 119 (+ 120 (+ 121 (+ 122 (+ 123 (+ 124 (+ 125 (+ 126 (+ 127 (+ 128 (+ 129 (+ 130 (+ 131 (+ 132 (+ 133 (+ 134 (+ 135 (+ 136 (+ 137 (+ 138 (+ 139 (+ 140 (+ 141 (+ 142 (+ 143 (+ 144 (+ 145 (+ 146 (+ 147 (+ 148 (+ 149 (+ 150 (+ 151 (+ 152 (+ 153 (+ 154 (+ 155 (+ 156 (+ 157 (+ 158 (+ 159 (+ 160 (+ 161 (+ 162 (+ 163 (+ 164 (+ 165 (+ 166 (+ 167 (+ 168 (+ 169 (+ 170 (+ 171 (+ 172 (+ 173 (+ 174 (+ 175 (+ 176 (+ 177 (+ 178 (+ 179 (+ 180 (+ 181 (+ 182 (+ 183 (+ 184 (+ 185 (+ 186 (+ 187 (+ 188 (+ 189 (+ 190 (+ 191 (+ 192 (+ 193 (+ 194 (+ 195 (+ 196 (+ 197 (+ 198 (+ 199 (+ 200 (+ 201 (+ 202 (+ 203 (+ 204 (+ 205 (+ 206 (+ 207 (+ 208 (+ 209 (+ 210 (+ 211 (+ 212 (+ 213 (+ 214 (+ 215 (+ 216 (+ 217 (+ 218 (+ 219 (+ 220 (+ 221 (+ 222 (+ 223 (+ 224 (+ 225 (+ 226 (+ 227 (+ 228 (+ 229 (+ 230 (+ 231 (+ 232 (+ 233 (+ 234 (+ 235 (+ 236 (+ 237 (+ 238 (+ 239 (+ 240 (+ 241 (+ 242 (+ 243 (+ 244 (+ 245 (+ 246 (+ 247 (+ 248 (+ 249 (+ 250 (+ 251 (+ 252 (+ 253 (+ 254 (+ 255 (+ 256 (+ 257 (+ 258 (+ 259 (+ 260 (+ 261 (+ 262 (+ 263 (+ 264 (+ 265 (+ 266 (+ 267 (+ 268 (+ 269 (+ 270 (+ 271 (+ 272 (+ 273 (+ 274 (+ 275 (+ 276 (+ 277 (+ 278 (+ 279 (+ 280 (+ 281 (+ 282 (+ 283 (+ 284 (+ 285 (+ 286 (+ 287 (+ 288 (+ 289 (+ 290 (+ 291 (+ 292 (+ 293 (+ 294 (+ 295 (+ 296 (+ 297 (+ 298 (+ 299 (+ 300 (+ 301 (+ 302 (+ 303 (+ 304 (+ 305 (+ 306 (+ 307 (+ 308 (+ 309 (+ 310 (+ 311 (+ 312 (+ 313 (+ 314 (+ 315 (+ 316 (+ 317 (+ 318 (+ 319 (+ 320 (+ 321 (+ 322 (+ 323 (+ 324 (+ 325 (+ 326 (+ 327 (+ 328 (+ 329 (+ 330 (+ 331 (+ 332 (+ 333 (+ 334 (+ 335 (+ 336 (+ 337 (+ 338 (+ 339 (+ 340 (+ 341 (+ 342 (+ 343 (+ 344 (+ 345 (+ 346 (+ 347 (+ 348 (+ 349 (+ 350 (+ 351 (+ 352 (+ 353 (+ 354 (+ 355 (+ 356 (+ 357 (+ 358 (+ 359 (+ 360 (+ 361 (+ 362 (+ 363 (+ 364 (+ 365 (+ 366 (+ 367 (+ 368 (+ 369 (+ 370 (+ 371 (+ 372 (+ 373 (+ 374 (+ 375 (+ 376 (+ 377 (+ 378 (+ 379 (+ 380 (+ 381 (+ 382 (+ 383 (+ 384 (+ 385 (+ 386 (+ 387 (+ 388 (+ 389 (+ 390 (+ 391 (+ 392 (+ 393 (+ 394 (+ 395 (+ 396 (+ 397 (+ 398 (+ 399 (+ 400 (+ 401 (+ 402 (+ 403 (+ 404 (+ 405 (+ 406 (+ 407 (+ 408 (+ 409 (+ 410 (+ 411 (+ 412 (+ 413 (+ 414 (+ 415 (+ 416 (+ 417 (+ 418 (+ 419 (+ 420 (+ 421 (+ 422 (+ 423 (+ 424 (+ 425 (+ 426 (+ 427 (+ 428 (+ 429 (+ 430 (+ 431 (+ 432 (+ 433 (+ 434 (+ 435 (+ 436 (+ 437 (+ 438 (+ 439 (+ 440 (+ 441 (+ 442 (+ 443 (+ 444 (+ 445 (+ 446 (+ 447 (+ 448 (+ 449 (+ 450 (+ 451 (+ 452 (+ 453 (+ 454 (+ 455 (+ 456 (+ 457 (+ 458 (+ 459 (+ 460 (+ 461 (+ 462 (+ 463 (+ 464 (+ 465 (+ 466 (+ 467 (+ 468 (+ 469 (+ 470 (+ 471 (+ 472 (+ 473 (+ 474 (+ 475 (+ 476 (+ 477 (+ 478 (+ 479 (+ 480 (+ 481 (+ 482 (+ 483 (+ 484 (+ 485 (+ 486 (+ 487 (+ 488 (+ 489 (+ 490 (+ 491 (+ 492 (+ 493 (+ 494 (+ 495 (+ 496 (+ 497 (+ 498 (+ 499 (+ 500 (+ 501 (+ 502 (+ 503 (+ 504 (+ 505 (+ 506 (+ 507 (+ 508 (+ 509 (+ 510 (+ 511 (+ 512 (+ 513 (+ 514 (+ 515 (+ 516 (+ 517 (+ 518 (+ 519 (+ 520 (+ 521 (+ 522 (+ 523 (+ 524 (+ 525 (+ 526 (+ 527 (+ 528 (+ 529 (+ 530 (+ 531 (+ 532 (+ 533 (+ 534 (+ 535 (+ 536 (+ 537 (+ 538 (+ 539 (+ 540 (+ 541 (+ 542 (+ 543 (+ 544 (+ 545 (+ 546 (+ 547 (+ 548 (+ 549 (+ 550 (+ 551 (+ 552 (+ 553 (+ 554 (+ 555 (+ 556 (+ 557 (+ 558 (+ 559 (+ 560 (+ 561 (+ 562 (+ 563 (+ 564 (+ 565 (+ 566 (+ 567 (+ 568 (+ 569 (+ 570 (+ 571 (+ 572 (+ 573 (+ 574 (+ 575 (+ 576 (+ 577 (+ 578 (+ 579 (+ 580 (+ 581 (+ 582 (+ 583 (+ 584 (+ 585 (+ 586 (+ 587 (+ 588 (+ 589 (+ 590 (+ 591 (+ 592 (+ 593 (+ 594 (+ 595 (+ 596 (+ 597 (+ 598 (+ 599 (+ 600 (+ 601 (+ 602 (+ 603 (+ 604 (+ 605 (+ 606 (+ 607 (+ 608 (+ 609 (+ 610 (+ 611 (+ 612 (+ 613 (+ 614 (+ 615 (+ 616 (+ 617 (+ 618 (+ 619 (+ 620 (+ 621 (+ 622 (+ 623 (+ 624 (+ 625 (+ 626 (+ 627 (+ 628 (+ 629 (+ 630 (+ 631 (+ 632 (+ 633 (+ 634 (+ 635 (+ 636 (+ 637 (+ 638 (+ 639 (+ 640 (+ 641 (+ 642 (+ 643 (+ 644 (+ 645 (+ 646 (+ 647 (+ 648 (+ 649 (+ 650 (+ 651 (+ 652 (+ 653 (+ 654 (+ 655 (+ 656 (+ 657 (+ 658 (+ 659 (+ 660 (+ 661 (+ 662 (+ 663 (+ 664 (+ 665 (+ 666 (+ 667 (+ 668 (+ 669 (+ 670 (+ 671 (+ 672 (+ 673 (+ 674 (+ 675 (+ 676 (+ 677 (+ 678 (+ 679 (+ 680 (+ 681 (+ 682 (+ 683 (+ 684 (+ 685 (+ 686 (+ 687 (+ 688 (+ 689 (+ 690 (+ 691 (+ 692 (+ 693 (+ 694 (+ 695 (+ 696 (+ 697 (+ 698 (+ 699 (+ 700 (+ 701 (+ 702 (+ 703 (+ 704 (+ 705 (+ 706 (+ 707 (+ 708 (+ 709 (+ 710 (+ 711 (+ 712 (+ 713 (+ 714 (+ 715 (+ 716 (+ 717 (+ 718 (+ 719 (+ 720 (+ 721 (+ 722 (+ 723 (+ 724 (+ 725 (+ 726 (+ 727 (+ 728 (+ 729 (+ 730 (+ 731 (+ 732 (+ 733 (+ 734 (+ 735 (+ 736 (+ 737 (+ 738 (+ 739 (+ 740 (+ 741 (+ 742 (+ 743 (+ 744 (+ 745 (+ 746 (+ 747 (+ 748 (+ 749 (+ 750 (+ 751 (+ 752 (+ 753 (+ 754 (+ 755 (+ 756 (+ 757 (+ 758 (+ 759 (+ 760 (+ 761 (+ 762 (+ 763 (+ 764 (+ 765 (+ 766 (+ 767 (+ 768 (+ 769 (+ 770 (+ 771 (+ 772 (+ 773 (+ 774 (+ 775 (+ 776 (+ 777 (+ 778 (+ 779 (+ 780 (+ 781 (+ 782 (+ 783 (+ 784 (+ 785 (+ 786 (+ 787 (+ 788 (+ 789 (+ 790 (+ 791 (+ 792 (+ 793 (+ 794 (+ 795 (+ 796 (+ 797 (+ 798 (+ 799 (+ 800 (+ 801 (+ 802 (+ 803 (+ 804 (+ 805 (+ 806 (+ 807 (+ 808 (+ 809 (+ 810 (+ 811 (+ 812 (+ 813 (+ 814 (+ 815 (+ 816 (+ 817 (+ 818 (+ 819 (+ 820 (+ 821 (+ 822 (+ 823 (+ 824 (+ 825 (+ 826 (+ 827 (+ 828 (+ 829 (+ 830 (+ 831 (+ 832 (+ 833 (+ 834 (+ 835 (+ 836 (+ 837 (+ 838 (+ 839 (+ 840 (+ 841 (+ 842 (+ 843 (+ 844 (+ 845 (+ 846 (+ 847 (+ 848 (+ 849 (+ 850 (+ 851 (+ 852 (+ 853 (+ 854 (+ 855 (+ 856 (+ 857 (+ 858 (+ 859 (+ 860 (+ 861 (+ 862 (+ 863 (+ 864 (+ 865 (+ 866 (+ 867 (+ 868 (+ 869 (+ 870 (+ 871 (+ 872 (+ 873 (+ 874 (+ 875 (+ 876 (+ 877 (+ 878 (+ 879 (+ 880 (+ 881 (+ 882 (+ 883 (+ 884 (+ 885 (+ 886 (+ 887 (+ 888 (+ 889 (+ 890 (+ 891 (+ 892 (+ 893 (+ 894 (+ 895 (+ 896 (+ 897 (+ 898 (+ 899 (+ 900 (+ 901 (+ 902 (+ 903 (+ 904 (+ 905 (+ 906 (+ 907 (+ 908 (+ 909 (+ 910 (+ 911 (+ 912 (+ 913 (+ 914 (+ 915 (+ 916 (+ 917 (+ 918 (+ 919 (+ 920 (+ 921 (+ 922 (+ 923 (+ 924 (+ 925 (+ 926 (+ 927 (+ 928 (+ 929 (+ 930 (+ 931 (+ 932 (+ 933 (+ 934 (+ 935 (+ 936 (+ 937 (+ 938 (+ 939 (+ 940 (+ 941 (+ 942 (+ 943 (+ 944 (+ 945 (+ 946 (+ 947 (+ 948 (+ 949 (+ 950 (+ 951 (+ 952 (+ 953 (+ 954 (+ 955 (+ 956 (+ 957 (+ 958 (+ 959 (+ 960 (+ 961 (+ 962 (+ 963 (+ 964 (+ 965 (+ 966 (+ 967 (+ 968 (+ 969 (+ 970 (+ 971 (+ 972 (+ 973 (+ 974 (+ 975 (+ 976 (+ 977 (+ 978 (+ 979 (+ 980 (+ 981 (+ 982 (+ 983 (+ 984 (+ 985 (+ 986 (+ 987 (+ 988 (+ 989 (+ 990 (+ 991 (+ 992 (+ 993 (+ 994 (+ 995 (+ 996 (+ 997 (+ 998 (+ 999))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+ (num-test (add4) 499500))
(let ()
(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1)))))
@@ -57017,6 +73118,31 @@ but it's the printout that is at fault:
(test (+ 1 2 . 3) 'error)
(test (+ 1 . 2) 'error)
+;;; an optimizer test
+(let ()
+ (define (hi a b c)
+ (+ (+ 1 (* 2 b))
+ (+ a (* b c))
+ (+ (* a b) c)
+ (+ (* a 3) 4)))
+ (num-test (hi 5 6 7) 116))
+
+(for-each
+ (lambda (arg)
+ (test (+ arg nan.0) 'error)
+ (test (+ nan.0 arg) 'error)
+ (test (+ arg inf.0) 'error)
+ (test (+ inf.0 arg) 'error)
+ (test (+ arg) 'error)
+ (test (+ 0 arg) 'error)
+ (test (+ 0.0 arg) 'error)
+ (test (+ 1 arg) 'error)
+ (test (+ 1/2 arg) 'error)
+ (test (+ 1.0 arg) 'error)
+ (test (+ 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
;;; --------------------------------------------------------------------------------
@@ -57805,11 +73931,29 @@ but it's the printout that is at fault:
(num-test (- 3 4) -1 )
(num-test (- 3) -3 )
+(call-with-exit
+ (lambda (ok)
+ (for-each-permutation
+ (lambda args
+ (when (not (morally-equal? (apply - args) (- (car args) (apply + (cdr args)))))
+ (format-logged #t "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args))))
+ (ok)))
+ '(1 1/2 0.5 1+i))))
+
+(call-with-exit
+ (lambda (ok)
+ (for-each-permutation
+ (lambda args
+ (when (not (morally-equal? (apply - args) (+ (car args) (- (apply + (cdr args))))))
+ (format-logged #t "~A: (- ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply - args))
+ (ok)))
+ '(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i))))
+
(num-test (- -1.797693134862315699999999999999999999998E308 -9223372036854775808) -1.797693134862315699999999999999999999998E308)
(num-test (- -9223372036854775808 -9223372036854775808) 0)
(num-test (- -9223372036854775808 5.551115123125783999999999999999999999984E-17) -9.223372036854775808000000000000000055511E18)
(num-test (- -9223372036854775808 9223372036854775807 -9223372036854775808) -9223372036854775807)
-(num-test (- -9223372036854775808) 9223372036854775808)
+(if with-bignums (num-test (- -9223372036854775808) 9223372036854775808))
(num-test (- 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 9.223372036854775808000000000000000111022E18)
(num-test (- 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 5.545694112263356477829399999999999999977E-17)
(num-test (- 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) -5.551115123125783999999999999999999999984E-17)
@@ -57820,6 +73964,14 @@ but it's the printout that is at fault:
(num-test (- 1/98947 2/97499 3/76847) -36656755224/741360956847391)
(num-test (- 500009/500029 500057/500041) -18001284/250035001189)
+(if (not with-bignums)
+ (begin
+ (num-test (- 8 -1/9223372036854775807 1/9223372036854775807) 8.0)
+; (num-test (- most-positive-fixnum most-negative-fixnum) 1.8446744073709551615E19)
+; (num-test (- most-negative-fixnum most-positive-fixnum) -1.8446744073709551615E19)
+;;; currently s7's optimizer screws up these cases
+ ))
+
(num-test (- -0.011326914400453525E0 -0.6668141757661364E0) 6.554872613656828749999999999999999999976E-1)
(num-test (- -0.46185382764946437E0 0.7488210697846337E0) -1.210674897434098070000000000000000000001E0)
(num-test (- -0.35834120541234993E0 -0.30919976341834987E0) -4.914144199400005999999999999999999999972E-2)
@@ -57992,7 +74144,7 @@ but it's the printout that is at fault:
(num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) -52761146275983172771170709/183561983334767209753061626751)
(num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981) -543899925850203550003/2756144552405627689570151)
(num-test (- 1e40+1e30i 1e40-1e30i) 0+2e30i)
- (num-test (- 2 12345678901234567890+12345678901234567890i) -12345678901234567890-12345678901234567890i)
+ (num-test (- 2 12345678901234567890+12345678901234567890i) -12345678901234567888-12345678901234567890i)
(num-test (- 500009/500029 500057/500041 500083/500069) -125047255383687283/125034753009582041)
(num-test (- 9223372036854775807 -9223372036854775808) 18446744073709551615)
(num-test (- 98947 2/97499 76847 4/61981 5/59981) 8010593845541429507/362470312515139)
@@ -58256,6 +74408,19 @@ but it's the printout that is at fault:
(test (- 1 2 . 3) 'error)
(test (- 1 . 2) 'error)
+(for-each
+ (lambda (arg)
+ (test (- arg nan.0) 'error)
+ (test (- nan.0 arg) 'error)
+ (test (- arg inf.0) 'error)
+ (test (- inf.0 arg) 'error)
+ (test (- arg) 'error)
+ (test (- 1 arg) 'error)
+ (test (- 1/2 arg) 'error)
+ (test (- 1.0 arg) 'error)
+ (test (- 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
@@ -58829,6 +74994,23 @@ but it's the printout that is at fault:
(num-test (/ 2/2) 2/2)
(num-test (/ 362880) 1/362880)
(num-test (/ 362880/1234) 1234/362880)
+(num-test (/ 1/2 1+i 1-i) 0.25)
+
+(num-test (/ 2/9223372036854775807 2) 1/9223372036854775807)
+(num-test (/ -63/288230376151711744 -63) 1/288230376151711744)
+
+(if (not with-bignums)
+ (begin
+ (num-test (/ 1/2305843009213693952 -1 4194304/2097151) -2.168403310995243176730312012479018335398E-19)
+ (num-test (/ 1/2199023255552 -63 8388608/4194303) -3.609105098938467225452985162735872325445E-15)
+ (num-test (/ 1/17179869184 -1 1073741824/536870911) -2.91038304025235949890060282996273599565E-11)
+ ))
+
+(for-each-permutation
+ (lambda args
+ (if (not (= (apply / args) (/ (car args) (apply * (cdr args)))))
+ (format-logged #t "~A: ~A != ~A?~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))))))
+ '(1 1/2 0.5 1+i))
(num-test (/ -9223372036854775808 5.551115123125783999999999999999999999984E-17) -1.661534994731144452653560599947843044136E35)
(num-test (/ 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -1.203706215242022689593248685469006886702E-35)
@@ -58862,8 +75044,15 @@ but it's the printout that is at fault:
(num-test (/ most-negative-fixnum most-negative-fixnum 2) 1/2)
(num-test (/ most-negative-fixnum most-negative-fixnum) 1)
(num-test (/ (/ (- most-positive-fixnum))) -9223372036854775807)
+(num-test (/ most-negative-fixnum 864691128455135232) -32/3)
(num-test (/(*(/(*)))) 1)
(num-test (/ 12341234/111 123456789 12341234/111) 1/123456789)
+(num-test (/ 1e63 1e-63) 1e126)
+(num-test (/ 1e154 1e-154) 1e308) ; else inf
+(num-test (/ 1e-200 1e200) 0.0)
+;;; inaccuracies creep in (/ 1e-200 1e123) => 9.8813129168249e-324
+;;; or (/ 10e307 1e309) => 0.0 and (/ 10e308 1e308) => inf
+;;; might be neat to handle these (if exps= just divide mant?
(num-test (/ -0.651381628953465E0 -0.9237050214744277E0) 7.051835962889135018948026610294923703508E-1)
(num-test (/ 0.5067986732438687E0 0.6260017267692811E0) 8.095803119575965307784422745290898299591E-1)
@@ -59016,6 +75205,12 @@ but it's the printout that is at fault:
(num-test (/ -4.276770609150315E-21 6.853299965034864E-21) -6.240454424832049912604789277138688124888E-1)
(num-test (/ -8.847946637724495E-21 6.33827952828724E-21) -1.395953996386055439061738621964402924048E0)
+(when with-bignums ; from futilitycloset I think
+ (let ((oldp (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 2048)
+ (test (object->string (/ 1.0 999999999999999999999998999999999999999999999999)) "1.00000000000000000000000100000000000000000000000200000000000000000000000300000000000000000000000500000000000000000000000800000000000000000000001300000000000000000000002100000000000000000000003400000000000000000000005500000000000000000000008900000000000000000000014400000000000000000000023300000000000000000000037700000000000000000000061000000000000000000000098700000000000000000000159700000000000000000000258400000000000000000000418100000000000000000000676500000000000000000001094600000000000000000001771100000000000000000002865700000000000000000004636800000000000000000007502500000000000000000012139300000000000000001E-48")
+ (set! (*s7* 'bignum-precision) oldp)))
+
(for-each
(lambda (num-and-val)
(let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 '/ num (/ num) val)))
@@ -59058,6 +75253,7 @@ but it's the printout that is at fault:
(if with-bignums
(begin
+ (num-test (/ 1/9223372036854775807 1+1i 1-1i) 5.421010862427522170625011179760852311177E-20)
(num-test (/ (/ 1 most-positive-fixnum) most-negative-fixnum) -1/85070591730234615856620279821087277056)
(num-test (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) (/ 1.0e307+1.0e307i 2.0e307+2.0e307i))
(num-test (/ (+ 1.2345e-15 1 -1)) 8.1004455245038e+14)
@@ -59318,11 +75514,53 @@ but it's the printout that is at fault:
(test (/ 0/3) 'error)
(test (/ 0 1 "hi") 'error)
(test (/ 2/3 0) 'error)
+(test (/ 0 0) 'error)
+(test (/ 1 0) 'error)
+(test (/ 0 0.0) 'error)
+(test (/ 1 0.0) 'error)
+(test (/ 0.0 0.0) 'error)
+(test (/ 1.0 0.0) 'error)
+(test (/ 0 1 2 3 0 4) 'error)
+(test (/ 0.0 1 2.0 3 0.0 4) 'error)
+(let ((NaN 1/0)) (test (/ 0 1 NaN 2 0 3) 'error)) ; i.e. divide by zero takes precedence over the NaN
+(let ((NaN 1/0)) (test (/ 0.0 1.0 NaN 0 1+i) 'error))
+(test (/ 1/9223372036854775807 0) 'error)
+(test (/ 1/9223372036854775807 0.0) 'error)
+(if with-bignums
+ (begin
+ (test (/ (bignum 1.0) (bignum 0)) 'error)
+ (test (/ (bignum 1.0) (bignum -0.0)) 'error)
+ (test (/ 9223372036854775807123123123 0) 'error)))
+
+(for-each
+ (lambda (arg)
+ (test (/ arg nan.0) 'error)
+ (test (/ nan.0 arg) 'error)
+ (test (/ arg inf.0) 'error)
+ (test (/ inf.0 arg) 'error)
+ (test (/ 0 arg nan.0) 'error)
+ (test (/ nan.0 0 arg) 'error)
+ (test (/ arg inf.0 0) 'error)
+ (test (/ 0 inf.0 arg) 'error)
+ (test (/ 0 arg) 'error)
+ (test (/ 0.0 arg) 'error)
+ (test (/ 1/2 arg) 'error)
+ (test (/ 1+i arg) 'error))
+ (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+
+(for-each
+ (lambda (arg)
+ (test (/ arg) 'error))
+ (list "hi" () (integer->char 65) 0 0.0 0+0i -0.0 -0 0-0i #f #t '(1 2) _ht_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs
+ #<eof> '(1 2 3) #\newline (lambda (a) (+ a 1)) #<unspecified> #<undefined>))
+;;; from guile irc
+(test (boolean? (let ((x (/ 1e-300 1e8))) x)) #f)
(if with-bignums
- (let ((old-prec (bignum-precision)))
- (set! (bignum-precision) 512)
+ (let ((old-prec (*s7* 'bignum-precision)))
+ (set! (*s7* 'bignum-precision) 512)
(let* ((rats (list 2/3
5/8
12/19
@@ -59415,26 +75653,26 @@ but it's the printout that is at fault:
26950438007336492223090258922432360483195364123447/42715433619638540017016192501265627583443206434902
))
(fifth (/ (log 2.0) (log 3.0)))
- (c-fifth (make-rectangular fifth fifth))
+ (c-fifth (complex fifth fifth))
(p-fifth (make-polar (* (sqrt 2.0) fifth) (/ pi 4)))
(last-rat 26950438007336492223090258922432360483195364123447/42715433619638540017016192501265627583443206434902))
(for-each
(lambda (a b)
(if (not (< (abs (- b fifth)) (abs (- a fifth))))
- (format #t ";fifth: ~A is not better than ~A??~%" b a))
- (if (not (< (magnitude (- (make-rectangular b b) c-fifth)) (magnitude (- (make-rectangular a a) c-fifth))))
- (format #t ";rectangular fifth: ~A is not better than ~A??~%" b a))
+ (format-logged #t ";fifth: ~A is not better than ~A??~%" b a))
+ (if (not (< (magnitude (- (complex b b) c-fifth)) (magnitude (- (complex a a) c-fifth))))
+ (format-logged #t ";rectangular fifth: ~A is not better than ~A??~%" b a))
(let ((pa (make-polar (* (sqrt 2.0) a) (/ pi 4)))
(pb (make-polar (* (sqrt 2.0) b) (/ pi 4))))
(if (not (< (magnitude (- pb p-fifth)) (magnitude (- pa p-fifth))))
- (format #t ";polar fifth: ~A is not better than ~A??~%" b a)))
+ (format-logged #t ";polar fifth: ~A is not better than ~A??~%" b a)))
(if (not (< (abs (- b last-rat)) (abs (- a last-rat))))
- (format #t ";- last: ~A is not better than ~A??~%" b a))
+ (format-logged #t ";- last: ~A is not better than ~A??~%" b a))
(if (not (< (magnitude (sqrt (- b last-rat))) (magnitude (sqrt (- a last-rat)))))
- (format #t ";sqrt last: ~A is not better than ~A??~%" b a))
+ (format-logged #t ";sqrt last: ~A is not better than ~A??~%" b a))
)
rats (cdr rats)))
- (set! (bignum-precision) old-prec)))
+ (set! (*s7* 'bignum-precision) old-prec)))
(if with-bignums
(num-test (- 2 (* 3796553736732654909229441/2684568892382786771291329 3796553736732654909229441/2684568892382786771291329)) 1/7206910137949342581102166717750576215502190586241))
@@ -59446,25 +75684,35 @@ but it's the printout that is at fault:
;;; random
;;; --------------------------------------------------------------------------------
-(let ((v (lambda (n range chker) ; chi^2 or mus-random
- (let ((hits (make-vector 100 0)))
- (do ((i 0 (+ 1 i )))
- ((= i n))
- (let ((y (random range)))
- (if (not (chker y))
- (format #t ";(random ~A) -> ~A?~%" range y))
- (let ((iy (min 99 (floor (* 100 (/ y range))))))
- (vector-set! hits iy (+ 1 (vector-ref hits iy))))))
- (let ((sum 0.0)
- (p (/ n 100.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 100) sum)
- (let ((num (- (vector-ref hits i) p)))
- (set! sum (+ sum (/ (* num num) p))))))))))
+(let ()
+ (define (v n range chker) ; chi^2 or mus-random
+ (let ((hits (make-vector 100 0)))
+ (do ((i 0 (+ 1 i )))
+ ((= i n))
+ (let ((y (random range)))
+ (if (not (chker y))
+ (format-logged #t ";(random ~A) -> ~A?~%" range y))
+ (let ((iy (min 99 (floor (* 100 (/ y range))))))
+ (vector-set! hits iy (+ 1 (vector-ref hits iy))))))
+ (let ((sum 0.0)
+ (p (/ n 100.0)))
+ (do ((i 0 (+ 1 i)))
+ ((= i 100) sum)
+ (let ((num (- (vector-ref hits i) p)))
+ (set! sum (+ sum (/ (* num num) p))))))))
(num-test (random 0) 0)
(num-test (random 0.0) 0.0)
+ (let ()
+ (define (rtest) (- (random 2.0) 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((val (rtest)))
+ (if (or (> val 1.0)
+ (< val -1.0))
+ (format-logged #t "(- (random 2.0) 1.0): ~A~%" i val)))))
+
(let ((vr (v 1000
1.0
(lambda (val)
@@ -59473,7 +75721,7 @@ but it's the printout that is at fault:
(<= val 1.0))))))
(if (or (< vr 40)
(> vr 400))
- (format #t ";(random 1.0) not so random? ~A~%" vr)))
+ (format-logged #t ";(random 1.0) not so random? ~A~%" vr)))
(let ((vr (v 1000
100
@@ -59483,7 +75731,7 @@ but it's the printout that is at fault:
(<= val 100))))))
(if (or (< vr 40)
(> vr 400))
- (format #t ";(random 100) not so random? ~A~%" vr)))
+ (format-logged #t ";(random 100) not so random? ~A~%" vr)))
(let ((vr (v 1000
1/2
@@ -59493,7 +75741,7 @@ but it's the printout that is at fault:
(<= val 1/2))))))
(if (or (< vr 40)
(> vr 400))
- (format #t ";(random 1/2) not so random? ~A~%" vr)))
+ (format-logged #t ";(random 1/2) not so random? ~A~%" vr)))
(let ((vr (v 1000
-10.0
@@ -59503,7 +75751,7 @@ but it's the printout that is at fault:
(>= val -10.0))))))
(if (or (< vr 40)
(> vr 400))
- (format #t ";(random -10.0) not so random? ~A~%" vr)))
+ (format-logged #t ";(random -10.0) not so random? ~A~%" vr)))
(let ((imax 0.0)
(rmax 0.0)
@@ -59522,7 +75770,7 @@ but it's the printout that is at fault:
(< rmin 0.0)
(< rmax 0.001)
(< imax 0.001))
- (format #t ";(random 1+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+ (format-logged #t ";(random 1+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
(let ((imax 0.0)
(rmax 0.0)
@@ -59540,7 +75788,7 @@ but it's the printout that is at fault:
(> rmax 0.0)
(< rmin 0.0)
(< imax 0.001))
- (format #t ";(random 0+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+ (format-logged #t ";(random 0+i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
(let ((imax 0.0)
(rmax 0.0)
@@ -59559,7 +75807,7 @@ but it's the printout that is at fault:
(< rmin 0.0)
(< imax 0.1)
(< rmax 0.01))
- (format #t ";(random 100+10i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
+ (format-logged #t ";(random 100+10i): ~A ~A ~A ~A~%" rmin rmax imin imax)))
(do ((i 0 (+ i 1)))
@@ -59569,16 +75817,16 @@ but it's the printout that is at fault:
(> (real-part val) 1.0)
(> (imag-part val) 1.0)
(< (real-part val) 0.0))
- (format #t ";(random 1.0+1.0i) -> ~A?~%" val))))
+ (format-logged #t ";(random 1.0+1.0i) -> ~A?~%" val))))
- (let ((rs (make-random-state 12345678)))
+ (let ((rs (random-state 12345678)))
(do ((i 0 (+ i 1)))
((= i 100))
(let ((val (random 1.0 rs)))
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format #t ";(random 1.0 rs) -> ~A?~%" val)))))
+ (format-logged #t ";(random 1.0 rs) -> ~A?~%" val)))))
(if with-bignums
(begin
@@ -59593,7 +75841,7 @@ but it's the printout that is at fault:
(<= val 1.0))))))
(if (or (< vr 40)
(> vr 400))
- (format #t ";(big-random 1.0) not so random? ~A~%" vr)))
+ (format-logged #t ";(big-random 1.0) not so random? ~A~%" vr)))
(let ((vr (v 1000
(bignum "100")
@@ -59603,7 +75851,7 @@ but it's the printout that is at fault:
(<= val 100))))))
(if (or (< vr 40)
(> vr 400))
- (format #t ";(big-random 100) not so random? ~A~%" vr)))
+ (format-logged #t ";(big-random 100) not so random? ~A~%" vr)))
(let ((vr (v 1000
(bignum "1/2")
@@ -59613,7 +75861,7 @@ but it's the printout that is at fault:
(<= val 1/2))))))
(if (or (< vr 40)
(> vr 400))
- (format #t ";(big-random 1/2) not so random? ~A~%" vr)))
+ (format-logged #t ";(big-random 1/2) not so random? ~A~%" vr)))
(let ((vr (v 1000
(bignum "-10.0")
@@ -59623,7 +75871,7 @@ but it's the printout that is at fault:
(>= val -10.0))))))
(if (or (< vr 40)
(> vr 400))
- (format #t ";(big-random -10.0) not so random? ~A~%" vr)))
+ (format-logged #t ";(big-random -10.0) not so random? ~A~%" vr)))
(do ((i 0 (+ i 1)))
((= i 100))
@@ -59632,35 +75880,35 @@ but it's the printout that is at fault:
(> (real-part val) 1.0)
(> (imag-part val) 1.0)
(< (real-part val) 0.0))
- (format #t ";(big-random 1.0+1.0i) -> ~A?~%" val))))
+ (format-logged #t ";(big-random 1.0+1.0i) -> ~A?~%" val))))
- (let ((rs (make-random-state (bignum "12345678"))))
+ (let ((rs (random-state (bignum "12345678"))))
(do ((i 0 (+ i 1)))
((= i 100))
(let ((val (random (bignum "1.0") rs)))
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format #t ";(big-random 1.0 rs) -> ~A?~%" val)))
+ (format-logged #t ";(big-random 1.0 rs) -> ~A?~%" val)))
(let ((val (random 1.0 rs)))
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format #t ";(big-random small-1.0 rs) -> ~A?~%" val)))))
+ (format-logged #t ";(big-random small-1.0 rs) -> ~A?~%" val)))))
- (let ((rs (make-random-state 1234)))
+ (let ((rs (random-state 1234)))
(do ((i 0 (+ i 1)))
((= i 100))
(let ((val (random (bignum "1.0") rs)))
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format #t ";(big-random 1.0 small-rs) -> ~A?~%" val)))
+ (format-logged #t ";(big-random 1.0 small-rs) -> ~A?~%" val)))
(let ((val (random 1.0 rs)))
(if (or (not (real? val))
(negative? val)
(> val 1.0))
- (format #t ";(random small-1.0 rs) -> ~A?~%" val)))))
+ (format-logged #t ";(random small-1.0 rs) -> ~A?~%" val)))))
))
)
@@ -59669,31 +75917,79 @@ but it's the printout that is at fault:
(test (nan? (random 1/0)) #t)
(test (zero? (random 1e-30)) #f)
-(test ((object->string (make-random-state 1234)) 1) #\<)
-(test (make-random-state 1.0) 'error)
-(test (make-random-state 1+i) 'error)
-(test (make-random-state 3/4) 'error)
+(unless with-bignums
+ (test ((object->string (random-state 1234) :readable) 1) #\r) ; print-readably here
+ (test ((object->string (random-state 1234)) 1) #\<)) ; write (#t as default) here
+(test (random-state 1.0) 'error)
+(test (random-state 1+i) 'error)
+(test (random-state 3/4) 'error)
+(test (random-state 1/0) 'error)
+(test (random-state (real-part (log 0))) 'error)
+(test (random-state? (random-state 100)) #t)
+(test (random-state?) 'error)
+(test (random-state? (random-state 100) 100) 'error)
+(test (equal? (random-state 1234) #f) #f)
+(unless with-bignums
+ (test (random-state -1) 'error)
+ (test (random-state -1 123) 'error)
+ (test (random-state 1 -123) 'error)
+ (test (random-state 1 most-negative-fixnum) 'error)
+ (test (random-state -9223372036854775808) 'error)
+
+ (let ((r1 (random-state 100))
+ (r2 (random-state 100))
+ (r3 (random-state 200)))
+ (test (random-state? r3) #t)
+ (test (equal? r1 r2) #t)
+ (test (equal? r1 r3) #f)
+ (random 1.0 r1)
+ (test (equal? r1 r2) #f)
+ (random 1.0 r2)
+ (test (equal? r1 r2) #t)
+ (test (equal? (copy r1) r1) #t)
+ (test (random-state? r2) #t)
+ (test (random-state? (copy r1)) #t)))
+
+(test (complex? (random 1+i (random-state 1234))) #t)
+(when with-bignums
+ (test (complex? (random (bignum "1+i") (random-state 1234))) #t)
+ (test (real? (random (bignum "1.5") (random-state 1234))) #t)
+ (test (rational? (random (bignum "1/2") (random-state 1234))) #t)
+ (test (integer? (random (bignum "100") (random-state 1234))) #t)
+ (test (complex? (random (bignum "1+i") (random-state (bignum "1234")))) #t)
+ (test (real? (random (bignum "1.5") (random-state (bignum "1234")))) #t)
+ (test (rational? (random (bignum "1/2") (random-state (bignum "1234")))) #t)
+ (test (integer? (random (bignum "100") (random-state (bignum "1234")))) #t))
(for-each
(lambda (arg)
(test (random arg) 'error)
(test (random 1.0 arg) 'error)
- (test (make-random-state arg) 'error))
- (list "hi" _ht_ '() '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) abs #\f (lambda (a) (+ a 1)) (if #f #f) #<eof> #<undefined>))
+ (test (random-state arg) 'error)
+ (test (random-state->list arg) 'error)
+ (test (random-state? arg) #f)
+ )
+ (list "hi" _ht_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) abs #\f (lambda (a) (+ a 1)) (if #f #f) :hi #<eof> #<undefined>))
-(let ((r1 (make-random-state 1234))
- (r2 (make-random-state 1234)))
+(when (not with-bignums)
+ (test (car (random-state->list (random-state 1234))) 1234)
+ (test (pair? (random-state->list)) #t)) ; the default?
+(test (random-state->list #f 1234) 'error)
+(test (random-state) 'error)
+
+(let ((r1 (random-state 1234))
+ (r2 (random-state 1234)))
(test (eq? r1 r2) #f)
- (test (equal? r1 r2) #f)
+ (unless with-bignums (test (equal? r1 r2) #t))
(test (eq? r2 r2) #t)
(test (equal? r1 r1) #t)
- (test ((object->string r1) 1) #\<)
+ (test ((object->string r1 #f) 1) #\<) ; display, not write
(let ((val1 (random 10000000 r1))
(val2 (random 10000000 r2)))
(test val1 val2)))
-(let ((r1 (make-random-state 1234))
- (r2 (make-random-state 1234567)))
+(let ((r1 (random-state 1234))
+ (r2 (random-state 1234567)))
(let ((val1 (random 10000000 r1))
(val2 (random 10000000 r2)))
(let ((val3 (random 10000000 r1))
@@ -59705,33 +76001,34 @@ but it's the printout that is at fault:
(not (= val5 val6)))
#t)))))
-(let ((r1 (make-vector 10)))
- (let* ((rs1 (make-random-state 12345))
- (rs2 (copy rs1))
- (rs3 (apply make-random-state (random-state->list rs1)))
- (rs4 #f)
- (rs5 #f))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (set! (r1 i) (random 1.0 rs1))
- (if (= i 3)
- (set! rs4 (copy rs1)))
- (if (= i 5)
- (set! rs5 (apply make-random-state (random-state->list rs1)))))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (let ((v1 (random 1.0 rs2))
- (v2 (random 1.0 rs3)))
- (if (not (= v1 v2 (r1 i)))
- (format #t ";random v1: ~A, v2: ~A, r1[~A]: ~A~%" v1 v2 i (r1 i))))
- (if (> i 3)
- (let ((v3 (random 1.0 rs4)))
- (if (not (= v3 (r1 i)))
- (format #t ";random v3: ~A, r1[~A]: ~A~%" v3 i (r1 i)))))
- (if (> i 5)
- (let ((v4 (random 1.0 rs5)))
- (if (not (= v4 (r1 i)))
- (format #t ";random v4: ~A, r1[~A]: ~A~%" v4 i (r1 i))))))))
+(when (not with-bignums)
+ (let ((r1 (make-vector 10)))
+ (let* ((rs1 (random-state 12345))
+ (rs2 (copy rs1))
+ (rs3 (apply random-state (random-state->list rs1)))
+ (rs4 #f)
+ (rs5 #f))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (r1 i) (random 1.0 rs1))
+ (if (= i 3)
+ (set! rs4 (copy rs1)))
+ (if (= i 5)
+ (set! rs5 (apply random-state (random-state->list rs1)))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (let ((v1 (random 1.0 rs2))
+ (v2 (random 1.0 rs3)))
+ (if (not (= v1 v2 (r1 i)))
+ (format-logged #t ";random v1: ~A, v2: ~A, r1[~A]: ~A~%" v1 v2 i (r1 i))))
+ (if (> i 3)
+ (let ((v3 (random 1.0 rs4)))
+ (if (not (= v3 (r1 i)))
+ (format-logged #t ";random v3: ~A, r1[~A]: ~A~%" v3 i (r1 i)))))
+ (if (> i 5)
+ (let ((v4 (random 1.0 rs5)))
+ (if (not (= v4 (r1 i)))
+ (format-logged #t ";random v4: ~A, r1[~A]: ~A~%" v4 i (r1 i)))))))))
(do ((i 0 (+ i 1)))
((= i 20)) ; this was ((+ i 100)) !! -- surely a warning would be in order?
@@ -59757,13 +76054,32 @@ but it's the printout that is at fault:
(if with-bignums
(begin
- (let ((r1 (make-random-state (expt 2 70))))
+ (let ((r1 (random-state (expt 2 70))))
+ (test (random-state? r1) #t)
(test ((object->string r1) 1) #\<)
(test (eq? r1 r1) #t)
+ (test (equal? r1 r1) #t)
(let ((val1 (random 10000000 r1))
(val2 (random 10000000 r1)))
(test (not (= val1 val2)) #t)))))
+(let () ; optimizer tests
+ (define (f1) (- (random 100) 50))
+ (define (f2) (- (random 1.0) 0.5))
+ (define (f3) (random 100))
+ (define (f4) (random 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 20))
+ (let ((v1 (f1))
+ (v2 (f2))
+ (v3 (f3))
+ (v4 (f4)))
+ (if (not (<= -50 v1 50)) (format *stderr* ";f1: sub_random_ic: ~A~%" v1))
+ (if (not (<= 0 v3 100)) (format *stderr* ";f3: random_ic: ~A~%" v3))
+ (if (not (<= -0.5 v2 0.5)) (format *stderr* ";f2: sub_random_rc: ~A~%" v2))
+ (if (not (<= 0.0 v4 1.0)) (format *stderr* ";f4: random_rc: ~A~%" v4)))))
+
+
@@ -59775,14 +76091,15 @@ but it's the printout that is at fault:
(test (string->number "+#.#") #f)
(test (string->number "-#.#") #f)
(test (string->number "#.#") #f)
-(test (string->number "#i") #f)
-(test (string->number "#e") #f)
+(when (not pure-s7)
+ (test (string->number "#i") #f)
+ (test (string->number "#e") #f))
(test (string->number "#") #f)
(for-each
(lambda (n)
(if (not (eqv? n (string->number (number->string n))))
- (format #t ";(string->number (number->string ~A)) = ~A?~%" n (string->number (number->string n)))))
+ (format-logged #t ";(string->number (number->string ~A)) = ~A?~%" n (string->number (number->string n)))))
(list 1 2 3 10 1234 1234000000 500029 362880 0/1 0/2 0/3 0/10 0/1234 0/1234000000 0/500029
0/362880 1/1 1/2 1/3 1/10 1/1234 1/1234000000 1/500029 1/362880 2/1 2/2 2/3 2/10 2/1234
2/1234000000 2/500029 2/362880 3/1 3/2 3/3 3/10 3/1234 3/1234000000 3/500029 3/362880
@@ -59796,7 +76113,7 @@ but it's the printout that is at fault:
(for-each
(lambda (x)
(if (not (fequal? x (string->number (number->string x))))
- (format #t ";(string->number (number->string ~A)) -> ~A?~%" x (string->number (number->string x)))))
+ (format-logged #t ";(string->number (number->string ~A)) -> ~A?~%" x (string->number (number->string x)))))
(list 0.000000 1.000000 3.141593 2.718282 1234.000000 1234000000.000000 0.000000+0.000000i 0.000000+0.000000i 0.000000+1.000000i
0.000000+3.141593i 0.000000+2.718282i 0.000000+1234.000000i 0.000000+1234000000.000000i 0.000000+0.000000i 0.000000+0.000000i
0.000000+1.000000i 0.000000+3.141593i 0.000000+2.718282i 0.000000+1234.000000i 0.000000+1234000000.000000i 1.000000+0.000000i
@@ -59841,6 +76158,59 @@ but it's the printout that is at fault:
(num-test (string->number "0-0e100i") 0.0)
(test (string->number "0e10e100") #f)
+(test (equal? (string->number (number->string -1e19)) -1e19) #t)
+(test (equal? (string->number (number->string 1e308)) 1e308) #t)
+(test (equal? (string->number (number->string 9.22e18)) 9.22e18) #t)
+
+;;; @ exponent added 26-Mar-12
+(if (provided? '@-exponent)
+ (begin
+ (num-test 0.0 0 at 0)
+ (num-test 0.0 0 at -0)
+ (num-test 0.0 0 at +0)
+ (num-test 1.0 1 at 0)
+ (num-test 10.0 1 at 1)
+ (num-test 10.0 1 at +1)
+ (num-test 0.1 1 at -1)
+
+ (num-test (string->number "1 at 0" 16) 1.0)
+ (num-test (string->number "e at 0" 16) 14.0)
+ (num-test (string->number "a at 1" 16) 160.0)
+ (num-test (string->number "#xa at 1") 160.0)
+ (num-test (string->number ".a at 0" 12) 0.83333333333333)
+ (num-test (string->number "a. at 0" 16) 10.0)
+ (num-test (string->number "0a" 16) 10)
+ (when (not pure-s7) (num-test (string->number "#e0a" 16) 10))
+ (num-test (string->number "a at -1" 16) 0.625)
+
+ (num-test 1 at 0+1@0i 1+1i)
+ (num-test (string->number "1 at 1" 12) 12.0)
+ (num-test (string->number "1 at -1" 16) 0.0625)
+ (num-test (string->number "1.0 at 1+0.1@2i" 16) 16+16i)
+ (num-test (string->number "#b.0 at 2") 0.0)
+ (num-test (string->number ".2 at -22") 2e-23)
+ (num-test (string->number "+02 at 02") 200.0)
+ (num-test (string->number "2fe2 at 2" 16) 3138048.0)
+ (when (not pure-s7) (num-test (string->number "#i1 at 01" 16) 16.0))
+ (num-test (string->number "1 at -0-bc/di" 16) 1-14.461538461538i)
+ (num-test (string->number ".f-a.c1 at 0i" 16) 0.9375-10.75390625i)
+ (num-test (string->number "df2 at 2-ccfi" 16) 913920-3279i)
+ (num-test (string->number "0/0de-0 at 2i" 16) 0.0)
+ (num-test (string->number "-1a12cd. at 1" 16) -27339984.0)
+ (num-test (string->number "fb/2ea+2 at +1i" 16) 0.33646112600536+32i)
+ (num-test (string->number "af.e0 at -0+0b/efefd11i" 16) 175.875+4.3721589140015e-08i)
+ (num-test (string->number "bb10 at 1-i" 12) 247248-1i)
+ (num-test (string->number "b.+0 at 01i" 12) 11.0)
+ (num-test (string->number "-0 at -0221" 12) 0.0)
+ (num-test (string->number "-a-01 at 2i" 12) -10-144i)
+ (num-test (string->number "#d.0 at -11" 10) 0.0)
+ (num-test (string->number "#i+1 at 002" 10) 100.0)
+ (num-test (string->number "-111 at -1-1i" 10) -11.1-1i)
+ (num-test (string->number "122 at 9-2@0i" 10) 122000000000-2i)
+ (num-test (string->number "-0 at +10-20i" 10) 0-20i)
+ (num-test (string->number "+2 at -909221" 10) 0.0)
+ ))
+
;; s7.html claims this '=' is guaranteed...
(test (= .6 (string->number ".6")) #t)
(test (= 0.60 (string->number "0.60")) #t)
@@ -59859,10 +76229,12 @@ but it's the printout that is at fault:
(test (= 0.6-.1i (string->number "0.6-.1i")) #t)
;; but is this case also guaranteed??
-(test (= .6 (string->number (number->string .6))) #t)
-(test (= 0.6 (string->number (number->string 0.6))) #t)
-(test (= 0.60 (string->number (number->string 0.60))) #t)
-(test (= 60e-2 (string->number (number->string 60e-2))) #t)
+(when (not with-bignums)
+ (test (= .6 (string->number (number->string .6))) #t)
+ (test (= 0.6 (string->number (number->string 0.6))) #t)
+ (test (= 0.60 (string->number (number->string 0.60))) #t)
+ (test (= 60e-2 (string->number (number->string 60e-2))) #t)
+ (test (= 0.6-.1i (string->number (number->string 0.6-.1i))) #t))
;(test (= #i3/5 (string->number (number->string #i3/5))) #t)
(test (= 0.11 (string->number (number->string 0.11))) #t)
(test (= 0.999 (string->number (number->string 0.999))) #t)
@@ -59874,7 +76246,6 @@ but it's the printout that is at fault:
(test (= -1/10 (string->number (number->string -1/10))) #t)
(test (= -110 (string->number (number->string -110))) #t)
(test (= 1+i (string->number (number->string 1+i))) #t)
-(test (= 0.6-.1i (string->number (number->string 0.6-.1i))) #t)
(test (= 0.6 0.600) #t)
(test (= 0.6 6e-1 60e-2 .06e1 6.e-1) #t)
@@ -59882,6 +76253,9 @@ but it's the printout that is at fault:
(test (= 0.3 0.3000) #t)
(test (= 0.345 0.345000 345.0e-3) #t)
+(test (string->number #u8(0 0 0 0 0) #\a) 'error)
+(test (string->number "" "") 'error)
+
#|
;; scheme spec says (eqv? (number->string (string->number num radix) radix) num) is always #t
;; (also that radix is 10 if num is inexact)
@@ -59914,7 +76288,7 @@ but it's the printout that is at fault:
(string->number str6)
(string->number str7))))
(if (not (apply = args))
- (format #t "~A.~A: ~{~D~^~4T~}~%" strd str
+ (format-logged #t "~A.~A: ~{~D~^~4T~}~%" strd str
(map (lambda (val)
(let ((ctr 0))
(for-each
@@ -60000,8 +76374,9 @@ but it's the printout that is at fault:
(num-test 0 0/100000000000000000000000000000000000000000000000000000000000000+0i)
(num-test 0 0/100000000000000000000000000000000000000000000000000000000000000000000-0i)
-(test (< 0 1000000000000000000000000000000000) #t)
-(test (> 0 -1000000000000000000000000000000000) #t)
+(when with-bignums
+ (test (< 0 1000000000000000000000000000000000) #t)
+ (test (> 0 -1000000000000000000000000000000000) #t))
#|
;;; are these worth fixing?
@@ -60043,6 +76418,28 @@ etc....
(test (equal? 0.0 0.0+0e0123456789i) #t)
(num-test 0.0 1e-1000)
+(num-test 0e123412341231231231231231231231231231 0.0)
+(num-test 0e-123412341231231231231231231231231231 0.0)
+(num-test 0.00000e123412341231231231231231231231231231 0.0)
+(num-test .0e-123412341231231231231231231231231231 0.0)
+(num-test 2e-123412341231231231231 0.0)
+(num-test 2e-123412341231231231231231231231231231 0.0)
+(num-test 2.001234e-123412341231231231231 0.0)
+(num-test .00122e-123412341231231231231231231231231231 0.0)
+(num-test 2e00000000000000000000000000000000000000001 20.0)
+(num-test 2e+00000000000000000000000000000000000000001 20.0)
+(num-test 2e-00000000000000000000000000000000000000001 0.2)
+(num-test 2e-9223372036854775807 0.0)
+(num-test 2000.000e-9223372036854775807 0.0)
+
+(if (not with-bignums)
+ (begin
+ (test (infinite? 2e123412341231231231231) #t)
+ (test (infinite? 2e12341234123123123123123123) #t)
+ (test (infinite? 2e12341234123123123123213123123123) #t)
+ (test (infinite? 2e9223372036854775807) #t)
+ ))
+
(if (provided? 'dfls-exponents)
(begin
(test (> 1.0L10 1.0e9) #t)
@@ -60157,7 +76554,7 @@ etc....
(test (> (imag-part 1.0+1.0F100i) 1.0e98) #t)
))))
-(if with-bignums
+(if (and with-bignums (not pure-s7))
(begin
(test (number? (string->number "#e1.0e564")) #t)
(test (number? (string->number "#e1.0e307")) #t)
@@ -60167,23 +76564,34 @@ etc....
(num-test (string->number "#e8978167593632120808315265/5504938256213345873657899") 8978167593632120808315265/5504938256213345873657899)
(num-test (string->number "#i8978167593632120808315265/5504938256213345873657899") 1.630929753571457437099527114342760854299E0)
(num-test (string->number "#i119601499942330812329233874099/12967220607") 9.223372036854775808414213562473095048798E18)
+ ;; this next test needs more bits to compare with other schemes -- this is the result if 128 bits
(num-test (string->number "#e005925563891587147521650777143.74135805596e05") 826023606487248364518118333837545313/1394)
(num-test (string->number "#e-1559696614.857e28") -15596966148570000000000000000000000000)
(test (integer? (string->number "#e1e310")) #t)
(test (number? (string->number "#e1.0e310")) #t)
))
;; in the non-gmp case #e1e321 is a read error -- should s7 return NaN silently?
-;; can't use #e1e543 directly here because the reader throws an error even though with-bignums is #f
-
-(if (not with-bignums)
- (begin
- ;(test (number? (string->number "#e1e307")) #t)
- ;(test (number? #e1.0e564) #t)
- (test (string->number "#e005925563891587147521650777143.74135805596e05") 'error)
- (test (string->number "#e78.5e65") 'error)
- (test (string->number "#e-1559696614.857e28") 'error)))
-(test (= 0 00 -000 #e-0 0/1 #e#x0 #b0000 #e#d0.0 -0 +0) #t)
+(when (and (not with-bignums)
+ (not pure-s7))
+ (test (string->number "#e1e307") #f)
+ (test (eval-string "(number? #e1.0e564)") 'error)
+ (test (string->number "#e005925563891587147521650777143.74135805596e05") #f)
+ (test (string->number "#e78.5e65") #f)
+ (test (string->number "#e1e543") #f)
+ (test (string->number "#e120d21") #f)
+ (test (string->number "#e-2.2e021") #f)
+ (if (provided? '@-exponent)
+ (test (infinite? (string->number "9221. at 9129" 10)) #t))
+ (test (string->number "#e120 at 21" 12) #f)
+ (test (string->number "#d#e120 at 21") #f)
+ (test (string->number "#b#e120 at 21") #f)
+ (test (string->number "#e#b120 at 21") #f)
+ (test (string->number "#e#d120 at 21") #f)
+ (test (nan? (string->number "0f0/00" 16)) #t)
+ (test (string->number "#e-1559696614.857e28") #f)
+ (test (string->number "#e1+1i") #f)
+ (test (= 0 00 -000 #e-0 0/1 #e#x0 #b0000 #e#d0.0 -0 +0) #t))
;; (do ((i 0 (+ i 1)) (n 1 (* n 2))) ((= i 63)) (display n) (display " ") (display (number->string n 16)) (newline))
@@ -60201,6 +76609,10 @@ etc....
(test (string->number "1.0/0.0") #f)
(test (string->number "'1") #f)
(test (string->number "`1") #f)
+(test (string->number ". at 0") #f)
+(test (string->number "+. at 0") #f)
+(test (string->number "+.-i") #f)
+(test (string->number "+.-0i") #f)
(num-test (string->number "10111/100010" 2) 23/34)
(num-test (string->number "27/42" 8) 23/34)
(num-test (string->number "17/22" 16) 23/34)
@@ -60216,6 +76628,19 @@ etc....
(test (number->string -23/34 8) "-27/42")
(test (number->string -23/34 16) "-17/22")
+(test (number->string -1 16) "-1")
+;(test (number->string #xffffffffffffffff 16) "-1") -- is this a bug?
+(when (not with-bignums)
+ ;(test (= #xffffffffffffffff -1) #t) ; this is an overflow
+ (test (= #x8000000000000000 -9223372036854775808) #t))
+(test (= #x7fffffffffffffff 9223372036854775807) #t)
+(test (number->string 9223372036854775807 16) "7fffffffffffffff")
+(test (number->string -9223372036854775808 16) "-8000000000000000")
+(test (number->string #o777777777777777777777) "9223372036854775807")
+(when (not with-bignums)
+ (test (number->string #o1000000000000000000000) "-9223372036854775808")
+ (test (number->string #b1000000000000000000000000000000000000000000000000000000000000000) "-9223372036854775808"))
+
(num-test (string->number "3/4+1/2i") 0.75+0.5i)
(num-test (string->number "3/4+i") 0.75+i)
(num-test (string->number "0+1/2i") 0+0.5i)
@@ -60234,16 +76659,13 @@ etc....
(test (string->number "#b 1") #f)
(test (string->number "# b1") #f)
(test (string->number "#b12") #f)
+(test (string->number "000+1") #f)
(test (string->number (string (integer->char 216))) #f) ; slashed 0
(test (string->number (string (integer->char 189))) #f) ; 1/2 as single char
(test (string->number (string #\1 (integer->char 127) #\0)) #f) ; backspace
-;; but...
-(test (string->number "1\ 2") 12)
(test (string->number "1\
2") 12)
-(num-test (string->number "1\ \ \ \ \ .\ \ \ 2\ \ ") 1.2)
-(test (string->number "1\ \ \ \ \ . \ \ \ 2\ \ ") #f) ; yowza
(test (string->number "1E1") 10.0)
(test (string->number "1e1") 10.0)
@@ -60341,15 +76763,14 @@ etc....
(num-test (string->number "179769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368.0")
1.7976931348623e+308))
-(if with-bignums
- (begin
- (num-test (string->number (number->string (bignum "12345.67890987654321") 2) 2) 12345.67890987654321)
- (test (number->string 1234.5678909876543212345 16) "4d2.91614dc3ab1f80e55a563311b8f308")
- (test (number->string -1234.5678909876543212345 16) "-4d2.91614dc3ab1f80e55a563311b8f308")
- (test (number->string 1234.5678909876543212345e8 16) "1cbe991a6a.c3f35c11868cb7e3fb75536")
- (test (number->string 1234.5678909876543212345e-8 16) "0.0000cf204983a27e1eff701c562a870641e50")
- (test (number->string 123456789098765432.12345e-8 16) "499602d2.fcd6e9e1748ba5adccc12c5a8")
- (test (number->string 123456789098765432.1e20 16) "949b0f70beeac8895e74b18b9680000.00")))
+(when with-bignums
+ (num-test (string->number (number->string (bignum "12345.67890987654321") 2) 2) 12345.67890987654321)
+ (test (number->string 1234.5678909876543212345 16) "4.d291614dc3ab1f80e55a563311b8f308 at 2")
+ (test (number->string -1234.5678909876543212345 16) "-4.d291614dc3ab1f80e55a563311b8f308 at 2")
+ (test (number->string 1234.5678909876543212345e8 16) "1.cbe991a6ac3f35c11868cb7e3fb75536 at 9")
+ (test (number->string 1234.5678909876543212345e-8 16) "c.f204983a27e1eff701c562a870641e5 at -5")
+ (test (number->string 123456789098765432.12345e-8 16) "4.99602d2fcd6e9e1748ba5adccc12c5a8 at 7")
+ (test (number->string 123456789098765432.1e20 16) "9.49b0f70beeac8895e74b18b968 at 30"))
(num-test (string->number "12345678900000000000.0") 1.23456789e+19)
(num-test (string->number "1234567890000000000000000000000000000000000000000000000000000000000000.0") 1.23456789e+69)
@@ -60378,6 +76799,13 @@ etc....
(test (number->string -0. 11 -) 'error)
(test (string->number "11" 2 -) 'error)
+(test (string->number "1.0F") #f)
+(test (string->number "1F") #f)
+(test (string->number "1d") #f)
+(test (string->number "1.0L") #f)
+(test (string->number "1.0+1.0Ei") #f)
+(test (string->number "0xff") #f)
+
;; duplicate various non-digit chars
(for-each
(lambda (str)
@@ -60437,12 +76865,25 @@ etc....
(test (string->number "1 000") #f)
(test (string->number "1 / 2") #f)
(test (string->number "1 .2") #f)
+(test (string->number "1:") #f)
+(test (string->number "#b 1") #f)
+#|
+(do ((i 20 (+ i 1)))
+ ((= i 128))
+ (let ((str (string-append "#" (string (integer->char i)) "1.0e8")))
+ (catch #t (lambda ()
+ (let ((val (eval-string str)))
+ (format-logged #t "~A -> ~S~%" str val)))
+ (lambda args 'error))))
+|#
(num-test #b1.0e8 256.0)
(num-test #o1.0e8 16777216.0)
(num-test #d1.0e8 100000000.0)
+(num-test #x1.0e8 1.056640625) ; e is a digit
+(num-test #e1.0e8 100000000)
+(num-test #i1.0e8 100000000.0)
-;;; no #x here because e is a digit
(if with-bignums
(num-test #b1.1111111111111111111111111111111111111111111111111110011101010100100100011001011011111011000011001110110101010011110011000100111E1023 1.7976931348623156E308))
@@ -60454,62 +76895,65 @@ etc....
(test (string->number "#b'0") #f)
(test (string->number "#b0/0") #f)
(test (string->number "#b-1/0") #f)
-(test (string->number "#b#i0/0") #f)
-(test (string->number "#b#e0/0") #f)
-(test (string->number "#b#e1/0+i") #f) ; inf+i?
(test (string->number "1e1/2") #f)
(test (string->number "1e#b0") #f)
(test (string->number "#B0") #f)
-(test (string->number "#e#b0/0") #f)
-(test (string->number "#i#b0/0") #f)
-(test (string->number "#e0/0") #f)
-(test (number? (string->number "#i0/0")) #t) ; nan since (number? 0/0) is #t
-(test (string->number "#e#b1/0") #f)
-(test (string->number "#i#b1/0") #f)
-(test (string->number "#e1/0") #f)
-(test (number? (string->number "#i1/0")) #t)
-(test (string->number "#e#b1/0+i") #f)
-(test (string->number "#i#b1/0+i") #f) ; inf+i?
-(test (string->number "#e1/0+i") #f)
-(test (number? (string->number "#i1/0+i")) #t)
-(test (number? (string->number "#i0/0+i")) #t)
-(test (nan? #i0/0) #t) ; but #i#d0/0 is a read error?
-
-(num-test (string->number "#b#e11e30") 3221225472) ; very confusing!
-(num-test (string->number "#b#i11e30") 3221225472.0)
-(num-test (string->number "#e#b11e30") 3221225472)
-(num-test (string->number "#i#b11e30") 3221225472.0)
-(num-test (string->number "#b#e+1e+1+0e+10i") 2)
-(num-test (string->number "#e+.0e-00-0i") 0)
-(num-test (string->number "#x1e0/e+0/ei") 34.285714285714)
-(num-test (string->number "#e-0/1110010") 0)
+(test (string->number "0+I") #f)
+(when (not pure-s7)
+ (test (string->number "#b#i0/0") #f)
+ (test (string->number "#b#e0/0") #f)
+ (test (string->number "#b#e1/0+i") #f) ; inf+i?
+ (test (string->number "#e#b0/0") #f)
+ (test (string->number "#i#b0/0") #f)
+ (test (string->number "#e0/0") #f)
+ (test (number? (string->number "#i0/0")) #t) ; nan since (number? 0/0) is #t
+ (test (string->number "#e#b1/0") #f)
+ (test (string->number "#i#b1/0") #f)
+ (test (string->number "#e1/0") #f)
+ (test (number? (string->number "#i1/0")) #t)
+ (test (string->number "#e#b1/0+i") #f)
+ (test (string->number "#i#b1/0+i") #f) ; inf+i?
+ (test (string->number "#e1/0+i") #f)
+ (test (number? (string->number "#i1/0+i")) #t)
+ (test (number? (string->number "#i0/0+i")) #t)
+ (test (nan? #i0/0) #t) ; but #i#d0/0 is a read error?
+
+ (num-test (string->number "#b#e11e30") 3221225472) ; very confusing!
+ (num-test (string->number "#b#i11e30") 3221225472.0)
+ (num-test (string->number "#e#b11e30") 3221225472)
+ (num-test (string->number "#i#b11e30") 3221225472.0)
+ (num-test (string->number "#b#e+1e+1+0e+10i") 2)
+ (num-test (string->number "#e+.0e-00-0i") 0)
+ (num-test (string->number "#e-0/1110010") 0)
+ (num-test (string->number "#x#e00110e") 4366)
+ (num-test (string->number "#e#x-e/001") -14)
+ (num-test (string->number "#e.001e-11") 0)
+ (num-test (string->number "#x#e00/00e") 0)
+ (num-test (string->number "#e#x+1e.01e10100") 65366158/2178339)
+ (num-test (string->number "#i#x0e10-000i") 3600.0)
+ (num-test (string->number "#x0/e010-e/1i") 0-14i)
+ (num-test (string->number "#i-1/1-1.0e1i") -1-10i)
+ (num-test (string->number "#e#x001ee11e1") 32379361)
+ (num-test (string->number "#e#x010e10.e1") 17699041/256)
+ (num-test #b#i.110e-1 0.375)
+ (num-test #e01.1e1+00.i 11))
+
+(num-test (string->number "#x10+10i") 16+16i)
+(num-test 00-10e+001i 0-100i)
+(num-test (string->number "#x+e/00011ee0") 7/36720)
+(num-test (string->number "-1.-00.0e+10i") -1.0)
(num-test (string->number "#x+1e1.+e10i") 481+3600i)
(num-test (string->number "#xe/e+e/ei") 1+1i)
(num-test (string->number "1e-0-.11e+1i") 1-1.1i)
(num-test (string->number "00.-1.1e-00i") 0-1.1i)
(num-test (string->number "+01.e+1+.00i") 10.0)
-(num-test (string->number "#x#e00110e") 4366)
+(num-test (string->number "#x1e0/e+0/ei") 34.285714285714)
(num-test (string->number "+01e0+00.i") 1.0)
-(num-test (string->number "#e#x-e/001") -14)
(num-test (string->number "+0/0100+0i") 0.0)
-(num-test (string->number "#e.001e-11") 0)
-(num-test (string->number "#x#e00/00e") 0)
(num-test (string->number "#x-e1e/eee") -139/147)
(num-test (string->number "#x-0101.+00/11i") -257.0)
(num-test (string->number "#x+ee.-e00e0110i") 238-3759014160i)
(num-test (string->number "#x-e0/1ee") -112/247)
-(num-test (string->number "#e#x+1e.01e10100") 65366158/2178339)
-(num-test (string->number "#i#x0e10-000i") 3600.0)
-(num-test (string->number "#x0/e010-e/1i") 0-14i)
-(num-test (string->number "#i-1/1-1.0e1i") -1-10i)
-(num-test (string->number "-1.-00.0e+10i") -1.0)
-(num-test (string->number "#e#x001ee11e1") 32379361)
-(num-test (string->number "#x+e/00011ee0") 7/36720)
-(num-test (string->number "#e#x010e10.e1") 17699041/256)
-(num-test (string->number "#x10+10i") 16+16i)
-(num-test 00-10e+001i 0-100i)
-(num-test #b#i.110e-1 0.375)
-(num-test #e01.1e1+00.i 11)
(if (provided? 'dfls-exponents)
(begin
@@ -60536,15 +76980,16 @@ etc....
(num-test (string->number "#i#d1e1+.0i") 10.0)
(num-test (string->number "1.-0.0e+00i") 1.0)
-(test (string->number "#o#e10.+1.i") #f)
-(test (string->number "#x#e1+i") #f)
-(test (string->number "#x#1+#e1i") #f)
-(test (string->number "#x#e1+#e1i") #f)
-(test (string->number "#b#e1+i") #f)
-(test (string->number "#o#e1-110.i") #f)
-(num-test (string->number "#e1+0i") 1)
-(num-test (string->number "#x#e1+0i") 1)
-(num-test (string->number "#e#x1+0i") 1)
+(when (not pure-s7)
+ (test (string->number "#o#e10.+1.i") #f)
+ (test (string->number "#x#e1+i") #f)
+ (test (string->number "#x#1+#e1i") #f)
+ (test (string->number "#x#e1+#e1i") #f)
+ (test (string->number "#b#e1+i") #f)
+ (test (string->number "#o#e1-110.i") #f)
+ (num-test (string->number "#e1+0i") 1)
+ (num-test (string->number "#x#e1+0i") 1)
+ (num-test (string->number "#e#x1+0i") 1))
(num-test (string->number "#x1/7e2") 1/2018)
(num-test (string->number "0.1e00" 2) 0.5)
@@ -60578,23 +77023,23 @@ etc....
(num-test (string->number "acd/eabf" 16) 79/1717)
(num-test (string->number "-1e-1-1e-1i") -0.1-0.1i)
(num-test (string->number "+1e+1+1e+1i") 10+10i)
-(num-test (string->number "#i#d+1e+1+1e+1i") 10+10i)
-(test (string->number "#e+1e+1+1e+1i") #f)
+(when (not pure-s7)
+ (num-test (string->number "#i#d+1e+1+1e+1i") 10+10i)
+ (test (string->number "#e+1e+1+1e+1i") #f)
+ ;; these depend on rationalize's default error I think
+ ;; and they cause valgrind to hang!!
+ ;;(num-test (string->number "#e.1e-11") 0)
+ ;;(num-test (string->number "#e1e-12") 0)
+ (num-test (string->number "#e1e-11") 1/90909090910)
+ (test (string->number "#e#f1") #f)
-;;; these depend on rationalize's default error I think
-;;; and they cause valgrind to hang!!
-;(num-test (string->number "#e.1e-11") 0)
-;(num-test (string->number "#e1e-12") 0)
-(num-test (string->number "#e1e-11") 1/90909090910)
-(test (string->number "#e#f1") #f)
-
-(if with-bignums
- (begin
- (test (= (string->number "#e1e19") (string->number "#e.1e20")) #t)
- (test (= (string->number "#e1e19") (* 10 (string->number "#e1e18"))) #t)
- (test (= (string->number "#e1e20") (* 100 (string->number "#e1e18"))) #t)))
+ (if with-bignums
+ (begin
+ (test (= (string->number "#e1e19") (string->number "#e.1e20")) #t)
+ (test (= (string->number "#e1e19") (* 10 (string->number "#e1e18"))) #t)
+ (test (= (string->number "#e1e20") (* 100 (string->number "#e1e18"))) #t)))
-(test (= #i1e19 #i.1e20) #t)
+ (test (= #i1e19 #i.1e20) #t))
(test (= 1e19 .1e20) #t)
(test (string->number "15+b7a9+8bbi-95+4e" 16) #f)
@@ -60612,78 +77057,63 @@ etc....
(test (nan? (string->number "-28133828f9421ef5/0" 16)) #t)
(test (nan? (string->number "+4a11654f7e00d5f2/0" 16)) #t)
-(if with-bignums
- (begin
- (test (number->string (/ most-positive-fixnum most-negative-fixnum) 2) "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000")
- (test (string->number "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000" 2) -9223372036854775807/9223372036854775808)
- (num-test (string->number "#b#e-11e+111") -7788445287802241442795744493830144)
- (num-test (string->number "#i#b-11e+111") -7.788445287802241442795744493830144E33)
- (num-test (string->number "#b#i-11e+111") -7.788445287802241442795744493830144E33)
- (num-test (string->number "#i3e+111") 3.0e111)
- (num-test (string->number "#e3e30") 3000000000000000000000000000000)
- (num-test (string->number "#i3e30") 3.000E30)
-
- (num-test (string->number "#b#e11e80") 3626777458843887524118528)
- (num-test (string->number "#b#i11e80") 3626777458843887524118528.0)
- (num-test (string->number "#e#b11e80") 3626777458843887524118528)
- (num-test (string->number "#i#b11e80") 3626777458843887524118528.0)
-
- (num-test (string->number "b2706b3d3e8e46ad5aae" 15) 247500582888444441302414)
- (num-test (string->number "ceec932122d7c22289da9144.4b7836de0a2f5ef" 16) 6.403991331575236168367699181229480307503E28)
- (num-test (string->number "c23177c20fb1296/fcf15a82c8544613721236e2" 16) 437284287268358475/39141000511500755277510679409)
-
- (num-test (string->number "775f81b8fee51b723f" 16) 2202044529881940455999)
- (num-test (string->number "5d9eb6d6496f5c9b6e" 16) 1726983762769631550318)
- (num-test (string->number "+775f81b8fee51b723f" 16) 2202044529881940455999)
- (num-test (string->number "+5d9eb6d6496f5c9b6e" 16) 1726983762769631550318)
- (num-test (string->number "-775f81b8fee51b723f" 16) -2202044529881940455999)
- (num-test (string->number "-5d9eb6d6496f5c9b6e" 16) -1726983762769631550318)
- (num-test (string->number "+d053d635e581a5c4/d7" 16) 15011577509928084932/215)
- (num-test (string->number "+a053a635a581a5a4/a7" 16) 11552760218475668900/167)
- (num-test (string->number "-d053d635e581a5c4/d7" 16) -15011577509928084932/215)
- (num-test (string->number "-a053a635a581a5a4/a7" 16) -11552760218475668900/167)
- (num-test (string->number "+6/a47367025481df6c8" 16) 1/31599808811326133196)
- (num-test (string->number "d053d635e581a5c4/d7" 16) 15011577509928084932/215)
- (num-test (string->number "+074563336d48564b774" 16) 2146033681147780970356)
- (num-test (string->number "e/4246061597ec79345a" 15) 7/204584420774687563055)
- (num-test (string->number "c57252467ff.cfd94d" 16) 1.3568424830975811909496784210205078125E13)
- (num-test (string->number "f309e9b9ba.7c52ff2" 16) 1.043843365306485641427338123321533203125E12)
- (num-test (string->number "+42e-0106653" 10) 4.199999999999999999999999999999999999999E-106652)
- (test (infinite? (string->number "8e7290491476" 10)) #t)
- (num-test (string->number "4ff7da4d/ab09e16255c06a55c5cb7193ebb2fbb" 16) 1341643341/14209330580250438592763227155654717371)
-
- (num-test (string->number "#d3000000000000000000000000000000") 3000000000000000000000000000000)
- (num-test (string->number "#x400000000000000000") (expt 2 70))
-
- (for-each
- (lambda (op)
- (if (not (= (op 1e19) (op .1e20)))
- (format #t ";(~A 1e19) = ~A, but (~A .1e20) = ~A?~%"
- op (op 1e19)
- op (op .1e20))))
- (list floor ceiling truncate round inexact->exact exact->inexact))
-
- (for-each
- (lambda (op)
- (if (not (= (op -1e19) (op -.1e20)))
- (format #t ";(~A -1e19) = ~A, but (~A -.1e20) = ~A?~%"
- op (op -1e19)
- op (op -.1e20))))
- (list floor ceiling truncate round inexact->exact exact->inexact))
- )
-
- (begin
- ;; not with-bignums!
-
- ;;(test (/ most-positive-fixnum most-negative-fixnum) 'error) ; why not -1?
- (test (nan? (/ most-negative-fixnum)) #t)
- ;; (/ most-positive-fixnum most-negative-fixnum) -> 9223372036854775807/-9223372036854775808
- ;; so
- ;; (positive? (/ most-positive-fixnum most-negative-fixnum)) -> #t!
-
- (test (infinite? (string->number "775f81b8fee51b723f" 16)) #t) ; and others similarly -- is this a good idea?
-
- ))
+(when (and with-bignums (not pure-s7))
+ (test (number->string (/ most-positive-fixnum most-negative-fixnum) 2) "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000")
+ (test (string->number "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000" 2) -9223372036854775807/9223372036854775808)
+ (num-test (string->number "#b#e-11e+111") -7788445287802241442795744493830144)
+ (num-test (string->number "#i#b-11e+111") -7.788445287802241442795744493830144E33)
+ (num-test (string->number "#b#i-11e+111") -7.788445287802241442795744493830144E33)
+ (num-test (string->number "#i3e+111") 3.0e111)
+ (num-test (string->number "#e3e30") 3000000000000000000000000000000)
+ (num-test (string->number "#i3e30") 3.000E30)
+
+ (num-test (string->number "#b#e11e80") 3626777458843887524118528)
+ (num-test (string->number "#b#i11e80") 3626777458843887524118528.0)
+ (num-test (string->number "#e#b11e80") 3626777458843887524118528)
+ (num-test (string->number "#i#b11e80") 3626777458843887524118528.0)
+
+ (num-test (string->number "b2706b3d3e8e46ad5aae" 15) 247500582888444441302414)
+ (num-test (string->number "ceec932122d7c22289da9144.4b7836de0a2f5ef" 16) 6.403991331575236168367699181229480307503E28)
+ (num-test (string->number "c23177c20fb1296/fcf15a82c8544613721236e2" 16) 437284287268358475/39141000511500755277510679409)
+
+ (num-test (string->number "775f81b8fee51b723f" 16) 2202044529881940455999)
+ (num-test (string->number "5d9eb6d6496f5c9b6e" 16) 1726983762769631550318)
+ (num-test (string->number "+775f81b8fee51b723f" 16) 2202044529881940455999)
+ (num-test (string->number "+5d9eb6d6496f5c9b6e" 16) 1726983762769631550318)
+ (num-test (string->number "-775f81b8fee51b723f" 16) -2202044529881940455999)
+ (num-test (string->number "-5d9eb6d6496f5c9b6e" 16) -1726983762769631550318)
+ (num-test (string->number "+d053d635e581a5c4/d7" 16) 15011577509928084932/215)
+ (num-test (string->number "+a053a635a581a5a4/a7" 16) 11552760218475668900/167)
+ (num-test (string->number "-d053d635e581a5c4/d7" 16) -15011577509928084932/215)
+ (num-test (string->number "-a053a635a581a5a4/a7" 16) -11552760218475668900/167)
+ (num-test (string->number "+6/a47367025481df6c8" 16) 1/31599808811326133196)
+ (num-test (string->number "d053d635e581a5c4/d7" 16) 15011577509928084932/215)
+ (num-test (string->number "+074563336d48564b774" 16) 2146033681147780970356)
+ (num-test (string->number "e/4246061597ec79345a" 15) 7/204584420774687563055)
+ (num-test (string->number "c57252467ff.cfd94d" 16) 1.3568424830975811909496784210205078125E13)
+ (num-test (string->number "f309e9b9ba.7c52ff2" 16) 1.043843365306485641427338123321533203125E12)
+ (num-test (string->number "+42e-0106653" 10) 4.199999999999999999999999999999999999999E-106652)
+ (test (infinite? (string->number "8e7290491476" 10)) #t)
+ (num-test (string->number "4ff7da4d/ab09e16255c06a55c5cb7193ebb2fbb" 16) 1341643341/14209330580250438592763227155654717371)
+
+ (num-test (string->number "#d3000000000000000000000000000000") 3000000000000000000000000000000)
+ (num-test (string->number "#x400000000000000000") (expt 2 70))
+
+ (for-each
+ (lambda (op)
+ (if (not (= (op 1e19) (op .1e20)))
+ (format-logged #t ";(~A 1e19) = ~A, but (~A .1e20) = ~A?~%"
+ op (op 1e19)
+ op (op .1e20))))
+ (list floor ceiling truncate round inexact->exact exact->inexact))
+
+ (for-each
+ (lambda (op)
+ (if (not (= (op -1e19) (op -.1e20)))
+ (format-logged #t ";(~A -1e19) = ~A, but (~A -.1e20) = ~A?~%"
+ op (op -1e19)
+ op (op -.1e20))))
+ (list floor ceiling truncate round inexact->exact exact->inexact)))
(num-test #b+01 1)
(num-test #b-01 -1)
@@ -60712,56 +77142,62 @@ etc....
(num-test #b1e1 2.0)
(num-test #b1.e1 2.0)
-(num-test #b#e-.1 -1/2)
-(num-test #o#e-.1 -1/8)
-(num-test #d#e-.1 -1/10)
-(num-test #x#e-.1 -1/16)
+(when (not pure-s7)
+ (num-test #b#e-.1 -1/2)
+ (num-test #o#e-.1 -1/8)
+ (num-test #d#e-.1 -1/10)
+ (num-test #x#e-.1 -1/16)
+ (num-test #b#e1.1e2 6)
+ (num-test #o#e1.1e2 72)
+ (num-test #d#e1.1e2 110)
+ (num-test #b#i-1.1e-2 -0.375)
+ (num-test #o#i-1.1e-2 -0.017578125)
+ (num-test #d#i-1.1e-2 -0.011)
+ (num-test #e#b1e-10 1/1024)
+ (num-test #e#b+1.1 3/2)
+ (num-test #e#o+1.1 9/8)
+ (num-test #e#d+1.1 11/10)
+ (num-test #e#x+1.1 17/16)
+ (num-test #e#b+1.1e+2 6)
+ (num-test #e#o+1.1e+2 72)
+ (num-test #e#d+1.1e+2 110)
+ (num-test #i#b.001 0.125)
+ (num-test #i#b000000000011 3.0)
+ (num-test #i#b-000000000011e1 -6.0)
+ (num-test #i#b-000000000011e+11 -6144.0)
+ ;;(num-test #b#e0+i 0+1i) ; these 2 are now read-errors (#e0+i is an error because inexact->exact does not accept complex args in s7)
+ ;;(num-test #b#e0+1.1i 0+1.5i)
+ (test (string->number "#b#e0+i") #f)
+ (num-test #i#xf/c 1.25)
+ (num-test #e#x1.4 5/4)
+ (num-test #e2/3 2/3)
+ (num-test #b#e+.1e+1 1)
+ (num-test #b#e.011-0.i 3/8)
+ (num-test #b#i1.1e0-.0i 1.5)
+ (num-test #b#e1.1e0-.0i 3/2)
+ (num-test #b#e-1.00e+001 -2)
+ (num-test #b#e+.01011100 23/64)
+ (num-test #b#i-00-0/001i 0.0)
+ (num-test #e#x1234/12 (string->number "#x#e1234/12"))
+ (num-test #x#e.1 #e#x.1))
+
(num-test #e-.0 0)
(num-test #e-123.0 -123)
(num-test #i-123 -123.0)
(num-test #e+123.0 123)
(num-test #i+123 123.0)
-
-(num-test #b#e1.1e2 6)
-(num-test #o#e1.1e2 72)
-(num-test #d#e1.1e2 110)
-
-(num-test #b#i-1.1e-2 -0.375)
-(num-test #o#i-1.1e-2 -0.017578125)
-(num-test #d#i-1.1e-2 -0.011)
(num-test #i-0 0.0)
(num-test #e-0.0 0)
;;; in guile #e1e-10 is 7737125245533627/77371252455336267181195264
-(num-test #e#b1e-10 1/1024)
-
-(num-test #e#b+1.1 3/2)
-(num-test #e#o+1.1 9/8)
-(num-test #e#d+1.1 11/10)
-(num-test #e#x+1.1 17/16)
-
-(num-test #e#b+1.1e+2 6)
-(num-test #e#o+1.1e+2 72)
-(num-test #e#d+1.1e+2 110)
-
-(num-test #i#b.001 0.125)
-(num-test #i#b000000000011 3.0)
-(num-test #i#b-000000000011e1 -6.0)
-(num-test #i#b-000000000011e+11 -6144.0)
(num-test #x-AAF -2735)
(num-test #x-aAf -2735)
(num-test #b1+1.1i 1+1.5i) ; yow...
-;(num-test #b#e0+i 0+1i) ; these 2 are now read-errors
-;(num-test #b#e0+1.1i 0+1.5i)
-
(num-test #xf/c 5/4)
(num-test #x+f/c 5/4)
(num-test #x-f/c -5/4)
-(num-test #i#xf/c 1.25)
-(num-test #e#x1.4 5/4)
(num-test #d1/2 1/2)
-(num-test #e2/3 2/3)
;; nutty: #e+inf.0 #e+nan.0
;; these don't arise in s7 because we don't define inf.0 and nan.0
@@ -60781,8 +77217,6 @@ etc....
(num-test #o777777777777777777777/7 1317624576693539401)
(num-test #x7fffffffffffffff/7 1317624576693539401)
(num-test (string->number "#x1234/12") (string->number "1234/12" 16))
-(num-test #e#x1234/12 (string->number "#x#e1234/12"))
-(num-test #x#e.1 #e#x.1)
(num-test #d#i1/10 #i#d1/10)
(test (equal? 0.0 #b0e0) #t)
@@ -60831,39 +77265,34 @@ etc....
(num-test #b0/01 0)
(num-test #b-0/1 0)
(num-test #b1.+.1i 1+0.5i)
-(num-test #b#i0-0i 0.0)
-(num-test #b#e1e01 2)
-(num-test #b#e1e-0 1)
(num-test 1e-0 1.0)
-(num-test #b#e11e-1 3/2)
+(when (not pure-s7)
+ (num-test #b#i0-0i 0.0)
+ (num-test #b#e1e01 2)
+ (num-test #b#e1e-0 1)
+ (num-test #b#e11e-1 3/2)
+ ;;(num-test #b#e-0/1+i 0+1i)
+ (test (string->number "#b#e-1/1+01.1e1i") #f)
+ (test (string->number "#d#i0/0") #f)
+ (test (string->number "#i#x0/0") #f)
+ (test (exact? #i#b1) #f)
+ (test (exact? #e#b1) #t)
+ (num-test #x#e1.5 21/16)
+ (num-test #x#i3 3.0))
+
(num-test #b0100/10 2)
(num-test #b0e+1-0.i 0.0)
(num-test #b.1-0/01i 0.5)
-;(num-test #b#e-0/1+i 0+1i)
(num-test #b0e+1-0.i 0.0)
-(num-test #b#e+.1e+1 1)
(num-test #b1.+01.e+1i 1+2i)
-(num-test #b#e.011-0.i 3/8)
-(num-test #b#i1.1e0-.0i 1.5)
-(num-test #b#e1.1e0-.0i 3/2)
(num-test #b0+.0e10101i 0.0)
-(num-test #b#e-1.00e+001 -2)
-(num-test #b#e+.01011100 23/64)
-(num-test #b#i-00-0/001i 0.0)
(num-test #b00e+0-.00e11i 0.0)
(num-test #b-000e+10110001 0.0)
-(test (string->number "#b#e-1/1+01.1e1i") #f)
-(test (string->number "#d#i0/0") #f)
-(test (string->number "#i#x0/0") #f)
(test (exact? #i1) #f)
(test (exact? #e1.0) #t)
(test (exact? #i1.0) #f)
(test (exact? #e1) #t)
-(test (exact? #i#b1) #f)
-(test (exact? #e#b1) #t)
-(num-test #x#e1.5 21/16)
-(num-test #x#i3 3.0)
(test (number? ''1) #f)
(test (symbol? ''1) #f)
(test (string->number "''1") #f)
@@ -60879,12 +77308,14 @@ etc....
(test (number? '00-) #f)
(test (string->number "00-") #f)
+(if pure-s7 (exit)) ; no way to go on...
+
(num-test #e0.1 1/10)
+(num-test #x#if 15.0)
(num-test #i1/1 1.0)
(num-test #o-11 -9)
(num-test #o-0. 0.0)
(num-test #o+.0 0.0)
-(num-test #x#if 15.0)
(num-test #xe/1 14)
(num-test #xe/a 7/5)
(num-test #xfad 4013)
@@ -61006,23 +77437,23 @@ etc....
(let ((rad (+ 2 (random 15))))
(let ((str (make-number rad)))
(if (not (number? (string->number str rad)))
- (format #t ";trouble in string->number ~A ~S: ~A~%"
+ (format-logged #t ";(1) trouble in string->number ~A ~S: ~A~%"
rad str
(string->number str rad))
(if (not (string? (number->string (string->number str rad) rad)))
- (format #t ";trouble in number->string ~A ~S: ~A ~S~%"
+ (format-logged #t ";(2) trouble in number->string ~A ~S: ~A ~S~%"
rad str
(string->number str rad)
(number->string (string->number str rad) rad))
(if (not (number? (string->number (number->string (string->number str rad) rad) rad)))
- (format #t ";trouble in (3) number->string ~A ~S: ~A ~S ~A~%"
+ (format-logged #t ";(3) trouble in number->string ~A ~S: ~A ~S ~A~%"
rad str
(string->number str rad)
(number->string (string->number str rad) rad)
(string->number (number->string (string->number str rad) rad) rad))
(let ((diff (abs (- (string->number (number->string (string->number str rad) rad) rad) (string->number str rad)))))
- (if (> diff 1e-5)
- (format #t "(string->number ~S ~D): ~A, n->s: ~S, s->n: ~A, diff: ~A~%"
+ (if (> diff 2e-5)
+ (format-logged #t "(string->number ~S ~D): ~A, n->s: ~S, s->n: ~A, diff: ~A~%"
str rad
(string->number str rad)
(number->string (string->number str rad) rad)
@@ -61036,7 +77467,7 @@ etc....
((= i len))
(if (and (not (char=? (str i) #\.))
(>= (string->number (string (str i)) 16) radix))
- (format #t ";~S in base ~D has ~C?" str radix (str i))))))
+ (format-logged #t ";~S in base ~D has ~C?" str radix (str i))))))
(no-char (number->string (* 1.0 2/3) 9) 9)
(no-char (number->string (string->number "0.05" 9) 9) 9)
@@ -61058,15 +77489,15 @@ etc....
(if (not (eqv? 3/4 (string->number (number->string 3/4 i) i)))
(begin
(set! happy #f)
- (format #t ";(string<->number 3/4 ~A) -> ~A?~%" i (string->number (number->string 3/4 i) i))))
+ (format-logged #t ";(string<->number 3/4 ~A) -> ~A?~%" i (string->number (number->string 3/4 i) i))))
(if (not (eqv? 1234/11 (string->number (number->string 1234/11 i) i)))
(begin
(set! happy #f)
- (format #t ";(string<->number 1234/11 ~A) -> ~A?~%" i (string->number (number->string 1234/11 i) i))))
+ (format-logged #t ";(string<->number 1234/11 ~A) -> ~A?~%" i (string->number (number->string 1234/11 i) i))))
(if (not (eqv? -1234/11 (string->number (number->string -1234/11 i) i)))
(begin
(set! happy #f)
- (format #t ";(string<->number -1234/11 ~A) -> ~A?~%" i (string->number (number->string -1234/11 i) i))))))
+ (format-logged #t ";(string<->number -1234/11 ~A) -> ~A?~%" i (string->number (number->string -1234/11 i) i))))))
(test (< (abs (- (string->number "3.1415926535897932384626433832795029") 3.1415926535897932384626433832795029)) 1e-7) #t)
@@ -61184,64 +77615,17 @@ etc....
(test (string->number "+.e1") #f)
(test (string->number ".e1") #f)
-(num-test (string->number "1\ 2") 12)
-(num-test (string->number "\ \x30\ ") 0)
-(num-test (string->number "\ \x31\ /\ \x32\ ") 1/2)
-(num-test (string->number "\ \ 4\ 3\ /43\ ") 1)
-(num-test (string->number "+\x36\ 4/\x36\ \ 4") 1)
-(num-test (string->number "\ +\ \x33\ 4/3\ 4") 1)
-(num-test (string->number "#x\x34\ 4\ /\ 44") 1)
-(num-test (string->number "+\x30\ \ \ \ \x33/3") 1)
-(num-test (string->number "4\ 4/\ \ 4\x34\ ") 1)
-(num-test (string->number "4\ \ \ /\ \ \ \x34") 1)
-(num-test (string->number "\ 3\x34\ /\ 3\ 4") 1)
-(num-test (string->number "\ #\ x\ \x34/\x30\x34") 1)
-(num-test (string->number "3\ /\ \x33\ \ ") 1)
-(num-test (string->number "\ 3\ /\x32\ ") 3/2)
-(num-test (string->number "\ \ +\ 3/\ \x32") 3/2)
-(num-test (string->number "#\ x\x36/4") 3/2)
-(num-test (string->number "#x\x38/\ 4\ \ ") 2)
(num-test (string->number "4\x32\x37") 427)
(num-test (string->number "\x32.\x39") 2.9)
-(num-test (string->number "\ 4\ e\x32\ ") 400.0)
-(num-test (string->number "#i\x32\x38\x36\ ") 286.0)
-(num-test (string->number "#\ i.3\ ") 0.3)
+(num-test (string->number "#i\x32\x38\x36") 286.0)
(num-test (string->number "4\x31+3\x36i") 41+36i)
-(num-test (string->number "34\ \ \ /4\ \x32\x32") 17/211)
-(num-test (string->number "#x4\ 4\ e\ /4") 551/2)
-(num-test (string->number "\ \ #\ x33\x34/\x33") 820/3)
-(num-test (string->number ".\ 44\ \ e\ -\ \ \x36\ \ ") 4.4e-07)
-(num-test (string->number "#\ \ x34\ 4\ \x38\ +4i") 13384+4i)
-(num-test (string->number "#i\x31.\ 4+\ \x39\ .\ \ i") 1.4+9i)
-(num-test (string->number "#\ \ x#i\ \x38\x31+4\ 4i") 129+68i)
-(num-test (string->number "#i\ #x4\ \x37\ -4/\ 4\ i") 71-1i)
-
-(num-test (string->number "12\
-34.\ \
-56") 1234.56)
-(num-test (string->number "12\
-\ 34\
-.\
-\
-5\ 6") 1234.56)
-(for-each
- (lambda (i)
- (test (eval-string (format #f "(string->number \"~A\")" (string #\1 #\\ (integer->char i) #\2))) 12))
- (list 9 10 11 12 13 32))
-
-
-(if with-bignums
- (begin
- (num-test (string->number "101461074055444526136" 8) 1181671265888545886)
- (num-test (string->number "-67330507011755171566102306711560321" 8) -35128577239298592313751007322321)
- (num-test (string->number "35215052773447206642040260+177402503313573563274751i" 8) 1.38249897923920622272688E23+1.176027342049207220713E21i))
- (begin
- (test (or (nan? -22161050056534423736715535510711123)
- (infinite? -22161050056534423736715535510711123))
- #t)
- ;; there is some randomness here: 1.0e309 -> inf, but 1.0e310 -> -nan and others equally scattered
- ))
+(when with-bignums
+ (num-test (string->number "101461074055444526136" 8) 1181671265888545886)
+ (num-test (string->number "-67330507011755171566102306711560321" 8) -35128577239298592313751007322321)
+ (num-test (string->number "35215052773447206642040260+177402503313573563274751i" 8) 1.38249897923920622272688E23+1.176027342049207220713E21i)
+ ;; there is some randomness here: 1.0e309 -> inf, but 1.0e310 -> -nan and others equally scattered
+ )
(test (string=? (substring (number->string pi 16) 0 14) "3.243f6a8885a3") #t)
@@ -61253,7 +77637,7 @@ etc....
(let ((val (string->number (string-append "1" exponent "1") base)))
(if (and (number? val)
(> (abs (- val base)) 1e-9))
- (format #t ";(string->number ~S ~A) returned ~A?~%"
+ (format-logged #t ";(string->number ~S ~A) returned ~A?~%"
(string-append "1" exponent "1") base (string->number (string-append "1" exponent "1") base)))))
(do ((base 2 (+ base 1)))
@@ -61261,7 +77645,7 @@ etc....
(let ((val (string->number (string-append "1.1" exponent "1") base)))
(if (and (number? val)
(> (abs (- val (+ base 1))) 1e-9))
- (format #t ";(string->number ~S ~A) returned ~A?~%"
+ (format-logged #t ";(string->number ~S ~A) returned ~A?~%"
(string-append "1.1" exponent "1") base (string->number (string-append "1.1" exponent "1") base)))))
(do ((base 2 (+ base 1)))
@@ -61269,7 +77653,7 @@ etc....
(let ((val (string->number (string-append "1" exponent "+1") base)))
(if (and (number? val)
(> (abs (- val base)) 1e-9))
- (format #t ";(string->number ~S ~A) returned ~A?~%"
+ (format-logged #t ";(string->number ~S ~A) returned ~A?~%"
(string-append "1" exponent "+1") base (string->number (string-append "1" exponent "+1") base)))))
; in base 16 this is still not a number because of the + (or -)
; but "1e+1i" is a number -- gad!
@@ -61278,8 +77662,8 @@ etc....
((= base 11))
(let ((val (string->number (string-append "1" exponent "-1+1i") base)))
(if (and (number? val)
- (> (magnitude (- val (make-rectangular (/ base) 1))) 1e-6))
- (format #t ";(string->number ~S ~A) returned ~A?~%"
+ (> (magnitude (- val (complex (/ base) 1))) 1e-6))
+ (format-logged #t ";(string->number ~S ~A) returned ~A?~%"
(string-append "1" exponent "-1+1i") base (string->number (string-append "1" exponent "-1+1i") base)))))))
(list #\e #\d #\f #\s #\l))
@@ -61311,7 +77695,7 @@ etc....
(if (> (abs (- val (string->number str i))) 1e-7)
(begin
(set! happy #f)
- (format #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))
+ (format-logged #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))
(let* ((radlim (list 0 0 62 39 31 26 23 22 20 19 18 17 17 16 16 15 15))
(digits "00123456789abcdef"))
@@ -61323,7 +77707,7 @@ etc....
(if (> (abs (- val (string->number str i))) 1e-7)
(begin
(set! happy #f)
- (format #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))))))
+ (format-logged #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val)))))))))
(let ((happy #t))
(do ((i 2 (+ i 1)))
@@ -61332,17 +77716,17 @@ etc....
(if (> (abs (- 0.75 (string->number (number->string 0.75 i) i))) 1e-6)
(begin
(set! happy #f)
- (format #t ";(string->number (number->string 0.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 0.75 i) i))))
+ (format-logged #t ";(string->number (number->string 0.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 0.75 i) i))))
(if (> (abs (- 1234.75 (string->number (number->string 1234.75 i) i))) 1e-6)
(begin
(set! happy #f)
- (format #t ";(string->number (number->string 1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 1234.75 i) i))))
+ (format-logged #t ";(string->number (number->string 1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 1234.75 i) i))))
(if (> (abs (- -1234.25 (string->number (number->string -1234.25 i) i))) 1e-6)
(begin
(set! happy #f)
- (format #t ";(string->number (number->string -1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string -1234.75 i) i))))
+ (format-logged #t ";(string->number (number->string -1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string -1234.75 i) i))))
(let ((val (string->number (number->string 12.5+3.75i i) i)))
(if (or (not (number? val))
@@ -61350,7 +77734,7 @@ etc....
(> (abs (- (imag-part val) 3.75)) 1e-6))
(begin
(set! happy #f)
- (format #t ";(string->number (number->string 12.5+3.75i ~A) ~A) -> ~A?~%" i i (string->number (number->string 12.5+3.75i i) i)))))
+ (format-logged #t ";(string->number (number->string 12.5+3.75i ~A) ~A) -> ~A?~%" i i (string->number (number->string 12.5+3.75i i) i)))))
(let ((happy #t))
(do ((base 2 (+ base 1)))
@@ -61362,7 +77746,7 @@ etc....
(im (- (random 200.0) 100.0))
(rlstr (number->string rl base))
(imstr (number->string im base))
- (val (make-rectangular rl im))
+ (val (complex rl im))
(str (string-append rlstr
(if (or (negative? im)
(char=? (string-ref imstr 0) #\-)) ; sigh -- -0.0 is not negative!
@@ -61377,7 +77761,7 @@ etc....
(> (abs (- (imag-part nval) (imag-part val))) 1e-3))
(begin
(set! happy #f)
- (format #t ";(number<->string ~S ~A) -> ~A? [~A ~S]~%" str base nval sn nsn)
+ (format-logged #t ";(number<->string ~S ~A) -> ~A? [~A ~S]~%" str base nval sn nsn)
)))))))))
@@ -61415,7 +77799,7 @@ etc....
(set! j (make-integer str (+ j 1) (+ 1 (random edigits)) radix #t))))
j))
- (define (make-complex str j digits edigits radix)
+ (define (complex str j digits edigits radix)
(set! j (make-real str j digits edigits radix))
(set! (str j) (#(#\+ #\-) (random 2)))
(set! j (make-real str (+ j 1) digits edigits radix))
@@ -61466,7 +77850,7 @@ etc....
((integer) (make-integer str j (+ 1 (random max-digits)) radix #t))
((ratio) (make-ratio str j (random max-digits) (random max-digits) radix))
((real) (make-real str j max-digits edigits radix))
- ((complex) (make-complex str j max-digits edigits radix))))
+ ((complex) (complex str j max-digits edigits radix))))
(let ((num (catch #t (lambda () (string->number (substring str 0 j) radix)) (lambda args 'error))))
(if (not (number? num))
@@ -61818,50 +78202,51 @@ etc....
+0001.e0 0000001. +000001.))
(lambda args 'error))))
(if (not (eq? val #t))
- (format #t ";funny 1's are not all equal to 1? ~A~%" val)))
+ (format-logged #t ";funny 1's are not all equal to 1? ~A~%" val)))
-
-(for-each
- (lambda (lst)
- (for-each
- (lambda (str)
- (let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
- (if (or (not (number? val))
- (> (abs (- val 1.0)) 1.0e-15))
- (format #t ";(string->number ~S) = ~A?~%" str val))))
- lst))
- (list
- (list "1")
-
- (list "01" "+1" "1.")
-
- (list "001" "+01" "#e1" "#i1" "1/1" "#b1" "#x1" "#d1" "#o1" "1.0" "1e0" "9/9" "01." "+1." "1E0")
-
- (list "0001" "+001" "#e01" "#i01" "1/01" "#b01" "#x01" "#d01" "#o01" "#e+1" "#i+1" "#b+1" "#x+1" "#d+1" "#o+1" ".1e1" "01/1" "+1/1" "1.00" "1e00" "01.0" "+1.0" "1e+0" "1e-0" "01e0" "+1e0" "1.e0" "9/09" "09/9" "+9/9" "001." "+01." "#e1." "#i1." "1+0i" "1-0i" "#d1.")
-
- (list "11/11" "00001" "+0001" "#e001" "#i001" "1/001" "#b001" "#x001" "#d001" "#o001" "#e+01" "#i+01" "#b+01" "#x+01" "#d+01" "#o+01" ".1e01" "01/01" "+1/01" "91/91" ".1e+1" "10e-1" "0.1e1" "+.1e1" ".10e1" "#b#e1" "#x#e1" "#d#e1" "#o#e1" "#b#i1" "#x#i1" "#d#i1" "#o#i1" "001/1" "+01/1" "#e1/1" "#i1/1" "#b1/1" "#x1/1" "#d1/1" "#o1/1" "#e#b1" "#i#b1" "#e#x1" "#i#x1" "#e#d1" "#i#d1" "#e#o1" "#i#o1" "10/10" "1.000" "1e000" "01.00" "+1.00" "1e+00" "1e-00" "01e00" "+1e00" "1.e00" "90/90" "001.0" "+01.0" "#e1.0" "#i1.0" "01e+0" "+1e+0" "1.e+0" "01e-0" "+1e-0" "1.e-0" "001e0" "+01e0" "#e1e0" "#i1e0" "1.0e0" "01.e0" "+1.e0" "19/19" "9/009" "09/09" "+9/09" "99/99" "009/9" "+09/9" "#e9/9" "#i9/9" "#x9/9" "#d9/9" "0001." "+001." "#e01." "#i01." "#e+1." "#i+1." "#xe/e" "1+00i" "1-00i" "1+.0i" "1-.0i" "01+0i" "+1+0i" "1.+0i" "01-0i" "+1-0i" "1.-0i" "1+0.i" "1-0.i" "#xb/b" "#xd/d" "#xf/f")
-
- ;; remove "9":
-
- (list "11/011" "011/11" "+11/11" "000001" "+00001" "#e0001" "#i0001" "1/0001" "#b0001" "#x0001" "#d0001" "#o0001" "#e+001" "#i+001" "#b+001" "#x+001" "#d+001" "#o+001" ".1e001" "01/001" "+1/001" ".1e+01" "10e-01" "0.1e01" "+.1e01" ".10e01" "#b#e01" "#x#e01" "#d#e01" "#o#e01" "#b#i01" "#x#i01" "#d#i01" "#o#i01" "001/01" "+01/01" "#e1/01" "#i1/01" "#b1/01" "#x1/01" "#d1/01" "#o1/01" "#e#b01" "#i#b01" "#e#x01" "#i#x01" "#e#d01" "#i#d01" "#e#o01" "#i#o01" "0.1e+1" "+.1e+1" ".10e+1" "#b#e+1" "#x#e+1" "#d#e+1" "#o#e+1" "#b#i+1" "#x#i+1" "#d#i+1" "#o#i+1" "#e#b+1" "#i#b+1" "#e#x+1" "#i#x+1" "#e#d+1" "#i#d+1" "#e#o+1" "#i#o+1" "010e-1" "+10e-1" "10.e-1" "00.1e1" "+0.1e1" "#e.1e1" "#i.1e1" "0.10e1" "+.10e1" ".100e1" "0001/1" "+001/1" "#e01/1" "#i01/1" "#b01/1" "#x01/1" "#d01/1" "#o01/1" "#e+1/1" "#i+1/1" "#b+1/1" "#x+1/1" "#d+1/1" "#o+1/1" "10/010" "010/10" "+10/10" "1.0000" "1e0000" "01.000" "+1.000" "1e+000" "1e-000" "01e000" "+1e000" "1.e000" "001.00" "+01.00" "#e1.00" "#i1.00" "01e+00" "+1e+00" "1.e+00" "01e-00" "+1e-00" "1.e-00" "001e00" "+01e00" "#e1e00" "#i1e00" "1.0e00" "01.e00" "+1.e00" "0001.0" "+001.0" "#e01.0" "#i01.0" "#e+1.0" "#i+1.0" "001e+0" "+01e+0" "#e1e+0" "#i1e+0" "1.0e+0" "01.e+0" "+1.e+0" "001e-0" "+01e-0" "#e1e-0" "#i1e-0" "1.0e-0" "01.e-0" "+1.e-0" "0001e0" "+001e0" "#e01e0" "#i01e0" "#e+1e0" "#i+1e0" "1.00e0" "01.0e0" "+1.0e0" "001.e0" "+01.e0" "#e1.e0" "#i1.e0" "00001." "+0001." "#e001." "#i001." "#e+01." "#i+01." "#xe/0e" "#x0e/e" "#x+e/e" "1+0e1i" "1-0e1i" "1+0/1i" "1-0/1i" "1+000i" "1-000i" "1+.00i" "1-.00i" "01+00i" "+1+00i" "1.+00i" "01-00i" "+1-00i" "1.-00i" "1+0.0i" "1-0.0i" "01+.0i" "+1+.0i" "1.+.0i" "01-.0i" "+1-.0i" "1.-.0i" "001+0i" "+01+0i" "#e1+0i" "#i1+0i" "1/1+0i" "1.0+0i" "1e0+0i" "01.+0i" "+1.+0i" "001-0i" "+01-0i" "#e1-0i" "#i1-0i" "1/1-0i" "1.0-0i" "1e0-0i" "01.-0i" "+1.-0i" "1+0e0i" "1-0e0i" "1+00.i" "1-00.i" "01+0.i" "+1+0.i" "1.+0.i" "01-0.i" "+1-0.i" "1.-0.i" "#xb/0b" "#x0b/b" "#x+b/b" "#xd/0d" "#x0d/d" "#x+d/d" "#xf/0f" "#x0f/f" "#x+f/f")
-
- (list "111/111" "11/0011" "011/011" "+11/011" "0011/11" "+011/11" "#e11/11" "#i11/11" "#b11/11" "#x11/11" "#d11/11" "#o11/11" "101/101" "0000001" "+000001" "#e00001" "#i00001" "1/00001" "#b00001" "#x00001" "#d00001" "#o00001" "#e+0001" "#i+0001" "#b+0001" "#x+0001" "#d+0001" "#o+0001" ".1e0001" "01/0001" "+1/0001" ".1e+001" "10e-001" "0.1e001" "+.1e001" ".10e001" "#b#e001" "#x#e001" "#d#e001" "#o#e001" "#b#i001" "#x#i001" "#d#i001" "#o#i001" "001/001" "+01/001" "#e1/001" "#i1/001" "#b1/001" "#x1/001" "#d1/001" "#o1/001" "#e#b001" "#i#b001" "#e#x001" "#i#x001" "#e#d001" "#i#d001" "#e#o001" "#i#o001" "0.1e+01" "+.1e+01" ".10e+01" "#b#e+01" "#x#e+01" "#d#e+01" "#o#e+01" "#b#i+01" "#x#i+01" "#d#i+01" "#o#i+01" "#e#b+01" "#i#b+01" "#e#x+01" "#i#x+01" "#e#d+01" "#i#d+01" "#e#o+01" "#i#o+01" "010e-01" "+10e-01" "10.e-01" "1.00000" "1e00000" "01.0000" "+1.0000" "1e+0000" "1e-0000" "01e0000" "+1e0000" "1.e0000" "001.000" "+01.000" "#e1.000" "#i1.000" "#d1.000" "01e+000" "+1e+000" "1.e+000" "01e-000" "+1e-000" "1.e-000" "001e000" "+01e000" "#e1e000" "#i1e000" "#d1e000" "1.0e000" "+1.e000" "0001.00" "+001.00" "#e01.00" "#i01.00" "#d01.00" "#e+1.00" "#i+1.00" "#d+1.00" "001e+00" "+01e+00" "#e1e+00" "#i1e+00" "#d1e+00" "1.0e+00" "01.e+00" "+1.e+00" "001e-00" "+01e-00" "#e1e-00" "#i1e-00" "#d1e-00" "1.0e-00" "01.e-00" "+1.e-00" "000001." "+00001." "#e0001." "#i0001." "#d0001." "#e+001." "#i+001." "#d+001." "#d#e01." "#d#i01." "#e#d01." "#i#d01." "#d#e+1." "#d#i+1." "#e#d+1." "#i#d+1." "#x1e/1e" "#xe/00e" "#x0e/0e" "#x+e/0e" "#xee/ee" "#x00e/e" "#x+0e/e" "#x#ee/e" "#x#ie/e" "#e#xe/e" "#i#xe/e" "#xbe/be" "#xde/de" "1+0e11i" "1-0e11i" "1+0/11i" "1-0/11i" "1+0e01i" "1-0e01i" "1+0/01i" "1-0/01i" "1+0e+1i" "1-0e+1i" "1+0e-1i" "1-0e-1i" "1+00e1i" "1-00e1i" "1+.0e1i" "1-.0e1i" "01+0e1i" "+1+0e1i" "1.+0e1i" "01-0e1i" "+1-0e1i" "1.-0e1i" "1+0.e1i" "1-0.e1i" "1+00/1i" "1-00/1i" "01+0/1i" "+1+0/1i" "1.+0/1i" "01-0/1i" "+1-0/1i" "1.-0/1i" "1+0e10i" "1-0e10i" "1+0/10i" "1-0/10i" "1+0000i" "1-0000i" "1+.000i" "1-.000i" "01+000i" "+1+000i" "1.+000i" "01-000i" "+1-000i" "1.-000i" "1+0.00i" "1-0.00i" "01+.00i" "+1+.00i" "1.+.00i" "01-.00i" "+1-.00i" "1.-.00i" "001+00i" "+01+00i" "#e1+00i" "#i1+00i" "1/1+00i" "#b1+00i" "#x1+00i" "#d1+00i" "#o1+00i" "1.0+00i" "1e0+00i" "01.+00i" "+1.+00i" "001-00i" "+01-00i" "#e1-00i" "#i1-00i" "1/1-00i" "#b1-00i" "#x1-00i" "#d1-00i" "#o1-00i" "1.0-00i" "1e0-00i" "01.-00i" "+1.-00i" "1+0e00i" "1-0e00i" "1+00.0i" "1-00.0i" "01+0.0i" "+1+0.0i" "1.+0.0i" "01-0.0i" "+1-0.0i" "1.-0.0i" "001+.0i" "+01+.0i" "#e1+.0i" "#i1+.0i" "1/1+.0i" "#d1+.0i" "1.0+.0i" "1e0+.0i" "01.+.0i" "+1.+.0i" "001-.0i" "+01-.0i" "#e1-.0i" "#i1-.0i" "1/1-.0i" "#d1-.0i" "1.0-.0i" "1e0-.0i" "01.-.0i" "+1.-.0i" "0001+0i" "+001+0i" "#e01+0i" "#i01+0i" "1/01+0i" "#b01+0i" "#x01+0i" "#d01+0i" "#o01+0i" "#e+1+0i" "#i+1+0i" "#b+1+0i" "#x+1+0i" "#d+1+0i" "#o+1+0i" ".1e1+0i" "01/1+0i" "+1/1+0i" "1.00+0i" "1e00+0i" "01.0+0i" "+1.0+0i" "1e+0+0i" "1e-0+0i" "01e0+0i" "+1e0+0i" "1.e0+0i" "001.+0i" "+01.+0i" "#e1.+0i" "#i1.+0i" "#d1.+0i" "1+0e+0i" "1-0e+0i" "0001-0i" "+001-0i" "#e01-0i" "#i01-0i" "1/01-0i" "#b01-0i" "#x01-0i" "#d01-0i" "#o01-0i" "#e+1-0i" "#i+1-0i" "#b+1-0i" "#x+1-0i" "#d+1-0i" "#o+1-0i" ".1e1-0i" "01/1-0i" "+1/1-0i" "1.00-0i" "1e00-0i" "01.0-0i" "+1.0-0i" "1e+0-0i" "1e-0-0i" "01e0-0i" "+1e0-0i" "1.e0-0i" "001.-0i" "+01.-0i" "#e1.-0i" "#i1.-0i" "#d1.-0i" "1+0e-0i" "1-0e-0i" "1+00e0i" "1-00e0i" "1+.0e0i" "1-.0e0i" "01+0e0i" "+1+0e0i" "1.+0e0i" "01-0e0i" "+1-0e0i" "1.-0e0i" "1+0.e0i" "1-0.e0i" "1+000.i" "1-000.i" "01+00.i" "+1+00.i" "1.+00.i" "01-00.i" "+1-00.i" "1.-00.i" "001+0.i" "+01+0.i" "#e1+0.i" "#i1+0.i" "1/1+0.i" "#d1+0.i" "1.0+0.i" "1e0+0.i" "+1.+0.i" "001-0.i" "+01-0.i" "#e1-0.i" "#i1-0.i" "1/1-0.i" "#d1-0.i" "1.0-0.i" "1e0-0.i" "01.-0.i" "+1.-0.i" "#xb/00b" "#x0b/0b" "#x+b/0b" "#xeb/eb" "#x00b/b" "#x+0b/b" "#x#eb/b" "#x#ib/b" "#e#xb/b" "#i#xb/b" "#xbb/bb" "#xdb/db" "#xd/00d" "#x0d/0d" "#x+d/0d" "#xed/ed")
-
+(do ((i 0 (+ i 1)))
+ ((= i 30))
+ (for-each
+ (lambda (lst)
+ (for-each
+ (lambda (str)
+ (let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
+ (if (or (not (number? val))
+ (> (abs (- val 1.0)) 1.0e-15))
+ (format-logged #t ";(string->number ~S) = ~A?~%" str val))))
+ lst))
+ (list
+ (list "1")
+
+ (list "01" "+1" "1.")
+
+ (list "001" "+01" "#e1" "#i1" "1/1" "#b1" "#x1" "#d1" "#o1" "1.0" "1e0" "9/9" "01." "+1." "1E0")
+
+ (list "0001" "+001" "#e01" "#i01" "1/01" "#b01" "#x01" "#d01" "#o01" "#e+1" "#i+1" "#b+1" "#x+1" "#d+1" "#o+1" ".1e1" "01/1" "+1/1" "1.00" "1e00" "01.0" "+1.0" "1e+0" "1e-0" "01e0" "+1e0" "1.e0" "9/09" "09/9" "+9/9" "001." "+01." "#e1." "#i1." "1+0i" "1-0i" "#d1.")
+
+ (list "11/11" "00001" "+0001" "#e001" "#i001" "1/001" "#b001" "#x001" "#d001" "#o001" "#e+01" "#i+01" "#b+01" "#x+01" "#d+01" "#o+01" ".1e01" "01/01" "+1/01" "91/91" ".1e+1" "10e-1" "0.1e1" "+.1e1" ".10e1" "#b#e1" "#x#e1" "#d#e1" "#o#e1" "#b#i1" "#x#i1" "#d#i1" "#o#i1" "001/1" "+01/1" "#e1/1" "#i1/1" "#b1/1" "#x1/1" "#d1/1" "#o1/1" "#e#b1" "#i#b1" "#e#x1" "#i#x1" "#e#d1" "#i#d1" "#e#o1" "#i#o1" "10/10" "1.000" "1e000" "01.00" "+1.00" "1e+00" "1e-00" "01e00" "+1e00" "1.e00" "90/90" "001.0" "+01.0" "#e1.0" "#i1.0" "01e+0" "+1e+0" "1.e+0" "01e-0" "+1e-0" "1.e-0" "001e0" "+01e0" "#e1e0" "#i1e0" "1.0e0" "01.e0" "+1.e0" "19/19" "9/009" "09/09" "+9/09" "99/99" "009/9" "+09/9" "#e9/9" "#i9/9" "#x9/9" "#d9/9" "0001." "+001." "#e01." "#i01." "#e+1." "#i+1." "#xe/e" "1+00i" "1-00i" "1+.0i" "1-.0i" "01+0i" "+1+0i" "1.+0i" "01-0i" "+1-0i" "1.-0i" "1+0.i" "1-0.i" "#xb/b" "#xd/d" "#xf/f")
+
+ ;; remove "9":
+
+ (list "11/011" "011/11" "+11/11" "000001" "+00001" "#e0001" "#i0001" "1/0001" "#b0001" "#x0001" "#d0001" "#o0001" "#e+001" "#i+001" "#b+001" "#x+001" "#d+001" "#o+001" ".1e001" "01/001" "+1/001" ".1e+01" "10e-01" "0.1e01" "+.1e01" ".10e01" "#b#e01" "#x#e01" "#d#e01" "#o#e01" "#b#i01" "#x#i01" "#d#i01" "#o#i01" "001/01" "+01/01" "#e1/01" "#i1/01" "#b1/01" "#x1/01" "#d1/01" "#o1/01" "#e#b01" "#i#b01" "#e#x01" "#i#x01" "#e#d01" "#i#d01" "#e#o01" "#i#o01" "0.1e+1" "+.1e+1" ".10e+1" "#b#e+1" "#x#e+1" "#d#e+1" "#o#e+1" "#b#i+1" "#x#i+1" "#d#i+1" "#o#i+1" "#e#b+1" "#i#b+1" "#e#x+1" "#i#x+1" "#e#d+1" "#i#d+1" "#e#o+1" "#i#o+1" "010e-1" "+10e-1" "10.e-1" "00.1e1" "+0.1e1" "#e.1e1" "#i.1e1" "0.10e1" "+.10e1" ".100e1" "0001/1" "+001/1" "#e01/1" "#i01/1" "#b01/1" "#x01/1" "#d01/1" "#o01/1" "#e+1/1" "#i+1/1" "#b+1/1" "#x+1/1" "#d+1/1" "#o+1/1" "10/010" "010/10" "+10/10" "1.0000" "1e0000" "01.000" "+1.000" "1e+000" "1e-000" "01e000" "+1e000" "1.e000" "001.00" "+01.00" "#e1.00" "#i1.00" "01e+00" "+1e+00" "1.e+00" "01e-00" "+1e-00" "1.e-00" "001e00" "+01e00" "#e1e00" "#i1e00" "1.0e00" "01.e00" "+1.e00" "0001.0" "+001.0" "#e01.0" "#i01.0" "#e+1.0" "#i+1.0" "001e+0" "+01e+0" "#e1e+0" "#i1e+0" "1.0e+0" "01.e+0" "+1.e+0" "001e-0" "+01e-0" "#e1e-0" "#i1e-0" "1.0e-0" "01.e-0" "+1.e-0" "0001e0" "+001e0" "#e01e0" "#i01e0" "#e+1e0" "#i+1e0" "1.00e0" "01.0e0" "+1.0e0" "001.e0" "+01.e0" "#e1.e0" "#i1.e0" "00001." "+0001." "#e001." "#i001." "#e+01." "#i+01." "#xe/0e" "#x0e/e" "#x+e/e" "1+0e1i" "1-0e1i" "1+0/1i" "1-0/1i" "1+000i" "1-000i" "1+.00i" "1-.00i" "01+00i" "+1+00i" "1.+00i" "01-00i" "+1-00i" "1.-00i" "1+0.0i" "1-0.0i" "01+.0i" "+1+.0i" "1.+.0i" "01-.0i" "+1-.0i" "1.-.0i" "001+0i" "+01+0i" "#e1+0i" "#i1+0i" "1/1+0i" "1.0+0i" "1e0+0i" "01.+0i" "+1.+0i" "001-0i" "+01-0i" "#e1-0i" "#i1-0i" "1/1-0i" "1.0-0i" "1e0-0i" "01.-0i" "+1.-0i" "1+0e0i" "1-0e0i" "1+00.i" "1-00.i" "01+0.i" "+1+0.i" "1.+0.i" "01-0.i" "+1-0.i" "1.-0.i" "#xb/0b" "#x0b/b" "#x+b/b" "#xd/0d" "#x0d/d" "#x+d/d" "#xf/0f" "#x0f/f" "#x+f/f")
+
+ (list "111/111" "11/0011" "011/011" "+11/011" "0011/11" "+011/11" "#e11/11" "#i11/11" "#b11/11" "#x11/11" "#d11/11" "#o11/11" "101/101" "0000001" "+000001" "#e00001" "#i00001" "1/00001" "#b00001" "#x00001" "#d00001" "#o00001" "#e+0001" "#i+0001" "#b+0001" "#x+0001" "#d+0001" "#o+0001" ".1e0001" "01/0001" "+1/0001" ".1e+001" "10e-001" "0.1e001" "+.1e001" ".10e001" "#b#e001" "#x#e001" "#d#e001" "#o#e001" "#b#i001" "#x#i001" "#d#i001" "#o#i001" "001/001" "+01/001" "#e1/001" "#i1/001" "#b1/001" "#x1/001" "#d1/001" "#o1/001" "#e#b001" "#i#b001" "#e#x001" "#i#x001" "#e#d001" "#i#d001" "#e#o001" "#i#o001" "0.1e+01" "+.1e+01" ".10e+01" "#b#e+01" "#x#e+01" "#d#e+01" "#o#e+01" "#b#i+01" "#x#i+01" "#d#i+01" "#o#i+01" "#e#b+01" "#i#b+01" "#e#x+01" "#i#x+01" "#e#d+01" "#i#d+01" "#e#o+01" "#i#o+01" "010e-01" "+10e-01" "10.e-01" "1.00000" "1e00000" "01.0000" "+1.0000" "1e+0000" "1e-0000" "01e0000" "+1e0000" "1.e0000" "001.000" "+01.000" "#e1.000" "#i1.000" "#d1.000" "01e+000" "+1e+000" "1.e+000" "01e-000" "+1e-000" "1.e-000" "001e000" "+01e000" "#e1e000" "#i1e000" "#d1e000" "1.0e000" "+1.e000" "0001.00" "+001.00" "#e01.00" "#i01.00" "#d01.00" "#e+1.00" "#i+1.00" "#d+1.00" "001e+00" "+01e+00" "#e1e+00" "#i1e+00" "#d1e+00" "1.0e+00" "01.e+00" "+1.e+00" "001e-00" "+01e-00" "#e1e-00" "#i1e-00" "#d1e-00" "1.0e-00" "01.e-00" "+1.e-00" "000001." "+00001." "#e0001." "#i0001." "#d0001." "#e+001." "#i+001." "#d+001." "#d#e01." "#d#i01." "#e#d01." "#i#d01." "#d#e+1." "#d#i+1." "#e#d+1." "#i#d+1." "#x1e/1e" "#xe/00e" "#x0e/0e" "#x+e/0e" "#xee/ee" "#x00e/e" "#x+0e/e" "#x#ee/e" "#x#ie/e" "#e#xe/e" "#i#xe/e" "#xbe/be" "#xde/de" "1+0e11i" "1-0e11i" "1+0/11i" "1-0/11i" "1+0e01i" "1-0e01i" "1+0/01i" "1-0/01i" "1+0e+1i" "1-0e+1i" "1+0e-1i" "1-0e-1i" "1+00e1i" "1-00e1i" "1+.0e1i" "1-.0e1i" "01+0e1i" "+1+0e1i" "1.+0e1i" "01-0e1i" "+1-0e1i" "1.-0e1i" "1+0.e1i" "1-0.e1i" "1+00/1i" "1-00/1i" "01+0/1i" "+1+0/1i" "1.+0/1i" "01-0/1i" "+1-0/1i" "1.-0/1i" "1+0e10i" "1-0e10i" "1+0/10i" "1-0/10i" "1+0000i" "1-0000i" "1+.000i" "1-.000i" "01+000i" "+1+000i" "1.+000i" "01-000i" "+1-000i" "1.-000i" "1+0.00i" "1-0.00i" "01+.00i" "+1+.00i" "1.+.00i" "01-.00i" "+1-.00i" "1.-.00i" "001+00i" "+01+00i" "#e1+00i" "#i1+00i" "1/1+00i" "#b1+00i" "#x1+00i" "#d1+00i" "#o1+00i" "1.0+00i" "1e0+00i" "01.+00i" "+1.+00i" "001-00i" "+01-00i" "#e1-00i" "#i1-00i" "1/1-00i" "#b1-00i" "#x1-00i" "#d1-00i" "#o1-00i" "1.0-00i" "1e0-00i" "01.-00i" "+1.-00i" "1+0e00i" "1-0e00i" "1+00.0i" "1-00.0i" "01+0.0i" "+1+0.0i" "1.+0.0i" "01-0.0i" "+1-0.0i" "1.-0.0i" "001+.0i" "+01+.0i" "#e1+.0i" "#i1+.0i" "1/1+.0i" "#d1+.0i" "1.0+.0i" "1e0+.0i" "01.+.0i" "+1.+.0i" "001-.0i" "+01-.0i" "#e1-.0i" "#i1-.0i" "1/1-.0i" "#d1-.0i" "1.0-.0i" "1e0-.0i" "01.-.0i" "+1.-.0i" "0001+0i" "+001+0i" "#e01+0i" "#i01+0i" "1/01+0i" "#b01+0i" "#x01+0i" "#d01+0i" "#o01+0i" "#e+1+0i" "#i+1+0i" "#b+1+0i" "#x+1+0i" "#d+1+0i" "#o+1+0i" ".1e1+0i" "01/1+0i" "+1/1+0i" "1.00+0i" "1e00+0i" "01.0+0i" "+1.0+0i" "1e+0+0i" "1e-0+0i" "01e0+0i" "+1e0+0i" "1.e0+0i" "001.+0i" "+01.+0i" "#e1.+0i" "#i1.+0i" "#d1.+0i" "1+0e+0i" "1-0e+0i" "0001-0i" "+001-0i" "#e01-0i" "#i01-0i" "1/01-0i" "#b01-0i" "#x01-0i" "#d01-0i" "#o01-0i" "#e+1-0i" "#i+1-0i" "#b+1-0i" "#x+1-0i" "#d+1-0i" "#o+1-0i" ".1e1-0i" "01/1-0i" "+1/1-0i" "1.00-0i" "1e00-0i" "01.0-0i" "+1.0-0i" "1e+0-0i" "1e-0-0i" "01e0-0i" "+1e0-0i" "1.e0-0i" "001.-0i" "+01.-0i" "#e1.-0i" "#i1.-0i" "#d1.-0i" "1+0e-0i" "1-0e-0i" "1+00e0i" "1-00e0i" "1+.0e0i" "1-.0e0i" "01+0e0i" "+1+0e0i" "1.+0e0i" "01-0e0i" "+1-0e0i" "1.-0e0i" "1+0.e0i" "1-0.e0i" "1+000.i" "1-000.i" "01+00.i" "+1+00.i" "1.+00.i" "01-00.i" "+1-00.i" "1.-00.i" "001+0.i" "+01+0.i" "#e1+0.i" "#i1+0.i" "1/1+0.i" "#d1+0.i" "1.0+0.i" "1e0+0.i" "+1.+0.i" "001-0.i" "+01-0.i" "#e1-0.i" "#i1-0.i" "1/1-0.i" "#d1-0.i" "1.0-0.i" "1e0-0.i" "01.-0.i" "+1.-0.i" "#xb/00b" "#x0b/0b" "#x+b/0b" "#xeb/eb" "#x00b/b" "#x+0b/b" "#x#eb/b" "#x#ib/b" "#e#xb/b" "#i#xb/b" "#xbb/bb" "#xdb/db" "#xd/00d" "#x0d/0d" "#x+d/0d" "#xed/ed")
+
;;; selected ones...
+
+ (list "#i+11/011" "+101/0101" "#o#e11/11" "#d+11/011" "#e1/0001" "#e#b+001" "#e10e-1"
+ "#x#e1/001" "000000001" "#i+.1e+01" "#d+.1e+01" "00.10e+01" "+0.10e+01" "#e.10e+01" "#i.10e+01" "#d.10e+01"
+ "#e.10e+01" "#i10.0e-01" "+010.e-01" "#e10.e-01" "#e00.1e01" "#e#d.1e01" "#i#d1e0+0e0i"
+ "#e#d10e-1+0e-2i" "#e#d1e0+0e-2i" "#i#d+0.001e+03+0.0e-10i" "#i#d+1/1-0/1i"
+ )
+ )))
- (list "#i+11/011" "+101/0101" "#o#e11/11" "#d+11/011" "#e1/0001" "#e#b+001" "#e10e-1"
- "#x#e1/001" "000000001" "#i+.1e+01" "#d+.1e+01" "00.10e+01" "+0.10e+01" "#e.10e+01" "#i.10e+01" "#d.10e+01"
- "#e.10e+01" "#i10.0e-01" "+010.e-01" "#e10.e-01" "#e00.1e01" "#e#d.1e01" "#i#d1e0+0e0i"
- "#e#d10e-1+0e-2i" "#e#d1e0+0e-2i" "#i#d+0.001e+03+0.0e-10i" "#i#d+1/1-0/1i"
- )
- ))
-
(for-each
(lambda (str)
(let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
(if (or (not (number? val))
(= val 1))
- (format #t ";(string->number ~S = ~A?~%" str val))))
+ (format-logged #t ";(string->number ~S = ~A?~%" str val))))
(list "011e0" "11e-00" "00.e01-i" "+10e10+i" "+1.110+i" "10011-0i" "-000.111" "0.100111" "-11.1111" "10.00011" "110e00+i"
"1e-011+i" "101001+i" "+11e-0-0i" "11+00e+0i" "-11101.-i" "1110e-0-i"))
@@ -61876,7 +78261,7 @@ etc....
(lambda (str)
(let ((val (catch #t (lambda () (string->number str)) (lambda args 'error))))
(if val ;(number? val)
- (format #t ";(string->number ~S) = ~A?~%" str val))))
+ (format-logged #t ";(string->number ~S) = ~A?~%" str val))))
(list "#b#e#e1" "#x#e#e1" "#d#e#e1" "#o#e#e1" "#b#i#e1" "#x#i#e1" "#d#i#e1" "#o#i#e1" "#e#b#e1" "#i#b#e1" "#e#x#e1" "#i#x#e1"
"#e#d#e1" "#i#d#e1" "#e#o#e1" "#i#o#e1" "#e#b#i1" "#e#x#i1" "#e#d#i1" "#e#o#i1" "#b#e#b1" "#x#e#b1" "#d#e#b1" "#o#e#b1"
"#b#i#b1" "#x#i#b1" "#d#i#b1" "#o#i#b1" "#b#e#x1" "#x#e#x1" "#d#e#x1" "#o#e#x1" "#b#i#x1" "#x#i#x1" "#d#i#x1" "#o#i#x1"
@@ -62035,7 +78420,7 @@ etc....
(list '(* 459926601011 (expt 10.0 15)) "4.59926601011e+26") ; 10.0 (and 2.0 above) because we aren't interested here in numeric overflows
)))
(let ((maxdiff 0.0)
- (maxdiff-case '()))
+ (maxdiff-case ()))
(do ((lst cases (cdr lst)))
((null? lst))
(let* ((form (caar lst))
@@ -62047,16 +78432,16 @@ etc....
(mnum (string->number str))
(diff (let ()
(if (not (string? n2s))
- (format #t "(number->string ~A) #f?~%" fnum))
+ (format-logged #t "(number->string ~A) #f?~%" fnum))
(if (not (number? s2n))
- (format #t "(string->number ~S) #f?~%" n2s))
+ (format-logged #t "(string->number ~S) #f?~%" n2s))
(/ (abs (- mnum s2n)) (max (expt 2 -31.0) (abs fnum))))))
(if (> diff maxdiff)
(begin
(set! maxdiff diff)
(set! maxdiff-case (car lst))))))
(if (> maxdiff 1e-15) ; we're only interested in real problems
- (format #t ";number->string rounding checks worst case relative error ~A ~A ~S~%" maxdiff (car maxdiff-case) (cadr maxdiff-case)))
+ (format-logged #t ";number->string rounding checks worst case relative error ~A ~A ~S~%" maxdiff (car maxdiff-case) (cadr maxdiff-case)))
))
@@ -62066,7 +78451,7 @@ etc....
(num (cdr p)))
(let ((tag (catch #t (lambda () (string->number sym)) (lambda args 'error))))
(if (not (equal? num tag))
- (format #t ";(string->number ~S) = ~A [~A]~%" sym tag num)))))
+ (format-logged #t ";(string->number ~S) = ~A [~A]~%" sym tag num)))))
'(("#xe/d" . 14/13) ("#xb/d" . 11/13) ("#xf/d" . 15/13) ("#x1/f" . 1/15) ("#xd/f" . 13/15) ("#xe/f" . 14/15) ("#d.1" . .1) ("#d01" . 1)
("#d+1" . 1) ("#d+0" . 0) ("#d0+i" . 0+i) ("#xe+i" . 14.0+1.0i) ("#xf+i" . 15.0+1.0i) ("#d1-i" . 1.0-1.0i); ("#e1+i" . 1+i)
))
@@ -62075,9 +78460,9 @@ etc....
;;; here's code to generate all (im)possible numbers (using just a few digits) of a given length
(define file (open-output-file "ntest.scm"))
-(define chars (list #\1 #\0 #\9 #\# #\. #\+ #\- #\e #\i #\/ #\b #\x #\d #\o #\l #\s #\f))
+(define chars (list #\1 #\0 #\9 #\# #\. #\+ #\- #\e #\i #\/ #\b #\x #\d #\o #\l #\s #\f #\@))
-(define (all-syms f len with-file)
+(define (all-syms len with-file)
(let ((sym (make-string len))
(num-chars (length chars))
(ctrs (make-vector len 0)))
@@ -62094,9 +78479,6 @@ etc....
(do ((k 0 (+ k 1)))
((= k len))
(string-set! sym k (list-ref chars (vector-ref ctrs k)))))
-
- ;(format #t "~S " sym)
-
(let ((tag (catch #t (lambda () (string->number sym)) (lambda args (car args)))))
(if (not with-file)
(if (and (number? tag)
@@ -62104,14 +78486,13 @@ etc....
(format #t "~S " sym))
(begin
(if (number? tag)
- (display (format file "(if (not (number? (string->number ~S))) (begin (display ~S) (display #\space)))"))
- (display (format file "(if (number? (string->number ~S)) (begin (display ~S) (display #\space)))")))
+ (format file "(if (not (number? (string->number ~S))) (begin (display ~S) (display #\\space)))" sym sym)
+ (format file "(if (number? (string->number ~S)) (begin (display ~S) (display #\\space)))" sym sym))
(newline file)))))))
(do ((len 1 (+ len 1)))
((= len 12))
- (all-syms file len #f)
- (newline))
+ (all-syms len #f))
(close-output-port file)
|#
@@ -62127,7 +78508,7 @@ etc....
(for-each
(lambda (n name)
(if (number? n)
- (format #t ";(number? ~A) returned #t?~%" name)))
+ (format-logged #t ";(number? ~A) returned #t?~%" name)))
(list
'a9 'aa 'aA 'a! 'a$ 'a% 'a& 'a* 'a+ 'a- 'a. 'a/ 'a: 'a< 'a= 'a> 'a? 'a@ 'a^ 'a_ 'a~ 'A9 'Aa 'AA 'A! 'A$ 'A% 'A& 'A* 'A+ 'A- 'A. 'A/ 'A: 'A< 'A= 'A> 'A? 'A@ 'A^ 'A_ 'A~ '!9 '!a '!A '!! '!$ '!% '!& '!* '!+ '!- '!. '!/ '!: '!< '!= '!> '!? '!@ '!^ '!_ '!~ '$9 '$a '$A '$! '$$ '$% '$& '$* '$+ '$- '$. '$/ '$: '$< '$= '$> '$? '$@ '$^ '$_ '$~ '%9 '%a '%A '%! '%$ '%% '%& '%* '%+ '%- '%. '%/ '%: '%< '%= '%> '%? '%@ '%^ '%_ '%~ '&9 '&a '&A '&! '&$ '&% '&& '&* '&+ '&- '&. '&/ '&: '&< '&= '&> '&? '&@ '&^ '&_ '&~ '*9 '*a '*A '*! '*$ '*% '*& '** '*+ '*- '*. '*/ '*: '*< '*= '*> '*? '*@ '*^ '*_ '*~ '/9 '/a '/A '/! '/$ '/% '/& '/* '/+ '/- '/. '// '/: '/< '/= '/> '/? '/@ '/^ '/_ '/~ ':9 ':a ':A ':! ':$ ':% ':& ':* ':+ ':- ':. ':/ ':: ':< ':= ':> ':? ':@ ':^ ':_ ':~ '<9 '<a '<A '<! '<$ '<% '<& '<* '<+ '<- '<. '</ '<: '<< '<= '<> '<? '<@ '<^ '<_ '<~ '=9 '=a '=A '=! '=$ '=% '=& '=* '=+ '=- '=. '=/ '=: '=< '== '=> '=? '=@ '=^ '=_ '=~ '>9 '>a '>A '>! '>$ '>% '>& '>* '>+ '>- '>. '>/ '>: '>< '>= '>> '>? '>@ '>^ '>_ '>~ '?9 '?a '?A '?! '?$ '?% '?& '?* '?+ '?- '?. '?/ '?: '?< '?= '?> '?? '?@ '?^ '?_ '?~ '^9 '^a '^A '^! '^$ '^% '^& '^* '^+ '^- '^. '^/ '^: '^< '^= '^> '^? '^@ '^^ '^_ '^~ '_9 '_a '_A '_! '_$ '_% '_& '_* '_+ '_- '_. '_/ '_: '_< '_= '_> '_? '_@ '_^ '__ '_~ '~9 '~a '~A '~! '~$ '~% '~& '~* '~+ '~- '~. '~/ '~: '~< '~= '~> '~? '~@ '~^ '~_ '~~)
@@ -62140,24 +78521,24 @@ etc....
; ((= i (string-length initial-chars)))
; (do ((k 0 (+ k 1)))
; ((= k (string-length subsequent-chars)))
- ; (format #t "'~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k))))))
+ ; (format-logged #t "'~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k))))))
(for-each
(lambda (z)
(if (not (zero? z))
- (format #t "~A is not zero?~%" z))
+ (format-logged #t "~A is not zero?~%" z))
(if (and (real? z) (positive? z))
- (format #t "~A is positive?~%" z))
+ (format-logged #t "~A is positive?~%" z))
(if (and (real? z) (negative? z))
- (format #t "~A is negative?~%" z)))
+ (format-logged #t "~A is negative?~%" z)))
'(0 -0 +0 0.0 -0.0 +0.0 0/1 -0/1 +0/24 0+0i 0-0i -0-0i +0-0i 0.0-0.0i -0.0+0i #b0 #o-0 #x000 #e0 #e0.0 #e#b0 #b#e0 #e0/1 #b+0 #d000/1111 000/111))
(for-each
(lambda (x)
(if (string->number x)
- (format #t ";(string->number ~A) returned ~A~%" x (string->number x))))
+ (format-logged #t ";(string->number ~A) returned ~A~%" x (string->number x))))
'("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18 at 19q" "20 at q" "23@"
"+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "."
"3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2" "#b12" "#b-12"
@@ -62167,7 +78548,7 @@ etc....
"-#b1" "+#b1" "#b1/#b2" "#b1+#b1i" "1+#bi" "1+#b1i" "1#be1" "#b" "#o" "#" "#ea" "#e1a" "1+ie1" "1+i1" "1e+1i"
"#e#b" "#b#b" "#b#b1" "1e3e4" "1.0e-3e+4" "1e3s" "1e3s3" "#o#x1" "#i#i1" "1e-i" "#be1" "1/i" "1/e1" "1+e1"
"1e+" "1e1+" "1e1e1" "1e-+1" "1e0x1" "1e-" "1/#o2"
- "#i#i1" "12 at 12+0i"))
+ "#i#i1" "12 at 12i"))
(for-each
(lambda (couple)
@@ -62179,7 +78560,7 @@ etc....
(and (rational? y)
(not (eqv? xx y)))
(> (abs (- xx y)) 1e-12))
- (format #t ";(string->number ~A) returned ~A but expected ~A (~A ~A ~A ~A)~%"
+ (format-logged #t ";(string->number ~A) returned ~A but expected ~A (~A ~A ~A ~A)~%"
x (string->number x) y
xx (eq? xx #f)
(if (and xx y) (and (rational? y) (not (eqv? xx y))) #f)
@@ -62224,28 +78605,30 @@ etc....
("#e1e1" 10) ("#i1e1+i" 10.0+1.0i)
))
+;;; some schemes are case insensitive throughout -- they accept 0+I, #X11 etc
+
(for-each
(lambda (arg)
(test (string->number arg) 'error))
- (list -1 #f #\a 1 _ht_ '#(1 2 3) 3.14 3/4 1.0+1.0i '() 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (list -1 #f #\a 1 _ht_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
(for-each
(lambda (arg)
(test (string->number "123" arg) 'error)
(test (string->number "1" arg) 'error))
- (list -1 0 1 17 #f _ht_ #\a '#(1 2 3) 3.14 3/4 1.5+0.3i 1+i '() "" "12" #() :hi most-positive-fixnum most-negative-fixnum 'hi abs '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (list -1 0 1 17 #f _ht_ _null_ _c_obj_ #\a #(1 2 3) 3.14 3/4 1.5+0.3i 1+i () "" "12" #() :hi most-positive-fixnum most-negative-fixnum 'hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
;; (string->number "0" 1) ?? why not?
(for-each
(lambda (arg)
(test (number->string arg) 'error))
- (list #\a '#(1 2 3) '() _ht_ 'hi abs "hi" '#(()) #f (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (list #\a #(1 2 3) () _ht_ _null_ _c_obj_ 'hi abs "hi" #(()) #f (list 1 2 3) '(1 . 2) (lambda () 1)))
(for-each
(lambda (arg)
(test (number->string 123 arg) 'error))
- (list -1 17 most-positive-fixnum most-negative-fixnum 0 1 512 _ht_ #\a #f '#(1 2 3) 3.14 2/3 1.5+0.3i 1+i '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
+ (list -1 17 most-positive-fixnum most-negative-fixnum 0 1 512 _ht_ _null_ _c_obj_ #\a #f #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
(test (string->number "34.1" (+ 5 (expt 2 32))) 'error)
(test (number->string 34.1 (+ 5 (expt 2 32))) 'error)
@@ -62280,27 +78663,27 @@ etc....
(test (string->number "101" (bignum "-1")) 'error)
(test (string->number "101" (bignum "1/2")) 'error)))
-(num-test (- (string->number "1188077266484631001.") (string->number "1.188077266484631001E18")) 0.0)
-
-(num-test (- (string->number "1188077266484631001." 10) (string->number "1.188077266484631001E18" 10)) 0.0)
-(num-test (- (string->number "118807726648463100.1" 10) (string->number "1.188077266484631001E17" 10)) 0.0)
+(num-test (- (string->number "11880772664.84631001" 10) (string->number "1.188077266484631001E10" 10)) 0.0)
+(num-test (- (string->number "11880772.66484631001" 10) (string->number "1.188077266484631001E7" 10)) 0.0)
(if with-bignums
(num-test (- (string->number "118807726648463.1001" 10) (string->number "1.188077266484631001E14" 10)) 0.0)
(test (> (abs (- (string->number "118807726648463.1001" 10) (string->number "1.188077266484631001E14" 10))) 1e-1) #f))
-(num-test (- (string->number "11880772664.84631001" 10) (string->number "1.188077266484631001E10" 10)) 0.0)
-(num-test (- (string->number "11880772.66484631001" 10) (string->number "1.188077266484631001E7" 10)) 0.0)
-
-(num-test (- (string->number "118807726648463100100." 9) (string->number "1.188077266484631001E20" 9)) 0.0)
-(num-test (- (string->number "1188077266484631001." 9) (string->number "1.188077266484631001E18" 9)) 0.0)
-(num-test (- (string->number "118807726648463100.1" 9) (string->number "1.188077266484631001E17" 9)) 0.0)
(if with-bignums
(num-test (- (string->number "118807726648463.1001" 9) (string->number "1.188077266484631001E14" 9)) 0.0)
(test (> (abs (- (string->number "118807726648463.1001" 9) (string->number "1.188077266484631001E14" 9))) 1e-1) #f))
(num-test (- (string->number "11880772664.84631001" 9) (string->number "1.188077266484631001E10" 9)) 0.0)
(num-test (- (string->number "11880772.66484631001" 9) (string->number "1.188077266484631001E7" 9)) 0.0)
+#|
+(num-test (- (string->number "1188077266484631001.") (string->number "1.188077266484631001E18")) 0.0)
+(num-test (- (string->number "1188077266484631001." 10) (string->number "1.188077266484631001E18" 10)) 0.0)
+(num-test (- (string->number "118807726648463100.1" 10) (string->number "1.188077266484631001E17" 10)) 0.0)
+(num-test (- (string->number "118807726648463100100." 9) (string->number "1.188077266484631001E20" 9)) 0.0)
+(num-test (- (string->number "1188077266484631001." 9) (string->number "1.188077266484631001E18" 9)) 0.0)
+(num-test (- (string->number "118807726648463100.1" 9) (string->number "1.188077266484631001E17" 9)) 0.0)
;; (num-test (- (string->number "1177077266474631001000." 8) (string->number "1.177077266474631001E21" 8)) 0.0)
-;; a fake unfortunately
+;; a fake unfortunately -- actually all of these are not what they appear to be
+|#
(num-test 111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111e-300 1.111111111111111111111111111111111111113E-1)
(num-test 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0)
@@ -62462,7 +78845,7 @@ etc
(for-each
(lambda (n)
(test (bignum? n) #f))
- (list 0 1 -1 1/3 1.0 1+i 1073741824 1.0e8 1+1.0e8i "hi" '() (integer->char 65) #f #t '(1 2) 'a-symbol _ht_ (cons 1 2) (make-vector 3) abs))
+ (list 0 1 -1 1/3 1.0 1+i 1073741824 1.0e8 1+1.0e8i "hi" () (integer->char 65) #f #t '(1 2) 'a-symbol _ht_ _null_ _c_obj_ (cons 1 2) (make-vector 3) abs))
(for-each
(lambda (n)
@@ -62474,7 +78857,7 @@ etc
(lambda (n)
(test (bignum n) 'error)
(test (bignum "1.0" n) 'error))
- (list "hi" (integer->char 65) #f #t '(1 2) 'a-symbol (cons 1 2) '() _ht_ (make-vector 3) 1 3/4 1.5 1+i abs))
+ (list "hi" (integer->char 65) #f #t '(1 2) 'a-symbol (cons 1 2) () _ht_ _null_ _c_obj_ (make-vector 3) 1 3/4 1.5 1+i abs))
(test (bignum?) 'error)
(test (bignum? 1 2) 'error)
@@ -62495,7 +78878,7 @@ etc
;;; errors
;;; --------------------------------------------------------------------------------
-(let ((ntype ((cadr (make-type)) "hi")))
+(let ()
(for-each
(lambda (op)
@@ -62504,23 +78887,23 @@ etc
(lambda (arg)
(let ((val (catch #t (lambda () (op arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format #t "(~A ~A) -> ~A (expected 'error)~%" op arg val)))
+ (format-logged #t "(~A ~A) -> ~A (expected 'error)~%" op arg val)))
(let ((val (catch #t (lambda () (op 0 arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format #t "(~A 0 ~A) -> ~A (expected 'error)~%" op arg val)))
+ (format-logged #t "(~A 0 ~A) -> ~A (expected 'error)~%" op arg val)))
(let ((val (catch #t (lambda () (op 0 1 arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format #t "(~A 0 1 ~A) -> ~A (expected 'error)~%" op arg val)))
+ (format-logged #t "(~A 0 1 ~A) -> ~A (expected 'error)~%" op arg val)))
(if with-bignums
(let ((val (catch #t (lambda () (op (expt 2 60) arg)) (lambda args 'error))))
(if (not (eq? val 'error))
- (format #t "(~A 2^60 ~A) -> ~A (expected 'error)~%" op arg val)))))
+ (format-logged #t "(~A 2^60 ~A) -> ~A (expected 'error)~%" op arg val)))))
- (list "hi" '() #\a (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs #t _ht_ (if #f #f) (lambda (a) (+ a 1)) #<undefined> #<unspecified> #<eof> ntype :key)))
+ (list "hi" () #\a (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs #t _ht_ _null_ _c_obj_ :hi (if #f #f) (lambda (a) (+ a 1)) #<undefined> #<unspecified> #<eof> :rest)))
(list exact? inexact? zero? positive? negative? even? odd? quotient remainder modulo truncate floor ceiling round
abs max min gcd lcm expt exact->inexact inexact->exact rationalize numerator denominator imag-part real-part
- magnitude angle make-polar make-rectangular sqrt exp log sin cos tan asin acos atan number->string
+ magnitude angle make-polar complex sqrt exp log sin cos tan asin acos atan number->string
+ - * / < > <= >= =)))
(let ((d 3.14)
@@ -62561,11 +78944,11 @@ etc
(let ((x (catch #t (lambda () (op c d)) (lambda args 'error))))
(check-vals op)))
(list
- number->string string->number make-rectangular magnitude abs exp make-polar angle
+ number->string string->number complex magnitude abs exp make-polar angle
sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin
number? integer? real? complex? rational? even? odd? zero? positive? negative? real-part imag-part
numerator denominator rationalize exact? inexact? exact->inexact inexact->exact floor ceiling truncate round
- logior logxor logand lognot ash integer-length
+ logior logxor logand lognot logbit? ash integer-length
+ - * / quotient remainder
expt = max min modulo < > <= >= lcm gcd
))))
@@ -62613,202 +78996,6162 @@ etc
(let ((x (catch #t (lambda () (op c d)) (lambda args 'error))))
(check-vals op)))
(list
- number->string string->number make-rectangular magnitude abs exp make-polar angle
+ number->string string->number complex magnitude abs exp make-polar angle
sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin
number? integer? real? complex? rational? even? odd? zero? positive? negative? real-part imag-part
numerator denominator rationalize exact? inexact? exact->inexact inexact->exact floor ceiling truncate round
- logior logxor logand lognot ash integer-length
+ logior logxor logand lognot logbit? ash integer-length
+ - * / quotient remainder
expt = max min modulo < > <= >= lcm gcd
- ))))))
-
-(for-each
- (lambda (arg)
- (test (bignum "1.0" arg) 'error))
- (list -1 0 #\a '#(1 2 3) 2/3 1.5+0.3i 1+i '() 'hi abs "hi" '#(()) (list 1 2 3) '(1 . 2) (lambda () 1)))
-
-
+ ))))
-;;; some leftovers placed here to avoid slowing down the rest of the tests unnecessarily
-(test (let ((equal? #f)) (member 3 '(1 2 3))) '(3))
-(test (let ((eqv? #f)) (case 1 ((1) 1))) 1) ; scheme wg
-(test (let ((eqv? equal?)) (case "asd" (("asd") 1) (else 2))) 2)
-(test (let ((eq? #f)) (memq 'a '(a b c))) '(a b c))
+ (for-each
+ (lambda (arg)
+ (test (bignum "1.0" arg) 'error))
+ (list -1 0 #\a #(1 2 3) 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))))
#|
(let ((funcs (list
- make-polar make-rectangular magnitude angle real-part imag-part numerator denominator rationalize abs
+ make-polar complex magnitude angle real-part imag-part numerator denominator rationalize abs
exp log sin cos tan asin acos atan sinh cosh tanh asinh acosh atanh sqrt floor ceiling truncate
round lcm gcd + - * / max min quotient remainder modulo = < > <= >= even? odd? zero? positive? negative?
- infinite? inexact->exact exact->inexact integer-length logior logxor logand lognot
+ infinite? inexact->exact exact->inexact integer-length logior logxor logand lognot logbit?
ash integer-decode-float exact? inexact? number? integer? real? complex? rational? nan?; number->string expt
))
(func-names (list
- 'make-polar 'make-rectangular 'magnitude 'angle 'real-part 'imag-part 'numerator 'denominator 'rationalize 'abs
+ 'make-polar 'complex 'magnitude 'angle 'real-part 'imag-part 'numerator 'denominator 'rationalize 'abs
'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt 'floor 'ceiling 'truncate
'round 'lcm 'gcd '+ '- '* '/ 'max 'min 'quotient 'remainder 'modulo '= '< '> '<= '>= 'even? 'odd? 'zero? 'positive? 'negative?
- 'infinite? 'inexact->exact 'exact->inexact 'integer-length 'logior 'logxor 'logand 'lognot
+ 'infinite? 'inexact->exact 'exact->inexact 'integer-length 'logior 'logxor 'logand 'lognot 'logbit?
'ash 'integer-decode-float 'exact? 'inexact? 'number? 'integer? 'real? 'complex? 'rational? 'nan?; 'number->string 'expt
))
(args (list 0 1 -1)))
(define (for-each-subset-permuted func name args)
- (let* ((arity (procedure-arity func))
- (min-args (car arity))
- (max-args (if (caddr arity)
- 1000
- (+ min-args (cadr arity)))))
+ (let* ((ar (arity func))
+ (min-args (car ar))
+ (max-args (min 1000 (cdr ar))))
(if (= min-args 0) (set! min-args 1))
(for-each-subset
(lambda s-args
(if (<= min-args (length s-args) max-args)
(for-each-permutation
(lambda p-args
- ;(format *stderr* "(~A ~{~A~^ ~})~%" name p-args)
- (let ((val (catch #t (lambda () (apply func p-args)) (lambda e-args ''error))))
- (format #t "(let ((new-val (catch-it (~A ~{~A~^ ~})))) " name p-args)
- (if (nan? val)
- (format #t "(if (not (nan? new-val)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not NaN?~~%\" new-val)))~%" name p-args)
- (if (infinite? val)
- (format #t "(if (not (infinite? new-val)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not inf?~~%\" new-val)))~%" name p-args)
- (if (not (number? val))
- (format #t "(if (not (equal? new-val ~A)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not ~A?~~%\" new-val)))~%" val name p-args val)
- (format #t "(if (or (not (number? new-val)) (> (magnitude (- new-val ~A)) 1e-6)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not ~A?~~%\" new-val)))~%"
- val name p-args val))))))
+ (catch #t
+ (lambda ()
+ (let ((val (apply func p-args)))
+ (format #t "(let ((new-val (catch-it (~A ~{~A~^ ~})))) " name p-args)
+ (if (not (number? val))
+ (format #t "(if (not (equal? new-val ~A)) (format #t \"(~A ~{~A~^ ~}) -> ~~A~~%\" new-val)))~%" val name p-args)
+ (if (nan? val)
+ (format #t "(if (not (nan? new-val)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not NaN?~~%\" new-val)))~%" name p-args)
+ (if (infinite? val)
+ (format #t "(if (not (infinite? new-val)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not inf?~~%\" new-val)))~%" name p-args)
+ (format #t "(if (> (magnitude (- new-val ~A)) 1e-6) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not ~A~~%\" new-val)))~%" val name p-args val))))))
+ (lambda e-args (format *stderr* "~A~%" e-args) ''error)))
s-args)))
args)))
(with-output-to-file "t248.data"
(lambda ()
(format #t "(define-macro (catch-it tst)~% `(catch #t (lambda () ,tst) (lambda args 'error)))~%")
-
(for-each
(lambda (func name)
(for-each-subset-permuted func name args))
funcs func-names))))
|#
+;(gc)
+
+;;; --------------------------------------------------------------------------------
+;;;
+;;; fft from s7.html
+
+(define* (cfft! data n (dir 1)) ; (complex data)
+ (if (not n) (set! n (length data)))
+ (do ((i 0 (+ i 1))
+ (j 0))
+ ((= i n))
+ (if (> j i)
+ (let ((temp (data j)))
+ (set! (data j) (data i))
+ (set! (data i) temp)))
+ (let ((m (/ n 2)))
+ (do ()
+ ((or (< m 2) (< j m)))
+ (set! j (- j m))
+ (set! m (/ m 2)))
+ (set! j (+ j m))))
+ (let ((ipow (floor (log n 2)))
+ (prev 1))
+ (do ((lg 0 (+ lg 1))
+ (mmax 2 (* mmax 2))
+ (pow (/ n 2) (/ pow 2))
+ (theta (complex 0.0 (* pi dir)) (* theta 0.5)))
+ ((= lg ipow))
+ (let ((wpc (exp theta))
+ (wc 1.0))
+ (do ((ii 0 (+ ii 1)))
+ ((= ii prev))
+ (do ((jj 0 (+ jj 1))
+ (i ii (+ i mmax))
+ (j (+ ii prev) (+ j mmax)))
+ ((>= jj pow))
+ (let ((tc (* wc (data j))))
+ (set! (data j) (- (data i) tc))
+ (set! (data i) (+ (data i) tc))))
+ (set! wc (* wc wpc)))
+ (set! prev mmax))))
+ data)
+
+(test (morally-equal? (cfft! (list 0.0 1+i 0.0 0.0)) '(1+1i -1+1i -1-1i 1-1i)) #t)
+(test (morally-equal? (cfft! (vector 0.0 1+i 0.0 0.0)) #(1+1i -1+1i -1-1i 1-1i)) #t)
+
+(let ((size 32))
+ (let ((v (make-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (v i) (random 1.0)))
+ (let ((copy-v (copy v)))
+ (cfft! v size)
+ (cfft! v size -1)
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (v i) (/ (v i) size))
+ (if (or (> (abs (imag-part (v i))) 1e-14)
+ (> (magnitude (- (v i) (copy-v i))) 1e-14))
+ (format *stderr* ";cfft! reals: ~D: ~A ~A~%" i (v i) (copy-v i)))))))
+
+(let ((size 32))
+ (let ((v (make-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (v i) (random 100)))
+ (let ((copy-v (copy v)))
+ (cfft! v size)
+ (cfft! v size -1)
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (v i) (/ (v i) size))
+ (if (or (> (abs (imag-part (v i))) 1e-12)
+ (> (magnitude (- (v i) (copy-v i))) 1e-12))
+ (format *stderr* ";cfft! ints: ~D: ~A ~A~%" i (v i) (copy-v i)))))))
+
+(let ((size 32))
+ (let ((v (make-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (v i) (random 1+i)))
+ (let ((copy-v (copy v)))
+ (cfft! v size)
+ (cfft! v size -1)
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (v i) (/ (v i) size))
+ (if (> (magnitude (- (v i) (copy-v i))) 1e-12)
+ (format *stderr* ";cfft! complex: ~D: ~A ~A~%" i (v i) (copy-v i)))))))
+
+(if with-bignums
+ (let ((size 32))
+ (let ((data (make-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (data i) (complex (bignum (number->string (random 1.0)))
+ (bignum (number->string (random 1.0))))))
+ (let ((old-data (copy data)))
+ (cfft! data size)
+ (cfft! data size -1)
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (data i) (/ (data i) size))
+ (if (> (magnitude (- (data i) (old-data i))) 1e-14)
+ (format *stderr* ";cfft! big: ~D: ~A~%" i (magnitude (- (old-data i) (data i))))))))))
+#|
+;;; 1048576 forces us to 4608000, 32568 512000
+(let ((size 65536))
+ (let ((v (make-vector size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (v i) (random 1+i)))
+ (let ((copy-v (copy v)))
+ (cfft! v size)
+ (cfft! v size -1)
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (v i) (/ (v i) size))
+ (if (> (magnitude (- (v i) (copy-v i))) 1e-10)
+ (format *stderr* "~D: ~A (~A ~A)~%" (magnitude (- (v i) (copy-v i))) i (v i) (copy-v i)))))))
+|#
+
+
+(if (not (provided? 'snd)) (load "stuff.scm"))
+
+(let ()
+ (if (provided? 'snd) (load "stuff.scm" (curlet)))
+
+ (test (first '(1 2 3 4 5 6 7 8 9 10)) 1)
+ (test (second '(1 2 3 4 5 6 7 8 9 10)) 2)
+ (test (third '(1 2 3 4 5 6 7 8 9 10)) 3)
+ (test (fourth '(1 2 3 4 5 6 7 8 9 10)) 4)
+ (test (fifth '(1 2 3 4 5 6 7 8 9 10)) 5)
+ (test (sixth '(1 2 3 4 5 6 7 8 9 10)) 6)
+ (test (seventh '(1 2 3 4 5 6 7 8 9 10)) 7)
+ (test (eighth '(1 2 3 4 5 6 7 8 9 10)) 8)
+ (test (ninth '(1 2 3 4 5 6 7 8 9 10)) 9)
+ (test (tenth '(1 2 3 4 5 6 7 8 9 10)) 10)
+ (test (first #(1 2 3 4 5 6 7 8 9 10)) 1)
+ (test (second #(1 2 3 4 5 6 7 8 9 10)) 2)
+ (test (third #(1 2 3 4 5 6 7 8 9 10)) 3)
+ (test (fourth #(1 2 3 4 5 6 7 8 9 10)) 4)
+ (test (fifth #(1 2 3 4 5 6 7 8 9 10)) 5)
+ (test (sixth #(1 2 3 4 5 6 7 8 9 10)) 6)
+ (test (seventh #(1 2 3 4 5 6 7 8 9 10)) 7)
+ (test (eighth #(1 2 3 4 5 6 7 8 9 10)) 8)
+ (test (ninth #(1 2 3 4 5 6 7 8 9 10)) 9)
+ (test (tenth #(1 2 3 4 5 6 7 8 9 10)) 10)
+ (test (first "1234567890") #\1)
+ (test (second "1234567890") #\2)
+ (test (third "1234567890") #\3)
+ (test (fourth "1234567890") #\4)
+ (test (fifth "1234567890") #\5)
+ (test (sixth "1234567890") #\6)
+ (test (seventh "1234567890") #\7)
+ (test (eighth "1234567890") #\8)
+ (test (ninth "1234567890") #\9)
+ (test (tenth "1234567890") #\0)
+
+ (for-each (lambda (obj)
+ (test (empty? obj) #t)
+ (test (not (sequence? obj)) #f))
+ (list "" () #() (hash-table) (inlet) (if with-block (block) (float-vector)) (float-vector) #2d()))
+
+ (for-each (lambda (obj)
+ (test (empty? obj) #f)
+ (test (not (sequence? obj)) #t)
+ (test (not (applicable? obj)) #f))
+ (list abs (lambda () 1) quasiquote))
+
+ (for-each (lambda (obj)
+ (test (empty? obj) #f)
+ (test (indexable? obj) #f)
+ (test (applicable? obj) #f)
+ (test (not (sequence? obj)) #t))
+ (list #\null #\a 1 'a-symbol 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f)))
+ (test (sequence?) 'error)
+ (test (sequence? () '(1)) 'error)
+
+ (test (->predicate 1) integer?)
+ (test (->predicate (curlet)) let?)
+ (test (->predicate #<eof>) eof-object?)
+ (test (->predicate (cons 1 2)) pair?)
+ (test (->predicate :hi) keyword?)
+ (test (->predicate #\a) char?)
+ (test (->predicate) 'error)
+
+ (when with-block
+ (add-predicate block?)
+ (test (->predicate (block 1 2)) block?))
+
+ (test (let ((a 1) (b "hi")) (value->symbol "hi")) 'b)
+
+ (test (typeq? 1 2) #t)
+ (test (typeq? #\a #\space #\b) #t)
+ (test (typeq?) #t)
+ (test (typeq? 1.2) #t)
+ (test (typeq? 1 1/2) #f)
+ (test (typeq? "hi" "" (string #\null) "abc") #t)
+ (test (typeq? 1.0 pi) #t)
+ (test (typeq? #<unspecified> (if #f #f)) #t)
+
+ (test (let ((x 1)) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 32)
+ (test (let ((x 1.0)) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 2)
+ (test (let ((x ())) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 0)
+ (test (let ((x "hi")) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 2)
+ (test (let ((x 0)) (typecase (set! x (+ x 1)) ((even?) -1) ((odd?) 1))) 1)
+
+ ;; 2^n and 2^n-1 are tested above as are log-n-of et al and the ldb/dpb functions
+ (test (lognand 1 2) -1)
+ (test (lognand -1 1) -2)
+ (test (lognand -1 -2) 1)
+ (test (lognand 123 321) -66)
+
+ (test (lognor -1 -2) 0)
+ (test (lognor 1 2) -4)
+ (test (lognor 123 321) -380)
+ (test (lognor 0 1) -2)
+
+ (test (logeqv 1) 1)
+ (test (logeqv) -1)
+ (test (logeqv 1 2) -4)
+ (test (logeqv -1 2) 2)
+ (test (logeqv -1 123 321) -315)
+ (test (logeqv 1 2 3 4) -5)
+ (test (logeqv 1 2 3 4 5) 1)
+
+ (test (iota 0) ())
+ (test (iota 3) '(0 1 2))
+ (test (iota -1) 'error)
+ (test (iota 3 -2) '(-2 -1 0))
+
+ (test (union vector '(1 2 3) #() #(4 2 1)) #(1 2 3 4))
+ (test (union string '(#\a) #(#\b) "abcde") "abcde")
+ (test (union vector) #())
+ (test (equal? (union list '(1 2 3) ()) '(1 2 3)) #t)
+ (test (let? (union inlet (inlet 'a 2) (inlet 'b 3))) #t)
+ (test ((union inlet '(a 1) #(b 2)) 'b) 2)
+ (test ((union hash-table (hash-table '(a . 1)) (hash-table '(a . 1) '(b . 2))) 'b) 2)
+
+ (test (intersection vector) #())
+ (test (intersection list '(1 2 3) #()) ())
+ (test (intersection list '(1 2 3) #(4 5 1 9)) '(1)) ; pair: unbound variable
+ (num-test ((intersection float-vector '(1 2 3) #(4 5 1 9 3)) 0) 1.0)
+ (test (intersection (lambda x (make-shared-vector (apply vector x) '(2 2))) '(1 2 3 4 5) #(4 5 1 9 3)) #2D((1 3) (4 5)))
+ (when with-block
+ (test (block? (intersection block '(1.0 2.0) #(1.0))) #t)
+ (test (block? (intersection block (block 1.0 2.0) #(2.0))) #t))
+ (test (intersection list '(1 2 3) '(3 2 1)) '(1 2 3))
+ (test (intersection inlet (inlet 'a 1 'b 2) (inlet 'b 3)) (inlet))
+ (test (intersection inlet (inlet 'a 1 'b 2) (inlet 'b 2)) (inlet 'b 2))
+
+ (test (symmetric-difference list '(1 2 3)) '(1 2 3))
+ (test (symmetric-difference list ()) ())
+ (test (symmetric-difference list '(1 2 3) '(1 2 4)) '(3 4))
+ (test (symmetric-difference list '(1 2 3) '(1 2 4) '(3 1 5)) '(1 4 5))
+
+ (test (asymmetric-difference list '(1 2 3) '(1 2 4)) '(4))
+ (test (asymmetric-difference list ()) ())
+ (test (asymmetric-difference list '(1 2 3)) ())
+
+ (test (null? (cl-set-difference list () ())) #t)
+ (test (null? (cl-set-difference list () '(1 2 3))) #t)
+ (test (null? (cl-set-difference list '(1 2 3 4) '(4 3 2 1))) #t)
+ (test (null? (cl-set-difference list '(1 2 3 4) '(2 4 3 1))) #t)
+ (test (null? (cl-set-difference list '(1 2 3 4) '(1 3 4 2))) #t)
+ (test (null? (cl-set-difference list '(1 2 3 4) '(1 3 2 4))) #t)
+
+ (test (power-set list ()) '(()))
+ (test (power-set list '(1)) '(() (1)))
+ (test (power-set list '(1 2)) '(() (2) (1) (1 2)))
+ (test (power-set list '(1 2 3)) '(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3)))
+
+ (test (apply union list (power-set list '(1 2 3))) '(3 2 1))
+
+ (test (hash-table->alist (hash-table)) ())
+ (test (hash-table->alist (hash-table '(a . 1))) '((a . 1)))
+ (test (let ((lst (hash-table->alist (hash-table '(a . 1) '(b . 2)))))
+ (or (equal? lst '((a . 1) (b . 2)))
+ (equal? lst '((b . 2) (a . 1)))))
+ #t)
+
+ (test (merge-hash-tables (hash-table) (hash-table '(a . 1))) (hash-table '(a . 1)))
+ (test (merge-hash-tables (hash-table '(a . 1) '(b . 2)) (hash-table '(a . 1))) (hash-table '(a . 1) '(b . 2)))
+ (test (union hash-table (hash-table '(a . 1) '(b . 2)) (hash-table '(a . 1))) (hash-table '(a . 1) '(b . 2)))
+ (test (with-let (union inlet (inlet 'a 1) (inlet 'b 2)) (+ a b)) 3)
+ (let ()
+ (define e (let ((e's (list (inlet 'a 1 'b 2) (inlet 'a 3 'b 4))))
+ (lambda (sym)
+ (apply values (map (lambda (e1)
+ (if (defined? sym e1)
+ (e1 sym)
+ (values)))
+ e's)))))
+ (test (+ (e 'a) (e 'b)) 10))
+
+ (test (find-if (lambda (x) (= x 3)) '(1 2 3 4)) 3)
+ (test (find-if (lambda (x) (= x 3)) '(1 2 5 4)) #f)
+ (test (find-if (lambda (x) (= x 3)) ()) #f)
+
+ (test (index-if (lambda (x) (= x 3)) '(1 2 3 4)) 2)
+ (test (index-if (lambda (x) (= x 1)) '(1 2 3 4)) 0)
+ (test (index-if (lambda (x) (= x 3)) '(1 2 5 4)) #f)
+ (test (index-if (lambda (x) (= x 3)) ()) #f)
+ (test (index-if (lambda (x) (equal? (cdr x) 2)) (hash-table '(a . 1) '(b . 2))) 'b)
+
+ (test (count-if (lambda (x) (= x 3)) ()) 0)
+ (test (count-if (lambda (x) (= x 3)) '(1 2)) 0)
+ (test (count-if (lambda (x) (= x 3)) '(3 3)) 2)
+
+ (test (every? (lambda (x) (= x 3)) ()) #t)
+ (test (every? (lambda (x) (= x 3)) '(1 2)) #f)
+ (test (every? (lambda (x) (= x 3)) '(1 3)) #f)
+ (test (every? (lambda (x) (= x 3)) '(3 3 3)) #t)
+
+ (test (any? (lambda (x) (= x 3)) ()) #f)
+ (test (any? (lambda (x) (= x 3)) '(1 2)) #f)
+ (test (not (any? (lambda (x) (= x 3)) '(1 3))) #f)
+ (test (not (any? (lambda (x) (= x 3)) '(3 3 3))) #f)
+
+ (test (collect-if list (lambda (x) (> x 3)) ()) ())
+ (test (collect-if list (lambda (x) (> x 3)) '(1)) ())
+ (test (collect-if list (lambda (x) (> x 3)) '(1 3 4)) '(4))
+ (test (collect-if list (lambda (x) (> x 3)) '(1 3 4 2 1 5 1)) '(4 5))
+
+ (test (collect-if inlet (let ((syms ()))
+ (lambda (x)
+ (and (not (memq (car x) syms))
+ (set! syms (cons (car x) syms)))))
+ (inlet 'a 1 'b 2 'a 3))
+ (inlet 'b 2 'a 3))
+ ;; i.e. clean out shadowed vars, ((inlet 'a 1 'b 2 'a 3) 'a) -> 3
+
+ (test (remove-if list (lambda (x) (> x 3)) ()) ())
+ (test (remove-if list (lambda (x) (> x 3)) '(1)) '(1))
+ (test (remove-if list (lambda (x) (> x 3)) '(1 3 4)) '(1 3))
+ (test (remove-if list (lambda (x) (> x 3)) '(1 3 4 2 1 5 1)) '(1 3 2 1 1))
+ (test (let ((e (inlet 'a 1 'b 2 'c 3)))
+ (remove-if inlet (lambda (x) (= (cdr x) 2)) e))
+ (inlet 'a 1 'c 3))
+ (test (let ((ht (hash-table '(a . 1) '(b . 2) '(c . 3))))
+ (remove-if hash-table (lambda (x) (= (cdr x) 2)) ht))
+ (hash-table '(a . 1) '(c . 3)))
+ (test (remove-if vector (lambda (x) (integer? x)) #(() #\a 3/2 2 21 "hi")) #(() #\a 3/2 "hi"))
+
+ (test (nonce list ()) ())
+ (test (nonce list '(1 2)) '(1 2))
+ (test (nonce list '(1 1)) ())
+ (test (nonce list '(1 2 3 1 3 1 1)) '(2))
+
+ (test (member? 1 ()) #f)
+ (test (member? 1 '(2 3)) #f)
+ (test (member? 1 '(2 1 3)) 1)
+
+ (test (concatenate list ()) ())
+ (test (concatenate list () #() "") ())
+ (test (concatenate vector '(1) #() "2") #(1 #\2))
+ (test (concatenate string '(#\1 #\2) "34" #(#\5)) "12345")
+ (test (concatenate inlet (inlet 'a 1) (inlet 'b 2 'a 3)) (inlet 'a 1 'b 2 'a 3))
+
+ (test (full-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1)
+ (test (full-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) #f)
+
+ (test (full-count-if (lambda (x) (and (integer? x) (= x 1))) '(1 2 (3 4 1) (5 (6 (1))))) 3)
+ (test (let ((l1 '(1 2))) (full-count-if (lambda (x) (and (integer? x) (= x 2))) (list 1 l1 2 l1 3 l1))) 4)
+
+ (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '(1 2 3)) '(2))
+ (test (full-index-if (lambda (x) (= (cdr x) 3)) (hash-table '(a . 1) '(b . 3))) '(b))
+ (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '(1 (2 3))) '(1 1))
+ (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '((1 (2 (3))))) '(0 1 1 0))
+ (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) #((1 (2 #(3))))) '(0 1 1 0))
+ (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) (hash-table '(a . 1) '(b . #(1 2 3)))) '(b 2))
+ (test (full-index-if (lambda (x) (and (integer? x) (= x 4))) (hash-table '(a . 1) '(b . #(1 2 3)))) #f)
+
+ (test (let ((lst (list 1 2))) (set-cdr! lst lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1))
+ (test (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2))
+ (test (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2 3))
+ (test (let ((lst (list 1 2 3 4))) (set-cdr! (cdddr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2 3 4))
+ (test (let ((v '(1 2 . 3))) (let ((i (make-complete-iterator v))) (map values i))) '(1 2 3))
+ (test (let ((v '(1 2 #(4 5) ("67")))) (let ((i (make-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5 ("67") "67" #\6 #\7))
+ (test (let ((v (list (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list (circular-list 1) 1))
+ (test (let ((v (list (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list (circular-list 1 2) 1 2))
+
+ (test (let ((v (cons 3 (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) '(3 1))
+ (test (let ((v (cons 3 (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) '(3 1 2))
+ (test (let ((v (list 3 (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list 3 (circular-list 1) 1))
+ (test (let ((v (list 3 (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list 3 (circular-list 1 2) 1 2))
+
+ (test (let ((v (vector (list 4 5) (circular-list 1 2 3) (cons 6 (cons 7 8)))))
+ (let ((iter (make-complete-iterator v)))
+ (map values iter)))
+ (list (list 4 5) 4 5 (circular-list 1 2 3) 1 2 3 (cons 6 (cons 7 8)) 6 7 8))
+
+ (test (let ((lst (list 1 2))) (let ((v (list lst lst))) (let ((iter (make-complete-iterator v))) (map values iter)))) '((1 2) 1 2))
+
+ (test (let ((lst (circular-list 1)))
+ (let ((v (list lst lst)))
+ (let ((iter (make-complete-iterator v)))
+ (map values iter))))
+ (list (circular-list 1) 1))
+
+ (let ((v (circular-list 1))) (set-car! v v) (test (let ((i5 (make-complete-iterator v))) (map values i5)) ()))
+ (let ((v (vector 1))) (set! (v 0) v) (test (let ((i4 (make-complete-iterator v))) (map values i4)) ()))
+
+ (let ((v (vector 1)) (lst (circular-list 2)))
+ (set! (v 0) lst) (set-car! lst v)
+ (test (let ((i1 (make-complete-iterator v))) (map values i1)) (list lst))) ; not v because it's the outermost container?
+
+ (let ((v (vector 1)) (lst (circular-list 2)))
+ (set! (v 0) lst) (set-car! lst v)
+ (test (let ((i2 (make-complete-iterator (list v)))) (map values i2)) (list v lst)))
+
+ (let ((v (vector 1 2)))
+ (set! (v 1) v) (set! (v 0) v)
+ (test (let ((i3 (make-complete-iterator (list v)))) (map values i3)) (list v)))
+
+ (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1)
+ (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) #f)
+ (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (circular-list 2 3 1 4)) 1)
+ (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 1 4) 3)) 1)
+ (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 4) 3)) #f)
+ (test (let ((v (vector 1 2))) (set! (v 1) v) (safe-find-if (lambda (x) (and (integer? x) (= x 1))) v)) 1)
+ (test (let ((v (vector 1 2)) (lst (list 1 2))) (set! (v 1) lst) (set! (lst 1) v) (safe-find-if (lambda (x) (and (integer? x) (= x 1))) v)) 1)
+
+ (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1)
+ (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) 0)
+ (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (circular-list 2 3 1 4)) 1)
+ (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 1 4) 3)) 1)
+ (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 4) 3)) 0)
+ (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 #(1) (circular-list 2 1 3 1 4) 3)) 3)
+ (test (let ((v (vector 1 2))) (set! (v 1) v) (safe-count-if (lambda (x) (and (integer? x) (= x 1))) v)) 1)
+ (test (let ((v (vector 1 2)) (lst (list 1 2))) (set! (v 1) lst) (set! (lst 1) v) (safe-count-if (lambda (x) (and (integer? x) (= x 1))) v)) 2)
+
+ (test (make-directory-iterator #\a) 'error)
+ (test (catch #t
+ (lambda ()
+ (let ((f (make-directory-iterator "/home/bil/libxm")))
+ (f)
+ ((iterator-sequence f) #<eof>)
+ #f))
+ (lambda args #f))
+ #f)
+
+ (test (let ((x 32))
+ (define gx (elambda () (*env* 'x)))
+ (let ((x 100))
+ (let ((x 12))
+ (gx))))
+ 12)
+ (test (let ()
+ (define hi (elambda (x) (string->symbol "b")))
+ (eq? (hi 1) 'b))
+ #t)
+ (test (let ()
+ (define hi (elambda (x) (+ (*env* 'y) x)))
+ (let ((y 3)) (hi 1)))
+ 4)
+ (test (letrec ((efunc (elambda (x) (if (= x 0) 0 (efunc (- x 1)))))) (efunc 3)) 0)
+ (test (let ((y 1)) (define hi (elambda (x z) (if (= x z) (display "oops")) (+ z x (*env* 'y)))) (hi 2 3)) 6)
+ (test (let ((y 1)) (define hi (elambda (x z) (if (= x z) (display "oops")) (+ z x (*env* 'y)))) (let ((y 12)) (hi 2 3))) 17)
+
+ (test (let ((vals #(0 0 0)))
+ (define rx (rlambda ((a (+ c 1))) (+ a 2)))
+ (set! (vals 0) (rx 5))
+ (let ((c 3))
+ (set! (vals 1) (rx))) ; error if lambda* not rlambda
+ (let ((c 5))
+ (set! (vals 2) (rx)))
+ vals)
+ #(7 6 8))
+ (test (let ((x 3)) (define rx (rlambda ((a x)) (if (> a 0) (rx (- a 1)) 0))) (rx)) 0)
+ (test (let () (define rx (rlambda ((a x)) (if (> a 0) (let ((x (- x 1))) (rx)) 0))) (let ((x 3)) (rx))) 0)
+
+
+ (test (let ((a 1) (b 2)) (eval-case 1 ((a) 123) ((b) 321) (else 0))) 123)
+ (test (let ((a 1) (b 2) (c 3)) (eval-case 3 ((a c) 123) ((b) 321) (else 0))) 123)
+ (test (let ((a 1) (b 2)) (eval-case 3 ((a) 123) ((b) 321) (((+ a b)) -1) (else 0))) -1)
+ (test (let ((a 1) (b 2)) (eval-case 6 ((a (* (+ a 2) b)) 123) ((b) 321) (((+ a b)) -1) (else 0))) 123)
+ (test (let ((a 1) (b 2) (c 5)) (eval-case (set! c (+ c 1)) ((a (* (+ a 2) b)) 123) ((b) 321) (((+ a b)) -1) (else 0))) 123)
+ (test (let ((a 1) (b 2) (c 5)) (eval-case (set! c (+ c 1)) ((b) 321) ((+ a b) -1) ((a (* (+ a 2) b)) 123) (((+ a b)) -1) (else 0))) 123)
+
+ (test (linearize (circular-list 1 2 3)) '(1 2 3))
+ (test (linearize ()) ())
+ (test (linearize (let ((lst (list 1 2 3 4))) (set-cdr! (list-tail lst 3) (cdr lst)) lst)) '(1 2 3 4))
+
+ (test (flatten-let (with-let (inlet) (let ((x 1)) (curlet)))) (inlet 'x 1))
+ (test (flatten-let (with-let (inlet) (let ((x 1)) (let ((y 2)) (curlet))))) (inlet 'x 1 'y 2))
+
+ (test (clamp 1 0 3) 1)
+ (test (clamp 1 2 3) 2)
+ (test (clamp 1 4 3) 3)
+
+ (test (n-choose-k 4 4) 1)
+ (test (n-choose-k 4 3) 4)
+ (test (n-choose-k 4 2) 6)
+ (test (n-choose-k 4 1) 4)
+ (test (n-choose-k 4 0) 1)
+
+ (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ b c)) (set! b 4) (set! c 5) a) 9)
+ (test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (reactive-set! a (+ b c)) (set! c 5) a) 14)
+ (test (let ((expr 21) (symbol 1)) (reactive-set! expr (* symbol 2)) (set! symbol 3) expr) 6)
+ (test (let ((a 21) (b 1)) (reactive-set! a (* b 2)) (set! b 3) a) 6)
+ (test (let ((s 21) (v 1)) (reactive-set! s (* v 2)) (set! v 3) s) 6)
+ (test (let ((a 21) (v 1)) (reactive-set! a (* v 2)) (set! v 3) a) 6)
+ (test (let ((symbol 21) (nv 1)) (reactive-set! symbol (* nv 2)) (set! nv 3) symbol) 6)
+ (test (let ((nv 21) (sym 1)) (reactive-set! nv (* sym 2)) (set! sym 3) nv) 6)
+ (test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (let ((a 10)) (set! a (+ b 5)) (list a b))) '(10 5))
+ (test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (list (let ((b 10)) (set! a (+ b 5)) a) b)) '(15 19))
+ (test (let ((a 21) (b 1)) (set! (symbol-access 'b) (lambda (x y) (* 2 y))) (reactive-set! a (* b 2)) (set! b 3) a) 12)
+ (test (let ((a 21) (b 1)) (set! (symbol-access 'b) (lambda (x y) (* 2 y))) (let ((b 2)) (reactive-set! a (* b 2)) (set! b 3) a)) 6)
+ (test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (let ((a 0)) (reactive-set! a (+ b c)) (set! c 5) a)) 14)
+ (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (reactive-set! b (+ c 4))) (list a b c)) '(7 7 3))
+ (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ 1 (reactive-set! b (+ c 4)))) (list a b c)) '(8 7 3))
+ (test (let ((a 1) (v (vector 1 2 3))) (reactive-set! (v 1) (* a 3)) (set! a 4) v) #(1 12 3))
+
+ (test (let ((a 1)) (let ((v (reactive-vector a (+ a 1) 2))) (set! a 4) v)) #(4 5 2))
+ (test (let* ((a 1) (v (reactive-vector a (+ a 1) 2))) (set! a 4) v) #(4 5 2))
+ (test (let* ((a 1) (v (reactive-vector a (+ a 1) (* 2 (_ 0))))) (set! a 4) (v 'value)) #(4 5 8))
+ (test (let ((v (let ((a 1)) (reactive-vector a (+ a 1) (* 2 (_ 0)))))) (set! (v 0) 3) (v 'value)) #(3 2 6))
+
+ ;; unfortunately, reactive-set! does not clear out dead symbol-accessors:
+ ;; (let ((a 1) (b 2)) (let ((c 3)) (reactive-set! b (* a c))) (let ((c 4)) (reactive-set! b (+ a 1)) (set! a 5)) (list a b))
+ ;; complains about unbound curlet gensym because the let it is defined in has been exited but the function still sits on the accessor
+
+ (test (reactive-let () 3) 3)
+ (test (let ((a 1)) (reactive-let ((b (+ a 1))) b)) 2)
+ (test (let ((a 1)) (+ (reactive-let ((b (+ a 1))) (set! a 3) b) a)) 7)
+ (test (let ((a 1)) (+ (reactive-let ((b (+ a 1)) (a 0)) (set! a 3) b) a)) 3)
+ (test (let ((a 1)) (reactive-let ((a 2) (b (* a 3))) (set! a 3) b)) 3)
+ (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! a 3) b)) 3)
+ (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! b 3) a)) 4)
+ (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2))) (set! b 3) a)) 6)
+ (test (let ((a 1)) (reactive-let ((b (+ a 1))) (set! a 3) b)) 4)
+ (test (let ((a 1)) (reactive-let ((b (+ a 1)) (c (* a 2))) (set! a 3) (+ c b))) 10)
+ (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (+ b c))) 11)
+ (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3)) (symbol-access 'a)) #f)
+ (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (set! d 12) (+ b c))) 11)
+ (test (let ((a 1) (b 2)) (+ (reactive-let ((b (+ a 1)) (c (* b 2))) (set! a 3) (+ b c)) a b)) 13) ;c=4 because it watches the outer b
+ (test (let ((a 1)) (reactive-let ((b (* a 2))) (reactive-let ((c (* a 3))) (set! a 2) (+ b c)))) 10)
+ (test (let ((a 1)) (reactive-let ((b (* a 2))) (let ((d (reactive-let ((c (* a 3))) c))) (set! a 2) (+ b d)))) 7)
+ (test (let ((a 1)) (reactive-let ((b (* a 2))) (+ (reactive-let ((c (* a 3))) c) (set! a 2) b))) 9) ; a=2 is added to b=4 and c=3
+ (test (let ((a 1)) (reactive-let ((b (+ a 1))) (reactive-let ((c (* b 2))) (begin (set! a 3) (+ c b))))) 12)
+ (test (reactive-let ((a (lambda (b) b))) (a 1)) 1)
+ (test (reactive-let ((a (let ((b 1) (c 2)) (+ b c)))) a) 3)
+ (test (let ((b 1)) (reactive-let ((a (let ((b 1) (c 2)) (+ b c))) (c (* b 2))) (set! b 43) c)) 86)
+ (num-test (let ((x 0.0)) (reactive-let ((y (sin x))) (set! x 1.0) y)) (sin 1.0))
+ (num-test (let ((x 0.0)) (reactive-let* ((y x) (z (* y (cos x)))) (set! x 1.0) z)) (cos 1.0))
+ (test (let ((a 1)) (reactive-let* ((b a) (x (+ a b))) (set! a 3) (list b x))) '(3 6))
+ (test (let ((a 1)) (reactive-let ((b a) (c a)) (set! a 3) (list b c))) '(3 3))
+ (test (let ((a 1)) (reactive-let* ((b a) (c (* b a))) (set! a 3) (list b c))) '(3 9))
+ (test (let ((a 1)) (reactive-let ((b a)) (reactive-let ((c (* b a))) (set! a 3) (list b c)))) '(3 9))
+ (test (let ((a 1) (b 2)) (reactive-let ((c a) (d (* b a))) (set! a 3) (list a b c d))) '(3 2 3 6))
+ (test (let ((a 1)) (reactive-let ((b (* a 2)) (c (* a 3)) (d (* a 4))) (set! a 2) (list a b c d))) '(2 4 6 8))
+ (test (let ((b 2)) (reactive-let ((a (* b 2))) (+ (reactive-let ((a (* b 3))) (set! b 3) a) a))) 15)
+
+ ;; (let ((a 1)) (define (set-a x) (set! a x)) (reactive-let ((b (* a 2))) (set-a 3) b)) -> b is still 2
+ ;; we can't see the outer set! without changing the outer accessor
+ ;; even: (rlet ((a 1)) (define (set-a x) (set! a x)) (rlet ((b (* a 2))) (set-a 3) b)) -> 2
+ ;; (let ((a 1)) (define (set-a x e) (set! (e 'a) x)) (rlet ((b (* a 2))) (set-a 3 (curlet)) b)) -> 6
+ ;; (let ((a 1)) (define-macro (set-a x) `(set! a ,x)) (rlet ((b (* a 2))) (set-a 3) b)) -> 6
+
+ ;; reactive-set! places an accessor but never removes it -- dangling refs eventually
+
+ (let ((max-stack 0))
+ (define (tc-1 a c)
+ (reactive-let ((b (+ a 1)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
+ (if (< b c)
+ (tc-1 b c))))
+ (tc-1 0 32)
+ (if (> max-stack 12) (format *stderr* ";reactive-let tc max: ~D~%" max-stack)))
+
+ (test (let ((a 1)) (reactive-let* ((b (+ a 1)) (c (* b 2))) (set! a 3) (+ c b))) 12)
+ (test (let ((a 1)) (reactive-let* ((b (+ a 1))) (set! a 3) b)) 4)
+ (test (reactive-let* ((a 1) (b (* a 2))) (set! a 3) b) 6)
+
+ (let ((max-stack 0))
+ (define (tc-2 a c)
+ (reactive-let* ((b (+ a 1)))
+ (if (> (-s7-stack-top-) max-stack)
+ (set! max-stack (-s7-stack-top-)))
+ (if (< b c)
+ (tc-2 b c))))
+ (tc-2 0 32)
+ (if (> max-stack 12) (format *stderr* ";reactive-let* tc max: ~D~%" max-stack)))
+
+
+ (let ((e (let ((a 1) (b 2)) (reactive-lambda* (s v) ((curlet) s)) (curlet)))) ; constant let
+ (test (set! (e 'a) 32) 1)
+ (set! (e 'b) 12)
+ (test (e 'b) 2)
+ (test (with-let e (set! a 32) a) 1))
+
+ (let ()
+ (define (make-library)
+ (let ((A 1.0) ; define a library with 2 globals (A and B) and a function (f1)
+ (B 2.0))
+ (reactive-lambda* (s v) ; make sure B is always twice A
+ (case s
+ ((A) (set! B (* 2 v)))
+ ((B) (set! A (/ v 2))))
+ v)
+ (define (f1 x)
+ (+ A (* B x)))
+ (curlet)))
+ (with-let (make-library)
+ (num-test (f1 3.0) 7.0)
+ (set! A 3.0)
+ (num-test B 6.0)
+ (num-test (f1 3.0) 21.0)
+ (set! B 4.0)
+ (num-test (f1 3.0) 14.0)))
+
+ (let ((lst ()))
+ (call-with-input-vector
+ (vector 1 2 3 4)
+ (lambda (p)
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (set! lst (cons (read p) lst)))))
+ (test lst '(4 3 2 1)))
+
+ (test (call-with-output-vector
+ (lambda (p)
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (write (* i 2) p) ; ("do" does not rebind in s7)
+ (display (* i 4) p)
+ (format p "~A" i))))
+ #(0 0 "0" 2 4 "1" 4 8 "2" 6 12 "3"))
+
+ (test (subsequence (list 1 2 3 4)) (list 1 2 3 4))
+ (test (subsequence (list 1 2 3 4) 1) (list 2 3 4))
+ (test (subsequence (list 1 2 3 4) 1 3) (list 2 3))
+ (test (subsequence (list 1 2 3 4) 3 3) ())
+ (test (subsequence #(1 2 3 4) 2) #(3 4))
+ (test (subsequence "1234" 1) "234")
+ (when with-block (test (subsequence (block .1 .2 .3 .4) 1 3) (block .2 .3)))
+ (let ((e (openlet (inlet 'value #(1 2 3 4) 'subsequence (lambda args (apply subsequence ((car args) 'value) (cdr args)))))))
+ (test (subsequence e 1 3) #(2 3))
+ (test (subsequence e 1) #(2 3 4))
+ (test (apply subsequence e ()) #(1 2 3 4))
+ (test (subsequence e) #(1 2 3 4)))
+
+ (let ((vpl (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 3)
+ (test (sequence->string '(0 1 2)) "(0 1 2)")
+ (test (sequence->string '()) "()")
+ (test (sequence->string '(0 1 2 3)) "(0 1 2 ...)")
+ (test (sequence->string #(0 1 2)) "#(0 1 2)")
+ (test (sequence->string #()) "#()")
+ (test (sequence->string #(0 1 2 3)) "#(0 1 2 ...)")
+ (test (sequence->string (hash-table)) "(hash-table)")
+ (test (string? (sequence->string (hash-table '(a . 1) '(b . 2) '(c . 3)))) #t)
+ (test (string? (sequence->string (hash-table '(a . 1) '(b . 2) '(c . 3) '(d . 4)))) #t)
+ (test (sequence->string (inlet)) "(inlet)")
+ (test (sequence->string (inlet 'a 1 'b 2 'c 3)) "(inlet '(a . 1) '(b . 2) '(c . 3))")
+ (test (sequence->string (inlet 'a 1 'b 2 'c 3 'd 4)) "(inlet '(a . 1) '(b . 2) '(c . 3) ...)")
+ (test (sequence->string "") "\"\"")
+ (test (sequence->string "abc") "\"abc\"")
+ (test (sequence->string "abcd") "\"abc ...\"")
+ (test (sequence->string #u8()) "#u8()")
+ (test (sequence->string (->byte-vector "abc")) "#u8(97 98 99)")
+ (test (sequence->string (byte-vector 0 1 2 3)) "#u8(0 1 2 ...)")
+ (test (sequence->string (float-vector)) "#()")
+ (test (sequence->string (float-vector 0 1 2 3)) "#(0.0 1.0 2.0 ...)")
+ (test (sequence->string (float-vector 0 1 2)) "#(0.0 1.0 2.0)")
+ (when with-block (test (sequence->string (block)) "(block)"))
+ (when with-block (test (sequence->string (block 0 1 2)) "(0.0 1.0 2.0)"))
+ (when with-block (test (sequence->string (block 0 1 2 3)) "(0.0 1.0 2.0 ...)") )
+ (set! (*s7* 'print-length) 8)
+ (test (string? (sequence->string (hash-table '(a . 1) '(b . 2) '(c . 3) '(d . 4)))) #t)
+ (test (sequence->string (inlet 'a 1 'b 2 'c 3 'd 4)) "(inlet '(a . 1) '(b . 2) '(c . 3) '(d . 4))")
+ (set! (*s7* 'print-length) vpl))
+
+ (test (pair? (member :heap-size (*s7*->list))) #t)
+
+ (test (cdr-assoc 'a '((a . 1) (b . 2))) 1)
+ (test (cdr-assoc 'c '((a . 1) (b . 2))) #f)
+ (test (cdr-assoc 'c ()) #f)
+ (test (adjoin 'a ()) '(a))
+ (test (adjoin 'a '(a)) '(a))
+ (test (adjoin 'a '(b a c)) '(b a c))
+ (test (adjoin 'a '(b c)) '(a b c))
+
+ (define (Display-test)
+
+ (define-macro (with-Display . body)
+ `(call-with-output-string
+ (lambda (p)
+ (let ((oldp (Display-port)))
+ (set! (Display-port) p)
+ , at body
+ (set! (Display-port) oldp)))))
+
+ (define (strip-comments s)
+ (let* ((len (length s))
+ (new-s (make-string len #\null)))
+ (do ((i 0 (+ i 1))
+ (j 0)
+ (k 1))
+ ((= i len) (substring new-s 0 j))
+ (case (s i)
+ ((#\;)
+ (set! k 0)
+ (set! j (- j 1)))
+ ((#\newline)
+ (set! k 1)
+ (set! (new-s j) #\newline))
+ (else (set! (new-s j) (s i))))
+ (set! j (+ j k)))))
+
+ (define (Display-string=? s1 s2)
+ (or (string=? s1 s2)
+ (string=? (strip-comments s1) s2)))
+ (Display (define (hi x) (+ x 1)))
+ (let ((str (with-Display (hi 1))))
+ (if (not (Display-string=? str "(hi :x 1)\n -> 2\n"))
+ (format *stderr* "Display 0: (hi 1) -> ~S~%" (strip-comments str))))
+
+ (define (ho y) (let ((z (+ y 1))) (hi z)))
+ (let ((str (with-Display (ho 1))))
+ (if (not (Display-string=? str "(hi :x 2) ;called from ho\n -> 3\n"))
+ (format *stderr* "Display 1: (ho 1) -> ~S~%" (strip-comments str))))
+
+ (Display (define (ho y) (let ((z (+ y 1))) (hi z))))
+ (let ((str (with-Display (ho 1))))
+ (if (not (Display-string=? str "(ho :y 1)\n (let ((z . 2))\n (hi :x 2)\n -> 3\n (hi z)) -> 3\n -> 3\n"))
+ (format *stderr* "Display 1a: (ho 1) -> ~S~%" (strip-comments str))))
+
+ (Display (define (hi x) (if (> x 0) (hi (- x 1)) 0)))
+ (let ((str (with-Display (hi 1))))
+ (if (not (Display-string=? str "(hi :x 1)\n (hi :x 0)\n -> 0\n -> 0\n"))
+ (format *stderr* "Display 2: (hi 1) -> ~S~%" (strip-comments str))))
+
+ (Display (define (hi a b) (+ a b)))
+ (let ((str (with-Display (hi 1 2))))
+ (if (and (not (Display-string=? str "(hi :a 1 :b 2)\n -> 3\n"))
+ (not (Display-string=? str "(hi :b 2 :a 1)\n -> 3\n")))
+ (format *stderr* "Display 3: (hi 1 2) -> ~S~%" (strip-comments str))))
+
+ (Display (define (hi x) (let ((a 1) (b 2)) (+ x a b))))
+ (let ((str (with-Display (hi 1))))
+ (if (not (Display-string=? str "(hi :x 1)\n (let ((a . 1) (b . 2))\n (+ x a b)) -> 4\n -> 4\n"))
+ (format *stderr* "Display 4: (hi 1) -> ~S~%" (strip-comments str))))
+
+ (Display (define (hi x) (let ((a 1) (b 2) (c 3) (d 4) (e 5) (f 6) (g 7)) (+ x e))))
+ (let ((str (with-Display (hi 1))))
+ (if (not (Display-string=? str "(hi :x 1)\n (let ((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6) ...)\n (+ x e)) -> 6\n -> 6\n"))
+ (format *stderr* "Display 5: (hi 1) -> ~S~%" (strip-comments str))))
+
+ (Display (define (hi x) (x 0)))
+ (let ((str (with-Display (hi '(0 1 2 3 4 5 6)))))
+ (if (not (Display-string=? str "(hi :x (0 1 2 3 4 5 ...))\n -> 0\n"))
+ (format *stderr* "Display 5: (hi '(0 1 2 3 4 5 6)) -> ~S~%" (strip-comments str))))
+
+ (let ((str (with-Display (hi #(0 1 2 3 4 5 6)))))
+ (if (not (Display-string=? str "(hi :x #(0 1 2 3 4 5 ...))\n -> 0\n"))
+ (format *stderr* "Display 5: (hi #(0 1 2 3 4 5 6)) -> ~S~%" (strip-comments str))))
+
+ (let ((str (with-Display (hi #u8(0 1 2 3 4 5 6)))))
+ (if (not (Display-string=? str "(hi :x #u8(0 1 2 3 4 5 ...))\n -> 0\n"))
+ (format *stderr* "Display 5: (hi #u8(0 1 2 3 4 5 6)) -> ~S~%" (strip-comments str))))
+
+ (let ((str (with-Display (hi "01234567"))))
+ (if (not (Display-string=? str "(hi :x \"012345 ...\")\n -> #\\0\n"))
+ (format *stderr* "Display 5: (hi \"01234567\") -> ~S~%" (strip-comments str))))
+
+ (Display (define (hi x) (x 'a)))
+ (let ((str (with-Display (hi (hash-table '(a . 1))))))
+ (if (not (Display-string=? str "(hi :x (hash-table '(a . 1)))\n -> 1\n"))
+ (format *stderr* "Display 5: (hi (hash-table '(a . 1))) -> ~S~%" (strip-comments str))))
+
+ (let ((str (with-Display (hi (inlet 'a 1)))))
+ (if (not (Display-string=? str "(hi :x (inlet '(a . 1)))\n -> 1\n"))
+ (format *stderr* "Display 5: (hi (inlet 'a 1)) -> ~S~%" (strip-comments str))))
+
+ (Display (define* (hi (x 1)) (* x 2)))
+ (let ((str (with-Display (hi))))
+ (if (not (Display-string=? str "(hi :x 1)\n -> 2\n"))
+ (format *stderr* "Display 6: (hi) -> ~S~%" (strip-comments str))))
+
+ (let ((y 5))
+ (Display (define* (hi (x (* y 2))) (* x 3)))
+ (let ((str (with-Display (hi))))
+ (if (not (Display-string=? str "(hi :x 10)\n -> 30\n"))
+ (format *stderr* "Display 7: (hi) -> ~S~%" (strip-comments str))))
+
+ (let ((str (with-Display (hi 3))))
+ (if (not (Display-string=? str "(hi :x 3)\n -> 9\n"))
+ (format *stderr* "Display 8: (hi) -> ~S~%" (strip-comments str)))))
+
+ (Display
+ (define (f1 x)
+ (or (> x 1)
+ (< x -1)
+ (= x 0))))
+
+ (let ((str (with-Display (f1 1))))
+ (if (not (Display-string=? str "(f1 :x 1)\n -> #f\n"))
+ (format *stderr* "Display 9: (f1 1) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f1 -2))))
+ (if (not (Display-string=? str "(f1 :x -2)\n (or ... (< x -1) ... ) -> #t\n -> #t\n"))
+ (format *stderr* "Display 9: (f1 -2) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f1 2))))
+ (if (not (Display-string=? str "(f1 :x 2)\n (or (> x 1) ... ) -> #t\n -> #t\n"))
+ (format *stderr* "Display 9: (f1 2) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f1 0))))
+ (if (not (Display-string=? str "(f1 :x 0)\n (or ... (= x 0)) -> #t\n -> #t\n"))
+ (format *stderr* "Display 9: (f1 0) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f2 x)
+ (and (> x 1)
+ (not (= x 3))
+ (integer? x))))
+
+ (let ((str (with-Display (f2 0))))
+ (if (not (Display-string=? str "(f2 :x 0)\n (and (> x 1) ... ) -> #f\n -> #f\n"))
+ (format *stderr* "Display 10: (f2 0) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f2 2))))
+ (if (not (Display-string=? str "(f2 :x 2)\n -> #t\n"))
+ (format *stderr* "Display 10: (f2 2) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f2 3))))
+ (if (not (Display-string=? str "(f2 :x 3)\n (and ... (not (= x 3)) ... ) -> #f\n -> #f\n"))
+ (format *stderr* "Display 10: (f2 3) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f2 3.5))))
+ (if (not (Display-string=? str "(f2 :x 3.5)\n (and ... (integer? x)) -> #f\n -> #f\n"))
+ (format *stderr* "Display 10: (f2 3.5) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f3 x)
+ (let ((y (* x 2)))
+ (and (> y 1)
+ (not (= y 6))
+ (integer? x)))))
+
+ (let ((str (with-Display (f3 3.5))))
+ (if (not (Display-string=? str "(f3 :x 3.5)\n (let ((y . 7.0))\n (and (> y 1) (not (= y 6)) (integer? x))) -> #f\n -> #f\n"))
+ (format *stderr* "Display 11: (f3 3.5) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f4 x)
+ (display x (Display-port))
+ (newline (Display-port))
+ (* x 2)))
+
+ (let ((str (with-Display (f4 1))))
+ (if (not (Display-string=? str "(f4 :x 1)\n1\n -> 2\n"))
+ (format *stderr* "Display 12: (f4 1) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f5 x)
+ (when (> x 1)
+ (display x (Display-port))
+ (newline (Display-port))
+ (* x 2))))
+
+ (let ((str (with-Display (f5 3))))
+ (if (not (Display-string=? str "(f5 :x 3)\n3\n(when ... (* x 2)) -> 6\n -> 6\n"))
+ (format *stderr* "Display 13: (f5 3) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f5 0))))
+ (if (not (Display-string=? str "(f5 :x 0)\n(when (> x 1) -> #f ...)\n -> #<unspecified>\n"))
+ (format *stderr* "Display 13: (f5 0) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f5a x)
+ (unless (> x 1)
+ (display x (Display-port))
+ (newline (Display-port))
+ (* x 2))))
+
+ (let ((str (with-Display (f5a 3))))
+ (if (not (Display-string=? str "(f5a :x 3)\n(unless (> x 1) -> #t ...)\n -> #<unspecified>\n"))
+ (format *stderr* "Display 14: (f5a 3) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f5a 0))))
+ (if (not (Display-string=? str "(f5a :x 0)\n0\n(unless ... (* x 2)) -> 0\n -> 0\n"))
+ (format *stderr* "Display 14: (f5a 0) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f6 x)
+ (begin
+ (display x (Display-port))
+ (newline (Display-port))
+ (* x 2))))
+
+ (let ((str (with-Display (f6 3))))
+ (if (not (Display-string=? str "(f6 :x 3)\n3\n(begin ... (* x 2)) -> 6\n -> 6\n"))
+ (format *stderr* "Display 15: (f6 3) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f7 x)
+ (cond ((= x 0) 123)
+ ((> x 1) (display x (Display-port)) (newline (Display-port)) (* x 2))
+ (#t x))))
+
+ (let ((str (with-Display (f7 3))))
+ (if (not (Display-string=? str "(f7 :x 3)\n3\n (cond ... ((> x 1) (display x (Display-port)) (newline (Display-port)) (* x 2)) ... ) -> 6\n -> 6\n"))
+ (format *stderr* "Display 16: (f7 3) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f7 0))))
+ (if (not (Display-string=? str "(f7 :x 0)\n (cond ((= x 0) 123) ... ) -> 123\n -> 123\n"))
+ (format *stderr* "Display 16: (f7 0) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f7 1))))
+ (if (not (Display-string=? str "(f7 :x 1)\n (cond ... (#t x)) -> 1\n -> 1\n"))
+ (format *stderr* "Display 16: (f7 1) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f8 x)
+ (case (+ x 1)
+ ((0) 123)
+ ((1 2 3) 0)
+ (else 4))))
+
+ (let ((str (with-Display (f8 3))))
+ (if (not (Display-string=? str "(f8 :x 3)\n (case [4] ... (else 4)) -> 4\n -> 4\n"))
+ (format *stderr* "Display 17: (f8 3) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f8 -1))))
+ (if (not (Display-string=? str "(f8 :x -1)\n (case [0] ((0) 123) ... ) -> 123\n -> 123\n"))
+ (format *stderr* "Display 17: (f8 -1) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f8 1))))
+ (if (not (Display-string=? str "(f8 :x 1)\n (case [2] ... ((1 2 3) 0) ... ) -> 0\n -> 0\n"))
+ (format *stderr* "Display 17: (f8 1) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f9 x)
+ (if (< x 0) (* x 2) (* x 3))))
+
+ (let ((str (with-Display (f9 3))))
+ (if (not (Display-string=? str "(f9 :x 3)\n -> 9\n"))
+ (format *stderr* "Display 18: (f9 3) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f10 x)
+ (dynamic-wind
+ (lambda ()
+ (set! x (* x 2)))
+ (lambda ()
+ (display x (Display-port))
+ (newline (Display-port))
+ (* x 2))
+ (lambda ()
+ (set! x 0)))))
+
+ (let ((str (with-Display (f10 1))))
+ (if (not (Display-string=? str "(f10 :x 1)\n2\n(dynamic-wind ... (* x 2)) -> 4\n -> 4\n"))
+ (format *stderr* "Display 19: (f10 1) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f11 x)
+ (cond (x => abs))))
+
+ (let ((str (with-Display (f11 -1))))
+ (if (not (Display-string=? str "(f11 :x -1)\n (cond (x => abs)) -> 1\n -> 1\n"))
+ (format *stderr* "Display 20: (f11 -1) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f12 x)
+ (cond ((+ x 1) => (lambda (y) (* y 2))))))
+
+ (let ((str (with-Display (f12 2))))
+ (if (not (Display-string=? str "(f12 :x 2)\n (cond ((+ x 1) => (lambda (y) (* y 2)))) -> 6\n -> 6\n"))
+ (format *stderr* "Display 21: (f12 2) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f13 x)
+ (case x
+ ((a) => (lambda (y) y))
+ (else => symbol?))))
+
+ (let ((str (with-Display (f13 'a))))
+ (if (not (Display-string=? str "(f13 :x a)\n (case [a] ((a) => (lambda (y) y)) ... ) -> a\n -> a\n"))
+ (format *stderr* "Display 22: (f13 'a) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f13 1))))
+ (if (not (Display-string=? str "(f13 :x 1)\n (case [1] ... (else => symbol?)) -> #f\n -> #f\n"))
+ (format *stderr* "Display 22: (f13 1) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f14 . x)
+ (display x (Display-port))
+ (newline (Display-port))
+ (apply + x)))
+
+ (let ((str (with-Display (f14))))
+ (if (not (Display-string=? str "(f14 :x ())\n()\n -> 0\n"))
+ (format *stderr* "Display 23: (f14) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f14 1))))
+ (if (not (Display-string=? str "(f14 :x (1))\n(1)\n -> 1\n"))
+ (format *stderr* "Display 23: (f14 1) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f14 1 2))))
+ (if (not (Display-string=? str "(f14 :x (1 2))\n(1 2)\n -> 3\n"))
+ (format *stderr* "Display 23: (f14 1 2) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (let ((a 1) (b 2)) (f14 a b)))))
+ (if (not (Display-string=? str "(f14 :x (1 2))\n(1 2)\n -> 3\n"))
+ (format *stderr* "Display 23: (f14 a b) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f15)
+ (+ 1 2)))
+
+ (let ((str (with-Display (f15))))
+ (if (not (Display-string=? str "(f15)\n -> 3\n"))
+ (format *stderr* "Display 23: (f15) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f16 x)
+ (case (+ x 1)
+ ((0) 123)
+ ((1 2 3) 0))))
+
+ (let ((str (with-Display (f16 4))))
+ (if (not (Display-string=? str "(f16 :x 4)\n (case [5] falls through\n -> #<unspecified>\n"))
+ (format *stderr* "Display 24: (f16 4) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define (f17 x . y)
+ (display y (Display-port))
+ (newline (Display-port))
+ (apply + x y)))
+
+ (let ((str (with-Display (f17 1))))
+ (if (and (not (Display-string=? str "(f17 :x 1 :y ())\n()\n -> 1\n"))
+ (not (Display-string=? str "(f17 :y () :x 1)\n()\n -> 1\n")))
+ (format *stderr* "Display 25: (f17 1) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f17 1 2))))
+ (if (and (not (Display-string=? str "(f17 :x 1 :y (2))\n(2)\n -> 3\n"))
+ (not (Display-string=? str "(f17 :y (2) :x 1)\n(2)\n -> 3\n")))
+ (format *stderr* "Display 25: (f17 1 2) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (let ((a 1) (b 2)) (f17 a b)))))
+ (if (and (not (Display-string=? str "(f17 :x 1 :y (2))\n(2)\n -> 3\n"))
+ (not (Display-string=? str "(f17 :y (2) :x 1)\n(2)\n -> 3\n")))
+ (format *stderr* "Display 25: (f17 a b) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define* (f18 (x 1) (y 2))
+ (display y (Display-port))
+ (newline (Display-port))
+ (+ x y)))
+
+ (let ((str (with-Display (f18))))
+ (if (and (not (Display-string=? str "(f18 :x 1 :y 2)\n2\n -> 3\n"))
+ (not (Display-string=? str "(f18 :y 2 :x 1)\n2\n -> 3\n")))
+ (format *stderr* "Display 26: (f18) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f18 3))))
+ (if (and (not (Display-string=? str "(f18 :x 3 :y 2)\n2\n -> 5\n"))
+ (not (Display-string=? str "(f18 :y 2 :x 3)\n2\n -> 5\n")))
+ (format *stderr* "Display 26: (f18 3) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f18 :y 32))))
+ (if (and (not (Display-string=? str "(f18 :x 1 :y 32)\n32\n -> 33\n"))
+ (not (Display-string=? str "(f18 :y 32 :x 1)\n32\n -> 33\n")))
+ (format *stderr* "Display 26: (f18 :y 32) -> ~S~%" (strip-comments str))))
+ (let ((str (with-Display (f18 :y 32 :x 12))))
+ (if (and (not (Display-string=? str "(f18 :x 12 :y 32)\n32\n -> 44\n"))
+ (not (Display-string=? str "(f18 :y 32 :x 12)\n32\n -> 44\n")))
+ (format *stderr* "Display 26: (f18 :y 32 :x 12) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define* (f19 (x 1) y)
+ (display y (Display-port))
+ (newline (Display-port))
+ (list x y)))
+
+ (let ((str (with-Display (f19))))
+ (if (and (not (Display-string=? str "(f19 :x 1 :y #f)\n#f\n -> (1 #f)\n"))
+ (not (Display-string=? str "(f19 :y #f :x 1)\n#f\n -> (1 #f)\n")))
+ (format *stderr* "Display 27: (f19) -> ~S~%" (strip-comments str))))
+
+ (Display
+ (define* (f20 x :rest y)
+ (display y (Display-port))
+ (newline (Display-port))
+ (list x y)))
+
+ (let ((str (with-Display (f20))))
+ (if (and (not (Display-string=? str "(f20 :x #f :y ())\n()\n -> (#f ())\n"))
+ (not (Display-string=? str "(f20 :y () :x #f)\n()\n -> (#f ())\n")))
+ (format *stderr* "Display 28: (f20) -> ~S~%" (strip-comments str))))
+
+ (let ((str (with-Display (let ((x 1)) (Display (or (< x 1) (= x 1)))))))
+ (if (not (Display-string=? str " (or ... (= x 1)) -> #t\n"))
+ (format *stderr* "Display 29: (or...) -> ~S~%" (strip-comments str))))
+
+ (let ((str (with-Display (let ((x 1)) (Display (when (> x 0) (+ x 1)))))))
+ (if (not (Display-string=? str "(when ... (+ x 1)) -> 2\n"))
+ (format *stderr* "Display 30: (when...) -> ~S~%" (strip-comments str))))
+
+ (let ((str (with-Display (Display (let ((x 1)) (+ x 1))))))
+ (if (not (Display-string=? str "(let ((x . 1))\n (+ x 1)) -> 2\n"))
+ (format *stderr* "Display 30: (let...) -> ~S~%" (strip-comments str))))
+
+ (set! ((funclet Display) '*display-spacing*) 4)
+ (Display (define (f21 x) (if (> x 0) (f21 (- x 1)) 0)))
+ (let ((str (with-Display (f21 2))))
+ (if (not (Display-string=? str "(f21 :x 2)\n (f21 :x 1)\n (f21 :x 0)\n -> 0\n -> 0\n -> 0\n"))
+ (format *stderr* "Display 31: (f21 2) -> ~S~%" (strip-comments str))))
+
+ (set! ((funclet Display) '*display-spacing*) 1)
+ (Display (define (f21 x) (if (> x 0) (f21 (- x 1)) 0)))
+ (let ((str (with-Display (f21 2))))
+ (if (not (Display-string=? str "(f21 :x 2)\n (f21 :x 1)\n (f21 :x 0)\n -> 0\n -> 0\n -> 0\n"))
+ (format *stderr* "Display 31a: (f21 2) -> ~S~%" (strip-comments str))))
+
+ (set! ((funclet Display) '*display-spacing*) 2)
+ )
+ (Display-test)
+ )
+
+(let ()
+ (require write.scm)
+
+ (if (not (string=? (pp '(lambda* (a b) (+ a b) (* 1 2))) "(lambda* (a b)\n (+ a b)\n (* 1 2))"))
+ (format *stderr* "pp 1~%"))
+ (if (not (string=? (pp '(let ((a 1) (b 2)) (+ a b))) "(let ((a 1)\n (b 2))\n (+ a b))"))
+ (format *stderr* "pp 2~%"))
+ (if (not (string=? (pp '(let () (+ a b))) "(let ()\n (+ a b))"))
+ (format *stderr* "pp 2a~%"))
+ (if (not (string=? (pp '(begin (+ 1 2) (* 2 3))) "(begin\n (+ 1 2)\n (* 2 3))"))
+ (format *stderr* "pp 3~%"))
+ (if (not (string=? (pp '(case a ((a b c) 1) ((d) 2) (else 3))) "(case a\n ((a b c) 1)\n ((d) 2)\n (else 3))"))
+ (format *stderr* "pp 4: ~A~%" (pp '(case a ((a b c) 1) ((d) 2) (else 3)))))
+ (if (not (string=? (pp '(cond ((> a 1) 2) ((< a 3) 3) (#t 4))) "(cond ((> a 1) 2)\n ((< a 3) 3)\n (#t 4))"))
+ (format *stderr* "pp 5~%"))
+ (if (not (string=? (pp '(if a '(1 2 3))) "(if a '(1 2 3))"))
+ (format *stderr* "pp7~%"))
+ (if (not (= ((funclet pretty-print) '*pretty-print-length*) 100))
+ (format *stderr* "*pretty-print-length*: ~A~%" ((funclet pretty-print) '*pretty-print-length*)))
+ (if (not (= ((funclet pretty-print) '*pretty-print-spacing*) 2))
+ (format *stderr* "*pretty-print-spacing*: ~A~%" ((funclet pretty-print) '*pretty-print-spacing*)))
+ (if (not (string=? (pp '(+ pi nan.0 1.123456)) "(+ pi nan.0 1.123456)"))
+ (format *stderr* "pp8~%"))
+ (if (not (string=? (pp 3.1415123123213) "3.1415"))
+ (format *stderr* "pp9: ~A~%" (pp 3.1415123123213)))
+ (let ((old-format ((funclet pretty-print) '*pretty-print-float-format*)))
+ (set! ((funclet pretty-print) '*pretty-print-float-format*) "~,12F")
+ (if (not (string=? (pp 3.1415123123213) "3.141512312321"))
+ (format *stderr* "pp10: ~A~%" (pp 3.1415123123213)))
+ (set! ((funclet pretty-print) '*pretty-print-float-format*) old-format))
+ (set! ((funclet pretty-print) '*pretty-print-spacing*) 8)
+ (if (not (string=? (pp '(let () (+ a b))) "(let ()\n (+ a b))"))
+ (format *stderr* "pp 11~%"))
+ )
+
+
+(let ()
+ (require r7rs.scm)
+
+ ;;; boolean=?
+ (test (boolean=? #f #f) #t)
+ (test (boolean=? #f #t) #f)
+ (test (boolean=? #f #f #f) #t)
+ (test (boolean=? #t #t) #t)
+ (test (boolean=? #f #f #t #f) #f)
+ (test (boolean=? #f (values) #f) #f)
+ (test (boolean=? 1 #t) #f)
+ ;(test (boolean=?) 'error)
+ ;(test (boolean=? #f) 'error)
+ (for-each
+ (lambda (arg)
+ (if (boolean=? #f arg)
+ (format-logged #t ";(boolean=? #f ~A) -> #t?~%" arg)))
+ (list "hi" '(1 2) () "" #() (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) #<eof> #<undefined> #<unspecified>))
+
+ (test (boolean=? #f #false) #t)
+ (test (boolean=? #t #true) #t)
+
+
+ ;;; symbol=?
+ (test (symbol=? 'hi 'hi) #t)
+ (test (symbol=? 'hi 'hi 'hi) #t)
+ (test (symbol=? 'hi 'hi 'ho) #f)
+ (test (symbol=? 'hi 'hi pi) #f)
+ (test (symbol=? #f 'hi) #f)
+ (for-each
+ (lambda (arg)
+ (if (symbol=? 'abs arg)
+ (format-logged #t ";(symbol=? 'abs ~A) -> #t?~%" arg)))
+ (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>))
+ ;(test (symbol=?) 'error)
+ ;(test (symbol=? 'hi) 'error)
+ (test (symbol=? :hi :hi) #t)
+ (test (symbol=? :hi hi:) #f)
+
+ ;; from chibi scheme I think
+ (let*-values (((root rem) (exact-integer-sqrt 32)))
+ (test (* root rem) 35))
+ (test (let ((a 'a) (b 'b) (x 'x) (y 'y))
+ (let*-values (((a b) (values x y))
+ ((x y) (values a b)))
+ (list a b x y)))
+ '(x y x y))
+
+ (test (force (r7rs-delay (+ 1 2))) 3)
+ (test (let ((p (r7rs-delay (+ 1 2)))) (list (force p) (force p))) '(3 3))
+ (let ()
+ (define integers
+ (letrec ((next
+ (lambda (n)
+ (r7rs-delay (cons n (next (+ n 1)))))))
+ (next 0)))
+ (define head (lambda (stream) (car (force stream))))
+ (define tail (lambda (stream) (cdr (force stream))))
+ (test (head (tail (tail integers))) 2)
+
+ (define (stream-filter p? s)
+ (delay-force
+ (if (null? (force s))
+ (r7rs-delay '())
+ (let ((h (car (force s)))
+ (t (cdr (force s))))
+ (if (p? h)
+ (r7rs-delay (cons h (stream-filter p? t)))
+ (stream-filter p? t))))))
+ (test (head (tail (tail (stream-filter odd? integers)))) 5))
+
+ (let ()
+ (define radix (make-parameter 10 (lambda (x) (if (and (integer? x) (<= 2 x 16)) x (error "invalid radix")))))
+ (define (f n) (number->string n (radix)))
+ (test (f 12) "12")
+ (test (parameterize ((radix 2)) (f 12)) "1100")
+ (test (f 12) "12"))
+
+ (let ()
+ (define plus
+ (case-lambda
+ (() 0)
+ ((x) x)
+ ((x y) (+ x y))
+ ((x y z) (+ (+ x y) z))
+ (args (apply + args))))
+ (test (plus) 0)
+ (test (plus 1) 1)
+ (test (plus 1 2) 3)
+ (test (plus 1 2 3) 6)
+ (test (plus 1 2 3 4) 10)
+
+ (define mult
+ (case-lambda
+ (() 1)
+ ((x) x)
+ ((x y) (* x y))
+ ((x y . z) (apply mult (* x y) z))))
+ (test (mult) 1)
+ (test (mult 1) 1)
+ (test (mult 1 2) 2)
+ (test (mult 1 2 3) 6)
+ (test (mult 1 2 3 4) 24))
+
+ (test (let () (define-values (x y) (values 1 2)) (+ x y)) 3)
+ (test (call-with-values (lambda () (exact-integer-sqrt 4)) list) '(2 0))
+ (test (call-with-values (lambda () (exact-integer-sqrt 5)) list) '(2 1))
+
+ (test (vector-copy #()) #())
+ (test (vector-copy #(a b c)) #(a b c))
+ (test (vector-copy #(a b c) 1) #(b c))
+ (test (vector-copy #(a b c) 1 2) #(b))
+
+ (let ((e (box 1)))
+ (test (box? e) #t)
+ (test (unbox e) 1)
+ (test (e 'value) 1)
+ (set-box! e 2)
+ (test (unbox e) 2)
+ (test (string=? (object->string e) "#<box-type: (value 2)>") #t))
+ )
+
+
+;;; --------------------------------------------------------------------------------
+;;;
+;;; cload c-define tests
+;;; (see libc.scm et al below)
+
+(if (provided? 'snd)
+ (begin
+ (load "cload.scm")
+
+ (c-define '((double j0 (double))
+ (double j1 (double))
+ (double erf (double))
+ (double erfc (double))
+ (double lgamma (double)))
+ "m" "math.h")
+ (num-test (m:j0 1.0) 0.76519768655797)
+ (num-test (m:j1 1.0) 0.44005058574493)
+ (num-test (m:j0 1/2) 0.93846980724081)
+ (num-test (m:erf 1.0) 0.84270079294971)
+ (num-test (m:erf 2) 0.99532226501895)
+ (num-test (m:erfc 1.0) 0.15729920705029)
+ (num-test (m:lgamma 2/3) 0.30315027514752)
+
+ (let ()
+ (c-define '(char* getenv (char*)))
+ (c-define '(int setenv (char* char* int)))
+ (test (string? (getenv "HOST")) #t))
+
+ (test (defined? 'setenv) #f)
+
+ (let ()
+ (define local-file-exists? (let () ; define F_OK and access only within this let
+ (c-define '((int F_OK) (int access (char* int))) "" "unistd.h")
+ (lambda (arg) (= (access arg F_OK) 0))))
+
+ (define delete-file (let ()
+ (c-define '(int unlink (char*)) "" "unistd.h")
+ (lambda (file) (= (unlink file) 0)))) ; 0=success
+
+ (test (local-file-exists? "s7test.scm") #t))
+
+ (c-define
+ '((in-C "static struct timeval overall_start_time; \n\
+ static bool time_set_up = false; \n\
+ static double get_internal_real_time(void) \n\
+ { \n\
+ struct timezone z0; \n\
+ struct timeval t0; \n\
+ double secs; \n\
+ if (!time_set_up) {gettimeofday(&overall_start_time, &z0); time_set_up = true;} \n\
+ gettimeofday(&t0, &z0); \n\
+ secs = difftime(t0.tv_sec, overall_start_time.tv_sec);\n\
+ return(secs + 0.000001 * (t0.tv_usec - overall_start_time.tv_usec)); \n\
+ }")
+ (double get_internal_real_time (void)))
+ "" '("time.h" "sys/time.h"))
+
+ (define-macro (new-time func)
+ `(let ((start (get_internal_real_time)))
+ ,func
+ (- (get_internal_real_time) start)))
+
+ (test (real? (new-time (do ((i 0 (+ i 1))) ((= i 30) i)))) #t)
+
+ (when (provided? 'linux)
+ (c-define '(int getpid (void)) "" "unistd.h")
+ (call-with-input-file (format #f "/proc/~D/status" (getpid))
+ (lambda (p)
+ (let ((name (substring (read-line p) 6)))
+ (do ((str (read-line p) (read-line p)))
+ ((eof-object? str))
+ (if (string=? (substring str 0 6) "VmRSS:")
+ (let ((size (with-input-from-string (substring str 7) read)))
+ (format #t "~%~A size: ~A kB, time: ~A~%" name size (*s7* 'cpu-time)))))))))
+ ))
+
+
;;; --------------------------------------------------------------------------------
+(let ((e (openlet (inlet 'absolute-value (lambda (x) (abs x))))))
+ (test (+ 3 ((e 'absolute-value) -3)) 6)
+ (test (catch #t (lambda () (+ ((e 'absolute-value) -3) 32)) (lambda args "oops")) 35)
+ (test (catch #t (lambda () (+ ((e 'absolute-value) "oops") 32)) (lambda args 35)) 35))
-(define* (profile (file "sort.data"))
- ;; find all functions, write out each one's number of calls, sorted first by calls, then alphabetically
+(let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (if (negative? x) (- x) x)))))))
+ (test (+ 3 (abs e)) 6)
+ (test (catch #t (lambda () (+ (abs e) 32)) (lambda args "oops")) 35)
+ (set! (e 'x) "oops")
+ (test (catch #t (lambda () (+ (abs e) 32)) (lambda args 35)) 35))
- (define (where-is func)
- (let* ((env (procedure-environment func))
- (cenv (and (pair? env)
- (car env)))
- (f (and (pair? cenv)
- (assoc '__func__ cenv)))
- (addr (and (pair? f)
- (cdr f))))
- (if (not (pair? addr))
- ""
- (format #f "~A[~D]" (cadr addr) (caddr addr)))))
+(test (+ 32 (call-with-exit
+ (lambda (return)
+ (let ((e (lambda (x) (return (if (negative? x) (- x) x)))))
+ (+ 123 (e -321)))))) 353)
+(test (+ 32 (catch #t
+ (lambda ()
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (error 'oops (if (negative? x) (- x) x))))))))
+ (+ 123 (abs e) -321)))
+ (lambda args 3))) 35)
+(test (+ 32 (catch #t
+ (lambda ()
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (throw 'oops (if (negative? x) (- x) x))))))))
+ (+ 123 (abs e) -321)))
+ (lambda args 3))) 35)
+(test (+ 32 (call-with-exit
+ (lambda (return)
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+ (+ 123 (abs e) -321))))) 35)
+(test (+ 32 (call-with-exit
+ (lambda (return)
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+ (+ 123 (eval `(abs e)) -321))))) 35)
+(test (+ 32 (catch #t
+ (lambda ()
+ (call-with-exit
+ (lambda (return)
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+ (+ 123 (error 'oops (abs e)) -321)))))
+ (lambda args 3))) 35)
+(test (+ 32 (call-with-exit
+ (lambda (return)
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+ (let ((e1 (openlet (inlet 'abs (lambda (x) (abs e))))))
+ (+ 123 (abs e1) -321)))))) 35)
+(test (+ 32 (call-with-exit
+ (lambda (return)
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x))))))))
+ (let ((e1 (openlet (inlet 'abs (lambda (x) (abs e))))))
+ (let ((e2 (openlet (inlet 'abs (lambda (x) (abs e1))))))
+ (+ 123 (abs e2) -321))))))) 35)
+
+(let () ; optimize these things
+ (define (tst-it)
+ (+ 32 (call-with-exit
+ (lambda (return)
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e)
+ (let ((x (e 'x)))
+ (return (if (negative? x) (- x) x))))))))
+ (+ 123 (abs e) -321))))))
+ (test (tst-it) 35)) ; (+ 123 3 -321 32) is -163
- (define (vector-max v start end)
- (let ((m 0))
- (do ((i start (+ i 1)))
- ((= i end) m)
- (if (> (v i) m)
- (set! m (v i))))))
+(let ()
+ (define (tst-it1)
+ (+ 32 (catch 'ok
+ (lambda ()
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e)
+ (let ((x (e 'x)))
+ (throw 'ok (if (negative? x) (- x) x))))))))
+ (+ 123 (abs e) -321)))
+ (lambda (type info)
+ (car info)))))
+ (test (tst-it1) 35))
- (define names (vector 'none 'nil 'string 'num 'sym 'pair 'func 'func* 'cont 'char 'iport 'vect 'mac 'bac
- 'cobj 'sobj 'goto 'oport 'catch 'dynwind 'hash 'bool 'hook 'cmac 'cptr 'cfunc 'cfunc 'cfunc
- 'int 'ratio 'real 'complex 'any 'any 'any))
+(let ()
+ (define (tst-it2)
+ (+ 32 (call/cc
+ (lambda (return)
+ (let ((e (openlet (inlet 'x -3 'abs (lambda (e)
+ (let ((x (e 'x)))
+ (return (if (negative? x) (- x) x))))))))
+ (+ 123 (abs e) -321))))))
+ (test (tst-it2) 35))
- (define wanted (vector #f #t #t #t #t #t #f #f #f #t #f #t #f #f
- #f #f #f #f #f #f #t #t #f #f #f #f #f #f
- #f #f #f #f #f #f #f #f #f #f #f #f))
- (define (display-arg v start)
- (let ((untested #f))
- (format #t " ")
- (do ((i start (+ i 1)))
- ((= i (+ start 28)))
- (if (> (v i) 0)
- (format #t "~A: ~D " (names (- i start)) (v i))
- (if (wanted (- i start))
- (set! untested #t))))
- (if (> (v (+ start 3)) 0)
- (begin
- (format #t "~% ")
- (do ((i (+ start 28) (+ i 1)))
- ((= i (+ start 32)))
- (format #t "~A: ~D " (names (- i start)) (v i)))))
- (if untested
- (begin
- (format #t "~% untested: ")
- (do ((i start (+ i 1)))
- ((= i (+ start 28)))
- (if (and (wanted (- i start))
- (= (v i) 0))
- (format #t "~A " (names (- i start)))))))
- (format #t "~%~%")))
-
- (let ((st (symbol-table))
- (calls (make-vector 50000 '(none (0 #f))))
- (call 0))
- (do ((i 0 (+ i 1)))
- ((= i (length st)))
- (let ((lst (st i)))
+
+;;; reader-cond
+(define (rt2)
+ (reader-cond ((> 3 2) `(+ 1 2))
+ (#t 'error)))
+(test (rt2) '(+ 1 2))
+(define (rt3)
+ (reader-cond ((> 3 2) (+ 1 2))
+ (#t 'error)))
+(test (rt3) 3)
+
+(let ()
+ (define (f1)
+ (let ((x 1)
+ (y 1))
+ (reader-cond ((not (provided? 'asdf))
+ (set! x (+ x 1))
+ (set! x (+ x 1)))
+ (#t (set! x (- x 1))))
+ (reader-cond ((provided? 'asdf)
+ (set! y (+ y 1))
+ (set! y (+ y 1)))
+ (#t (set! y (- y 1))))
+ (list x y)))
+ (f1)
+ (test (f1) (list 3 0)))
+
+(test (list 1 (reader-cond ((> 3 2) 2 3 4)) 5) (list 1 2 3 4 5))
+
+(define-expansion (__exp1__) (values 1 2 3))
+
+
+(let ()
+ (test (abs (+ 2 -3)) (+ 1))
+
+ (define-macro (protected-let vars . body)
+ ;; locals outside this let are not changed (and aren't accessible),
+ ;; and we'll protect the current rootlet values of built-ins
+ `(with-let (inlet :in (apply inlet ',(map (lambda (f)
+ (values (car f) ((rootlet) (car f))))
+ (unlet))))
+ (dynamic-wind
+ (lambda ()
+ #f)
+ (lambda ()
+ (let ,vars , at body))
+ (lambda ()
+ (for-each
+ (lambda (f) ; if any built-in's value has changed in the protected-let, reset it
+ (let ((value-before-let (in (car f))))
+ (unless (equal? (symbol->value (car f)) value-before-let)
+ (apply set! (list (car f)
+ (if (eq? value-before-let #<undefined>) ; it was not changed before
+ (cdr f) ; so use the start-up value
+ value-before-let))))))
+ (unlet))))))
+
+ (let ((abs 32))
+ (let ((val (protected-let ()
+ (set! abs 64)
+ (set! + 0)
+ (test (- + abs) -64)
+ 12)))
+ (test (+ val abs) 44)))
+ (test (abs (+ 2 -3)) (+ 1))
+
+ (define-macro (local-let vars . body)
+ ;; locals outside this let are accessible and can be changed, but we'll protect them and the current rootlet values of built-ins
+ `(let ((in (apply inlet (curlet) ',(map (lambda (f)
+ (values (car f) ((rootlet) (car f))))
+ (unlet)))))
+ (dynamic-wind
+ (lambda ()
+ #f)
+ (lambda ()
+ (let ,vars , at body))
+ (lambda ()
+ (let ((out (unlet)))
+ (when (out 'set!) ; in case set! was changed -- see example below
+ (eval `(define set! #_set!) (rootlet)))
+ (for-each
+ (lambda (f)
+ (let ((value-before-let (in (car f))))
+ (unless (or (equal? (symbol->value (car f)) value-before-let)
+ (eq? 'set! (car f)))
+ (apply #_set! (list (car f)
+ (if (eq? value-before-let #<undefined>)
+ (cdr f)
+ value-before-let))))))
+ (inlet in out)))))))
+#|
+ (let ((abs 32)
+ (a 20))
+ (let ((val (local-let ()
+ (set! abs 64)
+ (set! a 1)
+ (set! + 0)
+ (define (set! a b) b)
+ (format *stderr* "in local-let, abs: ~A, (- + abs): ~A~%" abs (- + abs))
+ 12)))
+ (format *stderr* "in outer let: abs: ~A, (+ abs): ~A, protected-let: ~A, a: ~A~%" abs (+ abs) val a)))
+ (format *stderr* "top: abs: ~A, +: ~A~%" abs +)
+|#
+ (let ((abs 32)
+ (a 20))
+ (let ((val (local-let ()
+ (set! abs 64)
+ (set! + 0)
+ (set! a 1)
+ (test (- + abs) -64)
+ 12)))
+ (test (+ abs a val) 64)))
+ (test (abs -1) (+ 1)))
+
+
+(let ()
+ (define (f1) (let ((lst '(1 2 (reader-cond ((> 1 0) 3) (else 4)) 5 6))) lst))
+ (test (f1) '(1 2 3 5 6))
+ (define (f2) (let ((lst '(1 2 (reader-cond ((> 1 0) 3 4)) 5 6))) lst))
+ (test (f2) '(1 2 3 4 5 6))
+ (define (f3) '((__exp1__) 5))
+ (test (f3) '(1 2 3 5))
+ (define (f4) (+ (__exp1__) (__exp1__)))
+ (test (f4) 12)
+ (define (f5) (let ((lst '((reader-cond ((> 1 0) (__exp1__)) (else 4)) 5 6))) lst))
+ (test (f5) '(1 2 3 5 6))
+ (define (f6) (let ((lst ((reader-cond ((> 1 0) list) (else cons)) 1 2))) lst))
+ (test (f6) '(1 2))
+ (define (f7) (let ((lst ((reader-cond ((= 1 0) vector) ((< 1 0) list) (else cons)) 1 2))) lst))
+ (test (f7) '(1 . 2))
+ (define (f8) (let ((lst ((reader-cond ((> 1 0) quote)) (+ 2 3)))) lst))
+ (test (f8) '(+ 2 3))
+ (define (f9) (let ((lst ((reader-cond ((= 1 0) quote)) list 2 3))) lst))
+ (test (f9) '(2 3))
+ (define (f10) (let ((lst #(0 (reader-cond ((> 1 0) (+ 2 3))) 2))) lst))
+ (test (f10) #(0 (+ 2 3) 2))
+ (define (f11) (let ((lst `(0 ,(reader-cond ((> 1 0) (+ 2 3))) 2))) lst))
+ (test (f11) '(0 5 2))
+ )
+(test (let ((v #(1 (reader-cond (#t 32)) 890))) v) #(1 32 890))
+(test (let ((v #(1 (reader-cond (#t 2 3)) 4))) v) #(1 2 3 4))
+(test (let ((v #(1 (reader-cond ((+ 2 3))) 4))) v) #(1 5 4))
+;;; even worse:
+;; (define (reader-cond ((display "defining hiho\n" *stderr*) hiho)) (lambda () "hiho"))
+;; (format *stderr* "~S~%" (hiho))
+
+
+
+(test (let ((equal? #f)) (member 3 '(1 2 3))) '(3))
+(test (let ((eqv? #f)) (case 1 ((1) 1))) 1) ; scheme wg
+(test (let ((eqv? equal?)) (case "asd" (("asd") 1) (else 2))) 2)
+(test (let ((eq? #f)) (memq 'a '(a b c))) '(a b c))
+(test (let ((if #t)) (or if)) #t)
+(test (let ((if +)) (if 1 2 3)) 6)
+(test (if (let ((if 3)) (> 2 if)) 4 5) 5)
+(test (let ('1 ) quote) 1)
+(test (let ((quote 1)) (+ quote 1)) 2)
+(test (let ((quote -)) '32) -32)
+(test (do ((do 1)) (#t do)) 1)
+(test (do ((do 1 (+ do do))) ((> do 3) do)) 4)
+(test (do ((do 1 do) (j do do)) (do do)) 1)
+(test (do ((do do do)) (do do)) do)
+(test (do ((do do do)) (do do do)) do) ; ok ok!
+(test (or (let ((or #t)) or)) #t)
+(test (and (let ((and #t)) and)) #t)
+(test (let ((=> 3) (cond 4)) (+ => cond)) 7)
+(test (case 1 ((1 2) (let ((case 3)) (+ case 1))) ((3 4) 0)) 4)
+(test (let ((lambda 4)) (+ lambda 1)) 5)
+
+(test (let () (define (hi a) (let ((pair? +)) (pair? a 1))) (hi 2)) 3)
+(test ((lambda (let) (let* ((letrec 1)) (+ letrec let))) 123) 124)
+
+(test (let ((begin 3)) (+ begin 1)) 4)
+(test ((lambda (let*) (let ((letrec 1)) (+ letrec let*))) 123) 124)
+(test ((lambda (quote) (+ quote 1)) 2) 3)
+(test ((lambda (quote . args) (list quote args)) 1 2 3) '(1 (2 3)))
+(test (let ((do 1) (map 2) (for-each 3) (quote 4)) (+ do map for-each quote)) 10)
+(test ((lambda lambda lambda) 'x) '(x))
+(test ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda)) '(1 2 3))
+(test (let* ((let 3) (x let)) (+ x let)) 6)
+(test (((lambda case lcm))) 1)
+(test (((lambda let* *))) 1)
+(test (do ((i 0 1) '(list)) (#t quote)) ())
+(test ((lambda (let) (+)) 0) 0)
+(test (let () (define (hi cond) (+ cond 1)) (hi 2)) 3)
+(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi 2)) 3)
+(test (let () (define* (hi (cond 1)) (+ cond 1)) (hi)) 2)
+(test (let () ((lambda (cond) (+ cond 1)) 2)) 3)
+(test (let () ((lambda* (cond) (+ cond 1)) 2)) 3)
+(test (let () (define-macro (hi cond) `(+ 1 ,cond)) (hi 2)) 3)
+(test (let () (define-macro* (hi (cond 1)) `(+ 1 ,cond)) (hi)) 2)
+(test (let () (define (hi abs) (+ abs 1)) (hi 2)) 3)
+(test (let () (define (hi if) (+ if 1)) (hi 2)) 3)
+
+(test (let () (define* (hi (lambda 1)) (+ lambda 1)) (hi)) 2)
+(test (do ((i 0 0) '(+ 0 1)) ((= i 0) i)) 0) ; guile also! (do ((i 0 0) (quote list (+ 0 1))) ((= i 0) i))?
+(test (let () (define (cond a) a) (cond 1)) 1)
+(test (let ((cond 1)) (+ cond 3)) 4)
+(test (let () (define (tst cond) (if cond 0 1)) (tst #f)) 1)
+(test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (tst cond)) 3)
+(test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (define (val) cond) (tst (val))) 3)
+(test (let () (define-macro (hi a) `(let ((lambda +)) (lambda ,a 1))) (hi 2)) 3)
+(test ((let ((do or)) do) 1 2) 1)
+
+(test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi)) 8)
+(test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi) (hi) (hi)) 8)
+(test (let ((x 12)) (define (hi env) (set! x (env 0)) x) (hi '(1 2 3)) (hi '(1 2 3))) 1)
+(test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3))) 14)
+(test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3))) 14)
+(test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15)
+(test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15)
+
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i (env 1 2)))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (+ 1 2 3)) (+ x 1))) (hi) (hi)) 6)
+(test (let * ((i 0)) (if (< i 1) (* (+ i 1))) i) 0)
+(test (let ((car if)) (car #t 0 1)) 0)
+(test (call-with-exit (lambda (abs) (abs -1))) -1)
+
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,@(map sqrt '(1 4 9)) 2)) '(+ 1 16 81 2))
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(sqrt 9) 4)) '(+ 81 4))
+(test `(+ ,(let ((sqrt (lambda (a) (* a a)))) (sqrt 9)) 4) '(+ 81 4))
+(test `(+ (let ((sqrt (lambda (a) (* a a)))) ,(sqrt 9)) 4) '(+ (let ((sqrt (lambda (a) (* a a)))) 3) 4))
+(test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(apply values (map sqrt '(1 4 9))) 2)) '(+ 1 16 81 2))
+(if (not (provided? 'immutable-unquote)) (test (let ((sqrt (lambda (a) (* a a)))) `(+ (unquote (apply values (map sqrt '(1 4 9)))) 2)) '(+ 1 16 81 2)))
+
+(test ((((eval lambda) lcm gcd))) 0)
+(test ((((lambda - -) -) 0) 1) -1)
+
+(test (let () (define (hi) (let ((oscil >)) (or (< 3 2) (oscil 4 2)))) (hi) (hi)) #t)
+(test (let () (define (hi) (let ((oscil >)) (and (< 2 3) (oscil 4 2)))) (hi) (hi)) #t)
+
+(test ((lambda* ((- 0)) -) :- 1) 1)
+
+(let ()
+ (define-macro (i_ arg)
+ `(with-let (unlet) ,arg))
+
+ (define-bacro* (mac b)
+ `((i_ let) ((a 12))
+ ((i_ +) a ,(symbol->value b))))
+ ;; this assumes the 'b' value is a symbol: (let ((a 1)) (mac (* a 2))) is an error -- see s7.html for a better version
+ (test (let ((a 32)
+ (+ -))
+ (mac a))
+ 44))
+
+;(define (hi) (do ((i 0 (+ i 1))) ((= i 200000) i) (abs i)))
+;(test (hi) 200000)
+
+(let ()
+ (define-macro (cube x) `(with-let (inlet :x ,x) (* x x x)))
+ (test (cube 2) 8)
+ (let ((x 2)) (test (cube (set! x (+ x 1))) 27))
+
+ (define-macro (pop! sym)
+ `(with-let (#_inlet :e (#_curlet) :result (#_car ,sym))
+ (with-let e (#_set! ,sym (#_cdr ,sym)))
+ result))
+
+ (test (let ((lst '(1 2 3))) (list (pop! lst) lst)) '(1 (2 3)))
+ (test (let ((lst (vector (list 1 2 3)))) (list (pop! (lst 0)) lst)) '(1 #((2 3))))
+ (test (let ((result '(1 2 3))) (list (pop! result) result)) '(1 (2 3)))
+ (test (let ((cdr '(1 2 3))) (list (pop! cdr) cdr)) '(1 (2 3)))
+
+ (define-macro (pushnew! val lst)
+ `(set! ,lst (with-let (inlet :val ,val :lst ,lst)
+ (if (not (member val lst))
+ (cons val lst)
+ lst))))
+
+ (test (let ((lst (list 1 2))) (pushnew! 3 lst)) '(3 1 2))
+ (test (let ((val (list 1 2)) (lst 3)) (pushnew! lst val)) '(3 1 2))
+ (test (let ((lst (list 1 2)) (val 3)) (pushnew! val lst)) '(3 1 2))
+ (test (let ((lst (list 1 2)) (member 3)) (pushnew! member lst)) '(3 1 2))
+ )
+
+
+(test (let ()
+ (define-immaculo (hi a) `(let ((b 23)) (+ b ,a)))
+ (let ((+ *)
+ (b 12))
+ (hi b)))
+ 35)
+
+(test (let ()
+ (define-clean-macro (hi a) `(+ ,a 1))
+ (let ((+ *)
+ (a 12))
+ (hi a)))
+ 13)
+
+(test (let ()
+ (define-immaculo (hi a) `(+ ,a 1))
+ (let ((+ *)
+ (a 12))
+ (hi a)))
+ 13)
+
+(test (let ()
+ (define-clean-macro (mac a . body)
+ `(+ ,a , at body))
+ (let ((a 2)
+ (+ *))
+ (mac a (- 5 a) (* a 2))))
+ 9)
+
+(test (let ()
+ (define-macro (mac b)
+ `(let ((a 12))
+ (,+ a ,b)))
+ (let ((a 1)
+ (+ *))
+ (mac a)))
+ 24)
+
+(test (let ()
+ (define-macro (mac b)
+ `(let ((a 12))
+ (+ a ,b)))
+ (let ((a 1)
+ (+ *))
+ (mac a)))
+ 144)
+
+(test (let ()
+ (define-immaculo (mac c d) `(let ((a 12) (b 3)) (+ a b ,c ,d)))
+ (let ((a 21) (b 10) (+ *)) (mac a b)))
+ 46)
+
+(let ()
+ (define-macro (pure-let bindings . body)
+ `(with-let (unlet)
+ (let ,bindings , at body)))
+ (test (let ((+ *) (lambda abs)) (pure-let ((x 2)) ((lambda (y) (+ x y)) 3))) 5))
+
+(test (let ((name '+))
+ (let ((+ *))
+ (eval (list name 2 3))))
+ 6)
+(test (let ((name +))
+ (let ((+ *))
+ (eval (list name 2 3))))
+ 5)
+;; why is this considered confusing? It has nothing to do with eval!
+
+(test (let ((call/cc (lambda (x)
+ (let ((c (call/cc x))) c))))
+ (call/cc (lambda (r) (r 1))))
+ 1)
+
+; (test (with-let (sublet (curlet) (cons '+ (lambda args (apply * args)))) (+ 1 2 3 4)) 24) ; not sure about this -- the inner '+ might be optimized
+
+(let ()
+ (define-constant [begin] begin)
+ (define-constant [if] if)
+ (define-macro (when1 expr . body)
+ `([if] ,expr ([begin] , at body)))
+ (let ((if 32) (begin +))
+ (test (when1 (> 2 1) 1 2 3) 3)
+ (test (when1 (> 1 2) 3 4 5) #<unspecified>))
+ (test (when1 (> 2 1) 3) 3))
+
+(test (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list))) 5)
+(test (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2)) 3)
+(test (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3))) 2)
+(test (let () (define (hi) (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list)))) (hi)) 5)
+(test (let () (define (hi) (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2))) (hi)) 3)
+(test (let () (define (hi) (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3)))) (hi)) 2)
+
+(let ()
+ (test ((lambda 'a (eval-string "1")) (curlet) 1) 1)
+ (test ((lambda 'a (eval-string "a")) (curlet) 1) 1))
+
+;;; check optimizer
+(let ((lst (list 1 2 3))
+ (old-lambda lambda)
+ (ho #f)
+ (val #f))
+ (let* ((lambda 1))
+ (define (hi)
+ (for-each (lambda (a) (display a)) lst))
+ (set! val (+ lambda 2))
+ (set! ho hi))
+ (test val 3)
+ (test (ho) 'error))
+
+(let ()
+ (define mac (let ((var (gensym)))
+ (define-macro (mac-inner b)
+ `(#_let ((,var 12)) (#_+ ,var ,b)))
+ mac-inner))
+ (test (let ((a 1) (+ *) (let /)) (mac a)) 13)
+ (test (let ((a 1) (+ *) (let /)) (mac (mac a))) 25))
+
+(test (let ((begin +)) (with-let (unlet) (begin 1 2))) 2)
+(test (let () (define (f x) (let > (begin (vector-dimensions 22)))) (f 0)) 'error)
+(test (let () (define (f x) (let asd ())) (f 1)) 'error)
+(test (let () (define (f x) (hook *)) (f #f)) 'error)
+(test (let ((e (sublet () '(a . 1)))) (define (f x) (e *)) (f 1)) 'error)
+(test (let () (define (f) (eval (lambda 2.(hash-table-ref 1-)))) (f)) 'error)
+(test (let () (eval (lambda 2.(hash-table-ref 1-)))) 'error)
+(test (let () (define (f) (eval (lambda 2 #f))) (f)) 'error)
+(test (let () (define (f) (eval (lambda #f))) (f)) 'error)
+(test (let () (define (f) (eval (lambda))) (f)) 'error)
+(test (let () ((lambda () (eval (lambda 2 #f))))) 'error)
+(test (let () (define (f x) (help (lambda `(x 1) 12))) (f (string #\a))) 'error)
+(test (let () (define (func x) (* +(quote (vector? )))) (func '((x 1) (y) . 2))) 'error)
+(test (let () (define (func x) (* +(quote i))) (func cond)) 'error)
+(test (let ((i 1)) (define (func x) (begin i(let -))) (func macroexpand)) 'error)
+(test (let ((i 1)) (define (func x) (if (* i '((x 1) (y) . 2) ) (atan (procedure? 2(sin ))))) (func '(values #\c 3 1.2))) 'error)
+(test (let ((i 1)) (define (func x) (* 1- '(values #\c 3 1.2) )) (func set!)) 'error)
+(test (let ((dynamic-wind 1)) (+ dynamic-wind 2)) 3)
+
+#|
+;;; after much dithering I've decided that built-in C functions have a very aggressive take
+;;; on "lexical scope": if gcd appears as the car of an expression in a function, and
+;;; at that point in the overall s7 process gcd has not been redefined, then the function
+;;; can embed the actual gcd function in that part of its source (as if it was (#_gcd ...)).
+;;; Hence a subsequent (set! gcd +) has no effect on any call that lexically (textually)
+;;; preceded that set!. This is different from the handling of scheme-defined functions
+;;; where (define (a) 0) (define (b) (a)) (define (c) 1) (set! a c) (b) -> 1.
+;;; The decision as to when to replace the 'gcd with the gcd function is up to the optimizer, so
+;;; consistency here is considered of no importance compared to speed -- either don't (set! gcd +)
+;;; or do it before using gcd in any way.
+
+(test (let ()
+ (define (gset-test)
+ (let ((old-gcd gcd)
+ (sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (set! sum (+ sum (gcd x y)))
+ (set! gcd +))
+ (set! gcd old-gcd)
+ sum))
+ (define (gset-test-1) (gset-test))
+ (gset-test-1))
+ 36 or 12 -- who knows)
+
+(let ()
+ (define %gcd gcd)
+ (define (gset-test-x)
+ (let ((sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (set! sum (+ sum (%gcd x y))))))
+ (define (gset-test-1x) (gset-test-x))
+
+ (define (gset-test-a)
+ (let ((sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (set! sum (+ sum (gcd x y))))))
+ (define (gset-test-1a) (gset-test-a))
+
+ (define (gset-test-b)
+ (let ((sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (set! sum (+ sum (gcd x y)))
+ (set! gcd +))))
+ (define (gset-test-1b) (gset-test-b))
+
+ (define (gset-test-c)
+ (let ((sum 0)
+ (x 12)
+ (y 4))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) sum)
+ (set! sum (+ sum (gcd x y))))))
+ (define (gset-test-1c) (gset-test-c))
+
+ (let* ((x (gset-test-1x))
+ (a (gset-test-1a))
+ (b (gset-test-1b))
+ (c (gset-test-1c))
+ (a (gset-test-1a)))
+ (set! %gcd +)
+ (let ((xx (gset-test-1x)))
+ (display (list x a b c a xx))
+ (newline))))
+
+
+;;; s7: 12 12 12 12 12 12 12
+;;; guile: 12 12 36 48 48 12 48
+|#
+
+(define-class quaternion ()
+ '((r 0) (i 0) (j 0) (k 0))
+ (list (list 'real-part (lambda (obj) (obj 'r)))
+ (list 'imag-part (lambda (obj) (vector (obj 'i) (obj 'j) (obj 'k))))
+
+ (list 'number? (lambda (obj) #t))
+ (list 'complex? (lambda (obj) #f))
+ (list 'real? (lambda (obj) #f))
+ (list 'integer? (lambda (obj) #f))
+ (list 'rational? (lambda (obj) #f))
+
+ (list '+ (lambda orig-args
+ (let add ((r ()) (i ()) (j ()) (k ()) (args orig-args))
+ (if (null? args)
+ (make-quaternion (apply + r) (apply + i) (apply + j) (apply + k))
+ (let ((n (car args)))
+ (cond
+ ((real? n) (add (cons n r) i j k (cdr args)))
+ ((complex? n) (add (cons (real-part n) r) (cons (imag-part n) i) j k (cdr args)))
+ ((quaternion? n) (add (cons (n 'r) r) (cons (n 'i) i) (cons (n 'j) j) (cons (n 'k) k) (cdr args)))
+ ((openlet? n)
+ (if (eq? n (car orig-args))
+ (error 'missing-method "+ can't handle these arguments: ~A" args)
+ (apply (n '+) (make-quaternion (apply + r) (apply + i) (apply + j) (apply + k)) (cdr args))))
+
+ ;; this code is trying to make sure we don't start bouncing:
+ ;; if (+ q1 o1) goes to (o1 '+) which also can't handle this
+ ;; combination, don't bounce back here!
+ ;; In the current case, it would be (+ o1 q1) bouncing us here.
+ ;; we're assuming (+ a b c) = (+ (+ a b) c), and that any other
+ ;; + method will behave that way. I think the optimizer also
+ ;; assumes that (+ a b) = (+ b a).
+
+ (else (error 'wrong-type-arg "+ argument ~A is not a number" n))))))))
+
+ (list '- (lambda args
+ (let ((first (car args)))
+ (if (null? (cdr args)) ; (- q) is not the same as (- q 0)
+ (make-quaternion (- (first 'r)) (- (first 'i)) (- (first 'j)) (- (first 'k)))
+ (let ((q (cond ((real? first) (make-quaternion first 0 0 0))
+ ((complex? first) (make-quaternion (real-part first) (imag-part first) 0 0))
+ (else (copy first))))
+ (n (apply + (cdr args))))
+ (cond ((real? n) (set! (q 'r) (- (q 'r) n)) q)
+ ((complex? n) (make-quaternion (- (q 'r) (real-part n)) (- (q 'i) (imag-part n)) (q 'j) (q 'k)))
+ ((quaternion? n) (make-quaternion (- (q 'r) (n 'r)) (- (q 'i) (n 'i)) (- (q 'j) (n 'j)) (- (q 'k) (n 'k))))
+ (else (apply (n '-) (list q n)))))))))
+ ))
+
+(let ((old-make-quaternion make-quaternion))
+ (varlet (outlet (curlet))
+ (cons 'make-quaternion (lambda args
+ (let ((q (apply old-make-quaternion args)))
+ (if (or (not (real? (q 'r)))
+ (not (real? (q 'i)))
+ (not (real? (q 'j)))
+ (not (real? (q 'k))))
+ (error 'wrong-type-arg "quaternion fields should all be real: ~A" q)
+ q))))))
+
+
+(define-class float ()
+ '((x 0.0))
+ (list (list '+ (lambda orig-args
+ (let add ((x ()) (args orig-args))
+ (if (null? args)
+ (make-float (apply + x))
+ (let ((n (car args)))
+ (cond
+ ((float? n) (add (cons (n 'x) x) (cdr args)))
+ ((real? n) (add (cons n x) (cdr args)))
+ ((complex? n) (add (cons (real-part n) x) (cdr args)))
+ ((openlet? n)
+ (if (eq? n (car orig-args))
+ (error 'missing-method "+ can't handle these arguments: ~A" args)
+ (apply (n '+) (make-float (apply + x)) (cdr args))))
+ (else (error 'wrong-type-arg "+ argument ~A is not a number" n))))))))
+ (list 'number? (lambda (obj) #t))))
+
+
+(let ((q1 (make-quaternion 1.0 1.0 0.0 0.0)))
+ (test (complex? q1) #f)
+ (test (number? q1) #t)
+ (test (quaternion? q1) #t)
+ (test (quaternion? 1) #f)
+ (test (quaternion? 1+i) #f)
+ (test (integer? q1) #f)
+ (test (real? q1) #f)
+ (test (rational? q1) #f)
+
+ (test (real-part q1) 1.0)
+ (test (imag-part q1) #(1.0 0.0 0.0))
+
+ (test (eq? q1 q1) #t)
+ (test (eqv? q1 q1) #t)
+ (test (equal? q1 q1) #t)
+
+ (let ((q2 (make-quaternion 1.0 1.0 0.0 0.0)))
+ (test (eq? q1 q2) #f)
+ (test (eqv? q1 q2) #f)
+ (test (equal? q1 q2) #t)
+ (set! (q2 'r) 2.0)
+ (test (equal? q1 q2) #f)
+
+ (test (+ q1) q1)
+ (test (+ 1 q1) q2)
+ (test (+ q1 1) q2)
+ (test (+ 1/2 q1 1/2) q2)
+ (test (+ .5 1/2 q1) q2)
+ (test (+ 1+i q1 0-i) q2)
+ (test (+ 1.0 q1) q2)
+ (test (+ q1 1+i 0-i) q2)
+ (test (+ 0+i q1 1 0-i) q2)
+
+ (test (- q1) (make-quaternion -1.0 -1.0 0.0 0.0))
+ (test (- q1 1) (make-quaternion 0.0 1.0 0.0 0.0))
+ (test (- q1 1 0.0+i) (make-quaternion 0.0 0.0 0.0 0.0))
+ (test (- 1 q1) (make-quaternion 0.0 -1.0 0.0 0.0))
+
+ (test (+ (make-float 1.0) 1.0) (make-float 2.0))
+ (test (+ (make-quaternion 1 0 0 0) (make-float 1.0)) 'error)
+ (test (+ (make-float 1.0) 2 (make-quaternion 1 1 1 1)) 'error)
+ (test (+ 1 (make-float 1.0) 2 (make-quaternion 1 1 1 1)) 'error)
+
+ (test (make-quaternion 1 2+i 0 0) 'error)
+ (test (make-quaternion 1 2 3 "hi") 'error)
+
+ (let () (define (a1 q) (+ q 1)) (test (a1 q1) (make-quaternion 2.0 1.0 0.0 0.0)))
+ (let () (define (a1 q) (+ 1 q)) (test (a1 q1) (make-quaternion 2.0 1.0 0.0 0.0)))
+ (let () (define (a1 q) (+ q q)) (test (a1 q1) (make-quaternion 2.0 2.0 0.0 0.0)))
+ (let () (define (a1 q) (- q 1)) (test (a1 q1) (make-quaternion 0.0 1.0 0.0 0.0)))
+ ))
+
+(if (not with-bignums)
+(let ((e1 (openlet
+ (inlet
+ 'x 3
+ '* (lambda args
+ (if (number? (car args)) ; are we the first?
+ (apply * (car args) ((cadr args) 'x) (cddr args))
+ (apply * ((car args) 'x) (cdr args))))))))
+ (let ((e2 (copy e1)))
+ (set! (e2 'x) 4)
+ (test (* 2 e1 e2 5) 120)
+ (test (* e1 e2 5) 60)
+ (test (* e1 e2) 12)
+ (test (* e1) 3)
+ (test (* 2 e1 e2) 24)
+ (test (* 2 e1 4) 24)
+ (test (* e1 2 e2 e1) 72))))
+
+
+(let ()
+ (begin
+ (define fvector? #f)
+ (define make-fvector #f)
+ (let ((type (gensym))
+ (->float (lambda (x)
+ (if (real? x)
+ (* x 1.0)
+ (error 'wrong-type-arg "fvector new value is not a real: ~A" x)))))
+ (set! make-fvector
+ (lambda* (len (init 0.0))
+ (openlet
+ (inlet 'v (make-vector len (->float init))
+ 'type type
+ 'length (lambda (e) len)
+ 'let-set! (lambda (fv i val) (#_vector-set! (fv 'v) i (->float val)))
+ 'let-ref (lambda (fv i) (#_vector-ref (fv 'v) i))))))
+ (set! fvector? (lambda (p) (and (let? p) (eq? (p 'type) type))))))
+ (let ((f (make-fvector 10)))
+ (test (fvector? f) #t)
+ (test (length f) 10)
+ (test (f 0) 0.0)
+ (set! (f 1) 123)
+ (test (f 1) 123.0)))
+
+(let ()
+ (define (baser-method func)
+ (lambda largs
+ (if (let? (car largs))
+ (apply func ((car largs) 'c) (cdr largs))
+ (if (let? (cadr largs))
+ (apply func (car largs) ((cadr largs) 'c) (cddr largs))
+ (if (let? (caddr largs))
+ (apply func (car largs) (cadr largs) ((caddr largs) 'c) (cdddr largs))
+ (apply func (car largs) (cadr largs) (caddr largs) ((cadddr largs) 'c) (cddddr largs)))))))
+ (test (constant? (openlet (inlet 'c #f 'constant? (baser-method constant?)))) #t)
+ (test (numerator (openlet (inlet 'c 1/9223372036854775807 'numerator (baser-method numerator)))) 1)
+ (test (cdaadr (openlet (inlet 'c '((1 (2)) (((3) 4))) 'cdaadr (baser-method cdaadr)))) '(4))
+ (test (cadadr (openlet (inlet 'c '((1 2) (3 4)) 'cadadr (baser-method cadadr)))) 4)
+ (test (caadar (openlet (inlet 'c '((1 (2)) (((3) 4))) 'caadar (baser-method caadar)))) 2)
+ (test (caaadr (openlet (inlet 'c '((1 (2)) (((3) 4))) 'caaadr (baser-method caaadr)))) '(3))
+ (test (boolean? (openlet (inlet 'c #f 'boolean? (baser-method boolean?)))) #t)
+ (test (number->string (openlet (inlet 'c 1/9223372036854775807 'number->string (baser-method number->string)))) "1/9223372036854775807")
+ (test (lognot (openlet (inlet 'c '9223372036854775807 'lognot (baser-method lognot)))) -9223372036854775808)
+ (unless pure-s7 (test (vector-length (openlet (inlet 'c #() 'vector-length (baser-method vector-length)))) 0))
+ (test (round (openlet (inlet 'c 1/9223372036854775807 'round (baser-method round)))) 0)
+ (test (string-upcase (openlet (inlet 'c #u8(104 105 52 53 53) 'string-upcase (baser-method string-upcase)))) "HI455")
+ (test (vector? (openlet (inlet 'c #() 'vector? (baser-method vector?)))) #t)
+ (test (null? (openlet (inlet 'c () 'null? (baser-method null?)))) #t)
+ (test (keyword? (openlet (inlet 'c ':key 'keyword? (baser-method keyword?)))) #t)
+ (test (real? (openlet (inlet 'c 1/9223372036854775807 'real? (baser-method real?)))) #t)
+ (test (length (openlet (inlet 'c () 'length (baser-method length)))) 0)
+ (test (pair? (openlet (inlet 'c '(1) 'pair? (baser-method pair?)))) #t)
+ (test (number? (openlet (inlet 'c 1/9223372036854775807 'number? (baser-method number?)))) #t)
+ (test (odd? (openlet (inlet 'c '9223372036854775807 'odd? (baser-method odd?)))) #t)
+ (test (symbol (openlet (inlet 'c #u8(104 105 52 53 53) 'symbol (baser-method symbol)))) 'hi455)
+ (test (cdar (openlet (inlet 'c '((1 2)) 'cdar (baser-method cdar)))) '(2))
+ (test (even? (openlet (inlet 'c -9223372036854775808 'even? (baser-method even?)))) #t)
+ (test (caar (openlet (inlet 'c '((1 2)) 'caar (baser-method caar)))) 1)
+ (test (negative? (openlet (inlet 'c -1/9223372036854775807 'negative? (baser-method negative?)))) #t)
+ (test (floor (openlet (inlet 'c 1/9223372036854775807 'floor (baser-method floor)))) 0)
+ (test (positive? (openlet (inlet 'c 1/9223372036854775807 'positive? (baser-method positive?)))) #t)
+ (test (string (openlet (inlet 'c #\a 'string (baser-method string)))) "a")
+ (test (rational? (openlet (inlet 'c 1/9223372036854775807 'rational? (baser-method rational?)))) #t)
+ (unless pure-s7 (test (string-copy (openlet (inlet 'c #u8(104 105 52 53 53) 'string-copy (baser-method string-copy)))) "hi455"))
+ (test (make-keyword (openlet (inlet 'c #u8(104 105 52 53 53) 'make-keyword (baser-method make-keyword)))) :hi455)
+ (test (inexact? (openlet (inlet 'c 1.5+1i 'inexact? (baser-method inexact?)))) #t)
+ (test (char? (openlet (inlet 'c #\a 'char? (baser-method char?)))) #t)
+ (test (exact? (openlet (inlet 'c 1/9223372036854775807 'exact? (baser-method exact?)))) #t)
+ (test (format (openlet (inlet 'c #u8(104 105 52 53 53) 'format (baser-method format)))) "hi455")
+ (test (cadar (openlet (inlet 'c '((1 2)) 'cadar (baser-method cadar)))) '2)
+ (test (char-lower-case? (openlet (inlet 'c #\a 'char-lower-case? (baser-method char-lower-case?)))) #t)
+ (test (char-upcase (openlet (inlet 'c #\a 'char-upcase (baser-method char-upcase)))) #\A)
+ (test (byte-vector? (openlet (inlet 'c #u8(104 105 52 53 53) 'byte-vector? (baser-method byte-vector?)))) #t)
+ (unless pure-s7 (test (string->list (openlet (inlet 'c #u8(104 105 52 53 53) 'string->list (baser-method string->list)))) '(#\h #\i #\4 #\5 #\5)))
+ (test (denominator (openlet (inlet 'c 1/9223372036854775807 'denominator (baser-method denominator)))) 9223372036854775807)
+ (test (integer-length (openlet (inlet 'c '9223372036854775807 'integer-length (baser-method integer-length)))) 63)
+ (test (integer? (openlet (inlet 'c '9223372036854775807 'integer? (baser-method integer?)))) #t)
+ (test (char->integer (openlet (inlet 'c #\a 'char->integer (baser-method char->integer)))) 97)
+ (test (min (openlet (inlet 'c 1/9223372036854775807 'real? (lambda (obj) (#_real? (obj 'c))) 'min (baser-method min)))) 1/9223372036854775807)
+ (test (ceiling (openlet (inlet 'c 1/9223372036854775807 'ceiling (baser-method ceiling)))) 1)
+ (test (max (openlet (inlet 'c 1/9223372036854775807 'real? (lambda (obj) (#_real? (obj 'c))) 'max (baser-method max)))) 1/9223372036854775807)
+ (test (car (openlet (inlet 'c '(1) 'car (baser-method car)))) 1)
+ (test (char-alphabetic? (openlet (inlet 'c #\a 'char-alphabetic? (baser-method char-alphabetic?)))) #t)
+ (test (modulo 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'modulo (baser-method modulo)))) 0)
+ (test (substring #u8(104 105 52 53 53) (openlet (inlet 'c '0 'substring (baser-method substring)))) "hi455")
+ (test (char-position #\a (openlet (inlet 'c #u8(97 0 98) 'char-position (baser-method char-position)))) 0)
+ (test (assv 1 (openlet (inlet 'c '((1 2)) 'assv (baser-method assv)))) '(1 2))
+ (test (assq 1 (openlet (inlet 'c '((1 2)) 'assq (baser-method assq)))) '(1 2))
+ (test (rationalize 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'rationalize (baser-method rationalize)))) 0)
+ (test (make-shared-vector #(1 2) (openlet (inlet 'c '(1) 'make-shared-vector (baser-method make-shared-vector)))) #(1))
+ (test (string>=? #u8(52 53 104 105 53) (openlet (inlet 'c #u8(52 53 104 105 53) 'string>=? (baser-method string>=?)))) #t)
+ (test (string<=? #u8(52 53 104 105 53) (openlet (inlet 'c #u8(52 53 104 105 53) 'string<=? (baser-method string<=?)))) #t)
+ (test (fill! #u8(97 97 97 97 97) (openlet (inlet 'c 120 'fill! (baser-method fill!)))) 120)
+ (test (string #\a (openlet (inlet 'c #\a 'string (baser-method string)))) "aa")
+ (test (logbit? 9223372036854775807 (openlet (inlet 'c '0 'logbit? (baser-method logbit?)))) #t)
+ (test (remainder 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'remainder (baser-method remainder)))) 0)
+ (if (not pure-s7) (test (string-ci>? #u8(0 0 0 0 0) (openlet (inlet 'c #u8(0) 'string-ci>? (baser-method string-ci>?)))) #t))
+ (if (not pure-s7) (test (string-ci=? #u8(0 0 0 0 0) (openlet (inlet 'c #u8(0 0 0 0 0) 'string-ci=? (baser-method string-ci=?)))) #t))
+ (test (string-ref #u8(0 0 0 0 0) (openlet (inlet 'c '0 'string-ref (baser-method string-ref)))) #\null)
+ (test (string-position #u8(0 0 0 0 0) (openlet (inlet 'c #u8(0 0 0 0 0) 'string-position (baser-method string-position)))) 0)
+ (test (string>? #u8(0 0 0 0 0) (openlet (inlet 'c #u8(0) 'string>? (baser-method string>?)))) #t)
+ (test (string>=? #u8(52 53 104 105 53) #u8(52 53 104 105 53) (openlet (inlet 'c #u8(52 53 104 105 53) 'string>=? (baser-method string>=?)))) #t)
+ (when (not with-bignums)
+ (test (logxor (openlet (inlet 'c '9223372036854775807 'logxor (baser-method logxor)))) 9223372036854775807)
+ (test (> 1/9223372036854775807 (openlet (inlet 'c -1/9223372036854775807 '> (baser-method >)))) #t)
+ (test (= 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '= (baser-method =)))) #t)
+ (test (< 1/9223372036854775807 (openlet (inlet 'c 1e+18 '< (baser-method <)))) #t)
+ (test (/ 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '/ (baser-method /)))) 1)
+ (test (- 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '- (baser-method -)))) 0)
+ (test (+ 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '+ (baser-method +)))) 2/9223372036854775807)
+ (test (> 1/9223372036854775807 -1/9223372036854775807 (openlet (inlet 'c -9223372036854775808 '> (baser-method >)))) #t)
+ (test (= 1/9223372036854775807 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '= (baser-method =)))) #t)
+ (test (+ -1 (openlet (inlet 'c -1 '+ (baser-method +)))) -2)
+ (test (- -1 (openlet (inlet 'c -1 '- (baser-method -)))) 0)
+ (test (* (openlet (inlet 'c 2.0 '* (baser-method *))) 2.0) 4.0)
+ (test (let ((x (openlet (inlet 'c -1 '- (baser-method -))))) (- x 1)) -2)
+ (test (let ((x (openlet (inlet 'c 1.0 '- (baser-method -))))) (- 1.0 x)) 0.0)
+ (test (* 3.0 (openlet (inlet 'c 2.0 '* (baser-method *))) 2.0) 12.0))
+ (test (symbol->string (openlet (inlet 'c 'a 'symbol->string (baser-method symbol->string)))) "a")
+ (test (let? (outlet (openlet (inlet 'c (curlet) 'outlet (baser-method outlet)))) ) #t)
+ (test (c-pointer? (c-pointer (openlet (inlet 'c 0 'c-pointer (baser-method c-pointer))))) #t))
+
+(let ((e (openlet (inlet 'x (list 1 2 3) 'make-iterator (let ((iterator? #t)) (lambda (y) (#_make-iterator (y 'x))))))))
+ (test (map (lambda (z) (+ z 1)) e) '(2 3 4)))
+
+(let ()
+ (require mockery.scm)
+ (let ((v ((*mock-vector* 'make-mock-vector) 10 0)))
+ (test (vector? v) #t)
+ (let ((old-vpl (*s7* 'print-length)))
+ (set! (*s7* 'print-length) 32)
+ (test (object->string v) "#(0 0 0 0 0 0 0 0 0 0)")
+ (set! (*s7* 'print-length) old-vpl))
+ (test (length v) 10)
+ (test (vector-length v) 10)
+ (test (vector-dimensions v) '(10))
+ (test (vector-set! v 0 1) 1)
+ (test (vector-ref v 0) 1)
+ (test (v 0) 1)
+ (test (set! (v 1) 2) 2)
+ (test (v 1) 2)
+ (fill! v 0)
+ (test (v 'value) #(0 0 0 0 0 0 0 0 0 0))
+ (test (morally-equal? v #(0 0 0 0 0 0 0 0 0 0)) #t)
+ (test (morally-equal? #(0 0 0 0 0 0 0 0 0 0) v) #t)
+ (test (morally-equal? v ((*mock-vector* 'make-mock-vector) 10 0)) #t)
+ (unless pure-s7 (vector-fill! v 3 1 4))
+ (unless pure-s7 (test (v 'value) #(0 3 3 3 0 0 0 0 0 0)))
+ (unless pure-s7 (test (vector->list v) '(0 3 3 3 0 0 0 0 0 0)))
+ (unless pure-s7 (test (map (lambda (a) (+ a 1)) v) '(1 4 4 4 1 1 1 1 1 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) i))
+ (test (v 'value) #(0 1 2 3 4 5 6 7 8 9))
+ (for-each (lambda (x) (test (integer? x) #t)) v)
+ (let ((v1 (make-shared-vector v '(3) 2)))
+ (test v1 #(2 3 4)))
+ (sort! v >)
+ (test (v 'value) #(9 8 7 6 5 4 3 2 1 0))
+ (test (reverse v) #(0 1 2 3 4 5 6 7 8 9))
+ (test (let* ((y (list 1)) (x ((*mock-vector* 'mock-vector) y))) (set! (y 0) x) (null? (cyclic-sequences x))) #f)
+
+ (let ((v1 ((*mock-vector* 'make-mock-vector) 10 1)))
+ (let ((v2 (copy v1)))
+ (set! (v1 3) 32)
+ (test (or (eq? (v1 'value) (v2 'value))
+ (equal? (v1 'value) (v2 'value)))
+ #f)))
+#|
+ (let ((v1 #(1 2 3))
+ (v2 ((*mock-vector* 'make-mock-vector) 2 4)))
+ (test (vector-append v1 v2) #(1 2 3 4 4))
+ (test (vector-append v2 v1) #(4 4 1 2 3))
+ (test (vector-append v1 v1 v2) #(1 2 3 1 2 3 4 4))
+ (test (vector-append v2 v2 v1) #(4 4 4 4 1 2 3)))
+|#
+ (let ((v1 ((*mock-vector* 'mock-vector) 0 1 2 3 4)))
+ (test (subsequence v1 0 2) #(0 1))))
+
+ (let ()
+ (define (vset v i j k)
+ (let ((x 3.0))
+ (vector-set! v 0 x)
+ (vector-set! v j (vector-ref v i))
+ (vector-set! v i (+ (vector-ref v j) x))
+ (vector-set! v k x)))
+ (let ((v (vector 1 2 0)) (i 0) (j 1) (k 2)) (vset v i j k) (test (morally-equal? v #(6.0 3.0 3.0)) #t))
+ (let ((v ((*mock-vector* 'mock-vector) 1 2 0)) (i 0) (j 1) (k 2)) (vset v i j k) (test (morally-equal? v #(6.0 3.0 3.0)) #t))
+ (let ((v (vector 1 2 0))
+ (i ((*mock-number* 'mock-number) 0))
+ (j ((*mock-number* 'mock-number) 1))
+ (k ((*mock-number* 'mock-number) 2)))
+ (vset v i j k) (test (morally-equal? v #(6.0 3.0 3.0)) #t))
+ (let ((v ((*mock-vector* 'mock-vector) 1 2 0))
+ (i ((*mock-number* 'mock-number) 0))
+ (j ((*mock-number* 'mock-number) 1))
+ (k ((*mock-number* 'mock-number) 2)))
+ (vset v i j k) (test (morally-equal? v #(6.0 3.0 3.0)) #t))
+ (let ((v (vector 1 2 0)) (i 0) (j ((*mock-number* 'mock-number) 1)) (k 2)) (vset v i j k) (test (morally-equal? v #(6.0 3.0 3.0)) #t)))
+
+ (num-test (+ ((*mock-number* 'mock-number) 1) ((*mock-number* 'mock-number) 2)) 3)
+ (num-test (log ((*mock-number* 'mock-number) 2) ((*mock-number* 'mock-number) 2)) 1)
+
+ (num-test (/ ((*mock-number* 'mock-number) 0) 1) 0)
+ (num-test (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 1-i) ((*mock-number* 'mock-number) 3/4)) 0.0)
+ (test (make-float-vector 0 ((*mock-number* 'mock-number) 3)) #())
+
+ (test (= ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0)) #t)
+ (test (= ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0) #\a) 'error)
+ (test (nan? (/ 0 1-1i inf.0 nan.0)) #t)
+ (test (nan? (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 1-1i) ((*mock-number* 'mock-number) inf.0) ((*mock-number* 'mock-number) nan.0))) #t)
+ (test (/ 0 0.0) 'error)
+ (test (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0.0)) 'error)
+ (test (/ 0.0 0) 'error)
+ (test (/ ((*mock-number* 'mock-number) 0.0) ((*mock-number* 'mock-number) 0)) 'error)
+ (test (/ 2.0 inf.0 1-1i 0.0) 'error)
+ (test (/ ((*mock-number* 'mock-number) 2.0) ((*mock-number* 'mock-number) inf.0) ((*mock-number* 'mock-number) 1-1i) ((*mock-number* 'mock-number) 0.0)) 'error)
+
+ (test (length (append '(1) ((*mock-number* 'mock-number) 1))) -1)
+ (test (number? (append ((*mock-number* 'mock-number) 1))) #t)
+; (test (append ((*mock-number* 'mock-number) 1) ()) 'error)
+
+ (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "ho")) #f)
+ (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "hi") #t)
+ (test (string=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "hi") #t)
+ (test (string=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string<=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj")) #f)
+ (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") 1) 'error)
+ (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") ((*mock-number* 'mock-number) 1)) 'error)
+ (test (string<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #f)
+ (test (string>? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #f)
+ (test (string<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hihi")) #t)
+ (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih")) #f)
+ (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih") #\a) 'error)
+ (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih") ((*mock-number* 'mock-number) 1)) 'error)
+
+ (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\k)) #f)
+ (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t)
+ (test (char=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t)
+ (test (char=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char<=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j)) #f)
+ (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j) 1) 'error)
+ (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j) ((*mock-number* 'mock-number) 1)) 'error)
+ (test (char<? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #f)
+ (test (char>? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #f)
+ (test (char<? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\p)) #t)
+ (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m)) #f)
+ (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) "a") 'error)
+ (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) ((*mock-number* 'mock-number) 1)) 'error)
+
+ (test (string-ci=? "hi" ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string-ci=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "ho")) #f)
+ (test (string-ci=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "HI") #t)
+ (test (string-ci=? ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi") "hi") #t)
+ (test (string-ci=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string-ci<=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string-ci>=? ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t)
+ (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj")) #f)
+ (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") 1) 'error)
+ (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hj") ((*mock-number* 'mock-number) 1)) 'error)
+ (test (string-ci<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #f)
+ (test (string-ci<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hih") "hi") #f)
+ (test (string-ci>? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI")) #f)
+ (test (string-ci<? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HIH") ((*mock-string* 'mock-string) "hihi")) #t)
+ (test (string-ci<? ((*mock-string* 'mock-string) "hi") "HIH" ((*mock-string* 'mock-string) "hihi")) #t)
+ (test (string-ci>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "HI")) #t)
+ (test (string-ci>? ((*mock-string* 'mock-string) "HIHI") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih")) #f)
+ (test (string-ci>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "HIH") ((*mock-string* 'mock-string) "hih") #\a) 'error)
+ (test (string-ci>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "HIH") ((*mock-number* 'mock-number) 1)) 'error)
+
+ (test (char-ci=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I)) #t)
+ (test (char-ci=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\k)) #f)
+ (test (char-ci=? #\I ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t)
+ (test (char-ci=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) #\i) #t)
+ (test (char-ci=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char-ci<=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char-ci>=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j)) #f)
+ (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\J) 1) 'error)
+ (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\J) ((*mock-number* 'mock-number) 1)) 'error)
+ (test (char-ci<? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #f)
+ (test (char-ci>? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #f)
+ (test (char-ci<? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\p)) #t)
+ (test (char-ci>? ((*mock-char* 'mock-char) #\P) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\i)) #t)
+ (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\M) ((*mock-char* 'mock-char) #\m)) #f)
+ (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\M) "a") 'error)
+ (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) ((*mock-number* 'mock-number) 1)) 'error)
+
+ (let ((v (make-vector 3 1.0 (openlet (inlet 'c #t 'make-vector (lambda args (make-vector (car args) (cadr args) ((caddr args) 'c))))))))
+ (test (float-vector? v) #t))
+ (test (rationalize ((*mock-number* 'mock-number) 2.5) (openlet (inlet 'c 1/100 'rationalize (make-method #_rationalize (lambda (obj) (obj 'c)))))) 5/2)
+ (test (autoload 'asdf (openlet (inlet 'c "asdf" 'autoload (make-method #_autoload (lambda (obj) (obj 'c)))))) "asdf")
+
+ (define stretchable-vector-class
+ (let ((local-ref (lambda (obj index)
+ (if (>= index (length (obj 'value)))
+ (obj 'initial-element)
+ (#_vector-ref (obj 'value) index))))
+ (local-set! (lambda (obj index val)
+ (if (>= index (length (obj 'value)))
+ (set! (obj 'value) (copy (obj 'value) (make-vector (+ index 8) (obj 'initial-element)))))
+ (#_vector-set! (obj 'value) index val))))
+ (openlet
+ (sublet (*mock-vector* 'mock-vector-class)
+ 'value (vector)
+ 'object->string (lambda* (obj (w #t)) (format #f "#<stretchable-vector: ~S>" (obj 'value)))
+ 'initial-element #f
+ 'vector-ref local-ref
+ 'let-ref local-ref
+ 'vector-set! local-set!
+ 'let-set! local-set!))))
+
+ (let ((v1 (copy stretchable-vector-class))
+ (ind 12))
+ (test (vector-length v1) 0)
+ (test ((*mock-vector* 'mock-vector?) v1) #t)
+ (test (v1 123) #f)
+ (test (vector-length v1) 0)
+ (test (object->string v1) "#<stretchable-vector: #()>")
+ (set! (v1 ind) 32)
+ (test (v1 ind) 32)
+ (test (length v1) 20)
+ (test (v1 11) #f))
+
+ (let ((ht ((*mock-hash-table* 'mock-hash-table*) 'a 1 'b 2)))
+ (test (ht 'a) 1)
+ (test (hash-table? ht) #t)
+ (test ((*mock-hash-table* 'mock-hash-table?) ht) #t)
+ (test (vector? ht) #f)
+ (test (morally-equal? ht (hash-table* 'a 1 'b 2)) #t)
+ (test (hash-table-ref ht 'b) 2)
+ (hash-table-set! ht 'c 3)
+ (test (ht 'c) 3)
+ (test (ht 'd) #f)
+ (set! (ht 'c) 32)
+ (test (hash-table-ref ht 'c) 32)
+ (test (length ht) (*s7* 'default-hash-table-length))
+ (test (hash-table-entries ht) 3)
+ (let ((ht1 (copy ht)))
+ (test (hash-table-ref ht1 'b) 2)
+ (test (hash-table-entries ht1) 3))
+ (let ((hti (make-iterator ht)))
+ (for-each (lambda (x)
+ (if (not (equal? x (hti)))
+ (format *stderr* "hti not ~A~%" x)))
+ ht))
+ (fill! ht ())
+ (test (hash-table-entries ht) 3))
+
+ (unless pure-s7 (test (let ((e (openlet (inlet 'fill! (lambda (obj val) (string-fill! (obj 'value) val)) 'value "01234")))) (vector-fill! e #\a) (e 'value)) 'error))
+ (test (let ((e (openlet (inlet 'call/cc (lambda (obj) 32))))) (call/cc e)) 32)
+ (test (let ((e (openlet (inlet 'call-with-current-continuation (lambda (obj) 32))))) (call/cc e)) 32)
+
+ (define gloomy-hash-table
+ (openlet
+ (sublet (*mock-hash-table* 'mock-hash-table-class)
+ 'mock-hash-table-table #f
+ 'false (gensym)
+ 'not-a-key #f
+ 'hash-table-ref (lambda (obj key)
+ (let ((val (#_hash-table-ref (obj 'mock-hash-table-table) key)))
+ (if (eq? val (obj 'false))
+ #f
+ (or val (obj 'not-a-key)))))
+ 'hash-table-key? (lambda (obj key)
+ (#_hash-table-ref (obj 'mock-hash-table-table) key)))))
+
+ (define* (make-gloomy-hash-table (len 511) not-a-key)
+ (let ((ht (copy gloomy-hash-table)))
+ (set! (ht 'mock-hash-table-table) (make-hash-table len))
+ (set! (ht 'not-a-key) not-a-key)
+ ht))
+
+ (define (hash-table-key? obj key) ((obj 'hash-table-key?) obj key))
+
+ (let ((ht (make-gloomy-hash-table :not-a-key 'nope)))
+ (test (hash-table-key? ht 'a) #f)
+ (test (hash-table-ref ht 'a) 'nope)
+ (hash-table-set! ht 'a 1)
+ (test (not (hash-table-key? ht 'a)) #f)
+ (test (ht 'a) 1))
+
+
+ (let ((s ((*mock-string* 'mock-string) #\a #\b #\c)))
+ (test (length s) 3)
+ (test (string-length s) 3)
+ (test (string? s) #t)
+ (test (morally-equal? s "abc") #t)
+ (test ((*mock-string* 'mock-string?) s) #t)
+ (test ((*mock-vector* 'mock-vector?) s) #f)
+ (test (string-ref s 0) #\a)
+ (test (string-set! s 0 #\A) #\A)
+ (test (s 0) #\A)
+ (test (set! (s 1) #\B) #\B)
+ (test (s 1) #\B)
+ (test (string->list s) '(#\A #\B #\c))
+ (test (string-append s "d") "ABcd")
+ (test (string-append "d" s "e") "dABce")
+ (test (string-append "d" "f" s) "dfABc")
+ (test (string-append "d" "f" s "gh") "dfABcgh")
+ (test (reverse s) "cBA")
+ (test (copy s) "ABc")
+ (test (string-copy s) "ABc")
+ (test (object->string s) "\"ABc\"")
+ (test (string=? s "ABc") #t)
+ (test (string=? "ABc" s) #t)
+ (test (string=? s "ABC") #f)
+ (test (substring s 0 1) "A")
+ (test (string-downcase s) "abc")
+ (test (string-upcase s) "ABC")
+ (test (string->symbol s) 'ABc)
+ (test (gensym? (gensym s)) #t)
+ (test (make-keyword s) :ABc)
+ (test (map values s) '(#\A #\B #\c))
+ (test (string>? s "ABC") #t)
+ (test (string-ci>? s "ABC") #f)
+ (test (string<? s "ABC") #f)
+ (test (string-ci<=? s "ABC") #t)
+ (test (string>=? s "ABC") #t)
+ (test (string-ci>=? s "ABC") #t)
+ (test (string<=? s "ABC") #f)
+ (test (string-ci<=? s "ABC") #t)
+ (test (call-with-input-string s read) 'ABc)
+ (test (with-input-from-string s read) 'ABc)
+ (test (let ((p (open-input-string s))) (let ((r (read p))) (close-input-port p) r)) 'ABc)
+ (string-fill! s #\1)
+ (test (s 0) #\1)
+ (test (string->number s) 111)
+ (fill! s #\2)
+ (test (s 1) #\2)
+ (for-each (lambda (c) (if (not (char=? c #\2)) (format *stderr* ";fill! mock-string: ~C~%" c))) s)
+ (test (format #f s) "222")
+ (test (format #f "~A" s) "222")
+ (test (format s) "222")
+ (test (eval-string s) 222)
+ (test (string-position "2" s) 0)
+ (test (->byte-vector s) #u8(50 50 50)))
+
+ (let ((c ((*mock-char* 'mock-char) #\a)))
+ (test (char? c) #t)
+ (test ((*mock-char* 'mock-char?) c) #t)
+ (test (morally-equal? c #\a) #t)
+ (test (char-upcase c) #\A)
+ (test (char-downcase c) #\a)
+ (test (char->integer c) 97)
+ (test (char-upper-case? c) #f)
+ (test (char-lower-case? c) #t)
+ (test (char-alphabetic? c) #t)
+ (test (char-numeric? c) #f)
+ (test (char-whitespace? c) #f)
+ (test (char=? c #\A) #f)
+ (test (char=? c #\a) #t)
+ (test (char<? c #\b) #t)
+ (test (char<=? c #\b) #t)
+ (test (char>? c #\b) #f)
+ (test (char>=? c #\b) #f)
+ (test (char-ci=? c #\A) #t)
+ (test (char-ci=? c #\a) #t)
+ (test (char-ci<? c #\b) #t)
+ (test (char-ci<=? c #\b) #t)
+ (test (char-ci>? c #\b) #f)
+ (test (char-ci>=? c #\b) #f)
+ (test (char-position c "abc") 0)
+ (test (char-position ((*mock-char* 'mock-char) #\b) "hoho" 63) #f)
+ (test (char-position #\null "hoho" ((*mock-char* 'mock-char) #\b)) 'error)
+ (test (char-position ((*mock-char* 'mock-char) #\null) "hoho" ((*mock-char* 'mock-char) #\b)) 'error)
+ (test (object->string c #f) "a")
+ (test (copy c) #\a)
+ (test (string c #\b) "ab")
+ (test (string #\c c) "ca")
+ (test (string #\a c c #\b) "aaab")
+ (test (format #f "~C" c) (format #f "~C" (c 'value)))
+ (let ((str "0123"))
+ (string-set! str 1 c)
+ (test str "0a23"))
+ )
+
+ (let ((mock-number (*mock-number* 'mock-number))
+ (mock-number? (*mock-number* 'mock-number?)))
+ (let ((i (mock-number 32))
+ (x (mock-number pi))
+ (z (mock-number 1+i))
+ (r (mock-number 3/2)))
+ (let ((nums (list i r x z))
+ (rnums (list i r x)))
+ (define (practically-equal? tst l1 l2)
+ (call-with-exit
+ (lambda (quit)
+ (for-each (lambda (n1 n2)
+ (when (not (number-ok? tst n1 n2))
+ (format *stderr* ";~S: ~A ~A~%" tst n1 n2)
+ (quit #f)))
+ l1 l2)
+ #t)))
+ (test (map mock-number? nums) '(#t #t #t #t))
+ (test (morally-equal? i 32) #t)
+ (if with-bignums
+ (test (map object->string nums) '("32" "3/2" "3.141592653589793238462643383279502884195E0" "1+1i"))
+ (test (map object->string nums) '("32" "3/2" "3.141592653589793" "1+1i")))
+ (test (map copy nums) (list 32 3/2 pi 1+1i))
+ (test (practically-equal? 'real-part (map real-part nums) (list 32 3/2 pi 1.0)) #t)
+ (test (map imag-part nums) '(0 0 0.0 1.0))
+ (test (numerator i) 32)
+ (test (numerator r) 3)
+ (test (denominator i) 1)
+ (test (denominator r) 2)
+ (test (even? i) #t)
+ (test (odd? i) #f)
+ (test (map zero? nums) '(#f #f #f #f))
+ (test (map positive? rnums) '(#t #t #t))
+ (test (map negative? rnums) '(#f #f #f))
+ (test (map infinite? nums) '(#f #f #f #f))
+ (test (map nan? nums) '(#f #f #f #f))
+ (num-test (make-polar i r) (make-polar 32 3/2))
+ (num-test (make-polar x i) (make-polar pi 32))
+ (num-test (complex i r) (complex 32 3/2))
+ (test (practically-equal? 'magnitude (map magnitude nums) (list 32 3/2 pi (sqrt 2))) #t)
+ (test (practically-equal? 'angle (map angle nums) '(0 0 0.0 0.7853981633974483)) #t)
+ (num-test (rationalize x) (rationalize pi))
+
+ (test (practically-equal? 'abs (map abs rnums) '(32 3/2 3.141592653589793)) #t)
+ (test (practically-equal? 'exp (map exp nums) '(78962960182680.69 4.481689070338065 23.14069263277927 1.468693939915885+2.287355287178842i)) #t)
+ (test (practically-equal? 'log (map log nums) '(3.465735902799727 0.4054651081081644 1.1447298858494 0.3465735902799727+0.7853981633974483i)) #t)
+ (test (practically-equal? 'sin (map sin nums) '(0.5514266812416906 0.9974949866040544 1.224646799147353e-16 1.298457581415977+0.6349639147847361i)) #t)
+ (test (practically-equal? 'cos (map cos nums) '(0.8342233605065102 0.07073720166770291 -1.0 0.8337300251311491-0.9888977057628651i)) #t)
+ (test (practically-equal? 'tan (map tan nums) '(0.6610060414837631 14.10141994717172 -1.224646799147353e-16 0.2717525853195117+1.083923327338695i)) #t)
+ (test (practically-equal? 'asin (map asin nums) '(1.570796326794897-4.158638853279167i 1.570796326794897-0.9624236501192069i
+ 1.570796326794897-1.811526272460853i 0.6662394324925153+1.061275061905036i)) #t)
+ (test (practically-equal? 'acos (map acos nums) '(0+4.158638853279167i 0+0.9624236501192069i 0+1.811526272460853i 0.9045568943023813-1.061275061905036i)) #t)
+ (test (practically-equal? 'atan (map atan nums) '(1.539556493364628 0.9827937232473291 1.262627255678912 1.017221967897851+0.4023594781085251i)) #t)
+ (test (practically-equal? 'sinh (map sinh nums) '(39481480091340.34 2.129279455094817 11.54873935725775 0.6349639147847361+1.298457581415977i)) #t)
+ (test (practically-equal? 'cosh (map cosh nums) '(39481480091340.34 2.352409615243247 11.59195327552152 0.8337300251311491+0.9888977057628651i)) #t)
+ (test (practically-equal? 'tanh (map tanh nums) '(1.0 0.9051482536448664 0.99627207622075 1.083923327338695+0.2717525853195117i)) #t)
+ (test (practically-equal? 'asinh (map asinh nums) '(4.15912713462618 1.194763217287109 1.862295743310848 1.061275061905036+0.6662394324925153i)) #t)
+ (test (practically-equal? 'acosh (map acosh nums) '(4.158638853279167 0.9624236501192069 1.811526272460853 1.061275061905036+0.9045568943023813i)) #t)
+ (test (practically-equal? 'atanh (map atanh nums) '(0.03126017849066698+1.570796326794897i 0.8047189562170503+1.570796326794897i
+ 0.3297653149566991+1.570796326794897i 0.4023594781085251+1.017221967897851i)) #t)
+ (test (practically-equal? 'sqrt (map sqrt nums) '(5.656854249492381 1.224744871391589 1.772453850905516 1.09868411346781+0.4550898605622273i)) #t)
+ (test (practically-equal? 'expt (map (lambda (n) (expt n 2)) nums) '(1024 9/4 9.869604401089358 1.224606353822377e-16+2i)) #t)
+ (test (practically-equal? 'expt (map (lambda (n) (expt n r)) nums) '(181.0193359837562 1.837117307087384 5.568327996831708
+ 0.6435942529055828+1.553773974030037i)) #t)
+ (test (map floor rnums) '(32 1 3))
+ (test (map ceiling rnums) '(32 2 4))
+ (test (map truncate rnums) '(32 1 3))
+ (test (map round rnums) '(32 2 3))
+ (test (integer->char (mock-number (char->integer #\a))) #\a)
+ (test (map inexact->exact rnums) '(32 3/2 4272943/1360120))
+ (test (practically-equal? 'exact->inexact (map exact->inexact rnums) '(32.0 1.5 3.141592653589793)) #t)
+ (test (integer-length i) 6)
+ (test (integer-decode-float x) '(7074237752028440 -51 1))
+ (test (map number? nums) '(#t #t #t #t))
+ (test (map integer? nums) '(#t #f #f #f))
+ (test (map real? nums) '(#t #t #t #f))
+ (test (map complex? nums) '(#t #t #t #t))
+ (test (map rational? nums) '(#t #t #f #f))
+ (test (map exact? nums) '(#t #t #f #f))
+ (test (map inexact? nums) '(#f #f #t #t))
+
+ (test (ash 1 i) 4294967296)
+ (test (ash i -3) 4)
+ (test (logbit? i 1) #f)
+ (test (logbit? 1 i) #f)
+ (if with-bignums
+ (test (map number->string nums) '("32" "3/2" "3.141592653589793238462643383279502884195E0" "1+1i"))
+ (test (map number->string nums) '("32" "3/2" "3.141592653589793" "1+1i")))
+ (test (every? number? (map random nums)) #t)
+ (test (quotient i r) 21)
+ (test (remainder i r) 1/2)
+ (test (modulo i r) 1/2)
+ (test (lognot i) -33)
+ (test (logior i 2) 34)
+ (test (logior 1 i 2 3) (logior 1 32 2 3))
+ (test (logior 1 7 i 62) (logior 1 7 32 62))
+ (test (logior (mock-number 1) (mock-number 8) 2 4 16 (mock-number 32)) 63)
+ (test (logxor (mock-number 1) (mock-number 7) 2 4 16 (mock-number 32)) (logxor 1 7 2 4 16 32))
+ (test (logand 63 15 31 127) (logand 63 (mock-number 15) (mock-number 31) 127))
+ (num-test (apply + nums) 37.6415926535898+1i)
+ (num-test (apply - nums) 26.35840734641021-1i)
+ (num-test (apply * nums) 150.7964473723101+150.7964473723101i)
+ (num-test (apply / nums) 3.3953054526271-3.3953054526271i)
+ (num-test (apply max rnums) 32)
+ (num-test (apply min rnums) 3/2)
+ (num-test (min 65 i) 32)
+ (test (apply < rnums) #f)
+ (test (apply > rnums) #f)
+ (test (apply <= rnums) #f)
+ (test (apply >= rnums) #f)
+ (test (< 1 3 i 47) #t)
+ (test (> 5/2 r 1/2 (/ i 100)) #t)
+ (test (<= 1.0 2.0 3.0 x) #t)
+ (test (>= 101.231 i 4 x 5/2 r) #t)
+ (test (> x z) 'error)
+ (test (> i 0) #t)
+ (test (< 0 i) #t)
+ (test (>= x 0.0) #t)
+ (test (<= 0.0 x) #t)
+ (test (apply = nums) #f)
+ (test (= i 32) #t)
+ (test (= 33 i) #f)
+ (test (= r 1/2) #f)
+ (test (lcm i 3/2) (lcm i r))
+ (test (lcm 3/2 i) (lcm r i))
+ (test (lcm 33 2 i) (lcm 2 i 33))
+ (test (lcm 33 x) 'error)
+ (test (apply lcm nums) 'error)
+ (test (lcm i 0 x) 'error)
+ (test (lcm 9 0 r) 0)
+ (test (gcd i 3/2) (gcd i r))
+ (test (gcd i 3/2) (gcd 32 3/2))
+ (test (gcd 3/2 i) (gcd r i))
+ (test (gcd 33 2 i) (gcd 2 i 33))
+ (test (gcd 33 x) 'error)
+ (test (apply gcd nums) 'error)
+ (test (gcd i 0 x) 'error)
+ (test (gcd 9 0 r) 3/2)
+
+ (test (format #f "~D" ((*mock-number* 'mock-number) 123)) "123")
+ (test (format #f "~F" ((*mock-number* 'mock-number) 1.23)) (format #f "~F" 1.23))
+ (test (format #f "~A" r) "3/2")
+
+ (let ((index (mock-number 2))
+ (v #(0 1 2 3 4))
+ (s "01234")
+ (p (list 0 1 2 3 4)))
+ (test (string-ref s index) #\2)
+ (test (list-ref p index) 2)
+ (test (vector-ref v index) 2)
+ (test (s index) #\2)
+ (test (p index) 2)
+ (test (v index) 2)
+ (test (make-shared-vector #(0 1 2 3) '(3) (mock-number 1)) #(1 2 3))
+ (test (vector->list #(0 1 2 3 4) (mock-number 1) (mock-number 3)) '(1 2))
+ (test (list-tail p index) '(2 3 4))
+ (test (substring "01234" index) "234")
+ (test (substring "01234" 0 index) "01")
+ (test (substring "01234" index (mock-number 3)) "2")
+ (test (vector->list #(0 1 2 3 4) index) '(2 3 4))
+ (test (vector->list #(0 1 2 3 4) index index) ())
+ (test (string->list "01234" index) '(#\2 #\3 #\4))
+ (test (string->list "01234" 0 index) '(#\0 #\1))
+ (test (let ((dest (make-string 3))) (copy "01234" dest index) dest) "234")
+ (test (let ((dest (make-string 2))) (copy "01234" dest 0 index) dest) "01")
+ (unless pure-s7 (test (let ((str "01234")) (string-fill! str #\a index) str) "01aaa"))
+ (unless pure-s7 (test (let ((vec #(0 1 2 3 4))) (vector-fill! vec 5 (mock-number 0) (mock-number 3)) vec) #(5 5 5 3 4)))
+ (test (let ((vec #2D((0 1 2) (3 4 5)))) (vector-ref vec (mock-number 1) index)) 5)
+ )
+ (test (let ((vec ((*mock-vector* 'mock-vector) 10 11 12))) (vec ((*mock-number* 'mock-number) 1))) 11)
+
+ (test (vector? (make-vector i)) #t)
+ (test (string? (make-string i)) #t)
+ (test (hash-table? (make-hash-table i)) #t)
+ (test (pair? (make-list i)) #t)
+
+ (define (p1-check . args)
+ (if (> (magnitude (- (apply * args) 0.25+0.25i)) 1e-15)
+ (format-logged #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args)))
+ (if (not (= (apply + args) 3+i))
+ (format-logged #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args)))
+ (if (not (= (apply - args) (- (car args) (apply + (cdr args)))))
+ (format-logged #t "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args)))))
+ (if (not (= (apply / args) (/ (car args) (apply * (cdr args)))))
+ (format-logged #t "~A: ~A != ~A?~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))))))
+
(for-each
- (lambda (sym)
- (if (and (defined? sym)
- (procedure? (symbol->value sym)))
- (begin
- (set! (calls call) (list sym (symbol-calls sym)))
- (set! call (+ call 1)))))
- lst)))
+ (lambda (lst)
+ (for-each-permutation p1-check lst))
+ (list
+ (list 1 1/2 0.5 1+i)
+ (list (mock-number 1) 1/2 0.5 1+i)
+ (list 1 (mock-number 1/2) 0.5 1+i)
+ (list 1 1/2 (mock-number 0.5) 1+i)
+ (list 1 1/2 0.5 (mock-number 1+i))
+ (list (mock-number 1)
+ (mock-number 1/2)
+ (mock-number 0.5)
+ (mock-number 1+i))))
+ )))
- (set! calls (sort! calls (lambda (a b)
- (> (caadr a) (caadr b)))))
+ (let ()
+ (let ((lst '(1 2 3)))
+ (list-set! lst ((inlet 'i 2) 'i) 32)
+ (test lst '(1 2 32)))
+ (let ((lst '((1 2 3))))
+ (list-set! lst 0 ((inlet 'i 2) 'i) 32)
+ (test lst '((1 2 32))))
+ (let ((lst '((1 2 3))))
+ (list-set! lst ((inlet 'i 0) 'i) ((inlet 'i 2) 'i) 32)
+ (test lst '((1 2 32))))
+ (let ((i0 ((*mock-number* 'mock-number) 0))
+ (i1 ((*mock-number* 'mock-number) 1))
+ (i2 ((*mock-number* 'mock-number) 2))
+ (lst '((0 1 2) (3 4 5))))
+ (list-set! lst i0 i1 32)
+ (test lst '((0 32 2) (3 4 5))))
+ (let ((i0 (openlet (inlet 'i 0 'list-set! (lambda (l . args) (apply #_list-set! l ((car args) 'i) (cdr args))))))
+ (i1 (openlet (inlet 'i 1 'list-set! (lambda (l . args) (apply #_list-set! l ((car args) 'i) (cdr args))))))
+ (i2 (openlet (inlet 'i 2 'list-set! (lambda (l . args) (apply #_list-set! l ((car args) 'i) (cdr args))))))
+ (lst '((0 1 2) (3 4 5))))
+ (list-set! lst i0 i1 32)
+ (test lst '((0 32 2) (3 4 5)))))
+
+ (let ((mock-pair (*mock-pair* 'mock-pair))
+ (mock-pair? (*mock-pair* 'mock-pair?)))
+ (let ((lst (mock-pair 1 2 3)))
+
+ (test (pair? lst) #t)
+ (test (mock-pair? lst) #t)
+ (test (morally-equal? (list 1 2 3) lst) #t)
+ (test (morally-equal? lst (mock-pair 1 2 3)) #t)
+ (test (integer? (pair-line-number lst)) #t)
+ (unless pure-s7 (test (list->string (mock-pair #\a #\b #\c)) "abc"))
+ (test (object->string lst) "(1 2 3)")
+ (test (list? lst) #t)
+ (test (null? lst) #f)
+ (test (car lst) 1)
+ (test (cdr lst) '(2 3))
+ (test (length lst) 3)
+ (test (arity lst) (cons 1 1))
+ (test (reverse lst) '(3 2 1))
+ (unless pure-s7 (test (list->vector lst) #(1 2 3)))
+ (test (map values lst) '(1 2 3))
+ (test (memq 2 lst) '(2 3))
+ (test (memv 3 lst) '(3))
+ (test (member 1 lst) '(1 2 3))
+ (test (list-tail lst 1) '(2 3))
+ (test (cadr lst) 2)
+ (test (caddr lst) 3)
+ (test (cddr lst) '(3))
+ (test (cdddr lst) ())
+ (test (list-ref lst 1) 2)
+ (set-car! lst 4)
+ (test (car lst) 4)
+ (list-set! lst 2 32)
+ (test (caddr lst) 32)
+ (set-cdr! lst ())
+ (test (length lst) 1)
+ (set! lst (apply mock-pair '((a . 1) (b . 2) (c . 3))))
+ (test (assq 'a lst) '(a . 1))
+ (test (assv 'b lst) '(b . 2))
+ (test (assoc 'c lst) '(c . 3))
+ (fill! lst 1)
+ (test (car lst) 1)
+ (set! lst (mock-pair 1 2 3))
+ (reverse! lst)
+ (test (copy lst) '(3 2 1))
+ (set! lst (apply mock-pair (sort! lst <)))
+ (test (copy lst) '(1 2 3))
+ (set! (lst 0) 4)
+ (test (lst 0) 4)
+ (test (list-tail lst 0) '(4 2 3))
+ (for-each (lambda (x) (if (not (integer? x)) (format *stderr* ";for-each mock-pair: ~A~%" x))) (mock-pair 1 2 3))
+ (test (make-shared-vector #(0 1 2 3) (mock-pair 2)) #(0 1))
+ (test (caar (apply mock-pair '((a) b c d e f g))) 'a)
+ (test (cadr (apply mock-pair '(a b c d e f g))) 'b)
+ (test (cdar (apply mock-pair '((a b) c d e f g))) '(b))
+ (test (cddr (apply mock-pair '(a b c d e f g))) '(c d e f g))
+ (test (caaar (apply mock-pair '(((a)) b c d e f g))) 'a)
+ (test (caadr (apply mock-pair '(a (b) c d e f g))) 'b)
+ (test (cadar (apply mock-pair '((a b) c d e f g))) 'b)
+ (test (caddr (apply mock-pair '(a b c d e f g))) 'c)
+ (test (cdaar (apply mock-pair '(((a b)) c d e f g))) '(b))
+ (test (cdadr (apply mock-pair '(a (b c) d e f g))) '(c))
+ (test (cddar (apply mock-pair '((a b c) d e f g))) '(c))
+ (test (cdddr (apply mock-pair '(a b c d e f g))) '(d e f g))
+ (test (caaaar (apply mock-pair '((((a))) b c d e f g))) 'a)
+ (test (caaadr (apply mock-pair '(a ((b)) c d e f g))) 'b)
+ (test (caadar (apply mock-pair '((a (b)) c d e f g))) 'b)
+ (test (caaddr (apply mock-pair '(a b (c) d e f g))) 'c)
+ (test (cadaar (apply mock-pair '(((a b)) c d e f g))) 'b)
+ (test (cadadr (apply mock-pair '(a (b c) d e f g))) 'c)
+ (test (caddar (apply mock-pair '((a b c) d e f g))) 'c)
+ (test (cadddr (apply mock-pair '(a b c d e f g))) 'd)
+ (test (cdaaar (apply mock-pair '((((a b))) c d e f g))) '(b))
+ (test (cdaadr (apply mock-pair '(a ((b c)) d e f g))) '(c))
+ (test (cdadar (apply mock-pair '((a (b c)) d e f g))) '(c))
+ (test (cdaddr (apply mock-pair '(a b (c d) e f g))) '(d))
+ (test (cddaar (apply mock-pair '(((a b c)) d e f g))) '(c))
+ (test (cddadr (apply mock-pair '(a (b c d) e f g))) '(d))
+ (test (cdddar (apply mock-pair '((a b c d) e f g))) '(d))
+ (test (cddddr (apply mock-pair '(a b c d e f g))) '(e f g))
+ (test (cyclic-sequences (mock-pair 1 2 3)) ())
+ (test (let ((y (mock-pair (make-circular-list 3)))) (let ((x (cyclic-sequences y))) (length x))) 1)
+ (test (subsequence ((*mock-pair* 'mock-pair) 1 2 3 4) 2) '(3 4))
+ ))
+
+; (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append lst '(4 5 6))) '(1 2 3 4 5 6))
+; (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append '(4 5 6) lst ())) '(4 5 6 1 2 3))
+; (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append '(4 5 6) lst)) '(4 5 6 1 2 3))
+ (test (sort! 'begin ((*mock-pair* 'mock-pair) 1 2)) 'error)
+
+ (let ((immutable-list-class
+ (sublet (*mock-pair* 'mock-pair-class)
+ 'object->string (lambda (obj . args)
+ (apply #_object->string (obj 'value) args))
+ 'let-set! (lambda (obj i val)
+ (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1))))
+ (list-set! (obj 'value) i val))
+ 'list-set! (lambda (obj i val)
+ (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1))))
+ (list-set! (obj 'value) i val))
+ 'set-car! (lambda (obj val)
+ (set! (obj 'value) (cons val (cdr (obj 'value)))))
+ 'set-cdr! (lambda (obj val)
+ (set! (obj 'value) (cons (car (obj 'value)) val)))
+ 'fill! (lambda (obj val)
+ (set! (obj 'value) (fill! (copy (obj 'value)) val)))
+ 'reverse! (lambda (obj)
+ (set! (obj 'value) (reverse (obj 'value))))
+ 'sort! (lambda (obj func)
+ (set! (obj 'value) (sort! (copy (obj 'value)) func))))))
+
+ (define (immutable-list lst)
+ (openlet
+ (sublet immutable-list-class
+ 'value lst)))
+
+ (let ((L1 (immutable-list (list 1 2 3 4 5))))
+ (let ((L2 (cdr L1))
+ (L3 (cons 0 (L1 'value))))
+ (list-set! L1 0 32)
+ (test (L1 'value) '(32 2 3 4 5))
+ (test L2 '(2 3 4 5))
+ (test L3 '(0 1 2 3 4 5))
+ (set! (L1 2) 32)
+ (test (L1 'value) '(32 2 32 4 5))
+ (test L2 '(2 3 4 5))
+ (test L3 '(0 1 2 3 4 5))
+ (set-cdr! L1 3)
+ (test (L1 'value) '(32 . 3))
+ (test L2 '(2 3 4 5))
+ (set! L1 (immutable-list (list 1 2 3 4 5)))
+ (set! L2 (cddr L1))
+ (set! L3 (cons 0 (L1 'value)))
+ (sort! L1 >)
+ (test (L1 'value) '(5 4 3 2 1))
+ (test L2 '(3 4 5))
+ (test L3 '(0 1 2 3 4 5))
+ (reverse! L1)
+ (test (L1 'value) '(1 2 3 4 5))
+ (test L2 '(3 4 5))
+ (test (object->string L1) "(1 2 3 4 5)")
+ )))
- (with-output-to-file file
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i call))
- (let* ((c (calls i))
- (sym (car c))
- (data (cadr c))
- (total (car data))
- (args (cadr data)))
- (if (> total 0)
- (begin
- (format #t "--------------------------------------------------------------------------------~%~A: ~A~40T~A~%" sym total (where-is sym))
- (if args
- (let* ((arity (procedure-arity (symbol->value sym)))
- (top (min 3 (+ (car arity) (cadr arity) (if (caddr arity) 3 0)))))
- (do ((base 0 (+ base 1)))
- ((= base top))
- (let ((arg-max (vector-max args (* base 32) (* (+ base 1) 32))))
- (if (> arg-max 0)
- (display-arg args (* base 32)))))))))))
-
- (format #t "~%~%-------------- not called ------------------------------------------------------------------~%~%")
- (do ((i 0 (+ i 1)))
- ((= i call))
- (let* ((c (calls i))
- (sym (car c))
- (data (cadr c))
- (total (car data)))
- (if (and (<= total 0)
- (not (eq? sym 'none)))
- (format #t "~A~40T~A~%" sym (where-is sym)))))
- (format #t "~%~%")))))
+ (let ((mock-symbol (*mock-symbol* 'mock-symbol))
+ (mock-symbol? (*mock-symbol* 'mock-symbol?)))
+ (let ((sym (mock-symbol 'a)))
+ (test (symbol? sym) #t)
+ (test (mock-symbol? sym) #t)
+ (test (morally-equal? sym 'a) #t)
+ (test (keyword? sym) #f)
+ (test (gensym? sym) #f)
+ (test (symbol->string sym) "a")
+ (let ((a 32))
+ (test (let ((a 32)) (symbol->value sym (curlet))) 32)
+ (test (symbol->dynamic-value sym) 32)
+ (test (defined? sym) #t)
+ (test (symbol->keyword sym) :a)
+ (test (provided? sym) #f)
+ (test (symbol-access sym) #f)))
+ (let ((sym (mock-symbol :a)))
+ (test (keyword? sym) #t)
+ (test (keyword->symbol sym) 'a))
+ (let ()
+ (define* (f1 a b) (+ a b))
+ (test (f1 (mock-symbol :a) 3 :b 2) 5)))
+
+ (let ((mock-port (*mock-port* 'mock-port))
+ (mock-port? (*mock-port* 'mock-port?)))
+ (let ((ip (open-input-string "0123456789"))
+ (op (open-output-string)))
+ (let ((mip (mock-port ip))
+ (mop (mock-port op)))
+ (test (mock-port? mip) #t)
+ (test (mock-port? ip) #f)
+ (test (mock-port? mop) #t)
+ (test (input-port? mip) #t)
+ (test (output-port? mip) #f)
+ (test (input-port? mop) #f)
+ (test (output-port? mop) #t)
+ (if (not pure-s7) (test (char-ready? mip) #t))
+ (test (char-ready? mop) 'error)
+ (test (port-closed? mip) #f)
+ (test (port-closed? mop) #f)
+; (test (port-line-number mip) 0) ; ??
+ (test (port-filename mip) "")
+ (test (read-char mip) #\0)
+ (test (read-byte mip) (char->integer #\1))
+ (test (peek-char mip) #\2)
+ (test (read-string 3 mip) "234")
+ (test (read-line mip) "56789")
+ (close-input-port mip)
+ (test (port-closed? mip) #t)
+ (test (port-closed? ip) #t)
+ (write-char #\a mop)
+ (test (get-output-string mop) "a")
+ (write-byte (char->integer #\b) mop)
+ (test (get-output-string mop) "ab")
+ (write-string "cde" mop)
+ (test (get-output-string mop) "abcde")
+ (display #\f mop)
+ (write 'g mop)
+ (test (get-output-string mop) "abcdefg")
+ (format mop "~C~C" #\h #\i)
+ (test (get-output-string mop) "abcdefghi")
+ (test (flush-output-port mop) op)
+ (close-output-port mop)
+ (test (port-closed? mop) #t)
+ (test (port-closed? op) #t)
+ (set! mip (mock-port (open-input-string "(+ 1 2)")))
+ (test (eval (read mip)) 3)
+ (close-input-port mip)
+ )))
+
+ ) ; mockery.scm
+
+;(let () (define (f1) (with-let (inlet '+ (lambda args (apply * args))) (+ 1 2 3 4))) (test (with-let (inlet '+ (lambda args (apply * args))) (+ 1 2 3 4)) (f1)))
+;as elsewhere stated, this is documented -- not sure it needs to be fixed
+
+(when (and (not with-bignums)
+ (not pure-s7))
+ (let ()
+ (require stuff.scm mockery.scm)
+ (define (write-func1 port name expr c method)
+ (format port "(define (~A x) ~S)~%" name expr)
+ (format port "(let ((val1 (~A ~S))~%" name c)
+ (format port " (val2 (let ((x ~S)) ~S)))~%" c expr)
+ (format port " (let ((val3 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x)))))))~%" name c method method)
+ (format port " (if (or (not (morally-equal? val1 val2))~%")
+ (format port " (not (morally-equal? val2 val3)))~%")
+ (format port " (format *stderr* \"~A: opt ~~A, unopt ~~A, env ~~A~~%\" val1 val2 val3))))~%~%" name))
+
+ (define* (write-func2 port name expr c1 c2 method method2)
+ (format port "(define (~A x y) ~S)~%" name expr)
+ (format port "(let ((val1 (~A ~S ~S))~%" name c1 c2)
+ (format port " (val2 (let ((x ~S) (y ~S)) ~S)))~%" c1 c2 expr)
+ (format port " (let ((val3 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x))))~%" name c1 method method)
+ (format port " (make-object 'y ~S '~A (make-method ~A (lambda (e) (e 'y)))))))~%" c2 (or method2 method) (or method2 method))
+ (format port " (let ((val4 (~A ~S (make-object 'y ~S '~A (make-method ~A (lambda (e) (e 'y)))))))~%" name c1 c2 (or method2 method) (or method2 method))
+ (format port " (let ((val5 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x)))) ~S)))~%" name c1 method method c2)
+ (format port " (if (or (not (morally-equal? val1 val2))~%")
+ (format port " (not (morally-equal? val2 val3))~%")
+ (format port " (not (morally-equal? val3 val4))~%")
+ (format port " (not (morally-equal? val4 val5)))~%")
+ (format port " (format *stderr* \"~A: opt ~~A, unopt ~~A, exy ~~A, ecy ~~A, exc ~~A~~%\" val1 val2 val3 val4 val5))))))~%~%" name))
+
+ (call-with-output-file
+ "t923.scm"
+ (lambda (p)
+ (format p "(require stuff.scm)~%~%")
+ (format p "(let ()~%")
+ (write-func1 p "+_1s" '(+ 1 x) 3 '+)
+ (write-func1 p "+_s1" '(+ x 1) 3 '+)
+ (write-func1 p "+_s12" '(+ (+ x) 1) 3 '+)
+ (write-func1 p "+_sf" '(+ x 2.0) 3 '+)
+ (write-func1 p "+_fs" '(+ 2.0 x) 3 '+)
+ (write-func2 p "+_xy" '(+ x y) 3 4 '+)
+ (write-func2 p "+_xy1" '(+ 5 x y) 3 4 '+)
+ (write-func2 p "+_xy2" '(+ 5 3 x 2 y) 3 4 '+)
+
+ (write-func1 p "-_s1" '(- x 1) 3 '-)
+ (write-func1 p "-_s1" '(- x 6) 3 '-)
+ (write-func1 p "-_s1" '(- (- x) 1) 3 '-)
+ (write-func1 p "-_1s" '(- 1 x) 3 '-)
+ (write-func1 p "-_sf" '(- x 2.0) 3 '-)
+ (write-func1 p "-_fs" '(- 2.0 x) 3 '-)
+ (write-func2 p "-_xy" '(- x y) 3 4 '-)
+
+ (write-func1 p "*_s" '(* x) 3 '*)
+ (write-func1 p "*_2s" '(* 2 x) 3 '*)
+ (write-func1 p "*_s2" '(* x 2) 3 '*)
+ (write-func1 p "*_sf" '(* x 2.0) 3 '*)
+ (write-func1 p "*_fs" '(* 2.0 x) 3 '*)
+ (write-func1 p "*_xx" '(* x x) 3 '*)
+ (write-func1 p "*_xnk" '(+ (* x 2) 3) 3 '*)
+ (write-func1 p "-_fss" '(- 2.0 (* x x)) 3 '*)
+ (write-func2 p "*_xy" '(* x y) 3 4 '*)
+ (write-func2 p "*1xy" '(* (- 1.0 x) y) 3.0 4 '- '*)
+ (write-func2 p "r2cos" '(* -2.0 x (cos y)) 3.0 1.8 '* 'cos)
+ (write-func1 p "fsf" '(+ 3.5 (* x 4.5)) 5.0 '*)
+
+ (write-func1 p "/_s" '(/ x) 3 '/)
+ (write-func1 p "/_1s" '(/ 1 x) 3 '/)
+ (write-func1 p "/_1.0s" '(/ 1.0 x) 3 '/)
+ (write-func1 p "/_2s" '(/ 2 x) 3 '/)
+ (write-func1 p "/_s2" '(/ x 2) 3 '/)
+ (write-func1 p "/_sf" '(/ x 2.0) 3 '/)
+ (write-func1 p "/_fs" '(/ 2.0 x) 3 '/)
+ (write-func2 p "/_xy" '(/ x y) 3 4 '/)
+
+ (write-func2 p "s_cos_s" '(* x (cos y)) 3.1 1.8 '* 'cos)
+ (write-func2 p "s_sin_s" '(* x (sin y)) 3.1 1.8 '* 'sin)
+
+ (write-func1 p "min_2f" '(min x 1.0) 3.1 'min)
+ (write-func1 p "max_2f" '(max 1.0 x) 3.1 'max)
+ (write-func1 p "min_2f1" '(min x 1.0) 3.1 'min)
+ (write-func1 p "max_2f1" '(max 1.0 x) 3.1 'max)
+ (write-func1 p "modsi0" '(zero? (modulo x 3)) 5 'modulo)
+ (write-func1 p "neglen" '(negative? (length x)) #(0 1) 'length)
+ (write-func1 p "eqzlen" '(= (length x) 0) #() 'length)
+ (write-func1 p "zlen" '(zero? (length x)) #() 'length)
+
+ (write-func1 p "=x" '(= x 1) 1 '=)
+ (write-func1 p "<x" '(< x 1) 1 '<)
+ (write-func1 p "<=x" '(<= x 1) 1 '<=)
+ (write-func1 p ">=x" '(>= x 1) 1 '>=)
+ (write-func1 p ">x" '(> x 1) 1 '>)
+
+ (write-func1 p "=len" '(= (length x) 6) #(0 1 2 3 4 5) 'length)
+ (write-func1 p "<len" '(< (length x) 6) #(0 1 2 3 4 5) 'length)
+ (write-func1 p ">len" '(> (length x) 6) #(0 1 2 3 4 5) 'length)
+ (write-func1 p "<=len" '(<= (length x) 6) #(0 1 2 3 4 5 ) 'length)
+ (write-func1 p "<=len" '(<= (length x) 6) #(0 1 2 3 4 5) 'length)
+ (write-func1 p ">=len" '(>= (length x) 6) #(0 1 2 3 4 5) 'length)
+
+ (for-each ; ints
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_si") `(,f1 x) -3 f1))
+ (list 'real-part 'imag-part 'numerator 'denominator 'even? 'odd? 'zero? 'positive? 'negative? 'infinite? 'nan?
+ 'magnitude 'angle 'rationalize 'abs 'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt
+ 'floor 'ceiling 'truncate 'round 'inexact->exact 'exact->inexact 'integer-length 'logior 'logxor 'logand 'lognot
+ 'number? 'integer? 'real? 'complex? 'rational? 'exact? 'inexact? 'number->string))
+
+ (for-each ; reals
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_sf") `(,f1 x) 3.14 f1))
+ (list 'real-part 'imag-part 'zero? 'positive? 'negative? 'infinite? 'nan?
+ 'magnitude 'angle 'rationalize 'abs 'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt
+ 'floor 'ceiling 'truncate 'round 'inexact->exact 'exact->inexact 'integer-decode-float
+ 'number? 'integer? 'real? 'complex? 'rational? 'exact? 'inexact? 'number->string))
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_si") `(,f1 x 3) 4 f1))
+ (list 'log 'logior 'logxor 'logand 'modulo 'remainder 'quotient 'max 'min 'lcm 'gcd 'expt 'ash))
+
+ (for-each
+ (lambda (f1)
+ (write-func2 p (string-append (symbol->string f1) "_xy") `(,f1 x y) 3 4 f1))
+ (list 'make-polar 'complex 'expt 'lcm 'gcd 'max 'min 'quotient 'remainder 'modulo
+ '= '< '> '<= '>= 'ash 'logbit?))
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_x0") `(,f1 x 0) 3 f1))
+ (list 'make-polar 'complex 'expt 'lcm 'gcd 'max 'min '= '< '> '<= '>= 'ash 'logbit?))
+
+ (for-each
+ (lambda (f1)
+ (write-func2 p (string-append (symbol->string f1) "_xy") `(,f1 x y) 3.14 4.2 f1))
+ (list 'make-polar 'complex 'expt 'max 'min 'quotient 'remainder 'modulo
+ '= '< '> '<= '>=))
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_c") `(,f1 x) #\a f1))
+ (list 'char-upcase 'char-downcase 'char->integer 'char-upper-case? 'char-lower-case? 'char-alphabetic?
+ 'char-numeric? 'char-whitespace? 'char?))
+
+ (for-each
+ (lambda (f2)
+ (write-func2 p (string-append (symbol->string f2) "_xy") `(,f2 x y) #\a #\space f2))
+ (list 'char=? 'char<? 'char>? 'char<=? 'char>=? 'string))
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_xc") `(,f1 x #\b) #\a f1))
+ (list 'char=? 'char<? 'char>? 'char<=? 'char>=?))
+
+ (write-func1 p "intchar" '(integer->char x) 92 'integer->char)
+ (write-func2 p "charpos" '(char-position x y) #\a "dsafa" 'char-position 'char-position)
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_c") `(,f1 x) "asd" f1))
+ (list 'string? 'string-downcase 'string-upcase 'string->list 'string-length 'string-copy))
+
+ (for-each
+ (lambda (f2)
+ (write-func2 p (string-append (symbol->string f2) "_xy") `(,f2 x y) "Aasd" "basd" f2))
+ (list 'string=? 'string<? 'string>? 'string<=? 'string>=? 'string-ci=? 'string-ci<? 'string-ci>? 'string-ci<=? 'string-ci>=? 'string-append))
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_xc") `(,f1 x "asbda") "asda" f1))
+ (list 'string=? 'string<? 'string>? 'string<=? 'string>=? 'string-ci=? 'string-ci<? 'string-ci>? 'string-ci<=? 'string-ci>=?))
+
+ (write-func1 p "lst0" '(list-ref x 0) '(list 0 1 3) 'list-ref)
+ (write-func1 p "lst1" '(list-set! x 0 1) '(list 0 1 3) 'list-set!)
+ (write-func1 p "vct0" '(vector-ref x 0) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+ (write-func1 p "vct1" '(vector-ref x 1) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+ (write-func1 p "vct2" '(vector-ref x 2) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+ (write-func1 p "vct3" '(vector-ref x 3) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+ (write-func1 p "vct4" '(vector-ref x 4) '(vector 0 1 3 4 5 6 7 8) 'vector-ref)
+
+ (write-func1 p "arit" '(aritable? x 1) abs 'aritable?)
+ (write-func1 p "arty" '(arity x) abs 'arity)
+ (write-func1 p "bool" '(boolean? x) #f 'boolean?)
+ (write-func1 p "cc" '(continuation? x) #f 'continuation?)
+ (write-func1 p "eof" '(eof-object? x) #<eof> 'eof-object?)
+ (write-func1 p "gen" '(gensym? x) ''a 'gensym?)
+ (write-func1 p "con" '(constant? x) 1 'constant?)
+ (write-func1 p "df" '(defined? x) ''format 'defined?)
+ (write-func1 p "key" '(keyword? x) ':a 'keyword?)
+ (write-func1 p "keysym" '(keyword->symbol x) ':a 'keyword->symbol)
+ (write-func1 p "intchr" '(integer->char x) 95 'integer->char)
+ ;(write-func1 p "gens" '(gensym x) "asdf" 'gensym) -- can't be the same (this is like calling random)
+ ;(write-func1 p "evl" '(eval x) ''(+ 1 2) 'eval) -- env evals to itself
+ (write-func1 p "evlstr" '(eval-string x) "(+ 1 2)" 'eval-string)
+ (write-func1 p "rev" '(reverse x) #(0 1 2) 'reverse)
+ (write-func1 p "symb" `(symbol x) "asdf" 'symbol)
+ (write-func1 p "mb" '(member 1 x) '(list 0 1 2) 'member)
+ (write-func1 p "mq" '(memq 1 x) '(list 0 1 2) 'memq)
+ (write-func1 p "mv" '(memv 1 x) '(list 0 1 2) 'memv)
+ (write-func1 p "ac" '(assoc 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assoc)
+ (write-func1 p "aq" '(assq 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assq)
+ (write-func1 p "av" '(assv 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assv)
+ (write-func1 p "srt" '(sort! x <) #(0 1 2) 'sort!)
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) abs f1))
+ (list 'procedure-documentation 'funclet
+ 'procedure-setter 'procedure-source 'dilambda? 'procedure?))
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) ''abs f1))
+ (list 'symbol->dynamic-value 'symbol->keyword 'symbol->string 'symbol->value 'symbol-access 'symbol?))
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) #(0 1 2) f1))
+ (list 'vector->list 'vector-dimensions 'vector-length 'vector?))
+
+ (write-func1 p "vs" '(vector-set! x 0 1) (vector 0 1) 'vector-set!)
+ (write-func1 p "vf" '(vector-fill! x 0) (vector 0 1) 'vector-fill!)
+ ;(write-func2 p "va" '(vector-append x y) (vector 0 1) (vector 2 3) 'vector-append 'vector-append)
+
+ (write-func1 p "cwof" '(call-with-output-file x (lambda (p) (display 12 p))) "tmp1.r5rs" 'call-with-output-file)
+ (write-func1 p "cwif" '(call-with-input-file x (lambda (p) (read p))) "tmp1.r5rs" 'call-with-input-file)
+ (write-func1 p "cwis" '(call-with-input-string x (lambda (p) (read p))) "123" 'call-with-input-string)
+ (write-func1 p "wof" '(with-output-to-file x (lambda () (display 12))) "tmp1.r5rs" 'with-output-to-file)
+ (write-func1 p "wif" '(with-input-from-file x (lambda () (read))) "tmp1.r5rs" 'with-input-from-file)
+ (write-func1 p "wis" '(with-input-from-string x (lambda () (read))) "123" 'with-input-from-string)
+
+ (write-func1 p "fvr" '(float-vector-ref x 0) '(float-vector 0 1) 'float-vector-ref)
+ (write-func1 p "fvs" '(float-vector-set! x 0 1.0) '(float-vector 0 1) 'float-vector-set!) ; g_vct_set_three clm2xen.c 9507
+ (write-func1 p "fvq" '(float-vector? x) '(float-vector 0 1) 'float-vector?)
+
+ (for-each
+ (lambda (f1)
+ (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) '(hash-table '(a . 1) '(b . 2)) f1))
+ (list 'hash-table-entries 'hash-table?))
+ (write-func1 p "htr" '(hash-table-ref x 'a) '(hash-table '(a . 1) '(b . 2)) 'hash-table-ref)
+ (write-func1 p "hts" '(hash-table-set! x 'a 1) '(hash-table '(a . 1) '(b . 2)) 'hash-table-set!)
+
+ (write-func1 p "lstail" '(list-tail x 2) '(list 0 1 2 3) 'list-tail)
+ (write-func1 p "op1" '(let ((p (open-input-file x))) (close-input-port p)) "tmp1.r5rs" 'open-input-file)
+ (write-func1 p "op1" '(let ((p (open-input-string x))) (close-input-port p)) "tmp1.r5rs" 'open-input-string)
+; (write-func1 p "mapx" '(map abs x) #(-1 -2 -3) 'map)
+; (write-func1 p "forx" '(let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) x) sum) #(1 2 3) 'for-each)
+
+ (write-func1 p "strfil" '(string-fill! x #\a) '(make-string 3) 'string-fill!)
+ (write-func1 p "strfil" '(string-fill! (make-string 3) x) #\a 'string-fill!)
+ (write-func1 p "lststr" '(list->string x) '(list #\a #\b) 'list->string)
+ (write-func1 p "substr" '(substring x 1) "asdf" 'substring)
+ (write-func2 p "makstr" `(make-string x y) 3 #\a 'make-string)
+
+ (write-func1 p "n?" '(null? x) '(list) 'null?)
+ (write-func1 p "nl?" '(null? x) '(list 1) 'null?)
+ (write-func1 p "npa" '(not (pair? (car x))) '(list 1 2) 'car)
+ (write-func1 p "npa1" '(not (pair? (car x))) '(list (list 1 2)) 'car)
+ (write-func1 p "ft" '(format #f x) "test" 'format)
+ (write-func1 p "sca" '(set-car! x 1) '(list 1 2) 'set-car!)
+ (write-func1 p "scd" '(set-cdr! x 1) '(list 1 2) 'set-cdr!)
+ (write-func1 p "nnd" '(not (null? (cdr x))) '(list 1) 'cdr)
+ (write-func1 p "nnd1" '(not (null? (cdr x))) '(list 1 2) 'cdr)
+ (write-func2 p "strref" `(string-ref x y) "asdf" 1 'string-ref)
+ (write-func2 p "strset" `(string-set! x y #\a) "asdf" 1 'string-set!)
+ (write-func1 p "objstr" `(object->string x) 12 'object->string)
+ (write-func1 p "newstr" `(call-with-output-string (lambda (p) (newline x))) #f 'newline)
+
+ (write-func1 p "ftn" '(format #f x) "test~%" 'format)
+ ;(write-func1 p "stk" '(stacktrace x) 2 'stacktrace)
+ (write-func1 p "symstr" '(symbol->string x) ''a 'symbol->string)
+ (write-func1 p "mrns" '(random-state x) 123 'random-state)
+ (write-func1 p "mrnx" '(random-state 123 x) 123 'random-state)
+ (write-func1 p "a1y" '(assoc (+ 0 1) x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assoc)
+ (write-func1 p "mba" '(member 'a x) '(list 0 'a 2) 'member)
+
+ (write-func1 p ">xf" '(> x 2.0) 3.0 '>)
+ (write-func1 p "=rx" '(= 3/2 x) 2/3 '=)
+ (write-func1 p "-*x" '(- (* x 2.0) 3.0) 4.0 '*)
+ (write-func1 p "-_rs" '(- 2/3 x) 3 '-)
+ (write-func1 p "-_rf" '(- 12 x) 3 '-)
+ (write-func1 p "-_cs" '(- 1+i x) 3 '-)
+ (write-func1 p "+_rs" '(+ 2/3 x) 3 '+)
+ (write-func1 p "+_cs" '(+ 1+i x) 3 '+)
+ (write-func1 p "*_rs" '(* 2/3 x) 3 '*)
+ (write-func1 p "*_cs" '(* 1+i x) 3 '*)
+ (write-func1 p "+_si" '(+ x 12) 3 '+)
+
+ (for-each
+ (lambda (f1 lst)
+ (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) lst f1))
+ (list 'car 'cdr 'caar 'cadr 'cdar 'cddr 'caaar 'caadr 'cadar 'caddr 'cdaar 'cdadr 'cddar 'cdddr 'caaaar 'caaadr 'caadar
+ 'caaddr 'cadaar 'cadadr 'caddar 'cadddr 'cdaaar 'cdaadr 'cdadar 'cdaddr 'cddaar 'cddadr 'cdddar 'cddddr )
+ (list ''(a) ''(a b) ''((a) b c) ''(a b c) ''((a . aa) b c) ''(a b . c) ''(((a)) b c) ''(a (b) c)
+ ''((a aa) b c) ''(a b c) ''(((a . aa)) b c) ''(a (b . bb) c) ''((a aa . aaa) b c) ''(a b c . d)
+ ''((((a))) b c) ''(a ((b)) c) ''((a (aa)) b c) ''(a b (c)) ''(((a aa)) b c) ''(a (b bb) c) ''((a aa aaa) b c)
+ ''(a b c d) ''((((a . aa))) b c) ''(a ((b . bb)) c) ''((a (aa . aaa)) b c) ''(a b (c . cc)) ''(((a aa . aaa)) b c)
+ ''(a (b bb . bbb) c) ''((a aa aaa . aaaa) b c) ''(a b c d . e)))
+
+ (write-func1 p "np" '(not (pair? x)) '(list 1) 'pair?)
+ (write-func1 p "nn" '(not (null? x)) () 'null?)
+ (write-func1 p "ns" '(not (symbol? x)) '(quote q) 'symbol?)
+ (write-func1 p "nx" '(not (number? x)) 3 'number?)
+ (write-func1 p "nr" '(not (real? x)) 3 'real?)
+ (write-func1 p "nm" '(not (rational? x)) 3 'rational?)
+ (write-func1 p "ni" '(not (integer? x)) 3 'integer?)
+ (write-func1 p "nb" '(not (boolean? x)) #f 'boolean?)
+ (write-func1 p "ny" '(not (string? x)) "a" 'string?)
+ (write-func1 p "nc" '(not (char? x)) #\a 'char?)
+ (write-func1 p "ne" '(not (eof-object? x)) #<eof> 'eof-object?)
+ (write-func1 p "nl" '(not (list? x)) '(list 1) 'list?)
+ (write-func1 p "nl1" '(not (proper-list? x)) '(cons 1 2) 'proper-list?)
+ (write-func1 p "scar" '(set! (car x) 2) '(list 0 1) 'set-car!)
+
+ (format p ")~%")
+ ))
+ (load "t923.scm" (curlet))))
+
+(let ()
+ (define (call-with-input-vector v proc)
+ (let ((i -1))
+ (proc (openlet
+ (inlet 'read (lambda (p) (v (set! i (+ i 1))))
+ 'read-byte (lambda (p) (v (set! i (+ i 1))))
+ 'read-char (lambda (p) (v (set! i (+ i 1))))
+ 'read-line (lambda (p) (v (set! i (+ i 1))))
+ 'close-input-port (lambda (p) p)
+ 'read-string (lambda (p) (v (set! i (+ i 1)))))))))
+ (define (call-with-output-vector proc)
+ (let* ((size 1)
+ (v (make-vector size #f))
+ (i 0)
+ (write-to-vector (lambda (obj p)
+ (when (= i size) ; make the vector bigger to accommodate the output
+ (set! v (copy v (make-vector (set! size (* size 2)) #f))))
+ (set! (v i) obj)
+ (set! i (+ i 1))
+ #<unspecified>))) ; that's what write/display return!
+ (proc (openlet
+ (inlet 'write (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p))
+ 'display (lambda* (obj p) ((if (not (let? p)) display write-to-vector) obj p))
+ 'format (lambda (p . args)
+ (if (not (let? p))
+ (apply format p args)
+ (write (apply format #f args) p)))
+ 'write-byte (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p))
+ 'write-char (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p))
+ 'close-output-port (lambda (p) p)
+ 'flush-output-port (lambda (p) p)
+ 'write-string (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p)))))
+ (make-shared-vector v (list i))))
+ (let ((lst ()))
+ (call-with-input-vector
+ (vector 1 2 3 4 5)
+ (lambda (p)
+ (set! lst (cons (read p) lst))
+ (set! lst (cons (read-byte p) lst))
+ (set! lst (cons (read-char p) lst))
+ (set! lst (cons (read-line p) lst))
+ (set! lst (cons (read-string p) lst))
+ (close-input-port p)))
+ (test lst '(5 4 3 2 1)))
+ (test (call-with-output-vector
+ (lambda (p)
+ (write 2 p)
+ (display 4 p)
+ (format p "~C" #\a)
+ (write-byte 8 p)
+ (write-char #\a p)
+ (write-string "a" p)
+ (flush-output-port p)
+ (close-output-port p)))
+ #(2 4 "a" 8 #\a "a")))
+
+(let ()
+ (define (open-output-log name)
+ ;; return a soft output port that does not hold its output file open
+ (define (logit name str)
+ (let ((p (open-output-file name "a")))
+ (display str p)
+ (close-output-port p)))
+ (openlet
+ (inlet :name name
+ :format (lambda (p str . args) (logit (p 'name) (apply format #f str args)))
+ :write (lambda (obj p) (logit (p 'name) (object->string obj #t)))
+ :display (lambda (obj p) (logit (p 'name) (object->string obj #f)))
+ :write-string (lambda (str p) (logit (p 'name) str))
+ :write-char (lambda (ch p) (logit (p 'name) (string ch)))
+ :newline (lambda (p) (logit (p 'name) (string #\newline)))
+ :close-output-port (lambda (p) #f)
+ :flush-output-port (lambda (p) #f))))
+
+ (if (file-exists? "s7-test.log")
+ (delete-file "s7-test.log"))
+ (let ((elog (open-output-log "s7-test.log")))
+ (format elog "this is a test~%")
+ (format elog "all done!~%"))
+ (let ((p (open-input-file "s7-test.log")))
+ (test (read-line p) "this is a test")
+ (test (read-line p) "all done!")
+ (test (eof-object? (read-line p)) #t)
+ (close-input-port p)))
+
+;;; *s7* --------
+(test (integer? (*s7* 'stack-top)) #t)
+(test (integer? (*s7* 'stack-size)) #t)
+(test (integer? (*s7* 'max-stack-size)) #t)
+(test (integer? (*s7* 'rootlet-size)) #t)
+(test (integer? (*s7* 'heap-size)) #t)
+(test (integer? (*s7* 'free-heap-size)) #t)
+(test (integer? (*s7* 'gc-freed)) #t)
+(test (real? (*s7* 'cpu-time)) #t)
+(test (vector? (*s7* 'symbol-table)) #t)
+(test (integer? (*s7* 'max-string-length)) #t)
+(test (integer? (*s7* 'max-list-length)) #t)
+(test (integer? (*s7* 'max-vector-length)) #t)
+(test (integer? (*s7* 'max-vector-dimensions)) #t)
+(test (integer? (*s7* 'default-hash-table-length)) #t)
+(test (integer? (*s7* 'initial-string-port-length)) #t)
+(test (real? (*s7* 'morally-equal-float-epsilon)) #t)
+(test (real? (*s7* 'hash-table-float-epsilon)) #t)
+(test (integer? (*s7* 'float-format-precision)) #t)
+(test (random-state? (*s7* 'default-random-state)) #t)
+(test (*s7* 'stacktrace-defaults) '(3 45 80 45 #t))
+(test (boolean? (*s7* 'undefined-identifier-warnings)) #t)
+(let ()
+ (catch 'one
+ (lambda ()
+ (catch 'two
+ (lambda ()
+ (catch 'three
+ (lambda ()
+ (test (*s7* 'catches) '(#t three two one)))
+ (lambda a a))) (lambda a a))) (lambda a a)))
+(let ()
+ (call-with-exit
+ (lambda (one)
+ (call-with-exit
+ (lambda (two)
+ (call-with-exit
+ (lambda (three)
+ (test (list? (*s7* 'exits)) #t))))))))
+(test (list? (*s7* 'stack)) #t)
+(test (string? (object->string (catch #t (lambda () (dynamic-wind (lambda () #f) (lambda () (object->string (*s7* 'stack))) (lambda () #f))) (lambda args #f)))) #t)
+(test (vector? (*s7* 'gc-protected-objects)) #t)
+(when (provided? 'debugging)
+ (test (vector? (*s7* 'gensyms)) #t)
+ (test (vector? (*s7* 'input-ports)) #t)
+ (test (vector? (*s7* 'output-ports)) #t)
+ (test (vector? (*s7* 'strings)) #t)
+ (test (vector? (*s7* 'vectors)) #t)
+ (test (vector? (*s7* 'hash-tables)) #t)
+ (test (vector? (*s7* 'continuations)) #t))
+(test (vector? (*s7* 'c-objects)) #t)
+(test (vector? (*s7* 'file-names)) #t)
+(test (boolean? (*s7* 'gc-stats)) #f)
+(test (real? (*s7* 'default-rationalize-error)) #t)
+
+(let ((old-default-hash-table-length (*s7* 'default-hash-table-length))
+ (old-initial-string-port-length (*s7* 'initial-string-port-length))
+ (old-hash-table-float-epsilon (*s7* 'hash-table-float-epsilon))
+ (old-morally-equal-float-epsilon (*s7* 'morally-equal-float-epsilon))
+ (old-gc-stats-symbol (*s7* 'gc-stats-symbol))
+ (old-symbol-table-locked? (*s7* 'symbol-table-locked?))
+ (old-max-stack-size (*s7* 'max-stack-size))
+ (old-safety (*s7* 'safety))
+ (old-default-rationalize-error (*s7* 'default-rationalize-error))
+ (old-default-random-state (*s7* 'default-random-state)))
+
+ (set! (*s7* 'default-hash-table-length) 31)
+ (let ((ht (make-hash-table))) (test (length ht) 32))
+ (let ((ht (hash-table '(a . 1)))) (test (length ht) 32))
+ (let ((ht (hash-table* :a 1))) (test (length ht) 32))
+ (set! (*s7* 'hash-table-float-epsilon) 1e-4)
+ (let ((ht (make-hash-table))) (set! (ht 3.0) 'x) (set! (ht 3.00005) 'y) (test (ht 3.00001) 'y))
+ (set! (*s7* 'morally-equal-float-epsilon) .1)
+ (test (morally-equal? 1.0 1.01) #t)
+ (set! (*s7* 'default-rationalize-error) .1)
+ (test (rationalize 3.14159) 16/5)
+
+ (set! (*s7* 'default-hash-table-length) old-default-hash-table-length)
+ (set! (*s7* 'initial-string-port-length) old-initial-string-port-length)
+ (set! (*s7* 'hash-table-float-epsilon) old-hash-table-float-epsilon)
+ (set! (*s7* 'morally-equal-float-epsilon) old-morally-equal-float-epsilon)
+ (set! (*s7* 'gc-stats-symbol) old-gc-stats-symbol)
+ (set! (*s7* 'symbol-table-locked?) old-symbol-table-locked?)
+ (set! (*s7* 'max-stack-size) old-max-stack-size)
+ (set! (*s7* 'safety) old-safety)
+ (set! (*s7* 'default-rationalize-error) old-default-rationalize-error)
+ (set! (*s7* 'default-random-state) old-default-random-state)
+
+ (let ((ht (make-hash-table))) (test (length ht) (*s7* 'default-hash-table-length)))
+ (let ((ht (make-hash-table))) (set! (ht 3.0) 'x) (set! (ht 3.05) 'y) (test (ht 3.01) #f))
+ (test (morally-equal? 1.0 1.01) #f)
+ (test (rationalize 3.14159) 314159/100000)
+ )
+
+(let ((old-vlen (*s7* 'max-vector-length)))
+ (set! (*s7* 'max-vector-length) 123)
+ (test (catch #t (lambda () (make-vector 256)) (lambda args 'error)) 'error)
+ (test (catch #t (lambda () (make-float-vector 256)) (lambda args 'error)) 'error)
+ (test (catch #t (lambda () (make-int-vector 256)) (lambda args 'error)) 'error)
+ (test (catch #t (lambda () (make-hash-table 256)) (lambda args 'error)) 'error)
+ (set! (*s7* 'max-vector-length) old-vlen))
+
+(let ((old-vdim (*s7* 'max-vector-dimensions)))
+ (set! (*s7* 'max-vector-dimensions) 1)
+ (test (catch #t (lambda () (make-vector '(2 3))) (lambda args 'error)) 'error)
+ (test (catch #t (lambda () (make-float-vector '(2 3))) (lambda args 'error)) 'error)
+ (test (catch #t (lambda () (make-int-vector '(2 3))) (lambda args 'error)) 'error)
+ (set! (*s7* 'max-vector-dimensions) old-vdim))
+
+(let ((old-slen (*s7* 'max-string-length)))
+ (set! (*s7* 'max-string-length) 12)
+ (test (catch #t (lambda () (make-string 256)) (lambda args 'error)) 'error)
+ (set! (*s7* 'max-string-length) old-slen))
+
+(let ((old-llen (*s7* 'max-list-length)))
+ (set! (*s7* 'max-list-length) 1)
+ (test (catch #t (lambda () (make-list 256)) (lambda args 'error)) 'error)
+ (set! (*s7* 'max-list-length) old-llen))
+
+(test (*s7* 14) 'error)
+(test (*s7* (list 1)) 'error)
+(test (set! (*s7* 14) 1) 'error)
+
+(let ((old-precision (*s7* 'float-format-precision)))
+ (let ((v ()))
+ (let ((val1 (object->string (do ((i 1 (+ i 1))) ((= i 4) v) (set! v (cons (sin i) v))))))
+ (set! v ())
+ (set! (*s7* 'float-format-precision) 3)
+ (let ((val2 (object->string (do ((i 1 (+ i 1))) ((= i 4) v) (set! v (cons (sin i) v))))))
+ (set! (*s7* 'float-format-precision) old-precision)
+ (if with-bignums
+ (test val1 "(1.411200080598672221007448028081102798466E-1 9.092974268256816953960198659117448427036E-1 8.414709848078965066525023216302989996239E-1)")
+ (test val1 "(0.1411200080598672 0.9092974268256817 0.8414709848078965)"))
+ (if with-bignums
+ (test val2 "(1.411200080598672221007448028081102798466E-1 9.092974268256816953960198659117448427036E-1 8.414709848078965066525023216302989996239E-1)")
+ (test val2 "(0.141 0.909 0.841)"))
+ (if (not with-bignums) (test (<= (length val1) (length val2)) #f))))))
+
+(for-each
+ (lambda (field)
+ (for-each
+ (lambda (arg)
+ (test (set! (*s7* field) arg) 'error))
+ (list "hi" (integer->char 65) (list 1 2) #t (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
+ 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>)))
+ '(print-length safety cpu-time heap-size free-heap-size gc-freed max-string-length max-list-length max-vector-length max-vector-dimensions
+ default-hash-table-length initial-string-port-length gc-protected-objects file-names rootlet-size c-types stack-top stack-size stacktrace-defaults max-stack-size
+ catches exits float-format-precision bignum-precision))
-(if (provided? 'profiling)
- (profile))
+(for-each
+ (lambda (field)
+ (for-each
+ (lambda (arg)
+ (test (set! (*s7* field) arg) 'error))
+ (list "hi" (integer->char 65) (list 1 2) #t (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand
+ 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>)))
+ '(default-rationalize-error default-random-state morally-equal-float-epsilon hash-table-float-epsilon))
+
+(for-each
+ (lambda (field)
+ (for-each
+ (lambda (arg)
+ (test (set! (*s7* field) arg) 'error))
+ (list "hi" (integer->char 65) (list 1 2) (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand
+ 3/4 3.14 1.0+1.0i #\f (lambda (a) (+ a 1)) #<eof> #<undefined>)))
+ '(undefined-identifier-warnings gc-stats symbol-table-locked?))
+
+
+;; it's documented that this kind of stuff may be optimized out, so these can do anything
+;(test (let ((x (abs -1)) (sba abs)) (set! abs odd?) (let ((y (abs 1))) (set! abs sba) (list x y abs))) (list 1 #t abs))
+;(test (let () (define (hi z) (abs z)) (let ((x (hi -1)) (sba abs)) (set! abs odd?) (let ((y (hi 1))) (set! abs sba) (list x y)))) (list 1 #t))
+;(test (let () (define (hi z) (abs z)) (let ((x (hi -1)) (sba abs)) (set! abs (lambda (a b) (+ a b))) (let ((y (hi 1))) (set! abs sba) (list x y)))) 'error)
+;(set! abs #_abs)
+;(test (let () (define (hi) (let ((cond 3)) (set! cond 4) cond)) (hi)) 4)
+;(test (let ((old+ +) (j 0)) (do ((i 0 (+ i 1))) ((or (< i -3) (> i 3))) (set! + -) (set! j (old+ j i))) (set! + old+) j) -6)
;;; --------------------------------------------------------------------------------
+;;; libm
-(format #t "~%;all done!~%")
+(if (not (provided? 'windows))
+ (let ()
+ (require libm.scm)
+
+ (when (and (defined? '*libm*)
+ (procedure? (*libm* 'remquo))) ; ignore ancient versions of libm
+ (with-let (sublet *libm*)
+
+ ;; __DBL_DENORM_MIN__ comes from gcc
+ ;; these tests come from the autotester (I also tried those in glibc 2-17 math/libm-test.inc)
+
+ ;; just representative values -- maybe catch more possibilities?
+ (when (not (provided? 'solaris))
+ (num-test __DBL_DENORM_MIN__ 4.9406564584125e-324)
+ (num-test __DBL_MAX__ 1.7976931348623e+308)
+ (num-test __DBL_MIN__ 2.2250738585072e-308)
+ (num-test __DBL_EPSILON__ 2.2204460492503e-16)
+ (num-test __DBL_MIN_10_EXP__ -307)
+ (num-test __DBL_MAX_10_EXP__ 308)
+ (num-test __DBL_DIG__ 15)
+ (num-test __DBL_MANT_DIG__ 53)
+ (num-test __DBL_MIN_EXP__ -1021)
+ (num-test __DBL_MAX_EXP__ 1024)
+ (reader-cond ((not (provided? 'openbsd)) (num-test __SIZEOF_DOUBLE__ 8)))
+ (reader-cond ((not (provided? 'openbsd)) (num-test __SIZEOF_LONG_LONG__ 8)))
+ (num-test __LONG_LONG_MAX__ 9223372036854775807))
+
+ (reader-cond ((provided? 'linux)
+ (num-test FP_NAN 0)
+ (num-test FP_INFINITE 1)
+ (num-test FP_ZERO 2)
+ (num-test FP_SUBNORMAL 3)
+ (num-test FP_NORMAL 4))
+ ((provided? 'freebsd)
+ (num-test FP_NAN 2)
+ (num-test FP_INFINITE 1)
+ (num-test FP_ZERO 16)
+ (num-test FP_SUBNORMAL 8)
+ (num-test FP_NORMAL 4))
+ ((provided? 'osx)
+ (num-test FP_NAN 1)
+ (num-test FP_INFINITE 2)
+ (num-test FP_ZERO 3)
+ (num-test FP_SUBNORMAL 5)
+ (num-test FP_NORMAL 4)))
+
+ (num-test M_E (exp 1.0))
+ (num-test M_LOG2E (/ (log 2)))
+ (num-test M_LOG10E (/ (log 10)))
+ (num-test M_LN2 (log 2))
+ (num-test M_LN10 (log 10))
+ (num-test M_PI pi)
+ (num-test M_PI_2 (/ pi 2))
+ (num-test M_PI_4 (/ pi 4))
+ (num-test M_1_PI (/ pi))
+ (num-test M_2_PI (/ 2 pi))
+ (num-test M_2_SQRTPI (/ 2 (sqrt pi)))
+ (num-test M_SQRT2 (sqrt 2))
+ (num-test M_SQRT1_2 (/ (sqrt 2)))
+
+ (num-test (j0 -1) 0.76519768655797)
+ (num-test (j0 0) 1.0)
+ (num-test (j0 1) 0.76519768655797)
+ (num-test (j0 1.5) 0.51182767173592)
+ (num-test (j0 -1234567.5) -0.00056797538542782)
+ (num-test (j0 32.75) 0.11922756341796)
+ (num-test (j0 3) -0.26005195490193)
+ (num-test (j0 inf.0) 0.0)
+ (test (nan? (j0 nan.0)) #t)
+
+ (num-test (j1 -42) 0.045993888221887)
+ (num-test (j1 -1) -0.44005058574493)
+ (num-test (j1 0) 0.0)
+ (num-test (j1 3/4) 0.34924360217486)
+ (num-test (j1 -63) 0.057696680293944)
+ (num-test (j1 inf.0) 0.0)
+ (test (nan? (j1 nan.0)) #t)
+ (num-test (j1 32.75) 0.074086803054576)
+ (num-test (j1 1.5) 0.5579365079101)
+
+ (test (nan? (erf nan.0)) #t)
+ (num-test (erf -1) -0.84270079294971)
+ (num-test (erf 0) 0.0)
+ (num-test (erf 1.5) 0.96610514647531)
+ (num-test (erf 3/4) 0.71115563365352)
+ (num-test (erf -63) -1.0)
+ (num-test (erf 3.1415926535898) 0.99999112385363)
+ (num-test (erf inf.0) 1.0)
+
+ (num-test (erfc inf.0) 0.0)
+ (test (nan? (erfc nan.0)) #t)
+ (num-test (erfc 1234567.6) 0.0)
+ (num-test (erfc 1.5) 0.033894853524689)
+ (num-test (erfc -1.5) 1.9661051464753)
+ (num-test (erfc 3.0) 2.2090496998585e-05)
+
+ (num-test (lgamma inf.0) inf.0)
+ (test (nan? (lgamma nan.0)) #t)
+ (num-test (lgamma 1.5) -0.12078223763525)
+ (num-test (lgamma 3/4) 0.2032809514313)
+ (num-test (lgamma 32.75) 80.688603510529)
+ (num-test (lgamma 1.5) -0.12078223763525)
+ (num-test (lgamma -1.5) 0.86004701537648)
+
+ (num-test (fabs -1) 1.0)
+ (num-test (fabs 0) 0.0)
+ (num-test (fabs inf.0) inf.0)
+ (test (nan? (fabs nan.0)) #t)
+ (num-test (fabs 1234567.6) 1234567.6)
+ (num-test (fabs -1234567.6) 1234567.6)
+ (num-test (fabs -1.5) 1.5)
+
+ (num-test (ceil -1) -1.0)
+ (num-test (ceil 0) 0.0)
+ (num-test (ceil inf.0) inf.0)
+ (test (nan? (ceil nan.0)) #t)
+ (num-test (ceil 1234567.6) 1234568.0)
+ (num-test (ceil -1234567.6) -1234567.0)
+ (num-test (ceil 1234567.5) 1234568.0)
+ (num-test (ceil -1234567.5) -1234567.0)
+ (num-test (ceil 32.75) 33.0)
+
+ (when (not (provided? 'netbsd))
+ (num-test (nearbyint 1.5) 2.0)
+ (num-test (nearbyint 3/4) 1.0)
+ (num-test (nearbyint -63) -63.0)
+ (num-test (nearbyint inf.0) inf.0)
+ (test (nan? (nearbyint nan.0)) #t)
+ (num-test (nearbyint 1234567.6) 1234568.0)
+ (num-test (nearbyint 1234567.5) 1234568.0)
+ (num-test (nearbyint -1234567.5) -1234568.0)
+ (num-test (nearbyint 1/9223372036854775807) 0.0))
+
+ (num-test (rint inf.0) inf.0)
+ (test (nan? (rint nan.0)) #t)
+ (num-test (rint 1234567.6) 1234568.0)
+ (num-test (rint -1234567.6) -1234568.0)
+ (num-test (rint 1234567.5) 1234568.0)
+ (num-test (rint -1234567.5) -1234568.0)
+ (num-test (rint 32.75) 33.0)
+ (num-test (rint 1.5) 2.0)
+
+ (num-test (llrint 3.1415926535898) 3)
+ (num-test (llrint 1.5707963267949) 2)
+ (num-test (llrint 1234567.6) 1234568)
+ (num-test (llrint -1234567.6) -1234568)
+ (num-test (llrint 1234567.5) 1234568)
+ (num-test (llrint -1234567.5) -1234568)
+ (num-test (llrint 32.75) 33)
+
+ (num-test (llround 1.5) 2)
+ (num-test (llround 3/4) 1)
+ (num-test (llround 1234567.6) 1234568)
+ (num-test (llround -1234567.6) -1234568)
+ (num-test (llround 1234567.5) 1234568)
+ (num-test (llround -1234567.5) -1234568)
+ (num-test (llround 32.75) 33)
+
+ (num-test (trunc 1.5707963267949) 1.0)
+ (num-test (trunc inf.0) inf.0)
+ (test (nan? (trunc nan.0)) #t)
+ (num-test (trunc 1234567.6) 1234567.0)
+ (num-test (trunc -1234567.6) -1234567.0)
+ (num-test (trunc 1234567.5) 1234567.0)
+ (num-test (trunc -1234567.5) -1234567.0)
+ (num-test (trunc 32.75) 32.0)
+ (num-test (trunc 1.5) 1.0)
+ (num-test (trunc -1.5) -1.0)
+
+ (test (nan? (fmod nan.0 -42.0)) #t)
+ (num-test (fmod 3.1415926535898 3) 0.14159265358979)
+ (num-test (fmod 32.75 -1.5) 1.25)
+ (num-test (fmod 32.75 1.5) 1.25)
+
+ (num-test (ldexp -1 6) -64.0)
+ (num-test (ldexp 0 6) 0.0)
+ (num-test (ldexp 6 6) 384.0)
+ (num-test (ldexp 3.0 1) 6.0)
+ (num-test (ldexp 6 0) 6.0)
+ (num-test (ldexp inf.0 -1) inf.0)
+ (test (nan? (ldexp nan.0 -1)) #t)
+
+ (num-test (scalbn 1.5 3) 12.0)
+ (num-test (scalbn 3.0 6) 192.0)
+ (num-test (scalbn 1.5 1) 3.0)
+ (num-test (scalbn 6 -1) 3.0)
+
+ (when (not (provided? 'netbsd))
+ (num-test (scalbln inf.0 -42) inf.0)
+ (test (nan? (scalbln nan.0 -42)) #t)
+ (num-test (scalbln 3.0 3) 24.0)
+ (num-test (scalbln 0 -42) 0.0)
+ (num-test (scalbln -1.5 6) -96.0)
+ (num-test (scalbln 3.0 6) 192.0)
+ (num-test (scalbln 1 -1) 0.5)
+ (num-test (scalbln 1.5 -1) 0.75))
+
+ (num-test (exp2 -1) 0.5)
+ (num-test (exp2 0) 1.0)
+ (num-test (exp2 1.5) 2.8284271247462)
+ (num-test (exp2 3/4) 1.6817928305074)
+ (num-test (exp2 6) 64.0)
+ (num-test (exp2 inf.0) inf.0)
+ (test (nan? (exp2 nan.0)) #t)
+
+ (num-test (expm1 inf.0) inf.0)
+ (test (nan? (expm1 nan.0)) #t)
+ (num-test (expm1 -1) -0.63212055882856)
+ (num-test (expm1 0) 0.0)
+ (num-test (expm1 1) 1.718281828459)
+ (num-test (expm1 1.5) 3.4816890703381)
+ (num-test (expm1 3/4) 1.1170000166127)
+ (num-test (expm1 -63) -1.0)
+
+ (num-test (log10 inf.0) inf.0)
+ (test (nan? (log10 nan.0)) #t)
+ (num-test (log10 32.75) 1.5152113043278)
+ (num-test (log10 1.5) 0.17609125905568)
+ (num-test (log10 1) 0.0)
+ (num-test (log10 1234567.6) 6.0915148751535)
+
+ (num-test (log1p inf.0) inf.0)
+ (if (provided? 'linux) (test (nan? (log1p nan.0)) #t))
+ (num-test (log1p 1234567.6) 14.02623215528)
+ (num-test (log1p 0.0) 0.0)
+ (num-test (log1p 1) 0.69314718055995)
+ (num-test (log1p 1.5) 0.91629073187416)
+ (num-test (log1p 3/4) 0.55961578793542)
+
+ (num-test (log2 inf.0) inf.0)
+ (test (nan? (log2 nan.0)) #t)
+ (num-test (log2 1234567.6) 20.235574404197)
+ (num-test (log2 1) 0.0)
+ (num-test (log2 32.75) 5.0334230015375)
+ (num-test (log2 1.5) 0.58496250072116)
+
+ (num-test (ilogb 3.1415926535898) 1)
+ (num-test (ilogb 1.5707963267949) 0)
+ (num-test (ilogb inf.0) 2147483647)
+ (num-test (ilogb nan.0) (if (or (provided? 'freebsd) (provided? 'solaris)) 2147483647 -2147483648))
+ (num-test (ilogb 1234567.6) 20)
+ (num-test (ilogb -1234567.6) 20)
+ (num-test (ilogb 1) 0)
+ (num-test (ilogb 3.0) 1)
+
+ (num-test (cbrt inf.0) inf.0)
+ (test (nan? (cbrt nan.0)) #t)
+ (num-test (cbrt 1234567.6) 107.27658956435)
+ (num-test (cbrt -1) -1.0)
+ (num-test (cbrt 0) 0.0)
+ (num-test (cbrt 1) 1.0)
+ (num-test (cbrt 1.5) 1.1447142425533)
+ (num-test (cbrt 3.0) 1.4422495703074)
+
+ (num-test (hypot 0 -42.0) 42.0)
+ (num-test (hypot 1 3) 3.1622776601684)
+ (num-test (hypot 1.5 3) 3.3541019662497)
+ (num-test (hypot 3/4 3) 3.0923292192132)
+ (num-test (hypot inf.0 -1.5) inf.0)
+ (test (nan? (hypot nan.0 -1.5)) #t)
+ (num-test (hypot 1.5 32.75) 32.784333148625)
+
+ (when (not (provided? 'netbsd))
+ (num-test (fma 3.0 3 -42.0) -33.0)
+ (num-test (fma 6 -42 -42.0) -294.0)
+ (num-test (fma 1.5 -42 -42.0) -105.0)
+ (num-test (fma -1.5 -42 -42.0) 21.0)
+ (num-test (fma 3.0 -42 -42.0) -168.0)
+ (num-test (fma inf.0 1.5 -42.0) inf.0))
+
+ (test (nan? (pow nan.0 -42.0)) #t)
+ (num-test (pow 1 3) 1.0)
+ (num-test (pow 1.5 3) 3.375)
+ (num-test (pow 3/4 3) 0.421875)
+ (num-test (pow -63 3) -250047.0)
+ (num-test (pow 6 3) 216.0)
+ (num-test (pow 0.0 3.0) 0.0)
+
+ (num-test (fdim 1.5 -42) 43.5)
+ (num-test (fdim -1.5 -42) 40.5)
+ (num-test (fdim 3.0 -42) 45.0)
+ (num-test (fdim 0 -42.0) 42.0)
+ (test (nan? (fdim 0.0 nan.0)) #t)
+ (num-test (fdim 1 6) 0.0)
+ (num-test (fdim 32.75 6) 26.75)
+
+ (num-test (tgamma 1.5) 0.88622692545276)
+ (num-test (tgamma 3/4) 1.2254167024652)
+ (num-test (tgamma 3.1415926535898) 2.28803779534)
+ (num-test (tgamma 1.5707963267949) 0.89056089038154)
+ (num-test (tgamma inf.0) inf.0)
+ (test (nan? (tgamma nan.0)) #t)
+ (num-test (tgamma -1.5) 2.3632718012074)
+ (num-test (tgamma 3.0) 2.0)
+
+ (num-test (copysign -1.5 3) 1.5)
+ (num-test (copysign 3/4 -42.0) -0.75)
+ (num-test (copysign inf.0 3.0) inf.0)
+ (test (nan? (copysign nan.0 3.0)) #t)
+ (num-test (copysign 1.5 3.0) 1.5)
+ (num-test (copysign -1.5 3.0) 1.5)
+
+ (num-test (nextafter 1 -42) 1.0)
+ (num-test (nextafter 1.5 -42) 1.5)
+ (num-test (nextafter 3/4 -42) 0.75)
+ (test (nan? (nextafter nan.0 -1.5)) #t)
+ (num-test (nextafter 0 -1.5) -4.9406564584125e-324)
+
+ (num-test (nexttoward 0 -42) -4.9406564584125e-324)
+ (num-test (nexttoward 1.5 3) 1.5)
+
+ (when (not (provided? 'solaris))
+ (num-test (isfinite inf.0) 0)
+ (num-test (isfinite nan.0) 0)
+ (num-test (isfinite 1234567.6) 1)
+ (num-test (isfinite -1234567.6) 1)
+ (num-test (isfinite 9223372036854775807) 1)
+
+ (num-test (isinf inf.0) 1)
+ (num-test (isinf nan.0) 0)
+ (num-test (isinf 1234567.6) 0)
+ (num-test (isinf -9223372036854775807) 0)
+ (num-test (isinf -1) 0)
+ (num-test (isinf 0) 0)
+
+ (num-test (isnan inf.0) 0)
+ (num-test (isnan nan.0) 1)
+ (num-test (isnan 1234567.6) 0)
+
+ (num-test (isnormal inf.0) 0)
+ (num-test (isnormal nan.0) 0)
+ (num-test (isnormal 1234567.6) 1)
+ (num-test (isnormal 0) 0)
+
+ (num-test (signbit 1.5) 0)
+ (reader-cond ((provided? 'linux)
+ (num-test (signbit -1.5) 128)
+ (num-test (signbit -1) 128))
+ ((provided? 'osx)
+ (num-test (signbit -1.5) 1)
+ (num-test (signbit -1) 1)))
+ (num-test (signbit 0) 0)
+ (num-test (signbit inf.0) 0)
+ (num-test (signbit nan.0) 0))
+
+ (num-test (floor 1.5) 1.0)
+ (num-test (floor 3/4) 0.0)
+ (num-test (floor -63) -63.0)
+ (num-test (floor inf.0) inf.0)
+ (test (nan? (floor nan.0)) #t)
+ (num-test (floor 1234567.6) 1234567.0)
+ (num-test (floor -1234567.6) -1234568.0)
+ (num-test (floor 1234567.5) 1234567.0)
+ (num-test (floor -1234567.5) -1234568.0)
+ (num-test (floor 32.75) 32.0)
+ (num-test (floor 1.5) 1.0)
+ (num-test (floor -1.5) -2.0)
+
+ (num-test (round inf.0) inf.0)
+ (test (nan? (round nan.0)) #t)
+ (num-test (round 1234567.6) 1234568.0)
+ (num-test (round -1234567.6) -1234568.0)
+ (num-test (round 1234567.5) 1234568.0)
+ (num-test (round -1234567.5) -1234568.0)
+ (num-test (round 32.75) 33.0)
+ (num-test (round 1.5) 2.0)
+ (num-test (round -1.5) -2.0)
+
+ (test (nan? (remainder nan.0 -42)) #t)
+ (num-test (remainder 1234567.6 -42) 19.600000000093)
+ (num-test (remainder -63 3.0) 0.0)
+ (num-test (remainder 32.75 3.0) -0.25)
+ (test (nan? (remainder 3.0 nan.0)) #t)
+ (num-test (remainder -1.5 3/4) 0.0)
+
+ (num-test (exp 1.5707963267949) 4.8104773809654)
+ (num-test (exp inf.0) inf.0)
+ (test (nan? (exp nan.0)) #t)
+ (num-test (exp -1) 0.36787944117144)
+ (num-test (exp 0) 1.0)
+ (num-test (exp 1.5) 4.4816890703381)
+ (num-test (exp 3/4) 2.1170000166127)
+
+ (num-test (log 6) 1.7917594692281)
+ (num-test (log 3.1415926535898) 1.1447298858494)
+ (num-test (log 1.5707963267949) 0.45158270528945)
+ (num-test (log inf.0) inf.0)
+ (test (nan? (log nan.0)) #t)
+ (num-test (log 1234567.6) 14.02623134528)
+ (num-test (log 32.75) 3.4889029620813)
+ (num-test (log 1.5) 0.40546510810816)
+
+ (num-test (sqrt 0.0) 0.0)
+ (num-test (sqrt 1) 1.0)
+ (num-test (sqrt 1.5) 1.2247448713916)
+ (num-test (sqrt 3/4) 0.86602540378444)
+ (num-test (sqrt 6) 2.4494897427832)
+ (num-test (sqrt 3.1415926535898) 1.7724538509055)
+ (num-test (sqrt 1.5707963267949) 1.2533141373155)
+ (num-test (sqrt inf.0) inf.0)
+ (test (nan? (sqrt nan.0)) #t)
+ (num-test (sqrt 1234567.6) 1111.1109755555)
+
+ (num-test (cos 0.0) 1.0)
+ (num-test (cos 1) 0.54030230586814)
+ (num-test (cos 1.5) 0.070737201667703)
+ (num-test (cos 3/4) 0.73168886887382)
+ (num-test (cos -63) 0.98589658158255)
+ (num-test (cos 6) 0.96017028665037)
+ (num-test (cos 3.1415926535898) -1.0)
+ (num-test (cos 1.5707963267949) 6.1232339957368e-17)
+ (test (nan? (cos nan.0)) #t)
+ (num-test (cos 1234567.6) -0.97435594756269)
+
+ (num-test (sin 0.0) 0.0)
+ (num-test (sin 1) 0.8414709848079)
+ (num-test (sin 1.5) 0.99749498660405)
+ (num-test (sin 3/4) 0.68163876002333)
+ (num-test (sin -63) -0.16735570030281)
+ (num-test (sin 6) -0.27941549819893)
+ (num-test (sin 3.1415926535898) 1.2246467991474e-16)
+ (num-test (sin 1.5707963267949) 1.0)
+ (test (nan? (sin nan.0)) #t)
+ (num-test (sin 1234567.6) -0.22501219400117)
+
+ (num-test (tan 0.0) 0.0)
+ (num-test (tan 1) 1.5574077246549)
+ (num-test (tan 1.5) 14.101419947172)
+ (num-test (tan 3/4) 0.93159645994407)
+ (num-test (tan -63) -0.16974975208269)
+ (num-test (tan 6) -0.29100619138475)
+ (num-test (tan 3.1415926535898) -1.2246467991474e-16)
+ (test (nan? (tan nan.0)) #t)
+ (num-test (tan 1234567.6) 0.23093428491305)
+
+ (num-test (sinh 0.0) 0.0)
+ (num-test (sinh 1) 1.1752011936438)
+ (num-test (sinh 1.5) 2.1292794550948)
+ (num-test (sinh 3/4) 0.82231673193583)
+ (num-test (sinh -63) -1.1468915797348e+27)
+ (num-test (sinh 6) 201.71315737028)
+ (num-test (sinh 3.1415926535898) 11.548739357258)
+ (num-test (sinh 1.5707963267949) 2.3012989023073)
+ (num-test (sinh inf.0) inf.0)
+ (test (nan? (sinh nan.0)) #t)
+ (num-test (sinh 1234567.6) inf.0)
+
+ (num-test (tanh 0.0) 0.0)
+ (num-test (tanh 1) 0.76159415595576)
+ (num-test (tanh 1.5) 0.90514825364487)
+ (num-test (tanh 3/4) 0.63514895238729)
+ (num-test (tanh -63) -1.0)
+ (num-test (tanh 6) 0.9999877116508)
+ (num-test (tanh 3.1415926535898) 0.99627207622075)
+ (num-test (tanh 1.5707963267949) 0.91715233566727)
+ (num-test (tanh inf.0) 1.0)
+ (test (nan? (tanh nan.0)) #t)
+ (num-test (tanh 1234567.6) 1.0)
+
+ (num-test (acos 1) 0.0)
+ (num-test (acos 3/4) 0.72273424781342)
+ (test (nan? (acos 1.5707963267949)) #t)
+ (num-test (acos -1) 3.1415926535898)
+ (num-test (acos 0) 1.5707963267949)
+
+ (num-test (asin 0.0) 0.0)
+ (num-test (asin 1) 1.5707963267949)
+ (test (nan? (asin inf.0)) #t)
+ (test (nan? (asin nan.0)) #t)
+ (num-test (asin 3/4) 0.84806207898148)
+
+ (num-test (atan 0.0) 0.0)
+ (num-test (atan 1) 0.78539816339745)
+ (num-test (atan 1.5) 0.98279372324733)
+ (num-test (atan 3/4) 0.64350110879328)
+ (num-test (atan -63) -1.5549246438031)
+ (num-test (atan 6) 1.4056476493803)
+ (num-test (atan 3.1415926535898) 1.2626272556789)
+ (num-test (atan 1.5707963267949) 1.0038848218539)
+ (num-test (atan inf.0) 1.5707963267949)
+ (test (nan? (atan nan.0)) #t)
+ (num-test (atan 1234567.6) 1.5707955167947)
+
+ (test (nan? (atan2 nan.0 3.0)) #t)
+ (num-test (atan2 -1 3) -0.32175055439664)
+ (num-test (atan2 -1 32.75) -0.030524866917203)
+ (num-test (atan2 0.0 3) 0.0)
+ (num-test (atan2 1 3) 0.32175055439664)
+ (num-test (atan2 1.5 3) 0.46364760900081)
+ (num-test (atan2 3/4 3) 0.24497866312686)
+ (num-test (atan2 -63 3) -1.5232132235179)
+
+ (num-test (acosh 1) 0.0)
+ (num-test (acosh 1.5) 0.96242365011921)
+ (num-test (acosh 6) 2.4778887302885)
+ (num-test (acosh 3.1415926535898) 1.8115262724609)
+ (num-test (acosh 1.5707963267949) 1.0232274785476)
+ (num-test (acosh inf.0) inf.0)
+ (test (nan? (acosh nan.0)) #t)
+ (num-test (acosh 1234567.6) 14.71937852584)
+
+ (num-test (asinh 0.0) 0.0)
+ (num-test (asinh 1) 0.88137358701954)
+ (num-test (asinh 1.5) 1.1947632172871)
+ (num-test (asinh 3/4) 0.69314718055995)
+ (num-test (asinh -63) -4.8363448891593)
+ (num-test (asinh 6) 2.4917798526449)
+ (num-test (asinh 3.1415926535898) 1.8622957433108)
+ (num-test (asinh 1.5707963267949) 1.2334031175112)
+ (num-test (asinh inf.0) inf.0)
+ (test (nan? (asinh nan.0)) #t)
+ (num-test (asinh 1234567.6) 14.71937852584)
+
+ (num-test (atanh 0.0) 0.0)
+ (num-test (atanh 3/4) 0.97295507452766)
+ (test (nan? (atanh nan.0)) #t)
+
+ (morally-equal? (remquo -42.0 -42.0) '(0.0 1))
+ (morally-equal? (remquo 1234567.5 3) '(1.5 2))
+ (morally-equal? (remquo 3.1415926535898 3) '(0.14159265358979 1))
+ (morally-equal? (remquo -63 3.0) '(0.0 -5))
+ (morally-equal? (remquo 1 -1.5) '(-0.5 -1))
+ (morally-equal? (remquo 3/4 1.5) '(0.75 0))
+
+ (morally-equal? (frexp 0.0) '(0.0 0))
+ (morally-equal? (frexp 1) '(0.5 1))
+ (morally-equal? (frexp 1.5) '(0.75 1))
+ (morally-equal? (frexp 3/4) '(0.75 0))
+ (morally-equal? (frexp -63) '(-0.984375 6))
+ (morally-equal? (frexp 6) '(0.75 3))
+ (morally-equal? (frexp 3.1415926535898) '(0.78539816339745 2))
+ (morally-equal? (frexp 1.5707963267949) '(0.78539816339745 1))
+ (morally-equal? (frexp inf.0) '(inf.0 0))
+ (morally-equal? (frexp nan.0) '(nan.0 0))
+ (morally-equal? (frexp 1234567.6) '(0.58868770599365 21))
+
+ (morally-equal? (modf 0.0) '(0.0 0.0))
+ (morally-equal? (modf 1) '(0.0 1.0))
+ (morally-equal? (modf 1.5) '(0.5 1.0))
+ (morally-equal? (modf 3/4) '(0.75 0.0))
+ (morally-equal? (modf -63) '(0.0 -63.0))
+ (morally-equal? (modf 6) '(0.0 6.0))
+ (morally-equal? (modf 3.1415926535898) '(0.14159265358979 3.0))
+ (morally-equal? (modf 1.5707963267949) '(0.5707963267949 1.0))
+ (morally-equal? (modf inf.0) '(0.0 inf.0))
+ (morally-equal? (modf nan.0) '(nan.0 nan.0))
+ (morally-equal? (modf 1234567.6) '(0.60000000009313 1234567.0))
+ ))))
+
+;; now check for leaks
+(test (defined? 'remquo) #f)
+(test (defined? 'M_LN2) #f)
+(num-test (sin 1+i) 1.298457581415977+0.6349639147847361i)
+(test (integer? (round 123.3)) #t)
+;;; --------------------------------------------------------------------------------
+;;; libc
+
+(if (not (provided? 'windows))
+ (let ()
+ (require libc.scm)
+ (when (and (defined? '*libc*)
+ (procedure? (*libc* 'passwd_pw_name)))
+ (with-let (sublet *libc*)
+
+ (test (let ((buf (make-string 20 #\null)))
+ (strcat buf "All ")
+ (strcat buf "for ")
+ (strcat buf "one.")
+ (substring buf 0 12))
+ "All for one.")
+ (test (strcmp "a" "b") -1)
+ (test (strcmp "a" "a") 0)
+ (test (strncmp "1234" "1235" 3) 0)
+ (test (strcpy (make-string 3) "123") "123")
+ (test (strlen "123") 3)
+ (test (strchr "12345" (char->integer #\3)) "345")
+ (test (strspn "12345" "123") 3)
+ (test (isalpha (char->integer #\.)) 0)
+ (test (zero? (isdigit (char->integer #\2))) #f)
+ (test (integer->char (toupper (char->integer #\a))) #\A)
+ (test (let ((buf (malloc 3)))
+ (memset buf 90 3)
+ (let ((result (c-pointer->string buf 3)))
+ (free buf)
+ result))
+ "ZZZ")
+
+ (define get-environment-variable getenv)
+ (define get-environment-variables getenvs)
+ (define* (set-environment-variable x v (overwrite #t)) (setenv x v (if overwrite 1 0)))
+ (define delete-environment-variable unsetenv)
+
+ (define (file-exists? file)
+ (= (access file F_OK) 0))
+
+ (define delete-file unlink)
+ ;; system can be used as is
+
+ (define* (ls dir-name (port *stderr*))
+ (let ((dir (opendir dir-name)))
+ (do ((p (read_dir dir) (read_dir dir)))
+ ((= (length p) 0))
+ (format port "~A " p))
+ (closedir dir)))
+
+ (define (directory->list dir-name)
+ (let ((lst ())
+ (dir (opendir dir-name)))
+ (do ((p (read_dir dir) (read_dir dir)))
+ ((= (length p) 0))
+ (if (not (member p '("." "..")))
+ (set! lst (cons p lst)))) ; read_dir in libc.scm returns dpos->d_name
+ (closedir dir)
+ lst))
+
+ (define (memory-usage)
+ (let ((v (rusage.make)))
+ (getrusage RUSAGE_SELF v)
+ (let ((mem (rusage.ru_maxrss v)))
+ (free v)
+ (* 1024 mem))))
+
+ (define (os-type) (car (uname)))
+ (define (cpu-architecture) (cadr (uname)))
+ (define (machine-name) (caddr (uname)))
+ (define (os-version) (string-append (list-ref (uname) 3) " " (list-ref (uname) 4)))
+ (define (implementation-name) "s7")
+ (define (implementation-version) (substring (s7-version) 3 7))
+
+ (reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris)))
+ (define (word-size) __WORDSIZE)))
+ (reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris)))
+ (define (little-endian?) (= __BYTE_ORDER __LITTLE_ENDIAN))))
+
+ (define (command-line)
+ (let ((lst ()))
+ (with-input-from-file "/proc/self/cmdline"
+ (lambda ()
+ (do ((c (read-char) (read-char))
+ (s ""))
+ ((eof-object? c)
+ (reverse lst))
+ (if (char=? c #\null)
+ (begin
+ (set! lst (cons s lst))
+ (set! s ""))
+ (set! s (string-append s (string c)))))))))
+
+ (define (daytime)
+ (let ((timestr (make-string 64)))
+ (let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z"
+ (localtime
+ (time.make (time
+ (c-pointer 0)))))))
+ (substring timestr 0 len))))
+
+ (define (write-date file)
+ (let ((buf (stat.make)))
+ (and (stat file buf)
+ (stat.st_mtime buf))))
+
+ (define (file-write-date->string file)
+ (let ((timestr (make-string 64)))
+ (let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z" (localtime (time.make (write-date file))))))
+ (substring timestr 0 len))))
+
+ (define (copy-file in-file out-file)
+ (with-let (sublet *libc*
+ (inlet 'in-file in-file 'out-file out-file))
+ (let ((infd (open in-file O_RDONLY 0)))
+ (if (= infd -1)
+ (error 'io-error "can't find ~S~%" in-file)
+ (let ((outfd (creat out-file #o666)))
+ (if (= outfd -1)
+ (begin
+ (close infd)
+ (error 'io-error "can't open ~S~%" out-file))
+ (let* ((BUF_SIZE 1024)
+ (buf (malloc BUF_SIZE)))
+ (do ((num (read infd buf BUF_SIZE) (read infd buf BUF_SIZE)))
+ ((or (<= num 0)
+ (not (= (write outfd buf num) num)))))
+ (close outfd)
+ (close infd)
+ (free buf)
+ out-file)))))))
+
+ (define (tty-direct) ; run in a non-GUI repl
+ (with-let (sublet *libc*)
+ (call-with-exit
+ (lambda (quit)
+ (let ((saved (termios.make))
+ (fn (fileno stdin)))
+ (define (tty_reset fd)
+ (tcsetattr fd TCSAFLUSH saved))
+ (define (sigcatch no)
+ (tty_reset fn)
+ (quit))
+ (if (or (equal? (signal SIGINT sigcatch) SIG_ERR)
+ (equal? (signal SIGQUIT sigcatch) SIG_ERR)
+ (equal? (signal SIGTERM sigcatch) SIG_ERR)
+ (negative? (tcgetattr fn saved)))
+ (quit))
+ (let ((buf (termios.make))
+ (c (string #\null #\null)))
+ (let ((cc (string->c-pointer c)))
+ (tcgetattr fn buf)
+ (termios.set_c_lflag buf (logand (termios.c_lflag buf) (lognot (logior ECHO ICANON))))
+ (termios.set_c_cc buf VMIN 1)
+ (termios.set_c_cc buf VTIME 0)
+ (if (negative? (tcsetattr fn TCSAFLUSH buf))
+ (quit))
+ (do ((i (read fn cc 1) (read fn cc 1)))
+ ((not (= i 1))
+ (tty_reset fn)
+ (quit))
+ (format *stderr* "got ~C~%" (c 0))))))))))
+
+ ;; to write a directory files + file size:
+ ;; (ftw "/home/bil/sf1" (lambda (a b c) (format *stderr* "~A ~A~%" a (stat.st_size b)) 0) 10)
+
+ (define (directory? file)
+ (let ((buf (stat.make)))
+ (let ((result (and (stat file buf)
+ (S_ISDIR (stat.st_mode buf)))))
+ (free buf)
+ result)))
+
+ (define* (home-directory name)
+ (if (not name)
+ (getenv "HOME")
+ (passwd.pw_dir (getpwnam name))))
+
+ (define (file-length file)
+ (let ((buf (stat.make)))
+ (stat file buf)
+ (let ((result (stat.st_size buf)))
+ (free buf)
+ result)))
+
+ (define (system-limits)
+ (list 'arg-max (sysconf _SC_ARG_MAX)
+ 'login-max (sysconf _SC_LOGIN_NAME_MAX)
+ 'open-max (sysconf _SC_OPEN_MAX)
+ 'groups-max (sysconf _SC_NGROUPS_MAX)
+ 'page-size (sysconf _SC_PAGESIZE)))
+
+ (test (string? (get-environment-variable "HOME")) #t)
+ (test (integer? (random)) #t)
+ (test (assq 'decimal_point (localeconv)) '(decimal_point . "."))
+ (test (string? (getlogin)) #t)
+ (test (integer? (getpid)) #t)
+ (test (integer? _POSIX_VERSION) #t)
+ (if (provided? 'linux) (test (>= __GLIBC__ 2) #t))
+ (test (c-null? (c-pointer 0)) #t)
+ (test (fnmatch "*.c" "s7.c" FNM_PATHNAME) 0)
+ (test (string? (realpath "s7.c" ".")) #t)
+ (test (passwd.pw_name (getpwnam (getlogin))) (getlogin))
+ (test (string? (passwd.pw_shell (getpwnam (getlogin)))) #t)
+ (reader-cond ((not (provided? 'openbsd))
+ (test (string? (car (let ((w (wordexp.make))) (wordexp "~/cl/snd-gdraw" w 0) (wordexp.we_wordv w)))) #t)))
+ (test (pair? (system-limits)) #t)
+ (test (> (file-length "s7test.scm") 4000000) #t)
+ (test (string? (home-directory)) #t)
+ (test (directory? (home-directory)) #t)
+ (test (string? (file-write-date->string "s7test.scm")) #t)
+ (if (provided? 'linux) (test (string? (car (command-line))) #t))
+ (test (string? (daytime)) #t)
+ (reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris)))
+ (test (not (member (word-size) '(32 64))) #f)))
+ (reader-cond ((provided? 'linux) (test (os-type) "Linux"))
+ ((provided? 'osx) (test (os-type) "Darwin"))
+ ((provided? 'freebsd) (test (os-type) "FreeBSD"))
+ ((provided? 'netbsd) (test (os-type) "NetBSD"))
+ ((provided? 'openbsd) (test (os-type) "OpenBSD"))
+ ((provided? 'solaris) (test (os-type) "SunOS"))
+ (#t (test (os-type) "Unknown")))
+ (test (integer? (memory-usage)) #t)
+ (test (file-exists? "s7test.scm") #t)
+ (test (atoi "123") 123)
+ (test (llabs -1234) 1234)
+ (test (strtod "1.5") 1.5)
+ (test CLOCKS_PER_SEC 1000000)
+ (test (group.gr_name (getgrnam "wheel")) "wheel")
+ (test (let ((g (glob.make))) (glob "s7t*.scm" 0 g) (let ((res (glob.gl_pathv g))) (globfree g) res)) '("s7test.scm"))
+ ))))
+
+
+;;; --------------------------------------------------------------------------------
+;;; libgsl
+
+(if (or (provided? 'linux)
+ (provided? 'osx))
+ (let ()
+ (require libgsl.scm)
+ (when (and (defined? '*libgsl*)
+ (procedure? (*libgsl* 'gsl_vector_equal)))
+ (with-let (sublet *libgsl*)
+
+ (define (eigenvalues M)
+ (with-let (sublet *libgsl* (inlet 'M M))
+ (let* ((len (sqrt (length M)))
+ (gm (gsl_matrix_alloc len len))
+ (m (float-vector->gsl_matrix M gm))
+ (evl (gsl_vector_complex_alloc len))
+ (evc (gsl_matrix_complex_alloc len len))
+ (w (gsl_eigen_nonsymmv_alloc len)))
+
+ (gsl_eigen_nonsymmv m evl evc w)
+ (gsl_eigen_nonsymmv_free w)
+ (gsl_eigen_nonsymmv_sort evl evc GSL_EIGEN_SORT_ABS_DESC)
+
+ (let ((vals (make-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (vals i) (gsl_vector_complex_get evl i)))
+ (gsl_matrix_free gm)
+ (gsl_vector_complex_free evl)
+ (gsl_matrix_complex_free evc)
+ vals))))
+
+ (test (eigenvalues (float-vector 3 1 1 3)) #(4.0 2.0))
+ (test (eigenvalues (float-vector 1 2 4 3)) #(5.0 -1.0))
+
+ (num-test GSL_CONST_CGS_LIGHT_YEAR 9.460536207070001e+17)
+ (num-test (GSL_SIGN -123) -1)
+ (test (GSL_IS_ODD 4) #f)
+ (test (integer? GSL_SF_FACT_NMAX) #t)
+
+ (num-test (gsl_sf_airy_Ai -500.0 GSL_MODE_DEFAULT) 0.07259012010418163)
+ (num-test (gsl_sf_airy_Bi -500.0 GSL_MODE_DEFAULT) -0.0946885701328829)
+ (num-test (gsl_sf_airy_Ai_scaled -5.0 GSL_MODE_DEFAULT) 0.3507610090241141)
+ (num-test (gsl_sf_airy_Bi_scaled -5.0 GSL_MODE_DEFAULT) -0.1383691349016009)
+ (num-test (gsl_sf_airy_Ai_deriv -5.0 GSL_MODE_DEFAULT) 0.3271928185544435)
+ (num-test (gsl_sf_airy_Bi_deriv -5.0 GSL_MODE_DEFAULT) 0.778411773001899)
+ (num-test (gsl_sf_airy_Ai_deriv_scaled -5.0 GSL_MODE_DEFAULT) 0.3271928185544435)
+ (num-test (gsl_sf_airy_Bi_deriv_scaled -5.0 GSL_MODE_DEFAULT) 0.778411773001899)
+ (num-test (gsl_sf_airy_zero_Ai_deriv 2) -3.248197582179837)
+ (num-test (gsl_sf_airy_zero_Bi_deriv 2) -4.073155089071828)
+ (num-test (gsl_sf_bessel_J0 1.0) 0.7651976865579666)
+ (num-test (let ((sfr (gsl_sf_result.make))) (gsl_sf_bessel_J0_e 1.0 sfr) (gsl_sf_result.val sfr)) 0.7651976865579666)
+ (num-test (let ((sfr (gsl_sf_result.make))) (gsl_sf_bessel_J0_e 1.0 sfr) (gsl_sf_result.err sfr)) 6.72613016567227e-16)
+ (num-test (gsl_sf_bessel_J0 .1) 0.9975015620660401)
+ (num-test (gsl_sf_bessel_J1 .1) 0.049937526036242)
+ (num-test (gsl_sf_bessel_Jn 45 900.0) 0.02562434700634277)
+ (num-test (gsl_sf_bessel_Y0 .1) -1.534238651350367)
+ (num-test (gsl_sf_bessel_Y1 .1) -6.458951094702027)
+ (num-test (gsl_sf_bessel_Yn 4 .1) -305832.2979335312)
+ (num-test (gsl_sf_bessel_I0_scaled .1) 0.9071009257823011)
+ (num-test (gsl_sf_bessel_I1_scaled .1) 0.04529844680880932)
+ (num-test (gsl_sf_bessel_In_scaled 4 .1) 2.35752586200546e-07)
+ (num-test (gsl_sf_bessel_I0 .1) 1.002501562934096)
+ (num-test (gsl_sf_bessel_I1 .1) 0.05006252604709269)
+ (num-test (gsl_sf_bessel_In 4 .1) 2.605469021299657e-07)
+ (num-test (gsl_sf_bessel_K0_scaled .1) 2.682326102262894)
+ (num-test (gsl_sf_bessel_K1_scaled .1) 10.8901826830497)
+ (num-test (gsl_sf_bessel_Kn_scaled 4 .1) 530040.2483725621)
+ (num-test (gsl_sf_bessel_K0 .1) 2.427069024702016)
+ (num-test (gsl_sf_bessel_K1 .1) 9.853844780870606)
+ (num-test (gsl_sf_bessel_Kn 4 .1) 479600.2497925678)
+ (num-test (gsl_sf_bessel_j0 1.0) 0.8414709848078965)
+ (num-test (gsl_sf_bessel_j1 1.0) 0.3011686789397567)
+ (num-test (gsl_sf_bessel_j2 1.0) 0.06203505201137386)
+ (num-test (gsl_sf_bessel_jl 5 1.0) 9.256115861125814e-05)
+ (num-test (gsl_sf_bessel_zero_J0 1) 2.404825557695771)
+ (num-test (gsl_sf_bessel_zero_Jnu 5 5) 22.21779994656127)
+ (num-test (gsl_sf_hydrogenicR_1 3 2) 0.02575994825614847)
+ (num-test (gsl_sf_dilog -3.0) -1.939375420766708)
+ (let ((s1 (gsl_sf_result.make))
+ (s2 (gsl_sf_result.make)))
+ (gsl_sf_complex_dilog_e 0.99999 (/ pi 2) s1 s2)
+ (num-test (gsl_sf_result.val s1) -0.2056132926277968)
+ (num-test (gsl_sf_result.val s2) 0.9159577401813151))
+ (let ((s1 (gsl_sf_result.make))
+ (s2 (gsl_sf_result.make)))
+ (gsl_sf_complex_spence_xy_e 0.5 0.0 s1 s2)
+ (num-test (gsl_sf_result.val s1) 0.5822405264650126)
+ (num-test (gsl_sf_result.val s2) 0.0))
+ (num-test (gsl_sf_lngamma -0.1) 2.368961332728787)
+ (num-test (gsl_sf_gamma 9.0) 40320.0)
+ (num-test (gsl_sf_gammastar 9.0) 1.009298426421819)
+ (num-test (gsl_sf_gammainv -1.0) 0.0)
+ (let ((s1 (gsl_sf_result.make))
+ (s2 (gsl_sf_result.make)))
+ (gsl_sf_lngamma_complex_e 5.0 2.0 s1 s2)
+ (num-test (gsl_sf_result.val s1) 2.748701756133804)
+ (num-test (gsl_sf_result.val s2) 3.073843410049702))
+ (num-test (gsl_sf_taylorcoeff 10 5) 2.691144455467373)
+ (num-test (gsl_sf_choose 7 3) 35.0)
+ (num-test (gsl_sf_poch 7 3) 504.0000000000001)
+ (num-test (gsl_sf_gamma_inc_P 1.0 10.0) 0.9999546000702381)
+ (num-test (gsl_sf_lnbeta 0.1 1.0) 2.302585092994044)
+ (num-test (gsl_sf_beta 100.1 -1.2) 1203.895236907804)
+ (num-test (gsl_sf_hyperg_0F1 1 0.5) 1.56608292975635)
+ (num-test (gsl_sf_hyperg_1F1 1 1.5 1) 2.030078469278705)
+ (num-test (gsl_sf_hyperg_U_int 100 100 1) 0.009998990209084679)
+ (num-test (gsl_sf_hyperg_2F1 1 1 1 0.5) 2.0)
+ (num-test (gsl_sf_legendre_P1 -0.5) -0.5)
+ (num-test (gsl_sf_legendre_sphPlm 10 0 -0.5) -0.2433270236930014)
+ (num-test (gsl_sf_legendre_Q0 -0.5) -0.5493061443340549)
+ (num-test (gsl_sf_clausen (+ (* 2 pi) (/ pi 3))) 1.014941606409653)
+ (num-test (gsl_sf_coupling_3j 0 1 1 0 1 -1) 0.7071067811865476)
+ (num-test (gsl_sf_dawson 0.5) 0.4244363835020223)
+ (num-test (gsl_sf_multiply -3 2) -6.0)
+ (num-test (gsl_sf_ellint_E (/ pi 2) 0.5 GSL_MODE_DEFAULT) 1.467462209339427)
+ (num-test (gsl_sf_erfc -10) 2.0)
+ (num-test (gsl_sf_exp_mult 10 -2) -44052.93158961344)
+ (num-test (gsl_sf_expm1 -.001) -0.0009995001666250082)
+ (num-test (gsl_sf_Shi -1) -1.057250875375728)
+ (num-test (gsl_sf_fermi_dirac_0 -1) 0.3132616875182229)
+ (num-test (gsl_sf_gegenpoly_1 1.0 1.0) 2.0)
+
+ (let ((p (float-vector 1.0 -2.0 1.0)) (res (vector 0.0 0.0)))
+ (gsl_poly_complex_solve (double* p) 3 res)
+ (test res #(1.0 1.0)))
+ (let ((p (float-vector 1 -1 1 -1 1 -1 1 -1 1 -1 1)))
+ (num-test (gsl_poly_eval (double* p) 11 1.0) 1.0))
+ (let ((p (float-vector 2.1 -1.34 0.76 0.45)))
+ (num-test (gsl_poly_complex_eval (double* p) 4 0.49+0.95i) 0.3959142999999998-0.6433305000000001i))
+ (let ((res (float-vector 0.0 0.0)))
+ (let ((err (gsl_poly_solve_quadratic 4.0 -20.0 26.0 (double* res))))
+ (test err 0)))
+ (let ((res (float-vector 0.0 0.0)))
+ (let ((err (gsl_poly_solve_quadratic 4.0 -20.0 21.0 (double* res))))
+ (test res (float-vector 1.5 3.5))))
+ (let ((res (float-vector 0.0 0.0 0.0)))
+ (let ((err (gsl_poly_solve_cubic -51 867 -4913 (double* res))))
+ (test res (float-vector 17.0 17.0 17.0))))
+ (let ((res (vector 0.0 0.0)))
+ (let ((err (gsl_poly_complex_solve_quadratic 4.0 -20.0 26.0 res)))
+ (test res #(2.5-0.5i 2.5+0.5i))))
+ (let ((res (vector 0.0 0.0 0.0))) ; workspace handling is internal
+ (let ((err (gsl_poly_complex_solve_cubic -51 867 -4913 res)))
+ (test res #(17.0 17.0 17.0))))
+
+ (num-test (gsl_hypot3 1.0 1.0 1.0) (sqrt 3))
+ (num-test (gsl_hypot 1.0 1.0) (sqrt 2))
+ (test (nan? (gsl_nan)) #t)
+ (test (infinite? (gsl_posinf)) #t)
+ (test (gsl_frexp 2.0) '(0.5 2))
+ (num-test (gsl_pow_2 4) 16.0)
+
+ (num-test (gsl_cdf_ugaussian_P 0.0) 0.5)
+ (num-test (gsl_cdf_ugaussian_P 0.5) 0.691462461274013)
+ (num-test (gsl_cdf_ugaussian_Q 0.5) 0.3085375387259869)
+ (num-test (gsl_cdf_ugaussian_Pinv 0.5) 0.0)
+ (num-test (gsl_cdf_ugaussian_Qinv 0.5) 0.0)
+ (num-test (gsl_cdf_exponential_P 0.1 0.7) 0.1331221002498184)
+ (num-test (gsl_cdf_exponential_Q 0.1 0.7) 0.8668778997501816)
+ (num-test (gsl_cdf_exponential_Pinv 0.13 0.7) 0.09748344713345537)
+ (num-test (gsl_cdf_exponential_Qinv 0.86 0.7) 0.1055760228142086)
+ (num-test (gsl_cdf_exppow_P -0.1 0.7 1.8) 0.4205349082867516)
+ (num-test (gsl_cdf_exppow_Q -0.1 0.7 1.8) 0.5794650917132484)
+ (num-test (gsl_cdf_tdist_P 0.0 1.0) 0.5)
+ (num-test (gsl_cdf_tdist_Q 0.0 1.0) 0.5)
+ (num-test (gsl_cdf_fdist_P 0.0 1.0 1.3) 0.0)
+ (num-test (gsl_cdf_fdist_Q 0.0 1.0 1.3) 1.0)
+ (num-test (gsl_cdf_fdist_Pinv 0.0 1.0 1.3) 0.0)
+ (num-test (gsl_cdf_fdist_Qinv 1.0 1.0 1.3) 0.0)
+ (num-test (gsl_cdf_gamma_P 0 1 1) 0.0)
+ (num-test (gsl_cdf_gamma_Q 0 1 1) 1.0)
+ (num-test (gsl_cdf_chisq_P 0 13) 0.0)
+ (num-test (gsl_cdf_chisq_Q 0 13) 1.0)
+ (num-test (gsl_cdf_beta_P 0 1.2 1.3) 0.0)
+ (num-test (gsl_cdf_beta_Q 0 1.2 1.3) 1.0)
+#|
+ ;; this is *very* slow!
+ (let ((d (gsl_dht_new 128 1.0 1.0))
+ (f_in (make-float-vector 128 0.0))
+ (f_out (make-float-vector 128 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 128))
+ (let ((x (gsl_dht_x_sample d i)))
+ (set! (f_in i) (* x (- 1.0 (* x x))))))
+ (gsl_dht_apply d (double* f_in) (double* f_out))
+ (let ((res (list (f_out 0) (f_out 5))))
+ (gsl_dht_free d)
+ (num-test (res 0) 0.05727421417071144)
+ (num-test (res 1) -0.0001908501261051786)))
+|#
+ (num-test (gsl_stats_mean (double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 2.5)
+ (num-test (gsl_stats_skew (double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 0.0)
+ (num-test (gsl_stats_max (double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 4.0)
+
+ (let ((rng (gsl_rng_alloc gsl_rng_default)))
+ (test (real? (gsl_ran_exponential rng 1.0)) #t)
+ (gsl_rng_free rng))
+
+ (num-test (gsl_complex_log 1+i) (log 1+i))
+ (num-test (gsl_complex_abs 1+i) (magnitude 1+i))
+ (num-test (gsl_complex_sin 1+i) (sin 1+i))
+
+ (let ((gs (gsl_cheb_alloc 40)))
+ (gsl_cheb_init gs (lambda (x) x) -1.0 1.0)
+ (num-test (gsl_cheb_eval gs -1.0) -1.0)
+ (num-test (gsl_cheb_eval gs 0.0) 0.0)
+ (num-test (gsl_cheb_eval gs 1.0) 1.0)
+ (gsl_cheb_free gs))
+
+ (let ((x (float-vector 0.0))
+ (y (float-vector 0.0)))
+ (gsl_deriv_central (lambda (x) (expt x 1.5)) 2.0 1e-8 (double* x) (double* y))
+ (num-test (x 0) (* 1.5 (sqrt 2)))
+ (gsl_deriv_forward (lambda (x) (expt x 1.5)) 0.0 1e-8 (double* x) (double* y))
+ (num-test (x 0) 0.0))
+
+ (let ((f (float-vector -1 3 0 4 2 6)))
+ (gsl_sort (double* f) 1 6)
+ (test f (float-vector -1 0 2 3 4 6)))
+
+ (let ((g1 (gsl_vector_alloc 3))
+ (g2 (gsl_vector_alloc 3))
+ (f1 (make-float-vector 3)))
+ (gsl_vector_add (float-vector->gsl_vector (float-vector 0 1 2) g1)
+ (float-vector->gsl_vector (float-vector 3 4 5) g2))
+ (gsl_vector->float-vector g1 f1)
+ (gsl_vector_free g1)
+ (gsl_vector_free g2)
+ (test f1 (float-vector 3 5 7)))
+
+ (let ((f (make-float-vector '(3 3))))
+ (let ((g (gsl_matrix_alloc 3 3)))
+ (gsl_matrix_set_identity g)
+ (do ((i 0 (+ i 1)))
+ ((= i 3)
+ (gsl_matrix_free g))
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! (f i j) (gsl_matrix_get g i j)))))
+ (test (morally-equal? f #2D((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))) #t))
+
+ (let ((f (make-vector '(3 3))))
+ (let ((g (gsl_matrix_complex_alloc 3 3)))
+ (gsl_matrix_complex_set_identity g)
+ (gsl_matrix_complex_scale g 1+i)
+ (do ((i 0 (+ i 1)))
+ ((= i 3)
+ (gsl_matrix_complex_free g))
+ (do ((j 0 (+ j 1)))
+ ((= j 3))
+ (set! (f i j) (gsl_matrix_complex_get g i j)))))
+ (test (morally-equal? f #2D((1+i 0.0 0.0) (0.0 1+i 0.0) (0.0 0.0 1+i))) #t))
+
+ (let ((Y (float-vector 0.554))
+ (A (float-vector -0.047))
+ (X (float-vector 0.672)))
+ (cblas_dgemv 101 111 1 1 -0.3 (double* A) 1 (double* X) -1 -1 (double* Y) -1)
+ (num-test (Y 0) -0.5445248))
+
+ (let ((Y (float-vector 0.348 0.07))
+ (A (float-vector 0.932 -0.724))
+ (X (float-vector 0.334 -0.317))
+ (alpha (float-vector 0 .1))
+ (beta (float-vector 1 0)))
+ (cblas_zgemv 101 111 1 1 (double* alpha) (double* A) 1 (double* X) -1 (double* beta) (double* Y) -1)
+ (num-test (Y 0) 0.401726)
+ (num-test (Y 1) 0.078178))
+
+ (test (let ((f (float-vector 0 1 2 3 4))) (gsl_interp_bsearch (double* f) 1.5 0 4)) 1)
+
+ (let ((x (make-float-vector 10))
+ (y (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (x i) (+ i (* 0.5 (sin i))))
+ (set! (y i) (+ i (cos (* i i)))))
+ (let ((acc (gsl_interp_accel_alloc))
+ (spline (gsl_spline_alloc gsl_interp_cspline 10)))
+ (gsl_spline_init spline (double* x) (double* y) 10)
+ (let ((res (gsl_spline_eval spline (x 5) acc)))
+ (gsl_spline_free spline)
+ (gsl_interp_accel_free acc)
+ (num-test res 5.991202811863474))))
+
+ (let ((c (gsl_combination_alloc 6 3))
+ (data #2d((0 1 2) (0 1 3) (0 1 4) (0 1 5)
+ (0 2 3) (0 2 4) (0 2 5) (0 3 4)
+ (0 3 5) (0 4 5) (1 2 3) (1 2 4)
+ (1 2 5) (1 3 4) (1 3 5) (1 4 5)
+ (2 3 4) (2 3 5) (2 4 5) (3 4 5)))
+ (iv (make-vector 3 0 #t)))
+ (gsl_combination_init_first c)
+ (do ((i 0 (+ i 1)))
+ ((= i 20))
+ ((*libgsl* 'gsl_combination->int-vector) c iv)
+ (if (not (morally-equal? iv (data i)))
+ (format *stderr* ";gsl_combination: ~A ~A~%" iv (data i)))
+ (gsl_combination_next c))
+ (gsl_combination_free c))
+
+ (let ((p (gsl_permutation_alloc 3))
+ (data (make-vector 18 0 #t)))
+ (gsl_permutation_init p)
+ (do ((pp GSL_SUCCESS (gsl_permutation_next p))
+ (i 0 (+ i 3)))
+ ((not (= pp GSL_SUCCESS)))
+ (set! (data i) (gsl_permutation_get p 0))
+ (set! (data (+ i 1)) (gsl_permutation_get p 1))
+ (set! (data (+ i 2)) (gsl_permutation_get p 2)))
+ (gsl_permutation_free p)
+ (test (morally-equal? data #(0 1 2 0 2 1 1 0 2 1 2 0 2 0 1 2 1 0)) #t))
+
+ (let ((N 50))
+ (let ((t (make-float-vector N 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (set! (t i) (/ 1.0 (* (+ i 1) (+ i 1)))))
+ (let ((zeta_2 (/ (* pi pi) 6.0)))
+ (let ((accel (float-vector 0.0))
+ (err (float-vector 0.0))
+ (w (gsl_sum_levin_u_alloc N)))
+ (gsl_sum_levin_u_accel (double* t) N w (double* accel) (double* err))
+ (num-test zeta_2 (accel 0))
+ (gsl_sum_levin_u_free w)))))
+
+ (let ((data (float-vector 0 0 1 0 1 1 0 -1)) ; complex data as rl+im coming and going
+ (output (make-float-vector 8 0.0)))
+ (gsl_dft_complex_forward (double* data) 1 4 (double* output))
+ ;; = -1 in snd terminology: (cfft! (vector 0 1 1+i 0-i) 4 -1): #(2.0 0-2i 0+2i -2.0)
+ (test (morally-equal? output (float-vector 2.0 0.0 0.0 -2.0 0.0 2.0 -2.0 0.0)) #t))
+ (let ((data (float-vector 0 0 1 0 1 1 0 -1))) ; complex data as rl+im coming and going
+ (gsl_fft_complex_radix2_forward (double* data) 1 4)
+ (test (morally-equal? data (float-vector 2.0 0.0 0.0 -2.0 0.0 2.0 -2.0 0.0)) #t))
+
+ (let ((data (make-float-vector 256))
+ (w (gsl_wavelet_alloc gsl_wavelet_daubechies 4))
+ (work (gsl_wavelet_workspace_alloc 256)))
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (set! (data i) (sin (* i (/ pi 128)))))
+ (gsl_wavelet_transform_forward w (double* data) 1 256 work)
+ (gsl_wavelet_transform_inverse w (double* data) 1 256 work)
+ (gsl_wavelet_free w)
+ (gsl_wavelet_workspace_free work)
+ data)
+
+ (let ((h (gsl_histogram_alloc 10))
+ (data (make-int-vector 10)))
+ (gsl_histogram_set_ranges_uniform h 0.0 1.0)
+ (do ((i 0 (+ i 1)))
+ ((= i 50))
+ (gsl_histogram_increment h (random 1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (data i) (round (gsl_histogram_get h i))))
+ (gsl_histogram_free h)
+ data)
+
+ (let ((a_data (float-vector 0.18 0.60 0.57 0.96 0.41 0.24 0.99 0.58 0.14 0.30 0.97 0.66 0.51 0.13 0.19 0.85))
+ (b_data (float-vector 1 2 3 4)))
+ (let ((m (gsl_matrix_alloc 4 4))
+ (b (gsl_vector_alloc 4)))
+ (let ((x (gsl_vector_alloc 4))
+ (p (gsl_permutation_alloc 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (do ((j 0 (+ j 1)))
+ ((= j 4))
+ (gsl_matrix_set m i j (a_data (+ j (* i 4))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (gsl_vector_set b i (b_data i)))
+ (gsl_linalg_LU_decomp m p) ; int-by-ref is internal
+ (gsl_linalg_LU_solve m p b x)
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (set! (b_data i) (gsl_vector_get x i)))
+ (gsl_permutation_free p)
+ (gsl_vector_free x)
+ b_data)))
+
+ (if (>= gsl-version 1.16)
+ (let ()
+ (define (dofit T X y c cov)
+ (let ((work (gsl_multifit_robust_alloc T (car (gsl_matrix_size X)) (cdr (gsl_matrix_size X)))))
+ (let ((s (gsl_multifit_robust X y c cov work)))
+ (gsl_multifit_robust_free work)
+ s)))
+ (let* ((n 30)
+ (p 2)
+ (a 1.45)
+ (b 3.88)
+ (X (gsl_matrix_alloc n p))
+ (x (gsl_vector_alloc n))
+ (y (gsl_vector_alloc n))
+ (c (gsl_vector_alloc p))
+ (c_ols (gsl_vector_alloc p))
+ (cov (gsl_matrix_alloc p p))
+ (gv (gsl_vector_alloc p))
+ (r (gsl_rng_alloc gsl_rng_default)))
+ (do ((i 0 (+ i 1)))
+ ((= i (- n 3)))
+ (let* ((dx (/ 10.0 (- n 1.0)))
+ (ei (gsl_rng_uniform r))
+ (xi (+ -5.0 (* i dx)))
+ (yi (+ b (* a xi))))
+ (gsl_vector_set x i xi)
+ (gsl_vector_set y i (+ yi ei))))
+ (gsl_vector_set x (- n 3) 4.7)
+ (gsl_vector_set y (- n 3) -8.3)
+ (gsl_vector_set x (- n 2) 3.5)
+ (gsl_vector_set y (- n 2) -6.7)
+ (gsl_vector_set x (- n 1) 4.1)
+ (gsl_vector_set y (- n 1) -6.0)
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((xi (gsl_vector_get x i)))
+ (gsl_matrix_set X i 0 1.0)
+ (gsl_matrix_set X i 1 xi)))
+ (dofit gsl_multifit_robust_ols X y c_ols cov)
+ (dofit gsl_multifit_robust_bisquare X y c cov)
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((xi (gsl_vector_get x i))
+ (yi (gsl_vector_get y i))
+ (y_ols (float-vector 0.0))
+ (y_rob (float-vector 0.0))
+ (y_err (float-vector 0.0)))
+ (gsl_vector_set gv 0 (gsl_matrix_get X i 0))
+ (gsl_vector_set gv 1 (gsl_matrix_get X i 1))
+ (gsl_multifit_robust_est gv c cov (double* y_rob) (double* y_err))
+ (gsl_multifit_robust_est gv c_ols cov (double* y_ols) (double* y_err))))
+ (gsl_matrix_free X)
+ (gsl_matrix_free cov)
+ (gsl_vector_free x)
+ (gsl_vector_free y)
+ (gsl_vector_free c)
+ (gsl_vector_free gv)
+ (gsl_rng_free r))))
+
+ (let ()
+ (gsl_rng_env_setup)
+ (let* ((T gsl_rng_default)
+ (r (gsl_rng_alloc T))
+ (x 0)
+ (y 0)
+ (dx (float-vector 0.0))
+ (dy (float-vector 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (gsl_ran_dir_2d r (double* dx) (double* dy))
+ (set! x (+ x (dx 0)))
+ (set! y (+ y (dy 0))))
+ (gsl_rng_free r)))
+
+ (let ((f_size 2)
+ (T gsl_multimin_fminimizer_nmsimplex))
+ (define (simple-abs x)
+ (let ((u (gsl_vector_get x 0))
+ (v (gsl_vector_get x 1)))
+ (let ((a (- u 1))
+ (b (- v 2)))
+ (+ (abs a) (abs b)))))
+ (let ((x (gsl_vector_alloc f_size))
+ (step_size (gsl_vector_alloc f_size))
+ (s (gsl_multimin_fminimizer_alloc T 2)))
+ (gsl_vector_set x 0 1.0)
+ (gsl_vector_set x 1 2.0)
+ (gsl_vector_set step_size 0 1)
+ (gsl_vector_set step_size 1 1)
+ (gsl_multimin_fminimizer_set s simple-abs x step_size)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (gsl_multimin_fminimizer_iterate s))
+ (let ((result (abs (gsl_multimin_fminimizer_fval s))))
+ (gsl_multimin_fminimizer_free s)
+ (gsl_vector_free x)
+ (gsl_vector_free step_size)
+ (num-test result 0.0))))
+
+ (let ((n 4)
+ (x (float-vector 1970 1980 1990 2000))
+ (y (float-vector 12 11 14 13))
+ (w (float-vector 0.1 0.2 0.3 0.4))
+ (c0 (float-vector 0.0))
+ (c1 (float-vector 0.0))
+ (cov00 (float-vector 0.0))
+ (cov01 (float-vector 0.0))
+ (cov11 (float-vector 0.0))
+ (chisq (float-vector 0.0)))
+ (gsl_fit_wlinear (double* x) 1 (double* w) 1 (double* y) 1 n
+ (double* c0) (double* c1) (double* cov00) (double* cov01) (double* cov11) (double* chisq))
+ (num-test (+ (c0 0) (c1 0)) -106.54))
+
+ (let ((c (gsl_multiset_calloc 4 2)))
+ (test (list (gsl_multiset_n c) (gsl_multiset_k c)) '(4 2)))
+
+ (let ((x (gsl_vector_alloc 2))
+ (factor 1.0)
+ (T gsl_multiroot_fsolver_dnewton))
+ (define (rosenb x f)
+ (let ((x0 (gsl_vector_get x 0))
+ (x1 (gsl_vector_get x 1)))
+ (let ((y0 (- 1 x0))
+ (y1 (* 10 (- x1 (* x0 x0)))))
+ (gsl_vector_set f 0 y0)
+ (gsl_vector_set f 1 y1)
+ GSL_SUCCESS)))
+ (gsl_vector_set x 0 -1.2)
+ (gsl_vector_set x 1 1.0)
+ (let ((s (gsl_multiroot_fsolver_alloc T 2)))
+ (gsl_multiroot_fsolver_set s rosenb x)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (gsl_multiroot_fsolver_iterate s))
+ (let ((residual (abs (gsl_vector_get (gsl_multiroot_fsolver_f s) 0))))
+ (gsl_multiroot_fsolver_free s)
+ (gsl_vector_free x)
+ (test residual 0.0))))
+
+ ))))
+
+(test (defined? 'CLOCKS_PER_SEC (rootlet)) #f) ; autoloader can cause endless confusion here!
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; libgdbm
+
+(if (and (provided? 'linux)
+ (provided? 'system-extras)
+ (file-exists? "/usr/local/lib/libgdbm.a"))
+ (let ()
+ (require libgdbm.scm)
+ (when (and (defined? '*libgdbm*)
+ (procedure? (*libgdbm* 'gdbm_store)))
+ (with-let (sublet *libgdbm*)
+ (let ((gfile (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664 (lambda (str) (format *stderr* "str: ~S~%" str)))))
+ (gdbm_store gfile "1" "1234" GDBM_REPLACE)
+ (gdbm_fetch gfile "1")
+ (gdbm_close gfile))
+
+ (define *db*
+ (openlet
+ (inlet :file (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664
+ (lambda (str) (format *stderr* "gdbm error: ~S~%" str)))
+
+ :let-ref-fallback (lambda (obj sym)
+ (with-input-from-string
+ (gdbm_fetch (obj 'file) (symbol->string sym))
+ (lambda () (eval (read)))))
+
+ :let-set!-fallback (lambda (obj sym val)
+ (gdbm_store (obj 'file)
+ (symbol->string sym)
+ (object->string val :readable)
+ GDBM_REPLACE)
+ val)
+
+ :make-iterator (lambda (obj)
+ (let ((key #f)
+ (length (lambda (obj) (expt 2 20))))
+ (#_make-iterator
+ (openlet
+ (let ((iterator? #t))
+ (lambda ()
+ (if key
+ (set! key (gdbm_nextkey (obj 'file) (cdr key)))
+ (set! key (gdbm_firstkey (obj 'file))))
+ (if (pair? key)
+ (cons (string->symbol (car key))
+ (with-input-from-string
+ (gdbm_fetch (obj 'file) (car key))
+ (lambda () (eval (read)))))
+ key))))))))))
+
+ (set! (*db* 'str) "123") ; add a variable named 'hi with the value "123"
+ (test (*db* 'str) "123")
+ (set! (*db* 'int) 432)
+ (test (*db* 'int) 432)
+ (test (with-let *db* (+ int (length str))) 435)
+ (test (let ((lst (map values *db*)))
+ (or (equal? lst '((str . "123") (int . 432)))
+ (equal? lst '((int . 432) (str . "123")))))
+ #t)
+
+ (gdbm_close (*db* 'file))))))
+
+;;; --------------------------------------------------------------------------------
+;;; libutf8proc
+;;;
+;;; these are from the libutf8proc test directory
+
+(when full-test
+ (load "libutf8proc.scm")
+
+ (when (defined? '*libutf8proc*)
+ (with-let *libutf8proc*
+
+ (define (print-property c)
+ (format *stderr* " category = ~S~% charwidth = ~D~%~A~%"
+ (utf8proc_category_string c)
+ (utf8proc_charwidth c)
+ (utf8proc_get_property c)))
+
+ (do ((c 1 (+ c 1)))
+ ((= c #x110000))
+ (let ((l (utf8proc_tolower c))
+ (u (utf8proc_toupper c)))
+ (if (not (or (= l c)
+ (utf8proc_codepoint_valid l)))
+ (format *stderr* "~X: invalid tolower~%" c))
+ (if (not (or (= u c)
+ (utf8proc_codepoint_valid u)))
+ (format *stderr* "~X: invalid toupper~%" c))
+ ))
+
+ (do ((c 0 (+ c 1)))
+ ((or (= c #xd800)
+ (and (not (utf8proc_codepoint_valid c))
+ (not (format *stderr* "~X: codepoint invalid~%" c))))))
+
+ (do ((c #xd800 (+ c 1)))
+ ((or (= c #xe000)
+ (and (utf8proc_codepoint_valid c)
+ (not (format *stderr* "~X: codepoint valid?~%" c))))))
+
+ (do ((c #xe000 (+ c 1)))
+ ((or (= c #x110000)
+ (and (not (utf8proc_codepoint_valid c))
+ (not (format *stderr* "~X: codepoint invalid~%" c))))))
+
+ (do ((c #x110000 (+ c 1)))
+ ((or (= c #x110010)
+ (and (utf8proc_codepoint_valid c)
+ (not (format *stderr* "~X: codepoint valid?~%" c))))))
+
+ ;; (print-property #xbb)
+
+ (do ((c 1 (+ c 1)))
+ ((= c #x110000))
+ (let ((cat ((utf8proc_get_property c) 'category))
+ (w (utf8proc_charwidth c)))
+ (if (and (or (= cat UTF8PROC_CATEGORY_MN) (= cat UTF8PROC_CATEGORY_ME))
+ (positive? w))
+ (format *stderr* "nonzero width ~D for combining char ~X~%" w c))
+ (if (and (zero? w)
+ (or (and (>= cat UTF8PROC_CATEGORY_LU) (<= cat UTF8PROC_CATEGORY_LO))
+ (and (>= cat UTF8PROC_CATEGORY_ND) (<= cat UTF8PROC_CATEGORY_SC))
+ (and (>= cat UTF8PROC_CATEGORY_SO) (<= cat UTF8PROC_CATEGORY_ZS))))
+ (format *stderr* "zero width for symbol-like char ~X~%" c))))
+ )))
+
+
+(define (symbol->value-anywhere sym)
+ (if (defined? sym)
+ (symbol->value sym)
+ (letrec ((libsearch
+ (lambda (sym libs)
+ (if (pair? libs)
+ (if (defined? sym (cdar libs))
+ (symbol->value sym (cdar libs))
+ (libsearch sym (cdr libs)))
+ #<undefined>))))
+ (libsearch sym *libraries*))))
+
+(test (procedure? (symbol->value-anywhere 'getchar)) #t)
+(test (integer? (symbol->value-anywhere 'GSL_SUCCESS)) #t)
+(test (integer? (symbol->value-anywhere 'most-positive-fixnum)) #t)
+
+(test (let? (cdr (assoc "libc.scm" *libraries*))) #t)
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(define (string-wi=? s1 s2)
+ (or (string=? s1 s2)
+ (let ((len1 (length s1))
+ (len2 (length s2)))
+ (let loop ((i1 0) (i2 0))
+ (or (and (= i1 len1)
+ (= i2 len2))
+ (if (and (< i1 len1)
+ (char-whitespace? (s1 i1)))
+ (loop (+ i1 1) i2)
+ (if (and (< i2 len2)
+ (char-whitespace? (s2 i2)))
+ (loop i1 (+ i2 1))
+ (and (< i1 len1)
+ (< i2 len2)
+ (char=? (s1 i1) (s2 i2))
+ (loop (+ i1 1) (+ i2 1))))))))))
+
+(test (string-wi=? "" "") #t)
+(test (string-wi=? "" " ") #t)
+(test (string-wi=? "" " a") #f)
+(test (string-wi=? "a" " a") #t)
+(test (string-wi=? "a " " a") #t)
+(test (string-wi=? " a " "a") #t)
+(test (string-wi=? " a " " a") #t)
+(test (string-wi=? "\n a\n " "a") #t)
+(test (string-wi=? "aa" " a") #f)
+(test (string-wi=? "aa" " a a ") #t)
+(test (string-wi=? "aa" "aa ") #t)
+
+(let ()
+ (require lint.scm)
+
+ (define (lint-test str1 str2) ;(display str1) (newline)
+ (let ((result (call-with-output-string
+ (lambda (op)
+ (call-with-input-string str1
+ (lambda (ip)
+ (lint ip op)))))))
+
+ (define (no-lines s)
+ (let ((pos (string-position "(line " s))
+ (epos (string-position "): " s)))
+ (if (and pos epos)
+ (no-lines (string-append (substring s 0 (- pos 1)) (substring s (+ epos 1)))) ; sometimes there are two "(line ...)" intrusions
+ s)))
+
+ (if (and (not (string-wi=? result str2))
+ (not (string-wi=? (no-lines result) str2)))
+ (format *stderr* ";(lint ~S) -> ~S~%" str1 result))))
+
+ (lint-test "(+ 1 2)" " +: perhaps (+ 1 2) -> 3")
+ (lint-test "(+ 1 (+ 2 3))" " +: perhaps (+ 1 (+ 2 3)) -> 6")
+ (lint-test "(+ 1 (+ x 3))" " +: perhaps (+ 1 (+ x 3)) -> (+ 4 x)")
+ (lint-test "(+ x)" " +: perhaps (+ x) -> x")
+ (lint-test "(* 2 (+))" " *: perhaps (* 2 (+)) -> 0")
+ (lint-test "(+ (+ (+ x 2) 3) 4)" " +: perhaps (+ (+ (+ x 2) 3) 4) -> (+ 9 x)")
+ (lint-test "(+ 1 2 x -3)" " +: perhaps (+ 1 2 x -3) -> x")
+ (lint-test "(+ 1/2 -1/2)" " +: perhaps (+ 1/2 -1/2) -> 0")
+ (lint-test "(+ 1/3 2/3)" " +: perhaps (+ 1/3 2/3) -> 1")
+ (lint-test "(+ (log x) (log 3))" "") ; oops...
+ (lint-test "(+ x 0 (+ 0 0))" " +: perhaps (+ x 0 (+ 0 0)) -> x")
+ (lint-test "(+ x #(0))" " +: +'s argument 2 should be a number?: #(0): (+ x #(0))")
+ (lint-test "(+ x 2.0 -2)" "")
+
+ (lint-test "(* 2 3)" " *: perhaps (* 2 3) -> 6")
+ (lint-test "(* (* 2 3) 4)" " *: perhaps (* (* 2 3) 4) -> 24")
+ (lint-test "(* (* x 3) 4)" " *: perhaps (* (* x 3) 4) -> (* 12 x)")
+ (lint-test "(* x)" " *: perhaps (* x) -> x")
+ (lint-test "(* x (*))" " *: perhaps (* x (*)) -> x")
+ (lint-test "(* 2 x 3 y 1/6)" " *: perhaps (* 2 x 3 y 1/6) -> (* x y)")
+ (lint-test "(* x -1)" " *: perhaps (* x -1) -> (- x)")
+ (lint-test "(* x 1 1 1)" " *: perhaps (* x 1 1 1) -> x")
+ (lint-test "(* x 1 1.0 1)" " *: perhaps (* x 1 1.0 1) -> (* x 1.0)")
+ (lint-test "(* x y 2 0)" " *: perhaps (* x y 2 0) -> 0")
+ (lint-test "(* -1 x -1 -1)" " *: perhaps (* -1 x -1 -1) -> (- x)")
+
+ (lint-test "(- 1 2)" " -: perhaps (- 1 2) -> -1")
+ (lint-test "(- 1 (- 1 2))" " -: perhaps (- 1 (- 1 2)) -> 2")
+ (lint-test "(- x (- 2 0))" " -: perhaps (- x (- 2 0)) -> (- x 2)")
+ (lint-test "(- (- x))" " -: perhaps (- (- x)) -> x")
+ (lint-test "(- 0 x)" " -: perhaps (- 0 x) -> (- x)")
+ (lint-test "(- x 0)" " -: perhaps (- x 0) -> x")
+ (lint-test "(+ x (- 1))" " +: perhaps (+ x (- 1)) -> (+ x -1)")
+ (lint-test "(- (- y x))" " -: perhaps (- (- y x)) -> (- x y)")
+ (lint-test "(- 3/2 1/2)" " -: perhaps (- 3/2 1/2) -> 1")
+ (lint-test "(- (- x y) z)" " -: perhaps (- (- x y) z) -> (- x y z)")
+ (lint-test "(- x 0 (+ 3 2))" " -: perhaps (- x 0 (+ 3 2)) -> (- x 5)")
+ (lint-test "(- 5 x (+ 3 2))" " -: perhaps (- 5 x (+ 3 2)) -> (- x)")
+ (lint-test "(- x 0 0 0)" " -: perhaps (- x 0 0 0) -> x")
+ (lint-test "(- 0 0 0 x)" " -: perhaps (- 0 0 0 x) -> (- x)")
+ (lint-test "(- 0.0 x)" "")
+ (lint-test "(- x (+ 0 x))" " -: perhaps (- x (+ 0 x)) -> 0")
+ (lint-test "(- (abs x) (abs x) y)" " -: perhaps (- (abs x) (abs x) y) -> (- y)")
+ (lint-test "(- (abs x) (abs x) (abs x) y)" " -: perhaps (- (abs x) (abs x) (abs x) y) -> (- 0 (abs x) y)")
+ (lint-test "(+ x (+ y 2) (+ z 3))" " +: perhaps (+ x (+ y 2) (+ z 3)) -> (+ 5 x y z)")
+
+ (lint-test "(/ 2 3)" " /: perhaps (/ 2 3) -> 2/3")
+ (lint-test "(/ 1 x)" " /: perhaps (/ 1 x) -> (/ x)")
+ (lint-test "(/ 2)" " /: perhaps (/ 2) -> 1/2")
+ (lint-test "(/ 0 2 x)" "")
+ (lint-test "(/ 0 x)" "")
+ (lint-test "(/ (/ x))" " /: perhaps (/ (/ x)) -> x")
+ (lint-test "(/ (log x) (log 2))" " /: perhaps (/ (log x) (log 2)) -> (log x 2)")
+ (lint-test "(/ (log x) (log y))" " /: perhaps (/ (log x) (log y)) -> (log x y)")
+ (lint-test "(/ x (/ y))" "") ; ideally (* x y)
+ (lint-test "(/ x 1 1 1)" " /: perhaps (/ x 1 1 1) -> x")
+ (lint-test "(/ x a (* b 1 c) d)" " /: perhaps (/ x a (* b 1 c) d) -> (/ x a b c d)")
+ (lint-test "(/ 0 a (* b 1 c) d)" " /: perhaps (/ 0 a (* b 1 c) d) -> (/ 0 a b c d)")
+ (lint-test "(/ x x)" " /: this looks odd: (/ x x)")
+ (lint-test "(/ 0)" " /: attempt to invert zero: (/ 0)")
+ (lint-test "(/ x y 2 0)" " /: attempt to divide by 0: (/ x y 2 0)")
+ (lint-test "(/ (/ 1 a) (/ b c d))" " /: perhaps (/ (/ 1 a) (/ b c d)) -> (/ (* c d) (* a b))")
+ (lint-test "(/ (/ a) (/ b))" " /: perhaps (/ (/ a) (/ b)) -> (/ b a)")
+ (lint-test "(/ (/ a b c) (/ d e f))" " /: perhaps (/ (/ a b c) (/ d e f)) -> (/ (* a e f) (* b c d))")
+
+ (lint-test "(sin (asin x))" " sin: perhaps (sin (asin x)) -> x")
+ (lint-test "(sin 0)" " sin: perhaps (sin 0) -> 0")
+ (lint-test "(sin pi)" " sin: perhaps (sin pi) -> 0.0")
+ (lint-test "(cos 0)" " cos: perhaps (cos 0) -> 1")
+ (lint-test "(cos (acos (+ x 1)))" " cos: perhaps (cos (acos (+ x 1))) -> (+ x 1)")
+ (lint-test "(cos (* pi 1))" " cos: perhaps (cos (* pi 1)) -> 1.0")
+ (lint-test "(cos (- (* x y)))" " cos: perhaps (cos (- (* x y))) -> (cos (* x y))")
+ (lint-test "(cos 0)" " cos: perhaps (cos 0) -> 1")
+ (lint-test "(exp (* (+ x y) (log (+ y 1))))" " exp: perhaps (exp (* (+ x y) (log (+ y 1)))) -> (expt (+ y 1) (+ x y))")
+ (lint-test "(exp (* (log x) a))" " exp: perhaps (exp (* (log x) a)) -> (expt x a)")
+ (lint-test "(acosh (cosh 0))" " acosh: perhaps (acosh (cosh 0)) -> (acosh 1)")
+ (lint-test "(exp (log 1))" " exp: perhaps (exp (log 1)) -> 1")
+ (if with-bignums
+ (lint-test "(exp 0.0)" " exp: perhaps (exp 0.0) -> 1.000E0")
+ (lint-test "(exp 0.0)" " exp: perhaps (exp 0.0) -> 1.0"))
+ (lint-test "(sin x 0.0)" " sin: sin has too many arguments: (sin x 0.0)")
+ (lint-test "(sin)" " sin: sin needs 1 argument: (sin)")
+
+ (lint-test "(log 1)" " log: perhaps (log 1) -> 0")
+ (lint-test "(log (exp 0))" " log: perhaps (log (exp 0)) -> 0")
+ (lint-test "(log (exp (* x y)))" " log: perhaps (log (exp (* x y))) -> (* x y)")
+ (lint-test "(log (* x 1) (- x 0))" " log: perhaps (log (* x 1) (- x 0)) -> 1.0")
+ (lint-test "(log 2 2)" " log: perhaps (log 2 2) -> 1")
+ (lint-test "(log pi pi)" " log: perhaps (log pi pi) -> 1.0")
+ (lint-test "(log (* x pi) (* x pi))" " log: perhaps (log (* x pi) (* x pi)) -> 1.0")
+ (lint-test "(log (* x pi))" "")
+
+ (lint-test "(sqrt 4)" " sqrt: perhaps (sqrt 4) -> 2")
+ (if (not with-bignums) (lint-test "(sqrt 3)" ""))
+ (lint-test "(sqrt 4.0)" "")
+ (lint-test "(sqrt (* (+ x 1) (+ x 1)))" "") ; tricky case, x might be -2 for example
+ (lint-test "(sqrt)" " sqrt: sqrt needs 1 argument: (sqrt)")
+ (lint-test "(sqrt (- x 0))" " sqrt: perhaps (sqrt (- x 0)) -> (sqrt x)")
+ (lint-test "(complex (- x 0) 2)" " complex: perhaps (complex (- x 0) 2) -> (complex x 2)")
+
+ (lint-test "(floor 3.4)" " floor: perhaps (floor 3.4) -> 3")
+ (lint-test "(round 3.4+i)" " round: round's argument should be a real?: 3.4+1i: (round 3.4+1i)")
+ (lint-test "(string-ref (round x) str)"
+ " string-ref: string-ref's argument 1 should be a string?: (round x): (string-ref (round x) str)")
+ (lint-test "(string-ref x (cons 1 2))"
+ " string-ref: string-ref's argument 2 should be an integer?: (cons 1 2): (string-ref x (cons 1 2))")
+ (lint-test "(ceiling (floor 2.1))" " ceiling: perhaps (ceiling (floor 2.1)) -> 2")
+ (lint-test "(ceiling (floor x))" " ceiling: perhaps (ceiling (floor x)) -> (floor x)")
+ (lint-test "(truncate 2/3)" " truncate: perhaps (truncate 2/3) -> 0")
+ (lint-test "(truncate (/ 2 3))" " truncate: perhaps (truncate (/ 2 3)) -> 0")
+ (lint-test "(truncate (/ 12 (* 2 3)))" " truncate: perhaps (truncate (/ 12 (* 2 3))) -> 2")
+
+ (lint-test "(abs (magnitude 1+i))" " abs: perhaps (abs (magnitude 1+1i)) -> (magnitude 1+1i)")
+ (lint-test "(magnitude 2/3)" " magnitude: perhaps use abs here: (magnitude 2/3) magnitude: perhaps (magnitude 2/3) -> 2/3")
+ (lint-test "(abs (- (* 2 x)))" " abs: perhaps (abs (- (* 2 x))) -> (abs (* 2 x))")
+ (lint-test "(abs (* (+ x 1) 1))" " abs: perhaps (abs (* (+ x 1) 1)) -> (abs (+ x 1))")
+ (lint-test "(magnitude (real-part z))" " magnitude: perhaps use abs here: (magnitude (real-part z))")
+ (lint-test "(abs (denominator x))" " abs: perhaps (abs (denominator x)) -> (denominator x)")
+ (lint-test "(abs (modulo x 2))" " abs: perhaps (abs (modulo x 2)) -> (modulo x 2)")
+
+ (lint-test "(real-part 3.0)" " real-part: perhaps (real-part 3.0) -> 3.0")
+ (lint-test "(imag-part 3.0)" " imag-part: perhaps (imag-part 3.0) -> 0.0")
+ (lint-test "(real-part (abs x))" " real-part: perhaps (real-part (abs x)) -> (abs x)")
+ (lint-test "(imag-part (abs x))" " imag-part: perhaps (imag-part (abs x)) -> 0.0")
+ (lint-test "(imag-part (sin x))" "")
+ (lint-test "(real-part 1+i)" "")
+ (lint-test "(imag-part x)" "")
+ (lint-test "(real-part x)" "")
+ (lint-test "(imag-part (vector-ref x i))" "")
+ (lint-test "(imag-part (x i))" "")
+
+ (lint-test "(string? (number->string x))" " string?: perhaps (string? (number->string x)) -> (number->string x)")
+ (lint-test "(number? (string->number x))" " number?: perhaps (number? (string->number x)) -> (string->number x)")
+
+ (lint-test "(numerator 1/3)" " numerator: perhaps (numerator 1/3) -> 1")
+ (lint-test "(numerator 3)" " numerator: perhaps (numerator 3) -> 3")
+ (lint-test "(numerator (floor x))" " numerator: perhaps (numerator (floor x)) -> (floor x)")
+ (lint-test "(denominator (floor x))" " denominator: perhaps (denominator (floor x)) -> 1")
+ (lint-test "(denominator 3)" " denominator: perhaps (denominator 3) -> 1")
+ (lint-test "(denominator (round (+ x 1)))" " denominator: perhaps (denominator (round (+ x 1))) -> 1")
+ (lint-test "(numerator (round (+ x 1)))" " numerator: perhaps (numerator (round (+ x 1))) -> (round (+ x 1))")
+ (lint-test "(random 0)" " random: perhaps (random 0) -> 0")
+ (lint-test "(random 0.0)" " random: perhaps (random 0.0) -> 0.0")
+ (lint-test "(random x)" "")
+ (lint-test "(random 1)" "")
+ (lint-test "(random 0 y)" "")
+
+ (lint-test "(lognot 1)" " lognot: perhaps (lognot 1) -> -2")
+ (lint-test "(lognot 1/2)" " lognot: lognot's argument should be an integer?: 1/2: (lognot 1/2)")
+ (if with-bignums
+ (lint-test "(ash 2 64)" " ash: perhaps (ash 2 64) -> 36893488147419103232")
+ (lint-test "(ash 2 64)" ""))
+ (lint-test "(ash 1 7)" " ash: perhaps (ash 1 7) -> 128")
+ (lint-test "(complex 1.0 0)" " complex: perhaps (complex 1.0 0) -> 1.0")
+
+ (lint-test "(expt 0 x)" " expt: perhaps (expt 0 x) -> 0")
+ (lint-test "(expt x 0)" " expt: perhaps (expt x 0) -> 1")
+ (lint-test "(expt (* 2 x) 1)" " expt: perhaps (expt (* 2 x) 1) -> (* 2 x)")
+ (lint-test "(expt (* 2 x) -1)" " expt: perhaps (expt (* 2 x) -1) -> (/ (* 2 x))")
+ (lint-test "(expt 2 3)" " expt: perhaps (expt 2 3) -> 8")
+ (lint-test "(expt 1/2 -2)" " expt: perhaps (expt 1/2 -2) -> 4")
+ (lint-test "(expt 2 1/2)" "")
+ (lint-test "(expt 1.0 1.0)" "")
+ (lint-test "(expt 0 0)" " expt: perhaps (expt 0 0) -> 1")
+
+ (lint-test "(angle -1)" " angle: perhaps (angle -1) -> pi")
+ (lint-test "(angle 0.0)" " angle: perhaps (angle 0.0) -> 0.0")
+ (lint-test "(angle pi)" " angle: perhaps (angle pi) -> 0.0")
+
+ (lint-test "(atan x 0.0)" "")
+ (lint-test "(atan (/ x y))" " atan: perhaps (atan (/ x y)) -> (atan x y)")
+
+ (lint-test "(inexact->exact 1.5)" " inexact->exact: perhaps (inexact->exact 1.5) -> 3/2")
+ (lint-test "(inexact->exact (floor x))" " inexact->exact: perhaps (inexact->exact (floor x)) -> (floor x)")
+ (lint-test "(inexact->exact 2/3)" " inexact->exact: perhaps (inexact->exact 2/3) -> 2/3")
+
+ (lint-test "(logior x (logior y z))" " logior: perhaps (logior x (logior y z)) -> (logior x y z)")
+ (lint-test "(logior x 3 7 3 1 x)" " logior: perhaps (logior x 3 7 3 1 x) -> (logior 7 x)")
+ (lint-test "(logior x)" " logior: perhaps (logior x) -> x")
+ (lint-test "(logior x -1 2 y)" " logior: perhaps (logior x -1 2 y) -> -1")
+ (lint-test "(logior 6 2)" " logior: perhaps (logior 6 2) -> 6")
+ (lint-test "(logior)" " logior: perhaps (logior) -> 0")
+ (lint-test "(logior x 0 y)" " logior: perhaps (logior x 0 y) -> (logior x y)")
+
+ (lint-test "(logand x 3 7 3 1 x)" " logand: perhaps (logand x 3 7 3 1 x) -> (logand 1 x)")
+ (lint-test "(logand 3 91 2)" " logand: perhaps (logand 3 91 2) -> 2")
+ (lint-test "(logand)" " logand: perhaps (logand) -> -1")
+ (lint-test "(logand (* x 3))" " logand: perhaps (logand (* x 3)) -> (* x 3)")
+ (lint-test "(logand (* x 3) 0 y)" " logand: perhaps (logand (* x 3) 0 y) -> 0")
+ (lint-test "(logand -1 x -1 y)" " logand: perhaps (logand -1 x -1 y) -> (logand x y)")
+ (lint-test "(logand x (logand y 1))" " logand: perhaps (logand x (logand y 1)) -> (logand x y 1)")
+ (lint-test "(logand x (logand y 0))" " logand: perhaps (logand x (logand y 0)) -> 0")
+
+ (lint-test "(logxor x y x z)" "")
+ (lint-test "(logxor 2 4 1)" " logxor: perhaps (logxor 2 4 1) -> 7")
+ (lint-test "(logxor x)" " logxor: perhaps (logxor x) -> x")
+ (lint-test "(logxor x x)" " logxor: perhaps (logxor x x) -> 0")
+
+ (lint-test "(gcd x (gcd x y))" " gcd: perhaps (gcd x (gcd x y)) -> (gcd x y)")
+ (lint-test "(lcm x (lcm x y))" " lcm: perhaps (lcm x (lcm x y)) -> (lcm x y)")
+ (lint-test "(gcd x x)" " gcd: perhaps (gcd x x) -> (abs x)")
+ (lint-test "(gcd)" " gcd: perhaps (gcd) -> 0")
+ (lint-test "(lcm)" " lcm: perhaps (lcm) -> 1")
+ (lint-test "(gcd x y 1 3)" " gcd: perhaps (gcd x y 1 3) -> 1")
+ (lint-test "(lcm x y 0 3)" " lcm: perhaps (lcm x y 0 3) -> 0")
+ (lint-test "(gcd 12 18)" " gcd: perhaps (gcd 12 18) -> 6")
+ (lint-test "(gcd x 0)" " gcd: perhaps (gcd x 0) -> (abs x)")
+ (lint-test "(* (gcd a b) (lcm a b))" " *: perhaps (* (gcd a b) (lcm a b)) -> (abs (* a b))")
+ (lint-test "(lcm 12 18)" " lcm: perhaps (lcm 12 18) -> 36")
+ (lint-test "(lcm x)" " lcm: perhaps (lcm x) -> (abs x)")
+ (lint-test "(lcm x x x)" " lcm: perhaps (lcm x x x) -> (abs x)")
+
+ (lint-test "(max x)" " max: perhaps (max x) -> x")
+ (lint-test "(max 3 4 5)" " max: perhaps (max 3 4 5) -> 5")
+ (lint-test "(max 3 x 4 5)" " max: perhaps (max 3 x 4 5) -> (max 5 x)")
+ (lint-test "(max 3.0 x 4/5 5)" " max: perhaps (max 3.0 x 4/5 5) -> (max 5 x)")
+ (lint-test "(min 3.0 x 4/5 5)" " min: perhaps (min 3.0 x 4/5 5) -> (min 4/5 x)")
+ (lint-test "(max 3.0 x x 5)" " max: it looks odd to have repeated arguments in (max 3.0 x x 5) max: perhaps (max 3.0 x x 5) -> (max 5 x)")
+ (lint-test "(max 3 (max 4 x) y)" " max: perhaps (max 3 (max 4 x) y) -> (max 4 x y)")
+ (lint-test "(max 4 (min 3 x) y)" " max: perhaps (max 4 (min 3 x) y) -> (max 4 y)")
+ (lint-test "(min 4 (max 3 x) y)" "")
+ (lint-test "(min (max x 3) 4 y)" "")
+ (lint-test "(min 3 (max 4 x) y)" " min: perhaps (min 3 (max 4 x) y) -> (min 3 y)")
+ (lint-test "(max (min x 3) (min x 3))" " max: this looks odd: (max (min x 3) (min x 3)) max: perhaps (max (min x 3) (min x 3)) -> (min x 3)")
+ (lint-test "(min x (max y x))" " min: perhaps (min x (max y x)) -> x")
+ (lint-test "(max (min y x) x)" " max: perhaps (max (min y x) x) -> x")
+ (lint-test "(min x (max y z (+ 21 x) x (* y z)))" " min: perhaps (min x (max y z (+ 21 x) x (* y z))) -> x")
+
+ (lint-test "(equal? x y z)" " equal?: equal? has too many arguments: (equal? x y z)")
+ (lint-test "(= 1 y 2)" " =: this comparison can't be true: (= 1 y 2)")
+ (lint-test "(= x 1.5)" " =: = can be troublesome with floats: (= x 1.5)")
+ (lint-test "(= x 0.0)" "")
+ (lint-test "(= x 1.0 x)" " =: it looks odd to have repeated arguments in (= x 1.0 x)")
+ (lint-test "(= (- x y) 0)" " =: perhaps (= (- x y) 0) -> (= x y)")
+ (lint-test "(= (- (abs x) 2) 0)" " =: perhaps (= (- (abs x) 2) 0) -> (= (abs x) 2)")
+
+ (lint-test "(memq 1.0 x)" " memq: (memq 1.0 x): perhaps memq -> memv")
+ (lint-test "(assq \"test\" x)" " assq: (assq \"test\" x): perhaps assq -> assoc")
+ (lint-test "(assq (list 1 2) x)" " assq: (assq (list 1 2) x): perhaps assq -> assoc")
+ (lint-test "(assv #(0) x)" " assv: (assv #(0) x): perhaps assv -> assoc")
+ (lint-test "(member 'a x (lambda (a b c) (eq? a b)))" " member: member equality function (optional 3rd arg) should take two arguments")
+ (lint-test "(member 'a x (lambda (a b) (eq? a (car b))))" " member: member might perhaps be assq")
+ (lint-test "(member y x (lambda (a b) (equal? a (car b))))" " member: member might perhaps be assoc")
+ (lint-test "(member 1 x (lambda (a b) (> a b)))" " member: perhaps (lambda (a b) (> a b)) -> >")
+ (lint-test "(member 1 x (lambda (a b) (> b a)))" " member: perhaps (lambda (a b) (> b a)) -> <")
+ (lint-test "(member 1 x abs)" " member: abs is a questionable member function")
+ (lint-test "(member x (list \"asdf\"))" " member: perhaps (member x (list \"asdf\")) -> (string=? x \"asdf\")")
+ (lint-test "(member x (list \"asd\" \"abc\" \"asd\"))" " member: duplicated entry \"asd\" in (list \"asd\" \"abc\" \"asd\")")
+ (lint-test "(memq x '(1))" " memq: perhaps (memq x '(1)) -> (= x 1)")
+ (lint-test "(memq x '(begin))" " memq: perhaps (memq x '(begin)) -> (eq? x 'begin)")
+ (lint-test "(memq x (list 'car))" " memq: perhaps (memq x (list 'car)) -> (eq? x 'car)")
+ (lint-test "(memq x '(a 'b c))" " memq: stray quote? (memq x '(a 'b c))")
+ (lint-test "(memq x '(a ,b c))" " memq: stray comma? (memq x '(a (unquote b) c))")
+ (lint-test "(memq x '(a (+ 1 2) 3))" " memq: pointless list member: (+ 1 2) in (memq x '(a (+ 1 2) 3))")
+ (lint-test "(memq x '(a #(0)))" " memq: pointless list member: #(0) in (memq x '(a #(0)))")
+ (lint-test "(memv x '(#f #\\c a 1 () :a))" "")
+ (lint-test "(memq x '(a b a c))" " memq: duplicated entry a in '(a b a c)")
+ (lint-test "(assq x '((a . 1)))" "")
+
+ (lint-test "(if #f x y)" " if: if test is never true: (if #f x y) if: perhaps (if #f x y) -> y")
+ (lint-test "(if #t #f)" " if: if test is never false: (if #t #f) if: perhaps (if #t #f) -> #f")
+ (lint-test "(if x #f #t)" " if: perhaps (if x #f #t) -> (not x)")
+ (lint-test "(if x #t #t)" " if: if is not needed here: (if x #t #t) -> #t")
+ (lint-test "(if x #f #f)" " if: if is not needed here: (if x #f #f) -> #f")
+ (lint-test "(if x (+ y 1) (+ y 1))" " if: if is not needed here: (if x (+ y 1) (+ y 1)) -> (+ y 1)")
+ (lint-test "(if #f #f)" " if: perhaps (if #f #f) -> #<unspecified>")
+ (lint-test "(if #f x)" " if: if test is never true: (if #f x) if: perhaps (if #f x) -> #<unspecified>")
+ (lint-test "(if #t x y)" " if: if test is never false: (if #t x y) if: perhaps (if #t x y) -> x")
+ (lint-test "(if x #t #f)" " if: perhaps (if x #t #f) -> x")
+ (lint-test "(if x y #f)" " if: perhaps (if x y #f) -> (and x y)")
+ (lint-test "(if x y #t)" " if: perhaps (if x y #t) -> (or (not x) y)")
+ (lint-test "(if x #f y)" " if: perhaps (if x #f y) -> (and (not x) y)")
+ (lint-test "(if x #t y)" " if: perhaps (if x #t y) -> (or x y)")
+ (lint-test "(if (not x) y #t)" " if: perhaps (if (not x) y #t) -> (or x y)")
+ (lint-test "(if (not x) #f y)" " if: perhaps (if (not x) #f y) -> (and x y)")
+ (lint-test "(if (< 1 2) x y)" " if: perhaps (if (< 1 2) x y) -> x")
+ (lint-test "(if (and x z) y #f)" " if: perhaps (if (and x z) y #f) -> (and x z y)")
+ (lint-test "(if (and x z) (and y w) #f)" " if: perhaps (if (and x z) (and y w) #f) -> (and x z y w)")
+ (lint-test "(if (or x z) #t y)" " if: perhaps (if (or x z) #t y) -> (or x z y)")
+ (lint-test "(if (or x z) #t (or y w))" " if: perhaps (if (or x z) #t (or y w)) -> (or x z y w)")
+ (lint-test "(if (not (or x z)) y #t)" " if: perhaps (if (not (or x z)) y #t) -> (or x z y)")
+ (lint-test "(if (not (and x z)) #f y)" " if: perhaps (if (not (and x z)) #f y) -> (and x z y)")
+ (lint-test "(if (cons 1 2) x y)" " if: if test is never false: (if (cons 1 2) x y)")
+ (lint-test "(if y)" " if: if has too few clauses: (if y)")
+ (lint-test "(if y z a b)" " if: if has too many clauses: (if y z a b)")
+ (lint-test "(if x y (if z y))" " if: perhaps (if x y (if z y)) -> (if (or x z) y)")
+ (lint-test "(if x y (if x y))" " if: perhaps (if x y (if x y)) -> (if x y)")
+ (lint-test "(if x (if x y))" " if: perhaps (if x (if x y)) -> (if x y)")
+ (lint-test "(if x (set! y #t) (set! y #f))" " if: perhaps (if x (set! y #t) (set! y #f)) -> (set! y x)")
+ (lint-test "(if x (if y z))" " if: perhaps (if x (if y z)) -> (if (and x y) z)")
+ (lint-test "(if (cadr x) (if (cadr x) 0))" " if: perhaps (if (cadr x) (if (cadr x) 0)) -> (if (cadr x) 0)")
+ (lint-test "(if (cadr x) 3 (if (not (cadr x)) 4))" " if: pointless repetition of if test: (if (cadr x) 3 (if (not (cadr x)) 4)) -> (if (cadr x) 3 4)")
+ (lint-test "(if (cadr x) 3 (if (not (cadr x)) 4 5))" " if: pointless repetition of if test: (if (cadr x) 3 (if (not (cadr x)) 4 5)) -> (if (cadr x) 3 4)")
+ (lint-test "(if x x y)" " if: perhaps (if x x y) -> (or x y)")
+ (lint-test "(if x y x)" " if: perhaps (if x y x) -> (and x y)")
+ (lint-test "(if (> x 1) (> x 1) (< x 2))" " if: perhaps (if (> x 1) (> x 1) (< x 2)) -> (or (> x 1) (< x 2))")
+ (lint-test "(if x x x)" " if: perhaps (if x x x) -> x if: if is not needed here: (if x x x) -> x")
+ (lint-test "(if x x)" " if: perhaps (if x x) -> (or x #<unspecified>)")
+ (lint-test "(if (> x 1) (> x 1))" " if: perhaps (if (> x 1) (> x 1)) -> (or (> x 1) #<unspecified>)")
+ (lint-test "(if (display x) (display x) y)" "")
+ (lint-test "(if (= x 1) 2 (if (= x 3) 2 3))" " if: perhaps (if (= x 1) 2 (if (= x 3) 2 3)) -> (if (memv x '(1 3)) 2 3)")
+ (lint-test "(if z x z)" " if: perhaps (if z x z) -> (and z x)")
+ (lint-test "(begin (if x (y)) (if x (z)) (if x (w)) 32)" " begin: perhaps combine repeated if's: (if x (y)) ... (if x (w)) -> (when x (y) ... (w))")
+ (lint-test "(begin (if x (y)) (if x (z)) (if x (w)))" " begin: perhaps combine repeated if's: (if x (y)) ... (if x (w)) -> (when x (y) ... (w))")
+ (lint-test "(begin (if x (y)) (if x (z)) 32)" "")
+ (lint-test "(begin (if x (y)) (if x (z)))" "")
+ (lint-test "(begin (if x (y)) (if x (z)) (v) (if x (w)))" "")
+ (lint-test "(begin (if x (y)) (if x (z)) (v) (if x (w)) 12)" "")
+
+ (lint-test "(car (cons 1 2))" " car: (car (cons 1 2)) is the same as 1")
+ (lint-test "(and x x y)" " and: perhaps (and x x y) -> (and x y)")
+ (lint-test "(or x x y)" " or: perhaps (or x x y) -> (or x y)")
+ (lint-test "(or x (or x y))" " or: perhaps (or x (or x y)) -> (or x y)")
+ (lint-test "(< x 1 2 0 y)" " <: this comparison can't be true: (< x 1 2 0 y)")
+ (lint-test "(< x 1 2 y)" "")
+ (lint-test "(< x 1 y)" "")
+ (lint-test "(char>? x #\\a #\\b y)" " char>?: this comparison can't be true: (char>? x #\\a #\\b y)")
+ (lint-test "(string>? \"a\" x \"b\" y)" " string>?: this comparison can't be true: (string>? \"a\" x \"b\" y)")
+ (lint-test "(copy (copy x))" " copy: (copy (copy x)) could be (copy x)")
+
+ (lint-test "(string-copy (string-copy x))" " string-copy: (string-copy (string-copy x)) could be (string-copy x)")
+ (lint-test "(string-append x)" " string-append: perhaps (string-append x) -> x, or use copy")
+ (lint-test "(string-append \"\" \"\" x)" " string-append: perhaps (string-append \"\" \"\" x) -> x, or use copy")
+ (lint-test "(string-append \"\" \"\")" " string-append: perhaps (string-append \"\" \"\") -> \"\"")
+ (lint-test "(string-append \"\" (string-append x y) \"\")" " string-append: perhaps (string-append \"\" (string-append x y) \"\") -> (string-append x y)")
+ (lint-test "(string-append \"123\" \"456\")" " string-append: perhaps (string-append \"123\" \"456\") -> \"123456\"")
+ (lint-test "(string-append x (string-append y z))" " string-append: perhaps (string-append x (string-append y z)) -> (string-append x y z)")
+ (lint-test "(vector-append)" " vector-append: perhaps (vector-append) -> #()")
+ (lint-test "(vector-append #(1 2) (vector-append #(3)))" " vector-append: perhaps (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3)")
+ (lint-test "(vector-append x (vector-append y z))" " vector-append: perhaps (vector-append x (vector-append y z)) -> (vector-append x y z)")
+
+ (lint-test "(object->string (object->string x))" " object->string: (object->string (object->string x)) could be (object->string x)")
+ (lint-test "(object->string x :else)" " object->string: bad second argument: :else")
+ (lint-test "(display (format #f str x))" " display: (display (format #f str x)) could be (format #t str x)")
+ (lint-test "(vector->list (list->vector x))" " vector->list: (vector->list (list->vector x)) could be (copy x)")
+ (lint-test "(reverse (reverse x))" " reverse: (reverse (reverse x)) could be (copy x)")
+ (lint-test "(string->number (number->string x))" " string->number: (string->number (number->string x)) could be x")
+
+ (lint-test "(append 3)" " append: perhaps (append 3) -> 3")
+ (lint-test "(append)" " append: perhaps (append) -> ()")
+ (lint-test "(append (append))" " append: perhaps (append (append)) -> ()")
+ (lint-test "(append '(1) (append '(2)))" " append: perhaps (append '(1) (append '(2))) -> (list 1 2)")
+ (lint-test "(append x (append))" " append: perhaps clearer: (append x (append)) -> (copy x)")
+ (lint-test "(append '(1 2) (list))" " append: perhaps clearer: (append '(1 2) (list)) -> (copy '(1 2))")
+ (lint-test "(append x '())" " append: perhaps clearer: (append x '()) -> (copy x) append: quote is not needed here: '()")
+ (lint-test "(append '(1) (append 2))" " append: perhaps (append '(1) (append 2)) -> (append '(1) 2)")
+ (lint-test "(append '(1) (append '(2) '(3)) '(4))" " append: perhaps (append '(1) (append '(2) '(3)) '(4)) -> (list 1 2 3 4)")
+ (lint-test "(append (list x y) (list z))" " append: perhaps (append (list x y) (list z)) -> (list x y z)")
+ (lint-test "(append '(1 2) (list 3))" " append: perhaps (append '(1 2) (list 3)) -> (list 1 2 3)")
+ (lint-test "(append '(1) '(2 3))" " append: perhaps (append '(1) '(2 3)) -> (list 1 2 3)")
+ (lint-test "(append '(x) '((+ 1 2) #(0)))" " append: perhaps (append '(x) '((+ 1 2) #(0))) -> (list 'x '(+ 1 2) #(0))")
+ ;; (equal? (list 'x '(+ 1 2) #(0)) (append '(x) '((+ 1 2) #(0)))) -> #t
+ (lint-test "(append (list x) (list y z) (list 1))" " append: perhaps (append (list x) (list y z) (list 1)) -> (list x y z 1)")
+
+ (lint-test "(cons x (list y z))" " cons: perhaps (cons x (list y z)) -> (list x y z)")
+ (lint-test "(cons x (list))" " cons: perhaps (cons x (list)) -> (list x)")
+
+ (lint-test "(sort! x abs)" " sort!: abs is a questionable sort! function")
+ (lint-test "(sort! x (lambda (a b) (< a b)))" " sort!: perhaps (lambda (a b) (< a b)) -> <")
+ (lint-test "(sort! x (lambda (a b) (< b a)))" " sort!: perhaps (lambda (a b) (< b a)) -> >")
+ (lint-test "(abs 1 2)" " abs: abs has too many arguments: (abs 1 2)")
+ (lint-test "(-)" " -: - needs at least 1 argument: (-)")
+ (lint-test "(modulo 3)" " modulo: modulo needs 2 arguments: (modulo 3)")
+
+ (lint-test "(let () (define* (f1 a b) (+ a b)) (f1 :c 1))" " let: f1 keyword argument :c (in (f1 :c 1)) does not match any argument in (a b)")
+ (lint-test "(let () (define (f2 a b) (+ a b)) (f2 1 2 3))" " let: f2 has too many arguments: (f2 1 2 3)")
+ (lint-test "(let () (define* (f3 a . b) (+ a b)) (f3 1 2 3))" "")
+ (lint-test "(let () (define* (f4 (a #f)) a) (f4))" " f4: the default argument value is #f in define* (a #f)")
+ (lint-test "(let () (define (f1 a) a) 32)" " let: let variable f1 not used")
+ (lint-test "(letrec ((f1 (lambda (a) a))) 32)" " letrec: letrec variable f1 not used")
+ (lint-test "(let () (define x 3) 32)" " let: let variable x not used")
+ (lint-test "(let ((z 1)) (define x 12) (define (y a) a) 32)" " let: let variables x, y, z not used")
+ (lint-test "(let ((z 1)) (define x 12) (define (y a) a) (+ z 32))" " let: let variables x, y not used")
+ (lint-test "(let* ((a 1) (b 2) (c (+ a 1))) (* c 2))" " let*: let* variable b not used")
+ (lint-test "(let () (define (f4 a . b) (+ a b)) (f4))" " let: f4 needs 1 argument: (f4)")
+ (lint-test "(let ((a)) #f)" " let: let variable value is missing? (a)")
+ (lint-test "(let ((a . 1)) #f)" " let: let binding is an improper list? (a . 1)")
+ (lint-test "(let ((1 2)) #f)" " let: let variable is not a symbol? (1 2)")
+ (lint-test "(let ((pi 2)) #f)" " let: can't bind a constant: (pi 2)")
+ (lint-test "(let ((:a 1)) :a)" " let: let variable is a keyword? (:a 1)")
+ (lint-test "(let ((a 2) (a 3)) a)" " let: let variable a is declared twice let: let variable a not used")
+ (lint-test "(let (a) a)" " let: let binding is not a list? a")
+ (lint-test "(let ((a 1) (set! a 2)))" " let: let is messed up: (let ((a 1) (set! a 2)))")
+ (lint-test "(let ((a 1)) (set! a 2))" " let: let variable a set, but not used")
+ (lint-test "(let ((a 1)) #f)" " let: perhaps (let ((a 1)) #f) -> #f let: let variable a not used")
+ (lint-test "(let ((x 1) (y 2)) (+ x y))" " let: perhaps (let ((x 1) (y 2)) (+ x y)) -> 3")
+ (lint-test "(let :x ((i y)) (x i))" " let: bad let name: :x")
+ (lint-test "(let xx () z)" " let: perhaps (let xx () z) -> z let: let variable xx not used")
+
+ (lint-test "(eq? x 1.5)" " eq?: eq? should be eqv? in (eq? x 1.5)")
+ (lint-test "(eq? 3 x)" " eq?: eq? should be eqv? in (eq? 3 x)")
+ (lint-test "(eq? x (not x))" " eq?: this looks odd: (eq? x (not x))")
+ (lint-test "(eq? #(0) #(0))" " eq?: this looks odd: (eq? #(0) #(0)) eq?: eq? should be equal? in (eq? #(0) #(0))")
+ (lint-test "(eq? #() ())" " eq?: eq? should be equal? in (eq? #() ())")
+ (lint-test "(eq? (symbol->string x) z)" " eq?: eq? should be equal? in (eq? (symbol->string x) z)")
+ (lint-test "(eq? (symbol? x) #t)" " eq?: perhaps (eq? (symbol? x) #t) -> (symbol? x)")
+ (lint-test "(eq? (symbol? x) #f)" " eq?: perhaps (eq? (symbol? x) #f) -> (not (symbol? x))")
+ (lint-test "(eq? x '())" " eq?: perhaps (eq? x '()) -> (null? x) eq?: quote is not needed here: '()")
+ (lint-test "(eq? x '#\\a)" " eq?: eq? should be eqv? in (eq? x '#\\a)")
+ (lint-test "(eqv? x ())" " eqv?: eqv? could be null?: (eqv? x ()) -> (null? x)")
+ (lint-test "(eqv? x '())" " eqv?: eqv? could be null?: (eqv? x '()) -> (null? x) eqv?: quote is not needed here: '()")
+ (lint-test "(eqv? x #(0))" " eqv?: eqv? should be equal? in (eqv? x #(0))")
+ (lint-test "(eqv? x 'a)" " eqv?: eqv? could be eq? in (eqv? x 'a)")
+ (lint-test "(eqv? x #f)" " eqv?: eqv? could be not: (eqv? x #f) -> (not x)")
+ (lint-test "(equal? x 'a)" " equal?: equal? could be eq? in (equal? x 'a)")
+ (lint-test "(equal? x (integer->char 96))" " equal?: equal? could be eqv? in (equal? x (integer->char 96))")
+ (lint-test "(equal? x #f)" " equal?: equal? could be not: (equal? x #f) -> (not x)")
+ (lint-test "(equal? x ())" " equal?: equal? could be null?: (equal? x ()) -> (null? x)")
+ (lint-test "(equal? x '())" " equal?: equal? could be null?: (equal? x '()) -> (null? x) equal?: quote is not needed here: '()")
+ (lint-test "(equal? (expt x y) z)" " equal?: equal? could be eqv? in (equal? (expt x y) z)")
+ (lint-test "(morally-equal? x 'a)" " morally-equal?: morally-equal? could be eq? in (morally-equal? x 'a)")
+ (lint-test "(morally-equal? x 0)" " morally-equal?: morally-equal? could be eqv? in (morally-equal? x 0)")
+ (lint-test "(morally-equal? x 0.0)" "")
+
+ (lint-test "(map abs '(1 2) '(3 4))" " map: map has too many arguments in: (map abs '(1 2) '(3 4))")
+ (lint-test "(map (lambda (a b) a) '(1 2))" " map: map has too few arguments in: (map (lambda (a b) a) '(1 2))")
+ (lint-test "(map (lambda (a) (abs a)) '(1 2 3))" " map: perhaps (lambda (a) (abs a)) -> abs")
+ (lint-test "(map abs (vector->list #(1 2)))" " map: (vector->list #(1 2)) could be simplified to: #(1 2) ; (map accepts non-list sequences)")
+ (lint-test "(begin (map g123 x) x)" " begin: map could be for-each: (map g123 x)")
+ (lint-test "(map log x x)" "")
+ (lint-test "(catch #(0) (lambda () #f) (lambda a a))" " catch: catch tag #(0) is unreliable (catch uses eq? to match tags)")
+ (lint-test "(catch 'hi x y)" "")
+ (lint-test "(car #(0))" " car: car's argument should be a pair?: #(0): (car #(0))")
+ (lint-test "(vector->list 1.4)" " vector->list: vector->list's argument should be a vector?: 1.4: (vector->list 1.4)")
+ (lint-test "(vector-set! #(0 1) 0 2)" " vector-set!: perhaps (vector-set! #(0 1) 0 2) -> 2")
+
+ (lint-test "(defmacro hi ())" " defmacro: defmacro declaration is messed up: (defmacro hi ())")
+ (lint-test "(defmacro hi (a b a) a)" " defmacro: defmacro parameter is repeated: (a b a)")
+ (lint-test "(define)" " define: (define) makes no sense")
+ (lint-test "(define a)" " define: (define a) has no value?")
+ (lint-test "(define a . b)" " define: (define a . b) makes no sense")
+ (lint-test "(define a b c)" " define: (define a b c) has too many values?")
+ (lint-test "(define a a)" " define: this define is either not needed, or is an error: (define a a)")
+ (lint-test "(define #(0) 2)" " define: strange form: (define #(0) 2)")
+ (lint-test "(define (f1 a) (abs a))" " f1: f1 could be (define f1 abs)")
+ (lint-test "(define (f1 a b) \"a docstring\" (log a b))" " f1: f1 could be (define f1 log)")
+ (lint-test "(lambda ())" " lambda: lambda is messed up in (lambda ())")
+ (lint-test "(lambda (a b a) a)" " lambda: lambda parameter is repeated: (a b a)")
+ (lint-test "((lambda () 32) 0)" " (lambda () 32): lambda has too many arguments: ((lambda () 32) 0)")
+ (lint-test "((lambda (a b) (+ a b)) 1)" " (lambda (a b) (+ a b)): lambda has too few arguments: ((lambda (a b) (+ a b)) 1) (lambda (a b) (+ a b)): perhaps (lambda (a b) (+ a b)) -> +")
+ (lint-test "(lambda* (:key a :optional b :rest c :allow-other-keys) a)"
+ " lambda*: :optional and key are no longer accepted: (:key a :optional b :rest c :allow-other-keys)")
+ (lint-test "(lambda* (a :rest) a)" " lambda*: :rest parameter needs a name: (a :rest)")
+ (lint-test "(lambda* (a :allow-other-keys b) a)" " lambda*: :allow-other-keys should be at the end of the parameter list:(a :allow-other-keys b)")
+ (lint-test "(lambda (a :b c) a)" " lambda: lambda arglist can't handle keywords (use lambda*)")
+ (lint-test "(lambda (a b) (>= b a))" " lambda: perhaps (lambda (a b) (>= b a)) -> <=")
+ (lint-test "(lambda (a b c) (/ a b c))" " lambda: perhaps (lambda (a b c) (/ a b c)) -> /")
+
+ (lint-test "(+ . 1)" " +: unexpected dot: (+ . 1)")
+ (lint-test "(length (a . b))" " length: missing quote? (a . b) in (length (a . b))")
+ (lint-test "(length ,a)" " length: stray comma? (unquote a) in (length (unquote a))")
+
+ (lint-test "(let () (define (f1 a) a) (f1 2 3))" " let: f1 has too many arguments: (f1 2 3)")
+ (lint-test "(let () (define-macro (f1 a) a) (f1 2 3))" " let: f1 has too many arguments: (f1 2 3)")
+ (lint-test "(set! a b c)" " set!: set! has too many arguments: (set! a b c)")
+ (lint-test "(set! a)" " set!: set! has too few arguments: (set! a)")
+ (lint-test "(set! (vector-ref v 0) 3)" " set!: vector-ref as target of set! (set! (vector-ref v 0) 3)")
+ (lint-test "(set! pi 3)" " set!: can't set! (set! pi 3) (it is a constant)")
+ (lint-test "(set! 3 1)" " set!: can't set! (set! 3 1)")
+ (lint-test "(set! a a)" " set!: pointless set! (set! a a)")
+ (lint-test "(begin (set! x (cons 1 z)) (set! x (cons 2 x)))" " begin: perhaps (set! x (cons 1 z)) (set! x (cons 2 x)) -> (set! x (cons 2 (cons 1 z)))")
+ (lint-test "(begin (set! x 0) (set! x 1))" " begin: this could be omitted: (set! x 0)")
+ (lint-test "(quote 3)" " quote: quote is not needed here: '3")
+ (lint-test "(quote . 3)" " quote: stray dot in quote's arguments? (quote . 3)")
+ (lint-test "(quote 3 4)" " quote: quote has too many arguments: (quote 3 4)")
+ (lint-test "'#(0)" " quote: quote is not needed here: '#(0)")
+
+ (lint-test "(cond . 1)" " cond: cond is messed up: (cond . 1)")
+ (lint-test "(cond 1)" " cond: cond clause is messed up: 1")
+ (lint-test "(cond ((< 3 1) 2))" " cond: cond test is never true: (cond ((< 3 1) 2)) cond: cond test is always false: ((< 3 1) 2)")
+ (lint-test "(cond (else 2) (x 3))" " cond: cond else clause is not the last: (cond (else 2) (x 3))")
+ (lint-test "(cond (x => abs))" "")
+ (lint-test "(cond (x =>))" " cond: cond => target is messed up: (x =>)")
+ (lint-test "(cond (x #f) (#t #t))" " cond: perhaps (cond (x #f) (#t #t)) -> (not x)")
+ (lint-test "(cond (x #t) (else #f))" " cond: perhaps (cond (x #t) (else #f)) -> x")
+ (lint-test "(cond ((= x 1) 2) (else 2))" " cond: perhaps (cond ((= x 1) 2) (else 2)) -> 2")
+ (lint-test "(cond ((and (display x) x) 32) (#t 32))" "")
+ (lint-test "(cond (x y) (z 32) (else 32))" " cond: this clause could be omitted: (z 32)")
+ (lint-test "(cond ((= x 1) (display \"a\") 32) (#t (display \"a\") 32))"
+ " cond: perhaps (cond ((= x 1) (display \"a\") 32) (#t (display \"a\") 32)) -> (begin (display \"a\") 32)")
+ (lint-test "(cond ((= x 1) 32))" "")
+ (lint-test "(cond ((and (display 32) (= x 1)) 1) (#t 1))" "")
+ (lint-test "(cond ((< x 1) 2) (else (cond ((< y 3) 2) (#t 4))))"
+ " cond: else clause cond could be folded into the outer cond: (else (cond ((< y 3) 2) (#t 4)))")
+ (lint-test "(cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5))"
+ " cond: cond test is never true: (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5)) cond: cond test repeated: ((< x 2) 5) cond: cond test is always false: ((< x 2) 5)")
+ (lint-test "(cond ((< x 1) (+ x 1)) ((> x 1) (+ x 1)) (#t 2))"
+ " cond: perhaps (cond ((< x 1) (+ x 1)) ((> x 1) (+ x 1)) (#t 2)) -> (cond ((or (< x 1) (> x 1)) (+ x 1)) (#t 2))")
+ (lint-test "(cond ((= x 3) 4) ((= x 2) 4) ((= x 1) 4) (else 5))"
+ " cond: perhaps (cond ((= x 3) 4) ((= x 2) 4) ((= x 1) 4) (else 5)) -> (cond ((memv x '(3 2 1)) 4) (else 5))")
+ (lint-test "(cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4) (else 5))"
+ " cond: perhaps (cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4) (else 5)) -> (cond ((= x 3) 3) ((memv x '(2 1)) 4) (else 5))")
+ (lint-test "(cond (a) (b) (c))" " cond: perhaps (cond (a) (b) (c)) -> (cond ((or a b c)))")
+ (lint-test "(cond ((= x 0) x) ((= x 1) (= x 1)))" " cond: no need to repeat the test: ((= x 1) (= x 1)) -> ((= x 1))")
+ (lint-test "(cond (x => expt))" " cond: => target (expt) may be unhappy: (x => expt)")
+ (lint-test "(cond (x (abs x)))" " cond: perhaps use => here: (x (abs x)) -> (x => abs)")
+
+ (lint-test "(cond (x (let ((z w)) (+ x z)) y) (else 2))" " cond: this could be omitted: (let ((z w)) (+ x z))")
+ (lint-test "(cond (x (if x y z) (+ x 1)) (z 2))" " cond: this could be omitted: (if x y z)")
+
+ (lint-test "(let () (when a (+ x 1)) y)" " let: this could be omitted: (when a (+ x 1))")
+ (lint-test "(let () (unless a (+ x 1)) y)" " let: this could be omitted: (unless a (+ x 1))")
+ (lint-test "(let () (cond ((< x y) 3) ((< y z) 4)) (+ x 1))" " let: this could be omitted: (cond ((< x y) 3) ((< y z) 4))")
+ (lint-test "(let () (case x ((0) 1) (else 2)) x)" " let: this could be omitted: (case x ((0) 1) (else 2))")
+ (lint-test "(begin (let ((a (+ x 1)) (b 2)) (+ a b)) 32)" " begin: this could be omitted: (let ((a (+ x 1)) (b 2)) (+ a b))")
+ (lint-test "(begin (if x y z) a)" " begin: this could be omitted: (if x y z)")
+ (lint-test "(lambda (a) (if x y z) a)" " lambda: this could be omitted: (if x y z)")
+ (lint-test "(lambda (a) (case x ((0) 1) (else x)) a)" " lambda: this could be omitted: (case x ((0) 1) (else x))")
+ (lint-test "(let () (do ((i 0 (+ i 1))) ((= i 1))) x)"
+ " let: this could be omitted: (do ((i 0 (+ i 1))) ((= i 1))) let: this do-loop could be replaced by (): (do ((i 0 (+ i 1))) ((= i 1)))")
+
+ (lint-test "(case 3)" " case: case is messed up: (case 3)")
+ (lint-test "(case 3 ((0) #t))" " case: case selector is a constant: (case 3 ((0) #t))")
+ (lint-test "(case (list 1) ((0) #t))" " case: case selector may not work with eqv: (list 1) case: case key 0 in ((0) #t) is pointless")
+ (lint-test "(case x (0))" " case: clause result is missing: (0) case: bad case key 0 in (0)")
+ (lint-test "(case x ((0)))" " case: clause result is missing: ((0))")
+ (lint-test "(case x ((0) 1) ((1) 2) ((3 0) 4))" " case: repeated case key 0 in ((3 0) 4)")
+ (lint-test "(case x ((0) 1) ((1) 2) ((3 . 0) 4))" " case: stray dot in case case key list: ((3 . 0) 4)")
+ (lint-test "(case x ((#(0)) 2))" " case: case key #(0) in ((#(0)) 2) is unlikely to work (case uses eqv?)")
+ (lint-test "(case x (else 2) ((0) 1))" " case: case else clause is not the last: ((else 2) ((0) 1))")
+ (lint-test "(case x ((0) 32) (else 32))" " case: perhaps (case x ((0) 32) (else 32)) -> 32")
+ (lint-test "(case (string->symbol x) ((a) 1) ((2 3) 3))" " case: case key 2 in ((2 3) 3) is pointless case: case key 3 in ((2 3) 3) is pointless")
+ (lint-test "(case c ((a) b) (else (begin (display d) e)))" " case: redundant begin: (begin (display d) e)")
+
+ (lint-test "(case x ((0) 32) ((1) 32))" " case: perhaps (case x ((0) 32) ((1) 32)) -> (case x ((0 1) 32))")
+ (lint-test "(case x ((0) 32) (else (case x ((1) 32))))" " case: perhaps (case x ((0) 32) (else (case x ((1) 32)))) -> (case x ((0 1) 32))")
+ (lint-test "(case x ((0) 32) (else (case x ((1) 32)) x))" " case: this could be omitted: (case x ((1) 32))")
+ (lint-test "(case x ((0) (display 1) 2) (else (display 1) 2))"
+ " case: perhaps (case x ((0) (display 1) 2) (else (display 1) 2)) -> (begin (display 1) 2)")
+ (lint-test "(case x (else (case x ((0) 1))))" " case: perhaps (case x (else (case x ((0) 1)))) -> (case x ((0) 1))")
+ (lint-test "(case x (else (case x (else 1))))" " case: perhaps (case x (else 1)) -> 1 case: perhaps (case x (else (case x (else 1)))) -> 1")
+ (lint-test "(case x ((0) 1) ((1 2) 1))" " case: perhaps (case x ((0) 1) ((1 2) 1)) -> (case x ((0 1 2) 1))")
+ (lint-test "(case x ((0 1) (abs x)))" " case: perhaps use => here: ((0 1) (abs x)) -> ((0 1) => abs)")
+ (lint-test "(case x ((a b a) 1) ((c) 2))" " case: repeated case key a in ((a b a) 1)")
+
+ (lint-test "(do ())" " do: do is messed up: (do ())")
+ (lint-test "(do () ())" " do: this do-loop could be replaced by (): (do () ())")
+ (lint-test "(do ((x 2) y) ())" " do: do binding is not a list? y do: do variable x not used")
+ (lint-test "(do ((x 2 1)) () x)" " do: this do-loop could be replaced by (): (do ((x 2 1)) () x) do: this could be omitted: x")
+ (lint-test "(do ((x 2 1)) () (display 1))" " do: do variable x not used")
+ (lint-test "(do ((i 0 (+ i 1))) ((+ i 10) i))" " do: end test is never false: (+ i 10)")
+ (lint-test "(do ((i 0 (+ i 1))) (#f i))" " do: result is unreachable: (#f i)")
+ (lint-test "(do ((i 0 (+ i 0))) ((= i 10) i))" " do: perhaps (+ i 0) -> i")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i len)) (string-set! s i #\\a))"
+ " do: perhaps (do ((i 0 (+ i 1))) ((= i len)) (string-set! s i #\\a)) -> (fill! s #\\a 0 len)")
+ (lint-test "(do ((i 0 (+ i 1))) ((= i len)) (vector-set! v0 i (vector-ref v1 i)))"
+ " do: perhaps (do ((i 0 (+ i 1))) ((= i len)) (vector-set! v0 i (vector-ref v1 i))) -> (copy v1 v0 0 len)")
+ (lint-test "(do ((i 0 (+ 1 1))) ((= i 3) z))" " do: perhaps (+ 1 1) -> 2")
+ (lint-test "(do ((x lst (cdr lst))) ((null? x) y))" " do: this looks suspicious: (x lst (cdr lst))")
+ (lint-test "(do ((i 0 (+ i 1))) ((>= i len)) (display i))" "")
+ (lint-test "(do ((i 0 (+ i 1))) ((< i len)) (display i))" " do: do step looks like it doesn't match end test: (+ i 1) -> (< i len)")
+ (lint-test "(do ((i 0 (- i 1))) ((<= i len)) (display i))" "")
+ (lint-test "(do ((i 0 (- i 1))) ((> i len)) (display i))" " do: do step looks like it doesn't match end test: (- i 1) -> (> i len)")
+ (lint-test "(do ((i 0 (+ i 1))) (= i 10) (display i))" " do: this could be omitted: (= i 10) do: perhaps missing parens: (= i 10)")
+ (lint-test "(do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 10)) (display i))" " do: do variable j not used")
+ (lint-test "(do ((i 0 (+ i j)) (j 0 (+ j 1))) ((= i 10)) (display i))" "") ; displays 00136
+ (lint-test "(do ((i 0 j) (j 0 (+ j 1))) (display i))" "")
+ (lint-test "(do ((i 0 (display i))) ((x y) z))" "")
+
+ ;(lint-test "(byte-vector 3213)" " byte-vector: byte-vector's argument should be a byte?: 3213: (byte-vector 3213)")
+ (lint-test "(let ())" " let: let is messed up: (let ())")
+ (lint-test "(let ((x (lambda (a) (x 1)))) x)"
+ " let: let variable x is called in its binding? Perhaps let should be letrec: ((x (lambda (a) (x 1))))")
+ (lint-test "(let* ((x 1)) x)" " let*: let* could be let: (let* ((x 1)) x)")
+ (lint-test "(let* ((x 1) (x x)) x)" " let*: let* variable x is declared twice")
+ (lint-test "(let* ((x (g g0)) (y (g g0))) (+ x y))" "")
+ (lint-test "(let* ((x 0) (y (g 0))) (+ x y))" "") ; no telling what g is or does
+ (lint-test "(let () (define x 3) (define (y a) a) (g z))" " let: let variables y, x not used")
+ (lint-test "(letrec () 1)" " letrec: letrec could be let: (letrec () 1)")
+ (lint-test "(letrec* ((a (lambda b (a 1)))) a)" " letrec*: letrec* could be letrec? (letrec* ((a (lambda b (a 1)))) a)")
+ (lint-test "(begin . 1)" " begin: stray dot in begin? (begin . 1)")
+ (lint-test "(begin (map abs x) #f)" " begin: map could be for-each: (map abs x) begin: this could be omitted: (map abs x)")
+ (lint-test "(begin 1 #f)" " begin: this could be omitted: 1")
+ (lint-test "(begin (+ x y) 3)" " begin: this could be omitted: (+ x y)")
+ (lint-test "(begin (display 1) (begin #f))" " begin: redundant begin: (begin #f) begin: begin could be omitted: (begin #f)")
+ (lint-test "(let () (display 1) (begin (display 1) #f))" " let: redundant begin: (begin (display 1) #f)")
+ (lint-test "(if (< x 1) (begin x) y)" " if: begin could be omitted: (begin x)")
+ (lint-test "(if (< x 1) (begin (display 1) x) y)" "")
+
+ (lint-test "(format)" " format: format needs at least 1 argument: (format) format: format has too few arguments: (format)")
+ (lint-test "(format (format #f str))" " format: redundant format: (format (format #f str))")
+ (lint-test "(format #f \"~H\" 1)" " format: unrecognized format directive: H in \"~H\", (format #f \"~H\" 1)")
+ (lint-test "(format #f \"~^\")" " format: ~^ has ^ outside ~{~}?")
+ (lint-test "(format #f \"~A\")" " format: format has too few arguments: (format #f \"~A\")")
+ (lint-test "(format #f \"~A\" 1 2)" " format: format has too many arguments: (format #f \"~A\" 1 2)")
+ (lint-test "(format #f \"asdf~\")" " format: format control string ends in tilde: (format #f \"asdf~\")")
+ (lint-test "(format #f \"~{~A\" 1)" " format: format has 1 unmatched {: (format #f \"~{~A\" 1)")
+ (lint-test "(format #f \"123\")" " format: (format #f \"123\") could be \"123\", (format is a no-op here)")
+ (lint-test "(format #f \"~nD\" 1 2)" "")
+ (lint-test "(format #f \"~n,nD\" 1 2 3)" "")
+ (lint-test "(format #f \"~nT\" 1 2)" " format: format has too many arguments: (format #f \"~nT\" 1 2)")
+ (lint-test "(format #f \"~nD\" 1)" " format: format has too few arguments: (format #f \"~nD\" 1)")
+ (lint-test "(format 1)" " format: format with one argument takes a string: (format 1)")
+ (lint-test "(format #f \"~NC ~W\" 1 #\\c 2)" "")
+
+ (lint-test "(open-output-file x \"fb+\")" " open-output-file: unexpected mode: (open-output-file x \"fb+\")")
+ (lint-test "(vector 1 2 . 3)" " vector: unexpected dot: (vector 1 2 . 3)")
+
+ (lint-test "(begin (display x) (newline) (display y) (newline))"
+ " begin: perhaps ((display x) (newline) (display y) (newline)) -> (format () \"~A~%~A~%\" x y)")
+ (lint-test "(begin (display x) (newline) (display y) (newline) 32)"
+ " begin: perhaps ((display x) (newline) (display y) (newline)) -> (format () \"~A~%~A~%\" x y)")
+ (lint-test "(begin (write x p) (newline p) (write-char #\\a p) (write-string \"bc\" p))"
+ " begin: perhaps ((write x p) (newline p) (write-char #\\a p) (write-string \"bc\" p)) -> (format p \"~S~%abc\" x)")
+ (lint-test "(begin (newline) (set! x 1) (display x) (newline) (newline))"
+ " begin: perhaps ((display x) (newline) (newline)) -> (format () \"~A~%~%\" x)")
+ (lint-test "(begin (write-string x p y z) (write-string \"1234\" p 1) (write-string \"5678\" p 2 3) (write-string \"abc\" p 2 z))"
+ " begin: perhaps ((write-string x p y z) (write-string \"1234\" p 1) (write-string \"5678\" p 2 3) (write-string \"abc\" p 2 z)) -> (format p \"~A2347~A\" (substring x y z) (substring \"abc\" 2 z))")
+
+ (lint-test "(substring x 0)" " substring: perhaps clearer: (substring x 0) -> (copy x)")
+ (lint-test "(substring (substring x 1) 2)" " substring: perhaps (substring (substring x 1) 2) -> (substring x 3)")
+ (lint-test "(list-tail x 0)" " list-tail: perhaps (list-tail x 0) -> x")
+ (lint-test "(list-tail (list-tail x 1) 2)" " list-tail: perhaps (list-tail (list-tail x 1) 2) -> (list-tail x 3)")
+ (lint-test "(list-tail (list-tail x y) z)" " list-tail: perhaps (list-tail (list-tail x y) z) -> (list-tail x (+ y z))")
+
+ (lint-test "(unless x)" " unless: unless is messed up: (unless x)")
+ (lint-test "(unless (abs x) #f)" " unless: unless test is never false: (unless (abs x) #f)")
+ (lint-test "(with-let x)" " with-let: with-let is messed up: (with-let x)")
+ (lint-test "(with-let (curlet) x)" " with-let: with-let is not needed here: (with-let (curlet) x)")
+ (lint-test "(object->string x y)" "")
+
+ (lint-test "(or)" " or: perhaps (or) -> #f")
+ (lint-test "(or x)" " or: perhaps (or x) -> x")
+ (lint-test "(or 'a)" " or: perhaps (or 'a) -> 'a")
+ (lint-test "(or 'a 'b)" " or: perhaps (or 'a 'b) -> 'a")
+ (lint-test "(or x x)" " or: perhaps (or x x) -> x")
+ (lint-test "(or x x y)" " or: perhaps (or x x y) -> (or x y)")
+ (lint-test "(or 1 x)" " or: perhaps (or 1 x) -> 1")
+ (lint-test "(or (or y) x)" " or: perhaps (or (or y) x) -> (or y x)")
+ (lint-test "(or (or y x) x)" " or: perhaps (or (or y x) x) -> (or y x)")
+ (lint-test "(or x (not x))" " or: perhaps (or x (not x)) -> (or x #t)")
+ (lint-test "(or (> x 1) (not (> x 1)))" " or: perhaps (or (> x 1) (not (> x 1))) -> (or (> x 1) #t)")
+ (lint-test "(or x (and x y))" " or: perhaps (or x (and x y)) -> x")
+ (lint-test "(or x #f y)" " or: perhaps (or x #f y) -> (or x y)")
+ (lint-test "(or x #f)" " or: perhaps (or x #f) -> x")
+ (lint-test "(or x (not (and x y)))" " or: perhaps (or x (not (and x y))) -> (or x #t)")
+ (lint-test "(or (pair? x) (list? x))" " or: perhaps (or (pair? x) (list? x)) -> (list? x)")
+ (lint-test "(or (number? x) (rational? x))" " or: perhaps (or (number? x) (rational? x)) -> (number? x)")
+ (lint-test "(or (pair? x) (null? x))" "")
+ (lint-test "(or (list? x) (list? x))" " or: perhaps (or (list? x) (list? x)) -> (list? x)")
+ (lint-test "(or #f (= x 1))" " or: perhaps (or #f (= x 1)) -> (= x 1)")
+ (lint-test "(or (integer? (cadr x)) (number? (cadr x)))" " or: perhaps (or (integer? (cadr x)) (number? (cadr x))) -> (number? (cadr x))")
+ (lint-test "(or (eq? x 'a) (eq? x 'b) (eq? x 'c))" " or: perhaps (or (eq? x 'a) (eq? x 'b) (eq? x 'c)) -> (memq x '(a b c))")
+ (lint-test "(or (= x 1) (= x 2) (= x 3))" " or: perhaps (or (= x 1) (= x 2) (= x 3)) -> (memv x '(1 2 3))")
+ (lint-test "(or (equal? x #()) (equal? x #(1)))" " or: perhaps (or (equal? x #()) (equal? x #(1))) -> (member x '(#() #(1)))")
+ (lint-test "(or (string=? x \"a\") (string=? x \"b\"))" " or: perhaps (or (string=? x \"a\") (string=? x \"b\")) -> (member x '(\"a\" \"b\") string=?)")
+ (lint-test "(or (char=? (cadr x) #\\a) (char=? (cadr x) #\\b))" " or: perhaps (or (char=? (cadr x) #\\a) (char=? (cadr x) #\\b)) -> (memv (cadr x) '(#\\a #\\b))")
+ (lint-test "(or (= (let ((z 1)) (display z) z) 1) (= (let ((z 1)) (display z) z) 2))" "")
+ (lint-test "(or (not (null? x)) (not (pair? x)))" " or: perhaps (or (not (null? x)) (not (pair? x))) -> #t")
+ (lint-test "(or (not (= x 1)) (not (= y 1)))" " or: perhaps (or (not (= x 1)) (not (= y 1))) -> (not (= x 1 y))")
+ (lint-test "(or (char=? x #\\a) (char=? x #\\A))" " or: perhaps (or (char=? x #\\a) (char=? x #\\A)) -> (char-ci=? x #\\a)")
+ (lint-test "(or (string=? x \"a\") (string=? x \"A\"))" " or: perhaps (or (string=? x \"a\") (string=? x \"A\")) -> (string-ci=? x \"a\")")
+
+ (lint-test "(and)" " and: perhaps (and) -> #t")
+ (lint-test "(and x)" " and: perhaps (and x) -> x")
+ (lint-test "(and x #t)" "")
+ (lint-test "(and x (not x))" " and: perhaps (and x (not x)) -> #f")
+ (lint-test "(and x (and x y))" " and: perhaps (and x (and x y)) -> (and x y)")
+ (lint-test "(and x (or x y))" " and: perhaps (and x (or x y)) -> x")
+ (lint-test "(and (number? x) (pair? x))" " and: perhaps (and (number? x) (pair? x)) -> #f")
+ (lint-test "(not (> x 1))" " not: perhaps (not (> x 1)) -> (<= x 1)")
+ (lint-test "(not (exact? x))" " not: perhaps (not (exact? x)) -> (inexact? x)")
+ (lint-test "(not (not x))" " not: perhaps (not (not x)) -> x")
+ (lint-test "(not (zero? (logand x (ash 1 z))))" " not: perhaps (not (zero? (logand x (ash 1 z)))) -> (logbit? x z)")
+ (lint-test "(not x y)" " not: not has too many arguments: (not x y) not: perhaps (not x y) -> (not)")
+ (lint-test "(and x (or y 123) z)" " and: perhaps (and x (or y 123) z) -> (and x z)")
+ (lint-test "(and (pair? x) (list? x))" " and: perhaps (and (pair? x) (list? x)) -> (pair? x)")
+ (lint-test "(and (number? x) (rational? x))" " and: perhaps (and (number? x) (rational? x)) -> (rational? x)")
+ (lint-test "(and (pair? x) (null? x))" " and: perhaps (and (pair? x) (null? x)) -> #f")
+ (lint-test "(and (list? x) (list? x))" " and: perhaps (and (list? x) (list? x)) -> (list? x)")
+ (lint-test "(and 3.1 #f (= x 1))" " and: perhaps (and 3.1 #f (= x 1)) -> #f")
+ (lint-test "(and 3.1 #t (= x 1))" " and: perhaps (and 3.1 #t (= x 1)) -> (= x 1)")
+ (lint-test "(and (number? (cadr x)) (integer? (cadr x)))" " and: perhaps (and (number? (cadr x)) (integer? (cadr x))) -> (integer? (cadr x))")
+ (lint-test "(and x y x)" "")
+ (lint-test "(and x y y)" " and: perhaps (and x y y) -> (and x y)")
+ (lint-test "(and x y x y)" " and: perhaps (and x y x y) -> (and x y)")
+ (lint-test "(and x #f y)" " and: perhaps (and x #f y) -> #f")
+ (lint-test "(and x y #t z)" " and: perhaps (and x y #t z) -> (and x y z)")
+ (lint-test "(and (g x) (g y) (g x))" "")
+ (lint-test "(and (cadr x) (car y) (cadr x))" "")
+ (lint-test "(and (cadr x) (car y) (cadr x) (car y))" " and: perhaps (and (cadr x) (car y) (cadr x) (car y)) -> (and (cadr x) (car y))")
+ (lint-test "(and (g x) #f (g y))" " and: perhaps (and (g x) #f (g y)) -> (and (g x) #f)")
+ (lint-test "(and x (or y 123 z))" " and: perhaps (and x (or y 123 z)) -> (and x (or y 123))")
+ (lint-test "(and x (or y 123 z) w)" " and: perhaps (and x (or y 123 z) w) -> (and x w)")
+ (lint-test "(and x (or (g y) z) w)" "")
+ (lint-test "(and (integer? x) (number? x))" " and: perhaps (and (integer? x) (number? x)) -> (integer? x)")
+ (lint-test "(and x y #t)" "")
+ (lint-test "(and x y (integer? 1))" " and: perhaps (and x y (integer? 1)) -> (and x y #t)")
+ (lint-test "(and x (or x y))" " and: perhaps (and x (or x y)) -> x")
+ (lint-test "(and x (or x))" " and: perhaps (and x (or x)) -> x")
+ (lint-test "(and (cadr x) (cadr x))" " and: perhaps (and (cadr x) (cadr x)) -> (cadr x)")
+ (lint-test "(and (< x y) (< y z))" " and: perhaps (and (< x y) (< y z)) -> (< x y z)")
+ (lint-test "(and (>= x y) (>= z x))" " and: perhaps (and (>= x y) (>= z x)) -> (>= z x y)")
+ (lint-test "(and (>= x y) (>= x z))" "")
+ (lint-test "(and (= x y) (= x z))" " and: perhaps (and (= x y) (= x z)) -> (= x y z)")
+ (lint-test "(and (< x y) (> z y))" " and: perhaps (and (< x y) (> z y)) -> (< x y z)")
+ (lint-test "(and (< x y) (< y (let ((z 1)) (display z) z)))" "")
+ (lint-test "(and (pair? x) (null? x))" " and: perhaps (and (pair? x) (null? x)) -> #f")
+
+ (lint-test "(car (car x))" " car: perhaps (car (car x)) -> (caar x)")
+ (lint-test "(cdr (cadr x))" " cdr: perhaps (cdr (cadr x)) -> (cdadr x)")
+ (lint-test "(car (car (cdr x)))" " car: perhaps (car (car (cdr x))) -> (caadr x)")
+ (lint-test "(car (car (cdr (cdr x))))" " car: perhaps (car (car (cdr (cdr x)))) -> (caaddr x)")
+ (lint-test "(car (cadr (cdr x)))" " car: perhaps (car (cadr (cdr x))) -> (caaddr x)")
+ (lint-test "(cddar (car x))" " cddar: perhaps (cddar (car x)) -> (cddaar x)")
+ (lint-test "(cadr (car (cdr x)))" " cadr: perhaps (cadr (car (cdr x))) -> (cadadr x)")
+ (lint-test "(cddddr (cddr x))" " cddddr: perhaps (cddddr (cddr x)) -> (list-tail x 6)")
+ (lint-test "(car (cddddr (cddr x)))" " car: perhaps (car (cddddr (cddr x))) -> (list-ref x 6)")
+ (lint-test "(cadr (cddr (cdddr x)))" " cadr: perhaps (cadr (cddr (cdddr x))) -> (list-ref x 6)")
+ (lint-test "(cadr (cddr (cdddr (cdr x))))" " cadr: perhaps (cadr (cddr (cdddr (cdr x)))) -> (list-ref x 7)")
+ (lint-test "(cddddr (cdddr (cddddr x)))" " cddddr: perhaps (cddddr (cdddr (cddddr x))) -> (list-tail x 11)")
+
+ (lint-test "(let ((x 3) (y 5)) (set! x (+ x y)) (+ x y))" " let: this could be omitted: (+ x y)")
+ (lint-test "(let ((x 3)) (set! x (+ x 1)) x)" " let: this could be omitted: x")
+ (lint-test "(begin (vector-set! x 0 32) (vector-ref x 0))" " begin: this could be omitted: (vector-ref x 0)")
+ (lint-test "(begin (list-set! x (* y 2) 32) (list-ref x (* y 2)))" " begin: this could be omitted: (list-ref x (* y 2))")
+ (lint-test "(let () (vector-set! x 0 32) (vector-ref x 0))" " let: this could be omitted: (vector-ref x 0)")
+ (lint-test "(let () (list-set! x (* y 2) 32) (list-ref x (* y 2)))" " let: this could be omitted: (list-ref x (* y 2))")
+ (lint-test "(begin (z 1) (do ((i 0 (+ i 1))) ((= i n) 32)))" " begin: this do-loop could be replaced by 32: (do ((i 0 (+ i 1))) ((= i n) 32))")
+ (lint-test "(vector-set! v i (vector-ref v i))" " vector-set!: redundant?: (vector-set! v i (vector-ref v i))")
+ (lint-test "(list-set! v (+ i 1) (list-ref v (+ i 1)))" " list-set!: redundant?: (list-set! v (+ i 1) (list-ref v (+ i 1)))")
+ (lint-test "(abs () ())" " abs: abs has too many arguments: (abs () ()) abs: abs's argument 1 should be a real?: (): (abs () ())")
+ (lint-test "(vector-ref (vector-ref x 0) y)" " vector-ref: perhaps (vector-ref (vector-ref x 0) y) -> (x 0 y)")
+ (lint-test "(list-ref (list-ref (list-ref (cadr x) (+ y 1)) (+ y 2)) (+ y 3))"
+ " list-ref: perhaps (list-ref (list-ref (list-ref (cadr x) (+ y 1)) (+ y 2)) (+ y 3)) -> ((cadr x) (+ y 1) (+ y 2) (+ y 3))")
+ (if (not pure-s7) (lint-test "(current-output-port 123)" " current-output-port: too many arguments: (current-output-port 123)"))
+ (lint-test "(copy (owlet))" " copy: (copy (owlet)) could be (owlet): owlet is copied internally")
+ (lint-test "(gcd x '(asd))" " gcd: gcd's argument 2 should be a rational?: '(asd): (gcd x '(asd))")
+ (lint-test "(string #\\null)" "")
+ (lint-test "(string (char->integer x))" " string: string's argument should be a char?: (char->integer x): (string (char->integer x))")
+ (lint-test "(close-output-port 022120)" " close-output-port: close-output-port's argument should be a output-port?: 22120: (close-output-port 22120)")
+ (lint-test "(close-input-port (log 32))" " close-input-port: close-input-port's argument should be an input-port?: (log 32): (close-input-port (log 32))")
+ (lint-test "(call-with-exit (lambda (p) (+ x 1)))" " call-with-exit: exit-function appears to be unused: (call-with-exit (lambda (p) (+ x 1)))")
+ (lint-test "(call-with-output-file file (lambda (p) (+ x 1)))" " call-with-output-file: port appears to be unused: (call-with-output-file file (lambda (p) (+ x 1)))")
+
+ (lint-test "(quasiquote 1 2)" " quasiquote: quasiquote has too many arguments: (quasiquote 1 2)")
+ (lint-test "(apply + 1)" " apply: last argument should be a list: (apply + 1)")
+ (lint-test "(apply (lambda (x) (abs x)) y)" " apply: perhaps (lambda (x) (abs x)) -> abs")
+ (lint-test "(apply log (list x y))" " apply: perhaps (apply log (list x y)) -> (log x y)")
+ (lint-test "(apply + 1 2 ())" " apply: perhaps (apply + 1 2 ()) -> 3")
+ (lint-test "(apply real? 1 3 rest)" " apply: too many arguments for real?: (apply real? 1 3 rest)")
+ (lint-test "(with-let 123 123)" " with-let: with-let: first argument should be an environment: (with-let 123 123)")
+ (lint-test "(with-let random .1)" " with-let: with-let: first argument should be an environment: (with-let random 0.1)")
+ (lint-test "(with-let (rootlet) 1)" "")
+
+ (lint-test "(round '(1))" " round: round's argument should be a real?: '(1): (round '(1))")
+ (lint-test "(round '1.2)" " round: quote is not needed here: '1.2")
+ (lint-test "(round (integer->char 96))" " round: round's argument should be a real?: (integer->char 96): (round (integer->char 96))")
+ (lint-test "(let ((v (make-vector 3))) (vector-set! v 3.14 #\\a))"
+ " let: vector-set!'s argument 2 should be an integer?: 3.14: (vector-set! v 3.14 #\\a)")
+ (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 3.14 1))"
+ " let: float-vector-set!'s argument 2 should be an integer?: 3.14: (float-vector-set! v 3.14 1)")
+ (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 1 3.14))" "")
+ (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 1 #\\a))"
+ " let: float-vector-set!'s argument 3 should be a real?: #\\a: (float-vector-set! v 1 #\\a)")
+ (lint-test "(append () '(1 2) 1)" "")
+ (lint-test "(vector-set! (vector-ref a i) j x)" " vector-set!: perhaps (vector-set! (vector-ref a i) j x) -> (set! (a i j) x)")
+
+ (lint-test "(round (char-position #\\a \"asb\"))" "")
+ (lint-test "(string-ref (char-position #\\a \"asb\") 1)"
+ " string-ref: string-ref's argument 1 should be a string?: (char-position #\\a \"asb\"): (string-ref (char-position #\\a \"asb\") 1)")
+ (lint-test "(char-position \"xyz\" \"asb\")" "")
+ (lint-test "(if (null? (cons x y)) 1.0 0.0)" " if: perhaps (if (null? (cons x y)) 1.0 0.0) -> 0.0")
+ (lint-test "(if (null (cdr x)) 0)" " if: misspelled 'null? in (null (cdr x))?")
+ (lint-test "(if (pair? (sin x)) 1.0 0.0)" " if: perhaps (if (pair? (sin x)) 1.0 0.0) -> 0.0")
+ (lint-test "(if (number? (sin x)) 1.0)" " if: perhaps (if (number? (sin x)) 1.0) -> 1.0")
+ (lint-test "(if (number? (car x)) 1.0)" "")
+ (lint-test "(if (real? (sin x)) 1.0)" "")
+
+; (lint-test "(real? (imag-part z))" "...") ; this should be reduced outside if...
+; (lint-test "(char? (string-ref z y))" "...")
+
+ (lint-test "(if (number? 1.0) 1.0 0.0)" " if: perhaps (if (number? 1.0) 1.0 0.0) -> 1.0")
+ (lint-test "(if (pair? 1.0) 1.0 0.0)" " if: perhaps (if (pair? 1.0) 1.0 0.0) -> 0.0")
+ (lint-test "(if (symbol? (string->symbol x)) 0 1)" " if: perhaps (if (symbol? (string->symbol x)) 0 1) -> 0")
+ (lint-test "(if (symbol? (symbol->string x)) 0 1)" " if: perhaps (if (symbol? (symbol->string x)) 0 1) -> 1")
+ (lint-test "(and (symbol? x) (gensym? x))" " and: perhaps (and (symbol? x) (gensym? x)) -> (gensym? x)")
+ (lint-test "(integer? (*s7* 'vector-print-length))" " integer?: unknown *s7* field: 'vector-print-length")
+ (lint-test "(dynamic-wind (lambda () (s7-version)) (lambda () (list)) (lambda () #f))"
+ " dynamic-wind: perhaps (lambda () (s7-version)) -> s7-version dynamic-wind: perhaps (lambda () (list)) -> list")
+ (lint-test "(lambda args (apply + args))" " lambda: perhaps (lambda args (apply + args)) -> +")
+ (lint-test "(define-macro (mac a) `(+ ,,a 1))" " mac: define-macro probably has too many unquotes: ({list} '+ (unquote a) 1)")
+
+ ;; these tickled a lint bug
+ (lint-test "(define :xxx 321)" " define: keywords are constants :xxx")
+ (lint-test "(define (:yyy a) a)" " define: keywords are constants :yyy")
+
+ (lint-test "(define (f1) 32)" "")
+ (lint-test "(define (f2 a) a)" "")
+ (lint-test "(define (f3 . a) a)" "")
+ (lint-test "(define (f4 a b) a)" "")
+ (lint-test "(define (f5 a . b) a)" "")
+ (lint-test "(define (f6 a b . c) a)" "")
+
+ (lint-test "(define* (f1) 32)" " f1: define* could be define")
+ (lint-test "(define* (f2 a) a)" "")
+ (lint-test "(define* (f3 . a) a)" "")
+ (lint-test "(define* (f4 a (b 2)) a)" "")
+ (lint-test "(define* (f5 a :rest b) a)" "")
+ (lint-test "(define* (f6 a b :allow-other-keys) a)" "")
+
+ (lint-test "(define f1 (lambda () 32))" "")
+ (lint-test "(define f2 (lambda (a) a))" "")
+ (lint-test "(define f3 (lambda a a))" "")
+ (lint-test "(define f4 (lambda (a b) a))" "")
+ (lint-test "(define f5 (lambda (a . b) a))" "")
+
+ (lint-test "(define-macro (f1) 32)" "")
+ (lint-test "(define-macro (f2 a) a)" "")
+ (lint-test "(define-macro (f3 . a) a)" "")
+ (lint-test "(define-macro (f4 a b) a)" "")
+ (lint-test "(define-macro (f5 a . b) a)" "")
+ (lint-test "(define-macro (f6 a b . c) a)" "")
+
+ (lint-test "(let ((a 1)) (define (f1 b) (+ a b)) (f1 0))" "")
+
+ (lint-test "(let f1 ((a 1)) a)" " let: let variable f1 not used")
+ (lint-test "(let f1 ((a 1)) (f1 a))" "")
+ (lint-test "(let f1 ((a 1)) (+ a (f1)))" " let: f1 needs 1 argument: (f1)")
+ (lint-test "(let f1 ((a 1)) (f1 a 2))" " let: f1 has too many arguments: (f1 a 2)")
+ (lint-test "(define f7 (let ((a 1)) (lambda () a)))" "")
+ (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7))" "")
+ (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7 1))" "...")
+
+
+ (lint-test "(let () (define (f1) 32) (f1))" "")
+ (lint-test "(let () (define (f1) 32) (f1 32))" " let: f1 has too many arguments: (f1 32)")
+ (lint-test "(let () (define (f2 a) a) (f2))" " let: f2 needs 1 argument: (f2)")
+ (lint-test "(let () (define (f2 a) a) (f2 3))" "")
+ (lint-test "(let () (define (f2 a) a) (f2 3 32))" " let: f2 has too many arguments: (f2 3 32)")
+ (lint-test "(let () (define (f3 . a) a) (f3))" "")
+ (lint-test "(let () (define (f3 . a) a) (f3 1))" "")
+ (lint-test "(let () (define (f3 . a) a) (f3 1 2 3))" "")
+ (lint-test "(let () (define (f4 a b) a) (f4))" " let: f4 needs 2 arguments: (f4)")
+ (lint-test "(let () (define (f4 a b) a) (f4 1))" " let: f4 needs 2 arguments: (f4 1)")
+ (lint-test "(let () (define (f4 a b) a) (f4 1 2))" "")
+ (lint-test "(let () (define (f4 a b) a) (f4 1 2 3))" " let: f4 has too many arguments: (f4 1 2 3)")
+ (lint-test "(let () (define (f5 a . b) a) (f5))" " let: f5 needs 1 argument: (f5)")
+ (lint-test "(let () (define (f5 a . b) a) (f5 1))" "")
+ (lint-test "(let () (define (f5 a . b) a) (f5 1 2))" "")
+ (lint-test "(let () (define (f5 a . b) a) (f5 1 2 3 4))" "")
+ (lint-test "(let () (define (f6 a b . c) a) (f6))" " let: f6 needs 2 arguments: (f6)")
+ (lint-test "(let () (define (f6 a b . c) a) (f6 1))" " let: f6 needs 2 arguments: (f6 1)")
+ (lint-test "(let () (define (f6 a b . c) a) (f6 1 2))" "")
+ (lint-test "(let () (define (f6 a b . c) a) (f6 1 2 3))" "")
+ (lint-test "(let () (define (f6 a b . c) a) (f6 1 2 3 4))" "")
+
+ (lint-test "(begin (define* (f1) 32) (f1))" " f1: define* could be define")
+ (lint-test "(begin (define* (f1) 32) (f1 :a 1))" " f1: define* could be define begin: f1 has too many arguments: (f1 :a 1)")
+ (lint-test "(begin (define* (f2 a) a) (f2))" "")
+ (lint-test "(begin (define* (f2 a) a) (f2 1))" "")
+ (lint-test "(begin (define* (f2 a) a) (f2 :a 1))" "")
+ (lint-test "(begin (define* (f2 a) a) (f2 :b 1))" " begin: f2 keyword argument :b (in (f2 :b 1)) does not match any argument in (a)")
+ (lint-test "(begin (define* (f2 a) a) (f2 :a 1 2))" " begin: f2 has too many arguments: (f2 :a 1 2)")
+ (lint-test "(begin (define* (f2 a) a) (f2 :a 1 :a 2))" " begin: f2 has too many arguments: (f2 :a 1 :a 2)")
+ (lint-test "(begin (define* (f2 a) a) (f2 1 2))" " begin: f2 has too many arguments: (f2 1 2)")
+ (lint-test "(begin (define* (f3 . a) a) (f3))" "")
+ (lint-test "(begin (define* (f3 . a) a) (f3 1))" "")
+ (lint-test "(begin (define* (f3 . a) a) (f3 :a 1))" "")
+ (lint-test "(begin (define* (f3 . a) a) (f3 1 2))" "")
+ (lint-test "(begin (define* (f4 a (b 2)) a) (f4))" "")
+ (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1))" "")
+ (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :b 1))" "")
+ (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :c 1))" " begin: f4 keyword argument :c (in (f4 :c 1)) does not match any argument in (a (b 2))")
+ (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1 :c 2))" " begin: f4 keyword argument :c (in (f4 :a 1 :c 2)) does not match any argument in (a (b 2))")
+ (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1 :b 2))" "")
+ (lint-test "(begin (define* (f5 a :rest b) a) (f5))" "")
+ (lint-test "(begin (define* (f5 a :rest b) a) (f5 1))" "")
+ (lint-test "(begin (define* (f5 a :rest b) a) (f5 1 2 3))" "")
+ (lint-test "(begin (define* (f5 a :rest b) a) (f5 :b 1))" "")
+ (lint-test "(begin (define* (f5 a :rest b) a) (f5 :a 1 2 3))" "")
+ (lint-test "(begin (define* (f6 a b :allow-other-keys) a) (f6))" "")
+ (lint-test "(begin (define* (f6 a b :allow-other-keys) a) (f6 :a 1 :b 2 :c 3))" "")
+
+
+ (lint-test "(let () (define (f8 a b) (+ 1 (f8 2 3))) (f8 1 2))" "")
+ (lint-test "(let () (define (f8 a b) ((lambda (c) (f8 c 3)) 1)) (f8 1 2))" "")
+ (lint-test "(let () (define (f1) 32) (set! f1 4) (+ 1 f1))" "")
+ (lint-test "(let () (define f10 (lambda (a) a)) (set! f10 (lambda (a b) (+ a b))) (f10 1 2))" " let: perhaps (lambda (a b) (+ a b)) -> +")
+
+ (when (provided? 'snd)
+ (lint-test "(if (real? (oscil x)) 1.0 0.0)" " if: perhaps (if (real? (oscil x)) 1.0 0.0) -> 1.0")
+ (lint-test "(if (pair? (oscil x)) 1.0 0.0)" " if: perhaps (if (pair? (oscil x)) 1.0 0.0) -> 0.0")
+ (lint-test "(if (float? (oscil x)) 1.0 0.0)" " if: perhaps (if (float? (oscil x)) 1.0 0.0) -> 1.0")
+ (lint-test "(radians->hz 3.4+i)" " radians->hz: radians->hz's argument should be a real?: 3.4+1i: (radians->hz 3.4+1i)")
+ (lint-test "(string-ref (radians->hz x) 3)"
+ " string-ref: string-ref's argument 1 should be a string?: (radians->hz x): (string-ref (radians->hz x) 3)")
+
+ (lint-test "(set! (print-length) \"asd\")" " set!: print-length: new value should be an integer?: string?: (set! (print-length) \"asd\")")
+ (lint-test "(set! (print-length) 9)" "")
+ (lint-test "(set! (show-indices) 32)" " set!: show-indices: new value should be a boolean?: integer?: (set! (show-indices) 32)")
+ (lint-test "(set! (show-indices) #t)" "")
+ )
+
+ (define f321
+ (let ((signature '(float? integer?)))
+ (lambda (int)
+ (if (integer? int)
+ (* 1.0 int)
+ (error 'wrong-type-arg "~A: ~A is not an integer" f321 int)))))
+ (lint-test "(string-ref (f321 3) 2)" " string-ref: string-ref's argument 1 should be a string?: (f321 3): (string-ref (f321 3) 2)")
+
+ (set! reader-cond #f)
+ )
+
+
+
+#|
+(let ((old+ +))
+ (let ((vals
+ (list (let ()
+ (define a 32)
+ (define p +)
+ (define (f b) (+ a b))
+ (set! a 1)
+ (let ((t1 (f 2)))
+ (set! + -)
+ (let ((t2 (f 2)))
+ (let ((t3 (equal? p +)))
+ (list t1 t2 t3)))))
+
+ ;; s7: (3 -1 #f) ; this is now (3 3 #f) which strikes me as correct
+ ;; guile: (3 3 #f)
+
+ (let ()
+ (define a 32)
+ (define p old+)
+ (define (f b) (p a b))
+ (set! a 1)
+ (let ((t1 (f 2)))
+ (set! p -)
+ (let ((t2 (f 2)))
+ (let ((t3 (equal? p old+)))
+ (list t1 t2 t3)))))
+
+ ;; s7 (3 -1 #t)
+ ;; guile (3 -1 #t)
+ )))
+ (set! + old+)
+ (test (car vals) (cadr vals))))
+|#
+
+(let ((old+ +))
+ (define (f x) (with-let (unlet) (+ x 1)))
+ (set! + -)
+ (test (+ 1 1) 0)
+ (test (f 1) 2)
+ (set! + old+))
+
+(let ((old+ +))
+ (let ((f #f))
+ (let ((+ -))
+ (set! f (lambda (a) (+ 1 a))))
+ (test (f 2) -1)
+ (set! + *)
+ (test (f 2) -1)
+ (set! + old+)))
+
+
+#|
+;;; this is confusing lint in t101.scm
+(set! *#readers* old-readers)
+
+(set! *#readers* (list (cons #\F (lambda (s) (and (string=? s "F") (list 'not #t))))
+ (cons #\F (lambda (s) (and (string=? s "First") 1)))))
+(let ((x #F))
+ (if x (format *stderr* "#F true?~%")) ; to what extent can this actually work?
+ (if #F (format *stderr* "#F #t?~%")))
+
+(let ((x #First))
+ (test (+ x 1) 2)
+ (test (if #F #First (not #F)) #t))
+
+(set! *#readers* (list (cons #\A (lambda (s) (and (string=? s "A") let)))
+ (cons #\B (lambda (s) (and (string=? s "B") `((x 1)))))
+ (cons #\C (lambda (s) (and (string=? s "C") `(+ x 1))))))
+(test (#A #B #C) 2) ; yow!!
+
+(set! *#readers* old-readers)
+|#
+
#|
(define (mu) ; infinite loop if bignums
@@ -62829,15 +85172,132 @@ largest fp integer 2+1024 - 2+971 = 1.798 10+308
gap from largest fp integer to previous fp integer 2+971 = 1.996 10+292
largest fp integer with a predecessor 2+53 - 1 = 9,007,199,254,740,991
-
#x7ff0000000000000 +inf
#xfff0000000000000 -inf
-#xfff8000000000000 nan
+#x7ff8000000000000 nan
+#xfff8000000000000 -nan
but how to build these in scheme? (set! flt (integer-encode-float 0 #x7ff 0)) ? (would need check for invalid args)
+in C:
+ s7_pointer p;
+ unsigned long long int NAN_1, NAN_0;
+ s7_double f_NAN_0, f_NAN_1;
+ p = s7_make_real(sc, NAN);
+ f_NAN_0 = real(p);
+ NAN_0 = integer(p);
+ NAN_1 = integer(p) | 1;
+ f_NAN_1 = (* ((s7_double*)(&NAN_1)));
+ fprintf(stderr, "%llx %f %d, %llx %f %d\n", NAN_0, f_NAN_0, is_NaN(f_NAN_0), NAN_1, f_NAN_1, is_NaN(f_NAN_1));
+
+7ff8000000000000 nan 1, 7ff8000000000001 nan 1
+
+so we can use these low order bits to mark where the NaN was created
+but I think we get NaN's implicitly and s7_make_real does not check
in non-gmp,
(+ most-negative-fixnum -1 most-positive-fixnum) is the same as
(+ most-positive-fixnum most-positive-fixnum) -> -2!
+
+apparently in solaris, it's NaN.0 not nan.0?
+ fprintf(stderr, "NaN: %f %e %g\n", NAN, NAN, NAN);
+ in every other case this prints "nan nan nan", but on Solaris it's "NaN NaN NaN"
+
+(let ((lst ()))
+ (do ((i 0 (+ i 1)))
+ ((= i 1000) (reverse lst))
+ (set! lst (cons i lst))))
+;;; ok (tested) up to 10000000
+
+(set! (*s7* 'print-length) 256)
+(let ((st (symbol-table))
+ (counts 0)
+ (alphs (make-vector 256 0 #t))
+ (alph-min (make-vector 256 256 #t))
+ (alph-max (make-vector 256 -1 #t)))
+ (for-each
+ (lambda (sym)
+ (let ((name (symbol->string sym)))
+ (if (= (length name) 2)
+ (let ((index (char->integer (name 0)))
+ (index2 (char->integer (name 1))))
+ (set! counts (+ counts 1))
+ (set! (alphs index) (+ (alphs index) 1))
+ (set! (alph-min index) (min (alph-min index) index2))
+ (set! (alph-max index) (max (alph-min index) index2))))))
+ st)
+ (format *stderr* "~A~%"
+ (list counts
+ (let ((in-use 0))
+ (for-each
+ (lambda (c)
+ (if (> c 0)
+ (set! in-use (+ in-use 1))))
+ alphs)
+ in-use)
+ (let ((total 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (if (>= (alph-max i) 0)
+ (set! total (+ total (+ 1 (- (alph-max i) (alph-min i)))))))
+ total)
+ alphs)))
+
+;; this works but has the same results as (let () (load "s7test.scm" (curlet)))
+;; some minor __func__ mis-assumption at 27547
+(let ()
+ (call-with-input-file "s7test.scm"
+ (lambda (p)
+ (do ((form (read p) (read p)))
+ ((eq? form #<eof>))
+ (eval form)))))
+|#
+
+(when (and full-test (provided? 'snd)) ; repl gets confused here
+ (set! *#readers* ())
+ (require lint.scm)
+ (lint "s7test.scm" #f))
+
+#|
+ (for-each
+ (lambda (s)
+ (if (and (symbol-access s)
+ (not (char=? #\* ((symbol->string s) 0))))
+ (format *stderr* "~A " s)))
+ (symbol-table))
+
+(for-each
+ (lambda (s)
+ (if (and (dilambda? (symbol->value s))
+ (defined? (string->symbol (string-append "*" (symbol->string s) "*"))))
+ (format *stderr* "~A " s)))
+ (symbol-table))
+
+(let ((vars (make-vector 32 0)))
+ (for-each
+ (lambda (s)
+ (let ((len (min (length (symbol->string s)) 31)))
+ (set! (vars len) (+ (vars len) 1))))
+ (symbol-table))
+ (do ((i 0 (+ i 1)))
+ ((= i 32))
+ (format *stderr* "~D: ~D~%" i (vars i))))
+
+(let ((st (symbol-table)))
+ (for-each
+ (lambda (s)
+ (if (and (keyword? s)
+ (not (eq? s (symbol->value s))))
+ (format *stderr* "~S: ~S~%" s (symbol->value s))))
+ st))
|#
+(if (provided? 'debugging)
+ (format-logged #t "~%;all done! (debugging flag is on)~%")
+ (format-logged #t "~%;all done!~%"))
+
+;(close-output-port error-port)
+
+(s7-version)
+(if s7test-exits (exit))
+
+
diff --git a/saw.c b/saw.c
deleted file mode 100644
index d1a6ed8..0000000
--- a/saw.c
+++ /dev/null
@@ -1,118 +0,0 @@
-/* try out Snd as a mere widget in some grander context */
-
-/*
- if anyone uses this feature, and Snd doesn't do what you want, or you
- need more hooks into Snd, send me (bil at ccrma.stanford.edu) a description
- of the problem.
-*/
-
-#include "snd.h"
-
-#ifndef USE_GTK
-
-/* ---------------- MOTIF VERSION ---------------- */
-
-static bool snd_running = false;
-Widget form, shell, label, snd;
-XtAppContext app;
-int n;
-Arg args[20];
-
-static void snd_callback(Widget w, XtPointer clientData, XtPointer callData)
-{
- if (!snd_running)
- {
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
-
- snd_as_widget(0, NULL, app, form, args, n);
- snd_open_file("~/cl/oboe.snd", FILE_READ_WRITE);
-
- snd_running = true;
- }
-}
-
-int main (int argc, char **argv )
-{
- shell = XtVaAppInitialize (&app, "Snd-as-widget", NULL, 0, &argc, argv, NULL,
- XmNminWidth, 200,
- XmNminHeight, 40,
- XmNallowResize, true,
- NULL);
- form = XtCreateManagedWidget("form", xmFormWidgetClass, shell, NULL, 0);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- label = XtCreateManagedWidget("push for Snd", xmPushButtonWidgetClass, form, args, n);
- XtAddCallback(label, XmNactivateCallback, snd_callback, NULL);
-
- XtRealizeWidget(shell);
- XtAppMainLoop(app);
-}
-
-#else
-
-/* ---------------- GTK VERSION ---------------- */
-
-static bool snd_running = false;
-GtkWidget *form, *shell, *label, *snd;
-
-static void snd_callback(GtkWidget *w, gpointer data)
-{
- if (!snd_running)
- {
- snd = snd_as_widget(0, NULL, w, NULL);
- gtk_box_pack_start(GTK_BOX(form), snd, true, true, 0);
- gtk_widget_show(snd);
- snd_open_file("~/cl/oboe.snd", FILE_READ_WRITE);
- snd_running = true;
- gtk_label_set_text(GTK_LABEL(BIN_CHILD(label)), "Push to quit Snd");
- }
- else
- {
- gtk_label_set_text(GTK_LABEL(BIN_CHILD(label)), "Push for Snd");
- gtk_widget_hide(snd);
- snd_running = 0;
- }
-}
-
-static gint window_close(GtkWidget *w, GdkEvent *event, gpointer clientData)
-{
- gtk_main_quit();
- return(true);
-}
-
-static void gsnd_main (int argc, char **argv )
-{
- gtk_init(&argc, &argv);
- shell = gtk_window_new(GTK_WINDOW_TOPLEVEL);
- ALLOW_RESIZE(shell);
- SET_USIZE(shell, 200, 40);
- form = gtk_vbox_new(false, 0);
- gtk_container_add(GTK_CONTAINER(shell), form);
- gtk_widget_show(form);
-
- label = gtk_button_new_with_label("push for Snd");
- gtk_box_pack_start(GTK_BOX(form), label, false, false, 0);
- gtk_widget_show(label);
- gtk_widget_show(shell);
-
- gtk_signal_connect((gpointer)label, "clicked", GTK_SIGNAL_FUNC(snd_callback), (gpointer)form);
- gtk_signal_connect((gpointer)shell, "delete_event", GTK_SIGNAL_FUNC(window_close), NULL);
- gtk_main();
-}
-
-int main(int argc, char *argv[])
-{
- return(0);
-}
-
-#endif
diff --git a/selection.scm b/selection.scm
index ba9046b..47b1667 100644
--- a/selection.scm
+++ b/selection.scm
@@ -4,24 +4,15 @@
;;; replace-with-selection
;;; selection-members
;;; make-selection
-;;; eval-over-selection
;;; filter-selection-and-smooth
;;; with-temporary-selection
-;;;
-;;;
-;;; see also make-selection-frame-reader (frame.scm)
-;;; selection->sound-data (frame.scm)
-;;; selection-rms (examp.scm)
-;;; fit-selection-between-marks (marks.scm)
-;;; define-selection-via-marks (marks.scm)
-;;; pan-mix-selection (mix.scm)
(provide 'snd-selection.scm)
(if (not (defined? 'all-chans))
(define (all-chans)
- (let ((sndlist '())
- (chnlist '()))
+ (let ((sndlist ())
+ (chnlist ()))
(for-each (lambda (snd)
(do ((i (- (channels snd) 1) (- i 1)))
((< i 0))
@@ -34,66 +25,47 @@
;;; -------- swap selection chans
-(define (swap-selection-channels)
- "(swap-selection-channels) swaps the currently selected data's channels"
-
- (define find-selection-sound
- (lambda (not-this)
- (let ((scs (all-chans)))
- (call-with-exit
- (lambda (return)
- (map
- (lambda (snd chn)
- (if (and (selection-member? snd chn)
- (or (null? not-this)
- (not (equal? snd (car not-this)))
- (not (= chn (cadr not-this)))))
- (return (list snd chn))))
- (car scs)
- (cadr scs)))))))
-
- (if (selection?)
- (if (= (selection-chans) 2)
- (let* ((beg (selection-position))
- (len (selection-frames))
- (snd-chn0 (find-selection-sound '()))
- (snd-chn1 (find-selection-sound snd-chn0)))
- (if snd-chn1
- (swap-channels (car snd-chn0) (cadr snd-chn0) (car snd-chn1) (cadr snd-chn1) beg len)
- (error 'wrong-number-of-channels "swap-selection-channels needs two channels to swap")))
- (error 'wrong-number-of-channels "swap-selection-channels needs a stereo selection"))
- (error 'no-active-selection "swap-selection-channels needs a selection")))
+(define swap-selection-channels
+ (let ((documentation "(swap-selection-channels) swaps the currently selected data's channels"))
+ (lambda ()
+ (define find-selection-sound
+ (lambda (not-this)
+ (let ((scs (all-chans)))
+ (call-with-exit
+ (lambda (return)
+ (map
+ (lambda (snd chn)
+ (if (and (selection-member? snd chn)
+ (or (null? not-this)
+ (not (equal? snd (car not-this)))
+ (not (= chn (cadr not-this)))))
+ (return (list snd chn))))
+ (car scs)
+ (cadr scs)))))))
+
+ (if (selection?)
+ (if (= (selection-chans) 2)
+ (let* ((beg (selection-position))
+ (len (selection-framples))
+ (snd-chn0 (find-selection-sound ()))
+ (snd-chn1 (find-selection-sound snd-chn0)))
+ (if snd-chn1
+ (swap-channels (car snd-chn0) (cadr snd-chn0) (car snd-chn1) (cadr snd-chn1) beg len)
+ (error 'wrong-number-of-channels "swap-selection-channels needs two channels to swap")))
+ (error 'wrong-number-of-channels "swap-selection-channels needs a stereo selection"))
+ (error 'no-active-selection "swap-selection-channels needs a selection")))))
;;; -------- replace-with-selection
-(define (replace-with-selection)
- "(replace-with-selection) replaces the samples from the cursor with the current selection"
- (let ((beg (cursor))
- (len (selection-frames)))
- (insert-selection beg) ; put in the selection before deletion, since delete-samples can deactivate the selection
- (delete-samples (+ beg len) len)))
-
-
-
-#|
-;;; define selection from cursor to named mark bound to 'm' key
-(bind-key #\m 0
- (lambda ()
- (prompt-in-minibuffer "mark name:"
- (lambda (response) ; this expects a string (use double quotes)
- (define (define-selection beg end)
- (let* ((s (selected-sound))
- (c (selected-channel s)))
- (set! (selection-member? s c) #t)
- (set! (selection-position s c) beg)
- (set! (selection-frames s c) (+ 1 (- end beg)))))
- (let ((m (find-mark response)))
- (if (mark? m)
- (define-selection (cursor) (mark-sample m))
- (report-in-minibuffer "no such mark")))))))
-|#
+(define replace-with-selection
+ (let ((documentation "(replace-with-selection) replaces the samples from the cursor with the current selection"))
+ (lambda ()
+ (let ((beg (cursor))
+ (len (selection-framples)))
+ (insert-selection beg) ; put in the selection before deletion, since delete-samples can deactivate the selection
+ (delete-samples (+ beg len) len)))))
@@ -101,127 +73,98 @@
;;;
;;; returns a list of lists of (snd chn): channels in current selection
-(define (selection-members)
- "(selection-members) -> list of lists of (snd chn) indicating the channels participating in the current selection."
- (let ((sndlist '()))
- (if (selection?)
- (map (lambda (snd)
- (do ((i (- (channels snd) 1) (- i 1)))
- ((< i 0))
- (if (selection-member? snd i)
- (set! sndlist (cons (list snd i) sndlist)))))
- (sounds)))
- sndlist))
+(define selection-members
+ (let ((documentation "(selection-members) -> list of lists of (snd chn) indicating the channels participating in the current selection."))
+ (lambda ()
+ (let ((sndlist ()))
+ (if (selection?)
+ (map (lambda (snd)
+ (do ((i (- (channels snd) 1) (- i 1)))
+ ((< i 0))
+ (if (selection-member? snd i)
+ (set! sndlist (cons (list snd i) sndlist)))))
+ (sounds)))
+ sndlist))))
;;; -------- make-selection
;;; the regularized form of this would use dur not end
-(define* (make-selection beg end snd chn)
- "(make-selection beg end snd chn) makes a selection like make-region but without creating a region.
+(define make-selection
+ (let ((documentation "(make-selection beg end snd chn) makes a selection like make-region but without creating a region.
make-selection follows snd's sync field, and applies to all snd's channels if chn is not specified. end defaults
-to end of channel, beg defaults to 0, snd defaults to the currently selected sound."
-
- (let ((current-sound (or snd (selected-sound) (car (sounds)))))
-
- (define (add-chan-to-selection s0 s1 s c)
- (set! (selection-member? s c) #t)
- (set! (selection-position s c) (or s0 0))
- (set! (selection-frames s c) (- (or (and (number? s1) (+ 1 s1)) (frames s c)) (or s0 0))))
-
- (if (not (sound? current-sound))
- (error 'no-such-sound "make-selection can't find sound"))
-
- (let ((current-sync (sync current-sound)))
- (unselect-all)
- (if (number? chn)
- (add-chan-to-selection beg end snd chn)
- (for-each
- (lambda (s)
- (if (or (eq? snd #t)
- (equal? s current-sound)
- (and (not (= current-sync 0))
- (= current-sync (sync s))))
- (do ((i 0 (+ 1 i)))
- ((= i (channels s)))
- (add-chan-to-selection beg end s i))))
- (sounds))))))
+to end of channel, beg defaults to 0, snd defaults to the currently selected sound."))
+ (lambda* (beg end snd chn)
+
+ (let ((current-sound (or snd (selected-sound) (car (sounds)))))
+
+ (define (add-chan-to-selection s0 s1 s c)
+ (set! (selection-member? s c) #t)
+ (set! (selection-position s c) (or s0 0))
+ (set! (selection-framples s c) (- (or (and (number? s1) (+ 1 s1)) (framples s c)) (or s0 0))))
+
+ (if (not (sound? current-sound))
+ (error 'no-such-sound "make-selection can't find sound"))
+
+ (let ((current-sync (sync current-sound)))
+ (unselect-all)
+ (if (number? chn)
+ (add-chan-to-selection beg end snd chn)
+ (for-each
+ (lambda (s)
+ (if (or (eq? snd #t)
+ (equal? s current-sound)
+ (and (not (= current-sync 0))
+ (= current-sync (sync s))))
+ (do ((i 0 (+ 1 i)))
+ ((= i (channels s)))
+ (add-chan-to-selection beg end s i))))
+ (sounds))))))))
;;; -------- with-temporary-selection
-(define (with-temporary-selection thunk beg dur snd chn)
-
- "(with-temporary-selection thunk beg dur snd chn) saves the current selection placement, makes a new selection \
+(define with-temporary-selection
+
+ (let ((documentation "(with-temporary-selection thunk beg dur snd chn) saves the current selection placement, makes a new selection \
of the data from sample beg to beg + dur in the given channel. It then calls thunk, and
-restores the previous selection (if any). It returns whatever 'thunk' returned."
-
- (let ((seldata (and (selection?)
- (car (selection-members)))))
- (if (selection?)
- (set! seldata (append seldata (list (selection-position) (selection-frames)))))
- (make-selection beg (- (+ beg dur) 1) snd chn)
- (let ((result (thunk)))
- (if seldata
- (make-selection (caddr seldata)
- (- (+ (caddr seldata) (cadddr seldata)) 1)
- (car seldata)
- (cadr seldata))
- (unselect-all))
- result)))
-
+restores the previous selection (if any). It returns whatever 'thunk' returned."))
+ (lambda (thunk beg dur snd chn)
+
+ (let ((seldata (and (selection?)
+ (car (selection-members)))))
+ (if (selection?)
+ (set! seldata (append seldata (list (selection-position) (selection-framples)))))
+ (make-selection beg (- (+ beg dur) 1) snd chn)
+ (let ((result (thunk)))
+ (if seldata
+ (make-selection (caddr seldata)
+ (- (+ (caddr seldata) (cadddr seldata)) 1)
+ (car seldata)
+ (cadr seldata))
+ (unselect-all))
+ result)))))
-;;; -------- eval over selection, replacing current samples, mapped to "C-x x" key using prompt-in-minibuffer
-;;;
-;;; when the user types C-x x (without modifiers) and there is a current selection,
-;;; the minibuffer prompts "selection eval:". Eventually the user responds,
-;;; hopefully with a function of one argument, the current selection sample
-;;; the value returned by the function becomes the new selection value.
-
-(bind-key #\x 0
- (lambda () "eval over selection"
- (if (selection?)
- (prompt-in-minibuffer "selection eval:" eval-over-selection)
- (report-in-minibuffer "no selection")))
- #t)
-
-(define (eval-over-selection func)
- "(eval-over-selection func) evaluates func on each sample in the current selection"
- (if (and (procedure? func)
- (selection?))
- (let* ((beg (selection-position))
- (len (selection-frames)))
- (apply map (lambda (snd chn)
- (if (selection-member? snd chn)
- (let ((new-data (make-vct len))
- (old-data (channel->vct beg len snd chn)))
- (do ((k 0 (+ 1 k))) ;here we're applying our function to each sample in the currently selected portion
- ((= k len) (vct->channel new-data beg len snd chn))
- (vct-set! new-data k (func (vct-ref old-data k)))))))
- (all-chans)))))
-
-;;; the same idea can be used to apply a function between two marks (see eval-between-marks in marks.scm)
-
-
;;; -------- filter-selection-and-smooth
-(define* (filter-selection-and-smooth ramp-dur flt order)
- "(filter-selection-and-smooth ramp-dur flt order) applies 'flt' (via filter-sound) to \
-the selection, the smooths the edges with a ramp whose duration is 'ramp-dur' (in seconds)"
- (let ((temp-file (snd-tempnam)))
- (save-selection temp-file)
- (let ((selsnd (open-sound temp-file)))
- (filter-sound flt (or order (length flt)) selsnd)
- (let ((tmp-dur (samples->seconds (frames selsnd))))
- (set! (sync selsnd) (+ 1 (sync-max))) ; make sure env-sound hits all chans
- (env-sound (list 0 0 ramp-dur 1 (- tmp-dur ramp-dur) 1 tmp-dur 0) 0 #f 1.0 selsnd)
- (save-sound selsnd)
- (close-sound selsnd)
- (env-selection (list 0 1 ramp-dur 0 (- tmp-dur ramp-dur) 0 tmp-dur 1))))
- (mix temp-file (selection-position) #t #f #f #f #f)))
-
-;;; (filter-selection-and-smooth .01 (vct .25 .5 .5 .5 .25))
+(define filter-selection-and-smooth
+ (let ((documentation "(filter-selection-and-smooth ramp-dur flt order) applies 'flt' (via filter-sound) to \
+the selection, the smooths the edges with a ramp whose duration is 'ramp-dur' (in seconds)"))
+ (lambda* (ramp-dur flt order)
+ (let ((temp-file (snd-tempnam)))
+ (save-selection temp-file)
+ (let ((selsnd (open-sound temp-file)))
+ (filter-sound flt (or order (length flt)) selsnd)
+ (let ((tmp-dur (samples->seconds (framples selsnd))))
+ (set! (sync selsnd) (+ 1 (sync-max))) ; make sure env-sound hits all chans
+ (env-sound (list 0 0 ramp-dur 1 (- tmp-dur ramp-dur) 1 tmp-dur 0) 0 #f 1.0 selsnd)
+ (save-sound selsnd)
+ (close-sound selsnd)
+ (env-selection (list 0 1 ramp-dur 0 (- tmp-dur ramp-dur) 0 tmp-dur 1))))
+ (mix temp-file (selection-position) #t #f #f #f #f)))))
+
+;;; (filter-selection-and-smooth .01 (float-vector .25 .5 .5 .5 .25))
diff --git a/singer.scm b/singer.scm
index cb6cdb4..ba6b6fa 100644
--- a/singer.scm
+++ b/singer.scm
@@ -17,515 +17,510 @@
;;; translated from CLM singer.ins
(provide 'snd-singer.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(define two-pi (* 2 pi))
(definstrument (singer beg amp data)
;; data is a list of lists very similar to the sequence of synthesize calls in Perry's original implementation.
;; Each imbedded list has the form: dur shape glot pitch glotamp noiseamps vibramt.
;; See below for examples.
+
(let* ((setup (car data))
(durs (map car data))
(dur (apply + durs))
(begs (let ((bg beg))
(append (list beg)
(map (lambda (x)
- (set! bg (+ bg x))
- bg)
+ (set! bg (+ bg x)))
durs))))
- (beg-samps (map seconds->samples begs))
- (change-times (let* ((len (length beg-samps))
- (nbegs (append beg-samps (list (list-ref beg-samps (- len 1))))))
- (list->vct nbegs)))
- (shps (map cadr data))
- (glts (map caddr data))
+ (beg-samps (map seconds->samples begs)))
+
+ (let ((change-times (let* ((len (length beg-samps))
+ (nbegs (append beg-samps (list (beg-samps (- len 1))))))
+ (apply vector nbegs)))
+
+ (shps (map cadr data))
+ (glts (map caddr data))
+
+ (pfun (let ((init (list 0.0 (* .8 (setup 3)))))
+ (for-each (lambda (b dat)
+ (set! init (append init (list (- b beg))))
+ (set! init (append init (list (* 1.0 (dat 3))))))
+ (cdr begs)
+ data)
+ init))
+ (gfun (let ((init (list 0.0 0.0)))
+ (for-each (lambda (b dat)
+ (set! init (append init (list (- b beg))))
+ (set! init (append init (list (* 1.0 (dat 4))))))
+ (cdr begs)
+ data)
+ init))
+ (nfun (let ((init (list 0.0 (* 1.0 (setup 5)))))
+ (for-each (lambda (b dat)
+ (set! init (append init (list (- b beg))))
+ (set! init (append init (list (* 1.0 (dat 5))))))
+ (cdr begs)
+ data)
+ init))
+ (vfun (let ((init (list 0.0 (* 1.0 (setup 6)))))
+ (for-each (lambda (b dat)
+ (set! init (append init (list (- b beg))))
+ (set! init (append init (list (* 1.0 (dat 6))))))
+ (cdr begs)
+ data)
+ init))
+ (noiseamps (let* ((len (length data))
+ (v (make-float-vector len 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v i) (* 1.0 ((data i) 5))))
+ v))
+ (tractlength 9)) ;length of vocal tract
+
+ (let ((frq-env (make-env pfun :duration dur))
+ (vib-env (make-env vfun :duration dur))
+ (vib-osc (make-oscil 6.0))
+ (glot-env (make-env gfun :duration dur))
+ (noise-env (make-env nfun :duration dur))
+ (ran-vib (make-rand-interp :frequency 10 :amplitude .02))
+
+ (glot-datai (make-float-vector (* 2 (length glts)) 0.0))
+ (glot-datar (make-float-vector (* 2 (length glts)) 0.0))
+
+ (tractlength+8 (+ tractlength 8))
+ (tractlength+1 (+ tractlength 1))
+ (tractlength-1 (- tractlength 1))
+ (tractlength-2 (- tractlength 2))
+
+ (noselength 6)
+ (table-size 1000) ; size of glottis wave-table
+ (dpole 0.998)
+ (bg (seconds->samples beg))
+ (tong-hump-pole 0.998)
+ (tong-tip-pole 0.998))
+
+ (let ((shape-data (make-float-vector (* (length shps) tractlength+8) 0.0))
+
+ (noselength-1 (- noselength 1))
+ (noselength-2 (- noselength 2))
+ (nose-ring-time 1000) ; naso pharynx response decay time
+ (table-size-over-sampling-rate (/ table-size *clm-srate*))
+ (dgain (- 1.0 dpole))
+ (tong-hump-gain (- 1.0 tong-hump-pole))
+ (tong-tip-gain (- 1.0 tong-tip-pole))
+
+ (last-sfd -1)
+ (last-gfd -1)
+
+ (glot-table (make-float-vector (+ 1 table-size) 0.0))
+ (glot-table2 (make-float-vector (+ 1 table-size) 0.0))
+ ;; (gn-table (make-float-vector (+ 1 table-size) 0.0)) ;(gn-gain 0.0) ;(gn-out 0.0) ;(gn-del (make-float-vector 4 0.0))
+ ;; (gn-coeffs (make-float-vector 4 0.0)) ; in Perry's C code, these were set in setGlotNoiseFilter but it was never called!
+ (table-increment 0.0)
+ (glot-refl-gain 0.7)
+ (pitch 400.0)
+ (last-lip-in 0.0) ;for lip reflection/transmission filter
+ (last-lip-out 0.0)
+ (last-lip-refl 0.0)
+ (lip-refl-gain -0.45)
+ (noise-gain 0.0) ;for vocal tract noise generator
+ (noise-input 0.0)
+ (noise-output 0.0)
+ (noisef (make-fir-filter 4 :xcoeffs (make-float-vector 4)))
+ (noisev #f)
+ (noise-pos 0)
+ (fnoiseamp 0.0)
+ (inz1 0.0)
+ (inz2 0.0)
+ ;; nasal tract acoustic tube structure
+ (nose-coeffs (make-float-vector noselength 0.0))
+ (nose1 (make-float-vector noselength 0.0))
+ (nose2 (make-float-vector noselength 0.0))
+ (velum-pos 0.0)
+ (nose-last-minus-refl 0.0)
+ (nose-last-plus-refl 0.0)
+ (nose-last-output 0.0)
+ (nose-filt 0.0)
+ (nose-filt1 0.0)
+ (time-nose-closed 1000) ; this is a hack used to determine if we need to calculate the nasal acoustics
+ ;; vocal tract acoustic tube structure
+
+ ;; throat radiation low-pass filter
+ (lt1 0.0)
+ (lp (make-one-pole 0.05 (* -0.05 .9995)))
- (pfun (let ((init (list 0.0 (* .8 (list-ref setup 3)))))
- (map (lambda (b dat)
- (set! init (append init (list (- b beg))))
- (set! init (append init (list (exact->inexact (list-ref dat 3))))))
- (cdr begs)
- data)
- init))
- (gfun (let ((init (list 0.0 0.0)))
- (map (lambda (b dat)
- (set! init (append init (list (- b beg))))
- (set! init (append init (list (exact->inexact (list-ref dat 4))))))
- (cdr begs)
- data)
- init))
- (nfun (let ((init (list 0.0 (exact->inexact (list-ref setup 5)))))
- (map (lambda (b dat)
- (set! init (append init (list (- b beg))))
- (set! init (append init (list (exact->inexact (list-ref dat 5))))))
- (cdr begs)
- data)
- init))
- (vfun (let ((init (list 0.0 (exact->inexact (list-ref setup 6)))))
- (map (lambda (b dat)
- (set! init (append init (list (- b beg))))
- (set! init (append init (list (exact->inexact (list-ref dat 6))))))
- (cdr begs)
- data)
- init))
- (noiseamps (let* ((len (length data))
- (v (make-vct len)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (set! (v i) (exact->inexact (list-ref (list-ref data i) 5))))
- v))
- (frq-env (make-env pfun :duration dur))
- (vib-env (make-env vfun :duration dur))
- (vib-osc (make-oscil 6.0))
- (glot-env (make-env gfun :duration dur))
- (noise-env (make-env nfun :duration dur))
- (ran-vib (make-rand-interp :frequency 10 :amplitude .02))
+ (lip-radius 0.0)
+ (s-glot-mix 0.0)
+ (s-noise 0.0)
+ (initial-noise-position 0.0)
+ (formant-shift 1.0)
+ (change-radii #f)
+ (delta 0.0)
+ (new-tract #t)
+ (first-tract #t)
+ (offset -1)
+ (nd (floor (change-times (- (length change-times) 1))))
+ (next-offset bg)
- (tractlength 9) ;length of vocal tract
- (tractlength+8 (+ tractlength 8))
- (tractlength+1 (+ tractlength 1))
- (tractlength-1 (- tractlength 1))
- (tractlength-2 (- tractlength 2))
- (shape-data (make-vct (* (length shps) tractlength+8)))
- (glot-datai (make-vct (* 2 (length glts))))
- (glot-datar (make-vct (* 2 (length glts)))))
+ (table-location 0.0)
+ (glotsamp 0.0)
+ (last-tract-plus 0.0)
+ (alpha1 0.0)
+ (alpha2 0.0)
+ (alpha3 0.0)
+ (noseposition 3)
- (do ((k 0 (+ 1 k))
- (i 0 (+ i tractlength+8)))
- ((= k (length shps)))
- (let ((shp (cdr (list-ref shps k))))
- (do ((j i (+ 1 j))
- (m 0 (+ 1 m)))
- ((= m (length shp)))
- (set! (shape-data j) (list-ref shp m)))))
-
- (do ((k 0 (+ 1 k))
- (i 0 (+ i 2)))
- ((= k (length glts)))
- (let ((glt (list-ref glts k)))
- (set! (glot-datai i) 0.0)
- (set! (glot-datai (+ 1 i)) (car glt))
- (set! (glot-datar i) (cadr glt))
- (set! (glot-datar (+ 1 i)) (caddr glt))))
- (let* ((table-size 1000) ; size of glottis wave-table
- (noseposition 3)
- (noselength 6)
- (noselength-1 (- noselength 1))
- (noselength-2 (- noselength 2))
- (nose-ring-time 1000) ; naso pharynx response decay time
- (two-pi (* 2 pi))
- (one-over-two-pi 0.159154943)
- (two-pi-over-table-size (/ two-pi table-size))
- (table-size-over-sampling-rate (/ table-size (mus-srate)))
- (dpole 0.998)
- (dgain (- 1.0 dpole))
- (tong-hump-pole 0.998)
- (tong-hump-gain (- 1.0 tong-hump-pole))
- (tong-tip-pole 0.998)
- (tong-tip-gain (- 1.0 tong-tip-pole))
- (glot-table (make-vct (+ 1 table-size)))
- (glot-table2 (make-vct (+ 1 table-size)))
- (gn-table (make-vct (+ 1 table-size)))
- (gn-gain 0.0)
- (gn-out 0.0)
- (gn-del (make-vct 4))
- (gn-coeffs (make-vct 4))
- (sines (make-vct 200))
- (cosines (make-vct 200))
- (table-increment 0.0)
- (table-location 0.0)
- (glot-refl-gain 0.7)
- (pitch 400.0)
- (vibr-amt 0.0)
- (last-lip-in 0.0) ;for lip reflection/transmission filter
- (last-lip-out 0.0)
- (last-lip-refl 0.0)
- (lip-refl-gain -0.45)
- (noise-gain 0.0) ;for vocal tract noise generator
- (noise-input 0.0)
- (noise-output 0.0)
- (noise-c (make-vct 4)) ; net coefficients on delayed outputs
- (noise-pos 0)
- (fnoiseamp 0.0)
- (inz1 0.0)
- (inz2 0.0)
- (outz (make-vct 4)) ; delayed versions of input and output
- ;; nasal tract acoustic tube structure
- (nose-coeffs (make-vct noselength))
- (nose1 (make-vct noselength))
- (nose2 (make-vct noselength))
- (velum-pos 0.0)
- (alpha (make-vct 4))
- (nose-last-minus-refl 0.0)
- (nose-last-plus-refl 0.0)
- (nose-last-output 0.0)
- (nose-filt 0.0)
- (nose-filt1 0.0)
- (time-nose-closed 1000) ; this is a hack used to determine if we need to calculate the nasal acoustics
- ;; vocal tract acoustic tube structure
- (radii (make-vct tractlength+8))
+ (target-radii (make-float-vector tractlength+8 0.0))
+ (target-temp (make-float-vector tractlength+8 0.0))
+ (radii-poles (make-float-vector tractlength+8 0.0))
+ (radii-pole-gains (make-float-vector tractlength+8 0.0))
+ (radii (make-float-vector tractlength+8 0.0))
; the radii array contains the vocal tract section radii
; (tractlength-1 of them), then glottal reflection gain
; then lip reflection gain, then noise position, then noise gain,
; then noise pole angle, then noise pole radius,
; then noise pole angle2, then noise pole radius2, then velum opening radius
- (coeffs (make-vct tractlength))
- (dline1 (make-vct tractlength))
- (dline2 (make-vct tractlength))
- ;; throat radiation low-pass filter
- (lt (make-vct 2))
- (ltcoeff .9995)
- (ltgain .05) ; a low order iir filter
- (lip-radius 0.0)
- (s-glot 0.0)
- (s-glot-mix 0.0)
- (s-noise 0.0)
- (last-tract-plus 0.0)
- (initial-noise-position 0.0)
- (formant-shift 1.0)
- (target-radii (make-vct tractlength+8))
- (radii-poles (make-vct tractlength+8))
- (radii-pole-gains (make-vct tractlength+8))
- (change-radii 0)
- (glotsamp 0.0)
- (delta 0.0)
- (temp-arr (make-vct tractlength+1))
- (new-glot 1)
- (first-glot 1)
- (new-tract 1)
- (first-tract 1)
- (offset -1)
- (bg (seconds->samples beg))
- (nd (floor (change-times (- (length change-times) 1))))
- (next-offset bg)
- (last-sfd -1)
- (last-gfd -1))
-
- (set! (nose-coeffs 0) 0.0)
- (set! (nose-coeffs 1) -0.29)
- (set! (nose-coeffs 2) -0.22)
- (set! (nose-coeffs 3) 0.0)
- (set! (nose-coeffs 4) 0.24)
- (set! (nose-coeffs 5) 0.3571)
+ (coeffs (make-float-vector tractlength 0.0))
+ (dline1 (make-float-vector tractlength 0.0))
+ (dline2 (make-float-vector tractlength 0.0)))
+
+ (set! noisev (mus-xcoeffs noisef))
+
+ (do ((k 0 (+ k 1))
+ (i 0 (+ i tractlength+8)))
+ ((= k (length shps)))
+ (let ((shp (cdr (shps k))))
+ (do ((j i (+ j 1))
+ (m 0 (+ 1 m)))
+ ((= m (length shp)))
+ (float-vector-set! shape-data j (shp m)))))
+
+ (do ((k 0 (+ k 1))
+ (i 0 (+ i 2)))
+ ((= k (length glts)))
+ (let ((glt (glts k)))
+ (set! (glot-datai i) 0.0)
+ (set! (glot-datai (+ i 1)) (car glt))
+ (set! (glot-datar i) (cadr glt))
+ (set! (glot-datar (+ i 1)) (caddr glt))))
+
+ (set! (nose-coeffs 0) 0.0)
+ (set! (nose-coeffs 1) -0.29)
+ (set! (nose-coeffs 2) -0.22)
+ (set! (nose-coeffs 3) 0.0)
+ (set! (nose-coeffs 4) 0.24)
+ (set! (nose-coeffs 5) 0.3571)
+
+ (fill! radii 1.0) ;(do ((i 0 (+ i 1))) ((= i 8)) (set! (radii i) 1.0))
+ (set! (radii 8) 0.7)
+ (set! (radii 9) -0.5)
+ (fill! target-radii 1.0) ;(do ((i 0 (+ i 1))) ((= i 8)) (set! (target-radii i) 1.0))
+ (set! (target-radii 8) 0.7)
+ (set! (target-radii 9) -0.5)
+
+ (fill! radii-poles dpole) ;(do ((i 0 (+ i 1))) ((= i tractlength+8)) (set! (radii-poles i) dpole))
+ (set! (radii-poles 2) tong-hump-pole)
+ (set! (radii-poles 3) tong-hump-pole)
+ (set! (radii-poles 4) tong-hump-pole)
+ (set! (radii-poles 5) tong-tip-pole)
+
+ (fill! radii-pole-gains dgain) ;(do ((i 0 (+ i 1))) ((= i tractlength+8)) (set! (radii-pole-gains i) dgain))
+ (set! (radii-pole-gains 2) tong-hump-gain)
+ (set! (radii-pole-gains 3) tong-hump-gain)
+ (set! (radii-pole-gains 4) tong-hump-gain)
+ (set! (radii-pole-gains 5) tong-tip-gain)
+
+ ;; ---------------- make glot ----------------
+ (let ((harms (floor (glot-datai 1)))
+ (temp1 0.0)
+ (temp 0.0)
+ (sines (make-float-vector 200 0.0))
+ (cosines (make-float-vector 200 0.0))
+ (one-over-two-pi 0.159154943)
+ (two-pi-over-table-size (/ two-pi table-size))
+ (a (glot-datar 0))
+ (b (glot-datar 1)))
+ (let ((a2 (* two-pi a))
+ (b2 (* two-pi b))
+ (b-a (- b a)))
+ (let ((sa2 (sin a2))
+ (ca2 (cos a2)))
+ (fill! sines 0.0)
+ (fill! cosines 0.0)
+ (if (not (= b a))
+ (begin
+ (set! temp (/ one-over-two-pi b-a))
+ (set! temp1 (- 1.0 ca2))
+ (set! (sines 1) (* (+ ca2 (* (- sa2 (sin b2)) temp)) temp1 one-over-two-pi))
+ (set! (cosines 1) (* (+ (- sa2) (* (- ca2 (cos b2)) temp)) temp1 one-over-two-pi))))
+ (set! (sines 1) (+ (sines 1) (* (+ 0.75 (- ca2) (* (cos (* 2 a2)) 0.25)) one-over-two-pi)))
+ (set! (cosines 1) (+ (cosines 1) (- (* (- sa2 (* (sin (* 2 a2)) 0.25)) one-over-two-pi) (* a 0.5))))
+ (do ((k 2 (+ k 1))
+ (ka2 (* 2 a2) (+ ka2 a2))
+ (ka1 a2 (+ ka1 a2))
+ (ka3 (* 3 a2) (+ ka3 a2)))
+ ((> k harms))
+ (if (not (= b a))
+ (begin
+ (set! temp (/ one-over-two-pi (* b-a k)))
+ (set! (sines k) (* (+ (cos ka2) (* (- (sin ka2) (sin (* k b2))) temp)) (/ temp1 k)))
+ (set! (cosines k) (* (+ (- (sin ka2)) (* (- (cos ka2) (cos (* k b2))) temp)) (/ temp1 k)))))
+ (set! (sines k) (+ (sines k)
+ (/ (- 1.0 (cos ka2)) k)
+ (/ (* (- (cos ka1) 1.0) 0.5) (- k 1))
+ (/ (* (- (cos ka3) 1.0) 0.5) (+ k 1))))
+ (set! (sines k) (* (sines k) one-over-two-pi))
+ (set! (cosines k) (+ (cosines k) (- (/ (sin ka2) k) (/ (* (sin ka1) 0.5) (- k 1)) (/ (* (sin ka3) 0.5) (+ k 1)))))
+ (set! (cosines k) (* (cosines k) one-over-two-pi)))
+ (fill! glot-table 0.0)
+ (do ((j 0 (+ j 1))
+ (x 0.0 (+ x two-pi-over-table-size)))
+ ((> j table-size))
+ (do ((k 1 (+ k 1))
+ (kx x (+ kx x)))
+ ((> k harms))
+ (float-vector-set! glot-table j (+ (float-vector-ref glot-table j)
+ (* (float-vector-ref cosines k) (cos kx))
+ (* (float-vector-ref sines k) (sin kx)))))))))
+ (set! s-glot-mix 1.0)
+ (copy glot-table glot-table2)
+ ;; ---------------- end make glot ----------------
+
+
+ (do ((i bg (+ i 1)))
+ ((= i nd))
+ (if (= i next-offset)
+ (begin
+ ;; time to check for new tract shapes, glottal pulse shapes etc.
+ (set! offset (+ offset 1))
+ (set! fnoiseamp (noiseamps offset))
+ (if (= last-sfd -1)
+ (set! last-sfd 0)
+ (let ((new-sfd (+ last-sfd 8 tractlength)))
+ (do ((j last-sfd (+ j 1))
+ (k new-sfd (+ k 1)))
+ ((= j new-sfd))
+ (if (> (abs (- (shape-data j) (shape-data k))) .001)
+ (set! new-tract #t)))
+ (set! last-sfd new-sfd)))
+ (if (= last-gfd -1)
+ (set! last-gfd 0)
+ (let ((new-gfd (+ last-gfd 2)))
+ (set! last-gfd new-gfd)))
+ (set! next-offset (floor (change-times (+ offset 1))))
+ (set! delta (/ 1.0 (- next-offset i)))))
+
+ (if new-tract
+ (begin
+ (copy shape-data target-radii last-sfd)
- (do ((i 0 (+ 1 i))) ((= i 8)) (set! (radii i) 1.0))
- (set! (radii 8) 0.7)
- (set! (radii 9) -0.5)
- (do ((i 0 (+ 1 i))) ((= i 8)) (set! (target-radii i) 1.0))
- (set! (target-radii 8) 0.7)
- (set! (target-radii 9) -0.5)
+ (if first-tract
+ (copy target-radii radii))
+ (set! change-radii #f)
+ (set! initial-noise-position (radii tractlength+1))
+ (do ((j 0 (+ j 1)))
+ ((or (= j tractlength+8)
+ change-radii))
+ (if (> (abs (- (target-radii j) (radii j))) 0.001)
+ (set! change-radii #t)))))
+
+ (if (or first-tract change-radii)
+ (begin
+ (if (not new-tract)
+ (begin
+ (float-vector-multiply! radii radii-poles)
+ (copy target-radii target-temp)
+ (float-vector-multiply! target-temp radii-pole-gains)
+ (float-vector-add! radii target-temp)
+ ;; (do ((j 0 (+ j 1))) ((= j tractlength+8))
+ ;; (float-vector-set! radii j (+ (* (float-vector-ref radii j) (float-vector-ref radii-poles j))
+ ;; (* (float-vector-ref target-radii j) (float-vector-ref radii-pole-gains j)))))
+ ))
+ ;; set tract shape
+ (let ((tj 1.0)
+ (tk 0.0))
+ (do ((k 0 (+ k 1))
+ (j 1 (+ j 1)))
+ ((= j tractlength))
+ (set! tk tj)
+ (if (zero? (float-vector-ref radii j))
+ (set! tj 1e-10)
+ (set! tj (* (float-vector-ref radii k) (float-vector-ref radii k))))
+ (float-vector-set! coeffs j (/ (- tk tj) (+ tk tj)))))
- (do ((i 0 (+ 1 i))) ((= i tractlength+8)) (set! (radii-poles i) dpole))
- (set! (radii-poles 2) tong-hump-pole)
- (set! (radii-poles 3) tong-hump-pole)
- (set! (radii-poles 4) tong-hump-pole)
- (set! (radii-poles 5) tong-tip-pole)
+ (set! glot-refl-gain (radii tractlength-1))
+ (set! lip-refl-gain (radii tractlength))
+ (set! noise-pos (floor (radii tractlength+1)))
+ (set! noise-gain (radii (+ tractlength 2)))
- (do ((i 0 (+ 1 i))) ((= i tractlength+8)) (set! (radii-pole-gains i) dgain))
- (set! (radii-pole-gains 2) tong-hump-gain)
- (set! (radii-pole-gains 3) tong-hump-gain)
- (set! (radii-pole-gains 4) tong-hump-gain)
- (set! (radii-pole-gains 5) tong-tip-gain)
+ (let ((temp1 (radii (+ tractlength 3)))
+ (r (radii (+ tractlength 4)))
+ (t2 (radii (+ tractlength 5)))
+ (r2 (radii (+ tractlength 6))))
+ (let (;; fricative noise generator (set noise angle and radius)
+ (noise-angle (hz->radians temp1))
+ (noise-angle2 (hz->radians t2))
+ (noise-radius r)
+ (noise-radius2 r2))
+ (let ((noise-a (* -2.0 (cos (/ noise-angle formant-shift)) noise-radius))
+ (noise-b (* noise-radius noise-radius))
+ (noise-a2 (* -2.0 (cos (/ noise-angle2 formant-shift)) noise-radius2))
+ (noise-b2 (* noise-radius2 noise-radius2)))
+ (set! (noisev 0) (+ noise-a noise-a2))
+ (set! (noisev 1) (+ noise-b noise-b2 (* noise-a noise-a2)))
+ (set! (noisev 2) (+ (* noise-a2 noise-b) (* noise-b2 noise-a)))
+ (set! (noisev 3) (* noise-b2 noise-b)))))
+
+ (set! lip-radius (radii tractlength-2))
+ (set! velum-pos (radii (+ tractlength 7)))
+ (let ((leftradius (radii (- noseposition 2)))
+ (velumradius velum-pos)
+ (rightradius (radii (- noseposition 1))))
+ (let ((temp1 0.0)
+ (temp 0.0))
+ ;; nasal tract (set nasal shape)
+ (set! temp (- rightradius velumradius))
+ (if (< temp 0.0) (set! temp 0.0))
+ (set! alpha1 (* leftradius leftradius))
+ (set! alpha2 (* temp temp))
+ (set! alpha3 (* velumradius velumradius))
+ (set! temp1 (/ 2.0 (+ alpha1 alpha2 alpha3)))
+ (set! alpha1 (* alpha1 temp1))
+ (set! alpha2 (* alpha2 temp1))
+ (set! alpha3 (* alpha3 temp1))))))
+
+ (if new-tract
+ (begin
+ (set! new-tract #f)
+ (set! first-tract #f)
+ (if (or (< s-noise 1.0) (< fnoiseamp 0.0001))
+ (set! (target-radii tractlength+1) initial-noise-position))))
+
+ (set! s-glot-mix (- s-glot-mix delta))
+ (set! s-noise (env noise-env))
+ (set! pitch (env frq-env))
+ (set! table-increment (* pitch (+ 1.0 (* (env vib-env) (oscil vib-osc)) (rand-interp ran-vib)) table-size-over-sampling-rate))
+ (set! last-lip-out (+ last-lip-in last-tract-plus))
+ (set! last-lip-refl (* (+ last-lip-in last-tract-plus) lip-refl-gain))
+ (set! last-lip-in last-tract-plus)
+ ;; next glot tick
+ (set! glotsamp (* (dline2 1) glot-refl-gain))
+ (if (not (= table-increment 0.0))
+ (begin
+ (set! table-location (+ table-location table-increment))
+ (if (>= table-location table-size)
+ (set! table-location (- table-location table-size)))
+ (let ((int-loc (floor table-location)))
+ (let ((table1 (glot-table int-loc)))
+ (set! glotsamp (+ glotsamp (* (env glot-env) (+ table1 (* s-glot-mix (- (glot-table2 int-loc) table1))))))))))
+
+ ;; next tract tick
+ (let ((j 0)
+ ;(temp1 0.0)
+ (temp (dline2 2)))
+ (set! lt1 (one-pole lp (+ (dline1 2) temp)))
+
+ (set! (dline2 1) (+ temp (* (coeffs 1) (- glotsamp temp))))
+ (set! temp (+ glotsamp (- (dline2 1) temp)))
+ (set! temp (singer-filter 1 noseposition temp dline1 dline2 coeffs))
+#|
+ (let ((x 0.0))
+ (do ((j 2 (+ j 1))
+ (k 1 (+ k 1)))
+ ((= j noseposition))
+ (set! x (float-vector-ref dline2 (+ j 1)))
+ (float-vector-set! dline2 j (+ x (* (float-vector-ref coeffs j) (- (float-vector-ref dline1 k) x))))
+ (set! temp1 temp)
+ (set! temp (+ (float-vector-ref dline1 k) (- (float-vector-ref dline2 j) x)))
+ (float-vector-set! dline1 k temp1)))
+|#
+ (set! j noseposition) ;added
+ ;;next nasal tick
+ (let ((plussamp (dline1 (- j 1)))
+ (minussamp (dline2 (+ j 1)))
+ (nose-reftemp 0.0))
+ (if (and (= velum-pos 0.0)
+ (>= time-nose-closed nose-ring-time))
+ (let ((nose2-1 (float-vector-ref nose2 1)))
+ (set! nose-reftemp (+ (* alpha1 plussamp) (* alpha2 minussamp) (* alpha3 nose2-1)))
+ (set! nose-last-minus-refl (- nose-reftemp plussamp))
+ (set! nose-last-plus-refl (- nose-reftemp minussamp)))
+ (begin
+ (if (not (= velum-pos 0.0))
+ (set! time-nose-closed 0)
+ (set! time-nose-closed (+ time-nose-closed 1))) ; added 1 bil 17-Apr-11 but didn't test it
+ ;; nasal tick
+ (let ((nose-reftemp (+ (* alpha1 plussamp) (* alpha2 minussamp) (* alpha3 (nose2 1)))))
+ (let (;(nose-t1 0.0)
+ (nose-temp 0.0)
+ (plus-in (* velum-pos (- nose-reftemp (nose2 1)))))
+ (set! nose-last-minus-refl (- nose-reftemp plussamp))
+ (set! nose-last-plus-refl (- nose-reftemp minussamp))
+ (set! nose-reftemp (* (nose-coeffs 1) (- plus-in (nose2 2))))
+ (set! (nose2 1) (+ (nose2 2) nose-reftemp))
+ (set! nose-temp (+ plus-in nose-reftemp))
+
+ (set! nose-temp (singer-nose-filter noselength-1 nose-temp nose1 nose2 nose-coeffs))
+#|
+ (do ((j 2 (+ j 1))
+ (k 1 (+ k 1)))
+ ((= j noselength-1))
+ (set! nose-reftemp (* (nose-coeffs j) (- (nose1 k) (nose2 (+ j 1)))))
+ (set! (nose2 j) (+ (nose2 (+ j 1)) nose-reftemp))
+ (set! nose-t1 nose-temp)
+ (set! nose-temp (+ (nose1 k) nose-reftemp))
+ (set! (nose1 k) nose-t1))
+|#
+
+ (set! nose-reftemp (* (nose-coeffs noselength-1) (- (nose1 noselength-2) (* nose-last-output 0.25))))
+ (set! (nose2 noselength-1) (+ (* nose-last-output 0.25) nose-reftemp))
+ (set! (nose1 noselength-1) (+ (nose1 noselength-2) nose-reftemp))
+ (set! (nose1 noselength-2) nose-temp)
+ (set! nose-filt1 nose-filt)
+ (set! nose-filt (nose1 noselength-1))
+ (set! nose-last-output (* (+ nose-filt nose-filt1) 0.5))))))
+ (set! (dline2 j) nose-last-minus-refl))
+
+ (set! (dline1 (- j 1)) temp)
+ (set! temp nose-last-plus-refl)
+
+ ;; j always starts at 4, goes to 8 so this loop can be unrolled, but doing so doesn't make a big difference
+ (set! temp (singer-filter noseposition tractlength-1 temp dline1 dline2 coeffs))
+#|
+ (let ((x 0.0))
+ (do ((j (+ noseposition 1) (+ j 1))
+ (k noseposition (+ k 1)))
+ ((= j tractlength-1))
+ (set! x (float-vector-ref dline2 (+ j 1)))
+ (float-vector-set! dline2 j (+ x (* (float-vector-ref coeffs j) (- (float-vector-ref dline1 k) x))))
+ (set! temp1 temp)
+ (set! temp (+ (float-vector-ref dline1 k) (- (float-vector-ref dline2 j) x)))
+ (float-vector-set! dline1 k temp1)))
+|#
- (run
- (do ((i bg (+ 1 i)))
- ((= i nd))
- (if (= i next-offset)
- (begin
- ;; time to check for new tract shapes, glottal pulse shapes etc.
- (set! offset (+ 1 offset))
- (set! fnoiseamp (noiseamps offset))
- (if (= last-sfd -1)
- (set! last-sfd 0)
- (let ((new-sfd (+ last-sfd 8 tractlength)))
- (do ((j last-sfd (+ 1 j))
- (k new-sfd (+ 1 k)))
- ((= j new-sfd))
- (if (> (abs (- (shape-data j) (shape-data k))) .001)
- (set! new-tract 1)))
- (set! last-sfd new-sfd)))
- (if (= last-gfd -1)
- (set! last-gfd 0)
- (let ((new-gfd (+ last-gfd 2)))
- (set! last-gfd new-gfd)))
- (set! next-offset (floor (change-times (+ offset 1))))))
-
- (if (not (= new-tract 0))
- (begin
- (do ((j last-sfd (+ 1 j))
- (k 0 (+ 1 k)))
- ((= k tractlength+8))
- (set! (target-radii k) (shape-data j)))
- (if (= first-tract 1)
- (begin
- (do ((k 0 (+ 1 k)))
- ((= k tractlength+8))
- (set! (radii k) (target-radii k)))))
- (set! change-radii 0)
- (set! initial-noise-position (radii tractlength+1))
- (do ((j 0 (+ 1 j)))
- ((= j tractlength+8))
- (if (> (abs (- (target-radii j) (radii j))) 0.001)
- (set! change-radii 1)))))
-
- (if (or (= first-tract 1) (not (= change-radii 0)))
- (begin
- (if (= new-tract 0)
- (begin
- (do ((j 0 (+ 1 j)))
- ((= j tractlength+8))
- (set! (radii j) (+ (* (radii j) (radii-poles j))
- (* (target-radii j) (radii-pole-gains j)))))))
- ;; set tract shape
- (set! (temp-arr 0) 1.0)
- (do ((j 1 (+ 1 j)))
- ((= j tractlength))
- (set! (temp-arr j) (* (radii (- j 1)) (radii (- j 1))))
- (if (= (temp-arr j) 0.0)
- (set! (temp-arr j) 1e-10)))
- (do ((j 1 (+ 1 j)))
- ((= j tractlength))
- (set! (coeffs j) (/ (- (temp-arr (- j 1)) (temp-arr j))
- (+ (temp-arr (- j 1)) (temp-arr j)))))
- (set! glot-refl-gain (radii tractlength-1))
- (set! lip-refl-gain (radii tractlength))
- (set! noise-pos (floor (radii tractlength+1)))
- (set! noise-gain (radii (+ tractlength 2)))
- (let* ((temp1 (radii (+ tractlength 3)))
- (r (radii (+ tractlength 4)))
- (t2 (radii (+ tractlength 5)))
- (r2 (radii (+ tractlength 6)))
- ;; fricative noise generator (set noise angle and radius)
- (noise-angle (hz->radians temp1))
- (noise-radius r)
- (noise-a (* -2.0 (cos (/ noise-angle formant-shift)) noise-radius))
- (noise-b (* noise-radius noise-radius))
- (noise-angle2 (hz->radians t2))
- (noise-radius2 r2)
- (noise-a2 (* -2.0 (cos (/ noise-angle2 formant-shift)) noise-radius2))
- (noise-b2 (* noise-radius2 noise-radius2)))
- (set! (noise-c 0) (+ noise-a noise-a2))
- (set! (noise-c 1) (+ noise-b noise-b2 (* noise-a noise-a2)))
- (set! (noise-c 2) (+ (* noise-a2 noise-b) (* noise-b2 noise-a)))
- (set! (noise-c 3) (* noise-b2 noise-b)))
- (set! lip-radius (radii tractlength-2))
- (set! velum-pos (radii (+ tractlength 7)))
- (let ((leftradius (radii (- noseposition 2)))
- (velumradius velum-pos)
- (rightradius (radii (- noseposition 1))))
- (let ((temp1 0.0)
- (temp 0.0))
- ;; nasal tract (set nasal shape)
- (set! temp (- rightradius velumradius))
- (if (< temp 0.0) (set! temp 0.0))
- (set! (alpha 1) (* leftradius leftradius))
- (set! (alpha 2) (* temp temp))
- (set! (alpha 3) (* velumradius velumradius))
- (set! temp1 (/ 2.0 (+ (alpha 1) (alpha 2) (alpha 3))))
- (set! (alpha 1) (* (alpha 1) temp1))
- (set! (alpha 2) (* (alpha 2) temp1))
- (set! (alpha 3) (* (alpha 3) temp1))))))
-
- (if (not (= new-tract 0))
- (begin
- (set! new-tract 0)
- (set! first-tract 0)
- (if (or (< s-noise 1.0) (< fnoiseamp 0.0001))
- (set! (target-radii tractlength+1) initial-noise-position))))
- (if (not (= new-glot 0))
- (begin
- (if (= first-glot 0)
- (begin
- (do ((i 0 (+ 1 i)))
- ((> i table-size))
- (set! (glot-table2 i) (glot-table i)))))
- (let* ((harms (floor (glot-datai (+ last-gfd 1))))
- (temp1 0.0)
- (temp 0.0)
- (a (glot-datar last-gfd))
- (b (glot-datar (+ last-gfd 1)))
- (a2 (* two-pi a))
- (b2 (* two-pi b)))
- (vct-fill! sines 0.0)
- (vct-fill! cosines 0.0)
- ;(set! (sines 1) 0.0)
- ;(set! (cosines 1) 0.0)
- (if (not (= b a))
- (begin
- (set! temp (/ one-over-two-pi (- b a)))
- (set! temp1 (- 1.0 (cos a2)))
- (set! (sines 1) (* (+ (cos a2) (* (- (sin a2) (sin b2)) temp)) temp1 one-over-two-pi))
- (set! (cosines 1) (* (+ (- (sin a2)) (* (- (cos a2) (cos b2)) temp)) temp1 one-over-two-pi))))
- (set! (sines 1) (+ (sines 1) (* (+ 0.75 (- (cos a2)) (* (cos (* 2 a2)) 0.25)) one-over-two-pi)))
- (set! (cosines 1) (+ (cosines 1) (- (* (- (sin a2) (* (sin (* 2 a2)) 0.25)) one-over-two-pi) (* a 0.5))))
- (do ((k 2 (+ 1 k))
- (ka2 (* 2 a2) (+ ka2 a2))
- (ka1 a2 (+ ka1 a2))
- (ka3 (* 3 a2) (+ ka3 a2)))
- ((> k harms))
- ;(set! (sines k) 0.0)
- ;(set! (cosines k) 0.0)
- (if (not (= b a))
- (begin
- (set! temp (/ one-over-two-pi (* (- b a) k)))
- (set! (sines k) (* (+ (cos ka2) (* (- (sin ka2) (sin (* k b2))) temp)) (/ temp1 k)))
- (set! (cosines k) (* (+ (- (sin ka2)) (* (- (cos ka2) (cos (* k b2))) temp)) (/ temp1 k)))))
- (set! (sines k) (+ (sines k) (+ (/ (- 1.0 (cos ka2)) k) (/ (* (- (cos ka1) 1.0) 0.5) (- k 1))
- (/ (* (- (cos ka3) 1.0) 0.5) (+ k 1)))))
- (set! (sines k) (* (sines k) one-over-two-pi))
- (set! (cosines k) (+ (cosines k) (- (/ (sin ka2) k) (/ (* (sin ka1) 0.5) (- k 1)) (/ (* (sin ka3) 0.5) (+ k 1)))))
- (set! (cosines k) (* (cosines k) one-over-two-pi)))
- (vct-fill! glot-table 0.0)
- (do ((j 0 (+ 1 j))
- (x 0.0 (+ x two-pi-over-table-size)))
- ((> j table-size))
- ;(set! (glot-table j) 0.0)
- (do ((k 1 (+ 1 k)))
- ((> k harms))
- (set! (glot-table j) (+ (glot-table j) (+ (* (cosines k) (cos (* k x)))
- (* (sines k) (sin (* k x)))))))))
- (set! s-glot-mix 1.0)
- (set! delta (/ 1.0 (- next-offset i)))
- (if (not (= first-glot 0))
- (begin
- (do ((i 0 (+ 1 i)))
- ((> i table-size))
- (set! (glot-table2 i) (glot-table i)))
- (set! first-glot 0)))
- (set! new-glot 0)))
-
- (set! s-glot-mix (- s-glot-mix delta))
- (set! s-glot (env glot-env))
- (set! s-noise (env noise-env))
- (set! pitch (env frq-env))
- (set! vibr-amt (env vib-env))
- (set! table-increment (* pitch (+ 1.0 (* vibr-amt (oscil vib-osc)) (rand-interp ran-vib)) table-size-over-sampling-rate))
- (set! last-lip-out (+ last-lip-in last-tract-plus))
- (set! last-lip-refl (* (+ last-lip-in last-tract-plus) lip-refl-gain))
- (set! last-lip-in last-tract-plus)
- ;; next glot tick
- (let ((table1 0.0)
- (table2 0.0)
- (int-loc 0))
- (set! glotsamp (* (dline2 1) glot-refl-gain))
- (if (not (= table-increment 0.0))
- (begin
- (set! table-location (+ table-location table-increment))
- (if (>= table-location table-size)
- (set! table-location (- table-location table-size)))
- (set! int-loc (floor table-location))
- (set! table1 (glot-table int-loc))
- (set! table2 (glot-table2 int-loc))
- (set! glotsamp (+ glotsamp (* s-glot (+ table1 (* s-glot-mix (- table2 table1))))))
- ;; glot noise tick
- (if (and (not (= (gn-table int-loc) 0.0))
- (not (= gn-gain 0.0)))
- (begin
- (set! gn-out (- (* gn-gain s-glot (- 1.0 (random 2.0))) ;guessing here about random()
- (* (gn-coeffs 3) (gn-del 3))
- (* (gn-coeffs 2) (gn-del 2))
- (* (gn-coeffs 1) (gn-del 1))
- (* (gn-coeffs 0) (gn-del 0))))
- (do ((j 3 (- j 1))
- (k 2 (- k 1)))
- ((< j 1))
- (set! (gn-del j) (gn-del k)))
- (set! (gn-del 0) gn-out)))
- (set! glotsamp (+ glotsamp (* gn-out (gn-table int-loc)))))))
-
- ;; next tract tick
- (let ((j 0)
- (temp1 0.0)
- (temp 0.0))
- (set! (lt 0) (+ (dline1 2) (dline2 2)))
- (set! (dline2 1) (+ (dline2 2) (* (coeffs 1) (- glotsamp (dline2 2)))))
- (set! temp (+ glotsamp (- (dline2 1) (dline2 2))))
- (do ((j 2 (+ 1 j)))
- ((= j noseposition))
- (set! (dline2 j) (+ (dline2 (+ j 1)) (* (coeffs j) (- (dline1 (- j 1)) (dline2 (+ j 1))))))
- (set! temp1 temp)
- (set! temp (+ (dline1 (- j 1)) (- (dline2 j) (dline2 (+ j 1)))))
- (set! (dline1 (- j 1)) temp1))
- (set! j noseposition) ;added
- ;;next nasal tick
- (let ((plussamp (dline1 (- j 1)))
- (minussamp (dline2 (+ j 1)))
- (nose-reftemp 0.0))
- (if (and (= velum-pos 0.0)
- (>= time-nose-closed nose-ring-time))
- (begin
- (set! nose-reftemp (+ (* (alpha 1) plussamp) (* (alpha 2) minussamp) (* (alpha 3) (nose2 1))))
- (set! nose-last-minus-refl (- nose-reftemp plussamp))
- (set! nose-last-plus-refl (- nose-reftemp minussamp)))
- (begin
- (if (not (= velum-pos 0.0))
- (set! time-nose-closed 0)
- (set! time-nose-closed (+ time-nose-closed)))
- ;; nasal tick
- (let* ((nose-t1 0.0)
- (nose-temp 0.0)
- (nose-reftemp (+ (* (alpha 1) plussamp) (* (alpha 2) minussamp) (* (alpha 3) (nose2 1))))
- (plus-in (* velum-pos (- nose-reftemp (nose2 1)))))
- (set! nose-last-minus-refl (- nose-reftemp plussamp))
- (set! nose-last-plus-refl (- nose-reftemp minussamp))
- (set! nose-reftemp (* (nose-coeffs 1) (- plus-in (nose2 2))))
- (set! (nose2 1) (+ (nose2 2) nose-reftemp))
- (set! nose-temp (+ plus-in nose-reftemp))
- (do ((j 2 (+ 1 j)))
- ((= j noselength-1))
- (set! nose-reftemp (* (nose-coeffs j) (- (nose1 (- j 1)) (nose2 (+ j 1)))))
- (set! (nose2 j) (+ (nose2 (+ j 1)) nose-reftemp))
- (set! nose-t1 nose-temp)
- (set! nose-temp (+ (nose1 (- j 1)) nose-reftemp))
- (set! (nose1 (- j 1)) nose-t1))
- (set! nose-reftemp (* (nose-coeffs noselength-1)
- (- (nose1 noselength-2) (* nose-last-output 0.25))))
- (set! (nose2 noselength-1) (+ (* nose-last-output 0.25) nose-reftemp))
- (set! (nose1 noselength-1) (+ (nose1 noselength-2) nose-reftemp))
- (set! (nose1 noselength-2) nose-temp)
- (set! nose-filt1 nose-filt)
- (set! nose-filt (nose1 noselength-1))
- (set! nose-last-output (* (+ nose-filt nose-filt1) 0.5)))))
- (set! (dline2 j) nose-last-minus-refl))
-
- (set! temp1 temp)
- (set! temp nose-last-plus-refl)
- (set! (dline1 (- j 1)) temp1)
- (do ((j (+ noseposition 1) (+ 1 j)))
- ((= j tractlength-1))
- (set! (dline2 j) (+ (dline2 (+ j 1)) (* (coeffs j) (- (dline1 (- j 1)) (dline2 (+ j 1))))))
- (set! temp1 temp)
- (set! temp (+ (dline1 (- j 1)) (- (dline2 j) (dline2 (+ j 1)))))
- (set! (dline1 (- j 1)) temp1))
- (set! (dline2 tractlength-1) (+ last-lip-refl (* (coeffs tractlength-1)
- (- (dline1 tractlength-2) last-lip-refl))))
- (set! (dline1 tractlength-1) (+ (dline1 tractlength-2)
- (- (dline2 tractlength-1) last-lip-refl)))
- (set! (dline1 tractlength-2) temp)
- (if (not (= noise-gain 0.0))
- (begin
- (set! noise-input (- 1.0 (random 2.0))) ;a guess
- (do ((j 3 (- j 1))
- (k 2 (- k 1)))
- ((< j 1))
- (set! (outz j) (outz k)))
- (set! (outz 0) noise-output)
- (set! noise-output (- noise-input inz2))
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (set! noise-output (- noise-output (* (noise-c i) (outz i)))))
- (set! inz2 inz1)
- (set! inz1 noise-input)
- (set! (dline1 noise-pos) (+ (dline1 noise-pos) (* noise-output noise-gain s-noise)))))
- (set! last-tract-plus (* (dline1 tractlength-1) lip-radius)))
- (set! (lt 1) (* ltgain (+ (lt 0) (* ltcoeff (lt 1)))))
- (outa i (* amp (+ last-lip-out nose-last-output (lt 1))) *output*)
- )))))
+ (set! (dline2 tractlength-1) (+ last-lip-refl (* (coeffs tractlength-1) (- (dline1 tractlength-2) last-lip-refl))))
+ (set! (dline1 tractlength-1) (+ (dline1 tractlength-2) (- (dline2 tractlength-1) last-lip-refl)))
+ (set! (dline1 tractlength-2) temp)
+ (if (not (= noise-gain 0.0))
+ (begin
+ (set! noise-input (mus-random 1.0)) ;a guess
+ (set! noise-output (- noise-input inz2 (fir-filter noisef noise-output)))
+ (set! inz2 inz1)
+ (set! inz1 noise-input)
+ (set! (dline1 noise-pos) (+ (dline1 noise-pos) (* noise-output noise-gain s-noise)))))
+ (set! last-tract-plus (* (dline1 tractlength-1) lip-radius)))
+ (outa i (* amp (+ last-lip-out nose-last-output lt1)))
+ ))))))
#|
-(with-sound () (singer 0 .1 (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01) (list .6 oo.shp test.glt 523.0 .7 .1 .01))))
+(with-sound (:statistics #t)
+ (singer 0 .1 (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01) (list .6 oo.shp test.glt 523.0 .7 .1 .01))))
-(with-sound ()
+(with-sound (:statistics #t)
(singer 0 .1 (list (list .05 ehh.shp test.glt 523.0 0.8 0.0 .01)
(list .15 ehh.shp test.glt 523.0 0.8 0.0 .01)
(list .05 kkk.shp test.glt 523.0 0.0 0.0 .01)
diff --git a/snd-0.h b/snd-0.h
index ed5ec4c..df3b022 100644
--- a/snd-0.h
+++ b/snd-0.h
@@ -1,27 +1,21 @@
#ifndef SND_0_H
#define SND_0_H
-#if defined(__bsdi__) && (!HAVE_DECL_ISNAN)
- #define HAVE_DECL_ISNAN 1
-#endif
-
#if HAVE_RUBY
#undef _
#endif
-#if (!HAVE_FAM)
- #define FAMRequest int
- #define FAMEvent int
- #define FAMConnection void*
+#if HAVE_SCHEME
+ #define DISPLAY(Obj) s7_object_to_c_string(s7, Obj)
#endif
-#define NO_SUCH_ENVELOPE XEN_ERROR_TYPE("no-such-envelope")
-#define NO_SUCH_SAMPLE XEN_ERROR_TYPE("no-such-sample")
-#define NO_SUCH_EDIT XEN_ERROR_TYPE("no-such-edit")
-#define CANNOT_SAVE XEN_ERROR_TYPE("cannot-save")
-#define CANT_UPDATE_FILE XEN_ERROR_TYPE("cant-update-file")
+#define NO_SUCH_ENVELOPE Xen_make_error_type("no-such-envelope")
+#define NO_SUCH_SAMPLE Xen_make_error_type("no-such-sample")
+#define NO_SUCH_EDIT Xen_make_error_type("no-such-edit")
+#define CANNOT_SAVE Xen_make_error_type("cannot-save")
+#define CANT_UPDATE_FILE Xen_make_error_type("cant-update-file")
-#if (SIZEOF_INT == SIZEOF_VOID_P)
+#if (SIZEOF_VOID_P == 4)
typedef int pointer_or_int_t;
#else
typedef long long int pointer_or_int_t;
@@ -31,7 +25,7 @@
#define STRFTIME_FORMAT "%a %d-%b-%Y %H:%M %Z"
#endif
-#if HAVE_STRCASECMP
+#ifndef _MSC_VER
#define STRCMP(a, b) strcasecmp(a, b)
#define STRNCMP(a, b, c) strncasecmp(a, b, c)
#else
@@ -39,29 +33,26 @@
#define STRNCMP(a, b, c) strncmp(a, b, c)
#endif
-#define XOR(a, b) ((a) ^ (b))
-/* can't get used to this operator -- in the good old days, ^ meant exponentiation */
+#define strcopy(Dest, Src, Len) snprintf(Dest, Len, "%s", Src)
-#define UNPACK_SOUND(a) ((int)a >> 16)
-#define UNPACK_CHANNEL(a) ((int)a & 0xff)
-#define PACK_SOUND_AND_CHANNEL(a, b) ((a << 16) | b)
+#define unpack_sound(a) ((int)a >> 16)
+#define unpack_channel(a) ((int)a & 0xff)
+#define pack_sound_and_channel(a, b) ((a << 16) | b)
#define POINT_BUFFER_SIZE 8192
#define FILE_BUFFER_SIZE 8192
#define MAX_BUFFER_SIZE 65536
-#define MIX_FILE_BUFFER_SIZE 2048
#define PRINT_BUFFER_SIZE 512
#define LABEL_BUFFER_SIZE 128
-#define REPORTING_SIZE (MAX_BUFFER_SIZE * 8)
-
+#define REPORTING_SIZE (MAX_BUFFER_SIZE * 32)
/* progress bar (hourglass icon) is displayed if more than this many samples are being processed */
+
#if (!USE_NO_GUI)
#define NUM_HOURGLASSES 15
#else
#define NUM_HOURGLASSES 1
#endif
-#define NUM_BOMBS 15
#define PEAK_ENV_CUTOFF 50000
#define MIN_INIT 1000000.0
@@ -70,15 +61,15 @@
#define DEFAULT_OUTPUT_CHANS 1
#define DEFAULT_OUTPUT_SRATE 44100
#define DEFAULT_OUTPUT_HEADER_TYPE MUS_NEXT
+/* mus-next is probably best here since intermediate/temp files can be any length (> 2^32 bytes)
+ * and the next header-specified size, although 32 bits, is explicitly "advisory".
+ */
#if MUS_LITTLE_ENDIAN
- #define DEFAULT_OUTPUT_DATA_FORMAT MUS_LFLOAT
+ #define DEFAULT_OUTPUT_SAMPLE_TYPE MUS_LFLOAT
#else
- #define DEFAULT_OUTPUT_DATA_FORMAT MUS_BFLOAT
+ #define DEFAULT_OUTPUT_SAMPLE_TYPE MUS_BFLOAT
#endif
-/* mus-next is probably best here since intermediate/temp files can be any length (> 2^32 bytes)
- * and the next header-specified size, although 32 bits, is explicitly "advisory".
- */
#define NO_COMPLETER -1
#define NO_SELECTION -1
@@ -100,6 +91,14 @@
#define POPUP_BUTTON 3
#endif
+#define I_HELP "Help"
+#define I_GO_AWAY "Go away"
+#define I_NEXT "Next"
+#define I_PREVIOUS "Previous"
+#define I_FIND "Find"
+#define I_find "find:"
+#define I_STOP "Stop"
+
typedef enum {SOUND_SAVE_AS, SELECTION_SAVE_AS, REGION_SAVE_AS} save_dialog_t;
typedef enum {NOT_IN_BACKGROUND, IN_BACKGROUND} play_process_t;
typedef enum {WITHOUT_VIRTUAL_CHANNELS, WITH_VIRTUAL_CHANNELS} virtual_channels_t;
@@ -121,21 +120,19 @@ typedef enum {DONT_NORMALIZE, NORMALIZE_BY_CHANNEL, NORMALIZE_BY_SOUND, NORMALIZ
typedef enum {NO_DISK_SPACE, NOT_ENOUGH_DISK_SPACE, DISK_SPACE_OK} disk_space_t;
typedef enum {CHAN_GC, CHAN_IGC, CHAN_SELGC, CHAN_CGC, CHAN_MGC, CHAN_MXGC, CHAN_TMPGC} chan_gc_t;
typedef enum {NOT_A_VIEWER, FILE_VIEWER, REGION_VIEWER} file_viewer_t; /* 1 and 2, according to docs for mouse-enter-label-hook */
-typedef enum {COLOR_ORIENTATION_DIALOG, UNUSED_DIALOG_1, ENVED_DIALOG, UNUSED_DIALOG_2, UNUSED_DIALOG_3, TRANSFORM_DIALOG,
+typedef enum {COLOR_ORIENTATION_DIALOG, ENVED_DIALOG, TRANSFORM_DIALOG,
FILE_OPEN_DIALOG, SOUND_SAVE_AS_DIALOG, VIEW_FILES_DIALOG, RAW_DATA_DIALOG, NEW_FILE_DIALOG,
- FILE_MIX_DIALOG, EDIT_HEADER_DIALOG, FIND_DIALOG, HELP_DIALOG, UNUSED_DIALOG_4, MIX_DIALOG,
- PRINT_DIALOG, RECORDER_DIALOG, REGION_DIALOG, POST_IT_DIALOG, CONTROLS_DIALOG, SELECTION_SAVE_AS_DIALOG,
+ FILE_MIX_DIALOG, EDIT_HEADER_DIALOG, FIND_DIALOG, HELP_DIALOG, MIX_DIALOG,
+ PRINT_DIALOG, REGION_DIALOG, POST_IT_DIALOG, CONTROLS_DIALOG, SELECTION_SAVE_AS_DIALOG,
FILE_INSERT_DIALOG, REGION_SAVE_AS_DIALOG, PREFERENCES_DIALOG, NUM_DIALOGS} snd_dialog_t;
typedef enum {SOUND_IDLE, SOUND_NORMAL, SOUND_WRAPPER, SOUND_REGION, SOUND_READER} sound_inuse_t;
-typedef enum {NOT_FILING, INPUT_FILING, SELECTION_FILING, CHANNEL_FILING, TEMP_FILING, CHANGE_FILING,
- INSERT_FILING, MACRO_FILING, DOIT_SELECTION_FILING, DOIT_CHANNEL_FILING, SAVE_EDITS_FILING} sp_filing_t;
typedef enum {IO_NO_ERROR, IO_SAVE_HOOK_CANCELLATION, IO_BAD_CHANNEL, IO_CANT_REOPEN_FILE, IO_TOO_MANY_OPEN_FILES,
- IO_UNKNOWN_SNDLIB_ERROR, IO_NO_MEMORY, IO_CANT_OPEN_FILE, IO_NO_FILENAME, IO_BAD_DATA_FORMAT, IO_BAD_HEADER_TYPE,
+ IO_UNKNOWN_SNDLIB_ERROR, IO_NO_MEMORY, IO_CANT_OPEN_FILE, IO_NO_FILENAME, IO_BAD_SAMPLE_TYPE, IO_BAD_HEADER_TYPE,
IO_SNDLIB_UNINITIALIZED, IO_NOT_A_SOUND_FILE, IO_FILE_CLOSED, IO_WRITE_ERROR, IO_INTERRUPTED, IO_CANT_CLOSE_FILE,
IO_BAD_HEADER, IO_DISK_FULL, IO_WRITE_PROTECTED, IO_CANT_READ_SELECTION_FILE, IO_NEED_WRITE_CONFIRMATION,
IO_NO_CHANGES, IO_EDIT_HOOK_CANCELLATION, IO_CANT_CREATE_FILE, IO_ERROR_NUM} io_error_t;
typedef enum {INSERTION_EDIT, DELETION_EDIT, CHANGE_EDIT, INITIALIZE_EDIT, SCALED_EDIT, ZERO_EDIT, RAMP_EDIT,
- PTREE_EDIT, EXTEND_EDIT, MIX_EDIT, CHANGE_MIX_EDIT,
+ EXTEND_EDIT, MIX_EDIT, CHANGE_MIX_EDIT,
NUM_EDIT_TYPES} edit_t;
typedef enum {SAMPLER, REGION_READER, MIX_READER} reader_t;
typedef enum {MIX_FOLLOWS_SYNC, MIX_SETS_SYNC_LOCALLY} mix_sync_t;
@@ -145,16 +142,14 @@ enum {BLACK_AND_WHITE_COLORMAP, GRAY_COLORMAP, HOT_COLORMAP, COOL_COLORMAP, BONE
AUTUMN_COLORMAP, WINTER_COLORMAP, SPRING_COLORMAP, SUMMER_COLORMAP, RAINBOW_COLORMAP, FLAG_COLORMAP, PHASES_COLORMAP, NUM_BUILTIN_COLORMAPS};
-#define SERIOUS_IO_ERROR(Err) ((Err != IO_NO_ERROR) && \
- (Err != IO_EDIT_HOOK_CANCELLATION) && \
- (Err != IO_SAVE_HOOK_CANCELLATION) && \
- (Err != IO_INTERRUPTED) && \
- (Err != IO_NEED_WRITE_CONFIRMATION) && \
- (Err != IO_NO_CHANGES))
+#define is_serious_io_error(Err) ((Err != IO_NO_ERROR) && \
+ (Err != IO_EDIT_HOOK_CANCELLATION) && \
+ (Err != IO_SAVE_HOOK_CANCELLATION) && \
+ (Err != IO_INTERRUPTED) && \
+ (Err != IO_NEED_WRITE_CONFIRMATION) && \
+ (Err != IO_NO_CHANGES))
enum {FILE_OPENED, FILE_CLOSED};
-enum {SELECTION_INACTIVE, SELECTION_ACTIVE, SELECTION_CHANGED, SELECTION_IN_DOUBT};
-
typedef enum {WITH_READABLE_HEADERS, WITH_WRITABLE_HEADERS, WITH_BUILTIN_HEADERS} header_choice_t;
enum {SORT_A_TO_Z, SORT_Z_TO_A, SORT_NEW_TO_OLD, SORT_OLD_TO_NEW, SORT_SMALL_TO_BIG, SORT_BIG_TO_SMALL, SORT_XEN};
@@ -173,7 +168,7 @@ typedef enum {FILE_READ_WRITE, FILE_READ_ONLY} read_only_t;
#define EXIT_NOT_FORCED false
#if HAVE_RUBY
- #define TO_PROC_NAME(Str) xen_scheme_procedure_to_ruby(Str)
+ #define to_proc_name(Str) xen_scheme_procedure_to_ruby(Str)
#define TO_VAR_NAME(Str) xen_scheme_constant_to_ruby(Str)
#define PROC_OPEN "("
#define PROC_SEP ", "
@@ -186,7 +181,7 @@ typedef enum {FILE_READ_WRITE, FILE_READ_ONLY} read_only_t;
#define PROC_QUOTE ""
#endif
#if HAVE_FORTH
- #define TO_PROC_NAME(Str) Str
+ #define to_proc_name(Str) Str
#define TO_VAR_NAME(Str) Str
#define PROC_OPEN " "
#define PROC_SEP " "
@@ -199,7 +194,7 @@ typedef enum {FILE_READ_WRITE, FILE_READ_ONLY} read_only_t;
#define PROC_QUOTE ""
#endif
#if HAVE_SCHEME || (!HAVE_EXTENSION_LANGUAGE)
- #define TO_PROC_NAME(Str) Str
+ #define to_proc_name(Str) Str
#define TO_VAR_NAME(Str) Str
#define PROC_OPEN " "
#define PROC_SEP " "
@@ -218,9 +213,8 @@ typedef enum {FILE_READ_WRITE, FILE_READ_ONLY} read_only_t;
#define NO_LIST -1
typedef enum {READ_FORWARD, READ_BACKWARD} read_direction_t;
-typedef enum {TRACK_IF_ASKED, ALWAYS_TRACK} tracking_cursor_t;
+typedef enum {DONT_TRACK, TRACK_AND_RETURN, TRACK_AND_STAY} tracking_cursor_t;
typedef enum {DONT_UPDATE_DISPLAY, UPDATE_DISPLAY} cut_selection_regraph_t;
-typedef enum {SEARCH_OK, SEARCH_FAILED} search_result_t;
typedef enum {IGNORE_CACHE, REMOVE_FROM_CACHE} cache_remove_t;
typedef enum {FFT_UNCHANGED, FFT_CHANGED, FFT_CHANGE_LOCKED} fft_change_t;
typedef enum {WITHOUT_GRAPH, WITH_GRAPH, WITHOUT_INITIAL_GRAPH_HOOK} channel_graph_t;
@@ -256,7 +250,6 @@ typedef enum {FCP_X_ANGLE, FCP_X_SCALE, FCP_Y_ANGLE, FCP_Y_SCALE, FCP_Z_ANGLE, F
FCP_SPECTRUM_END, FCP_SPECTRUM_START, FCP_ALPHA, FCP_BETA, FCP_BEATS} fcp_t;
typedef enum {TIME_AXIS_INFO, TRANSFORM_AXIS_INFO, LISP_AXIS_INFO} axis_info_t;
typedef enum {COLOR_POSITION, COLOR_ZOOM} slider_choice_t;
-typedef enum {MINI_OFF, MINI_CURSOR, MINI_FIND, MINI_PROMPT, MINI_REPORT, MINI_USER} minibuffer_choice_t;
typedef enum {PLAY_COMPLETE, PLAY_CLOSE, PLAY_BUTTON_UNSET, PLAY_STOP_CALLED, PLAY_C_G, PLAY_NO_CHANNEL,
PLAY_ERROR, PLAY_APPLY, PLAY_EDIT, PLAY_C_T} play_stop_t;
@@ -273,58 +266,106 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#define DEFAULT_REVERB_CONTROL_LENGTH 1.0
#define DEFAULT_REVERB_CONTROL_SCALE 0.0
#define DEFAULT_SPEED_CONTROL 1.0
-#define DEFAULT_CONTRAST_CONTROL_P false
-#define DEFAULT_EXPAND_CONTROL_P false
-#define DEFAULT_FILTER_CONTROL_P false
-#define DEFAULT_REVERB_CONTROL_P false
+#define DEFAULT_CONTRAST_CONTROL_ON false
+#define DEFAULT_EXPAND_CONTROL_ON false
+#define DEFAULT_FILTER_CONTROL_ON false
+#define DEFAULT_REVERB_CONTROL_ON false
#define filter_control_in_dB(ss) ss->Filter_Control_In_Db
-#define in_set_filter_control_in_dB(ss, val) ss->Filter_Control_In_Db = val
+#if HAVE_SCHEME
+ #define in_set_filter_control_in_dB(ss, val) {ss->Filter_Control_In_Db = val; s7_symbol_set_value(s7, ss->filter_control_in_db_symbol, s7_make_boolean(s7, val));}
+#else
+ #define in_set_filter_control_in_dB(ss, val) ss->Filter_Control_In_Db = val
+#endif
#define DEFAULT_FILTER_CONTROL_IN_DB false
#define filter_control_in_hz(ss) ss->Filter_Control_In_Hz
-#define in_set_filter_control_in_hz(ss, val) ss->Filter_Control_In_Hz = val
+#if HAVE_SCHEME
+ #define in_set_filter_control_in_hz(ss, val) {ss->Filter_Control_In_Hz = val; s7_symbol_set_value(s7, ss->filter_control_in_hz_symbol, s7_make_boolean(s7, val));}
+#else
+ #define in_set_filter_control_in_hz(ss, val) ss->Filter_Control_In_Hz = val
+#endif
#define DEFAULT_FILTER_CONTROL_IN_HZ false
#define speed_control_tones(ss) ss->Speed_Control_Tones
-#define in_set_speed_control_tones(ss, val) ss->Speed_Control_Tones = val
+#if HAVE_SCHEME
+ #define in_set_speed_control_tones(ss, val) {ss->Speed_Control_Tones = val; s7_symbol_set_value(s7, ss->speed_control_tones_symbol, s7_make_integer(s7, val));}
+#else
+ #define in_set_speed_control_tones(ss, val) ss->Speed_Control_Tones = val
+#endif
#define DEFAULT_SPEED_CONTROL_TONES 12
#define speed_control_style(ss) ss->Speed_Control_Style
-#define in_set_speed_control_style(ss, val) ss->Speed_Control_Style = val
+#if HAVE_SCHEME
+ #define in_set_speed_control_style(ss, val) {ss->Speed_Control_Style = val; s7_symbol_set_value(s7, ss->speed_control_style_symbol, s7_make_integer(s7, val));}
+#else
+ #define in_set_speed_control_style(ss, val) ss->Speed_Control_Style = val
+#endif
#define DEFAULT_SPEED_CONTROL_STYLE SPEED_CONTROL_AS_FLOAT
#define expand_control_length(ss) ss->Expand_Control_Length
-#define in_set_expand_control_length(ss, val) ss->Expand_Control_Length = val
+#if HAVE_SCHEME
+ #define in_set_expand_control_length(ss, val) {ss->Expand_Control_Length = val; s7_symbol_set_value(s7, ss->expand_control_length_symbol, s7_make_real(s7, val));}
+#else
+ #define in_set_expand_control_length(ss, val) ss->Expand_Control_Length = val
+#endif
#define DEFAULT_EXPAND_CONTROL_LENGTH 0.15
#define expand_control_ramp(ss) ss->Expand_Control_Ramp
-#define in_set_expand_control_ramp(ss, val) ss->Expand_Control_Ramp = val
+#if HAVE_SCHEME
+ #define in_set_expand_control_ramp(ss, val) {ss->Expand_Control_Ramp = val; s7_symbol_set_value(s7, ss->expand_control_ramp_symbol, s7_make_real(s7, val));}
+#else
+ #define in_set_expand_control_ramp(ss, val) ss->Expand_Control_Ramp = val
+#endif
#define DEFAULT_EXPAND_CONTROL_RAMP 0.4
#define expand_control_hop(ss) ss->Expand_Control_Hop
-#define in_set_expand_control_hop(ss, val) ss->Expand_Control_Hop = val
+#if HAVE_SCHEME
+ #define in_set_expand_control_hop(ss, val) {ss->Expand_Control_Hop = val; s7_symbol_set_value(s7, ss->expand_control_hop_symbol, s7_make_real(s7, val));}
+#else
+ #define in_set_expand_control_hop(ss, val) ss->Expand_Control_Hop = val
+#endif
#define DEFAULT_EXPAND_CONTROL_HOP 0.05
#define expand_control_jitter(ss) ss->Expand_Control_Jitter
-#define in_set_expand_control_jitter(ss, val) ss->Expand_Control_Jitter = val
+#if HAVE_SCHEME
+ #define in_set_expand_control_jitter(ss, val) {ss->Expand_Control_Jitter = val; s7_symbol_set_value(s7, ss->expand_control_jitter_symbol, s7_make_real(s7, val));}
+#else
+ #define in_set_expand_control_jitter(ss, val) ss->Expand_Control_Jitter = val
+#endif
#define DEFAULT_EXPAND_CONTROL_JITTER 0.1
#define contrast_control_amp(ss) ss->Contrast_Control_Amp
-#define in_set_contrast_control_amp(ss, val) ss->Contrast_Control_Amp = val
+#if HAVE_SCHEME
+ #define in_set_contrast_control_amp(ss, val) {ss->Contrast_Control_Amp = val; s7_symbol_set_value(s7, ss->contrast_control_amp_symbol, s7_make_real(s7, val));}
+#else
+ #define in_set_contrast_control_amp(ss, val) ss->Contrast_Control_Amp = val
+#endif
#define DEFAULT_CONTRAST_CONTROL_AMP 1.0
#define reverb_control_feedback(ss) ss->Reverb_Control_Feedback
-#define in_set_reverb_control_feedback(ss, val) ss->Reverb_Control_Feedback = val
+#if HAVE_SCHEME
+ #define in_set_reverb_control_feedback(ss, val) {ss->Reverb_Control_Feedback = val; s7_symbol_set_value(s7, ss->reverb_control_feedback_symbol, s7_make_real(s7, val));}
+#else
+ #define in_set_reverb_control_feedback(ss, val) ss->Reverb_Control_Feedback = val
+#endif
#define DEFAULT_REVERB_CONTROL_FEEDBACK 1.09
#define reverb_control_lowpass(ss) ss->Reverb_Control_Lowpass
-#define in_set_reverb_control_lowpass(ss, val) ss->Reverb_Control_Lowpass = val
+#if HAVE_SCHEME
+ #define in_set_reverb_control_lowpass(ss, val) {ss->Reverb_Control_Lowpass = val; s7_symbol_set_value(s7, ss->reverb_control_lowpass_symbol, s7_make_real(s7, val));}
+#else
+ #define in_set_reverb_control_lowpass(ss, val) ss->Reverb_Control_Lowpass = val
+#endif
#define DEFAULT_REVERB_CONTROL_LOWPASS 0.7
#define reverb_control_decay(ss) ss->Reverb_Control_Decay
-#define in_set_reverb_control_decay(ss, val) ss->Reverb_Control_Decay = val
+#if HAVE_SCHEME
+ #define in_set_reverb_control_decay(ss, val) {ss->Reverb_Control_Decay = val; s7_symbol_set_value(s7, ss->reverb_control_decay_symbol, s7_make_real(s7, val));}
+#else
+ #define in_set_reverb_control_decay(ss, val) ss->Reverb_Control_Decay = val
+#endif
#define DEFAULT_REVERB_CONTROL_DECAY 1.0
#define contrast_control_min(ss) ss->Contrast_Control_Min
@@ -376,19 +417,47 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#define DEFAULT_REVERB_CONTROL_LENGTH_MAX 5.0
#define filter_control_order(ss) ss->Filter_Control_Order
-#define in_set_filter_control_order(ss, val) ss->Filter_Control_Order = val
+#if HAVE_SCHEME
+ #define in_set_filter_control_order(ss, val) {ss->Filter_Control_Order = val; s7_symbol_set_value(s7, ss->filter_control_order_symbol, s7_make_integer(s7, val));}
+#else
+ #define in_set_filter_control_order(ss, val) ss->Filter_Control_Order = val
+#endif
#define DEFAULT_FILTER_CONTROL_ORDER 20
#define in_show_controls(ss) ss->Show_Controls
-#define in_set_show_controls(ss, val) ss->Show_Controls = val
+#if HAVE_SCHEME
+ #define in_set_show_controls(ss, val) \
+ do {\
+ ss->Show_Controls = val; \
+ s7_symbol_set_value(s7, ss->show_controls_symbol, s7_make_boolean(s7, ss->Show_Controls));\
+ } while (0)
+#else
+ #define in_set_show_controls(ss, val) ss->Show_Controls = val
+#endif
#define DEFAULT_SHOW_CONTROLS false
#define with_tracking_cursor(ss) ss->With_Tracking_Cursor
-#define set_with_tracking_cursor(ss, val) ss->With_Tracking_Cursor = val
-#define DEFAULT_WITH_TRACKING_CURSOR TRACK_IF_ASKED
+#if HAVE_SCHEME
+#define set_with_tracking_cursor(ss, val) \
+ do {\
+ ss->With_Tracking_Cursor = val; \
+ s7_symbol_set_value(s7, ss->with_tracking_cursor_symbol, s7_make_integer(s7, (int)(ss->With_Tracking_Cursor))); \
+ } while (0)
+#else
+ #define set_with_tracking_cursor(ss, val) ss->With_Tracking_Cursor = val
+#endif
+#define DEFAULT_WITH_TRACKING_CURSOR DONT_TRACK
#define just_sounds(ss) ss->Just_Sounds
-#define set_just_sounds(val) ss->Just_Sounds = val
+#if HAVE_SCHEME
+ #define set_just_sounds(val) \
+ do {\
+ ss->Just_Sounds = val; \
+ s7_symbol_set_value(s7, ss->just_sounds_symbol, s7_make_boolean(s7, ss->Just_Sounds));\
+ } while (0)
+#else
+ #define set_just_sounds(val) ss->Just_Sounds = val
+#endif
#define DEFAULT_JUST_SOUNDS true
#define DEFAULT_SYNC 0
@@ -398,28 +467,63 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#define DEFAULT_INIT_WINDOW_HEIGHT 0
#define default_output_header_type(ss) ss->Default_Output_Header_Type
-#define set_default_output_header_type(a) ss->Default_Output_Header_Type = a
+#if HAVE_SCHEME
+ #define set_default_output_header_type(a) \
+ do {\
+ ss->Default_Output_Header_Type = (mus_header_t)a; \
+ s7_symbol_set_value(s7, ss->default_output_header_type_symbol, s7_make_integer(s7, (s7_int)(ss->Default_Output_Header_Type))); \
+ } while (0)
+#else
+#define set_default_output_header_type(a) ss->Default_Output_Header_Type = (mus_header_t)a
+#endif
#define default_output_chans(ss) ss->Default_Output_Chans
-#define set_default_output_chans(a) ss->Default_Output_Chans = a
+#if HAVE_SCHEME
+ #define set_default_output_chans(a) \
+ do {\
+ ss->Default_Output_Chans = a; \
+ s7_symbol_set_value(s7, ss->default_output_chans_symbol, s7_make_integer(s7, ss->Default_Output_Chans));\
+ } while (0)
+#else
+ #define set_default_output_chans(a) ss->Default_Output_Chans = a
+#endif
#define default_output_srate(ss) ss->Default_Output_Srate
-#define set_default_output_srate(a) ss->Default_Output_Srate = a
+#if HAVE_SCHEME
+ #define set_default_output_srate(a) \
+ do {\
+ ss->Default_Output_Srate = a; \
+ s7_symbol_set_value(s7, ss->default_output_srate_symbol, s7_make_integer(s7, ss->Default_Output_Srate));\
+ } while (0)
+#else
+ #define set_default_output_srate(a) ss->Default_Output_Srate = a
+#endif
-#define default_output_data_format(ss) ss->Default_Output_Data_Format
-#define set_default_output_data_format(a) ss->Default_Output_Data_Format = a
+#define default_output_sample_type(ss) ss->Default_Output_Sample_Type
+#if HAVE_SCHEME
+ #define set_default_output_sample_type(a) \
+ do {\
+ ss->Default_Output_Sample_Type = (mus_sample_t)a; \
+ s7_symbol_set_value(s7, ss->default_output_sample_type_symbol, s7_make_integer(s7, (s7_int)ss->Default_Output_Sample_Type)); \
+ } while (0)
+#else
+#define set_default_output_sample_type(a) ss->Default_Output_Sample_Type = (mus_sample_t)a
+#endif
#define dac_size(ss) ss->Dac_Size
-#define set_dac_size(a) ss->Dac_Size = a
+#if HAVE_SCHEME
+ #define set_dac_size(a) \
+ do {\
+ ss->Dac_Size = a; \
+ s7_symbol_set_value(s7, ss->dac_size_symbol, s7_make_integer(s7, ss->Dac_Size));\
+ } while (0)
+#else
+ #define set_dac_size(a) ss->Dac_Size = a
+#endif
#if (HAVE_OSS || HAVE_ALSA)
- #ifdef PPC
- /* actually linuxppc */
- #define DEFAULT_DAC_SIZE 0
- #else
- #define DEFAULT_DAC_SIZE 256
- #endif
+ #define DEFAULT_DAC_SIZE 256
#else
- #if MUS_MAC_OSX
+ #if __APPLE__
#define DEFAULT_DAC_SIZE 64
#else
#define DEFAULT_DAC_SIZE 1024
@@ -427,19 +531,51 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define dac_combines_channels(ss) ss->Dac_Combines_Channels
-#define set_dac_combines_channels(a) ss->Dac_Combines_Channels = a
+#if HAVE_SCHEME
+ #define set_dac_combines_channels(a) \
+ do {\
+ ss->Dac_Combines_Channels = a; \
+ s7_symbol_set_value(s7, ss->dac_combines_channels_symbol, s7_make_boolean(s7, ss->Dac_Combines_Channels));\
+ } while (0)
+#else
+ #define set_dac_combines_channels(a) ss->Dac_Combines_Channels = a
+#endif
#define DEFAULT_DAC_COMBINES_CHANNELS true
#define max_regions(ss) ss->Max_Regions
-#define in_set_max_regions(a) ss->Max_Regions = a
+#if HAVE_SCHEME
+ #define in_set_max_regions(a) \
+ do {\
+ ss->Max_Regions = a; \
+ s7_symbol_set_value(s7, ss->max_regions_symbol, s7_make_integer(s7, ss->Max_Regions));\
+ } while (0)
+#else
+ #define in_set_max_regions(a) ss->Max_Regions = a
+#endif
#define DEFAULT_MAX_REGIONS 16
#define max_transform_peaks(ss) ss->Max_Transform_Peaks
-#define in_set_max_transform_peaks(a) ss->Max_Transform_Peaks = a
+#if HAVE_SCHEME
+ #define in_set_max_transform_peaks(a) \
+ do {\
+ ss->Max_Transform_Peaks = a; \
+ s7_symbol_set_value(s7, ss->max_transform_peaks_symbol, s7_make_integer(s7, ss->Max_Transform_Peaks));\
+ } while (0)
+#else
+ #define in_set_max_transform_peaks(a) ss->Max_Transform_Peaks = a
+#endif
#define DEFAULT_MAX_TRANSFORM_PEAKS 100
#define auto_resize(ss) ss->Auto_Resize
-#define set_auto_resize(a) ss->Auto_Resize = a
+#if HAVE_SCHEME
+ #define set_auto_resize(a) \
+ do {\
+ ss->Auto_Resize = a; \
+ s7_symbol_set_value(s7, ss->auto_resize_symbol, s7_make_boolean(s7, ss->Auto_Resize));\
+ } while (0)
+#else
+ #define set_auto_resize(a) ss->Auto_Resize = a
+#endif
#if HAVE_GTK
#define DEFAULT_AUTO_RESIZE false
#else
@@ -447,93 +583,233 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define auto_update(ss) ss->Auto_Update
-#define set_auto_update(a) ss->Auto_Update = a
+#if HAVE_SCHEME
+ #define set_auto_update(a) \
+ do {\
+ ss->Auto_Update = a; \
+ s7_symbol_set_value(s7, ss->auto_update_symbol, s7_make_boolean(s7, ss->Auto_Update));\
+ } while (0)
+#else
+ #define set_auto_update(a) ss->Auto_Update = a
+#endif
#define DEFAULT_AUTO_UPDATE false
#define auto_update_interval(ss) ss->Auto_Update_Interval
-#define set_auto_update_interval(a) ss->Auto_Update_Interval = a
+#if HAVE_SCHEME
+ #define set_auto_update_interval(a) \
+ do {\
+ ss->Auto_Update_Interval = a; \
+ s7_symbol_set_value(s7, ss->auto_update_interval_symbol, s7_make_real(s7, ss->Auto_Update_Interval));\
+ } while (0)
+#else
+ #define set_auto_update_interval(a) ss->Auto_Update_Interval = a
+#endif
#define DEFAULT_AUTO_UPDATE_INTERVAL 60.0
#define cursor_update_interval(ss) ss->Cursor_Update_Interval
-#define set_cursor_update_interval(a) ss->Cursor_Update_Interval = a
+#if HAVE_SCHEME
+ #define set_cursor_update_interval(a) \
+ do {\
+ ss->Cursor_Update_Interval = a; \
+ s7_symbol_set_value(s7, ss->cursor_update_interval_symbol, s7_make_real(s7, ss->Cursor_Update_Interval));\
+ } while (0)
+#else
+ #define set_cursor_update_interval(a) ss->Cursor_Update_Interval = a
+#endif
#define DEFAULT_CURSOR_UPDATE_INTERVAL 0.05
#define cursor_location_offset(ss) ss->Cursor_Location_Offset
-#define set_cursor_location_offset(a) ss->Cursor_Location_Offset = a
+#if HAVE_SCHEME
+ #define set_cursor_location_offset(a) \
+ do {\
+ ss->Cursor_Location_Offset = a; \
+ s7_symbol_set_value(s7, ss->cursor_location_offset_symbol, s7_make_integer(s7, ss->Cursor_Location_Offset));\
+ } while (0)
+#else
+ #define set_cursor_location_offset(a) ss->Cursor_Location_Offset = a
+#endif
#define DEFAULT_CURSOR_LOCATION_OFFSET 0
#define color_cutoff(ss) ss->Color_Cutoff
-#define in_set_color_cutoff(a) ss->Color_Cutoff = a
+#if HAVE_SCHEME
+ #define in_set_color_cutoff(a) \
+ do {\
+ ss->Color_Cutoff = a; \
+ s7_symbol_set_value(s7, ss->color_cutoff_symbol, s7_make_real(s7, ss->Color_Cutoff));\
+ } while (0)
+#else
+ #define in_set_color_cutoff(a) ss->Color_Cutoff = a
+#endif
#define DEFAULT_COLOR_CUTOFF 0.003
#define color_inverted(ss) ss->Color_Inverted
-#define in_set_color_inverted(a) ss->Color_Inverted = a
+#if HAVE_SCHEME
+ #define in_set_color_inverted(a) \
+ do {\
+ ss->Color_Inverted = a; \
+ s7_symbol_set_value(s7, ss->color_inverted_symbol, s7_make_boolean(s7, ss->Color_Inverted));\
+ } while (0)
+#else
+ #define in_set_color_inverted(a) ss->Color_Inverted = a
+#endif
#define DEFAULT_COLOR_INVERTED true
#define color_scale(ss) ss->Color_Scale
-#define in_set_color_scale(a) ss->Color_Scale = a
+#if HAVE_SCHEME
+ #define in_set_color_scale(a) \
+ do {\
+ ss->Color_Scale = a; \
+ s7_symbol_set_value(s7, ss->color_scale_symbol, s7_make_real(s7, ss->Color_Scale));\
+ } while (0)
+#else
+ #define in_set_color_scale(a) ss->Color_Scale = a
+#endif
#define DEFAULT_COLOR_SCALE 1.0
#define fft_window_alpha(ss) ss->Fft_Window_Alpha
-#define in_set_fft_window_alpha(a) ss->Fft_Window_Alpha = a
+#if HAVE_SCHEME
+ #define in_set_fft_window_alpha(a) \
+ do {\
+ ss->Fft_Window_Alpha = a; \
+ s7_symbol_set_value(s7, ss->fft_window_alpha_symbol, s7_make_real(s7, ss->Fft_Window_Alpha));\
+ } while (0)
+#else
+ #define in_set_fft_window_alpha(a) ss->Fft_Window_Alpha = a
+#endif
#define DEFAULT_FFT_WINDOW_ALPHA 0.0
#define fft_window_beta(ss) ss->Fft_Window_Beta
-#define in_set_fft_window_beta(a) ss->Fft_Window_Beta = a
+#if HAVE_SCHEME
+ #define in_set_fft_window_beta(a) \
+ do {\
+ ss->Fft_Window_Beta = a; \
+ s7_symbol_set_value(s7, ss->fft_window_beta_symbol, s7_make_real(s7, ss->Fft_Window_Beta));\
+ } while (0)
+#else
+ #define in_set_fft_window_beta(a) ss->Fft_Window_Beta = a
+#endif
#define DEFAULT_FFT_WINDOW_BETA 0.0
#define transform_size(ss) ss->Transform_Size
-#define in_set_transform_size(a) ss->Transform_Size = a
+#if HAVE_SCHEME
+ #define in_set_transform_size(a) \
+ do {\
+ ss->Transform_Size = a; \
+ s7_symbol_set_value(s7, ss->transform_size_symbol, s7_make_integer(s7, ss->Transform_Size));\
+ } while (0)
+#else
+ #define in_set_transform_size(a) ss->Transform_Size = a
+#endif
#define DEFAULT_TRANSFORM_SIZE 512
#define transform_graph_type(ss) ss->Transform_Graph_Type
-#define in_set_transform_graph_type_1(a) ss->Transform_Graph_Type = a
+#if HAVE_SCHEME
+ #define in_set_transform_graph_type_1(a) \
+ do {\
+ ss->Transform_Graph_Type = a; \
+ s7_symbol_set_value(s7, ss->transform_graph_type_symbol, s7_make_integer(s7, ss->Transform_Graph_Type));\
+ } while (0)
+#else
+ #define in_set_transform_graph_type_1(a) ss->Transform_Graph_Type = a
+#endif
#define DEFAULT_TRANSFORM_GRAPH_TYPE GRAPH_ONCE
#define time_graph_type(ss) ss->Time_Graph_Type
-#define in_set_time_graph_type(a) ss->Time_Graph_Type = a
+#if HAVE_SCHEME
+ #define in_set_time_graph_type(a) \
+ do {\
+ ss->Time_Graph_Type = a; \
+ s7_symbol_set_value(s7, ss->time_graph_type_symbol, s7_make_integer(s7, ss->Time_Graph_Type));\
+ } while (0)
+#else
+ #define in_set_time_graph_type(a) ss->Time_Graph_Type = a
+#endif
#define DEFAULT_TIME_GRAPH_TYPE GRAPH_ONCE
#define fft_window(ss) ss->Fft_Window
-#define in_set_fft_window_1(a) ss->Fft_Window = a
+#if HAVE_SCHEME
+ #define in_set_fft_window_1(a) \
+ do {\
+ ss->Fft_Window = a; \
+ s7_symbol_set_value(s7, ss->fft_window_symbol, s7_make_integer(s7, ss->Fft_Window));\
+ } while (0)
+#else
+ #define in_set_fft_window_1(a) ss->Fft_Window = a
+#endif
#define DEFAULT_FFT_WINDOW MUS_BLACKMAN2_WINDOW
-#define trap_segfault(ss) ss->Trap_Segfault
-#define set_trap_segfault(a) ss->Trap_Segfault = a
-#define DEFAULT_TRAP_SEGFAULT true
-
#define log_freq_start(ss) ss->Log_Freq_Start
-#define in_set_log_freq_start(a) ss->Log_Freq_Start = a
+#if HAVE_SCHEME
+ #define in_set_log_freq_start(a) \
+ do {\
+ ss->Log_Freq_Start = a; \
+ s7_symbol_set_value(s7, ss->log_freq_start_symbol, s7_make_real(s7, ss->Log_Freq_Start));\
+ } while (0)
+#else
+ #define in_set_log_freq_start(a) ss->Log_Freq_Start = a
+#endif
#define DEFAULT_LOG_FREQ_START 32.0
-#define optimization(ss) ss->Optimization
-#define set_optimization(a) ss->Optimization = a
-#define DEFAULT_OPTIMIZATION 6
-
#define dot_size(ss) ss->Dot_Size
-#define in_set_dot_size(a) ss->Dot_Size = a
+#if HAVE_SCHEME
+ #define in_set_dot_size(a) \
+ do {\
+ ss->Dot_Size = a; \
+ s7_symbol_set_value(s7, ss->dot_size_symbol, s7_make_integer(s7, ss->Dot_Size));\
+ } while (0)
+#else
+ #define in_set_dot_size(a) ss->Dot_Size = a
+#endif
#define DEFAULT_DOT_SIZE 1
#define MIN_DOT_SIZE 0
#define MAX_DOT_SIZE 100
#define grid_density(ss) ss->Grid_Density
-#define in_set_grid_density(a) ss->Grid_Density = a
+#if HAVE_SCHEME
+ #define in_set_grid_density(a) \
+ do {\
+ ss->Grid_Density = a; \
+ s7_symbol_set_value(s7, ss->grid_density_symbol, s7_make_real(s7, ss->Grid_Density));\
+ } while (0)
+#else
+ #define in_set_grid_density(a) ss->Grid_Density = a
+#endif
#define DEFAULT_GRID_DENSITY 1.0
-#define minibuffer_history_length(ss) ss->Minibuffer_History_Length
-#define set_minibuffer_history_length(a) ss->Minibuffer_History_Length = a
-#define DEFAULT_MINIBUFFER_HISTORY_LENGTH 8
-
#define transform_normalization(ss) ss->Transform_Normalization
-#define in_set_transform_normalization(a) ss->Transform_Normalization = a
+#if HAVE_SCHEME
+ #define in_set_transform_normalization(a) \
+ do {\
+ ss->Transform_Normalization = a; \
+ s7_symbol_set_value(s7, ss->transform_normalization_symbol, s7_make_integer(s7, ss->Transform_Normalization));\
+ } while (0)
+#else
+ #define in_set_transform_normalization(a) ss->Transform_Normalization = a
+#endif
#define DEFAULT_TRANSFORM_NORMALIZATION NORMALIZE_BY_CHANNEL
#define ask_before_overwrite(ss) ss->Ask_Before_Overwrite
-#define set_ask_before_overwrite(a) ss->Ask_Before_Overwrite = a
+#if HAVE_SCHEME
+ #define set_ask_before_overwrite(a) \
+ do {\
+ ss->Ask_Before_Overwrite = a; \
+ s7_symbol_set_value(s7, ss->ask_before_overwrite_symbol, s7_make_boolean(s7, ss->Ask_Before_Overwrite));\
+ } while (0)
+#else
+ #define set_ask_before_overwrite(a) ss->Ask_Before_Overwrite = a
+#endif
#define DEFAULT_ASK_BEFORE_OVERWRITE false
#define with_toolbar(ss) ss->With_Toolbar
-#define set_with_toolbar(a) ss->With_Toolbar = a
+#if HAVE_SCHEME
+ #define set_with_toolbar(a) \
+ do {\
+ ss->With_Toolbar = a; \
+ s7_symbol_set_value(s7, ss->with_toolbar_symbol, s7_make_boolean(s7, ss->With_Toolbar));\
+ } while (0)
+#else
+ #define set_with_toolbar(a) ss->With_Toolbar = a
+#endif
#if USE_GTK
#define DEFAULT_WITH_TOOLBAR true
#else
@@ -541,51 +817,159 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define with_tooltips(ss) ss->With_Tooltips
-#define in_set_with_tooltips(a) ss->With_Tooltips = a
+#if HAVE_SCHEME
+ #define in_set_with_tooltips(a) \
+ do {\
+ ss->With_Tooltips = a; \
+ s7_symbol_set_value(s7, ss->with_tooltips_symbol, s7_make_boolean(s7, ss->With_Tooltips));\
+ } while (0)
+#else
+ #define in_set_with_tooltips(a) ss->With_Tooltips = a
+#endif
#define DEFAULT_WITH_TOOLTIPS true
#define with_menu_icons(ss) ss->With_Menu_Icons
-#define in_set_with_menu_icons(a) ss->With_Menu_Icons = a
-#define DEFAULT_WITH_MENU_ICONS false
+#if HAVE_SCHEME
+ #define in_set_with_menu_icons(a) \
+ do {\
+ ss->With_Menu_Icons = a; \
+ s7_symbol_set_value(s7, ss->with_menu_icons_symbol, s7_make_boolean(s7, ss->With_Menu_Icons));\
+ } while (0)
+#else
+ #define in_set_with_menu_icons(a) ss->With_Menu_Icons = a
+#endif
+#define DEFAULT_WITH_MENU_ICONS true
#define save_as_dialog_src(ss) ss->Save_As_Dialog_Src
-#define in_set_save_as_dialog_src(a) ss->Save_As_Dialog_Src = a
+#if HAVE_SCHEME
+ #define in_set_save_as_dialog_src(a) \
+ do {\
+ ss->Save_As_Dialog_Src = a; \
+ s7_symbol_set_value(s7, ss->save_as_dialog_src_symbol, s7_make_boolean(s7, ss->Save_As_Dialog_Src));\
+ } while (0)
+#else
+ #define in_set_save_as_dialog_src(a) ss->Save_As_Dialog_Src = a
+#endif
#define DEFAULT_SAVE_AS_DIALOG_SRC false
#define save_as_dialog_auto_comment(ss) ss->Save_As_Dialog_Auto_Comment
-#define in_set_save_as_dialog_auto_comment(a) ss->Save_As_Dialog_Auto_Comment = a
+#if HAVE_SCHEME
+ #define in_set_save_as_dialog_auto_comment(a) \
+ do {\
+ ss->Save_As_Dialog_Auto_Comment = a; \
+ s7_symbol_set_value(s7, ss->save_as_dialog_auto_comment_symbol, s7_make_boolean(s7, ss->Save_As_Dialog_Auto_Comment));\
+ } while (0)
+#else
+ #define in_set_save_as_dialog_auto_comment(a) ss->Save_As_Dialog_Auto_Comment = a
+#endif
#define DEFAULT_SAVE_AS_DIALOG_AUTO_COMMENT false
#define remember_sound_state(ss) ss->Remember_Sound_State
-#define set_remember_sound_state(a) ss->Remember_Sound_State = a
+#if HAVE_SCHEME
+ #define set_remember_sound_state(a) \
+ do {\
+ ss->Remember_Sound_State = a; \
+ s7_symbol_set_value(s7, ss->remember_sound_state_symbol, s7_make_boolean(s7, ss->Remember_Sound_State));\
+ } while (0)
+#else
+ #define set_remember_sound_state(a) ss->Remember_Sound_State = a
+#endif
#define DEFAULT_REMEMBER_SOUND_STATE false
#define ask_about_unsaved_edits(ss) ss->Ask_About_Unsaved_Edits
-#define set_ask_about_unsaved_edits(a) ss->Ask_About_Unsaved_Edits = a
+#if HAVE_SCHEME
+ #define set_ask_about_unsaved_edits(a) \
+ do {\
+ ss->Ask_About_Unsaved_Edits = a; \
+ s7_symbol_set_value(s7, ss->ask_about_unsaved_edits_symbol, s7_make_boolean(s7, ss->Ask_About_Unsaved_Edits));\
+ } while (0)
+#else
+ #define set_ask_about_unsaved_edits(a) ss->Ask_About_Unsaved_Edits = a
+#endif
#define DEFAULT_ASK_ABOUT_UNSAVED_EDITS false
#define show_full_duration(ss) ss->Show_Full_Duration
-#define set_show_full_duration(a) ss->Show_Full_Duration = a
+#if HAVE_SCHEME
+ #define set_show_full_duration(a) \
+ do {\
+ ss->Show_Full_Duration = a; \
+ s7_symbol_set_value(s7, ss->show_full_duration_symbol, s7_make_boolean(s7, ss->Show_Full_Duration));\
+ } while (0)
+#else
+ #define set_show_full_duration(a) ss->Show_Full_Duration = a
+#endif
#define DEFAULT_SHOW_FULL_DURATION false
#define initial_beg(ss) ss->Initial_Beg
-#define set_initial_beg(a) ss->Initial_Beg = a
+#if HAVE_SCHEME
+ #define set_initial_beg(a) \
+ do {\
+ ss->Initial_Beg = a; \
+ s7_symbol_set_value(s7, ss->initial_beg_symbol, s7_make_real(s7, ss->Initial_Beg));\
+ } while (0)
+#else
+ #define set_initial_beg(a) ss->Initial_Beg = a
+#endif
#define DEFAULT_INITIAL_BEG 0.0
#define initial_dur(ss) ss->Initial_Dur
-#define set_initial_dur(a) ss->Initial_Dur = a
+#if HAVE_SCHEME
+ #define set_initial_dur(a) \
+ do {\
+ ss->Initial_Dur = a; \
+ s7_symbol_set_value(s7, ss->initial_dur_symbol, s7_make_real(s7, ss->Initial_Dur));\
+ } while (0)
+#else
+ #define set_initial_dur(a) ss->Initial_Dur = a
+#endif
#define DEFAULT_INITIAL_DUR 0.1
+#define show_full_range(ss) ss->Show_Full_Range
+#if HAVE_SCHEME
+ #define set_show_full_range(a) \
+ do {\
+ ss->Show_Full_Range = a; \
+ s7_symbol_set_value(s7, ss->show_full_range_symbol, s7_make_boolean(s7, ss->Show_Full_Range));\
+ } while (0)
+#else
+ #define set_show_full_range(a) ss->Show_Full_Range = a
+#endif
+#define DEFAULT_SHOW_FULL_RANGE false
+
#define spectrum_end(ss) ss->Spectrum_End
-#define in_set_spectrum_end(a) ss->Spectrum_End = a
+#if HAVE_SCHEME
+ #define in_set_spectrum_end(a) \
+ do {\
+ ss->Spectrum_End = a; \
+ s7_symbol_set_value(s7, ss->spectrum_end_symbol, s7_make_real(s7, ss->Spectrum_End));\
+ } while (0)
+#else
+ #define in_set_spectrum_end(a) ss->Spectrum_End = a
+#endif
#define DEFAULT_SPECTRUM_END 1.0
#define spectrum_start(ss) ss->Spectrum_Start
-#define in_set_spectrum_start(a) ss->Spectrum_Start = a
+#if HAVE_SCHEME
+ #define in_set_spectrum_start(a) \
+ do {\
+ ss->Spectrum_Start = a; \
+ s7_symbol_set_value(s7, ss->spectrum_start_symbol, s7_make_real(s7, ss->Spectrum_Start));\
+ } while (0)
+#else
+ #define in_set_spectrum_start(a) ss->Spectrum_Start = a
+#endif
#define DEFAULT_SPECTRUM_START 0.0
#define spectro_x_angle(ss) ss->Spectro_X_Angle
-#define in_set_spectro_x_angle(a) ss->Spectro_X_Angle = a
+#if HAVE_SCHEME
+ #define in_set_spectro_x_angle(a) \
+ do {\
+ ss->Spectro_X_Angle = a; \
+ s7_symbol_set_value(s7, ss->spectro_x_angle_symbol, s7_make_real(s7, ss->Spectro_X_Angle));\
+ } while (0)
+#else
+ #define in_set_spectro_x_angle(a) ss->Spectro_X_Angle = a
+#endif
#if HAVE_GL
#define DEFAULT_SPECTRO_X_ANGLE 300.0
#else
@@ -593,7 +977,15 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define spectro_y_angle(ss) ss->Spectro_Y_Angle
-#define in_set_spectro_y_angle(a) ss->Spectro_Y_Angle = a
+#if HAVE_SCHEME
+ #define in_set_spectro_y_angle(a) \
+ do {\
+ ss->Spectro_Y_Angle = a; \
+ s7_symbol_set_value(s7, ss->spectro_y_angle_symbol, s7_make_real(s7, ss->Spectro_Y_Angle));\
+ } while (0)
+#else
+ #define in_set_spectro_y_angle(a) ss->Spectro_Y_Angle = a
+#endif
#if HAVE_GL
#define DEFAULT_SPECTRO_Y_ANGLE 320.0
#else
@@ -601,7 +993,15 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define spectro_z_angle(ss) ss->Spectro_Z_Angle
-#define in_set_spectro_z_angle(a) ss->Spectro_Z_Angle = a
+#if HAVE_SCHEME
+ #define in_set_spectro_z_angle(a) \
+ do {\
+ ss->Spectro_Z_Angle = a; \
+ s7_symbol_set_value(s7, ss->spectro_z_angle_symbol, s7_make_real(s7, ss->Spectro_Z_Angle));\
+ } while (0)
+#else
+ #define in_set_spectro_z_angle(a) ss->Spectro_Z_Angle = a
+#endif
#if HAVE_GL
#define DEFAULT_SPECTRO_Z_ANGLE 0.0
#else
@@ -609,7 +1009,15 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define spectro_x_scale(ss) ss->Spectro_X_Scale
-#define in_set_spectro_x_scale(a) ss->Spectro_X_Scale = a
+#if HAVE_SCHEME
+ #define in_set_spectro_x_scale(a) \
+ do {\
+ ss->Spectro_X_Scale = a; \
+ s7_symbol_set_value(s7, ss->spectro_x_scale_symbol, s7_make_real(s7, ss->Spectro_X_Scale));\
+ } while (0)
+#else
+ #define in_set_spectro_x_scale(a) ss->Spectro_X_Scale = a
+#endif
#if HAVE_GL
#define DEFAULT_SPECTRO_X_SCALE 1.5
#define SPECTRO_X_SCALE_MAX 4.0
@@ -619,7 +1027,15 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define spectro_y_scale(ss) ss->Spectro_Y_Scale
-#define in_set_spectro_y_scale(a) ss->Spectro_Y_Scale = a
+#if HAVE_SCHEME
+ #define in_set_spectro_y_scale(a) \
+ do {\
+ ss->Spectro_Y_Scale = a; \
+ s7_symbol_set_value(s7, ss->spectro_y_scale_symbol, s7_make_real(s7, ss->Spectro_Y_Scale));\
+ } while (0)
+#else
+ #define in_set_spectro_y_scale(a) ss->Spectro_Y_Scale = a
+#endif
#if HAVE_GL
#define DEFAULT_SPECTRO_Y_SCALE 1.0
#define SPECTRO_Y_SCALE_MAX 4.0
@@ -629,7 +1045,15 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define spectro_z_scale(ss) ss->Spectro_Z_Scale
-#define in_set_spectro_z_scale(a) ss->Spectro_Z_Scale = a
+#if HAVE_SCHEME
+ #define in_set_spectro_z_scale(a) \
+ do {\
+ ss->Spectro_Z_Scale = a; \
+ s7_symbol_set_value(s7, ss->spectro_z_scale_symbol, s7_make_real(s7, ss->Spectro_Z_Scale));\
+ } while (0)
+#else
+ #define in_set_spectro_z_scale(a) ss->Spectro_Z_Scale = a
+#endif
#if HAVE_GL
#define DEFAULT_SPECTRO_Z_SCALE 1.0
#define SPECTRO_Z_SCALE_MAX 4.0
@@ -639,131 +1063,399 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define spectro_hop(ss) ss->Spectro_Hop
-#define in_set_spectro_hop(a) ss->Spectro_Hop = a
+#if HAVE_SCHEME
+ #define in_set_spectro_hop(a) \
+ do {\
+ ss->Spectro_Hop = a; \
+ s7_symbol_set_value(s7, ss->spectro_hop_symbol, s7_make_integer(s7, ss->Spectro_Hop));\
+ } while (0)
+#else
+ #define in_set_spectro_hop(a) ss->Spectro_Hop = a
+#endif
#define DEFAULT_SPECTRO_HOP 4
#define color_map(ss) ss->Color_Map
-#define in_set_color_map(a) ss->Color_Map = a
+#if HAVE_SCHEME
+ #define in_set_color_map(a) \
+ do {\
+ ss->Color_Map = a; \
+ s7_symbol_set_value(s7, ss->color_map_symbol, s7_make_integer(s7, ss->Color_Map));\
+ } while (0)
+#else
+ #define in_set_color_map(a) ss->Color_Map = a
+#endif
#define DEFAULT_COLOR_MAP 2
#define color_map_size(ss) ss->Color_Map_Size
-#define set_color_map_size(a) ss->Color_Map_Size = a
+#if HAVE_SCHEME
+ #define set_color_map_size(a) \
+ do {\
+ ss->Color_Map_Size = a; \
+ s7_symbol_set_value(s7, ss->color_map_size_symbol, s7_make_integer(s7, ss->Color_Map_Size));\
+ } while (0)
+#else
+ #define set_color_map_size(a) ss->Color_Map_Size = a
+#endif
#define DEFAULT_COLOR_MAP_SIZE 512
#define graph_style(ss) ss->Graph_Style
-#define in_set_graph_style(a) ss->Graph_Style = a
+#if HAVE_SCHEME
+ #define in_set_graph_style(a) \
+ do {\
+ ss->Graph_Style = a; \
+ s7_symbol_set_value(s7, ss->graph_style_symbol, s7_make_integer(s7, ss->Graph_Style));\
+ } while (0)
+#else
+ #define in_set_graph_style(a) ss->Graph_Style = a
+#endif
#define DEFAULT_GRAPH_STYLE GRAPH_LINES
#define region_graph_style(ss) ss->Region_Graph_Style
-#define set_region_graph_style(a) ss->Region_Graph_Style = a
+#if HAVE_SCHEME
+ #define set_region_graph_style(a) \
+ do {\
+ ss->Region_Graph_Style = a; \
+ s7_symbol_set_value(s7, ss->region_graph_style_symbol, s7_make_integer(s7, ss->Region_Graph_Style));\
+ } while (0)
+#else
+ #define set_region_graph_style(a) ss->Region_Graph_Style = a
+#endif
#define sinc_width(ss) ss->Sinc_Width
-#define set_sinc_width(a) ss->Sinc_Width = a
+#if HAVE_SCHEME
+ #define set_sinc_width(a) \
+ do {\
+ ss->Sinc_Width = a; \
+ s7_symbol_set_value(s7, ss->sinc_width_symbol, s7_make_integer(s7, ss->Sinc_Width));\
+ } while (0)
+#else
+ #define set_sinc_width(a) ss->Sinc_Width = a
+#endif
#define DEFAULT_SINC_WIDTH 10
-#define verbose_cursor(ss) ss->Verbose_Cursor
-#define in_set_verbose_cursor(a) ss->Verbose_Cursor = a
-#define DEFAULT_VERBOSE_CURSOR false
+#define with_verbose_cursor(ss) ss->With_Verbose_Cursor
+#if HAVE_SCHEME
+ #define in_set_with_verbose_cursor(a) \
+ do {\
+ ss->With_Verbose_Cursor = a; \
+ s7_symbol_set_value(s7, ss->with_verbose_cursor_symbol, s7_make_boolean(s7, ss->With_Verbose_Cursor));\
+ } while (0)
+#else
+ #define in_set_with_verbose_cursor(a) ss->With_Verbose_Cursor = a
+#endif
+#define DEFAULT_WITH_VERBOSE_CURSOR false
#define with_inset_graph(ss) ss->With_Inset_Graph
-#define set_with_inset_graph(a) ss->With_Inset_Graph = a
+#if HAVE_SCHEME
+ #define set_with_inset_graph(a) \
+ do {\
+ ss->With_Inset_Graph = a; \
+ s7_symbol_set_value(s7, ss->with_inset_graph_symbol, s7_make_boolean(s7, ss->With_Inset_Graph));\
+ } while (0)
+#else
+ #define set_with_inset_graph(a) ss->With_Inset_Graph = a
+#endif
#define DEFAULT_WITH_INSET_GRAPH false
+#define with_interrupts(ss) ss->With_Interrupts
+#if HAVE_SCHEME
+ #define set_with_interrupts(a) \
+ do {\
+ ss->With_Interrupts = a; \
+ s7_symbol_set_value(s7, ss->with_interrupts_symbol, s7_make_boolean(s7, ss->With_Interrupts));\
+ } while (0)
+#else
+ #define set_with_interrupts(a) ss->With_Interrupts = a
+#endif
+#define DEFAULT_WITH_INTERRUPTS true
+
#define with_smpte_label(ss) ss->With_Smpte_Label
-#define set_with_smpte_label(a) ss->With_Smpte_Label = a
+#if HAVE_SCHEME
+ #define set_with_smpte_label(a) \
+ do {\
+ ss->With_Smpte_Label = a; \
+ s7_symbol_set_value(s7, ss->with_smpte_label_symbol, s7_make_boolean(s7, ss->With_Smpte_Label));\
+ } while (0)
+#else
+ #define set_with_smpte_label(a) ss->With_Smpte_Label = a
+#endif
#define DEFAULT_WITH_SMPTE_LABEL false
#define with_pointer_focus(ss) ss->With_Pointer_Focus
-#define set_with_pointer_focus(a) ss->With_Pointer_Focus = a
+#if HAVE_SCHEME
+ #define set_with_pointer_focus(a) \
+ do {\
+ ss->With_Pointer_Focus = a; \
+ s7_symbol_set_value(s7, ss->with_pointer_focus_symbol, s7_make_boolean(s7, ss->With_Pointer_Focus));\
+ } while (0)
+#else
+ #define set_with_pointer_focus(a) ss->With_Pointer_Focus = a
+#endif
#define DEFAULT_WITH_POINTER_FOCUS false
#define selection_creates_region(ss) ss->Selection_Creates_Region
-#define set_selection_creates_region(a) ss->Selection_Creates_Region = a
+#if HAVE_SCHEME
+ #define set_selection_creates_region(a) \
+ do {\
+ ss->Selection_Creates_Region = a; \
+ s7_symbol_set_value(s7, ss->selection_creates_region_symbol, s7_make_boolean(s7, ss->Selection_Creates_Region));\
+ } while (0)
+#else
+ #define set_selection_creates_region(a) ss->Selection_Creates_Region = a
+#endif
#define DEFAULT_SELECTION_CREATES_REGION true
#define zoom_focus_style(ss) ss->Zoom_Focus_Style
-#define set_zoom_focus_style(a) ss->Zoom_Focus_Style = a
+#if HAVE_SCHEME
+ #define set_zoom_focus_style(a) \
+ do {\
+ ss->Zoom_Focus_Style = a; \
+ s7_symbol_set_value(s7, ss->zoom_focus_style_symbol, s7_make_integer(s7, ss->Zoom_Focus_Style));\
+ } while (0)
+#else
+ #define set_zoom_focus_style(a) ss->Zoom_Focus_Style = a
+#endif
#define DEFAULT_ZOOM_FOCUS_STYLE ZOOM_FOCUS_ACTIVE
#define eps_file(ss) ss->Eps_File
-#define set_eps_file(a) ss->Eps_File = a
+#if HAVE_SCHEME
+ #define set_eps_file(a) \
+ do {\
+ ss->Eps_File = a; \
+ s7_symbol_set_value(s7, ss->eps_file_symbol, s7_make_string(s7, ss->Eps_File));\
+ } while (0)
+#else
+ #define set_eps_file(a) ss->Eps_File = a
+#endif
#define DEFAULT_EPS_FILE "snd.eps"
#define eps_left_margin(ss) ss->Eps_Left_Margin
-#define set_eps_left_margin(a) ss->Eps_Left_Margin = a
+#if HAVE_SCHEME
+ #define set_eps_left_margin(a) \
+ do {\
+ ss->Eps_Left_Margin = a; \
+ s7_symbol_set_value(s7, ss->eps_left_margin_symbol, s7_make_real(s7, ss->Eps_Left_Margin));\
+ } while (0)
+#else
+ #define set_eps_left_margin(a) ss->Eps_Left_Margin = a
+#endif
#define DEFAULT_EPS_LEFT_MARGIN 0.0
#define eps_bottom_margin(ss) ss->Eps_Bottom_Margin
-#define set_eps_bottom_margin(a) ss->Eps_Bottom_Margin = a
+#if HAVE_SCHEME
+ #define set_eps_bottom_margin(a) \
+ do {\
+ ss->Eps_Bottom_Margin = a; \
+ s7_symbol_set_value(s7, ss->eps_bottom_margin_symbol, s7_make_real(s7, ss->Eps_Bottom_Margin));\
+ } while (0)
+#else
+ #define set_eps_bottom_margin(a) ss->Eps_Bottom_Margin = a
+#endif
#define DEFAULT_EPS_BOTTOM_MARGIN 0.0
#define eps_size(ss) ss->Eps_Size
-#define set_eps_size(a) ss->Eps_Size = a
+#if HAVE_SCHEME
+ #define set_eps_size(a) \
+ do {\
+ ss->Eps_Size = a; \
+ s7_symbol_set_value(s7, ss->eps_size_symbol, s7_make_real(s7, ss->Eps_Size));\
+ } while (0)
+#else
+ #define set_eps_size(a) ss->Eps_Size = a
+#endif
#define DEFAULT_EPS_SIZE 1.0
#define tiny_font(ss) ss->Tiny_Font
-#define in_set_tiny_font(a) ss->Tiny_Font = a
+#if HAVE_SCHEME
+ #define in_set_tiny_font(a) \
+ do {\
+ ss->Tiny_Font = a; \
+ s7_symbol_set_value(s7, ss->tiny_font_symbol, s7_make_string(s7, ss->Tiny_Font));\
+ } while (0)
+#else
+ #define in_set_tiny_font(a) ss->Tiny_Font = a
+#endif
#define peaks_font(ss) ss->Peaks_Font
-#define in_set_peaks_font(a) ss->Peaks_Font = a
+#if HAVE_SCHEME
+ #define in_set_peaks_font(a) \
+ do {\
+ ss->Peaks_Font = a; \
+ s7_symbol_set_value(s7, ss->peaks_font_symbol, s7_make_string(s7, ss->Peaks_Font));\
+ } while (0)
+#else
+ #define in_set_peaks_font(a) ss->Peaks_Font = a
+#endif
#define bold_peaks_font(ss) ss->Bold_Peaks_Font
-#define in_set_bold_peaks_font(a) ss->Bold_Peaks_Font = a
+#if HAVE_SCHEME
+ #define in_set_bold_peaks_font(a) \
+ do {\
+ ss->Bold_Peaks_Font = a; \
+ s7_symbol_set_value(s7, ss->bold_peaks_font_symbol, s7_make_string(s7, ss->Bold_Peaks_Font));\
+ } while (0)
+#else
+ #define in_set_bold_peaks_font(a) ss->Bold_Peaks_Font = a
+#endif
#define axis_label_font(ss) ss->Axis_Label_Font
-#define in_set_axis_label_font(a) ss->Axis_Label_Font = a
+#if HAVE_SCHEME
+ #define in_set_axis_label_font(a) \
+ do {\
+ ss->Axis_Label_Font = a; \
+ s7_symbol_set_value(s7, ss->axis_label_font_symbol, s7_make_string(s7, ss->Axis_Label_Font));\
+ } while (0)
+#else
+ #define in_set_axis_label_font(a) ss->Axis_Label_Font = a
+#endif
#define axis_numbers_font(ss) ss->Axis_Numbers_Font
-#define in_set_axis_numbers_font(a) ss->Axis_Numbers_Font = a
+#if HAVE_SCHEME
+ #define in_set_axis_numbers_font(a) \
+ do {\
+ ss->Axis_Numbers_Font = a; \
+ s7_symbol_set_value(s7, ss->axis_numbers_font_symbol, s7_make_string(s7, ss->Axis_Numbers_Font));\
+ } while (0)
+#else
+ #define in_set_axis_numbers_font(a) ss->Axis_Numbers_Font = a
+#endif
#define listener_font(ss) ss->Listener_Font
-#define in_set_listener_font(a) ss->Listener_Font = a
+#if HAVE_SCHEME
+ #define in_set_listener_font(a) \
+ do {\
+ ss->Listener_Font = a; \
+ s7_symbol_set_value(s7, ss->listener_font_symbol, s7_make_string(s7, ss->Listener_Font));\
+ } while (0)
+#else
+ #define in_set_listener_font(a) ss->Listener_Font = a
+#endif
#define save_state_file(ss) ss->Save_State_File
-#define in_set_save_state_file(a) ss->Save_State_File = a
-#define DEFAULT_SAVE_STATE_FILE "saved-snd." XEN_FILE_EXTENSION
+#if HAVE_SCHEME
+ #define in_set_save_state_file(a) \
+ do {\
+ ss->Save_State_File = a; \
+ s7_symbol_set_value(s7, ss->save_state_file_symbol, s7_make_string(s7, ss->Save_State_File));\
+ } while (0)
+#else
+ #define in_set_save_state_file(a) ss->Save_State_File = a
+#endif
+#define DEFAULT_SAVE_STATE_FILE "saved-snd." Xen_file_extension
#define temp_dir(ss) ss->Temp_Dir
-#define set_temp_dir(a) ss->Temp_Dir = a
+#if HAVE_SCHEME
+ #define set_temp_dir(a) \
+ do {\
+ ss->Temp_Dir = a; \
+ s7_symbol_set_value(s7, ss->temp_dir_symbol, s7_make_string(s7, ss->Temp_Dir));\
+ } while (0)
+#else
+ #define set_temp_dir(a) ss->Temp_Dir = a
+#endif
#ifndef MUS_DEFAULT_TEMP_DIR
#define MUS_DEFAULT_TEMP_DIR NULL
#endif
#define save_dir(ss) ss->Save_Dir
-#define set_save_dir(a) ss->Save_Dir = a
+#if HAVE_SCHEME
+ #define set_save_dir(a) \
+ do {\
+ ss->Save_Dir = a; \
+ s7_symbol_set_value(s7, ss->save_dir_symbol, s7_make_string(s7, ss->Save_Dir));\
+ } while (0)
+#else
+ #define set_save_dir(a) ss->Save_Dir = a
+#endif
#ifndef MUS_DEFAULT_SAVE_DIR
#define MUS_DEFAULT_SAVE_DIR NULL
#endif
#define ladspa_dir(ss) ss->Ladspa_Dir
-#define set_ladspa_dir(a) ss->Ladspa_Dir = a
+#if HAVE_SCHEME
+ #define set_ladspa_dir(a) \
+ do {\
+ ss->Ladspa_Dir = a; \
+ s7_symbol_set_value(s7, ss->ladspa_dir_symbol, s7_make_string(s7, ss->Ladspa_Dir));\
+ } while (0)
+#else
+ #define set_ladspa_dir(a) ss->Ladspa_Dir = a
+#endif
#ifndef DEFAULT_LADSPA_DIR
#define DEFAULT_LADSPA_DIR NULL
#endif
#define peak_env_dir(ss) ss->Peak_Env_Dir
-#define set_peak_env_dir(a) ss->Peak_Env_Dir = a
+#if HAVE_SCHEME
+ #define set_peak_env_dir(a) \
+ do {\
+ ss->Peak_Env_Dir = a; \
+ s7_symbol_set_value(s7, ss->peak_env_dir_symbol, s7_make_string(s7, ss->Peak_Env_Dir));\
+ } while (0)
+#else
+ #define set_peak_env_dir(a) ss->Peak_Env_Dir = a
+#endif
#ifndef DEFAULT_PEAK_ENV_DIR
#define DEFAULT_PEAK_ENV_DIR NULL
#endif
#define open_file_dialog_directory(ss) ss->Open_File_Dialog_Directory
-#define set_open_file_dialog_directory(a) ss->Open_File_Dialog_Directory = a
+#if HAVE_SCHEME
+ #define set_open_file_dialog_directory(a) \
+ do {\
+ ss->Open_File_Dialog_Directory = a; \
+ s7_symbol_set_value(s7, ss->open_file_dialog_directory_symbol, s7_make_string(s7, ss->Open_File_Dialog_Directory));\
+ } while (0)
+#else
+ #define set_open_file_dialog_directory(a) ss->Open_File_Dialog_Directory = a
+#endif
#define wavelet_type(ss) ss->Wavelet_Type
-#define in_set_wavelet_type(a) ss->Wavelet_Type = a
+#if HAVE_SCHEME
+ #define in_set_wavelet_type(a) \
+ do {\
+ ss->Wavelet_Type = a; \
+ s7_symbol_set_value(s7, ss->wavelet_type_symbol, s7_make_integer(s7, ss->Wavelet_Type));\
+ } while (0)
+#else
+ #define in_set_wavelet_type(a) ss->Wavelet_Type = a
+#endif
#define DEFAULT_WAVELET_TYPE 0
#define transform_type(ss) ss->Transform_Type
-#define in_set_transform_type(a) ss->Transform_Type = a
+#if HAVE_SCHEME
+ #define in_set_transform_type(a) \
+ do {\
+ ss->Transform_Type = a; \
+ s7_symbol_set_value(s7, ss->transform_type_symbol, s7_make_integer(s7, ss->Transform_Type));\
+ } while (0)
+#else
+ #define in_set_transform_type(a) ss->Transform_Type = a
+#endif
#define DEFAULT_TRANSFORM_TYPE FOURIER
#define show_selection_transform(ss) ss->Show_Selection_Transform
-#define in_set_show_selection_transform(a) ss->Show_Selection_Transform = a
+#if HAVE_SCHEME
+ #define in_set_show_selection_transform(a) \
+ do {\
+ ss->Show_Selection_Transform = a; \
+ s7_symbol_set_value(s7, ss->show_selection_transform_symbol, s7_make_boolean(s7, ss->Show_Selection_Transform));\
+ } while (0)
+#else
+ #define in_set_show_selection_transform(a) ss->Show_Selection_Transform = a
+#endif
#define DEFAULT_SHOW_SELECTION_TRANSFORM false
#define with_mix_tags(ss) ss->With_Mix_Tags
-#define set_with_mix_tags(a) ss->With_Mix_Tags = a
+#if HAVE_SCHEME
+ #define set_with_mix_tags(a) \
+ do {\
+ ss->With_Mix_Tags = a; \
+ s7_symbol_set_value(s7, ss->with_mix_tags_symbol, s7_make_boolean(s7, ss->With_Mix_Tags));\
+ } while (0)
+#else
+ #define set_with_mix_tags(a) ss->With_Mix_Tags = a
+#endif
#if USE_NO_GUI
#define DEFAULT_WITH_MIX_TAGS false
#else
@@ -771,11 +1463,27 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define with_relative_panes(ss) ss->With_Relative_Panes
-#define set_with_relative_panes(a) ss->With_Relative_Panes = a
+#if HAVE_SCHEME
+ #define set_with_relative_panes(a) \
+ do {\
+ ss->With_Relative_Panes = a; \
+ s7_symbol_set_value(s7, ss->with_relative_panes_symbol, s7_make_boolean(s7, ss->With_Relative_Panes));\
+ } while (0)
+#else
+ #define set_with_relative_panes(a) ss->With_Relative_Panes = a
+#endif
#define DEFAULT_WITH_RELATIVE_PANES true
#define with_gl(ss) ss->With_GL
-#define in_set_with_gl(a) ss->With_GL = a
+#if HAVE_SCHEME
+ #define in_set_with_gl(a) \
+ do {\
+ ss->With_GL = a; \
+ s7_symbol_set_value(s7, ss->with_gl_symbol, s7_make_boolean(s7, ss->With_GL));\
+ } while (0)
+#else
+ #define in_set_with_gl(a) ss->With_GL = a
+#endif
#if HAVE_GL
#define DEFAULT_WITH_GL true
#else
@@ -783,108 +1491,304 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#endif
#define with_background_processes(ss) ss->With_Background_Processes
-#define set_with_background_processes(a) ss->With_Background_Processes = a
+#if HAVE_SCHEME
+ #define set_with_background_processes(a) \
+ do {\
+ ss->With_Background_Processes = a; \
+ s7_symbol_set_value(s7, ss->with_background_processes_symbol, s7_make_boolean(s7, ss->With_Background_Processes));\
+ } while (0)
+#else
+ #define set_with_background_processes(a) ss->With_Background_Processes = a
+#endif
#define DEFAULT_WITH_BACKGROUND_PROCESSES true
#define with_file_monitor(ss) ss->With_File_Monitor
-#define set_with_file_monitor(a) ss->With_File_Monitor = a
+#if HAVE_SCHEME
+ #define set_with_file_monitor(a) \
+ do {\
+ ss->With_File_Monitor = a; \
+ s7_symbol_set_value(s7, ss->with_file_monitor_symbol, s7_make_boolean(s7, ss->With_File_Monitor));\
+ } while (0)
+#else
+ #define set_with_file_monitor(a) ss->With_File_Monitor = a
+#endif
#define DEFAULT_WITH_FILE_MONITOR true
#define wavo_hop(ss) ss->Wavo_Hop
-#define in_set_wavo_hop(a) ss->Wavo_Hop = a
+#if HAVE_SCHEME
+ #define in_set_wavo_hop(a) \
+ do {\
+ ss->Wavo_Hop = a; \
+ s7_symbol_set_value(s7, ss->wavo_hop_symbol, s7_make_integer(s7, ss->Wavo_Hop));\
+ } while (0)
+#else
+ #define in_set_wavo_hop(a) ss->Wavo_Hop = a
+#endif
#define DEFAULT_WAVO_HOP 3
#define wavo_trace(ss) ss->Wavo_Trace
-#define in_set_wavo_trace(a) ss->Wavo_Trace = a
+#if HAVE_SCHEME
+ #define in_set_wavo_trace(a) \
+ do {\
+ ss->Wavo_Trace = a; \
+ s7_symbol_set_value(s7, ss->wavo_trace_symbol, s7_make_integer(s7, ss->Wavo_Trace));\
+ } while (0)
+#else
+ #define in_set_wavo_trace(a) ss->Wavo_Trace = a
+#endif
#define DEFAULT_WAVO_TRACE 64
#define x_axis_style(ss) ss->X_Axis_Style
-#define in_set_x_axis_style(a) ss->X_Axis_Style = a
+#if HAVE_SCHEME
+ #define in_set_x_axis_style(a) \
+ do {\
+ ss->X_Axis_Style = a; \
+ s7_symbol_set_value(s7, ss->x_axis_style_symbol, s7_make_integer(s7, ss->X_Axis_Style));\
+ } while (0)
+#else
+ #define in_set_x_axis_style(a) ss->X_Axis_Style = a
+#endif
#define DEFAULT_X_AXIS_STYLE X_AXIS_IN_SECONDS
#define beats_per_minute(ss) ss->Beats_Per_Minute
-#define in_set_beats_per_minute(a) ss->Beats_Per_Minute = a
+#if HAVE_SCHEME
+ #define in_set_beats_per_minute(a) \
+ do {\
+ ss->Beats_Per_Minute = a; \
+ s7_symbol_set_value(s7, ss->beats_per_minute_symbol, s7_make_real(s7, ss->Beats_Per_Minute));\
+ } while (0)
+#else
+ #define in_set_beats_per_minute(a) ss->Beats_Per_Minute = a
+#endif
#define DEFAULT_BEATS_PER_MINUTE 60.0
#define beats_per_measure(ss) ss->Beats_Per_Measure
-#define in_set_beats_per_measure(a) ss->Beats_Per_Measure = a
+#if HAVE_SCHEME
+ #define in_set_beats_per_measure(a) \
+ do {\
+ ss->Beats_Per_Measure = a; \
+ s7_symbol_set_value(s7, ss->beats_per_measure_symbol, s7_make_integer(s7, ss->Beats_Per_Measure));\
+ } while (0)
+#else
+ #define in_set_beats_per_measure(a) ss->Beats_Per_Measure = a
+#endif
#define DEFAULT_BEATS_PER_MEASURE 4
#define zero_pad(ss) ss->Zero_Pad
-#define in_set_zero_pad(a) ss->Zero_Pad = a
+#if HAVE_SCHEME
+ #define in_set_zero_pad(a) \
+ do {\
+ ss->Zero_Pad = a; \
+ s7_symbol_set_value(s7, ss->zero_pad_symbol, s7_make_integer(s7, ss->Zero_Pad));\
+ } while (0)
+#else
+ #define in_set_zero_pad(a) ss->Zero_Pad = a
+#endif
#define DEFAULT_ZERO_PAD 0
#define MAX_ZERO_PAD 1000
#define show_transform_peaks(ss) ss->Show_Transform_Peaks
-#define in_set_show_transform_peaks(a) ss->Show_Transform_Peaks = a
+#if HAVE_SCHEME
+ #define in_set_show_transform_peaks(a) \
+ do {\
+ ss->Show_Transform_Peaks = a; \
+ s7_symbol_set_value(s7, ss->show_transform_peaks_symbol, s7_make_boolean(s7, ss->Show_Transform_Peaks));\
+ } while (0)
+#else
+ #define in_set_show_transform_peaks(a) ss->Show_Transform_Peaks = a
+#endif
#define DEFAULT_SHOW_TRANSFORM_PEAKS false
#define show_indices(ss) ss->Show_Indices
-#define set_show_indices(a) ss->Show_Indices = a
+#if HAVE_SCHEME
+ #define set_show_indices(a) \
+ do {\
+ ss->Show_Indices = a; \
+ s7_symbol_set_value(s7, ss->show_indices_symbol, s7_make_boolean(s7, ss->Show_Indices));\
+ } while (0)
+#else
+ #define set_show_indices(a) ss->Show_Indices = a
+#endif
#define DEFAULT_SHOW_INDICES false
-#define show_backtrace(ss) ss->Show_Backtrace
-#define set_show_backtrace(a) ss->Show_Backtrace = a
-#define DEFAULT_SHOW_BACKTRACE false
-
#define show_y_zero(ss) ss->Show_Y_Zero
-#define in_set_show_y_zero(a) ss->Show_Y_Zero = a
+#if HAVE_SCHEME
+ #define in_set_show_y_zero(a) \
+ do {\
+ ss->Show_Y_Zero = a; \
+ s7_symbol_set_value(s7, ss->show_y_zero_symbol, s7_make_boolean(s7, ss->Show_Y_Zero));\
+ } while (0)
+#else
+ #define in_set_show_y_zero(a) ss->Show_Y_Zero = a
+#endif
#define DEFAULT_SHOW_Y_ZERO false
#define show_grid(ss) ss->Show_Grid
-#define in_set_show_grid(a) ss->Show_Grid = a
+#if HAVE_SCHEME
+ #define in_set_show_grid(a) \
+ do {\
+ ss->Show_Grid = a; \
+ s7_symbol_set_value(s7, ss->show_grid_symbol, s7_make_boolean(s7, ss->Show_Grid));\
+ } while (0)
+#else
+ #define in_set_show_grid(a) ss->Show_Grid = a
+#endif
#define DEFAULT_SHOW_GRID NO_GRID
#define show_sonogram_cursor(ss) ss->Show_Sonogram_Cursor
-#define in_set_show_sonogram_cursor(a) ss->Show_Sonogram_Cursor = a
+#if HAVE_SCHEME
+ #define in_set_show_sonogram_cursor(a) \
+ do {\
+ ss->Show_Sonogram_Cursor = a; \
+ s7_symbol_set_value(s7, ss->show_sonogram_cursor_symbol, s7_make_boolean(s7, ss->Show_Sonogram_Cursor));\
+ } while (0)
+#else
+ #define in_set_show_sonogram_cursor(a) ss->Show_Sonogram_Cursor = a
+#endif
#define DEFAULT_SHOW_SONOGRAM_CURSOR false
#define show_axes(ss) ss->Show_Axes
-#define in_set_show_axes(a) ss->Show_Axes = a
+#if HAVE_SCHEME
+ #define in_set_show_axes(a) \
+ do {\
+ ss->Show_Axes = a; \
+ s7_symbol_set_value(s7, ss->show_axes_symbol, s7_make_integer(s7, ss->Show_Axes));\
+ } while (0)
+#else
+ #define in_set_show_axes(a) ss->Show_Axes = a
+#endif
#define DEFAULT_SHOW_AXES SHOW_ALL_AXES
#define show_mix_waveforms(ss) ss->Show_Mix_Waveforms
-#define in_set_show_mix_waveforms(a) ss->Show_Mix_Waveforms = a
+#if HAVE_SCHEME
+ #define in_set_show_mix_waveforms(a) \
+ do {\
+ ss->Show_Mix_Waveforms = a; \
+ s7_symbol_set_value(s7, ss->show_mix_waveforms_symbol, s7_make_boolean(s7, ss->Show_Mix_Waveforms));\
+ } while (0)
+#else
+ #define in_set_show_mix_waveforms(a) ss->Show_Mix_Waveforms = a
+#endif
#define DEFAULT_SHOW_MIX_WAVEFORMS true
#define mix_waveform_height(ss) ss->Mix_Waveform_Height
-#define in_set_mix_waveform_height(a) ss->Mix_Waveform_Height = a
+#if HAVE_SCHEME
+ #define in_set_mix_waveform_height(a) \
+ do {\
+ ss->Mix_Waveform_Height = a; \
+ s7_symbol_set_value(s7, ss->mix_waveform_height_symbol, s7_make_integer(s7, ss->Mix_Waveform_Height));\
+ } while (0)
+#else
+ #define in_set_mix_waveform_height(a) ss->Mix_Waveform_Height = a
+#endif
#define DEFAULT_MIX_WAVEFORM_HEIGHT 20
#define show_marks(ss) ss->Show_Marks
-#define in_set_show_marks(a) ss->Show_Marks = a
+#if HAVE_SCHEME
+ #define in_set_show_marks(a) \
+ do {\
+ ss->Show_Marks = a; \
+ s7_symbol_set_value(s7, ss->show_marks_symbol, s7_make_boolean(s7, ss->Show_Marks));\
+ } while (0)
+#else
+ #define in_set_show_marks(a) ss->Show_Marks = a
+#endif
#define DEFAULT_SHOW_MARKS true
#define fft_log_magnitude(ss) ss->Fft_Log_Magnitude
-#define in_set_fft_log_magnitude(a) ss->Fft_Log_Magnitude = a
+#if HAVE_SCHEME
+ #define in_set_fft_log_magnitude(a) \
+ do {\
+ ss->Fft_Log_Magnitude = a; \
+ s7_symbol_set_value(s7, ss->fft_log_magnitude_symbol, s7_make_boolean(s7, ss->Fft_Log_Magnitude));\
+ } while (0)
+#else
+ #define in_set_fft_log_magnitude(a) ss->Fft_Log_Magnitude = a
+#endif
#define DEFAULT_FFT_LOG_MAGNITUDE false
#define fft_log_frequency(ss) ss->Fft_Log_Frequency
-#define in_set_fft_log_frequency(a) ss->Fft_Log_Frequency = a
+#if HAVE_SCHEME
+ #define in_set_fft_log_frequency(a) \
+ do {\
+ ss->Fft_Log_Frequency = a; \
+ s7_symbol_set_value(s7, ss->fft_log_frequency_symbol, s7_make_boolean(s7, ss->Fft_Log_Frequency));\
+ } while (0)
+#else
+ #define in_set_fft_log_frequency(a) ss->Fft_Log_Frequency = a
+#endif
#define DEFAULT_FFT_LOG_FREQUENCY false
#define fft_with_phases(ss) ss->Fft_With_Phases
-#define in_set_fft_with_phases(a) ss->Fft_With_Phases = a
+#if HAVE_SCHEME
+ #define in_set_fft_with_phases(a) \
+ do {\
+ ss->Fft_With_Phases = a; \
+ s7_symbol_set_value(s7, ss->fft_with_phases_symbol, s7_make_boolean(s7, ss->Fft_With_Phases));\
+ } while (0)
+#else
+ #define in_set_fft_with_phases(a) ss->Fft_With_Phases = a
+#endif
#define DEFAULT_FFT_WITH_PHASES false
#define cursor_style(ss) ss->Cursor_Style
-#define in_set_cursor_style(a) ss->Cursor_Style = a
+#if HAVE_SCHEME
+ #define in_set_cursor_style(a) \
+ do {\
+ ss->Cursor_Style = a; \
+ s7_symbol_set_value(s7, ss->cursor_style_symbol, s7_make_integer(s7, ss->Cursor_Style));\
+ } while (0)
+#else
+ #define in_set_cursor_style(a) ss->Cursor_Style = a
+#endif
#define DEFAULT_CURSOR_STYLE CURSOR_CROSS
#define tracking_cursor_style(ss) ss->Tracking_Cursor_Style
-#define in_set_tracking_cursor_style(a) ss->Tracking_Cursor_Style = a
+#if HAVE_SCHEME
+ #define in_set_tracking_cursor_style(a) \
+ do {\
+ ss->Tracking_Cursor_Style = a; \
+ s7_symbol_set_value(s7, ss->tracking_cursor_style_symbol, s7_make_integer(s7, ss->Tracking_Cursor_Style));\
+ } while (0)
+#else
+ #define in_set_tracking_cursor_style(a) ss->Tracking_Cursor_Style = a
+#endif
#define DEFAULT_TRACKING_CURSOR_STYLE CURSOR_LINE
#define cursor_size(ss) ss->Cursor_Size
-#define in_set_cursor_size(a) ss->Cursor_Size = a
+#if HAVE_SCHEME
+ #define in_set_cursor_size(a) \
+ do {\
+ ss->Cursor_Size = a; \
+ s7_symbol_set_value(s7, ss->cursor_size_symbol, s7_make_integer(s7, ss->Cursor_Size));\
+ } while (0)
+#else
+ #define in_set_cursor_size(a) ss->Cursor_Size = a
+#endif
#define DEFAULT_CURSOR_SIZE 15
#define channel_style(ss) ss->Channel_Style
-#define in_set_channel_style(a) ss->Channel_Style = a
+#if HAVE_SCHEME
+ #define in_set_channel_style(a) \
+ do {\
+ ss->Channel_Style = a; \
+ s7_symbol_set_value(s7, ss->channel_style_symbol, s7_make_integer(s7, ss->Channel_Style));\
+ } while (0)
+#else
+ #define in_set_channel_style(a) ss->Channel_Style = a
+#endif
#define DEFAULT_CHANNEL_STYLE CHANNELS_COMBINED
#define sync_style(ss) ss->Sync_Style
-#define set_sync_style(a) ss->Sync_Style = a
+#if HAVE_SCHEME
+ #define set_sync_style(a) \
+ do {\
+ ss->Sync_Style = a; \
+ s7_symbol_set_value(s7, ss->sync_style_symbol, s7_make_integer(s7, ss->Sync_Style));\
+ } while (0)
+#else
+ #define set_sync_style(a) ss->Sync_Style = a
+#endif
#define DEFAULT_SYNC_STYLE SYNC_BY_SOUND
#define sound_style(ss) ss->Sound_Style
@@ -892,27 +1796,67 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#define DEFAULT_SOUND_STYLE SOUNDS_VERTICAL
#define listener_prompt(ss) ss->Listener_Prompt
-#define in_set_listener_prompt(a) ss->Listener_Prompt = a
+#if HAVE_SCHEME
+ #define in_set_listener_prompt(a) \
+ do {\
+ ss->Listener_Prompt = a; \
+ s7_symbol_set_value(s7, ss->listener_prompt_symbol, s7_make_string(s7, ss->Listener_Prompt));\
+ } while (0)
+#else
+ #define in_set_listener_prompt(a) ss->Listener_Prompt = a
+#endif
#define DEFAULT_LISTENER_PROMPT ">"
#define print_length(ss) ss->Print_Length
-#define set_print_length(a) ss->Print_Length = a
+#if HAVE_SCHEME
+ #define set_print_length(a) \
+ do {\
+ ss->Print_Length = a; \
+ s7_symbol_set_value(s7, ss->print_length_symbol, s7_make_integer(s7, ss->Print_Length));\
+ } while (0)
+#else
+ #define set_print_length(a) ss->Print_Length = a
+#endif
#define DEFAULT_PRINT_LENGTH 12
#define view_files_sort(ss) ss->View_Files_Sort
-#define set_view_files_sort(a) ss->View_Files_Sort = a
+#if HAVE_SCHEME
+ #define set_view_files_sort(a) \
+ do {\
+ ss->View_Files_Sort = a; \
+ s7_symbol_set_value(s7, ss->view_files_sort_symbol, s7_make_integer(s7, ss->View_Files_Sort));\
+ } while (0)
+#else
+ #define set_view_files_sort(a) ss->View_Files_Sort = a
+#endif
#define DEFAULT_VIEW_FILES_SORT SORT_A_TO_Z
-#define enved_clip_p(ss) ss->enved->clip_p
-#define in_set_enved_clip_p(a) ss->enved->clip_p = a
-#define DEFAULT_ENVED_CLIP_P true
-
-#define enved_wave_p(ss) ss->Enved_Wave_p
-#define in_set_enved_wave_p(a) ss->Enved_Wave_p = a
-#define DEFAULT_ENVED_WAVE_P false
+#define enved_clipping(ss) ss->enved->clipping
+#define in_set_enved_clipping(a) ss->enved->clipping = a
+#define DEFAULT_ENVED_CLIPPING true
+
+#define enved_with_wave(ss) ss->Enved_With_Wave
+#if HAVE_SCHEME
+ #define in_set_enved_with_wave(a) \
+ do {\
+ ss->Enved_With_Wave = a; \
+ s7_symbol_set_value(s7, ss->enved_with_wave_symbol, s7_make_boolean(s7, ss->Enved_With_Wave));\
+ } while (0)
+#else
+ #define in_set_enved_with_wave(a) ss->Enved_With_Wave = a
+#endif
+#define DEFAULT_ENVED_WITH_WAVE false
#define enved_filter_order(ss) ss->Enved_Filter_Order
-#define in_set_enved_filter_order(a) ss->Enved_Filter_Order = a
+#if HAVE_SCHEME
+ #define in_set_enved_filter_order(a) \
+ do {\
+ ss->Enved_Filter_Order = a; \
+ s7_symbol_set_value(s7, ss->enved_filter_order_symbol, s7_make_integer(s7, ss->Enved_Filter_Order));\
+ } while (0)
+#else
+ #define in_set_enved_filter_order(a) ss->Enved_Filter_Order = a
+#endif
#define DEFAULT_ENVED_FILTER_ORDER 40
#define enved_in_dB(ss) ss->enved->in_dB
@@ -920,69 +1864,178 @@ typedef enum {NO_REQUESTOR, FROM_UPDATE, FROM_VIEW_FILES, FROM_DRAG_AND_DROP, FR
#define DEFAULT_ENVED_IN_DB false
#define enved_target(ss) ss->Enved_Target
-#define in_set_enved_target(a) ss->Enved_Target = a
+#if HAVE_SCHEME
+ #define in_set_enved_target(a) \
+ do {\
+ ss->Enved_Target = a; \
+ s7_symbol_set_value(s7, ss->enved_target_symbol, s7_make_integer(s7, ss->Enved_Target));\
+ } while (0)
+#else
+ #define in_set_enved_target(a) ss->Enved_Target = a
+#endif
#define DEFAULT_ENVED_TARGET ENVED_AMPLITUDE
#define enved_base(ss) ss->Enved_Base
-#define in_set_enved_base(a) ss->Enved_Base = a
+#if HAVE_SCHEME
+ #define in_set_enved_base(a) \
+ do {\
+ ss->Enved_Base = a; \
+ s7_symbol_set_value(s7, ss->enved_base_symbol, s7_make_real(s7, ss->Enved_Base));\
+ } while (0)
+#else
+ #define in_set_enved_base(a) ss->Enved_Base = a
+#endif
#define DEFAULT_ENVED_BASE 1.0
#define enved_power(ss) ss->Enved_Power
-#define set_enved_power(a) ss->Enved_Power = a
+#if HAVE_SCHEME
+ #define set_enved_power(a) \
+ do {\
+ ss->Enved_Power = a; \
+ s7_symbol_set_value(s7, ss->enved_power_symbol, s7_make_real(s7, ss->Enved_Power));\
+ } while (0)
+#else
+ #define set_enved_power(a) ss->Enved_Power = a
+#endif
#define DEFAULT_ENVED_POWER 3.0
#define enved_style(ss) ss->Enved_Style
-#define set_enved_style(a) ss->Enved_Style = a
+#if HAVE_SCHEME
+ #define set_enved_style(a) \
+ do {\
+ ss->Enved_Style = a; \
+ s7_symbol_set_value(s7, ss->enved_style_symbol, s7_make_integer(s7, ss->Enved_Style));\
+ } while (0)
+#else
+ #define set_enved_style(a) ss->Enved_Style = a
+#endif
#define DEFAULT_ENVED_STYLE ENVELOPE_LINEAR
-#define audio_output_device(ss) ss->Audio_Output_Device
-#define set_audio_output_device(a) ss->Audio_Output_Device = a
-#define DEFAULT_AUDIO_OUTPUT_DEVICE MUS_AUDIO_DEFAULT
-
-#define audio_input_device(ss) ss->Audio_Input_Device
-#define set_audio_input_device(a) ss->Audio_Input_Device = a
-#define DEFAULT_AUDIO_INPUT_DEVICE MUS_AUDIO_DEFAULT
-
#define in_graph_cursor(ss) ss->Graph_Cursor
#define clipping(ss) ss->Clipping
-#define set_clipping(a) ss->Clipping = a
+#if HAVE_SCHEME
+ #define set_clipping(a) \
+ do {\
+ ss->Clipping = a; \
+ s7_symbol_set_value(s7, ss->clipping_symbol, s7_make_boolean(s7, ss->Clipping));\
+ } while (0)
+#else
+ #define set_clipping(a) ss->Clipping = a
+#endif
#define DEFAULT_CLIPPING false
#define html_dir(ss) ss->HTML_Dir
-#define set_html_dir_1(a) ss->HTML_Dir = a
+#if HAVE_SCHEME
+ #define set_html_dir_1(a) \
+ do {\
+ ss->HTML_Dir = a; \
+ s7_symbol_set_value(s7, ss->html_dir_symbol, s7_make_string(s7, ss->HTML_Dir));\
+ } while (0)
+#else
+ #define set_html_dir_1(a) ss->HTML_Dir = a
+#endif
#define DEFAULT_HTML_DIR "."
#define html_program(ss) ss->HTML_Program
-#define set_html_program(a) ss->HTML_Program = a
+#if HAVE_SCHEME
+ #define set_html_program(a) \
+ do {\
+ ss->HTML_Program = a; \
+ s7_symbol_set_value(s7, ss->html_program_symbol, s7_make_string(s7, ss->HTML_Program));\
+ } while (0)
+#else
+ #define set_html_program(a) ss->HTML_Program = a
+#endif
#define DEFAULT_HTML_PROGRAM "firefox"
#define graphs_horizontal(ss) ss->Graphs_Horizontal
-#define in_set_graphs_horizontal(a) ss->Graphs_Horizontal = a
+#if HAVE_SCHEME
+ #define in_set_graphs_horizontal(a) \
+ do {\
+ ss->Graphs_Horizontal = a; \
+ s7_symbol_set_value(s7, ss->graphs_horizontal_symbol, s7_make_boolean(s7, ss->Graphs_Horizontal));\
+ } while (0)
+#else
+ #define in_set_graphs_horizontal(a) ss->Graphs_Horizontal = a
+#endif
#define DEFAULT_GRAPHS_HORIZONTAL true
#define mix_tag_width(ss) ss->Mix_Tag_Width
-#define set_mix_tag_width(a) ss->Mix_Tag_Width = a
+#if HAVE_SCHEME
+ #define set_mix_tag_width(a) \
+ do {\
+ ss->Mix_Tag_Width = a; \
+ s7_symbol_set_value(s7, ss->mix_tag_width_symbol, s7_make_integer(s7, ss->Mix_Tag_Width));\
+ } while (0)
+#else
+ #define set_mix_tag_width(a) ss->Mix_Tag_Width = a
+#endif
#define DEFAULT_MIX_TAG_WIDTH 6
#define mix_tag_height(ss) ss->Mix_Tag_Height
-#define set_mix_tag_height(a) ss->Mix_Tag_Height = a
+#if HAVE_SCHEME
+ #define set_mix_tag_height(a) \
+ do {\
+ ss->Mix_Tag_Height = a; \
+ s7_symbol_set_value(s7, ss->mix_tag_height_symbol, s7_make_integer(s7, ss->Mix_Tag_Height));\
+ } while (0)
+#else
+ #define set_mix_tag_height(a) ss->Mix_Tag_Height = a
+#endif
#define DEFAULT_MIX_TAG_HEIGHT 14
#define mark_tag_width(ss) ss->Mark_Tag_Width
-#define set_mark_tag_width(a) ss->Mark_Tag_Width = a
+#if HAVE_SCHEME
+ #define set_mark_tag_width(a) \
+ do {\
+ ss->Mark_Tag_Width = a; \
+ s7_symbol_set_value(s7, ss->mark_tag_width_symbol, s7_make_integer(s7, ss->Mark_Tag_Width));\
+ } while (0)
+#else
+ #define set_mark_tag_width(a) ss->Mark_Tag_Width = a
+#endif
#define DEFAULT_MARK_TAG_WIDTH 10
#define mark_tag_height(ss) ss->Mark_Tag_Height
-#define set_mark_tag_height(a) ss->Mark_Tag_Height = a
+#if HAVE_SCHEME
+ #define set_mark_tag_height(a) \
+ do {\
+ ss->Mark_Tag_Height = a; \
+ s7_symbol_set_value(s7, ss->mark_tag_height_symbol, s7_make_integer(s7, ss->Mark_Tag_Height));\
+ } while (0)
+#else
+ #define set_mark_tag_height(a) ss->Mark_Tag_Height = a
+#endif
#define DEFAULT_MARK_TAG_HEIGHT 4
#define min_dB(ss) ss->Min_dB
-#define set_min_dB(a) ss->Min_dB = a
+#if HAVE_SCHEME
+ #define set_min_dB(a) \
+ do {\
+ ss->Min_dB = a; \
+ s7_symbol_set_value(s7, ss->min_db_symbol, s7_make_real(s7, ss->Min_dB));\
+ } while (0)
+#else
+ #define set_min_dB(a) ss->Min_dB = a
+#endif
#define DEFAULT_MIN_DB -60.0
#define play_arrow_size(ss) ss->Play_Arrow_Size
-#define set_play_arrow_size(a) ss->Play_Arrow_Size = a
+#if HAVE_SCHEME
+ #define set_play_arrow_size(a) \
+ do {\
+ ss->Play_Arrow_Size = a; \
+ s7_symbol_set_value(s7, ss->play_arrow_size_symbol, s7_make_integer(s7, ss->Play_Arrow_Size));\
+ } while (0)
+#else
+ #define set_play_arrow_size(a) ss->Play_Arrow_Size = a
+#endif
#define DEFAULT_PLAY_ARROW_SIZE 10
+
+#define HAVE_GTK use USE_GTK not HAVE!
+#define HAVE_MOTIF use USE_MOTIF not HAVE!
+/* I keep using these HAVE_* forms by mistake */
+
#endif
diff --git a/snd-1.h b/snd-1.h
index 399d2fe..11fc4da 100644
--- a/snd-1.h
+++ b/snd-1.h
@@ -1,64 +1,65 @@
#ifndef SND_1_H
#define SND_1_H
-#define ASSERT_SOUND(Origin, Snd, Offset) \
- if (!((XEN_INTEGER_P(Snd)) || (XEN_SOUND_P(Snd)) || (XEN_FALSE_P(Snd)) || (XEN_NOT_BOUND_P(Snd)))) \
- XEN_WRONG_TYPE_ARG_ERROR(Origin, Offset, Snd, "a sound object, an integer (sound index), or " PROC_FALSE);
+#define WITH_RELATIVE_PANES (USE_MOTIF && (XmVERSION > 1))
-#define ASSERT_CHANNEL(Origin, Snd, Chn, Offset) \
- if (!((XEN_INTEGER_P(Snd)) || (XEN_SOUND_P(Snd)) || (XEN_FALSE_P(Snd)) || (XEN_NOT_BOUND_P(Snd)))) \
- XEN_WRONG_TYPE_ARG_ERROR(Origin, Offset, Snd, "a sound object, an integer (sound index), or " PROC_FALSE); \
+#define Snd_assert_sound(Origin, Snd, Offset) \
+ if (!((Xen_is_integer(Snd)) || (xen_is_sound(Snd)) || (Xen_is_false(Snd)) || (!Xen_is_bound(Snd)))) \
+ Xen_wrong_type_arg_error(Origin, Offset, Snd, "a sound object, an integer (sound index), or " PROC_FALSE);
+
+#define Snd_assert_channel(Origin, Snd, Chn, Offset) \
+ if (!((Xen_is_integer(Snd)) || (xen_is_sound(Snd)) || (Xen_is_false(Snd)) || (!Xen_is_bound(Snd)))) \
+ Xen_wrong_type_arg_error(Origin, Offset, Snd, "a sound object, an integer (sound index), or " PROC_FALSE); \
else \
- if (!((XEN_INTEGER_P(Chn)) || (XEN_FALSE_P(Chn)) || (XEN_NOT_BOUND_P(Chn)))) \
- XEN_WRONG_TYPE_ARG_ERROR(Origin, Offset + 1, Chn, "an integer (0-based channel number) or " PROC_FALSE);
+ if (!((Xen_is_integer(Chn)) || (Xen_is_false(Chn)) || (!Xen_is_bound(Chn)))) \
+ Xen_wrong_type_arg_error(Origin, Offset + 1, Chn, "an integer (0-based channel number) or " PROC_FALSE);
+
-/* these macros fix up argument order for setter procs in Scheme: (set! (proc a b) c) */
-/* snd-edits has a 5 and a 10 case */
#if HAVE_SCHEME
+/* these macros fix up argument order for setter procs in Scheme: (set! (proc a b) c) */
-#define WITH_TWO_SETTER_ARGS(name_reversed, name) \
+#define with_two_setter_args(name_reversed, name) \
static s7_pointer name_reversed(s7_scheme *sc, s7_pointer args) \
{ \
- if (XEN_NULL_P(XEN_CDR(args))) \
- return(name(XEN_CAR(args), XEN_UNDEFINED)); \
- return(name(XEN_CADR(args), XEN_CAR(args))); \
+ if (Xen_is_null(Xen_cdr(args))) \
+ return(name(Xen_car(args), Xen_undefined)); \
+ return(name(Xen_cadr(args), Xen_car(args))); \
}
-#define WITH_THREE_SETTER_ARGS(name_reversed, name) \
+#define with_three_setter_args(name_reversed, name) \
static s7_pointer name_reversed(s7_scheme *sc, s7_pointer args) \
{ \
- if (XEN_NULL_P(XEN_CDR(args))) \
- return(name(XEN_CAR(args), XEN_UNDEFINED, XEN_UNDEFINED)); \
+ if (Xen_is_null(Xen_cdr(args))) \
+ return(name(Xen_car(args), Xen_undefined, Xen_undefined)); \
else { \
- if (XEN_NULL_P(XEN_CDDR(args))) \
- return(name(XEN_CADR(args), XEN_CAR(args), XEN_UNDEFINED)); \
- else return(name(XEN_CADDR(args), XEN_CAR(args), XEN_CADR(args))); \
+ if (Xen_is_null(Xen_cddr(args))) \
+ return(name(Xen_cadr(args), Xen_car(args), Xen_undefined)); \
+ else return(name(Xen_caddr(args), Xen_car(args), Xen_cadr(args))); \
}}
-#define WITH_FOUR_SETTER_ARGS(name_reversed, name) \
+#define with_four_setter_args(name_reversed, name) \
static s7_pointer name_reversed(s7_scheme *sc, s7_pointer args) \
{ \
- if (XEN_NULL_P(XEN_CDR(args))) \
- return(name(XEN_CAR(args), XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED)); \
+ if (Xen_is_null(Xen_cdr(args))) \
+ return(name(Xen_car(args), Xen_undefined, Xen_undefined, Xen_undefined)); \
else { \
- if (XEN_NULL_P(XEN_CDDR(args))) \
- return(name(XEN_CADR(args), XEN_CAR(args), XEN_UNDEFINED, XEN_UNDEFINED)); \
+ if (Xen_is_null(Xen_cddr(args))) \
+ return(name(Xen_cadr(args), Xen_car(args), Xen_undefined, Xen_undefined)); \
else { \
- if (XEN_NULL_P(XEN_CDDDR(args))) \
- return(name(XEN_CADDR(args), XEN_CAR(args), XEN_CADR(args), XEN_UNDEFINED)); \
- else return(name(XEN_CADDDR(args), XEN_CAR(args), XEN_CADR(args), XEN_CADDR(args))); \
+ if (Xen_is_null(Xen_cdddr(args))) \
+ return(name(Xen_caddr(args), Xen_car(args), Xen_cadr(args), Xen_undefined)); \
+ else return(name(Xen_cadddr(args), Xen_car(args), Xen_cadr(args), Xen_caddr(args))); \
}}}
#else
-/* 10 case in snd-edits for set-samples and a 5 case for set-sample */
-#define WITH_TWO_SETTER_ARGS(name_reversed, name)
-#define WITH_THREE_SETTER_ARGS(name_reversed, name)
-#define WITH_FOUR_SETTER_ARGS(name_reversed, name)
+#define with_two_setter_args(name_reversed, name)
+#define with_three_setter_args(name_reversed, name)
+#define with_four_setter_args(name_reversed, name)
#endif
-#define ASSERT_SAMPLE_TYPE(Origin, Beg, Offset) \
- XEN_ASSERT_TYPE(XEN_NUMBER_P(Beg) || XEN_FALSE_P(Beg) || XEN_NOT_BOUND_P(Beg), Beg, Offset, Origin, "a number or " PROC_FALSE)
+#define Snd_assert_sample_type(Origin, Beg, Offset) \
+ Xen_check_type(Xen_is_integer(Beg) || Xen_is_false(Beg) || (!Xen_is_bound(Beg)), Beg, Offset, Origin, "an integer or " PROC_FALSE)
typedef struct {
char **values;
@@ -77,20 +78,20 @@ typedef struct {
typedef struct snd_io snd_io;
typedef struct {
- char *name; /* full name */
- mus_long_t samples; /* total samples = chans * frames */
+ char *name; /* full name */
+ mus_long_t samples; /* total samples = chans * framples */
mus_long_t data_location; /* bytes */
int srate;
int chans;
- int format; /* data format (mus_bshort etc) */
- int type; /* header type (mus_aifc etc) */
- char *comment; /* output case, not input */
+ mus_sample_t sample_type; /* sample type (mus_bshort etc) */
+ mus_header_t type; /* header type (mus_aifc etc) */
+ char *comment; /* output case, not input */
int *loops;
} file_info;
typedef struct {
snd_data_file_t type;
- mus_sample_t *buffered_data;
+ mus_float_t *buffered_data;
snd_io *io;
char *filename;
file_info *hdr;
@@ -113,12 +114,12 @@ typedef struct {
mus_long_t beg, len; /* beg and len of changed portion */
char *origin;
edit_t edit_type;
- int sound_location, ptree_location;
+ int sound_location;
mus_long_t selection_beg, selection_end; /* selection needs to follow edit list */
mus_float_t maxamp, selection_maxamp;
mus_long_t maxamp_position, selection_maxamp_position;
int edpos;
- bool ptree_env_too, backed_up;
+ bool backed_up;
mus_long_t samples, cursor;
int mark_size, mark_ctr;
mark **marks; /* mark positions */
@@ -126,7 +127,7 @@ typedef struct {
enved_fft *fft; /* overall fft data for envelope editor */
void *readers; /* current readers of this edit (g++ stupidity forces us to use void* here -- type is sf_info, snd-edits.c) */
void *mixes;
- XEN properties;
+ Xen properties;
int properties_gc_loc;
} ed_list;
@@ -139,7 +140,7 @@ typedef struct snd_fd {
int cbi;
read_direction_t direction;
bool at_eof, freed;
- mus_sample_t *data;
+ mus_float_t *data;
snd_data *current_sound;
mus_long_t initial_samp;
struct chan_info *cp;
@@ -148,7 +149,7 @@ typedef struct snd_fd {
mus_long_t frag_pos;
int edit_ctr, region;
reader_t type;
- void *ptrees, *ramps, *mixes;
+ void *ramps, *mixes;
} snd_fd;
typedef struct {mus_float_t freq; mus_float_t amp;} fft_peak;
@@ -193,15 +194,6 @@ typedef struct {
int index; /* cp->sounds index (src writes a new temp file) */
} mix_state;
-typedef struct fam_info {
- FAMRequest *rp;
- void (*action)(struct fam_info *fp, FAMEvent *fe);
- void *data;
-#if MUS_DEBUGGING
- char *filename;
-#endif
-} fam_info;
-
typedef struct env_editor {
int *current_xs;
int *current_ys;
@@ -210,7 +202,7 @@ typedef struct env_editor {
oclock_t down_time;
bool env_dragged;
int env_pos;
- bool click_to_delete, in_dB, with_dots, clip_p;
+ bool click_to_delete, in_dB, with_dots, clipping;
bool edited;
} env_editor;
@@ -238,28 +230,29 @@ typedef struct {
mus_float_t scale;
} sono_info;
+typedef struct {
+ int chans, fields;
+ double *axis_data;
+ bool *fftp, *wavep;
+} axes_data;
+
typedef struct chan_info {
int chan; /* which chan are we */
- bool graph_transform_p; /* f button state */
- bool graph_time_p; /* w button state */
- bool graph_lisp_p; /* is lisp graph active */
+ bool graph_transform_on; /* f button state */
+ bool graph_time_on; /* w button state */
+ bool graph_lisp_on; /* is lisp graph active */
struct lisp_grf *lisp_info; /* defined in snd-chn.c */
bool cursor_on; /* channel's cursor */
bool cursor_visible, fft_cursor_visible; /* for XOR decisions */
int cursor_size;
cursor_style_t cursor_style, tracking_cursor_style;
- int cx, cy, fft_cx, old_cy; /* graph-relative cursor loc (for XOR in Motif, erase-via-overwrite in cairo) */
+ int cx, cy, fft_cx; /* , old_cy; */ /* graph-relative cursor loc (for XOR in Motif, erase-via-overwrite in cairo) */
int edit_ctr; /* channel's edit history */
int edit_size; /* current edit list size */
ed_list **edits; /* the edit list */
int sound_size; /* edit_list associated temp sound buffers */
int sound_ctr; /* current location in sounds list */
snd_data **sounds; /* the associated temp buffer/file/struct list */
- int ptree_size; /* ditto for ptrees */
- int ptree_ctr;
- struct ptree **ptrees;
- XEN *ptree_inits;
- int *init_locs, *init_args;
fft_info *fft; /* possibly null fft data */
struct snd_info *sound; /* containing sound */
axis_info *axis; /* time domain axis */
@@ -269,7 +262,6 @@ typedef struct chan_info {
struct env_state *peak_env_state;
graphics_context *ax;
bool selected;
- int current_hourglass;
mus_float_t progress_pct;
#if USE_GTK
@@ -278,7 +270,12 @@ typedef struct chan_info {
GdkCursor *current_cursor;
slist *edhist_list;
color_info *combined_data_color;
+#if CAIRO_HAS_RECORDING_SURFACE && (0)
+ cairo_surface_t *fft_pix;
+ bool fft_pix_ready;
+#endif
#endif
+
#if USE_MOTIF
Widget *chan_widgets;
Pixmap fft_pix;
@@ -312,7 +309,7 @@ typedef struct chan_info {
mus_float_t spectro_x_scale, spectro_y_scale, spectro_z_scale, spectro_z_angle, spectro_x_angle, spectro_y_angle;
mus_float_t spectrum_end, spectrum_start;
mus_float_t lin_dB, min_dB, fft_window_alpha, fft_window_beta, beats_per_minute, grid_density;
- bool show_y_zero, show_marks, verbose_cursor;
+ bool show_y_zero, show_marks, with_verbose_cursor;
with_grid_t show_grid;
int wavo_hop, wavo_trace, zero_pad, wavelet_type, max_transform_peaks, beats_per_measure;
x_axis_style_t x_axis_style;
@@ -326,17 +323,16 @@ typedef struct chan_info {
fft_normalize_t transform_normalization;
int transform_type, spectro_hop, edhist_base;
bool show_mix_waveforms, graphs_horizontal;
- XEN edit_hook;
- XEN undo_hook;
- XEN cursor_proc;
- XEN after_edit_hook;
- XEN properties;
+ Xen edit_hook;
+ Xen undo_hook;
+ Xen cursor_proc;
+ Xen after_edit_hook;
+ Xen properties;
int cursor_proc_loc, edit_hook_loc, undo_hook_loc, after_edit_hook_loc, properties_loc;
bool selection_visible;
channel_state_t active;
int old_x0, old_x1;
mus_float_t *amp_control; /* local amp controls in snd-dac; should it be extended to other controls? */
- search_result_t last_search_result;
bool just_zero, new_peaks, editable, updating;
struct inset_graph_info_t *inset_graph; /* defined in snd-chn.c */
#if HAVE_GL
@@ -344,18 +340,18 @@ typedef struct chan_info {
#endif
} chan_info;
-#define CURRENT_SAMPLES(Cp) (Cp)->edits[(Cp)->edit_ctr]->samples
-#define CURSOR(Cp) (Cp)->edits[(Cp)->edit_ctr]->cursor
+#define current_samples(Cp) (Cp)->edits[(Cp)->edit_ctr]->samples
+#define cursor_sample(Cp) (Cp)->edits[(Cp)->edit_ctr]->cursor
typedef struct snd_info {
sound_inuse_t inuse;
int index;
int playing;
int sync, previous_sync;
- bool expand_control_p;
- bool contrast_control_p;
- bool reverb_control_p;
- bool filter_control_p, filter_control_in_dB, filter_control_in_hz;
+ bool expand_control_on;
+ bool contrast_control_on;
+ bool reverb_control_on;
+ bool filter_control_on, filter_control_in_dB, filter_control_in_hz;
mus_float_t amp_control;
mus_float_t speed_control;
int speed_control_direction, speed_control_tones, speed_control_numerator, speed_control_denominator;
@@ -378,21 +374,9 @@ typedef struct snd_info {
char *filename;
char *short_filename;
int nchans;
- struct ptree *search_tree;
- XEN search_proc;
- XEN prompt_callback;
- XEN properties;
- int search_proc_loc, prompt_callback_loc, properties_loc;
- bool raw_prompt, remembering;
- char *search_expr;
- mus_long_t marking;
- int search_count, amp_count; /* search_count = number of times to search before return, amp_count = amp env samps if not 1 (= full dur) */
- sp_filing_t filing;
- char *filing_filename;
- bool prompting, loading, finding_mark, selectioning;
- printing_t printing;
- mus_long_t macro_count;
- minibuffer_choice_t minibuffer_on;
+ Xen properties;
+ int properties_loc;
+ bool remembering;
read_only_t user_read_only, file_read_only;
chan_info **chans;
@@ -403,16 +387,13 @@ typedef struct snd_info {
int num_progress_widgets;
Widget tab;
Widget dialog;
- Dimension minibuffer_height;
- bool minibuffer_watcher;
+ int bomb_ctr;
#endif
#if USE_GTK
GtkWidget **snd_widgets;
GtkAdjustment **snd_adjs;
GtkWidget *dialog;
int page;
- bool mini_active;
- gulong minibuffer_watcher;
graphics_context *name_pix_ax, *stop_pix_ax, *speed_arrow_ax, *filter_ax;
graphics_context **clock_pix_ax;
GtkWidget **clock_widgets;
@@ -423,28 +404,23 @@ typedef struct snd_info {
#endif
file_info *hdr; /* header of file that would be affected if we were to save current edits */
- int bomb_ctr;
time_t write_date, update_warning_write_date; /* check for change behind back while editing */
bool need_update, file_unreadable; /* current in-core data does not match actual file (someone wrote it behind our back) */
channel_style_t channel_style;
int allocated_chans, selectpos;
struct region *edited_region;
- struct dialog_play_info *delete_me;
+ void *delete_me;
chan_info *lacp;
struct ctrl_state *saved_controls;
bool apply_ok, applying;
- struct mini_history *minibuffer_history, *filter_history;
bool active;
char *name_string;
- fam_info *file_watcher;
+ void *file_watcher;
bool writing, bomb_in_progress;
-#if HAVE_PTHREADS
- mus_lock_t *starred_name_lock, *stop_sign_lock, *edit_history_lock;
-#endif
} snd_info;
-#define SND_SRATE(Sp) (((Sp)->hdr)->srate)
-#define HAS_WIDGETS(Sp) ((Sp) && ((Sp)->snd_widgets))
+#define snd_srate(Sp) (((Sp)->hdr)->srate)
+#define has_widgets(Sp) ((Sp) && ((Sp)->snd_widgets))
typedef struct snd_state {
int selected_sound; /* NO_SELECTION = none selected = which sound is currently receiving user's attention */
@@ -452,10 +428,9 @@ typedef struct snd_state {
int channel_min_height;
snd_info **sounds;
char *search_expr, *startup_title, *startup_errors;
- struct ptree *search_tree;
- XEN search_proc;
+ Xen search_proc;
int file_sorters_size, file_filters_size;
- XEN file_sorters, file_filters;
+ Xen file_sorters, file_filters;
int search_proc_loc, local_errno, local_open_errno;
int position_slider_width, zoom_slider_width, toggle_size, channel_sash_indent, sash_size, channel_sash_size, sash_indent;
int max_sounds, sound_sync_max;
@@ -468,6 +443,7 @@ typedef struct snd_state {
int init_window_width, init_window_height;
int init_window_x, init_window_y;
bool graph_hook_active, lisp_graph_hook_active;
+
bool Show_Transform_Peaks, Show_Y_Zero, Show_Marks;
with_grid_t Show_Grid;
bool Fft_Log_Frequency, Fft_Log_Magnitude, Fft_With_Phases;
@@ -478,19 +454,21 @@ typedef struct snd_state {
char *Eps_File, *Temp_Dir, *Save_Dir, *Ladspa_Dir, *Peak_Env_Dir;
char *Listener_Font, *Axis_Label_Font, *Axis_Numbers_Font, *Tiny_Font, *Peaks_Font, *Bold_Peaks_Font;
char *orig_listener_font, *orig_axis_label_font, *orig_axis_numbers_font, *orig_tiny_font, *orig_peaks_font, *orig_bold_peaks_font;
- bool Verbose_Cursor, Trap_Segfault, With_Inset_Graph, With_Pointer_Focus, With_Smpte_Label;
+ bool With_Verbose_Cursor, With_Inset_Graph, With_Pointer_Focus, With_Smpte_Label, With_Interrupts;
int Enved_Filter_Order;
mus_float_t Eps_Left_Margin, Eps_Bottom_Margin, Eps_Size, Log_Freq_Start;
mus_float_t Spectro_X_Scale, Spectro_Y_Scale, Spectro_Z_Scale, Spectro_Z_Angle, Spectro_X_Angle, Spectro_Y_Angle;
mus_float_t Spectrum_End, Spectrum_Start;
- int Default_Output_Header_Type, Default_Output_Data_Format, Default_Output_Chans, Default_Output_Srate;
- int Spectro_Hop, Color_Map, Color_Map_Size, Wavelet_Type, Transform_Type, Optimization;
+ mus_header_t Default_Output_Header_Type;
+ mus_sample_t Default_Output_Sample_Type;
+ int Default_Output_Chans, Default_Output_Srate;
+ int Spectro_Hop, Color_Map, Color_Map_Size, Wavelet_Type, Transform_Type;
int Dot_Size;
int Zero_Pad, Wavo_Hop, Wavo_Trace;
mus_long_t Transform_Size;
mus_fft_window_t Fft_Window;
graph_type_t Transform_Graph_Type, Time_Graph_Type;
- bool Ask_Before_Overwrite, Ask_About_Unsaved_Edits, Show_Full_Duration, Remember_Sound_State;
+ bool Ask_Before_Overwrite, Ask_About_Unsaved_Edits, Show_Full_Duration, Show_Full_Range, Remember_Sound_State;
bool Save_As_Dialog_Src, Save_As_Dialog_Auto_Comment, With_Toolbar, With_Tooltips, With_Menu_Icons;
mus_float_t Fft_Window_Alpha, Fft_Window_Beta, Grid_Density, Initial_Beg, Initial_Dur;
mus_float_t Color_Scale, Color_Cutoff, Beats_Per_Minute;
@@ -503,15 +481,14 @@ typedef struct snd_state {
graph_style_t Graph_Style, Region_Graph_Style;
bool Auto_Resize, Auto_Update;
int Max_Regions, Max_Transform_Peaks;
- int Audio_Output_Device, Audio_Input_Device;
- bool Show_Backtrace, With_GL, With_Relative_Panes;
+ bool With_GL, With_Relative_Panes;
int Print_Length, Dac_Size, View_Files_Sort;
bool Dac_Combines_Channels, Show_Selection_Transform, With_Mix_Tags, Selection_Creates_Region;
char *Save_State_File, *Listener_Prompt;
mus_float_t Enved_Base, Enved_Power, Auto_Update_Interval;
- bool Enved_Wave_p, Graphs_Horizontal, With_Background_Processes, With_File_Monitor;
+ bool Enved_With_Wave, Graphs_Horizontal, With_Background_Processes, With_File_Monitor;
env_type_t Enved_Style;
- int Graph_Cursor, Mix_Tag_Width, Mix_Tag_Height, Mark_Tag_Height, Mark_Tag_Width, Minibuffer_History_Length;
+ int Graph_Cursor, Mix_Tag_Width, Mix_Tag_Height, Mark_Tag_Height, Mark_Tag_Width;
enved_target_t Enved_Target;
bool Clipping, Show_Indices, Just_Sounds;
int Cursor_Size;
@@ -530,13 +507,77 @@ typedef struct snd_state {
mus_float_t Min_dB;
bool Show_Controls;
tracking_cursor_t With_Tracking_Cursor;
+ char *HTML_Dir, *HTML_Program, *Open_File_Dialog_Directory;
+
+#if HAVE_SCHEME
+ s7_pointer show_transform_peaks_symbol, show_y_zero_symbol, show_marks_symbol,
+ show_grid_symbol,
+ fft_log_frequency_symbol, fft_log_magnitude_symbol, fft_with_phases_symbol,
+ channel_style_symbol,
+ sync_style_symbol,
+ show_axes_symbol,
+ eps_file_symbol, temp_dir_symbol, save_dir_symbol, ladspa_dir_symbol, peak_env_dir_symbol,
+ listener_font_symbol, axis_label_font_symbol, axis_numbers_font_symbol, tiny_font_symbol, peaks_font_symbol, bold_peaks_font_symbol,
+ with_verbose_cursor_symbol, with_inset_graph_symbol, with_pointer_focus_symbol, with_smpte_label_symbol, with_interrupts_symbol,
+ enved_filter_order_symbol,
+ eps_left_margin_symbol, eps_bottom_margin_symbol, eps_size_symbol, log_freq_start_symbol,
+ spectro_x_scale_symbol, spectro_y_scale_symbol, spectro_z_scale_symbol, spectro_z_angle_symbol, spectro_x_angle_symbol, spectro_y_angle_symbol,
+ spectrum_end_symbol, spectrum_start_symbol,
+ default_output_header_type_symbol, default_output_sample_type_symbol, default_output_chans_symbol, default_output_srate_symbol,
+ spectro_hop_symbol, color_map_symbol, color_map_size_symbol, wavelet_type_symbol, transform_type_symbol,
+ dot_size_symbol,
+ zero_pad_symbol, wavo_hop_symbol, wavo_trace_symbol,
+ transform_size_symbol,
+ fft_window_symbol,
+ transform_graph_type_symbol, time_graph_type_symbol,
+ ask_before_overwrite_symbol, ask_about_unsaved_edits_symbol, show_full_duration_symbol, show_full_range_symbol, remember_sound_state_symbol,
+ save_as_dialog_src_symbol, save_as_dialog_auto_comment_symbol, with_toolbar_symbol, with_tooltips_symbol, with_menu_icons_symbol,
+ fft_window_alpha_symbol, fft_window_beta_symbol, grid_density_symbol, initial_beg_symbol, initial_dur_symbol,
+ color_scale_symbol, color_cutoff_symbol, beats_per_minute_symbol,
+ color_inverted_symbol, show_mix_waveforms_symbol,
+ mix_waveform_height_symbol, beats_per_measure_symbol,
+ transform_normalization_symbol,
+ sinc_width_symbol,
+ x_axis_style_symbol,
+ zoom_focus_style_symbol,
+ graph_style_symbol, region_graph_style_symbol,
+ auto_resize_symbol, auto_update_symbol,
+ max_regions_symbol, max_transform_peaks_symbol,
+ with_gl_symbol, with_relative_panes_symbol,
+ print_length_symbol, dac_size_symbol, view_files_sort_symbol,
+ dac_combines_channels_symbol, show_selection_transform_symbol, with_mix_tags_symbol, selection_creates_region_symbol,
+ save_state_file_symbol, listener_prompt_symbol,
+ enved_base_symbol, enved_power_symbol, auto_update_interval_symbol,
+ enved_with_wave_symbol, graphs_horizontal_symbol, with_background_processes_symbol, with_file_monitor_symbol,
+ enved_style_symbol,
+ graph_cursor_symbol, mix_tag_width_symbol, mix_tag_height_symbol, mark_tag_height_symbol, mark_tag_width_symbol,
+ enved_target_symbol,
+ clipping_symbol, show_indices_symbol, just_sounds_symbol,
+ cursor_size_symbol,
+ cursor_style_symbol, tracking_cursor_style_symbol,
+ filter_control_in_db_symbol, filter_control_in_hz_symbol, show_sonogram_cursor_symbol,
+ speed_control_tones_symbol,
+ speed_control_style_symbol,
+ expand_control_length_symbol, expand_control_ramp_symbol, expand_control_hop_symbol, expand_control_jitter_symbol,
+ contrast_control_amp_symbol,
+ reverb_control_feedback_symbol, reverb_control_lowpass_symbol,
+ reverb_control_decay_symbol, cursor_update_interval_symbol,
+ filter_control_order_symbol, cursor_location_offset_symbol, play_arrow_size_symbol,
+ min_db_symbol,
+ show_controls_symbol,
+ with_tracking_cursor_symbol,
+#if USE_GTK
+ listener_colorized_symbol,
+#endif
+ html_dir_symbol, html_program_symbol, open_file_dialog_directory_symbol;
+#endif
+
bool tracking;
- XEN cursor_proc;
+ Xen cursor_proc;
int cursor_proc_loc, listener_prompt_length;
- XEN zoom_focus_proc;
+ Xen zoom_focus_proc;
int zoom_focus_proc_loc;
mus_float_t lin_dB;
- char *HTML_Dir, *HTML_Program, *Open_File_Dialog_Directory;
char *io_error_info;
int deferred_regions;
open_requestor_t open_requestor;
@@ -545,8 +586,7 @@ typedef struct snd_state {
bool jump_ok, exiting;
env_editor *enved;
oclock_t click_time;
- bool fam_ok, cg_seen, C_g_typed;
- FAMConnection *fam_connection;
+ bool file_monitor_ok, C_g_typed, squelch_mark_drag_info;
void (*snd_error_handler)(const char *error_msg, void *data);
void *snd_error_data;
void (*snd_warning_handler)(const char *warning_msg, void *data);
@@ -559,12 +599,11 @@ typedef struct snd_state {
#if HAVE_GL && WITH_GL2PS
bool gl_printing;
#endif
- XEN mus_error_hook;
- XEN snd_error_hook;
- XEN snd_warning_hook;
- XEN snd_open_file_hook;
- XEN snd_selection_hook;
- XEN effects_hook;
+ Xen mus_error_hook;
+ Xen snd_error_hook;
+ Xen snd_warning_hook;
+ Xen snd_open_file_hook;
+ Xen effects_hook;
#if USE_MOTIF
XtAppContext mainapp;
@@ -585,7 +624,7 @@ typedef struct snd_state {
xm_font_t tiny_fontlist;
XFontStruct *tiny_fontstruct;
- Pixel white, black, red, yellow, green, light_blue, lighter_blue;
+ Pixel white, black, red, yellow, green, blue, light_blue, lighter_blue;
Pixel data_color, selected_data_color, mark_color, graph_color, selected_graph_color, listener_color, listener_text_color;
Pixel basic_color, selection_color, zoom_color, position_color, highlight_color, enved_waveform_color, cursor_color;
Pixel text_focus_color, filter_control_waveform_color, mix_color, sash_color;
@@ -604,18 +643,20 @@ typedef struct snd_state {
Widget listener_pane;
Widget *dialogs;
int num_dialogs, dialogs_size;
- Cursor graph_cursor, wait_cursor, bounds_cursor, play_cursor, loop_play_cursor;
+ Cursor graph_cursor, wait_cursor, bounds_cursor, play_cursor, loop_play_cursor, yaxis_cursor;
Widget requestor_dialog;
#if HAVE_GL
+#if USE_MOTIF
GLXContext cx;
#endif
- XtInputId fam_port;
+#endif
Widget *mw;
bool axis_color_set;
#endif
#if USE_GTK
cairo_t *cr;
+ double line_width;
GtkWidget *mainshell;
GtkWidget *mainpane;
GtkWidget *soundpane;
@@ -630,7 +671,7 @@ typedef struct snd_state {
PangoFontDescription *peaks_fnt;
PangoFontDescription *bold_peaks_fnt;
- color_info *white, *black, *red, *yellow, *green, *light_blue, *lighter_blue;
+ color_info *white, *black, *red, *yellow, *green, *blue, *light_blue, *lighter_blue;
color_info *data_color, *selected_data_color, *mark_color, *graph_color, *selected_graph_color, *listener_color, *listener_text_color, *cursor_color;
color_info *basic_color, *selection_color, *zoom_color, *position_color, *highlight_color, *enved_waveform_color;
color_info *text_focus_color, *filter_control_waveform_color, *mix_color, *sash_color;
@@ -653,15 +694,16 @@ typedef struct snd_state {
GtkWidget *requestor_dialog;
mus_float_t bg_gradient;
- GdkCursor *arrow_cursor, *wait_cursor, *graph_cursor, *bounds_cursor, *play_cursor, *loop_play_cursor;
- gint fam_port;
+ GdkCursor *arrow_cursor, *wait_cursor, *graph_cursor, *bounds_cursor, *play_cursor, *loop_play_cursor, *yaxis_cursor;
GtkWidget **mw;
bool axis_color_set;
+
+ glistener *listener;
#endif
#if USE_NO_GUI
int data_color, selected_data_color, mix_color, basic_color, grid_color, selected_grid_color, mark_color, axis_color;
- int white, black, red, yellow, green, light_blue;
+ int white, black, red, yellow, green, blue, light_blue;
int fltenv_basic_gc, fltenv_data_gc;
int basic_gc, selected_basic_gc, combined_basic_gc;
int cursor_gc, selected_cursor_gc;
@@ -669,12 +711,19 @@ typedef struct snd_state {
int erase_gc, selected_erase_gc;
int mark_gc, selected_mark_gc;
int mix_gc;
- struct dialog_play_info *ignore_me; /* for the compiler's benefit */
+ void *ignore_me;
int requestor_dialog;
bool axis_color_set;
- int bounds_cursor, graph_cursor, play_cursor, loop_play_cursor;
+ int bounds_cursor, graph_cursor, play_cursor, loop_play_cursor, yaxis_cursor;
+#endif
+#if HAVE_SCHEME
+ s7_pointer data_color_symbol, selected_data_color_symbol, mark_color_symbol, graph_color_symbol,
+ selected_graph_color_symbol, listener_color_symbol, listener_text_color_symbol,
+ basic_color_symbol, selection_color_symbol, zoom_color_symbol, position_color_symbol,
+ highlight_color_symbol, enved_waveform_color_symbol, cursor_color_symbol,
+ text_focus_color_symbol, filter_control_waveform_color_symbol, mix_color_symbol,
+ sash_color_symbol, axis_color_symbol;
#endif
-
} snd_state;
extern snd_state *ss;
@@ -711,9 +760,10 @@ io_error_t move_file(const char *oldfile, const char *newfile);
int snd_open_read(const char *arg);
int snd_reopen_write(const char *arg);
-io_error_t snd_write_header(const char *name, int type, int srate, int chans, mus_long_t samples, int format, const char *comment, int *loops);
+io_error_t snd_write_header(const char *name, mus_header_t type, int srate, int chans, mus_long_t samples,
+ mus_sample_t sample_type, const char *comment, int *loops);
io_error_t sndlib_error_to_snd(int sndlib_err);
-int snd_file_open_descriptors(int tfd, const char *name, int format, mus_long_t location, int chans, int type);
+int snd_file_open_descriptors(int tfd, const char *name, mus_sample_t sample_type, mus_long_t location, int chans, mus_header_t type);
snd_io *make_file_state(int fd, file_info *hdr, int chan, mus_long_t beg, int suggested_bufsize);
void file_buffers_forward(mus_long_t ind0, mus_long_t ind1, mus_long_t indx, snd_fd *sf, snd_data *cur_snd);
void file_buffers_back(mus_long_t ind0, mus_long_t ind1, mus_long_t indx, snd_fd *sf, snd_data *cur_snd);
@@ -725,15 +775,14 @@ void forget_temps(void);
snd_data *make_snd_data_file(const char *name, snd_io *io, file_info *hdr, file_delete_t temp, int ctr, int temp_chan);
snd_data *copy_snd_data(snd_data *sd, mus_long_t beg, int bufsize);
snd_data *free_snd_data(snd_data *sf);
-snd_data *make_snd_data_buffer(mus_sample_t *data, int len, int ctr);
+snd_data *make_snd_data_buffer(mus_float_t *data, int len, int ctr);
snd_data *make_snd_data_buffer_for_simple_channel(int len);
int open_temp_file(const char *ofile, int chans, file_info *hdr, io_error_t *err);
-io_error_t close_temp_file(const char *filename, int ofd, int type, mus_long_t bytes);
+io_error_t close_temp_file(const char *filename, int ofd, mus_header_t type, mus_long_t bytes);
void set_up_snd_io(chan_info *cp, int i, int fd, const char *filename, file_info *hdr, bool post_close);
mus_long_t io_beg(snd_io *io);
mus_long_t io_end(snd_io *io);
-int io_filed(snd_io *io); /* io_fd is in use already */
@@ -751,7 +800,6 @@ void marks_help(void);
void mix_help(void);
void sound_files_help(void);
void init_file_help(void);
-void recording_help(void);
void region_help(void);
void selection_help(void);
void colors_help(void);
@@ -773,11 +821,11 @@ void insert_file_dialog_help(void);
void save_as_dialog_help(void);
char* word_wrap(const char *text, int widget_len);
void g_init_help(void);
-XEN g_snd_help_with_search(XEN text, int widget_wid, bool search);
-XEN g_snd_help(XEN text, int widget_wid);
+Xen g_snd_help_with_search(Xen text, int widget_wid, bool search);
+Xen g_snd_help(Xen text, int widget_wid);
const char *snd_url(const char *name);
void set_html_dir(char *new_dir);
-void key_binding_help(void);
+void key_help(void);
void play_help(void);
void save_help(void);
void reverb_help(void);
@@ -815,29 +863,6 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
void g_init_main(void);
-/* --------- snd-error.c -------- */
-
-const char *io_error_name(io_error_t err);
-#ifdef __GNUC__
- void snd_error(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
- void snd_warning(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
-#else
- void snd_error(const char *format, ...);
- void snd_warning(const char *format, ...);
-#endif
-void snd_error_without_format(const char *msg);
-void snd_warning_without_format(const char *msg);
-bool run_snd_error_hook(const char *msg);
-void g_init_errors(void);
-
-#ifdef SND_AS_WIDGET
- void set_error_display(void (*func)(const char *msg));
-#endif
-void redirect_snd_error_to(void (*handler)(const char *error_msg, void *ufd), void *data);
-void redirect_snd_warning_to(void (*handler)(const char *warning_msg, void *ufd), void *data);
-
-
-
/* -------- snd-completion.c -------- */
char *expression_completer(widget_t w, const char *text, void *data);
@@ -859,11 +884,12 @@ char *filename_completer(widget_t w, const char *text, void *data);
char *sound_filename_completer(widget_t w, const char *text, void *data);
char *srate_completer(widget_t w, const char *text, void *data);
char *list_completer(widget_t w, const char *text, void *data);
-char *info_completer(widget_t w, const char *text, void *data);
char *complete_listener_text(char *old_text, int end, bool *try_completion, char **to_file_text);
-bool separator_char_p(char c);
void add_srate_to_completion_list(int srate);
char *direct_completions(const char *str);
+#if HAVE_FORTH || HAVE_RUBY
+ void call_read_hook_or_eval(const char *text);
+#endif
@@ -911,7 +937,6 @@ mark *add_mark(mus_long_t samp, const char *name, chan_info *cp);
bool delete_mark_samp(mus_long_t samp, chan_info *cp);
void free_mark_list(ed_list *ed);
bool goto_mark(chan_info *cp, int count);
-void goto_named_mark(chan_info *cp, const char *name);
mark *active_mark(chan_info *cp);
mus_long_t mark_beg(chan_info *cp);
void display_channel_marks(chan_info *cp);
@@ -928,13 +953,12 @@ void *sound_store_marks(snd_info *sp);
void sound_restore_marks(snd_info *sp, void *marks);
mus_long_t mark_id_to_sample(int id);
-XEN new_xen_mark(int n);
-bool xen_mark_p(XEN obj);
-#define XEN_MARK_P(arg) xen_mark_p(arg)
-int xen_mark_to_int(XEN n);
-#define XEN_MARK_TO_C_INT(n) xen_mark_to_int(n)
-XEN g_mark_sync(XEN mark_n);
-XEN g_set_mark_sync(XEN mark_n, XEN sync_n);
+Xen new_xen_mark(int n);
+bool xen_is_mark(Xen obj);
+int xen_mark_to_int(Xen n);
+#define Xen_mark_to_C_int(n) xen_mark_to_int(n)
+Xen g_mark_sync(Xen mark_n);
+Xen g_set_mark_sync(Xen mark_n, Xen sync_n);
@@ -963,6 +987,7 @@ void for_each_separate_chan(void (*func)(chan_info *ncp));
bool map_over_sound_chans(snd_info *sp, bool (*func)(chan_info *ncp));
bool snd_ok(snd_info *sp);
int active_channels(virtual_channels_t count_virtual_channels);
+int syncd_channels(int sync);
int find_free_sound_slot(int desired_chans);
int find_free_sound_slot_for_channel_display(void);
snd_info *selected_sound(void);
@@ -977,7 +1002,6 @@ sync_info *snd_sync(int sync);
sync_info *sync_to_chan(chan_info *cp);
sync_info *make_simple_sync(chan_info *cp, mus_long_t beg);
snd_info *find_sound(const char *name, int nth);
-void display_info(snd_info *sp);
void mix_display_during_drag(int mix_id, mus_long_t drag_beg, mus_long_t drag_end);
void g_init_data(void);
@@ -985,6 +1009,9 @@ void g_init_data(void);
/* -------- snd-edits.c -------- */
+mus_float_t channel_maxamp(chan_info *cp, int edpos);
+mus_long_t channel_maxamp_position(chan_info *cp, int edpos);
+mus_float_t channel_maxamp_and_position(chan_info *cp, int edpos, mus_long_t *maxpos);
ed_list *initial_ed_list(mus_long_t beg, mus_long_t end);
snd_info *sound_is_silence(snd_info *sp);
mus_long_t edit_changes_begin_at(chan_info *cp, int edpos);
@@ -997,56 +1024,52 @@ void free_edit_list(chan_info *cp);
void backup_edit_list(chan_info *cp);
void as_one_edit(chan_info *cp, int one_edit);
void free_sound_list(chan_info *cp);
-void free_ptree_list(chan_info *cp);
void after_edit(chan_info *cp);
bool extend_with_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int edpos, const char *origin);
-bool insert_samples(mus_long_t beg, mus_long_t num, mus_sample_t *vals, chan_info *cp, const char *origin, int edpos);
+bool insert_samples(mus_long_t beg, mus_long_t num, mus_float_t *vals, chan_info *cp, const char *origin, int edpos);
bool file_insert_samples(mus_long_t beg, mus_long_t num, const char *tempfile, chan_info *cp, int chan,
file_delete_t auto_delete, const char *origin, int edpos);
bool insert_complete_file_at_cursor(snd_info *sp, const char *filename);
bool insert_complete_file(snd_info *sp, const char *str, mus_long_t chan_beg, file_delete_t auto_delete);
bool delete_samples(mus_long_t beg, mus_long_t num, chan_info *cp, int edpos);
-bool change_samples(mus_long_t beg, mus_long_t num, mus_sample_t *vals, chan_info *cp, const char *origin, int edpos);
+bool change_samples(mus_long_t beg, mus_long_t num, mus_float_t *vals, chan_info *cp, const char *origin, int edpos, mus_float_t mx);
bool file_change_samples(mus_long_t beg, mus_long_t num, const char *tempfile, chan_info *cp, int chan, file_delete_t auto_delete, const char *origin, int edpos);
bool file_override_samples(mus_long_t num, const char *tempfile, chan_info *cp, int chan, file_delete_t auto_delete, const char *origin);
mus_float_t chn_sample(mus_long_t samp, chan_info *cp, int pos);
-void check_saved_temp_file(const char *type, XEN filename, XEN date_and_length);
-bool editable_p(chan_info *cp);
-file_delete_t xen_to_file_delete_t(XEN auto_delete, const char *caller);
+void check_saved_temp_file(const char *type, Xen filename, Xen date_and_length);
+bool is_editable(chan_info *cp);
+file_delete_t xen_to_file_delete_t(Xen auto_delete, const char *caller);
snd_fd *free_snd_fd(snd_fd *sf);
char *sampler_to_string(snd_fd *fd);
-bool sampler_p(XEN obj);
-snd_fd *xen_to_sampler(XEN obj);
+bool is_sampler(Xen obj);
+snd_fd *xen_to_sampler(Xen obj);
snd_fd *free_snd_fd_almost(snd_fd *sf);
bool scale_channel(chan_info *cp, mus_float_t scaler, mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit);
bool scale_channel_with_origin(chan_info *cp, mus_float_t scl, mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit, const char *origin);
bool ramp_channel(chan_info *cp, double start, double incr, mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit);
bool xramp_channel(chan_info *cp, double start, double incr, double scaler, double offset,
mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit, mus_any *e, int xramp_seg_loc);
-void ptree_channel(chan_info *cp, struct ptree *tree, mus_long_t beg, mus_long_t num, int pos, bool env_it, XEN init_func, const char *origin);
snd_fd *init_sample_read(mus_long_t samp, chan_info *cp, read_direction_t direction);
snd_fd *init_sample_read_any(mus_long_t samp, chan_info *cp, read_direction_t direction, int edit_position);
snd_fd *init_sample_read_any_with_bufsize(mus_long_t samp, chan_info *cp, read_direction_t direction, int edit_position, int bufsize);
void read_sample_change_direction(snd_fd *sf, read_direction_t dir);
+void sampler_set_safe(snd_fd *sf, mus_long_t dur);
bool unrampable(chan_info *cp, mus_long_t beg, mus_long_t dur, int pos, bool is_xramp);
-bool ptree_or_sound_fragments_in_use(chan_info *cp, int pos);
-bool unptreeable(chan_info *cp, mus_long_t beg, mus_long_t dur, int pos);
-#define read_sample_to_mus_sample(Sf) MUS_FLOAT_TO_SAMPLE((*((Sf)->runf))(Sf))
+bool sound_fragments_in_use(chan_info *cp, int pos);
#define read_sample(Sf) (*((Sf)->runf))(Sf)
-mus_float_t protected_next_sample(snd_fd *sf);
-mus_float_t protected_previous_sample(snd_fd *sf);
mus_float_t channel_local_maxamp(chan_info *cp, mus_long_t beg, mus_long_t num, int edpos, mus_long_t *maxpos);
bool undo_edit_with_sync(chan_info *cp, int count);
bool redo_edit_with_sync(chan_info *cp, int count);
bool undo_edit(chan_info *cp, int count);
bool redo_edit(chan_info *cp, int count);
io_error_t save_channel_edits(chan_info *cp, const char *ofile, int pos);
-io_error_t channel_to_file_with_settings(chan_info *cp, const char *new_name, int type, int format, int srate, const char *comment, int pos);
+io_error_t channel_to_file_with_settings(chan_info *cp, const char *new_name, int srate,
+ mus_sample_t samp_type, mus_header_t hd_type, const char *comment, int pos);
io_error_t save_edits(snd_info *sp);
io_error_t save_edits_without_asking(snd_info *sp);
-void save_edits_with_prompt(snd_info *sp);
io_error_t save_edits_and_update_display(snd_info *sp);
-io_error_t save_edits_without_display(snd_info *sp, const char *new_name, int type, int format, int srate, const char *comment, int pos);
+io_error_t save_edits_without_display(snd_info *sp, const char *new_name, mus_header_t type,
+ mus_sample_t sample_type, int srate, const char *comment, int pos);
void revert_edits(chan_info *cp);
mus_long_t current_location(snd_fd *sf);
void g_init_edits(void);
@@ -1061,10 +1084,7 @@ mus_long_t ed_selection_maxamp_position(chan_info *cp);
void copy_then_swap_channels(chan_info *cp0, chan_info *cp1, int pos0, int pos1);
void reflect_file_change_in_label(chan_info *cp);
void reflect_file_change_in_title(void);
-
-bool snd_to_sample_p(mus_any *ptr);
-mus_float_t snd_to_sample_read(mus_any *ptr, mus_long_t frame, int chan);
-int mix_buffer_with_tag(chan_info *cp, mus_sample_t *data, mus_long_t beg, mus_long_t num, const char *origin);
+int mix_buffer_with_tag(chan_info *cp, mus_float_t *data, mus_long_t beg, mus_long_t num, const char *origin);
int mix_file_with_tag(chan_info *cp, const char *filename, int chan, mus_long_t beg, file_delete_t auto_delete, const char *origin);
void unmix(chan_info *cp, mix_state *ms);
@@ -1074,10 +1094,10 @@ bool virtual_mix_ok(chan_info *cp, int edpos);
bool begin_mix_op(chan_info *cp, mus_long_t old_beg, mus_long_t old_len, mus_long_t new_beg, mus_long_t new_len, int edpos, const char *caller);
void end_mix_op(chan_info *cp, mus_long_t old_beg, mus_long_t old_len);
void prepare_sound_list(chan_info *cp);
-XEN g_sampler_file_name(XEN obj);
-
-vct *run_samples_to_vct(mus_long_t beg, mus_long_t len, chan_info *cp, int pos);
+Xen g_sampler_file_name(Xen obj);
char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos);
+vct *samples_to_vct(mus_long_t beg, mus_long_t len, chan_info *cp, int pos, mus_float_t *buf, snd_fd *reader);
+vct *samples_to_vct_with_reader(mus_long_t len, mus_float_t *buf, snd_fd *reader);
@@ -1112,47 +1132,57 @@ int transform_position_to_type(int pos);
int transform_type_to_position(int type);
int max_transform_type(void);
void set_transform_position(int i, int j);
-bool transform_p(int type);
+bool is_transform(int type);
-XEN new_xen_transform(int n);
-bool xen_transform_p(XEN obj);
-int xen_transform_to_int(XEN n);
-#define XEN_TRANSFORM_P(arg) xen_transform_p(arg)
-#define C_INT_TO_XEN_TRANSFORM(Val) new_xen_transform(Val)
-#define XEN_TRANSFORM_TO_C_INT(n) xen_transform_to_int(n)
+Xen new_xen_transform(int n);
+bool xen_is_transform(Xen obj);
+int xen_transform_to_int(Xen n);
+#define C_int_to_Xen_transform(Val) new_xen_transform(Val)
+#define Xen_transform_to_C_int(n) xen_transform_to_int(n)
/* -------- snd-xen.c -------- */
+const char *io_error_name(io_error_t err);
+#ifdef __GNUC__
+ void snd_error(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
+ void snd_warning(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
+#else
+ void snd_error(const char *format, ...);
+ void snd_warning(const char *format, ...);
+#endif
+void snd_error_without_format(const char *msg);
+void snd_warning_without_format(const char *msg);
+void redirect_snd_error_to(void (*handler)(const char *error_msg, void *ufd), void *data);
+void redirect_snd_warning_to(void (*handler)(const char *warning_msg, void *ufd), void *data);
+
+char *stdin_check_for_full_expression(const char *newstr);
+void stdin_free_str(void);
+
void redirect_xen_error_to(void (*handler)(const char *msg, void *ufd), void *data);
-void redirect_snd_print_to(void (*handler)(const char *msg, void *ufd), void *data);
void redirect_errors_to(void (*handler)(const char *msg, void *ufd), void *data);
void redirect_everything_to(void (*handler)(const char *msg, void *ufd), void *data);
-XEN snd_catch_any(XEN_CATCH_BODY_TYPE body, void *body_data, const char *caller);
-XEN snd_throw(XEN key, XEN args);
-XEN snd_no_such_file_error(const char *caller, XEN filename);
-XEN snd_no_such_channel_error(const char *caller, XEN snd, XEN chn);
-XEN snd_bad_arity_error(const char *caller, XEN errstr, XEN proc);
-XEN snd_no_active_selection_error(const char *caller);
+Xen snd_catch_any(Xen_catch_t body, void *body_data, const char *caller);
+Xen snd_throw(Xen key, Xen args);
+Xen snd_no_such_file_error(const char *caller, Xen filename);
+Xen snd_no_such_channel_error(const char *caller, Xen snd, Xen chn);
+Xen snd_bad_arity_error(const char *caller, Xen errstr, Xen proc);
+Xen snd_no_active_selection_error(const char *caller);
void g_xen_initialize(void);
-XEN eval_str_wrapper(void *data);
-XEN eval_form_wrapper(void *data);
-XEN string_to_form(const char *data);
-XEN g_c_make_sampler(snd_fd *fd);
-char *procedure_ok(XEN proc, int args, const char *caller, const char *arg_name, int argn);
-bool procedure_arity_ok(XEN proc, int args);
-int snd_protect(XEN obj);
+Xen eval_str_wrapper(void *data);
+Xen g_c_make_sampler(snd_fd *fd);
+char *procedure_ok(Xen proc, int args, const char *caller, const char *arg_name, int argn);
+bool procedure_arity_ok(Xen proc, int args);
+int snd_protect(Xen obj);
void snd_unprotect_at(int loc);
-XEN snd_protected_at(int loc);
-XEN run_or_hook(XEN hook, XEN args, const char *caller);
-XEN run_progn_hook(XEN hook, XEN args, const char *caller);
-XEN run_hook(XEN hook, XEN args, const char *caller);
-bool listener_print_p(const char *msg);
+Xen run_or_hook(Xen hook, Xen args, const char *caller);
+Xen run_progn_hook(Xen hook, Xen args, const char *caller);
+Xen run_hook(Xen hook, Xen args, const char *caller);
void check_features_list(const char *features);
#if (!USE_NO_GUI)
- mus_float_t check_color_range(const char *caller, XEN val);
+ mus_float_t check_color_range(const char *caller, Xen val);
#endif
void set_basic_color(color_t color);
void set_highlight_color(color_t color);
@@ -1169,14 +1199,14 @@ char *output_comment(file_info *hdr);
void snd_load_init_file(bool nog, bool noi);
void snd_load_file(const char *filename);
void snd_display_result(const char *str, const char *endstr);
-void snd_report_result(XEN result, const char *buf);
-void snd_report_listener_result(XEN form);
+void snd_report_result(Xen result, const char *buf);
+void snd_report_listener_result(Xen form);
void snd_eval_stdin_str(const char *buf);
void clear_stdin(void);
#if HAVE_RUBY
- void snd_rb_raise(XEN type, XEN info);
+ void snd_rb_raise(Xen type, Xen info);
#endif
-bool source_file_p(const char *name);
+bool is_source_file(const char *name);
void save_added_source_file_extensions(FILE *fd);
@@ -1209,19 +1239,17 @@ bool delete_selection(cut_selection_regraph_t regraph);
void move_selection(chan_info *cp, int x);
void finish_selection_creation(void);
int select_all(chan_info *cp);
-io_error_t save_selection(const char *ofile, int type, int format, int srate, const char *comment, int chan);
+io_error_t save_selection(const char *ofile, int srate, mus_sample_t samp_type, mus_header_t head_type, const char *comment, int chan);
bool selection_creation_in_progress(void);
void add_selection_or_region(int reg, chan_info *cp);
void insert_selection_from_menu(void);
-void insert_selection_or_region(int reg, chan_info *cp);
void cancel_selection_watch(void);
void show_selection(void);
-bool xen_selection_p(XEN obj);
-#define XEN_SELECTION_P(arg) xen_selection_p(arg)
-XEN g_selection_chans(void);
-XEN g_selection_srate(void);
-XEN g_selection_maxamp(XEN snd, XEN chn);
-XEN g_selection_frames(XEN snd, XEN chn);
+bool xen_is_selection(Xen obj);
+Xen g_selection_chans(void);
+Xen g_selection_srate(void);
+Xen g_selection_maxamp(Xen snd, Xen chn);
+Xen g_selection_framples(Xen snd, Xen chn);
void g_init_selection(void);
@@ -1248,7 +1276,7 @@ snd_fd *init_region_read(mus_long_t beg, int n, int chan, read_direction_t direc
void cleanup_region_temp_files(void);
int snd_regions(void);
void save_regions(FILE *fd);
-io_error_t save_region(int rg, const char *name, int type, int format, const char *comment);
+io_error_t save_region(int rg, const char *name, mus_sample_t samp_type, mus_header_t head_type, const char *comment);
void region_edit(int reg);
void clear_region_backpointer(snd_info *sp);
void save_region_backpointer(snd_info *sp);
@@ -1258,17 +1286,17 @@ void for_each_region_chan_with_refint(void (*func)(chan_info *ncp, int *val), in
mus_long_t region_current_location(snd_fd *fd);
char *region_description(int rg);
-XEN new_xen_region(int n);
-bool xen_region_p(XEN obj);
-int xen_region_to_int(XEN n);
-#define XEN_REGION_P(arg) xen_region_p(arg)
-#define C_INT_TO_XEN_REGION(Val) new_xen_region(Val)
-#define XEN_REGION_TO_C_INT(n) xen_region_to_int(n)
-XEN g_region_srate(XEN n);
-XEN g_region_chans(XEN n);
-XEN g_region_frames(XEN n, XEN chan);
-XEN g_region_maxamp(XEN n);
-XEN g_play_region(XEN n, play_process_t back, XEN stop_proc);
+Xen new_xen_region(int n);
+bool xen_is_region(Xen obj);
+int xen_region_to_int(Xen n);
+#define C_int_to_Xen_region(Val) new_xen_region(Val)
+#define Xen_region_to_C_int(n) xen_region_to_int(n)
+Xen g_region_srate(Xen n);
+Xen g_region_chans(Xen n);
+Xen g_region_framples(Xen n, Xen chan);
+Xen g_region_maxamp(Xen n);
+Xen g_play_region(Xen n, play_process_t back, Xen stop_proc);
+Xen g_region_to_vct(Xen reg_n, Xen beg_n, Xen num, Xen chn_n, Xen v);
@@ -1279,7 +1307,7 @@ env *free_env(env *e);
char *env_to_string(env *e);
env *make_envelope_with_offset_and_scaler(mus_float_t *env_buffer, int len, mus_float_t offset, mus_float_t scaler);
env *default_env(mus_float_t x1, mus_float_t y);
-bool default_env_p(env *e);
+bool is_default_env(env *e);
bool envs_equal(env *e1, env *e2);
env_editor *new_env_editor(void);
void env_editor_button_motion_with_xy(env_editor *edp, int evx, int evy, oclock_t motion_time, env *e, mus_float_t *new_x, mus_float_t *new_y);
@@ -1300,7 +1328,7 @@ void revert_env_edit(void);
int enved_all_envs_top(void);
char *enved_all_names(int n);
void set_enved_env_list_top(int n);
-env *enved_all_envs(int pos);
+/* env *enved_all_envs(int pos); */
void alert_envelope_editor(const char *name, env *val);
void enved_show_background_waveform(axis_info *ap, axis_info *gray_ap, bool apply_to_selection, bool show_fft, printing_t printing);
void save_envelope_editor_state(FILE *fd);
@@ -1310,13 +1338,13 @@ env *string_to_env(const char *str);
void add_or_edit_symbol(const char *name, env *val);
env* name_to_env(const char *str);
env *position_to_env(int pos);
-void delete_envelope(const char *name);
+/* void delete_envelope(const char *name); */
enved_fft *free_enved_fft(enved_fft *ef);
void reflect_enved_fft_change(chan_info *cp);
-XEN env_to_xen(env *e);
-env *xen_to_env(XEN res);
-env *get_env(XEN e, const char *origin);
+Xen env_to_xen(env *e);
+env *xen_to_env(Xen res);
+env *get_env(Xen e, const char *origin);
void g_init_env(void);
@@ -1329,18 +1357,18 @@ void stop_playing_sound_no_toggle(snd_info *sp, play_stop_t reason);
void stop_playing_all_sounds(play_stop_t reason);
void stop_playing_region(int n, play_stop_t reason);
void play_region(int n, play_process_t background);
-void play_region_1(int region, play_process_t background, XEN stop_proc);
+void play_region_1(int region, play_process_t background, Xen stop_proc);
void play_channel(chan_info *cp, mus_long_t start, mus_long_t end);
void play_channel_with_sync(chan_info *cp, mus_long_t start, mus_long_t end);
void play_sound(snd_info *sp, mus_long_t start, mus_long_t end);
void play_channels(chan_info **cps, int chans, mus_long_t *starts, mus_long_t *ur_ends,
- play_process_t background, XEN edpos, bool selection, const char *caller, int arg_pos);
+ play_process_t background, Xen edpos, bool selection, const char *caller, int arg_pos);
void play_selection(play_process_t background);
void loop_play_selection(void);
bool add_mix_to_play_list(mix_state *ms, chan_info *cp, mus_long_t beg_within_mix, bool start_playing);
void toggle_dac_pausing(void); /* snd-dac.c */
bool play_in_progress(void);
-void initialize_apply(snd_info *sp, int chans, mus_long_t beg, mus_long_t frames);
+void initialize_apply(snd_info *sp, int chans, mus_long_t beg, mus_long_t framples);
void finalize_apply(snd_info *sp);
int run_apply(int ofd);
mus_float_t *sample_linear_env(env *e, int order);
@@ -1348,11 +1376,10 @@ mus_float_t *sample_linear_env(env *e, int order);
void g_init_dac(void);
void clear_players(void);
-bool xen_player_p(XEN obj);
-#define XEN_PLAYER_P(arg) xen_player_p(arg)
-#define IS_PLAYER_SOUND(Sp) ((Sp) && ((Sp)->index < 0))
-snd_info *get_player_sound(XEN player);
-XEN no_such_player_error(const char *caller, XEN player);
+bool xen_is_player(Xen obj);
+#define is_player_sound(Sp) ((Sp) && ((Sp)->index < 0))
+snd_info *get_player_sound(Xen player);
+Xen no_such_player_error(const char *caller, Xen player);
void dac_set_expand(snd_info *sp, mus_float_t newval);
void dac_set_expand_length(snd_info *sp, mus_float_t newval);
@@ -1366,10 +1393,9 @@ void dac_set_reverb_lowpass(snd_info *sp, mus_float_t newval);
/* -------- snd-chn.c -------- */
-bool graph_style_p(int grf);
-chan_info *get_cp(XEN snd_n, XEN chn_n, const char *caller);
-snd_info *make_simple_channel_display(int srate, int initial_length, fw_button_t with_arrows,
- graph_style_t grf_style, widget_t container, bool with_events);
+bool is_graph_style(int grf);
+chan_info *get_cp(Xen snd_n, Xen chn_n, const char *caller);
+snd_info *make_simple_channel_display(int srate, int initial_length, fw_button_t with_arrows, graph_style_t grf_style, widget_t container, bool with_events);
axis_info *lisp_info_axis(chan_info *cp);
void free_lisp_info(chan_info *cp);
void zx_incremented(chan_info *cp, double amount);
@@ -1407,26 +1433,25 @@ void update_graph(chan_info *cp);
void update_graph_or_warn(chan_info *cp);
void make_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end);
void add_channel_data(char *filename, chan_info *cp, channel_graph_t graphed);
-void add_channel_data_1(chan_info *cp, int srate, mus_long_t frames, channel_graph_t graphed);
+bool add_channel_data_1(chan_info *cp, int srate, mus_long_t framples, channel_graph_t graphed);
void set_x_bounds(axis_info *ap);
void set_show_axes(show_axes_t val);
void display_channel_data(chan_info *cp);
void display_channel_fft_data(chan_info *cp);
void display_channel_time_data(chan_info *cp);
void show_cursor_info(chan_info *cp);
-void apply_x_axis_change(axis_info *ap, chan_info *cp);
-void apply_y_axis_change(axis_info *ap, chan_info *cp);
+void apply_x_axis_change(chan_info *cp);
+void apply_y_axis_change(chan_info *cp);
void sx_incremented(chan_info *cp, double amount);
-int move_axis(chan_info *cp, axis_info *ap, int x);
+int move_axis(chan_info *cp, int x);
void set_axes(chan_info *cp, double x0, double x1, mus_float_t y0, mus_float_t y1);
-void focus_x_axis_change(axis_info *ap, chan_info *cp, int focus_style);
-bool key_press_callback(chan_info *ur_cp, int x, int y, int key_state, int keysym);
+void focus_x_axis_change(chan_info *cp, int focus_style);
+void key_press_callback(chan_info *ur_cp, int x, int y, int key_state, int keysym);
void graph_button_press_callback(chan_info *cp, void *ev, int x, int y, int key_state, int button, oclock_t time);
void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, int button);
void graph_button_motion_callback(chan_info *cp, int x, int y, oclock_t time);
void channel_resize(chan_info *cp);
void edit_history_select(chan_info *cp, int row);
-int make_graph(chan_info *cp);
int make_background_graph(chan_info *cp, int srate, bool *two_sided);
int make_dragged_marks_graph(chan_info *cp);
void reset_spectro(void);
@@ -1440,9 +1465,10 @@ void set_show_mix_waveforms(bool val);
void clear_inset_graph(chan_info *cp);
void free_inset_graph(chan_info *cp);
void draw_inset_line_cursor(chan_info *cp, graphics_context *ax);
+void make_sonogram(chan_info *cp);
void g_init_chn(void);
-XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t hisamp);
+Xen make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t hisamp);
void draw_graph_data(chan_info *cp, mus_long_t losamp, mus_long_t hisamp, int data_size, mus_float_t *data, mus_float_t *data1, graphics_context *ax, graph_style_t style);
void fftb(chan_info *cp, bool on);
@@ -1459,12 +1485,12 @@ graphics_context *cursor_context(chan_info *cp);
void calculate_fft(chan_info *cp);
void set_min_db(mus_float_t db);
void set_x_axis_style(x_axis_style_t val);
-void set_verbose_cursor(bool val);
+void set_with_verbose_cursor(bool val);
void set_graph_style(graph_style_t val);
void set_show_marks(bool val);
void set_show_y_zero(bool val);
-XEN g_frames(XEN snd_n, XEN chn_n, XEN edpos);
+Xen g_framples(Xen snd_n, Xen chn_n, Xen edpos);
void check_cursor_shape(chan_info *cp, int x, int y);
widget_t channel_to_widget(chan_info *cp);
chan_info *channel_to_chan(chan_info *cp);
@@ -1473,8 +1499,8 @@ chan_info *channel_to_chan(chan_info *cp);
/* -------- snd-axis.c -------- */
-bool x_axis_style_p(int n);
-bool show_axes_p(int n);
+bool is_x_axis_style(int n);
+bool shows_axes(int n);
axis_info *free_axis_info(axis_info *ap);
char *x_axis_location_to_string(chan_info *cp, double loc);
int grf_x(double val, axis_info *ap);
@@ -1503,7 +1529,7 @@ void set_numbers_font(graphics_context *ax, printing_t printing, bool use_tiny_f
/* -------- snd-snd.c -------- */
-snd_info *get_sp(XEN snd_n);
+snd_info *get_sp(Xen snd_n);
peak_env_info *free_peak_env(chan_info *cp, int pos);
void free_peak_env_state(chan_info *cp);
peak_env_info *free_peak_env_info(peak_env_info *ep);
@@ -1513,21 +1539,19 @@ void finish_peak_env(chan_info *cp);
bool peak_env_maxamp_ok(chan_info *cp, int edpos);
mus_float_t peak_env_maxamp(chan_info *cp, int edpos);
bool peak_env_usable(chan_info *cp, mus_float_t samples_per_pixel, mus_long_t hisamp, bool start_new, int edit_pos, bool finish_env);
-int peak_env_graph(chan_info *cp, axis_info *ap, mus_float_t samples_per_pixel, int srate);
-int peak_env_partial_graph(chan_info *cp, axis_info *ap, mus_long_t beg, mus_long_t end, mus_float_t samples_per_pixel, int srate);
+int peak_env_graph(chan_info *cp, mus_float_t samples_per_pixel, int srate);
+int peak_env_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end, mus_float_t samples_per_pixel, int srate);
char *shortname(snd_info *sp);
char *shortname_indexed(snd_info *sp);
void add_sound_data(char *filename, snd_info *sp, channel_graph_t graphed);
mus_float_t speed_changed(mus_float_t ival, char *srcbuf, speed_style_t style, int tones, int srcbuf_size);
-void sp_name_click(snd_info *sp);
+char *sp_name_click(snd_info *sp);
void free_controls(snd_info *sp);
void save_controls(snd_info *sp);
void restore_controls(snd_info *sp);
void reset_controls(snd_info *sp);
void set_show_controls(bool val);
void stop_applying(snd_info *sp);
-void menu_apply_controls(snd_info *sp);
-void menu_reset_controls(snd_info *sp);
void expand_control_set_hop(mus_float_t hop);
void expand_control_set_length(mus_float_t hop);
void expand_control_set_ramp(mus_float_t hop);
@@ -1538,38 +1562,36 @@ void reverb_control_set_feedback(mus_float_t hop);
void amp_env_env(chan_info *cp, mus_float_t *brkpts, int npts, int pos, mus_float_t base, mus_float_t scaler, mus_float_t offset);
peak_env_info *copy_peak_env_info(peak_env_info *old_ep, bool reversed);
void amp_env_env_selection_by(chan_info *cp, mus_any *e, mus_long_t beg, mus_long_t num, int pos);
-void peak_env_ptree(chan_info *cp, struct ptree *pt, int pos, XEN init_func);
-void peak_env_ptree_selection(chan_info *cp, struct ptree *pt, mus_long_t beg, mus_long_t num, int pos, XEN init_func);
void peak_env_insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int pos);
-snd_info *snd_new_file(const char *newname, int header_type, int data_format, int srate, int chans, const char *new_comment, mus_long_t samples);
+snd_info *snd_new_file(const char *newname, int chans, int srate, mus_sample_t sample_type,
+ mus_header_t header_type, const char *new_comment, mus_long_t samples);
#if XEN_HAVE_RATIOS
void snd_rationalize(mus_float_t a, int *num, int *den);
#endif
+#ifdef __GNUC__
+ void status_report(snd_info *sp, const char *format, ...) __attribute__ ((format (printf, 2, 3)));
+#else
+ void status_report(snd_info *sp, const char *format, ...);
+#endif
+void errors_to_status_area(const char *msg, void *data);
+void printout_to_status_area(const char *msg, void *data);
+void clear_status_area(snd_info *sp);;
void g_init_snd(void);
-XEN snd_no_such_sound_error(const char *caller, XEN n);
+Xen snd_no_such_sound_error(const char *caller, Xen n);
void peak_env_scale_by(chan_info *cp, mus_float_t scl, int pos);
void peak_env_scale_selection_by(chan_info *cp, mus_float_t scl, mus_long_t beg, mus_long_t num, int pos);
peak_env_info *peak_env_copy(chan_info *cp, bool reversed, int edpos);
peak_env_info *peak_env_section(chan_info *cp, mus_long_t beg, mus_long_t num, int edpos);
void pick_one_bin(peak_env_info *ep, int bin, mus_long_t cursamp, chan_info *cp, int edpos);
-void remember_mini_string(snd_info *sp, const char *str);
-void restore_mini_string(snd_info *s, bool back);
-void clear_mini_strings(snd_info *sp);
-void remember_filter_string(snd_info *sp, const char *str);
-void restore_filter_string(snd_info *s, bool back);
-void clear_filter_strings(snd_info *sp);
-void remember_listener_string(const char *str);
-void restore_listener_string(bool back);
void set_channel_style(channel_style_t val);
-XEN new_xen_sound(int n);
-bool xen_sound_p(XEN obj);
-int xen_sound_to_int(XEN n);
-#define XEN_SOUND_P(arg) xen_sound_p(arg)
-#define C_INT_TO_XEN_SOUND(Val) new_xen_sound(Val)
-#define XEN_SOUND_TO_C_INT(n) xen_sound_to_int(n)
+Xen new_xen_sound(int n);
+bool xen_is_sound(Xen obj);
+int xen_sound_to_int(Xen n);
+#define C_int_to_Xen_sound(Val) new_xen_sound(Val)
+#define Xen_sound_to_C_int(n) xen_sound_to_int(n)
const char *read_peak_env_info_file(chan_info *cp);
bool write_peak_env_info_file(chan_info *cp);
@@ -1579,49 +1601,47 @@ void delete_peak_env_info_file(chan_info *cp);
/* -------- snd-file -------- */
-void *free_axes_data(void *sa);
-void *make_axes_data(snd_info *sp);
-void restore_axes_data(snd_info *sp, void *sa, mus_float_t new_duration, bool need_edit_history_update);
+axes_data *free_axes_data(axes_data *sa);
+axes_data *make_axes_data(snd_info *sp);
+void restore_axes_data(snd_info *sp, axes_data *sa, mus_float_t new_duration, bool need_edit_history_update);
mus_long_t disk_kspace(const char *filename);
time_t file_write_date(const char *filename);
-bool link_p(const char *filename);
+bool is_link_file(const char *filename);
int recent_files_size(void);
char **recent_files(void);
-bool directory_p(const char *filename);
+bool is_directory(const char *filename);
file_info *make_file_info(const char *fullname, read_only_t read_only, bool selected);
file_info *free_file_info(file_info *hdr);
file_info *copy_header(const char *fullname, file_info *ohdr);
file_info *make_temp_header(const char *fullname, int srate, int chans, mus_long_t samples, const char *caller);
-bool sound_file_p(const char *name);
+bool is_sound_file(const char *name);
void init_sound_file_extensions(void);
void save_added_sound_file_extensions(FILE *fd);
+const char **get_sound_file_extensions(void);
+int sound_file_extensions_length(void);
snd_info *snd_open_file(const char *filename, read_only_t read_only);
void snd_close_file(snd_info *sp);
snd_info *make_sound_readable(const char *filename, bool post_close);
snd_info *snd_update(snd_info *sp);
snd_info *snd_update_within_xen(snd_info *sp, const char *caller);
-int snd_decode(int type, const char *input_filename, const char *output_filename);
+int snd_decode(mus_header_t type, const char *input_filename, const char *output_filename);
void set_fallback_srate(int sr);
void set_fallback_chans(int ch);
-void set_fallback_format(int fr);
+void set_fallback_sample_type(mus_sample_t fr);
void set_with_tooltips(bool val);
void run_after_save_as_hook(snd_info *sp, const char *already_saved_as_name, bool from_save_as_dialog);
-bool run_before_save_as_hook(snd_info *sp, const char *save_as_filename, bool selection, int srate, int type, int format, const char *comment);
+bool run_before_save_as_hook(snd_info *sp, const char *save_as_filename, bool selection, int srate,
+ mus_sample_t smp_type, mus_header_t hd_type, const char *comment);
void during_open(int fd, const char *file, open_reason_t reason);
void after_open(snd_info *sp);
-char *output_name(const char *current_name);
-void save_view_files_dialogs(FILE *fd);
-widget_t start_view_files_dialog(bool managed, bool make_new);
-void view_files_unplay(void);
-void view_files_add_directory(widget_t dialog, const char *dirname);
-char *view_files_find_any_directory(void);
-int view_files_dialog_list_length(void);
-char **view_files_dialog_titles(void);
-void view_files_start_dialog_with_title(const char *title);
void set_with_toolbar_and_display(bool val);
+#if (!USE_NO_GUI)
+ void display_info(snd_info *sp);
+#endif
void g_init_file(void);
-void initialize_format_lists(void);
+void initialize_sample_type_lists(void);
void set_with_menu_icons(bool val);
+Xen g_expand_vector(Xen vector, int new_size);
@@ -1642,7 +1662,6 @@ bool snd_feq(mus_float_t val1, mus_float_t val2);
mus_float_t in_dB(mus_float_t min_dB, mus_float_t lin_dB, mus_float_t val);
#endif
-int snd_mkdir(const char *filename);
char *snd_local_time(void);
char *snd_io_strerror(void);
char *snd_open_strerror(void);
@@ -1660,38 +1679,25 @@ char *file_to_string(const char *filename);
char *snd_strftime(const char *format, time_t date);
#endif
-disk_space_t disk_space_p(mus_long_t bytes, const char *filename);
+disk_space_t disk_has_space(mus_long_t bytes, const char *filename);
char *prettyf(double num, int tens);
char *shorter_tempnam(const char *dir, const char *prefix);
char *snd_tempnam(void);
void snd_exit(int val);
void g_init_utils(void);
-fam_info *fam_monitor_file(const char *filename,
- void *data,
- void (*action)(struct fam_info *fp, FAMEvent *fe));
-fam_info *fam_monitor_directory(const char *dir_name,
- void *data,
- void (*action)(struct fam_info *fp, FAMEvent *fe));
-fam_info *fam_unmonitor_file(const char *filename, fam_info *fp);
-fam_info *fam_unmonitor_directory(const char *filename, fam_info *fp);
-
/* -------- snd-listener -------- */
-void backup_listener_to_previous_expression(void);
-void listener_return(widget_t w, int last_prompt);
-bool is_prompt(const char *str, int beg);
-bool within_prompt(const char *str, int beg, int end);
-char *listener_prompt_with_cr(void);
+void g_init_listener(void);
+#if HAVE_SCHEME
+void listener_begin_hook(s7_scheme *sc, bool *val);
+#endif
void set_listener_prompt(const char *new_prompt);
-int check_balance(const char *expr, int start, int end, bool in_listener);
-int find_matching_paren(const char *str, int parens, int pos, int *highlight_pos);
bool listener_is_visible(void);
-void g_init_listener(void);
-char *trim(char *orig);
-void listener_help_at_cursor(char *buf, int name_curpos, int len, int prompt_pos);
+Xen run_read_hook(char *str);
+bool have_read_hook(void);
@@ -1719,18 +1725,17 @@ void delete_any_remaining_mix_temp_files_at_exit(chan_info *cp);
int mix_sync_from_id(int id);
int mix_set_sync_from_id(int id, int new_sync);
void set_mix_waveform_height(int new_val);
-XEN new_xen_mix(int n);
-XEN g_make_mix_sampler(XEN mix_id, XEN ubeg);
-bool xen_mix_p(XEN obj);
-#define XEN_MIX_P(arg) xen_mix_p(arg)
-snd_fd *xen_mix_to_snd_fd(XEN obj);
-int xen_mix_to_int(XEN n);
-#define XEN_MIX_TO_C_INT(n) xen_mix_to_int(n)
-XEN g_mix_length(XEN n);
-XEN g_mix_sync(XEN n);
-XEN g_set_mix_sync(XEN n, XEN val);
-XEN g_mix_maxamp(XEN mix_id);
-double mix_maxamp(int mix_id);
+Xen new_xen_mix(int n);
+Xen g_make_mix_sampler(Xen mix_id, Xen ubeg);
+bool xen_is_mix(Xen obj);
+snd_fd *xen_mix_to_snd_fd(Xen obj);
+int xen_mix_to_int(Xen n);
+#define Xen_mix_to_C_int(n) xen_mix_to_int(n)
+Xen g_mix_length(Xen n);
+Xen g_mix_sync(Xen n);
+Xen g_set_mix_sync(Xen n, Xen val);
+Xen g_mix_maxamp(Xen mix_id);
+Xen g_mix_to_vct(Xen mix_n, Xen beg_n, Xen num);
mus_long_t mix_position_from_id(int id);
mus_long_t mix_length_from_id(int id);
@@ -1771,12 +1776,12 @@ int mix_complete_file(snd_info *sp, mus_long_t beg, const char *fullname, bool w
int mix_complete_file_at_cursor(snd_info *sp, const char *str);
int mix_file(mus_long_t beg, mus_long_t num, int chans, chan_info **cps, const char *mixinfile, file_delete_t temp, const char *origin, bool with_tag, int start_chan);
-bool mix_sampler_p(XEN obj);
-XEN g_copy_mix_sampler(XEN obj);
-XEN g_mix_sampler_home(XEN obj);
-XEN g_mix_sampler_at_end_p(XEN obj);
-XEN g_mix_sampler_position(XEN obj);
-XEN g_free_mix_sampler(XEN obj);
+bool is_mix_sampler(Xen obj);
+Xen g_copy_mix_sampler(Xen obj);
+Xen g_mix_sampler_home(Xen obj);
+Xen g_mix_sampler_is_at_end(Xen obj);
+Xen g_mix_sampler_position(Xen obj);
+Xen g_free_mix_sampler(Xen obj);
char *edit_list_mix_init(chan_info *cp);
void channel_set_mix_tags_erased(chan_info *cp);
void color_mixes(color_t color);
@@ -1788,58 +1793,42 @@ int prepare_mix_dialog_waveform(int mix_id, axis_info *ap, bool *two_sided);
void display_channel_mixes(chan_info *cp);
bool play_mix_from_id(int mix_id);
-XEN g_play_mix(XEN num, mus_long_t beg);
+Xen g_play_mix(Xen num, mus_long_t beg);
void drag_and_drop_mix_at_x_y(int data, const char *filename, int x, int y);
+snd_fd *mf_to_snd_fd(void *p);
/* -------- snd-find.c -------- */
-char *global_search(read_direction_t direction);
-void cursor_search(chan_info *cp, int count);
-void clear_sound_search_procedure(snd_info *sp, bool clear_expr_too);
-void clear_global_search_procedure(bool clear_expr_too);
-
+#if HAVE_EXTENSION_LANGUAGE && (!USE_NO_GUI)
+ void find_dialog_find(char *str, read_direction_t direction, chan_info *cp);
+#endif
void g_init_find(void);
/* -------- snd-trans.c -------- */
-int snd_translate(const char *oldname, const char *newname, int type);
+int snd_translate(const char *oldname, const char *newname, mus_header_t type);
/* -------- snd.c -------- */
-void mus_error_to_snd(int type, char *msg);
void snd_set_global_defaults(bool need_cleanup);
-#if SND_AS_WIDGET
- snd_state *snd_main(int argc, char **argv);
-#endif
void g_init_base(void);
/* -------- snd-kbd.c -------- */
-void save_macro_state(FILE *fd);
-
-#ifdef __GNUC__
- void report_in_minibuffer(snd_info *sp, const char *format, ...) __attribute__ ((format (printf, 2, 3)));
-#else
- void report_in_minibuffer(snd_info *sp, const char *format, ...);
-#endif
-void string_to_minibuffer(snd_info *sp, const char *buf);
-void errors_to_minibuffer(const char *msg, void *data);
-void printout_to_minibuffer(const char *msg, void *data);
-void clear_minibuffer(snd_info *sp);
-void clear_minibuffer_prompt(snd_info *sp);
-void snd_minibuffer_activate(snd_info *sp, int keysym, bool with_meta);
-int in_user_keymap(int key, int state, bool cx_extended);
-void set_keymap_entry(int key, int state, int args, XEN func, bool cx_extended, const char *origin, const char *prefs_info);
-char *key_binding_description(int key, int state, bool cx_extended);
+int in_keymap(int key, int state, bool cx_extended);
+void set_keymap_entry(int key, int state, int args, Xen func, bool cx_extended, const char *origin, const char *prefs_info);
+char *key_description(int key, int state, bool cx_extended);
char *make_key_name(char *buf, int buf_size, int key, int state, bool extended);
-void map_over_key_bindings(bool (*func)(int key, int state, bool cx, XEN xf));
-key_info *find_prefs_key_binding(const char *prefs_name);
+void map_over_keys(bool (*func)(int key, int state, bool cx, Xen xf));
+key_info *find_prefs_key(const char *prefs_name);
+
+void save_edits_from_kbd(snd_info *sp);
void keyboard_command(chan_info *cp, int keysym, int state);
void control_g(snd_info *sp);
void g_init_kbd(void);
@@ -1849,14 +1838,12 @@ void g_init_kbd(void);
void scale_by(chan_info *cp, mus_float_t *scalers, int len, bool selection);
bool scale_to(snd_info *sp, chan_info *cp, mus_float_t *scalers, int len, bool selection);
-mus_float_t channel_maxamp(chan_info *cp, int edpos);
-mus_long_t channel_maxamp_position(chan_info *cp, int edpos);
void src_env_or_num(chan_info *cp, env *e, mus_float_t ratio, bool just_num,
- const char *origin, bool over_selection, mus_any *gen, XEN edpos, int arg_pos);
+ const char *origin, bool over_selection, mus_any *gen, Xen edpos, int arg_pos);
void apply_filter(chan_info *ncp, int order, env *e, const char *caller, const char *origin,
- bool over_selection, mus_float_t *ur_a, mus_any *gen, XEN edpos, int arg_pos, bool truncate);
+ bool over_selection, mus_float_t *ur_a, mus_any *gen, Xen edpos, int arg_pos, bool truncate);
void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_selection,
- const char *origin, mus_any *gen, XEN edpos, int arg_pos);
+ const char *origin, mus_any *gen, Xen edpos, int arg_pos);
void cos_smooth(chan_info *cp, mus_long_t beg, mus_long_t num, bool over_selection);
void display_frequency_response(env *e, axis_info *ap, graphics_context *gax, int order, bool dBing);
void cursor_delete(chan_info *cp, mus_long_t count);
@@ -1864,15 +1851,18 @@ void cursor_zeros(chan_info *cp, mus_long_t count, bool over_selection);
void cursor_insert(chan_info *cp, mus_long_t beg, mus_long_t count);
void cut_and_smooth(chan_info *cp);
void src_file(const char *file, double ratio);
+mus_long_t scan_channel(chan_info *cp, mus_long_t start, mus_long_t end, Xen proc);
void g_init_sig(void);
-int to_c_edit_position(chan_info *cp, XEN edpos, const char *caller, int arg_pos);
-mus_long_t to_c_edit_samples(chan_info *cp, XEN edpos, const char *caller, int arg_pos);
-mus_long_t beg_to_sample(XEN beg, const char *caller);
-mus_long_t dur_to_samples(XEN dur, mus_long_t beg, chan_info *cp, int edpos, int argn, const char *caller);
+int to_c_edit_position(chan_info *cp, Xen edpos, const char *caller, int arg_pos);
+mus_long_t to_c_edit_samples(chan_info *cp, Xen edpos, const char *caller, int arg_pos);
+mus_long_t beg_to_sample(Xen beg, const char *caller);
+mus_long_t dur_to_samples(Xen dur, mus_long_t beg, chan_info *cp, int edpos, int argn, const char *caller);
+#if USE_MOTIF
char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_float_t speed, env *amp_env, bool *err);
-XEN g_scale_selection_by(XEN scalers);
-void reverse_sound(chan_info *ncp, bool over_selection, XEN edpos, int arg_pos);
+#endif
+Xen g_scale_selection_by(Xen scalers);
+void reverse_sound(chan_info *ncp, bool over_selection, Xen edpos, int arg_pos);
/* -------- snd-draw.c -------- */
@@ -1887,17 +1877,13 @@ void draw_both_grf_points(int dot_size, graphics_context *ax, int j, graph_style
void g_init_draw(void);
void set_dialog_widget(snd_dialog_t which, widget_t wid);
void run_new_widget_hook(widget_t w);
-bool foreground_color_ok(XEN color, graphics_context *ax);
+bool foreground_color_ok(Xen color, graphics_context *ax);
#if HAVE_GL
void sgl_save_currents(void);
void sgl_set_currents(bool with_dialogs);
#endif
-#if USE_GTK
- void recolor_everything(widget_t w, gpointer color);
-#endif
-
/* -------- snd-ladspa.c -------- */
#if HAVE_LADSPA
diff --git a/snd-axis.c b/snd-axis.c
index 8ff8b98..ca155dd 100644
--- a/snd-axis.c
+++ b/snd-axis.c
@@ -1,6 +1,6 @@
#include "snd.h"
-bool x_axis_style_p(int n)
+bool is_x_axis_style(int n)
{
switch (n)
{
@@ -13,7 +13,7 @@ bool x_axis_style_p(int n)
}
-bool show_axes_p(int n)
+bool shows_axes(int n)
{
switch (n)
{
@@ -58,7 +58,7 @@ static tick_descriptor *describe_ticks(tick_descriptor *gd_td, double lo, double
tick_descriptor *td;
int ten, hib, lob, offset = 0;
double flog10, plog10;
- double frac, ften, hilo_diff, eten, flt_ten, flt_ften;
+ double frac, ften, hilo_diff, eten, flt_ten;
double inside, mfdiv, mten, mften;
int mticks, mdiv;
@@ -99,6 +99,7 @@ static tick_descriptor *describe_ticks(tick_descriptor *gd_td, double lo, double
}
else
{
+ double flt_ften;
/* try next lower power of ten */
ften = eten * .1;
flt_ften = (hi / ften);
@@ -111,16 +112,19 @@ static tick_descriptor *describe_ticks(tick_descriptor *gd_td, double lo, double
}
inside = (td->mhi - td->mlo) / hilo_diff;
mticks = (int)floor(inside * max_ticks);
+
if (mticks <= 1) mdiv = 1;
- if (mticks < 3) mdiv = mticks;
+ else if (mticks < 3) mdiv = mticks;
else if (mticks == 3) mdiv = 2;
else if (mticks < 6) mdiv = mticks;
else if (mticks < 10) mdiv = 5;
else mdiv = (int)(10 * floor(mticks / 10));
+
mfdiv = (td->mhi - td->mlo) / mdiv;
flog10 = floor(log10(mfdiv));
plog10 = pow(10, flog10);
td->tens = (int)fabs(flog10);
+
mten = grid_scale * (double)(floor(4.0 * (.00001 + (mfdiv / plog10)))) / 4.0;
if (mten < 1.0) mten = 1.0;
if ((mten == 1.0) || (mten == 2.0) || (mten == 2.5) || (mten == 5.0)) ften = mten;
@@ -128,6 +132,7 @@ static tick_descriptor *describe_ticks(tick_descriptor *gd_td, double lo, double
else if (mten < 2.5) ften = 2.5;
else if (mten < 5.0) ften = 5.0;
else ften = 10.0;
+
td->tenstep = ften;
mften = ften * plog10;
td->step = mften;
@@ -345,15 +350,18 @@ static int tick_grf_x(double val, axis_info *ap, x_axis_style_t style, int srate
default:
res = (int)(ap->x_base + val * ap->x_scale);
break;
+
case X_AXIS_IN_BEATS:
case X_AXIS_IN_MEASURES:
if (ap->cp)
res = (int)(ap->x_base + val * ap->x_scale * 60.0 / ap->cp->beats_per_minute);
else res = (int)(ap->x_base + val * ap->x_scale);
break;
+
case X_AXIS_IN_SAMPLES:
res = (int)(ap->x_axis_x0 + (val - ap->x0 * srate) * ap->x_scale / srate);
break;
+
case X_AXIS_AS_PERCENTAGE:
res = (int)(ap->x_axis_x0 + (val - ap->x0 / ap->xmax) * ap->x_scale * ap->xmax);
break;
@@ -378,9 +386,9 @@ static int label_base, number_base;
static void activate_gl_fonts(void)
{
#if USE_MOTIF
- XFontStruct *label, *number;
if (!gl_fonts_activated)
{
+ XFontStruct *label, *number;
label = (XFontStruct *)(AXIS_LABEL_FONT(ss));
number = (XFontStruct *)(AXIS_NUMBERS_FONT(ss));
label_base = glGenLists(128);
@@ -394,8 +402,6 @@ static void activate_gl_fonts(void)
{
label_base = glGenLists(128);
number_base = glGenLists(128);
- gdk_gl_font_use_pango_font(AXIS_LABEL_FONT(ss), 32, 96, label_base + 32);
- gdk_gl_font_use_pango_font(AXIS_NUMBERS_FONT(ss), 32, 96, number_base + 32);
gl_fonts_activated = true;
}
#endif
@@ -405,9 +411,9 @@ static void activate_gl_fonts(void)
void reload_label_font(void)
{
#if USE_MOTIF
- XFontStruct *label;
if (gl_fonts_activated)
{
+ XFontStruct *label;
glDeleteLists(label_base, 128);
label_base = glGenLists(128);
label = (XFontStruct *)(AXIS_LABEL_FONT(ss));
@@ -418,7 +424,7 @@ void reload_label_font(void)
{
glDeleteLists(label_base, 128);
label_base = glGenLists(128);
- gdk_gl_font_use_pango_font(AXIS_LABEL_FONT(ss), 32, 96, label_base + 32);
+ /* gdk_gl_font_use_pango_font(AXIS_LABEL_FONT(ss), 32, 96, label_base + 32); */
}
#endif
}
@@ -427,9 +433,9 @@ void reload_label_font(void)
void reload_number_font(void)
{
#if USE_MOTIF
- XFontStruct *number;
if (gl_fonts_activated)
{
+ XFontStruct *number;
glDeleteLists(number_base, 128);
number_base = glGenLists(128);
number = (XFontStruct *)(AXIS_NUMBERS_FONT(ss));
@@ -440,7 +446,7 @@ void reload_number_font(void)
{
glDeleteLists(number_base, 128);
number_base = glGenLists(128);
- gdk_gl_font_use_pango_font(AXIS_NUMBERS_FONT(ss), 32, 96, number_base + 32);
+ /* gdk_gl_font_use_pango_font(AXIS_NUMBERS_FONT(ss), 32, 96, number_base + 32); */
}
#endif
}
@@ -622,7 +628,7 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
height = ap->height;
ap->graph_active = ((width > 4) || (height > 10));
include_grid = ((ap->cp) && (with_grid));
-
+
if ((axes == SHOW_NO_AXES) || (width < 40) || (height < 40) || (ap->xmax == 0.0))
{
/* leave it set up for bare graph */
@@ -722,7 +728,6 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
curx = left_border_width;
cury = height - bottom_border_width;
-
use_tiny_font = ((width < 250) || (height < 140));
x_number_height = number_height((use_tiny_font) ? TINY_FONT(ss) : AXIS_NUMBERS_FONT(ss));
@@ -751,27 +756,21 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
{
if (include_y_ticks)
{
- double y_range;
/* figure out how long the longest tick label will be and make room for it */
/* values go from ap->y0 to ap->y1 */
/* basic tick spacing is tick_spacing pixels */
+
num_ticks = cury / y_tick_spacing;
/* ticks start and stop at 10-based locations (i.e. sloppy axis bounds) */
/* so, given the current min..max, find the pretty min..max for ticks */
- y_range = ap->y1 - ap->y0;
- if (y_range <= 0.0)
+
+ if (ap->y1 <= ap->y0)
{
if (ap->y0 != 0.0)
- {
- ap->y1 = ap->y0 * 1.25;
- y_range = ap->y0 * .25;
- }
- else
- {
- ap->y1 = 1.0;
- y_range = 1.0;
- }
+ ap->y1 = ap->y0 * 1.25;
+ else ap->y1 = 1.0;
}
+
tdy = describe_ticks(ap->y_ticks, ap->y0, ap->y1, num_ticks, grid_scale);
ap->y_ticks = tdy;
if (include_y_tick_labels)
@@ -814,27 +813,19 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
if (include_y_tick_labels)
curx += number_width("10000", use_tiny_font);
curx += major_tick_length;
+ ap->y_axis_y1 = include_y_ticks ? top_border_width : 0;
}
ap->x_axis_x1 = width - right_border_width;
ap->x_axis_x0 = curx;
- {
- double x_range;
- x_range = ap->x1 - ap->x0;
- if (x_range <= 0)
- {
- if (ap->x0 != 0.0)
- {
- ap->x1 = ap->x0 * 1.25;
- x_range = ap->x0 * .25;
- }
- else
- {
- ap->x1 = .1;
- x_range = .1;
- }
- }
- }
+
+ if (ap->x1 <= ap->x0)
+ {
+ if (ap->x0 != 0.0)
+ ap->x1 = ap->x0 * 1.25;
+ else ap->x1 = .1;
+ }
+
if ((x_axis_linear) && (include_x_ticks))
{
num_ticks = (ap->x_axis_x1 - curx) / x_tick_spacing;
@@ -845,9 +836,11 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
default:
tdx = describe_ticks(ap->x_ticks, ap->x0, ap->x1, num_ticks, grid_scale);
break;
+
case X_AXIS_IN_SAMPLES:
tdx = describe_ticks(ap->x_ticks, ap->x0 * srate, ap->x1 * srate, num_ticks, grid_scale);
break;
+
case X_AXIS_IN_BEATS:
case X_AXIS_IN_MEASURES:
if (ap->cp) /* cp==null probably can't happen -- ap->cp is null (only?) if we're called from the envelope editor */
@@ -1008,7 +1001,11 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
if ((ap->y_axis_y0 - ap->y_axis_y1) > (y_label_width + 20))
draw_rotated_axis_label(ap->cp, ax, ap->ylabel,
(tdy) ?
+#if USE_GTK
+ (ap->y_axis_x0 - tdy->maj_tick_len - tdy->min_label_width - inner_border_width - 10) :
+#else
(ap->y_axis_x0 - tdy->maj_tick_len - tdy->min_label_width - inner_border_width) :
+#endif
(ap->y_axis_x0 - inner_border_width - 30),
/* tdy might be null if not y_axis_linear (sonogram + log-freq + y axis label) */
(int)((ap->y_axis_y0 + ap->y_axis_y1 - y_label_width) * 0.5) - 8);
@@ -1349,10 +1346,12 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
label = "100";
freq = 100.0;
break;
+
case 1:
label = "1000";
freq = 1000.0;
break;
+
case 2:
label = "10000";
freq = 10000.0;
@@ -1411,10 +1410,12 @@ void make_axes_1(axis_info *ap, x_axis_style_t x_style, int srate, show_axes_t a
label = "100";
freq = 100.0;
break;
+
case 1:
label = "1000";
freq = 1000.0;
break;
+
case 2:
label = "10000";
freq = 10000.0;
@@ -1493,7 +1494,7 @@ static axis_info *get_ap(chan_info *cp, axis_info_t ap_id, const char *caller)
{
#define AXIS_INFO_ID_OK(Id) (Id <= (int)LISP_AXIS_INFO)
- if ((cp) && (AXIS_INFO_ID_OK(ap_id)))
+ if (AXIS_INFO_ID_OK(ap_id))
switch (ap_id)
{
case TIME_AXIS_INFO: return(cp->axis); break;
@@ -1501,120 +1502,117 @@ static axis_info *get_ap(chan_info *cp, axis_info_t ap_id, const char *caller)
case LISP_AXIS_INFO: if (cp->lisp_info) return(lisp_info_axis(cp)); break;
}
- XEN_ERROR(XEN_ERROR_TYPE("no-such-axis"),
- XEN_LIST_6(((!(cp->squelch_update)) || (!(AXIS_INFO_ID_OK(ap_id)))) ?
- C_TO_XEN_STRING("~A: no such axis: ~A of sound ~A (~A), chan: ~A (axis should be " S_time_graph ", " S_lisp_graph ", or " S_transform_graph ")") :
- C_TO_XEN_STRING("~A: no such axis: ~A of sound ~A (~A), chan: ~A does not exist, probably because output is squelched"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT((int)(ap_id)),
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_STRING(cp->sound->short_filename),
- C_TO_XEN_INT(cp->chan)));
+ Xen_error(Xen_make_error_type("no-such-axis"),
+ Xen_list_6(((!(cp->squelch_update)) || (!(AXIS_INFO_ID_OK(ap_id)))) ?
+ C_string_to_Xen_string("~A: no such axis: ~A of sound ~A (~A), chan: ~A (axis should be " S_time_graph ", " S_lisp_graph ", or " S_transform_graph ")") :
+ C_string_to_Xen_string("~A: no such axis: ~A of sound ~A (~A), chan: ~A does not exist, probably because output is squelched"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer((int)(ap_id)),
+ C_int_to_Xen_sound(cp->sound->index),
+ C_string_to_Xen_string(cp->sound->short_filename),
+ C_int_to_Xen_integer(cp->chan)));
return(NULL);
}
-#define TO_C_AXIS_INFO(Snd, Chn, Ap, Caller) \
- get_ap(get_cp(Snd, Chn, Caller), \
- (axis_info_t)XEN_TO_C_INT_OR_ELSE(Ap, (int)TIME_AXIS_INFO), \
- Caller)
+#define TO_C_AXIS_INFO(Snd, Chn, Ap, Caller) get_ap(get_cp(Snd, Chn, Caller), (Xen_is_integer(Ap)) ? (axis_info_t)Xen_integer_to_C_int(Ap) : TIME_AXIS_INFO, Caller)
-static XEN g_x_to_position(XEN val, XEN snd, XEN chn, XEN ap)
+static Xen g_x_to_position(Xen val, Xen snd, Xen chn, Xen ap)
{
#define H_x_to_position "(" S_x_to_position " val :optional snd chn (ax " S_time_graph ")): x pixel loc of val"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_x_to_position, "a number");
- ASSERT_CHANNEL(S_x_to_position, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ap), ap, XEN_ARG_4, S_x_to_position, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
- return(C_TO_XEN_INT(grf_x(XEN_TO_C_DOUBLE(val),
+ Xen_check_type(Xen_is_number(val), val, 1, S_x_to_position, "a number");
+ Snd_assert_channel(S_x_to_position, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(ap), ap, 4, S_x_to_position, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ return(C_int_to_Xen_integer(grf_x(Xen_real_to_C_double(val),
TO_C_AXIS_INFO(snd, chn, ap, S_x_to_position))));
}
-static XEN g_y_to_position(XEN val, XEN snd, XEN chn, XEN ap)
+static Xen g_y_to_position(Xen val, Xen snd, Xen chn, Xen ap)
{
#define H_y_to_position "(" S_y_to_position " val :optional snd chn (ax " S_time_graph ")): y pixel loc of val"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_y_to_position, "a number");
- ASSERT_CHANNEL(S_y_to_position, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ap), ap, XEN_ARG_4, S_y_to_position, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
- return(C_TO_XEN_INT(grf_y(XEN_TO_C_DOUBLE(val),
+ Xen_check_type(Xen_is_number(val), val, 1, S_y_to_position, "a number");
+ Snd_assert_channel(S_y_to_position, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(ap), ap, 4, S_y_to_position, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ return(C_int_to_Xen_integer(grf_y(Xen_real_to_C_double(val),
TO_C_AXIS_INFO(snd, chn, ap, S_y_to_position))));
}
-static XEN g_position_to_x(XEN val, XEN snd, XEN chn, XEN ap)
+static Xen g_position_to_x(Xen val, Xen snd, Xen chn, Xen ap)
{
#define H_position_to_x "(" S_position_to_x " val :optional snd chn (ax " S_time_graph ")): x axis value corresponding to pixel val"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, S_position_to_x, "an integer");
- ASSERT_CHANNEL(S_position_to_x, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ap), ap, XEN_ARG_4, S_position_to_x, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
- return(C_TO_XEN_DOUBLE(ungrf_x(TO_C_AXIS_INFO(snd, chn, ap, S_position_to_x),
- XEN_TO_C_INT(val))));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_position_to_x, "an integer");
+ Snd_assert_channel(S_position_to_x, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(ap), ap, 4, S_position_to_x, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ return(C_double_to_Xen_real(ungrf_x(TO_C_AXIS_INFO(snd, chn, ap, S_position_to_x),
+ Xen_integer_to_C_int(val))));
}
-static XEN g_position_to_y(XEN val, XEN snd, XEN chn, XEN ap)
+static Xen g_position_to_y(Xen val, Xen snd, Xen chn, Xen ap)
{
#define H_position_to_y "(" S_position_to_y " val :optional snd chn (ax " S_time_graph ")): y axis value corresponding to pixel val"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, S_position_to_y, "an integer");
- ASSERT_CHANNEL(S_position_to_y, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ap), ap, XEN_ARG_4, S_position_to_y, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
- return(C_TO_XEN_DOUBLE(ungrf_y(TO_C_AXIS_INFO(snd, chn, ap, S_position_to_y),
- XEN_TO_C_INT(val))));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_position_to_y, "an integer");
+ Snd_assert_channel(S_position_to_y, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(ap), ap, 4, S_position_to_y, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ return(C_double_to_Xen_real(ungrf_y(TO_C_AXIS_INFO(snd, chn, ap, S_position_to_y),
+ Xen_integer_to_C_int(val))));
}
-static XEN g_axis_info(XEN snd, XEN chn, XEN ap_id)
+static Xen g_axis_info(Xen snd, Xen chn, Xen ap_id)
{
#define H_axis_info "(" S_axis_info " :optional snd chn (ax " S_time_graph ")): info about axis: (list losamp hisamp \
x0 y0 x1 y1 xmin ymin xmax ymax pix_x0 pix_y0 pix_x1 pix_y1 y_offset xscale yscale xlabel ylabel new-peaks)"
axis_info *ap;
- ASSERT_CHANNEL(S_axis_info, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ap_id), ap_id, XEN_ARG_3, S_axis_info, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ Snd_assert_channel(S_axis_info, snd, chn, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(ap_id), ap_id, 3, S_axis_info, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
ap = TO_C_AXIS_INFO(snd, chn, ap_id, S_axis_info);
- if (ap == NULL) return(XEN_EMPTY_LIST);
- return(XEN_CONS(C_TO_XEN_INT64_T(ap->losamp),
- XEN_CONS(C_TO_XEN_INT64_T(ap->hisamp),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->x0),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->y0),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->x1),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->y1),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->xmin),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->ymin),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->xmax),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->ymax),
- XEN_CONS(C_TO_XEN_INT(ap->x_axis_x0),
- XEN_CONS(C_TO_XEN_INT(ap->y_axis_y0),
- XEN_CONS(C_TO_XEN_INT(ap->x_axis_x1),
- XEN_CONS(C_TO_XEN_INT(ap->y_axis_y1),
- XEN_CONS(C_TO_XEN_INT(ap->y_offset),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->x_scale),
- XEN_CONS(C_TO_XEN_DOUBLE(ap->y_scale),
- XEN_CONS((ap->xlabel) ? C_TO_XEN_STRING(ap->xlabel) : XEN_FALSE,
- XEN_CONS((ap->ylabel) ? C_TO_XEN_STRING(ap->ylabel) : XEN_FALSE,
- XEN_CONS((ap->cp) ? C_TO_XEN_BOOLEAN(ap->cp->new_peaks) : XEN_FALSE,
- XEN_EMPTY_LIST)))))))))))))))))))));
+ if (ap == NULL) return(Xen_empty_list);
+ return(Xen_cons(C_llong_to_Xen_llong(ap->losamp),
+ Xen_cons(C_llong_to_Xen_llong(ap->hisamp),
+ Xen_cons(C_double_to_Xen_real(ap->x0),
+ Xen_cons(C_double_to_Xen_real(ap->y0),
+ Xen_cons(C_double_to_Xen_real(ap->x1),
+ Xen_cons(C_double_to_Xen_real(ap->y1),
+ Xen_cons(C_double_to_Xen_real(ap->xmin),
+ Xen_cons(C_double_to_Xen_real(ap->ymin),
+ Xen_cons(C_double_to_Xen_real(ap->xmax),
+ Xen_cons(C_double_to_Xen_real(ap->ymax),
+ Xen_cons(C_int_to_Xen_integer(ap->x_axis_x0),
+ Xen_cons(C_int_to_Xen_integer(ap->y_axis_y0),
+ Xen_cons(C_int_to_Xen_integer(ap->x_axis_x1),
+ Xen_cons(C_int_to_Xen_integer(ap->y_axis_y1),
+ Xen_cons(C_int_to_Xen_integer(ap->y_offset),
+ Xen_cons(C_double_to_Xen_real(ap->x_scale),
+ Xen_cons(C_double_to_Xen_real(ap->y_scale),
+ Xen_cons((ap->xlabel) ? C_string_to_Xen_string(ap->xlabel) : Xen_false,
+ Xen_cons((ap->ylabel) ? C_string_to_Xen_string(ap->ylabel) : Xen_false,
+ Xen_cons((ap->cp) ? C_bool_to_Xen_boolean(ap->cp->new_peaks) : Xen_false,
+ Xen_empty_list)))))))))))))))))))));
}
#if USE_MOTIF
- #define XEN_UNWRAP_SND_GC(Value) XEN_UNWRAP_C_POINTER(XEN_CADR(Value))
- #define XEN_SND_GC_P(Value) (XEN_LIST_P(Value) && (XEN_LIST_LENGTH(Value) >= 2) && \
- (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp("GC", XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
+ #define Xen_unwrap_snd_gc(Value) Xen_unwrap_C_pointer(Xen_cadr(Value))
+ #define Xen_is_GC(Value) (Xen_is_list(Value) && (Xen_list_length(Value) >= 2) && \
+ (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp("GC", Xen_symbol_to_C_string(Xen_car(Value))) == 0))
#else
#if USE_GTK
- #define XEN_UNWRAP_SND_GC(Value) (gc_t *)(XEN_UNWRAP_C_POINTER(XEN_CADR(Value)))
- #define XEN_SND_GC_P(Value) (XEN_LIST_P(Value) && (XEN_LIST_LENGTH(Value) >= 2) && \
- (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp("gc_t_", XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
+ #define Xen_unwrap_snd_gc(Value) (gc_t *)(Xen_unwrap_C_pointer(Xen_cadr(Value)))
+ #define Xen_is_GC(Value) (Xen_is_list(Value) && (Xen_list_length(Value) >= 2) && \
+ (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp("gc_t_", Xen_symbol_to_C_string(Xen_car(Value))) == 0))
#else
- #define XEN_UNWRAP_SND_GC(Value) 0
- #define XEN_SND_GC_P(Value) 0
+ #define Xen_unwrap_snd_gc(Value) 0
+ #define Xen_is_GC(Value) 0
#endif
#endif
-static XEN g_draw_axes(XEN args)
+static Xen g_draw_axes(Xen args)
{
#define H_draw_axes "(" S_draw_axes " wid gc label (x0 0.0) (x1 1.0) (y0 -1.0) (y1 1.0) (style " S_x_axis_in_seconds ") (axes " S_show_all_axes ")): \
draws axes in the widget 'wid', using the graphics context 'gc', with the x-axis label 'label' \
@@ -1631,7 +1629,7 @@ Returns actual (pixel) axis bounds -- a list (x0 y0 x1 y1)."
gc_t *gc;
#endif
- XEN val, xwid, xgc, xx0, xx1, xy0, xy1, xstyle, xaxes, label_ref;
+ Xen val, xwid, xgc, label_ref;
double x0 = 0.0, x1 = 1.0;
mus_float_t y0 = -1.0, y1 = 1.0;
x_axis_style_t x_style = X_AXIS_IN_SECONDS;
@@ -1640,69 +1638,75 @@ Returns actual (pixel) axis bounds -- a list (x0 y0 x1 y1)."
axis_info *ap;
int len;
- len = XEN_LIST_LENGTH(args);
+ len = Xen_list_length(args);
#if (!USE_GTK)
- XEN_ASSERT_TYPE((len >= 3) && (len < 10), args, XEN_ONLY_ARG, S_draw_axes, "3 required and 6 optional args");
+ Xen_check_type((len >= 3) && (len < 10), args, 1, S_draw_axes, "3 required and 6 optional args");
#else
- XEN_ASSERT_TYPE((len >= 3) && (len < 11), args, XEN_ONLY_ARG, S_draw_axes, "3 required and 7 optional args");
+ Xen_check_type((len >= 3) && (len < 11), args, 1, S_draw_axes, "3 required and 7 optional args");
#endif
- xwid = XEN_LIST_REF(args, 0);
- XEN_ASSERT_TYPE(XEN_WIDGET_P(xwid), xwid, XEN_ARG_1, S_draw_axes, "widget");
- xgc = XEN_LIST_REF(args, 1);
- XEN_ASSERT_TYPE(XEN_SND_GC_P(xgc), xgc, XEN_ARG_2, S_draw_axes, "snd-gc");
+ xwid = Xen_list_ref(args, 0);
+ Xen_check_type(Xen_is_widget(xwid), xwid, 1, S_draw_axes, "widget");
+ xgc = Xen_list_ref(args, 1);
+ Xen_check_type(Xen_is_GC(xgc), xgc, 2, S_draw_axes, "snd-gc");
#if USE_MOTIF
- w = (Widget)(XEN_UNWRAP_WIDGET(xwid));
- gc = (GC)(XEN_UNWRAP_SND_GC(xgc));
+ w = (Widget)(Xen_unwrap_widget(xwid));
+ gc = (GC)(Xen_unwrap_snd_gc(xgc));
#endif
#if USE_GTK
- w = (GtkWidget *)(XEN_UNWRAP_WIDGET(xwid));
- gc = (gc_t *)(XEN_UNWRAP_SND_GC(xgc));
+ w = (GtkWidget *)(Xen_unwrap_widget(xwid));
+ gc = (gc_t *)(Xen_unwrap_snd_gc(xgc));
#endif
- label_ref = XEN_LIST_REF(args, 2);
- XEN_ASSERT_TYPE(XEN_STRING_P(label_ref) || XEN_FALSE_P(label_ref), label_ref, XEN_ARG_3, S_draw_axes, "a string");
+ label_ref = Xen_list_ref(args, 2);
+ Xen_check_type(Xen_is_string(label_ref) || Xen_is_false(label_ref), label_ref, 3, S_draw_axes, "a string");
if (len > 3)
{
- xx0 = XEN_LIST_REF(args, 3);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xx0), xx0, XEN_ARG_4, S_draw_axes, "a number");
- x0 = XEN_TO_C_DOUBLE(xx0);
+ Xen xx0;
+ xx0 = Xen_list_ref(args, 3);
+ Xen_check_type(Xen_is_number(xx0), xx0, 4, S_draw_axes, "a number");
+ x0 = Xen_real_to_C_double(xx0);
if (len > 4)
{
- xx1 = XEN_LIST_REF(args, 4);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xx1), xx1, XEN_ARG_5, S_draw_axes, "a number");
- x1 = XEN_TO_C_DOUBLE(xx1);
+ Xen xx1;
+ xx1 = Xen_list_ref(args, 4);
+ Xen_check_type(Xen_is_number(xx1), xx1, 5, S_draw_axes, "a number");
+ x1 = Xen_real_to_C_double(xx1);
if (len > 5)
{
- xy0 = XEN_LIST_REF(args, 5);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xy0), xy0, XEN_ARG_6, S_draw_axes, "a number");
- y0 = XEN_TO_C_DOUBLE(xy0);
+ Xen xy0;
+ xy0 = Xen_list_ref(args, 5);
+ Xen_check_type(Xen_is_number(xy0), xy0, 6, S_draw_axes, "a number");
+ y0 = Xen_real_to_C_double(xy0);
if (len > 6)
{
- xy1 = XEN_LIST_REF(args, 6);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xy1), xy1, XEN_ARG_7, S_draw_axes, "a number");
- y1 = XEN_TO_C_DOUBLE(xy1);
+ Xen xy1;
+ xy1 = Xen_list_ref(args, 6);
+ Xen_check_type(Xen_is_number(xy1), xy1, 7, S_draw_axes, "a number");
+ y1 = Xen_real_to_C_double(xy1);
if (len > 7)
{
+ Xen xstyle;
int tmp;
- xstyle = XEN_LIST_REF(args, 7);
- XEN_ASSERT_TYPE(XEN_INTEGER_P(xstyle), xstyle, XEN_ARG_8, S_draw_axes, "axis style");
- tmp = XEN_TO_C_INT(xstyle);
- if (!(x_axis_style_p(tmp)))
- XEN_OUT_OF_RANGE_ERROR(S_draw_axes, 7, xstyle, "axis style");
+ xstyle = Xen_list_ref(args, 7);
+ Xen_check_type(Xen_is_integer(xstyle), xstyle, 8, S_draw_axes, "axis style");
+ tmp = Xen_integer_to_C_int(xstyle);
+ if (!(is_x_axis_style(tmp)))
+ Xen_out_of_range_error(S_draw_axes, 7, xstyle, "axis style");
x_style = (x_axis_style_t)tmp;
if (len > 8)
{
- xaxes = XEN_LIST_REF(args, 8);
- XEN_ASSERT_TYPE(XEN_INTEGER_P(xaxes), xaxes, XEN_ARG_9, S_draw_axes, S_show_axes " choice");
- tmp = XEN_TO_C_INT(xaxes);
- if (!(show_axes_p(tmp)))
- XEN_OUT_OF_RANGE_ERROR(S_draw_axes, 8, xaxes, S_show_axes " choice");
- axes = (show_axes_t)XEN_TO_C_INT(xaxes);
+ Xen xaxes;
+ xaxes = Xen_list_ref(args, 8);
+ Xen_check_type(Xen_is_integer(xaxes), xaxes, 9, S_draw_axes, S_show_axes " choice");
+ tmp = Xen_integer_to_C_int(xaxes);
+ if (!(shows_axes(tmp)))
+ Xen_out_of_range_error(S_draw_axes, 8, xaxes, S_show_axes " choice");
+ axes = (show_axes_t)Xen_integer_to_C_int(xaxes);
#if USE_GTK
if (len > 9)
- ss->cr = (cairo_t *)XEN_UNWRAP_C_POINTER(XEN_CADR(XEN_LIST_REF(args, 9)));
+ ss->cr = (cairo_t *)Xen_unwrap_C_pointer(Xen_cadr(Xen_list_ref(args, 9)));
#endif
}}}}}}
@@ -1719,8 +1723,8 @@ Returns actual (pixel) axis bounds -- a list (x0 y0 x1 y1)."
ax->wn = WIDGET_TO_WINDOW(w);
ax->w = w;
if (!ss->cr)
- XEN_ERROR(XEN_ERROR_TYPE("no-cairo-t"),
- XEN_LIST_1(C_TO_XEN_STRING(S_draw_axes ": in Gtk, the trailing cairo_t argument is not optional")));
+ Xen_error(Xen_make_error_type("no-cairo-t"),
+ Xen_list_1(C_string_to_Xen_string(S_draw_axes ": in Gtk, the trailing cairo_t argument is not optional")));
#endif
ap->xmin = x0;
@@ -1729,8 +1733,8 @@ Returns actual (pixel) axis bounds -- a list (x0 y0 x1 y1)."
ap->ymax = y1;
ap->y_ambit = y1 - y0;
ap->x_ambit = x1 - x0;
- if (XEN_STRING_P(label_ref))
- ap->xlabel = mus_strdup(XEN_TO_C_STRING(label_ref));
+ if (Xen_is_string(label_ref))
+ ap->xlabel = mus_strdup(Xen_string_to_C_string(label_ref));
ap->x0 = x0;
ap->x1 = x1;
ap->y0 = y0;
@@ -1745,128 +1749,137 @@ Returns actual (pixel) axis bounds -- a list (x0 y0 x1 y1)."
make_axes_1(ap, x_style, 1, axes, NOT_PRINTING, WITH_X_AXIS, NO_GRID, WITH_LINEAR_AXES, grid_density(ss));
- val = XEN_CONS(C_TO_XEN_INT(ap->x_axis_x0),
- XEN_CONS(C_TO_XEN_INT(ap->y_axis_y0),
- XEN_CONS(C_TO_XEN_INT(ap->x_axis_x1),
- XEN_CONS(C_TO_XEN_INT(ap->y_axis_y1),
- XEN_EMPTY_LIST))));
+ val = Xen_cons(C_int_to_Xen_integer(ap->x_axis_x0),
+ Xen_cons(C_int_to_Xen_integer(ap->y_axis_y0),
+ Xen_cons(C_int_to_Xen_integer(ap->x_axis_x1),
+ Xen_cons(C_int_to_Xen_integer(ap->y_axis_y1),
+ Xen_empty_list))));
free_axis_info(ap);
return(val);
}
-static XEN g_x_axis_label(XEN snd, XEN chn, XEN ax)
+static Xen g_x_axis_label(Xen snd, Xen chn, Xen ax)
{
#define H_x_axis_label "(" S_x_axis_label " :optional snd chn (ax " S_time_graph ")): current x axis label"
axis_info *ap;
- ASSERT_CHANNEL(S_x_axis_label, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_3, S_x_axis_label, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+
+ Snd_assert_channel(S_x_axis_label, snd, chn, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 3, S_x_axis_label, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
ap = TO_C_AXIS_INFO(snd, chn, ax, S_x_axis_label);
- return(C_TO_XEN_STRING(ap->xlabel));
+
+ return(C_string_to_Xen_string(ap->xlabel));
}
-static XEN g_set_x_axis_label(XEN label, XEN snd, XEN chn, XEN ax)
+
+static Xen g_set_x_axis_label(Xen label, Xen snd, Xen chn, Xen ax)
{
axis_info *ap;
- ASSERT_CHANNEL(S_setB S_x_axis_label, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_STRING_P(label) || XEN_FALSE_P(label), label, XEN_ARG_1, S_setB S_x_axis_label, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_4, S_setB S_x_axis_label, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+
+ Snd_assert_channel(S_set S_x_axis_label, snd, chn, 2);
+ Xen_check_type(Xen_is_string(label) || Xen_is_false(label), label, 1, S_set S_x_axis_label, "a string");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 4, S_set S_x_axis_label, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+
ap = TO_C_AXIS_INFO(snd, chn, ax, S_x_axis_label);
if (ap->xlabel) free(ap->xlabel);
if (ap->default_xlabel) free(ap->default_xlabel);
- if (XEN_FALSE_P(label))
+
+ if (Xen_is_false(label))
{
ap->xlabel = NULL;
ap->default_xlabel = NULL;
}
else
{
- ap->xlabel = mus_strdup(XEN_TO_C_STRING(label));
- if ((XEN_INTEGER_P(ax)) && (XEN_TO_C_INT(ax) == (int)TRANSFORM_AXIS_INFO))
+ ap->xlabel = mus_strdup(Xen_string_to_C_string(label));
+ if ((Xen_is_integer(ax)) && (Xen_integer_to_C_int(ax) == (int)TRANSFORM_AXIS_INFO))
set_fft_info_xlabel(ap->cp, ap->xlabel);
ap->default_xlabel = mus_strdup(ap->xlabel);
}
+
update_graph(ap->cp);
return(label);
}
-WITH_FOUR_SETTER_ARGS(g_set_x_axis_label_reversed, g_set_x_axis_label)
+with_four_setter_args(g_set_x_axis_label_reversed, g_set_x_axis_label)
-static XEN g_y_axis_label(XEN snd, XEN chn, XEN ax)
+static Xen g_y_axis_label(Xen snd, Xen chn, Xen ax)
{
#define H_y_axis_label "(" S_y_axis_label " :optional snd chn (ax " S_time_graph ")): current y axis label"
axis_info *ap;
- ASSERT_CHANNEL(S_y_axis_label, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_3, S_y_axis_label, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+
+ Snd_assert_channel(S_y_axis_label, snd, chn, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 3, S_y_axis_label, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
ap = TO_C_AXIS_INFO(snd, chn, ax, S_y_axis_label);
- return(C_TO_XEN_STRING(ap->ylabel));
+
+ return(C_string_to_Xen_string(ap->ylabel));
}
-static XEN g_set_y_axis_label(XEN label, XEN snd, XEN chn, XEN ax)
+static Xen g_set_y_axis_label(Xen label, Xen snd, Xen chn, Xen ax)
{
axis_info *ap;
- ASSERT_CHANNEL(S_setB S_y_axis_label, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_STRING_P(label) || XEN_FALSE_P(label), label, XEN_ARG_1, S_setB S_y_axis_label, "a string");
+ Snd_assert_channel(S_set S_y_axis_label, snd, chn, 2);
+ Xen_check_type(Xen_is_string(label) || Xen_is_false(label), label, 1, S_set S_y_axis_label, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_4, S_setB S_y_axis_label, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 4, S_set S_y_axis_label, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
ap = TO_C_AXIS_INFO(snd, chn, ax, S_y_axis_label);
if (ap->ylabel) free(ap->ylabel);
- if (XEN_FALSE_P(label))
+ if (Xen_is_false(label))
ap->ylabel = NULL;
- else ap->ylabel = mus_strdup(XEN_TO_C_STRING(label));
+ else ap->ylabel = mus_strdup(Xen_string_to_C_string(label));
update_graph(ap->cp);
return(label);
}
-WITH_FOUR_SETTER_ARGS(g_set_y_axis_label_reversed, g_set_y_axis_label)
+with_four_setter_args(g_set_y_axis_label_reversed, g_set_y_axis_label)
-static XEN g_x_bounds(XEN snd, XEN chn, XEN ax)
+static Xen g_x_bounds(Xen snd, Xen chn, Xen ax)
{
#define H_x_bounds "(" S_x_bounds " :optional snd chn axis): a list (x0 x1) giving the current x axis bounds of snd channel chn"
axis_info *ap;
- ASSERT_CHANNEL(S_x_bounds, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_4, S_x_bounds, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ Snd_assert_channel(S_x_bounds, snd, chn, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 4, S_x_bounds, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
ap = TO_C_AXIS_INFO(snd, chn, ax, S_x_bounds);
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(ap->x0),
- C_TO_XEN_DOUBLE(ap->x1)));
+ return(Xen_list_2(C_double_to_Xen_real(ap->x0),
+ C_double_to_Xen_real(ap->x1)));
/* wavogram settings depend on context -- no easy way to map back to user's notion of bounds */
}
-static XEN g_set_x_bounds(XEN bounds, XEN snd, XEN chn, XEN ax)
+static Xen g_set_x_bounds(Xen bounds, Xen snd, Xen chn, Xen ax)
{
chan_info *cp;
axis_info *ap;
mus_float_t x0 = 0.0, x1 = 0.0;
- ASSERT_CHANNEL(S_setB S_x_bounds, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(bounds) || (XEN_LIST_P(bounds) && (XEN_LIST_LENGTH(bounds) == 2)), bounds, XEN_ARG_1, S_setB S_x_bounds, "a list: (x0 x1) or a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_4, S_setB S_x_bounds, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
- ap = TO_C_AXIS_INFO(snd, chn, ax, S_setB S_x_bounds);
+ Snd_assert_channel(S_set S_x_bounds, snd, chn, 2);
+ Xen_check_type(Xen_is_number(bounds) || (Xen_is_list(bounds) && (Xen_list_length(bounds) == 2)), bounds, 1, S_set S_x_bounds, "a list: (x0 x1) or a number");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 4, S_set S_x_bounds, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ ap = TO_C_AXIS_INFO(snd, chn, ax, S_set S_x_bounds);
- cp = get_cp(snd, chn, S_setB S_x_bounds);
- if (!cp) return(XEN_FALSE);
+ cp = get_cp(snd, chn, S_set S_x_bounds);
+ if (!cp) return(Xen_false);
- if (XEN_NUMBER_P(bounds))
+ if (Xen_is_number(bounds))
{
x0 = 0.0;
- x1 = XEN_TO_C_DOUBLE(bounds);
+ x1 = Xen_real_to_C_double(bounds);
}
else
{
- x0 = XEN_TO_C_DOUBLE(XEN_CAR(bounds));
- x1 = XEN_TO_C_DOUBLE(XEN_CADR(bounds));
+ x0 = Xen_real_to_C_double(Xen_car(bounds));
+ x1 = Xen_real_to_C_double(Xen_cadr(bounds));
if (x1 < x0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_x_bounds, 1, bounds, "~A: x1 < x0?");
+ Xen_out_of_range_error(S_set S_x_bounds, 1, bounds, "x1 < x0?");
}
if (ap == cp->axis)
@@ -1878,7 +1891,7 @@ static XEN g_set_x_bounds(XEN bounds, XEN snd, XEN chn, XEN ax)
sp = cp->sound;
if (sp->nchans > 1)
{
- if ((XEN_NOT_BOUND_P(chn)) && (cp->sound->channel_style == CHANNELS_COMBINED))
+ if ((!Xen_is_bound(chn)) && (cp->sound->channel_style == CHANNELS_COMBINED))
{
int i;
for (i = 0; i < sp->nchans; i++)
@@ -1897,58 +1910,59 @@ static XEN g_set_x_bounds(XEN bounds, XEN snd, XEN chn, XEN ax)
return(bounds);
}
-WITH_FOUR_SETTER_ARGS(g_set_x_bounds_reversed, g_set_x_bounds)
+with_four_setter_args(g_set_x_bounds_reversed, g_set_x_bounds)
-static XEN g_y_bounds(XEN snd, XEN chn, XEN ax)
+static Xen g_y_bounds(Xen snd, Xen chn, Xen ax)
{
#define H_y_bounds "(" S_y_bounds " :optional snd chn axis): a list (y0 y1) giving the current y axis bounds of snd channel chn"
axis_info *ap;
- ASSERT_CHANNEL(S_y_bounds, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_4, S_y_bounds, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
- ap = TO_C_AXIS_INFO(snd, chn, ax, S_x_bounds);
+ Snd_assert_channel(S_y_bounds, snd, chn, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 4, S_y_bounds, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ ap = TO_C_AXIS_INFO(snd, chn, ax, S_y_bounds);
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(ap->y0),
- C_TO_XEN_DOUBLE(ap->y1)));
+ return(Xen_list_2(C_double_to_Xen_real(ap->y0),
+ C_double_to_Xen_real(ap->y1)));
}
-static XEN g_set_y_bounds(XEN bounds, XEN snd, XEN chn, XEN ax)
+static Xen g_set_y_bounds(Xen bounds, Xen snd, Xen chn, Xen ax)
{
chan_info *cp;
axis_info *ap;
mus_float_t low = 0.0, hi = 0.0;
- int len = 0;
- XEN y0 = XEN_UNDEFINED, y1 = XEN_UNDEFINED;
+ Xen y0 = Xen_undefined, y1 = Xen_undefined;
- ASSERT_CHANNEL(S_setB S_y_bounds, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(bounds) || XEN_LIST_P_WITH_LENGTH(bounds, len), bounds, XEN_ARG_1, S_setB S_y_bounds, "a list or a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_4, S_setB S_y_bounds, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
- ap = TO_C_AXIS_INFO(snd, chn, ax, S_setB S_y_bounds);
+ Snd_assert_channel(S_set S_y_bounds, snd, chn, 2);
+ Xen_check_type((Xen_is_number(bounds)) || (Xen_is_list(bounds)), bounds, 1, S_set S_y_bounds, "a list or a number");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 4, S_set S_y_bounds, S_time_graph ", " S_transform_graph ", or " S_lisp_graph);
+ ap = TO_C_AXIS_INFO(snd, chn, ax, S_set S_y_bounds);
- cp = get_cp(snd, chn, S_setB S_y_bounds);
- if (!cp) return(XEN_FALSE);
+ cp = get_cp(snd, chn, S_set S_y_bounds);
+ if (!cp) return(Xen_false);
- if (XEN_NUMBER_P(bounds))
+ if (Xen_is_number(bounds))
{
- hi = XEN_TO_C_DOUBLE(bounds);
+ hi = Xen_real_to_C_double(bounds);
low = -hi;
}
else
{
+ int len;
+ len = Xen_list_length(bounds);
if (len > 0)
{
- y0 = XEN_CAR(bounds);
+ y0 = Xen_car(bounds);
if (len > 1)
- y1 = XEN_CADR(bounds);
+ y1 = Xen_cadr(bounds);
}
- if (XEN_NUMBER_P(y0))
+ if (Xen_is_number(y0))
{
- low = XEN_TO_C_DOUBLE(y0);
- if (XEN_NUMBER_P(y1))
- hi = XEN_TO_C_DOUBLE(y1);
+ low = Xen_real_to_C_double(y0);
+ if (Xen_is_number(y1))
+ hi = Xen_real_to_C_double(y1);
else
{
if (low < 0.0)
@@ -1985,81 +1999,60 @@ static XEN g_set_y_bounds(XEN bounds, XEN snd, XEN chn, XEN ax)
if (ap == cp->axis)
{
resize_sy_and_zy(cp);
- apply_y_axis_change(ap, cp);
+ apply_y_axis_change(cp);
}
}
return(bounds);
}
-WITH_FOUR_SETTER_ARGS(g_set_y_bounds_reversed, g_set_y_bounds)
+with_four_setter_args(g_set_y_bounds_reversed, g_set_y_bounds)
-#ifdef XEN_ARGIFY_1
-
-XEN_ARGIFY_4(g_x_to_position_w, g_x_to_position)
-XEN_ARGIFY_4(g_y_to_position_w, g_y_to_position)
-XEN_ARGIFY_4(g_position_to_x_w, g_position_to_x)
-XEN_ARGIFY_4(g_position_to_y_w, g_position_to_y)
-XEN_ARGIFY_3(g_axis_info_w, g_axis_info)
+Xen_wrap_4_optional_args(g_x_to_position_w, g_x_to_position)
+Xen_wrap_4_optional_args(g_y_to_position_w, g_y_to_position)
+Xen_wrap_4_optional_args(g_position_to_x_w, g_position_to_x)
+Xen_wrap_4_optional_args(g_position_to_y_w, g_position_to_y)
+Xen_wrap_3_optional_args(g_axis_info_w, g_axis_info)
#if (!USE_NO_GUI)
-XEN_VARGIFY(g_draw_axes_w, g_draw_axes)
+Xen_wrap_any_args(g_draw_axes_w, g_draw_axes)
#endif
-XEN_ARGIFY_3(g_x_axis_label_w, g_x_axis_label)
-XEN_ARGIFY_4(g_set_x_axis_label_w, g_set_x_axis_label)
-XEN_ARGIFY_3(g_y_axis_label_w, g_y_axis_label)
-XEN_ARGIFY_4(g_set_y_axis_label_w, g_set_y_axis_label)
-XEN_ARGIFY_3(g_x_bounds_w, g_x_bounds)
-XEN_ARGIFY_4(g_set_x_bounds_w, g_set_x_bounds)
-XEN_ARGIFY_3(g_y_bounds_w, g_y_bounds)
-XEN_ARGIFY_4(g_set_y_bounds_w, g_set_y_bounds)
-
+Xen_wrap_3_optional_args(g_x_axis_label_w, g_x_axis_label)
+Xen_wrap_3_optional_args(g_y_axis_label_w, g_y_axis_label)
+Xen_wrap_3_optional_args(g_x_bounds_w, g_x_bounds)
+Xen_wrap_3_optional_args(g_y_bounds_w, g_y_bounds)
+#if HAVE_SCHEME
+#define g_set_x_axis_label_w g_set_x_axis_label_reversed
+#define g_set_y_axis_label_w g_set_y_axis_label_reversed
+#define g_set_x_bounds_w g_set_x_bounds_reversed
+#define g_set_y_bounds_w g_set_y_bounds_reversed
#else
-
-#define g_x_to_position_w g_x_to_position
-#define g_y_to_position_w g_y_to_position
-#define g_position_to_x_w g_position_to_x
-#define g_position_to_y_w g_position_to_y
-#define g_axis_info_w g_axis_info
-#define g_draw_axes_w g_draw_axes
-#define g_x_axis_label_w g_x_axis_label
-#define g_set_x_axis_label_w g_set_x_axis_label
-#define g_y_axis_label_w g_y_axis_label
-#define g_set_y_axis_label_w g_set_y_axis_label
-#define g_x_bounds_w g_x_bounds
-#define g_set_x_bounds_w g_set_x_bounds
-#define g_y_bounds_w g_y_bounds
-#define g_set_y_bounds_w g_set_y_bounds
-
+Xen_wrap_4_optional_args(g_set_x_axis_label_w, g_set_x_axis_label)
+Xen_wrap_4_optional_args(g_set_y_axis_label_w, g_set_y_axis_label)
+Xen_wrap_4_optional_args(g_set_x_bounds_w, g_set_x_bounds)
+Xen_wrap_4_optional_args(g_set_y_bounds_w, g_set_y_bounds)
#endif
void g_init_axis(void)
{
- XEN_DEFINE_PROCEDURE(S_x_to_position, g_x_to_position_w, 1, 3, 0, H_x_to_position);
- XEN_DEFINE_PROCEDURE(S_y_to_position, g_y_to_position_w, 1, 3, 0, H_y_to_position);
- XEN_DEFINE_PROCEDURE(S_position_to_x, g_position_to_x_w, 1, 3, 0, H_position_to_x);
- XEN_DEFINE_PROCEDURE(S_position_to_y, g_position_to_y_w, 1, 3, 0, H_position_to_y);
- XEN_DEFINE_PROCEDURE(S_axis_info, g_axis_info_w, 0, 3, 0, H_axis_info);
- XEN_DEFINE_PROCEDURE(S_draw_axes, g_draw_axes_w, 0, 0, 1, H_draw_axes);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_x_axis_label, g_x_axis_label_w, H_x_axis_label,
- S_setB S_x_axis_label, g_set_x_axis_label_w, g_set_x_axis_label_reversed, 0, 3, 1, 3);
+ Xen_define_safe_procedure(S_x_to_position, g_x_to_position_w, 1, 3, 0, H_x_to_position);
+ Xen_define_safe_procedure(S_y_to_position, g_y_to_position_w, 1, 3, 0, H_y_to_position);
+ Xen_define_safe_procedure(S_position_to_x, g_position_to_x_w, 1, 3, 0, H_position_to_x);
+ Xen_define_safe_procedure(S_position_to_y, g_position_to_y_w, 1, 3, 0, H_position_to_y);
+ Xen_define_safe_procedure(S_axis_info, g_axis_info_w, 0, 3, 0, H_axis_info);
+ Xen_define_safe_procedure(S_draw_axes, g_draw_axes_w, 0, 0, 1, H_draw_axes);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_y_axis_label, g_y_axis_label_w, H_y_axis_label,
- S_setB S_y_axis_label, g_set_y_axis_label_w, g_set_y_axis_label_reversed, 0, 3, 1, 3);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_x_bounds, g_x_bounds_w, H_x_bounds,
- S_setB S_x_bounds, g_set_x_bounds_w, g_set_x_bounds_reversed, 0, 3, 1, 3);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_y_bounds, g_y_bounds_w, H_y_bounds,
- S_setB S_y_bounds, g_set_y_bounds_w, g_set_y_bounds_reversed, 0, 3, 1, 3);
-
- XEN_DEFINE_CONSTANT(S_time_graph, TIME_AXIS_INFO, "time domain graph axis info");
- XEN_DEFINE_CONSTANT(S_transform_graph, TRANSFORM_AXIS_INFO, "frequency domain graph axis info");
- XEN_DEFINE_CONSTANT(S_lisp_graph, LISP_AXIS_INFO, "lisp graph axis info");
+ Xen_define_dilambda(S_x_axis_label, g_x_axis_label_w, H_x_axis_label, S_set S_x_axis_label, g_set_x_axis_label_w, 0, 3, 1, 3);
+ Xen_define_dilambda(S_y_axis_label, g_y_axis_label_w, H_y_axis_label, S_set S_y_axis_label, g_set_y_axis_label_w, 0, 3, 1, 3);
+ Xen_define_dilambda(S_x_bounds, g_x_bounds_w, H_x_bounds, S_set S_x_bounds, g_set_x_bounds_w, 0, 3, 1, 3);
+ Xen_define_dilambda(S_y_bounds, g_y_bounds_w, H_y_bounds, S_set S_y_bounds, g_set_y_bounds_w, 0, 3, 1, 3);
+
+ Xen_define_constant(S_time_graph, TIME_AXIS_INFO, "time domain graph axis info");
+ Xen_define_constant(S_transform_graph, TRANSFORM_AXIS_INFO, "frequency domain graph axis info");
+ Xen_define_constant(S_lisp_graph, LISP_AXIS_INFO, "lisp graph axis info");
}
#endif
diff --git a/snd-chn.c b/snd-chn.c
index 4bfb4c0..ba5ac22 100644
--- a/snd-chn.c
+++ b/snd-chn.c
@@ -2,9 +2,7 @@
#include "clm2xen.h"
#include "clm-strings.h"
-/* TODO: the per-chan attributes (y-bounds, graph-type etc) are a mess when update, unite, sync etc happen */
-
-bool graph_style_p(int grf)
+bool is_graph_style(int grf)
{
switch (grf)
{
@@ -26,7 +24,7 @@ typedef struct lisp_grf {
} lisp_grf;
-chan_info *get_cp(XEN snd, XEN x_chn_n, const char *caller)
+chan_info *get_cp(Xen snd, Xen x_chn_n, const char *caller)
{
snd_info *sp;
int chn_n;
@@ -39,8 +37,8 @@ chan_info *get_cp(XEN snd, XEN x_chn_n, const char *caller)
return(NULL); /* just in case our catch has been clobbered */
}
- if (XEN_INTEGER_P(x_chn_n))
- chn_n = XEN_TO_C_INT(x_chn_n);
+ if (Xen_is_integer(x_chn_n))
+ chn_n = Xen_integer_to_C_int(x_chn_n);
else
if (sp->selected_channel != NO_SELECTION)
chn_n = sp->selected_channel;
@@ -54,26 +52,26 @@ chan_info *get_cp(XEN snd, XEN x_chn_n, const char *caller)
}
-static XEN lisp_graph_hook;
-static XEN mouse_press_hook;
-static XEN mark_click_hook;
-static XEN mix_click_hook;
-static XEN mouse_click_hook;
-static XEN mouse_drag_hook;
-static XEN key_press_hook;
-static XEN after_transform_hook;
-static XEN graph_hook;
-static XEN after_graph_hook;
-static XEN after_lisp_graph_hook;
+static Xen lisp_graph_hook;
+static Xen mouse_press_hook;
+static Xen mark_click_hook;
+static Xen mix_click_hook;
+static Xen mouse_click_hook;
+static Xen mouse_drag_hook;
+static Xen key_press_hook;
+static Xen after_transform_hook;
+static Xen graph_hook;
+static Xen after_graph_hook;
+static Xen after_lisp_graph_hook;
static void after_transform(chan_info *cp, mus_float_t scaler)
{
- if (XEN_HOOKED(after_transform_hook))
+ if (Xen_hook_has_list(after_transform_hook))
run_hook(after_transform_hook,
- XEN_LIST_3(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_DOUBLE(scaler)),
+ Xen_list_3(C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_double_to_Xen_real(scaler)),
S_after_transform_hook);
}
@@ -81,12 +79,12 @@ static void after_transform(chan_info *cp, mus_float_t scaler)
static void run_after_graph_hook(chan_info *cp)
{
if ((cp->hookable == WITH_HOOK) &&
- (XEN_HOOKED(after_graph_hook)))
+ (Xen_hook_has_list(after_graph_hook)))
run_hook(after_graph_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan)),
+ Xen_list_2(C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan)),
S_after_graph_hook);
- /* (add-hook! after-graph-hook (lambda (a b) (snd-print (format #f "~A ~A" a b)))) */
+ /* (hook-push after-graph-hook (lambda (hook) (snd-print (format #f "~A ~A~%" (hook 'snd) (hook 'chn))))) */
}
@@ -456,10 +454,10 @@ static void chans_cursor_style(chan_info *cp, int value)
{
cursor_style_t style;
style = (cursor_style_t)value;
- if ((cp->cursor_style == CURSOR_PROC) && (XEN_PROCEDURE_P(cp->cursor_proc)))
+ if ((cp->cursor_style == CURSOR_PROC) && (Xen_is_procedure(cp->cursor_proc)))
{
snd_unprotect_at(cp->cursor_proc_loc);
- cp->cursor_proc = XEN_UNDEFINED;
+ cp->cursor_proc = Xen_undefined;
cp->cursor_proc_loc = NOT_A_GC_LOC;
}
cp->cursor_style = style;
@@ -498,7 +496,7 @@ chan_info *virtual_selected_channel(chan_info *cp)
static int calculate_fft_1(chan_info *cp, bool update_display)
{
- if ((cp->graph_transform_p) &&
+ if ((cp->graph_transform_on) &&
(!(chan_fft_in_progress(cp))))
{
#if (!USE_NO_GUI)
@@ -524,18 +522,9 @@ void calculate_fft(chan_info *cp)
static void update_graph_1(chan_info *cp, bool warn)
{
/* don't put display stuff here! This is needed so that the fft display does not get caught in a loop */
- double cur_srate;
snd_info *sp;
axis_info *ap;
-#if 0
- fprintf(stderr, "update %d %d %d %d %d\n",
- (cp->updating),
- (cp->active != CHANNEL_HAS_AXES),
- (cp->sounds == NULL),
- (cp->sounds[cp->sound_ctr] == NULL));
-#endif
-
if ((cp->updating) ||
(cp->active != CHANNEL_HAS_AXES) ||
(cp->sounds == NULL) ||
@@ -547,7 +536,7 @@ static void update_graph_1(chan_info *cp, bool warn)
{
#if (!USE_NO_GUI)
if ((warn) && (sp))
- string_to_minibuffer(sp, "(update squelched)"); /* this has tripped me one too many times... */
+ set_status(sp, "(update squelched)", false); /* this has tripped me one too many times... */
#endif
return;
}
@@ -559,23 +548,14 @@ static void update_graph_1(chan_info *cp, bool warn)
ap = cp->axis;
if (ap)
{
- cur_srate = (double)(SND_SRATE(sp));
+ double cur_srate;
+ cur_srate = (double)(snd_srate(sp));
ap->losamp = snd_round_mus_long_t(ap->x0 * cur_srate);
if (ap->losamp < 0) ap->losamp = 0;
ap->hisamp = (mus_long_t)(ap->x1 * cur_srate);
}
-#if USE_GTK
- if (!(cp->ax->wn))
- if (!(fixup_cp_cgx_ax_wn(cp)))
- {
- /* window not active yet (gtk) */
- cp->updating = false;
- return;
- }
-#endif
-
- if ((cp->graph_transform_p) &&
+ if ((cp->graph_transform_on) &&
(!(chan_fft_in_progress(cp))))
calculate_fft_1(cp, DONT_FORCE_REDISPLAY);
display_channel_data(cp);
@@ -597,9 +577,9 @@ void update_graph_or_warn(chan_info *cp)
#define INITIAL_EDIT_SIZE 8
-static XEN initial_graph_hook;
+static Xen initial_graph_hook;
-void add_channel_data_1(chan_info *cp, int srate, mus_long_t frames, channel_graph_t graphed)
+bool add_channel_data_1(chan_info *cp, int srate, mus_long_t framples, channel_graph_t graphed)
{
/* initialize channel, including edit/sound lists */
axis_info *ap;
@@ -612,7 +592,7 @@ void add_channel_data_1(chan_info *cp, int srate, mus_long_t frames, channel_gra
cp->edit_size = INITIAL_EDIT_SIZE;
cp->edits = (ed_list **)calloc(cp->edit_size, sizeof(ed_list *));
cp->edit_ctr = 0;
- cp->edits[0] = initial_ed_list(0, frames - 1);
+ cp->edits[0] = initial_ed_list(0, framples - 1);
cp->sound_size = INITIAL_EDIT_SIZE;
cp->sound_ctr = 0;
cp->sounds = (snd_data **)calloc(cp->sound_size, sizeof(snd_data *));
@@ -633,7 +613,7 @@ void add_channel_data_1(chan_info *cp, int srate, mus_long_t frames, channel_gra
default: label = "time"; break;
}
- dur = (double)frames / (double)(srate);
+ dur = (double)framples / (double)(srate);
if (show_full_duration(ss))
{
x0 = 0.0;
@@ -660,35 +640,37 @@ void add_channel_data_1(chan_info *cp, int srate, mus_long_t frames, channel_gra
if (error_string)
snd_warning("peak-env: %s\n", error_string);
}
+ /* there is no data yet in the channel, so channel_maxamp here will get 0.0 */
/* initial-graph-hook */
- if (XEN_HOOKED(initial_graph_hook))
+ if (Xen_hook_has_list(initial_graph_hook))
{
- XEN res;
- int len = 0;
+ Xen res;
res = run_or_hook(initial_graph_hook,
- XEN_LIST_3(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_DOUBLE(dur)),
+ Xen_list_3(C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_double_to_Xen_real(dur)),
S_initial_graph_hook);
- if (XEN_LIST_P_WITH_LENGTH(res, len))
+ if (Xen_is_list(res))
{
- if (len > 0) x0 = XEN_TO_C_DOUBLE(XEN_CAR(res));
- if (len > 1) x1 = XEN_TO_C_DOUBLE(XEN_CADR(res));
- if (len > 2) y0 = XEN_TO_C_DOUBLE(XEN_CADDR(res));
- if (len > 3) y1 = XEN_TO_C_DOUBLE(XEN_CADDDR(res));
+ int len;
+ len = Xen_list_length(res);
+ if (len > 0) x0 = Xen_real_to_C_double(Xen_car(res));
+ if (len > 1) x1 = Xen_real_to_C_double(Xen_cadr(res));
+ if (len > 2) y0 = Xen_real_to_C_double(Xen_caddr(res));
+ if (len > 3) y1 = Xen_real_to_C_double(Xen_cadddr(res));
if ((len > 4) &&
- (XEN_STRING_P(XEN_LIST_REF(res, 4))))
- hook_label = mus_strdup(XEN_TO_C_STRING(XEN_LIST_REF(res, 4)));
+ (Xen_is_string(Xen_list_ref(res, 4))))
+ hook_label = mus_strdup(Xen_string_to_C_string(Xen_list_ref(res, 4)));
if (len > 5)
{
- ymin = XEN_TO_C_DOUBLE(XEN_LIST_REF(res, 5));
+ ymin = Xen_real_to_C_double(Xen_list_ref(res, 5));
ymin_set = true;
}
if (len > 6)
{
- ymax = XEN_TO_C_DOUBLE(XEN_LIST_REF(res, 6));
+ ymax = Xen_real_to_C_double(Xen_list_ref(res, 6));
ymax_set = true;
}
/* ymin/ymax for possible fit data hooks */
@@ -766,6 +748,7 @@ void add_channel_data_1(chan_info *cp, int srate, mus_long_t frames, channel_gra
initialize_scrollbars(cp);
cp->active = CHANNEL_HAS_AXES;
+ return(ymax_set);
}
@@ -780,14 +763,21 @@ void start_peak_env(chan_info *cp)
void add_channel_data(char *filename, chan_info *cp, channel_graph_t graphed)
{
int chn = 0;
- mus_long_t frames;
+ mus_long_t framples;
snd_info *sp;
file_info *chdr, *hdr;
+#if (!USE_NO_GUI)
+ bool ymax_set;
+#endif
sp = cp->sound;
hdr = sp->hdr;
- frames = hdr->samples / hdr->chans;
- add_channel_data_1(cp, hdr->srate, frames, graphed);
+ framples = hdr->samples / hdr->chans;
+#if (!USE_NO_GUI)
+ ymax_set = add_channel_data_1(cp, hdr->srate, framples, graphed);
+#else
+ add_channel_data_1(cp, hdr->srate, framples, graphed);
+#endif
chdr = copy_header(filename, hdr); /* need one separate from snd_info case */
chn = cp->chan;
@@ -799,20 +789,93 @@ void add_channel_data(char *filename, chan_info *cp, channel_graph_t graphed)
{
snd_io *io;
snd_file_open_descriptors(fd,
- filename, chdr->format,
+ filename, chdr->sample_type,
chdr->data_location,
chdr->chans,
chdr->type);
during_open(fd, filename, SND_OPEN_CHANNEL);
io = make_file_state(fd, chdr, chn, 0, FILE_BUFFER_SIZE);
cp->sounds[0] = make_snd_data_file(filename, io, chdr, DONT_DELETE_ME, cp->edit_ctr, chn);
+
+ /* if sound tables have the saved maxamp data, grab it */
+ if (mus_sound_channel_maxamp_exists(filename, cp->chan))
+ {
+ mus_long_t pos;
+ /* fprintf(stderr, "reading max for %s %d\n", filename, cp->chan); */
+ set_ed_maxamp(cp, 0, mus_sound_channel_maxamp(filename, cp->chan, &pos));
+ set_ed_maxamp_position(cp, 0, pos);
+ }
+ /* else fprintf(stderr, "can't read max for %s %d\n", filename, chn); */
}
}
+
#if (!USE_NO_GUI)
- if ((CURRENT_SAMPLES(cp) > PEAK_ENV_CUTOFF) &&
- (cp->edits[0]->peak_env == NULL) && /* perhaps created at initial graph time */
- (cp->sound->short_filename != NULL)) /* region browser jumped in too soon during autotest */
- start_peak_env(cp);
+ if ((show_full_range(ss)) &&
+ (!ymax_set) &&
+ (graphed == WITH_GRAPH))
+ {
+ mus_float_t ymax;
+ if ((sp->channel_style == CHANNELS_COMBINED) &&
+ (sp->nchans > 1))
+ {
+ if (cp->chan == sp->nchans - 1)
+ {
+ int i;
+ ymax = 0.0;
+ for (i = 0; i < sp->nchans; i++)
+ {
+ mus_float_t local_max;
+ local_max = channel_maxamp(sp->chans[i], 0);
+ if (local_max > ymax)
+ ymax = local_max;
+ }
+ if (ymax > 1.0)
+ {
+ for (i = 0; i < sp->nchans; i++)
+ {
+ axis_info *ap;
+ chan_info *ncp;
+ ncp = sp->chans[i];
+ ap = ncp->axis;
+ ap->ymin = -ymax;
+ ap->ymax = ymax;
+ ap->y_ambit = 2 * ap->ymax;
+ ap->y0 = ap->ymin;
+ ap->y1 = ap->ymax;
+ ap->zy = 1.0;
+ ap->sy = 0.0;
+ resize_sy_and_zy(ncp);
+ apply_y_axis_change(ncp);
+ }
+ }
+ }
+ }
+ else
+ {
+ ymax = channel_maxamp(cp, 0);
+ if (ymax > 1.0)
+ {
+ axis_info *ap;
+ ap = cp->axis;
+ ap->ymin = -ymax;
+ ap->ymax = ymax;
+ ap->y_ambit = 2 * ap->ymax;
+ ap->y0 = ap->ymin;
+ ap->y1 = ap->ymax;
+ ap->zy = 1.0;
+ ap->sy = 0.0;
+ resize_sy_and_zy(cp);
+ apply_y_axis_change(cp);
+ }
+ }
+ }
+ else
+ {
+ if ((current_samples(cp) > PEAK_ENV_CUTOFF) &&
+ (cp->edits[0]->peak_env == NULL) && /* perhaps created at initial graph time */
+ (sp->short_filename != NULL)) /* region browser jumped in too soon during autotest */
+ start_peak_env(cp);
+ }
#endif
}
@@ -832,6 +895,8 @@ static void set_y_bounds(axis_info *ap)
}
+static bool is_NaN(double x) {return(x != x);}
+
void set_x_bounds(axis_info *ap)
{
double range;
@@ -842,9 +907,7 @@ void set_x_bounds(axis_info *ap)
}
range = ap->zx * ap->x_ambit;
ap->x0 = ap->xmin + ap->sx * ap->x_ambit;
-#if HAVE_DECL_ISNAN
- if (isnan(ap->x0)) ap->x0 = 0.0;
-#endif
+ if (is_NaN(ap->x0)) ap->x0 = 0.0;
ap->x1 = (ap->x0 + range);
if (ap->x1 > ap->xmax)
{
@@ -856,9 +919,11 @@ void set_x_bounds(axis_info *ap)
}
-void apply_y_axis_change(axis_info *ap, chan_info *cp)
+void apply_y_axis_change(chan_info *cp)
{
snd_info *sp;
+ axis_info *ap;
+ ap = cp->axis;
sp = cp->sound;
set_y_bounds(ap);
@@ -912,7 +977,7 @@ void set_x_axis_x0x1(chan_info *cp, double x0, double x1)
ap->sx = (x0 - ap->xmin) / ap->x_ambit;
resize_sx_and_zx(cp);
}
- apply_x_axis_change(ap, cp); /* this checks sync */
+ apply_x_axis_change(cp); /* this checks sync */
ap->changed = true;
}
@@ -927,10 +992,8 @@ static void set_x_axis_x0(chan_info *cp, mus_long_t left)
{
double x1x0;
x1x0 = ap->x1 - ap->x0;
- ap->x0 = (double)left / (double)SND_SRATE(cp->sound);
-#if HAVE_DECL_ISNAN
- if (isnan(ap->x0)) ap->x0 = 0.0;
-#endif
+ ap->x0 = (double)left / (double)snd_srate(cp->sound);
+ if (is_NaN(ap->x0)) ap->x0 = 0.0;
set_x_axis_x0x1(cp, ap->x0, ap->x0 + x1x0);
}
}
@@ -947,7 +1010,7 @@ static void set_x_axis_x1(chan_info *cp, mus_long_t right)
{
double x1x0;
x1x0 = ap->x1 - ap->x0;
- ap->x1 = (double)right / (double)SND_SRATE(cp->sound);
+ ap->x1 = (double)right / (double)snd_srate(cp->sound);
set_x_axis_x0x1(cp, ap->x1 - x1x0, ap->x1);
}
}
@@ -957,7 +1020,7 @@ static void set_x_axis_x1(chan_info *cp, mus_long_t right)
void reset_x_display(chan_info *cp, double sx, double zx)
{
axis_info *ap;
- bool reset_zx = false;
+ bool reset_zx;
ap = cp->axis;
ap->sx = sx;
@@ -988,14 +1051,19 @@ static void update_xs(chan_info *ncp, axis_info *ap)
}
-void apply_x_axis_change(axis_info *ap, chan_info *cp)
+void apply_x_axis_change(chan_info *cp)
{
int i;
snd_info *sp;
+ axis_info *ap;
+
+ ap = cp->axis;
sp = cp->sound;
sp->lacp = cp;
+
set_x_bounds(ap);
update_graph_or_warn(cp);
+
if (sp->sync != 0)
{
sync_info *si;
@@ -1019,7 +1087,7 @@ void apply_x_axis_change(axis_info *ap, chan_info *cp)
static mus_long_t zoom_focus_location(chan_info *cp)
{
if (cp->cursor_visible)
- return(CURSOR(cp));
+ return(cursor_sample(cp));
if (selection_is_visible_in_channel(cp))
/* this is complicated! We want the relative position of the focussed-upon thing
@@ -1060,8 +1128,9 @@ static mus_long_t zoom_focus_location(chan_info *cp)
}
-void focus_x_axis_change(axis_info *ap, chan_info *cp, int focus_style)
+void focus_x_axis_change(chan_info *cp, int focus_style)
{
+ axis_info *ap;
/* prepare for set_x_bounds given desired focus point, then drop into default
* we need to set ap->sx to reflect the new zx value and the focus type
* if focus_left - go on (nothing to do)
@@ -1070,7 +1139,7 @@ void focus_x_axis_change(axis_info *ap, chan_info *cp, int focus_style)
* focus_active - find the currently active entity, if none use focus_middle
* focus_proc -- call proc
*/
-
+ ap = cp->axis;
if (ap->xmax == 0.0) return;
if (ap->xmax <= ap->xmin)
@@ -1086,14 +1155,15 @@ void focus_x_axis_change(axis_info *ap, chan_info *cp, int focus_style)
switch (focus_style)
{
case ZOOM_FOCUS_PROC:
- ap->x0 = XEN_TO_C_DOUBLE(XEN_CALL_6(ss->zoom_focus_proc,
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_DOUBLE(ap->zx),
- C_TO_XEN_DOUBLE(ap->x0),
- C_TO_XEN_DOUBLE(ap->x1),
- C_TO_XEN_DOUBLE(ap->x_ambit),
- S_zoom_focus_style " procedure"));
+ ap->x0 = Xen_real_to_C_double(
+ Xen_call_with_6_args(ss->zoom_focus_proc,
+ C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_double_to_Xen_real(ap->zx),
+ C_double_to_Xen_real(ap->x0),
+ C_double_to_Xen_real(ap->x1),
+ C_double_to_Xen_real(ap->x_ambit),
+ S_zoom_focus_style " procedure"));
break;
case ZOOM_FOCUS_RIGHT:
@@ -1117,7 +1187,7 @@ void focus_x_axis_change(axis_info *ap, chan_info *cp, int focus_style)
sync = sp->sync;
if (sync != 0)
{
- int i, j;
+ int i;
for (i = 0; i < sp->nchans; i++)
if (i != ncp->chan)
{
@@ -1127,6 +1197,7 @@ void focus_x_axis_change(axis_info *ap, chan_info *cp, int focus_style)
}
if (newf == NO_ZOOM_FOCUS_LOCATION)
{
+ int j;
/* geez, maybe it's in a separate syncd sound */
for (j = 0; j < ss->max_sounds; j++)
{
@@ -1141,13 +1212,14 @@ void focus_x_axis_change(axis_info *ap, chan_info *cp, int focus_style)
if (newf != NO_ZOOM_FOCUS_LOCATION)
{
- double loc, pos;
- loc = (double)newf / (double)SND_SRATE(ncp->sound);
+ double loc;
+ loc = (double)newf / (double)snd_srate(ncp->sound);
if ((loc > ap->x0) &&
(loc < ap->x1) &&
(ap->x1 > ap->x0))
/* try to maintain current relative position in window */
{
+ double pos;
pos = (loc - ap->x0) / (ap->x1 - ap->x0);
ap->x0 = loc - pos * ap->zx * ap->x_ambit;
}
@@ -1157,14 +1229,12 @@ void focus_x_axis_change(axis_info *ap, chan_info *cp, int focus_style)
break;
}
-#if HAVE_DECL_ISNAN
- if (isnan(ap->x0)) ap->x0 = 0.0;
-#endif
+ if (is_NaN(ap->x0)) ap->x0 = 0.0;
if (ap->x0 < 0.0) ap->x0 = 0.0;
if (ap->x_ambit != 0.0)
ap->sx = (double)(ap->x0 - ap->xmin) / (double)(ap->x_ambit);
}
- apply_x_axis_change(ap, cp);
+ apply_x_axis_change(cp);
}
@@ -1175,50 +1245,56 @@ void sx_incremented(chan_info *cp, double amount)
ap->sx += (ap->zx * amount);
if (ap->sx < 0.0) ap->sx = 0.0;
if (ap->sx > (1.0 - ap->zx)) ap->sx = 1.0 - ap->zx;
- apply_x_axis_change(ap, cp);
+ apply_x_axis_change(cp);
resize_sx(cp);
}
void zx_incremented(chan_info *cp, double amount)
-{ /* kbd arrows etc -- needs to be able to return to original */
+{
+ /* kbd arrows etc -- needs to be able to return to original */
axis_info *ap;
mus_long_t samps;
- samps = CURRENT_SAMPLES(cp);
+ samps = current_samples(cp);
ap = cp->axis;
if ((amount >= 1.0) ||
((samps > 0) && ((ap->zx * (double)samps) > (amount / 2.0))))
{
ap->zx *= amount;
if (ap->zx > 1.0) ap->zx = 1.0;
- focus_x_axis_change(ap, cp, zoom_focus_style(ss));
- /* apply_x_axis_change(ap, cp); */
- resize_sx(cp);
+ focus_x_axis_change(cp, zoom_focus_style(ss));
+ /* resize_sx(cp); */
+ resize_sx_and_zx(cp); /* need zx also -- this changes its position, not its size. 22-Aug-12 */
}
}
-int move_axis(chan_info *cp, axis_info *ap, int x)
+int move_axis(chan_info *cp, int x)
{
/* need to scroll axis forward or backward -- distance per call depends on x distance from end of axis */
double off;
int nx;
+ axis_info *ap;
+
+ ap = cp->axis;
if (x > ap->x_axis_x1)
{
off = x - ap->x_axis_x1;
- ap->sx += (off * ap->zx / 1000.0);
+ ap->sx += (off * ap->zx / 4000.0); /* increase 4000.0 to make the axis move more slowly (and below) */
if (ap->sx > (1.0 - ap->zx)) ap->sx = 1.0 - ap->zx;
nx = ap->x_axis_x1;
}
else
{
off = ap->x_axis_x0 - x;
- ap->sx -= (off * ap->zx / 1000.0);
+ ap->sx -= (off * ap->zx / 4000.0);
if (ap->sx < 0.0) ap->sx = 0.0;
nx = ap->x_axis_x0;
}
- apply_x_axis_change(ap, cp);
+
+ apply_x_axis_change(cp);
resize_sx(cp);
+
return(nx);
}
@@ -1227,6 +1303,7 @@ void set_axes(chan_info *cp, double x0, double x1, mus_float_t y0, mus_float_t y
{
/* use to change channel_style to channels_separate, and restore axes upon update */
axis_info *ap;
+
ap = cp->axis;
ap->x0 = x0;
ap->x1 = x1;
@@ -1236,6 +1313,7 @@ void set_axes(chan_info *cp, double x0, double x1, mus_float_t y0, mus_float_t y
ap->sx = (x0 - ap->xmin) / ap->x_ambit;
}
resize_sx(cp);
+
ap->y0 = y0;
ap->y1 = y1;
if (ap->y_ambit != 0.0)
@@ -1290,24 +1368,30 @@ static char chn_id_str[LABEL_BUFFER_SIZE];
static void display_channel_id(chan_info *cp, graphics_context *ax, int height, int chans)
{
- if (cp->show_axes == SHOW_NO_AXES) return;
- if ((chans > 1) || (cp->edit_ctr > 0))
+ if (cp->show_axes == SHOW_NO_AXES)
+ return;
+
+ if ((chans > 1) ||
+ (cp->edit_ctr > 0))
{
int x0, y0;
color_t old_color = 0;
+
set_peak_numbers_font(cp, ax);
if (cp->printing) ps_set_peak_numbers_font();
+
x0 = 5;
y0 = height + CHN_LABEL_OFFSET;
-
if (cp->edit_ctr == 0)
- mus_snprintf(chn_id_str, LABEL_BUFFER_SIZE, "[%d]", cp->chan + 1);
- else mus_snprintf(chn_id_str, LABEL_BUFFER_SIZE, "[%d]: %d", cp->chan + 1, cp->edit_ctr);
+ snprintf(chn_id_str, LABEL_BUFFER_SIZE, "[%d]", cp->chan + 1);
+ else snprintf(chn_id_str, LABEL_BUFFER_SIZE, "[%d]: %d", cp->chan + 1, cp->edit_ctr);
+
if (cp == selected_channel())
{
old_color = get_foreground_color(copy_context(cp));
set_foreground_color(copy_context(cp), ss->red);
}
+
draw_string(copy_context(cp), x0, y0, chn_id_str, strlen(chn_id_str));
if (cp->printing)
ps_draw_string(cp->axis, x0, y0, chn_id_str);
@@ -1332,8 +1416,8 @@ static void display_selection_transform_size(chan_info *cp, axis_info *fap, grap
if (cp->printing) ps_set_tiny_numbers_font();
y0 = fap->height + fap->y_offset + SELECTION_FFT_LABEL_OFFSET;
x0 = fap->x_axis_x0 + 20;
- mus_snprintf(chn_id_str, LABEL_BUFFER_SIZE,
- "(len: " MUS_LD "/" MUS_LD ")",
+ snprintf(chn_id_str, LABEL_BUFFER_SIZE,
+ "(len: %lld/%lld)",
selection_len(),
cp->selection_transform_size);
draw_string(copy_context(cp), x0, y0, chn_id_str, strlen(chn_id_str));
@@ -1353,8 +1437,6 @@ snd_info *make_simple_channel_display(int srate, int initial_length, fw_button_t
sp->inuse = SOUND_WRAPPER;
sp->active = true;
sp->hdr = (file_info *)calloc(1, sizeof(file_info));
- sp->search_proc = XEN_UNDEFINED;
- sp->prompt_callback = XEN_UNDEFINED;
hdr = sp->hdr;
hdr->samples = initial_length;
hdr->srate = srate;
@@ -1390,10 +1472,9 @@ static int make_graph_1(chan_info *cp, double cur_srate, graph_choice_t graph_ch
snd_info *sp;
int j = 0;
mus_long_t samps;
- int xi;
axis_info *ap;
- mus_float_t samples_per_pixel, xf, pinc = 0.0;
- double x, incr;
+ mus_float_t samples_per_pixel;
+ double x;
/* in long files with small windows we can run into floating point errors that accumulate
* in the loop (incrementing by a truncated amount each time), making the x amounts smaller
@@ -1472,12 +1553,14 @@ static int make_graph_1(chan_info *cp, double cur_srate, graph_choice_t graph_ch
(samples_per_pixel < 25.0) &&
(samps < POINT_BUFFER_SIZE)))
{
+ double incr;
int grfpts;
/* i.e. individual samples are widely spaced, so we have to be careful about placement
* mouse uses grf_x so in this case we have to also (to make the cursor hit the dots etc)
*/
sf = init_sample_read(ap->losamp, cp, READ_FORWARD);
if (sf == NULL) return(0);
+
incr = (double)1.0 / cur_srate;
grfpts = (int)(ap->hisamp - ap->losamp + 1);
if (cp->printing)
@@ -1497,7 +1580,15 @@ static int make_graph_1(chan_info *cp, double cur_srate, graph_choice_t graph_ch
}
if (graph_choice == NORMAL_GRAPH)
{
- draw_grf_points(cp->dot_size, ax, j, ap, 0.0, cp->time_graph_style);
+ if (sp->channel_style == CHANNELS_SUPERIMPOSED)
+ {
+ color_t old_color;
+ old_color = get_foreground_color(ax);
+ set_foreground_color(ax, cp->combined_data_color);
+ draw_grf_points(cp->dot_size, ax, j, ap, 0.0, cp->time_graph_style);
+ set_foreground_color(ax, old_color);
+ }
+ else draw_grf_points(cp->dot_size, ax, j, ap, 0.0, cp->time_graph_style);
if (cp->printing)
ps_draw_grf_points(ap, j, 0.0, cp->time_graph_style, cp->dot_size);
}
@@ -1511,12 +1602,14 @@ static int make_graph_1(chan_info *cp, double cur_srate, graph_choice_t graph_ch
{
/* take min, max */
if (peak_env_usable(cp, samples_per_pixel, ap->hisamp, true, cp->edit_ctr, false)) /* true = start new background amp env process if needed */
- j = peak_env_graph(cp, ap, samples_per_pixel, (graph_choice != ENVED_GRAPH) ? ((int)SND_SRATE(sp)) : 1);
+ j = peak_env_graph(cp, samples_per_pixel, (graph_choice != ENVED_GRAPH) ? ((int)snd_srate(sp)) : 1);
else
{
- mus_float_t ymin, ymax;
+ mus_float_t ymin, ymax, xf, pinc = 0.0;
mus_long_t ioff;
- if ((ap->hisamp - ap->losamp) > (CURRENT_SAMPLES(cp) / 4))
+ int xi;
+
+ if ((ap->hisamp - ap->losamp) > (current_samples(cp) / 4))
{
/* we're trying to view a large portion of the (large) sound */
if (cp->peak_env_in_progress)
@@ -1532,6 +1625,7 @@ static int make_graph_1(chan_info *cp, double cur_srate, graph_choice_t graph_ch
}
sf = init_sample_read(ap->losamp, cp, READ_FORWARD);
if (sf == NULL) return(0);
+
j = 0; /* graph point counter */
x = ap->x0;
xi = local_grf_x(x, ap);
@@ -1541,7 +1635,7 @@ static int make_graph_1(chan_info *cp, double cur_srate, graph_choice_t graph_ch
if (cp->printing) pinc = samples_per_pixel / cur_srate;
ap->changed = false;
ss->stopped_explicitly = false;
- for (ioff = ap->losamp, xf = 0.0; ioff <= ap->hisamp; ioff++)
+ for (ioff = ap->losamp; ioff <= ap->hisamp; ioff++)
{
mus_float_t samp;
samp = read_sample(sf);
@@ -1578,7 +1672,15 @@ static int make_graph_1(chan_info *cp, double cur_srate, graph_choice_t graph_ch
}
if (graph_choice == NORMAL_GRAPH)
{
- draw_both_grf_points(cp->dot_size, ax, j, cp->time_graph_style);
+ if (sp->channel_style == CHANNELS_SUPERIMPOSED)
+ {
+ color_t old_color;
+ old_color = get_foreground_color(ax);
+ set_foreground_color(ax, cp->combined_data_color);
+ draw_both_grf_points(cp->dot_size, ax, j, cp->time_graph_style);
+ set_foreground_color(ax, old_color);
+ }
+ else draw_both_grf_points(cp->dot_size, ax, j, cp->time_graph_style);
if (cp->printing)
ps_draw_both_grf_points(ap, j, cp->time_graph_style, cp->dot_size);
}
@@ -1598,28 +1700,26 @@ static int make_graph_1(chan_info *cp, double cur_srate, graph_choice_t graph_ch
if (cp->printing)
ps_reset_color();
}
- if ((cp->verbose_cursor) && (cp->cursor_on) &&
- (CURSOR(cp) >= ap->losamp) && (CURSOR(cp) <= ap->hisamp) &&
- ((sp->minibuffer_on == MINI_OFF) || (sp->minibuffer_on == MINI_CURSOR)))
- {
- show_cursor_info(cp);
- sp->minibuffer_on = MINI_CURSOR;
- }
+ if ((cp->with_verbose_cursor) &&
+ (cp->cursor_on) &&
+ (cursor_sample(cp) >= ap->losamp) &&
+ (cursor_sample(cp) <= ap->hisamp))
+ show_cursor_info(cp);
}
return(j);
}
-int make_graph(chan_info *cp)
+static int make_graph(chan_info *cp)
{
- return(make_graph_1(cp, (double)(SND_SRATE(cp->sound)), NORMAL_GRAPH, NULL));
+ return(make_graph_1(cp, (double)(snd_srate(cp->sound)), NORMAL_GRAPH, NULL));
}
int make_dragged_marks_graph(chan_info *cp)
{
- return(make_graph_1(cp, (double)(SND_SRATE(cp->sound)), MARKS_GRAPH, NULL));
+ return(make_graph_1(cp, (double)(snd_srate(cp->sound)), MARKS_GRAPH, NULL));
}
@@ -1635,17 +1735,16 @@ void make_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end)
snd_info *sp;
int j = 0;
mus_long_t samps;
- int xi;
axis_info *ap;
- mus_float_t samples_per_pixel, xf;
- double x, incr, cur_srate, beg_in_seconds, end_in_seconds;
+ mus_float_t samples_per_pixel;
+ double x, cur_srate, beg_in_seconds, end_in_seconds;
int pixels;
snd_fd *sf = NULL;
int x_start, x_end;
graphics_context *ax = NULL;
sp = cp->sound;
- cur_srate = (double)SND_SRATE(sp);
+ cur_srate = (double)snd_srate(sp);
ap = cp->axis;
ax = copy_context(cp);
if (!(ap->ax))
@@ -1681,8 +1780,10 @@ void make_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end)
((samples_per_pixel < 5.0) && (samps < POINT_BUFFER_SIZE)) ||
((cp->time_graph_style == GRAPH_FILLED) && (samples_per_pixel < 25.0) && (samps < POINT_BUFFER_SIZE)))
{
+ double incr;
int grfpts;
sf = init_sample_read(beg, cp, READ_FORWARD);
+
incr = (double)1.0 / cur_srate;
grfpts = (int)(end - beg + 1);
@@ -1694,12 +1795,13 @@ void make_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end)
else
{
if (peak_env_usable(cp, samples_per_pixel, ap->hisamp, true, cp->edit_ctr, false)) /* true = start new background amp env process if needed */
- j = peak_env_partial_graph(cp, ap, beg, end, samples_per_pixel, (int)SND_SRATE(sp));
+ j = peak_env_partial_graph(cp, beg, end, samples_per_pixel, (int)snd_srate(sp));
else
{
- mus_float_t ymin, ymax;
+ mus_float_t ymin, ymax, xf;
mus_long_t ioff;
- if ((end - beg) > (CURRENT_SAMPLES(cp) / 4))
+ int xi;
+ if ((end - beg) > (current_samples(cp) / 4))
{
/* we're trying to view a large portion of the (large) sound */
if (cp->peak_env_in_progress)
@@ -1725,7 +1827,7 @@ void make_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end)
ymin = MIN_INIT;
ymax = MAX_INIT;
ap->changed = false;
- for (ioff = beg, xf = 0.0; ioff <= end; ioff++)
+ for (ioff = beg; ioff <= end; ioff++)
{
mus_float_t samp;
samp = read_sample(sf);
@@ -1753,13 +1855,12 @@ void make_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end)
#endif
if (cp->show_y_zero) display_y_zero(cp);
- if ((cp->verbose_cursor) && (cp->cursor_on) &&
- (CURSOR(cp) >= beg) && (CURSOR(cp) <= end) &&
- ((sp->minibuffer_on == MINI_OFF) || (sp->minibuffer_on == MINI_CURSOR)))
- {
- show_cursor_info(cp);
- sp->minibuffer_on = MINI_CURSOR;
- }
+ if ((cp->with_verbose_cursor) &&
+ (cp->cursor_on) &&
+ (cursor_sample(cp) >= beg) &&
+ (cursor_sample(cp) <= end))
+ show_cursor_info(cp);
+
#if USE_GTK
cairo_pop_group_to_source(ss->cr);
cairo_paint(ss->cr);
@@ -1775,9 +1876,9 @@ void make_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end)
* to the second cp -- allow arbitrary overlapping etc).
*/
-XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t hisamp)
+Xen make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t hisamp)
{
- int i, j = 0;
+ int j = 0;
mus_long_t samps, ioff;
axis_info *ap;
mus_float_t samples_per_pixel, xf;
@@ -1793,7 +1894,7 @@ XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t h
x_start = ap->x_axis_x0;
x_end = ap->x_axis_x1;
samps = hisamp - losamp + 1;
- if ((samps <= 0) || ((x_start == x_end) && (samps > 10))) return(XEN_FALSE);
+ if ((samps <= 0) || ((x_start == x_end) && (samps > 10))) return(Xen_false);
pixels = x_end - x_start;
if (pixels >= POINT_BUFFER_SIZE) pixels = POINT_BUFFER_SIZE - 1;
if ((x_start == x_end) || (samps <= 1))
@@ -1804,9 +1905,11 @@ XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t h
((samples_per_pixel < 5.0) &&
(samps < POINT_BUFFER_SIZE)))
{
+ int i;
data_size = (int)samps;
sf = init_sample_read_any(losamp, cp, READ_FORWARD, edit_pos);
- if (sf == NULL) return(XEN_FALSE); /* should this throw an error? (CHANNEL_BEING_DEALLOCATED) */
+ if (sf == NULL) return(Xen_false); /* should this throw an error? (CHANNEL_BEING_DEALLOCATED) */
+
data = (mus_float_t *)malloc(data_size * sizeof(mus_float_t));
for (i = 0; i < data_size; i++)
data[i] = read_sample(sf);
@@ -1817,7 +1920,6 @@ XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t h
{
double step, xk;
mus_float_t ymin, ymax;
- int k, kk;
peak_env_info *ep;
data_size = pixels + 1;
@@ -1834,6 +1936,7 @@ XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t h
while (ioff <= hisamp)
{
+ int k, kk;
k = (int)xf;
xf += step;
kk = (int)xf;
@@ -1855,11 +1958,12 @@ XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t h
}
else
{
- mus_float_t ymin, ymax, samp;
+ mus_float_t ymin, ymax;
data_size = pixels + 1;
sf = init_sample_read_any(losamp, cp, READ_FORWARD, edit_pos);
- if (sf == NULL) return(XEN_FALSE);
+ if (sf == NULL) return(Xen_false);
+
data = (mus_float_t *)calloc(data_size, sizeof(mus_float_t));
data1 = (mus_float_t *)calloc(data_size, sizeof(mus_float_t));
j = 0; /* graph point counter */
@@ -1869,6 +1973,7 @@ XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t h
for (ioff = losamp, xf = 0.0; ioff <= hisamp; ioff++)
{
+ mus_float_t samp;
samp = read_sample(sf);
if (samp > ymax) ymax = samp;
if (samp < ymin) ymin = samp;
@@ -1897,7 +2002,7 @@ XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t h
sf = free_snd_fd(sf);
if (data1)
- return(XEN_LIST_2(xen_make_vct(data_size, data),
+ return(Xen_list_2(xen_make_vct(data_size, data),
xen_make_vct(data_size, data1)));
else return(xen_make_vct(data_size, data));
}
@@ -1906,18 +2011,16 @@ XEN make_graph_data(chan_info *cp, int edit_pos, mus_long_t losamp, mus_long_t h
void draw_graph_data(chan_info *cp, mus_long_t losamp, mus_long_t hisamp, int data_size, mus_float_t *data, mus_float_t *data1, graphics_context *ax, graph_style_t style)
{
mus_long_t i, samps;
- int xi;
axis_info *ap;
snd_info *sp;
- double x, incr;
ap = cp->axis;
sp = cp->sound;
if (data1 == NULL)
{
- double start_time = 0.0, cur_srate = 1.0;
+ double start_time = 0.0, cur_srate, x, incr;
- cur_srate = (double)SND_SRATE(sp);
+ cur_srate = (double)snd_srate(sp);
if (losamp == -1)
losamp = snd_round_mus_long_t(ap->x0 * cur_srate);
start_time = (double)(losamp) / cur_srate;
@@ -1936,6 +2039,7 @@ void draw_graph_data(chan_info *cp, mus_long_t losamp, mus_long_t hisamp, int da
}
else
{
+ int xi;
if (losamp == -1)
losamp = 0;
if (hisamp == -1)
@@ -1965,31 +2069,33 @@ static char ampstr[LABEL_BUFFER_SIZE];
#define AMP_ROOM_CUTOFF 3.0
static void display_peaks(chan_info *cp, axis_info *fap, mus_float_t *data,
- mus_long_t start, mus_long_t end, /* start is not used? */
+ mus_long_t start, mus_long_t end,
mus_long_t losamp, mus_long_t hisamp,
mus_float_t samps_per_pixel, bool fft_data, mus_float_t fft_scale /* fourier scale factor or 0.0 */)
{
int num_peaks, row, frq_col, frq_strlen, tens, i, amp_col, amp_strlen, row_height = 15;
- mus_long_t samps;
+ mus_long_t samps, fsamps;
bool with_amps;
mus_float_t amp0;
graphics_context *ax;
fft_peak *peak_freqs = NULL;
fft_peak *peak_amps = NULL;
+ color_t old_color = (color_t)0; /* None in Motif, NULL in Gtk, 0 in no-gui */
- /* "end" is the top displayed frequency in the FFT frequency axis
+ /* "end" is the top displayed frequency in the FFT frequency axis (srate*spectrum_end/2)
* "hisamp - losamp" is how many samples of data we have
*/
/* "tens" is for prettyf in snd-utils, if -1 -> print int else sets decimals */
samps = hisamp - losamp;
- if (samps > (end * 10))
+ fsamps = end - start;
+ if (samps > (fsamps * 10))
tens = 2;
else
- if (samps > end)
+ if (samps > fsamps)
tens = 1;
else
- if (samps > (end / 10))
+ if (samps > (fsamps / 10))
tens = 0;
else tens = -1;
@@ -2010,7 +2116,7 @@ static void display_peaks(chan_info *cp, axis_info *fap, mus_float_t *data,
peak_amps = (fft_peak *)calloc(cp->max_transform_peaks, sizeof(fft_peak));
if (fft_data)
- num_peaks = find_and_sort_transform_peaks(data, peak_freqs, num_peaks, losamp, hisamp /* "fft size" */, samps_per_pixel, fft_scale); /* srate 1.0=>freqs between 0 and 1.0 */
+ num_peaks = find_and_sort_transform_peaks(data, peak_freqs, num_peaks, losamp, hisamp /* "fft size" */, samps_per_pixel, fft_scale);
else num_peaks = find_and_sort_peaks(data, peak_freqs, num_peaks, losamp, hisamp);
if ((num_peaks == 0) ||
@@ -2045,7 +2151,11 @@ static void display_peaks(chan_info *cp, axis_info *fap, mus_float_t *data,
}
if (cp->sound->channel_style == CHANNELS_SUPERIMPOSED)
- ax = combined_context(cp);
+ {
+ ax = combined_context(cp);
+ old_color = get_foreground_color(ax);
+ set_foreground_color(ax, cp->combined_data_color);
+ }
else ax = copy_context(cp);
if (num_peaks > 6)
@@ -2053,7 +2163,7 @@ static void display_peaks(chan_info *cp, axis_info *fap, mus_float_t *data,
for (i = 0; i < num_peaks; i++) peak_amps[i] = peak_freqs[i];
qsort((void *)peak_amps, num_peaks, sizeof(fft_peak), compare_peak_amps);
if (num_peaks < 12) amp0 = peak_amps[2].amp; else amp0 = peak_amps[5].amp;
- set_bold_peak_numbers_font(cp, ax); /* in snd-gchn.c */
+ set_bold_peak_numbers_font(cp, ax); /* in snd-g|xchn.c */
if (cp->printing) ps_set_bold_peak_numbers_font();
#if (!USE_GTK)
@@ -2081,8 +2191,8 @@ static void display_peaks(chan_info *cp, axis_info *fap, mus_float_t *data,
if (with_amps)
{
if ((fft_data) && (cp->fft_log_magnitude))
- mus_snprintf(ampstr, LABEL_BUFFER_SIZE, "%.1f", in_dB(cp->min_dB, cp->lin_dB, peak_freqs[i].amp));
- else mus_snprintf(ampstr, LABEL_BUFFER_SIZE, "%.*f", amp_strlen, peak_freqs[i].amp);
+ snprintf(ampstr, LABEL_BUFFER_SIZE, "%.1f", in_dB(cp->min_dB, cp->lin_dB, peak_freqs[i].amp));
+ else snprintf(ampstr, LABEL_BUFFER_SIZE, "%.*f", amp_strlen, peak_freqs[i].amp);
draw_string(ax, amp_col, row, ampstr, strlen(ampstr));
if (cp->printing)
ps_draw_string(fap, amp_col, row, ampstr);
@@ -2095,7 +2205,6 @@ static void display_peaks(chan_info *cp, axis_info *fap, mus_float_t *data,
set_peak_numbers_font(cp, ax);
if (cp->printing) ps_set_peak_numbers_font();
- /* choose a small font for these numbers */
#if (!USE_GTK)
row = fap->y_axis_y1 + row_height;
#else
@@ -2121,8 +2230,8 @@ static void display_peaks(chan_info *cp, axis_info *fap, mus_float_t *data,
if (with_amps)
{
if ((fft_data) && (cp->fft_log_magnitude))
- mus_snprintf(ampstr, LABEL_BUFFER_SIZE, "%.1f", in_dB(cp->min_dB, cp->lin_dB, peak_freqs[i].amp));
- else mus_snprintf(ampstr, LABEL_BUFFER_SIZE, "%.*f", amp_strlen, peak_freqs[i].amp);
+ snprintf(ampstr, LABEL_BUFFER_SIZE, "%.1f", in_dB(cp->min_dB, cp->lin_dB, peak_freqs[i].amp));
+ else snprintf(ampstr, LABEL_BUFFER_SIZE, "%.*f", amp_strlen, peak_freqs[i].amp);
draw_string(ax, amp_col, row, ampstr, strlen(ampstr));
if (cp->printing)
ps_draw_string(fap, amp_col, row, ampstr);
@@ -2132,6 +2241,8 @@ static void display_peaks(chan_info *cp, axis_info *fap, mus_float_t *data,
}
/* superimposed context reset takes place in make_fft_graph */
+ if (cp->sound->channel_style == CHANNELS_SUPERIMPOSED)
+ set_foreground_color(ax, old_color);
if (peak_freqs) free(peak_freqs);
if (peak_amps) free(peak_amps);
@@ -2146,13 +2257,12 @@ static void make_fft_graph(chan_info *cp, axis_info *fap, graphics_context *ax,
snd_info *sp;
mus_float_t *data;
mus_float_t incr, x, scale;
- mus_long_t i, j = 0, hisamp, losamp = 0;
+ mus_long_t i, hisamp, losamp = 0;
int lines_to_draw = 0;
- mus_float_t samples_per_pixel, xf, ina, ymax;
+ mus_float_t samples_per_pixel;
int logx, logy;
- mus_float_t pslogx, pslogy;
- mus_float_t saved_data = 0.0;
- mus_float_t minlx = 0.0, curlx = 0.0, fap_range, log_range, lscale = 1.0;
+ mus_float_t pslogx, pslogy, saved_data = 0.0;
+ mus_float_t minlx = 0.0, curlx = 0.0, lscale = 1.0;
mus_float_t *fft_phases = NULL;
bool free_phases = false;
@@ -2167,10 +2277,10 @@ static void make_fft_graph(chan_info *cp, axis_info *fap, graphics_context *ax,
{
hisamp = fp->current_size * cp->spectrum_end / 2;
if ((cp->fft_log_frequency) &&
- ((SND_SRATE(sp) * 0.5 * cp->spectrum_start) < log_freq_start(ss)))
- losamp = (mus_long_t)(ceil(fp->current_size * log_freq_start(ss) / (mus_float_t)SND_SRATE(sp)));
+ ((snd_srate(sp) * 0.5 * cp->spectrum_start) < log_freq_start(ss)))
+ losamp = (mus_long_t)(ceil(fp->current_size * log_freq_start(ss) / (mus_float_t)snd_srate(sp)));
else losamp = fp->current_size * cp->spectrum_start / 2;
- incr = (mus_float_t)SND_SRATE(sp) / (mus_float_t)(fp->current_size);
+ incr = (mus_float_t)snd_srate(sp) / (mus_float_t)(fp->current_size);
}
else
{
@@ -2190,7 +2300,7 @@ static void make_fft_graph(chan_info *cp, axis_info *fap, graphics_context *ax,
if (cp->fft_log_frequency)
{
- mus_float_t maxlx, max_data;
+ mus_float_t maxlx, max_data, log_range, fap_range;
fap_range = fap->x1 - fap->x0;
if (fap->x0 > 1.0) minlx = log(fap->x0); else minlx = 0.0;
@@ -2302,6 +2412,8 @@ static void make_fft_graph(chan_info *cp, axis_info *fap, graphics_context *ax,
}
else
{
+ mus_long_t j;
+ mus_float_t xf, ina, ymax;
if ((cp->fft_with_phases) &&
(fp->phases) &&
(cp->transform_type == FOURIER))
@@ -2432,7 +2544,15 @@ static void make_fft_graph(chan_info *cp, axis_info *fap, graphics_context *ax,
}
else
{
- draw_grf_points(cp->dot_size, ax, lines_to_draw, fap, 0.0, cp->transform_graph_style);
+ if (sp->channel_style == CHANNELS_SUPERIMPOSED)
+ {
+ color_t old_color;
+ old_color = get_foreground_color(ax);
+ set_foreground_color(ax, cp->combined_data_color);
+ draw_grf_points(cp->dot_size, ax, lines_to_draw, fap, 0.0, cp->transform_graph_style);
+ set_foreground_color(ax, old_color);
+ }
+ else draw_grf_points(cp->dot_size, ax, lines_to_draw, fap, 0.0, cp->transform_graph_style);
}
if (cp->printing)
@@ -2445,8 +2565,8 @@ static void make_fft_graph(chan_info *cp, axis_info *fap, graphics_context *ax,
{
if (cp->transform_type == FOURIER)
display_peaks(cp, fap, data,
- SND_SRATE(sp) * cp->spectrum_start / 2,
- SND_SRATE(sp) * cp->spectrum_end / 2,
+ snd_srate(sp) * cp->spectrum_start / 2,
+ snd_srate(sp) * cp->spectrum_end / 2,
losamp, hisamp,
samples_per_pixel, true, scale);
else display_peaks(cp, fap, data,
@@ -2488,12 +2608,15 @@ static int skew_color(mus_float_t x)
}
-static void make_sonogram(chan_info *cp)
+void make_sonogram(chan_info *cp)
{
#define SAVE_FFT_SIZE 4096
sono_info *si;
- static int *sono_js = NULL;
- static int sono_js_size = 0;
+ static unsigned int *sono_js = NULL;
+ static unsigned int sono_js_size = 0;
+#if CAIRO_HAS_RECORDING_SURFACE && (0)
+ cairo_t *lcr = NULL;
+#endif
if (chan_fft_in_progress(cp)) return;
si = cp->sonogram_data;
@@ -2501,16 +2624,17 @@ static void make_sonogram(chan_info *cp)
if ((si) && (si->scale > 0.0))
{
int i, slice, fwidth, fheight, j, bins;
- int rectw, recth;
+ int rectw, recth, cmap_size;
axis_info *fap;
mus_float_t xf, xfincr, yf, yfincr, frectw, frecth, xscl, scl = 1.0;
mus_float_t *hfdata;
int *hidata;
graphics_context *ax;
- mus_float_t minlx = 0.0, curlx = 0.0, lscale = 1.0;
+ mus_float_t minlx = 0.0, lscale = 1.0;
ax = copy_context(cp);
fap = cp->fft->axis;
+
fwidth = fap->x_axis_x1 - fap->x_axis_x0; /* these are the corners */
fheight = fap->y_axis_y0 - fap->y_axis_y1;
if ((fwidth == 0) || (fheight == 0)) return;
@@ -2538,13 +2662,30 @@ static void make_sonogram(chan_info *cp)
}
cp->fft_pix_ready = false;
}
+#else
+#if CAIRO_HAS_RECORDING_SURFACE && (0)
+ if (cp->fft_pix_ready)
+ {
+ if (cp->fft_pix)
+ cairo_surface_destroy(cp->fft_pix);
+ cp->fft_pix = NULL;
+ cp->fft_pix_ready = false;
+ }
+ if ((enved_dialog_is_active()) && /* or we want to see the sonogram as the enved background */
+ (enved_target(ss) == ENVED_SPECTRUM) &&
+ (enved_with_wave(ss)))
+ {
+ cp->fft_pix = cairo_recording_surface_create(CAIRO_CONTENT_COLOR, NULL);
+ lcr = cairo_create(cp->fft_pix);
+ }
+#endif
#endif
- if (sono_js_size != color_map_size(ss))
+ if (sono_js_size != (unsigned int)color_map_size(ss))
{
if (sono_js) free(sono_js);
- sono_js_size = color_map_size(ss);
- sono_js = (int *)calloc(sono_js_size, sizeof(int));
+ sono_js_size = (unsigned int)color_map_size(ss);
+ sono_js = (unsigned int *)calloc(sono_js_size, sizeof(unsigned int));
}
if (cp->printing) ps_allocate_grf_points();
allocate_sono_rects(si->total_bins);
@@ -2573,7 +2714,7 @@ static void make_sonogram(chan_info *cp)
log_range = (maxlx - minlx);
lscale = fap_range / log_range;
}
- yfincr = cp->spectrum_end * (mus_float_t)SND_SRATE(cp->sound) * 0.5 / (mus_float_t)bins;
+ yfincr = cp->spectrum_end * (mus_float_t)snd_srate(cp->sound) * 0.5 / (mus_float_t)bins;
}
else yfincr = 1.0;
@@ -2581,6 +2722,7 @@ static void make_sonogram(chan_info *cp)
{
for (yf = 0.0, i = 0; i <= bins; i++, yf += yfincr)
{
+ mus_float_t curlx;
if (yf > 1.0) curlx = log(yf); else curlx = 0.0;
hfdata[i] = fap->y0 + lscale * (curlx - minlx);
hidata[i] = local_grf_y(hfdata[i], fap);
@@ -2598,12 +2740,13 @@ static void make_sonogram(chan_info *cp)
xfincr = ((mus_float_t)fwidth / (mus_float_t)(si->target_slices));
xf = 2 + fap->x_axis_x0;
ss->stopped_explicitly = false;
+ cmap_size = color_map_size(ss) - 4;
for (slice = 0; slice < si->active_slices; slice++, xf += xfincr)
{
mus_float_t *fdata;
- memset((void *)sono_js, 0, color_map_size(ss) * sizeof(int));
+ memset((void *)sono_js, 0, color_map_size(ss) * sizeof(unsigned int));
fdata = si->data[slice];
for (i = 0; i < bins; i++)
@@ -2628,9 +2771,34 @@ static void make_sonogram(chan_info *cp)
}
}
- for (i = 0; i < color_map_size(ss); i++)
- if (sono_js[i] > 0)
- draw_sono_rectangles(ax, i, sono_js[i]);
+ i = 0;
+ while (i <= cmap_size)
+ {
+ if (sono_js[i] != 0) draw_sono_rectangles(ax, i, sono_js[i]);
+ i++;
+ if (sono_js[i] != 0) draw_sono_rectangles(ax, i, sono_js[i]);
+ i++;
+ if (sono_js[i] != 0) draw_sono_rectangles(ax, i, sono_js[i]);
+ i++;
+ if (sono_js[i] != 0) draw_sono_rectangles(ax, i, sono_js[i]);
+ i++;
+ }
+ for (; i < color_map_size(ss); i++)
+ if (sono_js[i] != 0) draw_sono_rectangles(ax, i, sono_js[i]);
+
+#if CAIRO_HAS_RECORDING_SURFACE && (0)
+ if ((cp->fft_pix) &&
+ (lcr))
+ {
+ cairo_t *old_cr;
+ old_cr = ss->cr;
+ ss->cr = lcr;
+ for (i = 0; i < color_map_size(ss); i++)
+ if (sono_js[i] != 0)
+ draw_sono_rectangles(ax, i, sono_js[i]);
+ ss->cr = old_cr;
+ }
+#endif
}
#if USE_MOTIF
@@ -2638,8 +2806,16 @@ static void make_sonogram(chan_info *cp)
if ((bins >= SAVE_FFT_SIZE) || /* transform size of twice that (8192) */
((enved_dialog_is_active()) && /* or we want to see the sonogram as the enved background */
(enved_target(ss) == ENVED_SPECTRUM) &&
- (enved_wave_p(ss))))
+ (enved_with_wave(ss))))
save_fft_pix(cp, ax, fwidth, fheight, fap->x_axis_x0, fap->y_axis_y1);
+#else
+#if CAIRO_HAS_RECORDING_SURFACE && (0)
+ if (cp->fft_pix)
+ {
+ cp->fft_pix_ready = true;
+ cairo_destroy(lcr);
+ }
+#endif
#endif
if (cp->printing) ps_reset_color();
@@ -2705,10 +2881,10 @@ void reset_spectro(void)
set_spectro_z_scale((with_gl(ss)) ? DEFAULT_SPECTRO_Z_SCALE : 0.1);
}
-#if HAVE_GL
- #include <GL/glu.h>
-#endif
+#if HAVE_GLU
+#include <GL/glu.h>
+#endif
static GLdouble unproject_to_x(int x, int y)
{
@@ -2774,6 +2950,7 @@ static void make_axes(chan_info *cp, axis_info *ap, x_axis_style_t x_style, bool
#define CLEAR_GRAPH true
#if HAVE_GL
+#if USE_MOTIF
static void set_up_for_gl(chan_info *cp)
{
glXMakeCurrent(MAIN_DISPLAY(ss), XtWindow(channel_graph(cp)), ss->cx);
@@ -2786,6 +2963,16 @@ static void gl_display(chan_info *cp)
glXSwapBuffers(MAIN_DISPLAY(ss), XtWindow(channel_graph(cp)));
else glFlush();
}
+#else
+static void set_up_for_gl(chan_info *cp)
+{
+ /* probably gdk_gl_context_make_current */
+}
+static void gl_display(chan_info *cp)
+{
+ glFlush();
+}
+#endif
#define GL_COLOR_SET(R, G, B) glColor3us(R, G, B)
@@ -2794,7 +2981,7 @@ static void gl_spectrogram(sono_info *si, int gl_fft_list, mus_float_t cutoff, b
rgb_t br, rgb_t bg, rgb_t bb)
{
mus_float_t lin_dB = 0.0;
- mus_float_t xincr, yincr, x0, y0, x1, y1;
+ mus_float_t xincr, yincr, y0, x1;
int bins = 0, slice, i, j;
float inv_scl;
int **js = NULL;
@@ -2828,6 +3015,7 @@ static void gl_spectrogram(sono_info *si, int gl_fft_list, mus_float_t cutoff, b
for (slice = 0; slice < si->active_slices - 1; slice++)
{
+ mus_float_t x0, y1;
x0 = x1;
x1 += xincr;
y1 = -0.5;
@@ -2906,10 +3094,12 @@ static bool make_gl_spectrogram(chan_info *cp)
bool need_relist = false;
rgb_t br = RGB_MAX, bg = RGB_MAX, bb = RGB_MAX;
+#if USE_MOTIF
Colormap cmap;
XColor tmp_color;
Display *dpy;
-
+#endif
+
si = cp->sonogram_data;
sp = cp->sound;
@@ -2946,6 +3136,7 @@ static bool make_gl_spectrogram(chan_info *cp)
glShadeModel(GL_SMOOTH);
glClearDepth(1.0);
+#if USE_MOTIF
/* get the background color */
dpy = XtDisplay(MAIN_SHELL(ss));
cmap = DefaultColormap(dpy, DefaultScreen(dpy));
@@ -2957,12 +3148,13 @@ static bool make_gl_spectrogram(chan_info *cp)
br = tmp_color.red;
bg = tmp_color.green;
bb = tmp_color.blue;
- glClearColor(RGB_TO_FLOAT(tmp_color.red),
- RGB_TO_FLOAT(tmp_color.green),
- RGB_TO_FLOAT(tmp_color.blue),
+ glClearColor(rgb_to_float(tmp_color.red),
+ rgb_to_float(tmp_color.green),
+ rgb_to_float(tmp_color.blue),
0.0);
glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
-
+#endif
+
if (need_relist)
gl_spectrogram(si, cp->gl_fft_list, cp->spectrum_end, cp->fft_log_magnitude, cp->min_dB, br, bg, bb);
@@ -2981,8 +3173,8 @@ static bool make_gl_spectrogram(chan_info *cp)
{
double frq0, frq1;
- frq0 = SND_SRATE(sp) * cp->spectrum_start / 2.0;
- frq1 = SND_SRATE(sp) * cp->spectrum_end / 2.0;
+ frq0 = snd_srate(sp) * cp->spectrum_start / 2.0;
+ frq1 = snd_srate(sp) * cp->spectrum_end / 2.0;
make_axis_info(cp,
cp->axis->x0, cp->axis->x1,
frq0, frq1,
@@ -3002,12 +3194,14 @@ static bool make_gl_spectrogram(chan_info *cp)
gl_display(cp);
/* a kludge to get the normal graph drawn (again...) */
- if (cp->graph_time_p)
+ if (cp->graph_time_on)
display_channel_time_data(cp);
- if (cp->graph_lisp_p)
+ if (cp->graph_lisp_on)
display_channel_lisp_data(cp);
-
+
+#if USE_MOTIF
return(XtAppPending(MAIN_APP(ss)) == 0); /* return true if there are no pending events to force current buffer to be displayed */
+#endif
}
#endif
/* HAVE_GL */
@@ -3021,22 +3215,20 @@ static bool make_spectrogram(chan_info *cp)
mus_float_t *fdata;
mus_float_t matrix[9];
mus_float_t xyz[3];
- mus_float_t xoff, yoff, x, y, xincr, yincr, x0, y0, binval, scl = 1.0;
+ mus_float_t xoff, yoff, xincr, yincr, x0, y0, binval, scl = 1.0;
mus_float_t fwidth, fheight, zscl, yval, xval;
int bins = 0, slice, i, j, xx = 0, yy = 0;
bool old_with_gl = false;
- snd_info *sp;
mus_float_t minlx = 0.0, lscale = 0.0, fap_incr = 0.0;
if (chan_fft_in_progress(cp)) return(false);
si = cp->sonogram_data;
if ((!si) || (si->scale <= 0.0)) return(false);
- sp = cp->sound;
#if HAVE_GL
- if (((sp->nchans == 1) ||
- (sp->channel_style == CHANNELS_SEPARATE)) &&
+ if (((cp->sound->nchans == 1) ||
+ (cp->sound->channel_style == CHANNELS_SEPARATE)) &&
(color_map(ss) != BLACK_AND_WHITE_COLORMAP) &&
(with_gl(ss)))
return(make_gl_spectrogram(cp));
@@ -3080,6 +3272,7 @@ static bool make_spectrogram(chan_info *cp)
slice < si->active_slices;
slice++, yoff += yincr)
{
+ mus_float_t x, y;
fdata = si->data[slice];
x = xoff;
y = yoff;
@@ -3176,23 +3369,26 @@ typedef struct wavogram_state {
static int make_wavogram(chan_info *cp)
{
snd_info *sp;
- mus_float_t xoff, x, y, x0, y0, xincr;
+ mus_float_t xoff, x0, y0, xincr;
mus_float_t width, height, zscl, yval, xval, binval;
- int i, j, points = 0, yincr, yoff, xx, yy;
+ int i, j, points = 0, yincr, yoff;
mus_float_t matrix[9];
mus_float_t xyz[3];
axis_info *ap;
graphics_context *ax;
snd_fd *sf = NULL;
wavogram_state *lw;
- bool need_new_list = true, need_redraw = true;
+#if USE_MOTIF
+ bool need_redraw = true;
+#endif
#if HAVE_GL || USE_MOTIF
bool use_gl = false;
+ bool need_new_list = true;
#endif
sp = cp->sound;
ap = cp->axis;
- if (sp) ap->losamp = (mus_long_t)(ap->x0 * SND_SRATE(sp));
+ if (sp) ap->losamp = (mus_long_t)(ap->x0 * snd_srate(sp));
#if HAVE_GL
if (((sp->nchans == 1) || (sp->channel_style == CHANNELS_SEPARATE)) &&
@@ -3204,6 +3400,7 @@ static int make_wavogram(chan_info *cp)
lw = cp->last_wavogram;
if (lw)
{
+#if HAVE_GL || USE_MOTIF
need_new_list = (!((lw->hop == wavo_hop(ss)) &&
(lw->trace == wavo_trace(ss)) &&
(lw->losamp == ap->losamp) &&
@@ -3216,6 +3413,7 @@ static int make_wavogram(chan_info *cp)
(lw->inverted == color_inverted(ss)) &&
(lw->scale == color_scale(ss)) &&
(lw->cutoff == color_cutoff(ss))));
+#endif
#if HAVE_GL
if (use_gl)
{
@@ -3223,12 +3421,14 @@ static int make_wavogram(chan_info *cp)
need_new_list = true;
}
#endif
+#if USE_MOTIF
need_redraw = (!((lw->x_scale == spectro_x_scale(ss)) &&
(lw->y_scale == spectro_y_scale(ss)) &&
(lw->z_scale == spectro_z_scale(ss)) &&
(lw->x_angle == spectro_x_angle(ss)) &&
(lw->y_angle == spectro_y_angle(ss)) &&
(lw->z_angle == spectro_z_angle(ss))));
+#endif
}
#if USE_MOTIF
@@ -3266,11 +3466,10 @@ static int make_wavogram(chan_info *cp)
{
mus_float_t **samps = NULL;
int **js = NULL;
- float x0, x1, y0, y1, x5inc, y5inc;
+ float x0, x1, y0, y1; /* x5inc, y5inc; */
mus_float_t xinc, yinc;
- rgb_t *rs = NULL, *gs = NULL, *bs = NULL;
- /* each line is wavo_trace samps, there are (height / wave_hop) of these? */
int lines = 0, len = 0;
+ rgb_t *rs = NULL;
if (need_new_list)
{
@@ -3329,8 +3528,8 @@ static int make_wavogram(chan_info *cp)
xinc = 2.0 / (mus_float_t)len;
yinc = 2.0 / (mus_float_t)lines;
- x5inc = 1.25 * xinc;
- y5inc = 1.25 * yinc;
+ /* x5inc = 1.25 * xinc; */
+ /* y5inc = 1.25 * yinc; */
rs = color_map_reds(color_map(ss));
@@ -3339,7 +3538,9 @@ static int make_wavogram(chan_info *cp)
if (rs)
{
int len1, lines1;
- mus_float_t xf, yf;
+ mus_float_t xf;
+ rgb_t *gs, *bs;
+ /* each line is wavo_trace samps, there are (height / wave_hop) of these? */
gs = color_map_greens(color_map(ss));
bs = color_map_blues(color_map(ss));
@@ -3349,6 +3550,7 @@ static int make_wavogram(chan_info *cp)
for (j = 0; j < lines1; j++)
{
+ mus_float_t yf;
x1 = -1.0;
y0 = y1;
y1 += yinc;
@@ -3438,7 +3640,7 @@ static int make_wavogram(chan_info *cp)
if (sf == NULL) return(0);
/* set up the graph width and so on */
- make_axes_1(ap, cp->x_axis_style, SND_SRATE(sp), SHOW_NO_AXES, NOT_PRINTING, NO_X_AXIS, NO_GRID, WITH_LINEAR_AXES, 1.0);
+ make_axes_1(ap, cp->x_axis_style, snd_srate(sp), SHOW_NO_AXES, NOT_PRINTING, NO_X_AXIS, NO_GRID, WITH_LINEAR_AXES, 1.0);
erase_rectangle(cp, ap->ax, ap->graph_x0, ap->y_offset, ap->width, ap->height);
if (cp->printing) ps_allocate_grf_points();
@@ -3467,6 +3669,7 @@ static int make_wavogram(chan_info *cp)
yoff > ap->y_axis_y1;
yoff += yincr)
{
+ mus_float_t x, y, xx, yy;
xx = -1;
yy = (int)y0; /* ? */
x = xoff;
@@ -3557,7 +3760,7 @@ void free_lisp_info(chan_info *cp)
}
-static void make_lisp_graph(chan_info *cp, XEN pixel_list)
+static void make_lisp_graph(chan_info *cp, Xen pixel_list)
{
snd_info *sp;
lisp_grf *up;
@@ -3581,7 +3784,7 @@ static void make_lisp_graph(chan_info *cp, XEN pixel_list)
if (up->env_data)
{
- int x0, x1, y0, y1;
+ int x0, y0;
int grf_len;
grf_len = up->len[0];
x0 = local_grf_x(up->data[0][0], uap);
@@ -3591,6 +3794,7 @@ static void make_lisp_graph(chan_info *cp, XEN pixel_list)
for (i = 2; i < grf_len; i += 2)
{
+ int x1, y1;
x1 = local_grf_x(up->data[0][i], uap);
y1 = local_grf_y(up->data[0][i + 1], uap);
draw_line(ax, x0, y0, x1, y1);
@@ -3604,16 +3808,17 @@ static void make_lisp_graph(chan_info *cp, XEN pixel_list)
{
int j, graph, pixel_len = -1;
color_t old_color = 0;
- mus_float_t x, y, samples_per_pixel = 1.0;
- if (XEN_LIST_P(pixel_list))
- pixel_len = XEN_LIST_LENGTH(pixel_list);
+ mus_float_t x, y;
+ if (Xen_is_list(pixel_list))
+ pixel_len = Xen_list_length(pixel_list);
if (up->graphs > 1)
old_color = get_foreground_color(ax);
for (graph = 0; graph < up->graphs; graph++)
{
+ mus_float_t samples_per_pixel;
if ((pixel_len <= graph) ||
- (!foreground_color_ok(XEN_LIST_REF(pixel_list, graph), ax)))
+ (!foreground_color_ok(Xen_list_ref(pixel_list, graph), ax)))
{
switch (graph)
{
@@ -3722,14 +3927,10 @@ static void make_axes(chan_info *cp, axis_info *ap, x_axis_style_t x_style, bool
make_axes_1(ap,
x_style,
- SND_SRATE(sp),
+ snd_srate(sp),
axes,
cp->printing,
- (((sp->channel_style != CHANNELS_COMBINED) ||
- (cp->show_axes == SHOW_ALL_AXES) ||
- (cp->show_axes == SHOW_ALL_AXES_UNLABELLED) ||
- (cp->show_axes == SHOW_BARE_X_AXIS) ||
- (cp->chan == (sp->nchans - 1))) ? WITH_X_AXIS : NO_X_AXIS),
+ (cp->show_axes != SHOW_NO_AXES) ? WITH_X_AXIS : NO_X_AXIS, /* C++ wants the with_x_axis_t result */
grid,
log_axes,
cp->grid_density);
@@ -3741,8 +3942,8 @@ static void make_axes(chan_info *cp, axis_info *ap, x_axis_style_t x_style, bool
static void draw_sonogram_cursor(chan_info *cp);
static void draw_graph_cursor(chan_info *cp);
-static void show_inset_graph(chan_info *cp, graphics_context *ax);
static void show_smpte_label(chan_info *cp, graphics_context *ax);
+static void show_inset_graph(chan_info *cp, graphics_context *cur_ax);
static void display_channel_data_with_size(chan_info *cp,
@@ -3765,19 +3966,19 @@ static void display_channel_data_with_size(chan_info *cp,
/* -------- graph-hook -------- */
if ((cp->hookable == WITH_HOOK) &&
(!(ss->graph_hook_active)) &&
- (XEN_HOOKED(graph_hook)))
+ (Xen_hook_has_list(graph_hook)))
{
- XEN res = XEN_FALSE;
+ Xen res;
ss->graph_hook_active = true;
res = run_progn_hook(graph_hook,
- XEN_LIST_4(C_INT_TO_XEN_SOUND(sp->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_DOUBLE(cp->axis->y0),
- C_TO_XEN_DOUBLE(cp->axis->y1)),
+ Xen_list_4(C_int_to_Xen_sound(sp->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_double_to_Xen_real(cp->axis->y0),
+ C_double_to_Xen_real(cp->axis->y1)),
S_graph_hook);
- /* (add-hook! graph-hook (lambda (a b c d) (snd-print (format #f "~A ~A ~A ~A" a b c d)))) */
+ /* (hook-push graph-hook (lambda (a b c d) (snd-print (format #f "~A ~A ~A ~A" a b c d)))) */
ss->graph_hook_active = false;
- if (XEN_TRUE_P(res)) return;
+ if (Xen_is_true(res)) return;
}
ap = cp->axis;
@@ -3788,12 +3989,12 @@ static void display_channel_data_with_size(chan_info *cp,
ap->window_width = width;
ap->width = width;
ap->y_offset = offset;
- if (cp->graph_time_p)
+ if (cp->graph_time_on)
{
displays++;
with_time = true;
}
- grflsp = ((cp->graph_lisp_p) || (XEN_HOOKED(lisp_graph_hook)));
+ grflsp = ((cp->graph_lisp_on) || (Xen_hook_has_list(lisp_graph_hook)));
if (grflsp)
{
displays++;
@@ -3820,7 +4021,7 @@ static void display_channel_data_with_size(chan_info *cp,
}
}
- if (cp->graph_transform_p)
+ if (cp->graph_transform_on)
{
fft_info *fp;
displays++;
@@ -3896,8 +4097,14 @@ static void display_channel_data_with_size(chan_info *cp,
#if USE_GTK
our_ax = copy_context(cp);
+ if ((!our_ax->w) || (!our_ax->wn))
+ {
+ /* how can this happen? */
+ our_ax->w = channel_to_widget(cp);
+ our_ax->wn = WIDGET_TO_WINDOW(our_ax->w);
+ }
if (!use_incoming_cr)
- ss->cr = MAKE_CAIRO(our_ax->wn);
+ ss->cr = make_cairo(our_ax->wn);
cairo_push_group(ss->cr);
#else
our_ax = ap->ax;
@@ -3908,8 +4115,8 @@ static void display_channel_data_with_size(chan_info *cp,
if (ap->y_axis_y0 == ap->y_axis_y1)
make_axes(cp, ap, cp->x_axis_style, DONT_CLEAR_GRAPH, cp->show_grid, WITH_LINEAR_AXES, cp->show_axes); /* first time needs setup */
ap->y0 = ap->x0;
- ap->y1 = ap->y0 + (mus_float_t)(cp->wavo_trace * (ap->y_axis_y0 - ap->y_axis_y1)) / ((mus_float_t)(cp->wavo_hop) * SND_SRATE(sp));
- ap->x1 = ap->x0 + (double)(cp->wavo_trace) / (double)SND_SRATE(sp);
+ ap->y1 = ap->y0 + (mus_float_t)(cp->wavo_trace * (ap->y_axis_y0 - ap->y_axis_y1)) / ((mus_float_t)(cp->wavo_hop) * snd_srate(sp));
+ ap->x1 = ap->x0 + (double)(cp->wavo_trace) / (double)snd_srate(sp);
points = make_wavogram(cp);
}
else
@@ -3958,11 +4165,28 @@ static void display_channel_data_with_size(chan_info *cp,
display_channel_id(cp, our_ax, height + offset, sp->nchans);
#if USE_GTK
+ /* here in gtk3 we can get:
+ * cairo-surface.c:385: _cairo_surface_begin_modification: Assertion `! surface->finished' failed.
+ * followed by a segfault.
+ *
+ * But I've followed this thing in detail, and nothing unusual is happening.
+ * If I check the surface status via
+ * {
+ * cairo_surface_t *surface;
+ * surface = cairo_get_target(ss->cr);
+ * fprintf(stderr, "status: %d ", cairo_surface_status(surface));
+ * }
+ * if prints 0 (success), and then dies! I can't trace it in gdb because the goddamn gtk idle
+ * mechanism gets confused. I can't ask cairo if the surface is finished. valgrind is happy.
+ * cairo-trace shows nothing unusual. cairo 1.8.0 is happy.
+ * I am stuck.
+ */
+
cairo_pop_group_to_source(ss->cr);
cairo_paint(ss->cr);
if (!use_incoming_cr)
{
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
}
#endif
@@ -3986,7 +4210,7 @@ static void display_channel_data_with_size(chan_info *cp,
{
#if USE_GTK
if (!use_incoming_cr)
- ss->cr = MAKE_CAIRO(cp->ax->wn);
+ ss->cr = make_cairo(cp->ax->wn);
cairo_push_group(ss->cr);
#endif
@@ -4007,8 +4231,8 @@ static void display_channel_data_with_size(chan_info *cp,
if ((!with_time) || (just_fft))
{ /* make_graph does this -- sets losamp needed by fft to find its starting point */
- ap->losamp = (mus_long_t)(ap->x0 * (double)SND_SRATE(sp));
- ap->hisamp = (mus_long_t)(ap->x1 * (double)SND_SRATE(sp));
+ ap->losamp = (mus_long_t)(ap->x0 * (double)snd_srate(sp));
+ ap->hisamp = (mus_long_t)(ap->x1 * (double)snd_srate(sp));
}
switch (cp->transform_graph_type)
@@ -4042,7 +4266,7 @@ static void display_channel_data_with_size(chan_info *cp,
cairo_paint(ss->cr);
if (!use_incoming_cr)
{
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
}
#endif
@@ -4064,24 +4288,24 @@ static void display_channel_data_with_size(chan_info *cp,
(!just_fft) && (!just_time))
{
int pixel_loc = -1;
- XEN pixel_list = XEN_FALSE;
+ Xen pixel_list = Xen_false;
if ((just_lisp) || ((!with_time) && (!(with_fft))))
{
- ap->losamp = (mus_long_t)(ap->x0 * (double)SND_SRATE(sp));
- ap->hisamp = (mus_long_t)(ap->x1 * (double)SND_SRATE(sp));
+ ap->losamp = (mus_long_t)(ap->x0 * (double)snd_srate(sp));
+ ap->hisamp = (mus_long_t)(ap->x1 * (double)snd_srate(sp));
}
if ((cp->hookable == WITH_HOOK) &&
(!(ss->lisp_graph_hook_active)) &&
- (XEN_HOOKED(lisp_graph_hook)))
+ (Xen_hook_has_list(lisp_graph_hook)))
{
ss->lisp_graph_hook_active = true;
/* inadvertent recursive call here can hang entire computer */
pixel_list = run_progn_hook(lisp_graph_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan)),
+ Xen_list_2(C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan)),
S_lisp_graph_hook);
ss->lisp_graph_hook_active = false;
- if (!(XEN_FALSE_P(pixel_list))) pixel_loc = snd_protect(pixel_list);
+ if (!(Xen_is_false(pixel_list))) pixel_loc = snd_protect(pixel_list);
}
if (up != cp->lisp_info)
@@ -4094,7 +4318,7 @@ static void display_channel_data_with_size(chan_info *cp,
if (!(uap->ax))
uap->ax = cp->ax;
if (!use_incoming_cr)
- ss->cr = MAKE_CAIRO(uap->ax->wn);
+ ss->cr = make_cairo(uap->ax->wn);
cairo_push_group(ss->cr);
#endif
make_axes(cp, uap, /* defined in this file l 2293 */
@@ -4104,7 +4328,7 @@ static void display_channel_data_with_size(chan_info *cp,
WITH_LINEAR_AXES,
up->show_axes);
- if (!(XEN_PROCEDURE_P(pixel_list)))
+ if (!(Xen_is_procedure(pixel_list)))
make_lisp_graph(cp, pixel_list); /* this uses the cairo_t set up above, but possible pixel_list proc does not */
#if USE_GTK
@@ -4112,21 +4336,21 @@ static void display_channel_data_with_size(chan_info *cp,
cairo_paint(ss->cr);
if (!use_incoming_cr)
{
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
}
#endif
- if (XEN_PROCEDURE_P(pixel_list))
- XEN_CALL_0(pixel_list, S_lisp_graph);
+ if (Xen_is_procedure(pixel_list))
+ Xen_call_with_no_args(pixel_list, S_lisp_graph);
- if (!(XEN_FALSE_P(pixel_list))) snd_unprotect_at(pixel_loc);
+ if (!(Xen_is_false(pixel_list))) snd_unprotect_at(pixel_loc);
if ((cp->hookable == WITH_HOOK) &&
- (XEN_HOOKED(after_lisp_graph_hook)))
+ (Xen_hook_has_list(after_lisp_graph_hook)))
run_hook(after_lisp_graph_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan)),
+ Xen_list_2(C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan)),
S_after_lisp_graph_hook);
}
@@ -4175,7 +4399,6 @@ static void display_channel_data_1(chan_info *cp, bool just_fft, bool just_lisp,
{
int offset, full_height, y0, y1, bottom, top;
mus_float_t val, size, chan_height;
- axis_info *ap;
/* CHANNELS_COMBINED case */
val = gsy_value(sp->chans[0]);
@@ -4211,6 +4434,7 @@ static void display_channel_data_1(chan_info *cp, bool just_fft, bool just_lisp,
display_channel_data_with_size(cp, width, (int)chan_height, offset, just_fft, just_lisp, just_time, use_incoming_cr);
else
{
+ axis_info *ap;
ap = cp->axis;
ap->y_offset = offset; /* needed for mouse click channel determination */
}
@@ -4257,27 +4481,6 @@ static void erase_cursor(chan_info *cp)
#if USE_MOTIF
draw_cursor(cp);
#endif
-#if USE_GTK
- {
- color_t old_cursor_color;
- int ccy;
- old_cursor_color = ss->cursor_color;
- cp->cursor_size++;
- ss->cursor_color = cp->ax->gc->bg_color;
- draw_cursor(cp);
- ss->cursor_color = old_cursor_color;
- cp->cursor_size--;
- /* we draw at (cp->cx, cp->cy), so presumably... */
- if (cp->just_zero)
- ccy = cp->old_cy;
- else ccy = cp->cy;
- /* make_partial_graph doesn't quite do the right thing here. We may have to
- * save the actual points around the cursor and redraw them by hand.
- */
- draw_dot(cp->ax, cp->cx + 0.5, ccy + 0.5, 1);
- /* this isn't perfect (it slightly erases any lines it contacts), but it's ok */
- }
-#endif
}
@@ -4286,8 +4489,8 @@ static void draw_graph_cursor(chan_info *cp)
axis_info *ap;
ap = cp->axis;
- if ((CURSOR(cp) < ap->losamp) ||
- (CURSOR(cp) > ap->hisamp) ||
+ if ((cursor_sample(cp) < ap->losamp) ||
+ (cursor_sample(cp) > ap->hisamp) ||
(!(ap->ax)))
return;
@@ -4297,25 +4500,25 @@ static void draw_graph_cursor(chan_info *cp)
#if USE_GTK
if (!(ap->ax->wn)) return;
- ss->cr = MAKE_CAIRO(ap->ax->wn);
+ ss->cr = make_cairo(ap->ax->wn);
#endif
if (cp->cursor_visible)
erase_cursor(cp);
- cp->cx = local_grf_x((double)(CURSOR(cp)) / (double)SND_SRATE(cp->sound), ap); /* not float -- this matters in very long files (i.e. > 40 minutes) */
+ cp->cx = local_grf_x((double)(cursor_sample(cp)) / (double)snd_srate(cp->sound), ap); /* not float -- this matters in very long files (i.e. > 40 minutes) */
if (cp->just_zero)
{
cp->cy = local_grf_y(0.0, ap);
- cp->old_cy = local_grf_y(chn_sample(CURSOR(cp), cp, cp->edit_ctr), ap);
+ /* cp->old_cy = local_grf_y(chn_sample(cursor_sample(cp), cp, cp->edit_ctr), ap); */
}
- else cp->cy = local_grf_y(chn_sample(CURSOR(cp), cp, cp->edit_ctr), ap);
+ else cp->cy = local_grf_y(chn_sample(cursor_sample(cp), cp, cp->edit_ctr), ap);
draw_cursor(cp);
cp->cursor_visible = true;
#if USE_GTK
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
#endif
}
@@ -4336,14 +4539,14 @@ static void draw_sonogram_cursor_1(chan_info *cp)
{
color_t old_color;
fax = cp->ax; /* fap->ax does not work here?!? */
- ss->cr = MAKE_CAIRO(fax->wn);
+ ss->cr = make_cairo(fax->wn);
/* y_axis_y0 > y_axis_y1 (upside down coordinates) */
old_color = get_foreground_color(fax);
set_foreground_color(fax, ss->cursor_color);
draw_line(fax, cp->fft_cx, fap->y_axis_y0 - 1, cp->fft_cx, fap->y_axis_y1);
set_foreground_color(fax, old_color);
cp->fft_cursor_visible = (!(cp->fft_cursor_visible));
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
}
#endif
@@ -4352,14 +4555,14 @@ static void draw_sonogram_cursor_1(chan_info *cp)
static void draw_sonogram_cursor(chan_info *cp)
{
- if ((cp->graph_transform_p) &&
+ if ((cp->graph_transform_on) &&
(cp->show_sonogram_cursor) &&
(cp->fft) &&
(cp->fft->axis) &&
(cp->transform_graph_type == GRAPH_AS_SONOGRAM))
{
if (cp->fft_cursor_visible) draw_sonogram_cursor_1(cp);
- cp->fft_cx = local_grf_x((double)(CURSOR(cp)) / (double)SND_SRATE(cp->sound), cp->fft->axis);
+ cp->fft_cx = local_grf_x((double)(cursor_sample(cp)) / (double)snd_srate(cp->sound), cp->fft->axis);
draw_sonogram_cursor_1(cp);
cp->fft_cursor_visible = true;
}
@@ -4369,12 +4572,12 @@ static void draw_sonogram_cursor(chan_info *cp)
kbd_cursor_t cursor_decision(chan_info *cp)
{
mus_long_t len;
- len = CURRENT_SAMPLES(cp);
- if (CURSOR(cp) >= len) CURSOR(cp) = len - 1; /* zero based, but in 0-length files, len = 0 */
- if (CURSOR(cp) < 0) CURSOR(cp) = 0; /* perhaps the cursor should be forced off in empty files? */
- if (CURSOR(cp) < cp->axis->losamp)
+ len = current_samples(cp);
+ if (cursor_sample(cp) >= len) cursor_sample(cp) = len - 1; /* zero based, but in 0-length files, len = 0 */
+ if (cursor_sample(cp) < 0) cursor_sample(cp) = 0; /* perhaps the cursor should be forced off in empty files? */
+ if (cursor_sample(cp) < cp->axis->losamp)
{
- if (CURSOR(cp) == 0) return(CURSOR_ON_LEFT);
+ if (cursor_sample(cp) == 0) return(CURSOR_ON_LEFT);
else
{
if (cp->sound->playing)
@@ -4382,9 +4585,9 @@ kbd_cursor_t cursor_decision(chan_info *cp)
return(CURSOR_IN_MIDDLE);
}
}
- if (CURSOR(cp) > cp->axis->hisamp)
+ if (cursor_sample(cp) > cp->axis->hisamp)
{
- if (CURSOR(cp) >= (len - 1)) return(CURSOR_ON_RIGHT);
+ if (cursor_sample(cp) >= (len - 1)) return(CURSOR_ON_RIGHT);
else
{
if (cp->sound->playing)
@@ -4403,12 +4606,11 @@ void handle_cursor(chan_info *cp, kbd_cursor_t redisplay)
if (redisplay != KEYBOARD_NO_ACTION)
{
snd_info *sp;
+
sp = cp->sound;
- if (cp->verbose_cursor)
- {
- show_cursor_info(cp);
- sp->minibuffer_on = MINI_CURSOR;
- }
+ if (cp->with_verbose_cursor)
+ show_cursor_info(cp);
+
if (redisplay != CURSOR_IN_VIEW)
{
double gx = 0.0;
@@ -4417,15 +4619,15 @@ void handle_cursor(chan_info *cp, kbd_cursor_t redisplay)
switch (redisplay)
{
case CURSOR_ON_LEFT:
- gx = (double)(CURSOR(cp)) / (double)SND_SRATE(sp);
+ gx = (double)(cursor_sample(cp)) / (double)snd_srate(sp);
break;
case CURSOR_ON_RIGHT:
- gx = (double)(CURSOR(cp)) / (double)SND_SRATE(sp) - ap->zx * ap->x_ambit;
+ gx = (double)(cursor_sample(cp)) / (double)snd_srate(sp) - ap->zx * ap->x_ambit;
break;
case CURSOR_IN_MIDDLE:
- gx = (double)(CURSOR(cp)) / (double)SND_SRATE(sp) - ap->zx * 0.5 * ap->x_ambit;
+ gx = (double)(cursor_sample(cp)) / (double)snd_srate(sp) - ap->zx * 0.5 * ap->x_ambit;
break;
default:
@@ -4439,8 +4641,15 @@ void handle_cursor(chan_info *cp, kbd_cursor_t redisplay)
{
if (cp->cursor_on)
{
+#if USE_MOTIF
draw_graph_cursor(cp);
draw_sonogram_cursor(cp);
+ if (!(sp->playing))
+ update_graph(cp);
+#endif
+#if USE_GTK
+ update_graph(cp);
+#endif
}
}
}
@@ -4449,9 +4658,9 @@ void handle_cursor(chan_info *cp, kbd_cursor_t redisplay)
int i;
for (i = 0; i < cp->edit_size; i++)
if (cp->edits[i])
- cp->edits[i]->cursor = CURSOR(cp);
+ cp->edits[i]->cursor = cursor_sample(cp);
}
- update_possible_selection_in_progress(CURSOR(cp));
+ update_possible_selection_in_progress(cursor_sample(cp));
}
@@ -4485,14 +4694,14 @@ void cursor_moveto(chan_info *cp, mus_long_t samp)
{
chan_info *ncp;
ncp = si->cps[i];
- CURSOR(ncp) = samp;
+ cursor_sample(ncp) = samp;
handle_cursor(ncp, cursor_decision(ncp)); /* checks len */
}
si = free_sync_info(si);
}
else
{
- CURSOR(cp) = samp;
+ cursor_sample(cp) = samp;
handle_cursor(cp, cursor_decision(cp));
}
}
@@ -4500,7 +4709,7 @@ void cursor_moveto(chan_info *cp, mus_long_t samp)
void cursor_move(chan_info *cp, mus_long_t samps)
{
- cursor_moveto(cp, CURSOR(cp) + samps);
+ cursor_moveto(cp, cursor_sample(cp) + samps);
}
@@ -4508,12 +4717,12 @@ void cursor_moveto_without_verbosity(chan_info *cp, mus_long_t samp)
{
bool old_verbose;
int old_sync;
- old_verbose = cp->verbose_cursor;
+ old_verbose = cp->with_verbose_cursor;
old_sync = cp->sound->sync;
- cp->verbose_cursor = false;
+ cp->with_verbose_cursor = false;
cp->sound->sync = 0;
cursor_moveto(cp, samp);
- cp->verbose_cursor = old_verbose;
+ cp->with_verbose_cursor = old_verbose;
cp->sound->sync = old_sync;
}
@@ -4530,14 +4739,14 @@ void cursor_moveto_with_window(chan_info *cp, mus_long_t samp, mus_long_t left_s
ap = cp->axis;
if (cp->cursor_visible)
{
- if (cp->graph_time_p)
+ if (cp->graph_time_on)
{
#if USE_GTK
- ss->cr = MAKE_CAIRO(ap->ax->wn);
+ ss->cr = make_cairo(ap->ax->wn);
#endif
erase_cursor(cp);
#if USE_GTK
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
#endif
}
@@ -4545,15 +4754,15 @@ void cursor_moveto_with_window(chan_info *cp, mus_long_t samp, mus_long_t left_s
}
if (cp->fft_cursor_visible)
{
- if ((cp->fft) && (cp->graph_transform_p)) draw_sonogram_cursor_1(cp);
+ if ((cp->fft) && (cp->graph_transform_on)) draw_sonogram_cursor_1(cp);
cp->fft_cursor_visible = false; /* don't redraw at old location */
}
- CURSOR(cp) = samp;
+ cursor_sample(cp) = samp;
current_window_size = ap->hisamp - ap->losamp;
if (snd_abs_mus_long_t(current_window_size - window_size) < (mus_long_t)(0.1 * (double)window_size))
- gx = (double)(left_samp) / (double)SND_SRATE(sp);
- else gx = (double)(samp) / (double)SND_SRATE(sp) - ap->zx * 0.5 * ap->x_ambit;
+ gx = (double)(left_samp) / (double)snd_srate(sp);
+ else gx = (double)(samp) / (double)snd_srate(sp) - ap->zx * 0.5 * ap->x_ambit;
if (gx < 0.0) gx = 0.0;
if (ap->x_ambit != 0.0)
reset_x_display(cp, (gx - ap->xmin) / ap->x_ambit, ap->zx);
@@ -4570,10 +4779,10 @@ void sync_cursors(chan_info *cp, mus_long_t samp)
sync_info *si;
si = snd_sync(sp->sync);
for (i = 0; i < si->chans; i++)
- CURSOR(si->cps[i]) = samp;
+ cursor_sample(si->cps[i]) = samp;
si = free_sync_info(si);
}
- else CURSOR(cp) = samp;
+ else cursor_sample(cp) = samp;
}
@@ -4590,7 +4799,7 @@ void show_cursor_info(chan_info *cp)
sp = cp->sound;
if ((sp->sync != 0) && (cp->chan != 0)) return;
- samp = CURSOR(cp);
+ samp = cursor_sample(cp);
y = chn_sample(samp, cp, cp->edit_ctr);
absy = fabs(y);
if (absy < .0001) digits = 5;
@@ -4601,24 +4810,24 @@ void show_cursor_info(chan_info *cp)
expr_str = (char *)calloc(len, sizeof(char));
if (sp->nchans == 1)
- mus_snprintf(expr_str, PRINT_BUFFER_SIZE, "cursor at %s (sample " MUS_LD ") = %s",
- s1 = x_axis_location_to_string(cp, (double)samp / (double)SND_SRATE(sp)),
+ snprintf(expr_str, PRINT_BUFFER_SIZE, "cursor at %s (sample %lld) = %s",
+ s1 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(sp)),
samp,
s2 = prettyf(y, digits));
else
{
if (sp->sync == 0)
- mus_snprintf(expr_str, PRINT_BUFFER_SIZE, "chan %d, cursor at %s (sample " MUS_LD ") = %s",
+ snprintf(expr_str, PRINT_BUFFER_SIZE, "chan %d, cursor at %s (sample %lld) = %s",
cp->chan + 1,
- s1 = x_axis_location_to_string(cp, (double)samp / (double)SND_SRATE(sp)),
+ s1 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(sp)),
samp,
s2 = prettyf(y, digits));
else
{
/* in this case, assume we show all on chan 0 and ignore the call otherwise (see above) */
/* "cursor at..." then list of values */
- mus_snprintf(expr_str, PRINT_BUFFER_SIZE, "cursor at %s (sample " MUS_LD "): %s",
- s1 = x_axis_location_to_string(cp, (double)samp / (double)SND_SRATE(sp)),
+ snprintf(expr_str, PRINT_BUFFER_SIZE, "cursor at %s (sample %lld): %s",
+ s1 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(sp)),
samp,
s2 = prettyf(y, digits));
for (i = 1; i < sp->nchans; i++)
@@ -4630,20 +4839,16 @@ void show_cursor_info(chan_info *cp)
ncp = sp->chans[i];
y = chn_sample(samp, ncp, ncp->edit_ctr);
absy = fabs(y);
- if (absy < .0001)
- digits = 4;
- else
- {
- if (absy < .001)
- digits = 3;
- else digits = 2;
- }
+ if (absy < .0001) digits = 5;
+ else if (absy<.01) digits = 4;
+ else if (absy<1.0) digits = 3;
+ else digits = 2;
s2 = prettyf(y, digits);
expr_str = mus_strcat(expr_str, s2, &len);
}
}
}
- string_to_minibuffer(sp, expr_str);
+ set_status(sp, expr_str, false);
free(expr_str);
free(s1);
free(s2);
@@ -4675,13 +4880,13 @@ static bool hit_cursor_triangle(chan_info *cp, int x, int y)
int cx;
ap = cp->axis;
- samp = CURSOR(cp);
+ samp = cursor_sample(cp);
if ((samp < ap->losamp) ||
(samp > ap->hisamp))
return(false);
- cx = grf_x((double)samp / (double)SND_SRATE(cp->sound), ap);
+ cx = grf_x((double)samp / (double)snd_srate(cp->sound), ap);
if ((cx > (x + HIT_SLOP)) ||
((cx + play_arrow_size(ss) + HIT_SLOP) < x))
return(false);
@@ -4731,7 +4936,7 @@ static click_loc_t within_graph(chan_info *cp, int x, int y)
y0 = y - SLOPPY_MOUSE;
y1 = y + SLOPPY_MOUSE;
- if (cp->graph_time_p)
+ if (cp->graph_time_on)
{
ap = cp->axis;
/* does (x, y) fall within the current axis bounds x_axis_x0|x1, y_axis_y0|y1 */
@@ -4768,7 +4973,7 @@ static click_loc_t within_graph(chan_info *cp, int x, int y)
{
mus_long_t bpos, epos, xpos;
double sr;
- sr = (double)SND_SRATE(cp->sound);
+ sr = (double)snd_srate(cp->sound);
bpos = selection_beg(cp);
epos = selection_end(cp);
@@ -4825,8 +5030,8 @@ static click_loc_t within_graph(chan_info *cp, int x, int y)
return(CLICK_CURSOR_PLAY);
}
- if (((cp->graph_lisp_p) ||
- (XEN_HOOKED(lisp_graph_hook))) &&
+ if (((cp->graph_lisp_on) ||
+ (Xen_hook_has_list(lisp_graph_hook))) &&
(cp->lisp_info))
{
ap = cp->lisp_info->axis;
@@ -4835,7 +5040,7 @@ static click_loc_t within_graph(chan_info *cp, int x, int y)
return(CLICK_LISP);
}
- if ((cp->graph_transform_p) && (cp->fft))
+ if ((cp->graph_transform_on) && (cp->fft))
{
ap = cp->fft->axis;
if (!ap) return(CLICK_NOGRAPH); /* apparently can happen if fft is being redrawn when we click */
@@ -4891,8 +5096,6 @@ void check_cursor_shape(chan_info *cp, int x, int y)
case CLICK_SELECTION_RIGHT:
case CLICK_MIX:
case CLICK_MARK:
- case CLICK_FFT_AXIS:
- /* these all involve a drag if the mouse is pressed */
if (cp->current_cursor != ss->bounds_cursor)
{
cp->current_cursor = ss->bounds_cursor;
@@ -4900,12 +5103,45 @@ void check_cursor_shape(chan_info *cp, int x, int y)
}
break;
+ case CLICK_FFT_AXIS:
+ /* these all involve a drag if the mouse is pressed
+ * but for fft axis, if sonogram, we want an up-and-down arrow, not left-to-right
+ */
+ if (cp->transform_graph_type != GRAPH_AS_SONOGRAM)
+ {
+ if (cp->current_cursor != ss->bounds_cursor)
+ {
+ cp->current_cursor = ss->bounds_cursor;
+ GUI_SET_CURSOR(channel_graph(cp), ss->bounds_cursor);
+ }
+ }
+ else
+ {
+ if (cp->current_cursor != ss->yaxis_cursor)
+ {
+ cp->current_cursor = ss->yaxis_cursor;
+ GUI_SET_CURSOR(channel_graph(cp), ss->yaxis_cursor);
+ }
+ }
+ break;
+
case CLICK_MIX_PLAY:
case CLICK_SELECTION_PLAY:
case CLICK_CURSOR_PLAY:
case CLICK_MARK_PLAY:
- if (cp->current_cursor != ss->play_cursor)
- {
+ if (!(cp->sound->playing) && (cp->current_cursor != ss->play_cursor))
+ {
+ snd_info *sp;
+ sp = cp->sound;
+ if (sp->sync != 0)
+ {
+ int i;
+ sync_info *si;
+ si = snd_sync(sp->sync);
+ for (i = 0; i < si->chans; i++)
+ si->cps[i]->original_cursor = cursor_sample(ncp);
+ }
+ else ncp->original_cursor = cursor_sample(ncp);
cp->current_cursor = ss->play_cursor;
GUI_SET_CURSOR(channel_graph(cp), ss->play_cursor);
}
@@ -4958,9 +5194,9 @@ static char *describe_fft_point(chan_info *cp, int x, int y)
mus_float_t minlx = 0.0;
if (ap->x0 > 1.0) minlx = log(ap->x0); else minlx = 0.0;
xf = exp(minlx + ((xf - ap->x0) * (log(ap->x1) - minlx) / (ap->x1 - ap->x0)));
- ind = (int)((fp->current_size * xf) / (mus_float_t)SND_SRATE(cp->sound));
+ ind = (int)((fp->current_size * xf) / (mus_float_t)snd_srate(cp->sound));
}
- else ind = (int)((fp->current_size * xf) / (mus_float_t)SND_SRATE(cp->sound));
+ else ind = (int)((fp->current_size * xf) / (mus_float_t)snd_srate(cp->sound));
}
else ind = (int)xf;
if (ind >= fp->current_size) ind = fp->current_size - 1;
@@ -5002,9 +5238,9 @@ static char *describe_fft_point(chan_info *cp, int x, int y)
mus_float_t minlx = 0.0;
if (ap->y0 > 1.0) minlx = log(ap->y0); else minlx = 0.0;
yf = exp(minlx + ((yf - ap->y0) * (log(ap->y1) - minlx) / (ap->y1 - ap->y0)));
- ind = (int)((fp->current_size * yf) / (mus_float_t)SND_SRATE(cp->sound));
+ ind = (int)((fp->current_size * yf) / (mus_float_t)snd_srate(cp->sound));
}
- else ind = (int)((fp->current_size * yf) / (mus_float_t)SND_SRATE(cp->sound));
+ else ind = (int)((fp->current_size * yf) / (mus_float_t)snd_srate(cp->sound));
}
else ind = (int)yf;
if (ind >= si->total_bins) ind = si->total_bins - 1;
@@ -5025,7 +5261,7 @@ static char *describe_fft_point(chan_info *cp, int x, int y)
void fftb(chan_info *cp, bool on)
{
- cp->graph_transform_p = on;
+ cp->graph_transform_on = on;
set_toggle_button(channel_f(cp), on, false, (void *)cp);
calculate_fft(cp);
}
@@ -5033,7 +5269,7 @@ void fftb(chan_info *cp, bool on)
void waveb(chan_info *cp, bool on)
{
- cp->graph_time_p = on;
+ cp->graph_time_on = on;
set_toggle_button(channel_w(cp), on, false, (void *)cp);
update_graph_or_warn(cp);
}
@@ -5046,14 +5282,14 @@ static void propagate_wf_state(snd_info *sp)
chan_info *cp;
cp = sp->chans[0];
- w = cp->graph_time_p;
- f = cp->graph_transform_p;
+ w = cp->graph_time_on;
+ f = cp->graph_transform_on;
for (i = 1; i < sp->nchans; i++)
{
cp = sp->chans[i];
- cp->graph_time_p = w;
- cp->graph_transform_p = f;
+ cp->graph_time_on = w;
+ cp->graph_transform_on = f;
set_toggle_button(channel_f(cp), f, false, (void *)cp);
set_toggle_button(channel_w(cp), w, false, (void *)cp);
}
@@ -5064,7 +5300,7 @@ static void propagate_wf_state(snd_info *sp)
void f_button_callback(chan_info *cp, bool on, bool with_control)
{
snd_info *sp;
- cp->graph_transform_p = on;
+ cp->graph_transform_on = on;
sp = cp->sound;
if (sp->channel_style != CHANNELS_SEPARATE)
propagate_wf_state(sp);
@@ -5080,7 +5316,7 @@ void f_button_callback(chan_info *cp, bool on, bool with_control)
ncp = sp->chans[i];
if (cp != ncp)
{
- ncp->graph_transform_p = on;
+ ncp->graph_transform_on = on;
#if USE_GTK
set_toggle_button(channel_f(ncp), on, true, (void *)cp);
#else
@@ -5098,7 +5334,7 @@ void f_button_callback(chan_info *cp, bool on, bool with_control)
void w_button_callback(chan_info *cp, bool on, bool with_control)
{
snd_info *sp;
- cp->graph_time_p = on;
+ cp->graph_time_on = on;
sp = cp->sound;
if (sp->channel_style != CHANNELS_SEPARATE)
propagate_wf_state(sp);
@@ -5114,7 +5350,7 @@ void w_button_callback(chan_info *cp, bool on, bool with_control)
ncp = sp->chans[i];
if (cp != ncp)
{
- ncp->graph_time_p = on;
+ ncp->graph_time_on = on;
#if USE_GTK
set_toggle_button(channel_w(ncp), on, true, (void *)cp);
#else
@@ -5129,35 +5365,33 @@ void w_button_callback(chan_info *cp, bool on, bool with_control)
}
-bool key_press_callback(chan_info *ncp, int x, int y, int key_state, int keysym)
+void key_press_callback(chan_info *ncp, int x, int y, int key_state, int keysym)
{
/* called by every key-intercepting widget in the entire sound pane */
chan_info *cp;
snd_info *sp;
- if (!ncp) return(false);
+ if (!ncp) return;
cp = virtual_selected_channel(ncp);
sp = cp->sound;
select_channel(sp, cp->chan);
- if (((cp->graph_lisp_p) || (XEN_HOOKED(lisp_graph_hook))) &&
+ if (((cp->graph_lisp_on) || (Xen_hook_has_list(lisp_graph_hook))) &&
(within_graph(cp, x, y) == CLICK_LISP) &&
- (XEN_HOOKED(key_press_hook)))
+ (Xen_hook_has_list(key_press_hook)))
{
- /* return true to keep this key press from being passed to keyboard_command */
- XEN res = XEN_FALSE;
+ Xen res;
res = run_or_hook(key_press_hook,
- XEN_LIST_4(C_INT_TO_XEN_SOUND(sp->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_INT(keysym),
- C_TO_XEN_INT(key_state)), /* this can have NumLock etc -- will be masked off in keyboard_command */
+ Xen_list_4(C_int_to_Xen_sound(sp->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_int_to_Xen_integer(keysym),
+ C_int_to_Xen_integer(key_state)), /* this can have NumLock etc -- will be masked off in keyboard_command */
S_key_press_hook);
- if (XEN_TRUE_P(res))
- return(false);
+ if (Xen_is_true(res))
+ return;
}
keyboard_command(cp, keysym, key_state);
/* if lisp graph has cursor? */
- return(false);
}
@@ -5212,7 +5446,7 @@ static int fft_axis_start = 0;
#endif
static chan_info *dragged_cp;
-#if HAVE_OSX
+#ifdef __APPLE__
static int press_x, press_y;
#endif
@@ -5221,25 +5455,14 @@ void graph_button_press_callback(chan_info *cp, void *ev, int x, int y, int key_
{
snd_info *sp;
- /* in Motif and Gtk, we see left (1) and middle (2) buttons,
- * but right (3) button is trapped earlier and starts the popup menu.
- * In gtk, that's apparently only because we trap the POPUP_BUTTON in
- * graph_button_press first in snd-gchn.c. In motif, there's a check
- * in snd-xchn (post_popup), but I think that only applies to the
- * separate windows case.
- * presumably in gtk we could remove that check, land here, get our graph context
- * from within_graph, the choose the right popup menu if button == POPUP_BUTTON
- * perhaps in Motif, we couls not enable the popup menu in snd-xmenu, calling it
- * explicitly as in gtk?
- */
-
sp = cp->sound;
if ((cp->active < CHANNEL_HAS_AXES) || (sp == NULL)) return; /* autotest silliness */
/* if combining, figure out which virtual channel the mouse is in */
- if (sp->channel_style == CHANNELS_COMBINED) cp = which_channel(sp, y);
+ if (sp->channel_style == CHANNELS_COMBINED) cp = which_channel(sp, y); /* select this?? */
click_within_graph = within_graph(cp, x, y);
+ select_channel(sp, cp->chan);
if (button == POPUP_BUTTON)
{
@@ -5273,18 +5496,16 @@ void graph_button_press_callback(chan_info *cp, void *ev, int x, int y, int key_
case CLICK_LISP:
post_lisp_popup_menu(ev);
break;
-
}
-
return;
}
mouse_down_time = time;
-#if HAVE_OSX
+#ifdef __APPLE__
press_x = x;
press_y = y;
#endif
- select_channel(sp, cp->chan);
+ /* select_channel(sp, cp->chan); */
dragged_cp = cp;
dragged = false;
finish_selection_creation();
@@ -5305,14 +5526,14 @@ void graph_button_press_callback(chan_info *cp, void *ev, int x, int y, int key_
break;
case CLICK_LISP:
- if (XEN_HOOKED(mouse_press_hook))
+ if (Xen_hook_has_list(mouse_press_hook))
run_hook(mouse_press_hook,
- XEN_LIST_6(C_INT_TO_XEN_SOUND(sp->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_INT(button),
- C_TO_XEN_INT(key_state),
- C_TO_XEN_DOUBLE(ungrf_x(cp->lisp_info->axis, x)),
- C_TO_XEN_DOUBLE(ungrf_y(cp->lisp_info->axis, y))),
+ Xen_list_6(C_int_to_Xen_sound(sp->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_int_to_Xen_integer(button),
+ C_int_to_Xen_integer(key_state),
+ C_double_to_Xen_real(ungrf_x(cp->lisp_info->axis, x)),
+ C_double_to_Xen_real(ungrf_y(cp->lisp_info->axis, y))),
S_mouse_press_hook);
break;
@@ -5363,7 +5584,7 @@ void graph_button_press_callback(chan_info *cp, void *ev, int x, int y, int key_
break;
case CLICK_CURSOR_PLAY:
- play_channel_with_sync(cp, CURSOR(cp), NO_END_SPECIFIED);
+ play_channel_with_sync(cp, cursor_sample(cp), NO_END_SPECIFIED);
break;
case CLICK_SELECTION_LOOP_PLAY:
@@ -5418,15 +5639,15 @@ void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, i
click_loc_t actax;
actax = within_graph(cp, x, y);
- if ((XEN_HOOKED(mouse_click_hook)) &&
- (XEN_TRUE_P(run_or_hook(mouse_click_hook,
- XEN_LIST_7(C_INT_TO_XEN_SOUND(sp->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_INT(button),
- C_TO_XEN_INT(key_state),
- C_TO_XEN_INT(x),
- C_TO_XEN_INT(y),
- C_TO_XEN_INT((int)(((actax == CLICK_FFT_AXIS) || (actax == CLICK_FFT_MAIN)) ?
+ if ((Xen_hook_has_list(mouse_click_hook)) &&
+ (Xen_is_true(run_or_hook(mouse_click_hook,
+ Xen_list_7(C_int_to_Xen_sound(sp->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_int_to_Xen_integer(button),
+ C_int_to_Xen_integer(key_state),
+ C_int_to_Xen_integer(x),
+ C_int_to_Xen_integer(y),
+ C_int_to_Xen_integer((int)(((actax == CLICK_FFT_AXIS) || (actax == CLICK_FFT_MAIN)) ?
TRANSFORM_AXIS_INFO : ((actax == CLICK_LISP) ?
LISP_AXIS_INFO : TIME_AXIS_INFO)))),
S_mouse_click_hook))))
@@ -5437,7 +5658,7 @@ void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, i
case CLICK_INSET_GRAPH:
{
mus_long_t samp;
- samp = snd_round_mus_long_t(CURRENT_SAMPLES(cp) * ((double)(x - cp->inset_graph->x0) / (double)(cp->inset_graph->width)));
+ samp = snd_round_mus_long_t(current_samples(cp) * ((double)(x - cp->inset_graph->x0) / (double)(cp->inset_graph->width)));
cursor_moveto(cp, samp);
if ((samp < cp->axis->losamp) ||
(samp > cp->axis->hisamp))
@@ -5445,7 +5666,7 @@ void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, i
mus_long_t rsamp;
rsamp = samp + snd_round_mus_long_t(0.5 * (cp->axis->hisamp - cp->axis->losamp));
if (rsamp < 0) rsamp = 0;
- if (rsamp > CURRENT_SAMPLES(cp)) rsamp = CURRENT_SAMPLES(cp);
+ if (rsamp > current_samples(cp)) rsamp = current_samples(cp);
set_x_axis_x1(cp, rsamp);
update_graph(cp);
}
@@ -5461,7 +5682,7 @@ void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, i
if (button == BUTTON_2) /* the middle button */
{
cp->cursor_on = true;
- cursor_moveto(cp, snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)SND_SRATE(sp)));
+ cursor_moveto(cp, snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)snd_srate(sp)));
paste_region(region_list_position_to_id(0), cp);
}
else
@@ -5472,47 +5693,47 @@ void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, i
axis_info *ap;
/* zoom request -> each added key zooms closer, as does each successive click */
ap = cp->axis;
- samps = CURRENT_SAMPLES(cp);
+ samps = current_samples(cp);
if ((samps > 0) && ((ap->zx * (double)samps) > 1.0))
{
if (key_state & snd_ShiftMask) ap->zx *= .5;
if (key_state & snd_ControlMask) ap->zx *= .5;
if (key_state & snd_MetaMask) ap->zx *= .5;
if (ap->x_ambit != 0.0)
- ap->sx = (((double)(CURSOR(cp)) / (double)SND_SRATE(sp) -
+ ap->sx = (((double)(cursor_sample(cp)) / (double)snd_srate(sp) -
ap->zx * 0.5 * (ap->xmax - ap->xmin)) - ap->xmin) / ap->x_ambit;
- apply_x_axis_change(ap, cp);
+ apply_x_axis_change(cp);
resize_sx_and_zx(cp);
}
}
else
{
cp->cursor_on = true;
- cursor_moveto(cp, snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)SND_SRATE(sp)));
+ cursor_moveto(cp, snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)snd_srate(sp)));
if (mouse_mark)
{
- XEN res = XEN_FALSE;
- if (XEN_HOOKED(mark_click_hook))
+ Xen res = Xen_false;
+ if (Xen_hook_has_list(mark_click_hook))
res = run_progn_hook(mark_click_hook,
- XEN_LIST_1(new_xen_mark(mark_to_int(mouse_mark))),
+ Xen_list_1(new_xen_mark(mark_to_int(mouse_mark))),
S_mark_click_hook);
- if (!(XEN_TRUE_P(res)))
+ if (!(Xen_is_true(res)))
{
mus_long_t samp;
int sync;
samp = mark_sample(mouse_mark);
sync = mark_sync(mouse_mark);
if (sync == 0)
- report_in_minibuffer(sp, "mark %d at sample " MUS_LD " (%3f secs): %3f",
+ status_report(sp, "mark %d at sample %lld (%3f secs): %3f",
mark_to_int(mouse_mark),
samp,
- (double)samp / (double)(SND_SRATE(sp)),
+ (double)samp / (double)(snd_srate(sp)),
chn_sample(samp, cp, cp->edit_ctr));
else
- report_in_minibuffer(sp, "mark %d at sample " MUS_LD " (%3f secs): %3f, (sync: %d)",
+ status_report(sp, "mark %d at sample %lld (%3f secs): %3f, (sync: %d)",
mark_to_int(mouse_mark),
samp,
- (double)samp / (double)(SND_SRATE(sp)),
+ (double)samp / (double)(snd_srate(sp)),
chn_sample(samp, cp, cp->edit_ctr),
sync);
}
@@ -5521,13 +5742,13 @@ void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, i
{
if (mix_tag != NO_MIX_TAG)
{
- XEN res = XEN_FALSE;
+ Xen res = Xen_false;
/* the mix has already been selected by hit-mix above (to prepare drag) */
- if (XEN_HOOKED(mix_click_hook))
+ if (Xen_hook_has_list(mix_click_hook))
res = run_progn_hook(mix_click_hook,
- XEN_LIST_1(new_xen_mix(mix_tag)),
+ Xen_list_1(new_xen_mix(mix_tag)),
S_mix_click_hook);
- if (!(XEN_TRUE_P(res)))
+ if (!(Xen_is_true(res)))
{
make_mix_dialog();
reflect_mix_change(mix_tag);
@@ -5543,10 +5764,23 @@ void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, i
{
char *str;
str = describe_fft_point(cp, x, y);
- string_to_minibuffer(sp, str);
+ set_status(sp, str, false);
if (str) free(str);
}
break;
+
+#if USE_MOTIF
+ case CLICK_MARK_PLAY:
+ if (sp->sync != 0)
+ {
+ int i;
+ sync_info *si;
+ si = snd_sync(sp->sync);
+ for (i = 0; i < si->chans; i++)
+ update_graph(si->cps[i]);
+ }
+ else update_graph(cp);
+#endif
default:
break;
@@ -5595,7 +5829,7 @@ void graph_button_motion_callback(chan_info *cp, int x, int y, oclock_t time)
mouse_time = time;
if ((mouse_time - mouse_down_time) < ss->click_time) return;
-#if HAVE_OSX
+#ifdef __APPLE__
/* on the Mac, we seem to get motion events even without any motion, and the times seem very short */
if ((x == press_x) && (y == press_y)) return;
#endif
@@ -5613,39 +5847,52 @@ void graph_button_motion_callback(chan_info *cp, int x, int y, oclock_t time)
if (mouse_mark)
{
move_mark(cp, mouse_mark, x);
- report_in_minibuffer(sp, "%.4f", ungrf_x(cp->axis, x));
+ /* if mark_drag_hook has printed info to the status_area, we shouldn't erase it here! */
+ if (!ss->squelch_mark_drag_info)
+ status_report(sp, "%.4f", ungrf_x(cp->axis, x));
dragged = true;
return;
}
switch (click_within_graph)
{
+ case CLICK_MIX:
+ /* printing the new position in the status area here is distracting and unnecessary
+ * and the documentation (extsnd.html) has a mix-drag-hook function to print the position.
+ */
+ move_mix_tag(mix_tag, x, y);
+ dragged = true;
+ break;
+
+ case CLICK_MARK:
+ if ((dragged) &&
+ (!ss->squelch_mark_drag_info))
+ status_report(sp, "%.4f", ungrf_x(cp->axis, x));
+ dragged = true;
+ break;
+
case CLICK_INSET_GRAPH:
case CLICK_SELECTION_LEFT:
case CLICK_SELECTION_RIGHT:
case CLICK_SELECTION_MAIN:
- case CLICK_MIX:
- case CLICK_MARK:
case CLICK_WAVE:
if (dragged)
- report_in_minibuffer(sp, "%.4f", ungrf_x(cp->axis, x));
+ status_report(sp, "%.4f", ungrf_x(cp->axis, x));
- if (mix_tag != NO_MIX_TAG)
+ if (!dragged)
{
- move_mix_tag(mix_tag, x, y);
- dragged = true;
- return;
+ /* somehow... if there is already a selection, be reluctant to clobber it */
+ start_selection_creation(cp, snd_round_mus_long_t(ungrf_x(cp->axis, x) * snd_srate(sp)));
}
- if (!dragged)
- start_selection_creation(cp, snd_round_mus_long_t(ungrf_x(cp->axis, x) * SND_SRATE(sp)));
else
{
- update_possible_selection_in_progress(snd_round_mus_long_t(ungrf_x(cp->axis, x) * SND_SRATE(sp)));
+ update_possible_selection_in_progress(snd_round_mus_long_t(ungrf_x(cp->axis, x) * snd_srate(sp)));
move_selection(cp, x);
}
+
dragged = true;
break;
-
+
case CLICK_FFT_AXIS:
{
/* change spectrum_end(ss) and redisplay fft */
@@ -5699,23 +5946,23 @@ void graph_button_motion_callback(chan_info *cp, int x, int y, oclock_t time)
break;
case CLICK_LISP:
- if (XEN_HOOKED(mouse_drag_hook))
+ if (Xen_hook_has_list(mouse_drag_hook))
run_hook(mouse_drag_hook,
- XEN_LIST_6(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_INT(-1),
- C_TO_XEN_INT(-1),
- C_TO_XEN_DOUBLE(ungrf_x(cp->lisp_info->axis, x)),
- C_TO_XEN_DOUBLE(ungrf_y(cp->lisp_info->axis, y))),
+ Xen_list_6(C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_int_to_Xen_integer(-1),
+ C_int_to_Xen_integer(-1),
+ C_double_to_Xen_real(ungrf_x(cp->lisp_info->axis, x)),
+ C_double_to_Xen_real(ungrf_y(cp->lisp_info->axis, y))),
S_mouse_drag_hook);
break;
case CLICK_FFT_MAIN:
- if (cp->verbose_cursor)
+ if (cp->with_verbose_cursor)
{
char *str;
str = describe_fft_point(cp, x, y);
- string_to_minibuffer(cp->sound, str);
+ set_status(cp->sound, str, false);
if (str) free(str);
}
break;
@@ -5804,10 +6051,7 @@ graphics_context *set_context(chan_info *cp, chan_gc_t gc)
case CHAN_CGC: ax->gc = ss->selected_cursor_gc; break;
case CHAN_MGC: ax->gc = ss->selected_mark_gc; break;
case CHAN_MXGC: ax->gc = ss->mix_gc; break;
- case CHAN_TMPGC:
- ax->gc = ss->selected_basic_gc;
- set_foreground_color(ax, cp->combined_data_color);
- break;
+ case CHAN_TMPGC: ax->gc = ss->selected_basic_gc; break;
}
}
else
@@ -5820,10 +6064,7 @@ graphics_context *set_context(chan_info *cp, chan_gc_t gc)
case CHAN_CGC: ax->gc = ss->cursor_gc; break;
case CHAN_MGC: ax->gc = ss->mark_gc; break;
case CHAN_MXGC: ax->gc = ss->mix_gc; break;
- case CHAN_TMPGC:
- ax->gc = ss->combined_basic_gc;
- set_foreground_color(ax, cp->combined_data_color);
- break;
+ case CHAN_TMPGC: ax->gc = ss->combined_basic_gc; break;
}
}
return(ax);
@@ -5845,10 +6086,8 @@ static graphics_context *combined_context(chan_info *cp) {return(set_context(cp,
static void show_smpte_label(chan_info *cp, graphics_context *cur_ax)
{
#if (!USE_NO_GUI)
- #define SMPTE_FRAMES_PER_SECOND 24.0
- static char label[12] = "00:00:00:00";
-
- if (cp->graph_time_p)
+ #define SMPTE_FRAMPLES_PER_SECOND 24.0
+ if (cp->graph_time_on)
{
int grf_x, grf_y, grf_width, grf_height;
/* is there room for a label? */
@@ -5861,10 +6100,11 @@ static void show_smpte_label(chan_info *cp, graphics_context *cur_ax)
if ((grf_width > 100) &&
(grf_height > 20))
{
- bool try_tiny_font = false;
- int width, height, frames, seconds, minutes, hours;
+ bool try_tiny_font;
+ int width, height, framples, seconds, minutes, hours;
double secs;
char num_buf[3];
+ static char label[12] = "00:00:00:00";
try_tiny_font = (grf_height < 50);
width = 8 + number_width(label, try_tiny_font);
@@ -5876,7 +6116,7 @@ static void show_smpte_label(chan_info *cp, graphics_context *cur_ax)
minutes = floor(secs / 60.0);
secs -= minutes * 60;
seconds = floor(secs);
- frames = (secs - seconds) * SMPTE_FRAMES_PER_SECOND;
+ framples = (secs - seconds) * SMPTE_FRAMPLES_PER_SECOND;
snprintf(num_buf, 3, "%d", hours);
if (hours > 9) {label[0] = num_buf[0]; label[1] = num_buf[1];} else {label[0] = '0'; label[1] = num_buf[0];}
@@ -5884,8 +6124,8 @@ static void show_smpte_label(chan_info *cp, graphics_context *cur_ax)
if (minutes > 9) {label[3] = num_buf[0]; label[4] = num_buf[1];} else {label[3] = '0'; label[4] = num_buf[0];}
snprintf(num_buf, 3, "%d", seconds);
if (seconds > 9) {label[6] = num_buf[0]; label[7] = num_buf[1];} else {label[6] = '0'; label[7] = num_buf[0];}
- snprintf(num_buf, 3, "%d", frames);
- if (frames > 9) {label[9] = num_buf[0]; label[10] = num_buf[1];} else {label[9] = '0'; label[10] = num_buf[0];}
+ snprintf(num_buf, 3, "%d", framples);
+ if (framples > 9) {label[9] = num_buf[0]; label[10] = num_buf[1];} else {label[9] = '0'; label[10] = num_buf[0];}
fill_rectangle(cur_ax, grf_x, grf_y, width, 2);
fill_rectangle(cur_ax, grf_x, grf_y + height, width, 2);
@@ -5945,18 +6185,57 @@ static void make_point_arrays(inset_graph_info_t *info, int size, vct *v1)
info->data_size = size;
}
+
+
+static void update_inset_axes(chan_info *cp, inset_graph_info_t *info, graphics_context *cur_ax)
+{
+ char *str;
+ int len, num_hgt = -1;
+ axis_info *ap;
+ ap = cp->axis;
+ str = prettyf(ap->xmax, 2);
+ if (str)
+ {
+ num_hgt = number_height(TINY_FONT(ss));
+ len = strlen(str);
+ set_tiny_numbers_font(cp, cur_ax);
+#if (!USE_GTK)
+ draw_string(cur_ax, info->x1 - 6 * len + 10, info->y1 + num_hgt, str, len);
+#else
+ draw_string(cur_ax, info->x1 - 6 * len + 10, info->y1 + (num_hgt / 2) - 2, str, len);
+#endif
+ free(str);
+ }
+
+ if (info->maxamp > 0.0)
+ {
+ str = prettyf(info->maxamp, (info->maxamp > .1) ? 2 : ((info->maxamp > .01) ? 3 : 4));
+ if (str)
+ {
+ len = strlen(str);
+ set_tiny_numbers_font(cp, cur_ax);
+#if (!USE_GTK)
+ if (num_hgt == -1) num_hgt = number_height(TINY_FONT(ss));
+ draw_string(cur_ax, info->x0 - 6 * len - 2, info->y0 + (num_hgt / 2), str, len);
+#else
+ draw_string(cur_ax, info->x0 - 6 * len - 2, info->y0, str, len);
+#endif
+ free(str);
+ }
+ }
+}
#endif
static void show_inset_graph(chan_info *cp, graphics_context *cur_ax)
{
#if (!USE_NO_GUI)
- if (cp->graph_time_p)
+ if (cp->graph_time_on)
{
- int grf_width, width, x_offset, y_offset, grf_height, height, chan_offset, grf_chn = 0;
+ int grf_width, width, x_offset, y_offset, grf_height, height, chan_offset;
bool new_peaks;
inset_graph_info_t *info;
- int64_t frames;
+ mus_long_t framples;
if (!(cp->inset_graph))
{
@@ -5976,20 +6255,16 @@ static void show_inset_graph(chan_info *cp, graphics_context *cur_ax)
chan_offset += 10;
y_offset = chan_offset + snd_round(height * 0.5);
- if (cp->sound->channel_style == CHANNELS_SEPARATE) grf_chn = cp->chan;
new_peaks = ((cp->axis->cp) && (cp->axis->cp->new_peaks));
/* new_peaks is set during update_graph if we just finished a new peak-env */
- frames = CURRENT_SAMPLES(cp);
+ framples = current_samples(cp);
if ((width > 10) &&
(height > 10) &&
- (frames > 0) &&
+ (framples > 0) &&
((cp->chan == 0) || (cp->sound->channel_style != CHANNELS_SUPERIMPOSED)))
{
/* draw axes around the inset graph */
- chan_info *grf_cp;
- grf_cp = cp->sound->chans[grf_chn];
-
fill_rectangle(cur_ax, x_offset, chan_offset + height, width, 2);
fill_rectangle(cur_ax, x_offset, chan_offset, 2, height);
@@ -5998,48 +6273,11 @@ static void show_inset_graph(chan_info *cp, graphics_context *cur_ax)
info->y0 = chan_offset;
info->y1 = chan_offset + height;
- {
- char *str;
- int len, num_hgt = -1;
- axis_info *ap;
- ap = cp->axis;
- str = prettyf(ap->xmax, 2);
- if (str)
- {
- num_hgt = number_height(TINY_FONT(ss));
- len = strlen(str);
- set_tiny_numbers_font(cp, cur_ax);
-#if (!USE_GTK)
- draw_string(cur_ax, info->x1 - 6 * len + 10, info->y1 + num_hgt, str, len);
-#else
- draw_string(cur_ax, info->x1 - 6 * len + 10, info->y1 + (num_hgt / 2) - 2, str, len);
-#endif
- free(str);
- }
-
- if (info->maxamp > 0.0)
- {
- str = prettyf(info->maxamp, (info->maxamp > .1) ? 2 : ((info->maxamp > .01) ? 3 : 4));
- if (str)
- {
- if (num_hgt == -1) num_hgt = number_height(TINY_FONT(ss));
- len = strlen(str);
- set_tiny_numbers_font(cp, cur_ax);
-#if (!USE_GTK)
- draw_string(cur_ax, info->x0 - 6 * len - 2, info->y0 + (num_hgt / 2), str, len);
-#else
- draw_string(cur_ax, info->x0 - 6 * len - 2, info->y0, str, len);
-#endif
- free(str);
- }
- }
- }
-
/* show where the current window fits into the overall graph */
{
int rx, lx, wx;
- rx = snd_round(width * (double)(cp->axis->hisamp) / (double)frames);
- lx = snd_round(width * (double)(cp->axis->losamp) / (double)frames);
+ rx = snd_round(width * (double)(cp->axis->hisamp) / (double)framples);
+ lx = snd_round(width * (double)(cp->axis->losamp) / (double)framples);
#if USE_GTK
if (lx < 2) lx = 2; /* don't erase the y axis */
#endif
@@ -6067,29 +6305,36 @@ static void show_inset_graph(chan_info *cp, graphics_context *cur_ax)
(cp->edit_ctr == info->edpos))
{
/* use old env graph points if nothing has changed */
+ update_inset_axes(cp, info, cur_ax);
}
else
{
/* need to get new peak env graph points */
- XEN data;
+ Xen data;
double data_max = 0.0, data_scaler, step;
vct *v0 = NULL, *v1 = NULL;
+ mus_float_t *v0data = NULL, *v1data = NULL;
int data_len;
#if HAVE_SCHEME
int gc_loc;
#endif
- data = make_graph_data(cp, cp->edit_ctr, 0, frames);
+ data = make_graph_data(cp, cp->edit_ctr, 0, framples);
+ if (Xen_is_false(data)) return;
#if HAVE_SCHEME
gc_loc = s7_gc_protect(s7, data);
#endif
- if (mus_vct_p(data))
+ if (mus_is_vct(data))
v0 = xen_to_vct(data);
else
{
- v0 = xen_to_vct(XEN_CAR(data));
- v1 = xen_to_vct(XEN_CADR(data));
+ v0 = xen_to_vct(Xen_car(data));
+ v1 = xen_to_vct(Xen_cadr(data));
}
+
+ v0data = mus_vct_data(v0);
+ if (v1) v1data = mus_vct_data(v1);
+
data_max = mus_vct_peak(v0);
if (v1)
{
@@ -6103,7 +6348,7 @@ static void show_inset_graph(chan_info *cp, graphics_context *cur_ax)
else data_scaler = 0.0;
info->maxamp = data_max;
- data_len = v0->length;
+ data_len = mus_vct_length(v0);
step = (double)data_len / (double)width;
if (data_scaler < 0.00000001)
@@ -6140,12 +6385,12 @@ static void show_inset_graph(chan_info *cp, graphics_context *cur_ax)
{
if (v1)
{
- if (v1->data[i] > max_y) max_y = v1->data[i];
- if (v0->data[i] < min_y) min_y = v0->data[i];
+ if (v1data[i] > max_y) max_y = v1data[i];
+ if (v0data[i] < min_y) min_y = v0data[i];
}
else
{
- if (v0->data[i] > max_y) max_y = v0->data[i];
+ if (v0data[i] > max_y) max_y = v0data[i];
}
stepper += 1.0;
if (stepper >= step)
@@ -6191,12 +6436,12 @@ static void show_inset_graph(chan_info *cp, graphics_context *cur_ax)
{
info->data0[i].x = snd_round(xj);
if (!v1)
- info->data0[i].y = snd_round(y_offset - data_scaler * v0->data[i]);
+ info->data0[i].y = snd_round(y_offset - data_scaler * v0data[i]);
else
{
- info->data0[i].y = snd_round(y_offset - data_scaler * v1->data[i]);
+ info->data0[i].y = snd_round(y_offset - data_scaler * v1data[i]);
info->data1[i].x = info->data0[i].x;
- info->data1[i].x = snd_round(y_offset - data_scaler * v0->data[i]);
+ info->data1[i].x = snd_round(y_offset - data_scaler * v0data[i]);
}
}
}
@@ -6206,6 +6451,7 @@ static void show_inset_graph(chan_info *cp, graphics_context *cur_ax)
info->height = height;
info->edpos = cp->edit_ctr;
info->y_offset = y_offset;
+ update_inset_axes(cp, info, cur_ax);
#if HAVE_SCHEME
s7_gc_unprotect_at(s7, gc_loc);
#endif
@@ -6234,37 +6480,37 @@ void draw_inset_line_cursor(chan_info *cp, graphics_context *ax)
/* -------------------------------------------------------------------------------- */
-typedef enum {CP_GRAPH_TRANSFORM_P, CP_GRAPH_TIME_P, CP_FRAMES, CP_CURSOR, CP_GRAPH_LISP_P, CP_AP_LOSAMP, CP_AP_HISAMP, CP_SQUELCH_UPDATE,
+typedef enum {CP_GRAPH_TRANSFORM_ON, CP_GRAPH_TIME_ON, CP_FRAMPLES, CP_CURSOR, CP_GRAPH_LISP_ON, CP_LOSAMP, CP_HISAMP, CP_SQUELCH_UPDATE,
CP_EDIT_CTR, CP_CURSOR_STYLE, CP_EDIT_HOOK, CP_UNDO_HOOK, CP_AFTER_EDIT_HOOK,
CP_SHOW_Y_ZERO, CP_SHOW_MARKS, CP_TIME_GRAPH_TYPE, CP_WAVO_HOP, CP_WAVO_TRACE, CP_MAX_TRANSFORM_PEAKS,
- CP_SHOW_TRANSFORM_PEAKS, CP_ZERO_PAD, CP_VERBOSE_CURSOR, CP_FFT_LOG_FREQUENCY, CP_FFT_LOG_MAGNITUDE,
+ CP_SHOW_TRANSFORM_PEAKS, CP_ZERO_PAD, CP_WITH_VERBOSE_CURSOR, CP_FFT_LOG_FREQUENCY, CP_FFT_LOG_MAGNITUDE,
CP_WAVELET_TYPE, CP_SPECTRO_HOP, CP_TRANSFORM_SIZE, CP_TRANSFORM_GRAPH_TYPE, CP_FFT_WINDOW, CP_TRANSFORM_TYPE,
CP_TRANSFORM_NORMALIZATION, CP_SHOW_MIX_WAVEFORMS, CP_TIME_GRAPH_STYLE, CP_LISP_GRAPH_STYLE, CP_TRANSFORM_GRAPH_STYLE, CP_DOT_SIZE,
CP_SHOW_AXES, CP_GRAPHS_HORIZONTAL, CP_CURSOR_SIZE, CP_CURSOR_POSITION,
- CP_EDPOS_FRAMES, CP_X_AXIS_STYLE, CP_UPDATE_TIME, CP_UPDATE_TRANSFORM_GRAPH, CP_UPDATE_LISP, CP_PROPERTIES,
+ CP_EDPOS_FRAMPLES, CP_X_AXIS_STYLE, CP_UPDATE_TIME, CP_UPDATE_TRANSFORM_GRAPH, CP_UPDATE_LISP, CP_PROPERTIES,
CP_MIN_DB, CP_SPECTRO_X_ANGLE, CP_SPECTRO_Y_ANGLE, CP_SPECTRO_Z_ANGLE, CP_SPECTRO_X_SCALE, CP_SPECTRO_Y_SCALE, CP_SPECTRO_Z_SCALE,
- CP_SPECTRUM_END, CP_SPECTRUM_START, CP_FFT_WINDOW_BETA, CP_AP_SX, CP_AP_SY, CP_AP_ZX, CP_AP_ZY, CP_MAXAMP, CP_EDPOS_MAXAMP,
+ CP_SPECTRUM_END, CP_SPECTRUM_START, CP_FFT_WINDOW_BETA, CP_SX, CP_SY, CP_ZX, CP_ZY, CP_MAXAMP, CP_EDPOS_MAXAMP,
CP_BEATS_PER_MINUTE, CP_EDPOS_CURSOR, CP_SHOW_GRID, CP_SHOW_SONOGRAM_CURSOR, CP_GRID_DENSITY, CP_MAXAMP_POSITION,
CP_EDPOS_MAXAMP_POSITION, CP_BEATS_PER_MEASURE, CP_FFT_WINDOW_ALPHA, CP_TRACKING_CURSOR_STYLE, CP_FFT_WITH_PHASES
} cp_field_t;
-static XEN cp_edpos;
+static Xen cp_edpos;
static int cp_edpos_loc = NOT_A_GC_LOC;
-static XEN channel_get(XEN snd, XEN chn_n, cp_field_t fld, const char *caller)
+static Xen channel_get(Xen snd, Xen chn_n, cp_field_t fld, const char *caller)
{
chan_info *cp;
snd_info *sp = NULL;
int i;
- XEN res = XEN_EMPTY_LIST;
- if (XEN_TRUE_P(snd))
+ Xen res = Xen_empty_list;
+ if (Xen_is_true(snd))
{
for (i = ss->max_sounds - 1; i >= 0; i--)
{
sp = ss->sounds[i];
if ((sp) && (sp->inuse == SOUND_NORMAL))
- res = XEN_CONS(channel_get(C_TO_XEN_INT(i), chn_n, fld, caller), res);
+ res = Xen_cons(channel_get(C_int_to_Xen_integer(i), chn_n, fld, caller), res);
/* I think not SOUND_WRAPPER here -- get/set would then be operating on sounds that
* are not returned by 'sounds' and return #f from 'sound?', so it would almost
* certainly cause confusion. The globals fields should be reflected however.
@@ -6274,111 +6520,108 @@ static XEN channel_get(XEN snd, XEN chn_n, cp_field_t fld, const char *caller)
}
else
{
- if (XEN_TRUE_P(chn_n))
+ if (Xen_is_true(chn_n))
{
sp = get_sp(snd);
if (sp == NULL)
return(snd_no_such_sound_error(caller, snd));
for (i = sp->nchans - 1; i >= 0; i--)
- res = XEN_CONS(channel_get(snd, C_TO_XEN_INT(i), fld, caller), res);
+ res = Xen_cons(channel_get(snd, C_int_to_Xen_integer(i), fld, caller), res);
return(res);
}
else
{
- ASSERT_CHANNEL(caller, snd, chn_n, 1);
+ Snd_assert_channel(caller, snd, chn_n, 1);
cp = get_cp(snd, chn_n, caller);
- if (!cp) return(XEN_FALSE); /* perhaps snd-error-hook cancelled the error? */
+ if (!cp) return(Xen_false); /* perhaps snd-error-hook cancelled the error? */
switch (fld)
{
- case CP_EDIT_CTR: return(C_TO_XEN_INT(cp->edit_ctr)); break;
- case CP_GRAPH_TRANSFORM_P: return(C_TO_XEN_BOOLEAN(cp->graph_transform_p)); break;
- case CP_GRAPH_TIME_P: return(C_TO_XEN_BOOLEAN(cp->graph_time_p)); break;
- case CP_CURSOR: return(C_TO_XEN_INT64_T(CURSOR(cp))); break;
- case CP_EDPOS_CURSOR: return(C_TO_XEN_INT64_T(cp->edits[to_c_edit_position(cp, cp_edpos, S_cursor, 3)]->cursor)); break;
- case CP_FRAMES: return(C_TO_XEN_INT64_T(CURRENT_SAMPLES(cp))); break;
- case CP_GRAPH_LISP_P: return(C_TO_XEN_BOOLEAN(cp->graph_lisp_p)); break;
- case CP_AP_LOSAMP: if (cp->axis) return(C_TO_XEN_INT64_T(cp->axis->losamp)); break;
- case CP_AP_HISAMP: if (cp->axis) return(C_TO_XEN_INT64_T(cp->axis->hisamp)); break;
- case CP_SQUELCH_UPDATE: return(C_TO_XEN_BOOLEAN(cp->squelch_update)); break;
- case CP_CURSOR_SIZE: return(C_TO_XEN_INT(cp->cursor_size)); break;
+ case CP_EDIT_CTR: return(C_int_to_Xen_integer(cp->edit_ctr)); break;
+ case CP_GRAPH_TRANSFORM_ON: return(C_bool_to_Xen_boolean(cp->graph_transform_on)); break;
+ case CP_GRAPH_TIME_ON: return(C_bool_to_Xen_boolean(cp->graph_time_on)); break;
+ case CP_CURSOR: return(C_llong_to_Xen_llong(cursor_sample(cp))); break;
+ case CP_EDPOS_CURSOR: return(C_llong_to_Xen_llong(cp->edits[to_c_edit_position(cp, cp_edpos, S_cursor, 3)]->cursor)); break;
+ case CP_FRAMPLES: return(C_llong_to_Xen_llong(current_samples(cp))); break;
+ case CP_GRAPH_LISP_ON: return(C_bool_to_Xen_boolean(cp->graph_lisp_on)); break;
+ case CP_LOSAMP: if (cp->axis) return(C_llong_to_Xen_llong(cp->axis->losamp)); break;
+ case CP_HISAMP: if (cp->axis) return(C_llong_to_Xen_llong(cp->axis->hisamp)); break;
+ case CP_SQUELCH_UPDATE: return(C_bool_to_Xen_boolean(cp->squelch_update)); break;
+ case CP_CURSOR_SIZE: return(C_int_to_Xen_integer(cp->cursor_size)); break;
case CP_CURSOR_STYLE:
if (cp->cursor_style != CURSOR_PROC)
- return(C_TO_XEN_INT((int)(cp->cursor_style)));
- if (XEN_PROCEDURE_P(cp->cursor_proc))
+ return(C_int_to_Xen_integer((int)(cp->cursor_style)));
+ if (Xen_is_procedure(cp->cursor_proc))
return(cp->cursor_proc);
return(ss->cursor_proc);
break;
case CP_TRACKING_CURSOR_STYLE:
- return(C_TO_XEN_INT((int)(cp->tracking_cursor_style)));
+ return(C_int_to_Xen_integer((int)(cp->tracking_cursor_style)));
break;
case CP_EDIT_HOOK:
- if (!(XEN_HOOK_P(cp->edit_hook)))
+ if (!(Xen_is_hook(cp->edit_hook)))
{
- cp->edit_hook = XEN_DEFINE_SIMPLE_HOOK(0);
+ cp->edit_hook = Xen_define_simple_hook("(make-hook)", 0);
cp->edit_hook_loc = snd_protect(cp->edit_hook);
}
return(cp->edit_hook);
break;
case CP_AFTER_EDIT_HOOK:
- if (!(XEN_HOOK_P(cp->after_edit_hook)))
+ if (!(Xen_is_hook(cp->after_edit_hook)))
{
- cp->after_edit_hook = XEN_DEFINE_SIMPLE_HOOK(0);
+ cp->after_edit_hook = Xen_define_simple_hook("(make-hook)", 0);
cp->after_edit_hook_loc = snd_protect(cp->after_edit_hook);
}
return(cp->after_edit_hook);
break;
case CP_UNDO_HOOK:
- if (!(XEN_HOOK_P(cp->undo_hook)))
+ if (!(Xen_is_hook(cp->undo_hook)))
{
- cp->undo_hook = XEN_DEFINE_SIMPLE_HOOK(0);
+ cp->undo_hook = Xen_define_simple_hook("(make-hook)", 0);
cp->undo_hook_loc = snd_protect(cp->undo_hook);
}
return(cp->undo_hook);
break;
- case CP_SHOW_Y_ZERO: return(C_TO_XEN_BOOLEAN(cp->show_y_zero)); break;
- case CP_SHOW_GRID: return(C_TO_XEN_BOOLEAN((bool)(cp->show_grid))); break;
- case CP_GRID_DENSITY: return(C_TO_XEN_DOUBLE(cp->grid_density)); break;
- case CP_SHOW_SONOGRAM_CURSOR: return(C_TO_XEN_BOOLEAN((bool)(cp->show_sonogram_cursor))); break;
- case CP_SHOW_MARKS: return(C_TO_XEN_BOOLEAN(cp->show_marks)); break;
- case CP_TIME_GRAPH_TYPE: return(C_TO_XEN_INT((int)(cp->time_graph_type))); break;
- case CP_WAVO_HOP: return(C_TO_XEN_INT(cp->wavo_hop)); break;
- case CP_WAVO_TRACE: return(C_TO_XEN_INT(cp->wavo_trace)); break;
- case CP_MAX_TRANSFORM_PEAKS: return(C_TO_XEN_INT(cp->max_transform_peaks)); break;
- case CP_ZERO_PAD: return(C_TO_XEN_INT(cp->zero_pad)); break;
- case CP_WAVELET_TYPE: return(C_TO_XEN_INT(cp->wavelet_type)); break;
- case CP_SHOW_TRANSFORM_PEAKS: return(C_TO_XEN_BOOLEAN(cp->show_transform_peaks)); break;
- case CP_VERBOSE_CURSOR: return(C_TO_XEN_BOOLEAN(cp->verbose_cursor)); break;
- case CP_FFT_LOG_FREQUENCY: return(C_TO_XEN_BOOLEAN(cp->fft_log_frequency)); break;
- case CP_FFT_LOG_MAGNITUDE: return(C_TO_XEN_BOOLEAN(cp->fft_log_magnitude)); break;
- case CP_FFT_WITH_PHASES: return(C_TO_XEN_BOOLEAN(cp->fft_with_phases)); break;
- case CP_SPECTRO_HOP: return(C_TO_XEN_INT(cp->spectro_hop)); break;
- case CP_TRANSFORM_SIZE: return(C_TO_XEN_INT64_T(cp->transform_size)); break;
- case CP_TRANSFORM_GRAPH_TYPE: return(C_TO_XEN_INT((int)(cp->transform_graph_type))); break;
- case CP_FFT_WINDOW: return(C_TO_XEN_INT((int)(cp->fft_window))); break;
- case CP_TRANSFORM_TYPE: return(C_INT_TO_XEN_TRANSFORM(cp->transform_type)); break;
- case CP_TRANSFORM_NORMALIZATION: return(C_TO_XEN_INT((int)(cp->transform_normalization))); break;
- case CP_SHOW_MIX_WAVEFORMS: return(C_TO_XEN_BOOLEAN(cp->show_mix_waveforms)); break;
- case CP_TIME_GRAPH_STYLE: return(C_TO_XEN_INT(cp->time_graph_style)); break;
- case CP_LISP_GRAPH_STYLE: return(C_TO_XEN_INT(cp->lisp_graph_style)); break;
- case CP_TRANSFORM_GRAPH_STYLE: return(C_TO_XEN_INT(cp->transform_graph_style)); break;
- case CP_X_AXIS_STYLE: return(C_TO_XEN_INT((int)(cp->x_axis_style))); break;
- case CP_DOT_SIZE: return(C_TO_XEN_INT(cp->dot_size)); break;
- case CP_SHOW_AXES: return(C_TO_XEN_INT((int)(cp->show_axes))); break;
- case CP_GRAPHS_HORIZONTAL: return(C_TO_XEN_BOOLEAN(cp->graphs_horizontal)); break;
- case CP_CURSOR_POSITION: return(XEN_LIST_2(C_TO_XEN_INT(cp->cx), C_TO_XEN_INT(cp->cy))); break;
- case CP_EDPOS_FRAMES: return(C_TO_XEN_INT64_T(to_c_edit_samples(cp, cp_edpos, caller, 3))); break;
+ case CP_SHOW_Y_ZERO: return(C_bool_to_Xen_boolean(cp->show_y_zero)); break;
+ case CP_SHOW_GRID: return(C_bool_to_Xen_boolean((bool)(cp->show_grid))); break;
+ case CP_GRID_DENSITY: return(C_double_to_Xen_real(cp->grid_density)); break;
+ case CP_SHOW_SONOGRAM_CURSOR: return(C_bool_to_Xen_boolean((bool)(cp->show_sonogram_cursor))); break;
+ case CP_SHOW_MARKS: return(C_bool_to_Xen_boolean(cp->show_marks)); break;
+ case CP_TIME_GRAPH_TYPE: return(C_int_to_Xen_integer((int)(cp->time_graph_type))); break;
+ case CP_WAVO_HOP: return(C_int_to_Xen_integer(cp->wavo_hop)); break;
+ case CP_WAVO_TRACE: return(C_int_to_Xen_integer(cp->wavo_trace)); break;
+ case CP_MAX_TRANSFORM_PEAKS: return(C_int_to_Xen_integer(cp->max_transform_peaks)); break;
+ case CP_ZERO_PAD: return(C_int_to_Xen_integer(cp->zero_pad)); break;
+ case CP_WAVELET_TYPE: return(C_int_to_Xen_integer(cp->wavelet_type)); break;
+ case CP_SHOW_TRANSFORM_PEAKS: return(C_bool_to_Xen_boolean(cp->show_transform_peaks)); break;
+ case CP_WITH_VERBOSE_CURSOR: return(C_bool_to_Xen_boolean(cp->with_verbose_cursor)); break;
+ case CP_FFT_LOG_FREQUENCY: return(C_bool_to_Xen_boolean(cp->fft_log_frequency)); break;
+ case CP_FFT_LOG_MAGNITUDE: return(C_bool_to_Xen_boolean(cp->fft_log_magnitude)); break;
+ case CP_FFT_WITH_PHASES: return(C_bool_to_Xen_boolean(cp->fft_with_phases)); break;
+ case CP_SPECTRO_HOP: return(C_int_to_Xen_integer(cp->spectro_hop)); break;
+ case CP_TRANSFORM_SIZE: return(C_llong_to_Xen_llong(cp->transform_size)); break;
+ case CP_TRANSFORM_GRAPH_TYPE: return(C_int_to_Xen_integer((int)(cp->transform_graph_type))); break;
+ case CP_FFT_WINDOW: return(C_int_to_Xen_integer((int)(cp->fft_window))); break;
+ case CP_TRANSFORM_TYPE: return(C_int_to_Xen_transform(cp->transform_type)); break;
+ case CP_TRANSFORM_NORMALIZATION: return(C_int_to_Xen_integer((int)(cp->transform_normalization))); break;
+ case CP_SHOW_MIX_WAVEFORMS: return(C_bool_to_Xen_boolean(cp->show_mix_waveforms)); break;
+ case CP_TIME_GRAPH_STYLE: return(C_int_to_Xen_integer(cp->time_graph_style)); break;
+ case CP_LISP_GRAPH_STYLE: return(C_int_to_Xen_integer(cp->lisp_graph_style)); break;
+ case CP_TRANSFORM_GRAPH_STYLE: return(C_int_to_Xen_integer(cp->transform_graph_style)); break;
+ case CP_X_AXIS_STYLE: return(C_int_to_Xen_integer((int)(cp->x_axis_style))); break;
+ case CP_DOT_SIZE: return(C_int_to_Xen_integer(cp->dot_size)); break;
+ case CP_SHOW_AXES: return(C_int_to_Xen_integer((int)(cp->show_axes))); break;
+ case CP_GRAPHS_HORIZONTAL: return(C_bool_to_Xen_boolean(cp->graphs_horizontal)); break;
+ case CP_CURSOR_POSITION: return(Xen_list_2(C_int_to_Xen_integer(cp->cx), C_int_to_Xen_integer(cp->cy))); break;
+ case CP_EDPOS_FRAMPLES: return(C_llong_to_Xen_llong(to_c_edit_samples(cp, cp_edpos, caller, 3))); break;
case CP_UPDATE_TIME:
-#if USE_GTK
- if (!(cp->ax->wn)) fixup_cp_cgx_ax_wn(cp);
-#endif
- /* any display-oriented background process must 1st be run to completion
+ /* any display-oriented background process must first be run to completion
* display checks for waiting process and does not update display if one found!
*/
finish_peak_env(cp);
@@ -6391,7 +6634,7 @@ static XEN channel_get(XEN snd, XEN chn_n, cp_field_t fld, const char *caller)
break;
case CP_UPDATE_TRANSFORM_GRAPH:
- if (cp->graph_transform_p)
+ if (cp->graph_transform_on)
{
if (chan_fft_in_progress(cp))
force_fft_clear(cp);
@@ -6410,55 +6653,55 @@ static XEN channel_get(XEN snd, XEN chn_n, cp_field_t fld, const char *caller)
break;
case CP_PROPERTIES:
- if (!(XEN_VECTOR_P(cp->properties)))
+ if (!(Xen_is_vector(cp->properties)))
{
- cp->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ cp->properties = Xen_make_vector(1, Xen_empty_list);
cp->properties_loc = snd_protect(cp->properties);
}
- return(XEN_VECTOR_REF(cp->properties, 0));
+ return(Xen_vector_ref(cp->properties, 0));
break;
- case CP_AP_SX: if (cp->axis) return(C_TO_XEN_DOUBLE(cp->axis->sx)); break;
- case CP_AP_SY: if (cp->axis) return(C_TO_XEN_DOUBLE(cp->axis->sy)); break;
- case CP_AP_ZX: if (cp->axis) return(C_TO_XEN_DOUBLE(cp->axis->zx)); break;
- case CP_AP_ZY: if (cp->axis) return(C_TO_XEN_DOUBLE(cp->axis->zy)); break;
- case CP_MIN_DB: return(C_TO_XEN_DOUBLE(cp->min_dB)); break;
- case CP_SPECTRO_X_ANGLE: return(C_TO_XEN_DOUBLE(cp->spectro_x_angle)); break;
- case CP_SPECTRO_Y_ANGLE: return(C_TO_XEN_DOUBLE(cp->spectro_y_angle)); break;
- case CP_SPECTRO_Z_ANGLE: return(C_TO_XEN_DOUBLE(cp->spectro_z_angle)); break;
- case CP_SPECTRO_X_SCALE: return(C_TO_XEN_DOUBLE(cp->spectro_x_scale)); break;
- case CP_SPECTRO_Y_SCALE: return(C_TO_XEN_DOUBLE(cp->spectro_y_scale)); break;
- case CP_SPECTRO_Z_SCALE: return(C_TO_XEN_DOUBLE(cp->spectro_z_scale)); break;
- case CP_SPECTRUM_END: return(C_TO_XEN_DOUBLE(cp->spectrum_end)); break;
- case CP_SPECTRUM_START: return(C_TO_XEN_DOUBLE(cp->spectrum_start)); break;
- case CP_FFT_WINDOW_ALPHA: return(C_TO_XEN_DOUBLE(cp->fft_window_alpha)); break;
- case CP_FFT_WINDOW_BETA: return(C_TO_XEN_DOUBLE(cp->fft_window_beta)); break;
- case CP_BEATS_PER_MINUTE: return(C_TO_XEN_DOUBLE(cp->beats_per_minute)); break;
- case CP_BEATS_PER_MEASURE: return(C_TO_XEN_INT(cp->beats_per_measure)); break;
- case CP_MAXAMP: return(C_TO_XEN_DOUBLE(channel_maxamp(cp, AT_CURRENT_EDIT_POSITION))); break;
- case CP_EDPOS_MAXAMP: return(C_TO_XEN_DOUBLE(channel_maxamp(cp, to_c_edit_position(cp, cp_edpos, S_maxamp, 3)))); break;
- case CP_MAXAMP_POSITION: return(C_TO_XEN_INT64_T(channel_maxamp_position(cp, AT_CURRENT_EDIT_POSITION))); break;
- case CP_EDPOS_MAXAMP_POSITION: return(C_TO_XEN_INT64_T(channel_maxamp_position(cp, to_c_edit_position(cp, cp_edpos, S_maxamp_position, 3)))); break;
+ case CP_SX: if (cp->axis) return(C_double_to_Xen_real(cp->axis->sx)); break;
+ case CP_SY: if (cp->axis) return(C_double_to_Xen_real(cp->axis->sy)); break;
+ case CP_ZX: if (cp->axis) return(C_double_to_Xen_real(cp->axis->zx)); break;
+ case CP_ZY: if (cp->axis) return(C_double_to_Xen_real(cp->axis->zy)); break;
+ case CP_MIN_DB: return(C_double_to_Xen_real(cp->min_dB)); break;
+ case CP_SPECTRO_X_ANGLE: return(C_double_to_Xen_real(cp->spectro_x_angle)); break;
+ case CP_SPECTRO_Y_ANGLE: return(C_double_to_Xen_real(cp->spectro_y_angle)); break;
+ case CP_SPECTRO_Z_ANGLE: return(C_double_to_Xen_real(cp->spectro_z_angle)); break;
+ case CP_SPECTRO_X_SCALE: return(C_double_to_Xen_real(cp->spectro_x_scale)); break;
+ case CP_SPECTRO_Y_SCALE: return(C_double_to_Xen_real(cp->spectro_y_scale)); break;
+ case CP_SPECTRO_Z_SCALE: return(C_double_to_Xen_real(cp->spectro_z_scale)); break;
+ case CP_SPECTRUM_END: return(C_double_to_Xen_real(cp->spectrum_end)); break;
+ case CP_SPECTRUM_START: return(C_double_to_Xen_real(cp->spectrum_start)); break;
+ case CP_FFT_WINDOW_ALPHA: return(C_double_to_Xen_real(cp->fft_window_alpha)); break;
+ case CP_FFT_WINDOW_BETA: return(C_double_to_Xen_real(cp->fft_window_beta)); break;
+ case CP_BEATS_PER_MINUTE: return(C_double_to_Xen_real(cp->beats_per_minute)); break;
+ case CP_BEATS_PER_MEASURE: return(C_int_to_Xen_integer(cp->beats_per_measure)); break;
+ case CP_MAXAMP: return(C_double_to_Xen_real(channel_maxamp(cp, AT_CURRENT_EDIT_POSITION))); break;
+ case CP_EDPOS_MAXAMP: return(C_double_to_Xen_real(channel_maxamp(cp, to_c_edit_position(cp, cp_edpos, S_maxamp, 3)))); break;
+ case CP_MAXAMP_POSITION: return(C_llong_to_Xen_llong(channel_maxamp_position(cp, AT_CURRENT_EDIT_POSITION))); break;
+ case CP_EDPOS_MAXAMP_POSITION: return(C_llong_to_Xen_llong(channel_maxamp_position(cp, to_c_edit_position(cp, cp_edpos, S_maxamp_position, 3)))); break;
}
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static int g_imin(int mn, XEN val, int def)
+static int g_imin(int mn, Xen val, int def)
{
int nval;
- nval = XEN_TO_C_INT_OR_ELSE(val, def);
+ if (Xen_is_integer(val)) nval = Xen_integer_to_C_int(val); else nval = def;
if (nval >= mn) return(nval);
return(mn);
}
-static int g_omin(mus_long_t mn, XEN val, mus_long_t def)
+static int g_omin(mus_long_t mn, Xen val, mus_long_t def)
{
mus_long_t nval;
- nval = XEN_TO_C_INT64_T_OR_ELSE(val, def);
+ if (Xen_is_llong(val)) nval = Xen_llong_to_C_llong(val); else nval = def;
if (nval >= mn) return(nval);
return(mn);
}
@@ -6471,7 +6714,7 @@ static void reset_y_display(chan_info *cp, double sy, double zy)
ap->sy = sy;
ap->zy = zy;
resize_sy(cp);
- apply_y_axis_change(ap, cp);
+ apply_y_axis_change(cp);
}
@@ -6483,108 +6726,128 @@ static bool call_update_graph = true;
#define MIN_SPECTRO_ANGLE -360.0
-static XEN channel_set(XEN snd, XEN chn_n, XEN on, cp_field_t fld, const char *caller)
+static Xen channel_set(Xen snd, Xen chn_n, Xen on, cp_field_t fld, const char *caller)
{
chan_info *cp;
int val = 0;
bool bval = false;
snd_info *sp;
int i;
- mus_long_t curlen = 0, newlen = 0;
- char *error = NULL;
- mus_float_t curamp;
- mus_float_t newamp[1];
- XEN res = XEN_EMPTY_LIST, errstr;
- if (XEN_TRUE_P(snd))
+ mus_float_t curamp, curf;
+ Xen res = Xen_empty_list;
+ if (Xen_is_true(snd))
{
for (i = ss->max_sounds - 1; i >= 0; i--)
{
sp = ss->sounds[i];
if ((sp) && (sp->inuse == SOUND_NORMAL))
- res = XEN_CONS(channel_set(C_TO_XEN_INT(i), chn_n, on, fld, caller), res);
+ res = Xen_cons(channel_set(C_int_to_Xen_integer(i), chn_n, on, fld, caller), res);
}
return(res);
}
- if (XEN_TRUE_P(chn_n))
+ if (Xen_is_true(chn_n))
{
sp = get_sp(snd);
if (sp == NULL)
return(snd_no_such_sound_error(caller, snd));
for (i = sp->nchans - 1; i >= 0; i--)
- res = XEN_CONS(channel_set(snd, C_TO_XEN_INT(i), on, fld, caller), res);
+ res = Xen_cons(channel_set(snd, C_int_to_Xen_integer(i), on, fld, caller), res);
return(res);
}
- ASSERT_CHANNEL(caller, snd, chn_n, 2);
+ Snd_assert_channel(caller, snd, chn_n, 2);
cp = get_cp(snd, chn_n, caller);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
switch (fld)
{
case CP_EDIT_CTR:
if (cp->editable)
{
- val = XEN_TO_C_INT_OR_ELSE(on, 0);
+ if (Xen_is_integer(on)) val = Xen_integer_to_C_int(on); else val = 0;
if (cp->edit_ctr < val)
redo_edit(cp, val - cp->edit_ctr);
else undo_edit(cp, cp->edit_ctr - val);
}
- return(C_TO_XEN_INT(cp->edit_ctr));
+ return(C_int_to_Xen_integer(cp->edit_ctr));
break;
- case CP_GRAPH_TRANSFORM_P:
- bval = XEN_TO_C_BOOLEAN(on);
+ case CP_GRAPH_TRANSFORM_ON:
+ bval = Xen_boolean_to_C_bool(on);
fftb(cp, bval);
update_graph(cp);
return(on);
break;
- case CP_GRAPH_TIME_P:
- bval = XEN_TO_C_BOOLEAN(on);
+ case CP_GRAPH_TIME_ON:
+ bval = Xen_boolean_to_C_bool(on);
waveb(cp, bval);
update_graph(cp);
return(on);
break;
case CP_CURSOR:
- cp->cursor_on = true;
- cursor_moveto(cp, beg_to_sample(on, caller));
- return(C_TO_XEN_INT64_T(CURSOR(cp)));
+ {
+ mus_long_t samp = 0;
+ if (Xen_is_llong(on)) samp = Xen_llong_to_C_llong(on);
+ if (samp < 0)
+ {
+ cp->cursor_on = false;
+ update_graph(cp);
+ }
+ else
+ {
+ cp->cursor_on = true;
+ cursor_moveto(cp, samp);
+ }
+ cp->original_cursor = samp; /* for snd-dac, track-and-return */
+ return(C_llong_to_Xen_llong(samp));
+ }
break;
case CP_EDPOS_CURSOR:
{
int pos;
- mus_long_t cpos;
+ mus_long_t samp = 0;
pos = to_c_edit_position(cp, cp_edpos, caller, 3);
- cpos = beg_to_sample(on, caller);
- if (pos == cp->edit_ctr)
+ if (Xen_is_llong(on)) samp = Xen_llong_to_C_llong(on);
+ if (samp < 0)
{
- cp->cursor_on = true;
- cursor_moveto(cp, cpos);
+ cp->cursor_on = false;
+ update_graph(cp);
}
- else cp->edits[pos]->cursor = cpos;
- return(C_TO_XEN_INT64_T(cpos));
+ else
+ {
+ if (pos == cp->edit_ctr)
+ {
+ cp->cursor_on = true;
+ cursor_moveto(cp, samp);
+ }
+ else cp->edits[pos]->cursor = samp;
+ }
+ return(C_llong_to_Xen_llong(samp));
}
break;
- case CP_GRAPH_LISP_P:
- cp->graph_lisp_p = XEN_TO_C_BOOLEAN(on);
+ case CP_GRAPH_LISP_ON:
+ cp->graph_lisp_on = Xen_boolean_to_C_bool(on);
update_graph(cp);
return(on);
break;
- case CP_AP_LOSAMP:
+ case CP_LOSAMP:
+ Xen_check_type(Xen_is_integer(on), on, 1, S_set S_left_sample, "an integer");
set_x_axis_x0(cp, beg_to_sample(on, caller));
return(on);
break;
- case CP_AP_HISAMP:
+ case CP_HISAMP:
+ Xen_check_type(Xen_is_integer(on), on, 1, S_set S_right_sample, "an integer");
set_x_axis_x1(cp, beg_to_sample(on, caller));
return(on);
break;
case CP_SQUELCH_UPDATE:
- cp->squelch_update = XEN_TO_C_BOOLEAN(on);
+ cp->squelch_update = Xen_boolean_to_C_bool(on);
if (!(cp->squelch_update))
{
/* make sure everything that was squelched before is now correct */
@@ -6592,24 +6855,25 @@ static XEN channel_set(XEN snd, XEN chn_n, XEN on, cp_field_t fld, const char *c
if (cp->edit_ctr == 0)
reflect_file_revert_in_label(cp->sound);
else reflect_file_change_in_label(cp);
- clear_minibuffer(cp->sound);
+ clear_status_area(cp->sound);
}
break;
case CP_CURSOR_SIZE:
- cp->cursor_size = XEN_TO_C_INT_OR_ELSE(on, DEFAULT_CURSOR_SIZE);
+ cp->cursor_size = Xen_integer_to_C_int(on);
update_graph(cp);
- return(C_TO_XEN_INT(cp->cursor_size));
+ return(C_int_to_Xen_integer(cp->cursor_size));
break;
case CP_CURSOR_STYLE:
- if (XEN_PROCEDURE_P(on))
+ if (Xen_is_procedure(on))
{
- error = procedure_ok(on, 3, S_setB S_cursor_style, "", 1);
+ char *error = NULL;
+ error = procedure_ok(on, 3, S_cursor_style, "", 1);
if (error == NULL)
{
if ((cp->cursor_style == CURSOR_PROC) &&
- (XEN_PROCEDURE_P(cp->cursor_proc)))
+ (Xen_is_procedure(cp->cursor_proc)))
snd_unprotect_at(cp->cursor_proc_loc);
cp->cursor_proc_loc = snd_protect(on);
cp->cursor_proc = on;
@@ -6618,221 +6882,226 @@ static XEN channel_set(XEN snd, XEN chn_n, XEN on, cp_field_t fld, const char *c
}
else
{
- errstr = C_TO_XEN_STRING(error);
+ Xen errstr;
+ errstr = C_string_to_Xen_string(error);
free(error);
- return(snd_bad_arity_error(S_setB S_cursor_style, errstr, on));
+ return(snd_bad_arity_error(S_set S_cursor_style, errstr, on));
}
}
else
{
if ((cp->cursor_style == CURSOR_PROC) &&
- (XEN_PROCEDURE_P(cp->cursor_proc)))
+ (Xen_is_procedure(cp->cursor_proc)))
{
snd_unprotect_at(cp->cursor_proc_loc);
- cp->cursor_proc = XEN_UNDEFINED;
+ cp->cursor_proc = Xen_undefined;
cp->cursor_proc_loc = NOT_A_GC_LOC;
}
- cp->cursor_style = (cursor_style_t)XEN_TO_C_INT(on); /* range already checked */
+ cp->cursor_style = (cursor_style_t)Xen_integer_to_C_int(on); /* range already checked */
}
cp->just_zero = (cp->cursor_style == CURSOR_LINE); /* no point in displaying y value in this case */
update_graph(cp);
- return(C_TO_XEN_INT((int)(cp->cursor_style)));
+ return(C_int_to_Xen_integer((int)(cp->cursor_style)));
break;
case CP_TRACKING_CURSOR_STYLE:
- cp->tracking_cursor_style = (cursor_style_t)XEN_TO_C_INT(on);
- return(C_TO_XEN_INT((int)(cp->tracking_cursor_style)));
+ cp->tracking_cursor_style = (cursor_style_t)Xen_integer_to_C_int(on);
+ return(C_int_to_Xen_integer((int)(cp->tracking_cursor_style)));
break;
case CP_SHOW_Y_ZERO:
- cp->show_y_zero = XEN_TO_C_BOOLEAN(on);
+ cp->show_y_zero = Xen_boolean_to_C_bool(on);
update_graph(cp);
- return(C_TO_XEN_BOOLEAN(cp->show_y_zero));
+ return(C_bool_to_Xen_boolean(cp->show_y_zero));
break;
case CP_SHOW_GRID:
- cp->show_grid = (with_grid_t)(XEN_TO_C_BOOLEAN(on));
+ cp->show_grid = (with_grid_t)(Xen_boolean_to_C_bool(on));
update_graph(cp);
- return(C_TO_XEN_BOOLEAN((bool)(cp->show_grid)));
+ return(C_bool_to_Xen_boolean((bool)(cp->show_grid)));
break;
case CP_GRID_DENSITY:
- cp->grid_density = XEN_TO_C_DOUBLE(on);
+ curf = Xen_real_to_C_double(on);
+ if (curf >= 0.0)
+ cp->grid_density = curf;
+ else Xen_out_of_range_error(S_set S_grid_density, 1, on, "density < 0.0?");
update_graph(cp);
- return(C_TO_XEN_DOUBLE(cp->grid_density));
+ return(C_double_to_Xen_real(cp->grid_density));
break;
case CP_SHOW_SONOGRAM_CURSOR:
- cp->show_sonogram_cursor = XEN_TO_C_BOOLEAN(on);
+ cp->show_sonogram_cursor = Xen_boolean_to_C_bool(on);
update_graph(cp);
- return(C_TO_XEN_BOOLEAN(cp->show_sonogram_cursor));
+ return(C_bool_to_Xen_boolean(cp->show_sonogram_cursor));
break;
case CP_SHOW_MARKS:
- cp->show_marks = XEN_TO_C_BOOLEAN(on);
+ cp->show_marks = Xen_boolean_to_C_bool(on);
update_graph(cp);
- return(C_TO_XEN_BOOLEAN(cp->show_marks));
+ return(C_bool_to_Xen_boolean(cp->show_marks));
break;
case CP_TIME_GRAPH_TYPE:
- cp->time_graph_type = (graph_type_t)XEN_TO_C_INT(on); /* checked already */
+ cp->time_graph_type = (graph_type_t)Xen_integer_to_C_int(on); /* checked already */
update_graph(cp);
- return(C_TO_XEN_INT((int)(cp->time_graph_type)));
+ return(C_int_to_Xen_integer((int)(cp->time_graph_type)));
break;
case CP_WAVO_HOP:
cp->wavo_hop = g_imin(1, on, DEFAULT_WAVO_HOP);
update_graph(cp);
- return(C_TO_XEN_INT(cp->wavo_hop));
+ return(C_int_to_Xen_integer(cp->wavo_hop));
break;
case CP_WAVO_TRACE:
cp->wavo_trace = mus_iclamp(1, g_imin(1, on, DEFAULT_WAVO_TRACE), POINT_BUFFER_SIZE);
update_graph(cp);
- return(C_TO_XEN_INT(cp->wavo_trace));
+ return(C_int_to_Xen_integer(cp->wavo_trace));
break;
case CP_MAX_TRANSFORM_PEAKS:
cp->max_transform_peaks = g_imin(1, on, DEFAULT_MAX_TRANSFORM_PEAKS);
- return(C_TO_XEN_INT(cp->max_transform_peaks));
+ return(C_int_to_Xen_integer(cp->max_transform_peaks));
break;
case CP_ZERO_PAD:
cp->zero_pad = mus_iclamp(0, g_imin(0, on, DEFAULT_ZERO_PAD), MAX_ZERO_PAD);
update_graph(cp);
- return(C_TO_XEN_INT(cp->zero_pad));
+ return(C_int_to_Xen_integer(cp->zero_pad));
break;
case CP_WAVELET_TYPE:
- cp->wavelet_type = XEN_TO_C_INT(on); /* range checked already */
+ cp->wavelet_type = Xen_integer_to_C_int(on); /* range checked already */
update_graph(cp);
- return(C_TO_XEN_INT(cp->wavelet_type));
+ return(C_int_to_Xen_integer(cp->wavelet_type));
break;
case CP_SHOW_TRANSFORM_PEAKS:
- cp->show_transform_peaks = XEN_TO_C_BOOLEAN(on);
+ cp->show_transform_peaks = Xen_boolean_to_C_bool(on);
update_graph(cp);
- return(C_TO_XEN_BOOLEAN(cp->show_transform_peaks));
+ return(C_bool_to_Xen_boolean(cp->show_transform_peaks));
break;
- case CP_VERBOSE_CURSOR:
- cp->verbose_cursor = XEN_TO_C_BOOLEAN(on);
- return(C_TO_XEN_BOOLEAN(cp->verbose_cursor));
+ case CP_WITH_VERBOSE_CURSOR:
+ cp->with_verbose_cursor = Xen_boolean_to_C_bool(on);
+ return(C_bool_to_Xen_boolean(cp->with_verbose_cursor));
break;
case CP_FFT_LOG_FREQUENCY:
- cp->fft_log_frequency = XEN_TO_C_BOOLEAN(on);
- if (cp->graph_transform_p) calculate_fft(cp);
- return(C_TO_XEN_BOOLEAN(cp->fft_log_frequency));
+ cp->fft_log_frequency = Xen_boolean_to_C_bool(on);
+ if (cp->graph_transform_on) calculate_fft(cp);
+ return(C_bool_to_Xen_boolean(cp->fft_log_frequency));
break;
case CP_FFT_LOG_MAGNITUDE:
- cp->fft_log_magnitude = XEN_TO_C_BOOLEAN(on);
- if (cp->graph_transform_p) calculate_fft(cp);
- return(C_TO_XEN_BOOLEAN(cp->fft_log_magnitude));
+ cp->fft_log_magnitude = Xen_boolean_to_C_bool(on);
+ if (cp->graph_transform_on) calculate_fft(cp);
+ return(C_bool_to_Xen_boolean(cp->fft_log_magnitude));
break;
case CP_FFT_WITH_PHASES:
- cp->fft_with_phases = XEN_TO_C_BOOLEAN(on);
- if (cp->graph_transform_p) calculate_fft(cp);
- return(C_TO_XEN_BOOLEAN(cp->fft_with_phases));
+ cp->fft_with_phases = Xen_boolean_to_C_bool(on);
+ if (cp->graph_transform_on) calculate_fft(cp);
+ return(C_bool_to_Xen_boolean(cp->fft_with_phases));
break;
case CP_SPECTRO_HOP:
cp->spectro_hop = g_imin(1, on, DEFAULT_SPECTRO_HOP);
- if (cp->graph_transform_p) calculate_fft(cp);
- return(C_TO_XEN_INT(cp->spectro_hop));
+ if (cp->graph_transform_on) calculate_fft(cp);
+ return(C_int_to_Xen_integer(cp->spectro_hop));
break;
case CP_TRANSFORM_SIZE:
cp->transform_size = g_omin(1, on, DEFAULT_TRANSFORM_SIZE);
calculate_fft(cp);
- return(C_TO_XEN_INT64_T(cp->transform_size));
+ return(C_llong_to_Xen_llong(cp->transform_size));
break;
case CP_TRANSFORM_GRAPH_TYPE:
- cp->transform_graph_type = (graph_type_t)XEN_TO_C_INT(on); /* checked already */
+ cp->transform_graph_type = (graph_type_t)Xen_integer_to_C_int(on); /* checked already */
calculate_fft(cp);
- return(C_TO_XEN_INT((int)(cp->transform_graph_type)));
+ return(C_int_to_Xen_integer((int)(cp->transform_graph_type)));
break;
case CP_FFT_WINDOW:
- cp->fft_window = (mus_fft_window_t)XEN_TO_C_INT(on); /* checked */
+ cp->fft_window = (mus_fft_window_t)Xen_integer_to_C_int(on); /* checked */
calculate_fft(cp);
- return(C_TO_XEN_INT((int)(cp->fft_window)));
+ return(C_int_to_Xen_integer((int)(cp->fft_window)));
break;
case CP_TRANSFORM_TYPE:
- cp->transform_type = XEN_TRANSFORM_TO_C_INT(on);
+ cp->transform_type = Xen_transform_to_C_int(on);
calculate_fft(cp);
- return(C_INT_TO_XEN_TRANSFORM(cp->transform_type));
+ return(C_int_to_Xen_transform(cp->transform_type));
break;
case CP_TRANSFORM_NORMALIZATION:
- cp->transform_normalization = (fft_normalize_t)XEN_TO_C_INT(on); /* range already checked */
+ cp->transform_normalization = (fft_normalize_t)Xen_integer_to_C_int(on); /* range already checked */
calculate_fft(cp);
- return(C_TO_XEN_INT((int)(cp->transform_normalization)));
+ return(C_int_to_Xen_integer((int)(cp->transform_normalization)));
break;
case CP_SHOW_MIX_WAVEFORMS:
- cp->show_mix_waveforms = XEN_TO_C_BOOLEAN(on);
+ cp->show_mix_waveforms = Xen_boolean_to_C_bool(on);
update_graph(cp);
- return(C_TO_XEN_BOOLEAN(cp->show_mix_waveforms));
+ return(C_bool_to_Xen_boolean(cp->show_mix_waveforms));
break;
case CP_TIME_GRAPH_STYLE:
- cp->time_graph_style = (graph_style_t)XEN_TO_C_INT_OR_ELSE(on, (int)DEFAULT_GRAPH_STYLE);
+ cp->time_graph_style = (Xen_is_integer(on)) ? (graph_style_t)Xen_integer_to_C_int(on) : DEFAULT_GRAPH_STYLE;
if (call_update_graph) update_graph(cp);
- return(C_TO_XEN_INT((int)(cp->time_graph_style)));
+ return(C_int_to_Xen_integer((int)(cp->time_graph_style)));
break;
case CP_LISP_GRAPH_STYLE:
- cp->lisp_graph_style = (graph_style_t)XEN_TO_C_INT_OR_ELSE(on, (int)DEFAULT_GRAPH_STYLE);
+ cp->lisp_graph_style = (Xen_is_integer(on)) ? (graph_style_t)Xen_integer_to_C_int(on) : DEFAULT_GRAPH_STYLE;
if (call_update_graph) update_graph(cp);
- return(C_TO_XEN_INT((int)(cp->lisp_graph_style)));
+ return(C_int_to_Xen_integer((int)(cp->lisp_graph_style)));
break;
case CP_TRANSFORM_GRAPH_STYLE:
- cp->transform_graph_style = (graph_style_t)XEN_TO_C_INT_OR_ELSE(on, (int)DEFAULT_GRAPH_STYLE);
+ cp->transform_graph_style = (Xen_is_integer(on)) ? (graph_style_t)Xen_integer_to_C_int(on) : DEFAULT_GRAPH_STYLE;
if (call_update_graph) update_graph(cp);
- return(C_TO_XEN_INT((int)(cp->transform_graph_style)));
+ return(C_int_to_Xen_integer((int)(cp->transform_graph_style)));
break;
case CP_X_AXIS_STYLE:
- val = XEN_TO_C_INT(on); /* range already checked */
+ val = Xen_integer_to_C_int(on); /* range already checked */
chans_x_axis_style(cp, val);
- return(C_TO_XEN_INT((int)(cp->x_axis_style)));
+ return(C_int_to_Xen_integer((int)(cp->x_axis_style)));
break;
case CP_DOT_SIZE:
cp->dot_size = mus_iclamp(MIN_DOT_SIZE,
- XEN_TO_C_INT_OR_ELSE(on, DEFAULT_DOT_SIZE),
+ (Xen_is_integer(on)) ? Xen_integer_to_C_int(on) : DEFAULT_DOT_SIZE,
MAX_DOT_SIZE); /* size > 17000 -> X segfault! */
update_graph(cp);
- return(C_TO_XEN_INT(cp->dot_size));
+ return(C_int_to_Xen_integer(cp->dot_size));
break;
case CP_SHOW_AXES:
- cp->show_axes = (show_axes_t)XEN_TO_C_INT(on); /* range checked already */
+ cp->show_axes = (show_axes_t)Xen_integer_to_C_int(on); /* range checked already */
update_graph(cp);
- return(C_TO_XEN_INT((int)(cp->show_axes)));
+ return(C_int_to_Xen_integer((int)(cp->show_axes)));
break;
case CP_GRAPHS_HORIZONTAL:
- cp->graphs_horizontal = XEN_TO_C_BOOLEAN(on);
+ cp->graphs_horizontal = Xen_boolean_to_C_bool(on);
update_graph(cp);
- return(C_TO_XEN_BOOLEAN(cp->graphs_horizontal));
+ return(C_bool_to_Xen_boolean(cp->graphs_horizontal));
break;
- case CP_FRAMES:
+ case CP_FRAMPLES:
if (cp->editable)
{
+ mus_long_t curlen, newlen;
bool need_update = true;
/* if less than current, delete, else zero pad */
- curlen = CURRENT_SAMPLES(cp);
- newlen = XEN_TO_C_INT64_T_OR_ELSE(on, curlen);
+ curlen = current_samples(cp);
+ newlen = (Xen_is_llong(on)) ? Xen_llong_to_C_llong(on) : curlen;
if (newlen < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_frames, 1, on, "frames (~A) < 0?");
+ Xen_out_of_range_error(S_set S_framples, 1, on, "framples < 0?");
if (curlen > newlen)
{
if (newlen > 0)
@@ -6842,7 +7111,7 @@ static XEN channel_set(XEN snd, XEN chn_n, XEN on, cp_field_t fld, const char *c
else
{
if (newlen > curlen)
- extend_with_zeros(cp, curlen, newlen - curlen, cp->edit_ctr, S_setB S_frames);
+ extend_with_zeros(cp, curlen, newlen - curlen, cp->edit_ctr, S_set S_framples);
}
if (need_update)
update_graph(cp);
@@ -6850,79 +7119,82 @@ static XEN channel_set(XEN snd, XEN chn_n, XEN on, cp_field_t fld, const char *c
break;
case CP_PROPERTIES:
- if (!(XEN_VECTOR_P(cp->properties)))
+ if (!(Xen_is_vector(cp->properties)))
{
- cp->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ cp->properties = Xen_make_vector(1, Xen_empty_list);
cp->properties_loc = snd_protect(cp->properties);
}
- XEN_VECTOR_SET(cp->properties, 0, on);
- return(XEN_VECTOR_REF(cp->properties, 0));
+ Xen_vector_set(cp->properties, 0, on);
+ return(Xen_vector_ref(cp->properties, 0));
break;
- case CP_AP_SX:
- reset_x_display(cp, mus_fclamp(0.0, XEN_TO_C_DOUBLE(on), 1.0), cp->axis->zx);
+ case CP_SX:
+ reset_x_display(cp, mus_fclamp(0.0, Xen_real_to_C_double(on), 1.0), cp->axis->zx);
break;
- case CP_AP_ZX:
- reset_x_display(cp, cp->axis->sx, mus_fclamp(0.0, XEN_TO_C_DOUBLE(on), 1.0));
+ case CP_ZX:
+ cp->axis->zx = mus_fclamp(0.0, Xen_real_to_C_double(on), 1.0);
+ focus_x_axis_change(cp, zoom_focus_style(ss));
+ resize_sx_and_zx(cp);
break;
- case CP_AP_SY:
- reset_y_display(cp, mus_fclamp(0.0, XEN_TO_C_DOUBLE(on), 1.0), cp->axis->zy);
+ case CP_SY:
+ reset_y_display(cp, mus_fclamp(0.0, Xen_real_to_C_double(on), 1.0), cp->axis->zy);
break;
- case CP_AP_ZY:
- reset_y_display(cp, cp->axis->sy, mus_fclamp(0.0, XEN_TO_C_DOUBLE(on), 1.0));
+ case CP_ZY:
+ reset_y_display(cp, cp->axis->sy, mus_fclamp(0.0, Xen_real_to_C_double(on), 1.0));
break;
case CP_MIN_DB:
- curamp = XEN_TO_C_DOUBLE(on);
+ curamp = Xen_real_to_C_double(on);
if (curamp < 0.0)
{
cp->min_dB = curamp;
cp->lin_dB = pow(10.0, cp->min_dB * 0.05);
calculate_fft(cp);
}
- else XEN_OUT_OF_RANGE_ERROR(caller, 1, on, S_min_dB " (~A) must be < 0.0");
+ else Xen_out_of_range_error(caller, 1, on, S_min_dB " should be < 0.0");
break;
- case CP_SPECTRO_X_ANGLE: cp->spectro_x_angle = mus_fclamp(MIN_SPECTRO_ANGLE, XEN_TO_C_DOUBLE(on), MAX_SPECTRO_ANGLE); calculate_fft(cp); break;
- case CP_SPECTRO_Y_ANGLE: cp->spectro_y_angle = mus_fclamp(MIN_SPECTRO_ANGLE, XEN_TO_C_DOUBLE(on), MAX_SPECTRO_ANGLE); calculate_fft(cp); break;
- case CP_SPECTRO_Z_ANGLE: cp->spectro_z_angle = mus_fclamp(MIN_SPECTRO_ANGLE, XEN_TO_C_DOUBLE(on), MAX_SPECTRO_ANGLE); calculate_fft(cp); break;
+ case CP_SPECTRO_X_ANGLE: cp->spectro_x_angle = mus_fclamp(MIN_SPECTRO_ANGLE, Xen_real_to_C_double(on), MAX_SPECTRO_ANGLE); calculate_fft(cp); break;
+ case CP_SPECTRO_Y_ANGLE: cp->spectro_y_angle = mus_fclamp(MIN_SPECTRO_ANGLE, Xen_real_to_C_double(on), MAX_SPECTRO_ANGLE); calculate_fft(cp); break;
+ case CP_SPECTRO_Z_ANGLE: cp->spectro_z_angle = mus_fclamp(MIN_SPECTRO_ANGLE, Xen_real_to_C_double(on), MAX_SPECTRO_ANGLE); calculate_fft(cp); break;
- case CP_SPECTRO_X_SCALE: cp->spectro_x_scale = mus_fclamp(0.0, XEN_TO_C_DOUBLE(on), MAX_SPECTRO_SCALE); calculate_fft(cp); break;
- case CP_SPECTRO_Y_SCALE: cp->spectro_y_scale = mus_fclamp(0.0, XEN_TO_C_DOUBLE(on), MAX_SPECTRO_SCALE); calculate_fft(cp); break;
- case CP_SPECTRO_Z_SCALE: cp->spectro_z_scale = mus_fclamp(0.0, XEN_TO_C_DOUBLE(on), MAX_SPECTRO_SCALE); calculate_fft(cp); break;
+ case CP_SPECTRO_X_SCALE: cp->spectro_x_scale = mus_fclamp(0.0, Xen_real_to_C_double(on), MAX_SPECTRO_SCALE); calculate_fft(cp); break;
+ case CP_SPECTRO_Y_SCALE: cp->spectro_y_scale = mus_fclamp(0.0, Xen_real_to_C_double(on), MAX_SPECTRO_SCALE); calculate_fft(cp); break;
+ case CP_SPECTRO_Z_SCALE: cp->spectro_z_scale = mus_fclamp(0.0, Xen_real_to_C_double(on), MAX_SPECTRO_SCALE); calculate_fft(cp); break;
case CP_SPECTRUM_END:
- cp->spectrum_end = XEN_TO_C_DOUBLE(on); /* range checked already */
+ cp->spectrum_end = Xen_real_to_C_double(on); /* range checked already */
calculate_fft(cp);
- return(C_TO_XEN_DOUBLE(cp->spectrum_end));
+ return(C_double_to_Xen_real(cp->spectrum_end));
break;
case CP_SPECTRUM_START:
- cp->spectrum_start = XEN_TO_C_DOUBLE(on); /* range checked already */
+ cp->spectrum_start = Xen_real_to_C_double(on); /* range checked already */
calculate_fft(cp);
- return(C_TO_XEN_DOUBLE(cp->spectrum_start));
+ return(C_double_to_Xen_real(cp->spectrum_start));
break;
case CP_FFT_WINDOW_ALPHA:
- cp->fft_window_alpha = XEN_TO_C_DOUBLE(on);
+ cp->fft_window_alpha = Xen_real_to_C_double(on);
calculate_fft(cp);
- return(C_TO_XEN_DOUBLE(cp->fft_window_alpha));
+ return(C_double_to_Xen_real(cp->fft_window_alpha));
break;
case CP_FFT_WINDOW_BETA:
- cp->fft_window_beta = XEN_TO_C_DOUBLE(on); /* range checked already */
+ cp->fft_window_beta = Xen_real_to_C_double(on); /* range checked already */
calculate_fft(cp);
- return(C_TO_XEN_DOUBLE(cp->fft_window_beta));
+ return(C_double_to_Xen_real(cp->fft_window_beta));
break;
case CP_MAXAMP:
if (cp->editable)
{
+ mus_float_t newamp[1];
curamp = channel_maxamp(cp, AT_CURRENT_EDIT_POSITION);
- newamp[0] = XEN_TO_C_DOUBLE(on);
+ newamp[0] = Xen_real_to_C_double(on);
if (curamp != newamp[0])
{
if (scale_to(cp->sound, cp, newamp, 1, false))
@@ -6932,7 +7204,7 @@ static XEN channel_set(XEN snd, XEN chn_n, XEN on, cp_field_t fld, const char *c
break;
case CP_BEATS_PER_MINUTE:
- curamp = XEN_TO_C_DOUBLE(on);
+ curamp = Xen_real_to_C_double(on);
if (curamp > 0.0)
{
cp->beats_per_minute = curamp;
@@ -6941,108 +7213,108 @@ static XEN channel_set(XEN snd, XEN chn_n, XEN on, cp_field_t fld, const char *c
break;
case CP_BEATS_PER_MEASURE:
- cp->beats_per_measure = XEN_TO_C_INT(on);
+ cp->beats_per_measure = Xen_integer_to_C_int(on);
update_graph(cp);
return(on);
break;
default:
break;
}
- return(C_TO_XEN_BOOLEAN(val));
+ return(C_bool_to_Xen_boolean(val));
}
-static XEN g_update_time_graph(XEN snd, XEN chn)
+static Xen g_update_time_graph(Xen snd, Xen chn)
{
#define H_update_time_graph "(" S_update_time_graph " :optional snd chn): redraw snd channel chn's graphs"
return(channel_get(snd, chn, CP_UPDATE_TIME, S_update_time_graph));
}
-static XEN g_update_transform_graph(XEN snd, XEN chn)
+static Xen g_update_transform_graph(Xen snd, Xen chn)
{
#define H_update_transform_graph "(" S_update_transform_graph " :optional snd chn): redraw snd channel chn's fft display"
return(channel_get(snd, chn, CP_UPDATE_TRANSFORM_GRAPH, S_update_transform_graph));
}
-static XEN g_update_lisp_graph(XEN snd, XEN chn)
+static Xen g_update_lisp_graph(Xen snd, Xen chn)
{
#define H_update_lisp_graph "(" S_update_lisp_graph " :optional snd chn): redraw snd channel chn's lisp graph"
return(channel_get(snd, chn, CP_UPDATE_LISP, S_update_lisp_graph));
}
-static XEN g_edit_position(XEN snd, XEN chn_n)
+static Xen g_edit_position(Xen snd, Xen chn_n)
{
#define H_edit_position "(" S_edit_position " :optional snd chn): current edit history position in snd's channel chn"
return(channel_get(snd, chn_n, CP_EDIT_CTR, S_edit_position));
}
-static XEN g_set_edit_position(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_edit_position(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(on), on, XEN_ARG_1, S_setB S_edit_position, "an integer");
- return(channel_set(snd, chn_n, on, CP_EDIT_CTR, S_setB S_edit_position));
+ Xen_check_type(Xen_is_integer(on), on, 1, S_set S_edit_position, "an integer");
+ return(channel_set(snd, chn_n, on, CP_EDIT_CTR, S_set S_edit_position));
}
-WITH_THREE_SETTER_ARGS(g_set_edit_position_reversed, g_set_edit_position)
+with_three_setter_args(g_set_edit_position_reversed, g_set_edit_position)
-static XEN g_transform_graph_p(XEN snd, XEN chn_n)
+static Xen g_transform_graph_on(Xen snd, Xen chn_n)
{
- #define H_transform_graph_p "(" S_transform_graph_p " :optional snd chn): " PROC_TRUE " if fft display is active in snd's channel chn"
- return(channel_get(snd, chn_n, CP_GRAPH_TRANSFORM_P, S_transform_graph_p));
+ #define H_transform_graph_on "(" S_transform_graph_on " :optional snd chn): " PROC_TRUE " if fft display is active in snd's channel chn"
+ return(channel_get(snd, chn_n, CP_GRAPH_TRANSFORM_ON, S_transform_graph_on));
}
-static XEN g_set_transform_graph_p(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_transform_graph_on(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_transform_graph_p, "a boolean");
- return(channel_set(snd, chn_n, on, CP_GRAPH_TRANSFORM_P, S_setB S_transform_graph_p));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_transform_graph_on, "a boolean");
+ return(channel_set(snd, chn_n, on, CP_GRAPH_TRANSFORM_ON, S_set S_transform_graph_on));
}
-WITH_THREE_SETTER_ARGS(g_set_transform_graph_p_reversed, g_set_transform_graph_p)
+with_three_setter_args(g_set_transform_graph_on_reversed, g_set_transform_graph_on)
-static XEN g_time_graph_p(XEN snd, XEN chn_n)
+static Xen g_timer_graph_on(Xen snd, Xen chn_n)
{
- #define H_time_graph_p "(" S_time_graph_p " :optional snd chn): " PROC_TRUE " if time domain display is active in snd's channel chn"
- return(channel_get(snd, chn_n, CP_GRAPH_TIME_P, S_time_graph_p));
+ #define H_timer_graph_on "(" S_time_graph_on " :optional snd chn): " PROC_TRUE " if time domain display is active in snd's channel chn"
+ return(channel_get(snd, chn_n, CP_GRAPH_TIME_ON, S_time_graph_on));
}
-static XEN g_set_time_graph_p(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_timer_graph_on(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_time_graph_p, "a boolean");
- return(channel_set(snd, chn_n, on, CP_GRAPH_TIME_P, S_setB S_time_graph_p));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_time_graph_on, "a boolean");
+ return(channel_set(snd, chn_n, on, CP_GRAPH_TIME_ON, S_set S_time_graph_on));
}
-WITH_THREE_SETTER_ARGS(g_set_time_graph_p_reversed, g_set_time_graph_p)
+with_three_setter_args(g_set_timer_graph_on_reversed, g_set_timer_graph_on)
-static XEN g_lisp_graph_p(XEN snd, XEN chn_n)
+static Xen g_lisp_graph_on(Xen snd, Xen chn_n)
{
- #define H_lisp_graph_p "(" S_lisp_graph_p " :optional snd chn): " PROC_TRUE " if lisp-generated data display is active in snd's channel chn"
- return(channel_get(snd, chn_n, CP_GRAPH_LISP_P, S_lisp_graph_p));
+ #define H_lisp_graph_on "(" S_lisp_graph_on " :optional snd chn): " PROC_TRUE " if lisp-generated data display is active in snd's channel chn"
+ return(channel_get(snd, chn_n, CP_GRAPH_LISP_ON, S_lisp_graph_on));
}
-static XEN g_set_lisp_graph_p(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_lisp_graph_on(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_lisp_graph_p, "a boolean");
- return(channel_set(snd, chn_n, on, CP_GRAPH_LISP_P, S_setB S_lisp_graph_p));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_lisp_graph_on, "a boolean");
+ return(channel_set(snd, chn_n, on, CP_GRAPH_LISP_ON, S_set S_lisp_graph_on));
}
-WITH_THREE_SETTER_ARGS(g_set_lisp_graph_p_reversed, g_set_lisp_graph_p)
+with_three_setter_args(g_set_lisp_graph_on_reversed, g_set_lisp_graph_on)
-static XEN g_cursor(XEN snd, XEN chn_n, XEN edpos)
+static Xen g_cursor(Xen snd, Xen chn_n, Xen edpos)
{
#define H_cursor "(" S_cursor " :optional snd chn edpos): current cursor location in snd's channel chn"
- if (XEN_BOUND_P(edpos))
+ if (Xen_is_bound(edpos))
{
- XEN res;
+ Xen res;
if (cp_edpos_loc != NOT_A_GC_LOC)
snd_unprotect_at(cp_edpos_loc);
cp_edpos = edpos;
@@ -7055,68 +7327,67 @@ static XEN g_cursor(XEN snd, XEN chn_n, XEN edpos)
return(channel_get(snd, chn_n, CP_CURSOR, S_cursor));
}
-static XEN g_set_cursor(XEN on, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_set_cursor(Xen on, Xen snd, Xen chn_n, Xen edpos)
{
- XEN_ASSERT_TYPE(XEN_INT64_T_P(on) || XEN_NOT_BOUND_P(on), on, XEN_ARG_1, S_setB S_cursor, "an integer");
- if (XEN_BOUND_P(edpos))
+ Xen_check_type(Xen_is_llong(on) || !Xen_is_bound(on), on, 1, S_set S_cursor, "an integer");
+ if (Xen_is_bound(edpos))
{
- XEN res;
+ Xen res;
if (cp_edpos_loc != NOT_A_GC_LOC)
snd_unprotect_at(cp_edpos_loc);
cp_edpos = edpos;
cp_edpos_loc = snd_protect(cp_edpos);
- res = channel_set(snd, chn_n, on, CP_EDPOS_CURSOR, S_setB S_cursor);
+ res = channel_set(snd, chn_n, on, CP_EDPOS_CURSOR, S_set S_cursor);
snd_unprotect_at(cp_edpos_loc);
cp_edpos_loc = NOT_A_GC_LOC;
return(res);
}
- return(channel_set(snd, chn_n, on, CP_CURSOR, S_setB S_cursor));
+ return(channel_set(snd, chn_n, on, CP_CURSOR, S_set S_cursor));
}
-WITH_FOUR_SETTER_ARGS(g_set_cursor_reversed, g_set_cursor)
+with_four_setter_args(g_set_cursor_reversed, g_set_cursor)
-static XEN g_cursor_style(XEN snd, XEN chn_n)
+static Xen g_cursor_style(Xen snd, Xen chn_n)
{
#define H_cursor_style "(" S_cursor_style " :optional snd chn): current cursor style in snd's channel chn. \
Possible values are " S_cursor_cross " (default), " S_cursor_line " (a vertical line), or a procedure of three arguments, the \
sound index, channel number, and graph (always " S_time_graph "). The procedure \
should draw the cursor at the current cursor position using the " S_cursor_context "."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn_n, CP_CURSOR_STYLE, S_cursor_style));
if (cursor_style(ss) == CURSOR_PROC)
return(ss->cursor_proc);
- return(C_TO_XEN_INT((int)(cursor_style(ss))));
+ return(C_int_to_Xen_integer((int)(cursor_style(ss))));
}
-static XEN g_set_cursor_style(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_cursor_style(Xen on, Xen snd, Xen chn_n)
{
cursor_style_t val = CURSOR_PROC;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(on) || XEN_PROCEDURE_P(on), on, XEN_ARG_1, S_setB S_cursor_style, "an integer or a function");
- if (XEN_INTEGER_P(on))
+ Xen_check_type(Xen_is_integer(on) || Xen_is_procedure(on), on, 1, S_set S_cursor_style, "an integer or a function");
+ if (Xen_is_integer(on))
{
int choice;
- choice = XEN_TO_C_INT(on);
+ choice = Xen_integer_to_C_int(on);
if (choice < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_cursor_style, 1, on, "~A, but must be >= 0");
+ Xen_out_of_range_error(S_set S_cursor_style, 1, on, S_cursor_style " should be " S_cursor_cross " or " S_cursor_line ", or a procedure");
val = (cursor_style_t)choice;
if (val > CURSOR_LINE)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_cursor_style, 1, on, "~A, but must be " S_cursor_cross " or " S_cursor_line ", or a procedure");
+ Xen_out_of_range_error(S_set S_cursor_style, 1, on, S_cursor_style " should be " S_cursor_cross " or " S_cursor_line ", or a procedure");
}
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn_n, on, CP_CURSOR_STYLE, S_setB S_cursor_style));
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn_n, on, CP_CURSOR_STYLE, S_set S_cursor_style));
else
{
- if (XEN_PROCEDURE_P(on))
+ if (Xen_is_procedure(on))
{
char *error;
- XEN errstr;
- error = procedure_ok(on, 3, S_setB S_cursor_style, "", 1);
+ error = procedure_ok(on, 3, S_cursor_style, "", 1);
if (error == NULL)
{
- if ((cursor_style(ss) == CURSOR_PROC) && (XEN_PROCEDURE_P(ss->cursor_proc)))
+ if ((cursor_style(ss) == CURSOR_PROC) && (Xen_is_procedure(ss->cursor_proc)))
snd_unprotect_at(ss->cursor_proc_loc);
ss->cursor_proc_loc = snd_protect(on);
ss->cursor_proc = on;
@@ -7124,9 +7395,10 @@ static XEN g_set_cursor_style(XEN on, XEN snd, XEN chn_n)
}
else
{
- errstr = C_TO_XEN_STRING(error);
+ Xen errstr;
+ errstr = C_string_to_Xen_string(error);
free(error);
- return(snd_bad_arity_error(S_setB S_cursor_style, errstr, on));
+ return(snd_bad_arity_error(S_set S_cursor_style, errstr, on));
}
}
set_cursor_style(val);
@@ -7134,216 +7406,186 @@ static XEN g_set_cursor_style(XEN on, XEN snd, XEN chn_n)
}
}
-WITH_THREE_SETTER_ARGS(g_set_cursor_style_reversed, g_set_cursor_style)
+with_three_setter_args(g_set_cursor_style_reversed, g_set_cursor_style)
-static XEN g_tracking_cursor_style(XEN snd, XEN chn_n)
+static Xen g_tracking_cursor_style(Xen snd, Xen chn_n)
{
#define H_tracking_cursor_style "(" S_tracking_cursor_style " :optional snd chn): current tracking cursor style in snd's channel chn. \
Possible values are " S_cursor_cross " (default), and " S_cursor_line "."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn_n, CP_TRACKING_CURSOR_STYLE, S_tracking_cursor_style));
- return(C_TO_XEN_INT((int)(tracking_cursor_style(ss))));
+ return(C_int_to_Xen_integer((int)(tracking_cursor_style(ss))));
}
-static XEN g_set_tracking_cursor_style(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_tracking_cursor_style(Xen on, Xen snd, Xen chn_n)
{
int in_val;
cursor_style_t val = CURSOR_CROSS;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(on), on, XEN_ARG_1, S_setB S_tracking_cursor_style, "an integer");
- in_val = XEN_TO_C_INT(on);
+ Xen_check_type(Xen_is_integer(on), on, 1, S_set S_tracking_cursor_style, "an integer");
+ in_val = Xen_integer_to_C_int(on);
if (in_val < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_tracking_cursor_style, 1, on, "~A, but must be >= 0");
+ Xen_out_of_range_error(S_set S_tracking_cursor_style, 1, on, S_tracking_cursor_style " should be " S_cursor_cross " or " S_cursor_line);
val = (cursor_style_t)in_val;
if (val > CURSOR_LINE)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_tracking_cursor_style, 1, on, "~A, but must be " S_cursor_cross " or " S_cursor_line);
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn_n, on, CP_TRACKING_CURSOR_STYLE, S_setB S_tracking_cursor_style));
+ Xen_out_of_range_error(S_set S_tracking_cursor_style, 1, on, S_tracking_cursor_style " should be " S_cursor_cross " or " S_cursor_line);
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn_n, on, CP_TRACKING_CURSOR_STYLE, S_set S_tracking_cursor_style));
else set_tracking_cursor_style(val);
return(on);
}
-WITH_THREE_SETTER_ARGS(g_set_tracking_cursor_style_reversed, g_set_tracking_cursor_style)
+with_three_setter_args(g_set_tracking_cursor_style_reversed, g_set_tracking_cursor_style)
-static XEN g_cursor_size(XEN snd, XEN chn_n)
+static Xen g_cursor_size(Xen snd, Xen chn_n)
{
#define H_cursor_size "(" S_cursor_size " :optional snd chn): current cursor size in snd's channel chn"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn_n, CP_CURSOR_SIZE, S_cursor_size));
- return(C_TO_XEN_INT(cursor_size(ss)));
+ return(C_int_to_Xen_integer(cursor_size(ss)));
}
-static XEN g_set_cursor_size(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_cursor_size(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(on), on, XEN_ARG_1, S_setB S_cursor_size, "an integer");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn_n, on, CP_CURSOR_SIZE, S_setB S_cursor_size));
- set_cursor_size(XEN_TO_C_INT_OR_ELSE(on, DEFAULT_CURSOR_SIZE));
- return(C_TO_XEN_INT(cursor_size(ss)));
+ Xen_check_type(Xen_is_integer(on) && (Xen_integer_to_C_int(on) > 0), on, 1, S_set S_cursor_size, "an integer");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn_n, on, CP_CURSOR_SIZE, S_set S_cursor_size));
+ set_cursor_size(Xen_integer_to_C_int(on));
+ return(C_int_to_Xen_integer(cursor_size(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_cursor_size_reversed, g_set_cursor_size)
+with_three_setter_args(g_set_cursor_size_reversed, g_set_cursor_size)
-static XEN g_cursor_position(XEN snd, XEN chn)
+static Xen g_cursor_position(Xen snd, Xen chn)
{
#define H_cursor_position "(" S_cursor_position " :optional snd chn): current cursor position (x y in pixels) in snd's channel chn"
return(channel_get(snd, chn, CP_CURSOR_POSITION, S_cursor_position));
}
-XEN g_frames(XEN snd, XEN chn, XEN edpos)
+Xen g_framples(Xen snd, Xen chn, Xen edpos)
{
- #define H_frames "(" S_frames " :optional snd-or-object chn edpos): number of frames of data in the given object or channel"
+ #define H_framples "(" S_framples " :optional snd-or-object chn edpos): number of framples of data in the given object or channel"
- if (!(XEN_BOUND_P(chn)))
+ if (!(Xen_is_bound(chn)))
{
- if ((XEN_SOUND_P(snd)) || (!XEN_BOUND_P(snd)))
- return(channel_get(snd, chn, CP_FRAMES, S_frames));
+ if ((xen_is_sound(snd)) || (!Xen_is_bound(snd)))
+ return(channel_get(snd, chn, CP_FRAMPLES, S_framples));
- if (XEN_STRING_P(snd))
- return(g_mus_sound_frames(snd)); /* mus-sound-frames */
+ if (Xen_is_string(snd))
+ return(g_mus_sound_framples(snd)); /* mus-sound-framples */
- if (mus_xen_p(snd)) /* mus-length */
+ if (mus_is_xen(snd)) /* mus-length */
return(g_mus_length(snd));
- if (sound_data_p(snd)) /* sound-data-length */
- return(C_TO_XEN_INT64_T((XEN_TO_SOUND_DATA(snd))->length));
-
- if (MUS_VCT_P(snd)) /* vct-length */
- return(C_TO_XEN_INT64_T((XEN_TO_VCT(snd))->length));
+ if (mus_is_vct(snd)) /* vct-length */
+ return(C_llong_to_Xen_llong(mus_vct_length(Xen_to_vct(snd))));
- if (XEN_MIX_P(snd)) /* mix-length */
+ if (xen_is_mix(snd)) /* mix-length */
return(g_mix_length(snd));
- if (XEN_REGION_P(snd)) /* region-frames */
- return(g_region_frames(snd, XEN_ZERO));
+ if (xen_is_region(snd)) /* region-framples */
+ return(g_region_framples(snd, Xen_integer_zero));
- if (XEN_PLAYER_P(snd))
+ if (xen_is_player(snd))
{
snd_info *sp;
sp = get_player_sound(snd);
- return(C_TO_XEN_INT64_T(CURRENT_SAMPLES(sp->chans[0])));
+ return(C_llong_to_Xen_llong(current_samples(sp->chans[0])));
}
}
- if (XEN_SELECTION_P(snd))
- return(g_selection_frames(chn, edpos));
+ if (xen_is_selection(snd))
+ return(g_selection_framples(chn, edpos));
- if (XEN_BOUND_P(edpos))
+ if (Xen_is_bound(edpos))
{
- XEN res;
+ Xen res;
if (cp_edpos_loc != NOT_A_GC_LOC)
snd_unprotect_at(cp_edpos_loc);
cp_edpos = edpos;
cp_edpos_loc = snd_protect(cp_edpos);
- res = channel_get(snd, chn, CP_EDPOS_FRAMES, S_frames);
+ res = channel_get(snd, chn, CP_EDPOS_FRAMPLES, S_framples);
snd_unprotect_at(cp_edpos_loc);
cp_edpos_loc = NOT_A_GC_LOC;
return(res);
}
- return(channel_get(snd, chn, CP_FRAMES, S_frames));
+ return(channel_get(snd, chn, CP_FRAMPLES, S_framples));
}
-static XEN g_set_frames(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_framples(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_frames, "a number");
- return(channel_set(snd, chn_n, on, CP_FRAMES, S_setB S_frames));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_framples, "a number");
+ return(channel_set(snd, chn_n, on, CP_FRAMPLES, S_set S_framples));
}
-WITH_THREE_SETTER_ARGS(g_set_frames_reversed, g_set_frames)
+with_three_setter_args(g_set_framples_reversed, g_set_framples)
-static XEN g_vector_maxamp(XEN obj)
+static Xen g_vector_maxamp(Xen obj)
{
double mx = 0.0;
int i, len;
- len = XEN_VECTOR_LENGTH(obj);
+ len = Xen_vector_length(obj);
for (i = 0; i < len; i++)
{
- XEN el;
- el = XEN_VECTOR_REF(obj, i);
- if (XEN_NUMBER_P(el))
+ Xen el;
+ el = Xen_vector_ref(obj, i);
+ if (Xen_is_number(el))
{
double temp;
- temp = fabs(XEN_TO_C_DOUBLE(el));
+ temp = fabs(Xen_real_to_C_double(el));
if (temp > mx) mx = temp;
}
/* should we trigger an error here? */
}
- return(C_TO_XEN_DOUBLE(mx));
+ return(C_double_to_Xen_real(mx));
}
-
-static XEN g_list_maxamp(XEN obj)
-{
- double mx = 0.0;
- int i, len;
- len = XEN_LIST_LENGTH(obj);
- for (i = 0; i < len; i++)
- {
- XEN el;
- el = XEN_LIST_REF(obj, i);
- if (XEN_NUMBER_P(el))
- {
- double temp;
- temp = fabs(XEN_TO_C_DOUBLE(el));
- if (temp > mx) mx = temp;
- }
- }
- return(C_TO_XEN_DOUBLE(mx));
-}
-
-
-static XEN g_maxamp(XEN snd, XEN chn_n, XEN edpos)
+static Xen g_maxamp(Xen snd, Xen chn_n, Xen edpos)
{
#define H_maxamp "(" S_maxamp " :optional snd chn edpos): maxamp of data in the object 'snd', or in snd's channel chn if snd is a sound"
- if (!(XEN_BOUND_P(chn_n)))
+ if (!(Xen_is_bound(chn_n)))
{
- if (XEN_STRING_P(snd)) /* string => mus_sound_maxamp */
- return(XEN_CADR(g_mus_sound_maxamp(snd)));
+ if (Xen_is_string(snd)) /* string => mus_sound_maxamp */
+ return(Xen_cadr(g_mus_sound_maxamp(snd)));
- if (mus_xen_p(snd)) /* maxamp of mus-data */
+ if (mus_is_xen(snd)) /* maxamp of mus-data */
{
- XEN v;
+ Xen v;
v = g_mus_data(snd);
- if (MUS_VCT_P(v))
+ if (mus_is_vct(v))
return(g_vct_peak(v));
}
- if (sound_data_p(snd))
- return(g_list_maxamp(g_sound_data_maxamp(snd)));
-
- if (MUS_VCT_P(snd)) /* vct-peak */
+ if (mus_is_vct(snd)) /* vct-peak */
return(g_vct_peak(snd));
- if (XEN_MIX_P(snd)) /* mix => sound maxamp of the mix data */
+ if (xen_is_mix(snd)) /* mix => sound maxamp of the mix data */
return(g_mix_maxamp(snd));
- if (XEN_REGION_P(snd)) /* region-maxamp */
+ if (xen_is_region(snd)) /* region-maxamp */
return(g_region_maxamp(snd));
- if (XEN_VECTOR_P(snd))
+ if (Xen_is_vector(snd))
return(g_vector_maxamp(snd));
-
- if (XEN_LIST_P(snd)) /* can this happen given defgenerator? */
- return(g_list_maxamp(snd));
}
- if (XEN_SELECTION_P(snd)) /* selection-maxamp where chn=snd and edpos=chn */
+ if (xen_is_selection(snd)) /* selection-maxamp where chn=snd and edpos=chn */
return(g_selection_maxamp(chn_n, edpos));
- if (XEN_BOUND_P(edpos))
+ if (Xen_is_bound(edpos))
{
- XEN res;
+ Xen res;
if (cp_edpos_loc != NOT_A_GC_LOC)
snd_unprotect_at(cp_edpos_loc);
cp_edpos = edpos;
@@ -7354,11 +7596,11 @@ static XEN g_maxamp(XEN snd, XEN chn_n, XEN edpos)
return(res);
}
- if ((XEN_BOUND_P(chn_n)) ||
- (XEN_TRUE_P(snd)))
- return(channel_get(snd, chn_n, CP_MAXAMP, S_maxamp));
+ if ((Xen_is_bound(chn_n)) ||
+ (Xen_is_true(snd)))
+ return(channel_get(snd, chn_n, CP_MAXAMP, S_maxamp)); /* calls channel_maxamp */
- ASSERT_SOUND(S_maxamp, snd, 0);
+ Snd_assert_sound(S_maxamp, snd, 0);
{
snd_info *sp;
sp = get_sp(snd);
@@ -7366,36 +7608,67 @@ static XEN g_maxamp(XEN snd, XEN chn_n, XEN edpos)
{
int i;
mus_float_t mx = 0.0;
+ mus_float_t *vals = NULL;
+ bool save_maxamp = true;
+
+ for (i = 0; i < sp->nchans; i++)
+ if (sp->chans[i]->edit_ctr != 0)
+ {
+ save_maxamp = false;
+ break;
+ }
+ if (save_maxamp)
+ {
+ mus_long_t *times = NULL;
+ /* fprintf(stderr, "save g_maxamp for %s (%d %lld)\n", sp->filename, mus_sound_maxamp_exists(sp->filename), sp->chans[0]->edits[0]->samples); */
+ vals = (mus_float_t *)calloc(sp->nchans, sizeof(mus_float_t));
+ times = (mus_long_t *)calloc(sp->nchans, sizeof(mus_long_t));
+ for (i = 0; i < sp->nchans; i++)
+ {
+ chan_info *ncp;
+ mus_long_t pos = 0;
+ ncp = sp->chans[i];
+ vals[i] = channel_maxamp_and_position(ncp, 0, &pos);
+ if (vals[i] > mx) mx = vals[i];
+ times[i] = pos;
+ }
+ mus_sound_set_maxamps(sp->filename, sp->nchans, vals, times);
+ free(vals);
+ free(times);
+ return(C_double_to_Xen_real(mx));
+ }
+
for (i = 0; i < sp->nchans; i++)
{
mus_float_t cur_mx;
+
cur_mx = channel_maxamp(sp->chans[i], sp->chans[i]->edit_ctr);
if (cur_mx > mx)
mx = cur_mx;
}
- return(C_TO_XEN_DOUBLE(mx));
+ return(C_double_to_Xen_real(mx));
}
else snd_no_such_sound_error(S_maxamp, snd);
}
- return(XEN_ZERO);
+ return(Xen_integer_zero);
}
-static XEN g_set_maxamp(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_maxamp(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_maxamp, "a number");
- return(channel_set(snd, chn_n, on, CP_MAXAMP, S_setB S_maxamp));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_maxamp, "a number");
+ return(channel_set(snd, chn_n, on, CP_MAXAMP, S_set S_maxamp));
}
-WITH_THREE_SETTER_ARGS(g_set_maxamp_reversed, g_set_maxamp)
+with_three_setter_args(g_set_maxamp_reversed, g_set_maxamp)
-static XEN g_maxamp_position(XEN snd, XEN chn_n, XEN edpos)
+static Xen g_maxamp_position(Xen snd, Xen chn_n, Xen edpos)
{
#define H_maxamp_position "(" S_maxamp_position " :optional snd chn edpos): location of maxamp of data in snd's channel chn"
- if (XEN_BOUND_P(edpos))
+ if (Xen_is_bound(edpos))
{
- XEN res;
+ Xen res;
if (cp_edpos_loc != NOT_A_GC_LOC)
snd_unprotect_at(cp_edpos_loc);
cp_edpos = edpos;
@@ -7409,90 +7682,90 @@ static XEN g_maxamp_position(XEN snd, XEN chn_n, XEN edpos)
}
-static XEN g_squelch_update(XEN snd, XEN chn_n)
+static Xen g_squelch_update(Xen snd, Xen chn_n)
{
#define H_squelch_update "(" S_squelch_update " :optional snd chn): " PROC_TRUE " if updates (redisplays) are turned off in snd's channel chn"
return(channel_get(snd, chn_n, CP_SQUELCH_UPDATE, S_squelch_update));
}
-static XEN g_set_squelch_update(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_squelch_update(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_squelch_update, "a boolean");
- return(channel_set(snd, chn_n, on, CP_SQUELCH_UPDATE, S_setB S_squelch_update));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_squelch_update, "a boolean");
+ return(channel_set(snd, chn_n, on, CP_SQUELCH_UPDATE, S_set S_squelch_update));
}
-WITH_THREE_SETTER_ARGS(g_set_squelch_update_reversed, g_set_squelch_update)
+with_three_setter_args(g_set_squelch_update_reversed, g_set_squelch_update)
-static XEN g_ap_sx(XEN snd, XEN chn_n)
+static Xen g_ap_sx(Xen snd, Xen chn_n)
{
#define H_x_position_slider "(" S_x_position_slider " :optional snd chn): current x axis position slider of snd channel chn"
- return(channel_get(snd, chn_n, CP_AP_SX, S_x_position_slider));
+ return(channel_get(snd, chn_n, CP_SX, S_x_position_slider));
}
-static XEN g_set_ap_sx(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_ap_sx(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_x_position_slider, "a number");
- return(channel_set(snd, chn_n, on, CP_AP_SX, S_setB S_x_position_slider));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_x_position_slider, "a number");
+ return(channel_set(snd, chn_n, on, CP_SX, S_set S_x_position_slider));
}
-WITH_THREE_SETTER_ARGS(g_set_ap_sx_reversed, g_set_ap_sx)
+with_three_setter_args(g_set_ap_sx_reversed, g_set_ap_sx)
-static XEN g_ap_sy(XEN snd, XEN chn_n)
+static Xen g_ap_sy(Xen snd, Xen chn_n)
{
#define H_y_position_slider "(" S_y_position_slider " :optional snd chn): current y axis position slider of snd channel chn"
- return(channel_get(snd, chn_n, CP_AP_SY, S_y_position_slider));
+ return(channel_get(snd, chn_n, CP_SY, S_y_position_slider));
}
-static XEN g_set_ap_sy(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_ap_sy(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_y_position_slider, "a number");
- return(channel_set(snd, chn_n, on, CP_AP_SY, S_setB S_y_position_slider));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_y_position_slider, "a number");
+ return(channel_set(snd, chn_n, on, CP_SY, S_set S_y_position_slider));
}
-WITH_THREE_SETTER_ARGS(g_set_ap_sy_reversed, g_set_ap_sy)
+with_three_setter_args(g_set_ap_sy_reversed, g_set_ap_sy)
-static XEN g_ap_zx(XEN snd, XEN chn_n)
+static Xen g_ap_zx(Xen snd, Xen chn_n)
{
#define H_x_zoom_slider "(" S_x_zoom_slider " :optional snd chn): current x axis zoom slider of snd channel chn"
- return(channel_get(snd, chn_n, CP_AP_ZX, S_x_zoom_slider));
+ return(channel_get(snd, chn_n, CP_ZX, S_x_zoom_slider));
}
-static XEN g_set_ap_zx(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_ap_zx(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_x_zoom_slider, "a number");
- return(channel_set(snd, chn_n, on, CP_AP_ZX, S_setB S_x_zoom_slider));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_x_zoom_slider, "a number");
+ return(channel_set(snd, chn_n, on, CP_ZX, S_set S_x_zoom_slider));
}
-WITH_THREE_SETTER_ARGS(g_set_ap_zx_reversed, g_set_ap_zx)
+with_three_setter_args(g_set_ap_zx_reversed, g_set_ap_zx)
-static XEN g_ap_zy(XEN snd, XEN chn_n)
+static Xen g_ap_zy(Xen snd, Xen chn_n)
{
#define H_y_zoom_slider "(" S_y_zoom_slider " :optional snd chn): current y axis zoom slider of snd channel chn"
- return(channel_get(snd, chn_n, CP_AP_ZY, S_y_zoom_slider));
+ return(channel_get(snd, chn_n, CP_ZY, S_y_zoom_slider));
}
-static XEN g_set_ap_zy(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_ap_zy(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_y_zoom_slider, "a number");
- return(channel_set(snd, chn_n, on, CP_AP_ZY, S_setB S_y_zoom_slider));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_y_zoom_slider, "a number");
+ return(channel_set(snd, chn_n, on, CP_ZY, S_set S_y_zoom_slider));
}
-WITH_THREE_SETTER_ARGS(g_set_ap_zy_reversed, g_set_ap_zy)
+with_three_setter_args(g_set_ap_zy_reversed, g_set_ap_zy)
-static XEN g_edit_hook(XEN snd, XEN chn_n)
+static Xen g_edit_hook(Xen snd, Xen chn_n)
{
#if HAVE_SCHEME
- #define edit_hook_example "(add-hook! (" S_edit_hook " snd chn) (lambda () (" S_snd_print " \";about to edit\") #f))"
+ #define edit_hook_example "(hook-push (" S_edit_hook " snd chn) (lambda () (" S_snd_print " \";about to edit\") #f))"
#endif
#if HAVE_RUBY
#define edit_hook_example "edit_hook(snd, chn).add_hook!(\"hook-test\") do | | snd_print(\"about to edit\"); false end"
@@ -7502,18 +7775,17 @@ static XEN g_edit_hook(XEN snd, XEN chn_n)
#endif
#define H_edit_hook "(" S_edit_hook " :optional snd chn): snd's channel chn's " S_edit_hook ". \
-This is a channel-specific hook variable; the hook procedures are thunks -- they should take no \
-arguments. " S_edit_hook " is called just before any attempt to edit the channel's data; if it returns " PROC_TRUE ", \
+This is a channel-specific hook variable; " S_edit_hook " is called just before any attempt to edit the channel's data; if it returns " PROC_TRUE ", \
the edit is aborted. \n " edit_hook_example
return(channel_get(snd, chn_n, CP_EDIT_HOOK, S_edit_hook));
}
-static XEN g_after_edit_hook(XEN snd, XEN chn_n)
+static Xen g_after_edit_hook(Xen snd, Xen chn_n)
{
#if HAVE_SCHEME
- #define after_edit_hook_example "(add-hook! (" S_after_edit_hook " snd chn) (lambda () (" S_snd_print " \";just edited\")))"
+ #define after_edit_hook_example "(hook-push (" S_after_edit_hook " snd chn) (lambda () (" S_snd_print " \";just edited\")))"
#endif
#if HAVE_RUBY
#define after_edit_hook_example "after_edit_hook(snd, chn).add_hook!(\"hook-test\") do | | snd_print(\"just edited\") end"
@@ -7523,29 +7795,27 @@ static XEN g_after_edit_hook(XEN snd, XEN chn_n)
#endif
#define H_after_edit_hook "(" S_after_edit_hook " :optional snd chn): snd's channel chn's " S_after_edit_hook ". \
-This is a channel-specific hook variable; the hook procedures are thunks -- they should take no \
-arguments. " S_after_edit_hook " is called after an edit, but before " S_after_graph_hook ". \n " after_edit_hook_example
+This is a channel-specific hook variable; " S_after_edit_hook " is called after an edit, but before " S_after_graph_hook ". \n " after_edit_hook_example
return(channel_get(snd, chn_n, CP_AFTER_EDIT_HOOK, S_after_edit_hook));
}
-static XEN g_undo_hook(XEN snd, XEN chn_n)
+static Xen g_undo_hook(Xen snd, Xen chn_n)
{
#define H_undo_hook "(" S_undo_hook " :optional snd chn): snd's channel chn's " S_undo_hook ". \
-This is a channel-specific hook variable; the hook procedures are thunks -- they should take no \
-arguments. " S_undo_hook " is called just after any undo, redo, or revert that affects the channel."
+This is a channel-specific hook variable; " S_undo_hook " is called just after any undo, redo, or revert that affects the channel."
return(channel_get(snd, chn_n, CP_UNDO_HOOK, S_undo_hook));
}
-static XEN g_show_y_zero(XEN snd, XEN chn)
+static Xen g_show_y_zero(Xen snd, Xen chn)
{
#define H_show_y_zero "(" S_show_y_zero " :optional snd chn): " PROC_TRUE " if Snd should include a line at y = 0.0"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SHOW_Y_ZERO, S_show_y_zero));
- return(C_TO_XEN_BOOLEAN(show_y_zero(ss)));
+ return(C_bool_to_Xen_boolean(show_y_zero(ss)));
}
static void chans_zero(chan_info *cp, bool value)
@@ -7560,88 +7830,92 @@ void set_show_y_zero(bool val)
for_each_chan_with_bool(chans_zero, val);
}
-static XEN g_set_show_y_zero(XEN on, XEN snd, XEN chn)
+static Xen g_set_show_y_zero(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_show_y_zero, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_SHOW_Y_ZERO, S_setB S_show_y_zero));
- set_show_y_zero(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(show_y_zero(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_show_y_zero, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_SHOW_Y_ZERO, S_set S_show_y_zero));
+ set_show_y_zero(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(show_y_zero(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_show_y_zero_reversed, g_set_show_y_zero)
+with_three_setter_args(g_set_show_y_zero_reversed, g_set_show_y_zero)
-static XEN g_show_grid(XEN snd, XEN chn)
+static Xen g_show_grid(Xen snd, Xen chn)
{
#define H_show_grid "(" S_show_grid " :optional snd chn): " PROC_TRUE " if Snd should display a background grid in the graphs"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SHOW_GRID, S_show_grid));
- return(C_TO_XEN_BOOLEAN((bool)show_grid(ss)));
+ return(C_bool_to_Xen_boolean((bool)show_grid(ss)));
}
-static XEN g_set_show_grid(XEN on, XEN snd, XEN chn)
+static Xen g_set_show_grid(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_show_grid, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_SHOW_GRID, S_setB S_show_grid));
- set_show_grid((with_grid_t)(XEN_TO_C_BOOLEAN(on)));
- return(C_TO_XEN_BOOLEAN((bool)show_grid(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_show_grid, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_SHOW_GRID, S_set S_show_grid));
+ set_show_grid((with_grid_t)(Xen_boolean_to_C_bool(on)));
+ return(C_bool_to_Xen_boolean((bool)show_grid(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_show_grid_reversed, g_set_show_grid)
+with_three_setter_args(g_set_show_grid_reversed, g_set_show_grid)
-static XEN g_grid_density(XEN snd, XEN chn)
+static Xen g_grid_density(Xen snd, Xen chn)
{
#define H_grid_density "(" S_grid_density " :optional snd chn): sets how closely axis ticks are spaced, default=1.0"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_GRID_DENSITY, S_grid_density));
- return(C_TO_XEN_DOUBLE(grid_density(ss)));
+ return(C_double_to_Xen_real(grid_density(ss)));
}
-static XEN g_set_grid_density(XEN on, XEN snd, XEN chn)
+static Xen g_set_grid_density(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_grid_density, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_GRID_DENSITY, S_setB S_grid_density));
- set_grid_density(XEN_TO_C_DOUBLE(on));
- return(C_TO_XEN_DOUBLE(grid_density(ss)));
+ mus_float_t curf;
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_grid_density, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_GRID_DENSITY, S_set S_grid_density));
+ curf = Xen_real_to_C_double(on);
+ if (curf >= 0.0)
+ set_grid_density(curf);
+ else Xen_out_of_range_error(S_set S_grid_density, 1, on, "density < 0.0?");
+ return(C_double_to_Xen_real(grid_density(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_grid_density_reversed, g_set_grid_density)
+with_three_setter_args(g_set_grid_density_reversed, g_set_grid_density)
-static XEN g_show_sonogram_cursor(XEN snd, XEN chn)
+static Xen g_show_sonogram_cursor(Xen snd, Xen chn)
{
#define H_show_sonogram_cursor "(" S_show_sonogram_cursor " :optional snd chn): " PROC_TRUE " if Snd should display a cursor in the sonogram"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SHOW_SONOGRAM_CURSOR, S_show_sonogram_cursor));
- return(C_TO_XEN_BOOLEAN((bool)show_sonogram_cursor(ss)));
+ return(C_bool_to_Xen_boolean((bool)show_sonogram_cursor(ss)));
}
-static XEN g_set_show_sonogram_cursor(XEN on, XEN snd, XEN chn)
+static Xen g_set_show_sonogram_cursor(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_show_sonogram_cursor, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_SHOW_SONOGRAM_CURSOR, S_setB S_show_sonogram_cursor));
- set_show_sonogram_cursor(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(show_sonogram_cursor(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_show_sonogram_cursor, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_SHOW_SONOGRAM_CURSOR, S_set S_show_sonogram_cursor));
+ set_show_sonogram_cursor(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(show_sonogram_cursor(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_show_sonogram_cursor_reversed, g_set_show_sonogram_cursor)
+with_three_setter_args(g_set_show_sonogram_cursor_reversed, g_set_show_sonogram_cursor)
-static XEN g_min_dB(XEN snd, XEN chn)
+static Xen g_min_dB(Xen snd, Xen chn)
{
#define H_min_dB "(" S_min_dB " :optional snd chn): min dB value displayed in fft graphs using dB scales (default: -60)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_MIN_DB, S_min_dB));
- return(C_TO_XEN_DOUBLE(min_dB(ss)));
+ return(C_double_to_Xen_real(min_dB(ss)));
}
static void update_db_graph(chan_info *cp, mus_float_t new_db)
@@ -7651,7 +7925,7 @@ static void update_db_graph(chan_info *cp, mus_float_t new_db)
if ((cp->active < CHANNEL_HAS_AXES) ||
(cp->sounds == NULL) ||
(cp->sounds[cp->sound_ctr] == NULL) ||
- (!(cp->graph_transform_p)) ||
+ (!(cp->graph_transform_on)) ||
(!(cp->fft_log_magnitude)) ||
(chan_fft_in_progress(cp)))
return;
@@ -7665,282 +7939,282 @@ void set_min_db(mus_float_t db)
for_each_chan_with_float(update_db_graph, db);
}
-static XEN g_set_min_dB(XEN val, XEN snd, XEN chn)
+static Xen g_set_min_dB(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_min_dB, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_MIN_DB, S_setB S_min_dB));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_min_dB, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_MIN_DB, S_set S_min_dB));
else
{
mus_float_t db;
- db = XEN_TO_C_DOUBLE(val);
+ db = Xen_real_to_C_double(val);
if (db < 0.0)
{
set_min_db(db);
reflect_min_db_in_transform_dialog();
}
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_min_dB, 1, val, S_min_dB " (~A) must be < 0.0");
- return(C_TO_XEN_DOUBLE(min_dB(ss)));
+ else Xen_out_of_range_error(S_set S_min_dB, 1, val, S_min_dB " should be < 0.0");
+ return(C_double_to_Xen_real(min_dB(ss)));
}
}
-WITH_THREE_SETTER_ARGS(g_set_min_dB_reversed, g_set_min_dB)
+with_three_setter_args(g_set_min_dB_reversed, g_set_min_dB)
-static XEN g_fft_window_beta(XEN snd, XEN chn)
+static Xen g_fft_window_beta(Xen snd, Xen chn)
{
#define H_fft_window_beta "(" S_fft_window_beta " :optional snd chn): fft window beta parameter value"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_FFT_WINDOW_BETA, S_fft_window_beta));
- return(C_TO_XEN_DOUBLE(fft_window_beta(ss)));
+ return(C_double_to_Xen_real(fft_window_beta(ss)));
}
-static XEN g_set_fft_window_beta(XEN val, XEN snd, XEN chn)
+static Xen g_set_fft_window_beta(Xen val, Xen snd, Xen chn)
{
mus_float_t beta;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_fft_window_beta, "a number");
- beta = XEN_TO_C_DOUBLE(val);
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_fft_window_beta, "a number");
+ beta = Xen_real_to_C_double(val);
if ((beta < 0.0) || (beta > 1.0))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_fft_window_beta, 1, val, "~A, must be between 0.0 and 1.0");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_FFT_WINDOW_BETA, S_setB S_fft_window_beta));
+ Xen_out_of_range_error(S_set S_fft_window_beta, 1, val, S_fft_window_beta " should be between 0.0 and 1.0");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_FFT_WINDOW_BETA, S_set S_fft_window_beta));
set_fft_window_beta(beta);
- return(C_TO_XEN_DOUBLE(fft_window_beta(ss)));
+ return(C_double_to_Xen_real(fft_window_beta(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_fft_window_beta_reversed, g_set_fft_window_beta)
+with_three_setter_args(g_set_fft_window_beta_reversed, g_set_fft_window_beta)
-static XEN g_fft_window_alpha(XEN snd, XEN chn)
+static Xen g_fft_window_alpha(Xen snd, Xen chn)
{
#define H_fft_window_alpha "(" S_fft_window_alpha " :optional snd chn): fft window alpha parameter value"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_FFT_WINDOW_ALPHA, S_fft_window_alpha));
- return(C_TO_XEN_DOUBLE(fft_window_alpha(ss)));
+ return(C_double_to_Xen_real(fft_window_alpha(ss)));
}
-static XEN g_set_fft_window_alpha(XEN val, XEN snd, XEN chn)
+static Xen g_set_fft_window_alpha(Xen val, Xen snd, Xen chn)
{
mus_float_t alpha;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_fft_window_alpha, "a number");
- alpha = XEN_TO_C_DOUBLE(val);
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_fft_window_alpha, "a number");
+ alpha = Xen_real_to_C_double(val);
if ((alpha < 0.0) || (alpha > 10.0))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_fft_window_alpha, 1, val, "~A, must be between 0.0 and 10.0");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_FFT_WINDOW_ALPHA, S_setB S_fft_window_alpha));
+ Xen_out_of_range_error(S_set S_fft_window_alpha, 1, val, S_fft_window_alpha " should be between 0.0 and 10.0");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_FFT_WINDOW_ALPHA, S_set S_fft_window_alpha));
set_fft_window_alpha(alpha);
- return(C_TO_XEN_DOUBLE(fft_window_alpha(ss)));
+ return(C_double_to_Xen_real(fft_window_alpha(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_fft_window_alpha_reversed, g_set_fft_window_alpha)
+with_three_setter_args(g_set_fft_window_alpha_reversed, g_set_fft_window_alpha)
-static XEN g_spectrum_end(XEN snd, XEN chn)
+static Xen g_spectrum_end(Xen snd, Xen chn)
{
#define H_spectrum_end "(" S_spectrum_end " :optional snd chn): max frequency shown in spectra (1.0 = srate/2)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRUM_END, S_spectrum_end));
- return(C_TO_XEN_DOUBLE(spectrum_end(ss)));
+ return(C_double_to_Xen_real(spectrum_end(ss)));
}
-static XEN g_set_spectrum_end(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectrum_end(Xen val, Xen snd, Xen chn)
{
mus_float_t cutoff;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectrum_end, "a number");
- cutoff = XEN_TO_C_DOUBLE(val);
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectrum_end, "a number");
+ cutoff = Xen_real_to_C_double(val);
if ((cutoff < 0.0) || (cutoff > 1.0))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_spectrum_end, 1, val, "~A, must be between 0.0 and 1.0");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRUM_END, S_setB S_spectrum_end));
+ Xen_out_of_range_error(S_set S_spectrum_end, 1, val, S_spectrum_end " should be between 0.0 and 1.0");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRUM_END, S_set S_spectrum_end));
set_spectrum_end(cutoff);
- return(C_TO_XEN_DOUBLE(spectrum_end(ss)));
+ return(C_double_to_Xen_real(spectrum_end(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectrum_end_reversed, g_set_spectrum_end)
+with_three_setter_args(g_set_spectrum_end_reversed, g_set_spectrum_end)
-static XEN g_spectrum_start(XEN snd, XEN chn)
+static Xen g_spectrum_start(Xen snd, Xen chn)
{
#define H_spectrum_start "(" S_spectrum_start " :optional snd chn): lower bound of frequency in spectral displays (0.0)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRUM_START, S_spectrum_start));
- return(C_TO_XEN_DOUBLE(spectrum_start(ss)));
+ return(C_double_to_Xen_real(spectrum_start(ss)));
}
-static XEN g_set_spectrum_start(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectrum_start(Xen val, Xen snd, Xen chn)
{
mus_float_t start;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectrum_start, "a number");
- start = XEN_TO_C_DOUBLE(val);
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectrum_start, "a number");
+ start = Xen_real_to_C_double(val);
if ((start < 0.0) || (start > 1.0))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_spectrum_start, 1, val, "~A, must be between 0.0 and 1.0");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRUM_START, S_setB S_spectrum_start));
+ Xen_out_of_range_error(S_set S_spectrum_start, 1, val, S_spectrum_start " should be between 0.0 and 1.0");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRUM_START, S_set S_spectrum_start));
set_spectrum_start(start);
- return(C_TO_XEN_DOUBLE(spectrum_start(ss)));
+ return(C_double_to_Xen_real(spectrum_start(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectrum_start_reversed, g_set_spectrum_start)
+with_three_setter_args(g_set_spectrum_start_reversed, g_set_spectrum_start)
-static XEN g_spectro_x_angle(XEN snd, XEN chn)
+static Xen g_spectro_x_angle(Xen snd, Xen chn)
{
#define H_spectro_x_angle "(" S_spectro_x_angle " :optional snd chn): spectrogram x-axis viewing angle (90.0)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRO_X_ANGLE, S_spectro_x_angle));
- return(C_TO_XEN_DOUBLE(spectro_x_angle(ss)));
+ return(C_double_to_Xen_real(spectro_x_angle(ss)));
}
-static XEN g_set_spectro_x_angle(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectro_x_angle(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectro_x_angle, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRO_X_ANGLE, S_setB S_spectro_x_angle));
- set_spectro_x_angle(mus_fclamp(MIN_SPECTRO_ANGLE, XEN_TO_C_DOUBLE(val), MAX_SPECTRO_ANGLE));
- return(C_TO_XEN_DOUBLE(spectro_x_angle(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectro_x_angle, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRO_X_ANGLE, S_set S_spectro_x_angle));
+ set_spectro_x_angle(mus_fclamp(MIN_SPECTRO_ANGLE, Xen_real_to_C_double(val), MAX_SPECTRO_ANGLE));
+ return(C_double_to_Xen_real(spectro_x_angle(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectro_x_angle_reversed, g_set_spectro_x_angle)
+with_three_setter_args(g_set_spectro_x_angle_reversed, g_set_spectro_x_angle)
-static XEN g_spectro_x_scale(XEN snd, XEN chn)
+static Xen g_spectro_x_scale(Xen snd, Xen chn)
{
#define H_spectro_x_scale "(" S_spectro_x_scale " :optional snd chn): scaler (stretch) along the spectrogram x axis (1.0)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRO_X_SCALE, S_spectro_x_scale));
- return(C_TO_XEN_DOUBLE(spectro_x_scale(ss)));
+ return(C_double_to_Xen_real(spectro_x_scale(ss)));
}
-static XEN g_set_spectro_x_scale(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectro_x_scale(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectro_x_scale, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRO_X_SCALE, S_setB S_spectro_x_scale));
- set_spectro_x_scale(mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), MAX_SPECTRO_SCALE));
- return(C_TO_XEN_DOUBLE(spectro_x_scale(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectro_x_scale, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRO_X_SCALE, S_set S_spectro_x_scale));
+ set_spectro_x_scale(mus_fclamp(0.0, Xen_real_to_C_double(val), MAX_SPECTRO_SCALE));
+ return(C_double_to_Xen_real(spectro_x_scale(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectro_x_scale_reversed, g_set_spectro_x_scale)
+with_three_setter_args(g_set_spectro_x_scale_reversed, g_set_spectro_x_scale)
-static XEN g_spectro_y_angle(XEN snd, XEN chn)
+static Xen g_spectro_y_angle(Xen snd, Xen chn)
{
#define H_spectro_y_angle "(" S_spectro_y_angle " :optional snd chn): spectrogram y-axis viewing angle (0.0)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRO_Y_ANGLE, S_spectro_y_angle));
- return(C_TO_XEN_DOUBLE(spectro_y_angle(ss)));
+ return(C_double_to_Xen_real(spectro_y_angle(ss)));
}
-static XEN g_set_spectro_y_angle(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectro_y_angle(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectro_y_angle, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRO_Y_ANGLE, S_setB S_spectro_y_angle));
- set_spectro_y_angle(mus_fclamp(MIN_SPECTRO_ANGLE, XEN_TO_C_DOUBLE(val), MAX_SPECTRO_ANGLE));
- return(C_TO_XEN_DOUBLE(spectro_y_angle(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectro_y_angle, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRO_Y_ANGLE, S_set S_spectro_y_angle));
+ set_spectro_y_angle(mus_fclamp(MIN_SPECTRO_ANGLE, Xen_real_to_C_double(val), MAX_SPECTRO_ANGLE));
+ return(C_double_to_Xen_real(spectro_y_angle(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectro_y_angle_reversed, g_set_spectro_y_angle)
+with_three_setter_args(g_set_spectro_y_angle_reversed, g_set_spectro_y_angle)
-static XEN g_spectro_y_scale(XEN snd, XEN chn)
+static Xen g_spectro_y_scale(Xen snd, Xen chn)
{
#define H_spectro_y_scale "(" S_spectro_y_scale " :optional snd chn): scaler (stretch) along the spectrogram y axis (1.0)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRO_Y_SCALE, S_spectro_y_scale));
- return(C_TO_XEN_DOUBLE(spectro_y_scale(ss)));
+ return(C_double_to_Xen_real(spectro_y_scale(ss)));
}
-static XEN g_set_spectro_y_scale(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectro_y_scale(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectro_y_scale, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRO_Y_SCALE, S_setB S_spectro_y_scale));
- set_spectro_y_scale(mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), MAX_SPECTRO_SCALE));
- return(C_TO_XEN_DOUBLE(spectro_y_scale(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectro_y_scale, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRO_Y_SCALE, S_set S_spectro_y_scale));
+ set_spectro_y_scale(mus_fclamp(0.0, Xen_real_to_C_double(val), MAX_SPECTRO_SCALE));
+ return(C_double_to_Xen_real(spectro_y_scale(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectro_y_scale_reversed, g_set_spectro_y_scale)
+with_three_setter_args(g_set_spectro_y_scale_reversed, g_set_spectro_y_scale)
-static XEN g_spectro_z_angle(XEN snd, XEN chn)
+static Xen g_spectro_z_angle(Xen snd, Xen chn)
{
#define H_spectro_z_angle "(" S_spectro_z_angle " :optional snd chn): spectrogram z-axis viewing angle (-2.0)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRO_Z_ANGLE, S_spectro_z_angle));
- return(C_TO_XEN_DOUBLE(spectro_z_angle(ss)));
+ return(C_double_to_Xen_real(spectro_z_angle(ss)));
}
-static XEN g_set_spectro_z_angle(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectro_z_angle(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectro_z_angle, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRO_Z_ANGLE, S_setB S_spectro_z_angle));
- set_spectro_z_angle(mus_fclamp(MIN_SPECTRO_ANGLE, XEN_TO_C_DOUBLE(val), MAX_SPECTRO_ANGLE));
- return(C_TO_XEN_DOUBLE(spectro_z_angle(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectro_z_angle, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRO_Z_ANGLE, S_set S_spectro_z_angle));
+ set_spectro_z_angle(mus_fclamp(MIN_SPECTRO_ANGLE, Xen_real_to_C_double(val), MAX_SPECTRO_ANGLE));
+ return(C_double_to_Xen_real(spectro_z_angle(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectro_z_angle_reversed, g_set_spectro_z_angle)
+with_three_setter_args(g_set_spectro_z_angle_reversed, g_set_spectro_z_angle)
-static XEN g_spectro_z_scale(XEN snd, XEN chn)
+static Xen g_spectro_z_scale(Xen snd, Xen chn)
{
#define H_spectro_z_scale "(" S_spectro_z_scale " :optional snd chn): scaler (stretch) along the spectrogram z axis (0.1)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRO_Z_SCALE, S_spectro_z_scale));
- return(C_TO_XEN_DOUBLE(spectro_z_scale(ss)));
+ return(C_double_to_Xen_real(spectro_z_scale(ss)));
}
-static XEN g_set_spectro_z_scale(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectro_z_scale(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectro_z_scale, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRO_Z_SCALE, S_setB S_spectro_z_scale));
- set_spectro_z_scale(mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), MAX_SPECTRO_SCALE));
- return(C_TO_XEN_DOUBLE(spectro_z_scale(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectro_z_scale, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRO_Z_SCALE, S_set S_spectro_z_scale));
+ set_spectro_z_scale(mus_fclamp(0.0, Xen_real_to_C_double(val), MAX_SPECTRO_SCALE));
+ return(C_double_to_Xen_real(spectro_z_scale(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectro_z_scale_reversed, g_set_spectro_z_scale)
+with_three_setter_args(g_set_spectro_z_scale_reversed, g_set_spectro_z_scale)
-static XEN g_spectro_hop(XEN snd, XEN chn)
+static Xen g_spectro_hop(Xen snd, Xen chn)
{
#define H_spectro_hop "(" S_spectro_hop " :optional snd chn): hop amount (pixels) in spectral displays"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SPECTRO_HOP, S_spectro_hop));
- return(C_TO_XEN_INT(spectro_hop(ss)));
+ return(C_int_to_Xen_integer(spectro_hop(ss)));
}
-static XEN g_set_spectro_hop(XEN val, XEN snd, XEN chn)
+static Xen g_set_spectro_hop(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_spectro_hop, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SPECTRO_HOP, S_setB S_spectro_hop));
- set_spectro_hop(XEN_TO_C_INT_OR_ELSE(val, 0));
- return(C_TO_XEN_INT(spectro_hop(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_spectro_hop, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SPECTRO_HOP, S_set S_spectro_hop));
+ set_spectro_hop((Xen_is_integer(val)) ? Xen_integer_to_C_int(val) : 0);
+ return(C_int_to_Xen_integer(spectro_hop(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_spectro_hop_reversed, g_set_spectro_hop)
+with_three_setter_args(g_set_spectro_hop_reversed, g_set_spectro_hop)
-static XEN g_show_marks(XEN snd, XEN chn)
+static Xen g_show_marks(Xen snd, Xen chn)
{
#define H_show_marks "(" S_show_marks " :optional snd chn): " PROC_TRUE " if Snd should show marks"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SHOW_MARKS, S_show_marks));
- return(C_TO_XEN_BOOLEAN(show_marks(ss)));
+ return(C_bool_to_Xen_boolean(show_marks(ss)));
}
static void chans_marks(chan_info *cp, bool value)
@@ -7955,328 +8229,330 @@ void set_show_marks(bool val)
for_each_chan_with_bool(chans_marks, val);
}
-static XEN g_set_show_marks(XEN on, XEN snd, XEN chn)
+static Xen g_set_show_marks(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_show_marks, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_SHOW_MARKS, S_setB S_show_marks));
- set_show_marks(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(show_marks(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_show_marks, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_SHOW_MARKS, S_set S_show_marks));
+ set_show_marks(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(show_marks(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_show_marks_reversed, g_set_show_marks)
+with_three_setter_args(g_set_show_marks_reversed, g_set_show_marks)
-static XEN g_show_transform_peaks(XEN snd, XEN chn)
+static Xen g_show_transform_peaks(Xen snd, Xen chn)
{
#define H_show_transform_peaks "(" S_show_transform_peaks " :optional snd chn): " PROC_TRUE " if fft display should include peak list"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SHOW_TRANSFORM_PEAKS, S_show_transform_peaks));
- return(C_TO_XEN_BOOLEAN(show_transform_peaks(ss)));
+ return(C_bool_to_Xen_boolean(show_transform_peaks(ss)));
}
-static XEN g_set_show_transform_peaks(XEN val, XEN snd, XEN chn)
+static Xen g_set_show_transform_peaks(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_1, S_setB S_show_transform_peaks, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_SHOW_TRANSFORM_PEAKS, S_setB S_show_transform_peaks));
- set_show_transform_peaks(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(show_transform_peaks(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_show_transform_peaks, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_SHOW_TRANSFORM_PEAKS, S_set S_show_transform_peaks));
+ set_show_transform_peaks(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(show_transform_peaks(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_show_transform_peaks_reversed, g_set_show_transform_peaks)
+with_three_setter_args(g_set_show_transform_peaks_reversed, g_set_show_transform_peaks)
-static XEN g_zero_pad(XEN snd, XEN chn)
+static Xen g_zero_pad(Xen snd, Xen chn)
{
#define H_zero_pad "(" S_zero_pad " :optional snd chn): zero padding used in fft as a multiple of fft size (0)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_ZERO_PAD, S_zero_pad));
- return(C_TO_XEN_INT(zero_pad(ss)));
+ return(C_int_to_Xen_integer(zero_pad(ss)));
}
-static XEN g_set_zero_pad(XEN val, XEN snd, XEN chn)
+static Xen g_set_zero_pad(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_zero_pad, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_ZERO_PAD, S_setB S_zero_pad));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_zero_pad, "an integer");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_ZERO_PAD, S_set S_zero_pad));
set_zero_pad(mus_iclamp(0, g_imin(0, val, DEFAULT_ZERO_PAD), MAX_ZERO_PAD));
- return(C_TO_XEN_INT(zero_pad(ss)));
+ return(C_int_to_Xen_integer(zero_pad(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_zero_pad_reversed, g_set_zero_pad)
+with_three_setter_args(g_set_zero_pad_reversed, g_set_zero_pad)
-static XEN g_wavelet_type(XEN snd, XEN chn)
+static Xen g_wavelet_type(Xen snd, Xen chn)
{
#define H_wavelet_type "(" S_wavelet_type " :optional snd chn): wavelet used in wavelet-transform (0)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_WAVELET_TYPE, S_wavelet_type));
- return(C_TO_XEN_INT(wavelet_type(ss)));
+ return(C_int_to_Xen_integer(wavelet_type(ss)));
}
-static XEN g_set_wavelet_type(XEN val, XEN snd, XEN chn)
+static Xen g_set_wavelet_type(Xen val, Xen snd, Xen chn)
{
int wave;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, S_setB S_wavelet_type, "an integer");
- wave = XEN_TO_C_INT(val);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_wavelet_type, "an integer");
+ wave = Xen_integer_to_C_int(val);
if ((wave < 0) || (wave >= NUM_WAVELETS))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_wavelet_type, 1, val, "~A, unknown wavelet type");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_WAVELET_TYPE, S_setB S_wavelet_type));
+ Xen_out_of_range_error(S_set S_wavelet_type, 1, val, "unknown wavelet type");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_WAVELET_TYPE, S_set S_wavelet_type));
set_wavelet_type(wave);
- return(C_TO_XEN_INT(wavelet_type(ss)));
+ return(C_int_to_Xen_integer(wavelet_type(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_wavelet_type_reversed, g_set_wavelet_type)
+with_three_setter_args(g_set_wavelet_type_reversed, g_set_wavelet_type)
-static XEN g_fft_log_frequency(XEN snd, XEN chn)
+static Xen g_fft_log_frequency(Xen snd, Xen chn)
{
#define H_fft_log_frequency "(" S_fft_log_frequency " :optional snd chn): " PROC_TRUE " if fft displays use log on the frequency axis"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_FFT_LOG_FREQUENCY, S_fft_log_frequency));
- return(C_TO_XEN_BOOLEAN(fft_log_frequency(ss)));
+ return(C_bool_to_Xen_boolean(fft_log_frequency(ss)));
}
-static XEN g_set_fft_log_frequency(XEN on, XEN snd, XEN chn)
+static Xen g_set_fft_log_frequency(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_fft_log_frequency, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_FFT_LOG_FREQUENCY, S_setB S_fft_log_frequency));
- set_fft_log_frequency(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(fft_log_frequency(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_fft_log_frequency, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_FFT_LOG_FREQUENCY, S_set S_fft_log_frequency));
+ set_fft_log_frequency(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(fft_log_frequency(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_fft_log_frequency_reversed, g_set_fft_log_frequency)
+with_three_setter_args(g_set_fft_log_frequency_reversed, g_set_fft_log_frequency)
-static XEN g_fft_log_magnitude(XEN snd, XEN chn)
+static Xen g_fft_log_magnitude(Xen snd, Xen chn)
{
#define H_fft_log_magnitude "(" S_fft_log_magnitude " :optional snd chn): " PROC_TRUE " if fft displays use dB"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_FFT_LOG_MAGNITUDE, S_fft_log_magnitude));
- return(C_TO_XEN_BOOLEAN(fft_log_magnitude(ss)));
+ return(C_bool_to_Xen_boolean(fft_log_magnitude(ss)));
}
-static XEN g_set_fft_log_magnitude(XEN on, XEN snd, XEN chn)
+static Xen g_set_fft_log_magnitude(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_fft_log_magnitude, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_FFT_LOG_MAGNITUDE, S_setB S_fft_log_magnitude));
- set_fft_log_magnitude(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(fft_log_magnitude(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_fft_log_magnitude, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_FFT_LOG_MAGNITUDE, S_set S_fft_log_magnitude));
+ set_fft_log_magnitude(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(fft_log_magnitude(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_fft_log_magnitude_reversed, g_set_fft_log_magnitude)
+with_three_setter_args(g_set_fft_log_magnitude_reversed, g_set_fft_log_magnitude)
-static XEN g_fft_with_phases(XEN snd, XEN chn)
+static Xen g_fft_with_phases(Xen snd, Xen chn)
{
#define H_fft_with_phases "(" S_fft_with_phases " :optional snd chn): " PROC_TRUE " if fft displays include phase info"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_FFT_WITH_PHASES, S_fft_with_phases));
- return(C_TO_XEN_BOOLEAN(fft_with_phases(ss)));
+ return(C_bool_to_Xen_boolean(fft_with_phases(ss)));
}
-static XEN g_set_fft_with_phases(XEN on, XEN snd, XEN chn)
+static Xen g_set_fft_with_phases(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_fft_with_phases, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_FFT_WITH_PHASES, S_setB S_fft_with_phases));
- set_fft_with_phases(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(fft_with_phases(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_fft_with_phases, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_FFT_WITH_PHASES, S_set S_fft_with_phases));
+ set_fft_with_phases(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(fft_with_phases(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_fft_with_phases_reversed, g_set_fft_with_phases)
+with_three_setter_args(g_set_fft_with_phases_reversed, g_set_fft_with_phases)
-static XEN g_show_mix_waveforms(XEN snd, XEN chn)
+static Xen g_show_mix_waveforms(Xen snd, Xen chn)
{
#define H_show_mix_waveforms "(" S_show_mix_waveforms " :optional snd chn): " PROC_TRUE " if Snd should display mix waveforms (above the main waveform)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SHOW_MIX_WAVEFORMS, S_show_mix_waveforms));
- return(C_TO_XEN_BOOLEAN(show_mix_waveforms(ss)));
+ return(C_bool_to_Xen_boolean(show_mix_waveforms(ss)));
}
-static XEN g_set_show_mix_waveforms(XEN on, XEN snd, XEN chn)
+static Xen g_set_show_mix_waveforms(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_show_mix_waveforms, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_SHOW_MIX_WAVEFORMS, S_setB S_show_mix_waveforms));
- set_show_mix_waveforms(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(show_mix_waveforms(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_show_mix_waveforms, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_SHOW_MIX_WAVEFORMS, S_set S_show_mix_waveforms));
+ set_show_mix_waveforms(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(show_mix_waveforms(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_show_mix_waveforms_reversed, g_set_show_mix_waveforms)
+with_three_setter_args(g_set_show_mix_waveforms_reversed, g_set_show_mix_waveforms)
-static XEN g_verbose_cursor(XEN snd, XEN chn)
+static Xen g_with_verbose_cursor(Xen snd, Xen chn)
{
- #define H_verbose_cursor "(" S_with_verbose_cursor " :optional snd chn): " PROC_TRUE " if the cursor's position and so on is displayed in the minibuffer"
- if (XEN_BOUND_P(snd))
- return(channel_get(snd, chn, CP_VERBOSE_CURSOR, S_with_verbose_cursor));
- return(C_TO_XEN_BOOLEAN(verbose_cursor(ss)));
+ #define H_with_verbose_cursor "(" S_with_verbose_cursor " :optional snd chn): " PROC_TRUE " if the cursor's position and so on is displayed in the status area"
+ if (Xen_is_bound(snd))
+ return(channel_get(snd, chn, CP_WITH_VERBOSE_CURSOR, S_with_verbose_cursor));
+ return(C_bool_to_Xen_boolean(with_verbose_cursor(ss)));
}
-static void chans_verbose_cursor(chan_info *cp, bool value)
+static void chans_with_verbose_cursor(chan_info *cp, bool value)
{
- cp->verbose_cursor = value;
+ cp->with_verbose_cursor = value;
update_graph(cp);
}
-void set_verbose_cursor(bool val)
+void set_with_verbose_cursor(bool val)
{
- in_set_verbose_cursor(val);
- if (val == 0) for_each_sound(clear_minibuffer);
- for_each_chan_with_bool(chans_verbose_cursor, val);
+ in_set_with_verbose_cursor(val);
+ if (val == 0) for_each_sound(clear_status_area);
+ for_each_chan_with_bool(chans_with_verbose_cursor, val);
}
-static XEN g_set_verbose_cursor(XEN on, XEN snd, XEN chn)
+static Xen g_set_with_verbose_cursor(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_with_verbose_cursor, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_VERBOSE_CURSOR, S_setB S_with_verbose_cursor));
- set_verbose_cursor(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(verbose_cursor(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_with_verbose_cursor, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_WITH_VERBOSE_CURSOR, S_set S_with_verbose_cursor));
+ set_with_verbose_cursor(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(with_verbose_cursor(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_verbose_cursor_reversed, g_set_verbose_cursor)
+with_three_setter_args(g_set_with_verbose_cursor_reversed, g_set_with_verbose_cursor)
-static XEN g_time_graph_type(XEN snd, XEN chn)
+static Xen g_time_graph_type(Xen snd, Xen chn)
{
#define H_time_graph_type "(" S_time_graph_type " :optional snd chn): " S_graph_as_wavogram " if Snd's time domain display is a 'wavogram',\
otherwise " S_graph_once "."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_TIME_GRAPH_TYPE, S_time_graph_type));
- return(C_TO_XEN_INT((int)time_graph_type(ss)));
+ return(C_int_to_Xen_integer((int)time_graph_type(ss)));
}
-static XEN g_set_time_graph_type(XEN val, XEN snd, XEN chn)
+static Xen g_set_time_graph_type(Xen val, Xen snd, Xen chn)
{
graph_type_t on;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, S_setB S_time_graph_type, "an integer");
- on = (graph_type_t)XEN_TO_C_INT(val);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_time_graph_type, "an integer");
+ on = (graph_type_t)Xen_integer_to_C_int(val);
if ((on != GRAPH_ONCE) && (on != GRAPH_AS_WAVOGRAM))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_time_graph_type, 1, val, "~A, must be " S_graph_once ", or " S_graph_as_wavogram);
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_TIME_GRAPH_TYPE, S_setB S_time_graph_type));
+ Xen_out_of_range_error(S_set S_time_graph_type, 1, val, S_time_graph_type " should be " S_graph_once ", or " S_graph_as_wavogram);
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_TIME_GRAPH_TYPE, S_set S_time_graph_type));
set_time_graph_type(on);
- return(C_TO_XEN_INT((int)time_graph_type(ss)));
+ return(C_int_to_Xen_integer((int)time_graph_type(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_time_graph_type_reversed, g_set_time_graph_type)
+with_three_setter_args(g_set_time_graph_type_reversed, g_set_time_graph_type)
-static XEN g_wavo_hop(XEN snd, XEN chn)
+static Xen g_wavo_hop(Xen snd, Xen chn)
{
#define H_wavo_hop "(" S_wavo_hop " :optional snd chn): wavogram spacing between successive traces"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_WAVO_HOP, S_wavo_hop));
- return(C_TO_XEN_INT(wavo_hop(ss)));
+ return(C_int_to_Xen_integer(wavo_hop(ss)));
}
-static XEN g_set_wavo_hop(XEN val, XEN snd, XEN chn)
+static Xen g_set_wavo_hop(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_wavo_hop, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_WAVO_HOP, S_setB S_wavo_hop));
- set_wavo_hop(XEN_TO_C_INT_OR_ELSE(val, 0));
- return(C_TO_XEN_INT(wavo_hop(ss)));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_wavo_hop, "an integer");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_WAVO_HOP, S_set S_wavo_hop));
+ set_wavo_hop(Xen_integer_to_C_int(val));
+ return(val);
}
-WITH_THREE_SETTER_ARGS(g_set_wavo_hop_reversed, g_set_wavo_hop)
+with_three_setter_args(g_set_wavo_hop_reversed, g_set_wavo_hop)
-static XEN g_wavo_trace(XEN snd, XEN chn)
+static Xen g_wavo_trace(Xen snd, Xen chn)
{
#define H_wavo_trace "(" S_wavo_trace " :optional snd chn): length (samples) of each trace in the wavogram (64)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_WAVO_TRACE, S_wavo_trace));
- return(C_TO_XEN_INT(wavo_trace(ss)));
+ return(C_int_to_Xen_integer(wavo_trace(ss)));
}
-static XEN g_set_wavo_trace(XEN val, XEN snd, XEN chn)
+static Xen g_set_wavo_trace(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_wavo_trace, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_WAVO_TRACE, S_setB S_wavo_trace));
- set_wavo_trace(mus_iclamp(1, XEN_TO_C_INT_OR_ELSE(val, DEFAULT_WAVO_TRACE), POINT_BUFFER_SIZE));
- return(C_TO_XEN_INT(wavo_trace(ss)));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_wavo_trace, "an integer");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_WAVO_TRACE, S_set S_wavo_trace));
+ set_wavo_trace(mus_iclamp(1, Xen_integer_to_C_int(val), POINT_BUFFER_SIZE));
+ return(C_int_to_Xen_integer(wavo_trace(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_wavo_trace_reversed, g_set_wavo_trace)
+with_three_setter_args(g_set_wavo_trace_reversed, g_set_wavo_trace)
-static XEN g_transform_size(XEN snd, XEN chn)
+static Xen g_transform_size(Xen snd, Xen chn)
{
#define H_transform_size "(" S_transform_size " :optional snd chn): current fft size (512)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_TRANSFORM_SIZE, S_transform_size));
- return(C_TO_XEN_INT64_T(transform_size(ss)));
+ return(C_llong_to_Xen_llong(transform_size(ss)));
}
-static XEN g_set_transform_size(XEN val, XEN snd, XEN chn)
+static Xen g_set_transform_size(Xen val, Xen snd, Xen chn)
{
mus_long_t len;
- XEN_ASSERT_TYPE(XEN_INT64_T_P(val), val, XEN_ARG_1, S_setB S_transform_size, "an integer");
- len = XEN_TO_C_INT64_T(val);
+ Xen_check_type(Xen_is_llong(val), val, 1, S_set S_transform_size, "an integer");
+ len = Xen_llong_to_C_llong(val);
if (len <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_transform_size, 1, val, "size ~A, but must be > 0");
- if (!(POWER_OF_2_P(len)))
+ Xen_out_of_range_error(S_set S_transform_size, 1, val, "size must be > 0");
+ if (!(is_power_of_2(len)))
len = snd_mus_long_t_pow2((int)(log(len + 1) / log(2.0))); /* actually rounds down, despite appearances */
- if (len <= 0) return(XEN_FALSE);
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_TRANSFORM_SIZE, S_setB S_transform_size));
+ if (len <= 0) return(Xen_false);
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_TRANSFORM_SIZE, S_set S_transform_size));
set_transform_size(len);
- return(C_TO_XEN_INT64_T(transform_size(ss)));
+ return(C_llong_to_Xen_llong(transform_size(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_transform_size_reversed, g_set_transform_size)
+with_three_setter_args(g_set_transform_size_reversed, g_set_transform_size)
-static XEN g_transform_graph_type(XEN snd, XEN chn)
+static Xen g_transform_graph_type(Xen snd, Xen chn)
{
#define H_transform_graph_type "(" S_transform_graph_type " :optional snd chn) can \
be " S_graph_once ", " S_graph_as_sonogram ", or " S_graph_as_spectrogram "."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_TRANSFORM_GRAPH_TYPE, S_transform_graph_type));
- return(C_TO_XEN_INT((int)transform_graph_type(ss)));
+ return(C_int_to_Xen_integer((int)transform_graph_type(ss)));
}
-static XEN g_set_transform_graph_type(XEN val, XEN snd, XEN chn)
+static Xen g_set_transform_graph_type(Xen val, Xen snd, Xen chn)
{
graph_type_t style;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, S_setB S_transform_graph_type, "an integer");
- style = (graph_type_t)XEN_TO_C_INT(val);
- if (style > GRAPH_AS_SPECTROGRAM)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_transform_graph_type, 1, val, "~A, but must be " S_graph_once ", " S_graph_as_sonogram ", or " S_graph_as_spectrogram);
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_TRANSFORM_GRAPH_TYPE, S_setB S_transform_graph_type));
+ int gt;
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_transform_graph_type, "an integer");
+ gt = Xen_integer_to_C_int(val);
+ style = (graph_type_t)gt;
+ if ((gt < 0) || (style > GRAPH_AS_SPECTROGRAM))
+ Xen_out_of_range_error(S_set S_transform_graph_type, 1, val, S_transform_graph_type " should be " S_graph_once ", " S_graph_as_sonogram ", or " S_graph_as_spectrogram);
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_TRANSFORM_GRAPH_TYPE, S_set S_transform_graph_type));
set_transform_graph_type(style);
- return(C_TO_XEN_INT((int)transform_graph_type(ss)));
+ return(C_int_to_Xen_integer((int)transform_graph_type(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_transform_graph_type_reversed, g_set_transform_graph_type)
+with_three_setter_args(g_set_transform_graph_type_reversed, g_set_transform_graph_type)
-static XEN g_fft_window(XEN snd, XEN chn)
+static Xen g_fft_window(Xen snd, Xen chn)
{
#define H_fft_window "(" S_fft_window " :optional snd chn): fft data window choice (e.g. " S_blackman2_window "). The \
choices are: " S_rectangular_window ", " S_hann_window ", " S_welch_window ", " S_parzen_window ", \
@@ -8286,130 +8562,129 @@ choices are: " S_rectangular_window ", " S_hann_window ", " S_welch_window ", "
" S_dolph_chebyshev_window ", " S_hann_poisson_window ", " S_connes_window ", \
" S_samaraki_window ", " S_ultraspherical_window ", " S_bartlett_hann_window ", " S_bohman_window ", " S_flat_top_window ", and " S_blackman5_window " et al."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_FFT_WINDOW, S_fft_window));
- return(C_TO_XEN_INT(fft_window(ss)));
+ return(C_int_to_Xen_integer(fft_window(ss)));
}
-static XEN g_set_fft_window(XEN val, XEN snd, XEN chn)
+static Xen g_set_fft_window(Xen val, Xen snd, Xen chn)
{
int in_win;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, S_setB S_fft_window, "an integer");
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_fft_window, "an integer");
- in_win = XEN_TO_C_INT(val);
- if (!(mus_fft_window_p(in_win)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_fft_window, 1, val, "~A: unknown fft data window");
+ in_win = Xen_integer_to_C_int(val);
+ if (!(mus_is_fft_window(in_win)))
+ Xen_out_of_range_error(S_set S_fft_window, 1, val, "unknown fft data window");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_FFT_WINDOW, S_setB S_fft_window));
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_FFT_WINDOW, S_set S_fft_window));
set_fft_window((mus_fft_window_t)in_win);
- return(C_TO_XEN_INT((int)fft_window(ss)));
+ return(C_int_to_Xen_integer((int)fft_window(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_fft_window_reversed, g_set_fft_window)
+with_three_setter_args(g_set_fft_window_reversed, g_set_fft_window)
-static XEN g_transform_type(XEN snd, XEN chn)
+static Xen g_transform_type(Xen snd, Xen chn)
{
#define H_transform_type "(" S_transform_type " :optional snd chn): transform type; can be one of " S_fourier_transform ", \
" S_wavelet_transform ", " S_haar_transform ", " S_autocorrelation ", " S_walsh_transform ", \
" S_cepstrum ", or an added transform (see " S_add_transform ")."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_TRANSFORM_TYPE, S_transform_type));
- return(C_INT_TO_XEN_TRANSFORM(transform_type(ss)));
+ return(C_int_to_Xen_transform(transform_type(ss)));
}
-static XEN g_set_transform_type(XEN val, XEN snd, XEN chn)
+static Xen g_set_transform_type(Xen val, Xen snd, Xen chn)
{
int type;
- XEN_ASSERT_TYPE(XEN_TRANSFORM_P(val), val, XEN_ARG_1, S_setB S_transform_type, "a transform object");
- type = XEN_TRANSFORM_TO_C_INT(val);
- if (!(transform_p(type)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_transform_type, 1, val, "~A: unknown transform");
+ Xen_check_type(xen_is_transform(val), val, 1, S_set S_transform_type, "a transform object");
+ type = Xen_transform_to_C_int(val);
+ if (!is_transform(type))
+ Xen_out_of_range_error(S_set S_transform_type, 1, val, "unknown transform");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_TRANSFORM_TYPE, S_setB S_transform_type));
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_TRANSFORM_TYPE, S_set S_transform_type));
set_transform_type(type);
-
- return(C_INT_TO_XEN_TRANSFORM(transform_type(ss)));
+ return(C_int_to_Xen_transform(transform_type(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_transform_type_reversed, g_set_transform_type)
+with_three_setter_args(g_set_transform_type_reversed, g_set_transform_type)
-static XEN g_transform_normalization(XEN snd, XEN chn)
+static Xen g_transform_normalization(Xen snd, Xen chn)
{
#define H_transform_normalization "(" S_transform_normalization " :optional snd chn): one of " S_dont_normalize ", " S_normalize_by_channel \
", " S_normalize_by_sound ", or " S_normalize_globally ". \
decides whether spectral data is normalized before display (default: " S_normalize_by_channel ")"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_TRANSFORM_NORMALIZATION, S_transform_normalization));
- return(C_TO_XEN_INT((int)transform_normalization(ss)));
+ return(C_int_to_Xen_integer((int)transform_normalization(ss)));
}
-static XEN g_set_transform_normalization(XEN val, XEN snd, XEN chn)
+static Xen g_set_transform_normalization(Xen val, Xen snd, Xen chn)
{
fft_normalize_t norm;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, S_setB S_transform_normalization, "an integer");
- norm = (fft_normalize_t)XEN_TO_C_INT(val);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_transform_normalization, "an integer");
+ norm = (fft_normalize_t)Xen_integer_to_C_int(val);
if (norm >= NUM_TRANSFORM_NORMALIZATIONS)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_transform_normalization, 1, val,
- "~A, but must be " S_dont_normalize ", " S_normalize_by_channel ", " S_normalize_by_sound ", or " S_normalize_globally);
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_TRANSFORM_NORMALIZATION, S_setB S_transform_normalization));
+ Xen_out_of_range_error(S_set S_transform_normalization, 1, val,
+ S_transform_normalization " should be " S_dont_normalize ", " S_normalize_by_channel ", " S_normalize_by_sound ", or " S_normalize_globally);
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_TRANSFORM_NORMALIZATION, S_set S_transform_normalization));
set_transform_normalization(norm);
- return(C_TO_XEN_INT((int)transform_normalization(ss)));
+ return(C_int_to_Xen_integer((int)transform_normalization(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_transform_normalization_reversed, g_set_transform_normalization)
+with_three_setter_args(g_set_transform_normalization_reversed, g_set_transform_normalization)
-static XEN g_max_transform_peaks(XEN snd, XEN chn)
+static Xen g_max_transform_peaks(Xen snd, Xen chn)
{
#define H_max_transform_peaks "(" S_max_transform_peaks " :optional snd chn): max number of fft peaks reported in fft display"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_MAX_TRANSFORM_PEAKS, S_max_transform_peaks));
- return(C_TO_XEN_INT(max_transform_peaks(ss)));
+ return(C_int_to_Xen_integer(max_transform_peaks(ss)));
}
-static XEN g_set_max_transform_peaks(XEN n, XEN snd, XEN chn)
+static Xen g_set_max_transform_peaks(Xen n, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n), n, XEN_ARG_1, S_setB S_max_transform_peaks, "an integer");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, n, CP_MAX_TRANSFORM_PEAKS, S_setB S_max_transform_peaks));
+ Xen_check_type(Xen_is_integer(n), n, 1, S_set S_max_transform_peaks, "an integer");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, n, CP_MAX_TRANSFORM_PEAKS, S_set S_max_transform_peaks));
else
{
int lim;
- lim = XEN_TO_C_INT(n);
+ lim = Xen_integer_to_C_int(n);
if (lim >= 1)
{
set_max_transform_peaks(lim);
reflect_peaks_in_transform_dialog();
}
- return(C_TO_XEN_INT(max_transform_peaks(ss)));
+ return(C_int_to_Xen_integer(max_transform_peaks(ss)));
}
}
-WITH_THREE_SETTER_ARGS(g_set_max_transform_peaks_reversed, g_set_max_transform_peaks)
+with_three_setter_args(g_set_max_transform_peaks_reversed, g_set_max_transform_peaks)
-static XEN g_graph_style(XEN snd, XEN chn)
+static Xen g_graph_style(Xen snd, Xen chn)
{
#define H_graph_style "(" S_graph_style " :optional snd chn): graph style, one \
of '(" S_graph_lines " " S_graph_dots " " S_graph_dots_and_lines " " S_graph_lollipops " " S_graph_filled ")"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_TIME_GRAPH_STYLE, S_time_graph_style));
- return(C_TO_XEN_INT(graph_style(ss)));
+ return(C_int_to_Xen_integer(graph_style(ss)));
}
static void chans_graph_style(chan_info *cp, int value)
@@ -8427,146 +8702,144 @@ void set_graph_style(graph_style_t val)
for_each_chan_with_int(chans_graph_style, (int)val);
}
-static XEN g_set_graph_style(XEN style, XEN snd, XEN chn)
+static Xen g_set_graph_style(Xen style, Xen snd, Xen chn)
{
int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(style), style, XEN_ARG_1, S_setB S_graph_style, "an integer");
+ Xen_check_type(Xen_is_integer(style), style, 1, S_set S_graph_style, "an integer");
- val = XEN_TO_C_INT(style);
- if (!(graph_style_p(val)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_graph_style, 1, style, "~A: unknown graph-style");
+ val = Xen_integer_to_C_int(style);
+ if (!(is_graph_style(val)))
+ Xen_out_of_range_error(S_set S_graph_style, 1, style, "unknown graph-style");
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
{
- XEN xval;
+ Xen xval;
call_update_graph = false;
- xval = channel_set(snd, chn, style, CP_TIME_GRAPH_STYLE, S_setB S_graph_style);
- channel_set(snd, chn, style, CP_LISP_GRAPH_STYLE, S_setB S_graph_style);
+ xval = channel_set(snd, chn, style, CP_TIME_GRAPH_STYLE, S_set S_graph_style);
+ channel_set(snd, chn, style, CP_LISP_GRAPH_STYLE, S_set S_graph_style);
call_update_graph = true;
- channel_set(snd, chn, style, CP_TRANSFORM_GRAPH_STYLE, S_setB S_graph_style);
+ channel_set(snd, chn, style, CP_TRANSFORM_GRAPH_STYLE, S_set S_graph_style);
return(xval);
}
set_graph_style((graph_style_t)val);
- return(C_TO_XEN_INT((int)(graph_style(ss))));
+ return(C_int_to_Xen_integer((int)(graph_style(ss))));
}
-WITH_THREE_SETTER_ARGS(g_set_graph_style_reversed, g_set_graph_style)
+with_three_setter_args(g_set_graph_style_reversed, g_set_graph_style)
-static XEN g_time_graph_style(XEN snd, XEN chn)
+static Xen g_time_graph_style(Xen snd, Xen chn)
{
#define H_time_graph_style "(" S_time_graph_style " snd chn): time domain graph drawing style. \
one of '(" S_graph_lines " " S_graph_dots " " S_graph_dots_and_lines " " S_graph_lollipops " " S_graph_filled ")"
- ASSERT_SOUND(S_time_graph_style, snd, 0);
+ Snd_assert_sound(S_time_graph_style, snd, 0);
return(channel_get(snd, chn, CP_TIME_GRAPH_STYLE, S_time_graph_style));
}
-static XEN g_set_time_graph_style(XEN style, XEN snd, XEN chn)
+static Xen g_set_time_graph_style(Xen style, Xen snd, Xen chn)
{
int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(style), style, XEN_ARG_1, S_setB S_time_graph_style, "an integer");
- ASSERT_SOUND(S_time_graph_style, snd, 0);
+ Xen_check_type(Xen_is_integer(style), style, 1, S_set S_time_graph_style, "an integer");
+ Snd_assert_sound(S_time_graph_style, snd, 0);
- val = XEN_TO_C_INT(style);
- if (!(graph_style_p(val)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_time_graph_style, 1, style, "~A: unknown " S_time_graph_style);
+ val = Xen_integer_to_C_int(style);
+ if (!(is_graph_style(val)))
+ Xen_out_of_range_error(S_set S_time_graph_style, 1, style, "unknown " S_time_graph_style);
- return(channel_set(snd, chn, style, CP_TIME_GRAPH_STYLE, S_setB S_time_graph_style));
+ return(channel_set(snd, chn, style, CP_TIME_GRAPH_STYLE, S_set S_time_graph_style));
}
-WITH_THREE_SETTER_ARGS(g_set_time_graph_style_reversed, g_set_time_graph_style)
+with_three_setter_args(g_set_time_graph_style_reversed, g_set_time_graph_style)
-static XEN g_lisp_graph_style(XEN snd, XEN chn)
+static Xen g_lisp_graph_style(Xen snd, Xen chn)
{
#define H_lisp_graph_style "(" S_lisp_graph_style " snd chn): lisp graph drawing style. \
one of '(" S_graph_lines " " S_graph_dots " " S_graph_dots_and_lines " " S_graph_lollipops " " S_graph_filled ")"
- ASSERT_SOUND(S_lisp_graph_style, snd, 0);
+ Snd_assert_sound(S_lisp_graph_style, snd, 0);
return(channel_get(snd, chn, CP_LISP_GRAPH_STYLE, S_lisp_graph_style));
}
-static XEN g_set_lisp_graph_style(XEN style, XEN snd, XEN chn)
+static Xen g_set_lisp_graph_style(Xen style, Xen snd, Xen chn)
{
int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(style), style, XEN_ARG_1, S_setB S_lisp_graph_style, "an integer");
- ASSERT_SOUND(S_lisp_graph_style, snd, 0);
+ Xen_check_type(Xen_is_integer(style), style, 1, S_set S_lisp_graph_style, "an integer");
+ Snd_assert_sound(S_lisp_graph_style, snd, 0);
- val = XEN_TO_C_INT(style);
- if (!(graph_style_p(val)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_lisp_graph_style, 1, style, "~A: unknown " S_lisp_graph_style);
+ val = Xen_integer_to_C_int(style);
+ if (!(is_graph_style(val)))
+ Xen_out_of_range_error(S_set S_lisp_graph_style, 1, style, "unknown " S_lisp_graph_style);
- return(channel_set(snd, chn, style, CP_LISP_GRAPH_STYLE, S_setB S_lisp_graph_style));
+ return(channel_set(snd, chn, style, CP_LISP_GRAPH_STYLE, S_set S_lisp_graph_style));
}
-WITH_THREE_SETTER_ARGS(g_set_lisp_graph_style_reversed, g_set_lisp_graph_style)
+with_three_setter_args(g_set_lisp_graph_style_reversed, g_set_lisp_graph_style)
-static XEN g_transform_graph_style(XEN snd, XEN chn)
+static Xen g_transform_graph_style(Xen snd, Xen chn)
{
#define H_transform_graph_style "(" S_transform_graph_style " snd chn): fft graph drawing style, one \
of '(" S_graph_lines " " S_graph_dots " " S_graph_dots_and_lines " " S_graph_lollipops " " S_graph_filled ")"
- ASSERT_SOUND(S_transform_graph_style, snd, 0);
+ Snd_assert_sound(S_transform_graph_style, snd, 0);
return(channel_get(snd, chn, CP_TRANSFORM_GRAPH_STYLE, S_transform_graph_style));
}
-static XEN g_set_transform_graph_style(XEN style, XEN snd, XEN chn)
+static Xen g_set_transform_graph_style(Xen style, Xen snd, Xen chn)
{
int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(style), style, XEN_ARG_1, S_setB S_transform_graph_style, "an integer");
- ASSERT_SOUND(S_transform_graph_style, snd, 0);
+ Xen_check_type(Xen_is_integer(style), style, 1, S_set S_transform_graph_style, "an integer");
+ Snd_assert_sound(S_transform_graph_style, snd, 0);
- val = XEN_TO_C_INT(style);
+ val = Xen_integer_to_C_int(style);
- if (!(graph_style_p(val)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_transform_graph_style, 1, style, "~A: unknown " S_transform_graph_style);
+ if (!(is_graph_style(val)))
+ Xen_out_of_range_error(S_set S_transform_graph_style, 1, style, "unknown " S_transform_graph_style);
- return(channel_set(snd, chn, style, CP_TRANSFORM_GRAPH_STYLE, S_setB S_transform_graph_style));
+ return(channel_set(snd, chn, style, CP_TRANSFORM_GRAPH_STYLE, S_set S_transform_graph_style));
}
-WITH_THREE_SETTER_ARGS(g_set_transform_graph_style_reversed, g_set_transform_graph_style)
+with_three_setter_args(g_set_transform_graph_style_reversed, g_set_transform_graph_style)
-static XEN g_dot_size(XEN snd, XEN chn)
+static Xen g_dot_size(Xen snd, Xen chn)
{
#define H_dot_size "(" S_dot_size " :optional snd chn): size in pixels of dots when graphing with dots (1)"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_DOT_SIZE, S_dot_size));
- return(C_TO_XEN_INT(dot_size(ss)));
+ return(C_int_to_Xen_integer(dot_size(ss)));
}
-static XEN g_set_dot_size(XEN size, XEN snd, XEN chn)
+static Xen g_set_dot_size(Xen size, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(size), size, XEN_ARG_1, S_setB S_dot_size, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, size, CP_DOT_SIZE, S_setB S_dot_size));
- set_dot_size(mus_iclamp(MIN_DOT_SIZE,
- XEN_TO_C_INT_OR_ELSE(size, DEFAULT_DOT_SIZE),
- MAX_DOT_SIZE));
- return(C_TO_XEN_INT(dot_size(ss)));
+ Xen_check_type(Xen_is_integer(size), size, 1, S_set S_dot_size, "an integer");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, size, CP_DOT_SIZE, S_set S_dot_size));
+ set_dot_size(mus_iclamp(MIN_DOT_SIZE, Xen_integer_to_C_int(size), MAX_DOT_SIZE));
+ return(C_int_to_Xen_integer(dot_size(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_dot_size_reversed, g_set_dot_size)
+with_three_setter_args(g_set_dot_size_reversed, g_set_dot_size)
-static XEN g_x_axis_style(XEN snd, XEN chn)
+static Xen g_x_axis_style(Xen snd, Xen chn)
{
#define H_x_axis_style "(" S_x_axis_style " :optional snd chn): \
The x axis labelling of the time domain waveform can be in seconds (" S_x_axis_in_seconds "), in samples (" S_x_axis_in_samples "), expressed as a \
percentage of the overall duration (" S_x_axis_as_percentage "), as a beat number (" S_x_axis_in_beats "), as a measure \
number (" S_x_axis_in_measures "), or clock-style (dd:hh:mm:ss) (" S_x_axis_as_clock ")."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_X_AXIS_STYLE, S_x_axis_style));
- return(C_TO_XEN_INT((int)x_axis_style(ss)));
+ return(C_int_to_Xen_integer((int)x_axis_style(ss)));
}
static void chans_x_axis_style(chan_info *cp, int value)
@@ -8602,137 +8875,139 @@ void set_x_axis_style(x_axis_style_t val)
for_each_chan_with_int(chans_x_axis_style, (int)val);
}
-static XEN g_set_x_axis_style(XEN style, XEN snd, XEN chn)
+static Xen g_set_x_axis_style(Xen style, Xen snd, Xen chn)
{
int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(style), style, XEN_ARG_1, S_setB S_x_axis_style, "an integer");
+ Xen_check_type(Xen_is_integer(style), style, 1, S_set S_x_axis_style, "an integer");
- val = XEN_TO_C_INT(style);
- if (!(x_axis_style_p(val)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_x_axis_style, 1, style, "~A is not an x-axis-style");
+ val = Xen_integer_to_C_int(style);
+ if (!(is_x_axis_style(val)))
+ Xen_out_of_range_error(S_set S_x_axis_style, 1, style, "unknown " S_x_axis_style);
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, style, CP_X_AXIS_STYLE, S_setB S_x_axis_style));
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, style, CP_X_AXIS_STYLE, S_set S_x_axis_style));
set_x_axis_style((x_axis_style_t)val);
/* snd-menu.c -- maps over chans */
- return(C_TO_XEN_INT((int)x_axis_style(ss)));
+ return(C_int_to_Xen_integer((int)x_axis_style(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_x_axis_style_reversed, g_set_x_axis_style)
+with_three_setter_args(g_set_x_axis_style_reversed, g_set_x_axis_style)
-static XEN g_beats_per_minute(XEN snd, XEN chn)
+static Xen g_beats_per_minute(Xen snd, Xen chn)
{
#define H_beats_per_minute "(" S_beats_per_minute " :optional snd chn): beats per minute if " S_x_axis_style " is " S_x_axis_in_beats
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_BEATS_PER_MINUTE, S_beats_per_minute));
- return(C_TO_XEN_DOUBLE(beats_per_minute(ss)));
+ return(C_double_to_Xen_real(beats_per_minute(ss)));
}
-static XEN g_set_beats_per_minute(XEN beats, XEN snd, XEN chn)
+static Xen g_set_beats_per_minute(Xen beats, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(beats), beats, XEN_ARG_1, S_setB S_beats_per_minute, "a number");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, beats, CP_BEATS_PER_MINUTE, S_setB S_beats_per_minute));
+ Xen_check_type(Xen_is_number(beats), beats, 1, S_set S_beats_per_minute, "a number");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, beats, CP_BEATS_PER_MINUTE, S_set S_beats_per_minute));
else
{
mus_float_t val;
- val = XEN_TO_C_DOUBLE(beats);
+ val = Xen_real_to_C_double(beats);
if (val > 0.0)
set_beats_per_minute(val);
- return(C_TO_XEN_DOUBLE(beats_per_minute(ss)));
+ return(C_double_to_Xen_real(beats_per_minute(ss)));
}
}
-WITH_THREE_SETTER_ARGS(g_set_beats_per_minute_reversed, g_set_beats_per_minute)
+with_three_setter_args(g_set_beats_per_minute_reversed, g_set_beats_per_minute)
-static XEN g_beats_per_measure(XEN snd, XEN chn)
+static Xen g_beats_per_measure(Xen snd, Xen chn)
{
#define H_beats_per_measure "(" S_beats_per_measure " :optional snd chn): beats per measure if " S_x_axis_style " is " S_x_axis_in_measures
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_BEATS_PER_MEASURE, S_beats_per_measure));
- return(C_TO_XEN_INT(beats_per_measure(ss)));
+ return(C_int_to_Xen_integer(beats_per_measure(ss)));
}
-static XEN g_set_beats_per_measure(XEN beats, XEN snd, XEN chn)
+static Xen g_set_beats_per_measure(Xen beats, Xen snd, Xen chn)
{
int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(beats), beats, XEN_ARG_1, S_setB S_beats_per_measure, "an int");
- val = XEN_TO_C_INT(beats);
+ Xen_check_type(Xen_is_integer(beats), beats, 1, S_set S_beats_per_measure, "an int");
+ val = Xen_integer_to_C_int(beats);
if ((val <= 0) || (val > 1000))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_beats_per_measure, 1, beats, "must be between 1 and 1000");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, beats, CP_BEATS_PER_MEASURE, S_setB S_beats_per_measure));
+ Xen_out_of_range_error(S_set S_beats_per_measure, 1, beats, S_beats_per_measure " should be between 1 and 1000");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, beats, CP_BEATS_PER_MEASURE, S_set S_beats_per_measure));
set_beats_per_measure(val);
- return(C_TO_XEN_INT(beats_per_measure(ss)));
+ return(C_int_to_Xen_integer(beats_per_measure(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_beats_per_measure_reversed, g_set_beats_per_measure)
+with_three_setter_args(g_set_beats_per_measure_reversed, g_set_beats_per_measure)
-static XEN g_show_axes(XEN snd, XEN chn)
+static Xen g_show_axes(Xen snd, Xen chn)
{
#define H_show_axes "(" S_show_axes " :optional snd chn) \
If " S_show_all_axes ", display x and y axes; if " S_show_x_axis ", just one axis (the x axis) is displayed. \
The other choices are " S_show_no_axes ", " S_show_all_axes_unlabelled ", " S_show_x_axis_unlabelled ", and " S_show_bare_x_axis "."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_SHOW_AXES, S_show_axes));
- return(C_TO_XEN_INT((int)show_axes(ss)));
+ return(C_int_to_Xen_integer((int)show_axes(ss)));
}
-static XEN g_set_show_axes(XEN on, XEN snd, XEN chn)
+static Xen g_set_show_axes(Xen on, Xen snd, Xen chn)
{
int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(on), on, XEN_ARG_1, S_setB S_show_axes, "an integer");
+ Xen_check_type(Xen_is_integer(on), on, 1, S_set S_show_axes, "an integer");
- val = XEN_TO_C_INT(on);
- if (!(show_axes_p(val)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_show_axes, 1, on, "~A must be a show-axes choice");
+ val = Xen_integer_to_C_int(on);
+ if (!(shows_axes(val)))
+ Xen_out_of_range_error(S_set S_show_axes, 1, on, "unknown " S_show_axes " choice");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, on, CP_SHOW_AXES, S_setB S_show_axes));
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, on, CP_SHOW_AXES, S_set S_show_axes));
set_show_axes((show_axes_t)val);
- return(C_TO_XEN_INT((int)show_axes(ss)));
+ return(C_int_to_Xen_integer((int)show_axes(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_show_axes_reversed, g_set_show_axes)
+with_three_setter_args(g_set_show_axes_reversed, g_set_show_axes)
-static XEN g_graphs_horizontal(XEN snd, XEN chn)
+static Xen g_graphs_horizontal(Xen snd, Xen chn)
{
#define H_graphs_horizontal "(" S_graphs_horizontal " :optional snd chn): " PROC_TRUE " if the time domain, fft, and lisp graphs are layed out horizontally"
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
return(channel_get(snd, chn, CP_GRAPHS_HORIZONTAL, S_graphs_horizontal));
- return(C_TO_XEN_BOOLEAN(graphs_horizontal(ss)));
+ return(C_bool_to_Xen_boolean(graphs_horizontal(ss)));
}
-static XEN g_set_graphs_horizontal(XEN val, XEN snd, XEN chn)
+static Xen g_set_graphs_horizontal(Xen val, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_1, S_setB S_graphs_horizontal, "a boolean");
- if (XEN_BOUND_P(snd))
- return(channel_set(snd, chn, val, CP_GRAPHS_HORIZONTAL, S_setB S_graphs_horizontal));
- set_graphs_horizontal(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(graphs_horizontal(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_graphs_horizontal, "a boolean");
+ if (Xen_is_bound(snd))
+ return(channel_set(snd, chn, val, CP_GRAPHS_HORIZONTAL, S_set S_graphs_horizontal));
+ set_graphs_horizontal(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(graphs_horizontal(ss)));
}
-WITH_THREE_SETTER_ARGS(g_set_graphs_horizontal_reversed, g_set_graphs_horizontal)
+with_three_setter_args(g_set_graphs_horizontal_reversed, g_set_graphs_horizontal)
void write_transform_peaks(FILE *fd, chan_info *ucp)
{
- /* put (sync'd) peak info in (possibly temporary) file */
+ /* put (sync'd) peak info in (possibly temporary) file.
+ * this used to follow the displays, but I think I'd rather get all the data at high precision
+ */
int i, chn;
sync_info *si = NULL;
@@ -8741,7 +9016,6 @@ void write_transform_peaks(FILE *fd, chan_info *ucp)
si = sync_to_chan(ucp);
for (chn = 0; chn < si->chans; chn++)
{
- snd_info *sp;
chan_info *cp;
fft_info *fp;
@@ -8754,56 +9028,40 @@ void write_transform_peaks(FILE *fd, chan_info *ucp)
fap = fp->axis;
if ((fap) && (fap->graph_active))
{
+ snd_info *sp;
mus_float_t srate2;
axis_info *ap;
fft_peak *peak_freqs = NULL;
fft_peak *peak_amps = NULL;
mus_float_t *data;
- int num_peaks,samps, cutoff_samps, tens, srate, digits = 5;
- mus_float_t samples_per_pixel, cutoff;
+ int num_peaks, samps, srate;
ap = cp->axis;
sp = cp->sound;
data = fp->data;
- cutoff = cp->spectrum_end;
- samps = (int)(fp->current_size * 0.5);
- cutoff_samps = (int)(samps * cutoff);
- samples_per_pixel = (mus_float_t)cutoff_samps / (mus_float_t)(fap->x_axis_x1 - fap->x_axis_x0);
-
- srate = SND_SRATE(sp);
+ srate = snd_srate(sp);
srate2 = (mus_float_t)srate * .5;
- if (samps > (5 * srate))
- tens = 2;
- else
- if (samps > (int)srate2)
- tens = 1;
- else
- if (samps > (srate / 20))
- tens = 0;
- else tens = -1;
-
- if (ceil(log10(srate)) > 3.0)
- digits = (int)ceil(log10(srate)) + 2;
+ samps = (int)(fp->current_size * 0.5);
peak_freqs = (fft_peak *)calloc(cp->max_transform_peaks, sizeof(fft_peak));
peak_amps = (fft_peak *)calloc(cp->max_transform_peaks, sizeof(fft_peak));
- num_peaks = find_and_sort_transform_peaks(data, peak_freqs, cp->max_transform_peaks, 0, samps, samples_per_pixel, fp->scale);
+ num_peaks = find_and_sort_transform_peaks(data, peak_freqs, cp->max_transform_peaks, 0, samps, 0.5, fp->scale);
if ((num_peaks != 1) ||
(peak_freqs[0].freq != 0.0))
{
fprintf(fd, "%s", sp->short_filename);
if (sp->nchans > 1) fprintf(fd, ": chan %d", cp->chan);
- fprintf(fd, ", fft " MUS_LD " points beginning at sample " MUS_LD " (%.3f secs), %s\n\n",
+ fprintf(fd, ", fft %lld points beginning at sample %lld (%.3f secs), %s\n\n",
fp->current_size,
ap->losamp,
(float)((double)(ap->losamp) / (double)srate),
- mus_fft_window_name(cp->fft_window)); /* was XEN name */
+ mus_fft_window_name(cp->fft_window)); /* was Xen name */
for (i = 0; i < num_peaks; i++)
fprintf(fd, " %.*f %.*f\n",
- tens,
+ 6,
peak_freqs[i].freq * srate2,
- digits,
+ 6,
peak_freqs[i].amp);
fprintf(fd, "\n");
}
@@ -8816,25 +9074,25 @@ void write_transform_peaks(FILE *fd, chan_info *ucp)
}
-static XEN g_peaks(XEN filename, XEN snd, XEN chn_n)
+static Xen g_peaks(Xen filename, Xen snd, Xen chn_n)
{
#define H_peaks "(" S_peaks " :optional filename snd chn): write current fft peaks data to filename, or \
to the info dialog if filename is omitted"
- char *name = NULL, *str;
+ char *name = NULL;
chan_info *cp;
bool post_to_dialog = true;
FILE *fd = NULL;
- XEN_ASSERT_TYPE((XEN_STRING_P(filename) || (XEN_FALSE_P(filename)) || (XEN_NOT_BOUND_P(filename))), filename, XEN_ARG_1, S_peaks, "a string or " PROC_FALSE);
+ Xen_check_type((Xen_is_string(filename) || (Xen_is_false(filename)) || (!Xen_is_bound(filename))), filename, 1, S_peaks, "a string or " PROC_FALSE);
- ASSERT_CHANNEL(S_peaks, snd, chn_n, 2);
+ Snd_assert_channel(S_peaks, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_peaks);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- if (XEN_STRING_P(filename))
+ if (Xen_is_string(filename))
{
- name = mus_expand_filename(XEN_TO_C_STRING(filename));
+ name = mus_expand_filename(Xen_string_to_C_string(filename));
if ((name) && (mus_strlen(name) > 0))
{
fd = FOPEN(name, "w");
@@ -8848,16 +9106,17 @@ to the info dialog if filename is omitted"
}
if (!fd)
- XEN_ERROR(XEN_ERROR_TYPE("cant-open-file"),
- XEN_LIST_3(C_TO_XEN_STRING(S_peaks ": ~S ~A"),
- C_TO_XEN_STRING(name),
- C_TO_XEN_STRING(snd_io_strerror())));
+ Xen_error(Xen_make_error_type("cant-open-file"),
+ Xen_list_3(C_string_to_Xen_string(S_peaks ": ~S ~A"),
+ C_string_to_Xen_string(name),
+ C_string_to_Xen_string(snd_io_strerror())));
write_transform_peaks(fd, cp);
snd_fclose(fd, name);
if (post_to_dialog)
{
+ char *str;
str = file_to_string(name);
if (str)
{
@@ -8871,229 +9130,284 @@ to the info dialog if filename is omitted"
}
-static XEN g_left_sample(XEN snd, XEN chn_n)
+static Xen g_left_sample(Xen snd, Xen chn_n)
{
#define H_left_sample "(" S_left_sample " :optional snd chn): left sample number in time domain window"
- return(channel_get(snd, chn_n, CP_AP_LOSAMP, S_left_sample));
+ return(channel_get(snd, chn_n, CP_LOSAMP, S_left_sample));
}
-static XEN g_set_left_sample(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_left_sample(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_INT64_T_P(on) || XEN_NOT_BOUND_P(on), on, XEN_ARG_1, S_setB S_left_sample, "an integer");
- return(channel_set(snd, chn_n, on, CP_AP_LOSAMP, S_setB S_left_sample));
+ Xen_check_type(Xen_is_llong(on) || !Xen_is_bound(on), on, 1, S_set S_left_sample, "an integer");
+ return(channel_set(snd, chn_n, on, CP_LOSAMP, S_set S_left_sample));
}
-WITH_THREE_SETTER_ARGS(g_set_left_sample_reversed, g_set_left_sample)
+with_three_setter_args(g_set_left_sample_reversed, g_set_left_sample)
-static XEN g_right_sample(XEN snd, XEN chn_n)
+static Xen g_right_sample(Xen snd, Xen chn_n)
{
#define H_right_sample "(" S_right_sample " :optional snd chn): right sample number in time domain window"
- return(channel_get(snd, chn_n, CP_AP_HISAMP, S_right_sample));
+ return(channel_get(snd, chn_n, CP_HISAMP, S_right_sample));
}
-static XEN g_set_right_sample(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_right_sample(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_INT64_T_P(on) || XEN_NOT_BOUND_P(on), on, XEN_ARG_1, S_setB S_right_sample, "an integer");
- return(channel_set(snd, chn_n, on, CP_AP_HISAMP, S_setB S_right_sample));
+ Xen_check_type(Xen_is_llong(on) || !Xen_is_bound(on), on, 1, S_set S_right_sample, "an integer");
+ return(channel_set(snd, chn_n, on, CP_HISAMP, S_set S_right_sample));
}
-WITH_THREE_SETTER_ARGS(g_set_right_sample_reversed, g_set_right_sample)
+with_three_setter_args(g_set_right_sample_reversed, g_set_right_sample)
-static XEN g_channel_properties(XEN snd, XEN chn_n)
+static Xen g_channel_properties(Xen snd, Xen chn_n)
{
#define H_channel_properties "(" S_channel_properties " :optional snd chn): \
-A property list associated with the given channel. It is set to '() at the time a sound is opened. \
-The accessor channel-property is provided in extensions." XEN_FILE_EXTENSION "."
+A property list associated with the given channel. It is set to () at the time a sound is opened."
return(channel_get(snd, chn_n, CP_PROPERTIES, S_channel_properties));
}
-static XEN g_set_channel_properties(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_channel_properties(Xen on, Xen snd, Xen chn_n)
{
- /* XEN_ASSERT_TYPE(XEN_LIST_P(on), on, XEN_ARG_1, S_setB S_channel_properties, "a property list"); */
- return(channel_set(snd, chn_n, on, CP_PROPERTIES, S_setB S_channel_properties));
+ /* Xen_check_type(Xen_is_list(on), on, 1, S_set S_channel_properties, "a property list"); */
+ return(channel_set(snd, chn_n, on, CP_PROPERTIES, S_set S_channel_properties));
}
-WITH_THREE_SETTER_ARGS(g_set_channel_properties_reversed, g_set_channel_properties)
+with_three_setter_args(g_set_channel_properties_reversed, g_set_channel_properties)
-static XEN g_channel_property(XEN key, XEN snd, XEN chn)
+static Xen g_channel_property(Xen key, Xen snd, Xen chn)
{
#define H_channel_property "(" S_channel_property " key snd chn) returns the value associated with 'key' in \
the given channel's property list, or " PROC_FALSE "."
- return(XEN_ASSOC_REF(key, g_channel_properties(snd, chn)));
+ return(Xen_assoc_ref(key, g_channel_properties(snd, chn)));
}
#if HAVE_SCHEME
-static XEN g_set_channel_property(XEN val, XEN key, XEN snd, XEN chn)
+static Xen g_set_channel_property(Xen val, Xen key, Xen snd, Xen chn)
#else
-static XEN g_set_channel_property(XEN key, XEN val, XEN snd, XEN chn)
+static Xen g_set_channel_property(Xen key, Xen val, Xen snd, Xen chn)
#endif
{
- g_set_channel_properties(XEN_ASSOC_SET(key, val, g_channel_properties(snd, chn)), snd, chn);
+ g_set_channel_properties(Xen_assoc_set(key, val, g_channel_properties(snd, chn)), snd, chn);
return(val);
}
-WITH_FOUR_SETTER_ARGS(g_set_channel_property_reversed, g_set_channel_property)
+with_four_setter_args(g_set_channel_property_reversed, g_set_channel_property)
-static XEN g_edit_properties(XEN snd, XEN chn_n, XEN pos)
+static Xen g_edit_properties(Xen snd, Xen chn_n, Xen pos)
{
#define H_edit_properties "(" S_edit_properties " :optional snd chn edpos): \
-A property list associated with the given edit. It is set to '() at the time an edit is performed and cleared when that edit is no longer accessible. \
-The accessor edit-property is provided in extensions." XEN_FILE_EXTENSION "."
+A property list associated with the given edit. It is set to () at the time an edit is performed and cleared when that edit is no longer accessible."
chan_info *cp;
int edpos;
- ASSERT_CHANNEL(S_edit_properties, snd, chn_n, 1);
+ Snd_assert_channel(S_edit_properties, snd, chn_n, 1);
cp = get_cp(snd, chn_n, S_edit_properties);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
edpos = to_c_edit_position(cp, pos, S_edit_properties, 3);
- if (!(XEN_VECTOR_P(cp->edits[edpos]->properties)))
+ if (!(Xen_is_vector(cp->edits[edpos]->properties)))
{
- cp->edits[edpos]->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ cp->edits[edpos]->properties = Xen_make_vector(1, Xen_empty_list);
cp->edits[edpos]->properties_gc_loc = snd_protect(cp->edits[edpos]->properties);
}
- return(XEN_VECTOR_REF(cp->edits[edpos]->properties, 0));
+ return(Xen_vector_ref(cp->edits[edpos]->properties, 0));
}
-static XEN g_set_edit_properties(XEN on, XEN snd, XEN chn_n, XEN pos)
+static Xen g_set_edit_properties(Xen on, Xen snd, Xen chn_n, Xen pos)
{
chan_info *cp;
int edpos;
- ASSERT_CHANNEL(S_setB S_edit_properties, snd, chn_n, 1);
+ Snd_assert_channel(S_set S_edit_properties, snd, chn_n, 1);
- cp = get_cp(snd, chn_n, S_setB S_edit_properties);
- if (!cp) return(XEN_FALSE);
+ cp = get_cp(snd, chn_n, S_set S_edit_properties);
+ if (!cp) return(Xen_false);
- edpos = to_c_edit_position(cp, pos, S_setB S_edit_properties, 3);
- if (!(XEN_VECTOR_P(cp->edits[edpos]->properties)))
+ edpos = to_c_edit_position(cp, pos, S_set S_edit_properties, 3);
+ if (!(Xen_is_vector(cp->edits[edpos]->properties)))
{
- cp->edits[edpos]->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ cp->edits[edpos]->properties = Xen_make_vector(1, Xen_empty_list);
cp->edits[edpos]->properties_gc_loc = snd_protect(cp->edits[edpos]->properties);
}
- XEN_VECTOR_SET(cp->edits[edpos]->properties, 0, on);
- return(XEN_VECTOR_REF(cp->edits[edpos]->properties, 0));
+ Xen_vector_set(cp->edits[edpos]->properties, 0, on);
+ return(Xen_vector_ref(cp->edits[edpos]->properties, 0));
}
-WITH_FOUR_SETTER_ARGS(g_set_edit_properties_reversed, g_set_edit_properties)
+with_four_setter_args(g_set_edit_properties_reversed, g_set_edit_properties)
-static XEN g_edit_property(XEN key, XEN snd, XEN chn, XEN pos)
+static Xen g_edit_property(Xen key, Xen snd, Xen chn, Xen pos)
{
#define H_edit_property "(" S_edit_property " key snd chn pos) returns the value associated with 'key' in the \
given edit's property list, or " PROC_FALSE "."
- return(XEN_ASSOC_REF(key, g_edit_properties(snd, chn, pos)));
+ Snd_assert_channel(S_edit_property, snd, chn, 2);
+ return(Xen_assoc_ref(key, g_edit_properties(snd, chn, pos)));
}
-static XEN g_set_edit_property(XEN key, XEN val, XEN snd, XEN chn, XEN pos)
+static Xen g_set_edit_property(Xen key, Xen val, Xen snd, Xen chn, Xen pos)
{
- g_set_edit_properties(XEN_ASSOC_SET(key, val, g_edit_properties(snd, chn, pos)), snd, chn, pos);
+ Snd_assert_channel(S_edit_property, snd, chn, 3);
+ g_set_edit_properties(Xen_assoc_set(key, val, g_edit_properties(snd, chn, pos)), snd, chn, pos);
return(val);
}
#if HAVE_SCHEME
-static XEN g_set_edit_property_reversed(s7_scheme *sc, s7_pointer args)
+static Xen g_set_edit_property_reversed(s7_scheme *sc, s7_pointer args)
{
int len;
- len = XEN_LIST_LENGTH(args);
+ len = Xen_list_length(args);
if (len == 2)
- return(g_set_edit_property(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_edit_property(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_undefined, Xen_undefined, Xen_undefined));
if (len == 3)
- return(g_set_edit_property(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 1), XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_edit_property(Xen_list_ref(args, 0), Xen_list_ref(args, 2), Xen_list_ref(args, 1), Xen_undefined, Xen_undefined));
if (len == 4)
- return(g_set_edit_property(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 3), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 2), XEN_UNDEFINED));
+ return(g_set_edit_property(Xen_list_ref(args, 0), Xen_list_ref(args, 3), Xen_list_ref(args, 1), Xen_list_ref(args, 2), Xen_undefined));
- return(g_set_edit_property(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 4), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 3)));
+ return(g_set_edit_property(Xen_list_ref(args, 0), Xen_list_ref(args, 4), Xen_list_ref(args, 1), Xen_list_ref(args, 2), Xen_list_ref(args, 3)));
}
#endif
-static XEN g_edits(XEN snd, XEN chn_n)
+static Xen g_edits(Xen snd, Xen chn_n)
{
#define H_edits "(" S_edits " :optional snd chn): -> (list undoable-edits redoable-edits) in snd's channel chn"
chan_info *cp;
int i;
- ASSERT_CHANNEL(S_edits, snd, chn_n, 1);
+ Snd_assert_channel(S_edits, snd, chn_n, 1);
cp = get_cp(snd, chn_n, S_edits);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
for (i = cp->edit_ctr + 1; i < cp->edit_size; i++)
if (!(cp->edits[i])) break;
- return(XEN_LIST_2(C_TO_XEN_INT(cp->edit_ctr),
- C_TO_XEN_INT(i - cp->edit_ctr - 1)));
+ return(Xen_list_2(C_int_to_Xen_integer(cp->edit_ctr),
+ C_int_to_Xen_integer(i - cp->edit_ctr - 1)));
}
-
-static XEN g_graph(XEN ldata, XEN xlabel, XEN x0, XEN x1, XEN y0, XEN y1, XEN snd, XEN chn_n, XEN force_display, XEN show_axes)
+/* Xen ldata, Xen xlabel, Xen x0, Xen x1, Xen y0, Xen y1, Xen snd, Xen chn_n, Xen force_display, Xen show_axes */
+static Xen g_graph(Xen args)
{
#define H_graph "(" S_graph " data :optional xlabel (x0 0.0) (x1 1.0) y0 y1 snd chn (force-display " PROC_TRUE ") show-axes): \
-displays 'data' as a graph with x axis label 'xlabel', axis units going from x0 to x1 and y0 to y1; 'data' can be a list or a vct. \
+displays 'data' as a graph with x axis label 'xlabel', axis units going from x0 to x1 and y0 to y1; 'data' can be a list or a " S_vct ". \
If 'data' is a list of numbers, it is treated as an envelope."
chan_info *cp;
lisp_grf *lg;
- XEN data = XEN_UNDEFINED, lst;
+ Xen data = Xen_undefined;
char *label = NULL;
- vct *v = NULL;
- int i, len = 0, graph, graphs;
+ int i, len = 0, graphs;
bool need_update = false;
- mus_float_t ymin, ymax, val;
- double nominal_x0, nominal_x1;
+ mus_float_t ymin = 32768.0, ymax = -32768.0, val;
+ double nominal_x0 = 0.0, nominal_x1 = 1.0;
int old_height = 0, old_width = 0, ww = 0;
int old_y_offset = 0, gx0 = 0;
+ Xen arg, ldata, x0 = Xen_undefined, x1 = Xen_undefined;
+ Xen snd = Xen_undefined, chn_n = Xen_undefined, force_display = Xen_undefined, show_axes = Xen_undefined;
/* ldata can be a vct or a list of numbers or vcts */
- XEN_ASSERT_TYPE(((MUS_VCT_P(ldata)) ||
- ((XEN_LIST_P(ldata)) && (XEN_LIST_LENGTH(ldata) > 0) &&
- ((XEN_NUMBER_P(XEN_CAR(ldata))) || (MUS_VCT_P(XEN_CAR(ldata)))))),
- ldata, XEN_ARG_1, S_graph, "a vct or a list");
-
- XEN_ASSERT_TYPE(XEN_STRING_P(xlabel) || XEN_NOT_BOUND_P(xlabel), xlabel, XEN_ARG_2, S_graph, "a string (x axis label)");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(x0), x0, XEN_ARG_3, S_graph, "a number (x0)");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(x1), x1, XEN_ARG_4, S_graph, "a number (x1)");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(y0), y0, XEN_ARG_5, S_graph, "a number (y0)");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(y1), y1, XEN_ARG_6, S_graph, "a number (y1)");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(force_display), force_display, XEN_ARG_9, S_graph, "a boolean (force-display)");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(show_axes), show_axes, XEN_ARG_10, S_graph, "an integer (show-axes choice)");
-
- ASSERT_CHANNEL(S_graph, snd, chn_n, 7);
+ arg = args;
+ ldata = Xen_car(arg);
+ Xen_check_type(((mus_is_vct(ldata)) ||
+ ((Xen_is_list(ldata)) && (Xen_list_length(ldata) > 0) &&
+ ((Xen_is_number(Xen_car(ldata))) || (mus_is_vct(Xen_car(ldata)))))),
+ ldata, 1, S_graph, "a " S_vct " or a list");
+
+ if ((!(Xen_is_list(ldata))) ||
+ (Xen_is_number(Xen_car(ldata))))
+ graphs = 1;
+ else graphs = Xen_list_length(ldata);
+ if (graphs == 0) return(Xen_false);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ Xen xlabel;
+ xlabel = Xen_car(arg);
+ Xen_check_type(Xen_is_string(xlabel), xlabel, 2, S_graph, "a string (x axis label)");
+ label = mus_strdup(Xen_string_to_C_string(xlabel));
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ x0 = Xen_car(arg);
+ Xen_check_type(Xen_is_number(x0), x0, 3, S_graph, "a number (x0)");
+ nominal_x0 = Xen_real_to_C_double(x0);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ x1 = Xen_car(arg);
+ Xen_check_type(Xen_is_number(x1), x1, 4, S_graph, "a number (x1)");
+ nominal_x1 = Xen_real_to_C_double(x1);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ Xen y0;
+ y0 = Xen_car(arg);
+ Xen_check_type(Xen_is_number(y0), y0, 5, S_graph, "a number (y0)");
+ ymin = Xen_real_to_C_double(y0);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ Xen y1;
+ y1 = Xen_car(arg);
+ Xen_check_type(Xen_is_number(y1), y1, 6, S_graph, "a number (y1)");
+ ymax = Xen_real_to_C_double(y1);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ snd = Xen_car(arg);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ chn_n = Xen_car(arg);
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ force_display = Xen_car(arg);
+ Xen_check_type(Xen_is_boolean(force_display), force_display, 9, S_graph, "a boolean (force-display)");
+
+ arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ show_axes = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(show_axes), show_axes, 10, S_graph, "an integer (show-axes choice)");
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ Snd_assert_channel(S_graph, snd, chn_n, 7);
cp = get_cp(snd, chn_n, S_graph);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- ymin = 32768.0;
- ymax = -32768.0;
if ((cp->sound_ctr == NOT_A_SOUND) ||
(cp->sounds == NULL) ||
(cp->sounds[cp->sound_ctr] == NULL) ||
(cp->axis == NULL))
- return(XEN_FALSE);
-
- if (XEN_STRING_P(xlabel)) label = mus_strdup(XEN_TO_C_STRING(xlabel));
- if (XEN_NUMBER_P(x0)) nominal_x0 = XEN_TO_C_DOUBLE(x0); else nominal_x0 = 0.0;
- if (XEN_NUMBER_P(x1)) nominal_x1 = XEN_TO_C_DOUBLE(x1); else nominal_x1 = 1.0;
- if (XEN_NUMBER_P(y0)) ymin = XEN_TO_C_DOUBLE(y0);
- if (XEN_NUMBER_P(y1)) ymax = XEN_TO_C_DOUBLE(y1);
+ return(Xen_false);
- if ((!(XEN_LIST_P(ldata))) ||
- (XEN_NUMBER_P(XEN_CAR(ldata))))
- graphs = 1;
- else graphs = XEN_LIST_LENGTH(ldata);
- if (graphs == 0) return(XEN_FALSE);
lg = cp->lisp_info;
-
if (lg)
{
axis_info *uap = NULL;
@@ -9124,17 +9438,19 @@ If 'data' is a list of numbers, it is treated as an envelope."
}
cp->lisp_info->show_axes = cp->show_axes;
- if (XEN_INTEGER_P(show_axes))
+ if (Xen_is_integer(show_axes))
{
- show_axes_t val;
- val = (show_axes_t)XEN_TO_C_INT(show_axes);
- if (val < NUM_SHOW_AXES)
- cp->lisp_info->show_axes = val;
+ show_axes_t aval;
+ aval = (show_axes_t)Xen_integer_to_C_int(show_axes);
+ if (aval < NUM_SHOW_AXES)
+ cp->lisp_info->show_axes = aval;
}
- if ((XEN_LIST_P_WITH_LENGTH(ldata, len)) &&
- (XEN_NUMBER_P(XEN_CAR(ldata))))
+ if ((Xen_is_list(ldata)) &&
+ (Xen_is_number(Xen_car(ldata))))
{
+ Xen lst;
+ len = Xen_list_length(ldata);
/* just one graph to display */
lg = cp->lisp_info;
lg->env_data = 1;
@@ -9144,10 +9460,9 @@ If 'data' is a list of numbers, it is treated as an envelope."
lg->data[0] = (mus_float_t *)calloc(len, sizeof(mus_float_t));
lg->len[0] = len;
}
- for (i = 0, lst = XEN_COPY_ARG(ldata); i < len; i++, lst = XEN_CDR(lst))
- lg->data[0][i] = XEN_TO_C_DOUBLE(XEN_CAR(lst));
- if ((!XEN_NUMBER_P(y0)) ||
- (!XEN_NUMBER_P(y1)))
+ for (i = 0, lst = Xen_copy_arg(ldata); i < len; i++, lst = Xen_cdr(lst))
+ lg->data[0][i] = Xen_real_to_C_double(Xen_car(lst));
+ if (ymin > ymax)
{
for (i = 1; i < len; i += 2)
{
@@ -9156,29 +9471,30 @@ If 'data' is a list of numbers, it is treated as an envelope."
if (ymax < val) ymax = val;
}
}
- if (!XEN_NUMBER_P(x0)) nominal_x0 = lg->data[0][0];
- if (!XEN_NUMBER_P(x1)) nominal_x1 = lg->data[0][len - 2];
+ if (!Xen_is_number(x0)) nominal_x0 = lg->data[0][0];
+ if (!Xen_is_number(x1)) nominal_x1 = lg->data[0][len - 2];
}
else
{
+ int graph;
lg = cp->lisp_info;
lg->env_data = 0;
for (graph = 0; graph < graphs; graph++)
{
- if (XEN_LIST_P(ldata))
- data = XEN_LIST_REF(ldata, graph);
+ vct *v = NULL;
+ if (Xen_is_list(ldata))
+ data = Xen_list_ref(ldata, graph);
else data = ldata;
- v = XEN_TO_VCT(data);
- len = v->length;
+ v = Xen_to_vct(data);
+ len = mus_vct_length(v);
if (lg->len[graph] != len)
{
if (lg->data[graph]) free(lg->data[graph]);
lg->data[graph] = (mus_float_t *)calloc(len, sizeof(mus_float_t));
lg->len[graph] = len;
}
- memcpy((void *)(lg->data[graph]), (void *)(v->data), len * sizeof(mus_float_t));
- if ((!XEN_NUMBER_P(y0)) ||
- (!XEN_NUMBER_P(y1)))
+ memcpy((void *)(lg->data[graph]), (void *)mus_vct_data(v), len * sizeof(mus_float_t));
+ if (ymin > ymax)
{
for (i = 0; i < len; i++)
{
@@ -9203,15 +9519,15 @@ If 'data' is a list of numbers, it is treated as an envelope."
uap->width = old_width;
uap->graph_x0 = gx0;
}
- cp->graph_lisp_p = true;
- if ((XEN_NOT_BOUND_P(force_display)) ||
- (XEN_NOT_FALSE_P(force_display)))
+ cp->graph_lisp_on = true;
+ if ((!Xen_is_bound(force_display)) ||
+ (!Xen_is_false(force_display)))
{
if (need_update)
update_graph(cp);
else display_channel_lisp_data(cp);
}
- return(XEN_FALSE);
+ return(Xen_false);
/* returning #f here because graph might be last thing in lisp-graph-hook, and we
* don't want its return value mistaken for the "pixel_list" that that hook function
* can return.
@@ -9221,7 +9537,7 @@ If 'data' is a list of numbers, it is treated as an envelope."
#if HAVE_GL
#define S_glSpectrogram "glSpectrogram"
-static XEN g_gl_spectrogram(XEN data, XEN gl_list, XEN cutoff, XEN use_dB, XEN min_dB, XEN scale, XEN br, XEN bg, XEN bb)
+static Xen g_gl_spectrogram(Xen data, Xen gl_list, Xen cutoff, Xen use_dB, Xen min_dB, Xen scale, Xen br, Xen bg, Xen bb)
{
#define H_glSpectrogram "(" S_glSpectrogram " data gl-list cutoff use-dB min-dB scale br bg bb) takes spectrogram \
data and passes it to openGL. See snd-gl.scm for an example."
@@ -9229,88 +9545,73 @@ data and passes it to openGL. See snd-gl.scm for an example."
int i;
vct *v;
- XEN_ASSERT_TYPE(XEN_VECTOR_P(data), data, XEN_ARG_1, S_glSpectrogram, "a vector of vcts");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(gl_list), gl_list, XEN_ARG_2, S_glSpectrogram, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(cutoff), cutoff, XEN_ARG_3, S_glSpectrogram, "a number");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(use_dB), use_dB, XEN_ARG_4, S_glSpectrogram, "a boolean");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(min_dB), min_dB, XEN_ARG_5, S_glSpectrogram, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(scale), scale, XEN_ARG_6, S_glSpectrogram, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(br), br, XEN_ARG_7, S_glSpectrogram, "a number (red value)");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(bg), bg, XEN_ARG_8, S_glSpectrogram, "a number (green value)");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(bb), bb, XEN_ARG_9, S_glSpectrogram, "a number (blue value)");
+ Xen_check_type(Xen_is_vector(data), data, 1, S_glSpectrogram, "a vector of " S_vct "s");
+ Xen_check_type(Xen_is_integer(gl_list), gl_list, 2, S_glSpectrogram, "an integer");
+ Xen_check_type(Xen_is_number(cutoff), cutoff, 3, S_glSpectrogram, "a number");
+ Xen_check_type(Xen_is_boolean(use_dB), use_dB, 4, S_glSpectrogram, "a boolean");
+ Xen_check_type(Xen_is_number(min_dB), min_dB, 5, S_glSpectrogram, "a number");
+ Xen_check_type(Xen_is_number(scale), scale, 6, S_glSpectrogram, "a number");
+ Xen_check_type(Xen_is_number(br), br, 7, S_glSpectrogram, "a number (red value)");
+ Xen_check_type(Xen_is_number(bg), bg, 8, S_glSpectrogram, "a number (green value)");
+ Xen_check_type(Xen_is_number(bb), bb, 9, S_glSpectrogram, "a number (blue value)");
si = (sono_info *)calloc(1, sizeof(sono_info));
- si->active_slices = XEN_VECTOR_LENGTH(data);
+ si->active_slices = Xen_vector_length(data);
si->data = (mus_float_t **)calloc(si->active_slices, sizeof(mus_float_t *));
- v = xen_to_vct(XEN_VECTOR_REF(data, 0));
- si->target_bins = v->length;
- si->scale = XEN_TO_C_DOUBLE(scale);
+ v = xen_to_vct(Xen_vector_ref(data, 0));
+ si->target_bins = mus_vct_length(v);
+ si->scale = Xen_real_to_C_double(scale);
for (i = 0; i < si->active_slices; i++)
{
- v = xen_to_vct(XEN_VECTOR_REF(data, i));
- si->data[i] = v->data;
+ v = xen_to_vct(Xen_vector_ref(data, i));
+ si->data[i] = mus_vct_data(v);
}
gl_spectrogram(si,
- XEN_TO_C_INT(gl_list),
- XEN_TO_C_DOUBLE(cutoff),
- XEN_TO_C_BOOLEAN(use_dB),
- XEN_TO_C_DOUBLE(min_dB),
- FLOAT_TO_RGB(XEN_TO_C_DOUBLE(br)),
- FLOAT_TO_RGB(XEN_TO_C_DOUBLE(bg)),
- FLOAT_TO_RGB(XEN_TO_C_DOUBLE(bb)));
+ Xen_integer_to_C_int(gl_list),
+ Xen_real_to_C_double(cutoff),
+ Xen_boolean_to_C_bool(use_dB),
+ Xen_real_to_C_double(min_dB),
+ float_to_rgb(Xen_real_to_C_double(br)),
+ float_to_rgb(Xen_real_to_C_double(bg)),
+ float_to_rgb(Xen_real_to_C_double(bb)));
free(si->data);
free(si);
- return(XEN_FALSE);
+ return(Xen_false);
}
#endif
-static XEN g_channel_data(XEN snd, XEN chn)
+static Xen g_channel_data(Xen snd, Xen chn)
{
#define H_channel_data "(" S_channel_data " :optional snd chn) returns the in-core samples associated with the \
-given channel. Currently, this must be a channel (sound) created by " S_make_variable_graph "."
+given channel."
chan_info *cp;
- ASSERT_CHANNEL(S_channel_data, snd, chn, 1);
+ Snd_assert_channel(S_channel_data, snd, chn, 1);
cp = get_cp(snd, chn, S_channel_data);
- if ((cp) && (cp->sound) && (cp->sound->inuse == SOUND_WRAPPER))
-#if SNDLIB_USE_FLOATS
- return(wrap_sound_data(1, cp->edits[0]->samples, &(cp->sounds[0]->buffered_data)));
-#else
- {
- /* actually this can't work. We expect that anything we write to the channel data (sound-data) object
- * will be displayed in the associated variable graph, but in the int mus_sample_t case, the two
- * arrays are separate.
- */
- XEN result;
- sound_data *sd;
- mus_long_t i;
- int loc;
- result = make_sound_data(1, cp->edits[0]->samples); /* need actual gc-able object here */
- loc = snd_protect(result);
- sd = XEN_TO_SOUND_DATA(result);
- for (i = 0; i < sd->length; i++)
- sd->data[0][i] = MUS_SAMPLE_TO_DOUBLE(cp->sounds[0]->buffered_data[i]);
- snd_unprotect_at(loc);
- return(result);
- }
-#endif
- return(XEN_FALSE);
+ if ((cp) &&
+ (cp->sound) &&
+ (cp->sound->inuse == SOUND_WRAPPER) &&
+ (cp->sounds) &&
+ (cp->sounds[0]) &&
+ (cp->sounds[0]->buffered_data))
+ return(xen_make_vct_wrapper(cp->edits[0]->samples, cp->sounds[0]->buffered_data));
+ return(Xen_false);
}
-static XEN g_variable_graph_p(XEN index)
+static Xen g_is_variable_graph(Xen index)
{
- #define H_variable_graph_p "(" S_variable_graph_p " :optional snd): " PROC_TRUE " if snd is a variable graph (from " S_make_variable_graph ")."
+ #define H_is_variable_graph "(" S_is_variable_graph " :optional snd): " PROC_TRUE " if snd is a variable graph (from " S_make_variable_graph ")."
snd_info *sp;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(index) || XEN_SOUND_P(index), index, XEN_ONLY_ARG, S_variable_graph_p, "a sound");
+ Xen_check_type(Xen_is_integer(index) || xen_is_sound(index), index, 1, S_is_variable_graph, "a sound");
sp = get_sp(index);
if (sp)
- return(C_TO_XEN_BOOLEAN(sp->inuse == SOUND_WRAPPER));
- return(XEN_FALSE);
+ return(C_bool_to_Xen_boolean(sp->inuse == SOUND_WRAPPER));
+ return(Xen_false);
}
@@ -9320,7 +9621,7 @@ static XEN g_variable_graph_p(XEN index)
* I didn't try the gtk equivalent -- the whole thing is too messy to be trustworthy.
*/
-static XEN g_make_variable_graph(XEN container, XEN name, XEN length, XEN srate)
+static Xen g_make_variable_graph(Xen container, Xen name, Xen length, Xen srate)
{
#define H_make_variable_graph "(" S_make_variable_graph " container :optional name length srate) returns a sound index referring \
to a standard Snd channel graph placed in the widget 'container'."
@@ -9329,30 +9630,30 @@ to a standard Snd channel graph placed in the widget 'container'."
chan_info *cp;
int rate, initial_length;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(container), container, XEN_ARG_1, S_make_variable_graph, "a widget");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(name), name, XEN_ARG_2, S_make_variable_graph, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(length), length, XEN_ARG_3, S_make_variable_graph, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(srate), srate, XEN_ARG_4, S_make_variable_graph, "an integer");
+ Xen_check_type(Xen_is_widget(container), container, 1, S_make_variable_graph, "a widget");
+ Xen_check_type(Xen_is_string_or_unbound(name), name, 2, S_make_variable_graph, "a string");
+ Xen_check_type(Xen_is_integer_or_unbound(length), length, 3, S_make_variable_graph, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(srate), srate, 4, S_make_variable_graph, "an integer");
- rate = XEN_TO_C_INT_OR_ELSE(srate, (int)mus_srate());
- initial_length = XEN_TO_C_INT_OR_ELSE(length, 8192);
+ rate = (Xen_is_integer(srate)) ? Xen_integer_to_C_int(srate) : (int)mus_srate();
+ initial_length = (Xen_is_integer(length)) ? Xen_integer_to_C_int(length) : 8192;
sp = make_simple_channel_display(rate, initial_length, WITH_FW_BUTTONS, graph_style(ss),
- (widget_t)(XEN_UNWRAP_WIDGET(container)), WITH_EVENTS);
+ (widget_t)(Xen_unwrap_widget(container)), WITH_EVENTS);
if (sp == NULL) /* can only happen if "container" is not a form widget (or perhaps no container XtWindow) */
- XEN_ERROR(XEN_ERROR_TYPE("wrong-type-arg"),
- XEN_LIST_2(C_TO_XEN_STRING(S_make_variable_graph ": container, ~A, must be a Form widget with a legitimate window"),
+ Xen_error(Xen_make_error_type("wrong-type-arg"),
+ Xen_list_2(C_string_to_Xen_string(S_make_variable_graph ": container, ~A, must be a Form widget with a legitimate window"),
container));
sp->user_read_only = FILE_READ_ONLY;
sp->index = find_free_sound_slot_for_channel_display();
ss->sounds[sp->index] = sp;
cp = sp->chans[0];
- if (XEN_STRING_P(name))
+ if (Xen_is_string(name))
{
axis_info *ap;
- sp->filename = mus_strdup(XEN_TO_C_STRING(name));
+ sp->filename = mus_strdup(Xen_string_to_C_string(name));
sp->short_filename = mus_strdup(sp->filename);
ap = cp->axis;
if (ap->xlabel) free(ap->xlabel);
@@ -9372,47 +9673,48 @@ to a standard Snd channel graph placed in the widget 'container'."
cp->edits[0] = initial_ed_list(0, initial_length - 1);
cp->edits[0]->origin = mus_strdup(S_make_variable_graph);
- return(C_INT_TO_XEN_SOUND(sp->index));
+ return(C_int_to_Xen_sound(sp->index));
}
-static XEN g_zoom_focus_style(void)
+static Xen g_zoom_focus_style(void)
{
if (zoom_focus_style(ss) != ZOOM_FOCUS_PROC)
- return(C_TO_XEN_INT((int)zoom_focus_style(ss)));
+ return(C_int_to_Xen_integer((int)zoom_focus_style(ss)));
return(ss->zoom_focus_proc);
}
-static XEN g_set_zoom_focus_style(XEN focus)
+static Xen g_set_zoom_focus_style(Xen focus)
{
#define H_zoom_focus_style "(" S_zoom_focus_style "): one of " S_zoom_focus_left ", " S_zoom_focus_right ", " S_zoom_focus_middle \
", or " S_zoom_focus_active ". This determines what zooming centers on (default: " S_zoom_focus_active "). It can also \
be a function of 6 args (snd chan zx x0 x1 range) that returns the new window left edge as a float."
- XEN_ASSERT_TYPE((XEN_INTEGER_P(focus)) || (XEN_PROCEDURE_P(focus)), focus, XEN_ONLY_ARG, S_setB S_zoom_focus_style, "an integer or a function");
- if ((XEN_PROCEDURE_P(focus)) && (!(procedure_arity_ok(focus, 6))))
- return(snd_bad_arity_error(S_setB S_zoom_focus_style,
- C_TO_XEN_STRING("zoom focus func should take 4 args"),
+ Xen_check_type((Xen_is_integer(focus)) || (Xen_is_procedure(focus)), focus, 1, S_set S_zoom_focus_style, "an integer or a function");
+ if ((Xen_is_procedure(focus)) && (!(procedure_arity_ok(focus, 6))))
+ return(snd_bad_arity_error(S_set S_zoom_focus_style,
+ C_string_to_Xen_string("zoom focus func should take 4 args"),
focus));
if (zoom_focus_style(ss) == ZOOM_FOCUS_PROC)
{
snd_unprotect_at(ss->zoom_focus_proc_loc);
- ss->zoom_focus_proc = XEN_UNDEFINED;
+ ss->zoom_focus_proc = Xen_undefined;
}
- if (XEN_INTEGER_P(focus))
+ if (Xen_is_integer(focus))
{
int in_choice;
zoom_focus_t choice;
- in_choice = XEN_TO_C_INT(focus);
+ in_choice = Xen_integer_to_C_int(focus);
if (in_choice < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_zoom_focus_style, 1, focus, "~A, but must be >= 0");
+ Xen_out_of_range_error(S_set S_zoom_focus_style, 1, focus,
+ S_zoom_focus_style " should be " S_zoom_focus_left ", " S_zoom_focus_right ", " S_zoom_focus_middle ", or " S_zoom_focus_active);
choice = (zoom_focus_t)in_choice;
if (choice > ZOOM_FOCUS_MIDDLE)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_zoom_focus_style, 1, focus,
- "~A, but must be " S_zoom_focus_left ", " S_zoom_focus_right ", " S_zoom_focus_middle ", or " S_zoom_focus_active);
+ Xen_out_of_range_error(S_set S_zoom_focus_style, 1, focus,
+ S_zoom_focus_style " should be " S_zoom_focus_left ", " S_zoom_focus_right ", " S_zoom_focus_middle ", or " S_zoom_focus_active);
set_zoom_focus_style(choice);
- return(C_TO_XEN_INT((int)zoom_focus_style(ss)));
+ return(C_int_to_Xen_integer((int)zoom_focus_style(ss)));
}
set_zoom_focus_style(ZOOM_FOCUS_PROC);
ss->zoom_focus_proc = focus;
@@ -9421,565 +9723,416 @@ be a function of 6 args (snd chan zx x0 x1 range) that returns the new window le
}
-static XEN g_with_gl(void) {return(C_TO_XEN_BOOLEAN(with_gl(ss)));}
+static Xen g_with_gl(void) {return(C_bool_to_Xen_boolean(with_gl(ss)));}
-static XEN g_set_with_gl(XEN val)
+static Xen g_set_with_gl(Xen val)
{
#define H_with_gl "(" S_with_gl "): " PROC_TRUE " if Snd should use GL graphics"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_with_gl, "a boolean");
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_with_gl, "a boolean");
#if HAVE_GL
- set_with_gl(XEN_TO_C_BOOLEAN(val), true);
+ set_with_gl(Xen_boolean_to_C_bool(val), true);
for_each_chan(update_graph);
#endif
- return(C_TO_XEN_BOOLEAN(with_gl(ss)));
+ return(C_bool_to_Xen_boolean(with_gl(ss)));
}
-static XEN g_sync_style(void)
+static Xen g_sync_style(void)
{
- return(C_TO_XEN_INT((int)sync_style(ss)));
+ return(C_int_to_Xen_integer((int)sync_style(ss)));
}
-static XEN g_set_sync_style(XEN style)
+static Xen g_set_sync_style(Xen style)
{
int choice;
#define H_sync_style "(" S_sync_style "): one of " S_sync_none ", " S_sync_all ", " \
", or " S_sync_by_sound ". This determines how channels are grouped when a sound is opened."
- XEN_ASSERT_TYPE(XEN_INTEGER_P(style), style, XEN_ONLY_ARG, S_setB S_sync_style, "a sync choice");
- choice = XEN_TO_C_INT(style);
+ Xen_check_type(Xen_is_integer(style), style, 1, S_set S_sync_style, "a sync choice");
+ choice = Xen_integer_to_C_int(style);
if ((choice < 0) || (choice >= NUM_SYNC_STYLES))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_sync_style, 0, style, "style should be one of " S_sync_none ", " S_sync_all ", or " S_sync_by_sound);
+ Xen_out_of_range_error(S_set S_sync_style, 0, style, "style should be one of " S_sync_none ", " S_sync_all ", or " S_sync_by_sound);
set_sync_style((sync_style_t)choice);
- return(C_TO_XEN_INT((int)sync_style(ss)));
-}
-
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_1(g_variable_graph_p_w, g_variable_graph_p)
-XEN_ARGIFY_4(g_make_variable_graph_w, g_make_variable_graph)
-XEN_ARGIFY_2(g_channel_data_w, g_channel_data)
-
-XEN_ARGIFY_10(g_graph_w, g_graph)
-XEN_ARGIFY_2(g_edits_w, g_edits)
-XEN_ARGIFY_3(g_peaks_w, g_peaks)
-XEN_ARGIFY_2(g_edit_hook_w, g_edit_hook)
-XEN_ARGIFY_2(g_after_edit_hook_w, g_after_edit_hook)
-XEN_ARGIFY_2(g_undo_hook_w, g_undo_hook)
-XEN_ARGIFY_2(g_ap_sx_w, g_ap_sx)
-XEN_ARGIFY_3(g_set_ap_sx_w, g_set_ap_sx)
-XEN_ARGIFY_2(g_ap_sy_w, g_ap_sy)
-XEN_ARGIFY_3(g_set_ap_sy_w, g_set_ap_sy)
-XEN_ARGIFY_2(g_ap_zx_w, g_ap_zx)
-XEN_ARGIFY_3(g_set_ap_zx_w, g_set_ap_zx)
-XEN_ARGIFY_2(g_ap_zy_w, g_ap_zy)
-XEN_ARGIFY_3(g_set_ap_zy_w, g_set_ap_zy)
-XEN_ARGIFY_3(g_frames_w, g_frames)
-XEN_ARGIFY_3(g_set_frames_w, g_set_frames)
-XEN_ARGIFY_3(g_maxamp_position_w, g_maxamp_position)
-XEN_ARGIFY_3(g_maxamp_w, g_maxamp)
-XEN_ARGIFY_3(g_set_maxamp_w, g_set_maxamp)
-XEN_ARGIFY_2(g_cursor_position_w, g_cursor_position)
-XEN_ARGIFY_2(g_edit_position_w, g_edit_position)
-XEN_ARGIFY_3(g_set_edit_position_w, g_set_edit_position)
-XEN_ARGIFY_2(g_transform_graph_p_w, g_transform_graph_p)
-XEN_ARGIFY_3(g_set_transform_graph_p_w, g_set_transform_graph_p)
-XEN_ARGIFY_2(g_time_graph_p_w, g_time_graph_p)
-XEN_ARGIFY_3(g_set_time_graph_p_w, g_set_time_graph_p)
-XEN_ARGIFY_2(g_lisp_graph_p_w, g_lisp_graph_p)
-XEN_ARGIFY_3(g_set_lisp_graph_p_w, g_set_lisp_graph_p)
-XEN_ARGIFY_2(g_squelch_update_w, g_squelch_update)
-XEN_ARGIFY_3(g_set_squelch_update_w, g_set_squelch_update)
-XEN_ARGIFY_3(g_cursor_w, g_cursor)
-XEN_ARGIFY_4(g_set_cursor_w, g_set_cursor)
-XEN_ARGIFY_2(g_cursor_style_w, g_cursor_style)
-XEN_ARGIFY_3(g_set_cursor_style_w, g_set_cursor_style)
-XEN_ARGIFY_2(g_tracking_cursor_style_w, g_tracking_cursor_style)
-XEN_ARGIFY_3(g_set_tracking_cursor_style_w, g_set_tracking_cursor_style)
-XEN_ARGIFY_2(g_cursor_size_w, g_cursor_size)
-XEN_ARGIFY_3(g_set_cursor_size_w, g_set_cursor_size)
-XEN_ARGIFY_2(g_left_sample_w, g_left_sample)
-XEN_ARGIFY_3(g_set_left_sample_w, g_set_left_sample)
-XEN_ARGIFY_2(g_right_sample_w, g_right_sample)
-XEN_ARGIFY_3(g_set_right_sample_w, g_set_right_sample)
-XEN_ARGIFY_2(g_channel_properties_w, g_channel_properties)
-XEN_ARGIFY_3(g_set_channel_properties_w, g_set_channel_properties)
-XEN_ARGIFY_3(g_channel_property_w, g_channel_property)
-XEN_ARGIFY_4(g_set_channel_property_w, g_set_channel_property)
-XEN_ARGIFY_3(g_edit_properties_w, g_edit_properties)
-XEN_ARGIFY_4(g_set_edit_properties_w, g_set_edit_properties)
-XEN_ARGIFY_4(g_edit_property_w, g_edit_property)
-XEN_ARGIFY_5(g_set_edit_property_w, g_set_edit_property)
-XEN_ARGIFY_2(g_max_transform_peaks_w, g_max_transform_peaks)
-XEN_ARGIFY_3(g_set_max_transform_peaks_w, g_set_max_transform_peaks)
-XEN_ARGIFY_2(g_show_y_zero_w, g_show_y_zero)
-XEN_ARGIFY_3(g_set_show_y_zero_w, g_set_show_y_zero)
-XEN_ARGIFY_2(g_show_grid_w, g_show_grid)
-XEN_ARGIFY_3(g_set_show_grid_w, g_set_show_grid)
-XEN_ARGIFY_2(g_grid_density_w, g_grid_density)
-XEN_ARGIFY_3(g_set_grid_density_w, g_set_grid_density)
-XEN_ARGIFY_2(g_show_sonogram_cursor_w, g_show_sonogram_cursor)
-XEN_ARGIFY_3(g_set_show_sonogram_cursor_w, g_set_show_sonogram_cursor)
-XEN_ARGIFY_2(g_show_marks_w, g_show_marks)
-XEN_ARGIFY_3(g_set_show_marks_w, g_set_show_marks)
-XEN_ARGIFY_2(g_time_graph_type_w, g_time_graph_type)
-XEN_ARGIFY_3(g_set_time_graph_type_w, g_set_time_graph_type)
-XEN_ARGIFY_2(g_wavo_hop_w, g_wavo_hop)
-XEN_ARGIFY_3(g_set_wavo_hop_w, g_set_wavo_hop)
-XEN_ARGIFY_2(g_wavo_trace_w, g_wavo_trace)
-XEN_ARGIFY_3(g_set_wavo_trace_w, g_set_wavo_trace)
-XEN_ARGIFY_2(g_show_transform_peaks_w, g_show_transform_peaks)
-XEN_ARGIFY_3(g_set_show_transform_peaks_w, g_set_show_transform_peaks)
-XEN_ARGIFY_2(g_zero_pad_w, g_zero_pad)
-XEN_ARGIFY_3(g_set_zero_pad_w, g_set_zero_pad)
-XEN_ARGIFY_2(g_verbose_cursor_w, g_verbose_cursor)
-XEN_ARGIFY_3(g_set_verbose_cursor_w, g_set_verbose_cursor)
-XEN_ARGIFY_2(g_fft_log_frequency_w, g_fft_log_frequency)
-XEN_ARGIFY_3(g_set_fft_log_frequency_w, g_set_fft_log_frequency)
-XEN_ARGIFY_2(g_fft_log_magnitude_w, g_fft_log_magnitude)
-XEN_ARGIFY_3(g_set_fft_log_magnitude_w, g_set_fft_log_magnitude)
-XEN_ARGIFY_2(g_fft_with_phases_w, g_fft_with_phases)
-XEN_ARGIFY_3(g_set_fft_with_phases_w, g_set_fft_with_phases)
-XEN_ARGIFY_2(g_min_dB_w, g_min_dB)
-XEN_ARGIFY_3(g_set_min_dB_w, g_set_min_dB)
-XEN_ARGIFY_2(g_wavelet_type_w, g_wavelet_type)
-XEN_ARGIFY_3(g_set_wavelet_type_w, g_set_wavelet_type)
-XEN_ARGIFY_2(g_spectrum_end_w, g_spectrum_end)
-XEN_ARGIFY_3(g_set_spectrum_end_w, g_set_spectrum_end)
-XEN_ARGIFY_2(g_spectrum_start_w, g_spectrum_start)
-XEN_ARGIFY_3(g_set_spectrum_start_w, g_set_spectrum_start)
-XEN_ARGIFY_2(g_spectro_x_angle_w, g_spectro_x_angle)
-XEN_ARGIFY_3(g_set_spectro_x_angle_w, g_set_spectro_x_angle)
-XEN_ARGIFY_2(g_spectro_x_scale_w, g_spectro_x_scale)
-XEN_ARGIFY_3(g_set_spectro_x_scale_w, g_set_spectro_x_scale)
-XEN_ARGIFY_2(g_spectro_y_angle_w, g_spectro_y_angle)
-XEN_ARGIFY_3(g_set_spectro_y_angle_w, g_set_spectro_y_angle)
-XEN_ARGIFY_2(g_spectro_y_scale_w, g_spectro_y_scale)
-XEN_ARGIFY_3(g_set_spectro_y_scale_w, g_set_spectro_y_scale)
-XEN_ARGIFY_2(g_spectro_z_angle_w, g_spectro_z_angle)
-XEN_ARGIFY_3(g_set_spectro_z_angle_w, g_set_spectro_z_angle)
-XEN_ARGIFY_2(g_spectro_z_scale_w, g_spectro_z_scale)
-XEN_ARGIFY_3(g_set_spectro_z_scale_w, g_set_spectro_z_scale)
-XEN_ARGIFY_2(g_fft_window_alpha_w, g_fft_window_alpha)
-XEN_ARGIFY_3(g_set_fft_window_alpha_w, g_set_fft_window_alpha)
-XEN_ARGIFY_2(g_fft_window_beta_w, g_fft_window_beta)
-XEN_ARGIFY_3(g_set_fft_window_beta_w, g_set_fft_window_beta)
-XEN_ARGIFY_2(g_spectro_hop_w, g_spectro_hop)
-XEN_ARGIFY_3(g_set_spectro_hop_w, g_set_spectro_hop)
-XEN_ARGIFY_2(g_transform_size_w, g_transform_size)
-XEN_ARGIFY_3(g_set_transform_size_w, g_set_transform_size)
-XEN_ARGIFY_2(g_transform_graph_type_w, g_transform_graph_type)
-XEN_ARGIFY_3(g_set_transform_graph_type_w, g_set_transform_graph_type)
-XEN_ARGIFY_2(g_fft_window_w, g_fft_window)
-XEN_ARGIFY_3(g_set_fft_window_w, g_set_fft_window)
-XEN_ARGIFY_2(g_transform_type_w, g_transform_type)
-XEN_ARGIFY_3(g_set_transform_type_w, g_set_transform_type)
-XEN_ARGIFY_2(g_transform_normalization_w, g_transform_normalization)
-XEN_ARGIFY_3(g_set_transform_normalization_w, g_set_transform_normalization)
-XEN_ARGIFY_2(g_show_mix_waveforms_w, g_show_mix_waveforms)
-XEN_ARGIFY_3(g_set_show_mix_waveforms_w, g_set_show_mix_waveforms)
-XEN_ARGIFY_2(g_graph_style_w, g_graph_style)
-XEN_ARGIFY_3(g_set_graph_style_w, g_set_graph_style)
-XEN_ARGIFY_2(g_time_graph_style_w, g_time_graph_style)
-XEN_ARGIFY_3(g_set_time_graph_style_w, g_set_time_graph_style)
-XEN_ARGIFY_2(g_lisp_graph_style_w, g_lisp_graph_style)
-XEN_ARGIFY_3(g_set_lisp_graph_style_w, g_set_lisp_graph_style)
-XEN_ARGIFY_2(g_transform_graph_style_w, g_transform_graph_style)
-XEN_ARGIFY_3(g_set_transform_graph_style_w, g_set_transform_graph_style)
-XEN_ARGIFY_2(g_dot_size_w, g_dot_size)
-XEN_ARGIFY_3(g_set_dot_size_w, g_set_dot_size)
-XEN_ARGIFY_2(g_x_axis_style_w, g_x_axis_style)
-XEN_ARGIFY_3(g_set_x_axis_style_w, g_set_x_axis_style)
-XEN_ARGIFY_2(g_beats_per_measure_w, g_beats_per_measure)
-XEN_ARGIFY_3(g_set_beats_per_measure_w, g_set_beats_per_measure)
-XEN_ARGIFY_2(g_beats_per_minute_w, g_beats_per_minute)
-XEN_ARGIFY_3(g_set_beats_per_minute_w, g_set_beats_per_minute)
-XEN_ARGIFY_2(g_show_axes_w, g_show_axes)
-XEN_ARGIFY_3(g_set_show_axes_w, g_set_show_axes)
-XEN_ARGIFY_2(g_graphs_horizontal_w, g_graphs_horizontal)
-XEN_ARGIFY_3(g_set_graphs_horizontal_w, g_set_graphs_horizontal)
-XEN_ARGIFY_2(g_update_time_graph_w, g_update_time_graph)
-XEN_ARGIFY_2(g_update_lisp_graph_w, g_update_lisp_graph)
-XEN_ARGIFY_2(g_update_transform_graph_w, g_update_transform_graph)
-XEN_NARGIFY_0(g_zoom_focus_style_w, g_zoom_focus_style)
-XEN_NARGIFY_1(g_set_zoom_focus_style_w, g_set_zoom_focus_style)
-XEN_NARGIFY_0(g_sync_style_w, g_sync_style)
-XEN_NARGIFY_1(g_set_sync_style_w, g_set_sync_style)
-XEN_NARGIFY_0(g_with_gl_w, g_with_gl)
-XEN_NARGIFY_1(g_set_with_gl_w, g_set_with_gl)
-#if HAVE_GL
- XEN_NARGIFY_9(g_gl_spectrogram_w, g_gl_spectrogram)
-#endif
+ return(C_int_to_Xen_integer((int)sync_style(ss)));
+}
+
+
+
+Xen_wrap_1_arg(g_is_variable_graph_w, g_is_variable_graph)
+Xen_wrap_4_optional_args(g_make_variable_graph_w, g_make_variable_graph)
+Xen_wrap_2_optional_args(g_channel_data_w, g_channel_data)
+
+Xen_wrap_any_args(g_graph_w, g_graph)
+Xen_wrap_2_optional_args(g_edits_w, g_edits)
+Xen_wrap_3_optional_args(g_peaks_w, g_peaks)
+Xen_wrap_2_optional_args(g_edit_hook_w, g_edit_hook)
+Xen_wrap_2_optional_args(g_after_edit_hook_w, g_after_edit_hook)
+Xen_wrap_2_optional_args(g_undo_hook_w, g_undo_hook)
+Xen_wrap_2_optional_args(g_ap_sx_w, g_ap_sx)
+Xen_wrap_2_optional_args(g_ap_sy_w, g_ap_sy)
+Xen_wrap_2_optional_args(g_ap_zx_w, g_ap_zx)
+Xen_wrap_2_optional_args(g_ap_zy_w, g_ap_zy)
+Xen_wrap_3_optional_args(g_framples_w, g_framples)
+Xen_wrap_3_optional_args(g_maxamp_position_w, g_maxamp_position)
+Xen_wrap_3_optional_args(g_maxamp_w, g_maxamp)
+Xen_wrap_2_optional_args(g_cursor_position_w, g_cursor_position)
+Xen_wrap_2_optional_args(g_edit_position_w, g_edit_position)
+Xen_wrap_2_optional_args(g_transform_graph_on_w, g_transform_graph_on)
+Xen_wrap_2_optional_args(g_timer_graph_on_w, g_timer_graph_on)
+Xen_wrap_2_optional_args(g_lisp_graph_on_w, g_lisp_graph_on)
+Xen_wrap_2_optional_args(g_squelch_update_w, g_squelch_update)
+Xen_wrap_3_optional_args(g_cursor_w, g_cursor)
+Xen_wrap_2_optional_args(g_cursor_style_w, g_cursor_style)
+Xen_wrap_2_optional_args(g_tracking_cursor_style_w, g_tracking_cursor_style)
+Xen_wrap_2_optional_args(g_cursor_size_w, g_cursor_size)
+Xen_wrap_2_optional_args(g_left_sample_w, g_left_sample)
+Xen_wrap_2_optional_args(g_right_sample_w, g_right_sample)
+Xen_wrap_2_optional_args(g_channel_properties_w, g_channel_properties)
+Xen_wrap_3_optional_args(g_channel_property_w, g_channel_property)
+Xen_wrap_3_optional_args(g_edit_properties_w, g_edit_properties)
+Xen_wrap_4_optional_args(g_edit_property_w, g_edit_property)
+Xen_wrap_2_optional_args(g_max_transform_peaks_w, g_max_transform_peaks)
+Xen_wrap_2_optional_args(g_show_y_zero_w, g_show_y_zero)
+Xen_wrap_2_optional_args(g_show_grid_w, g_show_grid)
+Xen_wrap_2_optional_args(g_grid_density_w, g_grid_density)
+Xen_wrap_2_optional_args(g_show_sonogram_cursor_w, g_show_sonogram_cursor)
+Xen_wrap_2_optional_args(g_show_marks_w, g_show_marks)
+Xen_wrap_2_optional_args(g_time_graph_type_w, g_time_graph_type)
+Xen_wrap_2_optional_args(g_wavo_hop_w, g_wavo_hop)
+Xen_wrap_2_optional_args(g_wavo_trace_w, g_wavo_trace)
+Xen_wrap_2_optional_args(g_show_transform_peaks_w, g_show_transform_peaks)
+Xen_wrap_2_optional_args(g_zero_pad_w, g_zero_pad)
+Xen_wrap_2_optional_args(g_with_verbose_cursor_w, g_with_verbose_cursor)
+Xen_wrap_2_optional_args(g_fft_log_frequency_w, g_fft_log_frequency)
+Xen_wrap_2_optional_args(g_fft_log_magnitude_w, g_fft_log_magnitude)
+Xen_wrap_2_optional_args(g_fft_with_phases_w, g_fft_with_phases)
+Xen_wrap_2_optional_args(g_min_dB_w, g_min_dB)
+Xen_wrap_2_optional_args(g_wavelet_type_w, g_wavelet_type)
+Xen_wrap_2_optional_args(g_spectrum_end_w, g_spectrum_end)
+Xen_wrap_2_optional_args(g_spectrum_start_w, g_spectrum_start)
+Xen_wrap_2_optional_args(g_spectro_x_angle_w, g_spectro_x_angle)
+Xen_wrap_2_optional_args(g_spectro_x_scale_w, g_spectro_x_scale)
+Xen_wrap_2_optional_args(g_spectro_y_angle_w, g_spectro_y_angle)
+Xen_wrap_2_optional_args(g_spectro_y_scale_w, g_spectro_y_scale)
+Xen_wrap_2_optional_args(g_spectro_z_angle_w, g_spectro_z_angle)
+Xen_wrap_2_optional_args(g_spectro_z_scale_w, g_spectro_z_scale)
+Xen_wrap_2_optional_args(g_fft_window_alpha_w, g_fft_window_alpha)
+Xen_wrap_2_optional_args(g_fft_window_beta_w, g_fft_window_beta)
+Xen_wrap_2_optional_args(g_spectro_hop_w, g_spectro_hop)
+Xen_wrap_2_optional_args(g_transform_size_w, g_transform_size)
+Xen_wrap_2_optional_args(g_transform_graph_type_w, g_transform_graph_type)
+Xen_wrap_2_optional_args(g_fft_window_w, g_fft_window)
+Xen_wrap_2_optional_args(g_transform_type_w, g_transform_type)
+Xen_wrap_2_optional_args(g_transform_normalization_w, g_transform_normalization)
+Xen_wrap_2_optional_args(g_show_mix_waveforms_w, g_show_mix_waveforms)
+Xen_wrap_2_optional_args(g_graph_style_w, g_graph_style)
+Xen_wrap_2_optional_args(g_time_graph_style_w, g_time_graph_style)
+Xen_wrap_2_optional_args(g_lisp_graph_style_w, g_lisp_graph_style)
+Xen_wrap_2_optional_args(g_transform_graph_style_w, g_transform_graph_style)
+Xen_wrap_2_optional_args(g_dot_size_w, g_dot_size)
+Xen_wrap_2_optional_args(g_x_axis_style_w, g_x_axis_style)
+Xen_wrap_2_optional_args(g_beats_per_measure_w, g_beats_per_measure)
+Xen_wrap_2_optional_args(g_beats_per_minute_w, g_beats_per_minute)
+Xen_wrap_2_optional_args(g_show_axes_w, g_show_axes)
+Xen_wrap_2_optional_args(g_graphs_horizontal_w, g_graphs_horizontal)
+Xen_wrap_2_optional_args(g_update_time_graph_w, g_update_time_graph)
+Xen_wrap_2_optional_args(g_update_lisp_graph_w, g_update_lisp_graph)
+Xen_wrap_2_optional_args(g_update_transform_graph_w, g_update_transform_graph)
+Xen_wrap_no_args(g_zoom_focus_style_w, g_zoom_focus_style)
+Xen_wrap_1_arg(g_set_zoom_focus_style_w, g_set_zoom_focus_style)
+Xen_wrap_no_args(g_sync_style_w, g_sync_style)
+Xen_wrap_1_arg(g_set_sync_style_w, g_set_sync_style)
+Xen_wrap_no_args(g_with_gl_w, g_with_gl)
+Xen_wrap_1_arg(g_set_with_gl_w, g_set_with_gl)
+#if HAVE_SCHEME
+#define g_set_ap_sx_w g_set_ap_sx_reversed
+#define g_set_ap_sy_w g_set_ap_sy_reversed
+#define g_set_ap_zx_w g_set_ap_zx_reversed
+#define g_set_ap_zy_w g_set_ap_zy_reversed
+#define g_set_framples_w g_set_framples_reversed
+#define g_set_maxamp_w g_set_maxamp_reversed
+#define g_set_edit_position_w g_set_edit_position_reversed
+#define g_set_transform_graph_on_w g_set_transform_graph_on_reversed
+#define g_set_timer_graph_on_w g_set_timer_graph_on_reversed
+#define g_set_lisp_graph_on_w g_set_lisp_graph_on_reversed
+#define g_set_squelch_update_w g_set_squelch_update_reversed
+#define g_set_cursor_w g_set_cursor_reversed
+#define g_set_cursor_style_w g_set_cursor_style_reversed
+#define g_set_tracking_cursor_style_w g_set_tracking_cursor_style_reversed
+#define g_set_cursor_size_w g_set_cursor_size_reversed
+#define g_set_left_sample_w g_set_left_sample_reversed
+#define g_set_right_sample_w g_set_right_sample_reversed
+#define g_set_channel_properties_w g_set_channel_properties_reversed
+#define g_set_channel_property_w g_set_channel_property_reversed
+#define g_set_edit_properties_w g_set_edit_properties_reversed
+#define g_set_edit_property_w g_set_edit_property_reversed
+#define g_set_max_transform_peaks_w g_set_max_transform_peaks_reversed
+#define g_set_show_y_zero_w g_set_show_y_zero_reversed
+#define g_set_show_grid_w g_set_show_grid_reversed
+#define g_set_grid_density_w g_set_grid_density_reversed
+#define g_set_show_sonogram_cursor_w g_set_show_sonogram_cursor_reversed
+#define g_set_show_marks_w g_set_show_marks_reversed
+#define g_set_time_graph_type_w g_set_time_graph_type_reversed
+#define g_set_wavo_hop_w g_set_wavo_hop_reversed
+#define g_set_wavo_trace_w g_set_wavo_trace_reversed
+#define g_set_show_transform_peaks_w g_set_show_transform_peaks_reversed
+#define g_set_zero_pad_w g_set_zero_pad_reversed
+#define g_set_with_verbose_cursor_w g_set_with_verbose_cursor_reversed
+#define g_set_fft_log_frequency_w g_set_fft_log_frequency_reversed
+#define g_set_fft_log_magnitude_w g_set_fft_log_magnitude_reversed
+#define g_set_fft_with_phases_w g_set_fft_with_phases_reversed
+#define g_set_min_dB_w g_set_min_dB_reversed
+#define g_set_wavelet_type_w g_set_wavelet_type_reversed
+#define g_set_spectrum_end_w g_set_spectrum_end_reversed
+#define g_set_spectrum_start_w g_set_spectrum_start_reversed
+#define g_set_spectro_x_angle_w g_set_spectro_x_angle_reversed
+#define g_set_spectro_x_scale_w g_set_spectro_x_scale_reversed
+#define g_set_spectro_y_angle_w g_set_spectro_y_angle_reversed
+#define g_set_spectro_y_scale_w g_set_spectro_y_scale_reversed
+#define g_set_spectro_z_angle_w g_set_spectro_z_angle_reversed
+#define g_set_spectro_z_scale_w g_set_spectro_z_scale_reversed
+#define g_set_fft_window_alpha_w g_set_fft_window_alpha_reversed
+#define g_set_fft_window_beta_w g_set_fft_window_beta_reversed
+#define g_set_spectro_hop_w g_set_spectro_hop_reversed
+#define g_set_transform_size_w g_set_transform_size_reversed
+#define g_set_transform_graph_type_w g_set_transform_graph_type_reversed
+#define g_set_fft_window_w g_set_fft_window_reversed
+#define g_set_transform_type_w g_set_transform_type_reversed
+#define g_set_transform_normalization_w g_set_transform_normalization_reversed
+#define g_set_show_mix_waveforms_w g_set_show_mix_waveforms_reversed
+#define g_set_graph_style_w g_set_graph_style_reversed
+#define g_set_time_graph_style_w g_set_time_graph_style_reversed
+#define g_set_lisp_graph_style_w g_set_lisp_graph_style_reversed
+#define g_set_transform_graph_style_w g_set_transform_graph_style_reversed
+#define g_set_dot_size_w g_set_dot_size_reversed
+#define g_set_x_axis_style_w g_set_x_axis_style_reversed
+#define g_set_beats_per_measure_w g_set_beats_per_measure_reversed
+#define g_set_show_axes_w g_set_show_axes_reversed
+#define g_set_beats_per_minute_w g_set_beats_per_minute_reversed
+#define g_set_graphs_horizontal_w g_set_graphs_horizontal_reversed
#else
-#define g_variable_graph_p_w g_variable_graph_p
-#define g_make_variable_graph_w g_make_variable_graph
-#define g_channel_data_w g_channel_data
-
-#define g_graph_w g_graph
-#define g_edits_w g_edits
-#define g_peaks_w g_peaks
-#define g_edit_hook_w g_edit_hook
-#define g_after_edit_hook_w g_after_edit_hook
-#define g_undo_hook_w g_undo_hook
-#define g_ap_sx_w g_ap_sx
-#define g_set_ap_sx_w g_set_ap_sx
-#define g_ap_sy_w g_ap_sy
-#define g_set_ap_sy_w g_set_ap_sy
-#define g_ap_zx_w g_ap_zx
-#define g_set_ap_zx_w g_set_ap_zx
-#define g_ap_zy_w g_ap_zy
-#define g_set_ap_zy_w g_set_ap_zy
-#define g_frames_w g_frames
-#define g_set_frames_w g_set_frames
-#define g_maxamp_position_w g_maxamp_position
-#define g_maxamp_w g_maxamp
-#define g_set_maxamp_w g_set_maxamp
-#define g_cursor_position_w g_cursor_position
-#define g_edit_position_w g_edit_position
-#define g_set_edit_position_w g_set_edit_position
-#define g_transform_graph_p_w g_transform_graph_p
-#define g_set_transform_graph_p_w g_set_transform_graph_p
-#define g_time_graph_p_w g_time_graph_p
-#define g_set_time_graph_p_w g_set_time_graph_p
-#define g_lisp_graph_p_w g_lisp_graph_p
-#define g_set_lisp_graph_p_w g_set_lisp_graph_p
-#define g_squelch_update_w g_squelch_update
-#define g_set_squelch_update_w g_set_squelch_update
-#define g_cursor_w g_cursor
-#define g_set_cursor_w g_set_cursor
-#define g_cursor_style_w g_cursor_style
-#define g_set_cursor_style_w g_set_cursor_style
-#define g_tracking_cursor_style_w g_tracking_cursor_style
-#define g_set_tracking_cursor_style_w g_set_tracking_cursor_style
-#define g_cursor_size_w g_cursor_size
-#define g_set_cursor_size_w g_set_cursor_size
-#define g_left_sample_w g_left_sample
-#define g_set_left_sample_w g_set_left_sample
-#define g_right_sample_w g_right_sample
-#define g_set_right_sample_w g_set_right_sample
-#define g_channel_properties_w g_channel_properties
-#define g_set_channel_properties_w g_set_channel_properties
-#define g_channel_property_w g_channel_property
-#define g_set_channel_property_w g_set_channel_property
-#define g_edit_properties_w g_edit_properties
-#define g_set_edit_properties_w g_set_edit_properties
-#define g_edit_property_w g_edit_property
-#define g_set_edit_property_w g_set_edit_property
-#define g_max_transform_peaks_w g_max_transform_peaks
-#define g_set_max_transform_peaks_w g_set_max_transform_peaks
-#define g_show_y_zero_w g_show_y_zero
-#define g_set_show_y_zero_w g_set_show_y_zero
-#define g_show_grid_w g_show_grid
-#define g_set_show_grid_w g_set_show_grid
-#define g_grid_density_w g_grid_density
-#define g_set_grid_density_w g_set_grid_density
-#define g_show_sonogram_cursor_w g_show_sonogram_cursor
-#define g_set_show_sonogram_cursor_w g_set_show_sonogram_cursor
-#define g_show_marks_w g_show_marks
-#define g_set_show_marks_w g_set_show_marks
-#define g_time_graph_type_w g_time_graph_type
-#define g_set_time_graph_type_w g_set_time_graph_type
-#define g_wavo_hop_w g_wavo_hop
-#define g_set_wavo_hop_w g_set_wavo_hop
-#define g_wavo_trace_w g_wavo_trace
-#define g_set_wavo_trace_w g_set_wavo_trace
-#define g_show_transform_peaks_w g_show_transform_peaks
-#define g_set_show_transform_peaks_w g_set_show_transform_peaks
-#define g_zero_pad_w g_zero_pad
-#define g_set_zero_pad_w g_set_zero_pad
-#define g_verbose_cursor_w g_verbose_cursor
-#define g_set_verbose_cursor_w g_set_verbose_cursor
-#define g_fft_log_frequency_w g_fft_log_frequency
-#define g_set_fft_log_frequency_w g_set_fft_log_frequency
-#define g_fft_log_magnitude_w g_fft_log_magnitude
-#define g_set_fft_log_magnitude_w g_set_fft_log_magnitude
-#define g_fft_with_phases_w g_fft_with_phases
-#define g_set_fft_with_phases_w g_set_fft_with_phases
-#define g_min_dB_w g_min_dB
-#define g_set_min_dB_w g_set_min_dB
-#define g_wavelet_type_w g_wavelet_type
-#define g_set_wavelet_type_w g_set_wavelet_type
-#define g_spectrum_end_w g_spectrum_end
-#define g_set_spectrum_end_w g_set_spectrum_end
-#define g_spectrum_start_w g_spectrum_start
-#define g_set_spectrum_start_w g_set_spectrum_start
-#define g_spectro_x_angle_w g_spectro_x_angle
-#define g_set_spectro_x_angle_w g_set_spectro_x_angle
-#define g_spectro_x_scale_w g_spectro_x_scale
-#define g_set_spectro_x_scale_w g_set_spectro_x_scale
-#define g_spectro_y_angle_w g_spectro_y_angle
-#define g_set_spectro_y_angle_w g_set_spectro_y_angle
-#define g_spectro_y_scale_w g_spectro_y_scale
-#define g_set_spectro_y_scale_w g_set_spectro_y_scale
-#define g_spectro_z_angle_w g_spectro_z_angle
-#define g_set_spectro_z_angle_w g_set_spectro_z_angle
-#define g_spectro_z_scale_w g_spectro_z_scale
-#define g_set_spectro_z_scale_w g_set_spectro_z_scale
-#define g_fft_window_beta_w g_fft_window_beta
-#define g_set_fft_window_beta_w g_set_fft_window_beta
-#define g_fft_window_alpha_w g_fft_window_alpha
-#define g_set_fft_window_alpha_w g_set_fft_window_alpha
-#define g_spectro_hop_w g_spectro_hop
-#define g_set_spectro_hop_w g_set_spectro_hop
-#define g_transform_size_w g_transform_size
-#define g_set_transform_size_w g_set_transform_size
-#define g_transform_graph_type_w g_transform_graph_type
-#define g_set_transform_graph_type_w g_set_transform_graph_type
-#define g_fft_window_w g_fft_window
-#define g_set_fft_window_w g_set_fft_window
-#define g_transform_type_w g_transform_type
-#define g_set_transform_type_w g_set_transform_type
-#define g_transform_normalization_w g_transform_normalization
-#define g_set_transform_normalization_w g_set_transform_normalization
-#define g_show_mix_waveforms_w g_show_mix_waveforms
-#define g_set_show_mix_waveforms_w g_set_show_mix_waveforms
-#define g_graph_style_w g_graph_style
-#define g_set_graph_style_w g_set_graph_style
-#define g_time_graph_style_w g_time_graph_style
-#define g_set_time_graph_style_w g_set_time_graph_style
-#define g_lisp_graph_style_w g_lisp_graph_style
-#define g_set_lisp_graph_style_w g_set_lisp_graph_style
-#define g_transform_graph_style_w g_transform_graph_style
-#define g_set_transform_graph_style_w g_set_transform_graph_style
-#define g_dot_size_w g_dot_size
-#define g_set_dot_size_w g_set_dot_size
-#define g_x_axis_style_w g_x_axis_style
-#define g_set_x_axis_style_w g_set_x_axis_style
-#define g_beats_per_measure_w g_beats_per_measure
-#define g_set_beats_per_measure_w g_set_beats_per_measure
-#define g_beats_per_minute_w g_beats_per_minute
-#define g_set_beats_per_minute_w g_set_beats_per_minute
-#define g_show_axes_w g_show_axes
-#define g_set_show_axes_w g_set_show_axes
-#define g_graphs_horizontal_w g_graphs_horizontal
-#define g_set_graphs_horizontal_w g_set_graphs_horizontal
-#define g_update_time_graph_w g_update_time_graph
-#define g_update_lisp_graph_w g_update_lisp_graph
-#define g_update_transform_graph_w g_update_transform_graph
-#define g_zoom_focus_style_w g_zoom_focus_style
-#define g_set_zoom_focus_style_w g_set_zoom_focus_style
-#define g_sync_style_w g_sync_style
-#define g_set_sync_style_w g_set_sync_style
-#define g_with_gl_w g_with_gl
-#define g_set_with_gl_w g_set_with_gl
+Xen_wrap_3_optional_args(g_set_ap_sx_w, g_set_ap_sx)
+Xen_wrap_3_optional_args(g_set_ap_sy_w, g_set_ap_sy)
+Xen_wrap_3_optional_args(g_set_ap_zx_w, g_set_ap_zx)
+Xen_wrap_3_optional_args(g_set_ap_zy_w, g_set_ap_zy)
+Xen_wrap_3_optional_args(g_set_framples_w, g_set_framples)
+Xen_wrap_3_optional_args(g_set_maxamp_w, g_set_maxamp)
+Xen_wrap_3_optional_args(g_set_edit_position_w, g_set_edit_position)
+Xen_wrap_3_optional_args(g_set_transform_graph_on_w, g_set_transform_graph_on)
+Xen_wrap_3_optional_args(g_set_timer_graph_on_w, g_set_timer_graph_on)
+Xen_wrap_3_optional_args(g_set_lisp_graph_on_w, g_set_lisp_graph_on)
+Xen_wrap_3_optional_args(g_set_squelch_update_w, g_set_squelch_update)
+Xen_wrap_4_optional_args(g_set_cursor_w, g_set_cursor)
+Xen_wrap_3_optional_args(g_set_cursor_style_w, g_set_cursor_style)
+Xen_wrap_3_optional_args(g_set_tracking_cursor_style_w, g_set_tracking_cursor_style)
+Xen_wrap_3_optional_args(g_set_cursor_size_w, g_set_cursor_size)
+Xen_wrap_3_optional_args(g_set_left_sample_w, g_set_left_sample)
+Xen_wrap_3_optional_args(g_set_right_sample_w, g_set_right_sample)
+Xen_wrap_3_optional_args(g_set_channel_properties_w, g_set_channel_properties)
+Xen_wrap_4_optional_args(g_set_channel_property_w, g_set_channel_property)
+Xen_wrap_4_optional_args(g_set_edit_properties_w, g_set_edit_properties)
+Xen_wrap_5_optional_args(g_set_edit_property_w, g_set_edit_property)
+Xen_wrap_3_optional_args(g_set_max_transform_peaks_w, g_set_max_transform_peaks)
+Xen_wrap_3_optional_args(g_set_show_y_zero_w, g_set_show_y_zero)
+Xen_wrap_3_optional_args(g_set_show_grid_w, g_set_show_grid)
+Xen_wrap_3_optional_args(g_set_grid_density_w, g_set_grid_density)
+Xen_wrap_3_optional_args(g_set_show_sonogram_cursor_w, g_set_show_sonogram_cursor)
+Xen_wrap_3_optional_args(g_set_show_marks_w, g_set_show_marks)
+Xen_wrap_3_optional_args(g_set_time_graph_type_w, g_set_time_graph_type)
+Xen_wrap_3_optional_args(g_set_wavo_hop_w, g_set_wavo_hop)
+Xen_wrap_3_optional_args(g_set_wavo_trace_w, g_set_wavo_trace)
+Xen_wrap_3_optional_args(g_set_show_transform_peaks_w, g_set_show_transform_peaks)
+Xen_wrap_3_optional_args(g_set_zero_pad_w, g_set_zero_pad)
+Xen_wrap_3_optional_args(g_set_with_verbose_cursor_w, g_set_with_verbose_cursor)
+Xen_wrap_3_optional_args(g_set_fft_log_frequency_w, g_set_fft_log_frequency)
+Xen_wrap_3_optional_args(g_set_fft_log_magnitude_w, g_set_fft_log_magnitude)
+Xen_wrap_3_optional_args(g_set_fft_with_phases_w, g_set_fft_with_phases)
+Xen_wrap_3_optional_args(g_set_min_dB_w, g_set_min_dB)
+Xen_wrap_3_optional_args(g_set_wavelet_type_w, g_set_wavelet_type)
+Xen_wrap_3_optional_args(g_set_spectrum_end_w, g_set_spectrum_end)
+Xen_wrap_3_optional_args(g_set_spectrum_start_w, g_set_spectrum_start)
+Xen_wrap_3_optional_args(g_set_spectro_x_angle_w, g_set_spectro_x_angle)
+Xen_wrap_3_optional_args(g_set_spectro_x_scale_w, g_set_spectro_x_scale)
+Xen_wrap_3_optional_args(g_set_spectro_y_angle_w, g_set_spectro_y_angle)
+Xen_wrap_3_optional_args(g_set_spectro_y_scale_w, g_set_spectro_y_scale)
+Xen_wrap_3_optional_args(g_set_spectro_z_angle_w, g_set_spectro_z_angle)
+Xen_wrap_3_optional_args(g_set_spectro_z_scale_w, g_set_spectro_z_scale)
+Xen_wrap_3_optional_args(g_set_fft_window_alpha_w, g_set_fft_window_alpha)
+Xen_wrap_3_optional_args(g_set_fft_window_beta_w, g_set_fft_window_beta)
+Xen_wrap_3_optional_args(g_set_spectro_hop_w, g_set_spectro_hop)
+Xen_wrap_3_optional_args(g_set_transform_size_w, g_set_transform_size)
+Xen_wrap_3_optional_args(g_set_transform_graph_type_w, g_set_transform_graph_type)
+Xen_wrap_3_optional_args(g_set_fft_window_w, g_set_fft_window)
+Xen_wrap_3_optional_args(g_set_transform_type_w, g_set_transform_type)
+Xen_wrap_3_optional_args(g_set_transform_normalization_w, g_set_transform_normalization)
+Xen_wrap_3_optional_args(g_set_show_mix_waveforms_w, g_set_show_mix_waveforms)
+Xen_wrap_3_optional_args(g_set_graph_style_w, g_set_graph_style)
+Xen_wrap_3_optional_args(g_set_time_graph_style_w, g_set_time_graph_style)
+Xen_wrap_3_optional_args(g_set_lisp_graph_style_w, g_set_lisp_graph_style)
+Xen_wrap_3_optional_args(g_set_transform_graph_style_w, g_set_transform_graph_style)
+Xen_wrap_3_optional_args(g_set_dot_size_w, g_set_dot_size)
+Xen_wrap_3_optional_args(g_set_x_axis_style_w, g_set_x_axis_style)
+Xen_wrap_3_optional_args(g_set_beats_per_measure_w, g_set_beats_per_measure)
+Xen_wrap_3_optional_args(g_set_show_axes_w, g_set_show_axes)
+Xen_wrap_3_optional_args(g_set_beats_per_minute_w, g_set_beats_per_minute)
+Xen_wrap_3_optional_args(g_set_graphs_horizontal_w, g_set_graphs_horizontal)
+#endif
#if HAVE_GL
- #define g_gl_spectrogram_w g_gl_spectrogram
+ Xen_wrap_9_args(g_gl_spectrogram_w, g_gl_spectrogram)
#endif
+
+#if HAVE_SCHEME
+static s7_pointer acc_transform_type(s7_scheme *sc, s7_pointer args) {return(g_set_transform_type(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_show_transform_peaks(s7_scheme *sc, s7_pointer args) {return(g_set_show_transform_peaks(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_show_y_zero(s7_scheme *sc, s7_pointer args) {return(g_set_show_y_zero(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_show_marks(s7_scheme *sc, s7_pointer args) {return(g_set_show_marks(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_show_grid(s7_scheme *sc, s7_pointer args) {return(g_set_show_grid(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_fft_log_frequency(s7_scheme *sc, s7_pointer args) {return(g_set_fft_log_frequency(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_fft_log_magnitude(s7_scheme *sc, s7_pointer args) {return(g_set_fft_log_magnitude(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_fft_with_phases(s7_scheme *sc, s7_pointer args) {return(g_set_fft_with_phases(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_sync_style(s7_scheme *sc, s7_pointer args) {return(g_set_sync_style(s7_cadr(args)));}
+static s7_pointer acc_show_axes(s7_scheme *sc, s7_pointer args) {return(g_set_show_axes(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_with_verbose_cursor(s7_scheme *sc, s7_pointer args) {return(g_set_with_verbose_cursor(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectro_x_scale(s7_scheme *sc, s7_pointer args) {return(g_set_spectro_x_scale(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectro_y_scale(s7_scheme *sc, s7_pointer args) {return(g_set_spectro_y_scale(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectro_z_scale(s7_scheme *sc, s7_pointer args) {return(g_set_spectro_z_scale(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectro_z_angle(s7_scheme *sc, s7_pointer args) {return(g_set_spectro_z_angle(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectro_x_angle(s7_scheme *sc, s7_pointer args) {return(g_set_spectro_x_angle(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectro_y_angle(s7_scheme *sc, s7_pointer args) {return(g_set_spectro_y_angle(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectrum_end(s7_scheme *sc, s7_pointer args) {return(g_set_spectrum_end(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectrum_start(s7_scheme *sc, s7_pointer args) {return(g_set_spectrum_start(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_spectro_hop(s7_scheme *sc, s7_pointer args) {return(g_set_spectro_hop(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_wavelet_type(s7_scheme *sc, s7_pointer args) {return(g_set_wavelet_type(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_dot_size(s7_scheme *sc, s7_pointer args) {return(g_set_dot_size(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_zero_pad(s7_scheme *sc, s7_pointer args) {return(g_set_zero_pad(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_wavo_hop(s7_scheme *sc, s7_pointer args) {return(g_set_wavo_hop(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_wavo_trace(s7_scheme *sc, s7_pointer args) {return(g_set_wavo_trace(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_transform_size(s7_scheme *sc, s7_pointer args) {return(g_set_transform_size(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_fft_window(s7_scheme *sc, s7_pointer args) {return(g_set_fft_window(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_transform_graph_type(s7_scheme *sc, s7_pointer args) {return(g_set_transform_graph_type(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_time_graph_type(s7_scheme *sc, s7_pointer args) {return(g_set_time_graph_type(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_fft_window_alpha(s7_scheme *sc, s7_pointer args) {return(g_set_fft_window_alpha(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_fft_window_beta(s7_scheme *sc, s7_pointer args) {return(g_set_fft_window_beta(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_grid_density(s7_scheme *sc, s7_pointer args) {return(g_set_grid_density(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_beats_per_minute(s7_scheme *sc, s7_pointer args) {return(g_set_beats_per_minute(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_show_mix_waveforms(s7_scheme *sc, s7_pointer args) {return(g_set_show_mix_waveforms(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_beats_per_measure(s7_scheme *sc, s7_pointer args) {return(g_set_beats_per_measure(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_transform_normalization(s7_scheme *sc, s7_pointer args) {return(g_set_transform_normalization(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_x_axis_style(s7_scheme *sc, s7_pointer args) {return(g_set_x_axis_style(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_zoom_focus_style(s7_scheme *sc, s7_pointer args) {return(g_set_zoom_focus_style(s7_cadr(args)));}
+static s7_pointer acc_graph_style(s7_scheme *sc, s7_pointer args) {return(g_set_graph_style(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_max_transform_peaks(s7_scheme *sc, s7_pointer args) {return(g_set_max_transform_peaks(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_graphs_horizontal(s7_scheme *sc, s7_pointer args) {return(g_set_graphs_horizontal(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_cursor_size(s7_scheme *sc, s7_pointer args) {return(g_set_cursor_size(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_cursor_style(s7_scheme *sc, s7_pointer args) {return(g_set_cursor_style(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_tracking_cursor_style(s7_scheme *sc, s7_pointer args) {return(g_set_tracking_cursor_style(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_show_sonogram_cursor(s7_scheme *sc, s7_pointer args) {return(g_set_show_sonogram_cursor(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_min_dB(s7_scheme *sc, s7_pointer args) {return(g_set_min_dB(s7_cadr(args), s7_undefined(sc), s7_undefined(sc)));}
+static s7_pointer acc_with_gl(s7_scheme *sc, s7_pointer args) {return(g_set_with_gl(s7_cadr(args)));}
#endif
+
void g_init_chn(void)
{
- cp_edpos = XEN_UNDEFINED;
+ cp_edpos = Xen_undefined;
- XEN_DEFINE_PROCEDURE(S_variable_graph_p, g_variable_graph_p_w, 1, 0, 0, H_variable_graph_p);
- XEN_DEFINE_PROCEDURE(S_make_variable_graph, g_make_variable_graph_w, 1, 3, 0, H_make_variable_graph);
- XEN_DEFINE_PROCEDURE(S_channel_data, g_channel_data_w, 0, 2, 0, H_channel_data);
+ Xen_define_safe_procedure(S_is_variable_graph, g_is_variable_graph_w, 1, 0, 0, H_is_variable_graph);
+ Xen_define_safe_procedure(S_make_variable_graph, g_make_variable_graph_w, 1, 3, 0, H_make_variable_graph);
+ Xen_define_safe_procedure(S_channel_data, g_channel_data_w, 0, 2, 0, H_channel_data);
- XEN_DEFINE_PROCEDURE(S_graph, g_graph_w, 1, 9, 0, H_graph);
- XEN_DEFINE_PROCEDURE(S_edits, g_edits_w, 0, 2, 0, H_edits);
- XEN_DEFINE_PROCEDURE(S_peaks, g_peaks_w, 0, 3, 0, H_peaks);
- XEN_DEFINE_PROCEDURE(S_edit_hook, g_edit_hook_w, 0, 2, 0, H_edit_hook);
- XEN_DEFINE_PROCEDURE(S_after_edit_hook, g_after_edit_hook_w, 0, 2, 0, H_after_edit_hook);
- XEN_DEFINE_PROCEDURE(S_undo_hook, g_undo_hook_w, 0, 2, 0, H_undo_hook);
- XEN_DEFINE_PROCEDURE(S_update_time_graph, g_update_time_graph_w, 0, 2, 0, H_update_time_graph);
- XEN_DEFINE_PROCEDURE(S_update_lisp_graph, g_update_lisp_graph_w, 0, 2, 0, H_update_lisp_graph);
- XEN_DEFINE_PROCEDURE(S_update_transform_graph, g_update_transform_graph_w, 0, 2, 0, H_update_transform_graph);
+ Xen_define_safe_procedure(S_graph, g_graph_w, 0, 0, 1, H_graph);
+ Xen_define_safe_procedure(S_edits, g_edits_w, 0, 2, 0, H_edits);
+ Xen_define_safe_procedure(S_peaks, g_peaks_w, 0, 3, 0, H_peaks);
+ Xen_define_safe_procedure(S_edit_hook, g_edit_hook_w, 0, 2, 0, H_edit_hook);
+ Xen_define_safe_procedure(S_after_edit_hook, g_after_edit_hook_w, 0, 2, 0, H_after_edit_hook);
+ Xen_define_safe_procedure(S_undo_hook, g_undo_hook_w, 0, 2, 0, H_undo_hook);
+ Xen_define_safe_procedure(S_update_time_graph, g_update_time_graph_w, 0, 2, 0, H_update_time_graph);
+ Xen_define_safe_procedure(S_update_lisp_graph, g_update_lisp_graph_w, 0, 2, 0, H_update_lisp_graph);
+ Xen_define_safe_procedure(S_update_transform_graph, g_update_transform_graph_w, 0, 2, 0, H_update_transform_graph);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_x_position_slider, g_ap_sx_w, H_x_position_slider,
- S_setB S_x_position_slider, g_set_ap_sx_w, g_set_ap_sx_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_y_position_slider, g_ap_sy_w, H_y_position_slider,
- S_setB S_y_position_slider, g_set_ap_sy_w, g_set_ap_sy_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_x_zoom_slider, g_ap_zx_w, H_x_zoom_slider,
- S_setB S_x_zoom_slider, g_set_ap_zx_w, g_set_ap_zx_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_y_zoom_slider, g_ap_zy_w, H_y_zoom_slider,
- S_setB S_y_zoom_slider, g_set_ap_zy_w, g_set_ap_zy_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_frames, g_frames_w, H_frames,
- S_setB S_frames, g_set_frames_w, g_set_frames_reversed, 0, 3, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_maxamp, g_maxamp_w, H_maxamp,
- S_setB S_maxamp, g_set_maxamp_w, g_set_maxamp_reversed, 0, 3, 1, 2);
-
- XEN_DEFINE_PROCEDURE(S_maxamp_position, g_maxamp_position_w, 0, 3, 0, H_maxamp_position);
- XEN_DEFINE_PROCEDURE(S_cursor_position, g_cursor_position_w, 0, 2, 0, H_cursor_position);
+ Xen_define_dilambda(S_x_position_slider, g_ap_sx_w, H_x_position_slider, S_set S_x_position_slider, g_set_ap_sx_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_y_position_slider, g_ap_sy_w, H_y_position_slider, S_set S_y_position_slider, g_set_ap_sy_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_x_zoom_slider, g_ap_zx_w, H_x_zoom_slider, S_set S_x_zoom_slider, g_set_ap_zx_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_y_zoom_slider, g_ap_zy_w, H_y_zoom_slider, S_set S_y_zoom_slider, g_set_ap_zy_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_framples, g_framples_w, H_framples, S_set S_framples, g_set_framples_w, 0, 3, 1, 2);
+ Xen_define_dilambda(S_maxamp, g_maxamp_w, H_maxamp, S_set S_maxamp, g_set_maxamp_w, 0, 3, 1, 2);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_edit_position, g_edit_position_w, H_edit_position,
- S_setB S_edit_position, g_set_edit_position_w, g_set_edit_position_reversed, 0, 2, 1, 2);
+ Xen_define_safe_procedure(S_maxamp_position, g_maxamp_position_w, 0, 3, 0, H_maxamp_position);
+ Xen_define_safe_procedure(S_cursor_position, g_cursor_position_w, 0, 2, 0, H_cursor_position);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_transform_graph_p, g_transform_graph_p_w, H_transform_graph_p,
- S_setB S_transform_graph_p, g_set_transform_graph_p_w, g_set_transform_graph_p_reversed, 0, 2, 1, 2);
+ Xen_define_dilambda(S_edit_position, g_edit_position_w, H_edit_position, S_set S_edit_position, g_set_edit_position_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_transform_graph_on, g_transform_graph_on_w, H_transform_graph_on, S_set S_transform_graph_on, g_set_transform_graph_on_w, 0, 2, 1, 2);
#define H_graph_once "The value for the various graph-type variables that displays the standard waveform"
#define H_graph_as_wavogram "The value for " S_time_graph_type " to make a spectrogram-like form of the time-domain data"
- XEN_DEFINE_CONSTANT(S_graph_once, GRAPH_ONCE, H_graph_once);
- XEN_DEFINE_CONSTANT(S_graph_as_wavogram, GRAPH_AS_WAVOGRAM, H_graph_as_wavogram);
+ Xen_define_constant(S_graph_once, GRAPH_ONCE, H_graph_once);
+ Xen_define_constant(S_graph_as_wavogram, GRAPH_AS_WAVOGRAM, H_graph_as_wavogram);
#define H_graph_as_sonogram "The value for " S_transform_graph_type " that causes a sonogram to be displayed"
#define H_graph_as_spectrogram "The value for " S_transform_graph_type " that causes a spectrogram to be displayed"
/* #define H_graph_as_complex "The value for " S_transform_graph_type " to display FFT data in the complex plane" */
- XEN_DEFINE_CONSTANT(S_graph_as_sonogram, GRAPH_AS_SONOGRAM, H_graph_as_sonogram);
- XEN_DEFINE_CONSTANT(S_graph_as_spectrogram, GRAPH_AS_SPECTROGRAM, H_graph_as_spectrogram);
- /* XEN_DEFINE_CONSTANT(S_graph_as_complex, GRAPH_AS_COMPLEX, H_graph_as_complex); */
+ Xen_define_constant(S_graph_as_sonogram, GRAPH_AS_SONOGRAM, H_graph_as_sonogram);
+ Xen_define_constant(S_graph_as_spectrogram, GRAPH_AS_SPECTROGRAM, H_graph_as_spectrogram);
+ /* Xen_define_constant(S_graph_as_complex, GRAPH_AS_COMPLEX, H_graph_as_complex); */
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_time_graph_p, g_time_graph_p_w, H_time_graph_p,
- S_setB S_time_graph_p, g_set_time_graph_p_w, g_set_time_graph_p_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_lisp_graph_p, g_lisp_graph_p_w, H_lisp_graph_p,
- S_setB S_lisp_graph_p, g_set_lisp_graph_p_w, g_set_lisp_graph_p_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_squelch_update, g_squelch_update_w, H_squelch_update,
- S_setB S_squelch_update, g_set_squelch_update_w, g_set_squelch_update_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_cursor, g_cursor_w, H_cursor,
- S_setB S_cursor, g_set_cursor_w, g_set_cursor_reversed, 0, 3, 1, 3);
+ Xen_define_dilambda(S_time_graph_on, g_timer_graph_on_w, H_timer_graph_on, S_set S_time_graph_on, g_set_timer_graph_on_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_lisp_graph_on, g_lisp_graph_on_w, H_lisp_graph_on, S_set S_lisp_graph_on, g_set_lisp_graph_on_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_squelch_update, g_squelch_update_w, H_squelch_update, S_set S_squelch_update, g_set_squelch_update_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_cursor, g_cursor_w, H_cursor, S_set S_cursor, g_set_cursor_w, 0, 3, 1, 3);
#define H_cursor_cross "The value for " S_cursor_style " that causes is to be a cross (the default)"
#define H_cursor_line "The value for " S_cursor_style " that causes is to be a full vertical line"
- XEN_DEFINE_CONSTANT(S_cursor_cross, CURSOR_CROSS, H_cursor_cross);
- XEN_DEFINE_CONSTANT(S_cursor_line, CURSOR_LINE, H_cursor_line);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_cursor_style, g_cursor_style_w, H_cursor_style,
- S_setB S_cursor_style, g_set_cursor_style_w, g_set_cursor_style_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_tracking_cursor_style, g_tracking_cursor_style_w, H_tracking_cursor_style,
- S_setB S_tracking_cursor_style, g_set_tracking_cursor_style_w, g_set_tracking_cursor_style_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_cursor_size, g_cursor_size_w, H_cursor_size,
- S_setB S_cursor_size, g_set_cursor_size_w, g_set_cursor_size_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_left_sample, g_left_sample_w, H_left_sample,
- S_setB S_left_sample, g_set_left_sample_w, g_set_left_sample_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_right_sample, g_right_sample_w, H_right_sample,
- S_setB S_right_sample, g_set_right_sample_w, g_set_right_sample_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_channel_properties, g_channel_properties_w, H_channel_properties,
- S_setB S_channel_properties, g_set_channel_properties_w, g_set_channel_properties_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_channel_property, g_channel_property_w, H_channel_property,
- S_setB S_channel_property, g_set_channel_property_w, g_set_channel_property_reversed, 1, 2, 2, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_edit_properties, g_edit_properties_w, H_edit_properties,
- S_setB S_edit_properties, g_set_edit_properties_w, g_set_edit_properties_reversed, 0, 3, 1, 3);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_edit_property, g_edit_property_w, H_edit_property,
- S_setB S_edit_property, g_set_edit_property_w, g_set_edit_property_reversed, 1, 3, 2, 3);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_max_transform_peaks, g_max_transform_peaks_w, H_max_transform_peaks,
- S_setB S_max_transform_peaks, g_set_max_transform_peaks_w, g_set_max_transform_peaks_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_show_y_zero, g_show_y_zero_w, H_show_y_zero,
- S_setB S_show_y_zero, g_set_show_y_zero_w, g_set_show_y_zero_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_show_grid, g_show_grid_w, H_show_grid,
- S_setB S_show_grid, g_set_show_grid_w, g_set_show_grid_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_grid_density, g_grid_density_w, H_grid_density,
- S_setB S_grid_density, g_set_grid_density_w, g_set_grid_density_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_show_sonogram_cursor, g_show_sonogram_cursor_w, H_show_sonogram_cursor,
- S_setB S_show_sonogram_cursor, g_set_show_sonogram_cursor_w, g_set_show_sonogram_cursor_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_show_marks, g_show_marks_w, H_show_marks,
- S_setB S_show_marks, g_set_show_marks_w, g_set_show_marks_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_time_graph_type, g_time_graph_type_w, H_time_graph_type,
- S_setB S_time_graph_type, g_set_time_graph_type_w, g_set_time_graph_type_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_wavo_hop, g_wavo_hop_w, H_wavo_hop,
- S_setB S_wavo_hop, g_set_wavo_hop_w, g_set_wavo_hop_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_wavo_trace, g_wavo_trace_w, H_wavo_trace,
- S_setB S_wavo_trace, g_set_wavo_trace_w, g_set_wavo_trace_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_show_transform_peaks, g_show_transform_peaks_w, H_show_transform_peaks,
- S_setB S_show_transform_peaks, g_set_show_transform_peaks_w, g_set_show_transform_peaks_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_zero_pad, g_zero_pad_w, H_zero_pad,
- S_setB S_zero_pad, g_set_zero_pad_w, g_set_zero_pad_reversed, 0, 2, 1, 2);
-
-#if (!SND_DISABLE_DEPRECATED)
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER("verbose-cursor", g_verbose_cursor_w, H_verbose_cursor,
- S_setB "verbose-cursor", g_set_verbose_cursor_w, g_set_verbose_cursor_reversed, 0, 2, 1, 2);
-#endif
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_with_verbose_cursor, g_verbose_cursor_w, H_verbose_cursor,
- S_setB S_with_verbose_cursor, g_set_verbose_cursor_w, g_set_verbose_cursor_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_fft_log_frequency, g_fft_log_frequency_w, H_fft_log_frequency,
- S_setB S_fft_log_frequency, g_set_fft_log_frequency_w, g_set_fft_log_frequency_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_fft_log_magnitude, g_fft_log_magnitude_w, H_fft_log_magnitude,
- S_setB S_fft_log_magnitude, g_set_fft_log_magnitude_w, g_set_fft_log_magnitude_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_fft_with_phases, g_fft_with_phases_w, H_fft_with_phases,
- S_setB S_fft_with_phases, g_set_fft_with_phases_w, g_set_fft_with_phases_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_min_dB, g_min_dB_w, H_min_dB,
- S_setB S_min_dB, g_set_min_dB_w, g_set_min_dB_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_wavelet_type, g_wavelet_type_w, H_wavelet_type,
- S_setB S_wavelet_type, g_set_wavelet_type_w, g_set_wavelet_type_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectrum_end, g_spectrum_end_w, H_spectrum_end,
- S_setB S_spectrum_end, g_set_spectrum_end_w, g_set_spectrum_end_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectrum_start, g_spectrum_start_w, H_spectrum_start,
- S_setB S_spectrum_start, g_set_spectrum_start_w, g_set_spectrum_start_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectro_x_angle, g_spectro_x_angle_w, H_spectro_x_angle,
- S_setB S_spectro_x_angle, g_set_spectro_x_angle_w, g_set_spectro_x_angle_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectro_x_scale, g_spectro_x_scale_w, H_spectro_x_scale,
- S_setB S_spectro_x_scale, g_set_spectro_x_scale_w, g_set_spectro_x_scale_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectro_y_angle, g_spectro_y_angle_w, H_spectro_y_angle,
- S_setB S_spectro_y_angle, g_set_spectro_y_angle_w, g_set_spectro_y_angle_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectro_y_scale, g_spectro_y_scale_w, H_spectro_y_scale,
- S_setB S_spectro_y_scale, g_set_spectro_y_scale_w, g_set_spectro_y_scale_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectro_z_angle, g_spectro_z_angle_w, H_spectro_z_angle,
- S_setB S_spectro_z_angle, g_set_spectro_z_angle_w, g_set_spectro_z_angle_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectro_z_scale, g_spectro_z_scale_w, H_spectro_z_scale,
- S_setB S_spectro_z_scale, g_set_spectro_z_scale_w, g_set_spectro_z_scale_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_fft_window_beta, g_fft_window_beta_w, H_fft_window_beta,
- S_setB S_fft_window_beta, g_set_fft_window_beta_w, g_set_fft_window_beta_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_fft_window_alpha, g_fft_window_alpha_w, H_fft_window_alpha,
- S_setB S_fft_window_alpha, g_set_fft_window_alpha_w, g_set_fft_window_alpha_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_spectro_hop, g_spectro_hop_w, H_spectro_hop,
- S_setB S_spectro_hop, g_set_spectro_hop_w, g_set_spectro_hop_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_transform_size, g_transform_size_w, H_transform_size,
- S_setB S_transform_size, g_set_transform_size_w, g_set_transform_size_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_transform_graph_type, g_transform_graph_type_w, H_transform_graph_type,
- S_setB S_transform_graph_type, g_set_transform_graph_type_w, g_set_transform_graph_type_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_fft_window, g_fft_window_w, H_fft_window,
- S_setB S_fft_window, g_set_fft_window_w, g_set_fft_window_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_transform_type, g_transform_type_w, H_transform_type,
- S_setB S_transform_type, g_set_transform_type_w, g_set_transform_type_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_transform_normalization, g_transform_normalization_w, H_transform_normalization,
- S_setB S_transform_normalization, g_set_transform_normalization_w, g_set_transform_normalization_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_show_mix_waveforms, g_show_mix_waveforms_w, H_show_mix_waveforms,
- S_setB S_show_mix_waveforms, g_set_show_mix_waveforms_w, g_set_show_mix_waveforms_reversed, 0, 2, 1, 2);
+ Xen_define_constant(S_cursor_cross, CURSOR_CROSS, H_cursor_cross);
+ Xen_define_constant(S_cursor_line, CURSOR_LINE, H_cursor_line);
+
+ Xen_define_dilambda(S_cursor_style, g_cursor_style_w, H_cursor_style, S_set S_cursor_style, g_set_cursor_style_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_tracking_cursor_style, g_tracking_cursor_style_w, H_tracking_cursor_style, S_set S_tracking_cursor_style, g_set_tracking_cursor_style_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_cursor_size, g_cursor_size_w, H_cursor_size, S_set S_cursor_size, g_set_cursor_size_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_left_sample, g_left_sample_w, H_left_sample, S_set S_left_sample, g_set_left_sample_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_right_sample, g_right_sample_w, H_right_sample, S_set S_right_sample, g_set_right_sample_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_channel_properties, g_channel_properties_w, H_channel_properties, S_set S_channel_properties, g_set_channel_properties_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_channel_property, g_channel_property_w, H_channel_property, S_set S_channel_property, g_set_channel_property_w, 1, 2, 2, 2);
+ Xen_define_dilambda(S_edit_properties, g_edit_properties_w, H_edit_properties, S_set S_edit_properties, g_set_edit_properties_w, 0, 3, 1, 3);
+ Xen_define_dilambda(S_edit_property, g_edit_property_w, H_edit_property, S_set S_edit_property, g_set_edit_property_w, 1, 3, 2, 3);
+ Xen_define_dilambda(S_max_transform_peaks, g_max_transform_peaks_w, H_max_transform_peaks, S_set S_max_transform_peaks, g_set_max_transform_peaks_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_show_y_zero, g_show_y_zero_w, H_show_y_zero, S_set S_show_y_zero, g_set_show_y_zero_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_show_grid, g_show_grid_w, H_show_grid, S_set S_show_grid, g_set_show_grid_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_grid_density, g_grid_density_w, H_grid_density, S_set S_grid_density, g_set_grid_density_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_show_sonogram_cursor, g_show_sonogram_cursor_w, H_show_sonogram_cursor, S_set S_show_sonogram_cursor, g_set_show_sonogram_cursor_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_show_marks, g_show_marks_w, H_show_marks, S_set S_show_marks, g_set_show_marks_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_time_graph_type, g_time_graph_type_w, H_time_graph_type, S_set S_time_graph_type, g_set_time_graph_type_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_wavo_hop, g_wavo_hop_w, H_wavo_hop, S_set S_wavo_hop, g_set_wavo_hop_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_wavo_trace, g_wavo_trace_w, H_wavo_trace, S_set S_wavo_trace, g_set_wavo_trace_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_show_transform_peaks, g_show_transform_peaks_w, H_show_transform_peaks, S_set S_show_transform_peaks, g_set_show_transform_peaks_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_zero_pad, g_zero_pad_w, H_zero_pad, S_set S_zero_pad, g_set_zero_pad_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_with_verbose_cursor, g_with_verbose_cursor_w, H_with_verbose_cursor, S_set S_with_verbose_cursor, g_set_with_verbose_cursor_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_fft_log_frequency, g_fft_log_frequency_w, H_fft_log_frequency, S_set S_fft_log_frequency, g_set_fft_log_frequency_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_fft_log_magnitude, g_fft_log_magnitude_w, H_fft_log_magnitude, S_set S_fft_log_magnitude, g_set_fft_log_magnitude_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_fft_with_phases, g_fft_with_phases_w, H_fft_with_phases, S_set S_fft_with_phases, g_set_fft_with_phases_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_min_dB, g_min_dB_w, H_min_dB, S_set S_min_dB, g_set_min_dB_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_wavelet_type, g_wavelet_type_w, H_wavelet_type, S_set S_wavelet_type, g_set_wavelet_type_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectrum_end, g_spectrum_end_w, H_spectrum_end, S_set S_spectrum_end, g_set_spectrum_end_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectrum_start, g_spectrum_start_w, H_spectrum_start, S_set S_spectrum_start, g_set_spectrum_start_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectro_x_angle, g_spectro_x_angle_w, H_spectro_x_angle, S_set S_spectro_x_angle, g_set_spectro_x_angle_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectro_x_scale, g_spectro_x_scale_w, H_spectro_x_scale, S_set S_spectro_x_scale, g_set_spectro_x_scale_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectro_y_angle, g_spectro_y_angle_w, H_spectro_y_angle, S_set S_spectro_y_angle, g_set_spectro_y_angle_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectro_y_scale, g_spectro_y_scale_w, H_spectro_y_scale, S_set S_spectro_y_scale, g_set_spectro_y_scale_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectro_z_angle, g_spectro_z_angle_w, H_spectro_z_angle, S_set S_spectro_z_angle, g_set_spectro_z_angle_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectro_z_scale, g_spectro_z_scale_w, H_spectro_z_scale, S_set S_spectro_z_scale, g_set_spectro_z_scale_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_fft_window_beta, g_fft_window_beta_w, H_fft_window_beta, S_set S_fft_window_beta, g_set_fft_window_beta_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_fft_window_alpha, g_fft_window_alpha_w, H_fft_window_alpha, S_set S_fft_window_alpha, g_set_fft_window_alpha_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_spectro_hop, g_spectro_hop_w, H_spectro_hop, S_set S_spectro_hop, g_set_spectro_hop_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_transform_size, g_transform_size_w, H_transform_size, S_set S_transform_size, g_set_transform_size_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_transform_graph_type, g_transform_graph_type_w, H_transform_graph_type, S_set S_transform_graph_type, g_set_transform_graph_type_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_fft_window, g_fft_window_w, H_fft_window, S_set S_fft_window, g_set_fft_window_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_transform_type, g_transform_type_w, H_transform_type, S_set S_transform_type, g_set_transform_type_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_transform_normalization, g_transform_normalization_w, H_transform_normalization, S_set S_transform_normalization, g_set_transform_normalization_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_show_mix_waveforms, g_show_mix_waveforms_w, H_show_mix_waveforms, S_set S_show_mix_waveforms, g_set_show_mix_waveforms_w, 0, 2, 1, 2);
/* should these be named "graph-with-lines" etc? */
#define H_graph_lines "The value for " S_graph_style " that causes graphs to use line-segments"
@@ -9988,29 +10141,17 @@ void g_init_chn(void)
#define H_graph_dots_and_lines "The value for " S_graph_style " that causes graphs to use dots connected by lines"
#define H_graph_lollipops "The value for " S_graph_style " that makes DSP engineers happy"
- XEN_DEFINE_CONSTANT(S_graph_lines, GRAPH_LINES, H_graph_lines);
- XEN_DEFINE_CONSTANT(S_graph_dots, GRAPH_DOTS, H_graph_dots);
- XEN_DEFINE_CONSTANT(S_graph_filled, GRAPH_FILLED, H_graph_filled);
- XEN_DEFINE_CONSTANT(S_graph_dots_and_lines, GRAPH_DOTS_AND_LINES, H_graph_dots_and_lines);
- XEN_DEFINE_CONSTANT(S_graph_lollipops, GRAPH_LOLLIPOPS, H_graph_lollipops);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_time_graph_style, g_time_graph_style_w, H_time_graph_style,
- S_setB S_time_graph_style, g_set_time_graph_style_w, g_set_time_graph_style_reversed,
- 1, 1, 1, 2);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_lisp_graph_style, g_lisp_graph_style_w, H_lisp_graph_style,
- S_setB S_lisp_graph_style, g_set_lisp_graph_style_w, g_set_lisp_graph_style_reversed,
- 1, 1, 1, 2);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_transform_graph_style, g_transform_graph_style_w, H_transform_graph_style,
- S_setB S_transform_graph_style, g_set_transform_graph_style_w, g_set_transform_graph_style_reversed,
- 1, 1, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_graph_style, g_graph_style_w, H_graph_style,
- S_setB S_graph_style, g_set_graph_style_w, g_set_graph_style_reversed,
- 0, 2, 1, 2);
+ Xen_define_constant(S_graph_lines, GRAPH_LINES, H_graph_lines);
+ Xen_define_constant(S_graph_dots, GRAPH_DOTS, H_graph_dots);
+ Xen_define_constant(S_graph_filled, GRAPH_FILLED, H_graph_filled);
+ Xen_define_constant(S_graph_dots_and_lines, GRAPH_DOTS_AND_LINES, H_graph_dots_and_lines);
+ Xen_define_constant(S_graph_lollipops, GRAPH_LOLLIPOPS, H_graph_lollipops);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_dot_size, g_dot_size_w, H_dot_size,
- S_setB S_dot_size, g_set_dot_size_w, g_set_dot_size_reversed,
- 0, 2, 1, 2);
+ Xen_define_dilambda(S_time_graph_style, g_time_graph_style_w, H_time_graph_style, S_set S_time_graph_style, g_set_time_graph_style_w, 1, 1, 1, 2);
+ Xen_define_dilambda(S_lisp_graph_style, g_lisp_graph_style_w, H_lisp_graph_style, S_set S_lisp_graph_style, g_set_lisp_graph_style_w, 1, 1, 1, 2);
+ Xen_define_dilambda(S_transform_graph_style, g_transform_graph_style_w, H_transform_graph_style, S_set S_transform_graph_style, g_set_transform_graph_style_w, 1, 1, 1, 2);
+ Xen_define_dilambda(S_graph_style, g_graph_style_w, H_graph_style, S_set S_graph_style, g_set_graph_style_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_dot_size, g_dot_size_w, H_dot_size, S_set S_dot_size, g_set_dot_size_w, 0, 2, 1, 2);
#define H_x_axis_in_seconds "The value for " S_x_axis_style " that displays the x axis using seconds"
#define H_x_axis_in_samples "The value for " S_x_axis_style " that displays the x axis using sample numbers"
@@ -10019,22 +10160,16 @@ void g_init_chn(void)
#define H_x_axis_as_percentage "The value for " S_x_axis_style " that displays the x axis using percentages"
#define H_x_axis_as_clock "The value for " S_x_axis_style " that displays the x axis using clock-like DD:HH:MM:SS syntax"
- XEN_DEFINE_CONSTANT(S_x_axis_in_seconds, X_AXIS_IN_SECONDS, H_x_axis_in_seconds);
- XEN_DEFINE_CONSTANT(S_x_axis_in_samples, X_AXIS_IN_SAMPLES, H_x_axis_in_samples);
- XEN_DEFINE_CONSTANT(S_x_axis_in_beats, X_AXIS_IN_BEATS, H_x_axis_in_beats);
- XEN_DEFINE_CONSTANT(S_x_axis_in_measures, X_AXIS_IN_MEASURES, H_x_axis_in_measures);
- XEN_DEFINE_CONSTANT(S_x_axis_as_percentage, X_AXIS_AS_PERCENTAGE, H_x_axis_as_percentage);
- XEN_DEFINE_CONSTANT(S_x_axis_as_clock, X_AXIS_AS_CLOCK, H_x_axis_as_clock);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_x_axis_style, g_x_axis_style_w, H_x_axis_style,
- S_setB S_x_axis_style, g_set_x_axis_style_w, g_set_x_axis_style_reversed,
- 0, 2, 1, 2);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_beats_per_minute, g_beats_per_minute_w, H_beats_per_minute,
- S_setB S_beats_per_minute, g_set_beats_per_minute_w, g_set_beats_per_minute_reversed,
- 0, 2, 1, 2);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_beats_per_measure, g_beats_per_measure_w, H_beats_per_measure,
- S_setB S_beats_per_measure, g_set_beats_per_measure_w, g_set_beats_per_measure_reversed,
- 0, 2, 1, 2);
+ Xen_define_constant(S_x_axis_in_seconds, X_AXIS_IN_SECONDS, H_x_axis_in_seconds);
+ Xen_define_constant(S_x_axis_in_samples, X_AXIS_IN_SAMPLES, H_x_axis_in_samples);
+ Xen_define_constant(S_x_axis_in_beats, X_AXIS_IN_BEATS, H_x_axis_in_beats);
+ Xen_define_constant(S_x_axis_in_measures, X_AXIS_IN_MEASURES, H_x_axis_in_measures);
+ Xen_define_constant(S_x_axis_as_percentage, X_AXIS_AS_PERCENTAGE, H_x_axis_as_percentage);
+ Xen_define_constant(S_x_axis_as_clock, X_AXIS_AS_CLOCK, H_x_axis_as_clock);
+
+ Xen_define_dilambda(S_x_axis_style, g_x_axis_style_w, H_x_axis_style, S_set S_x_axis_style, g_set_x_axis_style_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_beats_per_minute, g_beats_per_minute_w, H_beats_per_minute, S_set S_beats_per_minute, g_set_beats_per_minute_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_beats_per_measure, g_beats_per_measure_w, H_beats_per_measure, S_set S_beats_per_measure, g_set_beats_per_measure_w, 0, 2, 1, 2);
#define H_show_all_axes "The value for " S_show_axes " that causes both the x and y axes to be displayed"
#define H_show_all_axes_unlabelled "The value for " S_show_axes " that causes both the x and y axes to be displayed, but without any label"
@@ -10043,47 +10178,41 @@ void g_init_chn(void)
#define H_show_x_axis_unlabelled "The value for " S_show_axes " that causes only the x axis to be displayed, but without any label"
#define H_show_bare_x_axis "The value for " S_show_axes " that causes x axis to be displayed without a label or tick marks"
- XEN_DEFINE_CONSTANT(S_show_all_axes, SHOW_ALL_AXES, H_show_all_axes);
- XEN_DEFINE_CONSTANT(S_show_all_axes_unlabelled,SHOW_ALL_AXES_UNLABELLED, H_show_all_axes_unlabelled);
- XEN_DEFINE_CONSTANT(S_show_no_axes, SHOW_NO_AXES, H_show_no_axes);
- XEN_DEFINE_CONSTANT(S_show_x_axis, SHOW_X_AXIS, H_show_x_axis);
- XEN_DEFINE_CONSTANT(S_show_x_axis_unlabelled, SHOW_X_AXIS_UNLABELLED, H_show_x_axis_unlabelled);
- XEN_DEFINE_CONSTANT(S_show_bare_x_axis, SHOW_BARE_X_AXIS, H_show_bare_x_axis);
+ Xen_define_constant(S_show_all_axes, SHOW_ALL_AXES, H_show_all_axes);
+ Xen_define_constant(S_show_all_axes_unlabelled,SHOW_ALL_AXES_UNLABELLED, H_show_all_axes_unlabelled);
+ Xen_define_constant(S_show_no_axes, SHOW_NO_AXES, H_show_no_axes);
+ Xen_define_constant(S_show_x_axis, SHOW_X_AXIS, H_show_x_axis);
+ Xen_define_constant(S_show_x_axis_unlabelled, SHOW_X_AXIS_UNLABELLED, H_show_x_axis_unlabelled);
+ Xen_define_constant(S_show_bare_x_axis, SHOW_BARE_X_AXIS, H_show_bare_x_axis);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_show_axes, g_show_axes_w, H_show_axes,
- S_setB S_show_axes, g_set_show_axes_w, g_set_show_axes_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_graphs_horizontal, g_graphs_horizontal_w, H_graphs_horizontal,
- S_setB S_graphs_horizontal, g_set_graphs_horizontal_w, g_set_graphs_horizontal_reversed, 0, 2, 1, 2);
+ Xen_define_dilambda(S_show_axes, g_show_axes_w, H_show_axes, S_set S_show_axes, g_set_show_axes_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_graphs_horizontal, g_graphs_horizontal_w, H_graphs_horizontal, S_set S_graphs_horizontal, g_set_graphs_horizontal_w, 0, 2, 1, 2);
#define H_zoom_focus_left "The value for " S_zoom_focus_style " that causes zooming to maintain the left edge steady"
#define H_zoom_focus_right "The value for " S_zoom_focus_style " that causes zooming to maintain the right edge steady"
#define H_zoom_focus_middle "The value for " S_zoom_focus_style " that causes zooming to focus on the middle sample"
#define H_zoom_focus_active "The value for " S_zoom_focus_style " that causes zooming to focus on the currently active object"
- XEN_DEFINE_CONSTANT(S_zoom_focus_left, ZOOM_FOCUS_LEFT, H_zoom_focus_left);
- XEN_DEFINE_CONSTANT(S_zoom_focus_right, ZOOM_FOCUS_RIGHT, H_zoom_focus_right);
- XEN_DEFINE_CONSTANT(S_zoom_focus_active, ZOOM_FOCUS_ACTIVE, H_zoom_focus_active);
- XEN_DEFINE_CONSTANT(S_zoom_focus_middle, ZOOM_FOCUS_MIDDLE, H_zoom_focus_middle);
+ Xen_define_constant(S_zoom_focus_left, ZOOM_FOCUS_LEFT, H_zoom_focus_left);
+ Xen_define_constant(S_zoom_focus_right, ZOOM_FOCUS_RIGHT, H_zoom_focus_right);
+ Xen_define_constant(S_zoom_focus_active, ZOOM_FOCUS_ACTIVE, H_zoom_focus_active);
+ Xen_define_constant(S_zoom_focus_middle, ZOOM_FOCUS_MIDDLE, H_zoom_focus_middle);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_zoom_focus_style, g_zoom_focus_style_w, H_zoom_focus_style,
- S_setB S_zoom_focus_style, g_set_zoom_focus_style_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_gl, g_with_gl_w, H_with_gl,
- S_setB S_with_gl, g_set_with_gl_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_zoom_focus_style, g_zoom_focus_style_w, H_zoom_focus_style, S_set S_zoom_focus_style, g_set_zoom_focus_style_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_with_gl, g_with_gl_w, H_with_gl, S_set S_with_gl, g_set_with_gl_w, 0, 0, 1, 0);
#define H_sync_none "The " S_sync_style " choice that leaves every sound and channel unsync'd at the start"
#define H_sync_all "The " S_sync_style " choice that syncs together every sound and channel at the start"
#define H_sync_by_sound "The " S_sync_style " choice that syncs all channels in a sound, but each sound is separate"
- XEN_DEFINE_CONSTANT(S_sync_none, SYNC_NONE, H_sync_none);
- XEN_DEFINE_CONSTANT(S_sync_all, SYNC_ALL, H_sync_all);
- XEN_DEFINE_CONSTANT(S_sync_by_sound, SYNC_BY_SOUND, H_sync_by_sound);
+ Xen_define_constant(S_sync_none, SYNC_NONE, H_sync_none);
+ Xen_define_constant(S_sync_all, SYNC_ALL, H_sync_all);
+ Xen_define_constant(S_sync_by_sound, SYNC_BY_SOUND, H_sync_by_sound);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_sync_style, g_sync_style_w, H_sync_style,
- S_setB S_sync_style, g_set_sync_style_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_sync_style, g_sync_style_w, H_sync_style, S_set S_sync_style, g_set_sync_style_w, 0, 0, 1, 0);
#if HAVE_GL
- XEN_DEFINE_PROCEDURE(S_glSpectrogram, g_gl_spectrogram_w, 9, 0, 0, H_glSpectrogram);
+ Xen_define_safe_procedure(S_glSpectrogram, g_gl_spectrogram_w, 9, 0, 0, H_glSpectrogram);
#endif
#define H_after_transform_hook S_after_transform_hook " (snd chn scaler): called just after a spectrum is calculated."
@@ -10101,20 +10230,118 @@ If it returns a function (of no arguments), that function is called rather than
#define H_mix_click_hook S_mix_click_hook " (id): called when a mix is clicked; return " PROC_TRUE " to squelch the default message."
#define H_key_press_hook S_key_press_hook " (snd chn key state): called upon a key press if the mouse is in the lisp graph. \
If it returns " PROC_TRUE ", the key press is not passed to the main handler. 'state' refers to the control, meta, and shift keys."
- #define H_initial_graph_hook S_initial_graph_hook " (snd chn dur): called when a sound is displayed for the first time"
+ #define H_initial_graph_hook S_initial_graph_hook " (snd chn duration): called when a sound is displayed for the first time"
- after_transform_hook = XEN_DEFINE_HOOK(S_after_transform_hook, 3, H_after_transform_hook); /* args = sound channel scaler */
- graph_hook = XEN_DEFINE_HOOK(S_graph_hook, 4, H_graph_hook); /* args = sound channel y0 y1 */
- after_graph_hook = XEN_DEFINE_HOOK(S_after_graph_hook, 2, H_after_graph_hook); /* args = sound channel */
- after_lisp_graph_hook = XEN_DEFINE_HOOK(S_after_lisp_graph_hook, 2, H_after_lisp_graph_hook); /* args = sound channel */
- initial_graph_hook = XEN_DEFINE_HOOK(S_initial_graph_hook, 3, H_initial_graph_hook); /* args = sound channel duration */
- lisp_graph_hook = XEN_DEFINE_HOOK(S_lisp_graph_hook, 2, H_lisp_graph_hook); /* args = sound channel */
- mouse_press_hook = XEN_DEFINE_HOOK(S_mouse_press_hook, 6, H_mouse_press_hook); /* args = sound channel button state x y */
- mouse_click_hook = XEN_DEFINE_HOOK(S_mouse_click_hook, 7, H_mouse_click_hook); /* args = sound channel button state x y axis */
- mouse_drag_hook = XEN_DEFINE_HOOK(S_mouse_drag_hook, 6, H_mouse_drag_hook); /* args = sound channel button state x y */
- key_press_hook = XEN_DEFINE_HOOK(S_key_press_hook, 4, H_key_press_hook); /* args = sound channel key state */
- mark_click_hook = XEN_DEFINE_HOOK(S_mark_click_hook, 1, H_mark_click_hook); /* arg = id */
- mix_click_hook = XEN_DEFINE_HOOK(S_mix_click_hook, 1, H_mix_click_hook); /* arg = id */
-}
-
+ after_transform_hook = Xen_define_hook(S_after_transform_hook, "(make-hook 'snd 'chn 'scaler)", 3, H_after_transform_hook);
+ graph_hook = Xen_define_hook(S_graph_hook, "(make-hook 'snd 'chn 'y0 'y1)", 4, H_graph_hook);
+ after_graph_hook = Xen_define_hook(S_after_graph_hook, "(make-hook 'snd 'chn)", 2, H_after_graph_hook);
+ after_lisp_graph_hook = Xen_define_hook(S_after_lisp_graph_hook, "(make-hook 'snd 'chn)", 2, H_after_lisp_graph_hook);
+ initial_graph_hook = Xen_define_hook(S_initial_graph_hook, "(make-hook 'snd 'chn 'duration)", 3, H_initial_graph_hook);
+ lisp_graph_hook = Xen_define_hook(S_lisp_graph_hook, "(make-hook 'snd 'chn)", 2, H_lisp_graph_hook);
+ mouse_press_hook = Xen_define_hook(S_mouse_press_hook, "(make-hook 'snd 'chn 'button 'state 'x 'y)", 6, H_mouse_press_hook);
+ mouse_click_hook = Xen_define_hook(S_mouse_click_hook, "(make-hook 'snd 'chn 'button 'state 'x 'y 'axis)", 7, H_mouse_click_hook);
+ mouse_drag_hook = Xen_define_hook(S_mouse_drag_hook, "(make-hook 'snd 'chn 'button 'state 'x 'y)", 6, H_mouse_drag_hook);
+ key_press_hook = Xen_define_hook(S_key_press_hook, "(make-hook 'snd 'chn 'key 'state)", 4, H_key_press_hook);
+ mark_click_hook = Xen_define_hook(S_mark_click_hook, "(make-hook 'id)", 1, H_mark_click_hook);
+ mix_click_hook = Xen_define_hook(S_mix_click_hook, "(make-hook 'id)", 1, H_mix_click_hook);
+#if HAVE_SCHEME
+ s7_symbol_set_documentation(s7, ss->show_transform_peaks_symbol, "*" S_show_transform_peaks "* determines whether fft displays include a peak list");
+ s7_symbol_set_documentation(s7, ss->show_y_zero_symbol, "*show-y-zero*: #t if Snd should include a line at y = 0.0");
+ s7_symbol_set_documentation(s7, ss->show_marks_symbol, "*show-marks*: #t if Snd should show marks");
+ s7_symbol_set_documentation(s7, ss->show_grid_symbol, "*show-grid*: #t if Snd should display a background grid in the graphs");
+ s7_symbol_set_documentation(s7, ss->fft_log_frequency_symbol, "*fft-log-frequency*: #t if fft displays use log on the frequency axis");
+ s7_symbol_set_documentation(s7, ss->fft_log_magnitude_symbol, "*fft-log-magnitude*: #t if fft displays use dB");
+ s7_symbol_set_documentation(s7, ss->fft_with_phases_symbol, "*fft-with-phases*: #t if fft displays include phase info");
+ s7_symbol_set_documentation(s7, ss->sync_style_symbol, "*sync-style*: determines how channels are grouped when a sound is opened.");
+ s7_symbol_set_documentation(s7, ss->show_axes_symbol, "*show-axes*: If show-all-axes, display x and y axes; if show-x-axis, just one axis (the x axis) is displayed. The other choices are show-no-axes, show-all-axes-unlabelled, show-x-axis-unlabelled, and show-bare-x-axis.");
+ s7_symbol_set_documentation(s7, ss->with_verbose_cursor_symbol, "*with-verbose-cursor*: #t if the cursor's position and so on is displayed in the status area");
+ s7_symbol_set_documentation(s7, ss->spectro_x_scale_symbol, "*spectro-x-scale*: scaler (stretch) along the spectrogram x axis (1.0)");
+ s7_symbol_set_documentation(s7, ss->spectro_y_scale_symbol, "*spectro-y-scale*: scaler (stretch) along the spectrogram y axis (1.0)");
+ s7_symbol_set_documentation(s7, ss->spectro_z_scale_symbol, "*spectro-z-scale*: scaler (stretch) along the spectrogram z axis (0.1)");
+ s7_symbol_set_documentation(s7, ss->spectro_z_angle_symbol, "*spectro-z-angle*: spectrogram z-axis viewing angle (-2.0)");
+ s7_symbol_set_documentation(s7, ss->spectro_x_angle_symbol, "*spectro-x-angle*: spectrogram x-axis viewing angle (90.0)");
+ s7_symbol_set_documentation(s7, ss->spectro_y_angle_symbol, "*spectro-y-angle*: spectrogram y-axis viewing angle (0.0)");
+ s7_symbol_set_documentation(s7, ss->spectrum_end_symbol, "*spectrum-end*: max frequency shown in spectra (1.0 = srate/2)");
+ s7_symbol_set_documentation(s7, ss->spectrum_start_symbol, "*spectrum-start*: lower bound of frequency in spectral displays (0.0)");
+ s7_symbol_set_documentation(s7, ss->spectro_hop_symbol, "*spectro-hop*: hop amount (pixels) in spectral displays");
+ s7_symbol_set_documentation(s7, ss->wavelet_type_symbol, "*wavelet-type*: wavelet used in wavelet-transform (0)");
+ s7_symbol_set_documentation(s7, ss->dot_size_symbol, "*dot-size*: size in pixels of dots when graphing with dots (1)");
+ s7_symbol_set_documentation(s7, ss->zero_pad_symbol, "*zero-pad*: zero padding used in fft as a multiple of fft size (0)");
+ s7_symbol_set_documentation(s7, ss->wavo_hop_symbol, "*wavo-hop*: wavogram spacing between successive traces");
+ s7_symbol_set_documentation(s7, ss->wavo_trace_symbol, "*wavo-trace*: length (samples) of each trace in the wavogram (64)");
+ s7_symbol_set_documentation(s7, ss->transform_size_symbol, "*transform-size*: current fft size (512)");
+ s7_symbol_set_documentation(s7, ss->fft_window_symbol, "*fft-window*: fft data window choice (blackman2-window etc)");
+ s7_symbol_set_documentation(s7, ss->transform_graph_type_symbol, "*transform-graph-type* can be graph-once, graph-as-sonogram, or graph-as-spectrogram.");
+ s7_symbol_set_documentation(s7, ss->time_graph_type_symbol, "*time-graph-type*: graph-once or graph-as-wavogram");
+ s7_symbol_set_documentation(s7, ss->fft_window_alpha_symbol, "*fft-window-alpha*: fft window alpha parameter value");
+ s7_symbol_set_documentation(s7, ss->fft_window_beta_symbol, "*fft-window-beta*: fft window beta parameter value");
+ s7_symbol_set_documentation(s7, ss->grid_density_symbol, "*grid-density*: sets how closely axis ticks are spaced, default=1.0");
+ s7_symbol_set_documentation(s7, ss->beats_per_minute_symbol, "*beats-per-minute*: beats per minute if x-axis-style is x-axis-in-beats");
+ s7_symbol_set_documentation(s7, ss->show_mix_waveforms_symbol, "*show-mix-waveforms*: #t if Snd should display mix waveforms (above the main waveform)");
+ s7_symbol_set_documentation(s7, ss->beats_per_measure_symbol, "*beats-per-measure*: beats per measure if x-axis-style is x-axis-in-measures");
+ s7_symbol_set_documentation(s7, ss->transform_normalization_symbol, "*transform-normalization*: dont-normalize, normalize-by-channel, normalize-by-sound, or normalize-globally.");
+ s7_symbol_set_documentation(s7, ss->x_axis_style_symbol, "*x-axis-style*: The x axis labelling of the time domain waveform (x-axis-in-seconds etc)");
+ s7_symbol_set_documentation(s7, ss->zoom_focus_style_symbol, "*zoom-focus-style*: determines what zooming centers on (zoom-focus-active etc).");
+ s7_symbol_set_documentation(s7, ss->graph_style_symbol, "*graph-style*: graph style (graph-lines etc)");
+ s7_symbol_set_documentation(s7, ss->max_transform_peaks_symbol, "*max-transform-peaks*: max number of fft peaks reported in fft display");
+ s7_symbol_set_documentation(s7, ss->graphs_horizontal_symbol, "*graphs-horizontal*: #t if the time domain, fft, and lisp graphs are layed out horizontally");
+ s7_symbol_set_documentation(s7, ss->cursor_size_symbol, "*cursor-size*: current cursor size");
+ s7_symbol_set_documentation(s7, ss->cursor_style_symbol, "*cursor-style*: current cursor shape (cursor-cross etc)");
+ s7_symbol_set_documentation(s7, ss->tracking_cursor_style_symbol, "*tracking-cursor-style*: current tracking cursor shape (cursor-cross, cursor-line)");
+ s7_symbol_set_documentation(s7, ss->show_sonogram_cursor_symbol, "*show-sonogram-cursor*: #t if Snd should display a cursor in the sonogram");
+ s7_symbol_set_documentation(s7, ss->min_db_symbol, "*min-dB*: min dB value displayed in fft graphs using dB scales (-60)");
+ s7_symbol_set_documentation(s7, ss->transform_type_symbol, "*transform-type*: transform type (fourier-transform etc)");
+ s7_symbol_set_documentation(s7, ss->with_gl_symbol, "*with-gl*: #t if Snd should use GL graphics");
+
+ s7_symbol_set_access(s7, ss->transform_type_symbol, s7_make_function(s7, "[acc-" S_transform_type "]", acc_transform_type, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_transform_peaks_symbol, s7_make_function(s7, "[acc-" S_show_transform_peaks "]", acc_show_transform_peaks, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_y_zero_symbol, s7_make_function(s7, "[acc-" S_show_y_zero "]", acc_show_y_zero, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_marks_symbol, s7_make_function(s7, "[acc-" S_show_marks "]", acc_show_marks, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_grid_symbol, s7_make_function(s7, "[acc-" S_show_grid "]", acc_show_grid, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->fft_log_frequency_symbol, s7_make_function(s7, "[acc-" S_fft_log_frequency "]", acc_fft_log_frequency, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->fft_log_magnitude_symbol, s7_make_function(s7, "[acc-" S_fft_log_magnitude "]", acc_fft_log_magnitude, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->fft_with_phases_symbol, s7_make_function(s7, "[acc-" S_fft_with_phases "]", acc_fft_with_phases, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->sync_style_symbol, s7_make_function(s7, "[acc-" S_sync_style "]", acc_sync_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_axes_symbol, s7_make_function(s7, "[acc-" S_show_axes "]", acc_show_axes, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_verbose_cursor_symbol, s7_make_function(s7, "[acc-" S_with_verbose_cursor "]", acc_with_verbose_cursor, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectro_x_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_x_scale "]", acc_spectro_x_scale, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectro_y_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_y_scale "]", acc_spectro_y_scale, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectro_z_scale_symbol, s7_make_function(s7, "[acc-" S_spectro_z_scale "]", acc_spectro_z_scale, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectro_z_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_z_angle "]", acc_spectro_z_angle, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectro_x_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_x_angle "]", acc_spectro_x_angle, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectro_y_angle_symbol, s7_make_function(s7, "[acc-" S_spectro_y_angle "]", acc_spectro_y_angle, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectrum_end_symbol, s7_make_function(s7, "[acc-" S_spectrum_end "]", acc_spectrum_end, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectrum_start_symbol, s7_make_function(s7, "[acc-" S_spectrum_start "]", acc_spectrum_start, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->spectro_hop_symbol, s7_make_function(s7, "[acc-" S_spectro_hop "]", acc_spectro_hop, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->wavelet_type_symbol, s7_make_function(s7, "[acc-" S_wavelet_type "]", acc_wavelet_type, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->dot_size_symbol, s7_make_function(s7, "[acc-" S_dot_size "]", acc_dot_size, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->zero_pad_symbol, s7_make_function(s7, "[acc-" S_zero_pad "]", acc_zero_pad, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->wavo_hop_symbol, s7_make_function(s7, "[acc-" S_wavo_hop "]", acc_wavo_hop, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->wavo_trace_symbol, s7_make_function(s7, "[acc-" S_wavo_trace "]", acc_wavo_trace, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->transform_size_symbol, s7_make_function(s7, "[acc-" S_transform_size "]", acc_transform_size, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->fft_window_symbol, s7_make_function(s7, "[acc-" S_fft_window "]", acc_fft_window, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->transform_graph_type_symbol, s7_make_function(s7, "[acc-" S_transform_graph_type "]", acc_transform_graph_type, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->time_graph_type_symbol, s7_make_function(s7, "[acc-" S_time_graph_type "]", acc_time_graph_type, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->fft_window_alpha_symbol, s7_make_function(s7, "[acc-" S_fft_window_alpha "]", acc_fft_window_alpha, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->fft_window_beta_symbol, s7_make_function(s7, "[acc-" S_fft_window_beta "]", acc_fft_window_beta, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->grid_density_symbol, s7_make_function(s7, "[acc-" S_grid_density "]", acc_grid_density, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->beats_per_minute_symbol, s7_make_function(s7, "[acc-" S_beats_per_minute "]", acc_beats_per_minute, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_mix_waveforms_symbol, s7_make_function(s7, "[acc-" S_show_mix_waveforms "]", acc_show_mix_waveforms, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->beats_per_measure_symbol, s7_make_function(s7, "[acc-" S_beats_per_measure "]", acc_beats_per_measure, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->transform_normalization_symbol, s7_make_function(s7, "[acc-" S_transform_normalization "]", acc_transform_normalization, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->x_axis_style_symbol, s7_make_function(s7, "[acc-" S_x_axis_style "]", acc_x_axis_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->zoom_focus_style_symbol, s7_make_function(s7, "[acc-" S_zoom_focus_style "]", acc_zoom_focus_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->graph_style_symbol, s7_make_function(s7, "[acc-" S_graph_style "]", acc_graph_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->max_transform_peaks_symbol, s7_make_function(s7, "[acc-" S_max_transform_peaks "]", acc_max_transform_peaks, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->graphs_horizontal_symbol, s7_make_function(s7, "[acc-" S_graphs_horizontal "]", acc_graphs_horizontal, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->cursor_size_symbol, s7_make_function(s7, "[acc-" S_cursor_size "]", acc_cursor_size, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->cursor_style_symbol, s7_make_function(s7, "[acc-" S_cursor_style "]", acc_cursor_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->tracking_cursor_style_symbol, s7_make_function(s7, "[acc-" S_tracking_cursor_style "]", acc_tracking_cursor_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_sonogram_cursor_symbol, s7_make_function(s7, "[acc-" S_show_sonogram_cursor "]", acc_show_sonogram_cursor, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->min_db_symbol, s7_make_function(s7, "[acc-" S_min_dB "]", acc_min_dB, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_gl_symbol, s7_make_function(s7, "[acc-" S_with_gl "]", acc_with_gl, 2, 0, false, "accessor"));
+
+ s7_eval_c_string(s7, "(set! *transform-type* fourier-transform)");
+#endif
+}
diff --git a/snd-completion.c b/snd-completion.c
index e510374..314a7e7 100644
--- a/snd-completion.c
+++ b/snd-completion.c
@@ -60,11 +60,11 @@ static int completions(const char *text)
#if HAVE_RUBY
-static XEN snd_rb_methods(void)
+static Xen snd_rb_methods(void)
{
/* returns all the functions we defined */
- XEN argv[1];
- argv[0] = XEN_TRUE;
+ Xen argv[1];
+ argv[0] = Xen_true;
return(rb_class_private_instance_methods(1, argv, rb_mKernel));
/* rb_ary_new here -- should we free? */
}
@@ -72,20 +72,20 @@ static XEN snd_rb_methods(void)
static int completions(const char *text)
{
- XEN tab;
+ Xen tab;
int i, n, len, matches = 0;
tab = snd_rb_methods();
- n = XEN_VECTOR_LENGTH(tab);
+ n = Xen_vector_length(tab);
len = strlen(text);
for (i = 0; i < n; ++i)
{
char *sym;
- XEN handle;
+ Xen handle;
- handle = XEN_VECTOR_REF(tab, i);
- sym = XEN_AS_STRING(handle);
+ handle = Xen_vector_ref(tab, i);
+ sym = Xen_object_to_C_string(handle);
if (strncmp(text, sym, len) == 0)
{
@@ -105,9 +105,6 @@ static int completions(const char *text)
}
}
}
-#if HAVE_SCHEME
- if (sym) free(sym);
-#endif
}
return(matches);
}
@@ -117,12 +114,12 @@ static int completions(const char *text)
#if HAVE_FORTH
static int completions(const char *text)
{
- XEN tab = fth_find_in_wordlist(text);
- int i, matches = XEN_VECTOR_LENGTH(tab);
+ Xen tab = fth_find_in_wordlist(text);
+ int i, matches = Xen_vector_length(tab);
for (i = 0; i < matches; i++)
{
- char *sym = XEN_TO_C_STRING(XEN_VECTOR_REF(tab, i));
+ char *sym = Xen_string_to_C_string(Xen_vector_ref(tab, i));
add_possible_completion(sym);
if (current_match == NULL)
current_match = mus_strdup(sym);
@@ -149,13 +146,13 @@ static int completions(const char *text) {return(0);}
#if HAVE_FORTH
-bool separator_char_p(char c)
+static bool is_separator(char c)
{
/* only space is separator */
return(!(isgraph((int)c)));
}
#else
-bool separator_char_p(char c)
+static bool is_separator(char c)
{
return((!(isalpha((int)c))) &&
(!(isdigit((int)c))) &&
@@ -199,7 +196,7 @@ char *direct_completions(const char *str)
char *expression_completer(widget_t w, const char *original_text, void *data)
{
- int i, len, beg, matches = 0;
+ int len, beg, matches = 0;
/* first back up to some delimiter to get the current expression */
current_match = NULL;
@@ -208,10 +205,11 @@ char *expression_completer(widget_t w, const char *original_text, void *data)
if ((original_text) && (*original_text))
{
const char *text;
+ int i;
len = strlen(original_text);
for (i = len - 1; i >= 0; i--)
- if (separator_char_p(original_text[i]))
+ if (is_separator(original_text[i]))
break;
beg = i + 1;
@@ -265,16 +263,14 @@ void preload_best_completions(void)
/* set up the array with some reasonable first choices */
int n = 0;
best_completions[n++] = mus_strdup(S_open_sound);
- best_completions[n++] = mus_strdup(S_auto_resize);
best_completions[n++] = mus_strdup(S_channels);
best_completions[n++] = mus_strdup(S_close_sound);
best_completions[n++] = mus_strdup(S_cursor);
best_completions[n++] = mus_strdup(S_env_channel);
best_completions[n++] = mus_strdup(S_file_name);
- best_completions[n++] = mus_strdup(S_frames);
+ best_completions[n++] = mus_strdup(S_framples);
best_completions[n++] = mus_strdup(S_map_channel);
best_completions[n++] = mus_strdup(S_maxamp);
- best_completions[n++] = mus_strdup(S_optimization);
best_completions[n++] = mus_strdup(S_play);
best_completions[n++] = mus_strdup(S_save_sound);
best_completions[n++] = mus_strdup(S_scale_channel);
@@ -284,7 +280,6 @@ void preload_best_completions(void)
best_completions[n++] = mus_strdup("*output*");
best_completions[n++] = mus_strdup("lambda");
best_completions[n++] = mus_strdup("define");
- best_completions[n++] = mus_strdup(S_vct_length);
}
@@ -476,8 +471,8 @@ void add_srate_to_completion_list(int srate)
int i;
init_srate_list();
- str = (char *)calloc(16, sizeof(char));
- mus_snprintf(str, 16, "%d", srate);
+ str = (char *)malloc(16 * sizeof(char));
+ snprintf(str, 16, "%d", srate);
for (i = 0; i < srate_info->num_values; i++)
if (mus_strcmp(srate_info->values[i], str))
@@ -504,7 +499,7 @@ char *srate_completer(widget_t w, const char *text, void * data)
}
-#if HAVE_DIRENT_H
+#ifndef _MSC_VER
#include <dirent.h>
#endif
@@ -513,15 +508,13 @@ enum {ANY_FILE_TYPE, SOUND_FILE_TYPE};
static char *filename_completer_1(widget_t w, const char *text, int file_type)
{
-#if HAVE_OPENDIR
/* assume text is a partial filename */
/* get directory name, opendir, read files checking for match */
/* return name of same form as original (i.e. don't change user's directory indication) */
- /* if directory, add "/" -- directory_p(name) static in snd-xfile.c */
+ /* if directory, add "/" -- is_directory(name) static in snd-xfile.c */
char *full_name = NULL, *dir_name = NULL, *file_name = NULL, *current_match = NULL;
int i, j, k, len, curlen, matches = 0;
- struct dirent *dirp;
DIR *dpos;
if (mus_strlen(text) == 0) return(NULL);
@@ -547,12 +540,13 @@ static char *filename_completer_1(widget_t w, const char *text, int file_type)
len = mus_strlen(file_name);
if ((dpos = opendir(dir_name)) != NULL)
{
+ struct dirent *dirp;
while ((dirp = readdir(dpos)) != NULL)
if ((dirp->d_name[0] != '.') &&
(strncmp(dirp->d_name, file_name, len) == 0)) /* match dirp->d_name against rest of text */
{
if ((file_type == ANY_FILE_TYPE) ||
- (sound_file_p(dirp->d_name)))
+ (is_sound_file(dirp->d_name)))
{
matches++;
add_possible_completion(dirp->d_name);
@@ -593,12 +587,11 @@ static char *filename_completer_1(widget_t w, const char *text, int file_type)
file_name = (char *)calloc(curlen, sizeof(char));
strncpy(file_name, text, i + 1);
strcat(file_name, current_match);
- if (directory_p(file_name))
+ if (is_directory(file_name))
strcat(file_name, "/");
free(current_match);
return(file_name);
}
-#endif
return(mus_strdup(text));
}
@@ -615,59 +608,6 @@ char *sound_filename_completer(widget_t w, const char *text, void *data)
}
-static bool use_sound_filename_completer(sp_filing_t filing)
-{
- return((filing == INPUT_FILING) || /* C-x C-f */
- (filing == CHANGE_FILING) || /* C-x C-q */
- (filing == INSERT_FILING)); /* C-x C-i */
-}
-
-
-char *info_completer(widget_t w, const char *text, void *data)
-{
- snd_info *sp = (snd_info *)data;
- if (sp)
- {
- char *new_text = NULL;
- if (sp->search_count != 0) return(mus_strdup(text)); /* C-s or C-r so as above */
- if ((sp->marking) || (sp->finding_mark)) return(mus_strdup(text)); /* C-x C-m etc */
- if (sp->printing) return(mus_strdup(text)); /* C-x C-d so anything is possible */
- if (sp->amp_count != 0) return(env_name_completer(w, text, NULL));
- if (use_sound_filename_completer(sp->filing)) return(sound_filename_completer(w, text, NULL));
- if (sp->loading) return(filename_completer(w, text, NULL)); /* C-x C-l */
-
- new_text = expression_completer(w, text, NULL);
- if (get_completion_matches() == 0)
- {
- int i, beg, parens, len;
- beg = 0;
- parens = 0; /* filename would have to be a string in this context */
- len = mus_strlen(text);
- for (i = 0; i < len; i++)
- if (text[i] == '\"')
- {
- beg = i + 1;
- parens++;
- break;
- }
- if ((beg > 0) && (parens & 1)) /* i.e. there is a string and we're in it */
- {
- char *new_file;
- if (new_text) free(new_text);
- new_file = filename_completer(w, (char *)(text + beg), NULL);
- len = beg + 2 + mus_strlen(new_file);
- new_text = (char *)calloc(len, sizeof(char));
- strncpy(new_text, text, beg);
- strcat(new_text, new_file);
- if (new_file) free(new_file);
- }
- }
- return(new_text);
- }
- return(expression_completer(w, text, NULL));
-}
-
-
static int find_indentation(char *str, int loc)
{
int line_beg = 0, open_paren = -1, parens, i;
@@ -765,7 +705,7 @@ char *complete_listener_text(char *old_text, int end, bool *try_completion, char
new_text = (char *)calloc(len, sizeof(char));
strncpy(new_text, old_text, i + 1);
strcat(new_text, new_file);
- if (new_file) free(new_file);
+ free(new_file);
}
break;
}
@@ -793,7 +733,7 @@ char *list_completer(widget_t w, const char *text, void *data)
/* strip away leading and trailing white space */
trimmed_text = (char *)calloc(len + 1, sizeof(char));
for (i = 0; i < len; i++)
- if (!(isspace(text[i])))
+ if (!(isspace((int)text[i])))
trimmed_text[j++] = text[i];
if (j == 0)
diff --git a/snd-contents.html b/snd-contents.html
deleted file mode 100644
index da1a423..0000000
--- a/snd-contents.html
+++ /dev/null
@@ -1,511 +0,0 @@
-<html>
-<head>
-<title>Contents</title>
-<style type="text/css">
-<!--
- EM.red {color:red; font-style:normal}
- H1 {text-align: center}
- UL {list-style-type: none}
- PRE {font-family: Times, serif}
-
- A {text-decoration:none}
- A:hover {text-decoration:underline}
- A.quiet {color:black; text-decoration:none}
- A.quiet:hover {text-decoration:underline}
--->
-</style>
-
-<!-- based on code from Danny Goodman, "Javascript & DHTML Cookbook", O'Reilly -->
-
-<script language=JavaScript>
-
-var collapsedWidget = new Image(20, 16);
-collapsedWidget.src = "pix/toc-plus.png";
-var expandedWidget = new Image(20, 16);
-expandedWidget.src = "pix/toc-minus.png";
-var emptySpace = new Image(20, 16);
-emptySpace.src = "pix/toc-blank.png";
-
-var widgetWidth = "16";
-var widgetHeight = "16";
-var blankWidth = "16";
-var currState = "";
-var displayTarget = "snd1";
-
-function outlineItem(text, uri) {
- this.text = text;
- this.uri = uri;
-}
-
-function outlineInnerItem(text, uri) {
- this.text = "<small>" + text + "</small>";
- this.uri = uri;
-}
-
-var olData = {childNodes:
- [{item:new outlineItem("Introduction", "snd.html#gettingstarted")},
- {item:new outlineItem("Tutorial", "tutorial/1_intro_and_build_snd.html"),
- childNodes:
- [{item:new outlineInnerItem("Developing And Using Snd", "tutorial/1_intro_and_build_snd.html")},
- {item:new outlineInnerItem("Customizing Snd: The Basics", "tutorial/2_custom_snd.html")},
- {item:new outlineInnerItem("A Brief Tutorial For Snd", "tutorial/3_editing_and_processing_snd.html")},
- {item:new outlineInnerItem("Some Advanced Uses Of Snd", "tutorial/4_advanced_snd.html")},
- {item:new outlineInnerItem("Sounding Out", "tutorial/5_close_snd.html")},
- {item:new outlineInnerItem("Resources", "tutorial/6_resources.html")}]},
- {item:new outlineItem("File Operations", "snd.html#fileoperations"),
- childNodes:
- [{item:new outlineInnerItem("The Display", "snd.html#viewing")},
- {item:new outlineInnerItem("Other Options", "snd.html#options")}]},
- {item:new outlineItem("Editing", "snd.html#editoperations"),
- childNodes:
- [{item:new outlineInnerItem("The Active Channel and The Cursor", "snd.html#thecursor")},
- {item:new outlineInnerItem("Marks", "snd.html#marks")},
- {item:new outlineInnerItem("Regions", "snd.html#regions")},
- {item:new outlineInnerItem("Edit Lists", "snd.html#edithistory")},
- {item:new outlineInnerItem("How to ...", "snd.html#howtoedit"),
- childNodes:
- [{item:new outlineInnerItem("Save, open, close, print", "snd.html#saveopen")},
- {item:new outlineInnerItem("Delete, insert, mix", "snd.html#deleteinsert")},
- {item:new outlineInnerItem("Multichannel operationss", "snd.html#multichannel")},
- {item:new outlineInnerItem("Amplitude envelopes", "snd.html#ampenvs")},
- {item:new outlineInnerItem("Find", "snd.html#menufind")},
- {item:new outlineInnerItem("Change samples", "snd.html#changesamples")},
- {item:new outlineInnerItem("Undo, redo, revert", "snd.html#undoredo")},
- {item:new outlineInnerItem("Play", "snd.html#menuplay")},
- {item:new outlineInnerItem("Mix Files", "snd.html#mixingfiles")},
- {item:new outlineInnerItem("Keyboard macros", "snd.html#kbdmacros")},
- {item:new outlineInnerItem("Change file format", "snd.html#changeformat")},
- {item:new outlineInnerItem("Extend a file", "snd.html#extendfile")},
- {item:new outlineInnerItem("Record a file", "snd.html#recordfile")},
- {item:new outlineInnerItem("Edit or view an envelope", "snd.html#editenvelope")},
- {item:new outlineInnerItem("Edit, add, or remove the header", "snd.html#editheader")},
- {item:new outlineInnerItem("Center a tiny signal with DC", "snd.html#centeryaxis")},
- {item:new outlineInnerItem("Save session", "snd.html#savedstate")},
- {item:new outlineInnerItem("Miscellaneous commands", "snd.html#misccommands")}]},
- {item:new outlineInnerItem("Keyboard Commands", "snd.html#keyboardcommands")}]},
- {item:new outlineItem("Control Panel", "snd.html#controls")},
- {item:new outlineItem("Extension and Customization", "extsnd.html#extsndcontents"),
- childNodes:
- [{item:new outlineInnerItem("Introduction", "extsnd.html#lisplistener")},
- {item:new outlineInnerItem("Snd Programming", "extsnd.html#etc")},
- {item:new outlineInnerItem("Customizing Snd's behavior", "extsnd.html#behavior")},
- {item:new outlineInnerItem("Global variables", "extsnd.html#sndglobalvars")},
- {item:new outlineInnerItem("Generic functions", "extsnd.html#sndgenericfuncs")},
- {item:new outlineInnerItem("Hooks", "extsnd.html#sndhooks")},
- {item:new outlineInnerItem("Snd's objects", "extsnd.html#sndobjects")},
- {item:new outlineInnerItem("Samplers", "extsnd.html#samplers")},
- {item:new outlineInnerItem("Vcts", "extsnd.html#Vcts")},
- {item:new outlineInnerItem("Sound-data", "extsnd.html#sndsounddata")},
- {item:new outlineInnerItem("Sndlib", "extsnd.html#extsndlib")},
- {item:new outlineInnerItem("Marks", "extsnd.html#sndmarks")},
- {item:new outlineInnerItem("Mixes", "extsnd.html#sndmixes")},
- {item:new outlineInnerItem("Regions and Selections", "extsnd.html#sndregions")},
- {item:new outlineInnerItem("Sounds", "extsnd.html#sndsounds")},
- {item:new outlineInnerItem("Controls", "extsnd.html#customcontrols")},
- {item:new outlineInnerItem("Edit Lists", "extsnd.html#editlists")},
- {item:new outlineInnerItem("Transforms", "extsnd.html#sndtransforms")},
- {item:new outlineInnerItem("Dialogs", "extsnd.html#snddialogs")},
- {item:new outlineInnerItem("Miscellaneous functions", "extsnd.html#sndmisc")},
- {item:new outlineInnerItem("Constants", "extsnd.html#sndconstants")},
- {item:new outlineInnerItem("Errors and Debugging", "extsnd.html#snderrors")},
- {item:new outlineInnerItem("Customizing Snd's appearance", "extsnd.html#appearance")},
- {item:new outlineInnerItem("Colors", "extsnd.html#colors")},
- {item:new outlineInnerItem("Fonts", "extsnd.html#fonts")},
- {item:new outlineInnerItem("Graphics", "extsnd.html#graphics")}]},
- {item:new outlineItem("Snd Startup", "grfsnd.html#startup"),
- childNodes:
- [{item:new outlineInnerItem("Invocation", "grfsnd.html#sndswitches")},
- {item:new outlineInnerItem("Initialization file", "grfsnd.html#sndinitfile")},
- {item:new outlineInnerItem("Configuration Switches", "grfsnd.html#sndconfigurationswitches")},
- {item:new outlineInnerItem("Environment Variables", "grfsnd.html#sndenvvars")}]},
- {item:new outlineItem("External Programs", "grfsnd.html#snddynamic"),
- childNodes:
- [{item:new outlineInnerItem("Snd as an Emacs subjob", "grfsnd.html#emacssnd")},
- {item:new outlineInnerItem("Dynamically loaded modules", "grfsnd.html#dynamic")},
- {item:new outlineInnerItem("Snd as a Widget", "grfsnd.html#sndaswidget")},
- {item:new outlineInnerItem("Snd and CLM", "grfsnd.html#sndwithclm")},
- {item:new outlineInnerItem("Snd and Common Music", "grfsnd.html#sndwithcm")},
- {item:new outlineInnerItem("Snd and Pd", "grfsnd.html#sndwithpd")},
- {item:new outlineInnerItem("Snd and Motif", "grfsnd.html#sndwithmotif")},
- {item:new outlineInnerItem("Snd and Gtk", "grfsnd.html#sndwithgtk")},
- {item:new outlineInnerItem("Snd with no GUI and as script engine", "grfsnd.html#sndwithnogui")},
- {item:new outlineInnerItem("Snd with Ruby", "grfsnd.html#sndandruby")},
- {item:new outlineInnerItem("Snd with Forth", "grfsnd.html#sndandforth")},
- {item:new outlineInnerItem("Snd with s7", "grfsnd.html#sndands7")},
- {item:new outlineInnerItem("Snd and LADSPA plugins", "grfsnd.html#sndandladspa")},
- {item:new outlineInnerItem("Snd and ALSA", "grfsnd.html#sndandalsa")},
- {item:new outlineInnerItem("Snd and Jack", "grfsnd.html#sndandjack")},
- {item:new outlineInnerItem("Snd and OpenGL", "grfsnd.html#sndandgl")},
- {item:new outlineInnerItem("Snd and GSL", "grfsnd.html#sndandgsl")},
- {item:new outlineInnerItem("Snd and multiprecision arithmetic", "grfsnd.html#sndandgmp")}]},
- {item:new outlineItem("Sndlib", "sndlib.html#introduction"),
- childNodes:
- [{item:new outlineInnerItem("Headers", "sndlib.html#headers")},
- {item:new outlineInnerItem("Data", "sndlib.html#data")},
- {item:new outlineInnerItem("Hardware", "sndlib.html#hardware")},
- {item:new outlineInnerItem("Music V", "sndlib.html#music5")},
- {item:new outlineInnerItem("Examples", "sndlib.html#examples")},
- {item:new outlineInnerItem("SndInfo", "sndlib.html#sndinfo")},
- {item:new outlineInnerItem("SndPlay", "sndlib.html#sndplay")},
- {item:new outlineInnerItem("AudInfo", "sndlib.html#audinfo")},
- {item:new outlineInnerItem("SndSine", "sndlib.html#sndsine")},
- {item:new outlineInnerItem("clmosc", "sndlib.html#clmosc")},
- {item:new outlineInnerItem("Other Examples", "sndlib.html#otherexamples")},
- {item:new outlineInnerItem("Current Status", "sndlib.html#currentstatus")},
- {item:new outlineInnerItem("Extension Languages", "sndlib.html#sndlibxen")}]},
- {item:new outlineItem("CLM", "sndclm.html#introduction"),
- childNodes:
- [{item:new outlineInnerItem("Built-in Generators", "sndclm.html#generators")},
- {item:new outlineInnerItem("Other Generators", "sndclm.html#othergenerators")},
- {item:new outlineInnerItem("Functions", "sndclm.html#functions")},
- {item:new outlineInnerItem("Instruments", "sndclm.html#instruments")}]},
- {item:new outlineItem("Scheme, Ruby, and Forth files", "sndscm.html#introduction"),
- childNodes:
- [{item:new outlineInnerItem("analog-filter: standard analog filters", "sndscm.html#analogfilterdoc")},
- {item:new outlineInnerItem("animals: a bunch of animals", "sndscm.html#animalsdoc")},
- {item:new outlineInnerItem("autosave: auto-save (edit backup) support", "sndscm.html#autosavedoc")},
- {item:new outlineInnerItem("bess and bess1: FM demo", "sndscm.html#bessdoc")},
- {item:new outlineInnerItem("binary-io: binary files", "sndscm.html#binaryiodoc")},
- {item:new outlineInnerItem("bird: North-American birds", "sndscm.html#birddoc")},
- {item:new outlineInnerItem("clean: noise reduction", "sndscm.html#cleandoc")},
- {item:new outlineInnerItem("clm-ins: more CLM instruments", "sndscm.html#clminsdoc")},
- {item:new outlineInnerItem("dlocsig: moving sound simulation", "sndscm.html#dlocsigdoc")},
- {item:new outlineInnerItem("draw: graphics additions", "sndscm.html#drawdoc")},
- {item:new outlineInnerItem("dsp: various DSP-related procedures", "sndscm.html#dspdoc")},
- {item:new outlineInnerItem("edit123, snd_conffile, snd_frg: .snd examples", "sndscm.html#dotsnd")},
- {item:new outlineInnerItem("env: envelope functions", "sndscm.html#envdoc")},
- {item:new outlineInnerItem("enved: envelope editor", "sndscm.html#enveddoc")},
- {item:new outlineInnerItem("examp: many examples", "sndscm.html#exampdoc")},
- {item:new outlineInnerItem("extensions: extensions of Snd", "sndscm.html#extensionsdoc")},
- {item:new outlineInnerItem("fade: frequency-domain cross-fades", "sndscm.html#fadedoc")},
- {item:new outlineInnerItem("fmv: controller for the fm-violin", "sndscm.html#vdoc")},
- {item:new outlineInnerItem("frame: frame, vct, and sound-data objects", "sndscm.html#framedoc")},
- {item:new outlineInnerItem("freeverb: a reverb", "sndscm.html#freeverbdoc")},
- {item:new outlineInnerItem("generators: various generators", "sndclm.html#othergenerators")},
- {item:new outlineInnerItem("grani: granular synthesis", "sndscm.html#granidoc")},
- {item:new outlineInnerItem("heart: Snd and non-sound data", "sndscm.html#heartdoc")},
- {item:new outlineInnerItem("hooks: functions related to hooks", "sndscm.html#hooksdoc")},
- {item:new outlineInnerItem("index: snd-help extension", "sndscm.html#indexdoc")},
- {item:new outlineInnerItem("inf-snd.el, DotEmacs: Emacs subjob support", "sndscm.html#dotemacs")},
- {item:new outlineInnerItem("jcrev: John Chowning's reverb", "sndscm.html#jcrevdoc")},
- {item:new outlineInnerItem("ladspa: Kjetil S. Matheussen's LADSPA previewer.", "sndscm.html#ladspadoc")},
- {item:new outlineInnerItem("maraca: Perry Cook's maraca physical model", "sndscm.html#maracadoc")},
- {item:new outlineInnerItem("marks: functions related to marks", "sndscm.html#marksdoc")},
- {item:new outlineInnerItem("maxf: Max Mathews resonator", "sndscm.html#maxfdoc")},
- {item:new outlineInnerItem("menus: additional menus", "sndscm.html#menusdoc")},
- {item:new outlineInnerItem("mix: functions related to mixes", "sndscm.html#mixdoc")},
- {item:new outlineInnerItem("mixer: functions related to mixers and frames", "sndscm.html#mixerdoc")},
- {item:new outlineInnerItem("moog: Moog filter", "sndscm.html#moogdoc")},
- {item:new outlineInnerItem("musglyphs: Music notation symbols (from CMN)", "sndscm.html#musglyphs")},
- {item:new outlineInnerItem("nb: Popup File info etc", "sndscm.html#nbdoc")},
- {item:new outlineInnerItem("noise: CLM's noise.ins", "sndscm.html#noisedoc")},
- {item:new outlineInnerItem("numerics: fun with special functions, etc", "sndscm.html#numericsdoc")},
- {item:new outlineInnerItem("oscope: oscilloscope", "sndscm.html#oscopedoc")},
- {item:new outlineInnerItem("peak-phases: phases for the unpulse-train", "sndscm.html#peakphasesdoc")},
- {item:new outlineInnerItem("piano: piano physical model", "sndscm.html#pianodoc")},
- {item:new outlineInnerItem("play: play-related functions", "sndscm.html#playdoc")},
- {item:new outlineInnerItem("poly: polynomial-related functions", "sndscm.html#polydoc")},
- {item:new outlineInnerItem("prc95: Perry Cook's physical model examples", "sndscm.html#prc95doc")},
- {item:new outlineInnerItem("pvoc: phase-vocoder", "sndscm.html#pvocdoc")},
- {item:new outlineInnerItem("rgb: color names", "sndscm.html#rgbdoc")},
- {item:new outlineInnerItem("rt-examples: hard real-time support", "sndscm.html#rtexdoc")},
- {item:new outlineInnerItem("rtio: real-time stuff", "sndscm.html#rtiodoc")},
- {item:new outlineInnerItem("rubber: rubber-sound", "sndscm.html#rubberdoc")},
- {item:new outlineInnerItem("selection: selection functions", "sndscm.html#selectiondoc")},
- {item:new outlineInnerItem("singer: Perry Cook's vocal-tract physical model", "sndscm.html#singerdoc")},
- {item:new outlineInnerItem("sndwarp: Bret Battey's sndwarp instrument", "sndscm.html#sndwarpdoc")},
- {item:new outlineInnerItem("snd9..11: backwards compatibility", "sndscm.html#sndolddoc")},
- {item:new outlineInnerItem("snddiff: sound difference detection", "sndscm.html#snddiffdoc")},
- {item:new outlineInnerItem("snd-gl: OpenGL examples (gl.c)", "sndscm.html#sndgldoc")},
- {item:new outlineInnerItem("snd-motif, snd-gtk, snd-xm: Motif/Gtk module (xm.c, xg.c)", "sndscm.html#sndmotifdoc")},
- {item:new outlineInnerItem("snd-test: Snd regression tests", "sndscm.html#sndtestdoc")},
- {item:new outlineInnerItem("spectr: instrument steady-state spectra", "sndscm.html#spectrdoc")},
- {item:new outlineInnerItem("strad: violin physical model", "sndscm.html#straddoc")},
- {item:new outlineInnerItem("v: fm-violin", "sndscm.html#vdoc")},
- {item:new outlineInnerItem("ws: with-sound", "sndscm.html#wsdoc")},
- {item:new outlineInnerItem("zip: the zipper (a cross-fader)", "sndscm.html#zipdoc")}]},
- {item:new outlineItem("FM Introduction", "fm.html#fmintro")},
- {item:new outlineItem("Libxm", "libxm.html#xm")},
- {item:new outlineItem("Index", "index.html"),
- childNodes:
- [{item:new outlineInnerItem("CLM Index", "sndclm.html#clmindex")}]}]};
-
-function swapState(currState, currVal, n) {
- var newState = currState.substring(0, n);
- newState += currVal ^ 1 // Bitwise XOR item n;
- newState += currState.substring(n + 1, currState.length);
- return newState;
-}
-
-function toggle(img, blockNum) {
- var newString = "";
- var expanded, n;
- expanded = currState.charAt(blockNum);
- currState = swapState(currState, expanded, blockNum);
- if (expanded == "0") {
- document.getElementById("OLBlock" + blockNum).style.display = "block";
- img.src = expandedWidget.src;
- } else {
- document.getElementById("OLBlock" + blockNum).style.display = "none";
- img.src = collapsedWidget.src;
- }
-}
-
-function expandAll() {
- var newState = "";
- while (newState.length < currState.length) {
- newState += "1";
- }
- currState = newState;
- initExpand();
-}
-
-function collapseAll() {
- var newState = "";
- while (newState.length < currState.length) {
- newState += "0";
- }
- currState = newState;
- initExpand();
-}
-
-var blockID = 0;
-
-function drawOutline(ol, prefix) {
- var output = "";
- var nestCount, link, nestPrefix;
- prefix = (prefix) ? prefix : "";
- for (var i = 0; i < ol.childNodes.length; i++) {
- nestCount = (ol.childNodes[i].childNodes) ? ol.childNodes[i].childNodes.length : 0;
- output += "<div>\n";
- if (nestCount > 0) {
- output += "<nobr>" + prefix + "<img id='widget" + blockID + "' src='" + collapsedWidget.src;
- output += "' height=" + widgetHeight + " width=" + widgetWidth + " title='Click to expand/collapse' onClick= " + "'toggle(this," + blockID + ")'> ";
- link = (ol.childNodes[i].item.uri) ? ol.childNodes[i].item.uri : "";
- if (link) output += "<a href='" + link + "' target='" + displayTarget + "'>";
- output += "<span style='position:relative; top:-3px; height:11px'>" + ol.childNodes[i].item.text + "</span>";
- if (link) output += "</a></nobr>"; else output += "</nobr>";
- currState += "0";
- output += "<span class='OLBlock' blocknum='" + blockID + "' id='OLBlock" + blockID++ + "'>";
- nestPrefix = prefix + "<img src='" + emptySpace.src + "' height=" + widgetHeight + " width=" + blankWidth + ">";
- output += drawOutline(ol.childNodes[i], nestPrefix) + "</span>";
- } else {
- output += "<nobr>" + prefix + "<img src='" + emptySpace.src + "' height=" + widgetHeight + " width=" + blankWidth + ">";
- link = (ol.childNodes[i].item.uri) ? ol.childNodes[i].item.uri : "";
- if (link)
- output += " <a href='" + link + "' target='" + displayTarget + "'>";
- else output += " <a>";
- output += "<span style='position:relative; top:-3px; height:11px'>" + ol.childNodes[i].item.text + "</span></a></nobr>";
- }
- output += "</div>\n";
- }
- return output;
-}
-
-function initExpand() {
- for (var i = 0; i < currState.length; i++) {
- if (currState.charAt(i) == 1) {
- document.getElementById("OLBlock" + i).style.display = "block";
- document.getElementById("widget" + i).src = expandedWidget.src;
- } else {
- document.getElementById("OLBlock" + i).style.display = "none";
- document.getElementById("widget" + i).src = collapsedWidget.src;
- }
- }
-}
-
-function initExpMenu() {
- var olHTML = "<span>" + drawOutline(olData) + "</span>";
- document.getElementById("content").innerHTML = olHTML;
- initExpand();
-}
-</script>
-</head>
-
-<body bgcolor=beige onload="initExpMenu()">
-<form>
-<nobr><input type="button" value="open all" bgcolor=beige onClick="expandAll()"></input>
-<input type="button" value="close all" onClick="collapseAll()"></input></nobr>
-<hr>
-</form>
-<div id="content"></div>
-
-<noscript>
-<pre>
-<a href="snd.html#gettingstarted" target="snd1">Getting Started</a>
-<a href="tutorial/1_intro_and_build_snd.html" target="snd1">A Tutorial for Snd</a>
- <small><a href="tutorial/1_intro_and_build_snd.html" target="snd1">Developing And Using Snd</a></small>
- <small><a href="tutorial/2_custom_snd.html" target="snd1">Customizing Snd: The Basics</a></small>
- <small><a href="tutorial/3_editing_and_processing_snd.html" target="snd1">A Brief Tutorial For Snd</a></small>
- <small><a href="tutorial/4_advanced_snd.html" target="snd1">Some Advanced Uses Of Snd</a></small>
- <small><a href="tutorial/5_close_snd.html" target="snd1">Sounding Out</a></small>
- <small><a href="tutorial/6_resources.html" target="snd1">Resources</a></small>
-<a href="snd.html#fileoperations" target="snd1">File Operations</a>
- <a href="snd.html#viewing" target="snd1">The Display</a>
- <a href="snd.html#options" target="snd1">Other Options</a>
-<a href="snd.html#editoperations" target="snd1">Editing</a>
- <a href="snd.html#thecursor" target="snd1">The Active Channel and The Cursor</a>
- <a href="snd.html#marks" target="snd1">Marks</a>
- <a href="snd.html#regions" target="snd1">Regions</a>
- <a href="snd.html#edithistory" target="snd1">The Edit List</a>
- <a href="snd.html#howtoedit" target="snd1">How to ...</a>
- <small><a href="snd.html#saveopen" target="snd1">Save, open, close, print</a></small>
- <small><a href="snd.html#deleteinsert" target="snd1">Delete, insert, mix</a></small>
- <small><a href="snd.html#multichannel" target="snd1">Multichannel operations</a></small>
- <small><a href="snd.html#ampenvs" target="snd1">Amplitude envelopes and scaling</a></small>
- <small><a href="snd.html#menufind" target="snd1">Find</a></small>
- <small><a href="snd.html#changesamples" target="snd1">Change samples</a></small>
- <small><a href="snd.html#undoredo" target="snd1">Undo, redo, revert</a></small>
- <small><a href="snd.html#menuplay" target="snd1">Play</a></small>
- <small><a href="snd.html#mixingfiles" target="snd1">Mix Files</a></small>
- <small><a href="snd.html#kbdmacros" target="snd1">Keyboard macros</a></small>
- <small><a href="snd.html#changeformat" target="snd1">Change file format</a></small>
- <small><a href="snd.html#extendfile" target="snd1">Extend a file</a></small>
- <small><a href="snd.html#recordfile" target="snd1">Record a file</a></small>
- <small><a href="snd.html#editenvelope" target="snd1">Edit or view an envelope</a></small>
- <small><a href="snd.html#editheader" target="snd1">Edit, add, or remove the header</a></small>
- <small><a href="snd.html#centeryaxis" target="snd1">Center a tiny signal with DC</a></small>
- <small><a href="snd.html#savedstate" target="snd1">Save session for later restart</a></small>
- <small><a href="snd.html#misccommands" target="snd1">Miscellaneous commands</a></small>
- <a href="snd.html#keyboardcommands" target="snd1">Keyboard Commands</a>
-<a href="snd.html#controls" target="snd1">The Control Panel</a>
-<a href="extsnd.html#extsndcontents" target="snd1">Customization and Extension</a>
- <small><a href="extsnd.html#lisplistener" target="snd1">Introduction</a></small>
- <a href="extsnd.html#etc" target="snd1">Snd Programming</a>
- <small><a href="extsnd.html#behavior" target="snd1">Customizing Snd's behavior</a></small>
- <small><a href="extsnd.html#sndglobalvars" target="snd1">Global variables</a></small>
- <small><a href="extsnd.html#sndgenericfuncs" target="snd1">Generic functions</a></small>
- <small><a href="extsnd.html#sndhooks" target="snd1">Hooks</a></small>
- <small><a href="extsnd.html#sndobjects" target="snd1">Snd's objects</a></small>
- <small><a href="extsnd.html#samplers" target="snd1">Samplers</a></small>
- <small><a href="extsnd.html#Vcts" target="snd1">Vcts</a></small>
- <small><a href="extsnd.html#sndsounddata" target="snd1">Sound-data</a></small>
- <small><a href="extsnd.html#extsndlib" target="snd1">Sndlib</a></small>
- <small><a href="extsnd.html#sndmarks" target="snd1">Marks</a></small>
- <small><a href="extsnd.html#sndmixes" target="snd1">Mixes</a></small>
- <small><a href="extsnd.html#sndregions" target="snd1">Regions and Selections</a></small>
- <small><a href="extsnd.html#sndsounds" target="snd1">Sounds</a></small>
- <small><a href="extsnd.html#customcontrols" target="snd1">Controls</a></small>
- <small><a href="extsnd.html#editlists" target="snd1">Edit Lists</a></small>
- <small><a href="extsnd.html#sndtransforms" target="snd1">Transforms</a></small>
- <small><a href="extsnd.html#snddialogs" target="snd1">Dialogs and Widgets</a></small>
- <small><a href="extsnd.html#sndmisc" target="snd1">Miscellaneous functions</a></small>
- <small><a href="extsnd.html#sndconstants" target="snd1">Constants</a></small>
- <small><a href="extsnd.html#snderrors" target="snd1">Errors and Debugging</a></small>
- <small><a href="extsnd.html#appearance" target="snd1">Customizing Snd's appearance</a></small>
- <small><a href="extsnd.html#colors" target="snd1">Colors</a></small>
- <small><a href="extsnd.html#fonts" target="snd1">Fonts</a></small>
- <small><a href="extsnd.html#graphics" target="snd1">Graphics</a></small>
- <a href="grfsnd.html#startup" target="snd1">Snd Startup</a>
- <small><a href="grfsnd.html#sndswitches" target="snd1">Snd invocation flags</a></small>
- <small><a href="grfsnd.html#sndinitfile" target="snd1">The initialization file</a></small>
- <small><a href="grfsnd.html#sndconfigurationswitches" target="snd1">Configuration choices</a></small>
- <small><a href="grfsnd.html#sndenvvars" target="snd1">Environment variables</a></small>
- <a href="grfsnd.html#snddynamic" target="snd1">Runtime modules and external programs</a>
- <small><a href="grfsnd.html#emacssnd" target="snd1">Snd as an Emacs subjob</a></small>
- <small><a href="grfsnd.html#dynamic" target="snd1">Dynamically loaded modules</a></small>
- <small><a href="grfsnd.html#sndaswidget" target="snd1">Snd as a Widget</a></small>
- <small><a href="grfsnd.html#sndwithclm" target="snd1">Snd and CLM</a></small>
- <small><a href="grfsnd.html#sndwithcm" target="snd1">Snd and Common Music</a></small>
- <small><a href="grfsnd.html#sndwithpd" target="snd1">Snd and Pd</a></small>
- <small><a href="grfsnd.html#sndwithmotif" target="snd1">Snd and Motif</a></small>
- <small><a href="grfsnd.html#sndwithgtk" target="snd1">Snd and Gtk</a></small>
- <small><a href="grfsnd.html#sndwithnogui" target="snd1">Snd with no GUI and as script engine</a></small>
- <small><a href="grfsnd.html#sndandruby" target="snd1">Snd with Ruby</a></small>
- <small><a href="grfsnd.html#sndandforth" target="snd1">Snd with Forth</a></small>
- <small><a href="grfsnd.html#sndands7" target="snd1">Snd with s7</a></small>
- <small><a href="grfsnd.html#sndandladspa" target="snd1">Snd and LADSPA plugins</a></small>
- <small><a href="grfsnd.html#sndandalsa" target="snd1">Snd and ALSA</a></small>
- <small><a href="grfsnd.html#sndandjack" target="snd1">Snd and Jack</a></small>
- <small><a href="grfsnd.html#sndandgl" target="snd1">Snd and OpenGL</a></small>
- <small><a href="grfsnd.html#sndandgsl" target="snd1">Snd and GSL</a></small>
- <small><a href="grfsnd.html#sndandgmp" target="snd1">Snd and multiprecision arithmetic</a></small>
- <small><a href="index.html" target="snd1">Index</a></small>
-<a href="sndlib.html#introduction" target="snd1">Sndlib</a>
- <small><a href="sndlib.html#headers" target="snd1">Headers</a></small>
- <small><a href="sndlib.html#data" target="snd1">Data</a></small>
- <small><a href="sndlib.html#hardware" target="snd1">Hardware</a></small>
- <small><a href="sndlib.html#music5" target="snd1">Music V</a></small>
- <small><a href="sndlib.html#examples" target="snd1">Examples</a></small>
- <small><a href="sndlib.html#sndinfo" target="snd1">SndInfo</a></small>
- <small><a href="sndlib.html#sndplay" target="snd1">SndPlay</a></small>
- <small><a href="sndlib.html#audinfo" target="snd1">AudInfo</a></small>
- <small><a href="sndlib.html#sndsine" target="snd1">SndSine</a></small>
- <small><a href="sndlib.html#clmosc" target="snd1">clmosc</a></small>
- <small><a href="sndlib.html#otherexamples" target="snd1">Other Examples</a></small>
- <small><a href="sndlib.html#currentstatus" target="snd1">Current Status</a></small>
- <small><a href="sndlib.html#sndlibxen" target="snd1">Extension Languages</a></small>
-<a href="sndclm.html#introduction" target="snd1">CLM</a>
- <small><a href="sndclm.html#generators" target="snd1">Built-in Generators</a></small>
- <small><a href="sndclm.html#othergenerators" target="snd1">Other Generators</a></small>
- <small><a href="sndclm.html#functions" target="snd1">Functions</a></small>
- <small><a href="sndclm.html#definstrument" target="snd1">Instruments</a></small>
-<a href="sndclm.html#clmindex" target="snd1">CLM Index</a>
-<a href="sndscm.html#introduction" target="snd1">Snd Scheme, Ruby, and Forth files</a>
- <small><a href="sndscm.html#analogfilterdoc" target="snd1">analog-filter: standard analog filters</a></small>
- <small><a href="sndscm.html#animalsdoc" target="snd1">animals: a bunch of animals</a></small>
- <small><a href="sndscm.html#autosavedoc" target="snd1">autosave: auto-save (edit backup) support</a></small>
- <small><a href="sndscm.html#bessdoc" target="snd1">bess and bess1: FM demo</a></small>
- <small><a href="sndscm.html#binaryiodoc" target="snd1">binary-io: binary files</a></small>
- <small><a href="sndscm.html#birddoc" target="snd1">bird: North-American birds</a></small>
- <small><a href="sndscm.html#cleandoc" target="snd1">clean: noise reduction</a></small>
- <small><a href="sndscm.html#clminsdoc" target="snd1">clm-ins: more CLM instruments</a></small>
- <small><a href="sndscm.html#dlocsigdoc" target="snd1">dlocsig: moving sound simulation</a></small>
- <small><a href="sndscm.html#drawdoc" target="snd1">draw: graphics additions</a></small>
- <small><a href="sndscm.html#dspdoc" target="snd1">dsp: various DSP-related procedures</a></small>
- <small><a href="sndscm.html#dotsnd" target="snd1">edit123, snd_conffile, snd_frg: .snd examples</a></small>
- <small><a href="sndscm.html#envdoc" target="snd1">env: envelope functions</a></small>
- <small><a href="sndscm.html#enveddoc" target="snd1">enved: envelope editor</a></small>
- <small><a href="sndscm.html#exampdoc" target="snd1">examp: many examples</a></small>
- <small><a href="sndscm.html#extensionsdoc" target="snd1">extensions: extensions of Snd</a></small>
- <small><a href="sndscm.html#fadedoc" target="snd1">fade: frequency-domain cross-fades</a></small>
- <small><a href="sndscm.html#vdoc" target="snd1">fmv: controller for the fm-violin</a></small>
- <small><a href="sndscm.html#framedoc" target="snd1">frame: frame, vct, and sound-data objects</a></small>
- <small><a href="sndscm.html#freeverbdoc" target="snd1">freeverb: a reverb</a></small>
- <small><a href="sndclm.html#othergenerators" target="snd1">generators: more generators</a></small>
- <small><a href="sndscm.html#granidoc" target="snd1">grani: granular synthesis</a></small>
- <small><a href="sndscm.html#heartdoc" target="snd1">heart: Snd and non-sound data</a></small>
- <small><a href="sndscm.html#hooksdoc" target="snd1">hooks: functions related to hooks</a></small>
- <small><a href="sndscm.html#indexdoc" target="snd1">index: snd-help extension</a></small>
- <small><a href="sndscm.html#dotemacs" target="snd1">inf-snd.el, DotEmacs: Emacs subjob support</a></small>
- <small><a href="sndscm.html#jcrevdoc" target="snd1">jcrev: John Chowning's reverb</a></small>
- <small><a href="sndscm.html#ladspadoc" target="snd1">ladspa: Kjetil S. Matheussen's LADSPA previewer.</a></small>
- <small><a href="sndscm.html#maracadoc" target="snd1">maraca: Perry Cook's maraca physical model</a></small>
- <small><a href="sndscm.html#marksdoc" target="snd1">marks: functions related to marks</a></small>
- <small><a href="sndscm.html#maxfdoc" target="snd1">maxf: Max Mathews resonator</a></small>
- <small><a href="sndscm.html#menusdoc" target="snd1">menu: additional menus</a></small>
- <small><a href="sndscm.html#mixdoc" target="snd1">mix: functions related to mixes</a></small>
- <small><a href="sndscm.html#mixerdoc" target="snd1">mixer: functions related to mixers and frames</a></small>
- <small><a href="sndscm.html#moogdoc" target="snd1">moog: Moog filter</a></small>
- <small><a href="sndscm.html#musglyphs" target="snd1">musglyphs: Music notation symbols (from CMN)</a></small>
- <small><a href="sndscm.html#nbdoc" target="snd1">nb: Popup File info etc</a></small>
- <small><a href="sndscm.html#noisedoc" target="snd1">noise: CLM's noise.ins</a></small>
- <small><a href="sndscm.html#numericsdoc" target="snd1">numerics: fun with special functions etc</a></small>
- <small><a href="sndscm.html#oscopedoc" target="snd1">oscope: oscilloscope</a></small>
- <small><a href="sndscm.html#peakphasesdoc" target="snd1">peak-phases: phases for the unpulse-train</a></small>
- <small><a href="sndscm.html#pianodoc" target="snd1">piano: piano physical model</a></small>
- <small><a href="sndscm.html#playdoc" target="snd1">play: play-related functions</a></small>
- <small><a href="sndscm.html#polydoc" target="snd1">poly: polynomial-related functions</a></small>
- <small><a href="sndscm.html#prc95doc" target="snd1">prc95: Perry Cook's physical model examples</a></small>
- <small><a href="sndscm.html#pvocdoc" target="snd1">pvoc: phase-vocoder</a></small>
- <small><a href="sndscm.html#rgbdoc" target="snd1">rgb: colors</a></small>
- <small><a href="sndscm.html#rtexdoc" target="snd1">rt-examples: hard real-time support</a></small>
- <small><a href="sndscm.html#rtiodoc" target="snd1">rtio: real-time stuff</a></small>
- <small><a href="sndscm.html#rubberdoc" target="snd1">rubber: rubber-sound</a></small>
- <small><a href="sndscm.html#selectiondoc" target="snd1">selection: selection functions</a></small>
- <small><a href="sndscm.html#singerdoc" target="snd1">singer: Perry Cook's vocal-tract physical model</a></small>
- <small><a href="sndscm.html#sndwarpdoc" target="snd1">sndwarp: Bret Battey's sndwarp instrument</a></small>
- <small><a href="sndscm.html#sndolddoc" target="snd1">snd9..11: backwards compatibility</a></small>
- <small><a href="sndscm.html#snddiffdoc" target="snd1">snddiff: sound difference detection</a></small>
- <small><a href="sndscm.html#sndgldoc" target="snd1">snd-gl: OpenGL examples (gl.c)</a></small>
- <small><a href="sndscm.html#sndmotifdoc" target="snd1">snd-motif, snd-gtk, snd-xm: Motif/Gtk module (xm.c, xg.c)</a></small>
- <small><a href="sndscm.html#sndtestdoc" target="snd1">snd-test and event: Snd regression tests</a></small>
- <small><a href="sndscm.html#spectrdoc" target="snd1">spectr: instrument steady-state spectra</a></small>
- <small><a href="sndscm.html#straddoc" target="snd1">strad: violin physical model</a></small>
- <small><a href="sndscm.html#vdoc" target="snd1">v: fm-violin</a></small>
- <small><a href="sndscm.html#wsdoc" target="snd1">ws: with-sound</a></small>
- <small><a href="sndscm.html#zipdoc" target="snd1">zip: the zipper (a cross-fader)</a></small>
-<a href="libxm.html#xm" target="snd1">Libxm</a>
-</pre>
-</noscript>
-</body></html>
diff --git a/snd-dac.c b/snd-dac.c
index 7a1153f..2d188be 100644
--- a/snd-dac.c
+++ b/snd-dac.c
@@ -7,18 +7,6 @@
* channels can come and go as a play is in progress
*/
-/* TODO: how to use (play func) on a multichannel file?
- * there is a slot for each chan
- * add_xen_to_play_list needs a channel number [play has chan and out-chan]
- * but would it be better to have multiple functions (how to specify chans?) or one function returning a frame?
- * in the latter case, we'd need a :channels arg to play [this exists, currently only used for zero case?]
- * but how to parcel out the frame? (does the 0-case actually work if chans>1?)
- *
- * use the :channel arg, :wait, and add a separate func for each chan
- */
-
-
-
/* -------------------------------- per-channel control-panel state -------------------------------- */
typedef struct {
@@ -43,7 +31,7 @@ typedef struct dac_info {
int slot;
mus_float_t *a; /* filter coeffs */
int a_size; /* user can change filter order while playing (sigh...) */
- snd_fd *chn_fd; /* sampler, null if DAC_XEN */
+ snd_fd *chn_fd; /* sampler, null if DAC_Xen */
spd_info *spd;
mus_any *flt;
int region, mix_id; /* to reset region-browser play button upon completion */
@@ -52,11 +40,11 @@ typedef struct dac_info {
snd_info *sp; /* needed to see button callback changes etc */
chan_info *cp;
bool never_sped;
- int expand_ring_frames;
+ int expand_ring_framples;
mus_long_t end;
- XEN stop_procedure;
+ Xen stop_procedure;
int stop_procedure_gc_loc;
- XEN func;
+ Xen func;
int func_gc_loc, direction;
mus_float_t (*dac_sample)(struct dac_info *dp);
} dac_info;
@@ -79,14 +67,14 @@ static mus_float_t dac_no_sample(struct dac_info *dp)
static mus_float_t dac_xen_sample(struct dac_info *dp)
{
- XEN result;
- result = XEN_CALL_0_NO_CATCH(dp->func);
- if (XEN_FALSE_P(result))
+ Xen result;
+ result = Xen_unprotected_call_with_no_args(dp->func);
+ if (Xen_is_false(result))
{
dp->end = 0;
return(0.0);
}
- return(XEN_TO_C_DOUBLE(result));
+ return(Xen_real_to_C_double(result));
}
@@ -145,7 +133,7 @@ static int max_expand_control_len(snd_info *sp)
{
if (sp->expand_control_length > .5)
return(0);
- return((int)(SND_SRATE(sp) * .5));
+ return((int)(snd_srate(sp) * .5));
}
@@ -242,26 +230,26 @@ static void nrev(rev_info *r, mus_float_t *rins, mus_float_t *routs, int chans)
mus_float_t rout, rin = 0.0;
int i;
for (i = 0; i < chans; i++) rin += rins[i];
- rout = mus_all_pass(r->allpasses[3],
+ rout = mus_all_pass_unmodulated_noz(r->allpasses[3],
mus_one_pole(r->onep,
- mus_all_pass(r->allpasses[2],
- mus_all_pass(r->allpasses[1],
- mus_all_pass(r->allpasses[0],
- mus_comb(r->combs[0], rin, 0.0) +
- mus_comb(r->combs[1], rin, 0.0) +
- mus_comb(r->combs[2], rin, 0.0) +
- mus_comb(r->combs[3], rin, 0.0) +
- mus_comb(r->combs[4], rin, 0.0) +
- mus_comb(r->combs[5], rin, 0.0), 0.0), 0.0), 0.0)), 0.0);
+ mus_all_pass_unmodulated_noz(r->allpasses[2],
+ mus_all_pass_unmodulated_noz(r->allpasses[1],
+ mus_all_pass_unmodulated_noz(r->allpasses[0],
+ mus_comb_unmodulated_noz(r->combs[0], rin) +
+ mus_comb_unmodulated_noz(r->combs[1], rin) +
+ mus_comb_unmodulated_noz(r->combs[2], rin) +
+ mus_comb_unmodulated_noz(r->combs[3], rin) +
+ mus_comb_unmodulated_noz(r->combs[4], rin) +
+ mus_comb_unmodulated_noz(r->combs[5], rin))))));
for (i = 0; i < chans; i++)
- routs[i] = mus_all_pass(r->allpasses[i + 4], rout, 0.0);
+ routs[i] = mus_all_pass_unmodulated_noz(r->allpasses[i + 4], rout);
}
static mus_float_t *r_ins, *r_outs;
static int reverb_chans = 0;
-static void reverb(rev_info *r, mus_float_t **rins, mus_sample_t **outs, int ind)
+static void reverb(rev_info *r, mus_float_t **rins, mus_float_t **outs, int ind)
{
int i, chans;
chans = reverb_chans;
@@ -272,7 +260,7 @@ static void reverb(rev_info *r, mus_float_t **rins, mus_sample_t **outs, int ind
}
nrev(r, r_ins, r_outs, chans);
for (i = 0; i < chans; i++)
- outs[i][ind] += MUS_FLOAT_TO_SAMPLE(r_outs[i]);
+ outs[i][ind] += (r_outs[i]);
}
@@ -320,7 +308,7 @@ static rev_info *make_nrev(snd_info *sp, int chans)
if (sp == NULL) return(NULL);
- srscale = sp->reverb_control_length * SND_SRATE(sp) / 25641.0;
+ srscale = sp->reverb_control_length * snd_srate(sp) / 25641.0;
for (i = 0; i < BASE_DLY_LEN; i++)
dly_len[i] = get_prime((int)(srscale * base_dly_len[i]));
r = (rev_info *)calloc(1, sizeof(rev_info));
@@ -405,7 +393,7 @@ mus_float_t *sample_linear_env(env *e, int order)
mus_any *ge;
int ordp;
mus_float_t *data = NULL;
- mus_float_t last_x, step, x;
+ mus_float_t last_x, step;
last_x = e->data[(e->pts - 1) * 2];
step = 2 * last_x / ((mus_float_t)order - 1);
@@ -420,7 +408,8 @@ mus_float_t *sample_linear_env(env *e, int order)
if (!got_local_error)
{
int i, j;
- data = (mus_float_t *)calloc(order, sizeof(mus_float_t));
+ mus_float_t x;
+ data = (mus_float_t *)malloc(order * sizeof(mus_float_t));
for (i = 0, x = 0.0; i < order / 2; i++, x += step)
data[i] = mus_env_interp(x, ge);
for (j = order / 2 - 1, i = order / 2; (i < order) && (j >= 0); i++, j--)
@@ -435,20 +424,20 @@ mus_float_t *sample_linear_env(env *e, int order)
static void free_dac_info(dac_info *dp, play_stop_t reason)
{
bool looping;
- looping = (dp->stop_procedure == XEN_TRUE);
+ looping = (dp->stop_procedure == Xen_true);
if (dp->stop_procedure_gc_loc != NOT_A_GC_LOC)
{
- XEN_CALL_1(dp->stop_procedure,
- C_TO_XEN_INT((int)reason),
+ Xen_call_with_1_arg(dp->stop_procedure,
+ C_int_to_Xen_integer((int)reason),
"play stop procedure");
snd_unprotect_at(dp->stop_procedure_gc_loc);
- dp->stop_procedure = XEN_FALSE;
+ dp->stop_procedure = Xen_false;
dp->stop_procedure_gc_loc = NOT_A_GC_LOC;
}
if (dp->func_gc_loc != NOT_A_GC_LOC)
{
snd_unprotect_at(dp->func_gc_loc);
- dp->func = XEN_FALSE;
+ dp->func = Xen_false;
dp->func_gc_loc = NOT_A_GC_LOC;
}
if (dp->a) {free(dp->a); dp->a = NULL; dp->a_size = 0;}
@@ -515,7 +504,7 @@ static void dac_set_field(snd_info *sp, mus_float_t newval, dac_field_t field)
case DAC_EXPAND_LENGTH: /* segment length */
if (dp->spd)
{
- val = (int)(SND_SRATE(sp) * newval);
+ val = (int)(snd_srate(sp) * newval);
mus_set_length(dp->spd->gen, val);
mus_set_ramp(dp->spd->gen, (int)(val * sp->expand_control_ramp));
}
@@ -524,7 +513,7 @@ static void dac_set_field(snd_info *sp, mus_float_t newval, dac_field_t field)
case DAC_EXPAND_RAMP:
if (dp->spd)
{
- val = (int)(newval * sp->expand_control_length * SND_SRATE(sp));
+ val = (int)(newval * sp->expand_control_length * snd_srate(sp));
mus_set_ramp(dp->spd->gen, val);
}
break;
@@ -532,7 +521,7 @@ static void dac_set_field(snd_info *sp, mus_float_t newval, dac_field_t field)
case DAC_EXPAND_HOP: /* output hop */
if (dp->spd)
{
- val = (int)(SND_SRATE(sp) * newval);
+ val = (int)(snd_srate(sp) * newval);
mus_set_hop(dp->spd->gen, val);
mus_set_increment(dp->spd->gen, sp->expand_control);
}
@@ -572,14 +561,14 @@ void dac_set_reverb_lowpass(snd_info *sp, mus_float_t newval) {dac_set_field(sp,
/* -------------------------------- stop playing (remove from play-list) -------------------------------- */
typedef struct {
- int srate; /* output srate */
- int channels; /* total output channels currently active */
- int frames; /* samples per channel per output block */
- int devices; /* output devices active */
- int *chans_per_device; /* channels sent to each active device */
- int out_format; /* output data format */
- int slice; /* background process state (i.e. starting, running, quitting) */
- mus_long_t reverb_ring_frames; /* how long the reverb rings after the end (if reverb, of course) */
+ int srate; /* output srate */
+ int channels; /* total output channels currently active */
+ int framples; /* samples per channel per output block */
+ int devices; /* output devices active */
+ int *chans_per_device; /* channels sent to each active device */
+ mus_sample_t out_samp_type; /* output sample type */
+ int slice; /* background process state (i.e. starting, running, quitting) */
+ mus_long_t reverb_ring_framples; /* how long the reverb rings after the end (if reverb, of course) */
} dac_state;
@@ -596,16 +585,15 @@ static void free_dac_state(void)
}
static bool dac_running = false;
-static XEN play_hook;
-static XEN start_playing_hook;
-static XEN stop_playing_hook;
-static XEN stop_playing_selection_hook;
-static XEN start_playing_selection_hook;
+static Xen play_hook;
+static Xen start_playing_hook;
+static Xen stop_playing_hook;
+static Xen stop_playing_selection_hook;
+static Xen start_playing_selection_hook;
#define MAX_DEVICES 8
static int dev_fd[MAX_DEVICES] = {-1, -1, -1, -1, -1, -1, -1, -1};
-static void cleanup_dac_hook(void);
void cleanup_dac(void)
{
@@ -619,19 +607,31 @@ void cleanup_dac(void)
dev_fd[i] = -1;
}
for (i = 0; i < MAX_DEVICES; i++) dev_fd[i] = -1;
- cleanup_dac_hook();
dac_running = false;
}
+static bool something_is_playing(void)
+{
+ int i;
+ if (play_list)
+ for (i = 0; i < dac_max_sounds; i++)
+ if (play_list[i]) return(true);
+ return(false);
+}
+
+
static void reflect_play_stop(snd_info *sp)
{
#if (!USE_NO_GUI)
set_control_panel_play_button(sp);
#endif
set_open_file_play_button(false);
+#if (!USE_NO_GUI)
view_files_unplay();
- ss->tracking = false;
+#endif
+ if (!something_is_playing())
+ ss->tracking = false;
}
@@ -643,22 +643,53 @@ static void stop_playing_with_toggle(dac_info *dp, dac_toggle_t toggle, with_hoo
{
snd_info *sp = NULL;
bool sp_stopping = false;
+
if ((dp == NULL) || (play_list == NULL)) return;
sp = dp->sp;
if ((sp) && (sp->inuse != SOUND_IDLE))
{
if (sp->playing > 0) sp->playing--;
if (sp->playing == 0) sp_stopping = true;
- if (sp_stopping)
+
+ if ((sp_stopping) &&
+ (ss->tracking) &&
+ (sp->inuse == SOUND_NORMAL) &&
+ (sp->index >= 0))
{
- if ((sp->inuse == SOUND_NORMAL) && (ss->tracking) && (sp->index >= 0))
+ int i;
+ for (i = 0; i < sp->nchans; i++)
{
- int i;
- for (i = 0; i < sp->nchans; i++)
- cursor_moveto_with_window(sp->chans[i],
- sp->chans[i]->original_cursor,
- sp->chans[i]->original_left_sample,
- sp->chans[i]->original_window_size);
+ chan_info *cp;
+ cp = sp->chans[i];
+ if ((cp == dp->cp) ||
+ (sp->sync != 0)) /* don't move the cursor in a channel that isn't playing */
+ {
+ if (with_tracking_cursor(ss) == TRACK_AND_STAY)
+ {
+ if (dp->cur_srate > 0.0)
+ {
+ mus_long_t samp;
+ samp = current_location(dp->chn_fd) + ((snd_dacp) ? snd_dacp->framples : 0);
+ if (dp->selection)
+ {
+ if (samp > selection_end(cp))
+ samp = selection_end(cp);
+ }
+ else
+ {
+ if (samp > current_samples(cp))
+ samp = current_samples(cp);
+ }
+ cursor_sample(cp) = samp - 1;
+ }
+ cp->original_left_sample = cursor_sample(cp) - (cp->original_window_size / 2);
+ if (cp->original_left_sample < 0)
+ cp->original_left_sample = 0;
+ }
+ else cursor_sample(cp) = cp->original_cursor;
+ cursor_moveto_with_window(cp, cursor_sample(cp), cp->original_left_sample, cp->original_window_size);
+ update_graph(cp);
+ }
}
}
/* if ctrl-click play, c-t, c-q -> this flag is still set from aborted previous play, so clear at c-t (or c-g) */
@@ -697,22 +728,22 @@ static void stop_playing_with_toggle(dac_info *dp, dac_toggle_t toggle, with_hoo
if (dp->selection)
{
reflect_play_selection_stop();
- if (XEN_HOOKED(stop_playing_selection_hook))
+ if (Xen_hook_has_list(stop_playing_selection_hook))
run_hook(stop_playing_selection_hook,
- XEN_EMPTY_LIST,
+ Xen_empty_list,
S_stop_playing_selection_hook);
}
else
{
- if ((sp_stopping) && (XEN_HOOKED(stop_playing_hook)))
+ if ((sp_stopping) && (Xen_hook_has_list(stop_playing_hook)))
run_hook(stop_playing_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)),
+ Xen_list_1(C_int_to_Xen_sound(sp->index)),
S_stop_playing_hook);
}
}
}
- if ((sp) && (IS_PLAYER_SOUND(sp)))
+ if ((sp) && (is_player_sound(sp)))
{
int k;
bool free_ok = true;
@@ -737,7 +768,10 @@ static void stop_playing_with_toggle(dac_info *dp, dac_toggle_t toggle, with_hoo
if ((sp) && (sp_stopping) && (sp->delete_me))
{
- if (sp->delete_me != (struct dialog_play_info *)1) clear_deleted_snd_info(sp->delete_me); /* for various file dialog play buttons */
+#if USE_MOTIF || USE_GTK
+ if (sp->delete_me != (void *)1)
+ clear_deleted_snd_info(sp->delete_me); /* for various file dialog play buttons */
+#endif
completely_free_snd_info(sp); /* dummy snd_info struct for (play "filename") in snd-xen.c */
}
}
@@ -879,16 +913,6 @@ void stop_playing_region(int n, play_stop_t reason)
}
-static bool playing(void)
-{
- int i;
- if (play_list)
- for (i = 0; i < dac_max_sounds; i++)
- if (play_list[i]) return(true);
- return(false);
-}
-
-
/* -------------------------------- play (add to play-list) -------------------------------- */
static int find_slot_to_play(void)
@@ -914,12 +938,12 @@ static int find_slot_to_play(void)
}
-static dac_info *make_dac_info(int slot, chan_info *cp, snd_info *sp, snd_fd *fd, mus_long_t end, int out_chan, dac_source_t type, XEN func)
+static dac_info *make_dac_info(int slot, chan_info *cp, snd_info *sp, snd_fd *fd, mus_long_t end, int out_chan, dac_source_t type, Xen func)
{
dac_info *dp;
dp = (dac_info *)calloc(1, sizeof(dac_info)); /* only place dac_info is created */
- dp->stop_procedure = XEN_FALSE;
+ dp->stop_procedure = Xen_false;
dp->stop_procedure_gc_loc = NOT_A_GC_LOC;
dp->region = INVALID_REGION;
dp->mix_id = INVALID_MIX_ID;
@@ -938,7 +962,7 @@ static dac_info *make_dac_info(int slot, chan_info *cp, snd_info *sp, snd_fd *fd
else
{
dp->dac_sample = dac_read_sample;
- dp->func = XEN_FALSE;
+ dp->func = Xen_false;
dp->func_gc_loc = NOT_A_GC_LOC;
}
}
@@ -953,9 +977,9 @@ static dac_info *make_dac_info(int slot, chan_info *cp, snd_info *sp, snd_fd *fd
/* next block may get input */
if (sp)
{
- dp->expanding = sp->expand_control_p;
- dp->filtering = ((sp->filter_control_p) && (sp->filter_control_order > 0));
- dp->reverbing = sp->reverb_control_p;
+ dp->expanding = sp->expand_control_on;
+ dp->filtering = ((sp->filter_control_on) && (sp->filter_control_order > 0));
+ dp->reverbing = sp->reverb_control_on;
dp->contrast_amp = sp->contrast_control_amp;
if ((!(snd_feq(sp->speed_control, 1.0))) ||
@@ -968,7 +992,7 @@ static dac_info *make_dac_info(int slot, chan_info *cp, snd_info *sp, snd_fd *fd
if (dp->expanding)
{
dp->spd = (spd_info *)make_expand(sp, sp->expand_control, dp);
- dp->expand_ring_frames = (int)(SND_SRATE(sp) * sp->expand_control * sp->expand_control_length * 2);
+ dp->expand_ring_framples = (int)(snd_srate(sp) * sp->expand_control * sp->expand_control_length * 2);
}
if (dp->filtering)
@@ -1015,7 +1039,7 @@ static void start_dac(int srate, int channels, play_process_t background, mus_fl
/* look for channel folding cases etc */
/* channels = how many output audio chans we have; dac_combines_channels sets whether to wrap or muffle chans outside this limit */
- if (with_tracking_cursor(ss))
+ if (with_tracking_cursor(ss) != DONT_TRACK)
ss->tracking = true;
for (i = 0; i <= max_active_slot; i++)
@@ -1049,14 +1073,14 @@ static void start_dac(int srate, int channels, play_process_t background, mus_fl
snd_dacp = (dac_state *)calloc(1, sizeof(dac_state));
snd_dacp->slice = 0;
snd_dacp->srate = srate;
- snd_dacp->out_format = MUS_AUDIO_COMPATIBLE_FORMAT;
+ snd_dacp->out_samp_type = MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE;
if (snd_dacp->srate <= 0) snd_dacp->srate = 44100;
snd_dacp->channels = channels;
if (dac_size(ss) > 0)
- snd_dacp->frames = dac_size(ss);
- else snd_dacp->frames = 256;
+ snd_dacp->framples = dac_size(ss);
+ else snd_dacp->framples = 256;
snd_dacp->devices = 1; /* just a first guess */
- snd_dacp->reverb_ring_frames = (mus_long_t)(srate * decay);
+ snd_dacp->reverb_ring_framples = (mus_long_t)(srate * decay);
if (background == IN_BACKGROUND)
dac_work_proc = BACKGROUND_ADD(dac_in_background, NULL);
else
@@ -1069,7 +1093,7 @@ static void start_dac(int srate, int channels, play_process_t background, mus_fl
}
-/* pos = to_c_edit_position(cp, edpos, caller, arg_pos); */
+/* pos = to_c_edit_position(cp, edpos, caller, arg_pos); */
static dac_info *add_channel_to_play_list(chan_info *cp, snd_info *sp, mus_long_t start, mus_long_t end, int pos, int out_chan)
{
@@ -1115,9 +1139,10 @@ static dac_info *add_channel_to_play_list(chan_info *cp, snd_info *sp, mus_long_
if (sp)
{
sp->playing++;
- if ((ss->tracking) && (!(IS_PLAYER_SOUND(sp))))
+ if (((with_tracking_cursor(ss) != DONT_TRACK) || (ss->tracking)) &&
+ (!(is_player_sound(sp))))
{
- cp->original_cursor = CURSOR(cp);
+ cp->original_cursor = cursor_sample(cp);
if (cp->axis)
{
cp->original_left_sample = cp->axis->losamp;
@@ -1125,9 +1150,13 @@ static dac_info *add_channel_to_play_list(chan_info *cp, snd_info *sp, mus_long_
}
cp->cursor_on = true;
cursor_moveto_without_verbosity(cp, start);
+#if USE_MOTIF
+ if (cp->chan_widgets)
+ update_graph(cp);
+#endif
}
}
- return(make_dac_info(slot, cp, sp, sf, end, out_chan, DAC_CHANNEL, XEN_FALSE));
+ return(make_dac_info(slot, cp, sp, sf, end, out_chan, DAC_CHANNEL, Xen_false));
}
return(NULL);
}
@@ -1145,7 +1174,7 @@ static dac_info *add_region_channel_to_play_list(int region, int chan, mus_long_
if (fd)
{
dac_info *dp;
- dp = make_dac_info(slot, fd->cp, NULL, fd, end, out_chan, DAC_REGION, XEN_FALSE);
+ dp = make_dac_info(slot, fd->cp, NULL, fd, end, out_chan, DAC_REGION, Xen_false);
if (dp) dp->region = region;
return(dp);
}
@@ -1153,7 +1182,7 @@ static dac_info *add_region_channel_to_play_list(int region, int chan, mus_long_
}
-void play_region_1(int region, play_process_t background, XEN stop_proc)
+void play_region_1(int region, play_process_t background, Xen stop_proc)
{
/* just plays region (not current selection) -- no control panel etc */
int chans, i;
@@ -1175,7 +1204,7 @@ void play_region_1(int region, play_process_t background, XEN stop_proc)
if (rtn_dp)
{
rtn_dp->stop_procedure = stop_proc;
- if (XEN_PROCEDURE_P(stop_proc))
+ if (Xen_is_procedure(stop_proc))
rtn_dp->stop_procedure_gc_loc = snd_protect(stop_proc);
start_dac(region_srate(region), chans, background, DEFAULT_REVERB_CONTROL_DECAY);
}
@@ -1184,7 +1213,7 @@ void play_region_1(int region, play_process_t background, XEN stop_proc)
void play_region(int region, play_process_t background)
{
- play_region_1(region, background, XEN_FALSE);
+ play_region_1(region, background, Xen_false);
}
@@ -1199,12 +1228,12 @@ bool add_mix_to_play_list(mix_state *ms, chan_info *cp, mus_long_t beg_within_mi
if (fd)
{
dac_info *dp;
- dp = make_dac_info(slot, cp, NULL, fd, NO_END_SPECIFIED, 0, DAC_MIX, XEN_FALSE);
+ dp = make_dac_info(slot, cp, NULL, fd, NO_END_SPECIFIED, 0, DAC_MIX, Xen_false);
if (dp)
{
dp->mix_id = ms->index; /* any valid mix id will do */
if (start_playing)
- start_dac(SND_SRATE(cp->sound), 1, NOT_IN_BACKGROUND, DEFAULT_REVERB_CONTROL_DECAY);
+ start_dac(snd_srate(cp->sound), 1, NOT_IN_BACKGROUND, DEFAULT_REVERB_CONTROL_DECAY);
return(true);
}
}
@@ -1231,7 +1260,7 @@ static bool add_zeros_to_play_list(int srate, int chans)
if (slot != -1)
{
dac_info *dp;
- dp = make_dac_info(slot, NULL, NULL, NULL, NO_END_SPECIFIED, 0, DAC_NOTHING, XEN_FALSE);
+ dp = make_dac_info(slot, NULL, NULL, NULL, NO_END_SPECIFIED, 0, DAC_NOTHING, Xen_false);
if (dp)
{
start_dac(srate, chans, IN_BACKGROUND, DEFAULT_REVERB_CONTROL_DECAY);
@@ -1242,7 +1271,7 @@ static bool add_zeros_to_play_list(int srate, int chans)
}
-static bool add_xen_to_play_list(XEN func)
+static bool add_xen_to_play_list(Xen func)
{
int slot;
slot = find_slot_to_play();
@@ -1252,7 +1281,11 @@ static bool add_xen_to_play_list(XEN func)
dp = make_dac_info(slot, NULL, NULL, NULL, NO_END_SPECIFIED, 0, DAC_XEN, func);
if (dp)
{
+#if USE_NO_GUI
+ start_dac((int)mus_srate(), 1, NOT_IN_BACKGROUND, DEFAULT_REVERB_CONTROL_DECAY);
+#else
start_dac((int)mus_srate(), 1, IN_BACKGROUND, DEFAULT_REVERB_CONTROL_DECAY);
+#endif
/* ^ output channels */
return(true);
}
@@ -1263,9 +1296,9 @@ static bool add_xen_to_play_list(XEN func)
static bool call_start_playing_hook(snd_info *sp)
{
- if ((XEN_HOOKED(start_playing_hook)) &&
- (XEN_TRUE_P(run_or_hook(start_playing_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)), /* this can be 123456 (TEMP_SOUND_INDEX in snd-file.c) -- View:Files dialog play button */
+ if ((Xen_hook_has_list(start_playing_hook)) &&
+ (Xen_is_true(run_or_hook(start_playing_hook,
+ Xen_list_1(C_int_to_Xen_sound(sp->index)), /* this can be 123456 (TEMP_SOUND_INDEX in snd-file.c) -- View:Files dialog play button */
S_start_playing_hook))))
{
reflect_play_stop(sp); /* turns off buttons */
@@ -1279,15 +1312,15 @@ static bool call_start_playing_hook(snd_info *sp)
static bool call_start_playing_selection_hook(void)
{
- return((XEN_HOOKED(start_playing_selection_hook)) &&
- (XEN_TRUE_P(run_or_hook(start_playing_selection_hook,
- XEN_EMPTY_LIST,
+ return((Xen_hook_has_list(start_playing_selection_hook)) &&
+ (Xen_is_true(run_or_hook(start_playing_selection_hook,
+ Xen_empty_list,
S_start_playing_selection_hook))));
}
static dac_info *play_channel_1(chan_info *cp, mus_long_t start, mus_long_t end, play_process_t background,
- int pos, XEN stop_proc, int out_chan)
+ int pos, Xen stop_proc, int out_chan)
{
/* just plays one channel (ignores possible sync), includes start-hook */
snd_info *sp = NULL;
@@ -1301,10 +1334,10 @@ static dac_info *play_channel_1(chan_info *cp, mus_long_t start, mus_long_t end,
if (dp)
{
dp->stop_procedure = stop_proc;
- if (XEN_PROCEDURE_P(stop_proc))
+ if (Xen_is_procedure(stop_proc))
dp->stop_procedure_gc_loc = snd_protect(stop_proc);
set_play_button(sp, true);
- start_dac(SND_SRATE(sp), 1, background, sp->reverb_control_decay);
+ start_dac(snd_srate(sp), 1, background, sp->reverb_control_decay);
}
return(dp);
}
@@ -1312,15 +1345,15 @@ static dac_info *play_channel_1(chan_info *cp, mus_long_t start, mus_long_t end,
void play_channel(chan_info *cp, mus_long_t start, mus_long_t end)
{
- play_channel_1(cp, start, end, IN_BACKGROUND, AT_CURRENT_EDIT_POSITION, XEN_FALSE, cp->chan);
+ play_channel_1(cp, start, end, IN_BACKGROUND, AT_CURRENT_EDIT_POSITION, Xen_false, cp->chan);
}
static dac_info *play_sound_1(snd_info *sp, mus_long_t start, mus_long_t end, play_process_t background,
- XEN edpos, XEN stop_proc, const char *caller, int arg_pos)
+ Xen edpos, Xen stop_proc, const char *caller, int arg_pos)
{
/* just plays one sound (ignores possible sync) */
- int i, pos;
+ int i;
dac_info *dp = NULL, *rtn_dp = NULL;
if ((background == NOT_IN_BACKGROUND) &&
@@ -1330,6 +1363,7 @@ static dac_info *play_sound_1(snd_info *sp, mus_long_t start, mus_long_t end, pl
if (call_start_playing_hook(sp)) return(NULL);
for (i = 0; i < sp->nchans; i++)
{
+ int pos;
pos = to_c_edit_position(sp->chans[i], edpos, caller, arg_pos);
dp = add_channel_to_play_list(sp->chans[i], sp, start, end, pos, i); /* i = out chan */
if ((dp) && (rtn_dp == NULL)) rtn_dp = dp;
@@ -1337,10 +1371,10 @@ static dac_info *play_sound_1(snd_info *sp, mus_long_t start, mus_long_t end, pl
if (rtn_dp)
{
rtn_dp->stop_procedure = stop_proc;
- if (XEN_PROCEDURE_P(stop_proc))
+ if (Xen_is_procedure(stop_proc))
rtn_dp->stop_procedure_gc_loc = snd_protect(stop_proc);
set_play_button(sp, true);
- start_dac(SND_SRATE(sp), sp->nchans, background, sp->reverb_control_decay);
+ start_dac(snd_srate(sp), sp->nchans, background, sp->reverb_control_decay);
}
return(rtn_dp);
}
@@ -1348,15 +1382,15 @@ static dac_info *play_sound_1(snd_info *sp, mus_long_t start, mus_long_t end, pl
void play_sound(snd_info *sp, mus_long_t start, mus_long_t end)
{
- play_sound_1(sp, start, end, IN_BACKGROUND, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), XEN_FALSE, NULL, 0);
+ play_sound_1(sp, start, end, IN_BACKGROUND, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), Xen_false, NULL, 0);
}
static dac_info *play_channels_1(chan_info **cps, int chans, mus_long_t *starts, mus_long_t *ur_ends, play_process_t background,
- XEN edpos, bool selection, XEN stop_proc, const char *caller, int arg_pos)
+ Xen edpos, bool selection, Xen stop_proc, const char *caller, int arg_pos)
{
/* ends can be NULL */
- int i, pos;
+ int i;
snd_info *sp = NULL;
dac_info *dp = NULL, *rtn_dp = NULL;
mus_long_t *ends;
@@ -1387,6 +1421,7 @@ static dac_info *play_channels_1(chan_info **cps, int chans, mus_long_t *starts,
sp = cps[0]->sound;
for (i = 0; i < chans; i++)
{
+ int pos;
pos = to_c_edit_position(cps[i], edpos, caller, arg_pos);
dp = add_channel_to_play_list(cps[i], sp, starts[i], ends[i], pos, i);
if (dp)
@@ -1399,19 +1434,19 @@ static dac_info *play_channels_1(chan_info **cps, int chans, mus_long_t *starts,
if ((sp) && (rtn_dp))
{
rtn_dp->stop_procedure = stop_proc;
- if (XEN_PROCEDURE_P(stop_proc))
+ if (Xen_is_procedure(stop_proc))
rtn_dp->stop_procedure_gc_loc = snd_protect(stop_proc);
set_play_button(sp, true);
- start_dac(SND_SRATE(sp), chans, background, sp->reverb_control_decay);
+ start_dac(snd_srate(sp), chans, background, sp->reverb_control_decay);
}
return(rtn_dp);
}
void play_channels(chan_info **cps, int chans, mus_long_t *starts, mus_long_t *ur_ends,
- play_process_t background, XEN edpos, bool selection, const char *caller, int arg_pos)
+ play_process_t background, Xen edpos, bool selection, const char *caller, int arg_pos)
{
- play_channels_1(cps, chans, starts, ur_ends, background, edpos, selection, XEN_FALSE, caller, arg_pos);
+ play_channels_1(cps, chans, starts, ur_ends, background, edpos, selection, Xen_false, caller, arg_pos);
}
@@ -1424,7 +1459,7 @@ void play_channel_with_sync(chan_info *cp, mus_long_t start, mus_long_t end)
sp = cp->sound;
if ((sp->sync == 0) ||
- (IS_PLAYER_SOUND(sp)))
+ (is_player_sound(sp)))
{
play_channel(cp, start, end);
return;
@@ -1438,14 +1473,14 @@ void play_channel_with_sync(chan_info *cp, mus_long_t start, mus_long_t end)
}
for (i = 0; i < si->chans; i++) si->begs[i] = start;
- play_channels_1(si->cps, si->chans, si->begs, ends, IN_BACKGROUND, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), false, XEN_FALSE, NULL, 0);
+ play_channels_1(si->cps, si->chans, si->begs, ends, IN_BACKGROUND, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), false, Xen_false, NULL, 0);
si = free_sync_info(si);
if (ends) free(ends);
}
-static dac_info *play_selection_1(play_process_t background, XEN stop_proc)
+static dac_info *play_selection_1(play_process_t background, Xen stop_proc)
{
/* just plays the current selection */
dac_info *dp = NULL;
@@ -1458,14 +1493,13 @@ static dac_info *play_selection_1(play_process_t background, XEN stop_proc)
{
int i;
mus_long_t *ends;
+
ends = (mus_long_t *)calloc(si->chans, sizeof(mus_long_t));
for (i = 0; i < si->chans; i++)
- {
- snd_info *sp;
- sp = si->cps[i]->sound;
- ends[i] = si->begs[i] + selection_len();
- }
- dp = play_channels_1(si->cps, si->chans, si->begs, ends, background, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), true, stop_proc, NULL, 0);
+ ends[i] = si->begs[i] + selection_len();
+
+ dp = play_channels_1(si->cps, si->chans, si->begs, ends, background, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), true, stop_proc, NULL, 0);
+
si = free_sync_info(si); /* does not free samplers */
free(ends);
}
@@ -1476,13 +1510,13 @@ static dac_info *play_selection_1(play_process_t background, XEN stop_proc)
void play_selection(play_process_t background)
{
- play_selection_1(background, XEN_FALSE);
+ play_selection_1(background, Xen_false);
}
void loop_play_selection(void)
{
- play_selection_1(IN_BACKGROUND, XEN_TRUE);
+ play_selection_1(IN_BACKGROUND, Xen_true);
}
@@ -1496,7 +1530,7 @@ void loop_play_selection(void)
static int choose_dac_op(dac_info *dp, snd_info *sp)
{
if (!sp) return(NO_CHANGE);
- if ((dp->expanding) || (dp->filtering) || (dp->reverbing) || (sp->contrast_control_p))
+ if ((dp->expanding) || (dp->filtering) || (dp->reverbing) || (sp->contrast_control_on))
return(ALL_CHANGES);
else
{
@@ -1524,7 +1558,7 @@ static unsigned char **audio_bytes = NULL;
static int audio_bytes_size = 0;
static int audio_bytes_devices = 0;
-static mus_sample_t **dac_buffers = NULL;
+static mus_float_t **dac_buffers = NULL;
static int dac_buffer_size = 0;
static int dac_buffer_chans = 0; /* chans allocated */
static mus_float_t **rev_ins;
@@ -1532,58 +1566,37 @@ static mus_float_t **rev_ins;
#define WRITE_TO_DAC 1
#define WRITE_TO_FILE 0
-static XEN dac_hook;
-static XEN stop_dac_hook;
-static XEN sdobj;
-static int sdobj_loc = NOT_A_GC_LOC;
-
-static void cleanup_dac_hook(void)
-{
- if (XEN_HOOKED(stop_dac_hook))
- run_hook(stop_dac_hook,
- XEN_EMPTY_LIST,
- S_stop_dac_hook);
- if (!(XEN_FALSE_P(sdobj)))
- {
- snd_unprotect_at(sdobj_loc);
- sdobj = XEN_FALSE;
- sdobj_loc = NOT_A_GC_LOC;
- }
-}
-
-
static int fill_dac_buffers(int write_ok)
{
/* return value used only by Apply */
- int i, j;
+ int i;
bool cursor_change = false;
- int bytes, frames;
+ int framples;
mus_float_t *revin;
- mus_float_t amp, incr, sr, sincr, ind, indincr, ex, exincr, rev, revincr, fval;
dac_info *dp;
snd_info *sp;
- mus_sample_t *buf;
+ mus_float_t *buf;
#if (HAVE_OSS || HAVE_ALSA)
- mus_sample_t **dev_bufs;
+ mus_float_t **dev_bufs;
#endif
- frames = snd_dacp->frames;
+ framples = snd_dacp->framples;
/* clear buffers */
for (i = 0; i < snd_dacp->channels; i++)
- memset(dac_buffers[i], 0, frames * sizeof(mus_sample_t));
+ memset(dac_buffers[i], 0, framples * sizeof(mus_float_t));
if (global_rev)
for (i = 0; i < snd_dacp->channels; i++)
- memset(rev_ins[i], 0, frames * sizeof(mus_float_t));
+ memset(rev_ins[i], 0, framples * sizeof(mus_float_t));
if (dac_pausing)
cursor_change = false;
else
{
- if (XEN_HOOKED(play_hook))
+ if (Xen_hook_has_list(play_hook))
run_hook(play_hook,
- XEN_LIST_1(C_TO_XEN_INT(frames)),
+ Xen_list_1(C_int_to_Xen_integer(framples)),
S_play_hook);
- cursor_time += frames;
+ cursor_time += framples;
cursor_change = (cursor_time >= (int)(snd_dacp->srate * cursor_update_interval(ss)));
/* the check for hooks and so on has to be separate from the fill loop to keep everything synchronized across stop-function replay requests etc */
@@ -1604,7 +1617,8 @@ static int fill_dac_buffers(int write_ok)
dp = play_list[i];
if (dp)
{
-
+ int j;
+ mus_float_t amp, incr, sr, sincr, ind, indincr, rev, revincr, fval;
if (dp->audio_chan >= snd_dacp->channels) /* this can happen if we're playing 1 chan, try to add 2 chans */
{
if (dac_combines_channels(ss))
@@ -1613,12 +1627,15 @@ static int fill_dac_buffers(int write_ok)
}
/* check for moving cursor */
- sp = dp->sp; /* can be nil if region playing */
+ sp = dp->sp; /* can be nil if region playing */
if ((sp) &&
(ss->tracking) &&
(cursor_change) &&
(dp->chn_fd) &&
(!(dp->chn_fd->at_eof)) &&
+#if (!USE_NO_GUI)
+ (dp->cp->chan_widgets) && /* nil if play_file */
+#endif
(dp->chn_fd->cb))
{
mus_long_t loc;
@@ -1639,16 +1656,16 @@ static int fill_dac_buffers(int write_ok)
{
case NO_CHANGE:
/* simplest case -- no changes at all */
- for (j = 0; j < frames; j++)
- buf[j] += (mus_sample_t)((*(dp->dac_sample))(dp));
+ for (j = 0; j < framples; j++)
+ buf[j] += (mus_float_t)((*(dp->dac_sample))(dp));
break;
case JUST_AMP:
/* AMP_CONTROL(sp, dp) is current UI value, dp->cur_amp is current local value */
amp = dp->cur_amp;
- incr = (AMP_CONTROL(sp, dp) - amp) / (mus_float_t)(frames);
- for (j = 0; j < frames; j++, amp += incr)
- buf[j] += (mus_sample_t)(amp * (*(dp->dac_sample))(dp));
+ incr = (AMP_CONTROL(sp, dp) - amp) / (mus_float_t)(framples);
+ for (j = 0; j < framples; j++, amp += incr)
+ buf[j] += (mus_float_t)(amp * (*(dp->dac_sample))(dp));
dp->cur_amp = amp;
break;
@@ -1657,13 +1674,32 @@ static int fill_dac_buffers(int write_ok)
/* sp->speed_control is current UI value, dp->cur_srate is current local value */
dp->never_sped = false;
amp = dp->cur_amp;
- incr = (AMP_CONTROL(sp, dp) - amp) / (mus_float_t)(frames);
+ incr = (AMP_CONTROL(sp, dp) - amp) / (mus_float_t)(framples);
sr = dp->cur_srate;
- sincr = (sp->speed_control * sp->speed_control_direction - sr) / (mus_float_t)(frames);
+ sincr = (sp->speed_control * sp->speed_control_direction - sr) / (mus_float_t)(framples);
if ((sr != 0.0) || (sincr != 0.0))
{
- for (j = 0; j < frames; j++, amp += incr, sr += sincr)
- buf[j] += MUS_FLOAT_TO_SAMPLE(amp * speed(dp, sr));
+ if (dp->src)
+ {
+ if ((amp == 1.0) && (incr == 0.0) && (sincr == 0.0))
+ {
+ mus_set_increment(dp->src, sr);
+ mus_src_to_buffer(dp->src, &dac_src_input_as_needed, buf, framples);
+ }
+ else
+ {
+ for (j = 0; j < framples; j++, amp += incr, sr += sincr)
+ {
+ mus_set_increment(dp->src, sr);
+ buf[j] += (amp * mus_src(dp->src, 0.0, &dac_src_input_as_needed));
+ }
+ }
+ }
+ else
+ {
+ for (j = 0; j < framples; j++, amp += incr, sr += sincr)
+ buf[j] += (amp * speed(dp, sr));
+ }
}
dp->cur_srate = sr;
dp->cur_amp = amp;
@@ -1671,14 +1707,14 @@ static int fill_dac_buffers(int write_ok)
case ALL_CHANGES:
amp = dp->cur_amp;
- incr = (AMP_CONTROL(sp, dp) - amp) / (mus_float_t)(frames);
+ incr = (AMP_CONTROL(sp, dp) - amp) / (mus_float_t)(framples);
sr = dp->cur_srate;
- sincr = (sp->speed_control * sp->speed_control_direction - sr) / (mus_float_t)(frames);
+ sincr = (sp->speed_control * sp->speed_control_direction - sr) / (mus_float_t)(framples);
if ((sincr != 0.0) || (!(snd_feq(sr, 1.0)))) dp->never_sped = false;
ind = dp->cur_index;
- indincr = (sp->contrast_control - ind) / (mus_float_t)(frames);
+ indincr = (sp->contrast_control - ind) / (mus_float_t)(framples);
rev = dp->cur_rev;
- revincr = (sp->reverb_control_scale - rev) / (mus_float_t)(frames);
+ revincr = (sp->reverb_control_scale - rev) / (mus_float_t)(framples);
if ((dp->filtering) && (sp->filter_control_changed))
{
mus_float_t *data = NULL;
@@ -1713,15 +1749,16 @@ static int fill_dac_buffers(int write_ok)
}
if (dp->expanding)
{
+ mus_float_t ex, exincr;
ex = dp->cur_exp;
- exincr = (sp->expand_control - ex) / (mus_float_t)(frames);
- for (j = 0; j < frames; j++, amp += incr, sr += sincr, ind += indincr, ex += exincr, rev += revincr)
+ exincr = (sp->expand_control - ex) / (mus_float_t)(framples);
+ for (j = 0; j < framples; j++, amp += incr, sr += sincr, ind += indincr, ex += exincr, rev += revincr)
{
fval = expand(dp, sr, ex);
- if (sp->contrast_control_p) fval = contrast(dp, amp, ind, fval); else fval *= amp;
+ if (sp->contrast_control_on) fval = contrast(dp, amp, ind, fval); else fval *= amp;
if (dp->filtering) fval = mus_fir_filter(dp->flt, fval);
if (dp->reverbing) revin[j] += fval * rev;
- buf[j] += MUS_FLOAT_TO_SAMPLE(fval);
+ buf[j] += fval;
}
dp->cur_exp = ex;
}
@@ -1729,44 +1766,44 @@ static int fill_dac_buffers(int write_ok)
{
if (dp->filtering)
{
- for (j = 0; j < frames; j++, amp += incr, sr += sincr, ind += indincr, rev += revincr)
+ for (j = 0; j < framples; j++, amp += incr, sr += sincr, ind += indincr, rev += revincr)
{
fval = speed(dp, sr);
- if (sp->contrast_control_p) fval = contrast(dp, amp, ind, fval); else fval *= amp;
+ if (sp->contrast_control_on) fval = contrast(dp, amp, ind, fval); else fval *= amp;
fval = mus_fir_filter(dp->flt, fval);
if (dp->reverbing) revin[j] += fval * rev;
- buf[j] += MUS_FLOAT_TO_SAMPLE(fval);
+ buf[j] += fval;
}
}
else
{
- if (sp->contrast_control_p)
+ if (sp->contrast_control_on)
{
- for (j = 0; j < frames; j++, amp += incr, sr += sincr, ind += indincr, rev += revincr)
+ for (j = 0; j < framples; j++, amp += incr, sr += sincr, ind += indincr, rev += revincr)
{
fval = contrast(dp, amp, ind, speed(dp, sr));
if (dp->reverbing) revin[j] += fval * rev;
- buf[j] += MUS_FLOAT_TO_SAMPLE(fval);
+ buf[j] += fval;
}
}
else
{
if (dp->never_sped)
{
- for (j = 0; j < frames; j++, amp += incr, rev += revincr)
+ for (j = 0; j < framples; j++, amp += incr, rev += revincr)
{
fval = amp * (*(dp->dac_sample))(dp);
revin[j] += fval * rev;
- buf[j] += MUS_FLOAT_TO_SAMPLE(fval);
+ buf[j] += fval;
}
}
else
{
- for (j = 0; j < frames; j++, amp += incr, sr += sincr, rev += revincr)
+ for (j = 0; j < framples; j++, amp += incr, sr += sincr, rev += revincr)
{
fval = amp * speed(dp, sr);
revin[j] += fval * rev;
- buf[j] += MUS_FLOAT_TO_SAMPLE(fval);
+ buf[j] += fval;
}
}
}
@@ -1792,7 +1829,7 @@ static int fill_dac_buffers(int write_ok)
} /* fill-case loop through max_active_slot */
if (global_rev)
- for (i = 0; i < frames; i++)
+ for (i = 0; i < framples; i++)
reverb(global_rev, rev_ins, dac_buffers, i);
/* now hooks, stop-function etc */
@@ -1801,7 +1838,6 @@ static int fill_dac_buffers(int write_ok)
dp = play_list[i];
if (dp)
{
- sp = dp->sp; /* can be nil if region playing */
/* check for EOF or specified end point */
if (write_ok == WRITE_TO_DAC) /* not Apply */
{
@@ -1816,8 +1852,8 @@ static int fill_dac_buffers(int write_ok)
stop_playing(dp, WITH_HOOK, PLAY_COMPLETE);
else
{
- dp->expand_ring_frames -= frames;
- if (dp->expand_ring_frames <= 0)
+ dp->expand_ring_framples -= framples;
+ if (dp->expand_ring_framples <= 0)
stop_playing(dp, WITH_HOOK, PLAY_COMPLETE);
}
}
@@ -1839,39 +1875,13 @@ static int fill_dac_buffers(int write_ok)
(snd_dacp) &&
(play_list_members == 0))
{
- snd_dacp->reverb_ring_frames -= frames;
- if (snd_dacp->reverb_ring_frames <= 0)
+ snd_dacp->reverb_ring_framples -= framples;
+ if (snd_dacp->reverb_ring_framples <= 0)
free_reverb();
}
}
/* now parcel these buffers out to the available devices */
- if ((snd_dacp) && (XEN_HOOKED(dac_hook)))
- {
- if (XEN_FALSE_P(sdobj))
- {
-#if SNDLIB_USE_FLOATS
- sdobj = wrap_sound_data(snd_dacp->channels, snd_dacp->frames, dac_buffers);
- sdobj_loc = snd_protect(sdobj);
-#else
- {
- sound_data *sd;
- int j;
- mus_long_t i;
- sdobj = make_sound_data(snd_dacp->channels, snd_dacp->frames);
- sdobj_loc = snd_protect(sdobj);
- sd = XEN_TO_SOUND_DATA(sdobj);
- for (j = 0; j < sd->chans; j++)
- for (i = 0; i < sd->length; i++)
- sd->data[j][i] = MUS_SAMPLE_TO_DOUBLE(dac_buffers[j][i]);
- }
-#endif
- }
- run_hook(dac_hook,
- XEN_LIST_1(sdobj),
- S_dac_hook);
- }
- /* dac-hook might have forced stop-dac, so snd_dacp might be invalid here */
if (snd_dacp)
{
#if (HAVE_OSS || HAVE_ALSA)
@@ -1881,8 +1891,8 @@ static int fill_dac_buffers(int write_ok)
for (i = 0; i < snd_dacp->devices; i++)
if (dev_fd[i] != -1)
{
- mus_file_write_buffer(snd_dacp->out_format,
- 0, frames - 1,
+ mus_file_write_buffer(snd_dacp->out_samp_type,
+ 0, framples - 1,
snd_dacp->chans_per_device[i],
dev_bufs,
(char *)(audio_bytes[i]),
@@ -1892,21 +1902,23 @@ static int fill_dac_buffers(int write_ok)
for (i = 0; i < snd_dacp->devices; i++)
if (dev_fd[i] != -1)
{
- bytes = snd_dacp->chans_per_device[i] * frames * mus_bytes_per_sample(snd_dacp->out_format);
+ int bytes;
+ bytes = snd_dacp->chans_per_device[i] * framples * mus_bytes_per_sample(snd_dacp->out_samp_type);
mus_audio_write(dev_fd[i], (char *)(audio_bytes[i]), bytes);
}
}
#else
if (write_ok == WRITE_TO_DAC)
{
- mus_file_write_buffer(snd_dacp->out_format, 0, frames - 1, snd_dacp->channels, dac_buffers, (char *)(audio_bytes[0]), clipping(ss));
- bytes = snd_dacp->channels * frames * mus_bytes_per_sample(snd_dacp->out_format);
+ int bytes;
+ mus_file_write_buffer(snd_dacp->out_samp_type, 0, framples - 1, snd_dacp->channels, dac_buffers, (char *)(audio_bytes[0]), clipping(ss));
+ bytes = snd_dacp->channels * framples * mus_bytes_per_sample(snd_dacp->out_samp_type);
mus_audio_write(dev_fd[0], (char *)(audio_bytes[0]), bytes);
}
#endif
}
if (cursor_change) cursor_time = 0;
- return(frames);
+ return(framples);
}
@@ -1938,6 +1950,7 @@ static void unset_dac_print(void)
}
+#if WITH_AUDIO
static const char *describe_dac(void)
{
/* this is only called in dac_error and only then upon a failed mus_audio_open_output */
@@ -1954,17 +1967,17 @@ static const char *describe_dac(void)
return((const char *)(ptr->sp->short_filename));
return("");
}
+#endif
static void dac_error(void)
{
stop_playing_all_sounds_without_hook(PLAY_ERROR);
- if ((!last_print) &&
- (mus_audio_systems() == 0))
- snd_error_without_format("can't play: no audio support");
- else snd_error("can't play %s: %s",
- describe_dac(),
- (last_print) ? last_print : "reason not known");
+#if WITH_AUDIO
+ snd_error("can't play %s: %s",
+ describe_dac(),
+ (last_print) ? last_print : "reason not known");
+#endif
}
@@ -1977,7 +1990,7 @@ static void make_dac_buffers(void)
if ((dac_buffers == NULL) ||
(dac_buffer_chans < snd_dacp->channels) ||
- (dac_buffer_size < snd_dacp->frames))
+ (dac_buffer_size < snd_dacp->framples))
{
if (dac_buffers)
{
@@ -1989,22 +2002,22 @@ static void make_dac_buffers(void)
for (i = 0; i < dac_buffer_chans; i++) free(rev_ins[i]);
free(rev_ins);
}
- dac_buffers = (mus_sample_t **)calloc(snd_dacp->channels, sizeof(mus_sample_t *));
+ dac_buffers = (mus_float_t **)calloc(snd_dacp->channels, sizeof(mus_float_t *));
rev_ins = (mus_float_t **)calloc(snd_dacp->channels, sizeof(mus_float_t *));
for (i = 0; i < snd_dacp->channels; i++)
{
- dac_buffers[i] = (mus_sample_t *)calloc(snd_dacp->frames, sizeof(mus_sample_t));
- rev_ins[i] = (mus_float_t *)calloc(snd_dacp->frames, sizeof(mus_float_t));
+ dac_buffers[i] = (mus_float_t *)calloc(snd_dacp->framples, sizeof(mus_float_t));
+ rev_ins[i] = (mus_float_t *)calloc(snd_dacp->framples, sizeof(mus_float_t));
}
dac_buffer_chans = snd_dacp->channels;
- dac_buffer_size = snd_dacp->frames;
+ dac_buffer_size = snd_dacp->framples;
if (r_outs) free(r_outs);
if (r_ins) free(r_ins);
r_outs = (mus_float_t *)calloc(snd_dacp->channels, sizeof(mus_float_t));
r_ins = (mus_float_t *)calloc(snd_dacp->channels, sizeof(mus_float_t));
}
- bytes = snd_dacp->channels * dac_buffer_size * mus_bytes_per_sample(snd_dacp->out_format);
+ bytes = snd_dacp->channels * dac_buffer_size * mus_bytes_per_sample(snd_dacp->out_samp_type);
if ((audio_bytes_size < bytes) ||
(audio_bytes_devices < snd_dacp->devices))
{
@@ -2065,7 +2078,7 @@ static void scan_audio_devices(void)
* Otherwise we try to combine devices, if all fails we modify snd settings
* so that channel folding takes place. This is inefficient but works for now.
*/
- cards = mus_audio_systems();
+ cards = 1;
index = 0;
/* scan all cards and build a list of available output devices */
for (card = 0; card < cards; card++)
@@ -2112,16 +2125,13 @@ int mus_audio_alsa_samples_per_channel(int dev);
static bool start_audio_output_1(void)
{
- int i, d;
- int samples_per_channel = 256;
- static int out_dev[ALSA_MAX_DEVICES];
- int alloc_devs = 0;
- int alloc_chans = 0;
- int oss_available_chans = 2;
+ int i;
/* -------------------- ALSA not OSS -------------------- */
if (mus_audio_api() == MUS_ALSA_API)
{
+ static int out_dev[ALSA_MAX_DEVICES];
+ int d, alloc_chans, alloc_devs;
scan_audio_devices();
/* allocate devices for playback */
alloc_chans = 0;
@@ -2139,17 +2149,17 @@ static bool start_audio_output_1(void)
if (alloc_devs == 0)
{
/* try to use several devices */
- int this_format = -1;
- int prev_format = -1;
+ int prev_samp_type = -1;
for (d = 0; d < alsa_devices_available; d++)
{
- this_format = mus_audio_compatible_format(alsa_devices[d]);
- if (prev_format == -1)
+ int this_samp_type;
+ this_samp_type = mus_audio_compatible_sample_type(alsa_devices[d]);
+ if (prev_samp_type == -1)
{
- prev_format = this_format;
+ prev_samp_type = this_samp_type;
}
- /* format for all selected devices should match */
- if (this_format == prev_format)
+ /* samp_type for all selected devices should match */
+ if (this_samp_type == prev_samp_type)
{
out_dev[alloc_devs++] = d;
alloc_chans += alsa_available_chans[d];
@@ -2178,10 +2188,10 @@ static bool start_audio_output_1(void)
out_dev[alloc_devs++] = 0;
alloc_chans += alsa_available_chans[0];
}
- snd_dacp->out_format = mus_audio_compatible_format(alsa_devices[out_dev[0]]);
+ snd_dacp->out_samp_type = mus_audio_compatible_sample_type(alsa_devices[out_dev[0]]);
if (alloc_devs < 2)
{
- /* see if we have a minimum sized frame to fill
+ /* see if we have a minimum sized frample to fill
* FIXME: could this happen in more than one device? */
int c;
c = alsa_min_chans[out_dev[0]];
@@ -2199,11 +2209,14 @@ static bool start_audio_output_1(void)
snd_dacp->channels = alloc_chans;
}
- /* read the number of samples per channel the device wants buffered */
- samples_per_channel = mus_audio_alsa_samples_per_channel(alsa_devices[out_dev[0]]);
- snd_dacp->frames = samples_per_channel;
- set_dac_size(snd_dacp->frames * mus_bytes_per_sample(snd_dacp->out_format));
-
+ {
+ int samples_per_channel;
+ /* read the number of samples per channel the device wants buffered */
+ samples_per_channel = mus_audio_alsa_samples_per_channel(alsa_devices[out_dev[0]]);
+ snd_dacp->framples = samples_per_channel;
+ /* set_dac_size(snd_dacp->framples * mus_bytes_per_sample(snd_dacp->out_samp_type)); */
+ set_dac_size(samples_per_channel); /* bil 24-Mar-13 */
+ }
/* open all allocated devices */
for (d = 0; d < alloc_devs; d++)
{
@@ -2225,8 +2238,8 @@ static bool start_audio_output_1(void)
dev_fd[d] = mus_audio_open_output(alsa_devices[out_dev[d]],
snd_dacp->srate,
channels,
- snd_dacp->out_format,
- snd_dacp->frames * channels * mus_bytes_per_sample(snd_dacp->out_format));
+ snd_dacp->out_samp_type,
+ snd_dacp->framples * channels * mus_bytes_per_sample(snd_dacp->out_samp_type));
unset_dac_print();
if (dev_fd[d] == -1)
@@ -2239,7 +2252,6 @@ static bool start_audio_output_1(void)
}
dac_error();
dac_running = false;
- cleanup_dac_hook();
if (global_rev) free_reverb();
max_active_slot = -1;
return(false);
@@ -2257,37 +2269,16 @@ static bool start_audio_output_1(void)
/* -------------------- OSS not ALSA -------------------- */
/* api == MUS_OSS_API -- MUS_JACK_API should not intrude here because we're in HAVE_ALSA || HAVE_OSS */
+ int oss_available_chans = 2;
+
if (snd_dacp->channels > 2)
- oss_available_chans = mus_audio_device_channels(audio_output_device(ss));
+ oss_available_chans = mus_audio_device_channels(MUS_AUDIO_DEFAULT);
for (i = 0; i < MAX_DEVICES; i++) dev_fd[i] = -1;
/* see if we can play 16 bit output */
- snd_dacp->out_format = mus_audio_compatible_format(audio_output_device(ss));
-#ifndef PPC
- /* check for chans > def chans, open 2 cards if available */
- if ((oss_available_chans < snd_dacp->channels) && (snd_dacp->channels == 4))
- {
- if (mus_audio_systems() > 1)
- {
- set_dac_print();
- dev_fd[0] = mus_audio_open_output(MUS_AUDIO_PACK_SYSTEM(0) | audio_output_device(ss),
- snd_dacp->srate, 2,
- snd_dacp->out_format,
- dac_size(ss));
- unset_dac_print();
- if (dev_fd[0] != MUS_ERROR)
- dev_fd[1] = mus_audio_open_output(MUS_AUDIO_PACK_SYSTEM(1) | audio_output_device(ss),
- snd_dacp->srate, 2,
- snd_dacp->out_format,
- dac_size(ss));
- }
- if (dev_fd[1] == MUS_ERROR)
- {
- mus_audio_close(dev_fd[0]);
- dev_fd[0] = MUS_ERROR;
- }
- else oss_available_chans = 4;
- }
-#endif
+ snd_dacp->out_samp_type = mus_audio_compatible_sample_type(MUS_AUDIO_DEFAULT);
+
+ /* removed PPC stuff here 30-Apr-12 */
+
if ((oss_available_chans < snd_dacp->channels) &&
(oss_available_chans > 0))
{
@@ -2298,9 +2289,9 @@ static bool start_audio_output_1(void)
}
set_dac_print();
if (dev_fd[0] == MUS_ERROR)
- dev_fd[0] = mus_audio_open_output(audio_output_device(ss),
+ dev_fd[0] = mus_audio_open_output(MUS_AUDIO_DEFAULT,
snd_dacp->srate, snd_dacp->channels,
- snd_dacp->out_format,
+ snd_dacp->out_samp_type,
dac_size(ss));
unset_dac_print();
if (dev_fd[0] == MUS_ERROR)
@@ -2325,7 +2316,7 @@ static bool start_audio_output_1(void)
int available_chans = 2;
if (snd_dacp->channels > 2)
- available_chans = mus_audio_device_channels(audio_output_device(ss));
+ available_chans = mus_audio_device_channels(MUS_AUDIO_DEFAULT);
if (available_chans <= 0)
{
@@ -2342,14 +2333,14 @@ static bool start_audio_output_1(void)
}
for (i = 0; i < MAX_DEVICES; i++) dev_fd[i] = -1;
- snd_dacp->out_format = mus_audio_device_format(audio_output_device(ss));
+ snd_dacp->out_samp_type = mus_audio_device_sample_type(MUS_AUDIO_DEFAULT);
set_dac_print();
if (dev_fd[0] == MUS_ERROR)
- dev_fd[0] = mus_audio_open_output(audio_output_device(ss),
+ dev_fd[0] = mus_audio_open_output(MUS_AUDIO_DEFAULT,
snd_dacp->srate,
snd_dacp->channels,
- snd_dacp->out_format,
+ snd_dacp->out_samp_type,
dac_size(ss));
unset_dac_print();
if (dev_fd[0] == MUS_ERROR)
@@ -2372,10 +2363,10 @@ static bool start_audio_output(void)
{
/* at this point the desired output srate and chans are set in dacp (via start_dac) */
dac_info *dp;
- int i;
cursor_time = 0;
if (start_audio_output_1()) /* number of channels may be less than requested initially */
{
+ int i;
for (i = 0; i <= max_active_slot; i++)
{
dp = play_list[i];
@@ -2414,7 +2405,6 @@ static void stop_audio_output(void)
dev_fd[i] = -1;
}
dac_running = false;
- cleanup_dac_hook();
dac_pausing = false;
if (global_rev) free_reverb();
max_active_slot = -1;
@@ -2502,15 +2492,15 @@ void initialize_apply(snd_info *sp, int chans, mus_long_t beg, mus_long_t dur)
snd_dacp = (dac_state *)calloc(1, sizeof(dac_state));
snd_dacp->slice = 0;
- snd_dacp->srate = SND_SRATE(sp);
- snd_dacp->out_format = MUS_AUDIO_COMPATIBLE_FORMAT;
+ snd_dacp->srate = snd_srate(sp);
+ snd_dacp->out_samp_type = MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE;
if (snd_dacp->srate <= 0) snd_dacp->srate = 44100;
snd_dacp->channels = chans;
- snd_dacp->frames = 8192;
+ snd_dacp->framples = 8192;
snd_dacp->devices = 1;
snd_dacp->chans_per_device = (int *)calloc(1, sizeof(int));
snd_dacp->chans_per_device[0] = chans;
- snd_dacp->reverb_ring_frames = (mus_long_t)(snd_dacp->srate * sp->reverb_control_decay);
+ snd_dacp->reverb_ring_framples = (mus_long_t)(snd_dacp->srate * sp->reverb_control_decay);
make_dac_buffers();
switch (ss->apply_choice)
@@ -2540,7 +2530,6 @@ void finalize_apply(snd_info *sp)
play_list_members = 0;
sp->playing = 0;
dac_running = false;
- cleanup_dac_hook();
if (snd_dacp) free_dac_state();
if (global_rev) free_reverb();
}
@@ -2646,7 +2635,7 @@ void clear_players(void)
free_dac_info(dp, PLAY_CLOSE); /* calls stop-function, if any. used in snd-data.c in free_snd_info */
}
}
- if (IS_PLAYER_SOUND(sp)) free_player_sound(sp);
+ if (is_player_sound(sp)) free_player_sound(sp);
break;
}
}
@@ -2660,61 +2649,61 @@ typedef struct {
} xen_player;
-#define XEN_TO_XEN_PLAYER(arg) ((xen_player *)XEN_OBJECT_REF(arg))
+#define Xen_to_xen_player(arg) ((xen_player *)Xen_object_ref(arg))
-static int xen_player_to_int(XEN n)
+static int xen_player_to_int(Xen n)
{
xen_player *mx;
- mx = XEN_TO_XEN_PLAYER(n);
+ mx = Xen_to_xen_player(n);
return(mx->n);
}
-#define XEN_PLAYER_TO_C_INT(Player) xen_player_to_int(Player)
+#define Xen_player_to_C_int(Player) xen_player_to_int(Player)
-snd_info *get_player_sound(XEN obj)
+snd_info *get_player_sound(Xen obj)
{
return(players[xen_player_to_int(obj)]);
}
-static XEN_OBJECT_TYPE xen_player_tag;
+static Xen_object_type_t xen_player_tag;
-bool xen_player_p(XEN obj)
+bool xen_is_player(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, xen_player_tag));
+ return(Xen_c_object_is_type(obj, xen_player_tag));
}
static void xen_player_free(xen_player *v) {if (v) free(v);}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(xen_player, free_xen_player, xen_player_free)
+Xen_wrap_free(xen_player, free_xen_player, xen_player_free)
static char *xen_player_to_string(xen_player *v)
{
- #define XEN_PLAYER_PRINT_BUFFER_SIZE 64
+ #define PLAYER_PRINT_BUFFER_SIZE 64
char *buf;
if (v == NULL) return(NULL);
- buf = (char *)calloc(XEN_PLAYER_PRINT_BUFFER_SIZE, sizeof(char));
- snprintf(buf, XEN_PLAYER_PRINT_BUFFER_SIZE, "#<player %d>", v->n);
+ buf = (char *)calloc(PLAYER_PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, PLAYER_PRINT_BUFFER_SIZE, "#<player %d>", v->n);
return(buf);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(xen_player, print_xen_player, xen_player_to_string)
+Xen_wrap_print(xen_player, print_xen_player, xen_player_to_string)
#if HAVE_FORTH || HAVE_RUBY
-static XEN g_xen_player_to_string(XEN obj)
+static Xen g_xen_player_to_string(Xen obj)
{
char *vstr;
- XEN result;
+ Xen result;
#define S_xen_player_to_string "player->string"
- XEN_ASSERT_TYPE(XEN_PLAYER_P(obj), obj, XEN_ONLY_ARG, S_xen_player_to_string, "a player");
+ Xen_check_type(xen_is_player(obj), obj, 1, S_xen_player_to_string, "a player");
- vstr = xen_player_to_string(XEN_TO_XEN_PLAYER(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = xen_player_to_string(Xen_to_xen_player(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
@@ -2728,10 +2717,10 @@ static bool xen_player_equalp(xen_player *v1, xen_player *v2)
(v1->n == v2->n));
}
-static XEN equalp_xen_player(XEN obj1, XEN obj2)
+static Xen equalp_xen_player(Xen obj1, Xen obj2)
{
- if ((!(XEN_PLAYER_P(obj1))) || (!(XEN_PLAYER_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(xen_player_equalp(XEN_TO_XEN_PLAYER(obj1), XEN_TO_XEN_PLAYER(obj2))));
+ if ((!(xen_is_player(obj1))) || (!(xen_is_player(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(xen_player_equalp(Xen_to_xen_player(obj1), Xen_to_xen_player(obj2))));
}
#endif
@@ -2745,17 +2734,17 @@ static xen_player *xen_player_make(int n)
}
-static XEN new_xen_player(int n)
+static Xen new_xen_player(int n)
{
xen_player *mx;
if (n < 0)
- return(XEN_FALSE);
+ return(Xen_false);
mx = xen_player_make(n);
- XEN_MAKE_AND_RETURN_OBJECT(xen_player_tag, mx, 0, free_xen_player);
+ return(Xen_make_object(xen_player_tag, mx, 0, free_xen_player));
}
-#define C_INT_TO_XEN_PLAYER(val) new_xen_player(val)
+#define C_int_to_Xen_player(val) new_xen_player(val)
#if HAVE_SCHEME
@@ -2765,13 +2754,13 @@ static bool s7_xen_player_equalp(void *obj1, void *obj2)
(((xen_player *)obj1)->n == ((xen_player *)obj2)->n));
}
-static XEN s7_xen_player_length(s7_scheme *sc, XEN player)
+static Xen s7_xen_player_length(s7_scheme *sc, Xen player)
{
chan_info *cp;
int index;
- index = XEN_PLAYER_TO_C_INT(player);
+ index = Xen_player_to_C_int(player);
cp = players[index]->chans[player_chans[index]];
- return(C_TO_XEN_INT64_T(CURRENT_SAMPLES(cp)));
+ return(C_llong_to_Xen_llong(current_samples(cp)));
}
#endif
@@ -2779,12 +2768,12 @@ static XEN s7_xen_player_length(s7_scheme *sc, XEN player)
static void init_xen_player(void)
{
#if HAVE_SCHEME
- xen_player_tag = XEN_MAKE_OBJECT_TYPE("<player>", print_xen_player, free_xen_player, s7_xen_player_equalp, NULL, NULL, NULL, s7_xen_player_length, NULL, NULL);
+ xen_player_tag = s7_new_type_x(s7, "<player>", print_xen_player, free_xen_player, s7_xen_player_equalp, NULL, NULL, NULL, s7_xen_player_length, NULL, NULL, NULL);
#else
#if HAVE_RUBY
- xen_player_tag = XEN_MAKE_OBJECT_TYPE("XenPlayer", sizeof(xen_player));
+ xen_player_tag = Xen_make_object_type("XenPlayer", sizeof(xen_player));
#else
- xen_player_tag = XEN_MAKE_OBJECT_TYPE("Player", sizeof(xen_player));
+ xen_player_tag = Xen_make_object_type("Player", sizeof(xen_player));
#endif
#endif
@@ -2796,63 +2785,62 @@ static void init_xen_player(void)
#endif
#if HAVE_RUBY
- rb_define_method(xen_player_tag, "to_s", XEN_PROCEDURE_CAST print_xen_player, 0);
- rb_define_method(xen_player_tag, "eql?", XEN_PROCEDURE_CAST equalp_xen_player, 1);
- rb_define_method(xen_player_tag, "==", XEN_PROCEDURE_CAST equalp_xen_player, 1);
- rb_define_method(xen_player_tag, "to_str", XEN_PROCEDURE_CAST g_xen_player_to_string, 0);
+ rb_define_method(xen_player_tag, "to_s", Xen_procedure_cast print_xen_player, 0);
+ rb_define_method(xen_player_tag, "eql?", Xen_procedure_cast equalp_xen_player, 1);
+ rb_define_method(xen_player_tag, "==", Xen_procedure_cast equalp_xen_player, 1);
+ rb_define_method(xen_player_tag, "to_str", Xen_procedure_cast g_xen_player_to_string, 0);
#endif
}
/* -------------------------------------------------------------------------------- */
-static XEN play_file(const char *play_name, mus_long_t start, mus_long_t end, int in_channel, int out_channel, play_process_t background, XEN stop_func)
+static Xen play_file(const char *play_name, mus_long_t start, mus_long_t end, int in_channel, int out_channel, play_process_t background, Xen stop_func)
{
snd_info *sp;
if (!(mus_file_probe(play_name)))
- return(snd_no_such_file_error(S_play, C_TO_XEN_STRING(play_name)));
-
- if (!(mus_header_type_p(mus_sound_header_type(play_name))))
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_3(C_TO_XEN_STRING(S_play ": ~S has unknown header: ~A"),
- C_TO_XEN_STRING(play_name),
- C_TO_XEN_STRING(mus_header_type_name(mus_header_type()))));
-
- if (!(mus_data_format_p(mus_sound_data_format(play_name))))
- XEN_ERROR(XEN_ERROR_TYPE("bad-format"),
- XEN_LIST_3(C_TO_XEN_STRING(S_play ": ~S has unknown data format: ~A"),
- C_TO_XEN_STRING(play_name),
- C_TO_XEN_STRING(mus_header_original_format_name(mus_sound_original_format(play_name),
- mus_sound_header_type(play_name)))));
+ return(snd_no_such_file_error(S_play, C_string_to_Xen_string(play_name)));
+
+ if (!(mus_is_header_type(mus_sound_header_type(play_name))))
+ Xen_error(BAD_HEADER,
+ Xen_list_3(C_string_to_Xen_string(S_play ": ~S has unknown header: ~A"),
+ C_string_to_Xen_string(play_name),
+ C_string_to_Xen_string(mus_header_type_name(mus_header_type()))));
+
+ if (!(mus_is_sample_type(mus_sound_sample_type(play_name))))
+ Xen_error(Xen_make_error_type("bad-sample-type"),
+ Xen_list_3(C_string_to_Xen_string(S_play ": ~S has unknown sample type: ~A"),
+ C_string_to_Xen_string(play_name),
+ C_string_to_Xen_string(mus_header_original_sample_type_name(mus_sound_original_sample_type(play_name), mus_sound_header_type(play_name)))));
sp = make_sound_readable(play_name, false);
sp->short_filename = filename_without_directory(play_name);
sp->filename = NULL;
- sp->delete_me = (struct dialog_play_info *)1;
+ sp->delete_me = (void *)1;
if (in_channel != -1)
play_channel_1(sp->chans[in_channel], start, end, background, 0, stop_func, (out_channel < 0) ? 0 : out_channel);
- else play_sound_1(sp, start, end, background, XEN_ZERO, stop_func, S_play, -1);
+ else play_sound_1(sp, start, end, background, Xen_integer_zero, stop_func, S_play, -1);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN kw_start, kw_end, kw_channel, kw_wait, kw_edit_position, kw_stop, kw_out_channel, kw_with_sync, kw_srate, kw_channels;
+static Xen kw_start, kw_end, kw_channel, kw_wait, kw_edit_position, kw_stop, kw_out_channel, kw_with_sync, kw_srate, kw_channels;
static void init_play_keywords(void)
{
- kw_start = XEN_MAKE_KEYWORD("start");
- kw_end = XEN_MAKE_KEYWORD("end");
- kw_wait = XEN_MAKE_KEYWORD("wait");
- kw_channel = XEN_MAKE_KEYWORD("channel");
- kw_out_channel = XEN_MAKE_KEYWORD("out-channel");
- kw_edit_position = XEN_MAKE_KEYWORD("edit-position");
- kw_stop = XEN_MAKE_KEYWORD("stop");
- kw_with_sync = XEN_MAKE_KEYWORD("with-sync");
- kw_srate = XEN_MAKE_KEYWORD("srate");
- kw_channels = XEN_MAKE_KEYWORD("channels");
+ kw_start = Xen_make_keyword("start");
+ kw_end = Xen_make_keyword("end");
+ kw_wait = Xen_make_keyword("wait");
+ kw_channel = Xen_make_keyword("channel");
+ kw_out_channel = Xen_make_keyword("out-channel");
+ kw_edit_position = Xen_make_keyword("edit-position");
+ kw_stop = Xen_make_keyword("stop");
+ kw_with_sync = Xen_make_keyword("with-sync");
+ kw_srate = Xen_make_keyword("srate");
+ kw_channels = Xen_make_keyword("channels");
}
-static XEN g_play(XEN arglist)
+static Xen g_play(Xen arglist)
{
#if HAVE_SCHEME
#define play_example "(play \"oboe.snd\")"
@@ -2871,26 +2859,26 @@ to that DAC channel. If edit-position, play that member of the edit list, other
If stop, call that function when the play process finishes. \
If object is a string, it is assumed to be a file name: \n " play_example "\n."
- XEN object = XEN_UNDEFINED;
+ Xen object = Xen_undefined;
mus_long_t start = 0, end = NO_END_SPECIFIED;
int channel = -1, out_channel = -1, srate = 44100, channels = 2, edpos_argpos = 0, channel_argpos = 0;
bool with_sync = false, wait = false;
- XEN stop_func = XEN_FALSE, edit_position = XEN_FALSE, channel_arg = XEN_FALSE;
+ Xen stop_func = Xen_false, edit_position = Xen_false, channel_arg = Xen_false;
play_process_t background;
snd_info *sp;
- if (XEN_NOT_NULL_P(arglist))
+ if (!Xen_is_null(arglist))
{
#define NARGS 10
- XEN args[NARGS * 2];
- XEN keys[NARGS];
+ Xen args[NARGS * 2];
+ Xen keys[NARGS];
int orig_arg[NARGS] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
int vals, i, arglist_len;
- if (!XEN_KEYWORD_P(XEN_CAR(arglist)))
+ if (!Xen_is_keyword(Xen_car(arglist)))
{
- object = XEN_CAR(arglist);
- arglist = XEN_CDR(arglist);
+ object = Xen_car(arglist);
+ arglist = Xen_cdr(arglist);
}
keys[0] = kw_start;
@@ -2904,27 +2892,29 @@ If object is a string, it is assumed to be a file name: \n " play_example "\n
keys[8] = kw_srate;
keys[9] = kw_channels;
- for (i = 0; i < NARGS * 2; i++) args[i] = XEN_UNDEFINED;
- arglist_len = XEN_LIST_LENGTH(arglist);
+ for (i = 0; i < NARGS * 2; i++) args[i] = Xen_undefined;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > NARGS)
+ Xen_out_of_range_error(S_play, 0, arglist, "too many arguments");
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
+ for (i = 0; i < arglist_len; i++) args[i] = Xen_list_ref(arglist, i);
vals = mus_optkey_unscramble(S_play, NARGS, keys, args, orig_arg);
if (vals > 0)
{
start = mus_optkey_to_mus_long_t(keys[0], S_play, orig_arg[0], start);
if (start < 0)
- XEN_OUT_OF_RANGE_ERROR(S_play, orig_arg[0], keys[0], "start ~A is negative?");
+ Xen_out_of_range_error(S_play, orig_arg[0], keys[0], "start is negative?");
end = mus_optkey_to_mus_long_t(keys[1], S_play, orig_arg[1], end);
if (end < -1)
- XEN_OUT_OF_RANGE_ERROR(S_play, orig_arg[1], keys[1], "end ~A is negative?");
+ Xen_out_of_range_error(S_play, orig_arg[1], keys[1], "end is negative?");
channel = mus_optkey_to_int(keys[2], S_play, orig_arg[2], channel);
channel_argpos = orig_arg[2];
channel_arg = keys[2];
- if (!(XEN_KEYWORD_P(keys[3])))
+ if (!(Xen_is_keyword(keys[3])))
{
edit_position = keys[3];
edpos_argpos = orig_arg[3];
@@ -2937,43 +2927,43 @@ If object is a string, it is assumed to be a file name: \n " play_example "\n
srate = mus_optkey_to_int(keys[8], S_play, orig_arg[8], srate);
if (srate <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_play, orig_arg[8], keys[8], "srate ~A <= 0?");
+ Xen_out_of_range_error(S_play, orig_arg[8], keys[8], "srate <= 0?");
channels = mus_optkey_to_int(keys[9], S_play, orig_arg[9], channels);
if (channels <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_play, orig_arg[9], keys[9], "channels ~A <= 0?");
+ Xen_out_of_range_error(S_play, orig_arg[9], keys[9], "channels <= 0?");
}
}
#if USE_NO_GUI
background = NOT_IN_BACKGROUND;
#else
- if (wait) background = IN_BACKGROUND; else background = NOT_IN_BACKGROUND;
+ if (wait) background = NOT_IN_BACKGROUND; else background = IN_BACKGROUND;
+ /* confusing! wait=#f means don't wait for the play to complete => IN_BACKGROUND */
#endif
-
/* unspecified object means the current sound, all chans, all samps, with sync, without wait, current edpos */
- if (XEN_NOT_BOUND_P(object))
+ if (!Xen_is_bound(object))
{
sp = any_selected_sound();
if (sp)
- play_sound_1(sp, start, end, background, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), XEN_FALSE, NULL, 0);
- return(XEN_FALSE);
+ play_sound_1(sp, start, end, background, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), Xen_false, NULL, 0);
+ return(Xen_false);
}
/* #f object means start sending out zeros */
- if (XEN_FALSE_P(object))
- return(C_TO_XEN_BOOLEAN(add_zeros_to_play_list(srate, channels)));
+ if (Xen_is_false(object))
+ return(C_bool_to_Xen_boolean(add_zeros_to_play_list(srate, channels)));
/* procedure object means add that function to the play list */
- if (XEN_PROCEDURE_P(object))
- return(C_TO_XEN_BOOLEAN(add_xen_to_play_list(object)));
+ if (Xen_is_procedure(object))
+ return(C_bool_to_Xen_boolean(add_xen_to_play_list(object)));
/* mix object */
- if (XEN_MIX_P(object))
+ if (xen_is_mix(object))
return(g_play_mix(object, start));
/* selection object */
- if (XEN_SELECTION_P(object))
+ if (xen_is_selection(object))
{
if (selection_is_active())
play_selection_1(background, stop_func);
@@ -2981,21 +2971,21 @@ If object is a string, it is assumed to be a file name: \n " play_example "\n
}
/* region object */
- if (XEN_REGION_P(object))
+ if (xen_is_region(object))
return(g_play_region(object, background, stop_func));
/* string object = filename */
- if (XEN_STRING_P(object))
+ if (Xen_is_string(object))
{
char *name;
- name = mus_expand_filename(XEN_TO_C_STRING(object));
+ name = mus_expand_filename(Xen_string_to_C_string(object));
play_file((const char *)name, start, end, channel, out_channel, background, stop_func);
free(name);
return(object);
}
/* otherwise object is either a player or a sound */
- if (XEN_PLAYER_P(object))
+ if (xen_is_player(object))
sp = get_player_sound(object);
else sp = get_sp(object);
@@ -3004,7 +2994,7 @@ If object is a string, it is assumed to be a file name: \n " play_example "\n
if ((with_sync) &&
(sp->sync != 0) &&
- (!(IS_PLAYER_SOUND(sp))))
+ (!(is_player_sound(sp))))
{
sync_info *si;
mus_long_t *ends = NULL;
@@ -3021,7 +3011,7 @@ If object is a string, it is assumed to be a file name: \n " play_example "\n
si = free_sync_info(si);
if (ends) free(ends);
- return(XEN_FALSE);
+ return(Xen_false);
}
if (channel == -1)
@@ -3038,31 +3028,31 @@ If object is a string, it is assumed to be a file name: \n " play_example "\n
pos = to_c_edit_position(cp, edit_position, S_play, edpos_argpos);
play_channel_1(cp, start, end, background, pos, stop_func, out_channel);
}
- else XEN_OUT_OF_RANGE_ERROR(S_play, channel_argpos, channel_arg, "channel ~A does not exist?");
+ else Xen_out_of_range_error(S_play, channel_argpos, channel_arg, "channel does not exist?");
}
return(object);
}
-XEN no_such_player_error(const char *caller, XEN player)
+Xen no_such_player_error(const char *caller, Xen player)
{
- XEN_ERROR(XEN_ERROR_TYPE("no-such-player"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such player, ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("no-such-player"),
+ Xen_list_3(C_string_to_Xen_string("~A: no such player, ~A"),
+ C_string_to_Xen_string(caller),
player));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_stop_playing(XEN snd)
+static Xen g_stop_playing(Xen snd)
{
#define H_stop_playing "(" S_stop_playing " :optional snd): stop play (DAC output) in progress"
snd_info *sp = NULL;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(snd) || XEN_SOUND_P(snd) || XEN_NOT_BOUND_P(snd) || XEN_PLAYER_P(snd), snd, XEN_ONLY_ARG, S_stop_playing, "a sound or player");
+ Xen_check_type(Xen_is_integer(snd) || xen_is_sound(snd) || !Xen_is_bound(snd) || xen_is_player(snd), snd, 1, S_stop_playing, "a sound or player");
- if (XEN_INTEGER_P(snd) || XEN_SOUND_P(snd))
+ if (Xen_is_integer(snd) || xen_is_sound(snd))
{
sp = get_sp(snd);
if (!sp)
@@ -3070,7 +3060,7 @@ static XEN g_stop_playing(XEN snd)
}
else
{
- if (XEN_PLAYER_P(snd))
+ if (xen_is_player(snd))
{
sp = get_player_sound(snd);
if (!sp)
@@ -3082,7 +3072,7 @@ static XEN g_stop_playing(XEN snd)
stop_playing_sound(sp, PLAY_STOP_CALLED);
else stop_playing_all_sounds(PLAY_STOP_CALLED);
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -3090,7 +3080,7 @@ static XEN g_stop_playing(XEN snd)
/* add-player make-player stop-player start-playing */
-static XEN g_make_player(XEN snd, XEN chn)
+static Xen g_make_player(Xen snd, Xen chn)
{
#define H_make_player "(" S_make_player " :optional snd chn): \
make a new player associated with snd's channel chn. \
@@ -3103,7 +3093,7 @@ to be played (via " S_start_playing ")."
snd_info *true_sp, *new_sp;
chan_info *cp;
- ASSERT_CHANNEL(S_make_player, snd, chn, 1);
+ Snd_assert_channel(S_make_player, snd, chn, 1);
true_sp = get_sp(snd);
if (true_sp == NULL)
return(snd_no_such_sound_error(S_make_player, snd));
@@ -3112,17 +3102,17 @@ to be played (via " S_start_playing ")."
new_sp = make_snd_info(NULL, "make_player:wrapper", true_sp->hdr, new_player_index(), FILE_READ_ONLY);
new_sp->chans[cp->chan] = cp;
- return(C_INT_TO_XEN_PLAYER(make_player(new_sp, cp)));
+ return(C_int_to_Xen_player(make_player(new_sp, cp)));
}
-static XEN g_player_home(XEN player)
+static Xen g_player_home(Xen player)
{
#define H_player_home "(" S_player_home " player): a list of the sound index and channel number associated with player"
int index;
- XEN_ASSERT_TYPE(XEN_PLAYER_P(player), player, XEN_ONLY_ARG, S_player_home, "a player");
- index = XEN_PLAYER_TO_C_INT(player);
+ Xen_check_type(xen_is_player(player), player, 1, S_player_home, "a player");
+ index = Xen_player_to_C_int(player);
if ((index > 0) &&
(index < players_size) &&
@@ -3135,16 +3125,16 @@ static XEN g_player_home(XEN player)
if ((cp->sound) &&
(cp->sound->active))
- return(XEN_LIST_2(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan)));
- return(XEN_FALSE); /* can this happen? */
+ return(Xen_list_2(C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan)));
+ return(Xen_false); /* can this happen? */
}
return(no_such_player_error(S_player_home, player));
}
-static XEN g_add_player(XEN player, XEN start, XEN end, XEN edpos, XEN stop_proc, XEN out_chan)
+static Xen g_add_player(Xen player, Xen start, Xen end, Xen edpos, Xen stop_proc, Xen out_chan)
{
#define H_add_player "(" S_add_player " player :optional (start 0) (end len) (pos -1) stop-proc (out-chan player-chan)): \
adds a player to the play list; the play begins when " S_start_playing " is called. \
@@ -3158,16 +3148,16 @@ channel number in the sound that contains the channel being played."
dac_info *dp = NULL;
int i, ochan = -1;
- XEN_ASSERT_TYPE(XEN_PLAYER_P(player), player, XEN_ARG_1, S_add_player, "a player");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(start), start, XEN_ARG_2, S_add_player, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(end), end, XEN_ARG_3, S_add_player, "a number");
- XEN_ASSERT_TYPE(((XEN_PROCEDURE_P(stop_proc)) && (procedure_arity_ok(stop_proc, 1))) ||
- (XEN_NOT_BOUND_P(stop_proc)) ||
- (XEN_FALSE_P(stop_proc)),
- stop_proc, XEN_ARG_5, S_add_player, "a procedure of 1 arg");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(out_chan), out_chan, XEN_ARG_6, S_add_player, "an integer");
+ Xen_check_type(xen_is_player(player), player, 1, S_add_player, "a player");
+ Xen_check_type(Xen_is_integer_or_unbound(start), start, 2, S_add_player, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(end), end, 3, S_add_player, "an integer");
+ Xen_check_type(((Xen_is_procedure(stop_proc)) && (procedure_arity_ok(stop_proc, 1))) ||
+ (!Xen_is_bound(stop_proc)) ||
+ (Xen_is_false(stop_proc)),
+ stop_proc, 5, S_add_player, "a procedure of 1 arg");
+ Xen_check_type(Xen_is_integer_or_unbound(out_chan), out_chan, 6, S_add_player, "an integer");
- index = XEN_PLAYER_TO_C_INT(player);
+ index = Xen_player_to_C_int(player);
if ((index > 0) && (index < players_size))
sp = players[index];
@@ -3178,64 +3168,64 @@ channel number in the sound that contains the channel being played."
for (i = 0; i < dac_max_sounds; i++)
if ((play_list[i]) &&
(sp == (play_list[i]->sp)))
- XEN_ERROR(XEN_ERROR_TYPE("arg-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_add_player ": player ~A is already in the play list"),
+ Xen_error(Xen_make_error_type("arg-error"),
+ Xen_list_2(C_string_to_Xen_string(S_add_player ": player ~A is already in the play list"),
player));
cp = sp->chans[player_chans[index]];
- pos = to_c_edit_position(cp, edpos, S_add_player, XEN_ARG_4);
- if (XEN_INTEGER_P(out_chan)) ochan = XEN_TO_C_INT(out_chan);
+ pos = to_c_edit_position(cp, edpos, S_add_player, 4);
+ if (Xen_is_integer(out_chan)) ochan = Xen_integer_to_C_int(out_chan);
if (ochan < 0) ochan = cp->chan;
dp = add_channel_to_play_list(cp,
sp, /* this is not cp->sound! */
beg_to_sample(start, S_add_player),
- XEN_TO_C_INT64_T_OR_ELSE(end, NO_END_SPECIFIED),
+ (Xen_is_llong(end)) ? Xen_llong_to_C_llong(end) : NO_END_SPECIFIED,
pos,
ochan);
- if (dp == NULL) return(XEN_FALSE);
+ if (dp == NULL) return(Xen_false);
dp->stop_procedure = stop_proc;
- if (XEN_PROCEDURE_P(stop_proc))
+ if (Xen_is_procedure(stop_proc))
dp->stop_procedure_gc_loc = snd_protect(stop_proc);
return(player);
}
-static XEN g_start_playing(XEN Chans, XEN Srate, XEN In_Background)
+static Xen g_start_playing(Xen Chans, Xen Srate, Xen In_Background)
{
#define H_start_playing "(" S_start_playing " :optional (chans 1) (srate 44100) (in-background " PROC_TRUE ")): \
If a play-list is waiting, start it."
- int chans, srate;
+ int chans = 1, srate = 44100;
bool back;
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(Chans), Chans, XEN_ARG_1, S_start_playing, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(Srate), Srate, XEN_ARG_2, S_start_playing, "a number");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(In_Background), In_Background, XEN_ARG_3, S_start_playing, "a boolean");
+ Xen_check_type(Xen_is_integer_or_unbound(Chans), Chans, 1, S_start_playing, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(Srate), Srate, 2, S_start_playing, "an integer");
+ Xen_check_type(Xen_is_boolean_or_unbound(In_Background), In_Background, 3, S_start_playing, "a boolean");
- chans = XEN_TO_C_INT_OR_ELSE(Chans, 1);
+ if (Xen_is_integer(Chans)) chans = Xen_integer_to_C_int(Chans);
if ((chans <= 0) || (chans > 256))
- XEN_OUT_OF_RANGE_ERROR(S_start_playing, 1, Chans, "chans ~A <= 0 or > 256?");
+ Xen_out_of_range_error(S_start_playing, 1, Chans, "chans <= 0 or > 256?");
- srate = XEN_TO_C_INT_OR_ELSE(Srate, 44100);
+ if (Xen_is_integer(Srate)) srate = Xen_integer_to_C_int(Srate);
if (srate <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_start_playing, 2, Srate, "srate ~A <= 0?");
+ Xen_out_of_range_error(S_start_playing, 2, Srate, "srate <= 0?");
- back = XEN_TO_C_BOOLEAN(In_Background);
+ back = Xen_boolean_to_C_bool(In_Background);
start_dac(srate, chans, (back) ? IN_BACKGROUND : NOT_IN_BACKGROUND, DEFAULT_REVERB_CONTROL_DECAY);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_stop_player(XEN player)
+static Xen g_stop_player(Xen player)
{
- #define H_stop_player "(" S_stop_player " player): stop player (remove its associated sound from the current DAC playlist)"
+ #define H_stop_player "(" S_stop_player " player): stop player and remove its associated sound from the current DAC playlist"
snd_info *sp = NULL;
- XEN_ASSERT_TYPE(XEN_PLAYER_P(player), player, XEN_ONLY_ARG, S_stop_player, "a player");
+ Xen_check_type(xen_is_player(player), player, 1, S_stop_player, "a player");
sp = get_player_sound(player);
if (sp)
@@ -3244,93 +3234,92 @@ static XEN g_stop_player(XEN player)
}
-static XEN g_free_player(XEN player)
+static Xen g_free_player(Xen player)
{
- #define H_free_player "(" S_free_player " player): free all resources associated with 'player' and remove it from the current DAC playlist)"
+ #define H_free_player "(" S_free_player " player): free all resources associated with 'player' and remove it from the current DAC playlist"
snd_info *sp = NULL;
- XEN_ASSERT_TYPE(XEN_PLAYER_P(player), player, XEN_ONLY_ARG, S_free_player, "a player");
+ Xen_check_type(xen_is_player(player), player, 1, S_free_player, "a player");
sp = get_player_sound(player);
if (sp)
free_player_sound(sp);
- return(XEN_FALSE);
+ return(Xen_false);
}
/* also the dac filler needs to run on empty buffers in this case? */
-static XEN g_player_p(XEN obj)
+static Xen g_is_player(Xen obj)
{
- #define H_player_p "(" S_player_p " obj): is 'obj' an active player"
- int index;
-
- if (XEN_PLAYER_P(obj))
+ #define H_is_player "(" S_is_player " obj): is 'obj' an active player"
+ if (xen_is_player(obj))
{
- index = XEN_PLAYER_TO_C_INT(obj);
- return(C_TO_XEN_BOOLEAN((index > 0) &&
+ int index;
+ index = Xen_player_to_C_int(obj);
+ return(C_bool_to_Xen_boolean((index > 0) &&
(index < players_size) &&
(players[index])));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-/* player-position? -- need quick way from index to dp to its sampler, then C_TO_XEN_INT64_T(current_location(fd)) */
+/* player-position? -- need quick way from index to dp to its sampler, then C_llong_to_Xen_llong(current_location(fd)) */
-static XEN g_players(void)
+static Xen g_players(void)
{
#define H_players "(" S_players ") -> list of currently active players."
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
int i;
for (i = 0; i < players_size; i++)
if (players[i])
- lst = XEN_CONS(C_INT_TO_XEN_PLAYER(i), lst);
+ lst = Xen_cons(C_int_to_Xen_player(i), lst);
return(lst);
}
-static XEN g_dac_size(void) {return(C_TO_XEN_INT(dac_size(ss)));}
+static Xen g_dac_size(void) {return(C_int_to_Xen_integer(dac_size(ss)));}
-static XEN g_set_dac_size(XEN val)
+static Xen g_set_dac_size(Xen val)
{
- #define H_dac_size "(" S_dac_size "): the current DAC buffer size in frames (256)"
+ #define H_dac_size "(" S_dac_size "): the current DAC buffer size in framples (256)"
int len;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_dac_size, "a number");
- len = XEN_TO_C_INT_OR_ELSE(val, 0);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_dac_size, "an integer");
+ len = Xen_integer_to_C_int(val);
if (len > 0)
set_dac_size(len); /* macro in snd-0.h */
- return(C_TO_XEN_INT(dac_size(ss)));
+ return(C_int_to_Xen_integer(dac_size(ss)));
}
-static XEN g_dac_combines_channels(void) {return(C_TO_XEN_BOOLEAN(dac_combines_channels(ss)));}
+static Xen g_dac_combines_channels(void) {return(C_bool_to_Xen_boolean(dac_combines_channels(ss)));}
-static XEN g_set_dac_combines_channels(XEN val)
+static Xen g_set_dac_combines_channels(Xen val)
{
#define H_dac_combines_channels "(" S_dac_combines_channels "): " PROC_TRUE " if extra channels are to be mixed into available ones during playing. \
That is, if the sound to be played has 4 channels, but the DAC can only handle 2, if this \
variable is " PROC_TRUE ", the extra channels are mixed into the available ones; otherwise they are ignored."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_dac_combines_channels, "a boolean");
- set_dac_combines_channels(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(dac_combines_channels(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_dac_combines_channels, "a boolean");
+ set_dac_combines_channels(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(dac_combines_channels(ss)));
}
-static XEN g_playing(void)
+static Xen g_playing(void)
{
#define H_playing "(" S_playing "): " PROC_TRUE " if sound output is in progress. If players are waiting to start, \
setting this to " PROC_TRUE " starts them; setting it to " PROC_FALSE " stops output."
- return(C_TO_XEN_BOOLEAN(playing()));
+ return(C_bool_to_Xen_boolean(something_is_playing()));
}
-static XEN g_set_playing(XEN on)
+static Xen g_set_playing(Xen on)
{
bool starting = false;
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ONLY_ARG, S_setB S_playing, "a boolean");
- starting = XEN_TO_C_BOOLEAN(on);
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_playing, "a boolean");
+ starting = Xen_boolean_to_C_bool(on);
if (starting)
start_dac((int)mus_srate(), 1, IN_BACKGROUND, DEFAULT_REVERB_CONTROL_DECAY); /* how to get plausible srate chans here? */
else stop_playing_all_sounds(PLAY_STOP_CALLED);
@@ -3338,123 +3327,142 @@ static XEN g_set_playing(XEN on)
}
-static XEN g_pausing(void)
+static Xen g_pausing(void)
{
- #define H_pausing "(" S_pausing "): " PROC_TRUE " if sound output is currently pausing (settable."
- return(C_TO_XEN_BOOLEAN(dac_pausing));
+ #define H_pausing "(" S_pausing "): " PROC_TRUE " if sound output is currently pausing (this can be set)."
+ return(C_bool_to_Xen_boolean(dac_pausing));
}
-static XEN g_set_pausing(XEN pause)
+static Xen g_set_pausing(Xen pause)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(pause), pause, XEN_ONLY_ARG, S_setB S_pausing, "a boolean");
- dac_pausing = XEN_TO_C_BOOLEAN(pause);
+ Xen_check_type(Xen_is_boolean(pause), pause, 1, S_set S_pausing, "a boolean");
+ dac_pausing = Xen_boolean_to_C_bool(pause);
play_button_pause(dac_pausing);
return(pause);
}
-static XEN g_cursor_update_interval(void) {return(C_TO_XEN_DOUBLE(cursor_update_interval(ss)));}
+static Xen g_cursor_update_interval(void) {return(C_double_to_Xen_real(cursor_update_interval(ss)));}
-static XEN g_set_cursor_update_interval(XEN val)
+static Xen g_set_cursor_update_interval(Xen val)
{
mus_float_t ctime;
#define H_cursor_update_interval "(" S_cursor_update_interval "): time (seconds) between cursor updates if " S_with_tracking_cursor "."
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_cursor_update_interval, "a number");
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_cursor_update_interval, "a number");
- ctime = XEN_TO_C_DOUBLE(val);
+ ctime = Xen_real_to_C_double(val);
if ((ctime < 0.0) || (ctime > (24 * 3600)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_cursor_update_interval, 1, val, "~A: invalid time");
+ Xen_out_of_range_error(S_set S_cursor_update_interval, 1, val, "invalid time");
set_cursor_update_interval(ctime);
- return(C_TO_XEN_DOUBLE(cursor_update_interval(ss)));
+ return(C_double_to_Xen_real(cursor_update_interval(ss)));
}
-static XEN g_cursor_location_offset(void) {return(C_TO_XEN_INT(cursor_location_offset(ss)));}
+static Xen g_cursor_location_offset(void) {return(C_int_to_Xen_integer(cursor_location_offset(ss)));}
-static XEN g_set_cursor_location_offset(XEN val)
+static Xen g_set_cursor_location_offset(Xen val)
{
int ctime;
#define H_cursor_location_offset "(" S_cursor_location_offset "): samples added to cursor location if cursor displayed during play."
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_cursor_location_offset, "an integer");
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_cursor_location_offset, "an integer");
- ctime = XEN_TO_C_INT(val);
+ ctime = Xen_integer_to_C_int(val);
set_cursor_location_offset(ctime);
- return(C_TO_XEN_INT(cursor_location_offset(ss)));
+ return(C_int_to_Xen_integer(cursor_location_offset(ss)));
}
-static XEN g_with_tracking_cursor(void)
+static Xen g_with_tracking_cursor(void)
{
#define H_with_tracking_cursor "(" S_with_tracking_cursor "): " PROC_TRUE " if cursor always moves along in waveform display as sound is played"
- return(C_TO_XEN_BOOLEAN(with_tracking_cursor(ss) == ALWAYS_TRACK));
+ if (with_tracking_cursor(ss) == DONT_TRACK)
+ return(Xen_false);
+ if (with_tracking_cursor(ss) == TRACK_AND_RETURN)
+ return(Xen_true);
+ return(Xen_make_keyword("track-and-stay"));
}
-static XEN g_set_with_tracking_cursor(XEN on)
+static Xen g_set_with_tracking_cursor(Xen on)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ONLY_ARG, S_setB S_with_tracking_cursor, "a boolean");
- set_with_tracking_cursor(ss, (XEN_TO_C_BOOLEAN(on)) ? ALWAYS_TRACK : TRACK_IF_ASKED);
- return(C_TO_XEN_BOOLEAN(with_tracking_cursor(ss) == ALWAYS_TRACK));
+ if (Xen_is_boolean(on)) /* for backwards compatibility */
+ {
+ set_with_tracking_cursor(ss, (Xen_boolean_to_C_bool(on)) ? TRACK_AND_RETURN : DONT_TRACK);
+ return(on);
+ }
+
+ if (Xen_is_integer(on))
+ {
+ int val;
+ val = Xen_integer_to_C_int(on);
+ if (val == 2)
+ set_with_tracking_cursor(ss, TRACK_AND_STAY);
+ else set_with_tracking_cursor(ss, ((val == 1) ? TRACK_AND_RETURN : DONT_TRACK));
+ return(C_int_to_Xen_integer((int)with_tracking_cursor(ss)));
+ }
+
+ if (Xen_is_keyword(on))
+ {
+ if (Xen_keyword_is_eq(on, Xen_make_keyword("track-and-return")))
+ {
+ set_with_tracking_cursor(ss, TRACK_AND_RETURN);
+ return(on);
+ }
+ if (Xen_keyword_is_eq(on, Xen_make_keyword("track-and-stay")))
+ {
+ set_with_tracking_cursor(ss, TRACK_AND_STAY);
+ return(on);
+ }
+ if (Xen_keyword_is_eq(on, Xen_make_keyword("dont-track")))
+ {
+ set_with_tracking_cursor(ss, DONT_TRACK);
+ return(on);
+ }
+ }
+
+ Xen_check_type(false, on, 1, S_set S_with_tracking_cursor, ":dont-track, :track-and-return, or :track-and-stay");
+ return(on);
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_with_tracking_cursor_w, g_with_tracking_cursor)
-XEN_NARGIFY_1(g_set_with_tracking_cursor_w, g_set_with_tracking_cursor)
-XEN_VARGIFY(g_play_w, g_play)
-XEN_ARGIFY_1(g_stop_playing_w, g_stop_playing)
-XEN_ARGIFY_2(g_make_player_w, g_make_player)
-XEN_ARGIFY_6(g_add_player_w, g_add_player)
-XEN_NARGIFY_1(g_player_home_w, g_player_home)
-XEN_ARGIFY_3(g_start_playing_w, g_start_playing)
-XEN_NARGIFY_1(g_stop_player_w, g_stop_player)
-XEN_NARGIFY_1(g_free_player_w, g_free_player)
-XEN_NARGIFY_0(g_players_w, g_players)
-XEN_NARGIFY_1(g_player_p_w, g_player_p)
-XEN_NARGIFY_0(g_dac_size_w, g_dac_size)
-XEN_NARGIFY_1(g_set_dac_size_w, g_set_dac_size)
-XEN_NARGIFY_0(g_dac_combines_channels_w, g_dac_combines_channels)
-XEN_NARGIFY_1(g_set_dac_combines_channels_w, g_set_dac_combines_channels)
-XEN_NARGIFY_0(g_playing_w, g_playing)
-XEN_NARGIFY_1(g_set_playing_w, g_set_playing)
-XEN_NARGIFY_0(g_pausing_w, g_pausing)
-XEN_NARGIFY_1(g_set_pausing_w, g_set_pausing)
-XEN_NARGIFY_0(g_cursor_update_interval_w, g_cursor_update_interval)
-XEN_NARGIFY_1(g_set_cursor_update_interval_w, g_set_cursor_update_interval)
-XEN_NARGIFY_0(g_cursor_location_offset_w, g_cursor_location_offset)
-XEN_NARGIFY_1(g_set_cursor_location_offset_w, g_set_cursor_location_offset)
-#else
-#define g_with_tracking_cursor_w g_with_tracking_cursor
-#define g_set_with_tracking_cursor_w g_set_with_tracking_cursor
-#define g_play_w g_play
-#define g_stop_playing_w g_stop_playing
-#define g_make_player_w g_make_player
-#define g_add_player_w g_add_player
-#define g_player_home_w g_player_home
-#define g_start_playing_w g_start_playing
-#define g_stop_player_w g_stop_player
-#define g_free_player_w g_free_player
-#define g_players_w g_players
-#define g_player_p_w g_player_p
-#define g_dac_size_w g_dac_size
-#define g_set_dac_size_w g_set_dac_size
-#define g_dac_combines_channels_w g_dac_combines_channels
-#define g_set_dac_combines_channels_w g_set_dac_combines_channels
-#define g_playing_w g_playing
-#define g_set_playing_w g_set_playing
-#define g_pausing_w g_pausing
-#define g_set_pausing_w g_set_pausing
-#define g_cursor_update_interval_w g_cursor_update_interval
-#define g_set_cursor_update_interval_w g_set_cursor_update_interval
-#define g_cursor_location_offset_w g_cursor_location_offset
-#define g_set_cursor_location_offset_w g_set_cursor_location_offset
+Xen_wrap_no_args(g_with_tracking_cursor_w, g_with_tracking_cursor)
+Xen_wrap_1_arg(g_set_with_tracking_cursor_w, g_set_with_tracking_cursor)
+Xen_wrap_any_args(g_play_w, g_play)
+Xen_wrap_1_optional_arg(g_stop_playing_w, g_stop_playing)
+Xen_wrap_2_optional_args(g_make_player_w, g_make_player)
+Xen_wrap_6_optional_args(g_add_player_w, g_add_player)
+Xen_wrap_1_arg(g_player_home_w, g_player_home)
+Xen_wrap_3_optional_args(g_start_playing_w, g_start_playing)
+Xen_wrap_1_arg(g_stop_player_w, g_stop_player)
+Xen_wrap_1_arg(g_free_player_w, g_free_player)
+Xen_wrap_no_args(g_players_w, g_players)
+Xen_wrap_1_arg(g_is_player_w, g_is_player)
+Xen_wrap_no_args(g_dac_size_w, g_dac_size)
+Xen_wrap_1_arg(g_set_dac_size_w, g_set_dac_size)
+Xen_wrap_no_args(g_dac_combines_channels_w, g_dac_combines_channels)
+Xen_wrap_1_arg(g_set_dac_combines_channels_w, g_set_dac_combines_channels)
+Xen_wrap_no_args(g_playing_w, g_playing)
+Xen_wrap_1_arg(g_set_playing_w, g_set_playing)
+Xen_wrap_no_args(g_pausing_w, g_pausing)
+Xen_wrap_1_arg(g_set_pausing_w, g_set_pausing)
+Xen_wrap_no_args(g_cursor_update_interval_w, g_cursor_update_interval)
+Xen_wrap_1_arg(g_set_cursor_update_interval_w, g_set_cursor_update_interval)
+Xen_wrap_no_args(g_cursor_location_offset_w, g_cursor_location_offset)
+Xen_wrap_1_arg(g_set_cursor_location_offset_w, g_set_cursor_location_offset)
+
+#if HAVE_SCHEME
+static s7_pointer acc_cursor_location_offset(s7_scheme *sc, s7_pointer args) {return(g_set_cursor_location_offset(s7_cadr(args)));}
+static s7_pointer acc_cursor_update_interval(s7_scheme *sc, s7_pointer args) {return(g_set_cursor_update_interval(s7_cadr(args)));}
+static s7_pointer acc_dac_combines_channels(s7_scheme *sc, s7_pointer args) {return(g_set_dac_combines_channels(s7_cadr(args)));}
+static s7_pointer acc_dac_size(s7_scheme *sc, s7_pointer args) {return(g_set_dac_size(s7_cadr(args)));}
+static s7_pointer acc_with_tracking_cursor(s7_scheme *sc, s7_pointer args) {return(g_set_with_tracking_cursor(s7_cadr(args)));}
#endif
void g_init_dac(void)
@@ -3462,70 +3470,61 @@ void g_init_dac(void)
init_xen_player();
init_play_keywords();
- XEN_DEFINE_PROCEDURE(S_play, g_play_w, 0, 0, 1, H_play);
- XEN_DEFINE_PROCEDURE(S_stop_playing, g_stop_playing_w, 0, 1, 0, H_stop_playing);
+ Xen_define_procedure(S_play, g_play_w, 0, 0, 1, H_play);
+ Xen_define_procedure(S_stop_playing, g_stop_playing_w, 0, 1, 0, H_stop_playing);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_pausing, g_pausing_w, H_pausing, S_setB S_pausing, g_set_pausing_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_playing, g_playing_w, H_playing, S_setB S_playing, g_set_playing_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_pausing, g_pausing_w, H_pausing, S_set S_pausing, g_set_pausing_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_playing, g_playing_w, H_playing, S_set S_playing, g_set_playing_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE(S_make_player, g_make_player_w, 0, 2, 0, H_make_player);
- XEN_DEFINE_PROCEDURE(S_add_player, g_add_player_w, 1, 5, 0, H_add_player);
- XEN_DEFINE_PROCEDURE(S_player_home, g_player_home_w, 1, 0, 0, H_player_home);
- XEN_DEFINE_PROCEDURE(S_start_playing, g_start_playing_w, 0, 3, 0, H_start_playing);
- XEN_DEFINE_PROCEDURE(S_stop_player, g_stop_player_w, 1, 0, 0, H_stop_player);
- XEN_DEFINE_PROCEDURE(S_free_player, g_free_player_w, 1, 0, 0, H_free_player);
- XEN_DEFINE_PROCEDURE(S_players, g_players_w, 0, 0, 0, H_players);
- XEN_DEFINE_PROCEDURE(S_player_p, g_player_p_w, 1, 0, 0, H_player_p);
+ Xen_define_procedure(S_make_player, g_make_player_w, 0, 2, 0, H_make_player);
+ Xen_define_procedure(S_add_player, g_add_player_w, 1, 5, 0, H_add_player);
+ Xen_define_safe_procedure(S_player_home, g_player_home_w, 1, 0, 0, H_player_home);
+ Xen_define_procedure(S_start_playing, g_start_playing_w, 0, 3, 0, H_start_playing);
+ Xen_define_procedure(S_stop_player, g_stop_player_w, 1, 0, 0, H_stop_player);
+ Xen_define_procedure(S_free_player, g_free_player_w, 1, 0, 0, H_free_player);
+ Xen_define_safe_procedure(S_players, g_players_w, 0, 0, 0, H_players);
+ Xen_define_safe_procedure(S_is_player, g_is_player_w, 1, 0, 0, H_is_player);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_tracking_cursor, g_with_tracking_cursor_w, H_with_tracking_cursor,
- S_setB S_with_tracking_cursor, g_set_with_tracking_cursor_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_with_tracking_cursor, g_with_tracking_cursor_w, H_with_tracking_cursor,
+ S_set S_with_tracking_cursor, g_set_with_tracking_cursor_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_dac_size, g_dac_size_w, H_dac_size,
- S_setB S_dac_size, g_set_dac_size_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_dac_size, g_dac_size_w, H_dac_size,
+ S_set S_dac_size, g_set_dac_size_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_dac_combines_channels, g_dac_combines_channels_w, H_dac_combines_channels,
- S_setB S_dac_combines_channels, g_set_dac_combines_channels_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_dac_combines_channels, g_dac_combines_channels_w, H_dac_combines_channels,
+ S_set S_dac_combines_channels, g_set_dac_combines_channels_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_cursor_update_interval, g_cursor_update_interval_w, H_cursor_update_interval,
- S_setB S_cursor_update_interval, g_set_cursor_update_interval_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_cursor_update_interval, g_cursor_update_interval_w, H_cursor_update_interval,
+ S_set S_cursor_update_interval, g_set_cursor_update_interval_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_cursor_location_offset, g_cursor_location_offset_w, H_cursor_location_offset,
- S_setB S_cursor_location_offset, g_set_cursor_location_offset_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_cursor_location_offset, g_cursor_location_offset_w, H_cursor_location_offset,
+ S_set S_cursor_location_offset, g_set_cursor_location_offset_w, 0, 0, 1, 0);
#define H_stop_playing_hook S_stop_playing_hook " (snd): called when a sound finishes playing."
- #define H_play_hook S_play_hook " (samps): called each time a buffer is sent to the DAC."
+ #define H_play_hook S_play_hook " (size): called each time a buffer is sent to the DAC."
#define H_start_playing_hook S_start_playing_hook " (snd): called when a play request is triggered. \
If it returns " PROC_TRUE ", the sound is not played."
- #define H_dac_hook S_dac_hook " (sdobj): called just before data is sent to DAC passing data as sound-data object"
- #define H_stop_dac_hook S_stop_dac_hook " (): called upon mus_audio_close (when DAC is turned off)"
+
#define H_stop_playing_selection_hook S_stop_playing_selection_hook " (): called when the selection stops playing"
#define H_start_playing_selection_hook S_start_playing_selection_hook " (): called when the selection starts playing"
- stop_playing_hook = XEN_DEFINE_HOOK(S_stop_playing_hook, 1, H_stop_playing_hook); /* arg = sound */
- start_playing_hook = XEN_DEFINE_HOOK(S_start_playing_hook, 1, H_start_playing_hook); /* arg = sound */
- play_hook = XEN_DEFINE_HOOK(S_play_hook, 1, H_play_hook); /* args = size */
- dac_hook = XEN_DEFINE_HOOK(S_dac_hook, 1, H_dac_hook); /* args = data as sound_data obj */
- stop_dac_hook = XEN_DEFINE_HOOK(S_stop_dac_hook, 0, H_stop_dac_hook); /* no args */
- stop_playing_selection_hook = XEN_DEFINE_HOOK(S_stop_playing_selection_hook, 0, H_stop_playing_selection_hook); /* no args */
- start_playing_selection_hook = XEN_DEFINE_HOOK(S_start_playing_selection_hook, 0, H_start_playing_selection_hook); /* no args */
-
- sdobj = XEN_FALSE;
- sdobj_loc = NOT_A_GC_LOC;
-
- /* SOMEDAY: extend rest of play args to other cases like play-region */
+ stop_playing_hook = Xen_define_hook(S_stop_playing_hook, "(make-hook 'snd)", 1, H_stop_playing_hook);
+ start_playing_hook = Xen_define_hook(S_start_playing_hook, "(make-hook 'snd)", 1, H_start_playing_hook);
+ play_hook = Xen_define_hook(S_play_hook, "(make-hook 'size)", 1, H_play_hook);
+ stop_playing_selection_hook = Xen_define_hook(S_stop_playing_selection_hook, "(make-hook)", 0, H_stop_playing_selection_hook);
+ start_playing_selection_hook = Xen_define_hook(S_start_playing_selection_hook, "(make-hook)", 0, H_start_playing_selection_hook);
-
- /* backwards compatibility for c-g! */
#if HAVE_SCHEME
- XEN_EVAL_C_STRING("(define c-g! stop-playing)");
-#endif
-
-#if HAVE_RUBY
- XEN_EVAL_C_STRING("def c_g! () stop_playing end");
+ s7_symbol_set_access(s7, ss->cursor_location_offset_symbol, s7_make_function(s7, "[acc-" S_cursor_location_offset "]", acc_cursor_location_offset, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->cursor_update_interval_symbol, s7_make_function(s7, "[acc-" S_cursor_update_interval "]", acc_cursor_update_interval, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->dac_combines_channels_symbol, s7_make_function(s7, "[acc-" S_dac_combines_channels "]", acc_dac_combines_channels, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->dac_size_symbol, s7_make_function(s7, "[acc-" S_dac_size "]", acc_dac_size, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_tracking_cursor_symbol, s7_make_function(s7, "[acc-" S_with_tracking_cursor "]", acc_with_tracking_cursor, 2, 0, false, "accessor"));
+
+ s7_symbol_set_documentation(s7, ss->cursor_location_offset_symbol, "*cursor-location-offset*: samples added to cursor location if cursor displayed during play.");
+ s7_symbol_set_documentation(s7, ss->cursor_update_interval_symbol, "*cursor-update-interval*: time (seconds) between cursor updates if with-tracking-cursor.");
+ s7_symbol_set_documentation(s7, ss->dac_combines_channels_symbol, "*dac-combines-channels*: #t if extra channels are to be mixed into available ones during playing.");
+ s7_symbol_set_documentation(s7, ss->dac_size_symbol, "*dac-size*: the current DAC buffer size in framples (256)");
+ s7_symbol_set_documentation(s7, ss->with_tracking_cursor_symbol, "*with-tracking-cursor*: #t if cursor always moves along in waveform display as sound is played");
#endif
-
-#if HAVE_FORTH
- XEN_EVAL_C_STRING("<'> stop-playing alias c-g!");
-#endif
-
}
diff --git a/snd-data.c b/snd-data.c
index 4c12b2c..dc7de16 100644
--- a/snd-data.c
+++ b/snd-data.c
@@ -14,7 +14,7 @@ chan_info *make_chan_info(chan_info *cip, int chan, snd_info *sound)
case 0: cp->combined_data_color = ss->black; break;
case 1: cp->combined_data_color = ss->red; break;
case 2: cp->combined_data_color = ss->green; break;
- case 3: cp->combined_data_color = ss->light_blue; break;
+ case 3: cp->combined_data_color = ss->blue; break;
}
#if USE_GTK
cp->progress_pct = -1.0;
@@ -27,13 +27,13 @@ chan_info *make_chan_info(chan_info *cip, int chan, snd_info *sound)
cp->gl_fft_list = NO_LIST;
cp->gl_wavo_list = NO_LIST;
#endif
- cp->edit_hook = XEN_FALSE;
+ cp->edit_hook = Xen_false;
cp->edit_hook_loc = NOT_A_GC_LOC;
- cp->after_edit_hook = XEN_FALSE;
+ cp->after_edit_hook = Xen_false;
cp->after_edit_hook_loc = NOT_A_GC_LOC;
- cp->undo_hook = XEN_FALSE;
+ cp->undo_hook = Xen_false;
cp->undo_hook_loc = NOT_A_GC_LOC;
- cp->properties = XEN_FALSE; /* will be a vector of 1 element if it's ever used */
+ cp->properties = Xen_false; /* will be a vector of 1 element if it's ever used */
cp->properties_loc = NOT_A_GC_LOC;
cp->active = CHANNEL_INACTIVE;
}
@@ -43,9 +43,6 @@ chan_info *make_chan_info(chan_info *cip, int chan, snd_info *sound)
cp->sound_ctr = NOT_A_SOUND;
cp->edit_ctr = -1;
cp->sound_size = 0;
- cp->ptrees = NULL;
- cp->ptree_size = 0;
- cp->ptree_ctr = -1;
cp->edit_size = 0;
cp->cursor_on = false;
cp->cursor_visible = false;
@@ -56,7 +53,7 @@ chan_info *make_chan_info(chan_info *cip, int chan, snd_info *sound)
cp->cursor_style = cursor_style(ss);
cp->tracking_cursor_style = tracking_cursor_style(ss);
cp->cursor_size = cursor_size(ss);
- cp->cursor_proc = XEN_UNDEFINED;
+ cp->cursor_proc = Xen_undefined;
cp->cursor_proc_loc = NOT_A_GC_LOC;
cp->squelch_update = false;
cp->show_y_zero = show_y_zero(ss);
@@ -68,7 +65,7 @@ chan_info *make_chan_info(chan_info *cip, int chan, snd_info *sound)
cp->max_transform_peaks = max_transform_peaks(ss);
cp->show_transform_peaks = show_transform_peaks(ss);
cp->zero_pad = zero_pad(ss);
- cp->verbose_cursor = verbose_cursor(ss);
+ cp->with_verbose_cursor = with_verbose_cursor(ss);
cp->fft_log_frequency = fft_log_frequency(ss);
cp->fft_log_magnitude = fft_log_magnitude(ss);
cp->fft_with_phases = fft_with_phases(ss);
@@ -103,8 +100,8 @@ chan_info *make_chan_info(chan_info *cip, int chan, snd_info *sound)
cp->beats_per_minute = beats_per_minute(ss);
cp->beats_per_measure = beats_per_measure(ss);
cp->show_axes = show_axes(ss);
- cp->graph_time_p = true; /* the default state (button is set when we start) */
- cp->graph_transform_p = false;
+ cp->graph_time_on = true; /* the default state (button is set when we start) */
+ cp->graph_transform_on = false;
cp->printing = NOT_PRINTING;
cp->waiting_to_make_graph = false;
cp->new_peaks = false;
@@ -116,7 +113,6 @@ chan_info *make_chan_info(chan_info *cip, int chan, snd_info *sound)
cp->cy = 0;
cp->fft_cx = 0;
cp->selection_transform_size = 0;
- cp->last_search_result = SEARCH_OK;
if (cp->last_sonogram)
{
free(cp->last_sonogram);
@@ -141,7 +137,7 @@ static chan_info *free_chan_info(chan_info *cp)
cp->active = CHANNEL_INACTIVE;
/* need an indication right away that this channel is being deleted -- during free_snd_info (close-sound),
* an error may occur (an edit list temp file might have vanished for example), and normally Snd
- * attempts to post an error message in the sound's minibuffer. To force this out, we have to
+ * attempts to post an error message in the sound's status area. To force this out, we have to
* call XmUpdate or equivalent, which can cause all the sound's channels to attempt to redisplay;
* since the one causing the error is half-deallocated, trouble can ensue. So both the channel
* and the sound have "active" flags that are true only when everything is ship-shape.
@@ -151,12 +147,11 @@ static chan_info *free_chan_info(chan_info *cp)
cp->axis = free_axis_info(cp->axis);
if (cp->fft) cp->fft = free_fft_info(cp->fft);
cp_free_fft_state(cp);
- cp->graph_transform_p = false;
+ cp->graph_transform_on = false;
cp->printing = NOT_PRINTING;
- cp->graph_time_p = true;
+ cp->graph_time_on = true;
if (cp->edits) free_edit_list(cp);
if (cp->sounds) free_sound_list(cp);
- if (cp->ptrees) free_ptree_list(cp);
free_channel_mixes(cp);
cp->sound = NULL; /* a backpointer */
cp->cursor_on = false;
@@ -170,14 +165,14 @@ static chan_info *free_chan_info(chan_info *cp)
free(cp->amp_control);
cp->amp_control = NULL;
}
- if (XEN_PROCEDURE_P(cp->cursor_proc))
+ if (Xen_is_procedure(cp->cursor_proc))
{
snd_unprotect_at(cp->cursor_proc_loc);
- cp->cursor_proc = XEN_UNDEFINED;
+ cp->cursor_proc = Xen_undefined;
cp->cursor_proc_loc = NOT_A_GC_LOC;
}
- if (XEN_VECTOR_P(cp->properties)) /* using vector as node for GC */
- XEN_VECTOR_SET(cp->properties, 0, XEN_EMPTY_LIST);
+ if (Xen_is_vector(cp->properties)) /* using vector as node for GC */
+ Xen_vector_set(cp->properties, 0, Xen_empty_list);
cp->waiting_to_make_graph = false;
if (cp->sonogram_data) free_sono_info(cp);
if (cp->temp_sonogram)
@@ -204,7 +199,7 @@ static chan_info *free_chan_info(chan_info *cp)
free_lisp_info(cp);
cp->lisp_info = NULL;
}
- cp->graph_lisp_p = false;
+ cp->graph_lisp_on = false;
cp->selection_transform_size = 0;
if (cp->as_one_edit_positions)
@@ -214,25 +209,25 @@ static chan_info *free_chan_info(chan_info *cp)
cp->as_one_edit_positions_size = 0;
}
- if (XEN_HOOK_P(cp->edit_hook))
+ if (Xen_is_hook(cp->edit_hook))
{
- XEN_CLEAR_HOOK(cp->edit_hook);
+ Xen_clear_hook_list(cp->edit_hook);
snd_unprotect_at(cp->edit_hook_loc);
- cp->edit_hook = XEN_FALSE;
+ cp->edit_hook = Xen_false;
cp->edit_hook_loc = NOT_A_GC_LOC;
}
- if (XEN_HOOK_P(cp->after_edit_hook))
+ if (Xen_is_hook(cp->after_edit_hook))
{
- XEN_CLEAR_HOOK(cp->after_edit_hook);
+ Xen_clear_hook_list(cp->after_edit_hook);
snd_unprotect_at(cp->after_edit_hook_loc);
- cp->after_edit_hook = XEN_FALSE;
+ cp->after_edit_hook = Xen_false;
cp->after_edit_hook_loc = NOT_A_GC_LOC;
}
- if (XEN_HOOK_P(cp->undo_hook))
+ if (Xen_is_hook(cp->undo_hook))
{
- XEN_CLEAR_HOOK(cp->undo_hook);
+ Xen_clear_hook_list(cp->undo_hook);
snd_unprotect_at(cp->undo_hook_loc);
- cp->undo_hook = XEN_FALSE;
+ cp->undo_hook = Xen_false;
cp->undo_hook_loc = NOT_A_GC_LOC;
}
if (cp->inset_graph)
@@ -248,21 +243,10 @@ snd_info *make_basic_snd_info(int chans)
sp = (snd_info *)calloc(1, sizeof(snd_info));
sp->chans = (chan_info **)calloc(chans, sizeof(chan_info *));
sp->allocated_chans = chans;
- sp->properties = XEN_FALSE; /* will be a vector of 1 element if it's ever used */
+ sp->properties = Xen_false; /* will be a vector of 1 element if it's ever used */
sp->properties_loc = NOT_A_GC_LOC;
#if USE_NO_GUI
- sp->snd_widgets = false;
-#endif
-#if HAVE_PTHREADS
- /* multichannel cases can all try to change the "*" in the file name */
- sp->starred_name_lock = (mus_lock_t *)malloc(sizeof(mus_lock_t));
- MUS_LOCK_INIT(sp->starred_name_lock);
- /* similarly the stop and bomb icons */
- sp->stop_sign_lock = (mus_lock_t *)malloc(sizeof(mus_lock_t));
- MUS_LOCK_INIT(sp->stop_sign_lock);
- /* edit history list of multichannel file (after explicit open) */
- sp->edit_history_lock = (mus_lock_t *)malloc(sizeof(mus_lock_t));
- MUS_LOCK_INIT(sp->edit_history_lock);
+ sp->snd_widgets = false; /* it's a bool if no gui */
#endif
return(sp);
}
@@ -275,7 +259,7 @@ void initialize_control_panel(snd_info *sp)
sp->expand_control_max = expand_control_max(ss);
sp->last_expand_control = 0.0;
sp->saved_expand_control = 0.0;
- sp->expand_control_p = DEFAULT_EXPAND_CONTROL_P;
+ sp->expand_control_on = DEFAULT_EXPAND_CONTROL_ON;
sp->amp_control = DEFAULT_AMP_CONTROL;
sp->amp_control_min = amp_control_min(ss);
sp->amp_control_max = amp_control_max(ss);
@@ -287,15 +271,15 @@ void initialize_control_panel(snd_info *sp)
sp->last_speed_control = 1.0;
sp->saved_speed_control = 1.0;
if (DEFAULT_SPEED_CONTROL > 0.0) sp->speed_control_direction = 1; else sp->speed_control_direction = -1;
- sp->contrast_control_p = DEFAULT_CONTRAST_CONTROL_P;
+ sp->contrast_control_on = DEFAULT_CONTRAST_CONTROL_ON;
sp->contrast_control = DEFAULT_CONTRAST_CONTROL;
sp->contrast_control_min = contrast_control_min(ss);
sp->contrast_control_max = contrast_control_max(ss);
sp->contrast_control_amp = contrast_control_amp(ss);
sp->last_contrast_control = contrast_control_min(ss);
sp->saved_contrast_control = contrast_control_min(ss);
- sp->reverb_control_p = DEFAULT_REVERB_CONTROL_P;
- sp->filter_control_p = DEFAULT_FILTER_CONTROL_P;
+ sp->reverb_control_on = DEFAULT_REVERB_CONTROL_ON;
+ sp->filter_control_on = DEFAULT_FILTER_CONTROL_ON;
sp->expand_control_length = expand_control_length(ss);
sp->expand_control_ramp = expand_control_ramp(ss);
sp->expand_control_hop = expand_control_hop(ss);
@@ -321,7 +305,7 @@ void initialize_control_panel(snd_info *sp)
sp->filter_control_in_dB = filter_control_in_dB(ss);
sp->filter_control_in_hz = filter_control_in_hz(ss);
if (sp->filter_control_in_hz)
- sp->filter_control_xmax = (mus_float_t)(SND_SRATE(sp) / 2);
+ sp->filter_control_xmax = (mus_float_t)(snd_srate(sp) / 2);
else sp->filter_control_xmax = 1.0;
sp->filter_control_changed = false;
sp->saved_controls = NULL;
@@ -360,7 +344,6 @@ snd_info *make_snd_info(snd_info *sip, const char *filename, file_info *hdr, int
sp->sync = DEFAULT_SYNC;
sp->previous_sync = sp->sync;
initialize_control_panel(sp);
- sp->search_count = 0;
sp->selectpos = -1;
if (chans > 1)
@@ -374,20 +357,10 @@ snd_info *make_snd_info(snd_info *sip, const char *filename, file_info *hdr, int
}
else sp->channel_style = CHANNELS_SEPARATE;
- sp->loading = false;
- sp->marking = 0;
- sp->filing = NOT_FILING;
- sp->minibuffer_on = MINI_OFF;
sp->selected_channel = NO_SELECTION;
sp->playing = 0;
sp->applying = false;
- sp->search_expr = NULL;
sp->lacp = NULL;
- sp->search_tree = NULL;
- sp->search_proc = XEN_UNDEFINED;
- sp->search_proc_loc = NOT_A_GC_LOC;
- sp->prompt_callback = XEN_UNDEFINED;
- sp->prompt_callback_loc = NOT_A_GC_LOC;
sp->delete_me = NULL;
sp->name_string = NULL;
sp->active = true;
@@ -403,12 +376,12 @@ void free_snd_info(snd_info *sp)
env_editor *edp;
/* make sure trough colors are ok upon reuse */
- if (sp->reverb_control_p != DEFAULT_REVERB_CONTROL_P)
- toggle_reverb_button(sp, DEFAULT_REVERB_CONTROL_P);
- if (sp->expand_control_p != DEFAULT_EXPAND_CONTROL_P)
- toggle_expand_button(sp, DEFAULT_EXPAND_CONTROL_P);
- if (sp->contrast_control_p != DEFAULT_CONTRAST_CONTROL_P)
- toggle_contrast_button(sp, DEFAULT_CONTRAST_CONTROL_P);
+ if (sp->reverb_control_on != DEFAULT_REVERB_CONTROL_ON)
+ toggle_reverb_button(sp, DEFAULT_REVERB_CONTROL_ON);
+ if (sp->expand_control_on != DEFAULT_EXPAND_CONTROL_ON)
+ toggle_expand_button(sp, DEFAULT_EXPAND_CONTROL_ON);
+ if (sp->contrast_control_on != DEFAULT_CONTRAST_CONTROL_ON)
+ toggle_contrast_button(sp, DEFAULT_CONTRAST_CONTROL_ON);
edp = sp->flt;
if (edp)
@@ -432,27 +405,15 @@ void free_snd_info(snd_info *sp)
sp->chans[i] = free_chan_info(sp->chans[i]);
sp->inuse = SOUND_IDLE;
sp->playing = 0;
- sp->search_count = 0;
- sp->loading = false;
sp->bomb_in_progress = false;
- sp->marking = 0;
- sp->filing = NOT_FILING;
sp->applying = false;
sp->channel_style = CHANNELS_SEPARATE;
sp->user_read_only = FILE_READ_WRITE;
sp->file_read_only = FILE_READ_WRITE;
sp->need_update = false;
sp->file_unreadable = false;
- sp->minibuffer_on = MINI_OFF;
- clear_sound_search_procedure(sp, true);
- if (XEN_PROCEDURE_P(sp->prompt_callback))
- {
- snd_unprotect_at(sp->prompt_callback_loc);
- sp->prompt_callback_loc = NOT_A_GC_LOC;
- }
- sp->prompt_callback = XEN_UNDEFINED;
- if (XEN_VECTOR_P(sp->properties)) /* using vector as node for GC */
- XEN_VECTOR_SET(sp->properties, 0, XEN_EMPTY_LIST);
+ if (Xen_is_vector(sp->properties)) /* using vector as node for GC */
+ Xen_vector_set(sp->properties, 0, Xen_empty_list);
sp->selected_channel = NO_SELECTION;
sp->short_filename = NULL; /* was a pointer into filename */
if (sp->filename) free(sp->filename);
@@ -465,29 +426,26 @@ void free_snd_info(snd_info *sp)
sp->lacp = NULL;
sp->hdr = free_file_info(sp->hdr);
if (sp->edited_region) clear_region_backpointer(sp);
- clear_mini_strings(sp);
- clear_filter_strings(sp);
clear_players();
reflect_mix_change(ANY_MIX_ID);
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
}
snd_info *completely_free_snd_info(snd_info *sp)
{
int i;
- chan_info *cp;
free_snd_info(sp);
-
for (i = 0; i < sp->allocated_chans; i++)
{
+ chan_info *cp;
cp = sp->chans[i];
if (cp)
{
- if (XEN_VECTOR_P(cp->properties))
+ if (Xen_is_vector(cp->properties))
{
snd_unprotect_at(cp->properties_loc);
cp->properties_loc = NOT_A_GC_LOC;
@@ -501,7 +459,7 @@ snd_info *completely_free_snd_info(snd_info *sp)
}
}
free(sp->chans);
- if (XEN_VECTOR_P(sp->properties))
+ if (Xen_is_vector(sp->properties))
{
snd_unprotect_at(sp->properties_loc);
sp->properties_loc = NOT_A_GC_LOC;
@@ -513,9 +471,10 @@ snd_info *completely_free_snd_info(snd_info *sp)
void for_each_chan_with_int(void (*func)(chan_info *ncp, int val), int value)
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -529,9 +488,10 @@ void for_each_chan_with_int(void (*func)(chan_info *ncp, int val), int value)
void for_each_chan_with_mus_long_t(void (*func)(chan_info *ncp, mus_long_t val), mus_long_t value)
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -545,9 +505,10 @@ void for_each_chan_with_mus_long_t(void (*func)(chan_info *ncp, mus_long_t val),
void for_each_chan_with_bool(void (*func)(chan_info *ncp, bool val), bool value)
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -561,9 +522,10 @@ void for_each_chan_with_bool(void (*func)(chan_info *ncp, bool val), bool value)
void for_each_chan_with_float(void (*func)(chan_info *ncp, mus_float_t val), mus_float_t value)
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -577,9 +539,10 @@ void for_each_chan_with_float(void (*func)(chan_info *ncp, mus_float_t val), mus
void for_each_chan(void (*func)(chan_info *ncp))
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -593,9 +556,10 @@ void for_each_chan(void (*func)(chan_info *ncp))
void for_each_normal_chan_with_void(void (*func)(chan_info *ncp, void *ptr), void *userptr)
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -609,9 +573,10 @@ void for_each_normal_chan_with_void(void (*func)(chan_info *ncp, void *ptr), voi
void for_each_normal_chan_with_int(void (*func)(chan_info *ncp, int val), int value)
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -625,9 +590,10 @@ void for_each_normal_chan_with_int(void (*func)(chan_info *ncp, int val), int va
void for_each_normal_chan_with_refint(void (*func)(chan_info *ncp, int *val), int *value)
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -641,9 +607,10 @@ void for_each_normal_chan_with_refint(void (*func)(chan_info *ncp, int *val), in
void for_each_normal_chan(void (*func)(chan_info *ncp))
{
- int i, j;
+ int i;
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
snd_info *sp;
chan_info *cp;
sp = ss->sounds[i];
@@ -872,17 +839,17 @@ chan_info *selected_channel(void)
}
-static XEN select_sound_hook;
-static XEN select_channel_hook;
+static Xen select_sound_hook;
+static Xen select_channel_hook;
static int current_selectpos = 0;
static void select_sound(snd_info *sp)
{
if ((sp == NULL) || (sp->inuse != SOUND_NORMAL)) return;
- if (XEN_HOOKED(select_sound_hook))
+ if (Xen_hook_has_list(select_sound_hook))
run_hook(select_sound_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)),
+ Xen_list_1(C_int_to_Xen_sound(sp->index)),
S_select_sound_hook);
if (ss->selected_sound != sp->index)
@@ -894,8 +861,8 @@ static void select_sound(snd_info *sp)
}
sp->selectpos = current_selectpos++;
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
}
@@ -912,12 +879,13 @@ chan_info *color_selected_channel(snd_info *sp)
void select_channel(snd_info *sp, int chan)
{
- chan_info *cp, *ncp;
+ chan_info *cp;
if ((sp == NULL) || (sp->inuse != SOUND_NORMAL)) return;
cp = selected_channel();
if (cp != sp->chans[chan])
{
+ chan_info *ncp;
sp->selected_channel = chan;
select_sound(sp);
if (cp)
@@ -927,10 +895,10 @@ void select_channel(snd_info *sp, int chan)
if (sp != cp->sound) cp->sound->selected_channel = NO_SELECTION;
update_graph(cp);
}
- if (XEN_HOOKED(select_channel_hook))
+ if (Xen_hook_has_list(select_channel_hook))
run_hook(select_channel_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(sp->index),
- C_TO_XEN_INT(chan)),
+ Xen_list_2(C_int_to_Xen_sound(sp->index),
+ C_int_to_Xen_integer(chan)),
S_select_channel_hook);
ncp = color_selected_channel(sp);
goto_graph(ncp);
@@ -963,7 +931,7 @@ sync_info *free_sync_info(sync_info *si)
}
-static int syncd_channels(int sync)
+int syncd_channels(int sync)
{
if (sync != 0)
{
@@ -985,19 +953,20 @@ static int syncd_channels(int sync)
sync_info *snd_sync(int sync)
{
- int i, j, k, chans;
+ int chans;
snd_info *sp;
chans = syncd_channels(sync);
if (chans > 0)
{
+ int i, j;
sync_info *si;
si = (sync_info *)calloc(1, sizeof(sync_info));
si->begs = (mus_long_t *)calloc(chans, sizeof(mus_long_t));
si->cps = (chan_info **)calloc(chans, sizeof(chan_info *));
si->chans = chans;
- j = 0;
- for (i = 0; i < ss->max_sounds; i++)
+ for (i = 0, j = 0; i < ss->max_sounds; i++)
{
+ int k;
sp = ss->sounds[i];
if ((sp) &&
(sp->inuse == SOUND_NORMAL) &&
@@ -1057,74 +1026,6 @@ snd_info *find_sound(const char *name, int nth)
}
-static char *display_maxamps(const char *filename, int chans)
-{
- char *ampstr;
- int i, len;
- mus_sample_t *vals;
- mus_long_t *times;
- len = chans * 32;
- ampstr = (char *)calloc(len, sizeof(char));
- vals = (mus_sample_t *)calloc(chans, sizeof(mus_sample_t));
- times = (mus_long_t *)calloc(chans, sizeof(mus_long_t));
- mus_snprintf(ampstr, len, "%s", "\nmax amp: ");
- mus_sound_maxamps(filename, chans, vals, times);
- for (i = 0; i < chans; i++)
- {
- ampstr = mus_strcat(ampstr, prettyf(MUS_SAMPLE_TO_DOUBLE(vals[i]), 3), &len);
- ampstr = mus_strcat(ampstr, " ", &len);
- }
- free(vals);
- free(times);
- return(ampstr);
-}
-
-
-void display_info(snd_info *sp)
-{
- #define INFO_BUFFER_SIZE 1024
- if (sp)
- {
- file_info *hdr;
- hdr = sp->hdr;
- if (hdr)
- {
- char *comment = NULL, *ampstr = NULL, *quoted_comment = NULL;
- char *buffer = NULL;
- comment = hdr->comment;
- while ((comment) && (*comment) &&
- (((*comment) == '\n') ||
- ((*comment) == '\t') ||
- ((*comment) == ' ') ||
- ((*comment) == '\xd')))
- comment++;
- if ((comment) && (*comment))
- quoted_comment = mus_format("\"%s\"", comment);
- if (mus_sound_maxamp_exists(sp->filename))
- ampstr = display_maxamps(sp->filename, sp->nchans);
- buffer = (char *)calloc(INFO_BUFFER_SIZE, sizeof(char));
- mus_snprintf(buffer, INFO_BUFFER_SIZE,
- "srate: %d\nchans: %d\nlength: %.3f ("MUS_LD " %s)\ntype: %s\nformat: %s\nwritten: %s%s%s%s\n",
- hdr->srate,
- hdr->chans,
- (mus_float_t)((double)(hdr->samples) / (mus_float_t)(hdr->chans * hdr->srate)),
- (mus_long_t)((hdr->samples) / (hdr->chans)),
- (hdr->chans == 1) ? "samples" : "frames",
- mus_header_type_name(hdr->type),
- mus_data_format_name(hdr->format),
- snd_strftime(STRFTIME_FORMAT, sp->write_date),
- (ampstr) ? ampstr : "",
- (quoted_comment) ? "\ncomment: " : "",
- (quoted_comment) ? quoted_comment : "");
- post_it(sp->short_filename, buffer);
- if (ampstr) free(ampstr);
- if (quoted_comment) free(quoted_comment);
- free(buffer);
- }
- }
-}
-
-
void g_init_data(void)
{
#define H_select_sound_hook S_select_sound_hook " (snd): called whenever a sound is selected."
@@ -1132,7 +1033,7 @@ void g_init_data(void)
#define H_select_channel_hook S_select_channel_hook " (snd chn): called whenever a channel is selected. \
Its arguments are the sound index and the channel number."
- select_sound_hook = XEN_DEFINE_HOOK(S_select_sound_hook, 1, H_select_sound_hook); /* arg = sound index */
- select_channel_hook = XEN_DEFINE_HOOK(S_select_channel_hook, 2, H_select_channel_hook); /* args = sound index, channel */
+ select_sound_hook = Xen_define_hook(S_select_sound_hook, "(make-hook 'snd)", 1, H_select_sound_hook);
+ select_channel_hook = Xen_define_hook(S_select_channel_hook, "(make-hook 'snd 'chn)", 2, H_select_channel_hook);
}
diff --git a/snd-draw.c b/snd-draw.c
index 1b7d75f..63125f0 100644
--- a/snd-draw.c
+++ b/snd-draw.c
@@ -3,25 +3,6 @@
#if (!USE_NO_GUI)
-#if USE_MOTIF
- #define XEN_WRAP_PIXEL(Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("Pixel"), C_TO_XEN_INT((int)Value))
- /* not ulong here! -- messes up the equal? check */
- #define XEN_UNWRAP_PIXEL(Value) (unsigned long)XEN_TO_C_INT(XEN_CADR(Value))
- #define XEN_PIXEL_P(Value) (XEN_LIST_P(Value) && (XEN_LIST_LENGTH(Value) >= 2) && (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp("Pixel", XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
-#endif
-
-#if USE_GTK
- #define XEN_WRAP_PIXEL(Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("color_t"), XEN_WRAP_C_POINTER((unsigned long)Value))
- #define XEN_UNWRAP_PIXEL(Value) (color_t)(XEN_UNWRAP_C_POINTER(XEN_CADR(Value)))
- #define XEN_PIXEL_P(Value) (XEN_LIST_P(Value) && (XEN_LIST_LENGTH(Value) >= 2) && (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp("color_t", XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
-#endif
-
-/* unfortunately, we can't just make PIXEL into a C type here -- it is called
- * XM_PIXEL in xm.c and in that context, it assumes the layout given above.
- */
-
/* our "current path" */
static point_t points[POINT_BUFFER_SIZE];
static point_t points1[POINT_BUFFER_SIZE];
@@ -150,12 +131,11 @@ void draw_cursor(chan_info *cp)
cursor_style_t cur;
#if USE_GTK
color_t old_color;
- int cy0 = 0, cx0 = 0, csize;
#endif
axis_info *ap;
graphics_context *ax;
- if (!(cp->graph_time_p)) return;
+ if (!(cp->graph_time_on)) return;
ap = cp->axis;
#if USE_GTK
@@ -169,14 +149,15 @@ void draw_cursor(chan_info *cp)
old_color = get_foreground_color(ax);
set_foreground_color(ax, ss->cursor_color);
- if (cp->cx > cp->cursor_size) cx0 = cp->cx - cp->cursor_size;
- if (cp->cy > cp->cursor_size) cy0 = cp->cy - cp->cursor_size;
- csize = 2 * cp->cursor_size + 1;
+ /* if (cp->cx > cp->cursor_size) cx0 = cp->cx - cp->cursor_size; */
+ /* if (cp->cy > cp->cursor_size) cy0 = cp->cy - cp->cursor_size; */
+ /* csize = 2 * cp->cursor_size + 1; */
+ /* what were those lines for? */
#else
ax = cursor_context(cp);
#endif
- if (ss->tracking)
+ if ((ss->tracking) && (cp->sound->playing))
cur = cp->tracking_cursor_style;
else cur = cp->cursor_style;
@@ -196,17 +177,18 @@ void draw_cursor(chan_info *cp)
case CURSOR_PROC:
#if USE_GTK
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
#endif
- XEN_CALL_3((XEN_PROCEDURE_P(cp->cursor_proc)) ? (cp->cursor_proc) : (ss->cursor_proc),
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan),
+ Xen_call_with_3_args((Xen_is_procedure(cp->cursor_proc)) ? (cp->cursor_proc) : (ss->cursor_proc),
+ C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan),
/* this was time-graph, which was useless. It's now #t if we're in tracking-cursor mode */
- C_TO_XEN_BOOLEAN(ss->tracking),
+ C_bool_to_Xen_boolean(ss->tracking),
S_cursor_style " procedure");
#if USE_GTK
- ss->cr = MAKE_CAIRO(ap->ax->wn);
+ ss->cr = make_cairo(ap->ax->wn);
+ copy_context(cp);
#endif
break;
}
@@ -228,33 +210,33 @@ void draw_cursor(chan_info *cp)
/* -------------------------------------------------------------------------------- */
#define AXIS_CONTEXT_ID_OK(Id) ((Id >= CHAN_GC) && (Id <= CHAN_TMPGC))
-#define NO_SUCH_WIDGET XEN_ERROR_TYPE("no-such-widget")
+#define NO_SUCH_WIDGET Xen_make_error_type("no-such-widget")
#if USE_MOTIF
-static graphics_context *get_ax(chan_info *cp, int ax_id, const char *caller, XEN ignored)
+static graphics_context *get_ax(chan_info *cp, int ax_id, const char *caller, Xen ignored)
{
if ((cp) && (AXIS_CONTEXT_ID_OK(ax_id)))
return(set_context(cp, (chan_gc_t)ax_id));
- XEN_ERROR(XEN_ERROR_TYPE("no-such-graphics-context"),
- XEN_LIST_6(C_TO_XEN_STRING("~A: no such graphics context: ~A, sound index: ~A (~A), chan: ~A"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT(ax_id),
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_STRING(cp->sound->short_filename),
- C_TO_XEN_INT(cp->chan)));
+ Xen_error(Xen_make_error_type("no-such-graphics-context"),
+ Xen_list_6(C_string_to_Xen_string("~A: no such graphics context: ~A, sound index: ~A (~A), chan: ~A"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer(ax_id),
+ C_int_to_Xen_sound(cp->sound->index),
+ C_string_to_Xen_string(cp->sound->short_filename),
+ C_int_to_Xen_integer(cp->chan)));
return(NULL);
}
static graphics_context *get_ax_no_cr(chan_info *cp, int ax_id, const char *caller)
{
- return(get_ax(cp,ax_id, caller, XEN_FALSE));
+ return(get_ax(cp,ax_id, caller, Xen_false));
}
#endif
#if USE_GTK
-static graphics_context *get_ax(chan_info *cp, int ax_id, const char *caller, XEN xcr)
+static graphics_context *get_ax(chan_info *cp, int ax_id, const char *caller, Xen xcr)
{
if ((cp) && (AXIS_CONTEXT_ID_OK(ax_id)))
{
@@ -263,24 +245,24 @@ static graphics_context *get_ax(chan_info *cp, int ax_id, const char *caller, XE
/* (gdk_cairo_create (GDK_DRAWABLE (gtk_widget_get_window (car (channel-widgets 0 0)))))) -> '(cairo_t_ #<c_pointer 0x12bbca0>)
* (eq? (car hi) 'cairo_t_) -> #t
*/
- if ((XEN_LIST_P(xcr)) &&
- (XEN_LIST_LENGTH(xcr) == 2) &&
- (XEN_SYMBOL_P(XEN_CAR(xcr))) &&
- (strcmp("cairo_t_", XEN_SYMBOL_TO_C_STRING(XEN_CAR(xcr))) == 0))
- ss->cr = (cairo_t *)XEN_UNWRAP_C_POINTER(XEN_CADR(xcr));
+ if ((Xen_is_list(xcr)) &&
+ (Xen_list_length(xcr) == 2) &&
+ (Xen_is_symbol(Xen_car(xcr))) &&
+ (strcmp("cairo_t_", Xen_symbol_to_C_string(Xen_car(xcr))) == 0))
+ ss->cr = (cairo_t *)Xen_unwrap_C_pointer(Xen_cadr(xcr));
else
- XEN_ERROR(XEN_ERROR_TYPE("not-a-graphics-context"),
- XEN_LIST_2(C_TO_XEN_STRING("~A: cairo_t argument is not a cairo_t pointer"),
- C_TO_XEN_STRING(caller)));
+ Xen_error(Xen_make_error_type("not-a-graphics-context"),
+ Xen_list_2(C_string_to_Xen_string("~A: cairo_t argument is not a cairo_t pointer"),
+ C_string_to_Xen_string(caller)));
return(ax);
}
- XEN_ERROR(XEN_ERROR_TYPE("no-such-graphics-context"),
- XEN_LIST_6(C_TO_XEN_STRING("~A: no such graphics context: ~A, sound index: ~A (~A), chan: ~A"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT(ax_id),
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_STRING(cp->sound->short_filename),
- C_TO_XEN_INT(cp->chan)));
+ Xen_error(Xen_make_error_type("no-such-graphics-context"),
+ Xen_list_6(C_string_to_Xen_string("~A: no such graphics context: ~A, sound index: ~A (~A), chan: ~A"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer(ax_id),
+ C_int_to_Xen_sound(cp->sound->index),
+ C_string_to_Xen_string(cp->sound->short_filename),
+ C_int_to_Xen_integer(cp->chan)));
return(NULL);
}
@@ -292,101 +274,101 @@ static graphics_context *get_ax_no_cr(chan_info *cp, int ax_id, const char *call
ax = set_context(cp, (chan_gc_t)ax_id);
return(ax);
}
- XEN_ERROR(XEN_ERROR_TYPE("no-such-graphics-context"),
- XEN_LIST_6(C_TO_XEN_STRING("~A: no such graphics context: ~A, sound index: ~A (~A), chan: ~A"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT(ax_id),
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_STRING(cp->sound->short_filename),
- C_TO_XEN_INT(cp->chan)));
+ Xen_error(Xen_make_error_type("no-such-graphics-context"),
+ Xen_list_6(C_string_to_Xen_string("~A: no such graphics context: ~A, sound index: ~A (~A), chan: ~A"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer(ax_id),
+ C_int_to_Xen_sound(cp->sound->index),
+ C_string_to_Xen_string(cp->sound->short_filename),
+ C_int_to_Xen_integer(cp->chan)));
return(NULL);
}
#endif
-#define TO_C_AXIS_CONTEXT(Snd, Chn, Ax, Caller, Cr) get_ax(get_cp(Snd, Chn, Caller), XEN_TO_C_INT_OR_ELSE(Ax, (int)CHAN_GC), Caller, Cr)
-#define TO_C_AXIS_CONTEXT_NO_CR(Snd, Chn, Ax, Caller) get_ax_no_cr(get_cp(Snd, Chn, Caller), XEN_TO_C_INT_OR_ELSE(Ax, (int)CHAN_GC), Caller)
+#define TO_C_AXIS_CONTEXT(Snd, Chn, Ax, Caller, Cr) get_ax(get_cp(Snd, Chn, Caller), (Xen_is_integer(Ax)) ? Xen_integer_to_C_int(Ax) : (int)CHAN_GC, Caller, Cr)
+#define TO_C_AXIS_CONTEXT_NO_CR(Snd, Chn, Ax, Caller) get_ax_no_cr(get_cp(Snd, Chn, Caller), (Xen_is_integer(Ax)) ? Xen_integer_to_C_int(Ax) : (int)CHAN_GC, Caller)
-static XEN g_draw_line(XEN x0, XEN y0, XEN x1, XEN y1, XEN snd, XEN chn, XEN ax, XEN xcr)
+static Xen g_draw_line(Xen x0, Xen y0, Xen x1, Xen y1, Xen snd, Xen chn, Xen ax, Xen xcr)
{
#define H_draw_line "(" S_draw_line " x0 y0 x1 y1 :optional snd chn (ax " S_time_graph ") cr): draw a line"
- ASSERT_CHANNEL(S_draw_line, snd, chn, 5);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x0), x0, XEN_ARG_1, S_draw_line, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(y0), y0, XEN_ARG_2, S_draw_line, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x1), x1, XEN_ARG_3, S_draw_line, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(y1), y1, XEN_ARG_4, S_draw_line, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_7, S_draw_line, "an integer such as " S_time_graph);
+ Snd_assert_channel(S_draw_line, snd, chn, 5);
+ Xen_check_type(Xen_is_integer(x0), x0, 1, S_draw_line, "an integer");
+ Xen_check_type(Xen_is_integer(y0), y0, 2, S_draw_line, "an integer");
+ Xen_check_type(Xen_is_integer(x1), x1, 3, S_draw_line, "an integer");
+ Xen_check_type(Xen_is_integer(y1), y1, 4, S_draw_line, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 7, S_draw_line, "an integer such as " S_time_graph);
draw_line(TO_C_AXIS_CONTEXT(snd, chn, ax, S_draw_line, xcr),
- XEN_TO_C_INT(x0),
- XEN_TO_C_INT(y0),
- XEN_TO_C_INT(x1),
- XEN_TO_C_INT(y1));
- return(XEN_FALSE);
+ Xen_integer_to_C_int(x0),
+ Xen_integer_to_C_int(y0),
+ Xen_integer_to_C_int(x1),
+ Xen_integer_to_C_int(y1));
+ return(Xen_false);
}
-static XEN g_draw_dot(XEN x0, XEN y0, XEN size, XEN snd, XEN chn, XEN ax, XEN xcr)
+static Xen g_draw_dot(Xen x0, Xen y0, Xen size, Xen snd, Xen chn, Xen ax, Xen xcr)
{
#define H_draw_dot "(" S_draw_dot " x0 y0 size :optional snd chn (ax " S_time_graph ") cr): draw a dot"
- ASSERT_CHANNEL(S_draw_dot, snd, chn, 4);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x0), x0, XEN_ARG_1, S_draw_dot, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(y0), y0, XEN_ARG_2, S_draw_dot, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(size), size, XEN_ARG_3, S_draw_dot, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_6, S_draw_dot, "an integer such as " S_time_graph);
+ Snd_assert_channel(S_draw_dot, snd, chn, 4);
+ Xen_check_type(Xen_is_integer(x0), x0, 1, S_draw_dot, "an integer");
+ Xen_check_type(Xen_is_integer(y0), y0, 2, S_draw_dot, "an integer");
+ Xen_check_type(Xen_is_integer(size), size, 3, S_draw_dot, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 6, S_draw_dot, "an integer such as " S_time_graph);
draw_dot(TO_C_AXIS_CONTEXT(snd, chn, ax, S_draw_dot, xcr),
- XEN_TO_C_INT(x0),
- XEN_TO_C_INT(y0),
- XEN_TO_C_INT_OR_ELSE(size, 1));
- return(XEN_FALSE);
+ Xen_integer_to_C_int(x0),
+ Xen_integer_to_C_int(y0),
+ Xen_integer_to_C_int(size));
+ return(Xen_false);
}
-static XEN g_fill_rectangle(XEN x0, XEN y0, XEN width, XEN height, XEN snd, XEN chn, XEN ax, XEN erase, XEN xcr)
+static Xen g_fill_rectangle(Xen x0, Xen y0, Xen width, Xen height, Xen snd, Xen chn, Xen ax, Xen erase, Xen xcr)
{
#define H_fill_rectangle "(" S_fill_rectangle " x0 y0 width height :optional snd chn (ax " S_time_graph ") erase cr): draw a filled rectangle"
- ASSERT_CHANNEL(S_fill_rectangle, snd, chn, 5);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x0), x0, XEN_ARG_1, S_fill_rectangle, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(y0), y0, XEN_ARG_2, S_fill_rectangle, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(width), width, XEN_ARG_3, S_fill_rectangle, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(height), height, XEN_ARG_4, S_fill_rectangle, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_7, S_fill_rectangle, "an integer such as " S_time_graph);
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(erase), erase, XEN_ARG_8, S_fill_rectangle, "a boolean");
+ Snd_assert_channel(S_fill_rectangle, snd, chn, 5);
+ Xen_check_type(Xen_is_integer(x0), x0, 1, S_fill_rectangle, "an integer");
+ Xen_check_type(Xen_is_integer(y0), y0, 2, S_fill_rectangle, "an integer");
+ Xen_check_type(Xen_is_integer(width), width, 3, S_fill_rectangle, "an integer");
+ Xen_check_type(Xen_is_integer(height), height, 4, S_fill_rectangle, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 7, S_fill_rectangle, "an integer such as " S_time_graph);
+ Xen_check_type(Xen_is_boolean_or_unbound(erase), erase, 8, S_fill_rectangle, "a boolean");
- if ((XEN_BOOLEAN_P(erase)) &&
- (XEN_TRUE_P(erase)))
+ if ((Xen_is_boolean(erase)) &&
+ (Xen_is_true(erase)))
erase_rectangle(get_cp(snd, chn, S_fill_rectangle),
TO_C_AXIS_CONTEXT(snd, chn, ax, S_fill_rectangle, xcr),
- XEN_TO_C_INT(x0),
- XEN_TO_C_INT(y0),
- XEN_TO_C_INT(width),
- XEN_TO_C_INT(height));
+ Xen_integer_to_C_int(x0),
+ Xen_integer_to_C_int(y0),
+ Xen_integer_to_C_int(width),
+ Xen_integer_to_C_int(height));
else fill_rectangle(TO_C_AXIS_CONTEXT(snd, chn, ax, S_fill_rectangle, xcr),
- XEN_TO_C_INT(x0),
- XEN_TO_C_INT(y0),
- XEN_TO_C_INT(width),
- XEN_TO_C_INT(height));
- return(XEN_FALSE);
+ Xen_integer_to_C_int(x0),
+ Xen_integer_to_C_int(y0),
+ Xen_integer_to_C_int(width),
+ Xen_integer_to_C_int(height));
+ return(Xen_false);
}
-static XEN g_draw_string(XEN text, XEN x0, XEN y0, XEN snd, XEN chn, XEN ax, XEN xcr)
+static Xen g_draw_string(Xen text, Xen x0, Xen y0, Xen snd, Xen chn, Xen ax, Xen xcr)
{
#define H_draw_string "(" S_draw_string " text x0 y0 :optional snd chn (ax " S_time_graph ") cr): draw a string"
const char *tmp = NULL;
- ASSERT_CHANNEL(S_draw_string, snd, chn, 4);
- XEN_ASSERT_TYPE(XEN_STRING_P(text), text, XEN_ARG_1, S_draw_string, "a string");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x0), x0, XEN_ARG_2, S_draw_string, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(y0), y0, XEN_ARG_3, S_draw_string, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_6, S_draw_string, "an integer such as " S_time_graph);
+ Snd_assert_channel(S_draw_string, snd, chn, 4);
+ Xen_check_type(Xen_is_string(text), text, 1, S_draw_string, "a string");
+ Xen_check_type(Xen_is_integer(x0), x0, 2, S_draw_string, "an integer");
+ Xen_check_type(Xen_is_integer(y0), y0, 3, S_draw_string, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 6, S_draw_string, "an integer such as " S_time_graph);
- tmp = XEN_TO_C_STRING(text);
+ tmp = Xen_string_to_C_string(text);
#if USE_MOTIF
/* snd-xdraw to make motif draw-string act in the same way (coordinate-wise) as gtk */
/* despite the name, this is not a gtk function */
@@ -394,29 +376,29 @@ static XEN g_draw_string(XEN text, XEN x0, XEN y0, XEN snd, XEN chn, XEN ax, XEN
#else
draw_string(TO_C_AXIS_CONTEXT(snd, chn, ax, S_draw_string, xcr),
#endif
- XEN_TO_C_INT(x0),
- XEN_TO_C_INT(y0),
+ Xen_integer_to_C_int(x0),
+ Xen_integer_to_C_int(y0),
tmp,
mus_strlen(tmp));
return(text);
}
-static point_t *vector_to_points(XEN pts, const char *caller, int *vector_len)
+static point_t *vector_to_points(Xen pts, const char *caller, int *vector_len)
{
int i, j, vlen = 0, len = 0;
point_t *pack_pts;
- vlen = XEN_VECTOR_LENGTH(pts);
+ vlen = Xen_vector_length(pts);
if (vlen & 1)
- XEN_ERROR(XEN_ERROR_TYPE("bad-length"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: length of vector of points (~A) must be even"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT(vlen)));
+ Xen_error(Xen_make_error_type("bad-length"),
+ Xen_list_3(C_string_to_Xen_string("~A: length of vector of points (~A) must be even"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer(vlen)));
if (vlen <= 0)
- XEN_ERROR(NO_DATA,
- XEN_LIST_3(C_TO_XEN_STRING("~A: empty points vector? ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(NO_DATA,
+ Xen_list_3(C_string_to_Xen_string("~A: empty points vector? ~A"),
+ C_string_to_Xen_string(caller),
pts));
len = vlen / 2;
(*vector_len) = len;
@@ -424,14 +406,14 @@ static point_t *vector_to_points(XEN pts, const char *caller, int *vector_len)
for (i = 0, j = 0; i < len; i++, j += 2)
{
- pack_pts[i].x = XEN_TO_C_INT_OR_ELSE(XEN_VECTOR_REF(pts, j), 0);
- pack_pts[i].y = XEN_TO_C_INT_OR_ELSE(XEN_VECTOR_REF(pts, j + 1), 0);
+ pack_pts[i].x = Xen_integer_to_C_int(Xen_vector_ref(pts, j));
+ pack_pts[i].y = Xen_integer_to_C_int(Xen_vector_ref(pts, j + 1));
}
return(pack_pts);
}
- static XEN g_draw_lines(XEN pts, XEN snd, XEN chn, XEN ax, XEN xcr)
+ static Xen g_draw_lines(Xen pts, Xen snd, Xen chn, Xen ax, Xen xcr)
{
/* pts should be a vector of integers as (x y) pairs */
#define H_draw_lines "(" S_draw_lines " lines :optional snd chn (ax " S_time_graph ") cr): draw a vector of lines"
@@ -440,9 +422,9 @@ static point_t *vector_to_points(XEN pts, const char *caller, int *vector_len)
graphics_context *ax1;
int vlen = 0;
- ASSERT_CHANNEL(S_draw_lines, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_VECTOR_P(pts), pts, XEN_ARG_1, S_draw_lines, "a vector");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_4, S_draw_lines, "an integer such as " S_time_graph);
+ Snd_assert_channel(S_draw_lines, snd, chn, 2);
+ Xen_check_type(Xen_is_vector(pts), pts, 1, S_draw_lines, "a vector");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 4, S_draw_lines, "an integer such as " S_time_graph);
ax1 = TO_C_AXIS_CONTEXT(snd, chn, ax, S_draw_lines, xcr);
@@ -454,7 +436,7 @@ static point_t *vector_to_points(XEN pts, const char *caller, int *vector_len)
}
- static XEN g_draw_dots(XEN pts, XEN size, XEN snd, XEN chn, XEN ax, XEN xcr)
+ static Xen g_draw_dots(Xen pts, Xen size, Xen snd, Xen chn, Xen ax, Xen xcr)
{
/* pts should be a vector of integers as (x y) pairs */
#define H_draw_dots "(" S_draw_dots " positions :optional dot-size snd chn (ax " S_time_graph ") cr): draw a vector of dots"
@@ -463,10 +445,10 @@ static point_t *vector_to_points(XEN pts, const char *caller, int *vector_len)
graphics_context *ax1;
int vlen = 0;
- ASSERT_CHANNEL(S_draw_dots, snd, chn, 3);
- XEN_ASSERT_TYPE(XEN_VECTOR_P(pts), pts, XEN_ARG_1, S_draw_dots, "a vector");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(size), size, XEN_ARG_2, S_draw_dots, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_5, S_draw_dots, "an integer such as " S_time_graph);
+ Snd_assert_channel(S_draw_dots, snd, chn, 3);
+ Xen_check_type(Xen_is_vector(pts), pts, 1, S_draw_dots, "a vector");
+ Xen_check_type(Xen_is_integer_or_unbound(size), size, 2, S_draw_dots, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 5, S_draw_dots, "an integer such as " S_time_graph);
ax1 = TO_C_AXIS_CONTEXT(snd, chn, ax, S_draw_dots, xcr);
@@ -474,14 +456,14 @@ static point_t *vector_to_points(XEN pts, const char *caller, int *vector_len)
draw_points(ax1,
pack_pts,
vlen,
- XEN_TO_C_INT_OR_ELSE(size, 1));
+ (Xen_is_integer(size)) ? Xen_integer_to_C_int(size) : 1);
free(pack_pts);
return(pts);
}
- static XEN g_fill_polygon(XEN pts, XEN snd, XEN chn, XEN ax_id, XEN xcr)
+ static Xen g_fill_polygon(Xen pts, Xen snd, Xen chn, Xen ax_id, Xen xcr)
{
#define H_fill_polygon "(" S_fill_polygon " points :optional snd chn (ax " S_time_graph ") cr): draw a filled polygon"
@@ -489,9 +471,9 @@ static point_t *vector_to_points(XEN pts, const char *caller, int *vector_len)
graphics_context *ax;
int vlen = 0;
- ASSERT_CHANNEL(S_fill_polygon, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_VECTOR_P(pts), pts, XEN_ARG_1, S_fill_polygon, "a vector");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax_id), ax_id, XEN_ARG_4, S_fill_polygon, "an integer such as " S_time_graph);
+ Snd_assert_channel(S_fill_polygon, snd, chn, 2);
+ Xen_check_type(Xen_is_vector(pts), pts, 1, S_fill_polygon, "a vector");
+ Xen_check_type(Xen_is_integer_or_unbound(ax_id), ax_id, 4, S_fill_polygon, "an integer such as " S_time_graph);
ax = TO_C_AXIS_CONTEXT(snd, chn, ax_id, S_fill_polygon, xcr);
@@ -507,7 +489,7 @@ static point_t *vector_to_points(XEN pts, const char *caller, int *vector_len)
}
-static XEN g_make_bezier(XEN args1)
+static Xen g_make_bezier(Xen args1)
{
/* used in musglyphs.rb -- not currently used anywhere else */
@@ -521,17 +503,17 @@ defined by the 4 controlling points x0..y3; 'n' is how many points to return"
int x[4];
int y[4];
int n = 50;
- XEN pts, args;
+ Xen pts, args;
- args = XEN_COPY_ARG(args1);
+ args = Xen_copy_arg(args1);
for (i = 0; i < 4; i++)
{
- x[i] = XEN_TO_C_INT(XEN_CAR(args));
- y[i] = XEN_TO_C_INT(XEN_CADR(args));
- args = XEN_CDDR(args);
+ x[i] = Xen_integer_to_C_int(Xen_car(args));
+ y[i] = Xen_integer_to_C_int(Xen_cadr(args));
+ args = Xen_cddr(args);
}
- if (XEN_NOT_NULL_P(args))
- n = XEN_TO_C_INT(XEN_CAR(args));
+ if (!Xen_is_null(args))
+ n = Xen_integer_to_C_int(Xen_car(args));
cx = 3 * (x[1] - x[0]);
cy = 3 * (y[1] - y[0]);
@@ -540,162 +522,161 @@ defined by the 4 controlling points x0..y3; 'n' is how many points to return"
ax = x[3] - (x[0] + cx + bx);
ay = y[3] - (y[0] + cy + by);
incr = 1.0 / (float)n;
- pts = XEN_MAKE_VECTOR(2 * (n + 1), XEN_ZERO);
+ pts = Xen_make_vector(2 * (n + 1), Xen_integer_zero);
- XEN_VECTOR_SET(pts, 0, C_TO_XEN_INT(x[0]));
- XEN_VECTOR_SET(pts, 1, C_TO_XEN_INT(y[0]));
+ Xen_vector_set(pts, 0, C_int_to_Xen_integer(x[0]));
+ Xen_vector_set(pts, 1, C_int_to_Xen_integer(y[0]));
for (i = 1, val = incr; i <= n; i++, val += incr)
{
- XEN_VECTOR_SET(pts, i * 2, C_TO_XEN_INT((int)(x[0] + val * (cx + (val * (bx + (val * ax)))))));
- XEN_VECTOR_SET(pts, i * 2 + 1, C_TO_XEN_INT((int)(y[0] + val * (cy + (val * (by + (val * ay)))))));
+ Xen_vector_set(pts, i * 2, C_int_to_Xen_integer((int)(x[0] + val * (cx + (val * (bx + (val * ax)))))));
+ Xen_vector_set(pts, i * 2 + 1, C_int_to_Xen_integer((int)(y[0] + val * (cy + (val * (by + (val * ay)))))));
}
return(pts);
}
- static XEN g_foreground_color(XEN snd, XEN chn, XEN xax)
+ static Xen g_foreground_color(Xen snd, Xen chn, Xen xax)
{
#define H_foreground_color "(" S_foreground_color " :optional snd chn (ax " S_time_graph ")): current drawing color"
chan_info *cp;
graphics_context *ax;
- ASSERT_CHANNEL(S_foreground_color, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(xax), xax, XEN_ARG_3, S_foreground_color, "an integer");
+ Snd_assert_channel(S_foreground_color, snd, chn, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(xax), xax, 3, S_foreground_color, "an integer");
cp = get_cp(snd, chn, S_foreground_color);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- ax = get_ax_no_cr(cp, XEN_TO_C_INT_OR_ELSE(xax, (int)CHAN_GC), S_foreground_color);
- return(XEN_WRAP_PIXEL(get_foreground_color(ax)));
+ ax = get_ax_no_cr(cp, (Xen_is_integer(xax)) ? Xen_integer_to_C_int(xax) : (int)CHAN_GC, S_foreground_color);
+ return(Xen_wrap_pixel(get_foreground_color(ax)));
}
- static XEN g_set_foreground_color(XEN color, XEN snd, XEN chn, XEN ax)
+ static Xen g_set_foreground_color(Xen color, Xen snd, Xen chn, Xen ax)
{
chan_info *cp;
- ASSERT_CHANNEL(S_setB S_foreground_color, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ARG_1, S_setB S_foreground_color, "a color");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax), ax, XEN_ARG_4, S_setB S_foreground_color, "an integer");
+ Snd_assert_channel(S_set S_foreground_color, snd, chn, 2);
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_foreground_color, "a color");
+ Xen_check_type(Xen_is_integer_or_unbound(ax), ax, 4, S_set S_foreground_color, "an integer");
- cp = get_cp(snd, chn, S_setB S_foreground_color);
- if (!cp) return(XEN_FALSE);
+ cp = get_cp(snd, chn, S_set S_foreground_color);
+ if (!cp) return(Xen_false);
- set_foreground_color(get_ax_no_cr(cp, XEN_TO_C_INT_OR_ELSE(ax, (int)CHAN_GC), S_setB S_foreground_color),
- XEN_UNWRAP_PIXEL(color));
+ set_foreground_color(get_ax_no_cr(cp, (Xen_is_integer(ax)) ? Xen_integer_to_C_int(ax) : (int)CHAN_GC, S_set S_foreground_color),
+ Xen_unwrap_pixel(color));
return(color);
}
-WITH_FOUR_SETTER_ARGS(g_set_foreground_color_reversed, g_set_foreground_color)
+with_four_setter_args(g_set_foreground_color_reversed, g_set_foreground_color)
#if USE_MOTIF
-static XEN g_set_current_font(XEN id, XEN snd, XEN chn, XEN ax_id)
+static Xen g_set_current_font(Xen id, Xen snd, Xen chn, Xen ax_id)
{
graphics_context *ax;
- ASSERT_CHANNEL(S_setB S_current_font, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax_id), ax_id, XEN_ARG_4, S_setB S_current_font, "an integer such as time-graph");
- XEN_ASSERT_TYPE((XEN_LIST_P(id)) &&
- (XEN_LIST_LENGTH(id) >= 2) &&
- (XEN_SYMBOL_P(XEN_CAR(id))) &&
- (strcmp("Font", XEN_SYMBOL_TO_C_STRING(XEN_CAR(id))) == 0), id, XEN_ARG_1, S_setB S_current_font, "a Font");
+ Snd_assert_channel(S_set S_current_font, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(ax_id), ax_id, 4, S_set S_current_font, "an integer such as time-graph");
+ Xen_check_type((Xen_is_list(id)) &&
+ (Xen_list_length(id) >= 2) &&
+ (Xen_is_symbol(Xen_car(id))) &&
+ (strcmp("Font", Xen_symbol_to_C_string(Xen_car(id))) == 0), id, 1, S_set S_current_font, "a Font");
ax = TO_C_AXIS_CONTEXT_NO_CR(snd, chn, ax_id, S_current_font);
- ax->current_font = (Font)XEN_TO_C_ULONG(XEN_CADR(id));
+ ax->current_font = (Font)Xen_ulong_to_C_ulong(Xen_cadr(id));
XSetFont(ax->dp, ax->gc, ax->current_font);
return(id);
}
-static XEN g_current_font(XEN snd, XEN chn, XEN ax_id)
+static Xen g_current_font(Xen snd, Xen chn, Xen ax_id)
{
#define H_current_font "(" S_current_font " :optional snd chn (ax " S_time_graph ")): current font id"
graphics_context *ax;
chan_info *cp;
- ASSERT_CHANNEL(S_current_font, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax_id), ax_id, XEN_ARG_3, S_current_font, "an integer such as time-graph");
+ Snd_assert_channel(S_current_font, snd, chn, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(ax_id), ax_id, 3, S_current_font, "an integer such as time-graph");
cp = get_cp(snd, chn, S_current_font);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- ax = get_ax_no_cr(cp, XEN_TO_C_INT_OR_ELSE(ax_id, (int)CHAN_GC), S_current_font);
+ ax = get_ax_no_cr(cp, (Xen_is_integer(ax_id)) ? Xen_integer_to_C_int(ax_id) : (int)CHAN_GC, S_current_font);
if (ax->current_font == 0)
{
if ((cp->axis) && (cp->axis->ax))
- return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("Font"),
- C_TO_XEN_ULONG(cp->axis->ax->current_font)));
- else return(XEN_FALSE);
+ return(Xen_list_2(C_string_to_Xen_symbol("Font"),
+ C_ulong_to_Xen_ulong(cp->axis->ax->current_font)));
+ else return(Xen_false);
}
- return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("Font"),
- C_TO_XEN_ULONG(ax->current_font)));
+ return(Xen_list_2(C_string_to_Xen_symbol("Font"),
+ C_ulong_to_Xen_ulong(ax->current_font)));
}
#else
-static XEN g_set_current_font(XEN id, XEN snd, XEN chn, XEN ax_id)
+static Xen g_set_current_font(Xen id, Xen snd, Xen chn, Xen ax_id)
{
graphics_context *ax;
- ASSERT_CHANNEL(S_setB S_current_font, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax_id), ax_id, XEN_ARG_4, S_setB S_current_font, "an integer such as time-graph");
+ Snd_assert_channel(S_set S_current_font, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(ax_id), ax_id, 4, S_set S_current_font, "an integer such as time-graph");
- ax = TO_C_AXIS_CONTEXT_NO_CR(snd, chn, ax_id, S_setB S_current_font);
- XEN_ASSERT_TYPE((XEN_WRAPPED_C_POINTER_P(id)) ||
- (XEN_LIST_P(id) &&
- (XEN_LIST_LENGTH(id) >= 2) &&
- (XEN_SYMBOL_P(XEN_CAR(id)))),
- id, XEN_ARG_1, S_setB S_current_font, "a wrapped object or a raw pointer");
+ ax = TO_C_AXIS_CONTEXT_NO_CR(snd, chn, ax_id, S_set S_current_font);
+ Xen_check_type((Xen_is_wrapped_c_pointer(id)) ||
+ (Xen_is_list(id) &&
+ (Xen_list_length(id) >= 2) &&
+ (Xen_is_symbol(Xen_car(id)))),
+ id, 1, S_set S_current_font, "a wrapped object or a raw pointer");
- if (XEN_WRAPPED_C_POINTER_P(id))
- ax->current_font = (PangoFontDescription *)XEN_UNWRAP_C_POINTER(id);
- else ax->current_font = (PangoFontDescription *)XEN_UNWRAP_C_POINTER(XEN_CADR(id));
+ if (Xen_is_wrapped_c_pointer(id))
+ ax->current_font = (PangoFontDescription *)Xen_unwrap_C_pointer(id);
+ else ax->current_font = (PangoFontDescription *)Xen_unwrap_C_pointer(Xen_cadr(id));
return(id);
}
-static XEN g_current_font(XEN snd, XEN chn, XEN ax_id)
+static Xen g_current_font(Xen snd, Xen chn, Xen ax_id)
{
#define H_current_font "(" S_current_font " :optional snd chn (ax " S_time_graph ")): current font id"
graphics_context *ax;
- ASSERT_CHANNEL(S_current_font, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ax_id), ax_id, XEN_ARG_3, S_current_font, "an integer such as time-graph");
+ Snd_assert_channel(S_current_font, snd, chn, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(ax_id), ax_id, 3, S_current_font, "an integer such as time-graph");
ax = TO_C_AXIS_CONTEXT_NO_CR(snd, chn, ax_id, S_current_font);
- return(XEN_WRAP_C_POINTER(ax->current_font));
+ return(Xen_wrap_C_pointer(ax->current_font));
}
#endif
-WITH_FOUR_SETTER_ARGS(g_set_current_font_reversed, g_set_current_font)
+with_four_setter_args(g_set_current_font_reversed, g_set_current_font)
-
-static XEN g_make_graph_data(XEN snd, XEN chn, XEN edpos, XEN lo, XEN hi)
+static Xen g_make_graph_data(Xen snd, Xen chn, Xen edpos, Xen lo, Xen hi)
{
#define H_make_graph_data "(" S_make_graph_data " :optional snd chn edpos low high): \
-return either a vct (if the graph has one trace), or a list of two vcts (the two sides of the envelope graph). \
+return either a " S_vct " (if the graph has one trace), or a list of two " S_vct "s (the two sides of the envelope graph). \
'edpos' defaults to the " S_current_edit_position ", 'low' defaults to the current window left sample, and \
'high' defaults to the current rightmost sample. (" S_graph_data " (" S_make_graph_data ")) reimplements the time domain graph."
chan_info *cp;
- ASSERT_CHANNEL(S_make_graph_data, snd, chn, 1);
+ Snd_assert_channel(S_make_graph_data, snd, chn, 1);
cp = get_cp(snd, chn, S_make_graph_data);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(lo), lo, XEN_ARG_4, S_make_graph_data, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(hi), hi, XEN_ARG_5, S_make_graph_data, "a number");
+ Xen_check_type(Xen_is_integer_or_unbound(lo), lo, 4, S_make_graph_data, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(hi), hi, 5, S_make_graph_data, "an integer");
return(make_graph_data(cp,
to_c_edit_position(cp, edpos, S_make_graph_data, 3),
- XEN_TO_C_INT64_T_OR_ELSE(lo, -1),
- XEN_TO_C_INT64_T_OR_ELSE(hi, -1)));
+ (Xen_is_llong(lo)) ? Xen_llong_to_C_llong(lo) : -1,
+ (Xen_is_llong(hi)) ? Xen_llong_to_C_llong(hi) : -1));
}
- static XEN g_graph_data(XEN data, XEN snd, XEN chn, XEN ax, XEN lo, XEN hi, XEN style, XEN xcr)
+ static Xen g_graph_data(Xen data, Xen snd, Xen chn, Xen ax, Xen lo, Xen hi, Xen style, Xen xcr)
{
#define H_graph_data "(" S_graph_data " data :optional snd chn (context " S_copy_context ") low high graph-style cr): \
display 'data' in the time domain graph of snd's channel chn using the graphics context context (normally " S_copy_context "), placing the \
@@ -704,101 +685,101 @@ data in the recipient's graph between points low and high in the drawing mode gr
chan_info *cp;
vct *v0, *v1 = NULL;
- ASSERT_CHANNEL(S_graph_data, snd, chn, 2);
+ Snd_assert_channel(S_graph_data, snd, chn, 2);
cp = get_cp(snd, chn, S_graph_data);
- if (!cp) return(XEN_FALSE);
-
- if (XEN_FALSE_P(data)) return(XEN_FALSE);
- XEN_ASSERT_TYPE((XEN_LIST_P(data) &&
- (XEN_LIST_LENGTH(data) == 2) &&
- (MUS_VCT_P(XEN_CAR(data))) &&
- (MUS_VCT_P(XEN_CADR(data)))) ||
- MUS_VCT_P(data),
- data, XEN_ARG_1, S_graph_data, "a list of 2 vcts or vct");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(ax), ax, XEN_ARG_4, S_graph_data, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(lo) || XEN_FALSE_P(lo) || XEN_NOT_BOUND_P(lo), lo, XEN_ARG_5, S_graph_data, "a sample number");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(hi) || XEN_FALSE_P(hi) || XEN_NOT_BOUND_P(hi), hi, XEN_ARG_6, S_graph_data, "a sample number");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(style), style, XEN_ARG_7, S_graph_data, "an integer");
-
- if (XEN_LIST_P(data))
+ if (!cp) return(Xen_false);
+
+ if (Xen_is_false(data)) return(Xen_false);
+ Xen_check_type((Xen_is_list(data) &&
+ (Xen_list_length(data) == 2) &&
+ (mus_is_vct(Xen_car(data))) &&
+ (mus_is_vct(Xen_cadr(data)))) ||
+ (mus_is_vct(data)),
+ data, 1, S_graph_data, "a list of 2 " S_vct "s or a " S_vct);
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(ax), ax, 4, S_graph_data, "an integer");
+ Xen_check_type(Xen_is_llong(lo) || Xen_is_false(lo) || !Xen_is_bound(lo), lo, 5, S_graph_data, "a sample number");
+ Xen_check_type(Xen_is_llong(hi) || Xen_is_false(hi) || !Xen_is_bound(hi), hi, 6, S_graph_data, "a sample number");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(style), style, 7, S_graph_data, "an integer");
+
+ if (Xen_is_list(data))
{
- v0 = xen_to_vct(XEN_CAR(data));
- v1 = xen_to_vct(XEN_CADR(data));
+ v0 = xen_to_vct(Xen_car(data));
+ v1 = xen_to_vct(Xen_cadr(data));
}
else v0 = xen_to_vct(data);
draw_graph_data(cp,
- XEN_TO_C_INT64_T_OR_ELSE(lo, -1),
- XEN_TO_C_INT64_T_OR_ELSE(hi, -1),
- v0->length,
- v0->data,
- (v1) ? (v1->data) : NULL,
- get_ax(cp, XEN_TO_C_INT_OR_ELSE(ax, (int)CHAN_GC), S_graph_data, xcr),
- (graph_style_t)XEN_TO_C_INT_OR_ELSE(style, (int)(cp->time_graph_style)));
+ (Xen_is_llong(lo)) ? Xen_llong_to_C_llong(lo) : -1,
+ (Xen_is_llong(hi)) ? Xen_llong_to_C_llong(hi) : -1,
+ mus_vct_length(v0),
+ mus_vct_data(v0),
+ (v1) ? (mus_vct_data(v1)) : NULL,
+ get_ax(cp, (Xen_is_integer(ax)) ? Xen_integer_to_C_int(ax) : (int)CHAN_GC, S_graph_data, xcr),
+ (Xen_is_integer(style)) ? (graph_style_t)Xen_integer_to_C_int(style) : cp->time_graph_style);
return(data);
}
-static XEN g_main_widgets(void)
+static Xen g_main_widgets(void)
{
#define H_main_widgets "(" S_main_widgets "): top level \
widgets (list (0)main-app (1)main-shell (2)main-pane (3)sound-pane (4)listener-pane (5)notebook-outer-pane)"
- XEN bad_temp, res; /* needed by old gcc -- gets confused by straight arg list */
+ Xen bad_temp, res; /* needed by old gcc -- gets confused by straight arg list */
int loc;
#if USE_MOTIF
- bad_temp = XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("XtAppContext"),
- C_TO_XEN_ULONG((unsigned long)MAIN_APP(ss)));
+ bad_temp = Xen_list_2(C_string_to_Xen_symbol("XtAppContext"),
+ C_ulong_to_Xen_ulong((unsigned long)MAIN_APP(ss)));
#else
- bad_temp = XEN_WRAP_WINDOW(MAIN_WINDOW(ss));
+ bad_temp = Xen_wrap_window(MAIN_WINDOW(ss));
#endif
loc = snd_protect(bad_temp);
- res = XEN_CONS(bad_temp,
- XEN_CONS(XEN_WRAP_WIDGET(MAIN_SHELL(ss)),
- XEN_CONS(XEN_WRAP_WIDGET(MAIN_PANE(ss)),
- XEN_CONS(XEN_WRAP_WIDGET(SOUND_PANE(ss)),
- XEN_CONS(XEN_WRAP_WIDGET(ss->listener_pane),
- XEN_CONS(XEN_WRAP_WIDGET(SOUND_PANE_BOX(ss)),
- XEN_EMPTY_LIST))))));
+ res = Xen_cons(bad_temp,
+ Xen_cons(Xen_wrap_widget(MAIN_SHELL(ss)),
+ Xen_cons(Xen_wrap_widget(MAIN_PANE(ss)),
+ Xen_cons(Xen_wrap_widget(SOUND_PANE(ss)),
+ Xen_cons(Xen_wrap_widget(ss->listener_pane),
+ Xen_cons(Xen_wrap_widget(SOUND_PANE_BOX(ss)),
+ Xen_empty_list))))));
snd_unprotect_at(loc);
return(res);
}
-static XEN dialog_widgets;
-static XEN new_widget_hook;
+static Xen dialog_widgets;
+static Xen new_widget_hook;
/* ideally this would be an "after method" on XtCreateWidget or gtk_new_* */
void run_new_widget_hook(widget_t w)
{
- if (XEN_HOOKED(new_widget_hook))
- run_hook(new_widget_hook, XEN_LIST_1(XEN_WRAP_WIDGET(w)), S_new_widget_hook);
+ if (Xen_hook_has_list(new_widget_hook))
+ run_hook(new_widget_hook, Xen_list_1(Xen_wrap_widget(w)), S_new_widget_hook);
}
static void check_dialog_widget_table(void)
{
- if (!(XEN_VECTOR_P(dialog_widgets)))
+ if (!(Xen_is_vector(dialog_widgets)))
{
- dialog_widgets = XEN_MAKE_VECTOR(NUM_DIALOGS, XEN_FALSE);
- XEN_PROTECT_FROM_GC(dialog_widgets);
+ dialog_widgets = Xen_make_vector(NUM_DIALOGS, Xen_false);
+ Xen_GC_protect(dialog_widgets);
}
}
-static XEN g_dialog_widgets(void)
+static Xen g_dialog_widgets(void)
{
#define H_dialog_widgets "(" S_dialog_widgets "): dialog widgets (each " PROC_FALSE " if not yet created): (list \
- (0 " S_color_orientation_dialog ") (1 " PROC_FALSE ") (2 " S_enved_dialog ") (3 " PROC_FALSE ") (4 " PROC_FALSE ") (5 " S_transform_dialog ") \
- (6 " S_open_file_dialog ") (7 " S_save_sound_dialog ") (8 " S_view_files_dialog ") (9 raw data dialog) (10 new file dialog) \
- (11 " S_mix_file_dialog ") (12 " S_edit_header_dialog ") (13 " S_find_dialog ") (14 " S_help_dialog ") (15 listener completion) \
- (16 " S_view_mixes_dialog ") (17 " S_print_dialog ") (18 " S_recorder_dialog ") (19 " S_view_regions_dialog ") \
- (20 " S_info_dialog ") (21 " PROC_FALSE ") (22 " S_save_selection_dialog ") (23 " S_insert_file_dialog ") \
- (24 " S_save_region_dialog ") (25 " S_preferences_dialog "))"
+ (0 " S_color_orientation_dialog ") (1 " S_enved_dialog ") (2 " S_transform_dialog ") \
+ (3 " S_open_file_dialog ") (4 " S_save_sound_dialog ") (5 " S_view_files_dialog ") (6 raw data dialog) (7 new file dialog) \
+ (8 " S_mix_file_dialog ") (9 " S_edit_header_dialog ") (10 " S_find_dialog ") (11 " S_help_dialog ") \
+ (12 " S_view_mixes_dialog ") (13 " S_print_dialog ") (14 " S_view_regions_dialog ") \
+ (15 " S_info_dialog ") (16 extra controls dialog) (17 " S_save_selection_dialog ") (18 " S_insert_file_dialog ") \
+ (19 " S_save_region_dialog ") (20 " S_preferences_dialog "))"
check_dialog_widget_table();
- return(XEN_VECTOR_TO_LIST(dialog_widgets));
+ return(Xen_vector_to_Xen_list(dialog_widgets));
}
@@ -823,100 +804,104 @@ void set_dialog_widget(snd_dialog_t which, widget_t wid)
ss->dialogs[ss->num_dialogs++] = wid;
check_dialog_widget_table();
-#if USE_GTK && HAVE_GTK_3
- gtk_widget_override_background_color(wid, GTK_STATE_NORMAL, (GdkRGBA *)(ss->basic_color));
-#endif
-
- if (XEN_FALSE_P(XEN_VECTOR_REF(dialog_widgets, (int)which)))
- XEN_VECTOR_SET(dialog_widgets, (int)which,
- XEN_WRAP_WIDGET(wid));
+ if (Xen_is_false(Xen_vector_ref(dialog_widgets, (int)which)))
+ Xen_vector_set(dialog_widgets, (int)which,
+ Xen_wrap_widget(wid));
else
{
- if (XEN_WIDGET_P(XEN_VECTOR_REF(dialog_widgets, (int)which)))
- XEN_VECTOR_SET(dialog_widgets, (int)which,
- XEN_LIST_2(XEN_WRAP_WIDGET(wid),
- XEN_VECTOR_REF(dialog_widgets, (int)which)));
- else XEN_VECTOR_SET(dialog_widgets, (int)which,
- XEN_CONS(XEN_WRAP_WIDGET(wid),
- XEN_VECTOR_REF(dialog_widgets, (int)which)));
+ if (Xen_is_widget(Xen_vector_ref(dialog_widgets, (int)which)))
+ Xen_vector_set(dialog_widgets, (int)which,
+ Xen_list_2(Xen_wrap_widget(wid),
+ Xen_vector_ref(dialog_widgets, (int)which)));
+ else Xen_vector_set(dialog_widgets, (int)which,
+ Xen_cons(Xen_wrap_widget(wid),
+ Xen_vector_ref(dialog_widgets, (int)which)));
}
run_new_widget_hook(wid);
}
-static XEN g_widget_position(XEN wid)
+static Xen g_widget_position(Xen wid)
{
#define H_widget_position "(" S_widget_position " wid): widget's position, (list x y), in pixels"
widget_t w;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ONLY_ARG, S_widget_position, "a Widget");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_widget_position, "a Widget");
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (!w)
- XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_widget_position ": no such widget: ~A"),
+ Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_widget_position ": no such widget: ~A"),
wid));
- return(XEN_LIST_2(C_TO_XEN_INT(widget_x(w)),
- C_TO_XEN_INT(widget_y(w))));
+ return(Xen_list_2(C_int_to_Xen_integer(widget_x(w)),
+ C_int_to_Xen_integer(widget_y(w))));
}
-static XEN g_set_widget_position(XEN wid, XEN xy)
+static Xen g_set_widget_position(Xen wid, Xen xy)
{
widget_t w;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ONLY_ARG, S_setB S_widget_position, "a Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(xy) && (XEN_LIST_LENGTH(xy) == 2), xy, XEN_ARG_2, S_setB S_widget_position, "a list: (x y)");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_set S_widget_position, "a Widget");
+ Xen_check_type(Xen_is_list(xy) && (Xen_list_length(xy) == 2), xy, 2, S_set S_widget_position, "a list: (x y)");
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (w)
- set_widget_position(w,
- mus_iclamp(0, XEN_TO_C_INT(XEN_CAR(xy)), LOTSA_PIXELS),
- mus_iclamp(0, XEN_TO_C_INT(XEN_CADR(xy)), LOTSA_PIXELS));
- else XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_setB S_widget_position ": no such widget: ~A"),
+ {
+ Xen_check_type(Xen_is_integer(Xen_car(xy)), Xen_car(xy), 0, S_set S_widget_position, "an integer");
+ Xen_check_type(Xen_is_integer(Xen_cadr(xy)), Xen_cadr(xy), 0, S_set S_widget_position, "an integer");
+ set_widget_position(w,
+ mus_iclamp(0, Xen_integer_to_C_int(Xen_car(xy)), LOTSA_PIXELS),
+ mus_iclamp(0, Xen_integer_to_C_int(Xen_cadr(xy)), LOTSA_PIXELS));
+ }
+ else Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_set S_widget_position ": no such widget: ~A"),
wid));
return(wid);
}
-static XEN g_widget_size(XEN wid)
+static Xen g_widget_size(Xen wid)
{
#define H_widget_size "(" S_widget_size " wid): widget's size, (list width height), in pixels"
widget_t w;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ONLY_ARG, S_widget_size, "a Widget");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_widget_size, "a Widget");
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (!w)
- XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_widget_size ": no such widget: ~A"),
+ Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_widget_size ": no such widget: ~A"),
wid));
- return(XEN_LIST_2(C_TO_XEN_INT(widget_width(w)),
- C_TO_XEN_INT(widget_height(w))));
+ return(Xen_list_2(C_int_to_Xen_integer(widget_width(w)),
+ C_int_to_Xen_integer(widget_height(w))));
}
-static XEN g_set_widget_size(XEN wid, XEN wh)
+static Xen g_set_widget_size(Xen wid, Xen wh)
{
widget_t w;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ARG_1, S_setB S_widget_size, "a Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(wh) && (XEN_LIST_LENGTH(wh) == 2), wh, XEN_ARG_2, S_setB S_widget_size, "a list: (width height)");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_set S_widget_size, "a Widget");
+ Xen_check_type(Xen_is_list(wh) && (Xen_list_length(wh) == 2), wh, 2, S_set S_widget_size, "a list: (width height)");
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (w)
- set_widget_size(w,
- mus_iclamp(1, XEN_TO_C_INT(XEN_CAR(wh)), LOTSA_PIXELS),
- mus_iclamp(1, XEN_TO_C_INT(XEN_CADR(wh)), LOTSA_PIXELS));
- else XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_setB S_widget_size ": no such widget: ~A"),
+ {
+ Xen_check_type(Xen_is_integer(Xen_car(wh)), Xen_car(wh), 0, S_set S_widget_size, "an integer");
+ Xen_check_type(Xen_is_integer(Xen_cadr(wh)), Xen_cadr(wh), 0, S_set S_widget_size, "an integer");
+ set_widget_size(w,
+ mus_iclamp(1, Xen_integer_to_C_int(Xen_car(wh)), LOTSA_PIXELS),
+ mus_iclamp(1, Xen_integer_to_C_int(Xen_cadr(wh)), LOTSA_PIXELS));
+ }
+ else Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_set S_widget_size ": no such widget: ~A"),
wid));
return(wid);
}
-static XEN g_widget_text(XEN wid)
+static Xen g_widget_text(Xen wid)
{
#define H_widget_text "(" S_widget_text " wid): widget's text or label"
widget_t w;
- XEN res = XEN_FALSE;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ONLY_ARG, S_widget_text, "a Widget");
+ Xen res = Xen_false;
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_widget_text, "a Widget");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (w)
{
#if USE_MOTIF
@@ -924,40 +909,40 @@ static XEN g_widget_text(XEN wid)
if ((XmIsText(w)) || (XmIsTextField(w)))
{
text = XmTextGetString(w);
- res = C_TO_XEN_STRING(text);
+ res = C_string_to_Xen_string(text);
}
else
{
XmString s1 = NULL;
XtVaGetValues(w, XmNlabelString, &s1, NULL);
- if (XmStringEmpty(s1)) return(XEN_FALSE);
+ if (XmStringEmpty(s1)) return(Xen_false);
text = (char *)XmStringUnparse(s1, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
XmStringFree(s1);
- res = C_TO_XEN_STRING(text);
+ res = C_string_to_Xen_string(text);
}
if (text) XtFree(text);
return(res);
#else
if (GTK_IS_ENTRY(w))
- return(C_TO_XEN_STRING((char *)gtk_entry_get_text(GTK_ENTRY(w))));
+ return(C_string_to_Xen_string((char *)gtk_entry_get_text(GTK_ENTRY(w))));
else
{
if ((GTK_IS_BIN(w)) && (GTK_IS_LABEL(BIN_CHILD(w))))
- return(C_TO_XEN_STRING((char *)gtk_label_get_text(GTK_LABEL(BIN_CHILD(w)))));
+ return(C_string_to_Xen_string((char *)gtk_label_get_text(GTK_LABEL(BIN_CHILD(w)))));
else
{
if (GTK_IS_LABEL(w))
- return(C_TO_XEN_STRING((char *)gtk_label_get_text(GTK_LABEL(w))));
+ return(C_string_to_Xen_string((char *)gtk_label_get_text(GTK_LABEL(w))));
else
{
if (GTK_IS_TEXT_VIEW(w))
{
- XEN val = XEN_FALSE;
+ Xen val = Xen_false;
char *text;
text = sg_get_text(w, 0, -1);
if (text)
{
- val = C_TO_XEN_STRING(text); /* this copies, so it should be safe to free the original */
+ val = C_string_to_Xen_string(text); /* this copies, so it should be safe to free the original */
g_free(text);
}
return(val);
@@ -967,25 +952,25 @@ static XEN g_widget_text(XEN wid)
}
#endif
}
- else XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_widget_text ": no such widget: ~A"),
+ else Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_widget_text ": no such widget: ~A"),
wid));
return(res);
}
-static XEN g_set_widget_text(XEN wid, XEN text)
+static Xen g_set_widget_text(Xen wid, Xen text)
{
widget_t w;
- const char *str = NULL;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ARG_1, S_setB S_widget_text, "a Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(text) || XEN_FALSE_P(text), text, XEN_ARG_2, S_setB S_widget_text, "a string");
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_set S_widget_text, "a Widget");
+ Xen_check_type(Xen_is_string(text) || Xen_is_false(text), text, 2, S_set S_widget_text, "a string");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (w)
{
- if (XEN_STRING_P(text)) str = XEN_TO_C_STRING(text);
+ const char *str = NULL;
+ if (Xen_is_string(text)) str = Xen_string_to_C_string(text);
#if USE_MOTIF
if ((XmIsText(w)) || (XmIsTextField(w)))
XmTextSetString(w, (char *)str);
@@ -996,19 +981,19 @@ static XEN g_set_widget_text(XEN wid, XEN text)
else set_button_label(w, str);
#endif
}
- else XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_setB S_widget_text ": no such widget: ~A"),
+ else Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_set S_widget_text ": no such widget: ~A"),
wid));
return(text);
}
-static XEN g_hide_widget(XEN wid)
+static Xen g_hide_widget(Xen wid)
{
#define H_hide_widget "(" S_hide_widget " widget): hide or undisplay widget"
widget_t w;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ONLY_ARG, S_hide_widget, "a Widget");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_hide_widget, "a Widget");
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (w)
{
#if USE_MOTIF
@@ -1017,19 +1002,19 @@ static XEN g_hide_widget(XEN wid)
gtk_widget_hide(w);
#endif
}
- else XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_hide_widget ": no such widget: ~A"),
+ else Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_hide_widget ": no such widget: ~A"),
wid));
return(wid);
}
-static XEN g_show_widget(XEN wid)
+static Xen g_show_widget(Xen wid)
{
#define H_show_widget "(" S_show_widget " widget): show or display widget"
widget_t w;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ONLY_ARG, S_show_widget, "a Widget");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_show_widget, "a Widget");
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (w)
{
#if USE_MOTIF
@@ -1038,73 +1023,73 @@ static XEN g_show_widget(XEN wid)
gtk_widget_show(w);
#endif
}
- else XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_show_widget ": no such widget: ~A"),
+ else Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_show_widget ": no such widget: ~A"),
wid));
return(wid);
}
-static XEN g_focus_widget(XEN wid)
+static Xen g_focus_widget(Xen wid)
{
#define H_focus_widget "(" S_focus_widget " widget): cause widget to receive input focus"
widget_t w;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(wid), wid, XEN_ONLY_ARG, S_focus_widget, "a Widget");
- w = (widget_t)(XEN_UNWRAP_WIDGET(wid));
+ Xen_check_type(Xen_is_widget(wid), wid, 1, S_focus_widget, "a Widget");
+ w = (widget_t)(Xen_unwrap_widget(wid));
if (w)
goto_window(w);
- else XEN_ERROR(NO_SUCH_WIDGET,
- XEN_LIST_2(C_TO_XEN_STRING(S_focus_widget ": no such widget: ~A"),
+ else Xen_error(NO_SUCH_WIDGET,
+ Xen_list_2(C_string_to_Xen_string(S_focus_widget ": no such widget: ~A"),
wid));
return(wid);
}
-static XEN g_snd_gcs(void)
+static Xen g_snd_gcs(void)
{
#define H_snd_gcs "(" S_snd_gcs "): a list of Snd graphics contexts (list (0 basic) (1 selected_basic) (2 combined) (3 \
cursor) (4 selected_cursor) (5 selection) (6 selected_selection) (7 erase) (8 selected_erase) (9 mark) (10 selected_mark) (11 mix) (12 \
fltenv_basic) (13 fltenv_data))."
#if USE_MOTIF
- #define XEN_WRAP_SND_GC(Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GC"), XEN_WRAP_C_POINTER(Value))
+ #define Xen_wrap_snd_gc(Value) Xen_list_2(C_string_to_Xen_symbol("GC"), Xen_wrap_C_pointer(Value))
#else
#if USE_GTK
- #define XEN_WRAP_SND_GC(Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("gc_t_"), XEN_WRAP_C_POINTER(Value))
+ #define Xen_wrap_snd_gc(Value) Xen_list_2(C_string_to_Xen_symbol("gc_t_"), Xen_wrap_C_pointer(Value))
#else
- #define XEN_WRAP_SND_GC(Value) XEN_FALSE
+ #define Xen_wrap_snd_gc(Value) Xen_false
#endif
#endif
#if (!USE_NO_GUI)
- return(XEN_CONS(XEN_WRAP_SND_GC(ss->basic_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->selected_basic_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->combined_basic_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->cursor_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->selected_cursor_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->selection_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->selected_selection_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->erase_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->selected_erase_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->mark_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->selected_mark_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->mix_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->fltenv_basic_gc),
- XEN_CONS(XEN_WRAP_SND_GC(ss->fltenv_data_gc),
- XEN_EMPTY_LIST)))))))))))))));
+ return(Xen_cons(Xen_wrap_snd_gc(ss->basic_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->selected_basic_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->combined_basic_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->cursor_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->selected_cursor_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->selection_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->selected_selection_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->erase_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->selected_erase_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->mark_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->selected_mark_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->mix_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->fltenv_basic_gc),
+ Xen_cons(Xen_wrap_snd_gc(ss->fltenv_data_gc),
+ Xen_empty_list)))))))))))))));
#else
- return(XEN_EMPTY_LIST);
+ return(Xen_empty_list);
#endif
}
-static XEN g_snd_color(XEN choice)
+static Xen g_snd_color(Xen choice)
{
#define H_snd_color "(" S_snd_color " num): color associated with 'num' -- see table of colors in snd-draw.c"
color_t col;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(choice), choice, XEN_ONLY_ARG, S_snd_color, "an integer");
+ Xen_check_type(Xen_is_integer(choice), choice, 1, S_snd_color, "an integer");
- switch (XEN_TO_C_INT(choice))
+ switch (Xen_integer_to_C_int(choice))
{
case 0: col = ss->white; break;
case 1: col = ss->black; break;
@@ -1144,22 +1129,22 @@ static XEN g_snd_color(XEN choice)
break;
default: col = ss->black; break;
}
- return(XEN_WRAP_PIXEL(col));
+ return(Xen_wrap_pixel(col));
}
-static XEN g_snd_font(XEN choice)
+static Xen g_snd_font(Xen choice)
{
#if USE_MOTIF
- #define WRAP_FONT(Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("Font"), C_TO_XEN_ULONG((unsigned long)Value))
+ #define WRAP_FONT(Value) Xen_list_2(C_string_to_Xen_symbol("Font"), C_ulong_to_Xen_ulong((unsigned long)Value))
#else
- #define WRAP_FONT(Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("PangoFontDescription_"), XEN_WRAP_C_POINTER(Value))
+ #define WRAP_FONT(Value) Xen_list_2(C_string_to_Xen_symbol("PangoFontDescription_"), Xen_wrap_C_pointer(Value))
#endif
#define H_snd_font "(" S_snd_font " num): font associated with 'num' -- see table of fonts in snd-draw.c"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(choice), choice, XEN_ONLY_ARG, S_snd_font, "an integer");
+ Xen_check_type(Xen_is_integer(choice), choice, 1, S_snd_font, "an integer");
- switch (XEN_TO_C_INT(choice))
+ switch (Xen_integer_to_C_int(choice))
{
#if USE_MOTIF
case 0: return(WRAP_FONT(ss->peaks_fontstruct->fid)); break;
@@ -1177,50 +1162,50 @@ static XEN g_snd_font(XEN choice)
case 4: return(WRAP_FONT(ss->axis_numbers_fnt)); break;
case 5: return(WRAP_FONT(ss->listener_fnt)); break;
#endif
- default: return(XEN_FALSE); break;
+ default: return(Xen_false); break;
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_make_cairo(XEN drawer)
+static Xen g_make_cairo(Xen drawer)
{
#define H_make_cairo "(" S_make_cairo " widget) in gtk, this returns a new cairo_t to draw on the widget."
#if USE_GTK
- #define C_TO_XEN_cairo_t(Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("cairo_t_"), XEN_WRAP_C_POINTER(Value))
+ #define C_to_Xen_cairo_t(Value) Xen_list_2(C_string_to_Xen_symbol("cairo_t_"), Xen_wrap_C_pointer(Value))
cairo_t *cr;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(drawer), drawer, XEN_ONLY_ARG, S_make_cairo, "a widget");
+ Xen_check_type(Xen_is_widget(drawer), drawer, 1, S_make_cairo, "a widget");
-#if (!HAVE_GTK_3)
- cr = MAKE_CAIRO(GDK_DRAWABLE(gtk_widget_get_window(XEN_UNWRAP_WIDGET(drawer))));
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ cr = make_cairo(GDK_DRAWABLE(gtk_widget_get_window(Xen_unwrap_widget(drawer))));
#else
- cr = MAKE_CAIRO(GDK_WINDOW(gtk_widget_get_window(XEN_UNWRAP_WIDGET(drawer))));
+ cr = make_cairo(GDK_WINDOW(gtk_widget_get_window(Xen_unwrap_widget(drawer))));
#endif
- return(C_TO_XEN_cairo_t(cr));
+ return(C_to_Xen_cairo_t(cr));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_free_cairo(XEN xcr)
+static Xen g_free_cairo(Xen xcr)
{
#define H_free_cairo "(" S_free_cairo " cr) in gtk, this frees (destroys) the cairo_t 'cr'."
#if USE_GTK
- if ((XEN_LIST_P(xcr)) &&
- (XEN_LIST_LENGTH(xcr) == 2) &&
- (XEN_SYMBOL_P(XEN_CAR(xcr))) &&
- (strcmp("cairo_t_", XEN_SYMBOL_TO_C_STRING(XEN_CAR(xcr))) == 0))
- FREE_CAIRO((cairo_t *)XEN_UNWRAP_C_POINTER(XEN_CADR(xcr)));
+ if ((Xen_is_list(xcr)) &&
+ (Xen_list_length(xcr) == 2) &&
+ (Xen_is_symbol(Xen_car(xcr))) &&
+ (strcmp("cairo_t_", Xen_symbol_to_C_string(Xen_car(xcr))) == 0))
+ free_cairo((cairo_t *)Xen_unwrap_C_pointer(Xen_cadr(xcr)));
else
- XEN_ERROR(XEN_ERROR_TYPE("not-a-graphics-context"),
- XEN_LIST_2(C_TO_XEN_STRING(S_free_cairo ": cairo_t argument is not a cairo_t pointer: ~A"), xcr));
+ Xen_error(Xen_make_error_type("not-a-graphics-context"),
+ Xen_list_2(C_string_to_Xen_string(S_free_cairo ": cairo_t argument is not a cairo_t pointer: ~A"), xcr));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -1266,36 +1251,36 @@ void sgl_set_currents(bool with_dialogs)
/* -------- shared color funcs -------- */
-static XEN g_color_p(XEN obj)
+static Xen g_is_color(Xen obj)
{
- #define H_color_p "(" S_color_p " obj): " PROC_TRUE " if obj is a color"
- return(C_TO_XEN_BOOLEAN(XEN_PIXEL_P(obj)));
+ #define H_is_color "(" S_is_color " obj): " PROC_TRUE " if obj is a color"
+ return(C_bool_to_Xen_boolean(Xen_is_pixel(obj)));
}
-mus_float_t check_color_range(const char *caller, XEN val)
+mus_float_t check_color_range(const char *caller, Xen val)
{
mus_float_t rf;
- rf = XEN_TO_C_DOUBLE(val);
+ rf = Xen_real_to_C_double(val);
if ((rf > 1.0) || (rf < 0.0))
- XEN_OUT_OF_RANGE_ERROR(caller, 1, val, "value ~A must be between 0.0 and 1.0");
+ Xen_out_of_range_error(caller, 1, val, "value must be between 0.0 and 1.0");
return(rf);
}
-static XEN g_set_cursor_color(XEN color)
+static Xen g_set_cursor_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_cursor_color, "a color");
- color_cursor(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_cursor_color, "a color");
+ color_cursor(Xen_unwrap_pixel(color));
for_each_chan(update_graph);
return(color);
}
-static XEN g_cursor_color(void)
+static Xen g_cursor_color(void)
{
#define H_cursor_color "(" S_cursor_color "): cursor color"
- return(XEN_WRAP_PIXEL(ss->cursor_color));
+ return(Xen_wrap_pixel(ss->cursor_color));
}
@@ -1318,215 +1303,244 @@ static void highlight_recolor_everything(widget_t w, color_t color)
void set_highlight_color(color_t color)
{
+#if USE_MOTIF
color_t old_color;
old_color = ss->highlight_color;
+#endif
ss->highlight_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->highlight_color_symbol, Xen_wrap_pixel(color));
+#endif
#if USE_MOTIF
map_over_children_with_color(MAIN_SHELL(ss), highlight_recolor_everything, old_color);
#endif
}
-static XEN g_set_highlight_color(XEN color)
+static Xen g_set_highlight_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_highlight_color, "a color");
- set_highlight_color(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_highlight_color, "a color");
+ set_highlight_color(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_highlight_color(void)
+static Xen g_highlight_color(void)
{
#define H_highlight_color "(" S_highlight_color "): color of highlighted text or buttons"
- return(XEN_WRAP_PIXEL(ss->highlight_color));
+ return(Xen_wrap_pixel(ss->highlight_color));
}
-static XEN g_set_mark_color(XEN color)
+static Xen g_set_mark_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_mark_color, "a color");
- color_marks(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_mark_color, "a color");
+ color_marks(Xen_unwrap_pixel(color));
for_each_chan(update_graph);
return(color);
}
-static XEN g_mark_color(void)
+static Xen g_mark_color(void)
{
#define H_mark_color "(" S_mark_color "): mark color"
- return(XEN_WRAP_PIXEL(ss->mark_color));
+ return(Xen_wrap_pixel(ss->mark_color));
}
void set_zoom_color(color_t color)
{
ss->zoom_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->zoom_color_symbol, Xen_wrap_pixel(color));
+#endif
color_chan_components(ss->zoom_color, COLOR_ZOOM);
}
-static XEN g_set_zoom_color(XEN color)
+static Xen g_set_zoom_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_zoom_color, "a color");
- set_zoom_color(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_zoom_color, "a color");
+ set_zoom_color(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_zoom_color(void)
+static Xen g_zoom_color(void)
{
#define H_zoom_color "(" S_zoom_color "): color of zoom sliders"
- return(XEN_WRAP_PIXEL(ss->zoom_color));
+ return(Xen_wrap_pixel(ss->zoom_color));
}
void set_position_color(color_t color)
{
ss->position_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->position_color_symbol, Xen_wrap_pixel(color));
+#endif
color_chan_components(ss->position_color, COLOR_POSITION);
}
-static XEN g_set_position_color(XEN color)
+static Xen g_set_position_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_position_color, "a color");
- set_position_color(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_position_color, "a color");
+ set_position_color(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_position_color(void)
+static Xen g_position_color(void)
{
#define H_position_color "(" S_position_color "): color of position sliders"
- return(XEN_WRAP_PIXEL(ss->position_color));
+ return(Xen_wrap_pixel(ss->position_color));
}
-static XEN g_set_listener_color(XEN color)
+static Xen g_set_listener_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_listener_color, "a color");
- color_listener(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_listener_color, "a color");
+ color_listener(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_listener_color(void)
+static Xen g_listener_color(void)
{
#define H_listener_color "(" S_listener_color "): background color of the lisp listener"
- return(XEN_WRAP_PIXEL(ss->listener_color));
+ return(Xen_wrap_pixel(ss->listener_color));
}
-static XEN g_set_listener_text_color(XEN color)
+static Xen g_set_listener_text_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_listener_text_color, "a color");
- color_listener_text(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_listener_text_color, "a color");
+ color_listener_text(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_listener_text_color(void)
+static Xen g_listener_text_color(void)
{
#define H_listener_text_color "(" S_listener_text_color "): text color in the lisp listener"
- return(XEN_WRAP_PIXEL(ss->listener_text_color));
+ return(Xen_wrap_pixel(ss->listener_text_color));
}
-static XEN g_set_enved_waveform_color(XEN color)
+static Xen g_set_enved_waveform_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_enved_waveform_color, "a color");
- color_enved_waveform(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_enved_waveform_color, "a color");
+ ss->enved_waveform_color = Xen_unwrap_pixel(color);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->enved_waveform_color_symbol, color);
+#endif
+ color_enved_waveform(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_enved_waveform_color(void)
+static Xen g_enved_waveform_color(void)
{
#define H_enved_waveform_color "(" S_enved_waveform_color "): color of the envelope editor wave display"
- return(XEN_WRAP_PIXEL(ss->enved_waveform_color));
+ return(Xen_wrap_pixel(ss->enved_waveform_color));
}
-static XEN g_set_filter_control_waveform_color(XEN color)
+static Xen g_set_filter_control_waveform_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_filter_control_waveform_color, "a color");
- color_filter_waveform(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_filter_control_waveform_color, "a color");
+ ss->filter_control_waveform_color = Xen_unwrap_pixel(color);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->filter_control_waveform_color_symbol, color);
+#endif
+ color_filter_waveform(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_filter_control_waveform_color(void)
+static Xen g_filter_control_waveform_color(void)
{
#define H_filter_control_waveform_color "(" S_filter_control_waveform_color "): color of the filter waveform"
- return(XEN_WRAP_PIXEL(ss->filter_control_waveform_color));
+ return(Xen_wrap_pixel(ss->filter_control_waveform_color));
}
-static XEN g_set_selection_color(XEN color)
+static Xen g_set_selection_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_selection_color, "a color");
- color_selection(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_selection_color, "a color");
+ color_selection(Xen_unwrap_pixel(color));
for_each_chan(update_graph);
return(color);
}
-static XEN g_selection_color(void)
+static Xen g_selection_color(void)
{
#define H_selection_color "(" S_selection_color "): selection color"
- return(XEN_WRAP_PIXEL(ss->selection_color));
+ return(Xen_wrap_pixel(ss->selection_color));
}
-static XEN g_set_text_focus_color(XEN color)
+static Xen g_set_text_focus_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_text_focus_color, "a color");
- ss->text_focus_color = XEN_UNWRAP_PIXEL(color);
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_text_focus_color, "a color");
+ ss->text_focus_color = Xen_unwrap_pixel(color);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->text_focus_color_symbol, color);
+#endif
return(color);
}
-static XEN g_text_focus_color(void)
+static Xen g_text_focus_color(void)
{
#define H_text_focus_color "(" S_text_focus_color "): color used to show a text field has focus"
- return(XEN_WRAP_PIXEL(ss->text_focus_color));
+ return(Xen_wrap_pixel(ss->text_focus_color));
}
-static XEN g_set_sash_color(XEN color)
+static Xen g_set_sash_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_sash_color, "a color");
- ss->sash_color = XEN_UNWRAP_PIXEL(color);
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_sash_color, "a color");
+ ss->sash_color = Xen_unwrap_pixel(color);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->sash_color_symbol, color);
+#endif
return(color);
}
-static XEN g_sash_color(void)
+static Xen g_sash_color(void)
{
#define H_sash_color "(" S_sash_color "): color used to draw paned window sashes"
- return(XEN_WRAP_PIXEL(ss->sash_color));
+ return(Xen_wrap_pixel(ss->sash_color));
}
-static XEN g_data_color(void)
+static Xen g_data_color(void)
{
#define H_data_color "(" S_data_color "): color used to draw unselected data"
- return(XEN_WRAP_PIXEL(ss->data_color));
+ return(Xen_wrap_pixel(ss->data_color));
}
void set_data_color(color_t color)
{
+ ss->data_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->data_color_symbol, Xen_wrap_pixel(color));
+#endif
color_data(color);
ss->grid_color = get_in_between_color(ss->data_color, ss->graph_color);
for_each_chan(update_graph);
}
-static XEN g_set_data_color(XEN color)
+static Xen g_set_data_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_data_color, "a color");
- set_data_color(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_data_color, "a color");
+ set_data_color(Xen_unwrap_pixel(color));
return(color);
}
@@ -1534,6 +1548,10 @@ static XEN g_set_data_color(XEN color)
void set_selected_data_color(color_t color)
{
chan_info *cp;
+ ss->selected_data_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->selected_data_color_symbol, Xen_wrap_pixel(color));
+#endif
color_selected_data(color);
ss->selected_grid_color = get_in_between_color(ss->selected_data_color, ss->selected_graph_color);
cp = selected_channel();
@@ -1541,47 +1559,55 @@ void set_selected_data_color(color_t color)
}
-static XEN g_set_selected_data_color(XEN color)
+static Xen g_set_selected_data_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_selected_data_color, "a color");
- set_selected_data_color(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_selected_data_color, "a color");
+ set_selected_data_color(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_selected_data_color(void)
+static Xen g_selected_data_color(void)
{
#define H_selected_data_color "(" S_selected_data_color "): color used for selected data"
- return(XEN_WRAP_PIXEL(ss->selected_data_color));
+ return(Xen_wrap_pixel(ss->selected_data_color));
}
void set_graph_color(color_t color)
{
color_graph(color);
+ ss->graph_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->graph_color_symbol, Xen_wrap_pixel(color));
+#endif
color_unselected_graphs(color);
ss->grid_color = get_in_between_color(ss->data_color, ss->graph_color);
}
-static XEN g_set_graph_color(XEN color)
+static Xen g_set_graph_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_graph_color, "a color");
- set_graph_color(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_graph_color, "a color");
+ set_graph_color(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_graph_color(void)
+static Xen g_graph_color(void)
{
#define H_graph_color "(" S_graph_color "): background color used for unselected data"
- return(XEN_WRAP_PIXEL(ss->graph_color));
+ return(Xen_wrap_pixel(ss->graph_color));
}
void set_selected_graph_color(color_t color)
{
chan_info *cp;
+ ss->selected_graph_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->selected_graph_color_symbol, Xen_wrap_pixel(color));
+#endif
color_selected_graph(color);
ss->selected_grid_color = get_in_between_color(ss->selected_data_color, ss->selected_graph_color);
cp = selected_channel();
@@ -1596,82 +1622,93 @@ void set_selected_graph_color(color_t color)
}
-static XEN g_set_selected_graph_color(XEN color)
+static Xen g_set_selected_graph_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_selected_graph_color, "a color");
- set_selected_graph_color(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_selected_graph_color, "a color");
+ set_selected_graph_color(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_selected_graph_color(void)
+static Xen g_selected_graph_color(void)
{
#define H_selected_graph_color "(" S_selected_graph_color "): background color of selected data"
- return(XEN_WRAP_PIXEL(ss->selected_graph_color));
+ return(Xen_wrap_pixel(ss->selected_graph_color));
}
-static XEN g_set_axis_color(XEN color)
+static Xen g_set_axis_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_axis_color, "a color");
- ss->axis_color = XEN_UNWRAP_PIXEL(color);
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_axis_color, "a color");
+ ss->axis_color = Xen_unwrap_pixel(color);
ss->axis_color_set = true;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->axis_color_symbol, color);
+#endif
for_each_chan(update_graph);
return(color);
}
-static XEN g_axis_color(void)
+static Xen g_axis_color(void)
{
#define H_axis_color "(" S_axis_color "): color of axis (defaults to current data color)"
- return(XEN_WRAP_PIXEL(ss->axis_color));
+ return(Xen_wrap_pixel(ss->axis_color));
}
-static XEN g_basic_color(void)
+static Xen g_basic_color(void)
{
#define H_basic_color "(" S_basic_color "): Snd's basic color"
- return(XEN_WRAP_PIXEL(ss->basic_color));
+ return(Xen_wrap_pixel(ss->basic_color));
}
#if USE_GTK
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
+#if (!GTK_CHECK_VERSION(3, 16, 0))
static bool is_dark(color_info *color)
{
return(color->red + color->green + color->blue < 0.75);
}
#endif
+#endif
static void recolor_everything_1(widget_t w, gpointer color)
{
+#if (!GTK_CHECK_VERSION(3, 16, 0))
if ((GTK_IS_WIDGET(w)) &&
(w != ss->listener_pane))
{
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ /* this is a gigantic memory leak */
+#if 0
gtk_widget_modify_bg(w, GTK_STATE_NORMAL, (GdkColor *)color);
if (GTK_IS_CONTAINER(w))
gtk_container_foreach(GTK_CONTAINER(w), recolor_everything_1, color);
+#endif
+
#else
- gtk_widget_override_background_color(w, GTK_STATE_NORMAL, (GdkRGBA *)color);
+ gtk_widget_override_background_color(w, GTK_STATE_FLAG_ACTIVE, (GdkRGBA *)color);
if (GTK_IS_LABEL(w))
{
- if (is_dark(color))
- gtk_widget_override_color(w, GTK_STATE_NORMAL, (GdkRGBA *)(ss->white));
- else gtk_widget_override_color(w, GTK_STATE_NORMAL, (GdkRGBA *)(ss->black));
+ if (is_dark((color_info *)color))
+ gtk_widget_override_color(w, GTK_STATE_FLAG_ACTIVE, (GdkRGBA *)(ss->white));
+ else gtk_widget_override_color(w, GTK_STATE_FLAG_ACTIVE, (GdkRGBA *)(ss->black));
}
if (GTK_IS_CONTAINER(w))
gtk_container_foreach(GTK_CONTAINER(w), recolor_everything_1, color);
#endif
}
+#endif
}
void recolor_everything(widget_t w, gpointer color)
{
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
GdkColor *nc;
nc = rgb_to_gdk_color((color_t)color);
#else
@@ -1682,29 +1719,31 @@ void recolor_everything(widget_t w, gpointer color)
}
-static XEN g_color_to_list(XEN obj)
+static Xen g_color_to_list(Xen obj)
{
#define H_color_to_list "(" S_color_to_list " obj): 'obj' rgb values as a list of floats"
color_info *v;
- XEN_ASSERT_TYPE(XEN_PIXEL_P(obj), obj, XEN_ONLY_ARG, S_color_to_list, "a color");
- v = XEN_UNWRAP_PIXEL(obj);
- return(XEN_LIST_4(C_TO_XEN_DOUBLE(RGB_TO_FLOAT(v->red)),
- C_TO_XEN_DOUBLE(RGB_TO_FLOAT(v->green)),
- C_TO_XEN_DOUBLE(RGB_TO_FLOAT(v->blue)),
- C_TO_XEN_DOUBLE(v->alpha)));
+ Xen_check_type(Xen_is_pixel(obj), obj, 1, S_color_to_list, "a color");
+ v = Xen_unwrap_pixel(obj);
+ if (v)
+ return(Xen_list_4(C_double_to_Xen_real(rgb_to_float(v->red)),
+ C_double_to_Xen_real(rgb_to_float(v->green)),
+ C_double_to_Xen_real(rgb_to_float(v->blue)),
+ C_double_to_Xen_real(v->alpha)));
+ return(Xen_empty_list);
}
-static XEN g_make_color(XEN r, XEN g, XEN b, XEN alpha)
+static Xen g_make_color(Xen r, Xen g, Xen b, Xen alpha)
{
#define H_make_color "(" S_make_color " r g b alpha): return a color object with the indicated rgb values"
color_info *ccolor;
mus_float_t rf, gf, bf;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(r), r, XEN_ARG_1, S_make_color, "a number");
+ Xen_check_type(Xen_is_number(r), r, 1, S_make_color, "a number");
/* someday accept a list as r */
- XEN_ASSERT_TYPE(XEN_NUMBER_P(g), g, XEN_ARG_2, S_make_color, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(b), b, XEN_ARG_3, S_make_color, "a number");
+ Xen_check_type(Xen_is_number(g), g, 2, S_make_color, "a number");
+ Xen_check_type(Xen_is_number(b), b, 3, S_make_color, "a number");
rf = check_color_range(S_make_color, r);
gf = check_color_range(S_make_color, g);
@@ -1714,11 +1753,11 @@ static XEN g_make_color(XEN r, XEN g, XEN b, XEN alpha)
ccolor->green = gf;
ccolor->blue = bf;
- if (XEN_NUMBER_P(alpha))
+ if (Xen_is_number(alpha))
ccolor->alpha = check_color_range(S_make_color, alpha);
else ccolor->alpha = 1.0;
- return(XEN_WRAP_PIXEL(ccolor));
+ return(Xen_wrap_pixel(ccolor));
}
#endif
@@ -1736,39 +1775,39 @@ static void recolor_everything(widget_t w, color_t color)
}
}
-static XEN g_color_to_list(XEN obj)
+static Xen g_color_to_list(Xen obj)
{
#define H_color_to_list "(" S_color_to_list " obj): 'obj' rgb values as a list of floats"
Colormap cmap;
XColor tmp_color;
Display *dpy;
- XEN_ASSERT_TYPE(XEN_PIXEL_P(obj), obj, XEN_ONLY_ARG, S_color_to_list, "a color");
+ Xen_check_type(Xen_is_pixel(obj), obj, 1, S_color_to_list, "a color");
dpy = XtDisplay(MAIN_SHELL(ss));
cmap = DefaultColormap(dpy, DefaultScreen(dpy));
tmp_color.flags = DoRed | DoGreen | DoBlue;
- tmp_color.pixel = XEN_UNWRAP_PIXEL(obj);
+ tmp_color.pixel = Xen_unwrap_pixel(obj);
XQueryColor(dpy, cmap, &tmp_color);
- return(XEN_LIST_3(C_TO_XEN_DOUBLE(RGB_TO_FLOAT(tmp_color.red)),
- C_TO_XEN_DOUBLE(RGB_TO_FLOAT(tmp_color.green)),
- C_TO_XEN_DOUBLE(RGB_TO_FLOAT(tmp_color.blue))));
+ return(Xen_list_3(C_double_to_Xen_real(rgb_to_float(tmp_color.red)),
+ C_double_to_Xen_real(rgb_to_float(tmp_color.green)),
+ C_double_to_Xen_real(rgb_to_float(tmp_color.blue))));
}
-static XEN g_make_color(XEN r, XEN g, XEN b, XEN alpha)
+static Xen g_make_color(Xen r, Xen g, Xen b, Xen alpha)
{
/* alpha is ignored in Motif */
- #define H_make_color "(" S_make_color " r g b): return a color object with the indicated rgb values"
+ #define H_make_color "(" S_make_color " r g b alpha): return a color object with the indicated rgb values"
Colormap cmap;
XColor tmp_color;
Display *dpy;
mus_float_t rf, gf, bf;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(r), r, XEN_ARG_1, S_make_color, "a number");
+ Xen_check_type(Xen_is_number(r), r, 1, S_make_color, "a number");
/* someday accept a list as r */
- XEN_ASSERT_TYPE(XEN_NUMBER_P(g), g, XEN_ARG_2, S_make_color, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(b), b, XEN_ARG_3, S_make_color, "a number");
+ Xen_check_type(Xen_is_number(g), g, 2, S_make_color, "a number");
+ Xen_check_type(Xen_is_number(b), b, 3, S_make_color, "a number");
rf = check_color_range(S_make_color, r);
gf = check_color_range(S_make_color, g);
@@ -1776,24 +1815,29 @@ static XEN g_make_color(XEN r, XEN g, XEN b, XEN alpha)
dpy = XtDisplay(MAIN_SHELL(ss));
cmap = DefaultColormap(dpy, DefaultScreen(dpy));
tmp_color.flags = DoRed | DoGreen | DoBlue;
- tmp_color.red = FLOAT_TO_RGB(rf);
- tmp_color.green = FLOAT_TO_RGB(gf);
- tmp_color.blue = FLOAT_TO_RGB(bf);
+ tmp_color.red = float_to_rgb(rf);
+ tmp_color.green = float_to_rgb(gf);
+ tmp_color.blue = float_to_rgb(bf);
if ((XAllocColor(dpy, cmap, &tmp_color)) == 0)
- XEN_ERROR(XEN_ERROR_TYPE("no-such-color"),
- XEN_LIST_4(C_TO_XEN_STRING(S_make_color ": can't allocate this color! (~A ~A ~A)"),
+ Xen_error(Xen_make_error_type("no-such-color"),
+ Xen_list_4(C_string_to_Xen_string(S_make_color ": can't allocate this color! (~A ~A ~A)"),
r, g, b));
- return(XEN_WRAP_PIXEL(tmp_color.pixel));
+ return(Xen_wrap_pixel(tmp_color.pixel));
}
#endif
void set_basic_color(color_t color)
{
+#if USE_MOTIF
color_t old_color;
old_color = ss->basic_color;
+#endif
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->basic_color_symbol, Xen_wrap_pixel(color));
+#endif
ss->basic_color = color;
#if USE_MOTIF
map_over_children_with_color(MAIN_SHELL(ss), recolor_everything, old_color);
@@ -1809,41 +1853,41 @@ void set_basic_color(color_t color)
}
-static XEN g_set_basic_color(XEN color)
+static Xen g_set_basic_color(Xen color)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ONLY_ARG, S_setB S_basic_color, "a color");
- set_basic_color(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_basic_color, "a color");
+ set_basic_color(Xen_unwrap_pixel(color));
return(color);
}
-static XEN g_mix_color(XEN mix_id)
+static Xen g_mix_color(Xen mix_id)
{
#define H_mix_color "(" S_mix_color " :optional mix-id): color of all mix tags (if mix-id is omitted), or of mix-id's tag"
- if (XEN_MIX_P(mix_id))
- return(XEN_WRAP_PIXEL(mix_color_from_id(XEN_MIX_TO_C_INT(mix_id))));
- return(XEN_WRAP_PIXEL(ss->mix_color));
+ if (xen_is_mix(mix_id))
+ return(Xen_wrap_pixel(mix_color_from_id(Xen_mix_to_C_int(mix_id))));
+ return(Xen_wrap_pixel(ss->mix_color));
}
-static XEN g_set_mix_color(XEN color, XEN mix_id)
+static Xen g_set_mix_color(Xen color, Xen mix_id)
{
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ARG_1, S_setB S_mix_color, "a color");
- XEN_ASSERT_TYPE(XEN_MIX_P(mix_id) || XEN_NOT_BOUND_P(mix_id), mix_id, XEN_ARG_2, S_setB S_mix_color, "a mix");
- if (XEN_MIX_P(mix_id))
- mix_set_color_from_id(XEN_MIX_TO_C_INT(mix_id), XEN_UNWRAP_PIXEL(color));
- else color_mixes(XEN_UNWRAP_PIXEL(color));
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_mix_color, "a color");
+ Xen_check_type(xen_is_mix(mix_id) || !Xen_is_bound(mix_id), mix_id, 2, S_set S_mix_color, "a mix");
+ if (xen_is_mix(mix_id))
+ mix_set_color_from_id(Xen_mix_to_C_int(mix_id), Xen_unwrap_pixel(color));
+ else color_mixes(Xen_unwrap_pixel(color));
return(color);
}
-WITH_TWO_SETTER_ARGS(g_set_mix_color_reversed, g_set_mix_color)
+with_two_setter_args(g_set_mix_color_reversed, g_set_mix_color)
-bool foreground_color_ok(XEN color, graphics_context *ax)
+bool foreground_color_ok(Xen color, graphics_context *ax)
{
- if (XEN_PIXEL_P(color))
+ if (Xen_is_pixel(color))
{
- set_foreground_color(ax, (color_t)XEN_UNWRAP_PIXEL(color));
+ set_foreground_color(ax, (color_t)Xen_unwrap_pixel(color));
return(true);
}
return(false);
@@ -1851,308 +1895,250 @@ bool foreground_color_ok(XEN color, graphics_context *ax)
-static XEN g_combined_data_color(XEN snd, XEN chn)
+static Xen g_combined_data_color(Xen snd, Xen chn)
{
#define H_combined_data_color "(" S_combined_data_color " snd chn): color of this channel's data if graphed with channels-combined"
chan_info *cp;
- ASSERT_CHANNEL(S_combined_data_color, snd, chn, 1);
+ Snd_assert_channel(S_combined_data_color, snd, chn, 1);
cp = get_cp(snd, chn, S_combined_data_color);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- return(XEN_WRAP_PIXEL(cp->combined_data_color));
+ return(Xen_wrap_pixel(cp->combined_data_color));
}
-static XEN g_set_combined_data_color(XEN color, XEN snd, XEN chn)
+static Xen g_set_combined_data_color(Xen color, Xen snd, Xen chn)
{
chan_info *cp;
- XEN_ASSERT_TYPE(XEN_PIXEL_P(color), color, XEN_ARG_1, S_setB S_combined_data_color, "a color");
- ASSERT_CHANNEL(S_combined_data_color, snd, chn, 1);
+ Xen_check_type(Xen_is_pixel(color), color, 1, S_set S_combined_data_color, "a color");
+ Snd_assert_channel(S_combined_data_color, snd, chn, 1);
cp = get_cp(snd, chn, S_combined_data_color);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- cp->combined_data_color = XEN_UNWRAP_PIXEL(color);
+ cp->combined_data_color = Xen_unwrap_pixel(color);
+ update_graph(cp);
return(color);
}
-WITH_THREE_SETTER_ARGS(g_set_combined_data_color_reversed, g_set_combined_data_color)
-
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_8(g_draw_line_w, g_draw_line)
-XEN_ARGIFY_7(g_draw_dot_w, g_draw_dot)
-XEN_ARGIFY_5(g_draw_lines_w, g_draw_lines)
-XEN_ARGIFY_6(g_draw_dots_w, g_draw_dots)
-XEN_ARGIFY_7(g_draw_string_w, g_draw_string)
-XEN_ARGIFY_9(g_fill_rectangle_w, g_fill_rectangle)
-XEN_ARGIFY_5(g_fill_polygon_w, g_fill_polygon)
-XEN_ARGIFY_3(g_foreground_color_w, g_foreground_color)
-XEN_ARGIFY_4(g_set_foreground_color_w, g_set_foreground_color)
-XEN_ARGIFY_3(g_current_font_w, g_current_font)
-XEN_ARGIFY_4(g_set_current_font_w, g_set_current_font)
-XEN_NARGIFY_0(g_main_widgets_w, g_main_widgets)
-XEN_NARGIFY_0(g_dialog_widgets_w, g_dialog_widgets)
-XEN_NARGIFY_1(g_widget_size_w, g_widget_size)
-XEN_NARGIFY_2(g_set_widget_size_w, g_set_widget_size)
-XEN_NARGIFY_1(g_widget_position_w, g_widget_position)
-XEN_NARGIFY_2(g_set_widget_position_w, g_set_widget_position)
-XEN_NARGIFY_1(g_widget_text_w, g_widget_text)
-XEN_NARGIFY_2(g_set_widget_text_w, g_set_widget_text)
-XEN_NARGIFY_1(g_hide_widget_w, g_hide_widget)
-XEN_NARGIFY_1(g_show_widget_w, g_show_widget)
-XEN_NARGIFY_1(g_focus_widget_w, g_focus_widget)
-XEN_ARGIFY_5(g_make_graph_data_w, g_make_graph_data)
-XEN_ARGIFY_8(g_graph_data_w, g_graph_data)
-XEN_VARGIFY(g_make_bezier_w, g_make_bezier)
-XEN_NARGIFY_0(g_snd_gcs_w, g_snd_gcs)
-XEN_NARGIFY_1(g_snd_color_w, g_snd_color)
-XEN_NARGIFY_1(g_snd_font_w, g_snd_font)
-XEN_NARGIFY_1(g_make_cairo_w, g_make_cairo)
-XEN_NARGIFY_1(g_free_cairo_w, g_free_cairo)
-
-XEN_NARGIFY_0(g_selection_color_w, g_selection_color)
-XEN_NARGIFY_1(g_set_selection_color_w, g_set_selection_color)
-XEN_NARGIFY_0(g_zoom_color_w, g_zoom_color)
-XEN_NARGIFY_1(g_set_zoom_color_w, g_set_zoom_color)
-XEN_NARGIFY_0(g_position_color_w, g_position_color)
-XEN_NARGIFY_1(g_set_position_color_w, g_set_position_color)
-XEN_NARGIFY_0(g_mark_color_w, g_mark_color)
-XEN_NARGIFY_1(g_set_mark_color_w, g_set_mark_color)
-XEN_NARGIFY_0(g_listener_color_w, g_listener_color)
-XEN_NARGIFY_1(g_set_listener_color_w, g_set_listener_color)
-XEN_NARGIFY_0(g_listener_text_color_w, g_listener_text_color)
-XEN_NARGIFY_1(g_set_listener_text_color_w, g_set_listener_text_color)
-XEN_NARGIFY_0(g_enved_waveform_color_w, g_enved_waveform_color)
-XEN_NARGIFY_1(g_set_enved_waveform_color_w, g_set_enved_waveform_color)
-XEN_NARGIFY_0(g_filter_control_waveform_color_w, g_filter_control_waveform_color)
-XEN_NARGIFY_1(g_set_filter_control_waveform_color_w, g_set_filter_control_waveform_color)
-XEN_NARGIFY_0(g_highlight_color_w, g_highlight_color)
-XEN_NARGIFY_1(g_set_highlight_color_w, g_set_highlight_color)
-XEN_NARGIFY_0(g_cursor_color_w, g_cursor_color)
-XEN_NARGIFY_1(g_set_cursor_color_w, g_set_cursor_color)
-XEN_NARGIFY_0(g_text_focus_color_w, g_text_focus_color)
-XEN_NARGIFY_1(g_set_text_focus_color_w, g_set_text_focus_color)
-XEN_NARGIFY_0(g_sash_color_w, g_sash_color)
-XEN_NARGIFY_1(g_set_sash_color_w, g_set_sash_color)
-XEN_NARGIFY_0(g_data_color_w, g_data_color)
-XEN_NARGIFY_1(g_set_data_color_w, g_set_data_color)
-XEN_NARGIFY_0(g_graph_color_w, g_graph_color)
-XEN_NARGIFY_1(g_set_graph_color_w, g_set_graph_color)
-XEN_NARGIFY_0(g_selected_graph_color_w, g_selected_graph_color)
-XEN_NARGIFY_1(g_set_selected_graph_color_w, g_set_selected_graph_color)
-XEN_NARGIFY_0(g_selected_data_color_w, g_selected_data_color)
-XEN_NARGIFY_1(g_set_selected_data_color_w, g_set_selected_data_color)
-XEN_NARGIFY_0(g_axis_color_w, g_axis_color)
-XEN_NARGIFY_1(g_set_axis_color_w, g_set_axis_color)
-XEN_NARGIFY_0(g_basic_color_w, g_basic_color)
-XEN_NARGIFY_1(g_set_basic_color_w, g_set_basic_color)
-XEN_NARGIFY_1(g_color_p_w, g_color_p)
-XEN_ARGIFY_4(g_make_color_w, g_make_color)
-XEN_NARGIFY_1(g_color_to_list_w, g_color_to_list)
-XEN_ARGIFY_1(g_mix_color_w, g_mix_color)
-XEN_ARGIFY_2(g_set_mix_color_w, g_set_mix_color)
-XEN_NARGIFY_2(g_combined_data_color_w, g_combined_data_color)
-XEN_NARGIFY_3(g_set_combined_data_color_w, g_set_combined_data_color)
+with_three_setter_args(g_set_combined_data_color_reversed, g_set_combined_data_color)
+
+
+
+Xen_wrap_8_optional_args(g_draw_line_w, g_draw_line)
+Xen_wrap_7_optional_args(g_draw_dot_w, g_draw_dot)
+Xen_wrap_5_optional_args(g_draw_lines_w, g_draw_lines)
+Xen_wrap_6_optional_args(g_draw_dots_w, g_draw_dots)
+Xen_wrap_7_optional_args(g_draw_string_w, g_draw_string)
+Xen_wrap_9_optional_args(g_fill_rectangle_w, g_fill_rectangle)
+Xen_wrap_5_optional_args(g_fill_polygon_w, g_fill_polygon)
+Xen_wrap_3_optional_args(g_foreground_color_w, g_foreground_color)
+Xen_wrap_3_optional_args(g_current_font_w, g_current_font)
+Xen_wrap_no_args(g_main_widgets_w, g_main_widgets)
+Xen_wrap_no_args(g_dialog_widgets_w, g_dialog_widgets)
+Xen_wrap_1_arg(g_widget_size_w, g_widget_size)
+Xen_wrap_2_args(g_set_widget_size_w, g_set_widget_size)
+Xen_wrap_1_arg(g_widget_position_w, g_widget_position)
+Xen_wrap_2_args(g_set_widget_position_w, g_set_widget_position)
+Xen_wrap_1_arg(g_widget_text_w, g_widget_text)
+Xen_wrap_2_args(g_set_widget_text_w, g_set_widget_text)
+Xen_wrap_1_arg(g_hide_widget_w, g_hide_widget)
+Xen_wrap_1_arg(g_show_widget_w, g_show_widget)
+Xen_wrap_1_arg(g_focus_widget_w, g_focus_widget)
+Xen_wrap_5_optional_args(g_make_graph_data_w, g_make_graph_data)
+Xen_wrap_8_optional_args(g_graph_data_w, g_graph_data)
+Xen_wrap_any_args(g_make_bezier_w, g_make_bezier)
+Xen_wrap_no_args(g_snd_gcs_w, g_snd_gcs)
+Xen_wrap_1_arg(g_snd_color_w, g_snd_color)
+Xen_wrap_1_arg(g_snd_font_w, g_snd_font)
+Xen_wrap_1_arg(g_make_cairo_w, g_make_cairo)
+Xen_wrap_1_arg(g_free_cairo_w, g_free_cairo)
+
+Xen_wrap_no_args(g_selection_color_w, g_selection_color)
+Xen_wrap_1_arg(g_set_selection_color_w, g_set_selection_color)
+Xen_wrap_no_args(g_zoom_color_w, g_zoom_color)
+Xen_wrap_1_arg(g_set_zoom_color_w, g_set_zoom_color)
+Xen_wrap_no_args(g_position_color_w, g_position_color)
+Xen_wrap_1_arg(g_set_position_color_w, g_set_position_color)
+Xen_wrap_no_args(g_mark_color_w, g_mark_color)
+Xen_wrap_1_arg(g_set_mark_color_w, g_set_mark_color)
+Xen_wrap_no_args(g_listener_color_w, g_listener_color)
+Xen_wrap_1_arg(g_set_listener_color_w, g_set_listener_color)
+Xen_wrap_no_args(g_listener_text_color_w, g_listener_text_color)
+Xen_wrap_1_arg(g_set_listener_text_color_w, g_set_listener_text_color)
+Xen_wrap_no_args(g_enved_waveform_color_w, g_enved_waveform_color)
+Xen_wrap_1_arg(g_set_enved_waveform_color_w, g_set_enved_waveform_color)
+Xen_wrap_no_args(g_filter_control_waveform_color_w, g_filter_control_waveform_color)
+Xen_wrap_1_arg(g_set_filter_control_waveform_color_w, g_set_filter_control_waveform_color)
+Xen_wrap_no_args(g_highlight_color_w, g_highlight_color)
+Xen_wrap_1_arg(g_set_highlight_color_w, g_set_highlight_color)
+Xen_wrap_no_args(g_cursor_color_w, g_cursor_color)
+Xen_wrap_1_arg(g_set_cursor_color_w, g_set_cursor_color)
+Xen_wrap_no_args(g_text_focus_color_w, g_text_focus_color)
+Xen_wrap_1_arg(g_set_text_focus_color_w, g_set_text_focus_color)
+Xen_wrap_no_args(g_sash_color_w, g_sash_color)
+Xen_wrap_1_arg(g_set_sash_color_w, g_set_sash_color)
+Xen_wrap_no_args(g_data_color_w, g_data_color)
+Xen_wrap_1_arg(g_set_data_color_w, g_set_data_color)
+Xen_wrap_no_args(g_graph_color_w, g_graph_color)
+Xen_wrap_1_arg(g_set_graph_color_w, g_set_graph_color)
+Xen_wrap_no_args(g_selected_graph_color_w, g_selected_graph_color)
+Xen_wrap_1_arg(g_set_selected_graph_color_w, g_set_selected_graph_color)
+Xen_wrap_no_args(g_selected_data_color_w, g_selected_data_color)
+Xen_wrap_1_arg(g_set_selected_data_color_w, g_set_selected_data_color)
+Xen_wrap_no_args(g_axis_color_w, g_axis_color)
+Xen_wrap_1_arg(g_set_axis_color_w, g_set_axis_color)
+Xen_wrap_no_args(g_basic_color_w, g_basic_color)
+Xen_wrap_1_arg(g_set_basic_color_w, g_set_basic_color)
+Xen_wrap_1_arg(g_is_color_w, g_is_color)
+Xen_wrap_4_optional_args(g_make_color_w, g_make_color)
+Xen_wrap_1_arg(g_color_to_list_w, g_color_to_list)
+Xen_wrap_1_optional_arg(g_mix_color_w, g_mix_color)
+Xen_wrap_2_args(g_combined_data_color_w, g_combined_data_color)
+
+#if HAVE_SCHEME
+#define g_set_current_font_w g_set_current_font_reversed
+#define g_set_foreground_color_w g_set_foreground_color_reversed
+#define g_set_mix_color_w g_set_mix_color_reversed
+#define g_set_combined_data_color_w g_set_combined_data_color_reversed
+
+static s7_pointer acc_data_color(s7_scheme *sc, s7_pointer args) {return(g_set_data_color(s7_cadr(args)));}
+static s7_pointer acc_selected_data_color(s7_scheme *sc, s7_pointer args) {return(g_set_selected_data_color(s7_cadr(args)));}
+static s7_pointer acc_mark_color(s7_scheme *sc, s7_pointer args) {return(g_set_mark_color(s7_cadr(args)));}
+static s7_pointer acc_graph_color(s7_scheme *sc, s7_pointer args) {return(g_set_graph_color(s7_cadr(args)));}
+static s7_pointer acc_selected_graph_color(s7_scheme *sc, s7_pointer args) {return(g_set_selected_graph_color(s7_cadr(args)));}
+static s7_pointer acc_listener_color(s7_scheme *sc, s7_pointer args) {return(g_set_listener_color(s7_cadr(args)));}
+static s7_pointer acc_listener_text_color(s7_scheme *sc, s7_pointer args) {return(g_set_listener_text_color(s7_cadr(args)));}
+static s7_pointer acc_basic_color(s7_scheme *sc, s7_pointer args) {return(g_set_basic_color(s7_cadr(args)));}
+static s7_pointer acc_zoom_color(s7_scheme *sc, s7_pointer args) {return(g_set_zoom_color(s7_cadr(args)));}
+static s7_pointer acc_selection_color(s7_scheme *sc, s7_pointer args) {return(g_set_selection_color(s7_cadr(args)));}
+static s7_pointer acc_position_color(s7_scheme *sc, s7_pointer args) {return(g_set_position_color(s7_cadr(args)));}
+static s7_pointer acc_highlight_color(s7_scheme *sc, s7_pointer args) {return(g_set_highlight_color(s7_cadr(args)));}
+static s7_pointer acc_enved_waveform_color(s7_scheme *sc, s7_pointer args) {return(g_set_enved_waveform_color(s7_cadr(args)));}
+static s7_pointer acc_cursor_color(s7_scheme *sc, s7_pointer args) {return(g_set_cursor_color(s7_cadr(args)));}
+static s7_pointer acc_filter_control_waveform_color(s7_scheme *sc, s7_pointer args) {return(g_set_filter_control_waveform_color(s7_cadr(args)));}
+static s7_pointer acc_sash_color(s7_scheme *sc, s7_pointer args) {return(g_set_sash_color(s7_cadr(args)));}
+static s7_pointer acc_axis_color(s7_scheme *sc, s7_pointer args) {return(g_set_axis_color(s7_cadr(args)));}
+static s7_pointer acc_mix_color(s7_scheme *sc, s7_pointer args) {return(g_set_mix_color(s7_cadr(args), s7_undefined(s7)));}
+static s7_pointer acc_text_focus_color(s7_scheme *sc, s7_pointer args) {return(g_set_text_focus_color(s7_cadr(args)));}
#else
-
-#define g_draw_line_w g_draw_line
-#define g_draw_dot_w g_draw_dot
-#define g_draw_lines_w g_draw_lines
-#define g_draw_dots_w g_draw_dots
-#define g_draw_string_w g_draw_string
-#define g_fill_rectangle_w g_fill_rectangle
-#define g_fill_polygon_w g_fill_polygon
-#define g_foreground_color_w g_foreground_color
-#define g_set_foreground_color_w g_set_foreground_color
-#define g_current_font_w g_current_font
-#define g_set_current_font_w g_set_current_font
-#define g_main_widgets_w g_main_widgets
-#define g_dialog_widgets_w g_dialog_widgets
-#define g_widget_size_w g_widget_size
-#define g_set_widget_size_w g_set_widget_size
-#define g_widget_position_w g_widget_position
-#define g_set_widget_position_w g_set_widget_position
-#define g_widget_text_w g_widget_text
-#define g_set_widget_text_w g_set_widget_text
-#define g_hide_widget_w g_hide_widget
-#define g_show_widget_w g_show_widget
-#define g_focus_widget_w g_focus_widget
-#define g_make_graph_data_w g_make_graph_data
-#define g_graph_data_w g_graph_data
-#define g_make_bezier_w g_make_bezier
-#define g_snd_gcs_w g_snd_gcs
-#define g_snd_color_w g_snd_color
-#define g_snd_font_w g_snd_font
-#define g_make_cairo_w g_make_cairo
-#define g_free_cairo_w g_free_cairo
-
-#define g_selection_color_w g_selection_color
-#define g_set_selection_color_w g_set_selection_color
-#define g_zoom_color_w g_zoom_color
-#define g_set_zoom_color_w g_set_zoom_color
-#define g_position_color_w g_position_color
-#define g_set_position_color_w g_set_position_color
-#define g_mark_color_w g_mark_color
-#define g_set_mark_color_w g_set_mark_color
-#define g_listener_color_w g_listener_color
-#define g_set_listener_color_w g_set_listener_color
-#define g_listener_text_color_w g_listener_text_color
-#define g_set_listener_text_color_w g_set_listener_text_color
-#define g_enved_waveform_color_w g_enved_waveform_color
-#define g_set_enved_waveform_color_w g_set_enved_waveform_color
-#define g_filter_control_waveform_color_w g_filter_control_waveform_color
-#define g_set_filter_control_waveform_color_w g_set_filter_control_waveform_color
-#define g_highlight_color_w g_highlight_color
-#define g_set_highlight_color_w g_set_highlight_color
-#define g_cursor_color_w g_cursor_color
-#define g_set_cursor_color_w g_set_cursor_color
-#define g_text_focus_color_w g_text_focus_color
-#define g_set_text_focus_color_w g_set_text_focus_color
-#define g_sash_color_w g_sash_color
-#define g_set_sash_color_w g_set_sash_color
-#define g_data_color_w g_data_color
-#define g_set_data_color_w g_set_data_color
-#define g_graph_color_w g_graph_color
-#define g_set_graph_color_w g_set_graph_color
-#define g_selected_graph_color_w g_selected_graph_color
-#define g_set_selected_graph_color_w g_set_selected_graph_color
-#define g_selected_data_color_w g_selected_data_color
-#define g_set_selected_data_color_w g_set_selected_data_color
-#define g_axis_color_w g_axis_color
-#define g_set_axis_color_w g_set_axis_color
-#define g_basic_color_w g_basic_color
-#define g_set_basic_color_w g_set_basic_color
-#define g_color_p_w g_color_p
-#define g_make_color_w g_make_color
-#define g_color_to_list_w g_color_to_list
-#define g_mix_color_w g_mix_color
-#define g_set_mix_color_w g_set_mix_color
-#define g_combined_data_color_w g_combined_data_color
-#define g_set_combined_data_color_w g_set_combined_data_color
-
+Xen_wrap_4_optional_args(g_set_current_font_w, g_set_current_font)
+Xen_wrap_4_optional_args(g_set_foreground_color_w, g_set_foreground_color)
+Xen_wrap_2_optional_args(g_set_mix_color_w, g_set_mix_color)
+Xen_wrap_3_args(g_set_combined_data_color_w, g_set_combined_data_color)
#endif
void g_init_draw(void)
{
- dialog_widgets = XEN_UNDEFINED;
-
- XEN_DEFINE_CONSTANT(S_copy_context, CHAN_GC, "graphics context to draw a line");
- XEN_DEFINE_CONSTANT(S_cursor_context, CHAN_CGC, "graphics context for the cursor");
- XEN_DEFINE_CONSTANT(S_selection_context, CHAN_SELGC, "graphics context to draw in the selection color");
- XEN_DEFINE_CONSTANT(S_mark_context, CHAN_MGC, "graphics context for a mark");
-
- XEN_DEFINE_PROCEDURE(S_draw_line, g_draw_line_w, 4, 4, 0, H_draw_line);
- XEN_DEFINE_PROCEDURE(S_draw_dot, g_draw_dot_w, 2, 5, 0, H_draw_dot);
- XEN_DEFINE_PROCEDURE(S_draw_lines, g_draw_lines_w, 1, 4, 0, H_draw_lines);
- XEN_DEFINE_PROCEDURE(S_draw_dots, g_draw_dots_w, 1, 5, 0, H_draw_dots);
- XEN_DEFINE_PROCEDURE(S_draw_string, g_draw_string_w, 3, 4, 0, H_draw_string);
- XEN_DEFINE_PROCEDURE(S_fill_rectangle, g_fill_rectangle_w, 4, 5, 0, H_fill_rectangle);
- XEN_DEFINE_PROCEDURE(S_fill_polygon, g_fill_polygon_w, 1, 4, 0, H_fill_polygon);
- XEN_DEFINE_PROCEDURE(S_main_widgets, g_main_widgets_w, 0, 0, 0, H_main_widgets);
- XEN_DEFINE_PROCEDURE(S_dialog_widgets, g_dialog_widgets_w, 0, 0, 0, H_dialog_widgets);
- XEN_DEFINE_PROCEDURE(S_hide_widget, g_hide_widget_w, 1, 0, 0, H_hide_widget);
- XEN_DEFINE_PROCEDURE(S_show_widget, g_show_widget_w, 1, 0, 0, H_show_widget);
- XEN_DEFINE_PROCEDURE(S_focus_widget, g_focus_widget_w, 1, 0, 0, H_focus_widget);
-
- XEN_DEFINE_PROCEDURE(S_make_graph_data, g_make_graph_data_w, 0, 5, 0, H_make_graph_data);
- XEN_DEFINE_PROCEDURE(S_graph_data, g_graph_data_w, 1, 7, 0, H_graph_data);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_foreground_color, g_foreground_color_w, H_foreground_color,
- S_setB S_foreground_color, g_set_foreground_color_w, g_set_foreground_color_reversed, 0, 3, 1, 3);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_current_font, g_current_font_w, H_current_font,
- S_setB S_current_font, g_set_current_font_w, g_set_current_font_reversed, 0, 3, 1, 3);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_widget_size, g_widget_size_w, H_widget_size,
- S_setB S_widget_size, g_set_widget_size_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_widget_position, g_widget_position_w, H_widget_position,
- S_setB S_widget_position, g_set_widget_position_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_widget_text, g_widget_text_w, H_widget_text,
- S_setB S_widget_text, g_set_widget_text_w, 1, 0, 2, 0);
-
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_selection_color, g_selection_color_w, H_selection_color,
- S_setB S_selection_color, g_set_selection_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_zoom_color, g_zoom_color_w, H_zoom_color,
- S_setB S_zoom_color, g_set_zoom_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_position_color, g_position_color_w, H_position_color,
- S_setB S_position_color, g_set_position_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mark_color, g_mark_color_w, H_mark_color,
- S_setB S_mark_color, g_set_mark_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_listener_color, g_listener_color_w, H_listener_color,
- S_setB S_listener_color, g_set_listener_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_listener_text_color, g_listener_text_color_w, H_listener_text_color,
- S_setB S_listener_text_color, g_set_listener_text_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_waveform_color, g_enved_waveform_color_w, H_enved_waveform_color,
- S_setB S_enved_waveform_color, g_set_enved_waveform_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_filter_control_waveform_color, g_filter_control_waveform_color_w, H_filter_control_waveform_color,
- S_setB S_filter_control_waveform_color, g_set_filter_control_waveform_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_highlight_color, g_highlight_color_w, H_highlight_color,
- S_setB S_highlight_color, g_set_highlight_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_cursor_color, g_cursor_color_w, H_cursor_color,
- S_setB S_cursor_color, g_set_cursor_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_text_focus_color, g_text_focus_color_w, H_text_focus_color,
- S_setB S_text_focus_color, g_set_text_focus_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_sash_color, g_sash_color_w, H_sash_color,
- S_setB S_sash_color, g_set_sash_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_data_color, g_data_color_w, H_data_color,
- S_setB S_data_color, g_set_data_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_graph_color, g_graph_color_w, H_graph_color,
- S_setB S_graph_color, g_set_graph_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_selected_graph_color, g_selected_graph_color_w, H_selected_graph_color,
- S_setB S_selected_graph_color, g_set_selected_graph_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_selected_data_color, g_selected_data_color_w, H_selected_data_color,
- S_setB S_selected_data_color, g_set_selected_data_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_axis_color, g_axis_color_w, H_axis_color,
- S_setB S_axis_color, g_set_axis_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_basic_color, g_basic_color_w, H_basic_color,
- S_setB S_basic_color, g_set_basic_color_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_mix_color, g_mix_color_w, H_mix_color,
- S_setB S_mix_color, g_set_mix_color_w, g_set_mix_color_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_combined_data_color, g_combined_data_color_w, H_combined_data_color,
- S_setB S_combined_data_color, g_set_combined_data_color_w, g_set_combined_data_color_reversed, 2, 0, 3, 0);
-
- XEN_DEFINE_PROCEDURE(S_color_p, g_color_p_w, 1, 0, 0, H_color_p);
- XEN_DEFINE_PROCEDURE(S_make_color, g_make_color_w, 3, 1, 0, H_make_color);
- XEN_DEFINE_PROCEDURE(S_color_to_list, g_color_to_list_w, 1, 0, 0, H_color_to_list);
-
- XEN_DEFINE_PROCEDURE(S_make_bezier, g_make_bezier_w, 0, 0, 1, H_make_bezier);
- XEN_DEFINE_PROCEDURE(S_snd_gcs, g_snd_gcs_w, 0, 0, 0, H_snd_gcs);
- XEN_DEFINE_PROCEDURE(S_snd_color, g_snd_color_w, 1, 0, 0, H_snd_color);
- XEN_DEFINE_PROCEDURE(S_snd_font, g_snd_font_w, 1, 0, 0, H_snd_font);
-
- XEN_DEFINE_PROCEDURE(S_make_cairo, g_make_cairo_w, 1, 0, 0, H_make_cairo);
- XEN_DEFINE_PROCEDURE(S_free_cairo, g_free_cairo_w, 1, 0, 0, H_free_cairo);
+ dialog_widgets = Xen_undefined;
+
+ Xen_define_constant(S_copy_context, CHAN_GC, "graphics context to draw a line");
+ Xen_define_constant(S_cursor_context, CHAN_CGC, "graphics context for the cursor");
+ Xen_define_constant(S_selection_context, CHAN_SELGC, "graphics context to draw in the selection color");
+ Xen_define_constant(S_mark_context, CHAN_MGC, "graphics context for a mark");
+
+ Xen_define_safe_procedure(S_draw_line, g_draw_line_w, 4, 4, 0, H_draw_line);
+ Xen_define_safe_procedure(S_draw_dot, g_draw_dot_w, 2, 5, 0, H_draw_dot);
+ Xen_define_safe_procedure(S_draw_lines, g_draw_lines_w, 1, 4, 0, H_draw_lines);
+ Xen_define_safe_procedure(S_draw_dots, g_draw_dots_w, 1, 5, 0, H_draw_dots);
+ Xen_define_safe_procedure(S_draw_string, g_draw_string_w, 3, 4, 0, H_draw_string);
+ Xen_define_safe_procedure(S_fill_rectangle, g_fill_rectangle_w, 4, 5, 0, H_fill_rectangle);
+ Xen_define_safe_procedure(S_fill_polygon, g_fill_polygon_w, 1, 4, 0, H_fill_polygon);
+ Xen_define_safe_procedure(S_main_widgets, g_main_widgets_w, 0, 0, 0, H_main_widgets);
+ Xen_define_safe_procedure(S_dialog_widgets, g_dialog_widgets_w, 0, 0, 0, H_dialog_widgets);
+ Xen_define_safe_procedure(S_hide_widget, g_hide_widget_w, 1, 0, 0, H_hide_widget);
+ Xen_define_safe_procedure(S_show_widget, g_show_widget_w, 1, 0, 0, H_show_widget);
+ Xen_define_safe_procedure(S_focus_widget, g_focus_widget_w, 1, 0, 0, H_focus_widget);
+
+ Xen_define_safe_procedure(S_make_graph_data, g_make_graph_data_w, 0, 5, 0, H_make_graph_data);
+ Xen_define_safe_procedure(S_graph_data, g_graph_data_w, 1, 7, 0, H_graph_data);
+
+ Xen_define_dilambda(S_foreground_color, g_foreground_color_w, H_foreground_color, S_set S_foreground_color, g_set_foreground_color_w, 0, 3, 1, 3);
+ Xen_define_dilambda(S_current_font, g_current_font_w, H_current_font, S_set S_current_font, g_set_current_font_w, 0, 3, 1, 3);
+ Xen_define_dilambda(S_widget_size, g_widget_size_w, H_widget_size, S_set S_widget_size, g_set_widget_size_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_widget_position, g_widget_position_w, H_widget_position, S_set S_widget_position, g_set_widget_position_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_widget_text, g_widget_text_w, H_widget_text, S_set S_widget_text, g_set_widget_text_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_selection_color, g_selection_color_w, H_selection_color, S_set S_selection_color, g_set_selection_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_zoom_color, g_zoom_color_w, H_zoom_color, S_set S_zoom_color, g_set_zoom_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_position_color, g_position_color_w, H_position_color, S_set S_position_color, g_set_position_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mark_color, g_mark_color_w, H_mark_color, S_set S_mark_color, g_set_mark_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_listener_color, g_listener_color_w, H_listener_color, S_set S_listener_color, g_set_listener_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_listener_text_color, g_listener_text_color_w, H_listener_text_color, S_set S_listener_text_color, g_set_listener_text_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_waveform_color, g_enved_waveform_color_w, H_enved_waveform_color, S_set S_enved_waveform_color, g_set_enved_waveform_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_filter_control_waveform_color, g_filter_control_waveform_color_w, H_filter_control_waveform_color, S_set S_filter_control_waveform_color, g_set_filter_control_waveform_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_highlight_color, g_highlight_color_w, H_highlight_color, S_set S_highlight_color, g_set_highlight_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_cursor_color, g_cursor_color_w, H_cursor_color, S_set S_cursor_color, g_set_cursor_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_text_focus_color, g_text_focus_color_w, H_text_focus_color, S_set S_text_focus_color, g_set_text_focus_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_sash_color, g_sash_color_w, H_sash_color, S_set S_sash_color, g_set_sash_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_data_color, g_data_color_w, H_data_color, S_set S_data_color, g_set_data_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_graph_color, g_graph_color_w, H_graph_color, S_set S_graph_color, g_set_graph_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_selected_graph_color, g_selected_graph_color_w, H_selected_graph_color, S_set S_selected_graph_color, g_set_selected_graph_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_selected_data_color, g_selected_data_color_w, H_selected_data_color, S_set S_selected_data_color, g_set_selected_data_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_axis_color, g_axis_color_w, H_axis_color, S_set S_axis_color, g_set_axis_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_basic_color, g_basic_color_w, H_basic_color, S_set S_basic_color, g_set_basic_color_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mix_color, g_mix_color_w, H_mix_color, S_set S_mix_color, g_set_mix_color_w, 0, 1, 1, 1);
+ Xen_define_dilambda(S_combined_data_color, g_combined_data_color_w, H_combined_data_color, S_set S_combined_data_color, g_set_combined_data_color_w, 2, 0, 3, 0);
+
+ Xen_define_safe_procedure(S_is_color, g_is_color_w, 1, 0, 0, H_is_color);
+ Xen_define_safe_procedure(S_make_color, g_make_color_w, 3, 1, 0, H_make_color);
+ Xen_define_safe_procedure(S_color_to_list, g_color_to_list_w, 1, 0, 0, H_color_to_list);
+
+ Xen_define_safe_procedure(S_make_bezier, g_make_bezier_w, 0, 0, 1, H_make_bezier);
+ Xen_define_safe_procedure(S_snd_gcs, g_snd_gcs_w, 0, 0, 0, H_snd_gcs);
+ Xen_define_safe_procedure(S_snd_color, g_snd_color_w, 1, 0, 0, H_snd_color);
+ Xen_define_safe_procedure(S_snd_font, g_snd_font_w, 1, 0, 0, H_snd_font);
+
+ Xen_define_safe_procedure(S_make_cairo, g_make_cairo_w, 1, 0, 0, H_make_cairo);
+ Xen_define_safe_procedure(S_free_cairo, g_free_cairo_w, 1, 0, 0, H_free_cairo);
#define H_new_widget_hook S_new_widget_hook " (widget): called each time a dialog or \
a new set of channel or sound widgets is created."
- new_widget_hook = XEN_DEFINE_HOOK(S_new_widget_hook, 1, H_new_widget_hook); /* arg = widget */
+ new_widget_hook = Xen_define_hook(S_new_widget_hook, "(make-hook 'widget)", 1, H_new_widget_hook);
+
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->data_color_symbol, s7_make_function(s7, "[acc-" S_data_color "]", acc_data_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->highlight_color_symbol, s7_make_function(s7, "[acc-" S_highlight_color "]", acc_highlight_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->axis_color_symbol, s7_make_function(s7, "[acc-" S_axis_color "]", acc_axis_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->sash_color_symbol, s7_make_function(s7, "[acc-" S_sash_color "]", acc_sash_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->filter_control_waveform_color_symbol, s7_make_function(s7, "[acc-" S_filter_control_waveform_color "]", acc_filter_control_waveform_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->mix_color_symbol, s7_make_function(s7, "[acc-" S_mix_color "]", acc_mix_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->selected_data_color_symbol, s7_make_function(s7, "[acc-" S_selected_data_color "]", acc_selected_data_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->mark_color_symbol, s7_make_function(s7, "[acc-" S_mark_color "]", acc_mark_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->graph_color_symbol, s7_make_function(s7, "[acc-" S_graph_color "]", acc_graph_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->selected_graph_color_symbol, s7_make_function(s7, "[acc-" S_selected_graph_color "]", acc_selected_graph_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->listener_color_symbol, s7_make_function(s7, "[acc-" S_listener_color "]", acc_listener_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->listener_text_color_symbol, s7_make_function(s7, "[acc-" S_listener_text_color "]", acc_listener_text_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->basic_color_symbol, s7_make_function(s7, "[acc-" S_basic_color "]", acc_basic_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->selection_color_symbol, s7_make_function(s7, "[acc-" S_selection_color "]", acc_selection_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->zoom_color_symbol, s7_make_function(s7, "[acc-" S_zoom_color "]", acc_zoom_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->position_color_symbol, s7_make_function(s7, "[acc-" S_position_color "]", acc_position_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->enved_waveform_color_symbol, s7_make_function(s7, "[acc-" S_enved_waveform_color "]", acc_enved_waveform_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->cursor_color_symbol, s7_make_function(s7, "[acc-" S_cursor_color "]", acc_cursor_color, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->text_focus_color_symbol, s7_make_function(s7, "[acc-" S_text_focus_color "]", acc_text_focus_color, 2, 0, false, "accessor"));
+
+ s7_symbol_set_documentation(s7, ss->axis_color_symbol, "*axis-color*: color of axis (defaults to current data color)");
+ s7_symbol_set_documentation(s7, ss->basic_color_symbol, "*basic-color*: Snd's basic color");
+ s7_symbol_set_documentation(s7, ss->cursor_color_symbol, "*cursor-color*: cursor color");
+ s7_symbol_set_documentation(s7, ss->data_color_symbol, "*data-color*: color used to draw unselected data");
+ s7_symbol_set_documentation(s7, ss->enved_waveform_color_symbol, "*enved-waveform-color*: color of the envelope editor wave display");
+ s7_symbol_set_documentation(s7, ss->filter_control_waveform_color_symbol, "*filter-control-waveform-color*: color of the filter waveform");
+ s7_symbol_set_documentation(s7, ss->graph_color_symbol, "*graph-color*: background color used for unselected data");
+ s7_symbol_set_documentation(s7, ss->highlight_color_symbol, "*highlight-color*: color of highlighted text or buttons");
+ s7_symbol_set_documentation(s7, ss->listener_color_symbol, "*listener-color*: background color of the lisp listener");
+ s7_symbol_set_documentation(s7, ss->listener_text_color_symbol, "*listener-text-color*: text color in the lisp listener");
+ s7_symbol_set_documentation(s7, ss->mark_color_symbol, "*mark-color*: mark color");
+ s7_symbol_set_documentation(s7, ss->mix_color_symbol, "*mix-color*: color of mix tags");
+ s7_symbol_set_documentation(s7, ss->position_color_symbol, "*position-color*: color of position sliders");
+ s7_symbol_set_documentation(s7, ss->sash_color_symbol, "*sash-color*: color used to draw paned window sashes");
+ s7_symbol_set_documentation(s7, ss->selected_data_color_symbol, "*selected-data-color*: color used for selected data");
+ s7_symbol_set_documentation(s7, ss->selected_graph_color_symbol, "*selected-graph-color*: background color of selected data");
+ s7_symbol_set_documentation(s7, ss->selection_color_symbol, "*selection-color*: selection color");
+ s7_symbol_set_documentation(s7, ss->text_focus_color_symbol, "*text-focus-color*: color used to show a text field has focus");
+ s7_symbol_set_documentation(s7, ss->zoom_color_symbol, "*zoom-color*: color of zoom sliders");
+#endif
}
#else
@@ -2164,5 +2150,5 @@ void draw_both_grf_points(int dot_size, graphics_context *ax, int j, graph_style
void draw_cursor(chan_info *cp) {}
point_t *get_grf_points(void) {return(NULL);}
point_t *get_grf_points1(void) {return(NULL);}
-bool foreground_color_ok(XEN color, graphics_context *ax) {return(true);}
+bool foreground_color_ok(Xen color, graphics_context *ax) {return(true);}
#endif
diff --git a/snd-edits.c b/snd-edits.c
index 8faae87..31d75f0 100644
--- a/snd-edits.c
+++ b/snd-edits.c
@@ -1,17 +1,16 @@
#include "snd.h"
-
-static XEN save_hook;
+static Xen save_hook;
static bool dont_save(snd_info *sp, const char *newname)
{
- XEN res = XEN_FALSE;
- if (XEN_HOOKED(save_hook))
+ Xen res = Xen_false;
+ if (Xen_hook_has_list(save_hook))
res = run_or_hook(save_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(sp->index),
- (newname) ? C_TO_XEN_STRING(newname) : XEN_FALSE),
+ Xen_list_2(C_int_to_Xen_sound(sp->index),
+ (newname) ? C_string_to_Xen_string(newname) : Xen_false),
S_save_hook);
- return(XEN_TRUE_P(res));
+ return(Xen_is_true(res));
}
@@ -20,9 +19,9 @@ void after_edit(chan_info *cp)
reflect_edit_history_change(cp);
reflect_enved_fft_change(cp);
if ((cp->hookable == WITH_HOOK) &&
- (XEN_HOOK_P(cp->after_edit_hook)) &&
- (XEN_HOOKED(cp->after_edit_hook)))
- run_hook(cp->after_edit_hook, XEN_EMPTY_LIST, S_after_edit_hook);
+ (Xen_is_hook(cp->after_edit_hook)) &&
+ (Xen_hook_has_list(cp->after_edit_hook)))
+ run_hook(cp->after_edit_hook, Xen_empty_list, S_after_edit_hook);
}
@@ -102,72 +101,6 @@ static int add_sound_file_to_edit_list(chan_info *cp, const char *name, snd_io *
}
-void free_ptree_list(chan_info *cp)
-{
- if (cp->ptrees)
- {
- int i;
- for (i = 0; i < cp->ptree_size; i++)
- {
- if (cp->ptrees[i])
- {
- mus_run_free_ptree(cp->ptrees[i]);
- cp->ptrees[i] = NULL;
- }
- if (XEN_PROCEDURE_P(cp->ptree_inits[i]))
- snd_unprotect_at(cp->init_locs[i]);
- }
- free(cp->ptrees);
- cp->ptrees = NULL;
- free(cp->ptree_inits);
- cp->ptree_inits = NULL;
- free(cp->init_locs);
- cp->init_locs = NULL;
- free(cp->init_args);
- cp->init_args = NULL;
- }
- cp->ptree_ctr = -1;
- cp->ptree_size = 0;
-}
-
-
-static int add_ptree(chan_info *cp)
-{
- int i;
- if (cp->ptrees)
- for (i = 0; i <= cp->ptree_ctr; i++)
- if (cp->ptrees[i] == NULL)
- return(i);
- cp->ptree_ctr++;
- if (cp->ptree_ctr >= cp->ptree_size)
- {
- cp->ptree_size += EDIT_ALLOC_SIZE;
- if (cp->ptrees)
- {
- cp->ptrees = (struct ptree **)realloc(cp->ptrees, cp->ptree_size * sizeof(struct ptree *));
- for (i = cp->ptree_ctr; i < cp->ptree_size; i++) cp->ptrees[i] = NULL;
- cp->ptree_inits = (XEN *)realloc(cp->ptree_inits, cp->ptree_size * sizeof(XEN));
- for (i = cp->ptree_ctr; i < cp->ptree_size; i++) cp->ptree_inits[i] = XEN_FALSE;
- cp->init_locs = (int *)realloc(cp->init_locs, cp->ptree_size * sizeof(int));
- for (i = cp->ptree_ctr; i < cp->ptree_size; i++) cp->init_locs[i] = -1;
- cp->init_args = (int *)realloc(cp->init_args, cp->ptree_size * sizeof(int));
- for (i = cp->ptree_ctr; i < cp->ptree_size; i++) cp->init_args[i] = 2;
- }
- else
- {
- cp->ptrees = (struct ptree **)calloc(cp->ptree_size, sizeof(struct ptree *));
- cp->ptree_inits = (XEN *)calloc(cp->ptree_size, sizeof(XEN));
- for (i = 0; i < cp->ptree_size; i++) cp->ptree_inits[i] = XEN_FALSE;
- cp->init_locs = (int *)calloc(cp->ptree_size, sizeof(int));
- for (i = 0; i < cp->ptree_size; i++) cp->init_locs[i] = -1;
- cp->init_args = (int *)calloc(cp->ptree_size, sizeof(int));
- for (i = 0; i < cp->ptree_size; i++) cp->init_args[i] = 2;
- }
- }
- return(cp->ptree_ctr);
-}
-
-
static ed_list *free_ed_list(ed_list *ed, chan_info *cp);
static void prune_edits(chan_info *cp, int edpt)
@@ -184,15 +117,15 @@ static void prune_edits(chan_info *cp, int edpt)
}
-bool editable_p(chan_info *cp)
+bool is_editable(chan_info *cp)
{
if (!(cp->editable)) return(false);
- if ((XEN_HOOK_P(cp->edit_hook)) &&
- (XEN_HOOKED(cp->edit_hook)))
+ if ((Xen_is_hook(cp->edit_hook)) &&
+ (Xen_hook_has_list(cp->edit_hook)))
{
- XEN res;
- res = run_or_hook(cp->edit_hook, XEN_EMPTY_LIST, S_edit_hook);
- if (XEN_TRUE_P(res))
+ Xen res;
+ res = run_or_hook(cp->edit_hook, Xen_empty_list, S_edit_hook);
+ if (Xen_is_true(res))
return(false);
}
return(true);
@@ -221,16 +154,16 @@ static bool prepare_edit_list(chan_info *cp, int pos, const char *caller)
*/
snd_info *sp;
- if (!(editable_p(cp))) return(false); /* this may represent a second call on edit-hook for this edit */
+ if (!(is_editable(cp))) return(false); /* this may represent a second call on edit-hook for this edit */
if (pos > cp->edit_ctr)
{
- XEN_ERROR(NO_SUCH_EDIT,
- XEN_LIST_6(C_TO_XEN_STRING("~A: edpos: ~A but ~A chan ~A has ~A edits"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT(pos),
- C_TO_XEN_STRING(cp->sound->short_filename),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_INT(cp->edit_ctr)));
+ Xen_error(NO_SUCH_EDIT,
+ Xen_list_6(C_string_to_Xen_string("~A: edpos: ~A but ~A chan ~A has ~A edits"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer(pos),
+ C_string_to_Xen_string(cp->sound->short_filename),
+ C_int_to_Xen_integer(cp->chan),
+ C_int_to_Xen_integer(cp->edit_ctr)));
}
sp = cp->sound;
stop_peak_env(cp);
@@ -248,8 +181,8 @@ static void reflect_sample_change_in_axis(chan_info *cp)
if (ap)
{
mus_long_t samps;
- samps = CURRENT_SAMPLES(cp);
- ap->xmax = (double)samps / (double)SND_SRATE(cp->sound);
+ samps = current_samples(cp);
+ ap->xmax = (double)samps / (double)snd_srate(cp->sound);
ap->x_ambit = ap->xmax - ap->xmin;
if (ap->x1 > ap->xmax) ap->x1 = ap->xmax;
if ((samps == 0) || (ap->no_data))
@@ -285,7 +218,7 @@ void reflect_file_change_in_label(chan_info *cp)
len = strlen(shortname(sp)) + 16;
starred_name = (char *)calloc(len, sizeof(char));
- strcpy(starred_name, shortname_indexed(sp));
+ strcopy(starred_name, shortname_indexed(sp), len);
if ((sp->user_read_only == FILE_READ_ONLY) ||
(sp->file_read_only == FILE_READ_ONLY))
@@ -305,36 +238,36 @@ static void check_for_first_edit(chan_info *cp)
}
-static XEN save_state_hook;
+static Xen save_state_hook;
char *run_save_state_hook(const char *file)
{
char *filename;
filename = mus_strdup(file);
- if (XEN_HOOKED(save_state_hook))
+ if (Xen_hook_has_list(save_state_hook))
{
+ Xen result;
#if HAVE_SCHEME
- int gc_loc;
-#endif
- XEN fname;
- XEN result = XEN_FALSE;
- XEN procs = XEN_HOOK_PROCEDURES(save_state_hook);
- fname = C_TO_XEN_STRING(filename);
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, fname);
-#endif
- while (XEN_NOT_NULL_P(procs))
+ result = s7_call(s7, save_state_hook, s7_cons(s7, C_string_to_Xen_string(filename), s7_nil(s7)));
+ if (Xen_is_string(result))
+ {
+ free(filename);
+ filename = mus_strdup(Xen_string_to_C_string(result));
+ }
+#else
+ Xen procs, fname;
+ fname = C_string_to_Xen_string(filename);
+ procs = Xen_hook_list(save_state_hook);
+ while (!Xen_is_null(procs))
{
- result = XEN_CALL_1(XEN_CAR(procs), fname, "save state hook");
- if (XEN_STRING_P(result))
+ result = Xen_call_with_1_arg(Xen_car(procs), fname, "save state hook");
+ if (Xen_is_string(result))
{
free(filename);
- filename = mus_strdup(XEN_TO_C_STRING(result));
+ filename = mus_strdup(Xen_string_to_C_string(result));
}
- procs = XEN_CDR (procs);
+ procs = Xen_cdr(procs);
}
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
#endif
}
return(filename);
@@ -349,40 +282,17 @@ char *run_save_state_hook(const char *file)
* redo: push position foward
* No actual changes are flushed out to the file system until the file is saved.
*
- * the editing possibilities are insert, change, delete, scale, zero, env, mix, ptree.
+ * the editing possibilities are insert, change, delete, scale, zero, env, mix
* All input goes through these lists (with minor exceptions -- see chn_sample below).
*
* The accessors are highly optimized (split into numerous choices) since everything else in Snd
- * goes through the accessors to get at the data. My tests indicate that even a lowly old
- * 267 MHz PC (and equivalent Sun) can play stereo 44KHz through the ptree2 op
- * without glitches, and on a modern machine the readers scarcely register in loadav.
- *
- * (3.2 GHz): -ffast-math (double) (3.8 GHz, float): after arrayification:
- * straight 21 20 26 22 17
- * ramp 24 21 26 25 20
- * ramp2 27 22 27 29 25
- * ramp3 38 24 29 33 38
- * ramp4 35 44 30 43 43
- * ptree-zero 46 47 61 49 46
- * ptree 52 58 71 57 52
- * ptreec 80 80 93 74 65
- * ptree2 105 100 107 94 83
- * ptree3 129 125 157 128 114
- * cosine 304 270 355 (290) 199 194 xramp changed:
- * xramp 152 94 140 (91) 121 111 23
- * xramp2 290 148 242 (154) 211 206 38
- * mix 38
- * ramp10 88
- * xramp10 96
- * mix10 169
+ * goes through the accessors to get at the data.
*
* I tried a flattened version (using ed_fragment* rather than ed_fragment**) which involves fewer calls on malloc,
* but the edit list is a "real" list -- we do internal insertions and deletions and so on, so it's simpler
* to use in the current form.
*/
-static int max_virtual_ptrees = 32; /* was 3 */
-
/* fragment ramp info */
@@ -395,73 +305,41 @@ typedef struct {
} xramp_state;
typedef struct {
- short ramps;
+ int ramps, xramps;
ramp_state *ramp_list;
- short xramps;
xramp_state *xramp_list;
} ed_ramps;
-/* fragment ptree info */
-
-typedef struct {
- mus_float_t scl; /* scales the arg to the ptree */
- short loc; /* index into the cp->ptrees array */
- mus_long_t pos, /* segment position within original at time of ptree edit */
- dur; /* original (unfragmented) segment length */
-} ptree_state;
-
-typedef struct {
- short size, rsplit, xsplit, psplit;
- ptree_state *ptree_list;
-} ed_ptrees;
-
-
/* fragment mix info */
typedef struct {
- short size; /* size of mix_list, but some entries can be empty */
+ int size; /* size of mix_list, but some entries can be empty */
mix_state **mix_list;
} ed_mixes;
/* ed list fragment */
-typedef struct ed_fragment { /* this name is necessary even in straight C */
- short typ, /* code for accessor choice (ED_SIMPLE etc) */
- snd; /* either an index into the cp->sounds array (snd_data structs) or EDIT_LIST_END|ZERO_MARK */
+typedef struct ed_fragment { /* this name is necessary even in straight C */
+ int typ, /* code for accessor choice (ED_SIMPLE etc) */
+ snd; /* either an index into the cp->sounds array (snd_data structs) or EDIT_LIST_END|ZERO_MARK */
mus_long_t out, /* running segment location within current overall edited data */
beg, /* index into the associated data => start point of data used in current segment */
end; /* index into the associated data => end point of data used in current segment */
mus_float_t scl; /* segment scaler */
ed_ramps *ramps;
- ed_ptrees *ptrees;
ed_mixes *mixes;
+ struct ed_fragment *next;
} ed_fragment;
-/* reader ptree info */
-
-typedef struct {
- struct ptree *ptree;
- XEN closure;
- int gc_loc, closure_type;
-} ptree_info;
-
-typedef struct {
- short size, rsplit, xsplit, psplit;
- ptree_info *ptree_list;
- bool zero;
-} reader_ptrees;
-
-
/* reader ramp info */
typedef struct {
- short ramps;
+ int ramps, xramps;
double *incrs, *vals;
- short xramps;
double *xincrs, *xvals;
mus_float_t (*rampf)(struct snd_fd *sf);
mus_float_t (*rev_rampf)(struct snd_fd *sf);
@@ -491,10 +369,6 @@ typedef struct {
/* #define FRAGMENT_XRAMP_LIST(Ed, Pos) ((ed_fragment **)((Ed)->fragments))[Pos]->ramps->xramp_list */
#define FRAGMENT_XRAMP_LIST_SIZE(Ed, Pos) ((ed_fragment **)((Ed)->fragments))[Pos]->ramps->xramps
-#define FRAGMENT_PTREES(Ed, Pos) ((ed_fragment **)((Ed)->fragments))[Pos]->ptrees
-#define FRAGMENT_PTREE_LIST_SIZE(Ed, Pos) ((ed_fragment **)((Ed)->fragments))[Pos]->ptrees->size
-/* #define FRAGMENT_PTREE_LIST(Ed, Pos) ((ed_fragment **)((Ed)->fragments))[Pos]->ptrees->ptree_list */
-
#define FRAGMENT_MIXES(Ed, Pos) ((ed_fragment **)((Ed)->fragments))[Pos]->mixes
#define FRAGMENT_MIX_LIST_SIZE(Ed, Pos) ((ed_fragment **)((Ed)->fragments))[Pos]->mixes->size
#define FRAGMENT_MIX_LIST(Ed, Pos) ((ed_fragment **)((Ed)->fragments))[Pos]->mixes->mix_list
@@ -514,11 +388,6 @@ typedef struct {
#define FRAGMENT_XRAMP_SCALER(Ed, Pos, Rmp) ((ed_fragment **)((Ed)->fragments))[Pos]->ramps->xramp_list[Rmp].scl
#define FRAGMENT_XRAMP_OFFSET(Ed, Pos, Rmp) ((ed_fragment **)((Ed)->fragments))[Pos]->ramps->xramp_list[Rmp].off
-#define FRAGMENT_PTREE_SCALER(Ed, Pos, Pt) ((ed_fragment **)((Ed)->fragments))[Pos]->ptrees->ptree_list[Pt].scl
-#define FRAGMENT_PTREE_INDEX(Ed, Pos, Pt) ((ed_fragment **)((Ed)->fragments))[Pos]->ptrees->ptree_list[Pt].loc
-/* #define FRAGMENT_PTREE_DUR(Ed, Pos, Pt) ((ed_fragment **)((Ed)->fragments))[Pos]->ptrees->ptree_list[Pt].dur */
-#define FRAGMENT_PTREE_POSITION(Ed, Pos, Pt) ((ed_fragment **)((Ed)->fragments))[Pos]->ptrees->ptree_list[Pt].pos
-
#define FRAGMENT_MIX_STATE(Ed, Pos, Mix) ((ed_fragment **)((Ed)->fragments))[Pos]->mixes->mix_list[Mix]
/* #define FRAGMENT_MIX_INDEX(Ed, Pos, Mix) ((ed_fragment **)((Ed)->fragments))[Pos]->mixes->mix_list[Mix]->index */
/* #define FRAGMENT_MIX_LENGTH(Ed, Pos, Mix) ((ed_fragment **)((Ed)->fragments))[Pos]->mixes->mix_list[Mix]->len */
@@ -546,17 +415,6 @@ typedef struct {
#define ED_XRAMP_SCALER(Ed, Rmp) (Ed)->ramps->xramp_list[Rmp].scl
#define ED_XRAMP_OFFSET(Ed, Rmp) (Ed)->ramps->xramp_list[Rmp].off
-#define ED_PTREES(Ed) (Ed)->ptrees
-#define ED_PTREE_LIST(Ed) (Ed)->ptrees->ptree_list
-#define ED_PTREE_LIST_SIZE(Ed) (Ed)->ptrees->size
-#define ED_PTREE_POSITION(Ed, Pt) (Ed)->ptrees->ptree_list[Pt].pos
-#define ED_PTREE_DUR(Ed, Pt) (Ed)->ptrees->ptree_list[Pt].dur
-#define ED_PTREE_SCALER(Ed, Pt) (Ed)->ptrees->ptree_list[Pt].scl
-#define ED_PTREE_INDEX(Ed, Pt) (Ed)->ptrees->ptree_list[Pt].loc
-#define ED_PSPLIT(Ed) (Ed)->ptrees->psplit
-#define ED_RSPLIT(Ed) (Ed)->ptrees->rsplit
-#define ED_XSPLIT(Ed) (Ed)->ptrees->xsplit
-
#define ED_MIXES(Ed) (Ed)->mixes
#define ED_MIX_LIST(Ed) (Ed)->mixes->mix_list
/* #define ED_MIX_LIST_SIZE(Ed) (Ed)->mixes->size */
@@ -601,24 +459,6 @@ typedef struct {
#define READER_RAMPF(Sf) ((reader_ramps *)((Sf)->ramps))->rampf
#define READER_REV_RAMPF(Sf) ((reader_ramps *)((Sf)->ramps))->rev_rampf
-#define READER_PTREE_SCALER(Sf, Pt) ((ed_fragment *)((Sf)->cb))->ptrees->ptree_list[Pt].scl
-#define READER_PTREE_INDEX(Sf, Pt) ((ed_fragment *)((Sf)->cb))->ptrees->ptree_list[Pt].loc
-#define READER_PTREE_DUR(Sf, Pt) ((ed_fragment *)((Sf)->cb))->ptrees->ptree_list[Pt].dur
-#define READER_PTREE_POSITION(Sf, Pt) ((ed_fragment *)((Sf)->cb))->ptrees->ptree_list[Pt].pos
-
-#define READER_PTREES(Sf) ((reader_ptrees *)((Sf)->ptrees))
-#define READER_PTREE_LIST(Sf) ((reader_ptrees *)((Sf)->ptrees))->ptree_list
-#define READER_PTREE_LIST_SIZE(Sf) ((reader_ptrees *)((Sf)->ptrees))->size
-#define READER_PTREE_ZERO(Sf) ((reader_ptrees *)((Sf)->ptrees))->zero
-#define READER_PSPLIT(Sf) ((reader_ptrees *)((Sf)->ptrees))->psplit
-#define READER_RSPLIT(Sf) ((reader_ptrees *)((Sf)->ptrees))->rsplit
-#define READER_XSPLIT(Sf) ((reader_ptrees *)((Sf)->ptrees))->xsplit
-
-#define READER_PTREE(Sf, Pt) ((reader_ptrees *)((Sf)->ptrees))->ptree_list[Pt].ptree
-#define READER_PTREE_TYPE(Sf, Pt) ((reader_ptrees *)((Sf)->ptrees))->ptree_list[Pt].closure_type
-#define READER_PTREE_CLOSURE(Sf, Pt) ((reader_ptrees *)((Sf)->ptrees))->ptree_list[Pt].closure
-#define READER_PTREE_GC_LOC(Sf, Pt) ((reader_ptrees *)((Sf)->ptrees))->ptree_list[Pt].gc_loc
-
/* #define READER_MIXES(Sf) ((ed_fragment *)((Sf)->cb))->mixes */
#define READER_MIX_LIST_SIZE(Sf) ((ed_fragment *)((Sf)->cb))->mixes->size
/* #define READER_MIX_LIST(Sf) ((ed_fragment *)((Sf)->cb))->mixes->mix_list */
@@ -670,9 +510,11 @@ static mus_float_t previous_ramp2_value(snd_fd *sf)
static mus_float_t next_ramp_value(snd_fd *sf)
{
- mus_float_t val = 1.0;
+ mus_float_t val;
int i;
- for (i = 0; i < READER_RAMPS(sf); i++)
+ val = READER_VAL(sf, 0);
+ READER_VAL(sf, 0) += READER_INCR(sf, 0);
+ for (i = 1; i < READER_RAMPS(sf); i++)
{
val *= READER_VAL(sf, i);
READER_VAL(sf, i) += READER_INCR(sf, i);
@@ -682,9 +524,11 @@ static mus_float_t next_ramp_value(snd_fd *sf)
static mus_float_t previous_ramp_value(snd_fd *sf)
{
- mus_float_t val = 1.0;
+ mus_float_t val;
int i;
- for (i = 0; i < READER_RAMPS(sf); i++)
+ val = READER_VAL(sf, 0);
+ READER_VAL(sf, 0) -= READER_INCR(sf, 0);
+ for (i = 1; i < READER_RAMPS(sf); i++)
{
val *= READER_VAL(sf, i);
READER_VAL(sf, i) -= READER_INCR(sf, i);
@@ -717,8 +561,10 @@ static mus_float_t previous_xramp1_value(snd_fd *sf)
static mus_float_t next_xramp_value(snd_fd *sf)
{
int i;
- mus_float_t val = 1.0;
- for (i = 0; i < READER_XRAMPS(sf); i++)
+ mus_float_t val;
+ val = (READER_XRAMP_OFFSET(sf, 0) + (READER_XRAMP_SCALER(sf, 0) * READER_XVAL(sf, 0)));
+ READER_XVAL(sf, 0) *= READER_XINCR(sf, 0);
+ for (i = 1; i < READER_XRAMPS(sf); i++)
{
val *= (READER_XRAMP_OFFSET(sf, i) + (READER_XRAMP_SCALER(sf, i) * READER_XVAL(sf, i)));
READER_XVAL(sf, i) *= READER_XINCR(sf, i);
@@ -764,6 +610,21 @@ static mus_float_t next_sample_value(snd_fd *sf)
else return(sf->data[sf->loc++] * sf->fscaler);
}
+
+#define SF_UNSAFE 0
+
+static mus_float_t next_sample_value_unchecked(snd_fd *sf)
+{
+#if SF_UNSAFE
+ if (sf->loc > sf->last)
+ {
+ fprintf(stderr, "ran off end somehow\n");
+ abort();
+ }
+#endif
+ return(sf->data[sf->loc++] * sf->fscaler);
+}
+
static mus_float_t previous_sample_value(snd_fd *sf)
{
if (sf->loc < sf->first)
@@ -771,6 +632,12 @@ static mus_float_t previous_sample_value(snd_fd *sf)
else return(sf->data[sf->loc--] * sf->fscaler);
}
+mus_float_t previous_sample_value_unchecked(snd_fd *sf) ;
+mus_float_t previous_sample_value_unchecked(snd_fd *sf)
+{
+ return(sf->data[sf->loc--] * sf->fscaler);
+}
+
static mus_float_t next_sample_value_unscaled(snd_fd *sf)
{
@@ -779,7 +646,21 @@ static mus_float_t next_sample_value_unscaled(snd_fd *sf)
else return(sf->data[sf->loc++]);
}
-static mus_float_t previous_sample_value_unscaled(snd_fd *sf)
+mus_float_t next_sample_value_unscaled_and_unchecked(snd_fd *sf);
+mus_float_t next_sample_value_unscaled_and_unchecked(snd_fd *sf)
+{
+#if SF_UNSAFE
+ if (sf->loc > sf->last)
+ {
+ fprintf(stderr, "ran off end somehow\n");
+ abort();
+ }
+#endif
+ return(sf->data[sf->loc++]);
+}
+
+mus_float_t previous_sample_value_unscaled(snd_fd *sf) ;
+mus_float_t previous_sample_value_unscaled(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
@@ -787,6 +668,13 @@ static mus_float_t previous_sample_value_unscaled(snd_fd *sf)
}
+mus_float_t previous_sample_value_unscaled_and_unchecked(snd_fd *sf);
+mus_float_t previous_sample_value_unscaled_and_unchecked(snd_fd *sf)
+{
+ return(sf->data[sf->loc--]);
+}
+
+
static mus_float_t next_zero(snd_fd *sf)
{
if (sf->loc > sf->last) return(next_sound(sf));
@@ -809,12 +697,27 @@ static mus_float_t next_ramp1(snd_fd *sf)
else
{
mus_float_t val;
- val = sf->data[sf->loc++] * READER_VAL(sf, 0) * MUS_FIX_TO_FLOAT;
+ val = sf->data[sf->loc++] * READER_VAL(sf, 0);
READER_VAL(sf, 0) += READER_INCR(sf, 0);
return(val);
}
}
+static mus_float_t next_ramp1_unchecked(snd_fd *sf)
+{
+ mus_float_t val;
+#if SF_UNSAFE
+ if (sf->loc > sf->last)
+ {
+ fprintf(stderr, "ran off end somehow\n");
+ abort();
+ }
+#endif
+ val = sf->data[sf->loc++] * READER_VAL(sf, 0);
+ READER_VAL(sf, 0) += READER_INCR(sf, 0);
+ return(val);
+}
+
static mus_float_t previous_ramp1(snd_fd *sf)
{
if (sf->loc < sf->first)
@@ -822,7 +725,7 @@ static mus_float_t previous_ramp1(snd_fd *sf)
else
{
mus_float_t val;
- val = sf->data[sf->loc--] * READER_VAL(sf, 0) * MUS_FIX_TO_FLOAT;
+ val = sf->data[sf->loc--] * READER_VAL(sf, 0);
READER_VAL(sf, 0) -= READER_INCR(sf, 0);
return(val);
}
@@ -833,14 +736,14 @@ static mus_float_t next_ramp_f(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- else return(MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * (*(READER_RAMPF(sf)))(sf)));
+ else return(sf->data[sf->loc++] * (*(READER_RAMPF(sf)))(sf));
}
static mus_float_t previous_ramp_f(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- else return(MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * (*(READER_REV_RAMPF(sf)))(sf)));
+ else return(sf->data[sf->loc--] * (*(READER_REV_RAMPF(sf)))(sf));
}
@@ -848,14 +751,14 @@ static mus_float_t next_ramp(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- else return(MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * next_ramp_value(sf)));
+ else return(sf->data[sf->loc++] * next_ramp_value(sf));
}
static mus_float_t previous_ramp(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- else return(MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * previous_ramp_value(sf)));
+ else return(sf->data[sf->loc--] * previous_ramp_value(sf));
}
@@ -863,14 +766,14 @@ static mus_float_t next_xramp1(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- else return(MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * READER_SCALER(sf) * next_xramp1_value(sf)));
+ else return(sf->data[sf->loc++] * READER_SCALER(sf) * next_xramp1_value(sf));
}
static mus_float_t previous_xramp1(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- else return(MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * READER_SCALER(sf) * previous_xramp1_value(sf)));
+ else return(sf->data[sf->loc--] * READER_SCALER(sf) * previous_xramp1_value(sf));
}
@@ -878,14 +781,14 @@ static mus_float_t next_xramp(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- else return(MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * READER_SCALER(sf) * next_xramp_value(sf)));
+ else return(sf->data[sf->loc++] * READER_SCALER(sf) * next_xramp_value(sf));
}
static mus_float_t previous_xramp(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- else return(MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * READER_SCALER(sf) * previous_xramp_value(sf)));
+ else return(sf->data[sf->loc--] * READER_SCALER(sf) * previous_xramp_value(sf));
}
@@ -896,9 +799,13 @@ static mus_float_t read_mix_list_samples(snd_fd *sf)
{
reader_mixes *m;
int i;
- mus_float_t sum = 0.0;
+ mus_float_t sum;
+
m = (reader_mixes *)(sf->mixes);
- for (i = 0; i < m->size; i++)
+ if (m->size == 0) return(0.0); /* this is apparently possible?? */
+
+ sum = read_sample(m->sfs[0]);
+ for (i = 1; i < m->size; i++)
sum += read_sample(m->sfs[i]);
return(sum);
}
@@ -969,14 +876,14 @@ static mus_float_t next_mix_ramp1(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * next_ramp1_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc++] * next_ramp1_value(sf)) + read_mix_list_samples(sf));
}
static mus_float_t previous_mix_ramp1(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * previous_ramp1_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc--] * previous_ramp1_value(sf)) + read_mix_list_samples(sf));
}
@@ -984,14 +891,14 @@ static mus_float_t next_mix_ramp2(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * next_ramp2_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc++] * next_ramp2_value(sf)) + read_mix_list_samples(sf));
}
static mus_float_t previous_mix_ramp2(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * previous_ramp2_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc--] * previous_ramp2_value(sf)) + read_mix_list_samples(sf));
}
@@ -999,14 +906,14 @@ static mus_float_t next_mix_ramp(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * next_ramp_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc++] * next_ramp_value(sf)) + read_mix_list_samples(sf));
}
static mus_float_t previous_mix_ramp(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * previous_ramp_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc--] * previous_ramp_value(sf)) + read_mix_list_samples(sf));
}
@@ -1014,14 +921,14 @@ static mus_float_t next_mix_xramp1(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * READER_SCALER(sf) * next_xramp1_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc++] * READER_SCALER(sf) * next_xramp1_value(sf)) + read_mix_list_samples(sf));
}
static mus_float_t previous_mix_xramp1(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * READER_SCALER(sf) * previous_xramp1_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc--] * READER_SCALER(sf) * previous_xramp1_value(sf)) + read_mix_list_samples(sf));
}
@@ -1029,14 +936,14 @@ static mus_float_t next_mix_xramp(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * READER_SCALER(sf) * next_xramp_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc++] * READER_SCALER(sf) * next_xramp_value(sf)) + read_mix_list_samples(sf));
}
static mus_float_t previous_mix_xramp(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * READER_SCALER(sf) * previous_xramp_value(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc--] * READER_SCALER(sf) * previous_xramp_value(sf)) + read_mix_list_samples(sf));
}
@@ -1044,1091 +951,178 @@ static mus_float_t next_mix_xramp_f_ramp_f(snd_fd *sf)
{
if (sf->loc > sf->last)
return(next_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc++] * (*(READER_RAMPF(sf)))(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc++] * (*(READER_RAMPF(sf)))(sf)) + read_mix_list_samples(sf));
}
static mus_float_t previous_mix_xramp_f_ramp_f(snd_fd *sf)
{
if (sf->loc < sf->first)
return(previous_sound(sf));
- return((MUS_SAMPLE_TO_FLOAT(sf->data[sf->loc--] * (*(READER_REV_RAMPF(sf)))(sf))) + read_mix_list_samples(sf));
+ return((sf->data[sf->loc--] * (*(READER_REV_RAMPF(sf)))(sf)) + read_mix_list_samples(sf));
}
-static mus_float_t next_ptree_value(snd_fd *sf)
-{
- mus_float_t val1 = 0.0;
- int i;
- if (!(READER_PTREE_ZERO(sf)))
- val1 = sf->data[sf->loc];
- sf->loc++;
- for (i = 0; (i < READER_PTREE_LIST_SIZE(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), true, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
-static mus_float_t previous_ptree_value(snd_fd *sf)
-{
- mus_float_t val1 = 0.0;
- int i;
- if (!(READER_PTREE_ZERO(sf)))
- val1 = sf->data[sf->loc];
- sf->loc--;
- for (i = 0; (i < READER_PTREE_LIST_SIZE(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), false, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
+/* this is a kind of state machine for the virtual editor: if, for example, the current
+ op is ed_ramp and we want to add an xramp, we look at the add_xramp field of
+ ed_ramp's type_info struct, and if it's not -1, the add_xramp field is the
+ new virtual editor op; otherwise the op is collapsed to a change edit.
+ So, to add a new entry, make the accessor, and fill in the fields that
+ can reach it. Since, for example, ramp->xramp is flipped to xramp->ramp
+ since a(b()) == b(a()) in this case, there can be several ways to reach
+ a given op. Then fix the ramp segments in choose_accessor. The first
+ struct field is redundant, but makes editing this table much easier.
+*/
-static mus_float_t next_ptree(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(READER_SCALER(sf) * next_ptree_value(sf));
-}
+enum {ED_SIMPLE, ED_MIX,
+ ED_ZERO, ED_MIX_ZERO,
-static mus_float_t previous_ptree(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(READER_SCALER(sf) * previous_ptree_value(sf));
-}
+ /* simple envelope special cases */
+ ED_RAMP1, ED_MIX_RAMP1,
+ ED_RAMP2, ED_MIX_RAMP2,
+ ED_XRAMP1, ED_MIX_XRAMP1,
+
+ /* envelopes */
+ ED_RAMP, ED_MIX_RAMP,
+ ED_XRAMP, ED_MIX_XRAMP,
+ ED_XRAMP_RAMP, ED_MIX_XRAMP_RAMP,
+ NUM_OPS
+};
-static mus_float_t next_mix_ptree(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- return((READER_SCALER(sf) * next_ptree_value(sf)) + read_mix_list_samples(sf));
-}
-static mus_float_t previous_mix_ptree(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- return((READER_SCALER(sf) * previous_ptree_value(sf)) + read_mix_list_samples(sf));
-}
+typedef struct {
+ int type, add_ramp, add_xramp, add_mix, subtract_mix;
+ bool ramps, zero, mixes; /* zero = no underlying data (mix, etc), mixes = involves virtual mixes in some way */
+ int scale_op;
+ const char *name;
+ mus_float_t (*next)(struct snd_fd *sf);
+ mus_float_t (*previous)(struct snd_fd *sf);
+ mus_float_t (*rampf)(struct snd_fd *sf);
+ mus_float_t (*rev_rampf)(struct snd_fd *sf);
+} fragment_type_info;
-static mus_float_t next_ptree_ramp_f_value(snd_fd *sf)
-{
- mus_float_t val1;
- int i;
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, 0),
- (*(READER_RAMPF(sf)))(sf) * sf->data[sf->loc++],
- READER_PTREE_CLOSURE(sf, 0), true, READER_PTREE_TYPE(sf, 0));
- for (i = 1; (i < READER_PTREE_LIST_SIZE(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), true, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
+enum {NO_SCALE, SIMPLE_SCALE, SCALE_R, SCALE_X};
-static mus_float_t previous_ptree_ramp_f_value(snd_fd *sf)
-{
- mus_float_t val1;
- int i;
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, 0),
- (*(READER_REV_RAMPF(sf)))(sf) * sf->data[sf->loc--],
- READER_PTREE_CLOSURE(sf, 0), false, READER_PTREE_TYPE(sf, 0));
- for (i = 1; (i < READER_PTREE_LIST_SIZE(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), false, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
+#define NO_RAMP false
+#define NO_MIX false
+#define ON_ZERO true
+#define ON_DATA false
+#define MIXED true
+#define RAMPED true
+static fragment_type_info type_info[NUM_OPS] = {
-static mus_float_t next_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(READER_SCALER(sf) * next_ptree_ramp_f_value(sf));
-}
+ {ED_SIMPLE, ED_RAMP1, ED_XRAMP1, ED_MIX, -1,
+ NO_RAMP, ON_DATA, NO_MIX, SIMPLE_SCALE,
+ "ed_simple", next_sample_value, previous_sample_value,
+ NULL, NULL},
-static mus_float_t previous_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(READER_SCALER(sf) * previous_ptree_ramp_f_value(sf));
-}
+ {ED_MIX, -1, -1, ED_MIX, ED_SIMPLE,
+ NO_RAMP, ON_DATA, MIXED, NO_SCALE,
+ "ed_mix_simple", next_mix, previous_mix,
+ NULL, NULL},
+ {ED_ZERO, ED_ZERO, ED_ZERO, ED_MIX_ZERO, -1,
+ NO_RAMP, ON_ZERO, NO_MIX, NO_SCALE,
+ "ed_zero", next_zero, previous_zero,
+ NULL, NULL},
-static mus_float_t next_mix_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- return((READER_SCALER(sf) * next_ptree_ramp_f_value(sf)) + read_mix_list_samples(sf));
-}
+ {ED_MIX_ZERO, -1, -1, ED_MIX_ZERO, ED_ZERO,
+ NO_RAMP, ON_ZERO, MIXED, NO_SCALE,
+ "ed_mix_zero", next_mix_zero, previous_mix_zero,
+ NULL, NULL},
-static mus_float_t previous_mix_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- return((READER_SCALER(sf) * previous_ptree_ramp_f_value(sf)) + read_mix_list_samples(sf));
-}
+ {ED_RAMP1, ED_RAMP2, ED_XRAMP_RAMP, ED_MIX_RAMP1, -1,
+ RAMPED, ON_DATA, NO_MIX, SCALE_R,
+ "ed_ramp1", next_ramp1, previous_ramp1,
+ NULL, NULL},
+ {ED_MIX_RAMP1, -1, -1, ED_MIX_RAMP1, ED_RAMP1,
+ RAMPED, ON_DATA, MIXED, SCALE_R,
+ "ed_mix_ramp1", next_mix_ramp1, previous_mix_ramp1,
+ NULL, NULL},
-static mus_float_t next_ptree_xramp_value(snd_fd *sf)
-{
- mus_float_t val1;
- int i;
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, 0),
- sf->data[sf->loc++] * READER_PTREE_SCALER(sf, 0) * next_xramp_value(sf),
- READER_PTREE_CLOSURE(sf, 0), true, READER_PTREE_TYPE(sf, 0));
- for (i = 1; (i < READER_PTREE_LIST_SIZE(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), true, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
+ {ED_RAMP2, ED_RAMP, ED_XRAMP_RAMP, ED_MIX_RAMP2, -1,
+ RAMPED, ON_DATA, NO_MIX, SCALE_R,
+ "ed_ramp2", next_ramp_f, previous_ramp_f,
+ next_ramp2_value, previous_ramp2_value},
-static mus_float_t previous_ptree_xramp_value(snd_fd *sf)
-{
- mus_float_t val1;
- int i;
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, 0),
- sf->data[sf->loc--] * READER_PTREE_SCALER(sf, 0) * previous_xramp_value(sf),
- READER_PTREE_CLOSURE(sf, 0), false, READER_PTREE_TYPE(sf, 0));
- for (i = 1; (i < READER_PTREE_LIST_SIZE(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), false, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
+ {ED_MIX_RAMP2, -1, -1, ED_MIX_RAMP2, ED_RAMP2,
+ RAMPED, ON_DATA, MIXED, SCALE_R,
+ "ed_mix_ramp2", next_mix_ramp2, previous_mix_ramp2,
+ NULL, NULL},
+ {ED_XRAMP1, ED_XRAMP_RAMP, ED_XRAMP, ED_MIX_XRAMP1, -1,
+ RAMPED, ON_DATA, NO_MIX, NO_SCALE,
+ "ed_xramp1", next_xramp1, previous_xramp1,
+ NULL, NULL},
+
+ {ED_MIX_XRAMP1, -1, -1, ED_MIX_XRAMP1, ED_XRAMP1,
+ RAMPED, ON_DATA, MIXED, NO_SCALE,
+ "ed_mix_xramp1", next_mix_xramp1, previous_mix_xramp1,
+ NULL, NULL},
-static mus_float_t next_ptree_xramp(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(READER_SCALER(sf) * next_ptree_xramp_value(sf));
-}
+ {ED_RAMP, ED_RAMP, ED_XRAMP_RAMP, ED_MIX_RAMP, -1,
+ RAMPED, ON_DATA, NO_MIX, SCALE_R,
+ "ed_ramp", next_ramp, previous_ramp,
+ NULL, NULL},
-static mus_float_t previous_ptree_xramp(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(READER_SCALER(sf) * previous_ptree_xramp_value(sf));
-}
+ {ED_MIX_RAMP, -1, -1, ED_MIX_RAMP, ED_RAMP,
+ RAMPED, ON_DATA, MIXED, SCALE_R,
+ "ed_mix_ramp", next_mix_ramp, previous_mix_ramp,
+ NULL, NULL},
+ {ED_XRAMP, ED_XRAMP_RAMP, ED_XRAMP, ED_MIX_XRAMP, -1,
+ RAMPED, ON_DATA, NO_MIX, NO_SCALE,
+ "ed_xramp", next_xramp, previous_xramp,
+ NULL, NULL},
-static mus_float_t next_mix_ptree_xramp(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return((READER_SCALER(sf) * next_ptree_xramp_value(sf)) + read_mix_list_samples(sf));
-}
+ {ED_MIX_XRAMP, -1, -1, ED_MIX_XRAMP, ED_XRAMP,
+ RAMPED, ON_DATA, MIXED, NO_SCALE,
+ "ed_mix_xramp", next_mix_xramp, previous_mix_xramp,
+ NULL, NULL},
-static mus_float_t previous_mix_ptree_xramp(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return((READER_SCALER(sf) * previous_ptree_xramp_value(sf)) + read_mix_list_samples(sf));
-}
+ {ED_XRAMP_RAMP, ED_XRAMP_RAMP, ED_XRAMP_RAMP, ED_MIX_XRAMP_RAMP, -1,
+ RAMPED, ON_DATA, NO_MIX, SCALE_R,
+ "ed_xramp_ramp", next_ramp_f, previous_ramp_f,
+ next_xramp_ramp_value, previous_xramp_ramp_value},
+
+ {ED_MIX_XRAMP_RAMP, -1, -1, ED_MIX_XRAMP_RAMP, ED_XRAMP_RAMP,
+ RAMPED, ON_DATA, MIXED, SCALE_R,
+ "ed_mix_xramp_ramp", next_mix_xramp_f_ramp_f, previous_mix_xramp_f_ramp_f,
+ next_xramp_ramp_value, previous_xramp_ramp_value},
+};
-static mus_float_t next_ramp_f_ptree(snd_fd *sf)
+static bool zero_op(int type)
{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return((*(READER_RAMPF(sf)))(sf) * next_ptree_value(sf));
+ return(type_info[type].zero);
}
-static mus_float_t previous_ramp_f_ptree(snd_fd *sf)
+
+static bool ramp_op(int type)
{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return((*(READER_REV_RAMPF(sf)))(sf) * previous_ptree_value(sf));
+ return(type_info[type].ramps);
}
-static mus_float_t next_mix_ramp_f_ptree(snd_fd *sf)
+static bool is_mix_op(int type)
{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- return(((*(READER_RAMPF(sf)))(sf) * next_ptree_value(sf)) + read_mix_list_samples(sf));
+ return(type_info[type].mixes);
}
-static mus_float_t previous_mix_ramp_f_ptree(snd_fd *sf)
+static bool is_unmixable_op(int type)
{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- return(((*(READER_REV_RAMPF(sf)))(sf) * previous_ptree_value(sf)) + read_mix_list_samples(sf));
+ return(type_info[type].subtract_mix != -1);
}
-
-static mus_float_t next_xramp_ptree(snd_fd *sf)
+static bool is_mixable_op(int type)
{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(next_xramp_value(sf) * READER_SCALER(sf) * next_ptree_value(sf));
-}
-
-static mus_float_t previous_xramp_ptree(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(previous_xramp_value(sf) * READER_SCALER(sf) * previous_ptree_value(sf));
-}
-
-
-static mus_float_t next_mix_xramp_ptree(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return((next_xramp_value(sf) * READER_SCALER(sf) * next_ptree_value(sf)) + read_mix_list_samples(sf));
-}
-
-static mus_float_t previous_mix_xramp_ptree(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return((previous_xramp_value(sf) * READER_SCALER(sf) * previous_ptree_value(sf)) + read_mix_list_samples(sf));
-}
-
-
-
-
-static mus_float_t next_ramp_to_split_value(snd_fd *sf)
-{
- mus_float_t val = 1.0;
- int i;
- for (i = 0; i < READER_RSPLIT(sf); i++)
- {
- val *= READER_VAL(sf, i);
- READER_VAL(sf, i) += READER_INCR(sf, i);
- }
- return(val);
-}
-
-static mus_float_t previous_ramp_to_split_value(snd_fd *sf)
-{
- mus_float_t val = 1.0;
- int i;
- for (i = 0; i < READER_RSPLIT(sf); i++)
- {
- val *= READER_VAL(sf, i);
- READER_VAL(sf, i) -= READER_INCR(sf, i);
- }
- return(val);
-}
-
-
-static mus_float_t next_ramp_from_split_value(snd_fd *sf)
-{
- mus_float_t val = 1.0;
- int i;
- for (i = READER_RSPLIT(sf); i < READER_RAMPS(sf); i++)
- {
- val *= READER_VAL(sf, i);
- READER_VAL(sf, i) += READER_INCR(sf, i);
- }
- return(val);
-}
-
-static mus_float_t previous_ramp_from_split_value(snd_fd *sf)
-{
- mus_float_t val = 1.0;
- int i;
- for (i = READER_RSPLIT(sf); i < READER_RAMPS(sf); i++)
- {
- val *= READER_VAL(sf, i);
- READER_VAL(sf, i) -= READER_INCR(sf, i);
- }
- return(val);
-}
-
-
-static mus_float_t next_xramp_to_split_value(snd_fd *sf)
-{
- int i;
- mus_float_t val = READER_PTREE_SCALER(sf, 0);
- for (i = 0; i < READER_XSPLIT(sf); i++)
- {
- val *= (READER_XRAMP_OFFSET(sf, i) + (READER_XRAMP_SCALER(sf, i) * READER_XVAL(sf, i)));
- READER_XVAL(sf, i) *= READER_XINCR(sf, i);
- }
- return(val);
-}
-
-static mus_float_t previous_xramp_to_split_value(snd_fd *sf)
-{
- int i;
- mus_float_t val = READER_PTREE_SCALER(sf, 0);
- for (i = 0; i < READER_XSPLIT(sf); i++)
- {
- val *= (READER_XRAMP_OFFSET(sf, i) + (READER_XRAMP_SCALER(sf, i) * READER_XVAL(sf, i)));
- READER_XVAL(sf, i) /= READER_XINCR(sf, i);
- }
- return(val);
-}
-
-
-static mus_float_t next_unscaled_xramp_to_split_value(snd_fd *sf)
-{
- int i;
- mus_float_t val = 1.0;
- for (i = 0; i < READER_XSPLIT(sf); i++)
- {
- val *= (READER_XRAMP_OFFSET(sf, i) + (READER_XRAMP_SCALER(sf, i) * READER_XVAL(sf, i)));
- READER_XVAL(sf, i) *= READER_XINCR(sf, i);
- }
- return(val);
-}
-
-static mus_float_t previous_unscaled_xramp_to_split_value(snd_fd *sf)
-{
- int i;
- mus_float_t val = 1.0;
- for (i = 0; i < READER_XSPLIT(sf); i++)
- {
- val *= (READER_XRAMP_OFFSET(sf, i) + (READER_XRAMP_SCALER(sf, i) * READER_XVAL(sf, i)));
- READER_XVAL(sf, i) /= READER_XINCR(sf, i);
- }
- return(val);
-}
-
-
-static mus_float_t next_xramp_from_split_value(snd_fd *sf)
-{
- int i;
- mus_float_t val = 1.0;
- for (i = READER_XSPLIT(sf); i < READER_XRAMPS(sf); i++)
- {
- val *= (READER_XRAMP_OFFSET(sf, i) + (READER_XRAMP_SCALER(sf, i) * READER_XVAL(sf, i)));
- READER_XVAL(sf, i) *= READER_XINCR(sf, i);
- }
- return(val);
-}
-
-static mus_float_t previous_xramp_from_split_value(snd_fd *sf)
-{
- int i;
- mus_float_t val = 1.0;
- for (i = READER_XSPLIT(sf); i < READER_XRAMPS(sf); i++)
- {
- val *= (READER_XRAMP_OFFSET(sf, i) + (READER_XRAMP_SCALER(sf, i) * READER_XVAL(sf, i)));
- READER_XVAL(sf, i) /= READER_XINCR(sf, i);
- }
- return(val);
-}
-
-
-static mus_float_t next_xramp_ramp_to_split_value(snd_fd *sf)
-{
- return(next_xramp_to_split_value(sf) * next_ramp_to_split_value(sf));
-}
-
-static mus_float_t previous_xramp_ramp_to_split_value(snd_fd *sf)
-{
- return(previous_xramp_to_split_value(sf) * previous_ramp_to_split_value(sf));
-}
-
-
-static mus_float_t next_unscaled_xramp_ramp_to_split_value(snd_fd *sf)
-{
- return(next_unscaled_xramp_to_split_value(sf) * next_ramp_to_split_value(sf));
-}
-
-static mus_float_t previous_unscaled_xramp_ramp_to_split_value(snd_fd *sf)
-{
- return(previous_unscaled_xramp_to_split_value(sf) * previous_ramp_to_split_value(sf));
-}
-
-
-static mus_float_t next_xramp_ramp_from_split_value(snd_fd *sf)
-{
- return(next_xramp_from_split_value(sf) * next_ramp_from_split_value(sf));
-}
-
-static mus_float_t previous_xramp_ramp_from_split_value(snd_fd *sf)
-{
- return(previous_xramp_from_split_value(sf) * previous_ramp_from_split_value(sf));
-}
-
-
-
-static mus_float_t next_ramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(next_ramp_from_split_value(sf) * next_ptree_ramp_f_value(sf));
-}
-
-static mus_float_t previous_ramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(previous_ramp_from_split_value(sf) * previous_ptree_ramp_f_value(sf));
-}
-
-
-static mus_float_t next_xramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(next_xramp_from_split_value(sf) * READER_SCALER(sf) * next_ptree_ramp_f_value(sf));
-}
-
-static mus_float_t previous_xramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(previous_xramp_from_split_value(sf) * READER_SCALER(sf) * previous_ptree_ramp_f_value(sf));
-}
-
-
-static mus_float_t next_xramp_ramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(next_xramp_ramp_from_split_value(sf) * next_ptree_ramp_f_value(sf));
-}
-
-static mus_float_t previous_xramp_ramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(previous_xramp_ramp_from_split_value(sf) * previous_ptree_ramp_f_value(sf));
-}
-
-
-
-static mus_float_t next_ptree_to_split_value(snd_fd *sf)
-{
- mus_float_t val1 = 0.0;
- int i;
- if (!(READER_PTREE_ZERO(sf)))
- val1 = sf->data[sf->loc];
- sf->loc++;
- for (i = 0; (i < READER_PSPLIT(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), true, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
-
-static mus_float_t previous_ptree_to_split_value(snd_fd *sf)
-{
- mus_float_t val1 = 0.0;
- int i;
- if (!(READER_PTREE_ZERO(sf)))
- val1 = sf->data[sf->loc];
- sf->loc--;
- for (i = 0; (i < READER_PSPLIT(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), false, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
-
-
-static mus_float_t next_ptree_from_split_value(snd_fd *sf, mus_float_t val1)
-{
- int i;
- for (i = READER_PSPLIT(sf); (i < READER_PTREE_LIST_SIZE(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), true, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
-
-static mus_float_t previous_ptree_from_split_value(snd_fd *sf, mus_float_t val1)
-{
- int i;
- for (i = READER_PSPLIT(sf); (i < READER_PTREE_LIST_SIZE(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), false, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
-
-
-static mus_float_t next_ptree_ramp_f_ptree(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(READER_SCALER(sf) *
- next_ptree_from_split_value(sf, (*(READER_RAMPF(sf)))(sf) * next_ptree_to_split_value(sf)));
-}
-
-static mus_float_t previous_ptree_ramp_f_ptree(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(READER_SCALER(sf) *
- previous_ptree_from_split_value(sf, (*(READER_REV_RAMPF(sf)))(sf) * previous_ptree_to_split_value(sf)));
-}
-
-
-
-static mus_float_t next_ptree_to_split_ramp_f_value(snd_fd *sf)
-{
- mus_float_t val1;
- int i;
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, 0),
- (*(READER_RAMPF(sf)))(sf) * READER_PTREE_SCALER(sf, 0) * sf->data[sf->loc++],
- READER_PTREE_CLOSURE(sf, 0), true, READER_PTREE_TYPE(sf, 0));
- for (i = 1; (i < READER_PSPLIT(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), true, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
-
-static mus_float_t previous_ptree_to_split_ramp_f_value(snd_fd *sf)
-{
- mus_float_t val1;
- int i;
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, 0),
- (*(READER_REV_RAMPF(sf)))(sf) * READER_PTREE_SCALER(sf, 0) * sf->data[sf->loc--],
- READER_PTREE_CLOSURE(sf, 0), false, READER_PTREE_TYPE(sf, 0));
- for (i = 1; (i < READER_PSPLIT(sf)) && (READER_PTREE(sf, i)); i++)
- val1 = mus_run_evaluate_ptreec(READER_PTREE(sf, i),
- READER_PTREE_SCALER(sf, i) * val1,
- READER_PTREE_CLOSURE(sf, i), false, READER_PTREE_TYPE(sf, i));
- return(val1);
-}
-
-
-static mus_float_t next_ptree_ramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(READER_SCALER(sf) *
- next_ptree_from_split_value(sf, next_ramp_from_split_value(sf) * next_ptree_to_split_ramp_f_value(sf)));
-}
-
-static mus_float_t previous_ptree_ramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(READER_SCALER(sf) *
- previous_ptree_from_split_value(sf, previous_ramp_from_split_value(sf) * previous_ptree_to_split_ramp_f_value(sf)));
-}
-
-
-static mus_float_t next_ptree_xramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(READER_SCALER(sf) *
- next_ptree_from_split_value(sf, next_xramp_from_split_value(sf) * next_ptree_to_split_ramp_f_value(sf)));
-}
-
-static mus_float_t previous_ptree_xramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(READER_SCALER(sf) *
- previous_ptree_from_split_value(sf, previous_xramp_from_split_value(sf) * previous_ptree_to_split_ramp_f_value(sf)));
-}
-
-
-static mus_float_t next_ptree_xramp_ramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(READER_SCALER(sf) *
- next_ptree_from_split_value(sf, next_xramp_ramp_from_split_value(sf) * next_ptree_to_split_ramp_f_value(sf)));
-}
-
-static mus_float_t previous_ptree_xramp_ramp_ptree_ramp_f(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(READER_SCALER(sf) *
- previous_ptree_from_split_value(sf, previous_xramp_ramp_from_split_value(sf) * previous_ptree_to_split_ramp_f_value(sf)));
-}
-
-
-
-static mus_float_t next_xramp_ramp_ptree_xramp_ramp_ptree(snd_fd *sf)
-{
- if (sf->loc > sf->last)
- return(next_sound(sf));
- else return(READER_SCALER(sf) * /* here ramps may be 0, so we can't embed the scaler */
- next_xramp_ramp_from_split_value(sf) *
- next_ptree_from_split_value(sf, next_unscaled_xramp_ramp_to_split_value(sf) * next_ptree_to_split_value(sf)));
-}
-
-static mus_float_t previous_xramp_ramp_ptree_xramp_ramp_ptree(snd_fd *sf)
-{
- if (sf->loc < sf->first)
- return(previous_sound(sf));
- else return(READER_SCALER(sf) *
- previous_xramp_ramp_from_split_value(sf) *
- previous_ptree_from_split_value(sf, previous_unscaled_xramp_ramp_to_split_value(sf) * previous_ptree_to_split_value(sf)));
-}
-
-
-
-
-/* this is a kind of state machine for the virtual editor: if, for example, the current
- op is ed_ramp and we want to add an xramp, we look at the add_xramp field of
- ed_ramp's type_info struct, and if it's not -1, the add_xramp field is the
- new virtual editor op; otherwise the op is collapsed to a change edit.
- So, to add a new entry, make the accessor, and fill in the fields that
- can reach it. Since, for example, ramp->xramp is flipped to xramp->ramp
- since a(b()) == b(a()) in this case, there can be several ways to reach
- a given op. Then fix the ramp segments in choose_accessor. The first
- struct field is redundant, but makes editing this table much easier.
-*/
-
-enum {ED_SIMPLE, ED_MIX,
- ED_ZERO, ED_MIX_ZERO,
-
- /* simple envelope special cases */
- ED_RAMP1, ED_MIX_RAMP1,
- ED_RAMP2, ED_MIX_RAMP2,
- ED_XRAMP1, ED_MIX_XRAMP1,
-
- /* envelopes */
- ED_RAMP, ED_MIX_RAMP,
- ED_XRAMP, ED_MIX_XRAMP,
- ED_XRAMP_RAMP, ED_MIX_XRAMP_RAMP,
-
- /* ptrees */
- ED_PTREE, ED_MIX_PTREE,
- ED_PTREE_ZERO, ED_MIX_PTREE_ZERO,
- ED_PTREE_RAMP, ED_MIX_PTREE_RAMP,
- ED_PTREE_XRAMP, ED_MIX_PTREE_XRAMP,
- ED_PTREE_XRAMP_RAMP, ED_MIX_PTREE_XRAMP_RAMP,
-
- ED_RAMP_PTREE, ED_MIX_RAMP_PTREE,
- ED_RAMP_PTREE_ZERO, ED_MIX_RAMP_PTREE_ZERO,
- ED_XRAMP_PTREE, ED_MIX_XRAMP_PTREE,
- ED_XRAMP_PTREE_ZERO, ED_MIX_XRAMP_PTREE_ZERO,
- ED_XRAMP_RAMP_PTREE, ED_MIX_XRAMP_RAMP_PTREE,
- ED_XRAMP_RAMP_PTREE_ZERO, ED_MIX_XRAMP_RAMP_PTREE_ZERO,
-
- /* split envelopes */
- ED_RAMP_PTREE_RAMP, ED_RAMP_PTREE_XRAMP, ED_RAMP_PTREE_XRAMP_RAMP,
- ED_XRAMP_PTREE_RAMP, ED_XRAMP_PTREE_XRAMP, ED_XRAMP_PTREE_XRAMP_RAMP,
- ED_XRAMP_RAMP_PTREE_RAMP, ED_XRAMP_RAMP_PTREE_XRAMP, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP,
-
- /* split ptrees/envelopes */
- ED_PTREE_RAMP_PTREE, ED_PTREE_RAMP_PTREE_ZERO,
- ED_PTREE_XRAMP_PTREE, ED_PTREE_XRAMP_PTREE_ZERO,
- ED_PTREE_XRAMP_RAMP_PTREE, ED_PTREE_XRAMP_RAMP_PTREE_ZERO,
-
- ED_PTREE_RAMP_PTREE_RAMP, ED_PTREE_RAMP_PTREE_XRAMP, ED_PTREE_RAMP_PTREE_XRAMP_RAMP,
- ED_PTREE_XRAMP_PTREE_RAMP, ED_PTREE_XRAMP_PTREE_XRAMP, ED_PTREE_XRAMP_PTREE_XRAMP_RAMP,
- ED_PTREE_XRAMP_RAMP_PTREE_RAMP, ED_PTREE_XRAMP_RAMP_PTREE_XRAMP, ED_PTREE_XRAMP_RAMP_PTREE_XRAMP_RAMP,
-
- ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE,
- ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO,
-
- NUM_OPS
-};
-
-
-typedef struct {
- int type, add_ramp, add_xramp, add_ptree, add_mix, subtract_mix;
- bool ptrees, ramps, zero, mixes; /* zero = no underlying data (mix, ptree, etc), mixes = involves virtual mixes in some way */
- int scale_op;
- const char *name;
- mus_float_t (*next)(struct snd_fd *sf);
- mus_float_t (*previous)(struct snd_fd *sf);
- mus_float_t (*rampf)(struct snd_fd *sf);
- mus_float_t (*rev_rampf)(struct snd_fd *sf);
-} fragment_type_info;
-
-
-enum {NO_SCALE, SIMPLE_SCALE, SCALE_R, SCALE_P, SCALE_P_R, SCALE_X};
-
-#define NO_PTREE false
-#define NO_RAMP false
-#define NO_MIX false
-#define ON_ZERO true
-#define ON_DATA false
-#define PTREED true
-#define MIXED true
-#define RAMPED true
-
-static fragment_type_info type_info[NUM_OPS] = {
-
- {ED_SIMPLE, ED_RAMP1, ED_XRAMP1, ED_PTREE, ED_MIX, -1,
- NO_PTREE, NO_RAMP, ON_DATA, NO_MIX, SIMPLE_SCALE,
- "ed_simple", next_sample_value, previous_sample_value,
- NULL, NULL},
-
- {ED_MIX, -1, -1, -1, ED_MIX, ED_SIMPLE,
- NO_PTREE, NO_RAMP, ON_DATA, MIXED, NO_SCALE,
- "ed_mix_simple", next_mix, previous_mix,
- NULL, NULL},
-
- {ED_ZERO, ED_ZERO, ED_ZERO, ED_PTREE_ZERO, ED_MIX_ZERO, -1,
- NO_PTREE, NO_RAMP, ON_ZERO, NO_MIX, NO_SCALE,
- "ed_zero", next_zero, previous_zero,
- NULL, NULL},
-
- {ED_MIX_ZERO, -1, -1, -1, ED_MIX_ZERO, ED_ZERO,
- NO_PTREE, NO_RAMP, ON_ZERO, MIXED, NO_SCALE,
- "ed_mix_zero", next_mix_zero, previous_mix_zero,
- NULL, NULL},
-
- {ED_RAMP1, ED_RAMP2, ED_XRAMP_RAMP, ED_PTREE_RAMP, ED_MIX_RAMP1, -1,
- NO_PTREE, RAMPED, ON_DATA, NO_MIX, SCALE_R,
- "ed_ramp1", next_ramp1, previous_ramp1,
- NULL, NULL},
-
- {ED_MIX_RAMP1, -1, -1, -1, ED_MIX_RAMP1, ED_RAMP1,
- NO_PTREE, RAMPED, ON_DATA, MIXED, SCALE_R,
- "ed_mix_ramp1", next_mix_ramp1, previous_mix_ramp1,
- NULL, NULL},
-
- {ED_RAMP2, ED_RAMP, ED_XRAMP_RAMP, ED_PTREE_RAMP, ED_MIX_RAMP2, -1,
- NO_PTREE, RAMPED, ON_DATA, NO_MIX, SCALE_R,
- "ed_ramp2", next_ramp_f, previous_ramp_f,
- next_ramp2_value, previous_ramp2_value},
-
- {ED_MIX_RAMP2, -1, -1, -1, ED_MIX_RAMP2, ED_RAMP2,
- NO_PTREE, RAMPED, ON_DATA, MIXED, SCALE_R,
- "ed_mix_ramp2", next_mix_ramp2, previous_mix_ramp2,
- NULL, NULL},
-
- {ED_XRAMP1, ED_XRAMP_RAMP, ED_XRAMP, ED_PTREE_XRAMP, ED_MIX_XRAMP1, -1,
- NO_PTREE, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_xramp1", next_xramp1, previous_xramp1,
- NULL, NULL},
-
- {ED_MIX_XRAMP1, -1, -1, -1, ED_MIX_XRAMP1, ED_XRAMP1,
- NO_PTREE, RAMPED, ON_DATA, MIXED, NO_SCALE,
- "ed_mix_xramp1", next_mix_xramp1, previous_mix_xramp1,
- NULL, NULL},
-
- {ED_RAMP, ED_RAMP, ED_XRAMP_RAMP, ED_PTREE_RAMP, ED_MIX_RAMP, -1,
- NO_PTREE, RAMPED, ON_DATA, NO_MIX, SCALE_R,
- "ed_ramp", next_ramp, previous_ramp,
- NULL, NULL},
-
- {ED_MIX_RAMP, -1, -1, -1, ED_MIX_RAMP, ED_RAMP,
- NO_PTREE, RAMPED, ON_DATA, MIXED, SCALE_R,
- "ed_mix_ramp", next_mix_ramp, previous_mix_ramp,
- NULL, NULL},
-
- {ED_XRAMP, ED_XRAMP_RAMP, ED_XRAMP, ED_PTREE_XRAMP, ED_MIX_XRAMP, -1,
- NO_PTREE, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_xramp", next_xramp, previous_xramp,
- NULL, NULL},
-
- {ED_MIX_XRAMP, -1, -1, -1, ED_MIX_XRAMP, ED_XRAMP,
- NO_PTREE, RAMPED, ON_DATA, MIXED, NO_SCALE,
- "ed_mix_xramp", next_mix_xramp, previous_mix_xramp,
- NULL, NULL},
-
- {ED_XRAMP_RAMP, ED_XRAMP_RAMP, ED_XRAMP_RAMP, ED_PTREE_XRAMP_RAMP, ED_MIX_XRAMP_RAMP, -1,
- NO_PTREE, RAMPED, ON_DATA, NO_MIX, SCALE_R,
- "ed_xramp_ramp", next_ramp_f, previous_ramp_f,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
- {ED_MIX_XRAMP_RAMP, -1, -1, -1, ED_MIX_XRAMP_RAMP, ED_XRAMP_RAMP,
- NO_PTREE, RAMPED, ON_DATA, MIXED, SCALE_R,
- "ed_mix_xramp_ramp", next_mix_xramp_f_ramp_f, previous_mix_xramp_f_ramp_f,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
-
- /* ptree */
- {ED_PTREE, ED_RAMP_PTREE, ED_XRAMP_PTREE, ED_PTREE, ED_MIX_PTREE, -1,
- PTREED, NO_RAMP, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree", next_ptree, previous_ptree,
- NULL, NULL},
-
- {ED_MIX_PTREE, -1, -1, -1, ED_MIX_PTREE, ED_PTREE,
- PTREED, NO_RAMP, ON_DATA, MIXED, NO_SCALE,
- "ed_mix_ptree", next_mix_ptree, previous_mix_ptree,
- NULL, NULL},
-
- {ED_PTREE_ZERO, ED_RAMP_PTREE_ZERO, ED_XRAMP_PTREE_ZERO, ED_PTREE_ZERO, ED_MIX_PTREE_ZERO, -1,
- PTREED, NO_RAMP, ON_ZERO, NO_MIX, NO_SCALE,
- "ed_ptree_zero", next_ptree, previous_ptree,
- NULL, NULL},
-
- {ED_MIX_PTREE_ZERO, -1, -1, -1, ED_MIX_PTREE_ZERO, ED_PTREE_ZERO,
- PTREED, NO_RAMP, ON_ZERO, MIXED, NO_SCALE,
- "ed_mix_ptree_zero", next_mix_ptree, previous_mix_ptree,
- NULL, NULL},
-
- {ED_PTREE_RAMP, ED_RAMP_PTREE_RAMP, ED_XRAMP_PTREE_RAMP, ED_PTREE_RAMP, ED_MIX_PTREE_RAMP, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_P,
- "ed_ptree_ramp", next_ptree_ramp_f, previous_ptree_ramp_f,
- next_ramp_value, previous_ramp_value},
-
- {ED_MIX_PTREE_RAMP, -1, -1, -1, ED_MIX_PTREE_RAMP, ED_PTREE_RAMP,
- PTREED, RAMPED, ON_DATA, MIXED, SCALE_P,
- "ed_mix_ptree_ramp", next_mix_ptree_ramp_f, previous_mix_ptree_ramp_f,
- next_ramp_value, previous_ramp_value},
-
- {ED_PTREE_XRAMP, ED_RAMP_PTREE_XRAMP, ED_XRAMP_PTREE_XRAMP, ED_PTREE_XRAMP, ED_MIX_PTREE_XRAMP, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp", next_ptree_xramp, previous_ptree_xramp,
- NULL, NULL},
-
- {ED_MIX_PTREE_XRAMP, -1, -1, -1, ED_MIX_PTREE_XRAMP, ED_PTREE_XRAMP,
- PTREED, RAMPED, ON_DATA, MIXED, NO_SCALE,
- "ed_mix_ptree_xramp", next_mix_ptree_xramp, previous_mix_ptree_xramp,
- NULL, NULL},
-
- {ED_PTREE_XRAMP_RAMP, ED_RAMP_PTREE_XRAMP_RAMP, ED_XRAMP_PTREE_XRAMP_RAMP, ED_PTREE_XRAMP_RAMP, ED_MIX_PTREE_XRAMP_RAMP, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_P,
- "ed_ptree_xramp_ramp", next_ptree_ramp_f, previous_ptree_ramp_f,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
- {ED_MIX_PTREE_XRAMP_RAMP, -1, -1, -1, ED_MIX_PTREE_XRAMP_RAMP, ED_PTREE_XRAMP_RAMP,
- PTREED, RAMPED, ON_DATA, MIXED, SCALE_P,
- "ed_mix_ptree_xramp_ramp", next_mix_ptree_ramp_f, previous_mix_ptree_ramp_f,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
-
- {ED_RAMP_PTREE, ED_RAMP_PTREE, ED_XRAMP_RAMP_PTREE, ED_PTREE_RAMP_PTREE, ED_MIX_RAMP_PTREE, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_R,
- "ed_ramp_ptree", next_ramp_f_ptree, previous_ramp_f_ptree,
- next_ramp_value, previous_ramp_value},
-
- {ED_MIX_RAMP_PTREE, -1, -1, -1, ED_MIX_RAMP_PTREE, ED_RAMP_PTREE,
- PTREED, RAMPED, ON_DATA, MIXED, SCALE_R,
- "ed_mix_ramp_ptree", next_mix_ramp_f_ptree, previous_mix_ramp_f_ptree,
- next_ramp_value, previous_ramp_value},
-
- {ED_RAMP_PTREE_ZERO, ED_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_ZERO, ED_PTREE_RAMP_PTREE_ZERO, ED_MIX_RAMP_PTREE_ZERO, -1,
- PTREED, RAMPED, ON_ZERO, NO_MIX, SCALE_R,
- "ed_ramp_ptree_zero", next_ramp_f_ptree, previous_ramp_f_ptree,
- next_ramp_value, previous_ramp_value},
-
- {ED_MIX_RAMP_PTREE_ZERO, -1, -1, -1, ED_MIX_RAMP_PTREE_ZERO, ED_RAMP_PTREE_ZERO,
- PTREED, RAMPED, ON_ZERO, MIXED, SCALE_R,
- "ed_mix_ramp_ptree_zero", next_mix_ramp_f_ptree, previous_mix_ramp_f_ptree,
- next_ramp_value, previous_ramp_value},
-
- {ED_XRAMP_PTREE, ED_XRAMP_RAMP_PTREE, ED_XRAMP_PTREE, ED_PTREE_XRAMP_PTREE, ED_MIX_XRAMP_PTREE, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_xramp_ptree", next_xramp_ptree, previous_xramp_ptree,
- NULL, NULL},
-
- {ED_MIX_XRAMP_PTREE, -1, -1, -1, ED_MIX_XRAMP_PTREE, ED_XRAMP_PTREE,
- PTREED, RAMPED, ON_DATA, MIXED, NO_SCALE,
- "ed_mix_xramp_ptree", next_mix_xramp_ptree, previous_mix_xramp_ptree,
- NULL, NULL},
-
- {ED_XRAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_PTREE_ZERO, ED_PTREE_XRAMP_PTREE_ZERO, ED_MIX_XRAMP_PTREE_ZERO, -1,
- PTREED, RAMPED, ON_ZERO, NO_MIX, NO_SCALE,
- "ed_xramp_ptree_zero", next_xramp_ptree, previous_xramp_ptree,
- NULL, NULL},
-
- {ED_MIX_XRAMP_PTREE_ZERO, -1, -1, -1, ED_MIX_XRAMP_PTREE_ZERO, ED_XRAMP_PTREE_ZERO,
- PTREED, RAMPED, ON_ZERO, MIXED, NO_SCALE,
- "ed_mix_xramp_ptree_zero", next_mix_xramp_ptree, previous_mix_xramp_ptree,
- NULL, NULL},
-
- {ED_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE, ED_PTREE_XRAMP_RAMP_PTREE, ED_MIX_XRAMP_RAMP_PTREE, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_R,
- "ed_xramp_ramp_ptree", next_ramp_f_ptree, previous_ramp_f_ptree,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
- {ED_MIX_XRAMP_RAMP_PTREE, -1, -1, -1, ED_MIX_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE,
- PTREED, RAMPED, ON_DATA, MIXED, SCALE_R,
- "ed_mix_xramp_ramp_ptree", next_mix_ramp_f_ptree, previous_mix_ramp_f_ptree,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
- {ED_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_ZERO, ED_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_MIX_XRAMP_RAMP_PTREE_ZERO, -1,
- PTREED, RAMPED, ON_ZERO, NO_MIX, SCALE_R,
- "ed_xramp_ramp_ptree_zero", next_ramp_f_ptree, previous_ramp_f_ptree,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
- {ED_MIX_XRAMP_RAMP_PTREE_ZERO, -1, -1, -1, ED_MIX_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_ZERO,
- PTREED, RAMPED, ON_ZERO, MIXED, SCALE_R,
- "ed_mix_xramp_ramp_ptree_zero", next_mix_ramp_f_ptree, previous_mix_ramp_f_ptree,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
-
- /* split ramps */
- {ED_RAMP_PTREE_RAMP, ED_RAMP_PTREE_RAMP, ED_XRAMP_RAMP_PTREE_RAMP, ED_PTREE_RAMP_PTREE_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_P_R,
- "ed_ramp_ptree_ramp", next_ramp_ptree_ramp_f, previous_ramp_ptree_ramp_f,
- next_ramp_to_split_value, previous_ramp_to_split_value},
-
- {ED_RAMP_PTREE_XRAMP, ED_RAMP_PTREE_XRAMP, ED_XRAMP_RAMP_PTREE_XRAMP, ED_PTREE_RAMP_PTREE_XRAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_R,
- "ed_ramp_ptree_xramp", next_ramp_ptree_ramp_f, previous_ramp_ptree_ramp_f,
- next_xramp_to_split_value, previous_xramp_to_split_value},
-
- {ED_RAMP_PTREE_XRAMP_RAMP, ED_RAMP_PTREE_XRAMP_RAMP, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP, ED_PTREE_RAMP_PTREE_XRAMP_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_X,
- "ed_ramp_ptree_xramp_ramp", next_ramp_ptree_ramp_f, previous_ramp_ptree_ramp_f,
- next_xramp_ramp_to_split_value, previous_xramp_ramp_to_split_value},
-
- {ED_XRAMP_PTREE_RAMP, ED_XRAMP_RAMP_PTREE_RAMP, ED_XRAMP_PTREE_RAMP, ED_PTREE_XRAMP_PTREE_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_P,
- "ed_xramp_ptree_ramp", next_xramp_ptree_ramp_f, previous_xramp_ptree_ramp_f,
- next_ramp_to_split_value, previous_ramp_to_split_value},
-
- {ED_XRAMP_PTREE_XRAMP, ED_XRAMP_RAMP_PTREE_XRAMP, ED_XRAMP_PTREE_XRAMP, ED_PTREE_XRAMP_PTREE_XRAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_xramp_ptree_xramp", next_xramp_ptree_ramp_f, previous_xramp_ptree_ramp_f,
- next_xramp_to_split_value, previous_xramp_to_split_value},
-
- {ED_XRAMP_PTREE_XRAMP_RAMP, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP, ED_XRAMP_PTREE_XRAMP_RAMP, ED_PTREE_XRAMP_PTREE_XRAMP_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_xramp_ptree_xramp_ramp", next_xramp_ptree_ramp_f, previous_xramp_ptree_ramp_f,
- next_xramp_ramp_to_split_value, previous_xramp_ramp_to_split_value},
-
- {ED_XRAMP_RAMP_PTREE_RAMP, ED_XRAMP_RAMP_PTREE_RAMP, ED_XRAMP_RAMP_PTREE_RAMP, ED_PTREE_XRAMP_RAMP_PTREE_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_P_R,
- "ed_xramp_ramp_ptree_ramp", next_xramp_ramp_ptree_ramp_f, previous_xramp_ramp_ptree_ramp_f,
- next_ramp_to_split_value, previous_ramp_to_split_value},
-
- {ED_XRAMP_RAMP_PTREE_XRAMP, ED_XRAMP_RAMP_PTREE_XRAMP, ED_XRAMP_RAMP_PTREE_XRAMP, ED_PTREE_XRAMP_RAMP_PTREE_XRAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_R,
- "ed_xramp_ramp_ptree_xramp", next_xramp_ramp_ptree_ramp_f, previous_xramp_ramp_ptree_ramp_f,
- next_xramp_to_split_value, previous_xramp_to_split_value},
-
- {ED_XRAMP_RAMP_PTREE_XRAMP_RAMP, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP, ED_PTREE_XRAMP_RAMP_PTREE_XRAMP_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, SCALE_X,
- "ed_xramp_ramp_ptree_xramp_ramp", next_xramp_ramp_ptree_ramp_f, previous_xramp_ramp_ptree_ramp_f,
- next_xramp_ramp_to_split_value, previous_xramp_ramp_to_split_value},
-
-
- /* split ptrees */
- {ED_PTREE_RAMP_PTREE, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, ED_PTREE_RAMP_PTREE, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_ramp_ptree", next_ptree_ramp_f_ptree, previous_ptree_ramp_f_ptree, next_ramp_value, previous_ramp_value},
-
- {ED_PTREE_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_PTREE_RAMP_PTREE_ZERO, -1, -1,
- PTREED, RAMPED, ON_ZERO, NO_MIX, NO_SCALE,
- "ed_ptree_ramp_ptree_zero", next_ptree_ramp_f_ptree, previous_ptree_ramp_f_ptree, next_ramp_value, previous_ramp_value},
-
- {ED_PTREE_XRAMP_PTREE, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, ED_PTREE_XRAMP_PTREE, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ptree", next_ptree_ramp_f_ptree, previous_ptree_ramp_f_ptree, next_xramp_value, previous_xramp_value},
-
- {ED_PTREE_XRAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_PTREE_XRAMP_PTREE_ZERO, -1, -1,
- PTREED, RAMPED, ON_ZERO, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ptree_zero", next_ptree_ramp_f_ptree, previous_ptree_ramp_f_ptree, next_xramp_value, previous_xramp_value},
-
- {ED_PTREE_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, ED_PTREE_XRAMP_RAMP_PTREE, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ramp_ptree", next_ptree_ramp_f_ptree, previous_ptree_ramp_f_ptree,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
- {ED_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_PTREE_XRAMP_RAMP_PTREE_ZERO, -1, -1,
- PTREED, RAMPED, ON_ZERO, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ramp_ptree_zero", next_ptree_ramp_f_ptree, previous_ptree_ramp_f_ptree,
- next_xramp_ramp_value, previous_xramp_ramp_value},
-
- {ED_PTREE_RAMP_PTREE_RAMP, -1, -1, ED_PTREE_RAMP_PTREE_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_ramp_ptree_ramp", next_ptree_ramp_ptree_ramp_f, previous_ptree_ramp_ptree_ramp_f,
- next_ramp_to_split_value, previous_ramp_to_split_value},
-
- {ED_PTREE_RAMP_PTREE_XRAMP, -1, -1, ED_PTREE_RAMP_PTREE_XRAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_ramp_ptree_xramp", next_ptree_ramp_ptree_ramp_f, previous_ptree_ramp_ptree_ramp_f,
- next_unscaled_xramp_to_split_value, previous_unscaled_xramp_to_split_value},
-
- {ED_PTREE_RAMP_PTREE_XRAMP_RAMP, -1, -1, ED_PTREE_RAMP_PTREE_XRAMP_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_ramp_ptree_xramp_ramp", next_ptree_ramp_ptree_ramp_f, previous_ptree_ramp_ptree_ramp_f,
- next_unscaled_xramp_ramp_to_split_value, previous_unscaled_xramp_ramp_to_split_value},
-
- {ED_PTREE_XRAMP_PTREE_RAMP, -1, -1, ED_PTREE_XRAMP_PTREE_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ptree_ramp", next_ptree_xramp_ptree_ramp_f, previous_ptree_xramp_ptree_ramp_f,
- next_ramp_to_split_value, previous_ramp_to_split_value},
-
- {ED_PTREE_XRAMP_PTREE_XRAMP, -1, -1, ED_PTREE_XRAMP_PTREE_XRAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ptree_xramp", next_ptree_xramp_ptree_ramp_f, previous_ptree_xramp_ptree_ramp_f,
- next_unscaled_xramp_to_split_value, previous_unscaled_xramp_to_split_value},
-
- {ED_PTREE_XRAMP_PTREE_XRAMP_RAMP, -1, -1, ED_PTREE_XRAMP_PTREE_XRAMP_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ptree_xramp_ramp", next_ptree_xramp_ptree_ramp_f, previous_ptree_xramp_ptree_ramp_f,
- next_unscaled_xramp_ramp_to_split_value, previous_unscaled_xramp_ramp_to_split_value},
-
- {ED_PTREE_XRAMP_RAMP_PTREE_RAMP, -1, -1, ED_PTREE_XRAMP_RAMP_PTREE_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ramp_ptree_ramp", next_ptree_xramp_ramp_ptree_ramp_f, previous_ptree_xramp_ramp_ptree_ramp_f,
- next_ramp_to_split_value, previous_ramp_to_split_value},
-
- {ED_PTREE_XRAMP_RAMP_PTREE_XRAMP, -1, -1, ED_PTREE_XRAMP_RAMP_PTREE_XRAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ramp_ptree_xramp", next_ptree_xramp_ramp_ptree_ramp_f, previous_ptree_xramp_ramp_ptree_ramp_f,
- next_unscaled_xramp_to_split_value, previous_unscaled_xramp_to_split_value},
-
- {ED_PTREE_XRAMP_RAMP_PTREE_XRAMP_RAMP, -1, -1, ED_PTREE_XRAMP_RAMP_PTREE_XRAMP_RAMP, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_ptree_xramp_ramp_ptree_xramp_ramp", next_ptree_xramp_ramp_ptree_ramp_f, previous_ptree_xramp_ramp_ptree_ramp_f,
- next_unscaled_xramp_ramp_to_split_value, previous_unscaled_xramp_ramp_to_split_value},
-
- {ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE, -1, -1, -1,
- PTREED, RAMPED, ON_DATA, NO_MIX, NO_SCALE,
- "ed_xramp_ramp_ptree_xramp_ramp_ptree", next_xramp_ramp_ptree_xramp_ramp_ptree, previous_xramp_ramp_ptree_xramp_ramp_ptree,
- NULL, NULL},
-
- {ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE_ZERO, -1, -1, -1,
- PTREED, RAMPED, ON_ZERO, NO_MIX, NO_SCALE,
- "ed_xramp_ramp_ptree_xramp_ramp_ptree_zero", next_xramp_ramp_ptree_xramp_ramp_ptree, previous_xramp_ramp_ptree_xramp_ramp_ptree,
- NULL, NULL},
-
-};
-
-
-static bool ptree_op(int type)
-{
- return(type_info[type].ptrees);
-}
-
-
-static bool split_ptree_op(int type)
-{
- return(type >= ED_PTREE_RAMP_PTREE); /* order matters here */
-}
-
-
-static bool double_split_op(int type)
-{
- return(type >= ED_XRAMP_RAMP_PTREE_XRAMP_RAMP_PTREE);
-}
-
-
-static bool zero_op(int type)
-{
- return(type_info[type].zero);
-}
-
-
-static bool ramp_op(int type)
-{
- return(type_info[type].ramps);
-}
-
-
-static bool ramp_or_ptree_op(int type)
-{
- return((ramp_op(type)) || (ptree_op(type)));
-}
-
-
-static bool is_mix_op(int type)
-{
- return(type_info[type].mixes);
-}
-
-static bool is_unmixable_op(int type)
-{
- return(type_info[type].subtract_mix != -1);
-}
-
-static bool is_mixable_op(int type)
-{
- return(type_info[type].add_mix != -1);
+ return(type_info[type].add_mix != -1);
}
@@ -2157,7 +1151,7 @@ static void report_unhit_entries(void)
}
-static void check_type_info_entry(int op, int expected_ramps, int expected_xramps, int expected_ptrees, bool is_zero)
+static void check_type_info_entry(int op, int expected_ramps, int expected_xramps, bool is_zero)
{
hit_entry[op]++;
if (op != type_info[op].type)
@@ -2172,14 +1166,12 @@ static void check_type_info_entry(int op, int expected_ramps, int expected_xramp
if (is_zero != type_info[op].zero)
fprintf(stderr, "%s zero: %d %d\n", type_info[op].name, is_zero, type_info[op].zero);
if ((type_info[op].add_ramp != -1) && (type_info[op].add_ramp != op))
- check_type_info_entry(type_info[op].add_ramp, expected_ramps + 1, expected_xramps, expected_ptrees, is_zero);
+ check_type_info_entry(type_info[op].add_ramp, expected_ramps + 1, expected_xramps, is_zero);
if ((type_info[op].add_xramp != -1) && (type_info[op].add_xramp != op))
- check_type_info_entry(type_info[op].add_xramp, expected_ramps, expected_xramps + 1, expected_ptrees, is_zero);
- if ((type_info[op].add_ptree != -1) && (type_info[op].add_ptree != op))
- check_type_info_entry(type_info[op].add_ptree, expected_ramps, expected_xramps, expected_ptrees + 1, is_zero);
+ check_type_info_entry(type_info[op].add_xramp, expected_ramps, expected_xramps + 1, is_zero);
if ((type_info[op].add_mix != -1) &&
(type_info[op].subtract_mix == -1)) /* not a loop! */
- check_type_info_entry(type_info[op].add_mix, expected_ramps, expected_xramps, expected_ptrees, is_zero);
+ check_type_info_entry(type_info[op].add_mix, expected_ramps, expected_xramps, is_zero);
if ((!(type_info[op].mixes)) && (type_info[op].subtract_mix != -1))
fprintf(stderr, "%s: mix confused (#f)?\n", type_info[op].name);
@@ -2194,7 +1186,6 @@ static void check_type_info_entry(int op, int expected_ramps, int expected_xramp
(op != ED_MIX_ZERO))
fprintf(stderr, "%s add_ramp: %s\n", type_info[op].name, type_info[type_info[op].add_ramp].name);
if (type_info[op].add_xramp != -1) fprintf(stderr, "%s add_xramp: %s\n", type_info[op].name, type_info[type_info[op].add_xramp].name);
- if (type_info[op].add_ptree != -1) fprintf(stderr, "%s add_ptree: %s\n", type_info[op].name, type_info[type_info[op].add_ptree].name);
if (type_info[type_info[op].subtract_mix].add_mix != op)
fprintf(stderr, "%s subtract: %s but its add: %s\n",
@@ -2226,7 +1217,7 @@ void read_sample_change_direction(snd_fd *sf, read_direction_t dir1) /* can't us
}
-mus_float_t protected_next_sample(snd_fd *sf)
+static mus_float_t protected_next_sample(snd_fd *sf)
{
if (sf->direction == READ_BACKWARD)
read_sample_change_direction(sf, READ_FORWARD);
@@ -2234,7 +1225,7 @@ mus_float_t protected_next_sample(snd_fd *sf)
}
-mus_float_t protected_previous_sample(snd_fd *sf)
+static mus_float_t protected_previous_sample(snd_fd *sf)
{
if (sf->direction == READ_FORWARD)
read_sample_change_direction(sf, READ_BACKWARD);
@@ -2263,39 +1254,6 @@ static snd_fd *cancel_reader(snd_fd *sf)
}
-static XEN empty_closure;
-
-static void get_sf_closure(snd_fd *sf, int pt)
-{
- XEN proc;
- proc = sf->cp->ptree_inits[READER_PTREE_INDEX(sf, pt)];
- if (READER_PTREE_GC_LOC(sf, pt) != NOT_A_GC_LOC)
- {
- snd_unprotect_at(READER_PTREE_GC_LOC(sf, pt));
- READER_PTREE_GC_LOC(sf, pt) = NOT_A_GC_LOC;
- }
- READER_PTREE_CLOSURE(sf, pt) = empty_closure;
- if (XEN_PROCEDURE_P(proc))
- {
- if (sf->cp->init_args[READER_PTREE_INDEX(sf, pt)] == 3)
- READER_PTREE_CLOSURE(sf, pt) = XEN_CALL_3(proc,
- C_TO_XEN_INT64_T(sf->frag_pos + READER_PTREE_POSITION(sf, pt)),
- C_TO_XEN_INT64_T(READER_PTREE_DUR(sf, pt)), /* ptree_dur is the original (full) ptree-channel duration */
- C_TO_XEN_BOOLEAN(sf->direction == READ_FORWARD),
- S_ptree_channel " init func");
- else READER_PTREE_CLOSURE(sf, pt) = XEN_CALL_2(proc,
- C_TO_XEN_INT64_T(sf->frag_pos + READER_PTREE_POSITION(sf, pt)),
- C_TO_XEN_INT64_T(READER_PTREE_DUR(sf, pt)), /* ptree_dur is the original (full) ptree-channel duration */
- S_ptree_channel " init func");
- if (XEN_BOUND_P(READER_PTREE_CLOSURE(sf, pt)))
- {
- READER_PTREE_GC_LOC(sf, pt) = snd_protect(READER_PTREE_CLOSURE(sf, pt));
- READER_PTREE_TYPE(sf, pt) = mus_run_xen_to_run_type(READER_PTREE_CLOSURE(sf, pt));
- }
- }
-}
-
-
static reader_mixes *free_reader_mixes(reader_mixes *md);
static void setup_mix(snd_fd *sf)
@@ -2349,49 +1307,6 @@ static void setup_mix(snd_fd *sf)
}
-static void setup_ptrees(snd_fd *sf, int typ)
-{
- int i, pts;
- if (sf->ptrees == NULL)
- sf->ptrees = (void *)calloc(1, sizeof(reader_ptrees));
-
- pts = ED_PTREE_LIST_SIZE((ed_fragment *)(sf->cb));
- if (pts > READER_PTREE_LIST_SIZE(sf))
- {
- if (READER_PTREE_LIST_SIZE(sf) == 0)
- READER_PTREE_LIST(sf) = (ptree_info *)calloc(pts, sizeof(ptree_info));
- else READER_PTREE_LIST(sf) = (ptree_info *)realloc(READER_PTREE_LIST(sf), pts * sizeof(ptree_info));
- for (i = READER_PTREE_LIST_SIZE(sf); i < pts; i++)
- {
- READER_PTREE_CLOSURE(sf, i) = XEN_UNDEFINED; /* make sure no XEN field is 0! */
- READER_PTREE_GC_LOC(sf, i) = NOT_A_GC_LOC;
- READER_PTREE(sf, i) = NULL;
- }
- READER_PTREE_LIST_SIZE(sf) = pts;
- }
-
- for (i = 0; i < pts; i++)
- {
- READER_PTREE(sf, i) = sf->cp->ptrees[READER_PTREE_INDEX(sf, i)];
- get_sf_closure(sf, i);
- }
-
- for (i = pts; i < READER_PTREE_LIST_SIZE(sf); i++)
- {
- if (READER_PTREE_GC_LOC(sf, i) != NOT_A_GC_LOC)
- snd_unprotect_at(READER_PTREE_GC_LOC(sf, i));
- READER_PTREE_CLOSURE(sf, i) = XEN_UNDEFINED;
- READER_PTREE_GC_LOC(sf, i) = NOT_A_GC_LOC;
- READER_PTREE(sf, i) = NULL;
- }
-
- READER_PTREE_ZERO(sf) = zero_op(typ);
- READER_PSPLIT(sf) = ED_PSPLIT((ed_fragment *)(sf->cb));
- READER_RSPLIT(sf) = ED_RSPLIT((ed_fragment *)(sf->cb));
- READER_XSPLIT(sf) = ED_XSPLIT((ed_fragment *)(sf->cb));
-}
-
-
static void setup_ramps(snd_fd *sf, int typ)
{
int rmps, xrmps;
@@ -2492,20 +1407,6 @@ static void scale_inputs(snd_fd *sf, int scl_type)
case SCALE_R:
scale_ramp(sf, 0, READER_SCALER(sf));
break;
-
- case SCALE_P:
- scale_ramp(sf, 0, READER_PTREE_SCALER(sf, 0));
- break;
-
- case SCALE_P_R:
- scale_ramp(sf, 0, READER_PTREE_SCALER(sf, 0));
- scale_ramp(sf, READER_RSPLIT(sf), READER_SCALER(sf));
- break;
-
- case SCALE_X:
- scale_ramp(sf, READER_RSPLIT(sf), READER_SCALER(sf));
- break;
-
}
}
@@ -2520,9 +1421,6 @@ static void choose_accessor(snd_fd *sf)
if (ramp_op(typ))
setup_ramps(sf, typ);
- if (ptree_op(typ))
- setup_ptrees(sf, typ);
-
if (is_mix_op(typ))
setup_mix(sf);
@@ -2535,12 +1433,12 @@ static void choose_accessor(snd_fd *sf)
}
-static const char *edit_names[NUM_EDIT_TYPES] = {"insert", "delete", "set", "init", "scale", "zero", "env", "ptree", "extend", "mix", "change mix"};
+static const char *edit_names[NUM_EDIT_TYPES] = {"insert", "delete", "set", "init", "scale", "zero", "env", "extend", "mix", "change mix"};
-static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed, bool with_source)
+static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed)
{
- int len, j, index;
+ int len, j;
snd_data *sd;
if (ed == NULL)
{
@@ -2555,16 +1453,15 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed, bool
len = ed->size; /* number of fragments in this list */
switch (ed->edit_type)
{
- case INSERTION_EDIT: fprintf(outp, "\n (insert " MUS_LD " " MUS_LD ") ", ed->beg, ed->len); break;
- case DELETION_EDIT: fprintf(outp, "\n (delete " MUS_LD " " MUS_LD ") ", ed->beg, ed->len); break;
- case CHANGE_EDIT: fprintf(outp, "\n (set " MUS_LD " " MUS_LD ") ", ed->beg, ed->len); break;
- case SCALED_EDIT: fprintf(outp, "\n (scale " MUS_LD " " MUS_LD ") ", ed->beg, ed->len); break;
- case ZERO_EDIT: fprintf(outp, "\n (silence " MUS_LD " " MUS_LD ") ", ed->beg, ed->len); break;
- case RAMP_EDIT: fprintf(outp, "\n (ramp " MUS_LD " " MUS_LD ") ", ed->beg, ed->len); break;
- case PTREE_EDIT: fprintf(outp, "\n (ptree[%d] " MUS_LD " " MUS_LD ") ", ed->ptree_location, ed->beg, ed->len); break;
+ case INSERTION_EDIT: fprintf(outp, "\n (insert %lld %lld) ", ed->beg, ed->len); break;
+ case DELETION_EDIT: fprintf(outp, "\n (delete %lld %lld) ", ed->beg, ed->len); break;
+ case CHANGE_EDIT: fprintf(outp, "\n (set %lld %lld) ", ed->beg, ed->len); break;
+ case SCALED_EDIT: fprintf(outp, "\n (scale %lld %lld) ", ed->beg, ed->len); break;
+ case ZERO_EDIT: fprintf(outp, "\n (silence %lld %lld) ", ed->beg, ed->len); break;
+ case RAMP_EDIT: fprintf(outp, "\n (ramp %lld %lld) ", ed->beg, ed->len); break;
case EXTEND_EDIT: fprintf(outp, "\n (extend edit list with no-op)"); break;
- case MIX_EDIT: fprintf(outp, "\n (mix " MUS_LD " " MUS_LD ") ", ed->beg, ed->len); break;
- case CHANGE_MIX_EDIT: fprintf(outp, "\n (change mix " MUS_LD " " MUS_LD ") ", ed->beg, ed->len); break;
+ case MIX_EDIT: fprintf(outp, "\n (mix %lld %lld) ", ed->beg, ed->len); break;
+ case CHANGE_MIX_EDIT: fprintf(outp, "\n (change mix %lld %lld) ", ed->beg, ed->len); break;
case INITIALIZE_EDIT: fprintf(outp, "\n (begin) "); break;
default: break;
}
@@ -2572,14 +1469,15 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed, bool
fprintf(outp, "[%d:%d]:", i, len);
for (j = 0; j < len; j++)
{
+ int index;
index = FRAGMENT_SOUND(ed, j);
if (index == EDIT_LIST_END_MARK)
- fprintf(outp, "\n (at " MUS_LD ", end_mark)", FRAGMENT_GLOBAL_POSITION(ed, j));
+ fprintf(outp, "\n (at %lld, end_mark)", FRAGMENT_GLOBAL_POSITION(ed, j));
else
{
- int k, typ;
+ int typ;
typ = FRAGMENT_TYPE(ed, j);
- fprintf(outp, "\n (at " MUS_LD ", cp->sounds[%d][" MUS_LD ":" MUS_LD ", %.3f",
+ fprintf(outp, "\n (at %lld, cp->sounds[%d][%lld:%lld, %.3f",
FRAGMENT_GLOBAL_POSITION(ed, j),
index,
FRAGMENT_LOCAL_POSITION(ed, j),
@@ -2588,6 +1486,7 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed, bool
if (ramp_op(typ))
{
+ int k;
for (k = 0; k < FRAGMENT_RAMP_LIST_SIZE(ed, j); k++) /* step envs become successive scalings */
fprintf(outp, ", [%d]%.3f -> %.3f", k + 1,
FRAGMENT_RAMP_START(ed, j, k),
@@ -2606,32 +1505,6 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed, bool
}
}
- if (ptree_op(typ))
- {
- XEN code;
- for (k = FRAGMENT_PTREE_LIST_SIZE(ed, j) - 1; k >= 1; k--)
- fprintf(outp, ", loc%d: %d, pos%d: " MUS_LD ", scl%d: %.3f",
- k + 1, FRAGMENT_PTREE_INDEX(ed, j, k),
- k + 1, FRAGMENT_PTREE_POSITION(ed, j, k),
- k + 1, FRAGMENT_PTREE_SCALER(ed, j, k));
- fprintf(outp, ", loc: %d, pos: " MUS_LD ", scl: %.3f",
- FRAGMENT_PTREE_INDEX(ed, j, k),
- FRAGMENT_PTREE_POSITION(ed, j, k),
- FRAGMENT_PTREE_SCALER(ed, j, k));
-
- if (with_source)
- {
- char *temp1 = NULL, *temp2 = NULL;
- code = mus_run_ptree_code(cp->ptrees[FRAGMENT_PTREE_INDEX(ed, j, 0)]);
- if (XEN_LIST_P(code))
- fprintf(outp, ", code: %s", temp1 = (char *)XEN_AS_STRING(code));
- code = cp->ptree_inits[FRAGMENT_PTREE_INDEX(ed, j, 0)];
- if (XEN_PROCEDURE_P(code))
- fprintf(outp, ", init: %s", temp2 = (char *)XEN_AS_STRING(XEN_PROCEDURE_SOURCE(code))); /* ptree_code = car */
- if (temp1) free(temp1);
- if (temp2) free(temp2);
- }
- }
if (is_mix_op(typ))
{
ed_mixes *mxs;
@@ -2644,7 +1517,7 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed, bool
for (i = 0; i < mxs->size; i++)
{
if (MIX_LIST_STATE(mxs, i))
- fprintf(outp, ", ([%d]: %d %.3f " MUS_LD ")",
+ fprintf(outp, ", ([%d]: %d %.3f %lld)",
i,
MIX_LIST_INDEX(mxs, i),
MIX_LIST_SCALER(mxs, i),
@@ -2663,7 +1536,7 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed, bool
fprintf(outp, " [file: %s[%d]]", sd->filename, sd->chan);
else
if (sd->type == SND_DATA_BUFFER)
- fprintf(outp, " [buf: " MUS_LD "] ", sd->data_bytes / sizeof(mus_sample_t));
+ fprintf(outp, " [buf: %lld] ", sd->data_bytes / sizeof(mus_float_t));
else fprintf(outp, " [bogus!]");
}
}
@@ -2694,14 +1567,14 @@ char *edit_to_string(chan_info *cp, int edit)
/* only for edit list in snd-g|xchn.c */
#if HAVE_FORTH
- return(mus_format("%s : " MUS_LD " " MUS_LD " %s",
+ return(mus_format("%s : %lld %lld %s",
ed->origin,
ed->beg, ed->len,
edit_names[(int)(ed->edit_type)]));
#endif
#if HAVE_RUBY
- return(mus_format("%s : %s(" MUS_LD ", " MUS_LD ")",
+ return(mus_format("%s : %s(%lld, %lld)",
ed->origin,
edit_names[(int)(ed->edit_type)],
ed->beg, ed->len));
@@ -2709,7 +1582,7 @@ char *edit_to_string(chan_info *cp, int edit)
#endif
#if HAVE_SCHEME
- return(mus_format("%s : (%s " MUS_LD " " MUS_LD ")",
+ return(mus_format("%s : (%s %lld %lld)",
ed->origin,
edit_names[(int)(ed->edit_type)],
ed->beg, ed->len));
@@ -2719,12 +1592,12 @@ char *edit_to_string(chan_info *cp, int edit)
}
-static void display_edits(chan_info *cp, FILE *outp, bool with_source)
+static void display_edits(chan_info *cp, FILE *outp)
{
int i;
fprintf(outp, "\nEDITS: %d\n", cp->edit_ctr);
for (i = 0; i <= cp->edit_ctr; i++)
- display_ed_list(cp, outp, i, cp->edits[i], with_source);
+ display_ed_list(cp, outp, i, cp->edits[i]);
}
@@ -2734,9 +1607,9 @@ static io_error_t snd_make_file(const char *ofile, int chans, file_info *hdr, sn
int ofd;
int i, j, datumb;
bool reporting = false;
- mus_long_t len, total = 0;
+ mus_long_t len = 0, total = 0, alloc_len;
chan_info *cp = NULL;
- mus_sample_t **obufs;
+ mus_float_t **obufs;
io_error_t io_err = IO_NO_ERROR;
int sl_err = MUS_NO_ERROR;
bool need_clipping;
@@ -2744,6 +1617,9 @@ static io_error_t snd_make_file(const char *ofile, int chans, file_info *hdr, sn
ofd = open_temp_file(ofile, chans, hdr, &io_err);
if (ofd == -1)
return(io_err);
+ alloc_len = length;
+ if (alloc_len > REPORTING_SIZE)
+ alloc_len = REPORTING_SIZE;
need_clipping = clipping(ss);
if (need_clipping)
@@ -2780,79 +1656,111 @@ static io_error_t snd_make_file(const char *ofile, int chans, file_info *hdr, sn
mus_file_set_clipping(ofd, need_clipping); /* clipping is very expensive, so try to avoid it */
- datumb = mus_bytes_per_sample(hdr->format);
+ datumb = mus_bytes_per_sample(hdr->sample_type);
ss->stopped_explicitly = false;
- obufs = (mus_sample_t **)malloc(chans * sizeof(mus_sample_t *));
+ obufs = (mus_float_t **)malloc(chans * sizeof(mus_float_t *));
for (i = 0; i < chans; i++)
- obufs[i] = (mus_sample_t *)calloc(FILE_BUFFER_SIZE, sizeof(mus_sample_t));
+ obufs[i] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
j = 0;
- reporting = ((report_ok) && (length > REPORTING_SIZE));
+ reporting = ((report_ok) && (length > alloc_len));
if (reporting)
{
cp = sfs[0]->cp;
start_progress_report(cp);
}
+
if (chans == 1)
{
- if (length > FILE_BUFFER_SIZE)
+ mus_float_t *buf;
+ snd_fd *sf;
+ buf = obufs[0];
+ sf = sfs[0];
+ if (length > alloc_len)
{
- for (len = 0; len < length; len++)
+ sampler_set_safe(sf, length);
+ for (len = 0; len < length; )
{
- obufs[0][j] = read_sample_to_mus_sample(sfs[0]);
- j++;
- if (j == FILE_BUFFER_SIZE)
+ int k, kdur;
+
+ kdur = length - len;
+ if (kdur > alloc_len) kdur = alloc_len;
+
+ for (k = 0; k < kdur; k++)
+ buf[k] = read_sample(sf);
+
+ sl_err = mus_file_write(ofd, 0, kdur - 1, 1, obufs);
+ j = 0;
+ if (sl_err != MUS_NO_ERROR) break;
+ if (reporting)
{
- sl_err = mus_file_write(ofd, 0, j - 1, 1, obufs);
- j = 0;
- if (sl_err == -1) break;
- if (reporting)
- {
- total += FILE_BUFFER_SIZE;
- progress_report(cp, (mus_float_t)((double)total / (double)length));
- }
- /* this is a dangerous time to check for an event -- if in lock_affected_mixes,
- * the current edit is in progress, so any attempt to display will segfault.
- * is this still the case? I think in s7 it is ok.
- */
+ total += kdur;
+ progress_report(cp, (mus_float_t)((double)total / (double)length));
}
+ len += kdur;
}
}
else
{
- for (len = 0; len < length; len++)
- obufs[0][len] = read_sample_to_mus_sample(sfs[0]);
+ samples_to_vct_with_reader(length, buf, sf);
+ len = length;
j = (int)length;
}
}
else
{
- for (len = 0; len < length; len++)
+ if (length > alloc_len)
{
+ mus_float_t *buf;
+ snd_fd *sf;
+
for (i = 0; i < chans; i++)
- obufs[i][j] = read_sample_to_mus_sample(sfs[i]);
- j++;
- if (j == FILE_BUFFER_SIZE)
+ sampler_set_safe(sfs[i], length);
+
+ for (len = 0; len < length;)
{
- sl_err = mus_file_write(ofd, 0, j - 1, chans, obufs);
+ int k, kdur;
+ kdur = length - len;
+ if (kdur > alloc_len) kdur = alloc_len;
+
+ for (i = 0; i < chans; i++)
+ {
+ buf = obufs[i];
+ sf = sfs[i];
+ for (k = 0; k < kdur; k++)
+ buf[k] = read_sample(sf);
+ }
+
+ sl_err = mus_file_write(ofd, 0, kdur - 1, chans, obufs);
j = 0;
- if (sl_err == -1) break;
+ if (sl_err != MUS_NO_ERROR) break;
if (reporting)
{
- total += FILE_BUFFER_SIZE;
+ total += kdur;
progress_report(cp, (mus_float_t)((double)total / (double)length));
}
+ len += kdur;
}
}
+ else
+ {
+ for (i = 0; i < chans; i++)
+ samples_to_vct_with_reader(length, obufs[i], sfs[i]);
+ len = length;
+ j = (int)length;
+ }
}
- if ((sl_err == MUS_NO_ERROR) && (j > 0))
+ if ((sl_err == MUS_NO_ERROR) &&
+ (j > 0))
sl_err = mus_file_write(ofd, 0, j - 1, chans, obufs);
if (sl_err == MUS_NO_ERROR)
{
io_err = close_temp_file(ofile, ofd, hdr->type, len * chans * datumb);
- if (!(ss->fam_ok))
+#if USE_MOTIF
+ if (!(ss->file_monitor_ok))
alert_new_file();
+#endif
}
else
{
@@ -2873,12 +1781,13 @@ static io_error_t channel_to_file_with_bounds(chan_info *cp, const char *ofile,
io_error_t err = IO_NO_ERROR;
sp = cp->sound;
sf = (snd_fd **)malloc(sizeof(snd_fd *));
- sf[0] = init_sample_read_any(beg, cp, READ_FORWARD, edpos);
+
+ sf[0] = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, edpos, len);
if (sf[0] == NULL)
{
free(sf);
snd_error("no such edit: %s[%d]: %d (this channel has %d edit%s",
- cp->sound->short_filename,
+ sp->short_filename,
cp->chan,
edpos,
cp->edit_ctr,
@@ -2892,7 +1801,7 @@ static io_error_t channel_to_file_with_bounds(chan_info *cp, const char *ofile,
if ((err != IO_NO_ERROR) &&
(err != IO_INTERRUPTED))
snd_error("can't save %s chan %d: %s %s",
- cp->sound->short_filename,
+ sp->short_filename,
cp->chan,
ofile,
snd_io_strerror());
@@ -2907,7 +1816,8 @@ static io_error_t channel_to_file(chan_info *cp, const char *ofile, int edpos) /
}
-io_error_t channel_to_file_with_settings(chan_info *cp, const char *new_name, int type, int format, int srate, const char *comment, int pos)
+io_error_t channel_to_file_with_settings(chan_info *cp, const char *new_name, int srate,
+ mus_sample_t samp_type, mus_header_t hd_type, const char *comment, int pos)
{
file_info *hdr, *ohdr;
snd_info *sp;
@@ -2915,9 +1825,9 @@ io_error_t channel_to_file_with_settings(chan_info *cp, const char *new_name, in
sp = cp->sound;
ohdr = sp->hdr;
hdr = copy_header(new_name, ohdr);
- hdr->format = format;
+ hdr->sample_type = samp_type;
hdr->srate = srate;
- hdr->type = type;
+ hdr->type = hd_type;
if (comment)
hdr->comment = mus_strdup(comment);
else hdr->comment = NULL;
@@ -3022,7 +1932,6 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
/* write edit list as a scheme|ruby|forth program to fd (open for writing) for subsequent load */
/* the entire current list is written, then the edit_ctr is fixed up to reflect its current state */
int i, edits;
- ed_list *ed;
#if HAVE_FORTH
char *forth_func = NULL;
bool mix_ed = false;
@@ -3034,6 +1943,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
/* 0 case = open-sound */
for (i = 1; i <= edits; i++)
{
+ ed_list *ed;
ed = cp->edits[i];
if (ed)
{
@@ -3044,11 +1954,12 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
* The backed_up flag is set in the backed-up entry, and for save/restore, we
* override the entire current sound with a saved file.
*/
- char *nfile = NULL, *ofile = NULL;
+ char *nfile = NULL;
mus_long_t len;
io_error_t io_err;
if (with_save_state_hook)
{
+ char *ofile;
ofile = shorter_tempnam(save_dir(ss), "snd_");
nfile = run_save_state_hook(ofile);
free(ofile);
@@ -3064,29 +1975,29 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
return;
}
#if HAVE_RUBY
- fprintf(fd, " %s(\"%s\", " MUS_LD ", sfile, %d, ", TO_PROC_NAME(S_override_samples_with_origin), nfile, len, cp->chan);
+ fprintf(fd, " %s(\"%s\", %lld, sfile, %d, ", to_proc_name(S_override_samples_with_origin), nfile, len, cp->chan);
if (ed->origin)
fprintf_with_possible_embedded_string(fd, ed->origin);
else fprintf(fd, "\"\"");
- fprintf(fd, ", [%d, " MUS_LD "])\n",
+ fprintf(fd, ", [%d, %lld])\n",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
#if HAVE_SCHEME
- fprintf(fd, " (%s \"%s\" " MUS_LD " sfile %d ", S_override_samples_with_origin, nfile, len, cp->chan);
+ fprintf(fd, " (%s \"%s\" %lld sfile %d ", S_override_samples_with_origin, nfile, len, cp->chan);
if (ed->origin)
fprintf_with_possible_embedded_string(fd, ed->origin);
else fprintf(fd, "\"\"");
- fprintf(fd, " (list %d " MUS_LD "))\n",
+ fprintf(fd, " (list %d %lld))\n",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
#if HAVE_FORTH
- fprintf(fd, " \"%s\" " MUS_LD " sfile %d ", nfile, len, cp->chan);
+ fprintf(fd, " \"%s\" %lld sfile %d ", nfile, len, cp->chan);
if (ed->origin)
fprintf_with_possible_embedded_string(fd, ed->origin);
else fprintf(fd, "\"\"");
- fprintf(fd, " '( %d " MUS_LD " ) %s drop\n",
+ fprintf(fd, " '( %d %lld ) %s drop\n",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile),
S_override_samples_with_origin);
@@ -3108,7 +2019,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case INSERTION_EDIT:
/* samp data snd chn */
forth_func = S_insert_samples_with_origin;
- fprintf(fd, MUS_LD " " MUS_LD " ",
+ fprintf(fd, "%lld %lld ",
ed->beg,
ed->len);
if (ed->origin)
@@ -3121,7 +2032,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case DELETION_EDIT:
/* samp samps snd chn */
forth_func = S_delete_samples;
- fprintf(fd, MUS_LD " " MUS_LD " sfile %d",
+ fprintf(fd, "%lld %lld sfile %d",
ed->beg,
ed->len,
cp->chan);
@@ -3129,7 +2040,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case CHANGE_EDIT:
forth_func = S_change_samples_with_origin;
- fprintf(fd, MUS_LD " " MUS_LD " ",
+ fprintf(fd, "%lld %lld ",
ed->beg,
ed->len);
if (ed->origin)
@@ -3145,7 +2056,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case ZERO_EDIT:
forth_func = S_pad_channel;
- fprintf(fd, MUS_LD " " MUS_LD " sfile %d",
+ fprintf(fd, "%lld %lld sfile %d",
ed->beg,
ed->len,
cp->chan);
@@ -3164,29 +2075,6 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
}
break;
- case PTREE_EDIT:
- forth_func = S_ptree_channel;
- if ((ed->origin) &&
- (strcmp(ed->origin, S_ptree_channel) != 0))
- {
- char *func;
- if ((func = split_origin(ed->origin, &forth_func)))
- {
- fprintf(fd, "%s sfile %d", func, cp->chan);
- free(func);
- }
- else fprintf(fd, "sfile %d", cp->chan);
- }
- else
- {
- fprintf(fd, "%s " MUS_LD " " MUS_LD " sfile %d",
- XEN_AS_STRING(mus_run_ptree_code(cp->ptrees[ed->ptree_location])),
- ed->beg,
- ed->len,
- cp->chan);
- }
- break;
-
case MIX_EDIT:
case CHANGE_MIX_EDIT:
mix_ed = true;
@@ -3208,8 +2096,8 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
{
case INSERTION_EDIT:
/* samp data snd chn */
- fprintf(fd, "%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD PROC_SEP,
- TO_PROC_NAME(S_insert_samples_with_origin),
+ fprintf(fd, "%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP,
+ to_proc_name(S_insert_samples_with_origin),
ed->beg,
ed->len);
if (ed->origin)
@@ -3222,16 +2110,16 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case DELETION_EDIT:
/* samp samps snd chn */
- fprintf(fd, "%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD PROC_SEP "sfile" PROC_SEP "%d",
- TO_PROC_NAME(S_delete_samples),
+ fprintf(fd, "%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP "sfile" PROC_SEP "%d",
+ to_proc_name(S_delete_samples),
ed->beg,
ed->len,
cp->chan);
break;
case CHANGE_EDIT:
- fprintf(fd, "%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD PROC_SEP,
- TO_PROC_NAME(S_change_samples_with_origin),
+ fprintf(fd, "%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP,
+ to_proc_name(S_change_samples_with_origin),
ed->beg,
ed->len);
if (ed->origin)
@@ -3253,8 +2141,8 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
break;
case ZERO_EDIT:
- fprintf(fd, "%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD PROC_SEP "sfile" PROC_SEP "%d",
- TO_PROC_NAME(S_pad_channel),
+ fprintf(fd, "%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP "sfile" PROC_SEP "%d",
+ to_proc_name(S_pad_channel),
ed->beg,
ed->len,
cp->chan);
@@ -3266,28 +2154,12 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
cp->chan);
break;
- case PTREE_EDIT:
- {
- char *temp = NULL;
- if ((ed->origin) &&
- (strcmp(ed->origin, S_ptree_channel) != 0))
- fprintf(fd, "%s" PROC_SEP "sfile" PROC_SEP "%d",
- ed->origin,
- cp->chan);
- else fprintf(fd, "%s" PROC_OPEN "%s" PROC_SEP MUS_LD PROC_SEP MUS_LD PROC_SEP "sfile" PROC_SEP "%d",
- TO_PROC_NAME(S_ptree_channel),
- temp = (char *)XEN_AS_STRING(mus_run_ptree_code(cp->ptrees[ed->ptree_location])),
- ed->beg,
- ed->len,
- cp->chan);
-#if HAVE_EXTENSION_LANGUAGE
- if (temp) free(temp);
-#endif
- }
- break;
-
case MIX_EDIT:
- fprintf(fd, "%s" PROC_SEP "sfile" PROC_SEP "%d", ed->origin, cp->chan);
+#if HAVE_SCHEME
+ fprintf(fd, "(lambda (snd chn ignore) %s) sfile %d", ed->origin, cp->chan);
+#else
+ fprintf(fd, "func = lambda do |snd, chn, ignore|\n %s\n end\n func(sfile, %d", ed->origin, cp->chan);
+#endif
break;
case CHANGE_MIX_EDIT:
@@ -3318,34 +2190,20 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
fprintf(fd, " #f");
}
#endif
-#if HAVE_SCHEME
- if (ed->edit_type == PTREE_EDIT)
- {
- XEN code;
- fprintf(fd, " %s", (ed->ptree_env_too) ? "#t" : "#f");
- code = cp->ptree_inits[ed->ptree_location];
- if (XEN_PROCEDURE_P(code))
- {
- char *temp = NULL;
- fprintf(fd, " %s", temp = XEN_AS_STRING(XEN_CAR(XEN_PROCEDURE_SOURCE(code))));
- if (temp) free(temp);
- }
- }
-#endif
if (nfile)
{
#if HAVE_SCHEME
- fprintf(fd, " (list %d " MUS_LD ")",
+ fprintf(fd, " (list %d %lld)",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
#if HAVE_RUBY
- fprintf(fd, ", [%d, " MUS_LD "]",
+ fprintf(fd, ", [%d, %lld]",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
#if HAVE_FORTH
- fprintf(fd, " '( %d " MUS_LD " )",
+ fprintf(fd, " '( %d %lld )",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
@@ -3387,7 +2245,6 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
char *function = NULL, *old_function = NULL;
bool close_mix_let = false;
int i, edits;
- ed_list *ed;
edits = cp->edit_ctr;
while ((edits < (cp->edit_size - 1)) &&
@@ -3418,6 +2275,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
for (i = start_pos; i <= edits; i++)
{
+ ed_list *ed;
ed = cp->edits[i];
if (ed)
{
@@ -3425,7 +2283,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
function = NULL;
/* most of these depend on the caller to supply a usable re-call string (origin). */
- /* In insert/change/ptree/xen cases, there's basically no choice */
+ /* In insert/change cases, there's basically no choice */
if (ed->backed_up)
{
if ((ed->origin) &&
@@ -3451,7 +2309,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
/* save data in temp file, use insert-samples with file name */
char *ofile;
ofile = edit_list_data_to_temp_file(cp, ed, DELETE_ME, false);
- function = mus_format("%s\n (%s " MUS_LD " " MUS_LD " \"%s\" snd chn)", old_function, S_insert_samples, ed->beg, ed->len, ofile);
+ function = mus_format("%s\n (%s %lld %lld \"%s\" snd chn)", old_function, S_insert_samples, ed->beg, ed->len, ofile);
free(ofile);
}
else function = mus_format("%s\n (%s snd chn)", old_function, ed->origin);
@@ -3464,7 +2322,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
/* save data in temp file, use set-samples with file name */
char *ofile;
ofile = edit_list_data_to_temp_file(cp, ed, DELETE_ME, false);
- function = mus_format("%s\n (set-samples " MUS_LD " " MUS_LD " \"%s\" snd chn)", old_function, ed->beg, ed->len, ofile);
+ function = mus_format("%s\n (set-samples %lld %lld \"%s\" snd chn)", old_function, ed->beg, ed->len, ofile);
free(ofile);
}
else
@@ -3476,7 +2334,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
break;
case DELETION_EDIT:
- function = mus_format("%s\n (%s " MUS_LD " " MUS_LD " snd chn)", old_function, S_delete_samples, ed->beg, ed->len);
+ function = mus_format("%s\n (%s %lld %lld snd chn)", old_function, S_delete_samples, ed->beg, ed->len);
break;
case SCALED_EDIT:
@@ -3487,32 +2345,13 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
/* mix drag case */
break;
- case PTREE_EDIT:
- if ((ed->origin) &&
- (strcmp(ed->origin, S_ptree_channel) != 0))
- function = mus_format("%s\n (%s snd chn)", old_function, ed->origin);
- else
- {
- char *durstr, *temp = NULL;
- if (ed->len == cp->edits[i]->samples)
- durstr = mus_strdup("#f");
- else durstr = mus_format(MUS_LD, ed->len);
- function = mus_format("%s\n (%s %s " MUS_LD " %s snd chn)",
- old_function, S_ptree_channel,
- temp = XEN_AS_STRING(mus_run_ptree_code(cp->ptrees[ed->ptree_location])),
- ed->beg, durstr);
- free(durstr);
- if (temp) free(temp);
- }
- break;
-
case RAMP_EDIT:
function = mus_format("%s\n (%s snd chn)", old_function, ed->origin);
break;
case ZERO_EDIT:
/* origin here is useless (see extend_with_zeros cases) */
- function = mus_format("%s\n (%s " MUS_LD " " MUS_LD " snd chn)", old_function, S_pad_channel, ed->beg, ed->len);
+ function = mus_format("%s\n (%s %lld %lld snd chn)", old_function, S_pad_channel, ed->beg, ed->len);
break;
case MIX_EDIT:
@@ -3543,7 +2382,6 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
char *function = NULL, *old_function = NULL;
bool close_mix_let = false, first = true;
int i, edits;
- ed_list *ed;
edits = cp->edit_ctr;
while ((edits < (cp->edit_size - 1)) &&
(cp->edits[edits + 1]))
@@ -3566,12 +2404,13 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
else function = mus_strdup("Proc.new {|snd, chn| ");
for (i = start_pos; i <= edits; i++)
{
+ ed_list *ed;
ed = cp->edits[i];
if (ed)
{
old_function = function;
/* most of these depend on the caller to supply a usable re-call string (origin). */
- /* In insert/change/ptree/xen cases, there's basically no choice */
+ /* In insert/change/ cases, there's basically no choice */
if (ed->backed_up)
{
if ((ed->origin) &&
@@ -3589,14 +2428,14 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
{
case INSERTION_EDIT:
if ((!(ed->origin)) ||
- (strcmp(ed->origin, TO_PROC_NAME(S_insert_samples)) == 0))
+ (strcmp(ed->origin, to_proc_name(S_insert_samples)) == 0))
{
/* from HAVE_SCHEME above */
/* save data in temp file, use insert-samples with file name */
char *ofile;
ofile = edit_list_data_to_temp_file(cp, ed, DELETE_ME, false);
- function = mus_format("%s %s(" MUS_LD ", " MUS_LD ", \"%s\", snd, chn)",
- function, TO_PROC_NAME(S_insert_samples), ed->beg, ed->len, ofile);
+ function = mus_format("%s %s(%lld, %lld, \"%s\", snd, chn)",
+ function, to_proc_name(S_insert_samples), ed->beg, ed->len, ofile);
free(ofile);
}
else function = mus_format("%s%s %s, snd, chn)", function, (first) ? "" : ";", ed->origin);
@@ -3610,7 +2449,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
/* save data in temp file, use set-samples with file name */
char *ofile;
ofile = edit_list_data_to_temp_file(cp, ed, DELETE_ME, false);
- function = mus_format("%s set_samples(" MUS_LD ", " MUS_LD ", \"%s\", snd, chn)",
+ function = mus_format("%s set_samples(%lld, %lld, \"%s\", snd, chn)",
function, ed->beg, ed->len, ofile);
free(ofile);
}
@@ -3625,8 +2464,8 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
break;
case DELETION_EDIT:
- function = mus_format("%s%s %s(" MUS_LD ", " MUS_LD ", snd, chn)",
- function, (first) ? "" : ";", TO_PROC_NAME(S_delete_samples), ed->beg, ed->len);
+ function = mus_format("%s%s %s(%lld, %lld, snd, chn)",
+ function, (first) ? "" : ";", to_proc_name(S_delete_samples), ed->beg, ed->len);
break;
case SCALED_EDIT:
@@ -3643,8 +2482,8 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
case ZERO_EDIT:
/* origin here is useless (see extend_with_zeros cases) */
- function = mus_format("%s%s %s(" MUS_LD ", " MUS_LD ", snd, chn)",
- function, (first) ? "" : ";", TO_PROC_NAME(S_pad_channel), ed->beg, ed->len);
+ function = mus_format("%s%s %s(%lld, %lld, snd, chn)",
+ function, (first) ? "" : ";", to_proc_name(S_pad_channel), ed->beg, ed->len);
break;
case MIX_EDIT:
@@ -3672,9 +2511,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
#if HAVE_FORTH
char *function = NULL, *old_function = NULL;
- bool close_mix_let = false, first = true;
int i, edits;
- ed_list *ed;
edits = cp->edit_ctr;
while ((edits < (cp->edit_size - 1)) &&
(cp->edits[edits + 1]))
@@ -3688,7 +2525,6 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
mix_list = edit_list_mix_init(cp);
if (mix_list)
{
- close_mix_let = true;
function = mus_format("lambda: <{ snd chn -- val }> %s", mix_list);
free(mix_list);
}
@@ -3697,12 +2533,13 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
else function = mus_strdup("lambda: <{ snd chn -- val }>");
for (i = start_pos; i <= edits; i++)
{
+ ed_list *ed;
ed = cp->edits[i];
if (ed)
{
old_function = function;
/* most of these depend on the caller to supply a usable re-call string (origin). */
- /* In insert/change/ptree/xen cases, there's basically no choice */
+ /* In insert/change cases, there's basically no choice */
if (ed->backed_up)
{
char *name, *func;
@@ -3741,7 +2578,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
}
break;
case DELETION_EDIT:
- function = mus_format("%s " MUS_LD " " MUS_LD " snd chn %s drop",
+ function = mus_format("%s %lld %lld snd chn %s drop",
function, ed->beg, ed->len, S_delete_samples);
break;
case INSERTION_EDIT:
@@ -3763,7 +2600,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
case ZERO_EDIT:
/* origin here is unpredictable -- most of these extensions should be backed-over and invisible */
/* the one case that should survive (pad-channel) just passes its name as the origin */
- function = mus_format("%s " MUS_LD " " MUS_LD " snd chn %s drop",
+ function = mus_format("%s %lld %lld snd chn %s drop",
function, ed->beg, ed->len, S_pad_channel);
break;
@@ -3780,52 +2617,31 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
}
if (old_function) {free(old_function); old_function = NULL;}
}
- first = false;
}
old_function = function;
function = mus_format("%s ;", function);
free(old_function);
return(function);
#endif
-}
-
-static int ensure_ed_ptrees(ed_fragment *ed, int size)
-{
- if (ED_PTREES(ed))
- {
- if (ED_PTREE_LIST_SIZE(ed) < size)
- {
- ED_PTREE_LIST_SIZE(ed) = size;
- ED_PTREE_LIST(ed) = (ptree_state *)realloc(ED_PTREE_LIST(ed), size * sizeof(ptree_state));
- }
- }
- else
- {
- ED_PTREES(ed) = (ed_ptrees *)calloc(1, sizeof(ed_ptrees));
- ED_PTREE_LIST_SIZE(ed) = size;
- ED_PTREE_LIST(ed) = (ptree_state *)calloc(size, sizeof(ptree_state));
- }
- return(size);
+#if (!HAVE_EXTENSION_LANGUAGE)
+ return(NULL);
+#endif
}
-static ed_ptrees *copy_fragment_ptrees(ed_ptrees *old_ptrees)
-{
- ed_ptrees *np;
- np = (ed_ptrees *)calloc(1, sizeof(ed_ptrees));
- np->size = old_ptrees->size;
- np->psplit = old_ptrees->psplit;
- np->rsplit = old_ptrees->rsplit;
- np->xsplit = old_ptrees->xsplit;
- np->ptree_list = (ptree_state *)malloc(np->size * sizeof(ptree_state));
- memcpy((void *)(np->ptree_list), (void *)(old_ptrees->ptree_list), np->size * sizeof(ptree_state));
- return(np);
-}
-
+static ed_fragment *fragment_free_list = NULL;
static ed_fragment *make_ed_fragment(void)
{
+ if (fragment_free_list)
+ {
+ ed_fragment *e;
+ e = fragment_free_list;
+ fragment_free_list = (ed_fragment *)(fragment_free_list->next);
+ memset((void *)e, 0, sizeof(ed_fragment));
+ return(e);
+ }
return((ed_fragment *)calloc(1, sizeof(ed_fragment)));
}
@@ -3845,19 +2661,21 @@ static ed_mixes *copy_fragment_mixes(ed_mixes *old_mixes)
static ed_ramps *copy_fragment_ramps(ed_ramps *old_ramps)
{
ed_ramps *new_ramps;
- new_ramps = (ed_ramps *)calloc(1, sizeof(ed_ramps));
+ new_ramps = (ed_ramps *)malloc(sizeof(ed_ramps));
new_ramps->ramps = old_ramps->ramps;
new_ramps->xramps = old_ramps->xramps;
if (new_ramps->ramps > 0)
{
- new_ramps->ramp_list = (ramp_state *)calloc(new_ramps->ramps, sizeof(ramp_state));
+ new_ramps->ramp_list = (ramp_state *)malloc(new_ramps->ramps * sizeof(ramp_state));
memcpy((void *)(new_ramps->ramp_list), (void *)(old_ramps->ramp_list), new_ramps->ramps * sizeof(ramp_state));
}
+ else new_ramps->ramp_list = NULL;
if (new_ramps->xramps > 0)
{
- new_ramps->xramp_list = (xramp_state *)calloc(new_ramps->xramps, sizeof(xramp_state));
+ new_ramps->xramp_list = (xramp_state *)malloc(new_ramps->xramps * sizeof(xramp_state));
memcpy((void *)(new_ramps->xramp_list), (void *)(old_ramps->xramp_list), new_ramps->xramps * sizeof(xramp_state));
}
+ else new_ramps->xramp_list = NULL;
return(new_ramps);
}
@@ -3874,9 +2692,6 @@ static void copy_ed_fragment(ed_fragment *new_ed, ed_fragment *old_ed)
if (ED_RAMPS(old_ed))
ED_RAMPS(new_ed) = copy_fragment_ramps(ED_RAMPS(old_ed));
- if (ED_PTREES(old_ed))
- ED_PTREES(new_ed) = copy_fragment_ptrees(ED_PTREES(old_ed));
-
if (ED_MIXES(old_ed))
ED_MIXES(new_ed) = copy_fragment_mixes(ED_MIXES(old_ed));
}
@@ -3893,13 +2708,6 @@ static void copy_checked_ed_fragment(ed_fragment *new_ed, ed_fragment *old_ed)
free(ED_RAMPS(new_ed));
}
- if ((ED_PTREES(old_ed)) &&
- (ED_PTREES(new_ed)))
- {
- if (ED_PTREE_LIST(new_ed)) free(ED_PTREE_LIST(new_ed));
- free(ED_PTREES(new_ed));
- }
-
if ((ED_MIXES(old_ed)) &&
(ED_MIXES(new_ed)))
{
@@ -3923,13 +2731,6 @@ static void clear_ed_fragment(ed_fragment *ed)
ED_RAMPS(ed) = NULL;
}
- if (ED_PTREES(ed))
- {
- if (ED_PTREE_LIST(ed)) free(ED_PTREE_LIST(ed));
- free(ED_PTREES(ed));
- ED_PTREES(ed) = NULL;
- }
-
if (ED_MIXES(ed))
{
if (ED_MIX_LIST(ed)) free(ED_MIX_LIST(ed));
@@ -3944,7 +2745,8 @@ static ed_fragment *free_ed_fragment(ed_fragment *ed)
if (ed)
{
clear_ed_fragment(ed);
- free(ed);
+ ed->next = (struct ed_fragment *)fragment_free_list;
+ fragment_free_list = ed;
}
return(NULL);
}
@@ -3968,7 +2770,7 @@ static ed_list *make_ed_list(int size)
ed->selection_maxamp = -1.0;
ed->selection_maxamp_position = -1;
ed->properties_gc_loc = NOT_A_GC_LOC;
- ed->properties = XEN_FALSE;
+ ed->properties = Xen_false;
return(ed);
}
@@ -4058,22 +2860,6 @@ static ed_list *free_ed_list(ed_list *ed, chan_info *cp)
free(ed->origin);
ed->origin = NULL;
}
- if (ed->edit_type == PTREE_EDIT)
- {
- int loc;
- loc = ed->ptree_location;
- if (cp->ptrees[loc])
- {
- mus_run_free_ptree(cp->ptrees[loc]);
- cp->ptrees[loc] = NULL;
- }
- if (XEN_PROCEDURE_P(cp->ptree_inits[loc]))
- {
- snd_unprotect_at(cp->init_locs[loc]);
- cp->init_locs[loc] = -1;
- cp->ptree_inits[loc] = XEN_FALSE;
- }
- }
if (ed->marks)
free_mark_list(ed);
if (ed->peak_env)
@@ -4101,7 +2887,7 @@ static ed_list *free_ed_list(ed_list *ed, chan_info *cp)
{
snd_unprotect_at(ed->properties_gc_loc);
ed->properties_gc_loc = NOT_A_GC_LOC;
- ed->properties = XEN_FALSE;
+ ed->properties = Xen_false;
}
if (ED_MIXES(ed))
{
@@ -4114,11 +2900,13 @@ static ed_list *free_ed_list(ed_list *ed, chan_info *cp)
}
-void backup_edit_list(chan_info *cp)
+static void backup_edit_list_1(chan_info *cp, bool freeing)
{
int cur, i;
ed_list *old_ed, *new_ed;
mus_long_t old_end, new_end;
+ ed_fragment *top = NULL;
+
cur = cp->edit_ctr;
if (cur <= 0) return;
new_ed = cp->edits[cur];
@@ -4132,13 +2920,20 @@ void backup_edit_list(chan_info *cp)
if (old_ed->beg < new_ed->beg) new_ed->beg = old_ed->beg;
new_ed->len = new_end - new_ed->beg + 1;
- /* make sure backup_edit_list (as-one-edit) doesn't clobber our ptrees */
- /* this puts off gc of un-needed ptrees until close time -- a bit wasteful. */
- /* it might be enough to save the second tree loc in ptree2 cases, and include it in the block above */
- if (old_ed->edit_type == PTREE_EDIT)
- old_ed->edit_type = INITIALIZE_EDIT; /* was ED_SIMPLE which is obviously confused -- anything but PTREE_EDIT should be ok */
-
+ if (freeing)
+ top = fragment_free_list;
old_ed = free_ed_list(old_ed, cp);
+ if (freeing)
+ {
+ while ((fragment_free_list) && (fragment_free_list != top))
+ {
+ ed_fragment *e;
+ e = fragment_free_list;
+ fragment_free_list = e->next;
+ free(e);
+ }
+ }
+
cp->edits[cur - 1] = new_ed;
cp->edits[cur] = NULL;
if (cp->sounds) /* protect from release_pending_sounds upon edit after undo after as-one-edit or whatever */
@@ -4153,13 +2948,18 @@ void backup_edit_list(chan_info *cp)
}
+void backup_edit_list(chan_info *cp)
+{
+ backup_edit_list_1(cp, false);
+}
+
void free_edit_list(chan_info *cp)
{
if (cp)
{
- int i;
if (cp->edits)
{
+ int i;
for (i = 0; i < cp->edit_size; i++)
if (cp->edits[i])
cp->edits[i] = free_ed_list(cp->edits[i], cp);
@@ -4206,9 +3006,9 @@ ed_list *initial_ed_list(mus_long_t beg, mus_long_t end)
snd_info *sound_is_silence(snd_info *sp)
{
- int i;
if (sp)
{
+ int i;
for (i = 0; i < sp->nchans; i++)
{
chan_info *cp;
@@ -4317,13 +3117,6 @@ static void new_after_ramp(ed_fragment *new_after, ed_fragment *old_after, mus_l
ED_XRAMP_START(new_after, i) = ED_XRAMP_START(old_after, i) * exp(log(ED_XRAMP_INCR(old_after, i)) * d_dur);
}
}
- if ((ED_PTREES(new_after)) && (ED_PTREES(old_after)))
- {
- int i, trees;
- trees = ensure_ed_ptrees(new_after, ED_PTREE_LIST_SIZE(old_after));
- for (i = 0; i < trees; i++)
- ED_PTREE_POSITION(new_after, i) = ED_PTREE_POSITION(old_after, i) + dur;
- }
}
@@ -4352,7 +3145,7 @@ static bool lock_affected_mixes(chan_info *cp, int edpos, mus_long_t beg, mus_lo
ed_list *ed;
int i;
bool changed = false;
- mus_long_t change_beg = -1, change_end = -1, possible_beg = -1, fragment_beg, fragment_end;
+ mus_long_t change_beg = -1, change_end = -1, possible_beg = -1, fragment_end;
ed = cp->edits[edpos];
@@ -4361,6 +3154,7 @@ static bool lock_affected_mixes(chan_info *cp, int edpos, mus_long_t beg, mus_lo
*/
for (i = 0; i < ed->size; i++)
{
+ mus_long_t fragment_beg;
fragment_beg = FRAGMENT_GLOBAL_POSITION(ed, i);
if (is_mix_op(FRAGMENT_TYPE(ed, i)))
{
@@ -4404,7 +3198,7 @@ static bool lock_affected_mixes(chan_info *cp, int edpos, mus_long_t beg, mus_lo
{
int fd;
ed_list *new_ed;
- ed_fragment *cb;
+ ed_fragment *cb = NULL;
bool full_file;
full_file = ((change_beg == 0) &&
@@ -4413,7 +3207,7 @@ static bool lock_affected_mixes(chan_info *cp, int edpos, mus_long_t beg, mus_lo
fd = snd_open_read(temp_file_name);
snd_file_open_descriptors(fd,
temp_file_name,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
@@ -4451,13 +3245,14 @@ static bool lock_affected_mixes(chan_info *cp, int edpos, mus_long_t beg, mus_lo
static ed_list *insert_section_into_list(mus_long_t samp, mus_long_t num, ed_list *current_state, ed_fragment **rtn, const char *origin, mus_float_t scaler)
{
int cur_len, cur_i, new_i;
- ed_fragment *cur_f, *new_f, *inserted_f = NULL;
+ ed_fragment *new_f, *inserted_f = NULL;
ed_list *new_state;
if (num <= 0) return(NULL);
cur_len = current_state->size;
- new_state = make_ed_list(cur_len + 2); /* leave room for possible split */
+ new_state = make_ed_list(cur_len + 3); /* leave room for possible split */
for (cur_i = 0, new_i = 0; cur_i < cur_len; cur_i++, new_i++)
{
+ ed_fragment *cur_f;
cur_f = FRAGMENT(current_state, cur_i);
new_f = FRAGMENT(new_state, new_i);
if (ED_GLOBAL_POSITION(cur_f) > samp)
@@ -4502,8 +3297,8 @@ static ed_list *insert_section_into_list(mus_long_t samp, mus_long_t num, ed_lis
ED_LOCAL_POSITION(split_back_f) = ED_LOCAL_END(split_front_f) + 1;
ED_GLOBAL_POSITION(split_back_f) = samp + num; /* rippled */
- /* now fixup ramps/ptrees affected by the split */
- if (ramp_or_ptree_op(ED_TYPE(cur_f)))
+ /* now fixup ramps affected by the split */
+ if (ramp_op(ED_TYPE(cur_f)))
{
new_before_ramp(split_front_f, cur_f);
new_after_ramp(split_back_f, cur_f, samp);
@@ -4573,6 +3368,9 @@ static bool insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int edpo
ed->edit_type = ZERO_EDIT;
ed->sound_location = 0;
ed->maxamp = old_ed->maxamp;
+ ed->maxamp_position = old_ed->maxamp_position;
+ if (ed->maxamp_position >= beg)
+ ed->maxamp_position += num;
cp->edits[cp->edit_ctr] = ed;
peak_env_insert_zeros(cp, beg, num, edpos);
@@ -4661,16 +3459,17 @@ bool file_insert_samples(mus_long_t beg, mus_long_t num, const char *inserted_fi
mus_long_t len;
ed_fragment *cb;
file_info *hdr;
- ed_list *ed;
+ ed_list *ed, *old_ed;
int backup = 0;
- len = cp->edits[edpos]->samples;
+ old_ed = cp->edits[edpos];
+ len = old_ed->samples;
if (beg > len)
{
if (!(extend_with_zeros(cp, len, beg - len, edpos, origin)))
return(false);
edpos = cp->edit_ctr;
- len = CURRENT_SAMPLES(cp);
+ len = current_samples(cp);
backup++;
}
if (!(prepare_edit_list(cp, edpos, origin)))
@@ -4688,6 +3487,26 @@ bool file_insert_samples(mus_long_t beg, mus_long_t num, const char *inserted_fi
ed->edit_type = INSERTION_EDIT;
cp->edits[cp->edit_ctr] = ed;
+ if ((old_ed->maxamp_position != -1) &&
+ (mus_sound_channel_maxamp_exists(inserted_file, chan)))
+ {
+ mus_float_t mx;
+ mus_long_t pos;
+ mx = mus_sound_channel_maxamp(inserted_file, chan, &pos);
+ if (mx > old_ed->maxamp)
+ {
+ ed->maxamp = mx;
+ ed->maxamp_position = beg + pos;
+ }
+ else
+ {
+ ed->maxamp = old_ed->maxamp;
+ ed->maxamp_position = old_ed->maxamp_position;
+ if (ed->maxamp_position >= beg)
+ ed->maxamp_position += num;
+ }
+ }
+
hdr = make_file_info(inserted_file, FILE_READ_ONLY, FILE_NOT_SELECTED);
if (hdr)
{
@@ -4695,7 +3514,7 @@ bool file_insert_samples(mus_long_t beg, mus_long_t num, const char *inserted_fi
fd = snd_open_read(inserted_file);
snd_file_open_descriptors(fd,
inserted_file,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
@@ -4728,21 +3547,25 @@ bool file_insert_samples(mus_long_t beg, mus_long_t num, const char *inserted_fi
}
-bool insert_samples(mus_long_t beg, mus_long_t num, mus_sample_t *vals, chan_info *cp, const char *origin, int edpos)
+#define MAXAMP_CHECK_SIZE 10000
+/* making this larger was slower, smaller no difference? */
+
+bool insert_samples(mus_long_t beg, mus_long_t num, mus_float_t *vals, chan_info *cp, const char *origin, int edpos)
{
mus_long_t len;
ed_fragment *cb;
- ed_list *ed;
+ ed_list *ed, *old_ed;
int backup = 0;
if (num <= 0) return(true);
- len = cp->edits[edpos]->samples;
+ old_ed = cp->edits[edpos];
+ len = old_ed->samples;
if (beg > len)
{
if (!(extend_with_zeros(cp, len, beg - len, edpos, origin)))
return(false);
edpos = cp->edit_ctr;
- len = CURRENT_SAMPLES(cp);
+ len = current_samples(cp);
backup++;
}
@@ -4766,6 +3589,36 @@ bool insert_samples(mus_long_t beg, mus_long_t num, mus_sample_t *vals, chan_inf
ED_SOUND(cb) = cp->sound_ctr;
ed->sound_location = ED_SOUND(cb);
+ if ((old_ed->maxamp_position != -1) &&
+ (num < MAXAMP_CHECK_SIZE))
+ {
+ mus_float_t mx;
+ int i, pos = 0;
+ mx = fabs(vals[0]);
+ for (i = 1; i < num; i++)
+ {
+ mus_float_t temp;
+ temp = fabs(vals[i]);
+ if (temp > mx)
+ {
+ mx = temp;
+ pos = i;
+ }
+ }
+ if (mx > old_ed->maxamp)
+ {
+ ed->maxamp = mx;
+ ed->maxamp_position = beg + pos;
+ }
+ else
+ {
+ ed->maxamp = old_ed->maxamp;
+ ed->maxamp_position = old_ed->maxamp_position;
+ if (ed->maxamp_position >= beg)
+ ed->maxamp_position += num;
+ }
+ }
+
ripple_all(cp, beg, num);
ripple_selection(ed, beg, num);
reflect_sample_change_in_axis(cp);
@@ -4793,13 +3646,12 @@ bool insert_complete_file(snd_info *sp, const char *str, mus_long_t chan_beg, fi
if (nc > 0)
{
mus_long_t len;
- len = mus_sound_frames(filename);
+ len = mus_sound_framples(filename);
if (len == 0)
snd_warning("%s has no data", str);
else
{
int i, j, first_chan = 0;
- char *origin;
chan_info *ncp;
if (sp->sync != 0)
ncp = sp->chans[0];
@@ -4807,13 +3659,14 @@ bool insert_complete_file(snd_info *sp, const char *str, mus_long_t chan_beg, fi
first_chan = ncp->chan;
for (i = first_chan, j = 0; (j < nc) && (i < sp->nchans); i++, j++)
{
+ char *origin;
ncp = sp->chans[i];
#if HAVE_FORTH
- origin = mus_format("\"%s\" " MUS_LD " %d %s drop",
+ origin = mus_format("\"%s\" %lld %d %s drop",
filename, chan_beg, j, S_insert_sound);
#else
- origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP MUS_LD PROC_SEP "%d",
- TO_PROC_NAME(S_insert_sound), filename, chan_beg, j);
+ origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%lld" PROC_SEP "%d",
+ to_proc_name(S_insert_sound), filename, chan_beg, j);
#endif
ok = file_insert_samples(chan_beg, len, filename, ncp, j, auto_delete, origin, ncp->edit_ctr);
if (ok)
@@ -4832,7 +3685,7 @@ bool insert_complete_file_at_cursor(snd_info *sp, const char *filename)
{
chan_info *ncp;
ncp = any_selected_channel(sp);
- return(insert_complete_file(sp, filename, CURSOR(ncp), DONT_DELETE_ME));
+ return(insert_complete_file(sp, filename, cursor_sample(ncp), DONT_DELETE_ME));
}
@@ -4842,15 +3695,16 @@ bool insert_complete_file_at_cursor(snd_info *sp, const char *filename)
static ed_list *delete_section_from_list(mus_long_t beg, mus_long_t num, ed_list *current_state)
{
int cur_len, cur_i, new_i;
- ed_fragment *cur_f, *new_f;
+ ed_fragment *new_f;
mus_long_t end, next_pos;
ed_list *new_state;
if (num <= 0) return(NULL);
cur_len = current_state->size;
end = beg + num;
- new_state = make_ed_list(cur_len + 2); /* leave room for possible splits */
+ new_state = make_ed_list(cur_len + 3); /* leave room for possible splits */
for (cur_i = 0, new_i = 0; cur_i < cur_len; cur_i++)
{
+ ed_fragment *cur_f;
cur_f = FRAGMENT(current_state, cur_i);
new_f = FRAGMENT(new_state, new_i);
if (ED_GLOBAL_POSITION(cur_f) >= end)
@@ -4882,7 +3736,7 @@ static ed_list *delete_section_from_list(mus_long_t beg, mus_long_t num, ed_list
new_i++;
ED_LOCAL_END(split_front_f) = ED_LOCAL_POSITION(split_front_f) + beg - ED_GLOBAL_POSITION(split_front_f) - 1;
/* samp - global position = where in current fragment, offset that by its local offset, turn into end sample */
- if (ramp_or_ptree_op(ED_TYPE(cur_f)))
+ if (ramp_op(ED_TYPE(cur_f)))
new_before_ramp(split_front_f, cur_f);
}
next_pos = FRAGMENT_GLOBAL_POSITION(current_state, (cur_i + 1));
@@ -4895,7 +3749,7 @@ static ed_list *delete_section_from_list(mus_long_t beg, mus_long_t num, ed_list
new_i++;
ED_GLOBAL_POSITION(split_back_f) = beg;
ED_LOCAL_POSITION(split_back_f) += end - ED_GLOBAL_POSITION(cur_f);
- if (ramp_or_ptree_op(ED_TYPE(cur_f)))
+ if (ramp_op(ED_TYPE(cur_f)))
new_after_ramp(split_back_f, cur_f, end);
}
}
@@ -4905,17 +3759,17 @@ static ed_list *delete_section_from_list(mus_long_t beg, mus_long_t num, ed_list
new_state->beg = beg;
new_state->len = num;
#if HAVE_FORTH
- new_state->origin = mus_format(MUS_LD " " MUS_LD " %s drop", beg, num, S_delete_samples);
+ new_state->origin = mus_format("%lld %lld %s drop", beg, num, S_delete_samples);
#else
#if HAVE_RUBY
{
char *temp;
- temp = TO_PROC_NAME(S_delete_samples);
- new_state->origin = mus_format("%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD, temp, beg, num);
+ temp = to_proc_name(S_delete_samples);
+ new_state->origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld", temp, beg, num);
if (temp) free(temp);
}
#else
- new_state->origin = mus_format("%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(S_delete_samples), beg, num);
+ new_state->origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld", to_proc_name(S_delete_samples), beg, num);
#endif
#endif
new_state->edit_type = DELETION_EDIT;
@@ -4927,13 +3781,14 @@ static ed_list *delete_section_from_list(mus_long_t beg, mus_long_t num, ed_list
bool delete_samples(mus_long_t beg, mus_long_t num, chan_info *cp, int edpos)
{
mus_long_t len;
-
+
if (num <= 0) return(true);
len = cp->edits[edpos]->samples;
+
if ((beg < len) && (beg >= 0))
{
ed_list *ed;
- bool backup = false;
+ bool backup = false, read_max = false;
if ((beg + num) > len) num = len - beg;
if (!(prepare_edit_list(cp, edpos, S_delete_samples)))
@@ -4954,6 +3809,24 @@ bool delete_samples(mus_long_t beg, mus_long_t num, chan_info *cp, int edpos)
ed->selection_beg = old_state->selection_beg;
ed->selection_end = old_state->selection_end;
ed->cursor = old_state->cursor;
+
+ if (((old_state->maxamp_position >= 0) && (old_state->maxamp_position < beg)) ||
+ (old_state->maxamp_position > (beg + num)))
+ {
+ ed->maxamp = old_state->maxamp;
+ ed->maxamp_position = old_state->maxamp_position;
+ if (old_state->maxamp_position > (beg + num))
+ ed->maxamp_position -= num;
+ }
+ else
+ {
+ if ((beg == 0) && (num >= len))
+ {
+ ed->maxamp = 0.0;
+ ed->maxamp_position = 0;
+ }
+ else read_max = ((len - num) < MAXAMP_CHECK_SIZE);
+ }
}
ed->edpos = edpos;
ed->samples = len - num;
@@ -4968,13 +3841,38 @@ bool delete_samples(mus_long_t beg, mus_long_t num, chan_info *cp, int edpos)
if (ed->cursor < beg) ed->cursor = beg;
}
+ if (read_max)
+ {
+ mus_long_t new_len;
+ mus_float_t mx;
+ int i, loc = 0;
+ snd_fd *sf;
+ new_len = ed->samples;
+
+ sf = init_sample_read_any_with_bufsize(0, cp, READ_FORWARD, cp->edit_ctr, new_len + 1); /* read current samps */
+ sampler_set_safe(sf, new_len);
+ mx = fabs(read_sample(sf));
+ for (i = 1; i < new_len; i++)
+ {
+ mus_float_t temp;
+ temp = fabs(read_sample(sf));
+ if (temp > mx)
+ {
+ mx = temp;
+ loc = i;
+ }
+ }
+ free_snd_fd(sf);
+ ed->maxamp = mx;
+ ed->maxamp_position = loc;
+ }
+
reflect_sample_change_in_axis(cp);
reflect_mix_change(ANY_MIX_ID);
after_edit(cp);
if (backup)
backup_edit_list(cp);
-
return(true);
}
return(false);
@@ -4988,7 +3886,6 @@ static ed_list *change_samples_in_list(mus_long_t beg, mus_long_t num, int pos,
{
/* delete + insert -- already checked that beg < cur end */
ed_list *new_state;
- ed_list *del_state;
mus_long_t del_num, cur_end;
ed_fragment *changed_f;
@@ -4998,7 +3895,8 @@ static ed_list *change_samples_in_list(mus_long_t beg, mus_long_t num, int pos,
del_num = cur_end - beg;
if (num < del_num) del_num = num;
if (del_num > 0)
- {
+ {
+ ed_list *del_state;
del_state = delete_section_from_list(beg, del_num, cp->edits[pos]);
new_state = insert_section_into_list(beg, num, del_state, &changed_f, origin, 1.0);
del_state = free_ed_list(del_state, cp);
@@ -5026,13 +3924,14 @@ bool file_change_samples(mus_long_t beg, mus_long_t num, const char *tempfile, c
hdr = make_file_info(tempfile, FILE_READ_ONLY, FILE_NOT_SELECTED);
if (hdr)
{
- ed_list *ed;
+ ed_list *ed, *old_ed;
mus_long_t prev_len, new_len;
- ed_fragment *cb;
+ ed_fragment *cb = NULL;
int fd;
int backup = 0;
- prev_len = cp->edits[edpos]->samples;
+ old_ed = cp->edits[edpos];
+ prev_len = old_ed->samples;
if (beg > prev_len)
{
if (!(extend_with_zeros(cp, prev_len, beg - prev_len, edpos, origin)))
@@ -5042,7 +3941,7 @@ bool file_change_samples(mus_long_t beg, mus_long_t num, const char *tempfile, c
}
backup++;
edpos = cp->edit_ctr;
- prev_len = CURRENT_SAMPLES(cp);
+ prev_len = current_samples(cp);
}
new_len = beg + num;
if (new_len < prev_len) new_len = prev_len;
@@ -5064,10 +3963,35 @@ bool file_change_samples(mus_long_t beg, mus_long_t num, const char *tempfile, c
if (cp->edit_ctr > 0) ed->cursor = cp->edits[cp->edit_ctr - 1]->cursor;
cp->edits[cp->edit_ctr] = ed;
+ if (((old_ed->maxamp_position >= 0) ||
+ ((beg == 0) && (num >= old_ed->samples))) &&
+ (mus_sound_channel_maxamp_exists(tempfile, chan)))
+ {
+ mus_float_t mx;
+ mus_long_t pos;
+ mx = mus_sound_channel_maxamp(tempfile, chan, &pos);
+ if ((mx > old_ed->maxamp) ||
+ ((beg == 0) && (num >= old_ed->samples)))
+ {
+ ed->maxamp = mx;
+ ed->maxamp_position = beg + pos;
+ }
+ else
+ {
+ /* make sure old max info is still relevant */
+ if ((old_ed->maxamp_position < beg) ||
+ (old_ed->maxamp_position > (beg + num)))
+ {
+ ed->maxamp = old_ed->maxamp;
+ ed->maxamp_position = old_ed->maxamp_position;
+ }
+ }
+ }
+
fd = snd_open_read(tempfile);
snd_file_open_descriptors(fd,
tempfile,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
@@ -5092,10 +4016,10 @@ bool file_change_samples(mus_long_t beg, mus_long_t num, const char *tempfile, c
}
else
{
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: ~A"),
- C_TO_XEN_STRING(origin),
- C_TO_XEN_STRING(snd_io_strerror())));
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_3(C_string_to_Xen_string("~A: ~A"),
+ C_string_to_Xen_string(origin),
+ C_string_to_Xen_string(snd_io_strerror())));
}
return(true);
}
@@ -5120,7 +4044,7 @@ bool file_override_samples(mus_long_t num, const char *tempfile, chan_info *cp,
fd = snd_open_read(tempfile);
snd_file_open_descriptors(fd,
tempfile,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
@@ -5135,6 +4059,13 @@ bool file_override_samples(mus_long_t num, const char *tempfile, chan_info *cp,
if (cp->edit_ctr > 0) e->cursor = cp->edits[cp->edit_ctr - 1]->cursor;
cp->edits[cp->edit_ctr] = e;
+ if (mus_sound_channel_maxamp_exists(tempfile, chan))
+ {
+ mus_long_t pos;
+ e->maxamp = mus_sound_channel_maxamp(tempfile, chan, &pos);
+ e->maxamp_position = pos;
+ }
+
FRAGMENT_SOUND(e, 0) = add_sound_file_to_edit_list(cp, tempfile,
make_file_state(fd, hdr, chan, 0, FILE_BUFFER_SIZE),
hdr, auto_delete, chan);
@@ -5147,30 +4078,32 @@ bool file_override_samples(mus_long_t num, const char *tempfile, chan_info *cp,
}
else
{
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: ~A"),
- C_TO_XEN_STRING(origin),
- C_TO_XEN_STRING(snd_io_strerror())));
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_3(C_string_to_Xen_string("~A: ~A"),
+ C_string_to_Xen_string(origin),
+ C_string_to_Xen_string(snd_io_strerror())));
}
return(true);
}
-bool change_samples(mus_long_t beg, mus_long_t num, mus_sample_t *vals, chan_info *cp, const char *origin, int edpos)
+bool change_samples(mus_long_t beg, mus_long_t num, mus_float_t *vals, chan_info *cp, const char *origin, int edpos, mus_float_t mx)
{
+ /* mx should be -1.0 except in the one case where vals is a block all of the same value */
mus_long_t prev_len, new_len;
ed_fragment *cb;
- ed_list *ed;
+ ed_list *ed, *old_ed;
int backup = 0;
if (num <= 0) return(true);
- prev_len = cp->edits[edpos]->samples;
+ old_ed = cp->edits[edpos];
+ prev_len = old_ed->samples;
if (beg > prev_len)
{
if (!(extend_with_zeros(cp, prev_len, beg - prev_len, edpos, origin)))
return(false);
edpos = cp->edit_ctr;
- prev_len = CURRENT_SAMPLES(cp);
+ prev_len = current_samples(cp);
backup++;
}
new_len = beg + num;
@@ -5184,16 +4117,58 @@ bool change_samples(mus_long_t beg, mus_long_t num, mus_sample_t *vals, chan_inf
backup++;
}
- ed = change_samples_in_list(beg, num, edpos, cp, &cb, origin);
- ed->edit_type = CHANGE_EDIT;
- ed->samples = new_len;
- cp->edits[cp->edit_ctr] = ed;
- if (cp->edit_ctr > 0) ed->cursor = cp->edits[cp->edit_ctr - 1]->cursor;
- prepare_sound_list(cp);
- cp->sounds[cp->sound_ctr] = make_snd_data_buffer(vals, (int)num, cp->edit_ctr);
- ED_SOUND(cb) = cp->sound_ctr;
- ed->sound_location = ED_SOUND(cb);
-
+ ed = change_samples_in_list(beg, num, edpos, cp, &cb, origin);
+ ed->edit_type = CHANGE_EDIT;
+ ed->samples = new_len;
+ cp->edits[cp->edit_ctr] = ed;
+ if (cp->edit_ctr > 0) ed->cursor = cp->edits[cp->edit_ctr - 1]->cursor;
+ prepare_sound_list(cp);
+ cp->sounds[cp->sound_ctr] = make_snd_data_buffer(vals, (int)num, cp->edit_ctr);
+ ED_SOUND(cb) = cp->sound_ctr;
+ ed->sound_location = ED_SOUND(cb);
+
+ if ((old_ed->maxamp_position >= 0) ||
+ ((beg == 0) && (num >= old_ed->samples))) /* perhaps old max is irrelevant */
+ {
+ int pos = 0;
+ if ((mx < 0.0) &&
+ (num < MAXAMP_CHECK_SIZE))
+ {
+ mus_float_t nmx;
+ int i;
+ nmx = fabs(vals[0]);
+ for (i = 1; i < num; i++)
+ {
+ mus_float_t temp;
+ temp = fabs(vals[i]);
+ if (temp > nmx)
+ {
+ nmx = temp;
+ pos = i;
+ }
+ }
+ mx = nmx;
+ }
+ if (mx >= 0.0)
+ {
+ if ((mx > old_ed->maxamp) ||
+ ((beg == 0) && (num >= old_ed->samples)))
+ {
+ ed->maxamp = mx;
+ ed->maxamp_position = beg + pos;
+ }
+ else
+ {
+ if ((old_ed->maxamp_position < beg) ||
+ (old_ed->maxamp_position > (beg + num)))
+ {
+ ed->maxamp = old_ed->maxamp;
+ ed->maxamp_position = old_ed->maxamp_position;
+ }
+ }
+ }
+ }
+
ripple_all(cp, 0, 0);
if (new_len > prev_len) reflect_sample_change_in_axis(cp);
reflect_mix_change(ANY_MIX_ID);
@@ -5210,7 +4185,7 @@ bool change_samples(mus_long_t beg, mus_long_t num, mus_sample_t *vals, chan_inf
}
-/* -------------------------------- ramp/scale/ptree -------------------------------- */
+/* -------------------------------- ramp/scale -------------------------------- */
bool unrampable(chan_info *cp, mus_long_t beg, mus_long_t dur, int pos, bool is_xramp)
{
@@ -5241,36 +4216,7 @@ bool unrampable(chan_info *cp, mus_long_t beg, mus_long_t dur, int pos, bool is_
}
-bool unptreeable(chan_info *cp, mus_long_t beg, mus_long_t dur, int pos)
-{
- /* from ptree-channel (snd-sig.c) check for pre-existing ptree-channel */
- ed_list *ed;
- int i;
- mus_long_t end;
- ed = cp->edits[pos];
- end = beg + dur - 1;
- for (i = 0; i < ed->size - 1; i++)
- {
- mus_long_t loc, next_loc;
- if (FRAGMENT_SOUND(ed, i) == EDIT_LIST_END_MARK) return(false);
- loc = FRAGMENT_GLOBAL_POSITION(ed, i);
- if (loc > end) return(false);
- next_loc = FRAGMENT_GLOBAL_POSITION(ed, i + 1); /* i.e. next loc = current fragment end point */
- /* fragment starts at loc, ends just before next_loc, is of type typ */
- if (next_loc > beg)
- {
- if (type_info[FRAGMENT_TYPE(ed, i)].add_ptree == -1)
- return(true);
- if ((FRAGMENT_PTREES(ed, i)) &&
- (FRAGMENT_PTREE_LIST_SIZE(ed, i) >= max_virtual_ptrees))
- return(true);
- }
- }
- return(false);
-}
-
-
-bool ptree_or_sound_fragments_in_use(chan_info *cp, int pos)
+bool sound_fragments_in_use(chan_info *cp, int pos)
{
/* (swap-channels): are there any non-simple/non-ramp edits? */
int i;
@@ -5284,8 +4230,6 @@ bool ptree_or_sound_fragments_in_use(chan_info *cp, int pos)
if ((index != 0) &&
(index != EDIT_LIST_ZERO_MARK))
return(true);
- if (ptree_op(FRAGMENT_TYPE(ed, i)))
- return(true);
}
return(false);
}
@@ -5322,32 +4266,6 @@ static bool found_virtual_mix(chan_info *cp, int edpos)
}
-static bool found_unmixable_ptreed_op(chan_info *cp, int edpos, mus_long_t beg, mus_long_t end)
-{
- ed_list *ed;
- int i;
- ed = cp->edits[edpos];
- for (i = 0; i < ed->size - 1; i++)
- {
- mus_long_t loc, next_loc;
- if (FRAGMENT_SOUND(ed, i) == EDIT_LIST_END_MARK) return(false);
- loc = FRAGMENT_GLOBAL_POSITION(ed, i);
- if (loc > end) return(false);
- next_loc = FRAGMENT_GLOBAL_POSITION(ed, i + 1); /* i.e. next loc = current fragment end point */
- /* this fragment (i) starts at loc, ends just before next_loc, is of type typ */
- if (next_loc > beg)
- {
- int after_ptree_op;
- after_ptree_op = type_info[FRAGMENT_TYPE(ed, i)].add_ptree;
- if ((after_ptree_op == -1) || /* this should not happen since we check for it ahead of time */
- (!(is_mixable_op(after_ptree_op))))
- return(true);
- }
- }
- return(false);
-}
-
-
static bool found_unmixable_ramped_op(chan_info *cp, int edpos, mus_long_t beg, mus_long_t end, bool is_xramp)
{
ed_list *ed;
@@ -5407,13 +4325,14 @@ static ed_list *copy_and_split_list(mus_long_t beg, mus_long_t num, ed_list *cur
mus_long_t end, next_pos;
int cur_len, cur_i, new_i;
ed_list *new_state;
- ed_fragment *new_f, *cur_f, *mid_f = NULL;
+ ed_fragment *new_f, *mid_f = NULL;
if (num <= 0) return(NULL);
cur_len = current_state->size;
end = beg + num;
new_state = make_ed_list(cur_len + 2); /* leave room for possible split */
for (cur_i = 0, new_i = 0; cur_i < cur_len; cur_i++, new_i++)
{
+ ed_fragment *cur_f;
cur_f = FRAGMENT(current_state, cur_i);
new_f = FRAGMENT(new_state, new_i);
if (ED_GLOBAL_POSITION(cur_f) >= end)
@@ -5455,8 +4374,8 @@ static ed_list *copy_and_split_list(mus_long_t beg, mus_long_t num, ed_list *cur
ED_LOCAL_POSITION(split_back_f) = ED_LOCAL_END(split_front_f) + 1;
ED_GLOBAL_POSITION(split_back_f) = beg;
- /* now fixup ramps/ptrees affected by the split */
- if (ramp_or_ptree_op(ED_TYPE(cur_f)))
+ /* now fixup ramps affected by the split */
+ if (ramp_op(ED_TYPE(cur_f)))
{
new_before_ramp(split_front_f, cur_f);
new_after_ramp(split_back_f, cur_f, beg);
@@ -5477,8 +4396,8 @@ static ed_list *copy_and_split_list(mus_long_t beg, mus_long_t num, ed_list *cur
ED_LOCAL_POSITION(split_back_f) = ED_LOCAL_END(split_front_f) + 1;
ED_GLOBAL_POSITION(split_back_f) = end;
- /* now fixup ramps/ptrees affected by the split */
- if (ramp_or_ptree_op(ED_TYPE(cur_f)))
+ /* now fixup ramps affected by the split */
+ if (ramp_op(ED_TYPE(cur_f)))
{
if (ED_RAMPS(split_front_f))
{
@@ -5508,7 +4427,6 @@ static ed_list *copy_and_split_list(mus_long_t beg, mus_long_t num, ed_list *cur
if (ramp_begs) free(ramp_begs);
if (xramp_begs) free(xramp_begs);
}
- /* possibly also just ptrees in new trailer */
new_after_ramp(split_back_f, cur_f, end);
}
}
@@ -5527,7 +4445,7 @@ bool scale_channel_with_origin(chan_info *cp, mus_float_t scl, mus_long_t beg, m
{
/* copy current ed-list and reset scalers */
mus_long_t len = 0;
- int i;
+ int i, old_pos;
ed_list *new_ed, *old_ed;
bool backup = false;
@@ -5539,6 +4457,7 @@ bool scale_channel_with_origin(chan_info *cp, mus_float_t scl, mus_long_t beg, m
(section_is_zero(cp, beg, num, pos)))
return(false);
+ old_pos = pos;
len = old_ed->samples;
if (!(prepare_edit_list(cp, pos, S_scale_channel)))
return(false);
@@ -5565,6 +4484,11 @@ bool scale_channel_with_origin(chan_info *cp, mus_float_t scl, mus_long_t beg, m
copy_ed_fragment(FRAGMENT(new_ed, i), FRAGMENT(old_ed, i));
FRAGMENT_SCALER(new_ed, i) *= scl;
}
+ if (old_ed->maxamp_position != -1)
+ {
+ new_ed->maxamp = old_ed->maxamp * fabs(scl);
+ new_ed->maxamp_position = old_ed->maxamp_position;
+ }
}
new_ed->samples = len;
cp->edits[cp->edit_ctr] = new_ed;
@@ -5599,6 +4523,62 @@ bool scale_channel_with_origin(chan_info *cp, mus_float_t scl, mus_long_t beg, m
}
}
peak_env_scale_selection_by(cp, scl, beg, num, pos);
+
+ if (old_ed->maxamp_position >= 0)
+ {
+ if ((old_ed->maxamp_position < beg) ||
+ (old_ed->maxamp_position > (beg + num)))
+ {
+ if (fabs(scl) <= 1.0)
+ {
+ new_ed->maxamp = old_ed->maxamp;
+ new_ed->maxamp_position = old_ed->maxamp_position;
+ }
+ else
+ {
+ /* perhaps this costs more than it saves */
+ if (num < MAXAMP_CHECK_SIZE)
+ {
+ mus_float_t mx;
+ int i, loc = 0;
+ snd_fd *sf;
+ sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, old_pos, num + 1);
+ sampler_set_safe(sf, num);
+ mx = fabs(read_sample(sf));
+ for (i = 1; i < num; i++)
+ {
+ mus_float_t temp;
+ temp = fabs(read_sample(sf));
+ if (temp > mx)
+ {
+ mx = temp;
+ loc = i;
+ }
+ }
+ free_snd_fd(sf);
+ mx *= fabs(scl);
+ if (mx > old_ed->maxamp)
+ {
+ new_ed->maxamp = mx;
+ new_ed->maxamp_position = beg + loc;
+ }
+ else
+ {
+ new_ed->maxamp = old_ed->maxamp;
+ new_ed->maxamp_position = old_ed->maxamp_position;
+ }
+ }
+ }
+ }
+ else
+ {
+ if (fabs(scl) >= 1.0)
+ {
+ new_ed->maxamp = old_ed->maxamp * fabs(scl);
+ new_ed->maxamp_position = old_ed->maxamp_position;
+ }
+ }
+ }
}
new_ed->cursor = old_ed->cursor;
new_ed->edit_type = SCALED_EDIT;
@@ -5609,22 +4589,16 @@ bool scale_channel_with_origin(chan_info *cp, mus_float_t scl, mus_long_t beg, m
{
if (num == len)
#if HAVE_FORTH
- new_ed->origin = mus_format("%.3f " MUS_LD PROC_SEP PROC_FALSE " %s", scl, beg, S_scale_channel);
+ new_ed->origin = mus_format("%.3f %lld" PROC_SEP PROC_FALSE " %s", scl, beg, S_scale_channel);
#else
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP MUS_LD PROC_SEP PROC_FALSE, TO_PROC_NAME(S_scale_channel), scl, beg);
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%lld" PROC_SEP PROC_FALSE, to_proc_name(S_scale_channel), scl, beg);
#endif
else
{
#if HAVE_FORTH
- if (len == num)
- new_ed->origin = mus_format("%.3f " MUS_LD PROC_SEP PROC_FALSE " %s", scl, beg, S_scale_channel);
- else
- new_ed->origin = mus_format("%.3f " MUS_LD PROC_SEP MUS_LD " %s", scl, beg, num, S_scale_channel);
+ new_ed->origin = mus_format("%.3f %lld" PROC_SEP "%lld %s", scl, beg, num, S_scale_channel);
#else
- if (len == num)
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP MUS_LD PROC_SEP PROC_FALSE, TO_PROC_NAME(S_scale_channel), scl, beg);
- else
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(S_scale_channel), scl, beg, num);
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_scale_channel), scl, beg, num);
#endif
}
}
@@ -5697,261 +4671,44 @@ static void add_ramp_to_fragment(ed_list *new_ed, int i, double start, double in
loc = rmps - 1;
ED_RAMP_START(ed, loc) = start;
ED_RAMP_INCR(ed, loc) = incr;
- ED_TYPE(ed) = type_info[typ].add_ramp;
- }
-
- if ((double_split_op(ED_TYPE(ed))) &&
- (!(double_split_op(typ))))
- {
- ED_RSPLIT(ed) = (is_xramp) ? rmps : loc;
- ED_XSPLIT(ed) = (is_xramp) ? loc : xrmps;
- }
-}
-
-
-static bool all_ramp_channel(chan_info *cp, double start, double incr, double scaler, double offset,
- mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit, const char *origin,
- bool is_xramp, mus_any *e, int xramp_seg_loc)
-{
- mus_long_t len = 0;
- int i;
- ed_list *new_ed, *old_ed;
- bool backup = false;
- double rstart;
- /*
- fprintf(stderr,"ramp: %f %f %f %f " MUS_LD " " MUS_LD "\n", start, incr, scaler, offset, beg, num);
- */
- old_ed = cp->edits[pos];
- if ((beg < 0) ||
- (num <= 0) ||
- (beg >= old_ed->samples) ||
- (section_is_zero(cp, beg, num, pos)))
- return(false); /* was true, but this is a no-op */
-
- if ((!is_xramp) && ((incr == 0.0) || (num == 1))) /* in xramp case, we're ramping a power, not a scaler */
- return(scale_channel(cp, start, beg, num, pos, in_as_one_edit));
-
- len = old_ed->samples;
-
- if (!(prepare_edit_list(cp, pos, origin)))
- return(false);
-
- if (found_virtual_mix(cp, pos))
- {
- mus_long_t lock_beg, lock_end;
- if (found_unmixable_ramped_op(cp, pos, beg, beg + num, is_xramp))
- {
- lock_beg = 0;
- lock_end = len - 1;
- }
- else
- {
- lock_beg = beg;
- lock_end = beg + num;
- }
- if (lock_affected_mixes(cp, pos, lock_beg, lock_end))
- {
- pos = cp->edit_ctr;
- old_ed = cp->edits[pos];
- increment_edit_ctr(cp);
- backup = true;
- }
- }
-
- rstart = start;
- if ((beg == 0) &&
- (num >= old_ed->samples))
- {
- /* one ramp over entire fragment list -- no splits will occur here */
- num = len;
- new_ed = make_ed_list(old_ed->size);
- new_ed->beg = beg;
- new_ed->len = num;
- cp->edits[cp->edit_ctr] = new_ed;
- for (i = 0; i < new_ed->size; i++)
- copy_ed_fragment(FRAGMENT(new_ed, i), FRAGMENT(old_ed, i));
- for (i = 0; i < new_ed->size - 1; i++) /* -1 here to leave end mark alone */
- {
- add_ramp_to_fragment(new_ed, i, start, incr, scaler, offset, is_xramp);
- if (!is_xramp)
- start += (incr * FRAGMENT_LENGTH(new_ed, i));
- else start *= exp(log(incr) * FRAGMENT_LENGTH(new_ed, i));
- }
- }
- else
- {
- if (beg + num > len) num = len - beg;
- new_ed = copy_and_split_list(beg, num, old_ed);
- cp->edits[cp->edit_ctr] = new_ed;
- for (i = 0; i < new_ed->size - 1; i++)
- {
- if (FRAGMENT_GLOBAL_POSITION(new_ed, i) > (beg + num - 1)) break; /* not >= (1 sample selections) */
- if (FRAGMENT_GLOBAL_POSITION(new_ed, i) >= beg)
- {
- add_ramp_to_fragment(new_ed, i, start, incr, scaler, offset, is_xramp);
- if (!is_xramp)
- start += (incr * FRAGMENT_LENGTH(new_ed, i));
- else start *= exp(log(incr) * FRAGMENT_LENGTH(new_ed, i));
- }
- }
- }
- new_ed->samples = len;
- new_ed->cursor = old_ed->cursor;
- new_ed->edit_type = RAMP_EDIT;
- new_ed->sound_location = 0;
- if (!is_xramp)
- {
- mus_float_t rmp0, rmp1;
- rmp0 = rstart;
- rmp1 = rstart + incr * (num -1); /* want end point */
-#if HAVE_FORTH
- if (num == len)
- new_ed->origin = mus_format("%.3f %.3f " MUS_LD PROC_SEP PROC_FALSE " %s", rmp0, rmp1, beg, origin);
- else
- new_ed->origin = mus_format("%.3f %.3f " MUS_LD PROC_SEP MUS_LD " %s", rmp0, rmp1, beg, num, origin);
-#else
- if (num == len)
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP MUS_LD PROC_SEP PROC_FALSE, TO_PROC_NAME(origin), rmp0, rmp1, beg);
- else
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(origin), rmp0, rmp1, beg, num);
-#endif
- }
- else
- {
- mus_float_t *data;
- data = mus_data(e);
-#if HAVE_FORTH
- if (num == len)
- new_ed->origin = mus_format("%.3f %.3f %.3f " MUS_LD PROC_SEP PROC_FALSE " %s",
- data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, origin);
- else
- new_ed->origin = mus_format("%.3f %.3f %.3f " MUS_LD PROC_SEP MUS_LD " %s",
- data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, num, origin);
-#else
- if (num == len)
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%.3f" PROC_SEP MUS_LD PROC_SEP PROC_FALSE,
- TO_PROC_NAME(origin), data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg);
- else
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%.3f" PROC_SEP MUS_LD PROC_SEP MUS_LD,
- TO_PROC_NAME(origin), data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, num);
-#endif
- }
- new_ed->edpos = pos;
- new_ed->selection_beg = old_ed->selection_beg;
- new_ed->selection_end = old_ed->selection_end;
-
- ripple_all(cp, 0, 0); /* 0,0 -> copy marks */
- reflect_mix_change(ANY_MIX_ID);
- after_edit(cp);
-
- if (backup)
- backup_edit_list(cp);
-
- return(true);
-}
-
-
-bool ramp_channel(chan_info *cp, double start, double incr, mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit)
-{
- return(all_ramp_channel(cp, start, incr, 0.0, 0.0, beg, num, pos, in_as_one_edit, S_ramp_channel, false, NULL, 0));
-}
-
-
-bool xramp_channel(chan_info *cp, double start, double incr, double scaler, double offset,
- mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit, mus_any *e, int xramp_seg_loc)
-{
- return(all_ramp_channel(cp, start, incr, scaler, offset, beg, num, pos, in_as_one_edit, S_xramp_channel, true, e, xramp_seg_loc));
-}
-
-
-static void add_ptree_to_fragment(ed_list *new_ed, int i, int ptree_loc, mus_long_t beg, mus_long_t num)
-{
- int typ, tree;
- ed_fragment *ed;
- ed = FRAGMENT(new_ed, i);
-
- typ = ED_TYPE(ed);
- if (typ < ED_SIMPLE) return; /* end mark! trying to avoid it in copy loops */
-
- ED_TYPE(ed) = type_info[typ].add_ptree;
- tree = ensure_ed_ptrees(ed, (ED_PTREES(ed)) ? (ED_PTREE_LIST_SIZE(ed) + 1) : 1) - 1;
-
- if (ramp_op(typ))
- {
- if (ptree_op(typ))
- {
- if ((split_ptree_op(ED_TYPE(ed))) && (ED_PSPLIT(ed) == 0))
- ED_PSPLIT(ed) = ED_PTREE_LIST_SIZE(ed) - 1; /* we made room for the new (split) ptree already */
- }
- else
- {
- /* if old was (pure)ramp_op, set ramp split locs */
- ED_RSPLIT(ed) = ED_RAMP_LIST_SIZE(ed);
- ED_XSPLIT(ed) = ED_XRAMP_LIST_SIZE(ed);
- }
- }
-
-
- if (tree == 0)
- ED_PTREE_SCALER(ed, tree) = MUS_SAMPLE_TO_FLOAT(ED_SCALER(ed)); /* arg is mus_sample data, need convert to float */
- else ED_PTREE_SCALER(ed, tree) = ED_SCALER(ed); /* already float, so no need to convert */
-
- ED_PTREE_INDEX(ed, tree) = ptree_loc;
- ED_PTREE_DUR(ed, tree) = num;
- ED_PTREE_POSITION(ed, tree) = ED_GLOBAL_POSITION(ed) - beg;
-
- ED_SCALER(ed) = 1.0;
+ ED_TYPE(ed) = type_info[typ].add_ramp;
+ }
}
-void ptree_channel(chan_info *cp, struct ptree *tree, mus_long_t beg, mus_long_t num, int pos, bool env_it, XEN init_func, const char *origin)
+static bool all_ramp_channel(chan_info *cp, double start, double incr, double scaler, double offset,
+ mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit, const char *origin,
+ bool is_xramp, mus_any *e, int xramp_seg_loc)
{
- mus_long_t len;
- int i, ptree_loc = 0;
+ mus_long_t len = 0;
+ int i, old_pos;
ed_list *new_ed, *old_ed;
bool backup = false;
+ double rstart;
+ /*
+ fprintf(stderr,"ramp: %f %f %f %f %lld %lld\n", start, incr, scaler, offset, beg, num);
+ */
old_ed = cp->edits[pos];
if ((beg < 0) ||
(num <= 0) ||
(beg >= old_ed->samples) ||
- (tree == NULL))
- {
- if (tree)
- {
- mus_run_free_ptree(tree);
- tree = NULL;
- }
- return;
- }
+ (section_is_zero(cp, beg, num, pos)))
+ return(false); /* was true, but this is a no-op */
+
+ if ((!is_xramp) && ((incr == 0.0) || (num == 1))) /* in xramp case, we're ramping a power, not a scaler */
+ return(scale_channel(cp, start, beg, num, pos, in_as_one_edit));
len = old_ed->samples;
- if (pos > cp->edit_ctr)
- {
- /* prepare_edit_list will throw 'no-such-edit, but we need to clean up the ptree first */
- mus_run_free_ptree(tree);
- tree = NULL;
- }
+ old_pos = pos;
- if (!(prepare_edit_list(cp, pos, S_ptree_channel)))
- {
- /* perhaps edit-hook blocked the edit */
- if (tree)
- {
- mus_run_free_ptree(tree);
- tree = NULL;
- }
- return;
- }
+ if (!(prepare_edit_list(cp, pos, origin)))
+ return(false);
- /* if there are any virtual mixes, we need to check the ptreed section for either mixes present, or
- * ptreed-opcodes that are unmixable (since the user may drag the virtual mix into this new section).
- * In the latter case, all mixes must be locked, not just those directly affected.
- */
if (found_virtual_mix(cp, pos))
{
mus_long_t lock_beg, lock_end;
- if (found_unmixable_ptreed_op(cp, pos, beg, beg + num))
+ if (found_unmixable_ramped_op(cp, pos, beg, beg + num, is_xramp))
{
lock_beg = 0;
lock_end = len - 1;
@@ -5964,67 +4721,155 @@ void ptree_channel(chan_info *cp, struct ptree *tree, mus_long_t beg, mus_long_t
if (lock_affected_mixes(cp, pos, lock_beg, lock_end))
{
pos = cp->edit_ctr;
- old_ed = cp->edits[pos]; /* add ptrees to the changed list, not the original incoming list */
+ old_ed = cp->edits[pos];
increment_edit_ctr(cp);
backup = true;
}
}
- ptree_loc = add_ptree(cp);
- cp->ptrees[ptree_loc] = tree;
- if (XEN_PROCEDURE_P(init_func))
- {
- cp->init_locs[ptree_loc] = snd_protect(init_func);
- cp->ptree_inits[ptree_loc] = init_func;
- if (XEN_REQUIRED_ARGS_OK(init_func, 3))
- cp->init_args[ptree_loc] = 3;
- else cp->init_args[ptree_loc] = 2;
- }
- else cp->ptree_inits[ptree_loc] = XEN_FALSE;
-
+ rstart = start;
if ((beg == 0) &&
(num >= old_ed->samples))
{
+ /* one ramp over entire fragment list -- no splits will occur here */
num = len;
new_ed = make_ed_list(old_ed->size);
new_ed->beg = beg;
new_ed->len = num;
- new_ed->samples = len;
cp->edits[cp->edit_ctr] = new_ed;
-
- for (i = 0; i < new_ed->size; i++)
+ for (i = 0; i < new_ed->size; i++)
+ copy_ed_fragment(FRAGMENT(new_ed, i), FRAGMENT(old_ed, i));
+ for (i = 0; i < new_ed->size - 1; i++) /* -1 here to leave end mark alone */
{
- copy_ed_fragment(FRAGMENT(new_ed, i), FRAGMENT(old_ed, i));
- if (i < new_ed->size - 1) /* ignore end mark! */
- add_ptree_to_fragment(new_ed, i, ptree_loc, beg, num);
+ add_ramp_to_fragment(new_ed, i, start, incr, scaler, offset, is_xramp);
+ if (!is_xramp)
+ start += (incr * FRAGMENT_LENGTH(new_ed, i));
+ else start *= exp(log(incr) * FRAGMENT_LENGTH(new_ed, i));
}
- if (env_it)
- peak_env_ptree(cp, tree, pos, init_func);
}
else
{
if (beg + num > len) num = len - beg;
new_ed = copy_and_split_list(beg, num, old_ed);
- new_ed->samples = len;
cp->edits[cp->edit_ctr] = new_ed;
- for (i = 0; i < new_ed->size; i++)
+ for (i = 0; i < new_ed->size - 1; i++)
{
- if (FRAGMENT_GLOBAL_POSITION(new_ed, i) > (beg + num - 1))
- break; /* not >= (1 sample selections) */
- if ((FRAGMENT_GLOBAL_POSITION(new_ed, i) >= beg) &&
- (i < new_ed->size - 1))
- add_ptree_to_fragment(new_ed, i, ptree_loc, beg, num);
+ if (FRAGMENT_GLOBAL_POSITION(new_ed, i) > (beg + num - 1)) break; /* not >= (1 sample selections) */
+ if (FRAGMENT_GLOBAL_POSITION(new_ed, i) >= beg)
+ {
+ add_ramp_to_fragment(new_ed, i, start, incr, scaler, offset, is_xramp);
+ if (!is_xramp)
+ start += (incr * FRAGMENT_LENGTH(new_ed, i));
+ else start *= exp(log(incr) * FRAGMENT_LENGTH(new_ed, i));
+ }
+ }
+ if ((old_ed->maxamp_position >= 0) ||
+ ((beg == 0) && (num >= old_ed->samples)))
+ {
+ if ((old_ed->maxamp_position >= 0) &&
+ ((old_ed->maxamp_position < beg) ||
+ (old_ed->maxamp_position > (beg + num))) &&
+ (fabs(rstart) <= 1.0) &&
+ (((!is_xramp) &&
+ (fabs(rstart + incr * num) <= 1.0)) ||
+ ((is_xramp) &&
+ (fabs(rstart * exp(log(incr) * num)) <= 1.0))))
+ {
+ /* we have maxamp data for the previous edit and
+ * the ramp does not hit the current maxamp and it stays within -1.0 to 1.0,
+ * so it can't affect the maxamp
+ */
+ new_ed->maxamp = old_ed->maxamp;
+ new_ed->maxamp_position = old_ed->maxamp_position;
+ }
+ else
+ {
+ /* if ramped portion has a max > old max, we can use it in any case,
+ * but we need to do the ramp by hand here, I think.
+ */
+ if ((num < MAXAMP_CHECK_SIZE) &&
+ (!is_xramp))
+ {
+ mus_float_t mx, x;
+ int i, loc = 0;
+ snd_fd *sf;
+ x = rstart;
+ sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, old_pos, num + 1);
+ sampler_set_safe(sf, num);
+ mx = fabs(x * read_sample(sf));
+ for (i = 1; i < num; i++)
+ {
+ mus_float_t temp;
+ x += incr;
+ temp = fabs(x * read_sample(sf));
+ if (temp > mx)
+ {
+ mx = temp;
+ loc = i;
+ }
+ }
+ free_snd_fd(sf);
+ if ((mx > old_ed->maxamp) ||
+ ((beg == 0) && (num >= old_ed->samples)))
+ {
+ new_ed->maxamp = mx;
+ new_ed->maxamp_position = beg + loc;
+ }
+ else
+ {
+ if ((old_ed->maxamp_position < beg) ||
+ (old_ed->maxamp_position > (beg + num)))
+ {
+ new_ed->maxamp = old_ed->maxamp;
+ new_ed->maxamp_position = old_ed->maxamp_position;
+ }
+ }
+ }
+ }
}
- if (env_it)
- peak_env_ptree_selection(cp, tree, beg, num, pos, init_func);
}
+ new_ed->samples = len;
new_ed->cursor = old_ed->cursor;
- new_ed->edit_type = PTREE_EDIT;
+ new_ed->edit_type = RAMP_EDIT;
new_ed->sound_location = 0;
- new_ed->ptree_location = ptree_loc;
- new_ed->origin = mus_strdup(origin);
+ if (!is_xramp)
+ {
+ mus_float_t rmp0, rmp1;
+ rmp0 = rstart;
+ rmp1 = rstart + incr * (num - 1); /* want end point */
+#if HAVE_FORTH
+ if (num == len)
+ new_ed->origin = mus_format("%.3f %.3f %lld" PROC_SEP PROC_FALSE " %s", rmp0, rmp1, beg, origin);
+ else
+ new_ed->origin = mus_format("%.3f %.3f %lld" PROC_SEP "%lld %s", rmp0, rmp1, beg, num, origin);
+#else
+ if (num == len)
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%lld" PROC_SEP PROC_FALSE, to_proc_name(origin), rmp0, rmp1, beg);
+ else
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(origin), rmp0, rmp1, beg, num);
+#endif
+ }
+ else
+ {
+ mus_float_t *data;
+ data = mus_data(e);
+#if HAVE_FORTH
+ if (num == len)
+ new_ed->origin = mus_format("%.3f %.3f %.3f %lld" PROC_SEP PROC_FALSE " %s",
+ data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, origin);
+ else
+ new_ed->origin = mus_format("%.3f %.3f %.3f %lld" PROC_SEP "%lld %s",
+ data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, num, origin);
+#else
+ if (num == len)
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%.3f" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ to_proc_name(origin), data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg);
+ else
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%.3f" PROC_SEP "%lld" PROC_SEP "%lld",
+ to_proc_name(origin), data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, num);
+#endif
+ }
new_ed->edpos = pos;
- new_ed->ptree_env_too = env_it;
new_ed->selection_beg = old_ed->selection_beg;
new_ed->selection_end = old_ed->selection_end;
@@ -6034,10 +4879,27 @@ void ptree_channel(chan_info *cp, struct ptree *tree, mus_long_t beg, mus_long_t
if (backup)
backup_edit_list(cp);
- update_graph(cp);
+
+ return(true);
+}
+
+
+bool ramp_channel(chan_info *cp, double start, double incr, mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit)
+{
+ return(all_ramp_channel(cp, start, incr, 0.0, 0.0, beg, num, pos, in_as_one_edit, S_ramp_channel, false, NULL, 0));
+}
+
+
+bool xramp_channel(chan_info *cp, double start, double incr, double scaler, double offset,
+ mus_long_t beg, mus_long_t num, int pos, bool in_as_one_edit, mus_any *e, int xramp_seg_loc)
+{
+ return(all_ramp_channel(cp, start, incr, scaler, offset, beg, num, pos, in_as_one_edit, S_xramp_channel, true, e, xramp_seg_loc));
}
+
+
+
/* -------------------------------- samplers -------------------------------- */
static reader_mixes *free_reader_mixes(reader_mixes *md)
@@ -6079,24 +4941,6 @@ snd_fd *free_snd_fd_almost(snd_fd *sf)
sf->ramps = NULL;
}
- if (READER_PTREES(sf))
- {
- int i, pts;
- pts = READER_PTREE_LIST_SIZE(sf);
- for (i = 0; i < pts; i++)
- {
- if (READER_PTREE_GC_LOC(sf, i) != NOT_A_GC_LOC)
- {
- snd_unprotect_at(READER_PTREE_GC_LOC(sf, i));
- READER_PTREE_CLOSURE(sf, i) = XEN_UNDEFINED;
- READER_PTREE_GC_LOC(sf, i) = NOT_A_GC_LOC;
- }
- }
- if (READER_PTREE_LIST(sf)) free(READER_PTREE_LIST(sf));
- free(sf->ptrees);
- sf->ptrees = NULL;
- }
-
if (sf->mixes)
sf->mixes = (void *)free_reader_mixes((reader_mixes *)(sf->mixes));
@@ -6147,6 +4991,46 @@ mus_long_t current_location(snd_fd *sf)
}
+void sampler_set_safe(snd_fd *sf, mus_long_t dur)
+{
+ /* tricky because we currently assume the reader protects against reading off the end by returning 0.0,
+ * perhaps pass in dur (= number of samples we will be reading), and if last-loc+1>=dur, we're safe?
+ * dur here has to match the number of samples we will read!
+ */
+
+ /* fprintf(stderr, "%lld %lld %lld: %lld\n", sf->first, sf->loc, sf->last, dur); */
+
+ if ((sf->last - sf->loc + 1) >= dur) /* two kinds of counter here: last is sample number, dur is how many samples */
+ {
+ if (sf->runf == next_sample_value_unscaled)
+ sf->runf = next_sample_value_unscaled_and_unchecked;
+ else
+ {
+ if (sf->runf == next_sample_value)
+ sf->runf = next_sample_value_unchecked;
+ else
+ {
+ if (sf->runf == next_ramp1)
+ sf->runf = next_ramp1_unchecked;
+ }
+ }
+ }
+ else
+ {
+ if (sf->loc - sf->first + 1 >= dur)
+ {
+ if (sf->runf == previous_sample_value_unscaled)
+ sf->runf = previous_sample_value_unscaled_and_unchecked;
+ else
+ {
+ if (sf->runf == previous_sample_value)
+ sf->runf = previous_sample_value_unchecked;
+ }
+ }
+ }
+}
+
+
snd_fd *init_sample_read_any_with_bufsize(mus_long_t samp, chan_info *cp, read_direction_t direction, int edit_position, int bufsize)
{
snd_fd *sf;
@@ -6155,6 +5039,7 @@ snd_fd *init_sample_read_any_with_bufsize(mus_long_t samp, chan_info *cp, read_d
int len, i;
mus_long_t curlen;
snd_data *first_snd = NULL;
+ /* bufsize might be ignored here except in the copied buffer case -- we use the pre-exisiting buffer? */
if (cp->active < CHANNEL_HAS_EDIT_LIST) return(NULL);
if ((edit_position < 0) || (edit_position >= cp->edit_size)) return(NULL); /* was ">" not ">=": 6-Jan-05 */
@@ -6196,7 +5081,7 @@ snd_fd *init_sample_read_any_with_bufsize(mus_long_t samp, chan_info *cp, read_d
sf->type = SAMPLER;
sf->initial_samp = samp;
sf->cp = cp;
- sf->fscaler = MUS_FIX_TO_FLOAT;
+ sf->fscaler = 1.0;
sf->direction = direction;
sf->current_state = ed;
sf->edit_ctr = edit_position;
@@ -6223,7 +5108,7 @@ snd_fd *init_sample_read_any_with_bufsize(mus_long_t samp, chan_info *cp, read_d
ind0 = READER_LOCAL_POSITION(sf); /* cb->beg */
indx = ind0 + sf->frag_pos;
ind1 = READER_LOCAL_END(sf); /* cb->end */
- sf->fscaler = MUS_FIX_TO_FLOAT * READER_SCALER(sf);
+ sf->fscaler = READER_SCALER(sf);
if (zero_op(READER_TYPE(sf)))
{
sf->current_sound = NULL;
@@ -6245,10 +5130,13 @@ snd_fd *init_sample_read_any_with_bufsize(mus_long_t samp, chan_info *cp, read_d
* samplers (they trust their snd_fd indices); we wouldn't want to be
* constantly jumping around and re-reading data buffers (in the worst case
* many times per sample) anyway, so we copy the IO buffer, allocate a relatively
- * small data buffer, and then free all the copied snd_data stuff as soon as
+ * small(?? -- is this obsolete) data buffer, and then free all the copied snd_data stuff as soon as
* the current reader is done.
+ *
+ * but if all the data is in the current buffer, it won't be moving?
*/
- if (first_snd->inuse)
+ if ((first_snd->inuse) ||
+ (bufsize > FILE_BUFFER_SIZE))
{
first_snd = copy_snd_data(first_snd, samp, bufsize);
if (!first_snd)
@@ -6280,13 +5168,13 @@ snd_fd *init_sample_read_any_with_bufsize(mus_long_t samp, chan_info *cp, read_d
snd_fd *init_sample_read_any(mus_long_t samp, chan_info *cp, read_direction_t direction, int edit_position)
{
- return(init_sample_read_any_with_bufsize(samp, cp, direction, edit_position, MIX_FILE_BUFFER_SIZE));
+ return(init_sample_read_any_with_bufsize(samp, cp, direction, edit_position, FILE_BUFFER_SIZE));
}
snd_fd *init_sample_read(mus_long_t samp, chan_info *cp, read_direction_t direction)
{
- return(init_sample_read_any_with_bufsize(samp, cp, direction, cp->edit_ctr, MIX_FILE_BUFFER_SIZE));
+ return(init_sample_read_any_with_bufsize(samp, cp, direction, cp->edit_ctr, FILE_BUFFER_SIZE));
}
@@ -6309,7 +5197,7 @@ mus_float_t chn_sample(mus_long_t samp, chan_info *cp, int pos)
snd_data *sd;
sd = cp->sounds[0];
if ((sd) && (sd->io) && (io_beg(sd->io) <= samp) && (io_end(sd->io) >= samp))
- return(MUS_SAMPLE_TO_FLOAT(sd->buffered_data[samp - io_beg(sd->io)]));
+ return(sd->buffered_data[samp - io_beg(sd->io)]);
}
/* do it the hard way */
@@ -6325,7 +5213,7 @@ mus_float_t chn_sample(mus_long_t samp, chan_info *cp, int pos)
static void previous_sound_1(snd_fd *sf)
{
- mus_long_t ind0, ind1, indx;
+ mus_long_t ind0, ind1;
bool at_start;
if ((sf->cp) &&
(sf->cp->active < CHANNEL_HAS_EDIT_LIST))
@@ -6356,7 +5244,7 @@ static void previous_sound_1(snd_fd *sf)
sf->cb = FRAGMENT((sf->current_state), sf->cbi);
ind0 = READER_LOCAL_POSITION(sf);
ind1 = READER_LOCAL_END(sf);
- sf->fscaler = MUS_FIX_TO_FLOAT * READER_SCALER(sf);
+ sf->fscaler = READER_SCALER(sf);
if (zero_op(READER_TYPE(sf)))
{
sf->current_sound = NULL;
@@ -6372,7 +5260,7 @@ static void previous_sound_1(snd_fd *sf)
{
if (prev_snd->inuse)
{
- prev_snd = copy_snd_data(prev_snd, ind0, MIX_FILE_BUFFER_SIZE);
+ prev_snd = copy_snd_data(prev_snd, ind0, FILE_BUFFER_SIZE);
if (prev_snd == NULL)
{
/* too many files open or something of that sort */
@@ -6398,6 +5286,7 @@ static void previous_sound_1(snd_fd *sf)
}
else
{
+ mus_long_t indx;
/* back up in current file */
ind0 = READER_LOCAL_POSITION(sf);
ind1 = READER_LOCAL_END(sf);
@@ -6416,7 +5305,7 @@ static mus_float_t previous_sound(snd_fd *sf)
static void next_sound_1(snd_fd *sf)
{
- mus_long_t ind0, ind1, indx;
+ mus_long_t ind0, ind1;
bool at_end = false;
if ((sf->cp) &&
@@ -6454,7 +5343,7 @@ static void next_sound_1(snd_fd *sf)
}
ind0 = READER_LOCAL_POSITION(sf);
ind1 = READER_LOCAL_END(sf);
- sf->fscaler = MUS_FIX_TO_FLOAT * READER_SCALER(sf);
+ sf->fscaler = READER_SCALER(sf);
if (zero_op(READER_TYPE(sf)))
{
sf->current_sound = NULL;
@@ -6470,7 +5359,7 @@ static void next_sound_1(snd_fd *sf)
{
if (nxt_snd->inuse)
{
- nxt_snd = copy_snd_data(nxt_snd, ind0, MIX_FILE_BUFFER_SIZE);
+ nxt_snd = copy_snd_data(nxt_snd, ind0, FILE_BUFFER_SIZE);
if (nxt_snd == NULL)
{
reader_out_of_data(sf);
@@ -6495,6 +5384,7 @@ static void next_sound_1(snd_fd *sf)
}
else
{
+ mus_long_t indx;
ind0 = READER_LOCAL_POSITION(sf);
ind1 = READER_LOCAL_END(sf);
indx = io_end(sf->current_sound->io) + 1;
@@ -6527,7 +5417,7 @@ void copy_then_swap_channels(chan_info *cp0, chan_info *cp1, int pos0, int pos1)
fd = snd_open_read(name);
snd_file_open_descriptors(fd,
name,
- hdr0->format,
+ hdr0->sample_type,
hdr0->data_location,
hdr0->chans,
hdr0->type);
@@ -6539,7 +5429,7 @@ void copy_then_swap_channels(chan_info *cp0, chan_info *cp1, int pos0, int pos1)
fd = snd_open_read(name);
snd_file_open_descriptors(fd,
name,
- hdr1->format,
+ hdr1->sample_type,
hdr1->data_location,
hdr1->chans,
hdr1->type);
@@ -6559,7 +5449,7 @@ void copy_then_swap_channels(chan_info *cp0, chan_info *cp1, int pos0, int pos1)
new_ed->cursor = old_ed->cursor;
new_ed->beg = 0;
new_ed->len = old_ed->len;
- new_ed->origin = mus_strdup(TO_PROC_NAME(S_swap_channels));
+ new_ed->origin = mus_strdup(to_proc_name(S_swap_channels));
cp0->edits[cp0->edit_ctr] = new_ed;
if (new_ed->len > 0)
for (i = 0; i < new_ed->size; i++)
@@ -6578,7 +5468,7 @@ void copy_then_swap_channels(chan_info *cp0, chan_info *cp1, int pos0, int pos1)
new_ed->len = old_ed->len;
new_ed->samples = old_ed->samples;
new_ed->cursor = old_ed->cursor;
- new_ed->origin = mus_strdup(TO_PROC_NAME(S_swap_channels)); /* swap = stored change-edit at restore time, so no redundancy here */
+ new_ed->origin = mus_strdup(to_proc_name(S_swap_channels)); /* swap = stored change-edit at restore time, so no redundancy here */
cp1->edits[cp1->edit_ctr] = new_ed;
if (new_ed->len > 0)
for (i = 0; i < new_ed->size; i++)
@@ -6623,44 +5513,76 @@ io_error_t save_edits_and_update_display(snd_info *sp)
int i;
mus_long_t samples = 0;
mus_long_t *old_cursors = NULL;
- chan_info *cp;
- void *ms, *sa;
+ void *ms;
+ axes_data *sa;
file_info *sphdr = NULL;
io_error_t io_err = IO_NO_ERROR;
+ snd_fd **sf;
+ mus_float_t *vals = NULL;
+ mus_long_t *times = NULL;
+ bool have_maxamps = true;
if (dont_save(sp, NULL)) return(IO_SAVE_HOOK_CANCELLATION);
ofile = snd_tempnam();
/* this will use user's TMPDIR if temp_dir(ss) is not set, else stdio.h's P_tmpdir else /tmp */
- {
- snd_fd **sf;
- sf = (snd_fd **)calloc(sp->nchans, sizeof(snd_fd *));
- for (i = 0; i < sp->nchans; i++)
- {
- sf[i] = init_sample_read(0, sp->chans[i], READ_FORWARD);
- if (sf[i] == NULL)
- {
- int j;
- for (j = 0; j < i; j++) free_snd_fd(sf[j]);
- free(sf);
- return(IO_BAD_CHANNEL);
- }
- if (samples < CURRENT_SAMPLES(sp->chans[i]))
- samples = CURRENT_SAMPLES(sp->chans[i]);
- }
-
- /* write the new file */
- io_err = snd_make_file(ofile, sp->nchans, sp->hdr, sf, samples, true);
- for (i = 0; i < sp->nchans; i++) free_snd_fd(sf[i]);
- free(sf);
- sf = NULL;
- if (io_err != IO_NO_ERROR)
- {
- if (ofile) free(ofile);
- return(io_err);
- }
- }
-
+ for (i = 0; i < sp->nchans; i++)
+ {
+ chan_info *ncp;
+ ncp = sp->chans[i];
+ if ((ed_maxamp(ncp, ncp->edit_ctr) < 0.0) ||
+ (ed_maxamp_position(ncp, ncp->edit_ctr) < 0))
+ {
+ have_maxamps = false;
+ break;
+ }
+ }
+ if (have_maxamps)
+ {
+ vals = (mus_float_t *)calloc(sp->nchans, sizeof(mus_float_t));
+ times = (mus_long_t *)calloc(sp->nchans, sizeof(mus_long_t));
+ for (i = 0; i < sp->nchans; i++)
+ {
+ chan_info *ncp;
+ ncp = sp->chans[i];
+ vals[i] = ed_maxamp(ncp, ncp->edit_ctr);
+ times[i] = ed_maxamp_position(ncp, ncp->edit_ctr);
+ }
+ }
+
+ sf = (snd_fd **)calloc(sp->nchans, sizeof(snd_fd *));
+ for (i = 0; i < sp->nchans; i++)
+ {
+ sf[i] = init_sample_read(0, sp->chans[i], READ_FORWARD);
+ if (sf[i] == NULL)
+ {
+ int j;
+ for (j = 0; j < i; j++) free_snd_fd(sf[j]);
+ free(sf);
+ if (vals) free(vals);
+ if (times) free(times);
+ return(IO_BAD_CHANNEL);
+ }
+ if (samples < current_samples(sp->chans[i]))
+ samples = current_samples(sp->chans[i]);
+ }
+
+ /* write the new file */
+ io_err = snd_make_file(ofile, sp->nchans, sp->hdr, sf, samples, true);
+ for (i = 0; i < sp->nchans; i++) free_snd_fd(sf[i]);
+ free(sf);
+ sf = NULL;
+ if (io_err != IO_NO_ERROR)
+ {
+ if (ofile) free(ofile);
+ if (vals)
+ {
+ free(vals);
+ free(times);
+ }
+ return(io_err);
+ }
+
sa = make_axes_data(sp);
sphdr = sp->hdr;
sphdr->samples = samples * sp->nchans;
@@ -6668,8 +5590,9 @@ io_error_t save_edits_and_update_display(snd_info *sp)
old_cursors = (mus_long_t *)calloc(sp->nchans, sizeof(mus_long_t));
for (i = 0; i < sp->nchans; i++)
{
+ chan_info *cp;
cp = sp->chans[i];
- old_cursors[i] = CURSOR(cp); /* depends on edit_ctr -- set to -1 by free_edit_list below */
+ old_cursors[i] = cursor_sample(cp); /* depends on edit_ctr -- set to -1 by free_edit_list below */
if (ss->deferred_regions > 0)
sequester_deferred_regions(cp, -1);
if (cp->edits) free_edit_list(cp); /* sets cp->edits to NULL */
@@ -6677,16 +5600,21 @@ io_error_t save_edits_and_update_display(snd_info *sp)
cp->axis = free_axis_info(cp->axis);
}
-#if (HAVE_ACCESS)
+#ifndef _MSC_VER
if (access(sp->filename, W_OK))
{
sa = free_axes_data(sa);
if (ofile) free(ofile);
if (old_cursors) free(old_cursors);
+ if (vals)
+ {
+ free(vals);
+ free(times);
+ }
return(IO_WRITE_PROTECTED);
}
#endif
-
+
mus_sound_forget(sp->filename);
sp->writing = true;
io_err = move_file(ofile, sp->filename); /* should we cancel and restart a monitor? */
@@ -6695,16 +5623,27 @@ io_error_t save_edits_and_update_display(snd_info *sp)
{
if (ofile) free(ofile);
if (old_cursors) free(old_cursors);
+ if (vals)
+ {
+ free(vals);
+ free(times);
+ }
return(io_err);
}
+ if (vals)
+ {
+ mus_sound_set_maxamps(sp->filename, sp->nchans, vals, times);
+ free(vals);
+ free(times);
+ }
sp->write_date = file_write_date(sp->filename);
add_sound_data(sp->filename, sp, WITHOUT_INITIAL_GRAPH_HOOK);
restore_axes_data(sp, sa, mus_sound_duration(sp->filename), true);
sound_restore_marks(sp, ms);
sa = free_axes_data(sa);
for (i = 0; i < sp->nchans; i++)
- CURSOR(sp->chans[i]) = old_cursors[i];
+ cursor_sample(sp->chans[i]) = old_cursors[i];
free(old_cursors);
reflect_file_revert_in_label(sp);
if (ofile)
@@ -6712,30 +5651,34 @@ io_error_t save_edits_and_update_display(snd_info *sp)
free(ofile);
ofile = NULL;
}
- if (!(ss->fam_ok))
+ if (!(ss->file_monitor_ok))
if (auto_update(ss))
for_each_sound(sound_not_current);
return(IO_NO_ERROR);
}
-io_error_t save_edits_without_display(snd_info *sp, const char *new_name, int type, int format, int srate, const char *comment, int pos)
+io_error_t save_edits_without_display(snd_info *sp, const char *new_name, mus_header_t type,
+ mus_sample_t sample_type, int srate, const char *comment, int pos)
{
- /* assume we've already checked for (over)write permissions, and header-type+data-format writable,
+ /* assume we've already checked for (over)write permissions, and header-type+sample-type writable,
*/
file_info *hdr;
snd_fd **sf;
- mus_long_t frames = 0;
+ mus_long_t framples = 0;
int i;
file_info *ohdr;
io_error_t err = IO_NO_ERROR;
+ mus_float_t *vals = NULL;
+ mus_long_t *times = NULL;
+ bool have_maxamps = true;
if (dont_save(sp, new_name))
return(IO_SAVE_HOOK_CANCELLATION);
ohdr = sp->hdr;
hdr = copy_header(new_name, ohdr);
- hdr->format = format;
+ hdr->sample_type = sample_type;
hdr->srate = srate;
hdr->type = type;
if (comment)
@@ -6743,6 +5686,30 @@ io_error_t save_edits_without_display(snd_info *sp, const char *new_name, int ty
else hdr->comment = NULL;
hdr->data_location = 0; /* in case comment changes it */
+ for (i = 0; i < sp->nchans; i++)
+ {
+ chan_info *ncp;
+ ncp = sp->chans[i];
+ if ((ed_maxamp(ncp, ncp->edit_ctr) < 0.0) ||
+ (ed_maxamp_position(ncp, ncp->edit_ctr) < 0))
+ {
+ have_maxamps = false;
+ break;
+ }
+ }
+ if (have_maxamps)
+ {
+ vals = (mus_float_t *)calloc(sp->nchans, sizeof(mus_float_t));
+ times = (mus_long_t *)calloc(sp->nchans, sizeof(mus_long_t));
+ for (i = 0; i < sp->nchans; i++)
+ {
+ chan_info *ncp;
+ ncp = sp->chans[i];
+ vals[i] = ed_maxamp(ncp, ncp->edit_ctr);
+ times[i] = ed_maxamp_position(ncp, ncp->edit_ctr);
+ }
+ }
+
sf = (snd_fd **)malloc(sp->nchans * sizeof(snd_fd *));
for (i = 0; i < sp->nchans; i++)
{
@@ -6750,7 +5717,7 @@ io_error_t save_edits_without_display(snd_info *sp, const char *new_name, int ty
int local_pos;
cp = sp->chans[i];
if (pos == AT_CURRENT_EDIT_POSITION) local_pos = cp->edit_ctr; else local_pos = pos;
- if (frames < cp->edits[local_pos]->samples) frames = cp->edits[local_pos]->samples;
+ if (framples < cp->edits[local_pos]->samples) framples = cp->edits[local_pos]->samples;
sf[i] = init_sample_read_any(0, cp, READ_FORWARD, local_pos);
if (sf[i] == NULL)
{
@@ -6761,11 +5728,23 @@ io_error_t save_edits_without_display(snd_info *sp, const char *new_name, int ty
free(sf);
sf = NULL;
hdr = free_file_info(hdr);
+ if (vals)
+ {
+ free(vals);
+ free(times);
+ }
return(err);
}
}
- err = snd_make_file(new_name, sp->nchans, hdr, sf, frames, true);
+ err = snd_make_file(new_name, sp->nchans, hdr, sf, framples, true);
+ if (vals)
+ {
+ if (err == IO_NO_ERROR)
+ mus_sound_set_maxamps(new_name, sp->nchans, vals, times);
+ free(vals);
+ free(times);
+ }
for (i = 0; i < sp->nchans; i++)
free_snd_fd(sf[i]);
@@ -6802,7 +5781,7 @@ io_error_t save_channel_edits(chan_info *cp, const char *ofile, int pos)
snd_update(sp);
else
{
- if (SERIOUS_IO_ERROR(err))
+ if (is_serious_io_error(err))
{
free(nfile);
nfile = NULL;
@@ -6846,6 +5825,7 @@ static io_error_t save_edits_1(snd_info *sp, bool ask)
/* check for change to file while we were editing it */
current_write_date = file_write_date(sp->filename);
/* returns -1 if file does not exist (stat -> -1) */
+
if (current_write_date < 0)
{
snd_error("can't save edits; %s has disappeared!", sp->filename);
@@ -6853,10 +5833,15 @@ static io_error_t save_edits_1(snd_info *sp, bool ask)
return(IO_CANT_OPEN_FILE);
}
if ((ask) &&
- (ask_before_overwrite(ss)) &&
((current_write_date - sp->write_date) > 1)) /* In Redhat 7.1 these can differ by 1?? Surely this is a bug! */
- return(IO_NEED_WRITE_CONFIRMATION); /* see snd-kbd.c save_edits_with_prompt for the rest of this */
+ return(IO_NEED_WRITE_CONFIRMATION); /* see snd-kbd.c save_edits_from_kbd for the rest of this */
+
+ /* this used to include ask_before_overwrite, but I don't think that is relevant. If the file
+ * has changed from what we think it is, we have a problem -- the save is unlikely to do anything useful.
+ */
+
err = save_edits_and_update_display(sp);
+
if (err == IO_NO_ERROR)
{
if (sp->edited_region)
@@ -6880,29 +5865,24 @@ io_error_t save_edits_without_asking(snd_info *sp)
void revert_edits(chan_info *cp)
{
- int old_ctr;
if (cp->edit_ctr == 0) return;
- old_ctr = cp->edit_ctr;
cp->edit_ctr = 0;
clear_transform_edit_ctrs(cp);
reflect_edit_counter_change(cp);
reflect_sample_change_in_axis(cp);
+ enved_reflect_selection(selection_is_active());
+ reflect_selection_in_save_as_dialog(selection_is_active());
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_IN_DOUBT)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
update_graph(cp);
reflect_mix_change(ANY_MIX_ID);
reflect_enved_fft_change(cp);
if ((cp->hookable == WITH_HOOK) &&
- (XEN_HOOK_P(cp->undo_hook)) &&
- (XEN_HOOKED(cp->undo_hook)))
- run_hook(cp->undo_hook, XEN_EMPTY_LIST, S_undo_hook);
+ (Xen_is_hook(cp->undo_hook)) &&
+ (Xen_hook_has_list(cp->undo_hook)))
+ run_hook(cp->undo_hook, Xen_empty_list, S_undo_hook);
}
@@ -6921,26 +5901,23 @@ bool undo_edit(chan_info *cp, int count)
clear_transform_edit_ctrs(cp);
reflect_edit_counter_change(cp);
reflect_sample_change_in_axis(cp);
+ enved_reflect_selection(selection_is_active());
+ reflect_selection_in_save_as_dialog(selection_is_active());
if (cp->edit_ctr == 0)
{
reflect_file_revert_in_label(sp);
}
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_IN_DOUBT)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
update_graph(cp);
reflect_mix_change(ANY_MIX_ID);
reflect_enved_fft_change(cp);
if ((cp->hookable == WITH_HOOK) &&
- (XEN_HOOK_P(cp->undo_hook)) &&
- (XEN_HOOKED(cp->undo_hook)))
- run_hook(cp->undo_hook, XEN_EMPTY_LIST, S_undo_hook);
+ (Xen_is_hook(cp->undo_hook)) &&
+ (Xen_hook_has_list(cp->undo_hook)))
+ run_hook(cp->undo_hook, Xen_empty_list, S_undo_hook);
return(true);
}
return(false);
@@ -6999,22 +5976,19 @@ bool redo_edit(chan_info *cp, int count)
reflect_file_change_in_label(cp);
reflect_edit_counter_change(cp);
reflect_sample_change_in_axis(cp);
+ enved_reflect_selection(selection_is_active());
+ reflect_selection_in_save_as_dialog(selection_is_active());
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_IN_DOUBT)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
update_graph(cp);
reflect_mix_change(ANY_MIX_ID);
reflect_enved_fft_change(cp);
if ((cp->hookable == WITH_HOOK) &&
- (XEN_HOOK_P(cp->undo_hook)) &&
- (XEN_HOOKED(cp->undo_hook)))
- run_hook(cp->undo_hook, XEN_EMPTY_LIST, S_undo_hook);
+ (Xen_is_hook(cp->undo_hook)) &&
+ (Xen_hook_has_list(cp->undo_hook)))
+ run_hook(cp->undo_hook, Xen_empty_list, S_undo_hook);
return(true);
}
}
@@ -7055,10 +6029,10 @@ bool redo_edit_with_sync(chan_info *cp, int count)
/* -------------------- virtual mixes -------------------- */
-/* ramp on mix is techically possible, but ambiguous -- currently if we mix, then ramp elsewhere, then drag the mix
+/* ramp on mix is technically possible, but ambiguous -- currently if we mix, then ramp elsewhere, then drag the mix
* to the ramped portion, the mix treats the ramp as prior data (adding); if we had ramp_mix, it would want to
* treat that ramp as an envelope on the mix if the ramp happened after the mix was established but as data if before.
- * Too tricky (and ptrees make it worse). (We'd also need ED_RAMP_ZERO to make clean fixups upon drag and so on).
+ * Too tricky. (We'd also need ED_RAMP_ZERO to make clean fixups upon drag and so on).
* Three times and out so far...
* ...
* but, if the envelope is global, it is not ambiguous, (except that we have scaled portions?) --
@@ -7161,7 +6135,7 @@ int mix_file_with_tag(chan_info *cp, const char *filename, int chan, mus_long_t
return(NO_MIX_TAG);
edpos = cp->edit_ctr;
- file_len = mus_sound_frames(filename);
+ file_len = mus_sound_framples(filename);
old_ed = cp->edits[edpos];
if ((beg < 0) ||
@@ -7186,7 +6160,7 @@ int mix_file_with_tag(chan_info *cp, const char *filename, int chan, mus_long_t
fd = snd_open_read(filename);
snd_file_open_descriptors(fd,
filename,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
@@ -7215,7 +6189,7 @@ int mix_file_with_tag(chan_info *cp, const char *filename, int chan, mus_long_t
}
-int mix_buffer_with_tag(chan_info *cp, mus_sample_t *data, mus_long_t beg, mus_long_t buf_len, const char *origin)
+int mix_buffer_with_tag(chan_info *cp, mus_float_t *data, mus_long_t beg, mus_long_t buf_len, const char *origin)
{
int edpos, mix_loc;
mus_long_t old_len, new_len;
@@ -7414,10 +6388,11 @@ snd_fd *make_virtual_mix_reader(chan_info *cp, mus_long_t beg, mus_long_t len, i
sf->edit_ctr = 0;
first_snd = cp->sounds[index];
sf->frag_pos = 0;
+
ind0 = 0;
indx = beg;
ind1 = len - 1; /* ind1 (LOCAL_END...) is a sample number, not a length */
- sf->fscaler = scl * MUS_FIX_TO_FLOAT;
+ sf->fscaler = scl;
if ((scl == 1.0) &&
(sf->fscaler == 1.0))
@@ -7447,7 +6422,7 @@ snd_fd *make_virtual_mix_reader(chan_info *cp, mus_long_t beg, mus_long_t len, i
if (first_snd->inuse)
{
- first_snd = copy_snd_data(first_snd, beg, MIX_FILE_BUFFER_SIZE);
+ first_snd = copy_snd_data(first_snd, beg, FILE_BUFFER_SIZE);
if (!first_snd)
return(cancel_reader(sf));
}
@@ -7610,32 +6585,29 @@ void end_mix_op(chan_info *cp, mus_long_t old_beg, mus_long_t old_len)
/* ----------------------- Xen connection -------------------------------- */
-static XEN g_display_edits(XEN snd, XEN chn, XEN edpos, XEN with_source)
+static Xen g_display_edits(Xen snd, Xen chn, Xen edpos)
{
- #define H_display_edits "(" S_display_edits " :optional snd chn edpos (with-source " PROC_TRUE ")): current edit tree"
+ #define H_display_edits "(" S_display_edits " :optional snd chn edpos): current edit tree"
FILE *tmp = NULL;
char *buf, *name;
chan_info *cp;
int fd, pos = AT_CURRENT_EDIT_POSITION;
- bool include_source = true;
mus_long_t len;
- XEN res;
+ Xen res;
ssize_t bytes;
- ASSERT_CHANNEL(S_display_edits, snd, chn, 1);
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(with_source), with_source, XEN_ARG_4, S_display_edits, "boolean");
+ Snd_assert_channel(S_display_edits, snd, chn, 1);
cp = get_cp(snd, chn, S_display_edits);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- if (XEN_BOOLEAN_P(with_source)) include_source = XEN_TO_C_BOOLEAN(with_source);
- if (XEN_INTEGER_P(edpos))
+ if (Xen_is_integer(edpos))
{
- pos = XEN_TO_C_INT(edpos);
+ pos = Xen_integer_to_C_int(edpos);
if (pos == AT_CURRENT_EDIT_POSITION)
pos = cp->edit_ctr;
if ((pos < 0) || (pos >= cp->edit_size) || (!(cp->edits[pos])))
- XEN_ERROR(NO_SUCH_EDIT,
- XEN_LIST_2(C_TO_XEN_STRING(S_display_edits ": no such edit: ~A"),
+ Xen_error(NO_SUCH_EDIT,
+ Xen_list_2(C_string_to_Xen_string(S_display_edits ": no such edit: ~A"),
edpos));
}
name = snd_tempnam();
@@ -7643,14 +6615,14 @@ static XEN g_display_edits(XEN snd, XEN chn, XEN edpos, XEN with_source)
if (tmp)
{
if (pos != AT_CURRENT_EDIT_POSITION)
- display_ed_list(cp, tmp, pos, cp->edits[pos], include_source);
- else display_edits(cp, tmp, include_source);
+ display_ed_list(cp, tmp, pos, cp->edits[pos]);
+ else display_edits(cp, tmp);
snd_fclose(tmp, name);
}
- else XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_display_edits ": can't save ~S, ~A"),
- C_TO_XEN_STRING(name),
- C_TO_XEN_STRING(snd_io_strerror())));
+ else Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_display_edits ": can't save ~S, ~A"),
+ C_string_to_Xen_string(name),
+ C_string_to_Xen_string(snd_io_strerror())));
fd = mus_file_open_read(name);
len = lseek(fd, 0L, SEEK_END);
buf = (char *)calloc(len + 1, sizeof(char));
@@ -7660,45 +6632,45 @@ static XEN g_display_edits(XEN snd, XEN chn, XEN edpos, XEN with_source)
snd_remove(name, IGNORE_CACHE);
if (name) free(name);
if (bytes != 0)
- res = C_TO_XEN_STRING(buf);
- else res = C_STRING_TO_XEN_SYMBOL("read-error");
+ res = C_string_to_Xen_string(buf);
+ else res = C_string_to_Xen_symbol("read-error");
free(buf);
return(res);
}
-static XEN g_edit_fragment(XEN uctr, XEN snd, XEN chn)
+static Xen g_edit_fragment(Xen uctr, Xen snd, Xen chn)
{
#define H_edit_fragment "(" S_edit_fragment " :optional (ctr " S_current_edit_position ") snd chn): edit history entry at ctr \
associated with snd's channel chn; the returned value is a list (origin type start-sample samps)"
chan_info *cp;
int ctr;
- ASSERT_CHANNEL(S_edit_fragment, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(uctr), uctr, XEN_ARG_1, S_edit_fragment, "an integer");
+ Snd_assert_channel(S_edit_fragment, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(uctr), uctr, 1, S_edit_fragment, "an integer");
cp = get_cp(snd, chn, S_edit_fragment);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- ctr = XEN_TO_C_INT_OR_ELSE(uctr, cp->edit_ctr);
+ ctr = (Xen_is_integer(uctr)) ? Xen_integer_to_C_int(uctr) : cp->edit_ctr;
if ((ctr < cp->edit_size) &&
(ctr >= 0))
{
ed_list *ed;
ed = cp->edits[ctr];
if (ed)
- return(XEN_LIST_4(C_TO_XEN_STRING(ed->origin),
- C_TO_XEN_STRING(edit_names[(int)(ed->edit_type)]),
- C_TO_XEN_INT64_T(ed->beg),
- C_TO_XEN_INT64_T(ed->len)));
+ return(Xen_list_4(C_string_to_Xen_string(ed->origin),
+ C_string_to_Xen_string(edit_names[(int)(ed->edit_type)]),
+ C_llong_to_Xen_llong(ed->beg),
+ C_llong_to_Xen_llong(ed->len)));
}
- XEN_ERROR(NO_SUCH_EDIT,
- XEN_LIST_2(C_TO_XEN_STRING(S_edit_fragment ": no such edit ~A"),
+ Xen_error(NO_SUCH_EDIT,
+ Xen_list_2(C_string_to_Xen_string(S_edit_fragment ": no such edit ~A"),
uctr));
return(uctr);
}
-static XEN g_edit_tree(XEN snd, XEN chn, XEN upos)
+static Xen g_edit_tree(Xen snd, Xen chn, Xen upos)
{
#define H_edit_tree "(" S_edit_tree " :optional snd chn edpos): \
the edit lists '((global-pos data-num local-pos local-end scaler rmp0 rmp1 type-name)...)"
@@ -7706,11 +6678,11 @@ the edit lists '((global-pos data-num local-pos local-end scaler rmp0 rmp1 type-
int i, len, pos;
chan_info *cp;
ed_list *eds;
- XEN res = XEN_EMPTY_LIST;
+ Xen res = Xen_empty_list;
- ASSERT_CHANNEL(S_edit_tree, snd, chn, 1);
+ Snd_assert_channel(S_edit_tree, snd, chn, 1);
cp = get_cp(snd, chn, S_edit_tree);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, upos, S_edit_tree, 3);
eds = cp->edits[pos];
len = eds->size; /* fragments in this list */
@@ -7730,14 +6702,14 @@ the edit lists '((global-pos data-num local-pos local-end scaler rmp0 rmp1 type-
rbeg = 0.0;
rend = 0.0;
}
- res = XEN_CONS(XEN_LIST_8(C_TO_XEN_INT64_T(ED_GLOBAL_POSITION(ed)),
- C_TO_XEN_INT(ED_SOUND(ed)),
- C_TO_XEN_INT64_T(ED_LOCAL_POSITION(ed)),
- C_TO_XEN_INT64_T(ED_LOCAL_END(ed)),
- C_TO_XEN_DOUBLE(ED_SCALER(ed)),
- C_TO_XEN_DOUBLE(rbeg),
- C_TO_XEN_DOUBLE(rend),
- C_TO_XEN_INT(ED_TYPE(ed))),
+ res = Xen_cons(Xen_list_8(C_llong_to_Xen_llong(ED_GLOBAL_POSITION(ed)),
+ C_int_to_Xen_integer(ED_SOUND(ed)),
+ C_llong_to_Xen_llong(ED_LOCAL_POSITION(ed)),
+ C_llong_to_Xen_llong(ED_LOCAL_END(ed)),
+ C_double_to_Xen_real(ED_SCALER(ed)),
+ C_double_to_Xen_real(rbeg),
+ C_double_to_Xen_real(rend),
+ C_int_to_Xen_integer(ED_TYPE(ed))),
res);
}
return(res);
@@ -7745,32 +6717,30 @@ the edit lists '((global-pos data-num local-pos local-end scaler rmp0 rmp1 type-
#define S_edit_fragment_type_name "edit-fragment-type-name"
-static XEN g_edit_fragment_type_name(XEN type)
+static Xen g_edit_fragment_type_name(Xen type)
{
int typ;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(type), type, XEN_ONLY_ARG, S_edit_fragment_type_name, "an int");
- typ = XEN_TO_C_INT(type);
+ Xen_check_type(Xen_is_integer(type), type, 1, S_edit_fragment_type_name, "an int");
+ typ = Xen_integer_to_C_int(type);
if ((typ >= 0) && (typ < NUM_OPS))
- return(C_TO_XEN_STRING(type_info[typ].name));
- return(XEN_FALSE);
+ return(C_string_to_Xen_string(type_info[typ].name));
+ return(Xen_false);
}
/* ---------------- samplers ---------------- */
-static XEN_OBJECT_TYPE sf_tag;
-
-bool sampler_p(XEN obj) {return(XEN_OBJECT_TYPE_P(obj, sf_tag));}
+static Xen_object_type_t sf_tag;
-#define SAMPLER_P(Obj) XEN_OBJECT_TYPE_P(Obj, sf_tag)
+bool is_sampler(Xen obj) {return(Xen_c_object_is_type(obj, sf_tag));}
-#define ANY_SAMPLER_P(Obj) ((sampler_p(Obj)) || (mix_sampler_p(Obj)))
+#define is_any_sampler(Obj) ((is_sampler(Obj)) || (is_mix_sampler(Obj)))
-snd_fd *xen_to_sampler(XEN obj) {if (SAMPLER_P(obj)) return((snd_fd *)XEN_OBJECT_REF(obj)); else return(NULL);}
+snd_fd *xen_to_sampler(Xen obj) {if (is_sampler(obj)) return((snd_fd *)Xen_object_ref(obj)); else return(NULL);}
-#define XEN_TO_SAMPLER(obj) ((snd_fd *)XEN_OBJECT_REF(obj))
+#define Xen_to_C_sampler(obj) ((snd_fd *)Xen_object_ref(obj))
#if HAVE_SCHEME
@@ -7778,6 +6748,13 @@ static bool s7_equalp_sf(void *s1, void *s2)
{
return(s1 == s2);
}
+
+static s7_pointer length_sf(s7_scheme *sc, s7_pointer obj)
+{
+ snd_fd *fd;
+ fd = (snd_fd *)s7_object_value(obj);
+ return(s7_make_integer(sc, current_samples(fd->cp)));
+}
#endif
@@ -7820,15 +6797,15 @@ char *sampler_to_string(snd_fd *fd)
}
if (name == NULL) name = "unknown source";
if (fd->at_eof)
- mus_snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s at eof or freed>",
+ snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s at eof or freed>",
name);
else
{
if (cp)
- mus_snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s[%d: %d] from " MUS_LD ", at " MUS_LD ", %s>",
+ snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s[%d: %d] from %lld, at %lld, %s>",
name, cp->chan, fd->edit_ctr, fd->initial_samp, current_location(fd),
(fd->direction == READ_BACKWARD) ? "backward" : "forward");
- else mus_snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s from " MUS_LD ", at " MUS_LD ", %s>",
+ else snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s from %lld, at %lld, %s>",
name, fd->initial_samp, current_location(fd),
(fd->direction == READ_BACKWARD) ? "backward" : "forward");
}
@@ -7837,7 +6814,7 @@ char *sampler_to_string(snd_fd *fd)
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(snd_fd, print_sf, sampler_to_string)
+Xen_wrap_print(snd_fd, print_sf, sampler_to_string)
/* make-sampler can refer to any edit of any sound, user can subsequently
* either clobber that edit (undo, new edit), or close the sound, but forget
@@ -7851,10 +6828,10 @@ XEN_MAKE_OBJECT_PRINT_PROCEDURE(snd_fd, print_sf, sampler_to_string)
static void list_reader(snd_fd *fd)
{
ed_list *ed;
- int loc = -1;
ed = fd->current_state;
if (ed)
{
+ int loc = -1;
sf_info *lst = NULL;
if (ed->readers == NULL)
{
@@ -7892,6 +6869,7 @@ static void list_reader(snd_fd *fd)
static void unlist_reader(snd_fd *fd)
{
if ((fd) &&
+ (!(fd->freed)) &&
(fd->cp) &&
(fd->cp->active >= CHANNEL_HAS_EDIT_LIST) &&
(fd->current_state) &&
@@ -7929,144 +6907,144 @@ static void sf_free(snd_fd *fd)
}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(snd_fd, free_sf, sf_free)
+Xen_wrap_free(snd_fd, free_sf, sf_free)
/* sf_free is original, free_sf is wrapped form */
-static XEN g_sampler_at_end(XEN obj)
+static Xen g_sampler_at_end(Xen obj)
{
- #define H_sampler_at_end "(" S_sampler_at_end_p " obj): " PROC_TRUE " if sampler has reached the end of its data"
- XEN_ASSERT_TYPE(ANY_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_sampler_at_end_p, "a sampler (of any kind)");
+ #define H_sampler_at_end "(" S_is_sampler_at_end " obj): " PROC_TRUE " if sampler has reached the end of its data"
+ Xen_check_type(is_any_sampler(obj), obj, 1, S_is_sampler_at_end, "a sampler (of any kind)");
- if (sampler_p(obj))
+ if (is_sampler(obj))
{
snd_fd *sf;
- sf = XEN_TO_SAMPLER(obj);
- return(C_TO_XEN_BOOLEAN(sf->at_eof));
+ sf = Xen_to_C_sampler(obj);
+ return(C_bool_to_Xen_boolean(sf->at_eof));
}
- if (mix_sampler_p(obj))
- return(g_mix_sampler_at_end_p(obj));
+ if (is_mix_sampler(obj))
+ return(g_mix_sampler_is_at_end(obj));
- return(XEN_FALSE);
+ return(Xen_false);
}
/* can sampler-position be settable?
* this requires that we find the fragment that holds the new position (as at the start of init_sample_read_any_with_bufsize 6892)
* set the fragment bounds (ind0, ind1), call file_buffers_forward|backward
- * also check for reader_at_end complications, etc
+ * also check for reader_out_of_data complications, etc
* so, it's simpler and just as fast to require that the user make a new reader or use random access (channel->vct)
* (the only thing we avoid is choose_accessor)
*/
-static XEN g_sampler_position(XEN obj)
+static Xen g_sampler_position(Xen obj)
{
#define H_sampler_position "(" S_sampler_position " obj): current (sample-wise) location of sampler"
- XEN_ASSERT_TYPE(ANY_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_sampler_position, "a sampler (of any kind)");
+ Xen_check_type(is_any_sampler(obj), obj, 1, S_sampler_position, "a sampler (of any kind)");
- if (sampler_p(obj))
+ if (is_sampler(obj))
{
snd_fd *fd = NULL;
- fd = XEN_TO_SAMPLER(obj);
- if (fd->at_eof) return(XEN_ZERO); /* -1? frames? */
+ fd = Xen_to_C_sampler(obj);
+ if (fd->at_eof) return(Xen_integer_zero); /* -1? framples? */
if ((fd->cp) &&
(fd->cp->active >= CHANNEL_HAS_EDIT_LIST) &&
(fd->cp->sound))
{
if (fd->type == SAMPLER)
- return(C_TO_XEN_INT64_T(current_location(fd)));
- return(C_TO_XEN_INT64_T(region_current_location(fd)));
+ return(C_llong_to_Xen_llong(current_location(fd)));
+ return(C_llong_to_Xen_llong(region_current_location(fd)));
}
}
- if (mix_sampler_p(obj))
+ if (is_mix_sampler(obj))
return(g_mix_sampler_position(obj));
- return(XEN_ZERO);
+ return(Xen_integer_zero);
}
-static XEN g_sampler_home(XEN obj)
+static Xen g_sampler_home(Xen obj)
{
#define H_sampler_home "(" S_sampler_home " obj): (list sound-index chan-num) associated with a sound reader, or \
if 'obj' is a mix-sampler, the id of underlying mix"
- XEN_ASSERT_TYPE(ANY_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_sampler_home, "a sampler (of any kind)");
+ Xen_check_type(is_any_sampler(obj), obj, 1, S_sampler_home, "a sampler (of any kind)");
- if (sampler_p(obj))
+ if (is_sampler(obj))
{
snd_fd *fd = NULL;
- fd = XEN_TO_SAMPLER(obj);
+ fd = Xen_to_C_sampler(obj);
if ((fd->cp) &&
(fd->cp->active >= CHANNEL_HAS_EDIT_LIST) &&
(fd->cp->sound))
{
if (fd->type == SAMPLER)
- return(XEN_LIST_2(C_INT_TO_XEN_SOUND(fd->cp->sound->index),
- C_TO_XEN_INT(fd->cp->chan)));
+ return(Xen_list_2(C_int_to_Xen_sound(fd->cp->sound->index),
+ C_int_to_Xen_integer(fd->cp->chan)));
- return(XEN_LIST_2(C_INT_TO_XEN_REGION(fd->region),
- C_TO_XEN_INT(fd->cp->chan)));
+ return(Xen_list_2(C_int_to_Xen_region(fd->region),
+ C_int_to_Xen_integer(fd->cp->chan)));
}
}
- if (mix_sampler_p(obj))
+ if (is_mix_sampler(obj))
return(g_mix_sampler_home(obj));
- return(XEN_FALSE);
+ return(Xen_false);
}
-XEN g_sampler_file_name(XEN obj)
+Xen g_sampler_file_name(Xen obj)
{
- if (sampler_p(obj))
+ if (is_sampler(obj))
{
snd_fd *fd = NULL;
- fd = XEN_TO_SAMPLER(obj);
+ fd = Xen_to_C_sampler(obj);
if ((fd->cp) &&
(fd->cp->active >= CHANNEL_HAS_EDIT_LIST) &&
(fd->cp->sound))
- return(C_TO_XEN_STRING(fd->cp->sound->filename));
- return(XEN_FALSE);
+ return(C_string_to_Xen_string(fd->cp->sound->filename));
+ return(Xen_false);
}
- return(C_TO_XEN_STRING(mix_file_name(XEN_MIX_TO_C_INT(obj))));
+ return(C_string_to_Xen_string(mix_file_name(Xen_mix_to_C_int(obj))));
}
-XEN g_c_make_sampler(snd_fd *fd)
+Xen g_c_make_sampler(snd_fd *fd)
{
- XEN_MAKE_AND_RETURN_OBJECT(sf_tag, fd, 0, free_sf);
+ return(Xen_make_object(sf_tag, fd, 0, free_sf));
}
-static XEN g_make_region_sampler(XEN reg, XEN samp_n, XEN chn, XEN dir1)
+static Xen g_make_region_sampler(Xen reg, Xen samp_n, Xen chn, Xen dir1)
{
#define H_make_region_sampler "(" S_make_region_sampler " reg :optional (start-samp 0) (chn 0) (dir 1)): \
return a reader ready to access region's channel chn data starting at start-samp going in direction dir"
snd_fd *fd = NULL;
- int reg_n, chn_n;
+ int reg_n, chn_n = 0;
mus_long_t beg;
int direction = 1;
- XEN_ASSERT_TYPE(XEN_REGION_P(reg), reg, XEN_ARG_1, S_make_region_sampler, "a region");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(samp_n), samp_n, XEN_ARG_2, S_make_region_sampler, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chn), chn, XEN_ARG_3, S_make_region_sampler, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(dir1), dir1, XEN_ARG_4, S_make_region_sampler, "an integer");
- reg_n = XEN_REGION_TO_C_INT(reg);
+ Xen_check_type(xen_is_region(reg), reg, 1, S_make_region_sampler, "a region");
+ Xen_check_type(Xen_is_integer_or_unbound(samp_n), samp_n, 2, S_make_region_sampler, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(chn), chn, 3, S_make_region_sampler, "an integer");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(dir1), dir1, 4, S_make_region_sampler, "an integer");
+ reg_n = Xen_region_to_C_int(reg);
if (!(region_ok(reg_n)))
- XEN_ERROR(XEN_ERROR_TYPE("no-such-region"),
- XEN_LIST_2(C_TO_XEN_STRING(S_make_region_sampler ": no such region: ~A"),
+ Xen_error(Xen_make_error_type("no-such-region"),
+ Xen_list_2(C_string_to_Xen_string(S_make_region_sampler ": no such region: ~A"),
reg));
- chn_n = XEN_TO_C_INT_OR_ELSE(chn, 0);
+ if (Xen_is_integer(chn)) chn_n = Xen_integer_to_C_int(chn);
if ((chn_n < 0) || (chn_n >= region_chans(reg_n)))
- return(snd_no_such_channel_error(S_make_region_sampler, XEN_LIST_1(reg), chn));
+ return(snd_no_such_channel_error(S_make_region_sampler, Xen_list_1(reg), chn));
beg = beg_to_sample(samp_n, S_make_region_sampler);
- direction = XEN_TO_C_INT_OR_ELSE(dir1, 1);
+ if (Xen_is_integer(dir1)) direction = Xen_integer_to_C_int(dir1);
if (direction == 1)
fd = init_region_read(beg, reg_n, chn_n, READ_FORWARD);
@@ -8074,8 +7052,8 @@ return a reader ready to access region's channel chn data starting at start-samp
{
if (direction == -1)
fd = init_region_read(beg, reg_n, chn_n, READ_BACKWARD);
- else XEN_ERROR(XEN_ERROR_TYPE("no-such-direction"),
- XEN_LIST_2(C_TO_XEN_STRING(S_make_region_sampler ": bad direction: ~A"),
+ else Xen_error(Xen_make_error_type("no-such-direction"),
+ Xen_list_2(C_string_to_Xen_string(S_make_region_sampler ": bad direction: ~A"),
dir1));
}
@@ -8086,14 +7064,14 @@ return a reader ready to access region's channel chn data starting at start-samp
fd->region = reg_n;
fd->type = REGION_READER;
list_reader(fd);
- XEN_MAKE_AND_RETURN_OBJECT(sf_tag, fd, 0, free_sf);
+ return(Xen_make_object(sf_tag, fd, 0, free_sf));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_make_sampler(XEN samp_n, XEN snd, XEN chn, XEN dir1, XEN pos) /* "dir" confuses Mac OS-X Objective-C! */
+static Xen g_make_sampler(Xen samp_n, Xen snd, Xen chn, Xen dir1, Xen pos) /* "dir" confuses Mac OS-X Objective-C! */
{
#define H_make_sampler "(" S_make_sampler " :optional (start-samp 0) snd chn (dir 1) edpos): \
return a reader ready to access snd's channel chn's data starting at start-samp, going in direction dir (1 = \
@@ -8101,29 +7079,30 @@ forward, -1 = backward), reading the version of the data indicated by edpos whic
snd can be a filename, a mix, a region, or a sound index number."
snd_fd *fd = NULL;
- int chan, edpos, direction = 1; /* in Scheme 1=forward, -1=backward */
+ int edpos, direction = 1; /* in Scheme 1=forward, -1=backward */
chan_info *cp;
- const char *filename;
snd_info *loc_sp = NULL;
mus_long_t beg;
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(samp_n), samp_n, XEN_ARG_1, S_make_sampler, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(dir1), dir1, XEN_ARG_4, S_make_sampler, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(samp_n), samp_n, 1, S_make_sampler, "an integer");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(dir1), dir1, 4, S_make_sampler, "an integer");
- if (XEN_MIX_P(snd))
+ if (xen_is_mix(snd))
return(g_make_mix_sampler(snd, samp_n));
- if (XEN_REGION_P(snd))
+ if (xen_is_region(snd))
return(g_make_region_sampler(snd, samp_n, chn, dir1));
- if (XEN_STRING_P(snd))
+ if (Xen_is_string(snd))
{
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(chn), chn, XEN_ARG_3, S_make_sampler, "an integer or boolean");
- filename = XEN_TO_C_STRING(snd);
+ const char *filename;
+ int chan = 0;
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(chn), chn, 3, S_make_sampler, "an integer or boolean");
+ filename = Xen_string_to_C_string(snd);
if (mus_file_probe(filename))
loc_sp = make_sound_readable(filename, false);
else return(snd_no_such_file_error(S_make_sampler, snd));
- chan = XEN_TO_C_INT_OR_ELSE(chn, 0);
+ if (Xen_is_integer(chn)) chan = Xen_integer_to_C_int(chn);
if ((chan < 0) ||
(chan >= loc_sp->nchans))
{
@@ -8134,13 +7113,13 @@ snd can be a filename, a mix, a region, or a sound index number."
}
else
{
- ASSERT_CHANNEL(S_make_sampler, snd, chn, 2);
+ Snd_assert_channel(S_make_sampler, snd, chn, 2);
cp = get_cp(snd, chn, S_make_sampler);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
}
edpos = to_c_edit_position(cp, pos, S_make_sampler, 5);
- direction = XEN_TO_C_INT_OR_ELSE(dir1, 1);
+ if (Xen_is_integer(dir1)) direction = Xen_integer_to_C_int(dir1);
beg = beg_to_sample(samp_n, S_make_sampler);
if (direction == 1)
@@ -8149,8 +7128,8 @@ snd can be a filename, a mix, a region, or a sound index number."
{
if (direction == -1)
fd = init_sample_read_any(beg, cp, READ_BACKWARD, edpos);
- else XEN_ERROR(XEN_ERROR_TYPE("no-such-direction"),
- XEN_LIST_2(C_TO_XEN_STRING(S_make_sampler ": bad direction: ~A"),
+ else Xen_error(Xen_make_error_type("no-such-direction"),
+ Xen_list_2(C_string_to_Xen_string(S_make_sampler ": bad direction: ~A"),
dir1));
}
@@ -8158,129 +7137,162 @@ snd can be a filename, a mix, a region, or a sound index number."
{
fd->local_sp = loc_sp;
list_reader(fd);
- XEN_MAKE_AND_RETURN_OBJECT(sf_tag, fd, 0, free_sf);
+ return(Xen_make_object(sf_tag, fd, 0, free_sf));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_sampler_p(XEN obj)
+static Xen g_is_sampler(Xen obj)
{
- #define H_sampler_p "(" S_sampler_p " obj): " PROC_TRUE " if obj is a sound sampler."
+ #define H_is_sampler "(" S_is_sampler " obj): " PROC_TRUE " if obj is a sound sampler."
- if (sampler_p(obj))
+ if (is_sampler(obj))
{
snd_fd *fd;
- fd = XEN_TO_SAMPLER(obj);
- return(C_TO_XEN_BOOLEAN(fd->type == SAMPLER));
+ fd = Xen_to_C_sampler(obj);
+ return(C_bool_to_Xen_boolean(fd->type == SAMPLER));
}
- if (mix_sampler_p(obj))
- return(C_STRING_TO_XEN_SYMBOL("mix"));
+ if (is_mix_sampler(obj))
+ return(C_string_to_Xen_symbol("mix"));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_region_sampler_p(XEN obj)
+static Xen g_region_is_sampler(Xen obj)
{
- #define H_region_sampler_p "(" S_region_sampler_p " obj): " PROC_TRUE " if obj is a region sampler."
- if (sampler_p(obj))
+ #define H_region_is_sampler "(" S_is_region_sampler " obj): " PROC_TRUE " if obj is a region sampler."
+ if (is_sampler(obj))
{
snd_fd *fd;
- fd = XEN_TO_SAMPLER(obj);
- return(C_TO_XEN_BOOLEAN(fd->type == REGION_READER));
+ fd = Xen_to_C_sampler(obj);
+ return(C_bool_to_Xen_boolean(fd->type == REGION_READER));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_copy_sampler(XEN obj)
+static Xen g_copy_sampler(Xen obj)
{
#define H_copy_sampler "(" S_copy_sampler " reader): return a copy of reader"
- XEN_ASSERT_TYPE(ANY_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_copy_sampler, "a sampler (of any kind)");
+ Xen_check_type(is_any_sampler(obj), obj, 1, S_copy_sampler, "a sampler (of any kind)");
- if (sampler_p(obj))
+ if (is_sampler(obj))
{
snd_fd *fd = NULL;
- fd = XEN_TO_SAMPLER(obj);
+ fd = Xen_to_C_sampler(obj);
if ((fd->cp) &&
(fd->cp->active >= CHANNEL_HAS_EDIT_LIST) &&
(fd->cp->sound))
{
if (fd->type == SAMPLER)
- return(g_make_sampler(C_TO_XEN_INT64_T(current_location(fd)),
- C_INT_TO_XEN_SOUND(fd->cp->sound->index),
- C_TO_XEN_INT(fd->cp->chan),
- C_TO_XEN_INT((fd->direction == READ_FORWARD) ? 1 : -1), /* Scheme side is different from C side */
- C_TO_XEN_INT(fd->edit_ctr)));
+ return(g_make_sampler(C_llong_to_Xen_llong(current_location(fd)),
+ C_int_to_Xen_sound(fd->cp->sound->index),
+ C_int_to_Xen_integer(fd->cp->chan),
+ C_int_to_Xen_integer((fd->direction == READ_FORWARD) ? 1 : -1), /* Scheme side is different from C side */
+ C_int_to_Xen_integer(fd->edit_ctr)));
- return(g_make_region_sampler(C_INT_TO_XEN_REGION(fd->region),
- C_TO_XEN_INT64_T(region_current_location(fd)),
- C_TO_XEN_INT(fd->cp->chan),
- C_TO_XEN_INT((fd->direction == READ_FORWARD) ? 1 : -1)));
+ return(g_make_region_sampler(C_int_to_Xen_region(fd->region),
+ C_llong_to_Xen_llong(region_current_location(fd)),
+ C_int_to_Xen_integer(fd->cp->chan),
+ C_int_to_Xen_integer((fd->direction == READ_FORWARD) ? 1 : -1)));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
- if (mix_sampler_p(obj))
+ if (is_mix_sampler(obj))
return(g_copy_mix_sampler(obj));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static snd_fd *xen_to_any_sampler(XEN obj)
+static Xen g_next_sample(Xen obj)
{
- if (XEN_MIX_P(obj))
- return(xen_mix_to_snd_fd(obj));
- return(XEN_TO_SAMPLER(obj));
+ #define H_next_sample "(" S_next_sample " reader): next sample from reader"
+
+ if (is_sampler(obj))
+ return(C_double_to_Xen_real(protected_next_sample((snd_fd *)Xen_object_ref(obj))));
+ if (is_mix_sampler(obj))
+ return(C_double_to_Xen_real(protected_next_sample(xen_mix_to_snd_fd(obj))));
+
+ Xen_check_type(false, obj, 1, S_next_sample, "a sampler");
+ return(C_double_to_Xen_real(0.0));
}
-static XEN g_next_sample(XEN obj)
+mus_float_t read_sample_with_direction(void *p, int dir);
+mus_float_t read_sample_with_direction(void *p, int dir)
{
- #define H_next_sample "(" S_next_sample " reader): next sample from reader"
- XEN_ASSERT_TYPE(ANY_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_next_sample, "a sampler");
- return(C_TO_XEN_DOUBLE(protected_next_sample(xen_to_any_sampler(obj))));
+ if (dir > 0)
+ return(protected_next_sample((snd_fd *)p));
+ return(protected_previous_sample((snd_fd *)p));
}
-static XEN g_read_sample(XEN obj)
+static Xen g_read_sample(Xen obj)
{
#define H_read_sample "(" S_read_sample " reader): read sample from reader"
- XEN_ASSERT_TYPE(ANY_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_read_sample, "a sampler");
- return(C_TO_XEN_DOUBLE(read_sample(xen_to_any_sampler(obj))));
+ if (is_sampler(obj))
+ return(C_double_to_Xen_real(read_sample((snd_fd *)Xen_object_ref(obj))));
+ if (is_mix_sampler(obj))
+ return(C_double_to_Xen_real(read_sample(xen_mix_to_snd_fd(obj))));
+
+ Xen_check_type(false, obj, 1, S_read_sample, "a sampler");
+ return(C_double_to_Xen_real(0.0));
+}
+
+#define S_read_sample_with_direction "read-sample-with-direction"
+
+static Xen g_read_sample_with_direction(Xen obj, Xen dir)
+{
+ #define H_read_sample_with_direction "(" S_read_sample_with_direction " reader dir): read sample from reader following dir (next/previous choice)"
+ Xen_check_type(Xen_is_integer(dir), dir, 1, S_read_sample_with_direction, "an integer");
+ if (is_sampler(obj))
+ return(C_double_to_Xen_real(read_sample_with_direction((void *)Xen_object_ref(obj), Xen_integer_to_C_int(dir))));
+ if (is_mix_sampler(obj))
+ return(C_double_to_Xen_real(read_sample_with_direction((void *)xen_mix_to_snd_fd(obj), Xen_integer_to_C_int(dir))));
+
+ Xen_check_type(false, obj, 1, S_read_sample_with_direction, "a sampler");
+ return(C_double_to_Xen_real(0.0));
}
#if HAVE_SCHEME
-static XEN s7_read_sample(s7_scheme *sc, XEN obj, XEN args)
+static Xen s7_read_sample(s7_scheme *sc, Xen obj, Xen args)
{
- return(g_read_sample(obj));
+ /* we can only get here if obj is already known to be a sampler */
+ return(C_double_to_Xen_real(read_sample((snd_fd *)Xen_object_ref(obj))));
}
#endif
-static XEN g_previous_sample(XEN obj)
+static Xen g_previous_sample(Xen obj)
{
#define H_previous_sample "(" S_previous_sample " reader): previous sample from reader"
- XEN_ASSERT_TYPE(ANY_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_previous_sample, "a sampler");
- return(C_TO_XEN_DOUBLE(protected_previous_sample(xen_to_any_sampler(obj))));
+ if (is_sampler(obj))
+ return(C_double_to_Xen_real(protected_previous_sample((snd_fd *)Xen_object_ref(obj))));
+ if (is_mix_sampler(obj))
+ return(C_double_to_Xen_real(protected_previous_sample(xen_mix_to_snd_fd(obj))));
+
+ Xen_check_type(false, obj, 1, S_previous_sample, "a sampler");
+ return(C_double_to_Xen_real(0.0));
}
-static XEN g_free_sampler(XEN obj)
+static Xen g_free_sampler(Xen obj)
{
#define H_free_sampler "(" S_free_sampler " reader): free a sampler (of any kind)"
- XEN_ASSERT_TYPE(ANY_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_free_sampler, "a sampler");
+ Xen_check_type(is_any_sampler(obj), obj, 1, S_free_sampler, "a sampler");
- if (sampler_p(obj))
+ if (is_sampler(obj))
{
snd_info *sp = NULL;
snd_fd *fd;
- fd = XEN_TO_SAMPLER(obj);
+ fd = Xen_to_C_sampler(obj);
unlist_reader(fd);
sp = fd->local_sp;
fd->local_sp = NULL;
@@ -8288,44 +7300,44 @@ static XEN g_free_sampler(XEN obj)
if (sp) completely_free_snd_info(sp);
}
- if (mix_sampler_p(obj))
+ if (is_mix_sampler(obj))
return(g_free_mix_sampler(obj));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_save_edit_history(XEN filename, XEN snd, XEN chn)
+static Xen g_save_edit_history(Xen filename, Xen snd, Xen chn)
{
#define H_save_edit_history "(" S_save_edit_history " filename :optional snd chn): save snd channel's chn edit history in filename"
FILE *fd;
const char *name;
char *mcf = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ARG_1, S_save_edit_history, "a string");
- ASSERT_CHANNEL(S_save_edit_history, snd, chn, 2);
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_save_edit_history, "a string");
+ Snd_assert_channel(S_save_edit_history, snd, chn, 2);
- name = XEN_TO_C_STRING(filename);
+ name = Xen_string_to_C_string(filename);
mcf = mus_expand_filename(name);
- if (!mcf) return(XEN_FALSE);
+ if (!mcf) return(Xen_false);
fd = FOPEN(mcf, "w");
if (mcf) free(mcf);
if (fd)
{
- chan_info *cp;
- if ((XEN_INTEGER_P(chn)) &&
- (XEN_INTEGER_P(snd) || XEN_SOUND_P(snd)))
+ if ((Xen_is_integer(chn)) &&
+ (Xen_is_integer(snd) || xen_is_sound(snd)))
{
+ chan_info *cp;
cp = get_cp(snd, chn, S_save_edit_history);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
edit_history_to_file(fd, cp, false);
}
else
{
- int i, j;
+ int i;
snd_info *sp;
- if (XEN_INTEGER_P(snd) || XEN_SOUND_P(snd))
+ if (Xen_is_integer(snd) || xen_is_sound(snd))
{
sp = get_sp(snd);
if (sp)
@@ -8337,6 +7349,7 @@ static XEN g_save_edit_history(XEN filename, XEN snd, XEN chn)
for (i = 0; i < ss->max_sounds; i++)
{
+ int j;
sp = ss->sounds[i];
if ((sp) && (sp->inuse == SOUND_NORMAL))
for (j = 0; j < sp->nchans; j++)
@@ -8348,62 +7361,62 @@ static XEN g_save_edit_history(XEN filename, XEN snd, XEN chn)
}
else
{
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_edit_history ": can't save ~S: ~A"),
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_save_edit_history ": can't save ~S: ~A"),
filename,
- C_TO_XEN_STRING(snd_open_strerror())));
+ C_string_to_Xen_string(snd_open_strerror())));
}
return(filename);
}
-static XEN g_undo(XEN ed_n, XEN snd, XEN chn_n) /* opt ed_n */
+static Xen g_undo(Xen ed_n, Xen snd, Xen chn_n) /* opt ed_n */
{
#define H_undo "(" S_undo " :optional (count 1) snd chn): undo 'count' edits in snd's channel chn"
chan_info *cp;
- int num;
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ed_n), ed_n, XEN_ARG_1, S_undo, "an integer");
- ASSERT_CHANNEL(S_undo, snd, chn_n, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(ed_n), ed_n, 1, S_undo, "an integer");
+ Snd_assert_channel(S_undo, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_undo);
- if (!cp) return(XEN_FALSE);
- if (XEN_INTEGER_P(ed_n))
+ if (!cp) return(Xen_false);
+ if (Xen_is_integer(ed_n))
{
- num = XEN_TO_C_INT(ed_n);
+ int num;
+ num = Xen_integer_to_C_int(ed_n);
if ((num != 0) && (num < 1000000000) && (num > -1000000000))
{
if (undo_edit_with_sync(cp, num))
- return(C_TO_XEN_INT(num));
+ return(C_int_to_Xen_integer(num));
}
- return(XEN_ZERO);
+ return(Xen_integer_zero);
}
if (undo_edit_with_sync(cp, 1))
- return(C_TO_XEN_INT(1));
- return(XEN_ZERO);
+ return(C_int_to_Xen_integer(1));
+ return(Xen_integer_zero);
}
-static XEN g_redo(XEN ed_n, XEN snd, XEN chn_n) /* opt ed_n */
+static Xen g_redo(Xen ed_n, Xen snd, Xen chn_n) /* opt ed_n */
{
#define H_redo "(" S_redo " :optional (count 1) snd chn): redo 'count' edits in snd's channel chn"
chan_info *cp;
- int num;
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(ed_n), ed_n, XEN_ARG_1, S_redo, "an integer");
- ASSERT_CHANNEL(S_redo, snd, chn_n, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(ed_n), ed_n, 1, S_redo, "an integer");
+ Snd_assert_channel(S_redo, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_redo);
- if (!cp) return(XEN_FALSE);
- if (XEN_INTEGER_P(ed_n))
+ if (!cp) return(Xen_false);
+ if (Xen_is_integer(ed_n))
{
- num = XEN_TO_C_INT(ed_n);
+ int num;
+ num = Xen_integer_to_C_int(ed_n);
if ((num != 0) && (num < 1000000000) && (num > -1000000000))
{
if (redo_edit_with_sync(cp, num))
- return(C_TO_XEN_INT(num));
+ return(C_int_to_Xen_integer(num));
}
- return(XEN_ZERO);
+ return(Xen_integer_zero);
}
if (redo_edit_with_sync(cp, 1))
- return(C_TO_XEN_INT(1));
- return(XEN_ZERO);
+ return(C_int_to_Xen_integer(1));
+ return(Xen_integer_zero);
}
@@ -8415,14 +7428,15 @@ void as_one_edit(chan_info *cp, int one_edit)
{
/* it's not safe to back up during the as-one-edit function call because that function might refer back via the edpos args etc */
- bool need_backup = false;
+ bool need_backup;
need_backup = (cp->edit_ctr > one_edit); /* cp->edit_ctr will be changing, so save this */
if (cp->edit_ctr >= one_edit) /* ">=" here because the origin needs to be set even if there were no extra edits */
{
if (ss->deferred_regions > 0)
sequester_deferred_regions(cp, one_edit - 1);
- while (cp->edit_ctr > one_edit) backup_edit_list(cp);
+ while (cp->edit_ctr > one_edit)
+ backup_edit_list_1(cp, true); /* i.e. free all the fragments */
if (need_backup) prune_edits(cp, cp->edit_ctr + 1);
}
}
@@ -8482,62 +7496,62 @@ static void finish_as_one_edit(chan_info *cp)
if (cp->in_as_one_edit == 0)
{
cp->squelch_update = cp->previous_squelch_update;
- if (!(cp->squelch_update)) clear_minibuffer(cp->sound);
+ if (!(cp->squelch_update)) clear_status_area(cp->sound);
reflect_edit_history_change(cp);
update_graph(cp);
}
}
}
+#if HAVE_SCHEME
+static s7_pointer edit_finish;
+static s7_pointer g_edit_finish(s7_scheme *sc, s7_pointer args)
+{
+ for_each_normal_chan(finish_as_one_edit);
+ return(args);
+}
+#endif
-static XEN g_as_one_edit(XEN proc, XEN origin)
+static Xen g_as_one_edit(Xen proc, Xen origin)
{
#define H_as_one_edit "(" S_as_one_edit " thunk :optional origin): evaluate thunk, collecting all edits into one from the edit history's point of view"
- XEN result = XEN_FALSE;
+ Xen result = Xen_false;
char *errmsg, *as_one_edit_origin = NULL;
- XEN errstr;
-#if HAVE_SCHEME
- int loc = -1;
-#endif
- XEN_ASSERT_TYPE((XEN_PROCEDURE_P(proc)), proc, XEN_ARG_1, S_as_one_edit, "a procedure");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, XEN_ARG_2, S_as_one_edit, "a string");
+ Xen_check_type((Xen_is_procedure(proc)), proc, 1, S_as_one_edit, "a procedure");
+ Xen_check_type(Xen_is_string_or_unbound(origin), origin, 2, S_as_one_edit, "a string");
errmsg = procedure_ok(proc, 0, S_as_one_edit, "edit", 1);
if (errmsg)
{
- errstr = C_TO_XEN_STRING(errmsg);
+ Xen errstr;
+ errstr = C_string_to_Xen_string(errmsg);
free(errmsg);
return(snd_bad_arity_error(S_as_one_edit, errstr, proc));
}
- if (XEN_STRING_P(origin))
- as_one_edit_origin = mus_strdup(XEN_TO_C_STRING(origin));
- else as_one_edit_origin = NULL;
+ if (Xen_is_string(origin))
+ as_one_edit_origin = mus_strdup(Xen_string_to_C_string(origin));
+ else as_one_edit_origin = NULL;
for_each_normal_chan(init_as_one_edit);
- result = XEN_CALL_0_NO_CATCH(proc);
-#if HAVE_SCHEME
- loc = s7_gc_protect(s7, result);
- /* finish_as_one_edit can call update_graph which can call any number of hooks,
- * so this result has to be GC protected by hand.
- */
-#endif
+
+#if HAVE_SCHEME
+ result = s7_dynamic_wind(s7, xen_false, proc, edit_finish);
+#else
+ result = Xen_unprotected_call_with_no_args(proc);
for_each_normal_chan(finish_as_one_edit);
+#endif
if (as_one_edit_origin)
{
for_each_normal_chan_with_void(as_one_edit_set_origin, (void *)as_one_edit_origin);
free(as_one_edit_origin);
}
-
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, loc);
-#endif
return(result);
}
-static XEN g_scale_channel(XEN scl, XEN beg, XEN num, XEN snd, XEN chn, XEN edpos)
+static Xen g_scale_channel(Xen scl, Xen beg, Xen num, Xen snd, Xen chn, Xen edpos)
{
#define H_scale_channel "(" S_scale_channel " scaler :optional (beg 0) (dur len) snd chn edpos): \
scale samples in the given sound/channel between beg and beg + num by scaler."
@@ -8547,15 +7561,15 @@ scale samples in the given sound/channel between beg and beg + num by scaler."
mus_long_t samp;
int pos;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(scl), scl, XEN_ARG_1, S_scale_channel, "a number");
- ASSERT_SAMPLE_TYPE(S_scale_channel, beg, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(S_scale_channel, num, XEN_ARG_3);
- ASSERT_SOUND(S_scale_channel, snd, 4);
+ Xen_check_type(Xen_is_number(scl), scl, 1, S_scale_channel, "a number");
+ Snd_assert_sample_type(S_scale_channel, beg, 2);
+ Snd_assert_sample_type(S_scale_channel, num, 3);
+ Snd_assert_sound(S_scale_channel, snd, 4);
- scaler = XEN_TO_C_DOUBLE(scl);
+ scaler = Xen_real_to_C_double(scl);
samp = beg_to_sample(beg, S_scale_channel);
cp = get_cp(snd, chn, S_scale_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, S_scale_channel, 6);
scale_channel(cp, scaler, samp, dur_to_samples(num, samp, cp, pos, 3, S_scale_channel), pos, NOT_IN_AS_ONE_EDIT);
@@ -8564,7 +7578,7 @@ scale samples in the given sound/channel between beg and beg + num by scaler."
}
-static XEN g_normalize_channel(XEN scl, XEN beg, XEN num, XEN snd, XEN chn, XEN edpos)
+static Xen g_normalize_channel(Xen scl, Xen beg, Xen num, Xen snd, Xen chn, Xen edpos)
{
#define H_normalize_channel "(" S_normalize_channel " norm :optional (beg 0) (dur len) snd chn edpos): \
scale samples in the given sound/channel between beg and beg + num to norm."
@@ -8575,15 +7589,15 @@ scale samples in the given sound/channel between beg and beg + num to norm."
int pos;
char *origin = NULL;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(scl), scl, XEN_ARG_1, S_normalize_channel, "a number");
- ASSERT_SAMPLE_TYPE(S_normalize_channel, beg, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(S_normalize_channel, num, XEN_ARG_3);
- ASSERT_SOUND(S_normalize_channel, snd, 4);
+ Xen_check_type(Xen_is_number(scl), scl, 1, S_normalize_channel, "a number");
+ Snd_assert_sample_type(S_normalize_channel, beg, 2);
+ Snd_assert_sample_type(S_normalize_channel, num, 3);
+ Snd_assert_sound(S_normalize_channel, snd, 4);
- norm = XEN_TO_C_DOUBLE(scl);
+ norm = Xen_real_to_C_double(scl);
samp = beg_to_sample(beg, S_normalize_channel);
cp = get_cp(snd, chn, S_normalize_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, S_normalize_channel, 6);
samps = dur_to_samples(num, samp, cp, pos, 3, S_normalize_channel);
@@ -8597,18 +7611,18 @@ scale samples in the given sound/channel between beg and beg + num to norm."
else
{
cur_max = channel_local_maxamp(cp, samp, samps, pos, NULL);
- origin = mus_format("%.3f " MUS_LD PROC_SEP MUS_LD " %s", norm, samp, samps, S_normalize_channel);
+ origin = mus_format("%.3f %lld" PROC_SEP "%lld %s", norm, samp, samps, S_normalize_channel);
}
#else
if ((samp == 0) && (samps == cp->edits[pos]->samples))
{
cur_max = channel_maxamp(cp, pos);
- origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "0" PROC_SEP PROC_FALSE, TO_PROC_NAME(S_normalize_channel), norm);
+ origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "0" PROC_SEP PROC_FALSE, to_proc_name(S_normalize_channel), norm);
}
else
{
cur_max = channel_local_maxamp(cp, samp, samps, pos, NULL);
- origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(S_normalize_channel), norm, samp, samps);
+ origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_normalize_channel), norm, samp, samps);
}
#endif
@@ -8620,11 +7634,12 @@ scale samples in the given sound/channel between beg and beg + num to norm."
}
-static mus_float_t channel_maxamp_and_position(chan_info *cp, int edpos, mus_long_t *maxpos)
+mus_float_t channel_maxamp_and_position(chan_info *cp, int edpos, mus_long_t *maxpos)
{
/* maxamp position is not tracked in peak env because it gloms up the code, and cannot easily be saved/restored in the peak env files */
mus_float_t val;
int pos;
+ mus_long_t locpos;
if (edpos == AT_CURRENT_EDIT_POSITION) pos = cp->edit_ctr; else pos = edpos;
@@ -8632,14 +7647,16 @@ static mus_float_t channel_maxamp_and_position(chan_info *cp, int edpos, mus_lon
return(peak_env_maxamp(cp, pos));
val = ed_maxamp(cp, pos);
- if (maxpos) (*maxpos) = ed_maxamp_position(cp, pos);
+ locpos = ed_maxamp_position(cp, pos);
+ if (maxpos) (*maxpos) = locpos;
if ((val >= 0.0) && /* defaults to -1.0! */
- ((!maxpos) || ((*maxpos) >= 0)))
+ ((!maxpos) || (locpos >= 0)))
return(val);
- val = channel_local_maxamp(cp, 0, cp->edits[pos]->samples, pos, maxpos);
+ val = channel_local_maxamp(cp, 0, cp->edits[pos]->samples, pos, &locpos);
set_ed_maxamp(cp, pos, val);
- if (maxpos) set_ed_maxamp_position(cp, pos, (*maxpos));
+ set_ed_maxamp_position(cp, pos, locpos);
+ if (maxpos) (*maxpos) = locpos;
return(val);
}
@@ -8662,106 +7679,169 @@ mus_long_t channel_maxamp_position(chan_info *cp, int edpos)
mus_float_t channel_local_maxamp(chan_info *cp, mus_long_t beg, mus_long_t num, int edpos, mus_long_t *maxpos)
{
snd_fd *sf;
- mus_float_t ymax = 0.0, mval;
- mus_long_t mpos = -1;
- int j = 0, jpos = -1;
-
- if (edpos == 0)
- {
- snd_data *sd;
- sd = cp->sounds[0];
- if ((sd) &&
- (sd->io) &&
- (io_beg(sd->io) <= beg) &&
- (io_end(sd->io) >= (beg + num)))
- {
- /* use the in-core data directly */
- int start, end;
-
- start = beg - io_beg(sd->io);
- jpos = start;
- end = beg + num - io_beg(sd->io);
-
- for (j = start; j < end; j++)
- {
- mval = fabs(MUS_SAMPLE_TO_FLOAT(sd->buffered_data[j]));
- if (mval > ymax)
- {
- ymax = mval;
- jpos = j;
- }
- }
-
- if (maxpos) (*maxpos) = jpos - start;
- return(ymax);
- }
- }
+ mus_float_t ymax, x;
+ mus_float_t *d;
+ mus_long_t i, k, lim8, kend, mpos;
- sf = init_sample_read_any(beg, cp, READ_FORWARD, edpos);
+ sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, edpos, (num > MAX_BUFFER_SIZE) ? MAX_BUFFER_SIZE : num);
if (sf == NULL) return(0.0);
+
+ ymax = 0.0;
+ mpos = -1;
+ i = 0;
- if (num > (1 << 30))
+ while (true)
{
- mus_long_t i;
- ss->stopped_explicitly = false;
- for (i = 0; i < num; i++)
+ mus_long_t dur, left, offset;
+
+ dur = sf->last - sf->loc + 1; /* current fragment, we're always reading forward here */
+ left = num - i;
+ if (dur > left) dur = left;
+ offset = i - sf->loc;
+
+ if (sf->runf == next_sample_value_unscaled)
{
- mval = fabs(read_sample(sf));
- if (mval > ymax)
+ kend = sf->loc + dur;
+ lim8 = kend - 8;
+ k = sf->loc;
+ d = sf->data;
+
+ while (k <= lim8)
{
- ymax = mval;
- mpos = i;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
}
- j++;
- if (j > 1000000)
+ while (k < kend)
{
- check_for_event();
- if ((ss->stopped_explicitly) || (cp->active < CHANNEL_HAS_EDIT_LIST))
- {
- ss->stopped_explicitly = false;
- string_to_minibuffer(cp->sound, "maxamp check interrupted...");
- break;
- }
- j = 0;
+ x = fabs(d[k]); if (x > ymax) {ymax = x; mpos = k + offset;} k++;
}
+ i += dur;
}
- }
- else
- {
- int jnum;
- jnum = (int)num;
-
- if ((sf->runf == next_sample_value_unscaled) && /* not also next_sample_value because next_sound embeds the scaler multiply */
- (ED_LOCAL_POSITION(sf->cb) == 0) &&
- (ED_LOCAL_END(sf->cb) >= (num - 1)))
+ else
{
- for (j = 0; j < jnum; j++)
+ if (sf->runf == next_sample_value)
{
- if (sf->loc > sf->last)
- mval = fabs(next_sound(sf));
- else mval = fabs(sf->data[sf->loc++]);
- if (mval > ymax)
+ mus_float_t scl, lmax; /* provisional max -- we omit the scaling until the end */
+ mus_long_t lpos; /* provisional max position */
+
+ scl = fabs(sf->fscaler);
+ lpos = -1;
+ lmax = 0.0;
+ kend = sf->loc + dur;
+ lim8 = kend - 8;
+ d = sf->data;
+
+ k = sf->loc;
+ while (k <= lim8)
+ {
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
+ }
+ while (k < kend)
{
- ymax = mval;
- jpos = j;
+ x = fabs(d[k]); if (x > lmax) {lmax = x; lpos = k;} k++;
}
+ if (lmax * scl > ymax)
+ {
+ ymax = lmax * scl;
+ mpos = lpos + offset;
+ }
+ i += dur;
}
- }
- else
- {
- for (j = 0; j < jnum; j++)
+ else
{
- mval = fabs(read_sample(sf));
- if (mval > ymax)
+ if (sf->runf == next_ramp1)
+ {
+ mus_float_t amp, incr;
+ mus_long_t j;
+
+ amp = READER_VAL(sf, 0);
+ incr = READER_INCR(sf, 0);
+ kend = sf->loc + dur;
+ lim8 = kend - 4;
+ d = sf->data;
+
+ j = sf->loc;
+ while (j <= lim8)
+ {
+ x = fabs(amp * d[j]); if (x > ymax) {ymax = x; mpos = j + offset;} amp += incr; j++;
+ x = fabs(amp * d[j]); if (x > ymax) {ymax = x; mpos = j + offset;} amp += incr; j++;
+ x = fabs(amp * d[j]); if (x > ymax) {ymax = x; mpos = j + offset;} amp += incr; j++;
+ x = fabs(amp * d[j]); if (x > ymax) {ymax = x; mpos = j + offset;} amp += incr; j++;
+ }
+ while (j < kend)
+ {
+ x = fabs(amp * d[j]); if (x > ymax) {ymax = x; mpos = j + offset;} amp += incr; j++;
+ }
+ READER_VAL(sf, 0) = amp;
+ i += dur;
+ }
+ else
{
- ymax = mval;
- jpos = j;
+ if (sf->runf == end_sample_value)
+ break;
+ if (sf->runf == next_zero)
+ i += dur;
+ else
+ {
+ if (sf->runf == next_xramp1)
+ {
+ mus_float_t off, scaler, xval, scl, incr;
+ mus_long_t j;
+
+ off = READER_XRAMP_OFFSET(sf, 0);
+ scl = READER_SCALER(sf);
+ scaler = READER_XRAMP_SCALER(sf, 0);
+ xval = READER_XVAL(sf, 0);
+ incr = READER_XINCR(sf, 0);
+
+ d = sf->data;
+ kend = sf->loc + dur;
+ off *= scl;
+ scaler *= scl;
+
+ for (j = sf->loc; j < kend; j++)
+ {
+ x = fabs(d[j] * (off + scaler * xval)); if (x > ymax) {ymax = x; mpos = j + offset;}
+ xval *= incr;
+ }
+ READER_XVAL(sf, 0) = xval;
+ i += dur;
+ }
+ else
+ {
+ left = i + dur;
+ for (; i < left; i++)
+ {
+ x = fabs(read_sample(sf)); if (x > ymax) {ymax = x; mpos = i;}
+ }
+ }
+ }
}
}
}
- mpos = (mus_long_t)jpos;
-
+ if (i >= num) break;
+ next_sound_1(sf);
}
+
+ /* fprintf(stderr, "use %f %lld\n", ymax, mpos); */
+ if ((edpos == 0) &&
+ (beg == 0) &&
+ (num = cp->edits[0]->samples))
+ mus_sound_channel_set_maxamp(cp->sound->filename, cp->chan, ymax, mpos);
+
if (maxpos) (*maxpos) = mpos;
free_snd_fd(sf);
@@ -8769,48 +7849,51 @@ mus_float_t channel_local_maxamp(chan_info *cp, mus_long_t beg, mus_long_t num,
}
-static mus_sample_t *g_floats_to_samples(XEN obj, int *size, const char *caller, int position)
+static mus_float_t *g_floats_to_samples(Xen obj, int *size, const char *caller, int position)
{
- mus_sample_t *vals = NULL;
+ mus_float_t *vals = NULL;
int i, num = 0;
- if (XEN_LIST_P_WITH_LENGTH(obj, num))
+ if (Xen_is_list(obj))
{
- XEN lst;
+ Xen lst;
+ num = Xen_list_length(obj);
if (num == 0) return(NULL);
if (((*size) > 0) && (num > (*size)))
num = (*size);
- vals = (mus_sample_t *)malloc(num * sizeof(mus_sample_t));
- for (i = 0, lst = XEN_COPY_ARG(obj); i < num; i++, lst = XEN_CDR(lst))
- vals[i] = MUS_FLOAT_TO_SAMPLE(XEN_TO_C_DOUBLE_OR_ELSE(XEN_CAR(lst), 0.0));
+ vals = (mus_float_t *)malloc(num * sizeof(mus_float_t));
+ for (i = 0, lst = Xen_copy_arg(obj); i < num; i++, lst = Xen_cdr(lst))
+ vals[i] = (Xen_real_to_C_double(Xen_car(lst)));
}
else
{
- if (XEN_VECTOR_P(obj))
+ if (Xen_is_vector(obj))
{
- num = XEN_VECTOR_LENGTH(obj);
+ num = Xen_vector_length(obj);
if (num == 0) return(NULL);
if (((*size) > 0) && (num > (*size)))
num = (*size);
- vals = (mus_sample_t *)malloc(num * sizeof(mus_sample_t));
+ vals = (mus_float_t *)malloc(num * sizeof(mus_float_t));
for (i = 0; i < num; i++)
- vals[i] = MUS_FLOAT_TO_SAMPLE(XEN_TO_C_DOUBLE_OR_ELSE(XEN_VECTOR_REF(obj, i), 0.0));
+ vals[i] = (Xen_real_to_C_double(Xen_vector_ref(obj, i)));
}
else
{
- /* this block only triggered if not SNDLIB_USE_FLOATS */
- if (MUS_VCT_P(obj))
+ /* this block probably can't happen anymore */
+ if (mus_is_vct(obj))
{
vct *v;
- v = XEN_TO_VCT(obj);
- num = v->length;
+ mus_float_t *vdata;
+ v = Xen_to_vct(obj);
+ vdata = mus_vct_data(v);
+ num = mus_vct_length(v);
if (((*size) > 0) && (num > (*size)))
num = (*size);
- vals = (mus_sample_t *)malloc(num * sizeof(mus_sample_t));
+ vals = (mus_float_t *)malloc(num * sizeof(mus_float_t));
for (i = 0; i < num; i++)
- vals[i] = MUS_FLOAT_TO_SAMPLE(v->data[i]);
+ vals[i] = (vdata[i]);
}
- else XEN_ASSERT_TYPE(0, obj, position, caller, "a vct, vector, or list");
+ else Xen_check_type(0, obj, position, caller, "a " S_vct ", vector, or list");
}
}
(*size) = num;
@@ -8818,7 +7901,7 @@ static mus_sample_t *g_floats_to_samples(XEN obj, int *size, const char *caller,
}
-static XEN g_sample(XEN samp_n, XEN snd, XEN chn_n, XEN pos_n)
+static Xen g_sample(Xen samp_n, Xen snd, Xen chn_n, Xen pos_n)
{
#define H_sample "(" S_sample " samp :optional snd chn edpos): \
return sample samp in snd's channel chn (this is a slow access -- use samplers for speed)"
@@ -8826,47 +7909,51 @@ return sample samp in snd's channel chn (this is a slow access -- use samplers f
int pos;
chan_info *cp;
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(samp_n), samp_n, XEN_ARG_1, S_sample, "a number");
+ Xen_check_type(Xen_is_integer_or_unbound(samp_n), samp_n, 1, S_sample, "an integer");
- if (XEN_TRUE_P(chn_n)) /* a convenience! */
+ if (Xen_is_true(chn_n)) /* a convenience! */
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
int i, loc;
snd_info *sp;
- ASSERT_SOUND(S_sample, snd, 1);
+ Snd_assert_sound(S_sample, snd, 1);
sp = get_sp(snd);
- if (!sp) return(XEN_FALSE);
+ if (!sp) return(Xen_false);
cp = any_selected_channel(sp);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, pos_n, S_sample, 4);
beg = beg_to_sample(samp_n, S_sample);
loc = snd_protect(lst);
for (i = 0; i < sp->nchans; i++)
- lst = XEN_CONS(C_TO_XEN_DOUBLE(chn_sample(beg, sp->chans[i], pos)), lst);
+ {
+ if (pos > sp->chans[i]->edit_ctr)
+ lst = Xen_cons(C_double_to_Xen_real(chn_sample(beg, sp->chans[i], sp->chans[i]->edit_ctr)), lst);
+ else lst = Xen_cons(C_double_to_Xen_real(chn_sample(beg, sp->chans[i], pos)), lst);
+ }
snd_unprotect_at(loc);
return(lst);
}
- ASSERT_CHANNEL(S_sample, snd, chn_n, 2);
+ Snd_assert_channel(S_sample, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_sample);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, pos_n, S_sample, 4);
- if (XEN_BOUND_P(samp_n))
+ if (Xen_is_bound(samp_n))
beg = beg_to_sample(samp_n, S_sample);
- else beg = CURSOR(cp);
+ else beg = cursor_sample(cp);
- return(C_TO_XEN_DOUBLE(chn_sample(beg, cp, pos)));
+ return(C_double_to_Xen_real(chn_sample(beg, cp, pos)));
}
-static XEN g_set_sample(XEN samp_n, XEN val, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_set_sample(Xen samp_n, Xen val, Xen snd, Xen chn_n, Xen edpos)
{
/* each call consitutes a separate edit from the undo/redo point-of-view */
chan_info *cp;
@@ -8874,34 +7961,34 @@ static XEN g_set_sample(XEN samp_n, XEN val, XEN snd, XEN chn_n, XEN edpos)
char *origin;
mus_long_t beg;
mus_float_t fval;
- mus_sample_t ival[1];
-
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(samp_n), samp_n, XEN_ARG_1, S_setB S_sample, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_setB S_sample, "a number");
- ASSERT_CHANNEL(S_setB S_sample, snd, chn_n, 3);
- cp = get_cp(snd, chn_n, S_setB S_sample);
- if (!cp) return(XEN_FALSE);
- pos = to_c_edit_position(cp, edpos, S_setB S_sample, 5);
+ mus_float_t ival[1];
+
+ Xen_check_type(Xen_is_integer_or_unbound(samp_n), samp_n, 1, S_set S_sample, "an integer");
+ Xen_check_type(Xen_is_number(val), val, 2, S_set S_sample, "a number");
+ Snd_assert_channel(S_set S_sample, snd, chn_n, 3);
+ cp = get_cp(snd, chn_n, S_set S_sample);
+ if (!cp) return(Xen_false);
+ pos = to_c_edit_position(cp, edpos, S_set S_sample, 5);
if (pos > cp->edit_ctr)
- XEN_ERROR(NO_SUCH_EDIT,
- XEN_LIST_2(C_TO_XEN_STRING(S_setB S_sample ": no such edit: ~A"),
+ Xen_error(NO_SUCH_EDIT,
+ Xen_list_2(C_string_to_Xen_string(S_set S_sample ": no such edit: ~A"),
edpos));
- if (XEN_BOUND_P(samp_n))
- beg = beg_to_sample(samp_n, S_setB S_sample);
- else beg = CURSOR(cp);
+ if (Xen_is_bound(samp_n))
+ beg = beg_to_sample(samp_n, S_set S_sample);
+ else beg = cursor_sample(cp);
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if ((fval == 1.0) &&
- (mus_bytes_per_sample(((cp->sound)->hdr)->format) == 2))
+ (mus_bytes_per_sample(((cp->sound)->hdr)->sample_type) == 2))
fval = 32767.0 / 32768.0;
- ival[0] = MUS_FLOAT_TO_SAMPLE(fval);
+ ival[0] = fval;
#if HAVE_FORTH
- origin = mus_format(MUS_LD " %.4f %s drop", beg, fval, "set-sample");
+ origin = mus_format("%lld %.4f %s drop", beg, fval, "set-sample");
#else
- origin = mus_format("%s" PROC_OPEN MUS_LD PROC_SEP "%.4f", TO_PROC_NAME("set-sample"), beg, fval);
+ origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%.4f", to_proc_name("set-sample"), beg, fval);
#endif
- if (change_samples(beg, 1, ival, cp, origin, pos))
+ if (change_samples(beg, 1, ival, cp, origin, pos, fabs(fval)))
update_graph(cp);
free(origin);
return(val);
@@ -8909,46 +7996,46 @@ static XEN g_set_sample(XEN samp_n, XEN val, XEN snd, XEN chn_n, XEN edpos)
#if HAVE_SCHEME
-static XEN g_set_sample_reversed(s7_scheme *sc, s7_pointer args)
+static Xen g_set_sample_reversed(s7_scheme *sc, s7_pointer args)
{
int len;
- len = XEN_LIST_LENGTH(args);
+ len = Xen_list_length(args);
if (len == 1)
- return(g_set_sample(XEN_UNDEFINED, XEN_LIST_REF(args, 0), XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_sample(Xen_undefined, Xen_list_ref(args, 0), Xen_undefined, Xen_undefined, Xen_undefined));
if (len == 2)
- return(g_set_sample(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_sample(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_undefined, Xen_undefined, Xen_undefined));
if (len == 3)
- return(g_set_sample(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 1), XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_sample(Xen_list_ref(args, 0), Xen_list_ref(args, 2), Xen_list_ref(args, 1), Xen_undefined, Xen_undefined));
if (len == 4)
- return(g_set_sample(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 3), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 2), XEN_UNDEFINED));
+ return(g_set_sample(Xen_list_ref(args, 0), Xen_list_ref(args, 3), Xen_list_ref(args, 1), Xen_list_ref(args, 2), Xen_undefined));
- return(g_set_sample(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 4), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 3)));
+ return(g_set_sample(Xen_list_ref(args, 0), Xen_list_ref(args, 4), Xen_list_ref(args, 1), Xen_list_ref(args, 2), Xen_list_ref(args, 3)));
}
#endif
-file_delete_t xen_to_file_delete_t(XEN auto_delete, const char *caller)
+file_delete_t xen_to_file_delete_t(Xen auto_delete, const char *caller)
{
- if (XEN_BOOLEAN_P(auto_delete))
+ if (Xen_is_boolean(auto_delete))
{
- if (XEN_TO_C_BOOLEAN(auto_delete))
+ if (Xen_boolean_to_C_bool(auto_delete))
return(DELETE_ME);
else return(DONT_DELETE_ME);
}
else
{
- if (XEN_INTEGER_P(auto_delete)) /* might be unbound */
+ if (Xen_is_integer(auto_delete)) /* might be unbound */
{
int val;
- val = XEN_TO_C_INT(auto_delete);
+ val = Xen_integer_to_C_int(auto_delete);
if ((val >= DONT_DELETE_ME) && (val <= MULTICHANNEL_DELETION_IF_FILE))
return((file_delete_t)val);
- XEN_ERROR(XEN_ERROR_TYPE("no-such-auto-delete-choice"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such auto-delete option: ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("no-such-auto-delete-choice"),
+ Xen_list_3(C_string_to_Xen_string("~A: no such auto-delete option: ~A"),
+ C_string_to_Xen_string(caller),
auto_delete));
}
}
@@ -8956,11 +8043,11 @@ file_delete_t xen_to_file_delete_t(XEN auto_delete, const char *caller)
}
-static XEN g_set_samples_with_origin(XEN samp_0, XEN samps, XEN vect, XEN snd, XEN chn_n, XEN truncate,
- const char *edname, XEN infile_chan, XEN edpos, XEN auto_delete)
+static Xen g_set_samples_with_origin(Xen samp_0, Xen samps, Xen vect, Xen snd, Xen chn_n, Xen truncate,
+ const char *edname, Xen infile_chan, Xen edpos, Xen auto_delete)
{
#define H_set_samples "(set-" S_samples " start-samp samps data :optional snd chn truncate edname (infile-chan 0) edpos auto-delete): \
-set snd's channel chn's samples starting at start-samp for samps from data (a vct, vector, or string (filename)); \
+set snd's channel chn's samples starting at start-samp for samps from data (a " S_vct ", vector, or string (filename)); \
start-samp can be beyond current data end; if truncate is " PROC_TRUE " and start-samp is 0, the end of the file is set to match \
the new data's end."
@@ -8974,23 +8061,23 @@ the new data's end."
caller = edname;
else caller = "set-samples";
- ASSERT_SAMPLE_TYPE(caller, samp_0, XEN_ARG_1);
- ASSERT_SAMPLE_TYPE(caller, samps, XEN_ARG_2);
- ASSERT_CHANNEL(caller, snd, chn_n, 4);
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(truncate), truncate, XEN_ARG_6, caller, "a boolean");
+ Snd_assert_sample_type(caller, samp_0, 1);
+ Snd_assert_sample_type(caller, samps, 2);
+ Snd_assert_channel(caller, snd, chn_n, 4);
+ Xen_check_type(Xen_is_boolean_or_unbound(truncate), truncate, 6, caller, "a boolean");
cp = get_cp(snd, chn_n, caller);
- if (!cp) return(XEN_FALSE);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(infile_chan), infile_chan, XEN_ARG_8, caller, "an integer");
+ if (!cp) return(Xen_false);
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(infile_chan), infile_chan, 8, caller, "an integer");
pos = to_c_edit_position(cp, edpos, caller, 9);
beg = beg_to_sample(samp_0, caller);
len = dur_to_samples(samps, beg, cp, pos, 2, caller);
- if (len == 0) return(XEN_FALSE);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(auto_delete), auto_delete, XEN_ARG_10, caller, "a boolean or an integer");
+ if (len == 0) return(Xen_false);
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(auto_delete), auto_delete, 10, caller, "a boolean or an integer");
- override = XEN_TRUE_P(truncate);
- if (XEN_STRING_P(vect))
+ override = Xen_is_true(truncate);
+ if (Xen_is_string(vect))
{
int inchan = 0;
file_delete_t delete_file = DONT_DELETE_ME;
@@ -8999,19 +8086,19 @@ the new data's end."
curlen = cp->edits[pos]->samples;
- fname = XEN_TO_C_STRING(vect);
+ fname = Xen_string_to_C_string(vect);
if (!mus_file_probe(fname))
return(snd_no_such_file_error(caller, vect));
- inchan = XEN_TO_C_INT_OR_ELSE(infile_chan, 0);
+ if (Xen_is_integer(infile_chan)) inchan = Xen_integer_to_C_int(infile_chan);
if ((inchan < 0) ||
(inchan >= mus_sound_chans(fname)))
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_5(C_TO_XEN_STRING("~A: no such channel: ~A (~S has ~A chans)"),
- C_TO_XEN_STRING(caller),
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_5(C_string_to_Xen_string("~A: no such channel: ~A (~S has ~A chans)"),
+ C_string_to_Xen_string(caller),
infile_chan,
vect,
- C_TO_XEN_INT(mus_sound_chans(fname))));
+ C_int_to_Xen_integer(mus_sound_chans(fname))));
delete_file = xen_to_file_delete_t(auto_delete, caller);
if ((beg == 0) &&
@@ -9021,24 +8108,22 @@ the new data's end."
}
else
{
-#if SNDLIB_USE_FLOATS
- if (MUS_VCT_P(vect))
+ if (mus_is_vct(vect))
{
vct *v;
- v = XEN_TO_VCT(vect);
- if (len > v->length) len = v->length;
- change_samples(beg, len, v->data, cp, caller, pos);
+ v = Xen_to_vct(vect);
+ if (len > mus_vct_length(v)) len = mus_vct_length(v);
+ change_samples(beg, len, mus_vct_data(v), cp, caller, pos, -1.0);
}
else
-#endif
{
- mus_sample_t *ivals;
+ mus_float_t *ivals;
int ilen;
ilen = (int)len;
ivals = g_floats_to_samples(vect, &ilen, caller, 3);
if (ivals)
{
- change_samples(beg, (mus_long_t)ilen, ivals, cp, caller, pos);
+ change_samples(beg, (mus_long_t)ilen, ivals, cp, caller, pos, -1.0);
free(ivals);
}
}
@@ -9048,26 +8133,69 @@ the new data's end."
}
-static XEN g_set_samples(XEN samp_0, XEN samps, XEN vect, XEN snd, XEN chn_n, XEN truncate, XEN edname, XEN infile_chan, XEN edpos, XEN auto_delete)
+static Xen g_set_samples(Xen samp_0, Xen samps, Xen vect, Xen snd, Xen chn_n, Xen truncate, Xen edname, Xen infile_chan, Xen edpos, Xen auto_delete)
{
- XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(edname) || XEN_STRING_P(edname) || XEN_FALSE_P(edname), edname, XEN_ARG_7, "set-samples", "a string");
+ Xen_check_type(!Xen_is_bound(edname) || Xen_is_string(edname) || Xen_is_false(edname), edname, 7, "set-samples", "a string");
return(g_set_samples_with_origin(samp_0, samps, vect, snd, chn_n, truncate,
- (char *)((XEN_STRING_P(edname)) ? XEN_TO_C_STRING(edname) : "set-samples"),
+ (char *)((Xen_is_string(edname)) ? Xen_string_to_C_string(edname) : "set-samples"),
infile_chan, edpos, auto_delete));
}
-void check_saved_temp_file(const char *type, XEN filename, XEN date_and_length)
+static Xen g_set_samples_any(Xen args)
+{
+ Xen arg;
+ Xen samp_0 = Xen_undefined, samps = Xen_undefined, vect = Xen_undefined;
+ Xen snd = Xen_undefined, chn_n = Xen_undefined, truncate = Xen_undefined;
+ Xen edname = Xen_undefined, infile_chan = Xen_undefined, edpos = Xen_undefined, auto_delete = Xen_undefined;
+ arg = args;
+ if (!Xen_is_null(arg))
+ {
+ samp_0 = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ samps = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ vect = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ snd = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ chn_n = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ truncate = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ edname = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ infile_chan = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ {
+ edpos = Xen_car(arg); arg = Xen_cdr(arg);
+ if (!Xen_is_null(arg))
+ auto_delete = Xen_car(arg);
+ }}}}}}}}}
+ return(g_set_samples(samp_0, samps, vect, snd, chn_n, truncate, edname, infile_chan, edpos, auto_delete));
+}
+
+
+void check_saved_temp_file(const char *type, Xen filename, Xen date_and_length)
{
const char *file;
- time_t old_time, new_time;
- mus_long_t old_bytes, new_bytes;
- file = XEN_TO_C_STRING(filename);
+ if (!Xen_is_list(date_and_length)) return; /* can this happen? */
+
+ file = Xen_string_to_C_string(filename);
if (mus_file_probe(file))
{
- old_time = (time_t)XEN_TO_C_ULONG(XEN_CAR(date_and_length));
- old_bytes = XEN_TO_C_INT64_T(XEN_CADR(date_and_length));
+ time_t old_time, new_time;
+ mus_long_t old_bytes, new_bytes;
+ old_time = (time_t)Xen_ulong_to_C_ulong(Xen_car(date_and_length));
+ old_bytes = Xen_llong_to_C_llong(Xen_cadr(date_and_length));
new_time = mus_sound_write_date(file);
new_bytes = mus_sound_length(file);
if ((new_time != old_time) || (new_bytes != old_bytes))
@@ -9076,7 +8204,7 @@ void check_saved_temp_file(const char *type, XEN filename, XEN date_and_length)
if (old_time != new_time)
{
if (old_bytes != new_bytes)
- buf = mus_format("Saved %s temp file %s: original write date: %s, current: %s, original length: " MUS_LD "bytes, current: " MUS_LD,
+ buf = mus_format("Saved %s temp file %s: original write date: %s, current: %s, original length: %lldbytes, current: %lld",
type, file,
snd_strftime(STRFTIME_FORMAT, old_time),
snd_strftime(STRFTIME_FORMAT, new_time),
@@ -9087,7 +8215,7 @@ void check_saved_temp_file(const char *type, XEN filename, XEN date_and_length)
snd_strftime(STRFTIME_FORMAT, old_time),
snd_strftime(STRFTIME_FORMAT, new_time));
}
- else buf = mus_format("Saved %s temp file %s: original length: " MUS_LD "bytes, current: " MUS_LD,
+ else buf = mus_format("Saved %s temp file %s: original length: %lldbytes, current: %lld",
type, file,
old_bytes, new_bytes);
snd_warning_without_format(buf);
@@ -9097,201 +8225,346 @@ void check_saved_temp_file(const char *type, XEN filename, XEN date_and_length)
}
-static XEN g_override_samples_with_origin(XEN filename, XEN samps, XEN snd, XEN chn_n, XEN origin, XEN date)
+static Xen g_override_samples_with_origin(Xen filename, Xen samps, Xen snd, Xen chn_n, Xen origin, Xen date)
{
check_saved_temp_file("sound", filename, date);
- return(g_set_samples(XEN_ZERO, samps, filename, snd, chn_n, XEN_TRUE, origin, XEN_ZERO, XEN_FALSE, XEN_FALSE));
+ return(g_set_samples(Xen_integer_zero, samps, filename, snd, chn_n, Xen_true, origin, Xen_integer_zero, Xen_false, Xen_false));
}
-static XEN g_vct_to_channel(XEN v, XEN beg, XEN dur, XEN snd, XEN chn_n, XEN edpos, XEN origin)
+static Xen g_vct_to_channel(Xen v, Xen beg, Xen dur, Xen snd, Xen chn_n, Xen edpos, Xen origin)
{
- #define H_vct_to_channel "(" S_vct_to_channel " vct :optional (beg 0) (dur len) snd chn edpos origin): \
-set snd's channel chn's samples starting at beg for dur samps from vct data"
+ #define H_vct_to_channel "(" S_vct_to_channel " v :optional (beg 0) (dur len) snd chn edpos origin): \
+set snd's channel chn's samples starting at beg for dur samps from " S_vct " v"
const char *caller;
- XEN_ASSERT_TYPE(MUS_VCT_P(v), v, XEN_ARG_1, S_vct_to_channel, "a vct");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, XEN_ARG_7, S_vct_to_channel, "a string");
- if (XEN_NOT_BOUND_P(beg)) beg = XEN_ZERO;
- if (XEN_NOT_BOUND_P(dur))
+ Xen_check_type(mus_is_vct(v), v, 1, S_vct_to_channel, "a " S_vct);
+ Xen_check_type(Xen_is_string_or_unbound(origin), origin, 7, S_vct_to_channel, "a string");
+ if (!Xen_is_bound(beg)) beg = Xen_integer_zero;
+ if (!Xen_is_bound(dur))
{
vct *v1;
- v1 = XEN_TO_VCT(v);
- dur = C_TO_XEN_INT(v1->length);
+ v1 = Xen_to_vct(v);
+ dur = C_int_to_Xen_integer(mus_vct_length(v1));
}
- if (XEN_NOT_BOUND_P(origin))
+ if (!Xen_is_bound(origin))
caller = S_vct_to_channel;
- else caller = (const char *)XEN_TO_C_STRING(origin);
- return(g_set_samples_with_origin(beg, dur, v, snd, chn_n, XEN_FALSE, caller, XEN_FALSE, edpos, XEN_UNDEFINED));
+ else caller = (const char *)Xen_string_to_C_string(origin);
+ return(g_set_samples_with_origin(beg, dur, v, snd, chn_n, Xen_false, caller, Xen_false, edpos, Xen_undefined));
}
-vct *run_samples_to_vct(mus_long_t beg, mus_long_t len, chan_info *cp, int pos)
+vct *samples_to_vct(mus_long_t beg, mus_long_t len, chan_info *cp, int pos, mus_float_t *buf, snd_fd *reader)
{
+ /* if reader, beg, cp, and pos are ignored */
snd_fd *sf;
- int num_to_read = MIX_FILE_BUFFER_SIZE;
- if (len < num_to_read) num_to_read = (int)len; /* we often want fewer than 2048 samps (MIX_FILE_BUFFER_SIZE) */
- /* but this has less effect than I thought -- affects only copy case */
vct *v = NULL;
+ mus_float_t **d;
+ mus_float_t *fvals;
- sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, pos, num_to_read);
- if (sf)
+ if (!buf)
{
- mus_float_t *fvals;
v = mus_vct_make(len);
- fvals = v->data;
+ fvals = mus_vct_data(v);
+ }
+ else
+ {
+ v = mus_vct_wrap(len, buf);
+ fvals = buf;
+ }
+
+ if ((pos == 0) &&
+ (beg + len <= cp->edits[0]->samples) &&
+ (d = mus_sound_saved_data(cp->sound->filename)))
+ {
+ mus_float_t *dc;
+ dc = d[cp->chan];
+ memcpy((void *)fvals, (void *)(dc + beg), len * sizeof(mus_float_t));
+ return(v);
+ }
+
+ if (!reader)
+ sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, pos, len);
+ else sf = reader;
- if (len < (1 << 30))
+ if (sf)
+ {
+ mus_long_t i;
+ i = 0;
+ while (true)
{
- int j, jnum;
- jnum = (int)len;
- if ((sf->runf == next_sample_value_unscaled) && /* not also next_sample_value because next_sound embeds the scaler multiply */
- (ED_LOCAL_POSITION(sf->cb) == 0) &&
- (ED_LOCAL_END(sf->cb) >= (len - 1)))
+ mus_long_t dur, left;
+ dur = sf->last - sf->loc + 1; /* current fragment, we're always reading forward here */
+ left = len - i;
+ if (dur > left) dur = left;
+
+ if (sf->runf == next_sample_value_unscaled)
{
- for (j = 0; j < jnum; j++)
- {
- if (sf->loc > sf->last)
- fvals[j] = next_sound(sf);
- else fvals[j] = sf->data[sf->loc++];
- }
+ memcpy((void *)(fvals + i), (void *)(sf->data + sf->loc), dur * sizeof(mus_float_t));
+ i += dur;
}
else
{
- for (j = 0; j < jnum; j++)
- fvals[j] = read_sample(sf);
+ if (sf->runf == next_sample_value)
+ {
+ mus_float_t scl;
+ scl = sf->fscaler;
+ memcpy((void *)(fvals + i), (void *)(sf->data + sf->loc), dur * sizeof(mus_float_t));
+ left = i + dur;
+ for (; i < left; i++) fvals[i] *= scl;
+ }
+ else
+ {
+ if (sf->runf == next_ramp1)
+ {
+ mus_float_t amp, incr;
+ mus_long_t j;
+ amp = READER_VAL(sf, 0);
+ incr = READER_INCR(sf, 0);
+ left = i + dur;
+ for (j = sf->loc; i < left; i++, j++)
+ {
+ fvals[i] = amp * sf->data[j];
+ amp += incr;
+ }
+ READER_VAL(sf, 0) = amp;
+ }
+ else
+ {
+ if (sf->runf == end_sample_value)
+ break;
+ if (sf->runf == next_zero)
+ i += dur;
+ else
+ {
+ if (sf->runf == next_xramp1)
+ {
+ mus_float_t offset, scaler, xval, scl, incr;
+ mus_long_t j;
+ offset = READER_XRAMP_OFFSET(sf, 0);
+ scl = READER_SCALER(sf);
+ scaler = READER_XRAMP_SCALER(sf, 0);
+ xval = READER_XVAL(sf, 0);
+ incr = READER_XINCR(sf, 0);
+
+ left = i + dur;
+ offset *= scl;
+ scaler *= scl;
+ for (j = sf->loc; i < left; i++, j++)
+ {
+ fvals[i] = sf->data[j] * (offset + scaler * xval);
+ xval *= incr;
+ }
+ READER_XVAL(sf, 0) = xval;
+ }
+ else
+ {
+ left = i + dur;
+ for (; i < left; i++) fvals[i] = read_sample(sf);
+ }
+ }
+ }
+ }
}
+ if (i >= len) break;
+ next_sound_1(sf);
}
- else
- {
- mus_long_t i;
- for (i = 0; i < len; i++)
- fvals[i] = read_sample(sf);
- }
- free_snd_fd(sf);
+ if (!reader)
+ free_snd_fd(sf);
}
-
return(v);
}
-static XEN samples_to_vct_1(XEN samp_0, XEN samps, XEN snd, XEN chn_n, XEN edpos, const char *caller)
+vct *samples_to_vct_with_reader(mus_long_t len, mus_float_t *buf, snd_fd *reader)
+{
+ return(samples_to_vct(0, len, NULL, -1, buf, reader));
+}
+
+
+static Xen samples_to_vct_1(Xen samp_0, Xen samps, Xen snd, Xen chn_n, Xen edpos, const char *caller)
{
chan_info *cp;
mus_long_t len, beg;
int pos;
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(samp_0) || XEN_FALSE_P(samp_0), samp_0, XEN_ARG_1, caller, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(samps) || XEN_FALSE_P(samps), samps, XEN_ARG_2, caller, "a number");
- ASSERT_CHANNEL(caller, snd, chn_n, 3);
+ Xen_check_type(Xen_is_integer_or_unbound(samp_0) || Xen_is_false(samp_0), samp_0, 1, caller, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(samps) || Xen_is_false(samps), samps, 2, caller, "an integer");
+ Snd_assert_channel(caller, snd, chn_n, 3);
cp = get_cp(snd, chn_n, caller);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, caller, 6);
beg = beg_to_sample(samp_0, caller);
- len = XEN_TO_C_INT64_T_OR_ELSE(samps, cp->edits[pos]->samples - beg);
- if ((beg == 0) && (len == 0)) return(XEN_FALSE); /* empty file (channel) possibility */
- if (len <= 0) XEN_OUT_OF_RANGE_ERROR(caller, 2, samps, "samples ~A <= 0?");
+ len = dur_to_samples(samps, beg, cp, pos, 2, caller);
+ if (len == 0) return(Xen_false); /* empty file (channel) possibility */
- return(vct_to_xen(run_samples_to_vct(beg, len, cp, pos)));
+ return(vct_to_xen(samples_to_vct(beg, len, cp, pos, NULL, NULL)));
}
-static XEN g_channel_to_vct(XEN samp_0, XEN samps, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_channel_to_vct(Xen samp_0, Xen samps, Xen snd, Xen chn_n, Xen edpos)
{
#define H_channel_to_vct "(" S_channel_to_vct " :optional (beg 0) (dur len) snd chn edpos): \
-return a vct containing snd channel chn's data starting at beg for dur samps"
+return a " S_vct " containing snd channel chn's data starting at beg for dur samps"
return(samples_to_vct_1(samp_0, samps, snd, chn_n, edpos, S_channel_to_vct));
}
-static XEN g_samples(XEN samp_0, XEN samps, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_samples(Xen samp_0, Xen samps, Xen snd, Xen chn_n, Xen edpos)
{
#define H_samples "(" S_samples " :optional (start-samp 0) (samps len) snd chn edpos): \
-return a vct containing snd channel chn's samples starting a start-samp for samps samples; edpos is the edit \
-history position to read (defaults to current position)."
+return a " S_vct " containing snd channel chn's samples starting at start-samp for samps samples; edpos is the edit \
+history position to read (defaults to current position). snd can be a filename, a mix, a region, or a sound index number."
+
+ chan_info *cp;
+ mus_long_t beg, len;
+ int pos;
+
+ Xen_check_type(Xen_is_integer_or_unbound(samp_0) || Xen_is_false(samp_0), samp_0, 1, S_samples, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(samps) || Xen_is_false(samps), samps, 2, S_samples, "an integer");
+ beg = beg_to_sample(samp_0, S_samples);
+
+ /* -------- a file -------- */
+ if (Xen_is_string(snd))
+ {
+ snd_info *loc_sp = NULL;
+ int chan = 0, chans;
+ const char *filename;
+ mus_float_t *fvals;
+ vct *v;
+
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(chn_n), chn_n, 4, S_samples, "an integer");
+ if (Xen_is_integer(chn_n)) chan = Xen_integer_to_C_int(chn_n);
+ if (chan < 0) return(snd_no_such_channel_error(S_samples, snd, chn_n));
+
+ filename = Xen_string_to_C_string(snd);
+ if (!mus_file_probe(filename))
+ return(snd_no_such_file_error(S_make_sampler, snd));
+
+ if (Xen_is_integer(samps))
+ len = Xen_integer_to_C_int(samps);
+ else len = mus_sound_framples(filename);
+ if (len <= 0) return(Xen_false);
+
+ chans = mus_sound_chans(filename);
+ if (chan >= chans)
+ return(snd_no_such_channel_error(S_samples, snd, chn_n));
+
+ loc_sp = make_sound_readable(filename, false);
+ cp = loc_sp->chans[chan];
+ v = mus_vct_make(len);
+ fvals = mus_vct_data(v);
+ mus_file_to_array(filename, chan, beg, len, fvals);
+
+ completely_free_snd_info(loc_sp);
+ return(vct_to_xen(v));
+ }
+
+ /* -------- a mix -------- */
+ if (xen_is_mix(snd))
+ return(g_mix_to_vct(snd, samp_0, samps));
+
- return(samples_to_vct_1(samp_0, samps, snd, chn_n, edpos, S_samples));
+ /* -------- a region -------- */
+ if (xen_is_region(snd))
+ return(g_region_to_vct(snd, samp_0, samps, chn_n, Xen_false));
+
+
+ /* -------- a sound -------- */
+ Snd_assert_channel(S_samples, snd, chn_n, 3);
+ cp = get_cp(snd, chn_n, S_samples);
+ if (!cp) return(Xen_false);
+
+ pos = to_c_edit_position(cp, edpos, S_samples, 5);
+ len = dur_to_samples(samps, beg, cp, pos, 2, S_samples);
+ if (len == 0) return(Xen_false);
+
+ return(vct_to_xen(samples_to_vct(beg, len, cp, pos, NULL, NULL)));
}
#if HAVE_SCHEME
-static XEN g_set_samples_reversed(s7_scheme *sc, s7_pointer args)
+static Xen g_set_samples_reversed(s7_scheme *sc, s7_pointer args)
{
int len;
- len = XEN_LIST_LENGTH(args);
+ len = Xen_list_length(args);
switch (len)
{
case 3:
- return(g_set_samples(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 2),
- XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED,
- XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_samples(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_list_ref(args, 2),
+ Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined,
+ Xen_undefined, Xen_undefined));
case 4:
- return(g_set_samples(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 3), XEN_LIST_REF(args, 2),
- XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_samples(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_list_ref(args, 3), Xen_list_ref(args, 2),
+ Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined));
case 5:
- return(g_set_samples(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 4),
- XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 3),
- XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_samples(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_list_ref(args, 4),
+ Xen_list_ref(args, 2), Xen_list_ref(args, 3),
+ Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined));
case 6:
- return(g_set_samples(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 5),
- XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 3), XEN_LIST_REF(args, 4),
- XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_samples(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_list_ref(args, 5),
+ Xen_list_ref(args, 2), Xen_list_ref(args, 3), Xen_list_ref(args, 4),
+ Xen_undefined, Xen_undefined, Xen_undefined, Xen_undefined));
case 7:
- return(g_set_samples(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 6),
- XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 3), XEN_LIST_REF(args, 4),
- XEN_LIST_REF(args, 5),
- XEN_UNDEFINED, XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_samples(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_list_ref(args, 6),
+ Xen_list_ref(args, 2), Xen_list_ref(args, 3), Xen_list_ref(args, 4),
+ Xen_list_ref(args, 5),
+ Xen_undefined, Xen_undefined, Xen_undefined));
case 8:
- return(g_set_samples(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 7),
- XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 3), XEN_LIST_REF(args, 4),
- XEN_LIST_REF(args, 5), XEN_LIST_REF(args, 6),
- XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_set_samples(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_list_ref(args, 7),
+ Xen_list_ref(args, 2), Xen_list_ref(args, 3), Xen_list_ref(args, 4),
+ Xen_list_ref(args, 5), Xen_list_ref(args, 6),
+ Xen_undefined, Xen_undefined));
case 9:
- return(g_set_samples(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 8),
- XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 3), XEN_LIST_REF(args, 4),
- XEN_LIST_REF(args, 5), XEN_LIST_REF(args, 6), XEN_LIST_REF(args, 7),
- XEN_UNDEFINED));
+ return(g_set_samples(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_list_ref(args, 8),
+ Xen_list_ref(args, 2), Xen_list_ref(args, 3), Xen_list_ref(args, 4),
+ Xen_list_ref(args, 5), Xen_list_ref(args, 6), Xen_list_ref(args, 7),
+ Xen_undefined));
default:
- return(g_set_samples(XEN_LIST_REF(args, 0), XEN_LIST_REF(args, 1), XEN_LIST_REF(args, 9),
- XEN_LIST_REF(args, 2), XEN_LIST_REF(args, 3), XEN_LIST_REF(args, 4),
- XEN_LIST_REF(args, 5), XEN_LIST_REF(args, 6), XEN_LIST_REF(args, 7),
- XEN_LIST_REF(args, 8)));
+ return(g_set_samples(Xen_list_ref(args, 0), Xen_list_ref(args, 1), Xen_list_ref(args, 9),
+ Xen_list_ref(args, 2), Xen_list_ref(args, 3), Xen_list_ref(args, 4),
+ Xen_list_ref(args, 5), Xen_list_ref(args, 6), Xen_list_ref(args, 7),
+ Xen_list_ref(args, 8)));
}
}
#endif
-static XEN g_change_samples_with_origin(XEN samp_0, XEN samps, XEN origin, XEN vect, XEN snd, XEN chn_n, XEN edpos, XEN date)
+static Xen g_change_samples_with_origin(Xen samp_0, Xen samps, Xen origin, Xen vect, Xen snd, Xen chn_n, Xen edpos, Xen date)
{
chan_info *cp;
int pos;
- mus_long_t beg, len;
+ mus_long_t beg, len = 0;
- XEN_ASSERT_TYPE(XEN_INT64_T_P(samp_0), samp_0, XEN_ARG_1, S_change_samples_with_origin, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(samps), samps, XEN_ARG_2, S_change_samples_with_origin, "an integer");
- XEN_ASSERT_TYPE(XEN_STRING_P(origin), origin, XEN_ARG_3, S_change_samples_with_origin, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(vect), vect, XEN_ARG_4, S_change_samples_with_origin, "a filename");
- ASSERT_CHANNEL(S_change_samples_with_origin, snd, chn_n, 5);
+ Xen_check_type(Xen_is_llong(samp_0), samp_0, 1, S_change_samples_with_origin, "an integer");
+ Xen_check_type(Xen_is_llong(samps), samps, 2, S_change_samples_with_origin, "an integer");
+ Xen_check_type(Xen_is_string(origin), origin, 3, S_change_samples_with_origin, "a string");
+ Xen_check_type(Xen_is_string(vect), vect, 4, S_change_samples_with_origin, "a filename");
+
+ Snd_assert_channel(S_change_samples_with_origin, snd, chn_n, 5);
cp = get_cp(snd, chn_n, S_change_samples_with_origin);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
+
beg = beg_to_sample(samp_0, S_change_samples_with_origin);
- len = XEN_TO_C_INT64_T_OR_ELSE(samps, 0);
- if (len <= 0) return(XEN_FALSE);
+ if (Xen_is_llong(samps)) len = Xen_llong_to_C_llong(samps);
+ if (len <= 0) return(Xen_false);
+
pos = to_c_edit_position(cp, edpos, S_change_samples_with_origin, 7);
check_saved_temp_file("sound", vect, date);
+
file_change_samples(beg, len,
- XEN_TO_C_STRING(vect),
+ Xen_string_to_C_string(vect),
cp, 0, DONT_DELETE_ME,
- XEN_TO_C_STRING(origin),
+ Xen_string_to_C_string(origin),
pos);
update_graph(cp);
return(vect);
}
-static XEN g_insert_sound(XEN file, XEN ubeg, XEN file_chn, XEN snd, XEN chn_n, XEN edpos, XEN auto_delete)
+static Xen g_insert_sound(Xen file, Xen ubeg, Xen file_chn, Xen snd, Xen chn_n, Xen edpos, Xen auto_delete)
{
#if HAVE_SCHEME
#define insert_sound_example "(" S_insert_sound " \"oboe.snd\" 1000)"
@@ -9309,73 +8582,77 @@ position.\n " insert_sound_example "\ninserts all of oboe.snd starting at sampl
chan_info *cp;
static char *filename = NULL;
- int nc, i;
+ int nc;
char *origin;
file_delete_t delete_file = DONT_DELETE_ME;
mus_long_t beg = 0, len;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ARG_1, S_insert_sound, "a string");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(ubeg), ubeg, XEN_ARG_2, S_insert_sound, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(file_chn), file_chn, XEN_ARG_3, S_insert_sound, "an integer");
+ Xen_check_type(Xen_is_string(file), file, 1, S_insert_sound, "a string");
+ Xen_check_type(Xen_is_integer_or_unbound(ubeg), ubeg, 2, S_insert_sound, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(file_chn), file_chn, 3, S_insert_sound, "an integer");
- ASSERT_CHANNEL(S_insert_sound, snd, chn_n, 4);
+ Snd_assert_channel(S_insert_sound, snd, chn_n, 4);
cp = get_cp(snd, chn_n, S_insert_sound);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(auto_delete), auto_delete, XEN_ARG_7, S_insert_sound, "a boolean or an integer");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(auto_delete), auto_delete, 7, S_insert_sound, "a boolean or an integer");
delete_file = xen_to_file_delete_t(auto_delete, S_insert_sound);
if (filename) free(filename);
- filename = mus_expand_filename(XEN_TO_C_STRING(file));
+ filename = mus_expand_filename(Xen_string_to_C_string(file));
if (!mus_file_probe(filename))
return(snd_no_such_file_error(S_insert_sound, file));
nc = mus_sound_chans(filename);
if (nc <= 0)
{
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_3(C_TO_XEN_STRING(S_insert_sound ": chans <= 0? (~S has ~D chans)"),
+ Xen_error(BAD_HEADER,
+ Xen_list_3(C_string_to_Xen_string(S_insert_sound ": chans <= 0? (~S has ~D chans)"),
file,
- C_TO_XEN_INT(nc)));
+ C_int_to_Xen_integer(nc)));
}
- len = mus_sound_frames(filename);
- if (len <= 0) return(C_TO_XEN_INT64_T(len));
+ len = mus_sound_framples(filename);
+ if (len <= 0) return(C_llong_to_Xen_llong(len));
- if (XEN_NUMBER_P(ubeg))
+ if (Xen_is_integer(ubeg))
beg = beg_to_sample(ubeg, S_insert_sound);
- else beg = CURSOR(cp);
+ else beg = cursor_sample(cp);
- if (XEN_INTEGER_P(file_chn))
+ if (Xen_is_integer(file_chn))
{
int fchn;
- fchn = XEN_TO_C_INT(file_chn);
+ fchn = Xen_integer_to_C_int(file_chn);
+ if (fchn < 0)
+ Xen_error(NO_SUCH_CHANNEL, Xen_list_2(C_string_to_Xen_string(S_insert_sound ": file channel: ~D"), file_chn));
+
if (fchn < nc)
{
#if HAVE_FORTH
- origin = mus_format("\"%s\" " MUS_LD " %d %s drop", filename, beg, fchn, S_insert_sound);
+ origin = mus_format("\"%s\" %lld %d %s drop", filename, beg, fchn, S_insert_sound);
#else
- origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP MUS_LD PROC_SEP "%d", TO_PROC_NAME(S_insert_sound), filename, beg, fchn);
+ origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%lld" PROC_SEP "%d", to_proc_name(S_insert_sound), filename, beg, fchn);
#endif
if (file_insert_samples(beg, len, filename, cp, fchn, delete_file, origin,
to_c_edit_position(cp, edpos, S_insert_sound, 6)))
update_graph(cp);
free(origin);
- return(C_TO_XEN_INT64_T(len));
+ return(C_llong_to_Xen_llong(len));
}
else return(snd_no_such_channel_error(S_insert_sound, file, file_chn));
}
else
{
+ int i;
snd_info *sp;
sp = cp->sound;
if (sp->nchans < nc) nc = sp->nchans;
for (i = 0; i < nc; i++)
{
#if HAVE_FORTH
- origin = mus_format("\"%s\" " MUS_LD " %d %s drop", filename, beg, i, S_insert_sound);
+ origin = mus_format("\"%s\" %lld %d %s drop", filename, beg, i, S_insert_sound);
#else
- origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP MUS_LD PROC_SEP "%d", TO_PROC_NAME(S_insert_sound), filename, beg, i);
+ origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%lld" PROC_SEP "%d", to_proc_name(S_insert_sound), filename, beg, i);
#endif
if (file_insert_samples(beg, len, filename, sp->chans[i], i, delete_file, origin,
/* this edit_position cannot be optimized out -- each channel may have
@@ -9385,13 +8662,13 @@ position.\n " insert_sound_example "\ninserts all of oboe.snd starting at sampl
update_graph(sp->chans[i]);
free(origin);
}
- return(C_TO_XEN_INT64_T(len));
+ return(C_llong_to_Xen_llong(len));
}
- return(XEN_FALSE); /* not reached */
+ return(Xen_false); /* not reached */
}
-static XEN g_insert_sample(XEN samp_n, XEN val, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_insert_sample(Xen samp_n, Xen val, Xen snd, Xen chn_n, Xen edpos)
{
#define H_insert_sample "(" S_insert_sample " sample value :optional snd chn edpos): insert 'value' at 'sample' in snd's channel chn"
chan_info *cp;
@@ -9399,21 +8676,21 @@ static XEN g_insert_sample(XEN samp_n, XEN val, XEN snd, XEN chn_n, XEN edpos)
int pos;
mus_long_t beg;
mus_float_t fval;
- mus_sample_t ival[1];
+ mus_float_t ival[1];
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp_n), samp_n, XEN_ARG_1, S_insert_sample, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, S_insert_sample, "a number");
- ASSERT_CHANNEL(S_insert_sample, snd, chn_n, 3);
+ Xen_check_type(Xen_is_integer(samp_n), samp_n, 1, S_insert_sample, "an integer");
+ Xen_check_type(Xen_is_number(val), val, 2, S_insert_sample, "a number");
+ Snd_assert_channel(S_insert_sample, snd, chn_n, 3);
cp = get_cp(snd, chn_n, S_insert_sample);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
beg = beg_to_sample(samp_n, S_insert_sample);
pos = to_c_edit_position(cp, edpos, S_insert_sample, 5);
- fval = XEN_TO_C_DOUBLE(val);
- ival[0] = MUS_FLOAT_TO_SAMPLE(fval);
+ fval = Xen_real_to_C_double(val);
+ ival[0] = fval;
#if HAVE_FORTH
- origin = mus_format(MUS_LD " %.4f %s drop", beg, fval, S_insert_sample);
+ origin = mus_format("%lld %.4f %s drop", beg, fval, S_insert_sample);
#else
- origin = mus_format("%s" PROC_OPEN MUS_LD PROC_SEP "%.4f", TO_PROC_NAME(S_insert_sample), beg, fval);
+ origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%.4f", to_proc_name(S_insert_sample), beg, fval);
#endif
if (insert_samples(beg, 1, ival, cp, origin, pos))
update_graph(cp);
@@ -9422,10 +8699,10 @@ static XEN g_insert_sample(XEN samp_n, XEN val, XEN snd, XEN chn_n, XEN edpos)
}
-static XEN g_insert_samples(XEN samp, XEN samps, XEN vect, XEN snd, XEN chn_n, XEN edpos, XEN auto_delete, XEN caller)
+static Xen g_insert_samples(Xen samp, Xen samps, Xen vect, Xen snd, Xen chn_n, Xen edpos, Xen auto_delete, Xen caller)
{
#define H_insert_samples "(" S_insert_samples " start-samp samps data :optional snd chn edpos auto-delete origin): \
-insert data (either a vct, a list of samples, or a filename) into snd's channel chn starting at 'start-samp' for 'samps' samples"
+insert data (either a " S_vct ", a list of samples, or a filename) into snd's channel chn starting at 'start-samp' for 'samps' samples"
chan_info *cp;
int pos;
@@ -9433,62 +8710,60 @@ insert data (either a vct, a list of samples, or a filename) into snd's channel
file_delete_t delete_file = DONT_DELETE_ME;
mus_long_t beg, len = 0;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp), samp, XEN_ARG_1, S_insert_samples, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samps), samps, XEN_ARG_2, S_insert_samples, "a number");
- ASSERT_CHANNEL(S_insert_samples, snd, chn_n, 4);
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(caller), caller, XEN_ARG_8, S_insert_samples, "a string");
+ Xen_check_type(Xen_is_integer(samp), samp, 1, S_insert_samples, "an integer");
+ Xen_check_type(Xen_is_integer(samps), samps, 2, S_insert_samples, "an integer");
+ Snd_assert_channel(S_insert_samples, snd, chn_n, 4);
+ Xen_check_type(Xen_is_string_or_unbound(caller), caller, 8, S_insert_samples, "a string");
cp = get_cp(snd, chn_n, S_insert_samples);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
beg = beg_to_sample(samp, S_insert_samples);
- len = XEN_TO_C_INT64_T_OR_ELSE(samps, 0);
+ len = Xen_llong_to_C_llong(samps);
if (len <= 0) return(samps);
pos = to_c_edit_position(cp, edpos, S_insert_samples, 6);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(auto_delete), auto_delete, XEN_ARG_7, S_insert_samples, "a boolean or an integer");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(auto_delete), auto_delete, 7, S_insert_samples, "a boolean or an integer");
delete_file = xen_to_file_delete_t(auto_delete, S_insert_samples);
- if (XEN_STRING_P(caller))
- origin = mus_strdup(XEN_TO_C_STRING(caller));
- if (XEN_STRING_P(vect))
+ if (Xen_is_string(caller))
+ origin = mus_strdup(Xen_string_to_C_string(caller));
+ if (Xen_is_string(vect))
{
char *filename;
- filename = mus_expand_filename(XEN_TO_C_STRING(vect));
+ filename = mus_expand_filename(Xen_string_to_C_string(vect));
if (!mus_file_probe(filename))
{
free(filename);
return(snd_no_such_file_error(S_insert_samples, vect));
}
- if (mus_sound_frames(filename) <= 0) return(XEN_ZERO);
+ if (mus_sound_framples(filename) <= 0) return(Xen_integer_zero);
#if HAVE_FORTH
- if (!origin) origin = mus_format(MUS_LD PROC_SEP MUS_LD " \"%s\" %s drop", beg, len, filename, S_insert_samples);
+ if (!origin) origin = mus_format("%lld" PROC_SEP "%lld \"%s\" %s drop", beg, len, filename, S_insert_samples);
#else
- if (!origin) origin = mus_format("%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD PROC_SEP "\"%s\"", TO_PROC_NAME(S_insert_samples), beg, len, filename);
+ if (!origin) origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP "\"%s\"", to_proc_name(S_insert_samples), beg, len, filename);
#endif
file_insert_samples(beg, len, filename, cp, 0, delete_file, origin, pos);
if (filename) free(filename);
}
else
{
-#if SNDLIB_USE_FLOATS
- if (MUS_VCT_P(vect))
+ if (mus_is_vct(vect))
{
vct *v;
- v = XEN_TO_VCT(vect);
- if (len > v->length) len = v->length;
- if (!origin) origin = mus_strdup(TO_PROC_NAME(S_insert_samples));
- insert_samples(beg, len, v->data, cp, origin, pos);
+ v = Xen_to_vct(vect);
+ if (len > mus_vct_length(v)) len = mus_vct_length(v);
+ if (!origin) origin = mus_strdup(to_proc_name(S_insert_samples));
+ insert_samples(beg, len, mus_vct_data(v), cp, origin, pos);
}
else
-#endif
{
int ilen;
- mus_sample_t *ivals;
+ mus_float_t *ivals;
ilen = (int)len;
ivals = g_floats_to_samples(vect, &ilen, S_insert_samples, 3);
if (ivals)
{
- if (!origin) origin = mus_strdup(TO_PROC_NAME(S_insert_samples));
+ if (!origin) origin = mus_strdup(to_proc_name(S_insert_samples));
insert_samples(beg, (mus_long_t)ilen, ivals, cp, origin, pos);
free(ivals);
}
@@ -9496,54 +8771,54 @@ insert data (either a vct, a list of samples, or a filename) into snd's channel
}
if (origin) free(origin);
update_graph(cp);
- return(C_TO_XEN_INT64_T(len));
+ return(C_llong_to_Xen_llong(len));
}
-static XEN g_insert_samples_with_origin(XEN samp, XEN samps, XEN origin, XEN vect, XEN snd, XEN chn_n, XEN edpos, XEN date)
+static Xen g_insert_samples_with_origin(Xen samp, Xen samps, Xen origin, Xen vect, Xen snd, Xen chn_n, Xen edpos, Xen date)
{
chan_info *cp;
int pos;
mus_long_t beg, len;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(samp), samp, XEN_ARG_1, S_insert_samples_with_origin, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(samps), samps, XEN_ARG_2, S_insert_samples_with_origin, "an integer");
- XEN_ASSERT_TYPE(XEN_STRING_P(origin), origin, XEN_ARG_3, S_insert_samples_with_origin, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(vect), vect, XEN_ARG_4, S_insert_samples_with_origin, "a filename");
+ Xen_check_type(Xen_is_integer(samp), samp, 1, S_insert_samples_with_origin, "an integer");
+ Xen_check_type(Xen_is_integer(samps), samps, 2, S_insert_samples_with_origin, "an integer");
+ Xen_check_type(Xen_is_string(origin), origin, 3, S_insert_samples_with_origin, "a string");
+ Xen_check_type(Xen_is_string(vect), vect, 4, S_insert_samples_with_origin, "a filename");
- ASSERT_CHANNEL(S_insert_samples_with_origin, snd, chn_n, 5);
+ Snd_assert_channel(S_insert_samples_with_origin, snd, chn_n, 5);
cp = get_cp(snd, chn_n, S_insert_samples_with_origin);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
beg = beg_to_sample(samp, S_insert_samples_with_origin);
- len = XEN_TO_C_INT64_T_OR_ELSE(samps, 0);
+ len = Xen_llong_to_C_llong(samps);
if (len <= 0) return(samps);
pos = to_c_edit_position(cp, edpos, S_insert_samples_with_origin, 7);
check_saved_temp_file("sound", vect, date);
- file_insert_samples(beg, len, XEN_TO_C_STRING(vect), cp, 0, DONT_DELETE_ME, XEN_TO_C_STRING(origin), pos);
+ file_insert_samples(beg, len, Xen_string_to_C_string(vect), cp, 0, DONT_DELETE_ME, Xen_string_to_C_string(origin), pos);
update_graph(cp);
- return(C_TO_XEN_INT64_T(len));
+ return(C_llong_to_Xen_llong(len));
}
-static XEN g_delete_sample(XEN samp_n, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_delete_sample(Xen samp_n, Xen snd, Xen chn_n, Xen edpos)
{
#define H_delete_sample "(" S_delete_sample " samp :optional snd chn edpos): delete sample 'samp' from snd's channel chn"
chan_info *cp;
mus_long_t samp;
int pos;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp_n), samp_n, XEN_ARG_1, S_delete_sample, "a number");
- ASSERT_CHANNEL(S_delete_sample, snd, chn_n, 2);
+ Xen_check_type(Xen_is_integer(samp_n), samp_n, 1, S_delete_sample, "an integer");
+ Snd_assert_channel(S_delete_sample, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_delete_sample);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
samp = beg_to_sample(samp_n, S_delete_sample);
pos = to_c_edit_position(cp, edpos, S_delete_sample, 4);
if ((samp < 0) || (samp > cp->edits[pos]->samples))
- XEN_ERROR(NO_SUCH_SAMPLE,
- XEN_LIST_2(C_TO_XEN_STRING(S_delete_sample ": no such sample: ~A"),
+ Xen_error(NO_SUCH_SAMPLE,
+ Xen_list_2(C_string_to_Xen_string(S_delete_sample ": no such sample: ~A"),
samp_n));
if (delete_samples(samp, 1, cp, pos))
@@ -9553,7 +8828,7 @@ static XEN g_delete_sample(XEN samp_n, XEN snd, XEN chn_n, XEN edpos)
}
-static XEN g_delete_samples(XEN samp_n, XEN samps, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_delete_samples(Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos)
{
#define H_delete_samples "(" S_delete_samples " start-samp samps :optional snd chn edpos): \
delete 'samps' samples from snd's channel chn starting at 'start-samp'"
@@ -9562,17 +8837,17 @@ delete 'samps' samples from snd's channel chn starting at 'start-samp'"
int pos;
mus_long_t samp, len;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp_n), samp_n, XEN_ARG_1, S_delete_samples, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samps), samps, XEN_ARG_2, S_delete_samples, "a number");
+ Xen_check_type(Xen_is_integer(samp_n), samp_n, 1, S_delete_samples, "an integer");
+ Xen_check_type(Xen_is_integer(samps), samps, 2, S_delete_samples, "an integer");
- ASSERT_CHANNEL(S_delete_samples, snd, chn_n, 3);
+ Snd_assert_channel(S_delete_samples, snd, chn_n, 3);
cp = get_cp(snd, chn_n, S_delete_samples);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, S_delete_samples, 6);
samp = beg_to_sample(samp_n, S_delete_samples);
- len = XEN_TO_C_INT64_T_OR_ELSE(samps, 0);
- if (len <= 0) return(XEN_FALSE);
+ len = Xen_llong_to_C_llong(samps);
+ if (len <= 0) return(Xen_false);
if (delete_samples(samp, len, cp, pos))
update_graph(cp);
@@ -9586,7 +8861,7 @@ delete 'samps' samples from snd's channel chn starting at 'start-samp'"
#include "clm2xen.h"
-static int SND_TO_SAMPLE = 0;
+static int snd_to_sample_tag = 0;
typedef struct {
mus_any_class *core;
@@ -9596,7 +8871,7 @@ typedef struct {
mus_long_t *samps;
} snd_to_sample;
-bool snd_to_sample_p(mus_any *ptr) {return((ptr) && ((ptr->core)->type == SND_TO_SAMPLE));}
+static bool is_snd_to_sample(mus_any *ptr) {return(mus_type(ptr) == snd_to_sample_tag);}
static bool snd_to_sample_equalp(mus_any *p1, mus_any *p2) {return(p1 == p2);}
@@ -9606,29 +8881,25 @@ static mus_long_t snd_to_sample_location(mus_any *ptr) {return(((snd_to_sample *
static char *snd_to_sample_file_name(mus_any *ptr) {return(((snd_to_sample *)ptr)->sp->filename);}
-static mus_long_t snd_to_sample_length(mus_any *ptr) {return(CURRENT_SAMPLES(((snd_to_sample *)ptr)->sp->chans[0]));}
+static mus_long_t snd_to_sample_length(mus_any *ptr) {return(current_samples(((snd_to_sample *)ptr)->sp->chans[0]));}
-static int snd_to_sample_free(mus_any *ptr)
+static void snd_to_sample_free(mus_any *ptr)
{
snd_to_sample *spl = (snd_to_sample *)ptr;
- if (spl)
+ if (spl->sfs)
{
- if (spl->sfs)
- {
- int i;
- for (i = 0; i < spl->chans; i++)
- spl->sfs[i] = free_snd_fd(spl->sfs[i]);
- free(spl->sfs);
- spl->sfs = NULL;
- }
- if (spl->samps)
- {
- free(spl->samps);
- spl->samps = NULL;
- }
- free(spl);
+ int i;
+ for (i = 0; i < spl->chans; i++)
+ spl->sfs[i] = free_snd_fd(spl->sfs[i]);
+ free(spl->sfs);
+ spl->sfs = NULL;
}
- return(0);
+ if (spl->samps)
+ {
+ free(spl->samps);
+ spl->samps = NULL;
+ }
+ free(spl);
}
@@ -9653,7 +8924,7 @@ static char *snd_to_sample_describe(mus_any *ptr)
}
}
snd_to_sample_buf = (char *)calloc(len, sizeof(char));
- mus_snprintf(snd_to_sample_buf, len, "%s reading %s (%d chan%s) at " MUS_LD ":[",
+ snprintf(snd_to_sample_buf, len, "%s reading %s (%d chan%s) at %lld:[",
mus_name(ptr),
spl->sp->short_filename,
spl->chans,
@@ -9681,7 +8952,7 @@ static char *snd_to_sample_describe(mus_any *ptr)
}
-mus_float_t snd_to_sample_read(mus_any *ptr, mus_long_t frame, int chan)
+static mus_float_t snd_to_sample_read(mus_any *ptr, mus_long_t frample, int chan)
{
snd_to_sample *spl = (snd_to_sample *)ptr;
mus_long_t diff, i;
@@ -9689,11 +8960,11 @@ mus_float_t snd_to_sample_read(mus_any *ptr, mus_long_t frame, int chan)
spl->sfs = (snd_fd **)calloc(spl->chans, sizeof(snd_fd *));
if (!(spl->sfs[chan]))
{
- spl->sfs[chan] = init_sample_read(frame, spl->sp->chans[chan], READ_FORWARD);
- spl->samps[chan] = frame;
+ spl->sfs[chan] = init_sample_read(frample, spl->sp->chans[chan], READ_FORWARD);
+ spl->samps[chan] = frample;
return(next_sample_value(spl->sfs[chan]));
}
- diff = frame - spl->samps[chan];
+ diff = frample - spl->samps[chan];
if (diff == 1)
{
spl->samps[chan]++;
@@ -9702,84 +8973,58 @@ mus_float_t snd_to_sample_read(mus_any *ptr, mus_long_t frame, int chan)
if (diff > 1)
{
for (i = 1; i < diff; i++) next_sample_value(spl->sfs[chan]); /* just push pointer forward */
- spl->samps[chan] = frame;
+ spl->samps[chan] = frample;
return(next_sample_value(spl->sfs[chan]));
}
diff = -diff;
for (i = 0; i <= diff; i++) previous_sample_value(spl->sfs[chan]); /* just push pointer backward (one too far) */
- spl->samps[chan] = frame;
+ spl->samps[chan] = frample;
return(next_sample_value(spl->sfs[chan])); /* always end up going forward (for simpler code) */
}
-static mus_any_class SND_TO_SAMPLE_CLASS = {
- -1,
- (char *)S_snd_to_sample,
- &snd_to_sample_free,
- &snd_to_sample_describe,
- &snd_to_sample_equalp,
- 0, 0,
- &snd_to_sample_length, 0,
- 0, 0, 0, 0,
- 0, 0,
- 0, 0,
- 0,
- MUS_INPUT,
- NULL, /* environ */
- &snd_to_sample_channels,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- &snd_to_sample_read,
- 0,
- &snd_to_sample_file_name,
- 0,
- &snd_to_sample_location,
- 0, /* set location (ptr, mus_long_t loc) */
- 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0
-};
-
+static mus_any_class *snd_to_sample_class;
static mus_any *make_snd_to_sample(snd_info *sp)
{
snd_to_sample *gen;
gen = (snd_to_sample *)calloc(1, sizeof(snd_to_sample));
- gen->core = &SND_TO_SAMPLE_CLASS;
- gen->core->type = SND_TO_SAMPLE;
+ gen->core = snd_to_sample_class;
gen->chans = sp->nchans;
gen->sp = sp;
gen->samps = (mus_long_t *)calloc(sp->nchans, sizeof(mus_long_t));
- gen->sfs = NULL; /* created as needed */
+ gen->sfs = NULL; /* created as needed */
return((mus_any *)gen);
}
-static XEN g_snd_to_sample_p(XEN os)
+static Xen g_is_snd_to_sample(Xen os)
{
- #define H_snd_to_sample_p "(" S_snd_to_sample_p " gen): " PROC_TRUE " if gen is an " S_snd_to_sample " generator"
- return(C_TO_XEN_BOOLEAN((mus_xen_p(os)) &&
- (snd_to_sample_p(XEN_TO_MUS_ANY(os)))));
+ #define H_is_snd_to_sample "(" S_is_snd_to_sample " gen): " PROC_TRUE " if gen is an " S_snd_to_sample " generator"
+ return(C_bool_to_Xen_boolean((mus_is_xen(os)) &&
+ (is_snd_to_sample(Xen_to_mus_any(os)))));
}
-static XEN g_snd_to_sample(XEN os, XEN frame, XEN chan)
+static Xen g_snd_to_sample(Xen os, Xen frample, Xen chan)
{
- #define H_snd_to_sample "(" S_snd_to_sample " gen frame chan): input sample (via snd->sample gen) at frame in channel chan"
- XEN_ASSERT_TYPE((mus_xen_p(os)) && (snd_to_sample_p(XEN_TO_MUS_ANY(os))), os, XEN_ARG_1, S_snd_to_sample, "a " S_snd_to_sample " gen");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(frame), frame, XEN_ARG_2, S_snd_to_sample, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chan), chan, XEN_ARG_3, S_snd_to_sample, "an integer");
- return(C_TO_XEN_DOUBLE(snd_to_sample_read((mus_any *)XEN_TO_MUS_ANY(os),
- XEN_TO_C_INT64_T(frame),
- XEN_TO_C_INT_OR_ELSE(chan, 0))));
+ #define H_snd_to_sample "(" S_snd_to_sample " gen frample chan): input sample (via snd->sample gen) at frample in channel chan"
+ Xen_check_type((mus_is_xen(os)) && (is_snd_to_sample(Xen_to_mus_any(os))), os, 1, S_snd_to_sample, "a " S_snd_to_sample " gen");
+ Xen_check_type(Xen_is_llong(frample), frample, 2, S_snd_to_sample, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(chan), chan, 3, S_snd_to_sample, "an integer");
+ return(C_double_to_Xen_real(snd_to_sample_read((mus_any *)Xen_to_mus_any(os),
+ Xen_llong_to_C_llong(frample),
+ (Xen_is_integer(chan)) ? Xen_integer_to_C_int(chan) : 0)));
}
-static XEN g_make_snd_to_sample(XEN snd)
+static Xen g_make_snd_to_sample(Xen snd)
{
#define H_make_snd_to_sample "(" S_make_snd_to_sample " snd): return a new " S_snd_to_sample " (Snd to CLM input) generator"
mus_any *ge;
snd_info *sp;
- ASSERT_SOUND(S_make_snd_to_sample, snd, 1);
+ Snd_assert_sound(S_make_snd_to_sample, snd, 1);
sp = get_sp(snd);
if (sp == NULL)
@@ -9788,231 +9033,284 @@ static XEN g_make_snd_to_sample(XEN snd)
ge = make_snd_to_sample(sp);
if (ge)
return(mus_xen_to_object(mus_any_to_mus_xen(ge)));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_edit_list_to_function(XEN snd, XEN chn, XEN start, XEN end)
+static Xen g_edit_list_to_function(Xen snd, Xen chn, Xen start, Xen end)
{
#define H_edit_list_to_function "(" S_edit_list_to_function " :optional snd chn start end): function encapsulating edits"
chan_info *cp;
char *funcstr = NULL;
- XEN func;
+ Xen func;
int start_pos = 1, end_pos = -1;
- ASSERT_CHANNEL(S_edit_list_to_function, snd, chn, 1);
+ Snd_assert_channel(S_edit_list_to_function, snd, chn, 1);
cp = get_cp(snd, chn, S_edit_list_to_function);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(start), start, XEN_ARG_3, S_edit_list_to_function, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(end), end, XEN_ARG_4, S_edit_list_to_function, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(start), start, 3, S_edit_list_to_function, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(end), end, 4, S_edit_list_to_function, "an integer");
- start_pos = XEN_TO_C_INT_OR_ELSE(start, 1);
- end_pos = XEN_TO_C_INT_OR_ELSE(end, -1);
+ if (Xen_is_integer(start)) start_pos = Xen_integer_to_C_int(start);
+ if (start_pos < 0) /* is 0 legal here? */
+ Xen_out_of_range_error(S_edit_list_to_function, 3, start, "a non-negative integer");
+ if (Xen_is_integer(end)) end_pos = Xen_integer_to_C_int(end);
funcstr = edit_list_to_function(cp, start_pos, end_pos);
- func = XEN_EVAL_C_STRING(funcstr);
+ func = Xen_eval_C_string(funcstr);
#if HAVE_RUBY
- rb_set_property(rb_obj_id(func), C_STRING_TO_XEN_SYMBOL("proc_source"), C_TO_XEN_STRING(funcstr));
+ rb_set_property(rb_obj_id(func), C_string_to_Xen_symbol("proc_source"), C_string_to_Xen_string(funcstr));
#endif
#if HAVE_FORTH
- fth_proc_source_set(func, C_TO_XEN_STRING(funcstr));
+ fth_proc_source_set(func, C_string_to_Xen_string(funcstr));
#endif
free(funcstr);
return(func);
}
+#if HAVE_SCHEME
+static s7_double next_sample_rf_s(s7_scheme *sc, s7_pointer **p)
+{
+ snd_fd *fd;
+ fd = (snd_fd *)(*(*p)); (*p)++;
+ return(protected_next_sample(fd));
+}
-static XEN g_max_virtual_ptrees(void)
-{
- #define H_max_virtual_ptrees "(" S_max_virtual_ptrees "): most ptrees running at once in virtual edits (default: 32)"
- return(C_TO_XEN_INT(max_virtual_ptrees));
-}
-
-static XEN g_set_max_virtual_ptrees(XEN num)
-{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(num), num, XEN_ONLY_ARG, S_setB S_max_virtual_ptrees, "integer");
- max_virtual_ptrees = XEN_TO_C_INT(num);
- return(num);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_5(g_make_sampler_w, g_make_sampler)
-XEN_ARGIFY_4(g_make_region_sampler_w, g_make_region_sampler)
-XEN_NARGIFY_1(g_next_sample_w, g_next_sample)
-XEN_NARGIFY_1(g_read_sample_w, g_read_sample)
-XEN_NARGIFY_1(g_previous_sample_w, g_previous_sample)
-XEN_NARGIFY_1(g_free_sampler_w, g_free_sampler)
-XEN_NARGIFY_1(g_sampler_home_w, g_sampler_home)
-XEN_NARGIFY_1(g_sampler_position_w, g_sampler_position)
-XEN_NARGIFY_1(g_sampler_p_w, g_sampler_p)
-XEN_NARGIFY_1(g_region_sampler_p_w, g_region_sampler_p)
-XEN_NARGIFY_1(g_sampler_at_end_w, g_sampler_at_end)
-XEN_NARGIFY_1(g_copy_sampler_w, g_copy_sampler)
-XEN_ARGIFY_3(g_save_edit_history_w, g_save_edit_history)
-XEN_ARGIFY_3(g_edit_fragment_w, g_edit_fragment)
-XEN_ARGIFY_3(g_undo_w, g_undo)
-XEN_ARGIFY_3(g_redo_w, g_redo)
-XEN_ARGIFY_2(g_as_one_edit_w, g_as_one_edit)
-XEN_ARGIFY_4(g_display_edits_w, g_display_edits)
-XEN_ARGIFY_3(g_edit_tree_w, g_edit_tree)
-XEN_ARGIFY_4(g_delete_sample_w, g_delete_sample)
-XEN_ARGIFY_5(g_delete_samples_w, g_delete_samples)
-XEN_ARGIFY_5(g_insert_sample_w, g_insert_sample)
-XEN_ARGIFY_8(g_insert_samples_w, g_insert_samples)
-XEN_ARGIFY_7(g_vct_to_channel_w, g_vct_to_channel)
-XEN_ARGIFY_5(g_channel_to_vct_w, g_channel_to_vct)
-XEN_ARGIFY_7(g_insert_sound_w, g_insert_sound)
-XEN_ARGIFY_6(g_scale_channel_w, g_scale_channel)
-XEN_ARGIFY_6(g_normalize_channel_w, g_normalize_channel)
-XEN_ARGIFY_8(g_change_samples_with_origin_w, g_change_samples_with_origin)
-XEN_ARGIFY_8(g_insert_samples_with_origin_w, g_insert_samples_with_origin)
-XEN_ARGIFY_6(g_override_samples_with_origin_w, g_override_samples_with_origin)
-XEN_ARGIFY_4(g_sample_w, g_sample)
-XEN_ARGIFY_5(g_set_sample_w, g_set_sample)
-XEN_ARGIFY_5(g_samples_w, g_samples)
-XEN_ARGIFY_10(g_set_samples_w, g_set_samples)
-XEN_NARGIFY_1(g_snd_to_sample_p_w, g_snd_to_sample_p)
-XEN_ARGIFY_3(g_snd_to_sample_w, g_snd_to_sample)
-XEN_ARGIFY_1(g_make_snd_to_sample_w, g_make_snd_to_sample)
-XEN_ARGIFY_4(g_edit_list_to_function_w, g_edit_list_to_function)
-XEN_NARGIFY_0(g_max_virtual_ptrees_w, g_max_virtual_ptrees)
-XEN_NARGIFY_1(g_set_max_virtual_ptrees_w, g_set_max_virtual_ptrees)
-XEN_NARGIFY_1(g_edit_fragment_type_name_w, g_edit_fragment_type_name)
-#else
-#define g_make_sampler_w g_make_sampler
-#define g_make_region_sampler_w g_make_region_sampler
-#define g_next_sample_w g_next_sample
-#define g_read_sample_w g_read_sample
-#define g_previous_sample_w g_previous_sample
-#define g_free_sampler_w g_free_sampler
-#define g_sampler_home_w g_sampler_home
-#define g_sampler_position_w g_sampler_position
-#define g_sampler_p_w g_sampler_p
-#define g_region_sampler_p_w g_region_sampler_p
-#define g_sampler_at_end_w g_sampler_at_end
-#define g_copy_sampler_w g_copy_sampler
-#define g_save_edit_history_w g_save_edit_history
-#define g_edit_fragment_w g_edit_fragment
-#define g_undo_w g_undo
-#define g_redo_w g_redo
-#define g_as_one_edit_w g_as_one_edit
-#define g_display_edits_w g_display_edits
-#define g_edit_tree_w g_edit_tree
-#define g_delete_sample_w g_delete_sample
-#define g_delete_samples_w g_delete_samples
-#define g_insert_sample_w g_insert_sample
-#define g_insert_samples_w g_insert_samples
-#define g_vct_to_channel_w g_vct_to_channel
-#define g_channel_to_vct_w g_channel_to_vct
-#define g_insert_sound_w g_insert_sound
-#define g_scale_channel_w g_scale_channel
-#define g_normalize_channel_w g_normalize_channel
-#define g_change_samples_with_origin_w g_change_samples_with_origin
-#define g_insert_samples_with_origin_w g_insert_samples_with_origin
-#define g_override_samples_with_origin_w g_override_samples_with_origin
-#define g_sample_w g_sample
-#define g_set_sample_w g_set_sample
-#define g_samples_w g_samples
-#define g_set_samples_w g_set_samples
-#define g_snd_to_sample_p_w g_snd_to_sample_p
-#define g_make_snd_to_sample_w g_make_snd_to_sample
-#define g_snd_to_sample_w g_snd_to_sample
-#define g_edit_list_to_function_w g_edit_list_to_function
-#define g_max_virtual_ptrees_w g_max_virtual_ptrees
-#define g_set_max_virtual_ptrees_w g_set_max_virtual_ptrees
-#define g_edit_fragment_type_name_w g_edit_fragment_type_name
+static s7_double read_sample_rf_s(s7_scheme *sc, s7_pointer **p)
+{
+ snd_fd *fd;
+ fd = (snd_fd *)(*(*p)); (*p)++;
+ return(read_sample(fd));
+}
+
+static s7_double next_mix_sample_rf_s(s7_scheme *sc, s7_pointer **p)
+{
+ snd_fd *fd;
+ fd = (snd_fd *)(*(*p)); (*p)++;
+ return(protected_next_sample(fd));
+}
+
+static s7_double read_mix_sample_rf_s(s7_scheme *sc, s7_pointer **p)
+{
+ snd_fd *fd;
+ fd = (snd_fd *)(*(*p)); (*p)++;
+ return(read_sample(fd));
+}
+
+static s7_rf_t read_sample_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer sym, o;
+ snd_fd *g;
+
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL); /* just (gen s) for now */
+ sym = s7_cadr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ if (s7_xf_is_stepper(sc, sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ g = (snd_fd *)s7_object_value_checked(o, sf_tag);
+ if (g)
+ {
+ s7_xf_store(sc, (s7_pointer)g);
+ return(read_sample_rf_s);
+ }
+ if (is_mix_sampler(o))
+ {
+ s7_xf_store(sc, (s7_pointer)mf_to_snd_fd(s7_object_value(o)));
+ return(read_mix_sample_rf_s);
+ }
+ return(NULL);
+}
+
+static s7_rf_t next_sample_rf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer sym, o;
+ snd_fd *g;
+
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL);
+ sym = s7_cadr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ if (s7_xf_is_stepper(sc, sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ g = (snd_fd *)s7_object_value_checked(o, sf_tag);
+ if (g)
+ {
+ s7_xf_store(sc, (s7_pointer)g);
+ return(next_sample_rf_s);
+ }
+ if (is_mix_sampler(o))
+ {
+ s7_xf_store(sc, (s7_pointer)mf_to_snd_fd(s7_object_value(o)));
+ return(next_mix_sample_rf_s);
+ }
+ return(NULL);
+}
+
+static s7_pointer is_sampler_at_end_pf_s(s7_scheme *sc, s7_pointer **p)
+{
+ snd_fd *fd;
+ fd = (snd_fd *)(*(*p)); (*p)++;
+ return(s7_make_boolean(sc, fd->at_eof));
+}
+
+static s7_pf_t is_sampler_at_end_pf(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer sym, o;
+ snd_fd *g;
+
+ if (!s7_is_null(sc, s7_cddr(expr))) return(NULL);
+ sym = s7_cadr(expr);
+ if (!s7_is_symbol(sym)) return(NULL);
+ if (s7_xf_is_stepper(sc, sym)) return(NULL);
+ o = s7_symbol_value(sc, sym);
+ g = (snd_fd *)s7_object_value_checked(o, sf_tag);
+ if (g)
+ {
+ s7_xf_store(sc, (s7_pointer)g);
+ return(is_sampler_at_end_pf_s);
+ }
+ if (is_mix_sampler(o))
+ {
+ s7_xf_store(sc, (s7_pointer)mf_to_snd_fd(s7_object_value(o)));
+ return(is_sampler_at_end_pf_s);
+ }
+ return(NULL);
+}
#endif
+Xen_wrap_5_optional_args(g_make_sampler_w, g_make_sampler)
+Xen_wrap_4_optional_args(g_make_region_sampler_w, g_make_region_sampler)
+Xen_wrap_1_arg(g_next_sample_w, g_next_sample)
+Xen_wrap_1_arg(g_read_sample_w, g_read_sample)
+Xen_wrap_2_args(g_read_sample_with_direction_w, g_read_sample_with_direction)
+Xen_wrap_1_arg(g_previous_sample_w, g_previous_sample)
+Xen_wrap_1_arg(g_free_sampler_w, g_free_sampler)
+Xen_wrap_1_arg(g_sampler_home_w, g_sampler_home)
+Xen_wrap_1_arg(g_sampler_position_w, g_sampler_position)
+Xen_wrap_1_arg(g_is_sampler_w, g_is_sampler)
+Xen_wrap_1_arg(g_region_is_sampler_w, g_region_is_sampler)
+Xen_wrap_1_arg(g_sampler_at_end_w, g_sampler_at_end)
+Xen_wrap_1_arg(g_copy_sampler_w, g_copy_sampler)
+Xen_wrap_3_optional_args(g_save_edit_history_w, g_save_edit_history)
+Xen_wrap_3_optional_args(g_edit_fragment_w, g_edit_fragment)
+Xen_wrap_3_optional_args(g_undo_w, g_undo)
+Xen_wrap_3_optional_args(g_redo_w, g_redo)
+Xen_wrap_2_optional_args(g_as_one_edit_w, g_as_one_edit)
+Xen_wrap_3_optional_args(g_display_edits_w, g_display_edits)
+Xen_wrap_3_optional_args(g_edit_tree_w, g_edit_tree)
+Xen_wrap_4_optional_args(g_delete_sample_w, g_delete_sample)
+Xen_wrap_5_optional_args(g_delete_samples_w, g_delete_samples)
+Xen_wrap_5_optional_args(g_insert_sample_w, g_insert_sample)
+Xen_wrap_8_optional_args(g_insert_samples_w, g_insert_samples)
+Xen_wrap_7_optional_args(g_vct_to_channel_w, g_vct_to_channel)
+Xen_wrap_5_optional_args(g_channel_to_vct_w, g_channel_to_vct)
+Xen_wrap_7_optional_args(g_insert_sound_w, g_insert_sound)
+Xen_wrap_6_optional_args(g_scale_channel_w, g_scale_channel)
+Xen_wrap_6_optional_args(g_normalize_channel_w, g_normalize_channel)
+Xen_wrap_8_optional_args(g_change_samples_with_origin_w, g_change_samples_with_origin)
+Xen_wrap_8_optional_args(g_insert_samples_with_origin_w, g_insert_samples_with_origin)
+Xen_wrap_6_optional_args(g_override_samples_with_origin_w, g_override_samples_with_origin)
+Xen_wrap_4_optional_args(g_sample_w, g_sample)
+#if HAVE_SCHEME
+#define g_set_sample_w g_set_sample_reversed
+#define g_set_samples_w g_set_samples_reversed
+Xen_wrap_5_optional_args(orig_g_set_sample_w, g_set_sample)
+#else
+Xen_wrap_5_optional_args(g_set_sample_w, g_set_sample)
+Xen_wrap_any_args(g_set_samples_w, g_set_samples_any)
+#endif
+Xen_wrap_any_args(orig_g_set_samples_w, g_set_samples_any)
+Xen_wrap_5_optional_args(g_samples_w, g_samples)
+Xen_wrap_1_arg(g_is_snd_to_sample_w, g_is_snd_to_sample)
+Xen_wrap_3_optional_args(g_snd_to_sample_w, g_snd_to_sample)
+Xen_wrap_1_optional_arg(g_make_snd_to_sample_w, g_make_snd_to_sample)
+Xen_wrap_4_optional_args(g_edit_list_to_function_w, g_edit_list_to_function)
+Xen_wrap_1_arg(g_edit_fragment_type_name_w, g_edit_fragment_type_name)
+
void g_init_edits(void)
{
#if HAVE_SCHEME
- sf_tag = XEN_MAKE_OBJECT_TYPE("<sampler>", print_sf, free_sf, s7_equalp_sf, NULL, s7_read_sample, NULL, NULL, NULL, NULL);
+ sf_tag = s7_new_type_x(s7, "<sampler>", print_sf, free_sf, s7_equalp_sf, NULL, s7_read_sample, NULL, length_sf, NULL, NULL, NULL);
#else
- sf_tag = XEN_MAKE_OBJECT_TYPE("Sampler", sizeof(snd_fd));
+ sf_tag = Xen_make_object_type("Sampler", sizeof(snd_fd));
#endif
#if HAVE_RUBY
- rb_define_method(sf_tag, "to_s", XEN_PROCEDURE_CAST print_sf, 0);
- rb_define_method(sf_tag, "call", XEN_PROCEDURE_CAST g_read_sample, 0);
+ rb_define_method(sf_tag, "to_s", Xen_procedure_cast print_sf, 0);
+ rb_define_method(sf_tag, "call", Xen_procedure_cast g_read_sample, 0);
#endif
#if HAVE_FORTH
fth_set_object_inspect(sf_tag, print_sf);
fth_set_object_free(sf_tag, free_sf);
- fth_set_object_apply(sf_tag, XEN_PROCEDURE_CAST g_read_sample, 0, 0, 0);
+ fth_set_object_apply(sf_tag, Xen_procedure_cast g_read_sample, 0, 0, 0);
#endif
- XEN_DEFINE_CONSTANT(S_current_edit_position, AT_CURRENT_EDIT_POSITION, "represents the current edit history list position (-1)");
-
- XEN_DEFINE_PROCEDURE(S_make_sampler, g_make_sampler_w, 0, 5, 0, H_make_sampler);
- XEN_DEFINE_PROCEDURE(S_make_region_sampler, g_make_region_sampler_w, 1, 3, 0, H_make_region_sampler);
- XEN_DEFINE_PROCEDURE(S_read_sample, g_read_sample_w, 1, 0, 0, H_read_sample);
- XEN_DEFINE_PROCEDURE(S_read_region_sample, g_read_sample_w, 1, 0, 0, H_read_sample);
- XEN_DEFINE_PROCEDURE(S_next_sample, g_next_sample_w, 1, 0, 0, H_next_sample);
- XEN_DEFINE_PROCEDURE(S_previous_sample, g_previous_sample_w, 1, 0, 0, H_previous_sample);
- XEN_DEFINE_PROCEDURE(S_free_sampler, g_free_sampler_w, 1, 0, 0, H_free_sampler);
- XEN_DEFINE_PROCEDURE(S_sampler_home, g_sampler_home_w, 1, 0, 0, H_sampler_home);
- XEN_DEFINE_PROCEDURE(S_sampler_p, g_sampler_p_w, 1, 0, 0, H_sampler_p);
- XEN_DEFINE_PROCEDURE(S_region_sampler_p, g_region_sampler_p_w, 1, 0, 0, H_region_sampler_p);
- XEN_DEFINE_PROCEDURE(S_sampler_at_end_p, g_sampler_at_end_w, 1, 0, 0, H_sampler_at_end);
- XEN_DEFINE_PROCEDURE(S_sampler_position, g_sampler_position_w, 1, 0, 0, H_sampler_position);
- XEN_DEFINE_PROCEDURE(S_copy_sampler, g_copy_sampler_w, 1, 0, 0, H_copy_sampler);
-
- XEN_DEFINE_PROCEDURE(S_save_edit_history, g_save_edit_history_w, 1, 2, 0, H_save_edit_history);
- XEN_DEFINE_PROCEDURE(S_edit_fragment, g_edit_fragment_w, 0, 3, 0, H_edit_fragment);
- XEN_DEFINE_PROCEDURE(S_edit_fragment_type_name, g_edit_fragment_type_name_w, 1, 0, 0, "internal testing function");
-
- XEN_DEFINE_PROCEDURE(S_undo, g_undo_w, 0, 3, 0, H_undo);
+ Xen_define_constant(S_current_edit_position, AT_CURRENT_EDIT_POSITION, "represents the current edit history list position (-1)");
+
+ Xen_define_safe_procedure(S_make_sampler, g_make_sampler_w, 0, 5, 0, H_make_sampler);
+ Xen_define_safe_procedure(S_make_region_sampler, g_make_region_sampler_w, 1, 3, 0, H_make_region_sampler);
+ Xen_define_safe_procedure(S_read_sample, g_read_sample_w, 1, 0, 0, H_read_sample);
+ Xen_define_safe_procedure(S_read_sample_with_direction, g_read_sample_with_direction_w, 2, 0, 0, H_read_sample_with_direction);
+ Xen_define_safe_procedure(S_read_region_sample, g_read_sample_w, 1, 0, 0, H_read_sample);
+ Xen_define_safe_procedure(S_next_sample, g_next_sample_w, 1, 0, 0, H_next_sample);
+ Xen_define_safe_procedure(S_previous_sample, g_previous_sample_w, 1, 0, 0, H_previous_sample);
+ Xen_define_safe_procedure(S_free_sampler, g_free_sampler_w, 1, 0, 0, H_free_sampler);
+ Xen_define_safe_procedure(S_sampler_home, g_sampler_home_w, 1, 0, 0, H_sampler_home);
+ Xen_define_safe_procedure(S_is_sampler, g_is_sampler_w, 1, 0, 0, H_is_sampler);
+ Xen_define_safe_procedure(S_is_region_sampler, g_region_is_sampler_w, 1, 0, 0, H_region_is_sampler);
+ Xen_define_safe_procedure(S_is_sampler_at_end, g_sampler_at_end_w, 1, 0, 0, H_sampler_at_end);
+ Xen_define_safe_procedure(S_sampler_position, g_sampler_position_w, 1, 0, 0, H_sampler_position);
+ Xen_define_safe_procedure(S_copy_sampler, g_copy_sampler_w, 1, 0, 0, H_copy_sampler);
+
+ Xen_define_safe_procedure(S_save_edit_history, g_save_edit_history_w, 1, 2, 0, H_save_edit_history);
+ Xen_define_safe_procedure(S_edit_fragment, g_edit_fragment_w, 0, 3, 0, H_edit_fragment);
+ Xen_define_safe_procedure(S_edit_fragment_type_name,g_edit_fragment_type_name_w, 1, 0, 0, "internal testing function");
+
+ Xen_define_safe_procedure(S_undo, g_undo_w, 0, 3, 0, H_undo);
#if HAVE_RUBY
- XEN_DEFINE_PROCEDURE("undo_edit", g_undo_w, 0, 3, 0, H_undo);
+ Xen_define_procedure("undo_edit", g_undo_w, 0, 3, 0, H_undo);
#endif
- XEN_DEFINE_PROCEDURE(S_redo, g_redo_w, 0, 3, 0, H_redo);
- XEN_DEFINE_PROCEDURE(S_as_one_edit, g_as_one_edit_w, 1, 1, 0, H_as_one_edit);
- XEN_DEFINE_PROCEDURE(S_display_edits, g_display_edits_w, 0, 4, 0, H_display_edits);
- XEN_DEFINE_PROCEDURE(S_edit_tree, g_edit_tree_w, 0, 3, 0, H_edit_tree);
-
- XEN_DEFINE_PROCEDURE(S_delete_sample, g_delete_sample_w, 1, 3, 0, H_delete_sample);
- XEN_DEFINE_PROCEDURE(S_delete_samples, g_delete_samples_w, 2, 3, 0, H_delete_samples);
- XEN_DEFINE_PROCEDURE(S_insert_sample, g_insert_sample_w, 2, 3, 0, H_insert_sample);
- XEN_DEFINE_PROCEDURE(S_insert_samples, g_insert_samples_w, 3, 5, 0, H_insert_samples);
- XEN_DEFINE_PROCEDURE(S_vct_to_channel, g_vct_to_channel_w, 1, 6, 0, H_vct_to_channel);
- XEN_DEFINE_PROCEDURE(S_channel_to_vct, g_channel_to_vct_w, 0, 5, 0, H_channel_to_vct);
- XEN_DEFINE_PROCEDURE(S_insert_sound, g_insert_sound_w, 1, 6, 0, H_insert_sound);
- XEN_DEFINE_PROCEDURE(S_scale_channel, g_scale_channel_w, 1, 5, 0, H_scale_channel);
- XEN_DEFINE_PROCEDURE(S_normalize_channel, g_normalize_channel_w, 1, 5, 0, H_normalize_channel);
-
- XEN_DEFINE_PROCEDURE(S_change_samples_with_origin, g_change_samples_with_origin_w, 7, 1, 0, "internal function used in save-state");
- XEN_DEFINE_PROCEDURE(S_insert_samples_with_origin, g_insert_samples_with_origin_w, 7, 1, 0, "internal function used in save-state");
- XEN_DEFINE_PROCEDURE(S_override_samples_with_origin, g_override_samples_with_origin_w, 5, 1, 0, "internal function used in save-state");
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_sample, g_sample_w, H_sample,
- S_setB S_sample, g_set_sample_w, g_set_sample_reversed, 0, 4, 1, 4);
+ Xen_define_safe_procedure(S_redo, g_redo_w, 0, 3, 0, H_redo);
+ Xen_define_procedure(S_as_one_edit, g_as_one_edit_w, 1, 1, 0, H_as_one_edit);
+ Xen_define_safe_procedure(S_display_edits, g_display_edits_w, 0, 3, 0, H_display_edits);
+ Xen_define_safe_procedure(S_edit_tree, g_edit_tree_w, 0, 3, 0, H_edit_tree);
+
+ Xen_define_safe_procedure(S_delete_sample, g_delete_sample_w, 1, 3, 0, H_delete_sample);
+ Xen_define_safe_procedure(S_delete_samples, g_delete_samples_w, 2, 3, 0, H_delete_samples);
+ Xen_define_safe_procedure(S_insert_sample, g_insert_sample_w, 2, 3, 0, H_insert_sample);
+ Xen_define_safe_procedure(S_insert_samples, g_insert_samples_w, 3, 5, 0, H_insert_samples);
+ Xen_define_safe_procedure(S_vct_to_channel, g_vct_to_channel_w, 1, 6, 0, H_vct_to_channel);
+ Xen_define_safe_procedure(S_channel_to_vct, g_channel_to_vct_w, 0, 5, 0, H_channel_to_vct);
+ Xen_define_safe_procedure(S_insert_sound, g_insert_sound_w, 1, 6, 0, H_insert_sound);
+ Xen_define_safe_procedure(S_scale_channel, g_scale_channel_w, 1, 5, 0, H_scale_channel);
+ Xen_define_safe_procedure(S_normalize_channel, g_normalize_channel_w, 1, 5, 0, H_normalize_channel);
+
+ Xen_define_procedure(S_change_samples_with_origin, g_change_samples_with_origin_w, 7, 1, 0, "internal function used in save-state");
+ Xen_define_procedure(S_insert_samples_with_origin, g_insert_samples_with_origin_w, 7, 1, 0, "internal function used in save-state");
+ Xen_define_procedure(S_override_samples_with_origin, g_override_samples_with_origin_w, 5, 1, 0, "internal function used in save-state");
+
+ Xen_define_dilambda(S_sample, g_sample_w, H_sample, S_set S_sample, g_set_sample_w, 0, 4, 1, 4);
+ Xen_define_dilambda(S_samples, g_samples_w, H_samples, S_set S_samples, g_set_samples_w, 0, 5, 3, 7);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_samples, g_samples_w, H_samples,
- S_setB S_samples, g_set_samples_w, g_set_samples_reversed, 0, 5, 3, 7);
-
- XEN_DEFINE_PROCEDURE("set-sample", g_set_sample_w, 2, 3, 0, H_sample); /* for edit-list->function */
- XEN_DEFINE_PROCEDURE("set-samples", g_set_samples_w, 3, 7, 0, H_set_samples);
-
- XEN_DEFINE_PROCEDURE(S_snd_to_sample_p, g_snd_to_sample_p_w, 1, 0, 0, H_snd_to_sample_p);
- XEN_DEFINE_PROCEDURE(S_make_snd_to_sample, g_make_snd_to_sample_w, 0, 1, 0, H_make_snd_to_sample);
- XEN_DEFINE_PROCEDURE(S_snd_to_sample, g_snd_to_sample_w, 2, 1, 0, H_snd_to_sample);
- XEN_DEFINE_PROCEDURE(S_edit_list_to_function, g_edit_list_to_function_w, 0, 4, 0, H_edit_list_to_function);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_max_virtual_ptrees, g_max_virtual_ptrees_w, H_max_virtual_ptrees,
- S_setB S_max_virtual_ptrees, g_set_max_virtual_ptrees_w, 0, 0, 1, 0);
+#if HAVE_SCHEME
+ Xen_define_procedure("set-sample", orig_g_set_sample_w, 2, 3, 0, H_sample); /* for edit-list->function */
+#endif
+ Xen_define_procedure("set-samples", orig_g_set_samples_w, 0, 0, 1, H_set_samples);
+ Xen_define_safe_procedure(S_is_snd_to_sample, g_is_snd_to_sample_w, 1, 0, 0, H_is_snd_to_sample);
+ Xen_define_procedure(S_make_snd_to_sample, g_make_snd_to_sample_w, 0, 1, 0, H_make_snd_to_sample);
+ Xen_define_procedure(S_snd_to_sample, g_snd_to_sample_w, 2, 1, 0, H_snd_to_sample);
+ Xen_define_procedure(S_edit_list_to_function, g_edit_list_to_function_w, 0, 4, 0, H_edit_list_to_function);
#define H_save_hook S_save_hook " (snd name): called each time a file is about to be saved. \
If it returns " PROC_TRUE ", the file is not saved. 'name' is " PROC_FALSE " unless the file is being saved under a new name (as in sound-save-as)."
- save_hook = XEN_DEFINE_HOOK(S_save_hook, 2, H_save_hook); /* arg = sound index, possible new name */
+ save_hook = Xen_define_hook(S_save_hook, "(make-hook 'snd 'name)", 2, H_save_hook);
#define H_save_state_hook S_save_state_hook " (temp-filename): called each time the " S_save_state " \
mechanism is about to create a new temporary file to save some edit history sample values. \
@@ -10020,11 +9318,34 @@ temp-filename is the current file. \
If the hook returns a string, it is treated as the new temp filename. This hook provides a way to \
keep track of which files are in a given saved state batch, and a way to rename or redirect those files."
- save_state_hook = XEN_DEFINE_HOOK(S_save_state_hook, 1, H_save_state_hook); /* arg = temp-filename */
- empty_closure = xen_make_vct(1, (mus_float_t *)calloc(1, sizeof(mus_float_t)));
- XEN_PROTECT_FROM_GC(empty_closure);
+ save_state_hook = Xen_define_hook(S_save_state_hook, "(make-hook 'name)", 1, H_save_state_hook);
+
+
+ snd_to_sample_tag = mus_make_generator_type();
+ snd_to_sample_class = mus_make_generator(snd_to_sample_tag, (char *)S_snd_to_sample, snd_to_sample_free, snd_to_sample_describe, snd_to_sample_equalp);
+ mus_generator_set_length(snd_to_sample_class, snd_to_sample_length);
+ mus_generator_set_channels(snd_to_sample_class, snd_to_sample_channels);
+ mus_generator_set_read_sample(snd_to_sample_class, snd_to_sample_read);
+ mus_generator_set_file_name(snd_to_sample_class, snd_to_sample_file_name);
+ mus_generator_set_location(snd_to_sample_class, snd_to_sample_location);
+ mus_generator_set_extended_type(snd_to_sample_class, MUS_INPUT);
+
+
+#if HAVE_SCHEME
+ {
+ s7_pointer f;
+ edit_finish = s7_make_function(s7, "(finish-as-one-edit)", g_edit_finish, 0, 0, false, "");
+
+ f = s7_name_to_value(s7, "next-sample");
+ s7_rf_set_function(f, next_sample_rf);
- SND_TO_SAMPLE = mus_make_class_tag();
+ f = s7_name_to_value(s7, "read-sample");
+ s7_rf_set_function(f, read_sample_rf);
+
+ f = s7_name_to_value(s7, "sampler-at-end?");
+ s7_pf_set_function(f, is_sampler_at_end_pf);
+ }
+#endif
#if DEBUG_EDIT_TABLES
/* consistency checks for the accessor state table */
@@ -10049,20 +9370,3 @@ into some arbitrary place in the tree again? Would pasting it in
be analogous to take a certain stage of the edit-history and
append the rest?
*/
-
-/* for virtual filter (and ultimately virtual src), see virtual-filter-channel (examp.scm) and convolve-coeffs (snd-test.scm)
- * this almost works! -- it can repeat one sample if previous-sample after next-sample (but the standard case repeats as well!)
- * sampler-position is ahead 1 if reading forward, back 1 if reading backward,
- * so in C, I guess we could use that for "cur-loc"
- * but how to store in ed_fragment?
- * and how often is this actually going to be used?
- * and if we need the peak env anyway, why not write the data out somewhere?
- * filter on filter if combined orders < max, convolve coeffs
- *
- * reverse is too tricky: we'd need to reverse the ed list and remember to reverse it internally on any subsequent list change (deletion etc)
- * then the reader would need the start-time fixups (not hard) internally reading backward, but next-sound at end not previous
- */
-
-/* it would reduce edit list length to combine successive changes/inserts (deletes already combine)
- * but that requires another buffer (if buffers) or messing around with combined temp files
- */
diff --git a/snd-env.c b/snd-env.c
index e3f0e50..43a2397 100644
--- a/snd-env.c
+++ b/snd-env.c
@@ -85,10 +85,10 @@ char *env_to_string(env *e)
{
if (fabs(e->data[j + 1]) < .0000001) e->data[j + 1] = 0.0; /* try to get rid of -0.000 */
#if HAVE_RUBY
- mus_snprintf(expr_buf, PRINT_BUFFER_SIZE, "%s%.3f, %.3f", (first) ? "" : ", ", e->data[j], e->data[j + 1]);
+ snprintf(expr_buf, PRINT_BUFFER_SIZE, "%s%.3f, %.3f", (first) ? "" : ", ", e->data[j], e->data[j + 1]);
#endif
#if HAVE_SCHEME || HAVE_FORTH
- mus_snprintf(expr_buf, PRINT_BUFFER_SIZE, "%s%.3f %.3f", (first) ? "" : " ", e->data[j], e->data[j + 1]);
+ snprintf(expr_buf, PRINT_BUFFER_SIZE, "%s%.3f %.3f", (first) ? "" : " ", e->data[j], e->data[j + 1]);
#endif
news = mus_strcat(news, expr_buf, &len);
first = false;
@@ -243,7 +243,7 @@ env *default_env(mus_float_t x1, mus_float_t y)
}
-bool default_env_p(env *e)
+bool is_default_env(env *e)
{
if (e == NULL) return(true);
if (e->pts != 2) return(false);
@@ -266,7 +266,7 @@ env_editor *new_env_editor(void)
edp->env_pos = 0;
edp->click_to_delete = false;
edp->edited = false;
- edp->clip_p = true;
+ edp->clipping = true;
edp->in_dB = false;
return(edp);
}
@@ -324,11 +324,8 @@ static void local_mus_error(int type, char *msg)
void env_editor_display_env(env_editor *edp, env *e, graphics_context *ax, const char *name,
int x0, int y0, int width, int height, printing_t printing)
{
- int i, j, k;
- mus_float_t ex0, ey0, ex1, ey1, val;
- int ix0, ix1, iy0, iy1, lx0, lx1, ly0, ly1, index = 0;
- mus_float_t env_val, curx, xincr;
- int dur;
+ int i;
+ mus_float_t ex0, ey0, ex1, ey1;
axis_info *ap;
if (e)
{
@@ -338,6 +335,7 @@ void env_editor_display_env(env_editor *edp, env *e, graphics_context *ax, const
ey1 = ey0;
for (i = 3; i < e->pts * 2; i += 2)
{
+ mus_float_t val;
val = e->data[i];
if (ey0 > val) ey0 = val;
if (ey1 < val) ey1 = val;
@@ -376,6 +374,9 @@ void env_editor_display_env(env_editor *edp, env *e, graphics_context *ax, const
if (e)
{
+ int j, dur;
+ mus_float_t curx, xincr;
+ int ix0, ix1, iy0, iy1;
ix1 = grf_x(e->data[0], ap);
iy1 = env_editor_grf_y_dB(edp, e->data[1]);
if (edp->with_dots)
@@ -416,6 +417,7 @@ void env_editor_display_env(env_editor *edp, env *e, graphics_context *ax, const
{
/* interpolate so the display looks closer to dB */
mus_float_t yval, yincr;
+ int lx1, ly1, k;
dur = (ix1 - ix0) / EXP_SEGLEN;
xincr = (e->data[i] - e->data[i - 2]) / (mus_float_t)dur;
curx = e->data[i - 2] + xincr;
@@ -426,6 +428,7 @@ void env_editor_display_env(env_editor *edp, env *e, graphics_context *ax, const
yval += yincr;
for (k = 1; k < dur; k++, curx += xincr, yval += yincr)
{
+ int lx0, ly0;
lx0 = lx1;
ly0 = ly1;
lx1 = grf_x(curx, ap);
@@ -480,6 +483,8 @@ void env_editor_display_env(env_editor *edp, env *e, graphics_context *ax, const
}
else
{
+ int index = 0;
+ mus_float_t env_val;
mus_any *ce;
if (edp->with_dots)
for (j = 1, i = 2; i < e->pts * 2; i += 2, j++)
@@ -488,7 +493,7 @@ void env_editor_display_env(env_editor *edp, env *e, graphics_context *ax, const
/* exponential case */
dur = width / EXP_SEGLEN;
old_error_handler = mus_error_set_handler(local_mus_error);
- ce = mus_make_env_with_length(e->data, e->pts, 1.0, 0.0, e->base, dur);
+ ce = mus_make_env(e->data, e->pts, 1.0, 0.0, e->base, 0.0, dur - 1, NULL);
mus_error_set_handler(old_error_handler);
if (ce == NULL) return;
if (dur < e->pts) dur = e->pts;
@@ -496,7 +501,6 @@ void env_editor_display_env(env_editor *edp, env *e, graphics_context *ax, const
ix1 = grf_x(0.0, ap);
iy1 = env_editor_grf_y_dB(edp, env_val);
xincr = (ex1 - ex0) / (mus_float_t)dur;
- j = 1;
for (i = 1, curx = ex0 + xincr; i < dur; i++, curx += xincr)
{
iy0 = iy1;
@@ -557,7 +561,7 @@ void env_editor_button_motion_with_xy(env_editor *edp, int evx, int evy, oclock_
if (edp->env_pos == 0) x = e->data[0];
if (edp->env_pos == (e->pts - 1)) x = e->data[(e->pts - 1) * 2];
y = ungrf_y(ap, evy);
- if ((edp->clip_p) || (edp->in_dB))
+ if ((edp->clipping) || (edp->in_dB))
{
if (y < ap->y0) y = ap->y0;
if (y > ap->y1) y = ap->y1;
@@ -589,7 +593,7 @@ bool env_editor_button_press(env_editor *edp, int evx, int evy, oclock_t time, e
pos = hit_point(edp->current_xs, edp->current_ys, e->pts, evx, evy);
x = ungrf_x(ap, evx);
y = env_editor_ungrf_y_dB(edp, evy);
- if (edp->clip_p)
+ if (edp->clipping)
{
if (y < ap->y0) y = ap->y0;
if (y > ap->y1) y = ap->y1;
@@ -822,8 +826,7 @@ void revert_env_edit(void)
static int find_env(const char *name)
{ /* -1 upon failure */
int i;
- if ((all_envs) &&
- (name))
+ if ((all_envs) && (name))
for (i = 0; i < all_envs_top; i++)
if (mus_strcmp(name, all_names[i]))
return(i);
@@ -834,7 +837,7 @@ static int find_env(const char *name)
int enved_all_envs_top(void) {return(all_envs_top);}
char *enved_all_names(int n) {return(all_names[n]);}
void set_enved_env_list_top(int n) {env_list_top = n;}
-env *enved_all_envs(int pos) {return(all_envs[pos]);}
+/* env *enved_all_envs(int pos) {return(all_envs[pos]);} */
static void add_envelope(const char *name, env *val)
@@ -867,6 +870,7 @@ static void add_envelope(const char *name, env *val)
}
+#if 0
void delete_envelope(const char *name)
{
int pos;
@@ -891,6 +895,7 @@ void delete_envelope(const char *name)
}
}
}
+#endif
void alert_envelope_editor(const char *name, env *val)
@@ -985,18 +990,18 @@ static void display_enved_spectrum(chan_info *cp, enved_fft *ef, axis_info *ap)
if (ef)
{
mus_float_t incr, x = 0.0;
- int i = 0, j = 0;
+ int i = 0;
mus_long_t hisamp;
- mus_float_t samples_per_pixel, xf = 0.0, ina, ymax;
+ mus_float_t samples_per_pixel;
ap->losamp = 0;
ap->hisamp = ef->size - 1;
ap->y0 = 0.0;
ap->y1 = ef->scale;
ap->x0 = 0.0;
- ap->x1 = SND_SRATE(cp->sound) / 2;
+ ap->x1 = snd_srate(cp->sound) / 2;
init_axis_scales(ap);
hisamp = ef->size / 2;
- incr = (mus_float_t)SND_SRATE(cp->sound) / (mus_float_t)(ef->size);
+ incr = (mus_float_t)snd_srate(cp->sound) / (mus_float_t)(ef->size);
samples_per_pixel = (mus_float_t)((double)hisamp / (mus_float_t)(ap->x_axis_x1 - ap->x_axis_x0));
if ((samples_per_pixel < 4.0) &&
(hisamp < POINT_BUFFER_SIZE))
@@ -1007,9 +1012,12 @@ static void display_enved_spectrum(chan_info *cp, enved_fft *ef, axis_info *ap)
}
else
{
+ int j = 0;
+ mus_float_t xf = 0.0, ymax;
ymax = -1.0;
while (i < hisamp)
{
+ mus_float_t ina;
ina = ef->data[i++];
if (ina > ymax) ymax = ina;
xf += 1.0;
@@ -1029,9 +1037,6 @@ static void display_enved_spectrum(chan_info *cp, enved_fft *ef, axis_info *ap)
void enved_show_background_waveform(axis_info *ap, axis_info *gray_ap, bool apply_to_selection, bool show_fft, printing_t printing)
{
- int srate, pts = 0;
- graph_type_t old_time_graph_type = GRAPH_ONCE;
- mus_long_t samps;
printing_t old_printing;
bool two_sided = false;
axis_info *active_ap = NULL;
@@ -1059,9 +1064,10 @@ void enved_show_background_waveform(axis_info *ap, axis_info *gray_ap, bool appl
if (enved_max_fft_size < transform_size(ss)) enved_max_fft_size = transform_size(ss);
if (enved_max_fft_size < active_channel->transform_size) enved_max_fft_size = active_channel->transform_size;
-#if USE_MOTIF
+#if USE_MOTIF
+ /* uses fft_pix etc in chan_info */
if ((active_channel->transform_graph_type == GRAPH_AS_SONOGRAM) &&
- (active_channel->graph_transform_p))
+ (active_channel->graph_transform_on))
{
/* if the sonogram isn't ready, try to get it
* this is for frequency envelopes as in animals.scm
@@ -1074,7 +1080,7 @@ void enved_show_background_waveform(axis_info *ap, axis_info *gray_ap, bool appl
if ((active_channel->fft_pix) &&
(active_channel->fft_pix_ready) &&
(active_channel->transform_graph_type == GRAPH_AS_SONOGRAM) &&
- (active_channel->graph_transform_p))
+ (active_channel->graph_transform_on))
{
int old_x0, old_y0;
@@ -1090,11 +1096,66 @@ void enved_show_background_waveform(axis_info *ap, axis_info *gray_ap, bool appl
}
else display_enved_spectrum(active_channel, make_enved_spectrum(active_channel), gray_ap);
#else
- display_enved_spectrum(active_channel, make_enved_spectrum(active_channel), gray_ap);
+ /* for gtk, we need to redisplay the sonogram?
+ */
+#if CAIRO_HAS_RECORDING_SURFACE && (0)
+ /*
+ fprintf(stderr, "%p %d %d %d\n",
+ (active_channel->fft_pix),
+ (active_channel->fft_pix_ready),
+ (active_channel->transform_graph_type == GRAPH_AS_SONOGRAM),
+ (active_channel->graph_transform_on));
+ */
+ if ((active_channel->fft_pix) &&
+ (active_channel->fft_pix_ready) &&
+ (active_channel->transform_graph_type == GRAPH_AS_SONOGRAM) &&
+ (active_channel->graph_transform_on))
+ {
+ cairo_t *lcr, *old_cr;
+ old_cr = ss->cr;
+ lcr = gdk_cairo_create(gray_ap->ax->wn);
+ ss->cr = lcr;
+
+ cairo_set_source_surface(lcr, active_channel->fft_pix, 0.0, 0.0);
+ cairo_paint(lcr);
+ cairo_destroy(lcr);
+ ss->cr = old_cr;
+ }
+ else
+#else
+ /* this is not so slow as to be an annoyance, so maybe it's ok */
+ if ((active_channel->transform_graph_type == GRAPH_AS_SONOGRAM) &&
+ (active_channel->graph_transform_on))
+ {
+ axis_info *old_ap;
+ int x0, x1, y0, y1;
+ old_ap = active_channel->axis;
+ x0 = old_ap->x_axis_x0;
+ x1 = old_ap->x_axis_x1;
+ y0 = old_ap->y_axis_y0;
+ y1 = old_ap->y_axis_y1;
+ active_channel->axis = gray_ap;
+ active_channel->fft->axis->x_axis_x0 = gray_ap->x_axis_x0;
+ active_channel->fft->axis->x_axis_x1 = gray_ap->x_axis_x1;
+ active_channel->fft->axis->y_axis_y0 = gray_ap->y_axis_y0;
+ active_channel->fft->axis->y_axis_y1 = gray_ap->y_axis_y1;
+ make_sonogram(active_channel);
+ active_channel->axis = old_ap;
+ old_ap->x_axis_x0 = x0;
+ old_ap->x_axis_x1 = x1;
+ old_ap->y_axis_y0 = y0;
+ old_ap->y_axis_y1 = y1;
+ }
+ else
+#endif
+ display_enved_spectrum(active_channel, make_enved_spectrum(active_channel), gray_ap);
#endif
}
else
{
+ mus_long_t samps;
+ graph_type_t old_time_graph_type = GRAPH_ONCE;
+ int srate, pts = 0;
active_ap = active_channel->axis;
if (apply_to_selection)
{
@@ -1111,8 +1172,8 @@ void enved_show_background_waveform(axis_info *ap, axis_info *gray_ap, bool appl
else
{
/* show current channel overall view in gray scale */
- samps = CURRENT_SAMPLES(active_channel);
- srate = SND_SRATE(active_channel->sound);
+ samps = current_samples(active_channel);
+ srate = snd_srate(active_channel->sound);
gray_ap->losamp = 0;
gray_ap->hisamp = samps - 1;
if (active_channel->time_graph_type == GRAPH_AS_WAVOGRAM)
@@ -1217,48 +1278,48 @@ void save_envelope_editor_state(FILE *fd)
}
-env *xen_to_env(XEN res)
+env *xen_to_env(Xen res)
{
env *rtn = NULL;
- if (XEN_LIST_P(res))
+ if (Xen_is_list(res))
{
int len = 0;
- len = XEN_LIST_LENGTH(res);
+ len = Xen_list_length(res);
if (len > 0)
{
int i;
mus_float_t *data = NULL;
- XEN lst;
+ Xen lst;
- if (XEN_NUMBER_P(XEN_CAR(res)))
+ if (Xen_is_number(Xen_car(res)))
{
data = (mus_float_t *)calloc(len, sizeof(mus_float_t));
- for (i = 0, lst = XEN_COPY_ARG(res); i < len; i++, lst = XEN_CDR(lst))
+ for (i = 0, lst = Xen_copy_arg(res); i < len; i++, lst = Xen_cdr(lst))
{
- XEN el;
- el = XEN_CAR(lst);
- data[i] = XEN_TO_C_DOUBLE_OR_ELSE(el, 0.0);
+ Xen el;
+ el = Xen_car(lst);
+ data[i] = Xen_real_to_C_double(el);
}
}
else
{
/* embedded lists '((0 0) (100 1)) */
- if (XEN_LIST_P(XEN_CAR(res)))
+ if (Xen_is_list(Xen_car(res)))
{
len *= 2;
data = (mus_float_t *)calloc(len, sizeof(mus_float_t));
- for (i = 0, lst = XEN_COPY_ARG(res); i < len; i += 2, lst = XEN_CDR(lst))
+ for (i = 0, lst = Xen_copy_arg(res); i < len; i += 2, lst = Xen_cdr(lst))
{
- XEN el;
- el = XEN_CAR(lst);
- if ((!(XEN_NUMBER_P(XEN_CAR(el)))) ||
- (!(XEN_NUMBER_P(XEN_CADR(el)))))
+ Xen el;
+ el = Xen_car(lst);
+ if ((!(Xen_is_number(Xen_car(el)))) ||
+ (!(Xen_is_number(Xen_cadr(el)))))
{
free(data);
return(NULL);
}
- data[i] = XEN_TO_C_DOUBLE(XEN_CAR(el));
- data[i + 1] = XEN_TO_C_DOUBLE(XEN_CADR(el));
+ data[i] = Xen_real_to_C_double(Xen_car(el));
+ data[i + 1] = Xen_real_to_C_double(Xen_cadr(el));
}
}
else
@@ -1269,7 +1330,8 @@ env *xen_to_env(XEN res)
}
if (data)
{
- rtn = make_envelope(data, len);
+ if (len > 1)
+ rtn = make_envelope(data, len);
free(data);
}
}
@@ -1278,17 +1340,17 @@ env *xen_to_env(XEN res)
}
-static bool x_increases(XEN res)
+static bool x_increases(Xen res)
{
int i, len;
- XEN lst;
+ Xen lst;
mus_float_t x;
- len = XEN_LIST_LENGTH(res);
- x = XEN_TO_C_DOUBLE(XEN_CAR(res));
- for (i = 2, lst = XEN_CDDR(XEN_COPY_ARG(res)); i < len; i += 2, lst = XEN_CDDR(lst))
+ len = Xen_list_length(res);
+ x = Xen_real_to_C_double(Xen_car(res));
+ for (i = 2, lst = Xen_cddr(Xen_copy_arg(res)); i < len; i += 2, lst = Xen_cddr(lst))
{
mus_float_t nx;
- nx = XEN_TO_C_DOUBLE(XEN_CAR(lst));
+ nx = Xen_real_to_C_double(Xen_car(lst));
if (x >= nx) return(false);
x = nx;
}
@@ -1307,11 +1369,12 @@ static bool x_increases(XEN res)
env *string_to_env(const char *str)
{
#if HAVE_EXTENSION_LANGUAGE
- XEN res;
- int len = 0;
+ Xen res;
res = snd_catch_any(eval_str_wrapper, (void *)str, "string->env");
- if (XEN_LIST_P_WITH_LENGTH(res, len))
+ if (Xen_is_list(res))
{
+ int len;
+ len = Xen_list_length(res);
if ((len % 2) == 0)
{
if (x_increases(res))
@@ -1381,9 +1444,9 @@ env *name_to_env(const char *str)
pos = find_env(str);
if (pos >= 0) return(copy_env(all_envs[pos]));
#if HAVE_SCHEME || HAVE_FORTH
- e = xen_to_env(XEN_NAME_AS_C_STRING_TO_VALUE(str));
+ e = xen_to_env(C_string_to_Xen_value(str));
#else
- e = xen_to_env(XEN_EVAL_C_STRING((char *)str));
+ e = xen_to_env(Xen_eval_C_string((char *)str));
#endif
return(e);
}
@@ -1391,12 +1454,12 @@ env *name_to_env(const char *str)
#if HAVE_RUBY
#define SND_ENV_MAX_VARS 100
-static XEN snd_env_array[SND_ENV_MAX_VARS];
+static Xen snd_env_array[SND_ENV_MAX_VARS];
static int env_index = -1;
#endif
-static XEN g_define_envelope(XEN name, XEN data, XEN base)
+static Xen g_define_envelope(Xen name, Xen data, Xen base)
{
env *e;
const char *ename;
@@ -1404,19 +1467,19 @@ static XEN g_define_envelope(XEN name, XEN data, XEN base)
#define H_define_envelope "(" S_define_envelope " name data :optional base): load 'name' with associated 'data', a list of breakpoints \
into the envelope editor."
- XEN_ASSERT_TYPE(XEN_STRING_P(name) || XEN_SYMBOL_P(name), name, XEN_ARG_1, S_define_envelope, "a string or symbol");
- XEN_ASSERT_TYPE(XEN_LIST_P(data), data, XEN_ARG_2, S_define_envelope, "a list of breakpoints");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(base) || XEN_FALSE_P(base), base, XEN_ARG_3, S_define_envelope, "a float or " PROC_FALSE);
+ Xen_check_type(Xen_is_string(name) || Xen_is_symbol(name), name, 1, S_define_envelope, "a string or symbol");
+ Xen_check_type(Xen_is_list(data), data, 2, S_define_envelope, "a list of breakpoints");
+ Xen_check_type(Xen_is_number_or_unbound(base) || Xen_is_false(base), base, 3, S_define_envelope, "a float or " PROC_FALSE);
- if (XEN_STRING_P(name))
- ename = XEN_TO_C_STRING(name);
- else ename = XEN_SYMBOL_TO_C_STRING(name);
+ if (Xen_is_string(name))
+ ename = Xen_string_to_C_string(name);
+ else ename = Xen_symbol_to_C_string(name);
e = xen_to_env(data);
- if (!e) return(XEN_FALSE);
+ if (!e) return(Xen_false);
- if (XEN_NUMBER_P(base))
- e->base = XEN_TO_C_DOUBLE(base);
+ if (Xen_is_number(base))
+ e->base = Xen_real_to_C_double(base);
#if HAVE_RUBY
{
@@ -1426,7 +1489,7 @@ into the envelope editor."
env_index = 0;
else
env_index++;
- XEN_DEFINE_VARIABLE(ename, snd_env_array[env_index], data); /* need global C variable */
+ Xen_define_variable(ename, snd_env_array[env_index], data); /* need global C variable */
free(name);
return(snd_env_array[env_index]);
}
@@ -1434,20 +1497,24 @@ into the envelope editor."
#if HAVE_SCHEME || HAVE_FORTH
{
- XEN temp;
+ Xen temp;
alert_envelope_editor(ename, e);
- XEN_DEFINE_VARIABLE(ename, temp, data); /* already gc protected */
+ Xen_define_variable(ename, temp, data); /* already gc protected */
return(temp);
}
#endif
+
+#if (!HAVE_EXTENSION_LANGUAGE)
+ return(0);
+#endif
}
-XEN env_to_xen(env *e)
+Xen env_to_xen(env *e)
{
if (e)
return(mus_array_to_list(e->data, 0, e->pts * 2));
- return(XEN_EMPTY_LIST);
+ return(Xen_empty_list);
}
@@ -1462,7 +1529,7 @@ void add_or_edit_symbol(const char *name, env *val)
tmpstr = env_to_string(val);
len = mus_strlen(tmpstr) + mus_strlen(name) + 32;
buf = (char *)calloc(len, sizeof(char));
- mus_snprintf(buf, len, "%s = %s", name, tmpstr);
+ snprintf(buf, len, "%s = %s", name, tmpstr);
if (tmpstr) free(tmpstr);
snd_catch_any(eval_str_wrapper, buf, buf);
@@ -1471,56 +1538,55 @@ void add_or_edit_symbol(const char *name, env *val)
#endif
#if HAVE_SCHEME
- XEN e;
+ Xen e;
if (!val) return;
- if (XEN_DEFINED_P(name))
+ if (Xen_is_defined(name))
{
- e = XEN_NAME_AS_C_STRING_TO_VARIABLE(name);
- XEN_VARIABLE_SET(e, env_to_xen(val));
+ e = s7_make_symbol(s7, name);
+ Xen_variable_set(e, env_to_xen(val));
}
- else XEN_DEFINE_VARIABLE(name, e, env_to_xen(val));
+ else Xen_define_variable(name, e, env_to_xen(val));
#endif
#if HAVE_FORTH
- XEN e;
if (!val) return;
- if (XEN_DEFINED_P(name))
- e = XEN_VARIABLE_SET(name, env_to_xen(val));
- else XEN_DEFINE_VARIABLE(name, e, env_to_xen(val));
+ if (Xen_is_defined(name))
+ Xen_variable_set(name, env_to_xen(val));
+ else fth_define_variable(name, env_to_xen(val), NULL);
#endif
}
-env *get_env(XEN e, const char *origin) /* list in e */
+env *get_env(Xen e, const char *origin) /* list in e */
{
int i, len = 0;
env *new_env;
- XEN_ASSERT_TYPE(XEN_LIST_P_WITH_LENGTH(e, len), e, XEN_ARG_1, origin, "a list");
-
+ Xen_check_type(Xen_is_list(e), e, 1, origin, "a list");
+ len = Xen_list_length(e);
if (len == 0)
- XEN_ERROR(NO_DATA,
- XEN_LIST_3(C_TO_XEN_STRING("~A: null env, ~A"),
- C_TO_XEN_STRING(origin),
+ Xen_error(NO_DATA,
+ Xen_list_3(C_string_to_Xen_string("~A: null env, ~A"),
+ C_string_to_Xen_string(origin),
e));
new_env = xen_to_env(e);
if (!new_env)
- XEN_ERROR(XEN_ERROR_TYPE("env-error"),
- XEN_LIST_2(C_TO_XEN_STRING("envelope break point list is screwed up: ~A"),
+ Xen_error(Xen_make_error_type("env-error"),
+ Xen_list_2(C_string_to_Xen_string("envelope break point list is screwed up: ~A"),
e));
for (i = 2; i < new_env->pts * 2; i += 2)
if (new_env->data[i - 2] > new_env->data[i])
{
- XEN msg;
+ Xen msg;
char *buf;
buf = (char *)calloc(1024, sizeof(char));
- mus_snprintf(buf, 1024, "%s: env at breakpoint %d: x axis value %f > %f", origin, i / 2, new_env->data[i - 2], new_env->data[i]);
- msg = C_TO_XEN_STRING(buf);
+ snprintf(buf, 1024, "%s: env at breakpoint %d: x axis value %f > %f", origin, i / 2, new_env->data[i - 2], new_env->data[i]);
+ msg = C_string_to_Xen_string(buf);
free(buf);
free_env(new_env);
- XEN_ERROR(XEN_ERROR_TYPE("env-error"),
- XEN_LIST_3(C_TO_XEN_STRING("~A, ~A"),
+ Xen_error(Xen_make_error_type("env-error"),
+ Xen_list_3(C_string_to_Xen_string("~A, ~A"),
msg,
e));
}
@@ -1528,20 +1594,20 @@ env *get_env(XEN e, const char *origin) /* list in e */
}
-static XEN g_save_envelopes(XEN filename)
+static Xen g_save_envelopes(Xen filename)
{
#define H_save_envelopes "(" S_save_envelopes " :optional filename): save the envelopes known to the envelope editor in filename"
char *name = NULL;
- FILE *fd;
- XEN_ASSERT_TYPE((XEN_STRING_P(filename) || (XEN_FALSE_P(filename)) || (XEN_NOT_BOUND_P(filename))),
- filename, XEN_ONLY_ARG, S_save_envelopes, "a string or " PROC_FALSE);
- if (XEN_STRING_P(filename))
- name = mus_expand_filename(XEN_TO_C_STRING(filename));
+ Xen_check_type((Xen_is_string(filename) || (Xen_is_false(filename)) || (!Xen_is_bound(filename))),
+ filename, 1, S_save_envelopes, "a string or " PROC_FALSE);
+ if (Xen_is_string(filename))
+ name = mus_expand_filename(Xen_string_to_C_string(filename));
else name = mus_strdup("envs.save");
if (name)
{
+ FILE *fd;
fd = FOPEN(name, "w");
if (fd)
{
@@ -1552,246 +1618,229 @@ static XEN g_save_envelopes(XEN filename)
if (!fd)
{
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_envelopes ": can't save ~S, ~A"),
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_save_envelopes ": can't save ~S, ~A"),
filename,
- C_TO_XEN_STRING(snd_open_strerror())));
+ C_string_to_Xen_string(snd_open_strerror())));
}
}
return(filename);
}
-static XEN enved_hook;
+static Xen enved_hook;
static bool check_enved_hook(env *e, int pos, mus_float_t x, mus_float_t y, enved_point_t reason)
{
- bool env_changed = false;
- if (XEN_HOOKED(enved_hook))
+ if (Xen_hook_has_list(enved_hook))
{
- int len = 0;
-#if HAVE_SCHEME
- int gc_loc;
-#endif
- XEN result = XEN_FALSE;
- XEN procs, env_list;
+ Xen result = Xen_false;
/* if hook procedure returns a list, that is the new contents of the
* envelope -- if its length doesn't match current, we need to remake
* current. Otherwise return 0, and assume the caller will handle default
*/
- procs = XEN_HOOK_PROCEDURES(enved_hook);
- env_list = env_to_xen(e);
+
#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, env_list);
+ result = s7_call(s7, enved_hook,
+ Xen_list_5(env_to_xen(e),
+ C_int_to_Xen_integer(pos),
+ C_double_to_Xen_real(x),
+ C_double_to_Xen_real(y),
+ C_int_to_Xen_integer((int)reason)));
+#else
+ {
+ Xen procs, env_list;
+ env_list = env_to_xen(e);
+ procs = Xen_hook_list(enved_hook);
+ while (!Xen_is_null(procs))
+ {
+ Xen temp;
+ temp = Xen_apply(Xen_car(procs),
+ Xen_list_5(env_list,
+ C_int_to_Xen_integer(pos),
+ C_double_to_Xen_real(x),
+ C_double_to_Xen_real(y),
+ C_int_to_Xen_integer((int)reason)),
+ S_enved_hook);
+ if (!Xen_is_false(temp))
+ {
+ result = temp;
+ env_list = temp;
+ }
+ procs = Xen_cdr(procs);
+ }
+ }
#endif
-
- while (XEN_NOT_NULL_P(procs))
+ if (Xen_is_list(result))
{
- result = XEN_APPLY(XEN_CAR(procs),
- XEN_LIST_5(env_list,
- C_TO_XEN_INT(pos),
- C_TO_XEN_DOUBLE(x),
- C_TO_XEN_DOUBLE(y),
- C_TO_XEN_INT((int)reason)),
- S_enved_hook);
- procs = XEN_CDR (procs);
- if ((XEN_NOT_FALSE_P(result)) &&
- (XEN_LIST_P_WITH_LENGTH(result, len)))
+ int i, len;
+ Xen lst;
+ len = Xen_list_length(result);
+ if (len > e->data_size)
{
- /* remake env and (if not null procs) env_list */
- /* each successive hook procedure gets the on-going (changing) envelope */
- int i;
- XEN lst;
- if (len > e->data_size)
- {
- free(e->data);
- e->data = (mus_float_t *)calloc(len, sizeof(mus_float_t));
- e->data_size = len;
- }
- e->pts = len / 2;
- for (i = 0, lst = XEN_COPY_ARG(result); i < len; i++, lst = XEN_CDR(lst))
- e->data[i] = XEN_TO_C_DOUBLE(XEN_CAR(lst));
- if (XEN_NOT_NULL_P(procs))
- {
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
- env_list = env_to_xen(e);
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, env_list);
-#endif
-
- }
- env_changed = true;
+ free(e->data);
+ e->data = (mus_float_t *)calloc(len, sizeof(mus_float_t));
+ e->data_size = len;
}
+ e->pts = len / 2;
+ for (i = 0, lst = Xen_copy_arg(result); i < len; i++, lst = Xen_cdr(lst))
+ e->data[i] = Xen_real_to_C_double(Xen_car(lst));
+ return(true);
}
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
}
- return(env_changed); /* 0 = default action */
+ return(false);
}
-static XEN g_enved_base(void) {return(C_TO_XEN_DOUBLE(enved_base(ss)));}
+static Xen g_enved_base(void) {return(C_double_to_Xen_real(enved_base(ss)));}
-static XEN g_set_enved_base(XEN val)
+static Xen g_set_enved_base(Xen val)
{
#define H_enved_base "(" S_enved_base "): envelope editor exponential base value (1.0)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_enved_base, "a number");
- set_enved_base(mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), 300000.0));
- return(C_TO_XEN_DOUBLE(enved_base(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_enved_base, "a number");
+ set_enved_base(mus_fclamp(0.0, Xen_real_to_C_double(val), 300000.0));
+ return(C_double_to_Xen_real(enved_base(ss)));
}
-static XEN g_enved_power(void) {return(C_TO_XEN_DOUBLE(enved_power(ss)));}
+static Xen g_enved_power(void) {return(C_double_to_Xen_real(enved_power(ss)));}
-static XEN g_set_enved_power(XEN val)
+static Xen g_set_enved_power(Xen val)
{
#define H_enved_power "(" S_enved_power "): envelope editor base scale range (9.0^power)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_enved_power, "a number");
- set_enved_power(mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), 10.0));
- return(C_TO_XEN_DOUBLE(enved_power(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_enved_power, "a number");
+ set_enved_power(mus_fclamp(0.0, Xen_real_to_C_double(val), 10.0));
+ return(C_double_to_Xen_real(enved_power(ss)));
}
-static XEN g_enved_clip_p(void) {return(C_TO_XEN_BOOLEAN(enved_clip_p(ss)));}
+static Xen g_enved_clipping(void) {return(C_bool_to_Xen_boolean(enved_clipping(ss)));}
-static XEN g_set_enved_clip_p(XEN on)
+static Xen g_set_enved_clipping(Xen on)
{
- #define H_enved_clip_p "(" S_enved_clip_p "): envelope editor clip button setting; \
+ #define H_enved_clipping "(" S_enved_clipping "): envelope editor clip button setting; \
if clipping, the motion of the mouse is restricted to the current graph bounds."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ONLY_ARG, S_setB S_enved_clip_p, "a boolean");
- set_enved_clip_p(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(enved_clip_p(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_enved_clipping, "a boolean");
+ set_enved_clipping(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(enved_clipping(ss)));
}
-static XEN g_enved_style(void) {return(C_TO_XEN_INT(enved_style(ss)));}
+static Xen g_enved_style(void) {return(C_int_to_Xen_integer(enved_style(ss)));}
-static XEN g_set_enved_style(XEN val)
+static Xen g_set_enved_style(Xen val)
{
#define H_enved_style "(" S_enved_style "): envelope editor breakpoint connection choice: can \
be " S_envelope_linear ", or " S_envelope_exponential
int choice;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_enved_style, S_envelope_linear ", or " S_envelope_exponential);
- choice = XEN_TO_C_INT(val);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_enved_style, S_envelope_linear ", or " S_envelope_exponential);
+ choice = Xen_integer_to_C_int(val);
if ((choice == ENVELOPE_LINEAR) || (choice == ENVELOPE_EXPONENTIAL))
{
set_enved_style((env_type_t)choice);
reflect_enved_style();
}
- else XEN_OUT_OF_RANGE_ERROR(S_enved_style, XEN_ONLY_ARG, val, "must be " S_envelope_linear ", or " S_envelope_exponential);
+ else Xen_out_of_range_error(S_enved_style, 1, val, S_enved_style " should be " S_envelope_linear ", or " S_envelope_exponential);
return(val);
}
-static XEN g_enved_target(void) {return(C_TO_XEN_INT((int)enved_target(ss)));}
+static Xen g_enved_target(void) {return(C_int_to_Xen_integer((int)enved_target(ss)));}
-static XEN g_set_enved_target(XEN val)
+static Xen g_set_enved_target(Xen val)
{
- enved_target_t n;
int in_n;
#define H_enved_target "(" S_enved_target "): determines how the envelope edit envelope is applied; \
choices are " S_enved_amplitude ", " S_enved_srate "(apply to speed), and " S_enved_spectrum "(apply as a filter)."
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_enved_target, "an integer");
- in_n = XEN_TO_C_INT(val);
- if (in_n < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_enved_target, 1, val, "~A, but must be " S_enved_amplitude ", " S_enved_srate ", or " S_enved_spectrum);
- if (in_n > (int)ENVED_SRATE)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_enved_target, 1, val, "~A, but must be " S_enved_amplitude ", " S_enved_srate ", or " S_enved_spectrum);
- n = (enved_target_t)in_n;
- set_enved_target(n);
- return(C_TO_XEN_INT((int)enved_target(ss)));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_enved_target, "an integer");
+ in_n = Xen_integer_to_C_int(val);
+ if ((in_n < 0) ||
+ (in_n > (int)ENVED_SRATE))
+ Xen_out_of_range_error(S_set S_enved_target, 1, val, S_enved_target " should be " S_enved_amplitude ", " S_enved_srate ", or " S_enved_spectrum);
+ else
+ {
+ enved_target_t n;
+ n = (enved_target_t)in_n;
+ /* there is a huge bug in some versions of g++ that make it necessary to: */
+ if (in_n < 0) n = ENVED_AMPLITUDE;
+ if (in_n > 2) n = ENVED_SRATE;
+ set_enved_target(n);
+ }
+ return(C_int_to_Xen_integer((int)enved_target(ss)));
}
-static XEN g_enved_wave_p(void) {return(C_TO_XEN_BOOLEAN(enved_wave_p(ss)));}
+static Xen g_enved_with_wave(void) {return(C_bool_to_Xen_boolean(enved_with_wave(ss)));}
-static XEN g_set_enved_wave_p(XEN val)
+static Xen g_set_enved_with_wave(Xen val)
{
- #define H_enved_wave_p "(" S_enved_wave_p "): " PROC_TRUE " if the envelope editor is displaying the waveform to be edited"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_enved_wave_p, "a boolean");
- set_enved_wave_p(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(enved_wave_p(ss)));
+ #define H_enved_with_wave "(" S_enved_with_wave "): " PROC_TRUE " if the envelope editor is displaying the waveform to be edited"
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_enved_with_wave, "a boolean");
+ set_enved_with_wave(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(enved_with_wave(ss)));
}
-static XEN g_enved_in_dB(void) {return(C_TO_XEN_BOOLEAN(enved_in_dB(ss)));}
+static Xen g_enved_in_dB(void) {return(C_bool_to_Xen_boolean(enved_in_dB(ss)));}
-static XEN g_set_enved_in_dB(XEN val)
+static Xen g_set_enved_in_dB(Xen val)
{
#define H_enved_in_dB "(" S_enved_in_dB "): " PROC_TRUE " if the envelope editor is using dB"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_enved_in_dB, "a boolean");
- set_enved_in_dB(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(enved_in_dB(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_enved_in_dB, "a boolean");
+ set_enved_in_dB(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(enved_in_dB(ss)));
}
-static XEN g_enved_filter_order(void) {return(C_TO_XEN_INT(enved_filter_order(ss)));}
+static Xen g_enved_filter_order(void) {return(C_int_to_Xen_integer(enved_filter_order(ss)));}
-static XEN g_set_enved_filter_order(XEN val)
+static Xen g_set_enved_filter_order(Xen val)
{
#define H_enved_filter_order "(" S_enved_filter_order "): envelope editor's FIR filter order (40)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_enved_filter_order, "an integer");
- set_enved_filter_order(XEN_TO_C_INT(val));
- return(C_TO_XEN_INT(enved_filter_order(ss)));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_enved_filter_order, "an integer");
+ set_enved_filter_order(Xen_integer_to_C_int(val));
+ return(C_int_to_Xen_integer(enved_filter_order(ss)));
}
-static XEN g_enved_dialog(void)
+static Xen g_enved_dialog(void)
{
#define H_enved_dialog "(" S_enved_dialog "): start the Envelope Editor"
- widget_t w;
- w = create_envelope_editor();
- return(XEN_WRAP_WIDGET(w));
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_enved_base_w, g_enved_base)
-XEN_NARGIFY_1(g_set_enved_base_w, g_set_enved_base)
-XEN_NARGIFY_0(g_enved_power_w, g_enved_power)
-XEN_NARGIFY_1(g_set_enved_power_w, g_set_enved_power)
-XEN_NARGIFY_0(g_enved_clip_p_w, g_enved_clip_p)
-XEN_NARGIFY_1(g_set_enved_clip_p_w, g_set_enved_clip_p)
-XEN_NARGIFY_0(g_enved_style_w, g_enved_style)
-XEN_NARGIFY_1(g_set_enved_style_w, g_set_enved_style)
-XEN_NARGIFY_0(g_enved_target_w, g_enved_target)
-XEN_NARGIFY_1(g_set_enved_target_w, g_set_enved_target)
-XEN_NARGIFY_0(g_enved_wave_p_w, g_enved_wave_p)
-XEN_NARGIFY_1(g_set_enved_wave_p_w, g_set_enved_wave_p)
-XEN_NARGIFY_0(g_enved_in_dB_w, g_enved_in_dB)
-XEN_NARGIFY_1(g_set_enved_in_dB_w, g_set_enved_in_dB)
-XEN_NARGIFY_0(g_enved_filter_order_w, g_enved_filter_order)
-XEN_NARGIFY_1(g_set_enved_filter_order_w, g_set_enved_filter_order)
-XEN_NARGIFY_0(g_enved_dialog_w, g_enved_dialog)
-XEN_ARGIFY_1(g_save_envelopes_w, g_save_envelopes)
-XEN_ARGIFY_3(g_define_envelope_w, g_define_envelope)
-#else
-#define g_enved_base_w g_enved_base
-#define g_set_enved_base_w g_set_enved_base
-#define g_enved_power_w g_enved_power
-#define g_set_enved_power_w g_set_enved_power
-#define g_enved_clip_p_w g_enved_clip_p
-#define g_set_enved_clip_p_w g_set_enved_clip_p
-#define g_enved_style_w g_enved_style
-#define g_set_enved_style_w g_set_enved_style
-#define g_enved_target_w g_enved_target
-#define g_set_enved_target_w g_set_enved_target
-#define g_enved_wave_p_w g_enved_wave_p
-#define g_set_enved_wave_p_w g_set_enved_wave_p
-#define g_enved_in_dB_w g_enved_in_dB
-#define g_set_enved_in_dB_w g_set_enved_in_dB
-#define g_enved_filter_order_w g_enved_filter_order
-#define g_set_enved_filter_order_w g_set_enved_filter_order
-#define g_enved_dialog_w g_enved_dialog
-#define g_save_envelopes_w g_save_envelopes
-#define g_define_envelope_w g_define_envelope
+ return(Xen_wrap_widget(create_envelope_editor()));
+}
+
+
+Xen_wrap_no_args(g_enved_base_w, g_enved_base)
+Xen_wrap_1_arg(g_set_enved_base_w, g_set_enved_base)
+Xen_wrap_no_args(g_enved_power_w, g_enved_power)
+Xen_wrap_1_arg(g_set_enved_power_w, g_set_enved_power)
+Xen_wrap_no_args(g_enved_clipping_w, g_enved_clipping)
+Xen_wrap_1_arg(g_set_enved_clipping_w, g_set_enved_clipping)
+Xen_wrap_no_args(g_enved_style_w, g_enved_style)
+Xen_wrap_1_arg(g_set_enved_style_w, g_set_enved_style)
+Xen_wrap_no_args(g_enved_target_w, g_enved_target)
+Xen_wrap_1_arg(g_set_enved_target_w, g_set_enved_target)
+Xen_wrap_no_args(g_enved_with_wave_w, g_enved_with_wave)
+Xen_wrap_1_arg(g_set_enved_with_wave_w, g_set_enved_with_wave)
+Xen_wrap_no_args(g_enved_in_dB_w, g_enved_in_dB)
+Xen_wrap_1_arg(g_set_enved_in_dB_w, g_set_enved_in_dB)
+Xen_wrap_no_args(g_enved_filter_order_w, g_enved_filter_order)
+Xen_wrap_1_arg(g_set_enved_filter_order_w, g_set_enved_filter_order)
+Xen_wrap_no_args(g_enved_dialog_w, g_enved_dialog)
+Xen_wrap_1_optional_arg(g_save_envelopes_w, g_save_envelopes)
+Xen_wrap_3_optional_args(g_define_envelope_w, g_define_envelope)
+
+#if HAVE_SCHEME
+static s7_pointer acc_enved_base(s7_scheme *sc, s7_pointer args) {return(g_set_enved_base(s7_cadr(args)));}
+static s7_pointer acc_enved_filter_order(s7_scheme *sc, s7_pointer args) {return(g_set_enved_filter_order(s7_cadr(args)));}
+static s7_pointer acc_enved_power(s7_scheme *sc, s7_pointer args) {return(g_set_enved_power(s7_cadr(args)));}
+static s7_pointer acc_enved_style(s7_scheme *sc, s7_pointer args) {return(g_set_enved_style(s7_cadr(args)));}
+static s7_pointer acc_enved_target(s7_scheme *sc, s7_pointer args) {return(g_set_enved_target(s7_cadr(args)));}
+static s7_pointer acc_enved_with_wave(s7_scheme *sc, s7_pointer args) {return(g_set_enved_with_wave(s7_cadr(args)));}
#endif
void g_init_env(void)
@@ -1800,43 +1849,41 @@ void g_init_env(void)
#define H_enved_spectrum "The value for " S_enved_target " that sets the envelope editor 'flt' button."
#define H_enved_srate "The value for " S_enved_target " that sets the envelope editor 'src' button."
- XEN_DEFINE_CONSTANT(S_enved_amplitude, ENVED_AMPLITUDE, H_enved_amplitude);
- XEN_DEFINE_CONSTANT(S_enved_spectrum, ENVED_SPECTRUM, H_enved_spectrum);
- XEN_DEFINE_CONSTANT(S_enved_srate, ENVED_SRATE, H_enved_srate);
+ Xen_define_constant(S_enved_amplitude, ENVED_AMPLITUDE, H_enved_amplitude);
+ Xen_define_constant(S_enved_spectrum, ENVED_SPECTRUM, H_enved_spectrum);
+ Xen_define_constant(S_enved_srate, ENVED_SRATE, H_enved_srate);
- XEN_DEFINE_CONSTANT(S_envelope_linear, ENVELOPE_LINEAR, S_enved_style " choice: linear connections between breakpoints");
- XEN_DEFINE_CONSTANT(S_envelope_exponential, ENVELOPE_EXPONENTIAL, S_enved_style " choice: exponential connections between breakpoints");
+ Xen_define_constant(S_envelope_linear, ENVELOPE_LINEAR, S_enved_style " choice: linear connections between breakpoints");
+ Xen_define_constant(S_envelope_exponential, ENVELOPE_EXPONENTIAL, S_enved_style " choice: exponential connections between breakpoints");
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_base, g_enved_base_w, H_enved_base, S_setB S_enved_base, g_set_enved_base_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_power, g_enved_power_w, H_enved_power, S_setB S_enved_power, g_set_enved_power_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_clip_p, g_enved_clip_p_w, H_enved_clip_p, S_setB S_enved_clip_p, g_set_enved_clip_p_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_style, g_enved_style_w, H_enved_style, S_setB S_enved_style, g_set_enved_style_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_target, g_enved_target_w, H_enved_target, S_setB S_enved_target, g_set_enved_target_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_wave_p, g_enved_wave_p_w, H_enved_wave_p, S_setB S_enved_wave_p, g_set_enved_wave_p_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_in_dB, g_enved_in_dB_w, H_enved_in_dB, S_setB S_enved_in_dB, g_set_enved_in_dB_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_base, g_enved_base_w, H_enved_base, S_set S_enved_base, g_set_enved_base_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_power, g_enved_power_w, H_enved_power, S_set S_enved_power, g_set_enved_power_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_clipping, g_enved_clipping_w, H_enved_clipping, S_set S_enved_clipping, g_set_enved_clipping_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_style, g_enved_style_w, H_enved_style, S_set S_enved_style, g_set_enved_style_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_target, g_enved_target_w, H_enved_target, S_set S_enved_target, g_set_enved_target_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_with_wave, g_enved_with_wave_w, H_enved_with_wave, S_set S_enved_with_wave, g_set_enved_with_wave_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_in_dB, g_enved_in_dB_w, H_enved_in_dB, S_set S_enved_in_dB, g_set_enved_in_dB_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_filter_order, g_enved_filter_order_w, H_enved_filter_order,
- S_setB S_enved_filter_order, g_set_enved_filter_order_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_filter_order, g_enved_filter_order_w, H_enved_filter_order,
+ S_set S_enved_filter_order, g_set_enved_filter_order_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE(S_enved_dialog, g_enved_dialog_w, 0, 0, 0, H_enved_dialog);
- XEN_DEFINE_PROCEDURE(S_save_envelopes, g_save_envelopes_w, 0, 1, 0, H_save_envelopes);
+ Xen_define_safe_procedure(S_enved_dialog, g_enved_dialog_w, 0, 0, 0, H_enved_dialog);
+ Xen_define_safe_procedure(S_save_envelopes, g_save_envelopes_w, 0, 1, 0, H_save_envelopes);
#if HAVE_SCHEME
- XEN_DEFINE_PROCEDURE(S_define_envelope "-1", g_define_envelope_w, 2, 1, 0, H_define_envelope);
- XEN_EVAL_C_STRING("(defmacro define-envelope (a . b) `(define-envelope-1 ',a , at b))");
- XEN_EVAL_C_STRING("(defmacro defvar (a b) `(define-envelope-1 ',a ,b))");
- /* macro used here to ensure that "ampf" in (defvar ampf '(0 0 1 1)) is not evaluated */
+ Xen_define_safe_procedure(S_define_envelope "-1", g_define_envelope_w, 2, 1, 0, H_define_envelope);
+ Xen_eval_C_string("(define-macro (define-envelope a . b) `(define-envelope-1 ',a , at b))");
#else
- XEN_DEFINE_PROCEDURE(S_define_envelope, g_define_envelope_w, 2, 1, 0, H_define_envelope);
+ Xen_define_procedure(S_define_envelope, g_define_envelope_w, 2, 1, 0, H_define_envelope);
#endif
- XEN_DEFINE_CONSTANT(S_enved_add_point, ENVED_ADD_POINT, S_enved_hook " 'reason' arg when point is added");
- XEN_DEFINE_CONSTANT(S_enved_delete_point, ENVED_DELETE_POINT, S_enved_hook " 'reason' arg when point is deleted");
- XEN_DEFINE_CONSTANT(S_enved_move_point, ENVED_MOVE_POINT, S_enved_hook " 'reason' arg when point is moved");
+ Xen_define_constant(S_enved_add_point, ENVED_ADD_POINT, S_enved_hook " 'reason' arg when point is added");
+ Xen_define_constant(S_enved_delete_point, ENVED_DELETE_POINT, S_enved_hook " 'reason' arg when point is deleted");
+ Xen_define_constant(S_enved_move_point, ENVED_MOVE_POINT, S_enved_hook " 'reason' arg when point is moved");
#if HAVE_SCHEME
- #define H_enved_hook S_enved_hook " (env pt new-x new-y reason): \
+ #define H_enved_hook S_enved_hook " (envelope point x y reason): \
called each time a breakpoint is changed in the envelope editor; \
if it returns a list, that list defines the new envelope, \
otherwise the breakpoint is moved (but not beyond the neighboring \
@@ -1845,14 +1892,15 @@ is 'reason' which can be " S_enved_move_point ", " S_enved_delete_point ", \
or " S_enved_add_point ". This hook makes it possible to define attack \
and decay portions in the envelope editor, or use functions such as \
stretch-envelope from env.scm: \n\
- (add-hook! " S_enved_hook "\n\
- (lambda (env pt x y reason)\n\
- (if (= reason " S_enved_move_point ")\n\
- (let* ((old-x (list-ref env (* pt 2)))\n\
- (new-env (stretch-envelope env old-x x)))\n\
- (list-set! new-env (+ (* pt 2) 1) y)\n\
- new-env)\n\
- #f)))"
+ (hook-push " S_enved_hook "\n\
+ (lambda (hook) \n\
+ ((lambda (env pt x y reason)\n\
+ (if (= reason " S_enved_move_point ")\n\
+ (let* ((old-x (list-ref env (* pt 2)))\n\
+ (new-env (stretch-envelope env old-x x)))\n\
+ (list-set! new-env (+ (* pt 2) 1) y)\n\
+ (set! (hook 'result) new-env))))) \n\
+ (hook 'envelope) (hook 'point) (hook 'x) (hook 'y) (hook 'reason))))"
#endif
#if HAVE_RUBY
#define H_enved_hook S_enved_hook " (env pt new-x new-y reason): \
@@ -1883,11 +1931,28 @@ stretch-envelope from env.fth: \n\
; add-hook!"
#endif
- enved_hook = XEN_DEFINE_HOOK(S_enved_hook, 5, H_enved_hook);
+ enved_hook = Xen_define_hook(S_enved_hook, "(make-hook 'envelope 'point 'x 'y 'reason)", 5, H_enved_hook);
+ /* not 'env as hook arg name! that can confuse clm2xen's optimizer */
ss->enved = new_env_editor();
free(ss->enved->axis);
ss->enved->axis = NULL;
ss->enved->in_dB = DEFAULT_ENVED_IN_DB;
- ss->enved->clip_p = DEFAULT_ENVED_CLIP_P;
+ ss->enved->clipping = DEFAULT_ENVED_CLIPPING;
+
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->enved_base_symbol, s7_make_function(s7, "[acc-" S_enved_base "]", acc_enved_base, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->enved_filter_order_symbol, s7_make_function(s7, "[acc-" S_enved_filter_order "]", acc_enved_filter_order, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->enved_power_symbol, s7_make_function(s7, "[acc-" S_enved_power "]", acc_enved_power, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->enved_style_symbol, s7_make_function(s7, "[acc-" S_enved_style "]", acc_enved_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->enved_target_symbol, s7_make_function(s7, "[acc-" S_enved_target "]", acc_enved_target, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->enved_with_wave_symbol, s7_make_function(s7, "[acc-" S_enved_with_wave "]", acc_enved_with_wave, 2, 0, false, "accessor"));
+
+ s7_symbol_set_documentation(s7, ss->enved_base_symbol, "*enved-base*: envelope editor exponential base value (1.0)");
+ s7_symbol_set_documentation(s7, ss->enved_filter_order_symbol, "*enved-filter-order*: envelope editor's FIR filter order (40)");
+ s7_symbol_set_documentation(s7, ss->enved_power_symbol, "*enved-power*: envelope editor base scale range (9.0^power)");
+ s7_symbol_set_documentation(s7, ss->enved_style_symbol, "*enved-style*: envelope editor breakpoint connection choice: envelope-linear or envelope-exponential");
+ s7_symbol_set_documentation(s7, ss->enved_target_symbol, "*enved-target*: determines how the envelope edit envelope is applied; enved-amplitude etc");
+ s7_symbol_set_documentation(s7, ss->enved_with_wave_symbol, "*enved-wave?*: #t if the envelope editor is displaying the waveform to be edited");
+#endif
}
diff --git a/snd-error.c b/snd-error.c
deleted file mode 100644
index 2952669..0000000
--- a/snd-error.c
+++ /dev/null
@@ -1,345 +0,0 @@
-#include "snd.h"
-
-static const char *io_error_names[IO_ERROR_NUM] = {"no error", "save-hook cancellation", "bad channel",
- "can't reopen file", "too many open files", "unknown sndlib error",
- "no memory", "can't open", "no filename", "bad data format", "bad header type", "sndlib uninitialized",
- "not a sound file", "file closed", "write error", "interrupted", "can't close",
- "bad header", "disk full", "write protected", "can't read selection file",
- "need write confirmation", "no changes", "io edit-hook cancellation", "can't create file"
-};
-
-const char *io_error_name(io_error_t err)
-{
- if (err < IO_ERROR_NUM)
- return(io_error_names[(int)err]);
- return(mus_format("unknown io_error: %d", err));
-}
-
-
-/* these are needed as C ints below */
-#ifndef MUS_DEBUGGING
- #define MUS_DEBUGGING 0
-#endif
-#ifndef USE_NO_GUI
- #define USE_NO_GUI 0
-#endif
-
-
-bool run_snd_error_hook(const char *msg)
-{
- return((XEN_HOOKED(ss->snd_error_hook)) &&
- (XEN_NOT_FALSE_P(run_or_hook(ss->snd_error_hook,
- XEN_LIST_1(C_TO_XEN_STRING(msg)),
- S_snd_error_hook))));
-}
-
-
-void redirect_snd_warning_to(void (*handler)(const char *warning_msg, void *ufd), void *data)
-{
- ss->snd_warning_handler = handler;
- ss->snd_warning_data = data;
-}
-
-
-#ifdef SND_AS_WIDGET
-static void (*snd_error_display)(const char *msg);
-
-void set_error_display(void (*func)(const char *msg))
-{
- snd_error_display = func;
-}
-#endif
-
-
-void redirect_snd_error_to(void (*handler)(const char *error_msg, void *ufd), void *data)
-{
- ss->snd_error_handler = handler;
- ss->snd_error_data = data;
-}
-
-
-static void snd_error_1(const char *msg, bool with_redirection_and_hook)
-{
- if (with_redirection_and_hook)
- {
- if (ss->snd_error_handler)
- {
- /* make sure it doesn't call itself recursively */
- void (*old_snd_error_handler)(const char *error_msg, void *data);
- void *old_snd_error_data;
- old_snd_error_handler = ss->snd_error_handler;
- old_snd_error_data = ss->snd_error_data;
- ss->snd_error_handler = NULL;
- ss->snd_error_data = NULL;
- (*(old_snd_error_handler))(msg, old_snd_error_data);
- ss->snd_error_handler = old_snd_error_handler;
- ss->snd_error_data = old_snd_error_data;
- return;
- }
-
- if (run_snd_error_hook(msg))
- return;
- }
-#if (USE_NO_GUI) || (MUS_DEBUGGING)
- fprintf(stderr, "%s", msg);
-#else
- if (ss)
- {
- if (ss->batch_mode)
- fprintf(stderr, "%s", msg);
-#ifdef SND_AS_WIDGET
- if (snd_error_display)
- {
- snd_error_display(msg);
- return;
- }
-#endif
-#if ((!HAVE_EXTENSION_LANGUAGE) && (!USE_NO_GUI))
- {
- snd_info *sp;
- sp = any_selected_sound();
- if ((sp) && (sp->active))
- display_minibuffer_error(sp, msg);
- else post_it("Error", msg);
- }
-#endif
- }
- else
- {
- fprintf(stderr, "%s", msg);
- fputc('\n', stderr);
- }
-#endif
- /* end USE_NO_GUI */
-}
-
-
-static void snd_warning_1(const char *msg)
-{
- if (ss->snd_warning_handler)
- {
- /* make sure it doesn't call itself recursively */
- void (*old_snd_warning_handler)(const char *msg, void *data);
- void *old_snd_warning_data;
- old_snd_warning_handler = ss->snd_warning_handler;
- old_snd_warning_data = ss->snd_warning_data;
- ss->snd_warning_handler = NULL;
- ss->snd_warning_data = NULL;
- (*(old_snd_warning_handler))(msg, old_snd_warning_data);
- ss->snd_warning_handler = old_snd_warning_handler;
- ss->snd_warning_data = old_snd_warning_data;
- return;
- }
-
- if ((XEN_HOOKED(ss->snd_warning_hook)) &&
- (XEN_NOT_FALSE_P(run_or_hook(ss->snd_warning_hook,
- XEN_LIST_1(C_TO_XEN_STRING(msg)),
- S_snd_warning_hook))))
- return;
-
- if ((ss) && (!(ss->batch_mode)) && (ss->max_sounds > 0))
- {
- snd_info *sp;
- sp = any_selected_sound();
- if ((sp) && (sp->active))
- display_minibuffer_error(sp, msg);
- else
- {
- listener_append(msg);
- fprintf(stderr, "%s", msg);
- }
- }
- else fprintf(stderr, "%s", msg);
-#if MUS_DEBUGGING
- fprintf(stderr, "%s", msg);
-#endif
-}
-
-
-static int snd_error_buffer_size = 1024;
-static char *snd_error_buffer = NULL;
-
-void snd_warning(const char *format, ...)
-{
- int bytes_needed = 0;
- va_list ap;
-
- if (snd_error_buffer == NULL)
- snd_error_buffer = (char *)calloc(snd_error_buffer_size, sizeof(char));
- va_start(ap, format);
-
- /* can't use vasprintf here -- we may jump anywhere leaving unclaimed memory behind
- */
-
-#if HAVE_VSNPRINTF
- bytes_needed = vsnprintf(snd_error_buffer, snd_error_buffer_size, format, ap);
-#else
- bytes_needed = vsprintf(snd_error_buffer, format, ap);
-#endif
- va_end(ap);
-
- if (bytes_needed >= snd_error_buffer_size)
- {
- snd_error_buffer_size = bytes_needed * 2;
- free(snd_error_buffer);
- snd_error_buffer = (char *)calloc(snd_error_buffer_size, sizeof(char));
- va_start(ap, format);
-#if HAVE_VSNPRINTF
- vsnprintf(snd_error_buffer, snd_error_buffer_size, format, ap);
-#else
- vsprintf(snd_error_buffer, format, ap);
-#endif
- va_end(ap);
- }
- snd_warning_1(snd_error_buffer);
-}
-
-
-void snd_warning_without_format(const char *msg)
-{
- snd_warning_1(msg);
-}
-
-
-void snd_error(const char *format, ...)
-{
- int bytes_needed = 0;
- va_list ap;
- if (snd_error_buffer == NULL)
- snd_error_buffer = (char *)calloc(snd_error_buffer_size, sizeof(char));
- va_start(ap, format);
-#if HAVE_VSNPRINTF
- bytes_needed = vsnprintf(snd_error_buffer, snd_error_buffer_size, format, ap);
-#else
- bytes_needed = vsprintf(snd_error_buffer, format, ap);
-#endif
- va_end(ap);
- if (bytes_needed > snd_error_buffer_size)
- {
- snd_error_buffer_size = bytes_needed * 2;
- free(snd_error_buffer);
- snd_error_buffer = (char *)calloc(snd_error_buffer_size, sizeof(char));
- va_start(ap, format);
-#if HAVE_VSNPRINTF
- vsnprintf(snd_error_buffer, snd_error_buffer_size, format, ap);
-#else
- vsprintf(snd_error_buffer, format, ap);
-#endif
- va_end(ap);
- }
- snd_error_1(snd_error_buffer, true);
-}
-
-
-void snd_error_without_format(const char *msg)
-{
- snd_error_1(msg, true);
-}
-
-
-static XEN g_snd_error(XEN msg)
-{
- /* this throws a 'snd-error error; it does not call snd_error_1 or friends above */
- #define H_snd_error "(" S_snd_error " str): throws a 'snd-error error"
- XEN_ASSERT_TYPE(XEN_STRING_P(msg), msg, XEN_ONLY_ARG, S_snd_error, "a string");
-
- if (!(run_snd_error_hook(XEN_TO_C_STRING(msg)))) /* have to call this before the throw, else we end up at top level */
- XEN_ERROR(XEN_ERROR_TYPE("snd-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_snd_error ": ~A"),
- msg));
- return(msg);
-}
-
-
-static XEN g_snd_warning(XEN msg)
-{
- #define H_snd_warning "(" S_snd_warning " str): reports warning message str (normally in the minibuffer)"
- XEN_ASSERT_TYPE(XEN_STRING_P(msg), msg, XEN_ONLY_ARG, S_snd_warning, "a string");
- snd_warning("%s", XEN_TO_C_STRING(msg));
- return(msg);
-}
-
-
-static XEN clip_hook;
-
-static mus_sample_t run_clip_hook(mus_sample_t val)
-{
- if (XEN_HOOKED(clip_hook))
- {
- XEN result;
- result = run_progn_hook(clip_hook,
- XEN_LIST_1(C_TO_XEN_DOUBLE(MUS_SAMPLE_TO_DOUBLE(val))),
- S_clip_hook);
- if (XEN_NUMBER_P(result))
- return(MUS_DOUBLE_TO_SAMPLE(XEN_TO_C_DOUBLE(result)));
- }
- /* otherwise mimic the built-in default in io.c */
- if (val >= MUS_SAMPLE_MAX)
- return(MUS_SAMPLE_MAX);
- return(MUS_SAMPLE_MIN);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_1(g_snd_error_w, g_snd_error)
-XEN_NARGIFY_1(g_snd_warning_w, g_snd_warning)
-#else
-#define g_snd_error_w g_snd_error
-#define g_snd_warning_w g_snd_warning
-#endif
-
-void g_init_errors(void)
-{
- XEN_DEFINE_PROCEDURE(S_snd_error, g_snd_error_w, 1, 0, 0, H_snd_error);
- XEN_DEFINE_PROCEDURE(S_snd_warning, g_snd_warning_w, 1, 0, 0, H_snd_warning);
-
-#if HAVE_SCHEME
- #define H_snd_error_hook S_snd_error_hook " (error-message): called upon snd_error. \
-If it returns " PROC_TRUE ", Snd flushes the error (it assumes you've reported it via the hook:\n\
- (add-hook! " S_snd_error_hook "\n\
- (lambda (msg) (" S_play " \"bong.snd\") #f))"
-
- #define H_snd_warning_hook S_snd_warning_hook " (warning-message): called upon snd_warning. \
-If it returns " PROC_TRUE ", Snd flushes the warning (it assumes you've reported it via the hook):\n\
- (define without-warnings\n\
- (lambda (thunk)\n\
- (define no-warning (lambda (msg) #t))\n\
- (add-hook! " S_snd_warning_hook " no-warning)\n\
- (thunk)\n\
- (remove-hook! " S_snd_warning_hook " no-warning)))"
-#endif
-#if HAVE_RUBY
- #define H_snd_error_hook S_snd_error_hook " (error-message): called upon snd_error. \
-If it returns true, Snd flushes the error (it assumes you've reported it via the hook:\n\
- $snd_error_hook.add-hook!(\"error\") do |msg|\n\
- play(\"bong.snd\")\n\
- false\n\
- end"
-
- #define H_snd_warning_hook S_snd_warning_hook " (warning-message): called upon snd_warning. \
-If it returns true, Snd flushes the warning (it assumes you've reported it via the hook)"
-#endif
-#if HAVE_FORTH
- #define H_snd_error_hook S_snd_error_hook " (error-message): called upon snd_error. \
-If it returns " PROC_TRUE ", Snd flushes the error (it assumes you've reported it via the hook:\n\
-" S_snd_error_hook " lambda: <{ msg }>\n\
- \"bong.snd\" " S_play "\n\
-; add-hook!"
-
- #define H_snd_warning_hook S_snd_warning_hook " (warning-message): called upon snd_warning. \
-If it returns " PROC_TRUE ", Snd flushes the warning (it assumes you've reported it via the hook)"
-#endif
-
- ss->snd_error_hook = XEN_DEFINE_HOOK(S_snd_error_hook, 1, H_snd_error_hook); /* arg = error-message */
- ss->snd_warning_hook = XEN_DEFINE_HOOK(S_snd_warning_hook, 1, H_snd_warning_hook); /* arg = error-message */
-
-
- #define H_clip_hook S_clip_hook " (clipping-value) is called each time a sample is about to \
-be clipped upon being written to a sound file. The hook function can return the new value to \
-be written, or rely on the default (-1.0 or 1.0 depending on the sign of 'clipping-value')."
-
- clip_hook = XEN_DEFINE_HOOK(S_clip_hook, 1, H_clip_hook); /* arg = clipping val as double */
-
- mus_clip_set_handler(run_clip_hook);
-}
-
diff --git a/snd-fft.c b/snd-fft.c
index 3e0f962..7f24270 100644
--- a/snd-fft.c
+++ b/snd-fft.c
@@ -17,9 +17,9 @@ static void wavelet_transform(mus_float_t *data, mus_long_t num, mus_float_t *cc
mus_float_t *data1 = NULL;
mus_float_t sig = -1.0;
mus_float_t *cr = NULL;
- mus_long_t i, j, n, n1, nmod, nh, joff, ii, ni, k, jf;
+ mus_long_t i, j, n, ii, ni, k, jf;
- cr = (mus_float_t *)calloc(cc_size, sizeof(mus_float_t));
+ cr = (mus_float_t *)malloc(cc_size * sizeof(mus_float_t));
for (i = 0, j = cc_size - 1; i < cc_size; i++, j--)
{
@@ -29,6 +29,7 @@ static void wavelet_transform(mus_float_t *data, mus_long_t num, mus_float_t *cc
for (n = num; n >= 4; n /= 2)
{
+ mus_long_t n1, nh, nmod, joff;
if (data1) free(data1);
data1 = (mus_float_t *)calloc(n, sizeof(mus_float_t));
n1 = n - 1;
@@ -154,7 +155,7 @@ const char **wavelet_names(void) {return(wavelet_names_1);}
static void haar_transform(mus_float_t *f, mus_long_t n)
{
- mus_long_t m, mh, i, j, k;
+ mus_long_t m, i, j, k;
mus_float_t s2;
mus_float_t v = 1.0;
mus_float_t x, y;
@@ -165,6 +166,7 @@ static void haar_transform(mus_float_t *f, mus_long_t n)
for (m = n; m > 1; m >>= 1)
{
+ mus_long_t mh;
v *= s2;
mh = (m >> 1);
for (j = 0, k = 0; j < m; j += 2, k++)
@@ -192,20 +194,20 @@ static void haar_transform(mus_float_t *f, mus_long_t n)
static void walsh_transform(mus_float_t *data, mus_long_t n)
{
- mus_long_t i, j, m, r, t1, t2, mh;
- int ipow;
- mus_float_t u, v;
-
+ int i, ipow;
ipow = (int)((log(n) / log(2)) + .0001); /* added fudge factor 21-Sep-01 -- (int)3.0000 = 2 on PC */
for (i = ipow; i >= 1; --i)
{
+ mus_long_t r, m, mh, t1, t2;
m = (1 << i);
mh = (m >> 1);
for (r = 0; r < n; r += m)
{
+ int j;
for (j = 0, t1 = r, t2 = r + mh; j < mh; ++j, ++t1, ++t2)
{
+ mus_float_t u, v;
u = data[t1];
v = data[t2];
data[t1] = u + v;
@@ -279,7 +281,6 @@ int find_and_sort_peaks(mus_float_t *buf, fft_peak *found, int num_peaks, mus_lo
for (i = 0; i < pks; i++)
{
j = inds[i];
- ca = buf[j];
found[i].amp = buf[j];
found[i].freq = (mus_float_t)j;
}
@@ -297,7 +298,7 @@ int find_and_sort_transform_peaks(mus_float_t *buf, fft_peak *found, int num_pea
mus_long_t losamp, mus_long_t hisamp, mus_float_t samps_per_pixel, mus_float_t fft_scale)
{
/* we want to reflect the graph as displayed, so each "bin" is samps_per_pixel wide */
- mus_long_t i, j, k, hop, pkj, oldpkj;
+ mus_long_t i, j, k, hop, pkj;
int pks, minpk;
mus_float_t minval, la, ra, ca, logca, logra, logla, offset, fscl, ascl, bscl, fftsize2;
mus_float_t *peaks;
@@ -321,6 +322,7 @@ int find_and_sort_transform_peaks(mus_float_t *buf, fft_peak *found, int num_pea
for (i = losamp; i < hisamp - hop; i += hop)
{
+ mus_long_t oldpkj;
la = ca;
ca = ra;
oldpkj = pkj;
@@ -430,7 +432,7 @@ static const char *transform_type_program_names[NUM_BUILTIN_TRANSFORM_TYPES] = {
typedef struct {
char *name, *xlabel;
mus_float_t lo, hi;
- XEN proc;
+ Xen proc;
int type, row, gc_loc;
} added_transform;
@@ -471,7 +473,7 @@ static added_transform *new_transform(void)
}
-static int add_transform(const char *name, const char *xlabel, mus_float_t lo, mus_float_t hi, XEN proc)
+static int add_transform(const char *name, const char *xlabel, mus_float_t lo, mus_float_t hi, Xen proc)
{
added_transform *af;
af = new_transform();
@@ -496,7 +498,7 @@ static added_transform *type_to_transform(int type)
}
-bool transform_p(int type)
+bool is_transform(int type)
{
if (type < 0) return(false);
if (type < NUM_BUILTIN_TRANSFORM_TYPES) return(true);
@@ -508,7 +510,7 @@ bool transform_p(int type)
const char *transform_name(int type)
{
- if (transform_p(type))
+ if (is_transform(type))
{
added_transform *af;
if (type < NUM_BUILTIN_TRANSFORM_TYPES)
@@ -522,7 +524,7 @@ const char *transform_name(int type)
const char *transform_program_name(int type)
{
- if (transform_p(type))
+ if (is_transform(type))
{
added_transform *af;
if (type < NUM_BUILTIN_TRANSFORM_TYPES)
@@ -561,12 +563,12 @@ static mus_float_t added_transform_hi(int type)
}
-static XEN added_transform_proc(int type)
+static Xen added_transform_proc(int type)
{
added_transform *af;
af = type_to_transform(type);
if (af) return(af->proc);
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -642,18 +644,18 @@ static void make_sonogram_axes(chan_info *cp)
{
axis_info *ap;
mus_float_t max_freq, min_freq, yang;
- const char *xlabel;
ap = cp->axis;
if (cp->transform_type == FOURIER)
{
- max_freq = cp->spectrum_end * (mus_float_t)SND_SRATE(cp->sound) * 0.5;
- if ((cp->fft_log_frequency) && ((SND_SRATE(cp->sound) * 0.5 * cp->spectrum_start) < log_freq_start(ss)))
+ max_freq = cp->spectrum_end * (mus_float_t)snd_srate(cp->sound) * 0.5;
+ if ((cp->fft_log_frequency) && ((snd_srate(cp->sound) * 0.5 * cp->spectrum_start) < log_freq_start(ss)))
min_freq = log_freq_start(ss);
- else min_freq = cp->spectrum_start * (mus_float_t)SND_SRATE(cp->sound) * 0.5;
+ else min_freq = cp->spectrum_start * (mus_float_t)snd_srate(cp->sound) * 0.5;
}
else
{
- if (cp->transform_type == AUTOCORRELATION)
+ if ((cp->transform_type == AUTOCORRELATION) ||
+ (cp->transform_type == CEPSTRUM))
{
max_freq = fp->current_size * cp->spectrum_end / 2;
min_freq = fp->current_size * cp->spectrum_start / 2;
@@ -668,6 +670,7 @@ static void make_sonogram_axes(chan_info *cp)
if (yang < 0.0) yang += 360.0;
if (cp->transform_graph_type == GRAPH_AS_SPECTROGRAM)
{
+ const char *xlabel;
if (cp->transform_type == FOURIER)
{
if (yang < 45.0) xlabel = "frequency";
@@ -720,15 +723,12 @@ typedef struct fft_state {
} fft_state;
-#if (!HAVE_DECL_HYPOT)
-static double hypot(double r, double i) {return(sqrt(r * r + i * i));}
-#endif
-
+static mus_float_t *fs_idata = NULL;
+static mus_long_t fs_idata_size = 0;
void fourier_spectrum(snd_fd *sf, mus_float_t *fft_data, mus_long_t fft_size, mus_long_t data_len, mus_float_t *window, chan_info *cp)
{
- mus_long_t i;
- mus_float_t *idata;
+ mus_long_t i, j, lim;
if (window)
{
@@ -743,29 +743,51 @@ void fourier_spectrum(snd_fd *sf, mus_float_t *fft_data, mus_long_t fft_size, mu
if (data_len < fft_size)
memset((void *)(fft_data + data_len), 0, (fft_size - data_len) * sizeof(mus_float_t));
- idata = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
+ if (fft_size <= fs_idata_size)
+ memset((void *)fs_idata, 0, fft_size * sizeof(mus_float_t));
+ else
+ {
+ if (!fs_idata)
+ fs_idata = (mus_float_t *)malloc(fft_size * sizeof(mus_float_t));
+ else fs_idata = (mus_float_t *)realloc(fs_idata, fft_size * sizeof(mus_float_t));
+ memset((void *)fs_idata, 0, fft_size * sizeof(mus_float_t));
+ fs_idata_size = fft_size;
+ }
- mus_fft(fft_data, idata, fft_size, 1);
+ mus_fft(fft_data, fs_idata, fft_size, 1);
+ lim = fft_size / 2;
if ((cp) && (cp->fft_with_phases))
{
- for (i = 0; i < fft_size; i++)
+ fft_data[0] = hypot(fft_data[0], fs_idata[0]);
+ cp->fft->phases[0] = -atan2(fs_idata[0], fft_data[0]);
+ for (i = 1, j = fft_size - 1; i < lim; i++, j--)
{
- cp->fft->phases[i] = -atan2(idata[i], fft_data[i]);
- fft_data[i] = hypot(fft_data[i], idata[i]);
+ fft_data[i] = hypot(fft_data[i], fs_idata[i]);
+ fft_data[j] = fft_data[i];
+ cp->fft->phases[i] = -atan2(fs_idata[i], fft_data[i]);
+ cp->fft->phases[j] = -cp->fft->phases[i];
}
}
else
{
- for (i = 0; i < fft_size; i++)
- fft_data[i] = hypot(fft_data[i], idata[i]);
+ fft_data[0] = hypot(fft_data[0], fs_idata[0]);
+ for (i = 1, j = fft_size - 1; i < lim; i++, j--)
+ {
+ fft_data[i] = hypot(fft_data[i], fs_idata[i]);
+ fft_data[j] = fft_data[i];
+ }
+ }
+ if (fs_idata_size >= 4194304)
+ {
+ free(fs_idata);
+ fs_idata = NULL;
+ fs_idata_size = 0;
}
-
- free(idata);
}
-static XEN before_transform_hook;
+static Xen before_transform_hook;
static void apply_fft(fft_state *fs)
{
@@ -788,15 +810,15 @@ static void apply_fft(fft_state *fs)
}
else
{
- XEN res;
- if (XEN_HOOKED(before_transform_hook))
+ if (Xen_hook_has_list(before_transform_hook))
{
+ Xen res;
res = run_progn_hook(before_transform_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan)),
+ Xen_list_2(C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan)),
S_before_transform_hook);
- if (XEN_NUMBER_P(res))
- ind0 = XEN_TO_C_INT64_T_OR_ELSE(res, 0) + fs->beg;
+ if (Xen_is_llong(res))
+ ind0 = Xen_llong_to_C_llong(res) + fs->beg;
else ind0 = cp->axis->losamp + fs->beg;
}
else
@@ -850,22 +872,22 @@ static void apply_fft(fft_state *fs)
default:
{
- XEN res = XEN_FALSE, sfd;
- vct *v;
+ Xen res, sfd;
int gc_loc, sf_loc;
- mus_long_t len;
sfd = g_c_make_sampler(sf);
sf_loc = snd_protect(sfd);
- res = XEN_CALL_2(added_transform_proc(cp->transform_type),
- C_TO_XEN_INT64_T(data_len),
+ res = Xen_call_with_2_args(added_transform_proc(cp->transform_type),
+ C_llong_to_Xen_llong(data_len),
sfd,
"added transform func");
gc_loc = snd_protect(res);
- if (MUS_VCT_P(res))
+ if (mus_is_vct(res))
{
- v = XEN_TO_VCT(res);
- len = v->length;
- memcpy((void *)fft_data, (void *)(v->data), len * sizeof(mus_float_t));
+ vct *v;
+ mus_long_t len;
+ v = Xen_to_vct(res);
+ len = mus_vct_length(v);
+ memcpy((void *)fft_data, (void *)(mus_vct_data(v)), len * sizeof(mus_float_t));
}
snd_unprotect_at(gc_loc);
snd_unprotect_at(sf_loc);
@@ -889,7 +911,7 @@ static void display_fft(fft_state *fs)
mus_float_t *data, *tdata;
chan_info *ncp;
snd_info *sp;
- mus_long_t i, j, lo, hi;
+ mus_long_t i, lo, hi;
cp = fs->cp;
if ((cp == NULL) || (cp->active < CHANNEL_HAS_AXES)) return;
@@ -902,15 +924,18 @@ static void display_fft(fft_state *fs)
if (data == NULL) return;
sp = cp->sound;
- xlabel = spectro_xlabel(cp);
+ if (fp->xlabel == NULL)
+ xlabel = spectro_xlabel(cp);
+ else xlabel = fp->xlabel;
+ /* this only works until the fft data is remade in some way, then the label reverts to "frequency" */
switch (cp->transform_type)
{
case FOURIER:
- max_freq = ((mus_float_t)(SND_SRATE(sp)) * 0.5 * cp->spectrum_end);
- if ((cp->fft_log_frequency) && ((SND_SRATE(sp) * 0.5 * cp->spectrum_start) < log_freq_start(ss)))
+ max_freq = ((mus_float_t)(snd_srate(sp)) * 0.5 * cp->spectrum_end);
+ if ((cp->fft_log_frequency) && ((snd_srate(sp) * 0.5 * cp->spectrum_start) < log_freq_start(ss)))
min_freq = log_freq_start(ss);
- else min_freq = ((mus_float_t)(SND_SRATE(sp)) * 0.5 * cp->spectrum_start);
+ else min_freq = ((mus_float_t)(snd_srate(sp)) * 0.5 * cp->spectrum_start);
break;
case WAVELET: case WALSH: case HAAR:
@@ -954,10 +979,11 @@ static void display_fft(fft_state *fs)
(sp->nchans > 1) &&
(sp->channel_style == CHANNELS_SUPERIMPOSED)))
{
+ int j;
for (j = 0; j < sp->nchans; j++)
{
ncp = sp->chans[j];
- if ((ncp->graph_transform_p) && (ncp->fft)) /* normalize-by-sound but not ffting all chans? */
+ if ((ncp->graph_transform_on) && (ncp->fft)) /* normalize-by-sound but not ffting all chans? */
{
nfp = ncp->fft;
tdata = nfp->data;
@@ -1115,7 +1141,7 @@ static fft_state *make_fft_state(chan_info *cp, bool force_recalc)
}
else
{
- if ((cp->zero_pad == 0) && (POWER_OF_2_P(cp->transform_size)))
+ if ((cp->zero_pad == 0) && (is_power_of_2(cp->transform_size)))
fftsize = cp->transform_size;
else fftsize = snd_mus_long_t_pow2((int)(ceil(log((mus_float_t)(cp->transform_size * (1 + cp->zero_pad))) / log(2.0))));
if (fftsize < 2) fftsize = 2;
@@ -1126,7 +1152,7 @@ static fft_state *make_fft_state(chan_info *cp, bool force_recalc)
{
fs = cp->fft_data;
if ((fs->losamp == ap->losamp) &&
- (!(XEN_HOOKED(before_transform_hook))) &&
+ (!(Xen_hook_has_list(before_transform_hook))) &&
(fs->size == fftsize) &&
(fs->transform_type == cp->transform_type) &&
(fs->wintype == cp->fft_window) &&
@@ -1333,7 +1359,7 @@ typedef struct sonogram_state {
graph_type_t graph_type;
int transform_type, w_choice;
bool old_logxing;
- bool minibuffer_needs_to_be_cleared;
+ bool status_needs_to_be_cleared;
bool force_recalc;
} sonogram_state;
@@ -1369,7 +1395,7 @@ void *make_sonogram_state(chan_info *cp, bool force_recalc)
sg->msg_ctr = 8;
sg->transform_type = cp->transform_type;
sg->w_choice = cp->wavelet_type;
- sg->minibuffer_needs_to_be_cleared = false;
+ sg->status_needs_to_be_cleared = false;
if (cp->temp_sonogram)
{
sonogram_state *temp_sg;
@@ -1413,7 +1439,7 @@ void free_sono_info(chan_info *cp)
}
-static bool memory_available_p(mus_long_t slices, mus_long_t bins)
+static bool memory_is_available(mus_long_t slices, mus_long_t bins)
{
/* as far as I can tell, the approved way to make sure we can allocate enough memory is to allocate it... */
mus_long_t bytes_needed; /* "mus_long_t" throughout is vital here */
@@ -1440,7 +1466,7 @@ static bool memory_available_p(mus_long_t slices, mus_long_t bins)
if (check_alloc[i] == NULL)
{
int j;
- snd_warning("can't allocate enough memory to run this set of FFTS: " MUS_LD " bytes needed", bytes_needed);
+ snd_warning("can't allocate enough memory to run this set of FFTS: %lld bytes needed", bytes_needed);
for (j = 0; j < i; j++)
free(check_alloc[j]);
return(false);
@@ -1469,7 +1495,7 @@ static sono_slice_t set_up_sonogram(sonogram_state *sg)
cp->fft_changed = FFT_UNCHANGED;
else cp->fft_changed = FFT_CHANGED;
- if ((!(cp->graph_transform_p)) || (cp->transform_size <= 2)) return(SONO_QUIT);
+ if ((!(cp->graph_transform_on)) || (cp->transform_size <= 2)) return(SONO_QUIT);
ap = cp->axis;
sg->slice = SONO_INIT;
sg->outer = 0;
@@ -1480,8 +1506,8 @@ static sono_slice_t set_up_sonogram(sonogram_state *sg)
sg->alpha = cp->fft_window_alpha;
sg->beta = cp->fft_window_beta;
- if (cp->graph_time_p) dpys++;
- if (cp->graph_lisp_p) dpys++;
+ if (cp->graph_time_on) dpys++;
+ if (cp->graph_lisp_on) dpys++;
if (cp->transform_graph_type == GRAPH_AS_SPECTROGRAM)
sg->outlim = ap->height / cp->spectro_hop;
@@ -1495,10 +1521,11 @@ static sono_slice_t set_up_sonogram(sonogram_state *sg)
/* if fewer samps than pixels, draw rectangles */
if ((cp->transform_type == FOURIER) ||
- (cp->transform_type == AUTOCORRELATION))
- sg->spectrum_size = (cp->transform_size) / 2;
- else sg->spectrum_size = cp->transform_size;
- if (sg->spectrum_size <= 0) return(SONO_QUIT);
+ (cp->transform_type == AUTOCORRELATION) ||
+ (cp->transform_type == CEPSTRUM))
+ sg->spectrum_size = sg->fs->size / 2;
+ else sg->spectrum_size = sg->fs->size;
+ if (sg->spectrum_size <= 0) return(SONO_QUIT);
sg->edit_ctr = cp->edit_ctr;
si = cp->sonogram_data;
@@ -1509,7 +1536,7 @@ static sono_slice_t set_up_sonogram(sonogram_state *sg)
si->total_bins = sg->spectrum_size;
si->total_slices = snd_to_int_pow2(sg->outlim);
- if (!memory_available_p((mus_long_t)(si->total_slices), (mus_long_t)(si->total_bins)))
+ if (!memory_is_available((mus_long_t)(si->total_slices), (mus_long_t)(si->total_bins)))
{
free(si);
return(SONO_QUIT);
@@ -1527,7 +1554,7 @@ static sono_slice_t set_up_sonogram(sonogram_state *sg)
int tempsize;
tempsize = snd_to_int_pow2(sg->outlim);
- if (!memory_available_p((mus_long_t)tempsize, (mus_long_t)(sg->spectrum_size)))
+ if (!memory_is_available((mus_long_t)tempsize, (mus_long_t)(sg->spectrum_size)))
return(SONO_QUIT);
for (i = 0; i < si->total_slices; i++)
@@ -1558,7 +1585,7 @@ static sono_slice_t set_up_sonogram(sonogram_state *sg)
lsg = (sonogram_state *)(cp->last_sonogram);
if ((lsg->done) && /* it completed all ffts */
(lsg->outlim == sg->outlim) && /* the number of ffts is the same */
- (lsg->spectrum_size == sg->spectrum_size) && /* ditto fft sizes [cp->transform_size] */
+ (lsg->spectrum_size == sg->spectrum_size) && /* ditto fft sizes [fs->size] */
(lsg->losamp == sg->losamp) && /* begins are same */
(lsg->hisamp == sg->hisamp) && /* ends are same */
(lsg->window == sg->window) && /* data windows are same [fs->wintype, cp->fft_window] */
@@ -1583,7 +1610,7 @@ static sono_slice_t set_up_sonogram(sonogram_state *sg)
cp->fft_changed = FFT_CHANGED;
start_progress_report(cp);
- sg->minibuffer_needs_to_be_cleared = true;
+ sg->status_needs_to_be_cleared = true;
return(SONO_RUN);
}
@@ -1594,8 +1621,6 @@ static sono_slice_t run_all_ffts(sonogram_state *sg)
sono_info *si;
chan_info *cp;
axis_info *ap;
- mus_float_t val;
- int i;
/* check for losamp/hisamp change? */
one_fft((fft_state *)(sg->fs));
@@ -1610,15 +1635,17 @@ static sono_slice_t run_all_ffts(sonogram_state *sg)
if (sg->msg_ctr == 0)
{
progress_report(cp, ((mus_float_t)(si->active_slices) / (mus_float_t)(si->target_slices)));
- sg->minibuffer_needs_to_be_cleared = true;
+ sg->status_needs_to_be_cleared = true;
sg->msg_ctr = 8;
- if ((!(cp->graph_transform_p)) ||
+ if ((!(cp->graph_transform_on)) ||
(cp->active < CHANNEL_HAS_AXES))
return(SONO_QUIT);
}
if (si->active_slices < si->total_slices)
{
+ int i;
+ mus_float_t val;
if (cp->transform_type == FOURIER)
{
for (i = 0; i < sg->spectrum_size; i++)
@@ -1641,7 +1668,7 @@ static sono_slice_t run_all_ffts(sonogram_state *sg)
si->active_slices++;
}
sg->outer++;
- if ((sg->outer == sg->outlim) || (!(cp->graph_transform_p)) || (cp->transform_graph_type == GRAPH_ONCE)) return(SONO_QUIT);
+ if ((sg->outer == sg->outlim) || (!(cp->graph_transform_on)) || (cp->transform_graph_type == GRAPH_ONCE)) return(SONO_QUIT);
sg->acc_hop += sg->hop;
fs->beg = (mus_long_t)(sg->acc_hop);
ap = cp->axis;
@@ -1661,7 +1688,7 @@ static void finish_sonogram(sonogram_state *sg)
chan_info *cp;
cp = sg->cp;
if ((cp->active < CHANNEL_HAS_AXES) ||
- (!(cp->graph_transform_p)))
+ (!(cp->graph_transform_on)))
{
if (sg->fs)
sg->fs = free_fft_state(sg->fs);
@@ -1684,10 +1711,10 @@ static void finish_sonogram(sonogram_state *sg)
if ((cp->last_sonogram) && (cp->last_sonogram != sg))
free(cp->last_sonogram);
cp->last_sonogram = sg;
- if (sg->minibuffer_needs_to_be_cleared)
+ if (sg->status_needs_to_be_cleared)
{
finish_progress_report(cp);
- sg->minibuffer_needs_to_be_cleared = false;
+ sg->status_needs_to_be_cleared = false;
}
}
}
@@ -1701,7 +1728,7 @@ idle_func_t sonogram_in_slices(void *sono)
cp = sg->cp;
cp->temp_sonogram = NULL;
if ((cp->active < CHANNEL_HAS_AXES) ||
- (!(cp->graph_transform_p)))
+ (!(cp->graph_transform_on)))
{
if ((sg) && (sg->fs)) sg->fs = free_fft_state(sg->fs);
return(BACKGROUND_QUIT);
@@ -1766,13 +1793,13 @@ void c_convolve(const char *fname, mus_float_t amp, int filec, mus_long_t filehd
int err;
/* need file to hold convolution output */
- err = mus_write_header(fname, MUS_NEXT, DEFAULT_OUTPUT_SRATE, 1, data_size * mus_bytes_per_sample(MUS_OUT_FORMAT), MUS_OUT_FORMAT, "c_convolve temp");
+ err = mus_write_header(fname, MUS_NEXT, DEFAULT_OUTPUT_SRATE, 1, data_size * mus_bytes_per_sample(MUS_OUT_SAMPLE_TYPE), MUS_OUT_SAMPLE_TYPE, "c_convolve temp");
if (err != MUS_NO_ERROR)
snd_error("can't open convolution temp file %s: %s", fname, snd_io_strerror());
else
{
mus_float_t *rl0 = NULL, *rl1 = NULL, *rl2 = NULL;
- mus_sample_t **pbuffer = NULL, **fbuffer = NULL;
+ mus_float_t **pbuffer = NULL, **fbuffer = NULL;
mus_long_t oloc;
oloc = mus_header_data_location();
@@ -1782,42 +1809,41 @@ void c_convolve(const char *fname, mus_float_t amp, int filec, mus_long_t filehd
rl0 = (mus_float_t *)calloc(fftsize, sizeof(mus_float_t));
if (rl0) rl1 = (mus_float_t *)calloc(fftsize, sizeof(mus_float_t));
- if (rl1) pbuffer = (mus_sample_t **)calloc(1, sizeof(mus_sample_t *));
- if (pbuffer) pbuffer[0] = (mus_sample_t *)calloc(data_size, sizeof(mus_sample_t));
- fbuffer = (mus_sample_t **)calloc(filter_chans, sizeof(mus_sample_t *));
- if (fbuffer) fbuffer[filter_chan] = (mus_sample_t *)calloc(filtersize, sizeof(mus_sample_t));
+ if (rl1) pbuffer = (mus_float_t **)calloc(1, sizeof(mus_float_t *));
+ if (pbuffer) pbuffer[0] = (mus_float_t *)calloc(data_size, sizeof(mus_float_t));
+ fbuffer = (mus_float_t **)calloc(filter_chans, sizeof(mus_float_t *));
+ if (fbuffer) fbuffer[filter_chan] = (mus_float_t *)calloc(filtersize, sizeof(mus_float_t));
if ((rl0 == NULL) || (rl1 == NULL) ||
(pbuffer == NULL) || (pbuffer[0] == NULL) ||
(fbuffer == NULL) || (fbuffer[filter_chan] == NULL))
{
- snd_error("not enough memory for convolve of %s (filter size: "MUS_LD ", fft size: " MUS_LD ")",
+ snd_error("not enough memory for convolve of %s (filter size: %lld, fft size: %lld)",
fname, filtersize, fftsize);
}
else
{
- mus_sample_t *pbuf = NULL;
+ mus_float_t *pbuf = NULL;
mus_long_t i;
- mus_float_t scl;
int tempfile;
chan_info *gcp;
gcp = gsp->chans[0];
start_progress_report(gcp);
tempfile = snd_reopen_write(fname);
- snd_file_open_descriptors(tempfile, fname, MUS_OUT_FORMAT, oloc, 1, MUS_NEXT);
+ snd_file_open_descriptors(tempfile, fname, MUS_OUT_SAMPLE_TYPE, oloc, 1, MUS_NEXT);
lseek(tempfile, oloc, SEEK_SET);
/* read in the "impulse response" */
pbuf = pbuffer[0];
mus_file_read_any(filterc, 0, filter_chans, filtersize, fbuffer, fbuffer);
for (i = 0; i < filtersize; i++)
- rl1[i] = MUS_SAMPLE_TO_FLOAT(fbuffer[filter_chan][i]);
+ rl1[i] = fbuffer[filter_chan][i];
progress_report(gcp, .1);
/* get the convolution data */
mus_file_read_any(filec, 0, 1, data_size, pbuffer, pbuffer);
- for (i = 0; i < data_size; i++) rl0[i] = MUS_SAMPLE_TO_FLOAT(pbuf[i]);
+ for (i = 0; i < data_size; i++) rl0[i] = pbuf[i];
progress_report(gcp, .3);
mus_fft(rl0, rl1, fftsize, 1);
@@ -1829,6 +1855,7 @@ void c_convolve(const char *fname, mus_float_t amp, int filec, mus_long_t filehd
if (amp != 0.0)
{
+ mus_float_t scl;
/* normalize the results */
scl = 0.0;
for (i = 0; i < data_size; i++)
@@ -1839,17 +1866,12 @@ void c_convolve(const char *fname, mus_float_t amp, int filec, mus_long_t filehd
}
if (scl != 0.0) scl = amp / scl;
for (i = 0; i < data_size; i++)
- pbuf[i] = MUS_FLOAT_TO_SAMPLE(scl * rl0[i]);
+ pbuf[i] = (scl * rl0[i]);
}
else
{
/* amp == 0.0 means un-normalized output */
-#if SNDLIB_USE_FLOATS
- memcpy((void *)pbuf, (void *)rl0, data_size * sizeof(mus_sample_t));
-#else
- for (i = 0; i < data_size; i++)
- pbuf[i] = MUS_FLOAT_TO_SAMPLE(rl0[i]);
-#endif
+ memcpy((void *)pbuf, (void *)rl0, data_size * sizeof(mus_float_t));
}
progress_report(gcp, .9);
@@ -1884,7 +1906,7 @@ static void update_log_freq_fft_graph(chan_info *cp)
if ((cp->active < CHANNEL_HAS_AXES) ||
(cp->sounds == NULL) ||
(cp->sounds[cp->sound_ctr] == NULL) ||
- (!(cp->graph_transform_p)) ||
+ (!(cp->graph_transform_on)) ||
(!(cp->fft_log_frequency)) ||
(chan_fft_in_progress(cp)))
return;
@@ -1899,41 +1921,40 @@ void set_log_freq_start(mus_float_t base)
}
-static XEN g_log_freq_start(void) {return(C_TO_XEN_DOUBLE(log_freq_start(ss)));}
+static Xen g_log_freq_start(void) {return(C_double_to_Xen_real(log_freq_start(ss)));}
-static XEN g_set_log_freq_start(XEN val)
+static Xen g_set_log_freq_start(Xen val)
{
mus_float_t base;
#define H_log_freq_start "(" S_log_freq_start "): log freq base (default: 25.0)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_log_freq_start, "a number");
- base = XEN_TO_C_DOUBLE(val);
- if (base < 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_log_freq_start, XEN_ONLY_ARG, val, "a number >= 0.0");
- if (base > 100000.0)
- XEN_OUT_OF_RANGE_ERROR(S_log_freq_start, XEN_ONLY_ARG, val, "a number < srate/2");
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_log_freq_start, "a number");
+ base = Xen_real_to_C_double(val);
+ if ((base < 0.0) ||
+ (base > 100000.0))
+ Xen_out_of_range_error(S_log_freq_start, 1, val, "base should be between 0 and srate/2");
set_log_freq_start(base);
reflect_log_freq_start_in_transform_dialog();
- return(C_TO_XEN_DOUBLE(log_freq_start(ss)));
+ return(C_double_to_Xen_real(log_freq_start(ss)));
}
-static XEN g_show_selection_transform(void) {return(C_TO_XEN_BOOLEAN(show_selection_transform(ss)));}
+static Xen g_show_selection_transform(void) {return(C_bool_to_Xen_boolean(show_selection_transform(ss)));}
-static XEN g_set_show_selection_transform(XEN val)
+static Xen g_set_show_selection_transform(Xen val)
{
#define H_show_selection_transform "(" S_show_selection_transform "): " PROC_TRUE " if transform display reflects selection, not time-domain window"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_show_selection_transform, "a boolean");
- set_show_selection_transform(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(show_selection_transform(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_show_selection_transform, "a boolean");
+ set_show_selection_transform(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(show_selection_transform(ss)));
}
-static XEN g_transform_frames(XEN snd, XEN chn)
+static Xen g_transform_framples(Xen snd, Xen chn)
{
- #define H_transform_frames "(" S_transform_frames " :optional snd chn): \
+ #define H_transform_framples "(" S_transform_framples " :optional snd chn): \
return a description of transform graph data in snd's channel chn, based on " S_transform_graph_type ".\
If there is no transform graph, return 0; if " S_graph_once ", return " S_transform_size ",\
and otherwise return a list (spectrum-cutoff time-slices fft-bins)"
@@ -1941,100 +1962,100 @@ and otherwise return a list (spectrum-cutoff time-slices fft-bins)"
chan_info *cp;
sono_info *si;
- ASSERT_CHANNEL(S_transform_frames, snd, chn, 1);
- cp = get_cp(snd, chn, S_transform_frames);
- if (!cp) return(XEN_FALSE);
- if (!(cp->graph_transform_p))
- return(XEN_ZERO);
+ Snd_assert_channel(S_transform_framples, snd, chn, 1);
+ cp = get_cp(snd, chn, S_transform_framples);
+ if (!cp) return(Xen_false);
+ if (!(cp->graph_transform_on))
+ return(Xen_integer_zero);
if (cp->transform_graph_type == GRAPH_ONCE)
- return(C_TO_XEN_INT(cp->transform_size));
+ return(C_int_to_Xen_integer(cp->transform_size));
si = cp->sonogram_data;
- if (si) return(XEN_LIST_3(C_TO_XEN_DOUBLE(cp->spectrum_end),
- C_TO_XEN_INT64_T(si->active_slices),
- C_TO_XEN_INT64_T(si->target_bins)));
- return(XEN_ZERO);
+ if (si) return(Xen_list_3(C_double_to_Xen_real(cp->spectrum_end),
+ C_llong_to_Xen_llong(si->active_slices),
+ C_llong_to_Xen_llong(si->target_bins)));
+ return(Xen_integer_zero);
}
-static XEN g_transform_sample(XEN bin, XEN slice, XEN snd, XEN chn_n)
+static Xen g_transform_sample(Xen bin, Xen slice, Xen snd, Xen chn_n)
{
#define H_transform_sample "(" S_transform_sample " :optional (bin 0) (slice 0) snd chn): \
return the current transform sample at bin and slice in snd channel chn (assuming sonogram or spectrogram)"
chan_info *cp;
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(bin), bin, XEN_ARG_1, S_transform_sample, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(slice), slice, XEN_ARG_2, S_transform_sample, "an integer");
+ Xen_check_type(Xen_is_llong_or_unbound(bin), bin, 1, S_transform_sample, "an integer");
+ Xen_check_type(Xen_is_llong_or_unbound(slice), slice, 2, S_transform_sample, "an integer");
- ASSERT_CHANNEL(S_transform_sample, snd, chn_n, 3);
+ Snd_assert_channel(S_transform_sample, snd, chn_n, 3);
cp = get_cp(snd, chn_n, S_transform_sample);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- if (cp->graph_transform_p)
+ if (cp->graph_transform_on)
{
fft_info *fp;
fp = cp->fft;
if (fp)
{
- mus_long_t fbin;
- fbin = XEN_TO_C_INT64_T_OR_ELSE(bin, 0);
+ mus_long_t fbin = 0;
+ if (Xen_is_llong(bin)) fbin = Xen_llong_to_C_llong(bin);
if (fbin < fp->current_size)
{
if (cp->transform_graph_type == GRAPH_ONCE)
- return(C_TO_XEN_DOUBLE(fp->data[fbin]));
+ return(C_double_to_Xen_real(fp->data[fbin]));
else
{
- mus_long_t fslice;
+ mus_long_t fslice = 0;
sono_info *si;
- fslice = XEN_TO_C_INT64_T_OR_ELSE(slice, 0);
+ if (Xen_is_llong(slice)) fslice = Xen_llong_to_C_llong(slice);
si = cp->sonogram_data;
if ((si) &&
(fbin < si->target_bins) &&
(fslice < si->active_slices))
- return(C_TO_XEN_DOUBLE(si->data[fslice][fbin]));
- else XEN_ERROR(NO_SUCH_SAMPLE,
- XEN_LIST_8(C_TO_XEN_STRING(S_transform_sample ": no such sample, bin: ~A, max bin: ~A, slice: ~A, max slice: ~A, sound index: ~A (~A), chan: ~A"),
+ return(C_double_to_Xen_real(si->data[fslice][fbin]));
+ else Xen_error(NO_SUCH_SAMPLE,
+ Xen_list_8(C_string_to_Xen_string(S_transform_sample ": no such sample, bin: ~A, max bin: ~A, slice: ~A, max slice: ~A, sound index: ~A (~A), chan: ~A"),
bin,
- C_TO_XEN_INT((si) ? si->target_bins : 0),
+ C_int_to_Xen_integer((si) ? si->target_bins : 0),
slice,
- C_TO_XEN_INT((si) ? si->active_slices : 0),
+ C_int_to_Xen_integer((si) ? si->active_slices : 0),
snd,
- C_TO_XEN_STRING(cp->sound->short_filename),
+ C_string_to_Xen_string(cp->sound->short_filename),
chn_n));
}
}
- else XEN_ERROR(NO_SUCH_SAMPLE,
- XEN_LIST_6(C_TO_XEN_STRING(S_transform_sample ": no such sample, bin: ~A, max bin: ~A, sound index: ~A (~A), chan: ~A"),
+ else Xen_error(NO_SUCH_SAMPLE,
+ Xen_list_6(C_string_to_Xen_string(S_transform_sample ": no such sample, bin: ~A, max bin: ~A, sound index: ~A (~A), chan: ~A"),
bin,
- C_TO_XEN_INT(fp->current_size),
+ C_int_to_Xen_integer(fp->current_size),
snd,
- C_TO_XEN_STRING(cp->sound->short_filename),
+ C_string_to_Xen_string(cp->sound->short_filename),
chn_n));
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_transform_to_vct(XEN snd, XEN chn_n, XEN v)
+static Xen g_transform_to_vct(Xen snd, Xen chn_n, Xen v)
{
#define H_transform_to_vct "(" S_transform_to_vct " :optional snd chn obj): \
-return a vct (obj if it's passed), with the current transform data from snd's channel chn"
+return a " S_vct " (obj if it's passed), with the current transform data from snd's channel chn"
chan_info *cp;
vct *v1;
v1 = xen_to_vct(v);
- ASSERT_CHANNEL(S_transform_to_vct, snd, chn_n, 1);
+ Snd_assert_channel(S_transform_to_vct, snd, chn_n, 1);
cp = get_cp(snd, chn_n, S_transform_to_vct);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- if ((cp->graph_transform_p) &&
+ if ((cp->graph_transform_on) &&
(cp->fft))
{
mus_long_t len;
@@ -2046,7 +2067,7 @@ return a vct (obj if it's passed), with the current transform data from snd's ch
fp = cp->fft;
len = fp->current_size;
if (v1)
- fvals = v1->data;
+ fvals = mus_vct_data(v1);
else fvals = (mus_float_t *)malloc(len * sizeof(mus_float_t));
memcpy((void *)fvals, (void *)(fp->data), len * sizeof(mus_float_t));
if (v1)
@@ -2065,7 +2086,7 @@ return a vct (obj if it's passed), with the current transform data from snd's ch
bins = si->target_bins;
len = bins * slices;
if (v1)
- fvals = v1->data;
+ fvals = mus_vct_data(v1);
else fvals = (mus_float_t *)calloc(len, sizeof(mus_float_t));
for (i = 0, k = 0; i < slices; i++)
for (j = 0; j < bins; j++, k++)
@@ -2076,7 +2097,7 @@ return a vct (obj if it's passed), with the current transform data from snd's ch
}
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -2088,53 +2109,53 @@ typedef struct {
} xen_transform;
-#define XEN_TO_XEN_TRANSFORM(arg) ((xen_transform *)XEN_OBJECT_REF(arg))
+#define Xen_to_xen_transform(arg) ((xen_transform *)Xen_object_ref(arg))
-int xen_transform_to_int(XEN n)
+int xen_transform_to_int(Xen n)
{
xen_transform *col;
- col = XEN_TO_XEN_TRANSFORM(n);
+ col = Xen_to_xen_transform(n);
return(col->n);
}
-static XEN_OBJECT_TYPE xen_transform_tag;
+static Xen_object_type_t xen_transform_tag;
-bool xen_transform_p(XEN obj)
+bool xen_is_transform(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, xen_transform_tag));
+ return(Xen_c_object_is_type(obj, xen_transform_tag));
}
static void xen_transform_free(xen_transform *v) {if (v) free(v);}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(xen_transform, free_xen_transform, xen_transform_free)
+Xen_wrap_free(xen_transform, free_xen_transform, xen_transform_free)
static char *xen_transform_to_string(xen_transform *v)
{
- #define XEN_TRANSFORM_PRINT_BUFFER_SIZE 64
+ #define TRANSFORM_PRINT_BUFFER_SIZE 64
char *buf;
if (v == NULL) return(NULL);
- buf = (char *)calloc(XEN_TRANSFORM_PRINT_BUFFER_SIZE, sizeof(char));
- snprintf(buf, XEN_TRANSFORM_PRINT_BUFFER_SIZE, "#<transform %s>", transform_name(v->n));
+ buf = (char *)calloc(TRANSFORM_PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, TRANSFORM_PRINT_BUFFER_SIZE, "#<transform %s>", transform_name(v->n));
return(buf);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(xen_transform, print_xen_transform, xen_transform_to_string)
+Xen_wrap_print(xen_transform, print_xen_transform, xen_transform_to_string)
#if HAVE_FORTH || HAVE_RUBY
-static XEN g_xen_transform_to_string(XEN obj)
+static Xen g_xen_transform_to_string(Xen obj)
{
char *vstr;
- XEN result;
+ Xen result;
#define S_xen_transform_to_string "transform->string"
- XEN_ASSERT_TYPE(XEN_TRANSFORM_P(obj), obj, XEN_ONLY_ARG, S_xen_transform_to_string, "a transform");
+ Xen_check_type(xen_is_transform(obj), obj, 1, S_xen_transform_to_string, "a transform");
- vstr = xen_transform_to_string(XEN_TO_XEN_TRANSFORM(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = xen_transform_to_string(Xen_to_xen_transform(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
@@ -2148,10 +2169,10 @@ static bool xen_transform_equalp(xen_transform *v1, xen_transform *v2)
(v1->n == v2->n));
}
-static XEN equalp_xen_transform(XEN obj1, XEN obj2)
+static Xen equalp_xen_transform(Xen obj1, Xen obj2)
{
- if ((!(XEN_TRANSFORM_P(obj1))) || (!(XEN_TRANSFORM_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(xen_transform_equalp(XEN_TO_XEN_TRANSFORM(obj1), XEN_TO_XEN_TRANSFORM(obj2))));
+ if ((!(xen_is_transform(obj1))) || (!(xen_is_transform(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(xen_transform_equalp(Xen_to_xen_transform(obj1), Xen_to_xen_transform(obj2))));
}
#endif
@@ -2165,17 +2186,17 @@ static xen_transform *xen_transform_make(int n)
}
-XEN new_xen_transform(int n)
+Xen new_xen_transform(int n)
{
xen_transform *mx;
if (n < 0)
- return(XEN_FALSE);
+ return(Xen_false);
mx = xen_transform_make(n);
- XEN_MAKE_AND_RETURN_OBJECT(xen_transform_tag, mx, 0, free_xen_transform);
+ return(Xen_make_object(xen_transform_tag, mx, 0, free_xen_transform));
}
-#define C_INT_TO_XEN_TRANSFORM(Val) new_xen_transform(Val)
+#define C_int_to_Xen_transform(Val) new_xen_transform(Val)
#if HAVE_SCHEME
@@ -2186,9 +2207,9 @@ static bool s7_xen_transform_equalp(void *obj1, void *obj2)
}
-static XEN s7_xen_transform_length(s7_scheme *sc, XEN obj)
+static Xen s7_xen_transform_length(s7_scheme *sc, Xen obj)
{
- return(C_TO_XEN_INT(transform_size(ss)));
+ return(C_int_to_Xen_integer(transform_size(ss)));
}
#endif
@@ -2196,13 +2217,13 @@ static XEN s7_xen_transform_length(s7_scheme *sc, XEN obj)
static void init_xen_transform(void)
{
#if HAVE_SCHEME
- xen_transform_tag = XEN_MAKE_OBJECT_TYPE("<transform>", print_xen_transform, free_xen_transform, s7_xen_transform_equalp,
- NULL, NULL, NULL, s7_xen_transform_length, NULL, NULL);
+ xen_transform_tag = s7_new_type_x(s7, "<transform>", print_xen_transform, free_xen_transform, s7_xen_transform_equalp,
+ NULL, NULL, NULL, s7_xen_transform_length, NULL, NULL, NULL);
#else
#if HAVE_RUBY
- xen_transform_tag = XEN_MAKE_OBJECT_TYPE("XenTransform", sizeof(xen_transform));
+ xen_transform_tag = Xen_make_object_type("XenTransform", sizeof(xen_transform));
#else
- xen_transform_tag = XEN_MAKE_OBJECT_TYPE("Transform", sizeof(xen_transform));
+ xen_transform_tag = Xen_make_object_type("Transform", sizeof(xen_transform));
#endif
#endif
@@ -2214,105 +2235,107 @@ static void init_xen_transform(void)
#endif
#if HAVE_RUBY
- rb_define_method(xen_transform_tag, "to_s", XEN_PROCEDURE_CAST print_xen_transform, 0);
- rb_define_method(xen_transform_tag, "eql?", XEN_PROCEDURE_CAST equalp_xen_transform, 1);
- rb_define_method(xen_transform_tag, "==", XEN_PROCEDURE_CAST equalp_xen_transform, 1);
- rb_define_method(xen_transform_tag, "to_str", XEN_PROCEDURE_CAST g_xen_transform_to_string, 0);
+ rb_define_method(xen_transform_tag, "to_s", Xen_procedure_cast print_xen_transform, 0);
+ rb_define_method(xen_transform_tag, "eql?", Xen_procedure_cast equalp_xen_transform, 1);
+ rb_define_method(xen_transform_tag, "==", Xen_procedure_cast equalp_xen_transform, 1);
+ rb_define_method(xen_transform_tag, "to_str", Xen_procedure_cast g_xen_transform_to_string, 0);
#endif
}
-static XEN g_integer_to_transform(XEN n)
+static Xen g_integer_to_transform(Xen n)
{
#define H_integer_to_transform "(" S_integer_to_transform " n) returns a transform object corresponding to the given integer"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n), n, XEN_ONLY_ARG, S_integer_to_transform, "an integer");
- return(new_xen_transform(XEN_TO_C_INT(n)));
+ Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_transform, "an integer");
+ return(new_xen_transform(Xen_integer_to_C_int(n)));
}
-static XEN g_transform_to_integer(XEN n)
+static Xen g_transform_to_integer(Xen n)
{
#define H_transform_to_integer "(" S_transform_to_integer " id) returns the integer corresponding to the given transform"
- XEN_ASSERT_TYPE(XEN_TRANSFORM_P(n), n, XEN_ONLY_ARG, S_transform_to_integer, "a transform");
- return(C_TO_XEN_INT(xen_transform_to_int(n)));
+ Xen_check_type(xen_is_transform(n), n, 1, S_transform_to_integer, "a transform");
+ return(C_int_to_Xen_integer(xen_transform_to_int(n)));
}
-static XEN g_transform_p(XEN type)
+static Xen g_is_transform(Xen type)
{
- #define H_transform_p "(" S_transform_p " obj): " PROC_TRUE " if 'obj' is a transform object."
- return(C_TO_XEN_BOOLEAN(XEN_TRANSFORM_P(type) &&
- transform_p(XEN_TRANSFORM_TO_C_INT(type))));
+ #define H_is_transform "(" S_is_transform " obj): " PROC_TRUE " if 'obj' is a transform object."
+ return(C_bool_to_Xen_boolean(xen_is_transform(type) &&
+ is_transform(Xen_transform_to_C_int(type))));
}
-static XEN g_snd_transform(XEN type, XEN data, XEN hint)
+static Xen g_snd_transform(Xen type, Xen data, Xen hint)
{
#define H_snd_transform "(snd-transform type data choice) calls whatever FFT is being used by the \
-display. 'type' is a transform object such as " S_fourier_transform "; 'data' is a vct. In the wavelet case, \
+display. 'type' is a transform object such as " S_fourier_transform "; 'data' is a " S_vct ". In the wavelet case, \
'choice' is the wavelet to use."
int trf, hnt;
- mus_long_t i, j, n2;
+ mus_long_t i, j, n2, vlen;
vct *v;
- mus_float_t *dat;
+ mus_float_t *dat, *vdata;
- XEN_ASSERT_TYPE(XEN_TRANSFORM_P(type), type, XEN_ARG_1, "snd-transform", "a transform object");
- XEN_ASSERT_TYPE(MUS_VCT_P(data), data, XEN_ARG_2, "snd-transform", "a vct");
+ Xen_check_type(xen_is_transform(type), type, 1, "snd-transform", "a transform object");
+ Xen_check_type(mus_is_vct(data), data, 2, "snd-transform", "a " S_vct);
- trf = XEN_TRANSFORM_TO_C_INT(type);
+ trf = Xen_transform_to_C_int(type);
if ((trf < 0) || (trf > HAAR))
- XEN_OUT_OF_RANGE_ERROR("snd-transform", 1, type, "~A: invalid transform choice");
+ Xen_out_of_range_error("snd-transform", 1, type, "invalid transform choice");
- v = XEN_TO_VCT(data);
+ v = Xen_to_vct(data);
+ vlen = mus_vct_length(v);
+ vdata = mus_vct_data(v);
switch (trf)
{
case FOURIER:
- n2 = v->length / 2;
- dat = (mus_float_t *)calloc(v->length, sizeof(mus_float_t));
- mus_fft(v->data, dat, v->length, 1);
- v->data[0] *= v->data[0];
- v->data[n2] *= v->data[n2];
- for (i = 1, j = v->length - 1; i < n2; i++, j--)
+ n2 = vlen / 2;
+ dat = (mus_float_t *)calloc(vlen, sizeof(mus_float_t));
+ mus_fft(vdata, dat, vlen, 1);
+ vdata[0] *= vdata[0];
+ vdata[n2] *= vdata[n2];
+ for (i = 1, j = vlen - 1; i < n2; i++, j--)
{
- v->data[i] = v->data[i] * v->data[i] + dat[i] * dat[i];
- v->data[j] = v->data[i];
+ vdata[i] = vdata[i] * vdata[i] + dat[i] * dat[i];
+ vdata[j] = vdata[i];
}
free(dat);
break;
case WAVELET:
- hnt = XEN_TO_C_INT(hint);
+ hnt = Xen_integer_to_C_int(hint);
if (hnt < NUM_WAVELETS)
- wavelet_transform(v->data, v->length, wavelet_data[hnt], wavelet_sizes[hnt]);
+ wavelet_transform(vdata, vlen, wavelet_data[hnt], wavelet_sizes[hnt]);
break;
case HAAR:
- haar_transform(v->data, v->length);
+ haar_transform(vdata, vlen);
break;
case CEPSTRUM:
- mus_cepstrum(v->data, v->length);
+ mus_cepstrum(vdata, vlen);
break;
case WALSH:
- walsh_transform(v->data, v->length);
+ walsh_transform(vdata, vlen);
break;
case AUTOCORRELATION:
- mus_autocorrelate(v->data, v->length);
+ mus_autocorrelate(vdata, vlen);
break;
}
return(data);
}
-static XEN g_add_transform(XEN name, XEN xlabel, XEN lo, XEN hi, XEN proc)
+static Xen g_add_transform(Xen name, Xen xlabel, Xen lo, Xen hi, Xen proc)
{
#define H_add_transform "(" S_add_transform " name x-label low high func): add the transform func \
to the transform lists; func should be a function of two arguments, the length of the transform \
-and a sampler to get the data, and should return a vct containing the transform results. \
+and a sampler to get the data, and should return a " S_vct " containing the transform results. \
name is the transform's name, x-label is its x-axis label, and the relevant returned data \
to be displayed goes from low to high (normally 0.0 to 1.0). " S_add_transform " returns the new transform object."
@@ -2320,27 +2343,27 @@ to be displayed goes from low to high (normally 0.0 to 1.0). " S_add_transform
errmsg = procedure_ok(proc, 2, S_add_transform, "transform", 5);
if (errmsg)
{
- XEN errstr;
- errstr = C_TO_XEN_STRING(errmsg);
+ Xen errstr;
+ errstr = C_string_to_Xen_string(errmsg);
free(errmsg);
return(snd_bad_arity_error(S_add_transform, errstr, proc));
}
#if HAVE_SCHEME
- if ((mus_xen_p(proc)) || (sound_data_p(proc))) /* happens a lot in snd-test.scm, so add a check */
- XEN_WRONG_TYPE_ARG_ERROR(S_add_transform, XEN_ARG_5, proc, "a procedure");
+ if (mus_is_xen(proc)) /* happens a lot in snd-test.scm, so add a check */
+ Xen_wrong_type_arg_error(S_add_transform, 5, proc, "a procedure");
#endif
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, S_add_transform, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(xlabel), xlabel, XEN_ARG_2, S_add_transform, "a string");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(lo), lo, XEN_ARG_3, S_add_transform, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(hi), hi, XEN_ARG_4, S_add_transform, "a number");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(proc), proc, XEN_ARG_5, S_add_transform, "a procedure");
+ Xen_check_type(Xen_is_string(name), name, 1, S_add_transform, "a string");
+ Xen_check_type(Xen_is_string(xlabel), xlabel, 2, S_add_transform, "a string");
+ Xen_check_type(Xen_is_number(lo), lo, 3, S_add_transform, "a number");
+ Xen_check_type(Xen_is_number(hi), hi, 4, S_add_transform, "a number");
+ Xen_check_type(Xen_is_procedure(proc), proc, 5, S_add_transform, "a procedure");
- return(C_INT_TO_XEN_TRANSFORM(add_transform(XEN_TO_C_STRING(name),
- XEN_TO_C_STRING(xlabel),
- XEN_TO_C_DOUBLE(lo),
- XEN_TO_C_DOUBLE(hi),
+ return(C_int_to_Xen_transform(add_transform(Xen_string_to_C_string(name),
+ Xen_string_to_C_string(xlabel),
+ Xen_real_to_C_double(lo),
+ Xen_real_to_C_double(hi),
proc)));
}
@@ -2353,17 +2376,17 @@ static void unset_deleted_transform_type(chan_info *cp)
}
-static XEN g_delete_transform(XEN type)
+static Xen g_delete_transform(Xen type)
{
int typ;
added_transform *af;
#define H_delete_transform "(" S_delete_transform " obj) deletes the specified transform if it was created via " S_add_transform "."
- XEN_ASSERT_TYPE(XEN_TRANSFORM_P(type), type, XEN_ONLY_ARG, S_delete_transform, "a transform");
+ Xen_check_type(xen_is_transform(type), type, 1, S_delete_transform, "a transform");
- typ = XEN_TRANSFORM_TO_C_INT(type);
- if ((typ < NUM_BUILTIN_TRANSFORM_TYPES) || (!transform_p(typ)))
- XEN_OUT_OF_RANGE_ERROR(S_delete_transform, XEN_ONLY_ARG, type, "an integer (an active added transform)");
+ typ = Xen_transform_to_C_int(type);
+ if ((typ < NUM_BUILTIN_TRANSFORM_TYPES) || (!is_transform(typ)))
+ Xen_out_of_range_error(S_delete_transform, 1, type, "an integer (an active added transform)");
af = type_to_transform(typ);
if (af)
@@ -2372,50 +2395,39 @@ static XEN g_delete_transform(XEN type)
free(af->xlabel);
free(af->name);
snd_unprotect_at(af->gc_loc);
- af->proc = XEN_FALSE;
+ af->proc = Xen_false;
free(af);
/* now make sure nobody expects to use that transform */
if (transform_type(ss) == typ) set_transform_type(DEFAULT_TRANSFORM_TYPE);
deleted_type = typ;
for_each_chan(unset_deleted_transform_type);
- return(XEN_TRUE);
+ return(Xen_true);
}
- return(XEN_FALSE);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_2(g_transform_frames_w, g_transform_frames)
-XEN_ARGIFY_4(g_transform_sample_w, g_transform_sample)
-XEN_ARGIFY_3(g_transform_to_vct_w, g_transform_to_vct)
-XEN_NARGIFY_5(g_add_transform_w, g_add_transform)
-XEN_ARGIFY_3(g_snd_transform_w, g_snd_transform)
-XEN_NARGIFY_1(g_transform_p_w, g_transform_p)
-XEN_NARGIFY_1(g_delete_transform_w, g_delete_transform)
-XEN_NARGIFY_0(g_log_freq_start_w, g_log_freq_start)
-XEN_NARGIFY_1(g_set_log_freq_start_w, g_set_log_freq_start)
-XEN_NARGIFY_0(g_show_selection_transform_w, g_show_selection_transform)
-XEN_NARGIFY_1(g_set_show_selection_transform_w, g_set_show_selection_transform)
-XEN_NARGIFY_1(g_integer_to_transform_w, g_integer_to_transform)
-XEN_NARGIFY_1(g_transform_to_integer_w, g_transform_to_integer)
-#else
-#define g_transform_frames_w g_transform_frames
-#define g_transform_sample_w g_transform_sample
-#define g_transform_to_vct_w g_transform_to_vct
-#define g_add_transform_w g_add_transform
-#define g_snd_transform_w g_snd_transform
-#define g_transform_p_w g_transform_p
-#define g_delete_transform_w g_delete_transform
-#define g_log_freq_start_w g_log_freq_start
-#define g_set_log_freq_start_w g_set_log_freq_start
-#define g_show_selection_transform_w g_show_selection_transform
-#define g_set_show_selection_transform_w g_set_show_selection_transform
-#define g_integer_to_transform_w g_integer_to_transform
-#define g_transform_to_integer_w g_transform_to_integer
+ return(Xen_false);
+}
+
+
+Xen_wrap_2_optional_args(g_transform_framples_w, g_transform_framples)
+Xen_wrap_4_optional_args(g_transform_sample_w, g_transform_sample)
+Xen_wrap_3_optional_args(g_transform_to_vct_w, g_transform_to_vct)
+Xen_wrap_5_args(g_add_transform_w, g_add_transform)
+Xen_wrap_3_optional_args(g_snd_transform_w, g_snd_transform)
+Xen_wrap_1_arg(g_is_transform_w, g_is_transform)
+Xen_wrap_1_arg(g_delete_transform_w, g_delete_transform)
+Xen_wrap_no_args(g_log_freq_start_w, g_log_freq_start)
+Xen_wrap_1_arg(g_set_log_freq_start_w, g_set_log_freq_start)
+Xen_wrap_no_args(g_show_selection_transform_w, g_show_selection_transform)
+Xen_wrap_1_arg(g_set_show_selection_transform_w, g_set_show_selection_transform)
+Xen_wrap_1_arg(g_integer_to_transform_w, g_integer_to_transform)
+Xen_wrap_1_arg(g_transform_to_integer_w, g_transform_to_integer)
+
+#if HAVE_SCHEME
+static s7_pointer acc_log_freq_start(s7_scheme *sc, s7_pointer args) {return(g_set_log_freq_start(s7_cadr(args)));}
+static s7_pointer acc_show_selection_transform(s7_scheme *sc, s7_pointer args) {return(g_set_show_selection_transform(s7_cadr(args)));}
#endif
#if (!HAVE_SCHEME)
-static XEN transform_temp[6]; /* static for Ruby's sake */
+static Xen transform_temp[6]; /* static for Ruby's sake */
#endif
void g_init_fft(void)
@@ -2426,9 +2438,9 @@ an integer, it is used as the starting point of the transform. The following \
somewhat brute-force code shows a way to have the transform reflect the position \
of a moving mark:\n\
(define transform-position #f)\n\
- (add-hook! " S_before_transform_hook "\n\
+ (hook-push " S_before_transform_hook "\n\
(lambda (snd chn) transform-position))\n\
- (add-hook! " S_mark_drag_hook "\n\
+ (hook-push " S_mark_drag_hook "\n\
(lambda (id)\n\
(set! transform-position (" S_mark_sample " id))\n\
(" S_update_transform_graph ")))"
@@ -2436,7 +2448,17 @@ of a moving mark:\n\
#if HAVE_RUBY
#define H_before_transform_hook S_before_transform_hook " (snd chn): called just before a transform is calculated. If it returns \
-an integer, it is used as the starting point of the transform."
+an integer, it is used as the starting point of the transform. The following \
+somewhat brute-force code shows a way to have the transform reflect the position \
+of a moving mark:\n\
+$transform_position = false\n\
+$before_transform_hook.add_hook!(\"snd-fft\") |snd, chn|\n\
+ $transform_position\n\
+end\n\
+$mark_drag_hook.add_hook!(\"snd-fft\") |id|\n\
+ $transform_position = " S_mark_sample "(id)\n\
+ " S_update_transform_graph "\n\
+end"
#endif
#if HAVE_FORTH
@@ -2454,22 +2476,23 @@ of a moving mark:\n\
init_xen_transform();
- before_transform_hook = XEN_DEFINE_HOOK(S_before_transform_hook, 2, H_before_transform_hook); /* args = snd chn */
+ before_transform_hook = Xen_define_hook(S_before_transform_hook, "(make-hook 'snd 'chn)", 2, H_before_transform_hook);
#if HAVE_SCHEME
- s7_define_constant(s7, S_fourier_transform, C_INT_TO_XEN_TRANSFORM(FOURIER));
- s7_define_constant(s7, S_wavelet_transform, C_INT_TO_XEN_TRANSFORM(WAVELET));
- s7_define_constant(s7, S_haar_transform, C_INT_TO_XEN_TRANSFORM(HAAR));
- s7_define_constant(s7, S_cepstrum, C_INT_TO_XEN_TRANSFORM(CEPSTRUM));
- s7_define_constant(s7, S_walsh_transform, C_INT_TO_XEN_TRANSFORM(WALSH));
- s7_define_constant(s7, S_autocorrelation, C_INT_TO_XEN_TRANSFORM(AUTOCORRELATION));
+ s7_define_constant(s7, S_fourier_transform, C_int_to_Xen_transform(FOURIER));
+ s7_define_constant(s7, S_wavelet_transform, C_int_to_Xen_transform(WAVELET));
+ s7_define_constant(s7, S_haar_transform, C_int_to_Xen_transform(HAAR));
+ s7_define_constant(s7, S_cepstrum, C_int_to_Xen_transform(CEPSTRUM));
+ s7_define_constant(s7, S_walsh_transform, C_int_to_Xen_transform(WALSH));
+ s7_define_constant(s7, S_autocorrelation, C_int_to_Xen_transform(AUTOCORRELATION));
+ /* *transform-type* is #<transform Fourier> by default */
#else
- XEN_DEFINE_VARIABLE(S_fourier_transform, transform_temp[0], C_INT_TO_XEN_TRANSFORM(FOURIER));
- XEN_DEFINE_VARIABLE(S_wavelet_transform, transform_temp[1], C_INT_TO_XEN_TRANSFORM(WAVELET));
- XEN_DEFINE_VARIABLE(S_haar_transform, transform_temp[2], C_INT_TO_XEN_TRANSFORM(HAAR));
- XEN_DEFINE_VARIABLE(S_cepstrum, transform_temp[3], C_INT_TO_XEN_TRANSFORM(CEPSTRUM));
- XEN_DEFINE_VARIABLE(S_walsh_transform, transform_temp[4], C_INT_TO_XEN_TRANSFORM(WALSH));
- XEN_DEFINE_VARIABLE(S_autocorrelation, transform_temp[5], C_INT_TO_XEN_TRANSFORM(AUTOCORRELATION));
+ Xen_define_variable(S_fourier_transform, transform_temp[0], C_int_to_Xen_transform(FOURIER));
+ Xen_define_variable(S_wavelet_transform, transform_temp[1], C_int_to_Xen_transform(WAVELET));
+ Xen_define_variable(S_haar_transform, transform_temp[2], C_int_to_Xen_transform(HAAR));
+ Xen_define_variable(S_cepstrum, transform_temp[3], C_int_to_Xen_transform(CEPSTRUM));
+ Xen_define_variable(S_walsh_transform, transform_temp[4], C_int_to_Xen_transform(WALSH));
+ Xen_define_variable(S_autocorrelation, transform_temp[5], C_int_to_Xen_transform(AUTOCORRELATION));
#endif
#define H_dont_normalize "The value for " S_transform_normalization " that causes the transform to display raw data"
@@ -2477,27 +2500,35 @@ of a moving mark:\n\
#define H_normalize_by_sound "The value for " S_transform_normalization " that causes the transform to be normalized across a sound's channels"
#define H_normalize_globally "The value for " S_transform_normalization " that causes the transform to be normalized across all sounds"
- XEN_DEFINE_CONSTANT(S_dont_normalize, DONT_NORMALIZE, H_dont_normalize);
- XEN_DEFINE_CONSTANT(S_normalize_by_channel, NORMALIZE_BY_CHANNEL, H_normalize_by_channel);
- XEN_DEFINE_CONSTANT(S_normalize_by_sound, NORMALIZE_BY_SOUND, H_normalize_by_sound);
- XEN_DEFINE_CONSTANT(S_normalize_globally, NORMALIZE_GLOBALLY, H_normalize_globally);
+ Xen_define_constant(S_dont_normalize, DONT_NORMALIZE, H_dont_normalize);
+ Xen_define_constant(S_normalize_by_channel, NORMALIZE_BY_CHANNEL, H_normalize_by_channel);
+ Xen_define_constant(S_normalize_by_sound, NORMALIZE_BY_SOUND, H_normalize_by_sound);
+ Xen_define_constant(S_normalize_globally, NORMALIZE_GLOBALLY, H_normalize_globally);
+
+ Xen_define_safe_procedure(S_transform_framples, g_transform_framples_w, 0, 2, 0, H_transform_framples);
+ Xen_define_safe_procedure(S_transform_sample, g_transform_sample_w, 0, 4, 0, H_transform_sample);
+ Xen_define_safe_procedure(S_transform_to_vct, g_transform_to_vct_w, 0, 3, 0, H_transform_to_vct);
+ Xen_define_safe_procedure(S_add_transform, g_add_transform_w, 5, 0, 0, H_add_transform);
+ Xen_define_safe_procedure(S_is_transform, g_is_transform_w, 1, 0, 0, H_is_transform);
+ Xen_define_safe_procedure(S_delete_transform, g_delete_transform_w, 1, 0, 0, H_delete_transform);
+ Xen_define_safe_procedure("snd-transform", g_snd_transform_w, 2, 1, 0, H_snd_transform);
- XEN_DEFINE_PROCEDURE(S_transform_frames, g_transform_frames_w, 0, 2, 0, H_transform_frames);
- XEN_DEFINE_PROCEDURE(S_transform_sample, g_transform_sample_w, 0, 4, 0, H_transform_sample);
- XEN_DEFINE_PROCEDURE(S_transform_to_vct, g_transform_to_vct_w, 0, 3, 0, H_transform_to_vct);
- XEN_DEFINE_PROCEDURE(S_add_transform, g_add_transform_w, 5, 0, 0, H_add_transform);
- XEN_DEFINE_PROCEDURE(S_transform_p, g_transform_p_w, 1, 0, 0, H_transform_p);
- XEN_DEFINE_PROCEDURE(S_delete_transform, g_delete_transform_w, 1, 0, 0, H_delete_transform);
- XEN_DEFINE_PROCEDURE("snd-transform", g_snd_transform_w, 2, 1, 0, H_snd_transform);
+ Xen_define_dilambda(S_log_freq_start, g_log_freq_start_w, H_log_freq_start,
+ S_set S_log_freq_start, g_set_log_freq_start_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_log_freq_start, g_log_freq_start_w, H_log_freq_start,
- S_setB S_log_freq_start, g_set_log_freq_start_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_show_selection_transform, g_show_selection_transform_w, H_show_selection_transform,
+ S_set S_show_selection_transform, g_set_show_selection_transform_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_show_selection_transform, g_show_selection_transform_w, H_show_selection_transform,
- S_setB S_show_selection_transform, g_set_show_selection_transform_w, 0, 0, 1, 0);
+ Xen_define_safe_procedure(S_integer_to_transform, g_integer_to_transform_w, 1, 0, 0, H_integer_to_transform);
+ Xen_define_safe_procedure(S_transform_to_integer, g_transform_to_integer_w, 1, 0, 0, H_transform_to_integer);
- XEN_DEFINE_PROCEDURE(S_integer_to_transform, g_integer_to_transform_w, 1, 0, 0, H_integer_to_transform);
- XEN_DEFINE_PROCEDURE(S_transform_to_integer, g_transform_to_integer_w, 1, 0, 0, H_transform_to_integer);
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->log_freq_start_symbol, s7_make_function(s7, "[acc-" S_log_freq_start "]", acc_log_freq_start, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_selection_transform_symbol, s7_make_function(s7, "[acc-" S_show_selection_transform "]", acc_show_selection_transform, 2, 0, false, "accessor"));
+
+ s7_symbol_set_documentation(s7, ss->log_freq_start_symbol, "*log-freq-start*: log freq base (25.0)");
+ s7_symbol_set_documentation(s7, ss->show_selection_transform_symbol, "*show-selection-transform*: #t if transform display reflects selection, not time-domain window");
+#endif
}
/* display by wavelength is not so useful in the context of sound because
diff --git a/snd-file.c b/snd-file.c
index b8c19fe..6cca733 100644
--- a/snd-file.c
+++ b/snd-file.c
@@ -2,49 +2,21 @@
#include "snd-file.h"
#include "sndlib-strings.h"
-#if HAVE_DIRENT_H
- #include <dirent.h>
-#endif
-
-
/* -------------------------------- basic file attributes -------------------------------- */
-#if USE_STATVFS
- #include <sys/statvfs.h>
-#endif
+#ifdef _MSC_VER
+ mus_long_t disk_kspace(const char *filename) {return(1234567);}
+#else
-#if __bsdi__ || HAVE_SYS_PARAM_H
+ #include <sys/statvfs.h>
#include <sys/param.h>
-#endif
+ #include <dirent.h>
-#if (HAVE_SYS_MOUNT_H && HAVE_OSX) || __bsdi__ || HAVE_NETBSD
+#if __bsdi__ || __NetBSD__
#include <sys/mount.h>
#endif
-
-#if (!USE_STATVFS)
-
-#if USE_STATFS
-mus_long_t disk_kspace(const char *filename)
-{
- struct statfs buf;
- int err;
- err = statfs(filename, &buf);
- if (err == 0)
- {
- if (buf.f_bsize == 1024)
- return(buf.f_bavail);
- return((mus_long_t)(buf.f_bsize * ((double)(buf.f_bavail) / 1024.0)));
- }
- return(err);
-}
-#else
-mus_long_t disk_kspace(const char *filename) {return(1234567);}
-#endif
-
-#else
-
mus_long_t disk_kspace(const char *filename)
{
#if HAVE_SUN
@@ -52,7 +24,7 @@ mus_long_t disk_kspace(const char *filename)
#else
struct statvfs buf;
#endif
- mus_long_t err = -1;
+ mus_long_t err;
err = statvfs(filename, &buf);
if (err == 0)
{
@@ -65,14 +37,14 @@ mus_long_t disk_kspace(const char *filename)
#endif
-bool link_p(const char *filename)
+bool is_link_file(const char *filename)
{
#if __MINGW32__
return(false);
#else
struct stat statbuf;
-#if HAVE_LSTAT
- return((lstat(filename, &statbuf) >= 0) &&
+#ifndef _MSC_VER
+ return((stat(filename, &statbuf) >= 0) &&
(S_ISLNK(statbuf.st_mode)));
#else
return((stat(filename, &statbuf) == 0) &&
@@ -82,13 +54,12 @@ bool link_p(const char *filename)
}
-bool directory_p(const char *filename)
+bool is_directory(const char *filename)
{
struct stat statbuf;
-#if HAVE_LSTAT
- return((lstat(filename, &statbuf) >= 0) &&
+#ifndef _MSC_VER
+ return((stat(filename, &statbuf) >= 0) &&
(S_ISDIR(statbuf.st_mode)));
- return(false);
#else
return((stat(filename, &statbuf) == 0) &&
(S_ISDIR(statbuf.st_mode)));
@@ -96,73 +67,23 @@ bool directory_p(const char *filename)
}
-static bool empty_file_p(const char *filename)
-{
-#if HAVE_LSTAT
- struct stat statbuf;
- if (lstat(filename, &statbuf) >= 0)
- return(statbuf.st_size == (mus_long_t)0);
-#endif
- return(false);
-}
-
-
-static mus_long_t file_bytes(const char *filename)
-{
-#if HAVE_LSTAT
- struct stat statbuf;
- if (lstat(filename, &statbuf) >= 0)
- return(statbuf.st_size);
- return(0);
-#else
- int chan;
- mus_long_t bytes;
- chan = mus_file_open_read(filename);
- if (chan == -1) return(0);
- bytes = lseek(chan, 0L, SEEK_END);
- snd_close(chan, filename);
- return(bytes);
-#endif
-}
-
-
time_t file_write_date(const char *filename)
{
struct stat statbuf;
int err;
+ if (!filename) return((time_t)0);
err = stat(filename, &statbuf);
if (err < 0) return((time_t)err);
return((time_t)(statbuf.st_mtime));
}
-bool directory_exists(char *name)
-{
- char temp;
- bool result;
- int i, len, last_slash = -1;
- len = strlen(name);
- for (i = 0; i < len; i++)
- if (name[i] == '/')
- last_slash = i;
- if (last_slash <= 0)
- return(true);
- if (last_slash >= len - 1) /* can't be > */
- return(directory_p(name));
- temp = name[last_slash + 1];
- name[last_slash + 1] = '\0';
- result = directory_p(name);
- name[last_slash + 1] = temp;
- return(result);
-}
-
-
-const char *short_data_format_name(int sndlib_format, const char *filename)
+const char *short_sample_type_name(mus_sample_t sndlib_sample_type, const char *filename)
{
- if (mus_data_format_p(sndlib_format))
- return(mus_data_format_short_name(sndlib_format));
- else return(mus_header_original_format_name(mus_sound_original_format(filename),
- mus_sound_header_type(filename)));
+ if (mus_is_sample_type(sndlib_sample_type))
+ return(mus_sample_type_short_name(sndlib_sample_type));
+ else return(mus_header_original_sample_type_name(mus_sound_original_sample_type(filename),
+ mus_sound_header_type(filename)));
}
@@ -241,218 +162,98 @@ char **recent_files(void)
}
+/* -------------------------------- file filters -------------------------------- */
-/* -------------------------------- file list positioning -------------------------------- */
-
-static dirpos_info *make_dirpos_info(const char *dir, position_t pos)
-{
- dirpos_info *dp;
- dp = (dirpos_info *)calloc(1, sizeof(dirpos_info));
- dp->directory_name = mus_strdup(dir);
- dp->list_top = pos;
- return(dp);
-}
-
-
-dirpos_list *make_dirpos_list(void)
-{
- dirpos_list *dl;
- dl = (dirpos_list *)calloc(1, sizeof(dirpos_list));
- dl->size = 8;
- dl->top = 0;
- dl->dirs = (dirpos_info **)calloc(dl->size, sizeof(dirpos_info *));
- return(dl);
-}
-
+#define INITIAL_FILE_FILTERS_SIZE 4
-void dirpos_update(dirpos_list *dl, const char *dir, position_t pos)
+Xen g_expand_vector(Xen vector, int new_size)
{
- int i;
- if (!dl) return;
- for (i = 0; i < dl->top; i++)
- {
- if ((dl->dirs[i]) &&
- (strcmp(dir, dl->dirs[i]->directory_name) == 0))
- {
- dirpos_info *dp;
- dp = dl->dirs[i];
- dp->list_top = pos;
- return;
- }
- }
- if (dl->top >= dl->size)
+ int i, len;
+ Xen new_vect;
+ len = Xen_vector_length(vector);
+ new_vect = Xen_make_vector(new_size, Xen_false);
+ Xen_GC_protect(new_vect);
+ for (i = 0; i < len; i++)
{
- int old_size;
- old_size = dl->size;
- dl->size += 8;
- dl->dirs = (dirpos_info **)realloc(dl->dirs, dl->size * sizeof(dirpos_info *));
- for (i = old_size; i < dl->size; i++) dl->dirs[i] = NULL;
+ Xen_vector_set(new_vect, i, Xen_vector_ref(vector, i));
+ Xen_vector_set(vector, i, Xen_false);
}
- dl->dirs[dl->top++] = make_dirpos_info(dir, pos);
-}
-
-
-position_t dirpos_list_top(dirpos_list *dl, const char *dirname)
-{
- int i;
- if (dl)
- for (i = 0; i < dl->top; i++)
- if ((dl->dirs[i]) &&
- (strcmp(dirname, dl->dirs[i]->directory_name) == 0))
- return(dl->dirs[i]->list_top);
- return(POSITION_UNKNOWN);
+#if HAVE_RUBY || HAVE_FORTH
+ Xen_GC_unprotect(vector);
+#endif
+ return(new_vect);
}
-/* -------------------------------- sorters -------------------------------- */
-
-static sort_info *free_sort_info(sort_info *ptr)
+static bool file_filter_ok(Xen name, Xen proc, const char *caller)
{
- if (ptr)
+ char *errmsg;
+ Xen_check_type(Xen_is_string(name), name, 1, caller, "a string");
+ Xen_check_type(Xen_is_procedure(proc), proc, 2, caller, "a procedure of 1 arg (filename)");
+ errmsg = procedure_ok(proc, 1, caller, "file filter", 2);
+ if (errmsg)
{
- if (ptr->filename) free(ptr->filename);
- if (ptr->full_filename) free(ptr->full_filename);
- free(ptr);
+ Xen errstr;
+ errstr = C_string_to_Xen_string(errmsg);
+ free(errmsg);
+ snd_bad_arity_error(caller, errstr, proc);
+ return(false);
}
- return(NULL);
-}
-
-
-static sort_info *make_sort_info(const char *filename, const char *full_filename)
-{
- sort_info *ptr;
- ptr = (sort_info *)calloc(1, sizeof(sort_info));
- ptr->filename = mus_strdup(filename); /* not mus_strdup -> these are glomming up memlog */
- ptr->full_filename = mus_strdup(full_filename);
- return(ptr);
-}
-
-
-/* sort files list by name (aphabetical), or some number (date written, size), or by xen proc */
-
-static int sort_a_to_z(const void *a, const void *b)
-{
- sort_info *d1 = *(sort_info **)a;
- sort_info *d2 = *(sort_info **)b;
- return(strcmp(d1->filename, d2->filename));
+ return(true);
}
-static int sort_z_to_a(const void *a, const void *b)
+static Xen g_add_file_filter(Xen name, Xen proc)
{
- return(-sort_a_to_z(a, b));
-}
-
+ #define H_add_file_filter "(" S_add_file_filter " name proc) -- add proc with identifier name to file filter list. \n\
+ (add-file-filter \"just .snd\" \n\
+ (lambda (name) \n\
+ (string=? \".snd\" (substring name (- (length name) 4)))))\n\
+ restricts the displayed files to .snd files."
-static int sort_small_to_big(const void *a, const void *b)
-{
- sort_info *d1 = *(sort_info **)a;
- sort_info *d2 = *(sort_info **)b;
- if (d1->samps > d2->samps)
- return(1);
- else
+ if (file_filter_ok(name, proc, S_add_file_filter))
{
- if (d1->samps == d2->samps)
- return(0);
- else return(-1);
+ int i, len;
+ len = ss->file_filters_size;
+ for (i = 0; i < len; i++)
+ {
+ if (Xen_is_false(Xen_vector_ref(ss->file_filters, i)))
+ {
+ Xen_vector_set(ss->file_filters, i, Xen_list_2(name, proc));
+ return(C_int_to_Xen_integer(i));
+ }
+ }
+ ss->file_filters_size = len * 2;
+ ss->file_filters = g_expand_vector(ss->file_filters, ss->file_filters_size);
+ Xen_vector_set(ss->file_filters, len, Xen_list_2(name, proc));
+ return(C_int_to_Xen_integer(len));
}
+ return(Xen_false);
}
-static int sort_big_to_small(const void *a, const void *b)
+static Xen g_delete_file_filter(Xen index)
{
- return(-sort_small_to_big(a, b));
-}
-
-
-static int sort_new_to_old(const void *a, const void *b)
-{
- sort_info *d1 = *(sort_info **)a;
- sort_info *d2 = *(sort_info **)b;
- if (d1->time < d2->time)
- return(1);
- else
+ #define H_delete_file_filter "(" S_delete_file_filter " index) -- delete proc with identifier index from file filter list"
+ int pos;
+ Xen_check_type(Xen_is_integer(index), index, 1, S_delete_file_filter, "a file-filter function index");
+ pos = Xen_integer_to_C_int(index);
+ if ((pos >= 0) &&
+ (pos < ss->file_filters_size))
{
- if (d1->time == d2->time)
- return(0);
- else return(-1);
+#if USE_GTK && (!HAVE_RUBY)
+ /* in the gtk case, the function might be in use anyway, so we need to protect it */
+ if (Xen_is_list(Xen_vector_ref(ss->file_filters, pos)))
+ Xen_GC_protect(Xen_cadr(Xen_vector_ref(ss->file_filters, pos)));
+ /* in ruby Xen_GC_protect takes the address of the arg, so we need a variable or something */
+#endif
+ Xen_vector_set(ss->file_filters, pos, Xen_false);
}
+ return(index);
}
-static int sort_old_to_new(const void *a, const void *b)
-{
- return(-sort_new_to_old(a, b));
-}
-
-
-static XEN sorter_func;
-
-static int sort_xen(const void *a, const void *b)
-{
- /* sorter function gets two names, returns -1, 0, or 1 just like the other comparators */
- sort_info *d1 = *(sort_info **)a;
- sort_info *d2 = *(sort_info **)b;
- return(XEN_TO_C_INT(XEN_CALL_2(sorter_func, C_TO_XEN_STRING(d1->full_filename), C_TO_XEN_STRING(d2->full_filename), "sort func")));
-}
-
-
-void snd_sort(int sorter, sort_info **data, int len)
-{
- int i, sorter_pos;
- switch (sorter)
- {
- case SORT_A_TO_Z:
- qsort((void *)data, len, sizeof(sort_info *), sort_a_to_z);
- break;
-
- case SORT_Z_TO_A:
- qsort((void *)data, len, sizeof(sort_info *), sort_z_to_a);
- break;
-
- case SORT_NEW_TO_OLD:
- for (i = 0; i < len; i++)
- data[i]->time = file_write_date(data[i]->full_filename);
- qsort((void *)data, len, sizeof(sort_info *), sort_new_to_old);
- break;
-
- case SORT_OLD_TO_NEW:
- for (i = 0; i < len; i++)
- data[i]->time = file_write_date(data[i]->full_filename);
- qsort((void *)data, len, sizeof(sort_info *), sort_old_to_new);
- break;
-
- case SORT_SMALL_TO_BIG:
- for (i = 0; i < len; i++)
- data[i]->samps = file_bytes(data[i]->full_filename);
- qsort((void *)data, len, sizeof(sort_info *), sort_small_to_big);
- break;
-
- case SORT_BIG_TO_SMALL:
- for (i = 0; i < len; i++)
- data[i]->samps = file_bytes(data[i]->full_filename);
- qsort((void *)data, len, sizeof(sort_info *), sort_big_to_small);
- break;
- default:
- case SORT_XEN:
- /* sorter is SORT_XEN + index into file_sorters list */
- /* that list is a vector of pairs (name proc) */
- sorter_pos = sorter - SORT_XEN;
- if ((sorter_pos >= 0) &&
- (sorter_pos < ss->file_sorters_size))
- {
- if (XEN_LIST_P(XEN_VECTOR_REF(ss->file_sorters, sorter_pos)))
- {
- sorter_func = XEN_CADR(XEN_VECTOR_REF(ss->file_sorters, sorter_pos));
- qsort((void *)data, len, sizeof(sort_info *), sort_xen);
- return;
- }
- }
- snd_warning("no such file-sorter (%d)", sorter_pos);
- break;
- }
-}
/* -------------------------------- directory readers -------------------------------- */
@@ -469,6 +270,27 @@ static dir_info *make_dir_info(const char *name)
}
+static sort_info *make_sort_info(const char *filename, const char *full_filename)
+{
+ sort_info *ptr;
+ ptr = (sort_info *)calloc(1, sizeof(sort_info));
+ ptr->filename = mus_strdup(filename); /* not mus_strdup -> these are glomming up memlog */
+ ptr->full_filename = mus_strdup(full_filename);
+ return(ptr);
+}
+
+
+static sort_info *free_sort_info(sort_info *ptr)
+{
+ if (ptr)
+ {
+ if (ptr->filename) free(ptr->filename);
+ if (ptr->full_filename) free(ptr->full_filename);
+ free(ptr);
+ }
+ return(NULL);
+}
+
dir_info *free_dir_info(dir_info *dp)
{
if (dp->dir_name) free(dp->dir_name);
@@ -505,7 +327,7 @@ static void load_dir(DIR *dpos, dir_info *dp, bool (*filter)(const char *filenam
char *fullname;
int fullname_start = 0, path_max = 0;
-#if HAVE_PATHCONF
+#ifndef _MSC_VER
path_max = pathconf("/", _PC_PATH_MAX);
#endif
if (path_max < 1024)
@@ -518,7 +340,7 @@ static void load_dir(DIR *dpos, dir_info *dp, bool (*filter)(const char *filenam
}
fullname = (char *)calloc(path_max, sizeof(char));
- strcpy(fullname, dp->dir_name);
+ strcopy(fullname, dp->dir_name, path_max);
fullname_start = strlen(dp->dir_name);
while ((dirp = readdir(dpos)) != NULL)
if (dirp->d_name[0] != '.')
@@ -532,37 +354,15 @@ static void load_dir(DIR *dpos, dir_info *dp, bool (*filter)(const char *filenam
}
-static bool not_directory_p(const char *name)
+static bool not_is_directory(const char *name)
{
- return(!(directory_p(name)));
+ return(!(is_directory(name)));
}
dir_info *find_files_in_dir(const char *name)
{
-#if (!HAVE_OPENDIR)
- return(NULL);
-#else
- DIR *dpos;
- dir_info *dp = NULL;
- dpos = opendir(name);
- if (dpos)
- {
- dp = make_dir_info(name);
- load_dir(dpos, dp, not_directory_p);
- if (closedir(dpos) != 0)
- snd_error("closedir %s failed (%s)!",
- name, snd_io_strerror());
- }
- return(dp);
-#endif
-}
-
-
-#if USE_GTK
-dir_info *find_directories_in_dir(const char *name)
-{
-#if (!HAVE_OPENDIR)
+#ifdef _MSC_VER
return(NULL);
#else
DIR *dpos;
@@ -571,18 +371,7 @@ dir_info *find_directories_in_dir(const char *name)
if (dpos)
{
dp = make_dir_info(name);
- if (strcmp(name, "/") != 0)
- {
- char *fullname;
- int len;
- len = mus_strlen(name) + mus_strlen(PARENT_DIRECTORY) + 2; /* PARENT_DIRECTORY = ".." (snd-file.h) */
- fullname = (char *)calloc(len, sizeof(char));
- strcpy(fullname, name);
- strcat(fullname, PARENT_DIRECTORY);
- add_filename_to_dir_info(dp, PARENT_DIRECTORY, fullname); /* always back pointer */
- free(fullname);
- }
- load_dir(dpos, dp, directory_p);
+ load_dir(dpos, dp, not_is_directory);
if (closedir(dpos) != 0)
snd_error("closedir %s failed (%s)!",
name, snd_io_strerror());
@@ -590,29 +379,28 @@ dir_info *find_directories_in_dir(const char *name)
return(dp);
#endif
}
-#endif
-static XEN filter_func;
+static Xen filter_func;
static bool filter_xen(const char *name)
{
- return(XEN_TO_C_BOOLEAN(XEN_CALL_1(filter_func, C_TO_XEN_STRING(name), "filter func")));
+ return(Xen_boolean_to_C_bool(Xen_call_with_1_arg(filter_func, C_string_to_Xen_string(name), "filter func")));
}
dir_info *find_filtered_files_in_dir(const char *name, int filter_choice)
{
- bool (*filter)(const char *filename);
-#if (!HAVE_OPENDIR)
+#ifdef _MSC_VER
return(NULL);
#else
DIR *dpos;
dir_info *dp = NULL;
if ((dpos = opendir(name)) != NULL)
{
+ bool (*filter)(const char *filename);
if (filter_choice == JUST_SOUNDS_FILTER)
- filter = sound_file_p;
+ filter = is_sound_file;
else
{
int filter_pos;
@@ -620,10 +408,11 @@ dir_info *find_filtered_files_in_dir(const char *name, int filter_choice)
filter_pos = filter_choice - 2;
if ((filter_pos >= 0) &&
(filter_pos < ss->file_filters_size))
- filter_func = XEN_CADR(XEN_VECTOR_REF(ss->file_filters, filter_pos));
+ filter_func = Xen_cadr(Xen_vector_ref(ss->file_filters, filter_pos));
else
{
snd_warning("no such file-filter (%d)", filter_pos);
+ closedir(dpos);
return(find_files_in_dir(name));
}
}
@@ -649,7 +438,7 @@ dir_info *find_filtered_files_in_dir_with_pattern(const char *name, int filter_c
full_dir = find_filtered_files_in_dir(name, filter_choice);
else full_dir = find_files_in_dir(name);
pattern_dir = find_files_from_pattern(full_dir, pattern);
- full_dir = free_dir_info(full_dir);
+ free_dir_info(full_dir);
return(pattern_dir);
}
@@ -661,6 +450,9 @@ static int sound_file_extensions_size = 0;
static int sound_file_extensions_end = 0;
static int default_sound_file_extensions = 0;
+const char **get_sound_file_extensions(void) {return((const char **)sound_file_extensions);}
+int sound_file_extensions_length(void) {return(sound_file_extensions_end);}
+
static void add_sound_file_extension(const char *ext)
{
int i;
@@ -714,10 +506,7 @@ void init_sound_file_extensions(void)
#if HAVE_MPEG
add_sound_file_extension("mpeg");
-#endif
-
-#if HAVE_SHORTEN
- add_sound_file_extension("shn");
+ add_sound_file_extension("mp3");
#endif
#if HAVE_TTA
@@ -743,7 +532,7 @@ void save_added_sound_file_extensions(FILE *fd)
#endif
#if HAVE_RUBY
- fprintf(fd, "%s(\"%s\")\n", TO_PROC_NAME(S_add_sound_file_extension), sound_file_extensions[i]);
+ fprintf(fd, "%s(\"%s\")\n", to_proc_name(S_add_sound_file_extension), sound_file_extensions[i]);
#endif
#if HAVE_FORTH
@@ -757,7 +546,7 @@ void save_added_sound_file_extensions(FILE *fd)
* fool as an extension check (file might start with the word ".snd" or whatever).
*/
-bool sound_file_p(const char *name)
+bool is_sound_file(const char *name)
{
int i, dot_loc = -1, len;
if (!name) return(false);
@@ -779,38 +568,6 @@ bool sound_file_p(const char *name)
}
-static int local_error = MUS_NO_ERROR;
-static char *local_error_msg = NULL;
-static mus_error_handler_t *old_error_handler;
-
-static void local_error2snd(int type, char *msg)
-{
- local_error = type;
- if (local_error_msg) free(local_error_msg);
- if (msg)
- local_error_msg = mus_strdup(msg);
- else local_error_msg = NULL;
-}
-
-
-bool plausible_sound_file_p(const char *name)
-{
- int err = MUS_NO_ERROR;
- if (empty_file_p(name)) return(false);
- old_error_handler = mus_error_set_handler(local_error2snd);
- err = mus_header_read(name);
- mus_error_set_handler(old_error_handler);
- return((err == MUS_NO_ERROR) &&
- (mus_header_type() != MUS_RAW));
-}
-
-
-static dir_info *find_sound_files_in_dir(const char *name)
-{
- return(find_filtered_files_in_dir(name, JUST_SOUNDS_FILTER));
-}
-
-
static bool names_match(const char *filename, const char *pattern)
{
/* just "*" for wildcards here */
@@ -895,7 +652,7 @@ void reflect_file_change_in_title(void)
}
title_buffer = (char *)calloc(len, sizeof(char));
- mus_snprintf(title_buffer, len, "%s%s",
+ snprintf(title_buffer, len, "%s%s",
ss->startup_title,
((alist->active_sounds > 0) ? ": " : ""));
@@ -925,12 +682,14 @@ void reflect_file_change_in_title(void)
/* -------------------------------- open sound file -------------------------------- */
-static int fallback_srate = 0, fallback_chans = 0, fallback_format = MUS_UNKNOWN;
-static int original_srate = 0, original_chans = 0, original_format = MUS_UNKNOWN;
+static int fallback_srate = 0, fallback_chans = 0;
+static mus_sample_t fallback_sample_type = MUS_UNKNOWN_SAMPLE;
+static int original_srate = 0, original_chans = 0;
+static mus_sample_t original_sample_type = MUS_UNKNOWN_SAMPLE;
void set_fallback_srate(int sr) {fallback_srate = sr;}
void set_fallback_chans(int ch) {fallback_chans = ch;}
-void set_fallback_format(int fr) {fallback_format = fr;}
+void set_fallback_sample_type(mus_sample_t fr) {fallback_sample_type = fr;}
static file_info *make_file_info_1(const char *fullname)
@@ -940,20 +699,26 @@ static file_info *make_file_info_1(const char *fullname)
hdr->name = mus_strdup(fullname);
hdr->type = mus_sound_header_type(fullname);
if (hdr->type == MUS_RAW)
- mus_header_raw_defaults(&(hdr->srate), &(hdr->chans), &(hdr->format));
+ mus_header_raw_defaults(&(hdr->srate), &(hdr->chans), &(hdr->sample_type));
else
{
hdr->srate = mus_sound_srate(fullname);
original_srate = hdr->srate;
hdr->chans = mus_sound_chans(fullname);
original_chans = hdr->chans;
- hdr->format = mus_sound_data_format(fullname);
- original_format = hdr->format;
+ hdr->sample_type = mus_sound_sample_type(fullname);
+ original_sample_type = hdr->sample_type;
}
- if (!(mus_data_format_p(hdr->format))) hdr->format = fallback_format;
+ if (!(mus_is_sample_type(hdr->sample_type))) hdr->sample_type = fallback_sample_type;
if (hdr->srate <= 0) {if (fallback_srate > 0) hdr->srate = fallback_srate; else hdr->srate = 1;}
if (hdr->chans <= 0) {if (fallback_chans > 0) hdr->chans = fallback_chans; else hdr->chans = 1;}
hdr->samples = mus_sound_samples(fullname); /* total samples, not per channel */
+ if ((hdr->samples == 0) &&
+ (hdr->chans > 128))
+ {
+ snd_warning("no samples, but %d chans?", hdr->chans);
+ hdr->chans = 1;
+ }
hdr->data_location = mus_sound_data_location(fullname);
hdr->comment = mus_sound_comment(fullname);
hdr->loops = mus_sound_loop_info(fullname);
@@ -964,20 +729,20 @@ static file_info *make_file_info_1(const char *fullname)
file_info *copy_header(const char *fullname, file_info *ohdr)
{
file_info *hdr;
- int i;
hdr = (file_info *)calloc(1, sizeof(file_info));
hdr->name = mus_strdup(fullname);
hdr->comment = NULL;
- hdr->samples = ohdr->samples;
if (ohdr)
{
+ hdr->samples = ohdr->samples;
hdr->data_location = ohdr->data_location;
hdr->srate = ohdr->srate;
hdr->chans = ohdr->chans;
- hdr->format = ohdr->format;
+ hdr->sample_type = ohdr->sample_type;
hdr->type = ohdr->type;
if (ohdr->loops)
{
+ int i;
hdr->loops = (int *)calloc(MUS_LOOP_INFO_SIZE, sizeof(int));
for (i = 0; i < MUS_LOOP_INFO_SIZE; i++)
hdr->loops[i] = ohdr->loops[i];
@@ -987,7 +752,7 @@ file_info *copy_header(const char *fullname, file_info *ohdr)
}
-static file_info *translate_file(const char *filename, int type)
+static file_info *translate_file(const char *filename, mus_header_t type)
{
file_info *hdr = NULL;
char *newname;
@@ -997,7 +762,7 @@ static file_info *translate_file(const char *filename, int type)
len = strlen(filename);
loops = mus_sound_loop_info(filename); /* allocated anew */
newname = (char *)calloc(len + 5, sizeof(char));
- mus_snprintf(newname, len + 5, "%s.snd", filename);
+ snprintf(newname, len + 5, "%s.snd", filename);
/* too many special cases to do anything smart here -- I'll just tack on '.snd' */
/* before calling the translator we need to check for write-access to the current directory,
@@ -1046,15 +811,14 @@ static file_info *translate_file(const char *filename, int type)
}
-static XEN open_raw_sound_hook;
+static Xen open_raw_sound_hook;
static file_info *open_raw_sound(const char *fullname, read_only_t read_only, bool selected)
{
- XEN res = XEN_FALSE;
+ Xen res = Xen_false;
int res_loc = NOT_A_GC_LOC;
- XEN procs;
- int len, srate, chans, data_format;
- mus_long_t data_location, bytes;
+ int srate, chans;
+ mus_sample_t sample_type;
if (ss->reloading_updated_file != 0)
{
@@ -1062,55 +826,50 @@ static file_info *open_raw_sound(const char *fullname, read_only_t read_only, bo
return(make_file_info_1(fullname));
}
- if (XEN_HOOKED(open_raw_sound_hook))
+ if (Xen_hook_has_list(open_raw_sound_hook))
{
#if HAVE_SCHEME
- int gc_loc;
-#endif
- XEN arg1;
- procs = XEN_HOOK_PROCEDURES(open_raw_sound_hook);
-
- arg1 = C_TO_XEN_STRING(fullname);
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, arg1);
-#endif
-
- while (XEN_NOT_NULL_P(procs))
+ res = s7_call(s7, open_raw_sound_hook, s7_list(s7, 2, C_string_to_Xen_string(fullname), Xen_false)); /* state = #f? */
+#else
+ Xen arg1, procs;
+ procs = Xen_hook_list(open_raw_sound_hook);
+ arg1 = C_string_to_Xen_string(fullname);
+ while (!Xen_is_null(procs))
{
- res = XEN_CALL_2(XEN_CAR(procs),
+ res = Xen_call_with_2_args(Xen_car(procs),
arg1,
res,
S_open_raw_sound_hook);
if (res_loc != NOT_A_GC_LOC) snd_unprotect_at(res_loc);
res_loc = snd_protect(res);
- procs = XEN_CDR(procs);
+ procs = Xen_cdr(procs);
}
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
#endif
}
- if (XEN_LIST_P(res)) /* empty list ok here -> accept all current defaults */
+ if (Xen_is_list(res)) /* empty list ok here -> accept all current defaults */
{
file_info *hdr;
+ mus_long_t data_location, bytes;
+ int len;
- len = XEN_LIST_LENGTH(res);
- mus_header_raw_defaults(&srate, &chans, &data_format);
- if (len > 0) chans = XEN_TO_C_INT(XEN_CAR(res));
- if (len > 1) srate = XEN_TO_C_INT(XEN_CADR(res));
+ len = Xen_list_length(res);
+ mus_header_raw_defaults(&srate, &chans, &sample_type);
+ if (len > 0) chans = Xen_integer_to_C_int(Xen_car(res));
+ if (len > 1) srate = Xen_integer_to_C_int(Xen_cadr(res));
if (len > 2)
{
- XEN df;
- df = XEN_LIST_REF(res, 2);
- data_format = XEN_TO_C_INT(df);
+ Xen df;
+ df = Xen_list_ref(res, 2);
+ sample_type = (mus_sample_t)Xen_integer_to_C_int(df);
}
- if (len > 3) data_location = XEN_TO_C_INT64_T(XEN_LIST_REF(res, 3)); else data_location = 0;
- if (len > 4) bytes = XEN_TO_C_INT64_T(XEN_LIST_REF(res, 4)); else bytes = mus_sound_length(fullname) - data_location;
+ if (len > 3) data_location = Xen_llong_to_C_llong(Xen_list_ref(res, 3)); else data_location = 0;
+ if (len > 4) bytes = Xen_llong_to_C_llong(Xen_list_ref(res, 4)); else bytes = mus_sound_length(fullname) - data_location;
- mus_header_set_raw_defaults(srate, chans, data_format);
+ mus_header_set_raw_defaults(srate, chans, sample_type);
mus_sound_override_header(fullname,
- srate, chans, data_format,
+ srate, chans, sample_type,
MUS_RAW, data_location,
- mus_bytes_to_samples(data_format, bytes));
+ mus_bytes_to_samples(sample_type, bytes));
if (res_loc != NOT_A_GC_LOC) snd_unprotect_at(res_loc);
hdr = (file_info *)calloc(1, sizeof(file_info));
@@ -1118,8 +877,14 @@ static file_info *open_raw_sound(const char *fullname, read_only_t read_only, bo
hdr->type = MUS_RAW;
hdr->srate = mus_sound_srate(fullname);
hdr->chans = mus_sound_chans(fullname);
- hdr->format = mus_sound_data_format(fullname);
+ hdr->sample_type = mus_sound_sample_type(fullname);
hdr->samples = mus_sound_samples(fullname); /* total samples, not per channel */
+ if ((hdr->samples == 0) &&
+ (hdr->chans > 8))
+ {
+ snd_warning("no samples, but %d chans?", hdr->chans);
+ hdr->chans = 1;
+ }
hdr->data_location = mus_sound_data_location(fullname);
hdr->comment = NULL;
return(hdr);
@@ -1127,7 +892,7 @@ static file_info *open_raw_sound(const char *fullname, read_only_t read_only, bo
else
{
bool just_quit = false;
- if (XEN_TRUE_P(res)) just_quit = true;
+ if (Xen_is_true(res)) just_quit = true;
if (res_loc != NOT_A_GC_LOC) snd_unprotect_at(res_loc);
if (just_quit) return(NULL);
@@ -1142,7 +907,7 @@ static file_info *open_raw_sound(const char *fullname, read_only_t read_only, bo
{
char *str;
str = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(str, PRINT_BUFFER_SIZE, "No header found for %s", filename_without_directory(fullname));
+ snprintf(str, PRINT_BUFFER_SIZE, "No header found for %s", filename_without_directory(fullname));
raw_data_dialog_to_file_info(fullname, str, NULL, read_only, selected); /* dialog frees str */
}
#else
@@ -1157,14 +922,14 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
#endif
-static XEN bad_header_hook;
+static Xen bad_header_hook;
static file_info *tackle_bad_header(const char *fullname, read_only_t read_only, bool selected)
{
/* messed up header */
- if ((XEN_HOOKED(bad_header_hook)) &&
- (XEN_TRUE_P(run_or_hook(bad_header_hook,
- XEN_LIST_1(C_TO_XEN_STRING(fullname)),
+ if ((Xen_hook_has_list(bad_header_hook)) &&
+ (Xen_is_true(run_or_hook(bad_header_hook,
+ Xen_list_1(C_string_to_Xen_string(fullname)),
S_bad_header_hook))))
return(NULL);
@@ -1177,22 +942,22 @@ static file_info *tackle_bad_header(const char *fullname, read_only_t read_only,
if (ss->open_requestor == FROM_OPEN_SOUND)
caller = S_open_sound;
else caller = S_view_sound;
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_3(C_TO_XEN_STRING("~A: ~S has a bad header?"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_STRING(fullname)));
+ Xen_error(BAD_HEADER,
+ Xen_list_3(C_string_to_Xen_string("~A: ~S has a bad header?"),
+ C_string_to_Xen_string(caller),
+ C_string_to_Xen_string(fullname)));
return(NULL);
}
#if (!USE_NO_GUI)
{
- int type;
+ mus_header_t type;
type = mus_header_type();
if ((type != MUS_MIDI_SAMPLE_DUMP) &&
(type != MUS_IEEE) &&
(type != MUS_MUS10) &&
(type != MUS_HCOM) &&
- (!(encoded_header_p(type))))
+ (!(header_is_encoded(type))))
{
char *info = NULL, *title = NULL;
title = raw_data_explanation(fullname, make_file_info_1(fullname), &info);
@@ -1209,27 +974,27 @@ file_info *make_file_info(const char *fullname, read_only_t read_only, bool sele
file_info *hdr = NULL;
if (mus_file_probe(fullname))
{
- int type = MUS_UNSUPPORTED, format = MUS_UNKNOWN;
+ mus_header_t type = MUS_UNKNOWN_HEADER;
/* open-raw-sound will force it to viewed as a raw sound */
if (ss->open_requestor == FROM_OPEN_RAW_SOUND)
return(make_file_info_1(fullname));
type = mus_sound_header_type(fullname);
- if (type == MUS_ERROR) /* if something went wrong */
- type = mus_header_type(); /* try to read it anyway... */
+ if (type == MUS_UNKNOWN_HEADER) /* if something went wrong */
+ type = mus_header_type(); /* try to read it anyway... */
/* handle some files directly through the translator (headers here are not readable) */
if ((type == MUS_MIDI_SAMPLE_DUMP) ||
(type == MUS_IEEE) ||
(type == MUS_MUS10) ||
(type == MUS_HCOM) ||
- (encoded_header_p(type)))
+ (header_is_encoded(type)))
{
return(translate_file(fullname, type));
}
- if (mus_header_type_p(type))
+ if (mus_is_header_type(type))
{ /* at least the header type seems plausible */
/* check header fields */
int sr = 0, ch = 0;
@@ -1246,8 +1011,9 @@ file_info *make_file_info(const char *fullname, read_only_t read_only, bool sele
return(open_raw_sound(fullname, read_only, selected));
else
{
- format = mus_sound_data_format(fullname);
- if (mus_data_format_p(format))
+ mus_sample_t sample_type;
+ sample_type = mus_sound_sample_type(fullname);
+ if (mus_is_sample_type(sample_type))
return(make_file_info_1(fullname));
return(translate_file(fullname, type));
}
@@ -1268,7 +1034,7 @@ file_info *make_temp_header(const char *fullname, int srate, int chans, mus_long
hdr->data_location = 28;
hdr->srate = srate;
hdr->chans = chans;
- hdr->format = MUS_OUT_FORMAT;
+ hdr->sample_type = MUS_OUT_SAMPLE_TYPE;
hdr->type = MUS_NEXT;
/* want direct read/writes for temp files */
hdr->comment = mus_strdup(caller);
@@ -1289,95 +1055,13 @@ file_info *free_file_info(file_info *hdr)
}
-static void fam_sp_action(struct fam_info *fp, FAMEvent *fe)
-{
-#if HAVE_FAM
- snd_info *sp = NULL;
- /* fp has been checked already */
- sp = (snd_info *)(fp->data);
- if (sp->writing) return;
- switch (fe->code)
- {
- case FAMChanged:
- /* this includes cp overwriting old etc */
- if (file_write_date(sp->filename) != sp->write_date) /* otherwise chmod? */
- {
- sp->need_update = true;
- if (auto_update(ss))
- snd_update(sp);
- else start_bomb(sp);
- }
-#if HAVE_ACCESS
- else
- {
- int err;
- err = access(sp->filename, R_OK);
- if (err < 0)
- {
- char *msg;
- msg = mus_format("%s is read-protected!", sp->short_filename);
- display_minibuffer_error(sp, msg);
- free(msg);
- sp->file_unreadable = true;
- start_bomb(sp);
- }
- else
- {
- sp->file_unreadable = false;
- clear_minibuffer_error(sp);
- err = access(sp->filename, W_OK);
- if (err < 0) /* if err < 0, then we can't write (W_OK -> error ) */
- sp->file_read_only = FILE_READ_ONLY;
- else sp->file_read_only = FILE_READ_WRITE;
- if ((sp->user_read_only == FILE_READ_ONLY) ||
- (sp->file_read_only == FILE_READ_ONLY))
- show_lock(sp);
- else hide_lock(sp);
- }
- }
-#endif
- break;
-
- case FAMDeleted:
- /* snd_update will post a complaint in this case, but I like it explicit */
- if (mus_file_probe(sp->filename) == 0)
- {
- /* user deleted file while editing it? */
- report_in_minibuffer(sp, "%s no longer exists!", sp->short_filename);
- sp->file_unreadable = true;
- start_bomb(sp);
- return;
- }
- /* else I don't know why I got this fam code, but fall through to the update case */
-
- case FAMCreated:
- case FAMMoved:
- /* this can be delivered a bit late (and more than once for a given save), so don't set off the bomb icon unless the file is wrong */
- if (sp->write_date != file_write_date(sp->filename))
- {
- sp->file_unreadable = false;
- sp->need_update = true;
- if (auto_update(ss))
- snd_update(sp);
- else start_bomb(sp);
- }
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-#endif
-}
-
-
static char *opened_sound_file_name(snd_info *sp)
{
char *newname;
int len;
len = strlen(sp->filename);
newname = (char *)calloc(len + 32, sizeof(char));
- mus_snprintf(newname, len + 32, "%s.%s", sp->filename, XEN_FILE_EXTENSION);
+ snprintf(newname, len + 32, "%s.%s", sp->filename, Xen_file_extension);
return(newname);
}
@@ -1388,7 +1072,7 @@ static char *remembered_sound_file_name(snd_info *sp)
int len;
len = strlen(sp->filename);
newname = (char *)calloc(len + 32, sizeof(char));
- mus_snprintf(newname, len + 32, "remembered-%s.%s", sp->short_filename, XEN_FILE_EXTENSION);
+ snprintf(newname, len + 32, "remembered-%s.%s", sp->short_filename, Xen_file_extension);
return(newname);
}
@@ -1415,7 +1099,7 @@ static void load_sound_file_extras(snd_info *sp)
static void remember_sound_file(snd_info *sp)
{
- char *locale = NULL, *newname;
+ char *newname;
FILE *fd;
newname = remembered_sound_file_name(sp);
@@ -1426,41 +1110,28 @@ static void remember_sound_file(snd_info *sp)
snd_error("remember sound state can't write %s: %s", newname, snd_io_strerror());
return;
}
-#if HAVE_SETLOCALE
- locale = mus_strdup(setlocale(LC_NUMERIC, "C")); /* must use decimal point in floats since Scheme assumes that format */
-#endif
-
sp->remembering = true;
save_sound_state(sp, fd);
sp->remembering = false;
-
- if (locale)
- {
-#if HAVE_SETLOCALE
- setlocale(LC_NUMERIC, locale);
-#endif
- free(locale);
- }
snd_fclose(fd, newname);
free(newname);
}
-static XEN snd_opened_sound;
-static XEN open_hook;
-static XEN close_hook;
-static XEN before_close_hook;
-static XEN during_open_hook;
-static XEN after_open_hook;
-static XEN output_name_hook;
+static Xen snd_opened_sound;
+static Xen open_hook;
+static Xen close_hook;
+static Xen before_close_hook;
+static Xen during_open_hook;
+static Xen after_open_hook;
void during_open(int fd, const char *file, open_reason_t reason)
{
- if (XEN_HOOKED(during_open_hook))
+ if (Xen_hook_has_list(during_open_hook))
run_hook(during_open_hook,
- XEN_LIST_3(C_TO_XEN_INT(fd),
- C_TO_XEN_STRING(file),
- C_TO_XEN_INT((int)reason)),
+ Xen_list_3(C_int_to_Xen_integer(fd),
+ C_string_to_Xen_string(file),
+ C_int_to_Xen_integer((int)reason)),
S_during_open_hook);
}
@@ -1470,67 +1141,39 @@ void after_open(snd_info *sp)
/* the sync-style choice used to be handled via after-open-hook in extensions.*, but 15-Feb-11 has
* been moved into the main Snd. So here is the code...
*/
- switch (sync_style(ss))
+ if (sp->nchans > 1)
{
- case SYNC_NONE:
- sp->sync = 0;
- break;
-
- case SYNC_ALL:
- sp->sync = 1;
- break;
-
- case SYNC_BY_SOUND:
- ss->sound_sync_max++;
- sp->sync = ss->sound_sync_max; /* if we had used (set! (sync) ...) this would be set (via syncb) to the new max */
- break;
+ switch (sync_style(ss))
+ {
+ case SYNC_NONE:
+ sp->sync = 0;
+ break;
+
+ case SYNC_ALL:
+ sp->sync = 1;
+ break;
+
+ case SYNC_BY_SOUND:
+ ss->sound_sync_max++;
+ sp->sync = ss->sound_sync_max; /* if we had used (set! (sync) ...) this would be set (via syncb) to the new max */
+ break;
+ }
}
+ else sp->sync = 0;
syncb(sp, sp->sync);
- if (XEN_HOOKED(after_open_hook))
+ if (Xen_hook_has_list(after_open_hook))
run_hook(after_open_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)),
+ Xen_list_1(C_int_to_Xen_sound(sp->index)),
S_after_open_hook);
- if (XEN_HOOKED(ss->snd_open_file_hook))
+ if (Xen_hook_has_list(ss->snd_open_file_hook))
run_hook(ss->snd_open_file_hook,
- XEN_LIST_1(C_TO_XEN_INT(FILE_OPENED)),
+ Xen_list_1(C_int_to_Xen_integer(FILE_OPENED)),
"open-file-hook");
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
-}
-
-
-char *output_name(const char *current_name)
-{
- if (XEN_HOOKED(output_name_hook))
- {
-#if HAVE_SCHEME
- int gc_loc;
-#endif
- XEN result, fname;
- XEN procs = XEN_HOOK_PROCEDURES (output_name_hook);
-
- fname = C_TO_XEN_STRING(current_name);
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, fname);
-#endif
-
- while (XEN_NOT_NULL_P(procs))
- {
- result = XEN_CALL_1(XEN_CAR(procs),
- fname,
- S_output_name_hook);
- if (XEN_STRING_P(result))
- return(mus_strdup(XEN_TO_C_STRING(result)));
- procs = XEN_CDR (procs);
- }
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
- }
- return(mus_strdup(current_name));
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
}
@@ -1539,18 +1182,17 @@ snd_info *finish_opening_sound(snd_info *sp, bool selected)
if (sp)
{
#if HAVE_RUBY || HAVE_FORTH
- XEN_VARIABLE_SET(S_snd_opened_sound, C_INT_TO_XEN_SOUND(sp->index));
+ Xen_variable_set(S_snd_opened_sound, C_int_to_Xen_sound(sp->index));
#endif
#if HAVE_SCHEME
- XEN_VARIABLE_SET(snd_opened_sound, C_INT_TO_XEN_SOUND(sp->index));
+ Xen_variable_set(snd_opened_sound, C_int_to_Xen_sound(sp->index));
#endif
-
sp->write_date = file_write_date(sp->filename); /* redundant (see snd-xsnd.c) */
sp->need_update = false;
ss->active_sounds++;
reflect_file_change_in_title();
- sp->file_watcher = fam_monitor_file(sp->filename, (void *)sp, fam_sp_action);
+ monitor_sound(sp);
}
for_each_separate_chan(channel_open_pane);
@@ -1560,7 +1202,7 @@ snd_info *finish_opening_sound(snd_info *sp, bool selected)
if (sp)
{
- add_srate_to_completion_list(SND_SRATE(sp));
+ add_srate_to_completion_list(snd_srate(sp));
if ((selected) &&
(sp->active) &&
(sp->inuse == SOUND_NORMAL))
@@ -1582,7 +1224,7 @@ snd_info *finish_opening_sound(snd_info *sp, bool selected)
}
-/* (add-hook! open-hook (lambda (f) (display f) #f)) */
+/* (hook-push open-hook (lambda (f) (display f) #f)) */
snd_info *snd_open_file(const char *filename, read_only_t read_only)
{
@@ -1592,25 +1234,24 @@ snd_info *snd_open_file(const char *filename, read_only_t read_only)
if (mcf) free(mcf);
mcf = mus_expand_filename(filename);
- if (XEN_HOOKED(open_hook))
+ if (Xen_hook_has_list(open_hook))
{
- XEN res = XEN_FALSE;
- XEN fstr;
- fstr = C_TO_XEN_STRING(mcf);
+ Xen res, fstr;
+ fstr = C_string_to_Xen_string(mcf);
res = run_or_hook(open_hook,
- XEN_LIST_1(fstr),
+ Xen_list_1(fstr),
S_open_hook);
- if (XEN_TRUE_P(res))
+ if (Xen_is_true(res))
{
if (mcf) {free(mcf); mcf = NULL;}
return(NULL);
}
else
{
- if (XEN_STRING_P(res)) /* added 14-Aug-01 for user-supplied auto-translations */
+ if (Xen_is_string(res)) /* added 14-Aug-01 for user-supplied auto-translations */
{
if (mcf) free(mcf);
- mcf = mus_expand_filename(XEN_TO_C_STRING(res));
+ mcf = mus_expand_filename(Xen_string_to_C_string(res));
}
}
}
@@ -1629,20 +1270,18 @@ snd_info *snd_open_file(const char *filename, read_only_t read_only)
}
-static void view_files_add_file(widget_t dialog, const char *filename);
-
void snd_close_file(snd_info *sp)
{
int i;
- XEN res = XEN_FALSE;
+ Xen res = Xen_false;
snd_info *chosen_sp = NULL;
/* before-close-hook can cancel the close, whereas close-hook can't */
- if (XEN_HOOKED(before_close_hook))
+ if (Xen_hook_has_list(before_close_hook))
res = run_or_hook(before_close_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)),
+ Xen_list_1(C_int_to_Xen_sound(sp->index)),
S_before_close_hook);
- if (XEN_TRUE_P(res)) return;
+ if (Xen_is_true(res)) return;
#if (!USE_NO_GUI)
if ((ask_about_unsaved_edits(ss)) &&
@@ -1652,14 +1291,15 @@ void snd_close_file(snd_info *sp)
return;
}
unpost_unsaved_edits_if_any(sp);
+ unpost_file_has_changed_if_any(sp);
#endif
if (peak_env_dir(ss))
map_over_sound_chans(sp, write_peak_env_info_file);
- if (XEN_HOOKED(close_hook))
+ if (Xen_hook_has_list(close_hook))
run_hook(close_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)),
+ Xen_list_1(C_int_to_Xen_sound(sp->index)),
S_close_hook);
if (remember_sound_state(ss))
@@ -1676,9 +1316,9 @@ void snd_close_file(snd_info *sp)
for (i = 0; i < sp->nchans; i++)
sp->chans[i]->squelch_update = true;
- check_for_event();
+ /* check_for_event(); */
- sp->file_watcher = fam_unmonitor_file(sp->filename, sp->file_watcher);
+ sp->file_watcher = unmonitor_file(sp->file_watcher);
/* exit does not go through this function to clean up temps -- see snd_exit_cleanly in snd-main.c */
if (selection_creation_in_progress()) finish_selection_creation();
@@ -1693,8 +1333,8 @@ void snd_close_file(snd_info *sp)
stop_playing_sound(sp, PLAY_CLOSE);
#if (!USE_NO_GUI)
- sp->inuse = SOUND_NORMAL; /* needed to make sure minibuffer is actually cleared in set_minibuffer_string */
- set_minibuffer_string(sp, NULL, false); /* false = don't try to update graphs! */
+ sp->inuse = SOUND_NORMAL; /* needed to make sure the status area is actually cleared in set_status */
+ set_status(sp, NULL, false); /* false = don't try to update graphs! */
sp->inuse = SOUND_IDLE;
#endif
@@ -1720,7 +1360,6 @@ void snd_close_file(snd_info *sp)
}
/* if sequester_deferred_regions is in free_snd_info (moved up to this level 15-12-03)
- * if needs an active-looking sound if its active edit op is a ptree read with an in-use closure.
* If the sound is set to SOUND_IDLE, the init function returns 'no-such-sound, and the
* subsequent read segfaults.
*/
@@ -1728,19 +1367,16 @@ void snd_close_file(snd_info *sp)
ss->active_sounds--;
reflect_file_change_in_title();
+ enved_reflect_selection(selection_is_active());
+ reflect_selection_in_save_as_dialog(selection_is_active());
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_IN_DOUBT)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->snd_open_file_hook))
+ if (Xen_hook_has_list(ss->snd_open_file_hook))
run_hook(ss->snd_open_file_hook,
- XEN_LIST_1(C_TO_XEN_INT(FILE_CLOSED)),
+ Xen_list_1(C_int_to_Xen_integer(FILE_CLOSED)),
"open-file-hook");
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
if (chosen_sp)
select_channel(chosen_sp, 0);
@@ -1769,7 +1405,7 @@ snd_info *make_sound_readable(const char *filename, bool post_close)
snd_info *sp;
chan_info *cp;
file_info *hdr = NULL;
- int i, fd;
+ int i;
mus_long_t len;
/* we've already checked that filename exists */
@@ -1779,13 +1415,12 @@ snd_info *make_sound_readable(const char *filename, bool post_close)
sp->hdr = hdr;
sp->inuse = SOUND_READER;
initialize_control_panel(sp);
- sp->search_proc = XEN_UNDEFINED;
- sp->prompt_callback = XEN_UNDEFINED;
sp->index = TEMP_SOUND_INDEX;
len = (hdr->samples) / (hdr->chans);
for (i = 0; i < sp->nchans; i++)
{
+ int fd;
cp = make_chan_info(NULL, i, sp);
cp->editable = false;
free(cp->ax);
@@ -1802,16 +1437,8 @@ snd_info *make_sound_readable(const char *filename, bool post_close)
}
-typedef struct {
- int chans, fields;
- double *axis_data;
- bool *fftp, *wavep;
-} axes_data;
-
-
-void *free_axes_data(void *usa)
+axes_data *free_axes_data(axes_data *sa)
{
- axes_data *sa = (axes_data *)usa;
if (sa)
{
if (sa->axis_data) {free(sa->axis_data); sa->axis_data = NULL;}
@@ -1826,7 +1453,7 @@ void *free_axes_data(void *usa)
enum {SA_X0, SA_X1, SA_Y0, SA_Y1, SA_XMIN, SA_XMAX, SA_YMIN, SA_YMAX, SA_ZX, SA_ZY, SA_SX, SA_SY, SA_GSY, SA_GZY};
#define SA_FIELDS 14
-void *make_axes_data(snd_info *sp)
+axes_data *make_axes_data(snd_info *sp)
{
axes_data *sa;
int i;
@@ -1858,8 +1485,8 @@ void *make_axes_data(snd_info *sp)
sa->axis_data[loc + SA_SY] = ap->sy;
sa->axis_data[loc + SA_GSY] = cp->gsy;
sa->axis_data[loc + SA_GZY] = cp->gzy;
- sa->wavep[i] = cp->graph_time_p;
- sa->fftp[i] = cp->graph_transform_p;
+ sa->wavep[i] = cp->graph_time_on;
+ sa->fftp[i] = cp->graph_transform_on;
/* unite and sync buttons are being cleared in snd_info_cleanup and explicitly in snd_update
* then probably reset in change_channel_style
@@ -1869,49 +1496,70 @@ void *make_axes_data(snd_info *sp)
* (via channel_style(ss) which defaults to channels_combined)
*/
}
- return((void *)sa);
+ return(sa);
}
-void restore_axes_data(snd_info *sp, void *usa, mus_float_t new_duration, bool need_edit_history_update)
+void restore_axes_data(snd_info *sp, axes_data *sa, mus_float_t new_duration, bool need_edit_history_update)
{
- axes_data *sa = (axes_data *)usa;
int i, j;
for (i = 0, j = 0; i < sp->nchans; i++)
{
- mus_float_t old_duration;
chan_info *cp;
axis_info *ap;
int loc;
cp = sp->chans[i];
loc = j * sa->fields;
- old_duration = sa->axis_data[loc + SA_X1] - sa->axis_data[loc + SA_X0]; /* old duration is x1 - x0 */
-
- if (new_duration < sa->axis_data[loc + SA_X0]) /* new duration < old x0 */
- sa->axis_data[loc + SA_X0] = new_duration - old_duration; /* try to maintain old window size */
- if (sa->axis_data[loc + SA_X0] < 0.0)
- sa->axis_data[loc + SA_X0] = 0.0;
- if (new_duration < sa->axis_data[loc + SA_X1])
- sa->axis_data[loc + SA_X1] = new_duration; /* new x1 */
+
+ if ((show_full_duration(ss)) &&
+ (sa->axis_data[loc + SA_X0] == 0.0) &&
+ (sa->axis_data[loc + SA_X1] == sa->axis_data[loc + SA_XMAX]))
+ {
+ /* we were viewing the full duration when the update occurred, and show-full-duration is #t,
+ * so show the full new duration.
+ */
+ sa->axis_data[loc + SA_X1] = new_duration; /* new x1 */
+ }
+ else
+ {
+ mus_float_t old_duration; /* old duration is x1 - x0 */
+ old_duration = sa->axis_data[loc + SA_X1] - sa->axis_data[loc + SA_X0];
+ if (new_duration < sa->axis_data[loc + SA_X0]) /* new duration < old x0 */
+ sa->axis_data[loc + SA_X0] = new_duration - old_duration; /* try to maintain old window size */
+ if (sa->axis_data[loc + SA_X0] < 0.0)
+ sa->axis_data[loc + SA_X0] = 0.0;
+ if (new_duration < sa->axis_data[loc + SA_X1])
+ sa->axis_data[loc + SA_X1] = new_duration; /* new x1 */
+ }
sa->axis_data[loc + SA_XMAX] = new_duration; /* new xmax */
ap = cp->axis;
ap->xmin = sa->axis_data[loc + SA_XMIN];
ap->xmax = sa->axis_data[loc + SA_XMAX];
- ap->ymin = sa->axis_data[loc + SA_YMIN];
- ap->ymax = sa->axis_data[loc + SA_YMAX];
-
/* zx and sx are reset by set_axes below? */
ap->zx = sa->axis_data[loc + SA_ZX];
ap->sx = sa->axis_data[loc + SA_SX];
- ap->zy = sa->axis_data[loc + SA_ZY];
- ap->sy = sa->axis_data[loc + SA_SY];
- cp->gsy = sa->axis_data[loc + SA_GSY];
- cp->gzy = sa->axis_data[loc + SA_GZY];
- ap->y_ambit = ap->ymax - ap->ymin;
ap->x_ambit = ap->xmax - ap->xmin;
+
+ if (!show_full_range(ss))
+ {
+ ap->ymin = sa->axis_data[loc + SA_YMIN];
+ ap->ymax = sa->axis_data[loc + SA_YMAX];
+ ap->zy = sa->axis_data[loc + SA_ZY];
+ ap->sy = sa->axis_data[loc + SA_SY];
+ ap->y_ambit = ap->ymax - ap->ymin;
+ }
+ else
+ {
+ sa->axis_data[loc + SA_Y0] = ap->y0;
+ sa->axis_data[loc + SA_Y1] = ap->y1;
+ }
+
+ cp->gzy = sa->axis_data[loc + SA_GZY];
+ cp->gsy = sa->axis_data[loc + SA_GSY];
+
set_axes(cp,
sa->axis_data[loc + SA_X0],
sa->axis_data[loc + SA_X1],
@@ -1970,7 +1618,7 @@ static void copy_chan_info(chan_info *ncp, chan_info *ocp)
ncp->zero_pad = ocp->zero_pad;
ncp->x_axis_style = ocp->x_axis_style;
ncp->wavelet_type = ocp->wavelet_type;
- ncp->verbose_cursor = ocp->verbose_cursor;
+ ncp->with_verbose_cursor = ocp->with_verbose_cursor;
ncp->max_transform_peaks = ocp->max_transform_peaks;
ncp->show_transform_peaks = ocp->show_transform_peaks;
ncp->show_axes = ocp->show_axes;
@@ -1990,7 +1638,7 @@ static void copy_chan_info(chan_info *ncp, chan_info *ocp)
ncp->spectro_hop = ocp->spectro_hop;
ncp->graphs_horizontal = ocp->graphs_horizontal;
ncp->cursor_proc = ocp->cursor_proc;
- if (XEN_BOUND_P(ncp->cursor_proc))
+ if (Xen_is_bound(ncp->cursor_proc))
ncp->cursor_proc_loc = snd_protect(ncp->cursor_proc);
else ncp->cursor_proc_loc = NOT_A_GC_LOC;
}
@@ -2010,13 +1658,6 @@ static void copy_snd_info(snd_info *nsp, snd_info *osp)
nsp->reverb_control_decay = osp->reverb_control_decay;
nsp->channel_style = osp->channel_style;
nsp->sync = osp->sync;
- nsp->search_tree = osp->search_tree;
- osp->search_tree = NULL;
- nsp->search_expr = osp->search_expr;
- osp->search_expr = NULL;
- nsp->search_proc = osp->search_proc;
- if (XEN_BOUND_P(nsp->search_proc))
- nsp->search_proc_loc = snd_protect(nsp->search_proc);
}
@@ -2050,40 +1691,35 @@ static void sound_restore_chan_info(snd_info *nsp, snd_info *osp)
for (i = 0; i < nsp->nchans; i++)
{
copy_chan_info(nsp->chans[i], cps[i]);
- if (XEN_BOUND_P(cps[i]->cursor_proc))
+ if (Xen_is_bound(cps[i]->cursor_proc))
{
snd_unprotect_at(cps[i]->cursor_proc_loc);
- cps[i]->cursor_proc = XEN_UNDEFINED;
+ cps[i]->cursor_proc = Xen_undefined;
cps[i]->cursor_proc_loc = NOT_A_GC_LOC;
}
}
- if (XEN_BOUND_P(osp->search_proc))
- {
- snd_unprotect_at(osp->search_proc_loc);
- osp->search_proc_loc = NOT_A_GC_LOC;
- osp->search_proc = XEN_UNDEFINED;
- }
}
-static XEN update_hook;
+static Xen update_hook;
snd_info *snd_update(snd_info *sp)
{
/* we can't be real smart here because the channel number may have changed and so on */
- int i, old_srate, old_chans, old_format, sp_chans, old_index, gc_loc = NOT_A_GC_LOC, old_selected_channel = NO_SELECTION;
+ int i, old_srate, old_chans, sp_chans, old_index, gc_loc = NOT_A_GC_LOC, old_selected_channel = NO_SELECTION;
+ mus_sample_t old_sample_type;
channel_style_t old_channel_style;
read_only_t read_only;
bool old_raw;
- void *sa;
+ axes_data *sa;
snd_info *nsp = NULL;
char *filename;
void *ms;
snd_info *saved_sp;
struct ctrl_state *saved_controls;
mus_long_t *old_cursors;
- fam_info *old_file_watcher;
- XEN update_hook_result = XEN_FALSE;
+ void *old_file_watcher;
+ Xen update_hook_result = Xen_false;
const char *ur_filename;
int app_x, app_y;
@@ -2113,18 +1749,18 @@ snd_info *snd_update(snd_info *sp)
if (with_inset_graph(ss))
for_each_sound_chan(sp, clear_inset_graph);
- if (XEN_HOOKED(update_hook))
+ if (Xen_hook_has_list(update_hook))
{
/* #t => return without updating (not recommended!!), proc of 1 arg will be evaluated after update is complete */
update_hook_result = run_or_hook(update_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)),
+ Xen_list_1(C_int_to_Xen_sound(sp->index)),
S_update_hook);
- if (XEN_TRUE_P(update_hook_result)) return(sp);
- if (XEN_PROCEDURE_P(update_hook_result))
+ if (Xen_is_true(update_hook_result)) return(sp);
+ if (Xen_is_procedure(update_hook_result))
{
- if (XEN_REQUIRED_ARGS_OK(update_hook_result, 1))
+ if (Xen_is_aritable(update_hook_result, 1))
gc_loc = snd_protect(update_hook_result);
- else XEN_BAD_ARITY_ERROR(S_update_hook, 0, update_hook_result, S_update_hook " function result should require 1 arg");
+ else Xen_bad_arity_error(S_update_hook, 0, update_hook_result, S_update_hook " function result should require 1 arg");
}
}
@@ -2136,8 +1772,8 @@ snd_info *snd_update(snd_info *sp)
old_raw = (sp->hdr->type == MUS_RAW);
if (old_raw)
{
- mus_header_raw_defaults(&old_srate, &old_chans, &old_format);
- mus_header_set_raw_defaults(sp->hdr->srate, sp->hdr->chans, sp->hdr->format);
+ mus_header_raw_defaults(&old_srate, &old_chans, &old_sample_type);
+ mus_header_set_raw_defaults(sp->hdr->srate, sp->hdr->chans, sp->hdr->sample_type);
}
if (sp == selected_sound())
@@ -2165,7 +1801,7 @@ snd_info *snd_update(snd_info *sp)
chan_info *ncp;
int k;
ncp = sp->chans[i];
- old_cursors[i] = CURSOR(ncp);
+ old_cursors[i] = cursor_sample(ncp);
for (k = 0; k < ncp->edit_size; k++)
{
ed_list *ed;
@@ -2174,16 +1810,17 @@ snd_info *snd_update(snd_info *sp)
ed->peak_env = free_peak_env(ncp, k);
}
}
-
old_file_watcher = sp->file_watcher; /* will be unmonitored in snd_close_file, but we need to know if it is being monitored now */
snd_close_file(sp);
- /* no mus_sound_forget here because we may be simply re-interpreting the existing data (set! (data-format) ...) etc */
+ /* no mus_sound_forget here because we may be simply re-interpreting the existing data (set! (sample-type) ...) etc */
/* this normalizes the fft/lisp/wave state so we need to reset it after reopen */
- if (!(ss->fam_ok))
+#if USE_MOTIF
+ if (!(ss->file_monitor_ok))
alert_new_file();
+#endif
ss->reloading_updated_file = (old_index + 1);
ss->open_requestor = FROM_UPDATE;
@@ -2200,14 +1837,15 @@ snd_info *snd_update(snd_info *sp)
ss->reloading_updated_file = 0;
if (old_raw)
- mus_header_set_raw_defaults(old_srate, old_chans, old_format);
+ mus_header_set_raw_defaults(old_srate, old_chans, old_sample_type);
if (nsp)
{
/* if header is bad, nsp can be null awaiting raw data dialog's return */
+
if ((old_file_watcher) &&
(!(nsp->file_watcher)))
- nsp->file_watcher = fam_monitor_file(nsp->filename, (void *)nsp, fam_sp_action);
- /* might be a different sp as well as underlying file */
+ monitor_sound(nsp);
+ /* might be a different sp as well as underlying file */
nsp->saved_controls = saved_controls;
if (saved_controls) restore_controls(nsp);
@@ -2222,7 +1860,7 @@ snd_info *snd_update(snd_info *sp)
sound_restore_marks(nsp, ms);
for (i = 0; (i < nsp->nchans) && (i < sp_chans); i++)
- CURSOR(nsp->chans[i]) = old_cursors[i];
+ cursor_sample(nsp->chans[i]) = old_cursors[i];
if ((nsp->nchans > 1) &&
(old_channel_style != CHANNELS_SEPARATE)) /* we set it to separate before the update */
@@ -2231,13 +1869,12 @@ snd_info *snd_update(snd_info *sp)
free(old_cursors);
- if (XEN_PROCEDURE_P(update_hook_result))
+ if (Xen_is_procedure(update_hook_result))
{
- XEN_CALL_1(update_hook_result,
- (nsp) ? C_INT_TO_XEN_SOUND(nsp->index) : XEN_FALSE,
+ Xen_call_with_1_arg(update_hook_result,
+ (nsp) ? C_int_to_Xen_sound(nsp->index) : Xen_false,
"procedure returned by " S_update_hook);
if (gc_loc != NOT_A_GC_LOC) snd_unprotect_at(gc_loc);
- gc_loc = NOT_A_GC_LOC;
}
if (saved_sp)
@@ -2247,7 +1884,7 @@ snd_info *snd_update(snd_info *sp)
free(saved_sp->chans);
free(saved_sp);
}
- sa = free_axes_data(sa);
+ free_axes_data((axes_data *)sa);
free(filename);
#if USE_MOTIF
@@ -2263,7 +1900,7 @@ snd_info *snd_update(snd_info *sp)
static void snd_update_warning_handler(const char *msg, void *data)
{
- string_to_minibuffer((snd_info *)data, msg);
+ set_status((snd_info *)data, msg, false);
}
@@ -2271,10 +1908,10 @@ static void snd_update_error_handler(const char *msg, void *data)
{
redirect_snd_error_to(NULL, NULL);
redirect_snd_warning_to(NULL, NULL);
- XEN_ERROR(CANT_UPDATE_FILE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: ~A"),
- C_TO_XEN_STRING((char *)data),
- C_TO_XEN_STRING(msg)));
+ Xen_error(CANT_UPDATE_FILE,
+ Xen_list_3(C_string_to_Xen_string("~A: ~A"),
+ C_string_to_Xen_string((char *)data),
+ C_string_to_Xen_string(msg)));
}
@@ -2290,47 +1927,48 @@ snd_info *snd_update_within_xen(snd_info *sp, const char *caller)
}
-static XEN after_save_as_hook;
+static Xen after_save_as_hook;
void run_after_save_as_hook(snd_info *sp, const char *already_saved_as_name, bool from_save_as_dialog)
{
/* might be save-selection, as well as save-sound-as */
- if (XEN_HOOKED(after_save_as_hook))
+ if (Xen_hook_has_list(after_save_as_hook))
{
char *fullname;
fullname = mus_expand_filename(already_saved_as_name);
run_progn_hook(after_save_as_hook,
- XEN_LIST_3((sp) ? C_INT_TO_XEN_SOUND(sp->index) : XEN_FALSE,
- C_TO_XEN_STRING(fullname),
- C_TO_XEN_BOOLEAN(from_save_as_dialog)),
+ Xen_list_3((sp) ? C_int_to_Xen_sound(sp->index) : Xen_false,
+ C_string_to_Xen_string(fullname),
+ C_bool_to_Xen_boolean(from_save_as_dialog)),
S_after_save_as_hook);
free(fullname);
}
}
-static XEN before_save_as_hook;
+static Xen before_save_as_hook;
static bool before_save_as_hook_active = false;
-bool run_before_save_as_hook(snd_info *sp, const char *save_as_filename, bool selection, int srate, int type, int format, const char *comment)
+bool run_before_save_as_hook(snd_info *sp, const char *save_as_filename, bool selection, int srate,
+ mus_sample_t smp_type, mus_header_t hd_type, const char *comment)
{
/* might be save-selection, as well as save-sound-as */
if (before_save_as_hook_active) return(false);
- if (XEN_HOOKED(before_save_as_hook))
+ if (Xen_hook_has_list(before_save_as_hook))
{
- XEN result = XEN_FALSE;
+ Xen result;
before_save_as_hook_active = true;
result = run_progn_hook(before_save_as_hook,
- XEN_LIST_7((sp) ? C_INT_TO_XEN_SOUND(sp->index) : XEN_FALSE,
- C_TO_XEN_STRING(save_as_filename),
- C_TO_XEN_BOOLEAN(selection),
- C_TO_XEN_INT(srate),
- C_TO_XEN_INT(type),
- C_TO_XEN_INT(format),
- (comment) ? C_TO_XEN_STRING(comment) : XEN_FALSE),
+ Xen_list_7((sp) ? C_int_to_Xen_sound(sp->index) : Xen_false,
+ C_string_to_Xen_string(save_as_filename),
+ C_bool_to_Xen_boolean(selection),
+ C_int_to_Xen_integer(srate),
+ C_int_to_Xen_integer((int)smp_type),
+ C_int_to_Xen_integer((int)hd_type),
+ (comment) ? C_string_to_Xen_string(comment) : Xen_false),
S_before_save_as_hook);
before_save_as_hook_active = false;
- return(!(XEN_FALSE_P(result)));
+ return(Xen_is_true(result));
}
return(false);
}
@@ -2340,15 +1978,15 @@ bool run_before_save_as_hook(snd_info *sp, const char *save_as_filename, bool se
enum {H_NEXT, H_AIFC, H_RIFF, H_RF64, H_RAW, H_AIFF, H_IRCAM, H_NIST, H_CAFF, /* the "built-in" choices for output */
H_OGG, H_FLAC, H_SPEEX, H_TTA, H_WAVPACK, /* readable/writable via external programs */
- H_MPEG, H_MIDI, H_SHORTEN, /* readable via external programs */
+ H_MPEG, H_MIDI, /* readable via external programs */
H_SIZE};
-static int h_num_formats[H_SIZE] = {12 /* next */, 13 /* aifc */, 8 /* riff */, 8 /* rf64 */, 18 /* raw */, 4 /* aiff */, 5 /* ircam */, 7 /* nist */, 13 /* caff */,
+static int h_num_sample_types[H_SIZE] = {12 /* next */, 13 /* aifc */, 8 /* riff */, 8 /* rf64 */, 18 /* raw */, 4 /* aiff */, 5 /* ircam */, 7 /* nist */, 13 /* caff */,
1 /* ogg */, 1 /* flac */, 1 /* speex */, 1 /* tta */, 1 /*wavpack */,
- 1 /* mpeg */, 1 /* midi */, 1 /* shorten */};
+ 1 /* mpeg */, 1 /* midi */};
#define H_DFS_MAX 18
-static int h_dfs[H_SIZE][H_DFS_MAX] = { /* next */ {MUS_BFLOAT, MUS_BSHORT, MUS_LSHORT, MUS_LFLOAT,
+static mus_sample_t h_dfs[H_SIZE][H_DFS_MAX] = { /* next */ {MUS_BFLOAT, MUS_BSHORT, MUS_LSHORT, MUS_LFLOAT,
MUS_MULAW, MUS_BYTE, MUS_BINT, MUS_ALAW, MUS_B24INT, MUS_BDOUBLE, MUS_LINT, MUS_LDOUBLE},
/* aifc */ {MUS_BFLOAT, MUS_BSHORT, MUS_MULAW, MUS_BYTE, MUS_BINT, MUS_ALAW, MUS_B24INT,
MUS_BDOUBLE, MUS_UBYTE, MUS_LSHORT, MUS_LINT, MUS_L24INT, MUS_UBSHORT},
@@ -2367,21 +2005,23 @@ static int h_dfs[H_SIZE][H_DFS_MAX] = { /* next */ {MUS_BFLOAT, MUS_BSHORT, MUS
/* speex */ {MUS_LSHORT},
/* tta */ {MUS_LSHORT},
/* wavpack */ {MUS_LSHORT},
- /* readonly */ {-1}, {-1}, {-1}
+ /* readonly */ {MUS_UNKNOWN_SAMPLE}, {MUS_UNKNOWN_SAMPLE}
};
static const char *h_df_names[H_SIZE][H_DFS_MAX];
static const char *h_names[H_SIZE] = {"au/next ", "aifc ", "wave ", "rf64 ", "raw ", "aiff ", "ircam ", "nist ", "caff ",
"ogg ", "flac ", "speex ", "tta ", "wavpack",
- "mpeg ", "midi ", "shorten"};
-static int h_pos_to_type[H_SIZE] = {MUS_NEXT, MUS_AIFC, MUS_RIFF, MUS_RF64, MUS_RAW, MUS_AIFF, MUS_IRCAM, MUS_NIST, MUS_CAFF, -1, -1, -1, -1, -1, -1, -1, -1};
-static int h_type_to_pos[MUS_NUM_HEADER_TYPES];
-static int h_type_to_h[MUS_NUM_HEADER_TYPES];
+ "mpeg ", "midi "};
+static mus_header_t h_pos_to_type[H_SIZE] = {MUS_NEXT, MUS_AIFC, MUS_RIFF, MUS_RF64, MUS_RAW, MUS_AIFF, MUS_IRCAM, MUS_NIST, MUS_CAFF,
+ MUS_UNKNOWN_HEADER, MUS_UNKNOWN_HEADER, MUS_UNKNOWN_HEADER, MUS_UNKNOWN_HEADER,
+ MUS_UNKNOWN_HEADER, MUS_UNKNOWN_HEADER, MUS_UNKNOWN_HEADER};
+static int h_type_to_pos[MUS_NUM_HEADERS];
+static int h_type_to_h[MUS_NUM_HEADERS];
-static const char *data_format_name(int format)
+static const char *sample_type_name(mus_sample_t sample_type)
{
- switch (format)
+ switch (sample_type)
{
case MUS_BSHORT: return("16-bit int (be)"); break;
case MUS_MULAW: return("mulaw"); break;
@@ -2409,15 +2049,15 @@ static const char *data_format_name(int format)
}
}
-void initialize_format_lists(void)
+void initialize_sample_type_lists(void)
{
int i, h;
for (h = 0; h < H_SIZE; h++)
- for (i = 0; i < h_num_formats[h]; i++)
- h_df_names[h][i] = data_format_name(h_dfs[h][i]);
+ for (i = 0; i < h_num_sample_types[h]; i++)
+ h_df_names[h][i] = sample_type_name(h_dfs[h][i]);
- for (i = 0; i < MUS_NUM_HEADER_TYPES; i++)
+ for (i = 0; i < MUS_NUM_HEADERS; i++)
{
h_type_to_pos[i] = -1;
h_type_to_h[i] = -1;
@@ -2446,7 +2086,6 @@ void initialize_format_lists(void)
h_type_to_h[MUS_SPEEX] = H_SPEEX;
h_type_to_h[MUS_MIDI] = H_MIDI;
h_type_to_h[MUS_MPEG] = H_MPEG;
- h_type_to_h[MUS_SHORTEN] = H_SHORTEN;
h_type_to_h[MUS_TTA] = H_TTA;
h_type_to_h[MUS_WAVPACK] = H_WAVPACK;
@@ -2487,11 +2126,6 @@ void initialize_format_lists(void)
h_type_to_pos[MUS_MIDI] = i;
h_pos_to_type[i++] = MUS_MIDI;
#endif
-
-#if HAVE_SHORTEN
- h_type_to_pos[MUS_SHORTEN] = i;
- h_pos_to_type[i++] = MUS_SHORTEN;
-#endif
}
@@ -2513,9 +2147,9 @@ const char **short_builtin_headers(int *len)
const char **short_writable_headers(int *len)
{
/* these are headers that we either write ourself, or have external programs to write (oggenc etc) */
- int i;
if (!writable_headers)
{
+ int i;
writable_headers = (const char **)calloc(NUM_POSSIBLE_HEADERS, sizeof(char *));
for (i = 0; i < NUM_BUILTIN_HEADERS; i++)
writable_headers[i] = h_names[i];
@@ -2557,9 +2191,9 @@ const char **short_writable_headers(int *len)
const char **short_readable_headers(int *len)
{
- int i;
if (!readable_headers)
{
+ int i;
readable_headers = (const char **)calloc(NUM_POSSIBLE_HEADERS, sizeof(char *));
for (i = 0; i < NUM_BUILTIN_HEADERS; i++)
readable_headers[i] = h_names[i];
@@ -2568,7 +2202,7 @@ const char **short_readable_headers(int *len)
oggdec infile.ogg -b 16 -o translatedfile.wav
defaults for rest are signed little endian wav
- so formats (for output temp) here are not relevant -- no one will want 1 byte
+ so sample_types (for output temp) here are not relevant -- no one will want 1 byte
*/
readable_headers[i++] = h_names[H_OGG];
#endif
@@ -2605,10 +2239,6 @@ const char **short_readable_headers(int *len)
readable_headers[i++] = h_names[H_MIDI];
#endif
-#if HAVE_SHORTEN
- readable_headers[i++] = h_names[H_SHORTEN];
-#endif
-
#if HAVE_TTA
readable_headers[i++] = h_names[H_TTA];
#endif
@@ -2623,51 +2253,51 @@ const char **short_readable_headers(int *len)
}
-int position_to_type(int position)
+mus_header_t position_to_header_type(int position)
{
return(h_pos_to_type[position]);
}
-int position_to_format(int header, int position)
+mus_sample_t position_to_sample_type(mus_header_t header, int position)
{
return(h_dfs[h_type_to_pos[header]][position]);
}
-static int h_to_format_pos(int h, int frm)
+static int h_to_sample_type_pos(int h, mus_sample_t samp_type)
{
int i;
- for (i = 0; i < h_num_formats[h]; i++)
- if (h_dfs[h][i] == frm)
+ for (i = 0; i < h_num_sample_types[h]; i++)
+ if (h_dfs[h][i] == samp_type)
return(i);
return(0);
}
-const char **type_and_format_to_position(file_data *fdat, int type, int format)
+const char **header_type_and_sample_type_to_position(file_data *fdat, mus_header_t type, mus_sample_t sample_type)
{
int h;
h = h_type_to_h[type];
- fdat->formats = h_num_formats[h];
- fdat->header_pos = h_type_to_pos[type];
- fdat->format_pos = h_to_format_pos(h, format);
+ fdat->sample_types = h_num_sample_types[h];
+ fdat->header_type_pos = h_type_to_pos[type];
+ fdat->sample_type_pos = h_to_sample_type_pos(h, sample_type);
return(h_df_names[h]);
}
-void position_to_type_and_format(file_data *fdat, int pos)
+void position_to_header_type_and_sample_type(file_data *fdat, int pos)
{
int h;
h = h_type_to_h[h_pos_to_type[pos]];
- fdat->header_pos = pos;
- fdat->current_type = h_pos_to_type[pos];
- fdat->format_pos = h_to_format_pos(h, fdat->current_format);
- fdat->current_format = h_dfs[h][fdat->format_pos];
+ fdat->header_type_pos = pos;
+ fdat->current_header_type = h_pos_to_type[pos];
+ fdat->sample_type_pos = h_to_sample_type_pos(h, fdat->current_sample_type);
+ fdat->current_sample_type = h_dfs[h][fdat->sample_type_pos];
}
-bool encoded_header_p(int header_type)
+bool header_is_encoded(mus_header_t header_type)
{
/* going either way here */
return((header_type == MUS_OGG) ||
@@ -2675,56 +2305,96 @@ bool encoded_header_p(int header_type)
(header_type == MUS_SPEEX) ||
(header_type == MUS_MPEG) ||
(header_type == MUS_MIDI) ||
- (header_type == MUS_SHORTEN) ||
(header_type == MUS_TTA) ||
(header_type == MUS_WAVPACK)
);
}
-void snd_encode(int type, const char *input_filename, const char *output_filename)
+static char *quoted_filename(const char *filename, bool *new_name)
+{
+ int p, len;
+ p = strcspn(filename, "' *?"); /* also [] but do they actually ever happen? */
+ len = strlen(filename);
+ if (p < len)
+ {
+ int i, j;
+ char *name;
+ (*new_name) = true;
+ name = (char *)calloc(len * 2, sizeof(char));
+ for (i = 0, j = 0; i < len; i++)
+ {
+ if ((filename[i] == ' ') ||
+ (filename[i] == '\'') ||
+ (filename[i] == '*') ||
+ (filename[i] == '(') ||
+ (filename[i] == ')') ||
+ (filename[i] == '?'))
+ name[j++] = '\\';
+ name[j++] = filename[i];
+ }
+ return(name);
+ }
+ (*new_name) = false;
+ fprintf(stderr, "not quoted: %s\n", filename);
+ return((char *)filename);
+}
+
+
+void snd_encode(mus_header_t type, const char *input_filename, const char *output_filename)
{
/* write lshort wav tmpfile, encode, remove tmpfile */
- char *command = NULL;
+ char *command = NULL, *ofile, *ifile;
+ bool ofile_free = false, ifile_free = false;
+
if (mus_file_probe(output_filename))
snd_remove(output_filename, IGNORE_CACHE);
/* these guys balk at overwriting */
+ /* can't use '%s' here because the filename might also have single-quotes!
+ */
+ ifile = quoted_filename(input_filename, &ifile_free);
+ ofile = quoted_filename(output_filename, &ofile_free);
+
switch (type)
{
#if HAVE_OGG
case MUS_OGG:
- command = mus_format("%s %s -o %s", PATH_OGGENC, input_filename, output_filename);
+ command = mus_format("%s %s -o %s", PATH_OGGENC, ifile, ofile);
break;
#endif
#if HAVE_FLAC
case MUS_FLAC:
- command = mus_format("%s %s -o %s", PATH_FLAC, input_filename, output_filename);
+ command = mus_format("%s %s -o %s", PATH_FLAC, ifile, ofile);
break;
#endif
#if HAVE_SPEEX
case MUS_SPEEX:
- command = mus_format("%s %s %s", PATH_SPEEXENC, input_filename, output_filename);
+ command = mus_format("%s %s %s", PATH_SPEEXENC, ifile, ofile);
break;
#endif
#if HAVE_TTA
case MUS_TTA:
- command = mus_format("%s -e %s -o %s", PATH_TTA, input_filename, output_filename);
+ command = mus_format("%s -e %s -o %s", PATH_TTA, ifile, ofile);
break;
#endif
#if HAVE_WAVPACK
case MUS_WAVPACK:
- command = mus_format("%s %s -o %s", PATH_WAVPACK, input_filename, output_filename);
+ command = mus_format("%s %s -o %s", PATH_WAVPACK, ifile, ofile);
break;
#endif
default:
break;
}
+
+ if (ofile_free) free(ofile);
+ if (ifile_free) free(ifile);
+
if (command)
{
int err;
@@ -2736,71 +2406,74 @@ void snd_encode(int type, const char *input_filename, const char *output_filenam
}
-int snd_decode(int type, const char *input_filename, const char *output_filename)
+int snd_decode(mus_header_t type, const char *input_filename, const char *output_filename)
{
int err = 0;
- char *command = NULL;
+ char *command = NULL, *ofile, *ifile;
+ bool ofile_free = false, ifile_free = false;
+
if (mus_file_probe(output_filename))
snd_remove(output_filename, IGNORE_CACHE);
/* these guys balk at overwriting */
+ ifile = quoted_filename(input_filename, &ifile_free);
+ ofile = quoted_filename(output_filename, &ofile_free);
+
switch (type)
{
#if HAVE_OGG
case MUS_OGG:
- command = mus_format("%s %s -b 16 -o %s", PATH_OGGDEC, input_filename, output_filename);
+ command = mus_format("%s %s -b 16 -o %s", PATH_OGGDEC, ifile, ofile);
break;
#endif
#if HAVE_FLAC
case MUS_FLAC:
- command = mus_format("%s -d %s -o %s", PATH_FLAC, input_filename, output_filename);
+ command = mus_format("%s -d %s -o %s", PATH_FLAC, ifile, ofile);
break;
#endif
#if HAVE_SPEEX
case MUS_SPEEX:
- command = mus_format("%s %s %s", PATH_SPEEXDEC, input_filename, output_filename);
+ command = mus_format("%s %s %s", PATH_SPEEXDEC, ifile, ofile);
break;
#endif
#if HAVE_MPEG
case MUS_MPEG:
#if HAVE_MPG321
- command = mus_format("%s -q -w %s %s", PATH_MPG321, output_filename, input_filename);
+ command = mus_format("%s -q -w %s %s", PATH_MPG321, ofile, ifile);
#else
- command = mus_format("%s -q -w %s %s", PATH_MPG123, output_filename, input_filename);
+ command = mus_format("%s -q -w %s %s", PATH_MPG123, ofile, ifile);
#endif
break;
#endif
#if HAVE_TIMIDITY
case MUS_MIDI:
- command = mus_format("%s %s -Ou -o %s", PATH_TIMIDITY, input_filename, output_filename);
- break;
-#endif
-
-#if HAVE_SHORTEN
- case MUS_SHORTEN:
- command = mus_format("%s -x %s %s", PATH_SHORTEN, input_filename, output_filename);
+ command = mus_format("%s %s -Ou -o %s", PATH_TIMIDITY, ifile, ofile);
break;
#endif
#if HAVE_TTA
case MUS_TTA:
- command = mus_format("%s -d %s -o %s", PATH_TTA, input_filename, output_filename);
+ command = mus_format("%s -d %s -o %s", PATH_TTA, ifile, ofile);
break;
#endif
#if HAVE_WAVPACK
case MUS_WAVPACK:
- command = mus_format("%s %s -o %s", PATH_WVUNPACK, input_filename, output_filename);
+ command = mus_format("%s %s -o %s", PATH_WVUNPACK, ifile, ofile);
break;
#endif
default:
err = -1;
break;
}
+
+ if (ofile_free) free(ofile);
+ if (ifile_free) free(ifile);
+
if (command)
{
int err;
@@ -2876,15 +2549,18 @@ bool edit_header_callback(snd_info *sp, file_data *edit_header_data,
mus_long_t loc, samples;
char *comment, *original_comment = NULL;
file_info *hdr;
- int chans, srate, type, format;
+ int chans, srate;
+ mus_sample_t sample_type;
+ mus_header_t header_type;
+
if ((sp->user_read_only == FILE_READ_ONLY) ||
(sp->file_read_only == FILE_READ_ONLY))
{
snd_error("%s is write-protected", sp->filename);
return(false);
}
-#if HAVE_ACCESS
- if (!(ss->fam_ok))
+#ifndef _MSC_VER
+ if (!(ss->file_monitor_ok))
if (access(sp->filename, W_OK) < 0)
{
snd_error("%s is write-protected", sp->filename);
@@ -2895,7 +2571,7 @@ bool edit_header_callback(snd_info *sp, file_data *edit_header_data,
/* find out which fields changed -- if possible don't touch the sound data */
redirect_snd_error_to(inner_handler, (void *)edit_header_data);
- comment = get_file_dialog_sound_attributes(edit_header_data, &srate, &chans, &type, &format, &loc, &samples, 1);
+ comment = get_file_dialog_sound_attributes(edit_header_data, &srate, &chans, &header_type, &sample_type, &loc, &samples, 1);
redirect_snd_error_to(outer_handler, (void *)edit_header_data);
if (edit_header_data->error_widget != NOT_A_SCANF_WIDGET) /* bad field value, perhaps */
return(false);
@@ -2908,28 +2584,28 @@ bool edit_header_callback(snd_info *sp, file_data *edit_header_data,
mus_header_set_aiff_loop_info(mus_sound_loop_info(sp->filename));
}
mus_sound_forget(sp->filename);
- if (hdr->type != type)
+ if (hdr->type != header_type)
{
sp->writing = true;
- mus_header_change_type(sp->filename, type, format);
+ mus_header_change_type(sp->filename, header_type, sample_type);
sp->writing = false;
}
else
{
- if (hdr->format != format)
- mus_header_change_format(sp->filename, type, format);
+ if (hdr->sample_type != sample_type)
+ mus_header_change_sample_type(sp->filename, header_type, sample_type);
}
if (hdr->chans != chans)
- mus_header_change_chans(sp->filename, type, chans);
+ mus_header_change_chans(sp->filename, header_type, chans);
if (hdr->srate != srate)
- mus_header_change_srate(sp->filename, type, srate);
+ mus_header_change_srate(sp->filename, header_type, srate);
if (hdr->samples != samples)
- mus_header_change_data_size(sp->filename, type, mus_samples_to_bytes(format, samples));
- if ((type == MUS_NEXT) &&
+ mus_header_change_data_size(sp->filename, header_type, mus_samples_to_bytes(sample_type, samples));
+ if ((header_type == MUS_NEXT) &&
(hdr->data_location != loc))
mus_header_change_location(sp->filename, MUS_NEXT, loc);
if (!(mus_strcmp(comment, original_comment)))
- mus_header_change_comment(sp->filename, type, comment);
+ mus_header_change_comment(sp->filename, header_type, comment);
if (comment) free(comment);
if (original_comment) free(original_comment);
snd_update(sp);
@@ -2998,7 +2674,7 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
/* srate */
ok = ((original_srate >= 8000) &&
(original_srate <= 100000));
- mus_snprintf(reason_str, len, "srate%s: %d", (ok) ? "" : " looks wrong", original_srate);
+ snprintf(reason_str, len, "srate%s: %d", (ok) ? "" : " looks wrong", original_srate);
if (!ok)
{
ns = (int)swap_int(original_srate);
@@ -3007,7 +2683,7 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
if ((ns > 4000) && (ns < 100000))
{
better_srate = ns;
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %d)", ns);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %d)", ns);
reason_str = mus_strcat(reason_str, tmp_str, &len);
}
}
@@ -3015,7 +2691,7 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
/* chans */
ok = ((original_chans > 0) &&
(original_chans < 1000));
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nchans%s: %d", (ok) ? "" : " looks wrong", original_chans);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nchans%s: %d", (ok) ? "" : " looks wrong", original_chans);
reason_str = mus_strcat(reason_str, tmp_str, &len);
if (!ok)
{
@@ -3025,30 +2701,29 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
if ((ns > 0) && (ns <= 8))
{
better_chans = ns;
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %d)", ns);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %d)", ns);
reason_str = mus_strcat(reason_str, tmp_str, &len);
}
}
/* header type */
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, "\ntype: %s", mus_header_type_name(hdr->type));
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, "\ntype: %s", mus_header_type_name(hdr->type));
reason_str = mus_strcat(reason_str, tmp_str, &len);
- /* data format */
- if (!(mus_data_format_p(original_format)))
+ /* sample type */
+ if (!(mus_is_sample_type(original_sample_type)))
{
char *format_info;
- if (original_format != MUS_UNKNOWN)
- format_info = (char *)mus_data_format_name(original_format);
- else format_info = (char *)mus_header_original_format_name(mus_sound_original_format(filename),
- hdr->type);
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nformat looks bogus: %s", format_info);
+ if (original_sample_type != MUS_UNKNOWN_SAMPLE)
+ format_info = (char *)mus_sample_type_name(original_sample_type);
+ else format_info = (char *)mus_header_original_sample_type_name(mus_sound_original_sample_type(filename), hdr->type);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nformat looks bogus: %s", format_info);
}
- else mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nformat: %s", (char *)mus_data_format_name(original_format));
+ else snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nformat: %s", (char *)mus_sample_type_name(original_sample_type));
reason_str = mus_strcat(reason_str, tmp_str, &len);
/* samples */
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nlength: %.3f (" MUS_LD " samples, " MUS_LD " bytes total)",
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nlength: %.3f (%lld samples, %lld bytes total)",
(float)((double)(hdr->samples) / (float)(hdr->chans * hdr->srate)),
hdr->samples,
mus_sound_length(filename));
@@ -3056,11 +2731,11 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
nsamp = swap_mus_long_t(hdr->samples);
if (nsamp < mus_sound_length(filename))
{
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: " MUS_LD , nsamp);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %lld" , nsamp);
reason_str = mus_strcat(reason_str, tmp_str, &len);
if ((better_chans) && (better_srate))
{
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE,
+ snprintf(tmp_str, LABEL_BUFFER_SIZE,
", swapped length: %.3f / sample-size-in-bytes)",
(float)((double)nsamp / (float)(better_chans * better_srate)));
reason_str = mus_strcat(reason_str, tmp_str, &len);
@@ -3069,18 +2744,18 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
}
/* data location */
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, "\ndata location: " MUS_LD, hdr->data_location);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, "\ndata location: %lld", hdr->data_location);
reason_str = mus_strcat(reason_str, tmp_str, &len);
nsamp = swap_mus_long_t(hdr->data_location);
if ((nsamp > 0) &&
(nsamp <= 1024))
{
- mus_snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: " MUS_LD ")", nsamp);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %lld)", nsamp);
reason_str = mus_strcat(reason_str, tmp_str, &len);
}
(*info) = reason_str;
file_string = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(file_string, PRINT_BUFFER_SIZE,
+ snprintf(file_string, PRINT_BUFFER_SIZE,
"Bad header found on %s",
filename_without_directory(filename));
free(tmp_str);
@@ -3090,2112 +2765,349 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
#endif
-/* -------- view files shared code -------- */
-
-static void view_files_clear_selected_files(view_files_info *vdat);
-static int view_files_add_selected_file(view_files_info *vdat, vf_row *r);
-static int view_files_find_row(view_files_info *vdat, const char *name);
-static int view_files_info_size = 0;
-static view_files_info **view_files_infos = NULL;
-
-static XEN vf_open_file_watcher(XEN reason)
+char *dialog_get_title(widget_t dialog)
{
- int k;
- /* reasons are FILE_OPENED|CLOSED, but it's not worth the trouble of splitting them out here */
-
- /* loop through all vf dialogs ... */
- for (k = 0; k < view_files_info_size; k++)
- if ((view_files_infos[k]) &&
- (view_files_infos[k]->dialog) &&
- (widget_is_active(view_files_infos[k]->dialog)))
- {
- view_files_info *vdat;
- vdat = view_files_infos[k];
- vf_mix_insert_buttons_set_sensitive(vdat,
- ((vdat->currently_selected_files > 0) &&
- (any_selected_sound())));
- vf_open_remove_buttons_set_sensitive(vdat,
- (vdat->currently_selected_files > 0));
- }
- return(XEN_FALSE);
+#if USE_MOTIF
+ char *temp, *titlestr = NULL;
+ XmString title;
+ XtVaGetValues(dialog, XmNdialogTitle, &title, NULL);
+ temp = (char *)XmStringUnparse(title, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ if (temp)
+ {
+ titlestr = mus_strdup(temp);
+ XtFree(temp);
+ }
+ return(titlestr);
+#endif
+#if USE_GTK
+ return(mus_strdup(gtk_window_get_title(GTK_WINDOW(dialog))));
+#endif
+#if USE_NO_GUI
+ return(NULL); /* make the compiler happy */
+#endif
}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(vf_open_file_watcher_w, vf_open_file_watcher)
-#else
- #define vf_open_file_watcher_w vf_open_file_watcher
-#endif
-int view_files_dialog_list_length(void)
-{
- int i, n = 0;
- for (i = 0; i < view_files_info_size; i++)
- if ((view_files_infos[i]) &&
- (view_files_infos[i]->dialog))
- n++;
- return(n);
-}
+/* -------- info popup -------- */
+#if (!USE_NO_GUI)
-char **view_files_dialog_titles(void)
+static char *display_file_maxamps(const char *filename, int chans)
{
- int n;
- n = view_files_dialog_list_length();
- if (n > 0)
+ char *ampstr = NULL;
+ int i, len;
+ mus_float_t *vals;
+ mus_long_t *times;
+ len = chans * 32;
+ ampstr = (char *)calloc(len, sizeof(char));
+ vals = (mus_float_t *)calloc(chans, sizeof(mus_float_t));
+ times = (mus_long_t *)calloc(chans, sizeof(mus_long_t));
+ snprintf(ampstr, len, "maxamp%s: ", (chans > 1) ? "s" : "");
+ mus_sound_maxamps(filename, chans, vals, times);
+ for (i = 0; i < chans; i++)
{
- char **titles;
- int i, j = 0;
- titles = (char **)calloc(n + 1, sizeof(char *));
- for (i = 0; i < view_files_info_size; i++)
- if ((view_files_infos[i]) &&
- (view_files_infos[i]->dialog))
- titles[j++] = dialog_get_title(view_files_infos[i]->dialog);
- return(titles);
+ ampstr = mus_strcat(ampstr, prettyf(vals[i], 3), &len);
+ ampstr = mus_strcat(ampstr, " ", &len);
}
- return(NULL);
+ free(vals);
+ free(times);
+ return(ampstr);
}
-void view_files_start_dialog_with_title(const char *title)
+static char *display_sound_maxamps(snd_info *sp)
{
- int i;
- for (i = 0; i < view_files_info_size; i++)
- if ((view_files_infos[i]) &&
- (view_files_infos[i]->dialog))
- {
- char *dialog_title = NULL;
- dialog_title = dialog_get_title(view_files_infos[i]->dialog);
- if (mus_strcmp(title, dialog_title)) /* this includes NULL == NULL */
- {
- if (dialog_title) free(dialog_title);
- start_view_files_dialog_1(view_files_infos[i], true);
- return;
- }
- if (dialog_title) free(dialog_title);
- }
+ char *ampstr = NULL;
+ int i, len;
+ len = sp->nchans * 32;
+ ampstr = (char *)calloc(len, sizeof(char));
+ snprintf(ampstr, len, "maxamp%s: ", (sp->nchans > 1) ? "s" : "");
+ for (i = 0; i < sp->nchans; i++)
+ {
+ ampstr = mus_strcat(ampstr, prettyf(channel_maxamp(sp->chans[i], AT_CURRENT_EDIT_POSITION), 3), &len);
+ ampstr = mus_strcat(ampstr, " ", &len);
+ }
+ return(ampstr);
}
-view_files_info *new_view_files_dialog(void)
+void display_info(snd_info *sp)
{
- /* always returns a new (empty) file viewer -- changed 8-Jan-08 */
- int loc = -1;
- view_files_info *vdat;
-
- if (view_files_info_size == 0)
- {
- loc = 0;
- view_files_info_size = 4;
- view_files_infos = (view_files_info **)calloc(view_files_info_size, sizeof(view_files_info *));
- }
- else
+ #define INFO_BUFFER_SIZE 1024
+ if (sp)
{
- int i;
- for (i = 0; i < view_files_info_size; i++)
- if (!view_files_infos[i])
- {
- loc = i;
- break;
- }
- if (loc == -1)
- {
- loc = view_files_info_size;
- view_files_info_size += 4;
- view_files_infos = (view_files_info **)realloc(view_files_infos, view_files_info_size * sizeof(view_files_info *));
- for (i = loc; i < view_files_info_size; i++) view_files_infos[i] = NULL;
- }
- }
+ file_info *hdr;
+ char *comment = NULL, *ampstr = NULL, *buffer = NULL;
- view_files_infos[loc] = (view_files_info *)calloc(1, sizeof(view_files_info));
- vdat = view_files_infos[loc];
- vdat->index = loc;
- vdat->dialog = NULL_WIDGET;
- vdat->file_list = NULL_WIDGET;
- vdat->file_list_holder = NULL_WIDGET;
- vdat->file_list_entries = NULL;
- vdat->size = 0;
- vdat->end = -1;
- vdat->names = NULL;
- vdat->full_names = NULL;
- vdat->selected_files = NULL;
- vdat->selected_files_size = 0;
- vdat->location_choice = VF_AT_CURSOR;
- vdat->error_p = false;
- vdat->need_update = false;
- vdat->dirs_size = 0;
- vdat->dirs = NULL;
- vdat->dir_names = NULL;
- vdat->amp = 1.0;
- vdat->speed = 1.0;
- vdat->amp_env = default_env(1.0, 1.0);
- vdat->sort_items_size = 0;
- vdat->sort_items = NULL;
- vdat->speed_style = speed_control_style(ss);
+ hdr = sp->hdr;
+ buffer = (char *)calloc(INFO_BUFFER_SIZE, sizeof(char));
-#if USE_GTK
- vdat->at_sample_text_handler_id = 0;
- vdat->at_mark_text_handler_id = 0;
- vdat->at_sample_button_handler_id = 0;
- vdat->at_mark_button_handler_id = 0;
- vdat->add_text_handler_id = 0;
-#endif
+ snprintf(buffer, INFO_BUFFER_SIZE,
+ "srate: %d\nchans: %d\nlength: %.3f (%lld %s)\n%s\n",
+ snd_srate(sp),
+ sp->nchans,
+ (double)(current_samples(sp->chans[0])) / (double)snd_srate(sp),
+ current_samples(sp->chans[0]),
+ (sp->nchans == 1) ? "samples" : "framples",
+ ampstr = display_sound_maxamps(sp));
+ post_it(sp->short_filename, buffer);
+ if (ampstr) free(ampstr);
- /* don't clear at this point! */
- view_files_infos[loc]->currently_selected_files = 0;
- view_files_infos[loc]->sorter = view_files_sort(ss);
- return(view_files_infos[loc]);
-}
+ snprintf(buffer, INFO_BUFFER_SIZE, "\n----------------------------------------\n%s:", sp->filename);
+ post_it_append(buffer);
+ snprintf(buffer, INFO_BUFFER_SIZE, "\n type: %s\n format: %s\n written: %s\n",
+ mus_header_type_name(hdr->type),
+ mus_sample_type_name(hdr->sample_type),
+ snd_strftime(STRFTIME_FORMAT, sp->write_date));
+ post_it_append(buffer);
-static int vf_dialog_to_index(widget_t dialog)
-{
- int i;
- if ((!dialog) &&
- (view_files_infos[0]) &&
- (view_files_infos[0]->dialog))
- return(0);
- for (i = 0; i < view_files_info_size; i++)
- if ((view_files_infos[i]) &&
- (view_files_infos[i]->dialog == dialog))
- return(i);
- return(-1);
-}
+ if (hdr->srate != snd_srate(sp))
+ {
+ snprintf(buffer, INFO_BUFFER_SIZE, " original srate: %d\n", hdr->srate);
+ post_it_append(buffer);
+ }
+ if (hdr->chans != sp->nchans)
+ {
+ snprintf(buffer, INFO_BUFFER_SIZE, " original chans: %d\n", hdr->chans);
+ post_it_append(buffer);
+ }
-static view_files_info *vf_dialog_to_info(widget_t dialog)
-{
- int index;
- index = vf_dialog_to_index(dialog);
- if (index >= 0)
- return(view_files_infos[index]);
- return(NULL);
-}
+ comment = hdr->comment;
+ while ((comment) && (*comment) &&
+ (((*comment) == '\n') ||
+ ((*comment) == '\t') ||
+ ((*comment) == ' ') ||
+ ((*comment) == '\xd')))
+ comment++;
+ if ((comment) && (*comment))
+ {
+ snprintf(buffer, INFO_BUFFER_SIZE, " comment: \"%s\"\n", comment);
+ post_it_append(buffer);
+ }
+ if (mus_sound_maxamp_exists(sp->filename))
+ {
+ int i;
+ bool edits = false;
+ for (i = 0; i < sp->nchans; i++)
+ if (sp->chans[i]->edit_ctr > 0)
+ {
+ edits = true;
+ break;
+ }
-static char **vf_selected_files(view_files_info *vdat)
-{
- int len;
- char **files = NULL;
- len = vdat->currently_selected_files;
- if (len > 0)
- {
- int i;
- files = (char **)calloc(len, sizeof(char *));
- for (i = 0; i < len; i++)
- files[i] = mus_strdup(vdat->full_names[vdat->selected_files[i]]);
+ if (edits)
+ {
+ ampstr = display_file_maxamps(sp->filename, sp->nchans);
+ if (ampstr)
+ {
+ snprintf(buffer, INFO_BUFFER_SIZE, " original %s\n", ampstr);
+ post_it_append(buffer);
+ free(ampstr);
+ }
+ }
+ }
+ free(buffer);
}
- return(files);
}
+#endif
-static char **view_files_selected_files(widget_t dialog, int *len)
-{
- /* free result */
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- {
- (*len) = vdat->currently_selected_files;
- return(vf_selected_files(vdat));
- }
- (*len) = 0;
- return(NULL);
-}
+/* -------- extlang connections -------- */
-static void view_files_run_select_hook(widget_t dialog, const char *selected_file);
-static char **view_files_set_selected_files(widget_t dialog, char **files, int len)
+static Xen g_add_sound_file_extension(Xen ext)
{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- {
- int i;
- view_files_clear_selected_files(vdat);
- for (i = 0; i < len; i++)
- if (files[i])
- {
- int loc;
- loc = view_files_find_row(vdat, (const char *)(files[i]));
- if (loc >= 0)
- {
- view_files_add_selected_file(vdat, vdat->file_list_entries[loc]);
- view_files_run_select_hook(vdat->dialog, (const char *)(files[i]));
- }
- }
- vf_mix_insert_buttons_set_sensitive(vdat,
- ((vdat->currently_selected_files > 0) &&
- (any_selected_sound())));
- vf_open_remove_buttons_set_sensitive(vdat,
- (vdat->currently_selected_files > 0));
- }
- return(files);
+ #define H_add_sound_file_extension "(" S_add_sound_file_extension " ext): add the file extension 'ext' to the list of sound file extensions"
+ Xen_check_type(Xen_is_string(ext), ext, 1, S_add_sound_file_extension, "a string");
+ add_sound_file_extension(Xen_string_to_C_string(ext));
+ return(ext);
}
-static char **view_files_files(widget_t dialog, int *len)
+static Xen g_sound_file_extensions(void)
{
- /* don't free result! */
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- {
- (*len) = vdat->end + 1;
- return(vdat->full_names);
- }
- (*len) = 0;
- return(NULL);
+ #define H_sound_file_extensions "(" S_sound_file_extensions "): list of current sound file extensions (used \
+by the just-sounds file filters)"
+
+ Xen res = Xen_empty_list;
+ int i;
+ for (i = 0; i < sound_file_extensions_end; i++)
+ res = Xen_cons(C_string_to_Xen_string(sound_file_extensions[i]),
+ res);
+ return(res);
}
-static char **view_files_set_files(widget_t dialog, char **files, int len)
+static Xen g_set_sound_file_extensions(Xen lst)
{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- {
- int i;
- view_files_clear_selected_files(vdat);
- view_files_clear_list(vdat);
- if (len > 0)
- {
- for (i = 0; i < len; i++)
- if (files[i])
- view_files_add_file_or_directory(vdat, (const char *)(files[i]));
- }
- view_files_display_list(vdat);
- }
- return(files);
+ int i, len;
+ for (i = 0; i < sound_file_extensions_end; i++)
+ if (sound_file_extensions[i])
+ {
+ free(sound_file_extensions[i]);
+ sound_file_extensions[i] = NULL;
+ }
+ sound_file_extensions_end = 0;
+ default_sound_file_extensions = 0;
+ len = Xen_list_length(lst);
+ for (i = 0; i < len; i++)
+ if (!(Xen_is_string(Xen_list_ref(lst, i))))
+ {
+ Xen_check_type(0, Xen_list_ref(lst, i), i, S_set S_sound_file_extensions, "a filename extension (a string like \"snd\")");
+ return(Xen_false);
+ }
+ for (i = 0; i < len; i++)
+ add_sound_file_extension(Xen_string_to_C_string(Xen_list_ref(lst, i)));
+ return(lst);
}
-void vf_mix_insert_buttons_set_sensitive(view_files_info *vdat, bool sensitive)
+static Xen g_file_write_date(Xen file)
{
- if (vdat->mixB)
- {
- set_sensitive(vdat->mixB, sensitive);
- set_sensitive(vdat->insertB, sensitive);
- }
-}
+ #if HAVE_RUBY
+ #define write_date_equivalent "Equivalent to Ruby's File.mtime(file)"
+ #endif
+ #if HAVE_FORTH
+ #define write_date_equivalent "Equivalent to Forth's file-mtime"
+ #endif
-void vf_open_remove_buttons_set_sensitive(view_files_info *vdat, bool sensitive)
-{
- if (vdat->openB)
- {
- set_sensitive(vdat->removeB, sensitive);
- set_sensitive(vdat->openB, sensitive);
- }
-}
+ #if HAVE_SCHEME
+ #define write_date_equivalent ""
+ #endif
+ #define S_file_write_date "file-write-date"
+#ifndef __GNUC__
+ #define H_file_write_date "(" S_file_write_date " file): write date of file"
+#else
+ #define H_file_write_date "(" S_file_write_date " file): write date in the same format as \
+current-time:\n(strftime \"%a %d-%b-%Y %H:%M %Z\" (localtime (" S_file_write_date " \"oboe.snd\")))\n" write_date_equivalent
+#endif
-#if (!HAVE_FAM)
-void vf_clear_button_set_sensitive(view_files_info *vdat, bool sensitive)
-{
- if (vdat->clearB)
- set_sensitive(vdat->clearB, sensitive);
+ time_t date;
+ Xen_check_type(Xen_is_string(file), file, 1, S_file_write_date, "a string");
+ date = file_write_date(Xen_string_to_C_string(file));
+ return(C_int_to_Xen_integer(date));
}
-#endif
-static void view_files_clear_selected_files(view_files_info *vdat)
-{
- int len;
- len = vdat->currently_selected_files;
- if (len > 0)
- {
- int i;
- for (i = 0; i < len; i++)
- {
- vf_row *r;
- r = vdat->file_list_entries[vdat->selected_files[i]];
- if (r)
- vf_unhighlight_row(r->nm, r->rw);
- }
- }
- vdat->currently_selected_files = 0;
- vf_mix_insert_buttons_set_sensitive(vdat, false);
- vf_open_remove_buttons_set_sensitive(vdat, false);
-}
-
-
-static void view_files_unselect_file(view_files_info *vdat, vf_row *r)
-{
- vf_unhighlight_row(r->nm, r->rw);
- if (vdat->currently_selected_files > 1)
- {
- /* need to fixup selected_files list */
- int i, new_loc = 0;
- for (i = 0; i < vdat->currently_selected_files; i++)
- if (vdat->selected_files[i] != r->pos)
- vdat->selected_files[new_loc++] = vdat->selected_files[i];
- }
- vdat->currently_selected_files--;
- if (vdat->currently_selected_files < 0)
- vdat->currently_selected_files = 0;
- if (vdat->currently_selected_files == 0)
- {
- vf_mix_insert_buttons_set_sensitive(vdat, false);
- vf_open_remove_buttons_set_sensitive(vdat, false);
- vf_unpost_info(vdat);
- }
-}
-
-
-static int view_files_add_selected_file(view_files_info *vdat, vf_row *r)
-{
- /* returns how many are now selected (counting new) */
- if (vdat->selected_files_size == 0)
- {
- vdat->selected_files_size = 4;
- vdat->selected_files = (int *)calloc(vdat->selected_files_size, sizeof(int));
- vdat->selected_files[0] = r->pos;
- vdat->currently_selected_files = 1;
- }
- else
- {
- if (vdat->currently_selected_files >= vdat->selected_files_size)
- {
- vdat->selected_files_size += 4;
- vdat->selected_files = (int *)realloc(vdat->selected_files, vdat->selected_files_size * sizeof(int));
- vdat->selected_files[vdat->currently_selected_files++] = r->pos;
- }
- else
- {
- vdat->selected_files[vdat->currently_selected_files++] = r->pos;
- }
- }
- vf_highlight_row(r->nm, r->rw);
- return(vdat->currently_selected_files);
-}
-
-
-static void vf_fixup_selected_files(view_files_info *vdat, char **saved_selected_files, int len)
-{
- /* various things change the order or contents of the files list, so the selected locs list needs to reflect that */
- int i, newly_selected = 0;
- for (i = 0; i < len; i++)
- {
- int j;
- for (j = 0; j <= vdat->end; j++)
- if ((vdat->full_names[j]) &&
- (strcmp(vdat->full_names[j], saved_selected_files[i]) == 0))
- {
- vf_row *old_r, *new_r;
- /* fprintf(stderr,"old %d at %d -> %d at %d\n", vdat->selected_files[i], i, j, newly_selected); */
- old_r = vdat->file_list_entries[vdat->selected_files[i]];
- vdat->selected_files[newly_selected++] = j;
- new_r = vdat->file_list_entries[j];
- if (new_r != old_r)
- {
- vf_highlight_row(new_r->nm, new_r->rw);
- vf_unhighlight_row(old_r->nm, old_r->rw);
- }
- break;
- }
- }
- vdat->currently_selected_files = newly_selected;
-}
-
-
-static int view_files_find_row(view_files_info *vdat, const char *name)
-{
- int i;
- if (vdat->names)
- for (i = 0; i <= vdat->end; i++)
- if ((vdat->names[i]) &&
- (strcmp(vdat->names[i], name) == 0))
- return(i);
- if (vdat->full_names)
- for (i = 0; i <= vdat->end; i++)
- if ((vdat->full_names[i]) &&
- (strcmp(vdat->full_names[i], name) == 0))
- return(i);
- return(-1);
-}
-
-
-void view_files_select(vf_row *r, bool add_to_selected)
-{
- view_files_info *vdat = (view_files_info *)(r->vdat);
- int i, curloc = -1;
-
- for (i = 0; i < vdat->currently_selected_files; i++)
- if (vdat->selected_files[i] == r->pos)
- {
- curloc = r->pos;
- break;
- }
- if (curloc == -1)
- {
- /* file not currently selected */
- if (!add_to_selected) /* not shift click, so remove all currently selected files first */
- view_files_clear_selected_files(vdat);
- view_files_add_selected_file(vdat, r);
- view_files_run_select_hook(vdat->dialog, vdat->full_names[r->pos]);
- }
- else
- {
- /* file already selected, so remove from selected files list */
- view_files_unselect_file(vdat, r);
- }
-
- if ((vdat->currently_selected_files == 0) ||
- ((vdat->currently_selected_files == 1) &&
- (!(plausible_sound_file_p(vdat->full_names[vdat->selected_files[0]])))))
- vf_unpost_info(vdat);
- else
- {
- if (vdat->currently_selected_files == 1)
- vf_post_info(vdat, vdat->selected_files[0]);
- else vf_post_selected_files_list(vdat);
- }
- vf_mix_insert_buttons_set_sensitive(vdat,
- ((vdat->currently_selected_files > 0) &&
- (any_selected_sound())));
- vf_open_remove_buttons_set_sensitive(vdat,
- (vdat->currently_selected_files > 0));
-}
-
-
-bool view_files_play(view_files_info *vdat, int pos, bool play)
-{
- static snd_info *play_sp;
- if (play)
- {
- if (play_sp)
- {
- if (play_sp->playing) return(true); /* can't play two of these at once */
- if ((vdat->names[pos] == NULL) ||
- (strcmp(play_sp->short_filename, vdat->names[pos]) != 0))
- {
- completely_free_snd_info(play_sp);
- play_sp = NULL;
- }
- }
- if ((!play_sp) &&
- (vdat->full_names[pos]))
- play_sp = make_sound_readable(vdat->full_names[pos], false);
- if (play_sp)
- {
- play_sp->short_filename = vdat->names[pos];
- play_sp->filename = NULL;
- /* pass view files dialog settings to play */
- play_sp->speed_control = vdat->speed;
- play_sp->amp_control = vdat->amp;
- play_sound(play_sp, 0, NO_END_SPECIFIED);
- }
- else return(true); /* can't find or setup file */
- }
- else
- { /* play toggled off */
- if ((play_sp) && (play_sp->playing))
- {
- stop_playing_sound(play_sp, PLAY_BUTTON_UNSET);
- vdat->current_play_button = NULL_WIDGET;
- }
- }
- return(false);
-}
-
-
-void view_files_unplay(void)
-{
- int k;
- for (k = 0; k < view_files_info_size; k++)
- if ((view_files_infos[k]) &&
- (view_files_infos[k]->dialog) &&
- (widget_is_active(view_files_infos[k]->dialog)))
- {
- view_files_info *vdat;
- vdat = view_files_infos[k];
- if ((vdat->current_play_button) &&
-#if USE_MOTIF
- (XmToggleButtonGetState(vdat->current_play_button) != XmUNSET)
-#else
- #if USE_GTK
- ((bool)gtk_toggle_button_get_active(GTK_TOGGLE_BUTTON(vdat->current_play_button)))
- #else
- (0)
- #endif
-#endif
- )
- {
- set_toggle_button(vdat->current_play_button, false, true, (void *)vdat);
- vdat->current_play_button = NULL_WIDGET;
- }
- }
-}
-
-
-void view_files_reflect_sort_items(void)
-{
- int i;
-#if USE_MOTIF || USE_GTK
- view_files_info *vdat;
- int j = 0, k;
-#endif
- if (view_files_info_size == 0) return;
- for (i = 0; i < ss->file_sorters_size; i++)
- {
- XEN ref;
- ref = XEN_VECTOR_REF(ss->file_sorters, i);
- if (XEN_PAIR_P(ref))
- {
-#if USE_MOTIF
- XmString s1;
- s1 = XmStringCreateLocalized((char *)XEN_TO_C_STRING(XEN_CAR(ref)));
- for (k = 0; k < view_files_info_size; k++)
- if ((view_files_infos[k]) &&
- (view_files_infos[k]->dialog))
- {
- vdat = view_files_infos[k];
- if (j >= vdat->sort_items_size)
- {
- int n = 0, k, old_size;
- Arg args[20];
- old_size = vdat->sort_items_size;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- vdat->sort_items_size += 4;
- vdat->sort_items = (Widget *)realloc(vdat->sort_items, vdat->sort_items_size * sizeof(Widget));
- for (k = old_size; k < vdat->sort_items_size; k++)
- vdat->sort_items[k] = XtCreateWidget("unused", xmPushButtonWidgetClass, vdat->smenu, args, n);
- }
- XtVaSetValues(vdat->sort_items[j],
- XmNlabelString, s1,
- XmNuserData, i + SORT_XEN, /* this is an index into the file_sorters list, not the widget list */
- NULL);
- XtManageChild(vdat->sort_items[j]);
- }
- j++;
- XmStringFree(s1);
-#else
- #if USE_GTK
- for (k = 0; k < view_files_info_size; k++)
- if ((view_files_infos[k]) &&
- (view_files_infos[k]->dialog))
- {
- vdat = view_files_infos[k];
- if (j >= vdat->sort_items_size)
- {
- int k, old_size;
- old_size = vdat->sort_items_size;
- vdat->sort_items_size += 4;
- vdat->sort_items = (GtkWidget **)realloc(vdat->sort_items, vdat->sort_items_size * sizeof(GtkWidget *));
- for (k = old_size; k < vdat->sort_items_size; k++)
- {
- vdat->sort_items[k] = gtk_menu_item_new_with_label("unused");
- gtk_menu_shell_append(GTK_MENU_SHELL(vdat->smenu), vdat->sort_items[i]);
- }
- }
- set_menu_label(vdat->sort_items[j],
- XEN_TO_C_STRING(XEN_CAR(ref)));
- {
- pointer_or_int_t data;
- data = i + SORT_XEN;
- set_user_data(G_OBJECT(vdat->sort_items[j]),
- (gpointer)data); /* this is an index into the file_sorters list, not the widget list */
- }
- gtk_widget_show(vdat->sort_items[j]);
- }
- j++;
- #endif
-#endif
- }
- }
-}
-
-
-/* (add-file-sorter "duration"
- (lambda (lst)
- (sort lst
- (lambda (a b)
- (> (mus-sound-duration a) (mus-sound-duration b))))))
-
- */
-
-
-static void vf_add_file(view_files_info *vdat, const char *filename, const char *fullname)
-{
- vdat->end++;
- if (vdat->end >= vdat->size)
- {
- int new_size;
- new_size = vdat->size + 32;
- if (vdat->size == 0)
- {
- vdat->names = (char **)calloc(new_size, sizeof(char *));
- vdat->full_names = (char **)calloc(new_size, sizeof(char *));
- }
- else
- {
- int i;
- vdat->names = (char **)realloc(vdat->names, new_size * sizeof(char *));
- vdat->full_names = (char **)realloc(vdat->full_names, new_size * sizeof(char *));
- for (i = vdat->size; i < new_size; i++)
- {
- vdat->names[i] = NULL;
- vdat->full_names[i] = NULL;
- }
- }
- if (vdat->file_list_entries == NULL)
- vdat->file_list_entries = (vf_row **)calloc(new_size, sizeof(vf_row *));
- else
- {
- int i;
- vdat->file_list_entries = (vf_row **)realloc(vdat->file_list_entries, new_size * sizeof(vf_row *));
- for (i = vdat->size; i < new_size; i++) vdat->file_list_entries[i] = NULL;
- }
- vdat->size = new_size;
- }
- vdat->names[vdat->end] = mus_strdup(filename);
- vdat->full_names[vdat->end] = mus_strdup(fullname);
-}
-
-
-void add_file_to_view_files_list(view_files_info *vdat, const char *filename, const char *fullname)
-{
- int row;
-
- row = view_files_find_row(vdat, filename);
- if (row != -1)
- {
- if ((vdat->dialog) &&
- (widget_is_active(vdat->dialog)) &&
- (vdat->file_list_entries[row]))
- {
- ensure_scrolled_window_row_visible(vdat->file_list, row, vdat->end + 1);
- vf_flash_row(vdat->file_list_entries[row]);
- }
- return;
- }
-
- errno = 0;
- if (!(mus_file_probe(fullname)))
- {
- char *msg;
- if ((vdat->dialog) &&
- (widget_is_active(vdat->dialog)))
- {
- if (errno != 0)
- msg = mus_format("%s: %s", filename, strerror(errno));
- else msg = mus_format("%s does not exist", filename);
- vf_post_add_error(msg, vdat);
- free(msg);
- }
- return;
- }
-
- vf_add_file(vdat, filename, fullname);
-#if (!HAVE_FAM)
- if ((vdat->dialog) &&
- (widget_is_active(vdat->dialog)))
- vf_clear_button_set_sensitive(vdat, true);
-#endif
-}
-
-
-static void view_files_unmonitor_directories(view_files_info *vdat)
-{
- if (vdat->dirs)
- {
- int i;
- for (i = 0; i < vdat->dirs_size; i++)
- if (vdat->dirs[i])
- {
- vdat->dirs[i] = fam_unmonitor_directory(vdat->dir_names[i], vdat->dirs[i]);
- free(vdat->dir_names[i]);
- vdat->dir_names[i] = NULL;
- }
- free(vdat->dirs);
- vdat->dirs = NULL;
- free(vdat->dir_names);
- vdat->dir_names = NULL;
- vdat->dirs_size = 0;
- }
-}
-
-
-#if HAVE_FAM
-static void vf_add_file_if_absent(view_files_info *vdat, const char *filename)
-{
- int row;
- row = view_files_find_row(vdat, filename);
- if (row == -1)
- {
- vf_add_file(vdat, filename_without_directory(filename), filename);
- vdat->need_update = true;
- }
-}
-
-
-static void vf_remove_file_if_present(view_files_info *vdat, const char *filename)
-{
- int i, row;
- row = view_files_find_row(vdat, filename);
- if (row != -1)
- {
- vdat->need_update = true;
-
- /* if deleted file is selected, unselect */
- for (i = 0; i < vdat->currently_selected_files; i++)
- if (vdat->selected_files[i] == row)
- {
- view_files_unselect_file(vdat, vdat->file_list_entries[row]);
- break;
- }
- }
-}
-
-
-static void vf_watch_directory(struct fam_info *fp, FAMEvent *fe)
-{
- view_files_info *vdat;
- if (!(sound_file_p(fe->filename))) return;
- vdat = (view_files_info *)(fp->data);
- switch (fe->code)
- {
- case FAMChanged:
- if (access(fe->filename, R_OK) == 0)
- vf_add_file_if_absent(vdat, fe->filename);
- else vf_remove_file_if_present(vdat, fe->filename);
- break;
-
- case FAMDeleted:
- case FAMMoved:
- /* it's an existing file that is moved? -- I see the old name?? */
- vf_remove_file_if_present(vdat, fe->filename);
- break;
-
- case FAMCreated:
- vf_add_file_if_absent(vdat, fe->filename);
- break;
-
- default:
- /* ignore the rest */
- break;
- }
- if (vdat->need_update)
- {
- view_files_update_list(vdat);
- vdat->need_update = false;
- if ((vdat->dialog) &&
- (widget_is_active(vdat->dialog)))
- view_files_display_list(vdat);
- }
-}
-#else
-static void vf_watch_directory(struct fam_info *fp, FAMEvent *fe) {}
-#endif
-
-
-static void view_files_monitor_directory(view_files_info *vdat, const char *dirname)
-{
- int i, loc = -1;
- if (vdat->dirs)
- {
- for (i = 0; i < vdat->dirs_size; i++)
- if (vdat->dirs[i])
- {
- if (mus_strcmp(vdat->dir_names[i], dirname)) /* this was reversed?? */
- return;
- }
- else
- {
- loc = i;
- break;
- }
- if (loc == -1)
- {
- loc = vdat->dirs_size;
- vdat->dirs_size += 4;
- vdat->dirs = (fam_info **)realloc(vdat->dirs, vdat->dirs_size * sizeof(fam_info *));
- vdat->dir_names = (char **)realloc(vdat->dir_names, vdat->dirs_size * sizeof(char *));
- for (i = loc; i < vdat->dirs_size; i++)
- {
- vdat->dirs[i] = NULL;
- vdat->dir_names[i] = NULL;
- }
- }
- }
- else
- {
- vdat->dirs_size = 4;
- loc = 0;
- vdat->dirs = (fam_info **)calloc(vdat->dirs_size, sizeof(fam_info *));
- vdat->dir_names = (char **)calloc(vdat->dirs_size, sizeof(char *));
- }
- redirect_snd_error_to(redirect_vf_post_error, (void *)vdat);
- vdat->dirs[loc] = fam_monitor_directory(dirname, (void *)vdat, vf_watch_directory);
- redirect_snd_error_to(NULL, NULL);
- if (vdat->dirs[loc])
- vdat->dir_names[loc] = mus_strdup(dirname);
-}
-
-
-static void dialog_set_title(widget_t dialog, const char *titlestr)
-{
-#if USE_MOTIF
- XmString title;
- title = XmStringCreateLocalized((char *)titlestr);
- XtVaSetValues(dialog, XmNdialogTitle, title, NULL);
- XmStringFree(title);
-#endif
-#if USE_GTK
- gtk_window_set_title(GTK_WINDOW(dialog), titlestr);
-#endif
-}
-
-
-char *dialog_get_title(widget_t dialog)
-{
-#if USE_MOTIF
- char *temp, *titlestr = NULL;
- XmString title;
- XtVaGetValues(dialog, XmNdialogTitle, &title, NULL);
- temp = (char *)XmStringUnparse(title, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- if (temp)
- {
- titlestr = mus_strdup(temp);
- XtFree(temp);
- }
- return(titlestr);
-#endif
-#if USE_GTK
- return(mus_strdup(gtk_window_get_title(GTK_WINDOW(dialog))));
-#endif
-#if USE_NO_GUI
- return(NULL); /* make the compiler happy */
-#endif
-}
-
-
-/* what about temps coming and going -- should we just add a need-update switch for later remanage? */
-/* remanagement only through start_view_files_dialog -- this file */
-/* perhaps ss->making|deleting_temp_file -> ignore this fam event? */
-
-void add_directory_to_view_files_list(view_files_info *vdat, const char *dirname)
-{
- /* I think all directory additions come through here */
- dir_info *sound_files = NULL;
-
- if ((dirname) && (dirname[strlen(dirname) - 1] != '/'))
- {
- char *add_slash;
- add_slash = mus_format("%s/", dirname);
- add_directory_to_view_files_list(vdat, add_slash);
- free(add_slash);
- }
- else
- {
- view_files_monitor_directory(vdat, dirname);
- sound_files = find_sound_files_in_dir(dirname);
- if ((sound_files) &&
- (sound_files->len > 0))
- {
- int i, dirs = 0, len = 16;
- for (i = 0; i < sound_files->len; i++)
- add_file_to_view_files_list(vdat, sound_files->files[i]->filename, sound_files->files[i]->full_filename);
- sound_files = free_dir_info(sound_files);
-
- /* fixup title */
- for (i = 0; i < vdat->dirs_size; i++)
- if (vdat->dir_names[i])
- {
- dirs++;
- len += mus_strlen(just_filename(vdat->dir_names[i]));
- }
- if ((dirs < 4) &&
- (len < 512))
- {
- int cur_dir = 0;
- char *titlestr = NULL, *dirstr;
- titlestr = (char *)calloc(len + dirs * 8, sizeof(char));
- strcat(titlestr, "Files: ");
- for (i = 0; i < vdat->dirs_size; i++)
- if (vdat->dir_names[i])
- {
- dirstr = just_filename(vdat->dir_names[i]);
- strcat(titlestr, dirstr);
- free(dirstr);
- cur_dir++;
- if (cur_dir < dirs)
- strcat(titlestr, ", ");
- }
- dialog_set_title(vdat->dialog, titlestr);
- free(titlestr);
- }
- }
- }
-}
-
-
-static void view_files_sort_list(view_files_info *vdat)
-{
- if (vdat->end >= 0)
- {
- sort_info **data;
- int i, len;
-
- len = vdat->end + 1;
- data = (sort_info **)calloc(len, sizeof(sort_info *));
-
- for (i = 0; i < len; i++)
- {
- data[i] = (sort_info *)calloc(1, sizeof(sort_info));
- data[i]->filename = vdat->names[i];
- data[i]->full_filename = vdat->full_names[i];
- }
-
- snd_sort(vdat->sorter, data, len);
-
- for (i = 0; i < len; i++)
- {
- vdat->names[i] = data[i]->filename;
- vdat->full_names[i] = data[i]->full_filename;
- free(data[i]);
- }
- free(data);
- }
-}
-
-
-void view_files_display_list(view_files_info *vdat)
-{
- int i;
- widget_t last_row = NULL_WIDGET; /* ignored in gtk version */
- vf_row *r;
-
- if (!vdat) return;
- if (!(vdat->dialog)) return;
-
- if (vdat->end >= 0)
- {
- int i, old_len;
- char **old_names = NULL;
-
- old_len = vdat->currently_selected_files;
- if (old_len > 0)
- old_names = vf_selected_files(vdat);
-
- view_files_sort_list(vdat);
- for (i = 0; i <= vdat->end; i++)
- {
- r = vdat->file_list_entries[i];
- if (!r)
- {
- r = view_files_make_row(vdat, last_row);
- vdat->file_list_entries[i] = r;
- r->pos = i;
- }
- set_button_label(r->nm, vdat->names[r->pos]);
- set_toggle_button(r->pl, false, false, (void *)vdat);
- if (!(widget_is_active(r->rw))) activate_widget(r->rw);
- last_row = r->rw;
- }
-
- if (old_names)
- {
- vf_fixup_selected_files(vdat, old_names, old_len);
- for (i = 0; i < old_len; i++) free(old_names[i]);
- free(old_names);
- }
- }
-
- for (i = vdat->end + 1; i < vdat->size; i++)
- {
- r = vdat->file_list_entries[i];
- if (r)
- {
- if (widget_is_active(r->rw))
- deactivate_widget(r->rw);
- }
- }
-
- if (!(widget_is_active(vdat->file_list)))
- activate_widget(vdat->file_list);
-}
-
-
-void view_files_clear_list(view_files_info *vdat)
-{
- int i;
- view_files_unmonitor_directories(vdat);
- if (vdat->names)
- {
- for (i = 0; i < vdat->size; i++)
- if (vdat->names[i])
- {
- free(vdat->names[i]);
- vdat->names[i] = NULL;
- free(vdat->full_names[i]);
- vdat->full_names[i] = NULL;
- }
- vdat->end = -1;
-#if (!HAVE_FAM)
- vf_clear_button_set_sensitive(vdat, false);
-#endif
- vdat->currently_selected_files = 0;
- }
-}
-
-
-void view_files_update_list(view_files_info *vdat)
-{
- /* here we need the file's full name */
- int i, old_len;
- char **old_names = NULL;
-
- old_len = vdat->currently_selected_files;
- if (old_len > 0)
- old_names = vf_selected_files(vdat);
-
- if (vdat->names)
- {
- int i, j;
- for (i = 0; i <= vdat->end; i++)
- if (vdat->names[i])
- {
- if (!(mus_file_probe(vdat->full_names[i])))
- {
- free(vdat->names[i]);
- vdat->names[i] = NULL;
- free(vdat->full_names[i]);
- vdat->full_names[i] = NULL;
- }
- }
-
- for (i = 0, j = 0; i <= vdat->end; i++)
- if (vdat->names[i])
- {
- if (i != j)
- {
- vdat->names[j] = vdat->names[i];
- vdat->names[i] = NULL;
- vdat->full_names[j] = vdat->full_names[i];
- vdat->full_names[i] = NULL;
- }
- j++;
- }
- vdat->end = j - 1;
-#if (!HAVE_FAM)
- vf_clear_button_set_sensitive(vdat, vdat->end >= 0);
-#endif
- }
-
- if (old_names)
- {
- vf_fixup_selected_files(vdat, old_names, old_len);
- for (i = 0; i < old_len; i++) free(old_names[i]);
- free(old_names);
- }
-}
-
-
-void vf_clear_error(view_files_info *vdat)
-{
- if (vdat->currently_selected_files == 1)
- vf_post_info(vdat, vdat->selected_files[0]);
- else
- {
- if (vdat->currently_selected_files == 0)
- vf_unpost_info(vdat);
- else vf_post_selected_files_list(vdat);
- }
- vdat->error_p = false;
-}
-
-
-int vf_mix(view_files_info *vdat)
-{
- int len, id_or_error = 0;
- snd_info *sp;
-
- sp = any_selected_sound();
- len = vdat->currently_selected_files;
-
- if ((len == 1) &&
- (snd_feq(vdat->amp, 1.0)) &&
- (snd_feq(vdat->speed, 1.0)) &&
- (default_env_p(vdat->amp_env)))
- id_or_error = mix_complete_file(sp, vdat->beg,
- vdat->full_names[vdat->selected_files[0]],
- with_mix_tags(ss), DONT_DELETE_ME, MIX_SETS_SYNC_LOCALLY, NULL);
- else
- {
- int i;
- bool err = false;
- char *tempfile;
- char **selected_files;
-
- selected_files = vf_selected_files(vdat);
- tempfile = scale_and_src(selected_files, len, sp->nchans, vdat->amp, vdat->speed, vdat->amp_env, &err);
-
- if (err)
- {
- vf_post_error(tempfile, vdat);
- id_or_error = MIX_FILE_NO_TEMP_FILE;
- }
- else
- {
- if (sp->nchans > 1)
- remember_temp(tempfile, sp->nchans);
- id_or_error = mix_complete_file(sp, vdat->beg, tempfile,
- with_mix_tags(ss),
- (sp->nchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
- MIX_SETS_SYNC_LOCALLY, NULL);
- }
- free(tempfile);
- for (i = 0; i < len; i++)
- free(selected_files[i]);
- free(selected_files);
- }
- return(id_or_error);
-}
-
-
-void view_files_mix_selected_files(widget_t w, view_files_info *vdat)
-{
- vdat->error_p = false;
- redirect_snd_error_to(redirect_vf_post_location_error, (void *)vdat);
- vdat->beg = vf_location(vdat);
- redirect_snd_error_to(NULL, NULL);
-
- if (!(vdat->error_p))
- {
- int id_or_error = 0;
-
- redirect_snd_error_to(redirect_vf_post_error, (void *)vdat);
- ss->requestor_dialog = w;
- ss->open_requestor_data = (void *)vdat;
- ss->open_requestor = FROM_VIEW_FILES_MIX_DIALOG;
- id_or_error = vf_mix(vdat);
-
- /* "id_or_error" here is either one of the mix id's or an error indication such as MIX_FILE_NO_MIX */
- /* the possible error conditions have been checked already, or go through snd_error */
-
- redirect_snd_error_to(NULL, NULL);
- if (id_or_error >= 0)
- {
- char *msg;
- if (vdat->currently_selected_files == 1)
- msg = mus_format("%s mixed in at " MUS_LD, vdat->names[vdat->selected_files[0]], vdat->beg);
- else msg = mus_format("selected files mixed in at " MUS_LD, vdat->beg);
- vf_post_error(msg, vdat);
- vdat->error_p = false;
- free(msg);
- }
- }
-}
-
-
-bool vf_insert(view_files_info *vdat)
-{
- int len;
- bool ok = false;
- snd_info *sp;
- sp = any_selected_sound();
-
- len = vdat->currently_selected_files;
- if ((len == 1) &&
- (snd_feq(vdat->amp, 1.0)) &&
- (snd_feq(vdat->speed, 1.0)) &&
- (default_env_p(vdat->amp_env)))
- ok = insert_complete_file(sp,
- vdat->full_names[vdat->selected_files[0]],
- vdat->beg,
- DONT_DELETE_ME);
- else
- {
- int i;
- bool err = false;
- char *tempfile;
- char **selected_files;
-
- selected_files = vf_selected_files(vdat);
- tempfile = scale_and_src(selected_files, len, sp->nchans, vdat->amp, vdat->speed, vdat->amp_env, &err);
-
- if (err)
- {
- vf_post_error(tempfile, vdat);
- ok = false;
- }
- else
- {
- vf_clear_error(vdat);
- if (sp->nchans > 1)
- remember_temp(tempfile, sp->nchans);
- ok = insert_complete_file(sp,
- tempfile,
- vdat->beg,
- (sp->nchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME);
- }
- free(tempfile);
- for (i = 0; i < len; i++)
- free(selected_files[i]);
- free(selected_files);
- }
- return(ok);
-}
-
-
-void view_files_insert_selected_files(widget_t w, view_files_info *vdat)
-{
- vdat->error_p = false;
- redirect_snd_error_to(redirect_vf_post_location_error, (void *)vdat);
- vdat->beg = vf_location(vdat);
- redirect_snd_error_to(NULL, NULL);
-
- if (!(vdat->error_p))
- {
- bool ok = false;
-
- redirect_snd_error_to(redirect_vf_post_error, (void *)vdat);
- redirect_snd_warning_to(redirect_vf_post_error, (void *)vdat);
- ss->requestor_dialog = w;
- ss->open_requestor = FROM_VIEW_FILES_INSERT_DIALOG;
- ss->open_requestor_data = (void *)vdat;
- ok = vf_insert(vdat);
- redirect_snd_error_to(NULL, NULL);
- redirect_snd_warning_to(NULL, NULL);
-
- if (ok)
- {
- char *msg;
- if (vdat->currently_selected_files == 1)
- msg = mus_format("%s inserted at " MUS_LD, vdat->names[vdat->selected_files[0]], vdat->beg);
- else msg = mus_format("selected files inserted at " MUS_LD, vdat->beg);
- vf_post_error(msg, vdat);
- vdat->error_p = false;
- free(msg);
- }
- /* else we've already posted whatever went wrong (make_file_info etc) */
- }
-}
-
-
-static mus_float_t view_files_amp(widget_t dialog)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- return(vdat->amp);
- return(0.0);
-}
-
-
-static mus_float_t view_files_set_amp(widget_t dialog, mus_float_t new_amp)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- vf_set_amp(vdat, new_amp);
- return(new_amp);
-}
-
-
-static mus_float_t view_files_speed(widget_t dialog)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- return(vdat->speed);
- return(1.0);
-}
-
-
-static mus_float_t view_files_set_speed(widget_t dialog, mus_float_t new_speed)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- vf_set_speed(vdat, new_speed);
- return(new_speed);
-}
-
-
-static speed_style_t view_files_speed_style(widget_t dialog)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- return(vdat->speed_style);
- return(SPEED_CONTROL_AS_FLOAT);
-}
-
-
-static speed_style_t view_files_set_speed_style(widget_t dialog, speed_style_t speed_style)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- {
- vdat->speed_style = speed_style;
- vf_set_speed(vdat, vdat->speed); /* update label etc */
- }
- return(speed_style);
-}
-
-
-static env *view_files_amp_env(widget_t dialog)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- return(vdat->amp_env);
- return(NULL);
-}
-
-
-static void view_files_set_amp_env(widget_t dialog, env *new_e)
-{
- vf_set_amp_env(vf_dialog_to_info(dialog), new_e);
-}
-
-
-static int view_files_local_sort(widget_t dialog)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- return(vdat->sorter);
- return(-1);
-}
-
-
-static int view_files_set_local_sort(widget_t dialog, int sort_choice)
-{
- view_files_info *vdat;
- vdat = vf_dialog_to_info(dialog);
- if (vdat)
- {
- vdat->sorter = sort_choice;
- view_files_display_list(vdat);
- vf_reflect_sort_choice_in_menu(vdat);
- }
- return(sort_choice);
-}
-
-
-static view_files_info *view_files_find_dialog(widget_t dialog)
-{
- int i;
- for (i = 0; i < view_files_info_size; i++)
- if ((view_files_infos[i]) &&
- (view_files_infos[i]->dialog == dialog))
- return(view_files_infos[i]);
- return(NULL);
-}
-
-
-widget_t start_view_files_dialog(bool managed, bool make_new)
-{
- int i;
- view_files_info *vdat = NULL;
-
- if (make_new)
- return(start_view_files_dialog_1(new_view_files_dialog(), managed));
-
- for (i = 0; i < view_files_info_size; i++)
- if ((view_files_infos[i]) &&
- (view_files_infos[i]->dialog))
- {
- vdat = view_files_infos[i];
- if (widget_is_active(vdat->dialog))
- break;
- }
-
- if (vdat)
- return(start_view_files_dialog_1(vdat, managed));
- return(start_view_files_dialog_1(new_view_files_dialog(), managed));
-}
-
-
-void save_view_files_dialogs(FILE *fd)
-{
-#if HAVE_EXTENSION_LANGUAGE
- int i;
- view_files_info *vdat;
- for (i = 0; i < view_files_info_size; i++)
- if ((view_files_infos[i]) &&
- (view_files_infos[i]->dialog) &&
- (widget_is_active(view_files_infos[i]->dialog)))
- {
- int k;
- vdat = view_files_infos[i];
-
-#if HAVE_SCHEME
- fprintf(fd, "(let ((vf (" S_view_files_dialog " #t #t)))\n");
-
- if (vdat->full_names)
- {
- fprintf(fd, " (set! (" S_view_files_files " vf) (list");
- for (k = 0; k <= vdat->end; k++)
- fprintf(fd, " \"%s\"", vdat->full_names[k]);
- fprintf(fd, "))\n");
- if (vdat->currently_selected_files > 0)
- {
- fprintf(fd, " (set! (" S_view_files_selected_files " vf) (list");
- for (k = 0; k < vdat->currently_selected_files; k++)
- fprintf(fd, " \"%s\"", vdat->full_names[vdat->selected_files[k]]);
- fprintf(fd, "))\n");
- }
- }
- if (!(snd_feq(vdat->amp, 1.0)))
- fprintf(fd, " (set! (" S_view_files_amp " vf) %.3f)\n", vdat->amp);
-
- if (!(snd_feq(vdat->speed, 1.0)))
- fprintf(fd, " (set! (" S_view_files_speed " vf) %.3f)\n", vdat->speed);
-
- if (!(default_env_p(vdat->amp_env)))
- fprintf(fd, " (set! (" S_view_files_amp_env " vf) %s)\n", env_to_string(vdat->amp_env));
-
- /* assume file-sorters are set up already */
- fprintf(fd, " (set! (" S_view_files_sort " vf) %d)\n", vdat->sorter);
- fprintf(fd, ")\n");
-#endif
-
-#if HAVE_RUBY
- fprintf(fd, "vf = view_files_dialog(true, true)\n");
-
- if (vdat->full_names)
- {
- fprintf(fd, " set_view_files_files(vf, [");
- for (k = 0; k < vdat->end; k++)
- fprintf(fd, "\"%s\", ", vdat->full_names[k]);
- fprintf(fd, "\"%s\"])\n", vdat->full_names[vdat->end]);
- if (vdat->currently_selected_files > 0)
- {
- fprintf(fd, " set_view_files_selected_files(vf, [");
- for (k = 0; k < vdat->currently_selected_files - 1; k++)
- fprintf(fd, "\"%s\", ", vdat->full_names[vdat->selected_files[k]]);
- fprintf(fd, "\"%s\"])\n", vdat->full_names[vdat->selected_files[vdat->currently_selected_files]]);
- }
- }
- if (!(snd_feq(vdat->amp, 1.0)))
- fprintf(fd, " set_view_files_amp(vf, %.3f)\n", vdat->amp);
-
- if (!(snd_feq(vdat->speed, 1.0)))
- fprintf(fd, " set_view_files_speed(vf, %.3f)\n", vdat->speed);
-
- if (!(default_env_p(vdat->amp_env)))
- fprintf(fd, " set_view_files_amp_env(vf, %s)\n", env_to_string(vdat->amp_env));
-
- /* assume file-sorters are set up already */
- fprintf(fd, " set_view_files_sort(vf, %d)\n", vdat->sorter);
- fprintf(fd, "\n");
-#endif
-
-#if HAVE_FORTH
- fprintf(fd, "#t #t view-files-dialog value vf\n");
-
- if (vdat->full_names)
- {
- fprintf(fd, " vf '(");
- for (k = 0; k <= vdat->end; k++)
- fprintf(fd, " \"%s\"", vdat->full_names[k]);
- fprintf(fd, " ) set-view-files-files drop\n");
- if (vdat->currently_selected_files > 0)
- {
- fprintf(fd, " vf '(");
- for (k = 0; k <= vdat->currently_selected_files; k++)
- fprintf(fd, " \"%s\"", vdat->full_names[vdat->selected_files[k]]);
- fprintf(fd, " ) set-view-files-selected-files drop\n");
- }
- }
- if (!(snd_feq(vdat->amp, 1.0)))
- fprintf(fd, " vf %.3f set-view-files-amp drop\n", vdat->amp);
-
- if (!(snd_feq(vdat->speed, 1.0)))
- fprintf(fd, " vf %.3f set-view-files-speed drop\n", vdat->speed);
-
- if (!(default_env_p(vdat->amp_env)))
- fprintf(fd, " vf %s set-view-files-amp-env drop\n", env_to_string(vdat->amp_env));
-
- /* assume file-sorters are set up already */
- fprintf(fd, " vf %d set-view-files-sort drop\n\n", vdat->sorter);
-#endif
- }
-#endif
-}
-
-
-void view_files_add_directory(widget_t dialog, const char *dirname)
-{
- view_files_info *vdat = NULL;
- char *full_filename;
-
- if (dialog)
- vdat = view_files_find_dialog(dialog);
- else
- {
- if (view_files_info_size > 0)
- vdat = view_files_infos[0];
- else
- {
- vdat = new_view_files_dialog();
- start_view_files_dialog_1(vdat, false);
- }
- }
-
- if (vdat)
- {
- full_filename = mus_expand_filename((const char *)dirname);
- if (!(mus_file_probe(full_filename)))
- {
- char *msg;
- if ((vdat->dialog) &&
- (widget_is_active(vdat->dialog)))
- {
- if (errno != 0)
- msg = mus_format("%s: %s", full_filename, strerror(errno));
- else msg = mus_format("%s does not exist", full_filename);
- vf_post_add_error(msg, vdat);
- free(msg);
- }
- }
- else
- {
- add_directory_to_view_files_list(vdat, full_filename);
- }
- free(full_filename);
- }
-}
-
-
-static void view_files_add_file(widget_t dialog, const char *filename)
-{
- view_files_info *vdat = NULL;
- char *full_filename;
-
- if (dialog)
- vdat = view_files_find_dialog(dialog);
- else
- {
- if (view_files_info_size > 0)
- vdat = view_files_infos[0];
- else
- {
- vdat = new_view_files_dialog();
- start_view_files_dialog_1(vdat, false);
- }
- }
-
- if (vdat)
- {
- full_filename = mus_expand_filename((const char *)filename);
- add_file_to_view_files_list(vdat, filename, full_filename);
- free(full_filename);
- }
-}
-
-
-void view_files_open_selected_files(view_files_info *vdat)
-{
- snd_info *sp = NULL;
- ss->open_requestor = FROM_VIEW_FILES;
-
- if (vdat->currently_selected_files > 0)
- {
- int i;
- for (i = 0; i < vdat->currently_selected_files; i++)
- sp = snd_open_file(vdat->full_names[vdat->selected_files[i]], FILE_READ_WRITE);
- if (sp) select_channel(sp, 0);
- }
-}
-
-
-void view_files_remove_selected_files(view_files_info *vdat)
-{
- int i, loc;
-
- for (i = 0; i < vdat->currently_selected_files; i++)
- {
- loc = vdat->selected_files[i];
- if (vdat->names[loc])
- {
- free(vdat->names[loc]);
- vdat->names[loc] = NULL;
- free(vdat->full_names[loc]);
- vdat->full_names[loc] = NULL;
- }
- }
-
- vdat->currently_selected_files = 0;
- vf_unpost_info(vdat);
- view_files_update_list(vdat);
- view_files_display_list(vdat);
-}
-
-
-char *view_files_find_any_directory(void)
-{
- /* find any active directory in any vf dialog */
- if (view_files_info_size > 0)
- {
- int j;
- for (j = 0; j < view_files_info_size; j++)
- {
- view_files_info *vdat;
- vdat = view_files_infos[j];
- if ((vdat) &&
- (vdat->dirs))
- {
- int i;
- for (i = 0; i < vdat->dirs_size; i++)
- if (vdat->dirs[i])
- return(vdat->dir_names[i]);
- }
- }
- }
- return(NULL);
-}
-
-
-
-/* -------- extlang connections -------- */
-
-/* -------- view-files variables -------- */
-
-static XEN g_view_files_dialog(XEN managed, XEN make_new)
-{
- widget_t w;
- bool new_dialog = false;
- #define H_view_files_dialog "(" S_view_files_dialog " :optional managed create-new-dialog): start the View Files dialog"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ARG_1, S_view_files_dialog, "a boolean");
- new_dialog = (XEN_TRUE_P(make_new));
- w = start_view_files_dialog(XEN_TO_C_BOOLEAN(managed), new_dialog);
- return(XEN_WRAP_WIDGET(w));
-}
-
-
-static XEN g_add_directory_to_view_files_list(XEN directory, XEN dialog)
-{
- #define H_add_directory_to_view_files_list "(" S_add_directory_to_view_files_list " dir :optional w): adds any sound files in 'dir' to the View:Files dialog"
-
- XEN_ASSERT_TYPE(XEN_STRING_P(directory), directory, XEN_ARG_1, S_add_directory_to_view_files_list, "a string");
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog) || XEN_NOT_BOUND_P(dialog), dialog, XEN_ARG_2, S_add_directory_to_view_files_list, "a view-files dialog widget");
-
- if (XEN_NOT_BOUND_P(dialog))
- view_files_add_directory(NULL_WIDGET, XEN_TO_C_STRING(directory));
- else view_files_add_directory((widget_t)(XEN_UNWRAP_WIDGET(dialog)), XEN_TO_C_STRING(directory));
- return(directory);
-}
-
-
-static XEN g_add_file_to_view_files_list(XEN file, XEN dialog)
-{
- #define H_add_file_to_view_files_list "(" S_add_file_to_view_files_list " file :optional w): adds file to the View:Files dialog's list"
- char *name = NULL;
-
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ARG_1, S_add_file_to_view_files_list, "a string");
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog) || XEN_NOT_BOUND_P(dialog), dialog, XEN_ARG_2, S_add_file_to_view_files_list, "a view-files dialog widget");
-
- name = mus_expand_filename(XEN_TO_C_STRING(file));
- if (mus_file_probe(name))
- {
- if (XEN_NOT_BOUND_P(dialog))
- view_files_add_file(NULL_WIDGET, name);
- else view_files_add_file((widget_t)(XEN_UNWRAP_WIDGET(dialog)), name);
- }
- if (name) free(name);
- return(file);
-}
-
-
-static XEN g_view_files_sort(XEN dialog)
-{
- #define H_view_files_sort "(" S_view_files_sort " :optional dialog): sort choice in View:files dialog."
- if (XEN_BOUND_P(dialog))
- {
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_view_files_sort, "a view-files dialog widget");
- return(C_TO_XEN_INT(view_files_local_sort((widget_t)(XEN_UNWRAP_WIDGET(dialog)))));
- }
- return(C_TO_XEN_INT(view_files_sort(ss)));
-}
-
-
-static XEN g_set_view_files_sort(XEN dialog, XEN val)
-{
- int choice;
- XEN sort_choice;
-
- if (XEN_BOUND_P(val)) sort_choice = val; else sort_choice = dialog;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(sort_choice), sort_choice, XEN_ARG_1, S_setB S_view_files_sort, "an integer");
-
- choice = XEN_TO_C_INT(sort_choice);
- if ((choice < 0) ||
- (choice >= (ss->file_sorters_size + SORT_XEN)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_view_files_sort, 2, sort_choice, "must be a valid file-sorter index");
-
- if (XEN_BOUND_P(val))
- {
- widget_t w;
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ARG_1, S_setB S_view_files_sort, "a view-files dialog widget");
- w = (widget_t)(XEN_UNWRAP_WIDGET(dialog));
- view_files_set_local_sort(w, choice);
- return(C_TO_XEN_INT((int)view_files_sort(ss)));
- }
- /* else set global (default) sort choice */
- set_view_files_sort(choice);
- return(C_TO_XEN_INT((int)view_files_sort(ss)));
-}
-
-
-static XEN g_view_files_amp(XEN dialog)
-{
- #define H_view_files_amp "(" S_view_files_amp " dialog): amp setting in the given View:Files dialog"
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_view_files_amp, "a view-files dialog widget");
- return(C_TO_XEN_DOUBLE(view_files_amp((widget_t)(XEN_UNWRAP_WIDGET(dialog)))));
-}
-
-
-static XEN g_view_files_set_amp(XEN dialog, XEN amp)
-{
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ARG_1, S_setB S_view_files_amp, "a view-files dialog widget");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(amp), amp, XEN_ARG_2, S_setB S_view_files_amp, "a number");
- view_files_set_amp((widget_t)(XEN_UNWRAP_WIDGET(dialog)), XEN_TO_C_DOUBLE(amp));
- return(amp);
-}
-
-
-static XEN g_view_files_speed(XEN dialog)
-{
- #define H_view_files_speed "(" S_view_files_speed " dialog): speed setting in the given View:Files dialog"
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_view_files_speed, "a view-files dialog widget");
- return(C_TO_XEN_DOUBLE(view_files_speed((widget_t)(XEN_UNWRAP_WIDGET(dialog)))));
-}
-
-
-static XEN g_view_files_set_speed(XEN dialog, XEN speed)
-{
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_setB S_view_files_speed, "a view-files dialog widget");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(speed), speed, XEN_ARG_2, S_setB S_view_files_speed, "a number");
- view_files_set_speed((widget_t)(XEN_UNWRAP_WIDGET(dialog)), XEN_TO_C_DOUBLE(speed));
- return(speed);
-}
-
-
-static XEN g_view_files_amp_env(XEN dialog)
-{
- #define H_view_files_amp_env "(" S_view_files_amp_env " dialog): amp env breakpoints in the given View:Files dialog"
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_view_files_amp_env, "a view-files dialog widget");
- return(env_to_xen(view_files_amp_env((widget_t)(XEN_UNWRAP_WIDGET(dialog)))));
-}
-
-
-static XEN g_view_files_set_amp_env(XEN dialog, XEN amp_env)
-{
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_setB S_view_files_amp_env, "a view-files dialog widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(amp_env), amp_env, XEN_ARG_2, S_setB S_view_files_amp_env, "an envelope");
- view_files_set_amp_env((widget_t)(XEN_UNWRAP_WIDGET(dialog)), xen_to_env(amp_env));
- return(amp_env);
-}
-
-
-static XEN g_view_files_speed_style(XEN dialog)
-{
- #define H_view_files_speed_style "(" S_view_files_speed_style " dialog): speed_style in use in the given View:Files dialog"
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_view_files_speed_style, "a view-files dialog widget");
- return(C_TO_XEN_INT((int)(view_files_speed_style((widget_t)(XEN_UNWRAP_WIDGET(dialog))))));
-}
-
-
-static XEN g_view_files_set_speed_style(XEN dialog, XEN speed_style)
-{
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_setB S_view_files_speed_style, "a view-files dialog widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(speed_style), speed_style, XEN_ARG_2, S_setB S_view_files_speed_style, "an int");
- view_files_set_speed_style((widget_t)(XEN_UNWRAP_WIDGET(dialog)), (speed_style_t)(XEN_TO_C_INT(speed_style)));
- return(speed_style);
-}
-
-
-static XEN g_view_files_selected_files(XEN dialog)
-{
- #define H_view_files_selected_files "(" S_view_files_selected_files " dialog): list of files currently selected in the given View:Files dialog"
- XEN result = XEN_EMPTY_LIST;
- char **selected_files;
- int i, len = 0;
-
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_view_files_selected_files, "a view-files dialog widget");
-
- selected_files = view_files_selected_files((widget_t)(XEN_UNWRAP_WIDGET(dialog)), &len);
- if ((selected_files) && (len > 0))
- {
- for (i = 0; i < len; i++)
- {
- result = XEN_CONS(C_TO_XEN_STRING(selected_files[i]), result);
- free(selected_files[i]);
- }
- free(selected_files);
- }
- return(result);
-}
-
-
-static XEN g_view_files_set_selected_files(XEN dialog, XEN files)
-{
- int i, len;
- char **cfiles = NULL;
-
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ARG_1, S_setB S_view_files_selected_files, "a view-files dialog widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(files), files, XEN_ARG_2, S_setB S_view_files_selected_files, "a list of files or directories");
-
- len = XEN_LIST_LENGTH(files);
- if (len > 0)
- {
- for (i = 0; i < len; i++)
- if (!(XEN_STRING_P(XEN_LIST_REF(files, i))))
- {
- XEN_ASSERT_TYPE(0, XEN_LIST_REF(files, i), i, S_setB S_view_files_selected_files, "a filename (string)");
- return(XEN_FALSE);
- }
- cfiles = (char **)calloc(len, sizeof(char *));
- for (i = 0; i < len; i++)
- cfiles[i] = (char *)XEN_TO_C_STRING(XEN_LIST_REF(files, i));
- view_files_set_selected_files((widget_t)(XEN_UNWRAP_WIDGET(dialog)), cfiles, len);
- free(cfiles);
- }
- return(files);
-}
-
-
-static XEN g_view_files_files(XEN dialog)
-{
- #define H_view_files_files "(" S_view_files_files " dialog): list of files currently available in the given View:Files dialog"
- XEN result = XEN_EMPTY_LIST;
- char **files;
- int i, len = 0;
-
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ONLY_ARG, S_view_files_files, "a view-files dialog widget");
-
- files = view_files_files((widget_t)(XEN_UNWRAP_WIDGET(dialog)), &len);
- if ((files) && (len > 0))
- for (i = 0; i < len; i++)
- result = XEN_CONS(C_TO_XEN_STRING(files[i]), result);
- return(result);
-}
-
-
-static XEN g_view_files_set_files(XEN dialog, XEN files)
-{
- int i, len = 0;
- char **cfiles = NULL;
-
- XEN_ASSERT_TYPE(XEN_WIDGET_P(dialog), dialog, XEN_ARG_1, S_setB S_view_files_files, "a view-files dialog widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(files), files, XEN_ARG_2, S_setB S_view_files_files, "a list of files or directories");
-
- len = XEN_LIST_LENGTH(files);
- if (len > 0)
- {
- for (i = 0; i < len; i++)
- if (!(XEN_STRING_P(XEN_LIST_REF(files, i))))
- {
- XEN_ASSERT_TYPE(0, XEN_LIST_REF(files, i), i, S_setB S_view_files_files, "a filename (string)");
- return(XEN_FALSE);
- }
- cfiles = (char **)calloc(len, sizeof(char *));
- for (i = 0; i < len; i++)
- cfiles[i] = (char *)XEN_TO_C_STRING(XEN_LIST_REF(files, i));
- }
- view_files_set_files((widget_t)(XEN_UNWRAP_WIDGET(dialog)), cfiles, len);
- if (cfiles) free(cfiles);
- return(files);
-}
-
-
-static XEN view_files_select_hook;
-
-static void view_files_run_select_hook(widget_t dialog, const char *selected_file)
-{
- if (XEN_HOOKED(view_files_select_hook))
- run_hook(view_files_select_hook,
- XEN_LIST_2(XEN_WRAP_WIDGET(dialog),
- C_TO_XEN_STRING(selected_file)),
- S_view_files_select_hook);
-}
-
-
-static XEN g_add_sound_file_extension(XEN ext)
-{
- #define H_add_sound_file_extension "(" S_add_sound_file_extension " ext): add the file extension 'ext' to the list of sound file extensions"
- XEN_ASSERT_TYPE(XEN_STRING_P(ext), ext, XEN_ONLY_ARG, S_add_sound_file_extension, "a string");
- add_sound_file_extension(XEN_TO_C_STRING(ext));
- return(ext);
-}
-
-
-static XEN g_sound_file_extensions(void)
-{
- #define H_sound_file_extensions "(" S_sound_file_extensions "): list of current sound file extensions (used \
-by the just-sounds file filters)"
-
- XEN res = XEN_EMPTY_LIST;
- int i;
- for (i = 0; i < sound_file_extensions_end; i++)
- res = XEN_CONS(C_TO_XEN_STRING(sound_file_extensions[i]),
- res);
- return(res);
-}
-
-
-static XEN g_set_sound_file_extensions(XEN lst)
-{
- int i, len;
- for (i = 0; i < sound_file_extensions_end; i++)
- if (sound_file_extensions[i])
- {
- free(sound_file_extensions[i]);
- sound_file_extensions[i] = NULL;
- }
- sound_file_extensions_end = 0;
- default_sound_file_extensions = 0;
- len = XEN_LIST_LENGTH(lst);
- for (i = 0; i < len; i++)
- if (!(XEN_STRING_P(XEN_LIST_REF(lst, i))))
- {
- XEN_ASSERT_TYPE(0, XEN_LIST_REF(lst, i), i, S_setB S_sound_file_extensions, "a filename extension (a string like \"snd\")");
- return(XEN_FALSE);
- }
- for (i = 0; i < len; i++)
- add_sound_file_extension(XEN_TO_C_STRING(XEN_LIST_REF(lst, i)));
- return(lst);
-}
-
-
-static XEN g_file_write_date(XEN file)
-{
- #if HAVE_RUBY
- #define write_date_equivalent "Equivalent to Ruby's File.mtime(file)"
- #endif
-
- #if HAVE_FORTH
- #define write_date_equivalent "Equivalent to Forth's file-mtime"
- #endif
-
- #if HAVE_SCHEME
- #define write_date_equivalent ""
- #endif
-
- #define S_file_write_date "file-write-date"
-#ifndef __GNUC__
- #define H_file_write_date "(" S_file_write_date " file): write date of file"
-#else
- #define H_file_write_date "(" S_file_write_date " file): write date in the same format as \
-current-time:\n(strftime \"%a %d-%b-%Y %H:%M %Z\" (localtime (" S_file_write_date " \"oboe.snd\")))\n" write_date_equivalent
-#endif
-
- time_t date;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ONLY_ARG, S_file_write_date, "a string");
- date = file_write_date(XEN_TO_C_STRING(file));
- return(C_TO_XEN_INT(date));
-}
-
-
-static XEN g_sound_loop_info(XEN snd)
+static Xen g_sound_loop_info(Xen snd)
{
#define H_sound_loop_info "(" S_sound_loop_info " :optional snd): return the sound's loop points as a \
list: (sustain-start sustain-end release-start release-end baseNote detune)"
int *res;
snd_info *sp;
- ASSERT_SOUND(S_sound_loop_info, snd, 1);
+ Snd_assert_sound(S_sound_loop_info, snd, 1);
sp = get_sp(snd);
if (sp == NULL)
return(snd_no_such_sound_error(S_sound_loop_info, snd));
res = sp->hdr->loops;
if (res)
- return(XEN_LIST_8(C_TO_XEN_INT(res[0]), C_TO_XEN_INT(res[1]), C_TO_XEN_INT(res[2]),
- C_TO_XEN_INT(res[3]), C_TO_XEN_INT(res[4]), C_TO_XEN_INT(res[5]),
- C_TO_XEN_INT(res[6]), C_TO_XEN_INT(res[7])));
- return(XEN_EMPTY_LIST);
+ return(Xen_list_8(C_int_to_Xen_integer(res[0]), C_int_to_Xen_integer(res[1]), C_int_to_Xen_integer(res[2]),
+ C_int_to_Xen_integer(res[3]), C_int_to_Xen_integer(res[4]), C_int_to_Xen_integer(res[5]),
+ C_int_to_Xen_integer(res[6]), C_int_to_Xen_integer(res[7])));
+ return(Xen_empty_list);
}
-static XEN g_set_sound_loop_info(XEN snd, XEN vals)
+static Xen g_set_sound_loop_info(Xen snd, Xen vals)
{
snd_info *sp;
char *tmp_file;
file_info *hdr;
- int type, len = 0;
+ mus_header_t type;
+ int len = 0;
- XEN start0 = XEN_UNDEFINED, end0 = XEN_UNDEFINED;
- XEN start1 = XEN_UNDEFINED, end1 = XEN_UNDEFINED;
- XEN mode0 = XEN_UNDEFINED, mode1 = XEN_UNDEFINED;
- XEN note = XEN_UNDEFINED, detune = XEN_UNDEFINED;
- XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(vals) || XEN_LIST_P_WITH_LENGTH(vals, len), vals, XEN_ARG_2, S_setB S_sound_loop_info, "a list");
+ Xen start0 = Xen_integer_zero, end0 = Xen_integer_zero;
+ Xen start1 = Xen_integer_zero, end1 = Xen_integer_zero;
+ Xen mode0 = Xen_integer_zero, mode1 = Xen_integer_zero;
+ Xen note = Xen_integer_zero, detune = Xen_integer_zero;
+ Xen_check_type((!Xen_is_bound(vals)) || (Xen_is_list(vals)), vals, 2, S_set S_sound_loop_info, "a list");
- if (XEN_NOT_BOUND_P(vals))
+ if (!Xen_is_bound(vals))
{
/* what is going on here? -- (set! (sound-loop-info) (list...))? */
- XEN_ASSERT_TYPE(XEN_LIST_P(snd), snd, XEN_ARG_1, S_setB S_sound_loop_info, "a list");
+ Xen_check_type(Xen_is_list(snd), snd, 1, S_set S_sound_loop_info, "a list");
vals = snd;
- len = XEN_LIST_LENGTH(vals);
- sp = get_sp(XEN_UNDEFINED);
+ sp = get_sp(Xen_undefined);
}
else
{
- ASSERT_SOUND(S_setB S_sound_loop_info, snd, 1);
+ Snd_assert_sound(S_set S_sound_loop_info, snd, 1);
sp = get_sp(snd);
}
+ len = Xen_list_length(vals);
if (sp == NULL)
- return(snd_no_such_sound_error(S_setB S_sound_loop_info, snd));
+ return(snd_no_such_sound_error(S_set S_sound_loop_info, snd));
if ((sp->user_read_only == FILE_READ_ONLY) ||
(sp->file_read_only == FILE_READ_ONLY))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_setB S_sound_loop_info ": ~S is write-protected"),
- C_TO_XEN_STRING(sp->filename)));
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_set S_sound_loop_info ": ~S is write-protected"),
+ C_string_to_Xen_string(sp->filename)));
hdr = sp->hdr;
if (len > 0)
{
- start0 = XEN_LIST_REF(vals, 0);
+ start0 = Xen_list_ref(vals, 0);
+ Xen_check_type(Xen_is_integer(start0), start0, 2, S_set S_sound_loop_info, "start0 must be an integer");
if (len > 1)
{
- end0 = XEN_LIST_REF(vals, 1);
+ end0 = Xen_list_ref(vals, 1);
+ Xen_check_type(Xen_is_integer(end0), end0, 2, S_set S_sound_loop_info, "end0 must be an integer");
if (len > 2)
{
- start1 = XEN_LIST_REF(vals, 2);
+ start1 = Xen_list_ref(vals, 2);
+ Xen_check_type(Xen_is_integer(start1), start1, 2, S_set S_sound_loop_info, "start1 must be an integer");
if (len > 3)
{
- end1 = XEN_LIST_REF(vals, 3);
+ end1 = Xen_list_ref(vals, 3);
+ Xen_check_type(Xen_is_integer(end1), end1, 2, S_set S_sound_loop_info, "end1 must be an integer");
if (len > 4)
{
- note = XEN_LIST_REF(vals, 4);
+ note = Xen_list_ref(vals, 4);
+ Xen_check_type(Xen_is_integer(note), note, 2, S_set S_sound_loop_info, "note must be an integer");
if (len > 5)
{
- detune = XEN_LIST_REF(vals, 5);
+ detune = Xen_list_ref(vals, 5);
+ Xen_check_type(Xen_is_integer(detune), detune, 2, S_set S_sound_loop_info, "detune must be an integer");
if (len > 6)
{
- mode0 = XEN_LIST_REF(vals, 6);
+ mode0 = Xen_list_ref(vals, 6);
+ Xen_check_type(Xen_is_integer(mode0), mode0, 2, S_set S_sound_loop_info, "mode0 must be an integer");
if (len > 7)
- mode1 = XEN_LIST_REF(vals, 7);
- }}}}}}}
+ {
+ mode1 = Xen_list_ref(vals, 7);
+ Xen_check_type(Xen_is_integer(mode1), mode1, 2, S_set S_sound_loop_info, "mode1 must be an integer");
+ }}}}}}}}
if (hdr->loops == NULL)
hdr->loops = (int *)calloc(MUS_LOOP_INFO_SIZE, sizeof(int));
else memset((void *)(hdr->loops), 0, MUS_LOOP_INFO_SIZE * sizeof(int));
- hdr->loops[0] = XEN_TO_C_INT_OR_ELSE(start0, 0);
- hdr->loops[1] = XEN_TO_C_INT_OR_ELSE(end0, 0);
- hdr->loops[2] = XEN_TO_C_INT_OR_ELSE(start1, 0);
- hdr->loops[3] = XEN_TO_C_INT_OR_ELSE(end1, 0);
+ hdr->loops[0] = Xen_integer_to_C_int(start0);
+ hdr->loops[1] = Xen_integer_to_C_int(end0);
+ hdr->loops[2] = Xen_integer_to_C_int(start1);
+ hdr->loops[3] = Xen_integer_to_C_int(end1);
if (len > 4)
{
- hdr->loops[4] = XEN_TO_C_INT_OR_ELSE(note, 60);
- hdr->loops[5] = XEN_TO_C_INT_OR_ELSE(detune, 0);
+ hdr->loops[4] = Xen_integer_to_C_int(note);
+ hdr->loops[5] = Xen_integer_to_C_int(detune);
}
if (len > 6)
{
- hdr->loops[6] = XEN_TO_C_INT_OR_ELSE(mode0, 0);
- hdr->loops[7] = XEN_TO_C_INT_OR_ELSE(mode1, 0);
+ hdr->loops[6] = Xen_integer_to_C_int(mode0);
+ hdr->loops[7] = Xen_integer_to_C_int(mode1);
}
else
{
- if (!(XEN_FALSE_P(end0))) hdr->loops[6] = 1;
- if (!(XEN_FALSE_P(end1))) hdr->loops[7] = 1;
+ if (!(Xen_is_false(end0))) hdr->loops[6] = 1;
+ if (!(Xen_is_false(end1))) hdr->loops[7] = 1;
}
mus_sound_set_loop_info(sp->filename, hdr->loops);
mus_header_set_aiff_loop_info(hdr->loops);
@@ -5217,18 +3129,18 @@ static XEN g_set_sound_loop_info(XEN snd, XEN vals)
{
io_error_t err;
err = save_edits_without_display(sp, tmp_file, type,
- hdr->format,
+ hdr->sample_type,
hdr->srate,
hdr->comment,
AT_CURRENT_EDIT_POSITION);
if ((err != IO_NO_ERROR) &&
(err != IO_SAVE_HOOK_CANCELLATION))
{
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_setB S_sound_loop_info ": can't save ~S, ~A"),
- C_TO_XEN_STRING(tmp_file),
- C_TO_XEN_STRING(snd_io_strerror())));
- return(XEN_FALSE); /* not executed -- just for emphasis */
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_set S_sound_loop_info ": can't save ~S, ~A"),
+ C_string_to_Xen_string(tmp_file),
+ C_string_to_Xen_string(snd_io_strerror())));
+ return(Xen_false); /* not executed -- just for emphasis */
}
sp->writing = true;
if (err == IO_SAVE_HOOK_CANCELLATION)
@@ -5236,36 +3148,36 @@ static XEN g_set_sound_loop_info(XEN snd, XEN vals)
else
{
err = move_file(tmp_file, sp->filename);
- if (SERIOUS_IO_ERROR(err))
+ if (is_serious_io_error(err))
{
free(tmp_file);
sp->writing = false;
- XEN_ERROR(CANT_UPDATE_FILE,
- XEN_LIST_4(C_TO_XEN_STRING(S_setB S_sound_loop_info ": can't update ~S: ~A ~A"),
- C_TO_XEN_STRING(sp->filename),
- C_TO_XEN_STRING(io_error_name(err)),
- C_TO_XEN_STRING(snd_io_strerror())));
- return(XEN_FALSE);
+ Xen_error(CANT_UPDATE_FILE,
+ Xen_list_4(C_string_to_Xen_string(S_set S_sound_loop_info ": can't update ~S: ~A ~A"),
+ C_string_to_Xen_string(sp->filename),
+ C_string_to_Xen_string(io_error_name(err)),
+ C_string_to_Xen_string(snd_io_strerror())));
+ return(Xen_false);
}
}
sp->writing = false;
if (err != IO_SAVE_HOOK_CANCELLATION)
snd_update(sp);
free(tmp_file);
- return((err == IO_NO_ERROR) ? XEN_TRUE : C_TO_XEN_INT((int)err));
+ return((err == IO_NO_ERROR) ? Xen_true : C_int_to_Xen_integer((int)err));
}
}
-static XEN g_soundfont_info(XEN snd)
+static Xen g_soundfont_info(Xen snd)
{
/* return all soundfont descriptors as list of lists: ((name start loopstart loopend)) */
#define H_soundfont_info "(" S_soundfont_info " :optional snd): list of lists describing snd as a soundfont. \
each inner list has the form: (name start loopstart loopend)"
- XEN inlist = XEN_EMPTY_LIST, outlist = XEN_EMPTY_LIST;
+ Xen outlist = Xen_empty_list;
snd_info *sp;
- ASSERT_SOUND(S_soundfont_info, snd, 1);
+ Snd_assert_sound(S_soundfont_info, snd, 1);
sp = get_sp(snd);
if (sp == NULL)
return(snd_no_such_sound_error(S_soundfont_info, snd));
@@ -5277,25 +3189,32 @@ each inner list has the form: (name start loopstart loopend)"
if (lim > 0)
for (i = lim - 1; i >= 0; i--)
{
- inlist = XEN_LIST_4(C_TO_XEN_STRING(mus_header_sf2_name(i)),
- C_TO_XEN_INT(mus_header_sf2_start(i)),
- C_TO_XEN_INT(mus_header_sf2_loop_start(i)),
- C_TO_XEN_INT(mus_header_sf2_end(i)));
- outlist = XEN_CONS(inlist, outlist);
+ Xen inlist;
+ inlist = Xen_list_4(C_string_to_Xen_string(mus_header_sf2_name(i)),
+ C_int_to_Xen_integer(mus_header_sf2_start(i)),
+ C_int_to_Xen_integer(mus_header_sf2_loop_start(i)),
+ C_int_to_Xen_integer(mus_header_sf2_end(i)));
+ outlist = Xen_cons(inlist, outlist);
}
}
return(outlist);
}
-static XEN g_sound_files_in_directory(XEN dirname)
+dir_info *find_sound_files_in_dir(const char *name)
+{
+ return(find_filtered_files_in_dir(name, JUST_SOUNDS_FILTER));
+}
+
+
+static Xen g_sound_files_in_directory(Xen dirname)
{
#define H_sound_files_in_directory "(" S_sound_files_in_directory " :optional (directory \".\")): return a list of the sound files in 'directory'"
char *name = NULL;
- XEN res = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(dirname), dirname, XEN_ONLY_ARG, S_sound_files_in_directory, "a string");
- if (XEN_STRING_P(dirname))
- name = mus_expand_filename(XEN_TO_C_STRING(dirname));
+ Xen res = Xen_empty_list;
+ Xen_check_type(Xen_is_string_or_unbound(dirname), dirname, 1, S_sound_files_in_directory, "a string");
+ if (Xen_is_string(dirname))
+ name = mus_expand_filename(Xen_string_to_C_string(dirname));
else name = mus_expand_filename(".");
if (name)
{
@@ -5305,8 +3224,8 @@ static XEN g_sound_files_in_directory(XEN dirname)
{
int i;
for (i = dp->len - 1; i >= 0; i--)
- res = XEN_CONS(C_TO_XEN_STRING(dp->files[i]->filename), res);
- dp = free_dir_info(dp);
+ res = Xen_cons(C_string_to_Xen_string(dp->files[i]->filename), res);
+ free_dir_info(dp);
}
free(name);
}
@@ -5316,394 +3235,240 @@ static XEN g_sound_files_in_directory(XEN dirname)
#define S_disk_kspace "disk-kspace"
-static XEN g_disk_kspace(XEN name)
+static Xen g_disk_kspace(Xen name)
{
#define H_disk_kspace "(" S_disk_kspace " filename): kbytes of space available on partition containing 'filename'"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, S_disk_kspace, "a string");
- return(C_TO_XEN_INT64_T(disk_kspace(XEN_TO_C_STRING(name))));
+ Xen_check_type(Xen_is_string(name), name, 1, S_disk_kspace, "a string");
+ return(C_llong_to_Xen_llong(disk_kspace(Xen_string_to_C_string(name))));
}
-static XEN g_open_file_dialog(XEN managed)
+static Xen g_open_file_dialog(Xen managed)
{
- widget_t w;
#define H_open_file_dialog "(" S_open_file_dialog " :optional (managed " PROC_TRUE ")): create the file dialog if needed and display it if 'managed'"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_open_file_dialog, "a boolean");
- w = make_open_file_dialog(FILE_READ_WRITE, (XEN_BOUND_P(managed)) ? XEN_TO_C_BOOLEAN(managed) : true);
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_open_file_dialog, "a boolean");
+ return(Xen_wrap_widget(make_open_file_dialog(FILE_READ_WRITE, (Xen_is_bound(managed)) ? Xen_boolean_to_C_bool(managed) : true)));
}
-static XEN g_mix_file_dialog(XEN managed)
+static Xen g_mix_file_dialog(Xen managed)
{
- widget_t w;
#define H_mix_file_dialog "(" S_mix_file_dialog " :optional (managed " PROC_TRUE ")): create the mix file dialog if needed and display it if 'managed'"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_mix_file_dialog, "a boolean");
- w = make_mix_file_dialog((XEN_BOUND_P(managed)) ? XEN_TO_C_BOOLEAN(managed) : true);
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_mix_file_dialog, "a boolean");
+ return(Xen_wrap_widget(make_mix_file_dialog((Xen_is_bound(managed)) ? Xen_boolean_to_C_bool(managed) : true)));
}
-static XEN g_insert_file_dialog(XEN managed)
+static Xen g_insert_file_dialog(Xen managed)
{
- widget_t w;
#define H_insert_file_dialog "(" S_insert_file_dialog " :optional (managed " PROC_TRUE ")): create the insert file dialog if needed and display it if 'managed'"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_insert_file_dialog, "a boolean");
- w = make_insert_file_dialog((XEN_BOUND_P(managed)) ? XEN_TO_C_BOOLEAN(managed) : true);
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_insert_file_dialog, "a boolean");
+ return(Xen_wrap_widget(make_insert_file_dialog((Xen_is_bound(managed)) ? Xen_boolean_to_C_bool(managed) : true)));
}
-static XEN g_edit_header_dialog(XEN snd_n)
+static Xen g_edit_header_dialog(Xen snd_n)
{
- widget_t w;
#define H_edit_header_dialog "(" S_edit_header_dialog " :optional snd): start the Edit Header dialog on sound snd"
snd_info *sp;
sp = get_sp(snd_n);
if ((sp == NULL) || (sp->inuse != SOUND_NORMAL))
return(snd_no_such_sound_error(S_edit_header_dialog, snd_n));
- w = edit_header(sp);
- return(XEN_WRAP_WIDGET(w));
+ return(Xen_wrap_widget(edit_header(sp)));
}
-static XEN g_save_selection_dialog(XEN managed)
+static Xen g_save_selection_dialog(Xen managed)
{
- widget_t w;
#define H_save_selection_dialog "(" S_save_selection_dialog " :optional managed): start the Selection Save-as dialog"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_save_selection_dialog, "a boolean");
- w = make_selection_save_as_dialog(XEN_TO_C_BOOLEAN(managed));
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_save_selection_dialog, "a boolean");
+ return(Xen_wrap_widget(make_selection_save_as_dialog(Xen_boolean_to_C_bool(managed))));
}
-static XEN g_save_region_dialog(XEN managed)
+static Xen g_save_region_dialog(Xen managed)
{
- widget_t w;
#define H_save_region_dialog "(" S_save_region_dialog " :optional managed): start the Region Save-as dialog"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_save_region_dialog, "a boolean");
- w = make_region_save_as_dialog(XEN_TO_C_BOOLEAN(managed));
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_save_region_dialog, "a boolean");
+ return(Xen_wrap_widget(make_region_save_as_dialog(Xen_boolean_to_C_bool(managed))));
}
-static XEN g_save_sound_dialog(XEN managed)
+static Xen g_save_sound_dialog(Xen managed)
{
- widget_t w;
#define H_save_sound_dialog "(" S_save_sound_dialog " :optional managed): start the File Save-as dialog"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_save_sound_dialog, "a boolean");
- w = make_sound_save_as_dialog(XEN_TO_C_BOOLEAN(managed));
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_save_sound_dialog, "a boolean");
+ return(Xen_wrap_widget(make_sound_save_as_dialog(Xen_boolean_to_C_bool(managed))));
}
-static XEN g_info_dialog(XEN subject, XEN msg)
+static Xen g_info_dialog(Xen subject, Xen msg)
{
- widget_t w;
#define H_info_dialog "(" S_info_dialog " subject message): start the Info window with subject and message"
- XEN_ASSERT_TYPE(XEN_STRING_P(subject), subject, XEN_ARG_1, S_info_dialog, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(msg), msg, XEN_ARG_2, S_info_dialog, "a string");
- w = post_it(XEN_TO_C_STRING(subject), XEN_TO_C_STRING(msg));
- return(XEN_WRAP_WIDGET(w));
-}
-
-
-static XEN g_new_sound_dialog(XEN managed)
-{
- widget_t w;
-#define H_new_sound_dialog "(" S_new_sound_dialog " :optional managed): start the File New sound dialog"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_new_sound_dialog, "a boolean");
- w = make_new_file_dialog(XEN_TO_C_BOOLEAN(managed));
- return(XEN_WRAP_WIDGET(w));
-}
-
-
-/* -------- file-filters and file-sorters -------- */
-
-#define INITIAL_FILE_FILTERS_SIZE 4
-#define INITIAL_FILE_SORTERS_SIZE 4
-
-static XEN g_expand_vector(XEN vector, int new_size)
-{
- int i, len;
- XEN new_vect;
- len = XEN_VECTOR_LENGTH(vector);
- new_vect = XEN_MAKE_VECTOR(new_size, XEN_FALSE);
- XEN_PROTECT_FROM_GC(new_vect);
- for (i = 0; i < len; i++)
- {
- XEN_VECTOR_SET(new_vect, i, XEN_VECTOR_REF(vector, i));
- XEN_VECTOR_SET(vector, i, XEN_FALSE);
- }
-#if HAVE_RUBY || HAVE_FORTH
- XEN_UNPROTECT_FROM_GC(vector);
-#endif
- return(new_vect);
-}
-
-
-static bool file_filter_ok(XEN name, XEN proc, const char *caller)
-{
- char *errmsg;
- XEN errstr;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, caller, "a string");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(proc), proc, XEN_ARG_2, caller, "a procedure of 1 arg (filename)");
- errmsg = procedure_ok(proc, 1, caller, "function", 2);
- if (errmsg)
- {
- errstr = C_TO_XEN_STRING(errmsg);
- free(errmsg);
- snd_bad_arity_error(caller, errstr, proc);
- return(false);
- }
- return(true);
-}
-
-
-static XEN g_add_file_filter(XEN name, XEN proc)
-{
- #define H_add_file_filter "(" S_add_file_filter " name proc) -- add proc with identifier name to file filter list"
- int i, len;
- if (file_filter_ok(name, proc, S_add_file_filter))
- {
- len = ss->file_filters_size;
- for (i = 0; i < len; i++)
- {
- if (XEN_FALSE_P(XEN_VECTOR_REF(ss->file_filters, i)))
- {
- XEN_VECTOR_SET(ss->file_filters, i, XEN_LIST_2(name, proc));
- return(C_TO_XEN_INT(i));
- }
- }
- ss->file_filters_size = len * 2;
- ss->file_filters = g_expand_vector(ss->file_filters, ss->file_filters_size);
- XEN_VECTOR_SET(ss->file_filters, len, XEN_LIST_2(name, proc));
- return(C_TO_XEN_INT(len));
- }
- return(XEN_FALSE);
-}
-
-
-static XEN g_delete_file_filter(XEN index)
-{
- #define H_delete_file_filter "(" S_delete_file_filter " index) -- delete proc with identifier index from file filter list"
- int pos;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(index), index, XEN_ONLY_ARG, S_delete_file_filter, "a file-filter function index");
- pos = XEN_TO_C_INT(index);
- if ((pos >= 0) &&
- (pos < ss->file_filters_size))
- XEN_VECTOR_SET(ss->file_filters, pos, XEN_FALSE);
- return(index);
-}
-
-
-static bool file_sorter_ok(XEN name, XEN proc, const char *caller)
-{
- char *errmsg;
- XEN errstr;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, caller, "a string");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(proc), proc, XEN_ARG_2, caller, "a procedure of 2 args (file1 and file2)");
- errmsg = procedure_ok(proc, 2, caller, "function", 2);
- if (errmsg)
- {
- errstr = C_TO_XEN_STRING(errmsg);
- free(errmsg);
- snd_bad_arity_error(caller, errstr, proc);
- return(false);
- }
- return(true);
+ Xen_check_type(Xen_is_string(subject), subject, 1, S_info_dialog, "a string");
+ Xen_check_type(Xen_is_string(msg), msg, 2, S_info_dialog, "a string");
+ return(Xen_wrap_widget(post_it(Xen_string_to_C_string(subject), Xen_string_to_C_string(msg))));
}
-static XEN g_add_file_sorter(XEN name, XEN proc)
+static Xen g_new_sound_dialog(Xen managed)
{
- #define H_add_file_sorter "(" S_add_file_sorter " name proc) -- add proc with identifier name to file sorter list, returns its index"
- int i, len, choice = -1;
- /* type checks are redundant here */
-
- if (file_sorter_ok(name, proc, S_add_file_sorter))
- {
- len = ss->file_sorters_size;
- for (i = 0; i < len; i++)
- {
- if (XEN_FALSE_P(XEN_VECTOR_REF(ss->file_sorters, i)))
- {
- XEN_VECTOR_SET(ss->file_sorters, i, XEN_LIST_2(name, proc));
- choice = i;
- break;
- }
- }
- if (choice == -1)
- {
- ss->file_sorters_size = len * 2;
- ss->file_sorters = g_expand_vector(ss->file_sorters, ss->file_sorters_size);
- XEN_VECTOR_SET(ss->file_sorters, len, XEN_LIST_2(name, proc));
- choice = len;
- }
- view_files_reflect_sort_items();
- }
- return(C_TO_XEN_INT(choice + SORT_XEN));
+ #define H_new_sound_dialog "(" S_new_sound_dialog " :optional managed): start the File New sound dialog"
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_new_sound_dialog, "a boolean");
+ return(Xen_wrap_widget(make_new_file_dialog(Xen_boolean_to_C_bool(managed))));
}
-static XEN g_delete_file_sorter(XEN index)
-{
- #define H_delete_file_sorter "(" S_delete_file_sorter " index) -- delete proc with identifier name from file sorter list"
- int pos;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(index), index, XEN_ONLY_ARG, S_delete_file_sorter, "a file-sorter index");
- pos = XEN_TO_C_INT(index);
- if ((pos >= SORT_XEN) &&
- ((pos - SORT_XEN) < ss->file_sorters_size))
- XEN_VECTOR_SET(ss->file_sorters, pos - SORT_XEN, XEN_FALSE);
- view_files_reflect_sort_items();
- return(index);
-}
-static XEN g_sound_file_p(XEN name)
+static Xen g_is_sound_file(Xen name)
{
- #define H_sound_file_p "(" S_sound_file_p " name): " PROC_TRUE " if name has a known sound file extension"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, S_sound_file_p, "a filename");
- return(C_TO_XEN_BOOLEAN(sound_file_p(XEN_TO_C_STRING(name))));
+ #define H_is_sound_file "(" S_is_sound_file " name): " PROC_TRUE " if name has a known sound file extension"
+ Xen_check_type(Xen_is_string(name), name, 1, S_is_sound_file, "a filename");
+ return(C_bool_to_Xen_boolean(is_sound_file(Xen_string_to_C_string(name))));
}
-static XEN g_snd_tempnam(void)
+static Xen g_snd_tempnam(void)
{
#define H_snd_tempnam "(" S_snd_tempnam "): return a new temp file name using " S_temp_dir "."
char *tmp;
- XEN res;
+ Xen res;
tmp = snd_tempnam();
- res = C_TO_XEN_STRING(tmp);
+ res = C_string_to_Xen_string(tmp);
free(tmp);
return(res);
}
-static XEN g_auto_update(void) {return(C_TO_XEN_BOOLEAN(auto_update(ss)));}
+static Xen g_auto_update(void) {return(C_bool_to_Xen_boolean(auto_update(ss)));}
-static XEN g_set_auto_update(XEN val)
+static Xen g_set_auto_update(Xen val)
{
#define H_auto_update "(" S_auto_update "): " PROC_TRUE " if Snd should automatically update a file if it changes unexpectedly (default: " PROC_FALSE "). \
The number of seconds between update checks is set by " S_auto_update_interval "."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_auto_update, "a boolean");
- set_auto_update(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(auto_update(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_auto_update, "a boolean");
+ set_auto_update(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(auto_update(ss)));
}
-static XEN g_auto_update_interval(void) {return(C_TO_XEN_DOUBLE(auto_update_interval(ss)));}
+static Xen g_auto_update_interval(void) {return(C_double_to_Xen_real(auto_update_interval(ss)));}
-static XEN g_set_auto_update_interval(XEN val)
+static Xen g_set_auto_update_interval(Xen val)
{
- mus_float_t ctime, old_time;
+ mus_float_t ctime;
#define H_auto_update_interval "(" S_auto_update_interval "): time (seconds) between background checks for changed file on disk (default: 60). \
This value only matters if " S_auto_update " is " PROC_TRUE
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_auto_update_interval, "a number");
-
- ctime = XEN_TO_C_DOUBLE(val);
- if ((ctime < 0.0) || (ctime > (24 * 3600)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_auto_update_interval, 1, val, "~A: invalid time");
-
- old_time = auto_update_interval(ss);
- set_auto_update_interval(ctime);
- /* if new value is 0.0, auto_update_check will notice that, and not run or re-start the update check */
- /* if new value is not 0.0, and old value was 0.0, we need to restart the timeout proc, unless it's still on the queue */
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_auto_update_interval, "a number");
+ ctime = Xen_real_to_C_double(val);
+ if (ctime != auto_update_interval(ss))
+ {
+ mus_float_t old_time;
+ if ((ctime < 0.0) || (ctime > (24 * 3600)))
+ Xen_out_of_range_error(S_set S_auto_update_interval, 1, val, "invalid time");
- if ((ctime > 0.0) && (old_time == 0.0))
- auto_update_restart();
- return(C_TO_XEN_DOUBLE(auto_update_interval(ss)));
+ old_time = auto_update_interval(ss);
+ set_auto_update_interval(ctime);
+ /* if new value is 0.0, auto_update_check will notice that, and not run or re-start the update check */
+ /* if new value is not 0.0, and old value was 0.0, we need to restart the timeout proc, unless it's still on the queue */
+
+ if ((ctime > 0.0) && (old_time == 0.0))
+ auto_update_restart();
+ }
+ return(C_double_to_Xen_real(auto_update_interval(ss)));
}
-static XEN g_default_output_chans(void) {return(C_TO_XEN_INT(default_output_chans(ss)));}
+static Xen g_default_output_chans(void) {return(C_int_to_Xen_integer(default_output_chans(ss)));}
-static XEN g_set_default_output_chans(XEN val)
+static Xen g_set_default_output_chans(Xen val)
{
#define MAX_OUTPUT_CHANS 1024
#define H_default_output_chans "(" S_default_output_chans "): default number of channels when a new or temporary file is created (1)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_default_output_chans, "an integer");
- set_default_output_chans(mus_iclamp(1, XEN_TO_C_INT(val), MAX_OUTPUT_CHANS));
- return(C_TO_XEN_INT(default_output_chans(ss)));
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_default_output_chans, "an integer");
+ set_default_output_chans(mus_iclamp(1, Xen_integer_to_C_int(val), MAX_OUTPUT_CHANS));
+ return(C_int_to_Xen_integer(default_output_chans(ss)));
}
-static XEN g_default_output_srate(void) {return(C_TO_XEN_INT(default_output_srate(ss)));}
+static Xen g_default_output_srate(void) {return(C_int_to_Xen_integer(default_output_srate(ss)));}
-static XEN g_set_default_output_srate(XEN val)
+static Xen g_set_default_output_srate(Xen val)
{
#define MAX_OUTPUT_SRATE 1000000000
#define H_default_output_srate "(" S_default_output_srate "): default srate when a new or temporary file is created (22050)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_default_output_srate, "a number");
- set_default_output_srate(mus_iclamp(1, XEN_TO_C_INT_OR_ELSE(val, 0), MAX_OUTPUT_SRATE));
- return(C_TO_XEN_INT(default_output_srate(ss)));
+
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_default_output_srate, "an integer");
+ set_default_output_srate(mus_iclamp(1, Xen_integer_to_C_int(val), MAX_OUTPUT_SRATE));
+ return(C_int_to_Xen_integer(default_output_srate(ss)));
}
-static XEN g_default_output_header_type(void) {return(C_TO_XEN_INT(default_output_header_type(ss)));}
+static Xen g_default_output_header_type(void) {return(C_int_to_Xen_integer((int)default_output_header_type(ss)));}
-static XEN g_set_default_output_header_type(XEN val)
+static Xen g_set_default_output_header_type(Xen val)
{
- int typ;
+ mus_header_t typ;
#define H_default_output_header_type "(" S_default_output_header_type "): default header type when a new or temporary file is created. \
Normally this is " S_mus_next "; -1 here indicates you want Snd to use the current sound's header type, if possible. \
Other writable headers include " S_mus_aiff ", " S_mus_riff ", " S_mus_ircam ", " S_mus_nist ", " S_mus_aifc ", and " S_mus_raw "."
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_default_output_header_type, "an integer");
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_default_output_header_type, "an integer");
- typ = XEN_TO_C_INT(val);
- if (mus_header_writable(typ, -2))
- set_default_output_header_type(typ);
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_default_output_header_type, 1, val, "~A: unwritable header type");
- return(C_TO_XEN_INT(default_output_header_type(ss)));
+ typ = (mus_header_t)Xen_integer_to_C_int(val);
+ if (mus_header_writable(typ, MUS_IGNORE_SAMPLE))
+ set_default_output_header_type(typ);
+ else Xen_out_of_range_error(S_set S_default_output_header_type, 1, val, "unwritable header type");
+ return(C_int_to_Xen_integer((int)default_output_header_type(ss)));
}
-static XEN g_default_output_data_format(void) {return(C_TO_XEN_INT(default_output_data_format(ss)));}
+static Xen g_default_output_sample_type(void) {return(C_int_to_Xen_integer(default_output_sample_type(ss)));}
-static XEN g_set_default_output_data_format(XEN val)
+static Xen g_set_default_output_sample_type(Xen val)
{
- int format;
- #define H_default_output_data_format "(" S_default_output_data_format "): default data format when a new or temporary file is created, \
-normally " S_mus_bshort "; -1 here means try to use the current sound's data format; many other formats \
+ mus_sample_t samp_type;
+ #define H_default_output_sample_type "(" S_default_output_sample_type "): default sample type when a new or temporary file is created, \
+normally " S_mus_ldouble "; mus-unknown-sample here means try to use the current sound's sample type; many other sample types \
are available, but not all are compatible with all header types"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_default_output_data_format, "an integer");
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_default_output_sample_type, "an integer");
- format = XEN_TO_C_INT(val);
- if (mus_data_format_p(format))
- set_default_output_data_format(format);
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_default_output_data_format, 1, val, "~A: unknown data format");
- return(C_TO_XEN_INT(default_output_data_format(ss)));
+ samp_type = (mus_sample_t)Xen_integer_to_C_int(val);
+ if (mus_is_sample_type(samp_type))
+ set_default_output_sample_type(samp_type);
+ else Xen_out_of_range_error(S_set S_default_output_sample_type, 1, val, "unknown sample type");
+ return(C_int_to_Xen_integer((int)default_output_sample_type(ss)));
}
-static XEN g_clipping(void) {return(C_TO_XEN_BOOLEAN(clipping(ss)));}
+static Xen g_clipping(void) {return(C_bool_to_Xen_boolean(clipping(ss)));}
-static XEN g_set_clipping(XEN val)
+static Xen g_set_clipping(Xen val)
{
#define H_clipping "(" S_clipping "): " PROC_TRUE " if Snd should clip output values to the current \
-output data format's maximum. The default (" PROC_FALSE ") allows them to wrap-around which makes a very loud click"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_clipping, "a boolean");
- set_clipping(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(clipping(ss)));
+output sample type's maximum. The default (" PROC_FALSE ") allows them to wrap-around which makes a very loud click"
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_clipping, "a boolean");
+ set_clipping(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(clipping(ss)));
}
-static XEN g_ask_before_overwrite(void) {return(C_TO_XEN_BOOLEAN(ask_before_overwrite(ss)));}
+static Xen g_ask_before_overwrite(void) {return(C_bool_to_Xen_boolean(ask_before_overwrite(ss)));}
-static XEN g_set_ask_before_overwrite(XEN val)
+static Xen g_set_ask_before_overwrite(Xen val)
{
#define H_ask_before_overwrite "(" S_ask_before_overwrite "): " PROC_TRUE " if you want Snd to ask before overwriting a file. \
If " PROC_FALSE ", any existing file of the same name will be overwritten without warning when you save a sound."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_ask_before_overwrite, "a boolean");
- set_ask_before_overwrite(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(ask_before_overwrite(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_ask_before_overwrite, "a boolean");
+ set_ask_before_overwrite(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(ask_before_overwrite(ss)));
}
-static XEN g_with_toolbar(void) {return(C_TO_XEN_BOOLEAN(with_toolbar(ss)));}
+static Xen g_with_toolbar(void) {return(C_bool_to_Xen_boolean(with_toolbar(ss)));}
void set_with_toolbar_and_display(bool val)
{
@@ -5715,32 +3480,33 @@ void set_with_toolbar_and_display(bool val)
#endif
}
-static XEN g_set_with_toolbar(XEN val)
+static Xen g_set_with_toolbar(Xen val)
{
#define H_with_toolbar "(" S_with_toolbar "): " PROC_TRUE " if you want a toolbar"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_with_toolbar, "a boolean");
- set_with_toolbar_and_display(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(with_toolbar(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_with_toolbar, "a boolean");
+ set_with_toolbar_and_display(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(with_toolbar(ss)));
}
-static XEN g_with_tooltips(void) {return(C_TO_XEN_BOOLEAN(with_tooltips(ss)));}
+static Xen g_with_tooltips(void) {return(C_bool_to_Xen_boolean(with_tooltips(ss)));}
void set_with_tooltips(bool val)
{
in_set_with_tooltips(val);
-#if HAVE_GTK
+#if USE_GTK
+#if (!GTK_CHECK_VERSION(3, 16, 0)) /* this can't be combined in the line above */
g_object_set(gtk_settings_get_default(), "gtk-enable-tooltips", val, NULL);
- /* TODO: this doesn't seem to work (disable tooltips) */
+#endif
#endif
}
-static XEN g_set_with_tooltips(XEN val)
+static Xen g_set_with_tooltips(Xen val)
{
#define H_with_tooltips "(" S_with_tooltips "): " PROC_TRUE " if you want tooltips displayed at all"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_with_tooltips, "a boolean");
- set_with_tooltips(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(with_tooltips(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_with_tooltips, "a boolean");
+ set_with_tooltips(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(with_tooltips(ss)));
}
@@ -5748,19 +3514,22 @@ void set_with_menu_icons(bool val)
{
in_set_with_menu_icons(val);
#if USE_GTK
+#if (!GTK_CHECK_VERSION(3, 16, 0))
g_object_set(gtk_settings_get_default(), "gtk-menu-images", with_menu_icons(ss), NULL);
+ g_object_set(gtk_settings_get_default(), "gtk-button-images", with_menu_icons(ss), NULL);
+#endif
#endif
}
-static XEN g_with_menu_icons(void) {return(C_TO_XEN_BOOLEAN(with_menu_icons(ss)));}
+static Xen g_with_menu_icons(void) {return(C_bool_to_Xen_boolean(with_menu_icons(ss)));}
-static XEN g_set_with_menu_icons(XEN val)
+static Xen g_set_with_menu_icons(Xen val)
{
#define H_with_menu_icons "(" S_with_menu_icons "): " PROC_TRUE " if you want icons in the menus (gtk only)"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_with_menu_icons, "a boolean");
- set_with_menu_icons(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(with_menu_icons(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_with_menu_icons, "a boolean");
+ set_with_menu_icons(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(with_menu_icons(ss)));
}
@@ -5770,14 +3539,14 @@ static void set_save_as_dialog_src(bool val)
reflect_save_as_src(val);
}
-static XEN g_save_as_dialog_src(void) {return(C_TO_XEN_BOOLEAN(save_as_dialog_src(ss)));}
+static Xen g_save_as_dialog_src(void) {return(C_bool_to_Xen_boolean(save_as_dialog_src(ss)));}
-static XEN g_set_save_as_dialog_src(XEN val)
+static Xen g_set_save_as_dialog_src(Xen val)
{
- #define H_save_as_dialog_src "(" S_save_as_dialog_src "): " PROC_TRUE " if you the 'src' button set by default in the various Save-as dialogs"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_save_as_dialog_src, "a boolean");
- set_save_as_dialog_src(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(save_as_dialog_src(ss)));
+ #define H_save_as_dialog_src "(" S_save_as_dialog_src "): " PROC_TRUE " if you want the 'src' button set by default in the various Save-as dialogs"
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_save_as_dialog_src, "a boolean");
+ set_save_as_dialog_src(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(save_as_dialog_src(ss)));
}
@@ -5787,286 +3556,289 @@ static void set_save_as_dialog_auto_comment(bool val)
reflect_save_as_auto_comment(val);
}
-static XEN g_save_as_dialog_auto_comment(void) {return(C_TO_XEN_BOOLEAN(save_as_dialog_auto_comment(ss)));}
+static Xen g_save_as_dialog_auto_comment(void) {return(C_bool_to_Xen_boolean(save_as_dialog_auto_comment(ss)));}
-static XEN g_set_save_as_dialog_auto_comment(XEN val)
+static Xen g_set_save_as_dialog_auto_comment(Xen val)
{
- #define H_save_as_dialog_auto_comment "(" S_save_as_dialog_auto_comment "): " PROC_TRUE " if you the 'auto' button set by default in the various Save-as dialogs"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_save_as_dialog_auto_comment, "a boolean");
- set_save_as_dialog_auto_comment(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(save_as_dialog_auto_comment(ss)));
+ #define H_save_as_dialog_auto_comment "(" S_save_as_dialog_auto_comment "): " PROC_TRUE " if you want the 'auto' button set by default in the various Save-as dialogs"
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_save_as_dialog_auto_comment, "a boolean");
+ set_save_as_dialog_auto_comment(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(save_as_dialog_auto_comment(ss)));
}
-static XEN g_remember_sound_state(void) {return(C_TO_XEN_BOOLEAN(remember_sound_state(ss)));}
+static Xen g_remember_sound_state(void) {return(C_bool_to_Xen_boolean(remember_sound_state(ss)));}
-static XEN g_set_remember_sound_state(XEN val)
+static Xen g_set_remember_sound_state(Xen val)
{
#define H_remember_sound_state "(" S_remember_sound_state "): " PROC_TRUE " if you want a Snd to remember the current \
state of each sound when it is closed, restoring that state when it is opened again later."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_remember_sound_state, "a boolean");
- set_remember_sound_state(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(remember_sound_state(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_remember_sound_state, "a boolean");
+ set_remember_sound_state(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(remember_sound_state(ss)));
}
-static XEN g_ask_about_unsaved_edits(void) {return(C_TO_XEN_BOOLEAN(ask_about_unsaved_edits(ss)));}
+static Xen g_ask_about_unsaved_edits(void) {return(C_bool_to_Xen_boolean(ask_about_unsaved_edits(ss)));}
-static XEN g_set_ask_about_unsaved_edits(XEN val)
+static Xen g_set_ask_about_unsaved_edits(Xen val)
{
#define H_ask_about_unsaved_edits "(" S_ask_about_unsaved_edits "): " PROC_TRUE " if you want Snd to ask whether \
to save unsaved edits when a sound is closed."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_ask_about_unsaved_edits, "a boolean");
- set_ask_about_unsaved_edits(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(ask_about_unsaved_edits(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_ask_about_unsaved_edits, "a boolean");
+ set_ask_about_unsaved_edits(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(ask_about_unsaved_edits(ss)));
}
-static XEN g_show_full_duration(void) {return(C_TO_XEN_BOOLEAN(show_full_duration(ss)));}
+static Xen g_show_full_duration(void) {return(C_bool_to_Xen_boolean(show_full_duration(ss)));}
-static XEN g_set_show_full_duration(XEN val)
+static Xen g_set_show_full_duration(Xen val)
{
+ int i;
#define H_show_full_duration "(" S_show_full_duration "): " PROC_TRUE " if you want the entire sound \
displayed whn it is opened."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_show_full_duration, "a boolean");
- set_show_full_duration(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(show_full_duration(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_show_full_duration, "a boolean");
+ set_show_full_duration(Xen_boolean_to_C_bool(val));
+
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ snd_info *sp;
+ sp = ss->sounds[i];
+ if ((sp) && (sp->inuse == SOUND_NORMAL))
+ {
+ int j;
+ for (j = 0; j < sp->nchans; j++)
+ set_x_axis_x0x1(sp->chans[j], 0.0, sp->chans[j]->axis->xmax);
+ }
+ }
+
+ return(C_bool_to_Xen_boolean(show_full_duration(ss)));
}
-static XEN g_initial_beg(void) {return(C_TO_XEN_DOUBLE(initial_beg(ss)));}
+static Xen g_initial_beg(void) {return(C_double_to_Xen_real(initial_beg(ss)));}
-static XEN g_set_initial_beg(XEN val)
+static Xen g_set_initial_beg(Xen val)
{
#define H_initial_beg "(" S_initial_beg "): the begin point (in seconds) for the initial graph of a sound."
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_initial_beg, "a number");
- set_initial_beg(XEN_TO_C_DOUBLE(val));
- return(C_TO_XEN_DOUBLE(initial_beg(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_initial_beg, "a number");
+ set_initial_beg(Xen_real_to_C_double(val));
+ return(C_double_to_Xen_real(initial_beg(ss)));
}
-static XEN g_initial_dur(void) {return(C_TO_XEN_DOUBLE(initial_dur(ss)));}
+static Xen g_initial_dur(void) {return(C_double_to_Xen_real(initial_dur(ss)));}
-static XEN g_set_initial_dur(XEN val)
+static Xen g_set_initial_dur(Xen val)
{
#define H_initial_dur "(" S_initial_dur "): the duration (in seconds) for the initial graph of a sound."
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_initial_dur, "a number");
- set_initial_dur(XEN_TO_C_DOUBLE(val));
- return(C_TO_XEN_DOUBLE(initial_dur(ss)));
-}
-
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_1(g_view_files_sort_w, g_view_files_sort)
-XEN_ARGIFY_2(g_set_view_files_sort_w, g_set_view_files_sort)
-XEN_NARGIFY_1(g_add_sound_file_extension_w, g_add_sound_file_extension)
-XEN_NARGIFY_0(g_sound_file_extensions_w, g_sound_file_extensions)
-XEN_NARGIFY_1(g_set_sound_file_extensions_w, g_set_sound_file_extensions)
-XEN_NARGIFY_1(g_file_write_date_w, g_file_write_date)
-XEN_ARGIFY_1(g_soundfont_info_w, g_soundfont_info)
-XEN_ARGIFY_2(g_add_directory_to_view_files_list_w, g_add_directory_to_view_files_list)
-XEN_ARGIFY_2(g_add_file_to_view_files_list_w, g_add_file_to_view_files_list)
-XEN_ARGIFY_1(g_sound_files_in_directory_w, g_sound_files_in_directory)
-XEN_ARGIFY_1(g_sound_loop_info_w, g_sound_loop_info)
-XEN_ARGIFY_2(g_set_sound_loop_info_w, g_set_sound_loop_info)
-XEN_NARGIFY_1(g_disk_kspace_w, g_disk_kspace)
-XEN_ARGIFY_1(g_open_file_dialog_w, g_open_file_dialog)
-XEN_ARGIFY_1(g_mix_file_dialog_w, g_mix_file_dialog)
-XEN_ARGIFY_1(g_insert_file_dialog_w, g_insert_file_dialog)
-XEN_ARGIFY_2(g_view_files_dialog_w, g_view_files_dialog)
-XEN_ARGIFY_1(g_edit_header_dialog_w, g_edit_header_dialog)
-XEN_ARGIFY_1(g_save_selection_dialog_w, g_save_selection_dialog)
-XEN_ARGIFY_1(g_save_region_dialog_w, g_save_region_dialog)
-XEN_ARGIFY_1(g_save_sound_dialog_w, g_save_sound_dialog)
-XEN_ARGIFY_1(g_new_sound_dialog_w, g_new_sound_dialog)
-XEN_NARGIFY_2(g_info_dialog_w, g_info_dialog)
-XEN_NARGIFY_1(g_view_files_amp_w, g_view_files_amp)
-XEN_NARGIFY_2(g_view_files_set_amp_w, g_view_files_set_amp)
-XEN_NARGIFY_1(g_view_files_speed_w, g_view_files_speed)
-XEN_NARGIFY_2(g_view_files_set_speed_w, g_view_files_set_speed)
-XEN_NARGIFY_1(g_view_files_amp_env_w, g_view_files_amp_env)
-XEN_NARGIFY_2(g_view_files_set_amp_env_w, g_view_files_set_amp_env)
-XEN_NARGIFY_1(g_view_files_speed_style_w, g_view_files_speed_style)
-XEN_NARGIFY_2(g_view_files_set_speed_style_w, g_view_files_set_speed_style)
-XEN_NARGIFY_1(g_view_files_selected_files_w, g_view_files_selected_files)
-XEN_NARGIFY_1(g_view_files_files_w, g_view_files_files)
-XEN_NARGIFY_2(g_view_files_set_selected_files_w, g_view_files_set_selected_files)
-XEN_NARGIFY_2(g_view_files_set_files_w, g_view_files_set_files)
-XEN_NARGIFY_1(g_delete_file_filter_w, g_delete_file_filter)
-XEN_NARGIFY_2(g_add_file_filter_w, g_add_file_filter)
-XEN_NARGIFY_1(g_delete_file_sorter_w, g_delete_file_sorter)
-XEN_NARGIFY_2(g_add_file_sorter_w, g_add_file_sorter)
-XEN_NARGIFY_1(g_sound_file_p_w, g_sound_file_p)
-XEN_NARGIFY_0(g_snd_tempnam_w, g_snd_tempnam)
-XEN_NARGIFY_0(g_auto_update_w, g_auto_update)
-XEN_NARGIFY_1(g_set_auto_update_w, g_set_auto_update)
-XEN_NARGIFY_0(g_auto_update_interval_w, g_auto_update_interval)
-XEN_NARGIFY_1(g_set_auto_update_interval_w, g_set_auto_update_interval)
-XEN_NARGIFY_0(g_default_output_chans_w, g_default_output_chans)
-XEN_NARGIFY_1(g_set_default_output_chans_w, g_set_default_output_chans)
-XEN_NARGIFY_0(g_default_output_srate_w, g_default_output_srate)
-XEN_NARGIFY_1(g_set_default_output_srate_w, g_set_default_output_srate)
-XEN_NARGIFY_0(g_default_output_header_type_w, g_default_output_header_type)
-XEN_NARGIFY_1(g_set_default_output_header_type_w, g_set_default_output_header_type)
-XEN_NARGIFY_0(g_default_output_data_format_w, g_default_output_data_format)
-XEN_NARGIFY_1(g_set_default_output_data_format_w, g_set_default_output_data_format)
-XEN_NARGIFY_0(g_ask_before_overwrite_w, g_ask_before_overwrite)
-XEN_NARGIFY_1(g_set_ask_before_overwrite_w, g_set_ask_before_overwrite)
-XEN_NARGIFY_0(g_with_toolbar_w, g_with_toolbar)
-XEN_NARGIFY_1(g_set_with_toolbar_w, g_set_with_toolbar)
-XEN_NARGIFY_0(g_with_tooltips_w, g_with_tooltips)
-XEN_NARGIFY_1(g_set_with_tooltips_w, g_set_with_tooltips)
-XEN_NARGIFY_0(g_with_menu_icons_w, g_with_menu_icons)
-XEN_NARGIFY_1(g_set_with_menu_icons_w, g_set_with_menu_icons)
-XEN_NARGIFY_0(g_save_as_dialog_src_w, g_save_as_dialog_src)
-XEN_NARGIFY_1(g_set_save_as_dialog_src_w, g_set_save_as_dialog_src)
-XEN_NARGIFY_0(g_save_as_dialog_auto_comment_w, g_save_as_dialog_auto_comment)
-XEN_NARGIFY_1(g_set_save_as_dialog_auto_comment_w, g_set_save_as_dialog_auto_comment)
-XEN_NARGIFY_0(g_remember_sound_state_w, g_remember_sound_state)
-XEN_NARGIFY_1(g_set_remember_sound_state_w, g_set_remember_sound_state)
-XEN_NARGIFY_0(g_ask_about_unsaved_edits_w, g_ask_about_unsaved_edits)
-XEN_NARGIFY_1(g_set_ask_about_unsaved_edits_w, g_set_ask_about_unsaved_edits)
-XEN_NARGIFY_0(g_show_full_duration_w, g_show_full_duration)
-XEN_NARGIFY_1(g_set_show_full_duration_w, g_set_show_full_duration)
-XEN_NARGIFY_0(g_initial_beg_w, g_initial_beg)
-XEN_NARGIFY_1(g_set_initial_beg_w, g_set_initial_beg)
-XEN_NARGIFY_0(g_initial_dur_w, g_initial_dur)
-XEN_NARGIFY_1(g_set_initial_dur_w, g_set_initial_dur)
-XEN_NARGIFY_0(g_clipping_w, g_clipping)
-XEN_NARGIFY_1(g_set_clipping_w, g_set_clipping)
-#else
-#define g_view_files_sort_w g_view_files_sort
-#define g_set_view_files_sort_w g_set_view_files_sort
-#define g_add_sound_file_extension_w g_add_sound_file_extension
-#define g_sound_file_extensions_w g_sound_file_extensions
-#define g_set_sound_file_extensions_w g_set_sound_file_extensions
-#define g_file_write_date_w g_file_write_date
-#define g_soundfont_info_w g_soundfont_info
-#define g_add_directory_to_view_files_list_w g_add_directory_to_view_files_list
-#define g_add_file_to_view_files_list_w g_add_file_to_view_files_list
-#define g_sound_files_in_directory_w g_sound_files_in_directory
-#define g_sound_loop_info_w g_sound_loop_info
-#define g_set_sound_loop_info_w g_set_sound_loop_info
-#define g_disk_kspace_w g_disk_kspace
-#define g_open_file_dialog_w g_open_file_dialog
-#define g_mix_file_dialog_w g_mix_file_dialog
-#define g_insert_file_dialog_w g_insert_file_dialog
-#define g_view_files_dialog_w g_view_files_dialog
-#define g_edit_header_dialog_w g_edit_header_dialog
-#define g_save_selection_dialog_w g_save_selection_dialog
-#define g_save_region_dialog_w g_save_region_dialog
-#define g_save_sound_dialog_w g_save_sound_dialog
-#define g_new_sound_dialog_w g_new_sound_dialog
-#define g_info_dialog_w g_info_dialog
-#define g_view_files_amp_w g_view_files_amp
-#define g_view_files_set_amp_w g_view_files_set_amp
-#define g_view_files_amp_env_w g_view_files_amp_env
-#define g_view_files_set_amp_env_w g_view_files_set_amp_env
-#define g_view_files_speed_style_w g_view_files_speed_style
-#define g_view_files_set_speed_style_w g_view_files_set_speed_style
-#define g_view_files_speed_w g_view_files_speed
-#define g_view_files_set_speed_w g_view_files_set_speed
-#define g_view_files_selected_files_w g_view_files_selected_files
-#define g_view_files_files_w g_view_files_files
-#define g_view_files_set_selected_files_w g_view_files_set_selected_files
-#define g_view_files_set_files_w g_view_files_set_files
-#define g_delete_file_filter_w g_delete_file_filter
-#define g_add_file_filter_w g_add_file_filter
-#define g_delete_file_sorter_w g_delete_file_sorter
-#define g_add_file_sorter_w g_add_file_sorter
-#define g_sound_file_p_w g_sound_file_p
-#define g_snd_tempnam_w g_snd_tempnam
-#define g_auto_update_w g_auto_update
-#define g_set_auto_update_w g_set_auto_update
-#define g_auto_update_interval_w g_auto_update_interval
-#define g_set_auto_update_interval_w g_set_auto_update_interval
-#define g_default_output_chans_w g_default_output_chans
-#define g_set_default_output_chans_w g_set_default_output_chans
-#define g_default_output_srate_w g_default_output_srate
-#define g_set_default_output_srate_w g_set_default_output_srate
-#define g_default_output_header_type_w g_default_output_header_type
-#define g_set_default_output_header_type_w g_set_default_output_header_type
-#define g_default_output_data_format_w g_default_output_data_format
-#define g_set_default_output_data_format_w g_set_default_output_data_format
-#define g_ask_before_overwrite_w g_ask_before_overwrite
-#define g_set_ask_before_overwrite_w g_set_ask_before_overwrite
-#define g_with_toolbar_w g_with_toolbar
-#define g_set_with_toolbar_w g_set_with_toolbar
-#define g_with_tooltips_w g_with_tooltips
-#define g_set_with_tooltips_w g_set_with_tooltips
-#define g_with_menu_icons_w g_with_menu_icons
-#define g_set_with_menu_icons_w g_set_with_menu_icons
-#define g_save_as_dialog_src_w g_save_as_dialog_src
-#define g_set_save_as_dialog_src_w g_set_save_as_dialog_src
-#define g_save_as_dialog_auto_comment_w g_save_as_dialog_auto_comment
-#define g_set_save_as_dialog_auto_comment_w g_set_save_as_dialog_auto_comment
-#define g_remember_sound_state_w g_remember_sound_state
-#define g_set_remember_sound_state_w g_set_remember_sound_state
-#define g_ask_about_unsaved_edits_w g_ask_about_unsaved_edits
-#define g_set_ask_about_unsaved_edits_w g_set_ask_about_unsaved_edits
-#define g_show_full_duration_w g_show_full_duration
-#define g_set_show_full_duration_w g_set_show_full_duration
-#define g_initial_beg_w g_initial_beg
-#define g_set_initial_beg_w g_set_initial_beg
-#define g_initial_dur_w g_initial_dur
-#define g_set_initial_dur_w g_set_initial_dur
-#define g_clipping_w g_clipping
-#define g_set_clipping_w g_set_clipping
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_initial_dur, "a number");
+ set_initial_dur(Xen_real_to_C_double(val));
+ return(C_double_to_Xen_real(initial_dur(ss)));
+}
+
+
+static Xen g_show_full_range(void) {return(C_bool_to_Xen_boolean(show_full_range(ss)));}
+
+static Xen g_set_show_full_range(Xen val)
+{
+ int i;
+ #define H_show_full_range "(" S_show_full_range "): " PROC_TRUE " if you want the graph y-bounds to accommodate the sound's \
+max and min when it is opened."
+
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_show_full_range, "a boolean");
+ set_show_full_range(Xen_boolean_to_C_bool(val));
+
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ snd_info *sp;
+ sp = ss->sounds[i];
+ if ((sp) && (sp->inuse == SOUND_NORMAL))
+ {
+ int j;
+ for (j = 0; j < sp->nchans; j++)
+ {
+ chan_info *cp;
+ axis_info *ap;
+ mus_float_t hi;
+ cp = sp->chans[j];
+ ap = cp->axis;
+ hi = channel_maxamp(cp, AT_CURRENT_EDIT_POSITION);
+ if (hi > ap->ymax)
+ {
+ ap->ymin = -hi;
+ ap->ymax = hi;
+ ap->y_ambit = 2 * hi;
+ ap->y0 = -hi;
+ ap->y1 = hi;
+ ap->zy = 1.0;
+ ap->sy = 0.0;
+ resize_sy_and_zy(cp);
+ apply_y_axis_change(cp);
+ }
+ }
+ }
+ }
+
+ return(C_bool_to_Xen_boolean(show_full_range(ss)));
+}
+
+
+
+
+Xen_wrap_1_arg(g_add_sound_file_extension_w, g_add_sound_file_extension)
+Xen_wrap_no_args(g_sound_file_extensions_w, g_sound_file_extensions)
+Xen_wrap_1_arg(g_set_sound_file_extensions_w, g_set_sound_file_extensions)
+Xen_wrap_1_arg(g_file_write_date_w, g_file_write_date)
+Xen_wrap_1_optional_arg(g_soundfont_info_w, g_soundfont_info)
+Xen_wrap_1_optional_arg(g_sound_files_in_directory_w, g_sound_files_in_directory)
+Xen_wrap_1_optional_arg(g_sound_loop_info_w, g_sound_loop_info)
+Xen_wrap_2_optional_args(g_set_sound_loop_info_w, g_set_sound_loop_info)
+Xen_wrap_1_arg(g_disk_kspace_w, g_disk_kspace)
+Xen_wrap_1_optional_arg(g_open_file_dialog_w, g_open_file_dialog)
+Xen_wrap_1_optional_arg(g_mix_file_dialog_w, g_mix_file_dialog)
+Xen_wrap_1_optional_arg(g_insert_file_dialog_w, g_insert_file_dialog)
+Xen_wrap_1_optional_arg(g_edit_header_dialog_w, g_edit_header_dialog)
+Xen_wrap_1_optional_arg(g_save_selection_dialog_w, g_save_selection_dialog)
+Xen_wrap_1_optional_arg(g_save_region_dialog_w, g_save_region_dialog)
+Xen_wrap_1_optional_arg(g_save_sound_dialog_w, g_save_sound_dialog)
+Xen_wrap_1_optional_arg(g_new_sound_dialog_w, g_new_sound_dialog)
+Xen_wrap_2_args(g_info_dialog_w, g_info_dialog)
+Xen_wrap_1_arg(g_is_sound_file_w, g_is_sound_file)
+Xen_wrap_no_args(g_snd_tempnam_w, g_snd_tempnam)
+Xen_wrap_no_args(g_auto_update_w, g_auto_update)
+Xen_wrap_1_arg(g_set_auto_update_w, g_set_auto_update)
+Xen_wrap_no_args(g_auto_update_interval_w, g_auto_update_interval)
+Xen_wrap_1_arg(g_set_auto_update_interval_w, g_set_auto_update_interval)
+Xen_wrap_no_args(g_default_output_chans_w, g_default_output_chans)
+Xen_wrap_1_arg(g_set_default_output_chans_w, g_set_default_output_chans)
+Xen_wrap_no_args(g_default_output_srate_w, g_default_output_srate)
+Xen_wrap_1_arg(g_set_default_output_srate_w, g_set_default_output_srate)
+Xen_wrap_no_args(g_default_output_header_type_w, g_default_output_header_type)
+Xen_wrap_1_arg(g_set_default_output_header_type_w, g_set_default_output_header_type)
+Xen_wrap_no_args(g_default_output_sample_type_w, g_default_output_sample_type)
+Xen_wrap_1_arg(g_set_default_output_sample_type_w, g_set_default_output_sample_type)
+Xen_wrap_no_args(g_ask_before_overwrite_w, g_ask_before_overwrite)
+Xen_wrap_1_arg(g_set_ask_before_overwrite_w, g_set_ask_before_overwrite)
+Xen_wrap_no_args(g_with_toolbar_w, g_with_toolbar)
+Xen_wrap_1_arg(g_set_with_toolbar_w, g_set_with_toolbar)
+Xen_wrap_no_args(g_with_tooltips_w, g_with_tooltips)
+Xen_wrap_1_arg(g_set_with_tooltips_w, g_set_with_tooltips)
+Xen_wrap_no_args(g_with_menu_icons_w, g_with_menu_icons)
+Xen_wrap_1_arg(g_set_with_menu_icons_w, g_set_with_menu_icons)
+Xen_wrap_no_args(g_save_as_dialog_src_w, g_save_as_dialog_src)
+Xen_wrap_1_arg(g_set_save_as_dialog_src_w, g_set_save_as_dialog_src)
+Xen_wrap_no_args(g_save_as_dialog_auto_comment_w, g_save_as_dialog_auto_comment)
+Xen_wrap_1_arg(g_set_save_as_dialog_auto_comment_w, g_set_save_as_dialog_auto_comment)
+Xen_wrap_no_args(g_remember_sound_state_w, g_remember_sound_state)
+Xen_wrap_1_arg(g_set_remember_sound_state_w, g_set_remember_sound_state)
+Xen_wrap_no_args(g_ask_about_unsaved_edits_w, g_ask_about_unsaved_edits)
+Xen_wrap_1_arg(g_set_ask_about_unsaved_edits_w, g_set_ask_about_unsaved_edits)
+Xen_wrap_no_args(g_show_full_duration_w, g_show_full_duration)
+Xen_wrap_1_arg(g_set_show_full_duration_w, g_set_show_full_duration)
+Xen_wrap_no_args(g_show_full_range_w, g_show_full_range)
+Xen_wrap_1_arg(g_set_show_full_range_w, g_set_show_full_range)
+Xen_wrap_no_args(g_initial_beg_w, g_initial_beg)
+Xen_wrap_1_arg(g_set_initial_beg_w, g_set_initial_beg)
+Xen_wrap_no_args(g_initial_dur_w, g_initial_dur)
+Xen_wrap_1_arg(g_set_initial_dur_w, g_set_initial_dur)
+Xen_wrap_no_args(g_clipping_w, g_clipping)
+Xen_wrap_1_arg(g_set_clipping_w, g_set_clipping)
+Xen_wrap_1_arg(g_delete_file_filter_w, g_delete_file_filter)
+Xen_wrap_2_args(g_add_file_filter_w, g_add_file_filter)
+
+
+#if HAVE_SCHEME
+static s7_pointer acc_default_output_header_type(s7_scheme *sc, s7_pointer args) {return(g_set_default_output_header_type(s7_cadr(args)));}
+static s7_pointer acc_default_output_sample_type(s7_scheme *sc, s7_pointer args) {return(g_set_default_output_sample_type(s7_cadr(args)));}
+static s7_pointer acc_default_output_chans(s7_scheme *sc, s7_pointer args) {return(g_set_default_output_chans(s7_cadr(args)));}
+static s7_pointer acc_default_output_srate(s7_scheme *sc, s7_pointer args) {return(g_set_default_output_srate(s7_cadr(args)));}
+static s7_pointer acc_ask_before_overwrite(s7_scheme *sc, s7_pointer args) {return(g_set_ask_before_overwrite(s7_cadr(args)));}
+static s7_pointer acc_ask_about_unsaved_edits(s7_scheme *sc, s7_pointer args) {return(g_set_ask_about_unsaved_edits(s7_cadr(args)));}
+static s7_pointer acc_show_full_duration(s7_scheme *sc, s7_pointer args) {return(g_set_show_full_duration(s7_cadr(args)));}
+static s7_pointer acc_show_full_range(s7_scheme *sc, s7_pointer args) {return(g_set_show_full_range(s7_cadr(args)));}
+static s7_pointer acc_remember_sound_state(s7_scheme *sc, s7_pointer args) {return(g_set_remember_sound_state(s7_cadr(args)));}
+static s7_pointer acc_save_as_dialog_src(s7_scheme *sc, s7_pointer args) {return(g_set_save_as_dialog_src(s7_cadr(args)));}
+static s7_pointer acc_save_as_dialog_auto_comment(s7_scheme *sc, s7_pointer args) {return(g_set_save_as_dialog_auto_comment(s7_cadr(args)));}
+static s7_pointer acc_with_toolbar(s7_scheme *sc, s7_pointer args) {return(g_set_with_toolbar(s7_cadr(args)));}
+static s7_pointer acc_with_tooltips(s7_scheme *sc, s7_pointer args) {return(g_set_with_tooltips(s7_cadr(args)));}
+static s7_pointer acc_with_menu_icons(s7_scheme *sc, s7_pointer args) {return(g_set_with_menu_icons(s7_cadr(args)));}
+static s7_pointer acc_initial_beg(s7_scheme *sc, s7_pointer args) {return(g_set_initial_beg(s7_cadr(args)));}
+static s7_pointer acc_initial_dur(s7_scheme *sc, s7_pointer args) {return(g_set_initial_dur(s7_cadr(args)));}
+static s7_pointer acc_auto_update(s7_scheme *sc, s7_pointer args) {return(g_set_auto_update(s7_cadr(args)));}
+static s7_pointer acc_auto_update_interval(s7_scheme *sc, s7_pointer args) {return(g_set_auto_update_interval(s7_cadr(args)));}
+static s7_pointer acc_clipping(s7_scheme *sc, s7_pointer args) {return(g_set_clipping(s7_cadr(args)));}
#endif
void g_init_file(void)
{
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_view_files_amp, g_view_files_amp_w, H_view_files_amp,
- S_setB S_view_files_amp, g_view_files_set_amp_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_view_files_amp_env, g_view_files_amp_env_w, H_view_files_amp_env,
- S_setB S_view_files_amp_env, g_view_files_set_amp_env_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_view_files_speed_style, g_view_files_speed_style_w, H_view_files_speed_style,
- S_setB S_view_files_speed_style, g_view_files_set_speed_style_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_view_files_speed, g_view_files_speed_w, H_view_files_speed,
- S_setB S_view_files_speed, g_view_files_set_speed_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_view_files_files, g_view_files_files_w, H_view_files_files,
- S_setB S_view_files_files, g_view_files_set_files_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_view_files_selected_files, g_view_files_selected_files_w, H_view_files_selected_files,
- S_setB S_view_files_selected_files, g_view_files_set_selected_files_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE(S_add_sound_file_extension, g_add_sound_file_extension_w, 1, 0, 0, H_add_sound_file_extension);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_sound_file_extensions, g_sound_file_extensions_w, H_sound_file_extensions,
- S_setB S_sound_file_extensions, g_set_sound_file_extensions_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE(S_sound_file_p, g_sound_file_p_w, 1, 0, 0, H_sound_file_p);
- XEN_DEFINE_PROCEDURE(S_file_write_date, g_file_write_date_w, 1, 0, 0, H_file_write_date);
- XEN_DEFINE_PROCEDURE(S_soundfont_info, g_soundfont_info_w, 0, 1, 0, H_soundfont_info);
- XEN_DEFINE_PROCEDURE(S_add_directory_to_view_files_list, g_add_directory_to_view_files_list_w, 1, 1, 0, H_add_directory_to_view_files_list);
- XEN_DEFINE_PROCEDURE(S_add_file_to_view_files_list, g_add_file_to_view_files_list_w, 1, 1, 0, H_add_file_to_view_files_list);
- XEN_DEFINE_PROCEDURE(S_sound_files_in_directory, g_sound_files_in_directory_w, 0, 1, 0, H_sound_files_in_directory);
- XEN_DEFINE_PROCEDURE(S_open_file_dialog, g_open_file_dialog_w, 0, 1, 0, H_open_file_dialog);
- XEN_DEFINE_PROCEDURE(S_mix_file_dialog, g_mix_file_dialog_w, 0, 1, 0, H_mix_file_dialog);
- XEN_DEFINE_PROCEDURE(S_insert_file_dialog, g_insert_file_dialog_w, 0, 1, 0, H_insert_file_dialog);
- XEN_DEFINE_PROCEDURE(S_view_files_dialog, g_view_files_dialog_w, 0, 2, 0, H_view_files_dialog);
- XEN_DEFINE_PROCEDURE(S_edit_header_dialog, g_edit_header_dialog_w, 0, 1, 0, H_edit_header_dialog);
- XEN_DEFINE_PROCEDURE(S_save_selection_dialog, g_save_selection_dialog_w, 0, 1, 0, H_save_selection_dialog);
- XEN_DEFINE_PROCEDURE(S_save_region_dialog, g_save_region_dialog_w, 0, 1, 0, H_save_region_dialog);
- XEN_DEFINE_PROCEDURE(S_save_sound_dialog, g_save_sound_dialog_w, 0, 1, 0, H_save_sound_dialog);
- XEN_DEFINE_PROCEDURE(S_new_sound_dialog, g_new_sound_dialog_w, 0, 1, 0, H_new_sound_dialog);
- XEN_DEFINE_PROCEDURE(S_info_dialog, g_info_dialog_w, 2, 0, 0, H_info_dialog);
- XEN_DEFINE_PROCEDURE(S_disk_kspace, g_disk_kspace_w, 1, 0, 0, H_disk_kspace);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_sound_loop_info, g_sound_loop_info_w, H_sound_loop_info,
- S_setB S_sound_loop_info, g_set_sound_loop_info_w, 0, 1, 1, 1);
-
- XEN_DEFINE_VARIABLE(S_snd_opened_sound, snd_opened_sound, XEN_FALSE);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_view_files_sort, g_view_files_sort_w, H_view_files_sort,
- S_setB S_view_files_sort, g_set_view_files_sort_w, 0, 1, 1, 1);
-
- XEN_ADD_HOOK(ss->snd_open_file_hook, vf_open_file_watcher_w, "view-files-dialog-open-file-handler", "view-files dialog open-file handler");
-
- #define H_open_hook S_open_hook " (filename): called each time a file is opened (before the actual open). \
+#if HAVE_SCHEME
+ s7_pointer pl_b, pl_bb, pl_i, pl_ii, pl_s, pl_ss, pl_d, pl_dr, pl_zb, pl_l, pl_ll, pl_bs, pl_is, pl_lt, pl_zt, pl_zss, pl_ltl, pl_ls;
+ {
+ s7_pointer i, b, d, r, s, p, l, t, z;
+ i = s7_make_symbol(s7, "integer?");
+ b = s7_make_symbol(s7, "boolean?");
+ d = s7_make_symbol(s7, "float?");
+ r = s7_make_symbol(s7, "real?");
+ s = s7_make_symbol(s7, "string?");
+ p = s7_make_symbol(s7, "pair?");
+ l = s7_make_symbol(s7, "list");
+ t = s7_t(s7);
+
+ z = s7_make_signature(s7, 2, b, p);
+ pl_b = s7_make_signature(s7, 1, b);
+ pl_bb = s7_make_signature(s7, 2, b, b);
+ pl_bs = s7_make_signature(s7, 2, b, s);
+ pl_i = s7_make_signature(s7, 1, i);
+ pl_ii = s7_make_signature(s7, 2, i, i);
+ pl_is = s7_make_signature(s7, 2, i, s);
+ pl_s = s7_make_signature(s7, 1, s);
+ pl_ss = s7_make_signature(s7, 2, s, s);
+ pl_d = s7_make_signature(s7, 1, d);
+ pl_dr = s7_make_signature(s7, 2, d, r);
+ pl_zb = s7_make_signature(s7, 2, z, b);
+ pl_zt = s7_make_signature(s7, 2, z, t);
+ pl_zss = s7_make_signature(s7, 3, z, s, s);
+ pl_l = s7_make_signature(s7, 1, l);
+ pl_ll = s7_make_signature(s7, 2, l, l);
+ pl_lt = s7_make_signature(s7, 2, l, t);
+ pl_ls = s7_make_signature(s7, 2, l, s);
+ pl_ltl = s7_make_signature(s7, 3, l, t, l);
+ }
+#endif
+
+ Xen_define_typed_procedure(S_add_sound_file_extension, g_add_sound_file_extension_w, 1, 0, 0, H_add_sound_file_extension, pl_ss);
+ Xen_define_typed_dilambda(S_sound_file_extensions, g_sound_file_extensions_w, H_sound_file_extensions,
+ S_set S_sound_file_extensions, g_set_sound_file_extensions_w, 0, 0, 1, 0, pl_l, pl_ll);
+
+ Xen_define_typed_procedure(S_is_sound_file, g_is_sound_file_w, 1, 0, 0, H_is_sound_file, pl_bs);
+ Xen_define_typed_procedure(S_file_write_date, g_file_write_date_w, 1, 0, 0, H_file_write_date, pl_is);
+ Xen_define_typed_procedure(S_soundfont_info, g_soundfont_info_w, 0, 1, 0, H_soundfont_info, pl_lt);
+ Xen_define_typed_procedure(S_sound_files_in_directory, g_sound_files_in_directory_w, 0, 1, 0, H_sound_files_in_directory, pl_ls);
+ Xen_define_typed_procedure(S_disk_kspace, g_disk_kspace_w, 1, 0, 0, H_disk_kspace, pl_is);
+
+ Xen_define_typed_procedure(S_open_file_dialog, g_open_file_dialog_w, 0, 1, 0, H_open_file_dialog, pl_zb);
+ Xen_define_typed_procedure(S_mix_file_dialog, g_mix_file_dialog_w, 0, 1, 0, H_mix_file_dialog, pl_zb);
+ Xen_define_typed_procedure(S_insert_file_dialog, g_insert_file_dialog_w, 0, 1, 0, H_insert_file_dialog, pl_zb);
+ Xen_define_typed_procedure(S_edit_header_dialog, g_edit_header_dialog_w, 0, 1, 0, H_edit_header_dialog, pl_zt);
+ Xen_define_typed_procedure(S_save_selection_dialog, g_save_selection_dialog_w, 0, 1, 0, H_save_selection_dialog, pl_zb);
+ Xen_define_typed_procedure(S_save_region_dialog, g_save_region_dialog_w, 0, 1, 0, H_save_region_dialog, pl_zb);
+ Xen_define_typed_procedure(S_save_sound_dialog, g_save_sound_dialog_w, 0, 1, 0, H_save_sound_dialog, pl_zb);
+ Xen_define_typed_procedure(S_new_sound_dialog, g_new_sound_dialog_w, 0, 1, 0, H_new_sound_dialog, pl_zb);
+ Xen_define_typed_procedure(S_info_dialog, g_info_dialog_w, 2, 0, 0, H_info_dialog, pl_zss);
+
+ Xen_define_typed_dilambda(S_sound_loop_info, g_sound_loop_info_w, H_sound_loop_info,
+ S_set S_sound_loop_info, g_set_sound_loop_info_w, 0, 1, 1, 1, pl_lt, pl_ltl);
+
+ Xen_define_variable(S_snd_opened_sound, snd_opened_sound, Xen_false);
+
+ #define H_open_hook S_open_hook " (name): called each time a file is opened (before the actual open). \
If it returns " PROC_TRUE ", the file is not opened."
#define H_before_close_hook S_before_close_hook " (snd): called each time a file is closed (before the close). \
@@ -6074,58 +3846,37 @@ If it returns " PROC_TRUE ", the file is not closed."
#define H_close_hook S_close_hook " (snd): called each time a file is closed (before the close)."
- #define H_bad_header_hook S_bad_header_hook " (filename): called if a file has some bogus-looking header. \
+ #define H_bad_header_hook S_bad_header_hook " (name): called if a file has some bogus-looking header. \
Return " PROC_TRUE " to give up on that file."
- #define H_after_save_as_hook S_after_save_as_hook " (saved-sound-index save-as-full-filename from-save-as-dialog): called \
+ #define H_after_save_as_hook S_after_save_as_hook " (snd name dialog): called \
upon File:Save as or " S_save_sound_as " completion."
- #define H_before_save_as_hook S_before_save_as_hook " (index filename selection srate type format comment): called \
+ #define H_before_save_as_hook S_before_save_as_hook " (snd name selection sampling-rate sample-type header-type comment): called \
before File:Save as or " S_save_sound_as ". Provides a way to fixup a sound just before it is saved."
-#if HAVE_SCHEME
- #define H_during_open_hook S_during_open_hook " (fd name reason): called after file is opened, \
-but before data has been read. \n\
- (add-hook! " S_during_open_hook "\n\
- (lambda (fd name reason) \n\
- (if (= (" S_mus_sound_header_type " name) " S_mus_raw ")\n\
- (set! (" S_mus_file_prescaler " fd) 500.0))))"
+ #define H_during_open_hook S_during_open_hook " (fd name reason): called after file is opened, but before data has been read."
+#if HAVE_SCHEME
#define H_after_open_hook S_after_open_hook " (snd): called just before the new file's window is displayed. \
This provides a way to set various sound-specific defaults. \n\
- (add-hook! " S_after_open_hook "\n\
+ (hook-push " S_after_open_hook "\n\
(lambda (snd) \n\
(if (> (" S_channels " snd) 1) \n\
(set! (" S_channel_style " snd) " S_channels_combined "))))"
#endif
#if HAVE_RUBY
- #define H_during_open_hook "$" S_during_open_hook " lambda do |fd, name, reason| ...; called after file is opened, \
-but before data has been read. \n\
- $during_open_hook.add_hook!(\"during-open-hook\") do |fd, name, reason|\n\
- if (mus_sound_header_type(name) == Mus_raw)\n\
- set_mus_file_prescaler(fd, 500.0)\n\
- end\n\
- end"
#define H_after_open_hook S_after_open_hook " (snd): called just before the new file's window is displayed. \
This provides a way to set various sound-specific defaults. \n\
$after_open_hook.add-hook!(\"set-channels-combined\") do |snd| \n\
if (channels(snd) > 1) \n\
- set_channel_style(snd, Channels_combined)\n\
+ set_channel_style(Channels_combined, snd)\n\
end\n\
end"
#endif
#if HAVE_FORTH
- #define H_during_open_hook S_during_open_hook " (fd name reason): called after file is opened, \
-but before data has been read. \n\
-" S_during_open_hook " lambda: <{ fd name reason }>\n\
- name " S_mus_sound_header_type " " S_mus_raw " = if\n\
- 500.0 fd set-" S_mus_file_prescaler "\n\
- else\n\
- #f\n\
- then\n\
-; add-hook!"
#define H_after_open_hook S_after_open_hook " (snd): called just before the new file's window is displayed. \
This provides a way to set various sound-specific defaults. \n\
" S_after_open_hook " lambda: <{ snd }>\n\
@@ -6137,26 +3888,21 @@ This provides a way to set various sound-specific defaults. \n\
; add-hook!"
#endif
- #define H_output_name_hook S_output_name_hook " (current-name): called from the File:New dialog. If it returns a filename, \
-that name is presented in the New File dialog."
+ open_hook = Xen_define_hook(S_open_hook, "(make-hook 'name)", 1, H_open_hook);
+ before_close_hook = Xen_define_hook(S_before_close_hook, "(make-hook 'snd)", 1, H_before_close_hook);
+ close_hook = Xen_define_hook(S_close_hook, "(make-hook 'snd)", 1, H_close_hook);
+ bad_header_hook = Xen_define_hook(S_bad_header_hook, "(make-hook 'name)", 1, H_bad_header_hook);
+ after_save_as_hook = Xen_define_hook(S_after_save_as_hook, "(make-hook 'snd 'name 'dialog)", 3, H_after_save_as_hook);
+ before_save_as_hook = Xen_define_hook(S_before_save_as_hook, "(make-hook 'snd 'name 'selection 'sampling-rate 'sample-type 'header-type 'comment)", 7, H_before_save_as_hook);
+ during_open_hook = Xen_define_hook(S_during_open_hook, "(make-hook 'fd 'name 'reason)", 3, H_during_open_hook);
+ after_open_hook = Xen_define_hook(S_after_open_hook, "(make-hook 'snd)", 1, H_after_open_hook);
- open_hook = XEN_DEFINE_HOOK(S_open_hook, 1, H_open_hook); /* arg = filename */
- before_close_hook = XEN_DEFINE_HOOK(S_before_close_hook, 1, H_before_close_hook); /* arg = sound index */
- close_hook = XEN_DEFINE_HOOK(S_close_hook, 1, H_close_hook); /* arg = sound index */
- bad_header_hook = XEN_DEFINE_HOOK(S_bad_header_hook, 1, H_bad_header_hook); /* arg = filename */
- after_save_as_hook = XEN_DEFINE_HOOK(S_after_save_as_hook, 3, H_after_save_as_hook); /* args: index filename from-dialog */
- before_save_as_hook = XEN_DEFINE_HOOK(S_before_save_as_hook, 7, H_before_save_as_hook); /* args: index filename selection srate type format comment */
- during_open_hook = XEN_DEFINE_HOOK(S_during_open_hook, 3, H_during_open_hook); /* args = fd filename reason */
- after_open_hook = XEN_DEFINE_HOOK(S_after_open_hook, 1, H_after_open_hook); /* args = sound */
- output_name_hook = XEN_DEFINE_HOOK(S_output_name_hook, 1, H_output_name_hook); /* arg = current name, if any */
-
- #define H_open_raw_sound_hook S_open_raw_sound_hook " (filename current-choices): called when a headerless sound file is opened. \
+ #define H_open_raw_sound_hook S_open_raw_sound_hook " (name state): called when a headerless sound file is opened. \
Its result can be a list describing the raw file's attributes (thereby bypassing the Raw File Dialog and so on). \
-The list (passed to subsequent hook functions as 'current-choice') is interpreted as \
-(list chans srate data-format data-location data-length) where trailing elements can \
+The list is interpreted as (list chans srate sample-type data-location data-length) where trailing elements can \
be omitted (location defaults to 0, and length defaults to the file length in bytes)."
- open_raw_sound_hook = XEN_DEFINE_HOOK(S_open_raw_sound_hook, 2, H_open_raw_sound_hook); /* args = filename current-result */
+ open_raw_sound_hook = Xen_define_hook(S_open_raw_sound_hook, "(make-hook 'name 'state)", 2, H_open_raw_sound_hook);
#define H_update_hook S_update_hook " (snd): called just before " S_update_sound " is called. \
The update process can be triggered by a variety of situations, not just by " S_update_sound ". \
@@ -6166,82 +3912,114 @@ completion of the update operation; its argument is the (possibly different) sou
Snd tries to maintain the index across the update, but if you change the number of channels \
the newly updated sound may have a different index."
- update_hook = XEN_DEFINE_HOOK(S_update_hook, 1, H_update_hook); /* arg = sound index */
+ update_hook = Xen_define_hook(S_update_hook, "(make-hook 'snd)", 1, H_update_hook);
- #define H_view_files_select_hook S_view_files_select_hook "(filename): called when a file is selected in the \
-files list of the View Files dialog. If it returns " PROC_TRUE ", the default action, opening the file, is omitted."
+ Xen_define_typed_procedure(S_snd_tempnam, g_snd_tempnam_w, 0, 0, 0, H_snd_tempnam, pl_s);
- view_files_select_hook = XEN_DEFINE_HOOK(S_view_files_select_hook, 2, H_view_files_select_hook); /* args = dialog, filename */
+ Xen_define_typed_dilambda(S_auto_update, g_auto_update_w, H_auto_update,
+ S_set S_auto_update, g_set_auto_update_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_auto_update_interval, g_auto_update_interval_w, H_auto_update_interval,
+ S_set S_auto_update_interval, g_set_auto_update_interval_w, 0, 0, 1, 0, pl_d, pl_dr);
+
+ Xen_define_typed_dilambda(S_ask_before_overwrite, g_ask_before_overwrite_w, H_ask_before_overwrite,
+ S_set S_ask_before_overwrite, g_set_ask_before_overwrite_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_with_toolbar, g_with_toolbar_w, H_with_toolbar,
+ S_set S_with_toolbar, g_set_with_toolbar_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_with_tooltips, g_with_tooltips_w, H_with_tooltips,
+ S_set S_with_tooltips, g_set_with_tooltips_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_with_menu_icons, g_with_menu_icons_w, H_with_menu_icons,
+ S_set S_with_menu_icons, g_set_with_menu_icons_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_save_as_dialog_src, g_save_as_dialog_src_w, H_save_as_dialog_src,
+ S_set S_save_as_dialog_src, g_set_save_as_dialog_src_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_save_as_dialog_auto_comment, g_save_as_dialog_auto_comment_w, H_save_as_dialog_auto_comment,
+ S_set S_save_as_dialog_auto_comment, g_set_save_as_dialog_auto_comment_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_remember_sound_state, g_remember_sound_state_w, H_remember_sound_state,
+ S_set S_remember_sound_state, g_set_remember_sound_state_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_ask_about_unsaved_edits, g_ask_about_unsaved_edits_w, H_ask_about_unsaved_edits,
+ S_set S_ask_about_unsaved_edits, g_set_ask_about_unsaved_edits_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_show_full_duration, g_show_full_duration_w, H_show_full_duration,
+ S_set S_show_full_duration, g_set_show_full_duration_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_show_full_range, g_show_full_range_w, H_show_full_range,
+ S_set S_show_full_range, g_set_show_full_range_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_initial_beg, g_initial_beg_w, H_initial_beg,
+ S_set S_initial_beg, g_set_initial_beg_w, 0, 0, 1, 0, pl_d, pl_dr);
+
+ Xen_define_typed_dilambda(S_initial_dur, g_initial_dur_w, H_initial_dur,
+ S_set S_initial_dur, g_set_initial_dur_w, 0, 0, 1, 0, pl_d, pl_dr);
+
+ Xen_define_typed_dilambda(S_default_output_chans, g_default_output_chans_w, H_default_output_chans,
+ S_set S_default_output_chans, g_set_default_output_chans_w, 0, 0, 1, 0, pl_i, pl_ii);
+
+ Xen_define_typed_dilambda(S_default_output_srate, g_default_output_srate_w, H_default_output_srate,
+ S_set S_default_output_srate, g_set_default_output_srate_w, 0, 0, 1, 0, pl_i, pl_ii);
+
+ Xen_define_typed_dilambda(S_default_output_header_type, g_default_output_header_type_w, H_default_output_header_type,
+ S_set S_default_output_header_type, g_set_default_output_header_type_w, 0, 0, 1, 0, pl_i, pl_ii);
+
+ Xen_define_typed_dilambda(S_default_output_sample_type, g_default_output_sample_type_w, H_default_output_sample_type,
+ S_set S_default_output_sample_type, g_set_default_output_sample_type_w, 0, 0, 1, 0, pl_i, pl_ii);
+ Xen_define_typed_dilambda(S_clipping, g_clipping_w, H_clipping,
+ S_set S_clipping, g_set_clipping_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_safe_procedure(S_add_file_filter, g_add_file_filter_w, 2, 0, 0, H_add_file_filter);
+ Xen_define_safe_procedure(S_delete_file_filter, g_delete_file_filter_w, 1, 0, 0, H_delete_file_filter);
- /* file-filters and file-sorters are lists from user's point of view, but I want to
- * make sure they're gc-protected through add/delete/set, and want such code compatible
- * with current Ruby xen macros, so I'll use an array internally.
- */
ss->file_filters_size = INITIAL_FILE_FILTERS_SIZE;
- ss->file_sorters_size = INITIAL_FILE_SORTERS_SIZE;
- ss->file_filters = XEN_MAKE_VECTOR(ss->file_filters_size, XEN_FALSE);
- ss->file_sorters = XEN_MAKE_VECTOR(ss->file_sorters_size, XEN_FALSE);
- XEN_PROTECT_FROM_GC(ss->file_filters);
- XEN_PROTECT_FROM_GC(ss->file_sorters);
-
- XEN_DEFINE_PROCEDURE(S_add_file_filter, g_add_file_filter_w, 2, 0, 0, H_add_file_filter);
- XEN_DEFINE_PROCEDURE(S_delete_file_filter, g_delete_file_filter_w, 1, 0, 0, H_delete_file_filter);
-
- XEN_DEFINE_PROCEDURE(S_add_file_sorter, g_add_file_sorter_w, 2, 0, 0, H_add_file_sorter);
- XEN_DEFINE_PROCEDURE(S_delete_file_sorter, g_delete_file_sorter_w, 1, 0, 0, H_delete_file_sorter);
- XEN_DEFINE_PROCEDURE(S_snd_tempnam, g_snd_tempnam_w, 0, 0, 0, H_snd_tempnam);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_auto_update, g_auto_update_w, H_auto_update,
- S_setB S_auto_update, g_set_auto_update_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_auto_update_interval, g_auto_update_interval_w, H_auto_update_interval,
- S_setB S_auto_update_interval, g_set_auto_update_interval_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_ask_before_overwrite, g_ask_before_overwrite_w, H_ask_before_overwrite,
- S_setB S_ask_before_overwrite, g_set_ask_before_overwrite_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_toolbar, g_with_toolbar_w, H_with_toolbar,
- S_setB S_with_toolbar, g_set_with_toolbar_w, 0, 0, 1, 0);
+ ss->file_filters = Xen_make_vector(ss->file_filters_size, Xen_false);
+ Xen_GC_protect(ss->file_filters);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_tooltips, g_with_tooltips_w, H_with_tooltips,
- S_setB S_with_tooltips, g_set_with_tooltips_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_menu_icons, g_with_menu_icons_w, H_with_menu_icons,
- S_setB S_with_menu_icons, g_set_with_menu_icons_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_save_as_dialog_src, g_save_as_dialog_src_w, H_save_as_dialog_src,
- S_setB S_save_as_dialog_src, g_set_save_as_dialog_src_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_save_as_dialog_auto_comment, g_save_as_dialog_auto_comment_w, H_save_as_dialog_auto_comment,
- S_setB S_save_as_dialog_auto_comment, g_set_save_as_dialog_auto_comment_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_remember_sound_state, g_remember_sound_state_w, H_remember_sound_state,
- S_setB S_remember_sound_state, g_set_remember_sound_state_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_ask_about_unsaved_edits, g_ask_about_unsaved_edits_w, H_ask_about_unsaved_edits,
- S_setB S_ask_about_unsaved_edits, g_set_ask_about_unsaved_edits_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_show_full_duration, g_show_full_duration_w, H_show_full_duration,
- S_setB S_show_full_duration, g_set_show_full_duration_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_initial_beg, g_initial_beg_w, H_initial_beg,
- S_setB S_initial_beg, g_set_initial_beg_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_initial_dur, g_initial_dur_w, H_initial_dur,
- S_setB S_initial_dur, g_set_initial_dur_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_default_output_chans, g_default_output_chans_w, H_default_output_chans,
- S_setB S_default_output_chans, g_set_default_output_chans_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_default_output_srate, g_default_output_srate_w, H_default_output_srate,
- S_setB S_default_output_srate, g_set_default_output_srate_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_default_output_header_type, g_default_output_header_type_w, H_default_output_header_type,
- S_setB S_default_output_header_type, g_set_default_output_header_type_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_default_output_data_format, g_default_output_data_format_w, H_default_output_data_format,
- S_setB S_default_output_data_format, g_set_default_output_data_format_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_clipping, g_clipping_w, H_clipping,
- S_setB S_clipping, g_set_clipping_w, 0, 0, 1, 0);
+#if HAVE_SCHEME
+ s7_symbol_set_documentation(s7, ss->default_output_header_type_symbol, "*default-output-header-type*: header type when a new file is created (mus-next etc)");
+ s7_symbol_set_documentation(s7, ss->default_output_sample_type_symbol, "*default-output-sample-type*: sample type when a new file is created (mus-ldouble etc)");
+ s7_symbol_set_documentation(s7, ss->default_output_chans_symbol, "*default-output-chans*: number of channels when a new file is created (1)");
+ s7_symbol_set_documentation(s7, ss->default_output_srate_symbol, "*default-output-srate*: sampling rate when a new file is created (44100)");
+ s7_symbol_set_documentation(s7, ss->ask_before_overwrite_symbol, "*ask-before-overwrite*: #t if you want Snd to ask before overwriting a file.");
+ s7_symbol_set_documentation(s7, ss->ask_about_unsaved_edits_symbol, "*ask-about-unsaved-edits*: #t if you want Snd to ask whether to save unsaved edits when a sound is closed.");
+ s7_symbol_set_documentation(s7, ss->show_full_duration_symbol, "*show-full-duration*: #t if you want the entire sound displayed whn it is opened.");
+ s7_symbol_set_documentation(s7, ss->show_full_range_symbol, "*show-full-range*: #t if you want the graph y-bounds to accommodate the sound's max and min when it is opened.");
+ s7_symbol_set_documentation(s7, ss->remember_sound_state_symbol, "*remember-sound-state*: #t if you want a Snd to remember the current state of each sound when it is closed, restoring that state when it is opened again later.");
+ s7_symbol_set_documentation(s7, ss->save_as_dialog_src_symbol, "*save-as-dialog-src*: #t if you want the 'src' button set by default in the various Save-as dialogs");
+ s7_symbol_set_documentation(s7, ss->save_as_dialog_auto_comment_symbol, "*save-as-dialog-auto-comment*: #t if you want the 'auto' button set by default in the various Save-as dialogs");
+ s7_symbol_set_documentation(s7, ss->with_toolbar_symbol, "*with-toolbar*: #t if you want a toolbar");
+ s7_symbol_set_documentation(s7, ss->with_tooltips_symbol, "*with-tooltips*: #t if you want tooltips");
+ s7_symbol_set_documentation(s7, ss->with_menu_icons_symbol, "*with-menu-icons*: #t if you want icons in the menus (gtk only)");
+ s7_symbol_set_documentation(s7, ss->initial_beg_symbol, "*initial-beg*: the begin point (in seconds) for the initial graph of a sound.");
+ s7_symbol_set_documentation(s7, ss->initial_dur_symbol, "*initial-dur*: the duration (in seconds) for the initial graph of a sound.");
+ s7_symbol_set_documentation(s7, ss->auto_update_symbol, "*auto-update*: #t if Snd should automatically update a file if it changes unexpectedly");
+ s7_symbol_set_documentation(s7, ss->auto_update_interval_symbol, "*auto-update-interval*: time (seconds) between background checks for changed file on disk (60)");
+ s7_symbol_set_documentation(s7, ss->clipping_symbol, "*clipping*: #t if Snd should clip output values");
+
+
+ s7_symbol_set_access(s7, ss->default_output_header_type_symbol, s7_make_function(s7, "[acc-" S_default_output_header_type "]", acc_default_output_header_type, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->default_output_sample_type_symbol, s7_make_function(s7, "[acc-" S_default_output_sample_type "]", acc_default_output_sample_type, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->default_output_chans_symbol, s7_make_function(s7, "[acc-" S_default_output_chans "]", acc_default_output_chans, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->default_output_srate_symbol, s7_make_function(s7, "[acc-" S_default_output_srate "]", acc_default_output_srate, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->ask_before_overwrite_symbol, s7_make_function(s7, "[acc-" S_ask_before_overwrite "]", acc_ask_before_overwrite, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->ask_about_unsaved_edits_symbol, s7_make_function(s7, "[acc-" S_ask_about_unsaved_edits "]", acc_ask_about_unsaved_edits, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_full_duration_symbol, s7_make_function(s7, "[acc-" S_show_full_duration "]", acc_show_full_duration, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_full_range_symbol, s7_make_function(s7, "[acc-" S_show_full_range "]", acc_show_full_range, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->remember_sound_state_symbol, s7_make_function(s7, "[acc-" S_remember_sound_state "]", acc_remember_sound_state, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->save_as_dialog_src_symbol, s7_make_function(s7, "[acc-" S_save_as_dialog_src "]", acc_save_as_dialog_src, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->save_as_dialog_auto_comment_symbol, s7_make_function(s7, "[acc-" S_save_as_dialog_auto_comment "]", acc_save_as_dialog_auto_comment, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_toolbar_symbol, s7_make_function(s7, "[acc-" S_with_toolbar "]", acc_with_toolbar, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_tooltips_symbol, s7_make_function(s7, "[acc-" S_with_tooltips "]", acc_with_tooltips, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_menu_icons_symbol, s7_make_function(s7, "[acc-" S_with_menu_icons "]", acc_with_menu_icons, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->initial_beg_symbol, s7_make_function(s7, "[acc-" S_initial_beg "]", acc_initial_beg, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->initial_dur_symbol, s7_make_function(s7, "[acc-" S_initial_dur "]", acc_initial_dur, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->auto_update_symbol, s7_make_function(s7, "[acc-" S_auto_update "]", acc_auto_update, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->auto_update_interval_symbol, s7_make_function(s7, "[acc-" S_auto_update_interval "]", acc_auto_update_interval, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->clipping_symbol, s7_make_function(s7, "[acc-" S_clipping "]", acc_clipping, 2, 0, false, "accessor"));
+#endif
}
+
diff --git a/snd-file.h b/snd-file.h
index 3286e9c..6aa28e2 100644
--- a/snd-file.h
+++ b/snd-file.h
@@ -1,150 +1,19 @@
#ifndef SND_FILE_H
#define SND_FILE_H
-typedef enum {VF_AT_CURSOR, VF_AT_END, VF_AT_BEGINNING, VF_AT_MARK, VF_AT_SAMPLE} vf_location_t;
-typedef struct {
- widget_t rw;
- widget_t nm;
- widget_t pl;
- int pos;
- void *vdat;
-} vf_row;
-
-typedef struct {
- vf_row **file_list_entries;
- int index, size;
- char **names;
- char **full_names;
- int end;
- int sorter;
- int *selected_files;
- int selected_files_size;
- int currently_selected_files;
- mus_float_t amp;
- vf_location_t location_choice;
- mus_float_t speed;
- graphics_context *env_ax;
- env_editor *spf;
- env *amp_env;
- bool error_p;
- int sort_items_size;
- speed_style_t speed_style;
- mus_long_t beg;
-
- int dirs_size;
- fam_info **dirs;
- char **dir_names;
- bool need_update;
-
- widget_t dialog;
- widget_t file_list;
- widget_t file_list_holder;
- widget_t left_title;
- widget_t info1;
- widget_t info2;
- widget_t openB;
- widget_t mixB;
- widget_t removeB;
- widget_t insertB;
-#if (!HAVE_FAM)
- widget_t clearB;
- widget_t updateB;
-#endif
- widget_t at_cursor_button;
- widget_t at_end_button;
- widget_t at_beginning_button;
- widget_t at_mark_button;
- widget_t at_sample_button;
- widget_t at_sample_text;
- widget_t at_mark_text;
- widget_t amp_number;
- widget_t amp_scrollbar;
- widget_t speed_number;
- widget_t speed_scrollbar;
- widget_t env_drawer;
- widget_t a_to_z;
- widget_t z_to_a;
- widget_t new_to_old;
- widget_t old_to_new;
- widget_t small_to_big;
- widget_t big_to_small;
- widget_t smenu;
- widget_t current_play_button;
- widget_t amp_event;
- widget_t speed_event;
- widget_t speed_label_event;
- widget_t add_text;
- widget_t* sort_items;
-
-#if USE_GTK
- gc_t *env_gc;
- GtkAdjustment *amp_adj;
- GtkAdjustment *speed_adj;
-
- gulong at_sample_text_handler_id, at_mark_text_handler_id;
- gulong at_sample_button_handler_id, at_mark_button_handler_id;
- gulong add_text_handler_id;
-#endif
-#if USE_MOTIF
- GC env_gc;
-#endif
-} view_files_info;
-
-void vf_unhighlight_row(widget_t nm, widget_t rw);
-void vf_highlight_row(widget_t nm, widget_t rw);
-void vf_post_info(view_files_info *vdat, int pos);
-void vf_unpost_info(view_files_info *vdat);
-mus_long_t vf_location(view_files_info *vdat);
-void vf_post_error(const char *error_msg, view_files_info *data);
-void redirect_vf_post_error(const char *error_msg, void *data);
-void redirect_vf_post_location_error(const char *error_msg, void *data);
-void vf_post_add_error(const char *error_msg, view_files_info *data);
-widget_t start_view_files_dialog_1(view_files_info *vdat, bool managed);
-void vf_post_selected_files_list(view_files_info *vdat);
-void view_files_add_file_or_directory(view_files_info *vdat, const char *file_or_dir);
-void vf_reflect_sort_choice_in_menu(view_files_info *vdat);
-vf_row *view_files_make_row(view_files_info *vdat, widget_t last_row);
-void vf_flash_row(vf_row *r);
-
-void vf_set_amp(view_files_info *vdat, mus_float_t val);
-void vf_set_speed(view_files_info *vdat, mus_float_t val);
-void vf_set_amp_env(view_files_info *vdat, env *new_e);
-
-void view_files_display_list(view_files_info *vdat);
-void view_files_mix_selected_files(widget_t w, view_files_info *vdat);
-void view_files_insert_selected_files(widget_t w, view_files_info *vdat);
-void view_files_open_selected_files(view_files_info *vdat);
-void view_files_remove_selected_files(view_files_info *vdat);
-void view_files_select(vf_row *r, bool add_to_selected);
-bool view_files_play(view_files_info *vdat, int pos, bool play);
-void vf_clear_error(view_files_info *vdat);
-void view_files_clear_list(view_files_info *vdat);
-view_files_info *new_view_files_dialog(void);
-void view_files_update_list(view_files_info *vdat);
-void add_directory_to_view_files_list(view_files_info *vdat, const char *dirname);
-void add_file_to_view_files_list(view_files_info *vdat, const char *filename, const char *fullname);
-void vf_mix_insert_buttons_set_sensitive(view_files_info *vdat, bool sensitive);
-void vf_open_remove_buttons_set_sensitive(view_files_info *vdat, bool sensitive);
-#if (!HAVE_FAM)
- void vf_clear_button_set_sensitive(view_files_info *vdat, bool sensitive);
-#endif
-void view_files_reflect_sort_items(void);
-int vf_mix(view_files_info *vdat);
-bool vf_insert(view_files_info *vdat);
char *dialog_get_title(widget_t dialog);
-const char **type_and_format_to_position(file_data *fdat, int type, int format);
-void position_to_type_and_format(file_data *fdat, int pos);
-int position_to_format(int header, int pos);
-int position_to_type(int pos);
+const char **header_type_and_sample_type_to_position(file_data *fdat, mus_header_t header_type, mus_sample_t sample_type);
+void position_to_header_type_and_sample_type(file_data *fdat, int pos);
+mus_sample_t position_to_sample_type(mus_header_t header, int pos);
+mus_header_t position_to_header_type(int pos);
const char **short_writable_headers(int *len);
const char **short_readable_headers(int *len);
const char **short_builtin_headers(int *len);
-bool encoded_header_p(int header_type);
-void snd_encode(int type, const char *input_filename, const char *output_filename);
+bool header_is_encoded(mus_header_t header_type);
+void snd_encode(mus_header_t type, const char *input_filename, const char *output_filename);
snd_info *file_is_open_elsewhere_and_has_unsaved_edits(snd_info *sp, const char *fullname);
-bool plausible_sound_file_p(const char *name);
snd_info *finish_opening_sound(snd_info *sp, bool selected);
bool edit_header_callback(snd_info *sp, file_data *edit_header_data,
@@ -153,12 +22,6 @@ bool edit_header_callback(snd_info *sp, file_data *edit_header_data,
void raw_data_dialog_to_file_info(const char *filename, char *title, char *info, read_only_t read_only, bool selected);
-typedef struct {
- time_t time;
- mus_long_t samps;
- char *filename, *full_filename;
-} sort_info;
-
#if USE_GTK
#define position_t gdouble
#define POSITION_UNKNOWN 0.0
@@ -168,20 +31,10 @@ typedef struct {
#endif
typedef struct {
- char *directory_name;
- position_t list_top;
-} dirpos_info;
-
-typedef struct {
- dirpos_info **dirs;
- int size, top;
-} dirpos_list;
-
-void dirpos_update(dirpos_list *dl, const char *dir, position_t pos);
-position_t dirpos_list_top(dirpos_list *dl, const char *dirname);
-dirpos_list *make_dirpos_list(void);
-
-void snd_sort(int sorter, sort_info **data, int len);
+ time_t time;
+ mus_long_t samps;
+ char *filename, *full_filename;
+} sort_info;
typedef struct {
sort_info **files;
@@ -191,23 +44,19 @@ typedef struct {
} dir_info;
enum {NO_FILE_FILTER, JUST_SOUNDS_FILTER};
-#define PARENT_DIRECTORY ".."
dir_info *free_dir_info (dir_info *dp);
dir_info *find_files_in_dir(const char *name);
dir_info *find_filtered_files_in_dir(const char *name, int filter_choice);
dir_info *find_filtered_files_in_dir_with_pattern(const char *name, int filter_choice, const char *pattern);
-#if USE_GTK
- dir_info *find_directories_in_dir(const char *name);
-#endif
-bool directory_exists(char *name);
-const char *short_data_format_name(int sndlib_format, const char *filename);
+const char *short_sample_type_name(mus_sample_t sndlib_sample_type, const char *filename);
#define FILENAME_LIST_SIZE 16
void remember_filename(const char *filename, char **names);
char **make_filename_list(void);
void preload_filenames(char **files);
+dir_info *find_sound_files_in_dir(const char *name);
#endif
diff --git a/snd-find.c b/snd-find.c
index c41b9ad..279eafb 100644
--- a/snd-find.c
+++ b/snd-find.c
@@ -1,672 +1,280 @@
#include "snd.h"
-static bool search_in_progress = false;
-
-typedef struct
-{
- int n;
- read_direction_t direction;
- int chans;
- mus_long_t inc, dur;
- chan_info **cps;
- snd_fd **fds;
-} gfd;
-
-#define MANY_PASSES 10000
-
-
-static void prepare_global_search(chan_info *cp, void *g0)
+static void clear_search_state(void)
{
- gfd *g = (gfd *)g0;
- mus_long_t this_dur;
- read_direction_t direction;
- direction = g->direction;
- g->cps[g->n] = cp;
- if (direction == READ_FORWARD)
+ if (Xen_is_procedure(ss->search_proc))
{
- g->fds[g->n] = init_sample_read(CURSOR(cp) + 1, cp, direction);
- this_dur = CURRENT_SAMPLES(cp) - CURSOR(cp);
- }
- else
- {
- g->fds[g->n] = init_sample_read(CURSOR(cp) - 1, cp, direction);
- this_dur = CURSOR(cp);
+ snd_unprotect_at(ss->search_proc_loc);
+ ss->search_proc_loc = NOT_A_GC_LOC;
}
- if (this_dur > g->dur) g->dur = this_dur;
- if (g->fds[g->n] != NULL) g->n++;
-}
-
+ ss->search_proc = Xen_undefined;
-#define KEEP_SEARCHING false
-#define STOP_SEARCHING true
-
-static bool run_global_search(gfd *g)
-{
- if ((XEN_PROCEDURE_P(ss->search_proc)) || (ss->search_tree))
- {
- int i, j, k;
- for (i = 0; i < g->chans; i++)
- {
- if (g->cps[i])
- {
- mus_float_t samp;
- XEN res;
- snd_fd *sf;
- if (!((g->cps[i])->sound)) return(STOP_SEARCHING);
- sf = g->fds[i];
- samp = read_sample(sf);
- if (ss->search_tree)
- {
- if (mus_run_evaluate_ptree_1f2b(ss->search_tree, samp))
- {
- g->n = i;
- return(STOP_SEARCHING);
- }
- }
- else
- {
- res = XEN_CALL_1(ss->search_proc,
- C_TO_XEN_DOUBLE((double)(samp)),
- "global search func");
- if (ss->stopped_explicitly)
- return(STOP_SEARCHING);
- if (XEN_TRUE_P(res))
- {
- g->n = i;
- return(STOP_SEARCHING);
- }
- else
- {
- if (XEN_INTEGER_P(res))
- {
- g->n = i; /* channel number */
- if (g->direction == READ_FORWARD)
- g->inc += XEN_TO_C_INT(res);
- else g->inc -= XEN_TO_C_INT(res);
- return(STOP_SEARCHING);
- }
- }
- }
- if (sf->at_eof)
- {
- sf = free_snd_fd(sf);
- g->fds[i] = NULL;
- g->cps[i] = NULL;
- k = 0;
- for (j = 0; j < g->chans; j++)
- if (g->cps[i])
- {
- k = 1;
- break;
- }
- if (k == 0) /* all at eof */
- {
- g->n = -1;
- return(STOP_SEARCHING);
- }
- }
- }
- }
- }
- g->inc++;
- return(KEEP_SEARCHING);
+ if (ss->search_expr) free(ss->search_expr);
+ ss->search_expr = NULL;
}
-static char search_message[PRINT_BUFFER_SIZE];
+#if (!USE_NO_GUI)
-char *global_search(read_direction_t direction)
+static void find_report(chan_info *cp, const char *msg)
{
- /* set up snd_fd for each active channel,
- * tick each one forward until a match is found,
- * update cursor/graph and report success (if any) in associated info window
- * subsequent runs (if no new text) repeat the search from the current locations
- */
- int chans, i, passes = 0, report_passes = 0;
- bool reporting = false;
- gfd *fd;
- chan_info *cp;
- if (search_in_progress)
- {
- mus_snprintf(search_message, PRINT_BUFFER_SIZE, "%s", "search in progress");
- return(search_message);
- }
-
- /* here and elsewhere when a new search is begun, even if using the previous search expression, the
- * expression needs to be re-evaluated, since otherwise in a search like:
- * (define (zero+)
- * (let ((lastn 0.0))
- * (lambda (n)
- * (let ((rtn (and (< lastn 0.0)
- * (>= n 0.0)
- * -1)))
- * (set! lastn n)
- * rtn))))
- * the notion of the previous sample will never be cleared.
- * But we do know that the expression is ok otherwise.
- * (This causes one redundant evaluation the first time around)
- * perhaps its should save the form, and evaluate that?
- */
- if (ss->search_tree == NULL)
- {
- if (ss->search_expr)
- {
- /* search_expr can be null if user set search_proc directly */
- clear_global_search_procedure(false);
- ss->search_proc = snd_catch_any(eval_str_wrapper, ss->search_expr, ss->search_expr);
- ss->search_proc_loc = snd_protect(ss->search_proc);
- }
- }
- search_in_progress = true;
- chans = active_channels(WITH_VIRTUAL_CHANNELS);
- search_message[0] = '\0';
- if (chans > 0)
- {
- fd = (gfd *)calloc(1, sizeof(gfd));
- fd->n = 0;
- fd->inc = 1;
- fd->direction = direction;
- fd->dur = 0;
- fd->chans = chans;
- fd->fds = (snd_fd **)calloc(chans, sizeof(snd_fd *));
- fd->cps = (chan_info **)calloc(chans, sizeof(chan_info *));
- for_each_normal_chan_with_void(prepare_global_search, (void *)fd);
- fd->n = -1;
- ss->stopped_explicitly = false;
- reporting = (fd->dur >= (REPORTING_SIZE * 10));
- if (reporting) set_find_dialog_label("0%");
- while (run_global_search(fd) == KEEP_SEARCHING)
- {
- passes++;
- if (passes >= MANY_PASSES)
- {
- check_for_event();
- passes = 0;
- fd->n = -1;
- if (reporting)
- {
- report_passes += MANY_PASSES;
- if (report_passes > REPORTING_SIZE)
- {
- char buf[8];
- mus_snprintf(buf, 8, "%d%%", (int)(100 * (double)(fd->inc) / (double)(fd->dur)));
- set_find_dialog_label(buf);
- report_passes = 0;
- }
- }
- }
- if (ss->stopped_explicitly) break;
- }
- if (ss->stopped_explicitly)
- mus_snprintf(search_message, PRINT_BUFFER_SIZE, "%s", "search stopped");
- else
- {
- if (fd->n == -1)
- mus_snprintf(search_message, PRINT_BUFFER_SIZE, "%s: not found", ss->search_expr);
- else
- {
- /* fd->n is winner, fd->inc is how far forward we searched from current cursor loc */
- cp = fd->cps[fd->n];
- set_find_dialog_label("");
- cp->cursor_on = true;
- if (direction == READ_FORWARD)
- cursor_move(cp, fd->inc);
- else cursor_move(cp, -fd->inc);
- /* now in its own info window show find state, and update graph if needed */
- show_cursor_info(cp);
- mus_snprintf(search_message, PRINT_BUFFER_SIZE, "found at " MUS_LD, CURSOR(cp));
- }
- }
- ss->stopped_explicitly = false;
- for (i = 0; i < chans; i++)
- free_snd_fd(fd->fds[i]);
- free(fd->fds);
- free(fd->cps);
- free(fd);
- }
- search_in_progress = false;
- return(search_message);
+ if (cp)
+ status_report(cp->sound, "%s", msg);
+ find_dialog_set_label(msg);
}
-#define REPORT_TICKS 10
-#define TREE_REPORT_TICKS 100
-
-static bool find_eval_error_p = false;
+static bool search_in_progress = false;
+static chan_info *previous_channel = NULL;
+#define MANY_PASSES 100000
-static void send_find_errors_to_minibuffer(const char *msg, void *data)
+static mus_long_t channel_find_forward(chan_info *cp)
{
- find_eval_error_p = true;
- display_minibuffer_error((snd_info *)data, msg);
- ss->stopped_explicitly = true;
+ mus_long_t i, end, start;
+
+ end = current_samples(cp);
+ start = cursor_sample(cp) + 1;
+ if (start >= end)
+ start = 0;
+ i = scan_channel(cp, start, end, ss->search_proc);
+ if (i < end)
+ return(i);
+ return(-1);
}
-static mus_long_t cursor_find_forward(snd_info *sp, chan_info *cp, int count)
+static mus_long_t channel_find_backward(chan_info *cp)
{
- int passes = 0, tick = 0;
- mus_long_t i = 0, end, start;
+ bool reported = false;
+ mus_long_t i, start, passes;
snd_fd *sf = NULL;
- XEN res = XEN_FALSE;
- bool progress_displayed = false;
- if (search_in_progress)
- {
- display_minibuffer_error(sp, "search already in progress");
- return(-1);
- }
- search_in_progress = true;
- if (cp->last_search_result == SEARCH_OK)
- start = CURSOR(cp) + 1;
- else start = 0;
- sf = init_sample_read(start, cp, READ_FORWARD);
- if (!sf)
- {
- search_in_progress = false;
- return(-1);
- }
- end = CURRENT_SAMPLES(cp);
- ss->stopped_explicitly = false;
- if (sp->search_tree)
- {
-
- for (i = start; i < end; i++, tick++)
- {
- if (mus_run_evaluate_ptree_1f2b(sp->search_tree, read_sample(sf)))
- {
- count--;
- if (count == 0) break;
- }
- else
- {
- if (tick > (MANY_PASSES * TREE_REPORT_TICKS))
- {
- char *msg;
- check_for_event();
- if (ss->stopped_explicitly) break;
- tick = 0;
- msg = mus_format("search at minute %d", (int)floor(i / (SND_SRATE(sp) * 60)));
- display_minibuffer_error(sp, msg);
- free(msg);
- progress_displayed = true;
- }
- }
- }
- }
- else
- {
- for (i = start, passes = 0; i < end; i++, passes++)
- {
- res = XEN_CALL_1(sp->search_proc,
- C_TO_XEN_DOUBLE((double)(read_sample(sf))),
- "local search func");
- if (XEN_NOT_FALSE_P(res))
- {
- count--;
- if (count == 0) break;
- }
- if (passes >= MANY_PASSES)
- {
- check_for_event();
- tick++;
- if ((tick > REPORT_TICKS) && (!(ss->stopped_explicitly)))
- {
- char *msg;
- tick = 0;
- msg = mus_format("search at minute %d", (int)floor(i / (SND_SRATE(sp) * 60)));
- display_minibuffer_error(sp, msg);
- free(msg);
- progress_displayed = true;
- }
- /* if user types C-s during an active search, we risk stomping on our current pointers */
- if (!(sp->active)) break;
- passes = 0;
- }
- if (ss->stopped_explicitly) break;
- }
- }
- ss->stopped_explicitly = false;
- if ((progress_displayed) &&
- (!find_eval_error_p))
- clear_minibuffer_error(sp);
- free_snd_fd(sf);
- search_in_progress = false;
- if (count != 0) return(-1); /* impossible sample number, so => failure */
- if (XEN_INTEGER_P(res))
- return(i + XEN_TO_C_INT(res));
- return(i);
-}
+ Xen res = Xen_false;
+ start = cursor_sample(cp) - 1;
+ if (start < 0)
+ start = current_samples(cp) - 1;
-static mus_long_t cursor_find_backward(snd_info *sp, chan_info *cp, int count)
-{
- mus_long_t i = 0, start, tick = 0;
- int passes = 0;
- snd_fd *sf = NULL;
- XEN res = XEN_FALSE;
- bool progress_displayed = false;
- if (search_in_progress)
- {
- display_minibuffer_error(sp, "search already in progress");
- return(-1);
- }
- search_in_progress = true;
- if (cp->last_search_result == SEARCH_OK)
- start = CURSOR(cp) - 1;
- else start = CURRENT_SAMPLES(cp) - 1;
sf = init_sample_read(start, cp, READ_BACKWARD);
if (!sf)
- {
- search_in_progress = false;
- return(-1);
- }
+ return(-1);
+
ss->stopped_explicitly = false;
- if (sp->search_tree)
- {
- for (i = start; i >= 0; i--, tick++)
- {
- if (mus_run_evaluate_ptree_1f2b(sp->search_tree, read_sample(sf)))
- {
- count--;
- if (count == 0) break;
- }
- else
- {
- if (tick > (MANY_PASSES * TREE_REPORT_TICKS))
- {
- char *msg;
- check_for_event();
- if (ss->stopped_explicitly) break;
- tick = 0;
- msg = mus_format("search at minute %d", (int)floor(i / (SND_SRATE(sp) * 60)));
- display_minibuffer_error(sp, msg);
- free(msg);
- progress_displayed = true;
- }
- }
- }
- }
- else
+ for (i = start, passes = 0; i >= 0; i--, passes++)
{
- for (i = start, passes = 0; i >= 0; i--, passes++)
+ res = Xen_call_with_1_arg(ss->search_proc,
+ C_double_to_Xen_real((double)(read_sample(sf))),
+ "search function");
+ if (!Xen_is_false(res))
+ break;
+ if (passes >= MANY_PASSES)
{
- /* sp search proc as ptree */
- res = XEN_CALL_1(sp->search_proc,
- C_TO_XEN_DOUBLE((double)(read_sample(sf))),
- "local search func");
- if (XEN_NOT_FALSE_P(res))
- {
- count--;
- if (count == 0) break;
- }
- if (passes >= MANY_PASSES)
+ passes = 0;
+ check_for_event();
+ if (!(ss->stopped_explicitly))
{
- check_for_event();
- /* if user types C-s during an active search, we risk stomping on our current pointers */
- tick++;
- if (tick > REPORT_TICKS)
- {
- char *msg;
- tick = 0;
- msg = mus_format("search at minute %d", (int)floor(i / (SND_SRATE(sp) * 60)));
- display_minibuffer_error(sp, msg);
- free(msg);
- progress_displayed = true;
- }
- if (!(sp->active)) break;
- passes = 0;
+ char *msg;
+ msg = mus_format("search at minute %d", (int)floor(i / (snd_srate(cp->sound) * 60)));
+ find_report(cp, msg);
+ free(msg);
+ reported = true;
}
- if (ss->stopped_explicitly) break;
+ /* if user types C-s during an active search, we risk stomping on our current pointers */
+ if (!(cp->sound->active)) break;
}
+ if (ss->stopped_explicitly) break;
}
+
ss->stopped_explicitly = false;
- if ((progress_displayed) &&
- (!find_eval_error_p))
- clear_minibuffer_error(sp);
+ if (reported) find_report(cp, NULL);
free_snd_fd(sf);
- search_in_progress = false;
- if (count != 0) return(-1); /* impossible sample number, so => failure */
- if (XEN_INTEGER_P(res))
- return(i - XEN_TO_C_INT(res));
- return(i);
+
+ if (i >= 0)
+ return(i);
+ return(-1);
}
-static void get_find_expression(snd_info *sp, int count)
+static char *channel_search(chan_info *cp, read_direction_t direction)
{
- set_minibuffer_string(sp, NULL, true);
- make_minibuffer_label(sp, "find:");
- sp->minibuffer_on = MINI_FIND;
- goto_minibuffer(sp);
- sp->search_count = count;
+ mus_long_t samp;
+ char *s1, *s2, *msg;
+
+ if (direction == READ_FORWARD)
+ samp = channel_find_forward(cp);
+ else samp = channel_find_backward(cp);
+
+ previous_channel = cp;
+
+ if (samp == -1)
+ return(NULL);
+
+ s1 = prettyf(chn_sample(samp, cp, cp->edit_ctr), 2);
+ s2 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(cp->sound));
+ msg = mus_format("%s at %s (%lld)", s1, s2, samp);
+ cursor_moveto_without_verbosity(cp, samp);
+ free(s1);
+ free(s2);
+
+ return(msg);
}
-void cursor_search(chan_info *cp, int count)
+static char *global_search(read_direction_t direction, bool repeating)
{
- /* called only in snd-kbd so all errors should go to minibuffer, and search should be stopped upon error */
- snd_info *sp;
- sp = cp->sound;
- if (search_in_progress)
- display_minibuffer_error(sp, "search already in progress");
- else
+ int i, j;
+
+ if ((repeating) &&
+ ((!previous_channel) ||
+ (!(previous_channel->sound)) ||
+ (!(previous_channel->sound->active))))
+ repeating = false;
+
+ for (i = 0; i < ss->max_sounds; i++)
{
- if (sp->search_count != 0)
- {
- mus_long_t samp;
- if ((!(XEN_PROCEDURE_P(sp->search_proc))) &&
- (sp->search_tree == NULL))
- {
- /* I decided not to check for a global search procedure; it's much harder
- * to implement than it looks, and I'm not sure it would "do the right thing"
- * anyway, if say the user types c-g to clear the current to ask for the next --
- * a fall-back then would be annoying. And then, in the global searcher (edit:find)
- * to be consistent wouldn't we need a check for a local searcher?
- *
- * perhaps the right thing is to remove these procedures altogether
- */
- sp->search_count = 0;
- clear_minibuffer_prompt(cp->sound);
- return; /* no search expr */
- }
- if (sp->search_expr)
- {
- /* see note above about closures */
- clear_sound_search_procedure(sp, false);
-#if HAVE_SCHEME
- if (optimization(ss) > 0)
- sp->search_tree = mus_run_form_to_ptree_1_b_without_env(C_STRING_TO_XEN_FORM(sp->search_expr));
-#endif
- if (sp->search_tree == NULL)
- {
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- sp->search_proc = snd_catch_any(eval_str_wrapper, sp->search_expr, sp->search_expr);
- redirect_errors_to(NULL, NULL);
- if (XEN_PROCEDURE_P(sp->search_proc))
- sp->search_proc_loc = snd_protect(sp->search_proc);
- else return;
- }
- }
- redirect_errors_to(send_find_errors_to_minibuffer, (void *)sp);
- if (count > 0)
- samp = cursor_find_forward(sp, cp, count);
- else samp = cursor_find_backward(sp, cp, -count);
- redirect_errors_to(NULL, NULL);
- if (find_eval_error_p)
- {
- find_eval_error_p = false;
- sp->search_count = 0;
- }
- else
- {
- if (samp == -1)
- {
- char *msg;
- msg = mus_format("not found%s",
- (cp->last_search_result == SEARCH_FAILED) ? " (wrapped)" : "");
- display_minibuffer_error(sp, msg);
- free(msg);
- cp->last_search_result = SEARCH_FAILED;
- }
- else
- {
- char *s1, *s2, *msg;
- s1 = prettyf(chn_sample(samp, cp, cp->edit_ctr), 2);
- s2 = x_axis_location_to_string(cp, (double)samp / (double)SND_SRATE(sp));
- msg = mus_format("%s at %s (" MUS_LD ")", s1, s2, samp);
- display_minibuffer_error(sp, msg);
- free(s1);
- free(s2);
- free(msg);
- cp->last_search_result = SEARCH_OK;
- cursor_moveto_without_verbosity(cp, samp);
- }
- }
- }
- else get_find_expression(sp, count);
+ snd_info *sp;
+
+ sp = ss->sounds[i];
+ if ((sp) &&
+ (sp->inuse == SOUND_NORMAL))
+ for (j = 0; j < sp->nchans; j++)
+ {
+ chan_info *cp;
+ cp = (chan_info *)(sp->chans[j]);
+ if ((!repeating) ||
+ (cp == previous_channel))
+ {
+ char *msg;
+ repeating = false; /* after we find the channel, look at everything */
+ msg = channel_search(cp, direction);
+ if (msg)
+ return(msg);
+ }
+ }
}
+ return(NULL);
}
-void clear_sound_search_procedure(snd_info *sp, bool clear_expr_too)
+#if HAVE_EXTENSION_LANGUAGE
+void find_dialog_find(char *str, read_direction_t direction, chan_info *cp)
{
- if (XEN_PROCEDURE_P(sp->search_proc))
- {
- snd_unprotect_at(sp->search_proc_loc);
- sp->search_proc_loc = NOT_A_GC_LOC;
- }
- sp->search_proc = XEN_UNDEFINED;
- if (clear_expr_too)
- {
- if (sp->search_expr) free(sp->search_expr);
- sp->search_expr = NULL;
- }
- if (sp->search_tree)
+ Xen proc;
+ bool repeating_search = false;
+
+ if (search_in_progress)
{
- mus_run_free_ptree(sp->search_tree);
- sp->search_tree = NULL;
+ find_report(cp, "search already in progress");
+ return;
}
-}
+ proc = Xen_false;
-void clear_global_search_procedure(bool clear_expr_too)
-{
- if (XEN_PROCEDURE_P(ss->search_proc))
+ /* str can be null, or equal to the previous call's str -- in this case use
+ * the current search procedure if possible, else complain.
+ * if str not null, make a new (local?) search-procedure
+ */
+
+ if ((!str) ||
+ (!(*str)) ||
+ (mus_strcmp(str, ss->search_expr)))
{
- snd_unprotect_at(ss->search_proc_loc);
- ss->search_proc_loc = NOT_A_GC_LOC;
+ proc = ss->search_proc;
+ if (!(Xen_is_procedure(proc)))
+ return;
+ repeating_search = true;
}
- ss->search_proc = XEN_UNDEFINED;
- if (clear_expr_too)
+ else
{
- if (ss->search_expr) free(ss->search_expr);
- ss->search_expr = NULL;
+ char *buf = NULL;
+
+ redirect_errors_to(errors_to_find_text, NULL);
+ proc = snd_catch_any(eval_str_wrapper, str, str);
+ redirect_errors_to(NULL, NULL);
+
+ if ((!(Xen_is_procedure(proc))) ||
+ (!(procedure_arity_ok(proc, 1))))
+ return;
+
+ clear_search_state(); /* free previous, if any */
+ repeating_search = false;
+
+ ss->search_proc = proc;
+ ss->search_expr = mus_strdup(str);
+ ss->search_proc_loc = snd_protect(proc);
+
+ buf = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, PRINT_BUFFER_SIZE, "%s %s", I_find, str);
+ find_dialog_set_label(buf);
+ free(buf);
}
- if (ss->search_tree)
+
+ /* now we have a search procedure, possibly optimized */
+
+ search_in_progress = true;
+ find_dialog_stop_label(true);
+ redirect_xen_error_to(stop_search_if_error, NULL);
+ if (cp)
+ str = channel_search(cp, direction);
+ else str = global_search(direction, repeating_search);
+ redirect_xen_error_to(NULL, NULL);
+ find_dialog_stop_label(false);
+ search_in_progress = false;
+
+ if ((str) && (*str))
{
- mus_run_free_ptree(ss->search_tree);
- ss->search_tree = NULL;
+ find_report(cp, str);
+ free(str);
}
+ else find_report(cp, "not found");
}
+#endif
+#endif
+/* end no gui */
-static XEN g_search_procedure(XEN snd)
-{
- #define H_search_procedure "(" S_search_procedure " :optional snd): global (if no 'snd' specified) or sound-local search function"
- if (XEN_BOUND_P(snd))
- {
- snd_info *sp;
-
- ASSERT_SOUND(S_search_procedure, snd, 1);
- sp = get_sp(snd);
- if (sp)
- return(sp->search_proc);
- else return(XEN_FALSE);
- }
+/* -------------------------------------------------------------------------------- */
+static Xen g_search_procedure(void)
+{
+ #define H_search_procedure "(" S_search_procedure "): the function used by the find dialog or C-s if none is otherwise specified."
return(ss->search_proc);
}
-static XEN g_set_search_procedure(XEN snd, XEN proc)
+static Xen g_set_search_procedure(Xen proc)
{
- snd_info *sp;
char *error = NULL;
- XEN errstr;
- /* (set! (search-procedure) (lambda (y) #t)) -> #<procedure #f ((n) #t)> as "proc" */
- /* why is this different from ptree-channel's proc arg? */
+ /* (set! (search-procedure) (lambda (y) #t)) -> #<procedure #f ((n) #t)> */
+
+ Xen_check_type(Xen_is_procedure(proc) || Xen_is_false(proc), proc, 1, S_set S_search_procedure, "a procedure or " PROC_FALSE);
- if (XEN_INTEGER_P(snd) || XEN_SOUND_P(snd)) /* could be the proc arg if no snd */
+ error = procedure_ok(proc, 1, S_search_procedure, "search", 1);
+ if (!error)
{
- ASSERT_SOUND(S_setB S_search_procedure, snd, 1);
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(proc) || XEN_FALSE_P(proc), proc, XEN_ARG_1, S_setB S_search_procedure, "a procedure or " PROC_FALSE);
-
- sp = get_sp(snd);
- if (sp)
+ clear_search_state();
+ if (Xen_is_procedure(proc))
{
- error = procedure_ok(proc, 1, S_setB S_search_procedure, "proc", 1);
- if (error == NULL)
- {
- clear_sound_search_procedure(sp, true);
- if (XEN_PROCEDURE_P(proc))
- {
- sp->search_proc = proc;
- sp->search_proc_loc = snd_protect(proc);
-#if HAVE_SCHEME
- if (optimization(ss) > 0)
- sp->search_tree = mus_run_form_to_ptree_1_b(XEN_PROCEDURE_SOURCE(proc));
-#endif
- }
- return(proc);
- }
- else
- {
- errstr = C_TO_XEN_STRING(error);
- free(error);
- return(snd_bad_arity_error(S_setB S_search_procedure, errstr, proc));
- }
+ ss->search_proc = proc;
+ ss->search_proc_loc = snd_protect(proc);
}
- else
- return(snd_no_such_sound_error(S_setB S_search_procedure, snd));
}
else
{
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(snd) || XEN_FALSE_P(snd), snd, XEN_ARG_1, S_setB S_search_procedure, "a procedure or " PROC_FALSE);
- error = procedure_ok(snd, 1, S_setB S_search_procedure, "proc", 1);
- if (error == NULL)
- {
- clear_global_search_procedure(true);
- if (XEN_PROCEDURE_P(snd))
- {
- ss->search_proc = snd;
- ss->search_proc_loc = snd_protect(snd);
-#if HAVE_SCHEME
- if (optimization(ss) > 0)
- ss->search_tree = mus_run_form_to_ptree_1_b(XEN_PROCEDURE_SOURCE(snd));
-#endif
- }
- }
- else
- {
- errstr = C_TO_XEN_STRING(error);
- free(error);
- return(snd_bad_arity_error(S_setB S_search_procedure, errstr, snd));
- }
+ Xen errstr;
+ errstr = C_string_to_Xen_string(error);
+ free(error);
+ return(snd_bad_arity_error(S_set S_search_procedure, errstr, proc));
}
- return(snd);
+ return(proc);
}
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_1(g_search_procedure_w, g_search_procedure)
-XEN_ARGIFY_2(g_set_search_procedure_w, g_set_search_procedure)
-#else
-#define g_search_procedure_w g_search_procedure
-#define g_set_search_procedure_w g_set_search_procedure
-#endif
+Xen_wrap_no_args(g_search_procedure_w, g_search_procedure)
+Xen_wrap_1_arg(g_set_search_procedure_w, g_set_search_procedure)
void g_init_find(void)
{
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_search_procedure, g_search_procedure_w, H_search_procedure,
- S_setB S_search_procedure, g_set_search_procedure_w, 0, 1, 1, 1);
+ Xen_define_dilambda(S_search_procedure, g_search_procedure_w, H_search_procedure,
+ S_set S_search_procedure, g_set_search_procedure_w, 0, 0, 1, 0);
}
diff --git a/snd-forth-docs.fs b/snd-forth-docs.fs
index ccfce9f..431091d 100644
--- a/snd-forth-docs.fs
+++ b/snd-forth-docs.fs
@@ -182,7 +182,7 @@ lambda: ( -- )
lambda: ( -- )
"oboe.snd" make-readin { rd }
rd 0.5 make-src { sr }
- "oboe.snd" mus-sound-frames 2* ( len ) 0 do
+ "oboe.snd" mus-sound-framples 2* ( len ) 0 do
i sr 0 #f src *output* outa drop
loop
; :play #t :srate 22050 with-sound drop
@@ -216,7 +216,7 @@ lambda: ( -- )
lambda: ( -- )
"oboe.snd" "pistol.snd" 0.5 "convolved.snd" convolve-files { tempfile }
tempfile make-readin { reader }
- tempfile mus-sound-frames ( len ) 0 do
+ tempfile mus-sound-framples ( len ) 0 do
i reader readin *output* outa drop
loop
tempfile file-delete
@@ -257,7 +257,7 @@ lambda: ( -- )
\ PHASE-VOCODER2
lambda: ( -- )
"oboe.snd" make-readin :interp 256 make-phase-vocoder { pv }
- "oboe.snd" mus-sound-frames 2* ( samps ) 0 do
+ "oboe.snd" mus-sound-framples 2* ( samps ) 0 do
i pv #f #f #f #f phase-vocoder *output* outa drop
loop
; :play #t :srate 22050 with-sound drop
@@ -274,7 +274,7 @@ lambda: ( -- )
lambda: ( -- )
"stereo.snd" make-file->frame { input }
2 make-frame { frm }
- "stereo.snd" mus-sound-frames ( len ) 0 do
+ "stereo.snd" mus-sound-framples ( len ) 0 do
input i frm file->frame ( frm ) 1 frame-ref ( val1 )
frm 0 frame-ref ( val0 ) frm 1 rot frame-set! drop
( val1 ) frm 0 rot frame-set! drop
diff --git a/snd-forth-init.fs b/snd-forth-init.fs
index 9926f31..2d957dc 100644
--- a/snd-forth-init.fs
+++ b/snd-forth-init.fs
@@ -1,4 +1,7 @@
\ .snd_forth -- start up file for Snd/Forth
+\
+\ @(#)snd-forth-init.fs 1.43 11/11/14
+\
\ You can install the *.fs scripts with:
\
@@ -17,58 +20,59 @@
\
\ "/home/mike/snd" add-load-path
-\ A special *SND-HOME* path points here to ~/.snd.d (similar to ~/.emacs.d):
+\ A special *SND-HOME* path points to ~/.snd.d:
\
-\ ~/.snd.d directory for save-state-file
\ ~/.snd.d/sound directory for *clm-file-name*
-\ add-directory-to-view-files-list
-\ set-open-file-dialog-director
\ ~/.snd.d/zap directory for set-temp-dir
\ set-save-dir
\ ~/.snd.d/peaks directory for set-peak-env-dir
\
-\ "HOME" getenv value *home*
-\ *home* "/.snd.d" $+ value *snd-home*
+\ "HOME" getenv constant *home*
+\ *home* "/.snd.d" $+ constant *snd-home*
\
-\ Change these paths to fit your needs!
+\ Change these paths!
\
#t to *fth-verbose*
#f to *fth-debug*
-#f value *init-with-peaks* \ with peak-env support
-#f value *init-graph-extra-hooks* \ with display-correlate, zoom-spectrum, superimpose-ffts
-#f value *init-lisp-graph-extra-hooks* \ with display-energy, display-db
-
-: print-loading-file { fname -- }
- *fth-verbose* if $" \\ loading %s\n" '( fname ) clm-print then
-;
-
-*filename* print-loading-file
-
-"HOME" getenv value *home*
-*home* "/.snd.d" $+ value *snd-home*
-hostname value *hostname*
-*hostname* /\\./ string-split car value *short-hostname*
-*argv* length 0> [if] *argv* car undef file-basename [else] "snd" [then] value *program-name*
+\ Redirect Fth output (stdout) to the Snd listener (with snd-print).
+:port-name "sndout" :write-line <'> snd-print make-soft-port set-*stdout* drop
+\ Now force output to listener:
+#t set-show-listener drop
before-load-hook lambda: <{ fname -- f }>
- fname print-loading-file
- #t
+ *fth-verbose* if
+ "\\ loading %s\n" #( fname ) fth-print
+ then
+ #t
; add-hook!
+before-load-hook '( *filename* ) run-hook drop
+
+"HOME" getenv constant *home*
+*home* "/.snd.d" $+ constant *snd-home*
+hostname constant *hostname*
+*hostname* "." string-split car constant *short-hostname*
+*argv* length 0> [if]
+ *argv* car undef file-basename
+[else]
+ "snd"
+[then] constant *program-name*
+
\ if configured --with-shared-sndlib
-dl-load sndlib Init_sndlib
+'sndlib provided? [unless] dl-load sndlib Init_sndlib [then]
\ Set them before loading clm.fs.
-2 set-default-output-chans drop
-48000 set-default-output-srate drop
-512 set-dac-size drop
-mus-clipping set-clipping drop
-1024 1024 * set-mus-file-buffer-size drop
-24 set-mus-array-print-length drop
-mus-array-print-length set-print-length drop
-128 set-object-print-length
+2 set-default-output-chans drop
+48000 set-default-output-srate drop
+mus-bdouble set-default-output-sample-type drop
+512 set-dac-size drop
+mus-clipping set-clipping drop
+1024 1024 * set-mus-file-buffer-size drop
+48 set-mus-array-print-length drop
+mus-array-print-length set-print-length drop
+128 set-object-print-length
require clm
require clm-ins
@@ -76,259 +80,310 @@ require clm-ins
\ Environment variable CLM_SEARCH_PATH
\ Path variable where sound files reside.
\ csh: setenv CLM_SEARCH_PATH /usr/gnu/sound/SFiles:${HOME}/.snd.d/sound
-\ sh: CLM_SEARCH_PATH=/usr/gnu/sound/SFiles:${HOME}/.snd.d/sound; export CLM_SEARCH_PATH
+\ sh: export CLM_SEARCH_PATH=/usr/gnu/sound/SFiles:${HOME}/.snd.d/sound
"CLM_SEARCH_PATH" getenv dup [if]
- ":" string-split [each] *clm-search-list* swap array-push to *clm-search-list* [end-each]
+ ":" string-split [each]
+ *clm-search-list* swap array-push to *clm-search-list*
+ [end-each]
[else]
- drop
- *clm-search-list* *snd-home* "/sound" $+ array-push to *clm-search-list*
+ drop
+ *clm-search-list* *snd-home* "/sound" $+ array-push to *clm-search-list*
[then]
-#t to *clm-play*
-#t to *clm-statistics*
-#t to *clm-verbose*
-#f to *clm-debug*
-*snd-home* "/sound/fth-test.snd" $+ to *clm-file-name*
-*snd-home* "/sound/fth-test.reverb" $+ to *clm-reverb-file-name*
-#t to *clm-delete-reverb*
-lambda: <{ ins beg dur -- }> $" %14s: %5.2f %5.2f" '( ins beg dur ) clm-message ; to *clm-notehook*
-'snd-nogui provided? [if]
- \ snd-nogui repl and prompt hooks
- before-repl-hook reset-hook! \ remove default hook
- before-repl-hook lambda: <{ -- }>
- "" #f clm-message
- $" Starting session on %s." '( $" %Ev %Er" current-time strftime ) clm-message
- "" #f clm-message
- ; add-hook!
- after-repl-hook lambda: <{ history -- }>
- "" #f clm-message
- $" Thank you for using %s!" #( *program-name* string-upcase ) clm-message
- "" #f clm-message
- 1 sleep
- ; add-hook!
-
- \ A more elaborated prompt for fth and snd-forth-nogui.
- before-prompt-hook lambda: <{ prompt pos -- new-prompt }>
- "%EI:%EM%p" current-time strftime string-downcase! { tm }
- "(/usr)?" *home* $+ make-regexp file-pwd "~" regexp-replace { path }
- $" (%s:%s)\n[%s %s] (%d)> " #( *short-hostname* path *program-name* tm pos ) string-format
- ; add-hook!
-[then]
+: clm-print-instrument <{ ins beg dur -- }>
+ "%14s: %5.2f %5.2f" '( ins beg dur ) clm-message
+;
+
+: clm-sox-player <{ output -- }>
+ "sox -qV1 %s -d" #( output ) string-format file-system unless
+ "exit %d\n" #( exit-status ) fth-print
+ then
+;
+
+440.0 to *clm-default-frequency*
+#t to *clm-play*
+#t to *clm-statistics*
+#t to *clm-verbose*
+#f to *clm-debug*
+*snd-home* "/sound/fth-test.snd" $+ to *clm-file-name*
+*snd-home* "/sound/fth-test.reverb" $+ to *clm-reverb-file-name*
+#t to *clm-delete-reverb*
+<'> clm-print-instrument to *clm-notehook*
+<'> clm-sox-player to *clm-player*
*snd-home* add-load-path
-*init-with-peaks* [if]
- *snd-home* "/peaks" $+ set-peak-env-dir drop
-[then]
-*snd-home* "/snd-saved.fs" $+ set-save-state-file drop
-*snd-home* "/zap" $+ set-temp-dir drop
-*snd-home* "/zap" $+ set-save-dir drop
-*snd-home* "/sound" $+ set-open-file-dialog-directory drop
-"/usr/gnu/cvs/snd" set-html-dir drop
-"BROWSER" getenv "firefox" || set-html-program drop
-#t set-trap-segfault drop
-#t set-show-listener drop
-0.0 set-auto-update-interval drop
-"rev" add-sound-file-extension drop
-"reverb" add-sound-file-extension drop
-"wave" add-sound-file-extension drop
-*clm-search-list* [each] ( dir ) undef add-directory-to-view-files-list drop [end-each]
-
-before-save-state-hook lambda: <{ fname -- f }>
- $" \\ -*- snd-forth -*-\n" :filename fname with-output-port
- #t \ #t --> append mode
-; add-hook!
+"BROWSER" getenv "firefox" || set-html-program drop
+*snd-home* "/sound" $+ set-open-file-dialog-directory ( dir )
+"/saved-snd.fs" $+ set-save-state-file drop
+*snd-home* "/zap" $+ set-save-dir ( dir )
+ set-temp-dir drop
+0.0 set-auto-update-interval drop
+#t set-trap-segfault drop
+
+#( "rev" "reverb" "wave" ) [each] ( ext )
+ add-sound-file-extension drop
+[end-each]
\ make-default-comment from clm.fs
output-comment-hook lambda: <{ str -- s }>
- str empty? if make-default-comment else str then
+ str empty? if
+ make-default-comment
+ else
+ str
+ then
; add-hook!
-'snd-nogui provided? [unless]
- require snd-xm
- after-open-hook <'> show-disk-space add-hook!
-
- require effects
- #f to use-combo-box-for-fft-size \ boolean (default #f)
-
- 'snd-motif provided? [if]
- \ snd-xm.fs
- add-mark-pane
- [then]
-
- 'snd-gtk provided? [if]
- $" Serif 10" set-axis-label-font drop
- [then]
-
- require extensions
- #t set-emacs-style-save-as
- with-reopen-menu
- with-buffers-menu
-
- require examp
- *init-graph-extra-hooks* [if]
- graph-hook <'> display-correlate add-hook!
- graph-hook <'> zoom-spectrum add-hook!
- graph-hook <'> superimpose-ffts add-hook!
- [then]
- *init-lisp-graph-extra-hooks* [if]
- lisp-graph-hook <'> display-energy add-hook!
- lisp-graph-hook <'> display-db add-hook!
- [then]
- after-transform-hook <'> fft-peak add-hook!
-
- require mix
- mix-click-hook <'> mix-click-sets-amp add-hook!
- mix-click-hook <'> mix-click-info add-hook!
-
- require marks
- save-mark-properties
- mark-click-hook <'> mark-click-info add-hook!
-
- require dsp
- graph-hook lambda: <{ snd chn y0 y1 -- #f }>
- $" freq: %.3f" #( snd chn left-sample snd chn spot-freq ) string-format
- snd #f report-in-minibuffer drop
- #f
- ; add-hook!
-
- mouse-click-hook lambda: <{ snd chn button state x y axis -- a }>
- axis time-graph = if
- $" freq: %.3f" #( snd chn #f cursor snd chn spot-freq ) string-format
- snd #f report-in-minibuffer
- else
- #f
- then
- ; add-hook!
-
- require env
- enved-hook lambda: <{ en pt x y reason -- en'|#f }>
- reason enved-move-point = if
- x en 0 array-ref f> x en -2 array-ref f< && if
- en en pt 2* array-ref x #f #f stretch-envelope ( new-en ) dup pt 2* 1+ y array-set!
- else
- #f
- then
- else
- #f
- then
- ; add-hook!
-
- require rgb
- beige set-selected-graph-color drop
- blue set-selected-data-color drop
-
- #t set-show-indices drop
- #t set-with-inset-graph drop
- #t set-with-pointer-focus drop
- #t set-ask-about-unsaved-edits drop
- #f set-remember-sound-state drop
- #t set-with-smpte-label drop
- #t set-with-toolbar drop
- #t set-show-full-duration drop
- #t set-just-sounds drop
- #t set-enved-wave? drop
- #t set-show-y-zero drop
- #t set-show-transform-peaks drop
- speed-control-as-ratio set-speed-control-style drop
- graph-as-spectrogram set-transform-graph-type drop \ graph-once graph-as-sonogram
- rainbow-colormap set-colormap drop
- $" snd> " set-listener-prompt drop
- 160 set-window-x drop
- 0 set-window-y drop
- 800 set-window-width drop
- 600 set-window-height drop
-
- exit-hook lambda: <{ -- f }>
- save-state-file save-state drop
- sounds each close-sound drop end-each
- #t
- ; add-hook!
-
- after-open-hook lambda: <{ snd -- }>
- snd channels 0 ?do snd short-file-name snd i time-graph set-x-axis-label drop loop
- #t snd set-with-tracking-cursor drop
- channels-combined snd set-channel-style
- ; add-hook!
-
- : snd-set-cursor-style { snd kind -- #f }
- snd sound? if kind snd #t set-cursor-style drop then
- #f
- ;
- start-playing-hook lambda: <{ snd -- f }> snd cursor-line snd-set-cursor-style ; add-hook!
- stop-playing-hook lambda: <{ snd -- f }> snd cursor-cross snd-set-cursor-style ; add-hook!
-
- \ bind-key ( key modifiers func :optional extended=#f origin="" prefs-info="" -- val )
- \
- \ modifiers:
- \ 0 normal
- \ 1 shift
- \ 4 control
- \ 8 meta
- \
- \ extended (prefix key):
- \ #t C-x
- \ #f none
- \
- \ func ( -- val )
- \
- \ val should be:
- \ cursor-in-view
- \ cursor-on-left
- \ cursor-on-right
- \ cursor-in-middle
- \ keyboard-no-action
- \
- \ C-x C-c terminate Snd
- <char> c 4 lambda: <{ -- val }>
- 0 snd-exit drop
- cursor-in-view
- ; #t $" terminate Snd" "terminate-snd" bind-key drop
- \ C-x k close selected sound
- <char> k 0 lambda: <{ -- val }>
- selected-sound close-sound-extend
- cursor-in-view
- ; #t $" close sound and jump to next open" "close-current-sound" bind-key drop
- \ C-x C-k show listener
- <char> k 4 lambda: <{ -- val }>
- #t set-show-listener drop
- cursor-in-view
- ; #t $" show listener" "show-listener" bind-key drop
- \ C-x C-n hide listener
- <char> n 4 lambda: <{ -- val }>
- #f set-show-listener drop
- cursor-in-view
- ; #t $" hide listener" "hide-listener" bind-key drop
- \ C-x C-x play
- <char> x 4 lambda: <{ -- val }>
- #t play drop
- cursor-in-view
- ; #t $" play current sound" "play-current-sound" bind-key drop
- \ C-x C-t play from cursor
- <char> t 4 lambda: <{ -- val }>
- selected-sound :start undef undef undef cursor play drop
- cursor-in-view
- ; #t $" play from cursor" "play-from-cursor" bind-key drop
- \ C-x x eval over selection
- <char> x 0 lambda: <{ -- val }>
- undef selection? if
- $" selection-eval:" <'> eval-over-selection #f #f prompt-in-minibuffer
- else
- $" no selection" #f #f report-in-minibuffer
- then drop
- cursor-in-view
- ; #t $" eval over selection" "eval-over-selection" bind-key drop
-[then] \ not snd-nogui
-
-'snd-nogui provided? [unless]
- save-state-file file-exists? [if] require snd-saved [then]
+require examp
+[ifundef] read-eval-loop-prompt
+ "ok " value read-eval-loop-prompt
[then]
-\ find-file searchs in *clm-search-list*
-sounds empty? [if]
- *clm-file-name* find-file dup [if] open-sound [then] drop cr
-[then]
+'snd-nogui provided? [if]
+ \ snd-nogui repl and prompt hooks
+ before-repl-hook reset-hook! \ remove default hook
+ before-repl-hook lambda: <{ -- }>
+ "" #f clm-message
+ "Starting session on %s."
+ #( "%a %b %d %r %Z %Y" current-time strftime ) clm-message
+ "" #f clm-message
+ ; add-hook!
+
+ \
+ \ Remove duplicates from history file.
+ \
+ after-repl-hook lambda: <{ history -- }>
+ history readlines array-reverse! { hary }
+ #() "" "" { nhary hline tline }
+ hary array-length 0 ?do
+ hary i array-ref to hline
+ hary i 1+ array-ref to tline
+ nhary hline array-member? unless
+ nhary hline array-unshift
+ ( nhary ) tline array-unshift drop
+ then
+ 2 +loop
+ history nhary writelines
+ \ Be polite.
+ "" #f clm-message
+ "Thank you for using %s!"
+ #( *program-name* string-upcase ) clm-message
+ "" #f clm-message
+ 1 sleep
+ ; add-hook!
+
+ \
+ \ A more elaborated prompt for fth and snd-forth-nogui.
+ \
+ before-prompt-hook lambda: <{ prompt pos -- new-prompt }>
+ "%I:%M%p" current-time strftime string-downcase! { tm }
+ "%%S[%s %s] (%d)%%s %%Bok%%b "
+ #( *short-hostname* tm pos ) string-format
+ ; add-hook!
+[else] \ snd-motif|gtk
+ read-hook lambda: <{ text -- flag }>
+ \ Prints "\n" to put output at next line.
+ \ This separates better input from output.
+ cr
+ #f
+ ; add-hook!
+
+ require snd-xm
+ after-open-hook <'> show-disk-space add-hook!
+
+ require effects
+ #f to use-combo-box-for-fft-size \ boolean (default #f)
+
+ 'snd-motif provided? [if]
+ *clm-search-list* [each] ( dir )
+ undef add-directory-to-view-files-list drop
+ [end-each]
+ \ snd-xm.fs
+ add-mark-pane
+ require popup
+ edhist-save-hook lambda: <{ prc -- }>
+ "%S" #( prc ) clm-message
+ ; add-hook!
+ [then]
+
+ require extensions
+ with-reopen-menu
+ with-buffers-menu
+
+ \ examp.fs
+ graph-hook <'> auto-dot add-hook!
+ graph-hook <'> zoom-spectrum add-hook!
+ lisp-graph-hook <'> display-energy add-hook!
+ after-transform-hook <'> fft-peak add-hook!
+ \ graph-hook <'> display-correlate add-hook!
+ \ graph-hook <'> superimpose-ffts add-hook!
+ \ lisp-graph-hook <'> display-db add-hook!
+
+ require mix
+ mix-click-hook <'> mix-click-sets-amp add-hook!
+ mix-click-hook <'> mix-click-info add-hook!
+
+ require marks
+ save-mark-properties
+ mark-click-hook <'> mark-click-info add-hook!
+
+ require dsp
+ require env
+ enved-hook lambda: <{ en pt x y reason -- en'|#f }>
+ reason enved-move-point = if
+ x en 0 array-ref f>
+ x en -2 array-ref f< && if
+ en en pt 2* array-ref
+ x #f #f stretch-envelope ( new-en )
+ dup pt 2* 1+ y array-set!
+ ( new-en )
+ else
+ #f
+ then
+ else
+ #f
+ then
+ ; add-hook!
+
+ \ xm-enved.fs (already loaded by effects.fs)
+ before-enved-hook lambda: <{ gen pos x y reason -- f }>
+ enved-hook hook-empty? if
+ #f
+ else
+ gen xenved-envelope@ { res }
+ enved-hook each { prc }
+ prc #( res pos x y reason ) run-proc to res
+ res false? ?leave
+ end-each
+ res array? if
+ gen res xenved-envelope!
+ then
+ res
+ then
+ ; add-hook!
+
+ after-open-hook lambda: <{ snd -- }>
+ snd channels 0 ?do
+ snd short-file-name
+ snd i ( chn ) time-graph set-x-axis-label drop
+ \ to force a verbose cursor
+ 0 snd i ( chn ) #f set-cursor drop
+ loop
+ cursor-line snd #t set-cursor-style drop
+ channels-combined snd set-channel-style
+ ; add-hook!
+
+ require rgb
+ blue set-selected-data-color drop
+ beige set-selected-graph-color drop
+
+ rainbow-colormap set-colormap drop
+ #t set-enved-wave? drop
+ #t set-just-sounds drop
+ \ defined in examp.fs
+ read-eval-loop-prompt set-listener-prompt drop
+ #t set-show-full-duration drop
+ #t set-show-indices drop
+ #t set-show-transform-peaks drop
+ #t set-show-y-zero drop
+ speed-control-as-ratio set-speed-control-style drop
+ \ graph-once
+ \ graph-as-sonogram
+ \ graph-as-spectrogram
+ graph-once set-transform-graph-type drop
+ #t set-with-inset-graph drop
+ #t set-with-pointer-focus drop
+ #t set-with-smpte-label drop
+ #t set-with-toolbar drop
+ #t set-with-tracking-cursor drop
+ #t set-with-verbose-cursor drop
+ 1200 set-window-width drop
+ 150 set-window-x drop
+ 0 set-window-y drop
+ \ The listener appears in a more convenient size with this trick:
+ 800 set-window-height drop
+ 1000 set-window-height drop
+
+ \ bind-key ( key modifiers func
+ \ :optional extended=#f origin="" prefs-info="" -- val )
+ \
+ \ modifiers:
+ \ 0 normal
+ \ 1 shift
+ \ 4 control
+ \ 8 meta
+ \
+ \ extended (prefix key):
+ \ #t C-x
+ \ #f none
+ \
+ \ func ( -- val )
+ \
+ \ val should be:
+ \ cursor-in-view
+ \ cursor-on-left
+ \ cursor-on-right
+ \ cursor-in-middle
+ \ keyboard-no-action
+ \
+ \ C-x C-c terminate Snd
+ <char> c 4 lambda: <{ -- val }>
+ 0 snd-exit drop
+ cursor-in-view
+ ; #t "terminate Snd" "terminate-snd" bind-key drop
+
+ \ C-x k close selected sound
+ <char> k 0 lambda: <{ -- val }>
+ selected-sound close-sound-extend
+ cursor-in-view
+ ; #t "close sound and jump to next open"
+ "close-current-sound" bind-key drop
+
+ \ C-x C-k toggle listener
+ <char> k 4 lambda: <{ -- val }>
+ show-listener not set-show-listener drop
+ cursor-in-view
+ ; #t "show listener" "show-listener" bind-key drop
+
+ \ C-x C-x play
+ <char> x 4 lambda: <{ -- val }>
+ #t play drop
+ cursor-in-view
+ ; #t "play current sound" "play-current-sound" bind-key drop
+
+ \ C-x C-t play from cursor
+ <char> t 4 lambda: <{ -- val }>
+ selected-sound :start undef undef undef cursor play drop
+ cursor-in-view
+ ; #t "play from cursor" "play-from-cursor" bind-key drop
+
+ "End" 0 lambda: <{ -- val }>
+ selected-sound { snd }
+ snd #f #f framples { frms }
+ snd srate { sr }
+ '( 0.0 frms sr f/ ) snd #f undef set-x-bounds ( val )
+ ; #f "view full sound" undef bind-key drop
+
+ <char> m 0 <'> first-mark-in-window-at-left #f
+ "align window left edge with mark"
+ "first-mark-in-window-at-left" bind-key drop
+[then] \ snd-nogui
-$" Snd of %s (Fth %s)" #( snd-version fth-version ) clm-message
+\ find-file searchs in *clm-search-list*
+let:
+ sounds empty? if
+ *clm-file-name* find-file { fname }
+ fname if
+ fname open-sound drop
+ then
+ cr
+ then
+;let
+
+"%s (Fth %s)" #( snd-version fth-version ) clm-message
+
+\ Finally, after loading files with possible error messages, redirect
+\ Fth error output (stderr) to the Snd listener too.
+*stdout* set-*stderr* drop
\ .snd_forth ends here
diff --git a/snd-g0.h b/snd-g0.h
index 1e9e429..57aec42 100644
--- a/snd-g0.h
+++ b/snd-g0.h
@@ -3,12 +3,29 @@
#include <gtk/gtk.h>
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
#include <gdk/gdk.h>
#else
#include <gdk/gdkkeysyms.h>
#endif
+#if HAVE_GL
+#if GTK_CHECK_VERSION(3, 16, 0)
+ #include <GL/gl.h>
+#else
+#undef HAVE_GL
+#define HAVE_GL 0
+#endif
+#endif
+
+#include "glistener.h"
+
+#define HAVE_GTK_ADJUSTMENT_GET_UPPER GTK_CHECK_VERSION(2, 14, 0)
+#define HAVE_GTK_WIDGET_GET_VISIBLE GTK_CHECK_VERSION(2, 18, 0)
+#define HAVE_GTK_WIDGET_GET_MAPPED GTK_CHECK_VERSION(2, 19, 0)
+#define HAVE_GTK_GRID_NEW GTK_CHECK_VERSION(3, 0, 0)
+#define HAVE_GTK_HEADER_BAR_NEW GTK_CHECK_VERSION(3, 8, 0)
+
#include <cairo/cairo.h>
#define LOTSA_PIXELS 10000
@@ -28,6 +45,7 @@
typedef enum {WITH_DEFAULT_BACKGROUND, WITH_WHITE_BACKGROUND} snd_entry_bg_t;
#define widget_t GtkWidget*
+
#if (!HAVE_GTK_WIDGET_GET_VISIBLE)
/* 2.17 -- actually 2.14 also complains but it doesn't provide gtk_widget_get_visible! */
#define widget_is_active(Wid) GTK_WIDGET_VISIBLE(Wid)
@@ -37,12 +55,110 @@ typedef enum {WITH_DEFAULT_BACKGROUND, WITH_WHITE_BACKGROUND} snd_entry_bg_t;
#define activate_widget(Wid) gtk_widget_show(Wid)
#define deactivate_widget(Wid) gtk_widget_hide(Wid)
-#define XEN_WRAP_WIDGET(Value) ((Value) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkWidget_"), XEN_WRAP_C_POINTER(Value)) : XEN_FALSE)
-#define XEN_WRAP_WINDOW(Value) ((Value) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkWindow_"), XEN_WRAP_C_POINTER(Value)) : XEN_FALSE)
-#define XEN_UNWRAP_WIDGET(Value) (XEN_LIST_P(Value) ? (GtkWidget *)(XEN_UNWRAP_C_POINTER(XEN_CADR(Value))) : NULL)
-#define XEN_WIDGET_P(Value) (XEN_LIST_P(Value) && (XEN_LIST_LENGTH(Value) >= 2) && (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp("GtkWidget_", XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
-#define XEN_WRAP_EVENT(Value) ((Value) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEvent_"), XEN_WRAP_C_POINTER(Value)) : XEN_FALSE)
+
+/* no accessors: */
+#define EVENT_WINDOW(Ev) (Ev)->window
+#define EVENT_BUTTON(Ev) (Ev)->button
+/* #define EVENT_TYPE(Ev) (Ev)->type */
+#define EVENT_KEYVAL(Ev) (Ev)->keyval
+#define EVENT_IS_HINT(Ev) (Ev)->is_hint
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+#define EVENT_AREA_WIDTH(Ev) (Ev)->area.width
+#define EVENT_AREA_HEIGHT(Ev) (Ev)->area.height
+#define widget_set_margin_left(W, M)
+#define widget_set_margin_right(W, M)
+#else
+#if (GTK_CHECK_VERSION(3, 12, 0))
+ #define widget_set_margin_left(W, M)
+ #define widget_set_margin_right(W, M)
+#else
+ #define widget_set_margin_left(W, M) gtk_widget_set_margin_left(W, M)
+ #define widget_set_margin_right(W, M) gtk_widget_set_margin_right(W, M)
+#endif
+#endif
+
+#if (GTK_CHECK_VERSION(3, 0, 0)) && defined(__GNUC__) && (!(defined(__cplusplus)))
+ #define EVENT_STATE(Ev) ({ GdkModifierType Type; gdk_event_get_state((GdkEvent *)Ev, &Type); Type; })
+ #define EVENT_TIME(Ev) gdk_event_get_time((GdkEvent *)Ev)
+ #define EVENT_X(Ev) ({ gdouble x, y; gdk_event_get_coords((GdkEvent *)Ev, &x, &y); x; })
+ #define EVENT_Y(Ev) ({ gdouble x, y; gdk_event_get_coords((GdkEvent *)Ev, &x, &y); y; })
+ /* there's also gtk_get_event_widget */
+#else
+ #define EVENT_STATE(Ev) (Ev)->state
+ #define EVENT_TIME(Ev) (Ev)->time
+ #define EVENT_X(Ev) (Ev)->x
+ #define EVENT_Y(Ev) (Ev)->y
+#endif
+
+
+/* gtk 3.n changes -- nearly every widget used in Snd has been deprecated...
+ */
+#ifdef GTK_IS_FONT_CHOOSER_WIDGET
+/* can't use GTK_IS_VBOX here because it is now always defined, and blathers constantly during compilation */
+#undef GTK_IS_VBOX
+#define GTK_IS_VBOX(Obj) GTK_IS_BOX(Obj)
+#undef GTK_IS_HBOX
+#define GTK_IS_HBOX(Obj) GTK_IS_BOX(Obj)
+#undef GTK_IS_VPANED
+#define GTK_IS_VPANED(Obj) GTK_IS_PANED(Obj)
+#undef GTK_IS_HPANED
+#define GTK_IS_HPANED(Obj) GTK_IS_PANED(Obj)
+
+#define gtk_vbox_new(H, S) gtk_box_new(GTK_ORIENTATION_VERTICAL, S)
+#define gtk_hbox_new(H, S) gtk_box_new(GTK_ORIENTATION_HORIZONTAL, S)
+#define gtk_vscrollbar_new(S) gtk_scrollbar_new(GTK_ORIENTATION_VERTICAL, S)
+#define gtk_hscrollbar_new(S) gtk_scrollbar_new(GTK_ORIENTATION_HORIZONTAL, S)
+/* #define gtk_vscale_new(S) gtk_scale_new(GTK_ORIENTATION_VERTICAL, S) */
+#define gtk_hscale_new(S) gtk_scale_new(GTK_ORIENTATION_HORIZONTAL, S)
+#define gtk_vpaned_new() gtk_paned_new(GTK_ORIENTATION_VERTICAL)
+#define gtk_hpaned_new() gtk_paned_new(GTK_ORIENTATION_HORIZONTAL)
+#define gtk_vseparator_new() gtk_separator_new(GTK_ORIENTATION_VERTICAL)
+#define gtk_hseparator_new() gtk_separator_new(GTK_ORIENTATION_HORIZONTAL)
+
+/* 3.4: table widget replaced by grid (also box eventually, I think) */
+#undef GTK_TABLE
+#define GTK_TABLE(Obj) GTK_GRID(Obj)
+#define gtk_table_new(Rows, Cols, Homogeneous) gtk_grid_new()
+#define gtk_table_set_homogeneous(Obj, Val) do {gtk_grid_set_row_homogeneous(Obj, Val); gtk_grid_set_column_homogeneous(Obj, Val);} while (0)
+#define gtk_table_set_row_spacings(Obj, Val) gtk_grid_set_row_spacing(Obj, Val)
+#define gtk_table_set_col_spacings(Obj, Val) gtk_grid_set_column_spacing(Obj, Val)
+#define gtk_table_attach_defaults(Obj, Wid, Left, Right, Top, Bottom) gtk_grid_attach(Obj, Wid, Left, Top, Right - Left, Bottom - Top)
+#define gtk_table_attach(Obj, Wid, Left, Right, Top, Bottom, XOptions, YOptions, Xpad, YPad) gtk_grid_attach(Obj, Wid, Left, Top, Right - Left, Bottom - Top)
+
+#define window_get_pointer(Event, X, Y, Mask) gdk_window_get_device_position(EVENT_WINDOW(Event), gdk_event_get_device((GdkEvent *)Event), X, Y, Mask)
+#define widget_set_hexpand(Wid, Val) gtk_widget_set_hexpand(Wid, Val)
+#define widget_set_vexpand(Wid, Val) gtk_widget_set_vexpand(Wid, Val)
+
+#else
+
+#define window_get_pointer(Event, X, Y, Mask) gdk_window_get_pointer(EVENT_WINDOW(Event), X, Y, Mask)
+#define widget_set_hexpand(Wid, Val)
+#define widget_set_vexpand(Wid, Val)
+
+#endif
+
+/* 3.16: gdk_cursor_new removed */
+#if GTK_CHECK_VERSION(3, 16, 0)
+ #define GDK_CURSOR_NEW(Type) gdk_cursor_new_for_display(gdk_display_get_default(), Type)
+#else
+ #define GDK_CURSOR_NEW(Type) gdk_cursor_new(Type)
+#endif
+
+
+#define Xen_wrap_widget(Value) ((Value) ? Xen_list_2(C_string_to_Xen_symbol("GtkWidget_"), Xen_wrap_C_pointer(Value)) : Xen_false)
+#define Xen_wrap_window(Value) ((Value) ? Xen_list_2(C_string_to_Xen_symbol("GdkWindow_"), Xen_wrap_C_pointer(Value)) : Xen_false)
+#define Xen_unwrap_widget(Value) (Xen_is_pair(Value) ? (GtkWidget *)(Xen_unwrap_C_pointer(Xen_cadr(Value))) : NULL)
+#define Xen_is_widget(Value) (Xen_is_pair(Value) && (Xen_car(Value) == C_string_to_Xen_symbol("GtkWidget_")))
+
+#define Xen_wrap_pixel(Value) Xen_list_2(C_string_to_Xen_symbol("color_t"), Xen_wrap_C_pointer((unsigned long)Value))
+#define Xen_unwrap_pixel(Value) (color_t)(Xen_unwrap_C_pointer(Xen_cadr(Value)))
+#define Xen_is_pixel(Value) (Xen_is_list(Value) && (Xen_list_length(Value) >= 2) && (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp("color_t", Xen_symbol_to_C_string(Xen_car(Value))) == 0))
+/* unfortunately, we can't just make PIXEL into a C type here -- it is called
+ * XM_PIXEL in xm.c and in that context, it assumes the layout given above.
+ */
+
#define NULL_WIDGET NULL
#define SG_SIGNAL_CONNECT(Widget, Signal, Function, Data) g_signal_connect(G_OBJECT(Widget), Signal, G_CALLBACK(Function), (gpointer)Data)
@@ -52,22 +168,14 @@ typedef enum {WITH_DEFAULT_BACKGROUND, WITH_WHITE_BACKGROUND} snd_entry_bg_t;
#if HAVE_GTK_ADJUSTMENT_GET_UPPER
/* 2.13.6 */
#define WIDGET_TO_WINDOW(Widget) gtk_widget_get_window(Widget)
- #define DIALOG_ACTION_AREA(Dialog) gtk_dialog_get_action_area(GTK_DIALOG(Dialog))
#define DIALOG_CONTENT_AREA(Dialog) gtk_dialog_get_content_area(GTK_DIALOG(Dialog))
#define ADJUSTMENT_VALUE(Adjust) gtk_adjustment_get_value(GTK_ADJUSTMENT(Adjust))
- #define ADJUSTMENT_LOWER(Adjust) gtk_adjustment_get_lower(GTK_ADJUSTMENT(Adjust))
- #define ADJUSTMENT_UPPER(Adjust) gtk_adjustment_get_upper(GTK_ADJUSTMENT(Adjust))
- #define ADJUSTMENT_SET_UPPER(Adjust, Value) gtk_adjustment_set_upper(GTK_ADJUSTMENT(Adjust), Value)
#define ADJUSTMENT_PAGE_SIZE(Adjust) gtk_adjustment_get_page_size(GTK_ADJUSTMENT(Adjust))
#define ADJUSTMENT_SET_PAGE_SIZE(Adjust, Value) gtk_adjustment_set_page_size(GTK_ADJUSTMENT(Adjust), Value)
#else
#define WIDGET_TO_WINDOW(Widget) ((Widget)->window)
- #define DIALOG_ACTION_AREA(Dialog) ((GTK_DIALOG(Dialog))->action_area)
#define DIALOG_CONTENT_AREA(Dialog) ((GTK_DIALOG(Dialog))->vbox)
#define ADJUSTMENT_VALUE(Adjust) ((GTK_ADJUSTMENT(Adjust))->value)
- #define ADJUSTMENT_LOWER(Adjust) ((GTK_ADJUSTMENT(Adjust))->lower)
- #define ADJUSTMENT_UPPER(Adjust) ((GTK_ADJUSTMENT(Adjust))->upper)
- #define ADJUSTMENT_SET_UPPER(Adjust, Value) (GTK_ADJUSTMENT(Adjust))->upper = Value
#define ADJUSTMENT_PAGE_SIZE(Adjust) ((GTK_ADJUSTMENT(Adjust))->page_size)
#define ADJUSTMENT_SET_PAGE_SIZE(Adjust, Value) (GTK_ADJUSTMENT(Adjust))->page_size = Value
#endif
@@ -79,27 +187,13 @@ typedef enum {WITH_DEFAULT_BACKGROUND, WITH_WHITE_BACKGROUND} snd_entry_bg_t;
#define TOGGLE_BUTTON_ACTIVE(Button) gtk_toggle_button_get_active((GTK_TOGGLE_BUTTON(Button)))
#define BIN_CHILD(Bin) gtk_bin_get_child(GTK_BIN(Bin))
-#if (HAVE_GTK_3) && defined(__GNUC__) && (!(defined(__cplusplus)))
- #define EVENT_STATE(Ev) ({ GdkModifierType Type; gdk_event_get_state((GdkEvent *)Ev, &Type); Type; })
- #define EVENT_TIME(Ev) gdk_event_get_time((GdkEvent *)Ev)
- #define EVENT_X(Ev) ({ gdouble x, y; gdk_event_get_coords((GdkEvent *)Ev, &x, &y); x; })
- #define EVENT_Y(Ev) ({ gdouble x, y; gdk_event_get_coords((GdkEvent *)Ev, &x, &y); y; })
- /* there's also gtk_get_event_widget */
-#else
- #define EVENT_STATE(Ev) (Ev)->state
- #define EVENT_TIME(Ev) (Ev)->time
- #define EVENT_X(Ev) (Ev)->x
- #define EVENT_Y(Ev) (Ev)->y
-#endif
-
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
#define DRAW_SIGNAL "draw"
#else
#define DRAW_SIGNAL "expose_event"
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
- /* 2.17... */
+#if GTK_CHECK_VERSION(2, 18, 0)
#define SET_CAN_FOCUS(Wid) gtk_widget_set_can_focus(Wid, true)
#define UNSET_CAN_FOCUS(Wid) gtk_widget_set_can_focus(Wid, false)
#else
@@ -107,18 +201,6 @@ typedef enum {WITH_DEFAULT_BACKGROUND, WITH_WHITE_BACKGROUND} snd_entry_bg_t;
#define UNSET_CAN_FOCUS(Wid) GTK_WIDGET_UNSET_FLAGS(Wid, GTK_CAN_FOCUS)
#endif
-/* no accessors: */
-#define EVENT_WINDOW(Ev) (Ev)->window
-#define EVENT_BUTTON(Ev) (Ev)->button
-#define EVENT_TYPE(Ev) (Ev)->type
-#define EVENT_KEYVAL(Ev) (Ev)->keyval
-#define EVENT_IS_HINT(Ev) (Ev)->is_hint
-
-#if (!HAVE_GTK_3)
-#define EVENT_AREA_WIDTH(Ev) (Ev)->area.width
-#define EVENT_AREA_HEIGHT(Ev) (Ev)->area.height
-#endif
-
#define idle_t guint
#define idle_func_t gboolean
#define any_pointer_t gpointer
@@ -130,8 +212,8 @@ typedef struct {
#define rgb_t gdouble
#define RGB_MAX 1.0
-#define FLOAT_TO_RGB(Val) (rgb_t)(Val)
-#define RGB_TO_FLOAT(Val) Val
+#define float_to_rgb(Val) (rgb_t)(Val)
+#define rgb_to_float(Val) Val
typedef struct {
rgb_t red, green, blue, alpha;
@@ -145,11 +227,9 @@ typedef struct {
#define picture_t cairo_surface_t
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
typedef GdkWindow Drawable;
#define DRAWABLE(Widget) GDK_WINDOW(Widget)
- #define IS_DRAWABLE(Widget) GDK_IS_WINDOW(Widget)
-
/* as far as I can see, UPDATE_CONTINUOUS is now built-in */
#define gtk_range_get_update_policy(W) 0
#define gtk_range_set_update_policy(W, V)
@@ -157,7 +237,6 @@ typedef struct {
#else
typedef GdkDrawable Drawable;
#define DRAWABLE(Widget) GDK_DRAWABLE(Widget)
- #define IS_DRAWABLE(Widget) GDK_IS_DRAWABLE(Widget)
#endif
typedef struct {
@@ -184,11 +263,13 @@ typedef enum {NOT_A_SCANF_WIDGET, SRATE_WIDGET, CHANS_WIDGET, DATA_LOCATION_WIDG
typedef struct {
GtkWidget *srate_text, *chans_text, *comment_text, *location_text, *samples_text, *error_text;
GtkWidget *dialog, *src_button, *auto_comment_button;
- int current_type, current_format, formats, header_pos, format_pos;
+ mus_header_t current_header_type;
+ mus_sample_t current_sample_type;
+ int sample_types, header_type_pos, sample_type_pos;
scanf_widget_t scanf_widget, error_widget;
bool src, auto_comment;
gulong *reflection_ids;
- slist *header_list, *format_list;
+ slist *header_type_list, *sample_type_list;
char *saved_comment;
} file_data;
@@ -196,10 +277,10 @@ typedef struct {
#define DEFAULT_PEAKS_FONT "Times Medium 10"
#define DEFAULT_BOLD_PEAKS_FONT "Times Bold 10"
#define DEFAULT_AXIS_NUMBERS_FONT "Sans 10"
-/* changed 31-May-08 for Gtk+-2.13.1 -- apparently Fixed 10 is no longer defined (or maybe this is Fedora 9's fault?) */
#define DEFAULT_AXIS_LABEL_FONT "Times Medium 14"
+#define DEFAULT_LISTENER_FONT "Monospace 11"
-typedef enum {CONTAINER_ADD, PANED_ADD1, BOX_PACK, TABLE_ATTACH, PANED_ADD2, BOX_PACK_END} widget_add_t;
+typedef enum {CONTAINER_ADD, PANED_ADD1, BOX_PACK, TABLE_ATTACH} widget_add_t;
typedef enum {WITHOUT_CHANNELS_FIELD, WITH_CHANNELS_FIELD, WITH_EXTRACT_CHANNELS_FIELD} dialog_channels_t;
typedef enum {WITHOUT_SAMPLES_FIELD, WITH_SAMPLES_FIELD} dialog_samples_t;
typedef enum {WITHOUT_DATA_LOCATION_FIELD, WITH_DATA_LOCATION_FIELD} dialog_data_location_t;
@@ -218,9 +299,7 @@ typedef enum {WITHOUT_COMMENT_FIELD, WITH_COMMENT_FIELD} dialog_comment_t;
#define PEAKS_FONT(a) (a)->peaks_fnt
#define BOLD_PEAKS_FONT(a) (a)->bold_peaks_fnt
#define KEY_TO_NAME(key) gdk_keyval_name(key)
-
#define DEFAULT_GRAPH_CURSOR GDK_CROSSHAIR
-/* #define GUI_CURRENT_TIME(ss) GDK_CURRENT_TIME */
#define snd_ShiftMask GDK_SHIFT_MASK
#define snd_ControlMask GDK_CONTROL_MASK
@@ -230,9 +309,6 @@ typedef enum {WITHOUT_COMMENT_FIELD, WITH_COMMENT_FIELD} dialog_comment_t;
#define snd_MetaMask (GDK_MOD1_MASK | GDK_MOD4_MASK)
#endif
-#define NO_BUCKY_BITS_P(State) (((State) & (GDK_SHIFT_MASK | GDK_CONTROL_MASK | GDK_MOD1_MASK)) == 0)
-/* in some cases, numlock = GDK_MOD2_MASK for example, and we want to completely ignore that setting */
-
#define BUTTON1_PRESSED(State) ((State) & GDK_BUTTON1_MASK)
/* now pull in the key names (gdk/gdkkeysyms.h)
@@ -342,12 +418,7 @@ typedef enum {WITHOUT_COMMENT_FIELD, WITH_COMMENT_FIELD} dialog_comment_t;
#define snd_keypad_8 GDK_KEY_KP_8
#define snd_keypad_9 GDK_KEY_KP_9
-#define snd_K_Return GDK_KEY_Return
#define snd_K_Tab GDK_KEY_Tab
-#define snd_K_BackSpace GDK_KEY_BackSpace
-#define snd_K_Delete GDK_KEY_Delete
-#define snd_K_question GDK_KEY_question
-
#else
/* ---------------- old version ---------------- */
@@ -454,11 +525,92 @@ typedef enum {WITHOUT_COMMENT_FIELD, WITH_COMMENT_FIELD} dialog_comment_t;
#define snd_keypad_8 GDK_KP_8
#define snd_keypad_9 GDK_KP_9
-#define snd_K_Return GDK_Return
#define snd_K_Tab GDK_Tab
-#define snd_K_BackSpace GDK_BackSpace
-#define snd_K_Delete GDK_Delete
-#define snd_K_question GDK_question
+#endif
+
+
+#if GTK_CHECK_VERSION(3, 10, 0)
+
+/* see the "Icon Naming Specification" */
+#define ICON_ADD "Add"
+#define ICON_APPLY "Apply"
+#define ICON_CANCEL "process-stop"
+#define ICON_CLEAR "edit-clear"
+#define ICON_CLOSE "window-close"
+#define ICON_COPY "edit-copy"
+#define ICON_CUT "edit-cut"
+#define ICON_EDIT "Edit"
+#define ICON_FIND "edit-find"
+#define ICON_FULLSCREEN "view-fullscreen"
+#define ICON_GOTO_FIRST "go-first"
+#define ICON_GOTO_LAST "go-last"
+#define ICON_GO_BACK "go-previous"
+#define ICON_GO_FORWARD "go-next"
+#define ICON_HELP "help-browser"
+#define ICON_MEDIA_FORWARD "media-skip-forward"
+#define ICON_MEDIA_PLAY "media-playback-start"
+#define ICON_MEDIA_STOP "media-playback-stop"
+#define ICON_NEW "document-new"
+#define ICON_OK "Ok"
+#define ICON_OPEN "document-open"
+#define ICON_PASTE "edit-paste"
+#define ICON_PREFERENCES "Preferences"
+#define ICON_PRINT "document-print"
+#define ICON_QUIT "application-exit"
+#define ICON_REDO "edit-redo"
+#define ICON_REFRESH "view-refresh"
+#define ICON_REVERT_TO_SAVED "document-revert"
+#define ICON_SAVE "document-save"
+#define ICON_SAVE_AS "document-save-as"
+#define ICON_SELECT_ALL "edit-select-all"
+#define ICON_SELECT_COLOR "Select color"
+#define ICON_UNDO "edit-undo"
+#define ICON_ZOOM_IN "zoom-in"
+#define ICON_ZOOM_OUT "zoom-out"
+
+GtkWidget *button_new_with_icon(const gchar *label);
+#define image_new_with_icon(Icon, Size) gtk_image_new_from_icon_name(Icon, Size)
+
+#else
+
+#define ICON_ADD GTK_STOCK_ADD
+#define ICON_APPLY GTK_STOCK_APPLY
+#define ICON_CANCEL GTK_STOCK_CANCEL
+#define ICON_CLEAR GTK_STOCK_CLEAR
+#define ICON_CLOSE GTK_STOCK_CLOSE
+#define ICON_COPY GTK_STOCK_COPY
+#define ICON_CUT GTK_STOCK_CUT
+#define ICON_EDIT GTK_STOCK_EDIT
+#define ICON_FIND GTK_STOCK_FIND
+#define ICON_FULLSCREEN GTK_STOCK_FULLSCREEN
+#define ICON_GOTO_FIRST GTK_STOCK_GOTO_FIRST
+#define ICON_GOTO_LAST GTK_STOCK_GOTO_LAST
+#define ICON_GO_BACK GTK_STOCK_GO_BACK
+#define ICON_GO_FORWARD GTK_STOCK_GO_FORWARD
+#define ICON_HELP GTK_STOCK_HELP
+#define ICON_MEDIA_FORWARD GTK_STOCK_MEDIA_FORWARD
+#define ICON_MEDIA_PLAY GTK_STOCK_MEDIA_PLAY
+#define ICON_MEDIA_STOP GTK_STOCK_MEDIA_STOP
+#define ICON_NEW GTK_STOCK_NEW
+#define ICON_OK GTK_STOCK_OK
+#define ICON_OPEN GTK_STOCK_OPEN
+#define ICON_PASTE GTK_STOCK_PASTE
+#define ICON_PREFERENCES GTK_STOCK_PREFERENCES
+#define ICON_PRINT GTK_STOCK_PRINT
+#define ICON_QUIT GTK_STOCK_QUIT
+#define ICON_REDO GTK_STOCK_REDO
+#define ICON_REFRESH GTK_STOCK_REFRESH
+#define ICON_REVERT_TO_SAVED GTK_STOCK_REVERT_TO_SAVED
+#define ICON_SAVE GTK_STOCK_SAVE
+#define ICON_SAVE_AS GTK_STOCK_SAVE_AS
+#define ICON_SELECT_ALL GTK_STOCK_SELECT_ALL
+#define ICON_SELECT_COLOR GTK_STOCK_SELECT_COLOR
+#define ICON_UNDO GTK_STOCK_UNDO
+#define ICON_ZOOM_IN GTK_STOCK_ZOOM_IN
+#define ICON_ZOOM_OUT GTK_STOCK_ZOOM_OUT
+
+#define button_new_with_icon(Icon) gtk_button_new_from_stock(Icon)
+#define image_new_with_icon(Icon, Size) gtk_image_new_from_stock(Icon, Size)
#endif
diff --git a/snd-g1.h b/snd-g1.h
index 4c2c971..8017101 100644
--- a/snd-g1.h
+++ b/snd-g1.h
@@ -1,8 +1,7 @@
#ifndef SND_G1_H
#define SND_G1_H
-#define SOUND_ENV_EDITOR(Sp) ((env_editor *)(sp->flt))
-
+void recolor_everything(widget_t w, gpointer color);
/* -------- snd-ghelp.c -------- */
@@ -45,7 +44,7 @@ void set_spectro_y_scale(mus_float_t val);
void set_spectro_z_scale(mus_float_t val);
void view_color_orientation_callback(GtkWidget * w, gpointer info);
bool color_orientation_dialog_is_active(void);
-GtkWidget *start_color_orientation_dialog(bool managed);
+GtkWidget *make_color_orientation_dialog(bool managed);
void reflect_spectro(void);
void allocate_sono_rects(int size);
void set_sono_rectangle(int j, int color, int x, int y, int width, int height);
@@ -57,7 +56,6 @@ void initialize_colormap(void);
void reflect_color_list(bool setup_time);
void set_with_gl(bool val, bool with_dialogs);
void g_init_gxdraw(void);
-gchar* scale_int_format_callback(GtkScale *w, gdouble val, gpointer data);
gchar* scale_double_format_callback(GtkScale *w, gdouble val, gpointer data);
@@ -72,16 +70,14 @@ int listener_height(void);
int listener_width(void);
void goto_listener(void);
int save_listener_text(FILE *fp);
-void listener_delete_text(int new_end);
void append_listener_text(int end, const char *msg);
void listener_append(const char *msg);
void listener_append_and_prompt(const char *msg);
void clear_listener(void);
void set_listener_text_font(void);
+bool listener_colorized(void);
+bool listener_set_colorized(bool val);
void g_init_gxlistener(void);
-GtkWidget *snd_entry_new(GtkWidget *container, snd_entry_bg_t with_white_background);
-bool highlight_unbalanced_paren(void);
-void connect_mouse_to_text(GtkWidget *text);
@@ -92,10 +88,6 @@ void snd_doit(int argc, char **argv);
void auto_update_restart(void);
void save_colors(FILE *Fp);
-#ifdef SND_AS_WIDGET
- GtkWidget *snd_as_widget(int argc, char **argv, GtkWidget *parent, void (*error_func)(const char *));
-#endif
-
/* -------- snd-gmenu.c -------- */
@@ -112,7 +104,7 @@ void add_tooltip(GtkWidget *w, const char *tip);
void post_basic_popup_menu(void *ev);
void post_lisp_popup_menu(void *ev);
void post_selection_popup_menu(void *ev);
-GtkWidget *add_menu_item(GtkWidget *menu, const char *label, const char *icon, GCallback callback);
+widget_t make_file_print_dialog(bool managed, bool direct_to_printer);
@@ -123,7 +115,7 @@ void set_fft_window_alpha(mus_float_t val);
void set_transform_size(mus_long_t val);
void set_fft_window(mus_fft_window_t val);
void set_wavelet_type(int val);
-GtkWidget *fire_up_transform_dialog(bool managed);
+GtkWidget *make_transform_dialog(bool managed);
bool transform_dialog_is_active(void);
void set_transform_type(int val);
@@ -147,22 +139,9 @@ void post_fft_popup_menu(void *ev);
-/* -------- snd-gdrop.c -------- */
-
-void add_drop(GtkWidget *w,
- void (*watcher)(GtkWidget *w, const char *message, int x, int y, void *data),
- void *context);
-void add_drag_and_drop(GtkWidget *w,
- void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data),
- void (*drag_watcher)(GtkWidget *w, const char *message, int x, int y, drag_style_t dtype, void *data),
- void *context);
-void g_init_gxdrop(void);
-
-
-
/* -------- snd-gregion.c -------- */
-void update_region_browser(bool grf_too);
+int update_region_browser(bool grf_too);
void reflect_play_region_stop(int n);
bool region_browser_is_active(void);
void delete_region_and_update_browser(int n);
@@ -176,6 +155,10 @@ int region_dialog_region(void);
char *regrow_get_label(void *ur);
int regrow_get_pos(void *ur);
void g_init_gxregion(void);
+void view_files_add_directory(widget_t dialog, const char *dirname);
+bool view_files_has_files(void);
+void view_files_callback(GtkWidget *w, gpointer info);
+void view_files_unplay(void);
/* -------- snd-gxbitmaps.c -------- */
@@ -192,9 +175,11 @@ char *colormap_name(int n);
bool is_colormap(int n);
int num_colormaps(void);
void get_current_color(int colormap, int n, rgb_t *r, rgb_t *g, rgb_t *b);
+#if HAVE_GL
rgb_t *color_map_reds(int index);
rgb_t *color_map_greens(int index);
rgb_t *color_map_blues(int index);
+#endif
void g_init_gxcolormaps(void);
void phases_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b);
@@ -218,7 +203,6 @@ void set_z_scrollbars(chan_info *cp, axis_info *ap);
void change_gzy(mus_float_t val, chan_info *cp);
mus_float_t gsy_value(chan_info *cp);
mus_float_t gsy_size(chan_info *cp);
-bool fixup_cp_cgx_ax_wn(chan_info *cp);
void reflect_edit_history_change(chan_info *cp);
void reflect_edit_counter_change(chan_info *cp);
gboolean graph_key_press(GtkWidget *w, GdkEventKey *event, gpointer data);
@@ -242,7 +226,13 @@ void g_init_gxchn(void);
/* -------- snd-gfind.c -------- */
void edit_find_callback(GtkWidget *w, gpointer info);
-void set_find_dialog_label(const char *str);
+void find_dialog(chan_info *cp);
+void find_dialog_set_label(const char *str);
+void stop_search_if_error(const char *msg, void *data);
+void errors_to_find_text(const char *msg, void *data);
+void find_dialog_stop_label(bool show_stop);
+bool find_dialog_is_active(void);
+
void save_find_dialog_state(FILE *fd);
void g_init_gxfind(void);
@@ -267,8 +257,6 @@ void highlight_color(GtkWidget *w);
void raise_dialog(GtkWidget *w);
void set_button_label(GtkWidget *label, const char *str);
void set_label(GtkWidget *label, const char *str);
-void sg_left_justify_button(GtkWidget *button);
-void sg_left_justify_label(GtkWidget *label);
void check_for_event(void);
void set_title(const char *title);
void goto_window(GtkWidget *text);
@@ -291,14 +279,27 @@ void widget_modify_fg(GtkWidget *w, GtkStateType type, color_t color);
void widget_modify_base(GtkWidget *w, GtkStateType type, color_t color);
color_t rgb_to_color(mus_float_t r, mus_float_t g, mus_float_t b);
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
GdkColor *rgb_to_gdk_color(color_t col);
#endif
+void add_highlight_button_style(GtkWidget *w);
+void add_center_button_style(GtkWidget *w);
+void add_toolbar_style(GtkWidget *w);
+void add_menu_style(GtkWidget *w);
+void add_paned_style(GtkWidget *w);
+void add_red_scale_style(GtkWidget *w);
+void add_green_scale_style(GtkWidget *w);
+void add_blue_scale_style(GtkWidget *w);
+void add_white_button_style(GtkWidget *w);
+void add_listener_style(GtkWidget *w);
+void add_dialog_style(GtkWidget *w);
+void add_check_button_style(GtkWidget *w);
+void add_entry_style(GtkWidget *w);
void recolor_graph(chan_info *cp, bool selected);
void set_sensitive(GtkWidget *wid, bool val);
void set_toggle_button(GtkWidget *wid, bool val, bool passed, void *data);
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
int widget_height(GtkWidget *w);
int widget_width(GtkWidget *w);
#else
@@ -319,20 +320,14 @@ void reset_user_int_data(GObject *obj, int data);
gpointer get_user_data(GObject *obj);
int get_user_int_data(GObject *obj);
void set_stock_button_label(GtkWidget *w, const char *new_label);
-GtkWidget *sg_button_new_from_stock_with_label(const char *text, const gchar *stock_id);
+bool cursor_set_blinks(GtkWidget *w, bool blinks);
char *sg_get_text(GtkWidget *w, int start, int end);
-void sg_set_cursor(GtkWidget *w, int position);
void sg_text_insert(GtkWidget *w, const char *text);
-int sg_cursor_position(GtkWidget *w);
GtkWidget *make_scrolled_text(GtkWidget *parent, bool editable, int add_choice, bool resize);
void sg_make_resizable(GtkWidget *w);
idle_t add_work_proc(GSourceFunc func, gpointer data);
GtkWidget *snd_gtk_dialog_new(void);
-GtkWidget *snd_gtk_entry_label_new(const char *label, color_info *color);
-GtkWidget *make_info_widget(void);
-void info_widget_display(GtkWidget *w, const char *message);
-void info_widget_set_size(GtkWidget *w, int size);
GtkWidget *snd_gtk_highlight_label_new(const char *label);
void widget_int_to_text(GtkWidget *w, int val);
void widget_mus_long_t_to_text(GtkWidget *w, mus_long_t val);
@@ -347,20 +342,18 @@ void slist_clear(slist *lst);
void slist_append(slist *lst, const char *name);
void slist_moveto(slist *lst, int row);
void slist_select(slist *lst, int row);
-char *slist_selection(slist *lst);
-#if HAVE_GTK_3
-cairo_t *make_cairo(GdkWindow *win, const char *func, const char *file, int line);
+#if GTK_CHECK_VERSION(3, 0, 0)
+cairo_t *make_cairo(GdkWindow *win);
#else
-cairo_t *make_cairo(GdkDrawable *win, const char *func, const char *file, int line);
+cairo_t *make_cairo(GdkDrawable *win);
#endif
-void free_cairo(cairo_t *cr, const char *func, const char *file, int line);
-#define MAKE_CAIRO(Win) make_cairo(Win, __func__, __FILE__, __LINE__)
-#define FREE_CAIRO(Cr) free_cairo(Cr, __func__, __FILE__, __LINE__)
+void free_cairo(cairo_t *cr);
void init_gtk(void);
+
/* -------- snd-gsnd.c -------- */
int control_panel_height(snd_info *sp);
@@ -372,13 +365,7 @@ void show_lock(snd_info *sp);
void hide_lock(snd_info *sp);
void start_bomb(snd_info *sp);
void stop_bomb(snd_info *sp);
-void show_bomb(snd_info *sp);
-void hide_bomb(snd_info *sp);
-void goto_minibuffer(snd_info *sp);
-void set_minibuffer_string(snd_info *sp, const char *str, bool update);
-void set_minibuffer_cursor_position(snd_info *sp, int pos);
-char *get_minibuffer_string(snd_info *sp);
-void make_minibuffer_label(snd_info *sp, const char *str);
+void set_status(snd_info *sp, const char *str, bool update);
void set_play_button(snd_info *sp, bool val);
void play_button_pause(bool pausing);
void syncb(snd_info *sp, int on);
@@ -414,9 +401,12 @@ void finish_progress_report(chan_info *cp);
void progress_report(chan_info *cp, mus_float_t pct);
void g_init_gxsnd(void);
void reflect_sound_selection(snd_info *sp);
-void display_minibuffer_error(snd_info *sp, const char *str);
-void clear_minibuffer_error(snd_info *sp);
void make_controls_dialog(void);
+void update_sound_label(snd_info *sp);
+
+GtkWidget *snd_entry_new(GtkWidget *container, GtkWidget *prev, snd_entry_bg_t with_white_background);
+GtkWidget *snd_entry_new_with_size(GtkWidget *container, int size);
+void connect_mouse_to_text(GtkWidget *text);
@@ -440,6 +430,7 @@ void set_enved_revert_sensitive(bool val);
void set_enved_undo_sensitive(bool val);
void set_enved_save_sensitive(bool val);
void set_enved_show_sensitive(bool val);
+void enved_reflect_selection(bool on);
void make_scrolled_env_list(void);
void enved_reflect_peak_env_completion(snd_info *sp);
void new_active_channel_alert(void);
@@ -447,11 +438,11 @@ void env_redisplay(void);
void env_redisplay_with_print(void);
void update_enved_background_waveform(chan_info *cp);
GtkWidget *create_envelope_editor(void);
-void set_enved_clip_p(bool val);
+void set_enved_clipping(bool val);
void reflect_enved_style(void);
void set_enved_base(mus_float_t val);
void set_enved_target(enved_target_t val);
-void set_enved_wave_p(bool val);
+void set_enved_with_wave(bool val);
void set_enved_in_dB(bool val);
bool enved_dialog_is_active(void);
void set_enved_filter_order(int order);
@@ -460,18 +451,17 @@ void g_init_gxenv(void);
-/* -------- snd-grec.c -------- */
-
-widget_t record_file(void);
-
-
-
/* -------- snd-gfile.c -------- */
-char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, int *type, int *format, mus_long_t *location, mus_long_t *samples, int min_chan);
-void alert_new_file(void);
+void cleanup_file_monitor(void);
+void *unmonitor_file(void *watcher);
+void monitor_sound(snd_info *sp);
+
+char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, mus_header_t *header_type,
+ mus_sample_t *sample_type, mus_long_t *location, mus_long_t *samples, int min_chan);
widget_t make_open_file_dialog(read_only_t read_only, bool managed);
widget_t make_sound_save_as_dialog(bool managed);
+void make_channel_extract_dialog(int chan);
widget_t make_selection_save_as_dialog(bool managed);
widget_t make_region_save_as_dialog(bool managed);
widget_t make_new_file_dialog(bool managed);
@@ -479,35 +469,32 @@ widget_t make_mix_file_dialog(bool managed);
widget_t make_insert_file_dialog(bool managed);
GtkWidget *edit_header(snd_info *sp);
void save_edit_header_dialog_state(FILE *fd);
-void cleanup_edit_header_watcher(void);
-void cleanup_new_file_watcher(void);
void set_open_file_play_button(bool val);
void g_init_gxfile(void);
-void clear_deleted_snd_info(struct dialog_play_info *fd);
+void clear_deleted_snd_info(void *fd);
void reflect_just_sounds(void);
void save_file_dialog_state(FILE *fd);
widget_t post_it(const char *subject, const char *str);
+void post_it_append(const char *str);
void save_post_it_dialog_state(FILE *fd);
void reflect_region_in_save_as_dialog(void);
-void mouse_enter_label(void *r, int type);
-void mouse_leave_label(void *r, int type);
+void reflect_selection_in_save_as_dialog(bool on);
void save_edits_now(snd_info *sp);
void unpost_unsaved_edits_if_any(snd_info *sp);
+void unpost_file_has_changed_if_any(snd_info *sp);
+void changed_file_dialog(snd_info *sp);
void reflect_save_as_src(bool val);
void reflect_save_as_auto_comment(bool val);
void reflect_save_as_sound_selection(const char *sound_name);
-
-
-
-/* -------- snd-gprint.c -------- */
-
-void file_print_callback(GtkWidget *w, gpointer info);
-widget_t make_file_print_dialog(bool managed, bool direct_to_printer);
+void add_drag_and_drop(GtkWidget *w,
+ void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data),
+ void (*drag_watcher)(GtkWidget *w, const char *message, int x, int y, drag_style_t dtype, void *data),
+ void *context);
/* -------- snd-gprefs.c -------- */
-widget_t start_preferences_dialog(void);
+widget_t make_preferences_dialog(void);
#endif
diff --git a/snd-gchn.c b/snd-gchn.c
index 70bec31..e9e623d 100644
--- a/snd-gchn.c
+++ b/snd-gchn.c
@@ -31,7 +31,7 @@ GtkWidget *channel_down_arrow(chan_info *cp) {return(cp->chan_widgets[W_down_ev]
#define EDIT_HISTORY_LIST(Cp) (Cp)->edhist_list
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
#define EDIT_HISTORY_CLOSED 2
#else
#define EDIT_HISTORY_CLOSED 1
@@ -61,6 +61,7 @@ static mus_float_t cube(mus_float_t a) {return(a * a * a);}
bool channel_graph_is_visible(chan_info *cp)
{
return((cp) &&
+ (cp->chan_widgets) &&
(channel_graph(cp)) &&
(widget_is_active(channel_graph(cp))) &&
(cp->sound) &&
@@ -85,7 +86,7 @@ static void sy_changed(float value, chan_info *cp)
ap = cp->axis;
ap->sy = value - ap->zy;
if (ap->sy < 0.0) ap->sy = 0.0;
- apply_y_axis_change(ap, cp);
+ apply_y_axis_change(cp);
}
@@ -94,7 +95,7 @@ static void sx_changed(float value, chan_info *cp)
axis_info *ap;
ap = cp->axis;
ap->sx = value;
- apply_x_axis_change(ap, cp);
+ apply_x_axis_change(cp);
}
@@ -106,9 +107,10 @@ static void zy_changed(float value, chan_info *cp)
if (value < .01) value = .01;
old_zy = ap->zy;
ap->zy = sqr(value);
+ if (ap->zy < 1e-5) ap->zy = 1e-5;
ap->sy += (.5 * (old_zy - ap->zy)); /* try to keep wave centered */
if (ap->sy < 0) ap->sy = 0;
- apply_y_axis_change(ap, cp);
+ apply_y_axis_change(cp);
resize_sy(cp);
}
@@ -134,7 +136,7 @@ static void zx_changed(float value, chan_info *cp)
if (fabs(old_zx - ap->zx) > .00001) /* click on zoom is moving the window */
{
/* if cursor visible, focus on that, else selection, else mark, else left side */
- focus_x_axis_change(ap, cp, zoom_focus_style(ss));
+ focus_x_axis_change(cp, zoom_focus_style(ss));
/* focus_x_axis_change has already displayed the new graph, but in gtk the scrollbar setting
* in resize_sx will try to display everything again. So try to squelch it...
@@ -144,7 +146,7 @@ static void zx_changed(float value, chan_info *cp)
cp->squelch_update = true;
resize_sx(cp);
cp->squelch_update = false;
- clear_minibuffer(cp->sound); /* erase the "(update squelched)" message */
+ clear_status_area(cp->sound); /* erase the "(update squelched)" message */
}
else resize_sx(cp);
}
@@ -243,9 +245,7 @@ void resize_sy_and_zy(chan_info *cp)
void resize_sx(chan_info *cp)
{
axis_info *ap;
- snd_info *sp;
ap = cp->axis;
- sp = cp->sound;
if (ap->x_ambit != 0.0)
set_scrollbar(sx_adj(cp),
(ap->x0 - ap->xmin) / ap->x_ambit,
@@ -347,7 +347,9 @@ static void gzy_valuechanged_callback(GtkAdjustment *adj, gpointer context)
cp->gsy = ADJUSTMENT_VALUE(adj);
ADJUSTMENT_SET_VALUE(gsy_adj(cp), cp->gsy);
}
+#if (!(GTK_CHECK_VERSION(3, 18, 0)))
else gtk_adjustment_changed(GTK_ADJUSTMENT(gsy_adj(cp)));
+#endif
for_each_sound_chan(cp->sound, update_graph_or_warn);
}
}
@@ -407,7 +409,7 @@ static gboolean channel_expose_callback(GtkWidget *w, GdkEventExpose *ev, gpoint
cp = (chan_info *)data;
if ((cp == NULL) || (cp->active < CHANNEL_HAS_AXES) || (cp->sound == NULL)) return(false);
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
if ((EVENT_AREA_HEIGHT(ev) < MIN_REGRAPH_Y) ||
(EVENT_AREA_WIDTH(ev) < MIN_REGRAPH_X))
return(false);
@@ -429,8 +431,8 @@ static gboolean channel_resize_callback(GtkWidget *w, GdkEventConfigure *ev, gpo
}
-static XEN mouse_enter_graph_hook;
-static XEN mouse_leave_graph_hook;
+static Xen mouse_enter_graph_hook;
+static Xen mouse_leave_graph_hook;
static gboolean graph_mouse_enter(GtkWidget *w, GdkEventCrossing *ev, gpointer data)
{
@@ -439,13 +441,13 @@ static gboolean graph_mouse_enter(GtkWidget *w, GdkEventCrossing *ev, gpointer d
if (with_pointer_focus(ss))
goto_window(w);
- if (XEN_HOOKED(mouse_enter_graph_hook))
+ if (Xen_hook_has_list(mouse_enter_graph_hook))
{
int pdata;
pdata = get_user_int_data(G_OBJECT(w));
run_hook(mouse_enter_graph_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(UNPACK_SOUND(pdata)),
- C_TO_XEN_INT(UNPACK_CHANNEL(pdata))),
+ Xen_list_2(C_int_to_Xen_sound(unpack_sound(pdata)),
+ C_int_to_Xen_integer(unpack_channel(pdata))),
S_mouse_enter_graph_hook);
}
@@ -456,13 +458,13 @@ static gboolean graph_mouse_enter(GtkWidget *w, GdkEventCrossing *ev, gpointer d
static gboolean graph_mouse_leave(GtkWidget *w, GdkEventCrossing *ev, gpointer data)
{
- if (XEN_HOOKED(mouse_leave_graph_hook))
+ if (Xen_hook_has_list(mouse_leave_graph_hook))
{
int pdata;
pdata = get_user_int_data(G_OBJECT(w));
run_hook(mouse_leave_graph_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(UNPACK_SOUND(pdata)),
- C_TO_XEN_INT(UNPACK_CHANNEL(pdata))),
+ Xen_list_2(C_int_to_Xen_sound(unpack_sound(pdata)),
+ C_int_to_Xen_integer(unpack_channel(pdata))),
S_mouse_leave_graph_hook);
}
@@ -508,10 +510,15 @@ static void remake_edit_history(chan_info *cp)
snd_info *sp;
int i, eds;
slist *lst;
+
if ((!cp) || (cp->active < CHANNEL_HAS_AXES)) return;
if (cp->squelch_update) return;
lst = EDIT_HISTORY_LIST(cp);
if (!lst) return;
+
+ /* if you try to update something in a closed pane, goddamn gtk grinds to a halt */
+ if (gtk_paned_get_position(GTK_PANED(cp->chan_widgets[W_main_window])) < 10) return;
+
slist_clear(lst);
sp = cp->sound;
if (sp->channel_style != CHANNELS_SEPARATE)
@@ -593,18 +600,30 @@ void reflect_edit_counter_change(chan_info *cp)
{
/* undo/redo/revert -- change which line is highlighted */
snd_info *sp;
+ slist *lst;
+
if (cp->squelch_update) return;
sp = cp->sound;
+
if ((cp->chan > 0) && (sp->channel_style != CHANNELS_SEPARATE))
{
chan_info *ncp;
ncp = sp->chans[0];
- slist_select(EDIT_HISTORY_LIST(ncp), cp->edit_ctr + cp->edhist_base);
+
+ lst = EDIT_HISTORY_LIST(ncp);
+ if ((!lst) || (!(lst->items))) return;
+ if (gtk_paned_get_position(GTK_PANED(cp->chan_widgets[W_main_window])) < 10) return;
+
+ slist_select(lst, cp->edit_ctr + cp->edhist_base);
}
else
{
- slist_select(EDIT_HISTORY_LIST(cp), cp->edit_ctr);
- slist_moveto(EDIT_HISTORY_LIST(cp), cp->edit_ctr);
+ lst = EDIT_HISTORY_LIST(cp);
+ if ((!lst) || (!(lst->items))) return;
+ if (widget_width(lst->scroller) < 10) return;
+
+ slist_select(lst, cp->edit_ctr);
+ slist_moveto(lst, cp->edit_ctr);
goto_graph(cp);
}
}
@@ -619,17 +638,26 @@ static gboolean real_graph_key_press(GtkWidget *w, GdkEventKey *ev, gpointer dat
{
chan_info *cp = (chan_info *)data;
int keysym;
- bool theirs;
- int x, y;
- GdkModifierType key_state;
- gdk_window_get_pointer(EVENT_WINDOW(ev), &x, &y, &key_state);
- key_state = (GdkModifierType)(EVENT_STATE(ev));
+ /* window_get_pointer(ev, &x, &y, &key_state);
+ * the x and y coordinates apparently refer to the mouse,
+ * and are only used to recognize "lisp-graph" oriented keystrokes.
+ * These are then used only if there is also a key_press_hook.
+ */
+
keysym = EVENT_KEYVAL(ev);
- theirs = key_press_callback(cp, x, y, EVENT_STATE(ev), keysym);
- if (theirs) ss->graph_is_active = false;
- g_signal_stop_emission((gpointer)w, g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ key_press_callback(cp, 0, 0, EVENT_STATE(ev), keysym);
+#else
+ {
+ int x, y;
+ GdkModifierType key_state;
+ window_get_pointer(ev, &x, &y, &key_state);
+ key_press_callback(cp, x, y, EVENT_STATE(ev), keysym);
+ }
+#endif
+ g_signal_stop_emission((gpointer)w, g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
return(true);
}
@@ -638,16 +666,18 @@ gboolean graph_key_press(GtkWidget *w, GdkEventKey *ev, gpointer data)
{
chan_info *cp = (chan_info *)data;
int keysym;
- bool theirs;
- int x, y;
- GdkModifierType key_state;
- gdk_window_get_pointer(EVENT_WINDOW(ev), &x, &y, &key_state);
- key_state = (GdkModifierType)(EVENT_STATE(ev));
keysym = EVENT_KEYVAL(ev);
- theirs = key_press_callback(cp, x, y, EVENT_STATE(ev), keysym);
- if (theirs) ss->graph_is_active = true;
-
+#if GTK_CHECK_VERSION(3, 0, 0)
+ key_press_callback(cp, 0, 0, EVENT_STATE(ev), keysym);
+#else
+ {
+ int x, y;
+ GdkModifierType key_state;
+ window_get_pointer(ev, &x, &y, &key_state);
+ key_press_callback(cp, x, y, EVENT_STATE(ev), keysym);
+ }
+#endif
return(true);
}
@@ -657,8 +687,6 @@ static gboolean graph_button_press(GtkWidget *w, GdkEventButton *ev, gpointer da
chan_info *cp = (chan_info *)data;
ss->graph_is_active = true;
gtk_widget_grab_focus(w);
- if (cp->sound)
- cp->sound->mini_active = false;
graph_button_press_callback(cp, (void *)ev, (int)(EVENT_X(ev)), (int)(EVENT_Y(ev)), EVENT_STATE(ev), EVENT_BUTTON(ev), EVENT_TIME(ev));
return(false);
}
@@ -677,7 +705,7 @@ static gboolean graph_button_motion(GtkWidget *w, GdkEventMotion *ev, gpointer d
GdkModifierType state;
if (EVENT_IS_HINT(ev))
- gdk_window_get_pointer(EVENT_WINDOW(ev), &x, &y, &state);
+ window_get_pointer(ev, &x, &y, &state);
else
{
x = (int)(EVENT_X(ev));
@@ -702,16 +730,16 @@ static void channel_drag_watcher(GtkWidget *w, const char *filename, int x, int
{
int snd, chn, data;
snd_info *sp;
- chan_info *cp;
- float seconds;
data = get_user_int_data(G_OBJECT(w));
- chn = UNPACK_CHANNEL(data);
- snd = UNPACK_SOUND(data);
+ chn = unpack_channel(data);
+ snd = unpack_sound(data);
sp = ss->sounds[snd];
if (snd_ok(sp))
{
+ chan_info *cp;
+ float seconds;
switch (dtype)
{
case DRAG_ENTER:
@@ -722,12 +750,12 @@ static void channel_drag_watcher(GtkWidget *w, const char *filename, int x, int
seconds = (float)(ungrf_x(cp->axis, x));
if (seconds < 0.0) seconds = 0.0;
if (sp->nchans > 1)
- report_in_minibuffer(sp, "drop to mix file in chan %d at %.4f", cp->chan + 1, seconds);
- else report_in_minibuffer(sp, "drop to mix file at %.4f", seconds);
+ status_report(sp, "drop to mix file in chan %d at %.4f", cp->chan + 1, seconds);
+ else status_report(sp, "drop to mix file at %.4f", seconds);
break;
case DRAG_LEAVE:
- string_to_minibuffer(sp, " "); /* not clear_minibuffer here! => segfault */
+ set_status(sp, " ", false); /* not clear_status_area here! => segfault */
break;
}
}
@@ -746,7 +774,6 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
sp->chans[channel] = make_chan_info(sp->chans[channel], channel, sp);
cp = sp->chans[channel];
- cp->current_hourglass = -1;
if (cp->chan_widgets == NULL)
{
cw = (GtkWidget **)calloc(NUM_CHAN_WIDGETS, sizeof(GtkWidget *));
@@ -766,10 +793,11 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
if (!main)
{
cw[W_main_window] = gtk_hpaned_new();
+ add_paned_style(cw[W_main_window]);
gtk_container_set_border_width(GTK_CONTAINER(cw[W_main_window]), 2);
gtk_box_pack_start(GTK_BOX(w_snd_pane_box(sp)), cw[W_main_window], true, true, 0);
cp->edhist_list = slist_new(cw[W_main_window], NULL, 0, PANED_ADD1);
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(cp->edhist_list->scroller), GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC);
#else
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(cp->edhist_list->scroller), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
@@ -792,9 +820,13 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
cw[W_graph] = gtk_drawing_area_new();
add_drag_and_drop(cw[W_graph], channel_drop_watcher, channel_drag_watcher, NULL);
- set_user_int_data(G_OBJECT(cw[W_graph]), PACK_SOUND_AND_CHANNEL(sp->index, cp->chan));
+ set_user_int_data(G_OBJECT(cw[W_graph]), pack_sound_and_channel(sp->index, cp->chan));
gtk_widget_set_events(cw[W_graph], GDK_ALL_EVENTS_MASK);
SET_CAN_FOCUS(cw[W_graph]);
+
+ widget_set_hexpand(cw[W_graph], true);
+ widget_set_vexpand(cw[W_graph], true);
+
gtk_table_attach(GTK_TABLE(cw[W_graph_window]), cw[W_graph], 2, 3, 0, 2,
(GtkAttachOptions)(GTK_FILL | GTK_EXPAND),
(GtkAttachOptions)(GTK_FILL | GTK_EXPAND | GTK_SHRINK),
@@ -847,6 +879,7 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
if (button_style == WITH_FW_BUTTONS)
{
cw[W_f] = gtk_check_button_new_with_label("f");
+ add_tooltip(cw[W_f], "show fft");
gtk_box_pack_start(GTK_BOX(cw[W_wf_buttons]), cw[W_f], true, true, 0);
gtk_widget_show(cw[W_f]);
gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(cw[W_f]), false);
@@ -854,6 +887,7 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
SG_SIGNAL_CONNECT(cw[W_f], "toggled", f_toggle_click_callback, cp);
cw[W_w] = gtk_check_button_new_with_label("w");
+ add_tooltip(cw[W_f], "show wave");
gtk_box_pack_start(GTK_BOX(cw[W_wf_buttons]), cw[W_w], true, true, 0);
gtk_widget_show(cw[W_w]);
gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(cw[W_w]), true);
@@ -862,25 +896,42 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
}
else
{
+#if GTK_CHECK_VERSION(3, 14, 0)
+ GtkIconTheme *icon_theme;
+ icon_theme = gtk_icon_theme_get_default();
+#endif
cw[W_up_ev] = gtk_event_box_new();
gtk_box_pack_start(GTK_BOX(cw[W_wf_buttons]), cw[W_up_ev], true, true, 0);
gtk_widget_show(cw[W_up_ev]);
+ /* gtk_arrow is deprecated -- docs say: use GtkImage with a suitable icon
+ * but the damned "suitable icon" is specific to some ugly Gnome theme,
+ * so I'll conjure up some "^" and "v" images I guess -- insert flame here.
+ */
+#if GTK_CHECK_VERSION(3, 14, 0)
+ cw[W_f] = gtk_image_new_from_pixbuf(gtk_icon_theme_load_icon(icon_theme, "pan-up-symbolic", 16, (GtkIconLookupFlags)0, NULL));
+#else
cw[W_f] = gtk_arrow_new(GTK_ARROW_UP, GTK_SHADOW_ETCHED_OUT);
- gtk_container_add(GTK_CONTAINER(cw[W_up_ev]), cw[W_f]);
+#endif
+ gtk_container_add(GTK_CONTAINER(cw[W_up_ev]), GTK_WIDGET(cw[W_f]));
gtk_widget_show(cw[W_f]);
cw[W_down_ev] = gtk_event_box_new();
gtk_box_pack_start(GTK_BOX(cw[W_wf_buttons]), cw[W_down_ev], true, true, 0);
gtk_widget_show(cw[W_down_ev]);
+#if GTK_CHECK_VERSION(3, 14, 0)
+ cw[W_w] = gtk_image_new_from_pixbuf(gtk_icon_theme_load_icon(icon_theme, "pan-down-symbolic", 16, (GtkIconLookupFlags)0, NULL));
+#else
cw[W_w] = gtk_arrow_new(GTK_ARROW_DOWN, GTK_SHADOW_ETCHED_OUT);
- gtk_container_add(GTK_CONTAINER(cw[W_down_ev]), cw[W_w]);
+#endif
+ gtk_container_add(GTK_CONTAINER(cw[W_down_ev]), GTK_WIDGET(cw[W_w]));
gtk_widget_show(cw[W_w]);
}
adjs[W_zy_adj] = (GtkAdjustment *)gtk_adjustment_new(0.0, 0.0, 1.1, 0.001, 0.01, .1); /* 0 -> 1 (upside down) */
cw[W_zy] = gtk_vscrollbar_new(GTK_ADJUSTMENT(adjs[W_zy_adj]));
+ widget_set_vexpand(cw[W_zy], true);
gtk_table_attach(GTK_TABLE(cw[W_graph_window]), cw[W_zy], 0, 1, 0, 1,
(GtkAttachOptions)(GTK_FILL),
(GtkAttachOptions)(GTK_EXPAND | GTK_FILL | GTK_SHRINK),
@@ -892,6 +943,7 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
adjs[W_sy_adj] = (GtkAdjustment *)gtk_adjustment_new(0.5, 0.0, 1.01, 0.001, 0.01, .01);
cw[W_sy] = gtk_vscrollbar_new(GTK_ADJUSTMENT(adjs[W_sy_adj]));
+ widget_set_vexpand(cw[W_sy], true);
gtk_table_attach(GTK_TABLE(cw[W_graph_window]), cw[W_sy], 1, 2, 0, 1,
(GtkAttachOptions)(GTK_FILL),
(GtkAttachOptions)(GTK_EXPAND | GTK_FILL | GTK_SHRINK),
@@ -933,6 +985,7 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
cw[W_gsy] = NULL;
cw[W_gzy] = NULL;
}
+
if ((GTK_IS_VPANED(cw[W_main_window])) || (GTK_IS_HPANED(cw[W_main_window])))
gtk_paned_set_position(GTK_PANED(cw[W_main_window]), EDIT_HISTORY_CLOSED);
gtk_widget_show(cw[W_graph_window]);
@@ -957,7 +1010,6 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Gtk
cax->wn = WIDGET_TO_WINDOW(w);
cax->w = w;
}
-
return(0);
}
@@ -1040,8 +1092,12 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
(sp->nchans > 1))
{
channel_style_t old_style;
+ chan_info *selected_cp;
+
+ selected_cp = any_selected_channel(sp); /* chan 0 is none is selected */
old_style = sp->channel_style;
sp->channel_style = new_style;
+
if (new_style != old_style)
{
int i;
@@ -1076,24 +1132,51 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
{
sp->previous_sync = sp->sync;
if (sp->sync == 0) syncb(sp, 1);
- /* set to green ? */
- apply_y_axis_change((sp->chans[0])->axis, sp->chans[0]);
- apply_x_axis_change((sp->chans[0])->axis, sp->chans[0]);
- for (i = 1; i < sp->nchans; i++) CURSOR(sp->chans[i]) = CURSOR(sp->chans[0]);
+
+ apply_y_axis_change(selected_cp);
+ apply_x_axis_change(selected_cp);
+
+ for (i = 0; i < sp->nchans; i++)
+ {
+ if (i != selected_cp->chan)
+ {
+ chan_info *ncp;
+ ncp = sp->chans[i];
+ cursor_sample(ncp) = cursor_sample(selected_cp);
+ if (selected_cp->graph_transform_on != ncp->graph_transform_on)
+ {
+ ncp->graph_transform_on = selected_cp->graph_transform_on;
+ set_toggle_button(channel_f(ncp), selected_cp->graph_transform_on, false, (void *)ncp);
+ }
+ if (selected_cp->graph_time_on != ncp->graph_time_on)
+ {
+ ncp->graph_time_on = selected_cp->graph_time_on;
+ set_toggle_button(channel_w(ncp), selected_cp->graph_time_on, false, (void *)ncp);
+ }
+ }
+ }
}
}
height[0] = widget_height(w_snd_pane(sp)) - control_panel_height(sp);
if (old_style == CHANNELS_SEPARATE)
{
- chan_info *ncp;
- ncp = sp->chans[0];
+ axis_info *ap;
+ ap = selected_cp->axis;
- for (i = 1; i < sp->nchans; i++)
+ for (i = 0; i < sp->nchans; i++)
{
- ncp = sp->chans[i];
- cleanup_cw(ncp);
- fixup_cp_cgx_ax_wn(ncp);
+ if (i != selected_cp->chan)
+ set_axes(sp->chans[i], ap->x0, ap->x1, ap->y0, ap->y1);
+
+ if (i > 0)
+ {
+ chan_info *ncp;
+ ncp = sp->chans[i];
+ cleanup_cw(ncp);
+ ncp->ax->w = channel_to_widget(ncp);
+ ncp->ax->wn = WIDGET_TO_WINDOW(ncp->ax->w);
+ }
}
channel_open_pane(sp->chans[0]);
set_toggle_button(unite_button(sp), true, false, (void *)sp);
@@ -1102,27 +1185,21 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
{
if (new_style == CHANNELS_SEPARATE)
{
- axis_info *ap;
- chan_info* pcp;
- GtkWidget **cw;
/* height[0] = total space available */
height[0] /= sp->nchans;
for_each_sound_chan(sp, channel_open_pane);
/* for (i = 0; i < sp->nchans; i++) reset_mix_graph_parent(sp->chans[i]); */
- pcp = sp->chans[0];
- ap = pcp->axis;
+
for (i = 1; i < sp->nchans; i++)
{
+ GtkWidget **cw;
chan_info *cp;
cp = sp->chans[i];
- fixup_cp_cgx_ax_wn(cp);
+ cp->ax->w = channel_to_widget(cp);
+ cp->ax->wn = WIDGET_TO_WINDOW(cp->ax->w);
cw = cp->chan_widgets;
gtk_widget_show_all(cw[W_main_window]);
- set_toggle_button(cw[W_f], cp->graph_transform_p, false, (void *)cp);
- set_toggle_button(cw[W_w], cp->graph_time_p, false, (void *)cp);
- /* these can get out of sync if changes are made in the unseparated case */
- set_axes(cp, ap->x0, ap->x1, ap->y0, ap->y1);
}
set_toggle_button(unite_button(sp), false, false, (void *)sp);
if (sp->selected_channel > 0) color_selected_channel(sp);
@@ -1137,60 +1214,36 @@ void change_channel_style(snd_info *sp, channel_style_t new_style)
}
-bool fixup_cp_cgx_ax_wn(chan_info *cp)
-{
- GtkWidget *w;
- graphics_context *ax;
- ax = cp->ax;
- w = channel_to_widget(cp);
-
-#if 0
- if ((!(ax->w)) || (!(ax->wn)))
- fprintf(stderr, "set fixup\n");
- else
- {
- if ((ax->wn != WIDGET_TO_WINDOW(w)) ||
- (ax->w != w))
- fprintf(stderr, "reset fixup %p %p, %p %p\n", ax->w, w, ax->wn, WIDGET_TO_WINDOW(w));
- else fprintf(stderr, "redundant fixup\n");
- }
-#endif
-
- ax->wn = WIDGET_TO_WINDOW(w);
- ax->w = w;
- return(ax->wn != NULL);
-}
-
-static XEN g_channel_widgets(XEN snd, XEN chn)
+static Xen g_channel_widgets(Xen snd, Xen chn)
{
- #define H_channel_widgets "(" S_channel_widgets " :optional snd chn): a list of widgets: ((0)graph (1)w (2)f (3)sx (4)sy (5)zx (6)zy (7)\
-edhist (8)gsy (9)gzy (10)main (11)sx_adj (12)sy_adj (13)zx_adj (14)zy_adj (15)gsy_adj (16)gzy_adj"
+ #define H_channel_widgets "(" S_channel_widgets " :optional snd chn): a list of widgets: ((0)graph (1)w (2)f (3)sx (4)sy (5)zx (6)zy\
+(7)edhist (8)gsy (9)gzy (10)main (11)sx_adj (12)sy_adj (13)zx_adj (14)zy_adj (15)gsy_adj (16)gzy_adj)"
- #define XEN_WRAP_ADJ(Value) ((Value) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAdjustment_"), XEN_WRAP_C_POINTER(Value)) : XEN_FALSE)
+ #define Xen_wrap_adj(Value) ((Value) ? Xen_list_2(C_string_to_Xen_symbol("GtkAdjustment_"), Xen_wrap_C_pointer(Value)) : Xen_false)
chan_info *cp;
- ASSERT_CHANNEL(S_channel_widgets, snd, chn, 1);
+ Snd_assert_channel(S_channel_widgets, snd, chn, 1);
cp = get_cp(snd, chn, S_channel_widgets);
- if (!cp) return(XEN_FALSE);
- return(XEN_CONS(XEN_WRAP_WIDGET(channel_graph(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_w(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_f(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_sx(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_sy(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_zx(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_zy(cp)),
- XEN_CONS((EDIT_HISTORY_LIST(cp)) ? XEN_WRAP_WIDGET(EDIT_HISTORY_LIST(cp)->topics) : XEN_FALSE,
- XEN_CONS(XEN_WRAP_WIDGET(channel_gsy(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_gzy(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_main_pane(cp)),
- XEN_CONS(XEN_WRAP_ADJ(sx_adj(cp)),
- XEN_CONS(XEN_WRAP_ADJ(sy_adj(cp)),
- XEN_CONS(XEN_WRAP_ADJ(zx_adj(cp)),
- XEN_CONS(XEN_WRAP_ADJ(zy_adj(cp)),
- XEN_CONS(XEN_WRAP_ADJ(gsy_adj(cp)),
- XEN_CONS(XEN_WRAP_ADJ(gzy_adj(cp)),
- XEN_EMPTY_LIST))))))))))))))))));
+ if (!cp) return(Xen_false);
+ return(Xen_cons(Xen_wrap_widget(channel_graph(cp)),
+ Xen_cons(Xen_wrap_widget(channel_w(cp)),
+ Xen_cons(Xen_wrap_widget(channel_f(cp)),
+ Xen_cons(Xen_wrap_widget(channel_sx(cp)),
+ Xen_cons(Xen_wrap_widget(channel_sy(cp)),
+ Xen_cons(Xen_wrap_widget(channel_zx(cp)),
+ Xen_cons(Xen_wrap_widget(channel_zy(cp)),
+ Xen_cons((EDIT_HISTORY_LIST(cp)) ? Xen_wrap_widget(EDIT_HISTORY_LIST(cp)->topics) : Xen_false,
+ Xen_cons(Xen_wrap_widget(channel_gsy(cp)),
+ Xen_cons(Xen_wrap_widget(channel_gzy(cp)),
+ Xen_cons(Xen_wrap_widget(channel_main_pane(cp)),
+ Xen_cons(Xen_wrap_adj(sx_adj(cp)),
+ Xen_cons(Xen_wrap_adj(sy_adj(cp)),
+ Xen_cons(Xen_wrap_adj(zx_adj(cp)),
+ Xen_cons(Xen_wrap_adj(zy_adj(cp)),
+ Xen_cons(Xen_wrap_adj(gsy_adj(cp)),
+ Xen_cons(Xen_wrap_adj(gzy_adj(cp)),
+ Xen_empty_list))))))))))))))))));
}
@@ -1200,36 +1253,37 @@ static gint timed_eval(gpointer in_code)
{
#if HAVE_EXTENSION_LANGUAGE
/* #if needed on 64-bit machines */
- XEN lst = (XEN)in_code;
- XEN_CALL_0(XEN_CADR(lst), "timed callback func");
- snd_unprotect_at(XEN_TO_C_INT(XEN_CAR(lst)));
+ Xen lst = (Xen)in_code;
+ Xen_call_with_no_args(Xen_cadr(lst), "timed callback func");
+ snd_unprotect_at(Xen_integer_to_C_int(Xen_car(lst)));
#endif
return(0);
}
-static XEN g_in(XEN ms, XEN code)
+static Xen g_in(Xen ms, Xen code)
{
#define H_in "(" S_in " msecs thunk): invoke thunk in msecs milliseconds (named call_in in Ruby)"
#if HAVE_EXTENSION_LANGUAGE
- XEN_ASSERT_TYPE(XEN_NUMBER_P(ms), ms, XEN_ARG_1, S_in, "a number");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(code), code, XEN_ARG_2, S_in, "a procedure");
- if (XEN_REQUIRED_ARGS_OK(code, 0))
+ Xen_check_type(Xen_is_number(ms), ms, 1, S_in, "a number");
+ Xen_check_type(Xen_is_procedure(code), code, 2, S_in, "a procedure");
+ if (Xen_is_aritable(code, 0))
{
int secs;
- secs = XEN_TO_C_INT(ms);
+ Xen_check_type(Xen_is_integer(ms), ms, 3, S_in, "an integer");
+ secs = Xen_integer_to_C_int(ms);
if (secs < 0)
- XEN_OUT_OF_RANGE_ERROR(S_in, XEN_ARG_1, ms, "a positive integer");
+ Xen_out_of_range_error(S_in, 1, ms, "a positive integer");
else
{
- XEN lst;
- lst = XEN_LIST_2(XEN_FALSE, code);
- XEN_LIST_SET(lst, 0, C_TO_XEN_INT(snd_protect(lst)));
+ Xen lst;
+ lst = Xen_list_2(Xen_false, code);
+ Xen_list_set(lst, 0, C_int_to_Xen_integer(snd_protect(lst)));
g_timeout_add_full(0, (guint32)secs, timed_eval, (gpointer)lst, NULL);
}
}
- else XEN_BAD_ARITY_ERROR(S_in, 2, code, "should take no args");
+ else Xen_bad_arity_error(S_in, 2, code, "should take no args");
#endif
return(ms);
@@ -1257,6 +1311,7 @@ void color_unselected_graphs(color_t color)
void color_chan_components(color_t color, slider_choice_t which_component)
{
+#if (!GTK_CHECK_VERSION(3, 0, 0))
int i;
for (i = 0; i < ss->max_sounds; i++)
{
@@ -1272,6 +1327,9 @@ void color_chan_components(color_t color, slider_choice_t which_component)
{
if (which_component == COLOR_POSITION)
{
+ /* in gtk3 this sets the slider color when dragged, and it looks bad
+ * in gtk2 it sets the background (the trough, not the slider)
+ */
widget_modify_bg(channel_sx(cp), GTK_STATE_ACTIVE, color);
widget_modify_bg(channel_sy(cp), GTK_STATE_ACTIVE, color);
}
@@ -1283,60 +1341,57 @@ void color_chan_components(color_t color, slider_choice_t which_component)
}
}
}
+#endif
}
-static XEN g_graph_cursor(void)
+static Xen g_graph_cursor(void)
{
#define H_graph_cursor "(" S_graph_cursor "): current graph cursor shape"
- return(C_TO_XEN_INT(in_graph_cursor(ss)));
+ return(C_int_to_Xen_integer(in_graph_cursor(ss)));
}
-static XEN g_set_graph_cursor(XEN curs)
+static Xen g_set_graph_cursor(Xen curs)
{
int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(curs), curs, XEN_ONLY_ARG, S_setB S_graph_cursor, "an integer");
- val = XEN_TO_C_INT(curs);
+ Xen_check_type(Xen_is_integer(curs), curs, 1, S_set S_graph_cursor, "an integer");
+ val = Xen_integer_to_C_int(curs);
if ((val >= 0) && ((val & 1) == 0) && (val <= GDK_XTERM)) /* these are even numbers up to about 152 (gdkcursor.h) */
{
ss->Graph_Cursor = val;
- ss->graph_cursor = gdk_cursor_new((GdkCursorType)in_graph_cursor(ss));
+ ss->graph_cursor = GDK_CURSOR_NEW((GdkCursorType)in_graph_cursor(ss));
/* the gtk examples ignore g_object_ref|unref in this regard, so I will also */
}
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_graph_cursor, 1, curs, "~A: invalid cursor");
+ else Xen_out_of_range_error(S_set S_graph_cursor, 1, curs, "invalid cursor");
return(curs);
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_2(g_in_w, g_in)
-XEN_NARGIFY_0(g_graph_cursor_w, g_graph_cursor)
-XEN_NARGIFY_1(g_set_graph_cursor_w, g_set_graph_cursor)
-XEN_ARGIFY_2(g_channel_widgets_w, g_channel_widgets)
-#else
-#define g_in_w g_in
-#define g_graph_cursor_w g_graph_cursor
-#define g_set_graph_cursor_w g_set_graph_cursor
-#define g_channel_widgets_w g_channel_widgets
-#endif
+Xen_wrap_2_args(g_in_w, g_in)
+Xen_wrap_no_args(g_graph_cursor_w, g_graph_cursor)
+Xen_wrap_1_arg(g_set_graph_cursor_w, g_set_graph_cursor)
+Xen_wrap_2_optional_args(g_channel_widgets_w, g_channel_widgets)
+#if HAVE_SCHEME
+static s7_pointer acc_graph_cursor(s7_scheme *sc, s7_pointer args) {return(g_set_graph_cursor(s7_cadr(args)));}
+#endif
void g_init_gxchn(void)
{
- XEN_DEFINE_PROCEDURE(S_in, g_in_w, 2, 0, 0, H_in);
+ Xen_define_procedure(S_in, g_in_w, 2, 0, 0, H_in);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_graph_cursor, g_graph_cursor_w, H_graph_cursor,
- S_setB S_graph_cursor, g_set_graph_cursor_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_graph_cursor, g_graph_cursor_w, H_graph_cursor,
+ S_set S_graph_cursor, g_set_graph_cursor_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE(S_channel_widgets, g_channel_widgets_w, 0, 2, 0, H_channel_widgets);
+ Xen_define_procedure(S_channel_widgets, g_channel_widgets_w, 0, 2, 0, H_channel_widgets);
#if HAVE_SCHEME
#define H_mouse_enter_graph_hook S_mouse_enter_graph_hook " (snd chn): called when the mouse \
enters the drawing area (graph pane) of the given channel.\n\
- (add-hook! " S_mouse_enter_graph_hook "\n\
- (lambda (snd chn)\n\
- (" S_focus_widget " (car (" S_channel_widgets " snd chn)))))"
+ (hook-push " S_mouse_enter_graph_hook "\n\
+ (lambda (hook)\n\
+ (" S_focus_widget " (car (" S_channel_widgets " (hook 'snd) (hook 'chn))))))"
#define H_mouse_leave_graph_hook S_mouse_leave_graph_hook " (snd chn): called when the mouse \
leaves the drawing area (graph pane) of the given channel."
@@ -1364,6 +1419,16 @@ enters the drawing area (graph pane) of the given channel.\n\
leaves the drawing area (graph pane) of the given channel."
#endif
- mouse_enter_graph_hook = XEN_DEFINE_HOOK(S_mouse_enter_graph_hook, 2, H_mouse_enter_graph_hook); /* args = snd chn */
- mouse_leave_graph_hook = XEN_DEFINE_HOOK(S_mouse_leave_graph_hook, 2, H_mouse_leave_graph_hook); /* args = snd chn */
+ mouse_enter_graph_hook = Xen_define_hook(S_mouse_enter_graph_hook, "(make-hook 'snd 'chn)", 2, H_mouse_enter_graph_hook);
+ mouse_leave_graph_hook = Xen_define_hook(S_mouse_leave_graph_hook, "(make-hook 'snd 'chn)", 2, H_mouse_leave_graph_hook);
+
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->graph_cursor_symbol, s7_make_function(s7, "[acc-" S_graph_cursor "]", acc_graph_cursor, 2, 0, false, "accessor"));
+ s7_symbol_set_documentation(s7, ss->graph_cursor_symbol, "*graph-cursor*: current graph cursor shape");
+#endif
}
+
+/* apparently in gtk 3.8.n the sliders are invisible until you try to move them.
+ * I can't find any info about this, and can't find any way to fix it.
+ * Nothing works.
+ */
diff --git a/snd-gdraw.c b/snd-gdraw.c
index b02d5b5..279999e 100644
--- a/snd-gdraw.c
+++ b/snd-gdraw.c
@@ -4,7 +4,11 @@
void draw_line(graphics_context *ax, int x0, int y0, int x1, int y1)
{
cairo_set_source_rgba(ss->cr, ax->gc->fg_color->red, ax->gc->fg_color->green, ax->gc->fg_color->blue, ax->gc->fg_color->alpha);
- cairo_set_line_width(ss->cr, 1.0);
+ if (ss->line_width != 1.0)
+ {
+ cairo_set_line_width(ss->cr, 1.0);
+ ss->line_width = 1.0;
+ }
/* to get a thin line in cairo -- hooboy! you have to offset everything -- this is not pretty
* if line_width < 1.0, you get a smudgy mess in gray-scale!!
*/
@@ -20,7 +24,11 @@ void draw_lines(graphics_context *ax, point_t *points, int num)
{
int i;
cairo_set_source_rgba(ss->cr, ax->gc->fg_color->red, ax->gc->fg_color->green, ax->gc->fg_color->blue, ax->gc->fg_color->alpha);
- cairo_set_line_width(ss->cr, 1.0);
+ if (ss->line_width != 1.0)
+ {
+ cairo_set_line_width(ss->cr, 1.0);
+ ss->line_width = 1.0;
+ }
cairo_move_to(ss->cr, points[0].x + 0.5, points[0].y + 0.5);
for (i = 1; i < num; i++)
cairo_line_to(ss->cr, points[i].x + 0.5, points[i].y + 0.5);
@@ -75,9 +83,9 @@ void fill_rectangle(graphics_context *ax, int x0, int y0, int width, int height)
else
{
mus_float_t grad;
+ cairo_pattern_t *pat;
grad = ss->bg_gradient;
/* try gradient background: looks ok, but display is slow */
- cairo_pattern_t *pat;
/* this is shaded toward the right
pat = cairo_pattern_create_linear(0, 0, width, height);
*/
@@ -114,9 +122,10 @@ void erase_rectangle(chan_info *cp, graphics_context *ax, int x0, int y0, int wi
else
{
mus_float_t grad;
+ cairo_pattern_t *pat;
+
grad = ss->bg_gradient;
/* try gradient background: looks ok, but display is slow */
- cairo_pattern_t *pat;
/* this is shaded toward the right
pat = cairo_pattern_create_linear(0, 0, width, height);
*/
@@ -187,46 +196,44 @@ void draw_rotated_axis_label(chan_info *cp, graphics_context *ax, const char *te
rotate_text(ax, AXIS_LABEL_FONT(ss), text, 90, x0, y0);
}
+#if GTK_CHECK_VERSION(3, 0, 0)
+ #define IS_DRAWABLE(Widget) GDK_IS_WINDOW(Widget)
+#else
+ #define IS_DRAWABLE(Widget) GDK_IS_DRAWABLE(Widget)
+#endif
void draw_picture(graphics_context *ax, picture_t *src, gint xsrc, gint ysrc, gint xdest, gint ydest, gint width, gint height)
{
if ((ax) && (IS_DRAWABLE(ax->wn)))
{
cairo_t *cr;
- cr = MAKE_CAIRO(ax->wn);
+ cr = make_cairo(ax->wn);
cairo_set_source_surface(cr, src, xsrc + xdest, ysrc + ydest);
cairo_paint(cr);
- FREE_CAIRO(cr);
+ free_cairo(cr);
}
}
static void draw_polygon_va(graphics_context *ax, bool filled, int points, va_list ap)
{
- int i;
- {
- int x, y;
- x = va_arg(ap, int);
- y = va_arg(ap, int);
- cairo_set_source_rgba(ss->cr, ax->gc->fg_color->red, ax->gc->fg_color->green, ax->gc->fg_color->blue, ax->gc->fg_color->alpha);
- /* cairo_set_line_width(ss->cr, 1.0); */
- cairo_move_to(ss->cr, x, y);
- for (i = 1; i < points; i++)
- {
- x = va_arg(ap, int);
- y = va_arg(ap, int);
- cairo_line_to(ss->cr, x, y);
- }
- if (filled)
- {
- cairo_close_path(ss->cr);
- cairo_fill(ss->cr);
- }
- else
- {
- cairo_stroke(ss->cr);
- }
- }
+ int i, x, y;
+ x = va_arg(ap, int);
+ y = va_arg(ap, int);
+ cairo_set_source_rgba(ss->cr, ax->gc->fg_color->red, ax->gc->fg_color->green, ax->gc->fg_color->blue, ax->gc->fg_color->alpha);
+ cairo_move_to(ss->cr, x, y);
+ for (i = 1; i < points; i++)
+ {
+ x = va_arg(ap, int);
+ y = va_arg(ap, int);
+ cairo_line_to(ss->cr, x, y);
+ }
+ if (filled)
+ {
+ cairo_close_path(ss->cr);
+ cairo_fill(ss->cr);
+ }
+ else cairo_stroke(ss->cr);
}
@@ -244,7 +251,6 @@ void fill_polygon_from_array(graphics_context *ax, point_t *points, int npoints)
{
int i;
cairo_set_source_rgba(ss->cr, ax->gc->fg_color->red, ax->gc->fg_color->green, ax->gc->fg_color->blue, ax->gc->fg_color->alpha);
- /* cairo_set_line_width(ss->cr, 1.0); */
cairo_move_to(ss->cr, points[0].x, points[0].y);
for (i = 1; i < npoints; i++)
cairo_line_to(ss->cr, points[i].x, points[i].y);
@@ -294,8 +300,6 @@ void fill_two_sided_polygons(graphics_context *ax, point_t *points, point_t *poi
void setup_graphics_context(chan_info *cp, graphics_context *ax)
{
GtkWidget *w;
- snd_info *sp;
- sp = cp->sound;
w = channel_to_widget(cp);
ax->gc = copy_GC(cp);
ax->wn = WIDGET_TO_WINDOW(w);
@@ -314,9 +318,9 @@ static GdkRectangle **sono_data = NULL;
void check_colormap_sizes(int size)
{
- int i, old_size;
if ((sono_data) && (sono_colors < size) && (sono_bins > 0))
{
+ int i, old_size;
old_size = sono_colors;
sono_colors = size;
sono_data = (GdkRectangle **)realloc(sono_data, sono_colors * sizeof(GdkRectangle *));
@@ -357,7 +361,11 @@ void draw_spectro_line(graphics_context *ax, int color, int x0, int y0, int x1,
rgb_t r, g,b;
get_current_color(color_map(ss), color, &r, &g, &b);
cairo_set_source_rgb(ss->cr, r, g, b);
- cairo_set_line_width(ss->cr, 1.0);
+ if (ss->line_width != 1.0)
+ {
+ cairo_set_line_width(ss->cr, 1.0);
+ ss->line_width = 1.0;
+ }
cairo_move_to(ss->cr, x0 + 0.5, y0 + 0.5);
cairo_line_to(ss->cr, x1 + 0.5, y1 + 0.5);
cairo_stroke(ss->cr);
@@ -402,7 +410,7 @@ void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, in
* colors are 0..colormap_size: colors[k] = (int)((fft_phases[k] * color_map_size(ss)) / (2.0 * M_PI))
*/
- int i, x0, y0, x1, y1, cur, prev;
+ int i, x0, y0, cur, prev;
color_t old_color;
rgb_t r, g, b;
@@ -429,6 +437,7 @@ void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, in
for (i = 1; i < num; i++)
{
+ int x1, y1;
x1 = points[i].x;
y1 = points[i].y;
if ((abs(y0 - axis_y0) < 5) &&
@@ -461,7 +470,11 @@ void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, in
}
else
{
- cairo_set_line_width(ss->cr, 1.0);
+ if (ss->line_width != 1.0)
+ {
+ cairo_set_line_width(ss->cr, 1.0);
+ ss->line_width = 1.0;
+ }
cairo_move_to(ss->cr, x0 + 0.5, y0 + 0.5);
cairo_line_to(ss->cr, x1 + 0.5, y1 + 0.5);
cairo_stroke(ss->cr);
@@ -480,7 +493,7 @@ void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, in
/* -------- color browser -------- */
-static XEN color_hook;
+static Xen color_hook;
static GtkWidget *ccd_dialog = NULL, *ccd_scale, *ccd_invert, *ccd_cutoff;
static GtkAdjustment *ccd_scale_adj, *ccd_cutoff_adj;
static slist *ccd_list;
@@ -488,8 +501,8 @@ static slist *ccd_list;
static void check_color_hook(void)
{
- if (XEN_HOOKED(color_hook))
- run_hook(color_hook, XEN_EMPTY_LIST, S_color_hook);
+ if (Xen_hook_has_list(color_hook))
+ run_hook(color_hook, Xen_empty_list, S_color_hook);
}
@@ -508,6 +521,23 @@ static void invert_color_callback(GtkWidget *w, gpointer context)
}
+#if HAVE_GL
+static GtkWidget *gl_button = NULL;
+static void with_gl_callback(GtkWidget *w, gpointer context)
+{
+ sgl_save_currents();
+ in_set_with_gl(TOGGLE_BUTTON_ACTIVE(w));
+ sgl_set_currents(true);
+ for_each_chan(update_graph);
+}
+#endif
+
+void set_with_gl(bool val, bool with_dialogs)
+{
+ in_set_with_gl(val);
+}
+
+
void set_color_inverted(bool val)
{
in_set_color_inverted(val);
@@ -571,18 +601,25 @@ void set_color_map(int val)
}
+#define CUTOFF_BASE 2.5
static void cutoff_color_callback(GtkAdjustment *adj, gpointer context)
{
- in_set_color_cutoff(ADJUSTMENT_VALUE(adj));
+ in_set_color_cutoff(pow(ADJUSTMENT_VALUE(adj), CUTOFF_BASE));
check_color_hook();
for_each_chan(update_graph_setting_fft_changed);
}
+static gchar* scale_pow_double_format_callback(GtkScale *w, gdouble val, gpointer data)
+{
+ return(g_strdup_printf(" %.*f ", gtk_scale_get_digits(w), pow(val, CUTOFF_BASE))); /* not %g! */
+}
+
+
void set_color_cutoff(mus_float_t val)
{
in_set_color_cutoff(val);
- if (ccd_dialog) ADJUSTMENT_SET_VALUE(ccd_cutoff_adj, val);
+ if (ccd_dialog) ADJUSTMENT_SET_VALUE(ccd_cutoff_adj, pow(val, 1.0 / CUTOFF_BASE));
check_color_hook();
if (!(ss->graph_hook_active)) for_each_chan(update_graph_setting_fft_changed);
}
@@ -622,15 +659,15 @@ void reflect_color_list(bool setup_time)
/* -------- orientation browser -------- */
-static XEN orientation_hook;
+static Xen orientation_hook;
static void check_orientation_hook(void)
{
- run_hook(orientation_hook, XEN_EMPTY_LIST, S_orientation_hook);
+ run_hook(orientation_hook, Xen_empty_list, S_orientation_hook);
}
-static GtkWidget *oid_dialog = NULL, *oid_ax, *oid_ay, *oid_az, *oid_sx, *oid_sy, *oid_sz, *oid_hop;
+static GtkWidget *oid_ax, *oid_ay, *oid_az, *oid_sx, *oid_sy, *oid_sz, *oid_hop;
static GtkAdjustment *oid_ax_adj, *oid_az_adj, *oid_ay_adj, *oid_sx_adj, *oid_sz_adj, *oid_sy_adj, *oid_hop_adj;
static void ax_orientation_callback(GtkAdjustment *adj, gpointer context)
@@ -645,7 +682,7 @@ static void ax_orientation_callback(GtkAdjustment *adj, gpointer context)
void set_spectro_x_angle(mus_float_t val)
{
in_set_spectro_x_angle(val);
- if (oid_dialog) ADJUSTMENT_SET_VALUE(oid_ax_adj, val);
+ if (ccd_dialog) ADJUSTMENT_SET_VALUE(oid_ax_adj, val);
chans_field(FCP_X_ANGLE, val);
check_orientation_hook();
if (!(ss->graph_hook_active)) for_each_chan(update_graph);
@@ -664,7 +701,7 @@ static void ay_orientation_callback(GtkAdjustment *adj, gpointer context)
void set_spectro_y_angle(mus_float_t val)
{
in_set_spectro_y_angle(val);
- if (oid_dialog) ADJUSTMENT_SET_VALUE(oid_ay_adj, val);
+ if (ccd_dialog) ADJUSTMENT_SET_VALUE(oid_ay_adj, val);
chans_field(FCP_Y_ANGLE, val);
check_orientation_hook();
if (!(ss->graph_hook_active)) for_each_chan(update_graph);
@@ -683,7 +720,7 @@ static void az_orientation_callback(GtkAdjustment *adj, gpointer context)
void set_spectro_z_angle(mus_float_t val)
{
in_set_spectro_z_angle(val);
- if (oid_dialog) ADJUSTMENT_SET_VALUE(oid_az_adj, val);
+ if (ccd_dialog) ADJUSTMENT_SET_VALUE(oid_az_adj, val);
chans_field(FCP_Z_ANGLE, val);
check_orientation_hook();
if (!(ss->graph_hook_active)) for_each_chan(update_graph);
@@ -702,7 +739,7 @@ static void sx_orientation_callback(GtkAdjustment *adj, gpointer context)
void set_spectro_x_scale(mus_float_t val)
{
in_set_spectro_x_scale(val);
- if (oid_dialog) ADJUSTMENT_SET_VALUE(oid_sx_adj, val);
+ if (ccd_dialog) ADJUSTMENT_SET_VALUE(oid_sx_adj, val);
chans_field(FCP_X_SCALE, val);
check_orientation_hook();
if (!(ss->graph_hook_active)) for_each_chan(update_graph);
@@ -721,7 +758,7 @@ static void sy_orientation_callback(GtkAdjustment *adj, gpointer context)
void set_spectro_y_scale(mus_float_t val)
{
in_set_spectro_y_scale(val);
- if (oid_dialog) ADJUSTMENT_SET_VALUE(oid_sy_adj, val);
+ if (ccd_dialog) ADJUSTMENT_SET_VALUE(oid_sy_adj, val);
chans_field(FCP_Y_SCALE, val);
check_orientation_hook();
if (!(ss->graph_hook_active)) for_each_chan(update_graph);
@@ -740,7 +777,7 @@ static void sz_orientation_callback(GtkAdjustment *adj, gpointer context)
void set_spectro_z_scale(mus_float_t val)
{
in_set_spectro_z_scale(val);
- if (oid_dialog) ADJUSTMENT_SET_VALUE(oid_sz_adj, val);
+ if (ccd_dialog) ADJUSTMENT_SET_VALUE(oid_sz_adj, val);
chans_field(FCP_Z_SCALE, val);
check_orientation_hook();
if (!(ss->graph_hook_active)) for_each_chan(update_graph);
@@ -764,7 +801,7 @@ static void hop_callback(GtkAdjustment *adj, gpointer context)
}
-gchar* scale_int_format_callback(GtkScale *w, gdouble val, gpointer data)
+static gchar* scale_int_format_callback(GtkScale *w, gdouble val, gpointer data)
{
/* gtk_scale_get_digits(w) here will be 0 (set below), so we want ints
* this is needed since the value-spacing style property apparently does not put space between the value and the scale
@@ -783,7 +820,7 @@ void set_spectro_hop(int val)
if (val > 0)
{
in_set_spectro_hop(val);
- if (oid_dialog) ADJUSTMENT_SET_VALUE(oid_hop_adj, val);
+ if (ccd_dialog) ADJUSTMENT_SET_VALUE(oid_hop_adj, val);
for_each_chan_with_int(chans_spectro_hop, val);
check_orientation_hook();
if (!(ss->graph_hook_active)) for_each_chan(update_graph);
@@ -809,9 +846,7 @@ void reflect_spectro(void)
set_toggle_button(ccd_invert, color_inverted(ss), false, NULL);
ADJUSTMENT_SET_VALUE(ccd_cutoff_adj, color_cutoff(ss));
reflect_color_scale(color_scale(ss));
- }
- if (oid_dialog)
- {
+
ADJUSTMENT_SET_VALUE(oid_ax_adj, fixup_angle(spectro_x_angle(ss)));
ADJUSTMENT_SET_VALUE(oid_ay_adj, fixup_angle(spectro_y_angle(ss)));
ADJUSTMENT_SET_VALUE(oid_az_adj, fixup_angle(spectro_z_angle(ss)));
@@ -827,21 +862,20 @@ void reflect_spectro(void)
static void reset_color_orientation_callback(GtkWidget *w, gpointer context)
{
/* put everything back the way it was at the start */
+ set_color_cutoff(DEFAULT_COLOR_CUTOFF);
+ set_color_inverted(DEFAULT_COLOR_INVERTED);
+ set_color_scale(DEFAULT_COLOR_SCALE);
+ set_color_map(DEFAULT_COLOR_MAP);
+
reset_spectro();
reflect_spectro();
for_each_chan(update_graph);
}
-void set_with_gl(bool val, bool with_dialogs)
-{
- in_set_with_gl(val);
-}
-
-
void view_color_orientation_callback(GtkWidget *w, gpointer context)
{
- start_color_orientation_dialog(true);
+ make_color_orientation_dialog(true);
}
@@ -851,22 +885,29 @@ bool color_orientation_dialog_is_active(void)
}
-GtkWidget *start_color_orientation_dialog(bool managed)
+GtkWidget *make_color_orientation_dialog(bool managed)
{
if (!ccd_dialog)
{
GtkWidget *light_label, *dark_label, *help_button, *dismiss_button, *reset_button;
- GtkWidget *outer_table, *scale_box, *cutoff_box, *cutoff_label;
- GtkWidget *color_frame, *color_label, *mainbox, *colorbox;
+ GtkWidget *scale_box, *cutoff_box, *cutoff_label;
+ GtkWidget *color_label, *mainbox, *colorbox, *map_box;
GtkWidget *shbox;
GtkWidget *ax_box, *ay_box, *az_box, *sx_box, *sy_box, *sz_box, *hop_box;
GtkWidget *ax_label, *ay_label, *az_label, *sx_label, *sy_label, *sz_label, *hop_label;
- GtkWidget *orient_frame, *orient_label, *orientbox;
+ GtkWidget *orient_label, *orientbox;
GtkWidget *sep1, *sep2, *sep3, *sep5;
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ GtkWidget *orient_frame, *color_frame;
+#endif
+
ccd_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(ccd_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
SG_SIGNAL_CONNECT(ccd_dialog, "delete_event", delete_color_orientation_dialog, NULL);
gtk_window_set_title(GTK_WINDOW(ccd_dialog), "Color");
sg_make_resizable(ccd_dialog);
@@ -874,19 +915,17 @@ GtkWidget *start_color_orientation_dialog(bool managed)
gtk_widget_realize(ccd_dialog);
gtk_window_resize(GTK_WINDOW(ccd_dialog), 400, 200);
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
+ help_button = gtk_dialog_add_button(GTK_DIALOG(ccd_dialog), "Help", GTK_RESPONSE_NONE);
+ reset_button = gtk_dialog_add_button(GTK_DIALOG(ccd_dialog), "Revert", GTK_RESPONSE_NONE);
+ dismiss_button = gtk_dialog_add_button(GTK_DIALOG(ccd_dialog), "Go away", GTK_RESPONSE_NONE);
- dismiss_button = gtk_button_new_from_stock(GTK_STOCK_QUIT);
+ gtk_widget_set_name(help_button, "dialog_button");
gtk_widget_set_name(dismiss_button, "dialog_button");
- set_stock_button_label(dismiss_button, "Go Away");
-
- reset_button = gtk_button_new_from_stock(GTK_STOCK_REVERT_TO_SAVED);
gtk_widget_set_name(reset_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(ccd_dialog)), dismiss_button, false, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(ccd_dialog)), reset_button, false, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(ccd_dialog)), help_button, false, true, 10);
+ add_highlight_button_style(dismiss_button);
+ add_highlight_button_style(reset_button);
+ add_highlight_button_style(help_button);
SG_SIGNAL_CONNECT(dismiss_button, "clicked", dismiss_color_orientation_callback, NULL);
SG_SIGNAL_CONNECT(help_button, "clicked", help_color_orientation_callback, NULL);
@@ -900,29 +939,86 @@ GtkWidget *start_color_orientation_dialog(bool managed)
gtk_container_add(GTK_CONTAINER(DIALOG_CONTENT_AREA(ccd_dialog)), mainbox);
gtk_widget_show(mainbox);
-
+#if (!GTK_CHECK_VERSION(3, 0, 0))
color_frame = gtk_frame_new(NULL);
gtk_box_pack_start(GTK_BOX(mainbox), color_frame, false, false, 10);
gtk_frame_set_shadow_type(GTK_FRAME(color_frame), GTK_SHADOW_ETCHED_IN);
+ widget_set_vexpand(color_frame, true);
gtk_widget_show(color_frame);
+#endif
colorbox = gtk_vbox_new(false, 2);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ gtk_box_pack_start(GTK_BOX(mainbox), colorbox, false, false, 10);
+#else
gtk_container_add(GTK_CONTAINER(color_frame), colorbox);
+#endif
+ widget_set_vexpand(colorbox, true);
gtk_widget_show(colorbox);
color_label = snd_gtk_highlight_label_new("colors");
gtk_box_pack_start(GTK_BOX(colorbox), color_label, false, false, 0);
gtk_widget_show(color_label);
- outer_table = gtk_table_new(3, 5, true); /* this seems backwards! */
- gtk_box_pack_end(GTK_BOX(colorbox), outer_table, false, false, 4);
- gtk_widget_show(outer_table);
+ /* invert colormap
+ * light -> dark
+ * cutoff
+ * if gl, use gl button
+ */
+
+ map_box = gtk_hbox_new(false, 4);
+ widget_set_vexpand(map_box, true);
+ widget_set_margin_left(map_box, 8);
+ gtk_box_pack_start(GTK_BOX(colorbox), map_box, true, true, 8);
+ gtk_widget_show(map_box);
+
+ {
+ char **names;
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ GtkWidget *frame;
+#endif
+ int i, size;
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ frame = gtk_frame_new(NULL);
+ gtk_container_set_border_width(GTK_CONTAINER(frame), 0);
+ gtk_frame_set_shadow_type(GTK_FRAME(frame), GTK_SHADOW_ETCHED_IN);
+ widget_modify_bg(frame, GTK_STATE_NORMAL, ss->zoom_color);
+ gtk_box_pack_start(GTK_BOX(map_box), frame, true, true, 0);
+ widget_set_hexpand(frame, true);
+ widget_set_vexpand(frame, true);
+ gtk_widget_show(frame);
+#endif
+
+ size = num_colormaps();
+ names = (char **)calloc(size, sizeof(char *));
+ for (i = 0; i < size; i++) names[i] = colormap_name(i);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ ccd_list = slist_new_with_title(S_colormap, map_box, (const char**)names, size, BOX_PACK);
+#else
+ ccd_list = slist_new_with_title(S_colormap, frame, (const char**)names, size, CONTAINER_ADD);
+#endif
+ ccd_list->select_callback = list_color_callback;
+ widget_set_vexpand(ccd_list->box, true);
+ free(names);
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ gtk_scrolled_window_set_min_content_height(GTK_SCROLLED_WINDOW(ccd_list->scroller), 140);
+#endif
+ }
+
+ ccd_invert = gtk_check_button_new_with_label("invert");
+ SG_SIGNAL_CONNECT(ccd_invert, "toggled", invert_color_callback, NULL);
+ gtk_box_pack_start(GTK_BOX(map_box), ccd_invert, false, false, 12);
+ gtk_widget_show(ccd_invert);
+ set_toggle_button(ccd_invert, color_inverted(ss), false, NULL);
+
+
scale_box = gtk_vbox_new(false, 0);
- gtk_table_attach(GTK_TABLE(outer_table), scale_box, 0, 3, 0, 1,
- (GtkAttachOptions)(GTK_FILL | GTK_EXPAND),
- (GtkAttachOptions)(GTK_FILL | GTK_EXPAND | GTK_SHRINK),
- 10, 0);
+ widget_set_margin_left(scale_box, 8);
+ widget_set_margin_right(scale_box, 8);
+ gtk_box_pack_start(GTK_BOX(colorbox), scale_box, false, false, 0);
gtk_widget_show(scale_box);
ccd_scale_adj = (GtkAdjustment *)gtk_adjustment_new(50.0, 0.0, 101.0, 0.1, 1.0, 1.0);
@@ -937,48 +1033,33 @@ GtkWidget *start_color_orientation_dialog(bool managed)
SG_SIGNAL_CONNECT(ccd_scale, "format-value", scale_int_format_callback, NULL);
gtk_widget_show(ccd_scale);
- shbox = gtk_hbox_new(false, 0);
+ shbox = gtk_hbox_new(false, 10);
gtk_box_pack_start(GTK_BOX(scale_box), shbox, true, true, 0);
gtk_widget_show(shbox);
light_label = gtk_label_new("light");
- gtk_misc_set_alignment(GTK_MISC (light_label), 0.05, 0.0);
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_widget_set_halign(GTK_WIDGET(light_label), GTK_ALIGN_START);
+#else
+ gtk_misc_set_alignment(GTK_MISC(light_label), 0.05, 0.0);
+#endif
gtk_box_pack_start(GTK_BOX(shbox), light_label, false, false, 0);
gtk_widget_show(light_label);
dark_label = gtk_label_new("dark");
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_widget_set_halign(GTK_WIDGET(dark_label), GTK_ALIGN_END);
+#else
gtk_misc_set_alignment(GTK_MISC(dark_label), 0.95, 0.0);
+#endif
gtk_box_pack_end(GTK_BOX(shbox), dark_label, false, false, 0);
gtk_widget_show(dark_label);
- {
- char **names;
- GtkWidget *frame;
- int i, size;
-
- frame = gtk_frame_new(NULL);
- gtk_container_set_border_width(GTK_CONTAINER(frame), 0);
- gtk_frame_set_shadow_type(GTK_FRAME(frame), GTK_SHADOW_ETCHED_IN);
- widget_modify_bg(frame, GTK_STATE_NORMAL, ss->zoom_color);
- gtk_table_attach(GTK_TABLE(outer_table), frame, 3, 5, 0, 3,
- (GtkAttachOptions)(GTK_FILL | GTK_EXPAND),
- (GtkAttachOptions)(GTK_FILL | GTK_EXPAND | GTK_SHRINK),
- 4, 4);
- gtk_widget_show(frame);
-
- size = num_colormaps();
- names = (char **)calloc(size, sizeof(char *));
- for (i = 0; i < size; i++) names[i] = colormap_name(i);
- ccd_list = slist_new_with_title(S_colormap, frame, (const char**)names, size, CONTAINER_ADD);
- ccd_list->select_callback = list_color_callback;
- free(names);
- }
cutoff_box = gtk_hbox_new(false, 0);
- gtk_table_attach(GTK_TABLE(outer_table), cutoff_box, 0, 3, 1, 2,
- (GtkAttachOptions)(GTK_FILL | GTK_EXPAND),
- (GtkAttachOptions)(GTK_FILL | GTK_EXPAND | GTK_SHRINK),
- 0, 0);
+ widget_set_margin_left(cutoff_box, 8);
+ widget_set_margin_right(cutoff_box, 8);
+ gtk_box_pack_start(GTK_BOX(colorbox), cutoff_box, false, false, 8);
gtk_widget_show(cutoff_box);
cutoff_label = gtk_label_new("data cutoff:");
@@ -989,41 +1070,55 @@ GtkWidget *start_color_orientation_dialog(bool managed)
ccd_cutoff = gtk_hscale_new(GTK_ADJUSTMENT(ccd_cutoff_adj));
UNSET_CAN_FOCUS(ccd_cutoff);
gtk_range_set_update_policy(GTK_RANGE(GTK_SCALE(ccd_cutoff)), GTK_UPDATE_CONTINUOUS);
- gtk_scale_set_digits(GTK_SCALE(ccd_cutoff), 3);
+ gtk_scale_set_digits(GTK_SCALE(ccd_cutoff), 4);
gtk_scale_set_value_pos(GTK_SCALE(ccd_cutoff), GTK_POS_LEFT);
gtk_scale_set_draw_value(GTK_SCALE(ccd_cutoff), true);
SG_SIGNAL_CONNECT(ccd_cutoff_adj, "value_changed", cutoff_color_callback, NULL);
- SG_SIGNAL_CONNECT(ccd_cutoff, "format-value", scale_double_format_callback, NULL);
+ SG_SIGNAL_CONNECT(ccd_cutoff, "format-value", scale_pow_double_format_callback, NULL);
gtk_box_pack_start(GTK_BOX(cutoff_box), ccd_cutoff, true, true, 0);
gtk_widget_show(ccd_cutoff);
- ccd_invert = gtk_check_button_new_with_label("invert");
- SG_SIGNAL_CONNECT(ccd_invert, "toggled", invert_color_callback, NULL);
-
- gtk_table_attach(GTK_TABLE(outer_table), ccd_invert, 0, 3, 2, 3,
- (GtkAttachOptions)(GTK_FILL | GTK_EXPAND),
- (GtkAttachOptions)(GTK_FILL | GTK_EXPAND | GTK_SHRINK),
- 0, 0);
-
- gtk_widget_show(ccd_invert);
- set_toggle_button(ccd_invert, color_inverted(ss), false, NULL);
+#if HAVE_GL
+ gl_button = gtk_check_button_new_with_label("use GL");
+ SG_SIGNAL_CONNECT(gl_button, "toggled", with_gl_callback, NULL);
+ gtk_box_pack_end(GTK_BOX(colorbox), gl_button, false, false, 12);
+ gtk_widget_show(gl_button);
+ set_toggle_button(gl_button, with_gl(ss), false, NULL);
+#endif
set_dialog_widget(COLOR_ORIENTATION_DIALOG, ccd_dialog);
if (color_map(ss) != BLACK_AND_WHITE_COLORMAP) slist_select(ccd_list, color_map(ss));
+
/* orientation section */
+#if (!GTK_CHECK_VERSION(3, 0, 0))
orient_frame = gtk_frame_new(NULL);
- gtk_box_pack_start(GTK_BOX(mainbox), orient_frame, false, false, 10);
+ gtk_box_pack_start(GTK_BOX(mainbox), orient_frame, false, false, 0);
gtk_frame_set_shadow_type(GTK_FRAME(orient_frame), GTK_SHADOW_ETCHED_IN);
gtk_widget_show(orient_frame);
+#else
+ {
+ GtkWidget *sep;
+ sep = gtk_hseparator_new();
+ gtk_box_pack_start(GTK_BOX(mainbox), sep, false, false, 2);
+ gtk_widget_show(sep);
+ }
+#endif
orientbox = gtk_vbox_new(false, 2);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ /* gtk_widget_set_vexpand(orientbox, true); */
+ widget_set_margin_left(orientbox, 8);
+ widget_set_margin_right(orientbox, 8);
+ gtk_box_pack_start(GTK_BOX(mainbox), orientbox, false, false, 10);
+#else
gtk_container_add(GTK_CONTAINER(orient_frame), orientbox);
+#endif
gtk_widget_show(orientbox);
orient_label = snd_gtk_highlight_label_new("orientation");
- gtk_box_pack_start(GTK_BOX(orientbox), orient_label, false, false, 0);
+ gtk_box_pack_start(GTK_BOX(orientbox), orient_label, false, false, 10);
gtk_widget_show(orient_label);
@@ -1032,10 +1127,16 @@ GtkWidget *start_color_orientation_dialog(bool managed)
widget_modify_bg(sep3, GTK_STATE_NORMAL, ss->basic_color);
gtk_widget_show(sep3);
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ #define PADDING 4
+#else
+ #define PADDING 2
+#endif
/* AX */
ax_box = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(orientbox), ax_box, true, true, 0);
+ gtk_box_pack_start(GTK_BOX(orientbox), ax_box, true, true, PADDING);
gtk_widget_show(ax_box);
ax_label = gtk_label_new("x angle:");
@@ -1057,7 +1158,7 @@ GtkWidget *start_color_orientation_dialog(bool managed)
/* AY */
ay_box = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(orientbox), ay_box, true, true, 0);
+ gtk_box_pack_start(GTK_BOX(orientbox), ay_box, true, true, PADDING);
gtk_widget_show(ay_box);
ay_label = gtk_label_new("y angle:");
@@ -1079,7 +1180,7 @@ GtkWidget *start_color_orientation_dialog(bool managed)
/* AZ */
az_box = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(orientbox), az_box, true, true, 0);
+ gtk_box_pack_start(GTK_BOX(orientbox), az_box, true, true, PADDING);
gtk_widget_show(az_box);
az_label = gtk_label_new("z angle:");
@@ -1100,14 +1201,14 @@ GtkWidget *start_color_orientation_dialog(bool managed)
sep1 = gtk_vseparator_new(); /* not hseparator! */
- gtk_box_pack_start(GTK_BOX(orientbox), sep1, false, false, 6);
+ gtk_box_pack_start(GTK_BOX(orientbox), sep1, false, false, 3 * PADDING);
widget_modify_bg(sep1, GTK_STATE_NORMAL, ss->basic_color);
gtk_widget_show(sep1);
/* SX */
sx_box = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(orientbox), sx_box, true, true, 0);
+ gtk_box_pack_start(GTK_BOX(orientbox), sx_box, true, true, PADDING);
gtk_widget_show(sx_box);
sx_label = gtk_label_new("x scale:");
@@ -1129,7 +1230,7 @@ GtkWidget *start_color_orientation_dialog(bool managed)
/* SY */
sy_box = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(orientbox), sy_box, true, true, 0);
+ gtk_box_pack_start(GTK_BOX(orientbox), sy_box, true, true, PADDING);
gtk_widget_show(sy_box);
sy_label = gtk_label_new("y scale:");
@@ -1151,7 +1252,7 @@ GtkWidget *start_color_orientation_dialog(bool managed)
/* SZ */
sz_box = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(orientbox), sz_box, true, true, 0);
+ gtk_box_pack_start(GTK_BOX(orientbox), sz_box, true, true, PADDING);
gtk_widget_show(sz_box);
@@ -1173,14 +1274,14 @@ GtkWidget *start_color_orientation_dialog(bool managed)
sep2 = gtk_vseparator_new();
- gtk_box_pack_start(GTK_BOX(orientbox), sep2, false, false, 6);
+ gtk_box_pack_start(GTK_BOX(orientbox), sep2, false, false, 3 * PADDING);
widget_modify_bg(sep2, GTK_STATE_NORMAL, ss->basic_color);
gtk_widget_show(sep2);
/* HOP */
hop_box = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(orientbox), hop_box, false, false, 0);
+ gtk_box_pack_start(GTK_BOX(orientbox), hop_box, false, false, PADDING);
gtk_widget_show(hop_box);
hop_label = gtk_label_new("hop: ");
@@ -1202,7 +1303,7 @@ GtkWidget *start_color_orientation_dialog(bool managed)
gtk_widget_show(oid_hop);
sep5 = gtk_vseparator_new();
- gtk_box_pack_start(GTK_BOX(orientbox), sep5, false, false, 3);
+ gtk_box_pack_start(GTK_BOX(orientbox), sep5, false, false, 2 * PADDING);
widget_modify_bg(sep5, GTK_STATE_NORMAL, ss->basic_color);
gtk_widget_show(sep5);
}
@@ -1213,38 +1314,33 @@ GtkWidget *start_color_orientation_dialog(bool managed)
}
-static XEN g_background_gradient(void) {return(C_TO_XEN_DOUBLE(ss->bg_gradient));}
+static Xen g_background_gradient(void) {return(C_double_to_Xen_real(ss->bg_gradient));}
-static XEN g_set_background_gradient(XEN val)
+static Xen g_set_background_gradient(Xen val)
{
#define H_background_gradient "(" S_background_gradient "): channel graph background color gradient"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_background_gradient, "a number between 0 (none) and 1");
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_background_gradient, "a number between 0 (none) and 1");
- ss->bg_gradient = XEN_TO_C_DOUBLE(val);
+ ss->bg_gradient = Xen_real_to_C_double(val);
for_each_chan(update_graph);
return(val);
}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_0(g_background_gradient_w, g_background_gradient)
- XEN_NARGIFY_1(g_set_background_gradient_w, g_set_background_gradient)
-#else
- #define g_background_gradient_w g_background_gradient
- #define g_set_background_gradient_w g_set_background_gradient
-#endif
+Xen_wrap_no_args(g_background_gradient_w, g_background_gradient)
+Xen_wrap_1_arg(g_set_background_gradient_w, g_set_background_gradient)
void g_init_gxdraw(void)
{
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_background_gradient, g_background_gradient_w, H_background_gradient,
- S_setB S_background_gradient, g_set_background_gradient_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_background_gradient, g_background_gradient_w, H_background_gradient,
+ S_set S_background_gradient, g_set_background_gradient_w, 0, 0, 1, 0);
#define H_orientation_hook S_orientation_hook " (): called whenever one of the variables associated with the \
orientation dialog changes"
#define H_color_hook S_color_hook " (): called whenever one of the variables associated with the \
color dialog changes"
- orientation_hook = XEN_DEFINE_HOOK(S_orientation_hook, 0, H_orientation_hook);
- color_hook = XEN_DEFINE_HOOK(S_color_hook, 0, H_color_hook);
+ orientation_hook = Xen_define_hook(S_orientation_hook, "(make-hook)", 0, H_orientation_hook);
+ color_hook = Xen_define_hook(S_color_hook, "(make-hook)", 0, H_color_hook);
}
diff --git a/snd-gdrop.c b/snd-gdrop.c
deleted file mode 100644
index e40e990..0000000
--- a/snd-gdrop.c
+++ /dev/null
@@ -1,206 +0,0 @@
-#include "snd.h"
-
-typedef struct {
- void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data);
- void (*drag_watcher)(GtkWidget *w, const char *message, int x, int y, drag_style_t dtype, void *data);
- GtkWidget *caller;
- void *context;
-} drop_watcher_t;
-
-static drop_watcher_t **drop_watchers = NULL;
-static int drop_watchers_size = 0;
-
-#define DROP_WATCHER_SIZE_INCREMENT 2
-
-
-static int add_drop_watcher(GtkWidget *w,
- void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data),
- void (*drag_watcher)(GtkWidget *w, const char *message, int x, int y, drag_style_t dtype, void *data),
- void *context)
-{
- int loc = -1;
- if (!(drop_watchers))
- {
- loc = 0;
- drop_watchers_size = DROP_WATCHER_SIZE_INCREMENT;
- drop_watchers = (drop_watcher_t **)calloc(drop_watchers_size, sizeof(drop_watcher_t *));
- }
- else
- {
- int i;
- for (i = 0; i < drop_watchers_size; i++)
- if (!(drop_watchers[i]))
- {
- loc = i;
- break;
- }
- if (loc == -1)
- {
- loc = drop_watchers_size;
- drop_watchers_size += DROP_WATCHER_SIZE_INCREMENT;
- drop_watchers = (drop_watcher_t **)realloc(drop_watchers, drop_watchers_size * sizeof(drop_watcher_t *));
- for (i = loc; i < drop_watchers_size; i++) drop_watchers[i] = NULL;
- }
- }
- drop_watchers[loc] = (drop_watcher_t *)calloc(1, sizeof(drop_watcher_t));
- drop_watchers[loc]->drop_watcher = drop_watcher;
- drop_watchers[loc]->drag_watcher = drag_watcher;
- drop_watchers[loc]->context = context;
- drop_watchers[loc]->caller = w;
- return(loc);
-}
-
-
-static drop_watcher_t *find_drop_watcher(GtkWidget *caller)
-{
- if (drop_watchers)
- {
- int i;
- for (i = 0; i < drop_watchers_size; i++)
- {
- if (drop_watchers[i])
- {
- drop_watcher_t *d;
- d = drop_watchers[i];
- if (d->caller == caller)
- return(d);
- }
- }
- }
- return(NULL);
-}
-
-
-enum {TARGET_STRING, TARGET_UTF8, TARGET_URL};
-
-static GtkTargetEntry target_table[] = {
- {(char *)"STRING", 0, TARGET_STRING},
- {(char *)"FILE_NAME", 0, TARGET_STRING},
- {(char *)"text/plain", 0, TARGET_STRING},
- {(char *)"COMPOUND_TEXT", 0, TARGET_STRING},
- {(char *)"UTF8_STRING", 0, TARGET_UTF8}, /* untested */
- {(char *)"text/uri-list", 0, TARGET_URL}
-};
-
-static XEN drop_hook;
-
-
-#if HAVE_GTK_ADJUSTMENT_GET_UPPER
- #define SELECTION_DATA(Data) (gtk_selection_data_get_data(Data))
- #define SELECTION_LENGTH(Data) (gtk_selection_data_get_length(Data))
- #define SELECTION_FORMAT(Data) (gtk_selection_data_get_format(Data))
-#else
- #define SELECTION_DATA(Data) (Data->data)
- #define SELECTION_LENGTH(Data) (Data->length)
- #define SELECTION_FORMAT(Data) (Data->format)
-#endif
-
-static void drag_data_received(GtkWidget *caller, GdkDragContext *context, gint mx, gint my,
- GtkSelectionData *data, guint info, guint time)
-{
- /* data->target */
- if ((SELECTION_LENGTH(data) >= 0) &&
- (SELECTION_FORMAT(data) == 8))
- {
- gsize bread, bwritten;
- GError *error;
- char *str;
-
- if (info == TARGET_STRING)
- str = (char *)(SELECTION_DATA(data));
- else str = (char *)g_filename_from_utf8((gchar *)(SELECTION_DATA(data)), SELECTION_LENGTH(data), &bread, &bwritten, &error);
-
- if ((!(XEN_HOOKED(drop_hook))) ||
- (!(XEN_TRUE_P(run_or_hook(drop_hook,
- XEN_LIST_1(C_TO_XEN_STRING(str)),
- S_drop_hook)))))
- {
- drop_watcher_t *d;
- d = find_drop_watcher(caller);
- if (d)
- {
- /* loop through possible list of filenames, calling watcher on each */
- char *filename;
- int len = 0, i, j = 0;
- len = mus_strlen(str);
- filename = (char *)calloc(len, sizeof(char));
- for (i = 0; i < len; i++)
- {
- if (isspace(str[i]))
- {
- if (j > 0)
- {
- filename[j] = '\0';
- if (strncmp(filename, "file://", 7) == 0)
- {
- char *tmp;
- tmp = (char *)(filename + 7);
- (*(d->drop_watcher))(caller, (const char *)tmp, mx, my, d->context);
- }
- else (*(d->drop_watcher))(caller, (const char *)filename, mx, my, d->context);
- j = 0;
- }
- /* else ignore extra white space chars */
- }
- else
- {
- filename[j++] = str[i];
- }
- }
- free(filename);
- }
- }
- gtk_drag_finish (context, true, false, time);
- return;
- }
- gtk_drag_finish(context, false, false, time);
-}
-
-
-static void drag_leave(GtkWidget *w, GdkDragContext *context, guint time)
-{
- drop_watcher_t *d;
- d = find_drop_watcher(w);
- if ((d) && (d->drag_watcher))
- (*(d->drag_watcher))(w, NULL, 0, 0, DRAG_LEAVE, d->context);
-}
-
-
-static gboolean drag_motion(GtkWidget *w, GdkDragContext *context, gint x, gint y, guint time)
-{
- drop_watcher_t *d;
- d = find_drop_watcher(w);
- if ((d) && (d->drag_watcher))
- (*(d->drag_watcher))(w, NULL, x, y, DRAG_MOTION, d->context);
- return(true); /* this is what the examples return in gtk/tests/testdnd.c -- don't know what it means, if anything */
-}
-
-
-void add_drag_and_drop(GtkWidget *w,
- void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data),
- void (*drag_watcher)(GtkWidget *w, const char *message, int x, int y, drag_style_t dtype, void *data),
- void *context)
-{
- gtk_drag_dest_set(w, GTK_DEST_DEFAULT_ALL, target_table, 6, (GdkDragAction)(GDK_ACTION_COPY | GDK_ACTION_MOVE | GDK_ACTION_LINK));
- SG_SIGNAL_CONNECT(w, "drag_data_received", drag_data_received, NULL);
- SG_SIGNAL_CONNECT(w, "drag_motion", drag_motion, NULL);
- SG_SIGNAL_CONNECT(w, "drag_leave", drag_leave, NULL);
- add_drop_watcher(w, drop_watcher, drag_watcher, context);
-}
-
-
-void add_drop(GtkWidget *w,
- void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data),
- void *context)
-{
- add_drag_and_drop(w, drop_watcher, NULL, context);
-}
-
-
-void g_init_gxdrop(void)
-{
- #define H_drop_hook S_drop_hook " (filename): called whenever Snd receives a drag-and-drop \
-event. If it returns " PROC_TRUE ", the file is not opened by Snd."
-
- drop_hook = XEN_DEFINE_HOOK(S_drop_hook, 1, H_drop_hook); /* arg = filename */
-}
diff --git a/snd-genv.c b/snd-genv.c
index bee11b1..2325bed 100644
--- a/snd-genv.c
+++ b/snd-genv.c
@@ -2,12 +2,13 @@
/* envelope editor and viewer */
-
static GtkWidget *enved_dialog = NULL;
-static GtkWidget *applyB, *apply2B, *cancelB, *drawer, *showB, *saveB, *resetB, *firB = NULL;
-static GtkWidget *revertB, *undoB, *redoB, *printB, *brktxtL, *graphB, *fltB, *ampB, *srcB, *rbrow, *clipB, *deleteB;
-static GtkWidget *nameL, *textL, *dBB, *orderL;
-static GtkWidget *expB, *linB, *lerow, *baseScale, *baseLabel, *baseValue, *selectionB, *selrow, *revrow, *unrow, *saverow;
+static GtkWidget *enved_apply_button, *enved_apply2_button, *enved_cancel_button, *enved_drawer, *show_button;
+static GtkWidget *enved_save_button = NULL, *enved_reset_button, *fir_button = NULL;
+static GtkWidget *enved_revert_button, *enved_undo_button, *enved_redo_button, *brktxtL, *enved_graph_button;
+static GtkWidget *flt_button, *amp_button, *src_button, *rbrow, *clip_button;
+static GtkWidget *enved_name_label, *enved_text_label, *enved_dB_button, *enved_order_label;
+static GtkWidget *lin_button, *lerow, *baseScale, *baseLabel, *baseValue, *enved_selection_button, *selrow, *unrow;
static GtkAdjustment *baseAdj, *orderAdj;
static gc_t *gc, *rgc, *ggc;
static slist *env_list = NULL;
@@ -28,8 +29,8 @@ static env* active_env = NULL; /* env currently being edited */
static axis_info *axis = NULL;
static axis_info *gray_ap = NULL;
-static bool FIR_p = true;
-static bool old_clip_p = false;
+static bool is_FIR = true;
+static bool old_clipping = false;
static bool ignore_button_release = false;
@@ -74,11 +75,11 @@ static void prepare_env_edit(env *new_env)
}
-void set_enved_redo_sensitive(bool val) {set_sensitive(redoB, val);}
-void set_enved_revert_sensitive(bool val) {set_sensitive(revertB, val);}
-void set_enved_undo_sensitive(bool val) {set_sensitive(undoB, val);}
-void set_enved_save_sensitive(bool val) {set_sensitive(saveB, val);}
-void set_enved_show_sensitive(bool val) {set_sensitive(showB, val);}
+void set_enved_redo_sensitive(bool val) {set_sensitive(enved_redo_button, val);}
+void set_enved_revert_sensitive(bool val) {set_sensitive(enved_revert_button, val);}
+void set_enved_undo_sensitive(bool val) {set_sensitive(enved_undo_button, val);}
+void set_enved_save_sensitive(bool val) {set_sensitive(enved_save_button, val);}
+void set_enved_show_sensitive(bool val) {set_sensitive(show_button, val);}
void make_scrolled_env_list(void)
@@ -94,7 +95,7 @@ void make_scrolled_env_list(void)
void enved_reflect_peak_env_completion(snd_info *sp)
{
- if ((enved_dialog) && (active_channel) && (enved_wave_p(ss)))
+ if ((enved_dialog) && (active_channel) && (enved_with_wave(ss)))
{
if (active_channel->sound == sp)
env_redisplay();
@@ -146,16 +147,16 @@ static bool within_selection_src = false;
static void apply_enved(void)
{
- char *origin = NULL, *estr = NULL;
if (active_env)
{
active_channel = current_channel();
if (active_channel)
{
- set_sensitive(applyB, false);
- set_sensitive(apply2B, false);
- set_stock_button_label(cancelB, "Stop");
- force_update(cancelB);
+ char *origin = NULL, *estr = NULL;
+ set_sensitive(enved_apply_button, false);
+ set_sensitive(enved_apply2_button, false);
+ set_stock_button_label(enved_cancel_button, I_STOP);
+ force_update(enved_cancel_button);
switch (enved_target(ss))
{
case ENVED_AMPLITUDE:
@@ -166,17 +167,17 @@ static void apply_enved(void)
(apply_to_selection) ? S_env_selection : S_env_channel);
#else
origin = mus_format("%s" PROC_OPEN "%s%s",
- TO_PROC_NAME((apply_to_selection) ? S_env_selection : S_env_channel),
+ to_proc_name((apply_to_selection) ? S_env_selection : S_env_channel),
estr = env_to_string(active_env),
(apply_to_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
#endif
apply_env(active_channel, active_env, 0,
- CURRENT_SAMPLES(active_channel),
+ current_samples(active_channel),
apply_to_selection,
origin, NULL,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
/* calls update_graph, I think, but in short files that doesn't update the amp-env */
- if (enved_wave_p(ss)) env_redisplay();
+ if (enved_with_wave(ss)) env_redisplay();
if (estr) free(estr);
if (origin) free(origin);
break;
@@ -189,17 +190,17 @@ static void apply_enved(void)
(apply_to_selection) ? S_filter_selection : S_filter_channel);
#else
origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d%s",
- TO_PROC_NAME((apply_to_selection) ? S_filter_selection : S_filter_channel),
+ to_proc_name((apply_to_selection) ? S_filter_selection : S_filter_channel),
estr = env_to_string(active_env),
enved_filter_order(ss),
(apply_to_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
#endif
apply_filter(active_channel,
- (FIR_p) ? enved_filter_order(ss) : 0,
+ (is_FIR) ? enved_filter_order(ss) : 0,
active_env,
origin, NULL,
apply_to_selection, NULL, NULL,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0, false);
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0, false);
if (estr) free(estr);
if (origin) free(origin);
break;
@@ -213,16 +214,16 @@ static void apply_enved(void)
within_selection_src = true;
src_env_or_num(active_channel, max_env, 0.0,
false, "Enved: src", apply_to_selection, NULL,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
within_selection_src = false;
max_env = free_env(max_env);
- if (enved_wave_p(ss)) env_redisplay();
+ if (enved_with_wave(ss)) env_redisplay();
}
break;
}
- set_sensitive(applyB, true);
- set_sensitive(apply2B, true);
- set_stock_button_label(cancelB, "Go Away");
+ set_sensitive(enved_apply_button, true);
+ set_sensitive(enved_apply2_button, true);
+ set_stock_button_label(enved_cancel_button, I_GO_AWAY);
}
}
}
@@ -232,8 +233,15 @@ static void env_redisplay_1(printing_t printing)
{
if (enved_dialog_is_active())
{
- if (printing == NOT_PRINTING)
- ss->cr = MAKE_CAIRO(WIDGET_TO_WINDOW(drawer));
+ bool clear_cr = false;
+ if ((printing == NOT_PRINTING) &&
+ (!(ss->cr)))
+ {
+ /* we can get here from display_channel_data_with_size with an existing ss->cr */
+ ss->cr = make_cairo(WIDGET_TO_WINDOW(enved_drawer));
+ clear_cr = true;
+ }
+ if (!(ss->cr)) return;
cairo_push_group(ss->cr);
cairo_set_source_rgba(ss->cr, gc->bg_color->red, gc->bg_color->green, gc->bg_color->blue, gc->bg_color->alpha);
@@ -256,14 +264,14 @@ static void env_redisplay_1(printing_t printing)
else
{
char *name = NULL;
- name = (char *)gtk_entry_get_text(GTK_ENTRY(textL));
+ name = (char *)gtk_entry_get_text(GTK_ENTRY(enved_text_label));
if (!name) name = (char *)"noname";
- if ((enved_wave_p(ss)) &&
+ if ((enved_with_wave(ss)) &&
(active_channel) &&
(!(active_channel->squelch_update)))
{
- if ((enved_target(ss) == ENVED_SPECTRUM) && (active_env) && (FIR_p) && (printing == NOT_PRINTING))
+ if ((enved_target(ss) == ENVED_SPECTRUM) && (active_env) && (is_FIR) && (printing == NOT_PRINTING))
display_frequency_response(active_env, axis, gray_ap->ax, enved_filter_order(ss), enved_in_dB(ss));
enved_show_background_waveform(axis, gray_ap, apply_to_selection, (enved_target(ss) == ENVED_SPECTRUM), NOT_PRINTING);
}
@@ -272,9 +280,10 @@ static void env_redisplay_1(printing_t printing)
cairo_pop_group_to_source(ss->cr);
cairo_paint(ss->cr);
- if (printing == NOT_PRINTING)
+ if ((printing == NOT_PRINTING) &&
+ (clear_cr))
{
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
}
}
@@ -296,7 +305,7 @@ void env_redisplay_with_print(void)
void update_enved_background_waveform(chan_info *cp)
{
if ((enved_dialog_is_active()) &&
- (enved_wave_p(ss)) &&
+ (enved_with_wave(ss)) &&
(enved_target(ss) == ENVED_AMPLITUDE) &&
(cp == active_channel) &&
((!apply_to_selection) || (selection_is_active_in_channel(cp))))
@@ -307,7 +316,7 @@ void update_enved_background_waveform(chan_info *cp)
static void enved_filter_order_callback(GtkWidget *w, gpointer data)
{
- set_enved_filter_order(gtk_spin_button_get_value_as_int(GTK_SPIN_BUTTON(orderL)));
+ set_enved_filter_order(gtk_spin_button_get_value_as_int(GTK_SPIN_BUTTON(enved_order_label)));
}
@@ -329,7 +338,7 @@ static gint unpost_genv_error(gpointer data)
static void errors_to_genv_text(const char *msg, void *data)
{
- set_button_label(brktxtL, msg);
+ gtk_label_set_text(GTK_LABEL(brktxtL), msg);
g_timeout_add_full(0, (guint32)5000, unpost_genv_error, NULL, NULL);
}
@@ -350,7 +359,7 @@ static void text_field_activated(GtkWidget *w, gpointer context)
{
alert_envelope_editor(str, copy_env(active_env));
add_or_edit_symbol(str, active_env);
- set_sensitive(saveB, false);
+ set_sensitive(enved_save_button, false);
env_redisplay(); /* updates label */
}
else
@@ -373,9 +382,9 @@ static void text_field_activated(GtkWidget *w, gpointer context)
active_env = copy_env(e);
set_enved_env_list_top(0);
prepare_env_edit(active_env);
- set_sensitive(saveB, true);
- set_sensitive(undoB, false);
- set_sensitive(revertB, false);
+ set_sensitive(enved_save_button, true);
+ set_sensitive(enved_undo_button, false);
+ set_sensitive(enved_revert_button, false);
env_redisplay();
free_env(e);
}
@@ -383,16 +392,16 @@ static void text_field_activated(GtkWidget *w, gpointer context)
}
-static void save_button_pressed(GtkWidget *w, gpointer context)
+static void enved_save_button_pressed(GtkWidget *w, gpointer context)
{
char *name = NULL;
if (active_env == NULL) return;
- name = (char *)gtk_entry_get_text(GTK_ENTRY(textL));
+ name = (char *)gtk_entry_get_text(GTK_ENTRY(enved_text_label));
if ((!name) || (!(*name)))
name = (char *)"unnamed";
alert_envelope_editor(name, copy_env(active_env));
add_or_edit_symbol(name, active_env);
- set_sensitive(saveB, false);
+ set_sensitive(enved_save_button, false);
env_redisplay();
}
@@ -414,7 +423,7 @@ static void undo_and_apply_enved_callback(GtkWidget *w, gpointer context)
active_channel->squelch_update = true;
undo_edit_with_sync(active_channel, 1);
active_channel->squelch_update = false;
- clear_minibuffer(active_channel->sound);
+ clear_status_area(active_channel->sound);
}
apply_enved();
last_active_channel = active_channel;
@@ -423,12 +432,10 @@ static void undo_and_apply_enved_callback(GtkWidget *w, gpointer context)
static void reflect_segment_state(void)
{
- if (enved_dialog)
- {
- widget_modify_bg(expB, GTK_STATE_NORMAL, (enved_style(ss) == ENVELOPE_EXPONENTIAL) ? ss->yellow : ss->basic_color);
- widget_modify_bg(linB, GTK_STATE_NORMAL, (enved_style(ss) == ENVELOPE_LINEAR) ? ss->yellow : ss->basic_color);
- if ((active_env) && (!(showing_all_envs))) env_redisplay();
- }
+ if ((enved_dialog) &&
+ (active_env) &&
+ (!(showing_all_envs)))
+ env_redisplay();
}
@@ -437,20 +444,19 @@ static void select_or_edit_env(int pos)
if (showing_all_envs)
{
showing_all_envs = false;
- set_button_label(showB, "view envs");
+ set_button_label(show_button, "view envs");
}
if (active_env) active_env = free_env(active_env);
selected_env = position_to_env(pos);
if (!selected_env) return;
active_env = selected_env;
- gtk_entry_set_text(GTK_ENTRY(textL), enved_all_names(pos));
+ gtk_entry_set_text(GTK_ENTRY(enved_text_label), enved_all_names(pos));
set_enved_env_list_top(0);
prepare_env_edit(active_env);
- set_sensitive(undoB, false);
- set_sensitive(revertB, false);
- set_sensitive(saveB, false);
+ set_sensitive(enved_undo_button, false);
+ set_sensitive(enved_revert_button, false);
+ set_sensitive(enved_save_button, false);
env_redisplay();
- set_sensitive(deleteB, true);
}
@@ -458,7 +464,7 @@ static void select_or_edit_env(int pos)
static void clear_point_label(void)
{
- set_button_label(brktxtL, BLANK_LABEL);
+ gtk_label_set_text(GTK_LABEL(brktxtL), BLANK_LABEL);
}
@@ -467,13 +473,13 @@ static char brkpt_buf[LABEL_BUFFER_SIZE];
static void enved_display_point_label(mus_float_t x, mus_float_t y)
{
if ((enved_in_dB(ss)) && (min_dB(ss) < -60))
- mus_snprintf(brkpt_buf, LABEL_BUFFER_SIZE, "%.3f : %.5f", x, y);
- else mus_snprintf(brkpt_buf, LABEL_BUFFER_SIZE, "%.3f : %.3f", x, y);
- set_button_label(brktxtL, brkpt_buf);
+ snprintf(brkpt_buf, LABEL_BUFFER_SIZE, "%.3f : %.5f", x, y);
+ else snprintf(brkpt_buf, LABEL_BUFFER_SIZE, "%.3f : %.3f", x, y);
+ gtk_label_set_text(GTK_LABEL(brktxtL), brkpt_buf);
}
-static gboolean drawer_button_motion(GtkWidget *w, GdkEventMotion *ev, gpointer data)
+static gboolean enved_drawer_button_motion(GtkWidget *w, GdkEventMotion *ev, gpointer data)
{
int evx, evy;
GdkModifierType state;
@@ -483,7 +489,7 @@ static gboolean drawer_button_motion(GtkWidget *w, GdkEventMotion *ev, gpointer
if (BUTTON1_PRESSED(EVENT_STATE(ev)))
{
if (EVENT_IS_HINT(ev))
- gdk_window_get_pointer(EVENT_WINDOW(ev), &evx, &evy, &state);
+ window_get_pointer(ev, &evx, &evy, &state);
else
{
evx = (int)(EVENT_X(ev));
@@ -506,7 +512,7 @@ static gboolean drawer_button_motion(GtkWidget *w, GdkEventMotion *ev, gpointer
}
-static gboolean drawer_button_press(GtkWidget *w, GdkEventButton *ev, gpointer data)
+static gboolean enved_drawer_button_press(GtkWidget *w, GdkEventButton *ev, gpointer data)
{
ss->enved->down_time = EVENT_TIME(ev);
ss->enved->env_dragged = false;
@@ -528,20 +534,21 @@ static gboolean drawer_button_press(GtkWidget *w, GdkEventButton *ev, gpointer d
if (!active_env)
{
active_env = default_env(1.0, 0.0);
+ active_env->base = enved_base(ss);
env_redisplay(); /* needed to get current_xs set up correctly */
}
if (env_editor_button_press(ss->enved, (int)(EVENT_X(ev)), (int)(EVENT_Y(ev)), EVENT_TIME(ev), active_env))
env_redisplay();
enved_display_point_label(ungrf_x(ss->enved->axis, EVENT_X(ev)), env_editor_ungrf_y_dB(ss->enved, (int)(EVENT_Y(ev))));
- set_sensitive(saveB, true);
- set_sensitive(undoB, true);
- set_sensitive(revertB, true);
+ set_sensitive(enved_save_button, true);
+ set_sensitive(enved_undo_button, true);
+ set_sensitive(enved_revert_button, true);
}
return(false);
}
-static gboolean drawer_button_release(GtkWidget *w, GdkEventButton *ev, gpointer data)
+static gboolean enved_drawer_button_release(GtkWidget *w, GdkEventButton *ev, gpointer data)
{
if (ignore_button_release)
ignore_button_release = false;
@@ -558,7 +565,7 @@ static gboolean drawer_button_release(GtkWidget *w, GdkEventButton *ev, gpointer
}
-static gboolean drawer_expose(GtkWidget *w, GdkEventExpose *ev, gpointer data)
+static gboolean enved_drawer_expose(GtkWidget *w, GdkEventExpose *ev, gpointer data)
{
env_window_width = widget_width(w);
env_window_height = widget_height(w);
@@ -567,7 +574,7 @@ static gboolean drawer_expose(GtkWidget *w, GdkEventExpose *ev, gpointer data)
}
-static gboolean drawer_resize(GtkWidget *w, GdkEventConfigure *ev, gpointer data)
+static gboolean enved_drawer_resize(GtkWidget *w, GdkEventConfigure *ev, gpointer data)
{
/* update display, can be either view of all envs or sequence of current envs */
env_window_width = widget_width(w);
@@ -581,55 +588,34 @@ static void show_button_pressed(GtkWidget *w, gpointer context)
{
/* if show all (as opposed to show current), loop through loaded LV_LISTs */
showing_all_envs = (!showing_all_envs);
- set_button_label(showB, (showing_all_envs) ? "edit env" : "view envs");
+ set_button_label(show_button, (showing_all_envs) ? "edit env" : "view envs");
env_redisplay();
}
-static void selection_button_pressed(GtkWidget *w, gpointer context)
+static void enved_selection_button_pressed(GtkWidget *w, gpointer context)
{
apply_to_selection = (!apply_to_selection);
- widget_modify_bg(selectionB, GTK_STATE_NORMAL, (apply_to_selection) ? ss->yellow : ss->basic_color);
- set_sensitive(apply2B, true);
- if ((enved_wave_p(ss)) &&
+ widget_modify_bg(enved_selection_button, GTK_STATE_NORMAL, (apply_to_selection) ? ss->yellow : ss->basic_color);
+ set_sensitive(enved_apply2_button, true);
+ if ((enved_with_wave(ss)) &&
(!showing_all_envs))
env_redisplay();
}
-static void delete_button_pressed(GtkWidget *w, gpointer context)
-{
- if (selected_env)
- {
- int i, len;
- len = enved_all_envs_top();
- for (i = 0; i < len; i++)
- if (selected_env == enved_all_envs(i))
- {
- delete_envelope(enved_all_names(i));
- if (enved_all_envs_top() == 0)
- set_sensitive(deleteB, false);
- if (active_env) active_env = free_env(active_env);
- selected_env = NULL;
- env_redisplay();
- break;
- }
- }
-}
-
-
-static void revert_button_pressed(GtkWidget *w, gpointer context)
+static void enved_revert_button_pressed(GtkWidget *w, gpointer context)
{
revert_env_edit();
if (active_env) active_env = free_env(active_env);
active_env = enved_next_env();
if (active_env == NULL)
- text_field_activated(textL, NULL);
+ text_field_activated(enved_text_label, NULL);
env_redisplay();
}
-static void undo_button_pressed(GtkWidget *w, gpointer context)
+static void enved_undo_button_pressed(GtkWidget *w, gpointer context)
{
undo_env_edit();
if (active_env) active_env = free_env(active_env);
@@ -638,7 +624,7 @@ static void undo_button_pressed(GtkWidget *w, gpointer context)
}
-static void redo_button_pressed(GtkWidget *w, gpointer context)
+static void enved_redo_button_pressed(GtkWidget *w, gpointer context)
{
redo_env_edit();
if (active_env) active_env = free_env(active_env);
@@ -649,19 +635,19 @@ static void redo_button_pressed(GtkWidget *w, gpointer context)
static void reflect_apply_state(void)
{
- gtk_label_set_text(GTK_LABEL(nameL), env_names[enved_target(ss)]);
- widget_modify_bg(ampB, GTK_STATE_NORMAL, (enved_target(ss) == ENVED_AMPLITUDE) ? ss->yellow : ss->basic_color);
- widget_modify_bg(fltB, GTK_STATE_NORMAL, (enved_target(ss) == ENVED_SPECTRUM) ? ss->yellow : ss->basic_color);
- widget_modify_bg(srcB, GTK_STATE_NORMAL, (enved_target(ss) == ENVED_SRATE) ? ss->yellow : ss->basic_color);
- if ((!showing_all_envs) && (enved_wave_p(ss))) env_redisplay();
+ gtk_label_set_text(GTK_LABEL(enved_name_label), env_names[enved_target(ss)]);
+ widget_modify_bg(amp_button, GTK_STATE_NORMAL, (enved_target(ss) == ENVED_AMPLITUDE) ? ss->yellow : ss->basic_color);
+ widget_modify_bg(flt_button, GTK_STATE_NORMAL, (enved_target(ss) == ENVED_SPECTRUM) ? ss->yellow : ss->basic_color);
+ widget_modify_bg(src_button, GTK_STATE_NORMAL, (enved_target(ss) == ENVED_SRATE) ? ss->yellow : ss->basic_color);
+ if ((!showing_all_envs) && (enved_with_wave(ss))) env_redisplay();
}
static void flt_button_pressed(GtkWidget *w, gpointer context)
{
in_set_enved_target(ENVED_SPECTRUM);
- old_clip_p = enved_clip_p(ss);
- set_enved_clip_p(true);
+ old_clipping = enved_clipping(ss);
+ set_enved_clipping(true);
reflect_apply_state();
}
@@ -669,7 +655,7 @@ static void flt_button_pressed(GtkWidget *w, gpointer context)
static void amp_button_pressed(GtkWidget *w, gpointer context)
{
if (enved_target(ss) == ENVED_SPECTRUM)
- set_enved_clip_p(old_clip_p);
+ set_enved_clipping(old_clipping);
in_set_enved_target(ENVED_AMPLITUDE);
reflect_apply_state();
}
@@ -678,7 +664,7 @@ static void amp_button_pressed(GtkWidget *w, gpointer context)
static void src_button_pressed(GtkWidget *w, gpointer context)
{
if (enved_target(ss) == ENVED_SPECTRUM)
- set_enved_clip_p(old_clip_p);
+ set_enved_clipping(old_clipping);
in_set_enved_target(ENVED_SRATE);
reflect_apply_state();
}
@@ -686,12 +672,12 @@ static void src_button_pressed(GtkWidget *w, gpointer context)
static void enved_reset(void)
{
- set_enved_clip_p(DEFAULT_ENVED_CLIP_P);
+ set_enved_clipping(DEFAULT_ENVED_CLIPPING);
set_enved_style(ENVELOPE_LINEAR);
set_enved_power(DEFAULT_ENVED_POWER);
set_enved_base(DEFAULT_ENVED_BASE);
set_enved_target(DEFAULT_ENVED_TARGET);
- set_enved_wave_p(DEFAULT_ENVED_WAVE_P);
+ set_enved_with_wave(DEFAULT_ENVED_WITH_WAVE);
set_enved_in_dB(DEFAULT_ENVED_IN_DB);
set_enved_filter_order(DEFAULT_ENVED_FILTER_ORDER);
if (active_env) active_env = free_env(active_env);
@@ -706,39 +692,32 @@ static void enved_reset(void)
#endif
set_enved_env_list_top(0);
prepare_env_edit(active_env);
- set_sensitive(saveB, true);
+ set_sensitive(enved_save_button, true);
reflect_enved_style();
env_redisplay();
}
-static void reset_button_pressed(GtkWidget *w, gpointer context)
+static void enved_reset_button_pressed(GtkWidget *w, gpointer context)
{
enved_reset();
}
-static void print_button_pressed(GtkWidget *w, gpointer context)
-{
- ss->print_choice = PRINT_ENV;
- file_print_callback(w, context);
-}
-
-
static void env_browse_callback(const char *name, int row, void *data)
{
select_or_edit_env(row);
}
-static void graph_button_callback(GtkWidget *w, gpointer context)
+static void enved_graph_button_callback(GtkWidget *w, gpointer context)
{
- in_set_enved_wave_p(TOGGLE_BUTTON_ACTIVE(w));
+ in_set_enved_with_wave(TOGGLE_BUTTON_ACTIVE(w));
env_redisplay();
}
-static void dB_button_callback(GtkWidget *w, gpointer context)
+static void enved_dB_button_callback(GtkWidget *w, gpointer context)
{
in_set_enved_in_dB(TOGGLE_BUTTON_ACTIVE(w));
env_redisplay();
@@ -747,32 +726,7 @@ static void dB_button_callback(GtkWidget *w, gpointer context)
static void clip_button_callback(GtkWidget *w, gpointer context)
{
- in_set_enved_clip_p(TOGGLE_BUTTON_ACTIVE(w));
-}
-
-
-static void exp_button_pressed(GtkWidget *w, gpointer context)
-{
- set_enved_style(ENVELOPE_EXPONENTIAL);
- if ((active_env) && (!(showing_all_envs)))
- {
- active_env->base = enved_base(ss);
- set_sensitive(saveB, true);
- }
- reflect_segment_state();
-}
-
-
-static void lin_button_pressed(GtkWidget *w, gpointer context)
-{
- set_enved_style(ENVELOPE_LINEAR);
- if ((active_env) && (!(showing_all_envs)))
- {
- active_env->base = 1.0;
- set_enved_base(1.0);
- set_sensitive(saveB, true);
- }
- reflect_segment_state();
+ in_set_enved_clipping(TOGGLE_BUTTON_ACTIVE(w));
}
@@ -785,7 +739,7 @@ static void make_base_label(mus_float_t bval)
if (len < 32) len = 32;
sfs = (char *)calloc(len, sizeof(char));
- mus_snprintf(sfs, len, "%.3f", bval);
+ snprintf(sfs, len, "%.3f", bval);
scale_len = (int)(enved_power(ss) + 3);
if (scale_len < 32) scale_len = 32;
@@ -798,9 +752,17 @@ static void make_base_label(mus_float_t bval)
free(buf);
in_set_enved_base(bval);
- if ((active_env) && (!(showing_all_envs)))
+
+ if ((active_env) &&
+ (!(showing_all_envs)))
{
+ if (enved_save_button) set_sensitive(enved_save_button, true); /* what about undo/redo here? */
+
active_env->base = enved_base(ss);
+ if (active_env->base == 1.0)
+ set_enved_style(ENVELOPE_LINEAR);
+ else set_enved_style(ENVELOPE_EXPONENTIAL);
+
env_redisplay();
}
}
@@ -824,8 +786,6 @@ static void base_changed(mus_float_t val)
}
}
make_base_label(bval);
- if ((active_env) && (enved_style(ss) == ENVELOPE_EXPONENTIAL))
- set_sensitive(saveB, true); /* what about undo/redo here? */
}
@@ -853,63 +813,44 @@ static void reflect_changed_base(mus_float_t val)
}
-static void base_changed_callback(GtkAdjustment *adj, gpointer context)
+static void make_linear(GtkWidget *w, gpointer context)
{
- base_changed(ADJUSTMENT_VALUE(adj));
+ reflect_changed_base(1.0);
+ set_enved_style(ENVELOPE_LINEAR);
}
-static void fir_button_pressed(GtkWidget *w, gpointer context)
+static void base_changed_callback(GtkAdjustment *adj, gpointer context)
{
- FIR_p = (!FIR_p);
- set_button_label(firB, (FIR_p) ? "fir" : "fft");
- if (enved_wave_p(ss)) env_redisplay();
+ base_changed(ADJUSTMENT_VALUE(adj));
}
-static void reflect_sound_state(void)
+static gboolean fir_button_pressed(GtkWidget *w, GdkEventButton *ev, gpointer data)
{
- bool file_p;
- file_p = (bool)(any_selected_sound());
- set_sensitive(applyB, file_p);
- set_sensitive(apply2B, file_p);
+ is_FIR = (!is_FIR);
+ gtk_label_set_text(GTK_LABEL(fir_button), (is_FIR) ? "fir" : "fft");
+ if (enved_with_wave(ss)) env_redisplay();
+ return(false);
}
-static XEN reflect_file_in_enved(XEN reason)
+static void reflect_sound_state(void)
{
- if (enved_dialog) reflect_sound_state();
- return(XEN_FALSE);
+ bool file_on;
+ file_on = (bool)(any_selected_sound());
+ set_sensitive(enved_apply_button, file_on);
+ set_sensitive(enved_apply2_button, file_on);
}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(reflect_file_in_enved_w, reflect_file_in_enved)
-#else
- #define reflect_file_in_enved_w reflect_file_in_enved
-#endif
-
-static void enved_reflect_selection(bool on);
-
-static XEN enved_selection_handler(XEN xreason)
+static Xen reflect_file_in_enved(Xen hook_or_reason)
{
- int reason;
- reason = XEN_TO_C_INT(xreason);
- switch (reason)
- {
- case SELECTION_INACTIVE: enved_reflect_selection(false); break;
- case SELECTION_ACTIVE: enved_reflect_selection(true); break;
- default: enved_reflect_selection(selection_is_active()); break;
- }
- return(XEN_FALSE);
+ if (enved_dialog) reflect_sound_state();
+ return(Xen_false);
}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(enved_selection_handler_w, enved_selection_handler)
-#else
- #define enved_selection_handler_w enved_selection_handler
-#endif
-
+Xen_wrap_1_arg(reflect_file_in_enved_w, reflect_file_in_enved)
#define BB_MARGIN 3
@@ -917,9 +858,13 @@ GtkWidget *create_envelope_editor(void)
{
if (!enved_dialog)
{
- GtkWidget *mainform, *helpB, *leftbox, *bottombox, *leftframe, *toprow, *bottomrow;
+ GtkWidget *mainform, *enved_help_button, *leftbox, *bottombox, *leftframe, *toprow, *bottomrow;
enved_dialog = gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(enved_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
+ add_dialog_style(enved_dialog);
SG_SIGNAL_CONNECT(enved_dialog, "delete_event", delete_enved_dialog, NULL);
gtk_window_set_title(GTK_WINDOW(enved_dialog), "Edit Envelope");
sg_make_resizable(enved_dialog);
@@ -940,38 +885,36 @@ GtkWidget *create_envelope_editor(void)
gc_set_background(ggc, ss->white);
gc_set_foreground(ggc, ss->enved_waveform_color);
- helpB = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(helpB, "dialog_button");
-
- cancelB = sg_button_new_from_stock_with_label("Go Away", GTK_STOCK_QUIT);
- gtk_widget_set_name(cancelB, "dialog_button");
-
- applyB = gtk_button_new_from_stock(GTK_STOCK_APPLY);
- gtk_widget_set_name(applyB, "dialog_button");
-
- apply2B = sg_button_new_from_stock_with_label("Undo&Apply", GTK_STOCK_UNDO);
- gtk_widget_set_name(apply2B, "dialog_button");
-
- resetB = sg_button_new_from_stock_with_label("Reset", GTK_STOCK_REFRESH);
- gtk_widget_set_name(resetB, "dialog_button");
-
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(enved_dialog)), applyB, false, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(enved_dialog)), apply2B, false, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(enved_dialog)), cancelB, false, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(enved_dialog)), resetB, false, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(enved_dialog)), helpB, false, true, 10);
-
- SG_SIGNAL_CONNECT(cancelB, "clicked", dismiss_enved_callback, NULL);
- SG_SIGNAL_CONNECT(applyB, "clicked", apply_enved_callback, NULL);
- SG_SIGNAL_CONNECT(apply2B, "clicked", undo_and_apply_enved_callback, NULL);
- SG_SIGNAL_CONNECT(resetB, "clicked", reset_button_pressed, NULL);
- SG_SIGNAL_CONNECT(helpB, "clicked", help_enved_callback, NULL);
-
- gtk_widget_show(cancelB);
- gtk_widget_show(applyB);
- gtk_widget_show(apply2B);
- gtk_widget_show(resetB);
- gtk_widget_show(helpB);
+ enved_help_button = gtk_dialog_add_button(GTK_DIALOG(enved_dialog), "Help", GTK_RESPONSE_NONE);
+ enved_reset_button = gtk_dialog_add_button(GTK_DIALOG(enved_dialog), "Clear graph", GTK_RESPONSE_NONE);
+ enved_cancel_button = gtk_dialog_add_button(GTK_DIALOG(enved_dialog), I_GO_AWAY, GTK_RESPONSE_NONE);
+ enved_apply2_button = gtk_dialog_add_button(GTK_DIALOG(enved_dialog), "Undo&Apply", GTK_RESPONSE_NONE);
+ enved_apply_button = gtk_dialog_add_button(GTK_DIALOG(enved_dialog), "Apply", GTK_RESPONSE_NONE);
+
+ gtk_widget_set_name(enved_help_button, "dialog_button");
+ gtk_widget_set_name(enved_cancel_button, "dialog_button");
+ gtk_widget_set_name(enved_apply_button, "dialog_button");
+ gtk_widget_set_name(enved_apply2_button, "dialog_button");
+ gtk_widget_set_name(enved_reset_button, "dialog_button");
+
+ SG_SIGNAL_CONNECT(enved_cancel_button, "clicked", dismiss_enved_callback, NULL);
+ SG_SIGNAL_CONNECT(enved_reset_button, "clicked", enved_reset_button_pressed, NULL);
+ SG_SIGNAL_CONNECT(enved_help_button, "clicked", help_enved_callback, NULL);
+ SG_SIGNAL_CONNECT(enved_apply2_button, "clicked", undo_and_apply_enved_callback, NULL);
+ SG_SIGNAL_CONNECT(enved_apply_button, "clicked", apply_enved_callback, NULL);
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(enved_cancel_button);
+ add_highlight_button_style(enved_apply_button);
+ add_highlight_button_style(enved_apply2_button);
+ add_highlight_button_style(enved_reset_button);
+ add_highlight_button_style(enved_help_button);
+#endif
+ gtk_widget_show(enved_cancel_button);
+ gtk_widget_show(enved_apply_button);
+ gtk_widget_show(enved_apply2_button);
+ gtk_widget_show(enved_reset_button);
+ gtk_widget_show(enved_help_button);
mainform = gtk_hbox_new(false, 0); /* buttons + graph */
gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(enved_dialog)), mainform, true, true, 0);
@@ -987,224 +930,280 @@ GtkWidget *create_envelope_editor(void)
gtk_widget_show(leftbox);
bottombox = gtk_vbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(enved_dialog)), bottombox, false, false, 0);
+ gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(enved_dialog)), bottombox, false, false, 4);
gtk_widget_show(bottombox);
- drawer = gtk_drawing_area_new();
- gtk_box_pack_start(GTK_BOX(mainform), drawer, true, true, 0);
- gtk_widget_set_events(drawer, GDK_ALL_EVENTS_MASK);
- widget_modify_bg(drawer, GTK_STATE_NORMAL, ss->white);
- widget_modify_fg(drawer, GTK_STATE_NORMAL, ss->black);
- gtk_widget_show(drawer);
-
- showB = gtk_button_new_with_label("view envs");
- gtk_button_set_relief(GTK_BUTTON(showB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(leftbox), showB, false, false, BB_MARGIN);
- SG_SIGNAL_CONNECT(showB, "clicked", show_button_pressed, NULL);
- gtk_widget_show(showB);
-
- saverow = gtk_hbox_new(false, BB_MARGIN);
- gtk_box_pack_start(GTK_BOX(leftbox), saverow, false, false, BB_MARGIN);
- gtk_widget_show(saverow);
-
- saveB = gtk_button_new_with_label(" save ");
- gtk_button_set_relief(GTK_BUTTON(saveB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(saverow), saveB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(saveB, "clicked", save_button_pressed, NULL);
- gtk_widget_show(saveB);
-
- printB = gtk_button_new_with_label(" print ");
- gtk_button_set_relief(GTK_BUTTON(printB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(saverow), printB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(printB, "clicked", print_button_pressed, NULL);
- gtk_widget_show(printB);
-
- revrow = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(leftbox), revrow, false, false, BB_MARGIN);
- gtk_widget_show(revrow);
-
- revertB = gtk_button_new_with_label("revert ");
- gtk_button_set_relief(GTK_BUTTON(revertB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(revrow), revertB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(revertB, "clicked", revert_button_pressed, NULL);
- gtk_widget_show(revertB);
-
- deleteB = gtk_button_new_with_label("delete");
- gtk_button_set_relief(GTK_BUTTON(deleteB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(revrow), deleteB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(deleteB, "clicked", delete_button_pressed, NULL);
- gtk_widget_show(deleteB);
+
+ enved_drawer = gtk_drawing_area_new();
+ gtk_box_pack_start(GTK_BOX(mainform), enved_drawer, true, true, 0);
+ gtk_widget_set_events(enved_drawer, GDK_ALL_EVENTS_MASK);
+ widget_modify_bg(enved_drawer, GTK_STATE_NORMAL, ss->white);
+ widget_modify_fg(enved_drawer, GTK_STATE_NORMAL, ss->black);
+ gtk_widget_show(enved_drawer);
+
+ show_button = gtk_button_new_with_label("view envs");
+ gtk_button_set_relief(GTK_BUTTON(show_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(leftbox), show_button, false, false, BB_MARGIN);
+ SG_SIGNAL_CONNECT(show_button, "clicked", show_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(show_button);
+#endif
+ gtk_widget_show(show_button);
+
+ enved_save_button = gtk_button_new_with_label("define it");
+ gtk_button_set_relief(GTK_BUTTON(enved_save_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(leftbox), enved_save_button, false, false, BB_MARGIN);
+ SG_SIGNAL_CONNECT(enved_save_button, "clicked", enved_save_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(enved_save_button);
+#endif
+ gtk_widget_show(enved_save_button);
+
+ enved_revert_button = gtk_button_new_with_label("revert ");
+ gtk_button_set_relief(GTK_BUTTON(enved_revert_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(leftbox), enved_revert_button, false, false, BB_MARGIN);
+ SG_SIGNAL_CONNECT(enved_revert_button, "clicked", enved_revert_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(enved_revert_button);
+#endif
+ gtk_widget_show(enved_revert_button);
unrow = gtk_hbox_new(false, 0);
gtk_box_pack_start(GTK_BOX(leftbox), unrow, false, false, BB_MARGIN);
gtk_widget_show(unrow);
- undoB = gtk_button_new_with_label(" undo ");
- gtk_button_set_relief(GTK_BUTTON(undoB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(unrow), undoB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(undoB, "clicked", undo_button_pressed, NULL);
- gtk_widget_show(undoB);
-
- redoB = gtk_button_new_with_label(" redo ");
- gtk_button_set_relief(GTK_BUTTON(redoB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(unrow), redoB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(redoB, "clicked", redo_button_pressed, NULL);
- gtk_widget_show(redoB);
+ enved_undo_button = gtk_button_new_with_label(" undo ");
+ gtk_button_set_relief(GTK_BUTTON(enved_undo_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(unrow), enved_undo_button, true, true, BB_MARGIN);
+ SG_SIGNAL_CONNECT(enved_undo_button, "clicked", enved_undo_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(enved_undo_button);
+#endif
+ gtk_widget_show(enved_undo_button);
+
+ enved_redo_button = gtk_button_new_with_label(" redo ");
+ gtk_button_set_relief(GTK_BUTTON(enved_redo_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(unrow), enved_redo_button, true, true, BB_MARGIN);
+ SG_SIGNAL_CONNECT(enved_redo_button, "clicked", enved_redo_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(enved_redo_button);
+#endif
+ gtk_widget_show(enved_redo_button);
rbrow = gtk_hbox_new(false, 0);
gtk_box_pack_start(GTK_BOX(leftbox), rbrow, false, false, BB_MARGIN);
gtk_widget_show(rbrow);
- ampB = gtk_button_new_with_label("amp");
- gtk_button_set_relief(GTK_BUTTON(ampB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(rbrow), ampB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(ampB, "clicked", amp_button_pressed, NULL);
- gtk_widget_show(ampB);
-
- fltB = gtk_button_new_with_label("flt");
- gtk_button_set_relief(GTK_BUTTON(fltB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(rbrow), fltB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(fltB, "clicked", flt_button_pressed, NULL);
- gtk_widget_show(fltB);
-
- srcB = gtk_button_new_with_label("src");
- gtk_button_set_relief(GTK_BUTTON(srcB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(rbrow), srcB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(srcB, "clicked", src_button_pressed, NULL);
- gtk_widget_show(srcB);
-
- lerow = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(leftbox), lerow, false, false, BB_MARGIN);
- gtk_widget_show(lerow);
-
- linB = gtk_button_new_with_label("lin");
- gtk_button_set_relief(GTK_BUTTON(linB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(lerow), linB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(linB, "clicked", lin_button_pressed, NULL);
- gtk_widget_show(linB);
+ amp_button = gtk_button_new_with_label("amp");
+ gtk_button_set_relief(GTK_BUTTON(amp_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(rbrow), amp_button, true, true, BB_MARGIN);
+ SG_SIGNAL_CONNECT(amp_button, "clicked", amp_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(amp_button);
+#endif
+ gtk_widget_show(amp_button);
+
+ flt_button = gtk_button_new_with_label("flt");
+ gtk_button_set_relief(GTK_BUTTON(flt_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(rbrow), flt_button, true, true, BB_MARGIN);
+ SG_SIGNAL_CONNECT(flt_button, "clicked", flt_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(flt_button);
+#endif
+ gtk_widget_show(flt_button);
+
+ src_button = gtk_button_new_with_label("src");
+ gtk_button_set_relief(GTK_BUTTON(src_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(rbrow), src_button, true, true, BB_MARGIN);
+ SG_SIGNAL_CONNECT(src_button, "clicked", src_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(src_button);
+#endif
+ gtk_widget_show(src_button);
- expB = gtk_button_new_with_label("exp");
- gtk_button_set_relief(GTK_BUTTON(expB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(lerow), expB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(expB, "clicked", exp_button_pressed, NULL);
- gtk_widget_show(expB);
selrow = gtk_hbox_new(false, 0);
gtk_box_pack_start(GTK_BOX(leftbox), selrow, false, false, BB_MARGIN);
gtk_widget_show(selrow);
- selectionB = gtk_button_new_with_label("selection");
- gtk_button_set_relief(GTK_BUTTON(selectionB), GTK_RELIEF_HALF);
- gtk_box_pack_start(GTK_BOX(selrow), selectionB, true, true, BB_MARGIN);
- SG_SIGNAL_CONNECT(selectionB, "clicked", selection_button_pressed, NULL);
- gtk_widget_show(selectionB);
+ enved_selection_button = gtk_button_new_with_label("selection");
+ gtk_button_set_relief(GTK_BUTTON(enved_selection_button), GTK_RELIEF_HALF);
+ gtk_box_pack_start(GTK_BOX(selrow), enved_selection_button, true, true, BB_MARGIN);
+ SG_SIGNAL_CONNECT(enved_selection_button, "clicked", enved_selection_button_pressed, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(enved_selection_button);
+#endif
+ gtk_widget_show(enved_selection_button);
env_list = slist_new_with_title("envs:", leftbox, NULL, 0, BOX_PACK);
env_list->select_callback = env_browse_callback;
if (enved_all_envs_top() > 0) make_scrolled_env_list();
+
toprow = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(bottombox), toprow, false, false, 6);
+ gtk_box_pack_start(GTK_BOX(bottombox), toprow, false, false, 0);
gtk_widget_show(toprow);
bottomrow = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(bottombox), bottomrow, false, false, 4);
+ gtk_box_pack_start(GTK_BOX(bottombox), bottomrow, false, false, 0);
gtk_widget_show(bottomrow);
- nameL = gtk_label_new("amp env:");
- gtk_box_pack_start(GTK_BOX(toprow), nameL, false, false, 0);
- gtk_widget_show(nameL);
+ {
+ GtkWidget* sep;
+ sep = gtk_hseparator_new();
+ gtk_box_pack_end(GTK_BOX(DIALOG_CONTENT_AREA(enved_dialog)), sep, false, false, 8);
+ gtk_widget_show(sep);
+ }
+
+ #define LEFT_MARGIN 8
+
+ enved_name_label = gtk_label_new("amp env:");
+ widget_set_margin_left(enved_name_label, LEFT_MARGIN);
+ gtk_box_pack_start(GTK_BOX(toprow), enved_name_label, false, false, 0);
+ gtk_widget_show(enved_name_label);
- textL = snd_entry_new(toprow, WITH_WHITE_BACKGROUND);
- SG_SIGNAL_CONNECT(textL, "activate", text_field_activated, NULL);
+ enved_text_label = snd_entry_new_with_size(toprow, 28);
+ SG_SIGNAL_CONNECT(enved_text_label, "activate", text_field_activated, NULL);
- brktxtL = gtk_button_new_with_label(BLANK_LABEL);
- gtk_button_set_relief(GTK_BUTTON(brktxtL), GTK_RELIEF_NONE);
+ brktxtL = gtk_label_new(BLANK_LABEL);
gtk_box_pack_start(GTK_BOX(toprow), brktxtL, false, false, 6);
gtk_widget_show(brktxtL);
- clipB = gtk_check_button_new_with_label("clip");
- SG_SIGNAL_CONNECT(clipB, "toggled", clip_button_callback, NULL);
- gtk_box_pack_start(GTK_BOX(toprow), clipB, false, false, 4);
- gtk_widget_show(clipB);
- graphB = gtk_check_button_new_with_label("wave");
- SG_SIGNAL_CONNECT(graphB, "toggled", graph_button_callback, NULL);
- gtk_box_pack_start(GTK_BOX(toprow), graphB, false, false, 4);
- gtk_widget_show(graphB);
+ enved_dB_button = gtk_check_button_new_with_label("dB");
+ SG_SIGNAL_CONNECT(enved_dB_button, "toggled", enved_dB_button_callback, NULL);
+ gtk_box_pack_end(GTK_BOX(toprow), enved_dB_button, false, false, 4);
+ gtk_widget_show(enved_dB_button);
+
+ enved_graph_button = gtk_check_button_new_with_label("wave");
+ SG_SIGNAL_CONNECT(enved_graph_button, "toggled", enved_graph_button_callback, NULL);
+ gtk_box_pack_end(GTK_BOX(toprow), enved_graph_button, false, false, 4);
+ gtk_widget_show(enved_graph_button);
+
+ clip_button = gtk_check_button_new_with_label("clip");
+ SG_SIGNAL_CONNECT(clip_button, "toggled", clip_button_callback, NULL);
+ gtk_box_pack_end(GTK_BOX(toprow), clip_button, false, false, 4);
+ gtk_widget_show(clip_button);
- dBB = gtk_check_button_new_with_label("dB");
- SG_SIGNAL_CONNECT(dBB, "toggled", dB_button_callback, NULL);
- gtk_box_pack_start(GTK_BOX(toprow), dBB, false, false, 4);
- gtk_widget_show(dBB);
baseLabel = gtk_label_new("exp:");
- gtk_box_pack_start(GTK_BOX(bottomrow), baseLabel, false, false, 2);
+ widget_set_margin_left(baseLabel, LEFT_MARGIN);
+ gtk_box_pack_start(GTK_BOX(bottomrow), baseLabel, false, false, 4);
gtk_widget_show(baseLabel);
baseValue = gtk_label_new("1.000");
- gtk_box_pack_start(GTK_BOX(bottomrow), baseValue, false, false, 2);
+ gtk_box_pack_start(GTK_BOX(bottomrow), baseValue, false, false, 4);
gtk_widget_show(baseValue);
+ lerow = gtk_vbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(bottomrow), lerow, true, true, 8);
+ gtk_widget_show(lerow);
+
+ {
+ GtkWidget* sep;
+ sep = gtk_vseparator_new();
+ gtk_box_pack_start(GTK_BOX(lerow), sep, false, false, 8);
+ gtk_widget_show(sep);
+ }
+
baseAdj = (GtkAdjustment *)gtk_adjustment_new(0.5, 0.0, 1.0, 0.001, 0.01, .1);
baseScale = gtk_hscrollbar_new(GTK_ADJUSTMENT(baseAdj));
widget_modify_bg(baseScale, GTK_STATE_NORMAL, ss->position_color);
SG_SIGNAL_CONNECT(baseAdj, "value_changed", base_changed_callback, NULL);
- gtk_box_pack_start(GTK_BOX(bottomrow), baseScale, true, true, 4);
+ /* gtk_box_pack_start(GTK_BOX(bottomrow), baseScale, true, true, 4); */
+ gtk_box_pack_start(GTK_BOX(lerow), baseScale, true, true, 0);
gtk_widget_show(baseScale);
+
+ {
+ /* try to center the linear button */
+ GtkWidget *hr, *rb, *lb;
+
+ hr = gtk_hbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(lerow), hr, false, false, 4);
+ gtk_widget_show(hr);
+
+ rb = gtk_label_new("");
+ gtk_box_pack_start(GTK_BOX(hr), rb, true, true, 2);
+ gtk_widget_show(rb);
+
+ lb = gtk_label_new("");
+ gtk_box_pack_end(GTK_BOX(hr), lb, true, true, 2);
+ gtk_widget_show(lb);
+
+ lin_button = gtk_button_new_with_label("1.0");
+ gtk_box_pack_start(GTK_BOX(hr), lin_button, false, false, 4);
+ SG_SIGNAL_CONNECT(lin_button, "clicked", make_linear, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_center_button_style(lin_button);
+#endif
+ gtk_widget_show(lin_button);
+ }
+
orderAdj = (GtkAdjustment *)gtk_adjustment_new(20, 2, 100000, 2, 10, 0);
- orderL = gtk_spin_button_new(GTK_ADJUSTMENT(orderAdj), 0.0, 0);
- gtk_box_pack_end(GTK_BOX(bottomrow), orderL, false, false, 4);
- gtk_spin_button_set_numeric(GTK_SPIN_BUTTON(orderL), true);
+ enved_order_label = gtk_spin_button_new(GTK_ADJUSTMENT(orderAdj), 0.0, 0);
+ gtk_box_pack_end(GTK_BOX(bottomrow), enved_order_label, false, false, 4);
+ gtk_spin_button_set_numeric(GTK_SPIN_BUTTON(enved_order_label), true);
SG_SIGNAL_CONNECT(orderAdj, "value_changed", enved_filter_order_callback, NULL);
- SG_SIGNAL_CONNECT(orderL, "enter_notify_event", spin_button_focus_callback, NULL);
- SG_SIGNAL_CONNECT(orderL, "leave_notify_event", spin_button_unfocus_callback, NULL);
- gtk_widget_show(orderL);
-
- firB = gtk_button_new_with_label((FIR_p) ? "fir" : "fft");
- SG_SIGNAL_CONNECT(firB, "clicked", fir_button_pressed, NULL);
- gtk_box_pack_end(GTK_BOX(bottomrow), firB, false, false, 4);
- gtk_widget_show(firB);
+ SG_SIGNAL_CONNECT(enved_order_label, "enter_notify_event", spin_button_focus_callback, NULL);
+ SG_SIGNAL_CONNECT(enved_order_label, "leave_notify_event", spin_button_unfocus_callback, NULL);
+ gtk_widget_show(enved_order_label);
+
+ /* fir_button = gtk_button_new_with_label((is_FIR) ? "fir" : "fft"); */
+ /* SG_SIGNAL_CONNECT(eb, "clicked", fir_button_pressed, NULL); */
+ {
+ GtkWidget *eb;
+
+ eb = gtk_event_box_new();
+ gtk_box_pack_end(GTK_BOX(bottomrow), eb, false, false, 4);
+ widget_set_margin_left(eb, 8);
+ widget_modify_bg(eb, GTK_STATE_NORMAL, ss->basic_color);
+ gtk_widget_set_events(eb, GDK_BUTTON_PRESS_MASK);
+ SG_SIGNAL_CONNECT(eb, "button_press_event", fir_button_pressed, NULL);
+ gtk_widget_show(eb);
+
+ fir_button = gtk_label_new("fir");
+ gtk_container_add(GTK_CONTAINER(eb), fir_button);
+ gtk_widget_show(fir_button);
+ }
gtk_widget_show(mainform);
gtk_widget_show(enved_dialog);
axis = (axis_info *)calloc(1, sizeof(axis_info));
axis->ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- axis->ax->wn = WIDGET_TO_WINDOW(drawer);
- axis->ax->w = drawer;
+ axis->ax->wn = WIDGET_TO_WINDOW(enved_drawer);
+ axis->ax->w = enved_drawer;
axis->ax->gc = gc;
axis->ax->current_font = AXIS_NUMBERS_FONT(ss);
gray_ap = (axis_info *)calloc(1, sizeof(axis_info));
gray_ap->ax = (graphics_context *)calloc(1, sizeof(graphics_context));
gray_ap->graph_active = true;
- gray_ap->ax->wn = WIDGET_TO_WINDOW(drawer);
- gray_ap->ax->w = drawer;
+ gray_ap->ax->wn = WIDGET_TO_WINDOW(enved_drawer);
+ gray_ap->ax->w = enved_drawer;
gray_ap->ax->gc = ggc;
gray_ap->ax->current_font = AXIS_NUMBERS_FONT(ss);
- SG_SIGNAL_CONNECT(drawer, DRAW_SIGNAL, drawer_expose, NULL);
- SG_SIGNAL_CONNECT(drawer, "configure_event", drawer_resize, NULL);
- SG_SIGNAL_CONNECT(drawer, "button_press_event", drawer_button_press, NULL);
- SG_SIGNAL_CONNECT(drawer, "button_release_event", drawer_button_release, NULL);
- SG_SIGNAL_CONNECT(drawer, "motion_notify_event", drawer_button_motion, NULL);
+ SG_SIGNAL_CONNECT(enved_drawer, DRAW_SIGNAL, enved_drawer_expose, NULL);
+ SG_SIGNAL_CONNECT(enved_drawer, "configure_event", enved_drawer_resize, NULL);
+ SG_SIGNAL_CONNECT(enved_drawer, "button_press_event", enved_drawer_button_press, NULL);
+ SG_SIGNAL_CONNECT(enved_drawer, "button_release_event", enved_drawer_button_release, NULL);
+ SG_SIGNAL_CONNECT(enved_drawer, "motion_notify_event", enved_drawer_button_motion, NULL);
if (enved_all_envs_top() == 0)
- set_sensitive(showB, false);
- set_sensitive(revertB, false);
- set_sensitive(deleteB, false);
- set_sensitive(undoB, false);
- set_sensitive(redoB, false);
- set_sensitive(saveB, false);
+ set_sensitive(show_button, false);
+ set_sensitive(enved_revert_button, false);
+ set_sensitive(enved_undo_button, false);
+ set_sensitive(enved_redo_button, false);
+ set_sensitive(enved_save_button, false);
if (!(selection_is_active()))
- set_sensitive(selectionB, false);
+ set_sensitive(enved_selection_button, false);
- set_toggle_button(clipB, enved_clip_p(ss), false, NULL);
- set_toggle_button(graphB, enved_wave_p(ss), false, NULL);
- set_toggle_button(dBB, enved_in_dB(ss), false, NULL);
+ set_toggle_button(clip_button, enved_clipping(ss), false, NULL);
+ set_toggle_button(enved_graph_button, enved_with_wave(ss), false, NULL);
+ set_toggle_button(enved_dB_button, enved_in_dB(ss), false, NULL);
reflect_apply_state();
reflect_segment_state();
@@ -1212,13 +1211,12 @@ GtkWidget *create_envelope_editor(void)
set_dialog_widget(ENVED_DIALOG, enved_dialog);
- XEN_ADD_HOOK(ss->snd_open_file_hook, reflect_file_in_enved_w, "enved-file-open-handler", "enved dialog's file-open-hook handler");
- XEN_ADD_HOOK(ss->snd_selection_hook, enved_selection_handler_w, "enved-selection-handler", "enved dialog's selection-hook handler");
+ Xen_add_to_hook_list(ss->snd_open_file_hook, reflect_file_in_enved_w, "enved-file-open-handler", "enved dialog's file-open-hook handler");
}
else raise_dialog(enved_dialog);
- env_window_width = widget_width(drawer);
- env_window_height = widget_height(drawer);
+ env_window_width = widget_width(enved_drawer);
+ env_window_height = widget_height(enved_drawer);
active_channel = current_channel();
env_redisplay();
@@ -1226,10 +1224,10 @@ GtkWidget *create_envelope_editor(void)
}
-void set_enved_clip_p(bool val)
+void set_enved_clipping(bool val)
{
- in_set_enved_clip_p(val);
- if (enved_dialog) set_toggle_button(clipB, val, false, NULL);
+ in_set_enved_clipping(val);
+ if (enved_dialog) set_toggle_button(clip_button, val, false, NULL);
}
@@ -1246,17 +1244,17 @@ void set_enved_target(enved_target_t val)
}
-void set_enved_wave_p(bool val)
+void set_enved_with_wave(bool val)
{
- in_set_enved_wave_p(val);
- if (enved_dialog) set_toggle_button(graphB, val, false, NULL);
+ in_set_enved_with_wave(val);
+ if (enved_dialog) set_toggle_button(enved_graph_button, val, false, NULL);
}
void set_enved_in_dB(bool val)
{
in_set_enved_in_dB(val);
- if (enved_dialog) set_toggle_button(dBB, val, false, NULL);
+ if (enved_dialog) set_toggle_button(enved_dB_button, val, false, NULL);
}
@@ -1278,13 +1276,13 @@ void set_enved_filter_order(int order)
if ((order > 0) && (order < 2000))
{
if (order & 1)
- in_set_enved_filter_order(order + 1);
- else in_set_enved_filter_order(order);
+ {in_set_enved_filter_order(order + 1);}
+ else {in_set_enved_filter_order(order);}
if (enved_dialog)
{
- widget_int_to_text(orderL, enved_filter_order(ss));
+ widget_int_to_text(enved_order_label, enved_filter_order(ss));
if ((enved_target(ss) == ENVED_SPECTRUM) &&
- (enved_wave_p(ss)) &&
+ (enved_with_wave(ss)) &&
(!showing_all_envs))
env_redisplay();
}
@@ -1292,11 +1290,11 @@ void set_enved_filter_order(int order)
}
-static void enved_reflect_selection(bool on)
+void enved_reflect_selection(bool on)
{
if ((enved_dialog) && (!within_selection_src))
{
- set_sensitive(selectionB, on);
+ set_sensitive(enved_selection_button, on);
if ((apply_to_selection) && (!on))
{
apply_to_selection = false;
@@ -1306,9 +1304,9 @@ static void enved_reflect_selection(bool on)
{
apply_to_selection = true;
}
- widget_modify_bg(selectionB, GTK_STATE_NORMAL, (apply_to_selection) ? ss->yellow : ss->basic_color);
+ widget_modify_bg(enved_selection_button, GTK_STATE_NORMAL, (apply_to_selection) ? ss->yellow : ss->basic_color);
if ((enved_target(ss) != ENVED_SPECTRUM) &&
- (enved_wave_p(ss)) &&
+ (enved_with_wave(ss)) &&
(!showing_all_envs))
env_redisplay();
}
@@ -1317,32 +1315,31 @@ static void enved_reflect_selection(bool on)
void color_enved_waveform(color_info *pix)
{
- ss->enved_waveform_color = pix;
if (enved_dialog)
{
gc_set_foreground(ggc, pix);
- if ((enved_wave_p(ss)) && (enved_dialog)) env_redisplay();
+ if ((enved_with_wave(ss)) && (enved_dialog)) env_redisplay();
}
}
-static XEN g_enved_envelope(void)
+static Xen g_enved_envelope(void)
{
#define H_enved_envelope "(" S_enved_envelope "): current envelope editor displayed (active) envelope"
return(env_to_xen(active_env));
}
-static XEN g_set_enved_envelope(XEN e)
+static Xen g_set_enved_envelope(Xen e)
{
- XEN_ASSERT_TYPE(XEN_LIST_P(e) || XEN_STRING_P(e) || XEN_SYMBOL_P(e), e, XEN_ONLY_ARG, S_setB S_enved_envelope, "a list, symbol, or string");
+ Xen_check_type(Xen_is_list(e) || Xen_is_string(e) || Xen_is_symbol(e), e, 1, S_set S_enved_envelope, "a list, symbol, or string");
if (active_env) active_env = free_env(active_env);
- if ((XEN_STRING_P(e)) || (XEN_SYMBOL_P(e)))
- active_env = name_to_env((XEN_STRING_P(e)) ? XEN_TO_C_STRING(e) : XEN_SYMBOL_TO_C_STRING(e));
+ if ((Xen_is_string(e)) || (Xen_is_symbol(e)))
+ active_env = name_to_env((Xen_is_string(e)) ? Xen_string_to_C_string(e) : Xen_symbol_to_C_string(e));
else active_env = xen_to_env(e);
- if ((!active_env) && (!(XEN_LIST_P(e))))
- XEN_ERROR(NO_SUCH_ENVELOPE,
- XEN_LIST_2(C_TO_XEN_STRING(S_setB S_enved_envelope ": bad envelope arg: ~A"),
+ if ((!active_env) && (!(Xen_is_list(e))))
+ Xen_error(NO_SUCH_ENVELOPE,
+ Xen_list_2(C_string_to_Xen_string(S_set S_enved_envelope ": bad envelope arg: ~A"),
e));
if (enved_dialog)
env_redisplay();
@@ -1350,40 +1347,33 @@ static XEN g_set_enved_envelope(XEN e)
}
-static XEN g_enved_filter(void)
+static Xen g_enved_filter(void)
{
- #define H_enved_filter "(" S_enved_filter "): envelope editor FIR/FFT filter choice (#t: FIR)"
- return(C_TO_XEN_BOOLEAN(FIR_p));
+ #define H_enved_filter "(" S_enved_filter "): envelope editor FIR/FFT filter choice (" PROC_TRUE ": FIR)"
+ return(C_bool_to_Xen_boolean(is_FIR));
}
-static XEN g_set_enved_filter(XEN type)
+static Xen g_set_enved_filter(Xen type)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(type), type, XEN_ONLY_ARG, S_setB S_enved_filter, "boolean");
- FIR_p = XEN_TO_C_BOOLEAN(type);
- if (firB)
- set_button_label(firB, (FIR_p) ? "fir" : "fft");
+ Xen_check_type(Xen_is_boolean(type), type, 1, S_set S_enved_filter, "boolean");
+ is_FIR = Xen_boolean_to_C_bool(type);
+ if (fir_button)
+ gtk_label_set_text(GTK_LABEL(fir_button), (is_FIR) ? "fir" : "fft");
return(type);
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_enved_filter_w, g_enved_filter)
-XEN_NARGIFY_1(g_set_enved_filter_w, g_set_enved_filter)
-XEN_NARGIFY_0(g_enved_envelope_w, g_enved_envelope)
-XEN_NARGIFY_1(g_set_enved_envelope_w, g_set_enved_envelope)
-#else
-#define g_enved_filter_w g_enved_filter
-#define g_set_enved_filter_w g_set_enved_filter
-#define g_enved_envelope_w g_enved_envelope
-#define g_set_enved_envelope_w g_set_enved_envelope
-#endif
+Xen_wrap_no_args(g_enved_filter_w, g_enved_filter)
+Xen_wrap_1_arg(g_set_enved_filter_w, g_set_enved_filter)
+Xen_wrap_no_args(g_enved_envelope_w, g_enved_envelope)
+Xen_wrap_1_arg(g_set_enved_envelope_w, g_set_enved_envelope)
void g_init_gxenv(void)
{
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_filter, g_enved_filter_w, H_enved_filter,
- S_setB S_enved_filter, g_set_enved_filter_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_envelope, g_enved_envelope_w, H_enved_envelope,
- S_setB S_enved_envelope, g_set_enved_envelope_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_filter, g_enved_filter_w, H_enved_filter,
+ S_set S_enved_filter, g_set_enved_filter_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_envelope, g_enved_envelope_w, H_enved_envelope,
+ S_set S_enved_envelope, g_set_enved_envelope_w, 0, 0, 1, 0);
}
diff --git a/snd-gfft.c b/snd-gfft.c
index 1627392..cfd642a 100644
--- a/snd-gfft.c
+++ b/snd-gfft.c
@@ -7,7 +7,7 @@
*/
-slist *transform_list = NULL, *size_list = NULL, *window_list = NULL, *wavelet_list = NULL;
+static slist *transform_list = NULL, *size_list = NULL, *window_list = NULL, *wavelet_list = NULL;
static GtkWidget *transform_dialog = NULL; /* main dialog shell */
static GtkWidget *outer_table, *db_button, *peaks_button, *logfreq_button, *sono_button, *spectro_button, *normal_fft_button, *phases_button;
static GtkWidget *normalize_button, *selection_button;
@@ -15,7 +15,7 @@ static GtkWidget *alpha_label = NULL, *beta_label = NULL, *graph_drawer = NULL,
static GtkAdjustment *beta_adj, *alpha_adj, *spectrum_start_adj, *spectrum_end_adj;
static GtkWidget *spectrum_start_scale, *spectrum_end_scale;
static GtkWidget *db_txt, *peaks_txt, *lf_txt;
-static gc_t *gc = NULL, *fgc = NULL;
+static gc_t *fft_gc = NULL, *fgc = NULL;
static bool ignore_callbacks;
#define NUM_TRANSFORM_SIZES 15
@@ -63,7 +63,7 @@ static void graph_redisplay(void)
else ax = axis_ap->ax;
ax->wn = WIDGET_TO_WINDOW(graph_drawer);
ax->w = graph_drawer;
- ax->gc = gc;
+ ax->gc = fft_gc;
ax->current_font = TINY_FONT(ss); /* we're right on the edge; this changes if user makes dialog bigger */
axis_ap->xmin = 0.0;
axis_ap->xmax = 1.0;
@@ -71,7 +71,7 @@ static void graph_redisplay(void)
axis_ap->x0 = 0.0;
axis_ap->x1 = 1.0;
- ss->cr = MAKE_CAIRO(ax->wn);
+ ss->cr = make_cairo(ax->wn);
cairo_push_group(ss->cr);
/* erase previous */
@@ -108,7 +108,7 @@ static void graph_redisplay(void)
make_axes_1(axis_ap, X_AXIS_IN_SECONDS, 1 /* "srate" */, SHOW_ALL_AXES, NOT_PRINTING, WITH_X_AXIS, NO_GRID, WITH_LINEAR_AXES, grid_density(ss));
- ax->gc = gc;
+ ax->gc = fft_gc;
ix1 = grf_x(0.0, axis_ap);
iy1 = grf_y(graph_data[0], axis_ap);
xincr = 1.0 / (mus_float_t)GRAPH_SIZE;
@@ -139,7 +139,7 @@ static void graph_redisplay(void)
cairo_pop_group_to_source(ss->cr);
cairo_paint(ss->cr);
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
}
@@ -237,19 +237,21 @@ void set_wavelet_type(int val)
/* ---------------- window choice ---------------- */
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
/* this won't work in gtk2 because it requires the alpha field (GdkRGBA not defined) */
static color_t not_so_black;
static void alpha_beta_alpha(mus_fft_window_t val)
{
+#if (!GTK_CHECK_VERSION(3, 16, 0))
if (fft_window_beta_in_use(val))
- gtk_widget_override_color(beta_label, GTK_STATE_NORMAL, (GdkRGBA *)(ss->black));
- else gtk_widget_override_color(beta_label, GTK_STATE_NORMAL, (GdkRGBA *)not_so_black);
+ gtk_widget_override_color(beta_label, GTK_STATE_FLAG_ACTIVE, (GdkRGBA *)(ss->black));
+ else gtk_widget_override_color(beta_label, GTK_STATE_FLAG_ACTIVE, (GdkRGBA *)not_so_black);
if (fft_window_alpha_in_use(val))
- gtk_widget_override_color(alpha_label, GTK_STATE_NORMAL, (GdkRGBA *)(ss->black));
- else gtk_widget_override_color(alpha_label, GTK_STATE_NORMAL, (GdkRGBA *)not_so_black);
+ gtk_widget_override_color(alpha_label, GTK_STATE_FLAG_ACTIVE, (GdkRGBA *)(ss->black));
+ else gtk_widget_override_color(alpha_label, GTK_STATE_FLAG_ACTIVE, (GdkRGBA *)not_so_black);
+#endif
}
#endif
@@ -262,7 +264,7 @@ static void window_browse_callback(const char *name, int row, void *data)
gtk_label_set_text(GTK_LABEL(fft_window_label), mus_fft_window_name(fft_window(ss)));
get_fft_window_data();
graph_redisplay();
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
alpha_beta_alpha(fft_window(ss));
#endif
}
@@ -280,7 +282,7 @@ void set_fft_window(mus_fft_window_t val)
gtk_label_set_text(GTK_LABEL(fft_window_label), mus_fft_window_name(val));
get_fft_window_data();
graph_redisplay();
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
alpha_beta_alpha(val);
#endif
}
@@ -316,14 +318,14 @@ void make_transform_type_list(void)
num = max_transform_type();
transform_names = (const char **)calloc(num, sizeof(char *));
for (i = 0, j = 0; i < num; i++)
- if (transform_p(i))
+ if (is_transform(i))
{
set_transform_position(i, j);
transform_names[j++] = transform_name(i);
}
if (!transform_list)
{
- transform_list = slist_new_with_title_and_table_data("type", outer_table, transform_names, j, TABLE_ATTACH, 0, 3, 0, 3);
+ transform_list = slist_new_with_title_and_table_data("type", outer_table, transform_names, j, TABLE_ATTACH, 0, 3, 0, 4);
transform_list->select_callback = transform_browse_callback;
}
else
@@ -340,7 +342,7 @@ void make_transform_type_list(void)
void set_transform_type(int val)
{
- if (transform_p(val))
+ if (is_transform(val))
{
if (!(ss->graph_hook_active)) for_each_chan(force_fft_clear);
in_set_transform_type(val);
@@ -421,7 +423,7 @@ static void map_show_transform_peaks(chan_info *cp, bool value)
static void peaks_callback(GtkWidget *w, gpointer context)
{
- bool val = false;
+ bool val;
val = (bool)(TOGGLE_BUTTON_ACTIVE(w));
in_set_show_transform_peaks(val);
for_each_chan_with_bool(map_show_transform_peaks, val);
@@ -826,7 +828,7 @@ static void dismiss_transform_callback(GtkWidget *w, gpointer context)
static void color_orientation_transform_callback(GtkWidget *w, gpointer context)
{
- start_color_orientation_dialog(true);
+ make_color_orientation_dialog(true);
}
@@ -860,7 +862,7 @@ gboolean spin_button_unfocus_callback(GtkWidget *w, GdkEventCrossing *ev, gpoint
#define RIGHT_SEP_SIZE 10
-GtkWidget *fire_up_transform_dialog(bool managed)
+GtkWidget *make_transform_dialog(bool managed)
{
bool need_callback = false, need_moveto = true;
if (!transform_dialog)
@@ -869,15 +871,17 @@ GtkWidget *fire_up_transform_dialog(bool managed)
GtkWidget *display_frame, *help_button, *dismiss_button;
GtkWidget *color_button;
GtkWidget *se_box, *se_frame, *se_label;
- GtkWidget *alpha_box, *beta_box;
GtkWidget *end_box, *end_label, *start_box, *start_label;
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
not_so_black = rgb_to_color(0.0, 0.0, 0.0);
not_so_black->alpha = 0.5;
#endif
transform_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(transform_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
gtk_widget_set_name(transform_dialog, "fft_dialog");
SG_SIGNAL_CONNECT(transform_dialog, "delete_event", delete_transform_dialog, NULL);
gtk_window_set_title(GTK_WINDOW(transform_dialog), "Transform Options");
@@ -886,19 +890,19 @@ GtkWidget *fire_up_transform_dialog(bool managed)
gtk_widget_realize(transform_dialog);
/* gtk_window_resize(GTK_WINDOW(transform_dialog), 400, 500); */
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
+ help_button = gtk_dialog_add_button(GTK_DIALOG(transform_dialog), "Help", GTK_RESPONSE_NONE);
+ dismiss_button = gtk_dialog_add_button(GTK_DIALOG(transform_dialog), "Go away", GTK_RESPONSE_NONE);
+ color_button = gtk_dialog_add_button(GTK_DIALOG(transform_dialog), "Color/Orientation", GTK_RESPONSE_NONE);
- dismiss_button = gtk_button_new_from_stock(GTK_STOCK_QUIT);
+ gtk_widget_set_name(help_button, "dialog_button");
gtk_widget_set_name(dismiss_button, "dialog_button");
- set_stock_button_label(dismiss_button, "Go Away");
-
- color_button = sg_button_new_from_stock_with_label("Color/Orientation", GTK_STOCK_SELECT_COLOR);
gtk_widget_set_name(color_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(transform_dialog)), color_button, false, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(transform_dialog)), dismiss_button, false, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(transform_dialog)), help_button, false, true, 10);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(dismiss_button);
+ add_highlight_button_style(color_button);
+ add_highlight_button_style(help_button);
+#endif
SG_SIGNAL_CONNECT(dismiss_button, "clicked", dismiss_transform_callback, NULL);
SG_SIGNAL_CONNECT(color_button, "clicked", color_orientation_transform_callback, NULL);
@@ -908,7 +912,7 @@ GtkWidget *fire_up_transform_dialog(bool managed)
gtk_widget_show(color_button);
gtk_widget_show(help_button);
- outer_table = gtk_table_new(8, 11, false); /* rows cols */
+ outer_table = gtk_table_new(16, 11, false); /* rows cols */
gtk_container_add(GTK_CONTAINER(DIALOG_CONTENT_AREA(transform_dialog)), outer_table);
gtk_table_set_row_spacings(GTK_TABLE(outer_table), 16);
gtk_table_set_col_spacings(GTK_TABLE(outer_table), 16);
@@ -925,12 +929,12 @@ GtkWidget *fire_up_transform_dialog(bool managed)
make_transform_type_list();
/* SIZE */
- size_list = slist_new_with_title_and_table_data("size", outer_table, transform_size_names, NUM_TRANSFORM_SIZES, TABLE_ATTACH, 3, 6, 0, 3);
+ size_list = slist_new_with_title_and_table_data("size", outer_table, transform_size_names, NUM_TRANSFORM_SIZES, TABLE_ATTACH, 3, 6, 0, 6);
size_list->select_callback = size_browse_callback;
/* DISPLAY */
display_frame = gtk_frame_new(NULL);
- gtk_table_attach_defaults(GTK_TABLE(outer_table), display_frame, 6, 11, 0, 4);
+ gtk_table_attach_defaults(GTK_TABLE(outer_table), display_frame, 6, 11, 0, 7);
gtk_frame_set_shadow_type(GTK_FRAME(display_frame), GTK_SHADOW_IN);
{
@@ -939,6 +943,9 @@ GtkWidget *fire_up_transform_dialog(bool managed)
GtkAdjustment *pk_vals, *db_vals, *lf_vals;
GtkWidget *vb, *sep1, *sep2;
+ #define DISPLAY_MARGIN 2
+ #define LEFT_MARGIN 8
+
vbb = gtk_vbox_new(false, 6);
gtk_container_add(GTK_CONTAINER(display_frame), vbb);
gtk_widget_show(vbb);
@@ -955,53 +962,71 @@ GtkWidget *fire_up_transform_dialog(bool managed)
gtk_container_add(GTK_CONTAINER(hb), buttons);
normal_fft_button = gtk_radio_button_new_with_label(NULL, "single transform");
- gtk_box_pack_start(GTK_BOX(buttons), normal_fft_button, false, false, 2);
+ widget_set_margin_left(normal_fft_button, LEFT_MARGIN);
+ add_check_button_style(normal_fft_button);
+ gtk_box_pack_start(GTK_BOX(buttons), normal_fft_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(normal_fft_button);
SG_SIGNAL_CONNECT(normal_fft_button, "clicked", normal_fft_callback, NULL);
sono_button = gtk_radio_button_new_with_label(gtk_radio_button_get_group(GTK_RADIO_BUTTON(normal_fft_button)), "sonogram");
- gtk_box_pack_start(GTK_BOX(buttons), sono_button, false, false, 2);
+ widget_set_margin_left(sono_button, LEFT_MARGIN);
+ add_check_button_style(sono_button);
+ gtk_box_pack_start(GTK_BOX(buttons), sono_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(sono_button);
SG_SIGNAL_CONNECT(sono_button, "clicked", sonogram_callback, NULL);
spectro_button = gtk_radio_button_new_with_label(gtk_radio_button_get_group(GTK_RADIO_BUTTON(normal_fft_button)), "spectrogram");
- gtk_box_pack_start(GTK_BOX(buttons), spectro_button, false, false, 2);
+ widget_set_margin_left(spectro_button, LEFT_MARGIN);
+ add_check_button_style(spectro_button);
+ gtk_box_pack_start(GTK_BOX(buttons), spectro_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(spectro_button);
SG_SIGNAL_CONNECT(spectro_button, "clicked", spectrogram_callback, NULL);
peaks_button = gtk_check_button_new_with_label("peaks");
- gtk_box_pack_start(GTK_BOX(buttons), peaks_button, false, false, 2);
+ widget_set_margin_left(peaks_button, LEFT_MARGIN);
+ add_check_button_style(peaks_button);
+ gtk_box_pack_start(GTK_BOX(buttons), peaks_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(peaks_button);
SG_SIGNAL_CONNECT(peaks_button, "toggled", peaks_callback, NULL);
db_button = gtk_check_button_new_with_label("dB");
- gtk_box_pack_start(GTK_BOX(buttons), db_button, false, false, 2);
+ widget_set_margin_left(db_button, LEFT_MARGIN);
+ add_check_button_style(db_button);
+ gtk_box_pack_start(GTK_BOX(buttons), db_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(db_button);
SG_SIGNAL_CONNECT(db_button, "toggled", db_callback, NULL);
logfreq_button = gtk_check_button_new_with_label("log freq");
- gtk_box_pack_start(GTK_BOX(buttons), logfreq_button, false, false, 2);
+ widget_set_margin_left(logfreq_button, LEFT_MARGIN);
+ add_check_button_style(logfreq_button);
+ gtk_box_pack_start(GTK_BOX(buttons), logfreq_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(logfreq_button);
SG_SIGNAL_CONNECT(logfreq_button, "toggled", logfreq_callback, NULL);
normalize_button = gtk_check_button_new_with_label("normalize");
- gtk_box_pack_start(GTK_BOX(buttons), normalize_button, false, false, 2);
+ widget_set_margin_left(normalize_button, LEFT_MARGIN);
+ add_check_button_style(normalize_button);
+ gtk_box_pack_start(GTK_BOX(buttons), normalize_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(normalize_button);
SG_SIGNAL_CONNECT(normalize_button, "toggled", normalize_callback, NULL);
selection_button = gtk_check_button_new_with_label("selection");
- gtk_box_pack_start(GTK_BOX(buttons), selection_button, false, false, 2);
+ widget_set_margin_left(selection_button, LEFT_MARGIN);
+ add_check_button_style(selection_button);
+ gtk_box_pack_start(GTK_BOX(buttons), selection_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(selection_button);
SG_SIGNAL_CONNECT(selection_button, "toggled", selection_callback, NULL);
phases_button = gtk_check_button_new_with_label("with phases");
- gtk_box_pack_end(GTK_BOX(buttons), phases_button, false, false, 2);
+ widget_set_margin_left(phases_button, LEFT_MARGIN);
+ add_check_button_style(phases_button);
+ gtk_box_pack_end(GTK_BOX(buttons), phases_button, false, false, DISPLAY_MARGIN);
gtk_widget_show(phases_button);
SG_SIGNAL_CONNECT(phases_button, "toggled", phases_callback, NULL);
vb = gtk_vbox_new(false, 0);
- gtk_container_add(GTK_CONTAINER(hb), vb);
+ gtk_container_add(GTK_CONTAINER(hb), vb);
pk_lab = snd_gtk_highlight_label_new("max peaks");
gtk_box_pack_start(GTK_BOX(vb), pk_lab, false, false, 0);
@@ -1058,21 +1083,22 @@ GtkWidget *fire_up_transform_dialog(bool managed)
/* WINDOWS */
- window_list = slist_new_with_title_and_table_data("window", outer_table, (const char **)mus_fft_window_names(), MUS_NUM_FFT_WINDOWS, TABLE_ATTACH, 0, 3, 3, 6);
+ window_list = slist_new_with_title_and_table_data("window", outer_table, (const char **)mus_fft_window_names(), MUS_NUM_FFT_WINDOWS, TABLE_ATTACH, 0, 3, 6, 12);
window_list->select_callback = window_browse_callback;
/* WAVELETS */
- wavelet_list = slist_new_with_title_and_table_data("wavelet", outer_table, (const char **)wavelet_names(), NUM_WAVELETS, TABLE_ATTACH, 3, 6, 3, 6);
+ wavelet_list = slist_new_with_title_and_table_data("wavelet", outer_table, (const char **)wavelet_names(), NUM_WAVELETS, TABLE_ATTACH, 3, 6, 6, 12);
wavelet_list->select_callback = wavelet_browse_callback;
/* ALPHA/BETA */
{
+ GtkWidget *alpha_box, *beta_box;
GtkWidget *alpha_scale, *beta_scale, *ab_box, *ab_frame, *ab_label;
ab_frame = gtk_frame_new(NULL);
- gtk_table_attach_defaults(GTK_TABLE(outer_table), ab_frame, 0, 6, 6, 7);
+ gtk_table_attach_defaults(GTK_TABLE(outer_table), ab_frame, 0, 6, 12, 14);
gtk_frame_set_shadow_type(GTK_FRAME(ab_frame), GTK_SHADOW_IN);
ab_box = gtk_vbox_new(false, 2);
@@ -1088,7 +1114,7 @@ GtkWidget *fire_up_transform_dialog(bool managed)
gtk_widget_show(alpha_box);
alpha_label = gtk_label_new("alpha: ");
- gtk_box_pack_start(GTK_BOX(alpha_box), alpha_label, false, false, 1);
+ gtk_box_pack_start(GTK_BOX(alpha_box), alpha_label, false, false, 8);
gtk_widget_show(alpha_label);
alpha_adj = (GtkAdjustment *)gtk_adjustment_new(0.0, 0.0, 1.01, 0.001, 0.01, .01);
@@ -1110,7 +1136,7 @@ GtkWidget *fire_up_transform_dialog(bool managed)
beta_label = gtk_label_new("beta: ");
- gtk_box_pack_start(GTK_BOX(beta_box), beta_label, false, false, 1);
+ gtk_box_pack_start(GTK_BOX(beta_box), beta_label, false, false, 8);
gtk_widget_show(beta_label);
beta_adj = (GtkAdjustment *)gtk_adjustment_new(0.0, 0.0, 1.01, 0.001, 0.01, .01);
@@ -1135,7 +1161,7 @@ GtkWidget *fire_up_transform_dialog(bool managed)
/* SPECTRUM_START/END */
se_frame = gtk_frame_new(NULL);
- gtk_table_attach_defaults(GTK_TABLE(outer_table), se_frame, 0, 6, 7, 8);
+ gtk_table_attach_defaults(GTK_TABLE(outer_table), se_frame, 0, 6, 14, 16);
gtk_frame_set_shadow_type(GTK_FRAME(se_frame), GTK_SHADOW_IN);
se_box = gtk_vbox_new(false, 2);
@@ -1150,7 +1176,7 @@ GtkWidget *fire_up_transform_dialog(bool managed)
gtk_widget_show(start_box);
start_label = gtk_label_new("start: ");
- gtk_box_pack_start(GTK_BOX(start_box), start_label, false, false, 1);
+ gtk_box_pack_start(GTK_BOX(start_box), start_label, false, false, 8);
gtk_widget_show(start_label);
spectrum_start_adj = (GtkAdjustment *)gtk_adjustment_new(0.0, 0.0, 1.01, 0.001, 0.01, .01);
@@ -1171,7 +1197,7 @@ GtkWidget *fire_up_transform_dialog(bool managed)
gtk_widget_show(end_box);
end_label = gtk_label_new("end: ");
- gtk_box_pack_start(GTK_BOX(end_box), end_label, false, false, 1);
+ gtk_box_pack_start(GTK_BOX(end_box), end_label, false, false, 8);
gtk_widget_show(end_label);
spectrum_end_adj = (GtkAdjustment *)gtk_adjustment_new(0.0, 0.0, 1.01, 0.001, 0.01, .01);
@@ -1198,7 +1224,7 @@ GtkWidget *fire_up_transform_dialog(bool managed)
GtkWidget *graph_frame, *g_vbox;
graph_frame = gtk_frame_new(NULL);
- gtk_table_attach_defaults(GTK_TABLE(outer_table), graph_frame, 6, 11, 4, 8);
+ gtk_table_attach_defaults(GTK_TABLE(outer_table), graph_frame, 6, 11, 7, 16);
gtk_frame_set_label_align(GTK_FRAME(graph_frame), 0.5, 0.0);
gtk_frame_set_shadow_type(GTK_FRAME(graph_frame), GTK_SHADOW_IN);
@@ -1218,9 +1244,9 @@ GtkWidget *fire_up_transform_dialog(bool managed)
gc_set_background(fgc, ss->white);
gc_set_foreground(fgc, ss->enved_waveform_color);
- gc = gc_new();
- gc_set_background(gc, ss->white);
- gc_set_foreground(gc, ss->black);
+ fft_gc = gc_new();
+ gc_set_background(fft_gc, ss->white);
+ gc_set_foreground(fft_gc, ss->black);
gtk_widget_show(graph_drawer);
gtk_widget_show(graph_frame);
@@ -1244,7 +1270,7 @@ GtkWidget *fire_up_transform_dialog(bool managed)
if (fft_window_alpha(ss) != 0.0) ADJUSTMENT_SET_VALUE(alpha_adj, fft_window_alpha(ss));
if (fft_window_beta(ss) != 0.0) ADJUSTMENT_SET_VALUE(beta_adj, fft_window_beta(ss));
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
alpha_beta_alpha(fft_window(ss));
#endif
need_callback = true;
@@ -1284,7 +1310,6 @@ GtkWidget *fire_up_transform_dialog(bool managed)
get_fft_window_data();
SG_SIGNAL_CONNECT(graph_drawer, DRAW_SIGNAL, graph_expose_callback, NULL);
SG_SIGNAL_CONNECT(graph_drawer, "configure_event", graph_configure_callback, NULL);
- need_callback = false;
}
return(transform_dialog);
diff --git a/snd-gfile.c b/snd-gfile.c
index 726a659..81ffa86 100644
--- a/snd-gfile.c
+++ b/snd-gfile.c
@@ -9,97 +9,161 @@
File:Edit-Header
File:New
Info and Raw
- View:Files
+ View:Files (replaced)
*/
-/* if icons do not get displayed, check the system preferences menu+toolbar dialog */
-
-/* ---------------- file selector replacement ---------------- */
-
-typedef struct fsb {
-
- /* base dialog */
- GtkWidget *dialog, *filter_text, *filter_label, *just_sounds_button;
- GtkWidget *file_label, *file_text, *ok_button, *mkdir_button, *cancel_button, *help_button, *extract_button;
- GtkWidget *panes, *dirs_menu, *files_menu;
-
- char *directory_name, *file_name;
- slist *directory_list, *file_list;
- void (*file_select_callback)(const char *filename, void *data);
- void *file_select_data;
- void (*directory_select_callback)(const char *filename, void *data);
- void *directory_select_data;
+#define HAVE_G_FILE_MONITOR_DIRECTORY 1 /* (GLIB_CHECK_VERSION(2, 18, 1) but it might be much older */
+#define WITH_SKETCH 1 /* (!GTK_CHECK_VERSION(3, 0, 0)) see below */
+
+/* if thumbnail graph display is too slow: save the points? split the idler? g_source_remove if overlap?
+ *
+ * In gtk2, if we have a file selected, then some other process writes a file in the
+ * current directory (emacs autosaving), the file chooser gets confused as
+ * to what is selected! So we can't get the selected filename except immediately upon
+ * "selection-changed" and even then we're asking for trouble.
+ *
+ * In gtk3, each time we reopen the chooser, it starts all the way back at the useless "recently used"!
+ * We can't use gtk_..._set|select_filename -- the function is simply ignored!
+ * so currently we never hide the dialog.
+ * And if we resize the dialog, a hand cursor appears, and the next thing we know we're moving the dialog itself!
+ * And valgrind reports a million invalid reads in gtk's code!
+ * And the sketch gets an incomprehensible cairo error
+ * this apparently happens because our "signal-changed" callback takes too long to draw a long sound's graph!
+ * but making it idle does not fully fix the problem -- we have to save the graph points and rescale directly.
+ *
+ * 3.10 will have gtk_file_chooser_get_current_name
+ */
- /* fam stuff */
- bool reread_directory;
- char *last_dir;
- dir_info *current_files;
- fam_info *directory_watcher;
- int filter_choice, sorter_choice;
+/* we can find the embedded tree view:
+
+ (define* (traveler w (spaces 0))
+ (gtk_container_foreach (GTK_CONTAINER w)
+ (lambda (w1 d)
+ (do ((i 0 (+ i 1)))
+ ((= i spaces))
+ (format #t " "))
+ (format #t "~A " (gtk_widget_get_name w1))
+ (if (GTK_IS_LABEL w1)
+ (format #t "~A~%" (gtk_label_get_text (GTK_LABEL w1)))
+ (if (GTK_IS_BUTTON w1)
+ (format #t "~A~%" (gtk_button_get_label (GTK_BUTTON w1)))
+ (if (GTK_IS_ENTRY w1)
+ (format #t "~A~%" (gtk_entry_get_text (GTK_ENTRY w1)))
+ (begin
+ (newline)
+ (if (GTK_IS_CONTAINER w1)
+ (traveler w1 (+ spaces 2))))))))))
+
+ (traveler (open-file-dialog))
+
+* now how to get at the sidebar and remove "recently used"? or change the row-colors in gtk3?
+* no way that I can find...
+* in 3.12 they've added gtk_places_sidebar_set_local_only, but it's not clear how to get at this thing
+* and it probably isn't what we want anyway.
+*/
- /* popup info */
- GtkWidget **file_dir_items, **file_list_items;
- int file_list_items_size;
- dirpos_list *dir_list;
-} fsb;
-#define NO_MATCHING_FILES "[no matching files]"
+/* ---------------------------------------- file monitor ---------------------------------------- */
-static char *fsb_filter_text(fsb *fs)
-{
- return((char *)gtk_entry_get_text(GTK_ENTRY(fs->filter_text)));
-}
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+static void cleanup_new_file_watcher(void);
+static void cleanup_edit_header_watcher(void);
-static void fsb_filter_set_text_with_directory(fsb *fs, const char *filter)
+void cleanup_file_monitor(void)
{
- char *name;
- int cur_dir_len;
- cur_dir_len = mus_strlen(fs->directory_name);
- name = (char *)calloc(cur_dir_len + 3, sizeof(char));
- mus_snprintf(name, cur_dir_len + 3, "%s%s", fs->directory_name, filter);
- gtk_entry_set_text(GTK_ENTRY(fs->filter_text), name);
- free(name);
+ cleanup_edit_header_watcher();
+ cleanup_new_file_watcher();
+ ss->file_monitor_ok = false;
}
-
-static char *fsb_file_text(fsb *fs)
+void *unmonitor_file(void *watcher)
{
- return((char *)gtk_entry_get_text(GTK_ENTRY(fs->file_text)));
+ if (G_IS_FILE_MONITOR(watcher))
+ g_file_monitor_cancel((GFileMonitor *)watcher);
+ return(NULL);
}
-
-static void fsb_file_set_text(fsb *fs, const char *file)
+static void *unmonitor_directory(void *watcher)
{
- if (fs->file_name) free(fs->file_name);
- fs->file_name = mus_strdup(file);
- gtk_entry_set_text(GTK_ENTRY(fs->file_text), fs->file_name);
+ if (G_IS_FILE_MONITOR(watcher))
+ g_file_monitor_cancel((GFileMonitor *)watcher);
+ return(NULL);
}
-#if HAVE_FAM
-static void force_directory_reread(fsb *fs);
-static void watch_current_directory_contents(struct fam_info *famp, FAMEvent *fe)
+static void sp_file_changed(GFileMonitor *mon, GFile *file, GFile *other, GFileMonitorEvent ev, gpointer data)
{
- switch (fe->code)
+ snd_info *sp = (snd_info *)data;
+ if (sp->writing) return;
+
+ switch (ev)
{
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- if ((!(just_sounds(ss))) ||
- (sound_file_p(fe->filename)))
+ case G_FILE_MONITOR_EVENT_CHANGED:
+ /* this includes cp overwriting old etc */
+ if (file_write_date(sp->filename) != sp->write_date) /* otherwise chmod? */
+ {
+ sp->need_update = true;
+ if (auto_update(ss))
+ snd_update(sp);
+ else start_bomb(sp);
+ }
+#ifndef _MSC_VER
+ else
{
- fsb *fs = (fsb *)(famp->data);
- fs->reread_directory = true;
- if ((fs->dialog) &&
- (widget_is_active(fs->dialog)))
+ int err;
+ err = access(sp->filename, R_OK);
+ if (err < 0)
+ {
+ char *msg;
+ msg = mus_format("%s is read-protected!", sp->short_filename);
+ status_report(sp, "%s", msg);
+ free(msg);
+ sp->file_unreadable = true;
+ start_bomb(sp);
+ }
+ else
{
- force_directory_reread(fs);
- fs->reread_directory = false;
+ sp->file_unreadable = false;
+ clear_status_area(sp);
+ err = access(sp->filename, W_OK);
+ if (err < 0) /* if err < 0, then we can't write (W_OK -> error ) */
+ sp->file_read_only = FILE_READ_ONLY;
+ else sp->file_read_only = FILE_READ_WRITE;
+ if ((sp->user_read_only == FILE_READ_ONLY) ||
+ (sp->file_read_only == FILE_READ_ONLY))
+ show_lock(sp);
+ else hide_lock(sp);
}
}
+#endif
+ break;
+
+ case G_FILE_MONITOR_EVENT_DELETED:
+ /* snd_update will post a complaint in this case, but I like it explicit */
+ if (mus_file_probe(sp->filename) == 0)
+ {
+ /* user deleted file while editing it? */
+ status_report(sp, "%s no longer exists!", sp->short_filename);
+ sp->file_unreadable = true;
+ start_bomb(sp);
+ return;
+ }
+
+ case G_FILE_MONITOR_EVENT_CREATED:
+#if HAVE_GTK_WIDGET_GET_VISIBLE
+ case G_FILE_MONITOR_EVENT_MOVED:
+#endif
+ if (sp->write_date != file_write_date(sp->filename))
+ {
+ sp->file_unreadable = false;
+ sp->need_update = true;
+ if (auto_update(ss))
+ snd_update(sp);
+ else start_bomb(sp);
+ }
break;
default:
@@ -107,5622 +171,3806 @@ static void watch_current_directory_contents(struct fam_info *famp, FAMEvent *fe
break;
}
}
-#endif
-static void fsb_update_lists(fsb *fs)
+void monitor_sound(snd_info *sp)
{
- dir_info *files;
- int i;
- char *pattern;
+ GFile *file;
+ GError *err = NULL;
- /* reload directory list */
- slist_clear(fs->directory_list);
+ file = g_file_new_for_path(sp->filename);
- files = find_directories_in_dir(fs->directory_name);
- if (files->len > 1)
- snd_sort(0, files->files, files->len);
+ sp->file_watcher = (void *)g_file_monitor_file(file, G_FILE_MONITOR_NONE, NULL, &err);
+ if (err != NULL)
+ snd_warning("%s", err->message);
+ else g_signal_connect(G_OBJECT(sp->file_watcher), "changed", G_CALLBACK(sp_file_changed), (gpointer)sp);
- for (i = 0; i < files->len; i++)
- slist_append(fs->directory_list, files->files[i]->filename);
+ g_object_unref(file); /* is this safe? */
+}
- /* set directory list position */
- {
- position_t list_top;
- char *dir_case;
+#else
- dir_case = mus_format("dir:%s", fs->directory_name);
- list_top = dirpos_list_top(fs->dir_list, dir_case);
+void cleanup_file_monitor(void) {}
+void *unmonitor_file(void *watcher) {return(NULL);}
+static void *unmonitor_directory(void *watcher) {return(NULL);}
+void monitor_sound(snd_info *sp) {}
- if (list_top != POSITION_UNKNOWN)
- {
- GtkAdjustment *adj;
- adj = gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->directory_list->scroller));
- if (ADJUSTMENT_UPPER(adj) < files->len * 16)
- ADJUSTMENT_SET_UPPER(adj, files->len * 16);
-#if HAVE_GTK_3
- adj = gtk_scrollable_get_vadjustment(GTK_SCROLLABLE(gtk_widget_get_parent(fs->directory_list->topics)));
-#else
- adj = gtk_viewport_get_vadjustment(GTK_VIEWPORT(gtk_widget_get_parent(fs->directory_list->topics)));
#endif
- ADJUSTMENT_SET_VALUE(gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->directory_list->scroller)), list_top);
- }
- else slist_moveto(fs->directory_list, 0);
- free(dir_case);
- }
- files = free_dir_info(files);
- /* reload file list */
- if (fs->current_files) fs->current_files = free_dir_info(fs->current_files);
- slist_clear(fs->file_list);
+/* ---------------------------------------- dialogs ---------------------------------------- */
- pattern = filename_without_directory(fsb_filter_text(fs)); /* a pointer into the text */
- if ((!pattern) ||
- (strcmp(pattern, "*") == 0))
- {
- if (fs->filter_choice == NO_FILE_FILTER)
- files = find_files_in_dir(fs->directory_name);
- else files = find_filtered_files_in_dir(fs->directory_name, fs->filter_choice);
- }
- else files = find_filtered_files_in_dir_with_pattern(fs->directory_name, fs->filter_choice, pattern);
+#define FILE_DIALOG_DEFAULT_WIDTH 500
+#define FILE_DIALOG_DEFAULT_HEIGHT 300
+#define FILE_DIALOG_DEFAULT_SKETCH_HEIGHT 75
- if (files->len > 1)
- snd_sort(fs->sorter_choice, files->files, files->len);
+typedef struct file_dialog_info {
- if (files->len == 0)
- slist_append(fs->file_list, NO_MATCHING_FILES);
- else
- {
- for (i = 0; i < files->len; i++)
- slist_append(fs->file_list, files->files[i]->filename);
- }
+ GtkWidget *dialog, *ok_button, *cancel_button, *help_button, *extract_button, *play_button, *chooser;
+ read_only_t file_dialog_read_only;
+ GtkWidget *frame, *info, *vbox;
+ void *unsound_directory_watcher; /* doesn't exist, not a sound file, bogus header, etc */
+ void *info_filename_watcher; /* watch for change in selected file and repost info */
+ char *unsound_dirname, *unsound_filename;
+ char *info_filename;
- /* set file list position */
- {
- position_t list_top;
- list_top = dirpos_list_top(fs->dir_list, fs->directory_name);
- if (list_top != POSITION_UNKNOWN)
- {
- GtkAdjustment *adj;
- adj = gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->file_list->scroller));
- /* this is unbelievable -- there's no way to force the scrolled window to update its notion of the viewport size
- * so that the vertical adjustment is more than its (dumb) default size, so unless I set it by hand here,
- * I can't position the list! I suppose I could have a timed call one second from here that would set
- * the position, but then I have to worry about the user clicking before I get to it.
- */
- if (ADJUSTMENT_UPPER(adj) < files->len * 16)
- ADJUSTMENT_SET_UPPER(adj, files->len * 16);
-#if HAVE_GTK_3
- adj = gtk_scrollable_get_vadjustment(GTK_SCROLLABLE(gtk_widget_get_parent(fs->file_list->topics)));
-#else
- adj = gtk_viewport_get_vadjustment(GTK_VIEWPORT(gtk_widget_get_parent(fs->file_list->topics)));
-#endif
- ADJUSTMENT_SET_VALUE(gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->file_list->scroller)), list_top);
- }
- else slist_moveto(fs->file_list, 0);
- }
+ snd_info *player;
- fs->current_files = files;
+ file_data *panel_data;
+ char *filename;
+ save_dialog_t type;
+ void *file_watcher;
+ gulong filename_watcher_id;
+ mus_header_t header_type;
+ mus_sample_t sample_type;
+#if WITH_SKETCH
+ point_t *p0, *p1;
+ int pts;
+ gc_t *gc;
+ axis_info *axis;
+ GtkWidget *drawer;
+ snd_info *sp;
+ bool in_progress, two_sided;
+ mus_long_t samps;
+ int srate;
+ bool unreadable;
+#endif
-#if HAVE_FAM
- /* make sure fam knows which directory to watch */
- if ((fs->last_dir == NULL) ||
- (strcmp(fs->directory_name, fs->last_dir) != 0))
- {
- if (fs->directory_watcher)
- fam_unmonitor_file(fs->last_dir, fs->directory_watcher); /* filename normally ignored */
+} file_dialog_info;
- fs->directory_watcher = fam_monitor_directory(fs->directory_name, (void *)fs, watch_current_directory_contents);
+static file_dialog_info *odat = NULL; /* open file */
+static file_dialog_info *mdat = NULL; /* mix file */
+static file_dialog_info *idat = NULL; /* insert file */
- if (fs->last_dir) free(fs->last_dir);
- fs->last_dir = mus_strdup(fs->directory_name);
- fs->reread_directory = false;
- }
-#endif
-}
+void reflect_just_sounds(void) {}
-static void fsb_directory_select_callback(const char *dir_name, int row, void *data)
+static bool post_sound_info(file_dialog_info *fd, const char *filename, bool with_filename)
{
- fsb *fs = (fsb *)data;
-
- if (strcmp(dir_name, PARENT_DIRECTORY) == 0)
+ if ((!filename) ||
+ (is_directory(filename)) ||
+ (!is_sound_file(filename)))
{
- int i, slash_loc = 0, len;
- len = strlen(fs->directory_name);
- for (i = 1; i < len - 1; i++)
- if (fs->directory_name[i] == '/')
- slash_loc = i;
- fs->directory_name[slash_loc + 1] = '\0';
+ gtk_label_set_text(GTK_LABEL(fd->info), "");
+#if WITH_SKETCH
+ gtk_widget_hide(fd->drawer);
+#endif
+ return(false);
}
else
{
- char *old_name;
-
- if (row > 0) /* not ".." */
- /* save current directory list position */
+ char *buf;
+ char *mx, *lenstr;
+ buf = (char *)calloc(1024, sizeof(char));
+ if (mus_sound_maxamp_exists(filename))
{
- position_t position;
- char *dir_case;
- dir_case = mus_format("dir:%s", fs->directory_name);
- position = ADJUSTMENT_VALUE(gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->directory_list->scroller)));
- dirpos_update(fs->dir_list, dir_case, position);
- free(dir_case);
+ int i, chns, lim;
+ mus_long_t pos = 0;
+
+ mx = (char *)calloc(128, sizeof(char));
+ chns = mus_sound_chans(filename);
+ lim = 5;
+ if (chns < lim) lim = chns;
+ snprintf(mx, 128, "\nmaxamp: %.3f", mus_sound_channel_maxamp(filename, 0, &pos));
+ for (i = 1; i < lim; i++)
+ {
+ char fb[16];
+ snprintf(fb, 16, " %.3f", mus_sound_channel_maxamp(filename, i, &pos));
+ strcat(mx, fb);
+ }
+ if (lim < chns)
+ strcat(mx, "...");
}
+ else
+ {
+ mx = (char *)calloc(2, sizeof(char));
+ mx[0] = '\n';
+ }
+
+ lenstr = (char *)calloc(128, sizeof(char));
+ if (mus_sound_samples(filename) < 1000)
+ snprintf(lenstr, 128, "%d samples", (int)mus_sound_samples(filename));
+ else snprintf(lenstr, 128, "%.3f seconds", mus_sound_duration(filename));
+
+ snprintf(buf, 1024, "%s%s%d chan%s, %d Hz, %s\n%s, %s%s%s",
+
+ (with_filename) ? filename_without_directory(filename) : "",
+ (with_filename) ? ": " : "",
+ mus_sound_chans(filename),
+ (mus_sound_chans(filename) > 1) ? "s" : "",
+ mus_sound_srate(filename),
+ lenstr,
+ mus_header_type_name(mus_sound_header_type(filename)),
+ short_sample_type_name(mus_sound_sample_type(filename), filename),
+ snd_strftime(", %d-%b-%Y", mus_sound_write_date(filename)),
+ mx);
+
+ gtk_label_set_text(GTK_LABEL(fd->info), buf);
+ free(buf);
+ free(mx);
+ free(lenstr);
+#if WITH_SKETCH
+ gtk_widget_show(fd->drawer);
+#endif
+ }
+ return(true);
+}
- old_name = fs->directory_name;
- fs->directory_name = (char *)calloc(strlen(old_name) + strlen(dir_name) + 3, sizeof(char));
- strcpy(fs->directory_name, old_name);
- strcat(fs->directory_name, dir_name);
- strcat(fs->directory_name, "/");
- free(old_name);
+static void file_dialog_stop_playing(file_dialog_info *fd)
+{
+ if ((fd->player) &&
+ (fd->player->playing))
+ {
+ stop_playing_sound(fd->player, PLAY_BUTTON_UNSET);
+ fd->player = NULL;
}
+}
+
- fsb_filter_set_text_with_directory(fs, "*");
- fsb_file_set_text(fs, fs->directory_name);
- fsb_update_lists(fs);
- if (fs->directory_select_callback)
- (*(fs->directory_select_callback))((const char *)(fs->directory_name), fs->directory_select_data);
+void clear_deleted_snd_info(void *ufd)
+{
+ file_dialog_info *fd = (file_dialog_info *)ufd;
+ fd->player = NULL;
}
-static char *fsb_fullname(fsb *fs, const char *filename)
+#if WITH_AUDIO
+static void file_dialog_play(GtkWidget *w, gpointer data)
{
- if (filename)
+ file_dialog_info *fd = (file_dialog_info *)data;
+
+ if ((fd->player) &&
+ (fd->player->playing))
+ file_dialog_stop_playing(fd);
+ else
{
- char *fullname;
- fullname = (char *)calloc(strlen(fs->directory_name) + strlen(filename) + 2, sizeof(char));
- strcpy(fullname, fs->directory_name);
- strcat(fullname, filename);
- return(fullname);
+ char *filename;
+ filename = fd->filename; /* gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser)); */
+ if ((filename) &&
+ (!is_directory(filename)))
+ {
+ if (mus_file_probe(filename))
+ {
+ fd->player = make_sound_readable(filename, false);
+ fd->player->delete_me = (void *)fd;
+ if (fd->player)
+ play_sound(fd->player, 0, NO_END_SPECIFIED);
+ }
+ }
}
- return(NULL);
+}
+#endif
+
+
+#if WITH_SKETCH
+static void tiny_string(cairo_t *cr, const char *str, int x0, int y0)
+{
+ PangoLayout *layout = NULL;
+ cairo_save(cr);
+ layout = pango_cairo_create_layout(cr);
+ pango_layout_set_font_description(layout, TINY_FONT(ss));
+ pango_layout_set_text(layout, str, -1);
+ cairo_move_to(cr, x0, y0);
+ pango_cairo_show_layout(cr, layout);
+ g_object_unref(G_OBJECT(layout));
+ cairo_restore(cr);
}
-static void fsb_file_select_callback(const char *file_name, int row, void *data)
+static void sketch_1(file_dialog_info *fd, bool new_data)
{
- fsb *fs = (fsb *)data;
- if (strcmp(file_name, NO_MATCHING_FILES) != 0)
+ #define X_AXIS 24
+ #define Y_AXIS 8
+
+ char *filename, *str;
+ int hgt, wid, i, xoff, yoff;
+ axis_info *ap;
+ cairo_t *old_cr;
+ double xscl, yscl;
+ point_t *g_p0, *g_p1;
+
+ filename = fd->filename; /* gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser)); */
+ /* gtk_widget_show(fd->drawer); */
+
+ if (!filename)
+ return;
+
+ if ((is_directory(filename)) ||
+ (!is_sound_file(filename)))
+ return;
+
+ if ((!new_data) &&
+ (fd->unreadable))
+ return;
+
+ wid = widget_width(fd->drawer);
+ hgt = widget_height(fd->drawer);
+ ap = fd->axis;
+
+ if (new_data)
+ {
+ bool two_sided = false;
+ chan_info *active_channel;
+ axis_info *active_ap = NULL;
+ snd_info *sp;
+
+ sp = make_sound_readable(filename, false);
+ if (!sp)
+ {
+ fd->unreadable = true;
+ return;
+ }
+ fd->unreadable = false;
+ active_channel = sp->chans[0];
+ active_ap = active_channel->axis;
+ ap->graph_active = true;
+
+ fd->samps = current_samples(active_channel);
+ fd->srate = snd_srate(active_channel->sound);
+
+ ap->losamp = 0;
+ ap->hisamp = fd->samps - 1;
+ ap->y0 = -1.0;
+ ap->y1 = 1.0;
+ ap->x0 = 0.0;
+ ap->x1 = (double)(fd->samps) / (double)(fd->srate);
+
+ ap->x_axis_x0 = 0;
+ ap->y_axis_y0 = 1000;
+ ap->x_axis_x1 = 1000;
+ ap->y_axis_y1 = 0;
+
+ active_channel->axis = ap;
+ init_axis_scales(ap);
+ fd->pts = make_background_graph(active_channel, fd->srate, &two_sided);
+ fd->two_sided = two_sided;
+ memcpy((void *)(fd->p0), (void *)get_grf_points(), fd->pts * sizeof(point_t));
+ if (fd->two_sided)
+ memcpy((void *)(fd->p1), (void *)get_grf_points1(), fd->pts * sizeof(point_t));
+ active_channel->axis = active_ap;
+
+ sp->chans[0]->active = CHANNEL_INACTIVE;
+ completely_free_snd_info(sp);
+ sp = NULL;
+ }
+ else
{
- char *fullname;
- fullname = fsb_fullname(fs, file_name);
- fsb_file_set_text(fs, fullname);
- if (fs->file_select_callback)
- (*(fs->file_select_callback))((const char *)fullname, fs->file_select_data);
+ ap->x1 = (double)(fd->samps) / (double)(fd->srate);
+ }
- /* save current file list position */
- {
- position_t position;
- position = ADJUSTMENT_VALUE(gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->file_list->scroller)));
- dirpos_update(fs->dir_list, fs->directory_name, position);
- }
+ ap->x_axis_x0 = X_AXIS + 2;
+ ap->y_axis_y1 = Y_AXIS;
+ ap->x_axis_x1 = wid - 4;
+ ap->y_axis_y0 = hgt - Y_AXIS * 2;
+
+ g_p0 = get_grf_points();
+ g_p1 = get_grf_points1();
+ if (!new_data)
+ {
+ memcpy((void *)g_p0, (void *)(fd->p0), fd->pts * sizeof(point_t));
+ if (fd->two_sided)
+ memcpy((void *)g_p1, (void *)(fd->p1), fd->pts * sizeof(point_t));
+ }
+
+ xoff = ap->x_axis_x0;
+ yoff = ap->y_axis_y1;
+ xscl = (ap->x_axis_x1 - xoff) * 0.001;
+ yscl = (ap->y_axis_y0 - yoff) * 0.001;
+ init_axis_scales(ap);
+
+ for (i = 0; i < fd->pts; i++)
+ {
+ g_p0[i].x = xoff + (int)(g_p0[i].x * xscl);
+ g_p0[i].y = yoff + (int)(g_p0[i].y * yscl);
+ }
+ if (fd->two_sided)
+ {
+ for (i = 0; i < fd->pts; i++)
+ {
+ g_p1[i].x = xoff + (int)(g_p1[i].x * xscl);
+ g_p1[i].y = yoff + (int)(g_p1[i].y * yscl);
+ }
+ }
- free(fullname);
+ /* here we could check that nothing has changed while getting the data ready, but it doesn't seem to be a problem? */
+
+ old_cr = ss->cr;
+ ss->cr = make_cairo(WIDGET_TO_WINDOW(fd->drawer));
+ cairo_push_group(ss->cr);
+
+ cairo_set_source_rgba(ss->cr, fd->gc->bg_color->red, fd->gc->bg_color->green, fd->gc->bg_color->blue, fd->gc->bg_color->alpha);
+ cairo_rectangle(ss->cr, 0, 0, wid, hgt);
+ cairo_fill(ss->cr);
+
+ cairo_set_source_rgba(ss->cr, fd->gc->fg_color->red, fd->gc->fg_color->green, fd->gc->fg_color->blue, fd->gc->fg_color->alpha);
+ /* y axis */
+ cairo_rectangle(ss->cr, X_AXIS, 8, 2, hgt - Y_AXIS - 16);
+ cairo_fill(ss->cr);
+
+ /* x axis */
+ cairo_rectangle(ss->cr, X_AXIS, hgt - Y_AXIS - 8, wid - X_AXIS - 4, 2);
+ cairo_fill(ss->cr);
+
+ tiny_string(ss->cr, "1.0", 4, 6);
+ tiny_string(ss->cr, "-1.0", 0, hgt - 24);
+ tiny_string(ss->cr, "0.0", 24, hgt - 12);
+
+ str = prettyf(ap->x1, 3);
+ if (str)
+ {
+ tiny_string(ss->cr, str, wid - 4 - 6 * strlen(str), hgt - 12);
+ free(str);
+ }
+
+ if (fd->pts > 0)
+ {
+ if (fd->two_sided)
+ draw_both_grf_points(1, ap->ax, fd->pts, GRAPH_LINES);
+ else draw_grf_points(1, ap->ax, fd->pts, ap, 0.0, GRAPH_LINES);
}
+
+ cairo_pop_group_to_source(ss->cr);
+ cairo_paint(ss->cr);
+ free_cairo(ss->cr);
+ ss->cr = old_cr;
}
-static char *fsb_selected_file(fsb *fs)
+static idle_func_t get_sketch(gpointer data)
{
- return(fsb_fullname(fs, slist_selection(fs->file_list)));
+ sketch_1((file_dialog_info *)data, true);
+ return(false);
}
+static idle_func_t get_resketch(gpointer data)
+{
+ sketch_1((file_dialog_info *)data, false);
+ return(false);
+}
-static void fsb_filter_activate(GtkWidget *w, gpointer context)
+static void stop_sketch(gpointer data)
{
- fsb *fs = (fsb *)context;
- char *filter;
- filter = fsb_filter_text(fs);
- if (filter)
- {
- if (fs->directory_name) free(fs->directory_name);
- fs->directory_name = just_directory(filter); /* this allocates */
- fsb_update_lists(fs);
- }
+ file_dialog_info *fd = (file_dialog_info *)data;
+ fd->in_progress = false;
}
+#define sketch(Fd) {fd->in_progress = true; g_idle_add_full(G_PRIORITY_DEFAULT_IDLE, get_sketch, (gpointer)Fd, (GDestroyNotify)stop_sketch);}
+#define resketch(Fd) if (!fd->in_progress) {fd->in_progress = true; g_idle_add_full(G_PRIORITY_DEFAULT_IDLE, get_resketch, (gpointer)Fd, (GDestroyNotify)stop_sketch);}
+#endif
-static void fsb_file_activate(GtkWidget *w, gpointer context)
+static void selection_changed_callback(GtkFileChooser *w, gpointer data)
{
- fsb *fs = (fsb *)context;
- char *file;
- file = fsb_file_text(fs);
- if (file)
- {
- if ((strcmp(file, NO_MATCHING_FILES) != 0) &&
- (fs->file_select_callback))
- (*(fs->file_select_callback))(file, fs->file_select_data);
- }
+ file_dialog_info *fd = (file_dialog_info *)data;
+ fd->filename = gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser));
+#if WITH_SKETCH
+ if (post_sound_info(fd, fd->filename, false))
+ sketch(fd);
+#else
+ post_sound_info(fd, fd->filename, false);
+#endif
}
+static gboolean file_filter_callback(const GtkFileFilterInfo *filter_info, gpointer data)
+{
+ /* return true => include this file */
+ if (filter_info)
+ return(Xen_boolean_to_C_bool(Xen_call_with_1_arg((Xen)data, C_string_to_Xen_string(filter_info->filename), "filter func")));
+ return(false);
+}
-static bool fsb_directory_button_press_callback(GdkEventButton *ev, void *data);
-static bool fsb_files_button_press_callback(GdkEventButton *ev, void *data);
-
-static fsb *make_fsb(const char *title, const char *file_lab, const char *ok_lab,
- void (*add_innards)(GtkWidget *vbox, void *data), void *data, /* add_innards data can be either file_dialog_info or save_as_dialog_info */
- const gchar *stock, bool with_extract)
+#if WITH_SKETCH
+static gboolean drawer_expose(GtkWidget *w, GdkEventExpose *ev, gpointer data)
{
- fsb *fs;
- char *cur_dir = NULL, *pwd = NULL;
-
- fs = (fsb *)calloc(1, sizeof(fsb));
- if (just_sounds(ss))
- fs->filter_choice = JUST_SOUNDS_FILTER;
- else fs->filter_choice = NO_FILE_FILTER;
- fs->dir_list = make_dirpos_list();
+ file_dialog_info *fd = (file_dialog_info *)data;
+ resketch(fd);
+ return(false);
+}
+#endif
- /* -------- current working directory -------- */
- if (open_file_dialog_directory(ss))
- pwd = mus_strdup(open_file_dialog_directory(ss));
- else pwd = mus_getcwd();
- cur_dir = (char *)calloc(strlen(pwd) + 2, sizeof(char));
- strcpy(cur_dir, pwd);
- free(pwd);
- if ((cur_dir) && (cur_dir[strlen(cur_dir) - 1] != '/'))
- strcat(cur_dir, "/");
- fs->directory_name = cur_dir;
+/* if icons do not get displayed, check the system preferences menu+toolbar dialog */
+static file_dialog_info *make_fsb(const char *title, const char *file_lab, const char *ok_lab,
+ const gchar *stock, bool with_extract, bool save_as)
+{
+ file_dialog_info *fd;
+ int i;
+ GtkFileFilter *just_sounds_filter, *all_files_filter;
+ const char **exts;
+ char buf[32];
+
+ fd = (file_dialog_info *)calloc(1, sizeof(file_dialog_info));
/* -------- base dialog -------- */
- fs->dialog = snd_gtk_dialog_new();
- gtk_window_set_title(GTK_WINDOW(fs->dialog), title);
- sg_make_resizable(fs->dialog);
- gtk_container_set_border_width(GTK_CONTAINER(fs->dialog), 10);
- gtk_widget_realize(fs->dialog);
+ fd->dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(fd->dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
+ gtk_window_set_title(GTK_WINDOW(fd->dialog), title);
+ sg_make_resizable(fd->dialog);
+ gtk_container_set_border_width(GTK_CONTAINER(fd->dialog), 10);
+ gtk_widget_realize(fd->dialog);
/* -------- buttons -------- */
- fs->help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(fs->help_button, "dialog_button");
-
- fs->cancel_button = gtk_button_new_from_stock(GTK_STOCK_CANCEL);
- gtk_widget_set_name(fs->cancel_button, "dialog_button");
- set_stock_button_label(fs->cancel_button, "Go Away");
-
- fs->mkdir_button = sg_button_new_from_stock_with_label("Mkdir", GTK_STOCK_REFRESH);
- gtk_widget_set_name(fs->mkdir_button, "dialog_button");
+ fd->help_button = gtk_dialog_add_button(GTK_DIALOG(fd->dialog), "Help", GTK_RESPONSE_NONE);
+#if WITH_AUDIO
+ if (!save_as)
+ fd->play_button = gtk_dialog_add_button(GTK_DIALOG(fd->dialog), "Play", GTK_RESPONSE_NONE);
+#endif
+ if (with_extract)
+ fd->extract_button = gtk_dialog_add_button(GTK_DIALOG(fd->dialog), "Extract", GTK_RESPONSE_NONE);
+ fd->cancel_button = gtk_dialog_add_button(GTK_DIALOG(fd->dialog), "Go away", GTK_RESPONSE_NONE);
+ fd->ok_button = gtk_dialog_add_button(GTK_DIALOG(fd->dialog), "Ok", GTK_RESPONSE_NONE);
+ gtk_widget_set_name(fd->help_button, "dialog_button");
+ gtk_widget_set_name(fd->cancel_button, "dialog_button");
if (with_extract)
- {
- fs->extract_button = sg_button_new_from_stock_with_label("Extract", GTK_STOCK_CUT);
- gtk_widget_set_name(fs->extract_button, "dialog_button");
+ gtk_widget_set_name(fd->extract_button, "dialog_button");
+ gtk_widget_set_name(fd->ok_button, "dialog_button");
+#if WITH_AUDIO
+ if (!save_as)
+ {
+ gtk_widget_set_name(fd->play_button, "dialog_button");
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(fd->play_button);
+#endif
}
+#endif
- if (ok_lab)
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(fd->ok_button);
+ add_highlight_button_style(fd->cancel_button);
+ add_highlight_button_style(fd->help_button);
+ if (with_extract) add_highlight_button_style(fd->extract_button);
+#endif
+
+ gtk_widget_show(fd->ok_button);
+ gtk_widget_show(fd->cancel_button);
+ gtk_widget_show(fd->help_button);
+#if WITH_AUDIO
+ if (!save_as)
+ gtk_widget_show(fd->play_button);
+#endif
+ if (with_extract) gtk_widget_show(fd->extract_button);
+
+ just_sounds_filter = gtk_file_filter_new();
+ gtk_file_filter_set_name(just_sounds_filter, "Just sounds");
+ exts = get_sound_file_extensions();
+ buf[0] = '*';
+ buf[1] = '.';
+ for (i = 0; i < sound_file_extensions_length(); i++)
{
- if (stock)
- fs->ok_button = sg_button_new_from_stock_with_label(ok_lab, stock);
- else fs->ok_button = gtk_button_new_with_label(ok_lab);
+ buf[2] = '\0';
+ strcat((char *)(buf + 2), exts[i]);
+ gtk_file_filter_add_pattern(just_sounds_filter, buf);
}
- else fs->ok_button = gtk_button_new_from_stock(stock);
- gtk_widget_set_name(fs->ok_button, "dialog_button");
+ all_files_filter = gtk_file_filter_new();
+ gtk_file_filter_set_name(all_files_filter, "All files");
+ gtk_file_filter_add_pattern(all_files_filter, "*");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(fs->dialog)), fs->ok_button, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(fs->dialog)), fs->cancel_button, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(fs->dialog)), fs->mkdir_button, true, true, 10);
- if (with_extract) gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(fs->dialog)), fs->extract_button, true, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(fs->dialog)), fs->help_button, true, true, 10);
+ fd->chooser = gtk_file_chooser_widget_new((save_as) ? GTK_FILE_CHOOSER_ACTION_SAVE : GTK_FILE_CHOOSER_ACTION_OPEN);
+ gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(fd->dialog)), fd->chooser, true, true, 10);
+ gtk_file_chooser_add_filter(GTK_FILE_CHOOSER(fd->chooser), just_sounds_filter);
+ gtk_file_chooser_add_filter(GTK_FILE_CHOOSER(fd->chooser), all_files_filter);
- gtk_widget_show(fs->ok_button);
- gtk_widget_show(fs->cancel_button);
- gtk_widget_show(fs->help_button);
- gtk_widget_show(fs->mkdir_button);
- if (with_extract) gtk_widget_show(fs->extract_button);
+#if HAVE_EXTENSION_LANGUAGE
+ {
+ /* now look for added filters added via add-file-filter */
+ int i;
+ for (i = 0; i < ss->file_filters_size; i++)
+ if (!(Xen_is_false(Xen_vector_ref(ss->file_filters, i))))
+ {
+ const char *filter_name;
+ GtkFileFilter *nfilt;
+ Xen filter_func;
+ filter_name = Xen_string_to_C_string(Xen_car(Xen_vector_ref(ss->file_filters, i)));
+ filter_func = Xen_cadr(Xen_vector_ref(ss->file_filters, i));
- /* -------- filter -------- */
- {
- GtkWidget *row;
- row = gtk_hbox_new(false, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(fs->dialog)), row, false, false, 2);
- gtk_widget_show(row);
-
- /* filter text entry */
- fs->filter_label = gtk_label_new("files listed:");
- gtk_box_pack_start(GTK_BOX(row), fs->filter_label, false, false, 0);
- sg_left_justify_label(fs->filter_label);
- gtk_widget_show(fs->filter_label);
-
- fs->filter_text = snd_entry_new(row, WITH_WHITE_BACKGROUND);
- fsb_filter_set_text_with_directory(fs, "*");
- SG_SIGNAL_CONNECT(fs->filter_text, "activate", fsb_filter_activate, (gpointer)fs);
+ nfilt = gtk_file_filter_new();
+ gtk_file_filter_set_name(nfilt, filter_name);
+ gtk_file_filter_add_custom(nfilt, GTK_FILE_FILTER_FILENAME, file_filter_callback, (gpointer)filter_func, NULL);
+
+ gtk_file_chooser_add_filter(GTK_FILE_CHOOSER(fd->chooser), nfilt);
+ }
}
+#endif
+
+ gtk_widget_show(fd->chooser);
+ gtk_widget_set_size_request(fd->chooser, FILE_DIALOG_DEFAULT_WIDTH, FILE_DIALOG_DEFAULT_HEIGHT);
+ gtk_file_chooser_set_filter(GTK_FILE_CHOOSER(fd->chooser), (just_sounds(ss)) ? just_sounds_filter : all_files_filter);
+#if HAVE_GTK_WIDGET_GET_VISIBLE
+ if (save_as)
+ gtk_file_chooser_set_create_folders(GTK_FILE_CHOOSER(fd->chooser), true);
+#endif
+ fd->filename = gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser));
- /* -------- directory and file lists -------- */
- fs->panes = gtk_hpaned_new();
- gtk_container_set_border_width(GTK_CONTAINER(fs->panes), 2);
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(fs->dialog)), fs->panes, true, true, 10);
- gtk_widget_show(fs->panes);
+ return(fd);
+}
- fs->directory_list = slist_new(fs->panes, NULL, 0, PANED_ADD1);
- fs->directory_list->select_callback = fsb_directory_select_callback;
- fs->directory_list->select_callback_data = (void *)fs;
- fs->directory_list->button_press_callback = fsb_directory_button_press_callback;
- fs->directory_list->button_press_callback_data = (void *)fs;
- fs->file_list = slist_new(fs->panes, NULL, 0, PANED_ADD2);
- fs->file_list->select_callback = fsb_file_select_callback;
- fs->file_list->select_callback_data = (void *)fs;
- fs->file_list->button_press_callback = fsb_files_button_press_callback;
- fs->file_list->button_press_callback_data = (void *)fs;
+static file_dialog_info *make_file_dialog(read_only_t read_only, const char *title, const char *file_title, const char *ok_title,
+ snd_dialog_t which_dialog,
+ GCallback file_ok_proc,
+ GCallback file_mkdir_proc,
+ GCallback file_delete_proc,
+ GCallback file_dismiss_proc,
+ GCallback file_help_proc,
+ const gchar *stock)
+{
+ file_dialog_info *fd;
+ GtkWidget *vbox, *hbox;
- fsb_update_lists(fs);
- gtk_widget_set_size_request(fs->panes, -1, 150);
+ fd = make_fsb(title, file_title, ok_title, stock, false, false);
+ fd->file_dialog_read_only = read_only;
+ vbox = DIALOG_CONTENT_AREA(fd->dialog);
- /* -------- special case box -------- */
- add_innards(DIALOG_CONTENT_AREA(fs->dialog), data);
+ hbox = gtk_hbox_new(true, 8);
+ gtk_box_pack_start(GTK_BOX(vbox), hbox, true, true, 8);
+ gtk_widget_show(hbox);
+ fd->info = gtk_label_new(NULL);
+ gtk_box_pack_start(GTK_BOX(hbox), fd->info, false, true, 8);
+ gtk_widget_show(fd->info);
- /* -------- file -------- */
- {
- GtkWidget *row;
+#if WITH_SKETCH
+ fd->sp = NULL;
+ fd->gc = gc_new();
+ gc_set_background(fd->gc, ss->white);
+ gc_set_foreground(fd->gc, ss->black);
+
+ fd->drawer = gtk_drawing_area_new();
+ gtk_box_pack_end(GTK_BOX(hbox), fd->drawer, true, true, 10);
+ gtk_widget_set_events(fd->drawer, GDK_EXPOSURE_MASK);
+ gtk_widget_set_size_request(fd->drawer, -1, FILE_DIALOG_DEFAULT_SKETCH_HEIGHT);
+ gtk_widget_show(fd->drawer);
+
+ fd->axis = (axis_info *)calloc(1, sizeof(axis_info));
+ fd->axis->ax = (graphics_context *)calloc(1, sizeof(graphics_context));
+ fd->axis->ax->wn = WIDGET_TO_WINDOW(fd->drawer);
+ fd->axis->ax->w = fd->drawer;
+ fd->axis->ax->gc = fd->gc;
+ fd->axis->ax->current_font = AXIS_NUMBERS_FONT(ss);
+ fd->p0 = (point_t *)calloc(POINT_BUFFER_SIZE, sizeof(point_t));
+ fd->p1 = (point_t *)calloc(POINT_BUFFER_SIZE, sizeof(point_t));
+ fd->unreadable = true;
+
+ SG_SIGNAL_CONNECT(fd->drawer, DRAW_SIGNAL, drawer_expose, (gpointer)fd);
+
+ gtk_widget_show(fd->dialog);
+#endif
- row = gtk_hbox_new(false, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(fs->dialog)), row, false, false, 10);
- gtk_widget_show(row);
+ SG_SIGNAL_CONNECT(fd->help_button, "clicked", file_help_proc, (gpointer)fd);
+ SG_SIGNAL_CONNECT(fd->ok_button, "clicked", file_ok_proc, (gpointer)fd);
+ SG_SIGNAL_CONNECT(fd->cancel_button, "clicked", file_dismiss_proc, (gpointer)fd);
+ if (file_delete_proc)
+ SG_SIGNAL_CONNECT(fd->dialog, "delete_event", file_delete_proc, (gpointer)fd);
+#if WITH_AUDIO
+ SG_SIGNAL_CONNECT(fd->play_button, "clicked", file_dialog_play, (gpointer)(fd));
+#endif
- /* file text entry */
- fs->file_label = gtk_label_new(file_lab);
- gtk_box_pack_start(GTK_BOX(row), fs->file_label, false, false, 0);
- sg_left_justify_label(fs->file_label);
- gtk_widget_show(fs->file_label);
+ gtk_label_set_text(GTK_LABEL(fd->info), "");
+ set_dialog_widget(which_dialog, fd->dialog);
- fs->file_text = snd_entry_new(row, WITH_WHITE_BACKGROUND);
- gtk_entry_set_text(GTK_ENTRY(fs->file_text), fs->directory_name);
- SG_SIGNAL_CONNECT(fs->file_text, "activate", fsb_file_activate, (gpointer)fs);
- }
+ SG_SIGNAL_CONNECT(fd->chooser, "selection-changed", selection_changed_callback, (gpointer)fd);
+ return(fd);
+}
- gtk_widget_show(fs->dialog);
- gtk_paned_set_position(GTK_PANED(fs->panes), 120);
- return(fs);
+static void file_open_error(const char *error_msg, file_dialog_info *fd)
+{
+ gtk_label_set_text(GTK_LABEL(fd->info), error_msg);
+ gtk_widget_show(fd->info);
}
-static void force_directory_reread(fsb *fs)
+static void redirect_file_open_error(const char *error_msg, void *ufd)
{
- /* protect the current selection and file name entry values across an update, also try to maintain window position */
- char *filename = NULL, *selected;
- gdouble scroller_position;
- int i;
+ /* called from snd_error, redirecting error handling to the dialog */
+ file_open_error(error_msg, (file_dialog_info *)ufd);
+}
- selected = mus_strdup(slist_selection(fs->file_list));
- filename = mus_strdup(fsb_file_text(fs));
- scroller_position = ADJUSTMENT_VALUE(gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->file_list->scroller)));
- fsb_update_lists(fs);
- fsb_file_set_text(fs, filename);
+static void clear_file_error_label(file_dialog_info *fd)
+{
+ gtk_label_set_text(GTK_LABEL(fd->info), "");
- if (selected)
+ if (fd->unsound_directory_watcher)
{
- for (i = 0; i < fs->current_files->len; i++)
- if (mus_strcmp(selected, fs->current_files->files[i]->filename))
- {
- slist_select(fs->file_list, i); /* doesn't call select callback */
- break;
- }
- free(selected);
+ fd->unsound_directory_watcher = unmonitor_directory(fd->unsound_directory_watcher);
+ if (fd->unsound_dirname) {free(fd->unsound_dirname); fd->unsound_dirname = NULL;}
+ if (fd->unsound_filename) {free(fd->unsound_filename); fd->unsound_filename = NULL;}
}
- if (filename) free(filename);
- ADJUSTMENT_SET_VALUE(gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->file_list->scroller)), scroller_position);
}
-/* ---------------- popups ---------------- */
-
-/* dir list popup */
+/* key press event here, not key release -- the latter is triggered by the <return> release
+ * that triggered the error, so our error is immediately erased
+ */
-static void file_dir_item_activate_callback(GtkWidget *w, gpointer context)
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+static void unpost_unsound_error(GFileMonitor *mon, GFile *file, GFile *other, GFileMonitorEvent ev, gpointer data)
{
- /* set fs->directory_name, and filter text ("*", then fsb_update_lists */
- fsb *fs = (fsb *)context;
- if (fs->directory_name) free(fs->directory_name);
- fs->directory_name = mus_format("%s/", gtk_label_get_text(GTK_LABEL(gtk_bin_get_child(GTK_BIN(w)))));
- fsb_filter_set_text_with_directory(fs, "*");
- fsb_update_lists(fs);
+ file_dialog_info *fd;
+ char *filename;
+ switch (ev)
+ {
+ case G_FILE_MONITOR_EVENT_CHANGED:
+ case G_FILE_MONITOR_EVENT_CREATED:
+ filename = g_file_get_path(file);
+ fd = (file_dialog_info *)data;
+ if ((fd) &&
+ (filename) &&
+ (mus_strcmp(filename, fd->unsound_filename)))
+ clear_file_error_label(fd);
+ break;
+
+ default:
+ /* ignore the rest */
+ break;
+ }
}
-/* dir_items, but strs generated on the fly, current in filter text */
-static bool fsb_directory_button_press_callback(GdkEventButton *ev, void *data)
+static void start_unsound_watcher(file_dialog_info *fd, const char *filename)
{
- fsb *fs = (fsb *)data;
- if ((NO_BUCKY_BITS_P(EVENT_STATE(ev))) &&
- (EVENT_TYPE(ev) == GDK_BUTTON_PRESS) &&
- (EVENT_BUTTON(ev) == POPUP_BUTTON))
- {
- char *current_filename = NULL;
- int i, dirs_to_display = 0, len = 0;
-
- if (fs->file_dir_items == NULL)
- {
- fs->dirs_menu = gtk_menu_new();
- fs->file_dir_items = (GtkWidget **)calloc(FILENAME_LIST_SIZE, sizeof(GtkWidget *));
- for (i = 0; i < FILENAME_LIST_SIZE; i++)
- {
- fs->file_dir_items[i] = gtk_menu_item_new_with_label("oops");
- set_user_int_data(G_OBJECT(fs->file_dir_items[i]), i);
- gtk_menu_shell_append(GTK_MENU_SHELL(fs->dirs_menu), fs->file_dir_items[i]);
- gtk_widget_show(fs->file_dir_items[i]);
- SG_SIGNAL_CONNECT(fs->file_dir_items[i], "activate", file_dir_item_activate_callback, (gpointer)fs);
- }
- }
- current_filename = fs->directory_name;
- len = strlen(current_filename);
- for (i = 0; i < len; i++)
- if (current_filename[i] == '/')
- dirs_to_display++;
-
- if (dirs_to_display > FILENAME_LIST_SIZE)
- dirs_to_display = FILENAME_LIST_SIZE;
-
- if (dirs_to_display > 0)
- {
- char **dirs;
- int j = 1;
- dirs = (char **)calloc(dirs_to_display, sizeof(char *));
- dirs[0] = mus_strdup("/");
- for (i = 1; i < len; i++)
- if (current_filename[i] == '/')
- {
- dirs[j] = (char *)calloc(i + 1, sizeof(char));
- strncpy(dirs[j], (const char *)current_filename, i);
- j++;
- }
-
- for (i = 0; i < dirs_to_display; i++)
- {
- gtk_label_set_text(GTK_LABEL(gtk_bin_get_child(GTK_BIN(fs->file_dir_items[i]))), dirs[i]);
- gtk_widget_show(fs->file_dir_items[i]);
- free(dirs[i]);
- }
- free(dirs);
- }
+ GFile *file;
+ GError *err = NULL;
- for (i = dirs_to_display; i < FILENAME_LIST_SIZE; i++)
- if ((fs->file_dir_items[i]) &&
- (widget_is_active(fs->file_dir_items[i])))
- gtk_widget_hide(fs->file_dir_items[i]);
-
- gtk_menu_popup(GTK_MENU(fs->dirs_menu), NULL, NULL, NULL, NULL, EVENT_BUTTON(ev), EVENT_TIME(ev));
+ if (fd->unsound_directory_watcher)
+ {
+ fd->unsound_directory_watcher = unmonitor_directory(fd->unsound_directory_watcher);
+ if (fd->unsound_dirname) free(fd->unsound_dirname);
+ if (fd->unsound_filename) free(fd->unsound_filename);
}
- return(false);
-}
-
-#define NO_FILTER_LABEL "no filter"
-
-#define FILE_FILTER_OFFSET 1024
-#define NO_FILE_FILTER_OFFSET 2048
-
-static void sort_files_and_redisplay(fsb *fs);
+ fd->unsound_filename = mus_expand_filename(filename);
+ fd->unsound_dirname = just_directory(fd->unsound_filename);
-static void file_list_item_activate_callback(GtkWidget *w, gpointer context)
-{
- fsb *fs = (fsb *)context;
- int choice = 0;
- choice = get_user_int_data(G_OBJECT(w));
- if (choice >= FILE_FILTER_OFFSET)
- {
- set_toggle_button(fs->just_sounds_button, false, false, (void *)fs);
- if (choice == NO_FILE_FILTER_OFFSET)
- fs->filter_choice = NO_FILE_FILTER;
- else fs->filter_choice = choice - FILE_FILTER_OFFSET + 2;
- force_directory_reread(fs);
- }
- else
- {
- fs->sorter_choice = choice;
- sort_files_and_redisplay(fs);
- }
+ file = g_file_new_for_path(fd->unsound_dirname);
+ fd->unsound_directory_watcher = (void *)g_file_monitor_directory(file, G_FILE_MONITOR_NONE, NULL, &err);
+ if (err != NULL)
+ snd_warning("%s", err->message);
+ else g_signal_connect(G_OBJECT(fd->unsound_directory_watcher), "changed", G_CALLBACK(unpost_unsound_error), (gpointer)fd);
+ g_object_unref(file);
}
+#else
+static void start_unsound_watcher(file_dialog_info *fd, const char *filename) {}
+#endif
+
-static GtkWidget *make_file_list_item(fsb *fs, int choice)
+static void file_open_dialog_ok(GtkWidget *w, gpointer data)
{
- const char *item_label[7] = {"a..z", "z..a", "new..old", "old..new", "small..big", "big..small", "unused"};
- GtkWidget *w;
+ file_dialog_info *fd = (file_dialog_info *)data;
+ char *filename = NULL;
- w = gtk_menu_item_new_with_label(item_label[choice]);
- set_user_int_data(G_OBJECT(w), choice);
- gtk_menu_shell_append(GTK_MENU_SHELL(fs->files_menu), w);
- gtk_widget_show(w);
- SG_SIGNAL_CONNECT(w, "activate", file_list_item_activate_callback, (gpointer)fs);
- return(w);
-}
+ filename = fd->filename; /* gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser)); */
+ /* fprintf(stderr, "open %s, %s\n", fd->filename, gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser))); */
-static bool fsb_files_button_press_callback(GdkEventButton *ev, void *data)
-{
- if ((NO_BUCKY_BITS_P(EVENT_STATE(ev))) &&
- (EVENT_TYPE(ev) == GDK_BUTTON_PRESS) &&
- (EVENT_BUTTON(ev) == POPUP_BUTTON))
+ file_dialog_stop_playing(fd);
+ if ((filename) &&
+ (!is_directory(filename)))
{
- fsb *fs = (fsb *)data;
- int i, items_len;
- if (fs->file_list_items == NULL)
+ snd_info *sp;
+ redirect_snd_error_to(redirect_file_open_error, (void *)fd);
+ ss->requestor_dialog = fd->dialog;
+ ss->open_requestor = FROM_OPEN_DIALOG;
+ sp = snd_open_file(filename, fd->file_dialog_read_only);
+ redirect_snd_error_to(NULL, NULL);
+ if (sp)
{
- /* set up the default menu items */
- fs->files_menu = gtk_menu_new();
- fs->file_list_items = (GtkWidget **)calloc(SORT_XEN, sizeof(GtkWidget *));
- fs->file_list_items_size = SORT_XEN;
- for (i = 0; i < SORT_XEN; i++)
- fs->file_list_items[i] = make_file_list_item(fs, i);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ gpointer hide_me;
+ hide_me = g_object_get_data(G_OBJECT(fd->dialog), "hide-me"); /* see snd-gtk.scm where this is set */
+ if (hide_me == 0)
+ gtk_widget_hide(fd->dialog);
+#endif
+ select_channel(sp, 0); /* add_sound_window (snd-xsnd.c) -> make_file_info (snd-file) will report reason for error, if any */
}
-
- /* clear any trailers just in case */
- if (fs->file_list_items_size > SORT_XEN)
- for (i = SORT_XEN; i < fs->file_list_items_size; i++)
- gtk_widget_hide(fs->file_list_items[i]);
-
- /* check for added sort and filter functions (allocate more items if needed) */
- {
- int extra_sorters = 0, extra_filters = 0;
- for (i = 0; i < ss->file_sorters_size; i++)
- if (!(XEN_FALSE_P(XEN_VECTOR_REF(ss->file_sorters, i))))
- extra_sorters++;
- for (i = 0; i < ss->file_filters_size; i++)
- if (!(XEN_FALSE_P(XEN_VECTOR_REF(ss->file_filters, i))))
- extra_filters++;
-
- items_len = SORT_XEN + extra_sorters + extra_filters;
- if (fs->filter_choice != NO_FILE_FILTER) items_len++;
-
- if (items_len > fs->file_list_items_size)
- {
- fs->file_list_items = (GtkWidget **)realloc(fs->file_list_items, items_len * sizeof(GtkWidget *));
- for (i = fs->file_list_items_size; i < items_len; i++)
- fs->file_list_items[i] = make_file_list_item(fs, i);
- fs->file_list_items_size = items_len;
- }
- }
-
- /* make sure all the added sorter labels are correct, bg blue, and items active */
- if (fs->file_list_items_size > SORT_XEN)
+ else
{
- int k = SORT_XEN;
-
- /* sorters */
- for (i = 0; i < ss->file_sorters_size; i++)
- {
- if (!(XEN_FALSE_P(XEN_VECTOR_REF(ss->file_sorters, i))))
- {
- gtk_label_set_text(GTK_LABEL(gtk_bin_get_child(GTK_BIN(fs->file_list_items[k]))),
- XEN_TO_C_STRING(XEN_CAR(XEN_VECTOR_REF(ss->file_sorters, i))));
- reset_user_int_data(G_OBJECT(fs->file_list_items[k]), SORT_XEN + i);
- widget_modify_bg(fs->file_list_items[k], GTK_STATE_NORMAL, ss->lighter_blue);
- if (!(widget_is_active(fs->file_list_items[k])))
- gtk_widget_show(fs->file_list_items[k]);
- k++;
- }
- }
-
- for (i = 0; i < ss->file_filters_size; i++)
- {
- if (!(XEN_FALSE_P(XEN_VECTOR_REF(ss->file_filters, i))))
- {
- gtk_label_set_text(GTK_LABEL(gtk_bin_get_child(GTK_BIN(fs->file_list_items[k]))),
- XEN_TO_C_STRING(XEN_CAR(XEN_VECTOR_REF(ss->file_filters, i))));
- reset_user_int_data(G_OBJECT(fs->file_list_items[k]), i + FILE_FILTER_OFFSET);
- widget_modify_bg(fs->file_list_items[k], GTK_STATE_NORMAL, ss->light_blue);
- if (!(widget_is_active(fs->file_list_items[k])))
- gtk_widget_show(fs->file_list_items[k]);
- k++;
- }
- }
-
- /* add "no filter" item if currently filtered */
- if (fs->filter_choice != NO_FILE_FILTER)
+ if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
{
- gtk_label_set_text(GTK_LABEL(gtk_bin_get_child(GTK_BIN(fs->file_list_items[k]))), NO_FILTER_LABEL);
- reset_user_int_data(G_OBJECT(fs->file_list_items[k]), NO_FILE_FILTER_OFFSET);
- widget_modify_bg(fs->file_list_items[k], GTK_STATE_NORMAL, ss->light_blue);
- if (!(widget_is_active(fs->file_list_items[k])))
- gtk_widget_show(fs->file_list_items[k]);
+ start_unsound_watcher(fd, filename);
}
-
}
- gtk_menu_popup(GTK_MENU(fs->files_menu), NULL, NULL, NULL, NULL, EVENT_BUTTON(ev), EVENT_TIME(ev));
}
- return(false);
-}
-
-
-/* ---------------- just-sounds (file-filters) ---------------- */
-
-static void sort_files_and_redisplay(fsb *fs)
-{
- /* if just sorting, no need to read the directory */
- dir_info *cur_dir;
- char *selected;
- gdouble scroller_position;
-
- cur_dir = fs->current_files;
- scroller_position = ADJUSTMENT_VALUE(gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->file_list->scroller)));
- selected = mus_strdup(slist_selection(fs->file_list));
- slist_clear(fs->file_list);
-
- if (cur_dir->len == 0)
- slist_append(fs->file_list, NO_MATCHING_FILES);
else
{
- int i;
- snd_sort(fs->sorter_choice, cur_dir->files, cur_dir->len);
- for (i = 0; i < cur_dir->len; i++)
- slist_append(fs->file_list, cur_dir->files[i]->filename);
- }
-
- if (selected)
- {
- int i;
- for (i = 0; i < cur_dir->len; i++)
- if (mus_strcmp(selected, cur_dir->files[i]->filename))
- {
- slist_select(fs->file_list, i); /* doesn't call select callback */
- scroller_position = i * 16;
- break;
- }
- free(selected);
+ char *str;
+ str = mus_format("%s is a directory", filename);
+ file_open_error(str, fd);
+ free(str);
}
-
- ADJUSTMENT_SET_VALUE(gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(fs->file_list->scroller)), scroller_position);
}
-static void just_sounds_callback(GtkWidget *w, gpointer data)
+static void file_open_dialog_dismiss(GtkWidget *w, gpointer context)
{
- fsb *fs = (fsb *)data;
- if (TOGGLE_BUTTON_ACTIVE(w))
- fs->filter_choice = JUST_SOUNDS_FILTER;
- else fs->filter_choice = NO_FILE_FILTER;
- force_directory_reread(fs);
+ file_dialog_info *fd = (file_dialog_info *)context;
+ file_dialog_stop_playing(fd);
+ gtk_label_set_text(GTK_LABEL(fd->info), "");
+ gtk_widget_hide(fd->dialog);
}
-
-/* -------- play selected file handlers -------- */
-
-typedef struct dialog_play_info {
- GtkWidget *play_button;
- snd_info *player;
- fsb *fs;
-} dialog_play_info;
-
-static void file_dialog_stop_playing(dialog_play_info *dp)
+static void file_open_dialog_help(GtkWidget *w, gpointer context)
{
- if ((dp->player) &&
- (dp->player->playing))
- {
- stop_playing_sound(dp->player, PLAY_BUTTON_UNSET);
- dp->player = NULL;
- }
+ open_file_dialog_help();
}
-void clear_deleted_snd_info(struct dialog_play_info *dp)
+static gint file_open_dialog_delete(GtkWidget *w, GdkEvent *event, gpointer context)
{
- dp->player = NULL;
+ file_dialog_info *fd = (file_dialog_info *)context;
+ file_dialog_stop_playing(fd);
+ gtk_label_set_text(GTK_LABEL(fd->info), "");
+ gtk_widget_hide(fd->dialog);
+ return(true);
}
-static void play_selected_callback(GtkWidget *w, gpointer data)
+static void file_activated_callback(GtkFileChooser *w, gpointer data)
{
- dialog_play_info *dp = (dialog_play_info *)data;
- if (TOGGLE_BUTTON_ACTIVE(w))
+ const char *filename;
+ file_dialog_info *fd = (file_dialog_info *)data;
+ fd->filename = gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser));
+ filename = fd->filename;
+ if ((filename) &&
+ (!(is_directory(filename))))
{
- char *filename;
- if ((dp->player) &&
- (dp->player->playing))
- stop_playing_sound(dp->player, PLAY_BUTTON_UNSET);
- filename = fsb_selected_file(dp->fs); /* allocates, so free below */
- if (filename)
+ snd_info *sp;
+
+ redirect_snd_error_to(redirect_file_open_error, (void *)fd);
+ ss->requestor_dialog = fd->dialog;
+ ss->open_requestor = FROM_OPEN_DIALOG;
+ sp = snd_open_file(filename, fd->file_dialog_read_only);
+ redirect_snd_error_to(NULL, NULL);
+
+ if (sp)
{
- if (mus_file_probe(filename))
- {
- dp->player = make_sound_readable(filename, false);
- dp->player->delete_me = dp;
- if (dp->player)
- play_sound(dp->player, 0, NO_END_SPECIFIED);
- }
- free(filename);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ gpointer hide_me;
+ hide_me = g_object_get_data(G_OBJECT(fd->dialog), "hide-me"); /* see snd-gtk.scm where this is set */
+ if (hide_me == 0)
+ gtk_widget_hide(fd->dialog);
+#endif
+ select_channel(sp, 0); /* add_sound_window (snd-xsnd.c) -> make_file_info (snd-file) will report reason for error, if any */
+ }
+ else
+ {
+ start_unsound_watcher(fd, filename);
}
}
- else file_dialog_stop_playing(dp);
-}
-
-
-static bool file_is_directory(fsb *fs)
-{
- char *filename;
- filename = fsb_file_text(fs);
- return((!filename) || (directory_p(filename)));
}
-static bool file_is_nonexistent_directory(fsb *fs)
+widget_t make_open_file_dialog(read_only_t read_only, bool managed)
{
- char *filename = NULL;
- filename = mus_strdup(fsb_file_text(fs));
- if (filename)
+ if (!odat)
+ {
+ odat = make_file_dialog(read_only,
+ (char *)((read_only == FILE_READ_ONLY) ? "View" : "Open"),
+ (char *)((read_only == FILE_READ_ONLY) ? "view:" : "open:"),
+ NULL,
+ FILE_OPEN_DIALOG,
+ (GCallback)file_open_dialog_ok,
+ NULL, /* no mkdir */
+ (GCallback)file_open_dialog_delete,
+ (GCallback)file_open_dialog_dismiss,
+ (GCallback)file_open_dialog_help,
+ ICON_OPEN);
+ SG_SIGNAL_CONNECT(odat->chooser, "file-activated", file_activated_callback, (gpointer)odat);
+ }
+ else
{
- int i, len;
- len = strlen(filename);
- if ((!mus_file_probe(filename)) &&
- (filename[len - 1] == '/'))
+ if (read_only != odat->file_dialog_read_only)
{
- /* check that there's some hope of making this directory */
- for (i = len - 2; i > 0; i--)
- if (filename[i] == '/')
- {
- bool result;
- filename[i] = '\0';
- result = directory_p(filename);
- free(filename);
- return(result);
- }
+ set_stock_button_label(odat->ok_button, (char *)((read_only == FILE_READ_ONLY) ? "View" : "Open"));
+ gtk_window_set_title(GTK_WINDOW(odat->dialog), (char *)((read_only == FILE_READ_ONLY) ? "View" : "Open"));
+ odat->file_dialog_read_only = read_only;
}
+#if GTK_CHECK_VERSION(3, 0, 0)
+ /* this doesn't work!! and nothing else does either */
+ /* if (odat->filename) gtk_file_chooser_select_filename(GTK_FILE_CHOOSER(odat->chooser), odat->filename); */
+#endif
}
- free(filename);
- return(false);
-}
-
-
-static void post_sound_info(GtkWidget *info1, GtkWidget *info2, const char *filename, bool with_filename)
-{
- /* filename is known[strongly believed] to be a sound file, etc */
- char *buf;
-
- buf = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
- mus_snprintf(buf, LABEL_BUFFER_SIZE, "%s%s%d chan%s, %d Hz, %.3f secs",
- (with_filename) ? filename_without_directory(filename) : "",
- (with_filename) ? ": " : "",
- mus_sound_chans(filename),
- (mus_sound_chans(filename) > 1) ? "s" : "",
- mus_sound_srate(filename),
- mus_sound_duration(filename));
-
- info_widget_display(info1, buf);
- info_widget_set_size(info1, 1 + strlen(buf));
-
- mus_snprintf(buf, LABEL_BUFFER_SIZE, "%s, %s%s",
- mus_header_type_name(mus_sound_header_type(filename)),
- short_data_format_name(mus_sound_data_format(filename), filename),
- snd_strftime(", %d-%b-%Y", mus_sound_write_date(filename)));
- info_widget_display(info2, buf);
- info_widget_set_size(info2, 1 + strlen(buf));
-
- free(buf);
+ if (managed)
+ gtk_widget_show(odat->dialog);
+ return(odat->dialog);
}
-/* ---------------- file dialogs ---------------- */
+/* -------- mix file dialog -------- */
-typedef struct file_dialog_info {
- fsb *fs;
- read_only_t file_dialog_read_only;
- GtkWidget *frame, *info1, *info2, *vbox;
- dialog_play_info *dp;
- fam_info *unsound_directory_watcher; /* doesn't exist, not a sound file, bogus header, etc */
- char *unsound_dirname, *unsound_filename;
- fam_info *info_filename_watcher; /* watch for change in selected file and repost info */
- char *info_filename;
-} file_dialog_info;
+static void file_mix_cancel_callback(GtkWidget *w, gpointer context)
+{
+ file_dialog_stop_playing(mdat);
+ gtk_label_set_text(GTK_LABEL(mdat->info), "");
+ gtk_widget_hide(mdat->dialog);
+}
-static void clear_open_handlers(fsb *fs);
-static void unpost_file_info(file_dialog_info *fd)
+static void file_mix_help_callback(GtkWidget *w, gpointer context)
{
- info_widget_display(fd->info1, "");
- info_widget_display(fd->info2, "");
- clear_open_handlers(fd->fs);
-#if HAVE_FAM
- if (fd->info_filename_watcher)
- {
- fd->info_filename_watcher = fam_unmonitor_file(fd->info_filename, fd->info_filename_watcher);
- if (fd->info_filename) {free(fd->info_filename); fd->info_filename = NULL;}
- }
-#endif
+ mix_file_dialog_help();
}
-#if HAVE_FAM
-static void repost_sound_info(file_dialog_info *fd)
+static gint file_mix_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
{
- if ((mus_file_probe(fd->info_filename)) &&
- (plausible_sound_file_p(fd->info_filename)))
- post_sound_info(fd->info1, fd->info2, fd->info_filename, true);
- else unpost_file_info(fd);
+ file_dialog_stop_playing(mdat);
+ gtk_label_set_text(GTK_LABEL(mdat->info), "");
+ gtk_widget_hide(mdat->dialog);
+ return(true);
}
-static void watch_info_file(struct fam_info *fp, FAMEvent *fe)
+static void file_mix_ok_callback(GtkWidget *w, gpointer context)
{
- switch (fe->code)
+ char *filename = NULL;
+ filename = mdat->filename; /* gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(mdat->chooser)); */
+ if ((!filename) || (!(*filename)))
{
- case FAMChanged:
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- repost_sound_info((file_dialog_info *)(fp->data));
- break;
-
- default:
- /* ignore the rest */
- break;
+ file_open_error("no filename given", mdat);
+ }
+ else
+ {
+ file_dialog_stop_playing(mdat);
+ if (!(is_directory(filename)))
+ {
+ snd_info *sp;
+ int err;
+ sp = any_selected_sound();
+ redirect_snd_error_to(redirect_file_open_error, (void *)mdat);
+ ss->requestor_dialog = mdat->dialog;
+ ss->open_requestor = FROM_MIX_DIALOG;
+ err = mix_complete_file_at_cursor(sp, filename);
+ redirect_snd_error_to(NULL, NULL);
+ if (err < 0)
+ {
+ if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
+ {
+ if (err == MIX_FILE_NO_FILE)
+ start_unsound_watcher(mdat, filename);
+ }
+ }
+ else
+ {
+ status_report(sp, "%s mixed in at cursor", filename);
+ }
+ }
+ else
+ {
+ char *str;
+ str = mus_format("%s is a directory", filename);
+ file_open_error(str, mdat);
+ free(str);
+ }
}
}
-#endif
-static gboolean filer_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+widget_t make_mix_file_dialog(bool managed)
{
- if (EVENT_KEYVAL(event) == snd_K_Tab)
+ if (mdat == NULL)
{
- gtk_entry_set_text(GTK_ENTRY(w), sound_filename_completer(w, (char *)gtk_entry_get_text(GTK_ENTRY(w)), NULL));
- gtk_editable_set_position(GTK_EDITABLE(w), mus_strlen((char *)gtk_entry_get_text(GTK_ENTRY(w))));
- return(true);
+ mdat = make_file_dialog(FILE_READ_ONLY, "Mix", "mix:", "Mix", FILE_MIX_DIALOG,
+ (GCallback)file_mix_ok_callback,
+ NULL, /* no mkdir */
+ (GCallback)file_mix_delete_callback,
+ (GCallback)file_mix_cancel_callback,
+ (GCallback)file_mix_help_callback,
+ ICON_ADD);
}
- return(false);
-}
+ if (managed) gtk_widget_show(mdat->dialog);
+ return(mdat->dialog);
+}
-/* -------- File Open/View/Mix/ Dialogs -------- */
-static file_dialog_info *odat = NULL; /* open file */
-static file_dialog_info *mdat = NULL; /* mix file */
-static file_dialog_info *idat = NULL; /* insert file */
+/* -------- File:Insert dialog -------- */
-void alert_new_file(void)
+static void file_insert_cancel_callback(GtkWidget *w, gpointer context)
{
- if (ss->fam_ok) return;
- if (odat)
- {
- odat->fs->reread_directory = true;
- if (widget_is_active(odat->fs->dialog))
- {
- force_directory_reread(odat->fs);
- odat->fs->reread_directory = false;
- }
- }
- if (mdat)
- {
- mdat->fs->reread_directory = true;
- if (widget_is_active(mdat->fs->dialog))
- {
- force_directory_reread(mdat->fs);
- mdat->fs->reread_directory = false;
- }
- }
- if (idat)
- {
- idat->fs->reread_directory = true;
- if (widget_is_active(idat->fs->dialog))
- {
- force_directory_reread(idat->fs);
- idat->fs->reread_directory = false;
- }
- }
+ file_dialog_stop_playing(idat);
+ gtk_widget_hide(idat->dialog);
}
-void reflect_just_sounds(void)
+static void file_insert_help_callback(GtkWidget *w, gpointer context)
{
- if ((odat) && (odat->fs->just_sounds_button))
- gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(odat->fs->just_sounds_button), just_sounds(ss));
- if ((mdat) && (mdat->fs->just_sounds_button))
- gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(mdat->fs->just_sounds_button), just_sounds(ss));
- if ((idat) && (idat->fs->just_sounds_button))
- gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(idat->fs->just_sounds_button), just_sounds(ss));
+ insert_file_dialog_help();
}
-static void dialog_directory_select_callback(const char *dirname, void *context)
+static gint file_insert_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
{
- file_dialog_info *fd = (file_dialog_info *)context;
- set_sensitive(fd->fs->ok_button, (!(file_is_directory(fd->fs))));
- unpost_file_info(fd);
+ file_dialog_stop_playing(idat);
+ gtk_widget_hide(idat->dialog);
+ return(true);
}
-static void dialog_select_callback(const char *filename, void *context)
+static void file_insert_ok_callback(GtkWidget *w, gpointer context)
{
file_dialog_info *fd = (file_dialog_info *)context;
-
- unpost_file_info(fd);
- if ((filename) &&
- (!(directory_p(filename))) &&
- (plausible_sound_file_p(filename)))
+ char *filename;
+ filename = fd->filename; /* gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser)); */
+ if ((!filename) || (!(*filename)))
{
- post_sound_info(fd->info1, fd->info2, filename, true);
- gtk_widget_show(fd->frame);
- gtk_widget_show(fd->vbox);
- gtk_widget_show(fd->info1);
- gtk_widget_show(fd->info2);
- gtk_widget_show(fd->dp->play_button);
-#if HAVE_FAM
- fd->info_filename = mus_strdup(filename);
- fd->info_filename_watcher = fam_monitor_file(fd->info_filename, (void *)fd, watch_info_file);
-#endif
+ file_open_error("no filename given", fd);
}
else
{
- unpost_file_info(fd);
- }
- set_sensitive(fd->fs->ok_button, (!(file_is_directory(fd->fs))));
-}
-
-
-static void open_innards(GtkWidget *vbox, void *data)
-{
- GtkWidget *center_info;
- file_dialog_info *fd = (file_dialog_info *)data;
-
- center_info = gtk_hbox_new(true, 10);
- gtk_box_pack_start(GTK_BOX(vbox), center_info, false, false, 0);
- gtk_widget_show(center_info);
-
- fd->frame = gtk_frame_new(NULL);
- gtk_frame_set_shadow_type(GTK_FRAME(fd->frame), GTK_SHADOW_ETCHED_IN);
- gtk_container_set_border_width(GTK_CONTAINER(fd->frame), 1);
- widget_modify_bg(fd->frame, GTK_STATE_NORMAL, ss->zoom_color);
- gtk_box_pack_start(GTK_BOX(center_info), fd->frame, false, false, 10);
-
- fd->vbox = gtk_vbox_new(false, 0);
- gtk_container_set_border_width(GTK_CONTAINER(fd->vbox), 10);
- gtk_container_add(GTK_CONTAINER(fd->frame), fd->vbox);
+ file_dialog_stop_playing(fd);
+ if (!(is_directory(filename))) /* this can be a directory name if the user clicked 'ok' when he meant 'cancel' */
+ {
+ bool ok;
+ snd_info *sp;
- fd->info1 = make_info_widget();
- gtk_box_pack_start(GTK_BOX(fd->vbox), fd->info1, true, true, 0);
-
- fd->info2 = make_info_widget();
- gtk_box_pack_start(GTK_BOX(fd->vbox), fd->info2, true, true, 0);
+ sp = any_selected_sound();
+ ss->requestor_dialog = w;
+ ss->open_requestor = FROM_INSERT_DIALOG;
+ redirect_snd_error_to(redirect_file_open_error, (void *)fd);
+ ok = insert_complete_file_at_cursor(sp, filename);
+ redirect_snd_error_to(NULL, NULL);
+ if (!ok)
+ {
+ if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
+ {
+ char *fullname;
+ fullname = mus_expand_filename(filename);
+ if (!(mus_file_probe(fullname)))
+ start_unsound_watcher(fd, filename);
+ free(fullname);
+ }
+ }
+ else
+ {
+ status_report(sp, "%s inserted at cursor", filename);
+ }
+ }
+ else
+ {
+ char *str;
+ str = mus_format("%s is a directory", filename);
+ file_open_error(str, fd);
+ free(str);
+ }
+ }
+}
+
+
+widget_t make_insert_file_dialog(bool managed)
+{
+ if (idat == NULL)
+ idat = make_file_dialog(FILE_READ_ONLY, "Insert", "insert:", "Insert", FILE_INSERT_DIALOG,
+ (GCallback)file_insert_ok_callback,
+ NULL, /* no mkdir */
+ (GCallback)file_insert_delete_callback,
+ (GCallback)file_insert_cancel_callback,
+ (GCallback)file_insert_help_callback,
+ ICON_PASTE);
- gtk_widget_show(fd->frame);
- gtk_widget_show(fd->vbox);
- gtk_widget_show(fd->info1);
- gtk_widget_show(fd->info2);
+ if (managed) gtk_widget_show(idat->dialog);
+ return(idat->dialog);
}
-static gboolean reflect_text_in_open_button(GtkWidget *w, GdkEventKey *event, gpointer data)
+void set_open_file_play_button(bool val)
{
- file_dialog_info *fd = (file_dialog_info *)data;
- fsb *fs;
- char *filename = NULL;
- fs = fd->fs;
+}
+
+
+
+/* ---------------- file data panel ---------------- */
+
+char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, mus_header_t *header_type,
+ mus_sample_t *sample_type, mus_long_t *location, mus_long_t *samples, int min_chan)
+{
+ char *str;
+ int res;
+ fdat->error_widget = NOT_A_SCANF_WIDGET;
+ fdat->scanf_widget = NOT_A_SCANF_WIDGET;
+
+ if ((srate) && (fdat->srate_text))
+ {
+ str = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->srate_text));
+ fdat->scanf_widget = SRATE_WIDGET;
+ if ((str) && (*str))
+ (*srate) = string_to_int(str, 1, "srate");
+ else snd_error_without_format("no srate?");
+ }
- set_sensitive(fs->ok_button, (!(file_is_directory(fs))));
- if (fs->mkdir_button) set_sensitive(fs->mkdir_button, file_is_nonexistent_directory(fs));
+ if ((chans) && (fdat->chans_text))
+ {
+ str = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->chans_text));
+ fdat->scanf_widget = CHANS_WIDGET;
+ if ((str) && (*str))
+ (*chans) = string_to_int(str, min_chan, "chans");
+ else
+ {
+ if (min_chan > 0)
+ snd_error_without_format("no chans?");
+ }
+ }
+
+ if ((location) && (fdat->location_text))
+ {
+ str = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->location_text));
+ fdat->scanf_widget = DATA_LOCATION_WIDGET;
+ if ((str) && (*str))
+ (*location) = string_to_mus_long_t(str, 0, "data location");
+ else snd_error_without_format("no data location?");
+ }
+
+ if ((samples) && (fdat->samples_text))
+ {
+ str = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->samples_text));
+ fdat->scanf_widget = SAMPLES_WIDGET;
+ if ((str) && (*str))
+ (*samples) = string_to_mus_long_t(str, 0, "samples");
+ else snd_error_without_format("no samples?");
+ }
+ fdat->scanf_widget = SAMPLES_WIDGET;
- /* try to find the current partial filename in the files list, and move to it if found */
- /* try to move file list to show possible matches,
- * if a sound file, show info
- */
- filename = fsb_file_text(fs);
- if ((filename) && (*filename))
+ if (fdat->header_type_list)
{
- int i, pos = -1, l = 0, u;
- dir_info *cur_dir;
- cur_dir = fs->current_files;
- u = cur_dir->len - 1;
- while (true)
+ res = fdat->header_type_list->selected_item;
+ if (res == SLIST_NO_ITEM_SELECTED)
+ res = fdat->header_type_pos;
+ if (res != NO_SELECTION)
{
- int comp;
- if (u < l) break;
- i = (l + u) / 2;
- comp = strcmp(cur_dir->files[i]->full_filename, filename);
- if (comp == 0)
- {
- pos = i;
- break;
- }
- if (comp < 0) /* files[i]->full_filename less than filename */
- l = i + 1;
- else u = i - 1;
+ (*header_type) = position_to_header_type(res);
+ fdat->current_header_type = (*header_type);
}
- slist_moveto(fs->file_list, pos);
- if ((mus_file_probe(filename)) &&
- (!directory_p(filename)))
+ }
+
+ if (fdat->sample_type_list)
+ {
+ res = fdat->sample_type_list->selected_item;
+ if (res == SLIST_NO_ITEM_SELECTED) /* can this happen? */
+ res = fdat->sample_type_pos;
+ if (res != NO_SELECTION)
{
- if (sound_file_p(filename))
- post_sound_info(fd->info1, fd->info2, filename, true);
+ (*sample_type) = position_to_sample_type(fdat->current_header_type, res);
+ fdat->current_sample_type = (*sample_type);
}
}
- return(false);
+ if (fdat->comment_text)
+ {
+ char *comment = NULL;
+ if (GTK_IS_TEXT_VIEW(fdat->comment_text))
+ comment = sg_get_text(fdat->comment_text, 0, -1);
+ else comment = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->comment_text));
+ str = mus_strdup(comment);
+ return(str);
+ }
+
+ return(NULL);
}
-static file_dialog_info *make_file_dialog(read_only_t read_only, const char *title, const char *file_title, const char *ok_title,
- snd_dialog_t which_dialog,
- GCallback file_ok_proc,
- GCallback file_mkdir_proc,
- GCallback file_delete_proc,
- GCallback file_dismiss_proc,
- GCallback file_help_proc,
- const gchar *stock)
+#define IGNORE_DATA_LOCATION -1
+#define IGNORE_SAMPLES MUS_UNKNOWN_SAMPLE
+#define IGNORE_CHANS -1
+#define IGNORE_SRATE -1
+#define IGNORE_HEADER_TYPE MUS_UNKNOWN_HEADER
+
+static void set_file_dialog_sound_attributes(file_data *fdat, mus_header_t header_type, mus_sample_t sample_type,
+ int srate, int chans, mus_long_t location, mus_long_t samples, char *comment)
{
- file_dialog_info *fd;
- fsb *fs;
- fd = (file_dialog_info *)calloc(1, sizeof(file_dialog_info));
- fd->file_dialog_read_only = read_only;
- fd->dp = (dialog_play_info *)calloc(1, sizeof(dialog_play_info));
+ int i;
+ const char **fl = NULL;
+ if (!(fdat->sample_type_list)) return;
- fd->fs = make_fsb(title, file_title, ok_title, open_innards, (void *)fd, stock, false);
- fs = fd->fs;
- fd->dp->fs = fs;
+ if (header_type != IGNORE_HEADER_TYPE)
+ fdat->current_header_type = header_type;
+ else fdat->current_header_type = MUS_RAW;
+ fdat->current_sample_type = sample_type;
+ fl = header_type_and_sample_type_to_position(fdat, fdat->current_header_type, fdat->current_sample_type);
+ if (fl == NULL) return;
- SG_SIGNAL_CONNECT(fs->help_button, "clicked", file_help_proc, (gpointer)fd);
- SG_SIGNAL_CONNECT(fs->file_text, "key_press_event", filer_key_press, NULL);
- SG_SIGNAL_CONNECT(fs->ok_button, "clicked", file_ok_proc, (gpointer)fd);
- SG_SIGNAL_CONNECT(fs->cancel_button, "clicked", file_dismiss_proc, (gpointer)fd);
- if (file_delete_proc)
- SG_SIGNAL_CONNECT(fs->dialog, "delete_event", file_delete_proc, (gpointer)fd);
+ if ((header_type != IGNORE_HEADER_TYPE) &&
+ (fdat->header_type_list))
+ {
+ slist_select(fdat->header_type_list, fdat->header_type_pos);
+ slist_moveto(fdat->header_type_list, fdat->header_type_pos);
+ }
- if (file_mkdir_proc)
- SG_SIGNAL_CONNECT(fs->mkdir_button, "clicked", file_mkdir_proc, (gpointer)fd);
- else gtk_widget_hide(fs->mkdir_button);
+ slist_clear(fdat->sample_type_list);
+ for (i = 0; i < fdat->sample_types; i++)
+ slist_append(fdat->sample_type_list, (const char *)fl[i]);
- fs->file_select_data = (void *)fd;
- fs->file_select_callback = dialog_select_callback;
- fs->directory_select_data = (void *)fd;
- fs->directory_select_callback = dialog_directory_select_callback;
+ slist_select(fdat->sample_type_list, fdat->sample_type_pos);
+ slist_moveto(fdat->sample_type_list, fdat->sample_type_pos);
- /* this needs fs, so it can't be in open_innards */
- {
- GtkWidget *hbox, *spacer;
-
- hbox = gtk_hbox_new(true, 0);
- gtk_box_pack_end(GTK_BOX(fd->vbox), hbox, false, false, 0);
- gtk_widget_show(hbox);
-
- fs->just_sounds_button = gtk_check_button_new_with_label("sound files only");
- gtk_box_pack_start(GTK_BOX(hbox), fs->just_sounds_button, true, true, 2);
- gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(fs->just_sounds_button), just_sounds(ss));
- SG_SIGNAL_CONNECT(fs->just_sounds_button, "toggled", just_sounds_callback, (void *)fs);
- gtk_widget_show(fs->just_sounds_button);
-
- fd->dp->play_button = gtk_check_button_new_with_label("play selected sound");
- gtk_box_pack_end(GTK_BOX(hbox), fd->dp->play_button, true, true, 2);
- SG_SIGNAL_CONNECT(fd->dp->play_button, "toggled", play_selected_callback, fd->dp);
- gtk_widget_show(fd->dp->play_button);
-
- /* this order of box_pack_end calls puts the spacer before (above) the buttons */
- spacer = gtk_vseparator_new();
- gtk_box_pack_end(GTK_BOX(fd->vbox), spacer, false, false, 6);
- gtk_widget_show(spacer);
- }
+ if ((srate != IGNORE_SRATE) &&
+ (fdat->srate_text))
+ widget_int_to_text(fdat->srate_text, srate);
- info_widget_display(fd->info1, "");
- info_widget_display(fd->info2, "");
+ if ((chans != IGNORE_CHANS) &&
+ (fdat->chans_text))
+ widget_int_to_text(fdat->chans_text, chans);
- SG_SIGNAL_CONNECT(fs->file_text, "activate", file_ok_proc, (gpointer)fd);
+ if (fdat->comment_text)
+ {
+ if (GTK_IS_TEXT_VIEW(fdat->comment_text))
+ {
+ gtk_text_buffer_set_text(gtk_text_view_get_buffer(GTK_TEXT_VIEW(fdat->comment_text)), "", 0);
+ sg_text_insert(fdat->comment_text, comment);
+ }
+ else gtk_entry_set_text(GTK_ENTRY(fdat->comment_text), comment);
+ }
- set_sensitive(fs->ok_button, (!(file_is_directory(fs))));
- set_sensitive(fs->mkdir_button, false);
- SG_SIGNAL_CONNECT(fs->file_text, "key_release_event", reflect_text_in_open_button, (gpointer)fd);
+ if ((location != IGNORE_DATA_LOCATION) &&
+ (fdat->location_text))
+ widget_mus_long_t_to_text(fdat->location_text, location);
- set_dialog_widget(which_dialog, fs->dialog);
+ if ((samples != IGNORE_SAMPLES) &&
+ (fdat->samples_text))
+ widget_mus_long_t_to_text(fdat->samples_text, samples);
- return(fd);
}
-static void file_open_error(const char *error_msg, file_dialog_info *fd)
+static gboolean data_panel_srate_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
{
- info_widget_display(fd->info1, error_msg);
- info_widget_set_size(fd->info1, strlen(error_msg));
- gtk_widget_show(fd->frame);
- gtk_widget_show(fd->vbox);
- gtk_widget_show(fd->info1);
- info_widget_display(fd->info2, "");
+ if (EVENT_KEYVAL(event) == snd_K_Tab)
+ {
+ gtk_entry_set_text(GTK_ENTRY(w), srate_completer(w, (char *)gtk_entry_get_text(GTK_ENTRY(w)), NULL));
+ gtk_editable_set_position(GTK_EDITABLE(w), mus_strlen((char *)gtk_entry_get_text(GTK_ENTRY(w))));
+ return(true);
+ }
+ return(false);
}
-static void redirect_file_open_error(const char *error_msg, void *ufd)
+#define NUM_REFLECTION_IDS 5
+enum {REFLECT_SRATE_ID, REFLECT_CHANS_ID, REFLECT_SAMPLES_ID, REFLECT_LOCATION_ID, REFLECT_COMMENT_ID};
+
+static void reflect_file_data_panel_change(file_data *fd, void *data, void (*change_action)(GtkWidget *w, gpointer context))
{
- /* called from snd_error, redirecting error handling to the dialog */
- file_open_error(error_msg, (file_dialog_info *)ufd);
+ if (!(fd->reflection_ids))
+ fd->reflection_ids = (gulong *)calloc(NUM_REFLECTION_IDS, sizeof(gulong));
+ if (fd->srate_text)
+ fd->reflection_ids[REFLECT_SRATE_ID] = SG_SIGNAL_CONNECT(fd->srate_text, "changed", change_action, (gpointer)data);
+ if (fd->chans_text)
+ fd->reflection_ids[REFLECT_CHANS_ID] = SG_SIGNAL_CONNECT(fd->chans_text, "changed", change_action, (gpointer)data);
+ if (fd->samples_text)
+ fd->reflection_ids[REFLECT_SAMPLES_ID] = SG_SIGNAL_CONNECT(fd->samples_text, "changed", change_action, (gpointer)data);
+ if (fd->location_text)
+ fd->reflection_ids[REFLECT_LOCATION_ID] = SG_SIGNAL_CONNECT(fd->location_text, "changed", change_action, (gpointer)data);
+ if (fd->comment_text)
+ {
+ if (GTK_IS_TEXT_VIEW(fd->comment_text))
+ fd->reflection_ids[REFLECT_COMMENT_ID] =
+ SG_SIGNAL_CONNECT(gtk_text_view_get_buffer(GTK_TEXT_VIEW(fd->comment_text)), "changed", change_action, (gpointer)data);
+ else fd->reflection_ids[REFLECT_COMMENT_ID] = SG_SIGNAL_CONNECT(fd->comment_text, "changed", change_action, (gpointer)data);
+ }
}
-static void clear_file_error_label(file_dialog_info *fd)
+static void unreflect_file_data_panel_change(file_data *fd, void *data, void (*change_action)(GtkWidget *w, gpointer context))
{
- info_widget_display(fd->info1, "");
-#if HAVE_FAM
- if (fd->unsound_directory_watcher)
+ int i;
+ if (!(fd->reflection_ids)) return;
+ if ((fd->srate_text) && (fd->reflection_ids[REFLECT_SRATE_ID] > 0))
+ g_signal_handler_disconnect(fd->srate_text, fd->reflection_ids[REFLECT_SRATE_ID]);
+ if ((fd->chans_text) && (fd->reflection_ids[REFLECT_CHANS_ID] > 0))
+ g_signal_handler_disconnect(fd->chans_text, fd->reflection_ids[REFLECT_CHANS_ID]);
+ if ((fd->samples_text) && (fd->reflection_ids[REFLECT_SAMPLES_ID] > 0))
+ g_signal_handler_disconnect(fd->samples_text, fd->reflection_ids[REFLECT_SAMPLES_ID]);
+ if ((fd->location_text) && (fd->reflection_ids[REFLECT_LOCATION_ID] > 0))
+ g_signal_handler_disconnect(fd->location_text, fd->reflection_ids[REFLECT_LOCATION_ID]);
+ if ((fd->comment_text) && (fd->reflection_ids[REFLECT_COMMENT_ID] > 0))
{
- fd->unsound_directory_watcher = fam_unmonitor_file(fd->unsound_dirname, fd->unsound_directory_watcher);
- if (fd->unsound_dirname) {free(fd->unsound_dirname); fd->unsound_dirname = NULL;}
- if (fd->unsound_filename) {free(fd->unsound_filename); fd->unsound_filename = NULL;}
+ if (GTK_IS_TEXT_VIEW(fd->comment_text))
+ g_signal_handler_disconnect(gtk_text_view_get_buffer(GTK_TEXT_VIEW(fd->comment_text)), fd->reflection_ids[REFLECT_COMMENT_ID]);
+ else g_signal_handler_disconnect(fd->comment_text, fd->reflection_ids[REFLECT_COMMENT_ID]);
}
-#endif
+ for (i = 0; i < NUM_REFLECTION_IDS; i++) fd->reflection_ids[i] = 0;
}
-/* key press event here, not key release -- the latter is triggered by the <return> release
- * that triggered the error, so our error is immediately erased
+/* -------- panel error handling -------- */
+
+/* if an error occurs, a callback is added to the offending text widget, and an error is
+ * posted in the error_text label. When the user modifies the bad entry, the callback
+ * erases the error message, and removes itself from the text widget.
*/
-static gulong key_press_handler_id = 0;
-static void clear_open_handlers(fsb *fs)
+static void clear_dialog_error(file_data *fdat)
{
- if (key_press_handler_id)
- {
- g_signal_handler_disconnect(fs->file_text, key_press_handler_id);
- key_press_handler_id = 0;
- }
+ gtk_label_set_text(GTK_LABEL(fdat->error_text), "");
}
-static gboolean open_modify_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+static void post_file_dialog_error(const char *error_msg, file_data *fdat)
{
- file_dialog_info *fd = (file_dialog_info *)data;
- clear_file_error_label(fd);
- clear_open_handlers(fd->fs);
- return(false);
+ gtk_label_set_text(GTK_LABEL(fdat->error_text), (gchar *)error_msg);
}
-static void clear_error_if_open_changes(fsb *fs, file_dialog_info *fd)
+static void redirect_post_file_dialog_error(const char *error_msg, void *ufd)
{
- if (!key_press_handler_id)
- key_press_handler_id = SG_SIGNAL_CONNECT(fs->file_text, "key_press_event", open_modify_key_press, (void *)fd);
+ file_data *fdat = (file_data *)ufd;
+ gtk_label_set_text(GTK_LABEL(fdat->error_text), error_msg);
}
-#if HAVE_FAM
-static void unpost_unsound_error(struct fam_info *fp, FAMEvent *fe)
+static gulong chans_key_press_handler_id = 0;
+
+static gboolean chans_key_press_callback(GtkWidget *w, GdkEventKey *event, gpointer data)
{
- file_dialog_info *fd;
- switch (fe->code)
+ file_data *fdat = (file_data *)data;
+ gtk_label_set_text(GTK_LABEL(fdat->error_text), "");
+ if (chans_key_press_handler_id)
{
- case FAMChanged:
- case FAMCreated:
- fd = (file_dialog_info *)(fp->data);
- if ((fd) &&
- (fe->filename) &&
- (mus_strcmp(fe->filename, fd->unsound_filename)))
- clear_file_error_label(fd);
- break;
-
- default:
- /* ignore the rest */
- break;
+ g_signal_handler_disconnect(fdat->chans_text, chans_key_press_handler_id);
+ chans_key_press_handler_id = 0;
}
+ return(false);
}
-static void start_unsound_watcher(file_dialog_info *fd, const char *filename)
+static void clear_error_if_chans_changes(GtkWidget *dialog, void *data)
{
- if (fd->unsound_directory_watcher)
- {
- fd->unsound_directory_watcher = fam_unmonitor_file(fd->unsound_dirname, fd->unsound_directory_watcher);
- if (fd->unsound_dirname) free(fd->unsound_dirname);
- if (fd->unsound_filename) free(fd->unsound_filename);
- }
- fd->unsound_filename = mus_expand_filename(filename);
- fd->unsound_dirname = just_directory(fd->unsound_filename);
- fd->unsound_directory_watcher = fam_monitor_directory(fd->unsound_dirname, (void *)fd, unpost_unsound_error);
+ file_data *fdat = (file_data *)data;
+ if (fdat->chans_text)
+ chans_key_press_handler_id = SG_SIGNAL_CONNECT(fdat->chans_text, "key_press_event", chans_key_press_callback, data);
}
-#else
-static void start_unsound_watcher(file_dialog_info *fd, const char *filename) {}
-#endif
-static void file_open_dialog_ok(GtkWidget *w, gpointer data)
+static gulong panel_modify_handler_id = 0;
+
+static gboolean panel_modify_callback(GtkWidget *w, GdkEventKey *event, gpointer data)
{
- file_dialog_info *fd = (file_dialog_info *)data;
- char *filename = NULL;
- gpointer hide_me = 0;
-
- filename = fsb_file_text(fd->fs);
- if ((!filename) || (!(*filename)))
- {
- file_open_error("no filename given", fd);
- clear_error_if_open_changes(fd->fs, fd);
- }
- else
+ file_data *fdat = (file_data *)data;
+ gtk_label_set_text(GTK_LABEL(fdat->error_text), "");
+ if (panel_modify_handler_id)
{
- file_dialog_stop_playing(fd->dp);
- if (!(directory_p(filename)))
- {
- snd_info *sp;
- redirect_snd_error_to(redirect_file_open_error, (void *)fd);
- ss->requestor_dialog = fd->fs->dialog;
- ss->open_requestor = FROM_OPEN_DIALOG;
- sp = snd_open_file(filename, fd->file_dialog_read_only);
- redirect_snd_error_to(NULL, NULL);
- if (sp)
- {
- hide_me = g_object_get_data(G_OBJECT(fd->fs->dialog), "hide-me"); /* see snd-gtk.scm where this is set */
- if (hide_me == 0)
- gtk_widget_hide(fd->fs->dialog);
- select_channel(sp, 0); /* add_sound_window (snd-xsnd.c) -> make_file_info (snd-file) will report reason for error, if any */
- }
- else
- {
- if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
- {
- clear_error_if_open_changes(fd->fs, fd);
- start_unsound_watcher(fd, filename);
- }
- }
- }
- else
- {
- char *str;
- str = mus_format("%s is a directory", filename);
- file_open_error(str, fd);
- clear_error_if_open_changes(fd->fs, fd);
- free(str);
- }
+ g_signal_handler_disconnect(w, panel_modify_handler_id);
+ panel_modify_handler_id = 0;
}
+ return(false);
}
-static void file_open_dialog_dismiss(GtkWidget *w, gpointer context)
+static void clear_error_if_panel_changes(GtkWidget *dialog, file_data *fdat)
{
- file_dialog_info *fd = (file_dialog_info *)context;
- file_dialog_stop_playing(fd->dp);
- gtk_widget_hide(fd->fs->dialog);
+ GtkWidget *baddy;
+ switch (fdat->error_widget)
+ {
+ case SRATE_WIDGET: baddy = fdat->srate_text; break;
+ case DATA_LOCATION_WIDGET: baddy = fdat->location_text; break;
+ case SAMPLES_WIDGET: baddy = fdat->samples_text; break;
+ default: baddy = fdat->chans_text; break;
+ }
+ if (baddy)
+ panel_modify_handler_id = SG_SIGNAL_CONNECT(baddy, "key_press_event", panel_modify_callback, (void *)fdat);
}
-static void file_open_dialog_help(GtkWidget *w, gpointer context)
+static void post_file_panel_error(const char *error_msg, file_data *fdat)
{
- open_file_dialog_help();
+ fdat->error_widget = fdat->scanf_widget;
+ post_file_dialog_error(error_msg, fdat);
}
-static gint file_open_dialog_delete(GtkWidget *w, GdkEvent *event, gpointer context)
+static void redirect_post_file_panel_error(const char *error_msg, void *ufd)
{
- file_dialog_info *fd = (file_dialog_info *)context;
- file_dialog_stop_playing(fd->dp);
- gtk_widget_hide(fd->fs->dialog);
- return(true);
+ post_file_panel_error(error_msg, (file_data *)ufd);
}
-static void file_open_dialog_mkdir(GtkWidget *w, gpointer context)
-{
- file_dialog_info *fd = (file_dialog_info *)context;
- fsb *fs;
- char *filename = NULL;
- fs = fd->fs;
-
- filename = fsb_file_text(fs);
- if (snd_mkdir(filename) < 0)
- {
- /* could not make the directory */
- char *str;
- str = mus_format("can't make %s: %s", filename, strerror(errno));
- file_open_error(str, fd);
- clear_error_if_open_changes(fs, fd);
- free(str);
- }
- else
- {
- /* set FSB to new dir and force update */
- if (fs->directory_name) free(fs->directory_name);
- fs->directory_name = mus_strdup(filename);
- fsb_filter_set_text_with_directory(fs, "*");
- fsb_update_lists(fs);
- set_sensitive(w, false);
- }
-}
-
+/* -------- file data choices -------- */
-widget_t make_open_file_dialog(read_only_t read_only, bool managed)
+static void update_header_type_list(const char *name, int row, void *data)
{
- if (!odat)
- {
- odat = make_file_dialog(read_only,
- (char *)((read_only == FILE_READ_ONLY) ? "View" : "Open"),
- (char *)((read_only == FILE_READ_ONLY) ? "view:" : "open:"),
- NULL,
- FILE_OPEN_DIALOG,
- (GCallback)file_open_dialog_ok,
- (GCallback)file_open_dialog_mkdir,
- (GCallback)file_open_dialog_delete,
- (GCallback)file_open_dialog_dismiss,
- (GCallback)file_open_dialog_help,
- GTK_STOCK_OPEN);
-#if 0
- preload_filenames(odat->fs->file_text_names);
-#endif
- }
- else
+ /* needed to reflect type selection in sample_type list */
+ file_data *fdat = (file_data *)data;
+ if (position_to_header_type(row) != fdat->current_header_type)
{
- if (read_only != odat->file_dialog_read_only)
- {
- set_stock_button_label(odat->fs->ok_button, (char *)((read_only == FILE_READ_ONLY) ? "View" : "Open"));
- gtk_window_set_title(GTK_WINDOW(odat->fs->dialog), (char *)((read_only == FILE_READ_ONLY) ? "View" : "Open"));
- odat->file_dialog_read_only = read_only;
- }
- if (odat->fs->reread_directory)
- {
- force_directory_reread(odat->fs);
- odat->fs->reread_directory = false;
- }
+ position_to_header_type_and_sample_type(fdat, row);
+ set_file_dialog_sound_attributes(fdat,
+ fdat->current_header_type,
+ fdat->current_sample_type,
+ IGNORE_SRATE, IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
+ NULL);
}
- if (managed) gtk_widget_show(odat->fs->dialog);
- return(odat->fs->dialog);
}
-/* -------- mix file dialog -------- */
-
-static void file_mix_cancel_callback(GtkWidget *w, gpointer context)
+static void update_sample_type_list(const char *name, int row, void *data)
{
- file_dialog_stop_playing(mdat->dp);
- gtk_widget_hide(mdat->fs->dialog);
+ file_data *fdat = (file_data *)data;
+ fdat->current_sample_type = position_to_sample_type(fdat->current_header_type, row);
}
-static void file_mix_help_callback(GtkWidget *w, gpointer context)
+static void file_data_src_callback(GtkWidget *w, gpointer context)
{
- mix_file_dialog_help();
+ file_data *fdat = (file_data *)context;
+ fdat->src = (bool)(TOGGLE_BUTTON_ACTIVE(w));
}
-
-static gint file_mix_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
-{
- file_dialog_stop_playing(mdat->dp);
- gtk_widget_hide(mdat->fs->dialog);
- return(true);
-}
+#define WITH_SRATE_FIELD true
+#define WITHOUT_SRATE_FIELD false
+#define WITHOUT_AUTO_COMMENT false
-static void file_mix_ok_callback(GtkWidget *w, gpointer context)
+static file_data *make_file_data_panel(GtkWidget *parent, const char *name,
+ dialog_channels_t with_chan,
+ mus_header_t header_type,
+ mus_sample_t sample_type,
+ dialog_data_location_t with_loc,
+ dialog_samples_t with_samples,
+ dialog_header_type_t with_header_type,
+ dialog_comment_t with_comment,
+ header_choice_t header_choice,
+ bool with_src,
+ bool with_auto_comment)
{
- char *filename = NULL;
- filename = fsb_file_text(mdat->fs);
- if ((!filename) || (!(*filename)))
- {
- file_open_error("no filename given", mdat);
- clear_error_if_open_changes(mdat->fs, mdat);
- }
- else
+ GtkWidget *form, *scbox, *frame_box, *frame;
+ file_data *fdat;
+ int nsample_types = 0, nheaders = 0;
+ const char **sample_types = NULL, **headers = NULL;
+
+ switch (header_choice)
{
- file_dialog_stop_playing(mdat->dp);
- if (!(directory_p(filename)))
- {
- snd_info *sp;
- int err;
- sp = any_selected_sound();
- redirect_snd_error_to(redirect_file_open_error, (void *)mdat);
- ss->requestor_dialog = mdat->fs->dialog;
- ss->open_requestor = FROM_MIX_DIALOG;
- err = mix_complete_file_at_cursor(sp, filename);
- redirect_snd_error_to(NULL, NULL);
- if (err < 0)
- {
- if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
- {
- if (err == MIX_FILE_NO_FILE)
- start_unsound_watcher(mdat, filename);
- clear_error_if_open_changes(mdat->fs, mdat);
- }
- }
- else
- {
- report_in_minibuffer(sp, "%s mixed in at cursor", filename);
- }
- }
- else
- {
- char *str;
- str = mus_format("%s is a directory", filename);
- file_open_error(str, mdat);
- clear_error_if_open_changes(mdat->fs, mdat);
- free(str);
- }
+ case WITH_READABLE_HEADERS: headers = short_readable_headers(&nheaders); break;
+ case WITH_WRITABLE_HEADERS: headers = short_writable_headers(&nheaders); break;
+ case WITH_BUILTIN_HEADERS: headers = short_builtin_headers(&nheaders); break;
}
-}
+ fdat = (file_data *)calloc(1, sizeof(file_data));
+ fdat->src = save_as_dialog_src(ss);
+ fdat->auto_comment = save_as_dialog_auto_comment(ss);
+ fdat->saved_comment = NULL;
+ fdat->current_header_type = header_type;
+ fdat->current_sample_type = sample_type;
+ sample_types = header_type_and_sample_type_to_position(fdat, header_type, sample_type);
+ nsample_types = fdat->sample_types;
-widget_t make_mix_file_dialog(bool managed)
-{
- if (mdat == NULL)
- {
- mdat = make_file_dialog(FILE_READ_ONLY, "Mix", "mix:", "Mix", FILE_MIX_DIALOG,
- (GCallback)file_mix_ok_callback,
- NULL, /* no mkdir */
- (GCallback)file_mix_delete_callback,
- (GCallback)file_mix_cancel_callback,
- (GCallback)file_mix_help_callback,
- GTK_STOCK_ADD);
- }
- else
+ frame = gtk_frame_new(NULL);
+ gtk_box_pack_start(GTK_BOX(parent), frame, false, true, 8);
+ gtk_widget_show(frame);
+
+ frame_box = gtk_vbox_new(false, 0);
+ gtk_container_add(GTK_CONTAINER(frame), frame_box);
+ gtk_widget_show(frame_box);
+
+ form = gtk_hbox_new(true, 8);
+ gtk_box_pack_start(GTK_BOX(frame_box), form, false, false, 4);
+ gtk_widget_show(form);
+
+ /* header type */
+ if (with_header_type == WITH_HEADER_TYPE_FIELD)
{
- if (mdat->fs->reread_directory)
- {
- force_directory_reread(mdat->fs);
- mdat->fs->reread_directory = false;
- }
+ fdat->header_type_list = slist_new_with_title("header type", form, (const char **)headers, nheaders, BOX_PACK); /* BOX_PACK widget_add_t (snd-g0.h) */
+ fdat->header_type_list->select_callback = update_header_type_list;
+ fdat->header_type_list->select_callback_data = (void *)fdat;
+ slist_select(fdat->header_type_list, fdat->header_type_pos);
}
- if (managed) gtk_widget_show(mdat->fs->dialog);
- return(mdat->fs->dialog);
-}
+ /* sample type */
+#if GTK_CHECK_VERSION(3, 0, 0)
+ fdat->sample_type_list = slist_new_with_title(" sample type ", form, (const char **)sample_types, nsample_types, BOX_PACK);
+#else
+ fdat->sample_type_list = slist_new_with_title("sample type", form, (const char **)sample_types, nsample_types, BOX_PACK);
+#endif
+ fdat->sample_type_list->select_callback = update_sample_type_list;
+ fdat->sample_type_list->select_callback_data = (void *)fdat;
+ slist_select(fdat->sample_type_list, fdat->sample_type_pos);
-/* -------- File:Insert dialog -------- */
+ scbox = gtk_vbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(form), scbox, false, false, 4);
+ gtk_widget_show(scbox);
-static void file_insert_cancel_callback(GtkWidget *w, gpointer context)
-{
- file_dialog_stop_playing(idat->dp);
- gtk_widget_hide(idat->fs->dialog);
-}
+ /* srate */
+ {
+ GtkWidget *srate_label;
+ srate_label = snd_gtk_highlight_label_new("srate");
+ gtk_box_pack_start(GTK_BOX(scbox), srate_label, false, false, 0);
+ gtk_widget_show(srate_label);
+ if (with_src)
+ {
+ GtkWidget *src_box;
+ src_box = gtk_hbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(scbox), src_box, false, false, 0);
+ gtk_widget_show(src_box);
+
+ fdat->srate_text = snd_entry_new(src_box, NULL, WITH_WHITE_BACKGROUND);
+ gtk_entry_set_width_chars(GTK_ENTRY(fdat->srate_text), 8);
+ SG_SIGNAL_CONNECT(fdat->srate_text, "key_press_event", data_panel_srate_key_press, NULL); /* srate completer */
+
+ fdat->src_button = gtk_check_button_new_with_label("src");
+ gtk_box_pack_end(GTK_BOX(src_box), fdat->src_button, false, false, 4);
+ SG_SIGNAL_CONNECT(fdat->src_button, "toggled", file_data_src_callback, fdat);
+ gtk_widget_show(fdat->src_button);
+ set_toggle_button(fdat->src_button, fdat->src, false, (void *)fdat);
+ }
+ else
+ {
+ fdat->srate_text = snd_entry_new(scbox, NULL, WITH_WHITE_BACKGROUND);
+ SG_SIGNAL_CONNECT(fdat->srate_text, "key_press_event", data_panel_srate_key_press, NULL); /* srate completer */
+ }
+ }
-static void file_insert_help_callback(GtkWidget *w, gpointer context)
-{
- insert_file_dialog_help();
-}
+ if (with_samples != WITH_SAMPLES_FIELD)
+ {
+ GtkWidget *spacer;
+ spacer = gtk_vseparator_new();
+ gtk_box_pack_start(GTK_BOX(scbox), spacer, false, false, 12);
+ gtk_widget_show(spacer);
+ }
+ /* chans */
+ if (with_chan != WITHOUT_CHANNELS_FIELD)
+ {
+ GtkWidget *chans_label;
+ chans_label = snd_gtk_highlight_label_new((with_chan == WITH_CHANNELS_FIELD) ? "channels" : "extract channel");
+ gtk_box_pack_start(GTK_BOX(scbox), chans_label, false, false, 0);
+ gtk_widget_show(chans_label);
-static gint file_insert_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
-{
- file_dialog_stop_playing(idat->dp);
- gtk_widget_hide(idat->fs->dialog);
- return(true);
-}
+ fdat->chans_text = snd_entry_new(scbox, NULL, WITH_WHITE_BACKGROUND);
+
+ if (with_loc == WITH_DATA_LOCATION_FIELD)
+ {
+ GtkWidget *loclab;
+ loclab = snd_gtk_highlight_label_new("location");
+ gtk_box_pack_start(GTK_BOX(scbox), loclab, false, false, 0);
+ gtk_widget_show(loclab);
+ fdat->location_text = snd_entry_new(scbox, NULL, WITH_WHITE_BACKGROUND);
+ }
+ }
-static void file_insert_ok_callback(GtkWidget *w, gpointer context)
-{
- file_dialog_info *fd = (file_dialog_info *)context;
- char *filename;
- filename = fsb_file_text(fd->fs);
- if ((!filename) || (!(*filename)))
+ /* samples */
+ if (with_samples == WITH_SAMPLES_FIELD)
{
- file_open_error("no filename given", fd);
- clear_error_if_open_changes(fd->fs, fd);
+ GtkWidget *samplab;
+ samplab = snd_gtk_highlight_label_new("samples");
+ gtk_box_pack_start(GTK_BOX(scbox), samplab, false, false, 0);
+ gtk_widget_show(samplab);
+
+ fdat->samples_text = snd_entry_new(scbox, NULL, WITH_WHITE_BACKGROUND);
}
else
{
- file_dialog_stop_playing(fd->dp);
- if (!(directory_p(filename))) /* this can be a directory name if the user clicked 'ok' when he meant 'cancel' */
- {
- bool ok = false;
- snd_info *sp;
- sp = any_selected_sound();
- ss->requestor_dialog = w;
- ss->open_requestor = FROM_INSERT_DIALOG;
- redirect_snd_error_to(redirect_file_open_error, (void *)fd);
- ok = insert_complete_file_at_cursor(sp, filename);
- redirect_snd_error_to(NULL, NULL);
- if (!ok)
- {
- if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
- {
- char *fullname;
- clear_error_if_open_changes(fd->fs, fd);
- fullname = mus_expand_filename(filename);
- if (!(mus_file_probe(fullname)))
- start_unsound_watcher(fd, filename);
- free(fullname);
- }
- }
- else
- {
- report_in_minibuffer(sp, "%s inserted at cursor", filename);
- }
- }
- else
- {
- char *str;
- str = mus_format("%s is a directory", filename);
- file_open_error(str, fd);
- clear_error_if_open_changes(fd->fs, fd);
- free(str);
- }
+ /* need a spacer to force the lists to have room */
+ GtkWidget *spacer;
+ spacer = gtk_vseparator_new();
+ gtk_box_pack_start(GTK_BOX(scbox), spacer, false, false, 12);
+ gtk_widget_show(spacer);
}
-}
-
-widget_t make_insert_file_dialog(bool managed)
-{
- if (idat == NULL)
- idat = make_file_dialog(FILE_READ_ONLY, "Insert", "insert:", "Insert", FILE_INSERT_DIALOG,
- (GCallback)file_insert_ok_callback,
- NULL, /* no mkdir */
- (GCallback)file_insert_delete_callback,
- (GCallback)file_insert_cancel_callback,
- (GCallback)file_insert_help_callback,
- GTK_STOCK_PASTE);
- else
+ /* comment */
+ if (with_comment != WITHOUT_COMMENT_FIELD)
{
- if (idat->fs->reread_directory)
- {
- force_directory_reread(idat->fs);
- idat->fs->reread_directory = false;
- }
- }
- if (managed) gtk_widget_show(idat->fs->dialog);
- return(idat->fs->dialog);
-}
-
+ GtkWidget *frame, *comment_label;
+ GtkWidget *w1, *combox;
+ w1 = gtk_vseparator_new();
+ gtk_box_pack_start(GTK_BOX(frame_box), w1, false, false, 4);
+ gtk_widget_show(w1);
-void set_open_file_play_button(bool val)
-{
- if ((odat) && (odat->dp->play_button))
- set_toggle_button(odat->dp->play_button, val, false, (gpointer)odat);
- if ((mdat) && (mdat->dp->play_button))
- set_toggle_button(mdat->dp->play_button, val, false, (gpointer)mdat);
- if ((idat) && (idat->dp->play_button))
- set_toggle_button(idat->dp->play_button, val, false, (gpointer)mdat);
-}
+ combox = gtk_hbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(frame_box), combox, false, true, 4);
+ gtk_widget_show(combox);
+ if (with_auto_comment)
+ {
+ GtkWidget *cbox;
+ cbox = gtk_vbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(combox), cbox, false, false, 0);
+ gtk_widget_show(cbox);
+
+ comment_label = snd_gtk_highlight_label_new("comment");
+ gtk_box_pack_start(GTK_BOX(cbox), comment_label, false, false, 0);
+ gtk_widget_show(comment_label);
+
+ fdat->auto_comment_button = gtk_check_button_new_with_label("auto");
+ gtk_box_pack_end(GTK_BOX(cbox), fdat->auto_comment_button, false, false, 4);
+ gtk_widget_show(fdat->auto_comment_button);
+ set_toggle_button(fdat->auto_comment_button, fdat->auto_comment, false, (void *)fdat);
+ }
+ else
+ {
+ comment_label = snd_gtk_highlight_label_new("comment");
+ gtk_box_pack_start(GTK_BOX(combox), comment_label, false, false, 0);
+ gtk_widget_show(comment_label);
+ }
-/* ---------------- file data panel ---------------- */
+ frame = gtk_frame_new(NULL);
+ gtk_box_pack_start(GTK_BOX(combox), frame, true, true, 4);
+ gtk_frame_set_shadow_type(GTK_FRAME(frame), GTK_SHADOW_IN);
+ gtk_widget_show(frame);
+ fdat->comment_text = make_scrolled_text(frame, true, CONTAINER_ADD, false); /* this returns a text_view widget */
+ connect_mouse_to_text(fdat->comment_text);
+ }
-char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, int *type, int *format, mus_long_t *location, mus_long_t *samples, int min_chan)
-{
- char *str;
- int res;
- char *comment = NULL;
- fdat->error_widget = NOT_A_SCANF_WIDGET;
- fdat->scanf_widget = NOT_A_SCANF_WIDGET;
+ /* error */
+ fdat->error_text = gtk_label_new(NULL);
+ gtk_box_pack_end(GTK_BOX(parent), fdat->error_text, false, false, 0);
+ gtk_widget_show(fdat->error_text);
- if ((srate) && (fdat->srate_text))
- {
- str = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->srate_text));
- fdat->scanf_widget = SRATE_WIDGET;
- if ((str) && (*str))
- (*srate) = string_to_int(str, 1, "srate");
- else snd_error_without_format("no srate?");
- }
+ return(fdat);
+}
- if ((chans) && (fdat->chans_text))
- {
- str = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->chans_text));
- fdat->scanf_widget = CHANS_WIDGET;
- if ((str) && (*str))
- (*chans) = string_to_int(str, min_chan, "chans");
- else
- {
- if (min_chan > 0)
- snd_error_without_format("no chans?");
- }
- }
- if ((location) && (fdat->location_text))
- {
- str = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->location_text));
- fdat->scanf_widget = DATA_LOCATION_WIDGET;
- if ((str) && (*str))
- (*location) = string_to_mus_long_t(str, 0, "data location");
- else snd_error_without_format("no data location?");
- }
+/* -------- save as dialog (file and edit menus) -------- */
- if ((samples) && (fdat->samples_text))
- {
- str = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->samples_text));
- fdat->scanf_widget = SAMPLES_WIDGET;
- if ((str) && (*str))
- (*samples) = string_to_mus_long_t(str, 0, "samples");
- else snd_error_without_format("no samples?");
- }
- fdat->scanf_widget = SAMPLES_WIDGET;
+static file_dialog_info *save_sound_as = NULL, *save_selection_as = NULL, *save_region_as = NULL;
- if (fdat->header_list)
- {
- res = fdat->header_list->selected_item;
- if (res == SLIST_NO_ITEM_SELECTED)
- res = fdat->header_pos;
- if (res != NO_SELECTION)
- {
- (*type) = position_to_type(res);
- fdat->current_type = (*type);
- }
- }
- if (fdat->format_list)
+void reflect_save_as_sound_selection(const char *sound_name)
+{
+ if (save_sound_as)
{
- res = fdat->format_list->selected_item;
- if (res == SLIST_NO_ITEM_SELECTED) /* can this happen? */
- res = fdat->format_pos;
- if (res != NO_SELECTION)
+ char *file_string;
+ if (sound_name)
+ file_string = mus_format("save %s", sound_name);
+ else
{
- (*format) = position_to_format(fdat->current_type, res);
- fdat->current_format = (*format);
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ file_string = mus_format("save %s", sp->short_filename);
+ else file_string = mus_strdup("nothing to save!");
}
+ gtk_window_set_title(GTK_WINDOW(save_sound_as->dialog), file_string);
+ free(file_string);
}
-
- if (fdat->comment_text)
- {
- if (GTK_IS_TEXT_VIEW(fdat->comment_text))
- comment = sg_get_text(fdat->comment_text, 0, -1);
- else comment = (char *)gtk_entry_get_text(GTK_ENTRY(fdat->comment_text));
- str = mus_strdup(comment);
- return(str);
- }
-
- return(NULL);
}
-#define IGNORE_DATA_LOCATION -1
-#define IGNORE_SAMPLES -1
-#define IGNORE_CHANS -1
-#define IGNORE_SRATE -1
-#define IGNORE_HEADER_TYPE -1
-
-static void set_file_dialog_sound_attributes(file_data *fdat, int type, int format, int srate, int chans, mus_long_t location, mus_long_t samples, char *comment)
+void reflect_save_as_src(bool val)
{
- int i;
- const char **fl = NULL;
- const char *str;
- if (!(fdat->format_list)) return;
-
- if (type != IGNORE_HEADER_TYPE)
- fdat->current_type = type;
- else fdat->current_type = MUS_RAW;
- fdat->current_format = format;
- fl = type_and_format_to_position(fdat, fdat->current_type, fdat->current_format);
- if (fl == NULL) return;
-
- if ((type != IGNORE_HEADER_TYPE) &&
- (fdat->header_list))
+ if (save_sound_as)
{
- slist_select(fdat->header_list, fdat->header_pos);
- slist_moveto(fdat->header_list, fdat->header_pos);
+ set_toggle_button(save_sound_as->panel_data->src_button, val, false, (void *)save_sound_as);
+ save_sound_as->panel_data->src = val;
}
-
- slist_clear(fdat->format_list);
- for (i = 0; i < fdat->formats; i++)
+ if (save_selection_as)
{
- str = fl[i];
- slist_append(fdat->format_list, str);
+ set_toggle_button(save_selection_as->panel_data->src_button, val, false, (void *)save_selection_as);
+ save_selection_as->panel_data->src = val;
}
- slist_select(fdat->format_list, fdat->format_pos);
- slist_moveto(fdat->format_list, fdat->format_pos);
-
- if ((srate != IGNORE_SRATE) &&
- (fdat->srate_text))
- widget_int_to_text(fdat->srate_text, srate);
-
- if ((chans != IGNORE_CHANS) &&
- (fdat->chans_text))
- widget_int_to_text(fdat->chans_text, chans);
-
- if (fdat->comment_text)
+ if (save_region_as)
{
- if (GTK_IS_TEXT_VIEW(fdat->comment_text))
- {
- gtk_text_buffer_set_text(gtk_text_view_get_buffer(GTK_TEXT_VIEW(fdat->comment_text)), "", 0);
- sg_text_insert(fdat->comment_text, comment);
- }
- else gtk_entry_set_text(GTK_ENTRY(fdat->comment_text), comment);
+ set_toggle_button(save_region_as->panel_data->src_button, val, false, (void *)save_region_as);
+ save_region_as->panel_data->src = val;
}
-
- if ((location != IGNORE_DATA_LOCATION) &&
- (fdat->location_text))
- widget_mus_long_t_to_text(fdat->location_text, location);
-
- if ((samples != IGNORE_SAMPLES) &&
- (fdat->samples_text))
- widget_mus_long_t_to_text(fdat->samples_text, samples);
}
-static gboolean data_panel_srate_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+void reflect_save_as_auto_comment(bool val)
{
- if (EVENT_KEYVAL(event) == snd_K_Tab)
+ if (save_sound_as)
{
- gtk_entry_set_text(GTK_ENTRY(w), srate_completer(w, (char *)gtk_entry_get_text(GTK_ENTRY(w)), NULL));
- gtk_editable_set_position(GTK_EDITABLE(w), mus_strlen((char *)gtk_entry_get_text(GTK_ENTRY(w))));
- return(true);
+ set_toggle_button(save_sound_as->panel_data->auto_comment_button, val, false, (void *)save_sound_as);
+ save_sound_as->panel_data->auto_comment = val;
}
- return(false);
}
-#define NUM_REFLECTION_IDS 5
-enum {REFLECT_SRATE_ID, REFLECT_CHANS_ID, REFLECT_SAMPLES_ID, REFLECT_LOCATION_ID, REFLECT_COMMENT_ID};
-
-static void reflect_file_data_panel_change(file_data *fd, void *data, void (*change_action)(GtkWidget *w, gpointer context))
+static void make_auto_comment(file_dialog_info *fd)
{
- if (!(fd->reflection_ids))
- fd->reflection_ids = (gulong *)calloc(NUM_REFLECTION_IDS, sizeof(gulong));
- if (fd->srate_text)
- fd->reflection_ids[REFLECT_SRATE_ID] = SG_SIGNAL_CONNECT(fd->srate_text, "changed", change_action, (gpointer)data);
- if (fd->chans_text)
- fd->reflection_ids[REFLECT_CHANS_ID] = SG_SIGNAL_CONNECT(fd->chans_text, "changed", change_action, (gpointer)data);
- if (fd->samples_text)
- fd->reflection_ids[REFLECT_SAMPLES_ID] = SG_SIGNAL_CONNECT(fd->samples_text, "changed", change_action, (gpointer)data);
- if (fd->location_text)
- fd->reflection_ids[REFLECT_LOCATION_ID] = SG_SIGNAL_CONNECT(fd->location_text, "changed", change_action, (gpointer)data);
- if (fd->comment_text)
+ if ((fd == save_sound_as) &&
+ (widget_is_active(fd->dialog)))
{
- if (GTK_IS_TEXT_VIEW(fd->comment_text))
- fd->reflection_ids[REFLECT_COMMENT_ID] =
- SG_SIGNAL_CONNECT(gtk_text_view_get_buffer(GTK_TEXT_VIEW(fd->comment_text)), "changed", change_action, (gpointer)data);
- else fd->reflection_ids[REFLECT_COMMENT_ID] = SG_SIGNAL_CONNECT(fd->comment_text, "changed", change_action, (gpointer)data);
- }
-}
+ file_data *fdat;
+ fdat = fd->panel_data;
+ if (!(fdat->auto_comment))
+ {
+ /* don't erase typed-in comment, if any */
+ sg_text_insert(fdat->comment_text, fdat->saved_comment);
+ }
+ else
+ {
+ snd_info *sp;
+ bool edits = false;
+ int i;
+ char *original_sound_comment, *comment, *orig_comment = NULL;
-static void unreflect_file_data_panel_change(file_data *fd, void *data, void (*change_action)(GtkWidget *w, gpointer context))
-{
- int i;
- if (!(fd->reflection_ids)) return;
- if ((fd->srate_text) && (fd->reflection_ids[REFLECT_SRATE_ID] > 0))
- g_signal_handler_disconnect(fd->srate_text, fd->reflection_ids[REFLECT_SRATE_ID]);
- if ((fd->chans_text) && (fd->reflection_ids[REFLECT_CHANS_ID] > 0))
- g_signal_handler_disconnect(fd->chans_text, fd->reflection_ids[REFLECT_CHANS_ID]);
- if ((fd->samples_text) && (fd->reflection_ids[REFLECT_SAMPLES_ID] > 0))
- g_signal_handler_disconnect(fd->samples_text, fd->reflection_ids[REFLECT_SAMPLES_ID]);
- if ((fd->location_text) && (fd->reflection_ids[REFLECT_LOCATION_ID] > 0))
- g_signal_handler_disconnect(fd->location_text, fd->reflection_ids[REFLECT_LOCATION_ID]);
- if ((fd->comment_text) && (fd->reflection_ids[REFLECT_COMMENT_ID] > 0))
- {
- if (GTK_IS_TEXT_VIEW(fd->comment_text))
- g_signal_handler_disconnect(gtk_text_view_get_buffer(GTK_TEXT_VIEW(fd->comment_text)), fd->reflection_ids[REFLECT_COMMENT_ID]);
- else g_signal_handler_disconnect(fd->comment_text, fd->reflection_ids[REFLECT_COMMENT_ID]);
- }
- for (i = 0; i < NUM_REFLECTION_IDS; i++) fd->reflection_ids[i] = 0;
-}
+ sp = any_selected_sound();
+ original_sound_comment = mus_sound_comment(sp->filename);
+ if (original_sound_comment)
+ {
+ if (*original_sound_comment)
+ orig_comment = mus_format("\n%s comment:\n%s\n", sp->short_filename, original_sound_comment);
+ free(original_sound_comment);
+ original_sound_comment = NULL;
+ }
-/* -------- panel error handling -------- */
+ fdat->saved_comment = sg_get_text(fdat->comment_text, 0, -1);
+ if ((fdat->saved_comment) &&
+ (!(*(fdat->saved_comment))))
+ fdat->saved_comment = NULL;
-/* if an error occurs, a callback is added to the offending text widget, and an error is
- * posted in the error_text label. When the user modifies the bad entry, the callback
- * erases the error message, and removes itself from the text widget.
- */
+ for (i = 0; i < sp->nchans; i++)
+ if (sp->chans[i]->edit_ctr != 0)
+ {
+ edits = true;
+ break;
+ }
-static void clear_dialog_error(file_data *fd)
-{
- gtk_widget_hide(fd->error_text);
-}
+ if (!edits)
+ comment = mus_format("%ssaved %s from %s (no edits)\n%s",
+ (fdat->saved_comment) ? "\n" : "",
+ snd_local_time(),
+ sp->filename,
+ (orig_comment) ? orig_comment : "");
+ else
+ {
+ int len;
+ char **edit_strs;
+ char *time;
+
+ time = snd_local_time();
+ len = 2 * mus_strlen(sp->filename) +
+ mus_strlen(time) +
+ 32 * sp->nchans +
+ mus_strlen(fdat->saved_comment) +
+ mus_strlen(original_sound_comment);
+ edit_strs = (char **)malloc(sp->nchans * sizeof(char *));
+ for (i = 0; i < sp->nchans; i++)
+ {
+ edit_strs[i] = edit_list_to_function(sp->chans[i], 1, sp->chans[i]->edit_ctr);
+ len += mus_strlen(edit_strs[i]);
+ }
-static void show_dialog_error(file_data *fd)
-{
- gtk_widget_show(fd->error_text);
-}
+ comment = (char *)calloc(len, sizeof(char));
+ snprintf(comment, len, "%ssaved %s from %s with edits:\n",
+ (fdat->saved_comment) ? "\n" : "",
+ snd_local_time(),
+ sp->filename);
+
+ for (i = 0; i < sp->nchans; i++)
+ {
+ if (sp->nchans > 1)
+ {
+ char buf[32];
+ snprintf(buf, 32, "\n-------- channel %d --------\n", i);
+ strcat(comment, buf);
+ }
+ strcat(comment, edit_strs[i]);
+ }
+ if (orig_comment)
+ strcat(comment, orig_comment);
+ free(edit_strs);
+ }
-static void post_file_dialog_error(const char *error_msg, file_data *fd)
-{
- gtk_entry_set_text(GTK_ENTRY(fd->error_text), (gchar *)error_msg);
- show_dialog_error(fd);
+ sg_text_insert(fdat->comment_text, comment);
+ if (comment) free(comment);
+ if (orig_comment) free(orig_comment);
+ }
+ }
}
-static void redirect_post_file_dialog_error(const char *error_msg, void *ufd)
+static void file_data_auto_comment_callback(GtkWidget *w, gpointer context)
{
- post_file_dialog_error(error_msg, (file_data *)ufd);
+ file_dialog_info *fd = (file_dialog_info *)context;
+ fd->panel_data->auto_comment = (bool)(TOGGLE_BUTTON_ACTIVE(w));
+ make_auto_comment(fd);
}
-/* key press event here, not key release -- the latter is triggered by the <return> release
- * that triggered the error, so our error is immediately erased
- */
-static gulong key_press_filename_handler_id = 0;
-
-static void clear_filename_handlers(fsb *fs)
+void reflect_selection_in_save_as_dialog(bool on)
{
- if (key_press_filename_handler_id)
- {
- g_signal_handler_disconnect(fs->file_text, key_press_filename_handler_id);
- key_press_filename_handler_id = 0;
- }
+ if ((on) &&
+ (save_selection_as) &&
+ (save_selection_as->panel_data))
+ clear_dialog_error(save_selection_as->panel_data);
}
-static gulong chans_key_press_handler_id = 0;
-
-static gboolean chans_key_press_callback(GtkWidget *w, GdkEventKey *event, gpointer data)
+void reflect_region_in_save_as_dialog(void)
{
- file_data *fd = (file_data *)data;
- clear_dialog_error(fd);
- if (chans_key_press_handler_id)
- {
- g_signal_handler_disconnect(fd->chans_text, chans_key_press_handler_id);
- chans_key_press_handler_id = 0;
- }
- return(false);
+ if ((save_region_as) &&
+ (save_region_as->dialog) &&
+ (widget_is_active(save_region_as->dialog)) &&
+ (region_ok(region_dialog_region())))
+ clear_dialog_error(save_region_as->panel_data);
}
-static void clear_error_if_chans_changes(GtkWidget *dialog, void *data)
+static void save_as_undoit(file_dialog_info *fd)
{
- file_data *fd = (file_data *)data;
- if (fd->chans_text)
- chans_key_press_handler_id = SG_SIGNAL_CONNECT(fd->chans_text, "key_press_event", chans_key_press_callback, data);
+ set_stock_button_label(fd->ok_button, "Save");
+ clear_dialog_error(fd->panel_data);
+ fd->file_watcher = unmonitor_file(fd->file_watcher);
}
-static gulong panel_modify_handler_id = 0;
-static gboolean panel_modify_callback(GtkWidget *w, GdkEventKey *event, gpointer data)
+
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+static void watch_save_as_file(GFileMonitor *mon, GFile *file, GFile *other, GFileMonitorEvent ev, gpointer data)
{
- file_data *fd = (file_data *)data;
- clear_dialog_error(fd);
- if (panel_modify_handler_id)
+ /* if file is deleted, respond in some debonair manner */
+ switch (ev)
{
- g_signal_handler_disconnect(w, panel_modify_handler_id);
- panel_modify_handler_id = 0;
+ case G_FILE_MONITOR_EVENT_CHANGED:
+ case G_FILE_MONITOR_EVENT_DELETED:
+ case G_FILE_MONITOR_EVENT_CREATED:
+#if HAVE_GTK_WIDGET_GET_VISIBLE
+ case G_FILE_MONITOR_EVENT_MOVED:
+#endif
+ save_as_undoit((file_dialog_info *)data);
+ break;
+
+ default:
+ /* ignore the rest */
+ break;
}
- return(false);
}
+#endif
-static void clear_error_if_panel_changes(GtkWidget *dialog, file_data *fd)
+static bool srates_differ(int srate, file_dialog_info *fd)
{
- GtkWidget *baddy;
- switch (fd->error_widget)
+ switch (fd->type)
{
- case SRATE_WIDGET: baddy = fd->srate_text; break;
- case DATA_LOCATION_WIDGET: baddy = fd->location_text; break;
- case SAMPLES_WIDGET: baddy = fd->samples_text; break;
- default: baddy = fd->chans_text; break;
+ case SOUND_SAVE_AS:
+ return(snd_srate(any_selected_sound()) != srate);
+
+ case SELECTION_SAVE_AS:
+ return(selection_srate() != srate);
+
+ case REGION_SAVE_AS:
+ return(region_srate(region_dialog_region()) != srate);
}
- if (baddy)
- panel_modify_handler_id = SG_SIGNAL_CONNECT(baddy, "key_press_event", panel_modify_callback, (void *)fd);
-}
-
-
-static void post_file_panel_error(const char *error_msg, file_data *fd)
-{
- fd->error_widget = fd->scanf_widget;
- post_file_dialog_error(error_msg, fd);
-}
-
-static void redirect_post_file_panel_error(const char *error_msg, void *ufd)
-{
- post_file_panel_error(error_msg, (file_data *)ufd);
+ return(false);
}
-/* -------- file data choices -------- */
-
-static void update_header_type_list(const char *name, int row, void *data)
+static double srate_ratio(int srate, file_dialog_info *fd)
{
- /* needed to reflect type selection in format list */
- file_data *fd = (file_data *)data;
- if (position_to_type(row) != fd->current_type)
+ switch (fd->type)
{
- position_to_type_and_format(fd, row);
- set_file_dialog_sound_attributes(fd,
- fd->current_type,
- fd->current_format,
- IGNORE_SRATE, IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
- NULL);
+ case SOUND_SAVE_AS:
+ return((double)(snd_srate(any_selected_sound())) / (double)srate);
+
+ case SELECTION_SAVE_AS:
+ return((double)selection_srate() / (double)srate);
+
+ case REGION_SAVE_AS:
+ return((double)region_srate(region_dialog_region()) / (double)srate);
}
-}
-
-static void update_data_format_list(const char *name, int row, void *data)
-{
- file_data *fd = (file_data *)data;
- fd->current_format = position_to_format(fd->current_type, row);
+ return(1.0);
}
-static void file_data_src_callback(GtkWidget *w, gpointer context)
+static void save_or_extract(file_dialog_info *fd, bool saving)
{
- file_data *fd = (file_data *)context;
- fd->src = (bool)(TOGGLE_BUTTON_ACTIVE(w));
-}
-
+ char *str = NULL, *comment = NULL, *msg = NULL, *fullname = NULL, *tmpfile = NULL;
+ snd_info *sp = NULL;
+ mus_header_t header_type = MUS_NEXT, output_type;
+ mus_sample_t sample_type = DEFAULT_OUTPUT_SAMPLE_TYPE;
+ int srate = DEFAULT_OUTPUT_SRATE, chans = DEFAULT_OUTPUT_CHANS;
+ int chan = 0, extractable_chans = 0;
+ bool file_exists = false;
+ mus_long_t location = 28, samples = 0;
+ io_error_t io_err = IO_NO_ERROR;
-static file_data *make_file_data_panel(GtkWidget *parent, const char *name,
- dialog_channels_t with_chan,
- int header_type, int data_format,
- dialog_data_location_t with_loc,
- dialog_samples_t with_samples,
- dialog_header_type_t with_header_type,
- dialog_comment_t with_comment,
- header_choice_t header_choice,
- bool with_src, bool with_auto_comment)
-{
- GtkWidget *form, *scbox, *combox = NULL, *frame, *frame_box;
- file_data *fdat;
- int nformats = 0, nheaders = 0;
- const char **formats = NULL, **headers = NULL;
+ clear_dialog_error(fd->panel_data);
- switch (header_choice)
+ if ((fd->type == SELECTION_SAVE_AS) &&
+ (!(selection_is_active())))
{
- case WITH_READABLE_HEADERS: headers = short_readable_headers(&nheaders); break;
- case WITH_WRITABLE_HEADERS: headers = short_writable_headers(&nheaders); break;
- case WITH_BUILTIN_HEADERS: headers = short_builtin_headers(&nheaders); break;
+ if (saving)
+ msg = (char *)"no selection to save";
+ else msg = (char *)"can't extract: no selection";
+ post_file_dialog_error((const char *)msg, fd->panel_data);
+ return;
}
- fdat = (file_data *)calloc(1, sizeof(file_data));
- fdat->src = save_as_dialog_src(ss);
- fdat->auto_comment = save_as_dialog_auto_comment(ss);
- fdat->saved_comment = NULL;
- fdat->current_type = header_type;
- fdat->current_format = data_format;
- formats = type_and_format_to_position(fdat, header_type, data_format);
- nformats = fdat->formats;
-
- frame = gtk_frame_new(NULL);
- gtk_box_pack_start(GTK_BOX(parent), frame, false, false, 8);
- gtk_widget_show(frame);
+ if ((fd->type == REGION_SAVE_AS) &&
+ (!(region_ok(region_dialog_region()))))
+ {
+ post_file_dialog_error("no region to save", fd->panel_data);
+ return;
+ }
- frame_box = gtk_vbox_new(false, 0);
- gtk_container_add(GTK_CONTAINER(frame), frame_box);
- gtk_widget_show(frame_box);
+ sp = any_selected_sound();
+ if ((!sp) &&
+ (fd->type != REGION_SAVE_AS))
+ {
+ if (saving)
+ msg = (char *)"nothing to save";
+ else msg = (char *)"nothing to extract";
+ post_file_dialog_error((const char *)msg, fd->panel_data);
+ return;
+ }
- form = gtk_hbox_new(true, 8);
- gtk_box_pack_start(GTK_BOX(frame_box), form, false, false, 4);
- gtk_widget_show(form);
+ /* get output filename */
+ str = gtk_file_chooser_get_filename(GTK_FILE_CHOOSER(fd->chooser));
+ if ((!str) || (!*str))
+ {
+ if (saving)
+ msg = (char *)"can't save: no file name given";
+ else msg = (char *)"can't extract: no file name given";
+ post_file_dialog_error((const char *)msg, fd->panel_data);
+ return;
+ }
+ if (is_directory(str))
+ {
+ post_file_dialog_error("can't overwrite a directory", fd->panel_data);
+ return;
+ }
- /* header type */
- if (with_header_type == WITH_HEADER_TYPE_FIELD)
+ /* get output file attributes */
+ redirect_snd_error_to(redirect_post_file_panel_error, (void *)(fd->panel_data));
+ if (saving)
+ comment = get_file_dialog_sound_attributes(fd->panel_data, &srate, &chans, &header_type, &sample_type, &location, &samples, 0);
+ else comment = get_file_dialog_sound_attributes(fd->panel_data, &srate, &chan, &header_type, &sample_type, &location, &samples, 0);
+ output_type = header_type;
+ redirect_snd_error_to(NULL, NULL);
+ if (fd->panel_data->error_widget != NOT_A_SCANF_WIDGET)
{
- fdat->header_list = slist_new_with_title("header type", form, (const char **)headers, nheaders, BOX_PACK); /* BOX_PACK widget_add_t (snd-g0.h) */
- fdat->header_list->select_callback = update_header_type_list;
- fdat->header_list->select_callback_data = (void *)fdat;
- slist_select(fdat->header_list, fdat->header_pos);
+ clear_error_if_panel_changes(fd->dialog, fd->panel_data);
+ if (comment) free(comment);
+ return;
}
- /* data format */
- fdat->format_list = slist_new_with_title("data type", form, (const char **)formats, nformats, BOX_PACK);
- fdat->format_list->select_callback = update_data_format_list;
- fdat->format_list->select_callback_data = (void *)fdat;
- slist_select(fdat->format_list, fdat->format_pos);
+ switch (fd->type)
+ {
+ case SOUND_SAVE_AS:
+ clear_status_area(sp);
+ if (!saving)
+ extractable_chans = sp->nchans;
+ break;
- scbox = gtk_vbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(form), scbox, false, false, 4);
- gtk_widget_show(scbox);
+ case SELECTION_SAVE_AS:
+ if (!saving)
+ extractable_chans = selection_chans();
+ break;
- /* srate */
- {
- GtkWidget *srate_label;
- srate_label = snd_gtk_highlight_label_new("srate");
- gtk_box_pack_start(GTK_BOX(scbox), srate_label, false, false, 0);
- gtk_widget_show(srate_label);
+ default:
+ break;
+ }
- if (with_src)
- {
- GtkWidget *src_box;
- src_box = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(scbox), src_box, false, false, 0);
- gtk_widget_show(src_box);
-
- fdat->srate_text = snd_entry_new(src_box, WITH_WHITE_BACKGROUND);
- gtk_entry_set_width_chars(GTK_ENTRY(fdat->srate_text), 8);
- SG_SIGNAL_CONNECT(fdat->srate_text, "key_press_event", data_panel_srate_key_press, NULL); /* srate completer */
-
- fdat->src_button = gtk_check_button_new_with_label("src");
- gtk_box_pack_end(GTK_BOX(src_box), fdat->src_button, false, false, 4);
- SG_SIGNAL_CONNECT(fdat->src_button, "toggled", file_data_src_callback, fdat);
- gtk_widget_show(fdat->src_button);
- set_toggle_button(fdat->src_button, fdat->src, false, (void *)fdat);
- }
- else
- {
- fdat->srate_text = snd_entry_new(scbox, WITH_WHITE_BACKGROUND);
- SG_SIGNAL_CONNECT(fdat->srate_text, "key_press_event", data_panel_srate_key_press, NULL); /* srate completer */
- }
- }
+ if (!saving)
+ {
+ if ((chan > extractable_chans) ||
+ (((extractable_chans > 1) && (chan == extractable_chans)) ||
+ (chan < 0)))
+ {
+ if (chan > extractable_chans)
+ msg = mus_format("can't extract chan %d (%s has %d chan%s)",
+ chan,
+ (fd->type == SOUND_SAVE_AS) ? "sound" : "selection",
+ extractable_chans,
+ (extractable_chans > 1) ? "s" : "");
+ else msg = mus_format("can't extract chan %d (first chan is numbered 0)", chan);
+ post_file_dialog_error((const char *)msg, fd->panel_data);
+ clear_error_if_chans_changes(fd->dialog, (void *)(fd->panel_data));
+ free(msg);
+ if (comment) free(comment);
+ return;
+ }
+ }
- /* chans */
- if (with_chan != WITHOUT_CHANNELS_FIELD)
+ fullname = mus_expand_filename(str);
+ if (run_before_save_as_hook(sp, fullname, fd->type != SOUND_SAVE_AS, srate, sample_type, header_type, comment))
{
- GtkWidget *chans_label;
- chans_label = snd_gtk_highlight_label_new((with_chan == WITH_CHANNELS_FIELD) ? "channels" : "extract channel");
- gtk_box_pack_start(GTK_BOX(scbox), chans_label, false, false, 0);
- gtk_widget_show(chans_label);
+ msg = mus_format("%s cancelled by %s", (saving) ? "save" : "extract", S_before_save_as_hook);
+ post_file_dialog_error((const char *)msg, fd->panel_data);
+ free(msg);
+ free(fullname);
+ if (comment) free(comment);
+ return;
+ }
- fdat->chans_text = snd_entry_new(scbox, WITH_WHITE_BACKGROUND);
-
- if (with_loc == WITH_DATA_LOCATION_FIELD)
+ file_exists = mus_file_probe(fullname);
+ if ((fd->type == SOUND_SAVE_AS) &&
+ (mus_strcmp(fullname, sp->filename)))
+ {
+ /* save-as here is the same as save */
+ if ((sp->user_read_only == FILE_READ_ONLY) ||
+ (sp->file_read_only == FILE_READ_ONLY))
{
- GtkWidget *loclab;
- loclab = snd_gtk_highlight_label_new("location");
- gtk_box_pack_start(GTK_BOX(scbox), loclab, false, false, 0);
- gtk_widget_show(loclab);
-
- fdat->location_text = snd_entry_new(scbox, WITH_WHITE_BACKGROUND);
+ msg = mus_format("can't overwrite %s (it is write-protected)", sp->short_filename);
+ post_file_dialog_error((const char *)msg, fd->panel_data);
+ free(msg);
+ free(fullname);
+ if (comment) free(comment);
+ return;
}
}
-
- /* samples */
- if (with_samples == WITH_SAMPLES_FIELD)
+ else
{
- GtkWidget *samplab;
- samplab = snd_gtk_highlight_label_new("samples");
- gtk_box_pack_start(GTK_BOX(scbox), samplab, false, false, 0);
- gtk_widget_show(samplab);
+ if (!(fd->file_watcher))
+ {
+ /* check for overwrites that are questionable -- DoIt click will return here with fd->file_watcher active */
+ snd_info *parlous_sp = NULL;
+ if ((file_exists) &&
+ ((ask_before_overwrite(ss)) ||
+ ((fd->type == SOUND_SAVE_AS) &&
+ (parlous_sp = file_is_open_elsewhere_and_has_unsaved_edits(sp, fullname)))))
+ {
+ msg = mus_format("%s exists%s. To overwrite it, click '%s'",
+ str,
+ (parlous_sp) ? ", and has unsaved edits" : "",
+ "DoIt"
+ );
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+ {
+ GFile *file;
+ GError *err = NULL;
+ file = g_file_new_for_path(fullname);
+ fd->file_watcher = (void *)g_file_monitor_file(file, G_FILE_MONITOR_NONE, NULL, &err);
+ if (err != NULL)
+ snd_warning("%s", err->message);
+ else g_signal_connect(G_OBJECT(fd->file_watcher), "changed", G_CALLBACK(watch_save_as_file), (gpointer)fd);
+ g_object_unref(file);
+ }
+#endif
+ post_file_dialog_error((const char *)msg, fd->panel_data);
+ set_stock_button_label(fd->ok_button, "DoIt");
+ free(msg);
+ free(fullname);
+ if (comment) free(comment);
+ return;
+ }
+ }
+ }
- fdat->samples_text = snd_entry_new(scbox, WITH_WHITE_BACKGROUND);
+ /* try to save... if it exists already, first write as temp, then move */
+
+ if (fd->file_watcher)
+ save_as_undoit(fd);
+ ss->local_errno = 0;
+
+ if (header_is_encoded(header_type))
+ {
+ output_type = header_type;
+ sample_type = MUS_LSHORT;
+ header_type = MUS_RIFF;
+ tmpfile = snd_tempnam();
}
else
{
- /* need a spacer to force the lists to have room */
- GtkWidget *spacer;
- spacer = gtk_vseparator_new();
- gtk_box_pack_start(GTK_BOX(scbox), spacer, false, false, 10);
- gtk_widget_show(spacer);
+ tmpfile = fullname;
}
- /* comment */
- if (with_comment != WITHOUT_COMMENT_FIELD)
+ redirect_snd_error_to(redirect_post_file_dialog_error, (void *)(fd->panel_data));
+ switch (fd->type)
{
- GtkWidget *frame, *comment_label;
- GtkWidget *w1;
+ case SOUND_SAVE_AS:
+ if (saving)
+ io_err = save_edits_without_display(sp, tmpfile, header_type, sample_type, srate, comment, AT_CURRENT_EDIT_POSITION);
+ else io_err = save_channel_edits(sp->chans[chan], tmpfile, AT_CURRENT_EDIT_POSITION); /* protects if same name */
+ break;
- w1 = gtk_vseparator_new();
- gtk_box_pack_start(GTK_BOX(frame_box), w1, false, false, 4);
- gtk_widget_show(w1);
+ case SELECTION_SAVE_AS:
+ {
+ char *ofile;
+ if (file_exists) /* file won't exist if we're encoding, so this isn't as wasteful as it looks */
+ ofile = snd_tempnam();
+ else ofile = mus_strdup(tmpfile);
+ io_err = save_selection(ofile, srate, sample_type, header_type, comment, (saving) ? SAVE_ALL_CHANS : chan);
+ if (io_err == IO_NO_ERROR)
+ io_err = move_file(ofile, fullname);
+ free(ofile);
+ break;
+ }
- combox = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(frame_box), combox, true, true, 4);
- gtk_widget_show(combox);
+ case REGION_SAVE_AS:
+ {
+ if (region_ok(region_dialog_region()))
+ {
+ char *ofile;
+ if (file_exists)
+ ofile = snd_tempnam();
+ else ofile = mus_strdup(tmpfile);
+ io_err = save_region(region_dialog_region(), ofile, sample_type, header_type, comment);
+ if (io_err == IO_NO_ERROR)
+ io_err = move_file(ofile, fullname);
+ free(ofile);
+ }
+ }
+ break;
+ }
+ redirect_snd_error_to(NULL, NULL);
- if (with_auto_comment)
+ /* check for possible srate conversion */
+ if ((fd->panel_data->src) &&
+ (srates_differ(srate, fd)))
+ {
+ /* if src, and srates differ, do the sampling rate conversion.
+ * this needs to happen before the snd_encode (->OGG etc) below
+ * if we do it before the save-as above, then undo it later, it messes up the user's edit history list
+ * so do it here to tmpfile (tmpfile is fullname unless we're doing a translation to something like OGG)
+ */
+ src_file(tmpfile, srate_ratio(srate, fd));
+ }
+
+ if (io_err == IO_NO_ERROR)
+ {
+ if (header_is_encoded(output_type))
{
- GtkWidget *cbox;
- cbox = gtk_vbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(combox), cbox, false, false, 0);
- gtk_widget_show(cbox);
-
- comment_label = snd_gtk_highlight_label_new("comment");
- gtk_box_pack_start(GTK_BOX(cbox), comment_label, false, false, 0);
- gtk_widget_show(comment_label);
-
- fdat->auto_comment_button = gtk_check_button_new_with_label("auto");
- gtk_box_pack_end(GTK_BOX(cbox), fdat->auto_comment_button, false, false, 4);
- gtk_widget_show(fdat->auto_comment_button);
- set_toggle_button(fdat->auto_comment_button, fdat->auto_comment, false, (void *)fdat);
+ snd_encode(output_type, tmpfile, fullname);
+ snd_remove(tmpfile, REMOVE_FROM_CACHE);
+ free(tmpfile);
+ }
+
+ if (saving)
+ {
+ if (fd->type == SOUND_SAVE_AS)
+ status_report(sp, "%s saved as %s", sp->short_filename, str);
+ else status_report(sp, "%s saved as %s", (fd->type == SELECTION_SAVE_AS) ? "selection" : "region", str);
}
else
{
- comment_label = snd_gtk_highlight_label_new("comment");
- gtk_box_pack_start(GTK_BOX(combox), comment_label, false, false, 0);
- gtk_widget_show(comment_label);
+ if (fd->type == SOUND_SAVE_AS)
+ status_report(sp, "%s chan %d saved as %s", sp->short_filename, chan, str);
+ else status_report(sp, "selection chan %d saved as %s", chan, str);
}
-
- frame = gtk_frame_new(NULL);
- gtk_box_pack_start(GTK_BOX(combox), frame, true, true, 4);
- gtk_frame_set_shadow_type(GTK_FRAME(frame), GTK_SHADOW_IN);
- gtk_widget_show(frame);
- fdat->comment_text = make_scrolled_text(frame, true, 0, false); /* this returns a text_view widget */
- connect_mouse_to_text(fdat->comment_text);
+ run_after_save_as_hook(sp, str, true); /* true => from dialog */
+ gtk_widget_hide(fd->dialog);
}
-
- /* error */
- fdat->error_text = make_info_widget();
- gtk_box_pack_end(GTK_BOX(parent), fdat->error_text, false, false, 0);
- gtk_widget_hide(fdat->error_text);
-
- return(fdat);
+ else
+ {
+ msg = mus_format("%s as %s: %s (%s)", (saving) ? "save" : "extract chan", str, io_error_name(io_err), snd_io_strerror());
+ post_file_dialog_error((const char *)msg, fd->panel_data);
+ free(msg);
+ }
+ free(fullname);
+ if (comment) free(comment);
}
-/* -------- save as dialog (file and edit menus) -------- */
-
-typedef struct {
- fsb *fs;
- file_data *panel_data;
- char *filename;
- save_dialog_t type;
- dialog_play_info *dp;
- fam_info *file_watcher;
- gulong filename_watcher_id;
- int header_type, format_type;
-} save_as_dialog_info;
+static void save_as_ok_callback(GtkWidget *w, gpointer data)
+{
+ save_or_extract((file_dialog_info *)data, true);
+}
-static save_as_dialog_info *save_sound_as = NULL, *save_selection_as = NULL, *save_region_as = NULL;
-static gboolean filename_modify_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+static void save_as_extract_callback(GtkWidget *w, gpointer data)
{
- save_as_dialog_info *sd = (save_as_dialog_info *)data;
- clear_dialog_error(sd->panel_data);
- clear_filename_handlers(sd->fs);
- return(false);
+ save_or_extract((file_dialog_info *)data, false);
}
-void reflect_save_as_sound_selection(const char *sound_name)
-{
- if (save_sound_as)
- {
- char *file_string;
- if (sound_name)
- file_string = mus_format("save %s", sound_name);
- else
- {
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- file_string = mus_format("save %s", sp->short_filename);
- else file_string = mus_strdup("nothing to save!");
- }
- gtk_window_set_title(GTK_WINDOW(save_sound_as->fs->dialog), file_string);
- free(file_string);
- }
-}
+static void save_as_cancel_callback(GtkWidget *w, gpointer data)
+{
+ file_dialog_info *fd = (file_dialog_info *)data;
+ gtk_widget_hide(fd->dialog);
+}
-void reflect_save_as_src(bool val)
+static void save_as_help_callback(GtkWidget *w, gpointer data)
{
- if (save_sound_as)
- {
- set_toggle_button(save_sound_as->panel_data->src_button, val, false, (void *)save_sound_as);
- save_sound_as->panel_data->src = val;
- }
- if (save_selection_as)
- {
- set_toggle_button(save_selection_as->panel_data->src_button, val, false, (void *)save_selection_as);
- save_selection_as->panel_data->src = val;
- }
- if (save_region_as)
- {
- set_toggle_button(save_region_as->panel_data->src_button, val, false, (void *)save_region_as);
- save_region_as->panel_data->src = val;
- }
+ save_as_dialog_help();
}
-void reflect_save_as_auto_comment(bool val)
+static gint save_as_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
{
- if (save_sound_as)
- {
- set_toggle_button(save_sound_as->panel_data->auto_comment_button, val, false, (void *)save_sound_as);
- save_sound_as->panel_data->auto_comment = val;
- }
+ file_dialog_info *fd = (file_dialog_info *)context;
+ gtk_widget_hide(fd->dialog);
+ return(true);
}
-static void make_auto_comment(save_as_dialog_info *sd)
+static file_dialog_info *make_save_as_dialog(const char *file_string, mus_header_t header_type, mus_sample_t sample_type, int dialog_type)
{
- if ((sd == save_sound_as) &&
- (widget_is_active(sd->fs->dialog)))
- {
- file_data *fd;
- fd = sd->panel_data;
+ file_dialog_info *fd;
+ GtkWidget *vbox;
- if (!(fd->auto_comment))
- {
- /* don't erase typed-in comment, if any */
- sg_text_insert(fd->comment_text, fd->saved_comment);
- }
- else
- {
- snd_info *sp;
- bool edits = false;
- int i;
- char *original_sound_comment, *comment, *orig_comment = NULL;
-
- sp = any_selected_sound();
-
- original_sound_comment = mus_sound_comment(sp->filename);
- if (original_sound_comment)
- {
- if (*original_sound_comment)
- orig_comment = mus_format("\n%s comment:\n%s\n", sp->short_filename, original_sound_comment);
- free(original_sound_comment);
- original_sound_comment = NULL;
- }
-
- fd->saved_comment = sg_get_text(fd->comment_text, 0, -1);
- if ((fd->saved_comment) &&
- (!(*(fd->saved_comment))))
- fd->saved_comment = NULL;
-
- for (i = 0; i < sp->nchans; i++)
- if (sp->chans[i]->edit_ctr != 0)
- {
- edits = true;
- break;
- }
-
- if (!edits)
- comment = mus_format("%ssaved %s from %s (no edits)\n%s",
- (fd->saved_comment) ? "\n" : "",
- snd_local_time(),
- sp->filename,
- (orig_comment) ? orig_comment : "");
- else
- {
- int len;
- char **edit_strs;
- char *time;
-
- time = snd_local_time();
- len = 2 * mus_strlen(sp->filename) +
- mus_strlen(time) +
- 32 * sp->nchans +
- mus_strlen(fd->saved_comment) +
- mus_strlen(original_sound_comment);
-
- edit_strs = (char **)malloc(sp->nchans * sizeof(char *));
- for (i = 0; i < sp->nchans; i++)
- {
- edit_strs[i] = edit_list_to_function(sp->chans[i], 1, sp->chans[i]->edit_ctr);
- len += mus_strlen(edit_strs[i]);
- }
-
- comment = (char *)calloc(len, sizeof(char));
- mus_snprintf(comment, len, "%ssaved %s from %s with edits:\n",
- (fd->saved_comment) ? "\n" : "",
- snd_local_time(),
- sp->filename);
-
- for (i = 0; i < sp->nchans; i++)
- {
- if (sp->nchans > 1)
- {
- char buf[32];
- snprintf(buf, 32, "\n-------- channel %d --------\n", i);
- strcat(comment, buf);
- }
- strcat(comment, edit_strs[i]);
- }
-
- if (orig_comment)
- strcat(comment, orig_comment);
- }
-
- sg_text_insert(fd->comment_text, comment);
- if (comment) free(comment);
- if (orig_comment) free(orig_comment);
- }
- }
-}
-
-
-static void file_data_auto_comment_callback(GtkWidget *w, gpointer context)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- sd->panel_data->auto_comment = (bool)(TOGGLE_BUTTON_ACTIVE(w));
- make_auto_comment(sd);
-}
-
-
-static void clear_error_if_filename_changes(fsb *fs, save_as_dialog_info *sd)
-{
- key_press_filename_handler_id = SG_SIGNAL_CONNECT(fs->file_text, "key_press_event", filename_modify_key_press, (void *)sd);
-}
-
-
-
-static save_as_dialog_info *new_save_as_dialog_info(save_dialog_t type)
-{
- save_as_dialog_info *sd;
- sd = (save_as_dialog_info *)calloc(1, sizeof(save_as_dialog_info));
- sd->type = type;
- sd->filename_watcher_id = 0;
- return(sd);
-}
-
-
-static XEN save_selection_hook_handler(XEN xreason)
-{
- int reason;
- save_as_dialog_info *sd;
-
- sd = save_selection_as;
- reason = XEN_TO_C_INT(xreason);
-
- if ((reason == SELECTION_ACTIVE) ||
- (selection_is_active()))
- {
- clear_dialog_error(sd->panel_data);
- }
- return(XEN_FALSE);
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(save_selection_hook_handler_w, save_selection_hook_handler)
-#else
- #define save_selection_hook_handler_w save_selection_hook_handler
-#endif
-
-
-
-void reflect_region_in_save_as_dialog(void)
-{
- if ((save_region_as) &&
- (save_region_as->fs->dialog) &&
- (widget_is_active(save_region_as->fs->dialog)) &&
- (region_ok(region_dialog_region())))
- clear_dialog_error(save_region_as->panel_data);
-}
-
-
-static void save_as_undoit(save_as_dialog_info *sd)
-{
- set_stock_button_label(sd->fs->ok_button, "Save");
- if ((sd->filename_watcher_id > 0) && (sd->fs->file_text))
- {
- g_signal_handler_disconnect(sd->fs->file_text, sd->filename_watcher_id);
- sd->filename_watcher_id = 0;
- }
- clear_dialog_error(sd->panel_data);
- sd->file_watcher = fam_unmonitor_file(sd->filename, sd->file_watcher);
-}
-
-
-static void save_as_filename_modify_callback(GtkWidget *w, gpointer context)
-{
- save_as_undoit((save_as_dialog_info *)context);
-}
-
-
-static void clear_error_if_save_as_filename_changes(GtkWidget *dialog, gpointer data)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)data;
- if (sd->fs->file_text)
- sd->filename_watcher_id = SG_SIGNAL_CONNECT(sd->fs->file_text, "changed", save_as_filename_modify_callback, data);
-}
-
-
-static void watch_save_as_file(struct fam_info *fp, FAMEvent *fe)
-{
-#if HAVE_FAM
- /* if file is deleted, respond in some debonair manner */
- switch (fe->code)
- {
- case FAMChanged:
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- save_as_undoit((save_as_dialog_info *)(fp->data));
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-#endif
-}
-
-
-static bool srates_differ(int srate, save_as_dialog_info *sd)
-{
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- return(SND_SRATE(any_selected_sound()) != srate);
-
- case SELECTION_SAVE_AS:
- return(selection_srate() != srate);
-
- case REGION_SAVE_AS:
- return(region_srate(region_dialog_region()) != srate);
- }
-
- return(false);
-}
+ fd = make_fsb(file_string, "save as:", "Save as", ICON_SAVE_AS, (dialog_type != REGION_SAVE_AS), true);
+ fd->type = (save_dialog_t)dialog_type;
+ fd->header_type = header_type;
+ fd->sample_type = sample_type;
+ vbox = DIALOG_CONTENT_AREA(fd->dialog);
+ fd->panel_data = make_file_data_panel(vbox, "data-form",
+ (fd->type == REGION_SAVE_AS) ? WITHOUT_CHANNELS_FIELD : WITH_EXTRACT_CHANNELS_FIELD,
+ fd->header_type, fd->sample_type,
+ WITHOUT_DATA_LOCATION_FIELD,
+ WITHOUT_SAMPLES_FIELD,
+ WITH_HEADER_TYPE_FIELD,
+ WITH_COMMENT_FIELD,
+ WITH_WRITABLE_HEADERS,
+ WITH_SRATE_FIELD,
+ fd->type == SOUND_SAVE_AS);
-static double srate_ratio(int srate, save_as_dialog_info *sd)
-{
- switch (sd->type)
+ gtk_widget_show(fd->dialog);
+
+ if (fd->type != REGION_SAVE_AS)
+ SG_SIGNAL_CONNECT(fd->extract_button, "clicked", save_as_extract_callback, (void *)fd);
+
+ SG_SIGNAL_CONNECT(fd->help_button, "clicked", save_as_help_callback, (gpointer)fd);
+ SG_SIGNAL_CONNECT(fd->ok_button, "clicked", save_as_ok_callback, (gpointer)fd);
+ SG_SIGNAL_CONNECT(fd->cancel_button, "clicked", save_as_cancel_callback, (gpointer)fd);
+
+ fd->panel_data->dialog = fd->dialog;
+ switch (fd->type)
{
case SOUND_SAVE_AS:
- return((double)(SND_SRATE(any_selected_sound())) / (double)srate);
+ set_dialog_widget(SOUND_SAVE_AS_DIALOG, fd->dialog);
+ break;
case SELECTION_SAVE_AS:
- return((double)selection_srate() / (double)srate);
+ set_dialog_widget(SELECTION_SAVE_AS_DIALOG, fd->dialog);
+ break;
case REGION_SAVE_AS:
- return((double)region_srate(region_dialog_region()) / (double)srate);
- }
-
- return(1.0);
-}
-
-
-static void save_or_extract(save_as_dialog_info *sd, bool saving)
-{
- char *str = NULL, *comment = NULL, *msg = NULL, *fullname = NULL, *tmpfile = NULL;
- snd_info *sp = NULL;
- int type = MUS_NEXT, format = DEFAULT_OUTPUT_DATA_FORMAT, srate = DEFAULT_OUTPUT_SRATE, chans = DEFAULT_OUTPUT_CHANS;
- int output_type, chan = 0, extractable_chans = 0;
- bool file_exists = false;
- mus_long_t location = 28, samples = 0;
- io_error_t io_err = IO_NO_ERROR;
-
- clear_dialog_error(sd->panel_data);
-
- if ((sd->type == SELECTION_SAVE_AS) &&
- (!(selection_is_active())))
- {
- if (saving)
- msg = (char *)"no selection to save";
- else msg = (char *)"can't extract: no selection";
- post_file_dialog_error((const char *)msg, sd->panel_data);
- return;
- }
-
- if ((sd->type == REGION_SAVE_AS) &&
- (!(region_ok(region_dialog_region()))))
- {
- post_file_dialog_error("no region to save", sd->panel_data);
- return;
- }
-
- sp = any_selected_sound();
- if ((!sp) &&
- (sd->type != REGION_SAVE_AS))
- {
- if (saving)
- msg = (char *)"nothing to save";
- else msg = (char *)"nothing to extract";
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->fs, sd);
- return;
- }
-
- /* get output filename */
- str = fsb_file_text(sd->fs);
- if ((!str) || (!*str))
- {
- if (saving)
- msg = (char *)"can't save: no file name given";
- else msg = (char *)"can't extract: no file name given";
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->fs, sd);
- return;
- }
-
- /* get output file attributes */
- redirect_snd_error_to(redirect_post_file_panel_error, (void *)(sd->panel_data));
- if (saving)
- comment = get_file_dialog_sound_attributes(sd->panel_data, &srate, &chans, &type, &format, &location, &samples, 0);
- else comment = get_file_dialog_sound_attributes(sd->panel_data, &srate, &chan, &type, &format, &location, &samples, 0);
- output_type = type;
- redirect_snd_error_to(NULL, NULL);
- if (sd->panel_data->error_widget != NOT_A_SCANF_WIDGET)
- {
- clear_error_if_panel_changes(sd->fs->dialog, sd->panel_data);
- if (comment) free(comment);
- return;
- }
-
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- clear_minibuffer(sp);
- if (!saving)
- extractable_chans = sp->nchans;
- break;
-
- case SELECTION_SAVE_AS:
- if (!saving)
- extractable_chans = selection_chans();
+ set_dialog_widget(REGION_SAVE_AS_DIALOG, fd->dialog);
break;
-
+
default:
+ snd_error("internal screw up");
break;
}
-
- if (!saving)
+ SG_SIGNAL_CONNECT(fd->dialog, "delete_event", save_as_delete_callback, (void *)fd);
+
+ if (fd->type != REGION_SAVE_AS)
{
- if ((chan > extractable_chans) ||
- (((extractable_chans > 1) && (chan == extractable_chans)) ||
- (chan < 0)))
- {
- if (chan > extractable_chans)
- msg = mus_format("can't extract chan %d (%s has %d chan%s)",
- chan,
- (sd->type == SOUND_SAVE_AS) ? "sound" : "selection",
- extractable_chans,
- (extractable_chans > 1) ? "s" : "");
- else msg = mus_format("can't extract chan %d (first chan is numbered 0)", chan);
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_chans_changes(sd->fs->dialog, (void *)(sd->panel_data));
- free(msg);
- if (comment) free(comment);
- return;
- }
+ if (fd->type == SOUND_SAVE_AS)
+ SG_SIGNAL_CONNECT(fd->panel_data->auto_comment_button, "toggled", file_data_auto_comment_callback, fd);
}
+ return(fd);
+}
- fullname = mus_expand_filename(str);
- if (run_before_save_as_hook(sp, fullname, sd->type != SOUND_SAVE_AS, srate, type, format, comment))
- {
- msg = mus_format("%s cancelled by %s", (saving) ? "save" : "extract", S_before_save_as_hook);
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->fs, sd);
- free(msg);
- free(fullname);
- if (comment) free(comment);
- return;
- }
- file_exists = mus_file_probe(fullname);
- if ((sd->type == SOUND_SAVE_AS) &&
- (mus_strcmp(fullname, sp->filename)))
- {
- /* save-as here is the same as save */
- if ((sp->user_read_only == FILE_READ_ONLY) ||
- (sp->file_read_only == FILE_READ_ONLY))
- {
- msg = mus_format("can't overwrite %s (it is write-protected)", sp->short_filename);
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->fs, sd);
- free(msg);
- free(fullname);
- if (comment) free(comment);
- return;
- }
- }
- else
- {
- if (!(sd->file_watcher))
- {
- /* check for overwrites that are questionable -- DoIt click will return here with sd->file_watcher active */
- snd_info *parlous_sp = NULL;
- if ((file_exists) &&
- ((ask_before_overwrite(ss)) ||
- ((sd->type == SOUND_SAVE_AS) &&
- (parlous_sp = file_is_open_elsewhere_and_has_unsaved_edits(sp, fullname)))))
- {
- msg = mus_format("%s exists%s. To overwrite it, click '%s'",
- str,
- (parlous_sp) ? ", and has unsaved edits" : "",
- "DoIt"
- );
- sd->file_watcher = fam_monitor_file(fullname, (void *)sd, watch_save_as_file);
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_save_as_filename_changes(sd->fs->dialog, (void *)sd);
- set_stock_button_label(sd->fs->ok_button, "DoIt");
- free(msg);
- free(fullname);
- if (comment) free(comment);
- return;
- }
- }
- }
-
- /* try to save... if it exists already, first write as temp, then move */
- if (sd->file_watcher)
- save_as_undoit(sd);
- ss->local_errno = 0;
-
- if (encoded_header_p(type))
- {
- output_type = type;
- format = MUS_LSHORT;
- type = MUS_RIFF;
- tmpfile = snd_tempnam();
- }
- else
- {
- tmpfile = fullname;
- }
-
- redirect_snd_error_to(redirect_post_file_dialog_error, (void *)(sd->panel_data));
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- if (saving)
- io_err = save_edits_without_display(sp, tmpfile, type, format, srate, comment, AT_CURRENT_EDIT_POSITION);
- else io_err = save_channel_edits(sp->chans[chan], tmpfile, AT_CURRENT_EDIT_POSITION); /* protects if same name */
- break;
-
- case SELECTION_SAVE_AS:
- {
- char *ofile;
- if (file_exists) /* file won't exist if we're encoding, so this isn't as wasteful as it looks */
- ofile = snd_tempnam();
- else ofile = mus_strdup(tmpfile);
- io_err = save_selection(ofile, type, format, srate, comment, (saving) ? SAVE_ALL_CHANS : chan);
- if (io_err == IO_NO_ERROR)
- io_err = move_file(ofile, fullname);
- free(ofile);
- break;
- }
-
- case REGION_SAVE_AS:
- {
- char *ofile;
- if (region_ok(region_dialog_region()))
- {
- if (file_exists)
- ofile = snd_tempnam();
- else ofile = mus_strdup(tmpfile);
- io_err = save_region(region_dialog_region(), ofile, type, format, comment);
- if (io_err == IO_NO_ERROR)
- io_err = move_file(ofile, fullname);
- free(ofile);
- }
- }
- break;
- }
- redirect_snd_error_to(NULL, NULL);
-
- /* check for possible srate conversion */
- if ((sd->panel_data->src) &&
- (srates_differ(srate, sd)))
- {
- /* if src, and srates differ, do the sampling rate conversion.
- * this needs to happen before the snd_encode (->OGG etc) below
- * if we do it before the save-as above, then undo it later, it messes up the user's edit history list
- * so do it here to tmpfile (tmpfile is fullname unless we're doing a translation to something like OGG)
- */
- src_file(tmpfile, srate_ratio(srate, sd));
- }
-
- if (io_err == IO_NO_ERROR)
- {
- if (encoded_header_p(output_type))
- {
- snd_encode(output_type, tmpfile, fullname);
- snd_remove(tmpfile, REMOVE_FROM_CACHE);
- free(tmpfile);
- }
-
- if (saving)
- {
- if (sd->type == SOUND_SAVE_AS)
- report_in_minibuffer(sp, "%s saved as %s", sp->short_filename, str);
- else report_in_minibuffer(sp, "%s saved as %s", (sd->type == SELECTION_SAVE_AS) ? "selection" : "region", str);
- }
- else
- {
- if (sd->type == SOUND_SAVE_AS)
- report_in_minibuffer(sp, "%s chan %d saved as %s", sp->short_filename, chan, str);
- else report_in_minibuffer(sp, "selection chan %d saved as %s", chan, str);
- }
- run_after_save_as_hook(sp, str, true); /* true => from dialog */
- gtk_widget_hide(sd->fs->dialog);
- }
- else
- {
- msg = mus_format("%s as %s: %s (%s)", (saving) ? "save" : "extract chan", str, io_error_name(io_err), snd_io_strerror());
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->fs, sd);
- free(msg);
- }
- free(fullname);
- if (comment) free(comment);
-}
-
-
-static void save_as_ok_callback(GtkWidget *w, gpointer data)
-{
- save_or_extract((save_as_dialog_info *)data, true);
-}
-
-
-static void save_as_extract_callback(GtkWidget *w, gpointer data)
-{
- save_or_extract((save_as_dialog_info *)data, false);
-}
-
-
-static void save_as_cancel_callback(GtkWidget *w, gpointer data)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)data;
- gtk_widget_hide(sd->fs->dialog);
-}
-
-
-static void save_as_help_callback(GtkWidget *w, gpointer data)
-{
- save_as_dialog_help();
-}
-
-
-static void save_as_dialog_select_callback(const char *filename, void *data)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)data;
- clear_filename_handlers(sd->fs);
- clear_dialog_error(sd->panel_data);
- set_sensitive(sd->fs->ok_button, (!(file_is_directory(sd->fs))));
- if (sd->fs->extract_button) set_sensitive(sd->fs->extract_button, (!(file_is_directory(sd->fs))));
-}
-
-
-static gint save_as_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- gtk_widget_hide(sd->fs->dialog);
- return(true);
-}
-
-
-static void save_as_mkdir_callback(GtkWidget *w, gpointer context)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- char *filename = NULL, *str;
- fsb *fs;
- fs = sd->fs;
- filename = fsb_file_text(fs);
- if (snd_mkdir(filename) < 0)
- {
- /* could not make the directory */
- str = mus_format("can't make %s: %s", filename, strerror(errno));
- post_file_dialog_error((const char *)str, sd->panel_data);
- clear_error_if_filename_changes(fs, sd);
- free(str);
- }
- else
- {
- if (fs->directory_name) free(fs->directory_name);
- fs->directory_name = mus_strdup(filename);
- fsb_filter_set_text_with_directory(fs, "*");
- fsb_update_lists(fs);
- set_sensitive(w, false);
- str = (char *)"save as:";
- gtk_label_set_text(GTK_LABEL(sd->fs->file_label), str);
- }
-}
-
-
-static void save_as_file_exists_check(GtkWidget *w, gpointer context)
-{
- /* a "changed" callback for the text field */
- char *msg, *filename = NULL;
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- filename = fsb_file_text(sd->fs);
- if ((filename) && (*filename))
- {
- if ((mus_file_probe(filename)) &&
- (!directory_p(filename)))
- {
-#if HAVE_ACCESS
- if (access(filename, W_OK) < 0)
- msg = (char *)"save as (file write-protected?):";
- else
-#endif
- msg = (char *)"save as (overwriting):";
- }
- else
- {
- if (!(directory_exists(filename)))
- msg = (char *)"save as (no such directory?):";
- else msg = (char *)"save as:";
- }
- }
- else msg = (char *)"save as:";
- gtk_label_set_text(GTK_LABEL(sd->fs->file_label), msg);
-}
-
-
-static void save_innards(GtkWidget *vbox, void *data)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)data;
- sd->panel_data = make_file_data_panel(vbox, "data-form",
- (sd->type == REGION_SAVE_AS) ? WITHOUT_CHANNELS_FIELD : WITH_EXTRACT_CHANNELS_FIELD,
- sd->header_type, sd->format_type,
- WITHOUT_DATA_LOCATION_FIELD,
- WITHOUT_SAMPLES_FIELD,
- WITH_HEADER_TYPE_FIELD,
- WITH_COMMENT_FIELD,
- WITH_WRITABLE_HEADERS,
- true,
- sd->type == SOUND_SAVE_AS);
- widget_modify_base(sd->panel_data->error_text, GTK_STATE_NORMAL, ss->yellow);
- widget_modify_base(sd->panel_data->error_text, GTK_STATE_ACTIVE, ss->yellow);
-}
-
-
-static gboolean reflect_text_in_save_button(GtkWidget *w, GdkEventKey *event, gpointer data)
-{
- fsb *fs = (fsb *)data;
- set_sensitive(fs->ok_button, (!(file_is_directory(fs))));
- if (fs->mkdir_button) set_sensitive(fs->mkdir_button, file_is_nonexistent_directory(fs));
- return(false);
-}
-
-
-static gboolean reflect_text_in_extract_button(GtkWidget *w, GdkEventKey *event, gpointer data)
-{
- fsb *fs = (fsb *)data;
- set_sensitive(fs->extract_button, (!(file_is_directory(fs))));
- return(false);
-}
-
-
-static void make_save_as_dialog(save_as_dialog_info *sd, const char *sound_name, int header_type, int format_type)
-{
- char *file_string;
-
- file_string = mus_format("save %s", sound_name);
- if (!(sd->fs))
- {
- fsb *fs;
- sd->header_type = header_type;
- sd->format_type = format_type;
- sd->fs = make_fsb(file_string, "save as:", "Save as", save_innards, (void *)sd, GTK_STOCK_SAVE_AS, (sd->type != REGION_SAVE_AS));
- fs = sd->fs;
-
- if (sd->type != REGION_SAVE_AS)
- SG_SIGNAL_CONNECT(fs->extract_button, "clicked", save_as_extract_callback, (void *)sd);
- SG_SIGNAL_CONNECT(fs->mkdir_button, "clicked", save_as_mkdir_callback, (void *)sd);
-
- SG_SIGNAL_CONNECT(fs->help_button, "clicked", save_as_help_callback, (gpointer)sd);
- SG_SIGNAL_CONNECT(fs->file_text, "key_press_event", filer_key_press, NULL);
- SG_SIGNAL_CONNECT(fs->ok_button, "clicked", save_as_ok_callback, (gpointer)sd);
- SG_SIGNAL_CONNECT(fs->cancel_button, "clicked", save_as_cancel_callback, (gpointer)sd);
- SG_SIGNAL_CONNECT(fs->file_text, "changed", save_as_file_exists_check, (gpointer)sd);
-
- fs->file_select_data = (void *)sd;
- fs->file_select_callback = save_as_dialog_select_callback;
- fs->directory_select_data = (void *)sd;
- fs->directory_select_callback = save_as_dialog_select_callback;
-
- sd->panel_data->dialog = fs->dialog;
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- set_dialog_widget(SOUND_SAVE_AS_DIALOG, fs->dialog);
- break;
-
- case SELECTION_SAVE_AS:
- set_dialog_widget(SELECTION_SAVE_AS_DIALOG, fs->dialog);
- XEN_ADD_HOOK(ss->snd_selection_hook, save_selection_hook_handler_w, "save-selection-hook-handler", "save selection dialog's selection hook handler");
- break;
-
- case REGION_SAVE_AS:
- set_dialog_widget(REGION_SAVE_AS_DIALOG, fs->dialog);
- break;
-
- default:
- snd_error("internal screw up");
- break;
- }
- SG_SIGNAL_CONNECT(fs->dialog, "delete_event", save_as_delete_callback, (void *)sd);
-
- set_sensitive(fs->ok_button, (!(file_is_directory(fs))));
- SG_SIGNAL_CONNECT(fs->file_text, "key_release_event", reflect_text_in_save_button, (gpointer)fs);
-
- if (sd->type != REGION_SAVE_AS)
- {
- set_sensitive(fs->extract_button, (!(file_is_directory(fs))));
- SG_SIGNAL_CONNECT(fs->file_text, "key_release_event", reflect_text_in_extract_button, (gpointer)fs);
- if (sd->type == SOUND_SAVE_AS)
- SG_SIGNAL_CONNECT(sd->panel_data->auto_comment_button, "toggled", file_data_auto_comment_callback, sd);
- }
- }
- else
- {
- gtk_window_set_title(GTK_WINDOW(sd->fs->dialog), file_string);
- }
-
- /* gtk_label_set_text(GTK_LABEL(sd->fs->file_label), file_string); */
- free(file_string);
-}
-
-
-widget_t make_sound_save_as_dialog(bool managed)
+static file_dialog_info *make_sound_save_as_dialog_1(bool managed, int chan)
{
snd_info *sp = NULL;
char *com = NULL;
file_info *hdr = NULL;
- save_as_dialog_info *sd;
-
- if (!save_sound_as)
- save_sound_as = new_save_as_dialog_info(SOUND_SAVE_AS);
- sd = save_sound_as;
-
- sp = any_selected_sound();
- if (sp) hdr = sp->hdr;
- make_save_as_dialog(sd,
- (char *)((sp) ? sp->short_filename : ""),
- default_output_header_type(ss),
- default_output_data_format(ss));
- set_file_dialog_sound_attributes(sd->panel_data,
- sd->panel_data->current_type,
- sd->panel_data->current_format,
- (hdr) ? hdr->srate : selection_srate(),
- IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
- com = output_comment(hdr));
- if (com) free(com);
- if (sd->fs->reread_directory)
- {
- force_directory_reread(sd->fs);
- sd->fs->reread_directory = false;
- }
- if (managed) gtk_widget_show(sd->fs->dialog);
- make_auto_comment(sd);
- return(sd->fs->dialog);
-}
-
-
-widget_t make_selection_save_as_dialog(bool managed)
-{
- save_as_dialog_info *sd;
-
- if (!save_selection_as)
- save_selection_as = new_save_as_dialog_info(SELECTION_SAVE_AS);
- sd = save_selection_as;
-
- make_save_as_dialog(sd,
- "current selection",
- default_output_header_type(ss),
- default_output_data_format(ss));
- set_file_dialog_sound_attributes(sd->panel_data,
- sd->panel_data->current_type,
- sd->panel_data->current_format,
- selection_srate(),
- IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
- NULL);
- if (sd->fs->reread_directory)
- {
- force_directory_reread(sd->fs);
- sd->fs->reread_directory = false;
- }
- if (managed) gtk_widget_show(sd->fs->dialog);
- return(sd->fs->dialog);
-}
-
-
-widget_t make_region_save_as_dialog(bool managed)
-{
- save_as_dialog_info *sd;
- char *comment = NULL;
-
- if (!save_region_as)
- save_region_as = new_save_as_dialog_info(REGION_SAVE_AS);
- sd = save_region_as;
-
- make_save_as_dialog(sd,
- "current region",
- default_output_header_type(ss),
- default_output_data_format(ss));
- comment = region_description(region_dialog_region());
- set_file_dialog_sound_attributes(sd->panel_data,
- sd->panel_data->current_type,
- sd->panel_data->current_format,
- region_srate(region_dialog_region()),
- IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
- comment);
- if (comment) free(comment);
- if (sd->fs->reread_directory)
- {
- force_directory_reread(sd->fs);
- sd->fs->reread_directory = false;
- }
- if (managed) gtk_widget_show(sd->fs->dialog);
- return(sd->fs->dialog);
-}
-
-
-void save_file_dialog_state(FILE *fd)
-{
- if ((odat) && (widget_is_active(odat->fs->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_open_file_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_open_file_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_open_file_dialog);
-#endif
- }
- if ((mdat) && (widget_is_active(mdat->fs->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_mix_file_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_mix_file_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_mix_file_dialog);
-#endif
- }
- if ((idat) && (widget_is_active(idat->fs->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_insert_file_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_insert_file_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_insert_file_dialog);
-#endif
- }
- if ((save_sound_as) && (widget_is_active(save_sound_as->fs->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_save_sound_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_save_sound_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_save_sound_dialog);
-#endif
- }
- if ((save_selection_as) && (widget_is_active(save_selection_as->fs->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_save_selection_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_save_selection_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_save_selection_dialog);
-#endif
- }
- if ((save_region_as) && (widget_is_active(save_region_as->fs->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_save_region_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_save_region_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_save_region_dialog);
-#endif
- }
-}
-
-
-/* -------------------------------- Raw Data Dialog -------------------------------- */
-
-typedef struct raw_info {
- GtkWidget *dialog;
- mus_long_t location;
- file_data *rdat;
- read_only_t read_only;
- bool selected;
- char *filename;
- char *help;
- open_requestor_t requestor;
- void *requestor_data;
- GtkWidget *requestor_dialog;
-} raw_info;
-
-static int raw_info_size = 0;
-static raw_info **raw_infos = NULL;
-
-static raw_info *new_raw_dialog(void)
-{
- int loc = -1;
- if (raw_info_size == 0)
- {
- loc = 0;
- raw_info_size = 4;
- raw_infos = (raw_info **)calloc(raw_info_size, sizeof(raw_info *));
- }
- else
- {
- int i;
- for (i = 0; i < raw_info_size; i++)
- if ((!raw_infos[i]) ||
- (!(widget_is_active(raw_infos[i]->dialog))))
- {
- loc = i;
- break;
- }
- if (loc == -1)
- {
- loc = raw_info_size;
- raw_info_size += 4;
- raw_infos = (raw_info **)realloc(raw_infos, raw_info_size * sizeof(raw_info *));
- for (i = loc; i < raw_info_size; i++) raw_infos[i] = NULL;
- }
- }
- if (!raw_infos[loc])
- {
- raw_infos[loc] = (raw_info *)calloc(1, sizeof(raw_info));
- raw_infos[loc]->dialog = NULL;
- raw_infos[loc]->filename = NULL;
- raw_infos[loc]->help = NULL;
- }
- raw_infos[loc]->requestor = NO_REQUESTOR;
- raw_infos[loc]->requestor_data = NULL;
- raw_infos[loc]->location = 0;
- return(raw_infos[loc]);
-}
-
-
-static void raw_data_ok_callback(GtkWidget *w, gpointer context)
-{
- raw_info *rp = (raw_info *)context;
- int raw_srate, raw_chans, raw_data_format;
- redirect_snd_error_to(redirect_post_file_panel_error, (void *)(rp->rdat));
- get_file_dialog_sound_attributes(rp->rdat, &raw_srate, &raw_chans, NULL, &raw_data_format, &(rp->location), NULL, 1);
- redirect_snd_error_to(NULL, NULL);
- if (rp->rdat->error_widget != NOT_A_SCANF_WIDGET)
- {
- clear_error_if_panel_changes(rp->dialog, rp->rdat);
- }
- else
- {
- mus_header_set_raw_defaults(raw_srate, raw_chans, raw_data_format);
- mus_sound_override_header(rp->filename, raw_srate, raw_chans,
- raw_data_format, MUS_RAW, rp->location,
- mus_bytes_to_samples(raw_data_format,
- mus_sound_length(rp->filename) - rp->location));
- /* choose action based on how we got here */
- if ((rp->requestor_dialog) &&
- ((rp->requestor == FROM_MIX_DIALOG) ||
- (rp->requestor == FROM_INSERT_DIALOG) ||
- (rp->requestor == FROM_VIEW_FILES_MIX_DIALOG) ||
- (rp->requestor == FROM_VIEW_FILES_INSERT_DIALOG)))
- {
- ss->reloading_updated_file = true; /* don't reread lack-of-header! */
- /* redirection may be still set here, but I'll make it obvious */
- switch (rp->requestor)
- {
- case FROM_MIX_DIALOG:
- redirect_snd_error_to(redirect_file_open_error, (void *)mdat);
- mix_complete_file_at_cursor(any_selected_sound(), rp->filename);
- break;
-
- case FROM_INSERT_DIALOG:
- redirect_snd_error_to(redirect_file_open_error, (void *)idat);
- insert_complete_file_at_cursor(any_selected_sound(), rp->filename);
- break;
-
- case FROM_VIEW_FILES_MIX_DIALOG:
- {
- int err;
- view_files_info *vdat = (view_files_info *)(rp->requestor_data);
- redirect_snd_error_to(redirect_vf_post_error, rp->requestor_data);
- err = vf_mix(vdat);
- }
- break;
-
- case FROM_VIEW_FILES_INSERT_DIALOG:
- {
- int err;
- view_files_info *vdat = (view_files_info *)(rp->requestor_data);
- redirect_snd_error_to(redirect_vf_post_error, rp->requestor_data);
- err = vf_insert(vdat);
- }
- break;
-
- default:
- snd_error("wrong requestor type in raw data dialog? %d\n", (int)(rp->requestor));
- break;
- }
- redirect_snd_error_to(NULL, NULL);
- ss->reloading_updated_file = false;
- }
- else
- {
- file_info *hdr;
- hdr = (file_info *)calloc(1, sizeof(file_info));
- hdr->name = mus_strdup(rp->filename);
- hdr->type = MUS_RAW;
- hdr->srate = raw_srate;
- hdr->chans = raw_chans;
- hdr->format = raw_data_format;
- hdr->samples = mus_bytes_to_samples(raw_data_format,
- mus_sound_length(rp->filename) - rp->location);
- hdr->data_location = rp->location;
- hdr->comment = NULL;
- if (rp->requestor == FROM_KEYBOARD)
- {
- clear_minibuffer((snd_info *)(rp->requestor_data));
- rp->selected = true;
- }
- finish_opening_sound(add_sound_window(rp->filename, rp->read_only, hdr), rp->selected);
- }
- gtk_widget_hide(rp->dialog);
- }
-}
-
-
-static void raw_data_cancel_callback(GtkWidget *w, gpointer context)
-{
- raw_info *rp = (raw_info *)context;
- gtk_widget_hide(rp->dialog);
- if ((rp->requestor_dialog) &&
- ((rp->requestor == FROM_OPEN_DIALOG) ||
- (rp->requestor == FROM_MIX_DIALOG)))
- gtk_widget_show(rp->requestor_dialog);
-}
-
-
-static gint raw_data_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
-{
- raw_info *rp = (raw_info *)context;
- if ((rp->requestor_dialog) &&
- ((rp->requestor == FROM_OPEN_DIALOG) ||
- (rp->requestor == FROM_MIX_DIALOG)))
- gtk_widget_show(rp->requestor_dialog);
- return(true);
-}
-
-
-static void raw_data_reset_callback(GtkWidget *w, gpointer context)
-{
- raw_info *rp = (raw_info *)context;
- int raw_srate, raw_chans, raw_data_format;
- rp->location = 0;
- mus_header_raw_defaults(&raw_srate, &raw_chans, &raw_data_format); /* pick up defaults */
- set_file_dialog_sound_attributes(rp->rdat,
- IGNORE_HEADER_TYPE,
- raw_data_format, raw_srate, raw_chans, rp->location,
- IGNORE_SAMPLES, NULL);
- gtk_widget_hide(rp->rdat->error_text);
-}
-
-
-static void raw_data_help_callback(GtkWidget *w, gpointer context)
-{
- raw_info *rp = (raw_info *)context;
- raw_data_dialog_help(rp->help);
-}
-
-
-static void make_raw_data_dialog(raw_info *rp, const char *filename, const char *title)
-{
- GtkWidget *resetB, *helpB, *cancelB, *okB;
- int raw_srate, raw_chans, raw_data_format;
-
- rp->dialog = snd_gtk_dialog_new();
- if (!title)
- gtk_window_set_title(GTK_WINDOW(rp->dialog), "No header on file");
- else gtk_window_set_title(GTK_WINDOW(rp->dialog), title);
- sg_make_resizable(rp->dialog);
- gtk_container_set_border_width(GTK_CONTAINER(rp->dialog), 10);
- gtk_window_resize(GTK_WINDOW(rp->dialog), 350, 260);
- gtk_widget_realize(rp->dialog);
-
- helpB = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(helpB, "dialog_button");
-
- cancelB = gtk_button_new_from_stock(GTK_STOCK_CANCEL);
- gtk_widget_set_name(cancelB, "dialog_button");
- set_stock_button_label(cancelB, "Go Away");
-
- resetB = sg_button_new_from_stock_with_label("Reset", GTK_STOCK_REFRESH);
- gtk_widget_set_name(resetB, "dialog_button");
-
- okB = gtk_button_new_from_stock(GTK_STOCK_OK);
- gtk_widget_set_name(okB, "dialog_button");
-
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(rp->dialog)), okB, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(rp->dialog)), cancelB, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(rp->dialog)), resetB, true, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(rp->dialog)), helpB, true, true, 10);
-
- mus_header_raw_defaults(&raw_srate, &raw_chans, &raw_data_format); /* pick up defaults */
-
- rp->rdat = make_file_data_panel(DIALOG_CONTENT_AREA(rp->dialog), "data-form",
- WITH_CHANNELS_FIELD,
- MUS_RAW, raw_data_format,
- WITH_DATA_LOCATION_FIELD,
- WITHOUT_SAMPLES_FIELD,
- WITHOUT_HEADER_TYPE_FIELD,
- WITHOUT_COMMENT_FIELD,
- WITH_READABLE_HEADERS,
- false, false);
- rp->rdat->dialog = rp->dialog;
- set_file_dialog_sound_attributes(rp->rdat,
- IGNORE_HEADER_TYPE,
- raw_data_format, raw_srate, raw_chans, rp->location,
- IGNORE_SAMPLES, NULL);
-
- SG_SIGNAL_CONNECT(rp->dialog, "delete_event", raw_data_delete_callback, rp);
- SG_SIGNAL_CONNECT(okB, "clicked", raw_data_ok_callback, rp);
-
- SG_SIGNAL_CONNECT(helpB, "clicked", raw_data_help_callback, rp);
- SG_SIGNAL_CONNECT(resetB, "clicked", raw_data_reset_callback, rp);
- SG_SIGNAL_CONNECT(cancelB, "clicked", raw_data_cancel_callback, rp);
-
- gtk_widget_show(okB);
- gtk_widget_show(cancelB);
- gtk_widget_show(helpB);
- gtk_widget_show(resetB);
-
- set_dialog_widget(RAW_DATA_DIALOG, rp->dialog);
-}
-
-
-void raw_data_dialog_to_file_info(const char *filename, char *title, char *info, read_only_t read_only, bool selected)
-{
- raw_info *rp;
- rp = new_raw_dialog();
- rp->read_only = read_only;
- rp->selected = selected;
- if (rp->filename) free(rp->filename);
- rp->filename = mus_strdup(filename);
- rp->requestor = ss->open_requestor;
- rp->requestor_dialog = ss->requestor_dialog;
- ss->open_requestor = NO_REQUESTOR;
- ss->requestor_dialog = NULL;
- if ((rp->requestor_dialog) &&
- ((rp->requestor == FROM_OPEN_DIALOG) ||
- (rp->requestor == FROM_MIX_DIALOG)))
- gtk_widget_hide(ss->requestor_dialog);
- if (!title)
- title = mus_format("no header found on %s\n", filename);
- if (!rp->dialog)
- make_raw_data_dialog(rp, filename, title);
- else gtk_window_set_title(GTK_WINDOW(rp->dialog), title);
- free(title);
- if (rp->help) free(rp->help);
- if (info)
- {
- rp->help = mus_strdup(info);
- free(info);
- }
- else rp->help = NULL;
- raise_dialog(rp->dialog);
- gtk_widget_show(rp->dialog);
-}
-
-
-/* -------------------------------- New File -------------------------------- */
-
-static GtkWidget *new_file_dialog = NULL, *new_file_text = NULL, *new_file_ok_button = NULL;
-static file_data *ndat = NULL;
-static mus_long_t initial_samples = 1;
-static char *new_file_filename = NULL;
-static fam_info *new_file_watcher = NULL;
-
-void cleanup_new_file_watcher(void)
-{
- new_file_watcher = fam_unmonitor_file(new_file_filename, new_file_watcher);
-}
-
-
-static gulong new_file_handler_id = 0;
-static gboolean new_filename_modify_callback(GtkWidget *w, GdkEventKey *event, gpointer ignored);
-
-static void new_file_undoit(void)
-{
- clear_dialog_error(ndat);
- if (new_file_handler_id)
- {
- if (new_file_handler_id)
- {
- g_signal_handler_disconnect(new_file_text, new_file_handler_id);
- new_file_handler_id = 0;
- }
- }
- set_stock_button_label(new_file_ok_button, "Ok");
- new_file_watcher = fam_unmonitor_file(new_file_filename, new_file_watcher);
-}
-
-
-static gboolean new_filename_modify_callback(GtkWidget *w, GdkEventKey *event, gpointer ignored)
-{
- new_file_undoit();
- return(false);
-}
-
-
-static void clear_error_if_new_filename_changes(GtkWidget *dialog)
-{
- if (new_file_text)
- new_file_handler_id = SG_SIGNAL_CONNECT(new_file_text, "key_press_event", new_filename_modify_callback, NULL);
-}
-
-
-static void watch_new_file(struct fam_info *fp, FAMEvent *fe)
-{
- /* if file is deleted, respond in some debonair manner */
-#if HAVE_FAM
- switch (fe->code)
- {
- case FAMChanged:
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- new_file_undoit();
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-#endif
-}
-
-
-static void new_file_ok_callback(GtkWidget *w, gpointer context)
-{
- mus_long_t loc;
- char *comment = NULL, *newer_name = NULL, *msg;
- int header_type, data_format, srate, chans;
- newer_name = (char *)gtk_entry_get_text(GTK_ENTRY(new_file_text));
- if ((!newer_name) || (!(*newer_name)))
- {
- msg = (char *)"new sound needs a file name ('New file:' field is empty)";
- post_file_dialog_error((const char *)msg, ndat);
- clear_error_if_new_filename_changes(new_file_dialog);
- }
- else
- {
- redirect_snd_error_to(redirect_post_file_panel_error, (void *)ndat);
- comment = get_file_dialog_sound_attributes(ndat, &srate, &chans, &header_type, &data_format, &loc, &initial_samples, 1);
- redirect_snd_error_to(NULL, NULL);
- if (ndat->error_widget != NOT_A_SCANF_WIDGET)
- {
- clear_error_if_panel_changes(new_file_dialog, ndat);
- }
- else
- {
- snd_info *sp;
- /* handle the overwrite hook directly */
- if (new_file_filename) free(new_file_filename);
- new_file_filename = mus_expand_filename(newer_name); /* need full filename for fam */
- if ((!new_file_watcher) &&
- (ask_before_overwrite(ss)) &&
- (mus_file_probe(new_file_filename)))
- {
- msg = mus_format("%s exists. If you want to overwrite it, click 'DoIt'", newer_name);
- new_file_watcher = fam_monitor_file(new_file_filename, NULL, watch_new_file);
- set_stock_button_label(new_file_ok_button, "DoIt");
- post_file_dialog_error((const char *)msg, ndat);
- clear_error_if_new_filename_changes(new_file_dialog);
- free(msg);
- }
- else
- {
- if (new_file_watcher)
- new_file_undoit();
- ss->local_errno = 0;
- redirect_snd_error_to(redirect_post_file_dialog_error, (void *)ndat);
- sp = snd_new_file(newer_name, header_type, data_format, srate, chans, comment, initial_samples);
- redirect_snd_error_to(NULL, NULL);
- if (!sp)
- {
- if ((ss->local_errno) &&
- (mus_file_probe(new_file_filename))) /* see comment in snd-xfile.c */
- new_file_watcher = fam_monitor_file(new_file_filename, NULL, watch_new_file);
- clear_error_if_new_filename_changes(new_file_dialog);
- }
- else
- {
- gtk_widget_hide(new_file_dialog);
- }
- }
- }
- if (comment) free(comment);
- }
-}
-
-
-static char *new_file_dialog_filename(int header_type)
-{
- static int new_file_dialog_file_ctr = 1;
- char *filename = NULL;
- const char *extensions[6] = {"aiff", "aiff", "wav", "wav", "caf", "snd"};
- int extension = 0;
-
- filename = (char *)calloc(64, sizeof(char));
- switch (header_type)
- {
- case MUS_AIFC: extension = 0; break;
- case MUS_AIFF: extension = 1; break;
- case MUS_RF64: extension = 2; break;
- case MUS_RIFF: extension = 3; break;
- case MUS_CAFF: extension = 4; break;
- default: extension = 5; break;
- }
- mus_snprintf(filename, 64, "new-%d.%s", new_file_dialog_file_ctr++, extensions[extension]);
-
- return(filename);
-}
-
-
-static void load_new_file_defaults(char *newname)
-{
- char *filename = NULL, *new_comment = NULL;
- int header_type, data_format, chans, srate;
-
- header_type = default_output_header_type(ss);
- chans = default_output_chans(ss);
- data_format = default_output_data_format(ss);
- srate = default_output_srate(ss);
- new_comment = output_comment(NULL);
-
- if ((newname) && (!(*newname))) newname = NULL;
- filename = output_name(newname); /* calls output-name-hook, always free */
- if (filename == NULL)
- filename = new_file_dialog_filename(header_type);
- gtk_entry_set_text(GTK_ENTRY(new_file_text), filename);
- mus_sound_forget(filename);
-
- set_file_dialog_sound_attributes(ndat, header_type, data_format, srate, chans, IGNORE_DATA_LOCATION, initial_samples, new_comment);
-
- if (new_comment) free(new_comment);
- if (filename) free(filename);
-}
-
-
-static void new_file_cancel_callback(GtkWidget *w, gpointer context)
-{
- gtk_widget_hide(new_file_dialog);
-}
-
-
-static void new_file_reset_callback(GtkWidget *w, gpointer context)
-{
- char *current_name;
- current_name = (char *)gtk_entry_get_text(GTK_ENTRY(new_file_text));
- load_new_file_defaults(current_name);
- if (new_file_watcher)
- new_file_undoit();
-}
-
-
-static gint new_file_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
-{
- gtk_widget_hide(new_file_dialog);
- return(true);
-}
-
-
-static void new_file_help_callback(GtkWidget *w, gpointer context)
-{
- new_file_dialog_help();
-}
-
-
-widget_t make_new_file_dialog(bool managed)
-{
- char *newname;
- if (!new_file_dialog)
- {
- GtkWidget *name_label, *hform, *help_button, *cancel_button, *reset_button;
- new_file_dialog = snd_gtk_dialog_new();
- gtk_window_set_title(GTK_WINDOW(new_file_dialog), "New file");
- sg_make_resizable(new_file_dialog);
- gtk_container_set_border_width (GTK_CONTAINER(new_file_dialog), 10);
- gtk_window_resize(GTK_WINDOW(new_file_dialog), 400, 250);
- gtk_widget_realize(new_file_dialog);
-
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
-
- cancel_button = gtk_button_new_from_stock(GTK_STOCK_CANCEL);
- gtk_widget_set_name(cancel_button, "dialog_button");
- set_stock_button_label(cancel_button, "Go Away");
-
- new_file_ok_button = sg_button_new_from_stock_with_label("Ok", GTK_STOCK_NEW);
- gtk_widget_set_name(new_file_ok_button, "dialog_button");
-
- reset_button = sg_button_new_from_stock_with_label("Reset", GTK_STOCK_REFRESH);
- gtk_widget_set_name(reset_button, "dialog_button");
-
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(new_file_dialog)), new_file_ok_button, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(new_file_dialog)), cancel_button, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(new_file_dialog)), reset_button, true, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(new_file_dialog)), help_button, true, true, 10);
-
- hform = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(new_file_dialog)), hform, false, false, 4);
- gtk_widget_show(hform);
-
- name_label = gtk_label_new("New file:");
- gtk_box_pack_start(GTK_BOX(hform), name_label, false, false, 2);
- gtk_widget_show(name_label);
-
- new_file_text = snd_entry_new(hform, WITH_WHITE_BACKGROUND);
-
- newname = output_name(NULL); /* fix later */
- if ((newname) && (*newname))
- gtk_entry_set_text(GTK_ENTRY(new_file_text), newname); /* output_name?? fix later */
-
- ndat = make_file_data_panel(DIALOG_CONTENT_AREA(new_file_dialog), "data-form",
- WITH_CHANNELS_FIELD,
- default_output_header_type(ss),
- default_output_data_format(ss),
- WITHOUT_DATA_LOCATION_FIELD,
- WITH_SAMPLES_FIELD,
- WITH_HEADER_TYPE_FIELD,
- WITH_COMMENT_FIELD,
- WITH_BUILTIN_HEADERS,
- false, false);
- ndat->dialog = new_file_dialog;
-
- SG_SIGNAL_CONNECT(new_file_dialog, "delete_event", new_file_delete_callback, ndat);
- SG_SIGNAL_CONNECT(cancel_button, "clicked", new_file_cancel_callback, ndat);
- SG_SIGNAL_CONNECT(help_button, "clicked", new_file_help_callback, ndat);
- SG_SIGNAL_CONNECT(new_file_ok_button, "clicked", new_file_ok_callback, ndat);
- SG_SIGNAL_CONNECT(reset_button, "clicked", new_file_reset_callback, ndat);
- SG_SIGNAL_CONNECT(new_file_text, "activate", new_file_ok_callback, ndat);
-
- gtk_widget_show(cancel_button);
- gtk_widget_show(new_file_ok_button);
- gtk_widget_show(reset_button);
- gtk_widget_show(help_button);
-
- set_dialog_widget(NEW_FILE_DIALOG, new_file_dialog);
- load_new_file_defaults(NULL);
- }
- else
- {
- char *new_name;
- new_name = (char *)gtk_entry_get_text(GTK_ENTRY(new_file_text));
-#if (!HAVE_FAM)
- if (new_file_watcher)
- {
- /* if overwrite question pends, but file has been deleted in the meantime, go back to normal state */
- if ((!new_name) || (!(*new_name)) ||
- (!(mus_file_probe(new_name))))
- new_file_undoit();
- }
-#endif
- if (strncmp(new_name, "new-", 4) == 0)
- {
- /* if file is open with currently posted new-file dialog name, and it's our name (new-%d), then tick the counter */
- snd_info *sp;
- sp = find_sound(new_name, 0);
- if (sp)
- {
- char *filename;
- filename = new_file_dialog_filename(default_output_header_type(ss));
- gtk_entry_set_text(GTK_ENTRY(new_file_text), filename);
- mus_sound_forget(filename);
- free(filename);
- }
- }
- }
- if (managed)
- gtk_widget_show(new_file_dialog);
- return(new_file_dialog);
-}
-
-
-
-/* ---------------- Edit Header ---------------- */
-
-typedef struct edhead_info {
- GtkWidget *dialog, *save_button;
- file_data *edat;
- snd_info *sp;
- bool panel_changed;
- fam_info *file_ro_watcher;
- int sp_ro_watcher_loc;
-} edhead_info;
-
-static int edhead_info_size = 0;
-static edhead_info **edhead_infos = NULL;
-
-static edhead_info *new_edhead_dialog(void)
-{
- int loc = -1;
- if (edhead_info_size == 0)
- {
- loc = 0;
- edhead_info_size = 4;
- edhead_infos = (edhead_info **)calloc(edhead_info_size, sizeof(edhead_info *));
- }
- else
- {
- int i;
- for (i = 0; i < edhead_info_size; i++)
- if ((!edhead_infos[i]) ||
- (!(widget_is_active(edhead_infos[i]->dialog))))
- {
- loc = i;
- break;
- }
- if (loc == -1)
- {
- loc = edhead_info_size;
- edhead_info_size += 4;
- edhead_infos = (edhead_info **)realloc(edhead_infos, edhead_info_size * sizeof(edhead_info *));
- for (i = loc; i < edhead_info_size; i++) edhead_infos[i] = NULL;
- }
- }
- if (!edhead_infos[loc])
- {
- edhead_infos[loc] = (edhead_info *)calloc(1, sizeof(edhead_info));
- edhead_infos[loc]->dialog = NULL;
- edhead_infos[loc]->panel_changed = false;
- }
- edhead_infos[loc]->sp = NULL;
- edhead_infos[loc]->file_ro_watcher = NULL;
- return(edhead_infos[loc]);
-}
-
-
-void cleanup_edit_header_watcher(void)
-{
- int i;
- for (i = 0; i < edhead_info_size; i++)
- if (edhead_infos[i])
- {
- edhead_info *ep;
- ep = edhead_infos[i];
- if (ep->file_ro_watcher)
- ep->file_ro_watcher = fam_unmonitor_file(ep->sp->filename, ep->file_ro_watcher);
- }
-}
-
-
-static char *make_header_dialog_title(edhead_info *ep, snd_info *sp)
-{
- /* dialog may not yet exist */
- char *str;
- str = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- if ((sp->user_read_only == FILE_READ_ONLY) ||
- (sp->file_read_only == FILE_READ_ONLY))
- {
- if (sp->hdr->type == MUS_RAW)
- mus_snprintf(str, PRINT_BUFFER_SIZE, "Add header to (write-protected) %s", sp->short_filename);
- else mus_snprintf(str, PRINT_BUFFER_SIZE, "Edit header of (write-protected) %s", sp->short_filename);
- if (ep->dialog)
- set_sensitive(ep->save_button, (sp->hdr->type == MUS_RAW));
- }
- else
- {
- if (sp->hdr->type == MUS_RAW)
- mus_snprintf(str, PRINT_BUFFER_SIZE, "Add header to %s", sp->short_filename);
- else mus_snprintf(str, PRINT_BUFFER_SIZE, "Edit header of %s", sp->short_filename);
- if (ep->dialog)
- set_sensitive(ep->save_button, ep->panel_changed);
- }
- return(str);
-}
-
-
-static void edit_header_help_callback(GtkWidget *w, gpointer context)
-{
- edit_header_dialog_help();
-}
-
-
-static void edit_header_set_ok_sensitive(GtkWidget *w, gpointer context)
-{
- edhead_info *ep = (edhead_info *)context;
- if (ep->sp->file_read_only == FILE_READ_WRITE)
- gtk_widget_set_sensitive(ep->save_button, true);
- ep->panel_changed = true;
-}
-
-
-static void edit_header_done(edhead_info *ep)
-{
- gtk_widget_hide(ep->dialog);
- unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
- ep->panel_changed = false;
- ep->file_ro_watcher = fam_unmonitor_file(ep->sp->filename, ep->file_ro_watcher);
-}
-
-
-static void edit_header_cancel_callback(GtkWidget *w, gpointer context)
-{
- edit_header_done((edhead_info *)context);
-}
-
-
-static gint edit_header_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
-{
- edit_header_done((edhead_info *)context);
- return(true);
-}
-
-
-static void watch_file_read_only(struct fam_info *fp, FAMEvent *fe)
-{
-#if HAVE_FAM
- /* if file is deleted or permissions change, respond in some debonair manner */
- edhead_info *ep = (edhead_info *)(fp->data);
- snd_info *sp = NULL;
- sp = ep->sp;
- if (sp->writing) return;
- switch (fe->code)
- {
- case FAMChanged:
-#if HAVE_ACCESS
- {
- int err;
- char *title;
- if (mus_file_probe(sp->filename))
- {
- err = access(sp->filename, W_OK);
- sp->file_read_only = ((err < 0) ? FILE_READ_ONLY : FILE_READ_WRITE);
- if ((sp->file_read_only == FILE_READ_WRITE) &&
- (sp->user_read_only == FILE_READ_WRITE))
- clear_dialog_error(ep->edat);
- title = make_header_dialog_title(ep, sp);
- gtk_window_set_title(GTK_WINDOW(ep->dialog), title);
- free(title);
- return;
- }
- }
-#endif
-
- /* else fall through */
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- /* I don't think it makes sense to continue the dialog at this point */
- clear_dialog_error(ep->edat);
- gtk_widget_hide(ep->dialog);
- if (ep->panel_changed)
- unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
- ep->panel_changed = false;
- ep->file_ro_watcher = fam_unmonitor_file(ep->sp->filename, ep->file_ro_watcher);
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-#endif
-}
-
-
-static void edit_header_ok_callback(GtkWidget *w, gpointer context)
-{
- edhead_info *ep = (edhead_info *)context;
- if ((ep->sp) && (ep->sp->active))
- {
- bool ok;
- redirect_snd_error_to(redirect_post_file_dialog_error, (void *)(ep->edat));
- ok = edit_header_callback(ep->sp, ep->edat, redirect_post_file_dialog_error, redirect_post_file_panel_error);
- redirect_snd_error_to(NULL, NULL);
- if (ep->edat->error_widget != NOT_A_SCANF_WIDGET)
- {
- clear_error_if_panel_changes(ep->dialog, ep->edat);
- return;
- }
- else
- {
- if (!ok)
- {
- set_sensitive(ep->save_button, false);
- return;
- }
- }
- ep->file_ro_watcher = fam_unmonitor_file(ep->sp->filename, ep->file_ro_watcher);
- gtk_widget_hide(ep->dialog);
- unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
- }
-}
-
-
-GtkWidget *edit_header(snd_info *sp)
-{
- char *str;
- file_info *hdr;
- int i;
- edhead_info *ep = NULL;
-
- if (!sp) return(NULL);
- /* look for a dialog already editing this sound, raise if found, else make a new one */
- if (edhead_info_size > 0)
- {
- for (i = 0; i < edhead_info_size; i++)
- if ((edhead_infos[i]) &&
- ((edhead_infos[i]->sp == sp) ||
- ((edhead_infos[i]->sp) && /* maybe same sound open twice -- only one edit header dialog for it */
- (edhead_infos[i]->sp->inuse == SOUND_NORMAL) &&
- (mus_strcmp(sp->filename, edhead_infos[i]->sp->filename)))))
- {
- ep = edhead_infos[i];
- break;
- }
- }
- if (!ep)
- ep = new_edhead_dialog();
-
- ep->sp = sp;
- hdr = sp->hdr;
- ep->panel_changed = (hdr->type == MUS_RAW);
-
- if (!ep->dialog)
- {
- GtkWidget *help_button, *cancel_button;
- ep->dialog = snd_gtk_dialog_new();
- /* gtk_window_set_title(GTK_WINDOW(ep->dialog), "Edit Header"); */
- sg_make_resizable(ep->dialog);
- gtk_container_set_border_width (GTK_CONTAINER(ep->dialog), 10);
- gtk_window_resize(GTK_WINDOW(ep->dialog), 400, 250);
- gtk_widget_realize(ep->dialog);
-
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
-
- cancel_button = gtk_button_new_from_stock(GTK_STOCK_CANCEL);
- gtk_widget_set_name(cancel_button, "dialog_button");
- set_stock_button_label(cancel_button, "Go Away");
-
- ep->save_button = gtk_button_new_from_stock(GTK_STOCK_SAVE);
- gtk_widget_set_name(ep->save_button, "dialog_button");
-
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(ep->dialog)), ep->save_button, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(ep->dialog)), cancel_button, true, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(ep->dialog)), help_button, true, true, 10);
-
- ep->edat = make_file_data_panel(DIALOG_CONTENT_AREA(ep->dialog), "Edit Header",
- WITH_CHANNELS_FIELD,
- hdr->type,
- hdr->format,
- WITH_DATA_LOCATION_FIELD,
- WITH_SAMPLES_FIELD,
- WITH_HEADER_TYPE_FIELD,
- WITH_COMMENT_FIELD,
- WITH_BUILTIN_HEADERS,
- false, false);
- ep->edat->dialog = ep->dialog;
-
- SG_SIGNAL_CONNECT(ep->dialog, "delete_event", edit_header_delete_callback, ep);
- SG_SIGNAL_CONNECT(cancel_button, "clicked", edit_header_cancel_callback, ep);
- SG_SIGNAL_CONNECT(help_button, "clicked", edit_header_help_callback, ep);
- SG_SIGNAL_CONNECT(ep->save_button, "clicked", edit_header_ok_callback, ep);
-
- gtk_widget_show(cancel_button);
- gtk_widget_show(ep->save_button);
- gtk_widget_show(help_button);
-
- set_dialog_widget(EDIT_HEADER_DIALOG, ep->dialog);
- }
- else clear_dialog_error(ep->edat);
-
- str = make_header_dialog_title(ep, sp);
- gtk_window_set_title(GTK_WINDOW(ep->dialog), str);
- free(str);
-
- gtk_widget_set_sensitive(ep->save_button, (hdr->type == MUS_RAW));
-
- if (hdr->type == MUS_RAW)
- set_file_dialog_sound_attributes(ep->edat,
- default_output_header_type(ss),
- hdr->format, hdr->srate, hdr->chans,
- hdr->data_location, hdr->samples, hdr->comment);
- else set_file_dialog_sound_attributes(ep->edat,
- hdr->type, hdr->format, hdr->srate, hdr->chans,
- hdr->data_location, hdr->samples, hdr->comment);
-
- gtk_widget_show(ep->dialog);
- reflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
- ep->file_ro_watcher = fam_monitor_file(ep->sp->filename, (void *)ep, watch_file_read_only);
- return(ep->dialog);
-}
-
-
-void save_edit_header_dialog_state(FILE *fd)
-{
- int i;
- for (i = 0; i < edhead_info_size; i++)
- if (edhead_infos[i])
- {
- edhead_info *ep;
- ep = edhead_infos[i];
- if ((ep->dialog) &&
- (widget_is_active(ep->dialog)) &&
- (snd_ok(ep->sp)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s (%s \"%s\"))\n", S_edit_header_dialog, S_find_sound, ep->sp->short_filename);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(%s(\"%s\"))\n", TO_PROC_NAME(S_edit_header_dialog), TO_PROC_NAME(S_find_sound), ep->sp->short_filename);
-#endif
-#if HAVE_FORTH
- fprintf(fd, "\"%s\" %s %s drop\n", ep->sp->short_filename, S_find_sound, S_edit_header_dialog);
-#endif
- }
- }
-}
+ file_dialog_info *fd;
+ char *file_string;
+ sp = any_selected_sound();
+ if (sp) hdr = sp->hdr;
+ file_string = mus_format("save %s", (char *)((sp) ? sp->short_filename : ""));
+ if (!save_sound_as)
+ save_sound_as = make_save_as_dialog(file_string, default_output_header_type(ss), default_output_sample_type(ss), SOUND_SAVE_AS);
+ else gtk_window_set_title(GTK_WINDOW(save_sound_as->dialog), file_string);
+ free(file_string);
-/* ---------------- Post-it Monolog ---------------- */
+ fd = save_sound_as;
+ set_file_dialog_sound_attributes(fd->panel_data,
+ fd->panel_data->current_header_type,
+ fd->panel_data->current_sample_type,
+ (hdr) ? hdr->srate : selection_srate(),
+ IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
+ com = output_comment(hdr));
+ if (com) free(com);
+ if (chan >= 0)
+ {
+ char *chan_str;
+ chan_str = (char *)calloc(8, sizeof(char));
+ snprintf(chan_str, 8, "%d", chan);
+ gtk_entry_set_text(GTK_ENTRY(fd->panel_data->chans_text), chan_str);
+ free(chan_str);
+ }
+ if (managed) gtk_widget_show(fd->dialog);
+ make_auto_comment(fd);
+ return(fd);
+}
-#define POST_IT_ROWS 12
-#define POST_IT_COLUMNS 56
-static GtkWidget *post_it_text = NULL, *post_it_dialog = NULL;
+widget_t make_sound_save_as_dialog(bool managed)
+{
+ file_dialog_info *fd;
+ fd = make_sound_save_as_dialog_1(managed, -1);
+ return(fd->dialog);
+}
-static void dismiss_post_it(GtkWidget *w, gpointer context) {gtk_widget_hide(post_it_dialog);}
-static gint delete_post_it(GtkWidget *w, GdkEvent *event, gpointer context)
+void make_channel_extract_dialog(int chan)
{
- gtk_widget_hide(post_it_dialog);
- return(true);
+ make_sound_save_as_dialog_1(true, chan);
}
-static void create_post_it_monolog(void)
+widget_t make_selection_save_as_dialog(bool managed)
{
- /* create scrollable but not editable text window */
- GtkWidget *ok_button;
- post_it_dialog = gtk_dialog_new();
- SG_SIGNAL_CONNECT(post_it_dialog, "delete_event", delete_post_it, NULL);
-
- gtk_window_set_title(GTK_WINDOW(post_it_dialog), "Info");
- sg_make_resizable(post_it_dialog);
- gtk_container_set_border_width(GTK_CONTAINER(post_it_dialog), 10);
- gtk_window_resize(GTK_WINDOW(post_it_dialog), POST_IT_COLUMNS * 9, POST_IT_ROWS * 20);
- gtk_widget_realize(post_it_dialog);
+ file_dialog_info *fd;
- ok_button = gtk_button_new_from_stock(GTK_STOCK_OK);
- gtk_widget_set_name(ok_button, "dialog_button");
+ if (!save_selection_as)
+ save_selection_as = make_save_as_dialog("save current selection", default_output_header_type(ss), default_output_sample_type(ss), SELECTION_SAVE_AS);
+ else gtk_window_set_title(GTK_WINDOW(save_selection_as->dialog), "save current selection");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(post_it_dialog)), ok_button, false, true, 20);
- SG_SIGNAL_CONNECT(ok_button, "clicked", dismiss_post_it, NULL);
- gtk_widget_show(ok_button);
+ fd = save_selection_as;
+ set_file_dialog_sound_attributes(fd->panel_data,
+ fd->panel_data->current_header_type,
+ fd->panel_data->current_sample_type,
+ selection_srate(),
+ IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
+ NULL);
- post_it_text = make_scrolled_text(DIALOG_CONTENT_AREA(post_it_dialog), false, 2, true);
- gtk_text_view_set_left_margin(GTK_TEXT_VIEW(post_it_text), 10);
- gtk_widget_show(post_it_dialog);
- set_dialog_widget(POST_IT_DIALOG, post_it_dialog);
+ if (managed) gtk_widget_show(fd->dialog);
+ return(fd->dialog);
}
-widget_t post_it(const char *subject, const char *str)
+widget_t make_region_save_as_dialog(bool managed)
{
- if (ss == NULL) return(NULL);
- if (!(post_it_dialog)) create_post_it_monolog(); else raise_dialog(post_it_dialog);
- gtk_window_set_title(GTK_WINDOW(post_it_dialog), subject);
- gtk_text_buffer_set_text(gtk_text_view_get_buffer(GTK_TEXT_VIEW(post_it_text)), "", 0);
- sg_text_insert(post_it_text, (char *)str);
- return(post_it_dialog);
+ file_dialog_info *fd;
+ char *comment = NULL;
+
+ if (!save_region_as)
+ save_region_as = make_save_as_dialog("save current region", default_output_header_type(ss), default_output_sample_type(ss), REGION_SAVE_AS);
+ else gtk_window_set_title(GTK_WINDOW(save_region_as->dialog), "save current region");
+
+ fd = save_region_as;
+ comment = region_description(region_dialog_region());
+ set_file_dialog_sound_attributes(fd->panel_data,
+ fd->panel_data->current_header_type,
+ fd->panel_data->current_sample_type,
+ region_srate(region_dialog_region()),
+ IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
+ comment);
+ if (comment) free(comment);
+ if (managed) gtk_widget_show(fd->dialog);
+ return(fd->dialog);
}
-void save_post_it_dialog_state(FILE *fd)
+void save_file_dialog_state(FILE *fd)
{
- if ((post_it_dialog) && (widget_is_active(post_it_dialog)))
+ if ((odat) && (widget_is_active(odat->dialog)))
{
- char *subject;
- gchar *text;
- subject = dialog_get_title(post_it_dialog);
- text = sg_get_text(post_it_text, 0, -1);
#if HAVE_SCHEME
- fprintf(fd, "(%s \"%s\" \"%s\")\n", S_info_dialog, subject, text);
+ fprintf(fd, "(%s #t)\n", S_open_file_dialog);
#endif
#if HAVE_RUBY
- fprintf(fd, "%s(\"%s\", \"%s\")\n", TO_PROC_NAME(S_info_dialog), subject, text);
+ fprintf(fd, "%s(true)\n", to_proc_name(S_open_file_dialog));
#endif
#if HAVE_FORTH
- fprintf(fd, "\"%s\" \"%s\" %s drop\n", subject, text, S_info_dialog);
+ fprintf(fd, "#t %s drop\n", S_open_file_dialog);
#endif
- if (text) g_free(text);
- if (subject) free(subject);
}
-}
-
-
-
-/* ---------------- unsaved edits dialog ---------------- */
-
-static int num_unsaved_edits_dialogs = 0;
-static GtkWidget **unsaved_edits_dialogs = NULL;
-static snd_info **unsaved_edits_sounds = NULL;
-
-static GtkWidget *unsaved_edits_dialog(snd_info *sp)
-{
- int i;
- /* are there any such dialogs? */
- if (num_unsaved_edits_dialogs == 0)
- return(NULL);
-
- /* now see if we've already prompted about this sound */
- for (i = 0; i < num_unsaved_edits_dialogs; i++)
- if (unsaved_edits_sounds[i] == sp)
- return(unsaved_edits_dialogs[i]);
-
- /* try to find a free unmanaged dialog */
- for (i = 0; i < num_unsaved_edits_dialogs; i++)
- if ((unsaved_edits_dialogs[i]) &&
- (!widget_is_active(unsaved_edits_dialogs[i])))
- return(unsaved_edits_dialogs[i]);
-
- return(NULL);
-}
-
-static void save_unsaved_edits_dialog(GtkWidget *d, snd_info *sp)
-{
- if (num_unsaved_edits_dialogs == 0)
+ if ((mdat) && (widget_is_active(mdat->dialog)))
{
- unsaved_edits_dialogs = (GtkWidget **)calloc(1, sizeof(GtkWidget *));
- unsaved_edits_sounds = (snd_info **)calloc(1, sizeof(snd_info *));
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_mix_file_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_mix_file_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_mix_file_dialog);
+#endif
}
- else
+ if ((idat) && (widget_is_active(idat->dialog)))
{
- unsaved_edits_dialogs = (GtkWidget **)realloc(unsaved_edits_dialogs, (num_unsaved_edits_dialogs + 1) * sizeof(GtkWidget *));
- unsaved_edits_sounds = (snd_info **)realloc(unsaved_edits_sounds, (num_unsaved_edits_dialogs + 1) * sizeof(snd_info *));
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_insert_file_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_insert_file_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_insert_file_dialog);
+#endif
+ }
+ if ((save_sound_as) && (widget_is_active(save_sound_as->dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_save_sound_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_save_sound_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_save_sound_dialog);
+#endif
+ }
+ if ((save_selection_as) && (widget_is_active(save_selection_as->dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_save_selection_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_save_selection_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_save_selection_dialog);
+#endif
+ }
+ if ((save_region_as) && (widget_is_active(save_region_as->dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_save_region_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_save_region_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_save_region_dialog);
+#endif
}
-
- unsaved_edits_dialogs[num_unsaved_edits_dialogs] = d;
- unsaved_edits_sounds[num_unsaved_edits_dialogs] = sp;
- num_unsaved_edits_dialogs++;
-}
-
-
-void unpost_unsaved_edits_if_any(snd_info *sp)
-{
- int i;
- for (i = 0; i < num_unsaved_edits_dialogs; i++)
- if (((unsaved_edits_sounds[i] == sp) ||
- (!snd_ok(unsaved_edits_sounds[i]))) &&
- (widget_is_active(unsaved_edits_dialogs[i])))
- gtk_widget_hide(unsaved_edits_dialogs[i]);
}
-static void zero_edits(chan_info *cp)
-{
- cp->edit_ctr = 0;
-}
-
+/* -------------------------------- Raw Data Dialog -------------------------------- */
-static void unsaved_edits_activate(GtkDialog *w, gint id, gpointer context)
-{
- snd_info *sp = (snd_info *)context;
- if (id == GTK_RESPONSE_NO)
- for_each_sound_chan(sp, zero_edits);
- else save_edits(sp);
- snd_close_file(sp);
- gtk_widget_hide(GTK_WIDGET(w));
-}
+typedef struct raw_info {
+ GtkWidget *dialog;
+ mus_long_t location;
+ file_data *rdat;
+ read_only_t read_only;
+ bool selected;
+ char *filename;
+ char *help;
+ open_requestor_t requestor;
+ void *requestor_data;
+ GtkWidget *requestor_dialog;
+} raw_info;
+static int raw_info_size = 0;
+static raw_info **raw_infos = NULL;
-void save_edits_now(snd_info *sp)
+static raw_info *new_raw_dialog(void)
{
- char *question;
- GtkWidget *dialog;
-
- question = mus_format("%s has unsaved edits. Save them?", sp->short_filename);
- dialog = unsaved_edits_dialog(sp);
- if (!dialog)
+ int loc = -1;
+ if (raw_info_size == 0)
{
- dialog = gtk_message_dialog_new(NULL, GTK_DIALOG_MODAL, GTK_MESSAGE_QUESTION, GTK_BUTTONS_YES_NO, question);
- SG_SIGNAL_CONNECT(dialog, "response", unsaved_edits_activate, (gpointer)sp);
- save_unsaved_edits_dialog(dialog, sp);
+ loc = 0;
+ raw_info_size = 4;
+ raw_infos = (raw_info **)calloc(raw_info_size, sizeof(raw_info *));
}
else
{
- g_object_set(dialog, "text", question, NULL);
+ int i;
+ for (i = 0; i < raw_info_size; i++)
+ if ((!raw_infos[i]) ||
+ (!(widget_is_active(raw_infos[i]->dialog))))
+ {
+ loc = i;
+ break;
+ }
+ if (loc == -1)
+ {
+ loc = raw_info_size;
+ raw_info_size += 4;
+ raw_infos = (raw_info **)realloc(raw_infos, raw_info_size * sizeof(raw_info *));
+ for (i = loc; i < raw_info_size; i++) raw_infos[i] = NULL;
+ }
}
-
- free(question);
- gtk_widget_show(dialog);
-}
-
-
-
-
-/* ---------------- view files dialog ---------------- */
-
-static XEN mouse_enter_label_hook;
-static XEN mouse_leave_label_hook;
-
-static char *vf_row_get_label(void *ur)
-{
- vf_row *r = (vf_row *)ur;
- return(((view_files_info *)(r->vdat))->full_names[r->pos]);
-}
-
-
-static int vf_row_get_pos(void *ur)
-{
- vf_row *r = (vf_row *)ur;
- return(r->pos);
+ if (!raw_infos[loc])
+ {
+ raw_infos[loc] = (raw_info *)calloc(1, sizeof(raw_info));
+ raw_infos[loc]->dialog = NULL;
+ raw_infos[loc]->filename = NULL;
+ raw_infos[loc]->help = NULL;
+ }
+ raw_infos[loc]->requestor = NO_REQUESTOR;
+ raw_infos[loc]->requestor_data = NULL;
+ raw_infos[loc]->location = 0;
+ return(raw_infos[loc]);
}
-static void mouse_enter_or_leave_label(void *r, int type, XEN hook, const char *caller)
+static void raw_data_ok_callback(GtkWidget *w, gpointer context)
{
- if ((r) &&
- (XEN_HOOKED(hook)))
+ raw_info *rp = (raw_info *)context;
+ int raw_srate = 0, raw_chans = 0;
+ mus_sample_t raw_sample_type = MUS_UNKNOWN_SAMPLE;
+ redirect_snd_error_to(redirect_post_file_panel_error, (void *)(rp->rdat));
+ get_file_dialog_sound_attributes(rp->rdat, &raw_srate, &raw_chans, NULL, &raw_sample_type, &(rp->location), NULL, 1);
+ redirect_snd_error_to(NULL, NULL);
+ if (rp->rdat->error_widget != NOT_A_SCANF_WIDGET)
{
- char *label = NULL;
- if (type == FILE_VIEWER)
- label = vf_row_get_label(r);
- else label = regrow_get_label(r);
- if (label)
- run_hook(hook,
- XEN_LIST_3(C_TO_XEN_INT(type),
- C_TO_XEN_INT((type == FILE_VIEWER) ? (vf_row_get_pos(r)) : (regrow_get_pos(r))),
- C_TO_XEN_STRING(label)),
- caller);
+ clear_error_if_panel_changes(rp->dialog, rp->rdat);
}
-}
+ else
+ {
+ mus_header_set_raw_defaults(raw_srate, raw_chans, raw_sample_type);
+ mus_sound_override_header(rp->filename, raw_srate, raw_chans,
+ raw_sample_type, MUS_RAW, rp->location,
+ mus_bytes_to_samples(raw_sample_type,
+ mus_sound_length(rp->filename) - rp->location));
+ /* choose action based on how we got here */
+ if ((rp->requestor_dialog) &&
+ ((rp->requestor == FROM_MIX_DIALOG) ||
+ (rp->requestor == FROM_INSERT_DIALOG)))
+ {
+ ss->reloading_updated_file = true; /* don't reread lack-of-header! */
+ /* redirection may be still set here, but I'll make it obvious */
+ switch (rp->requestor)
+ {
+ case FROM_MIX_DIALOG:
+ redirect_snd_error_to(redirect_file_open_error, (void *)mdat);
+ mix_complete_file_at_cursor(any_selected_sound(), rp->filename);
+ break;
+ case FROM_INSERT_DIALOG:
+ redirect_snd_error_to(redirect_file_open_error, (void *)idat);
+ insert_complete_file_at_cursor(any_selected_sound(), rp->filename);
+ break;
-void mouse_leave_label(void *r, int type)
-{
- mouse_enter_or_leave_label(r, type, mouse_leave_label_hook, S_mouse_leave_label_hook);
+ default:
+ snd_error("wrong requestor type in raw data dialog? %d\n", (int)(rp->requestor));
+ break;
+ }
+ redirect_snd_error_to(NULL, NULL);
+ ss->reloading_updated_file = false;
+ }
+ else
+ {
+ file_info *hdr;
+ hdr = (file_info *)calloc(1, sizeof(file_info));
+ hdr->name = mus_strdup(rp->filename);
+ hdr->type = MUS_RAW;
+ hdr->srate = raw_srate;
+ hdr->chans = raw_chans;
+ hdr->sample_type = raw_sample_type;
+ hdr->samples = mus_bytes_to_samples(raw_sample_type,
+ mus_sound_length(rp->filename) - rp->location);
+ hdr->data_location = rp->location;
+ hdr->comment = NULL;
+ if (rp->requestor == FROM_KEYBOARD)
+ {
+ clear_status_area((snd_info *)(rp->requestor_data));
+ rp->selected = true;
+ }
+ finish_opening_sound(add_sound_window(rp->filename, rp->read_only, hdr), rp->selected);
+ }
+ gtk_widget_hide(rp->dialog);
+ }
}
-void mouse_enter_label(void *r, int type)
+static void raw_data_cancel_callback(GtkWidget *w, gpointer context)
{
- mouse_enter_or_leave_label(r, type, mouse_enter_label_hook, S_mouse_enter_label_hook);
+ raw_info *rp = (raw_info *)context;
+ gtk_widget_hide(rp->dialog);
+ if ((rp->requestor_dialog) &&
+ ((rp->requestor == FROM_OPEN_DIALOG) ||
+ (rp->requestor == FROM_MIX_DIALOG)))
+ gtk_widget_show(rp->requestor_dialog);
}
-static gboolean vf_mouse_enter_label(GtkWidget *w, GdkEventCrossing *ev, gpointer gp)
+static gint raw_data_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
{
- mouse_enter_label((void *)gp, FILE_VIEWER);
- return(false);
+ raw_info *rp = (raw_info *)context;
+ if ((rp->requestor_dialog) &&
+ ((rp->requestor == FROM_OPEN_DIALOG) ||
+ (rp->requestor == FROM_MIX_DIALOG)))
+ gtk_widget_show(rp->requestor_dialog);
+ return(true);
}
-static gboolean vf_mouse_leave_label(GtkWidget *w, GdkEventCrossing *ev, gpointer gp)
+static void raw_data_reset_callback(GtkWidget *w, gpointer context)
{
- mouse_leave_label((void *)gp, FILE_VIEWER);
- return(false);
+ raw_info *rp = (raw_info *)context;
+ int raw_srate, raw_chans;
+ mus_sample_t raw_sample_type;
+ rp->location = 0;
+ mus_header_raw_defaults(&raw_srate, &raw_chans, &raw_sample_type); /* pick up defaults */
+ set_file_dialog_sound_attributes(rp->rdat,
+ IGNORE_HEADER_TYPE,
+ raw_sample_type, raw_srate, raw_chans, rp->location,
+ IGNORE_SAMPLES, NULL);
+ clear_dialog_error(rp->rdat);
}
-static int vf_last_select_state = 0;
-static oclock_t mouse_down_time = 0, ev_mouse_down_time = 0;
-
-static gboolean select_event_callback(GtkWidget *w, GdkEventButton *ev, gpointer data)
+static void raw_data_help_callback(GtkWidget *w, gpointer context)
{
- vf_last_select_state = EVENT_STATE(ev);
- ev_mouse_down_time = EVENT_TIME(ev);
- return(false);
+ raw_info *rp = (raw_info *)context;
+ raw_data_dialog_help(rp->help);
}
-static vf_row *make_vf_row(view_files_info *vdat, GCallback play_callback, GCallback name_callback)
+static void make_raw_data_dialog(raw_info *rp, const char *filename, const char *title)
{
- vf_row *r;
- r = (vf_row *)calloc(1, sizeof(vf_row));
- r->vdat = (void *)vdat;
-
- r->rw = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(vdat->file_list), r->rw, false, false, 0);
- gtk_widget_show(r->rw);
+ GtkWidget *reset_button, *help_button, *cancel_button, *ok_button;
+ int raw_srate, raw_chans;
+ mus_sample_t raw_sample_type;
+
+ rp->dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(rp->dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
+ if (!title)
+ gtk_window_set_title(GTK_WINDOW(rp->dialog), "No header on file");
+ else gtk_window_set_title(GTK_WINDOW(rp->dialog), title);
+ sg_make_resizable(rp->dialog);
+ gtk_container_set_border_width(GTK_CONTAINER(rp->dialog), 10);
+ gtk_window_resize(GTK_WINDOW(rp->dialog), 350, 260);
+ gtk_widget_realize(rp->dialog);
- r->pl = gtk_check_button_new();
- gtk_box_pack_start(GTK_BOX(r->rw), r->pl, false, false, 2);
- widget_modify_bg(r->rw, GTK_STATE_NORMAL, ss->white);
- widget_modify_base(r->rw, GTK_STATE_NORMAL, ss->white);
- SG_SIGNAL_CONNECT(r->pl, "toggled", play_callback, r);
- gtk_widget_show(r->pl);
+ help_button = gtk_dialog_add_button(GTK_DIALOG(rp->dialog), "Help", GTK_RESPONSE_NONE);
+ reset_button = gtk_dialog_add_button(GTK_DIALOG(rp->dialog), "Reset", GTK_RESPONSE_NONE);
+ cancel_button = gtk_dialog_add_button(GTK_DIALOG(rp->dialog), "Go away", GTK_RESPONSE_NONE);
+ ok_button = gtk_dialog_add_button(GTK_DIALOG(rp->dialog), "Ok", GTK_RESPONSE_NONE);
- r->nm = gtk_button_new_with_label("");
- /* gtk_button_set_relief(GTK_BUTTON(r->nm), GTK_RELIEF_HALF); */
- widget_modify_bg(r->nm, GTK_STATE_NORMAL, ss->white);
- widget_modify_base(r->nm, GTK_STATE_NORMAL, ss->white);
- sg_left_justify_button(r->nm);
- gtk_box_pack_start(GTK_BOX(r->rw), r->nm, true, true, 2);
+ gtk_widget_set_name(help_button, "dialog_button");
+ gtk_widget_set_name(cancel_button, "dialog_button");
+ gtk_widget_set_name(reset_button, "dialog_button");
+ gtk_widget_set_name(ok_button, "dialog_button");
-#if HAVE_GTK_3
- {
- GtkWidget *child;
- child = gtk_bin_get_child(GTK_BIN(r->nm));
- gtk_widget_override_color(child, GTK_STATE_NORMAL, (GdkRGBA *)(ss->black));
- gtk_widget_override_color(child, GTK_STATE_PRELIGHT, (GdkRGBA *)(ss->black));
- gtk_widget_override_color(child, GTK_STATE_SELECTED, (GdkRGBA *)(ss->black));
- }
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(cancel_button);
+ add_highlight_button_style(help_button);
+ add_highlight_button_style(reset_button);
+ add_highlight_button_style(ok_button);
#endif
- SG_SIGNAL_CONNECT(r->nm, "clicked", name_callback, r);
- SG_SIGNAL_CONNECT(r->nm, "enter_notify_event", vf_mouse_enter_label, r);
- SG_SIGNAL_CONNECT(r->nm, "leave_notify_event", vf_mouse_leave_label, r);
- SG_SIGNAL_CONNECT(r->nm, "button_press_event", select_event_callback, (gpointer)vdat);
+ mus_header_raw_defaults(&raw_srate, &raw_chans, &raw_sample_type); /* pick up defaults */
- set_user_data(G_OBJECT(r->nm), (gpointer)r);
- gtk_widget_show(r->nm);
-
- vf_unhighlight_row(r->nm, r->rw);
- return(r);
-}
+ rp->rdat = make_file_data_panel(DIALOG_CONTENT_AREA(rp->dialog), "data-form",
+ WITH_CHANNELS_FIELD,
+ MUS_RAW, raw_sample_type,
+ WITH_DATA_LOCATION_FIELD,
+ WITHOUT_SAMPLES_FIELD,
+ WITHOUT_HEADER_TYPE_FIELD,
+ WITHOUT_COMMENT_FIELD,
+ WITH_READABLE_HEADERS,
+ WITHOUT_SRATE_FIELD,
+ WITHOUT_AUTO_COMMENT);
+ rp->rdat->dialog = rp->dialog;
+ set_file_dialog_sound_attributes(rp->rdat,
+ IGNORE_HEADER_TYPE,
+ raw_sample_type, raw_srate, raw_chans, rp->location,
+ IGNORE_SAMPLES, NULL);
+ SG_SIGNAL_CONNECT(rp->dialog, "delete_event", raw_data_delete_callback, rp);
+ SG_SIGNAL_CONNECT(ok_button, "clicked", raw_data_ok_callback, rp);
-void vf_unhighlight_row(GtkWidget *nm, GtkWidget *rw)
-{
- widget_modify_bg(nm, GTK_STATE_NORMAL, ss->white);
- widget_modify_base(nm, GTK_STATE_NORMAL, ss->white);
- widget_modify_bg(rw, GTK_STATE_NORMAL, ss->white);
- widget_modify_base(rw, GTK_STATE_NORMAL, ss->white);
-}
+ SG_SIGNAL_CONNECT(help_button, "clicked", raw_data_help_callback, rp);
+ SG_SIGNAL_CONNECT(reset_button, "clicked", raw_data_reset_callback, rp);
+ SG_SIGNAL_CONNECT(cancel_button, "clicked", raw_data_cancel_callback, rp);
+ gtk_widget_show(ok_button);
+ gtk_widget_show(cancel_button);
+ gtk_widget_show(help_button);
+ gtk_widget_show(reset_button);
-void vf_highlight_row(GtkWidget *nm, GtkWidget *rw)
-{
- widget_modify_bg(nm, GTK_STATE_NORMAL, ss->light_blue);
- widget_modify_base(nm, GTK_STATE_NORMAL, ss->light_blue);
- widget_modify_bg(rw, GTK_STATE_NORMAL, ss->light_blue);
- widget_modify_base(rw, GTK_STATE_NORMAL, ss->light_blue);
+ set_dialog_widget(RAW_DATA_DIALOG, rp->dialog);
}
-static gint vf_unflash_row(gpointer data)
+void raw_data_dialog_to_file_info(const char *filename, char *title, char *info, read_only_t read_only, bool selected)
{
- vf_row *r = (vf_row *)data;
- view_files_info *vdat;
- int i;
- vdat = (view_files_info *)(r->vdat);
- for (i = 0; i < vdat->currently_selected_files; i++)
- if (vdat->selected_files[i] == r->pos)
- {
- vf_highlight_row(r->nm, r->rw);
- return(0);
- }
- vf_unhighlight_row(r->nm, r->rw);
- return(0);
+ raw_info *rp;
+ rp = new_raw_dialog();
+ rp->read_only = read_only;
+ rp->selected = selected;
+ if (rp->filename) free(rp->filename);
+ rp->filename = mus_strdup(filename);
+ rp->requestor = ss->open_requestor;
+ rp->requestor_dialog = ss->requestor_dialog;
+ ss->open_requestor = NO_REQUESTOR;
+ ss->requestor_dialog = NULL;
+ if ((rp->requestor_dialog) &&
+ ((rp->requestor == FROM_OPEN_DIALOG) ||
+ (rp->requestor == FROM_MIX_DIALOG)))
+ gtk_widget_hide(rp->requestor_dialog);
+ if (!title)
+ title = mus_format("no header found on %s\n", filename);
+ if (!rp->dialog)
+ make_raw_data_dialog(rp, filename, title);
+ else gtk_window_set_title(GTK_WINDOW(rp->dialog), title);
+ free(title);
+ if (rp->help) free(rp->help);
+ if (info)
+ {
+ rp->help = mus_strdup(info);
+ free(info);
+ }
+ else rp->help = NULL;
+ raise_dialog(rp->dialog);
+ gtk_widget_show(rp->dialog);
}
-void vf_flash_row(vf_row *r)
-{
- widget_modify_bg(r->nm, GTK_STATE_NORMAL, ss->light_blue);
- widget_modify_base(r->nm, GTK_STATE_NORMAL, ss->light_blue);
- g_timeout_add_full(0, (guint32)500, vf_unflash_row, (gpointer)r, NULL);
-}
+/* -------------------------------- New File -------------------------------- */
+static GtkWidget *new_file_dialog = NULL, *new_file_text = NULL, *new_file_ok_button = NULL;
+static file_data *ndat = NULL;
+static mus_long_t initial_samples = 1;
+static char *new_file_filename = NULL;
+static void *new_file_watcher = NULL;
-void vf_post_info(view_files_info *vdat, int pos)
+static void cleanup_new_file_watcher(void)
{
- char *title;
- title = mus_format("%s:", vdat->names[pos]);
- info_widget_display(vdat->left_title, title);
- free(title);
- post_sound_info(vdat->info1, vdat->info2, vdat->full_names[pos], false);
+ new_file_watcher = unmonitor_file(new_file_watcher);
}
-void vf_post_selected_files_list(view_files_info *vdat)
-{
- int len;
- char *msg1 = NULL, *msg2 = NULL, *title;
- len = vdat->currently_selected_files;
-
- title = mus_strdup("selected files:");
- info_widget_display(vdat->left_title, title);
- free(title);
+static gulong new_file_handler_id = 0;
+static gboolean new_filename_modify_callback(GtkWidget *w, GdkEventKey *event, gpointer ignored);
- if (len == 2)
- {
- msg1 = mus_strdup(vdat->names[vdat->selected_files[0]]);
- msg2 = mus_strdup(vdat->names[vdat->selected_files[1]]);
- }
- else
+static void new_file_undoit(void)
+{
+ clear_dialog_error(ndat);
+ if (new_file_handler_id)
{
- if (len == 3)
- {
- msg1 = mus_format("%s, %s", vdat->names[vdat->selected_files[0]], vdat->names[vdat->selected_files[1]]);
- msg2 = mus_strdup(vdat->names[vdat->selected_files[2]]);
- }
- else
+ if (new_file_handler_id)
{
- msg1 = mus_format("%s, %s", vdat->names[vdat->selected_files[0]], vdat->names[vdat->selected_files[1]]);
- msg2 = mus_format("%s, %s%s", vdat->names[vdat->selected_files[2]], vdat->names[vdat->selected_files[3]],
- (len == 4) ? "" : "...");
+ g_signal_handler_disconnect(new_file_text, new_file_handler_id);
+ new_file_handler_id = 0;
}
}
+ set_stock_button_label(new_file_ok_button, "Ok");
+ new_file_watcher = unmonitor_file(new_file_watcher);
+}
- info_widget_display(vdat->info1, msg1);
- info_widget_display(vdat->info2, msg2);
-
- free(msg1);
- free(msg2);
- set_sensitive(vdat->openB, true);
- set_sensitive(vdat->removeB, true);
- set_sensitive(vdat->mixB, true);
- set_sensitive(vdat->insertB, true);
+static gboolean new_filename_modify_callback(GtkWidget *w, GdkEventKey *event, gpointer ignored)
+{
+ new_file_undoit();
+ return(false);
}
-void vf_unpost_info(view_files_info *vdat)
+static void clear_error_if_new_filename_changes(GtkWidget *dialog)
{
- char *title;
+ if (new_file_text)
+ new_file_handler_id = SG_SIGNAL_CONNECT(new_file_text, "key_press_event", new_filename_modify_callback, NULL);
+}
- title = mus_strdup("(no files selected)");
- info_widget_display(vdat->left_title, title);
- free(title);
- info_widget_display(vdat->info1, "");
- info_widget_display(vdat->info2, "");
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+static void watch_new_file(GFileMonitor *mon, GFile *file, GFile *other, GFileMonitorEvent ev, gpointer data)
+{
+ /* if file is deleted, respond in some debonair manner */
+ switch (ev)
+ {
+ case G_FILE_MONITOR_EVENT_CHANGED:
+ case G_FILE_MONITOR_EVENT_DELETED:
+ case G_FILE_MONITOR_EVENT_CREATED:
+#if HAVE_GTK_WIDGET_GET_VISIBLE
+ case G_FILE_MONITOR_EVENT_MOVED:
+#endif
+ new_file_undoit();
+ break;
- set_sensitive(vdat->openB, false);
- set_sensitive(vdat->removeB, false);
- set_sensitive(vdat->mixB, false);
- set_sensitive(vdat->insertB, false);
+ default:
+ /* ignore the rest */
+ break;
+ }
}
+#endif
-static void view_files_select_callback(GtkWidget *w, gpointer context)
+static void new_file_ok_callback(GtkWidget *w, gpointer context)
{
- if (mouse_down_time != 0)
+ mus_long_t loc;
+ char *newer_name = NULL, *msg;
+ mus_header_t header_type;
+ mus_sample_t sample_type;
+ int srate, chans;
+ newer_name = (char *)gtk_entry_get_text(GTK_ENTRY(new_file_text));
+ if ((!newer_name) || (!(*newer_name)))
{
- if ((ev_mouse_down_time - mouse_down_time) < 200)
+ msg = (char *)"new sound needs a file name ('New file:' field is empty)";
+ post_file_dialog_error((const char *)msg, ndat);
+ clear_error_if_new_filename_changes(new_file_dialog);
+ }
+ else
+ {
+ char *comment;
+ redirect_snd_error_to(redirect_post_file_panel_error, (void *)ndat);
+ comment = get_file_dialog_sound_attributes(ndat, &srate, &chans, &header_type, &sample_type, &loc, &initial_samples, 1);
+ redirect_snd_error_to(NULL, NULL);
+ if (ndat->error_widget != NOT_A_SCANF_WIDGET)
{
- mouse_down_time = ev_mouse_down_time;
- view_files_open_selected_files((view_files_info *)(((vf_row *)context)->vdat));
- return;
+ clear_error_if_panel_changes(new_file_dialog, ndat);
+ }
+ else
+ {
+ /* handle the overwrite hook directly */
+ if (new_file_filename) free(new_file_filename);
+ new_file_filename = mus_expand_filename(newer_name); /* need full filename for fam */
+ if ((!new_file_watcher) &&
+ (ask_before_overwrite(ss)) &&
+ (mus_file_probe(new_file_filename)))
+ {
+ msg = mus_format("%s exists. If you want to overwrite it, click 'DoIt'", newer_name);
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+ {
+ GFile *file;
+ GError *err = NULL;
+ file = g_file_new_for_path(new_file_filename);
+ new_file_watcher = (void *)g_file_monitor_file(file, G_FILE_MONITOR_NONE, NULL, &err);
+ if (err != NULL)
+ snd_warning("%s", err->message);
+ else g_signal_connect(G_OBJECT(new_file_watcher), "changed", G_CALLBACK(watch_new_file), NULL);
+ g_object_unref(file);
+ }
+#endif
+ set_stock_button_label(new_file_ok_button, "DoIt");
+ post_file_dialog_error((const char *)msg, ndat);
+ clear_error_if_new_filename_changes(new_file_dialog);
+ free(msg);
+ }
+ else
+ {
+ snd_info *sp;
+ if (new_file_watcher)
+ new_file_undoit();
+
+ ss->local_errno = 0;
+ redirect_snd_error_to(redirect_post_file_dialog_error, (void *)ndat);
+ sp = snd_new_file(newer_name, chans, srate, sample_type, header_type, comment, initial_samples);
+ redirect_snd_error_to(NULL, NULL);
+ if (!sp)
+ {
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+ if ((ss->local_errno) &&
+ (mus_file_probe(new_file_filename))) /* see comment in snd-xfile.c */
+ {
+ GFile *file;
+ GError *err = NULL;
+ file = g_file_new_for_path(new_file_filename);
+ new_file_watcher = (void *)g_file_monitor_file(file, G_FILE_MONITOR_NONE, NULL, &err);
+ if (err != NULL)
+ snd_warning("%s", err->message);
+ else g_signal_connect(G_OBJECT(new_file_watcher), "changed", G_CALLBACK(watch_new_file), NULL);
+ g_object_unref(file);
+ }
+#endif
+ clear_error_if_new_filename_changes(new_file_dialog);
+ }
+ else
+ {
+ gtk_widget_hide(new_file_dialog);
+ }
+ }
}
+ if (comment) free(comment);
}
- mouse_down_time = ev_mouse_down_time;
- view_files_select((vf_row *)context, vf_last_select_state & snd_ShiftMask);
-}
-
-
-static void view_files_play_callback(GtkWidget *w, gpointer context)
-{
- /* open and play -- close at end or when button off toggled */
- vf_row *r = (vf_row *)context;
- view_files_info *vdat;
- vdat = (view_files_info *)(r->vdat);
- if (view_files_play(vdat, r->pos, TOGGLE_BUTTON_ACTIVE(w)))
- set_toggle_button(w, false, false, (void *)vdat);
- else vdat->current_play_button = w;
}
-vf_row *view_files_make_row(view_files_info *vdat, widget_t ignored)
+static char *new_file_dialog_filename(int header_type)
{
- return(make_vf_row(vdat, (GCallback)view_files_play_callback, (GCallback)view_files_select_callback));
-}
+ static int new_file_dialog_file_ctr = 1;
+ char *filename = NULL;
+ const char *extensions[6] = {"aiff", "aiff", "wav", "wav", "caf", "snd"};
+ int extension = 0;
+ filename = (char *)calloc(64, sizeof(char));
+ switch (header_type)
+ {
+ case MUS_AIFC: extension = 0; break;
+ case MUS_AIFF: extension = 1; break;
+ case MUS_RF64: extension = 2; break;
+ case MUS_RIFF: extension = 3; break;
+ case MUS_CAFF: extension = 4; break;
+ default: extension = 5; break;
+ }
+ snprintf(filename, 64, "new-%d.%s", new_file_dialog_file_ctr++, extensions[extension]);
-static void view_files_help_callback(GtkWidget *w, gpointer context)
-{
- view_files_dialog_help();
+ return(filename);
}
-static gint view_files_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
+static void load_new_file_defaults(char *newname)
{
- view_files_info *vdat = (view_files_info *)context;
- gtk_widget_hide(vdat->dialog);
- return(true);
-}
+ char *new_comment = NULL;
+ mus_header_t header_type;
+ mus_sample_t sample_type;
+ int chans, srate;
+ header_type = default_output_header_type(ss);
+ chans = default_output_chans(ss);
+ sample_type = default_output_sample_type(ss);
+ srate = default_output_srate(ss);
+ new_comment = output_comment(NULL);
-static void view_files_dismiss_callback(GtkWidget *w, gpointer context)
-{
- view_files_info *vdat = (view_files_info *)context;
- gtk_widget_hide(vdat->dialog);
-}
-
+ if ((!newname) || (!(*newname)))
+ newname = new_file_dialog_filename(header_type);
+ gtk_entry_set_text(GTK_ENTRY(new_file_text), newname);
+ mus_sound_forget(newname);
-static void view_files_new_viewer_callback(GtkWidget *w, gpointer context)
-{
- view_files_info *vdat;
- vdat = new_view_files_dialog();
- start_view_files_dialog_1(vdat, true);
+ set_file_dialog_sound_attributes(ndat, header_type, sample_type, srate, chans, IGNORE_DATA_LOCATION, initial_samples, new_comment);
+ if (new_comment) free(new_comment);
}
-#if (!HAVE_FAM)
-static void view_files_clear_callback(GtkWidget *w, gpointer context)
+static void new_file_cancel_callback(GtkWidget *w, gpointer context)
{
- view_files_info *vdat = (view_files_info *)context;
- view_files_clear_list(vdat);
- view_files_display_list(vdat);
+ gtk_widget_hide(new_file_dialog);
}
-static void view_files_update_callback(GtkWidget *w, gpointer context)
+static void new_file_reset_callback(GtkWidget *w, gpointer context)
{
- view_files_info *vdat = (view_files_info *)context;
- /* run through view files list looking for any that have been deleted behind our back */
- view_files_update_list(vdat);
- view_files_display_list(vdat);
+ char *current_name;
+ current_name = (char *)gtk_entry_get_text(GTK_ENTRY(new_file_text));
+ load_new_file_defaults(current_name);
+ if (new_file_watcher)
+ new_file_undoit();
}
-#endif
-static void sort_vf(view_files_info *vdat, int sort_choice)
+static gint new_file_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
{
- vdat->sorter = sort_choice;
- vf_reflect_sort_choice_in_menu(vdat);
- view_files_display_list(vdat);
+ gtk_widget_hide(new_file_dialog);
+ return(true);
}
-static void sort_view_files_a_to_z(GtkWidget *w, gpointer context)
+static void new_file_help_callback(GtkWidget *w, gpointer context)
{
- sort_vf((view_files_info *)context, SORT_A_TO_Z);
+ new_file_dialog_help();
}
-static void sort_view_files_z_to_a(GtkWidget *w, gpointer context)
-{
- sort_vf((view_files_info *)context, SORT_Z_TO_A);
-}
-static void sort_view_files_new_to_old(GtkWidget *w, gpointer context)
+widget_t make_new_file_dialog(bool managed)
{
- sort_vf((view_files_info *)context, SORT_NEW_TO_OLD);
-}
+ if (!new_file_dialog)
+ {
+ GtkWidget *name_label, *hform, *help_button, *cancel_button, *reset_button;
+ new_file_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(new_file_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
+ gtk_window_set_title(GTK_WINDOW(new_file_dialog), "New file");
+ sg_make_resizable(new_file_dialog);
+ gtk_container_set_border_width (GTK_CONTAINER(new_file_dialog), 10);
+ gtk_window_resize(GTK_WINDOW(new_file_dialog), 400, 250);
+ gtk_widget_realize(new_file_dialog);
-static void sort_view_files_old_to_new(GtkWidget *w, gpointer context)
-{
- sort_vf((view_files_info *)context, SORT_OLD_TO_NEW);
-}
+ help_button = gtk_dialog_add_button(GTK_DIALOG(new_file_dialog), "Help", GTK_RESPONSE_NONE);
+ reset_button = gtk_dialog_add_button(GTK_DIALOG(new_file_dialog), "Reset", GTK_RESPONSE_NONE);
+ cancel_button = gtk_dialog_add_button(GTK_DIALOG(new_file_dialog), "Go away", GTK_RESPONSE_NONE);
+ new_file_ok_button = gtk_dialog_add_button(GTK_DIALOG(new_file_dialog), "Ok", GTK_RESPONSE_NONE);
-static void sort_view_files_big_to_small(GtkWidget *w, gpointer context)
-{
- sort_vf((view_files_info *)context, SORT_BIG_TO_SMALL);
-}
+ gtk_widget_set_name(help_button, "dialog_button");
+ gtk_widget_set_name(cancel_button, "dialog_button");
+ gtk_widget_set_name(new_file_ok_button, "dialog_button");
+ gtk_widget_set_name(reset_button, "dialog_button");
-static void sort_view_files_small_to_big(GtkWidget *w, gpointer context)
-{
- sort_vf((view_files_info *)context, SORT_SMALL_TO_BIG);
-}
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(help_button);
+ add_highlight_button_style(cancel_button);
+ add_highlight_button_style(reset_button);
+ add_highlight_button_style(new_file_ok_button);
+#endif
-static void sort_view_files_xen(GtkWidget *w, gpointer context)
-{
- long index;
- index = (long)get_user_data(G_OBJECT(w));
- sort_vf((view_files_info *)context, (int)index);
-}
+ hform = gtk_hbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(new_file_dialog)), hform, false, false, 4);
+ gtk_widget_show(hform);
+ name_label = gtk_label_new("New file:");
+ gtk_box_pack_start(GTK_BOX(hform), name_label, false, false, 2);
+ gtk_widget_show(name_label);
-void vf_reflect_sort_choice_in_menu(view_files_info *vdat)
-{
- int i;
- set_sensitive(vdat->a_to_z, vdat->sorter != SORT_A_TO_Z);
- set_sensitive(vdat->z_to_a, vdat->sorter != SORT_Z_TO_A);
- set_sensitive(vdat->new_to_old, vdat->sorter != SORT_NEW_TO_OLD);
- set_sensitive(vdat->old_to_new, vdat->sorter != SORT_OLD_TO_NEW);
- set_sensitive(vdat->small_to_big, vdat->sorter != SORT_SMALL_TO_BIG);
- set_sensitive(vdat->big_to_small, vdat->sorter != SORT_BIG_TO_SMALL);
- for (i = 0; i < vdat->sort_items_size; i++)
- if (widget_is_active(vdat->sort_items[i]))
- set_sensitive(vdat->sort_items[i], vdat->sorter != (SORT_XEN + i));
-}
+ new_file_text = snd_entry_new(hform, NULL, WITH_WHITE_BACKGROUND);
+ ndat = make_file_data_panel(DIALOG_CONTENT_AREA(new_file_dialog), "data-form",
+ WITH_CHANNELS_FIELD,
+ default_output_header_type(ss),
+ default_output_sample_type(ss),
+ WITHOUT_DATA_LOCATION_FIELD,
+ WITH_SAMPLES_FIELD,
+ WITH_HEADER_TYPE_FIELD,
+ WITH_COMMENT_FIELD,
+ WITH_BUILTIN_HEADERS,
+ WITHOUT_SRATE_FIELD,
+ WITHOUT_AUTO_COMMENT);
+ ndat->dialog = new_file_dialog;
-void view_files_add_file_or_directory(view_files_info *vdat, const char *file_or_dir)
-{
- char *filename;
- filename = mus_expand_filename((const char *)file_or_dir);
- if ((filename) && (filename[strlen(filename) - 1] == '*'))
- filename[strlen(filename) - 1] = 0;
- if (directory_p(filename))
- add_directory_to_view_files_list(vdat, (const char *)filename);
- else add_file_to_view_files_list(vdat, file_or_dir, filename);
- free(filename);
-}
+ SG_SIGNAL_CONNECT(new_file_dialog, "delete_event", new_file_delete_callback, ndat);
+ SG_SIGNAL_CONNECT(cancel_button, "clicked", new_file_cancel_callback, ndat);
+ SG_SIGNAL_CONNECT(help_button, "clicked", new_file_help_callback, ndat);
+ SG_SIGNAL_CONNECT(new_file_ok_button, "clicked", new_file_ok_callback, ndat);
+ SG_SIGNAL_CONNECT(reset_button, "clicked", new_file_reset_callback, ndat);
+ SG_SIGNAL_CONNECT(new_file_text, "activate", new_file_ok_callback, ndat);
+ gtk_widget_show(cancel_button);
+ gtk_widget_show(new_file_ok_button);
+ gtk_widget_show(reset_button);
+ gtk_widget_show(help_button);
-static void view_files_add_files(GtkWidget *w, gpointer context)
-{
- view_files_info *vdat = (view_files_info *)context;
- char *file_or_dir;
- file_or_dir = (char *)gtk_entry_get_text(GTK_ENTRY(w));
- if ((file_or_dir) && (*file_or_dir))
- {
- view_files_add_file_or_directory(vdat, (const char *)file_or_dir);
- view_files_display_list(vdat);
+ set_dialog_widget(NEW_FILE_DIALOG, new_file_dialog);
+ load_new_file_defaults(NULL);
}
-}
-
-
-static void view_files_drop_watcher(GtkWidget *w, const char *str, int x, int y, void *context)
-{
- view_files_info *vdat = (view_files_info *)context;
- char *filename;
- filename = mus_expand_filename(str);
- add_file_to_view_files_list(vdat, str, filename);
- free(filename);
- view_files_display_list(vdat);
-}
-
-
-static void view_files_open_selected_callback(GtkWidget *w, gpointer context)
-{
- view_files_open_selected_files((view_files_info *)context);
-}
-
-
-static void view_files_remove_selected_callback(GtkWidget *w, gpointer context)
-{
- view_files_remove_selected_files((view_files_info *)context);
-}
-
-
-mus_long_t vf_location(view_files_info *vdat)
-{
- mus_long_t pos = 0;
- snd_info *sp;
- chan_info *cp;
- char *str;
-
- switch (vdat->location_choice)
+ else
{
- case VF_AT_CURSOR:
- sp = any_selected_sound();
- if (sp)
- {
- cp = any_selected_channel(sp);
- return(CURSOR(cp));
- }
- break;
-
- case VF_AT_END:
- sp = any_selected_sound();
- if (sp)
- {
- cp = any_selected_channel(sp);
- return(CURRENT_SAMPLES(cp));
- }
- break;
-
- case VF_AT_BEGINNING:
- return(0);
- break;
+ char *new_name;
+ new_name = (char *)gtk_entry_get_text(GTK_ENTRY(new_file_text));
- case VF_AT_MARK:
- str = (char *)gtk_entry_get_text(GTK_ENTRY(vdat->at_mark_text));
- if ((str) && (*str))
+ if (new_file_watcher)
{
- pos = mark_id_to_sample(string_to_int(str, 0, "mark"));
- if (pos < 0)
- snd_error_without_format("no such mark");
+ /* if overwrite question pends, but file has been deleted in the meantime, go back to normal state */
+ if ((!new_name) || (!(*new_name)) ||
+ (!(mus_file_probe(new_name))))
+ new_file_undoit();
}
- else snd_error_without_format("no mark?");
- break;
- case VF_AT_SAMPLE:
- str = (char *)gtk_entry_get_text(GTK_ENTRY(vdat->at_sample_text));
- if ((str) && (*str))
+ if (strncmp(new_name, "new-", 4) == 0)
{
- pos = string_to_mus_long_t(str, 0, "sample");
- /* pos already checked for lower bound */
+ /* if file is open with currently posted new-file dialog name, and it's our name (new-%d), then tick the counter */
+ snd_info *sp;
+ sp = find_sound(new_name, 0);
+ if (sp)
+ {
+ char *filename;
+ filename = new_file_dialog_filename(default_output_header_type(ss));
+ gtk_entry_set_text(GTK_ENTRY(new_file_text), filename);
+ mus_sound_forget(filename);
+ free(filename);
+ }
}
- else snd_error_without_format("no sample number?");
- break;
}
- return(pos);
+ if (managed)
+ gtk_widget_show(new_file_dialog);
+ return(new_file_dialog);
}
-static void vf_clear_sample(view_files_info *vdat);
-
-static void vf_sample_button_modify_callback(GtkWidget *w, gpointer context)
-{
- vf_clear_sample((view_files_info *)context);
-}
+/* ---------------- Edit Header ---------------- */
-static void vf_sample_text_modify_callback(GtkWidget *w, gpointer context)
-{
- vf_clear_sample((view_files_info *)context);
-}
+typedef struct edhead_info {
+ GtkWidget *dialog, *save_button;
+ file_data *edat;
+ snd_info *sp;
+ bool panel_changed;
+ void *file_ro_watcher;
+ int sp_ro_watcher_loc;
+} edhead_info;
+static int edhead_info_size = 0;
+static edhead_info **edhead_infos = NULL;
-static void vf_clear_sample(view_files_info *vdat)
+static edhead_info *new_edhead_dialog(void)
{
- vf_clear_error(vdat);
- if (vdat->at_sample_text_handler_id != 0)
+ int loc = -1;
+ if (edhead_info_size == 0)
+ {
+ loc = 0;
+ edhead_info_size = 4;
+ edhead_infos = (edhead_info **)calloc(edhead_info_size, sizeof(edhead_info *));
+ }
+ else
+ {
+ int i;
+ for (i = 0; i < edhead_info_size; i++)
+ if ((!edhead_infos[i]) ||
+ (!(widget_is_active(edhead_infos[i]->dialog))))
+ {
+ loc = i;
+ break;
+ }
+ if (loc == -1)
+ {
+ loc = edhead_info_size;
+ edhead_info_size += 4;
+ edhead_infos = (edhead_info **)realloc(edhead_infos, edhead_info_size * sizeof(edhead_info *));
+ for (i = loc; i < edhead_info_size; i++) edhead_infos[i] = NULL;
+ }
+ }
+ if (!edhead_infos[loc])
{
- g_signal_handler_disconnect(vdat->at_sample_text, vdat->at_sample_text_handler_id);
- g_signal_handler_disconnect(vdat->at_sample_button, vdat->at_sample_button_handler_id);
- vdat->at_sample_text_handler_id = 0;
- vdat->at_sample_button_handler_id = 0;
+ edhead_infos[loc] = (edhead_info *)calloc(1, sizeof(edhead_info));
+ edhead_infos[loc]->dialog = NULL;
+ edhead_infos[loc]->panel_changed = false;
}
+ edhead_infos[loc]->sp = NULL;
+ edhead_infos[loc]->file_ro_watcher = NULL;
+ return(edhead_infos[loc]);
}
-static void vf_clear_mark(view_files_info *vdat);
-
-static void vf_mark_button_modify_callback(GtkWidget *w, gpointer context)
-{
- vf_clear_mark((view_files_info *)context);
-}
-
-
-static void vf_mark_text_modify_callback(GtkWidget *w, gpointer context)
+static void cleanup_edit_header_watcher(void)
{
- vf_clear_mark((view_files_info *)context);
+ int i;
+ for (i = 0; i < edhead_info_size; i++)
+ if (edhead_infos[i])
+ {
+ edhead_info *ep;
+ ep = edhead_infos[i];
+ if (ep->file_ro_watcher)
+ ep->file_ro_watcher = unmonitor_file(ep->file_ro_watcher);
+ }
}
-static void vf_clear_mark(view_files_info *vdat)
+static char *make_header_dialog_title(edhead_info *ep, snd_info *sp)
{
- vf_clear_error(vdat);
- if (vdat->at_mark_text_handler_id != 0)
+ /* dialog may not yet exist */
+ char *str;
+ str = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ if ((sp->user_read_only == FILE_READ_ONLY) ||
+ (sp->file_read_only == FILE_READ_ONLY))
{
- g_signal_handler_disconnect(vdat->at_mark_text, vdat->at_mark_text_handler_id);
- g_signal_handler_disconnect(vdat->at_mark_button, vdat->at_mark_button_handler_id);
- vdat->at_mark_text_handler_id = 0;
- vdat->at_mark_button_handler_id = 0;
+ if (sp->hdr->type == MUS_RAW)
+ snprintf(str, PRINT_BUFFER_SIZE, "Add header to (write-protected) %s", sp->short_filename);
+ else snprintf(str, PRINT_BUFFER_SIZE, "Edit header of (write-protected) %s", sp->short_filename);
}
+ else
+ {
+ if (sp->hdr->type == MUS_RAW)
+ snprintf(str, PRINT_BUFFER_SIZE, "Add header to %s", sp->short_filename);
+ else snprintf(str, PRINT_BUFFER_SIZE, "Edit header of %s", sp->short_filename);
+ }
+ return(str);
}
-void vf_post_error(const char *error_msg, view_files_info *vdat)
-{
- vdat->error_p = true;
- info_widget_display(vdat->info1, error_msg);
- info_widget_display(vdat->info2, "|");
-}
-
-
-void redirect_vf_post_error(const char *error_msg, void *vdat)
+static void edit_header_help_callback(GtkWidget *w, gpointer context)
{
- vf_post_error(error_msg, (view_files_info *)vdat);
+ edit_header_dialog_help();
}
-void redirect_vf_post_location_error(const char *error_msg, void *data)
+static void edit_header_set_ok_sensitive(GtkWidget *w, gpointer context)
{
- view_files_info *vdat = (view_files_info *)data;
- vf_post_error(error_msg, vdat);
- if (vdat->location_choice == VF_AT_SAMPLE)
- {
- /* watch at_sample_text or button (undo) */
- vdat->at_sample_text_handler_id = g_signal_connect(vdat->at_sample_text, "changed", G_CALLBACK(vf_sample_text_modify_callback), (gpointer)data);
- vdat->at_sample_button_handler_id = g_signal_connect(vdat->at_sample_button, "activated", G_CALLBACK(vf_sample_button_modify_callback), (gpointer)data);
- }
- else
- {
- /* watch at_mark_text or button */
- vdat->at_mark_text_handler_id = g_signal_connect(vdat->at_mark_text, "changed", G_CALLBACK(vf_mark_text_modify_callback), (gpointer)data);
- vdat->at_mark_button_handler_id = g_signal_connect(vdat->at_mark_button, "activated", G_CALLBACK(vf_mark_button_modify_callback), (gpointer)data);
- }
+ edhead_info *ep = (edhead_info *)context;
+ ep->panel_changed = true;
}
-static gboolean vf_add_text_modify_callback(GtkWidget *w, GdkEventKey *event, gpointer data)
+static void edit_header_done(edhead_info *ep)
{
- view_files_info *vdat = (view_files_info *)data;
- vf_clear_error(vdat);
- if (vdat->add_text_handler_id)
- {
- g_signal_handler_disconnect(w, vdat->add_text_handler_id);
- vdat->add_text_handler_id = 0;
- }
- return(false);
+ gtk_widget_hide(ep->dialog);
+ unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
+ ep->panel_changed = false;
+ ep->file_ro_watcher = unmonitor_file(ep->file_ro_watcher);
}
-void vf_post_add_error(const char *error_msg, view_files_info *vdat)
+static void edit_header_cancel_callback(GtkWidget *w, gpointer context)
{
- vf_post_error(error_msg, vdat);
- vdat->add_text_handler_id = SG_SIGNAL_CONNECT(vdat->add_text, "key_press_event", vf_add_text_modify_callback, (gpointer)vdat);
+ edit_header_done((edhead_info *)context);
}
-static void view_files_mix_selected_callback(GtkWidget *w, gpointer context)
+static gint edit_header_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
{
- view_files_mix_selected_files(w, (view_files_info *)context);
+ edit_header_done((edhead_info *)context);
+ return(true);
}
-static void view_files_insert_selected_callback(GtkWidget *w, gpointer context)
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+static void watch_file_read_only(GFileMonitor *mon, GFile *file, GFile *other, GFileMonitorEvent ev, gpointer data)
{
- view_files_insert_selected_files(w, (view_files_info *)context);
+ /* if file is deleted or permissions change, respond in some debonair manner */
+ edhead_info *ep = (edhead_info *)data;
+ snd_info *sp = NULL;
+ sp = ep->sp;
+ if (sp->writing) return;
+
+ switch (ev)
+ {
+ case G_FILE_MONITOR_EVENT_CHANGED:
+#ifndef _MSC_VER
+ {
+ if (mus_file_probe(sp->filename))
+ {
+ char *title;
+ int err;
+ err = access(sp->filename, W_OK);
+ sp->file_read_only = ((err < 0) ? FILE_READ_ONLY : FILE_READ_WRITE);
+ if ((sp->file_read_only == FILE_READ_WRITE) &&
+ (sp->user_read_only == FILE_READ_WRITE))
+ clear_dialog_error(ep->edat);
+ title = make_header_dialog_title(ep, sp);
+ gtk_window_set_title(GTK_WINDOW(ep->dialog), title);
+ free(title);
+ return;
+ }
+ }
+#endif
+
+ /* else fall through */
+ case G_FILE_MONITOR_EVENT_DELETED:
+ case G_FILE_MONITOR_EVENT_CREATED:
+#if HAVE_GTK_WIDGET_GET_VISIBLE
+ case G_FILE_MONITOR_EVENT_MOVED:
+#endif
+ /* I don't think it makes sense to continue the dialog at this point */
+ clear_dialog_error(ep->edat);
+ gtk_widget_hide(ep->dialog);
+ if (ep->panel_changed)
+ unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
+ ep->panel_changed = false;
+ ep->file_ro_watcher = unmonitor_file(ep->file_ro_watcher);
+ break;
+
+ default:
+ /* ignore the rest */
+ break;
+ }
}
+#endif
-static void view_files_at_cursor_callback(GtkWidget *w, gpointer context)
+static void edit_header_ok_callback(GtkWidget *w, gpointer context)
{
- view_files_info *vdat = (view_files_info *)context;
- if (vdat->error_p)
+ edhead_info *ep = (edhead_info *)context;
+ if ((ep->sp) && (ep->sp->active))
{
- if (vdat->location_choice == VF_AT_SAMPLE)
- vf_clear_sample(vdat);
- else vf_clear_mark(vdat);
+ bool ok;
+ redirect_snd_error_to(redirect_post_file_dialog_error, (void *)(ep->edat));
+ ok = edit_header_callback(ep->sp, ep->edat, redirect_post_file_dialog_error, redirect_post_file_panel_error);
+ redirect_snd_error_to(NULL, NULL);
+ if (ep->edat->error_widget != NOT_A_SCANF_WIDGET)
+ {
+ clear_error_if_panel_changes(ep->dialog, ep->edat);
+ return;
+ }
+ else
+ {
+ if (!ok)
+ return;
+ }
+ ep->file_ro_watcher = unmonitor_file(ep->file_ro_watcher);
+ gtk_widget_hide(ep->dialog);
+ unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
}
- vdat->location_choice = VF_AT_CURSOR;
}
-static void view_files_at_end_callback(GtkWidget *w, gpointer context)
+GtkWidget *edit_header(snd_info *sp)
{
- view_files_info *vdat = (view_files_info *)context;
- if (vdat->error_p)
+ char *str;
+ file_info *hdr;
+ edhead_info *ep = NULL;
+
+ if (!sp) return(NULL);
+ /* look for a dialog already editing this sound, raise if found, else make a new one */
+ if (edhead_info_size > 0)
{
- if (vdat->location_choice == VF_AT_SAMPLE)
- vf_clear_sample(vdat);
- else vf_clear_mark(vdat);
+ int i;
+ for (i = 0; i < edhead_info_size; i++)
+ if ((edhead_infos[i]) &&
+ ((edhead_infos[i]->sp == sp) ||
+ ((edhead_infos[i]->sp) && /* maybe same sound open twice -- only one edit header dialog for it */
+ (edhead_infos[i]->sp->inuse == SOUND_NORMAL) &&
+ (mus_strcmp(sp->filename, edhead_infos[i]->sp->filename)))))
+ {
+ ep = edhead_infos[i];
+ break;
+ }
}
- vdat->location_choice = VF_AT_END;
-}
+ if (!ep)
+ ep = new_edhead_dialog();
+ ep->sp = sp;
+ hdr = sp->hdr;
+ ep->panel_changed = (hdr->type == MUS_RAW);
-static void view_files_at_beginning_callback(GtkWidget *w, gpointer context)
-{
- view_files_info *vdat = (view_files_info *)context;
- if (vdat->error_p)
+ if (!ep->dialog)
{
- if (vdat->location_choice == VF_AT_SAMPLE)
- vf_clear_sample(vdat);
- else vf_clear_mark(vdat);
+ GtkWidget *help_button, *cancel_button;
+ ep->dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(ep->dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
+ /* gtk_window_set_title(GTK_WINDOW(ep->dialog), "Edit Header"); */
+ sg_make_resizable(ep->dialog);
+ gtk_container_set_border_width (GTK_CONTAINER(ep->dialog), 10);
+ gtk_window_resize(GTK_WINDOW(ep->dialog), 400, 250);
+ gtk_widget_realize(ep->dialog);
+
+ help_button = gtk_dialog_add_button(GTK_DIALOG(ep->dialog), "Help", GTK_RESPONSE_NONE);
+ cancel_button = gtk_dialog_add_button(GTK_DIALOG(ep->dialog), "Go away", GTK_RESPONSE_NONE);
+ ep->save_button = gtk_dialog_add_button(GTK_DIALOG(ep->dialog), "Save", GTK_RESPONSE_NONE);
+
+ gtk_widget_set_name(help_button, "dialog_button");
+ gtk_widget_set_name(cancel_button, "dialog_button");
+ gtk_widget_set_name(ep->save_button, "dialog_button");
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(help_button);
+ add_highlight_button_style(cancel_button);
+ add_highlight_button_style(ep->save_button);
+#endif
+
+ ep->edat = make_file_data_panel(DIALOG_CONTENT_AREA(ep->dialog), "Edit Header",
+ WITH_CHANNELS_FIELD,
+ hdr->type,
+ hdr->sample_type,
+ WITH_DATA_LOCATION_FIELD,
+ WITH_SAMPLES_FIELD,
+ WITH_HEADER_TYPE_FIELD,
+ WITH_COMMENT_FIELD,
+ WITH_BUILTIN_HEADERS,
+ WITHOUT_SRATE_FIELD,
+ WITHOUT_AUTO_COMMENT);
+ ep->edat->dialog = ep->dialog;
+
+ SG_SIGNAL_CONNECT(ep->dialog, "delete_event", edit_header_delete_callback, ep);
+ SG_SIGNAL_CONNECT(cancel_button, "clicked", edit_header_cancel_callback, ep);
+ SG_SIGNAL_CONNECT(help_button, "clicked", edit_header_help_callback, ep);
+ SG_SIGNAL_CONNECT(ep->save_button, "clicked", edit_header_ok_callback, ep);
+
+ gtk_widget_show(cancel_button);
+ gtk_widget_show(ep->save_button);
+ gtk_widget_show(help_button);
+
+ set_dialog_widget(EDIT_HEADER_DIALOG, ep->dialog);
}
- vdat->location_choice = VF_AT_BEGINNING;
-}
+ else clear_dialog_error(ep->edat);
+ str = make_header_dialog_title(ep, sp);
+ gtk_window_set_title(GTK_WINDOW(ep->dialog), str);
+ free(str);
-static void view_files_at_sample_callback(GtkWidget *w, gpointer context)
-{
- view_files_info *vdat = (view_files_info *)context;
- if ((vdat->error_p) &&
- (vdat->location_choice == VF_AT_MARK))
- vf_clear_mark(vdat);
- vdat->location_choice = VF_AT_SAMPLE;
+ if (hdr->type == MUS_RAW)
+ set_file_dialog_sound_attributes(ep->edat,
+ default_output_header_type(ss),
+ hdr->sample_type, hdr->srate, hdr->chans,
+ hdr->data_location, hdr->samples, hdr->comment);
+ else set_file_dialog_sound_attributes(ep->edat,
+ hdr->type, hdr->sample_type, hdr->srate, hdr->chans,
+ hdr->data_location, hdr->samples, hdr->comment);
+
+ gtk_widget_show(ep->dialog);
+ reflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
+#if HAVE_G_FILE_MONITOR_DIRECTORY
+ {
+ GFile *file;
+ GError *err = NULL;
+ file = g_file_new_for_path(ep->sp->filename);
+ ep->file_ro_watcher = (void *)g_file_monitor_file(file, G_FILE_MONITOR_NONE, NULL, &err);
+ if (err != NULL)
+ snd_warning("%s", err->message);
+ else g_signal_connect(G_OBJECT(ep->file_ro_watcher), "changed", G_CALLBACK(watch_file_read_only), (gpointer)ep);
+ g_object_unref(file);
+ }
+#endif
+ return(ep->dialog);
}
-static void view_files_at_mark_callback(GtkWidget *w, gpointer context)
+void save_edit_header_dialog_state(FILE *fd)
{
- view_files_info *vdat = (view_files_info *)context;
- if ((vdat->error_p) &&
- (vdat->location_choice == VF_AT_SAMPLE))
- vf_clear_sample(vdat);
- vdat->location_choice = VF_AT_MARK;
+ int i;
+ for (i = 0; i < edhead_info_size; i++)
+ if (edhead_infos[i])
+ {
+ edhead_info *ep;
+ ep = edhead_infos[i];
+ if ((ep->dialog) &&
+ (widget_is_active(ep->dialog)) &&
+ (snd_ok(ep->sp)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s (%s \"%s\"))\n", S_edit_header_dialog, S_find_sound, ep->sp->short_filename);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(%s(\"%s\"))\n", to_proc_name(S_edit_header_dialog), to_proc_name(S_find_sound), ep->sp->short_filename);
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "\"%s\" %s %s drop\n", ep->sp->short_filename, S_find_sound, S_edit_header_dialog);
+#endif
+ }
+ }
}
-/* -------- speed -------- */
+/* ---------------- Post-it Monolog ---------------- */
-static bool speed_pressed = false, speed_dragged = false;
+#define POST_IT_ROWS 12
+#define POST_IT_COLUMNS 56
-static mus_float_t vf_speed_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0.0);
- if (val >= maxval) return(0.9);
- return(0.9 * ((log(val) - log(minval)) / (log(maxval) - log(minval))));
-}
+static GtkWidget *post_it_text = NULL, *post_it_dialog = NULL;
+static void dismiss_post_it(GtkWidget *w, gpointer context) {gtk_widget_hide(post_it_dialog);}
-static mus_float_t vf_scroll_to_speed(mus_float_t scroll)
+static gint delete_post_it(GtkWidget *w, GdkEvent *event, gpointer context)
{
- return(exp((scroll * (log(speed_control_max(ss)) - log(speed_control_min(ss))) / 0.9) + log(speed_control_min(ss))));
+ gtk_widget_hide(post_it_dialog);
+ return(true);
}
-static void vf_set_speed_label(view_files_info *vdat, mus_float_t val)
+static void create_post_it_monolog(void)
{
- char speed_number_buffer[6];
- vdat->speed = speed_changed(val,
- speed_number_buffer,
- vdat->speed_style,
- speed_control_tones(ss),
- 6);
- set_label(vdat->speed_number, speed_number_buffer);
+ /* create scrollable but not editable text window */
+ GtkWidget *ok_button;
+ post_it_dialog = gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(post_it_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
+ SG_SIGNAL_CONNECT(post_it_dialog, "delete_event", delete_post_it, NULL);
+
+ gtk_window_set_title(GTK_WINDOW(post_it_dialog), "Info");
+ sg_make_resizable(post_it_dialog);
+ gtk_container_set_border_width(GTK_CONTAINER(post_it_dialog), 10);
+ gtk_window_resize(GTK_WINDOW(post_it_dialog), POST_IT_COLUMNS * 9, POST_IT_ROWS * 20);
+ gtk_widget_realize(post_it_dialog);
+
+ ok_button = gtk_dialog_add_button(GTK_DIALOG(post_it_dialog), "Ok", GTK_RESPONSE_NONE);
+ gtk_widget_set_name(ok_button, "dialog_button");
+ SG_SIGNAL_CONNECT(ok_button, "clicked", dismiss_post_it, NULL);
+ gtk_widget_show(ok_button);
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(ok_button);
+#endif
+
+ post_it_text = make_scrolled_text(DIALOG_CONTENT_AREA(post_it_dialog), false, BOX_PACK, true);
+ gtk_text_view_set_left_margin(GTK_TEXT_VIEW(post_it_text), 10);
+ gtk_widget_show(post_it_dialog);
+ set_dialog_widget(POST_IT_DIALOG, post_it_dialog);
}
-void vf_set_speed(view_files_info *vdat, mus_float_t val)
+widget_t post_it(const char *subject, const char *str)
{
- vf_set_speed_label(vdat, val);
- ADJUSTMENT_SET_VALUE(vdat->speed_adj, vf_speed_to_scroll(speed_control_min(ss), vdat->speed, speed_control_max(ss)));
- /* gtk_adjustment_value_changed(GTK_ADJUSTMENT(vdat->speed_adj)); */
+ if (ss == NULL) return(NULL);
+ if (!(post_it_dialog)) create_post_it_monolog(); else raise_dialog(post_it_dialog);
+ gtk_window_set_title(GTK_WINDOW(post_it_dialog), subject);
+ gtk_text_buffer_set_text(gtk_text_view_get_buffer(GTK_TEXT_VIEW(post_it_text)), "", 0);
+ sg_text_insert(post_it_text, (char *)str);
+ return(post_it_dialog);
}
-static gboolean vf_speed_click_callback(GtkWidget *w, GdkEventButton *ev, gpointer context)
+void post_it_append(const char *str)
{
- view_files_info *vdat = (view_files_info *)context;
- speed_dragged = false;
- speed_pressed = false;
- vf_set_speed(vdat, 1.0);
- return(false);
+ if (post_it_text)
+ sg_text_insert(post_it_text, (char *)str);
}
-static gboolean vf_speed_label_click_callback(GtkWidget *w, GdkEventButton *ev, gpointer context)
+void save_post_it_dialog_state(FILE *fd)
{
- view_files_info *vdat = (view_files_info *)context;
- speed_dragged = false;
- speed_pressed = false;
-
- switch (vdat->speed_style)
+ if ((post_it_dialog) && (widget_is_active(post_it_dialog)))
{
- default:
- case SPEED_CONTROL_AS_FLOAT: vdat->speed_style = SPEED_CONTROL_AS_RATIO; break;
- case SPEED_CONTROL_AS_RATIO: vdat->speed_style = SPEED_CONTROL_AS_SEMITONE; break;
- case SPEED_CONTROL_AS_SEMITONE: vdat->speed_style = SPEED_CONTROL_AS_FLOAT; break;
+ char *subject;
+ gchar *text;
+ subject = dialog_get_title(post_it_dialog);
+ text = sg_get_text(post_it_text, 0, -1);
+#if HAVE_SCHEME
+ fprintf(fd, "(%s \"%s\" \"%s\")\n", S_info_dialog, subject, text);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(\"%s\", \"%s\")\n", to_proc_name(S_info_dialog), subject, text);
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "\"%s\" \"%s\" %s drop\n", subject, text, S_info_dialog);
+#endif
+ if (text) g_free(text);
+ if (subject) free(subject);
}
-
- vf_set_speed_label(vdat, vf_scroll_to_speed(ADJUSTMENT_VALUE(vdat->speed_adj)));
- return(false);
}
-static gboolean vf_speed_motion_callback(GtkWidget *w, GdkEventMotion *ev, gpointer data)
+
+/* ---------------- unsaved edits dialog ---------------- */
+
+static int num_unsaved_edits_dialogs = 0;
+static GtkWidget **unsaved_edits_dialogs = NULL;
+static snd_info **unsaved_edits_sounds = NULL;
+
+static GtkWidget *unsaved_edits_dialog(snd_info *sp)
{
- view_files_info *vdat = (view_files_info *)data;
- if (!speed_pressed) {speed_dragged = false; return(false);}
- speed_dragged = true;
- vf_set_speed_label(vdat, vf_scroll_to_speed(ADJUSTMENT_VALUE(vdat->speed_adj)));
- return(false);
-}
+ int i;
+ /* are there any such dialogs? */
+ if (num_unsaved_edits_dialogs == 0)
+ return(NULL);
+
+ /* now see if we've already prompted about this sound */
+ for (i = 0; i < num_unsaved_edits_dialogs; i++)
+ if (unsaved_edits_sounds[i] == sp)
+ return(unsaved_edits_dialogs[i]);
+ /* try to find a free unmanaged dialog */
+ for (i = 0; i < num_unsaved_edits_dialogs; i++)
+ if ((unsaved_edits_dialogs[i]) &&
+ (!widget_is_active(unsaved_edits_dialogs[i])))
+ return(unsaved_edits_dialogs[i]);
-static gboolean vf_speed_release_callback(GtkWidget *w, GdkEventButton *ev, gpointer data)
-{
- view_files_info *vdat = (view_files_info *)data;
- speed_pressed = false;
- speed_dragged = false;
- vf_set_speed_label(vdat, vf_scroll_to_speed(ADJUSTMENT_VALUE(vdat->speed_adj)));
- return(false);
+ return(NULL);
}
-
-static gboolean vf_speed_press_callback(GtkWidget *w, GdkEventButton *ev, gpointer data)
+static void save_unsaved_edits_dialog(GtkWidget *d, snd_info *sp)
{
- speed_pressed = true;
- speed_dragged = false;
- return(false);
-}
-
-
-/* -------- amp -------- */
-
-static bool amp_pressed = false, amp_dragged = false;
+ if (num_unsaved_edits_dialogs == 0)
+ {
+ unsaved_edits_dialogs = (GtkWidget **)calloc(1, sizeof(GtkWidget *));
+ unsaved_edits_sounds = (snd_info **)calloc(1, sizeof(snd_info *));
+ }
+ else
+ {
+ unsaved_edits_dialogs = (GtkWidget **)realloc(unsaved_edits_dialogs, (num_unsaved_edits_dialogs + 1) * sizeof(GtkWidget *));
+ unsaved_edits_sounds = (snd_info **)realloc(unsaved_edits_sounds, (num_unsaved_edits_dialogs + 1) * sizeof(snd_info *));
+ }
-static mus_float_t vf_scroll_to_amp(mus_float_t val)
-{
- if (val <= 0.0)
- return(amp_control_min(ss));
- if (val >= 0.9)
- return(amp_control_max(ss));
- if (val > (0.5 * 0.9))
- return((((val / (0.5 * 0.9)) - 1.0) * (amp_control_max(ss) - 1.0)) + 1.0);
- else return((val * (1.0 - amp_control_min(ss)) / (0.5 * 0.9)) + amp_control_min(ss));
+ unsaved_edits_dialogs[num_unsaved_edits_dialogs] = d;
+ unsaved_edits_sounds[num_unsaved_edits_dialogs] = sp;
+ num_unsaved_edits_dialogs++;
}
-static mus_float_t vf_amp_to_scroll(mus_float_t amp)
+void unpost_unsaved_edits_if_any(snd_info *sp)
{
- return(amp_to_scroll(amp_control_min(ss), amp, amp_control_max(ss)));
+ int i;
+ for (i = 0; i < num_unsaved_edits_dialogs; i++)
+ if (((unsaved_edits_sounds[i] == sp) ||
+ (!snd_ok(unsaved_edits_sounds[i]))) &&
+ (widget_is_active(unsaved_edits_dialogs[i])))
+ gtk_widget_hide(unsaved_edits_dialogs[i]);
}
-void vf_set_amp(view_files_info *vdat, mus_float_t val)
+static void zero_edits(chan_info *cp)
{
- char sfs[6];
- vdat->amp = val;
- mus_snprintf(sfs, 6, "%.2f", val);
- set_label(vdat->amp_number, sfs);
- ADJUSTMENT_SET_VALUE(vdat->amp_adj, vf_amp_to_scroll(vdat->amp));
- /* gtk_adjustment_value_changed(GTK_ADJUSTMENT(vdat->amp_adj)); */
+ cp->edit_ctr = 0;
}
-static gboolean vf_amp_click_callback(GtkWidget *w, GdkEventButton *ev, gpointer context)
+static void unsaved_edits_activate(GtkDialog *w, gint id, gpointer context)
{
- amp_dragged = false;
- amp_pressed = false;
- vf_set_amp((view_files_info *)context, 1.0);
- return(false);
+ snd_info *sp = (snd_info *)context;
+ if (id == GTK_RESPONSE_NO)
+ for_each_sound_chan(sp, zero_edits);
+ else save_edits(sp);
+ snd_close_file(sp);
+ gtk_widget_hide(GTK_WIDGET(w));
}
-static gboolean vf_amp_motion_callback(GtkWidget *w, GdkEventMotion *ev, gpointer data)
+void save_edits_now(snd_info *sp)
{
- mus_float_t scrollval;
- char sfs[6];
- view_files_info *vdat = (view_files_info *)data;
-
- if (!amp_pressed) {amp_dragged = false; return(false);}
- amp_dragged = true;
+ char *question;
+ GtkWidget *dialog;
- scrollval = ADJUSTMENT_VALUE(vdat->amp_adj);
- vdat->amp = vf_scroll_to_amp(scrollval);
- mus_snprintf(sfs, 6, "%.2f", vdat->amp);
- set_label(vdat->amp_number, sfs);
+ question = mus_format("%s has unsaved edits. Save them?", sp->short_filename);
+ dialog = unsaved_edits_dialog(sp);
+ if (!dialog)
+ {
+ dialog = gtk_message_dialog_new(NULL, GTK_DIALOG_MODAL, GTK_MESSAGE_QUESTION, GTK_BUTTONS_YES_NO, "%s", question);
+ SG_SIGNAL_CONNECT(dialog, "response", unsaved_edits_activate, (gpointer)sp);
+ save_unsaved_edits_dialog(dialog, sp);
+ }
+ else
+ {
+ g_object_set(dialog, "text", question, NULL);
+ }
- return(false);
+ free(question);
+ gtk_widget_show(dialog);
}
-static gboolean vf_amp_release_callback(GtkWidget *w, GdkEventButton *ev, gpointer data)
-{
- mus_float_t scrollval;
- char sfs[6];
- view_files_info *vdat = (view_files_info *)data;
-
- amp_pressed = false;
- /* if (!amp_dragged) return(false); */
- amp_dragged = false;
- scrollval = ADJUSTMENT_VALUE(vdat->amp_adj);
- vdat->amp = vf_scroll_to_amp(scrollval);
- mus_snprintf(sfs, 6, "%.2f", vdat->amp);
- set_label(vdat->amp_number, sfs);
-
- return(false);
-}
+/* ---------------- file has changed dialog ---------------- */
+static int num_file_has_changed_dialogs = 0;
+static GtkWidget **file_has_changed_dialogs = NULL;
+static snd_info **file_has_changed_sounds = NULL;
-static gboolean vf_amp_press_callback(GtkWidget *w, GdkEventButton *ev, gpointer data)
+static GtkWidget *file_has_changed_dialog(snd_info *sp)
{
- amp_pressed = true;
- amp_dragged = false;
- return(false);
-}
+ int i;
+ /* are there any such dialogs? */
+ if (num_file_has_changed_dialogs == 0)
+ return(NULL);
+ /* now see if we've already prompted about this sound */
+ for (i = 0; i < num_file_has_changed_dialogs; i++)
+ if (file_has_changed_sounds[i] == sp)
+ return(file_has_changed_dialogs[i]);
+ /* try to find a free unmanaged dialog */
+ for (i = 0; i < num_file_has_changed_dialogs; i++)
+ if ((file_has_changed_dialogs[i]) &&
+ (!widget_is_active(file_has_changed_dialogs[i])))
+ return(file_has_changed_dialogs[i]);
-/* -------- amp-envs -------- */
+ return(NULL);
+}
-static void vf_amp_env_resize(view_files_info *vdat, GtkWidget *w)
+static void save_file_has_changed_dialog(GtkWidget *d, snd_info *sp)
{
- if (vdat->env_ax == NULL)
+ if (num_file_has_changed_dialogs == 0)
{
- vdat->env_gc = gc_new();
- gc_set_background(vdat->env_gc, ss->graph_color);
- gc_set_foreground(vdat->env_gc, ss->data_color);
- vdat->env_ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- vdat->env_ax->wn = WIDGET_TO_WINDOW(w);
- vdat->env_ax->w = w;
- vdat->env_ax->gc = vdat->env_gc;
+ file_has_changed_dialogs = (GtkWidget **)calloc(1, sizeof(GtkWidget *));
+ file_has_changed_sounds = (snd_info **)calloc(1, sizeof(snd_info *));
+ }
+ else
+ {
+ file_has_changed_dialogs = (GtkWidget **)realloc(file_has_changed_dialogs, (num_file_has_changed_dialogs + 1) * sizeof(GtkWidget *));
+ file_has_changed_sounds = (snd_info **)realloc(file_has_changed_sounds, (num_file_has_changed_dialogs + 1) * sizeof(snd_info *));
}
- ss->cr = MAKE_CAIRO(WIDGET_TO_WINDOW(w));
- cairo_push_group(ss->cr);
-
- /* erase previous */
- cairo_set_source_rgba(ss->cr, vdat->env_gc->bg_color->red, vdat->env_gc->bg_color->green, vdat->env_gc->bg_color->blue, vdat->env_gc->bg_color->alpha);
- cairo_rectangle(ss->cr, 0, 0, widget_width(w), widget_height(w));
- cairo_fill(ss->cr);
-
- vdat->spf->with_dots = true;
- env_editor_display_env(vdat->spf, vdat->amp_env, vdat->env_ax, NULL, 0, 0, widget_width(w), widget_height(w), NOT_PRINTING);
- cairo_pop_group_to_source(ss->cr);
- cairo_paint(ss->cr);
- FREE_CAIRO(ss->cr);
- ss->cr = NULL;
+ file_has_changed_dialogs[num_file_has_changed_dialogs] = d;
+ file_has_changed_sounds[num_file_has_changed_dialogs] = sp;
+ num_file_has_changed_dialogs++;
}
-void vf_set_amp_env(view_files_info *vdat, env *new_e)
+void unpost_file_has_changed_if_any(snd_info *sp)
{
- if (!vdat) return;
- if (vdat->amp_env) free_env(vdat->amp_env);
- vdat->amp_env = copy_env(new_e);
- if ((vdat->dialog) &&
- (widget_is_active(vdat->dialog)))
- vf_amp_env_resize(vdat, vdat->env_drawer);
+ int i;
+ for (i = 0; i < num_file_has_changed_dialogs; i++)
+ if (((file_has_changed_sounds[i] == sp) ||
+ (!snd_ok(file_has_changed_sounds[i]))) &&
+ (widget_is_active(file_has_changed_dialogs[i])))
+ gtk_widget_hide(file_has_changed_dialogs[i]);
}
-static gboolean vf_drawer_button_press(GtkWidget *w, GdkEventButton *ev, gpointer data)
+static void file_has_changed_activate(GtkDialog *w, gint id, gpointer context)
{
- view_files_info *vdat = (view_files_info *)data;
- vdat->spf->with_dots = false;
- if (env_editor_button_press(vdat->spf, (int)(EVENT_X(ev)), (int)(EVENT_Y(ev)), EVENT_TIME(ev), vdat->amp_env))
- vf_amp_env_resize(vdat, w);
- return(false);
+ if (id == GTK_RESPONSE_YES)
+ {
+ snd_info *sp = (snd_info *)context;
+ save_edits_without_asking(sp);
+ sp->need_update = false;
+ stop_bomb(sp); /* in case Snd already noticed the problem */
+ clear_status_area(sp);
+ }
+ gtk_widget_hide(GTK_WIDGET(w));
}
-static gboolean vf_drawer_button_release(GtkWidget *w, GdkEventButton *ev, gpointer data)
+void changed_file_dialog(snd_info *sp)
{
- view_files_info *vdat = (view_files_info *)data;
- env_editor_button_release(vdat->spf, vdat->amp_env);
- vf_amp_env_resize(vdat, w);
- return(false);
-}
-
+ char *question;
+ GtkWidget *dialog;
-static gboolean vf_drawer_button_motion(GtkWidget *w, GdkEventMotion *ev, gpointer data)
-{
- view_files_info *vdat = (view_files_info *)data;
- if (BUTTON1_PRESSED(EVENT_STATE(ev)))
+ question = mus_format("%s has changed! Save edits anyway?", sp->short_filename);
+ dialog = file_has_changed_dialog(sp);
+ if (!dialog)
{
- int x, y;
- GdkModifierType state;
- if (EVENT_IS_HINT(ev))
- gdk_window_get_pointer(EVENT_WINDOW(ev), &x, &y, &state);
- else
- {
- x = (int)(EVENT_X(ev));
- y = (int)(EVENT_Y(ev));
- }
- vdat->spf->with_dots = false;
- env_editor_button_motion(vdat->spf, x, y, EVENT_TIME(ev), vdat->amp_env);
- vf_amp_env_resize(vdat, w);
+ dialog = gtk_message_dialog_new(NULL, GTK_DIALOG_MODAL, GTK_MESSAGE_QUESTION, GTK_BUTTONS_YES_NO, "%s", question);
+ SG_SIGNAL_CONNECT(dialog, "response", file_has_changed_activate, (gpointer)sp);
+ save_file_has_changed_dialog(dialog, sp);
+ }
+ else
+ {
+ g_object_set(dialog, "text", question, NULL);
}
- return(false);
-}
-
-static gboolean vf_amp_env_expose_callback(GtkWidget *w, GdkEventExpose *ev, gpointer data)
-{
- view_files_info *vdat = (view_files_info *)data;
- vf_amp_env_resize(vdat, w);
- return(false);
+ free(question);
+ gtk_widget_show(dialog);
}
-static gboolean vf_amp_env_resize_callback(GtkWidget *w, GdkEventConfigure *ev, gpointer data)
-{
- view_files_info *vdat = (view_files_info *)data;
- vf_amp_env_resize(vdat, w);
- return(false);
-}
+/* drop */
+typedef struct {
+ void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data);
+ void (*drag_watcher)(GtkWidget *w, const char *message, int x, int y, drag_style_t dtype, void *data);
+ GtkWidget *caller;
+ void *context;
+} drop_watcher_t;
-static void view_files_reset_callback(GtkWidget *w, gpointer context)
-{
- view_files_info *vdat = (view_files_info *)context;
- env *e;
- vf_set_amp(vdat, 1.0);
- vf_set_speed(vdat, 1.0);
- vf_set_amp_env(vdat, e = default_env(1.0, 1.0));
- free_env(e);
- sort_vf(vdat, view_files_sort(ss));
-}
+static drop_watcher_t **drop_watchers = NULL;
+static int drop_watchers_size = 0;
+
+#define DROP_WATCHER_SIZE_INCREMENT 2
-GtkWidget *start_view_files_dialog_1(view_files_info *vdat, bool managed)
+static int add_drop_watcher(GtkWidget *w,
+ void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data),
+ void (*drag_watcher)(GtkWidget *w, const char *message, int x, int y, drag_style_t dtype, void *data),
+ void *context)
{
- if (!(vdat->dialog))
+ int loc = -1;
+ if (!(drop_watchers))
+ {
+ loc = 0;
+ drop_watchers_size = DROP_WATCHER_SIZE_INCREMENT;
+ drop_watchers = (drop_watcher_t **)calloc(drop_watchers_size, sizeof(drop_watcher_t *));
+ }
+ else
{
int i;
- GtkWidget *sep1, *cww, *rlw, *tophbox, *plw, *add_label, *addbox;
-#if (!HAVE_FAM)
- GtkWidget *bbox;
-#endif
- GtkWidget *sbar, *sitem, *newB;
- GtkWidget *mainform, *leftform, *fileform, *helpB, *dismissB, *resetB;
-
- vdat->dialog = snd_gtk_dialog_new();
-
- {
- char *filestr = NULL;
- filestr = mus_format("%s %d", "Files", vdat->index + 1);
- gtk_window_set_title(GTK_WINDOW(vdat->dialog), filestr);
- free(filestr);
- }
-
- sg_make_resizable(vdat->dialog);
- gtk_container_set_border_width (GTK_CONTAINER(vdat->dialog), 10);
- gtk_widget_realize(vdat->dialog);
- gtk_window_resize(GTK_WINDOW(vdat->dialog), 500, 540);
-
- helpB = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(helpB, "dialog_button");
-
- newB = sg_button_new_from_stock_with_label("New Viewer", GTK_STOCK_NEW);
- gtk_widget_set_name(newB, "dialog_button");
-
- dismissB = gtk_button_new_from_stock(GTK_STOCK_QUIT);
- gtk_widget_set_name(dismissB, "dialog_button");
- set_stock_button_label(dismissB, "Go Away");
-
- resetB = sg_button_new_from_stock_with_label("Reset", GTK_STOCK_REFRESH);
- gtk_widget_set_name(resetB, "dialog_button");
-
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(vdat->dialog)), newB, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(vdat->dialog)), dismissB, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(vdat->dialog)), resetB, true, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(vdat->dialog)), helpB, true, true, 10);
-
- SG_SIGNAL_CONNECT(vdat->dialog, "delete_event", view_files_delete_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(dismissB, "clicked", view_files_dismiss_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(newB, "clicked", view_files_new_viewer_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(helpB, "clicked", view_files_help_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(resetB, "clicked", view_files_reset_callback, (gpointer)vdat);
-
- gtk_widget_show(dismissB);
- gtk_widget_show(newB);
- gtk_widget_show(helpB);
- gtk_widget_show(resetB);
-
- mainform = gtk_hpaned_new();
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(vdat->dialog)), mainform, true, true, 0);
- gtk_widget_set_name(mainform, "the_unpane");
- gtk_widget_show(mainform);
-
- {
- GtkWidget *lmargin, *rmargin;
- /* these exist solely to put some blank space around the handle */
-
- lmargin = gtk_hbox_new(false, 0);
- gtk_paned_add1(GTK_PANED(mainform), lmargin);
- gtk_widget_show(lmargin);
-
- rmargin = gtk_hbox_new(false, 0);
- gtk_paned_add2(GTK_PANED(mainform), rmargin);
- gtk_widget_show(rmargin);
-
- leftform = gtk_vbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(lmargin), leftform, true, true, 4);
- gtk_widget_show(leftform);
-
- fileform = gtk_vbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(rmargin), fileform, true, true, 4);
- gtk_widget_show(fileform);
- }
-
- /* files section: play files | files */
-
- rlw = snd_gtk_highlight_label_new("files");
- gtk_box_pack_start(GTK_BOX(fileform), rlw, false, false, 0);
- gtk_widget_show(rlw);
-
- sep1 = gtk_hseparator_new();
- gtk_box_pack_start(GTK_BOX(fileform), sep1, false, false, 2);
- widget_modify_bg(sep1, GTK_STATE_NORMAL, ss->zoom_color);
- gtk_widget_show(sep1);
-
- tophbox = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(fileform), tophbox, false, false, 4);
- gtk_widget_show(tophbox);
-
- plw = gtk_label_new("play");
- gtk_box_pack_start(GTK_BOX(tophbox), plw, false, false, 5);
- gtk_widget_show(plw);
-
- sbar = gtk_menu_bar_new();
- gtk_box_pack_end(GTK_BOX(tophbox), sbar, false, false, 0);
- gtk_widget_show(sbar);
-
- vdat->smenu = gtk_menu_new();
- vdat->a_to_z = gtk_menu_item_new_with_label("a..z");
- vdat->z_to_a = gtk_menu_item_new_with_label("z..a");
- vdat->new_to_old = gtk_menu_item_new_with_label("new..old");
- vdat->old_to_new = gtk_menu_item_new_with_label("old..new");
- vdat->small_to_big = gtk_menu_item_new_with_label("small..big");
- vdat->big_to_small = gtk_menu_item_new_with_label("big..small");
-
- gtk_menu_shell_append(GTK_MENU_SHELL(vdat->smenu), vdat->a_to_z);
- gtk_menu_shell_append(GTK_MENU_SHELL(vdat->smenu), vdat->z_to_a);
- gtk_menu_shell_append(GTK_MENU_SHELL(vdat->smenu), vdat->new_to_old);
- gtk_menu_shell_append(GTK_MENU_SHELL(vdat->smenu), vdat->old_to_new);
- gtk_menu_shell_append(GTK_MENU_SHELL(vdat->smenu), vdat->small_to_big);
- gtk_menu_shell_append(GTK_MENU_SHELL(vdat->smenu), vdat->big_to_small);
-
- vdat->sort_items_size = 4;
- vdat->sort_items = (GtkWidget **)calloc(vdat->sort_items_size, sizeof(GtkWidget *));
- for (i = 0; i < vdat->sort_items_size; i++)
- {
- vdat->sort_items[i] = gtk_menu_item_new_with_label("unused");
- gtk_menu_shell_append(GTK_MENU_SHELL(vdat->smenu), vdat->sort_items[i]);
- }
-
- gtk_widget_show(vdat->a_to_z);
- gtk_widget_show(vdat->z_to_a);
- gtk_widget_show(vdat->new_to_old);
- gtk_widget_show(vdat->old_to_new);
- gtk_widget_show(vdat->small_to_big);
- gtk_widget_show(vdat->big_to_small);
-
- sitem = gtk_menu_item_new_with_label("sort");
- gtk_widget_show(sitem);
- gtk_menu_item_set_submenu(GTK_MENU_ITEM(sitem), vdat->smenu);
- gtk_menu_shell_append(GTK_MENU_SHELL(sbar), sitem);
-
- SG_SIGNAL_CONNECT(vdat->a_to_z, "activate", sort_view_files_a_to_z, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->z_to_a, "activate", sort_view_files_z_to_a, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->new_to_old, "activate", sort_view_files_new_to_old, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->old_to_new, "activate", sort_view_files_old_to_new, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->small_to_big, "activate", sort_view_files_small_to_big, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->big_to_small, "activate", sort_view_files_big_to_small, (gpointer)vdat);
-
- {
- int i;
- for (i = 0; i < vdat->sort_items_size; i++)
- SG_SIGNAL_CONNECT(vdat->sort_items[i], "activate", sort_view_files_xen, (gpointer)vdat);
- }
-
- vdat->file_list = gtk_vbox_new(false, 0);
-
- cww = gtk_scrolled_window_new(NULL, NULL);
- gtk_box_pack_start(GTK_BOX(fileform), cww, true, true, 0);
- gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(cww), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
- gtk_scrolled_window_add_with_viewport(GTK_SCROLLED_WINDOW(cww), vdat->file_list);
-
- gtk_widget_show(vdat->file_list);
- gtk_widget_show(cww);
- add_drop(vdat->file_list, view_files_drop_watcher, (void *)vdat);
-
-#if (!HAVE_FAM)
- bbox = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(fileform), bbox, false, false, 0);
- gtk_widget_show(bbox);
-
- vdat->updateB = gtk_button_new_from_stock(GTK_STOCK_REFRESH);
- gtk_widget_set_name(vdat->updateB, "dialog_button");
-
- vdat->clearB = gtk_button_new_from_stock(GTK_STOCK_CLEAR);
- gtk_widget_set_name(vdat->clearB, "dialog_button");
-
- gtk_box_pack_start(GTK_BOX(bbox), vdat->updateB, true, true, 1);
- gtk_box_pack_end(GTK_BOX(bbox), vdat->clearB, true, true, 1);
-
- SG_SIGNAL_CONNECT(vdat->updateB, "clicked", view_files_update_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->clearB, "clicked", view_files_clear_callback, (gpointer)vdat);
-
- gtk_widget_show(vdat->updateB);
- gtk_widget_show(vdat->clearB);
-#endif
-
- addbox = gtk_hbox_new(false, 0);
- gtk_box_pack_end(GTK_BOX(fileform), addbox, false, false, 0);
- gtk_widget_show(addbox);
-
- add_label = gtk_label_new("add:");
- gtk_box_pack_start(GTK_BOX(addbox), add_label, false, false, 4);
- gtk_widget_show(add_label);
-
- vdat->add_text = snd_entry_new(addbox, WITH_WHITE_BACKGROUND);
- SG_SIGNAL_CONNECT(vdat->add_text, "activate", view_files_add_files, (gpointer)vdat);
-
-
- /* left side */
- {
- GtkWidget *ltop_sep, *lbox, *frame;
- GtkWidget *lbox1, *lbox2, *lbox3, *lbox4, *lbox5;
-
- vdat->left_title = snd_gtk_entry_label_new("(no files selected)", ss->highlight_color);
- gtk_box_pack_start(GTK_BOX(leftform), vdat->left_title, false, false, 0);
-
- gtk_entry_set_alignment(GTK_ENTRY(vdat->left_title), 0.5);
-
- gtk_widget_show(vdat->left_title);
-
- ltop_sep = gtk_hseparator_new();
- gtk_box_pack_start(GTK_BOX(leftform), ltop_sep, false, false, 2);
- widget_modify_bg(ltop_sep, GTK_STATE_NORMAL, ss->zoom_color);
- gtk_widget_show(ltop_sep);
-
- vdat->info1 = make_info_widget();
- gtk_box_pack_start(GTK_BOX(leftform), vdat->info1, false, true, 0);
- info_widget_display(vdat->info1, "|");
- gtk_widget_show(vdat->info1);
-
- vdat->info2 = make_info_widget();
- gtk_box_pack_start(GTK_BOX(leftform), vdat->info2, false, true, 0);
- info_widget_display(vdat->info2, "|");
- gtk_widget_show(vdat->info2);
-
+ for (i = 0; i < drop_watchers_size; i++)
+ if (!(drop_watchers[i]))
+ {
+ loc = i;
+ break;
+ }
+ if (loc == -1)
{
- GtkWidget *spacer;
- spacer = gtk_vseparator_new();
- gtk_box_pack_start(GTK_BOX(leftform), spacer, false, false, 2);
- gtk_widget_show(spacer);
+ loc = drop_watchers_size;
+ drop_watchers_size += DROP_WATCHER_SIZE_INCREMENT;
+ drop_watchers = (drop_watcher_t **)realloc(drop_watchers, drop_watchers_size * sizeof(drop_watcher_t *));
+ for (i = loc; i < drop_watchers_size; i++) drop_watchers[i] = NULL;
}
+ }
+ drop_watchers[loc] = (drop_watcher_t *)calloc(1, sizeof(drop_watcher_t));
+ drop_watchers[loc]->drop_watcher = drop_watcher;
+ drop_watchers[loc]->drag_watcher = drag_watcher;
+ drop_watchers[loc]->context = context;
+ drop_watchers[loc]->caller = w;
+ return(loc);
+}
- lbox = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(leftform), lbox, false, false, 0);
- gtk_widget_show(lbox);
-
- vdat->openB = gtk_button_new_from_stock(GTK_STOCK_OPEN);
- vdat->removeB = sg_button_new_from_stock_with_label("Unlist", GTK_STOCK_REMOVE);
-
- gtk_box_pack_start(GTK_BOX(lbox), vdat->openB, true, true, 1);
- gtk_box_pack_end(GTK_BOX(lbox), vdat->removeB, true, true, 1);
-
- SG_SIGNAL_CONNECT(vdat->openB, "clicked", view_files_open_selected_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->removeB, "clicked", view_files_remove_selected_callback, (gpointer)vdat);
-
- set_sensitive(vdat->openB, false);
- set_sensitive(vdat->removeB, false);
-
- gtk_widget_show(vdat->openB);
- gtk_widget_show(vdat->removeB);
+static drop_watcher_t *find_drop_watcher(GtkWidget *caller)
+{
+ if (drop_watchers)
+ {
+ int i;
+ for (i = 0; i < drop_watchers_size; i++)
{
- GtkWidget *spacer;
- spacer = gtk_vseparator_new();
- gtk_box_pack_start(GTK_BOX(leftform), spacer, false, false, 4);
- gtk_widget_show(spacer);
+ if (drop_watchers[i])
+ {
+ drop_watcher_t *d;
+ d = drop_watchers[i];
+ if (d->caller == caller)
+ return(d);
+ }
}
+ }
+ return(NULL);
+}
- /* framed stuff */
- frame = gtk_frame_new(NULL);
- gtk_frame_set_shadow_type(GTK_FRAME(frame), GTK_SHADOW_ETCHED_IN);
- gtk_container_set_border_width(GTK_CONTAINER(frame), 3);
- widget_modify_bg(frame, GTK_STATE_NORMAL, ss->zoom_color);
- gtk_widget_show(frame);
- gtk_box_pack_start(GTK_BOX(leftform), frame, false, false, 0);
-
- lbox2 = gtk_vbox_new(false, 0);
- gtk_container_add(GTK_CONTAINER(frame), lbox2);
- gtk_widget_show(lbox2);
-
- lbox1 = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(lbox2), lbox1, false, false, 0);
- gtk_widget_show(lbox1);
-
- vdat->mixB = sg_button_new_from_stock_with_label("Mix", GTK_STOCK_ADD);
- vdat->insertB = sg_button_new_from_stock_with_label("Insert", GTK_STOCK_PASTE);
-
- gtk_box_pack_start(GTK_BOX(lbox1), vdat->mixB, true, true, 1);
- gtk_box_pack_end(GTK_BOX(lbox1), vdat->insertB, true, true, 1);
-
- SG_SIGNAL_CONNECT(vdat->mixB, "clicked", view_files_mix_selected_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->insertB, "clicked", view_files_insert_selected_callback, (gpointer)vdat);
-
- set_sensitive(vdat->mixB, false);
- set_sensitive(vdat->insertB, false);
-
- gtk_widget_show(vdat->mixB);
- gtk_widget_show(vdat->insertB);
-
- vdat->at_cursor_button = gtk_radio_button_new_with_label(NULL, "at cursor");
- widget_modify_bg(vdat->at_cursor_button, GTK_STATE_PRELIGHT, ss->lighter_blue);
- gtk_box_pack_start(GTK_BOX(lbox2), vdat->at_cursor_button, false, false, 0);
- gtk_widget_show(vdat->at_cursor_button);
- SG_SIGNAL_CONNECT(vdat->at_cursor_button, "clicked", view_files_at_cursor_callback, (gpointer)vdat);
-
- vdat->at_end_button = gtk_radio_button_new_with_label(gtk_radio_button_get_group(GTK_RADIO_BUTTON(vdat->at_cursor_button)), "at end");
- widget_modify_bg(vdat->at_end_button, GTK_STATE_PRELIGHT, ss->lighter_blue);
- gtk_box_pack_start(GTK_BOX(lbox2), vdat->at_end_button, false, false, 0);
- gtk_widget_show(vdat->at_end_button);
- SG_SIGNAL_CONNECT(vdat->at_end_button, "clicked", view_files_at_end_callback, (gpointer)vdat);
-
- vdat->at_beginning_button = gtk_radio_button_new_with_label(gtk_radio_button_get_group(GTK_RADIO_BUTTON(vdat->at_cursor_button)), "at beginning");
- widget_modify_bg(vdat->at_beginning_button, GTK_STATE_PRELIGHT, ss->lighter_blue);
- gtk_box_pack_start(GTK_BOX(lbox2), vdat->at_beginning_button, false, false, 0);
- gtk_widget_show(vdat->at_beginning_button);
- SG_SIGNAL_CONNECT(vdat->at_beginning_button, "clicked", view_files_at_beginning_callback, (gpointer)vdat);
- lbox5 = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(lbox2), lbox5, false, false, 0);
- gtk_widget_show(lbox5);
+enum {TARGET_STRING, TARGET_UTF8, TARGET_URL};
- lbox3 = gtk_vbox_new(true, 0);
- gtk_box_pack_start(GTK_BOX(lbox5), lbox3, false, false, 0);
- gtk_widget_show(lbox3);
+static GtkTargetEntry target_table[] = {
+ {(char *)"STRING", 0, TARGET_STRING},
+ {(char *)"FILE_NAME", 0, TARGET_STRING},
+ {(char *)"text/plain", 0, TARGET_STRING},
+ {(char *)"COMPOUND_TEXT", 0, TARGET_STRING},
+ {(char *)"UTF8_STRING", 0, TARGET_UTF8}, /* untested */
+ {(char *)"text/uri-list", 0, TARGET_URL}
+};
- lbox4 = gtk_vbox_new(true, 0);
- gtk_box_pack_start(GTK_BOX(lbox5), lbox4, true, true, 10);
- gtk_widget_show(lbox4);
+static Xen drop_hook;
- vdat->at_sample_button = gtk_radio_button_new_with_label(gtk_radio_button_get_group(GTK_RADIO_BUTTON(vdat->at_cursor_button)), "at sample");
- widget_modify_bg(vdat->at_sample_button, GTK_STATE_PRELIGHT, ss->lighter_blue);
- gtk_box_pack_start(GTK_BOX(lbox3), vdat->at_sample_button, false, false, 0);
- gtk_widget_show(vdat->at_sample_button);
- SG_SIGNAL_CONNECT(vdat->at_sample_button, "clicked", view_files_at_sample_callback, (gpointer)vdat);
- vdat->at_sample_text = snd_entry_new(lbox4, WITH_WHITE_BACKGROUND);
- gtk_widget_show(vdat->at_sample_text);
+#if HAVE_GTK_ADJUSTMENT_GET_UPPER
+ #define SELECTION_DATA(Data) (gtk_selection_data_get_data(Data))
+ #define SELECTION_LENGTH(Data) (gtk_selection_data_get_length(Data))
+ #define SELECTION_FORMAT(Data) (gtk_selection_data_get_format(Data))
+#else
+ #define SELECTION_DATA(Data) (Data->data)
+ #define SELECTION_LENGTH(Data) (Data->length)
+ #define SELECTION_FORMAT(Data) (Data->format)
+#endif
- vdat->at_mark_button = gtk_radio_button_new_with_label(gtk_radio_button_get_group(GTK_RADIO_BUTTON(vdat->at_cursor_button)), "at mark");
- widget_modify_bg(vdat->at_mark_button, GTK_STATE_PRELIGHT, ss->lighter_blue);
- gtk_box_pack_end(GTK_BOX(lbox3), vdat->at_mark_button, false, false, 0);
- gtk_widget_show(vdat->at_mark_button);
- SG_SIGNAL_CONNECT(vdat->at_mark_button, "clicked", view_files_at_mark_callback, (gpointer)vdat);
+static void drag_data_received(GtkWidget *caller, GdkDragContext *context, gint mx, gint my,
+ GtkSelectionData *data, guint info, guint time)
+{
+ /* data->target */
+ if ((SELECTION_LENGTH(data) >= 0) &&
+ (SELECTION_FORMAT(data) == 8))
+ {
+ gsize bread, bwritten;
+ GError *error;
+ char *str;
- vdat->at_sample_text = snd_entry_new(lbox4, WITH_WHITE_BACKGROUND);
- gtk_widget_show(vdat->at_sample_text);
+ if (info == TARGET_STRING)
+ str = (char *)(SELECTION_DATA(data));
+ else str = (char *)g_filename_from_utf8((gchar *)(SELECTION_DATA(data)), SELECTION_LENGTH(data), &bread, &bwritten, &error);
+ if ((!(Xen_hook_has_list(drop_hook))) ||
+ (!(Xen_is_true(run_or_hook(drop_hook,
+ Xen_list_1(C_string_to_Xen_string(str)),
+ S_drop_hook)))))
{
- GtkWidget *ampH, *ampL, *speedH, *speedL, *gframe;
-
- /* AMP */
- ampH = gtk_hbox_new(false, 2);
- gtk_box_pack_start(GTK_BOX(leftform), ampH, false, false, 4);
-
- vdat->amp_event = gtk_event_box_new();
- gtk_box_pack_start(GTK_BOX(ampH), vdat->amp_event, false, false, 4);
- gtk_widget_show(vdat->amp_event);
- SG_SIGNAL_CONNECT(vdat->amp_event, "button_press_event", vf_amp_click_callback, (gpointer)vdat);
-
- ampL = gtk_label_new("amp:");
- gtk_container_add(GTK_CONTAINER(vdat->amp_event), ampL);
- gtk_widget_show(ampL);
-
- vdat->amp_number = gtk_label_new("1.00");
- gtk_box_pack_start(GTK_BOX(ampH), vdat->amp_number, false, false, 0);
- gtk_widget_show(vdat->amp_number);
-
- vdat->amp_adj = (GtkAdjustment *)gtk_adjustment_new(0.5, 0.0, 1.0, 0.001, 0.01, .1);
- vdat->amp_scrollbar = gtk_hscrollbar_new(GTK_ADJUSTMENT(vdat->amp_adj));
- gtk_box_pack_start(GTK_BOX(ampH), vdat->amp_scrollbar, true, true, 4);
-
- SG_SIGNAL_CONNECT(vdat->amp_scrollbar, "motion_notify_event", vf_amp_motion_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->amp_scrollbar, "button_release_event", vf_amp_release_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->amp_scrollbar, "button_press_event", vf_amp_press_callback, (gpointer)vdat);
- gtk_widget_show(vdat->amp_scrollbar);
-
- gtk_widget_show(ampH);
-
- /* SPEED */
- speedH = gtk_hbox_new(false, 2);
- gtk_box_pack_start(GTK_BOX(leftform), speedH, false, false, 4);
-
- vdat->speed_event = gtk_event_box_new();
- gtk_box_pack_start(GTK_BOX(speedH), vdat->speed_event, false, false, 4);
- gtk_widget_show(vdat->speed_event);
- SG_SIGNAL_CONNECT(vdat->speed_event, "button_press_event", vf_speed_click_callback, (gpointer)vdat);
-
- speedL = gtk_label_new("speed:");
- gtk_container_add(GTK_CONTAINER(vdat->speed_event), speedL);
- gtk_widget_show(speedL);
-
- vdat->speed_label_event = gtk_event_box_new();
- gtk_box_pack_start(GTK_BOX(speedH), vdat->speed_label_event, false, false, 4);
- gtk_widget_show(vdat->speed_label_event);
- SG_SIGNAL_CONNECT(vdat->speed_label_event, "button_press_event", vf_speed_label_click_callback, (gpointer)vdat);
-
- switch (vdat->speed_style)
+ drop_watcher_t *d;
+ d = find_drop_watcher(caller);
+ if (d)
{
- case SPEED_CONTROL_AS_RATIO: vdat->speed_number = gtk_label_new("1/1"); break;
- case SPEED_CONTROL_AS_SEMITONE: vdat->speed_number = gtk_label_new("1"); break;
- default: vdat->speed_number = gtk_label_new("1.00"); break;
+ /* loop through possible list of filenames, calling watcher on each */
+ char *filename;
+ int len = 0, i, j = 0;
+ len = mus_strlen(str);
+ filename = (char *)calloc(len, sizeof(char));
+ for (i = 0; i < len; i++)
+ {
+ if (isspace((int)str[i]))
+ {
+ if (j > 0)
+ {
+ filename[j] = '\0';
+ if (strncmp(filename, "file://", 7) == 0)
+ {
+ char *tmp;
+ tmp = (char *)(filename + 7);
+ (*(d->drop_watcher))(caller, (const char *)tmp, mx, my, d->context);
+ }
+ else (*(d->drop_watcher))(caller, (const char *)filename, mx, my, d->context);
+ j = 0;
+ }
+ /* else ignore extra white space chars */
+ }
+ else
+ {
+ filename[j++] = str[i];
+ }
+ }
+ free(filename);
}
- gtk_container_add(GTK_CONTAINER(vdat->speed_label_event), vdat->speed_number);
- gtk_widget_show(vdat->speed_number);
-
- vdat->speed_adj = (GtkAdjustment *)gtk_adjustment_new(0.45, 0.0, 1.0, 0.001, 0.01, .1);
- vdat->speed_scrollbar = gtk_hscrollbar_new(GTK_ADJUSTMENT(vdat->speed_adj));
- gtk_box_pack_start(GTK_BOX(speedH), vdat->speed_scrollbar, true, true, 4);
- SG_SIGNAL_CONNECT(vdat->speed_scrollbar, "button_release_event", vf_speed_release_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->speed_scrollbar, "motion_notify_event", vf_speed_motion_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->speed_scrollbar, "button_press_event", vf_speed_press_callback, (gpointer)vdat);
-
- gtk_widget_show(vdat->speed_scrollbar);
- gtk_widget_show(speedH);
-
-
- /* GRAPH (frame) */
- gframe = gtk_frame_new(NULL);
- gtk_box_pack_end(GTK_BOX(leftform), gframe, true, true, 10);
-
- /* GRAPH (drawing area) */
- vdat->env_drawer = gtk_drawing_area_new();
- gtk_widget_set_events(vdat->env_drawer, GDK_ALL_EVENTS_MASK);
- gtk_container_add(GTK_CONTAINER(gframe), vdat->env_drawer);
- widget_modify_bg(vdat->env_drawer, GTK_STATE_NORMAL, ss->white);
- gtk_widget_show(vdat->env_drawer);
-
- SG_SIGNAL_CONNECT(vdat->env_drawer, DRAW_SIGNAL, vf_amp_env_expose_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->env_drawer, "configure_event", vf_amp_env_resize_callback, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->env_drawer, "button_press_event", vf_drawer_button_press, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->env_drawer, "button_release_event", vf_drawer_button_release, (gpointer)vdat);
- SG_SIGNAL_CONNECT(vdat->env_drawer, "motion_notify_event", vf_drawer_button_motion, (gpointer)vdat);
+ }
+ gtk_drag_finish (context, true, false, time);
+ return;
+ }
+ gtk_drag_finish(context, false, false, time);
+}
- gtk_widget_show(gframe);
- vdat->spf = new_env_editor(); /* one global amp env */
+static void drag_leave(GtkWidget *w, GdkDragContext *context, guint time)
+{
+ drop_watcher_t *d;
+ d = find_drop_watcher(w);
+ if ((d) && (d->drag_watcher))
+ (*(d->drag_watcher))(w, NULL, 0, 0, DRAG_LEAVE, d->context);
+}
+
- }
- }
+static gboolean drag_motion(GtkWidget *w, GdkDragContext *context, gint x, gint y, guint time)
+{
+ drop_watcher_t *d;
+ d = find_drop_watcher(w);
+ if ((d) && (d->drag_watcher))
+ (*(d->drag_watcher))(w, NULL, x, y, DRAG_MOTION, d->context);
+ return(true); /* this is what the examples return in gtk/tests/testdnd.c -- don't know what it means, if anything */
+}
+
- set_dialog_widget(VIEW_FILES_DIALOG, vdat->dialog);
- }
- if (managed)
- {
- view_files_display_list(vdat);
- raise_dialog(vdat->dialog);
- }
- return(vdat->dialog);
+void add_drag_and_drop(GtkWidget *w,
+ void (*drop_watcher)(GtkWidget *w, const char *message, int x, int y, void *data),
+ void (*drag_watcher)(GtkWidget *w, const char *message, int x, int y, drag_style_t dtype, void *data),
+ void *context)
+{
+ gtk_drag_dest_set(w, GTK_DEST_DEFAULT_ALL, target_table, 6, (GdkDragAction)(GDK_ACTION_COPY | GDK_ACTION_MOVE | GDK_ACTION_LINK));
+ SG_SIGNAL_CONNECT(w, "drag_data_received", drag_data_received, NULL);
+ SG_SIGNAL_CONNECT(w, "drag_motion", drag_motion, NULL);
+ SG_SIGNAL_CONNECT(w, "drag_leave", drag_leave, NULL);
+ add_drop_watcher(w, drop_watcher, drag_watcher, context);
}
+
void g_init_gxfile(void)
{
-#if HAVE_SCHEME
- #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
-The 'type' is 1 for view-files, and 2 for regions. The 'position' \
-is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.scm \
-to popup file info as follows: \n\
-(add-hook! " S_mouse_enter_label_hook "\n\
- (lambda (type position name)\n\
- (if (not (= type 2))\n\
- (" S_info_dialog " name (finfo name)))))\n\
-See also nb.scm."
-#endif
-#if HAVE_RUBY
- #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
-The 'type' is 1 for view-files, and 2 for regions. The 'position' \
-is the scrolled list position of the label. The label itself is 'label'."
-#endif
-#if HAVE_FORTH
- #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
-The 'type' is 1 for view-files, and 2 for regions. The 'position' \
-is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.scm \
-to popup file info as follows: \n\
-" S_mouse_enter_label_hook " lambda: <{ type position name }>\n\
- type 2 <> if\n\
- name name finfo info-dialog\n\
- else\n\
- #f\n\
- then\n\
-; add-hook!"
-#endif
-
- #define H_mouse_leave_label_hook S_mouse_leave_label_hook " (type position label): called when the mouse leaves a file viewer or region label"
+ #define H_drop_hook S_drop_hook " (name): called whenever Snd receives a drag-and-drop \
+event. If it returns " PROC_TRUE ", the file is not opened by Snd."
- mouse_enter_label_hook = XEN_DEFINE_HOOK(S_mouse_enter_label_hook, 3, H_mouse_enter_label_hook);
- mouse_leave_label_hook = XEN_DEFINE_HOOK(S_mouse_leave_label_hook, 3, H_mouse_leave_label_hook);
+ drop_hook = Xen_define_hook(S_drop_hook, "(make-hook 'name)", 1, H_drop_hook);
}
diff --git a/snd-gfind.c b/snd-gfind.c
index ece7870..126626c 100644
--- a/snd-gfind.c
+++ b/snd-gfind.c
@@ -1,19 +1,10 @@
#include "snd.h"
-
-static GtkWidget *edit_find_dialog, *edit_find_text, *cancelB, *edit_find_label, *next_button, *previous_button;
-
+static GtkWidget *edit_find_dialog, *edit_find_text, *find_cancel_button, *edit_find_label, *find_next_button, *find_previous_button;
static GtkWidget *find_error_frame = NULL, *find_error_label = NULL;
-
-static void clear_find_error(void);
+static chan_info *find_channel = NULL;
static gulong find_key_press_handler_id = 0;
-static gboolean find_modify_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
-{
- clear_find_error();
- return(false);
-}
-
static void clear_find_error(void)
{
@@ -27,15 +18,22 @@ static void clear_find_error(void)
}
-static void errors_to_find_text(const char *msg, void *data)
+static gboolean find_modify_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+{
+ clear_find_error();
+ return(false);
+}
+
+
+void errors_to_find_text(const char *msg, void *data)
{
- set_label(find_error_label, msg);
+ find_dialog_set_label(msg);
gtk_widget_show(find_error_frame);
find_key_press_handler_id = SG_SIGNAL_CONNECT(edit_find_text, "key_press_event", find_modify_key_press, NULL);
}
-static void stop_search_if_error(const char *msg, void *data)
+void stop_search_if_error(const char *msg, void *data)
{
errors_to_find_text(msg, data);
ss->stopped_explicitly = true; /* should be noticed in global_search in snd-find.c */
@@ -69,59 +67,22 @@ static void edit_find_help(GtkWidget *w, gpointer context)
static void edit_find_find(read_direction_t direction, GtkWidget *w, gpointer context)
-{ /* "Find" is the label here */
- char *str, *buf = NULL;
- str = (char *)gtk_entry_get_text(GTK_ENTRY(edit_find_text));
- if ((str) && (*str))
- {
- XEN proc;
- clear_global_search_procedure(true);
- ss->search_expr = mus_strdup(str);
- redirect_errors_to(errors_to_find_text, NULL);
- proc = snd_catch_any(eval_str_wrapper, str, str);
- redirect_errors_to(NULL, NULL);
- if ((XEN_PROCEDURE_P(proc)) && (procedure_arity_ok(proc, 1)))
- {
- ss->search_proc = proc;
- ss->search_proc_loc = snd_protect(proc);
-#if HAVE_SCHEME
- if (optimization(ss) > 0)
- ss->search_tree = mus_run_form_to_ptree_1_b(XEN_PROCEDURE_SOURCE(proc));
-#endif
- buf = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(buf, PRINT_BUFFER_SIZE, "find: %s", str);
- set_label(edit_find_label, buf);
- free(buf);
- }
- }
- else
- {
- if (ss->search_expr == NULL)
- {
- char *temp = NULL;
- /* using global search_proc set by user */
- buf = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(buf, PRINT_BUFFER_SIZE, "find: %s", temp = (char *)XEN_AS_STRING(ss->search_proc));
-#if HAVE_SCHEME
- if (temp) free(temp);
+{
+#if HAVE_EXTENSION_LANGUAGE
+ find_dialog_find((char *)gtk_entry_get_text(GTK_ENTRY(edit_find_text)), direction, find_channel);
#endif
- set_label(edit_find_label, buf);
- free(buf);
- }
- }
- if ((XEN_PROCEDURE_P(ss->search_proc)) || (ss->search_tree))
- {
- set_stock_button_label(cancelB, "Stop");
- redirect_xen_error_to(stop_search_if_error, NULL);
- str = global_search(direction);
- redirect_xen_error_to(NULL, NULL);
- set_stock_button_label(cancelB, "Go Away");
- if ((str) && (*str)) set_label(edit_find_label, str);
- }
-}
+}
+
+
+void find_dialog_stop_label(bool show_stop)
+{
+ if (show_stop)
+ set_stock_button_label(find_cancel_button, I_STOP);
+ else set_stock_button_label(find_cancel_button, I_GO_AWAY);
+}
-void set_find_dialog_label(const char *str)
+void find_dialog_set_label(const char *str)
{
if (edit_find_label)
set_label(edit_find_label, str);
@@ -140,43 +101,48 @@ static void edit_find_previous(GtkWidget *w, gpointer context)
}
-static void make_edit_find_dialog(bool managed)
+static void make_edit_find_dialog(bool managed, chan_info *cp)
{
if (!edit_find_dialog)
{
GtkWidget *dl, *rc;
GtkWidget *help_button;
edit_find_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(edit_find_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
SG_SIGNAL_CONNECT(edit_find_dialog, "delete_event", edit_find_delete, NULL);
- gtk_window_set_title(GTK_WINDOW(edit_find_dialog), "Find");
+ gtk_window_set_title(GTK_WINDOW(edit_find_dialog), I_FIND);
sg_make_resizable(edit_find_dialog);
gtk_container_set_border_width (GTK_CONTAINER(edit_find_dialog), 10);
gtk_window_resize(GTK_WINDOW(edit_find_dialog), 350, 120);
gtk_widget_realize(edit_find_dialog);
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
-
- cancelB = sg_button_new_from_stock_with_label("Go Away", GTK_STOCK_QUIT);
- gtk_widget_set_name(cancelB, "dialog_button");
+ find_next_button = gtk_dialog_add_button(GTK_DIALOG(edit_find_dialog), "Forward", GTK_RESPONSE_NONE);
+ find_previous_button = gtk_dialog_add_button(GTK_DIALOG(edit_find_dialog), "Back", GTK_RESPONSE_NONE);
+ find_cancel_button = gtk_dialog_add_button(GTK_DIALOG(edit_find_dialog), "Go Away", GTK_RESPONSE_NONE);
+ help_button = gtk_dialog_add_button(GTK_DIALOG(edit_find_dialog), "Help", GTK_RESPONSE_NONE);
- previous_button = gtk_button_new_from_stock(GTK_STOCK_GO_BACK);
- gtk_widget_set_name(previous_button, "dialog_button");
-
- next_button = gtk_button_new_from_stock(GTK_STOCK_GO_FORWARD);
- gtk_widget_set_name(next_button, "dialog_button");
+ gtk_widget_set_name(help_button, "dialog_button");
+ gtk_widget_set_name(find_cancel_button, "dialog_button");
+ gtk_widget_set_name(find_previous_button, "dialog_button");
+ gtk_widget_set_name(find_next_button, "dialog_button");
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(find_cancel_button);
+ add_highlight_button_style(help_button);
+ add_highlight_button_style(find_previous_button);
+ add_highlight_button_style(find_next_button);
+#endif
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(edit_find_dialog)), cancelB, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(edit_find_dialog)), next_button, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(edit_find_dialog)), previous_button, true, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(edit_find_dialog)), help_button, true, true, 10);
- SG_SIGNAL_CONNECT(cancelB, "clicked", edit_find_dismiss, NULL);
+ SG_SIGNAL_CONNECT(find_cancel_button, "clicked", edit_find_dismiss, NULL);
SG_SIGNAL_CONNECT(help_button, "clicked", edit_find_help, NULL);
- SG_SIGNAL_CONNECT(next_button, "clicked", edit_find_next, NULL);
- SG_SIGNAL_CONNECT(previous_button, "clicked", edit_find_previous, NULL);
- gtk_widget_show(cancelB);
- gtk_widget_show(next_button);
- gtk_widget_show(previous_button);
+ SG_SIGNAL_CONNECT(find_next_button, "clicked", edit_find_next, NULL);
+ SG_SIGNAL_CONNECT(find_previous_button, "clicked", edit_find_previous, NULL);
+
+ gtk_widget_show(find_cancel_button);
+ gtk_widget_show(find_next_button);
+ gtk_widget_show(find_previous_button);
gtk_widget_show(help_button);
@@ -184,11 +150,11 @@ static void make_edit_find_dialog(bool managed)
gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(edit_find_dialog)), rc, true, true, 4);
gtk_widget_show(rc);
- dl = gtk_label_new("find:");
+ dl = gtk_label_new(I_find);
gtk_box_pack_start(GTK_BOX(rc), dl, false, false, 4);
gtk_widget_show(dl);
- edit_find_text = snd_entry_new(rc, WITH_WHITE_BACKGROUND);
+ edit_find_text = snd_entry_new(rc, NULL, WITH_WHITE_BACKGROUND);
SG_SIGNAL_CONNECT(edit_find_text, "activate", edit_find_next, NULL);
edit_find_label = gtk_label_new("");
@@ -216,13 +182,26 @@ static void make_edit_find_dialog(bool managed)
void edit_find_callback(GtkWidget *w, gpointer context)
{
- make_edit_find_dialog(true);
+ make_edit_find_dialog(true, NULL);
+}
+
+
+void find_dialog(chan_info *cp)
+{
+ /* used in snd-kbd.c */
+ make_edit_find_dialog(true, cp);
+}
+
+
+bool find_dialog_is_active(void)
+{
+ return((edit_find_dialog) && (widget_is_active(edit_find_dialog)));
}
void save_find_dialog_state(FILE *fd)
{
- if ((edit_find_dialog) && (widget_is_active(edit_find_dialog)))
+ if (find_dialog_is_active())
{
char *text = NULL;
text = sg_get_text(edit_find_text, 0, -1);
@@ -238,12 +217,12 @@ void save_find_dialog_state(FILE *fd)
#endif
#if HAVE_RUBY
if (text)
- fprintf(fd, "%s(true, \"%s\")\n", TO_PROC_NAME(S_find_dialog), text);
+ fprintf(fd, "%s(true, \"%s\")\n", to_proc_name(S_find_dialog), text);
else
{
if (ss->search_expr)
- fprintf(fd, "%s(true, \"%s\")\n", TO_PROC_NAME(S_find_dialog), ss->search_expr);
- else fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_find_dialog));
+ fprintf(fd, "%s(true, \"%s\")\n", to_proc_name(S_find_dialog), ss->search_expr);
+ else fprintf(fd, "%s(true)\n", to_proc_name(S_find_dialog));
}
#endif
#if HAVE_FORTH
@@ -261,42 +240,40 @@ void save_find_dialog_state(FILE *fd)
}
-static XEN g_find_dialog(XEN managed, XEN text)
+static Xen g_find_dialog(Xen managed, Xen text)
{
#define H_find_dialog "(" S_find_dialog " :optional managed text): create and activate the Edit:Find dialog, return the dialog widget"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ARG_1, S_find_dialog, "a boolean");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(text), text, XEN_ARG_2, S_find_dialog, "a string");
- make_edit_find_dialog(XEN_TO_C_BOOLEAN(managed));
- if ((edit_find_text) && (XEN_STRING_P(text)))
+
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_find_dialog, "a boolean");
+ Xen_check_type(Xen_is_string_or_unbound(text), text, 2, S_find_dialog, "a string");
+
+ make_edit_find_dialog(Xen_boolean_to_C_bool(managed), NULL);
+ if ((edit_find_text) && (Xen_is_string(text)))
gtk_entry_get_text(GTK_ENTRY(edit_find_text));
- return(XEN_WRAP_WIDGET(edit_find_dialog));
+
+ return(Xen_wrap_widget(edit_find_dialog));
}
-static XEN g_find_dialog_widgets(void)
+static Xen g_find_dialog_widgets(void)
{
if (edit_find_dialog)
- return(XEN_CONS(XEN_WRAP_WIDGET(edit_find_dialog),
- XEN_CONS(XEN_WRAP_WIDGET(edit_find_text),
- XEN_CONS(XEN_WRAP_WIDGET(next_button),
- XEN_CONS(XEN_WRAP_WIDGET(previous_button),
- XEN_CONS(XEN_WRAP_WIDGET(cancelB),
- XEN_EMPTY_LIST))))));
- return(XEN_EMPTY_LIST);
+ return(Xen_cons(Xen_wrap_widget(edit_find_dialog),
+ Xen_cons(Xen_wrap_widget(edit_find_text),
+ Xen_cons(Xen_wrap_widget(find_next_button),
+ Xen_cons(Xen_wrap_widget(find_previous_button),
+ Xen_cons(Xen_wrap_widget(find_cancel_button),
+ Xen_empty_list))))));
+ return(Xen_empty_list);
}
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_2(g_find_dialog_w, g_find_dialog)
-XEN_NARGIFY_0(g_find_dialog_widgets_w, g_find_dialog_widgets)
-#else
-#define g_find_dialog_w g_find_dialog
-#define g_find_dialog_widgets_w g_find_dialog_widgets
-#endif
+Xen_wrap_2_optional_args(g_find_dialog_w, g_find_dialog)
+Xen_wrap_no_args(g_find_dialog_widgets_w, g_find_dialog_widgets)
void g_init_gxfind(void)
{
- XEN_DEFINE_PROCEDURE(S_find_dialog, g_find_dialog_w, 0, 2, 0, H_find_dialog);
- XEN_DEFINE_PROCEDURE("find-dialog-widgets", g_find_dialog_widgets_w, 0, 0, 0, "internal auto-test function");
+ Xen_define_procedure(S_find_dialog, g_find_dialog_w, 0, 2, 0, H_find_dialog);
+ Xen_define_procedure("find-dialog-widgets", g_find_dialog_widgets_w, 0, 0, 0, "internal auto-test function");
}
diff --git a/snd-ghelp.c b/snd-ghelp.c
index d59e1f0..ba1f0b3 100644
--- a/snd-ghelp.c
+++ b/snd-ghelp.c
@@ -2,11 +2,6 @@
/* ---------------- HELP MONOLOG ---------------- */
-/* I tried gtkhtml (and XmHTML in 1999), and in both cases decided not to use them. Both work fine,
- * but is it that much of a difference to have an html widget in a dialog as opposed to mozilla
- * running remotely? And it would require fixing up all the help texts.
- */
-
static GtkWidget *help_dialog = NULL;
static void dismiss_help_dialog(GtkWidget *w, gpointer context)
@@ -31,8 +26,6 @@ slist *related_items = NULL;
static char *original_help_text = NULL;
static const char **help_urls = NULL;
-/* gtk_text_buffer_insert_with_tags_by_name (buffer, &iter, "some text in red", -1, "red_foreground", NULL); */
-
static void add_help_text(GtkWidget *text, const char *message)
{
sg_text_insert(text, (char *)message);
@@ -90,14 +83,14 @@ static bool new_help(const char *pattern, bool complain)
if (url)
{
/* given name, find doc string, if any */
- XEN xstr;
- xstr = g_snd_help(C_TO_XEN_STRING(pattern), 0);
- if (XEN_STRING_P(xstr))
+ Xen xstr;
+ xstr = g_snd_help(C_string_to_Xen_string(pattern), 0);
+ if (Xen_is_string(xstr))
{
int gc_loc;
gc_loc = snd_protect(xstr);
xrefs = help_name_to_xrefs(pattern);
- snd_help_with_xrefs(pattern, XEN_TO_C_STRING(xstr), WITH_WORD_WRAP, xrefs, NULL);
+ snd_help_with_xrefs(pattern, Xen_string_to_C_string(xstr), WITH_WORD_WRAP, xrefs, NULL);
snd_unprotect_at(gc_loc);
if (xrefs) free(xrefs);
return(true);
@@ -120,64 +113,6 @@ static bool new_help(const char *pattern, bool complain)
}
-static char **help_history = NULL;
-static int help_history_size = 0;
-static int help_history_pos = 0;
-static bool help_needed = true;
-
-static void add_pattern_to_help_history(const char *pattern)
-{
- if (!help_needed) return;
- if (help_history_size == 0)
- {
- help_history_size = 16; /* not 8! -- need room for cycle below */
- help_history = (char **)calloc(help_history_size, sizeof(char *));
- }
- else
- {
- if (help_history_pos >= help_history_size)
- {
- int i;
- for (i = 0; i < 8; i++)
- {
- if (help_history[i]) free(help_history[i]);
- help_history[i] = help_history[i + 8];
- help_history[i + 8] = NULL;
- }
- help_history_pos = 8;
- }
- }
- if (help_history[help_history_pos]) free(help_history[help_history_pos]);
- help_history[help_history_pos++] = mus_strdup(pattern);
-}
-
-
-static void help_next_callback(GtkWidget *w, gpointer context)
-{
- if ((help_history_pos < help_history_size) &&
- (help_history[help_history_pos]))
- {
- help_needed = false;
- help_history_pos++;
- new_help(help_history[help_history_pos - 1], true);
- help_needed = true;
- }
-}
-
-
-static void help_previous_callback(GtkWidget *w, gpointer context)
-{
- if ((help_history_pos > 1) &&
- (help_history[help_history_pos - 2]))
- {
- help_needed = false;
- help_history_pos--;
- new_help(help_history[help_history_pos - 1], true);
- help_needed = true;
- }
-}
-
-
static char *find_highlighted_text(const char *value)
{
int i, len, start = -1;
@@ -208,11 +143,11 @@ static char *find_highlighted_text(const char *value)
static void help_browse_callback(const char *name, int row, void *data)
{
- char *topic = NULL;
if ((help_urls) && (help_urls[row]))
url_to_html_viewer(help_urls[row]);
else
{
+ char *topic = NULL;
topic = find_highlighted_text(name);
if (topic)
{
@@ -245,7 +180,7 @@ static gboolean text_release_callback(GtkTreeSelection *selection, gpointer *gp)
bool one_word = true;
len = mus_strlen(txt);
for (i = 0; i < len; i++)
- if (isspace(txt[i]))
+ if (isspace((int)txt[i]))
{
one_word = false;
break;
@@ -268,45 +203,35 @@ static void search_activated(GtkWidget *w, gpointer context)
}
-static GtkWidget *help_next_button = NULL, *help_previous_button = NULL;
-
static void create_help_monolog(void)
{
/* create scrollable but not editable text window */
- GtkWidget *ok_button, *search, *frame, *label, *hbox;
+ GtkWidget *ok_button, *search, *frame;
help_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(help_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
SG_SIGNAL_CONNECT(help_dialog, "delete_event", delete_help_dialog, NULL);
- gtk_window_set_title(GTK_WINDOW(help_dialog), "Help");
+ gtk_window_set_title(GTK_WINDOW(help_dialog), I_HELP);
sg_make_resizable(help_dialog);
gtk_container_set_border_width (GTK_CONTAINER(help_dialog), 10);
gtk_window_resize(GTK_WINDOW(help_dialog), HELP_COLUMNS * 9, HELP_ROWS * 40);
gtk_widget_realize(help_dialog);
- ok_button = gtk_button_new_from_stock(GTK_STOCK_QUIT);
+ ok_button = gtk_dialog_add_button(GTK_DIALOG(help_dialog), "Go Away", GTK_RESPONSE_NONE);
gtk_widget_set_name(ok_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(help_dialog)), ok_button, false, true, 20);
SG_SIGNAL_CONNECT(ok_button, "clicked", dismiss_help_dialog, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(ok_button);
+#endif
gtk_widget_show(ok_button);
- set_stock_button_label(ok_button, "Go Away");
-
- help_previous_button = gtk_button_new_from_stock(GTK_STOCK_GO_BACK);
- gtk_widget_set_name(help_previous_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(help_dialog)), help_previous_button, true, true, 10);
- SG_SIGNAL_CONNECT(help_previous_button, "clicked", help_previous_callback, NULL);
- gtk_widget_show(help_previous_button);
-
- help_next_button = gtk_button_new_from_stock(GTK_STOCK_GO_FORWARD);
- gtk_widget_set_name(help_next_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(help_dialog)), help_next_button, true, true, 10);
- SG_SIGNAL_CONNECT(help_next_button, "clicked", help_next_callback, NULL);
- gtk_widget_show(help_next_button);
frame = gtk_frame_new(NULL);
gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(help_dialog)), frame, true, true, 10);
gtk_widget_show(frame);
- help_text = make_scrolled_text(frame, false, 0, false); /* last arg ignored */
+ help_text = make_scrolled_text(frame, false, CONTAINER_ADD, false); /* last arg ignored */
gtk_widget_add_events(help_text, GDK_BUTTON_RELEASE);
gtk_text_view_set_left_margin(GTK_TEXT_VIEW(help_text), 10);
SG_SIGNAL_CONNECT(help_text, "button_release_event", text_release_callback, NULL);
@@ -314,15 +239,37 @@ static void create_help_monolog(void)
related_items = slist_new_with_title("related topics", DIALOG_CONTENT_AREA(help_dialog), NULL, 0, BOX_PACK);
related_items->select_callback = help_browse_callback;
- hbox = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(help_dialog)), hbox, false, false, 10);
- gtk_widget_show(hbox);
-
- label = gtk_label_new("help topic:");
- gtk_box_pack_start(GTK_BOX(hbox), label, false, false, 0);
- gtk_widget_show(label);
+ {
+ GtkWidget *label, *hbox;
+#if (!HAVE_GTK_GRID_NEW)
+ hbox = gtk_hbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(help_dialog)), hbox, false, false, 10);
+ gtk_widget_show(hbox);
+
+ label = gtk_label_new("help topic:");
+ gtk_box_pack_start(GTK_BOX(hbox), label, false, false, 0);
+ gtk_widget_show(label);
+
+ search = snd_entry_new(hbox, NULL, WITH_WHITE_BACKGROUND);
+#else
+ GtkWidget *content_area;
+ content_area = gtk_dialog_get_content_area(GTK_DIALOG(help_dialog));
+
+ hbox = gtk_grid_new();
+ gtk_container_add(GTK_CONTAINER(content_area), hbox);
+ gtk_widget_show(hbox);
+
+ label = gtk_label_new("help topic:");
+ gtk_widget_set_halign(label, GTK_ALIGN_CENTER);
+ gtk_widget_set_hexpand(label, false);
+ g_object_set(label, "margin", 10, NULL);
+ gtk_grid_attach(GTK_GRID(hbox), label, 0, 0, 1, 1);
+ gtk_widget_show(label);
+
+ search = snd_entry_new(hbox, label, WITH_WHITE_BACKGROUND);
+#endif
+ }
- search = snd_entry_new(hbox, WITH_WHITE_BACKGROUND);
SG_SIGNAL_CONNECT(search, "activate", search_activated, NULL);
gtk_widget_show(help_dialog);
SG_SIGNAL_CONNECT((gpointer)help_dialog, DRAW_SIGNAL, help_expose_callback, NULL);
@@ -353,10 +300,7 @@ GtkWidget *snd_help(const char *subject, const char *helpstr, with_word_wrap_t w
}
else add_help_text(help_text, helpstr);
- if (help_needed) add_pattern_to_help_history(subject);
slist_clear(related_items); /* this can clobber "subject"! */
- gtk_widget_set_sensitive(help_next_button, (help_history_pos < help_history_size) && (help_history[help_history_pos]));
- gtk_widget_set_sensitive(help_previous_button, (help_history_pos > 1));
return(help_dialog);
}
@@ -378,7 +322,8 @@ GtkWidget *snd_help_with_xrefs(const char *subject, const char *helpstr, with_wo
void snd_help_append(const char *text)
{
- if (help_text) sg_text_insert(help_text, text);
+ if (help_text)
+ sg_text_insert(help_text, text);
}
diff --git a/snd-gl.scm b/snd-gl.scm
index f349475..61bd29b 100644
--- a/snd-gl.scm
+++ b/snd-gl.scm
@@ -2,184 +2,70 @@
(provide 'snd-snd-gl.scm)
+(with-let *gl*
+
;;; ---------------- gl-info ----------------
-(define (gl-info)
+(define gl-info
;; taken loosely from glxvisuals.c
- "(gl-info) prints out GL-related info"
- (define (class-of n)
- (and (number? n)
- (cond ((= n StaticGray) "static-gray")
- ((= n GrayScale) "gray-scale")
- ((= n StaticColor) "static-color")
- ((= n PseudoColor) "pseudo-color")
- ((= n TrueColor) "true-color")
- ((= n DirectColor) "direct-color")
- (#t "??"))))
- (let* ((cx (snd-glx-context))
- (dpy (XtDisplay (cadr (main-widgets))))
- (version (glXQueryVersion dpy 0 0)))
- (if (car version)
- (let* ((scr (DefaultScreen dpy))
- (visuals (XGetVisualInfo dpy 0 (list 'XVisualInfo 0))))
- (glXMakeCurrent dpy (XtWindow (cadr (main-widgets))) cx)
- (snd-print (format #f "GL version: ~A.~A, (~A ~A ~A)~%"
- (cadr version) (caddr version)
- (glGetString GL_VENDOR) (glGetString GL_RENDERER) (glGetString GL_VERSION)))
- (snd-print (format #f " with: ~A~A~%"
- (glXQueryExtensionsString dpy (XScreenNumberOfScreen (DefaultScreenOfDisplay dpy)))
- (if (glXIsDirect dpy cx) ", direct rendering support" "")))
- (for-each
- (lambda (visual)
- (if (= (cadr (glXGetConfig dpy visual GLX_USE_GL)) 1)
- ;; found a visual that can support GL
- (let ((buffersize (cadr (glXGetConfig dpy visual GLX_BUFFER_SIZE)))
- (level (cadr (glXGetConfig dpy visual GLX_LEVEL)))
- (rgba (cadr (glXGetConfig dpy visual GLX_RGBA)))
- (doublebuffer (cadr (glXGetConfig dpy visual GLX_DOUBLEBUFFER)))
- (stereo (cadr (glXGetConfig dpy visual GLX_STEREO)))
- (auxbuffers (cadr (glXGetConfig dpy visual GLX_AUX_BUFFERS)))
- (redsize (cadr (glXGetConfig dpy visual GLX_RED_SIZE)))
- (bluesize (cadr (glXGetConfig dpy visual GLX_BLUE_SIZE)))
- (greensize (cadr (glXGetConfig dpy visual GLX_GREEN_SIZE)))
- (alphasize (cadr (glXGetConfig dpy visual GLX_ALPHA_SIZE)))
- (depthsize (cadr (glXGetConfig dpy visual GLX_DEPTH_SIZE)))
- (stencilsize (cadr (glXGetConfig dpy visual GLX_STENCIL_SIZE)))
- (acredsize (cadr (glXGetConfig dpy visual GLX_ACCUM_RED_SIZE)))
- (acgreensize (cadr (glXGetConfig dpy visual GLX_ACCUM_GREEN_SIZE)))
- (acbluesize (cadr (glXGetConfig dpy visual GLX_ACCUM_BLUE_SIZE)))
- (acalphasize (cadr (glXGetConfig dpy visual GLX_ACCUM_ALPHA_SIZE))))
- (snd-print (format #f " id: #x~X depth: ~D class: ~S~%" (.visualid visual) (.depth visual) (class-of (.class visual))))
- (snd-print (format #f " buffersize: ~D, level: ~D, rgba: ~A, doublebuffer: ~A, stereo: ~A~%"
- buffersize level
- (if (= rgba 1) "#t" "#f")
- (if (= doublebuffer 1) "#t" "#f")
- (if (= stereo 1) "#t" "#f")))
- (snd-print (format #f " r: ~A, g: ~D, b: ~D, alpha: ~D, accum-r: ~D, accum-g: ~D, accum-b: ~D, accum-alpha: ~D~%"
- redsize greensize bluesize alphasize
- acredsize acgreensize acbluesize acalphasize))
- (snd-print (format #f " auxbuffs: ~D, depth: ~D, acalpha: ~D~%"
- auxbuffers depthsize stencilsize))
-
-
- )))
- visuals))
- (snd-print "no GL found!"))))
-
-
-;;; ---------------- waterfall spectrum ----------------
-(define waterfall
- (let* ((drawer #f)
- (input-port #f)
- (input-proc 0)
- (gl-list #f)
- (slices 256) ; number of traces displayed
- (slice 0)
- (data (make-vector slices))
- (bins 512) ; fft size
- (input-data #f)
- (scaler 1.0) ; data scaler before GL turns it into colors
- (cutoff 0.2)) ; 0.5 is full spectrum
-
- (define (redraw-graph)
- (let* ((win (XtWindow drawer))
- (dpy (XtDisplay drawer))
- (cx (snd-glx-context)))
- (glXMakeCurrent dpy win cx)
- (if gl-list (glDeleteLists gl-list 1))
- (set! gl-list (glGenLists 1))
- (glEnable GL_DEPTH_TEST)
- (glShadeModel GL_SMOOTH)
- (glClearDepth 1.0)
- (glClearColor 1.0 1.0 1.0 1.0) ; todo: bg color here
- (glClear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
- ;;gl_spectrogram(XEN data, XEN gl_list, XEN cutoff, XEN use_dB, XEN min_dB, XEN scale, XEN br, XEN bg, XEN bb)
- (glSpectrogram data gl-list cutoff #f -60.0 scaler 65535 65535 65535)
- (let ((vals (XtVaGetValues drawer (list XmNwidth 0 XmNheight 0))))
- (glViewport 0 0 (list-ref vals 1) (list-ref vals 3)))
- (glMatrixMode GL_PROJECTION)
- (glLoadIdentity)
- (glRotatef (spectro-x-angle) 1.0 0.0 0.0)
- (glRotatef (spectro-y-angle) 0.0 1.0 0.0)
- (glRotatef (spectro-z-angle) 0.0 0.0 1.0)
- (glScalef (spectro-x-scale) (spectro-y-scale) (spectro-z-scale))
- (glCallList gl-list)
- ;; todo: make axis
- (glXSwapBuffers dpy win)
- (glDrawBuffer GL_BACK)))
-
- (define (tick-audio id)
- ;; background process reads incoming audio data, creates spectrum, displays next trace
- (mus-audio-read input-port input-data (* bins 2))
- (let ((rl-data (sound-data->vct input-data 0 (data slice))))
- (snd-spectrum rl-data blackman2-window bins #t 0.0 #t #f)
- (redraw-graph))
- (set! slice (+ 1 slice))
- (if (>= slice slices)
- (set! slice 0))
- #f)
-
- (define (stop-it)
- ;; turn off the waterfall display
- (if input-port
- (begin
- (mus-audio-close input-port)
- (set! input-port #f)))
- (if (XtWorkProcId? input-proc)
- (begin
- (XtRemoveWorkProc input-proc)
- (set! input-proc 0)))
- (do ((i 0 (+ 1 i)))
- ((= i slices))
- (vct-scale! (data i) 0.0)))
-
- (define (start-it)
- (define (add-main-pane name type args)
- (XtCreateManagedWidget name type (list-ref (main-widgets) 3) args))
- (if (not drawer)
- (let* ((outer (add-main-pane "Waterfall" xmFormWidgetClass
- (list XmNbackground (basic-color)
- XmNpaneMinimum 320))))
- (set! drawer (XtCreateManagedWidget "draw" xmDrawingAreaWidgetClass outer
- (list XmNbackground (graph-color)
- XmNforeground (data-color)
- XmNleftAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM)))
- (XtAddCallback drawer XmNresizeCallback (lambda (w context info) (redraw-graph)))
- (XtAddCallback drawer XmNexposeCallback (lambda (w context info) (redraw-graph)))
- (hook-push orientation-hook (lambda () (redraw-graph)))
- (hook-push color-hook (lambda () (redraw-graph)))))
- ;; start the waterfall display
- (if (not (or input-port (XtWorkProcId? input-proc)))
- (begin
- (set! input-port (mus-audio-open-input mus-audio-default 22050 1 mus-lshort 512))
- (set! input-proc (XtAppAddWorkProc (car (main-widgets)) tick-audio)))))
-
- ;; turn display with orientation dialog
- ;; for example: x-angle 290, y angle: 60
-
- (lambda* (start scl pc-spectrum fft-size)
- (if start
- (begin
- (set! cutoff pc-spectrum)
- (set! scaler scl)
- (set! bins fft-size)
- (set! input-data (make-sound-data 1 (* bins 2)))
- (do ((i 0 (+ 1 i)))
- ((= i slices))
- (set! (data i) (make-vct bins)))
- (start-it))
- (stop-it)))))
-
-
-(define* (start-waterfall (scl 1.0) (pc-spectrum 0.2) (fft-size 512))
- "(start-waterfall (scl 1.0) (pc-spectrum 0.2) (fft-size 512)) starts a 'waterfall' spectrum display of the incoming audio data"
- (waterfall #t scl pc-spectrum fft-size))
-
-(define (stop-waterfall)
- "(stop-waterfall) stops a waterfall display"
- (waterfall #f))
+ (let ((documentation "(gl-info) prints out GL-related info"))
+ (lambda ()
+ (define (class-of n)
+ (and (number? n)
+ (cond ((= n (*motif* 'StaticGray)) "static-gray")
+ ((= n (*motif* 'GrayScale)) "gray-scale")
+ ((= n (*motif* 'StaticColor)) "static-color")
+ ((= n (*motif* 'PseudoColor)) "pseudo-color")
+ ((= n (*motif* 'TrueColor)) "true-color")
+ ((= n (*motif* 'DirectColor)) "direct-color")
+ (#t "??"))))
+ (let* ((cx (snd-gl-context))
+ (dpy ((*motif* 'XtDisplay) (cadr (main-widgets))))
+ (version (glXQueryVersion dpy 0 0)))
+ (if (car version)
+ (let ((visuals ((*motif* 'XGetVisualInfo) dpy 0 (list 'XVisualInfo 0))))
+ (glXMakeCurrent dpy ((*motif* 'XtWindow) (cadr (main-widgets))) cx)
+ (snd-print (format #f "GL version: ~A.~A, (~A ~A ~A)~%"
+ (cadr version) (caddr version)
+ (glGetString GL_VENDOR) (glGetString GL_RENDERER) (glGetString GL_VERSION)))
+ (snd-print (format #f " with: ~A~A~%"
+ (glXQueryExtensionsString dpy ((*motif* 'XScreenNumberOfScreen) ((*motif* 'DefaultScreenOfDisplay) dpy)))
+ (if (glXIsDirect dpy cx) ", direct rendering support" "")))
+ (for-each
+ (lambda (visual)
+ (if (= (cadr (glXGetConfig dpy visual GLX_USE_GL)) 1)
+ ;; found a visual that can support GL
+ (let ((buffersize (cadr (glXGetConfig dpy visual GLX_BUFFER_SIZE)))
+ (level (cadr (glXGetConfig dpy visual GLX_LEVEL)))
+ (rgba (cadr (glXGetConfig dpy visual GLX_RGBA)))
+ (doublebuffer (cadr (glXGetConfig dpy visual GLX_DOUBLEBUFFER)))
+ (stereo (cadr (glXGetConfig dpy visual GLX_STEREO)))
+ (auxbuffers (cadr (glXGetConfig dpy visual GLX_AUX_BUFFERS)))
+ (redsize (cadr (glXGetConfig dpy visual GLX_RED_SIZE)))
+ (bluesize (cadr (glXGetConfig dpy visual GLX_BLUE_SIZE)))
+ (greensize (cadr (glXGetConfig dpy visual GLX_GREEN_SIZE)))
+ (alphasize (cadr (glXGetConfig dpy visual GLX_ALPHA_SIZE)))
+ (depthsize (cadr (glXGetConfig dpy visual GLX_DEPTH_SIZE)))
+ (stencilsize (cadr (glXGetConfig dpy visual GLX_STENCIL_SIZE)))
+ (acredsize (cadr (glXGetConfig dpy visual GLX_ACCUM_RED_SIZE)))
+ (acgreensize (cadr (glXGetConfig dpy visual GLX_ACCUM_GREEN_SIZE)))
+ (acbluesize (cadr (glXGetConfig dpy visual GLX_ACCUM_BLUE_SIZE)))
+ (acalphasize (cadr (glXGetConfig dpy visual GLX_ACCUM_ALPHA_SIZE))))
+ (snd-print (format #f " id: #x~X depth: ~D class: ~S~%" ((*motif* '.visualid) visual) ((*motif* '.depth) visual) (class-of ((*motif* '.class) visual))))
+ (snd-print (format #f " buffersize: ~D, level: ~D, rgba: ~A, doublebuffer: ~A, stereo: ~A~%"
+ buffersize level
+ (if (= rgba 1) "#t" "#f")
+ (if (= doublebuffer 1) "#t" "#f")
+ (if (= stereo 1) "#t" "#f")))
+ (snd-print (format #f " r: ~A, g: ~D, b: ~D, alpha: ~D, accum-r: ~D, accum-g: ~D, accum-b: ~D, accum-alpha: ~D~%"
+ redsize greensize bluesize alphasize
+ acredsize acgreensize acbluesize acalphasize))
+ (snd-print (format #f " auxbuffs: ~D, depth: ~D, acalpha: ~D~%"
+ auxbuffers depthsize stencilsize))
+
+
+ )))
+ visuals))
+ (snd-print "no GL found!"))))))
;;; -------- dump GL state
@@ -187,84 +73,84 @@
(define (gl-dump-state)
;; based on Mesa/util/dumpstate.c by Stephane Rehel
- (display (format #f "GL_CURRENT_COLOR: ~A~%" (glGetFloatv GL_CURRENT_COLOR)))
- (display (format #f "GL_CURRENT_INDEX: ~A~%" (glGetIntegerv GL_CURRENT_INDEX)))
- (display (format #f "GL_CURRENT_TEXTURE_COORDS: ~A~%" (glGetFloatv GL_CURRENT_TEXTURE_COORDS)))
- (display (format #f "GL_CURRENT_NORMAL: ~A~%" (glGetFloatv GL_CURRENT_NORMAL)))
- (display (format #f "GL_CURRENT_RASTER_POSITION: ~A~%" (glGetFloatv GL_CURRENT_RASTER_POSITION)))
- (display (format #f "GL_CURRENT_RASTER_DISTANCE: ~A~%" (glGetFloatv GL_CURRENT_RASTER_DISTANCE)))
- (display (format #f "GL_CURRENT_RASTER_COLOR: ~A~%" (glGetFloatv GL_CURRENT_RASTER_COLOR)))
- (display (format #f "GL_CURRENT_RASTER_INDEX: ~A~%" (glGetIntegerv GL_CURRENT_RASTER_INDEX)))
- (display (format #f "GL_CURRENT_RASTER_TEXTURE_COORDS: ~A~%" (glGetFloatv GL_CURRENT_RASTER_TEXTURE_COORDS)))
- (display (format #f "GL_CURRENT_RASTER_POSITION_VALID: ~A~%" (glGetBooleanv GL_CURRENT_RASTER_POSITION_VALID)))
- (display (format #f "GL_EDGE_FLAG: ~A~%" (glGetBooleanv GL_EDGE_FLAG)))
- (display (format #f "GL_VERTEX_ARRAY: ~A~%" (glGetBooleanv GL_VERTEX_ARRAY)))
- (display (format #f "GL_VERTEX_ARRAY_SIZE: ~A~%" (glGetIntegerv GL_VERTEX_ARRAY_SIZE)))
- (display (format #f "GL_VERTEX_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_VERTEX_ARRAY_TYPE)))
- (display (format #f "GL_VERTEX_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_VERTEX_ARRAY_STRIDE)))
- (display (format #f "GL_VERTEX_ARRAY_POINTER: ~A~%" (glGetPointerv GL_VERTEX_ARRAY_POINTER)))
- (display (format #f "GL_NORMAL_ARRAY: ~A~%" (glGetBooleanv GL_NORMAL_ARRAY)))
- (display (format #f "GL_NORMAL_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_NORMAL_ARRAY_TYPE)))
- (display (format #f "GL_NORMAL_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_NORMAL_ARRAY_STRIDE)))
- (display (format #f "GL_NORMAL_ARRAY_POINTER: ~A~%" (glGetPointerv GL_NORMAL_ARRAY_POINTER)))
- (display (format #f "GL_COLOR_ARRAY: ~A~%" (glGetBooleanv GL_COLOR_ARRAY)))
- (display (format #f "GL_COLOR_ARRAY_SIZE: ~A~%" (glGetIntegerv GL_COLOR_ARRAY_SIZE)))
- (display (format #f "GL_COLOR_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_COLOR_ARRAY_TYPE)))
- (display (format #f "GL_COLOR_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_COLOR_ARRAY_STRIDE)))
- (display (format #f "GL_COLOR_ARRAY_POINTER: ~A~%" (glGetPointerv GL_COLOR_ARRAY_POINTER)))
- (display (format #f "GL_INDEX_ARRAY: ~A~%" (glGetBooleanv GL_INDEX_ARRAY)))
- (display (format #f "GL_INDEX_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_INDEX_ARRAY_TYPE)))
- (display (format #f "GL_INDEX_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_INDEX_ARRAY_STRIDE)))
- (display (format #f "GL_INDEX_ARRAY_POINTER: ~A~%" (glGetPointerv GL_INDEX_ARRAY_POINTER)))
- (display (format #f "GL_TEXTURE_COORD_ARRAY: ~A~%" (glGetBooleanv GL_TEXTURE_COORD_ARRAY)))
- (display (format #f "GL_TEXTURE_COORD_ARRAY_SIZE: ~A~%" (glGetIntegerv GL_TEXTURE_COORD_ARRAY_SIZE)))
- (display (format #f "GL_TEXTURE_COORD_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_TEXTURE_COORD_ARRAY_TYPE)))
- (display (format #f "GL_TEXTURE_COORD_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_TEXTURE_COORD_ARRAY_STRIDE)))
- (display (format #f "GL_TEXTURE_COORD_ARRAY_POINTER: ~A~%" (glGetPointerv GL_TEXTURE_COORD_ARRAY_POINTER)))
- (display (format #f "GL_EDGE_FLAG_ARRAY: ~A~%" (glGetBooleanv GL_EDGE_FLAG_ARRAY)))
- (display (format #f "GL_EDGE_FLAG_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_EDGE_FLAG_ARRAY_STRIDE)))
- (display (format #f "GL_EDGE_FLAG_ARRAY_POINTER: ~A~%" (glGetPointerv GL_EDGE_FLAG_ARRAY_POINTER)))
- (display (format #f "GL_MODELVIEW_MATRIX: ~A~%" (glGetFloatv GL_MODELVIEW_MATRIX)))
- (display (format #f "GL_PROJECTION_MATRIX: ~A~%" (glGetFloatv GL_PROJECTION_MATRIX)))
- (display (format #f "GL_TEXTURE_MATRIX: ~A~%" (glGetFloatv GL_TEXTURE_MATRIX)))
- (display (format #f "GL_VIEWPORT: ~A~%" (glGetIntegerv GL_VIEWPORT)))
- (display (format #f "GL_DEPTH_RANGE: ~A~%" (glGetFloatv GL_DEPTH_RANGE)))
- (display (format #f "GL_MODELVIEW_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MODELVIEW_STACK_DEPTH)))
- (display (format #f "GL_PROJECTION_STACK_DEPTH: ~A~%" (glGetIntegerv GL_PROJECTION_STACK_DEPTH)))
- (display (format #f "GL_TEXTURE_STACK_DEPTH: ~A~%" (glGetIntegerv GL_TEXTURE_STACK_DEPTH)))
- (display (format #f "GL_MATRIX_MODE: ~A~%" (glGetIntegerv GL_MATRIX_MODE)))
- (display (format #f "GL_NORMALIZE: ~A~%" (glGetBooleanv GL_NORMALIZE)))
- (display (format #f "GL_CLIP_PLANE0: ~A~%" (glGetBooleanv GL_CLIP_PLANE0)))
- (display (format #f "GL_CLIP_PLANE1: ~A~%" (glGetBooleanv GL_CLIP_PLANE1)))
- (display (format #f "GL_CLIP_PLANE2: ~A~%" (glGetBooleanv GL_CLIP_PLANE2)))
- (display (format #f "GL_CLIP_PLANE3: ~A~%" (glGetBooleanv GL_CLIP_PLANE3)))
- (display (format #f "GL_CLIP_PLANE4: ~A~%" (glGetBooleanv GL_CLIP_PLANE4)))
- (display (format #f "GL_CLIP_PLANE5: ~A~%" (glGetBooleanv GL_CLIP_PLANE5)))
- (display (format #f "GL_FOG_COLOR: ~A~%" (glGetFloatv GL_FOG_COLOR)))
- (display (format #f "GL_FOG_INDEX: ~A~%" (glGetIntegerv GL_FOG_INDEX)))
- (display (format #f "GL_FOG_DENSITY: ~A~%" (glGetFloatv GL_FOG_DENSITY)))
- (display (format #f "GL_FOG_START: ~A~%" (glGetFloatv GL_FOG_START)))
- (display (format #f "GL_FOG_END: ~A~%" (glGetFloatv GL_FOG_END)))
- (display (format #f "GL_FOG_MODE: ~A~%" (glGetIntegerv GL_FOG_MODE)))
- (display (format #f "GL_FOG: ~A~%" (glGetBooleanv GL_FOG)))
- (display (format #f "GL_SHADE_MODEL: ~A~%" (glGetIntegerv GL_SHADE_MODEL)))
- (display (format #f "GL_LIGHTING: ~A~%" (glGetBooleanv GL_LIGHTING)))
- (display (format #f "GL_COLOR_MATERIAL: ~A~%" (glGetBooleanv GL_COLOR_MATERIAL)))
- (display (format #f "GL_COLOR_MATERIAL_PARAMETER: ~A~%" (glGetIntegerv GL_COLOR_MATERIAL_PARAMETER)))
- (display (format #f "GL_COLOR_MATERIAL_FACE: ~A~%" (glGetIntegerv GL_COLOR_MATERIAL_FACE)))
- (display (format #f "GL_BACK GL_AMBIENT: ~A~%" (glGetMaterialfv GL_BACK GL_AMBIENT)))
- (display (format #f "GL_FRONT GL_AMBIENT: ~A~%" (glGetMaterialfv GL_FRONT GL_AMBIENT)))
- (display (format #f "GL_BACK GL_DIFFUSE: ~A~%" (glGetMaterialfv GL_BACK GL_DIFFUSE)))
- (display (format #f "GL_FRONT GL_DIFFUSE: ~A~%" (glGetMaterialfv GL_FRONT GL_DIFFUSE)))
- (display (format #f "GL_BACK GL_SPECULAR: ~A~%" (glGetMaterialfv GL_BACK GL_SPECULAR)))
- (display (format #f "GL_FRONT GL_SPECULAR: ~A~%" (glGetMaterialfv GL_FRONT GL_SPECULAR)))
- (display (format #f "GL_BACK GL_EMISSION: ~A~%" (glGetMaterialfv GL_BACK GL_EMISSION)))
- (display (format #f "GL_FRONT GL_EMISSION: ~A~%" (glGetMaterialfv GL_FRONT GL_EMISSION)))
- (display (format #f "GL_BACK GL_SHININESS: ~A~%" (glGetMaterialfv GL_BACK GL_SHININESS)))
- (display (format #f "GL_FRONT GL_SHININESS: ~A~%" (glGetMaterialfv GL_FRONT GL_SHININESS)))
- (display (format #f "GL_LIGHT_MODEL_AMBIENT: ~A~%" (glGetFloatv GL_LIGHT_MODEL_AMBIENT)))
- (display (format #f "GL_LIGHT_MODEL_LOCAL_VIEWER: ~A~%" (glGetBooleanv GL_LIGHT_MODEL_LOCAL_VIEWER)))
- (display (format #f "GL_LIGHT_MODEL_TWO_SIDE: ~A~%" (glGetBooleanv GL_LIGHT_MODEL_TWO_SIDE)))
+ (format #t "GL_CURRENT_COLOR: ~A~%" (glGetFloatv GL_CURRENT_COLOR))
+ (format #t "GL_CURRENT_INDEX: ~A~%" (glGetIntegerv GL_CURRENT_INDEX))
+ (format #t "GL_CURRENT_TEXTURE_COORDS: ~A~%" (glGetFloatv GL_CURRENT_TEXTURE_COORDS))
+ (format #t "GL_CURRENT_NORMAL: ~A~%" (glGetFloatv GL_CURRENT_NORMAL))
+ (format #t "GL_CURRENT_RASTER_POSITION: ~A~%" (glGetFloatv GL_CURRENT_RASTER_POSITION))
+ (format #t "GL_CURRENT_RASTER_DISTANCE: ~A~%" (glGetFloatv GL_CURRENT_RASTER_DISTANCE))
+ (format #t "GL_CURRENT_RASTER_COLOR: ~A~%" (glGetFloatv GL_CURRENT_RASTER_COLOR))
+ (format #t "GL_CURRENT_RASTER_INDEX: ~A~%" (glGetIntegerv GL_CURRENT_RASTER_INDEX))
+ (format #t "GL_CURRENT_RASTER_TEXTURE_COORDS: ~A~%" (glGetFloatv GL_CURRENT_RASTER_TEXTURE_COORDS))
+ (format #t "GL_CURRENT_RASTER_POSITION_VALID: ~A~%" (glGetBooleanv GL_CURRENT_RASTER_POSITION_VALID))
+ (format #t "GL_EDGE_FLAG: ~A~%" (glGetBooleanv GL_EDGE_FLAG))
+ (format #t "GL_VERTEX_ARRAY: ~A~%" (glGetBooleanv GL_VERTEX_ARRAY))
+ (format #t "GL_VERTEX_ARRAY_SIZE: ~A~%" (glGetIntegerv GL_VERTEX_ARRAY_SIZE))
+ (format #t "GL_VERTEX_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_VERTEX_ARRAY_TYPE))
+ (format #t "GL_VERTEX_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_VERTEX_ARRAY_STRIDE))
+ (format #t "GL_VERTEX_ARRAY_POINTER: ~A~%" (glGetPointerv GL_VERTEX_ARRAY_POINTER))
+ (format #t "GL_NORMAL_ARRAY: ~A~%" (glGetBooleanv GL_NORMAL_ARRAY))
+ (format #t "GL_NORMAL_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_NORMAL_ARRAY_TYPE))
+ (format #t "GL_NORMAL_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_NORMAL_ARRAY_STRIDE))
+ (format #t "GL_NORMAL_ARRAY_POINTER: ~A~%" (glGetPointerv GL_NORMAL_ARRAY_POINTER))
+ (format #t "GL_COLOR_ARRAY: ~A~%" (glGetBooleanv GL_COLOR_ARRAY))
+ (format #t "GL_COLOR_ARRAY_SIZE: ~A~%" (glGetIntegerv GL_COLOR_ARRAY_SIZE))
+ (format #t "GL_COLOR_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_COLOR_ARRAY_TYPE))
+ (format #t "GL_COLOR_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_COLOR_ARRAY_STRIDE))
+ (format #t "GL_COLOR_ARRAY_POINTER: ~A~%" (glGetPointerv GL_COLOR_ARRAY_POINTER))
+ (format #t "GL_INDEX_ARRAY: ~A~%" (glGetBooleanv GL_INDEX_ARRAY))
+ (format #t "GL_INDEX_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_INDEX_ARRAY_TYPE))
+ (format #t "GL_INDEX_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_INDEX_ARRAY_STRIDE))
+ (format #t "GL_INDEX_ARRAY_POINTER: ~A~%" (glGetPointerv GL_INDEX_ARRAY_POINTER))
+ (format #t "GL_TEXTURE_COORD_ARRAY: ~A~%" (glGetBooleanv GL_TEXTURE_COORD_ARRAY))
+ (format #t "GL_TEXTURE_COORD_ARRAY_SIZE: ~A~%" (glGetIntegerv GL_TEXTURE_COORD_ARRAY_SIZE))
+ (format #t "GL_TEXTURE_COORD_ARRAY_TYPE: ~A~%" (glGetIntegerv GL_TEXTURE_COORD_ARRAY_TYPE))
+ (format #t "GL_TEXTURE_COORD_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_TEXTURE_COORD_ARRAY_STRIDE))
+ (format #t "GL_TEXTURE_COORD_ARRAY_POINTER: ~A~%" (glGetPointerv GL_TEXTURE_COORD_ARRAY_POINTER))
+ (format #t "GL_EDGE_FLAG_ARRAY: ~A~%" (glGetBooleanv GL_EDGE_FLAG_ARRAY))
+ (format #t "GL_EDGE_FLAG_ARRAY_STRIDE: ~A~%" (glGetIntegerv GL_EDGE_FLAG_ARRAY_STRIDE))
+ (format #t "GL_EDGE_FLAG_ARRAY_POINTER: ~A~%" (glGetPointerv GL_EDGE_FLAG_ARRAY_POINTER))
+ (format #t "GL_MODELVIEW_MATRIX: ~A~%" (glGetFloatv GL_MODELVIEW_MATRIX))
+ (format #t "GL_PROJECTION_MATRIX: ~A~%" (glGetFloatv GL_PROJECTION_MATRIX))
+ (format #t "GL_TEXTURE_MATRIX: ~A~%" (glGetFloatv GL_TEXTURE_MATRIX))
+ (format #t "GL_VIEWPORT: ~A~%" (glGetIntegerv GL_VIEWPORT))
+ (format #t "GL_DEPTH_RANGE: ~A~%" (glGetFloatv GL_DEPTH_RANGE))
+ (format #t "GL_MODELVIEW_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MODELVIEW_STACK_DEPTH))
+ (format #t "GL_PROJECTION_STACK_DEPTH: ~A~%" (glGetIntegerv GL_PROJECTION_STACK_DEPTH))
+ (format #t "GL_TEXTURE_STACK_DEPTH: ~A~%" (glGetIntegerv GL_TEXTURE_STACK_DEPTH))
+ (format #t "GL_MATRIX_MODE: ~A~%" (glGetIntegerv GL_MATRIX_MODE))
+ (format #t "GL_NORMALIZE: ~A~%" (glGetBooleanv GL_NORMALIZE))
+ (format #t "GL_CLIP_PLANE0: ~A~%" (glGetBooleanv GL_CLIP_PLANE0))
+ (format #t "GL_CLIP_PLANE1: ~A~%" (glGetBooleanv GL_CLIP_PLANE1))
+ (format #t "GL_CLIP_PLANE2: ~A~%" (glGetBooleanv GL_CLIP_PLANE2))
+ (format #t "GL_CLIP_PLANE3: ~A~%" (glGetBooleanv GL_CLIP_PLANE3))
+ (format #t "GL_CLIP_PLANE4: ~A~%" (glGetBooleanv GL_CLIP_PLANE4))
+ (format #t "GL_CLIP_PLANE5: ~A~%" (glGetBooleanv GL_CLIP_PLANE5))
+ (format #t "GL_FOG_COLOR: ~A~%" (glGetFloatv GL_FOG_COLOR))
+ (format #t "GL_FOG_INDEX: ~A~%" (glGetIntegerv GL_FOG_INDEX))
+ (format #t "GL_FOG_DENSITY: ~A~%" (glGetFloatv GL_FOG_DENSITY))
+ (format #t "GL_FOG_START: ~A~%" (glGetFloatv GL_FOG_START))
+ (format #t "GL_FOG_END: ~A~%" (glGetFloatv GL_FOG_END))
+ (format #t "GL_FOG_MODE: ~A~%" (glGetIntegerv GL_FOG_MODE))
+ (format #t "GL_FOG: ~A~%" (glGetBooleanv GL_FOG))
+ (format #t "GL_SHADE_MODEL: ~A~%" (glGetIntegerv GL_SHADE_MODEL))
+ (format #t "GL_LIGHTING: ~A~%" (glGetBooleanv GL_LIGHTING))
+ (format #t "GL_COLOR_MATERIAL: ~A~%" (glGetBooleanv GL_COLOR_MATERIAL))
+ (format #t "GL_COLOR_MATERIAL_PARAMETER: ~A~%" (glGetIntegerv GL_COLOR_MATERIAL_PARAMETER))
+ (format #t "GL_COLOR_MATERIAL_FACE: ~A~%" (glGetIntegerv GL_COLOR_MATERIAL_FACE))
+ (format #t "GL_BACK GL_AMBIENT: ~A~%" (glGetMaterialfv GL_BACK GL_AMBIENT))
+ (format #t "GL_FRONT GL_AMBIENT: ~A~%" (glGetMaterialfv GL_FRONT GL_AMBIENT))
+ (format #t "GL_BACK GL_DIFFUSE: ~A~%" (glGetMaterialfv GL_BACK GL_DIFFUSE))
+ (format #t "GL_FRONT GL_DIFFUSE: ~A~%" (glGetMaterialfv GL_FRONT GL_DIFFUSE))
+ (format #t "GL_BACK GL_SPECULAR: ~A~%" (glGetMaterialfv GL_BACK GL_SPECULAR))
+ (format #t "GL_FRONT GL_SPECULAR: ~A~%" (glGetMaterialfv GL_FRONT GL_SPECULAR))
+ (format #t "GL_BACK GL_EMISSION: ~A~%" (glGetMaterialfv GL_BACK GL_EMISSION))
+ (format #t "GL_FRONT GL_EMISSION: ~A~%" (glGetMaterialfv GL_FRONT GL_EMISSION))
+ (format #t "GL_BACK GL_SHININESS: ~A~%" (glGetMaterialfv GL_BACK GL_SHININESS))
+ (format #t "GL_FRONT GL_SHININESS: ~A~%" (glGetMaterialfv GL_FRONT GL_SHININESS))
+ (format #t "GL_LIGHT_MODEL_AMBIENT: ~A~%" (glGetFloatv GL_LIGHT_MODEL_AMBIENT))
+ (format #t "GL_LIGHT_MODEL_LOCAL_VIEWER: ~A~%" (glGetBooleanv GL_LIGHT_MODEL_LOCAL_VIEWER))
+ (format #t "GL_LIGHT_MODEL_TWO_SIDE: ~A~%" (glGetBooleanv GL_LIGHT_MODEL_TWO_SIDE))
(let ((nlights (car (glGetIntegerv GL_MAX_LIGHTS))))
(do ((i 0 (+ 1 i)))
@@ -284,154 +170,156 @@
(glGetLightfv i SPOT_CUTOFF)
))))
- (display (format #f "GL_POINT_SIZE: ~A~%" (glGetFloatv GL_POINT_SIZE)))
- (display (format #f "GL_POINT_SMOOTH: ~A~%" (glGetBooleanv GL_POINT_SMOOTH)))
- (display (format #f "GL_LINE_WIDTH: ~A~%" (glGetFloatv GL_LINE_WIDTH)))
- (display (format #f "GL_LINE_SMOOTH: ~A~%" (glGetBooleanv GL_LINE_SMOOTH)))
- (display (format #f "GL_LINE_STIPPLE_PATTERN: ~A~%" (glGetIntegerv GL_LINE_STIPPLE_PATTERN)))
- (display (format #f "GL_LINE_STIPPLE_REPEAT: ~A~%" (glGetIntegerv GL_LINE_STIPPLE_REPEAT)))
- (display (format #f "GL_LINE_STIPPLE: ~A~%" (glGetBooleanv GL_LINE_STIPPLE)))
- (display (format #f "GL_CULL_FACE: ~A~%" (glGetBooleanv GL_CULL_FACE)))
- (display (format #f "GL_CULL_FACE_MODE: ~A~%" (glGetIntegerv GL_CULL_FACE_MODE)))
- (display (format #f "GL_FRONT_FACE: ~A~%" (glGetIntegerv GL_FRONT_FACE)))
- (display (format #f "GL_POLYGON_SMOOTH: ~A~%" (glGetBooleanv GL_POLYGON_SMOOTH)))
- (display (format #f "GL_POLYGON_MODE: ~A~%" (glGetIntegerv GL_POLYGON_MODE)))
- (display (format #f "GL_POLYGON_OFFSET_FACTOR: ~A~%" (glGetFloatv GL_POLYGON_OFFSET_FACTOR)))
- (display (format #f "GL_POLYGON_OFFSET_UNITS: ~A~%" (glGetFloatv GL_POLYGON_OFFSET_UNITS)))
- (display (format #f "GL_POLYGON_OFFSET_POINT: ~A~%" (glGetBooleanv GL_POLYGON_OFFSET_POINT)))
- (display (format #f "GL_POLYGON_OFFSET_LINE: ~A~%" (glGetBooleanv GL_POLYGON_OFFSET_LINE)))
- (display (format #f "GL_POLYGON_OFFSET_FILL: ~A~%" (glGetBooleanv GL_POLYGON_OFFSET_FILL)))
- (display (format #f "GL_POLYGON_STIPPLE: ~A~%" (glGetBooleanv GL_POLYGON_STIPPLE)))
- (display (format #f "GL_TEXTURE_1D: ~A~%" (glGetBooleanv GL_TEXTURE_1D)))
- (display (format #f "GL_TEXTURE_2D: ~A~%" (glGetBooleanv GL_TEXTURE_2D)))
- (display (format #f "GL_TEXTURE_BINDING_1D: ~A~%" (glGetIntegerv GL_TEXTURE_BINDING_1D)))
- (display (format #f "GL_TEXTURE_BINDING_2D: ~A~%" (glGetIntegerv GL_TEXTURE_BINDING_2D)))
- (display (format #f "GL_TEXTURE_GEN_S: ~A~%" (glGetBooleanv GL_TEXTURE_GEN_S)))
- (display (format #f "GL_TEXTURE_GEN_T: ~A~%" (glGetBooleanv GL_TEXTURE_GEN_T)))
- (display (format #f "GL_TEXTURE_GEN_R: ~A~%" (glGetBooleanv GL_TEXTURE_GEN_R)))
- (display (format #f "GL_TEXTURE_GEN_Q: ~A~%" (glGetBooleanv GL_TEXTURE_GEN_Q)))
- (display (format #f "GL_SCISSOR_TEST: ~A~%" (glGetBooleanv GL_SCISSOR_TEST)))
- (display (format #f "GL_SCISSOR_BOX: ~A~%" (glGetIntegerv GL_SCISSOR_BOX)))
- (display (format #f "GL_ALPHA_TEST: ~A~%" (glGetBooleanv GL_ALPHA_TEST)))
- (display (format #f "GL_ALPHA_TEST_FUNC: ~A~%" (glGetIntegerv GL_ALPHA_TEST_FUNC)))
- (display (format #f "GL_ALPHA_TEST_REF: ~A~%" (glGetFloatv GL_ALPHA_TEST_REF)))
- (display (format #f "GL_STENCIL_TEST: ~A~%" (glGetBooleanv GL_STENCIL_TEST)))
- (display (format #f "GL_STENCIL_FUNC: ~A~%" (glGetIntegerv GL_STENCIL_FUNC)))
- (display (format #f "GL_STENCIL_VALUE_MASK: ~A~%" (glGetIntegerv GL_STENCIL_VALUE_MASK)))
- (display (format #f "GL_STENCIL_REF: ~A~%" (glGetIntegerv GL_STENCIL_REF)))
- (display (format #f "GL_STENCIL_FAIL: ~A~%" (glGetIntegerv GL_STENCIL_FAIL)))
- (display (format #f "GL_STENCIL_PASS_DEPTH_FAIL: ~A~%" (glGetIntegerv GL_STENCIL_PASS_DEPTH_FAIL)))
- (display (format #f "GL_STENCIL_PASS_DEPTH_PASS: ~A~%" (glGetIntegerv GL_STENCIL_PASS_DEPTH_PASS)))
- (display (format #f "GL_DEPTH_TEST: ~A~%" (glGetBooleanv GL_DEPTH_TEST)))
- (display (format #f "GL_DEPTH_FUNC: ~A~%" (glGetIntegerv GL_DEPTH_FUNC)))
- (display (format #f "GL_BLEND: ~A~%" (glGetBooleanv GL_BLEND)))
- (display (format #f "GL_BLEND_SRC: ~A~%" (glGetIntegerv GL_BLEND_SRC)))
- (display (format #f "GL_BLEND_DST: ~A~%" (glGetIntegerv GL_BLEND_DST)))
- (display (format #f "GL_DITHER: ~A~%" (glGetBooleanv GL_DITHER)))
- (display (format #f "GL_LOGIC_OP: ~A~%" (glGetBooleanv GL_LOGIC_OP)))
- (display (format #f "GL_COLOR_LOGIC_OP: ~A~%" (glGetBooleanv GL_COLOR_LOGIC_OP)))
- (display (format #f "GL_DRAW_BUFFER: ~A~%" (glGetIntegerv GL_DRAW_BUFFER)))
- (display (format #f "GL_INDEX_WRITEMASK: ~A~%" (glGetIntegerv GL_INDEX_WRITEMASK)))
- (display (format #f "GL_COLOR_WRITEMASK: ~A~%" (glGetBooleanv GL_COLOR_WRITEMASK)))
- (display (format #f "GL_DEPTH_WRITEMASK: ~A~%" (glGetBooleanv GL_DEPTH_WRITEMASK)))
- (display (format #f "GL_STENCIL_WRITEMASK: ~A~%" (glGetIntegerv GL_STENCIL_WRITEMASK)))
- (display (format #f "GL_COLOR_CLEAR_VALUE: ~A~%" (glGetFloatv GL_COLOR_CLEAR_VALUE)))
- (display (format #f "GL_INDEX_CLEAR_VALUE: ~A~%" (glGetIntegerv GL_INDEX_CLEAR_VALUE)))
- (display (format #f "GL_DEPTH_CLEAR_VALUE: ~A~%" (glGetFloatv GL_DEPTH_CLEAR_VALUE)))
- (display (format #f "GL_STENCIL_CLEAR_VALUE: ~A~%" (glGetIntegerv GL_STENCIL_CLEAR_VALUE)))
- (display (format #f "GL_ACCUM_CLEAR_VALUE: ~A~%" (glGetFloatv GL_ACCUM_CLEAR_VALUE)))
- (display (format #f "GL_UNPACK_SWAP_BYTES: ~A~%" (glGetBooleanv GL_UNPACK_SWAP_BYTES)))
- (display (format #f "GL_UNPACK_LSB_FIRST: ~A~%" (glGetBooleanv GL_UNPACK_LSB_FIRST)))
- (display (format #f "GL_UNPACK_ROW_LENGTH: ~A~%" (glGetIntegerv GL_UNPACK_ROW_LENGTH)))
- (display (format #f "GL_UNPACK_SKIP_ROWS: ~A~%" (glGetIntegerv GL_UNPACK_SKIP_ROWS)))
- (display (format #f "GL_UNPACK_SKIP_PIXELS: ~A~%" (glGetIntegerv GL_UNPACK_SKIP_PIXELS)))
- (display (format #f "GL_UNPACK_ALIGNMENT: ~A~%" (glGetIntegerv GL_UNPACK_ALIGNMENT)))
- (display (format #f "GL_PACK_SWAP_BYTES: ~A~%" (glGetBooleanv GL_PACK_SWAP_BYTES)))
- (display (format #f "GL_PACK_LSB_FIRST: ~A~%" (glGetBooleanv GL_PACK_LSB_FIRST)))
- (display (format #f "GL_PACK_ROW_LENGTH: ~A~%" (glGetIntegerv GL_PACK_ROW_LENGTH)))
- (display (format #f "GL_PACK_SKIP_ROWS: ~A~%" (glGetIntegerv GL_PACK_SKIP_ROWS)))
- (display (format #f "GL_PACK_SKIP_PIXELS: ~A~%" (glGetIntegerv GL_PACK_SKIP_PIXELS)))
- (display (format #f "GL_PACK_ALIGNMENT: ~A~%" (glGetIntegerv GL_PACK_ALIGNMENT)))
- (display (format #f "GL_MAP_COLOR: ~A~%" (glGetBooleanv GL_MAP_COLOR)))
- (display (format #f "GL_MAP_STENCIL: ~A~%" (glGetBooleanv GL_MAP_STENCIL)))
- (display (format #f "GL_INDEX_SHIFT: ~A~%" (glGetIntegerv GL_INDEX_SHIFT)))
- (display (format #f "GL_INDEX_OFFSET: ~A~%" (glGetIntegerv GL_INDEX_OFFSET)))
- (display (format #f "GL_RED_SCALE: ~A~%" (glGetFloatv GL_RED_SCALE)))
- (display (format #f "GL_GREEN_SCALE: ~A~%" (glGetFloatv GL_GREEN_SCALE)))
- (display (format #f "GL_BLUE_SCALE: ~A~%" (glGetFloatv GL_BLUE_SCALE)))
- (display (format #f "GL_ALPHA_SCALE: ~A~%" (glGetFloatv GL_ALPHA_SCALE)))
- (display (format #f "GL_DEPTH_SCALE: ~A~%" (glGetFloatv GL_DEPTH_SCALE)))
- (display (format #f "GL_RED_BIAS: ~A~%" (glGetFloatv GL_RED_BIAS)))
- (display (format #f "GL_GREEN_BIAS: ~A~%" (glGetFloatv GL_GREEN_BIAS)))
- (display (format #f "GL_BLUE_BIAS: ~A~%" (glGetFloatv GL_BLUE_BIAS)))
- (display (format #f "GL_ALPHA_BIAS: ~A~%" (glGetFloatv GL_ALPHA_BIAS)))
- (display (format #f "GL_DEPTH_BIAS: ~A~%" (glGetFloatv GL_DEPTH_BIAS)))
- (display (format #f "GL_ZOOM_X: ~A~%" (glGetFloatv GL_ZOOM_X)))
- (display (format #f "GL_ZOOM_Y: ~A~%" (glGetFloatv GL_ZOOM_Y)))
- (display (format #f "GL_READ_BUFFER: ~A~%" (glGetIntegerv GL_READ_BUFFER)))
- (display (format #f "GL_AUTO_NORMAL: ~A~%" (glGetBooleanv GL_AUTO_NORMAL)))
- (display (format #f "GL_PERSPECTIVE_CORRECTION_HINT: ~A~%" (glGetIntegerv GL_PERSPECTIVE_CORRECTION_HINT)))
- (display (format #f "GL_POINT_SMOOTH_HINT: ~A~%" (glGetIntegerv GL_POINT_SMOOTH_HINT)))
- (display (format #f "GL_LINE_SMOOTH_HINT: ~A~%" (glGetIntegerv GL_LINE_SMOOTH_HINT)))
- (display (format #f "GL_POLYGON_SMOOTH_HINT: ~A~%" (glGetIntegerv GL_POLYGON_SMOOTH_HINT)))
- (display (format #f "GL_FOG_HINT: ~A~%" (glGetIntegerv GL_FOG_HINT)))
- (display (format #f "GL_MAX_LIGHTS: ~A~%" (glGetIntegerv GL_MAX_LIGHTS)))
- (display (format #f "GL_MAX_CLIP_PLANES: ~A~%" (glGetIntegerv GL_MAX_CLIP_PLANES)))
- (display (format #f "GL_MAX_MODELVIEW_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_MODELVIEW_STACK_DEPTH)))
- (display (format #f "GL_MAX_PROJECTION_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_PROJECTION_STACK_DEPTH)))
- (display (format #f "GL_MAX_TEXTURE_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_TEXTURE_STACK_DEPTH)))
- (display (format #f "GL_SUBPIXEL_BITS: ~A~%" (glGetIntegerv GL_SUBPIXEL_BITS)))
- (display (format #f "GL_MAX_TEXTURE_SIZE: ~A~%" (glGetIntegerv GL_MAX_TEXTURE_SIZE)))
- (display (format #f "GL_MAX_PIXEL_MAP_TABLE: ~A~%" (glGetIntegerv GL_MAX_PIXEL_MAP_TABLE)))
- (display (format #f "GL_MAX_NAME_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_NAME_STACK_DEPTH)))
- (display (format #f "GL_MAX_LIST_NESTING: ~A~%" (glGetIntegerv GL_MAX_LIST_NESTING)))
- (display (format #f "GL_MAX_EVAL_ORDER: ~A~%" (glGetIntegerv GL_MAX_EVAL_ORDER)))
- (display (format #f "GL_MAX_VIEWPORT_DIMS: ~A~%" (glGetIntegerv GL_MAX_VIEWPORT_DIMS)))
- (display (format #f "GL_MAX_ATTRIB_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_ATTRIB_STACK_DEPTH)))
- (display (format #f "GL_MAX_CLIENT_ATTRIB_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_CLIENT_ATTRIB_STACK_DEPTH)))
- (display (format #f "GL_AUX_BUFFERS: ~A~%" (glGetIntegerv GL_AUX_BUFFERS)))
- (display (format #f "GL_RGBA_MODE: ~A~%" (glGetBooleanv GL_RGBA_MODE)))
- (display (format #f "GL_INDEX_MODE: ~A~%" (glGetBooleanv GL_INDEX_MODE)))
- (display (format #f "GL_DOUBLEBUFFER: ~A~%" (glGetBooleanv GL_DOUBLEBUFFER)))
- (display (format #f "GL_STEREO: ~A~%" (glGetBooleanv GL_STEREO)))
- (display (format #f "GL_LINE_WIDTH_RANGE: ~A~%" (glGetFloatv GL_LINE_WIDTH_RANGE)))
- (display (format #f "GL_LINE_WIDTH_GRANULARITY: ~A~%" (glGetFloatv GL_LINE_WIDTH_GRANULARITY)))
- (display (format #f "GL_RED_BITS: ~A~%" (glGetIntegerv GL_RED_BITS)))
- (display (format #f "GL_GREEN_BITS: ~A~%" (glGetIntegerv GL_GREEN_BITS)))
- (display (format #f "GL_BLUE_BITS: ~A~%" (glGetIntegerv GL_BLUE_BITS)))
- (display (format #f "GL_ALPHA_BITS: ~A~%" (glGetIntegerv GL_ALPHA_BITS)))
- (display (format #f "GL_INDEX_BITS: ~A~%" (glGetIntegerv GL_INDEX_BITS)))
- (display (format #f "GL_DEPTH_BITS: ~A~%" (glGetIntegerv GL_DEPTH_BITS)))
- (display (format #f "GL_STENCIL_BITS: ~A~%" (glGetIntegerv GL_STENCIL_BITS)))
- (display (format #f "GL_ACCUM_RED_BITS: ~A~%" (glGetIntegerv GL_ACCUM_RED_BITS)))
- (display (format #f "GL_ACCUM_GREEN_BITS: ~A~%" (glGetIntegerv GL_ACCUM_GREEN_BITS)))
- (display (format #f "GL_ACCUM_BLUE_BITS: ~A~%" (glGetIntegerv GL_ACCUM_BLUE_BITS)))
- (display (format #f "GL_ACCUM_ALPHA_BITS: ~A~%" (glGetIntegerv GL_ACCUM_ALPHA_BITS)))
- (display (format #f "GL_LIST_BASE: ~A~%" (glGetIntegerv GL_LIST_BASE)))
- (display (format #f "GL_LIST_INDEX: ~A~%" (glGetIntegerv GL_LIST_INDEX)))
- (display (format #f "GL_LIST_MODE: ~A~%" (glGetIntegerv GL_LIST_MODE)))
- (display (format #f "GL_ATTRIB_STACK_DEPTH: ~A~%" (glGetIntegerv GL_ATTRIB_STACK_DEPTH)))
- (display (format #f "GL_CLIENT_ATTRIB_STACK_DEPTH: ~A~%" (glGetIntegerv GL_CLIENT_ATTRIB_STACK_DEPTH)))
- (display (format #f "GL_NAME_STACK_DEPTH: ~A~%" (glGetIntegerv GL_NAME_STACK_DEPTH)))
- (display (format #f "GL_RENDER_MODE: ~A~%" (glGetIntegerv GL_RENDER_MODE)))
- (display (format #f "GL_SELECTION_BUFFER_POINTER: ~A~%" (glGetPointerv GL_SELECTION_BUFFER_POINTER)))
- (display (format #f "GL_SELECTION_BUFFER_SIZE: ~A~%" (glGetIntegerv GL_SELECTION_BUFFER_SIZE)))
- (display (format #f "GL_FEEDBACK_BUFFER_POINTER: ~A~%" (glGetPointerv GL_FEEDBACK_BUFFER_POINTER)))
- (display (format #f "GL_FEEDBACK_BUFFER_SIZE: ~A~%" (glGetIntegerv GL_FEEDBACK_BUFFER_SIZE)))
- (display (format #f "GL_FEEDBACK_BUFFER_TYPE: ~A~%" (glGetIntegerv GL_FEEDBACK_BUFFER_TYPE)))
+ (format #t "GL_POINT_SIZE: ~A~%" (glGetFloatv GL_POINT_SIZE))
+ (format #t "GL_POINT_SMOOTH: ~A~%" (glGetBooleanv GL_POINT_SMOOTH))
+ (format #t "GL_LINE_WIDTH: ~A~%" (glGetFloatv GL_LINE_WIDTH))
+ (format #t "GL_LINE_SMOOTH: ~A~%" (glGetBooleanv GL_LINE_SMOOTH))
+ (format #t "GL_LINE_STIPPLE_PATTERN: ~A~%" (glGetIntegerv GL_LINE_STIPPLE_PATTERN))
+ (format #t "GL_LINE_STIPPLE_REPEAT: ~A~%" (glGetIntegerv GL_LINE_STIPPLE_REPEAT))
+ (format #t "GL_LINE_STIPPLE: ~A~%" (glGetBooleanv GL_LINE_STIPPLE))
+ (format #t "GL_CULL_FACE: ~A~%" (glGetBooleanv GL_CULL_FACE))
+ (format #t "GL_CULL_FACE_MODE: ~A~%" (glGetIntegerv GL_CULL_FACE_MODE))
+ (format #t "GL_FRONT_FACE: ~A~%" (glGetIntegerv GL_FRONT_FACE))
+ (format #t "GL_POLYGON_SMOOTH: ~A~%" (glGetBooleanv GL_POLYGON_SMOOTH))
+ (format #t "GL_POLYGON_MODE: ~A~%" (glGetIntegerv GL_POLYGON_MODE))
+ (format #t "GL_POLYGON_OFFSET_FACTOR: ~A~%" (glGetFloatv GL_POLYGON_OFFSET_FACTOR))
+ (format #t "GL_POLYGON_OFFSET_UNITS: ~A~%" (glGetFloatv GL_POLYGON_OFFSET_UNITS))
+ (format #t "GL_POLYGON_OFFSET_POINT: ~A~%" (glGetBooleanv GL_POLYGON_OFFSET_POINT))
+ (format #t "GL_POLYGON_OFFSET_LINE: ~A~%" (glGetBooleanv GL_POLYGON_OFFSET_LINE))
+ (format #t "GL_POLYGON_OFFSET_FILL: ~A~%" (glGetBooleanv GL_POLYGON_OFFSET_FILL))
+ (format #t "GL_POLYGON_STIPPLE: ~A~%" (glGetBooleanv GL_POLYGON_STIPPLE))
+ (format #t "GL_TEXTURE_1D: ~A~%" (glGetBooleanv GL_TEXTURE_1D))
+ (format #t "GL_TEXTURE_2D: ~A~%" (glGetBooleanv GL_TEXTURE_2D))
+ (format #t "GL_TEXTURE_BINDING_1D: ~A~%" (glGetIntegerv GL_TEXTURE_BINDING_1D))
+ (format #t "GL_TEXTURE_BINDING_2D: ~A~%" (glGetIntegerv GL_TEXTURE_BINDING_2D))
+ (format #t "GL_TEXTURE_GEN_S: ~A~%" (glGetBooleanv GL_TEXTURE_GEN_S))
+ (format #t "GL_TEXTURE_GEN_T: ~A~%" (glGetBooleanv GL_TEXTURE_GEN_T))
+ (format #t "GL_TEXTURE_GEN_R: ~A~%" (glGetBooleanv GL_TEXTURE_GEN_R))
+ (format #t "GL_TEXTURE_GEN_Q: ~A~%" (glGetBooleanv GL_TEXTURE_GEN_Q))
+ (format #t "GL_SCISSOR_TEST: ~A~%" (glGetBooleanv GL_SCISSOR_TEST))
+ (format #t "GL_SCISSOR_BOX: ~A~%" (glGetIntegerv GL_SCISSOR_BOX))
+ (format #t "GL_ALPHA_TEST: ~A~%" (glGetBooleanv GL_ALPHA_TEST))
+ (format #t "GL_ALPHA_TEST_FUNC: ~A~%" (glGetIntegerv GL_ALPHA_TEST_FUNC))
+ (format #t "GL_ALPHA_TEST_REF: ~A~%" (glGetFloatv GL_ALPHA_TEST_REF))
+ (format #t "GL_STENCIL_TEST: ~A~%" (glGetBooleanv GL_STENCIL_TEST))
+ (format #t "GL_STENCIL_FUNC: ~A~%" (glGetIntegerv GL_STENCIL_FUNC))
+ (format #t "GL_STENCIL_VALUE_MASK: ~A~%" (glGetIntegerv GL_STENCIL_VALUE_MASK))
+ (format #t "GL_STENCIL_REF: ~A~%" (glGetIntegerv GL_STENCIL_REF))
+ (format #t "GL_STENCIL_FAIL: ~A~%" (glGetIntegerv GL_STENCIL_FAIL))
+ (format #t "GL_STENCIL_PASS_DEPTH_FAIL: ~A~%" (glGetIntegerv GL_STENCIL_PASS_DEPTH_FAIL))
+ (format #t "GL_STENCIL_PASS_DEPTH_PASS: ~A~%" (glGetIntegerv GL_STENCIL_PASS_DEPTH_PASS))
+ (format #t "GL_DEPTH_TEST: ~A~%" (glGetBooleanv GL_DEPTH_TEST))
+ (format #t "GL_DEPTH_FUNC: ~A~%" (glGetIntegerv GL_DEPTH_FUNC))
+ (format #t "GL_BLEND: ~A~%" (glGetBooleanv GL_BLEND))
+ (format #t "GL_BLEND_SRC: ~A~%" (glGetIntegerv GL_BLEND_SRC))
+ (format #t "GL_BLEND_DST: ~A~%" (glGetIntegerv GL_BLEND_DST))
+ (format #t "GL_DITHER: ~A~%" (glGetBooleanv GL_DITHER))
+ (format #t "GL_LOGIC_OP: ~A~%" (glGetBooleanv GL_LOGIC_OP))
+ (format #t "GL_COLOR_LOGIC_OP: ~A~%" (glGetBooleanv GL_COLOR_LOGIC_OP))
+ (format #t "GL_DRAW_BUFFER: ~A~%" (glGetIntegerv GL_DRAW_BUFFER))
+ (format #t "GL_INDEX_WRITEMASK: ~A~%" (glGetIntegerv GL_INDEX_WRITEMASK))
+ (format #t "GL_COLOR_WRITEMASK: ~A~%" (glGetBooleanv GL_COLOR_WRITEMASK))
+ (format #t "GL_DEPTH_WRITEMASK: ~A~%" (glGetBooleanv GL_DEPTH_WRITEMASK))
+ (format #t "GL_STENCIL_WRITEMASK: ~A~%" (glGetIntegerv GL_STENCIL_WRITEMASK))
+ (format #t "GL_COLOR_CLEAR_VALUE: ~A~%" (glGetFloatv GL_COLOR_CLEAR_VALUE))
+ (format #t "GL_INDEX_CLEAR_VALUE: ~A~%" (glGetIntegerv GL_INDEX_CLEAR_VALUE))
+ (format #t "GL_DEPTH_CLEAR_VALUE: ~A~%" (glGetFloatv GL_DEPTH_CLEAR_VALUE))
+ (format #t "GL_STENCIL_CLEAR_VALUE: ~A~%" (glGetIntegerv GL_STENCIL_CLEAR_VALUE))
+ (format #t "GL_ACCUM_CLEAR_VALUE: ~A~%" (glGetFloatv GL_ACCUM_CLEAR_VALUE))
+ (format #t "GL_UNPACK_SWAP_BYTES: ~A~%" (glGetBooleanv GL_UNPACK_SWAP_BYTES))
+ (format #t "GL_UNPACK_LSB_FIRST: ~A~%" (glGetBooleanv GL_UNPACK_LSB_FIRST))
+ (format #t "GL_UNPACK_ROW_LENGTH: ~A~%" (glGetIntegerv GL_UNPACK_ROW_LENGTH))
+ (format #t "GL_UNPACK_SKIP_ROWS: ~A~%" (glGetIntegerv GL_UNPACK_SKIP_ROWS))
+ (format #t "GL_UNPACK_SKIP_PIXELS: ~A~%" (glGetIntegerv GL_UNPACK_SKIP_PIXELS))
+ (format #t "GL_UNPACK_ALIGNMENT: ~A~%" (glGetIntegerv GL_UNPACK_ALIGNMENT))
+ (format #t "GL_PACK_SWAP_BYTES: ~A~%" (glGetBooleanv GL_PACK_SWAP_BYTES))
+ (format #t "GL_PACK_LSB_FIRST: ~A~%" (glGetBooleanv GL_PACK_LSB_FIRST))
+ (format #t "GL_PACK_ROW_LENGTH: ~A~%" (glGetIntegerv GL_PACK_ROW_LENGTH))
+ (format #t "GL_PACK_SKIP_ROWS: ~A~%" (glGetIntegerv GL_PACK_SKIP_ROWS))
+ (format #t "GL_PACK_SKIP_PIXELS: ~A~%" (glGetIntegerv GL_PACK_SKIP_PIXELS))
+ (format #t "GL_PACK_ALIGNMENT: ~A~%" (glGetIntegerv GL_PACK_ALIGNMENT))
+ (format #t "GL_MAP_COLOR: ~A~%" (glGetBooleanv GL_MAP_COLOR))
+ (format #t "GL_MAP_STENCIL: ~A~%" (glGetBooleanv GL_MAP_STENCIL))
+ (format #t "GL_INDEX_SHIFT: ~A~%" (glGetIntegerv GL_INDEX_SHIFT))
+ (format #t "GL_INDEX_OFFSET: ~A~%" (glGetIntegerv GL_INDEX_OFFSET))
+ (format #t "GL_RED_SCALE: ~A~%" (glGetFloatv GL_RED_SCALE))
+ (format #t "GL_GREEN_SCALE: ~A~%" (glGetFloatv GL_GREEN_SCALE))
+ (format #t "GL_BLUE_SCALE: ~A~%" (glGetFloatv GL_BLUE_SCALE))
+ (format #t "GL_ALPHA_SCALE: ~A~%" (glGetFloatv GL_ALPHA_SCALE))
+ (format #t "GL_DEPTH_SCALE: ~A~%" (glGetFloatv GL_DEPTH_SCALE))
+ (format #t "GL_RED_BIAS: ~A~%" (glGetFloatv GL_RED_BIAS))
+ (format #t "GL_GREEN_BIAS: ~A~%" (glGetFloatv GL_GREEN_BIAS))
+ (format #t "GL_BLUE_BIAS: ~A~%" (glGetFloatv GL_BLUE_BIAS))
+ (format #t "GL_ALPHA_BIAS: ~A~%" (glGetFloatv GL_ALPHA_BIAS))
+ (format #t "GL_DEPTH_BIAS: ~A~%" (glGetFloatv GL_DEPTH_BIAS))
+ (format #t "GL_ZOOM_X: ~A~%" (glGetFloatv GL_ZOOM_X))
+ (format #t "GL_ZOOM_Y: ~A~%" (glGetFloatv GL_ZOOM_Y))
+ (format #t "GL_READ_BUFFER: ~A~%" (glGetIntegerv GL_READ_BUFFER))
+ (format #t "GL_AUTO_NORMAL: ~A~%" (glGetBooleanv GL_AUTO_NORMAL))
+ (format #t "GL_PERSPECTIVE_CORRECTION_HINT: ~A~%" (glGetIntegerv GL_PERSPECTIVE_CORRECTION_HINT))
+ (format #t "GL_POINT_SMOOTH_HINT: ~A~%" (glGetIntegerv GL_POINT_SMOOTH_HINT))
+ (format #t "GL_LINE_SMOOTH_HINT: ~A~%" (glGetIntegerv GL_LINE_SMOOTH_HINT))
+ (format #t "GL_POLYGON_SMOOTH_HINT: ~A~%" (glGetIntegerv GL_POLYGON_SMOOTH_HINT))
+ (format #t "GL_FOG_HINT: ~A~%" (glGetIntegerv GL_FOG_HINT))
+ (format #t "GL_MAX_LIGHTS: ~A~%" (glGetIntegerv GL_MAX_LIGHTS))
+ (format #t "GL_MAX_CLIP_PLANES: ~A~%" (glGetIntegerv GL_MAX_CLIP_PLANES))
+ (format #t "GL_MAX_MODELVIEW_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_MODELVIEW_STACK_DEPTH))
+ (format #t "GL_MAX_PROJECTION_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_PROJECTION_STACK_DEPTH))
+ (format #t "GL_MAX_TEXTURE_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_TEXTURE_STACK_DEPTH))
+ (format #t "GL_SUBPIXEL_BITS: ~A~%" (glGetIntegerv GL_SUBPIXEL_BITS))
+ (format #t "GL_MAX_TEXTURE_SIZE: ~A~%" (glGetIntegerv GL_MAX_TEXTURE_SIZE))
+ (format #t "GL_MAX_PIXEL_MAP_TABLE: ~A~%" (glGetIntegerv GL_MAX_PIXEL_MAP_TABLE))
+ (format #t "GL_MAX_NAME_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_NAME_STACK_DEPTH))
+ (format #t "GL_MAX_LIST_NESTING: ~A~%" (glGetIntegerv GL_MAX_LIST_NESTING))
+ (format #t "GL_MAX_EVAL_ORDER: ~A~%" (glGetIntegerv GL_MAX_EVAL_ORDER))
+ (format #t "GL_MAX_VIEWPORT_DIMS: ~A~%" (glGetIntegerv GL_MAX_VIEWPORT_DIMS))
+ (format #t "GL_MAX_ATTRIB_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_ATTRIB_STACK_DEPTH))
+ (format #t "GL_MAX_CLIENT_ATTRIB_STACK_DEPTH: ~A~%" (glGetIntegerv GL_MAX_CLIENT_ATTRIB_STACK_DEPTH))
+ (format #t "GL_AUX_BUFFERS: ~A~%" (glGetIntegerv GL_AUX_BUFFERS))
+ (format #t "GL_RGBA_MODE: ~A~%" (glGetBooleanv GL_RGBA_MODE))
+ (format #t "GL_INDEX_MODE: ~A~%" (glGetBooleanv GL_INDEX_MODE))
+ (format #t "GL_DOUBLEBUFFER: ~A~%" (glGetBooleanv GL_DOUBLEBUFFER))
+ (format #t "GL_STEREO: ~A~%" (glGetBooleanv GL_STEREO))
+ (format #t "GL_LINE_WIDTH_RANGE: ~A~%" (glGetFloatv GL_LINE_WIDTH_RANGE))
+ (format #t "GL_LINE_WIDTH_GRANULARITY: ~A~%" (glGetFloatv GL_LINE_WIDTH_GRANULARITY))
+ (format #t "GL_RED_BITS: ~A~%" (glGetIntegerv GL_RED_BITS))
+ (format #t "GL_GREEN_BITS: ~A~%" (glGetIntegerv GL_GREEN_BITS))
+ (format #t "GL_BLUE_BITS: ~A~%" (glGetIntegerv GL_BLUE_BITS))
+ (format #t "GL_ALPHA_BITS: ~A~%" (glGetIntegerv GL_ALPHA_BITS))
+ (format #t "GL_INDEX_BITS: ~A~%" (glGetIntegerv GL_INDEX_BITS))
+ (format #t "GL_DEPTH_BITS: ~A~%" (glGetIntegerv GL_DEPTH_BITS))
+ (format #t "GL_STENCIL_BITS: ~A~%" (glGetIntegerv GL_STENCIL_BITS))
+ (format #t "GL_ACCUM_RED_BITS: ~A~%" (glGetIntegerv GL_ACCUM_RED_BITS))
+ (format #t "GL_ACCUM_GREEN_BITS: ~A~%" (glGetIntegerv GL_ACCUM_GREEN_BITS))
+ (format #t "GL_ACCUM_BLUE_BITS: ~A~%" (glGetIntegerv GL_ACCUM_BLUE_BITS))
+ (format #t "GL_ACCUM_ALPHA_BITS: ~A~%" (glGetIntegerv GL_ACCUM_ALPHA_BITS))
+ (format #t "GL_LIST_BASE: ~A~%" (glGetIntegerv GL_LIST_BASE))
+ (format #t "GL_LIST_INDEX: ~A~%" (glGetIntegerv GL_LIST_INDEX))
+ (format #t "GL_LIST_MODE: ~A~%" (glGetIntegerv GL_LIST_MODE))
+ (format #t "GL_ATTRIB_STACK_DEPTH: ~A~%" (glGetIntegerv GL_ATTRIB_STACK_DEPTH))
+ (format #t "GL_CLIENT_ATTRIB_STACK_DEPTH: ~A~%" (glGetIntegerv GL_CLIENT_ATTRIB_STACK_DEPTH))
+ (format #t "GL_NAME_STACK_DEPTH: ~A~%" (glGetIntegerv GL_NAME_STACK_DEPTH))
+ (format #t "GL_RENDER_MODE: ~A~%" (glGetIntegerv GL_RENDER_MODE))
+ (format #t "GL_SELECTION_BUFFER_POINTER: ~A~%" (glGetPointerv GL_SELECTION_BUFFER_POINTER))
+ (format #t "GL_SELECTION_BUFFER_SIZE: ~A~%" (glGetIntegerv GL_SELECTION_BUFFER_SIZE))
+ (format #t "GL_FEEDBACK_BUFFER_POINTER: ~A~%" (glGetPointerv GL_FEEDBACK_BUFFER_POINTER))
+ (format #t "GL_FEEDBACK_BUFFER_SIZE: ~A~%" (glGetIntegerv GL_FEEDBACK_BUFFER_SIZE))
+ (format #t "GL_FEEDBACK_BUFFER_TYPE: ~A~%" (glGetIntegerv GL_FEEDBACK_BUFFER_TYPE))
)
;;; -------- complexify --------
+(require snd-snd-motif.scm)
+
(define complexify
- (let* ((gl-list #f)
- (drawer #f))
+ (let ((gl-list #f)
+ (drawer #f))
(define (redraw-graph)
- (let* ((win (XtWindow drawer))
- (dpy (XtDisplay drawer))
- (cx (snd-glx-context)))
+ (let ((win ((*motif* 'XtWindow) drawer))
+ (dpy ((*motif* 'XtDisplay) drawer))
+ (cx (snd-gl-context)))
(glXMakeCurrent dpy win cx)
(if gl-list (glDeleteLists gl-list 1))
(set! gl-list (glGenLists 1))
@@ -440,56 +328,61 @@
(glClearDepth 1.0)
(glClearColor 1.0 1.0 1.0 1.0)
(glClear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
- (let* ((rl (channel->vct (left-sample) 512))
- (im (make-vct 512 0.0)))
+ (let ((rl (channel->float-vector (left-sample) 512))
+ (im (make-float-vector 512 0.0)))
(mus-fft rl im)
- (let ((peak (* 2 (max (vct-peak rl) (vct-peak im)))))
- (vct-scale! rl (/ 1.0 peak))
- (vct-scale! im (/ 1.0 peak)))
+ (let ((peak (* 2 (max (float-vector-peak rl) (float-vector-peak im)))))
+ (float-vector-scale! rl (/ 1.0 peak))
+ (float-vector-scale! im (/ 1.0 peak)))
;; display each element in the complex plane rotated to stack along the x axis
(glNewList gl-list GL_COMPILE)
(glBegin GL_LINES)
- (apply glColor3f (color->list (data-color)))
+ (apply glColor3f (color->list *data-color*))
(do ((i 0 (+ 1 i)))
((= i 256))
(glVertex3f (/ i 256.0) 0.0 0.0)
(glVertex3f (/ i 256.0) (rl i) (im i)))
(glEnd)
(glEndList))
- (let ((vals (XtVaGetValues drawer (list XmNwidth 0 XmNheight 0))))
+ (let ((vals ((*motif* 'XtVaGetValues) drawer (list (*motif* 'XmNwidth) 0 (*motif* 'XmNheight) 0))))
(glViewport 0 0 (list-ref vals 1) (list-ref vals 3)))
(glMatrixMode GL_PROJECTION)
(glLoadIdentity)
(glOrtho -0.2 1.0 -1.5 1.0 -1.0 1.0)
- (glRotatef (spectro-x-angle) 1.0 0.0 0.0)
- (glRotatef (spectro-y-angle) 0.0 1.0 0.0)
- (glRotatef (spectro-z-angle) 0.0 0.0 1.0)
- (glScalef (spectro-x-scale) (spectro-y-scale) (spectro-z-scale))
+ (glRotatef *spectro-x-angle* 1.0 0.0 0.0)
+ (glRotatef *spectro-y-angle* 0.0 1.0 0.0)
+ (glRotatef *spectro-z-angle* 0.0 0.0 1.0)
+ (glScalef *spectro-x-scale* *spectro-y-scale* *spectro-z-scale*)
(glCallList gl-list)
(glXSwapBuffers dpy win)
(glDrawBuffer GL_BACK)))
(define (add-main-pane name type args)
- (XtCreateManagedWidget name type (list-ref (main-widgets) 3) args))
+ ((*motif* 'XtCreateManagedWidget) name type (list-ref (main-widgets) 3) args))
(lambda ()
(if (not drawer)
- (let* ((outer (add-main-pane "Waterfall" xmFormWidgetClass
- (list XmNbackground (basic-color)
- XmNpaneMinimum 320))))
- (set! drawer (XtCreateManagedWidget "draw" xmDrawingAreaWidgetClass outer
- (list XmNbackground (graph-color)
- XmNforeground (data-color)
- XmNleftAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM)))
- (set! (spectro-x-angle) 210.0)
- (set! (spectro-y-angle) 60.0)
- (set! (spectro-z-angle) 30.0)
- (set! (spectro-x-scale) 3.0)
- (XtAddCallback drawer XmNresizeCallback (lambda (w context info) (redraw-graph)))
- (XtAddCallback drawer XmNexposeCallback (lambda (w context info) (redraw-graph)))
- (hook-push after-graph-hook (lambda (s c) (redraw-graph)))
- (hook-push orientation-hook (lambda () (redraw-graph)))
- (hook-push color-hook (lambda () (redraw-graph))))))))
+ (let ((outer (with-let (sublet *motif*)
+ (add-main-pane "Waterfall" xmFormWidgetClass
+ (list XmNbackground *basic-color*
+ XmNpaneMinimum 320)))))
+ (set! drawer (with-let (sublet *motif* 'outer outer)
+ (XtCreateManagedWidget "draw" xmDrawingAreaWidgetClass outer
+ (list XmNbackground *graph-color*
+ XmNforeground *data-color*
+ XmNleftAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM))))
+ (set! *spectro-x-angle* 210.0)
+ (set! *spectro-y-angle* 60.0)
+ (set! *spectro-z-angle* 30.0)
+ (set! *spectro-x-scale* 3.0)
+ ((*motif* 'XtAddCallback) drawer (*motif* 'XmNresizeCallback) (lambda (w context info) (redraw-graph)))
+ ((*motif* 'XtAddCallback) drawer (*motif* 'XmNexposeCallback) (lambda (w context info) (redraw-graph)))
+ (hook-push after-graph-hook (lambda (hook) (redraw-graph)))
+ (hook-push orientation-hook (lambda (hook) (redraw-graph)))
+ (hook-push color-hook (lambda (hook) (redraw-graph))))))))
+)
+
+(define complexify (*gl* 'complexify))
diff --git a/snd-glistener.c b/snd-glistener.c
index 5085ce1..032f3df 100644
--- a/snd-glistener.c
+++ b/snd-glistener.c
@@ -1,955 +1,596 @@
#include "snd.h"
+#include "snd-menu.h"
static GtkWidget *listener_text = NULL;
-static int printout_end = 0;
+static GtkTextBuffer *listener_buffer = NULL;
-#define LISTENER_BUFFER gtk_text_view_get_buffer(GTK_TEXT_VIEW(listener_text))
-
-
-int save_listener_text(FILE *fp)
+void listener_append(const char *msg)
{
- /* return -1 if fwrite error */
+ if (ss->listener)
+ glistener_append_text(ss->listener, msg);
if (listener_text)
- {
- char *str = NULL;
- str = sg_get_text(listener_text, 0, -1);
- if (str)
- {
- size_t bytes;
- bytes = fwrite((void *)str, sizeof(char), mus_strlen(str), fp);
- g_free(str);
- if (bytes == 0) return(-1);
- }
- }
- return(0);
+ ss->graph_is_active = false;
}
-void append_listener_text(int end, const char *msg)
+void listener_append_and_prompt(const char *msg)
{
- /* "end" arg needed in Motif */
- if ((listener_print_p(msg)) &&
- (listener_text))
+ if (msg)
{
- int chars;
- chars = gtk_text_buffer_get_char_count(LISTENER_BUFFER);
- if (chars > 0) sg_set_cursor(listener_text, chars + 1);
- sg_text_insert(listener_text, (char *)msg);
+ glistener_append_text(ss->listener, msg);
+ glistener_append_prompt(ss->listener);
}
-}
-
-
-static GtkTextTag *prompt_not_editable = NULL;
-
-static void append_listener_prompt(void)
-{
- /* append cr + prompt with not-editable tag */
- if (listener_text)
+ else
{
- int chars;
- GtkTextIter pos;
- chars = gtk_text_buffer_get_char_count(LISTENER_BUFFER);
- if (chars > 0) sg_set_cursor(listener_text, chars + 1);
- gtk_text_buffer_get_end_iter(LISTENER_BUFFER, &pos);
- gtk_text_buffer_insert_with_tags(LISTENER_BUFFER, &pos, listener_prompt_with_cr(), ss->listener_prompt_length + 1, prompt_not_editable, NULL);
+ if (ss->listener)
+ glistener_append_text(ss->listener, "\n");
}
}
-static void sg_text_delete(GtkWidget *w, int start, int end)
-{
- GtkTextIter s, e;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
- gtk_text_buffer_get_iter_at_offset(buf, &s, start);
- gtk_text_buffer_get_iter_at_offset(buf, &e, end);
- gtk_text_buffer_delete(buf, &s, &e);
-}
-
+static Xen listener_click_hook;
+static Xen mouse_enter_listener_hook;
+static Xen mouse_leave_listener_hook;
-static void listener_completion(int end)
+static gboolean listener_focus_callback(GtkWidget *w, GdkEventCrossing *ev, gpointer unknown)
{
- int beg;
- char *old_text = NULL;
-
- beg = printout_end + 1;
- if (end <= beg) return;
-
- old_text = sg_get_text(listener_text, beg, end);
- /* now old_text is the stuff typed since the last prompt */
-
- if (old_text)
- {
- char *new_text = NULL, *file_text = NULL;
- bool try_completion = true;
-
- new_text = complete_listener_text(old_text, end, &try_completion, &file_text);
- if (try_completion)
- {
- int matches = 0;
- if (mus_strcmp(old_text, new_text))
- matches = get_completion_matches();
- sg_text_delete(listener_text, beg, end);
- append_listener_text(0, new_text);
- goto_window(listener_text);
- }
+ if (with_pointer_focus(ss))
+ goto_window(listener_text);
- if (new_text) free(new_text);
- if (file_text) free(file_text);
- g_free(old_text);
- }
-
+ if (Xen_hook_has_list(mouse_enter_listener_hook))
+ run_hook(mouse_enter_listener_hook,
+ Xen_list_1(Xen_wrap_widget(listener_text)),
+ S_mouse_enter_listener_hook);
+ cursor_set_blinks(w, true);
+ return(false);
}
-static int back_to_start(bool move_cursor)
+static gboolean listener_unfocus_callback(GtkWidget *w, GdkEventCrossing *ev, gpointer unknown)
{
- char *full_str = NULL, *prompt;
- int start_of_text;
- full_str = sg_get_text(listener_text, 0, -1);
- start_of_text = sg_cursor_position(listener_text);
- prompt = listener_prompt(ss);
- if (start_of_text > 0)
- {
- int i;
- for (i = start_of_text; i >= 0; i--)
- if (is_prompt(full_str, i))
- {
- start_of_text = i + 1;
- break;
- }
- }
- if (move_cursor)
- sg_set_cursor(listener_text, start_of_text + 1);
- if (full_str) g_free(full_str);
- return(start_of_text + 1);
+ if (Xen_hook_has_list(mouse_leave_listener_hook))
+ run_hook(mouse_leave_listener_hook,
+ Xen_list_1(Xen_wrap_widget(listener_text)),
+ S_mouse_leave_listener_hook);
+ cursor_set_blinks(w, false);
+ return(false);
}
-static void text_at_cursor(GtkWidget *w)
+static gboolean listener_button_press(GtkWidget *w, GdkEventButton *ev, gpointer data)
{
- int curpos, endpos, start, end, len, prompt_pos;
- char *buf;
-
- curpos = sg_cursor_position(w);
- if (curpos <= 1)
- {
- snd_help("Listener", "This is the 'listener', a text widget in which you can interact with Snd's extension language. See extsnd.html.", WITH_WORD_WRAP);
- return;
- }
-
- prompt_pos = back_to_start(false);
-
- if (curpos > 40)
- start = curpos - 40;
- else start = 0;
- if (start < prompt_pos)
- start = prompt_pos;
-
- endpos = gtk_text_buffer_get_char_count(LISTENER_BUFFER) - 1;
- if ((endpos - curpos) > 40)
- end = curpos + 40;
- else end = endpos;
-
- len = end - start + 1;
- buf = sg_get_text(w, start, end + 1);
- listener_help_at_cursor(buf, curpos - start - 1, len, prompt_pos);
- g_free(buf);
+ ss->graph_is_active = false;
+ return(false);
}
+static gboolean listener_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+{
+ guint key;
+ GdkModifierType state;
-/* ---------------- listener widget ---------------- */
+ /* clear possible warning */
+ /* glistener_clear_status(ss->listener); */
-void listener_append(const char *msg)
-{
- append_listener_text(0, msg); /* do this in any case to make sure print-hook gets to run (listener_print_p in append_listener_text) */
- if (listener_text)
- {
- if (ss->graph_is_active)
- ss->graph_is_active = false;
- printout_end = gtk_text_buffer_get_char_count(LISTENER_BUFFER) - 1;
- }
-}
+ key = EVENT_KEYVAL(event);
+ state = (GdkModifierType)EVENT_STATE(event);
+ if ((state & snd_ControlMask) &&
+ ((key == snd_K_g) || (key == snd_K_G)))
+ ss->C_g_typed = true;
-void listener_append_and_prompt(const char *msg)
-{
- if (msg)
- append_listener_text(0, msg);
- append_listener_prompt();
- if (listener_text)
+ if (ss->graph_is_active)
{
- int cmd_eot;
- cmd_eot = gtk_text_buffer_get_char_count(LISTENER_BUFFER);
- printout_end = cmd_eot - 1;
+ chan_info *cp;
+ cp = current_channel();
+ if (!cp)
+ ss->graph_is_active = false;
+ else
+ {
+ graph_key_press(channel_graph(cp), event, (gpointer)cp);
+ return(true); /* don't repeat the keystroke?? */
+ }
}
+ return(false);
}
-static void listener_return_callback(void)
-{
- listener_return(listener_text, printout_end);
+#if HAVE_SCHEME
+static s7_pointer g_listener_load_hook(s7_scheme *sc, s7_pointer args)
+{
+ /* arg is the hook, (hook 'name) is the file */
+ s7_pointer hook, file;
+ if (!(ss->listener)) return(args);
+ char msg[128];
+ hook = s7_car(args);
+ file = s7_let_ref(s7, hook, s7_make_symbol(s7, "name"));
+ if (!s7_is_string(file))
+ s7_wrong_type_arg_error(sc, "glistener *load-hook*", 1, file, "a hook with a 'name field, the file being loaded");
+ snprintf(msg, 128, "loading %s", s7_string(file));
+ glistener_post_status(ss->listener, msg);
+ return(args);
}
+#endif
-void listener_delete_text(int new_end)
+static void listener_init(glistener *g, GtkWidget *w)
{
- int old_end;
- old_end = gtk_text_buffer_get_char_count(gtk_text_view_get_buffer(GTK_TEXT_VIEW(listener_text)));
- if (new_end < old_end)
- sg_text_delete(listener_text, new_end, old_end);
-}
-
+ listener_text = w;
+ listener_buffer = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
-static void clear_back_to_prompt(GtkWidget *w)
-{
- int beg, end;
- end = sg_cursor_position(w);
- back_to_start(true);
- beg = sg_cursor_position(w);
- if (end <= beg) return;
- sg_text_delete(w, beg, end);
+ set_listener_text_font();
+ add_listener_style(w);
+ SG_SIGNAL_CONNECT(w, "key_press_event", listener_key_press, NULL); /* Snd's should run first */
+ SG_SIGNAL_CONNECT(w, "button_press_event", listener_button_press, NULL);
+ SG_SIGNAL_CONNECT(w, "enter_notify_event", listener_focus_callback, NULL);
+ SG_SIGNAL_CONNECT(w, "leave_notify_event", listener_unfocus_callback, NULL);
+
+ glistener_set_prompt_tag(ss->listener, gtk_text_buffer_create_tag(listener_buffer, "glistener_prompt_tag",
+ "weight", PANGO_WEIGHT_BOLD,
+ /* "foreground", "red", */
+ NULL));
+ ss->listener_pane = w;
}
-
-static void ctrl_k(GtkWidget *w)
+#if HAVE_SCHEME
+static const char *helper(glistener *g, const char *text)
{
- GtkTextIter beg, end;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
- gtk_text_buffer_get_iter_at_mark(buf, &beg, gtk_text_buffer_get_mark(buf, "insert"));
- end = beg;
- gtk_text_iter_forward_to_end(&end);
- if (!gtk_text_iter_equal(&beg, &end))
- {
- gtk_text_buffer_select_range(buf, &beg, &end);
- gtk_text_buffer_cut_clipboard(buf, gtk_widget_get_clipboard(w, GDK_SELECTION_CLIPBOARD), true);
- }
-}
+ s7_pointer sym;
+ if (!text) return(NULL);
+ sym = s7_symbol_table_find_name(s7, text);
+ if (sym)
+ return(s7_help(s7, sym));
-
-static void sg_text_replace(GtkWidget *w, int beg, int end, char *text)
-{
- GtkTextIter pos, endpos, pos1;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
- gtk_text_buffer_get_iter_at_offset(buf, &pos, beg);
- gtk_text_buffer_get_iter_at_offset(buf, &endpos, end);
- gtk_text_buffer_delete(buf, &pos, &endpos);
- gtk_text_buffer_get_iter_at_offset(buf, &pos1, beg);
- gtk_text_buffer_insert(buf, &pos1, text, strlen(text));
+ glistener_clear_status(g);
+ return(NULL);
}
-static void text_transpose(GtkWidget *w)
+#if HAVE_CHECKER
+static const char *checker(glistener *g, const char *text)
{
- int curpos;
- curpos = sg_cursor_position(w);
- if (curpos > 1)
- {
- char *buf = NULL;
- char tmp;
- buf = sg_get_text(w, curpos - 1, curpos + 1);
- tmp = buf[0];
- buf[0] = buf[1];
- buf[1] = tmp;
- sg_text_replace(w, curpos - 1, curpos + 1, buf);
- sg_set_cursor(w, curpos + 2);
- }
-}
+ int gc_loc, err_loc;
+ s7_pointer port, err_port, result;
+ const char *errmsg;
+ bool err = false;
+ result = s7_f(s7);
+ if (s7_begin_hook(s7) != NULL) return(NULL);
+ err_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
+ err_loc = s7_gc_protect(s7, err_port);
+ port = s7_open_input_string(s7, text);
+ gc_loc = s7_gc_protect(s7, port);
+ result = s7_read(s7, port);
+ errmsg = s7_get_output_string(s7, err_port);
+ if (errmsg) {err = true; glistener_post_status(g, errmsg);}
+ s7_close_input_port(s7, port);
+ s7_gc_unprotect_at(s7, gc_loc);
+ s7_close_output_port(s7, s7_current_error_port(s7));
+ s7_set_current_error_port(s7, err_port);
+ s7_gc_unprotect_at(s7, err_loc);
-static void word_upper(GtkWidget *w, int cap, int up)
-{
- int curpos, endpos;
- curpos = sg_cursor_position(w);
- endpos = gtk_text_buffer_get_char_count(gtk_text_view_get_buffer(GTK_TEXT_VIEW(w)));
- if (curpos < endpos)
+ if ((!err) &&
+ (s7_is_pair(result)))
{
- int i, length, wstart, wend;
- char *buf = NULL;
- length = endpos - curpos;
- buf = sg_get_text(w, curpos, endpos);
- wstart = 0;
- wend = length;
- for (i = 0; i < length; i++)
- if (!isspace((int)(buf[i])))
- {
- wstart = i;
- break;
- }
- for (i = wstart + 1; i < length; i++)
- if (isspace((int)(buf[i])))
- {
- wend = i;
- break;
- }
- if (cap)
+ s7_pointer sym;
+ sym = s7_car(result);
+ if (s7_is_symbol(sym))
{
- buf[0] = toupper(buf[wstart]);
- buf[1] = '\0';
- sg_text_replace(w, curpos, curpos + 1, buf);
- }
- else
- {
- int j;
- for (i = wstart, j = 0; i < wend; i++, j++)
- if (up)
- buf[j] = toupper(buf[i]);
- else buf[j] = tolower(buf[i]);
- buf[j] = '\0';
- sg_text_replace(w, curpos + wstart, curpos + wend, buf);
+ s7_pointer val;
+ val = s7_symbol_value(s7, sym);
+ if ((val != s7_undefined(s7)) &&
+ (!s7_is_aritable(s7, val, s7_list_length(s7, result) - 1)))
+ {
+ glistener_post_status(g, "wrong number of args");
+ }
}
- sg_set_cursor(w, curpos + wend + 1);
- if (buf) g_free(buf);
}
+ return(NULL);
}
+#endif
-static GtkTextTag *flash_tag = NULL;
-static int flashes = 0;
-static int paren_pos = -1;
-#define FLASH_TIME 150
+static GtkTextTag *string_tag = NULL, *comment_tag = NULL, *comment3_tag = NULL, *block_comment_tag = NULL;
+static GtkTextTag *syntax_tag = NULL, *macro_tag = NULL, *procedure_tag = NULL, *constant_tag = NULL;
+static GtkTextTag *undefined_tag = NULL;
+/* also bracket and character
+ */
-static void add_inverse(int pos)
+static s7_pointer g_colorizer_colors(s7_scheme *sc, s7_pointer args)
{
- GtkTextIter start, end;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(listener_text));
- gtk_text_buffer_get_iter_at_offset(buf, &start, pos);
- gtk_text_buffer_get_iter_at_offset(buf, &end, pos + 1);
- if (!flash_tag) flash_tag = gtk_text_buffer_create_tag(buf, "red_background", "background", "red", NULL);
- gtk_text_buffer_apply_tag(buf, flash_tag, &start, &end);
-}
+ #define H_colorizer_colors "(colorizer-colors comment comment3 block-comment string constant syntax macro procedure undefined)"
+ /* set the tag colors from scheme -- tags are owned by the buffer, so I assume we don't free the old ones
+ *
+ * default: (colorizer-colors "red" "brown" "orangered" "gray40" "gray20" "blue" "seagreen" "steelblue4" "black")
+ */
+ int i;
+ s7_pointer p;
+
+ for (p = args, i = 1; s7_is_pair(p); p = s7_cdr(p), i++)
+ {
+ if (!s7_is_string(s7_car(p)))
+ s7_wrong_type_arg_error(sc, "colorizer-colors", i, s7_car(p), "a color name (a string)");
+ }
+ p = args;
+ if (s7_is_pair(p)) {comment_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
+ if (s7_is_pair(p)) {comment3_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
+ if (s7_is_pair(p)) {block_comment_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
+ if (s7_is_pair(p)) {string_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
+ if (s7_is_pair(p)) {constant_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
+ if (s7_is_pair(p)) {syntax_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
+ if (s7_is_pair(p)) {macro_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
+ if (s7_is_pair(p)) {procedure_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
+ if (s7_is_pair(p)) {undefined_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", s7_string(s7_car(p)), NULL); p = s7_cdr(p);}
-static void remove_inverse(int pos)
-{
- GtkTextIter start, end;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(listener_text));
- gtk_text_buffer_get_iter_at_offset(buf, &start, pos);
- gtk_text_buffer_get_iter_at_offset(buf, &end, pos + 1);
- if (!flash_tag) flash_tag = gtk_text_buffer_create_tag(buf, "red_background", "background", "red", NULL);
- gtk_text_buffer_remove_tag(buf, flash_tag, &start, &end);
+ return(s7_t(sc));
}
-static gint flash_unbalanced_paren(gpointer data)
+static void colorizer(glistener *g, glistener_colorizer_t type, int start, int end)
{
- flashes--;
- if (flashes & 1) remove_inverse(paren_pos); else add_inverse(paren_pos);
- if (flashes > 0)
- g_timeout_add_full(0, (guint32)FLASH_TIME, flash_unbalanced_paren, NULL, NULL);
- else
+ GtkTextIter s1, s2;
+ GtkTextTag *tag;
+
+ if (!comment_tag)
{
- remove_inverse(paren_pos);
- paren_pos = -1;
+ comment_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "red", NULL);
+ comment3_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "brown", NULL);
+ block_comment_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "orangered", NULL);
+ string_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "gray40", NULL);
+ constant_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "gray20", NULL);
+ syntax_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "blue", NULL);
+ macro_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "seagreen", NULL);
+ procedure_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "steelblue4", NULL);
+ undefined_tag = gtk_text_buffer_create_tag(listener_buffer, NULL, "foreground", "black", NULL);
}
- return(0);
-}
+ tag = NULL;
-
-bool highlight_unbalanced_paren(void)
-{
- /* if cursor is positioned at close paren, try to find reason for unbalanced expr and highlight it */
- int pos;
- bool success = true;
- pos = sg_cursor_position(listener_text);
- if (pos > 2)
+ switch (type)
{
- char *str = NULL;
- str = sg_get_text(listener_text, 0, pos);
- if ((str[pos - 1] == ')') &&
- ((str[pos - 2] != '\\') || (str[pos - 3] != '#')))
+ case GLISTENER_COMMENT:
+ tag = comment_tag;
+ if (comment3_tag)
{
- int parens;
- parens = find_matching_paren(str, 2, pos - 1, &paren_pos);
- if (parens == 0)
+ /* presumably ;;; ... is handled differently in this case */
+ GtkTextIter iter;
+ gtk_text_buffer_get_iter_at_offset(listener_buffer, &iter, start);
+ /* is start the start of a line, and are the first 3 chars semicolons */
+ if ((gtk_text_iter_starts_line(&iter)) &&
+ ((end - start) > 2))
{
- add_inverse(paren_pos);
- flashes = 4;
- g_timeout_add_full(0, (guint32)FLASH_TIME, flash_unbalanced_paren, NULL, NULL);
+ char *text;
+ text = glistener_text(ss->listener, start, start + 3);
+ if (text)
+ {
+ if (strcmp(text, ";;;") == 0)
+ tag = comment3_tag;
+ free(text);
+ }
}
- else success = false;
}
- if (str) g_free(str);
- }
- return(success);
-}
+ break;
+ case GLISTENER_BLOCK_COMMENT:
+ tag = block_comment_tag;
+ break;
-static GtkTextTag *tag = NULL;
-static int old_pos = -1;
+ case GLISTENER_STRING:
+ tag = string_tag;
+ break;
-static void add_underline(int pos)
-{
- GtkTextIter start, end;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(listener_text));
- gtk_text_buffer_get_iter_at_offset(buf, &start, pos);
- gtk_text_buffer_get_iter_at_offset(buf, &end, pos + 1);
- if (!tag) tag = gtk_text_buffer_create_tag(buf, "underline", "underline", PANGO_UNDERLINE_DOUBLE, NULL);
- gtk_text_buffer_apply_tag(buf, tag, &start, &end);
-}
+ case GLISTENER_ATOM:
+ {
+ char *text;
+ tag = NULL;
+ text = glistener_text(ss->listener, start, end);
+ if (text[0] == '#')
+ {
+ tag = constant_tag;
+ }
+ else
+ {
+ s7_pointer sym;
+ sym = s7_symbol_table_find_name(s7, text);
+
+ if (sym)
+ {
+ if (s7_is_syntax(s7_symbol_value(s7, sym)))
+ tag = syntax_tag;
+ else
+ {
+ if (s7_is_procedure(s7_symbol_value(s7, sym)))
+ tag = procedure_tag;
+ else
+ {
+ if (s7_is_macro(s7, sym))
+ tag = macro_tag;
+ else
+ {
+ if (!s7_is_defined(s7, text))
+ {
+ tag = undefined_tag;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ }
+ }
+ if (text) free(text);
+ }
+ break;
-static void remove_underline(int pos)
-{
- GtkTextIter start, end;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(listener_text));
- gtk_text_buffer_get_iter_at_offset(buf, &start, pos);
- gtk_text_buffer_get_iter_at_offset(buf, &end, pos + 1);
- if (!tag) tag = gtk_text_buffer_create_tag(buf, "underline", "underline", PANGO_UNDERLINE_DOUBLE, NULL);
- gtk_text_buffer_remove_tag(buf, tag, &start, &end);
+ case GLISTENER_LIST:
+ case GLISTENER_BRACKET:
+ case GLISTENER_CHARACTER:
+ break;
+ }
+ if (!tag) return;
+
+ gtk_text_buffer_get_iter_at_offset(listener_buffer, &s1, start);
+ gtk_text_buffer_get_iter_at_offset(listener_buffer, &s2, end);
+ gtk_text_buffer_apply_tag(listener_buffer, tag, &s1, &s2);
}
-static void check_parens(void)
+static void completer(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
{
- int current_position, parens, pos;
- if (old_pos != -1)
- {
- remove_underline(old_pos);
- old_pos = -1;
- }
- current_position = sg_cursor_position(listener_text);
- if (current_position > 2)
- {
- char *fstr = NULL;
- fstr = sg_get_text(listener_text, 0, current_position);
- if (fstr[current_position - 1] == ')')
- {
- parens = find_matching_paren(fstr, 1, current_position - 1, &pos);
- if (parens == 0)
- {
- add_underline(pos);
- old_pos = pos;
- }
- }
- g_free(fstr);
- }
+ s7_for_each_symbol_name(s7, symbol_func, data);
}
-static gboolean listener_key_release(GtkWidget *w, GdkEventKey *event, gpointer data)
+static s7_pointer top_level_let = NULL;
+static s7_pointer g_top_level_let(s7_scheme *sc, s7_pointer args)
{
- check_parens();
- return(false);
+ return(top_level_let);
}
-
-static gboolean listener_key_press(GtkWidget *w, GdkEventKey *event, gpointer data)
+static s7_pointer g_set_top_level_let(s7_scheme *sc, s7_pointer args)
{
- guint key;
- GdkModifierType state;
-
- if (ss->graph_is_active)
- {
- chan_info *cp;
- cp = current_channel();
- graph_key_press(channel_graph(cp), event, (gpointer)cp);
- return(true); /* don't repeat the keystroke */
- }
+ top_level_let = s7_car(args);
+ return(top_level_let);
+}
- key = EVENT_KEYVAL(event);
- state = (GdkModifierType)EVENT_STATE(event);
- if (key == snd_K_Tab)
+static void evaluator(glistener *g, const char *text)
+{
+ int gc_loc;
+ s7_pointer old_port, result;
+ char *errmsg = NULL;
+
+ if (s7_begin_hook(s7) != NULL) return; /* s7 is already running (user typed <cr> during computation) */
+
+ old_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
+ gc_loc = s7_gc_protect(s7, old_port);
+
+ if (with_interrupts(ss))
+ s7_set_begin_hook(s7, listener_begin_hook);
+
+ result = s7_eval_c_string_with_environment(s7, text, top_level_let);
+
+ s7_set_begin_hook(s7, NULL);
+ errmsg = mus_strdup(s7_get_output_string(s7, s7_current_error_port(s7)));
+
+ s7_close_output_port(s7, s7_current_error_port(s7));
+ s7_set_current_error_port(s7, old_port);
+ s7_gc_unprotect_at(s7, gc_loc);
+
+ if (errmsg)
{
- listener_completion(gtk_text_buffer_get_char_count(LISTENER_BUFFER));
- return(true);
+ if (*errmsg)
+ snd_display_result(errmsg, NULL);
+ free(errmsg);
}
-
- if (key == snd_K_Return)
- listener_return_callback();
- else
- {
- if (((key == snd_K_g) || (key == snd_K_G)) &&
- (state & snd_ControlMask))
- {
- ss->C_g_typed = true;
- if (state & snd_MetaMask)
- clear_listener();
- else control_g(any_selected_sound());
- }
- else
- {
- if (((key == snd_K_a) || (key == snd_K_A)) &&
- (state & snd_ControlMask))
- {
- back_to_start(true);
- }
- else
- {
- if (key == snd_K_BackSpace)
- {
- int current_position;
- char *fstr;
- current_position = sg_cursor_position(listener_text);
- if (current_position > 1)
- {
- fstr = sg_get_text(listener_text, current_position - 2, current_position);
- if ((current_position != (printout_end - 2)) &&
- (!(mus_strcmp(fstr, listener_prompt_with_cr()))))
- {
- g_free(fstr);
- return(false);
- }
- g_free(fstr);
- }
- }
- else
- {
- if ((key == snd_K_greater) && (state & snd_MetaMask))
- {
- int end;
- end = gtk_text_buffer_get_char_count(LISTENER_BUFFER);
- sg_set_cursor(listener_text, end + 1);
- }
- else
- {
- if ((key == snd_K_less) && (state & snd_MetaMask))
- {
- sg_set_cursor(listener_text, 2);
- }
- else
- {
- if (((key == snd_K_p) || (key == snd_K_P)) && (state & snd_MetaMask))
- {
- clear_back_to_prompt(listener_text);
- restore_listener_string(true);
- }
- else
- {
- if (((key == snd_K_n) || (key == snd_K_N)) && (state & snd_MetaMask))
- {
- clear_back_to_prompt(listener_text);
- restore_listener_string(false);
- }
- else
- {
- if ((key == snd_K_question) && (state & snd_ControlMask))
- {
- text_at_cursor(listener_text);
- }
- else
- {
- if (((key == snd_K_c) || (key == snd_K_C)) && (state & snd_MetaMask))
- {
- /* M-c (as opposed to M-C) is trapped somewhere else */
- word_upper(listener_text, true, false);
- }
- else
- {
- if (((key == snd_K_l) || (key == snd_K_L)) && (state & snd_MetaMask))
- {
- word_upper(listener_text, false, false);
- }
- else
- {
- if (((key == snd_K_u) || (key == snd_K_U)) && (state & snd_MetaMask))
- {
- word_upper(listener_text, false, true);
- }
- else
- {
- if (((key == snd_K_t) || (key == snd_K_T)) && (state & snd_ControlMask))
- {
- text_transpose(listener_text);
- }
- else
- {
- if ((key == snd_K_underscore) && (state & snd_ControlMask))
- {
- backup_listener_to_previous_expression();
- }
- else
- {
- if ((key == snd_K_k) && (state & snd_ControlMask))
- {
- /* select to line end, copy to clipboard, delete */
- ctrl_k(listener_text);
- }
- else
- return(false);
- }}}}}}}}}}}}}}
- g_signal_stop_emission((gpointer)w, g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
- return(false);
+ else snd_report_listener_result(result);
}
-static XEN listener_click_hook;
-
-static gboolean listener_button_press(GtkWidget *w, GdkEventButton *ev, gpointer data)
+static s7_pointer wrap_glistener(glistener *g)
{
- ss->graph_is_active = false;
- return(false);
+ return(s7_make_c_pointer(s7, (void *)g));
}
-
-static gboolean listener_button_release(GtkWidget *w, GdkEventButton *ev, gpointer data)
+static glistener *unwrap_glistener(s7_scheme *sc, const char *caller, s7_pointer p)
{
- if (EVENT_STATE(ev) & GDK_BUTTON2_MASK)
- {
- int end;
- end = gtk_text_buffer_get_char_count(LISTENER_BUFFER);
- sg_set_cursor(listener_text, end + 1);
- /* I guess ideally we'd go to the end of the current form. At least this
- * squelches the redundant copy of the text and leaves the cursor in most
- * cases at the end of the form.
- */
- }
- check_parens();
- return(false);
+ glistener *g;
+ if (!s7_is_c_pointer(p))
+ s7_wrong_type_arg_error(sc, caller, 1, p, "a c-pointer");
+ g = (glistener *)s7_c_pointer(p);
+ if (!g)
+ s7_wrong_type_arg_error(sc, caller, 1, p, "a non-null c-pointer");
+ return(g);
}
-
-static XEN mouse_enter_listener_hook;
-static XEN mouse_leave_listener_hook;
-static XEN mouse_enter_text_hook;
-static XEN mouse_leave_text_hook;
-
-#if 0
-static bool cursor_blinks(GtkWidget *w)
+static s7_pointer g_evaluate(s7_scheme *sc, s7_pointer args)
{
- GtkSettings *settings;
- gboolean blink = false;
- settings = gtk_widget_get_settings(w);
- g_object_get(settings, "gtk-cursor-blink", &blink, NULL);
- return((bool)blink);
+ char *str;
+ s7_pointer result;
+ str = glistener_evaluate(unwrap_glistener(sc, "listener eval", s7_car(args)));
+ result = s7_make_string(s7, str);
+ if (str) g_free(str);
+ return(result);
}
-#endif
-
-static bool cursor_set_blinks(GtkWidget *w, bool blinks)
+static s7_pointer g_complete(s7_scheme *sc, s7_pointer args)
{
- GtkSettings *settings;
- settings = gtk_widget_get_settings(w);
- g_object_set(settings, "gtk-cursor-blink", (gboolean)blinks, NULL);
- return(blinks);
+ char *str;
+ s7_pointer result;
+ str = glistener_complete(unwrap_glistener(sc, "listener completion", s7_car(args)));
+ result = s7_make_string(s7, str);
+ if (str) g_free(str);
+ return(result);
}
-
-static gboolean listener_focus_callback(GtkWidget *w, GdkEventCrossing *ev, gpointer unknown)
+static s7_pointer g_append_text(s7_scheme *sc, s7_pointer args)
{
- if (with_pointer_focus(ss))
- goto_window(listener_text);
-
- if (XEN_HOOKED(mouse_enter_listener_hook))
- run_hook(mouse_enter_listener_hook,
- XEN_LIST_1(XEN_WRAP_WIDGET(listener_text)),
- S_mouse_enter_listener_hook);
- cursor_set_blinks(w, true);
- return(false);
+ if (s7_is_string(s7_cadr(args)))
+ glistener_append_text(unwrap_glistener(sc, "listener append_text", s7_car(args)), s7_string(s7_cadr(args)));
+ return(s7_cadr(args));
}
-
-static gboolean listener_unfocus_callback(GtkWidget *w, GdkEventCrossing *ev, gpointer unknown)
+static s7_pointer g_insert_text(s7_scheme *sc, s7_pointer args)
{
- if (XEN_HOOKED(mouse_leave_listener_hook))
- run_hook(mouse_leave_listener_hook,
- XEN_LIST_1(XEN_WRAP_WIDGET(listener_text)),
- S_mouse_leave_listener_hook);
- cursor_set_blinks(w, false);
- return(false);
+ if (s7_is_string(s7_cadr(args)))
+ glistener_insert_text(unwrap_glistener(sc, "listener insert_text", s7_car(args)), s7_string(s7_cadr(args)));
+ return(s7_cadr(args));
}
-
-static gboolean mouse_enter_text_callback(GtkWidget *w, GdkEventCrossing *ev, gpointer unknown)
+static s7_pointer g_scroll_to_end(s7_scheme *sc, s7_pointer args)
{
- if (with_pointer_focus(ss))
- goto_window(w);
- widget_modify_base(w, GTK_STATE_NORMAL, ss->white);
- if (XEN_HOOKED(mouse_enter_text_hook))
- run_hook(mouse_enter_text_hook,
- XEN_LIST_1(XEN_WRAP_WIDGET(w)),
- S_mouse_enter_text_hook);
- cursor_set_blinks(w, true);
- return(false);
+ glistener_scroll_to_end(unwrap_glistener(sc, "listener scroll_to_end", s7_car(args)));
+ return(s7_car(args));
}
-
-static gboolean mouse_leave_text_callback(GtkWidget *w, GdkEventCrossing *ev, gpointer unknown)
+static s7_pointer g_append_prompt(s7_scheme *sc, s7_pointer args)
{
- widget_modify_base(w, GTK_STATE_NORMAL, ss->basic_color);
- if (XEN_HOOKED(mouse_leave_text_hook))
- run_hook(mouse_leave_text_hook,
- XEN_LIST_1(XEN_WRAP_WIDGET(w)),
- S_mouse_leave_text_hook);
- cursor_set_blinks(w, false);
- return(false);
+ glistener_append_prompt(unwrap_glistener(sc, "listener append prompt", s7_car(args)));
+ return(s7_car(args));
}
-
-void connect_mouse_to_text(GtkWidget *text)
+static s7_pointer g_prompt_position(s7_scheme *sc, s7_pointer args)
{
- SG_SIGNAL_CONNECT(text, "enter_notify_event", mouse_enter_text_callback, NULL);
- SG_SIGNAL_CONNECT(text, "leave_notify_event", mouse_leave_text_callback, NULL);
+ return(s7_make_integer(s7, glistener_prompt_position(unwrap_glistener(sc, "listener prompt position", s7_car(args)))));
}
-
-static void make_bindings(gpointer cls)
+static s7_pointer g_cursor_position(s7_scheme *sc, s7_pointer args)
{
- /* sigh... activate Emacs key bindings to some extent */
- GtkBindingSet *set;
- set = gtk_binding_set_by_class(cls);
-
- /* C-b back char */
- gtk_binding_entry_remove(set, snd_K_b, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_b, GDK_CONTROL_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_VISUAL_POSITIONS,
- G_TYPE_INT, -1,
- G_TYPE_BOOLEAN, false);
- /* M-b back word */
- gtk_binding_entry_remove(set, snd_K_b, GDK_MOD1_MASK);
- gtk_binding_entry_add_signal(set, snd_K_b, GDK_MOD1_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_WORDS,
- G_TYPE_INT, -1,
- G_TYPE_BOOLEAN, false);
- /* C-f forward char */
- gtk_binding_entry_remove(set, snd_K_f, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_f, GDK_CONTROL_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_VISUAL_POSITIONS,
- G_TYPE_INT, 1,
- G_TYPE_BOOLEAN, false);
- /* OVERRIDDEN: M-f forward word */
- gtk_binding_entry_remove(set, snd_K_f, GDK_MOD1_MASK);
- gtk_binding_entry_add_signal(set, snd_K_f, GDK_MOD1_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_WORDS,
- G_TYPE_INT, 1,
- G_TYPE_BOOLEAN, false);
- /* C-e end of line */
- gtk_binding_entry_remove(set, snd_K_e, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_e, GDK_CONTROL_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINE_ENDS,
- G_TYPE_INT, 1,
- G_TYPE_BOOLEAN, false);
- /* C-a start of line */
- gtk_binding_entry_remove(set, snd_K_a, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_a, GDK_CONTROL_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINE_ENDS,
- G_TYPE_INT, -1,
- G_TYPE_BOOLEAN, false);
- /* M-< start of file */
- gtk_binding_entry_remove(set, snd_K_less, GDK_MOD1_MASK);
- gtk_binding_entry_add_signal(set, snd_K_less, GDK_MOD1_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_BUFFER_ENDS,
- G_TYPE_INT, -1,
- G_TYPE_BOOLEAN, false);
- /* M-> end of file */
- gtk_binding_entry_remove(set, snd_K_greater, GDK_MOD1_MASK);
- gtk_binding_entry_add_signal(set, snd_K_greater, GDK_MOD1_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_BUFFER_ENDS,
- G_TYPE_INT, 1,
- G_TYPE_BOOLEAN, false);
- /* C-n down line */
- gtk_binding_entry_remove(set, snd_K_n, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_n, GDK_CONTROL_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINES,
- G_TYPE_INT, 1,
- G_TYPE_BOOLEAN, false);
- /* C-p up line */
- gtk_binding_entry_remove(set, snd_K_p, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_p, GDK_CONTROL_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_DISPLAY_LINES,
- G_TYPE_INT, -1,
- G_TYPE_BOOLEAN, false);
- /* C-v down window */
- gtk_binding_entry_remove(set, snd_K_v, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_v, GDK_CONTROL_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_PAGES,
- G_TYPE_INT, 1,
- G_TYPE_BOOLEAN, false);
- /* OVERRIDEN: M-v up window */
- gtk_binding_entry_remove(set, snd_K_v, GDK_MOD1_MASK);
- gtk_binding_entry_add_signal(set, snd_K_v, GDK_MOD1_MASK, "move_cursor", 3,
- G_TYPE_ENUM, GTK_MOVEMENT_PAGES,
- G_TYPE_INT, -1,
- G_TYPE_BOOLEAN, false);
- /* C-d delete at cursor */
- gtk_binding_entry_remove(set, snd_K_d, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_d, GDK_CONTROL_MASK,
- "delete_from_cursor", 2,
- G_TYPE_ENUM, GTK_DELETE_CHARS,
- G_TYPE_INT, -1);
- /* M-d delete word at cursor */
- gtk_binding_entry_remove(set, snd_K_d, GDK_MOD1_MASK);
- gtk_binding_entry_add_signal(set, snd_K_d, GDK_MOD1_MASK,
- "delete_from_cursor", 2,
- G_TYPE_ENUM, GTK_DELETE_WORD_ENDS,
- G_TYPE_INT, 1);
-
- /* C-k delete to end of line -- see explicit handling above */
- gtk_binding_entry_remove(set, snd_K_k, GDK_CONTROL_MASK);
-
- /* M-delete delete to start of line */
- gtk_binding_entry_remove(set, snd_K_Delete, GDK_MOD1_MASK);
- gtk_binding_entry_add_signal(set, snd_K_Delete, GDK_MOD1_MASK,
- "delete_from_cursor", 2,
- G_TYPE_ENUM, GTK_DELETE_PARAGRAPH_ENDS,
- G_TYPE_INT, -1);
-
- /* C-w delete region -> clipboard */
- gtk_binding_entry_remove(set, snd_K_w, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_w, GDK_CONTROL_MASK,
- "cut_clipboard", 0);
-
- /* C-y yank <- clipboard */
- gtk_binding_entry_remove(set, snd_K_y, GDK_CONTROL_MASK);
- gtk_binding_entry_add_signal(set, snd_K_y, GDK_CONTROL_MASK,
- "paste_clipboard", 0);
+ return(s7_make_integer(s7, glistener_cursor_position(unwrap_glistener(sc, "listener cursor position", s7_car(args)))));
}
-
-static bool bindings_ok = false;
-
-GtkWidget *snd_entry_new(GtkWidget *container, snd_entry_bg_t with_white_background)
+static s7_pointer g_set_cursor_position(s7_scheme *sc, s7_pointer args)
{
- GtkWidget *text;
- GtkSettings *settings;
- text = gtk_entry_new();
- gtk_editable_set_editable(GTK_EDITABLE(text), true);
- settings = gtk_widget_get_settings(text);
- g_object_set(settings, "gtk-entry-select-on-focus", false, NULL);
- gtk_box_pack_start(GTK_BOX(container), text, true, true, 2);
-
- if (!bindings_ok)
- {
- bindings_ok = true;
- make_bindings(GTK_ENTRY_GET_CLASS(GTK_ENTRY(text)));
- }
-
- gtk_widget_show(text);
- if (with_white_background == WITH_WHITE_BACKGROUND)
- {
- widget_modify_bg(text, GTK_STATE_NORMAL, ss->white);
- widget_modify_base(text, GTK_STATE_SELECTED, ss->white);
- }
- connect_mouse_to_text(text);
- return(text);
+ if (s7_is_integer(s7_cadr(args)))
+ glistener_set_cursor_position(unwrap_glistener(sc, "set listener cursor-position", s7_car(args)), s7_integer(s7_cadr(args)));
+ return(s7_cadr(args));
}
-
-static void listener_help_callback(GtkWidget *w, gpointer info)
+static s7_pointer g_text(s7_scheme *sc, s7_pointer args)
{
- /* for selected text or text near cursor or text near pointer, get help or completion,
- * or at least apropos, show in help dialog
- */
- GtkTextIter start, end;
- if (gtk_text_buffer_get_selection_bounds(LISTENER_BUFFER, &start, &end))
+ if ((s7_is_integer(s7_cadr(args))) &&
+ (s7_is_integer(s7_caddr(args))))
{
- char *txt;
- txt = gtk_text_buffer_get_text(LISTENER_BUFFER, &start, &end, true);
- if (txt)
- {
- char *trim_txt;
- trim_txt = trim(txt);
- if (trim_txt)
- {
- snd_help(trim_txt, XEN_TO_C_STRING(g_snd_help(C_TO_XEN_STRING(trim_txt), 0)), WITH_WORD_WRAP);
- free(trim_txt);
- }
- g_free(txt);
- }
+ char *str;
+ s7_pointer result;
+ str = glistener_text(unwrap_glistener(sc, "listener text", s7_car(args)), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)));
+ result = s7_make_string(s7, str);
+ if (str) g_free(str);
+ return(result);
}
- else text_at_cursor(listener_text);
+ return(s7_f(sc));
}
-
-static void listener_save_callback(GtkWidget *w, gpointer info)
+static s7_pointer g_clear(s7_scheme *sc, s7_pointer args)
{
- FILE *fp = NULL;
- fp = FOPEN("listener.txt", "w");
- if (fp)
- {
- save_listener_text(fp);
- snd_fclose(fp, "listener.txt");
- }
+ glistener_clear(unwrap_glistener(sc, "listener clear", s7_car(args)));
+ return(s7_car(args));
}
-
-static void listener_clear_callback(GtkWidget *w, gpointer info)
+static s7_pointer g_text_widget(s7_scheme *sc, s7_pointer args)
{
- clear_listener();
+ return(s7_list(sc, 2, s7_make_symbol(sc, "GtkTextView*"), s7_make_c_pointer(sc, (void *)listener_text)));
}
-
-static void listener_stop_callback(GtkWidget *w, gpointer info)
+static s7_pointer g_set_prompt(s7_scheme *sc, s7_pointer args)
{
- control_g(any_selected_sound());
+ if (s7_is_string(s7_cadr(args)))
+ glistener_set_prompt(unwrap_glistener(sc, "set listener prompt", s7_car(args)), s7_string(s7_cadr(args)));
+ return(s7_cadr(args));
}
+static s7_pointer g_set_prompt_tag(s7_scheme *sc, s7_pointer args)
+{
+ /* args: (#<c_pointer 0x2dfbed0> (GtkTextTag_ #<c_pointer 0x2e8f180>))
+ */
+ GtkTextTag *new_tag = NULL;
+ if (s7_is_pair(s7_cadr(args)))
+ new_tag = (GtkTextTag *)(s7_c_pointer(s7_cadr(s7_cadr(args))));
+
+ glistener_set_prompt_tag(unwrap_glistener(sc, "set listener prompt tag", s7_car(args)), new_tag);
+ return(s7_cadr(args));
+}
+
+/* (listener-set-prompt-tag *listener*
+ (gtk_text_buffer_create_tag
+ (GTK_TEXT_BUFFER (gtk_text_view_get_buffer (GTK_TEXT_VIEW (listener-text-widget *listener*))))
+ #f (list "weight" PANGO_WEIGHT_BOLD "foreground" "red")))
+*/
+
+
+static void glistener_init(glistener *g1)
+{
+ s7_define_function(s7, "listener-append-text", g_append_text, 2, 0, false, "(listener-append-text g txt)");
+ s7_define_function(s7, "listener-insert-text", g_insert_text, 2, 0, false, "(listener-insert-text g txt)");
+ s7_define_function(s7, "listener-cursor-position", g_cursor_position, 1, 0, false, "(listener-cursor-position g)");
+ s7_define_function(s7, "listener-set-cursor-position", g_set_cursor_position, 2, 0, false, "(listener-set-cursor-position g pos)");
+ s7_define_function(s7, "listener-text", g_text, 3, 0, false, "(listener-text g start end)");
+ s7_define_function(s7, "listener-append-prompt", g_append_prompt, 1, 0, false, "(listener-append-prompt g)");
+ s7_define_function(s7, "listener-prompt-position", g_prompt_position, 1, 0, false, "(listener-prompt-position g)");
+ s7_define_function(s7, "listener-set-prompt", g_set_prompt, 2, 0, false, "(listener-set-prompt g str)");
+ s7_define_function(s7, "listener-set-prompt-tag", g_set_prompt_tag, 2, 0, false, "(listener-set-prompt-tag g tag)");
+ s7_define_function(s7, "listener-evaluate", g_evaluate, 1, 0, false, "(listener-evaluate g)");
+ s7_define_function(s7, "listener-complete", g_complete, 1, 0, false, "(listener-complete g)");
+ s7_define_function(s7, "listener-scroll", g_scroll_to_end, 1, 0, false, "(listener-scroll g)");
+ s7_define_function(s7, "listener-clear", g_clear, 1, 0, false, "(listener-clear g)");
+ s7_define_function(s7, "listener-text-widget", g_text_widget, 1, 0, false, "(listener-text-widget g)");
+ s7_define_variable(s7, "*listener*", wrap_glistener(g1));
+}
+#endif
-#if HAVE_SCHEME
-static bool (*current_begin_hook)(s7_scheme *sc);
-static bool stacktrace_begin_hook(s7_scheme *sc)
+static bool listener_colorizing = false;
+bool listener_colorized(void) {return(listener_colorizing);}
+bool listener_set_colorized(bool val)
{
- s7_stacktrace(sc, s7_name_to_value(sc, "*stderr*"));
- s7_set_begin_hook(s7, current_begin_hook);
- return(false);
+#if HAVE_SCHEME
+ listener_colorizing = val;
+ s7_symbol_set_value(s7, ss->listener_colorized_symbol, s7_make_boolean(s7, val));
+ if (ss->listener)
+ {
+ if (val)
+ glistener_set_colorizer(ss->listener, colorizer);
+ else glistener_set_colorizer(ss->listener, NULL);
+ }
+#endif
+ return(val);
}
-/* TODO: this doesn't drop down during computation? */
-static void listener_stacktrace_callback(GtkWidget *w, gpointer info)
+#if HAVE_FORTH || HAVE_RUBY
+static void evaluator(glistener *g, const char *text)
{
- /* if we're running, replace the current begin_hook with one that grabs a stacktrace and
- * replaces itself with the previous one
- */
- current_begin_hook = s7_begin_hook(s7);
- if (current_begin_hook)
- s7_set_begin_hook(s7, stacktrace_begin_hook);
+ call_read_hook_or_eval(text); /* snd-listener.c */
}
#endif
-static void listener_popup_populate_callback(GtkTextView *view, GtkMenu *menu, gpointer ignored)
+static bool keyer(glistener *g, GtkWidget *w, GdkEventKey *e)
{
- /* this apparently only happens once */
- GtkWidget *w;
-
- /* prepending, so do everything backwards */
- w = gtk_separator_menu_item_new();
- gtk_menu_shell_prepend(GTK_MENU_SHELL(menu), w);
- gtk_widget_show(w);
-
- w = gtk_menu_item_new_with_label("Clear");
- gtk_menu_shell_prepend(GTK_MENU_SHELL(menu), w);
- g_signal_connect(w, "activate", G_CALLBACK(listener_clear_callback), NULL);
- gtk_widget_show(w);
-
- w = gtk_menu_item_new_with_label("Save");
- gtk_menu_shell_prepend(GTK_MENU_SHELL(menu), w);
- g_signal_connect(w, "activate", G_CALLBACK(listener_save_callback), NULL);
- gtk_widget_show(w);
-
-#if HAVE_SCHEME
- w = gtk_menu_item_new_with_label("Stacktrace");
- gtk_menu_shell_prepend(GTK_MENU_SHELL(menu), w);
- g_signal_connect(w, "activate", G_CALLBACK(listener_stacktrace_callback), NULL);
- gtk_widget_show(w);
-#endif
+ /* add C-g handling */
+ guint key;
+ GdkModifierType state;
- w = gtk_menu_item_new_with_label("Stop");
- gtk_menu_shell_prepend(GTK_MENU_SHELL(menu), w);
- g_signal_connect(w, "activate", G_CALLBACK(listener_stop_callback), NULL);
- gtk_widget_show(w);
+ key = EVENT_KEYVAL(e);
+ state = (GdkModifierType)EVENT_STATE(e);
+ if (((key == snd_K_g) || (key == snd_K_G)) &&
+ (state & snd_ControlMask))
+ {
+ ss->C_g_typed = true;
+ control_g(any_selected_sound());
+ }
- w = gtk_menu_item_new_with_label("Help");
- gtk_menu_shell_prepend(GTK_MENU_SHELL(menu), w);
- g_signal_connect(w, "activate", G_CALLBACK(listener_help_callback), NULL);
- gtk_widget_show(w);
+ return(false);
}
static void make_listener_widget(int height)
{
+#if HAVE_EXTENSION_LANGUAGE
if (!listener_text)
{
GtkWidget *frame;
@@ -962,35 +603,25 @@ static void make_listener_widget(int height)
gtk_paned_pack2(GTK_PANED(SOUND_PANE(ss)), frame, false, true); /* add2 but resize=false */
else gtk_container_add(GTK_CONTAINER(MAIN_PANE(ss)), frame);
- listener_text = make_scrolled_text(frame, true, 0, false);
- gtk_widget_set_name(listener_text, "listener_text");
-
- make_bindings(GTK_TEXT_VIEW_GET_CLASS(GTK_TEXT_VIEW(listener_text)));
-
- SG_SIGNAL_CONNECT(listener_text, "key_press_event", listener_key_press, NULL);
- SG_SIGNAL_CONNECT(listener_text, "key_release_event", listener_key_release, NULL);
- SG_SIGNAL_CONNECT(listener_text, "button_press_event", listener_button_press, NULL);
- SG_SIGNAL_CONNECT(listener_text, "button_release_event", listener_button_release, NULL);
- SG_SIGNAL_CONNECT(listener_text, "enter_notify_event", listener_focus_callback, NULL);
- SG_SIGNAL_CONNECT(listener_text, "leave_notify_event", listener_unfocus_callback, NULL);
- SG_SIGNAL_CONNECT(listener_text, "populate-popup", listener_popup_populate_callback, NULL);
- ss->listener_pane = listener_text;
-
- if (!prompt_not_editable)
- prompt_not_editable = gtk_text_buffer_create_tag(LISTENER_BUFFER, "prompt_not_editable",
- "editable", false,
- "weight", PANGO_WEIGHT_BOLD,
- NULL);
- {
- GtkTextIter pos;
- gtk_text_buffer_get_end_iter(LISTENER_BUFFER, &pos);
- gtk_text_buffer_insert_with_tags(LISTENER_BUFFER, &pos, listener_prompt(ss), ss->listener_prompt_length, prompt_not_editable, NULL);
- }
-
- gtk_widget_show(listener_text);
+ ss->listener = glistener_new(frame, listener_init);
+ glistener_set_evaluator(ss->listener, evaluator);
+ glistener_set_keyer(ss->listener, keyer);
- /* an attempt to add the completions list here as the end of an hbox failed */
+#if HAVE_SCHEME
+ glistener_set_helper(ss->listener, helper);
+#if HAVE_CHECKER
+ glistener_set_checker(ss->listener, checker);
+#endif
+ glistener_set_completer(ss->listener, completer);
+ if (listener_colorizing)
+ glistener_set_colorizer(ss->listener, colorizer);
+ glistener_init(ss->listener);
+#endif
+#if HAVE_FORTH || HAVE_RUBY
+ glistener_is_schemish(ss->listener, false);
+#endif
}
+#endif
}
@@ -1003,32 +634,42 @@ void goto_listener(void)
void color_listener(color_info *pix)
{
ss->listener_color = pix;
- if (listener_text)
- widget_modify_base(listener_text, GTK_STATE_NORMAL, ss->listener_color);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->listener_color_symbol, Xen_wrap_pixel(pix));
+#endif
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ glistener_set_background_color(ss->listener, rgb_to_gdk_color(ss->listener_color));
+#else
+ glistener_set_background_color(ss->listener, (GdkRGBA *)(ss->listener_color));
+#endif
}
void color_listener_text(color_info *pix)
{
ss->listener_text_color = pix;
-#if (!HAVE_GTK_3)
- if (listener_text)
- gtk_widget_modify_text(listener_text, GTK_STATE_NORMAL, rgb_to_gdk_color(ss->listener_text_color));
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->listener_text_color_symbol, Xen_wrap_pixel(pix));
+#endif
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ glistener_set_text_color(ss->listener, rgb_to_gdk_color(ss->listener_text_color));
#else
- if (listener_text)
- gtk_widget_override_color(listener_text, GTK_STATE_NORMAL, (GdkRGBA *)(ss->listener_text_color));
+ glistener_set_text_color(ss->listener, (GdkRGBA *)(ss->listener_text_color));
#endif
}
void handle_listener(bool open)
{
- if ((open) && (!listener_text))
+ if (!open) return;
+ if (!listener_text)
{
make_listener_widget(100);
color_listener(ss->listener_color);
color_listener_text(ss->listener_text_color);
+
+ gtk_widget_hide(view_listener_menu);
}
if ((SOUND_PANE(ss)) && /* might be run -separate with no sound open */
@@ -1036,14 +677,10 @@ void handle_listener(bool open)
{
int hgt;
hgt = widget_height(SOUND_PANE(ss));
- if (open)
- {
- if (hgt > 100) /* we can get here before the sound window has opened, but with one pending.
- * the position is in terms of current size, which is useless in this case.
- */
- gtk_paned_set_position(GTK_PANED(SOUND_PANE(ss)), (gint)(hgt * .75));
- }
- else gtk_paned_set_position(GTK_PANED(SOUND_PANE(ss)), hgt);
+ if (hgt > 100) /* we can get here before the sound window has opened, but with one pending.
+ * the position is in terms of current size, which is useless in this case.
+ */
+ gtk_paned_set_position(GTK_PANED(SOUND_PANE(ss)), (gint)(hgt * .75));
}
}
@@ -1056,34 +693,34 @@ bool listener_exists(void)
int listener_height(void)
{
- if ((listener_text) && (widget_is_active(listener_text)))
- return(widget_height(listener_text));
- else return(0);
+ if (!listener_text)
+ return(0);
+ return(100);
}
int listener_width(void)
{
- if ((listener_text) && (widget_is_active(listener_text)))
- return(widget_width(listener_text));
- else return(0);
+ if (!listener_text)
+ return(0);
+ return(500);
}
-static XEN g_listener_selection(void)
+static Xen g_listener_selection(void)
{
#define H_listener_selection "(" S_listener_selection "): currently selected text in listener or " PROC_FALSE
- XEN res = XEN_FALSE;
+ Xen res = Xen_false;
if (listener_text)
{
GtkTextIter start, end;
- if (gtk_text_buffer_get_selection_bounds(LISTENER_BUFFER, &start, &end))
+ if (gtk_text_buffer_get_selection_bounds(listener_buffer, &start, &end))
{
char *txt;
- txt = gtk_text_buffer_get_text(LISTENER_BUFFER, &start, &end, true);
+ txt = gtk_text_buffer_get_text(listener_buffer, &start, &end, true);
if (txt)
{
- res = C_TO_XEN_STRING(txt);
+ res = C_string_to_Xen_string(txt);
g_free(txt);
}
}
@@ -1094,64 +731,69 @@ static XEN g_listener_selection(void)
void set_listener_text_font(void)
{
-#if (!HAVE_GTK_3)
- if (listener_text)
- gtk_widget_modify_font(GTK_WIDGET(listener_text), LISTENER_FONT(ss));
-#else
- if (listener_text)
- gtk_widget_override_font(GTK_WIDGET(listener_text), LISTENER_FONT(ss));
-#endif
+ /* (set! (listener-font) "Monospace 12") */
+ glistener_set_font(ss->listener, LISTENER_FONT(ss));
}
-static XEN g_reset_listener_cursor(void)
+static Xen g_reset_listener_cursor(void)
{
#define H_reset_listener_cursor "(" S_reset_listener_cursor "): reset listener cursor to the default pointer"
if (listener_text)
- gdk_window_set_cursor(WIDGET_TO_WINDOW(listener_text), ss->arrow_cursor);
- return(XEN_FALSE);
+ glistener_set_cursor_shape(ss->listener, ss->arrow_cursor);
+ return(Xen_false);
}
void clear_listener(void)
{
- if (listener_text)
- sg_text_delete(listener_text, 1, sg_cursor_position(listener_text));
+ if (ss->listener)
+ glistener_clear(ss->listener);
+}
+
+
+void append_listener_text(int end, const char *msg)
+{
+ /* "end" arg needed in Motif */
+ if (ss->listener)
+ glistener_append_text(ss->listener, msg);
}
-static XEN g_goto_listener_end(void)
+int save_listener_text(FILE *fp)
{
- #define H_goto_listener_end "(" S_goto_listener_end "): move cursor and scroll to bottom of listener pane"
- if (listener_text)
+ if (ss->listener)
{
- int chars;
- chars = gtk_text_buffer_get_char_count(LISTENER_BUFFER);
- if (chars > 0) sg_set_cursor(listener_text, chars + 1);
- return(C_TO_XEN_INT(chars));
+ if ((!listener_text) ||
+ (glistener_write(ss->listener, fp)))
+ return(0);
}
- return(XEN_FALSE);
+ return(-1);
+}
+
+
+static Xen g_goto_listener_end(void)
+{
+ #define H_goto_listener_end "(" S_goto_listener_end "): move cursor and scroll to bottom of listener pane"
+ if (ss->listener)
+ glistener_scroll_to_end(ss->listener);
+ return(Xen_false);
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_listener_selection_w, g_listener_selection)
-XEN_NARGIFY_0(g_reset_listener_cursor_w, g_reset_listener_cursor)
-XEN_NARGIFY_0(g_goto_listener_end_w, g_goto_listener_end)
-#else
-#define g_listener_selection_w g_listener_selection
-#define g_reset_listener_cursor_w g_reset_listener_cursor
-#define g_goto_listener_end_w g_goto_listener_end
-#endif
+
+Xen_wrap_no_args(g_listener_selection_w, g_listener_selection)
+Xen_wrap_no_args(g_reset_listener_cursor_w, g_reset_listener_cursor)
+Xen_wrap_no_args(g_goto_listener_end_w, g_goto_listener_end)
void g_init_gxlistener(void)
{
#if HAVE_SCHEME
- #define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (listener): called when the mouse \
+ #define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (widget): called when the mouse \
enters the lisp listener pane:\n\
- (add-hook! " S_mouse_enter_listener_hook "\n\
- (lambda (widget)\n\
- (" S_focus_widget " widget)))"
+ (hook-push " S_mouse_enter_listener_hook "\n\
+ (lambda (hook)\n\
+ (" S_focus_widget " (hook 'widget))))"
#endif
#if HAVE_RUBY
#define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (listener): called when the mouse \
@@ -1166,39 +808,45 @@ enters the lisp listener pane:\n\
" S_mouse_enter_listener_hook " lambda: <{ wid }> wid " S_focus_widget " ; add-hook!"
#endif
- #define H_mouse_leave_listener_hook S_mouse_leave_listener_hook " (listener): called when the mouse \
+ #define H_mouse_leave_listener_hook S_mouse_leave_listener_hook " (widget): called when the mouse \
leaves the lisp listener pane"
- mouse_enter_listener_hook = XEN_DEFINE_HOOK(S_mouse_enter_listener_hook, 1, H_mouse_enter_listener_hook); /* arg = listener_text widget */
- mouse_leave_listener_hook = XEN_DEFINE_HOOK(S_mouse_leave_listener_hook, 1, H_mouse_leave_listener_hook); /* arg = listener_text widget */
+ mouse_enter_listener_hook = Xen_define_hook(S_mouse_enter_listener_hook, "(make-hook 'widget)", 1, H_mouse_enter_listener_hook);
+ mouse_leave_listener_hook = Xen_define_hook(S_mouse_leave_listener_hook, "(make-hook 'widget)", 1, H_mouse_leave_listener_hook);
-#if HAVE_SCHEME
- #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
-(add-hook! " S_mouse_enter_text_hook "\n\
- (lambda (w)\n\
- (" S_focus_widget " w)))"
-#endif
-#if HAVE_RUBY
- #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
-$mouse_enter_text_hook.add_hook!(\"enter\") do |w|\n\
- focus_widget(w)\n\
- end"
-#endif
-#if HAVE_FORTH
- #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
-" S_mouse_enter_text_hook " lambda: <{ wid }> wid " S_focus_widget " ; add-hook!"
-#endif
-
- #define H_mouse_leave_text_hook S_mouse_leave_text_hook " (widget): called when the mouse leaves a text widget"
+ Xen_define_procedure(S_listener_selection, g_listener_selection_w, 0, 0, 0, H_listener_selection);
+ Xen_define_procedure(S_reset_listener_cursor, g_reset_listener_cursor_w, 0, 0, 0, H_reset_listener_cursor);
+ Xen_define_procedure(S_goto_listener_end, g_goto_listener_end_w, 0, 0, 0, H_goto_listener_end);
- mouse_enter_text_hook = XEN_DEFINE_HOOK(S_mouse_enter_text_hook, 1, H_mouse_enter_text_hook); /* arg = text widget */
- mouse_leave_text_hook = XEN_DEFINE_HOOK(S_mouse_leave_text_hook, 1, H_mouse_leave_text_hook); /* arg = text widget */
+ #define H_listener_click_hook S_listener_click_hook " (position): called when listener clicked; position is text pos of click in listener"
+ listener_click_hook = Xen_define_hook(S_listener_click_hook, "(make-hook 'position)", 1, H_listener_click_hook);
- XEN_DEFINE_PROCEDURE(S_listener_selection, g_listener_selection_w, 0, 0, 0, H_listener_selection);
- XEN_DEFINE_PROCEDURE(S_reset_listener_cursor, g_reset_listener_cursor_w, 0, 0, 0, H_reset_listener_cursor);
- XEN_DEFINE_PROCEDURE(S_goto_listener_end, g_goto_listener_end_w, 0, 0, 0, H_goto_listener_end);
-
- #define H_listener_click_hook S_listener_click_hook " (pos): called when listener clicked; pos is text pos of click in listener"
- listener_click_hook = XEN_DEFINE_HOOK(S_listener_click_hook, 1, H_listener_click_hook); /* arg = pos */
+#if HAVE_SCHEME
+ top_level_let = s7_nil(s7);
+ s7_define_variable(s7, "top-level-let",
+ s7_dilambda(s7, "top-level-let", g_top_level_let, 0, 0, g_set_top_level_let, 1, 0, "listener environment"));
+
+ s7_define_function(s7, "colorizer-colors", g_colorizer_colors, 0, 0, true, H_colorizer_colors);
+ s7_hook_set_functions(s7, s7_name_to_value(s7, "*load-hook*"),
+ s7_cons(s7,
+ s7_make_function(s7, "listener-load-hook", g_listener_load_hook, 1, 0, false, "listener *load-hook* function"),
+ s7_hook_functions(s7, s7_name_to_value(s7, "*load-hook*"))));
+#endif
}
+
+/* to get rid of
+ * Fontconfig error: Cannot load default config file
+ * and the consequent ridiculous fonts, since I think I built fontconfig from scratch,
+ * copy (as root) /etc/fonts/fonts.conf to /usr/local/etc/fonts/fonts.conf
+ *
+ * to disable the goddamn beep put
+ * gtk-error-bell = 0
+ * in /etc/gtk-2.0/gtkrc
+ *
+ * to build fontconfig, use --disable-docs (there's no way to make the docbook chain happy)
+ * atk-bridge-2.0 needed, glib needs automake 1.13.1, at-spi2-atk needs at-spi2-code which
+ * is incompatible with glib 2.37.0, my FC18 machine is dead, so I'm stuck. Wait for FC19...
+ *
+ * to implement stuff like find, the prompt might be in the status area?
+ */
diff --git a/snd-gmain.c b/snd-gmain.c
index ca63bf3..f32cd64 100644
--- a/snd-gmain.c
+++ b/snd-gmain.c
@@ -15,7 +15,7 @@
#define DATA_COLOR rgb_to_color(0.0, 0.0, 0.0) /* "black" */
#define SELECTED_DATA_COLOR rgb_to_color(0.0, 0.0, 0.0) /* "black" */
#define MARK_COLOR rgb_to_color(1.0, 0.0, 0.0) /* "red" */
-#define LISTENER_COLOR rgb_to_color(0.94, 0.97, 1.00) /* "AliceBlue" */
+#define LISTENER_COLOR rgb_to_color(1.0, 1.0, 1.0) /* "white" */ /* rgb_to_color(0.94, 0.97, 1.00) */ /* "AliceBlue" */
#define LISTENER_TEXT_COLOR rgb_to_color(0.0, 0.0, 0.0) /* "black" */
#define LIGHT_BLUE_COLOR rgb_to_color(0.79, 0.88, 1.00) /* "lightsteelblue1" */
#define LIGHTER_BLUE_COLOR rgb_to_color(0.94, 0.97, 1.00) /* "AliceBlue" */
@@ -27,6 +27,7 @@
#define TEXT_FOCUS_COLOR rgb_to_color(1.0, 1.0, 1.0) /* "white" */
#define FILTER_CONTROL_WAVEFORM_COLOR rgb_to_color(0.0, 0.0, 1.0) /* "blue" */
#define SASH_COLOR rgb_to_color(0.56, 0.93, 0.56) /* "lightgreen" */
+#define BLUE_COLOR rgb_to_color(0.0, 0.0, 1.0);
#define CHANNEL_SASH_INDENT -10
#define CHANNEL_SASH_SIZE 10
@@ -43,7 +44,6 @@
#define INITIAL_WINDOW_HEIGHT 300
-#ifndef SND_AS_WIDGET
static gint window_close(GtkWidget *w, GdkEvent *event, gpointer context)
{
if (snd_exit_cleanly(EXIT_FORCED))
@@ -92,47 +92,36 @@ static gint window_iconify(GtkWidget *w, GdkEventWindowState *event, gpointer co
}
return(false);
}
-#endif
-#if (!HAVE_FAM)
static guint auto_update_proc = 0;
static gint auto_update_check(gpointer context)
{
+ if (auto_update_proc != 0)
+ {
+ g_source_remove(auto_update_proc);
+ auto_update_proc = 0;
+ }
if (auto_update_interval(ss) > 0.0)
{
if (!(play_in_progress()))
for_each_sound(sound_not_current);
auto_update_proc = g_timeout_add_full(0, (guint32)(auto_update_interval(ss) * 1000), auto_update_check, context, NULL);
}
- else auto_update_proc = 0;
return(0);
}
-
void auto_update_restart(void)
{
if (auto_update_proc == 0)
- g_timeout_add_full(0, (guint32)(auto_update_interval(ss) * 1000), auto_update_check, NULL, NULL);
+ auto_update_proc = g_timeout_add_full(0, (guint32)(auto_update_interval(ss) * 1000), auto_update_check, NULL, NULL);
}
-#else
-void auto_update_restart(void) {}
-#endif
-
-#if HAVE_SETJMP_H
-#include <setjmp.h>
-#if MUS_TRAP_SEGFAULT
-/* stolen from scwm.c */
-static sigjmp_buf envHandleEventsLoop;
-static void segv(int ignored)
-{
- siglongjmp(envHandleEventsLoop, 1);
-}
-#endif
+#ifndef _MSC_VER
+#include <setjmp.h>
static jmp_buf top_level_jump;
@@ -181,9 +170,6 @@ static void get_stdin_string(gpointer context, gint fd, int condition)
static void setup_gcs(void)
{
- GdkWindow *wn;
- wn = MAIN_WINDOW(ss);
-
ss->basic_gc = gc_new();
gc_set_background(ss->basic_gc, ss->graph_color);
gc_set_foreground(ss->basic_gc, ss->data_color);
@@ -253,24 +239,28 @@ static void save_a_color(FILE *Fp, color_info *default_color, color_info *curren
#if HAVE_FORTH
fprintf(Fp, "%.3f %.3f %.3f %s set-%s drop\n",
- RGB_TO_FLOAT(current_color->red),
- RGB_TO_FLOAT(current_color->green),
- RGB_TO_FLOAT(current_color->blue),
+ rgb_to_float(current_color->red),
+ rgb_to_float(current_color->green),
+ rgb_to_float(current_color->blue),
S_make_color,
ext_name);
-#else
+#endif
#if HAVE_SCHEME
fprintf(Fp, "(set! (%s) (%s %.3f %.3f %.3f))\n",
+ to_proc_name(ext_name),
+ to_proc_name(S_make_color),
+ rgb_to_float(current_color->red),
+ rgb_to_float(current_color->green),
+ rgb_to_float(current_color->blue));
#endif
#if HAVE_RUBY
fprintf(Fp, "set_%s(%s(%.3f, %.3f, %.3f))\n",
-#endif
- TO_PROC_NAME(ext_name),
- TO_PROC_NAME(S_make_color),
- RGB_TO_FLOAT(current_color->red),
- RGB_TO_FLOAT(current_color->green),
- RGB_TO_FLOAT(current_color->blue));
-#endif /* not forth */
+ to_proc_name(ext_name),
+ to_proc_name(S_make_color),
+ rgb_to_float(current_color->red),
+ rgb_to_float(current_color->green),
+ rgb_to_float(current_color->blue));
+#endif
#endif /* ext lang */
free(default_color); /* macro has rgb_to_color which allocates */
@@ -279,24 +269,24 @@ static void save_a_color(FILE *Fp, color_info *default_color, color_info *curren
void save_colors(FILE *Fp)
{
- save_a_color(Fp, BASIC_COLOR, ss->basic_color, S_basic_color);
- save_a_color(Fp, CURSOR_COLOR, ss->cursor_color, S_cursor_color);
- save_a_color(Fp, DATA_COLOR, ss->data_color, S_data_color);
+ save_a_color(Fp, BASIC_COLOR, ss->basic_color, S_basic_color);
+ save_a_color(Fp, CURSOR_COLOR, ss->cursor_color, S_cursor_color);
+ save_a_color(Fp, DATA_COLOR, ss->data_color, S_data_color);
save_a_color(Fp, SELECTED_DATA_COLOR, ss->selected_data_color, S_selected_data_color);
- save_a_color(Fp, HIGHLIGHT_COLOR, ss->highlight_color, S_highlight_color);
- save_a_color(Fp, POSITION_COLOR, ss->position_color, S_position_color);
- save_a_color(Fp, ZOOM_COLOR, ss->zoom_color, S_zoom_color);
- save_a_color(Fp, SELECTION_COLOR, ss->selection_color, S_selection_color);
- save_a_color(Fp, MIX_COLOR, ss->mix_color, S_mix_color);
+ save_a_color(Fp, HIGHLIGHT_COLOR, ss->highlight_color, S_highlight_color);
+ save_a_color(Fp, POSITION_COLOR, ss->position_color, S_position_color);
+ save_a_color(Fp, ZOOM_COLOR, ss->zoom_color, S_zoom_color);
+ save_a_color(Fp, SELECTION_COLOR, ss->selection_color, S_selection_color);
+ save_a_color(Fp, MIX_COLOR, ss->mix_color, S_mix_color);
save_a_color(Fp, ENVED_WAVEFORM_COLOR, ss->enved_waveform_color, S_enved_waveform_color);
save_a_color(Fp, FILTER_CONTROL_WAVEFORM_COLOR, ss->filter_control_waveform_color, S_filter_control_waveform_color);
- save_a_color(Fp, LISTENER_COLOR, ss->listener_color, S_listener_color);
+ save_a_color(Fp, LISTENER_COLOR, ss->listener_color, S_listener_color);
save_a_color(Fp, LISTENER_TEXT_COLOR, ss->listener_text_color, S_listener_text_color);
- save_a_color(Fp, GRAPH_COLOR, ss->graph_color, S_graph_color);
+ save_a_color(Fp, GRAPH_COLOR, ss->graph_color, S_graph_color);
save_a_color(Fp, SELECTED_GRAPH_COLOR, ss->selected_graph_color, S_selected_graph_color);
- save_a_color(Fp, MARK_COLOR, ss->mark_color, S_mark_color);
- save_a_color(Fp, SASH_COLOR, ss->sash_color, S_sash_color);
- save_a_color(Fp, TEXT_FOCUS_COLOR, ss->text_focus_color, S_text_focus_color);
+ save_a_color(Fp, MARK_COLOR, ss->mark_color, S_mark_color);
+ save_a_color(Fp, SASH_COLOR, ss->sash_color, S_sash_color);
+ save_a_color(Fp, TEXT_FOCUS_COLOR, ss->text_focus_color, S_text_focus_color);
}
@@ -312,26 +302,26 @@ static gboolean io_invoke(GIOChannel *source, GIOCondition condition, gpointer d
static void startup_funcs(void)
{
static int auto_open_ctr = 0;
+ ss->file_monitor_ok = true;
-#ifndef SND_AS_WIDGET
/* trap outer-level Close for cleanup check */
SG_SIGNAL_CONNECT(MAIN_SHELL(ss), "delete_event", window_close, NULL);
/* when iconified, we need to hide any dialogs as well */
SG_SIGNAL_CONNECT(MAIN_SHELL(ss), "window_state_event", window_iconify, NULL);
-#endif
- ss->graph_cursor = gdk_cursor_new((GdkCursorType)in_graph_cursor(ss));
- ss->wait_cursor = gdk_cursor_new(GDK_WATCH);
- ss->bounds_cursor = gdk_cursor_new(GDK_SB_H_DOUBLE_ARROW);
- ss->play_cursor = gdk_cursor_new(GDK_SB_RIGHT_ARROW);
- ss->loop_play_cursor = gdk_cursor_new(GDK_SB_LEFT_ARROW);
- ss->arrow_cursor = gdk_cursor_new(GDK_LEFT_PTR);
+ ss->graph_cursor = GDK_CURSOR_NEW((GdkCursorType)in_graph_cursor(ss));
+ ss->wait_cursor = GDK_CURSOR_NEW(GDK_WATCH);
+ ss->bounds_cursor = GDK_CURSOR_NEW(GDK_SB_H_DOUBLE_ARROW);
+ ss->yaxis_cursor = GDK_CURSOR_NEW(GDK_SB_V_DOUBLE_ARROW);
+ ss->play_cursor = GDK_CURSOR_NEW(GDK_SB_RIGHT_ARROW);
+ ss->loop_play_cursor = GDK_CURSOR_NEW(GDK_SB_LEFT_ARROW);
+ ss->arrow_cursor = GDK_CURSOR_NEW(GDK_LEFT_PTR);
#if HAVE_EXTENSION_LANGUAGE
snd_load_init_file(noglob, noinit);
#endif
-#if HAVE_SIGNAL && HAVE_EXTENSION_LANGUAGE && !__MINGW32__
+#if (!_MSC_VER) && HAVE_EXTENSION_LANGUAGE && !__MINGW32__
if (!nostdin)
{
GIOChannel *channel;
@@ -353,21 +343,16 @@ static void startup_funcs(void)
while (auto_open_ctr < auto_open_files)
auto_open_ctr = handle_next_startup_arg(auto_open_ctr, auto_open_file_names, true, auto_open_files);
-#ifndef SND_AS_WIDGET
if ((ss->init_window_width > 0) && (ss->init_window_height > 0))
set_widget_size(GTK_WIDGET(MAIN_SHELL(ss)), ss->init_window_width, ss->init_window_height);
if ((ss->init_window_x != DEFAULT_INIT_WINDOW_X) && (ss->init_window_y != DEFAULT_INIT_WINDOW_Y))
set_widget_position(GTK_WIDGET(MAIN_SHELL(ss)), ss->init_window_x, ss->init_window_y);
-#endif
-
-#if (!HAVE_FAM)
- if (auto_update_interval(ss) > 0.0)
- g_timeout_add_full(0, (guint32)(auto_update_interval(ss) * 1000), auto_update_check, NULL, NULL);
-#endif
-#if MUS_TRAP_SEGFAULT
- if (trap_segfault(ss)) signal(SIGSEGV, segv);
-#endif
+ if (!(ss->file_monitor_ok))
+ {
+ if (auto_update_interval(ss) > 0.0)
+ g_timeout_add_full(0, (guint32)(auto_update_interval(ss) * 1000), auto_update_check, NULL, NULL);
+ }
if ((ss->sounds) &&
(ss->selected_sound == NO_SELECTION))
@@ -382,12 +367,10 @@ static void startup_funcs(void)
}
-#ifndef SND_AS_WIDGET
static void set_up_icon(void)
{
gtk_window_set_icon(GTK_WINDOW(MAIN_SHELL(ss)), gdk_pixbuf_new_from_xpm_data(snd_icon_bits()));
}
-#endif
color_t get_in_between_color(color_t fg, color_t bg)
@@ -423,38 +406,25 @@ static void notebook_switch_page(GtkNotebook *w, GtkWidget *page_widget, gint pa
}
-#ifdef SND_AS_WIDGET
-GtkWidget *snd_as_widget(int argc, char **argv, GtkWidget *parent, void (*error_func)(const char *msg))
-{
-
-#else
-
void snd_doit(int argc, char **argv)
{
-#endif
GtkWidget *shell;
int i;
-#ifdef SND_AS_WIDGET
- set_error_display(error_func);
- ss = snd_main(argc, argv);
-#else
gtk_init(&argc, &argv);
-#if (!HAVE_GTK_3)
-#ifndef HAVE_OSX
+#if (!GTK_CHECK_VERSION(3, 0, 0)) && (!__APPLE__)
gdk_set_locale();
#endif
-#endif
-
-#endif
ss->channel_min_height = CHANNEL_MIN_HEIGHT;
ss->Graph_Cursor = DEFAULT_GRAPH_CURSOR;
-#ifndef SND_AS_WIDGET
shell = gtk_window_new(GTK_WINDOW_TOPLEVEL);
sg_make_resizable(shell);
+
+#ifndef _MSC_VER
+ setlocale(LC_NUMERIC, "C");
#endif
auto_open_files = argc-1;
@@ -462,39 +432,39 @@ void snd_doit(int argc, char **argv)
ss->startup_title = mus_strdup("snd");
set_sound_style(SOUNDS_VERTICAL);
for (i = 1; i < argc; i++)
- if ((strcmp(argv[i], "-h") == 0) ||
- (strcmp(argv[i], "-horizontal") == 0) ||
- (strcmp(argv[i], "--horizontal") == 0))
+ if ((mus_strcmp(argv[i], "-h")) ||
+ (mus_strcmp(argv[i], "-horizontal")) ||
+ (mus_strcmp(argv[i], "--horizontal")))
set_sound_style(SOUNDS_HORIZONTAL);
else
- if ((strcmp(argv[i], "-v") == 0) ||
- (strcmp(argv[i], "-vertical") == 0) ||
- (strcmp(argv[i], "--vertical") == 0))
+ if ((mus_strcmp(argv[i], "-v")) ||
+ (mus_strcmp(argv[i], "-vertical")) ||
+ (mus_strcmp(argv[i], "--vertical")))
set_sound_style(SOUNDS_VERTICAL);
else
- if ((strcmp(argv[i], "-notebook") == 0) ||
- (strcmp(argv[i], "--notebook") == 0))
+ if ((mus_strcmp(argv[i], "-notebook")) ||
+ (mus_strcmp(argv[i], "--notebook")))
set_sound_style(SOUNDS_IN_NOTEBOOK);
else
- if ((strcmp(argv[i], "-separate") == 0) ||
- (strcmp(argv[i], "--separate") == 0))
+ if ((mus_strcmp(argv[i], "-separate")) ||
+ (mus_strcmp(argv[i], "--separate")))
set_sound_style(SOUNDS_IN_SEPARATE_WINDOWS);
else
- if (strcmp(argv[i], "-noglob") == 0)
+ if (mus_strcmp(argv[i], "-noglob"))
noglob = true;
else
- if (strcmp(argv[i], "-noinit") == 0)
+ if (mus_strcmp(argv[i], "-noinit"))
noinit = true;
else
- if (strcmp(argv[i], "-nostdin") == 0)
+ if (mus_strcmp(argv[i], "-nostdin"))
nostdin = true;
else
- if ((strcmp(argv[i], "-b") == 0) ||
- (strcmp(argv[i], "-batch") == 0) ||
- (strcmp(argv[i], "--batch") == 0))
+ if ((mus_strcmp(argv[i], "-b")) ||
+ (mus_strcmp(argv[i], "-batch")) ||
+ (mus_strcmp(argv[i], "--batch")))
batch = true;
else
- if (strcmp(argv[i], "--features") == 0) /* testing (compsnd) */
+ if (mus_strcmp(argv[i], "--features")) /* testing (compsnd) */
check_features_list(argv[i + 1]);
ss->batch_mode = batch;
@@ -515,6 +485,7 @@ void snd_doit(int argc, char **argv)
ss->lighter_blue = LIGHTER_BLUE_COLOR;
ss->red = RED_COLOR;
ss->green = GREEN_COLOR;
+ ss->blue = BLUE_COLOR;
ss->yellow = YELLOW_COLOR;
ss->highlight_color = HIGHLIGHT_COLOR;
ss->basic_color = BASIC_COLOR;
@@ -535,6 +506,27 @@ void snd_doit(int argc, char **argv)
ss->sash_color = SASH_COLOR;
ss->text_focus_color = TEXT_FOCUS_COLOR;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->highlight_color_symbol, Xen_wrap_pixel(ss->highlight_color));
+ s7_symbol_set_value(s7, ss->basic_color_symbol, Xen_wrap_pixel(ss->basic_color));
+ s7_symbol_set_value(s7, ss->position_color_symbol, Xen_wrap_pixel(ss->position_color));
+ s7_symbol_set_value(s7, ss->zoom_color_symbol, Xen_wrap_pixel(ss->zoom_color));
+ s7_symbol_set_value(s7, ss->cursor_color_symbol, Xen_wrap_pixel(ss->cursor_color));
+ s7_symbol_set_value(s7, ss->selection_color_symbol, Xen_wrap_pixel(ss->selection_color));
+ s7_symbol_set_value(s7, ss->mix_color_symbol, Xen_wrap_pixel(ss->mix_color));
+ s7_symbol_set_value(s7, ss->enved_waveform_color_symbol, Xen_wrap_pixel(ss->enved_waveform_color));
+ s7_symbol_set_value(s7, ss->filter_control_waveform_color_symbol, Xen_wrap_pixel(ss->filter_control_waveform_color));
+ s7_symbol_set_value(s7, ss->listener_color_symbol, Xen_wrap_pixel(ss->listener_color));
+ s7_symbol_set_value(s7, ss->listener_text_color_symbol, Xen_wrap_pixel(ss->listener_text_color));
+ s7_symbol_set_value(s7, ss->graph_color_symbol, Xen_wrap_pixel(ss->graph_color));
+ s7_symbol_set_value(s7, ss->selected_graph_color_symbol, Xen_wrap_pixel(ss->selected_graph_color));
+ s7_symbol_set_value(s7, ss->data_color_symbol, Xen_wrap_pixel(ss->data_color));
+ s7_symbol_set_value(s7, ss->selected_data_color_symbol, Xen_wrap_pixel(ss->selected_data_color));
+ s7_symbol_set_value(s7, ss->mark_color_symbol, Xen_wrap_pixel(ss->mark_color));
+ s7_symbol_set_value(s7, ss->sash_color_symbol, Xen_wrap_pixel(ss->sash_color));
+ s7_symbol_set_value(s7, ss->text_focus_color_symbol, Xen_wrap_pixel(ss->text_focus_color));
+#endif
+
ss->grid_color = get_in_between_color(ss->data_color, ss->graph_color);
ss->selected_grid_color = get_in_between_color(ss->selected_data_color, ss->selected_graph_color);
@@ -575,8 +567,9 @@ void snd_doit(int argc, char **argv)
(!(set_bold_peaks_font(FALLBACK_FONT))))
fprintf(stderr, "can't find bold peaks font: %s", DEFAULT_BOLD_PEAKS_FONT);
- if (!(set_listener_font(FALLBACK_FONT)))
- fprintf(stderr, "can't find listener font: %s", FALLBACK_FONT);
+ if ((!(set_listener_font(DEFAULT_LISTENER_FONT))) &&
+ (!(set_listener_font(FALLBACK_FONT))))
+ fprintf(stderr, "can't find listener font: %s", DEFAULT_LISTENER_FONT);
ss->orig_axis_label_font = mus_strdup(axis_label_font(ss));
ss->orig_axis_numbers_font = mus_strdup(axis_numbers_font(ss));
@@ -585,31 +578,31 @@ void snd_doit(int argc, char **argv)
ss->orig_listener_font = mus_strdup(listener_font(ss));
ss->orig_tiny_font = mus_strdup(tiny_font(ss));
-#if (!HAVE_GTK_3)
+#if (!(GTK_CHECK_VERSION(3, 0, 0)))
init_gtk();
#endif
MAIN_PANE(ss) = gtk_vbox_new(false, 0); /* not homogenous, spacing 0 */
-#if (HAVE_GTK_3)
+#if (GTK_CHECK_VERSION(3, 0, 0))
init_gtk();
#endif
-#ifdef SND_AS_WIDGET
- MAIN_SHELL(ss) = parent;
- shell = MAIN_PANE(ss);
-#else
MAIN_SHELL(ss) = shell;
gtk_container_add(GTK_CONTAINER(MAIN_SHELL(ss)), MAIN_PANE(ss));
-#endif
+
add_menu(); /* adds menubar to MAIN_PANE (via box_pack_start) */
if (with_toolbar(ss)) show_toolbar();
if (sound_style(ss) != SOUNDS_IN_SEPARATE_WINDOWS)
{
+ /* hseparator here looks bad */
+
SOUND_PANE(ss) = gtk_vpaned_new();
+ add_paned_style(SOUND_PANE(ss));
gtk_container_set_border_width(GTK_CONTAINER(SOUND_PANE(ss)), 0);
gtk_container_add(GTK_CONTAINER(MAIN_PANE(ss)), SOUND_PANE(ss));
+
if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
{
SOUND_PANE_BOX(ss) = gtk_notebook_new();
@@ -621,6 +614,10 @@ void snd_doit(int argc, char **argv)
if (sound_style(ss) == SOUNDS_HORIZONTAL)
SOUND_PANE_BOX(ss) = gtk_hbox_new(false, 0);
else SOUND_PANE_BOX(ss) = gtk_vbox_new(false, 0);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ gtk_widget_set_hexpand(GTK_WIDGET(SOUND_PANE_BOX(ss)), true);
+ gtk_widget_set_vexpand(GTK_WIDGET(SOUND_PANE_BOX(ss)), true);
+#endif
}
gtk_paned_add1(GTK_PANED(SOUND_PANE(ss)), SOUND_PANE_BOX(ss));
gtk_widget_show(SOUND_PANE_BOX(ss));
@@ -629,41 +626,26 @@ void snd_doit(int argc, char **argv)
gtk_widget_show(MAIN_PANE(ss));
gtk_widget_show(MAIN_SHELL(ss));
-#ifndef SND_AS_WIDGET
#if HAVE_GTK_ADJUSTMENT_GET_UPPER
MAIN_WINDOW(ss) = gtk_widget_get_window(MAIN_SHELL(ss));
#else
MAIN_WINDOW(ss) = MAIN_SHELL(ss)->window;
#endif
-#else
- MAIN_WINDOW(ss) = gtk_widget_get_parent_window(MAIN_SHELL(ss));
-#endif
setup_gcs();
if (batch) gtk_widget_hide(MAIN_SHELL(ss));
else gdk_window_resize(WIDGET_TO_WINDOW(MAIN_SHELL(ss)), INITIAL_WINDOW_WIDTH, INITIAL_WINDOW_HEIGHT);
- startup_funcs();
-#if HAVE_SETJMP_H
-#if MUS_TRAP_SEGFAULT
- if (sigsetjmp(envHandleEventsLoop, 1))
- {
- if (!(ss->exiting))
- snd_error_without_format("Caught seg fault (will try to continue):\n");
- else
- {
- snd_error_without_format("Caught seg fault while trying to exit.\n");
- exit(0);
- }
- }
-#endif
+#ifndef _MSC_VER
if (setjmp(top_level_jump))
{
if (!(ss->jump_ok))
snd_error_without_format("Caught top level error (will try to continue):\n");
else ss->jump_ok = false;
}
+ else
#endif
+ startup_funcs(); /* snd /tmp -> segfault if this happens before the setjmp(top_level_jump) */
if (ss->startup_errors)
{
@@ -672,17 +654,18 @@ void snd_doit(int argc, char **argv)
ss->startup_errors = NULL;
}
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
set_basic_color(ss->basic_color);
color_listener(ss->listener_color);
+
+ color_chan_components(ss->zoom_color, COLOR_ZOOM);
+ color_chan_components(ss->position_color, COLOR_POSITION);
#endif
+ if ((!listener_exists()) &&
+ (!(ss->sounds[0])))
+ handle_listener(true);
-#ifndef SND_AS_WIDGET
set_up_icon();
gtk_main();
-#else
- return(shell);
-#endif
}
-
diff --git a/snd-gmenu.c b/snd-gmenu.c
index b34d59c..0474558 100644
--- a/snd-gmenu.c
+++ b/snd-gmenu.c
@@ -2,11 +2,92 @@
#include "snd-menu.h"
+/* gprint */
+/* are the printed graphs truncated because the "printer" assumes some paper size?
+ */
+
+static GtkPrintSettings *settings = NULL;
+
+static void begin_print(GtkPrintOperation *operation, GtkPrintContext *context, gpointer data)
+{
+ gtk_print_operation_set_n_pages(operation, 1);
+}
+
+
+static void draw_page(GtkPrintOperation *operation, GtkPrintContext *context, gint page_num, gpointer data)
+{
+ chan_info *cp;
+
+ ss->cr = gtk_print_context_get_cairo_context(context);
+
+ switch (ss->print_choice)
+ {
+ case PRINT_SND:
+ cp = selected_channel();
+ display_channel_data_for_print(cp);
+ break;
+
+ case PRINT_ENV:
+ env_redisplay_with_print();
+ break;
+ }
+}
+
+
+static void end_print(GtkPrintOperation *operation, GtkPrintContext *context, gpointer data)
+{
+ ss->cr = NULL;
+}
+
+
+static void file_print_callback(GtkWidget *w, gpointer info)
+{
+ /* called from File:Print in main menu */
+ GtkPrintOperation *operation;
+ GtkPrintOperationResult res;
+ GError *error = NULL;
+
+ operation = gtk_print_operation_new ();
+ if (settings != NULL)
+ gtk_print_operation_set_print_settings(operation, settings);
+
+ g_signal_connect(G_OBJECT(operation), "begin-print", G_CALLBACK(begin_print), NULL);
+ g_signal_connect(G_OBJECT(operation), "draw-page", G_CALLBACK(draw_page), NULL);
+ g_signal_connect(G_OBJECT(operation), "end-print", G_CALLBACK(end_print), NULL);
+
+ res = gtk_print_operation_run(operation, GTK_PRINT_OPERATION_ACTION_PRINT_DIALOG, GTK_WINDOW(MAIN_SHELL(ss)), &error);
+ if (res == GTK_PRINT_OPERATION_RESULT_APPLY)
+ {
+ if (settings != NULL)
+ g_object_unref(settings);
+ settings = (GtkPrintSettings *)g_object_ref(gtk_print_operation_get_print_settings(operation));
+ }
+ g_object_unref(operation);
+
+ if (error)
+ {
+ snd_warning_without_format(error->message);
+ g_error_free (error);
+ }
+}
+
+
+widget_t make_file_print_dialog(bool managed, bool direct_to_printer)
+{
+ /* xen print-dialog code */
+ file_print_callback(NULL, NULL);
+ return(NULL);
+}
+
+
+/* gmenu */
+
static const char *ml[NUM_MENU_WIDGETS];
void set_menu_label(GtkWidget *w, const char *label) {if (w) set_button_label(w, label);}
+
/* -------------------------------- FILE MENU -------------------------------- */
static GtkWidget **recent_file_items = NULL;
@@ -95,10 +176,9 @@ static void file_menu_update_1(GtkWidget *w, gpointer info)
static void file_open_callback(GtkWidget *w, gpointer info) {make_open_file_dialog(FILE_READ_WRITE, true);}
static void file_view_callback(GtkWidget *w, gpointer info) {make_open_file_dialog(FILE_READ_ONLY, true);}
static void file_new_callback(GtkWidget *w, gpointer info) {make_new_file_dialog(true);}
-static void file_record_callback(GtkWidget *w, gpointer info) {record_file();}
static void file_close_callback(GtkWidget *w, gpointer info) {if (any_selected_sound()) snd_close_file(any_selected_sound());}
static void file_close_all_callback(GtkWidget *w, gpointer info) {for_each_sound(snd_close_file);}
-static void file_save_callback(GtkWidget *w, gpointer info) {if (any_selected_sound()) save_edits_with_prompt(any_selected_sound());}
+static void file_save_callback(GtkWidget *w, gpointer info) {if (any_selected_sound()) save_edits_from_kbd(any_selected_sound());}
static void file_update_callback(GtkWidget *w, gpointer info) {update_file_from_menu();}
static void file_save_as_callback(GtkWidget *w, gpointer info) {make_sound_save_as_dialog(true);}
static void file_revert_callback(GtkWidget *w, gpointer info) {revert_file_from_menu();}
@@ -122,6 +202,7 @@ static void edit_undo_callback(GtkWidget *w, gpointer info) {undo_edit_with_sync
static void edit_redo_callback(GtkWidget *w, gpointer info) {redo_edit_with_sync(current_channel(), 1);}
+#if WITH_AUDIO
static void edit_play_callback(GtkWidget *w, gpointer info)
{
if (ss->selection_play_stop)
@@ -131,7 +212,7 @@ static void edit_play_callback(GtkWidget *w, gpointer info)
}
else
{
- set_menu_label(edit_play_menu, "Stop");
+ set_menu_label(edit_play_menu, I_STOP);
ss->selection_play_stop = true;
play_selection(IN_BACKGROUND);
}
@@ -143,6 +224,12 @@ void reflect_play_selection_stop(void)
set_menu_label(edit_play_menu, "Play Selection");
ss->selection_play_stop = false;
}
+#else
+
+void reflect_play_selection_stop(void)
+{
+}
+#endif
static void edit_header_callback_1(GtkWidget *w, gpointer info)
@@ -163,82 +250,7 @@ static void edit_find_callback_1(GtkWidget *w, gpointer info)
/* -------------------------------- VIEW MENU -------------------------------- */
-static GtkWidget **view_files_items = NULL, *view_files_cascade_menu = NULL;
-static int view_files_items_size = 0;
-
-static void view_files_item_callback(GtkWidget *w, gpointer info)
-{
- char *dirname;
- dirname = get_item_label(w);
- if (mus_strcmp(dirname, "new viewer"))
- start_view_files_dialog(true, true); /* managed and empty (brand-new) */
- else view_files_start_dialog_with_title(dirname);
-}
-
-
-static void view_files_callback(GtkWidget *w, gpointer info)
-{
- int size;
-
- size = view_files_dialog_list_length();
- if (size == 0)
- {
- start_view_files_dialog(true, true); /* managed and empty (brand-new) */
- }
- else
- {
- int i;
- char **view_files_names;
-
- view_files_names = view_files_dialog_titles();
- view_files_names[size++] = mus_strdup("new viewer");
-
- if (size > view_files_items_size)
- {
- if (view_files_items_size == 0)
- view_files_items = (GtkWidget **)calloc(size, sizeof(GtkWidget *));
- else
- {
- view_files_items = (GtkWidget **)realloc(view_files_items, size * sizeof(GtkWidget *));
- for (i = view_files_items_size; i < size; i++)
- view_files_items[i] = NULL;
- }
- view_files_items_size = size;
- }
-
- for (i = 0; i < size; i++)
- {
- if (view_files_items[i] == NULL)
- {
- view_files_items[i] = gtk_menu_item_new_with_label(view_files_names[i]);
- gtk_menu_shell_append(GTK_MENU_SHELL(view_files_cascade_menu), view_files_items[i]);
- gtk_widget_show(view_files_items[i]);
- SG_SIGNAL_CONNECT(view_files_items[i], "activate", view_files_item_callback, NULL);
- }
- else
- {
- set_item_label(view_files_items[i], view_files_names[i]);
- gtk_widget_show(view_files_items[i]);
- }
- free(view_files_names[i]);
- }
- free(view_files_names);
- }
-}
-
-
-static void view_menu_update_1(GtkWidget *w, gpointer info)
-{
- if ((view_files_dialog_list_length() > 0) &&
- (!view_files_cascade_menu))
- {
- view_files_cascade_menu = gtk_menu_new();
- gtk_menu_item_set_submenu(GTK_MENU_ITEM(view_files_menu), view_files_cascade_menu);
- }
-
- view_menu_update();
-}
-
+static void view_menu_update_1(GtkWidget *w, gpointer info) {view_menu_update();}
static void view_separate_callback(GtkWidget *w, gpointer info) {set_channel_style(CHANNELS_SEPARATE);}
static void view_combined_callback(GtkWidget *w, gpointer info) {set_channel_style(CHANNELS_COMBINED);}
@@ -249,7 +261,7 @@ static void view_filled_callback(GtkWidget *w, gpointer info) {set_graph_style(G
static void view_dots_and_lines_callback(GtkWidget *w, gpointer info) {set_graph_style(GRAPH_DOTS_AND_LINES);}
static void view_lollipops_callback(GtkWidget *w, gpointer info) {set_graph_style(GRAPH_LOLLIPOPS);}
static void view_zero_callback(GtkWidget *w, gpointer info) {set_show_y_zero((!(show_y_zero(ss))));}
-static void view_cursor_callback(GtkWidget *w, gpointer info) {set_verbose_cursor((!(verbose_cursor(ss))));}
+static void view_cursor_callback(GtkWidget *w, gpointer info) {set_with_verbose_cursor((!(with_verbose_cursor(ss))));}
static void view_controls_callback(GtkWidget *w, gpointer info) {set_show_controls(!in_show_controls(ss));}
#if HAVE_EXTENSION_LANGUAGE
@@ -260,8 +272,8 @@ static void view_inset_callback(GtkWidget *w, gpointer info)
}
#endif
-#if HAVE_EXTENSION_LANGUAGE
-static void view_listener_callback(GtkWidget *w, gpointer info) {handle_listener(!(listener_is_visible()));}
+#if HAVE_EXTENSION_LANGUAGE
+static void view_listener_callback(GtkWidget *w, gpointer info) {handle_listener(true);}
#endif
static void view_mix_dialog_callback(GtkWidget *w, gpointer info) {make_mix_dialog();}
@@ -287,20 +299,24 @@ static void view_focus_left_callback(GtkWidget *w, gpointer info, gpointer data)
static void view_focus_middle_callback(GtkWidget *w, gpointer info, gpointer data) {set_zoom_focus_style(ZOOM_FOCUS_MIDDLE);}
static void view_focus_active_callback(GtkWidget *w, gpointer info, gpointer data) {set_zoom_focus_style(ZOOM_FOCUS_ACTIVE);}
+static void view_grid_callback(GtkWidget *w, gpointer info)
+{
+ if (show_grid(ss) == NO_GRID)
+ set_show_grid(WITH_GRID);
+ else set_show_grid(NO_GRID);
+}
+
/* -------------------------------- OPTIONS MENU -------------------------------- */
-static void options_transform_callback(GtkWidget *w, gpointer info) {fire_up_transform_dialog(true);}
+static void options_transform_callback(GtkWidget *w, gpointer info) {make_transform_dialog(true);}
static void options_controls_callback(GtkWidget *w, gpointer info) {make_controls_dialog();}
-#if HAVE_EXTENSION_LANGUAGE
-static void options_save_callback(GtkWidget *w, gpointer info) {save_options_from_menu();}
-#endif
#if HAVE_EXTENSION_LANGUAGE
static void options_save_state_callback(GtkWidget *w, gpointer info) {save_state_from_menu();}
#endif
-static void options_preferences_callback(GtkWidget *w, gpointer info, gpointer data) {start_preferences_dialog();}
+static void options_preferences_callback(GtkWidget *w, gpointer info, gpointer data) {make_preferences_dialog();}
/* -------------------------------- HELP MENU -------------------------------- */
@@ -319,8 +335,7 @@ static void help_env_callback(GtkWidget *w, gpointer info) {env_help();}
static void help_marks_callback(GtkWidget *w, gpointer info) {marks_help();}
static void help_mix_callback(GtkWidget *w, gpointer info) {mix_help();}
static void help_sound_files_callback(GtkWidget *w, gpointer info) {sound_files_help();}
-static void help_recording_callback(GtkWidget *w, gpointer info) {recording_help();}
-static void help_keys_callback(GtkWidget *w, gpointer info) {key_binding_help();}
+static void help_keys_callback(GtkWidget *w, gpointer info) {key_help();}
static void help_play_callback(GtkWidget *w, gpointer info) {play_help();}
static void help_resample_callback(GtkWidget *w, gpointer info) {resample_help();}
static void help_reverb_callback(GtkWidget *w, gpointer info) {reverb_help();}
@@ -348,13 +363,13 @@ static bool have_drag_title = false;
static void menu_drag_watcher(GtkWidget *w, const char *str, int x, int y, drag_style_t dtype, void *data)
{
- char *new_title;
switch (dtype)
{
case DRAG_MOTION:
case DRAG_ENTER:
if (!have_drag_title)
{
+ char *new_title;
new_title = mus_format("%s: drop to open file", ss->startup_title);
gtk_window_set_title(GTK_WINDOW(MAIN_SHELL(ss)), new_title);
have_drag_title = true;
@@ -372,15 +387,20 @@ static void menu_drag_watcher(GtkWidget *w, const char *str, int x, int y, drag_
/* -------------------------------- MAIN MENU -------------------------------- */
-GtkWidget *add_menu_item(GtkWidget *menu, const char *label, const char *icon, GCallback callback)
+static GtkWidget *add_menu_item(GtkWidget *menu, const char *label, const char *icon, GCallback callback)
{
GtkWidget *w;
+#if GTK_CHECK_VERSION(3, 10, 0)
+ w = gtk_menu_item_new_with_label(label);
+ gtk_menu_shell_append(GTK_MENU_SHELL(menu), w);
+#else
if (icon)
w = gtk_image_menu_item_new_with_label(label);
else w = gtk_menu_item_new_with_label(label);
gtk_menu_shell_append(GTK_MENU_SHELL(menu), w);
if (icon)
- gtk_image_menu_item_set_image(GTK_IMAGE_MENU_ITEM(w), gtk_image_new_from_stock(icon, GTK_ICON_SIZE_MENU));
+ gtk_image_menu_item_set_image(GTK_IMAGE_MENU_ITEM(w), image_new_with_icon(icon, GTK_ICON_SIZE_MENU));
+#endif
if (callback)
SG_SIGNAL_CONNECT(w, "activate", callback, NULL);
gtk_widget_show(w);
@@ -429,6 +449,7 @@ GtkWidget *add_menu(void)
ml[m_menu] = NULL;
add_drag_and_drop(main_menu, menu_drop_watcher, menu_drag_watcher, NULL);
gtk_box_pack_start(GTK_BOX(MAIN_PANE(ss)), main_menu, false, true, 0);
+ add_menu_style(main_menu);
gtk_widget_show(main_menu);
@@ -437,67 +458,67 @@ GtkWidget *add_menu(void)
file_menu = gtk_menu_item_new_with_label("File");
ml[f_menu] = "File";
gtk_menu_shell_append(GTK_MENU_SHELL(main_menu), file_menu);
+ add_menu_style(file_menu);
gtk_widget_show(file_menu);
file_cascade_menu = gtk_menu_new();
+ add_menu_style(file_cascade_menu);
ml[f_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(file_menu), file_cascade_menu);
- file_open_menu = add_menu_item(file_cascade_menu, "Open", GTK_STOCK_OPEN, (GCallback)file_open_callback);
+ file_open_menu = add_menu_item(file_cascade_menu, "Open", ICON_OPEN, (GCallback)file_open_callback);
ml[f_open_menu] = "Open";
#if WITH_MENU_ACCELERATORS
gtk_widget_add_accelerator (file_open_menu, "activate", accel_group, GDK_O, GDK_HYPER_MASK | GDK_SHIFT_MASK, GTK_ACCEL_VISIBLE);
#endif
- file_open_recent_menu = add_menu_item(file_cascade_menu, "Open recent", GTK_STOCK_OPEN, (GCallback)file_open_recent_callback);
+ file_open_recent_menu = add_menu_item(file_cascade_menu, "Open recent", ICON_OPEN, (GCallback)file_open_recent_callback);
ml[f_open_recent_menu] = "Open recent";
gtk_widget_hide(file_open_recent_menu);
file_open_recent_cascade_menu = gtk_menu_new();
+ add_menu_style(file_open_recent_cascade_menu);
ml[f_open_recent_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(file_open_recent_menu), file_open_recent_cascade_menu);
- file_close_menu = add_insensitive_menu_item(file_cascade_menu, "Close", GTK_STOCK_CLOSE, (GCallback)file_close_callback);
+ file_close_menu = add_insensitive_menu_item(file_cascade_menu, "Close", ICON_CLOSE, (GCallback)file_close_callback);
ml[f_close_menu] = "Close";
- file_close_all_menu = add_menu_item(file_cascade_menu, "Close all", GTK_STOCK_CLOSE, (GCallback)file_close_all_callback);
+ file_close_all_menu = add_menu_item(file_cascade_menu, "Close all", ICON_CLOSE, (GCallback)file_close_all_callback);
ml[f_close_all_menu] = "Close all";
gtk_widget_hide(file_close_all_menu);
- file_save_menu = add_insensitive_menu_item(file_cascade_menu, "Save", GTK_STOCK_SAVE, (GCallback)file_save_callback);
+ file_save_menu = add_insensitive_menu_item(file_cascade_menu, "Save", ICON_SAVE, (GCallback)file_save_callback);
ml[f_save_menu] = "Save";
- file_save_as_menu = add_insensitive_menu_item(file_cascade_menu, "Save as", GTK_STOCK_SAVE_AS, (GCallback)file_save_as_callback);
+ file_save_as_menu = add_insensitive_menu_item(file_cascade_menu, "Save as", ICON_SAVE_AS, (GCallback)file_save_as_callback);
ml[f_save_as_menu] = "Save as";
- file_revert_menu = add_insensitive_menu_item(file_cascade_menu, "Revert", GTK_STOCK_REVERT_TO_SAVED, (GCallback)file_revert_callback);
+ file_revert_menu = add_insensitive_menu_item(file_cascade_menu, "Revert", ICON_REVERT_TO_SAVED, (GCallback)file_revert_callback);
ml[f_revert_menu] = "Revert";
- file_mix_menu = add_insensitive_menu_item(file_cascade_menu, "Mix", GTK_STOCK_ADD, (GCallback)file_mix_callback_1);
+ file_mix_menu = add_insensitive_menu_item(file_cascade_menu, "Mix", ICON_ADD, (GCallback)file_mix_callback_1);
ml[f_mix_menu] = "Mix";
- file_insert_menu = add_insensitive_menu_item(file_cascade_menu, "Insert", GTK_STOCK_PASTE, (GCallback)file_insert_callback_1);
+ file_insert_menu = add_insensitive_menu_item(file_cascade_menu, "Insert", ICON_PASTE, (GCallback)file_insert_callback_1);
ml[f_insert_menu] = "Insert";
- file_update_menu = add_insensitive_menu_item(file_cascade_menu, "Update", GTK_STOCK_REFRESH, (GCallback)file_update_callback);
+ file_update_menu = add_insensitive_menu_item(file_cascade_menu, "Update", ICON_REFRESH, (GCallback)file_update_callback);
ml[f_update_menu] = "Update";
- file_new_menu = add_menu_item(file_cascade_menu, "New", GTK_STOCK_NEW, (GCallback)file_new_callback);
+ file_new_menu = add_menu_item(file_cascade_menu, "New", ICON_NEW, (GCallback)file_new_callback);
ml[f_new_menu] = "New";
- file_record_menu = add_menu_item(file_cascade_menu, "Record", GTK_STOCK_MEDIA_RECORD, (GCallback)file_record_callback);
- ml[f_record_menu] = "Record";
-
- file_view_menu = add_menu_item(file_cascade_menu, "View", GTK_STOCK_OPEN, (GCallback)file_view_callback);
+ file_view_menu = add_menu_item(file_cascade_menu, "View", ICON_OPEN, (GCallback)file_view_callback);
ml[f_view_menu] = "View";
- file_print_menu = add_insensitive_menu_item(file_cascade_menu, "Print", GTK_STOCK_PRINT, (GCallback)file_print_callback_1);
+ file_print_menu = add_insensitive_menu_item(file_cascade_menu, "Print", ICON_PRINT, (GCallback)file_print_callback_1);
ml[f_print_menu] = "Print";
file_sep_menu = add_menu_separator(file_cascade_menu);
ml[f_sep_menu] = NULL;
- file_exit_menu = add_menu_item(file_cascade_menu, "Exit", GTK_STOCK_QUIT, (GCallback)file_exit_callback);
+ file_exit_menu = add_menu_item(file_cascade_menu, "Exit", ICON_QUIT, (GCallback)file_exit_callback);
ml[f_exit_menu] = "Exit";
@@ -506,45 +527,49 @@ GtkWidget *add_menu(void)
edit_menu = gtk_menu_item_new_with_label("Edit");
ml[e_menu] = "Edit";
gtk_menu_shell_append(GTK_MENU_SHELL(main_menu), edit_menu);
+ add_menu_style(edit_menu);
gtk_widget_show(edit_menu);
edit_cascade_menu = gtk_menu_new();
+ add_menu_style(edit_cascade_menu);
ml[e_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(edit_menu), edit_cascade_menu);
- edit_undo_menu = add_insensitive_menu_item(edit_cascade_menu, "Undo", GTK_STOCK_UNDO, (GCallback)edit_undo_callback);
+ edit_undo_menu = add_insensitive_menu_item(edit_cascade_menu, "Undo", ICON_UNDO, (GCallback)edit_undo_callback);
ml[e_undo_menu] = "Undo";
- edit_redo_menu = add_insensitive_menu_item(edit_cascade_menu, "Redo", GTK_STOCK_REDO, (GCallback)edit_redo_callback);
+ edit_redo_menu = add_insensitive_menu_item(edit_cascade_menu, "Redo", ICON_REDO, (GCallback)edit_redo_callback);
ml[e_redo_menu] = "Redo";
#if HAVE_EXTENSION_LANGUAGE
- edit_find_menu = add_insensitive_menu_item(edit_cascade_menu, "Find", GTK_STOCK_FIND, (GCallback)edit_find_callback_1);
- ml[e_find_menu] = "Find";
+ edit_find_menu = add_insensitive_menu_item(edit_cascade_menu, I_FIND, ICON_FIND, (GCallback)edit_find_callback_1);
+ ml[e_find_menu] = I_FIND;
#endif
edit_select_sep_menu = add_menu_separator(edit_cascade_menu);
ml[e_select_sep_menu] = NULL;
- edit_cut_menu = add_insensitive_menu_item(edit_cascade_menu, "Delete selection", GTK_STOCK_CUT, (GCallback)edit_cut_callback);
+ edit_cut_menu = add_insensitive_menu_item(edit_cascade_menu, "Delete selection", ICON_CUT, (GCallback)edit_cut_callback);
ml[e_cut_menu] = "Delete Selection";
- edit_paste_menu = add_insensitive_menu_item(edit_cascade_menu, "Insert selection", GTK_STOCK_PASTE, (GCallback)edit_paste_callback);
+ edit_paste_menu = add_insensitive_menu_item(edit_cascade_menu, "Insert selection", ICON_PASTE, (GCallback)edit_paste_callback);
ml[e_paste_menu] = "Insert Selection";
- edit_mix_menu = add_insensitive_menu_item(edit_cascade_menu, "Mix selection", GTK_STOCK_ADD, (GCallback)edit_mix_callback);
+ edit_mix_menu = add_insensitive_menu_item(edit_cascade_menu, "Mix selection", ICON_ADD, (GCallback)edit_mix_callback);
ml[e_mix_menu] = "Mix Selection";
- edit_play_menu = add_insensitive_menu_item(edit_cascade_menu, "Play selection", GTK_STOCK_MEDIA_PLAY, (GCallback)edit_play_callback);
+#if WITH_AUDIO
+ edit_play_menu = add_insensitive_menu_item(edit_cascade_menu, "Play selection", ICON_MEDIA_PLAY, (GCallback)edit_play_callback);
ml[e_play_menu] = "Play Selection";
+#endif
- edit_save_as_menu = add_insensitive_menu_item(edit_cascade_menu, "Save selection", GTK_STOCK_SAVE_AS, (GCallback)edit_save_as_callback);
+ edit_save_as_menu = add_insensitive_menu_item(edit_cascade_menu, "Save selection", ICON_SAVE_AS, (GCallback)edit_save_as_callback);
ml[e_save_as_menu] = "Save Selection";
- edit_select_all_menu = add_insensitive_menu_item(edit_cascade_menu, "Select all", GTK_STOCK_SELECT_ALL, (GCallback)edit_select_all_callback);
+ edit_select_all_menu = add_insensitive_menu_item(edit_cascade_menu, "Select all", ICON_SELECT_ALL, (GCallback)edit_select_all_callback);
ml[e_select_all_menu] = "Select all";
- edit_unselect_menu = add_insensitive_menu_item(edit_cascade_menu, "Unselect all", NULL, (GCallback)edit_unselect_callback);
+ edit_unselect_menu = add_insensitive_menu_item(edit_cascade_menu, "Unselect all", ICON_CLEAR, (GCallback)edit_unselect_callback);
ml[e_unselect_menu] = "Unselect all";
edit_edit_sep_menu = add_menu_separator(edit_cascade_menu);
@@ -553,7 +578,7 @@ GtkWidget *add_menu(void)
edit_env_menu = add_menu_item(edit_cascade_menu, "Edit envelope", NULL, (GCallback)edit_envelope_callback);
ml[e_env_menu] = "Edit Envelope";
- edit_header_menu = add_insensitive_menu_item(edit_cascade_menu, "Edit header", GTK_STOCK_EDIT, (GCallback)edit_header_callback_1);
+ edit_header_menu = add_insensitive_menu_item(edit_cascade_menu, "Edit header", ICON_EDIT, (GCallback)edit_header_callback_1);
ml[e_header_menu] = "Edit Header";
@@ -562,21 +587,21 @@ GtkWidget *add_menu(void)
view_menu = gtk_menu_item_new_with_label("View");
ml[v_menu] = "View";
gtk_menu_shell_append(GTK_MENU_SHELL(main_menu), view_menu);
+ add_menu_style(view_menu);
gtk_widget_show(view_menu);
view_cascade_menu = gtk_menu_new();
+ add_menu_style(view_cascade_menu);
ml[v_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(view_menu), view_cascade_menu);
- view_controls_menu = add_menu_item(view_cascade_menu, "Show controls", NULL, (GCallback)view_controls_callback);
- ml[v_controls_menu] = "Show controls";
-
#if HAVE_EXTENSION_LANGUAGE
view_listener_menu = add_menu_item(view_cascade_menu, "Open listener", NULL, (GCallback)view_listener_callback);
ml[v_listener_menu] = "Open listener";
+ /* handle_listener in snd-glistener hides this -- is it ever displayed? */
#endif
- view_files_menu = add_menu_item(view_cascade_menu, "Files", NULL, (GCallback)view_files_callback);
+ view_files_menu = add_insensitive_menu_item(view_cascade_menu, "Files", NULL, (GCallback)view_files_callback);
ml[v_files_menu] = "Files";
view_mix_dialog_menu = add_menu_item(view_cascade_menu, "Mixes", NULL, (GCallback)view_mix_dialog_callback);
@@ -585,17 +610,21 @@ GtkWidget *add_menu(void)
view_region_menu = add_insensitive_menu_item(view_cascade_menu, "Regions", NULL, (GCallback)view_region_callback_1);
ml[v_region_menu] = "Regions";
- view_color_orientation_menu = add_menu_item(view_cascade_menu, "Color/Orientation", NULL, (GCallback)view_color_orientation_callback_1);
+ view_color_orientation_menu = add_menu_item(view_cascade_menu, "Color/Orientation", ICON_SELECT_COLOR, (GCallback)view_color_orientation_callback_1);
ml[v_color_orientation_menu] = "Color/Orientation";
+ view_controls_menu = add_menu_item(view_cascade_menu, "Show controls", NULL, (GCallback)view_controls_callback);
+ ml[v_controls_menu] = "Show controls";
+
view_sep2_menu = add_menu_separator(view_cascade_menu);
ml[v_sep2_menu] = NULL;
- view_graph_style_menu = add_menu_item(view_cascade_menu, "Graph style", NULL, NULL);
- ml[v_graph_style_menu] = "Graph style";
+ view_graph_style_menu = add_menu_item(view_cascade_menu, I_LINES_OR_DOTS, NULL, NULL);
+ ml[v_graph_style_menu] = I_LINES_OR_DOTS;
view_graph_style_cascade_menu = gtk_menu_new();
+ add_menu_style(view_graph_style_cascade_menu);
ml[v_graph_style_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(view_graph_style_menu), view_graph_style_cascade_menu);
@@ -629,10 +658,11 @@ GtkWidget *add_menu(void)
#endif
- view_combine_menu = add_menu_item(view_cascade_menu, "Channel style", NULL, NULL);
- ml[v_combine_menu] = "Channel style";
+ view_combine_menu = add_menu_item(view_cascade_menu, I_CHANNEL_LAYOUT, NULL, NULL);
+ ml[v_combine_menu] = I_CHANNEL_LAYOUT;
view_combine_cascade_menu = gtk_menu_new();
+ add_menu_style(view_combine_cascade_menu);
ml[v_combine_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(view_combine_menu), view_combine_cascade_menu);
@@ -656,6 +686,7 @@ GtkWidget *add_menu(void)
ml[v_x_axis_menu] = "X axis units";
view_x_axis_cascade_menu = gtk_menu_new();
+ add_menu_style(view_x_axis_cascade_menu);
ml[v_x_axis_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(view_x_axis_menu), view_x_axis_cascade_menu);
@@ -678,10 +709,11 @@ GtkWidget *add_menu(void)
ml[v_x_axis_measures_menu] = "measures";
- view_axes_menu = add_menu_item(view_cascade_menu, "Axes", NULL, NULL);
- ml[v_axes_menu] = "Axes";
+ view_axes_menu = add_menu_item(view_cascade_menu, I_AXIS_LAYOUT, NULL, NULL);
+ ml[v_axes_menu] = I_AXIS_LAYOUT;
view_axes_cascade_menu = gtk_menu_new();
+ add_menu_style(view_axes_cascade_menu);
ml[v_axes_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(view_axes_menu), view_axes_cascade_menu);
@@ -704,10 +736,11 @@ GtkWidget *add_menu(void)
ml[v_bare_x_axis_menu] = "base x axis";
- view_focus_style_menu = add_menu_item(view_cascade_menu, "Zoom focus", NULL, NULL);
- ml[v_focus_style_menu] = "Zoom focus";
+ view_focus_style_menu = add_menu_item(view_cascade_menu, I_ZOOM_CENTERS_ON, NULL, NULL);
+ ml[v_focus_style_menu] = I_ZOOM_CENTERS_ON;
view_focus_cascade_menu = gtk_menu_new();
+ add_menu_style(view_focus_cascade_menu);
ml[v_focus_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(view_focus_style_menu), view_focus_cascade_menu);
@@ -724,28 +757,30 @@ GtkWidget *add_menu(void)
ml[v_focus_active_menu] = "cursor or selection";
+ view_grid_menu = add_menu_item(view_cascade_menu, "With grid", NULL, (GCallback)view_grid_callback);
+ ml[v_grid_menu] = "With grid";
+
/* -------- OPTIONS MENU -------- */
options_menu = gtk_menu_item_new_with_label("Options");
ml[o_menu] = "Options";
gtk_menu_shell_append(GTK_MENU_SHELL(main_menu), options_menu);
+ add_menu_style(options_menu);
gtk_widget_show(options_menu);
options_cascade_menu = gtk_menu_new();
+ add_menu_style(options_cascade_menu);
ml[o_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(options_menu), options_cascade_menu);
options_transform_menu = add_menu_item(options_cascade_menu, "Transform options", NULL, (GCallback)options_transform_callback);
ml[o_transform_menu] = "Transform Options";
- options_controls_menu = add_menu_item(options_cascade_menu, "Controls", NULL, (GCallback)options_controls_callback);
- ml[o_controls_menu] = "Controls";
+ options_controls_menu = add_menu_item(options_cascade_menu, "Control panel options", NULL, (GCallback)options_controls_callback);
+ ml[o_controls_menu] = "Control panel options";
#if HAVE_EXTENSION_LANGUAGE
- options_save_menu = add_menu_item(options_cascade_menu, "Save options", NULL, (GCallback)options_save_callback);
- ml[o_save_menu] = "Save options";
-
options_save_state_menu = add_menu_item(options_cascade_menu, "Save session", NULL, (GCallback)options_save_state_callback);
ml[o_save_state_menu] = "Save session";
#endif
@@ -753,20 +788,32 @@ GtkWidget *add_menu(void)
add_menu_separator(options_cascade_menu);
ml[o_sep_menu] = NULL;
- options_preferences_menu = add_menu_item(options_cascade_menu, "Preferences", NULL, (GCallback)options_preferences_callback);
+ options_preferences_menu = add_menu_item(options_cascade_menu, "Preferences", ICON_PREFERENCES, (GCallback)options_preferences_callback);
ml[o_preferences_menu] = "Preferences";
/* -------- HELP MENU -------- */
- help_menu = gtk_menu_item_new_with_label("Help");
- ml[h_menu] = "Help";
+ help_menu = gtk_menu_item_new_with_label(I_HELP);
+ ml[h_menu] = I_HELP;
gtk_menu_shell_append(GTK_MENU_SHELL(main_menu), help_menu);
+ add_menu_style(help_menu);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ /* gtk_widget_set_halign(GTK_WIDGET(help_menu), GTK_ALIGN_END);
+ * gtk_widget_set_hexpand(GTK_WIDGET(help_menu), true);
+ *
+ * this is no longer supported in Gtk -- they say "use gtk_widget_set_hexpand() and gtk_widget_set_halign()"
+ * but who gets the hexpand? not main_menu, not help_menu...
+ */
+#else
+ gtk_menu_item_set_right_justified(GTK_MENU_ITEM(help_menu), true);
+#endif
gtk_widget_show(help_menu);
- gtk_menu_item_set_right_justified(GTK_MENU_ITEM(help_menu), true);
+
help_cascade_menu = gtk_menu_new();
+ add_menu_style(help_cascade_menu);
ml[h_cascade_menu] = NULL;
gtk_menu_item_set_submenu(GTK_MENU_ITEM(help_menu), help_cascade_menu);
@@ -784,9 +831,6 @@ GtkWidget *add_menu(void)
help_keys_menu = add_menu_item(help_cascade_menu, "Key bindings", NULL, (GCallback)help_keys_callback);
ml[h_keys_menu] = "Key bindings";
- help_recording_menu = add_menu_item(help_cascade_menu, "Record", NULL, (GCallback)help_recording_callback);
- ml[h_recording_menu] = "Record";
-
help_play_menu = add_menu_item(help_cascade_menu, "Play", NULL, (GCallback)help_play_callback);
ml[h_play_menu] = "Play";
@@ -824,8 +868,8 @@ GtkWidget *add_menu(void)
ml[h_undo_menu] = "Undo and redo";
#if HAVE_EXTENSION_LANGUAGE
- help_find_menu = add_menu_item(help_cascade_menu, "Find", NULL, (GCallback)help_find_callback);
- ml[h_find_menu] = "Find";
+ help_find_menu = add_menu_item(help_cascade_menu, I_FIND, NULL, (GCallback)help_find_callback);
+ ml[h_find_menu] = I_FIND;
#endif
help_sync_menu = add_menu_item(help_cascade_menu, "Sync and unite", NULL, (GCallback)help_sync_callback);
@@ -882,36 +926,36 @@ static void popup_normalize_callback(GtkWidget *w, gpointer info)
}
-static void popup_apply_controls_callback(GtkWidget *w, gpointer info)
+static void popup_reverse_callback(GtkWidget *w, gpointer info)
{
- menu_apply_controls(any_selected_sound());
+ reverse_sound(current_channel(), OVER_SOUND, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
}
-static void popup_reset_controls_callback(GtkWidget *w, gpointer info)
+static void stop_everything_callback(GtkWidget *w, gpointer info)
{
- menu_reset_controls(any_selected_sound());
+ control_g(any_selected_sound());
}
-static void popup_reverse_callback(GtkWidget *w, gpointer info)
-{
- reverse_sound(current_channel(), OVER_SOUND, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
-}
-static void stop_everything_callback(GtkWidget *w, gpointer info)
+static void popup_play_channel_callback(GtkWidget *w, gpointer info)
{
- control_g(any_selected_sound());
+ chan_info *cp;
+ cp = current_channel();
+ play_channel(cp, 0, current_samples(cp));
}
-
+static GtkWidget *popup_play = NULL;
void post_basic_popup_menu(void *e)
{
GdkEventButton *ev = (GdkEventButton *)e;
+ snd_info *sp;
if (!basic_popup_menu)
{
basic_popup_menu = gtk_menu_new();
+ add_menu_style(basic_popup_menu);
gtk_widget_set_events(basic_popup_menu, GDK_ALL_EVENTS_MASK);
gtk_widget_show(basic_popup_menu);
@@ -919,13 +963,16 @@ void post_basic_popup_menu(void *e)
add_menu_item(basic_popup_menu, "Info", NULL, (GCallback)popup_info_callback);
add_menu_item(basic_popup_menu, "Select all", NULL, (GCallback)edit_select_all_callback);
+ popup_play = add_menu_item(basic_popup_menu, "Play channel", NULL, (GCallback)popup_play_channel_callback);
add_menu_item(basic_popup_menu, "Stop!", NULL, (GCallback)stop_everything_callback);
add_menu_item(basic_popup_menu, "-> 1.0", NULL, (GCallback)popup_normalize_callback);
add_menu_item(basic_popup_menu, "Reverse", NULL, (GCallback)popup_reverse_callback);
- add_menu_item(basic_popup_menu, "Apply controls", NULL, (GCallback)popup_apply_controls_callback);
- add_menu_item(basic_popup_menu, "Reset controls", NULL, (GCallback)popup_reset_controls_callback);
}
-
+
+ sp = any_selected_sound();
+ if ((!sp) || (sp->nchans == 1))
+ gtk_widget_hide(popup_play);
+ else gtk_widget_show(popup_play);
gtk_menu_popup(GTK_MENU(basic_popup_menu), NULL, NULL, NULL, NULL, POPUP_BUTTON, EVENT_TIME(ev));
}
@@ -955,7 +1002,7 @@ static void popup_error_handler(const char *msg, void *data)
{
redirect_snd_error_to(NULL, NULL);
redirect_snd_warning_to(NULL, NULL);
- report_in_minibuffer(any_selected_sound(), "%s: %s", (char *)data, msg);
+ status_report(any_selected_sound(), "%s: %s", (char *)data, msg);
}
static void popup_cut_to_new_callback_1(bool cut)
@@ -964,7 +1011,7 @@ static void popup_cut_to_new_callback_1(bool cut)
io_error_t io_err = IO_NO_ERROR;
temp_file = snd_tempnam();
- io_err = save_selection(temp_file, default_output_header_type(ss), default_output_data_format(ss), selection_srate(), NULL, SAVE_ALL_CHANS);
+ io_err = save_selection(temp_file, selection_srate(), default_output_sample_type(ss), default_output_header_type(ss), NULL, SAVE_ALL_CHANS);
if (io_err == IO_NO_ERROR)
{
if (cut) delete_selection(UPDATE_DISPLAY);
@@ -985,14 +1032,14 @@ static void crop(chan_info *cp)
{
if (selection_is_active_in_channel(cp))
{
- mus_long_t beg, end, frames;
- frames = CURRENT_SAMPLES(cp);
+ mus_long_t beg, end, framples;
+ framples = current_samples(cp);
beg = selection_beg(cp);
end = selection_end(cp);
if (beg > 0)
delete_samples(0, beg, cp, cp->edit_ctr);
- if (end < (frames - 1))
- delete_samples(end + 1, frames - end, cp, cp->edit_ctr);
+ if (end < (framples - 1))
+ delete_samples(end + 1, framples - end, cp, cp->edit_ctr);
}
}
@@ -1023,7 +1070,7 @@ static void popup_mark_selection_callback(GtkWidget *w, gpointer info)
static void popup_reverse_selection_callback(GtkWidget *w, gpointer info)
{
- reverse_sound(current_channel(), OVER_SELECTION, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
+ reverse_sound(current_channel(), OVER_SELECTION, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
}
static mus_float_t selection_max = 0.0;
@@ -1039,16 +1086,10 @@ static void popup_selection_info_callback(GtkWidget *w, gpointer info)
{
selection_max = 0.0;
for_each_chan(selection_info);
- report_in_minibuffer(any_selected_sound(), "selection max: %f", selection_max);
+ status_report(any_selected_sound(), "selection max: %f", selection_max);
}
-static void popup_selection_apply_controls_callback(GtkWidget *w, gpointer info)
-{
- ss->apply_choice = APPLY_TO_SELECTION;
- menu_apply_controls(any_selected_sound());
-}
-
-
+#if WITH_AUDIO
static void popup_loop_play_callback(GtkWidget *w, gpointer info)
{
if (ss->selection_play_stop)
@@ -1058,11 +1099,12 @@ static void popup_loop_play_callback(GtkWidget *w, gpointer info)
}
else
{
- set_menu_label(edit_play_menu, "Stop");
+ set_menu_label(edit_play_menu, I_STOP);
ss->selection_play_stop = true;
loop_play_selection();
}
}
+#endif
void post_selection_popup_menu(void *e)
@@ -1071,20 +1113,23 @@ void post_selection_popup_menu(void *e)
if (!selection_popup_menu)
{
selection_popup_menu = gtk_menu_new();
+ add_menu_style(selection_popup_menu);
gtk_widget_set_events(selection_popup_menu, GDK_ALL_EVENTS_MASK);
gtk_widget_show(selection_popup_menu);
SG_SIGNAL_CONNECT(selection_popup_menu, "button_release_event", popup_menu_button_release, NULL);
- add_menu_item(selection_popup_menu, "Fill Window", NULL, (GCallback)popup_show_selection_callback);
+ add_menu_item(selection_popup_menu, "Fill window", NULL, (GCallback)popup_show_selection_callback);
add_menu_item(selection_popup_menu, "Cut", NULL, (GCallback)edit_cut_callback);
add_menu_item(selection_popup_menu, "Cut and smooth", NULL, (GCallback)popup_cut_and_smooth_callback);
add_menu_item(selection_popup_menu, "Cut -> new", NULL, (GCallback)popup_cut_to_new_callback);
add_menu_item(selection_popup_menu, "Save as", NULL, (GCallback)edit_save_as_callback);
+#if WITH_AUDIO
add_menu_item(selection_popup_menu, "Play", NULL, (GCallback)edit_play_callback);
add_menu_item(selection_popup_menu, "Play looping", NULL, (GCallback)popup_loop_play_callback);
+#endif
add_menu_item(selection_popup_menu, "Crop", NULL, (GCallback)popup_crop_callback);
- add_menu_item(selection_popup_menu, "Unselect", NULL, (GCallback)edit_unselect_callback);
+ add_menu_item(selection_popup_menu, "Unselect all", NULL, (GCallback)edit_unselect_callback);
add_menu_item(selection_popup_menu, "Copy -> new", NULL, (GCallback)popup_copy_to_new_callback);
add_menu_item(selection_popup_menu, "-> 0.0", NULL, (GCallback)popup_zero_selection_callback);
add_menu_item(selection_popup_menu, "-> 1.0", NULL, (GCallback)popup_normalize_selection_callback);
@@ -1092,7 +1137,6 @@ void post_selection_popup_menu(void *e)
add_menu_item(selection_popup_menu, "Mix", NULL, (GCallback)edit_mix_callback);
add_menu_item(selection_popup_menu, "Mark", NULL, (GCallback)popup_mark_selection_callback);
add_menu_item(selection_popup_menu, "Reverse", NULL, (GCallback)popup_reverse_selection_callback);
- add_menu_item(selection_popup_menu, "Apply controls", NULL, (GCallback)popup_selection_apply_controls_callback);
add_menu_item(selection_popup_menu, "Info", NULL, (GCallback)popup_selection_info_callback);
}
@@ -1183,6 +1227,7 @@ void post_fft_popup_menu(void *e)
{
GtkWidget *outer_menu, *cascade_menu;
fft_popup_menu = gtk_menu_new();
+ add_menu_style(fft_popup_menu);
gtk_widget_set_events(fft_popup_menu, GDK_ALL_EVENTS_MASK);
gtk_widget_show(fft_popup_menu);
@@ -1190,6 +1235,7 @@ void post_fft_popup_menu(void *e)
outer_menu = add_menu_item(fft_popup_menu, "Size", NULL, NULL);
cascade_menu = gtk_menu_new();
+ add_menu_style(cascade_menu);
gtk_menu_item_set_submenu(GTK_MENU_ITEM(outer_menu), cascade_menu);
add_menu_item(cascade_menu, "16", NULL, (GCallback)fft_size_16_callback);
@@ -1205,6 +1251,7 @@ void post_fft_popup_menu(void *e)
outer_menu = add_menu_item(fft_popup_menu, "Window", NULL, NULL);
cascade_menu = gtk_menu_new();
+ add_menu_style(cascade_menu);
gtk_menu_item_set_submenu(GTK_MENU_ITEM(outer_menu), cascade_menu);
add_menu_item(cascade_menu, "rectangular", NULL, (GCallback)fft_window_rectangular_callback);
@@ -1231,6 +1278,7 @@ void post_fft_popup_menu(void *e)
outer_menu = add_menu_item(fft_popup_menu, "Graph type", NULL, NULL);
cascade_menu = gtk_menu_new();
+ add_menu_style(cascade_menu);
gtk_menu_item_set_submenu(GTK_MENU_ITEM(outer_menu), cascade_menu);
add_menu_item(cascade_menu, "one fft", NULL, (GCallback)fft_graph_once_callback);
@@ -1240,6 +1288,7 @@ void post_fft_popup_menu(void *e)
outer_menu = add_menu_item(fft_popup_menu, "Transform type", NULL, NULL);
cascade_menu = gtk_menu_new();
+ add_menu_style(cascade_menu);
gtk_menu_item_set_submenu(GTK_MENU_ITEM(outer_menu), cascade_menu);
add_menu_item(cascade_menu, "fourier", NULL, (GCallback)fft_type_fourier_callback);
@@ -1250,6 +1299,7 @@ void post_fft_popup_menu(void *e)
outer_menu = add_menu_item(fft_popup_menu, "Colormap", NULL, NULL);
cascade_menu = gtk_menu_new();
+ add_menu_style(cascade_menu);
gtk_menu_item_set_submenu(GTK_MENU_ITEM(outer_menu), cascade_menu);
add_menu_item(cascade_menu, "gray", NULL, (GCallback)fft_gray_callback);
@@ -1285,13 +1335,13 @@ void post_lisp_popup_menu(void *e) {}
void add_tooltip(GtkWidget *w, const char *tip)
{
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
gtk_widget_set_tooltip_text(w, tip);
#else
char *str;
int i, len;
len = mus_strlen(tip);
- str = (char *)calloc(len, sizeof(char));
+ str = (char *)calloc(len + 1, sizeof(char));
for (i = 0; i < len; i++)
{
if (tip[i] == '\n')
@@ -1304,14 +1354,32 @@ void add_tooltip(GtkWidget *w, const char *tip)
}
-static void add_to_toolbar(GtkWidget *bar, const gchar *stock, const char *tip, GCallback callback)
+/* suddenly in 3.3.12 the icon backgrounds are gray and everything has endless white space around it!
+ * now in 3.3.14, the whitespace is gone, but the backgrounds are following a different (white-base) cairo pattern -- sigh...
+ * and previously gray backgrounds are now black?
+ */
+
+static GtkWidget *add_to_toolbar(GtkWidget *bar, const gchar *stock, const char *tip, GCallback callback)
{
GtkToolItem *w;
+#if GTK_CHECK_VERSION(3, 10, 0)
+ GtkWidget *pw;
+ GtkIconTheme *icon_theme;
+ GdkPixbuf *pixbuf;
+ icon_theme = gtk_icon_theme_get_default();
+ pixbuf = gtk_icon_theme_load_icon(icon_theme, stock, 16, (GtkIconLookupFlags)0, NULL);
+ pw = gtk_image_new_from_pixbuf(pixbuf);
+ gtk_widget_show(pw);
+ w = gtk_tool_button_new(pw, NULL);
+#else
w = gtk_tool_button_new_from_stock(stock);
+#endif
+ add_toolbar_style(GTK_WIDGET(w));
gtk_toolbar_insert(GTK_TOOLBAR(bar), w, -1); /* -1 = at end */
add_tooltip(GTK_WIDGET(w), tip);
gtk_widget_show(GTK_WIDGET(w));
g_signal_connect(GTK_WIDGET(w), "clicked", callback, NULL);
+ return(GTK_WIDGET(w));
}
@@ -1324,6 +1392,7 @@ static void add_separator_to_toolbar(GtkWidget *bar)
}
+#if WITH_AUDIO
static void play_from_start_callback(GtkWidget *w, gpointer info)
{
snd_info *sp;
@@ -1342,7 +1411,7 @@ static void play_from_cursor_callback(GtkWidget *w, gpointer info)
chan_info *cp;
cp = any_selected_channel(sp);
if (cp)
- play_sound(sp, CURSOR(cp), NO_END_SPECIFIED);
+ play_sound(sp, cursor_sample(cp), NO_END_SPECIFIED);
}
}
@@ -1352,6 +1421,7 @@ static void stop_playing_callback(GtkWidget *w, gpointer info)
stop_playing_all_sounds(PLAY_C_G);
reflect_play_selection_stop(); /* this sets ss->selection_play_stop = false; */
}
+#endif
static void full_dur_callback(GtkWidget *w, gpointer info)
@@ -1430,6 +1500,7 @@ static void go_forward_callback(GtkWidget *w, gpointer info)
}
}
+
static void goto_end_callback(GtkWidget *w, gpointer info)
{
snd_info *sp;
@@ -1443,52 +1514,433 @@ static void goto_end_callback(GtkWidget *w, gpointer info)
}
+static gboolean close_selected_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ if ((!ask_about_unsaved_edits(ss)) &&
+ (has_unsaved_edits(sp)))
+ tip = mus_format("close %s (throwing away the current edits)", sp->short_filename);
+ else tip = mus_format("close %s", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "close the current sound");
+
+ /* gtk_tooltip_set_markup(tooltip, "<span background=\"#fffff0\">close the current sound</span>");
+ * this is almost right -- the padding (or margin?) is still in the ugly yellow color
+ * how to set that color??
+ */
+ return(true);
+}
+
+
+static gboolean save_selected_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ if (has_unsaved_edits(sp))
+ tip = mus_format("save edits to %s (overwriting)", sp->short_filename);
+ else tip = mus_format("save %s, but it has no unsaved edits", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "save the current sound");
+ return(true);
+}
+
+#if 0
+static gboolean save_as_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("save %s in a new file", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "save the current sound in a new file");
+ return(true);
+}
+#endif
+
+static gboolean revert_selected_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ if (has_unsaved_edits(sp))
+ tip = mus_format("return %s to its saved state, undoing the current edits", sp->short_filename);
+ else tip = mus_format("undo all edits in %s, but it has no edits", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "undo all edits in the current sound");
+ return(true);
+}
+
+
+static gboolean undo_selected_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ chan_info *cp;
+ cp = current_channel();
+ if (cp)
+ {
+ snd_info *sp;
+ char *tip;
+ sp = cp->sound;
+
+ if (cp->edit_ctr > 0)
+ {
+ if (syncd_channels(sp->sync) <= 1)
+ {
+ if (sp->nchans == 1)
+ tip = mus_format("undo the last edit to %s", sp->short_filename);
+ else tip = mus_format("undo the last edit to channel %d of %s", cp->chan, sp->short_filename);
+ }
+ else tip = mus_format("undo the last edit to %s (and also in anything sync'd with it)", sp->short_filename);
+ }
+ else
+ {
+ if (sp->nchans == 1)
+ tip = mus_format("undo an edit to %s, but it has no edits", sp->short_filename);
+ else tip = mus_format("undo an edit to channel %d of %s, but it has no edits", cp->chan, sp->short_filename);
+ }
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "undo the last edit to the current channel");
+ return(true);
+}
+
+#if 0
+static gboolean redo_selected_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ chan_info *cp;
+ cp = current_channel();
+ if (cp)
+ {
+ snd_info *sp;
+ char *tip;
+ sp = cp->sound;
+
+ if ((cp->edit_size > cp->edit_ctr) &&
+ (cp->edits[cp->edit_ctr + 1]))
+ {
+ if (syncd_channels(sp->sync) <= 1)
+ {
+ if (sp->nchans == 1)
+ tip = mus_format("redo one edit to %s", sp->short_filename);
+ else tip = mus_format("redo one edit to channel %d of %s", cp->chan, sp->short_filename);
+ }
+ else tip = mus_format("redo one edit to %s (and anything sync'd with it)", sp->short_filename);
+ }
+ else
+ {
+ if (sp->nchans == 1)
+ tip = mus_format("redo one edit %s, but it has no %sedits", sp->short_filename, (cp->edit_ctr == 0) ? "" : "redoable ");
+ else tip = mus_format("redo one edit to channel %d of %s, but it has no %sedits", cp->chan, sp->short_filename, (cp->edit_ctr == 0) ? "" : "redoable ");
+ }
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "redo one edit in the current channel");
+ return(true);
+}
+#endif
+
+#if WITH_AUDIO
+static gboolean play_selected_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("play %s from the top", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "play the current sound");
+ return(true);
+}
+
+
+static gboolean play_selected_from_cursor_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ chan_info *cp;
+ cp = any_selected_channel(sp);
+ tip = mus_format("play %s from the cursor (%.3f seconds in)", sp->short_filename, ((double)cursor_sample(cp)) / ((double)(snd_srate(sp))));
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "play the current sound from the cursor");
+ return(true);
+}
+#endif
+
+
+static gboolean full_dur_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("show all of %s", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "show all of the current sound");
+ return(true);
+}
+
+
+static gboolean zoom_out_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("show more of %s (zoom out)", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "show more of the current sound (zoom out)");
+ return(true);
+}
+
+
+static gboolean zoom_in_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("show less of %s (zoom in)", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "show less of the current sound (zoom in)");
+ return(true);
+}
+
+
+static gboolean goto_start_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("go to the beginning of %s", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "go to the beginning of the current sound");
+ return(true);
+}
+
+
+static gboolean goto_end_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("go to the end of %s", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "go to the end of the current sound");
+ return(true);
+}
+
+
+static gboolean go_back_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("go back one window in %s", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "go back one window in the current sound");
+ return(true);
+}
+
+
+static gboolean go_forward_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ char *tip;
+ tip = mus_format("go forward one window in %s", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "go forward one window in the current sound");
+ return(true);
+}
+
+#if 0
+static gboolean unselect_all_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ if (selection_is_active())
+ gtk_tooltip_set_text(tooltip, "unselect the currently selected portion");
+ else gtk_tooltip_set_text(tooltip, "when something is selected, this unselects it");
+ return(true);
+}
+#endif
+
+static gboolean delete_selection_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ if (selection_is_active())
+ gtk_tooltip_set_text(tooltip, "delete the currently selected portion");
+ else gtk_tooltip_set_text(tooltip, "when something is selected, this deletes it");
+ return(true);
+}
+
+
+static gboolean insert_selection_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ if (selection_is_active())
+ {
+ snd_info *sp;
+ char *tip;
+ chan_info *cp;
+
+ sp = any_selected_sound();
+ cp = any_selected_channel(sp);
+
+ tip = mus_format("insert the selected portion at the cursor (at time %.3f) in %s",
+ ((double)cursor_sample(cp)) / ((double)(snd_srate(sp))),
+ sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ }
+ else gtk_tooltip_set_text(tooltip, "when something is selected, this inserts it at the cursor in the current sound");
+ return(true);
+}
+
+
+
static GtkWidget *toolbar = NULL;
void show_toolbar(void)
{
if (!toolbar)
{
+ GtkWidget *w;
+
toolbar = gtk_toolbar_new();
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_toolbar_style(toolbar);
+ gtk_toolbar_set_icon_size(GTK_TOOLBAR(toolbar), GTK_ICON_SIZE_SMALL_TOOLBAR);
+#endif
gtk_box_pack_start(GTK_BOX(MAIN_PANE(ss)), toolbar, false, false, 0); /* MAIN_PANE = top level vbox */
gtk_box_reorder_child(GTK_BOX(MAIN_PANE(ss)), toolbar, 1); /* put toolbar just under the top level menubar */
- add_to_toolbar(toolbar, GTK_STOCK_NEW, "new sound", (GCallback)file_new_callback);
- add_to_toolbar(toolbar, GTK_STOCK_OPEN, "open sound", (GCallback)file_open_callback);
- add_to_toolbar(toolbar, GTK_STOCK_SAVE_AS, "save selected sound", (GCallback)file_save_as_callback);
- add_to_toolbar(toolbar, GTK_STOCK_REVERT_TO_SAVED, "revert to saved", (GCallback)file_revert_callback);
- add_to_toolbar(toolbar, GTK_STOCK_UNDO, "undo edit", (GCallback)edit_undo_callback);
- add_to_toolbar(toolbar, GTK_STOCK_REDO, "redo last (undone) edit", (GCallback)edit_redo_callback);
- add_to_toolbar(toolbar, GTK_STOCK_CLOSE, "close selected sound", (GCallback)file_close_callback);
+
+ add_to_toolbar(toolbar, ICON_NEW, "open a new sound", (GCallback)file_new_callback);
+ add_to_toolbar(toolbar, ICON_OPEN, "open a sound", (GCallback)file_open_callback);
+
+ w = add_to_toolbar(toolbar, ICON_SAVE, "save current sound, overwriting", (GCallback)file_save_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(save_selected_tooltip), NULL);
+#if 0
+ w = add_to_toolbar(toolbar, ICON_SAVE_AS, "save selected sound in new file", (GCallback)file_save_as_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(save_as_tooltip), NULL);
+#endif
+ w = add_to_toolbar(toolbar, ICON_REVERT_TO_SAVED, "revert to saved", (GCallback)file_revert_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(revert_selected_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_UNDO, "undo edit", (GCallback)edit_undo_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(undo_selected_tooltip), NULL);
+#if 0
+ w = add_to_toolbar(toolbar, ICON_REDO, "redo last (undone) edit", (GCallback)edit_redo_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(redo_selected_tooltip), NULL);
+#endif
+ w = add_to_toolbar(toolbar, ICON_CLOSE, "close selected sound", (GCallback)file_close_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(close_selected_tooltip), NULL);
add_separator_to_toolbar(toolbar);
- add_to_toolbar(toolbar, GTK_STOCK_MEDIA_PLAY, "play from the start", (GCallback)play_from_start_callback);
- add_to_toolbar(toolbar, GTK_STOCK_MEDIA_FORWARD, "play from the cursor", (GCallback)play_from_cursor_callback);
- add_to_toolbar(toolbar, GTK_STOCK_MEDIA_STOP, "stop playing", (GCallback)stop_playing_callback);
+
+#if WITH_AUDIO
+ w = add_to_toolbar(toolbar, ICON_MEDIA_PLAY, "play from the start", (GCallback)play_from_start_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(play_selected_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_MEDIA_FORWARD, "play from the cursor", (GCallback)play_from_cursor_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(play_selected_from_cursor_tooltip), NULL);
+
+ add_to_toolbar(toolbar, ICON_MEDIA_STOP, "stop playing", (GCallback)stop_playing_callback);
add_separator_to_toolbar(toolbar);
+#endif
+
- add_to_toolbar(toolbar, GTK_STOCK_FULLSCREEN, "show full sound", (GCallback)full_dur_callback);
- add_to_toolbar(toolbar, GTK_STOCK_ZOOM_OUT, "zoom out", (GCallback)zoom_out_callback);
- add_to_toolbar(toolbar, GTK_STOCK_ZOOM_IN, "zoom in", (GCallback)zoom_in_callback);
- add_to_toolbar(toolbar, GTK_STOCK_GOTO_FIRST, "go to start of sound", (GCallback)goto_start_callback);
- add_to_toolbar(toolbar, GTK_STOCK_GO_BACK, "go back a window", (GCallback)go_back_callback);
- add_to_toolbar(toolbar, GTK_STOCK_GO_FORWARD, "go forward a window", (GCallback)go_forward_callback);
- add_to_toolbar(toolbar, GTK_STOCK_GOTO_LAST, "go to end of sound", (GCallback)goto_end_callback);
+ w = add_to_toolbar(toolbar, ICON_FULLSCREEN, "show full sound", (GCallback)full_dur_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(full_dur_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_ZOOM_OUT, "zoom out", (GCallback)zoom_out_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(zoom_out_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_ZOOM_IN, "zoom in", (GCallback)zoom_in_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(zoom_in_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_GOTO_FIRST, "go to start of sound", (GCallback)goto_start_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(goto_start_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_GO_BACK, "go back a window", (GCallback)go_back_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(go_back_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_GO_FORWARD, "go forward a window", (GCallback)go_forward_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(go_forward_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_GOTO_LAST, "go to end of sound", (GCallback)goto_end_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(goto_end_tooltip), NULL);
add_separator_to_toolbar(toolbar);
#if 0
- add_to_toolbar(toolbar, GTK_STOCK_SELECT_ALL, "select all of sound", (GCallback)edit_select_all_callback);
- add_to_toolbar(toolbar, GTK_STOCK_CLEAR, "unselect everything", (GCallback)edit_unselect_callback);
-#endif
- add_to_toolbar(toolbar, GTK_STOCK_CUT, "delete selection", (GCallback)edit_cut_callback);
- add_to_toolbar(toolbar, GTK_STOCK_PASTE, "insert selection at cursor", (GCallback)edit_paste_callback);
-#if 0
+ add_to_toolbar(toolbar, ICON_SELECT_ALL, "select all of the current sound",(GCallback)edit_select_all_callback);
+
+ w = add_to_toolbar(toolbar, ICON_CLEAR, "unselect everything", (GCallback)edit_unselect_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(unselect_all_tooltip), NULL);
+#endif
+ w = add_to_toolbar(toolbar, ICON_CUT, "delete the selected portion",(GCallback)edit_cut_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(delete_selection_tooltip), NULL);
+
+ w = add_to_toolbar(toolbar, ICON_PASTE, "insert the selection at the cursor", (GCallback)edit_paste_callback);
+ g_signal_connect(w, "query-tooltip", G_CALLBACK(insert_selection_tooltip), NULL);
add_separator_to_toolbar(toolbar);
-#endif
- add_to_toolbar(toolbar, GTK_STOCK_PREFERENCES, "open preferences dialog", (GCallback)options_preferences_callback);
- add_to_toolbar(toolbar, GTK_STOCK_CANCEL, "stop the current operation", (GCallback)stop_everything_callback);
- add_to_toolbar(toolbar, GTK_STOCK_QUIT, "exit Snd", (GCallback)file_exit_callback);
+
+#if (!WITH_AUDIO)
+ add_to_toolbar(toolbar, ICON_PREFERENCES, "open the preferences dialog",(GCallback)options_preferences_callback);
+#endif
+ add_to_toolbar(toolbar, ICON_CANCEL, "stop everything", (GCallback)stop_everything_callback);
+ add_to_toolbar(toolbar, ICON_QUIT, "exit Snd", (GCallback)file_exit_callback);
}
gtk_widget_show(toolbar);
@@ -1526,13 +1978,13 @@ static int callb2option(int callb)
}
-static void SND_callback(GtkWidget *w, gpointer info)
+static void menu_callback(GtkWidget *w, gpointer info)
{
int callb, opt;
callb = get_user_int_data(G_OBJECT(w));
opt = callb2option(callb);
if (opt != -1)
- g_snd_callback(callb);
+ g_menu_callback(callb);
}
@@ -1622,10 +2074,11 @@ int g_add_to_main_menu(const char *label, int slot)
set_user_int_data(G_OBJECT(m), slot);
if (slot >= 0)
{
- SG_SIGNAL_CONNECT(m, "activate", SND_callback, NULL);
+ SG_SIGNAL_CONNECT(m, "activate", menu_callback, NULL);
add_option(m, new_menu + 1, label, slot);
}
mc = gtk_menu_new();
+ add_menu_style(mc);
gtk_menu_item_set_submenu(GTK_MENU_ITEM(m), mc);
new_menu++;
added_menus[new_menu] = m; /* was mc -- 1-Mar-06 */
@@ -1665,7 +2118,7 @@ GtkWidget *g_add_to_menu(int which_menu, const char *label, int callb, int posit
if (label)
{
set_user_int_data(G_OBJECT(m), callb);
- SG_SIGNAL_CONNECT(m, "activate", SND_callback, NULL);
+ SG_SIGNAL_CONNECT(m, "activate", menu_callback, NULL);
add_option(m, which_menu, label, callb);
}
return(m);
@@ -1678,28 +2131,24 @@ int g_remove_from_menu(int which_menu, const char *label)
}
-static XEN g_menu_widgets(void)
+static Xen g_menu_widgets(void)
{
#define H_menu_widgets "(" S_menu_widgets "): a list of the top level menu widgets: ((0)main (1)file (2)edit (3)view (4)options (5)help)"
- return(XEN_CONS(XEN_WRAP_WIDGET(main_menu),
- XEN_CONS(XEN_WRAP_WIDGET(file_menu),
- XEN_CONS(XEN_WRAP_WIDGET(edit_menu),
- XEN_CONS(XEN_WRAP_WIDGET(view_menu),
- XEN_CONS(XEN_WRAP_WIDGET(options_menu),
- XEN_CONS(XEN_WRAP_WIDGET(help_menu),
- XEN_EMPTY_LIST)))))));
+ return(Xen_cons(Xen_wrap_widget(main_menu),
+ Xen_cons(Xen_wrap_widget(file_menu),
+ Xen_cons(Xen_wrap_widget(edit_menu),
+ Xen_cons(Xen_wrap_widget(view_menu),
+ Xen_cons(Xen_wrap_widget(options_menu),
+ Xen_cons(Xen_wrap_widget(help_menu),
+ Xen_empty_list)))))));
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_menu_widgets_w, g_menu_widgets)
-#else
-#define g_menu_widgets_w g_menu_widgets
-#endif
+Xen_wrap_no_args(g_menu_widgets_w, g_menu_widgets)
void g_init_gxmenu(void)
{
- XEN_DEFINE_PROCEDURE(S_menu_widgets, g_menu_widgets_w, 0, 0, 0, H_menu_widgets);
+ Xen_define_procedure(S_menu_widgets, g_menu_widgets_w, 0, 0, 0, H_menu_widgets);
}
diff --git a/snd-gmix.c b/snd-gmix.c
index 17eafc6..f2652e2 100644
--- a/snd-gmix.c
+++ b/snd-gmix.c
@@ -54,7 +54,9 @@ static bool speed_pressed = false, speed_dragged = false;
/* can't use value_changed on adjustment and motion event happens even when the mouse merely moves across the slider without dragging */
static speed_style_t gmix_speed_control_style = SPEED_CONTROL_AS_FLOAT;
-static graphics_context *mix_play_ax = NULL;
+#if WITH_AUDIO
+ static graphics_context *mix_play_ax = NULL;
+#endif
static mus_float_t speed_to_scrollbar(mus_float_t minval, mus_float_t val, mus_float_t maxval)
{
@@ -203,7 +205,7 @@ static void reflect_mix_amp(mus_float_t val)
char sfs[6];
ADJUSTMENT_SET_VALUE(w_amp_adj, amp_to_scroll(amp_control_min(ss), val, amp_control_max(ss)));
/* gtk_adjustment_value_changed(GTK_ADJUSTMENT(w_amp_adj)); */
- mus_snprintf(sfs, 6, "%.2f", val);
+ snprintf(sfs, 6, "%.2f", val);
gtk_label_set_text(GTK_LABEL(w_amp_number), sfs);
}
@@ -302,8 +304,6 @@ static void mix_amp_env_resize(GtkWidget *w)
if (!(mix_is_active(mix_dialog_id))) return;
if (ax == NULL)
{
- GdkWindow *wn;
- wn = MAIN_WINDOW(ss);
cur_gc = gc_new();
gc_set_background(cur_gc, ss->graph_color);
gc_set_foreground(cur_gc, ss->data_color);
@@ -312,7 +312,7 @@ static void mix_amp_env_resize(GtkWidget *w)
ax->w = w_env;
ax->gc = cur_gc;
}
- ss->cr = MAKE_CAIRO(ax->wn);
+ ss->cr = make_cairo(ax->wn);
cairo_push_group(ss->cr);
/* erase previous */
@@ -327,7 +327,7 @@ static void mix_amp_env_resize(GtkWidget *w)
cairo_pop_group_to_source(ss->cr);
cairo_paint(ss->cr);
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
}
@@ -359,7 +359,7 @@ static gboolean mix_drawer_button_motion(GtkWidget *w, GdkEventMotion *ev, gpoin
int x, y;
GdkModifierType state;
if (EVENT_IS_HINT(ev))
- gdk_window_get_pointer(EVENT_WINDOW(ev), &x, &y, &state);
+ window_get_pointer(ev, &x, &y, &state);
else
{
x = (int)(EVENT_X(ev));
@@ -388,7 +388,10 @@ static gboolean mix_amp_env_resize_callback(GtkWidget *w, GdkEventConfigure *ev,
}
-static GtkWidget *w_id = NULL, *w_beg = NULL, *mix_play = NULL, *w_id_label = NULL;
+static GtkWidget *w_id = NULL, *w_beg = NULL, *w_id_label = NULL;
+#if WITH_AUDIO
+ static GtkWidget *mix_play = NULL;
+#endif
static bool id_changed = false;
@@ -410,7 +413,7 @@ static gint unpost_mix_error(gpointer data)
static void errors_to_mix_text(const char *msg, void *data)
{
- info_widget_display(error_label, msg);
+ gtk_label_set_text(GTK_LABEL(error_label), msg);
gtk_widget_show(error_frame);
g_timeout_add_full(0, (guint32)5000, unpost_mix_error, NULL, NULL);
}
@@ -474,7 +477,7 @@ static void beg_activated(GtkWidget *w, gpointer context)
{
mus_long_t pos, old_pos;
old_pos = mix_position_from_id(mix_dialog_id);
- pos = (mus_long_t)(beg * SND_SRATE(cp->sound));
+ pos = (mus_long_t)(beg * snd_srate(cp->sound));
mix_set_position_edit(mix_dialog_id, pos);
syncd_mix_change_position(mix_dialog_id, pos - old_pos);
}
@@ -511,6 +514,7 @@ void reflect_mix_play_stop(void)
}
+#if WITH_AUDIO
static void mix_play_callback(GtkWidget *w, gpointer context)
{
if (mix_playing)
@@ -530,6 +534,7 @@ static gboolean mix_play_pix_expose(GtkWidget *w, GdkEventExpose *ev, gpointer d
draw_picture(mix_play_ax, snd_icon(SND_PNG_SPEAKER), 0, 0, 0, 0, 16, 16); /* in gtk2 this looks better if y-dest is 2 */
return(false);
}
+#endif
static void mix_dB_callback(GtkWidget *w, gpointer context)
@@ -565,7 +570,7 @@ static void mix_sync_callback(GtkWidget *w, gpointer context)
static void mix_clip_callback(GtkWidget *w, gpointer context)
{
- spf->clip_p = gtk_toggle_button_get_active(GTK_TOGGLE_BUTTON(w));
+ spf->clipping = gtk_toggle_button_get_active(GTK_TOGGLE_BUTTON(w));
mix_amp_env_resize(w_env);
}
@@ -583,7 +588,7 @@ static void apply_env_callback(GtkWidget *w, gpointer context)
if (!(mix_is_active(mix_dialog_id))) return;
if ((dialog_env) &&
- (!(default_env_p(dialog_env))))
+ (!(is_default_env(dialog_env))))
{
mix_set_amp_env_edit(mix_dialog_id, dialog_env);
syncd_mix_set_amp_env(mix_dialog_id, dialog_env);
@@ -613,7 +618,7 @@ static gint delete_mix_dialog(GtkWidget *w, GdkEvent *event, gpointer context)
}
-static GtkWidget *nextb, *previousb, *apply_button;
+static GtkWidget *mix_next_button, *mix_previous_button, *mix_apply_button;
static void mix_next_callback(GtkWidget *w, gpointer context)
{
@@ -625,7 +630,7 @@ static void mix_next_callback(GtkWidget *w, gpointer context)
mix_dialog_id = id;
reflect_mix_change(id);
if (next_mix_id(id) == INVALID_MIX_ID)
- set_sensitive(nextb, false);
+ set_sensitive(mix_next_button, false);
}
}
@@ -640,7 +645,7 @@ static void mix_previous_callback(GtkWidget *w, gpointer context)
mix_dialog_id = id;
reflect_mix_change(id);
if (previous_mix_id(id) == INVALID_MIX_ID)
- set_sensitive(previousb, false);
+ set_sensitive(mix_previous_button, false);
}
}
@@ -652,19 +657,26 @@ static void mix_dialog_help_callback(GtkWidget *w, gpointer context)
static GtkWidget *w_sync;
+#define LEFT_MARGIN 6
GtkWidget *make_mix_dialog(void)
{
if (mix_dialog == NULL)
{
GtkWidget *dismiss_button, *help_button, *rc, *mix_frame, *rc_top, *copy_button;
- GtkWidget *lo_hbox, *w_dB_frame, *w_dB, *w_clip, *w_wave, *w_dB_row, *mix_play_pix;
+ GtkWidget *lo_hbox, *w_dB_frame, *w_dB, *w_clip, *w_wave, *w_dB_row;
+#if WITH_AUDIO
+ GtkWidget *mix_play_pix;
+#endif
char amplab[LABEL_BUFFER_SIZE];
gmix_speed_control_style = speed_control_style(ss);
mix_dialog_id = any_mix_id();
mix_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(mix_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
SG_SIGNAL_CONNECT(mix_dialog, "delete_event", delete_mix_dialog, NULL);
gtk_window_set_title(GTK_WINDOW(mix_dialog), "Mixes");
sg_make_resizable(mix_dialog);
@@ -672,36 +684,43 @@ GtkWidget *make_mix_dialog(void)
gtk_window_resize(GTK_WINDOW(mix_dialog), 560, 280);
gtk_widget_realize(mix_dialog);
- dismiss_button = gtk_button_new_from_stock(GTK_STOCK_QUIT);
- gtk_widget_set_name(dismiss_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(mix_dialog)), dismiss_button, false, true, 10);
- SG_SIGNAL_CONNECT(dismiss_button, "clicked", dismiss_mix_dialog, NULL);
- gtk_widget_show(dismiss_button);
- set_stock_button_label(dismiss_button, "Go Away");
-
- apply_button = sg_button_new_from_stock_with_label("Apply Env", GTK_STOCK_APPLY);
- gtk_widget_set_name(apply_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(mix_dialog)), apply_button, false, true, 10);
- SG_SIGNAL_CONNECT(apply_button, "clicked", apply_env_callback, NULL);
- gtk_widget_show(apply_button);
+ help_button = gtk_dialog_add_button(GTK_DIALOG(mix_dialog), "Help", GTK_RESPONSE_NONE);
+ gtk_widget_set_name(help_button, "dialog_button");
+ SG_SIGNAL_CONNECT(help_button, "clicked", mix_dialog_help_callback, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(help_button);
+#endif
+ gtk_widget_show(help_button);
- copy_button = sg_button_new_from_stock_with_label("Copy mix", GTK_STOCK_COPY);
+ copy_button = gtk_dialog_add_button(GTK_DIALOG(mix_dialog), "Copy mix", GTK_RESPONSE_NONE);
gtk_widget_set_name(copy_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(mix_dialog)), copy_button, false, true, 10);
SG_SIGNAL_CONNECT(copy_button, "clicked", copy_mix_callback, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(copy_button);
+#endif
gtk_widget_show(copy_button);
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(mix_dialog)), help_button, true, true, 10);
- SG_SIGNAL_CONNECT(help_button, "clicked", mix_dialog_help_callback, NULL);
- gtk_widget_show(help_button);
+ dismiss_button = gtk_dialog_add_button(GTK_DIALOG(mix_dialog), I_GO_AWAY, GTK_RESPONSE_NONE);
+ gtk_widget_set_name(dismiss_button, "dialog_button");
+ SG_SIGNAL_CONNECT(dismiss_button, "clicked", dismiss_mix_dialog, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(dismiss_button);
+#endif
+ gtk_widget_show(dismiss_button);
+
+ mix_apply_button = gtk_dialog_add_button(GTK_DIALOG(mix_dialog), "Apply env", GTK_RESPONSE_NONE);
+ gtk_widget_set_name(mix_apply_button, "dialog_button");
+ SG_SIGNAL_CONNECT(mix_apply_button, "clicked", apply_env_callback, NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(mix_apply_button);
+#endif
+ gtk_widget_show(mix_apply_button);
/* normally hidden error indication at top */
error_frame = gtk_frame_new(NULL);
gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(mix_dialog)), error_frame, false, false, 4);
- error_label = make_info_widget();
+ error_label = gtk_label_new(NULL);
gtk_container_add(GTK_CONTAINER(error_frame), error_label);
gtk_widget_show(error_label);
@@ -724,14 +743,15 @@ GtkWidget *make_mix_dialog(void)
gtk_box_pack_start(GTK_BOX(rc), w_id_label, false, false, 4);
gtk_widget_show(w_id_label);
- w_id = snd_entry_new(rc, WITH_DEFAULT_BACKGROUND);
+ w_id = snd_entry_new(rc, NULL, WITH_DEFAULT_BACKGROUND);
SG_SIGNAL_CONNECT(w_id, "activate", id_activated, NULL);
SG_SIGNAL_CONNECT(w_id, "leave_notify_event", id_check_callback, NULL);
SG_SIGNAL_CONNECT(w_id, "key_press_event", id_modify_callback, NULL);
- w_beg = snd_entry_new(rc, WITH_DEFAULT_BACKGROUND);
+ w_beg = snd_entry_new(rc, NULL, WITH_DEFAULT_BACKGROUND);
SG_SIGNAL_CONNECT(w_beg, "activate", beg_activated, NULL);
+#if WITH_AUDIO
mix_play = gtk_button_new();
gtk_box_pack_start(GTK_BOX(rc), mix_play, false, false, 2);
SG_SIGNAL_CONNECT(mix_play, "clicked", mix_play_callback, NULL);
@@ -745,21 +765,27 @@ GtkWidget *make_mix_dialog(void)
gtk_container_add(GTK_CONTAINER(mix_play), mix_play_pix);
gtk_widget_show(mix_play_pix);
SG_SIGNAL_CONNECT(mix_play_pix, DRAW_SIGNAL, mix_play_pix_expose, NULL);
-
-
- nextb = gtk_button_new_from_stock(GTK_STOCK_GO_FORWARD);
- gtk_widget_set_name(nextb, "dialog_button");
- gtk_box_pack_end(GTK_BOX(rc), nextb, false, true, 6);
- SG_SIGNAL_CONNECT(nextb, "clicked", mix_next_callback, NULL);
- gtk_widget_show(nextb);
- set_stock_button_label(nextb, "Next");
-
- previousb = gtk_button_new_from_stock(GTK_STOCK_GO_BACK);
- gtk_widget_set_name(previousb, "dialog_button");
- gtk_box_pack_end(GTK_BOX(rc), previousb, false, true, 6);
- SG_SIGNAL_CONNECT(previousb, "clicked", mix_previous_callback, NULL);
- gtk_widget_show(previousb);
- set_stock_button_label(previousb, "Previous");
+#endif
+
+ mix_next_button = button_new_with_icon(ICON_GO_FORWARD);
+ gtk_widget_set_name(mix_next_button, "dialog_button");
+ gtk_box_pack_end(GTK_BOX(rc), mix_next_button, false, true, 6);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(mix_next_button);
+#endif
+ SG_SIGNAL_CONNECT(mix_next_button, "clicked", mix_next_callback, NULL);
+ gtk_widget_show(mix_next_button);
+ set_stock_button_label(mix_next_button, I_NEXT);
+
+ mix_previous_button = button_new_with_icon(ICON_GO_BACK);
+ gtk_widget_set_name(mix_previous_button, "dialog_button");
+ gtk_box_pack_end(GTK_BOX(rc), mix_previous_button, false, true, 6);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(mix_previous_button);
+#endif
+ SG_SIGNAL_CONNECT(mix_previous_button, "clicked", mix_previous_callback, NULL);
+ gtk_widget_show(mix_previous_button);
+ set_stock_button_label(mix_previous_button, I_PREVIOUS);
/* SPEED */
@@ -771,7 +797,12 @@ GtkWidget *make_mix_dialog(void)
gtk_widget_show(w_speed_event);
SG_SIGNAL_CONNECT(w_speed_event, "button_press_event", mix_speed_click_callback, NULL);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
w_speed_label = gtk_label_new("speed:");
+#else
+ w_speed_label = gtk_button_new_with_label("speed:");
+ add_highlight_button_style(w_speed_label);
+#endif
gtk_container_add(GTK_CONTAINER(w_speed_event), w_speed_label);
gtk_widget_show(w_speed_label);
@@ -810,8 +841,13 @@ GtkWidget *make_mix_dialog(void)
gtk_widget_show(w_amp_event);
SG_SIGNAL_CONNECT(w_amp_event, "button_press_event", mix_amp_click_callback, NULL);
- mus_snprintf(amplab, LABEL_BUFFER_SIZE, "%s", "amp:");
+ snprintf(amplab, LABEL_BUFFER_SIZE, "%s", "amp:");
+#if (!GTK_CHECK_VERSION(3, 0, 0))
w_amp_label = gtk_label_new(amplab);
+#else
+ w_amp_label = gtk_button_new_with_label("amp:");
+ add_highlight_button_style(w_amp_label);
+#endif
gtk_container_add(GTK_CONTAINER(w_amp_event), w_amp_label);
gtk_widget_show(w_amp_label);
@@ -848,21 +884,25 @@ GtkWidget *make_mix_dialog(void)
gtk_widget_show(w_dB_row);
w_clip = gtk_check_button_new_with_label("clip");
+ widget_set_margin_left(w_clip, LEFT_MARGIN);
SG_SIGNAL_CONNECT(w_clip, "toggled", mix_clip_callback, NULL);
gtk_box_pack_start(GTK_BOX(w_dB_row), w_clip, false, false, 0);
gtk_widget_show(w_clip);
w_wave = gtk_check_button_new_with_label("wave");
+ widget_set_margin_left(w_wave, LEFT_MARGIN);
SG_SIGNAL_CONNECT(w_wave, "toggled", mix_wave_callback, NULL);
gtk_box_pack_start(GTK_BOX(w_dB_row), w_wave, false, false, 0);
gtk_widget_show(w_wave);
w_dB = gtk_check_button_new_with_label("dB");
+ widget_set_margin_left(w_dB, LEFT_MARGIN);
SG_SIGNAL_CONNECT(w_dB, "toggled", mix_dB_callback, NULL);
gtk_box_pack_start(GTK_BOX(w_dB_row), w_dB, false, false, 0);
gtk_widget_show(w_dB);
w_sync = gtk_check_button_new_with_label("sync");
+ widget_set_margin_left(w_sync, LEFT_MARGIN);
SG_SIGNAL_CONNECT(w_sync, "toggled", mix_sync_callback, NULL);
gtk_box_pack_start(GTK_BOX(w_dB_row), w_sync, false, false, 0);
gtk_widget_show(w_sync);
@@ -887,9 +927,11 @@ GtkWidget *make_mix_dialog(void)
if (mix_sync_from_id(mix_dialog_id) != 0)
gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(w_sync), true);
+#if WITH_AUDIO
mix_play_ax = (graphics_context *)calloc(1, sizeof(graphics_context));
mix_play_ax->wn = WIDGET_TO_WINDOW(mix_play_pix);
mix_play_ax->gc = ss->basic_gc;
+#endif
gtk_widget_hide(error_frame);
}
@@ -918,8 +960,8 @@ void reflect_mix_change(int mix_id)
if ((mix_id == mix_dialog_id) || (mix_id == ANY_MIX_ID))
{
mus_float_t val;
- set_sensitive(nextb, (next_mix_id(mix_dialog_id) != INVALID_MIX_ID));
- set_sensitive(previousb, (previous_mix_id(mix_dialog_id) != INVALID_MIX_ID));
+ set_sensitive(mix_next_button, (next_mix_id(mix_dialog_id) != INVALID_MIX_ID));
+ set_sensitive(mix_previous_button, (previous_mix_id(mix_dialog_id) != INVALID_MIX_ID));
/* now reflect current mix state in mix dialog controls */
if (mix_exists(mix_dialog_id))
@@ -948,21 +990,21 @@ void reflect_mix_change(int mix_id)
beg = mix_position_from_id(mix_dialog_id);
len = mix_length_from_id(mix_dialog_id);
- mus_snprintf(lab, LABEL_BUFFER_SIZE, "%.3f : %.3f%s",
- (float)((double)beg / (float)SND_SRATE(cp->sound)),
- (float)((double)(beg + len) / (float)SND_SRATE(cp->sound)),
+ snprintf(lab, LABEL_BUFFER_SIZE, "%.3f : %.3f%s",
+ (float)((double)beg / (float)snd_srate(cp->sound)),
+ (float)((double)(beg + len) / (float)snd_srate(cp->sound)),
(mix_is_active(mix_dialog_id)) ? "" : " (locked)");
gtk_entry_set_text(GTK_ENTRY(w_beg), lab);
widget_mix_to_text(w_id, mix_dialog_id);
- set_sensitive(apply_button, true);
+ set_sensitive(mix_apply_button, true);
}
else
{
gtk_entry_set_text(GTK_ENTRY(w_id), "-1");
gtk_entry_set_text(GTK_ENTRY(w_beg), "no active mixes");
- set_sensitive(apply_button, false);
+ set_sensitive(mix_apply_button, false);
}
if (!dragging)
{
diff --git a/snd-gprefs.c b/snd-gprefs.c
index bd0ff73..d1758a7 100644
--- a/snd-gprefs.c
+++ b/snd-gprefs.c
@@ -23,7 +23,7 @@ static char *include_load_path = NULL;
typedef struct prefs_info {
GtkWidget *label, *text, *arrow_up, *arrow_down, *arrow_right, *error, *toggle, *scale, *toggle2, *toggle3;
- GtkWidget *color, *rscl, *gscl, *bscl, *rtxt, *gtxt, *btxt, *list_menu, *radio_button, *helper;
+ GtkWidget *color, *rscl, *gscl, *bscl, *rtxt, *gtxt, *btxt, *list_menu, *radio_button;
GtkAdjustment *adj, *radj, *gadj, *badj;
GtkWidget **radio_buttons;
bool got_error;
@@ -51,7 +51,7 @@ typedef struct prefs_info {
static void prefs_set_dialog_title(const char *filename);
static void reflect_key(prefs_info *prf, const char *key_name);
-static void save_key_binding(prefs_info *prf, FILE *fd, char *(*binder)(char *key, bool c, bool m, bool x));
+static void save_key(prefs_info *prf, FILE *fd, char *(*binder)(char *key, bool c, bool m, bool x));
static void key_bind(prefs_info *prf, char *(*binder)(char *key, bool c, bool m, bool x));
static void clear_prefs_dialog_error(void);
static void scale_set_color(prefs_info *prf, color_t pixel);
@@ -79,6 +79,30 @@ static void post_prefs_error(const char *msg, prefs_info *data);
/* gdk_gc_set_foreground(Prf->label->style->black_gc, ss->red) no effect? */
+static GtkWidget *make_basic_row(GtkWidget *box)
+{
+#if GTK_CHECK_VERSION(3, 0, 0)
+ GtkWidget *row, *r;
+ r = gtk_event_box_new(); /* not button! */
+ gtk_widget_set_hexpand(GTK_WIDGET(r), true);
+ gtk_box_pack_start(GTK_BOX(box), r, false, false, 0);
+ add_highlight_button_style(r);
+ gtk_widget_show(r);
+
+ row = gtk_hbox_new(false, 0);
+ gtk_container_add(GTK_CONTAINER(r), row);
+ gtk_widget_set_hexpand(GTK_WIDGET(row), true);
+ gtk_widget_show(row);
+#else
+ GtkWidget *row;
+ row = gtk_hbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
+ gtk_widget_show(row);
+#endif
+
+ return(row);
+}
+
static void set_radio_button(prefs_info *prf, int which)
{
if ((which >= 0) && (which < prf->num_buttons))
@@ -169,7 +193,15 @@ static GtkWidget *make_row_label(prefs_info *prf, const char *label, GtkWidget *
GtkWidget *w;
w = gtk_label_new(label);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
gtk_misc_set_alignment(GTK_MISC(w), 1.0, 0.0);
+#else
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_widget_set_halign(GTK_WIDGET(w), GTK_ALIGN_END);
+#else
+ gtk_misc_set_alignment(GTK_MISC(w), 1.0, 0.5);
+#endif
+#endif
gtk_size_group_add_widget(label_group, w);
gtk_box_pack_start(GTK_BOX(box), w, PACK_1, PACK_2, 0);
gtk_widget_show(w);
@@ -181,39 +213,34 @@ static GtkWidget *make_row_label(prefs_info *prf, const char *label, GtkWidget *
/* ---------------- row inner label widget ---------------- */
-static GtkWidget *make_row_inner_label(prefs_info *prf, const char *label, GtkWidget *box)
+static void make_row_inner_label(prefs_info *prf, const char *label, GtkWidget *box)
{
GtkWidget *w;
-
w = gtk_label_new(label);
gtk_box_pack_start(GTK_BOX(box), w, false, false, 4);
gtk_widget_show(w);
-
- return(w);
}
/* ---------------- row middle separator widget ---------------- */
-static GtkWidget *make_row_middle_separator(GtkWidget *box)
+static void make_row_middle_separator(GtkWidget *box)
{
GtkWidget *w;
w = gtk_vseparator_new();
gtk_box_pack_start(GTK_BOX(box), w, false, false, 10);
gtk_widget_show(w);
- return(w);
}
/* ---------------- row inner separator widget ---------------- */
-static GtkWidget *make_row_inner_separator(int width, GtkWidget *box)
+static void make_row_inner_separator(int width, GtkWidget *box)
{
GtkWidget *w;
w = gtk_hseparator_new();
gtk_box_pack_start(GTK_BOX(box), w, false, false, width);
gtk_widget_show(w);
- return(w);
}
@@ -272,7 +299,7 @@ static gint arrow_func_up(gpointer context)
prefs_info *prf = (prefs_info *)context;
if (Widget_Is_Sensitive(prf->arrow_up))
{
- if ((prf) && (prf->arrow_up_func))
+ if (prf->arrow_up_func)
{
(*(prf->arrow_up_func))(prf);
prf->power_id = g_timeout_add_full(0,
@@ -291,7 +318,7 @@ static gint arrow_func_down(gpointer context)
prefs_info *prf = (prefs_info *)context;
if (Widget_Is_Sensitive(prf->arrow_down))
{
- if ((prf) && (prf->arrow_down_func))
+ if (prf->arrow_down_func)
{
(*(prf->arrow_down_func))(prf);
prf->power_id = g_timeout_add_full(0,
@@ -342,12 +369,20 @@ static gboolean call_arrow_up_press(GtkWidget *w, GdkEventButton *ev, gpointer c
static GtkWidget *make_row_arrows(prefs_info *prf, GtkWidget *box)
{
GtkWidget *ev_up, *ev_down, *up, *down;
+#if GTK_CHECK_VERSION(3, 14, 0)
+ GtkIconTheme *icon_theme;
+ icon_theme = gtk_icon_theme_get_default();
+#endif
ev_down = gtk_event_box_new();
gtk_box_pack_start(GTK_BOX(box), ev_down, false, false, 0);
gtk_widget_show(ev_down);
+#if GTK_CHECK_VERSION(3, 14, 0)
+ down = gtk_image_new_from_pixbuf(gtk_icon_theme_load_icon(icon_theme, "pan-down-symbolic", 16, (GtkIconLookupFlags)0, NULL));
+#else
down = gtk_arrow_new(GTK_ARROW_DOWN, GTK_SHADOW_ETCHED_OUT);
+#endif
gtk_container_add(GTK_CONTAINER(ev_down), down);
gtk_widget_show(down);
@@ -355,7 +390,11 @@ static GtkWidget *make_row_arrows(prefs_info *prf, GtkWidget *box)
gtk_box_pack_start(GTK_BOX(box), ev_up, false, false, 0);
gtk_widget_show(ev_up);
+#if GTK_CHECK_VERSION(3, 14, 0)
+ up = gtk_image_new_from_pixbuf(gtk_icon_theme_load_icon(icon_theme, "pan-up-symbolic", 16, (GtkIconLookupFlags)0, NULL));
+#else
up = gtk_arrow_new(GTK_ARROW_UP, GTK_SHADOW_ETCHED_OUT);
+#endif
gtk_container_add(GTK_CONTAINER(ev_up), up);
gtk_widget_show(up);
@@ -388,15 +427,13 @@ static prefs_info *prefs_row_with_toggle(const char *label, const char *varname,
void (*toggle_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->toggle_func = toggle_func;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -404,7 +441,7 @@ static prefs_info *prefs_row_with_toggle(const char *label, const char *varname,
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->toggle = make_row_toggle(prf, current_value, hb);
SG_SIGNAL_CONNECT(prf->toggle, "toggled", call_toggle_func, (gpointer)prf);
@@ -431,16 +468,14 @@ static prefs_info *prefs_row_with_two_toggles(const char *label, const char *var
void (*toggle2_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *sep1, *row, *hb;
+ GtkWidget *row, *hb;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->toggle_func = toggle_func;
prf->toggle2_func = toggle2_func;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -448,9 +483,9 @@ static prefs_info *prefs_row_with_two_toggles(const char *label, const char *var
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->toggle = make_row_toggle_with_label(prf, value1, hb, label1);
- sep1 = make_row_inner_separator(20, hb);
+ make_row_inner_separator(20, hb);
prf->toggle2 = make_row_toggle_with_label(prf, value2, hb, label2);
SG_SIGNAL_CONNECT(prf->toggle, "toggled", call_toggle_func, (gpointer)prf);
@@ -562,16 +597,14 @@ static prefs_info *prefs_row_with_toggle_with_text(const char *label, const char
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *sep1, *lab1, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->toggle_func = toggle_func;
prf->text_func = text_func;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -579,10 +612,10 @@ static prefs_info *prefs_row_with_toggle_with_text(const char *label, const char
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->toggle = make_row_toggle(prf, current_value, hb);
- sep1 = make_row_inner_separator(16, hb);
- lab1 = make_row_inner_label(prf, text_label, hb);
+ make_row_inner_separator(16, hb);
+ make_row_inner_label(prf, text_label, hb);
prf->text= make_row_text(prf, text_value, cols, hb);
SG_SIGNAL_CONNECT(prf->toggle, "toggled", call_toggle_func, (gpointer)prf);
@@ -600,15 +633,13 @@ static prefs_info *prefs_row_with_toggle_with_two_texts(const char *label, const
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *sep1, *lab1, *lab2, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->toggle_func = toggle_func;
prf->text_func = text_func;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -616,12 +647,12 @@ static prefs_info *prefs_row_with_toggle_with_two_texts(const char *label, const
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->toggle = make_row_toggle(prf, current_value, hb);
- sep1 = make_row_inner_separator(16, hb);
- lab1 = make_row_inner_label(prf, label1, hb);
+ make_row_inner_separator(16, hb);
+ make_row_inner_label(prf, label1, hb);
prf->text= make_row_text(prf, text1, cols, hb);
- lab2 = make_row_inner_label(prf, label2, hb);
+ make_row_inner_label(prf, label2, hb);
prf->rtxt= make_row_text(prf, text2, cols, hb);
SG_SIGNAL_CONNECT(prf->toggle, "toggled", call_toggle_func, (gpointer)prf);
@@ -642,16 +673,14 @@ static prefs_info *prefs_row_with_text_with_toggle(const char *label, const char
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *sep1, *lab1, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->toggle_func = toggle_func;
prf->text_func = text_func;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -659,10 +688,10 @@ static prefs_info *prefs_row_with_text_with_toggle(const char *label, const char
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->text = make_row_text(prf, text_value, cols, hb);
- sep1 = make_row_inner_separator(8, hb);
- lab1 = make_row_inner_label(prf, toggle_label, hb);
+ make_row_inner_separator(8, hb);
+ make_row_inner_label(prf, toggle_label, hb);
prf->toggle = make_row_toggle(prf, current_value, hb);
SG_SIGNAL_CONNECT(prf->toggle, "toggled", call_toggle_func, (gpointer)prf);
@@ -683,15 +712,13 @@ static prefs_info *prefs_row_with_text_and_three_toggles(const char *label, cons
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *sep1, *sep2, *sep3, *lab1, *lab2, *lab3, *lab4, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->text_func = text_func;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -699,17 +726,17 @@ static prefs_info *prefs_row_with_text_and_three_toggles(const char *label, cons
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
- lab4 = make_row_inner_label(prf, text_label, hb);
+ make_row_middle_separator(hb);
+ make_row_inner_label(prf, text_label, hb);
prf->text = make_row_text(prf, text_value, cols, hb);
- sep1 = make_row_inner_separator(12, hb);
- lab1 = make_row_inner_label(prf, toggle1_label, hb);
+ make_row_inner_separator(12, hb);
+ make_row_inner_label(prf, toggle1_label, hb);
prf->toggle = make_row_toggle(prf, toggle1_value, hb);
- sep2 = make_row_inner_separator(4, hb);
- lab2 = make_row_inner_label(prf, toggle2_label, hb);
+ make_row_inner_separator(4, hb);
+ make_row_inner_label(prf, toggle2_label, hb);
prf->toggle2 = make_row_toggle(prf, toggle2_value, hb);
- sep3 = make_row_inner_separator(4, hb);
- lab3 = make_row_inner_label(prf, toggle3_label, hb);
+ make_row_inner_separator(4, hb);
+ make_row_inner_label(prf, toggle3_label, hb);
prf->toggle3 = make_row_toggle(prf, toggle3_value, hb);
SG_SIGNAL_CONNECT(prf->text, "activate", call_text_func, (gpointer)prf);
@@ -770,14 +797,12 @@ static prefs_info *prefs_row_with_radio_box(const char *label, const char *varna
void (*toggle_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->toggle_func = toggle_func;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
@@ -786,7 +811,7 @@ static prefs_info *prefs_row_with_radio_box(const char *label, const char *varna
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->toggle = make_row_radio_box(prf, labels, num_labels, current_value, hb);
return(prf);
@@ -802,7 +827,7 @@ static prefs_info *prefs_row_with_radio_box_and_number(const char *label, const
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *row, *hb;
+ GtkWidget *row, *hb;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->toggle_func = toggle_func;
@@ -810,9 +835,7 @@ static prefs_info *prefs_row_with_radio_box_and_number(const char *label, const
prf->arrow_up_func = arrow_up_func;
prf->arrow_down_func = arrow_down_func;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
@@ -821,7 +844,7 @@ static prefs_info *prefs_row_with_radio_box_and_number(const char *label, const
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->toggle = make_row_radio_box(prf, labels, num_labels, current_value, hb);
prf->text = make_row_text(prf, text_value, text_cols, hb);
prf->arrow_up = make_row_arrows(prf, hb);
@@ -865,16 +888,14 @@ static prefs_info *prefs_row_with_scale(const char *label, const char *varname,
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *hb, *row;
+ GtkWidget *hb, *row;
char *str;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
prf->scale_max = max_val;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -882,10 +903,10 @@ static prefs_info *prefs_row_with_scale(const char *label, const char *varname,
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
str = (char *)calloc(12, sizeof(char));
- mus_snprintf(str, 12, "%.3f", current_value);
+ snprintf(str, 12, "%.3f", current_value);
prf->text = make_row_text(prf, str, 6, hb);
free(str);
@@ -895,7 +916,6 @@ static prefs_info *prefs_row_with_scale(const char *label, const char *varname,
gtk_widget_show(prf->scale);
gtk_range_set_update_policy(GTK_RANGE(GTK_SCALE(prf->scale)), GTK_UPDATE_CONTINUOUS);
gtk_scale_set_draw_value(GTK_SCALE(prf->scale), false);
-
prf->scale_func = scale_func;
prf->text_func = text_func;
@@ -915,14 +935,12 @@ static prefs_info *prefs_row_with_text(const char *label, const char *varname, c
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -930,7 +948,7 @@ static prefs_info *prefs_row_with_text(const char *label, const char *varname, c
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->text = make_row_text(prf, value, 0, hb);
prf->text_func = text_func;
@@ -948,13 +966,11 @@ static prefs_info *prefs_row_with_two_texts(const char *label, const char *varna
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *lab1, *lab2, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -962,10 +978,10 @@ static prefs_info *prefs_row_with_two_texts(const char *label, const char *varna
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
- lab1 = make_row_inner_label(prf, label1, hb);
+ make_row_middle_separator(hb);
+ make_row_inner_label(prf, label1, hb);
prf->text = make_row_text(prf, text1, cols, hb);
- lab2 = make_row_inner_label(prf, label2, hb);
+ make_row_inner_label(prf, label2, hb);
prf->rtxt = make_row_text(prf, text2, cols, hb);
prf->text_func = text_func;
@@ -985,14 +1001,12 @@ static prefs_info *prefs_row_with_number(const char *label, const char *varname,
void (*text_func)(prefs_info *prf))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
@@ -1001,7 +1015,7 @@ static prefs_info *prefs_row_with_number(const char *label, const char *varname,
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
prf->text = make_row_text(prf, value, cols, hb);
prf->arrow_up = make_row_arrows(prf, hb);
prf->error = make_row_error(prf, hb);
@@ -1026,14 +1040,12 @@ static prefs_info *prefs_row_with_list(const char *label, const char *varname, c
{
int i;
prefs_info *prf = NULL;
- GtkWidget *sep, *hb, *row;
+ GtkWidget *hb, *row;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
prf->var_name = varname;
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -1041,9 +1053,9 @@ static prefs_info *prefs_row_with_list(const char *label, const char *varname, c
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
prf->text = gtk_combo_box_text_new_with_entry();
for (i = 0; i < num_values; i++)
gtk_combo_box_text_append_text(GTK_COMBO_BOX_TEXT(prf->text), (values[i]) ? values[i] : " ");
@@ -1070,12 +1082,25 @@ static prefs_info *prefs_row_with_list(const char *label, const char *varname, c
static void pixel_to_rgb(color_t pix, float *r, float *g, float *b)
{
- (*r) = RGB_TO_FLOAT(pix->red);
- (*g) = RGB_TO_FLOAT(pix->green);
- (*b) = RGB_TO_FLOAT(pix->blue);
+ (*r) = rgb_to_float(pix->red);
+ (*g) = rgb_to_float(pix->green);
+ (*b) = rgb_to_float(pix->blue);
}
+#if GTK_CHECK_VERSION(3, 0, 0)
+static void display_color(GtkWidget *w, color_t pixel)
+{
+ cairo_t *cr;
+ cr = gdk_cairo_create(WIDGET_TO_WINDOW(w));
+ cairo_set_source_rgba(cr, pixel->red, pixel->green, pixel->blue, pixel->alpha);
+ cairo_rectangle(cr, 0, 0, widget_width(w), widget_height(w));
+ cairo_fill(cr);
+ cairo_destroy(cr);
+}
+#endif
+
+
static void scale_set_color(prefs_info *prf, color_t pixel)
{
float r = 0.0, g = 0.0, b = 0.0;
@@ -1086,7 +1111,11 @@ static void scale_set_color(prefs_info *prf, color_t pixel)
ADJUSTMENT_SET_VALUE(prf->gadj, g);
float_to_textfield(prf->btxt, b);
ADJUSTMENT_SET_VALUE(prf->badj, b);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ display_color(prf->color, pixel);
+#else
widget_modify_bg(prf->color, GTK_STATE_NORMAL, pixel);
+#endif
}
@@ -1100,7 +1129,11 @@ static void reflect_color(prefs_info *prf)
b = ADJUSTMENT_VALUE(prf->badj);
current_color = rgb_to_color(r, g, b);
- widget_modify_bg(prf->color, GTK_STATE_NORMAL, current_color);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ display_color(prf->color, current_color);
+#else
+ widget_modify_bg(prf->color, GTK_STATE_NORMAL, current_color);
+#endif
float_to_textfield(prf->rtxt, r);
float_to_textfield(prf->gtxt, g);
@@ -1137,7 +1170,7 @@ static void prefs_r_callback(GtkWidget *w, gpointer context)
{
prefs_info *prf = (prefs_info *)context;
char *str;
- float r = 0.0;
+ float r;
str = (char *)gtk_entry_get_text(GTK_ENTRY(w));
redirect_errors_to(errors_to_color_text, context);
r = (float)string_to_mus_float_t(str, 0.0, "red amount");
@@ -1154,7 +1187,7 @@ static void prefs_g_callback(GtkWidget *w, gpointer context)
{
prefs_info *prf = (prefs_info *)context;
char *str;
- float r = 0.0;
+ float r;
str = (char *)gtk_entry_get_text(GTK_ENTRY(w));
redirect_errors_to(errors_to_color_text, context);
r = (float)string_to_mus_float_t(str, 0.0, "green amount");
@@ -1171,7 +1204,7 @@ static void prefs_b_callback(GtkWidget *w, gpointer context)
{
prefs_info *prf = (prefs_info *)context;
char *str;
- float r = 0.0;
+ float r;
str = (char *)gtk_entry_get_text(GTK_ENTRY(w));
redirect_errors_to(errors_to_color_text, context);
r = (float)string_to_mus_float_t(str, 0.0, "blue amount");
@@ -1198,13 +1231,31 @@ static void prefs_call_color_func_callback(GtkWidget *w, gpointer context)
}
+#if GTK_CHECK_VERSION(3, 0, 0)
+static gboolean drawer_expose(GtkWidget *w, GdkEventExpose *ev, gpointer data)
+{
+ prefs_info *prf = (prefs_info *)data;
+ mus_float_t r, g, b;
+ color_info *current_color;
+
+ r = ADJUSTMENT_VALUE(prf->radj);
+ g = ADJUSTMENT_VALUE(prf->gadj);
+ b = ADJUSTMENT_VALUE(prf->badj);
+
+ current_color = rgb_to_color(r, g, b);
+ display_color(prf->color, current_color);
+ return(false);
+}
+#endif
+
+
static prefs_info *prefs_color_selector_row(const char *label, const char *varname,
color_t current_pixel,
GtkWidget *box,
void (*color_func)(prefs_info *prf, float r, float g, float b))
{
prefs_info *prf = NULL;
- GtkWidget *sep, *sep1, *hb, *row, *row2, *sep2, *sep3;
+ GtkWidget *hb, *row, *row2, *sep3;
float r = 0.0, g = 0.0, b = 0.0;
prf = (prefs_info *)calloc(1, sizeof(prefs_info));
@@ -1212,9 +1263,7 @@ static prefs_info *prefs_color_selector_row(const char *label, const char *varna
pixel_to_rgb(current_pixel, &r, &g, &b);
/* first row */
- row = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(box), row, false, false, 0);
- gtk_widget_show(row);
+ row = make_basic_row(box);
prf->label = make_row_label(prf, label, row);
hb = gtk_hbox_new(false, 0);
@@ -1222,7 +1271,7 @@ static prefs_info *prefs_color_selector_row(const char *label, const char *varna
gtk_box_pack_start(GTK_BOX(row), hb, false, false, 0);
gtk_widget_show(hb);
- sep = make_row_middle_separator(hb);
+ make_row_middle_separator(hb);
{
GtkWidget *frame;
@@ -1233,14 +1282,20 @@ static prefs_info *prefs_color_selector_row(const char *label, const char *varna
gtk_size_group_add_widget(prf->color_texts, frame);
prf->color = gtk_drawing_area_new();
- gtk_widget_set_events(prf->color, GDK_ENTER_NOTIFY_MASK | GDK_LEAVE_NOTIFY_MASK);
gtk_container_add(GTK_CONTAINER(frame), prf->color);
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ SG_SIGNAL_CONNECT(prf->color, DRAW_SIGNAL, drawer_expose, prf);
+ gtk_widget_set_hexpand(GTK_WIDGET(prf->color), true);
+ gtk_widget_set_vexpand(GTK_WIDGET(prf->color), true);
+#else
widget_modify_bg(prf->color, GTK_STATE_NORMAL, current_pixel);
+#endif
gtk_widget_show(prf->color);
gtk_widget_show(frame);
}
- sep1 = make_row_inner_separator(8, hb);
+ make_row_inner_separator(8, hb);
prf->rtxt = make_row_text(prf, NULL, 6, hb);
gtk_size_group_add_widget(prf->color_texts, prf->rtxt);
@@ -1260,14 +1315,18 @@ static prefs_info *prefs_color_selector_row(const char *label, const char *varna
gtk_box_pack_start(GTK_BOX(box), row2, false, false, 0);
gtk_widget_show(row2);
- sep2 = make_row_inner_separator(20, row2);
+ make_row_inner_separator(20, row2);
prf->radj = (GtkAdjustment *)gtk_adjustment_new(r, 0.0, 1.01, 0.001, 0.01, .01);
prf->rscl = gtk_hscale_new(GTK_ADJUSTMENT(prf->radj));
gtk_widget_set_name(prf->rscl, "prefs_color_scale");
gtk_box_pack_start(GTK_BOX(row2), prf->rscl, true, true, 4);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
widget_modify_bg(prf->rscl, GTK_STATE_NORMAL, rscl_color); /* this is the slider except when clicked */
widget_modify_bg(prf->rscl, GTK_STATE_PRELIGHT, rscl_color); /* this is the slider when clicked */
+#else
+ add_red_scale_style(prf->rscl);
+#endif
gtk_widget_show(prf->rscl);
gtk_range_set_update_policy(GTK_RANGE(GTK_SCALE(prf->rscl)), GTK_UPDATE_CONTINUOUS);
gtk_scale_set_draw_value(GTK_SCALE(prf->rscl), false);
@@ -1276,8 +1335,12 @@ static prefs_info *prefs_color_selector_row(const char *label, const char *varna
prf->gscl = gtk_hscale_new(GTK_ADJUSTMENT(prf->gadj));
gtk_widget_set_name(prf->gscl, "prefs_color_scale");
gtk_box_pack_start(GTK_BOX(row2), prf->gscl, true, true, 4);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
widget_modify_bg(prf->gscl, GTK_STATE_NORMAL, gscl_color);
widget_modify_bg(prf->gscl, GTK_STATE_PRELIGHT, gscl_color);
+#else
+ add_green_scale_style(prf->gscl);
+#endif
gtk_widget_show(prf->gscl);
gtk_range_set_update_policy(GTK_RANGE(GTK_SCALE(prf->gscl)), GTK_UPDATE_CONTINUOUS);
gtk_scale_set_draw_value(GTK_SCALE(prf->gscl), false);
@@ -1286,8 +1349,12 @@ static prefs_info *prefs_color_selector_row(const char *label, const char *varna
prf->bscl = gtk_hscale_new(GTK_ADJUSTMENT(prf->badj));
gtk_widget_set_name(prf->bscl, "prefs_color_scale");
gtk_box_pack_start(GTK_BOX(row2), prf->bscl, true, true, 4);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
widget_modify_bg(prf->bscl, GTK_STATE_NORMAL, bscl_color);
widget_modify_bg(prf->bscl, GTK_STATE_PRELIGHT, bscl_color);
+#else
+ add_blue_scale_style(prf->bscl);
+#endif
gtk_widget_show(prf->bscl);
gtk_range_set_update_policy(GTK_RANGE(GTK_SCALE(prf->bscl)), GTK_UPDATE_CONTINUOUS);
gtk_scale_set_draw_value(GTK_SCALE(prf->bscl), false);
@@ -1319,33 +1386,31 @@ static prefs_info *prefs_color_selector_row(const char *label, const char *varna
/* ---------------- topic separator ---------------- */
-static GtkWidget *make_inter_topic_separator(GtkWidget *topics)
+static void make_inter_topic_separator(GtkWidget *topics)
{
GtkWidget *w;
w = gtk_hseparator_new();
gtk_box_pack_start(GTK_BOX(topics), w, false, false, 0);
gtk_widget_show(w);
- return(w);
/* height = INTER_TOPIC_SPACE no line */
}
/* ---------------- variable separator ---------------- */
-static GtkWidget *make_inter_variable_separator(GtkWidget *topics)
+static void make_inter_variable_separator(GtkWidget *topics)
{
GtkWidget *w;
w = gtk_hseparator_new();
gtk_box_pack_start(GTK_BOX(topics), w, false, false, 0);
gtk_widget_show(w);
- return(w);
/* height = INTER_VARIABLE_SPACE no line */
}
/* ---------------- top-level contents label ---------------- */
-static GtkWidget *make_top_level_label(const char *label, GtkWidget *parent)
+static void make_top_level_label(const char *label, GtkWidget *parent)
{
GtkWidget *w1, *w2, *w3;
char *str;
@@ -1354,13 +1419,27 @@ static GtkWidget *make_top_level_label(const char *label, GtkWidget *parent)
gtk_box_pack_start(GTK_BOX(parent), w1, false, false, 6);
gtk_widget_show(w1);
- w2 = gtk_label_new(label);
str = mus_format("<b>%s</b>", label);
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ w2 = gtk_label_new(label);
gtk_label_set_markup(GTK_LABEL(w2), str);
gtk_label_set_use_markup(GTK_LABEL(w2), true);
+ gtk_misc_set_alignment(GTK_MISC(w2), 0.01, 0.5);
+#else
+ w2 = gtk_button_new_with_label(label);
+ add_highlight_button_style(w2);
+ gtk_label_set_markup(GTK_LABEL(BIN_CHILD(w2)), str);
+ gtk_label_set_use_markup(GTK_LABEL(BIN_CHILD(w2)), true);
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_widget_set_halign(GTK_WIDGET(w2), GTK_ALIGN_START);
+#else
+ gtk_misc_set_alignment(GTK_MISC(BIN_CHILD(w2)), 0.01, 0.5);
+#endif
+#endif
+
free(str);
- gtk_misc_set_alignment(GTK_MISC(w2), 0.01, 0.5);
gtk_box_pack_start(GTK_BOX(parent), w2, false, false, 0);
gtk_widget_show(w2);
@@ -1369,8 +1448,6 @@ static GtkWidget *make_top_level_label(const char *label, GtkWidget *parent)
gtk_widget_show(w3);
make_inter_variable_separator(parent);
-
- return(w2);
}
@@ -1382,14 +1459,14 @@ static GtkWidget *make_top_level_box(GtkWidget *topics)
gtk_box_pack_start(GTK_BOX(topics), frame, true, true, 0);
gtk_widget_show(frame);
- w = gtk_vbox_new(false, 0);
+ w = gtk_vbox_new(false, 2);
gtk_container_add(GTK_CONTAINER(frame), w);
gtk_widget_show(w);
return(w);
}
-static GtkWidget *make_inner_label(const char *label, GtkWidget *parent)
+static void make_inner_label(const char *label, GtkWidget *parent)
{
GtkWidget *w, *w1, *w2;
char *str;
@@ -1398,13 +1475,27 @@ static GtkWidget *make_inner_label(const char *label, GtkWidget *parent)
gtk_box_pack_start(GTK_BOX(parent), w1, false, false, 4);
gtk_widget_show(w1);
- w = gtk_label_new(label);
str = mus_format("<b>%s</b>", label);
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ w = gtk_label_new(label);
gtk_label_set_markup(GTK_LABEL(w), str);
gtk_label_set_use_markup(GTK_LABEL(w), true);
+ gtk_misc_set_alignment(GTK_MISC(w), 0.0, 0.5);
+#else
+ w = gtk_button_new_with_label(label);
+ add_highlight_button_style(w);
+ gtk_label_set_markup(GTK_LABEL(BIN_CHILD(w)), str);
+ gtk_label_set_use_markup(GTK_LABEL(BIN_CHILD(w)), true);
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_widget_set_halign(GTK_WIDGET(w), GTK_ALIGN_START);
+#else
+ gtk_misc_set_alignment(GTK_MISC(BIN_CHILD(w)), 0.0, 0.5);
+#endif
+#endif
+
free(str);
- gtk_misc_set_alignment(GTK_MISC(w), 0.0, 0.5);
gtk_box_pack_start(GTK_BOX(parent), w, false, false, 0);
gtk_widget_show(w);
@@ -1413,8 +1504,6 @@ static GtkWidget *make_inner_label(const char *label, GtkWidget *parent)
gtk_widget_show(w2);
make_inter_variable_separator(parent);
-
- return(w);
}
@@ -1527,9 +1616,9 @@ static void va_post_prefs_error(const char *msg, prefs_info *data, ...)
/* ---------------- preferences dialog ---------------- */
-widget_t start_preferences_dialog(void)
+widget_t make_preferences_dialog(void)
{
- GtkWidget *saveB, *revertB, *clearB, *helpB, *dismissB, *topics, *scroller, *current_sep;
+ GtkWidget *save_button, *revert_button, *clear_button, *help_button, *dismiss_button, *topics, *scroller;
prefs_info *prf;
char *str;
@@ -1540,6 +1629,9 @@ widget_t start_preferences_dialog(void)
}
preferences_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(preferences_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
gtk_window_set_title(GTK_WINDOW(preferences_dialog), "Preferences");
sg_make_resizable(preferences_dialog);
/* gtk_container_set_border_width (GTK_CONTAINER(preferences_dialog), 10); */
@@ -1549,54 +1641,56 @@ widget_t start_preferences_dialog(void)
(STARTUP_HEIGHT < gdk_screen_height()))
gtk_window_resize(GTK_WINDOW(preferences_dialog), STARTUP_WIDTH, STARTUP_HEIGHT);
- helpB = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(helpB, "dialog_button");
-
+ help_button = gtk_dialog_add_button(GTK_DIALOG(preferences_dialog), "Help", GTK_RESPONSE_NONE);
+ revert_button = gtk_dialog_add_button(GTK_DIALOG(preferences_dialog), "Revert", GTK_RESPONSE_NONE);
+ clear_button = gtk_dialog_add_button(GTK_DIALOG(preferences_dialog), "Clear", GTK_RESPONSE_NONE);
+ dismiss_button = gtk_dialog_add_button(GTK_DIALOG(preferences_dialog), "Go away", GTK_RESPONSE_NONE);
#if HAVE_EXTENSION_LANGUAGE
- saveB = gtk_button_new_from_stock(GTK_STOCK_SAVE);
- gtk_widget_set_name(saveB, "dialog_button");
+ save_button = gtk_dialog_add_button(GTK_DIALOG(preferences_dialog), "Save", GTK_RESPONSE_NONE);
+ gtk_widget_set_name(save_button, "dialog_button");
#endif
- revertB = gtk_button_new_from_stock(GTK_STOCK_REVERT_TO_SAVED);
- gtk_widget_set_name(revertB, "dialog_button");
+ gtk_widget_set_name(help_button, "dialog_button");
+ gtk_widget_set_name(revert_button, "dialog_button");
+ gtk_widget_set_name(clear_button, "dialog_button");
+ gtk_widget_set_name(dismiss_button, "dialog_button");
- clearB = gtk_button_new_from_stock(GTK_STOCK_CLEAR);
- gtk_widget_set_name(clearB, "dialog_button");
-
- dismissB = gtk_button_new_from_stock(GTK_STOCK_QUIT);
- gtk_widget_set_name(dismissB, "dialog_button");
- set_stock_button_label(dismissB, "Go Away");
-
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(preferences_dialog)), dismissB, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(preferences_dialog)), revertB, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(preferences_dialog)), clearB, true, true, 10);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(dismiss_button);
+ add_highlight_button_style(revert_button);
+ add_highlight_button_style(clear_button);
#if HAVE_EXTENSION_LANGUAGE
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(preferences_dialog)), saveB, true, true, 10);
+ add_highlight_button_style(save_button);
+#endif
+ add_highlight_button_style(help_button);
#endif
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(preferences_dialog)), helpB, true, true, 10);
SG_SIGNAL_CONNECT(preferences_dialog, "delete_event", preferences_delete_callback, NULL);
- SG_SIGNAL_CONNECT(dismissB, "clicked", preferences_dismiss_callback, NULL);
- SG_SIGNAL_CONNECT(revertB, "clicked", preferences_revert_callback, NULL);
- SG_SIGNAL_CONNECT(clearB, "clicked", preferences_clear_callback, NULL);
+ SG_SIGNAL_CONNECT(dismiss_button, "clicked", preferences_dismiss_callback, NULL);
+ SG_SIGNAL_CONNECT(revert_button, "clicked", preferences_revert_callback, NULL);
+ SG_SIGNAL_CONNECT(clear_button, "clicked", preferences_clear_callback, NULL);
#if HAVE_EXTENSION_LANGUAGE
- SG_SIGNAL_CONNECT(saveB, "clicked", preferences_save_callback, NULL);
+ SG_SIGNAL_CONNECT(save_button, "clicked", preferences_save_callback, NULL);
#endif
- SG_SIGNAL_CONNECT(helpB, "clicked", preferences_help_callback, NULL);
+ SG_SIGNAL_CONNECT(help_button, "clicked", preferences_help_callback, NULL);
- gtk_widget_show(dismissB);
+ gtk_widget_show(dismiss_button);
#if HAVE_EXTENSION_LANGUAGE
- gtk_widget_show(saveB);
+ gtk_widget_show(save_button);
#endif
- gtk_widget_show(revertB);
- gtk_widget_show(clearB);
- gtk_widget_show(helpB);
+ gtk_widget_show(revert_button);
+ gtk_widget_show(clear_button);
+ gtk_widget_show(help_button);
topics = gtk_vbox_new(false, 0);
scroller = gtk_scrolled_window_new(NULL, NULL);
gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(preferences_dialog)), scroller, true, true, 0);
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(scroller), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+#if HAVE_GTK_HEADER_BAR_NEW
+ gtk_container_add(GTK_CONTAINER(scroller), topics);
+#else
gtk_scrolled_window_add_with_viewport(GTK_SCROLLED_WINDOW(scroller), topics);
+#endif
gtk_widget_show(topics);
gtk_widget_show(scroller);
@@ -1618,13 +1712,13 @@ widget_t start_preferences_dialog(void)
/* ---------------- overall behavior ---------------- */
{
- GtkWidget *dpy_box, *dpy_label, *file_label, *cursor_label, *key_label;
+ GtkWidget *dpy_box;
char *str1, *str2;
/* ---------------- overall behavior ----------------*/
dpy_box = make_top_level_box(topics);
- dpy_label = make_top_level_label("overall behavior choices", dpy_box);
+ make_top_level_label("overall behavior choices", dpy_box);
str1 = mus_format("%d", ss->init_window_width);
str2 = mus_format("%d", ss->init_window_height);
@@ -1638,21 +1732,21 @@ widget_t start_preferences_dialog(void)
free(str2);
free(str1);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_toggle("ask before overwriting anything", S_ask_before_overwrite,
rts_ask_before_overwrite = ask_before_overwrite(ss),
dpy_box,
overwrite_toggle);
remember_pref(prf, reflect_ask_before_overwrite, save_ask_before_overwrite, help_ask_before_overwrite, NULL, revert_ask_before_overwrite);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_toggle("ask about unsaved edits before exiting", S_ask_about_unsaved_edits,
rts_unsaved_edits = ask_about_unsaved_edits(ss),
dpy_box,
unsaved_edits_toggle);
remember_pref(prf, reflect_unsaved_edits, save_unsaved_edits, help_unsaved_edits, clear_unsaved_edits, revert_unsaved_edits);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_toggle("include thumbnail graph in upper right corner", S_with_inset_graph,
rts_with_inset_graph = with_inset_graph(ss),
dpy_box,
@@ -1660,14 +1754,14 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_with_inset_graph, save_with_inset_graph, help_inset_graph,
clear_with_inset_graph, revert_with_inset_graph);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_toggle("resize main window as sounds open and close", S_auto_resize,
rts_auto_resize = auto_resize(ss),
dpy_box,
resize_toggle);
remember_pref(prf, reflect_auto_resize, save_auto_resize, help_auto_resize, NULL, revert_auto_resize);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_toggle("pointer focus", S_with_pointer_focus,
rts_with_pointer_focus = with_pointer_focus(ss),
dpy_box,
@@ -1675,7 +1769,7 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_with_pointer_focus, save_with_pointer_focus, help_pointer_focus,
clear_with_pointer_focus, revert_with_pointer_focus);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_sync_style = sync_style(ss);
prf = prefs_row_with_two_toggles("operate on all channels together", S_sync,
"within each sound", rts_sync_style == SYNC_BY_SOUND,
@@ -1684,7 +1778,7 @@ widget_t start_preferences_dialog(void)
sync1_choice, sync2_choice);
remember_pref(prf, reflect_sync_style, save_sync_style, help_sync_style, clear_sync_style, revert_sync_style);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_remember_sound_state = remember_sound_state(ss);
prf = prefs_row_with_toggle("restore a sound's state if reopened later", S_remember_sound_state,
rts_remember_sound_state,
@@ -1693,14 +1787,14 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_remember_sound_state, save_remember_sound_state, help_remember_sound_state,
clear_remember_sound_state, revert_remember_sound_state);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_toggle("show the control panel upon opening a sound", S_show_controls,
rts_show_controls = in_show_controls(ss),
dpy_box,
controls_toggle);
remember_pref(prf, reflect_show_controls, save_show_controls, help_show_controls, NULL, revert_show_controls);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
include_peak_env_directory = mus_strdup(peak_env_dir(ss));
rts_peak_env_directory = mus_strdup(include_peak_env_directory);
include_peak_envs = find_peak_envs();
@@ -1712,7 +1806,7 @@ widget_t start_preferences_dialog(void)
peak_envs_toggle, peak_envs_text);
remember_pref(prf, reflect_peak_envs, save_peak_envs, help_peak_envs, clear_peak_envs, revert_peak_envs);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
str = mus_format("%d", rts_max_regions = max_regions(ss));
prf = prefs_row_with_toggle_with_text("selection creates an associated region", S_selection_creates_region,
rts_selection_creates_region = selection_creates_region(ss),
@@ -1723,7 +1817,7 @@ widget_t start_preferences_dialog(void)
free(str);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_with_toolbar = with_toolbar(ss);
prf = prefs_row_with_toggle("include a toolbar", S_with_toolbar,
rts_with_toolbar,
@@ -1731,7 +1825,7 @@ widget_t start_preferences_dialog(void)
toggle_with_toolbar);
remember_pref(prf, reflect_with_toolbar, save_with_toolbar, help_with_toolbar, clear_with_toolbar, revert_with_toolbar);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_with_tooltips = with_tooltips(ss);
prf = prefs_row_with_toggle("enable tooltips", S_with_tooltips,
rts_with_tooltips,
@@ -1740,7 +1834,7 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_with_tooltips, save_with_tooltips, help_with_tooltips, clear_with_tooltips, revert_with_tooltips);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_with_menu_icons = with_menu_icons(ss);
prf = prefs_row_with_toggle("enable menu icons (gtk only)", S_with_menu_icons,
rts_with_menu_icons,
@@ -1752,25 +1846,25 @@ widget_t start_preferences_dialog(void)
/* ---------------- file options ---------------- */
- current_sep = make_inter_variable_separator(dpy_box);
- file_label = make_inner_label(" file options", dpy_box);
+ make_inter_variable_separator(dpy_box);
+ make_inner_label(" file options", dpy_box);
rts_load_path = find_sources();
- prf = prefs_row_with_text("directory containing Snd's " XEN_LANGUAGE_NAME " files", "load path",
+ prf = prefs_row_with_text("directory containing Snd's " Xen_language " files", "load path",
rts_load_path,
dpy_box,
load_path_text);
remember_pref(prf, reflect_load_path, NULL, help_load_path, clear_load_path, revert_load_path);
load_path_text_widget = prf->text;
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_toggle("display only sound files in various file lists", S_just_sounds,
rts_just_sounds = just_sounds(ss),
dpy_box,
just_sounds_toggle);
remember_pref(prf, prefs_reflect_just_sounds, save_just_sounds, help_just_sounds, NULL, revert_just_sounds);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_temp_dir = mus_strdup(temp_dir(ss));
prf = prefs_row_with_text("directory for temporary files", S_temp_dir,
temp_dir(ss),
@@ -1778,7 +1872,7 @@ widget_t start_preferences_dialog(void)
temp_dir_text);
remember_pref(prf, reflect_temp_dir, save_temp_dir, help_temp_dir, NULL, revert_temp_dir);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_save_dir = mus_strdup(save_dir(ss));
prf = prefs_row_with_text("directory for save-state files", S_save_dir,
save_dir(ss),
@@ -1786,7 +1880,7 @@ widget_t start_preferences_dialog(void)
save_dir_text);
remember_pref(prf, reflect_save_dir, save_save_dir, help_save_dir, NULL, revert_save_dir);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_save_state_file = mus_strdup(save_state_file(ss));
prf = prefs_row_with_text("default save-state filename", S_save_state_file,
save_state_file(ss),
@@ -1795,7 +1889,7 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_save_state_file, save_save_state_file, help_save_state_file, NULL, revert_save_state_file);
#if HAVE_LADSPA
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_ladspa_dir = mus_strdup(ladspa_dir(ss));
prf = prefs_row_with_text("directory for ladspa plugins", S_ladspa_dir,
ladspa_dir(ss),
@@ -1804,23 +1898,14 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_ladspa_dir, save_ladspa_dir, help_ladspa_dir, NULL, revert_ladspa_dir);
#endif
- current_sep = make_inter_variable_separator(dpy_box);
- rts_vf_directory = mus_strdup(view_files_find_any_directory());
- prf = prefs_row_with_text("directory for view-files dialog", S_add_directory_to_view_files_list,
- rts_vf_directory,
- dpy_box,
- view_files_directory_text);
- remember_pref(prf, reflect_view_files_directory, save_view_files_directory, help_view_files_directory, NULL, revert_view_files_directory);
- /* in this case clear_vf doesn't make much sense */
-
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_html_program = mus_strdup(html_program(ss));
prf = prefs_row_with_text("external program to read HTML files via snd-help", S_html_program,
html_program(ss),
dpy_box,
html_program_text);
remember_pref(prf, reflect_html_program, save_html_program, help_html_program, NULL, revert_html_program);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
rts_default_output_chans = default_output_chans(ss);
prf = prefs_row_with_radio_box("default new sound attributes: chans", S_default_output_chans,
@@ -1840,34 +1925,35 @@ widget_t start_preferences_dialog(void)
rts_default_output_header_type = default_output_header_type(ss);
prf = prefs_row_with_radio_box("header type", S_default_output_header_type,
- output_type_choices, NUM_OUTPUT_TYPE_CHOICES, -1,
+ output_header_type_choices, NUM_OUTPUT_HEADER_TYPE_CHOICES, -1,
dpy_box,
default_output_header_type_choice);
output_header_type_prf = prf;
remember_pref(prf, reflect_default_output_header_type, save_default_output_header_type, help_default_output_header_type, NULL, revert_default_output_header_type);
- rts_default_output_data_format = default_output_data_format(ss);
- prf = prefs_row_with_radio_box("data format", S_default_output_data_format,
- output_format_choices, NUM_OUTPUT_FORMAT_CHOICES, -1,
+ rts_default_output_sample_type = default_output_sample_type(ss);
+ prf = prefs_row_with_radio_box("sample type", S_default_output_sample_type,
+ output_sample_type_choices, NUM_OUTPUT_SAMPLE_TYPE_CHOICES, -1,
dpy_box,
- default_output_data_format_choice);
- output_data_format_prf = prf;
- remember_pref(prf, reflect_default_output_data_format, save_default_output_data_format, help_default_output_data_format, NULL, revert_default_output_data_format);
+ default_output_sample_type_choice);
+ output_sample_type_prf = prf;
+ remember_pref(prf, reflect_default_output_sample_type, save_default_output_sample_type, help_default_output_sample_type, NULL, revert_default_output_sample_type);
reflect_default_output_header_type(output_header_type_prf);
- reflect_default_output_data_format(output_data_format_prf);
+ reflect_default_output_sample_type(output_sample_type_prf);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
{
- int i, srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int i, srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
str = mus_format("%d", chans);
str1 = mus_format("%d", srate);
rts_raw_chans = chans;
rts_raw_srate = srate;
- rts_raw_data_format = format;
- raw_data_format_choices = (char **)calloc(MUS_NUM_DATA_FORMATS - 1, sizeof(char *));
- for (i = 1; i < MUS_NUM_DATA_FORMATS; i++)
- raw_data_format_choices[i - 1] = raw_data_format_to_string(i); /* skip MUS_UNKNOWN */
+ rts_raw_sample_type = samp_type;
+ raw_sample_type_choices = (char **)calloc(MUS_NUM_SAMPLES - 1, sizeof(char *));
+ for (i = 1; i < MUS_NUM_SAMPLES; i++)
+ raw_sample_type_choices[i - 1] = raw_sample_type_to_string((mus_sample_t)i); /* skip MUS_UNKNOWN_SAMPLE = 0 */
prf = prefs_row_with_text("default raw sound attributes: chans", S_mus_header_raw_defaults, str,
dpy_box,
raw_chans_choice);
@@ -1881,107 +1967,106 @@ widget_t start_preferences_dialog(void)
free(str1);
- prf = prefs_row_with_list("data format", S_mus_header_raw_defaults, raw_data_format_choices[format - 1],
- (const char **)raw_data_format_choices, MUS_NUM_DATA_FORMATS - 1,
+ prf = prefs_row_with_list("sample type", S_mus_header_raw_defaults, raw_sample_type_choices[samp_type - 1],
+ (const char **)raw_sample_type_choices, MUS_NUM_SAMPLES - 1,
dpy_box,
- raw_data_format_from_text,
+ raw_sample_type_from_text,
NULL, NULL);
- remember_pref(prf, reflect_raw_data_format, save_raw_data_format, help_raw_data_format, NULL, revert_raw_data_format);
+ remember_pref(prf, reflect_raw_sample_type, save_raw_sample_type, help_raw_sample_type, NULL, revert_raw_sample_type);
}
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
- /* ---------------- additional key bindings ---------------- */
+ /* ---------------- additional keys ---------------- */
{
key_info *ki;
- key_label = make_inner_label(" additional key bindings", dpy_box);
-
- ki = find_prefs_key_binding("play-from-cursor");
+ make_inner_label(" additional keys", dpy_box);
+ ki = find_prefs_key("play-from-cursor");
prf = prefs_row_with_text_and_three_toggles("play all chans from cursor", S_play,
"key:", 8, "ctrl:", "meta:", "C-x:",
ki->key, ki->c, ki->m, ki->x,
dpy_box,
bind_play_from_cursor);
- remember_pref(prf, reflect_play_from_cursor, save_pfc_binding, help_play_from_cursor, clear_play_from_cursor, NULL);
+ remember_pref(prf, reflect_play_from_cursor, save_pfc, help_play_from_cursor, clear_play_from_cursor, NULL);
free(ki);
- current_sep = make_inter_variable_separator(dpy_box);
- ki = find_prefs_key_binding("show-all");
+ make_inter_variable_separator(dpy_box);
+ ki = find_prefs_key("show-all");
prf = prefs_row_with_text_and_three_toggles("show entire sound", S_x_bounds,
"key:", 8, "ctrl:", "meta:", "C-x:",
ki->key, ki->c, ki->m, ki->x,
dpy_box,
bind_show_all);
- remember_pref(prf, reflect_show_all, save_show_all_binding, help_show_all, clear_show_all, NULL);
+ remember_pref(prf, reflect_show_all, save_show_all, help_show_all, clear_show_all, NULL);
free(ki);
- current_sep = make_inter_variable_separator(dpy_box);
- ki = find_prefs_key_binding("select-all");
+ make_inter_variable_separator(dpy_box);
+ ki = find_prefs_key("select-all");
prf = prefs_row_with_text_and_three_toggles("select entire sound", S_select_all,
"key:", 8, "ctrl:", "meta:", "C-x:",
ki->key, ki->c, ki->m, ki->x,
dpy_box,
bind_select_all);
- remember_pref(prf, reflect_select_all, save_select_all_binding, help_select_all, clear_select_all, NULL);
+ remember_pref(prf, reflect_select_all, save_select_all, help_select_all, clear_select_all, NULL);
free(ki);
- current_sep = make_inter_variable_separator(dpy_box);
- ki = find_prefs_key_binding("show-selection");
+ make_inter_variable_separator(dpy_box);
+ ki = find_prefs_key("show-selection");
prf = prefs_row_with_text_and_three_toggles("show current selection", "show-selection",
"key:", 8, "ctrl:", "meta:", "C-x:",
ki->key, ki->c, ki->m, ki->x,
dpy_box,
bind_show_selection);
- remember_pref(prf, reflect_show_selection, save_show_selection_binding, help_show_selection, clear_show_selection, NULL);
+ remember_pref(prf, reflect_show_selection, save_show_selection, help_show_selection, clear_show_selection, NULL);
free(ki);
- current_sep = make_inter_variable_separator(dpy_box);
- ki = find_prefs_key_binding("revert-sound");
+ make_inter_variable_separator(dpy_box);
+ ki = find_prefs_key("revert-sound");
prf = prefs_row_with_text_and_three_toggles("undo all edits (revert)", S_revert_sound,
"key:", 8, "ctrl:", "meta:", "C-x:",
ki->key, ki->c, ki->m, ki->x,
dpy_box,
bind_revert);
- remember_pref(prf, reflect_revert, save_revert_binding, help_revert, clear_revert_sound, NULL);
+ remember_pref(prf, reflect_revert, save_revert, help_revert, clear_revert_sound, NULL);
free(ki);
- current_sep = make_inter_variable_separator(dpy_box);
- ki = find_prefs_key_binding("exit");
+ make_inter_variable_separator(dpy_box);
+ ki = find_prefs_key("exit");
prf = prefs_row_with_text_and_three_toggles("exit from Snd", S_exit,
"key:", 8, "ctrl:", "meta:", "C-x:",
ki->key, ki->c, ki->m, ki->x,
dpy_box,
bind_exit);
- remember_pref(prf, reflect_exit, save_exit_binding, help_exit, clear_exit, NULL);
+ remember_pref(prf, reflect_exit, save_exit, help_exit, clear_exit, NULL);
free(ki);
- current_sep = make_inter_variable_separator(dpy_box);
- ki = find_prefs_key_binding("goto-maxamp");
+ make_inter_variable_separator(dpy_box);
+ ki = find_prefs_key("goto-maxamp");
prf = prefs_row_with_text_and_three_toggles("move cursor to channel's maximum sample", S_maxamp_position,
"key:", 8, "ctrl:", "meta:", "C-x:",
ki->key, ki->c, ki->m, ki->x,
dpy_box,
bind_goto_maxamp);
- remember_pref(prf, reflect_goto_maxamp, save_goto_maxamp_binding, help_goto_maxamp, clear_goto_maxamp, NULL);
+ remember_pref(prf, reflect_goto_maxamp, save_goto_maxamp, help_goto_maxamp, clear_goto_maxamp, NULL);
free(ki);
}
/* ---------------- cursor options ---------------- */
- current_sep = make_inter_variable_separator(dpy_box);
- cursor_label = make_inner_label(" cursor options", dpy_box);
+ make_inter_variable_separator(dpy_box);
+ make_inner_label(" cursor options", dpy_box);
prf = prefs_row_with_toggle("report cursor location as it moves", S_with_verbose_cursor,
- rts_verbose_cursor = verbose_cursor(ss),
+ rts_with_verbose_cursor = with_verbose_cursor(ss),
dpy_box,
- verbose_cursor_toggle);
- remember_pref(prf, reflect_verbose_cursor, save_verbose_cursor, help_verbose_cursor, NULL, revert_verbose_cursor);
+ with_verbose_cursor_toggle);
+ remember_pref(prf, reflect_with_verbose_cursor, save_with_verbose_cursor, help_with_verbose_cursor, NULL, revert_with_verbose_cursor);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
{
char *str1;
str = mus_format("%.2f", rts_cursor_update_interval = cursor_update_interval(ss));
@@ -1998,7 +2083,7 @@ widget_t start_preferences_dialog(void)
free(str1);
}
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
str = mus_format("%d", rts_cursor_size = cursor_size(ss));
prf = prefs_row_with_number("size", S_cursor_size,
str, 4,
@@ -2008,7 +2093,7 @@ widget_t start_preferences_dialog(void)
free(str);
if (cursor_size(ss) <= 0) gtk_widget_set_sensitive(prf->arrow_down, false);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_radio_box("shape", S_cursor_style,
cursor_styles, NUM_CURSOR_STYLES,
rts_cursor_style = cursor_style(ss),
@@ -2016,7 +2101,7 @@ widget_t start_preferences_dialog(void)
cursor_style_choice);
remember_pref(prf, reflect_cursor_style, save_cursor_style, help_cursor_style, NULL, revert_cursor_style);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
prf = prefs_row_with_radio_box("tracking cursor shape", S_tracking_cursor_style,
cursor_styles, NUM_CURSOR_STYLES,
rts_tracking_cursor_style = tracking_cursor_style(ss),
@@ -2024,7 +2109,7 @@ widget_t start_preferences_dialog(void)
tracking_cursor_style_choice);
remember_pref(prf, reflect_tracking_cursor_style, save_tracking_cursor_style, help_tracking_cursor_style, NULL, revert_tracking_cursor_style);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
saved_cursor_color = ss->cursor_color;
prf = prefs_color_selector_row("color", S_cursor_color, ss->cursor_color,
dpy_box,
@@ -2033,8 +2118,8 @@ widget_t start_preferences_dialog(void)
/* ---------------- (overall) colors ---------------- */
- current_sep = make_inter_variable_separator(dpy_box);
- cursor_label = make_inner_label(" colors", dpy_box);
+ make_inter_variable_separator(dpy_box);
+ make_inner_label(" colors", dpy_box);
saved_basic_color = ss->basic_color;
prf = prefs_color_selector_row("main background color", S_basic_color, ss->basic_color,
@@ -2042,21 +2127,21 @@ widget_t start_preferences_dialog(void)
basic_color_func);
remember_pref(prf, NULL, save_basic_color, help_basic_color, clear_basic_color, revert_basic_color);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
saved_highlight_color = ss->highlight_color;
prf = prefs_color_selector_row("main highlight color", S_highlight_color, ss->highlight_color,
dpy_box,
highlight_color_func);
remember_pref(prf, NULL, save_highlight_color, help_highlight_color, clear_highlight_color, revert_highlight_color);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
saved_position_color = ss->position_color;
prf = prefs_color_selector_row("second highlight color", S_position_color, ss->position_color,
dpy_box,
position_color_func);
remember_pref(prf, NULL, save_position_color, help_position_color, clear_position_color, revert_position_color);
- current_sep = make_inter_variable_separator(dpy_box);
+ make_inter_variable_separator(dpy_box);
saved_zoom_color = ss->zoom_color;
prf = prefs_color_selector_row("third highlight color", S_zoom_color, ss->zoom_color,
dpy_box,
@@ -2064,16 +2149,16 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, NULL, save_zoom_color, help_zoom_color, clear_zoom_color, revert_zoom_color);
}
- current_sep = make_inter_topic_separator(topics);
+ make_inter_topic_separator(topics);
/* -------- graphs -------- */
{
- GtkWidget *grf_box, *grf_label, *colgrf_label;
+ GtkWidget *grf_box;
/* ---------------- graph options ---------------- */
grf_box = make_top_level_box(topics);
- grf_label = make_top_level_label("graph options", grf_box);
+ make_top_level_label("graph options", grf_box);
prf = prefs_row_with_radio_box("how to connect the dots", S_graph_style,
graph_styles, NUM_GRAPH_STYLES,
@@ -2082,7 +2167,7 @@ widget_t start_preferences_dialog(void)
graph_style_choice);
remember_pref(prf, reflect_graph_style, save_graph_style, help_graph_style, NULL, revert_graph_style);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
str = mus_format("%d", rts_dot_size = dot_size(ss));
prf = prefs_row_with_number("dot size", S_dot_size,
str, 4,
@@ -2092,7 +2177,7 @@ widget_t start_preferences_dialog(void)
free(str);
if (dot_size(ss) <= 0) gtk_widget_set_sensitive(prf->arrow_down, false);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
rts_initial_beg = initial_beg(ss);
rts_initial_dur = initial_dur(ss);
str = mus_format("%.2f : %.2f", rts_initial_beg, rts_initial_dur);
@@ -2105,7 +2190,7 @@ widget_t start_preferences_dialog(void)
free(str);
remember_pref(prf, reflect_initial_bounds, save_initial_bounds, help_initial_bounds, clear_initial_bounds, revert_initial_bounds);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
prf = prefs_row_with_radio_box("how to layout multichannel graphs", S_channel_style,
channel_styles, NUM_CHANNEL_STYLES,
rts_channel_style = channel_style(ss),
@@ -2113,21 +2198,21 @@ widget_t start_preferences_dialog(void)
channel_style_choice);
remember_pref(prf, reflect_channel_style, save_channel_style, help_channel_style, NULL, revert_channel_style);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
prf = prefs_row_with_toggle("layout wave and fft graphs horizontally", S_graphs_horizontal,
rts_graphs_horizontal = graphs_horizontal(ss),
grf_box,
graphs_horizontal_toggle);
remember_pref(prf, reflect_graphs_horizontal, save_graphs_horizontal, help_graphs_horizontal, NULL, revert_graphs_horizontal);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
prf = prefs_row_with_toggle("include y=0 line in sound graphs", S_show_y_zero,
rts_show_y_zero = show_y_zero(ss),
grf_box,
y_zero_toggle);
remember_pref(prf, reflect_show_y_zero, save_show_y_zero, help_show_y_zero, NULL, revert_show_y_zero);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
rts_show_grid = show_grid(ss);
prf = prefs_row_with_toggle("include a grid in sound graphs", S_show_grid,
rts_show_grid == WITH_GRID,
@@ -2135,7 +2220,7 @@ widget_t start_preferences_dialog(void)
grid_toggle);
remember_pref(prf, reflect_show_grid, save_show_grid, help_show_grid, NULL, revert_show_grid);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
prf = prefs_row_with_scale("grid density", S_grid_density,
2.0, rts_grid_density = grid_density(ss),
grf_box,
@@ -2143,7 +2228,7 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_grid_density, save_grid_density, help_grid_density, NULL, revert_grid_density);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
rts_show_axes = show_axes(ss);
prf = prefs_row_with_list("what axes to display", S_show_axes, show_axes_choices[(int)rts_show_axes],
show_axes_choices, NUM_SHOW_AXES,
@@ -2152,7 +2237,7 @@ widget_t start_preferences_dialog(void)
NULL, NULL);
remember_pref(prf, reflect_show_axes, save_show_axes, help_show_axes, clear_show_axes, revert_show_axes);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
rts_x_axis_style = x_axis_style(ss);
prf = prefs_row_with_list("time division", S_x_axis_style, x_axis_styles[(int)rts_x_axis_style],
x_axis_styles, NUM_X_AXIS_STYLES,
@@ -2161,7 +2246,7 @@ widget_t start_preferences_dialog(void)
NULL, NULL);
remember_pref(prf, reflect_x_axis_style, save_x_axis_style, help_x_axis_style, clear_x_axis_style, revert_x_axis_style);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
prf = prefs_row_with_toggle("include smpte info", "show-smpte-label",
rts_with_smpte_label = with_smpte_label(ss),
grf_box,
@@ -2171,8 +2256,8 @@ widget_t start_preferences_dialog(void)
/* ---------------- (graph) colors ---------------- */
- current_sep = make_inter_variable_separator(grf_box);
- colgrf_label = make_inner_label(" colors", grf_box);
+ make_inter_variable_separator(grf_box);
+ make_inner_label(" colors", grf_box);
saved_data_color = ss->data_color;
prf = prefs_color_selector_row("unselected data (waveform) color", S_data_color, ss->data_color,
@@ -2180,28 +2265,28 @@ widget_t start_preferences_dialog(void)
data_color_func);
remember_pref(prf, NULL, save_data_color, help_data_color, clear_data_color, revert_data_color);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
saved_graph_color = ss->graph_color;
prf = prefs_color_selector_row("unselected graph (background) color", S_graph_color, ss->graph_color,
grf_box,
graph_color_func);
remember_pref(prf, NULL, save_graph_color, help_graph_color, clear_graph_color, revert_graph_color);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
saved_selected_data_color = ss->selected_data_color;
prf = prefs_color_selector_row("selected channel data (waveform) color", S_selected_data_color, ss->selected_data_color,
grf_box,
selected_data_color_func);
remember_pref(prf, NULL, save_selected_data_color, help_selected_data_color, clear_selected_data_color, revert_selected_data_color);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
saved_selected_graph_color = ss->selected_graph_color;
prf = prefs_color_selector_row("selected channel graph (background) color", S_selected_graph_color, ss->selected_graph_color,
grf_box,
selected_graph_color_func);
remember_pref(prf, NULL, save_selected_graph_color, help_selected_graph_color, clear_selected_graph_color, revert_selected_graph_color);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
saved_selection_color = ss->selection_color;
prf = prefs_color_selector_row("selection color", S_selection_color, ss->selection_color,
grf_box,
@@ -2210,8 +2295,8 @@ widget_t start_preferences_dialog(void)
/* ---------------- (graph) fonts ---------------- */
- current_sep = make_inter_variable_separator(grf_box);
- colgrf_label = make_inner_label(" fonts", grf_box);
+ make_inter_variable_separator(grf_box);
+ make_inner_label(" fonts", grf_box);
rts_axis_label_font = mus_strdup(axis_label_font(ss));
prf = prefs_row_with_text("axis label font", S_axis_label_font,
@@ -2220,7 +2305,7 @@ widget_t start_preferences_dialog(void)
axis_label_font_text);
remember_pref(prf, reflect_axis_label_font, save_axis_label_font, help_axis_label_font, clear_axis_label_font, revert_axis_label_font);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
rts_axis_numbers_font = mus_strdup(axis_numbers_font(ss));
prf = prefs_row_with_text("axis number font", S_axis_numbers_font,
axis_numbers_font(ss),
@@ -2228,7 +2313,7 @@ widget_t start_preferences_dialog(void)
axis_numbers_font_text);
remember_pref(prf, reflect_axis_numbers_font, save_axis_numbers_font, help_axis_numbers_font, clear_axis_numbers_font, revert_axis_numbers_font);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
rts_peaks_font = mus_strdup(peaks_font(ss));
prf = prefs_row_with_text("fft peaks font", S_peaks_font,
peaks_font(ss),
@@ -2236,7 +2321,7 @@ widget_t start_preferences_dialog(void)
peaks_font_text);
remember_pref(prf, reflect_peaks_font, save_peaks_font, help_peaks_font, clear_peaks_font, revert_peaks_font);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
rts_bold_peaks_font = mus_strdup(bold_peaks_font(ss));
prf = prefs_row_with_text("fft peaks bold font (for main peaks)", S_bold_peaks_font,
bold_peaks_font(ss),
@@ -2244,7 +2329,7 @@ widget_t start_preferences_dialog(void)
bold_peaks_font_text);
remember_pref(prf, reflect_bold_peaks_font, save_bold_peaks_font, help_bold_peaks_font, clear_bold_peaks_font, revert_bold_peaks_font);
- current_sep = make_inter_variable_separator(grf_box);
+ make_inter_variable_separator(grf_box);
rts_tiny_font = mus_strdup(tiny_font(ss));
prf = prefs_row_with_text("tiny font (for various annotations)", S_peaks_font,
tiny_font(ss),
@@ -2253,19 +2338,19 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_tiny_font, save_tiny_font, help_tiny_font, clear_tiny_font, revert_tiny_font);
}
- current_sep = make_inter_topic_separator(topics);
+ make_inter_topic_separator(topics);
/* -------- transform -------- */
{
- GtkWidget *fft_box, *fft_label;
+ GtkWidget *fft_box;
/* ---------------- transform options ---------------- */
fft_box = make_top_level_box(topics);
- fft_label = make_top_level_label("transform options", fft_box);
+ make_top_level_label("transform options", fft_box);
rts_fft_size = transform_size(ss);
- str = mus_format(MUS_LD, rts_fft_size);
+ str = mus_format("%lld", rts_fft_size);
prf = prefs_row_with_number("size", S_transform_size,
str, 12,
fft_box,
@@ -2274,7 +2359,7 @@ widget_t start_preferences_dialog(void)
free(str);
if (transform_size(ss) <= 2) gtk_widget_set_sensitive(prf->arrow_down, false);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
prf = prefs_row_with_radio_box("transform graph choice", S_transform_graph_type,
transform_graph_types, NUM_TRANSFORM_GRAPH_TYPES,
rts_transform_graph_type = transform_graph_type(ss),
@@ -2283,7 +2368,7 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_transform_graph_type, save_transform_graph_type, help_transform_graph_type, NULL, revert_transform_graph_type);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
rts_transform_type = transform_type(ss);
prf = prefs_row_with_list("transform", S_transform_type, transform_types[rts_transform_type],
transform_types, NUM_BUILTIN_TRANSFORM_TYPES,
@@ -2292,7 +2377,7 @@ widget_t start_preferences_dialog(void)
transform_type_completer, NULL);
remember_pref(prf, reflect_transform_type, save_transform_type, help_transform_type, clear_transform_type, revert_transform_type);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
rts_fft_window = fft_window(ss);
prf = prefs_row_with_list("data window", S_fft_window, mus_fft_window_name(rts_fft_window),
mus_fft_window_names(), MUS_NUM_FFT_WINDOWS,
@@ -2302,14 +2387,14 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_fft_window, save_fft_window, help_fft_window, clear_fft_window, revert_fft_window);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
prf = prefs_row_with_scale("data window family parameter", S_fft_window_beta,
1.0, rts_fft_window_beta = fft_window_beta(ss),
fft_box,
fft_window_beta_scale_callback, fft_window_beta_text_callback);
remember_pref(prf, reflect_fft_window_beta, save_fft_window_beta, help_fft_window_beta, NULL, revert_fft_window_beta);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
str = mus_format("%d", rts_max_transform_peaks = max_transform_peaks(ss));
prf = prefs_row_with_toggle_with_text("show fft peak data", S_show_transform_peaks,
rts_show_transform_peaks = show_transform_peaks(ss),
@@ -2320,7 +2405,7 @@ widget_t start_preferences_dialog(void)
free(str);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
{
const char **cmaps;
int i, len;
@@ -2339,14 +2424,14 @@ widget_t start_preferences_dialog(void)
}
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
prf = prefs_row_with_toggle("y axis as log magnitude (dB)", S_fft_log_magnitude,
rts_fft_log_magnitude = fft_log_magnitude(ss),
fft_box,
log_magnitude_toggle);
remember_pref(prf, reflect_fft_log_magnitude, save_fft_log_magnitude, help_fft_log_magnitude, NULL, revert_fft_log_magnitude);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
str = mus_format("%.1f", rts_min_dB = min_dB(ss));
prf = prefs_row_with_text("minimum y-axis dB value", S_min_dB, str,
fft_box,
@@ -2354,14 +2439,14 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_min_dB, save_min_dB, help_min_dB, NULL, revert_min_dB);
free(str);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
prf = prefs_row_with_toggle("x axis as log freq", S_fft_log_frequency,
rts_fft_log_frequency = fft_log_frequency(ss),
fft_box,
log_frequency_toggle);
remember_pref(prf, reflect_fft_log_frequency, save_fft_log_frequency, help_fft_log_frequency, NULL, revert_fft_log_frequency);
- current_sep = make_inter_variable_separator(fft_box);
+ make_inter_variable_separator(fft_box);
prf = prefs_row_with_radio_box("normalization", S_transform_normalization,
transform_normalizations, NUM_TRANSFORM_NORMALIZATIONS,
rts_transform_normalization = transform_normalization(ss),
@@ -2370,17 +2455,17 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_transform_normalization, save_transform_normalization, help_transform_normalization, NULL, revert_transform_normalization);
}
- current_sep = make_inter_topic_separator(topics);
+ make_inter_topic_separator(topics);
/* -------- marks, mixes, and regions -------- */
{
- GtkWidget *mmr_box, *mmr_label;
+ GtkWidget *mmr_box;
char *str1, *str2;
/* ---------------- marks and mixes ---------------- */
mmr_box = make_top_level_box(topics);
- mmr_label = make_top_level_label("marks and mixes", mmr_box);
+ make_top_level_label("marks and mixes", mmr_box);
saved_mark_color = ss->mark_color;
prf = prefs_color_selector_row("mark and mix tag color", S_mark_color, ss->mark_color,
@@ -2388,7 +2473,7 @@ widget_t start_preferences_dialog(void)
mark_color_func);
remember_pref(prf, NULL, save_mark_color, help_mark_color, clear_mark_color, revert_mark_color);
- current_sep = make_inter_variable_separator(mmr_box);
+ make_inter_variable_separator(mmr_box);
str1 = mus_format("%d", rts_mark_tag_width = mark_tag_width(ss));
str2 = mus_format("%d", rts_mark_tag_height = mark_tag_height(ss));
@@ -2400,7 +2485,7 @@ widget_t start_preferences_dialog(void)
free(str2);
free(str1);
- current_sep = make_inter_variable_separator(mmr_box);
+ make_inter_variable_separator(mmr_box);
str1 = mus_format("%d", rts_mix_tag_width = mix_tag_width(ss));
str2 = mus_format("%d", rts_mix_tag_height = mix_tag_height(ss));
prf = prefs_row_with_two_texts("mix tag size", S_mix_tag_width,
@@ -2411,14 +2496,14 @@ widget_t start_preferences_dialog(void)
free(str2);
free(str1);
- current_sep = make_inter_variable_separator(mmr_box);
+ make_inter_variable_separator(mmr_box);
saved_mix_color = ss->mix_color;
prf = prefs_color_selector_row("mix waveform color", S_mix_color, ss->mix_color,
mmr_box,
mix_color_func);
remember_pref(prf, NULL, save_mix_color, help_mix_color, clear_mix_color, revert_mix_color);
- current_sep = make_inter_variable_separator(mmr_box);
+ make_inter_variable_separator(mmr_box);
str = mus_format("%d", rts_mix_waveform_height = mix_waveform_height(ss));
prf = prefs_row_with_toggle_with_text("show mix waveforms (attached to the mix tag)", S_show_mix_waveforms,
rts_show_mix_waveforms = show_mix_waveforms(ss),
@@ -2430,16 +2515,16 @@ widget_t start_preferences_dialog(void)
}
- current_sep = make_inter_topic_separator(topics);
+ make_inter_topic_separator(topics);
/* -------- clm -------- */
{
- GtkWidget *clm_box, *clm_label;
+ GtkWidget *clm_box;
/* ---------------- clm options ---------------- */
clm_box = make_top_level_box(topics);
- clm_label = make_top_level_label("clm", clm_box);
+ make_top_level_label("clm", clm_box);
str = mus_format("%d", rts_speed_control_tones = speed_control_tones(ss));
rts_speed_control_style = speed_control_style(ss);
@@ -2451,7 +2536,7 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_speed_control, save_speed_control, help_speed_control, NULL, revert_speed_control);
free(str);
- current_sep = make_inter_variable_separator(clm_box);
+ make_inter_variable_separator(clm_box);
str = mus_format("%d", rts_sinc_width = sinc_width(ss));
prf = prefs_row_with_text("sinc interpolation width in srate converter", S_sinc_width, str,
clm_box,
@@ -2460,16 +2545,16 @@ widget_t start_preferences_dialog(void)
free(str);
}
- current_sep = make_inter_topic_separator(topics);
+ make_inter_topic_separator(topics);
/* -------- programming -------- */
{
- GtkWidget *prg_box, *prg_label;
+ GtkWidget *prg_box;
/* ---------------- listener options ---------------- */
prg_box = make_top_level_box(topics);
- prg_label = make_top_level_label("listener options", prg_box);
+ make_top_level_label("listener options", prg_box);
prf = prefs_row_with_toggle("show listener at start up", S_show_listener,
rts_show_listener = listener_is_visible(),
@@ -2477,7 +2562,7 @@ widget_t start_preferences_dialog(void)
show_listener_toggle);
remember_pref(prf, reflect_show_listener, save_show_listener, help_show_listener, clear_show_listener, revert_show_listener);
- current_sep = make_inter_variable_separator(prg_box);
+ make_inter_variable_separator(prg_box);
rts_listener_prompt = mus_strdup(listener_prompt(ss));
prf = prefs_row_with_text("prompt", S_listener_prompt,
listener_prompt(ss),
@@ -2485,7 +2570,7 @@ widget_t start_preferences_dialog(void)
listener_prompt_text);
remember_pref(prf, reflect_listener_prompt, save_listener_prompt, help_listener_prompt, NULL, revert_listener_prompt);
- current_sep = make_inter_variable_separator(prg_box);
+ make_inter_variable_separator(prg_box);
str = mus_format("%d", rts_print_length = print_length(ss));
prf = prefs_row_with_text("number of vector elements to display", S_print_length, str,
prg_box,
@@ -2493,7 +2578,7 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_print_length, save_print_length, help_print_length, NULL, revert_print_length);
free(str);
- current_sep = make_inter_variable_separator(prg_box);
+ make_inter_variable_separator(prg_box);
rts_listener_font = mus_strdup(listener_font(ss));
prf = prefs_row_with_text("font", S_listener_font,
listener_font(ss),
@@ -2501,14 +2586,14 @@ widget_t start_preferences_dialog(void)
listener_font_text);
remember_pref(prf, reflect_listener_font, save_listener_font, help_listener_font, clear_listener_font, revert_listener_font);
- current_sep = make_inter_variable_separator(prg_box);
+ make_inter_variable_separator(prg_box);
saved_listener_color = ss->listener_color;
prf = prefs_color_selector_row("background color", S_listener_color, ss->listener_color,
prg_box,
listener_color_func);
remember_pref(prf, NULL, save_listener_color, help_listener_color, clear_listener_color, revert_listener_color);
- current_sep = make_inter_variable_separator(prg_box);
+ make_inter_variable_separator(prg_box);
saved_listener_text_color = ss->listener_text_color;
prf = prefs_color_selector_row("text color", S_listener_text_color, ss->listener_text_color,
prg_box,
@@ -2518,12 +2603,12 @@ widget_t start_preferences_dialog(void)
/* -------- audio -------- */
{
- GtkWidget *aud_box, *aud_label;
+ GtkWidget *aud_box;
/* ---------------- audio options ---------------- */
aud_box = make_top_level_box(topics);
- aud_label = make_top_level_label("audio options", aud_box);
+ make_top_level_label("audio options", aud_box);
str = mus_format("%d", rts_dac_size = dac_size(ss));
prf = prefs_row_with_text("dac buffer size", S_dac_size,
@@ -2533,7 +2618,7 @@ widget_t start_preferences_dialog(void)
remember_pref(prf, reflect_dac_size, save_dac_size, help_dac_size, NULL, revert_dac_size);
free(str);
- current_sep = make_inter_variable_separator(aud_box);
+ make_inter_variable_separator(aud_box);
prf = prefs_row_with_toggle("fold in otherwise unplayable channels", S_dac_combines_channels,
rts_dac_combines_channels = dac_combines_channels(ss),
aud_box,
diff --git a/snd-gprint.c b/snd-gprint.c
deleted file mode 100644
index 047313a..0000000
--- a/snd-gprint.c
+++ /dev/null
@@ -1,74 +0,0 @@
-#include "snd.h"
-
-static GtkPrintSettings *settings = NULL;
-
-static void begin_print(GtkPrintOperation *operation, GtkPrintContext *context, gpointer data)
-{
- gtk_print_operation_set_n_pages(operation, 1);
-}
-
-
-static void draw_page(GtkPrintOperation *operation, GtkPrintContext *context, gint page_num, gpointer data)
-{
- chan_info *cp;
-
- ss->cr = gtk_print_context_get_cairo_context(context);
-
- switch (ss->print_choice)
- {
- case PRINT_SND:
- cp = selected_channel();
- display_channel_data_for_print(cp);
- break;
-
- case PRINT_ENV:
- env_redisplay_with_print();
- break;
- }
-}
-
-
-static void end_print(GtkPrintOperation *operation, GtkPrintContext *context, gpointer data)
-{
- ss->cr = NULL;
-}
-
-
-void file_print_callback(GtkWidget *w, gpointer info)
-{
- /* called from File:Print in main menu */
- GtkPrintOperation *operation;
- GtkPrintOperationResult res;
- GError *error = NULL;
-
- operation = gtk_print_operation_new ();
- if (settings != NULL)
- gtk_print_operation_set_print_settings(operation, settings);
-
- g_signal_connect(G_OBJECT(operation), "begin-print", G_CALLBACK(begin_print), NULL);
- g_signal_connect(G_OBJECT(operation), "draw-page", G_CALLBACK(draw_page), NULL);
- g_signal_connect(G_OBJECT(operation), "end-print", G_CALLBACK(end_print), NULL);
-
- res = gtk_print_operation_run(operation, GTK_PRINT_OPERATION_ACTION_PRINT_DIALOG, GTK_WINDOW(MAIN_SHELL(ss)), &error);
- if (res == GTK_PRINT_OPERATION_RESULT_APPLY)
- {
- if (settings != NULL)
- g_object_unref(settings);
- settings = (GtkPrintSettings *)g_object_ref(gtk_print_operation_get_print_settings(operation));
- }
- g_object_unref(operation);
-
- if (error)
- {
- snd_warning_without_format(error->message);
- g_error_free (error);
- }
-}
-
-
-widget_t make_file_print_dialog(bool managed, bool direct_to_printer)
-{
- /* xen print-dialog code */
- file_print_callback(NULL, NULL);
- return(NULL);
-}
diff --git a/snd-grec.c b/snd-grec.c
deleted file mode 100644
index 141ea77..0000000
--- a/snd-grec.c
+++ /dev/null
@@ -1,382 +0,0 @@
-#include "snd.h"
-
-static GtkWidget *recorder = NULL, *meters = NULL, *record_button = NULL, *recorder_output = NULL, *info;
-static bool reading = false, recording = false;
-static char *recorder_filename = NULL;
-static int recorder_fd = -1, recorder_srate = 44100, recorder_chans = 2, recorder_format = MUS_LFLOAT;
-static mus_long_t recorder_total_bytes = 0;
-static graphics_context *recorder_ax = NULL;
-static int meter_width = 0, meter_height = 0, meters_width = 0;
-static bool meters_in_db = false;
-
-#define RECORDER_WIDTH 300
-#define RECORDER_HEIGHT 200
-
-static bool recorder_watching = false;
-static gulong recorder_text_id = 0;
-
-static char *base_message(void)
-{
- return(mus_format("srate: %d, chans: %d", recorder_srate, recorder_chans));
-}
-
-
-static void clear_error(void)
-{
- char *msg;
- msg = base_message();
- info_widget_display(info, msg);
- free(msg);
- widget_modify_base(info, GTK_STATE_NORMAL, ss->basic_color);
- widget_modify_base(info, GTK_STATE_ACTIVE, ss->basic_color);
- if (recorder_watching)
- {
- recorder_watching = false;
- g_signal_handler_disconnect(recorder_output, recorder_text_id);
- recorder_text_id = 0;
- }
-}
-
-
-static void watch_info(GtkWidget *w, gpointer context)
-{
- clear_error();
-}
-
-
-static void report_in_error_info(const char *msg, void *ignore)
-{
- info_widget_display(info, msg);
- widget_modify_base(info, GTK_STATE_NORMAL, ss->highlight_color);
- widget_modify_base(info, GTK_STATE_ACTIVE, ss->highlight_color);
- /* info_widget_set_size(info, 1 + mus_strlen(msg)); */
- recorder_watching = true;
- recorder_text_id = SG_SIGNAL_CONNECT(recorder_output, "changed", watch_info, NULL);
-}
-
-
-static void stop_recording(void)
-{
- clear_error();
- recording = false;
- mus_sound_close_output(recorder_fd, recorder_total_bytes);
- recorder_fd = -1;
- recorder_total_bytes = 0;
- set_stock_button_label(record_button, "Record");
-}
-
-
-static gint close_recorder(GtkWidget *w, GdkEvent *event, gpointer context)
-{
- /* window manager close button */
- if (recording)
- stop_recording();
- reading = false;
- gtk_widget_hide(recorder);
- return(true);
-}
-
-
-static void quit_recorder(GtkWidget *w, gpointer context)
-{
- /* Quit button in the recorder dialog */
- if (recording)
- stop_recording();
- reading = false;
- gtk_widget_hide(recorder);
-}
-
-
-static void recorder_help(GtkWidget *w, gpointer context)
-{
- recording_help();
-}
-
-
-static void display_meters(mus_float_t *maxes)
-{
- if (recorder_chans > 0)
- {
- cairo_t *cr = NULL;
- int i, x0 = 0;
- /* if maxes is NULL, assume all 0's */
-
- cr = MAKE_CAIRO(recorder_ax->wn);
- cairo_push_group(cr);
-
- cairo_set_source_rgb(cr, 1.0, 1.0, 1.0);
- cairo_rectangle(cr, 0, 0, meters_width, meter_height);
- cairo_fill(cr);
-
- for (i = 0; i < recorder_chans; i++, x0 += meter_width)
- {
- mus_float_t cur_max = 0.0;
- if (maxes)
- {
- if (!meters_in_db)
- cur_max = maxes[i];
- else
- {
- mus_float_t dv;
- dv = in_dB(min_dB(ss), ss->lin_dB, maxes[i]);
- cur_max = 1.0 + ((dv < -30.0) ? -30.0 : dv) / 30.0;
- }
- }
- cairo_save(cr);
-
- /* put our origin at the meter pivot point scaled (as a square so the dial remains circular) to 0..1 */
- cairo_translate(cr, x0 + (0.5 * meter_width), 0.5 * meter_width + 0.2 * meter_height);
- cairo_scale(cr, meter_width, meter_width);
-
- cairo_set_source_rgb(cr, 0.0, 0.0, 0.0);
- cairo_set_line_width(cr, 2.0 / (float)meter_width);
- cairo_arc(cr, 0, 0, 0.5, -0.75 * M_PI, -0.25 * M_PI);
- cairo_stroke(cr);
-
- cairo_rotate(cr, 1.2 * M_PI + cur_max * M_PI * 0.5);
- cairo_move_to(cr, 0, 0);
- cairo_rel_line_to(cr, 0.55, 0.0);
- cairo_stroke(cr);
-
- cairo_restore(cr);
- }
-
- cairo_pop_group_to_source(cr);
- cairo_paint(cr);
- FREE_CAIRO(cr);
- }
-}
-
-
-static void start_recording(void)
-{
- clear_error();
- recorder_filename = (char *)gtk_entry_get_text(GTK_ENTRY(recorder_output));
- if (recorder_filename == NULL) recorder_filename = mus_strdup("test.snd");
- redirect_snd_error_to(report_in_error_info, NULL);
- recorder_fd = mus_sound_open_output(recorder_filename, recorder_srate, recorder_chans, recorder_format,
- (recorder_format == MUS_LFLOAT) ? MUS_RIFF : MUS_NEXT,
- NULL);
- redirect_snd_error_to(NULL, NULL);
- if (recorder_fd < 0)
- {
- recording = false;
- }
- else
- {
- recording = true;
- set_stock_button_label(record_button, "Done");
- }
-}
-
-
-static void start_reading(void)
-{
- mus_float_t *maxes;
- int input_device, buffer_size, err = MUS_NO_ERROR;
- unsigned char *inbuf;
-
- clear_error();
-
- recorder_chans = mus_audio_device_channels(MUS_AUDIO_DEFAULT);
- if (recorder_chans > 4) recorder_chans = 8;
- if (recorder_chans <= 0)
- {
- char *msg;
- msg = mus_format("chans: %d?", recorder_chans);
- report_in_error_info(msg, NULL);
- free(msg);
- reading = false;
- return;
- }
-
- recorder_srate = 44100;
- recorder_format = mus_audio_device_format(MUS_AUDIO_DEFAULT);
- buffer_size = 4096;
-
- input_device = mus_audio_open_input(MUS_AUDIO_DEFAULT, recorder_srate, recorder_chans, recorder_format, buffer_size);
- if (input_device < 0)
- {
- char *msg;
- msg = mus_format("open input failed: chans: %d, srate: %d, format: %s, size: %d -> %d",
- recorder_chans, recorder_srate, mus_data_format_short_name(recorder_format), buffer_size, input_device);
- report_in_error_info(msg, NULL);
- free(msg);
-
- reading = false;
- return;
- }
-
- maxes = (mus_float_t *)calloc(recorder_chans, sizeof(mus_float_t));
- inbuf = (unsigned char *)calloc(buffer_size, sizeof(unsigned char));
-
- reading = true;
- while (true)
- {
- err = mus_audio_read(input_device, (char *)inbuf, buffer_size);
- if (err != MUS_NO_ERROR) break;
- if (recording)
- {
- ssize_t bytes;
- bytes = write(recorder_fd, (char *)inbuf, buffer_size);
- if (bytes != buffer_size)
- {
- char *msg;
- msg = mus_format("recorder wrote " SSIZE_TD " bytes of %d requested?", bytes, buffer_size);
- report_in_error_info(msg, NULL);
- free(msg);
- }
- recorder_total_bytes += buffer_size;
- }
- check_for_event(); /* watch for close event or "go away" clicked */
- if (!reading) break;
- err = mus_samples_peak(inbuf, buffer_size, recorder_chans, recorder_format, maxes);
- if (err != MUS_ERROR)
- display_meters(maxes);
- else
- {
- char *msg;
- msg = mus_format("data conversion problem; format is %s\n", mus_data_format_name(recorder_format));
- report_in_error_info(msg, NULL);
- free(msg);
- err = MUS_NO_ERROR;
- break;
- }
- }
- if (err != MUS_NO_ERROR)
- {
- char *msg;
- msg = mus_format("error: %s", mus_error_type_to_string(err));
- report_in_error_info(msg, NULL);
- free(msg);
- }
-
- mus_audio_close(input_device);
- free(inbuf);
- free(maxes);
-}
-
-
-static void start_or_stop_recorder(GtkWidget *w, gpointer context)
-{
- if (recording)
- stop_recording();
- else start_recording();
-}
-
-
-static gboolean meters_resize(GtkWidget *w, GdkEventConfigure *ev, gpointer data)
-{
- if (recorder_chans == 0) return(false);
- meters_width = widget_width(meters);
- meter_width = meters_width / recorder_chans;
- meter_height = widget_height(meters);
- display_meters(NULL);
- return(false);
-}
-
-
-static void db_callback(GtkWidget *w, gpointer context)
-{
- meters_in_db = (bool)(TOGGLE_BUTTON_ACTIVE(w));
-}
-
-
-widget_t record_file(void)
-{
- if (!recorder)
- {
- GtkWidget *help_button, *quit_button, *hbox, *output_label, *db_button;
-
- recorder = snd_gtk_dialog_new();
- SG_SIGNAL_CONNECT(recorder, "delete_event", close_recorder, NULL);
- gtk_window_set_title(GTK_WINDOW(recorder), "Record");
- sg_make_resizable(recorder);
- gtk_widget_realize(recorder);
- gtk_window_resize(GTK_WINDOW(recorder), RECORDER_WIDTH, RECORDER_HEIGHT);
-
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
-
- quit_button = gtk_button_new_from_stock(GTK_STOCK_QUIT);
- gtk_widget_set_name(quit_button, "dialog_button");
- set_stock_button_label(quit_button, "Go Away");
-
-#ifdef GTK_STOCK_MEDIA_RECORD
- record_button = sg_button_new_from_stock_with_label("Record", GTK_STOCK_MEDIA_RECORD);
-#else
- record_button = sg_button_new_from_stock_with_label("Record", GTK_STOCK_EXECUTE);
-#endif
- gtk_widget_set_name(record_button, "dialog_button");
-
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(recorder)), quit_button, true, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(recorder)), record_button, true, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(recorder)), help_button, true, true, 10);
-
- SG_SIGNAL_CONNECT(quit_button, "clicked", quit_recorder, NULL);
- SG_SIGNAL_CONNECT(help_button, "clicked", recorder_help, NULL);
- SG_SIGNAL_CONNECT(record_button, "clicked", start_or_stop_recorder, NULL);
-
- gtk_widget_show(quit_button);
- gtk_widget_show(record_button);
- gtk_widget_show(help_button);
-
- meters = gtk_drawing_area_new();
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(recorder)), meters, true, true, 8);
- gtk_widget_show(meters);
-
- hbox = gtk_hbox_new(false, 0);
- gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(recorder)), hbox, false, false, 6);
- gtk_widget_show(hbox);
-
- output_label = gtk_label_new("file:");
- gtk_box_pack_start(GTK_BOX(hbox), output_label, false, false, 2);
- gtk_widget_show(output_label);
-
- recorder_output = snd_entry_new(hbox, WITH_WHITE_BACKGROUND);
- if (!recorder_filename) recorder_filename = mus_strdup("test.snd");
- gtk_entry_set_text(GTK_ENTRY(recorder_output), recorder_filename);
-
- db_button = gtk_check_button_new_with_label("dB");
- gtk_box_pack_end(GTK_BOX(hbox), db_button, false, false, 10);
- gtk_widget_show(db_button);
- SG_SIGNAL_CONNECT(db_button, "toggled", db_callback, NULL);
-
- {
- GtkWidget *frame, *hbox, *fsep;
-
- hbox = gtk_hbox_new(false, 0);
- gtk_box_pack_end(GTK_BOX(DIALOG_CONTENT_AREA(recorder)), hbox, false, false, 8);
- gtk_widget_show(hbox);
-
- fsep = gtk_hseparator_new();
- gtk_box_pack_start(GTK_BOX(hbox), fsep, false, false, 20);
- widget_modify_bg(fsep, GTK_STATE_NORMAL, ss->basic_color);
- gtk_widget_show(fsep);
-
- frame = gtk_frame_new(NULL);
- gtk_frame_set_shadow_type(GTK_FRAME(frame), GTK_SHADOW_ETCHED_IN);
- /* gtk_container_set_border_width(GTK_CONTAINER(frame), 1); */
- /* widget_modify_bg(frame, GTK_STATE_NORMAL, ss->zoom_color); */
- gtk_box_pack_start(GTK_BOX(hbox), frame, true, true, 0);
- gtk_widget_show(frame);
-
- info = snd_gtk_entry_label_new(NULL, ss->basic_color);
- gtk_container_add(GTK_CONTAINER(frame), info);
- gtk_widget_show(info);
- }
-
- gtk_widget_show(recorder);
- set_dialog_widget(RECORDER_DIALOG, recorder);
-
- recorder_ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- recorder_ax->wn = WIDGET_TO_WINDOW(meters);
-
- SG_SIGNAL_CONNECT(meters, DRAW_SIGNAL, meters_resize, NULL);
- SG_SIGNAL_CONNECT(meters, "configure_event", meters_resize, NULL);
- }
- else gtk_widget_show(recorder);
- start_reading();
- return(recorder);
-}
-
diff --git a/snd-gregion.c b/snd-gregion.c
index 90cc1f1..8d64e92 100644
--- a/snd-gregion.c
+++ b/snd-gregion.c
@@ -1,5 +1,28 @@
#include "snd.h"
+static void sg_left_justify_button(GtkWidget *button)
+{
+#if GTK_CHECK_VERSION(3, 0, 0)
+ gtk_widget_set_halign(GTK_WIDGET(button), GTK_ALIGN_START);
+#else
+ gfloat x, y;
+ gtk_misc_get_alignment(GTK_MISC(GTK_LABEL(BIN_CHILD(button))), &x, &y);
+ gtk_misc_set_alignment(GTK_MISC(GTK_LABEL(BIN_CHILD(button))), 0.05, y);
+#endif
+}
+
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+static void sg_left_justify_label(GtkWidget *label)
+{
+ /* the label justify function in Gtk refers to the text of the lines after the first! */
+ gfloat x, y;
+ gtk_misc_get_alignment(GTK_MISC(GTK_LABEL(label)), &x, &y);
+ gtk_misc_set_alignment(GTK_MISC(GTK_LABEL(label)), 0.05, y);
+}
+#endif
+
+
/* -------- region browser -------- */
typedef struct {
@@ -115,19 +138,35 @@ static void make_region_labels(file_info *hdr)
char *str;
if (hdr == NULL) return;
str = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(str, PRINT_BUFFER_SIZE, "srate: %d", hdr->srate);
+ snprintf(str, PRINT_BUFFER_SIZE, "srate: %d", hdr->srate);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
set_label(srate_text, str);
- mus_snprintf(str, PRINT_BUFFER_SIZE, "chans: %d", hdr->chans);
+#else
+ set_button_label(srate_text, str);
+#endif
+ snprintf(str, PRINT_BUFFER_SIZE, "chans: %d", hdr->chans);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
set_label(chans_text, str);
- mus_snprintf(str, PRINT_BUFFER_SIZE, "length: %.3f", (float)((double)(hdr->samples) / (float)(hdr->chans * hdr->srate)));
+#else
+ set_button_label(chans_text, str);
+#endif
+ snprintf(str, PRINT_BUFFER_SIZE, "length: %.3f", (float)((double)(hdr->samples) / (float)(hdr->chans * hdr->srate)));
+#if (!GTK_CHECK_VERSION(3, 0, 0))
set_label(length_text, str);
- mus_snprintf(str, PRINT_BUFFER_SIZE, "maxamp: %.3f", region_maxamp(region_list_position_to_id(current_region)));
+#else
+ set_button_label(length_text, str);
+#endif
+ snprintf(str, PRINT_BUFFER_SIZE, "maxamp: %.3f", region_maxamp(region_list_position_to_id(current_region)));
+#if (!GTK_CHECK_VERSION(3, 0, 0))
set_label(maxamp_text, str);
+#else
+ set_button_label(maxamp_text, str);
+#endif
free(str);
}
-void update_region_browser(bool grf_too)
+int update_region_browser(bool grf_too)
{
int i, len;
region_state *rs;
@@ -140,7 +179,9 @@ void update_region_browser(bool grf_too)
regrow *r;
r = region_row(i);
set_button_label(r->nm, rs->name[i]);
+#if WITH_AUDIO
set_toggle_button(r->pl, false, false, (void *)r);
+#endif
gtk_widget_show(r->rw);
}
@@ -149,7 +190,7 @@ void update_region_browser(bool grf_too)
gtk_widget_hide(region_rows[i]->rw);
free_region_state(rs);
- if (len == 0) return;
+ if (len == 0) return(0);
gtk_widget_show(region_list);
if (grf_too)
@@ -173,6 +214,7 @@ void update_region_browser(bool grf_too)
region_update_graph(cp);
}
}
+ return(len);
}
@@ -230,13 +272,6 @@ void delete_region_and_update_browser(int pos)
}
-static void region_unlist_callback(GtkWidget *w, gpointer context)
-{
- if (current_region != -1)
- delete_region_and_update_browser(current_region);
-}
-
-
static void region_insert_callback(GtkWidget *w, gpointer context)
{
if ((current_region != -1) &&
@@ -300,10 +335,33 @@ static gboolean region_down_arrow_callback(GtkWidget *w, GdkEventButton *ev, gpo
}
-static void region_focus_callback(GtkWidget *w, gpointer context) /* button clicked callback */
+
+static oclock_t mouse_down_time = 0, ev_mouse_down_time = 0;
+
+static gboolean select_event_callback(GtkWidget *w, GdkEventButton *ev, gpointer data)
+{
+ ev_mouse_down_time = EVENT_TIME(ev);
+ return(false);
+}
+
+
+static void region_focus_callback(GtkWidget *w, gpointer context) /* button clicked callback */
{
chan_info *cp;
regrow *r = (regrow *)context;
+
+ if (mouse_down_time != 0)
+ {
+ if ((ev_mouse_down_time - mouse_down_time) < 200)
+ {
+ mouse_down_time = ev_mouse_down_time;
+ if (current_region != -1)
+ region_edit(current_region);
+ return;
+ }
+ }
+ mouse_down_time = ev_mouse_down_time;
+
unhighlight_region();
if (region_list_position_to_id(r->pos) == INVALID_REGION) return; /* needed by auto-tester */
set_current_region(r->pos);
@@ -321,68 +379,86 @@ static void region_focus_callback(GtkWidget *w, gpointer context) /* button clic
void reflect_play_region_stop(int n)
{
+#if WITH_AUDIO
if (region_rows)
{
regrow *rg;
rg = region_row(region_id_to_list_position(n));
if (rg) set_toggle_button(rg->pl, false, false, (void *)rg);
}
+#endif
}
static void region_play_callback(GtkWidget *w, gpointer context)
{
+#if WITH_AUDIO
regrow *r = (regrow *)context;
if (TOGGLE_BUTTON_ACTIVE(r->pl))
play_region(region_list_position_to_id(r->pos), IN_BACKGROUND);
else stop_playing_region(region_list_position_to_id(r->pos), PLAY_BUTTON_UNSET);
+#endif
}
-static void region_edit_callback(GtkWidget *w, gpointer context)
+static Xen reflect_file_in_region_browser(Xen hook_or_reason)
{
- if (current_region != -1)
- region_edit(current_region);
+ if (region_dialog)
+ {
+ bool file_on;
+ file_on = (bool)(any_selected_sound());
+ set_sensitive(mix_button, file_on);
+ set_sensitive(insert_button, file_on);
+ }
+ return(Xen_false);
}
+Xen_wrap_1_arg(reflect_file_in_region_browser_w, reflect_file_in_region_browser)
-static gboolean region_labels_mouse_enter(GtkWidget *w, GdkEventCrossing *ev, gpointer data)
+char *regrow_get_label(void *ur)
{
- g_signal_stop_emission((gpointer)w, g_signal_lookup("enter_notify_event", G_OBJECT_TYPE((gpointer)w)), 0);
- return(false);
+ regrow *r = (regrow *)ur;
+ return((char *)gtk_label_get_text(GTK_LABEL(BIN_CHILD(r->nm))));
}
-static XEN reflect_file_in_region_browser(XEN reason)
+int regrow_get_pos(void *ur)
{
- if (region_dialog)
+ regrow *r = (regrow *)ur;
+ return(r->pos);
+}
+
+
+static Xen mouse_enter_label_hook;
+static Xen mouse_leave_label_hook;
+
+static void mouse_enter_or_leave_label(void *r, int type, Xen hook, const char *caller)
+{
+ if ((r) &&
+ (Xen_hook_has_list(hook)))
{
- bool file_p;
- file_p = (bool)(any_selected_sound());
- set_sensitive(mix_button, file_p);
- set_sensitive(insert_button, file_p);
+ char *label = NULL;
+ label = regrow_get_label(r);
+ if (label)
+ run_hook(hook,
+ Xen_list_3(C_int_to_Xen_integer(type),
+ C_int_to_Xen_integer(regrow_get_pos(r)),
+ C_string_to_Xen_string(label)),
+ caller);
+
}
- return(XEN_FALSE);
}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(reflect_file_in_region_browser_w, reflect_file_in_region_browser)
-#else
- #define reflect_file_in_region_browser_w reflect_file_in_region_browser
-#endif
-
-char *regrow_get_label(void *ur)
+static void mouse_leave_label(void *r, int type)
{
- regrow *r = (regrow *)ur;
- return((char *)gtk_label_get_text(GTK_LABEL(BIN_CHILD(r->nm))));
+ mouse_enter_or_leave_label(r, type, mouse_leave_label_hook, S_mouse_leave_label_hook);
}
-int regrow_get_pos(void *ur)
+static void mouse_enter_label(void *r, int type)
{
- regrow *r = (regrow *)ur;
- return(r->pos);
+ mouse_enter_or_leave_label(r, type, mouse_enter_label_hook, S_mouse_enter_label_hook);
}
@@ -412,49 +488,89 @@ static regrow *make_regrow(GtkWidget *ww, GCallback play_callback, GCallback nam
widget_modify_base(r->rw, GTK_STATE_NORMAL, ss->white);
gtk_widget_show(r->rw);
+#if WITH_AUDIO
r->pl = gtk_check_button_new();
gtk_box_pack_start(GTK_BOX(r->rw), r->pl, false, false, 2);
SG_SIGNAL_CONNECT(r->pl, "toggled", play_callback, r);
gtk_widget_show(r->pl);
+#endif
r->nm = gtk_button_new_with_label("");
+ widget_modify_bg(r->nm, GTK_STATE_NORMAL, ss->white);
+ widget_modify_base(r->nm, GTK_STATE_NORMAL, ss->white);
+ gtk_button_set_relief(GTK_BUTTON(r->nm), GTK_RELIEF_HALF);
sg_left_justify_button(r->nm);
gtk_box_pack_start(GTK_BOX(r->rw), r->nm, true, true, 2);
+ add_white_button_style(r->nm);
+
SG_SIGNAL_CONNECT(r->nm, "clicked", name_callback, r);
SG_SIGNAL_CONNECT(r->nm, "enter_notify_event", regrow_mouse_enter_label, r);
SG_SIGNAL_CONNECT(r->nm, "leave_notify_event", regrow_mouse_leave_label, r);
- set_user_data(G_OBJECT(r->nm), (gpointer)r);
- widget_modify_bg(r->nm, GTK_STATE_NORMAL, ss->white);
- widget_modify_base(r->nm, GTK_STATE_NORMAL, ss->white);
-
-#if HAVE_GTK_3
- {
- GtkWidget *child;
- child = gtk_bin_get_child(GTK_BIN(r->nm));
- gtk_widget_override_color(child, GTK_STATE_NORMAL, (GdkRGBA *)(ss->black));
- gtk_widget_override_color(child, GTK_STATE_PRELIGHT, (GdkRGBA *)(ss->black));
- gtk_widget_override_color(child, GTK_STATE_SELECTED, (GdkRGBA *)(ss->black));
- }
-#endif
+ SG_SIGNAL_CONNECT(r->nm, "button_press_event", select_event_callback, NULL);
+ set_user_data(G_OBJECT(r->nm), (gpointer)r);
gtk_widget_show(r->nm);
return(r);
}
-static GtkWidget *edit_button, *unlist_button;
-static GtkWidget *dismiss_button, *help_button;
+static bool query_callback(GtkTooltip *tooltip, const char *which)
+{
+ snd_info *sp;
+
+ sp = any_selected_sound();
+ if (sp)
+ {
+ chan_info *cp;
+ cp = any_selected_channel(sp);
+ if (cp)
+ {
+ char *tip;
+ tip = mus_format("%s the selected region at the cursor (at time %.3f) in %s",
+ which,
+ ((double)cursor_sample(cp)) / ((double)(snd_srate(sp))),
+ sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ return(true);
+ }
+ }
+
+ if (strcmp(which, "insert") == 0)
+ gtk_tooltip_set_text(tooltip, "if there is an active sound, this inserts the selected region into it at the cursor");
+ else gtk_tooltip_set_text(tooltip, "if there is an active sound, this mixes the selected region with it starting at the cursor");
+ return(true);
+}
+
+
+static gboolean insert_region_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ return(query_callback(tooltip, "insert"));
+}
+
+
+static gboolean mix_region_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ return(query_callback(tooltip, "mix"));
+}
+
static void make_region_dialog(void)
{
- int i, id;
+ int i, id, rows;
regrow *r;
chan_info *cp;
- GtkWidget *infobox, *labels, *labbox;
- GtkWidget *sep1, *cww, *toppane, *tophbox, *plw, *formw;
+ GtkWidget *infobox, *labels, *labbox, *dismiss_button, *help_button;
+ GtkWidget *sep1, *cww, *toppane, *tophbox, *formw;
+#if WITH_AUDIO
+ GtkWidget *plw;
+#endif
region_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(region_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
SG_SIGNAL_CONNECT(region_dialog, "delete_event", region_browser_delete_callback, NULL);
gtk_window_set_title(GTK_WINDOW(region_dialog), "Regions");
sg_make_resizable(region_dialog);
@@ -462,27 +578,25 @@ static void make_region_dialog(void)
gtk_window_resize(GTK_WINDOW(region_dialog), 400, 500);
gtk_widget_realize(region_dialog);
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
+ insert_button = gtk_dialog_add_button(GTK_DIALOG(region_dialog), "Insert", GTK_RESPONSE_NONE);
+ mix_button = gtk_dialog_add_button(GTK_DIALOG(region_dialog), "Mix", GTK_RESPONSE_NONE);
+ save_as_button = gtk_dialog_add_button(GTK_DIALOG(region_dialog), "Save as", GTK_RESPONSE_NONE);
+ dismiss_button = gtk_dialog_add_button(GTK_DIALOG(region_dialog), "Go away", GTK_RESPONSE_NONE);
+ help_button = gtk_dialog_add_button(GTK_DIALOG(region_dialog), "Help", GTK_RESPONSE_NONE);
- dismiss_button = gtk_button_new_from_stock(GTK_STOCK_QUIT);
+ gtk_widget_set_name(help_button, "dialog_button");
gtk_widget_set_name(dismiss_button, "dialog_button");
- set_stock_button_label(dismiss_button, "Go Away");
-
- insert_button = sg_button_new_from_stock_with_label("Insert", GTK_STOCK_PASTE);
gtk_widget_set_name(insert_button, "dialog_button");
-
- mix_button = sg_button_new_from_stock_with_label("Mix", GTK_STOCK_ADD);
gtk_widget_set_name(mix_button, "dialog_button");
-
- save_as_button = gtk_button_new_from_stock(GTK_STOCK_SAVE_AS);
gtk_widget_set_name(save_as_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(region_dialog)), dismiss_button, true, true, 4);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(region_dialog)), insert_button, true, true, 4);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(region_dialog)), mix_button, true, true, 4);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(region_dialog)), save_as_button, true, true, 4);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(region_dialog)), help_button, true, true, 4);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(help_button);
+ add_highlight_button_style(dismiss_button);
+ add_highlight_button_style(insert_button);
+ add_highlight_button_style(save_as_button);
+ add_highlight_button_style(mix_button);
+#endif
SG_SIGNAL_CONNECT(insert_button, "clicked", region_insert_callback, NULL);
SG_SIGNAL_CONNECT(mix_button, "clicked", region_mix_callback, NULL);
@@ -490,6 +604,13 @@ static void make_region_dialog(void)
SG_SIGNAL_CONNECT(dismiss_button, "clicked", region_ok_callback, NULL);
SG_SIGNAL_CONNECT(save_as_button, "clicked", region_save_callback, NULL);
+ add_tooltip(insert_button, "insert the selected region");
+ add_tooltip(mix_button, "mix the selected region");
+ add_tooltip(save_as_button, "save the selected region to a file");
+
+ g_signal_connect(insert_button, "query-tooltip", G_CALLBACK(insert_region_tooltip), NULL);
+ g_signal_connect(mix_button, "query-tooltip", G_CALLBACK(mix_region_tooltip), NULL);
+
gtk_widget_show(insert_button);
gtk_widget_show(mix_button);
gtk_widget_show(help_button);
@@ -497,9 +618,11 @@ static void make_region_dialog(void)
gtk_widget_show(save_as_button);
region_grf = gtk_vpaned_new();
+ add_paned_style(region_grf);
gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(region_dialog)), region_grf, true, true, 0);
gtk_widget_show(region_grf);
+
toppane = gtk_hbox_new(false, 0);
gtk_paned_add1(GTK_PANED(region_grf), toppane);
gtk_widget_show(toppane);
@@ -516,9 +639,16 @@ static void make_region_dialog(void)
gtk_box_pack_start(GTK_BOX(formw), tophbox, false, false, 4);
gtk_widget_show(tophbox);
+#if WITH_AUDIO
+#if (!GTK_CHECK_VERSION(3, 0, 0))
plw = gtk_label_new("play");
+#else
+ plw = gtk_button_new_with_label("play");
+ add_highlight_button_style(plw);
+#endif
gtk_box_pack_start(GTK_BOX(tophbox), plw, false, false, 2);
gtk_widget_show(plw);
+#endif
sep1 = gtk_vseparator_new();
gtk_box_pack_start(GTK_BOX(formw), sep1, false, false, 2);
@@ -530,11 +660,19 @@ static void make_region_dialog(void)
cww = gtk_scrolled_window_new(NULL, NULL);
gtk_box_pack_start(GTK_BOX(formw), cww, true, true, 0);
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(cww), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+#if HAVE_GTK_HEADER_BAR_NEW
+ gtk_container_add(GTK_CONTAINER(cww), region_list);
+#else
gtk_scrolled_window_add_with_viewport(GTK_SCROLLED_WINDOW(cww), region_list);
+#endif
gtk_widget_show(region_list);
gtk_widget_show(cww);
+ sep1 = gtk_hseparator_new();
+ gtk_box_pack_end(GTK_BOX(formw), sep1, false, false, 2);
+ gtk_widget_show(sep1);
+
infobox = gtk_vbox_new(false, 0);
gtk_box_pack_start(GTK_BOX(toppane), infobox, false, false, 2);
@@ -549,7 +687,8 @@ static void make_region_dialog(void)
r->pos = i;
}
- update_region_browser(false);
+ rows = update_region_browser(false);
+ if (rows > 10) rows = 10;
/* in Gtk, apparently, labels are just the text, not the background (i.e. they're transparent) */
/* we need a button simply to get the background color, then a vbox to put four labels on the button */
@@ -557,49 +696,61 @@ static void make_region_dialog(void)
/* if we turn off the relief, the colors go away */
/* all I want is an opaque label with a background color */
- labels = gtk_button_new();
+ labels = gtk_event_box_new();
gtk_box_pack_start(GTK_BOX(infobox), labels, true, true, 2);
gtk_widget_show(labels);
widget_modify_bg(labels, GTK_STATE_NORMAL, ss->highlight_color);
- SG_SIGNAL_CONNECT(labels, "enter_notify_event", region_labels_mouse_enter, NULL);
+ /* SG_SIGNAL_CONNECT(labels, "enter_notify_event", region_labels_mouse_enter, NULL); */
labbox = gtk_vbox_new(true, 0);
gtk_container_add(GTK_CONTAINER(labels), labbox);
gtk_widget_show(labbox);
widget_modify_bg(labbox, GTK_STATE_NORMAL, ss->highlight_color);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
srate_text = gtk_label_new("srate:");
sg_left_justify_label(srate_text);
+#else
+ srate_text = gtk_button_new_with_label("srate:");
+ add_highlight_button_style(srate_text);
+ sg_left_justify_button(srate_text);
+#endif
gtk_box_pack_start(GTK_BOX(labbox), srate_text, false, false, 2);
gtk_widget_show(srate_text);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
chans_text = gtk_label_new("chans:");
sg_left_justify_label(chans_text);
+#else
+ chans_text = gtk_button_new_with_label("chans:");
+ add_highlight_button_style(chans_text);
+ sg_left_justify_button(chans_text);
+#endif
gtk_box_pack_start(GTK_BOX(labbox), chans_text, false, false, 2);
gtk_widget_show(chans_text);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
length_text = gtk_label_new("length:");
sg_left_justify_label(length_text);
+#else
+ length_text = gtk_button_new_with_label("length:");
+ add_highlight_button_style(length_text);
+ sg_left_justify_button(length_text);
+#endif
gtk_box_pack_start(GTK_BOX(labbox), length_text, false, false, 2);
gtk_widget_show(length_text);
+#if (!GTK_CHECK_VERSION(3, 0, 0))
maxamp_text = gtk_label_new("maxamp:");
sg_left_justify_label(maxamp_text);
+#else
+ maxamp_text = gtk_button_new_with_label("maxamp:");
+ add_highlight_button_style(maxamp_text);
+ sg_left_justify_button(maxamp_text);
+#endif
gtk_box_pack_start(GTK_BOX(labbox), maxamp_text, false, false, 2);
gtk_widget_show(maxamp_text);
- edit_button = gtk_button_new_with_label("edit");
- SG_SIGNAL_CONNECT(edit_button, "clicked", region_edit_callback, NULL);
- gtk_box_pack_start(GTK_BOX(infobox), edit_button, true, true, 2);
- gtk_widget_show(edit_button);
- widget_modify_bg(edit_button, GTK_STATE_NORMAL, ss->lighter_blue);
-
- unlist_button = gtk_button_new_with_label("unlist");
- SG_SIGNAL_CONNECT(unlist_button, "clicked", region_unlist_callback, NULL);
- gtk_box_pack_start(GTK_BOX(infobox), unlist_button, true, true, 2);
- gtk_widget_show(unlist_button);
- widget_modify_bg(unlist_button, GTK_STATE_NORMAL, ss->lighter_blue);
-
gtk_widget_show(region_dialog);
id = region_list_position_to_id(0);
@@ -608,7 +759,8 @@ static void make_region_dialog(void)
set_current_region(0);
cp = rsp->chans[0];
- gtk_paned_set_position(GTK_PANED(region_grf), 220);
+ gtk_paned_set_position(GTK_PANED(region_grf), (gint)floor(100 + rows * 14));
+
SG_SIGNAL_CONNECT(channel_graph(cp), DRAW_SIGNAL, region_resize_callback, cp);
SG_SIGNAL_CONNECT(channel_graph(cp), "configure_event", region_expose_callback, cp);
@@ -616,14 +768,18 @@ static void make_region_dialog(void)
SG_SIGNAL_CONNECT(channel_down_arrow(cp), "button_press_event", region_down_arrow_callback, NULL);
set_sensitive(channel_f(cp), false);
- if (region_chans(region_list_position_to_id(0)) > 1) set_sensitive(channel_w(cp), true);
+ set_sensitive(channel_w(cp), (region_chans(region_list_position_to_id(0)) > 1));
+
+ add_tooltip(channel_f(cp), "move the graph to the previous channel");
+ add_tooltip(channel_w(cp), "move the graph to the next channel");
+
cp->chan = 0;
rsp->hdr = fixup_region_data(cp, 0, 0);
make_region_labels(rsp->hdr);
highlight_region();
region_update_graph(cp);
- XEN_ADD_HOOK(ss->snd_open_file_hook, reflect_file_in_region_browser_w, "region-dialog-open-file-watcher", "region dialog open-file-hook handler");
+ Xen_add_to_hook_list(ss->snd_open_file_hook, reflect_file_in_region_browser_w, "region-dialog-open-file-watcher", "region dialog open-file-hook handler");
set_dialog_widget(REGION_DIALOG, region_dialog);
}
@@ -686,24 +842,303 @@ int region_dialog_region(void)
}
-static XEN g_view_regions_dialog(void)
+static Xen g_view_regions_dialog(void)
{
#define H_view_regions_dialog "(" S_view_regions_dialog "): start the region dialog"
if (snd_regions() > 0)
view_region_callback(MAIN_PANE(ss), NULL);
- return(XEN_WRAP_WIDGET(region_dialog));
+ return(Xen_wrap_widget(region_dialog));
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_view_regions_dialog_w, g_view_regions_dialog)
-#else
-#define g_view_regions_dialog_w g_view_regions_dialog
+Xen_wrap_no_args(g_view_regions_dialog_w, g_view_regions_dialog)
+
+void g_init_gxregion(void)
+{
+ Xen_define_procedure(S_view_regions_dialog, g_view_regions_dialog_w, 0, 0, 0, H_view_regions_dialog);
+#if HAVE_SCHEME
+ #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
+The 'type' is 1 for view-files, and 2 for regions. The 'position' \
+is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.scm \
+to popup file info as follows: \n\
+(hook-push " S_mouse_enter_label_hook "\n\
+ (lambda (type position name)\n\
+ (if (not (= type 2))\n\
+ (" S_info_dialog " name (finfo name)))))\n\
+See also nb.scm."
+#endif
+#if HAVE_RUBY
+ #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
+The 'type' is 1 for view-files, and 2 for regions. The 'position' \
+is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.rb \
+to popup file info as follows: \n\
+$mouse_enter_label_hook.add_hook!(\"finfo\") do |type, position, name|\n\
+ if type != 2\n\
+ " S_info_dialog "(name, finfo(name))\n\
+ end\n\
+end\n\
+See also nb.rb."
+#endif
+#if HAVE_FORTH
+ #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
+The 'type' is 1 for view-files, and 2 for regions. The 'position' \
+is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.fs \
+to popup file info as follows: \n\
+" S_mouse_enter_label_hook " lambda: <{ type position name }>\n\
+ type 2 <> if\n\
+ name name finfo info-dialog\n\
+ else\n\
+ #f\n\
+ then\n\
+; add-hook!"
#endif
+ #define H_mouse_leave_label_hook S_mouse_leave_label_hook " (type position label): called when the mouse leaves a file viewer or region label"
-void g_init_gxregion(void)
+ mouse_enter_label_hook = Xen_define_hook(S_mouse_enter_label_hook, "(make-hook 'type 'position 'label)", 3, H_mouse_enter_label_hook);
+ mouse_leave_label_hook = Xen_define_hook(S_mouse_leave_label_hook, "(make-hook 'type 'position 'label)", 3, H_mouse_leave_label_hook);
+}
+
+
+/* simple view-files replacement */
+
+#include "snd-file.h"
+
+GtkWidget *view_files_dialog = NULL;
+
+static gint vf_delete_callback(GtkWidget *w, GdkEvent *event, gpointer context)
+{
+ gtk_widget_hide(view_files_dialog);
+ return(true);
+}
+
+static void vf_ok_callback(GtkWidget *w, gpointer context)
+{
+ gtk_widget_hide(view_files_dialog);
+}
+
+static void vf_help_callback(GtkWidget *w, gpointer context)
{
- XEN_DEFINE_PROCEDURE(S_view_regions_dialog, g_view_regions_dialog_w, 0, 0, 0, H_view_regions_dialog);
+ view_files_dialog_help();
}
+
+static char **vf_names, **vf_full_names;
+static int vf_names_size = 0;
+static regrow **vf_rows = NULL;
+static snd_info *vf_play_sp = NULL;
+
+static bool view_files_play(int pos, bool play)
+{
+ if (play)
+ {
+ if (vf_play_sp)
+ {
+ if (vf_play_sp->playing) return(true); /* can't play two of these at once */
+ if (strcmp(vf_play_sp->short_filename, vf_names[pos]) != 0)
+ {
+ completely_free_snd_info(vf_play_sp);
+ vf_play_sp = NULL;
+ }
+ }
+ if ((!vf_play_sp) &&
+ (vf_full_names[pos]))
+ vf_play_sp = make_sound_readable(vf_full_names[pos], false);
+ if (vf_play_sp)
+ {
+ vf_play_sp->short_filename = vf_names[pos];
+ vf_play_sp->filename = NULL;
+ play_sound(vf_play_sp, 0, NO_END_SPECIFIED);
+ }
+ else return(true); /* can't find or setup file */
+ }
+ else
+ { /* play toggled off */
+ if ((vf_play_sp) &&
+ (vf_play_sp->playing))
+ {
+ stop_playing_sound(vf_play_sp, PLAY_BUTTON_UNSET);
+ }
+ }
+ return(false);
+}
+
+void view_files_unplay(void)
+{
+ int i;
+ for (i = 0; i < vf_names_size; i++)
+ if (TOGGLE_BUTTON_ACTIVE(vf_rows[i]->pl))
+ gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(vf_rows[i]->pl), false);
+}
+
+static void vf_focus_callback(GtkWidget *w, gpointer context) {}
+
+static void vf_play_callback(GtkWidget *w, gpointer context)
+{
+ regrow *r = (regrow *)context;
+ view_files_play(r->pos, TOGGLE_BUTTON_ACTIVE(r->pl));
+}
+
+static int sort_a_to_z(const void *a, const void *b)
+{
+ sort_info *d1 = *(sort_info **)a;
+ sort_info *d2 = *(sort_info **)b;
+ return(strcmp(d1->filename, d2->filename));
+}
+
+static void vf_sort(void)
+{
+ sort_info **data;
+ int i;
+
+ data = (sort_info **)calloc(vf_names_size, sizeof(sort_info *));
+ for (i = 0; i < vf_names_size; i++)
+ {
+ data[i] = (sort_info *)calloc(1, sizeof(sort_info));
+ data[i]->filename = vf_names[i];
+ data[i]->full_filename = vf_full_names[i];
+ }
+ qsort((void *)data, vf_names_size, sizeof(sort_info *), sort_a_to_z);
+ for (i = 0; i < vf_names_size; i++)
+ {
+ vf_names[i] = data[i]->filename;
+ vf_full_names[i] = data[i]->full_filename;
+ free(data[i]);
+ }
+ free(data);
+}
+
+void view_files_add_directory(widget_t dialog, const char *dirname)
+{
+ dir_info *sound_files = NULL;
+ if ((dirname) && (dirname[strlen(dirname) - 1] != '/'))
+ {
+ char *add_slash;
+ add_slash = mus_format("%s/", dirname);
+ sound_files = find_sound_files_in_dir(add_slash);
+ free(add_slash);
+ }
+ else sound_files = find_sound_files_in_dir(dirname);
+
+ if ((sound_files) &&
+ (sound_files->len > 0))
+ {
+ int i;
+
+ vf_names_size = sound_files->len;
+ vf_names = (char **)calloc(vf_names_size, sizeof(char *));
+ vf_full_names = (char **)calloc(vf_names_size, sizeof(char *));
+ vf_rows = (regrow **)calloc(vf_names_size, sizeof(regrow *));
+
+ for (i = 0; i < sound_files->len; i++)
+ {
+ vf_names[i] = mus_strdup(sound_files->files[i]->filename);
+ vf_full_names[i] = mus_strdup(sound_files->files[i]->full_filename);
+ }
+ sound_files = free_dir_info(sound_files);
+ vf_sort();
+ }
+}
+
+bool view_files_has_files(void)
+{
+ return(vf_names_size > 0);
+}
+
+void view_files_callback(GtkWidget *w, gpointer info)
+{
+ if (!view_files_dialog)
+ {
+ int i;
+ regrow *r;
+ GtkWidget *dismiss_button, *help_button, *vf_list;
+ GtkWidget *sep1, *cww, *tophbox, *formw;
+#if WITH_AUDIO
+ GtkWidget *plw;
+#endif
+ view_files_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(view_files_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
+ SG_SIGNAL_CONNECT(view_files_dialog, "delete_event", vf_delete_callback, NULL);
+ gtk_window_set_title(GTK_WINDOW(view_files_dialog), "Files");
+ sg_make_resizable(view_files_dialog);
+ gtk_container_set_border_width(GTK_CONTAINER(view_files_dialog), 10);
+ gtk_window_resize(GTK_WINDOW(view_files_dialog), 300, 500);
+ gtk_widget_realize(view_files_dialog);
+
+ dismiss_button = gtk_dialog_add_button(GTK_DIALOG(view_files_dialog), "Go away", GTK_RESPONSE_NONE);
+ help_button = gtk_dialog_add_button(GTK_DIALOG(view_files_dialog), "Help", GTK_RESPONSE_NONE);
+
+ gtk_widget_set_name(help_button, "dialog_button");
+ gtk_widget_set_name(dismiss_button, "dialog_button");
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(help_button);
+ add_highlight_button_style(dismiss_button);
+#endif
+
+ SG_SIGNAL_CONNECT(help_button, "clicked", vf_help_callback, NULL);
+ SG_SIGNAL_CONNECT(dismiss_button, "clicked", vf_ok_callback, NULL);
+
+ gtk_widget_show(help_button);
+ gtk_widget_show(dismiss_button);
+
+ formw = gtk_vbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(DIALOG_CONTENT_AREA(view_files_dialog)), formw, true, true, 0);
+ gtk_widget_show(formw);
+
+ sep1 = gtk_vseparator_new(); /* not hsep -- damned thing insists on drawing a line */
+ gtk_box_pack_start(GTK_BOX(formw), sep1, false, false, 2);
+ gtk_widget_show(sep1);
+
+ tophbox = gtk_hbox_new(false, 0);
+ gtk_box_pack_start(GTK_BOX(formw), tophbox, false, false, 4);
+ gtk_widget_show(tophbox);
+
+#if WITH_AUDIO
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ plw = gtk_label_new("play");
+#else
+ plw = gtk_button_new_with_label("play");
+ add_highlight_button_style(plw);
+#endif
+ gtk_box_pack_start(GTK_BOX(tophbox), plw, false, false, 2);
+ gtk_widget_show(plw);
+#endif
+
+ sep1 = gtk_vseparator_new();
+ gtk_box_pack_start(GTK_BOX(formw), sep1, false, false, 2);
+ gtk_widget_show(sep1);
+
+ vf_list = gtk_vbox_new(false, 0);
+
+ cww = gtk_scrolled_window_new(NULL, NULL);
+ gtk_box_pack_start(GTK_BOX(formw), cww, true, true, 0);
+ gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(cww), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+#if HAVE_GTK_HEADER_BAR_NEW
+ gtk_container_add(GTK_CONTAINER(cww), vf_list);
+#else
+ gtk_scrolled_window_add_with_viewport(GTK_SCROLLED_WINDOW(cww), vf_list);
+#endif
+
+ gtk_widget_show(vf_list);
+ gtk_widget_show(cww);
+
+ for (i = 0; i < vf_names_size; i++)
+ {
+ r = make_regrow(vf_list, (void (*)())vf_play_callback, (void (*)())vf_focus_callback);
+ vf_rows[i] = r;
+ r->pos = i;
+ set_button_label(r->nm, vf_names[i]);
+ }
+
+ gtk_widget_show(view_files_dialog);
+ set_dialog_widget(VIEW_FILES_DIALOG, view_files_dialog);
+ }
+ else
+ {
+ raise_dialog(view_files_dialog);
+ }
+
+}
diff --git a/snd-gsnd.c b/snd-gsnd.c
index a0a92cd..537e9bc 100644
--- a/snd-gsnd.c
+++ b/snd-gsnd.c
@@ -4,8 +4,10 @@
* with boxes. Especially the control panel.
*/
+#define sound_env_editor(Sp) ((env_editor *)(sp->flt))
+
enum {W_pane, W_pane_box, W_control_panel,
- W_name_form, W_name, W_name_event, W_name_pix, W_stop_pix, W_info_label, W_info,
+ W_name_form, W_name, W_name_event, W_name_pix, W_stop_pix, W_info,
W_play, W_sync, W_unite, W_close,
W_amp_form, W_amp_event, W_amp, W_amp_label, W_amp_number, W_amp_sep,
W_speed_form, W_speed, W_speed_event, W_speed_label, W_speed_label_event, W_speed_number, W_speed_pix,
@@ -15,7 +17,6 @@ enum {W_pane, W_pane_box, W_control_panel,
W_revlen, W_revlen_event, W_revlen_label, W_revlen_number, W_reverb_button,
W_filter_form, W_filter_label, W_filter_order, W_filter_env, W_filter, W_filter_button,
W_filter_dB, W_filter_hz, W_filter_frame,
- W_error_info_frame, W_error_info_label,
NUM_SND_WIDGETS
};
@@ -40,8 +41,7 @@ GtkWidget *w_snd_pane_box(snd_info *sp) {return(sp->snd_widgets[W_pane_box]);}
#define CLOSE_BUTTON(Sp) Sp->snd_widgets[W_close]
-#define MINIBUFFER_LABEL(Sp) Sp->snd_widgets[W_info_label]
-#define MINIBUFFER_TEXT(Sp) Sp->snd_widgets[W_info]
+#define STATUS_AREA(Sp) Sp->snd_widgets[W_info]
#define NAME_PIX(Sp) Sp->snd_widgets[W_name_pix]
#define STOP_PIX(Sp) Sp->snd_widgets[W_stop_pix]
#define SYNC_BUTTON(Sp) Sp->snd_widgets[W_sync]
@@ -49,9 +49,6 @@ GtkWidget *w_snd_pane_box(snd_info *sp) {return(sp->snd_widgets[W_pane_box]);}
#define UNITE_BUTTON(Sp) Sp->snd_widgets[W_unite]
#define CLOCK_PIX(Sp, Chan) Sp->clock_widgets[Chan]
-#define ERROR_INFO(Sp) Sp->snd_widgets[W_error_info_label]
-#define ERROR_INFO_FRAME(Sp) Sp->snd_widgets[W_error_info_frame]
-
#define CONTROL_PANEL(Sp) Sp->snd_widgets[W_control_panel]
#define AMP_HBOX(Sp) Sp->snd_widgets[W_amp_form]
@@ -114,125 +111,56 @@ GtkWidget *w_snd_pane_box(snd_info *sp) {return(sp->snd_widgets[W_pane_box]);}
#define FILTER_ADJUSTMENT(Sp) Sp->snd_adjs[W_filter_adj]
-/* -------- minibuffer error -------- */
-
-static void watch_minibuffer(GtkWidget *w, gpointer context)
-{
- clear_minibuffer_error((snd_info *)context);
-}
-
-
-void clear_minibuffer_error(snd_info *sp)
-{
- gtk_widget_hide(ERROR_INFO_FRAME(sp));
- gtk_widget_hide(ERROR_INFO(sp));
- if (sp->minibuffer_watcher)
- {
- g_signal_handler_disconnect(MINIBUFFER_TEXT(sp), sp->minibuffer_watcher);
- sp->minibuffer_watcher = 0;
- }
-}
-
-
-void display_minibuffer_error(snd_info *sp, const char *str)
-{
- char *s1 = NULL; /* change cr to space (cr is printed as a funny box in gtk) */
- int len, i;
- len = mus_strlen(str);
- if (len > 0)
- {
- s1 = mus_strdup(str);
- for (i = 0; i < len; i++)
- if (s1[i] == '\n')
- s1[i] = ' ';
- }
- info_widget_display(ERROR_INFO(sp), s1);
- gtk_widget_show(ERROR_INFO(sp));
- gtk_widget_show(ERROR_INFO_FRAME(sp));
- if (!(sp->minibuffer_watcher))
- sp->minibuffer_watcher = SG_SIGNAL_CONNECT(MINIBUFFER_TEXT(sp), "changed", watch_minibuffer, (gpointer)sp);
- if (s1) free(s1);
-}
-
-
static bool mini_lock_allocated = false;
static picture_t *mini_lock = NULL, *speed_r = NULL, *speed_l = NULL, *blank = NULL, *stop_sign = NULL;
-static picture_t *bombs[NUM_BOMBS];
+static picture_t *bomb = NULL;
void show_lock(snd_info *sp)
{
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
+ if (mini_lock)
{
- if (mini_lock)
- {
- draw_picture(sp->name_pix_ax, mini_lock, 0, 0, 0, 0, 16, 16);
- gtk_widget_show(NAME_PIX(sp));
- }
- MUS_UNLOCK(sp->stop_sign_lock);
+ draw_picture(sp->name_pix_ax, mini_lock, 0, 0, 0, 0, 16, 16);
+ gtk_widget_show(NAME_PIX(sp));
}
}
void hide_lock(snd_info *sp)
{
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- if (mini_lock)
- gtk_widget_hide(NAME_PIX(sp));
- MUS_UNLOCK(sp->stop_sign_lock);
- }
+ if (mini_lock)
+ gtk_widget_hide(NAME_PIX(sp));
}
static void show_stop_sign(snd_info *sp)
{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- if (stop_sign)
- draw_picture(sp->stop_pix_ax, stop_sign, 0, 0, 0, 0, 16, 16);
- gtk_widget_show(STOP_PIX(sp));
- MUS_UNLOCK(sp->stop_sign_lock);
- }
+ if (!has_widgets(sp)) return;
+ if (stop_sign)
+ draw_picture(sp->stop_pix_ax, stop_sign, 0, 0, 0, 0, 16, 16);
+ gtk_widget_show(STOP_PIX(sp));
}
static void hide_stop_sign(snd_info *sp)
{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- gtk_widget_hide(STOP_PIX(sp));
- MUS_UNLOCK(sp->stop_sign_lock);
- }
+ if (!has_widgets(sp)) return;
+ gtk_widget_hide(STOP_PIX(sp));
}
-void show_bomb(snd_info *sp)
+static void show_bomb(snd_info *sp)
{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- if (sp->bomb_ctr >= NUM_BOMBS)
- sp->bomb_ctr = 0;
- draw_picture(sp->name_pix_ax, bombs[sp->bomb_ctr], 0, 0, 0, 0, 16, 16);
- gtk_widget_show(NAME_PIX(sp));
- sp->bomb_ctr++;
- MUS_UNLOCK(sp->stop_sign_lock);
- }
+ if (!has_widgets(sp)) return;
+ draw_picture(sp->name_pix_ax, bomb, 0, 0, 0, 0, 16, 16);
+ gtk_widget_show(NAME_PIX(sp));
}
-void hide_bomb(snd_info *sp)
+static void hide_bomb(snd_info *sp)
{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- gtk_widget_hide(NAME_PIX(sp));
- sp->bomb_ctr = 0;
- MUS_UNLOCK(sp->stop_sign_lock);
- }
+ if (!has_widgets(sp)) return;
+ gtk_widget_hide(NAME_PIX(sp));
}
@@ -241,7 +169,7 @@ void hide_bomb(snd_info *sp)
static gint tick_bomb(gpointer data)
{
snd_info *sp = (snd_info *)data;
- if (!HAS_WIDGETS(sp)) return(0);
+ if (!has_widgets(sp)) return(0);
if (sp->need_update || sp->file_unreadable)
{
show_bomb(sp);
@@ -258,8 +186,7 @@ static gint tick_bomb(gpointer data)
void start_bomb(snd_info *sp)
{
- if (!HAS_WIDGETS(sp)) return;
- sp->bomb_ctr = 0;
+ if (!has_widgets(sp)) return;
if (!(sp->bomb_in_progress))
{
sp->bomb_in_progress = true;
@@ -270,7 +197,7 @@ void start_bomb(snd_info *sp)
void stop_bomb(snd_info *sp)
{
- if (!HAS_WIDGETS(sp)) return;
+ if (!has_widgets(sp)) return;
hide_bomb(sp);
sp->bomb_in_progress = false;
}
@@ -281,7 +208,7 @@ static Drawable *sound_pix_wn(chan_info *cp)
{
snd_info *sp = NULL;
if (cp) sp = cp->sound;
- if (!HAS_WIDGETS(sp)) return(NULL);
+ if (!has_widgets(sp)) return(NULL);
if ((cp->chan < sp->num_clock_widgets) &&
(CLOCK_PIX(sp, cp->chan)) &&
@@ -294,7 +221,7 @@ static Drawable *sound_pix_wn(chan_info *cp)
static void show_happy_face(Drawable *wn, mus_float_t pct)
{
cairo_t *cr;
- cr = MAKE_CAIRO(wn);
+ cr = make_cairo(wn);
/* overall background */
cairo_translate(cr, 0, 0);
@@ -346,18 +273,18 @@ static void show_happy_face(Drawable *wn, mus_float_t pct)
cairo_pop_group_to_source(cr);
cairo_paint(cr);
- FREE_CAIRO(cr);
+ free_cairo(cr);
}
static void hide_happy_face(Drawable *wn)
{
cairo_t *cr;
- cr = MAKE_CAIRO(wn);
+ cr = make_cairo(wn);
cairo_set_source_rgba(cr, ss->basic_color->red, ss->basic_color->green, ss->basic_color->blue, ss->basic_color->alpha);
cairo_rectangle(cr, 0, 0, 24, 24);
cairo_fill(cr);
- FREE_CAIRO(cr);
+ free_cairo(cr);
}
@@ -365,23 +292,28 @@ static void make_pixmaps(void)
{
if (!mini_lock_allocated)
{
- int k;
mini_lock = snd_icon(SND_PNG_LOCK);
stop_sign = snd_icon(SND_PNG_STOP);
blank = snd_icon(SND_PNG_BLANK);
speed_r = snd_icon(SND_PNG_RIGHT_ARROW);
speed_l = snd_icon(SND_PNG_LEFT_ARROW);
- for (k = 0; k < NUM_BOMBS; k++)
- bombs[k] = snd_icon(SND_PNG_BOMB);
+ bomb = snd_icon(SND_PNG_BOMB);
mini_lock_allocated = true;
}
}
+/* lock stop blank bomb as 16x16
+ * bomb (warning) is also 22x22 24x24 32x32
+ * lock (changes-prevent) and stop (stop) also
+ * but 24x24 doesn't look larger?
+ */
+
static gboolean name_pix_expose(GtkWidget *w, GdkEventExpose *ev, gpointer data)
{
snd_info *sp = (snd_info *)data;
- if ((HAS_WIDGETS(sp)) &&
+
+ if ((has_widgets(sp)) &&
(NAME_PIX(sp)) &&
(sp->name_pix_ax))
{
@@ -400,7 +332,7 @@ static gboolean clock_pix_expose(GtkWidget *w, GdkEventExpose *ev, gpointer data
snd_info *sp = NULL;
if (cp) sp = cp->sound;
- if ((HAS_WIDGETS(sp)) &&
+ if ((has_widgets(sp)) &&
(cp->chan < sp->num_clock_widgets) &&
(CLOCK_PIX(sp, cp->chan)) &&
(sp->clock_pix_ax[cp->chan]))
@@ -413,106 +345,20 @@ static gboolean clock_pix_expose(GtkWidget *w, GdkEventExpose *ev, gpointer data
}
-/* -------- MINIBUFFER CALLBACKS -------- */
-
-void goto_minibuffer(snd_info *sp)
-{
- if (sp)
- {
- sp->mini_active = true;
- goto_window(MINIBUFFER_TEXT(sp));
- }
-}
-
-
-void set_minibuffer_cursor_position(snd_info *sp, int pos)
-{
- if ((sp->inuse != SOUND_NORMAL) || (!HAS_WIDGETS(sp))) return;
- gtk_editable_set_position(GTK_EDITABLE(MINIBUFFER_TEXT(sp)), pos);
-}
-
-
-char *get_minibuffer_string(snd_info *sp)
-{
- if ((sp->inuse != SOUND_NORMAL) || (!HAS_WIDGETS(sp))) return(NULL);
- return(mus_strdup((char *)gtk_entry_get_text(GTK_ENTRY(MINIBUFFER_TEXT(sp)))));
-}
+/* -------- STATUS AREA CALLBACKS -------- */
static char stupid[1] = {'\0'};
-void set_minibuffer_string(snd_info *sp, const char *str, bool update)
+void set_status(snd_info *sp, const char *str, bool update)
{
- if ((sp->inuse != SOUND_NORMAL) || (!HAS_WIDGETS(sp))) return;
+ if ((sp->inuse != SOUND_NORMAL) || (!has_widgets(sp))) return;
if (str)
- gtk_entry_set_text(GTK_ENTRY(MINIBUFFER_TEXT(sp)), str);
- else gtk_entry_set_text(GTK_ENTRY(MINIBUFFER_TEXT(sp)), stupid);
+ set_label(STATUS_AREA(sp), str);
+ else set_label(STATUS_AREA(sp), stupid);
}
-void make_minibuffer_label(snd_info *sp, const char *str)
-{
- if ((sp->inuse != SOUND_NORMAL) || (!HAS_WIDGETS(sp))) return;
- gtk_label_set_text(GTK_LABEL(MINIBUFFER_LABEL(sp)), str);
-}
-
-
-static void minibuffer_activate_callback(GtkWidget *w, gpointer data)
-{
- snd_info *sp = (snd_info *)data;
- snd_minibuffer_activate(sp, 0, false);
- sp->mini_active = true;
-}
-
-
-static gboolean minibuffer_key_callback(GtkWidget *w, GdkEventKey *event, gpointer data)
-{
- /* can't use M-p in gtk version because it's trapped by a menu accelerator (File:Print) -- M-n is File:New */
- snd_info *sp = (snd_info *)data;
- if (((!sp->mini_active)) ||
- (((EVENT_KEYVAL(event) == snd_K_s) ||
- (EVENT_KEYVAL(event) == snd_K_r)) &&
- (EVENT_STATE(event) & snd_ControlMask)))
- {
- chan_info *cp;
- cp = current_channel();
- if (cp) graph_key_press(channel_graph(cp), event, (gpointer)cp);
- g_signal_stop_emission((gpointer)w, g_signal_lookup("key_press_event", G_OBJECT_TYPE((gpointer)w)), 0);
- return(true);
- }
- if (((EVENT_KEYVAL(event) == snd_K_g) || (EVENT_KEYVAL(event) == snd_K_G)) &&
- (EVENT_STATE(event) & snd_ControlMask))
- {
- clear_minibuffer(sp);
- return(true);
- }
- if (EVENT_KEYVAL(event) == snd_K_Tab)
- {
- gtk_entry_set_text(GTK_ENTRY(w), info_completer(w, (char *)gtk_entry_get_text(GTK_ENTRY(w)), data));
- gtk_editable_set_position(GTK_EDITABLE(w), mus_strlen((char *)gtk_entry_get_text(GTK_ENTRY(w))));
- return(true);
- }
- return(false);
-}
-
-
-static gboolean minibuffer_mouse_enter(GtkWidget *w, GdkEventCrossing *ev, gpointer data)
-{
- snd_info *sp = (snd_info *)data;
- if ((sp) && (sp->inuse == SOUND_NORMAL))
- sp->mini_active = true;
- return(false);
-}
-
-
-static gboolean minibuffer_mouse_leave(GtkWidget *w, GdkEventCrossing *ev, gpointer data)
-{
- snd_info *sp = (snd_info *)data;
- if ((sp) && (sp->inuse == SOUND_NORMAL))
- sp->mini_active = false;
- return(false);
-}
-
/* -------- PLAY BUTTON -------- */
@@ -525,21 +371,26 @@ static void set_button_base(GtkWidget *w, color_info *col)
void set_play_button(snd_info *sp, bool val)
{
- if (HAS_WIDGETS(sp))
+#if WITH_AUDIO
+ if (has_widgets(sp))
set_toggle_button(PLAY_BUTTON(sp), val, false, (void *)sp);
+#endif
}
void set_control_panel_play_button(snd_info *sp)
{
- if (HAS_WIDGETS(sp))
+#if WITH_AUDIO
+ if (has_widgets(sp))
{
set_toggle_button(PLAY_BUTTON(sp), false, false, sp);
set_button_base(PLAY_BUTTON(sp), ss->white);
}
+#endif
}
+#if WITH_AUDIO
static int last_play_state = 0;
/* these "last-*-state" variables are trying to catch C-M-click info which is then used
* presumably by the immediately following value-changed callback for the given button.
@@ -562,7 +413,7 @@ static void play_button_click_callback(GtkWidget *w, gpointer data)
if (sp->playing)
stop_playing_sound_no_toggle(sp, PLAY_BUTTON_UNSET);
- ss->tracking = ((with_tracking_cursor(ss)) ||
+ ss->tracking = ((with_tracking_cursor(ss) != DONT_TRACK) ||
((on) && (last_play_state & (snd_ControlMask | snd_MetaMask))));
cp = any_selected_channel(sp);
@@ -595,15 +446,18 @@ static void set_play_button_pause(snd_info *sp, void *ptr)
else set_button_base(w, ss->white);
}
}
+#endif
void play_button_pause(bool pausing)
{
+#if WITH_AUDIO
pause_data *pd;
pd = (pause_data *)calloc(1, sizeof(pause_data));
pd->pausing = pausing;
for_each_sound_with_void(set_play_button_pause, (void *)pd);
free(pd);
+#endif
}
@@ -627,7 +481,7 @@ void syncb(snd_info *sp, int on)
{
sp->sync = on;
if (on > ss->sound_sync_max) ss->sound_sync_max = on;
- if (HAS_WIDGETS(sp))
+ if (has_widgets(sp))
{
set_sync_color(sp);
set_toggle_button(SYNC_BUTTON(sp), (on != 0), false, (void *)sp);
@@ -669,8 +523,8 @@ static void sync_button_click(GtkWidget *w, gpointer data)
cp = sp->lacp;
if (cp == NULL) cp = any_selected_channel(sp);
goto_graph(cp);
- if (cp->cursor_on) sync_cursors(cp, CURSOR(cp));
- apply_x_axis_change(cp->axis, cp);
+ if (cp->cursor_on) sync_cursors(cp, cursor_sample(cp));
+ apply_x_axis_change(cp);
}
}
@@ -706,11 +560,34 @@ static void unite_button_click(GtkWidget *w, gpointer data)
static gboolean name_click_callback(GtkWidget *w, GdkEventButton *ev, gpointer data)
{
- sp_name_click((snd_info *)data);
+ char *str;
+ snd_info *sp = (snd_info *)data;
+ str = sp_name_click(sp);
+ if (str)
+ {
+ status_report(sp, "%s", str);
+ free(str);
+ }
return(false);
}
+static gboolean name_button_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ char *str;
+ snd_info *sp = (snd_info *)data;
+ str = sp_name_click(sp);
+ if (str)
+ {
+ gtk_tooltip_set_text(tooltip, str);
+ free(str);
+ }
+ else gtk_tooltip_set_text(tooltip, "nothing known about this sound!");
+ return(true);
+}
+
+
+
/* -------- AMP CALLBACKS -------- */
mus_float_t amp_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
@@ -739,7 +616,7 @@ static mus_float_t scroll_to_amp(snd_info *sp, mus_float_t val)
else sp->amp_control = (val * (1.0 - sp->amp_control_min) / (0.5 * 0.9)) + sp->amp_control_min;
}
}
- mus_snprintf(amp_number_buffer, 6, "%.3f", sp->amp_control);
+ snprintf(amp_number_buffer, 6, "%.3f", sp->amp_control);
gtk_label_set_text(GTK_LABEL(AMP_LABEL(sp)), amp_number_buffer);
return(val);
}
@@ -747,7 +624,7 @@ static mus_float_t scroll_to_amp(snd_info *sp, mus_float_t val)
void set_amp(snd_info *sp, mus_float_t amp)
{
- if (!HAS_WIDGETS(sp))
+ if (!has_widgets(sp))
sp->amp_control = amp;
else
{
@@ -814,7 +691,7 @@ static bool ignore_callback = false;
void set_speed(snd_info *sp, mus_float_t val)
{
- if (!HAS_WIDGETS(sp))
+ if (!has_widgets(sp))
sp->speed_control = val;
else
{
@@ -883,11 +760,9 @@ static gboolean speed_release_callback(GtkWidget *w, GdkEventButton *ev, gpointe
static void draw_speed_arrow(snd_info *sp)
{
- gtk_widget_hide(SPEED_ARROW(sp));
if (sp->speed_control_direction == 1)
draw_picture(sp->speed_arrow_ax, speed_r, 0, 0, 0, 0, 16, 16);
else draw_picture(sp->speed_arrow_ax, speed_l, 0, 0, 0, 0, 16, 16);
- gtk_widget_show(SPEED_ARROW(sp));
}
@@ -897,7 +772,9 @@ static gboolean speed_arrow_press(GtkWidget *w, GdkEventButton *ev, gpointer dat
if (sp->speed_control_direction == 1)
sp->speed_control_direction = -1;
else sp->speed_control_direction = 1;
- draw_speed_arrow(sp);
+ gtk_widget_hide(SPEED_ARROW(sp));
+ gtk_widget_show(SPEED_ARROW(sp));
+ /* draw_speed_arrow(sp); */
return(false);
}
@@ -911,10 +788,11 @@ static gboolean speed_arrow_expose(GtkWidget *w, GdkEventExpose *ev, gpointer da
void toggle_direction_arrow(snd_info *sp, bool state)
{
+ /* this is part of the apply-controls junk */
int dir = 1;
if (state) dir = -1;
sp->speed_control_direction = dir;
- if (HAS_WIDGETS(sp)) draw_speed_arrow(sp);
+ if (has_widgets(sp)) draw_speed_arrow(sp);
}
@@ -940,7 +818,7 @@ static mus_float_t scroll_to_expand(snd_info *sp, mus_float_t val)
else sp->expand_control = exp((val * (log(sp->expand_control_max) - log(sp->expand_control_min)) / 0.9) + log(sp->expand_control_min));
}
if (sp->playing) dac_set_expand(sp, sp->expand_control);
- mus_snprintf(expand_number_buffer, 6, "%.3f", sp->expand_control);
+ snprintf(expand_number_buffer, 6, "%.3f", sp->expand_control);
gtk_label_set_text(GTK_LABEL(EXPAND_LABEL(sp)), expand_number_buffer);
return(val);
}
@@ -948,7 +826,7 @@ static mus_float_t scroll_to_expand(snd_info *sp, mus_float_t val)
void set_expand(snd_info *sp, mus_float_t val)
{
- if (!HAS_WIDGETS(sp))
+ if (!has_widgets(sp))
sp->expand_control = val;
else
{
@@ -992,7 +870,7 @@ static gboolean expand_click_callback(GtkWidget *w, GdkEventButton *ev, gpointer
static void expand_button_callback(GtkWidget *w, gpointer context)
{
snd_info *sp = (snd_info *)context;
- sp->expand_control_p = TOGGLE_BUTTON_ACTIVE(w);
+ sp->expand_control_on = TOGGLE_BUTTON_ACTIVE(w);
/* to change the trough color: (widget_modify_bg (list-ref (channel-widgets) 3) GTK_STATE_ACTIVE (zoom-color)) */
/* and the slider color: (widget_modify_bg (list-ref (channel-widgets) 3) GTK_STATE_PRELIGHT (highlight-color)) */
}
@@ -1000,8 +878,8 @@ static void expand_button_callback(GtkWidget *w, gpointer context)
void toggle_expand_button(snd_info *sp, bool state)
{
- if (!HAS_WIDGETS(sp))
- sp->expand_control_p = state;
+ if (!has_widgets(sp))
+ sp->expand_control_on = state;
else set_toggle_button(EXPAND_RIGHT_BUTTON(sp), state, true, (void *)sp);
}
@@ -1020,7 +898,7 @@ static mus_float_t scroll_to_contrast(snd_info *sp, mus_float_t val)
{
char contrast_number_buffer[6];
sp->contrast_control = sp->contrast_control_min + val * (sp->contrast_control_max - sp->contrast_control_min) / 0.9;
- mus_snprintf(contrast_number_buffer, 6, "%.3f", sp->contrast_control);
+ snprintf(contrast_number_buffer, 6, "%.3f", sp->contrast_control);
gtk_label_set_text(GTK_LABEL(CONTRAST_LABEL(sp)), contrast_number_buffer);
return(val);
}
@@ -1028,7 +906,7 @@ static mus_float_t scroll_to_contrast(snd_info *sp, mus_float_t val)
void set_contrast(snd_info *sp, mus_float_t val)
{
- if (!HAS_WIDGETS(sp))
+ if (!has_widgets(sp))
sp->contrast_control = val;
else
{
@@ -1073,14 +951,14 @@ static gboolean contrast_release_callback(GtkWidget *w, GdkEventButton *ev, gpoi
static void contrast_button_callback(GtkWidget *w, gpointer context)
{
snd_info *sp = (snd_info *)context;
- sp->contrast_control_p = TOGGLE_BUTTON_ACTIVE(w);
+ sp->contrast_control_on = TOGGLE_BUTTON_ACTIVE(w);
}
void toggle_contrast_button(snd_info *sp, bool state)
{
- if (!HAS_WIDGETS(sp))
- sp->contrast_control_p = state;
+ if (!has_widgets(sp))
+ sp->contrast_control_on = state;
else set_toggle_button(CONTRAST_RIGHT_BUTTON(sp), state, true, (void *)sp);
}
@@ -1110,7 +988,7 @@ static mus_float_t scroll_to_revscl(snd_info *sp, mus_float_t val)
else sp->reverb_control_scale = cube((val * (pow(sp->reverb_control_scale_max, 0.333) - pow(sp->reverb_control_scale_min, 0.333)) / 0.9) +
pow(sp->reverb_control_scale_min, 0.333));
}
- mus_snprintf(revscl_number_buffer, 7, "%.4f", sp->reverb_control_scale);
+ snprintf(revscl_number_buffer, 7, "%.4f", sp->reverb_control_scale);
gtk_label_set_text(GTK_LABEL(REVSCL_LABEL(sp)), revscl_number_buffer);
return(val);
}
@@ -1118,7 +996,7 @@ static mus_float_t scroll_to_revscl(snd_info *sp, mus_float_t val)
void set_revscl(snd_info *sp, mus_float_t val)
{
- if (!HAS_WIDGETS(sp))
+ if (!has_widgets(sp))
sp->reverb_control_scale = val;
else
{
@@ -1172,7 +1050,7 @@ static mus_float_t scroll_to_revlen(snd_info *sp, mus_float_t val)
char revlen_number_buffer[5];
sp->reverb_control_length = sp->reverb_control_length_min +
(sp->reverb_control_length_max - sp->reverb_control_length_min) * (mus_float_t)val / 0.9;
- mus_snprintf(revlen_number_buffer, 5, "%.2f", sp->reverb_control_length);
+ snprintf(revlen_number_buffer, 5, "%.2f", sp->reverb_control_length);
gtk_label_set_text(GTK_LABEL(REVLEN_LABEL(sp)), revlen_number_buffer);
return(val);
}
@@ -1180,7 +1058,7 @@ static mus_float_t scroll_to_revlen(snd_info *sp, mus_float_t val)
void set_revlen(snd_info *sp, mus_float_t val)
{
- if (!HAS_WIDGETS(sp))
+ if (!has_widgets(sp))
sp->reverb_control_length = val;
else
{
@@ -1224,14 +1102,14 @@ static gboolean revlen_release_callback(GtkWidget *w, GdkEventButton *ev, gpoint
static void reverb_button_callback(GtkWidget *w, gpointer context)
{
snd_info *sp = (snd_info *)context;
- sp->reverb_control_p = TOGGLE_BUTTON_ACTIVE(w);
+ sp->reverb_control_on = TOGGLE_BUTTON_ACTIVE(w);
}
void toggle_reverb_button(snd_info *sp, bool state)
{
- if (!HAS_WIDGETS(sp))
- sp->reverb_control_p = state;
+ if (!has_widgets(sp))
+ sp->reverb_control_on = state;
else set_toggle_button(REVERB_RIGHT_BUTTON(sp), state, true, (void *)sp);
}
@@ -1247,7 +1125,7 @@ void display_filter_env(snd_info *sp)
GtkWidget *drawer;
env_editor *edp;
- if (!HAS_WIDGETS(sp)) return;
+ if (!has_widgets(sp)) return;
edp = sp->flt;
drawer = FILTER_ENV(sp);
@@ -1268,7 +1146,7 @@ void display_filter_env(snd_info *sp)
}
ax->gc = ss->fltenv_basic_gc;
- ss->cr = MAKE_CAIRO(ax->wn);
+ ss->cr = make_cairo(ax->wn);
cairo_push_group(ss->cr);
/* erase previous */
@@ -1288,14 +1166,14 @@ void display_filter_env(snd_info *sp)
{
ax->gc = ss->fltenv_data_gc;
display_frequency_response(sp->filter_control_envelope,
- (SOUND_ENV_EDITOR(sp))->axis, ax,
+ (sound_env_editor(sp))->axis, ax,
sp->filter_control_order,
sp->filter_control_in_dB);
}
cairo_pop_group_to_source(ss->cr);
cairo_paint(ss->cr);
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
}
@@ -1309,7 +1187,7 @@ static gboolean filter_drawer_button_motion(GtkWidget *w, GdkEventMotion *ev, gp
GdkModifierType state;
env_editor *edp;
if (EVENT_IS_HINT(ev))
- gdk_window_get_pointer(EVENT_WINDOW(ev), &evx, &evy, &state);
+ window_get_pointer(ev, &evx, &evy, &state);
else
{
evx = (int)(EVENT_X(ev));
@@ -1341,7 +1219,7 @@ static gboolean filter_drawer_button_release(GtkWidget *w, GdkEventButton *ev, g
{
char *tmpstr = NULL;
snd_info *sp = (snd_info *)data;
- env_editor_button_release(SOUND_ENV_EDITOR(sp), sp->filter_control_envelope);
+ env_editor_button_release(sound_env_editor(sp), sp->filter_control_envelope);
display_filter_env(sp);
set_filter_text(sp, tmpstr = env_to_string(sp->filter_control_envelope));
if (tmpstr) free(tmpstr);
@@ -1352,7 +1230,7 @@ static gboolean filter_drawer_button_release(GtkWidget *w, GdkEventButton *ev, g
void set_filter_text(snd_info *sp, const char *str)
{
- if (HAS_WIDGETS(sp))
+ if (has_widgets(sp))
{
if (str)
gtk_entry_set_text(GTK_ENTRY(FILTER_COEFFS_TEXT(sp)), str);
@@ -1380,14 +1258,14 @@ static gboolean filter_drawer_resize(GtkWidget *w, GdkEventConfigure *ev, gpoint
static void filter_button_callback(GtkWidget *w, gpointer context)
{
snd_info *sp = (snd_info *)context;
- sp->filter_control_p = TOGGLE_BUTTON_ACTIVE(w);
+ sp->filter_control_on = TOGGLE_BUTTON_ACTIVE(w);
}
void toggle_filter_button(snd_info *sp, bool state)
{
- if (!HAS_WIDGETS(sp))
- sp->filter_control_p = state;
+ if (!has_widgets(sp))
+ sp->filter_control_on = state;
else set_toggle_button(FILTER_RIGHT_BUTTON(sp), state, true, (void *)sp);
}
@@ -1403,7 +1281,7 @@ static void filter_db_callback(GtkWidget *w, gpointer context)
void set_filter_in_dB(snd_info *sp, bool val)
{
sp->filter_control_in_dB = val;
- if (HAS_WIDGETS(sp))
+ if (has_widgets(sp))
{
set_toggle_button(FILTER_DB_BUTTON(sp), val, false, (void *)sp);
display_filter_env(sp);
@@ -1415,7 +1293,7 @@ static void new_in_hz(snd_info *sp, bool val)
{
sp->filter_control_in_hz = val;
if (val)
- sp->filter_control_xmax = (mus_float_t)(SND_SRATE(sp) / 2);
+ sp->filter_control_xmax = (mus_float_t)(snd_srate(sp) / 2);
else sp->filter_control_xmax = 1.0;
if (sp->filter_control_envelope) free_env(sp->filter_control_envelope);
sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
@@ -1433,7 +1311,7 @@ static void filter_hz_callback(GtkWidget *w, gpointer context)
void set_filter_in_hz(snd_info *sp, bool val)
{
new_in_hz(sp, val);
- if (HAS_WIDGETS(sp))
+ if (has_widgets(sp))
{
set_toggle_button(FILTER_HZ_BUTTON(sp), val, false, (void *)sp);
display_filter_env(sp);
@@ -1453,7 +1331,7 @@ static void set_filter_order_1(snd_info *sp, int order, bool setadj)
void set_filter_order(snd_info *sp, int order)
{
- if (!HAS_WIDGETS(sp))
+ if (!has_widgets(sp))
sp->filter_control_order = order;
else set_filter_order_1(sp, order, true);
}
@@ -1478,12 +1356,12 @@ static void filter_activate_callback(GtkWidget *w, gpointer context)
char *str = NULL;
str = (char *)gtk_entry_get_text(GTK_ENTRY(w));
if (sp->filter_control_envelope) sp->filter_control_envelope = free_env(sp->filter_control_envelope);
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
+ redirect_errors_to(errors_to_status_area, (void *)sp);
sp->filter_control_envelope = string_to_env((const char *)str);
redirect_errors_to(NULL, NULL);
if (!(sp->filter_control_envelope)) /* maybe user cleared text field? */
sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
- (SOUND_ENV_EDITOR(sp))->edited = true;
+ (sound_env_editor(sp))->edited = true;
display_filter_env(sp);
sp->filter_control_changed = true;
}
@@ -1492,7 +1370,7 @@ static void filter_activate_callback(GtkWidget *w, gpointer context)
void filter_env_changed(snd_info *sp, env *e)
{
/* turn e back into a string for textfield widget */
- if (HAS_WIDGETS(sp))
+ if (has_widgets(sp))
{
char *tmpstr;
tmpstr = env_to_string(e);
@@ -1502,7 +1380,7 @@ void filter_env_changed(snd_info *sp, env *e)
free(tmpstr);
}
else gtk_entry_set_text(GTK_ENTRY(FILTER_COEFFS_TEXT(sp)), stupid);
- (SOUND_ENV_EDITOR(sp))->edited = true;
+ (sound_env_editor(sp))->edited = true;
display_filter_env(sp);
/* this is called also from snd-scm.c */
}
@@ -1514,7 +1392,6 @@ void color_filter_waveform(color_info *color)
{
int i;
gc_set_foreground(ss->fltenv_data_gc, color);
- ss->filter_control_waveform_color = color;
for (i = 0; i < ss->max_sounds; i++)
{
snd_info *sp;
@@ -1529,7 +1406,7 @@ void color_filter_waveform(color_info *color)
static int cant_write(char *name)
{
-#if HAVE_ACCESS
+#ifndef _MSC_VER
return((access(name, W_OK)) != 0);
#else
return(0);
@@ -1540,8 +1417,11 @@ static int cant_write(char *name)
static gint close_sound_dialog(GtkWidget *w, GdkEvent *event, gpointer context)
{
snd_info *sp = (snd_info *)context;
- if (sp) snd_close_file(sp);
- gtk_widget_hide(sp->dialog);
+ if (sp)
+ {
+ snd_close_file(sp);
+ gtk_widget_hide(sp->dialog);
+ }
return(true);
}
@@ -1563,10 +1443,14 @@ static void show_sync_button(snd_info *sp)
}
-static XEN reflect_file_close_in_sync(XEN xreason)
+static Xen reflect_file_close_in_sync(Xen hook_or_reason)
{
int reason;
- reason = XEN_TO_C_INT(xreason);
+#if HAVE_SCHEME
+ reason = Xen_integer_to_C_int(s7_let_ref(s7, hook_or_reason, s7_make_symbol(s7, "reason")));
+#else
+ reason = Xen_integer_to_C_int(hook_or_reason);
+#endif
if ((reason == FILE_CLOSED) && /* snd-file.c */
(ss->active_sounds == 1))
{
@@ -1575,15 +1459,10 @@ static XEN reflect_file_close_in_sync(XEN xreason)
if ((sp) && (sp->nchans == 1))
gtk_widget_hide(SYNC_BUTTON(sp));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(reflect_file_close_in_sync_w, reflect_file_close_in_sync)
-#else
- #define reflect_file_close_in_sync_w reflect_file_close_in_sync
-#endif
-
+Xen_wrap_1_arg(reflect_file_close_in_sync_w, reflect_file_close_in_sync)
static void close_button_callback(GtkWidget *w, gpointer context)
@@ -1592,6 +1471,19 @@ static void close_button_callback(GtkWidget *w, gpointer context)
}
+static gboolean close_button_tooltip(GtkWidget *w, gint x, gint y, gboolean keyboard_tip, GtkTooltip *tooltip, gpointer data)
+{
+ snd_info *sp = (snd_info *)data;
+ char *tip;
+ tip = mus_format("close %s", sp->short_filename);
+ gtk_tooltip_set_text(tooltip, tip);
+ free(tip);
+ return(true);
+}
+
+
+
+
/* -------- SOUND PANE -------- */
#define BUTTON_SPACE 6
@@ -1601,12 +1493,10 @@ static bool currently_showing_controls = false;
snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr)
{
snd_info *sp, *osp;
- GtkWidget **sw;
- GtkAdjustment **adjs;
- int snd_slot, nchans, i, k, old_chans;
+ int snd_slot, nchans, i, old_chans;
bool free_filename = false, make_widgets;
- char *old_name = NULL, *title;
- int app_y, app_dy, screen_y, chan_min_y;
+ char *old_name = NULL;
+ int app_y, app_dy, chan_min_y;
/* these dimensions are used to try to get a reasonable channel graph size without falling off the screen bottom */
if (ss->translated_filename)
@@ -1625,6 +1515,7 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
if (auto_resize(ss))
{
+ int screen_y;
screen_y = gdk_screen_height();
app_dy = (screen_y - app_y - app_dy - 20 * nchans);
}
@@ -1650,21 +1541,13 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
sp = ss->sounds[snd_slot];
sp->inuse = SOUND_NORMAL;
- sp->bomb_ctr = 0;
sp->write_date = file_write_date(filename); /* needed early in this process by the peak-env handlers */
make_pixmaps();
if (sp->snd_widgets == NULL)
{
- sw = (GtkWidget **)calloc(NUM_SND_WIDGETS, sizeof(GtkWidget *));
- adjs = (GtkAdjustment **)calloc(NUM_SND_ADJS, sizeof(GtkAdjustment *));
- sp->snd_widgets = sw;
- sp->snd_adjs = adjs;
- }
- else
- {
- sw = sp->snd_widgets;
- adjs = sp->snd_adjs;
+ sp->snd_widgets = (GtkWidget **)calloc(NUM_SND_WIDGETS, sizeof(GtkWidget *));
+ sp->snd_adjs = (GtkAdjustment **)calloc(NUM_SND_ADJS, sizeof(GtkAdjustment *));
}
if (!(auto_resize(ss))) gtk_window_set_resizable(GTK_WINDOW(MAIN_SHELL(ss)), false);
@@ -1677,6 +1560,7 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
if (make_widgets)
{
SND_PANE(sp) = gtk_vpaned_new();
+ add_paned_style(SND_PANE(sp));
set_user_int_data(G_OBJECT(SND_PANE(sp)), sp->index);
gtk_container_set_border_width(GTK_CONTAINER(SND_PANE(sp)), 4); /* this is the outer margin of each sound's box -- 6 seems slightly large */
/* I tried putting a frame around the entire pane, but it looked fussy, and the frame bottom cut into the filter widget! */
@@ -1706,9 +1590,6 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
gtk_paned_add1(GTK_PANED(SND_PANE(sp)), PANE_BOX(sp));
gtk_widget_show(PANE_BOX(sp));
- ERROR_INFO_FRAME(sp) = gtk_frame_new(NULL);
- gtk_box_pack_end(GTK_BOX(PANE_BOX(sp)), ERROR_INFO_FRAME(sp), false, false, 10);
-
NAME_HBOX(sp) = gtk_hbox_new(false, 0);
gtk_box_pack_end(GTK_BOX(PANE_BOX(sp)), NAME_HBOX(sp), false, false, 0);
@@ -1724,17 +1605,27 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
/* -------- NAME FIELDS -------- */
CLOSE_BUTTON(sp) = gtk_button_new();
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(CLOSE_BUTTON(sp));
+#endif
+ add_tooltip(CLOSE_BUTTON(sp), "close current sound");
gtk_button_set_relief(GTK_BUTTON(CLOSE_BUTTON(sp)), GTK_RELIEF_NONE);
- gtk_button_set_image(GTK_BUTTON(CLOSE_BUTTON(sp)), gtk_image_new_from_stock(GTK_STOCK_CLOSE, GTK_ICON_SIZE_MENU));
+ gtk_button_set_image(GTK_BUTTON(CLOSE_BUTTON(sp)), image_new_with_icon(ICON_CLOSE, GTK_ICON_SIZE_MENU));
gtk_box_pack_start(GTK_BOX(NAME_HBOX(sp)), CLOSE_BUTTON(sp), false, false, 8);
SG_SIGNAL_CONNECT(CLOSE_BUTTON(sp), "clicked", close_button_callback, sp);
+ g_signal_connect(CLOSE_BUTTON(sp), "query-tooltip", G_CALLBACK(close_button_tooltip), (gpointer)sp);
gtk_widget_show(CLOSE_BUTTON(sp));
NAME_EVENT_BOX(sp) = gtk_event_box_new();
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(NAME_EVENT_BOX(sp));
+#endif
+ add_tooltip(NAME_EVENT_BOX(sp), "name of current sound"); /* just a placeholder */
gtk_box_pack_start(GTK_BOX(NAME_HBOX(sp)), NAME_EVENT_BOX(sp), false, false, 5);
gtk_widget_show(NAME_EVENT_BOX(sp));
SG_SIGNAL_CONNECT(NAME_EVENT_BOX(sp), "button_press_event", name_click_callback, sp);
+ g_signal_connect(NAME_EVENT_BOX(sp), "query-tooltip", G_CALLBACK(name_button_tooltip), (gpointer)sp);
NAME_BUTTON(sp) = gtk_label_new(shortname_indexed(sp));
gtk_container_add(GTK_CONTAINER(NAME_EVENT_BOX(sp)), NAME_BUTTON(sp));
@@ -1780,31 +1671,33 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
}
}
- MINIBUFFER_LABEL(sp) = gtk_label_new(NULL);
- gtk_box_pack_start(GTK_BOX(NAME_HBOX(sp)), MINIBUFFER_LABEL(sp), false, false, 0);
- gtk_widget_show(MINIBUFFER_LABEL(sp));
-
- MINIBUFFER_TEXT(sp) = snd_entry_new(NAME_HBOX(sp), WITH_DEFAULT_BACKGROUND);
- SG_SIGNAL_CONNECT(MINIBUFFER_TEXT(sp), "key_press_event", minibuffer_key_callback, sp);
- SG_SIGNAL_CONNECT(MINIBUFFER_TEXT(sp), "activate", minibuffer_activate_callback, sp);
- SG_SIGNAL_CONNECT(MINIBUFFER_TEXT(sp), "enter_notify_event", minibuffer_mouse_enter, sp);
- SG_SIGNAL_CONNECT(MINIBUFFER_TEXT(sp), "leave_notify_event", minibuffer_mouse_leave, sp);
+ STATUS_AREA(sp) = gtk_label_new(NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ gtk_widget_set_halign(STATUS_AREA(sp), GTK_ALIGN_FILL);
+ gtk_widget_set_hexpand(STATUS_AREA(sp), true);
+#endif
+ gtk_box_pack_start(GTK_BOX(NAME_HBOX(sp)), STATUS_AREA(sp), true, true, 2);
+ gtk_widget_show(STATUS_AREA(sp));
/* now fill from other end */
+#if WITH_AUDIO
PLAY_BUTTON(sp) = gtk_check_button_new_with_label("play");
gtk_box_pack_end(GTK_BOX(NAME_HBOX(sp)), PLAY_BUTTON(sp), false, false, BUTTON_SPACE); /* need space here or "play" hits window edge */
SG_SIGNAL_CONNECT(PLAY_BUTTON(sp), "button_press_event", play_button_callback, sp);
SG_SIGNAL_CONNECT(PLAY_BUTTON(sp), "toggled", play_button_click_callback, sp);
gtk_widget_show(PLAY_BUTTON(sp));
+#endif
SYNC_BUTTON(sp) = gtk_check_button_new_with_label("sync");
+ add_tooltip(SYNC_BUTTON(sp), "group this sound with anything sharing its sync value");
gtk_box_pack_end(GTK_BOX(NAME_HBOX(sp)), SYNC_BUTTON(sp), false, false, BUTTON_SPACE);
SG_SIGNAL_CONNECT(SYNC_BUTTON(sp), "button_press_event", sync_button_callback, sp);
SG_SIGNAL_CONNECT(SYNC_BUTTON(sp), "toggled", sync_button_click, sp);
gtk_widget_show(SYNC_BUTTON(sp));
UNITE_BUTTON(sp) = gtk_check_button_new_with_label("unite");
+ add_tooltip(UNITE_BUTTON(sp), "combine channel graphs in one window");
gtk_box_pack_end(GTK_BOX(NAME_HBOX(sp)), UNITE_BUTTON(sp), false, false, BUTTON_SPACE);
SG_SIGNAL_CONNECT(UNITE_BUTTON(sp), "button_press_event", unite_button_callback, sp);
SG_SIGNAL_CONNECT(UNITE_BUTTON(sp), "toggled", unite_button_click, sp);
@@ -1812,11 +1705,6 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
gtk_widget_show(NAME_HBOX(sp));
- /* -------- minibuffer error display -------- */
-
- ERROR_INFO(sp) = make_info_widget();
- gtk_container_add(GTK_CONTAINER(ERROR_INFO_FRAME(sp)), ERROR_INFO(sp));
- gtk_widget_show(ERROR_INFO(sp));
/* if control-panel */
@@ -1888,7 +1776,7 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
gtk_widget_show(SPEED_SCROLLBAR(sp));
SPEED_ARROW(sp) = gtk_drawing_area_new();
- gtk_widget_set_events(SPEED_ARROW(sp), GDK_ALL_EVENTS_MASK);
+ gtk_widget_set_events(SPEED_ARROW(sp), GDK_EXPOSURE_MASK | GDK_BUTTON_PRESS_MASK);
gtk_box_pack_start(GTK_BOX(SPEED_HBOX(sp)), SPEED_ARROW(sp), false, false, 2);
gtk_widget_set_size_request(SPEED_ARROW(sp), 16, 16);
gtk_widget_show(SPEED_ARROW(sp));
@@ -2041,7 +1929,7 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
SG_SIGNAL_CONNECT(FILTER_ORDER_TEXT(sp), "leave_notify_event", spin_button_unfocus_callback, NULL);
gtk_widget_show(FILTER_ORDER_TEXT(sp));
- FILTER_COEFFS_TEXT(sp) = snd_entry_new(FILTER_HBOX(sp), WITH_DEFAULT_BACKGROUND);
+ FILTER_COEFFS_TEXT(sp) = snd_entry_new(FILTER_HBOX(sp), NULL, WITH_DEFAULT_BACKGROUND);
SG_SIGNAL_CONNECT(FILTER_COEFFS_TEXT(sp), "activate", filter_activate_callback, sp);
FILTER_HZ_BUTTON(sp) = gtk_check_button_new_with_label("hz");
@@ -2090,9 +1978,14 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
/* end if control-panel */
gtk_widget_show(CONTROL_PANEL(sp));
gtk_widget_show(SND_PANE(sp));
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ set_basic_color(ss->basic_color);
+#endif
} /* new sound ss */
else
{
+ int k;
/* re-manage currently inactive chan */
if (sound_style(ss) == SOUNDS_IN_SEPARATE_WINDOWS)
raise_dialog(sp->dialog);
@@ -2106,13 +1999,15 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
gtk_notebook_set_tab_label_text(GTK_NOTEBOOK(SOUND_PANE_BOX(ss)), SND_PANE(sp), sp->short_filename);
else reset_controls(sp); /* segfault here in notebook case! */
}
+
gtk_window_set_resizable(GTK_WINDOW(MAIN_SHELL(ss)), true);
if (currently_showing_controls) show_controls(sp); else hide_controls(sp);
if (sound_style(ss) == SOUNDS_IN_SEPARATE_WINDOWS)
{
+ char *title;
title = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(title, PRINT_BUFFER_SIZE, "%d: %s", snd_slot, sp->short_filename);
+ snprintf(title, PRINT_BUFFER_SIZE, "%d: %s", snd_slot, sp->short_filename);
gtk_window_set_title(GTK_WINDOW(sp->dialog), title);
free(title);
}
@@ -2141,7 +2036,7 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
else hide_lock(sp);
if (old_name)
- report_in_minibuffer(sp, "(translated %s)", old_name);
+ status_report(sp, "(translated %s)", old_name);
after_open(sp);
if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
{
@@ -2149,31 +2044,38 @@ snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr
reset_controls(sp);
}
if (free_filename) free(filename);
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ if (listener_exists())
+ gtk_paned_set_position(GTK_PANED(SOUND_PANE(ss)), 50);
+ /* actually we haven't reached full size here at start-up */
+#endif
return(sp);
}
void set_sound_pane_file_label(snd_info *sp, const char *str)
{
- if (MUS_TRY_LOCK(sp->starred_name_lock) != MUS_ALREADY_LOCKED)
+ if ((sp->name_string == NULL) ||
+ (strcmp(sp->name_string, str) != 0))
{
- if ((sp->name_string == NULL) ||
- (strcmp(sp->name_string, str) != 0))
- {
- if (sp->name_string) free(sp->name_string);
- sp->name_string = mus_strdup(str);
- set_label(NAME_BUTTON(sp), str);
- }
- MUS_UNLOCK(sp->starred_name_lock);
+ if (sp->name_string) free(sp->name_string);
+ sp->name_string = mus_strdup(str);
+ set_label(NAME_BUTTON(sp), str);
}
}
+void update_sound_label(snd_info *sp)
+{
+ if (has_widgets(sp))
+ gtk_label_set_text(GTK_LABEL(NAME_BUTTON(sp)), shortname_indexed(sp));
+}
void snd_info_cleanup(snd_info *sp)
{
- if (HAS_WIDGETS(sp))
+ if (has_widgets(sp))
{
- clear_minibuffer_error(sp);
+ clear_status_area(sp);
if (SYNC_BUTTON(sp))
{
set_toggle_button(SYNC_BUTTON(sp), false, false, (void *)sp);
@@ -2206,7 +2108,7 @@ void show_controls(snd_info *sp)
void hide_controls(snd_info *sp)
{
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
gtk_widget_hide(CONTROL_PANEL(sp));
#else
gtk_widget_hide_all(CONTROL_PANEL(sp));
@@ -2467,6 +2369,9 @@ void make_controls_dialog(void)
GtkWidget* mainbox, *help_button, *dismiss_button, *reset_button;
controls_dialog = snd_gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(controls_dialog), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
SG_SIGNAL_CONNECT(controls_dialog, "delete_event", delete_controls_dialog, NULL);
gtk_window_set_title(GTK_WINDOW(controls_dialog), "Controls");
sg_make_resizable(controls_dialog);
@@ -2474,19 +2379,19 @@ void make_controls_dialog(void)
gtk_widget_realize(controls_dialog);
gtk_window_resize(GTK_WINDOW(controls_dialog), 400, 500);
- help_button = gtk_button_new_from_stock(GTK_STOCK_HELP);
- gtk_widget_set_name(help_button, "dialog_button");
+ help_button = gtk_dialog_add_button(GTK_DIALOG(controls_dialog), "Help", GTK_RESPONSE_NONE);
+ reset_button = gtk_dialog_add_button(GTK_DIALOG(controls_dialog), "Revert", GTK_RESPONSE_NONE);
+ dismiss_button = gtk_dialog_add_button(GTK_DIALOG(controls_dialog), "Go away", GTK_RESPONSE_NONE);
- dismiss_button = gtk_button_new_from_stock(GTK_STOCK_QUIT);
+ gtk_widget_set_name(help_button, "dialog_button");
gtk_widget_set_name(dismiss_button, "dialog_button");
- set_stock_button_label(dismiss_button, "Go Away");
-
- reset_button = gtk_button_new_from_stock(GTK_STOCK_REVERT_TO_SAVED);
gtk_widget_set_name(reset_button, "dialog_button");
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(controls_dialog)), dismiss_button, false, true, 10);
- gtk_box_pack_start(GTK_BOX(DIALOG_ACTION_AREA(controls_dialog)), reset_button, false, true, 10);
- gtk_box_pack_end(GTK_BOX(DIALOG_ACTION_AREA(controls_dialog)), help_button, false, true, 10);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ add_highlight_button_style(dismiss_button);
+ add_highlight_button_style(reset_button);
+ add_highlight_button_style(help_button);
+#endif
SG_SIGNAL_CONNECT(dismiss_button, "clicked", controls_dismiss_callback, NULL);
SG_SIGNAL_CONNECT(help_button, "clicked", controls_help_callback, NULL);
@@ -2515,45 +2420,186 @@ void make_controls_dialog(void)
/* ---------------------------------------- */
-static XEN g_sound_widgets(XEN snd)
+static Xen g_sound_widgets(Xen snd)
{
#define H_sound_widgets "(" S_sound_widgets " :optional snd): a list of \
-widgets: ((0)pane (1)name (2)control-panel (3)minibuffer (4)play-button (5)filter-env (6)unite-button (7)name-label (8)name-icon) (9)\
+widgets: ((0)pane (1)name (2)control-panel (3)status area (4)play-button (5)filter-env (6)unite-button (7)name-label (8)name-icon) (9)\
pane-box (10)name-form"
snd_info *sp;
- ASSERT_SOUND(S_sound_widgets, snd, 1);
+ Snd_assert_sound(S_sound_widgets, snd, 1);
sp = get_sp(snd);
if (sp == NULL)
return(snd_no_such_sound_error(S_sound_widgets, snd));
- if (!HAS_WIDGETS(sp))
- return(XEN_EMPTY_LIST);
-
- return(XEN_CONS(XEN_WRAP_WIDGET(SND_PANE(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(NAME_BUTTON(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(CONTROL_PANEL(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(MINIBUFFER_TEXT(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(PLAY_BUTTON(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(FILTER_ENV(sp)), /* this is the (filter) drawingarea widget */
- XEN_CONS(XEN_WRAP_WIDGET(UNITE_BUTTON(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(MINIBUFFER_LABEL(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(NAME_PIX(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(PANE_BOX(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(NAME_HBOX(sp)),
- XEN_EMPTY_LIST))))))))))));
-}
-
-
-#ifdef XEN_ARGIFY_1
- XEN_ARGIFY_1(g_sound_widgets_w, g_sound_widgets)
+ if (!has_widgets(sp))
+ return(Xen_empty_list);
+
+ return(Xen_cons(Xen_wrap_widget(SND_PANE(sp)),
+ Xen_cons(Xen_wrap_widget(NAME_BUTTON(sp)),
+ Xen_cons(Xen_wrap_widget(CONTROL_PANEL(sp)),
+ Xen_cons(Xen_wrap_widget(STATUS_AREA(sp)),
+#if WITH_AUDIO
+ Xen_cons(Xen_wrap_widget(PLAY_BUTTON(sp)),
+#else
+ Xen_cons(Xen_false,
+#endif
+ Xen_cons(Xen_wrap_widget(FILTER_ENV(sp)), /* this is the (filter) drawingarea widget */
+ Xen_cons(Xen_wrap_widget(UNITE_BUTTON(sp)),
+ Xen_cons(Xen_false,
+ Xen_cons(Xen_wrap_widget(NAME_PIX(sp)),
+ Xen_cons(Xen_wrap_widget(PANE_BOX(sp)),
+ Xen_cons(Xen_wrap_widget(NAME_HBOX(sp)),
+ Xen_empty_list))))))))))));
+}
+
+
+Xen_wrap_1_optional_arg(g_sound_widgets_w, g_sound_widgets)
+
+
+/* -------------------------------------------------------------------------------- */
+
+
+static Xen mouse_enter_text_hook;
+static Xen mouse_leave_text_hook;
+
+static gboolean mouse_enter_text_callback(GtkWidget *w, GdkEventCrossing *ev, gpointer unknown)
+{
+ if (with_pointer_focus(ss))
+ goto_window(w);
+ widget_modify_base(w, GTK_STATE_NORMAL, ss->white);
+ if (Xen_hook_has_list(mouse_enter_text_hook))
+ run_hook(mouse_enter_text_hook,
+ Xen_list_1(Xen_wrap_widget(w)),
+ S_mouse_enter_text_hook);
+ cursor_set_blinks(w, true);
+ return(false);
+}
+
+
+static gboolean mouse_leave_text_callback(GtkWidget *w, GdkEventCrossing *ev, gpointer unknown)
+{
+ widget_modify_base(w, GTK_STATE_NORMAL, ss->basic_color);
+ if (Xen_hook_has_list(mouse_leave_text_hook))
+ run_hook(mouse_leave_text_hook,
+ Xen_list_1(Xen_wrap_widget(w)),
+ S_mouse_leave_text_hook);
+ cursor_set_blinks(w, false);
+ return(false);
+}
+
+
+void connect_mouse_to_text(GtkWidget *text)
+{
+ SG_SIGNAL_CONNECT(text, "enter_notify_event", mouse_enter_text_callback, NULL);
+ SG_SIGNAL_CONNECT(text, "leave_notify_event", mouse_leave_text_callback, NULL);
+}
+
+
+static bool bindings_ok = false;
+
+GtkWidget *snd_entry_new(GtkWidget *container, GtkWidget *prev, snd_entry_bg_t with_white_background)
+{
+ GtkWidget *text;
+ GtkSettings *settings;
+
+ text = gtk_entry_new();
+ gtk_editable_set_editable(GTK_EDITABLE(text), true);
+ add_entry_style(text);
+
+ settings = gtk_widget_get_settings(text);
+ g_object_set(settings, "gtk-entry-select-on-focus", false, NULL);
+
+#if HAVE_GTK_GRID_NEW
+ if (prev)
+ {
+ g_object_set(text, "margin", 2, NULL);
+ gtk_widget_set_halign(text, GTK_ALIGN_FILL);
+ gtk_widget_set_hexpand(text, true);
+ gtk_grid_attach_next_to(GTK_GRID(container), text, prev, GTK_POS_RIGHT, 1, 1);
+ }
+ else gtk_box_pack_start(GTK_BOX(container), text, true, true, 2);
#else
- #define g_sound_widgets_w g_sound_widgets
+ gtk_box_pack_start(GTK_BOX(container), text, true, true, 2);
+#endif
+
+ if (!bindings_ok)
+ {
+ bindings_ok = true;
+ glistener_key_bindings(ss->listener, GTK_ENTRY_GET_CLASS(GTK_ENTRY(text)));
+ }
+ gtk_widget_show(text);
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ if (with_white_background == WITH_WHITE_BACKGROUND)
+ {
+ widget_modify_bg(text, GTK_STATE_NORMAL, ss->white);
+ widget_modify_base(text, GTK_STATE_SELECTED, ss->white);
+ }
+#endif
+ connect_mouse_to_text(text);
+ return(text);
+}
+
+
+GtkWidget *snd_entry_new_with_size(GtkWidget *container, int size)
+{
+ GtkWidget *text;
+ GtkSettings *settings;
+
+ text = gtk_entry_new();
+ gtk_editable_set_editable(GTK_EDITABLE(text), true);
+ gtk_entry_set_width_chars(GTK_ENTRY(text), size);
+ add_entry_style(text);
+
+ settings = gtk_widget_get_settings(text);
+ g_object_set(settings, "gtk-entry-select-on-focus", false, NULL);
+
+ gtk_box_pack_start(GTK_BOX(container), text, false, false, 4);
+
+ if (!bindings_ok)
+ {
+ bindings_ok = true;
+ glistener_key_bindings(ss->listener, GTK_ENTRY_GET_CLASS(GTK_ENTRY(text)));
+ }
+ gtk_widget_show(text);
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ widget_modify_bg(text, GTK_STATE_NORMAL, ss->white);
+ widget_modify_base(text, GTK_STATE_SELECTED, ss->white);
#endif
+ connect_mouse_to_text(text);
+ return(text);
+}
+
+
+
void g_init_gxsnd(void)
{
- XEN_ADD_HOOK(ss->snd_open_file_hook, reflect_file_close_in_sync_w, "sync-open-file-watcher", "sound sync open-file-hook handler");
+ Xen_add_to_hook_list(ss->snd_open_file_hook, reflect_file_close_in_sync_w, "sync-open-file-watcher", "sound sync open-file-hook handler");
+
+ Xen_define_procedure(S_sound_widgets, g_sound_widgets_w, 0, 1, 0, H_sound_widgets);
+
+#if HAVE_SCHEME
+ #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
+(hook-push " S_mouse_enter_text_hook "\n\
+ (lambda (w)\n\
+ (" S_focus_widget " w)))"
+#endif
+#if HAVE_RUBY
+ #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
+$mouse_enter_text_hook.add_hook!(\"enter\") do |w|\n\
+ focus_widget(w)\n\
+ end"
+#endif
+#if HAVE_FORTH
+ #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
+" S_mouse_enter_text_hook " lambda: <{ wid }> wid " S_focus_widget " ; add-hook!"
+#endif
+
+ #define H_mouse_leave_text_hook S_mouse_leave_text_hook " (widget): called when the mouse leaves a text widget"
- XEN_DEFINE_PROCEDURE(S_sound_widgets, g_sound_widgets_w, 0, 1, 0, H_sound_widgets);
+ mouse_enter_text_hook = Xen_define_hook(S_mouse_enter_text_hook, "(make-hook 'widget)", 1, H_mouse_enter_text_hook);
+ mouse_leave_text_hook = Xen_define_hook(S_mouse_leave_text_hook, "(make-hook 'widget)", 1, H_mouse_leave_text_hook);
}
diff --git a/snd-gtk.scm b/snd-gtk.scm
index 30398a3..7067cff 100644
--- a/snd-gtk.scm
+++ b/snd-gtk.scm
@@ -9,69 +9,46 @@
;;; snd-clock-icon
;;; bring possibly-obscured dialog to top
;;; select-file
-;;; with-level-meters
;;; add delete and rename options to the file menu
;;; notebook-with-top-tabs
;;; make-font-selector-dialog
;;; add-main-menu-mnemonics
-(if (not (provided? 'snd-gtk)) (snd-error "snd-gtk.scm is Gtk-specific"))
-
-
-(if (not (provided? 'xg))
- (let ((hxm (dlopen "xg.so")))
- (if (string? hxm)
- (snd-error (format #f "snd-gtk.scm needs the xg module (either 'make xg' or build Snd with --with-static-xg): ~A" hxm))
- (dlinit hxm "Init_libxg"))))
-
(provide 'snd-snd-gtk.scm)
+(require snd-gtk snd-extensions.scm snd-play.scm)
-(if (not (provided? 'snd-extensions.scm)) (load "extensions.scm"))
-(if (not (provided? 'snd-play.scm)) (load "play.scm"))
-
-(define (load-font name)
- (pango_font_description_from_string name))
-
-(define (g-list-foreach glist func)
- (let ((len (g_list_length glist)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (func (g_list_nth_data glist i)))))
-
-(define (for-each-child w func)
- "(for-each-child w func) applies func to w and each of its children"
- (func w)
- (g-list-foreach (gtk_container_get_children (GTK_CONTAINER w))
- (lambda (w)
- (func (GTK_WIDGET w)))))
-
-
-(define (host-name)
- "(host-name) -> name of current machine"
- (let ((val (gdk_property_get (car (main-widgets))
- (gdk_atom_intern "WM_CLIENT_MACHINE" #f)
- GDK_TARGET_STRING 0 1024 0)))
- ;; val is list: (success atom element-size length unterminated-string)
- (and (car val)
- (substring (list-ref val 4) 0 (list-ref val 3)))))
-
-
-(define red-pixel
- (let ((tmp (GdkColor)))
- (gdk_color_parse "red" tmp)
- (gdk_color_copy tmp)))
-
-(define white-pixel
- (let ((tmp (GdkColor)))
- (gdk_color_parse "white" tmp)
- (gdk_color_copy tmp)))
-
-(define black-pixel
- (let ((tmp (GdkColor)))
- (gdk_color_parse "black" tmp)
- (gdk_color_copy tmp)))
-
-
+(with-let *gtk*
+
+ (define load-font pango_font_description_from_string)
+
+ (define (g-list-foreach glist func)
+ (let ((len (g_list_length glist)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (func (g_list_nth_data glist i)))))
+
+ (define for-each-child
+ (let ((documentation "(for-each-child w func) applies func to w and each of its children"))
+ (lambda (w func)
+ (func w)
+ (g-list-foreach (gtk_container_get_children (GTK_CONTAINER w))
+ (lambda (w)
+ (func (GTK_WIDGET w)))))))
+
+
+ (define host-name ; this is the same as (define (machine-name) (caddr ((*libc* 'uname))))
+ (let ((documentation "(host-name) -> name of current machine"))
+ (lambda ()
+ (let ((val (gdk_property_get (car (main-widgets))
+ (gdk_atom_intern "WM_CLIENT_MACHINE" #f)
+ GDK_TARGET_STRING 0 1024 0)))
+ ;; val is list: (success atom element-size length unterminated-string)
+ (and (car val)
+ (substring (val 4) 0 (val 3)))))))
+
+
+
+#|
;;; -------- display-scanned-synthesis --------
;;;
;;; open a new main pane below the listener, with two sections
@@ -79,502 +56,496 @@
;;; push 'start' to start the scanned synthesis display
;;; if spring > mass, you'll get overflows
;;;
-
-(define scanned-synthesis-pane #f)
-
-(define (display-scanned-synthesis)
- (define compute-uniform-circular-string
- ;; copied from dsp.scm to simplify life
- (lambda (size x0 x1 x2 mass xspring damp)
- (define circle-vct-ref
- (lambda (v i)
- (if (< i 0)
- (v (+ size i))
- (if (>= i size)
- (v (- i size))
- (v i)))))
- (let* ((dm (/ damp mass))
- (km (/ xspring mass))
- (denom (+ 1.0 dm))
- (p1 (/ (+ 2.0 (- dm (* 2.0 km))) denom))
- (p2 (/ km denom))
- (p3 (/ -1.0 denom)))
- (do ((i 0 (+ 1 i)))
- ((= i size))
- (set! (x0 i) (min (+ (* p1 (x1 i))
- (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
- (* p3 (x2 i)))
- 1000.0)))
- (vct-fill! x2 0.0)
- (vct-add! x2 x1)
- (vct-fill! x1 0.0)
- (vct-add! x1 x0))))
-
- (set! (mus-srate) 22050.0)
+ (define scanned-synthesis-pane #f)
- (let* ((mass 1.0)
- (xspring 0.1)
- (damp 0.0)
- (bounds '())
- (pts0 #f)
- (pts1 #f)
- (ax0 0) (ax1 0) (ay0 0) (ay1 0)
- (gc (car (snd-gcs)))
- (egc (list-ref (snd-gcs) 7))
-
- ;; now set up a paned window in the main Snd window with controllers on the left and the graph on the right
- (scan-outer (let ((pane (gtk_hbox_new #f 0)))
- (gtk_box_pack_start (GTK_BOX (list-ref (main-widgets) 5)) pane #f #f 4)
- (gtk_widget_show pane)
- pane))
- (scan-row (let ((box (gtk_vbox_new #f 0)))
- (gtk_box_pack_start (GTK_BOX scan-outer) box #f #f 0)
- (gtk_widget_show box)
- box))
- ;; the graph
- (scan-pane (let ((grf (gtk_drawing_area_new)))
- (gtk_widget_set_events grf GDK_ALL_EVENTS_MASK)
- (gtk_box_pack_start (GTK_BOX scan-outer) grf #t #t 0)
- (gtk_widget_show grf)
- grf))
- ;; the controllers
- (scan-start (let ((label (gtk_button_new_with_label "Start")))
- (gtk_box_pack_start (GTK_BOX scan-row) label #t #t 0)
- (gtk_widget_show label)
- label))
- (scan-continue (let ((label (gtk_button_new_with_label "Continue")))
- (gtk_box_pack_start (GTK_BOX scan-row) label #t #t 0)
- (gtk_widget_show label)
- label))
- (scan-stop (let ((label (gtk_button_new_with_label "Stop")))
- (gtk_box_pack_start (GTK_BOX scan-row) label #t #t 0)
- (gtk_widget_show label)
- label))
- (size 128)
- (tbl (make-table-lookup :size size))
- (frequency 440.0)
- (amplitude 0.02)
- (gx0 (mus-data tbl))
- (gx1 (make-vct size))
- (gx2 (make-vct size))
- (vect (make-vector (* 2 size)))
- (work-proc #f)
- (play-button #f)) ; fixed up later -- needed in stop-synthesis
-
- (define (y->grfy y range)
- (min ay1
- (max ay0
- (round (+ ay0
- (* range (- 10.0 y)))))))
-
- (define (cairo-draw-lines cr data size)
- (cairo_set_line_width cr 4.0)
- (cairo_move_to cr (data 0) (data 1))
- (do ((i 1 (+ 1 i))
- (j 2 (+ j 2)))
- ((= i size))
- (cairo_line_to cr (data j) (data (+ j 1))))
- (cairo_stroke cr))
-
- (define (draw-graph cr)
- (if (and (> ax1 ax0)
- (> ay1 ay0))
- (let* ((diff (* 0.05 (- ay1 ay0))) ; assuming -10 to 10
- (xincr (/ (- ax1 ax0) size))
- (bg-color (color->list (basic-color))))
- (cairo_set_source_rgb cr (car bg-color) (cadr bg-color) (caddr bg-color))
- (if pts1
- (cairo-draw-lines cr pts1 size)
- (begin
- (cairo_rectangle cr (+ ax0 2) ay0 (- ax1 ax0 2) (- ay1 ay0))
- (cairo_fill cr)))
- (cairo_set_source_rgb cr 0.0 0.0 0.0)
- (cairo_set_line_width cr 1.0)
- (let ((x (floor ax0))
- (y (y->grfy (gx0 0) diff)))
- (cairo_move_to cr x y)
- (set! (vect 0) x)
- (set! (vect 1) y))
- (do ((i 1 (+ 1 i))
- (j 2 (+ j 2))
- (xi (+ ax0 xincr) (+ xi xincr)))
- ((= i size))
- (let ((x (floor xi))
- (y (y->grfy (gx0 i) diff)))
- (set! (vect j) x)
- (set! (vect (+ j 1)) y)
- (cairo_line_to cr x y)))
- (cairo_stroke cr)
- (set! pts1 vect))))
-
- (define (redraw-graph)
- (let* ((wn ((if (provided? 'gtk3) GDK_WINDOW GDK_DRAWABLE) (gtk_widget_get_window scan-pane)))
- (cr (gdk_cairo_create wn)))
- (set! bounds (draw-axes scan-pane gc "scanned synthesis" 0.0 1.0 -10.0 10.0 x-axis-in-seconds show-all-axes cr))
- (set! ax0 (+ (car bounds) 4))
- (set! ax1 (caddr bounds))
- (set! ay1 (cadr bounds))
- (set! ay0 (cadddr bounds))
- (draw-graph cr)
- (cairo_destroy cr)))
-
- (define (tick-synthesis n)
- ;; background process
- (compute-uniform-circular-string size gx0 gx1 gx2 mass xspring damp)
- (let* ((wn ((if (provided? 'gtk3) GDK_WINDOW GDK_DRAWABLE) (gtk_widget_get_window scan-pane)))
- (cr (gdk_cairo_create wn)))
- (draw-graph cr)
- (cairo_destroy cr))
- #t)
-
- (define (stop-synthesis)
- (if work-proc
- (g_source_remove work-proc))
- (set! work-proc #f)
- (gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON play-button) #f))
+ (define (display-scanned-synthesis)
- (define (start-synthesis)
- (stop-synthesis)
- (vct-fill! gx0 0.0)
- (vct-fill! gx1 0.0)
- (vct-fill! gx2 0.0)
- (do ((i 0 (+ 1 i)))
- ((= i 12))
- (let ((val (sin (/ (* 2 pi i) 12.0))))
- (set! (gx1 (+ i (- (/ size 4) 6))) val)))
- (set! work-proc (g_idle_add tick-synthesis #f)))
+ (define compute-uniform-circular-string
+ ;; copied from dsp.scm to simplify life
+ (lambda (size x0 x1 x2 mass xspring damp)
+ (define circle-float-vector-ref
+ (lambda (v i)
+ (if (< i 0)
+ (v (+ size i))
+ (if (>= i size)
+ (v (- i size))
+ (v i)))))
+ (let* ((dm (/ damp mass))
+ (km (/ xspring mass))
+ (denom (+ 1.0 dm))
+ (p1 (/ (+ 2.0 (- dm (* 2.0 km))) denom))
+ (p2 (/ km denom))
+ (p3 (/ -1.0 denom)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (x0 i) (min (+ (* p1 (x1 i))
+ (* p2 (+ (circle-float-vector-ref x1 (- i 1)) (circle-float-vector-ref x1 (+ i 1))))
+ (* p3 (x2 i)))
+ 1000.0)))
+ (copy x1 x2)
+ (copy x0 x1))))
- (define (continue-synthesis)
- (stop-synthesis)
- (set! work-proc (g_idle_add tick-synthesis #f)))
+ (set! *clm-srate* 22050.0)
- ;; controller callbacks
- (for-each
- (lambda (data)
- (let* ((title (list-ref data 0))
- (minval (list-ref data 1))
- (maxval (list-ref data 2))
- (curval (list-ref data 3))
- (decimals (list-ref data 4))
- (func (list-ref data 5))
- (adj (gtk_adjustment_new curval minval maxval 1.0 10.0 1.0))
- (scale (gtk_hscale_new (GTK_ADJUSTMENT adj)))
- (label (gtk_label_new title)))
- (if (not (provided? 'gtk3)) (gtk_range_set_update_policy (GTK_RANGE (GTK_SCALE scale)) GTK_UPDATE_CONTINUOUS))
- (gtk_scale_set_digits (GTK_SCALE scale) decimals)
- (gtk_scale_set_value_pos (GTK_SCALE scale) GTK_POS_TOP)
- (gtk_scale_set_draw_value (GTK_SCALE scale) #t)
- (gtk_box_pack_start (GTK_BOX scan-row) scale #t #t 0)
- (gtk_widget_show scale)
- (gtk_box_pack_start (GTK_BOX scan-row) label #t #t 0)
- (gtk_widget_show label)
- (g_signal_connect adj "value_changed" (lambda (w d) (func (gtk_adjustment_get_value (GTK_ADJUSTMENT adj)))) #f)))
- (list (list "mass" 1 200 100 2 (lambda (val) (set! mass (/ val 100.0))))
- (list "spring" 1 100 10 2 (lambda (val) (set! xspring (/ val 100.0))))
- (list "damping" 0 100 0 4 (lambda (val) (set! damp (/ val 10000.0))))))
-
- (let* ((scan-size (gtk_hbox_new #f 4)))
- (gtk_box_pack_start (GTK_BOX scan-row) scan-size #t #t 6)
- (gtk_widget_show scan-size)
- (let ((scan-label (gtk_label_new "Size:")))
- (gtk_box_pack_start (GTK_BOX scan-size) scan-label #f #f 10)
- (gtk_widget_show scan-label)
- (let ((scan-text (gtk_entry_new)))
- (gtk_box_pack_start (GTK_BOX scan-size) scan-text #t #t 0)
- (gtk_widget_show scan-text)
- (gtk_entry_set_text (GTK_ENTRY scan-text) (number->string size))
- (g_signal_connect scan-text "activate"
- (lambda (w d)
- (stop-synthesis)
- (set! size (string->number (gtk_entry_get_text (GTK_ENTRY scan-text))))
- (set! tbl (make-table-lookup :size size))
- (set! gx0 (mus-data tbl))
- (set! gx1 (make-vct size))
- (set! gx2 (make-vct size))
- (set! vect (make-vector (* size 2))))
- #f))))
- (set! play-button (gtk_check_button_new_with_label "play"))
- (gtk_box_pack_start (GTK_BOX scan-row) play-button #f #f 4)
- (gtk_widget_show play-button)
- (g_signal_connect play-button "toggled"
- (lambda (w d)
- (if (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON play-button))
- (let* ((audio-info (open-play-output 1 22050 #f 128))
- (audio-fd (car audio-info))
- (outchans (cadr audio-info))
- (frames (caddr audio-info))
- (data (make-sound-data outchans frames)))
- (if (not (= audio-fd -1))
- (do ()
- ((not (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON play-button)))
- (mus-audio-close audio-fd))
- (tick-synthesis work-proc)
- (do ((k 0 (+ 1 k)))
- ((= k frames))
- (sound-data-set! data 0 k (* amplitude (table-lookup tbl))))
- (mus-audio-write audio-fd data frames))))))
- #f)
- (let* ((freq-adj (gtk_adjustment_new 440.0 20.0 1000.0 1.0 10.0 1.0)) ; step incr, page incr page size
- (amp-adj (gtk_adjustment_new 0.02 0.0 0.1 .001 .01 .001))
- (freq-scale (gtk_hscale_new (GTK_ADJUSTMENT freq-adj)))
- (amp-scale (gtk_hscale_new (GTK_ADJUSTMENT amp-adj)))
- (freq-label (gtk_label_new "frequency"))
- (amp-label (gtk_label_new "amplitude")))
- (if (not (provided? 'gtk3)) (gtk_range_set_update_policy (GTK_RANGE (GTK_SCALE freq-scale)) GTK_UPDATE_CONTINUOUS))
- (if (not (provided? 'gtk3)) (gtk_range_set_update_policy (GTK_RANGE (GTK_SCALE amp-scale)) GTK_UPDATE_CONTINUOUS))
- (gtk_scale_set_digits (GTK_SCALE freq-scale) 1)
- (gtk_scale_set_digits (GTK_SCALE amp-scale) 3)
- (gtk_scale_set_value_pos (GTK_SCALE freq-scale) GTK_POS_TOP)
- (gtk_scale_set_value_pos (GTK_SCALE amp-scale) GTK_POS_TOP)
- (gtk_scale_set_draw_value (GTK_SCALE freq-scale) #t)
- (gtk_scale_set_draw_value (GTK_SCALE amp-scale) #t)
- (gtk_box_pack_start (GTK_BOX scan-row) freq-scale #t #t 0)
- (gtk_box_pack_start (GTK_BOX scan-row) freq-label #t #t 0)
- (gtk_box_pack_start (GTK_BOX scan-row) amp-scale #t #t 0)
- (gtk_box_pack_start (GTK_BOX scan-row) amp-label #t #t 0)
- (gtk_widget_show freq-scale)
- (gtk_widget_show amp-scale)
- (gtk_widget_show freq-label)
- (gtk_widget_show amp-label)
- (g_signal_connect freq-adj "value_changed" (lambda (w d) (set! (mus-frequency tbl) (gtk_adjustment_get_value (GTK_ADJUSTMENT freq-adj)))) #f)
- (g_signal_connect amp-adj "value_changed" (lambda (w d) (set! amplitude (gtk_adjustment_get_value (GTK_ADJUSTMENT amp-adj)))) #f)
- )
-
- (g_signal_connect scan-pane
- (if (provided? 'gtk3) "draw" "expose_event")
- (lambda (w e d)
- (redraw-graph))
- #f)
- (g_signal_connect scan-pane "configure_event" (lambda (w e d) (redraw-graph)) #f)
- (g_signal_connect scan-pane "button_press_event"
- (lambda (w e d)
- (let ((button (.button (GDK_EVENT_BUTTON e))))
- (if (not work-proc)
- (if (= button 2)
- (continue-synthesis)
- (start-synthesis))
- (stop-synthesis))))
- #f)
- (g_signal_connect scan-start "clicked" (lambda (w d) (start-synthesis)) #f)
- (g_signal_connect scan-continue "clicked" (lambda (w d) (continue-synthesis)) #f)
- (g_signal_connect scan-stop "clicked" (lambda (w d) (stop-synthesis)) #f)
- #t))
-
-
-(define (close-scanned-synthesis-pane)
- (gtk_widget_hide scanned-synthesis-pane))
-
+ (let* ((mass 1.0)
+ (xspring 0.1)
+ (damp 0.0)
+ (bounds ())
+ (pts1 #f)
+ (ax0 0) (ax1 0) (ay0 0) (ay1 0)
+ (gc (car (snd-gcs)))
+
+ ;; now set up a paned window in the main Snd window with controllers on the left and the graph on the right
+ (scan-outer (let ((pane (gtk_box_new GTK_ORIENTATION_HORIZONTAL 0)))
+ (gtk_box_pack_start (GTK_BOX ((main-widgets) 5)) pane #f #f 4)
+ (gtk_widget_show pane)
+ pane))
+ (scan-row (let ((box (gtk_box_new GTK_ORIENTATION_VERTICAL 0)))
+ (gtk_box_pack_start (GTK_BOX scan-outer) box #f #f 0)
+ (gtk_widget_show box)
+ box))
+ ;; the graph
+ (scan-pane (let ((grf (gtk_drawing_area_new)))
+ (gtk_widget_set_events grf GDK_ALL_EVENTS_MASK)
+ (gtk_box_pack_start (GTK_BOX scan-outer) grf #t #t 0)
+ (gtk_widget_show grf)
+ grf))
+ ;; the controllers
+ (scan-start (let ((label (gtk_button_new_with_label "Start")))
+ (gtk_box_pack_start (GTK_BOX scan-row) label #t #t 0)
+ (gtk_widget_show label)
+ label))
+ (scan-continue (let ((label (gtk_button_new_with_label "Continue")))
+ (gtk_box_pack_start (GTK_BOX scan-row) label #t #t 0)
+ (gtk_widget_show label)
+ label))
+ (scan-stop (let ((label (gtk_button_new_with_label "Stop")))
+ (gtk_box_pack_start (GTK_BOX scan-row) label #t #t 0)
+ (gtk_widget_show label)
+ label))
+ (size 128)
+ (tbl (make-table-lookup :size size))
+ (amplitude 0.02)
+ (gx0 (mus-data tbl))
+ (gx1 (make-float-vector size))
+ (gx2 (make-float-vector size))
+ (vect (make-vector (* 2 size)))
+ (work-proc #f)
+ (play-button #f)) ; fixed up later -- needed in stop-synthesis
+
+ (define (y->grfy y range)
+ (min ay1
+ (max ay0
+ (round (+ ay0
+ (* range (- 10.0 y)))))))
+
+ (define (cairo-draw-lines cr data size)
+ (cairo_set_line_width cr 4.0)
+ (cairo_move_to cr (data 0) (data 1))
+ (do ((i 1 (+ i 1))
+ (j 2 (+ j 2)))
+ ((= i size))
+ (cairo_line_to cr (data j) (data (+ j 1))))
+ (cairo_stroke cr))
+
+ (define (draw-graph cr)
+ (if (and (> ax1 ax0)
+ (> ay1 ay0))
+ (let ((diff (* 0.05 (- ay1 ay0))) ; assuming -10 to 10
+ (xincr (/ (- ax1 ax0) size))
+ (bg-color (color->list *basic-color*)))
+ (cairo_set_source_rgb cr (car bg-color) (cadr bg-color) (caddr bg-color))
+ (if pts1
+ (cairo-draw-lines cr pts1 size)
+ (begin
+ (cairo_rectangle cr (+ ax0 2) ay0 (- ax1 ax0 2) (- ay1 ay0))
+ (cairo_fill cr)))
+ (cairo_set_source_rgb cr 0.0 0.0 0.0)
+ (cairo_set_line_width cr 1.0)
+ (let ((x (floor ax0))
+ (y (y->grfy (gx0 0) diff)))
+ (cairo_move_to cr x y)
+ (set! (vect 0) x)
+ (set! (vect 1) y))
+ (do ((i 1 (+ i 1))
+ (j 2 (+ j 2))
+ (xi (+ ax0 xincr) (+ xi xincr)))
+ ((= i size))
+ (let ((x (floor xi))
+ (y (y->grfy (gx0 i) diff)))
+ (set! (vect j) x)
+ (set! (vect (+ j 1)) y)
+ (cairo_line_to cr x y)))
+ (cairo_stroke cr)
+ (set! pts1 vect))))
+
+ (define (redraw-graph)
+ (let* ((wn (GDK_WINDOW (gtk_widget_get_window scan-pane)))
+ (cr (gdk_cairo_create wn)))
+ (set! bounds (draw-axes scan-pane gc "scanned synthesis" 0.0 1.0 -10.0 10.0 x-axis-in-seconds show-all-axes cr))
+ (set! ax0 (+ (car bounds) 4))
+ (set! ax1 (caddr bounds))
+ (set! ay1 (cadr bounds))
+ (set! ay0 (cadddr bounds))
+ (draw-graph cr)
+ (cairo_destroy cr)))
+
+ (define (tick-synthesis n)
+ ;; background process
+ (compute-uniform-circular-string size gx0 gx1 gx2 mass xspring damp)
+ (let* ((wn (GDK_WINDOW (gtk_widget_get_window scan-pane)))
+ (cr (gdk_cairo_create wn)))
+ (draw-graph cr)
+ (cairo_destroy cr))
+ #t)
+
+ (define (stop-synthesis)
+ (if work-proc
+ (g_source_remove work-proc))
+ (set! work-proc #f)
+ (gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON play-button) #f))
+
+ (define (start-synthesis)
+ (stop-synthesis)
+ (fill! gx0 0.0)
+ (fill! gx1 0.0)
+ (fill! gx2 0.0)
+ (do ((i 0 (+ i 1)))
+ ((= i 12))
+ (let ((val (sin (/ (* 2 pi i) 12.0))))
+ (set! (gx1 (+ i (- (/ size 4) 6))) val)))
+ (set! work-proc (g_idle_add tick-synthesis #f)))
+
+ (define (continue-synthesis)
+ (stop-synthesis)
+ (set! work-proc (g_idle_add tick-synthesis #f)))
+
+ ;; controller callbacks
+ (for-each
+ (lambda (data)
+ (let* ((title (data 0))
+ (minval (data 1))
+ (maxval (data 2))
+ (curval (data 3))
+ (decimals (data 4))
+ (func (data 5))
+ (adj (gtk_adjustment_new curval minval maxval 1.0 10.0 1.0))
+ (scale (gtk_scale_new GTK_ORIENTATION_HORIZONTAL (GTK_ADJUSTMENT adj)))
+ (label (gtk_label_new title)))
+ (gtk_scale_set_digits (GTK_SCALE scale) decimals)
+ (gtk_scale_set_value_pos (GTK_SCALE scale) GTK_POS_TOP)
+ (gtk_scale_set_draw_value (GTK_SCALE scale) #t)
+ (gtk_box_pack_start (GTK_BOX scan-row) scale #t #t 0)
+ (gtk_widget_show scale)
+ (gtk_box_pack_start (GTK_BOX scan-row) label #t #t 0)
+ (gtk_widget_show label)
+ (g_signal_connect adj "value_changed" (lambda (w d) (func (gtk_adjustment_get_value (GTK_ADJUSTMENT adj)))) #f)))
+ (list (list "mass" 1 200 100 2 (lambda (val) (set! mass (/ val 100.0))))
+ (list "spring" 1 100 10 2 (lambda (val) (set! xspring (/ val 100.0))))
+ (list "damping" 0 100 0 4 (lambda (val) (set! damp (/ val 10000.0))))))
+
+ (let ((scan-size (gtk_box_new GTK_ORIENTATION_HORIZONTAL 4)))
+ (gtk_box_pack_start (GTK_BOX scan-row) scan-size #t #t 6)
+ (gtk_widget_show scan-size)
+ (let ((scan-label (gtk_label_new "Size:")))
+ (gtk_box_pack_start (GTK_BOX scan-size) scan-label #f #f 10)
+ (gtk_widget_show scan-label)
+ (let ((scan-text (gtk_entry_new)))
+ (gtk_box_pack_start (GTK_BOX scan-size) scan-text #t #t 0)
+ (gtk_widget_show scan-text)
+ (gtk_entry_set_text (GTK_ENTRY scan-text) (number->string size))
+ (g_signal_connect scan-text "activate"
+ (lambda (w d)
+ (stop-synthesis)
+ (set! size (string->number (gtk_entry_get_text (GTK_ENTRY scan-text))))
+ (set! tbl (make-table-lookup :size size))
+ (set! gx0 (mus-data tbl))
+ (set! gx1 (make-float-vector size))
+ (set! gx2 (make-float-vector size))
+ (set! vect (make-vector (* size 2))))
+ #f))))
+ (set! play-button (gtk_check_button_new_with_label "play"))
+ (gtk_box_pack_start (GTK_BOX scan-row) play-button #f #f 4)
+ (gtk_widget_show play-button)
+ (g_signal_connect play-button "toggled"
+ (lambda (w d)
+ (if (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON play-button))
+ (let* ((audio-info (open-play-output 1 22050 #f 128))
+ (audio-fd (car audio-info))
+ ;; (outchans (cadr audio-info))
+ (len (caddr audio-info))
+ (data (make-float-vector len))
+ (sdata (make-shared-vector data (list 1 len))))
+ (if (not (= audio-fd -1))
+ (do ()
+ ((not (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON play-button)))
+ (mus-audio-close audio-fd))
+ (tick-synthesis work-proc)
+ (do ((k 0 (+ 1 k)))
+ ((= k len))
+ (float-vector-set! data k (* amplitude (table-lookup tbl))))
+ (mus-audio-write audio-fd sdata len))))))
+ #f)
+ (let* ((freq-adj (gtk_adjustment_new 440.0 20.0 1000.0 1.0 10.0 1.0)) ; step incr, page incr page size
+ (amp-adj (gtk_adjustment_new 0.02 0.0 0.1 .001 .01 .001))
+ (freq-scale (gtk_scale_new GTK_ORIENTATION_HORIZONTAL (GTK_ADJUSTMENT freq-adj)))
+ (amp-scale (gtk_scale_new GTK_ORIENTATION_HORIZONTAL (GTK_ADJUSTMENT amp-adj)))
+ (freq-label (gtk_label_new "frequency"))
+ (amp-label (gtk_label_new "amplitude")))
+ (gtk_scale_set_digits (GTK_SCALE freq-scale) 1)
+ (gtk_scale_set_digits (GTK_SCALE amp-scale) 3)
+ (gtk_scale_set_value_pos (GTK_SCALE freq-scale) GTK_POS_TOP)
+ (gtk_scale_set_value_pos (GTK_SCALE amp-scale) GTK_POS_TOP)
+ (gtk_scale_set_draw_value (GTK_SCALE freq-scale) #t)
+ (gtk_scale_set_draw_value (GTK_SCALE amp-scale) #t)
+ (gtk_box_pack_start (GTK_BOX scan-row) freq-scale #t #t 0)
+ (gtk_box_pack_start (GTK_BOX scan-row) freq-label #t #t 0)
+ (gtk_box_pack_start (GTK_BOX scan-row) amp-scale #t #t 0)
+ (gtk_box_pack_start (GTK_BOX scan-row) amp-label #t #t 0)
+ (gtk_widget_show freq-scale)
+ (gtk_widget_show amp-scale)
+ (gtk_widget_show freq-label)
+ (gtk_widget_show amp-label)
+ (g_signal_connect freq-adj "value_changed" (lambda (w d) (set! (mus-frequency tbl) (gtk_adjustment_get_value (GTK_ADJUSTMENT freq-adj)))) #f)
+ (g_signal_connect amp-adj "value_changed" (lambda (w d) (set! amplitude (gtk_adjustment_get_value (GTK_ADJUSTMENT amp-adj)))) #f)
+ )
+
+ (g_signal_connect scan-pane "draw" (lambda (w e d) (redraw-graph)) #f)
+ (g_signal_connect scan-pane "configure_event" (lambda (w e d) (redraw-graph)) #f)
+ (g_signal_connect scan-pane "button_press_event"
+ (lambda (w e d)
+ (let ((button (.button (GDK_EVENT_BUTTON e))))
+ (if (not work-proc)
+ (if (= button 2)
+ (continue-synthesis)
+ (start-synthesis))
+ (stop-synthesis))))
+ #f)
+ (g_signal_connect scan-start "clicked" (lambda (w d) (start-synthesis)) #f)
+ (g_signal_connect scan-continue "clicked" (lambda (w d) (continue-synthesis)) #f)
+ (g_signal_connect scan-stop "clicked" (lambda (w d) (stop-synthesis)) #f)
+ #t))
+ (define (close-scanned-synthesis-pane)
+ (gtk_widget_hide scanned-synthesis-pane))
+
+|#
+
+
+
;;; -------- zync and unzync: start or stop y-zoom slider sync --------
;;;
;;; (i.e. when one y-zoom-slider changes position, all other channels in the sound change in parallel)
;;; (zync) to start and (unzync) to stop
-
-
-(define (add-dragger snd)
-
- (define (dragger-callback adj context)
- (let ((val (- 1.0 (gtk_adjustment_get_value (GTK_ADJUSTMENT adj))))
- (snd (car context))
- (chn (cadr context)))
- (if (sound-property 'dragger snd)
- (begin
- (do ((i 0 (+ 1 i)))
- ((= i (channels snd)))
- (if (not (= i chn))
- (begin
- (set! (y-zoom-slider snd i) (* val val))
- (set! (y-position-slider snd i) (y-position-slider snd chn)))))
- (g_signal_stop_emission (GPOINTER adj)
- (g_signal_lookup "value_changed" (G_OBJECT_TYPE (G_OBJECT adj)))
- 0)))))
+
+
+ (define (add-dragger hook)
+ (let ((snd (hook 'snd)))
- (set! (sound-property 'dragger snd) #t)
- (set! (sound-property 'save-state-ignore snd)
- (cons 'dragger
- (or (sound-property 'save-state-ignore snd)
- (list 'save-state-ignore))))
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (let* ((zy (list-ref (channel-widgets snd chn) 14)))
- (g_signal_connect_closure_by_id (GPOINTER zy)
- (g_signal_lookup "value_changed" (G_OBJECT_TYPE (G_OBJECT zy)))
- 0
- (g_cclosure_new dragger-callback (list snd chn) (list 'GClosureNotify 0))
- #f))))
-
-(define (zync)
- "(zync) ties each sound's y-zoom sliders together so that all change in paralle if one changes"
- (hook-push after-open-hook add-dragger)
- (for-each
- (lambda (n)
- (if (not (sound-property 'dragger n))
- (add-dragger n)))
- (sounds)))
-
-(define (unzync)
- "(unzync) undoes a previous (zync) -- subsequently each sound's y-zoom sliders are independent"
- (hook-remove after-open-hook add-dragger)
- (for-each
- (lambda (n)
- (if (sound-property 'dragger n)
- (set! (sound-property 'dragger n) #f)))
- (sounds)))
-
-
-
+ (define (dragger-callback adj context)
+ (let ((val (- 1.0 (gtk_adjustment_get_value (GTK_ADJUSTMENT adj))))
+ (snd (car context))
+ (chn (cadr context)))
+ (if (sound-property 'dragger snd)
+ (begin
+ (do ((i 0 (+ i 1)))
+ ((= i (channels snd)))
+ (if (not (= i chn))
+ (begin
+ (set! (y-zoom-slider snd i) (* val val))
+ (set! (y-position-slider snd i) (y-position-slider snd chn)))))
+ (g_signal_stop_emission (GPOINTER adj)
+ (g_signal_lookup "value_changed" (G_OBJECT_TYPE (G_OBJECT adj)))
+ 0)))))
+
+ (set! (sound-property 'dragger snd) #t)
+ (set! (sound-property 'save-state-ignore snd)
+ (cons 'dragger
+ (or (sound-property 'save-state-ignore snd)
+ (list 'save-state-ignore))))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels snd)))
+ (let ((zy ((channel-widgets snd chn) 14)))
+ (g_signal_connect_closure_by_id (GPOINTER zy)
+ (g_signal_lookup "value_changed" (G_OBJECT_TYPE (G_OBJECT zy)))
+ 0
+ (g_cclosure_new dragger-callback (list snd chn) (list 'GClosureNotify 0))
+ #f)))))
+
+ (define zync
+ (let ((documentation "(zync) ties each sound's y-zoom sliders together so that all change in paralle if one changes"))
+ (lambda ()
+ (hook-push after-open-hook add-dragger)
+ (for-each
+ (lambda (n)
+ (if (not (sound-property 'dragger n))
+ (add-dragger n)))
+ (sounds)))))
+
+ (define unzync
+ (let ((documentation "(unzync) undoes a previous (zync) -- subsequently each sound's y-zoom sliders are independent"))
+ (lambda ()
+ (hook-remove after-open-hook add-dragger)
+ (for-each
+ (lambda (n)
+ (if (sound-property 'dragger n)
+ (set! (sound-property 'dragger n) #f)))
+ (sounds)))))
+
+
+
;;; -------- disable control panel --------
-
-(define (disable-control-panel snd)
- (gtk_widget_hide (caddr (sound-widgets snd)))
- (remove-from-menu 2 "Show controls"))
-
-
-
+
+ (define (disable-control-panel snd)
+ (gtk_widget_hide (caddr (sound-widgets snd)))
+ (remove-from-menu 2 "Show controls"))
+
+
+
;;; -------- show-disk-space
;;;
-;;; adds a label to the minibuffer area showing the current free space
-
-(define show-disk-space
- (let ((labelled-snds '()))
-
- (define (kmg num)
- (if (<= num 0)
- "disk full!"
- (if (> num 1024)
- (if (> num (* 1024 1024))
- (format #f "space: ~6,3FG" (/ num (* 1024.0 1024.0)))
- (format #f "space: ~6,3FM" (/ num 1024.0)))
- (format #f "space: ~10DK" num))))
-
- (define (show-label data)
- (if (sound? (car data))
- (let ((space (kmg (disk-kspace (file-name (car data))))))
- (gtk_label_set_text (GTK_LABEL (cadr data)) space)
- (g_timeout_add 10000 show-label data) ; every 10 seconds recheck space
- 0)))
-
- (define (find-if pred l)
- (cond ((null? l) #f)
- ((pred (car l)) (car l))
- (else (find-if pred (cdr l)))))
-
- (lambda* (snd-arg)
- "(show-disk-space) adds a label to the minibuffer area showing the current free space (for use with after-open-hook)"
-
- (let* ((snd (or snd-arg (selected-sound)))
- (previous-label (find-if (lambda (n) (equal? (car n) snd)) labelled-snds)))
- (if (not previous-label)
- (if (not snd)
- (snd-error "no sound found for disk space label")
- (let* ((name-form (list-ref (sound-widgets) 10))
- (space (kmg (disk-kspace (file-name snd))))
- (new-label (gtk_label_new space)))
- (gtk_box_pack_start (GTK_BOX name-form) new-label #f #f 6)
- (gtk_widget_show new-label)
- (set! previous-label (list snd new-label))
- (set! labelled-snds (cons previous-label labelled-snds))
- (g_timeout_add 10000 show-label previous-label))))))))
-
-
-
+;;; adds a label to the status-area area showing the current free space
+
+ (define show-disk-space
+ (let ((labelled-snds ()))
+
+ (define (kmg num)
+ (if (<= num 0)
+ "disk full!"
+ (if (> num 1024)
+ (if (> num (* 1024 1024))
+ (format #f "space: ~6,3FG" (/ num (* 1024.0 1024.0)))
+ (format #f "space: ~6,3FM" (/ num 1024.0)))
+ (format #f "space: ~10DK" num))))
+
+ (define (show-label data)
+ (if (sound? (car data))
+ (let ((space (kmg (disk-kspace (file-name (car data))))))
+ (gtk_label_set_text (GTK_LABEL (cadr data)) space)
+ (g_timeout_add 10000 show-label data) ; every 10 seconds recheck space
+ 0)))
+
+ (define (find-if pred l)
+ (cond ((null? l) #f)
+ ((pred (car l)) (car l))
+ (else (find-if pred (cdr l)))))
+
+ (lambda (hook)
+ ;; (show-disk-space snd) adds a label to snd's status-area area showing the current free space (for use with after-open-hook)
+
+ (let* ((snd (hook 'snd))
+ (previous-label (find-if (lambda (n) (equal? (car n) snd)) labelled-snds)))
+ (if (not previous-label)
+ (if (not snd)
+ (snd-error "no sound found for disk space label")
+ (let* ((name-form ((sound-widgets) 10))
+ (space (kmg (disk-kspace (file-name snd))))
+ (new-label (gtk_label_new space)))
+ (gtk_box_pack_start (GTK_BOX name-form) new-label #f #f 6)
+ (gtk_widget_show new-label)
+ (set! previous-label (list snd new-label))
+ (set! labelled-snds (cons previous-label labelled-snds))
+ (g_timeout_add 10000 show-label previous-label))))))))
+
+
+
;;; -------- remove top level menu
;;;
;;; (remove-main-menu 5) removes the Help menu
-
-(define (remove-main-menu menu)
- "(remove-main-menu menu) removes the specified top-level menu: (remove-main-menu 5) removes the Help menu"
- (gtk_widget_hide (list-ref (menu-widgets) menu)))
-
-
+
+ (define remove-main-menu
+ (let ((documentation "(remove-main-menu menu) removes the specified top-level menu: (remove-main-menu 5) removes the Help menu"))
+ (lambda (menu)
+ (gtk_widget_hide ((menu-widgets) menu)))))
+
+
;;; -------- keep-file-dialog-open-upon-ok
;;;
;;; this seems to work, but it's a kludge
-
-(define (keep-file-dialog-open-upon-ok)
- (let ((dialog (open-file-dialog #f)))
- (g_object_set_data (G_OBJECT dialog) "hide-me" (GPOINTER 1)))) ; anything not 0 means don't hide (this is a stupid kludge forced on me by goddamn gtk)
-
-
-
+
+ (define (keep-file-dialog-open-upon-ok)
+ (let ((dialog (open-file-dialog #f)))
+ (g_object_set_data (G_OBJECT dialog) "hide-me" (GPOINTER 1)))) ; anything not 0 means don't hide (this is a stupid kludge forced on me by goddamn gtk)
+
+
+
;;; -------- snd-clock-icon --------
;;;
;;; a clock icon to replace Snd's hourglass
;;; call from a work proc or whatever with hour going from 0 to 12 then #f
-
-(define snd-clock-icon
- (lambda (snd hour)
- (let* ((window ((if (provided? 'gtk3) GDK_WINDOW GDK_DRAWABLE) (gtk_widget_get_window (list-ref (sound-widgets snd) 8))))
+
+ (define snd-clock-icon
+ (lambda (snd hour)
+ (let* ((window (GDK_WINDOW (gtk_widget_get_window ((sound-widgets snd) 8))))
+ (cr (gdk_cairo_create window))
+ (bg (color->list *basic-color*)))
+ (cairo_set_source_rgb cr (car bg) (cadr bg) (caddr bg))
+ (cairo_rectangle cr 0 0 16 16) ; icon bg
+ (cairo_fill cr)
+ (cairo_set_source_rgb cr 1.0 1.0 1.0)
+ (cairo_arc cr 8 8 7 0 (* 2 pi)) ; clock face
+ (cairo_fill cr)
+ (cairo_set_line_width cr 2.0)
+ (cairo_set_source_rgb cr 0.0 0.0 0.0)
+ (cairo_move_to cr 8 8) ; clock hour hand
+ (cairo_line_to cr (+ 8 (* 7 (sin (* hour (/ 3.1416 6.0)))))
+ (- 8 (* 7 (cos (* hour (/ 3.1416 6.0))))))
+ (cairo_stroke cr)
+ (cairo_destroy cr))))
+
+
+#|
+;;; this is the happy face progress bar
+
+ (define (snd-happy-face snd progress)
+ (let* ((window (GDK_WINDOW (gtk_widget_get_window ((sound-widgets snd) 8))))
(cr (gdk_cairo_create window))
- (bg (color->list (basic-color))))
+ (bg (color->list *basic-color*))
+ (fc (list 1.0 progress 0.0)))
+
+ ;; overall background
(cairo_set_source_rgb cr (car bg) (cadr bg) (caddr bg))
- (cairo_rectangle cr 0 0 16 16) ; icon bg
+ (cairo_rectangle cr 0 0 16 16)
(cairo_fill cr)
- (cairo_set_source_rgb cr 1.0 1.0 1.0)
- (cairo_arc cr 8 8 7 0 (* 2 pi)) ; clock face
+
+ ;; round face
+ (cairo_set_source_rgb cr (car fc) (cadr fc) (caddr fc))
+ (cairo_arc cr 8 8 8 0.0 (* 2 pi))
(cairo_fill cr)
- (cairo_set_line_width cr 2.0)
+
+ ;; eyes
(cairo_set_source_rgb cr 0.0 0.0 0.0)
- (cairo_move_to cr 8 8) ; clock hour hand
- (cairo_line_to cr (+ 8 (* 7 (sin (* hour (/ 3.1416 6.0)))))
- (- 8 (* 7 (cos (* hour (/ 3.1416 6.0))))))
+ (cairo_arc cr 5 6 1.5 0 (* 2 pi))
+ (cairo_fill cr)
+
+ (cairo_arc cr 11 6 1.5 0 (* 2 pi))
+ (cairo_fill cr)
+
+ ;; mouth
+ (cairo_set_line_width cr 1.0)
+ (if (< progress 0.4)
+ (cairo_arc cr 8 14 4 (* 17/16 pi) (* -1/16 pi))
+ (if (< progress 0.7)
+ (begin
+ (cairo_move_to cr 4 12)
+ (cairo_rel_line_to cr 8 0))
+ (cairo_arc cr 8 8 5 (* 1/16 pi) (* 15/16 pi))))
(cairo_stroke cr)
- (cairo_destroy cr))))
-
-
-#|
-;;; this is the happy face progress bar
-
-(define (snd-happy-face snd progress)
- (let* ((window ((if (provided? 'gtk3) GDK_WINDOW GDK_DRAWABLE) (gtk_widget_get_window (list-ref (sound-widgets snd) 8))))
- (cr (gdk_cairo_create window))
- (bg (color->list (basic-color)))
- (fc (list 1.0 progress 0.0)))
-
- ;; overall background
- (cairo_set_source_rgb cr (car bg) (cadr bg) (caddr bg))
- (cairo_rectangle cr 0 0 16 16)
- (cairo_fill cr)
-
- ;; round face
- (cairo_set_source_rgb cr (car fc) (cadr fc) (caddr fc))
- (cairo_arc cr 8 8 8 0.0 (* 2 pi))
- (cairo_fill cr)
-
- ;; eyes
- (cairo_set_source_rgb cr 0.0 0.0 0.0)
- (cairo_arc cr 5 6 1.5 0 (* 2 pi))
- (cairo_fill cr)
-
- (cairo_arc cr 11 6 1.5 0 (* 2 pi))
- (cairo_fill cr)
-
- ;; mouth
- (cairo_set_line_width cr 1.0)
- (if (< progress 0.4)
- (cairo_arc cr 8 14 4 (* 17/16 pi) (* -1/16 pi))
- (if (< progress 0.7)
- (begin
- (cairo_move_to cr 4 12)
- (cairo_rel_line_to cr 8 0))
- (cairo_arc cr 8 8 5 (* 1/16 pi) (* 15/16 pi))))
- (cairo_stroke cr)
-
- (cairo_destroy cr)))
-
+
+ (cairo_destroy cr)))
|#
-
-
+
+
;;; -------- bring possibly-obscured dialog to top
-
-(define (raise-dialog w)
- (gtk_widget_show w)
- (gtk_window_present (GTK_WINDOW w)))
-
-
+
+ (define (raise-dialog w)
+ (gtk_widget_show w)
+ (gtk_window_present (GTK_WINDOW w)))
+
+
;;; -------- select-file --------
;;;
;;; (select-file func title dir filter help)
@@ -586,472 +557,330 @@
;;; (lambda (filename)
;;; (insert-sound filename))
;;; "Insert File" "." "*" "file will be inserted at cursor")))
-
-(define select-file
-
- (let ((file-selector-dialogs '()))
- ;; (list (list widget inuse func title help) ...)
-
- (define (find-free-dialog ds)
- (if (null? ds)
- #f
- (if (not (cadr (car ds)))
- (begin
- (list-set! (car ds) 1 #t)
- (caar ds))
- (find-free-dialog (cdr ds)))))
-
- (define (find-dialog-widget wid ds)
- (if (null? ds)
- #f
- (if (equal? wid (caar ds))
- (car ds)
- (find-dialog-widget wid (cdr ds)))))
-
- (lambda args
- ;; (file-select func title dir filter help)
- (let* ((func (if (> (length args) 0) (list-ref args 0) #f))
- (title (if (> (length args) 1) (list-ref args 1) "select file"))
- (dir (if (> (length args) 2) (list-ref args 2) "."))
- ;; (filter (if (> (length args) 3) (list-ref args 3) "*"))
- (dialog (or (find-free-dialog file-selector-dialogs)
- (GTK_FILE_CHOOSER_DIALOG (gtk_file_chooser_dialog_new
- title
- #f
- ;(GTK_WINDOW (cadr (main-widgets)))
- GTK_FILE_CHOOSER_ACTION_OPEN
- (list GTK_STOCK_CANCEL GTK_RESPONSE_REJECT
- GTK_STOCK_OK GTK_RESPONSE_ACCEPT))))))
- (gtk_file_chooser_set_current_folder (GTK_FILE_CHOOSER dialog) dir)
- (if (and (= GTK_RESPONSE_ACCEPT (gtk_dialog_run (GTK_DIALOG dialog)))
- func)
- (func (gtk_file_chooser_get_filename (GTK_FILE_CHOOSER dialog))))
- (gtk_widget_hide (GTK_WIDGET dialog))))))
-
-;;(select-file (lambda (n) (snd-print n)))
-
-
-;;; -------- with-level-meters, make-level-meter, display-level
-
-(define (make-level-meter parent width height)
- (let ((frame (gtk_frame_new #f)))
- (gtk_widget_set_size_request frame width height)
- (gtk_box_pack_start (GTK_BOX parent) frame #t #t 4)
- (gtk_widget_show frame)
- (let ((meter (gtk_drawing_area_new)))
- (gtk_widget_set_events meter (logior GDK_EXPOSURE_MASK GDK_STRUCTURE_MASK))
- (gtk_container_add (GTK_CONTAINER frame) meter)
- (gtk_widget_show meter)
- (let ((context (list meter 0.0 1.0 0.0 0.0 width height)))
- (g_signal_connect meter
- (if (provided? 'gtk3) "draw" "expose_event")
- (lambda (w e d)
- (display-level d))
- context)
- (g_signal_connect meter "configure_event"
- (lambda (w e d)
- (let ((xy (if (provided? 'gtk2)
- (gdk_drawable_get_size ((if (provided? 'gtk3) GDK_WINDOW GDK_DRAWABLE) (gtk_widget_get_window w)))
- (list (gtk_widget_get_allocated_width w)
- (gtk_widget_get_allocated_height w)))))
- (list-set! d 5 (car xy))
- (list-set! d 6 (cadr xy))
- (display-level d)))
- context)
- context))))
-
-(define (display-level meter-data)
- (let* ((meter (car meter-data))
- (level (list-ref meter-data 1))
- (last-level (list-ref meter-data 3))
- (red-deg (list-ref meter-data 4))
- (width (list-ref meter-data 5))
- (height (list-ref meter-data 6))
- ;; (size (list-ref meter-data 2))
- (win ((if (provided? 'gtk3) GDK_WINDOW GDK_DRAWABLE) (gtk_widget_get_window meter)))
- (major-tick (round (/ width 24)))
- (minor-tick (round (* major-tick .6)))
- (wid2 (floor (/ width 2)))
- (gc (car (snd-gcs)))
- (top (round (/ height 3.2)))) ; distance of label from top of meter
-
- ;; this is too slow -- can we save the plate? (also if just 1 meter, put pivot higher?)
- (let ((cr (gdk_cairo_create win)))
-
- ;; put our origin at the meter pivot point scaled (as a square so the dial remains circular) to 0..1
- (cairo_translate cr (* 0.5 width) (+ (* 0.5 width) (* 0.2 height)))
- (cairo_scale cr width width)
-
- ;; background
- (let ((pat (cairo_pattern_create_radial 0 0 .1 0 0 0.75)))
- (cairo_pattern_add_color_stop_rgb pat 0.0 1.0 0.9 0.0)
- (cairo_pattern_add_color_stop_rgb pat 1.0 1.0 1.0 1.0)
- (cairo_rectangle cr -1 -1 2 2)
- (cairo_set_source cr pat)
- (cairo_fill cr)
- (cairo_pattern_destroy pat))
-
- ;; dial markings
- (cairo_set_source_rgb cr 0.0 0.0 0.0)
-
- ;; outer arc
- (cairo_set_line_width cr (/ 2.0 width))
- (cairo_arc cr 0 0 0.5 (* -0.75 pi) (* -0.25 pi))
- (cairo_stroke cr)
-
- ;; inner arc
- (cairo_set_line_width cr (/ 0.5 width))
- (cairo_arc cr 0 0 (- 0.5 (/ 6.0 width)) (* -0.75 pi) (* -0.25 pi))
- (cairo_stroke cr)
-
- ;; save unrotated coords
- (cairo_save cr)
+
+ (define select-file
+
+ (let ((file-selector-dialogs ()))
+ ;; (list (list widget inuse func title help) ...)
- ;; ticks
- (cairo_rotate cr (* 5 (/ pi 4)))
- (do ((i 0 (+ 1 i)))
- ((= i 5))
- (cairo_set_line_width cr (/ 1.5 width))
- (if (or (= i 0) (= i 4))
- (begin
- (cairo_move_to cr (- 0.5 (/ 6.0 width)) 0.0)
- (cairo_rel_line_to cr (/ 15.0 width) 0))
- (begin
- (cairo_move_to cr 0.5 0.0)
- (cairo_rel_line_to cr (/ 9.0 width) 0)))
- (cairo_stroke cr)
- (if (< i 4)
- (begin
- (cairo_set_line_width cr (/ 0.5 width))
- (do ((j 0 (+ 1 j)))
- ((= j 5))
- (cairo_move_to cr 0.5 0.0)
- (cairo_rel_line_to cr (/ 6.0 width) 0)
- (cairo_rotate cr (/ pi (* 8 5)))
- (cairo_stroke cr)))))
- (cairo_restore cr)
+ (define (find-free-dialog ds)
+ (and (pair? ds)
+ (if (not (cadr (car ds)))
+ (begin
+ (set! ((car ds) 1) #t)
+ (caar ds))
+ (find-free-dialog (cdr ds)))))
+ (lambda args
+ ;; (file-select func title dir filter help)
+ (let* ((func (and (> (length args) 0) (args 0)))
+ (title (if (> (length args) 1) (args 1) "select file"))
+ (dir (if (> (length args) 2) (args 2) "."))
+ (dialog (or (find-free-dialog file-selector-dialogs)
+ (GTK_FILE_CHOOSER_DIALOG (gtk_file_chooser_dialog_new
+ title
+ #f
+ GTK_FILE_CHOOSER_ACTION_OPEN
+ (list "process-stop" GTK_RESPONSE_REJECT
+ "Ok" GTK_RESPONSE_ACCEPT))))))
+ (gtk_file_chooser_set_current_folder (GTK_FILE_CHOOSER dialog) dir)
+ (if (and (= GTK_RESPONSE_ACCEPT (gtk_dialog_run (GTK_DIALOG dialog)))
+ func)
+ (func (gtk_file_chooser_get_filename (GTK_FILE_CHOOSER dialog))))
+ (gtk_widget_hide (GTK_WIDGET dialog))))))
+
+ ;;(select-file (lambda (n) (snd-print n)))
+
+
+
+#|
+;;; -------- with-level-meters, make-level-meter, display-level
+
+ (define (make-level-meter parent width height)
+ (let ((frame (gtk_frame_new #f)))
+ (gtk_widget_set_size_request frame width height)
+ (gtk_box_pack_start (GTK_BOX parent) frame #t #t 4)
+ (gtk_widget_show frame)
+ (let ((meter (gtk_drawing_area_new)))
+ (gtk_widget_set_events meter (logior GDK_EXPOSURE_MASK GDK_STRUCTURE_MASK))
+ (gtk_container_add (GTK_CONTAINER frame) meter)
+ (gtk_widget_show meter)
+ (let ((context (list meter 0.0 1.0 0.0 0.0 width height)))
+ (g_signal_connect meter "draw" (lambda (w e d) (display-level d)) context)
+ (g_signal_connect meter "configure_event"
+ (lambda (w e d)
+ (let ((xy (list (gtk_widget_get_allocated_width w)
+ (gtk_widget_get_allocated_height w))))
+ (set! (d 5) (car xy))
+ (set! (d 6) (cadr xy))
+ (display-level d)))
+ context)
+ context))))
+
+ (define (display-level meter-data)
+ (let* ((meter (car meter-data))
+ (level (meter-data 1))
+ (last-level (meter-data 3))
+ (red-deg (meter-data 4))
+ (width (meter-data 5))
+ (height (meter-data 6))
+ ;; (size (meter-data 2))
+ (win (GDK_WINDOW (gtk_widget_get_window meter))))
- ;; needle and bubble
- (let* ((needle-speed 0.25)
- (bubble-speed 0.025)
- (bubble-size (/ pi 12))
- (val (+ (* level needle-speed) (* last-level (- 1.0 needle-speed)))))
- (cairo_save cr)
+ ;; this is too slow -- can we save the plate? (also if just 1 meter, put pivot higher?)
+ (let ((cr (gdk_cairo_create win)))
+
+ ;; put our origin at the meter pivot point scaled (as a square so the dial remains circular) to 0..1
+ (cairo_translate cr (* 0.5 width) (+ (* 0.5 width) (* 0.2 height)))
+ (cairo_scale cr width width)
+
+ ;; background
+ (let ((pat (cairo_pattern_create_radial 0 0 .1 0 0 0.75)))
+ (cairo_pattern_add_color_stop_rgb pat 0.0 1.0 0.9 0.0)
+ (cairo_pattern_add_color_stop_rgb pat 1.0 1.0 1.0 1.0)
+ (cairo_rectangle cr -1 -1 2 2)
+ (cairo_set_source cr pat)
+ (cairo_fill cr)
+ (cairo_pattern_destroy pat))
+
+ ;; dial markings
+ (cairo_set_source_rgb cr 0.0 0.0 0.0)
+
+ ;; outer arc
(cairo_set_line_width cr (/ 2.0 width))
- (cairo_rotate cr (+ (* 5 (/ pi 4)) (* val pi 0.5)))
- (cairo_move_to cr 0 0)
- (cairo_rel_line_to cr 0.55 0.0)
+ (cairo_arc cr 0 0 0.5 (* -0.75 pi) (* -0.25 pi))
+ (cairo_stroke cr)
+
+ ;; inner arc
+ (cairo_set_line_width cr (/ 0.5 width))
+ (cairo_arc cr 0 0 (- 0.5 (/ 6.0 width)) (* -0.75 pi) (* -0.25 pi))
(cairo_stroke cr)
+
+ ;; save unrotated coords
+ (cairo_save cr)
+
+ ;; ticks
+ (cairo_rotate cr (* 5 (/ pi 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 5))
+ (cairo_set_line_width cr (/ 1.5 width))
+ (if (or (= i 0) (= i 4))
+ (begin
+ (cairo_move_to cr (- 0.5 (/ 6.0 width)) 0.0)
+ (cairo_rel_line_to cr (/ 15.0 width) 0))
+ (begin
+ (cairo_move_to cr 0.5 0.0)
+ (cairo_rel_line_to cr (/ 9.0 width) 0)))
+ (cairo_stroke cr)
+ (if (< i 4)
+ (begin
+ (cairo_set_line_width cr (/ 0.5 width))
+ (do ((j 0 (+ 1 j)))
+ ((= j 5))
+ (cairo_move_to cr 0.5 0.0)
+ (cairo_rel_line_to cr (/ 6.0 width) 0)
+ (cairo_rotate cr (/ pi (* 8 5)))
+ (cairo_stroke cr)))))
(cairo_restore cr)
- (list-set! meter-data 3 val)
- (if (<= val red-deg)
- (set! val (+ (* val bubble-speed) (* red-deg (- 1.0 bubble-speed)))))
- (list-set! meter-data 4 val)
+ ;; needle and bubble
+ (let* ((needle-speed 0.25)
+ (bubble-speed 0.025)
+ (bubble-size (/ pi 12))
+ (val (+ (* level needle-speed) (* last-level (- 1.0 needle-speed)))))
+ (cairo_save cr)
+ (cairo_set_line_width cr (/ 2.0 width))
+ (cairo_rotate cr (+ (* 5 (/ pi 4)) (* val pi 0.5)))
+ (cairo_move_to cr 0 0)
+ (cairo_rel_line_to cr 0.55 0.0)
+ (cairo_stroke cr)
+ (cairo_restore cr)
+
+ (set! (meter-data 3) val)
+ (if (<= val red-deg)
+ (set! val (+ (* val bubble-speed) (* red-deg (- 1.0 bubble-speed)))))
+ (set! (meter-data 4) val)
+
+ ;; now the red bubble...
+ (if (> val .01)
+ (begin
+ (cairo_set_source_rgb cr 1.0 0.0 0.0)
+ (cairo_set_line_width cr (/ 5.0 width))
+ (let ((redx (* val 0.5 pi)))
+ (cairo_arc cr 0 0 (- 0.5 (/ 3.0 width)) (+ (* 5 (/ pi 4)) (max 0.0 (- redx bubble-size))) (+ (* 5 (/ pi 4)) redx))
+ (cairo_stroke cr)))))
- ;; now the red bubble...
- (if (> val .01)
- (begin
- (cairo_set_source_rgb cr 1.0 0.0 0.0)
- (cairo_set_line_width cr (/ 5.0 width))
- (let* ((redx (* val 0.5 pi))
- (redy (min redx bubble-size)))
- (cairo_arc cr 0 0 (- 0.5 (/ 3.0 width)) (+ (* 5 (/ pi 4)) (max 0.0 (- redx bubble-size))) (+ (* 5 (/ pi 4)) redx))
- (cairo_stroke cr)))))
-
- (cairo_destroy cr))))
-
-
-(define (with-level-meters n)
- ;; add n level meters to a pane at the top of the Snd window
- (let* ((parent (list-ref (main-widgets) 5))
- (height (if (> n 2) 70 85))
- (parent-width (cadr (gdk_drawable_get_size ((if (provided? 'gtk3) GDK_WINDOW GDK_DRAWABLE) (gtk_widget_get_window parent)))))
- (width (floor (/ parent-width n)))
- (meters (gtk_hbox_new #t 4))
- (meter-list '()))
- (gtk_box_pack_start (GTK_BOX parent) meters #f #f 4)
- (gtk_widget_set_size_request meters width height)
- (gtk_widget_show meters)
- (do ((i 0 (+ 1 i)))
- ((= i n))
- (set! meter-list (cons (make-level-meter meters width height) meter-list)))
- (hook-push dac-hook
- (lambda (sdobj)
- (let* ((maxes (sound-data-maxamp sdobj)))
- (for-each
- (lambda (meter)
- (if (null? maxes)
- (list-set! meter 1 0.0)
- (begin
- (list-set! meter 1 (car maxes))
- (display-level meter)
- (set! maxes (cdr maxes)))))
- (reverse meter-list)))))
- (hook-push stop-dac-hook
- (lambda () ; drain away the bubble
- (g_idle_add
- (let ((ctr 0))
- (lambda (ignored)
- (for-each
- (lambda (meter)
- (list-set! meter 1 0.0)
- (display-level meter))
- meter-list)
- (set! ctr (+ ctr 1))
- (< ctr 200)))
- #f)))
- meter-list))
-
-
-
-
-;;; -------- state display panel --------
-
-(define variables-dialog #f)
-(define variables-notebook #f)
-(define variables-pages '())
-
-(define (make-variables-dialog)
- (let ((dismiss-button (gtk_button_new_with_label "Go Away")))
- (gtk_widget_set_name dismiss-button "quit_button")
- (set! variables-dialog (gtk_dialog_new))
- (gtk_window_set_title (GTK_WINDOW variables-dialog) "Variables")
- (gtk_container_set_border_width (GTK_CONTAINER variables-dialog) 10)
- (gtk_window_set_default_size (GTK_WINDOW variables-dialog) -1 -1)
- (gtk_window_set_resizable (GTK_WINDOW variables-dialog) #t)
- (gtk_widget_realize variables-dialog)
- (g_signal_connect variables-dialog "delete_event" (lambda (w ev data) (gtk_widget_hide variables-dialog) #t) #f)
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG variables-dialog))) dismiss-button #t #t 20)
- (g_signal_connect dismiss-button "clicked" (lambda (w data) (gtk_widget_hide variables-dialog)) #f)
- (gtk_widget_show dismiss-button)
- (set! variables-notebook (gtk_notebook_new))
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG variables-dialog))) variables-notebook #t #t 4)
- (gtk_notebook_set_tab_pos (GTK_NOTEBOOK variables-notebook) GTK_POS_RIGHT)
- (gtk_widget_show variables-notebook)
- (gtk_widget_show variables-dialog)
- variables-dialog))
-
-(define* (make-variable-display page-name variable-name (type 'text) (range (list 0.0 1.0)))
- ;; type = 'text, 'meter, 'graph, 'spectrum, 'scale
- (if (not variables-dialog) (make-variables-dialog))
- (let ((page-info (assoc page-name variables-pages)))
- (if (not page-info)
- (let* ((vbox (gtk_vbox_new #f 0))
- (tab (gtk_label_new page-name)))
- (gtk_widget_show tab)
- (gtk_widget_show vbox)
- (gtk_notebook_append_page (GTK_NOTEBOOK variables-notebook) vbox tab)
- (set! page-info (cons page-name vbox))
- (set! variables-pages (cons page-info variables-pages))))
- (let* ((pane (cdr page-info))
- (var-label (string-append variable-name ":")))
- (case type
- ((text)
- ;; add a horizontal pair: label text
- (let* ((label (gtk_label_new var-label))
- (hbox (gtk_hbox_new #f 0))
- (text (gtk_label_new "")))
- (gtk_box_pack_start (GTK_BOX pane) hbox #f #f 2)
- (gtk_widget_show hbox)
- (gtk_box_pack_start (GTK_BOX hbox) label #f #f 6)
- (gtk_misc_set_alignment (GTK_MISC (GTK_LABEL label)) 0.05 0.0)
- (gtk_widget_show label)
- (gtk_box_pack_start (GTK_BOX hbox) text #t #t 6)
- (gtk_misc_set_alignment (GTK_MISC (GTK_LABEL text)) 0.05 0.0)
- (gtk_widget_show text)
- text))
- ((scale)
- (let* ((label (gtk_label_new var-label))
- (hbox (gtk_hbox_new #f 0))
- (scale (gtk_progress_bar_new)))
- (gtk_box_pack_start (GTK_BOX pane) hbox #f #f 2)
- (gtk_widget_show hbox)
- (gtk_box_pack_start (GTK_BOX hbox) label #f #f 6)
- (gtk_misc_set_alignment (GTK_MISC (GTK_LABEL label)) 0.05 0.0)
- (gtk_widget_show label)
- (gtk_box_pack_start (GTK_BOX hbox) scale #f #f 6)
- (gtk_widget_show scale)
- (list scale (car range) (cadr range))))
- ((meter)
- ;; using the level meters in snd-gtk.scm
- (let* ((height 70)
- (width 210)
- (label (gtk_label_new var-label)))
- (gtk_box_pack_start (GTK_BOX pane) label #f #f 2)
- (make-level-meter pane width height)))
- ((graph)
- (let* ((snd (make-variable-graph pane (string-append variable-name ": time") 2048 (mus-srate))))
- (list (sound->integer snd) (channel-data snd 0))))
- ((spectrum)
- (let* ((snd (make-variable-graph pane variable-name 2048 (mus-srate))))
- (set! (time-graph? snd 0) #f)
- (set! (transform-graph? snd 0) #t)
- (set! (x-axis-label snd 0 transform-graph) (string-append variable-name ": frequency"))
- (list (sound->integer snd) (channel-data snd 0))))
- (else #f)))))
-
-(define (variable-display var widget)
-
- (define (force-update wid)
- (gdk_window_invalidate_rect (GDK_WINDOW (gtk_widget_get_window (GTK_WIDGET wid))) (list 'GdkRectangle_ 0) #t)
- (gdk_window_process_updates (GDK_WINDOW (gtk_widget_get_window (GTK_WIDGET wid))) #t))
-
- (define (widget? w) (and (list? w) (= (length w) 2) (eq? (car w) 'GtkWidget_)))
-
- (if (widget? widget)
- (if (GTK_IS_LABEL widget)
- (begin
- (gtk_label_set_text (GTK_LABEL widget) (object->string var))
- (force-update widget)))
-
- (if (list? widget)
- (if (or (number? (car widget))
- (sound? (car widget)))
- ;; graph/spectrum -- does this need an explicit update?
- (let* ((snd (car widget))
- (data (cadr widget))
- (frames (length data))
- (loc (cursor snd 0)))
- (sound-data-set! data 0 loc var)
- (if (time-graph? snd) (update-time-graph snd))
- (if (transform-graph? snd) (update-transform-graph snd))
- (if (= (+ loc 1) frames)
- (set! (cursor snd 0) 0)
- (set! (cursor snd 0) (+ loc 1))))
- (if (GTK_IS_PROGRESS_BAR (car widget))
- ;; "thermometer"
- (let ((y0 (cadr widget))
- (y1 (caddr widget)))
- ;; (define wid (make-variable-display "do-loop" "i*2" 'scale))
- (gtk_progress_bar_set_fraction
- (GTK_PROGRESS_BAR (car widget))
- (max 0.0 (min 1.0 (/ (- var y0) (- y1 y0))))))
- ;; level meter
- (begin
- (list-set! widget 1 var)
- (display-level widget)
- (force-update (car widget)))))))
- var)
-
-(define (notebook-with-top-tabs)
- (gtk_notebook_set_tab_pos (GTK_NOTEBOOK (list-ref (main-widgets) 5)) GTK_POS_TOP))
-
-
-
-;;; -------- font selector --------
-
-(define font-selector-dialog #f)
-(define font-selectors '())
-
-(define (make-font-selector-dialog)
- (if (not font-selector-dialog)
- (let ((dismiss-button (gtk_button_new_with_label "Go Away"))
- (help-button (gtk_button_new_with_label "Help")))
- (gtk_widget_set_name dismiss-button "quit_button")
- (gtk_widget_set_name help-button "help_button")
- (set! font-selector-dialog (gtk_font_selection_dialog_new "Choose a Font"))
- (gtk_window_set_default_size (GTK_WINDOW font-selector-dialog) -1 -1)
- (gtk_window_set_resizable (GTK_WINDOW font-selector-dialog) #t)
- (gtk_widget_realize font-selector-dialog)
- (g_signal_connect font-selector-dialog "delete_event" (lambda (w ev data) (gtk_widget_hide font-selector-dialog) #t) #f)
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG font-selector-dialog))) dismiss-button #t #t 20)
- (g_signal_connect dismiss-button "clicked" (lambda (w data) (gtk_widget_hide font-selector-dialog)) #f)
- (gtk_widget_show dismiss-button)
- (gtk_box_pack_end (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG font-selector-dialog))) help-button #t #t 20)
- (g_signal_connect help-button "clicked"
- (lambda (w data)
- (help-dialog "Choose a Font"
- "choose a font, set which fields you want to use that font, and click 'ok'"))
- #f)
- (gtk_widget_show help-button)
- (let ((ok-button (gtk_font_selection_dialog_get_ok_button (GTK_FONT_SELECTION_DIALOG font-selector-dialog))))
- (gtk_widget_set_name ok-button "doit_button")
- (g_signal_connect ok-button "clicked"
- (lambda (w d)
- (let ((new-font (gtk_font_selection_dialog_get_font_name (GTK_FONT_SELECTION_DIALOG font-selector-dialog))))
- (for-each
- (lambda (fd)
- (let ((button (car fd))
- (func (cadr fd)))
- (if (gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON button))
- (set! (func) new-font))))
- font-selectors)
- (if (> (length (sounds)) 0)
- (begin
- (if (time-graph?) (update-time-graph))
- (if (transform-graph?) (update-transform-graph))
- (if (lisp-graph?) (update-lisp-graph))))))
- #f))
- (let ((cancel (gtk_font_selection_dialog_get_cancel_button (GTK_FONT_SELECTION_DIALOG font-selector-dialog))))
- (gtk_widget_set_name cancel "reset_button")
- (g_signal_connect cancel "clicked"
- (lambda (w d)
- (for-each
- (lambda (fd)
- (let ((func (cadr fd))
- (old-value (caddr fd)))
- (set! (func) old-value)))
- font-selectors)
- (if (> (length (sounds)) 0)
- (begin
- (if (time-graph?) (update-time-graph))
- (if (transform-graph?) (update-transform-graph))
- (if (lisp-graph?) (update-lisp-graph)))))
- #f))
- (let ((mainform (gtk_dialog_get_content_area (GTK_DIALOG font-selector-dialog))))
- (let ((label (gtk_label_new "Apply font to:")))
- (gtk_box_pack_start (GTK_BOX mainform) label #f #f 4)
- (gtk_misc_set_alignment (GTK_MISC label) 0.1 0.0)
- (gtk_widget_show label))
- (for-each
- (lambda (title func)
- (let* ((button (gtk_toggle_button_new_with_label (symbol->string title))))
- (gtk_box_pack_start (GTK_BOX mainform) button #f #f 4)
- (set! font-selectors (cons (list button func (func)) font-selectors))
- (gtk_widget_show button)))
- (list 'axis-label-font 'axis-numbers-font 'bold-peaks-font 'peaks-font 'listener-font 'tiny-font)
- (list axis-label-font axis-numbers-font bold-peaks-font peaks-font listener-font tiny-font)))
- (add-to-menu 3 "Choose Font"
- (lambda ()
- (gtk_widget_show font-selector-dialog)))
- )))
-
-
-#|
-;;; this doesn't actually work yet, but the simpler C case below almost works
-(define (emacs)
- (let ((emacs-pane (gtk_vbox_new #t 0)))
- (gtk_box_pack_start (GTK_BOX (list-ref (main-widgets) 5)) emacs-pane #f #f 4)
- (gtk_widget_show emacs-pane)
- (let ((socket (gtk_socket_new)))
- (gtk_container_add (GTK_CONTAINER emacs-pane) socket)
- (gtk_widget_show socket)
- (gtk_widget_realize socket)
- (let ((id (gtk_socket_get_id (GTK_SOCKET socket))))
- (system (format #f "/home/bil/test/emacs-23.1/src/emacs --parent-id=~D" id))))))
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <signal.h>
-#include <gtk/gtk.h>
-int main(int argc, char *argv)
-{
- GtkWidget *parent, *window;
- gtk_init (&argc, &argv);
- window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
- parent = gtk_vbox_new (FALSE, 0);
- gtk_container_add (GTK_CONTAINER (window), parent);
- {
- GtkWidget *socket = gtk_socket_new ();
- gtk_widget_show (socket);
- gtk_container_add (GTK_CONTAINER (parent), socket);
- gtk_widget_realize (socket);
- g_print ("The ID of the sockets window is %ld\n", gtk_socket_get_id (socket));
- }
- gtk_widget_show_all (window);
- gtk_main ();
- return(0);
-}
+ (cairo_destroy cr))))
+
+
+ (define (with-level-meters n)
+ ;; add n level meters to a pane at the top of the Snd window
+ (let* ((parent ((main-widgets) 5))
+ (height (if (> n 2) 70 85))
+ (pw (gtk_widget_get_window parent))
+ (parent-width (gtk_widget_get_allocated_height pw))
+ (width (floor (/ parent-width n)))
+ (meters (gtk_box_new GTK_ORIENTATION_HORIZONTAL 4))
+ (meter-list ()))
+ (gtk_box_pack_start (GTK_BOX parent) meters #f #f 4)
+ (gtk_widget_set_size_request meters width height)
+ (gtk_widget_show meters)
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (set! meter-list (cons (make-level-meter meters width height) meter-list)))
+ (hook-push dac-hook
+ (lambda (hook)
+ (let* ((sdobj (hook 'data))
+ (maxes (map float-vector-peak sdobj)))
+ (for-each
+ (lambda (meter)
+ (if (null? maxes)
+ (set! (meter 1) 0.0)
+ (begin
+ (set! (meter 1) (car maxes))
+ (display-level meter)
+ (set! maxes (cdr maxes)))))
+ (reverse meter-list)))))
+ (hook-push stop-dac-hook
+ (lambda (hook) ; drain away the bubble
+ (g_idle_add
+ (let ((ctr 0))
+ (lambda (ignored)
+ (for-each
+ (lambda (meter)
+ (set! (meter 1) 0.0)
+ (display-level meter))
+ meter-list)
+ (set! ctr (+ ctr 1))
+ (< ctr 200)))
+ #f)))
+ meter-list))
|#
+
+
+
+;;; -------- state display panel --------
+
+ (define variables-dialog #f)
+ (define variables-notebook #f)
+ (define variables-pages ())
+
+ (define (make-variables-dialog)
+ (let ((dismiss-button #f))
+ (set! variables-dialog (gtk_dialog_new))
+ (gtk_window_set_title (GTK_WINDOW variables-dialog) "Variables")
+ (gtk_container_set_border_width (GTK_CONTAINER variables-dialog) 10)
+ (gtk_window_set_default_size (GTK_WINDOW variables-dialog) -1 -1)
+ (gtk_window_set_resizable (GTK_WINDOW variables-dialog) #t)
+ (gtk_widget_realize variables-dialog)
+ (g_signal_connect variables-dialog "delete_event" (lambda (w ev data) (gtk_widget_hide variables-dialog) #t) #f)
+
+ (set! dismiss-button (gtk_dialog_add_button (GTK_DIALOG variables-dialog) "Go Away" GTK_RESPONSE_NONE))
+ (g_signal_connect dismiss-button "clicked" (lambda (w data) (gtk_widget_hide variables-dialog)) #f)
+ (gtk_widget_show dismiss-button)
+ (gtk_widget_set_name dismiss-button "quit_button")
+
+ (set! variables-notebook (gtk_notebook_new))
+ (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_content_area (GTK_DIALOG variables-dialog))) variables-notebook #t #t 4)
+ (gtk_notebook_set_tab_pos (GTK_NOTEBOOK variables-notebook) GTK_POS_RIGHT)
+ (gtk_widget_show variables-notebook)
+ (gtk_widget_show variables-dialog)
+ variables-dialog))
+
+ (define* (make-variable-display page-name variable-name (type 'text) (range (list 0.0 1.0)))
+ ;; type = 'text, 'meter, 'graph, 'spectrum, 'scale
+ (if (not variables-dialog) (make-variables-dialog))
+ (let ((page-info (assoc page-name variables-pages)))
+ (if (not page-info)
+ (let ((vbox (gtk_box_new GTK_ORIENTATION_VERTICAL 0))
+ (tab (gtk_label_new page-name)))
+ (gtk_widget_show tab)
+ (gtk_widget_show vbox)
+ (gtk_notebook_append_page (GTK_NOTEBOOK variables-notebook) vbox tab)
+ (set! page-info (cons page-name vbox))
+ (set! variables-pages (cons page-info variables-pages))))
+ (let ((pane (cdr page-info))
+ (var-label (string-append variable-name ":")))
+ (case type
+ ((text)
+ ;; add a horizontal pair: label text
+ (let ((label (gtk_label_new var-label))
+ (hbox (gtk_box_new GTK_ORIENTATION_HORIZONTAL 0))
+ (text (gtk_label_new "")))
+ (gtk_box_pack_start (GTK_BOX pane) hbox #f #f 2)
+ (gtk_widget_show hbox)
+ (gtk_box_pack_start (GTK_BOX hbox) label #f #f 6)
+
+ (gtk_widget_set_halign (GTK_WIDGET label) GTK_ALIGN_START)
+ (gtk_widget_show label)
+ (gtk_box_pack_start (GTK_BOX hbox) text #t #t 6)
+ (gtk_widget_set_halign (GTK_WIDGET text) GTK_ALIGN_START)
+ (gtk_widget_show text)
+ text))
+ ((scale)
+ (let ((label (gtk_label_new var-label))
+ (hbox (gtk_box_new GTK_ORIENTATION_HORIZONTAL 0))
+ (scale (gtk_progress_bar_new)))
+ (gtk_box_pack_start (GTK_BOX pane) hbox #f #f 2)
+ (gtk_widget_show hbox)
+ (gtk_box_pack_start (GTK_BOX hbox) label #f #f 6)
+ (gtk_widget_set_halign (GTK_WIDGET label) GTK_ALIGN_START)
+ (gtk_widget_show label)
+ (gtk_box_pack_start (GTK_BOX hbox) scale #f #f 6)
+ (gtk_widget_show scale)
+ (list scale (car range) (cadr range))))
+ ((graph)
+ (let ((snd (make-variable-graph pane (string-append variable-name ": time") 2048 *clm-srate*)))
+ (list (sound->integer snd) (channel-data snd 0))))
+ ((spectrum)
+ (let ((snd (make-variable-graph pane variable-name 2048 *clm-srate*)))
+ (set! (time-graph? snd 0) #f)
+ (set! (transform-graph? snd 0) #t)
+ (set! (x-axis-label snd 0 transform-graph) (string-append variable-name ": frequency"))
+ (list (sound->integer snd) (channel-data snd 0))))
+ (else #f)))))
+
+ (define (variable-display var widget)
+
+ (define (force-update wid)
+ (gdk_window_invalidate_rect (GDK_WINDOW (gtk_widget_get_window (GTK_WIDGET wid))) (list 'GdkRectangle_ 0) #t)
+ (gdk_window_process_updates (GDK_WINDOW (gtk_widget_get_window (GTK_WIDGET wid))) #t))
+
+ (define (widget? w) (and (pair? w) (= (length w) 2) (eq? (car w) 'GtkWidget_)))
+
+ ;; (let ((wid1 (make-variable-display "do-loop" "i*1" 'spectrum))) (variable-display 0.1 wid1))
+
+ (if (widget? widget)
+ (if (GTK_IS_LABEL widget)
+ (begin
+ (gtk_label_set_text (GTK_LABEL widget) (object->string var))
+ (force-update widget)))
+
+ (if (pair? widget)
+ (if (or (number? (car widget))
+ (sound? (car widget)))
+ ;; graph/spectrum -- does this need an explicit update?
+ (let* ((snd (car widget))
+ (data (cadr widget))
+ (len (length data))
+ (loc (cursor snd 0)))
+ (set! (data loc) var)
+ (if (time-graph? snd) (update-time-graph snd))
+ (if (transform-graph? snd) (update-transform-graph snd))
+ (if (= (+ loc 1) len)
+ (set! (cursor snd 0) 0)
+ (set! (cursor snd 0) (+ loc 1))))
+ (if (GTK_IS_PROGRESS_BAR (car widget))
+ ;; "thermometer"
+ (let ((y0 (cadr widget))
+ (y1 (caddr widget)))
+ ;; (define wid (make-variable-display "do-loop" "i*2" 'scale))
+ (gtk_progress_bar_set_fraction
+ (GTK_PROGRESS_BAR (car widget))
+ (max 0.0 (min 1.0 (/ (- var y0) (- y1 y0))))))
+ ))))
+ var)
+
+ (define (notebook-with-top-tabs)
+ (gtk_notebook_set_tab_pos (GTK_NOTEBOOK ((main-widgets) 5)) GTK_POS_TOP))
+
+ ) ; *gtk*
\ No newline at end of file
diff --git a/snd-gutils.c b/snd-gutils.c
index 8b01519..33af5d4 100644
--- a/snd-gutils.c
+++ b/snd-gutils.c
@@ -1,33 +1,19 @@
#include "snd.h"
-#if MUS_DEBUGGING
-static int cairo_depth = 0;
-#endif
-#if HAVE_GTK_3
-cairo_t *make_cairo(GdkWindow *win, const char *func, const char *file, int line)
+#if GTK_CHECK_VERSION(3, 0, 0)
+cairo_t *make_cairo(GdkWindow *win)
#else
-cairo_t *make_cairo(GdkDrawable *win, const char *func, const char *file, int line)
+cairo_t *make_cairo(GdkDrawable *win)
#endif
{
-#if MUS_DEBUGGING
- cairo_depth++;
- /* fprintf(stderr, "make_cairo: %s %s[%d] %d\n", func, file, line, cairo_depth); */
- if (cairo_depth > 1)
- {
- fprintf(stderr, "make_cairo: %s %s[%d] %d\n", func, file, line, cairo_depth);
- /* abort(); */
- }
-#endif
+ ss->line_width = -1.0;
return(gdk_cairo_create(win));
}
-void free_cairo(cairo_t *cr, const char *func, const char *file, int line)
+void free_cairo(cairo_t *cr)
{
-#if MUS_DEBUGGING
- cairo_depth--;
- /* fprintf(stderr, "free_cairo: %s %s[%d] %d\n", func, file, line, cairo_depth); */
-#endif
+ ss->line_width = -1.0;
cairo_destroy(cr);
}
@@ -187,13 +173,15 @@ int number_width(const char *num, bool use_tiny_font)
static int sg_font_width(PangoFontDescription *font)
{
/* returns size in pixels */
- int wid = 0;
- double dpi = 96.0; /* see below */
+ int wid;
+ double dpi;
PangoContext *ctx;
PangoFontMetrics *m;
#if HAVE_GTK_LINK_BUTTON_NEW
dpi = gdk_screen_get_resolution(gdk_display_get_default_screen(gdk_display_get_default())); /* pixels/inch */
+#else
+ dpi = 96.0; /* see below */
#endif
ctx = gdk_pango_context_get();
@@ -209,8 +197,8 @@ static int sg_font_width(PangoFontDescription *font)
static int sg_font_height(PangoFontDescription *font)
{
/* returns size in pixels */
- double dpi = 96.0; /* a plausible guess */
- int hgt = 0;
+ double dpi;
+ int hgt;
PangoContext *ctx;
PangoFontMetrics *m;
@@ -218,6 +206,8 @@ static int sg_font_height(PangoFontDescription *font)
/* gtk 2.1: gdk_display_get_default, gdk_display_get_default_screen */
/* gtk 2.9: gdk_screen_get_resolution */
dpi = gdk_screen_get_resolution(gdk_display_get_default_screen(gdk_display_get_default()));
+#else
+ dpi = 96.0; /* a plausible guess */
#endif
ctx = gdk_pango_context_get();
@@ -335,26 +325,81 @@ void set_button_label(GtkWidget *label, const char *str)
}
-void set_label(GtkWidget *label, const char *str)
+#if GTK_CHECK_VERSION(3, 10, 0)
+static const char *icon_to_label(const char *label)
{
- gtk_label_set_text(GTK_LABEL(label), str);
-}
+ /* these are the new-style labels in snd-g0.h */
+
+ /* fprintf(stderr, "label: [%s]\n", label); */
+ switch (label[0])
+ {
+ case 'A': case 'E': case 'O': case 'P': case 'S':
+ return(label);
+
+ case 'a': return("Exit");
+
+ case 'd':
+ if (mus_strcmp(label, "document-new")) return("New"); else
+ if (mus_strcmp(label, "document-open")) return("Open"); else
+ if (mus_strcmp(label, "document-print")) return("Print"); else
+ if (mus_strcmp(label, "document-revert")) return("Revert"); else
+ if (mus_strcmp(label, "document-save")) return("Save"); else
+ if (mus_strcmp(label, "document-save-as")) return("Save as");
+ break;
+ case 'e':
+ if (mus_strcmp(label, "edit-clear")) return("Clear"); else
+ if (mus_strcmp(label, "edit-copy")) return("Copy"); else
+ if (mus_strcmp(label, "edit-cut")) return("Cut"); else
+ if (mus_strcmp(label, "edit-find")) return("Find"); else
+ if (mus_strcmp(label, "edit-paste")) return("Paste"); else
+ if (mus_strcmp(label, "edit-redo")) return("Redo"); else
+ if (mus_strcmp(label, "edit-select-all")) return("Select all"); else
+ if (mus_strcmp(label, "edit-undo")) return("Undo");
+ break;
+
+ case 'g':
+ if (mus_strcmp(label, "go-first")) return("Go to start"); else
+ if (mus_strcmp(label, "go-last")) return("Go to end"); else
+ if (mus_strcmp(label, "go-next")) return("Next"); else
+ if (mus_strcmp(label, "go-previous")) return("Previous");
+ break;
+
+ case 'h': return("Help");
-void sg_left_justify_button(GtkWidget *button)
+ case 'm':
+ if (mus_strcmp(label, "media-playback-start")) return("Play"); else
+ if (mus_strcmp(label, "media-playback-stop")) return("Stop playing"); else
+ if (mus_strcmp(label, "media-playback-forward")) return("Play from cursor");
+ break;
+
+ case 'p': return("Stop");
+
+ case 'v':
+ if (mus_strcmp(label, "view-fullscreen")) return("Show all"); else
+ if (mus_strcmp(label, "view-refresh")) return("Show again");
+ break;
+
+ case 'w': return("Close");
+
+ case 'z':
+ if (mus_strcmp(label, "zoom-in")) return("Zoom in"); else
+ if (mus_strcmp(label, "zoom-out")) return("Zoom out");
+ break;
+ }
+ return(label);
+}
+
+GtkWidget *button_new_with_icon(const gchar *label)
{
- gfloat x, y;
- gtk_misc_get_alignment(GTK_MISC(GTK_LABEL(BIN_CHILD(button))), &x, &y);
- gtk_misc_set_alignment(GTK_MISC(GTK_LABEL(BIN_CHILD(button))), 0.05, y);
+ return(gtk_button_new_with_label(icon_to_label(label)));
}
+#endif
-void sg_left_justify_label(GtkWidget *label)
+void set_label(GtkWidget *label, const char *str)
{
- /* the label justify function in Gtk refers to the text of the lines after the 1st! */
- gfloat x, y;
- gtk_misc_get_alignment(GTK_MISC(GTK_LABEL(label)), &x, &y);
- gtk_misc_set_alignment(GTK_MISC(GTK_LABEL(label)), 0.05, y);
+ gtk_label_set_text(GTK_LABEL(label), str);
}
@@ -369,7 +414,7 @@ void check_for_event(void)
int i = 0;
if (ss->checking_explicitly) return;
ss->checking_explicitly = true;
- while ((i < 500) && (gtk_events_pending())) /* was 50, but gtk generates a huge number of these events */
+ while ((i < 100) && (gtk_events_pending()))
{
gtk_main_iteration();
i++; /* don't hang! */
@@ -380,9 +425,7 @@ void check_for_event(void)
void set_title(const char *title)
{
-#ifndef SND_AS_WIDGET
gtk_window_set_title(GTK_WINDOW(MAIN_SHELL(ss)), title);
-#endif
}
@@ -423,6 +466,9 @@ gc_t *gc_new(void)
void color_cursor(color_info *color)
{
ss->cursor_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->cursor_color_symbol, Xen_wrap_pixel(color));
+#endif
gc_set_colors(ss->cursor_gc, color, ss->graph_color);
gc_set_colors(ss->selected_cursor_gc, color, ss->selected_graph_color);
}
@@ -431,6 +477,9 @@ void color_cursor(color_info *color)
void color_marks(color_info *color)
{
ss->mark_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->mark_color_symbol, Xen_wrap_pixel(color));
+#endif
gc_set_colors(ss->mark_gc, color, ss->graph_color);
gc_set_colors(ss->selected_mark_gc, color, ss->selected_graph_color);
}
@@ -439,6 +488,9 @@ void color_marks(color_info *color)
void color_selection(color_info *color)
{
ss->selection_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->selection_color_symbol, Xen_wrap_pixel(color));
+#endif
gc_set_colors(ss->selection_gc, color, ss->graph_color);
gc_set_colors(ss->selected_selection_gc, color, ss->selected_graph_color);
}
@@ -446,7 +498,6 @@ void color_selection(color_info *color)
void color_graph(color_info *color)
{
- ss->graph_color = color;
gc_set_background(ss->basic_gc, color);
gc_set_foreground(ss->erase_gc, color);
gc_set_colors(ss->selection_gc, ss->selection_color, color);
@@ -457,7 +508,6 @@ void color_graph(color_info *color)
void color_selected_graph(color_info *color)
{
- ss->selected_graph_color = color;
gc_set_background(ss->selected_basic_gc, color);
gc_set_foreground(ss->selected_erase_gc, color);
gc_set_colors(ss->selected_selection_gc, ss->selection_color, color);
@@ -468,7 +518,6 @@ void color_selected_graph(color_info *color)
void color_data(color_info *color)
{
- ss->data_color = color;
gc_set_foreground(ss->basic_gc, color);
gc_set_background(ss->erase_gc, color);
}
@@ -476,7 +525,6 @@ void color_data(color_info *color)
void color_selected_data(color_info *color)
{
- ss->selected_data_color = color;
gc_set_foreground(ss->selected_basic_gc, color);
gc_set_background(ss->selected_erase_gc, color);
}
@@ -485,6 +533,9 @@ void color_selected_data(color_info *color)
void set_mix_color(color_info *color)
{
ss->mix_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->mix_color_symbol, Xen_wrap_pixel(color));
+#endif
gc_set_foreground(ss->mix_gc, color);
}
@@ -501,7 +552,7 @@ color_t rgb_to_color(mus_float_t r, mus_float_t g, mus_float_t b)
}
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
GdkColor *rgb_to_gdk_color(color_t col)
{
GdkColor gcolor;
@@ -520,30 +571,36 @@ void widget_modify_bg(GtkWidget *w, GtkStateType type, color_t color)
{
/* the color has to stick around??? */
/* another stop-gap: allocate a color each time... */
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
gtk_widget_modify_bg(w, type, rgb_to_gdk_color(color));
#else
- gtk_widget_override_background_color(w, type, (GdkRGBA *)color);
+#if (!GTK_CHECK_VERSION(3, 16, 0))
+ gtk_widget_override_background_color(w, GTK_STATE_FLAG_NORMAL, (GdkRGBA *)color);
+#endif
#endif
}
void widget_modify_fg(GtkWidget *w, GtkStateType type, color_t color)
{
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
gtk_widget_modify_fg(w, type, rgb_to_gdk_color(color));
#else
- gtk_widget_override_color(w, type, (GdkRGBA *)color);
+#if (!GTK_CHECK_VERSION(3, 16, 0))
+ gtk_widget_override_color(w, GTK_STATE_FLAG_NORMAL, (GdkRGBA *)color);
+#endif
#endif
}
void widget_modify_base(GtkWidget *w, GtkStateType type, color_t color)
{
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
gtk_widget_modify_base(w, type, rgb_to_gdk_color(color));
#else
- gtk_widget_override_background_color(w, type, (GdkRGBA *)color);
+#if (!GTK_CHECK_VERSION(3, 16, 0))
+ gtk_widget_override_background_color(w, GTK_STATE_FLAG_NORMAL, (GdkRGBA *)color);
+#endif
#endif
}
@@ -569,7 +626,16 @@ void set_toggle_button(GtkWidget *wid, bool val, bool passed, void *data)
}
-#if HAVE_GTK_3
+bool cursor_set_blinks(GtkWidget *w, bool blinks)
+{
+ GtkSettings *settings;
+ settings = gtk_widget_get_settings(w);
+ g_object_set(settings, "gtk-cursor-blink", (gboolean)blinks, NULL);
+ return(blinks);
+}
+
+
+#if GTK_CHECK_VERSION(3, 0, 0)
int widget_height(GtkWidget *w)
{
@@ -719,29 +785,6 @@ void sg_text_insert(GtkWidget *w, const char *text)
}
-void sg_set_cursor(GtkWidget *w, int position)
-{
- GtkTextIter pos;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
- gtk_text_buffer_get_iter_at_offset(buf, &pos, position - 1);
- gtk_text_buffer_place_cursor(buf, &pos);
- gtk_text_view_scroll_mark_onscreen(GTK_TEXT_VIEW(w), gtk_text_buffer_get_insert(buf));
-}
-
-
-int sg_cursor_position(GtkWidget *w)
-{
- GtkTextMark *m;
- GtkTextIter pos;
- GtkTextBuffer *buf;
- buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
- m = gtk_text_buffer_get_insert(buf);
- gtk_text_buffer_get_iter_at_mark(buf, &pos, m);
- return(gtk_text_iter_get_offset(&pos));
-}
-
-
GtkWidget *make_scrolled_text(GtkWidget *parent, bool editable, int add_choice, bool resize)
{
/* returns new text widget */
@@ -750,6 +793,9 @@ GtkWidget *make_scrolled_text(GtkWidget *parent, bool editable, int add_choice,
sw = gtk_scrolled_window_new(NULL, NULL);
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(sw), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+ /* gtk_scrolled_window_set_min_content_height(GTK_SCROLLED_WINDOW(sw), 1000);
+ * seems to be a no-op -- I think they are maxing this against the current contents window size (see below)
+ */
new_text = gtk_text_view_new();
buf = gtk_text_buffer_new(NULL);
@@ -809,6 +855,10 @@ GtkWidget *snd_gtk_dialog_new(void)
{
GtkWidget *w;
w = gtk_dialog_new();
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_window_set_transient_for(GTK_WINDOW(w), GTK_WINDOW(MAIN_SHELL(ss)));
+#endif
+ add_dialog_style(w);
g_object_ref(w);
return(w);
}
@@ -829,68 +879,32 @@ GtkWidget *snd_gtk_highlight_label_new(const char *label)
}
-GtkWidget *snd_gtk_entry_label_new(const char *label, color_info *color)
-{
- GtkWidget *rlw;
- rlw = gtk_entry_new();
- gtk_entry_set_has_frame(GTK_ENTRY(rlw), false);
- if (label) gtk_entry_set_text(GTK_ENTRY(rlw), label);
- gtk_editable_set_editable(GTK_EDITABLE(rlw), false);
- UNSET_CAN_FOCUS(GTK_WIDGET(rlw)); /* turn off the $%#@$! blinking cursor */
- widget_modify_base(rlw, GTK_STATE_NORMAL, color);
- widget_modify_base(rlw, GTK_STATE_ACTIVE, color);
- return(rlw);
-}
-
-
-GtkWidget *make_info_widget(void)
-{
- return(snd_gtk_entry_label_new(NULL, ss->highlight_color));
-}
-
-
-void info_widget_display(GtkWidget *w, const char *message)
-{
- gtk_entry_set_text(GTK_ENTRY(w), message);
-}
-
-
-void info_widget_set_size(GtkWidget *w, int size)
-{
- gtk_entry_set_width_chars(GTK_ENTRY(w), size);
-}
-
-
void widget_int_to_text(GtkWidget *w, int val)
{
char *str;
str = (char *)calloc(8, sizeof(char));
- mus_snprintf(str, 8, "%d", val);
- gtk_entry_set_text(GTK_ENTRY(w), str);
- free(str);
-}
-
-#if 0
-void widget_float_to_text(GtkWidget *w, mus_float_t val)
-{
- char *str;
- str = (char *)calloc(8, sizeof(char));
- mus_snprintf(str, 8, "%.2f", val);
+ snprintf(str, 8, "%d", val);
gtk_entry_set_text(GTK_ENTRY(w), str);
free(str);
}
-#endif
void widget_mus_long_t_to_text(GtkWidget *w, mus_long_t val)
{
char *str;
str = (char *)calloc(8, sizeof(char));
- mus_snprintf(str, 8, MUS_LD, val);
+ snprintf(str, 8, "%lld", val);
gtk_entry_set_text(GTK_ENTRY(w), str);
free(str);
}
+#if HAVE_GTK_ADJUSTMENT_GET_UPPER
+ #define ADJUSTMENT_LOWER(Adjust) gtk_adjustment_get_lower(GTK_ADJUSTMENT(Adjust))
+ #define ADJUSTMENT_UPPER(Adjust) gtk_adjustment_get_upper(GTK_ADJUSTMENT(Adjust))
+#else
+ #define ADJUSTMENT_LOWER(Adjust) ((GTK_ADJUSTMENT(Adjust))->lower)
+ #define ADJUSTMENT_UPPER(Adjust) ((GTK_ADJUSTMENT(Adjust))->upper)
+#endif
void ensure_scrolled_window_row_visible(widget_t list, int row, int num_rows)
{
@@ -902,7 +916,7 @@ void ensure_scrolled_window_row_visible(widget_t list, int row, int num_rows)
gdouble maximum, size, new_value, minimum;
parent = gtk_widget_get_parent(list);
-#if HAVE_GTK_3
+#if GTK_CHECK_VERSION(3, 0, 0)
v = gtk_scrollable_get_vadjustment(GTK_SCROLLABLE(parent));
#else
v = gtk_viewport_get_vadjustment(GTK_VIEWPORT(parent));
@@ -923,27 +937,6 @@ void ensure_scrolled_window_row_visible(widget_t list, int row, int num_rows)
ADJUSTMENT_SET_VALUE(v, new_value);
}
-
-GtkWidget *sg_button_new_from_stock_with_label(const char *text, const gchar *stock_id)
-{
- /* borrowed from gtk/gtkbutton.c */
- GtkWidget *button, *image, *label, *hbox, *align;
-
- button = gtk_button_new();
- label = gtk_label_new(text);
- image = (GtkWidget *)g_object_ref(gtk_image_new_from_stock(stock_id, GTK_ICON_SIZE_BUTTON));
- hbox = gtk_hbox_new(false, 2);
- align = gtk_alignment_new (0.5, 0.5, 0.0, 0.0);
-
- gtk_box_pack_start(GTK_BOX(hbox), image, false, false, 0);
- gtk_box_pack_end(GTK_BOX(hbox), label, false, false, 0);
- gtk_container_add(GTK_CONTAINER(button), align);
- gtk_container_add(GTK_CONTAINER(align), hbox);
- gtk_widget_show_all(align);
-
- g_object_unref(image);
- return(button);
-}
@@ -972,8 +965,162 @@ static gboolean slist_item_button_pressed(GtkWidget *w, GdkEventButton *ev, gpoi
}
-#if HAVE_GTK_3
-static GtkCssProvider *wb_provider;
+#if GTK_CHECK_VERSION(3, 0, 0)
+static GtkCssProvider *wb_provider, *listener_provider, *dialog_provider, *hl_provider, *tb_provider, *mu_provider;
+static GtkCssProvider *rsc_provider, *gsc_provider, *bsc_provider, *pd_provider, *cb_provider, *entry_provider;
+static GtkCssProvider *cl_provider;
+
+void add_white_button_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(wb_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+ gtk_widget_set_name(w, "white_button");
+}
+
+void add_highlight_button_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(hl_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+ gtk_widget_set_name(w, "highlight_button");
+}
+
+void add_center_button_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(cl_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+void add_listener_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(listener_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+ gtk_widget_set_name(w, "listener_text");
+}
+
+void add_dialog_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(dialog_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+void add_toolbar_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(tb_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+void add_menu_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(mu_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+void add_paned_style(GtkWidget *w)
+{
+#if 0
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(pd_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+#endif
+}
+
+void add_red_scale_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(rsc_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+void add_green_scale_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(gsc_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+void add_blue_scale_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(bsc_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+void add_check_button_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(cb_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+void add_entry_style(GtkWidget *w)
+{
+ GtkStyleContext *c;
+ c = gtk_widget_get_style_context(w);
+ gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(entry_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+}
+
+#else
+
+void add_red_scale_style(GtkWidget *w)
+{
+}
+
+void add_green_scale_style(GtkWidget *w)
+{
+}
+
+void add_blue_scale_style(GtkWidget *w)
+{
+}
+
+void add_toolbar_style(GtkWidget *w)
+{
+}
+
+void add_menu_style(GtkWidget *w)
+{
+}
+
+void add_paned_style(GtkWidget *w)
+{
+}
+
+void add_highlight_button_style(GtkWidget *w)
+{
+}
+
+void add_center_button_style(GtkWidget *w)
+{
+}
+
+void add_white_button_style(GtkWidget *w)
+{
+ gtk_widget_set_name(w, "white_button");
+}
+
+void add_listener_style(GtkWidget *w)
+{
+ gtk_widget_set_name(w, "listener_text");
+}
+
+void add_dialog_style(GtkWidget *w)
+{
+}
+
+void add_check_button_style(GtkWidget *w)
+{
+}
+
+void add_entry_style(GtkWidget *w)
+{
+}
#endif
static GtkWidget *slist_new_item(slist *lst, const char *label, int row)
@@ -981,26 +1128,19 @@ static GtkWidget *slist_new_item(slist *lst, const char *label, int row)
GtkWidget *item;
item = gtk_button_new_with_label(label);
- gtk_widget_set_name(item, "white_button");
slist_set_row(item, row);
gtk_button_set_relief(GTK_BUTTON(item), GTK_RELIEF_HALF);
+#if GTK_CHECK_VERSION(3, 14, 0)
+ gtk_widget_set_halign(GTK_WIDGET(item), GTK_ALIGN_START);
+#else
gtk_button_set_alignment(GTK_BUTTON(item), 0.05, 1.0);
+#endif
gtk_box_pack_start(GTK_BOX(lst->topics), item, false, false, 0);
widget_modify_bg(item, GTK_STATE_NORMAL, ss->white);
widget_modify_bg(item, GTK_STATE_PRELIGHT, ss->light_blue);
-#if (HAVE_GTK_3)
- gtk_widget_override_color(item, GTK_STATE_NORMAL, (GdkRGBA *)(ss->black));
- gtk_widget_override_color(item, GTK_STATE_PRELIGHT, (GdkRGBA *)(ss->red));
- gtk_widget_override_color(item, GTK_STATE_SELECTED, (GdkRGBA *)(ss->black));
-
- {
- GtkStyleContext *c;
- c = gtk_widget_get_style_context(item);
- gtk_style_context_add_provider(c, GTK_STYLE_PROVIDER(wb_provider), GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
- }
-#endif
-
+ add_white_button_style(item);
+
SG_SIGNAL_CONNECT(item, "clicked", slist_item_clicked, (gpointer)lst);
SG_SIGNAL_CONNECT(item, "button_press_event", slist_item_button_pressed, (gpointer)lst);
@@ -1018,13 +1158,13 @@ slist *slist_new_with_title_and_table_data(const char *title,
{
slist *lst;
GtkWidget *topw = NULL;
- int i;
lst = (slist *)calloc(1, sizeof(slist));
lst->selected_item = SLIST_NO_ITEM_SELECTED;
if (title)
{
lst->box = gtk_vbox_new(false, 0);
+ widget_set_vexpand(lst->box, true);
lst->label = snd_gtk_highlight_label_new(title);
gtk_box_pack_start(GTK_BOX(lst->box), lst->label, false, false, 0);
@@ -1032,6 +1172,7 @@ slist *slist_new_with_title_and_table_data(const char *title,
}
lst->topics = gtk_vbox_new(false, 2); /* sets list item vertical spacing */
+ widget_set_vexpand(lst->topics, true);
lst->scroller = gtk_scrolled_window_new(NULL, NULL);
if (!title)
@@ -1044,18 +1185,10 @@ slist *slist_new_with_title_and_table_data(const char *title,
gtk_paned_add1(GTK_PANED(parent), topw);
break;
- case PANED_ADD2:
- gtk_paned_add2(GTK_PANED(parent), topw);
- break;
-
case BOX_PACK:
gtk_box_pack_start(GTK_BOX(parent), topw, true, true, 4);
break;
- case BOX_PACK_END:
- gtk_box_pack_end(GTK_BOX(parent), topw, false, false, 4);
- break;
-
case TABLE_ATTACH:
gtk_table_attach(GTK_TABLE(parent), topw, t1, t2, t3, t4,
(GtkAttachOptions)(GTK_FILL | GTK_EXPAND),
@@ -1069,7 +1202,11 @@ slist *slist_new_with_title_and_table_data(const char *title,
}
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(lst->scroller), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+#if HAVE_GTK_HEADER_BAR_NEW
+ gtk_container_add(GTK_CONTAINER(lst->scroller), lst->topics);
+#else
gtk_scrolled_window_add_with_viewport(GTK_SCROLLED_WINDOW(lst->scroller), lst->topics);
+#endif
if (title)
{
@@ -1081,12 +1218,18 @@ slist *slist_new_with_title_and_table_data(const char *title,
if (num_items > 0)
{
+ int i;
lst->items = (GtkWidget **)calloc(num_items, sizeof(GtkWidget *));
lst->items_size = num_items;
lst->num_items = num_items;
for (i = 0; i < num_items; i++)
lst->items[i] = slist_new_item(lst, initial_items[i], i);
}
+
+ /* gtk_scrolled_window_set_min_content_height(GTK_SCROLLED_WINDOW(lst->scroller), 200);
+ * this actually works!
+ */
+
return(lst);
}
@@ -1141,6 +1284,10 @@ static void slist_set_row(GtkWidget *item, int row)
void slist_append(slist *lst, const char *name)
{
int loc = 0;
+ if ((!name) ||
+ (!g_utf8_validate(name, -1, NULL)))
+ return;
+
if (lst->items_size == 0)
{
lst->items = (GtkWidget **)calloc(INITIAL_SLIST_LENGTH, sizeof(GtkWidget *));
@@ -1181,52 +1328,7 @@ void slist_select(slist *lst, int row)
}
-char *slist_selection(slist *lst)
-{
- if (lst->selected_item != SLIST_NO_ITEM_SELECTED)
- return((char *)gtk_button_get_label(GTK_BUTTON(lst->items[lst->selected_item])));
- return(NULL);
-}
-
-/* (any place labels are erased see gtk_bin_get_child and snd-gregion.c) */
-
-
-/* TODO: gtk troubles:
- *
- * gtk3: the name_pix icon backgrounds are still gray, also dialog buttons and menu items
- * do meters work in rec? in Motif they're drawn incorrectly
- * hide controls + listener doesn't
- * perhaps tooltips in places like the data list of the save-as dialog
- * perhaps menu accelerators, but they still look dumb
- * drag marks as edit is messy looking in gtk
- * are the printed graphs truncated because the "printer" assumes some paper size?
- *
- * if chans are syncd, shouldn't multichan mix/mark also?
- * syncd but mark drag doesn't edit both?
- *
- * gtk3: snd-test 13 segfault
- * snd: cairo-surface.c:385: _cairo_surface_begin_modification: Assertion `! surface->finished' failed.
- * it's ok out of context?
- *
- * superimposed chans flicker a lot
- * the cairo_t's are not shared in this case, so each chan is a separate display
- *
- * cursor redisplay needs work -- save the actual points? (it's ok if dots)
- * if proc cursor, foreground color is not set back to old
- *
- * hide listener says: "gtk_widget_size_allocate(): attempt to allocate widget with width 1024 and height -3"
- * there are many bugs in gtk3's paned windows! You can get this error simply by dragging a pane closed.
- * show controls for example, does not open the pane.
- *
- * why does Motif stop sign have dark corners?
- * what is the ;or3 1 problem?
- * is fixup_cp_ax_wn needed?
- * play choppy if graphics -- seems ok?
- */
-
-
-
-#if (!HAVE_GTK_3)
+#if (!GTK_CHECK_VERSION(3, 0, 0))
void init_gtk(void)
{
@@ -1315,6 +1417,12 @@ style \"zoom_slider\" = \"default_slider\"\n \
widget \"*.zx_slider\" style \"zoom_slider\"\n \
widget \"*.zy_slider\" style \"zoom_slider\"\n \
widget \"*.gzy_slider\" style \"zoom_slider\"\n \
+style \"default_tree_view\" = \"default\"\n \
+{\n \
+ GtkTreeView::odd-row-color = { 0.94, 0.97, 1.0 }\n \
+ GtkTreeView::even-row-color = { 1.0, 1.0, 1.0 }\n \
+}\n \
+class \"GtkTreeView\" style \"default_tree_view\"\n \
style \"dialog_button\" = \"default_button\"\n \
{\n \
bg[NORMAL] = { 1.0, 1.0, 0.94 }\n \
@@ -1339,18 +1447,141 @@ widget \"*.white_button\" style \"white_button\"\n");
#else
-/* see gtkcssprovider.c toward the end
- */
-
void init_gtk(void)
{
wb_provider = gtk_css_provider_new();
gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(wb_provider),
- "#white_button { \n"
- " padding: 0 0;\n"
- " border-width: 0;\n"
+ "GtkButton#white_button { \n"
+ " padding-top: 0px;\n"
+ " padding-bottom: 0px;\n"
+ " border-width: 0px;\n"
+ " background-color: #ffffff;\n"
+ "}\n"
+ "GtkButton#white_button:prelight { \n"
+ " background-image: -gtk-gradient (linear, left top, right bottom, from(#ffffff), to(rgb(200, 225, 255)));\n"
+ "}\n",
+ -1, NULL);
+
+ hl_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(hl_provider),
+ "GtkEventBox, GtkButton#highlight_button { \n"
+ " padding-top: 0px;\n"
+ " padding-bottom: 0px;\n"
+ " border-width: 0px;\n"
+ " background-color: #fffff0;\n"
+ "}\n"
+ "GtkButton#highlight_button:prelight { \n"
+ " background-image: -gtk-gradient (linear, left top, right bottom, from(#fffff0), to(rgb(200, 225, 255)));\n"
"}\n",
-1, NULL);
+
+ cl_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(cl_provider),
+ "GtkEventBox, GtkButton { \n"
+ " padding-top: 0px;\n"
+ " padding-bottom: 0px;\n"
+ " padding-left: 8px;\n"
+ " padding-right: 8px;\n"
+ " border-width: 1px;\n"
+ " border-color: gray;\n"
+ " background-color: #fffff0;\n"
+ "}\n"
+ "GtkButton:prelight { \n"
+ " background-image: -gtk-gradient (linear, left top, right bottom, from(#fffff0), to(rgb(200, 225, 255)));\n"
+ "}\n",
+ -1, NULL);
+
+ listener_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(listener_provider),
+ "#listener_text { \n"
+ /* " background-color: rgb(240, 248, 255);\n" */
+ " background-color: #ffffff;\n"
+ " color: #000000;\n"
+ "}\n"
+ "#listener_text:selected { \n"
+ " background-color: darker(rgb(240, 248, 255));\n"
+ " color: #000000;\n"
+ "}\n",
+ -1, NULL);
+
+ entry_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(entry_provider),
+ "GtkEntry:selected { \n"
+ " background-color: darker(rgb(240, 248, 255));\n"
+ " color: #000000;\n"
+ "}\n",
+ -1, NULL);
+
+ dialog_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(dialog_provider),
+ "GtkDialog { \n"
+ " background-image: -gtk-gradient (linear, left top, right bottom, from(rgb(250, 250, 230)), to(rgb(235, 235, 210)));\n"
+ "}\n",
+ -1, NULL);
+
+ tb_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(tb_provider),
+ "GtkToolbar, GtkToolButton, GtkToolItem { \n"
+ " border-color: #fffff0;\n"
+ /* " background-color: #fffff0;\n" */
+ " padding-left: 8px;\n"
+ " padding-bottom: 4px;\n"
+ " background-image: -gtk-gradient (linear, left top, right bottom, from(rgb(255, 255, 240)), to(rgb(255, 255, 255)));\n"
+ "}\n",
+ -1, NULL);
+ /* the 8px here refers to the whole bar, not each entry */
+
+ mu_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(mu_provider),
+ "GtkMenuBar, GtkMenu, GtkMenuItem { \n"
+ " border-width: 4px;\n"
+ " border-color: #fffff0;\n"
+ " background-color: #fffff0;\n"
+ " padding-bottom: 4px;\n"
+ " padding-left: 8px;\n"
+ "}\n",
+ -1, NULL);
+
+ rsc_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(rsc_provider),
+ "GtkScale { \n"
+ " background-image: -gtk-gradient (linear, left top, right bottom, from(rgb(250, 250, 230)), to(rgb(160, 0, 0)));\n"
+ "}\n",
+ -1, NULL);
+
+ gsc_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(gsc_provider),
+ "GtkScale { \n"
+ " background-image: -gtk-gradient (linear, left top, right bottom, from(rgb(250, 250, 230)), to(rgb(0, 160, 0)));\n"
+ "}\n",
+ -1, NULL);
+
+ bsc_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(bsc_provider),
+ "GtkScale { \n"
+ " background-image: -gtk-gradient (linear, left top, right bottom, from(rgb(250, 250, 230)), to(rgb(0, 0, 160)));\n"
+ "}\n",
+ -1, NULL);
+
+ /* I wanted to make the handle larger and set its color to #90ee90 -- no way!
+ */
+ pd_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(pd_provider),
+ "GtkPaned { \n"
+ " background-color: #fffff0;\n"
+ "}\n",
+ -1, NULL);
+
+ cb_provider = gtk_css_provider_new();
+ gtk_css_provider_load_from_data(GTK_CSS_PROVIDER(cb_provider),
+ "GtkRadioButton:hover, GtkCheckButton:hover { \n"
+ " background-color: rgb(200, 200, 190);\n"
+ "}\n",
+ -1, NULL);
+
+/* gtk3 tree view is inaccessible in filechooser and row colors can't be set!
+ */
}
#endif
+
diff --git a/snd-gxbitmaps.c b/snd-gxbitmaps.c
index 888b37d..47ee6a4 100644
--- a/snd-gxbitmaps.c
+++ b/snd-gxbitmaps.c
@@ -334,28 +334,32 @@ const char **mini_glass_bits(int n)
}
/* from HView */
+/* there are at least 3 stop signs in Snd. This one for the Motif name-box,
+ * the big one for the toolbar (below), and the gtk built-in stop sign
+ * for the gtk name-box.
+ */
static const char *stop_sign_xpm[] = {
"17 17 3 1",
-" c None s None",
-". c red",
-"X c white",
-" XXXXXXXXX ",
-" X.........X ",
-" X...........X ",
-" X.............X ",
-"X...............X",
-"X...............X",
-"X.XX.XXX.XX..XX.X",
-"X.X...X.X..X.X.XX",
-"X..X..X.X..X.XX.X",
-"X.XX..X..XX..X..X",
-"X...............X",
-"X...............X",
-"X...............X",
-" X.............X ",
-" X...........X ",
-" X.........X ",
-" XXXXXXXXX "};
+"- c None s None",
+". c red",
+"X c white",
+"----XXXXXXXXX----",
+"---X.........X---",
+"--X...........X--",
+"-X.............X-",
+"X...............X",
+"X...............X",
+"X.XX.XXX.XX..XX.X",
+"X.X...X.X..X.X.XX",
+"X..X..X.X..X.XX.X",
+"X.XX..X..XX..X..X",
+"X...............X",
+"X...............X",
+"X...............X",
+"-X.............X-",
+"--X...........X--",
+"---X.........X---",
+"----XXXXXXXXX----"};
const char **stop_sign_bits(void) {return(stop_sign_xpm);}
@@ -1385,6 +1389,295 @@ static const char *save_xpm[] = {
" . . . . . . . . . . . . . . . . 7+. ",
" "};
+static const char *saveas_xpm[] = {
+"24 24 262 2",
+" c None",
+". c #000000",
+"+ c #FBE73B",
+"@ c #F2B64D",
+"# c #FCEB3D",
+"$ c #F7B544",
+"% c #5D502C",
+"& c #C3D7F4",
+"* c #A9CDE5",
+"= c #75757A",
+"- c #EFC5BB",
+"; c #F1C8BE",
+"> c #F0C6BC",
+", c #EEBCB2",
+"' c #EEBEB5",
+") c #EEC1B8",
+"! c #EDBFB6",
+"~ c #E8B6AC",
+"{ c #FCE93B",
+"] c #F7B545",
+"^ c #6C5F34",
+"/ c #434345",
+"( c #92A7B9",
+"_ c #96B1C7",
+": c #BBD6E8",
+"< c #8AAAC5",
+"[ c #605F68",
+"} c #E08D7E",
+"| c #E0826E",
+"1 c #E0806E",
+"2 c #DC7A68",
+"3 c #DC8171",
+"4 c #DA7868",
+"5 c #D38072",
+"6 c #FAE43A",
+"7 c #F4B244",
+"8 c #615030",
+"9 c #783E35",
+"0 c #4D4C52",
+"a c #7790A2",
+"b c #526D82",
+"c c #BAD5E9",
+"d c #88A7C3",
+"e c #686670",
+"f c #C8817B",
+"g c #CB7C74",
+"h c #CB7A73",
+"i c #CB7B73",
+"j c #CC7C72",
+"k c #CA7C72",
+"l c #F9DF39",
+"m c #F3AF42",
+"n c #614F2F",
+"o c #8F4941",
+"p c #945554",
+"q c #5B5A62",
+"r c #7B97AE",
+"s c #536F84",
+"t c #B6D3E7",
+"u c #87ABC1",
+"v c #737373",
+"w c #FFFFFF",
+"x c #FEFEFE",
+"y c #F9DC38",
+"z c #EFB44D",
+"A c #665A32",
+"B c #BBBBBB",
+"C c #CDCDCD",
+"D c #E4E4E4",
+"E c #6E6E6E",
+"F c #819EB6",
+"G c #526C80",
+"H c #B9D3E7",
+"I c #85A4BF",
+"J c #F8D837",
+"K c #F0A93F",
+"L c #655930",
+"M c #BABABA",
+"N c #CCCCCC",
+"O c #E5E5E5",
+"P c #F7F7F7",
+"Q c #727272",
+"R c #83A0B8",
+"S c #4F697C",
+"T c #B9D3E6",
+"U c #84A3BF",
+"V c #CECECE",
+"W c #F6D236",
+"X c #EDA43E",
+"Y c #5C5130",
+"Z c #949494",
+"` c #A3A3A3",
+" . c #B7B7B7",
+".. c #C6C6C6",
+"+. c #BDBDBD",
+"@. c #88A4BB",
+"#. c #486276",
+"$. c #B7D2E7",
+"%. c #82A0BB",
+"&. c #636363",
+"*. c #FDFDFD",
+"=. c #D7AE74",
+"-. c #61562F",
+";. c #465E70",
+">. c #B5CAE5",
+",. c #7FA2B9",
+"'. c #4F4115",
+"). c #87A3BA",
+"!. c #455C6D",
+"~. c #AECCE5",
+"{. c #7DA0B6",
+"]. c #CBCBCB",
+"^. c #9B9B9B",
+"/. c #9C9C9C",
+"(. c #A7A7A7",
+"_. c #B8B8B8",
+":. c #C5C5C5",
+"<. c #546069",
+"[. c #B0D1E4",
+"}. c #83A1B6",
+"|. c #735B5B",
+"1. c #F0F0F0",
+"2. c #D9D9D9",
+"3. c #D3D3D3",
+"4. c #E1E1E1",
+"5. c #EDEDED",
+"6. c #F8F8F8",
+"7. c #515C64",
+"8. c #AACEE3",
+"9. c #7B9BB2",
+"0. c #7A8E9A",
+"a. c #7A7A7A",
+"b. c #707070",
+"c. c #6C6C6C",
+"d. c #6F6F6F",
+"e. c #6A6E71",
+"f. c #696969",
+"g. c #6F777E",
+"h. c #86A2B9",
+"i. c #3A515D",
+"j. c #A9C9E2",
+"k. c #7494AF",
+"l. c #7E9BB4",
+"m. c #7D9AB3",
+"n. c #7998B2",
+"o. c #85A1B8",
+"p. c #829FB7",
+"q. c #8CA7BD",
+"r. c #8AA5BB",
+"s. c #364A59",
+"t. c #ABC4E2",
+"u. c #7294AD",
+"v. c #6F90AC",
+"w. c #7192AE",
+"x. c #414A4E",
+"y. c #424A51",
+"z. c #525B63",
+"A. c #626F79",
+"B. c #5F6C76",
+"C. c #5C6971",
+"D. c #5A666F",
+"E. c #58636B",
+"F. c #57636A",
+"G. c #3B5360",
+"H. c #39424B",
+"I. c #7897B3",
+"J. c #A4B9CB",
+"K. c #364853",
+"L. c #AAC9E2",
+"M. c #7091AA",
+"N. c #6F8FA7",
+"O. c #4A5359",
+"P. c #97938C",
+"Q. c #DFDDDA",
+"R. c #E3E1DE",
+"S. c #EBEAE8",
+"T. c #EAE9E7",
+"U. c #CFCEC9",
+"V. c #C9C6C0",
+"W. c #9B968E",
+"X. c #566168",
+"Y. c #4B657A",
+"Z. c #54738C",
+"`. c #AAC6DD",
+" + c #34464E",
+".+ c #AAC9E1",
+"++ c #6C8EA6",
+"@+ c #6C8CA4",
+"#+ c #40474D",
+"$+ c #DAD8D3",
+"%+ c #E7E6E2",
+"&+ c #67655E",
+"*+ c #524F47",
+"=+ c #D9D7D4",
+"-+ c #C7C5BF",
+";+ c #C0BCB5",
+">+ c #B8B3AB",
+",+ c #434C54",
+"'+ c #4D697F",
+")+ c #4F6F84",
+"!+ c #B3CADC",
+"~+ c #313E49",
+"{+ c #A8C8E1",
+"]+ c #6B8DA6",
+"^+ c #728FA4",
+"/+ c #E2E1DD",
+"(+ c #F0EFEC",
+"_+ c #CDCAC6",
+":+ c #C2BFB9",
+"<+ c #CAC6C0",
+"[+ c #DCDAD7",
+"}+ c #4B555D",
+"|+ c #4E697F",
+"1+ c #BACCDC",
+"2+ c #A4C4DE",
+"3+ c #698BA3",
+"4+ c #708AA1",
+"5+ c #383E43",
+"6+ c #E0DEDA",
+"7+ c #514E46",
+"8+ c #4F4C44",
+"9+ c #C7C4BE",
+"0+ c #CBC8C2",
+"a+ c #E1E0DC",
+"b+ c #E9E8E6",
+"c+ c #475158",
+"d+ c #4E6879",
+"e+ c #4D6C80",
+"f+ c #A3C3DB",
+"g+ c #383F43",
+"h+ c #778999",
+"i+ c #6E899E",
+"j+ c #65859C",
+"k+ c #33383C",
+"l+ c #D7D4D0",
+"m+ c #D6D4D0",
+"n+ c #4E4A43",
+"o+ c #4D4942",
+"p+ c #D1CEC9",
+"q+ c #E6E5E2",
+"r+ c #EDECEA",
+"s+ c #454F55",
+"t+ c #486173",
+"u+ c #4D6678",
+"v+ c #A1C1DA",
+"w+ c #373C40",
+"x+ c #0C0D0F",
+"y+ c #4E5E6A",
+"z+ c #5B6E7C",
+"A+ c #4F5B62",
+"B+ c #A4A099",
+"C+ c #CCC9C3",
+"D+ c #D7D5D1",
+"E+ c #E4E2E0",
+"F+ c #DDDBD7",
+"G+ c #B8B5B0",
+"H+ c #3E474D",
+"I+ c #4A6176",
+"J+ c #4A6070",
+"K+ c #9BC3D8",
+"L+ c #363C41",
+"M+ c #28323E",
+" . . ",
+" . + @ . ",
+" . . . . . . . . . . . . . # $ % . . . ",
+" . & * = - ; > , ' ) ! ~ . { ] ^ . / ( _ . ",
+" . : < [ } | 1 2 3 4 5 . 6 7 8 . 9 0 a b . ",
+" . c d e f g h i j k . l m n . o p q r s . ",
+" . t u v w w w w x . y z A . B C D E F G . ",
+" . H I v w w w x . J K L . M N O P Q R S . ",
+" . T U v V C N . W X Y . Z ` ...+.v @.#.. ",
+" . $.%.&.w w *.. =.-.. M N D P *.w v @.;.. ",
+" . >.,.v w x . '.. . M N D P *.w w v ).!.. ",
+" . ~.{.v V ].. . ^./.(._...].C C :.v ).<.. ",
+" . [.}.|.w *.1.2.3.4.5.6.x w w w w v R 7.. ",
+" . 8.9.0.a.Q b.c.c.d.e.E v v v v f.g.h.i.. ",
+" . j.k.F R h.F l.m.F n.h.o.o.).p.q.R r.s.. ",
+" . t.u.v.w.x.y.z.A.B.C.D.E.F.z.G.H.I.J.K.. ",
+" . L.M.N.O.P.Q.R.S.S.T.Q.U.V.W.X.Y.Z.`. +. ",
+" . .+++ at +#+$+%+&+*+*+=+-+;+>+U.,+'+)+!+~+. ",
+" . {+]+^+#+/+(+&+*+*+_+:+;+<+[+}+|+)+1+~+. ",
+" . 2+3+4+5+6+S.7+8+8+9+;+0+a+b+c+d+e+f+g+. ",
+" . h+i+j+k+l+m+n+o+o+;+p+q+r+q+s+t+u+v+w+. ",
+" x+y+z+A+B+;+>+C+C+D+E+T.F+G+H+I+J+K+L+. ",
+" . . . . . . . . . . . . . . . . M+. ",
+" "};
+
static const char *new_xpm[] = {
"24 24 127 2",
" c None",
@@ -2547,6 +2840,7 @@ void make_toolbar_icons(Widget w)
XpmCreatePixmapFromData(dp, wn, (char **)redo_xpm, &toolbar_pixmaps[SND_XPM_REDO], &shape1, &attributes);
XpmCreatePixmapFromData(dp, wn, (char **)undo_xpm, &toolbar_pixmaps[SND_XPM_UNDO], &shape1, &attributes);
XpmCreatePixmapFromData(dp, wn, (char **)save_xpm, &toolbar_pixmaps[SND_XPM_SAVE], &shape1, &attributes);
+ XpmCreatePixmapFromData(dp, wn, (char **)saveas_xpm, &toolbar_pixmaps[SND_XPM_SAVE_AS], &shape1, &attributes);
XpmCreatePixmapFromData(dp, wn, (char **)new_xpm, &toolbar_pixmaps[SND_XPM_NEW], &shape1, &attributes);
XpmCreatePixmapFromData(dp, wn, (char **)open_xpm, &toolbar_pixmaps[SND_XPM_OPEN], &shape1, &attributes);
XpmCreatePixmapFromData(dp, wn, (char **)right_arrow_xpm, &toolbar_pixmaps[SND_XPM_NEXT], &shape1, &attributes);
@@ -2577,6 +2871,7 @@ Pixmap toolbar_icon(int which)
case SND_XPM_REDO: return(toolbar_pixmaps[SND_XPM_REDO]);
case SND_XPM_UNDO: return(toolbar_pixmaps[SND_XPM_UNDO]);
case SND_XPM_SAVE: return(toolbar_pixmaps[SND_XPM_SAVE]);
+ case SND_XPM_SAVE_AS: return(toolbar_pixmaps[SND_XPM_SAVE_AS]);
case SND_XPM_NEW: return(toolbar_pixmaps[SND_XPM_NEW]);
case SND_XPM_OPEN: return(toolbar_pixmaps[SND_XPM_OPEN]);
case SND_XPM_NEXT: return(toolbar_pixmaps[SND_XPM_NEXT]);
@@ -2593,6 +2888,7 @@ Pixmap toolbar_icon(int which)
return(None);
}
+#define NUM_BOMBS 15
void make_icons_transparent(const char *color)
{
@@ -2604,6 +2900,7 @@ void make_icons_transparent(const char *color)
bg1 = mus_format("- c %s s %s", color, color); /* the background color isn't known at compile time */
mini_lock_xpm[1] = bg1;
close_icon_xpm[1] = bg1;
+ stop_sign_xpm[1] = bg1;
blank_xpm[1] = bg1;
for (i = 0; i < NUM_BOMBS; i++)
{
@@ -2628,6 +2925,7 @@ void make_icons_transparent(const char *color)
redo_xpm[1] = bg4;
undo_xpm[1] = bg4;
save_xpm[1] = bg4;
+ saveas_xpm[1] = bg4;
new_xpm[1] = bg4;
open_xpm[1] = bg4;
right_arrow_xpm[1] = bg4;
@@ -2801,57 +3099,127 @@ static unsigned char speaker_data[709] = {
0104, 0256, 0102, 0140, 0202};
-/* /usr/share/icons/oxygen/16x16/actions/edit-bomb.png */
+/* /usr/share/icons/oxygen/16x16/status/dialog-warning.png */
-static unsigned char bomb_data[760] = {
+static unsigned char bomb_data[596] = {
0211, 0120, 0116, 0107, 0015, 0012, 0032, 0012, 0000, 0000, 0000, 0015, 0111, 0110, 0104, 0122,
0000, 0000, 0000, 0020, 0000, 0000, 0000, 0020, 0010, 0006, 0000, 0000, 0000, 0037, 0363, 0377,
- 0141, 0000, 0000, 0000, 0001, 0163, 0122, 0107, 0102, 0000, 0256, 0316, 0034, 0351, 0000, 0000,
- 0000, 0006, 0142, 0113, 0107, 0104, 0000, 0377, 0000, 0377, 0000, 0377, 0240, 0275, 0247, 0223,
- 0000, 0000, 0000, 0011, 0160, 0110, 0131, 0163, 0000, 0000, 0067, 0135, 0000, 0000, 0067, 0135,
- 0001, 0031, 0200, 0106, 0135, 0000, 0000, 0000, 0007, 0164, 0111, 0115, 0105, 0007, 0330, 0005,
- 0036, 0021, 0070, 0016, 0247, 0134, 0303, 0205, 0000, 0000, 0002, 0170, 0111, 0104, 0101, 0124,
- 0170, 0332, 0155, 0123, 0113, 0153, 0023, 0121, 0024, 0076, 0063, 0231, 0144, 0362, 0234, 0064,
- 0213, 0350, 0302, 0202, 0056, 0114, 0232, 0054, 0112, 0005, 0015, 0230, 0200, 0156, 0262, 0350,
- 0302, 0235, 0305, 0105, 0127, 0332, 0255, 0331, 0005, 0304, 0205, 0256, 0374, 0003, 0356, 0304,
- 0277, 0240, 0142, 0321, 0265, 0233, 0020, 0160, 0043, 0201, 0110, 0012, 0215, 0055, 0245, 0346,
- 0235, 0226, 0044, 0344, 0375, 0176, 0214, 0337, 0271, 0314, 0110, 0015, 0036, 0370, 0270, 0367,
- 0236, 0071, 0347, 0273, 0337, 0071, 0347, 0216, 0104, 0260, 0311, 0367, 0073, 0061, 0222, 0247,
- 0167, 0055, 0276, 0146, 0367, 0361, 0213, 0373, 0137, 0167, 0167, 0167, 0107, 0275, 0136, 0357,
- 0141, 0273, 0335, 0336, 0131, 0255, 0126, 0252, 0307, 0343, 0371, 0355, 0367, 0373, 0277, 0045,
- 0022, 0211, 0026, 0255, 0231, 0164, 0365, 0360, 0340, 0236, 0366, 0376, 0366, 0366, 0336, 0323,
- 0331, 0154, 0326, 0014, 0004, 0002, 0233, 0221, 0110, 0204, 0254, 0126, 0053, 0145, 0062, 0031,
- 0312, 0345, 0162, 0123, 0020, 0275, 0013, 0207, 0303, 0257, 0222, 0311, 0344, 0330, 0314, 0261,
- 0134, 0045, 0320, 0174, 0267, 0016, 0272, 0335, 0376, 0166, 0064, 0032, 0325, 0142, 0261, 0030,
- 0201, 0204, 0160, 0063, 0151, 0232, 0106, 0222, 0044, 0051, 0351, 0164, 0072, 0332, 0150, 0064,
- 0342, 0373, 0373, 0373, 0037, 0122, 0251, 0324, 0354, 0037, 0202, 0203, 0147, 0117, 0036, 0135,
- 0134, 0324, 0336, 0070, 0235, 0136, 0151, 0143, 0143, 0103, 0370, 0372, 0375, 0076, 0325, 0353,
- 0165, 0052, 0227, 0313, 0124, 0052, 0225, 0250, 0331, 0154, 0122, 0066, 0233, 0335, 0134, 0056,
- 0227, 0067, 0316, 0316, 0316, 0276, 0374, 0045, 0010, 0006, 0203, 0204, 0232, 0077, 0237, 0234,
- 0024, 0257, 0333, 0154, 0066, 0142, 0033, 0215, 0106, 0042, 0241, 0132, 0255, 0122, 0261, 0130,
- 0024, 0004, 0225, 0112, 0105, 0234, 0307, 0343, 0361, 0116, 0074, 0036, 0377, 0224, 0317, 0347,
- 0033, 0012, 0301, 0274, 0136, 0157, 0350, 0374, 0374, 0174, 0173, 0062, 0231, 0120, 0255, 0126,
- 0043, 0266, 0126, 0253, 0105, 0166, 0273, 0235, 0245, 0023, 0373, 0273, 0335, 0056, 0135, 0136,
- 0136, 0322, 0164, 0072, 0345, 0125, 0102, 0362, 0036, 0302, 0216, 0005, 0001, 0344, 0204, 0006,
- 0203, 0001, 0241, 0343, 0034, 0050, 0022, 0134, 0056, 0027, 0251, 0252, 0112, 0154, 0150, 0052,
- 0015, 0207, 0103, 0366, 0233, 0147, 0126, 0023, 0346, 0275, 0142, 0310, 0225, 0120, 0027, 0261,
- 0161, 0011, 0016, 0207, 0103, 0254, 0026, 0213, 0250, 0220, 0047, 0041, 0174, 0272, 0256, 0013,
- 0005, 0346, 0152, 0022, 0360, 0155, 0247, 0254, 0200, 0111, 0334, 0156, 0067, 0141, 0134, 0344,
- 0164, 0072, 0105, 0042, 0333, 0174, 0076, 0347, 0272, 0111, 0226, 0145, 0216, 0141, 0002, 0376,
- 0176, 0012, 0045, 0202, 0200, 0245, 0037, 0303, 0361, 0013, 0254, 0041, 0324, 0315, 0004, 0114,
- 0304, 0045, 0160, 0017, 0304, 0155, 0212, 0242, 0320, 0142, 0261, 0060, 0211, 0164, 0114, 0352,
- 0260, 0323, 0351, 0220, 0114, 0060, 0154, 0164, 0064, 0362, 0065, 0144, 0162, 0040, 0047, 0012,
- 0022, 0237, 0317, 0307, 0020, 0357, 0000, 0304, 0134, 0022, 0177, 0147, 0337, 0307, 0102, 0241,
- 0220, 0043, 0230, 0114, 0206, 0141, 0124, 0207, 0040, 0171, 0213, 0055, 0337, 0304, 0301, 0042,
- 0021, 0076, 0336, 0263, 0217, 0345, 0163, 0362, 0021, 0310, 0237, 0377, 0357, 0045, 0252, 0120,
- 0122, 0104, 0051, 0136, 0110, 0334, 0202, 0154, 0005, 0020, 0123, 0301, 0353, 0343, 0106, 0353,
- 0040, 0370, 0211, 0267, 0361, 0022, 0243, 0256, 0040, 0176, 0152, 0066, 0221, 0315, 0334, 0273,
- 0361, 0362, 0216, 0060, 0147, 0017, 0054, 0000, 0271, 0036, 0364, 0100, 0106, 0217, 0306, 0030,
- 0143, 0031, 0204, 0077, 0214, 0070, 0033, 0040, 0001, 0272, 0264, 0106, 0340, 0007, 0266, 0200,
- 0233, 0300, 0065, 0046, 0064, 0002, 0047, 0100, 0013, 0050, 0003, 0247, 0100, 0205, 0175, 0353,
- 0177, 0243, 0331, 0023, 0025, 0160, 0030, 0260, 0032, 0061, 0013, 0043, 0141, 0154, 0254, 0113,
- 0100, 0007, 0350, 0017, 0110, 0036, 0104, 0362, 0111, 0043, 0346, 0313, 0000, 0000, 0000, 0000,
- 0111, 0105, 0116, 0104, 0256, 0102, 0140, 0202};
+ 0141, 0000, 0000, 0000, 0004, 0163, 0102, 0111, 0124, 0010, 0010, 0010, 0010, 0174, 0010, 0144,
+ 0210, 0000, 0000, 0000, 0011, 0160, 0110, 0131, 0163, 0000, 0000, 0001, 0273, 0000, 0000, 0001,
+ 0273, 0001, 0072, 0354, 0343, 0342, 0000, 0000, 0000, 0031, 0164, 0105, 0130, 0164, 0123, 0157,
+ 0146, 0164, 0167, 0141, 0162, 0145, 0000, 0167, 0167, 0167, 0056, 0151, 0156, 0153, 0163, 0143,
+ 0141, 0160, 0145, 0056, 0157, 0162, 0147, 0233, 0356, 0074, 0032, 0000, 0000, 0001, 0321, 0111,
+ 0104, 0101, 0124, 0170, 0332, 0245, 0222, 0275, 0153, 0123, 0121, 0030, 0207, 0237, 0367, 0334,
+ 0357, 0336, 0336, 0174, 0124, 0323, 0350, 0140, 0205, 0024, 0127, 0035, 0072, 0166, 0120, 0212,
+ 0372, 0007, 0050, 0342, 0242, 0213, 0272, 0110, 0121, 0227, 0342, 0042, 0024, 0034, 0265, 0010,
+ 0132, 0024, 0104, 0161, 0322, 0105, 0161, 0020, 0203, 0330, 0072, 0364, 0057, 0350, 0052, 0124,
+ 0021, 0007, 0151, 0051, 0105, 0152, 0022, 0233, 0064, 0311, 0375, 0310, 0021, 0162, 0301, 0273,
+ 0330, 0264, 0322, 0007, 0176, 0160, 0016, 0234, 0363, 0360, 0173, 0017, 0107, 0264, 0326, 0354,
+ 0007, 0305, 0000, 0242, 0252, 0175, 0065, 0171, 0357, 0134, 0140, 0020, 0132, 0353, 0177, 0046,
+ 0136, 0264, 0056, 0106, 0213, 0247, 0172, 0321, 0322, 0071, 0335, 0135, 0260, 0056, 0355, 0164,
+ 0116, 0355, 0050, 0016, 0335, 0207, 0346, 0330, 0264, 0030, 0245, 0363, 0310, 0266, 0375, 0340,
+ 0277, 0106, 0350, 0175, 0062, 0246, 0305, 0077, 0163, 0010, 0303, 0100, 0014, 0120, 0301, 0311,
+ 0321, 0350, 0243, 0175, 0153, 0317, 0202, 0044, 0366, 0357, 0032, 0007, 0047, 0131, 0176, 0162,
+ 0237, 0345, 0247, 0217, 0120, 0205, 0343, 0350, 0330, 0234, 0335, 0223, 0040, 0136, 0260, 0356,
+ 0310, 0360, 0344, 0001, 0330, 0242, 0261, 0362, 0225, 0306, 0227, 0157, 0210, 0324, 0120, 0376,
+ 0211, 0221, 0360, 0203, 0065, 0273, 0273, 0040, 0011, 0156, 0033, 0305, 0012, 0260, 0206, 0243,
+ 0244, 0037, 0324, 0052, 0106, 0056, 0240, 0027, 0173, 0063, 0003, 0005, 0235, 0252, 0272, 0147,
+ 0004, 0225, 0234, 0030, 0353, 0140, 0156, 0342, 0005, 0171, 0374, 0221, 0121, 0160, 0132, 0210,
+ 0327, 0104, 0025, 0307, 0202, 0366, 0073, 0065, 0007, 0031, 0331, 0107, 0172, 0046, 0126, 0253,
+ 0350, 0066, 0206, 0216, 0046, 0236, 0130, 0021, 0030, 0360, 0375, 0125, 0011, 0235, 0204, 0214,
+ 0137, 0153, 0200, 0200, 0116, 0034, 0232, 0237, 0165, 0073, 0030, 0017, 0363, 0114, 0350, 0010,
+ 0300, 0204, 0224, 0346, 0220, 0074, 0066, 0013, 0256, 0047, 0371, 0072, 0230, 0364, 0123, 0271,
+ 0361, 0063, 0355, 0050, 0364, 0221, 0136, 0027, 0253, 0134, 0360, 0232, 0053, 0321, 0374, 0360,
+ 0004, 0327, 0263, 0006, 0057, 0305, 0157, 0164, 0162, 0265, 0334, 0124, 0333, 0022, 0067, 0112,
+ 0005, 0026, 0254, 0317, 0027, 0000, 0070, 0074, 0123, 0207, 0036, 0020, 0203, 0356, 0172, 0374,
+ 0256, 0112, 0324, 0361, 0266, 0213, 0345, 0313, 0272, 0245, 0000, 0032, 0165, 0136, 0330, 0025,
+ 0057, 0275, 0154, 0003, 0116, 0032, 0023, 0301, 0024, 0001, 0223, 0254, 0205, 0152, 0143, 0037,
+ 0013, 0054, 0267, 0306, 0363, 0277, 0043, 0164, 0327, 0230, 0012, 0316, 0006, 0151, 0335, 0170,
+ 0003, 0064, 0220, 0100, 0351, 0146, 0055, 0135, 0157, 0245, 0173, 0142, 0200, 0062, 0316, 0221,
+ 0074, 0315, 0245, 0315, 0323, 0331, 0033, 0030, 0352, 0355, 0257, 0067, 0077, 0256, 0204, 0253,
+ 0241, 0146, 0127, 0066, 0020, 0267, 0246, 0225, 0037, 0277, 0316, 0336, 0140, 0037, 0374, 0001,
+ 0075, 0255, 0302, 0111, 0346, 0040, 0215, 0173, 0000, 0000, 0000, 0000, 0111, 0105, 0116, 0104,
+ 0256, 0102, 0140, 0202};
+
+#if 0
+static unsigned char bomb_data_24[2010] = {
+ 0211, 0120, 0116, 0107, 0015, 0012, 0032, 0012, 0000, 0000, 0000, 0015, 0111, 0110, 0104, 0122,
+ 0000, 0000, 0000, 0030, 0000, 0000, 0000, 0030, 0010, 0006, 0000, 0000, 0000, 0340, 0167, 0075,
+ 0370, 0000, 0000, 0000, 0006, 0142, 0113, 0107, 0104, 0000, 0376, 0000, 0376, 0000, 0376, 0353,
+ 0030, 0324, 0202, 0000, 0000, 0000, 0011, 0160, 0110, 0131, 0163, 0000, 0000, 0015, 0326, 0000,
+ 0000, 0015, 0326, 0001, 0220, 0157, 0171, 0234, 0000, 0000, 0000, 0011, 0166, 0160, 0101, 0147,
+ 0000, 0000, 0000, 0030, 0000, 0000, 0000, 0030, 0000, 0170, 0114, 0245, 0246, 0000, 0000, 0003,
+ 0300, 0111, 0104, 0101, 0124, 0110, 0307, 0265, 0225, 0115, 0150, 0134, 0125, 0030, 0206, 0237,
+ 0163, 0316, 0235, 0073, 0223, 0073, 0223, 0111, 0234, 0144, 0222, 0114, 0046, 0115, 0310, 0044,
+ 0326, 0332, 0304, 0104, 0353, 0137, 0301, 0126, 0254, 0165, 0241, 0124, 0020, 0225, 0210, 0240,
+ 0304, 0240, 0050, 0126, 0011, 0052, 0102, 0177, 0124, 0064, 0320, 0215, 0202, 0042, 0245, 0324,
+ 0212, 0340, 0312, 0215, 0210, 0113, 0105, 0167, 0041, 0065, 0125, 0101, 0233, 0022, 0321, 0032,
+ 0264, 0155, 0114, 0332, 0116, 0232, 0304, 0114, 0376, 0347, 0357, 0336, 0173, 0216, 0213, 0321,
+ 0272, 0150, 0143, 0223, 0246, 0276, 0360, 0155, 0316, 0371, 0316, 0373, 0234, 0157, 0361, 0361,
+ 0302, 0377, 0054, 0261, 0332, 0306, 0305, 0327, 0354, 0267, 0254, 0326, 0235, 0373, 0105, 0054,
+ 0045, 0374, 0343, 0037, 0017, 0073, 0052, 0277, 0125, 0364, 0241, 0257, 0311, 0057, 0262, 0173,
+ 0150, 0310, 0176, 0270, 0075, 0357, 0215, 0016, 0030, 0357, 0217, 0101, 0223, 0373, 0254, 0247,
+ 0260, 0264, 0227, 0047, 0127, 0363, 0126, 0256, 0246, 0311, 0267, 0043, 0357, 0132, 0167, 0074,
+ 0153, 0233, 0314, 0050, 0172, 0154, 0220, 0300, 0315, 0217, 0333, 0204, 0052, 0336, 0067, 0175,
+ 0330, 0353, 0006, 0054, 0354, 0341, 0006, 0253, 0345, 0236, 0207, 0125, 0174, 0223, 0320, 0323,
+ 0043, 0230, 0205, 0064, 0040, 0260, 0266, 0164, 0127, 0054, 0144, 0171, 0141, 0335, 0000, 0023,
+ 0212, 0036, 0016, 0334, 0332, 0035, 0320, 0027, 0176, 0102, 0140, 0020, 0001, 0007, 0075, 0376,
+ 0035, 0126, 0373, 0043, 0001, 0053, 0022, 0077, 0060, 0325, 0107, 0344, 0252, 0001, 0363, 0373,
+ 0270, 0335, 0112, 0335, 0273, 0215, 0160, 0134, 0350, 0364, 0020, 0262, 0152, 0003, 0252, 0261,
+ 0003, 0063, 0067, 0016, 0113, 0223, 0310, 0055, 0117, 0205, 0354, 0054, 0373, 0256, 0032, 0340,
+ 0212, 0350, 0021, 0273, 0375, 0041, 0133, 0217, 0035, 0003, 0343, 0041, 0343, 0315, 0210, 0362,
+ 0132, 0104, 0044, 0206, 0177, 0246, 0237, 0100, 0152, 0273, 0245, 0303, 0211, 0127, 0027, 0173,
+ 0211, 0257, 0031, 0060, 0371, 0012, 0367, 0251, 0226, 0273, 0333, 0261, 0202, 0102, 0247, 0117,
+ 0240, 0152, 0132, 0110, 0117, 0057, 0060, 0236, 0276, 0200, 0111, 0154, 0306, 0054, 0116, 0140,
+ 0376, 0374, 0015, 0273, 0363, 0261, 0300, 0262, 0342, 0300, 0232, 0000, 0006, 0204, 0253, 0312,
+ 0217, 0224, 0155, 0334, 0021, 0324, 0243, 0003, 0010, 0051, 0220, 0325, 0115, 0034, 0376, 0364,
+ 0033, 0366, 0037, 0374, 0002, 0337, 0166, 0020, 0225, 0011, 0374, 0321, 0243, 0330, 0311, 0016,
+ 0245, 0243, 0015, 0075, 0351, 0027, 0151, 0132, 0065, 0140, 0274, 0227, 0107, 0355, 0346, 0255,
+ 0015, 0322, 0270, 0350, 0311, 0223, 0310, 0344, 0046, 0060, 0105, 0052, 0034, 0211, 0205, 0117,
+ 0110, 0272, 0130, 0015, 0155, 0230, 0334, 0014, 0146, 0342, 0004, 0221, 0366, 0373, 0255, 0274,
+ 0340, 0275, 0125, 0001, 0114, 0027, 0312, 0227, 0341, 0203, 0221, 0324, 0155, 0041, 0075, 0172,
+ 0024, 0031, 0014, 0042, 0143, 0365, 0030, 0057, 0107, 0165, 0104, 0022, 0055, 0023, 0030, 0057,
+ 0017, 0266, 0215, 0214, 0067, 0241, 0307, 0276, 0045, 0024, 0333, 0240, 0144, 0064, 0271, 0353,
+ 0324, 0363, 0264, 0137, 0021, 0060, 0122, 0311, 0323, 0201, 0144, 0147, 0114, 0345, 0147, 0321,
+ 0063, 0247, 0120, 0015, 0067, 0202, 0237, 0003, 0057, 0107, 0074, 0252, 0210, 0072, 0200, 0237,
+ 0005, 0157, 0031, 0225, 0110, 0141, 0346, 0307, 0361, 0177, 0377, 0232, 0150, 0343, 0346, 0240,
+ 0147, 0070, 0364, 0237, 0200, 0321, 0036, 0102, 0332, 0262, 0337, 0216, 0065, 0156, 0014, 0351,
+ 0261, 0143, 0310, 0160, 0024, 0121, 0131, 0005, 0136, 0016, 0274, 0045, 0232, 0253, 0064, 0101,
+ 0177, 0036, 0226, 0322, 0260, 0174, 0036, 0241, 0263, 0250, 0372, 0024, 0372, 0334, 0017, 0070,
+ 0321, 0353, 0204, 0050, 0253, 0272, 0363, 0347, 0147, 0270, 0153, 0105, 0300, 0054, 0274, 0344,
+ 0324, 0266, 0224, 0311, 0345, 0363, 0230, 0271, 0061, 0124, 0175, 0013, 0046, 0077, 0003, 0271,
+ 0111, 0130, 0236, 0244, 0055, 0141, 0330, 0275, 0253, 0261, 0064, 0221, 0357, 0202, 0056, 0042,
+ 0233, 0072, 0020, 0226, 0205, 0116, 0017, 0021, 0157, 0155, 0013, 0271, 0206, 0017, 0056, 0013,
+ 0370, 0361, 0071, 0052, 0214, 0120, 0157, 0124, 0045, 0022, 0145, 0346, 0354, 0367, 0210, 0110,
+ 0024, 0021, 0166, 0300, 0315, 0142, 0274, 0074, 0106, 0027, 0171, 0140, 0357, 0127, 0354, 0170,
+ 0371, 0113, 0062, 0163, 0113, 0030, 0135, 0304, 0150, 0027, 0041, 0101, 0065, 0167, 0142, 0062,
+ 0247, 0161, 0202, 0122, 0250, 0160, 0374, 0372, 0343, 0335, 0074, 0170, 0011, 0300, 0313, 0362,
+ 0172, 0171, 0115, 0062, 0020, 0130, 0236, 0300, 0024, 0027, 0261, 0122, 0067, 0201, 0166, 0057,
+ 0226, 0361, 0135, 0026, 0263, 0245, 0362, 0375, 0142, 0351, 0334, 0057, 0335, 0251, 0144, 0053,
+ 0042, 0350, 0240, 0047, 0117, 0122, 0337, 0324, 0130, 0346, 0032, 0016, 0231, 0276, 0222, 0267,
+ 0005, 0320, 0337, 0105, 0235, 0207, 0352, 0255, 0253, 0213, 0005, 0165, 0346, 0127, 0144, 0145,
+ 0015, 0302, 0011, 0227, 0114, 0204, 0004, 0041, 0021, 0010, 0372, 0337, 0331, 0106, 0321, 0323,
+ 0070, 0101, 0001, 0176, 0261, 0264, 0061, 0106, 0203, 0321, 0310, 0144, 0053, 0376, 0351, 0141,
+ 0302, 0221, 0070, 0301, 0362, 0130, 0315, 0340, 0110, 0346, 0011, 0340, 0023, 0013, 0300, 0207,
+ 0335, 0065, 0261, 0162, 0151, 0025, 0146, 0060, 0136, 0001, 0075, 0073, 0105, 0141, 0340, 0363,
+ 0313, 0156, 0246, 0002, 0012, 0254, 0054, 0263, 0220, 0046, 0131, 0023, 0166, 0176, 0231, 0311,
+ 0274, 0171, 0021, 0260, 0120, 0040, 0222, 0020, 0312, 0106, 0052, 0104, 0105, 0003, 0030, 0303,
+ 0125, 0113, 0052, 0334, 0371, 0002, 0256, 0056, 0145, 0205, 0005, 0060, 0064, 0305, 0200, 0045,
+ 0147, 0272, 0306, 0317, 0146, 0352, 0244, 0224, 0172, 0015, 0111, 0172, 0351, 0004, 0332, 0107,
+ 0033, 0123, 0030, 0236, 0346, 0043, 0370, 0327, 0251, 0072, 0000, 0055, 0267, 0324, 0022, 0227,
+ 0152, 0035, 0356, 0177, 0153, 0044, 0303, 0374, 0134, 0236, 0163, 0300, 0231, 0177, 0314, 0002,
+ 0100, 0045, 0134, 0071, 0002, 0127, 0051, 0037, 0230, 0007, 0162, 0327, 0310, 0157, 0145, 0375,
+ 0005, 0324, 0210, 0175, 0376, 0216, 0127, 0307, 0103, 0000, 0000, 0000, 0045, 0164, 0105, 0130,
+ 0164, 0144, 0141, 0164, 0145, 0072, 0143, 0162, 0145, 0141, 0164, 0145, 0000, 0062, 0060, 0060,
+ 0071, 0055, 0061, 0061, 0055, 0062, 0063, 0124, 0061, 0065, 0072, 0065, 0067, 0072, 0061, 0071,
+ 0053, 0060, 0061, 0072, 0060, 0060, 0362, 0065, 0257, 0206, 0000, 0000, 0000, 0045, 0164, 0105,
+ 0130, 0164, 0144, 0141, 0164, 0145, 0072, 0155, 0157, 0144, 0151, 0146, 0171, 0000, 0062, 0060,
+ 0060, 0071, 0055, 0061, 0061, 0055, 0062, 0063, 0124, 0061, 0065, 0072, 0065, 0067, 0072, 0061,
+ 0071, 0053, 0060, 0061, 0072, 0060, 0060, 0203, 0150, 0027, 0072, 0000, 0000, 0000, 0031, 0164,
+ 0105, 0130, 0164, 0123, 0157, 0146, 0164, 0167, 0141, 0162, 0145, 0000, 0167, 0167, 0167, 0056,
+ 0151, 0156, 0153, 0163, 0143, 0141, 0160, 0145, 0056, 0157, 0162, 0147, 0233, 0356, 0074, 0032,
+ 0000, 0000, 0000, 0000, 0111, 0105, 0116, 0104, 0256, 0102, 0140, 0202};
+#endif
/* /usr/share/icons/gnome/16x16/actions/go-next.png */
diff --git a/snd-gxcolormaps.c b/snd-gxcolormaps.c
index 41bdbec..333216b 100644
--- a/snd-gxcolormaps.c
+++ b/snd-gxcolormaps.c
@@ -4,16 +4,16 @@ typedef struct {
int size;
char *name;
rgb_t *r, *g, *b;
- XEN lambda;
+ Xen lambda;
int gc_loc;
- mus_float_t **(*make_rgb)(int size, XEN func);
+ mus_float_t **(*make_rgb)(int size, Xen func);
void (*get_rgb)(float x, rgb_t *r, rgb_t *g, rgb_t *b);
} cmap;
static cmap **cmaps = NULL;
static int cmaps_size = 0;
-#define NO_SUCH_COLORMAP XEN_ERROR_TYPE("no-such-colormap")
+#define NO_SUCH_COLORMAP Xen_make_error_type("no-such-colormap")
bool is_colormap(int n)
@@ -52,7 +52,7 @@ static cmap *delete_cmap(int index)
if (c->g) free(c->g);
if (c->b) free(c->b);
if (c->name) free(c->name);
- if (XEN_PROCEDURE_P(c->lambda))
+ if (Xen_is_procedure(c->lambda))
snd_unprotect_at(c->gc_loc);
free(c);
cmaps[index] = NULL;
@@ -67,7 +67,7 @@ static rgb_t *mus_float_ts_to_rgb_t(int size, mus_float_t *data)
rgb_t *new_data;
new_data = (rgb_t *)calloc(size, sizeof(rgb_t));
for (i = 0; i < size; i++)
- new_data[i] = FLOAT_TO_RGB(data[i]);
+ new_data[i] = float_to_rgb(data[i]);
return(new_data);
}
@@ -113,7 +113,7 @@ void get_current_color(int index, int n, rgb_t *r, rgb_t *g, rgb_t *b)
}
}
-
+#if HAVE_GL
rgb_t *color_map_reds(int index)
{
if (is_colormap(index))
@@ -157,7 +157,7 @@ rgb_t *color_map_blues(int index)
}
return(NULL);
}
-
+#endif
static cmap *new_cmap(const char *name, int size, mus_float_t **rgb)
@@ -172,20 +172,20 @@ static cmap *new_cmap(const char *name, int size, mus_float_t **rgb)
c->g = mus_float_ts_to_rgb_t(size, rgb[1]);
c->b = mus_float_ts_to_rgb_t(size, rgb[2]);
}
- c->lambda = XEN_FALSE;
+ c->lambda = Xen_false;
c->gc_loc = NOT_A_GC_LOC;
return(c);
}
static cmap *make_builtin_cmap(int size, const char *name,
- mus_float_t **(*make_rgb)(int size, XEN ignored),
+ mus_float_t **(*make_rgb)(int size, Xen ignored),
void (*get_rgb)(float x, rgb_t *r, rgb_t *g, rgb_t *b))
{
mus_float_t **rgb = NULL;
cmap *c = NULL;
if ((make_rgb) && (!get_rgb))
- rgb = make_rgb(size, XEN_FALSE);
+ rgb = make_rgb(size, Xen_false);
c = new_cmap(name, size, rgb);
c->get_rgb = get_rgb;
c->make_rgb = make_rgb;
@@ -219,64 +219,68 @@ static void add_colormap_func_error(const char *msg, void *data)
}
-static mus_float_t **make_xen_colormap(int size, XEN lambda)
+static mus_float_t **make_xen_colormap(int size, Xen lambda)
{
- XEN xrgb;
+ Xen xrgb;
mus_float_t **rgb = NULL;
add_colormap_func_hit_error = false;
redirect_xen_error_to(add_colormap_func_error, NULL);
- xrgb = XEN_CALL_1(lambda,
- C_TO_XEN_INT(size),
+ xrgb = Xen_call_with_1_arg(lambda,
+ C_int_to_Xen_integer(size),
S_add_colormap);
redirect_xen_error_to(NULL, NULL);
if (add_colormap_func_hit_error)
{
- XEN str;
+ Xen str;
if (add_colormap_func_error_msg)
{
- str = C_TO_XEN_STRING(add_colormap_func_error_msg);
+ str = C_string_to_Xen_string(add_colormap_func_error_msg);
free(add_colormap_func_error_msg);
add_colormap_func_error_msg = NULL;
}
- else str = XEN_FALSE;
+ else str = Xen_false;
- XEN_ERROR(XEN_ERROR_TYPE("colormap-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_add_colormap ": function error ~A"),
+ Xen_error(Xen_make_error_type("colormap-error"),
+ Xen_list_2(C_string_to_Xen_string(S_add_colormap ": function error ~A"),
str));
}
- if (!(XEN_LIST_P(xrgb)))
- XEN_ERROR(XEN_ERROR_TYPE("colormap-error"),
- XEN_LIST_3(C_TO_XEN_STRING(S_add_colormap ": colormap function, ~A, returned ~A, but should return a list of 3 vcts"),
+ if (!(Xen_is_list(xrgb)))
+ Xen_error(Xen_make_error_type("colormap-error"),
+ Xen_list_3(C_string_to_Xen_string(S_add_colormap ": colormap function, ~A, returned ~A, but should return a list of 3 " S_vct "s"),
lambda,
xrgb));
else
{
vct *xr, *xg, *xb;
+ mus_float_t *xrdata, *xgdata, *xbdata;
int i, gc_loc;
/* user-defined colormap func returns a list of 3 vcts (r g b) */
gc_loc = snd_protect(xrgb);
- if (!(mus_vct_p(XEN_LIST_REF(xrgb, 0))))
- XEN_ERROR(XEN_ERROR_TYPE("colormap-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_add_colormap ": function did not return a list of vcts! ~A"),
+ if (!(mus_is_vct(Xen_list_ref(xrgb, 0))))
+ Xen_error(Xen_make_error_type("colormap-error"),
+ Xen_list_2(C_string_to_Xen_string(S_add_colormap ": function did not return a list of " S_vct "s! ~A"),
xrgb));
- xr = XEN_TO_VCT(XEN_LIST_REF(xrgb, 0));
- if (xr->length < size)
- XEN_ERROR(XEN_ERROR_TYPE("colormap-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_add_colormap ": function did not return a list of vcts of the correct size: ~A"),
+ xr = Xen_to_vct(Xen_list_ref(xrgb, 0));
+ xrdata = mus_vct_data(xr);
+ if (mus_vct_length(xr) < size)
+ Xen_error(Xen_make_error_type("colormap-error"),
+ Xen_list_2(C_string_to_Xen_string(S_add_colormap ": function did not return a list of " S_vct "s of the correct size: ~A"),
xrgb));
- xg = XEN_TO_VCT(XEN_LIST_REF(xrgb, 1));
- xb = XEN_TO_VCT(XEN_LIST_REF(xrgb, 2));
+ xg = Xen_to_vct(Xen_list_ref(xrgb, 1));
+ xgdata = mus_vct_data(xg);
+ xb = Xen_to_vct(Xen_list_ref(xrgb, 2));
+ xbdata = mus_vct_data(xb);
rgb = make_base_rgb(size);
for (i = 0; i < size; i++)
{
- rgb[0][i] = xr->data[i];
- rgb[1][i] = xg->data[i];
- rgb[2][i] = xb->data[i];
+ rgb[0][i] = xrdata[i];
+ rgb[1][i] = xgdata[i];
+ rgb[2][i] = xbdata[i];
}
snd_unprotect_at(gc_loc);
@@ -285,7 +289,7 @@ static mus_float_t **make_xen_colormap(int size, XEN lambda)
}
-static int add_colormap(const char *name, XEN func)
+static int add_colormap(const char *name, Xen func)
{
cmap *c;
mus_float_t **rgb;
@@ -316,7 +320,7 @@ static int add_colormap(const char *name, XEN func)
}
-static mus_float_t **make_black_and_white_colormap(int size, XEN ignored)
+static mus_float_t **make_black_and_white_colormap(int size, Xen ignored)
{
/* (r 0) (g 0) (b 0) */
return(make_base_rgb(size));
@@ -337,7 +341,7 @@ static void black_and_white_rgb(float n, rgb_t *r, rgb_t *g, rgb_t *b)
/* colormap functions taken mostly from (GPL) octave-forge code written by Kai Habel <kai.habel at gmx.de> */
-static mus_float_t **make_gray_colormap(int size, XEN ignored)
+static mus_float_t **make_gray_colormap(int size, Xen ignored)
{
/* (r x) (g x) (b x) */
mus_float_t **rgb;
@@ -367,7 +371,7 @@ static void gray_rgb(float n, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_autumn_colormap(int size, XEN ignored)
+static mus_float_t **make_autumn_colormap(int size, Xen ignored)
{
/* (r 1.0) (g x) (b 0.0) */
mus_float_t **rgb;
@@ -397,7 +401,7 @@ static void autumn_rgb(float n, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_spring_colormap(int size, XEN ignored)
+static mus_float_t **make_spring_colormap(int size, Xen ignored)
{
/* (r 1.0) (g x) (b (- 1.0 x)) */
mus_float_t **rgb;
@@ -427,7 +431,7 @@ static void spring_rgb(float n, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_winter_colormap(int size, XEN ignored)
+static mus_float_t **make_winter_colormap(int size, Xen ignored)
{
/* (r 0.0) (g x) (b (- 1.0 (/ x 2))) */
mus_float_t **rgb;
@@ -457,7 +461,7 @@ static void winter_rgb(float n, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_summer_colormap(int size, XEN ignored)
+static mus_float_t **make_summer_colormap(int size, Xen ignored)
{
/* (r x) (g (+ 0.5 (/ x 2))) (b 0.4) */
mus_float_t **rgb;
@@ -487,7 +491,7 @@ static void summer_rgb(float n, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_cool_colormap(int size, XEN ignored)
+static mus_float_t **make_cool_colormap(int size, Xen ignored)
{
/* (r x) (g (- 1.0 x)) (b 1.0) */
mus_float_t **rgb;
@@ -517,7 +521,7 @@ static void cool_rgb(float n, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_copper_colormap(int size, XEN ignored)
+static mus_float_t **make_copper_colormap(int size, Xen ignored)
{
/* (r (if (< x 4/5) (* 5/4 x) 1.0)) (g (* 4/5 x)) (b (* 1/2 x)) */
mus_float_t **rgb;
@@ -547,7 +551,7 @@ static void copper_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_flag_colormap(int size, XEN ignored)
+static mus_float_t **make_flag_colormap(int size, Xen ignored)
{
/* (r (if (or (= k 0) (= k 1)) 1.0 0.0)) (g (if (= k 1) 1.0 0.0)) (b (if (or (= k 1) (= k 2)) 1.0 0.0)) */
mus_float_t **rgb;
@@ -579,7 +583,7 @@ static void flag_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_prism_colormap(int size, XEN ignored)
+static mus_float_t **make_prism_colormap(int size, Xen ignored)
{
/* (r (list-ref (list 1 1 1 0 0 2/3) k)) (g (list-ref (list 0 1/2 1 1 0 0) k)) (b (list-ref (list 0 0 0 0 1 1) k)) */
mus_float_t **rgb;
@@ -604,10 +608,11 @@ static mus_float_t **make_prism_colormap(int size, XEN ignored)
static void prism_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
{
int k;
- k = ((int)(x * color_map_size(ss))) % 6;
mus_float_t rs[6] = {1.0, 1.0, 1.0, 0.0, 0.0, 0.6667};
mus_float_t gs[6] = {0.0, 0.5, 1.0, 1.0, 0.0, 0.0};
mus_float_t bs[6] = {0.0, 0.0, 0.0, 0.0, 1.0, 1.0};
+
+ k = ((int)(x * color_map_size(ss))) % 6;
(*r) = rs[k];
(*g) = gs[k];
(*b) = bs[k];
@@ -617,7 +622,7 @@ static void prism_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_bone_colormap(int size, XEN ignored)
+static mus_float_t **make_bone_colormap(int size, Xen ignored)
{
/* (r (if (< x 3/4) (* 7/8 x) (- (* 11/8 x) 3/8)))
(g (if (< x 3/8) (* 7/8 x) (if (< x 3/4) (- (* 29/24 x) 1/8) (+ (* 7/8 x) 1/8))))
@@ -650,7 +655,7 @@ static void bone_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_hot_colormap(int size, XEN ignored)
+static mus_float_t **make_hot_colormap(int size, Xen ignored)
{
/* (mimicking matlab here, not octave)
(r (if (< x 3/8) (* 8/3 x) 1.0))
@@ -684,7 +689,7 @@ static void hot_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_jet_colormap(int size, XEN ignored)
+static mus_float_t **make_jet_colormap(int size, Xen ignored)
{
/*
(r (if (< x 3/8) 0.0 (if (< x 5/8) (- (* 4 x) 3/2) (if (< x 7/8) 1.0 (+ (* -4 x) 9/2)))))
@@ -718,7 +723,7 @@ static void jet_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_pink_colormap(int size, XEN ignored)
+static mus_float_t **make_pink_colormap(int size, Xen ignored)
{
/* matlab uses log here, or something like that -- this version is quite different
(r (if (< x 3/8) (* 14/9 x) (+ (* 2/3 x) 1/3)))
@@ -752,7 +757,7 @@ static void pink_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_rainbow_colormap(int size, XEN ignored)
+static mus_float_t **make_rainbow_colormap(int size, Xen ignored)
{
/*
(r (if (< x 2/5) 1.0 (if (< x 3/5) (+ (* -5 x) 3) (if (< x 4/5) 0.0 (- (* 10/3 x) 8/3)))))
@@ -786,7 +791,7 @@ static void rainbow_rgb(float x, rgb_t *r, rgb_t *g, rgb_t *b)
#endif
-static mus_float_t **make_phases_colormap(int size, XEN ignored)
+static mus_float_t **make_phases_colormap(int size, Xen ignored)
{
/* 0 and pi: blue->green, pi/2 and 3pi/2: red->black */
mus_float_t **rgb;
@@ -879,57 +884,55 @@ typedef struct {
} xen_colormap;
-#define XEN_TO_XEN_COLORMAP(arg) ((xen_colormap *)XEN_OBJECT_REF(arg))
+#define Xen_to_xen_colormap(arg) ((xen_colormap *)Xen_object_ref(arg))
-static int xen_colormap_to_int(XEN n)
+static int xen_colormap_to_int(Xen n)
{
xen_colormap *col;
- col = XEN_TO_XEN_COLORMAP(n);
+ col = Xen_to_xen_colormap(n);
return(col->n);
}
-#define XEN_COLORMAP_TO_C_INT(n) xen_colormap_to_int(n)
+#define Xen_colormap_to_C_int(n) xen_colormap_to_int(n)
-static XEN_OBJECT_TYPE xen_colormap_tag;
+static Xen_object_type_t xen_colormap_tag;
-static bool xen_colormap_p(XEN obj)
+static bool xen_is_colormap(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, xen_colormap_tag));
+ return(Xen_c_object_is_type(obj, xen_colormap_tag));
}
-#define XEN_COLORMAP_P(Obj) xen_colormap_p(Obj)
-
static void xen_colormap_free(xen_colormap *v) {if (v) free(v);}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(xen_colormap, free_xen_colormap, xen_colormap_free)
+Xen_wrap_free(xen_colormap, free_xen_colormap, xen_colormap_free)
static char *xen_colormap_to_string(xen_colormap *v)
{
- #define XEN_COLORMAP_PRINT_BUFFER_SIZE 64
+ #define COLORMAP_PRINT_BUFFER_SIZE 64
char *buf;
if (v == NULL) return(NULL);
- buf = (char *)calloc(XEN_COLORMAP_PRINT_BUFFER_SIZE, sizeof(char));
- snprintf(buf, XEN_COLORMAP_PRINT_BUFFER_SIZE, "#<colormap %s>", colormap_name(v->n));
+ buf = (char *)calloc(COLORMAP_PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, COLORMAP_PRINT_BUFFER_SIZE, "#<colormap %s>", colormap_name(v->n));
return(buf);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(xen_colormap, print_xen_colormap, xen_colormap_to_string)
+Xen_wrap_print(xen_colormap, print_xen_colormap, xen_colormap_to_string)
#if HAVE_FORTH || HAVE_RUBY
-static XEN g_xen_colormap_to_string(XEN obj)
+static Xen g_xen_colormap_to_string(Xen obj)
{
char *vstr;
- XEN result;
+ Xen result;
#define S_xen_colormap_to_string "colormap->string"
- XEN_ASSERT_TYPE(XEN_COLORMAP_P(obj), obj, XEN_ONLY_ARG, S_xen_colormap_to_string, "a colormap");
+ Xen_check_type(xen_is_colormap(obj), obj, 1, S_xen_colormap_to_string, "a colormap");
- vstr = xen_colormap_to_string(XEN_TO_XEN_COLORMAP(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = xen_colormap_to_string(Xen_to_xen_colormap(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
@@ -943,10 +946,10 @@ static bool xen_colormap_equalp(xen_colormap *v1, xen_colormap *v2)
(v1->n == v2->n));
}
-static XEN equalp_xen_colormap(XEN obj1, XEN obj2)
+static Xen equalp_xen_colormap(Xen obj1, Xen obj2)
{
- if ((!(XEN_COLORMAP_P(obj1))) || (!(XEN_COLORMAP_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(xen_colormap_equalp(XEN_TO_XEN_COLORMAP(obj1), XEN_TO_XEN_COLORMAP(obj2))));
+ if ((!(xen_is_colormap(obj1))) || (!(xen_is_colormap(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(xen_colormap_equalp(Xen_to_xen_colormap(obj1), Xen_to_xen_colormap(obj2))));
}
#endif
@@ -960,17 +963,17 @@ static xen_colormap *xen_colormap_make(int n)
}
-static XEN new_xen_colormap(int n)
+static Xen new_xen_colormap(int n)
{
xen_colormap *mx;
if (n < 0)
- return(XEN_FALSE);
+ return(Xen_false);
mx = xen_colormap_make(n);
- XEN_MAKE_AND_RETURN_OBJECT(xen_colormap_tag, mx, 0, free_xen_colormap);
+ return(Xen_make_object(xen_colormap_tag, mx, 0, free_xen_colormap));
}
-#define C_INT_TO_XEN_COLORMAP(Val) new_xen_colormap(Val)
+#define C_int_to_Xen_colormap(Val) new_xen_colormap(Val)
#if HAVE_SCHEME
@@ -981,16 +984,16 @@ static bool s7_xen_colormap_equalp(void *obj1, void *obj2)
}
-static XEN s7_xen_colormap_length(s7_scheme *sc, XEN obj)
+static Xen s7_xen_colormap_length(s7_scheme *sc, Xen obj)
{
- return(C_TO_XEN_INT(color_map_size(ss)));
+ return(C_int_to_Xen_integer(color_map_size(ss)));
}
-static XEN g_colormap_ref(XEN map, XEN pos);
-static XEN s7_colormap_apply(s7_scheme *sc, XEN obj, XEN args)
+static Xen g_colormap_ref(Xen map, Xen pos);
+static Xen s7_colormap_apply(s7_scheme *sc, Xen obj, Xen args)
{
- return(g_colormap_ref(obj, XEN_CAR(args)));
+ return(g_colormap_ref(obj, Xen_car(args)));
}
#endif
@@ -998,13 +1001,13 @@ static XEN s7_colormap_apply(s7_scheme *sc, XEN obj, XEN args)
static void init_xen_colormap(void)
{
#if HAVE_SCHEME
- xen_colormap_tag = XEN_MAKE_OBJECT_TYPE("<colormap>", print_xen_colormap, free_xen_colormap, s7_xen_colormap_equalp,
- NULL, s7_colormap_apply, NULL, s7_xen_colormap_length, NULL, NULL);
+ xen_colormap_tag = s7_new_type_x(s7, "<colormap>", print_xen_colormap, free_xen_colormap, s7_xen_colormap_equalp,
+ NULL, s7_colormap_apply, NULL, s7_xen_colormap_length, NULL, NULL, NULL);
#else
#if HAVE_RUBY
- xen_colormap_tag = XEN_MAKE_OBJECT_TYPE("XenColormap", sizeof(xen_colormap));
+ xen_colormap_tag = Xen_make_object_type("XenColormap", sizeof(xen_colormap));
#else
- xen_colormap_tag = XEN_MAKE_OBJECT_TYPE("Colormap", sizeof(xen_colormap));
+ xen_colormap_tag = Xen_make_object_type("Colormap", sizeof(xen_colormap));
#endif
#endif
@@ -1016,34 +1019,34 @@ static void init_xen_colormap(void)
#endif
#if HAVE_RUBY
- rb_define_method(xen_colormap_tag, "to_s", XEN_PROCEDURE_CAST print_xen_colormap, 0);
- rb_define_method(xen_colormap_tag, "eql?", XEN_PROCEDURE_CAST equalp_xen_colormap, 1);
- rb_define_method(xen_colormap_tag, "==", XEN_PROCEDURE_CAST equalp_xen_colormap, 1);
- rb_define_method(xen_colormap_tag, "to_str", XEN_PROCEDURE_CAST g_xen_colormap_to_string, 0);
+ rb_define_method(xen_colormap_tag, "to_s", Xen_procedure_cast print_xen_colormap, 0);
+ rb_define_method(xen_colormap_tag, "eql?", Xen_procedure_cast equalp_xen_colormap, 1);
+ rb_define_method(xen_colormap_tag, "==", Xen_procedure_cast equalp_xen_colormap, 1);
+ rb_define_method(xen_colormap_tag, "to_str", Xen_procedure_cast g_xen_colormap_to_string, 0);
#endif
}
/* -------------------------------------------------------------------------------- */
-static XEN g_integer_to_colormap(XEN n)
+static Xen g_integer_to_colormap(Xen n)
{
#define H_integer_to_colormap "(" S_integer_to_colormap " n) returns a colormap object corresponding to the given integer"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n), n, XEN_ONLY_ARG, S_integer_to_colormap, "an integer");
- return(new_xen_colormap(XEN_TO_C_INT(n)));
+ Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_colormap, "an integer");
+ return(new_xen_colormap(Xen_integer_to_C_int(n)));
}
-static XEN g_colormap_to_integer(XEN n)
+static Xen g_colormap_to_integer(Xen n)
{
#define H_colormap_to_integer "(" S_colormap_to_integer " id) returns the integer corresponding to the given colormap"
- XEN_ASSERT_TYPE(XEN_COLORMAP_P(n), n, XEN_ONLY_ARG, S_colormap_to_integer, "a colormap");
- return(C_TO_XEN_INT(xen_colormap_to_int(n)));
+ Xen_check_type(xen_is_colormap(n), n, 1, S_colormap_to_integer, "a colormap");
+ return(C_int_to_Xen_integer(xen_colormap_to_int(n)));
}
-static XEN g_colormap_ref(XEN map, XEN pos)
+static Xen g_colormap_ref(Xen map, Xen pos)
{
int index;
mus_float_t x;
@@ -1051,44 +1054,44 @@ static XEN g_colormap_ref(XEN map, XEN pos)
#define H_colormap_ref "(" S_colormap_ref " colormap pos): (list r g b). Pos is between 0.0 and 1.0."
- XEN_ASSERT_TYPE(XEN_COLORMAP_P(map), map, XEN_ARG_1, S_colormap_ref, "a colormap object");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(pos), pos, XEN_ARG_2, S_colormap_ref, "a number between 0.0 and 1.0");
+ Xen_check_type(xen_is_colormap(map), map, 1, S_colormap_ref, "a colormap object");
+ Xen_check_type(Xen_is_number(pos), pos, 2, S_colormap_ref, "a number between 0.0 and 1.0");
- index = XEN_COLORMAP_TO_C_INT(map);
+ index = Xen_colormap_to_C_int(map);
if (!(is_colormap(index)))
- XEN_ERROR(NO_SUCH_COLORMAP,
- XEN_LIST_2(C_TO_XEN_STRING(S_colormap_ref ": no such colormap: ~A"),
+ Xen_error(NO_SUCH_COLORMAP,
+ Xen_list_2(C_string_to_Xen_string(S_colormap_ref ": no such colormap: ~A"),
map));
- x = XEN_TO_C_DOUBLE(pos);
+ x = Xen_real_to_C_double(pos);
if ((x < 0.0) || (x > 1.0))
- XEN_OUT_OF_RANGE_ERROR(S_colormap_ref, 2, pos, "x must be between 0.0 and 1.0: ~A");
+ Xen_out_of_range_error(S_colormap_ref, 2, pos, "x must be between 0.0 and 1.0");
get_current_color(index, (int)(color_map_size(ss) * x + 0.5), &r, &g, &b);
- return(XEN_LIST_3(C_TO_XEN_DOUBLE(RGB_TO_FLOAT(r)),
- C_TO_XEN_DOUBLE(RGB_TO_FLOAT(g)),
- C_TO_XEN_DOUBLE(RGB_TO_FLOAT(b))));
+ return(Xen_list_3(C_double_to_Xen_real(rgb_to_float(r)),
+ C_double_to_Xen_real(rgb_to_float(g)),
+ C_double_to_Xen_real(rgb_to_float(b))));
}
/* can't use Colormap -- it's the X type name */
-static XEN g_colormap(void)
+static Xen g_colormap(void)
{
#define H_colormap "(" S_colormap "): current colormap choice."
- return(C_INT_TO_XEN_COLORMAP(color_map(ss)));
+ return(C_int_to_Xen_colormap(color_map(ss)));
}
-static XEN g_set_colormap(XEN val)
+static Xen g_set_colormap(Xen val)
{
int index;
- XEN_ASSERT_TYPE(XEN_COLORMAP_P(val), val, XEN_ONLY_ARG, S_setB S_colormap, "a colormap");
+ Xen_check_type(xen_is_colormap(val), val, 1, S_set S_colormap, "a colormap");
- index = XEN_COLORMAP_TO_C_INT(val);
+ index = Xen_colormap_to_C_int(val);
if (!(is_colormap(index)))
- XEN_ERROR(NO_SUCH_COLORMAP,
- XEN_LIST_2(C_TO_XEN_STRING(S_colormap ": no such colormap: ~A"),
+ Xen_error(NO_SUCH_COLORMAP,
+ Xen_list_2(C_string_to_Xen_string(S_colormap ": no such colormap: ~A"),
val));
set_color_map(index); /* this normally redisplays */
@@ -1096,64 +1099,64 @@ static XEN g_set_colormap(XEN val)
}
-static XEN g_colormap_size(void) {return(C_TO_XEN_INT(color_map_size(ss)));}
+static Xen g_colormap_size(void) {return(C_int_to_Xen_integer(color_map_size(ss)));}
-static XEN g_set_colormap_size(XEN val)
+static Xen g_set_colormap_size(Xen val)
{
int size;
#define H_colormap_size "(" S_colormap_size "): current colormap size; default is 512."
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_colormap_size, "an integer");
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_colormap_size, "an integer");
- size = XEN_TO_C_INT(val);
+ size = Xen_integer_to_C_int(val);
if (size < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_colormap_size, 1, val, "size ~A < 0?");
+ Xen_out_of_range_error(S_set S_colormap_size, 1, val, "size < 0?");
if (size > (1 << 26))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_colormap_size, 1, val, "size ~A too large");
+ Xen_out_of_range_error(S_set S_colormap_size, 1, val, "size too large");
set_color_map_size(size);
check_colormap_sizes(color_map_size(ss));
- return(C_TO_XEN_INT(color_map_size(ss)));
+ return(C_int_to_Xen_integer(color_map_size(ss)));
}
-static XEN g_colormap_name(XEN col)
+static Xen g_colormap_name(Xen col)
{
int map;
#define H_colormap_name "(" S_colormap_name " colormap) returns the colormap's name (used in the Color/Orientation dialog)."
- XEN_ASSERT_TYPE(XEN_COLORMAP_P(col), col, XEN_ONLY_ARG, S_colormap_name, "a colormap");
+ Xen_check_type(xen_is_colormap(col), col, 1, S_colormap_name, "a colormap");
- map = XEN_COLORMAP_TO_C_INT(col);
+ map = Xen_colormap_to_C_int(col);
if (!(is_colormap(map)))
- XEN_ERROR(NO_SUCH_COLORMAP,
- XEN_LIST_2(C_TO_XEN_STRING(S_colormap_name ": no such colormap: ~A"),
+ Xen_error(NO_SUCH_COLORMAP,
+ Xen_list_2(C_string_to_Xen_string(S_colormap_name ": no such colormap: ~A"),
col));
- return(C_TO_XEN_STRING(cmaps[map]->name));
+ return(C_string_to_Xen_string(cmaps[map]->name));
}
-static XEN g_colormap_p(XEN obj)
+static Xen g_is_colormap(Xen obj)
{
- #define H_colormap_p "(" S_colormap_p " obj) -> " PROC_TRUE " if 'obj' is a colormap."
- return(C_TO_XEN_BOOLEAN(XEN_COLORMAP_P(obj) &&
- is_colormap(XEN_COLORMAP_TO_C_INT(obj))));
+ #define H_is_colormap "(" S_is_colormap " obj) -> " PROC_TRUE " if 'obj' is a colormap."
+ return(C_bool_to_Xen_boolean(xen_is_colormap(obj) &&
+ is_colormap(Xen_colormap_to_C_int(obj))));
}
-static XEN g_delete_colormap(XEN col)
+static Xen g_delete_colormap(Xen col)
{
int map;
#define H_delete_colormap "(" S_delete_colormap " colormap) frees the specified colormap."
- XEN_ASSERT_TYPE(XEN_COLORMAP_P(col), col, XEN_ONLY_ARG, S_delete_colormap, "a colormap");
+ Xen_check_type(xen_is_colormap(col), col, 1, S_delete_colormap, "a colormap");
- map = XEN_COLORMAP_TO_C_INT(col);
+ map = Xen_colormap_to_C_int(col);
if (!(is_colormap(map)))
- XEN_ERROR(NO_SUCH_COLORMAP,
- XEN_LIST_2(C_TO_XEN_STRING(S_delete_colormap ": no such colormap: ~A"),
+ Xen_error(NO_SUCH_COLORMAP,
+ Xen_list_2(C_string_to_Xen_string(S_delete_colormap ": no such colormap: ~A"),
col));
delete_cmap(map);
@@ -1166,55 +1169,46 @@ static XEN g_delete_colormap(XEN col)
#include "clm2xen.h"
-static XEN g_add_colormap(XEN name, XEN func)
+static Xen g_add_colormap(Xen name, Xen func)
{
int index;
#define H_add_colormap "(" S_add_colormap " name func) adds the colormap created by func to the colormap table, \
returning the new colormap. 'name' is the colormap's name in the View:Color/Orientation dialog."
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, S_add_colormap, "a string");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(func) && (!mus_xen_p(func)), func, XEN_ARG_2, S_add_colormap, "a function of 2 args");
+ Xen_check_type(Xen_is_string(name), name, 1, S_add_colormap, "a string");
+ Xen_check_type(Xen_is_procedure(func) && (!mus_is_xen(func)), func, 2, S_add_colormap, "a function of 2 args");
if (!(procedure_arity_ok(func, 1)))
return(snd_bad_arity_error(S_add_colormap,
- C_TO_XEN_STRING("func should take 1 arg"),
+ C_string_to_Xen_string("func should take 1 arg"),
func));
- index = add_colormap(XEN_TO_C_STRING(name), func);
+ index = add_colormap(Xen_string_to_C_string(name), func);
reflect_color_list(false);
- return(C_INT_TO_XEN_COLORMAP(index));
+ return(C_int_to_Xen_colormap(index));
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_2(g_colormap_ref_w, g_colormap_ref)
-XEN_NARGIFY_0(g_colormap_w, g_colormap)
-XEN_NARGIFY_1(g_colormap_p_w, g_colormap_p)
-XEN_NARGIFY_1(g_set_colormap_w, g_set_colormap)
-XEN_NARGIFY_0(g_colormap_size_w, g_colormap_size)
-XEN_NARGIFY_1(g_set_colormap_size_w, g_set_colormap_size)
-XEN_NARGIFY_1(g_colormap_name_w, g_colormap_name)
-XEN_NARGIFY_1(g_delete_colormap_w, g_delete_colormap)
-XEN_NARGIFY_2(g_add_colormap_w, g_add_colormap)
-XEN_NARGIFY_1(g_integer_to_colormap_w, g_integer_to_colormap)
-XEN_NARGIFY_1(g_colormap_to_integer_w, g_colormap_to_integer)
-#else
-#define g_colormap_ref_w g_colormap_ref
-#define g_colormap_w g_colormap
-#define g_colormap_p_w g_colormap_p
-#define g_set_colormap_w g_set_colormap
-#define g_colormap_size_w g_colormap_size
-#define g_set_colormap_size_w g_set_colormap_size
-#define g_colormap_name_w g_colormap_name
-#define g_delete_colormap_w g_delete_colormap
-#define g_add_colormap_w g_add_colormap
-#define g_integer_to_colormap_w g_integer_to_colormap
-#define g_colormap_to_integer_w g_colormap_to_integer
+Xen_wrap_2_args(g_colormap_ref_w, g_colormap_ref)
+Xen_wrap_no_args(g_colormap_w, g_colormap)
+Xen_wrap_1_arg(g_is_colormap_w, g_is_colormap)
+Xen_wrap_1_arg(g_set_colormap_w, g_set_colormap)
+Xen_wrap_no_args(g_colormap_size_w, g_colormap_size)
+Xen_wrap_1_arg(g_set_colormap_size_w, g_set_colormap_size)
+Xen_wrap_1_arg(g_colormap_name_w, g_colormap_name)
+Xen_wrap_1_arg(g_delete_colormap_w, g_delete_colormap)
+Xen_wrap_2_args(g_add_colormap_w, g_add_colormap)
+Xen_wrap_1_arg(g_integer_to_colormap_w, g_integer_to_colormap)
+Xen_wrap_1_arg(g_colormap_to_integer_w, g_colormap_to_integer)
+
+#if HAVE_SCHEME
+static s7_pointer acc_colormap(s7_scheme *sc, s7_pointer args) {return(g_set_colormap(s7_cadr(args)));}
+static s7_pointer acc_colormap_size(s7_scheme *sc, s7_pointer args) {return(g_set_colormap_size(s7_cadr(args)));}
#endif
#if (!HAVE_SCHEME)
-static XEN colormap_temp[16]; /* static for Ruby's sake */
+static Xen colormap_temp[16]; /* static for Ruby's sake */
#endif
void g_init_gxcolormaps(void)
@@ -1242,50 +1236,58 @@ void g_init_gxcolormaps(void)
cmaps[PHASES_COLORMAP] = make_builtin_cmap(1, "phases", make_phases_colormap, phases_rgb);
#if HAVE_SCHEME
- s7_define_constant(s7, "black-and-white-colormap", C_INT_TO_XEN_COLORMAP(0));
- s7_define_constant(s7, "gray-colormap", C_INT_TO_XEN_COLORMAP(1));
- s7_define_constant(s7, "hot-colormap", C_INT_TO_XEN_COLORMAP(2));
- s7_define_constant(s7, "cool-colormap", C_INT_TO_XEN_COLORMAP(3));
- s7_define_constant(s7, "bone-colormap", C_INT_TO_XEN_COLORMAP(4));
- s7_define_constant(s7, "copper-colormap", C_INT_TO_XEN_COLORMAP(5));
- s7_define_constant(s7, "pink-colormap", C_INT_TO_XEN_COLORMAP(6));
- s7_define_constant(s7, "jet-colormap", C_INT_TO_XEN_COLORMAP(7));
- s7_define_constant(s7, "prism-colormap", C_INT_TO_XEN_COLORMAP(8));
- s7_define_constant(s7, "autumn-colormap", C_INT_TO_XEN_COLORMAP(9));
- s7_define_constant(s7, "winter-colormap", C_INT_TO_XEN_COLORMAP(10));
- s7_define_constant(s7, "spring-colormap", C_INT_TO_XEN_COLORMAP(11));
- s7_define_constant(s7, "summer-colormap", C_INT_TO_XEN_COLORMAP(12));
- s7_define_constant(s7, "rainbow-colormap", C_INT_TO_XEN_COLORMAP(13));
- s7_define_constant(s7, "flag-colormap", C_INT_TO_XEN_COLORMAP(14));
- s7_define_constant(s7, "phases-colormap", C_INT_TO_XEN_COLORMAP(15));
+ s7_define_constant(s7, "black-and-white-colormap", C_int_to_Xen_colormap(0));
+ s7_define_constant(s7, "gray-colormap", C_int_to_Xen_colormap(1));
+ s7_define_constant(s7, "hot-colormap", C_int_to_Xen_colormap(2));
+ s7_define_constant(s7, "cool-colormap", C_int_to_Xen_colormap(3));
+ s7_define_constant(s7, "bone-colormap", C_int_to_Xen_colormap(4));
+ s7_define_constant(s7, "copper-colormap", C_int_to_Xen_colormap(5));
+ s7_define_constant(s7, "pink-colormap", C_int_to_Xen_colormap(6));
+ s7_define_constant(s7, "jet-colormap", C_int_to_Xen_colormap(7));
+ s7_define_constant(s7, "prism-colormap", C_int_to_Xen_colormap(8));
+ s7_define_constant(s7, "autumn-colormap", C_int_to_Xen_colormap(9));
+ s7_define_constant(s7, "winter-colormap", C_int_to_Xen_colormap(10));
+ s7_define_constant(s7, "spring-colormap", C_int_to_Xen_colormap(11));
+ s7_define_constant(s7, "summer-colormap", C_int_to_Xen_colormap(12));
+ s7_define_constant(s7, "rainbow-colormap", C_int_to_Xen_colormap(13));
+ s7_define_constant(s7, "flag-colormap", C_int_to_Xen_colormap(14));
+ s7_define_constant(s7, "phases-colormap", C_int_to_Xen_colormap(15));
#else
- XEN_DEFINE_VARIABLE("black-and-white-colormap", colormap_temp[0], C_INT_TO_XEN_COLORMAP(0));
- XEN_DEFINE_VARIABLE("gray-colormap", colormap_temp[1], C_INT_TO_XEN_COLORMAP(1));
- XEN_DEFINE_VARIABLE("hot-colormap", colormap_temp[2], C_INT_TO_XEN_COLORMAP(2));
- XEN_DEFINE_VARIABLE("cool-colormap", colormap_temp[3], C_INT_TO_XEN_COLORMAP(3));
- XEN_DEFINE_VARIABLE("bone-colormap", colormap_temp[4], C_INT_TO_XEN_COLORMAP(4));
- XEN_DEFINE_VARIABLE("copper-colormap", colormap_temp[5], C_INT_TO_XEN_COLORMAP(5));
- XEN_DEFINE_VARIABLE("pink-colormap", colormap_temp[6], C_INT_TO_XEN_COLORMAP(6));
- XEN_DEFINE_VARIABLE("jet-colormap", colormap_temp[7], C_INT_TO_XEN_COLORMAP(7));
- XEN_DEFINE_VARIABLE("prism-colormap", colormap_temp[8], C_INT_TO_XEN_COLORMAP(8));
- XEN_DEFINE_VARIABLE("autumn-colormap", colormap_temp[9], C_INT_TO_XEN_COLORMAP(9));
- XEN_DEFINE_VARIABLE("winter-colormap", colormap_temp[10], C_INT_TO_XEN_COLORMAP(10));
- XEN_DEFINE_VARIABLE("spring-colormap", colormap_temp[11], C_INT_TO_XEN_COLORMAP(11));
- XEN_DEFINE_VARIABLE("summer-colormap", colormap_temp[12], C_INT_TO_XEN_COLORMAP(12));
- XEN_DEFINE_VARIABLE("rainbow-colormap", colormap_temp[13], C_INT_TO_XEN_COLORMAP(13));
- XEN_DEFINE_VARIABLE("flag-colormap", colormap_temp[14], C_INT_TO_XEN_COLORMAP(14));
- XEN_DEFINE_VARIABLE("phases-colormap", colormap_temp[15], C_INT_TO_XEN_COLORMAP(15));
+ Xen_define_variable("black-and-white-colormap", colormap_temp[0], C_int_to_Xen_colormap(0));
+ Xen_define_variable("gray-colormap", colormap_temp[1], C_int_to_Xen_colormap(1));
+ Xen_define_variable("hot-colormap", colormap_temp[2], C_int_to_Xen_colormap(2));
+ Xen_define_variable("cool-colormap", colormap_temp[3], C_int_to_Xen_colormap(3));
+ Xen_define_variable("bone-colormap", colormap_temp[4], C_int_to_Xen_colormap(4));
+ Xen_define_variable("copper-colormap", colormap_temp[5], C_int_to_Xen_colormap(5));
+ Xen_define_variable("pink-colormap", colormap_temp[6], C_int_to_Xen_colormap(6));
+ Xen_define_variable("jet-colormap", colormap_temp[7], C_int_to_Xen_colormap(7));
+ Xen_define_variable("prism-colormap", colormap_temp[8], C_int_to_Xen_colormap(8));
+ Xen_define_variable("autumn-colormap", colormap_temp[9], C_int_to_Xen_colormap(9));
+ Xen_define_variable("winter-colormap", colormap_temp[10], C_int_to_Xen_colormap(10));
+ Xen_define_variable("spring-colormap", colormap_temp[11], C_int_to_Xen_colormap(11));
+ Xen_define_variable("summer-colormap", colormap_temp[12], C_int_to_Xen_colormap(12));
+ Xen_define_variable("rainbow-colormap", colormap_temp[13], C_int_to_Xen_colormap(13));
+ Xen_define_variable("flag-colormap", colormap_temp[14], C_int_to_Xen_colormap(14));
+ Xen_define_variable("phases-colormap", colormap_temp[15], C_int_to_Xen_colormap(15));
#endif
- XEN_DEFINE_PROCEDURE(S_colormap_p, g_colormap_p_w, 1, 0, 0, H_colormap_p);
- XEN_DEFINE_PROCEDURE(S_colormap_ref, g_colormap_ref_w, 2, 0, 0, H_colormap_ref);
- XEN_DEFINE_PROCEDURE(S_add_colormap, g_add_colormap_w, 2, 0, 0, H_add_colormap);
- XEN_DEFINE_PROCEDURE(S_colormap_name, g_colormap_name_w, 1, 0, 0, H_colormap_name);
- XEN_DEFINE_PROCEDURE(S_delete_colormap, g_delete_colormap_w, 1, 0, 0, H_delete_colormap);
+ Xen_define_safe_procedure(S_is_colormap, g_is_colormap_w, 1, 0, 0, H_is_colormap);
+ Xen_define_safe_procedure(S_colormap_ref, g_colormap_ref_w, 2, 0, 0, H_colormap_ref);
+ Xen_define_safe_procedure(S_add_colormap, g_add_colormap_w, 2, 0, 0, H_add_colormap);
+ Xen_define_safe_procedure(S_colormap_name, g_colormap_name_w, 1, 0, 0, H_colormap_name);
+ Xen_define_safe_procedure(S_delete_colormap, g_delete_colormap_w, 1, 0, 0, H_delete_colormap);
+
+ Xen_define_dilambda(S_colormap, g_colormap_w, H_colormap, S_set S_colormap, g_set_colormap_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_colormap_size, g_colormap_size_w, H_colormap_size, S_set S_colormap_size, g_set_colormap_size_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_colormap, g_colormap_w, H_colormap, S_setB S_colormap, g_set_colormap_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_colormap_size, g_colormap_size_w, H_colormap_size, S_setB S_colormap_size, g_set_colormap_size_w, 0, 0, 1, 0);
+ Xen_define_safe_procedure(S_integer_to_colormap, g_integer_to_colormap_w, 1, 0, 0, H_integer_to_colormap);
+ Xen_define_safe_procedure(S_colormap_to_integer, g_colormap_to_integer_w, 1, 0, 0, H_colormap_to_integer);
- XEN_DEFINE_PROCEDURE(S_integer_to_colormap, g_integer_to_colormap_w, 1, 0, 0, H_integer_to_colormap);
- XEN_DEFINE_PROCEDURE(S_colormap_to_integer, g_colormap_to_integer_w, 1, 0, 0, H_colormap_to_integer);
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->color_map_size_symbol, s7_make_function(s7, "[acc-" S_colormap_size "]", acc_colormap_size, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->color_map_symbol, s7_make_function(s7, "[acc-" S_colormap "]", acc_colormap, 2, 0, false, "accessor"));
+
+ s7_symbol_set_documentation(s7, ss->color_map_size_symbol, "*colormap-size*: current colormap size; default is 512.");
+ s7_symbol_set_documentation(s7, ss->color_map_symbol, "*colormap*: current colormap choice.");
+#endif
}
diff --git a/snd-help.c b/snd-help.c
index 0084417..a69aabb 100644
--- a/snd-help.c
+++ b/snd-help.c
@@ -27,7 +27,7 @@ static char *snd_itoa(int n)
}
}
str = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
- mus_snprintf(str, LABEL_BUFFER_SIZE, "%d", n);
+ snprintf(str, LABEL_BUFFER_SIZE, "%d", n);
snd_itoa_strs[snd_itoa_ctr++] = str;
return(str);
}
@@ -46,40 +46,6 @@ static void free_snd_itoa(void)
}
-static char *format_to_name(int bits)
-{
- if (bits == 4)
- return(mus_strdup("float"));
- if (bits == 8)
- return(mus_strdup("double"));
- return(mus_format("int%d", bits));
-}
-
-
-static char *sndlib_consistency_check(void)
-{
- /* sizeof is not usable in this context, unfortunately; bits/bytes jumbled together here */
- int sndlib_bits, snd_bits;
- sndlib_bits = mus_sample_bits();
-#if SNDLIB_USE_FLOATS
- snd_bits = mus_bytes_per_sample(MUS_OUT_FORMAT);
-#else
- snd_bits = MUS_SAMPLE_BITS;
-#endif
- if (snd_bits != sndlib_bits)
- {
- char *snd_name, *sndlib_name, *val;
- snd_name = format_to_name(snd_bits);
- sndlib_name = format_to_name(sndlib_bits);
- val = mus_format(" Snd expects %s samples, but sndlib uses %s!", snd_name, sndlib_name);
- free(snd_name);
- free(sndlib_name);
- return(val);
- }
- return(NULL);
-}
-
-
static char *vstrcat(const char *arg1, ...)
{
char *buf;
@@ -109,11 +75,10 @@ static const char *main_snd_xrefs[16] = {
"{Forth}: extension language",
"{s7}: extension language",
"{Emacs}: Snd as Emacs subjob",
- "{Libxm}: graphics module",
"{Sndlib}: underlying sound support library",
- "{Scripting}: Snd as scripting language",
- "{Motif}: Motif extensions via Libxm",
- "{Gtk}: Gtk extensions via Libxm",
+ "{Scripting}: Snd with no GUI",
+ "{Motif}: Motif extensions",
+ "{Gtk}: Gtk extensions",
"{Ladspa}: plugins",
"{Multiprecision arithmetic}: libgmp and friends",
NULL
@@ -127,7 +92,6 @@ static const char *main_snd_xref_urls[16] = {
"grfsnd.html#sndandforth",
"grfsnd.html#sndands7",
"grfsnd.html#emacssnd",
- "libxm.html#xm",
"sndlib.html#introduction",
"grfsnd.html#sndwithnogui",
"grfsnd.html#sndwithmotif",
@@ -155,11 +119,7 @@ static void main_snd_help(const char *subject, ...)
#include <X11/xpm.h>
#endif
-#if HAVE_GNU_LIBC_VERSION_H
- #include <gnu/libc-version.h>
-#endif
-
-#if HAVE_LADSPA && HAVE_DLFCN_H && HAVE_DIRENT_H
+#if HAVE_LADSPA
#include <ladspa.h>
#endif
@@ -181,45 +141,45 @@ static void main_snd_help(const char *subject, ...)
static char *xm_version(void)
{
- XEN xm_val = XEN_FALSE;
+ Xen xm_val = Xen_false;
#if HAVE_SCHEME
#if USE_MOTIF
- xm_val = XEN_EVAL_C_STRING("(and (defined? 'xm-version) xm-version)");
+ xm_val = Xen_eval_C_string("(and (defined? 'xm-version) xm-version)");
#else
#if USE_GTK
- xm_val = XEN_EVAL_C_STRING("(and (defined? 'xg-version) xg-version)");
+ xm_val = Xen_eval_C_string("(and (defined? 'xg-version) xg-version)");
#endif
#endif
#endif
#if HAVE_FORTH
- xm_val = XEN_VARIABLE_REF(XM_VERSION_NAME);
+ xm_val = Xen_variable_ref(XM_VERSION_NAME);
#endif
#if HAVE_RUBY
#if USE_MOTIF
if (rb_const_defined(rb_cObject, rb_intern("Xm_Version")))
- xm_val = XEN_EVAL_C_STRING("Xm_Version");
+ xm_val = Xen_eval_C_string("Xm_Version");
#else
#if USE_GTK
if (rb_const_defined(rb_cObject, rb_intern("Xg_Version")))
- xm_val = XEN_EVAL_C_STRING("Xg_Version");
+ xm_val = Xen_eval_C_string("Xg_Version");
#endif
#endif
#endif
- if (XEN_STRING_P(xm_val))
+ if (Xen_is_string(xm_val))
{
char *version = NULL;
version = (char *)calloc(32, sizeof(char));
- mus_snprintf(version, 32, "\n %s: %s",
+ snprintf(version, 32, "\n %s: %s",
#if USE_MOTIF
"xm",
#else
"xg",
#endif
- XEN_TO_C_STRING(xm_val));
+ Xen_string_to_C_string(xm_val));
if (snd_itoa_ctr < snd_itoa_size) snd_itoa_strs[snd_itoa_ctr++] = version;
return(version);
}
@@ -228,36 +188,32 @@ static char *xm_version(void)
#if HAVE_GL
-#if (!JUST_GL)
- void Init_libgl(void);
-#endif
+void Init_libgl(void);
+
static char *gl_version(void)
{
- XEN gl_val = XEN_FALSE;
-
-#if (!JUST_GL)
+ Xen gl_val = Xen_false;
Init_libgl(); /* define the version string, if ./snd --version */
-#endif
#if HAVE_SCHEME
- gl_val = XEN_EVAL_C_STRING("(and (provided? 'gl) gl-version)"); /* this refers to gl.c, not the GL library */
+ gl_val = Xen_eval_C_string("(and (provided? 'gl) gl-version)"); /* this refers to gl.c, not the GL library */
#endif
#if HAVE_RUBY
if (rb_const_defined(rb_cObject, rb_intern("Gl_Version")))
- gl_val = XEN_EVAL_C_STRING("Gl_Version");
+ gl_val = Xen_eval_C_string("Gl_Version");
#endif
#if HAVE_FORTH
if (fth_provided_p("gl"))
- gl_val = XEN_VARIABLE_REF("gl-version");
+ gl_val = Xen_variable_ref("gl-version");
#endif
- if (XEN_STRING_P(gl_val))
+ if (Xen_is_string(gl_val))
{
char *version = NULL;
version = (char *)calloc(32, sizeof(char));
- mus_snprintf(version, 32, " (snd gl: %s)", XEN_TO_C_STRING(gl_val));
+ snprintf(version, 32, " (snd gl: %s)", Xen_string_to_C_string(gl_val));
if (snd_itoa_ctr < snd_itoa_size) snd_itoa_strs[snd_itoa_ctr++] = version;
return(version);
}
@@ -271,55 +227,57 @@ static char *gl_version(void)
static char *glx_version(void)
{
+#if USE_MOTIF
#define VERSION_SIZE 128
- int major = 0, minor = 0;
- char *version;
+ char *version = NULL;
+
+ if ((ss->dialogs == NULL) || /* snd --help for example */
+ (MAIN_DISPLAY(ss) == NULL))
+ return(mus_strdup(" "));
+
version = (char *)calloc(VERSION_SIZE, sizeof(char));
- if (ss->dialogs == NULL) /* snd --help for example */
+ if (ss->cx)
{
-#if HAVE_X
- /* Mesa has version.h with all the info we want at compile time, but insists on hiding it! */
- /* so we go to the trouble of creating a context... */
- int glAttribs[] = {GLX_DOUBLEBUFFER, GLX_RGBA, GLX_DEPTH_SIZE, 1, None};
- Display *dpy;
- XVisualInfo *visInfo;
- int scrn;
- Window win;
- GLXContext glCtx;
- dpy = XOpenDisplay(NULL);
- if (!dpy) return(mus_strdup(" "));
- scrn = DefaultScreen(dpy);
- visInfo = glXChooseVisual(dpy, scrn, glAttribs);
- if (!visInfo) return(mus_strdup(" "));
- glCtx = glXCreateContext(dpy, visInfo, 0, True);
- if (!glCtx) return(mus_strdup(" "));
- win = XCreateSimpleWindow(dpy, RootWindow(dpy, scrn), 0, 0, 1, 1, 0, 0, 0);
- glXMakeCurrent(dpy, win, glCtx);
- mus_snprintf(version, VERSION_SIZE, " %s", glGetString(GL_VERSION));
- return(version);
-#else
- return(mus_strdup(" "));
-#endif
+ glXMakeCurrent(MAIN_DISPLAY(ss), XtWindow(ss->mainshell), ss->cx);
+ snprintf(version, VERSION_SIZE, " %s", glGetString(GL_VERSION));
}
-
- if (MAIN_DISPLAY(ss) != NULL)
+ else
{
- if (ss->cx)
- {
- glXMakeCurrent(MAIN_DISPLAY(ss), XtWindow(ss->mainshell), ss->cx);
- mus_snprintf(version, VERSION_SIZE, " %s", glGetString(GL_VERSION));
- }
- else
- {
- glXQueryVersion(MAIN_DISPLAY(ss), &major, &minor);
- mus_snprintf(version, VERSION_SIZE, " %d.%d", major, minor);
- }
+ int major = 0, minor = 0;
+ glXQueryVersion(MAIN_DISPLAY(ss), &major, &minor);
+ snprintf(version, VERSION_SIZE, " %d.%d", major, minor);
}
if (snd_itoa_ctr < snd_itoa_size) snd_itoa_strs[snd_itoa_ctr++] = version;
return(version);
+#else
+#if USE_GTK && (0)
+ /* TODO: need to gdk_gl_context_make_current then gdk_gl_context_get_version or better gtk_gl_area_make_current
+ */
+ #define VERSION_SIZE 128
+ char *version = NULL;
+ int major, minor;
+
+ if ((ss->dialogs == NULL) || (MAIN_DISPLAY(ss) == NULL)) /* TODO: MAIN_DISPLAY needs to be the gl context here (it's not otherwise used in gtk snd) */
+ return(mus_strdup(" "));
+
+ version = (char *)calloc(VERSION_SIZE, sizeof(char));
+ gdk_gl_context_get_version(MAIN_DISPLAY(ss), &major, &minor);
+ snprintf(version, VERSION_SIZE, " %d.%d", major, minor);
+ if (snd_itoa_ctr < snd_itoa_size) snd_itoa_strs[snd_itoa_ctr++] = version;
+ return(version);
+#else
+ return(mus_strdup(" "));
+#endif
+#endif
}
#endif
+#if HAVE_GSL
+ #include <gsl/gsl_version.h>
+#endif
+#ifndef _MSC_VER
+ #include <sys/utsname.h>
+#endif
char *version_info(void)
{
@@ -327,9 +285,13 @@ char *version_info(void)
#if HAVE_GL && WITH_GL2PS
char *gl2ps_name = NULL;
#endif
+#ifndef _MSC_VER
+ int uname_ok;
+ struct utsname uts;
+ uname_ok = uname(&uts); /* 0=success */
+#endif
snd_itoa_ctr = 0;
xversion = xen_version();
- consistent = sndlib_consistency_check();
result = vstrcat(
"This is Snd version ",
SND_VERSION,
@@ -341,33 +303,20 @@ char *version_info(void)
"\n Sndlib ", snd_itoa(SNDLIB_VERSION), ".",
snd_itoa(SNDLIB_REVISION),
" (", SNDLIB_DATE,
-#if SNDLIB_USE_FLOATS
- ", ", (sizeof(mus_sample_t) == sizeof(float)) ? "float" : "double", " samples",
-#else
- ", int", snd_itoa(MUS_SAMPLE_BITS), " samples",
-#endif
-#if HAVE_PTHREADS
- ", with threads",
-#endif
")",
- (consistent) ? consistent : "",
"\n CLM ", snd_itoa(MUS_VERSION), ".",
snd_itoa(MUS_REVISION), " (",
MUS_DATE, ")",
#if HAVE_GSL
- "\n GSL",
- #ifdef MUS_GSL_VERSION
- " ", MUS_GSL_VERSION,
+ "\n GSL",
+ #ifdef GSL_VERSION
+ " ", GSL_VERSION,
#endif
#endif
#if HAVE_FFTW3
"\n ", fftw_version,
#endif
#if USE_MOTIF
- #ifdef LESSTIF_VERSION
- "\n Lesstif ", snd_itoa(LESSTIF_VERSION), ".",
- snd_itoa(LESSTIF_REVISION), " ",
- #endif
"\n Motif ", snd_itoa(XmVERSION), ".",
snd_itoa(XmREVISION), ".",
snd_itoa(XmUPDATE_LEVEL),
@@ -381,11 +330,15 @@ char *version_info(void)
", Glib ", snd_itoa(GLIB_MAJOR_VERSION), ".",
snd_itoa(GLIB_MINOR_VERSION), ".",
snd_itoa(GLIB_MICRO_VERSION),
- #ifdef MUS_PANGO_VERSION
- ", Pango ", MUS_PANGO_VERSION,
+ #ifdef PANGO_VERSION_MAJOR
+ ", Pango ", snd_itoa(PANGO_VERSION_MAJOR), ".",
+ snd_itoa(PANGO_VERSION_MINOR), ".",
+ snd_itoa(PANGO_VERSION_MICRO),
#endif
- #ifdef MUS_CAIRO_VERSION
- ", Cairo ", MUS_CAIRO_VERSION,
+ #ifdef CAIRO_VERSION_MAJOR
+ ", Cairo ", snd_itoa(CAIRO_VERSION_MAJOR), ".",
+ snd_itoa(CAIRO_VERSION_MINOR), ".",
+ snd_itoa(CAIRO_VERSION_MICRO),
#endif
#endif
xm_version(), /* omitted if --version/--help because the init procs haven't run at that point */
@@ -404,19 +357,12 @@ char *version_info(void)
snd_itoa(XpmVersion), ".",
snd_itoa(XpmRevision),
#endif
-#if HAVE_LADSPA && HAVE_DLFCN_H && HAVE_DIRENT_H
- "\n LADSPA: ",
- #ifdef LADSPA_HINT_DEFAULT_MASK
- "1.1",
- #else
- "1.0",
- #endif
-#endif
-#if HAVE_FAM
- #ifdef MUS_GAMIN_VERSION
- "\n Gamin: ", MUS_GAMIN_VERSION,
+#if HAVE_LADSPA
+ "\n Ladspa: ",
+ #ifdef LADSPA_VERSION
+ LADSPA_VERSION,
#else
- "\n with fam",
+ "1.0",
#endif
#endif
#if WITH_GMP
@@ -424,9 +370,6 @@ char *version_info(void)
", mpfr: ", mpfr_get_version(),
", mpc: ", mpc_get_version(),
#endif
-#if SND_AS_WIDGET
- "\n compiled as a widget",
-#endif
#ifdef __DATE__
"\n Compiled ", __DATE__, " ", __TIME__,
#endif
@@ -437,19 +380,17 @@ char *version_info(void)
"\n C++: ",
#endif
__VERSION__,
-#else
-#ifdef __SUNPRO_C
- "\n Forte C ",
-#endif
-#endif
-#if HAVE_GNU_LIBC_VERSION_H
- "\n Libc: ", gnu_get_libc_version(), ".",
- gnu_get_libc_release(),
-#endif
-#ifdef SND_HOST
- "\n host: ", SND_HOST,
#endif
"\n",
+#ifndef _MSC_VER
+ (uname_ok == 0) ? " " : "",
+ (uname_ok == 0) ? uts.sysname : "",
+ (uname_ok == 0) ? " " : "",
+ (uname_ok == 0) ? uts.release : "",
+ (uname_ok == 0) ? " " : "",
+ (uname_ok == 0) ? uts.machine : "",
+ (uname_ok == 0) ? "\n" : "",
+#endif
NULL);
free_snd_itoa();
if (xversion) free(xversion); /* calloc in xen.c */
@@ -466,17 +407,17 @@ void about_snd_help(void)
char *info = NULL, *features = NULL;
#if HAVE_RUBY
- features = word_wrap(XEN_AS_STRING(XEN_EVAL_C_STRING((char *)"$\".join(' ')")), 400);
+ features = word_wrap(Xen_object_to_C_string(Xen_eval_C_string((char *)"$\".join(' ')")), 400);
#endif
#if HAVE_FORTH
- features = word_wrap(XEN_AS_STRING(XEN_EVAL_C_STRING("*features*")), 400);
+ features = word_wrap(Xen_object_to_C_string(Xen_eval_C_string("*features*")), 400);
#endif
#if HAVE_SCHEME
{
char *temp = NULL;
- features = word_wrap(temp = XEN_AS_STRING(XEN_EVAL_C_STRING("*features*")), 400);
+ features = word_wrap(temp = Xen_object_to_C_string(Xen_eval_C_string("*features*")), 400);
if (temp) free(temp);
}
#endif
@@ -485,25 +426,6 @@ void about_snd_help(void)
/* -------------------------------------------------------------------------------- */
main_snd_help("Snd is a sound editor.",
info,
- "\nRecent changes include:\n\
-\n\
-18-Mar: Snd 12.0.\n\
-17-Mar: removed time-graph-hook; replaced by combined-data-color.\n\
-10-Mar: space=play or pause, tracking-cursor stuff changed.\n\
-4-Mar: 'src' button in Save-as dialogs to do automatic sampling rate conversion.\n\
-1-Mar: delete-selection-and-smooth, delete-samples-and-smooth.\n\
-23-Feb: sync-style variable: sync-none (old default), sync-all, or sync-by-sound (new default).\n\
- Options:Controls menu item, and Edit:Unselect\n\
- show-selection and unselect-all.\n\
- show-full-duration, initial-beg, initial-dur, ask-about-unsaved-edits.\n\
- with-toolbar, with-tooltips, remember-sound-state, with-smpte-label.\n\
- new built-in toolbars, removed toolbar.scm and panic.scm.\n\
- removed Snd.ad and Snd.gtrc.\n\
- The built-in popup menus are now context sensitive, and the files popup.scm\n\
- and gtk-popup.scm have been removed.\n\
- play-arrow-size\n\
-12-Feb: Snd 11.13.\n\
-",
#if HAVE_RUBY
"\n $LOADED_FEATURES: \n", features, "\n\n",
#endif
@@ -529,14 +451,14 @@ NULL);
static bool append_key_help(const char *name, int key, int state, bool cx_extended, bool first_time)
{
int pos;
- pos = in_user_keymap(key, state, cx_extended);
+ pos = in_keymap(key, state, cx_extended);
if (pos != -1)
{
char *msg, *tmp = NULL;
msg = mus_format("%s%s is bound to %s",
(first_time) ? "\n\ncurrently " : "\n ",
name,
- tmp = key_binding_description(key, state, cx_extended));
+ tmp = key_description(key, state, cx_extended));
snd_help_append(msg);
free(msg);
if (tmp) free(tmp);
@@ -570,15 +492,14 @@ void find_help(void)
#define search_procedure_example " >lambda: <{ y }> 0.1 y f< ; set-search-procedure"
#endif
- snd_help_with_xrefs("Find",
+ snd_help_with_xrefs(I_FIND,
#if HAVE_EXTENSION_LANGUAGE
-"Searches in Snd refer to the sound data, and are, in general, patterned after Emacs. When you type \
-C-s or C-r, the minibuffer below the graph is activated and you are asked for the search expression. \
+"Searches in Snd refer to the sound data. When you type \
+C-s, the find dialog is activated and you are asked for the search expression. \
The expression is a function that takes one argument, the current sample value, and returns " PROC_TRUE " when it finds a match. \
To look for the next sample that is greater than .1, " basic_example ". The cursor then moves \
-to that sample, if any. Successive C-s's or C-r's continue the search starting from the next sample.\
-Normally, the search applies only to the current channel. To search all current files at once, use the Edit:Find dialog.\
+to that sample, if any. Successive C-s's continue the search starting from the next sample.\
\n\n\
The primary searching function is:\n\
\n\
@@ -612,8 +533,7 @@ the searching mechanisms are disabled.",
snd_xrefs("Search"),
snd_xref_urls("Search"));
- append_key_help("C-r", snd_K_r, snd_ControlMask, false,
- append_key_help("C-s", snd_K_s, snd_ControlMask, false, true));
+ append_key_help("C-s", snd_K_s, snd_ControlMask, false, true);
}
@@ -770,22 +690,16 @@ superimposed on each other.",
/* ---------------- Debug ---------------- */
-static const char *debug_xrefs[8] = {
+static const char *debug_xrefs[5] = {
"C debugging: {gdb}",
- "Scheme/Ruby/Forth debugging: {snd-debug}",
"CLM Instrument debugging: {variable-display}",
- "Notelist debugging: {ws-backtrace}",
- "Break and trace points: {snd-break}",
"Error handling",
"Print statement: {" S_snd_print "}",
NULL};
-static const char *debug_urls[8] = {
+static const char *debug_urls[5] = {
"extsnd.html#cdebugging",
- "sndscm.html#debugdoc",
"sndscm.html#variabledisplay",
- "sndscm.html#wsdebug",
- "sndscm.html#debugdoc",
"extsnd.html#snderrors",
"extsnd.html#sndprint",
NULL};
@@ -816,7 +730,7 @@ about it! If possible, run Snd in gdb and send me the stack trace: \n\n\
See README.Snd for more about C-level troubles. For CLM-based instruments, " vardpy_reference " might \
help. For debugging your own Scheme/Ruby/Forth \
code (or Snd's for that matter), see the \"Errors and Debugging\" section of \
-extsnd.html, or snd-debug. For notelist debugging, see ws-backtrace.",
+extsnd.html. For notelist debugging, see ws-backtrace.",
#else
"If you hit a segfault in Snd, please tell me \
about it! If possible, run Snd in gdb and send me the stack trace: \n\n\
@@ -857,14 +771,7 @@ void env_help(void)
To define a triangle curve: " envelope_example ".\
There is no preset limit on the number of breakpoints. Use the envelope editor to draw envelopes with the mouse. \
\n\n\
-To apply an envelope to a sound, use " S_env_sound " or the extended command C-x C-a. If this command gets a numeric \
-argument, the envelope is applied from the cursor for that many samples. Otherwise, the envelope is \
-applied to the entire file. \
-\n\
- C-x a apply amplitude envelope to selection\n\
- C-x C-a apply amplitude envelope to channel\n\
-\n\
-The primary enveloping functions are:\n\
+To apply an envelope to a sound, use " S_env_sound ". The primary enveloping functions are:\n\
\n\
" S_env_sound " (envelope :optional (samp 0) samps (env-base 1.0) snd chn edpos)\n\
" S_env_sound " applies the amplitude envelope to snd's channel chn.\n\
@@ -881,9 +788,6 @@ The primary enveloping functions are:\n\
WITH_WORD_WRAP,
snd_xrefs("Envelope"), /* snd-xref.c */
snd_xref_urls("Envelope"));
-
- append_key_help("C-x a", snd_K_a, 0, true,
- append_key_help("C-x C-a", snd_K_s, snd_ControlMask, true, true));
}
@@ -963,7 +867,7 @@ The full frequency axis is normally displayed, but the axis is draggable -- put
and drag it either way to change the range (this is equivalent to changing the variable " S_spectrum_end "). \
You can also click on any point in the fft to get the associated fft value at that point displayed; \
if " S_with_verbose_cursor " is " PROC_TRUE ", you can drag the mouse through the fft display and \
-the description in the minibuffer will be constantly updated. To change the fft size by powers of two, \
+the description in the status area is constantly updated. To change the fft size by powers of two, \
you can use the keypad keys '*' and '/'. \
\n\n\
The main FFT-related functions are:\
@@ -994,7 +898,7 @@ The main FFT-related functions are:\
" S_fft_with_phases " (:optional snd chn)\n\
sets whether the single fft display includes phase information\n\
\n\
- " S_transform_graph_p " (:optional snd chn)\n\
+ " S_transform_graph_on " (:optional snd chn)\n\
if " PROC_TRUE ", the fft graph is displayed: " transform_graph_example "\n\
\n\
" S_transform_normalization " (:optional snd chn)\n\
@@ -1205,7 +1109,6 @@ than 0) will move together when one is moved, and so on. The following keyboard
C-x / place named mark at cursor\n\
C-x C-m add named mark\n\
C-j go to mark\n\
- C-x j go to named mark\n\
\n\
The main mark-related functions are:\n\
\n\
@@ -1238,19 +1141,17 @@ The following keyboard commands relate to marks: \
C-M place syncd marks at all currently syncd chan cursors\n\
C-x / place named mark at cursor\n\
C-x C-m add named mark\n\
- C-j go to mark\n\
- C-x j go to named mark",
+ C-j go to mark",
#endif
WITH_WORD_WRAP,
snd_xrefs("Mark"),
snd_xref_urls("Mark"));
- append_key_help("C-x j", snd_K_j, 0, true,
- append_key_help("C-j", snd_K_j, snd_ControlMask, false,
- append_key_help("C-x C-m", snd_K_m, snd_ControlMask, true,
- append_key_help("C-x /", snd_K_slash, 0, true,
- append_key_help("C-m", snd_K_m, snd_ControlMask, false, true)))));
+ append_key_help("C-x C-m", snd_K_m, snd_ControlMask, true,
+ append_key_help("C-x /", snd_K_slash, 0, true,
+ append_key_help("C-j", snd_K_j, snd_ControlMask, false,
+ append_key_help("C-m", snd_K_m, snd_ControlMask, false, true))));
}
@@ -1260,7 +1161,7 @@ void mix_help(void)
{
#if HAVE_SCHEME
#define mix_example "(mix \"oboe.snd\" 1234)"
- #define mix_vct_example "(mix-vct (vct 0 .1 .2) 1234)"
+ #define mix_vct_example "(mix-float-vector (float-vector 0 .1 .2) 1234)"
#define mix_amp_example "(set! (mix-amp 0) .5)"
#define mix_amp_env_example "(set! (mix-amp-env 0) '(0 0 1 1))"
#endif
@@ -1296,8 +1197,6 @@ name, begin and end times, and a play button. Beneath that are \
various sliders controlling the speed (sampling rate) of the mix, amplitude of \
each input channel, and the amplitude envelopes. \
\n\n\
-To move the cursor from one mix to the next, in the same manner as C-j moves through marks, use C-x C-j. \
-\n\n\
The main mix-related functions are:\n\
\n\
" S_mix " (file :optional samp in-chan snd chn tags delete)\n\
@@ -1310,8 +1209,8 @@ The main mix-related functions are:\n\
" S_mix_region " (:optional samp reg snd chn region-channel)\n\
mix region reg at sample samp (default is cursor sample)\n\
\n\
- " S_mix_vct " (vct :optional beg snd chn with-mix-tags origin)\n\
- mix the contents of vct starting at beg:\n\
+ " S_mix_vct " (v :optional beg snd chn with-mix-tags origin)\n\
+ mix the contents of " S_vct " starting at beg:\n\
" mix_vct_example "\n\
\n\
" S_mix_amp " (mix)\n\
@@ -1351,8 +1250,6 @@ commonly-used controls on the currently chosen mix. At the top are the mix id, \
name, begin and end times, and a play button. Beneath that are \
various sliders controlling the speed (sampling rate), amplitude, \
and amplitude envelope applied to the mix. \
-\n\n\
-To move the cursor from one mix to the next, in the same manner as C-j moves through marks, use C-x C-j. \
\n\n",
#endif
@@ -1365,40 +1262,25 @@ To move the cursor from one mix to the next, in the same manner as C-j moves thr
}
-/* ---------------- Recording ---------------- */
-
-void recording_help(void)
-{
- snd_help_with_xrefs("Record",
-"Snd's recorder is very simple; for complex recording tasks, use Ardour. The record dialog presents one or two VU meters (just \
-the curve and a needle), a text widget for the output sound file name, a button to change the meters from linear to dB, and \
-the usual buttons along the bottom to start or stop the recorder, provide help, and exit.",
-
- WITH_WORD_WRAP,
- NULL,
- NULL);
-}
-
-
/* ---------------- Headers etc ---------------- */
static const char *header_and_data_xrefs[10] = {
- "data format discussion: {" S_data_format "}",
- "data format constants: {" S_mus_data_format_name "}",
+ "sample type discussion: {" S_sample_type "}",
+ "sample type constants: {" S_mus_sample_type_name "}",
"header type discussion: {" S_header_type "}",
"header type constants: {" S_mus_header_type_name "}",
- "MPEG support: mpg in examp." XEN_FILE_EXTENSION,
- "OGG support: read-ogg in examp." XEN_FILE_EXTENSION,
- "Speex support: read-speex in examp." XEN_FILE_EXTENSION,
- "Flac support: read-flac in examp." XEN_FILE_EXTENSION,
+ "MPEG support: mpg in examp." Xen_file_extension,
+ "OGG support: read-ogg in examp." Xen_file_extension,
+ "Speex support: read-speex in examp." Xen_file_extension,
+ "Flac support: read-flac in examp." Xen_file_extension,
"{Sndlib}: underlying support",
NULL};
static const char *header_and_data_urls[10] = {
- "extsnd.html#snddataformat",
- "extsnd.html#soundformatname",
- "extsnd.html#sndheadertype",
- "extsnd.html#soundtypename",
+ "extsnd.html#sampletype",
+ "extsnd.html#defaultoutputsampletype",
+ "extsnd.html#headertype",
+ "extsnd.html#defaultoutputheadertype",
"sndscm.html#exmpg",
"sndscm.html#exmpg",
"sndscm.html#exmpg",
@@ -1411,7 +1293,7 @@ void sound_files_help(void)
snd_help_with_xrefs("Headers and Data",
"Snd can handle the following file and data types: \
\n\n\
- read/write (many data formats):\n\
+ read/write (many sample types):\n\
NeXT/Sun/DEC/AFsp\n\
AIFF/AIFC\n\
RIFF (Microsoft wave)\n\
@@ -1421,7 +1303,7 @@ void sound_files_help(void)
CAFF\n\
no header ('raw')\n\
\n\n\
- read-only (in selected data formats):\n\
+ read-only (in selected sample types):\n\
8SVX (IFF), EBICSF, INRS, ESPS, SPPACK, ADC (OGI), AVR, VOC, PVF,\n\
Sound Tools, Turtle Beach SMP, SoundFont 2.0, Sound Designer I, PSION, MAUD, Kurzweil 2000,\n\
Gravis Ultrasound, ASF, PAF, CSL, Comdisco SPW, Goldwave sample, omf, quicktime, sox,\n\
@@ -1429,7 +1311,7 @@ void sound_files_help(void)
Ultratracker WaveSample, Sample Dump exchange, Yamaha SY85, SY99, and TX16, Covox v8, AVI, \n\
Impulse tracker, Korg, Akai, Turtle Beach, Matlab-5\n\
\n\n\
- automatically translated to a readable format:\n\
+ automatically translated to a readable sample and header type:\n\
IEEE text, Mus10, SAM 16-bit (modes 1 and 4), AVI, \n\
NIST shortpack, HCOM, Intel, IBM, and Oki (Dialogic) ADPCM, \n\
G721, G723_24, G723_40, MIDI sample dump, Ogg, Speex, \n\
@@ -1437,11 +1319,11 @@ void sound_files_help(void)
\n\n\
The files can have any number of channels. Data can be either big or little endian. \
The file types listed above as 'automatically translated' are \
-decoded upon being opened, translated to some format Snd can read and write, \
+decoded upon being opened, translated to some type that Snd can read and write, \
and rewritten as a new file with an added (possibly redundant) extension .snd, \
and that file is the one the editor sees from then on.\
\n\n\
-" S_data_format " returns the current sound's data format, and " S_header_type " returns \
+" S_sample_type " returns the current sound's sample type, and " S_header_type " returns \
its header type.",
WITH_WORD_WRAP,
@@ -1452,8 +1334,7 @@ its header type.",
/* ---------------- Initialization File ---------------- */
-static const char *init_file_xrefs[6] = {
- "{X resources}: .Xdefaults settings",
+static const char *init_file_xrefs[5] = {
"{Invocation flags}",
"~/.snd: {Initialization file}",
"{Customization}",
@@ -1461,7 +1342,6 @@ static const char *init_file_xrefs[6] = {
NULL};
static const char *init_file_urls[6] = {
- "grfsnd.html#sndresources",
"grfsnd.html#sndswitches",
"grfsnd.html#sndinitfile",
"extsnd.html#lisplistener",
@@ -1474,7 +1354,7 @@ void init_file_help(void)
#if HAVE_EXTENSION_LANGUAGE
"Nearly everything in Snd can be set in an initialization file, loaded at any time from a saved-state file, specified \
-via inter-process communciation from any other program, invoked via M-x in the minibuffer, imbedded in a keyboard macro, or \
+via inter-process communciation from any other program, or \
dealt with from the lisp listener panel. I've tried to bring out to lisp nearly every portion of Snd, \
both the signal-processing functions, and much of the user interface. You can, for example, add your own menu choices, \
editing operations, or graphing alternatives. These extensions can be loaded at any time. One of the \
@@ -1491,17 +1371,17 @@ is loaded, there's not much customization you can do.",
}
-/* ---------------- Key Bindings ---------------- */
+/* ---------------- Keys ---------------- */
static const char *key_xrefs[4] = {
- "To change a key binding: {" S_bind_key "}",
+ "To change a key's action: {" S_bind_key "}",
"To undefine a key: {" S_unbind_key "}",
- "Current key binding: {" S_key_binding "}",
+ "Current key action: {" S_key_binding "}",
NULL};
static void show_key_help(int key, int state, bool cx, char *help)
{
- /* this frees the help string since it's always coming from key_binding_description, and
+ /* this frees the help string since it's always coming from key_description, and
* is a bother to handle in the loops that call us
*/
if (help)
@@ -1509,71 +1389,71 @@ static void show_key_help(int key, int state, bool cx, char *help)
char buf[1024];
char cbuf[256];
make_key_name(cbuf, 256, key, state, cx);
- mus_snprintf(buf, 1024, "\n%s: %s", cbuf, help);
+ snprintf(buf, 1024, "\n%s: %s", cbuf, help);
snd_help_append(buf);
free(help);
}
}
-static bool find_unbuckified_keys(int key, int state, bool cx, XEN func)
+static bool find_unbuckified_keys(int key, int state, bool cx, Xen func)
{
- if ((key > 256) && (state == 0) && (!cx) && (XEN_BOUND_P(func)))
- show_key_help(key, state, cx, key_binding_description(key, state, cx));
+ if ((key > 256) && (state == 0) && (!cx) && (Xen_is_bound(func)))
+ show_key_help(key, state, cx, key_description(key, state, cx));
return(false);
}
-static bool find_buckified_keys(int key, int state, bool cx, XEN func)
+static bool find_buckified_keys(int key, int state, bool cx, Xen func)
{
- if ((key > 256) && (state == snd_ControlMask) && (!cx) && (XEN_BOUND_P(func)))
- show_key_help(key, state, cx, key_binding_description(key, state, cx));
+ if ((key > 256) && (state == snd_ControlMask) && (!cx) && (Xen_is_bound(func)))
+ show_key_help(key, state, cx, key_description(key, state, cx));
return(false);
}
-static bool find_unbuckified_cx_keys(int key, int state, bool cx, XEN func)
+static bool find_unbuckified_cx_keys(int key, int state, bool cx, Xen func)
{
- if ((key > 256) && (state == 0) && (cx) && (XEN_BOUND_P(func)))
- show_key_help(key, state, cx, key_binding_description(key, state, cx));
+ if ((key > 256) && (state == 0) && (cx) && (Xen_is_bound(func)))
+ show_key_help(key, state, cx, key_description(key, state, cx));
return(false);
}
-static bool find_buckified_cx_keys(int key, int state, bool cx, XEN func)
+static bool find_buckified_cx_keys(int key, int state, bool cx, Xen func)
{
- if ((key > 256) && (state == snd_ControlMask) && (cx) && (XEN_BOUND_P(func)))
- show_key_help(key, state, cx, key_binding_description(key, state, cx));
+ if ((key > 256) && (state == snd_ControlMask) && (cx) && (Xen_is_bound(func)))
+ show_key_help(key, state, cx, key_description(key, state, cx));
return(false);
}
-static bool find_leftover_keys(int key, int state, bool cx, XEN func)
+static bool find_leftover_keys(int key, int state, bool cx, Xen func)
{
if ((key > 256) && (state & snd_MetaMask))
- show_key_help(key, state, cx, key_binding_description(key, state, cx));
+ show_key_help(key, state, cx, key_description(key, state, cx));
return(false);
}
-void key_binding_help(void)
+void key_help(void)
{
#if HAVE_SCHEME
- #define bind_key_example "(bind-key \"End\" 0\n (lambda () \"view full sound\"\n (set! (x-bounds) (list 0.0 (/ (frames) (srate))))))"
+ #define bind_key_example "(bind-key \"End\" 0\n (lambda () \"view full sound\"\n (set! (x-bounds) (list 0.0 (/ (framples) (srate))))))"
#endif
#if HAVE_RUBY
- #define bind_key_example "bind_key(\"End\", 0,\n lambda do ||\n set_x_bounds([0.0, frames.to_f / srate.to_f])\n end)"
+ #define bind_key_example "bind_key(\"End\", 0,\n lambda do ||\n set_x_bounds([0.0, framples.to_f / srate.to_f])\n end)"
#endif
#if HAVE_FORTH
- #define bind_key_example "\"End\" 0\n lambda: <{ -- val }> doc\"view full sound\"\n '( 0.0 #f #f #f frames #f srate f/ ) #f #f set-x-bounds ; bind-key"
+ #define bind_key_example "\"End\" 0\n lambda: <{ -- val }> doc\" view full sound\"\n '( 0.0 #f #f #f framples #f srate f/ ) #f #f undef set-x-bounds ; bind-key"
#endif
int i;
- snd_help_with_xrefs("Key bindings",
+ snd_help_with_xrefs("Keys",
#if HAVE_EXTENSION_LANGUAGE
-"Although Snd has a number of built-in key bindings (listed below), you can redefine \
+"Although Snd has a number of built-in key actions (listed below), you can redefine \
any key via:\n\
\n\
" S_bind_key " (key state func :optional extended origin)\n\
@@ -1581,33 +1461,33 @@ any key via:\n\
modifiers 'state' (and preceding C-x if 'extended') to evaluate\n\
'func'. For example, to set the End key to cause the full sound\n\
to be displayed:\n\n\
- " bind_key_example "\n\n\nKey Bindings:\n",
+ " bind_key_example "\n\n\nKeys:\n",
#else
-"If there's no extension language, you're stuck with the built-in key bindings:",
+"If there's no extension language, you're stuck with the built-in key actions:",
#endif
WITHOUT_WORD_WRAP,
key_xrefs,
NULL);
/* run through bindings straight, C-key, C-x key, C-x C-key appending description in help dialog */
for (i = 0; i < 256; i++)
- show_key_help(i, 0, false, key_binding_description(i, 0, false));
- map_over_key_bindings(find_unbuckified_keys);
+ show_key_help(i, 0, false, key_description(i, 0, false));
+ map_over_keys(find_unbuckified_keys);
for (i = 0; i < 256; i++)
- show_key_help(i, snd_ControlMask, false, key_binding_description(i, snd_ControlMask, false));
- map_over_key_bindings(find_buckified_keys);
+ show_key_help(i, snd_ControlMask, false, key_description(i, snd_ControlMask, false));
+ map_over_keys(find_buckified_keys);
for (i = 0; i < 256; i++)
- show_key_help(i, snd_MetaMask, false, key_binding_description(i, snd_MetaMask, false));
+ show_key_help(i, snd_MetaMask, false, key_description(i, snd_MetaMask, false));
for (i = 0; i < 256; i++)
- show_key_help(i, snd_ControlMask | snd_MetaMask, false, key_binding_description(i, snd_ControlMask | snd_MetaMask, false));
+ show_key_help(i, snd_ControlMask | snd_MetaMask, false, key_description(i, snd_ControlMask | snd_MetaMask, false));
for (i = 0; i < 256; i++)
- show_key_help(i, 0, true, key_binding_description(i, 0, true));
- map_over_key_bindings(find_unbuckified_cx_keys);
+ show_key_help(i, 0, true, key_description(i, 0, true));
+ map_over_keys(find_unbuckified_cx_keys);
for (i = 0; i < 256; i++)
- show_key_help(i, snd_ControlMask, true, key_binding_description(i, snd_ControlMask, true));
+ show_key_help(i, snd_ControlMask, true, key_description(i, snd_ControlMask, true));
- map_over_key_bindings(find_buckified_cx_keys);
- map_over_key_bindings(find_leftover_keys);
+ map_over_keys(find_buckified_cx_keys);
+ map_over_keys(find_leftover_keys);
snd_help_back_to_top();
}
@@ -1616,6 +1496,7 @@ any key via:\n\
void play_help(void)
{
+#if WITH_AUDIO
#if HAVE_SCHEME
#define play_cursor_example "(play (cursor))"
#define play_file_example "(play \"oboe.snd\")"
@@ -1678,6 +1559,9 @@ Except in the browsers, what is actually played depends on the control panel.",
snd_xref_urls("Play"));
append_key_help("C-q", snd_K_q, snd_ControlMask, true, true);
+#else
+ snd_help("Play", "this version of Snd can't play!", WITH_WORD_WRAP);
+#endif
}
@@ -1725,7 +1609,7 @@ reverbs mentioned in the related topics list. The control panel reverb function
" S_reverb_control_lowpass " (:optional snd):\n\
reverb low pass filter coefficient. (filter in feedback loop).\n\
\n\
- " S_reverb_control_p " (:optional snd):\n\
+ " S_reverb_control_on " (:optional snd):\n\
" PROC_TRUE " if the reverb button is set (i.e. the reverberator is active).\n\
" reverb_control_p_example "\n\
\n\
@@ -1753,20 +1637,13 @@ void save_help(void)
snd_help_with_xrefs("Save",
"To save the current edited state of a file, use the File:Save option (to overwrite the old version of the \
file), or File:Save as (to write to a new file, leaving the old file unchanged). The equivalent keyboard \
-command is C-x C-s (save). Other related keyboard commands are C-x w (save selection as file), and \
-C-x C-w (extract and save the current channel as a file). Normally, if the new file already exists, and it is \
-not currently being edited in Snd, it is silently overwritten. \
-If you try to overwrite a file, and \
-that file has active edits in a different Snd window, you'll be asked for confirmation. \
-If you want Snd to ask before overwriting a file in any case, set the variable " S_ask_before_overwrite " to " PROC_TRUE ".\n",
+command is C-x C-s (save). ",
WITH_WORD_WRAP,
snd_xrefs("Save"),
snd_xref_urls("Save"));
- append_key_help("C-x w", snd_K_w, 0, true,
- append_key_help("C-x C-w", snd_K_w, snd_ControlMask, true,
- append_key_help("C-x C-s", snd_K_s, snd_ControlMask, true, true)));
+ append_key_help("C-x C-s", snd_K_s, snd_ControlMask, true, true);
}
@@ -1776,8 +1653,8 @@ void filter_help(void)
{
#if HAVE_SCHEME
#define filter_sound_env_example "(filter-sound '(0 1 1 0) 1024)"
- #define filter_sound_vct_example "(filter-sound (vct .1 .2 .3 .3 .2 .1) 6)"
- #define filter_sound_clm_example "(filter-sound (make-filter 2 (vct 1 -1) (vct 0 -0.99)))"
+ #define filter_sound_vct_example "(filter-sound (float-vector .1 .2 .3 .3 .2 .1) 6)"
+ #define filter_sound_clm_example "(filter-sound (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99)))"
#endif
#if HAVE_RUBY
#define filter_sound_env_example "filter_sound([0.0, 1.0, 1.0, 0.0], 1024)"
@@ -1794,7 +1671,7 @@ void filter_help(void)
#if HAVE_EXTENSION_LANGUAGE
"There is an FIR Filter in the control panel, a filtering option in the envelope editor dialog, and a variety of other filters scattered around; \
-see sndclm.html, dsp." XEN_FILE_EXTENSION " and analog-filters." XEN_FILE_EXTENSION " in particular. The \
+see sndclm.html, dsp." Xen_file_extension " and analog-filters." Xen_file_extension " in particular. The \
built-in filtering functions include: \n\
\n\
" S_filter_channel " (env :optional order beg dur snd chn edpos trunc origin)\n\
@@ -1828,7 +1705,7 @@ The control filter functions are:\n\
" S_filter_control_order " (:optional snd)\n\
The filter order\n\
\n\
- " S_filter_control_p " (:optional snd)\n\
+ " S_filter_control_on " (:optional snd)\n\
" PROC_TRUE " if the filter is active.\n\
\n\
" S_filter_control_waveform_color "\n\
@@ -1851,7 +1728,7 @@ void resample_help(void)
#if HAVE_SCHEME
#define src_number_example "(src-channel 2.0) ; go twice as fast"
#define src_env_example "(src-channel '(0 1 1 2))"
- #define src_clm_example "(src-channel (make-env '(0 1 1 2) :end (frames)))"
+ #define src_clm_example "(src-channel (make-env '(0 1 1 2) :end (framples)))"
#define H_speed_control_as_float S_speed_control_as_float
#define H_speed_control_as_ratio S_speed_control_as_ratio
#define H_speed_control_as_semitone S_speed_control_as_semitone
@@ -1860,7 +1737,7 @@ void resample_help(void)
#if HAVE_RUBY
#define src_number_example "src_channel(2.0) # go twice as fast"
#define src_env_example "src_channel([0.0, 1.0, 1.0, 2.0])"
- #define src_clm_example "src_channel(make_env([0.0, 1.0, 1.0, 2.0], :end, frames()))"
+ #define src_clm_example "src_channel(make_env([0.0, 1.0, 1.0, 2.0], :end, framples()))"
#define H_speed_control_as_float "Speed_control_as_float"
#define H_speed_control_as_ratio "Speed_control_as_ratio"
#define H_speed_control_as_semitone "Speed_control_as_semitone"
@@ -1869,7 +1746,7 @@ void resample_help(void)
#if HAVE_FORTH
#define src_number_example "2.0 src-channel \\ go twice as fast"
#define src_env_example "'( 0.0 1.0 1.0 2.0 ) src-channel"
- #define src_clm_example "'( 0.0 1.0 1.0 2.0 ) :end 0 0 -1 frames make-env src-channel"
+ #define src_clm_example "'( 0.0 1.0 1.0 2.0 ) :end 0 0 -1 framples make-env src-channel"
#define H_speed_control_as_float S_speed_control_as_float
#define H_speed_control_as_ratio S_speed_control_as_ratio
#define H_speed_control_as_semitone S_speed_control_as_semitone
@@ -1880,7 +1757,7 @@ void resample_help(void)
#if HAVE_EXTENSION_LANGUAGE
"There is a sampling rate changer in the control panel, and a resampling option in the envelope \
-editor dialog; see also sndclm.html and examp." XEN_FILE_EXTENSION ". \
+editor dialog; see also sndclm.html and examp." Xen_file_extension ". \
The basic resampling functions are:\n\
\n\
" S_src_channel " (num-or-env :optional beg dur snd chn edpos)\n\
@@ -1937,7 +1814,7 @@ void insert_help(void)
snd_help_with_xrefs("Insert",
#if HAVE_EXTENSION_LANGUAGE
-"To insert a file, use C-x C-i, and to insert the selection C-x i. C-o inserts a \
+"C-o inserts a \
zero sample at the cursor. There are also the File:Insert and Edit:Insert Selection \
dialogs. The insertion-related functions are:\n\
\n\
@@ -1957,7 +1834,7 @@ dialogs. The insertion-related functions are:\n\
insert sample 'value' at sample 'samp'\n\
\n\
" S_insert_samples " (samp samps data :optional snd chn pos del org)\n\
- insert 'samps' samples of 'data' (normally a vct) starting at\n\
+ insert 'samps' samples of 'data' (normally a " S_vct ") starting at\n\
sample 'samp'. 'data' can also be a filename.\n\
\n\
" S_insert_sound " (file :optional beg in-chan snd chn pos del)\n\
@@ -1966,7 +1843,7 @@ dialogs. The insertion-related functions are:\n\
channels are inserted.\n",
#else
-"To insert a file, use C-x C-i, and to insert the selection C-x i. C-o inserts a \
+"C-o inserts a \
zero sample at the cursor. There are also the File:Insert and Edit:Insert Selection dialogs.",
#endif
@@ -1974,9 +1851,7 @@ zero sample at the cursor. There are also the File:Insert and Edit:Insert Selec
snd_xrefs("Insert"),
snd_xref_urls("Insert"));
- append_key_help("C-x i", snd_K_i, 0, true,
- append_key_help("C-o", snd_K_o, snd_ControlMask, false,
- append_key_help("C-x C-i", snd_K_i, snd_ControlMask, true, true)));
+ append_key_help("C-o", snd_K_o, snd_ControlMask, false, true);
}
@@ -2017,7 +1892,7 @@ functions are:\n\
void region_help(void)
{
#if HAVE_SCHEME
- #define region_to_vct_example "(region->vct 0 0 reg) ; len=0 => entire region"
+ #define region_to_vct_example "(region->float-vector 0 0 reg) ; len=0 => entire region"
#define save_region_example "(save-region reg :file \"reg0.snd\" :header-type mus-next)"
#endif
#if HAVE_RUBY
@@ -2054,17 +1929,17 @@ The main region-related functions are:\n\
" S_mix_region " (:optional samp reg snd chn reg-chan)\n\
mix in region 'reg' at sample 'samp' (defaults to the cursor sample)\n\
\n\
- " S_save_region " (reg :file :header-type :data-format :comment)\n\
- save region 'reg' in 'file' in data format (default is mus-bshort),\n\
+ " S_save_region " (reg :file :header-type :sample-type :comment)\n\
+ save region 'reg' in 'file' in sample-type (default is mus-bshort),\n\
header type (default is mus-next), and comment. Return the output\n\
filename.\n\
\n\
" save_region_example "\n\
\n\
" S_region_to_vct " (:optional samp samps reg chn v)\n\
- return a vct containing 'samps' samples starting at 'samp'\n\
- in region 'reg's channel 'chn'. If 'v' (a vct) is provided,\n\
- it is filled, rather than creating a new vct.\n\
+ return a " S_vct " containing 'samps' samples starting at 'samp'\n\
+ in region 'reg's channel 'chn'. If 'v' (a " S_vct ") is provided,\n\
+ it is filled, rather than creating a new " S_vct ".\n\
\n\
" region_to_vct_example "\n\
\n\
@@ -2074,7 +1949,7 @@ The main region-related functions are:\n\
\n\
" S_forget_region " (:optional reg): remove region from region list\n\
\n\
- " S_region_p " (reg): " PROC_TRUE " if 'reg' is a known region id\n\
+ " S_is_region " (reg): " PROC_TRUE " if 'reg' is a known region id\n\
\n\
" S_regions ": list of currently active regions\n\
\n\
@@ -2083,7 +1958,7 @@ The main region-related functions are:\n\
" S_selection_creates_region ": does making a selection create a region\n\
\n\
" S_region_chans " (:optional reg): region chans\n\
- " S_region_frames " (:optional reg chan): region length\n\
+ " S_region_framples " (:optional reg chan): region length\n\
" S_region_maxamp " (:optional reg): region maxamp\n\
" S_region_maxamp_position " (:optional reg): maxamp location (sample number)\n\
" S_region_position " (:optional reg chan): original begin time of region\n\
@@ -2150,7 +2025,7 @@ The primary selection-related functions are:\n\
" S_filter_selection " (env :optional order truncate)\n\
apply an FIR filter with frequency response 'env' to the \n\
selection. env can be the filter coefficients themselves in\n\
- a vct with at least 'order' elements, or a CLM filter\n\
+ a " S_vct " with at least 'order' elements, or a CLM filter\n\
\n\
" S_insert_selection " (:optional beg snd chn)\n\
insert (a copy of) selection starting at 'beg'\n\
@@ -2161,7 +2036,7 @@ The primary selection-related functions are:\n\
" S_reverse_selection "(): reverse selected portion\n\
\n\
" S_save_selection " (:file (:header-type mus-next)\n\
- :data-format :srate :comment :channel)\n\
+ :sample-type :srate :comment :channel)\n\
save the selection in file. If channel is given, save\n\
only that channel.\n\
\n\
@@ -2169,15 +2044,15 @@ The primary selection-related functions are:\n\
\n\
" S_scale_selection_by " (scalers)\n\
scale the selection by 'scalers' which can be either a float,\n\
- a list of floats, or a vct. In a multichannel selection, each\n\
- member of the vct or list is applied to the next channel in the\n\
+ a list of floats, or a " S_vct ". In a multichannel selection, each\n\
+ member of the " S_vct " or list is applied to the next channel in the\n\
selection. " scale_selection_list_example " scales the first\n\
channel by 0.0, the second (if any) by 2.0.\n\
" scale_selection_number_example " scales all channels by 2.0.\n\
\n\
" S_scale_selection_to " (norms)\n\
normalize the selection to norms which can be either a float,\n\
- a list of floats, or a vct.\n\
+ a list of floats, or a " S_vct ".\n\
\n\
" S_select_all " (:optional snd chn)\n\
select all samples\n\
@@ -2197,17 +2072,17 @@ The primary selection-related functions are:\n\
\n\
" S_selection_chans ": chans in selection\n\
" S_selection_color ": color to highlight selection\n\
- " S_selection_frames " (:optional snd chn): length of selection\n\
+ " S_selection_framples " (:optional snd chn): length of selection\n\
" S_selection_maxamp " (:optional snd chn): maxamp of selection\n\
" S_selection_maxamp_position " (:optional snd chn): sample number of maxamp\n\
" S_selection_member " (:optional snd chn): \n\
" PROC_TRUE " if snd's channel chn has selected data.\n\
- " S_selection_p ": " PROC_TRUE " if there's a selection\n\
+ " S_is_selection ": " PROC_TRUE " if there's a selection\n\
" S_selection_position " (:optional snd chn): \n\
sample number where selection starts\n\
" S_selection_srate ": nominal srate of selected portion.\n\
\n\
-There are many more selection-oriented functions scattered around the various *." XEN_FILE_EXTENSION " files. \
+There are many more selection-oriented functions scattered around the various *." Xen_file_extension " files. \
See the related topics list below.",
#else
@@ -2245,7 +2120,7 @@ as numbers between 0.0 and 1.0. A color object is created via " S_make_color ":\
" make_color_example "\n\
\n\
This declares the variable \"blue\" and gives it the value of the color whose rgb components \
-include only blue in full force. The X11 color names are defined in rgb." XEN_FILE_EXTENSION ". The overall widget background color is " S_basic_color ".\n\
+include only blue in full force. The X11 color names are defined in rgb." Xen_file_extension ". The overall widget background color is " S_basic_color ".\n\
\n\
" set_basic_color_example "\n\
\n\
@@ -2289,9 +2164,9 @@ The sonogram colors can be set in the View:Colors dialog.",
void envelope_editor_dialog_help(void)
{
#if HAVE_SCHEME
- #define define_envelope_name "defvar, define, or define-envelope"
+ #define define_envelope_name "define, or define-envelope"
#define ramp_envelope_example "'(0 0 1 1)"
- #define define_envelope_example " (defvar ramp '(0 0 1 1))\n (define-envelope pyramid '(0 0 1 1 2 0))"
+ #define define_envelope_example " (define-envelope pyramid '(0 0 1 1 2 0))"
#endif
#if HAVE_RUBY
#define define_envelope_name "define_envelope"
@@ -2315,9 +2190,9 @@ The dialog has a display showing either the envelope currently being edited or \
a panorama of all currently loaded envelopes. The current envelope can be edited with the mouse: click at some spot in the graph to place a \
new breakpoint, drag an existing breakpoint to change its position, and click an existing breakpoint to delete it. \
The Undo and Redo buttons can be used to move around in the list of envelope edits; the current state \
-of the envelope can be saved with the 'save' button, or printed with 'print'. Envelopes can be defined via " define_envelope_name ": \
+of the envelope can be saved with the 'save' button. Envelopes can be defined via " define_envelope_name ": \
\n\n" define_envelope_example "\n\n\
-defines two envelopes that can be used in Snd wherever an envelope is needed (e.g. C-x C-a). You can also define \
+defines two envelopes that can be used in Snd wherever an envelope is needed. You can also define \
a new envelope in the dialog's text field; " ramp_envelope_example " creates a ramp as a new envelope. \
\n\n\
In the overall view of envelopes, click an envelope, or click its name in the scrolled \
@@ -2326,7 +2201,7 @@ was previously there. To load an existing envelope into the editor, you can als
the envelope as it is currently defined in the graph viewer, type its name in this field, then \
either push return or the 'save' button. \
\n\n\
-Once you have an envelope in the editor, you can apply it to the current sounds with the 'Apply' or 'Undo&Apply' buttons; the latter \
+Once you have an envelope in the editor, you can apply it to the current sounds with the 'Apply' or 'Undo&Apply' buttons; the latter \
first tries to undo the previous edit, then applies the envelope. The envelope can be applied to \
the amplitude, the spectrum, or the sampling rate. The choice is made via the three buttons marked 'amp', \
'flt', and 'src'. The filter order is the variable " S_enved_filter_order " which defaults to 40. To use fft-filtering (convolution) \
@@ -2351,7 +2226,6 @@ improve the fit. In this case, the X axis goes from 0 Hz to half the sampling r
snd_xrefs("Envelope"),
snd_xref_urls("Envelope"));
- append_key_help("C-x C-a", snd_K_a, snd_ControlMask, true, true);
}
@@ -2401,7 +2275,7 @@ in linear terms.",
static const char *color_orientation_dialog_xrefs[11] = {
"colormap variable: {colormap}",
"orientation variables: {" S_spectro_x_scale "}, {" S_spectro_x_angle "}, etc",
- "colormap constants: rgb." XEN_FILE_EXTENSION,
+ "colormap constants: rgb." Xen_file_extension,
"colormap colors: {" S_colormap_ref "}",
"color dialog variables: {" S_color_cutoff "}, {" S_color_inverted "}, {" S_color_scale "}",
"start the color/orientation dialog: {" S_color_orientation_dialog "}",
@@ -2457,15 +2331,15 @@ static const char *raw_xrefs[7] = {
"specialize handing of raw sounds: {" S_open_raw_sound_hook "}",
"open a headerless sound: {" S_open_raw_sound "}",
"header type constants: {" S_mus_header_type_name "}",
- "data format constants: {" S_mus_data_format_name "}",
- "what are these data formats?",
+ "sample type constants: {" S_mus_sample_type_name "}",
+ "what are these sample types?",
"what are these headers?",
NULL};
static const char *raw_urls[7] = {
NULL, NULL, NULL, NULL,
- "extsnd.html#describedataformats",
- "extsnd.html#describeheadertypes",
+ "extsnd.html#sampletype",
+ "extsnd.html#headertype",
NULL
};
@@ -2477,7 +2351,7 @@ void raw_data_dialog_help(const char *info)
snd_help_with_xrefs("Raw Data",
"This file seems to have an invalid header. I'll append what sense I can make of it. \
To display and edit sound data, Snd needs to know how the data's sampling rate, number \
-of channels, and numerical format.\n\n",
+of channels, and sample type.\n\n",
WITH_WORD_WRAP,
raw_xrefs,
raw_urls);
@@ -2487,7 +2361,7 @@ of channels, and numerical format.\n\n",
{
snd_help_with_xrefs("Raw Data",
"To display and edit sound data, Snd needs to know how the data's sampling rate, number \
-of channels, and numerical format. This dialog gives you a chance to set those fields. \
+of channels, and sample type. This dialog gives you a chance to set those fields. \
To use the defaults, click the 'Reset' button.",
WITH_WORD_WRAP,
raw_xrefs,
@@ -2503,10 +2377,10 @@ void save_as_dialog_help(void)
snd_help_with_xrefs("Save As",
"You can save the current state of a file with File:Save As, or the current selection with Edit:Save as. \
-The output header type, data format, sampling rate, and comment can also be set. If the 'src' button \
+The output header type, sample type, sampling rate, and comment can also be set. If the 'src' button \
is not set, setting the srate does not affect the data -- it is just a number placed in the sound file header. \
Otherwise, if the output sampling rate differs from the current one, the data is converted to the new rate automatically. \
-The notation \"(be)\" in the data format lists stands for big endian; similarly, \"(le)\" is little endian.\
+The notation \"(be)\" in the sample type lists stands for big endian; similarly, \"(le)\" is little endian.\
If a file by the chosen name already exists \
it is overwritten, unless that file is already open in Snd and has edits. In that case, \
you'll be asked what to do. If you want to be warned whenever a file is about to be overwritten by this \
@@ -2537,6 +2411,7 @@ static const char *open_file_xrefs[] = {
void open_file_dialog_help(void)
{
+#if USE_MOTIF
snd_help_with_xrefs("Open File",
"The file selection dialog is slightly different from the Gtk or Motif default. If you single click \
@@ -2547,13 +2422,19 @@ in the directory list). \
The 'sound files only' button filters out all non-sound files from the files list (using the \
extension -- you can add to the list of sound file extensions via " S_add_sound_file_extension ". \
When a sound file is selected, information about it is posted under the lists, and a 'play' \
-button is displayed. If you have libgamin (fam), it is tied into the file list, so what you \
-see should always be up-to-date. The name field has <TAB> completion, of course, and also \
+button is displayed. The name field has <TAB> completion, of course, and also \
watches as you type a new name, reflecting that partial name by moving the file list to \
display possible matches.",
WITH_WORD_WRAP,
open_file_xrefs,
NULL);
+#else
+ snd_help_with_xrefs("Open File",
+ "This dialog provides a clumsy way to open a file.",
+ WITH_WORD_WRAP,
+ open_file_xrefs,
+ NULL);
+#endif
}
@@ -2609,22 +2490,22 @@ void find_dialog_help(void)
#define closure_example ": zero+ ( -- prc; n self -- val )\n lambda-create 0.0 ( lastn ) , latestxt 1 make-proc\n does> { n self -- val }\n self @ ( lastn ) f0< n f0>= && -1 && { rtn }\n n self ! ( lastn = n )\n rtn\n;"
#endif
- snd_help_with_xrefs("Global Find",
+ snd_help_with_xrefs("Search all sounds",
#if HAVE_EXTENSION_LANGUAGE
"This search travels through all the current channels in parallel until a match is found. The find \
expression is a function of one argument, the current sample value. It is evaluated on each sample, and should return " PROC_TRUE " when the \
search is satisfied. For example, \n\n " find_example "\n\nlooks for the next sample that is greater than .1. \
If you need to compare the current sample with a previous one, use a 'closure' as in " zero_plus " in \
-examp." XEN_FILE_EXTENSION ": \n\n" closure_example "\n\nThere are several other \
+examp." Xen_file_extension ": \n\n" closure_example "\n\nThere are several other \
search function examples in that file that search for peaks, clicks, or a particular pitch.",
#else
"This search mechanism is built on the extension language, which isn't available in this version of Snd.",
#endif
WITH_WORD_WRAP,
- snd_xrefs("Find"),
- snd_xref_urls("Find"));
+ snd_xrefs(I_FIND),
+ snd_xref_urls(I_FIND));
}
@@ -2660,7 +2541,7 @@ static const char *new_file_xrefs[5] = {
"open a new sound: {" S_new_sound "}",
"specialize making a new sound: {" S_new_sound_hook "}",
"header type constants: {" S_mus_header_type_name "}",
- "data format constants: {" S_mus_data_format_name "}",
+ "sample type constants: {" S_mus_sample_type_name "}",
NULL};
void new_file_dialog_help(void)
@@ -2668,16 +2549,15 @@ void new_file_dialog_help(void)
snd_help_with_xrefs("New File",
#if HAVE_EXTENSION_LANGUAGE
-"This dialog sets the new file's output header type, data format, srate, chans, and comment. \
+"This dialog sets the new file's output header type, sample type, srate, chans, and comment. \
The 'srate:' and 'channels:' labels are actually drop-down menus providing quick access to common choices. \
The default values for the fields can be set by clicking 'Reset'. These values \
-are " S_default_output_chans ", " S_default_output_data_format ", " S_default_output_srate ", and " S_default_output_header_type ". \
-The notation \"(be)\" in the data format lists stands for big endian; similarly, \"(le)\" is little endian.\
-The file name field can be set upon each invocation through " S_output_name_hook ", and the \
-comment field via " S_output_comment_hook ". Click 'Ok' to open the new sound. The actual new file representing the new sound is not written \
+are " S_default_output_chans ", " S_default_output_sample_type ", " S_default_output_srate ", and " S_default_output_header_type ". \
+The notation \"(be)\" in the sample type lists stands for big endian; similarly, \"(le)\" is little endian.\
+Click 'Ok' to open the new sound. The actual new file representing the new sound is not written \
until you save the new sound.",
#else
-"This dialog sets the new file's output header type, data format, srate, chans, and comment. \
+"This dialog sets the new file's output header type, sample type, srate, chans, and comment. \
The 'srate:' and 'channels:' labels are actually drop-down menus providing quick access to common choices. \
The default values for the fields can be set by clicking 'Reset'. Click 'Ok' to open the new sound. \
The actual new file representing the new sound is not written \
@@ -2693,22 +2573,22 @@ until you save the new sound.",
static const char *edit_header_xrefs[11] = {
"change srate: {" S_src_channel "}",
- "convert data to a new format: {" S_save_sound_as "}",
- "interpret current data in new data format: {" S_data_format "}",
+ "convert data to a new sample type: {" S_save_sound_as "}",
+ "interpret current data in new sample type: {" S_sample_type "}",
"convert header to a new type: {" S_save_sound_as "}",
"interpret current header differently: {" S_header_type "}",
"extract or combine chans: {mono->stereo}",
"change data location: {" S_data_location "}",
- "change number of samples: {frames}",
- "what are these data formats?",
+ "change number of samples: {framples}",
+ "what are these sample types?",
"what are these headers?",
NULL
};
static const char *edit_header_urls[11] = {
NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
- "extsnd.html#describedataformats",
- "extsnd.html#describeheadertypes",
+ "extsnd.html#sampletype",
+ "extsnd.html#headertype",
NULL
};
@@ -2718,7 +2598,7 @@ void edit_header_dialog_help(void)
snd_help_with_xrefs("Edit Header",
"This dialog edits the header of a sound file; no change is made to the actual sound data. \
-The notation \"(be)\" in the data format lists stands for big endian; similarly, \"(le)\" is little endian.\
+The notation \"(be)\" in the sample type lists stands for big endian; similarly, \"(le)\" is little endian.\
If you specify 'raw' as the type, any existing header is removed. This dialog is aimed at adding or removing an entire header, \
or editing the header comments; anything else is obviously dangerous.",
@@ -2775,8 +2655,7 @@ static const char *view_files_xrefs[5] = {
void view_files_dialog_help(void)
{
snd_help_with_xrefs("File Browser",
-
-#if HAVE_EXTENSION_LANGUAGE
+#if USE_MOTIF
"The View:Files dialog provides a list of sounds and various things to do with them.\
The play button plays the file. \
Double click a file name, and that file is opened in Snd. You can also mix or insert the \
@@ -2801,10 +2680,7 @@ The functions that refer to this dialog are: \n\
" S_view_files_speed ": dialog's speed value\n\
" S_view_files_speed_style ": dialog's speed style\n",
#else
-"The View:Files dialog provides a list of sounds and various things to do with them.\
-The play button plays the file. \
-Double click a file name, and that file is opened in Snd. You can also mix or insert the \
-selected file with amplitude envelopes and so on.",
+ "The View:Files dialog provides a list of files preloaded via the -p startup switch.",
#endif
WITH_WORD_WRAP,
view_files_xrefs,
@@ -2877,16 +2753,6 @@ static void reverse_help(void)
}
-static void noise_reduction_help(void)
-{
- snd_help_with_xrefs("Noise Reduction",
- "",
- WITH_WORD_WRAP,
- snd_xrefs("Noise Reduction"),
- snd_xref_urls("Noise Reduction"));
-}
-
-
static void random_numbers_help(void)
{
snd_help_with_xrefs("Random Numbers",
@@ -2932,17 +2798,22 @@ static void window_size_help(void)
}
+#if HAVE_SCHEME
+ #define S_Vct "Float-vector"
+#else
+ #define S_Vct "Vct"
+#endif
#include "snd-xref.c"
-#define NUM_TOPICS 39
+#define NUM_TOPICS 37
static const char *topic_names[NUM_TOPICS] = {
- "Hook", "Vct", "Sample reader", "Mark", "Mix", "Region", "Edit list", "Transform", "Error",
+ "Hook", S_Vct, "Sample reader", "Mark", "Mix", "Region", "Edit list", "Transform", "Error",
"Color", "Font", "Graphic", "Widget", "Emacs",
- "CLM", "Instrument", "CM", "CMN", "Libxm", "Sndlib",
+ "CLM", "Instrument", "CM", "CMN", "Sndlib",
"Motif", "Gtk", "Script", "Ruby", "s7", "LADSPA", "OpenGL", "Gdb", "Control panel",
"X resources", "Invocation flags", "Initialization file", "Customization",
- "Noise Reduction", "Window Size", "Color", "Random Number", "Wavogram",
+ "Window Size", "Color", "Random Number", "Wavogram",
"Forth"
};
@@ -2952,12 +2823,12 @@ static const char *topic_urls[NUM_TOPICS] = {
"extsnd.html#snderrors", "extsnd.html#colors", "extsnd.html#fonts", "extsnd.html#sndgraphics",
"extsnd.html#sndwidgets", "grfsnd.html#emacssnd", "grfsnd.html#sndwithclm",
"grfsnd.html#sndinstruments", "grfsnd.html#sndwithcm", "sndscm.html#musglyphs",
- "libxm.html#xm", "sndlib.html#introduction", "grfsnd.html#sndwithmotif",
+ "sndlib.html#introduction", "grfsnd.html#sndwithmotif",
"grfsnd.html#sndwithgtk", "grfsnd.html#sndwithnogui", "grfsnd.html#sndandruby", "grfsnd.html#sndands7",
"grfsnd.html#sndandladspa",
"grfsnd.html#sndandgl", "grfsnd.html#sndandgdb", "extsnd.html#customcontrols",
"grfsnd.html#sndresources", "grfsnd.html#sndswitches", "grfsnd.html#sndinitfile", "extsnd.html#extsndcontents",
- "extsnd.html#noisystory", "extsnd.html#movingwindows", "extsnd.html#colors", "sndscm.html#allrandomnumbers",
+ "extsnd.html#movingwindows", "extsnd.html#colors", "sndscm.html#allrandomnumbers",
"snd.html#wavogram", "grfsnd.html#sndandforth"
};
@@ -2980,12 +2851,12 @@ static const char *topic_url(const char *topic)
return(NULL);
}
-#define NUM_XREFS 35
+#define NUM_XREFS 33
static const char *xrefs[NUM_XREFS] = {
"Mark", "Mix", "Region", "Selection", "Cursor", "Tracking cursor", "Delete", "Envelope", "Filter",
"Search", "Insert", "Maxamp", "Play", "Reverse", "Save", "Smooth", "Resample", "FFT", "Reverb",
- "Src", "Find", "Undo", "Redo", "Sync", "Control panel", "Record", "Header", "Key", "Copy",
- "Noise Reduction", "Window Size", "Color", "Control", "Random Numbers", "Wavogram"
+ "Src", I_FIND, "Undo", "Redo", "Sync", "Control panel", "Header", "Key", "Copy",
+ "Window Size", "Color", "Control", "Random Numbers", "Wavogram"
};
static const char **xref_tables[NUM_XREFS] = {
@@ -2993,8 +2864,8 @@ static const char **xref_tables[NUM_XREFS] = {
Deletions_xrefs, Envelopes_xrefs, Filters_xrefs, Searching_xrefs, Insertions_xrefs, Maxamps_xrefs,
Playing_xrefs, Reversing_xrefs, Saving_xrefs, Smoothing_xrefs, Resampling_xrefs, FFTs_xrefs, Reverb_xrefs,
Resampling_xrefs, Searching_xrefs, Undo_and_Redo_xrefs, Undo_and_Redo_xrefs,
- sync_xrefs, control_xrefs, NULL, header_and_data_xrefs, key_xrefs, Copying_xrefs,
- Noise_Reduction_xrefs, Window_size_and_position_xrefs, Colors_xrefs, control_xrefs, Random_Numbers_xrefs,
+ sync_xrefs, control_xrefs, header_and_data_xrefs, key_xrefs, Copying_xrefs,
+ Window_size_and_position_xrefs, Colors_xrefs, control_xrefs, Random_Numbers_xrefs,
Wavogram_xrefs
};
@@ -3003,8 +2874,8 @@ static const char **xref_url_tables[NUM_XREFS] = {
Deletions_urls, Envelopes_urls, Filters_urls, Searching_urls, Insertions_urls, Maxamps_urls,
Playing_urls, Reversing_urls, Saving_urls, Smoothing_urls, Resampling_urls, FFTs_urls, Reverb_urls,
Resampling_urls, Searching_urls, Undo_and_Redo_urls, Undo_and_Redo_urls,
- NULL, NULL, NULL, NULL, NULL, Copying_urls,
- Noise_Reduction_urls, Window_size_and_position_urls, Colors_urls, NULL, Random_Numbers_urls,
+ NULL, NULL, NULL, NULL, Copying_urls,
+ Window_size_and_position_urls, Colors_urls, NULL, Random_Numbers_urls,
Wavogram_urls
};
@@ -3015,8 +2886,8 @@ static help_func help_funcs[NUM_XREFS] = {
&delete_help, &env_help, &filter_help, &find_help, &insert_help, &maxamp_help,
&play_help, &reverse_help, &save_help, &smooth_help, &resample_help, &fft_help, &reverb_help,
&resample_help, &find_help, &undo_help, &undo_help,
- &sync_help, &controls_help, recording_help, &sound_files_help, &key_binding_help, ©_help,
- &noise_reduction_help, &window_size_help, &colors_help, &controls_help, &random_numbers_help,
+ &sync_help, &controls_help, &sound_files_help, &key_help, ©_help,
+ &window_size_help, &colors_help, &controls_help, &random_numbers_help,
&wavogram_help
};
@@ -3041,25 +2912,27 @@ static const char **snd_xref_urls(const char *topic)
}
-static int levenstein(const char *s1, const char *s2)
+static int levenshtein(const char *s1, int l1, const char *s2, int l2)
{
- /* taken with bug fixes from "The Ruby Way" by Hal Fulton, SAMS Pubs */
- int l1, l2, i, j, val, insert_cost = 2, delete_cost = 2, substitute_cost = 1;
+ /* taken with bug fixes from "The Ruby Way" by Hal Fulton, SAMS Pubs
+ */
+ int i, j, val;
int **distance;
- l1 = mus_strlen(s1);
- l2 = mus_strlen(s2);
- if ((l1 == 0) || (l2 == 0)) return(1000);
+
+ if (!s1) return(l2);
+ if (!s2) return(l1);
+
distance = (int **)calloc(l2 + 1, sizeof(int *));
for (i = 0; i <= l2; i++) distance[i] = (int *)calloc(l1 + 1, sizeof(int));
- for (j = 0; j <= l1; j++) distance[0][j] = j * insert_cost;
- for (i = 0; i <= l2; i++) distance[i][0] = i * delete_cost;
+ for (j = 0; j <= l1; j++) distance[0][j] = j;
+ for (i = 0; i <= l2; i++) distance[i][0] = i;
for (i = 1; i <= l2; i++)
for (j = 1; j <= l1; j++)
{
int c1, c2, c3;
- c1 = distance[i][j - 1] + insert_cost;
- c2 = distance[i - 1][j] + delete_cost;
- c3 = distance[i - 1][j - 1] + (((s2[i - 1] == s1[j - 1]) || (toupper(s2[i - 1]) == toupper(s1[j - 1]))) ? 0 : substitute_cost);
+ c1 = distance[i][j - 1] + 1;
+ c2 = distance[i - 1][j] + 1;
+ c3 = distance[i - 1][j - 1] + ((s2[i - 1] == s1[j - 1]) ? 0 : 1);
if (c1 > c2) c1 = c2;
if (c1 > c3) c1 = c3;
distance[i][j] = c1;
@@ -3107,13 +2980,12 @@ static char *call_grep(const char *defstr, const char *name, const char *endstr,
{
int err;
char *command;
-#if (!HAVE_SUN)
+#ifndef __sun
/* Gnu fgrep: -s switch to fgrep = "silent", I guess (--no-messages) [OSX uses Gnu fgrep] */
- /* configure script looks for grep -F or fgrep, setting FGREP_PROG (fgrep is supposedly obsolete) */
- command = mus_format(FGREP_PROG " -s \"%s%s%s\" %s/*." XEN_FILE_EXTENSION " --line-number > %s", defstr, name, endstr, path, tempfile);
+ command = mus_format("grep -F -s \"%s%s%s\" %s/*." Xen_file_extension " --line-number > %s", defstr, name, endstr, path, tempfile);
#else
/* Sun fgrep: here -s means -q and --line-number prints an error message */
- command = mus_format(FGREP_PROG " \"%s%s%s\" %s/*." XEN_FILE_EXTENSION " > %s", defstr, name, endstr, path, tempfile);
+ command = mus_format("grep -F \"%s%s%s\" %s/*." Xen_file_extension " > %s", defstr, name, endstr, path, tempfile);
#endif
err = system(command);
free(command);
@@ -3128,9 +3000,9 @@ static char *snd_finder(const char *name, bool got_help)
/* desperation -- search *.scm/rb/fs then even *.html? for 'name' */
const char *url = NULL;
char *fgrep = NULL, *tempfile = NULL, *command = NULL;
- bool is_defined = false;
+ bool is_defined;
int a_def = 0, dir_len = 0, i;
- XEN dirs = XEN_EMPTY_LIST;
+ Xen dirs = Xen_empty_list;
#if HAVE_SCHEME || (!HAVE_EXTENSION_LANGUAGE)
#define NUM_DEFINES 7
@@ -3150,28 +3022,45 @@ static char *snd_finder(const char *name, bool got_help)
const char *defines[NUM_DEFINES] = {": ", "instrument: ", "event: "};
#endif
- if (mus_strlen(FGREP_PROG) == 0) return(NULL); /* configure didn't find a plausible fgrep */
+ is_defined = Xen_is_defined(name);
+
+#if HAVE_SCHEME
+ {
+ s7_pointer help;
+ fgrep = mus_format("(*autoload* '%s)", name);
+ help = s7_eval_c_string(s7, fgrep);
+ free(fgrep);
+ fgrep = NULL;
+ if (help != Xen_false)
+ {
+ command = mus_format("%s is defined in %s", name, s7_object_to_c_string(s7, help));
+ return(command);
+ }
+ }
+#endif
- is_defined = XEN_DEFINED_P(name);
url = snd_url(name);
tempfile = snd_tempnam(); /* this will have a .snd extension */
- dirs = XEN_LOAD_PATH;
- dir_len = XEN_LIST_LENGTH(dirs);
+ dirs = Xen_load_path;
+ dir_len = Xen_list_length(dirs);
for (i = 0; (!fgrep) && (i < dir_len); i++)
{
- const char *path;
- path = XEN_TO_C_STRING(XEN_LIST_REF(dirs, i));
- if (!path) continue;
+ if (Xen_is_string(Xen_list_ref(dirs, i))) /* *load-path* might have garbage */
+ {
+ const char *path;
+ path = Xen_string_to_C_string(Xen_list_ref(dirs, i));
+ if (!path) continue;
- for (a_def = 0; (!fgrep) && (a_def < NUM_DEFINES); a_def++)
- fgrep = call_grep(defines[a_def], name, TRAILER, path, tempfile);
+ for (a_def = 0; (!fgrep) && (a_def < NUM_DEFINES); a_def++)
+ fgrep = call_grep(defines[a_def], name, TRAILER, path, tempfile);
#if HAVE_SCHEME
- if (!fgrep)
- fgrep = call_grep("(define (", name, ")", path, tempfile);
- if (!fgrep)
- fgrep = call_grep("(define ", name, "\n", path, tempfile);
+ if (!fgrep)
+ fgrep = call_grep("(define (", name, ")", path, tempfile);
+ if (!fgrep)
+ fgrep = call_grep("(define ", name, "\n", path, tempfile);
#endif
+ }
}
snd_remove(tempfile, IGNORE_CACHE);
free(tempfile);
@@ -3254,11 +3143,12 @@ bool snd_topic_help(const char *topic)
/* try respelling topic */
{
- int min_diff = 1000, min_loc = 0, this_diff;
+ int min_diff = 1000, min_loc = 0, this_diff, topic_len;
+ topic_len = mus_strlen(topic);
for (i = 0; i < NUM_XREFS; i++)
if (help_funcs[i])
{
- this_diff = levenstein(topic, xrefs[i]);
+ this_diff = levenshtein(topic, topic_len, xrefs[i], mus_strlen(xrefs[i]));
if (this_diff < min_diff)
{
min_diff = this_diff;
@@ -3392,7 +3282,7 @@ char *word_wrap(const char *text, int widget_len)
}
else
{
- if ((text[i] == '#') && (i < old_len))
+ if ((i < old_len) && (text[i] == '#'))
{
if (text[i + 1] == 'f')
{
@@ -3487,7 +3377,7 @@ static const char *doc_files[DOC_DIRECTORIES] = {
"/usr/share/docs/snd-" SND_VERSION "/snd.html"
};
-static char *html_directory(void)
+static const char *html_directory(void)
{
int i;
if (mus_file_probe("snd.html"))
@@ -3503,16 +3393,16 @@ static char *html_directory(void)
snprintf(hd, len, "%s/snd.html", html_dir(ss));
happy = mus_file_probe(hd);
free(hd);
- if (happy) return(mus_strdup(html_dir(ss)));
+ if (happy) return(html_dir(ss));
}
#ifdef MUS_DEFAULT_DOC_DIR
if (mus_file_probe(MUS_DEFAULT_DOC_DIR "/snd.html"))
- return(mus_strdup(MUS_DEFAULT_DOC_DIR));
+ return(MUS_DEFAULT_DOC_DIR);
#endif
for (i = 0; i < DOC_DIRECTORIES; i++)
- if (mus_file_probe(doc_files[i])) return(mus_strdup(doc_directories[i]));
+ if (mus_file_probe(doc_files[i])) return(doc_directories[i]);
return(NULL);
}
@@ -3520,7 +3410,7 @@ static char *html_directory(void)
void url_to_html_viewer(const char *url)
{
- char *dir_path;
+ const char *dir_path;
dir_path = html_directory();
if (dir_path)
@@ -3533,13 +3423,12 @@ void url_to_html_viewer(const char *url)
int len, err;
len = strlen(dir_path) + strlen(url) + 256;
path = (char *)calloc(len, sizeof(char));
- snprintf(path, len, "%s file:%s/%s", program, dir_path, url);
+ snprintf(path, len, "%s file:%s/%s &", program, dir_path, url);
err = system(path);
if (err == -1)
fprintf(stderr, "can't start %s?", program);
free(path);
}
- free(dir_path);
}
}
@@ -3554,73 +3443,45 @@ void name_to_html_viewer(const char *red_text)
}
-static XEN help_hook;
-static XEN output_comment_hook;
+static Xen output_comment_hook;
-static char *run_string_hook(XEN hook, const char *caller, char *initial_string, char *subject)
+char *output_comment(file_info *hdr)
{
- /* no longer concats -- now just passes successive results along */
- if (XEN_HOOKED(hook))
+ Xen hook;
+ hook = output_comment_hook;
+ if (Xen_hook_has_list(hook))
{
-#if HAVE_SCHEME
- int gc_loc1, gc_loc2;
-#endif
- XEN result, substr;
- XEN procs = XEN_HOOK_PROCEDURES(hook);
-
- result = C_TO_XEN_STRING(initial_string);
-#if HAVE_SCHEME
- gc_loc1 = s7_gc_protect(s7, result);
-#endif
-
- substr = C_TO_XEN_STRING(subject);
-#if HAVE_SCHEME
- gc_loc2 = s7_gc_protect(s7, substr);
-#endif
-
- while (XEN_NOT_NULL_P(procs))
- {
-#if (!HAVE_SCHEME)
- if (subject)
- result = XEN_CALL_2(XEN_CAR(procs), substr, result, caller);
- else result = XEN_CALL_1(XEN_CAR(procs), result, caller);
-#else
- if (subject)
- result = XEN_CALL_2(XEN_CAR(procs), substr, result, caller);
- else result = XEN_CALL_1(XEN_CAR(procs), result, caller);
- s7_gc_unprotect_at(s7, gc_loc1);
- gc_loc1 = s7_gc_protect(s7, result);
-#endif
- procs = XEN_CDR(procs);
- }
+ Xen result;
+ result = C_string_to_Xen_string((hdr) ? hdr->comment : NULL);
#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc1);
- s7_gc_unprotect_at(s7, gc_loc2);
+ result = s7_call(s7, hook, s7_cons(s7, result, s7_nil(s7)));
+#else
+ {
+ Xen procs;
+ procs = Xen_hook_list(hook);
+ while (!Xen_is_null(procs))
+ {
+ result = Xen_call_with_1_arg(Xen_car(procs), result, S_output_comment_hook);
+ procs = Xen_cdr(procs);
+ }
+ }
#endif
-
- if (XEN_STRING_P(result))
- return(mus_strdup(XEN_TO_C_STRING(result)));
+ if (Xen_is_string(result))
+ return(mus_strdup(Xen_string_to_C_string(result)));
}
- return(mus_strdup(initial_string));
+ return(mus_strdup((hdr) ? hdr->comment : NULL));
}
-char *output_comment(file_info *hdr)
-{
- return(run_string_hook(output_comment_hook,
- S_output_comment_hook,
- (hdr) ? hdr->comment : NULL,
- NULL));
-}
+static Xen help_hook;
-
-XEN g_snd_help_with_search(XEN text, int widget_wid, bool search)
+Xen g_snd_help_with_search(Xen text, int widget_wid, bool search)
{
/* snd-help but no search for misspelled name if search=false */
#if HAVE_SCHEME
- #define snd_help_example "(snd-help 'make-vct)"
+ #define snd_help_example "(snd-help 'make-float-vector)"
#define snd_help_arg_type "can be a string, symbol, or in some cases, the object itself"
#endif
#if HAVE_RUBY
@@ -3633,68 +3494,69 @@ XEN g_snd_help_with_search(XEN text, int widget_wid, bool search)
#endif
#define H_snd_help "(" S_snd_help " :optional (arg 'snd-help) (formatted " PROC_TRUE ")): return the documentation \
-associated with its argument. " snd_help_example " for example, prints out a brief description of make-vct. \
+associated with its argument. " snd_help_example " for example, prints out a brief description of make-" S_vct ". \
The argument " snd_help_arg_type ". \
-In the help descriptions, optional arguments are in parens with the default value (if any) as the 2nd entry. \
-A ':' as the start of the argument name marks a CLM-style optional keyword argument. If you load index." XEN_FILE_EXTENSION " \
+In the help descriptions, optional arguments are in parens with the default value (if any) as the second entry. \
+A ':' as the start of the argument name marks a CLM-style optional keyword argument. If you load index." Xen_file_extension " \
the functions html and ? can be used in place of help to go to the HTML description, \
and the location of the associated C code will be displayed, if it can be found. \
If " S_help_hook " is not empty, it is invoked with the subject and the snd-help result \
and its value is returned."
-
char *str = NULL, *subject = NULL;
- int min_diff = 1000;
+
+ if (Xen_is_keyword(text))
+ return(C_string_to_Xen_string("keyword"));
#if HAVE_RUBY
- if (XEN_STRING_P(text))
- subject = XEN_TO_C_STRING(text);
+ if (Xen_is_string(text))
+ subject = Xen_string_to_C_string(text);
else
- if ((XEN_SYMBOL_P(text)) && (XEN_BOUND_P(text)))
+ if ((Xen_is_symbol(text)) && (Xen_is_bound(text)))
{
text = XEN_SYMBOL_TO_STRING(text);
- subject = XEN_TO_C_STRING(text);
+ subject = Xen_string_to_C_string(text);
}
else
{
char *temp;
temp = xen_scheme_procedure_to_ruby(S_snd_help);
- text = C_TO_XEN_STRING(temp);
+ text = C_string_to_Xen_string(temp);
if (temp) free(temp);
}
- str = XEN_AS_STRING(XEN_OBJECT_HELP(text));
+ str = Xen_object_to_C_string(Xen_documentation(text));
#endif
#if HAVE_FORTH
- if (XEN_STRING_P(text)) /* "play" snd-help */
- subject = XEN_TO_C_STRING(text);
- else if (XEN_NOT_BOUND_P(text)) /* snd-help play */
+ if (Xen_is_string(text)) /* "play" snd-help */
+ subject = Xen_string_to_C_string(text);
+ else if (!Xen_is_bound(text)) /* snd-help play */
{
subject = fth_parse_word();
- text = C_TO_XEN_STRING(subject);
+ text = C_string_to_Xen_string(subject);
}
if (!subject)
{
subject = S_snd_help;
- text = C_TO_XEN_STRING(S_snd_help);
+ text = C_string_to_Xen_string(S_snd_help);
}
- str = XEN_AS_STRING(XEN_OBJECT_HELP(text));
+ str = Xen_object_to_C_string(Xen_documentation(text));
#endif
#if HAVE_SCHEME
{
- /* hooks and vars are broken here */
- XEN sym = XEN_FALSE;
- if (XEN_STRING_P(text))
+ Xen sym = Xen_false;
+ if (Xen_is_string(text))
{
- subject = (char *)XEN_TO_C_STRING(text);
+ subject = (char *)Xen_string_to_C_string(text);
sym = s7_name_to_value(s7, subject);
}
else
{
- if (XEN_SYMBOL_P(text))
+ if (Xen_is_symbol(text))
{
- subject = (char *)XEN_SYMBOL_TO_C_STRING(text);
+ subject = (char *)Xen_symbol_to_C_string(text);
+ str = (char *)s7_help(s7, text);
sym = s7_symbol_value(s7, text);
}
else
@@ -3703,45 +3565,58 @@ and its value is returned."
}
}
- if (XEN_PROCEDURE_P(sym))
+ if (!str) str = (char *)s7_help(s7, sym);
+
+ if ((str == NULL) ||
+ (mus_strlen(str) == 0))
{
- str = (char *)s7_procedure_documentation(s7, sym);
- if ((str == NULL) || (mus_strlen(str) == 0))
+ if (Xen_is_procedure(sym))
{
- const char *url = NULL;
- s7_pointer x;
+ str = (char *)s7_procedure_documentation(s7, sym);
- /* (cdr (assoc '__func__ (car (procedure-environment func))) => (name file line) or name */
- x = s7_procedure_environment(sym);
- if (s7_is_pair(x))
+ if (((str == NULL) ||
+ (mus_strlen(str) == 0)) &&
+ (s7_funclet(s7, sym) != sym))
{
- x = s7_cdr(s7_assoc(s7, s7_make_symbol(s7, "__func__"), s7_car(x)));
- if (s7_is_pair(x))
+ s7_pointer e;
+ e = s7_funclet(s7, sym);
+ str = (char *)calloc(256, sizeof(char));
+ /* unavoidable memleak I guess -- we could use a backup statically allocated buffer here */
+ if (s7_is_null(s7, e))
+ snprintf(str, 256, "this function appears to come from eval or eval-string?");
+ else
{
- subject = (char *)s7_symbol_name(s7_car(x));
- url = snd_url(subject);
- /* unavoidable memleak I guess */
- str = (char *)calloc(256, sizeof(char));
- if (url)
- mus_snprintf(str, 256, "%s is defined at line %lld of %s, and documented at %s",
- subject,
- s7_integer(s7_car(s7_cdr(s7_cdr(x)))),
- s7_string(s7_car(s7_cdr(x))),
- url);
- else
- mus_snprintf(str, 256, "%s is defined at line %lld of %s",
- subject,
- s7_integer(s7_car(s7_cdr(s7_cdr(x)))),
- s7_string(s7_car(s7_cdr(x))));
+ s7_pointer x;
+ /* (cdr (assoc '__func__ (let->list (funclet func)))) => (name file line) or name */
+ x = s7_assoc(s7, s7_make_symbol(s7, "__func__"), s7_let_to_list(s7, e));
+ if (s7_is_pair(x))
+ {
+ x = s7_cdr(x);
+ if (s7_is_pair(x))
+ {
+ const char *url;
+ subject = (char *)s7_symbol_name(s7_car(x));
+ url = snd_url(subject);
+ if (url)
+ snprintf(str, 256, "%s is defined at line %lld of %s, and documented at %s",
+ subject,
+ (long long int)s7_integer(s7_car(s7_cdr(s7_cdr(x)))),
+ s7_string(s7_car(s7_cdr(x))),
+ url);
+ else
+ snprintf(str, 256, "%s is defined at line %lld of %s",
+ subject,
+ (long long int)s7_integer(s7_car(s7_cdr(s7_cdr(x)))),
+ s7_string(s7_car(s7_cdr(x))));
+ }
+ }
}
}
}
- }
- else
- {
- if (XEN_HOOK_P(sym))
- str = (char *)s7_hook_documentation(sym);
- else str = (char *)xen_s7_constant_help(subject);
+ else
+ {
+ str = s7_symbol_documentation(s7, s7_make_symbol(s7, subject));
+ }
}
}
#endif
@@ -3754,64 +3629,81 @@ and its value is returned."
(mus_strlen(str) == 0) ||
(strcmp(str, PROC_FALSE) == 0)) /* Ruby returns "false" here */
{
- if (!subject) return(XEN_FALSE);
+ if (!subject) return(Xen_false);
str = snd_finder(subject, false);
need_free = true;
}
- else
+ if (str)
{
- if ((min_diff < 1000) && (min_diff > 0))
+ Xen help_text = Xen_false; /* so that we can free "str" */
+ char *new_str = NULL;
+ if (subject)
{
- char *more_str;
- more_str = snd_finder(subject, true);
- if (more_str)
+ Xen hook;
+ hook = help_hook;
+ if (Xen_hook_has_list(hook))
{
- str = mus_format("%s\nOther possibilities:\n%s", str, more_str);
- need_free = true;
- free(more_str);
+ Xen result, subj;
+
+ result = C_string_to_Xen_string(str);
+ subj = C_string_to_Xen_string(subject);
+
+#if HAVE_SCHEME
+ result = s7_call(s7, hook, s7_cons(s7, subj, s7_cons(s7, result, s7_nil(s7))));
+#else
+ {
+ Xen procs;
+ procs = Xen_hook_list(hook);
+ while (!Xen_is_null(procs))
+ {
+ result = Xen_call_with_2_args(Xen_car(procs), subj, result, S_help_hook);
+ procs = Xen_cdr(procs);
+ }
+ }
+#endif
+ if (Xen_is_string(result))
+ new_str = mus_strdup(Xen_string_to_C_string(result));
+ else new_str = mus_strdup(str);
}
+ else new_str = mus_strdup(str);
}
- }
- if (str)
- {
- XEN help_text = XEN_FALSE; /* so that we can free "str" */
- char *new_str = NULL;
- if (subject)
- new_str = run_string_hook(help_hook, S_help_hook, str, subject);
else new_str = mus_strdup(str);
if (need_free)
{
free(str);
str = NULL;
}
+#if (!USE_GTK)
if (widget_wid > 0)
{
str = word_wrap(new_str, widget_wid);
if (new_str) free(new_str);
}
- else str = new_str;
- help_text = C_TO_XEN_STRING(str);
+ else
+#endif
+ str = new_str;
+ help_text = C_string_to_Xen_string(str);
if (str) free(str);
return(help_text);
}
}
if (str)
- return(C_TO_XEN_STRING(str));
- return(XEN_FALSE);
+ return(C_string_to_Xen_string(str));
+ return(Xen_false);
}
-XEN g_snd_help(XEN text, int widget_wid)
+Xen g_snd_help(Xen text, int widget_wid)
{
return(g_snd_help_with_search(text, widget_wid, true));
}
-static XEN g_listener_help(XEN arg, XEN formatted)
+static Xen g_listener_help(Xen arg, Xen formatted)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(formatted), formatted, XEN_ARG_2, S_snd_help, "a boolean");
- if (XEN_FALSE_P(formatted))
+ Xen_check_type(Xen_is_boolean_or_unbound(formatted), formatted, 2, S_snd_help, "a boolean");
+ if (Xen_is_false(formatted))
return(g_snd_help(arg, 0));
return(g_snd_help(arg, listener_width()));
}
@@ -3824,57 +3716,57 @@ void set_html_dir(char *new_dir)
}
-static XEN g_html_dir(void)
+static Xen g_html_dir(void)
{
#define H_html_dir "(" S_html_dir "): location of Snd documentation"
- return(C_TO_XEN_STRING(html_dir(ss)));
+ return(C_string_to_Xen_string(html_dir(ss)));
}
-static XEN g_set_html_dir(XEN val)
+static Xen g_set_html_dir(Xen val)
{
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_html_dir, "a string");
- set_html_dir(mus_strdup(XEN_TO_C_STRING(val)));
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_html_dir, "a string");
+ set_html_dir(mus_strdup(Xen_string_to_C_string(val)));
return(val);
}
-static XEN g_html_program(void)
+static Xen g_html_program(void)
{
#define H_html_program "(" S_html_program "): name of documentation reader (mozilla, by default)"
- return(C_TO_XEN_STRING(html_program(ss)));
+ return(C_string_to_Xen_string(html_program(ss)));
}
-static XEN g_set_html_program(XEN val)
+static Xen g_set_html_program(Xen val)
{
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_html_program, "a string");
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_html_program, "a string");
if (html_program(ss)) free(html_program(ss));
- set_html_program(mus_strdup(XEN_TO_C_STRING(val)));
+ set_html_program(mus_strdup(Xen_string_to_C_string(val)));
return(val);
}
-static XEN g_snd_url(XEN name)
+static Xen g_snd_url(Xen name)
{
#define H_snd_url "(" S_snd_url " name): url corresponding to 'name'"
/* given Snd entity ('open-sound) as symbol or string return associated url */
- XEN_ASSERT_TYPE(XEN_STRING_P(name) || XEN_SYMBOL_P(name), name, XEN_ONLY_ARG, S_snd_url, "a string or symbol");
- if (XEN_STRING_P(name))
- return(C_TO_XEN_STRING(snd_url(XEN_TO_C_STRING(name))));
- return(C_TO_XEN_STRING(snd_url(XEN_SYMBOL_TO_C_STRING(name))));
+ Xen_check_type(Xen_is_string(name) || Xen_is_symbol(name), name, 1, S_snd_url, "a string or symbol");
+ if (Xen_is_string(name))
+ return(C_string_to_Xen_string(snd_url(Xen_string_to_C_string(name))));
+ return(C_string_to_Xen_string(snd_url(Xen_symbol_to_C_string(name))));
}
-static XEN g_snd_urls(void)
+static Xen g_snd_urls(void)
{
#define H_snd_urls "(" S_snd_urls "): list of all snd names with the associated url (a list of lists)"
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
#if HAVE_EXTENSION_LANGUAGE
int i;
for (i = 0; i < HELP_NAMES_SIZE; i++)
- lst = XEN_CONS(XEN_CONS(C_TO_XEN_STRING(help_names[i]),
- C_TO_XEN_STRING(help_urls[i])),
+ lst = Xen_cons(Xen_cons(C_string_to_Xen_string(help_names[i]),
+ C_string_to_Xen_string(help_urls[i])),
lst);
#endif
return(lst);
@@ -3883,153 +3775,97 @@ static XEN g_snd_urls(void)
static const char **refs = NULL, **urls = NULL;
-static XEN g_help_dialog(XEN subject, XEN msg, XEN xrefs, XEN xurls)
+static Xen g_help_dialog(Xen subject, Xen msg, Xen xrefs, Xen xurls)
{
#define H_help_dialog "(" S_help_dialog " subject message xrefs urls): start the Help window with subject and message"
- widget_t w;
- XEN_ASSERT_TYPE(XEN_STRING_P(subject), subject, XEN_ARG_1, S_help_dialog, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(msg), msg, XEN_ARG_2, S_help_dialog, "a string");
- XEN_ASSERT_TYPE(XEN_LIST_P(xrefs) || XEN_NOT_BOUND_P(xrefs), xrefs, XEN_ARG_3, S_help_dialog, "a list of related references");
- XEN_ASSERT_TYPE(XEN_LIST_P(xurls) || XEN_NOT_BOUND_P(xurls), xurls, XEN_ARG_4, S_help_dialog, "a list of urls");
+
+ Xen_check_type(Xen_is_string(subject), subject, 1, S_help_dialog, "a string");
+ Xen_check_type(Xen_is_string(msg), msg, 2, S_help_dialog, "a string");
+ Xen_check_type(Xen_is_list(xrefs) || !Xen_is_bound(xrefs), xrefs, 3, S_help_dialog, "a list of related references");
+ Xen_check_type(Xen_is_list(xurls) || !Xen_is_bound(xurls), xurls, 4, S_help_dialog, "a list of urls");
+
if (refs) {free(refs); refs = NULL;}
if (urls) {free(urls); urls = NULL;}
- if (XEN_LIST_P(xrefs))
+
+ if (Xen_is_list(xrefs))
{
int i, len;
- len = XEN_LIST_LENGTH(xrefs);
+
+ len = Xen_list_length(xrefs);
refs = (const char **)calloc(len + 1, sizeof(char *));
+
for (i = 0; i < len; i++)
- if (XEN_STRING_P(XEN_LIST_REF(xrefs, i)))
- refs[i] = XEN_TO_C_STRING(XEN_LIST_REF(xrefs, i));
- if (XEN_LIST_P(xurls))
+ if (Xen_is_string(Xen_list_ref(xrefs, i)))
+ refs[i] = Xen_string_to_C_string(Xen_list_ref(xrefs, i));
+
+ if (Xen_is_list(xurls))
{
int ulen;
- ulen = XEN_LIST_LENGTH(xurls);
+ ulen = Xen_list_length(xurls);
if (ulen > len) ulen = len;
urls = (const char **)calloc(ulen + 1, sizeof(char *));
for (i = 0; i < ulen; i++)
- if (XEN_STRING_P(XEN_LIST_REF(xurls, i)))
- urls[i] = XEN_TO_C_STRING(XEN_LIST_REF(xurls, i));
+ if (Xen_is_string(Xen_list_ref(xurls, i)))
+ urls[i] = Xen_string_to_C_string(Xen_list_ref(xurls, i));
}
- w = snd_help_with_xrefs(XEN_TO_C_STRING(subject),
- XEN_TO_C_STRING(msg),
- WITH_WORD_WRAP,
- refs,
- urls);
+ return(Xen_wrap_widget(snd_help_with_xrefs(Xen_string_to_C_string(subject),
+ Xen_string_to_C_string(msg),
+ WITH_WORD_WRAP,
+ refs,
+ urls)));
}
- else w = snd_help(XEN_TO_C_STRING(subject),
- XEN_TO_C_STRING(msg),
- WITH_WORD_WRAP);
- return(XEN_WRAP_WIDGET(w));
+ return(Xen_wrap_widget(snd_help(Xen_string_to_C_string(subject),
+ Xen_string_to_C_string(msg),
+ WITH_WORD_WRAP)));
}
-#if HAVE_SCHEME
-#define S_autoload_file "autoload-file"
+Xen_wrap_2_optional_args(g_listener_help_w, g_listener_help)
+Xen_wrap_no_args(g_html_dir_w, g_html_dir)
+Xen_wrap_1_arg(g_set_html_dir_w, g_set_html_dir)
+Xen_wrap_no_args(g_html_program_w, g_html_program)
+Xen_wrap_1_arg(g_set_html_program_w, g_set_html_program)
+Xen_wrap_1_arg(g_snd_url_w, g_snd_url)
+Xen_wrap_no_args(g_snd_urls_w, g_snd_urls)
+Xen_wrap_4_optional_args(g_help_dialog_w, g_help_dialog)
-static XEN g_autoload_file(XEN symbol_name)
-{
- #define H_autoload_file "(autoload-file symbol-name) looks for the file that contains a definition of the variable \
-whose name (as a string) is 'symbol-name'"
-
- int i;
- const char *name;
- name = XEN_TO_C_STRING(symbol_name);
-
- for (i = 0; i < AUTOLOAD_NAMES; i++)
- if (strcmp(name, autoload_names[i]) == 0)
- {
- const char *filename;
- char *str;
- int len;
- XEN result;
-
- filename = autoload_files[autoload_indices[i]];
- if (mus_file_probe(filename))
- return(C_TO_XEN_STRING(filename));
-
- /* try /usr/local/share/snd */
- len = strlen(filename) + 32;
- str = (char *)calloc(len, sizeof(char));
- snprintf(str, len, "/usr/local/share/snd/%s", filename);
- if (mus_file_probe(str))
- {
- result = C_TO_XEN_STRING(str);
- free(str);
- return(result);
- }
-
- /* try /usr/lib/snd/scheme */
- snprintf(str, len, "/usr/lib/snd/scheme/%s", filename);
- if (mus_file_probe(str))
- {
- result = C_TO_XEN_STRING(str);
- free(str);
- return(result);
- }
-
- /* no luck */
- free(str);
- }
-
- return(XEN_FALSE);
-}
-#endif
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_2(g_listener_help_w, g_listener_help)
-XEN_NARGIFY_0(g_html_dir_w, g_html_dir)
-XEN_NARGIFY_1(g_set_html_dir_w, g_set_html_dir)
-XEN_NARGIFY_0(g_html_program_w, g_html_program)
-XEN_NARGIFY_1(g_set_html_program_w, g_set_html_program)
-XEN_NARGIFY_1(g_snd_url_w, g_snd_url)
-XEN_NARGIFY_0(g_snd_urls_w, g_snd_urls)
-XEN_ARGIFY_4(g_help_dialog_w, g_help_dialog)
#if HAVE_SCHEME
-XEN_NARGIFY_1(g_autoload_file_w, g_autoload_file)
-#endif
-#else
-#define g_listener_help_w g_listener_help
-#define g_html_dir_w g_html_dir
-#define g_set_html_dir_w g_set_html_dir
-#define g_html_program_w g_html_program
-#define g_set_html_program_w g_set_html_program
-#define g_snd_url_w g_snd_url
-#define g_snd_urls_w g_snd_urls
-#define g_help_dialog_w g_help_dialog
-#if HAVE_SCHEME
-#define g_autoload_file_w g_autoload_file
-#endif
+static s7_pointer acc_html_dir(s7_scheme *sc, s7_pointer args) {return(g_set_html_dir(s7_cadr(args)));}
+static s7_pointer acc_html_program(s7_scheme *sc, s7_pointer args) {return(g_set_html_program(s7_cadr(args)));}
#endif
void g_init_help(void)
{
- XEN_DEFINE_PROCEDURE(S_snd_help, g_listener_help_w, 0, 2, 0, H_snd_help);
+ Xen_define_procedure(S_snd_help, g_listener_help_w, 0, 2, 0, H_snd_help);
#if HAVE_SCHEME
- XEN_DEFINE_PROCEDURE("help", g_listener_help_w, 0, 2, 0, H_snd_help); /* override s7's help */
+ Xen_eval_C_string("(define s7-help help)");
+ Xen_define_procedure("help", g_listener_help_w, 0, 2, 0, H_snd_help); /* override s7's help */
#endif
- XEN_DEFINE_PROCEDURE(S_snd_url, g_snd_url_w, 1, 0, 0, H_snd_url);
- XEN_DEFINE_PROCEDURE(S_snd_urls, g_snd_urls_w, 0, 0, 0, H_snd_urls);
- XEN_DEFINE_PROCEDURE(S_help_dialog, g_help_dialog_w, 2, 2, 0, H_help_dialog);
+ Xen_define_safe_procedure(S_snd_url, g_snd_url_w, 1, 0, 0, H_snd_url);
+ Xen_define_safe_procedure(S_snd_urls, g_snd_urls_w, 0, 0, 0, H_snd_urls);
+ Xen_define_safe_procedure(S_help_dialog, g_help_dialog_w, 2, 2, 0, H_help_dialog);
- #define H_help_hook S_help_hook "(subject help-string): called from " S_snd_help ". If \
-it returns a string, it replaces 'help-string' (the default help)"
+ #define H_help_hook S_help_hook "(subject message): called from " S_snd_help ". If \
+it returns a string, it replaces 'message' (the default help)"
- help_hook = XEN_DEFINE_HOOK(S_help_hook, 2, H_help_hook); /* args = subject help-string */
+ help_hook = Xen_define_hook(S_help_hook, "(make-hook 'subject 'message)", 2, H_help_hook);
#if HAVE_SCHEME
- #define H_output_comment_hook S_output_comment_hook " (str): called in Save-As dialog, passed current sound's comment, if any. \
+ #define H_output_comment_hook S_output_comment_hook " (comment): called in Save-As dialog, passed current sound's comment, if any. \
If more than one hook function, each function gets the previous function's output as its input.\n\
- (add-hook! " S_output_comment_hook "\n\
- (lambda (str)\n\
- (string-append str \": written \"\n\
- (strftime \"%a %d-%b-%Y %H:%M %Z\"\n\
- (localtime (current-time))))))"
+ (hook-push " S_output_comment_hook "\n\
+ (lambda (hook)\n\
+ (set! (hook 'result) (string-append (hook 'comment) \n\
+ \": written \"\n\
+ (strftime \"%a %d-%b-%Y %H:%M %Z\"\n\
+ (localtime (current-time)))))))"
#endif
#if HAVE_RUBY
#define H_output_comment_hook S_output_comment_hook " (str): called in Save-As dialog, passed current sound's comment, if any. \
-If more than one hook function, each function gets the previous function's output as its input."
+If more than one hook function, each function gets the previous function's output as its input.\n\
+$output_comment_hook.add_hook!(\"comment\") do |str|\n\
+ str + \": written \" + Time.new.localtime.strftime(\"%a %d-%b-%y %H:%M %Z\")\n\
+end"
#endif
#if HAVE_FORTH
#define H_output_comment_hook S_output_comment_hook " (str): called in Save-As dialog, passed current sound's comment, if any. \
@@ -4039,18 +3875,17 @@ If more than one hook function, each function gets the previous function's outpu
; add-hook!"
#endif
- output_comment_hook = XEN_DEFINE_HOOK(S_output_comment_hook, 1, H_output_comment_hook); /* arg = current mus_sound_comment(hdr) if any */
+ output_comment_hook = Xen_define_hook(S_output_comment_hook, "(make-hook 'comment)", 1, H_output_comment_hook);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_html_dir, g_html_dir_w, H_html_dir, S_setB S_html_dir, g_set_html_dir_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_html_program, g_html_program_w, H_html_program, S_setB S_html_program, g_set_html_program_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_html_dir, g_html_dir_w, H_html_dir, S_set S_html_dir, g_set_html_dir_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_html_program, g_html_program_w, H_html_program, S_set S_html_program, g_set_html_program_w, 0, 0, 1, 0);
#if HAVE_SCHEME
- XEN_DEFINE_PROCEDURE(S_autoload_file, g_autoload_file_w, 1, 0, 0, H_autoload_file);
+ autoload_info(s7); /* snd-xref.c included above */
+ s7_symbol_set_access(s7, ss->html_dir_symbol, s7_make_function(s7, "[acc-" S_html_dir "]", acc_html_dir, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->html_program_symbol, s7_make_function(s7, "[acc-" S_html_program "]", acc_html_program, 2, 0, false, "accessor"));
- XEN_EVAL_C_STRING("(set! (hook-functions *unbound-variable-hook*) \
- (list (lambda (sym) \
- (let ((file (autoload-file (symbol->string sym)))) \
- (if file (load file)) \
- (symbol->value sym)))))");
+ s7_symbol_set_documentation(s7, ss->html_dir_symbol, "*html-dir*: location of Snd documentation");
+ s7_symbol_set_documentation(s7, ss->html_program_symbol, "*html-program*: name of documentation reader (firefox)");
#endif
}
diff --git a/snd-io.c b/snd-io.c
index b6fa51b..875acea 100644
--- a/snd-io.c
+++ b/snd-io.c
@@ -6,8 +6,8 @@
struct snd_io {
int fd, chans, bufsize;
- mus_long_t frames, beg, end;
- mus_sample_t **arrays;
+ mus_long_t framples, beg, end;
+ mus_float_t **arrays;
};
mus_long_t io_beg(snd_io *io)
@@ -20,11 +20,6 @@ mus_long_t io_end(snd_io *io)
return(io->end);
}
-int io_filed(snd_io *io)
-{
- return(io->fd);
-}
-
void snd_remove(const char *name, cache_remove_t forget)
{
@@ -93,7 +88,7 @@ int snd_open(const char *filename, int flags, mode_t mode)
ss->local_errno = 0;
ss->local_open_errno = 0;
errno = 0;
-#if HAVE_WINDOZE
+#if (defined(_MSC_VER) || __CYGWIN__)
result = open(filename, flags);
#else
result = open(filename, flags, mode);
@@ -145,21 +140,22 @@ io_error_t copy_file(const char *oldname, const char *newname)
{
/* make newname a copy of oldname */
int ifd, ofd;
- mus_long_t bytes, wb, total;
+ mus_long_t bytes, wb;
char *buf = NULL;
- total = 0;
- ifd = OPEN(oldname, O_RDONLY, 0);
+
+ ifd = OPEN(oldname, O_RDONLY, 0);
if (ifd == -1) return(IO_CANT_OPEN_FILE);
+
ofd = CREAT(newname, 0666);
if (ofd == -1)
{
snd_close(ifd, oldname);
return(IO_CANT_CREATE_FILE);
}
- buf = (char *)calloc(8192, sizeof(char));
+
+ buf = (char *)malloc(8192 * sizeof(char));
while ((bytes = read(ifd, buf, 8192)))
{
- total += bytes;
wb = write(ofd, buf, bytes);
if (wb != bytes)
{
@@ -169,6 +165,7 @@ io_error_t copy_file(const char *oldname, const char *newname)
return(IO_WRITE_ERROR);
}
}
+
snd_close(ifd, oldname);
wb = disk_kspace(newname);
snd_close(ofd, newname);
@@ -184,43 +181,44 @@ io_error_t copy_file(const char *oldname, const char *newname)
static void c_io_bufclr(snd_io *io, int beg)
{
- int k, end;
- end = io->bufsize;
+ int k;
+ size_t bytes;
+
+ bytes = (io->bufsize - beg) * sizeof(mus_float_t);
for (k = 0; k < io->chans; k++)
{
- mus_sample_t *j;
+ mus_float_t *j;
j = io->arrays[k];
if (j)
- memset((void *)(j + beg), 0, (end - beg) * sizeof(mus_sample_t));
+ memset((void *)(j + beg), 0, bytes);
}
}
static void reposition_file_buffers_1(mus_long_t loc, snd_io *io)
{
- /* called when loc is outside the current in-core frame for the file pointed to by io */
- mus_long_t frames;
- /* local frames is buffer-local, not a sample number. */
- frames = io->frames - loc;
- if (frames > io->bufsize) frames = io->bufsize;
- if (frames <= 0) /* tried to access beyond current end of file */
+ /* called when loc is outside the current in-core frample for the file pointed to by io */
+ mus_long_t framples;
+ /* local framples is buffer-local, not a sample number. */
+
+ framples = io->framples - loc; /* io->framples is total samps in file */
+ if (framples > io->bufsize) framples = io->bufsize;
+ if (framples <= 0) /* tried to access beyond current end of file */
{
io->beg = loc;
c_io_bufclr(io, 0);
}
else
{
- mus_long_t seek_loc;
- int err;
- seek_loc = mus_file_seek_frame(io->fd, loc);
+ mus_file_seek_frample(io->fd, loc);
io->beg = loc;
- err = mus_file_read_chans(io->fd,
- 0, frames - 1,
- io->chans,
- io->arrays,
- io->arrays);
- if (frames < io->bufsize)
- c_io_bufclr(io, frames);
+ mus_file_read_chans(io->fd,
+ loc, framples,
+ io->chans,
+ io->arrays,
+ io->arrays);
+ if (framples < (io->bufsize - 1))
+ c_io_bufclr(io, framples);
}
io->end = io->beg + io->bufsize - 1;
}
@@ -246,7 +244,7 @@ static void reposition_file_buffers(snd_data *sd, mus_long_t index)
/* these need to flush active data before hidden close and fixup the io indices */
snd_file_open_descriptors(fd,
sd->filename,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
@@ -282,15 +280,16 @@ snd_io *make_file_state(int fd, file_info *hdr, int chan, mus_long_t beg, int su
bufsize = chansize + 1;
io = (snd_io *)calloc(1, sizeof(snd_io)); /* only creation point */
- io->arrays = (mus_sample_t **)calloc(hdr->chans, sizeof(mus_sample_t *));
+ io->arrays = (mus_float_t **)calloc(hdr->chans, sizeof(mus_float_t *));
io->fd = fd;
io->chans = hdr->chans;
- io->frames = chansize;
+ io->framples = chansize;
io->beg = 0;
io->end = bufsize - 1;
io->bufsize = bufsize;
- io->arrays[chan] = (mus_sample_t *)calloc(bufsize, sizeof(mus_sample_t));
- reposition_file_buffers_1(beg, io); /* get ready to read -- we're assuming mus_file_read_chans here */
+ io->arrays[chan] = (mus_float_t *)malloc(bufsize * sizeof(mus_float_t));
+ io->arrays[chan][bufsize - 1] = 0.0; /* there is buffer bounds confusion somewhere... */
+ reposition_file_buffers_1(beg, io); /* get ready to read -- we're assuming mus_file_read_chans here */
return(io);
}
@@ -368,7 +367,6 @@ static int too_many_files_cleanup(void)
{
int *closed;
int rtn;
- rtn = -1;
closed = (int *)malloc(sizeof(int));
(*closed) = 0;
for_each_normal_chan_with_refint(close_temp_files, closed);
@@ -400,6 +398,7 @@ int snd_open_read(const char *arg)
int snd_reopen_write(const char *arg)
{
int fd;
+
fd = OPEN(arg, O_RDWR, 0);
if ((fd == -1) &&
(errno == EMFILE))
@@ -439,7 +438,7 @@ io_error_t sndlib_error_to_snd(int sndlib_err)
case MUS_CANT_OPEN_FILE: return(IO_CANT_OPEN_FILE);
case MUS_NO_SUCH_CHANNEL: return(IO_BAD_CHANNEL);
case MUS_NO_FILE_NAME_PROVIDED: return(IO_NO_FILENAME);
- case MUS_UNSUPPORTED_DATA_FORMAT: return(IO_BAD_DATA_FORMAT);
+ case MUS_UNSUPPORTED_SAMPLE_TYPE: return(IO_BAD_SAMPLE_TYPE);
case MUS_HEADER_READ_FAILED: return(IO_BAD_HEADER);
case MUS_UNSUPPORTED_HEADER_TYPE: return(IO_BAD_HEADER_TYPE);
case MUS_FILE_DESCRIPTORS_NOT_INITIALIZED: return(IO_SNDLIB_UNINITIALIZED);
@@ -455,34 +454,42 @@ io_error_t sndlib_error_to_snd(int sndlib_err)
}
-int snd_file_open_descriptors(int fd, const char *name, int format, mus_long_t location, int chans, int type)
+int snd_file_open_descriptors(int fd, const char *name, mus_sample_t samp_type, mus_long_t location, int chans, mus_header_t type)
{
- int sl_err = MUS_NO_ERROR;
- sl_err = mus_file_open_descriptors(fd, name, format, mus_bytes_per_sample(format), location, chans, type);
+ int sl_err;
+
+ sl_err = mus_file_open_descriptors(fd, name, samp_type, mus_bytes_per_sample(samp_type), location, chans, type);
if (sl_err != MUS_NO_ERROR)
snd_warning("%s: open file descriptors: %s", name, mus_error_type_to_string(sl_err));
+
+ if (mus_sound_saved_data(name))
+ mus_file_save_data(fd, mus_sound_framples(name), mus_sound_saved_data(name));
+
return(sl_err);
}
-io_error_t snd_write_header(const char *name, int type, int srate, int chans,
- mus_long_t samples, int format, const char *comment,
+io_error_t snd_write_header(const char *name, mus_header_t head_type, int srate, int chans,
+ mus_long_t samples, mus_sample_t samp_type, const char *comment,
int *loops)
{
int err; /* sndlib-style error */
/* trap mus_error locally here so that callers of open_temp_file can cleanup samplers and whatnot */
+
local_mus_error = MUS_NO_ERROR;
old_error_handler = mus_error_set_handler(local_mus_error_to_snd);
mus_sound_forget(name);
mus_header_set_aiff_loop_info(loops);
- err = mus_write_header(name, type, srate, chans, samples, format, comment);
- if (err == -1)
+
+ err = mus_write_header(name, head_type, srate, chans, samples, samp_type, comment);
+ /* err here is a mus error */
+ if (err != MUS_NO_ERROR)
{
if (errno == EMFILE) /* 0 => no error (err not actually returned unless it's -1) */
{
err = too_many_files_cleanup();
if (err != -1)
- err = mus_write_header(name, type, srate, chans, samples, format, comment);
+ mus_write_header(name, head_type, srate, chans, samples, samp_type, comment);
else
{
mus_error_set_handler(old_error_handler);
@@ -490,8 +497,7 @@ io_error_t snd_write_header(const char *name, int type, int srate, int chans,
}
}
}
- if (err != -1)
- mus_header_set_aiff_loop_info(NULL);
+ else mus_header_set_aiff_loop_info(NULL);
mus_error_set_handler(old_error_handler);
return(sndlib_error_to_snd(local_mus_error));
}
@@ -508,17 +514,12 @@ typedef struct {
static tempfile_ctr **tempfiles = NULL;
static int tempfiles_size = 0;
-#if HAVE_PTHREADS
- static mus_lock_t temp_file_lock = MUS_LOCK_INITIALIZER;
-#endif
void remember_temp(const char *filename, int chans)
{
- int i, old_size;
+ int i;
tempfile_ctr *tmp = NULL;
- MUS_LOCK(&temp_file_lock);
-
if (tempfiles_size == 0)
{
tempfiles_size = 8;
@@ -530,10 +531,7 @@ void remember_temp(const char *filename, int chans)
for (i = 0; i < tempfiles_size; i++)
if ((tempfiles[i]) &&
(mus_strcmp(filename, tempfiles[i]->name)))
- {
- MUS_UNLOCK(&temp_file_lock);
- return;
- }
+ return;
for (i = 0; i < tempfiles_size; i++)
if (tempfiles[i] == NULL)
@@ -541,6 +539,7 @@ void remember_temp(const char *filename, int chans)
if (i >= tempfiles_size)
{
+ int old_size;
old_size = tempfiles_size;
tempfiles_size += 8;
tempfiles = (tempfile_ctr **)realloc(tempfiles, tempfiles_size * sizeof(tempfile_ctr *));
@@ -549,13 +548,11 @@ void remember_temp(const char *filename, int chans)
}
}
- tmp = (tempfile_ctr *)calloc(1, sizeof(tempfile_ctr));
+ tmp = (tempfile_ctr *)malloc(sizeof(tempfile_ctr));
tempfiles[i] = tmp;
tmp->name = mus_strdup(filename);
tmp->chans = chans;
tmp->ticks = (int *)calloc(chans, sizeof(int));
-
- MUS_UNLOCK(&temp_file_lock);
}
@@ -613,7 +610,7 @@ void forget_temps(void)
snd_data *make_snd_data_file(const char *name, snd_io *io, file_info *hdr, file_delete_t temp, int ctr, int temp_chan)
{
snd_data *sd;
- sd = (snd_data *)calloc(1, sizeof(snd_data));
+ sd = (snd_data *)malloc(sizeof(snd_data));
sd->type = SND_DATA_FILE;
sd->buffered_data = io->arrays[temp_chan];
sd->io = io;
@@ -626,7 +623,8 @@ snd_data *make_snd_data_file(const char *name, snd_io *io, file_info *hdr, file_
sd->inuse = false;
sd->copy = false;
sd->chan = temp_chan;
- sd->data_bytes = (hdr->samples) * (mus_bytes_per_sample(hdr->format)) + hdr->data_location;
+ sd->data_bytes = (hdr->samples) * (mus_bytes_per_sample(hdr->sample_type)) + hdr->data_location;
+ sd->free_me = false;
return(sd);
}
@@ -643,13 +641,13 @@ snd_data *copy_snd_data(snd_data *sd, mus_long_t beg, int bufsize)
return(NULL);
snd_file_open_descriptors(fd,
sd->filename,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
during_open(fd, sd->filename, SND_COPY_READER);
io = make_file_state(fd, hdr, sd->chan, beg, bufsize);
- sf = (snd_data *)calloc(1, sizeof(snd_data));
+ sf = (snd_data *)malloc(sizeof(snd_data));
sf->type = sd->type;
sf->buffered_data = io->arrays[sd->chan];
sf->io = io;
@@ -657,29 +655,37 @@ snd_data *copy_snd_data(snd_data *sd, mus_long_t beg, int bufsize)
sf->hdr = hdr;
sf->temporary = DONT_DELETE_ME;
sf->edit_ctr = sd->edit_ctr;
- sf->open = FD_OPEN;
+
+ /* 17-Nov-14: this was sf->open = FD_OPEN; but I can't think of any reason to leave it open */
+ sf->open = FD_CLOSED;
+ sf->io->fd = -1;
+ mus_file_close(fd);
+
sf->inuse = false;
sf->copy = true;
+ sf->chan = 0;
+ sf->data_bytes = 0;
+ sf->free_me = false;
return(sf);
}
-snd_data *make_snd_data_buffer(mus_sample_t *data, int len, int ctr)
+snd_data *make_snd_data_buffer(mus_float_t *data, int len, int ctr)
{
snd_data *sf;
sf = (snd_data *)calloc(1, sizeof(snd_data));
sf->type = SND_DATA_BUFFER;
- sf->buffered_data = (mus_sample_t *)malloc((len + 1) * sizeof(mus_sample_t));
+ sf->buffered_data = (mus_float_t *)malloc((len + 1) * sizeof(mus_float_t));
/* sigh... using len + 1 rather than len to protect against access to inserted buffer at end mixups (final fragment uses end + 1) */
/* the real problem here is that I never decided whether insert starts at the cursor or just past it */
/* when the cursor is on the final sample, this causes cross-fragment ambiguity as to the length of a trailing insertion */
/* C > (make-region 1000 2000) (insert-region (cursor)) C-v hits this empty slot and gets confused about the previously final sample value */
- memcpy((void *)(sf->buffered_data), (void *)data, len * sizeof(mus_sample_t));
- sf->buffered_data[len] = MUS_SAMPLE_0;
+ memcpy((void *)(sf->buffered_data), (void *)data, len * sizeof(mus_float_t));
+ sf->buffered_data[len] = 0.0;
sf->edit_ctr = ctr;
sf->copy = false;
sf->inuse = false;
- sf->data_bytes = len * sizeof(mus_sample_t);
+ sf->data_bytes = len * sizeof(mus_float_t);
return(sf);
}
@@ -689,11 +695,11 @@ snd_data *make_snd_data_buffer_for_simple_channel(int len)
snd_data *sf;
sf = (snd_data *)calloc(1, sizeof(snd_data));
sf->type = SND_DATA_BUFFER;
- sf->buffered_data = (mus_sample_t *)calloc(len, sizeof(mus_sample_t));
+ sf->buffered_data = (mus_float_t *)calloc(len, sizeof(mus_float_t));
sf->edit_ctr = 0;
sf->copy = false;
sf->inuse = false;
- sf->data_bytes = len * sizeof(mus_sample_t);
+ sf->data_bytes = len * sizeof(mus_float_t);
return(sf);
}
@@ -759,19 +765,19 @@ int open_temp_file(const char *ofile, int chans, file_info *hdr, io_error_t *err
{
/* returns io fd */
int ofd, sl_err = MUS_NO_ERROR;
- if (!(mus_header_writable(hdr->type, hdr->format)))
+ if (!(mus_header_writable(hdr->type, hdr->sample_type)))
{
hdr->type = default_output_header_type(ss);
- if (mus_header_writable(hdr->type, default_output_data_format(ss)))
- hdr->format = default_output_data_format(ss);
+ if (mus_header_writable(hdr->type, default_output_sample_type(ss)))
+ hdr->sample_type = default_output_sample_type(ss);
else
{
/* was default_output_* here, but that's for the user's output, not ours */
hdr->type = MUS_NEXT;
- hdr->format = MUS_OUT_FORMAT;
+ hdr->sample_type = MUS_OUT_SAMPLE_TYPE;
}
}
- (*err) = snd_write_header(ofile, hdr->type, hdr->srate, chans, 0, hdr->format, hdr->comment, hdr->loops);
+ (*err) = snd_write_header(ofile, hdr->type, hdr->srate, chans, 0, hdr->sample_type, hdr->comment, hdr->loops);
if ((*err) != IO_NO_ERROR)
{
/* -1 as fd */
@@ -786,7 +792,7 @@ int open_temp_file(const char *ofile, int chans, file_info *hdr, io_error_t *err
hdr->data_location = mus_header_data_location(); /* header might have changed size (aiff extras) */
sl_err = snd_file_open_descriptors(ofd,
ofile,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
chans,
hdr->type);
@@ -797,7 +803,7 @@ int open_temp_file(const char *ofile, int chans, file_info *hdr, io_error_t *err
}
-io_error_t close_temp_file(const char *filename, int ofd, int type, mus_long_t bytes)
+io_error_t close_temp_file(const char *filename, int ofd, mus_header_t type, mus_long_t bytes)
{
int err;
err = mus_file_close(ofd);
@@ -806,6 +812,7 @@ io_error_t close_temp_file(const char *filename, int ofd, int type, mus_long_t b
local_mus_error = MUS_NO_ERROR;
old_error_handler = mus_error_set_handler(local_mus_error_to_snd);
mus_header_change_data_size(filename, type, bytes);
+ mus_sound_forget(filename);
mus_error_set_handler(old_error_handler);
return(sndlib_error_to_snd(local_mus_error));
}
@@ -819,12 +826,12 @@ void set_up_snd_io(chan_info *cp, int i, int fd, const char *filename, file_info
snd_io *io;
snd_file_open_descriptors(fd,
filename,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
io = make_file_state(fd, hdr, i, 0,
- (post_close) ? MAX_BUFFER_SIZE : MIX_FILE_BUFFER_SIZE);
+ (post_close) ? MAX_BUFFER_SIZE : FILE_BUFFER_SIZE);
cp->sounds[0] = make_snd_data_file(filename, io,
copy_header(hdr->name, hdr),
DONT_DELETE_ME, cp->edit_ctr, i);
diff --git a/snd-kbd.c b/snd-kbd.c
index ca33309..139d3e5 100644
--- a/snd-kbd.c
+++ b/snd-kbd.c
@@ -13,21 +13,18 @@ static int macro_cmd_size = 0;
static int macro_size = 0;
typedef struct {int keysym; int state;} macro_cmd;
static macro_cmd **macro_cmds = NULL;
-typedef struct {char *name; int macro_size; macro_cmd **cmds;} named_macro;
-static named_macro **named_macros = NULL;
-static int named_macro_ctr = 0;
-static int named_macro_size = 0;
static void allocate_macro_cmds(void)
{
- int i, old_size;
+ int old_size;
old_size = macro_cmd_size;
macro_cmd_size += 16;
if (!macro_cmds)
macro_cmds = (macro_cmd **)calloc(macro_cmd_size, sizeof(macro_cmd *));
else
{
+ int i;
macro_cmds = (macro_cmd **)realloc(macro_cmds, macro_cmd_size * sizeof(macro_cmd *));
for (i = old_size; i < macro_cmd_size; i++) macro_cmds[i] = NULL;
}
@@ -73,211 +70,48 @@ static void continue_macro(int keysym, int state)
}
-static named_macro *name_macro(char *name)
-{
- named_macro *nm;
- if (named_macro_ctr == named_macro_size)
- {
- int old_size;
- old_size = named_macro_size;
- named_macro_size += 16;
- if (!named_macros) named_macros = (named_macro **)calloc(named_macro_size, sizeof(named_macro *));
- else
- {
- int i;
- named_macros = (named_macro **)realloc(named_macros, named_macro_size * sizeof(named_macro *));
- for (i = old_size; i < named_macro_size; i++) named_macros[i] = NULL;
- }
- }
- if (!(named_macros[named_macro_ctr]))
- named_macros[named_macro_ctr] = (named_macro *)calloc(1, sizeof(named_macro));
- nm = named_macros[named_macro_ctr];
- nm->name = mus_strdup(name);
- named_macro_ctr++;
- return(nm);
-}
-
-
-static void name_last_macro (char *name)
-{
- named_macro *nm;
- int i;
- nm = name_macro(name);
- nm->macro_size = macro_size;
- nm->cmds = (macro_cmd **)calloc(macro_size, sizeof(macro_cmd *));
- for (i = 0; i < macro_size; i++)
- {
- macro_cmd *mc;
- nm->cmds[i] = (macro_cmd *)calloc(1, sizeof(macro_cmd));
- mc = nm->cmds[i];
- mc->keysym = macro_cmds[i]->keysym;
- mc->state = macro_cmds[i]->state;
- }
-}
-
-
-static void save_macro_1(named_macro *nm, FILE *fd)
-{
- int i;
- macro_cmd *mc;
-#if HAVE_RUBY
- fprintf(fd, "def %s\n", nm->name);
- for (i = 0; i < nm->macro_size; i++)
- {
- mc = nm->cmds[i];
- if (mc->keysym != 0)
- fprintf(fd,
- " %s %d, %d\n",
- S_key, (int)(mc->keysym), mc->state);
- }
- fprintf(fd, "end\n");
-#endif
-#if HAVE_SCHEME
- fprintf(fd, "(define (%s)\n", nm->name);
- for (i = 0; i < nm->macro_size; i++)
- {
- mc = nm->cmds[i];
- if (mc->keysym != 0)
- fprintf(fd,
- " (%s (char->integer #\\%c) %d)\n",
- S_key, (char)(mc->keysym), mc->state);
- }
- fprintf(fd, ")\n");
-#endif
-#if HAVE_FORTH
- fprintf(fd, ": %s\n", nm->name);
- for (i = 0; i < nm->macro_size; i++)
- {
- mc = nm->cmds[i];
- if (mc->keysym != 0)
- fprintf(fd,
- " [char] %c %d %s drop\n",
- (char)(mc->keysym), mc->state, S_key);
- }
- fprintf(fd, ";\n");
-#endif
-}
-
-void save_macro_state (FILE *fd)
-{
- int i;
- for (i = 0; i < named_macro_ctr; i++)
- save_macro_1(named_macros[i], fd);
-}
-
-static bool execute_named_macro_1(chan_info *cp, const char *name, mus_long_t count)
-{
- int k;
- for (k = 0; k < named_macro_ctr; k++)
- {
- if (mus_strcmp(name, named_macros[k]->name))
- {
- int i;
- mus_long_t j;
- named_macro *nm;
- nm = named_macros[k];
- for (j = 0; j < count; j++)
- for (i = 0; i < nm->macro_size; i++)
- {
- macro_cmd *mc;
- mc = nm->cmds[i];
- if (mc->keysym != 0)
- {
- if ((cp->active < CHANNEL_HAS_EDIT_LIST) || (!(cp->sound))) return(1);
- /* it's possible for a command in the macro sequence to close cp */
- keyboard_command(cp, mc->keysym, mc->state);
- }
- }
- return(true);
- }
- }
- return(false);
-}
-
-
-static void execute_named_macro(chan_info *cp, char *name, mus_long_t count)
-{
- if (!(execute_named_macro_1(cp, name, count)))
- /* not a macro...*/
- {
-#if HAVE_EXTENSION_LANGUAGE
-#if HAVE_SCHEME
- XEN result = XEN_FALSE;
- int i, loc, one_edit;
- one_edit = cp->edit_ctr + 1;
- for (i = 0; i < count; i++)
- result = XEN_EVAL_C_STRING(name);
-#else
- int one_edit, i, loc, form_loc;
- XEN form, result = XEN_UNDEFINED;
- one_edit = cp->edit_ctr + 1;
- redirect_errors_to(errors_to_minibuffer, (void *)(cp->sound));
- form = string_to_form(name);
- redirect_errors_to(NULL, NULL);
- form_loc = snd_protect(form);
- for (i = 0; i < count; i++)
- result = snd_catch_any(eval_form_wrapper, (void *)form, name);
- snd_unprotect_at(form_loc);
-#endif
- loc = snd_protect(result);
- snd_report_result(result, name);
- snd_unprotect_at(loc);
- if (cp->edit_ctr > one_edit)
- {
- if (ss->deferred_regions > 0)
- sequester_deferred_regions(cp, one_edit - 1);
- while (cp->edit_ctr > one_edit) backup_edit_list(cp);
- }
-#else
- /* not sure it's possible to get here at all -- execute undefined named macro?? */
- snd_error("This version of Snd has no extension language, so there's no way to evaluate %s", name);
-#endif
- }
-}
-
-
-/* ---------------- key bindings ---------------- */
+/* ---------------- keys ---------------- */
typedef struct {
int key;
int state;
int args;
- XEN func;
+ Xen func;
bool cx_extended; /* Sun/Forte C defines "extended" somewhere */
const char *origin, *prefs_info;
int gc_loc;
} key_entry;
-static key_entry *user_keymap = NULL;
+static key_entry *keymap = NULL;
static int keymap_size = 0;
static int keymap_top = 0;
-int in_user_keymap(int key, int state, bool cx_extended)
+int in_keymap(int key, int state, bool cx_extended)
{
int i;
if (keymap_top == 0) return(-1);
for (i = 0; i < keymap_top; i++)
- if ((user_keymap[i].key == key) &&
- (user_keymap[i].state == state) &&
- (user_keymap[i].cx_extended == cx_extended) &&
- (XEN_BOUND_P(user_keymap[i].func)))
+ if ((keymap[i].key == key) &&
+ (keymap[i].state == state) &&
+ (keymap[i].cx_extended == cx_extended) &&
+ (Xen_is_bound(keymap[i].func)))
return(i);
return(-1);
}
-#if HAVE_SCHEME
+#if HAVE_SCHEME || HAVE_FORTH
#define kbd_false 0
#else
- #define kbd_false XEN_FALSE
+ #define kbd_false Xen_false
#endif
-#define NUM_BUILT_IN_KEY_BINDINGS 81
+#define NUM_BUILT_IN_KEYS 81
-static key_entry built_in_key_bindings[NUM_BUILT_IN_KEY_BINDINGS] = {
+static key_entry built_in_keys[NUM_BUILT_IN_KEYS] = {
{snd_K_Down, 0, 0, kbd_false, false, "zoom out", NULL, -1},
{snd_K_Up, 0, 0, kbd_false, false, "zoom in", NULL, -1},
{snd_K_Left, 0, 0, kbd_false, false, "move window left", NULL, -1},
@@ -308,8 +142,7 @@ static key_entry built_in_key_bindings[NUM_BUILT_IN_KEY_BINDINGS] = {
{snd_K_o, snd_ControlMask, 0, kbd_false, false, "insert one zero sample at cursor", NULL, -1},
{snd_K_p, snd_ControlMask, 0, kbd_false, false, "move cursor back one 'line'", NULL, -1},
{snd_K_q, snd_ControlMask, 0, kbd_false, false, "play current channel starting at cursor", "play-channel-from-cursor", -1},
- {snd_K_r, snd_ControlMask, 0, kbd_false, false, "search backwards", NULL, -1},
- {snd_K_s, snd_ControlMask, 0, kbd_false, false, "search forwards", NULL, -1},
+ {snd_K_s, snd_ControlMask, 0, kbd_false, false, "search", NULL, -1},
{snd_K_t, snd_ControlMask, 0, kbd_false, false, "stop playing", NULL, -1},
{snd_K_u, snd_ControlMask, 0, kbd_false, false, "start arg count definition.", NULL, -1},
{snd_K_v, snd_ControlMask, 0, kbd_false, false, "move cursor to mid-window", NULL, -1},
@@ -322,14 +155,10 @@ static key_entry built_in_key_bindings[NUM_BUILT_IN_KEY_BINDINGS] = {
{snd_K_less, snd_MetaMask, 0, kbd_false, false, "move cursor to sample 0", NULL, -1},
{snd_K_greater, snd_MetaMask, 0, kbd_false, false, "move cursor to last sample", NULL, -1},
- {snd_K_a, 0, 0, kbd_false, true, "apply envelope to selection", NULL, -1},
{snd_K_b, 0, 0, kbd_false, true, "position window so cursor is on left margin", NULL, -1},
{snd_K_c, 0, 0, kbd_false, true, "define selection from cursor to nth mark", NULL, -1},
- {snd_K_d, 0, 0, kbd_false, true, "set temp dir name", NULL, -1},
{snd_K_e, 0, 0, kbd_false, true, "execute keyboard macro", NULL, -1},
{snd_K_f, 0, 0, kbd_false, true, "position window so cursor is on right margin", NULL, -1},
- {snd_K_i, 0, 0, kbd_false, true, "insert region", "insert-selection", -1},
- {snd_K_j, 0, 0, kbd_false, true, "goto named mark", NULL, -1},
{snd_K_k, 0, 0, kbd_false, true, "close file", NULL, -1},
{snd_K_l, 0, 0, kbd_false, true, "position selection in mid-view", NULL, -1},
{snd_K_o, 0, 0, kbd_false, true, "move to next or previous graph", NULL, -1},
@@ -338,21 +167,14 @@ static key_entry built_in_key_bindings[NUM_BUILT_IN_KEY_BINDINGS] = {
{snd_K_r, 0, 0, kbd_false, true, "redo", NULL, -1},
{snd_K_u, 0, 0, kbd_false, true, "undo", NULL, -1},
{snd_K_v, 0, 0, kbd_false, true, "position window over selection", NULL, -1},
- {snd_K_w, 0, 0, kbd_false, true, "save selection as file", NULL, -1},
{snd_K_z, 0, 0, kbd_false, true, "smooth selection", NULL, -1},
- {snd_K_slash, 0, 0, kbd_false, true, "place named mark", NULL, -1},
{snd_K_openparen, 0, 0, kbd_false, true, "begin keyboard macro definition", NULL, -1},
{snd_K_closeparen, 0, 0, kbd_false, true, "end keyboard macro definition", NULL, -1},
- {snd_K_a, snd_ControlMask, 0, kbd_false, true, "apply envelope", NULL, -1},
{snd_K_b, snd_ControlMask, 0, kbd_false, true, "set x window bounds (preceded by 1 arg)", NULL, -1},
{snd_K_c, snd_ControlMask, 0, kbd_false, true, "hide control panel", NULL, -1},
- {snd_K_d, snd_ControlMask, 0, kbd_false, true, "print", NULL, -1},
- {snd_K_e, snd_ControlMask, 0, kbd_false, true, "give last keyboard macro a name", NULL, -1},
{snd_K_f, snd_ControlMask, 0, kbd_false, true, "open file", NULL, -1},
{snd_K_g, snd_ControlMask, 0, kbd_false, true, "abort command", NULL, -1},
- {snd_K_i, snd_ControlMask, 0, kbd_false, true, "insert file", NULL, -1},
- {snd_K_m, snd_ControlMask, 0, kbd_false, true, "add named mark", NULL, -1},
{snd_K_o, snd_ControlMask, 0, kbd_false, true, "show control panel", NULL, -1},
{snd_K_p, snd_ControlMask, 0, kbd_false, true, "set window size (preceded by 1 arg)", NULL, -1},
{snd_K_q, snd_ControlMask, 0, kbd_false, true, "mix in file", NULL, -1},
@@ -365,15 +187,15 @@ static key_entry built_in_key_bindings[NUM_BUILT_IN_KEY_BINDINGS] = {
};
-void map_over_key_bindings(bool (*func)(int key, int state, bool cx, XEN xf))
+void map_over_keys(bool (*func)(int key, int state, bool cx, Xen xf))
{
int i;
for (i = 0; i < keymap_top; i++)
- if ((XEN_BOUND_P(user_keymap[i].func)) &&
- ((*func)(user_keymap[i].key,
- user_keymap[i].state,
- user_keymap[i].cx_extended,
- user_keymap[i].func)))
+ if ((Xen_is_bound(keymap[i].func)) &&
+ ((*func)(keymap[i].key,
+ keymap[i].state,
+ keymap[i].cx_extended,
+ keymap[i].func)))
return;
}
@@ -396,18 +218,18 @@ static key_info *make_key_info(key_entry k)
}
-key_info *find_prefs_key_binding(const char *prefs_name)
+key_info *find_prefs_key(const char *prefs_name)
{
int i;
key_info *ki;
for (i = 0; i < keymap_top; i++)
- if ((XEN_BOUND_P(user_keymap[i].func)) &&
- (mus_strcmp(user_keymap[i].prefs_info, prefs_name)))
- return(make_key_info(user_keymap[i]));
+ if ((Xen_is_bound(keymap[i].func)) &&
+ (mus_strcmp(keymap[i].prefs_info, prefs_name)))
+ return(make_key_info(keymap[i]));
- for (i = 0; i < NUM_BUILT_IN_KEY_BINDINGS; i++)
- if (mus_strcmp(built_in_key_bindings[i].prefs_info, prefs_name))
- return(make_key_info(built_in_key_bindings[i]));
+ for (i = 0; i < NUM_BUILT_IN_KEYS; i++)
+ if (mus_strcmp(built_in_keys[i].prefs_info, prefs_name))
+ return(make_key_info(built_in_keys[i]));
ki = (key_info *)calloc(1, sizeof(key_info));
ki->key = NULL;
@@ -418,33 +240,33 @@ key_info *find_prefs_key_binding(const char *prefs_name)
}
-char *key_binding_description(int key, int state, bool cx_extended)
+char *key_description(int key, int state, bool cx_extended)
{
int pos;
if ((key < MIN_KEY_CODE) || (key > MAX_KEY_CODE) ||
(state < MIN_KEY_STATE) || (state > MAX_KEY_STATE))
return(NULL);
- pos = in_user_keymap(key, state, cx_extended);
- if (pos < 0) pos = in_user_keymap(key, state, cx_extended);
+ pos = in_keymap(key, state, cx_extended);
+ if (pos < 0) pos = in_keymap(key, state, cx_extended);
if (pos >= 0)
{
- if (user_keymap[pos].origin)
- return(mus_strdup(user_keymap[pos].origin));
+ if (keymap[pos].origin)
+ return(mus_strdup(keymap[pos].origin));
return(mus_strdup("something indescribable")); /* NULL would mean "no binding" */
}
- for (pos = 0; pos < NUM_BUILT_IN_KEY_BINDINGS; pos++)
- if ((built_in_key_bindings[pos].key == key) &&
- (built_in_key_bindings[pos].state == state) &&
- (built_in_key_bindings[pos].cx_extended == cx_extended))
- return(mus_strdup(built_in_key_bindings[pos].origin));
+ for (pos = 0; pos < NUM_BUILT_IN_KEYS; pos++)
+ if ((built_in_keys[pos].key == key) &&
+ (built_in_keys[pos].state == state) &&
+ (built_in_keys[pos].cx_extended == cx_extended))
+ return(mus_strdup(built_in_keys[pos].origin));
return(NULL);
}
-void set_keymap_entry(int key, int state, int args, XEN func, bool cx_extended, const char *origin, const char *prefs_info)
+void set_keymap_entry(int key, int state, int args, Xen func, bool cx_extended, const char *origin, const char *prefs_info)
{
int i;
- i = in_user_keymap(key, state, cx_extended);
+ i = in_keymap(key, state, cx_extended);
if (i == -1)
{
if (keymap_size == keymap_top)
@@ -452,649 +274,98 @@ void set_keymap_entry(int key, int state, int args, XEN func, bool cx_extended,
keymap_size += 16;
if (keymap_top == 0)
{
- user_keymap = (key_entry *)calloc(keymap_size, sizeof(key_entry));
+ keymap = (key_entry *)calloc(keymap_size, sizeof(key_entry));
for (i = 0; i < keymap_size; i++)
- user_keymap[i].func = XEN_UNDEFINED;
+ keymap[i].func = Xen_undefined;
}
else
{
- user_keymap = (key_entry *)realloc(user_keymap, keymap_size * sizeof(key_entry));
+ keymap = (key_entry *)realloc(keymap, keymap_size * sizeof(key_entry));
for (i = keymap_top; i < keymap_size; i++)
{
- user_keymap[i].key = 0;
- user_keymap[i].state = 0;
- user_keymap[i].func = XEN_UNDEFINED;
- user_keymap[i].cx_extended = false;
- user_keymap[i].origin = NULL;
- user_keymap[i].prefs_info = NULL;
- user_keymap[i].gc_loc = NOT_A_GC_LOC;
+ keymap[i].key = 0;
+ keymap[i].state = 0;
+ keymap[i].func = Xen_undefined;
+ keymap[i].cx_extended = false;
+ keymap[i].origin = NULL;
+ keymap[i].prefs_info = NULL;
+ keymap[i].gc_loc = NOT_A_GC_LOC;
}
}
}
- user_keymap[keymap_top].key = key;
- user_keymap[keymap_top].state = state;
- user_keymap[keymap_top].cx_extended = cx_extended;
+ keymap[keymap_top].key = key;
+ keymap[keymap_top].state = state;
+ keymap[keymap_top].cx_extended = cx_extended;
check_menu_labels(key, state, cx_extended);
i = keymap_top;
keymap_top++;
}
else
{
- if ((XEN_PROCEDURE_P(user_keymap[i].func)) &&
- (user_keymap[i].gc_loc != NOT_A_GC_LOC))
+ if ((Xen_is_procedure(keymap[i].func)) &&
+ (keymap[i].gc_loc != NOT_A_GC_LOC))
{
- snd_unprotect_at(user_keymap[i].gc_loc);
- user_keymap[i].gc_loc = NOT_A_GC_LOC;
+ snd_unprotect_at(keymap[i].gc_loc);
+ keymap[i].gc_loc = NOT_A_GC_LOC;
}
- if (user_keymap[i].origin)
+ if (keymap[i].origin)
{
/* this is silly... */
char *tmp;
- tmp = (char *)user_keymap[i].origin;
- user_keymap[i].origin = NULL;
+ tmp = (char *)keymap[i].origin;
+ keymap[i].origin = NULL;
free(tmp);
}
- if (user_keymap[i].prefs_info)
+ if (keymap[i].prefs_info)
{
char *tmp;
- tmp = (char *)user_keymap[i].prefs_info;
- user_keymap[i].prefs_info = NULL;
+ tmp = (char *)keymap[i].prefs_info;
+ keymap[i].prefs_info = NULL;
free(tmp);
}
}
- user_keymap[i].origin = mus_strdup(origin);
- user_keymap[i].prefs_info = mus_strdup(prefs_info);
- user_keymap[i].args = args;
- user_keymap[i].func = func;
- if (XEN_PROCEDURE_P(func))
- user_keymap[i].gc_loc = snd_protect(func);
+ keymap[i].origin = mus_strdup(origin);
+ keymap[i].prefs_info = mus_strdup(prefs_info);
+ keymap[i].args = args;
+ keymap[i].func = func;
+ if (Xen_is_procedure(func))
+ keymap[i].gc_loc = snd_protect(func);
}
-static void call_user_keymap(int hashedsym, int count)
+static void call_keymap(int hashedsym, int count)
{
kbd_cursor_t res = KEYBOARD_NO_ACTION;
- if (XEN_BOUND_P(user_keymap[hashedsym].func))
- {
- /* not _NO_CATCH here because the code is not protected at any higher level */
- if (user_keymap[hashedsym].args == 0)
- res = (kbd_cursor_t)XEN_TO_C_INT_OR_ELSE(XEN_CALL_0(user_keymap[hashedsym].func,
- user_keymap[hashedsym].origin),
- (int)KEYBOARD_NO_ACTION);
- else res = (kbd_cursor_t)XEN_TO_C_INT_OR_ELSE(XEN_CALL_1(user_keymap[hashedsym].func,
- C_TO_XEN_INT(count),
- user_keymap[hashedsym].origin),
- (int)KEYBOARD_NO_ACTION);
- }
- handle_cursor(selected_channel(), res);
-}
-
-
-/* ---------------- minibuffer ---------------- */
-
-void string_to_minibuffer(snd_info *sp, const char *buf)
-{
- if ((sp->minibuffer_on == MINI_PROMPT) ||
- (sp->minibuffer_on == MINI_USER) ||
- (sp->minibuffer_on == MINI_FIND))
- display_minibuffer_error(sp, buf); /* leave the prompt alone */
- else
- {
- clear_minibuffer_prompt(sp);
- set_minibuffer_string(sp, buf, false); /* was true, but that causes bogus expose events of entire graph widget -- perhaps pass this as parameter? */
- sp->minibuffer_on = MINI_REPORT;
- }
-}
-
-
-void report_in_minibuffer(snd_info *sp, const char *format, ...)
-{
-#if (!USE_NO_GUI)
- char *buf;
- va_list ap;
- if ((!sp) || (!(sp->active)) || (sp->inuse != SOUND_NORMAL)) return;
- va_start(ap, format);
- buf = vstr(format, ap);
- va_end(ap);
- string_to_minibuffer(sp, buf);
- free(buf);
-#endif
-}
-
-
-void clear_minibuffer(snd_info *sp)
-{
- clear_minibuffer_prompt(sp);
- set_minibuffer_string(sp, NULL, true);
- sp->search_count = 0;
- sp->marking = 0;
- sp->filing = NOT_FILING;
- sp->printing = NOT_PRINTING;
- sp->minibuffer_on = MINI_OFF;
- sp->loading = false;
- sp->amp_count = 0;
- sp->macro_count = 0;
- sp->prompting = false;
-}
-
-
-void clear_minibuffer_prompt(snd_info *sp)
-{
- make_minibuffer_label(sp, " ");
-}
-
-
-static void prompt(snd_info *sp, const char *msg, const char *preload)
-{
- if (preload)
- {
- set_minibuffer_string(sp, preload, true);
- set_minibuffer_cursor_position(sp, mus_strlen(preload));
- }
- else
- set_minibuffer_string(sp, NULL, true);
- make_minibuffer_label(sp, msg);
- sp->minibuffer_on = MINI_PROMPT;
- goto_minibuffer(sp);
-}
-
-
-static void get_amp_expression(snd_info *sp, int count, bool over_selection)
-{
- prompt(sp, "env:", NULL);
- sp->amp_count = count;
- sp->selectioning = over_selection;
-}
-
-
-static void prompt_named_mark(chan_info *cp)
-{
- snd_info *sp = cp->sound;
- clear_minibuffer(sp);
- make_minibuffer_label(sp, "mark:");
- sp->minibuffer_on = MINI_PROMPT;
- goto_minibuffer(sp);
- sp->marking = CURSOR(cp) + 1; /* + 1 so it's not confused with 0 (if (sp->marking)...) */
-}
-
-
-void errors_to_minibuffer(const char *msg, void *data)
-{
- snd_info *sp;
- sp = (snd_info *)data;
- if (!(snd_ok(sp)))
- {
- sp = any_selected_sound();
- if (!snd_ok(sp)) return;
- }
- display_minibuffer_error((snd_info *)data, msg);
-}
-
-
-void printout_to_minibuffer(const char *msg, void *data)
-{
- string_to_minibuffer((snd_info *)data, msg);
-}
-
-
-#if HAVE_DIRENT_H
- #include <dirent.h>
-#endif
-
-void snd_minibuffer_activate(snd_info *sp, int keysym, bool with_meta)
-{
- bool s_or_r = false;
- chan_info *active_chan;
- static char *str = NULL;
- if (str) /* leftover from previous call */
- {
-#if USE_MOTIF
- XtFree(str);
-#else
-#if USE_GTK
- free(str);
-#endif
-#endif
- str = NULL;
- }
- if ((keysym == snd_K_s) || (keysym == snd_K_r)) s_or_r = true;
- if (sp != selected_sound()) select_channel(sp, 0);
- active_chan = any_selected_channel(sp);
- if (active_chan)
- {
- goto_graph(active_chan);
- }
- if ((keysym == snd_K_g) || (keysym == snd_K_G)) /* c-g => abort whatever we're doing and return */
- {
- clear_minibuffer(sp);
- return;
- }
- if ((with_meta) && ((keysym == snd_K_p) || (keysym == snd_K_P) || (keysym == snd_K_n) || (keysym == snd_K_N)))
- {
- restore_mini_string(sp, (keysym == snd_K_p) || (keysym == snd_K_P));
- goto_minibuffer(sp);
- return;
- }
-
- str = get_minibuffer_string(sp);
- if ((str) && (*str))
- remember_mini_string(sp, str);
- /* sp->minibuffer_on = MINI_REPORT; */
-
-#if HAVE_EXTENSION_LANGUAGE
- if (sp->search_count != 0)
- {
- /* it's the search expr request */
- /* if not nil, replace previous */
- if (!s_or_r)
- {
- if ((str) && (*str))
- {
- XEN proc;
- /* check for procedure as arg, or lambda form:
- * (lambda (y) (> y .1))
- * if returns #t, search stops
- *
- * if error in scheme, don't go ahead with the search!
- */
- clear_sound_search_procedure(sp, true);
- sp->search_expr = mus_strdup(str);
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- proc = snd_catch_any(eval_str_wrapper, str, str);
- if (XEN_PROCEDURE_P(proc)) /* redundant but avoids unwanted error message via snd_error */
- {
- char *errmsg;
- errmsg = procedure_ok(proc, 1, "find", "find", 1);
- if (errmsg)
- {
- snd_error_without_format(errmsg);
- free(errmsg);
- }
- else
- {
- sp->search_proc = proc;
- sp->search_proc_loc = snd_protect(proc);
- }
- }
- else active_chan = NULL; /* don't try to search! */
- redirect_errors_to(NULL, NULL);
- if (active_chan) active_chan->last_search_result = SEARCH_OK;
- }
- }
-
- if (active_chan)
- cursor_search(active_chan, sp->search_count);
- return;
- }
-#endif
- sp->minibuffer_on = MINI_REPORT;
- if ((sp->marking) || (sp->finding_mark))
- {
- if (sp->marking)
- {
- mark *m;
- m = add_mark(sp->marking - 1, str, active_chan);
- if (m)
- {
- report_in_minibuffer(sp, "%s placed at sample " MUS_LD, str, sp->marking - 1);
- display_channel_marks(active_chan);
- }
- else report_in_minibuffer(sp, "There is already a mark at sample " MUS_LD, sp->marking - 1);
- sp->marking = 0;
- }
- else
- {
- goto_named_mark(active_chan, str);
- sp->finding_mark = false;
- }
- return;
- }
- if (mus_strlen(str) != 0)
- {
- if (sp->printing)
- {
- snd_print(str);
- sp->printing = NOT_PRINTING;
- clear_minibuffer(sp);
- return;
- }
- if (sp->loading)
- {
- snd_load_file(str);
- sp->loading = false;
- clear_minibuffer(sp);
- return;
- }
- if (sp->filing != NOT_FILING)
- {
- switch (sp->filing)
- {
-
- /* open file */
- case INPUT_FILING:
- if (str)
- {
- char *filename;
- snd_info *nsp;
- filename = mus_expand_filename(str);
- if (mus_file_probe(filename))
- {
- ss->open_requestor = FROM_KEYBOARD;
-#if (!USE_NO_GUI)
- ss->requestor_dialog = NULL;
-#endif
- ss->open_requestor_data = (void *)sp;
- nsp = snd_open_file(str, FILE_READ_WRITE);
- }
- else
- {
- /* C-x C-f <name-of-nonexistent-file> -> open new sound */
- nsp = snd_new_file(filename,
- default_output_header_type(ss),
- default_output_data_format(ss),
- default_output_srate(ss),
- default_output_chans(ss),
- NULL, 1); /* at least 1 sample needed for new sound data buffer creation */
- /* now should this file be deleted upon exit?? */
- }
- free(filename);
- if (nsp)
- {
- select_channel(nsp, 0);
- clear_minibuffer(sp);
- }
- else snd_warning("can't open %s!", str);
- }
- /* C-x C-f <cr> is no-op (emacs) */
- break;
-
- /* save selection */
- case DOIT_SELECTION_FILING: /* if user responded to prompt about overwriting */
- /* clear prompt and text widget without clearing all the fields (like sp->filing!) */
- clear_minibuffer_prompt(sp);
- set_minibuffer_string(sp, NULL, true);
- sp->minibuffer_on = MINI_OFF;
- if (STRCMP(str, "yes") != 0)
- {
- if (sp->filing_filename)
- {
- free(sp->filing_filename);
- sp->filing_filename = NULL;
- }
- string_to_minibuffer(sp, "selection not saved");
- sp->filing = NOT_FILING;
- return;
- }
-
- /* else fall through... */
- case SELECTION_FILING:
- if (selection_is_active())
- {
- io_error_t io_err;
- char *filename = NULL;
- if (sp->filing == SELECTION_FILING)
- {
- clear_minibuffer_prompt(sp);
- set_minibuffer_string(sp, NULL, true);
- sp->minibuffer_on = MINI_OFF;
- filename = mus_expand_filename(str);
- if ((ask_before_overwrite(ss)) &&
- (mus_file_probe(filename)))
- {
- /* ask user whether to go on. */
- char *ques;
- ques = mus_format("%s exists: overwrite?", str);
- prompt(sp, ques, NULL);
- free(ques);
- sp->filing_filename = filename;
- sp->filing = DOIT_SELECTION_FILING;
- return;
- }
- }
- else
- {
- filename = sp->filing_filename;
- sp->filing_filename = NULL;
- }
- io_err = save_selection(filename,
- default_output_header_type(ss),
- default_output_data_format(ss),
- SND_SRATE(sp), NULL, SAVE_ALL_CHANS);
- if (io_err == IO_NO_ERROR)
- report_in_minibuffer(sp, "selection saved as %s", filename);
- else report_in_minibuffer(sp, "selection not saved: %s %s",
- io_error_name(io_err),
- filename);
- free(filename);
- }
- else string_to_minibuffer(sp, "no selection to save");
- sp->filing = NOT_FILING;
- break;
-
- /* save channel -- the same loop as selection case above */
- case DOIT_CHANNEL_FILING:
- clear_minibuffer_prompt(sp);
- set_minibuffer_string(sp, NULL, true);
- sp->minibuffer_on = MINI_OFF;
- if (STRCMP(str, "yes") != 0)
- {
- if (sp->filing_filename)
- {
- free(sp->filing_filename);
- sp->filing_filename = NULL;
- }
- string_to_minibuffer(sp, "channel not saved");
- sp->filing = NOT_FILING;
- return;
- }
-
- /* else fall through... */
- case CHANNEL_FILING:
- {
- io_error_t io_err;
- char *filename = NULL;
- if (sp->filing == CHANNEL_FILING)
- {
- clear_minibuffer_prompt(sp);
- set_minibuffer_string(sp, NULL, true);
- sp->minibuffer_on = MINI_OFF;
- filename = mus_expand_filename(str);
- if ((ask_before_overwrite(ss)) &&
- (mus_file_probe(filename)))
- {
- /* ask user whether to go on. */
- char *ques;
- ques = mus_format("%s exists: overwrite?", str);
- prompt(sp, ques, NULL);
- free(ques);
- sp->filing_filename = filename;
- sp->filing = DOIT_CHANNEL_FILING;
- return;
- }
- }
- else
- {
- filename = sp->filing_filename;
- sp->filing_filename = NULL;
- }
- io_err = save_channel_edits(active_chan, filename, AT_CURRENT_EDIT_POSITION);
- if (io_err == IO_NO_ERROR)
- report_in_minibuffer(sp, "channel %d saved as %s",
- active_chan->chan,
- filename);
- else string_to_minibuffer(sp, "channel not saved");
- if (filename) free(filename);
- sp->filing = NOT_FILING;
- }
- break;
-
-#if HAVE_OPENDIR
- /* set temp-dir */
- case TEMP_FILING:
- {
- DIR *dp;
- char *newdir;
- newdir = mus_strdup(str);
- clear_minibuffer(sp);
- dp = opendir(newdir);
- if (dp)
- {
- closedir(dp);
- if (temp_dir(ss)) free(temp_dir(ss));
- set_temp_dir(newdir);
- }
- else
- {
- char *msg;
- msg = mus_format("can't access %s! temp dir is unchanged", newdir);
- display_minibuffer_error(sp, msg);
- free(msg);
- if (newdir) free(newdir);
- }
- }
- break;
-#endif
-
- /* mix file */
- case CHANGE_FILING:
- {
- int id_or_error;
- clear_minibuffer(sp);
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- id_or_error = mix_complete_file_at_cursor(sp, str);
- redirect_errors_to(NULL, NULL);
- if (id_or_error >= 0)
- report_in_minibuffer(sp, "%s mixed in at cursor", str);
- }
- break;
-
- /* insert file */
- case INSERT_FILING:
- {
- int err;
- clear_minibuffer(sp);
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- err = insert_complete_file_at_cursor(sp, str);
- redirect_errors_to(NULL, NULL);
- if (err == 0)
- report_in_minibuffer(sp, "%s inserted at cursor", str);
- }
- break;
-
- /* execute macro */
- case MACRO_FILING:
- if ((macro_cmds) && (macro_size > 0))
- {
- name_last_macro(str);
- clear_minibuffer(sp);
- }
- else string_to_minibuffer(sp, "no previous macro");
- break;
-
- case SAVE_EDITS_FILING:
- if ((str[0] == 'y') ||
- (str[0] == 'Y'))
- {
- sp->need_update = false;
- clear_minibuffer_error(sp);
- save_edits_and_update_display(sp);
- }
- clear_minibuffer(sp);
- break;
- default:
- break;
- }
- sp->filing = NOT_FILING;
- return;
- }
-
- if (sp->amp_count != 0)
- {
- env *e;
- if (!active_chan) active_chan = sp->chans[0];
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- e = string_to_env(str);
- if (e)
- {
- if (sp->amp_count != 1)
- apply_env(active_chan, e, CURSOR(active_chan),
- sp->amp_count, sp->selectioning,
- (char *)((sp->selectioning) ? "C-x a" : "C-x C-a"), NULL,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
- else apply_env(active_chan, e, 0, CURRENT_SAMPLES(active_chan),
- sp->selectioning,
- (char *)((sp->selectioning) ? "C-x a" : "C-x C-a"), NULL,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
- e = free_env(e);
- }
- redirect_errors_to(NULL, NULL);
- sp->selectioning = false;
- sp->amp_count = 0;
- clear_minibuffer(sp);
- return;
- }
-
-#if HAVE_EXTENSION_LANGUAGE
- if (sp->macro_count)
- {
- redirect_snd_print_to(printout_to_minibuffer, (void *)sp);
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- execute_named_macro(active_chan, str, sp->macro_count);
- /* if this is a close command from the current minibuffer, the sound may not exist when we return */
- redirect_everything_to(NULL, NULL);
- if (sp == NULL) return;
- sp->macro_count = 0;
- return;
- }
-#endif
- }
-
-#if HAVE_EXTENSION_LANGUAGE
- /* strlen can be 0 here if <cr> response to prompt */
- if (sp->prompting)
+ if (Xen_is_bound(keymap[hashedsym].func))
{
- int loc;
- if (mus_strlen(str) > 0)
+ /* not _NO_CATCH here because the code is not protected at any higher level
+ * if key-bind function returns some impossible cursor-action, return keyboard-no-action
+ */
+ Xen result;
+ if (keymap[hashedsym].args == 0)
+ result = Xen_call_with_no_args(keymap[hashedsym].func, keymap[hashedsym].origin);
+ else result = Xen_call_with_1_arg(keymap[hashedsym].func, C_int_to_Xen_integer(count), keymap[hashedsym].origin);
+ if (Xen_is_integer(result))
{
- XEN proc;
- redirect_snd_print_to(printout_to_minibuffer, (void *)sp);
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- if (sp->raw_prompt)
- proc = C_TO_XEN_STRING(str);
- else proc = snd_catch_any(eval_str_wrapper, str, str);
- if (XEN_PROCEDURE_P(sp->prompt_callback))
- {
- loc = snd_protect(proc);
- XEN_CALL_1(sp->prompt_callback, proc, "prompt callback func");
- snd_unprotect_at(loc);
- }
- redirect_everything_to(NULL, NULL);
+ int r;
+ r = (int)Xen_integer_to_C_int(result);
+ if ((r <= KEYBOARD_NO_ACTION) &&
+ (r >= CURSOR_IN_VIEW))
+ res = (kbd_cursor_t)r;
}
- sp->prompting = false;
- sp->minibuffer_on = MINI_REPORT;
- clear_minibuffer_prompt(sp);
- return;
}
-#endif
- if (mus_strlen(str) > 0)
- {
- redirect_snd_print_to(printout_to_minibuffer, (void *)sp);
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- snd_report_result(snd_catch_any(eval_str_wrapper, (void *)str, str), str);
- redirect_everything_to(NULL, NULL);
- sp->selectioning = false;
- }
- else clear_minibuffer(sp);
+ handle_cursor(selected_channel(), res);
}
+
/* ---------------- other kbd built-in commands ---------------- */
static void cursor_moveto_end(chan_info *cp)
{
- cursor_moveto(cp, CURRENT_SAMPLES(cp) - 1);
+ cursor_moveto(cp, current_samples(cp) - 1);
}
@@ -1106,7 +377,7 @@ static void set_window_bounds(chan_info *cp, int count)
if (ap->x_ambit != 0.0)
{
double sx;
- sx = (((double)count / (double)SND_SRATE(cp->sound)) - ap->xmin) / ap->x_ambit;
+ sx = (((double)count / (double)snd_srate(cp->sound)) - ap->xmin) / ap->x_ambit;
reset_x_display(cp, sx, ap->zx);
}
}
@@ -1120,7 +391,7 @@ static void set_window_size(chan_info *cp, int count)
if (ap->x_ambit != 0.0)
{
double zx;
- zx = ((double)count / (((double)SND_SRATE(cp->sound)) * ap->x_ambit));
+ zx = ((double)count / (((double)snd_srate(cp->sound)) * ap->x_ambit));
reset_x_display(cp, ap->sx, zx);
}
}
@@ -1132,17 +403,17 @@ static void set_window_percentage(chan_info *cp, int count)
axis_info *ap;
double zx;
ap = cp->axis;
- zx = (double)count / (double)SND_SRATE(cp->sound);
+ zx = (double)count / (double)snd_srate(cp->sound);
reset_x_display(cp, ap->sx, zx);
}
-static void window_frames_selection(chan_info *cp)
+static void window_framples_selection(chan_info *cp)
{
double x0, x1;
int i;
- x0 = (((double)(selection_beg(cp))) / ((double)SND_SRATE(cp->sound)));
- x1 = x0 + ((double)(selection_len())) / ((double)(SND_SRATE(cp->sound)));
+ x0 = (((double)(selection_beg(cp))) / ((double)snd_srate(cp->sound)));
+ x1 = x0 + ((double)(selection_len())) / ((double)(snd_srate(cp->sound)));
set_x_axis_x0x1(cp, x0, x1);
for (i = 0; i < ss->max_sounds; i++)
{
@@ -1268,17 +539,23 @@ static chan_info *goto_next_graph(chan_info *cp, int count)
}
-void save_edits_with_prompt(snd_info *sp)
+void save_edits_from_kbd(snd_info *sp)
{
- io_error_t err;
- redirect_everything_to(printout_to_minibuffer, (void *)sp);
- err = save_edits(sp);
+ /* this used to prompt for confirmation, but we now use a dialog
+ */
+ redirect_everything_to(printout_to_status_area, (void *)sp);
+#if (!USE_NO_GUI)
+ {
+ io_error_t err;
+ err = save_edits(sp);
+ if (err == IO_NEED_WRITE_CONFIRMATION)
+ changed_file_dialog(sp);
+ }
+#else
+ save_edits_without_asking(sp);
+#endif
+
redirect_everything_to(NULL, NULL);
- if (err == IO_NEED_WRITE_CONFIRMATION)
- {
- prompt(sp, "file has changed; overwrite anyway?", NULL);
- sp->filing = SAVE_EDITS_FILING;
- }
}
@@ -1299,7 +576,7 @@ static mus_long_t get_count_1(char *number_buffer, int number_ctr, bool dot_seen
if (dot_seen)
{
float f;
- if (!(sscanf(number_buffer, "%f", &f)))
+ if (!(sscanf(number_buffer, "%12f", &f))) /* 12 is number_buffer size */
{
/* this doesn't happen for most bogus cases -- the C spec says "it is not possible to determine
* directly whether matches of literal character in the control string succeed or fail."
@@ -1308,9 +585,9 @@ static mus_long_t get_count_1(char *number_buffer, int number_ctr, bool dot_seen
snd_error("invalid number: %s", number_buffer);
return(0);
}
- return((mus_long_t)(f * SND_SRATE(cp->sound)));
+ return((mus_long_t)(f * snd_srate(cp->sound)));
}
- if (!(sscanf(number_buffer, "%d", &i)))
+ if (!(sscanf(number_buffer, "%12d", &i)))
{
snd_error("invalid number: %s", number_buffer);
return(0);
@@ -1324,11 +601,11 @@ static mus_long_t get_count(char *number_buffer, int number_ctr, bool dot_seen,
mus_long_t val, old_cursor;
val = get_count_1(number_buffer, number_ctr, dot_seen, cp);
if (!mark_wise) return(val);
- old_cursor = CURSOR(cp);
+ old_cursor = cursor_sample(cp);
if (!(goto_mark(cp, val)))
- string_to_minibuffer(cp->sound, "no such mark");
- val = CURSOR(cp) - old_cursor; /* will be 0 if no relevant marks */
- CURSOR(cp) = old_cursor;
+ set_status(cp->sound, "no such mark", false);
+ val = cursor_sample(cp) - old_cursor; /* will be 0 if no relevant marks */
+ cursor_sample(cp) = old_cursor;
return(val);
}
@@ -1403,8 +680,7 @@ static bool extended_mode = false;
void control_g(snd_info *sp)
{
- ss->cg_seen = true;
-
+ ss->C_g_typed = true;
number_ctr = 0;
counting = false;
dot_seen = false;
@@ -1413,6 +689,7 @@ void control_g(snd_info *sp)
defining_macro = false;
clear_stdin();
redirect_everything_to(NULL, NULL);
+ if (sp) clear_status_area(sp); /* do this before stop_playing! */
if ((ss->checking_explicitly) ||
(play_in_progress()))
@@ -1421,19 +698,24 @@ void control_g(snd_info *sp)
/* but, as in other such cases, it leaves this flag set so all subsequent uses of it need to clear it first */
stop_playing_all_sounds(PLAY_C_G); /* several scm files assume hooks called upon C-g -- could be region play, etc */
-
if (sp)
{
if (sp->applying) stop_applying(sp);
for_each_sound_chan(sp, stop_fft_in_progress);
- clear_minibuffer(sp);
}
+
+ if (selection_creation_in_progress())
+ deactivate_selection();
}
#ifndef SND_KEYMASK
#define SND_KEYMASK (snd_ControlMask | snd_MetaMask)
#endif
+#if HAVE_EXTENSION_LANGUAGE && (!USE_NO_GUI)
+ static chan_info *last_searcher = NULL;
+#endif
+
void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
{
@@ -1447,9 +729,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
static bool got_count = false;
static bool m = false;
int shift = 0;
- bool dont_clear_minibuffer = false, cursor_searching = false, clear_search = true;
int hashloc, i, state;
- mus_long_t loc;
static mus_long_t ext_count = 1;
static bool got_ext_count = false;
snd_info *sp;
@@ -1471,7 +751,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
if (defining_macro) continue_macro(keysym, state);
if (!m) count = 1; else m = false;
- if ((selection_creation_in_progress()) &&
+ if ((selection_creation_in_progress()) && (!counting) &&
((extended_mode) || (stop_selecting(keysym, state))))
finish_selection_creation();
@@ -1503,35 +783,26 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
}
#if HAVE_EXTENSION_LANGUAGE
- if ((state & snd_MetaMask) &&
- ((keysym == snd_K_X) || (keysym == snd_K_x)))
- {
- /* named macros invoked and saved here */
- prompt(sp, (char *)"M-x:", NULL);
- sp->macro_count = count;
- return;
- }
- hashloc = in_user_keymap(keysym, state, extended_mode);
+ hashloc = in_keymap(keysym, state, extended_mode);
if (hashloc != -1) /* found user-defined key */
{
extended_mode = false;
- call_user_keymap(hashloc, count);
+ call_keymap(hashloc, count);
return;
}
#endif
- /* if (sp->minibuffer_temp) clear_minibuffer(sp); */
-
if (state & snd_ControlMask)
{
if (!extended_mode)
{
+ mus_long_t loc;
/* -------------------------------- C-key -------------------------------- */
switch (keysym)
{
case snd_K_A: case snd_K_a:
cp->cursor_on = true;
- loc = (mus_long_t)(ap->x0 * SND_SRATE(sp));
+ loc = (mus_long_t)(ap->x0 * snd_srate(sp));
if ((loc + 1) == ap->losamp) loc = ap->losamp; /* handle dumb rounding problem */
cursor_moveto(cp, loc);
break;
@@ -1559,7 +830,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
case snd_K_E: case snd_K_e:
cp->cursor_on = true;
- loc = (mus_long_t)(ap->x1 * (double)SND_SRATE(sp));
+ loc = (mus_long_t)(ap->x1 * (double)snd_srate(sp));
if ((loc + 1) == ap->hisamp) loc = ap->hisamp;
cursor_moveto(cp, loc);
break;
@@ -1592,13 +863,12 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
case snd_K_I: case snd_K_i:
show_cursor_info(cp);
- dont_clear_minibuffer = true;
break;
case snd_K_J: case snd_K_j:
cp->cursor_on = true;
if (!(goto_mark(cp, count)))
- string_to_minibuffer(cp->sound, "no such mark");
+ set_status(cp->sound, "no such mark", false);
break;
case snd_K_K: case snd_K_k:
@@ -1618,13 +888,13 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
{
cp->cursor_on = true;
set_show_marks(true);
- mk = add_mark(CURSOR(cp), NULL, cp);
+ mk = add_mark(cursor_sample(cp), NULL, cp);
display_channel_marks(cp);
}
else
{
- if (!(delete_mark_samp(CURSOR(cp), cp)))
- report_in_minibuffer(cp->sound, "no mark at sample " MUS_LD, CURSOR(cp));
+ if (!(delete_mark_samp(cursor_sample(cp), cp)))
+ status_report(cp->sound, "no mark at sample %lld", cursor_sample(cp));
}
if ((keysym == snd_K_M) &&
(cp->sound->sync != 0))
@@ -1639,7 +909,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
{
if (count > 0)
{
- mk = add_mark(CURSOR(cp), NULL, si->cps[i]);
+ mk = add_mark(cursor_sample(cp), NULL, si->cps[i]);
if (mk)
{
set_mark_sync(mk, sync_num);
@@ -1648,8 +918,8 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
}
else
{
- if (!(delete_mark_samp(CURSOR(cp), si->cps[i])))
- report_in_minibuffer(cp->sound, "no mark at sample " MUS_LD, CURSOR(cp));
+ if (!(delete_mark_samp(cursor_sample(cp), si->cps[i])))
+ status_report(cp->sound, "no mark at sample %lld", cursor_sample(cp));
}
}
si = free_sync_info(si);
@@ -1664,7 +934,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
case snd_K_O: case snd_K_o:
cp->cursor_on = true;
- cursor_insert(cp, CURSOR(cp), count);
+ cursor_insert(cp, cursor_sample(cp), count);
break;
case snd_K_P: case snd_K_p:
@@ -1673,22 +943,24 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
break;
case snd_K_Q: case snd_K_q:
- play_channel(cp, CURSOR(cp), NO_END_SPECIFIED);
+ play_channel(cp, cursor_sample(cp), NO_END_SPECIFIED);
break;
-#if HAVE_EXTENSION_LANGUAGE
- case snd_K_R: case snd_K_r:
- cp->cursor_on = true;
- cursor_search(cp, -count);
- dont_clear_minibuffer = true;
- cursor_searching = true;
+#if HAVE_EXTENSION_LANGUAGE && (!USE_NO_GUI)
+ case snd_K_S: case snd_K_s:
+ if ((cp == last_searcher) &&
+ (find_dialog_is_active()))
+ find_dialog_find(NULL, READ_FORWARD, cp);
+ last_searcher = cp;
+ find_dialog(cp);
break;
- case snd_K_S: case snd_K_s:
- cp->cursor_on = true;
- cursor_search(cp, count);
- dont_clear_minibuffer = true;
- cursor_searching = true;
+ case snd_K_R: case snd_K_r:
+ if ((cp == last_searcher) &&
+ (find_dialog_is_active()))
+ find_dialog_find(NULL, READ_BACKWARD, cp);
+ last_searcher = cp;
+ find_dialog(cp);
break;
#endif
case snd_K_T: case snd_K_t:
@@ -1769,9 +1041,8 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
case snd_K_space:
if (count > 0)
{
- start_selection_creation(cp, CURSOR(cp));
- report_in_minibuffer(sp, "selection starts at " MUS_LD, CURSOR(cp));
- clear_search = false;
+ start_selection_creation(cp, cursor_sample(cp));
+ status_report(sp, "selection starts at %lld", cursor_sample(cp));
}
break;
@@ -1804,7 +1075,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
break;
default:
- report_in_minibuffer(sp, "C-%s undefined", key_to_name(keysym));
+ status_report(sp, "C-%s undefined", key_to_name(keysym));
break;
}
}
@@ -1815,11 +1086,6 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
extended_mode = false;
switch (keysym)
{
- case snd_K_A: case snd_K_a:
- get_amp_expression(sp, ext_count, OVER_SOUND);
- dont_clear_minibuffer = true;
- break;
-
case snd_K_B: case snd_K_b:
set_window_bounds(cp, ext_count);
break;
@@ -1828,57 +1094,19 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
hide_controls(sp);
break;
- case snd_K_D: case snd_K_d:
- prompt(sp, "eps file:", NULL);
- sp->printing = ((ext_count != 0) ? PRINTING : NOT_PRINTING);
- dont_clear_minibuffer = true;
- break;
-
- case snd_K_E: case snd_K_e:
- if (macro_size == 0)
- string_to_minibuffer(sp, "no macro active?");
- else
- {
- prompt(sp, "macro name:", NULL);
- sp->filing = MACRO_FILING;
- dont_clear_minibuffer = true;
- }
- break;
-
case snd_K_F: case snd_K_f:
- prompt(sp, "file:", NULL);
- sp->filing = INPUT_FILING;
- dont_clear_minibuffer = true;
+ make_open_file_dialog(FILE_READ_WRITE, true);
break;
case snd_K_G: case snd_K_g:
control_g(sp);
break;
- case snd_K_I: case snd_K_i:
- prompt(sp, "insert file:", NULL);
- sp->filing = INSERT_FILING;
- dont_clear_minibuffer = true;
- break;
-
case snd_K_J: case snd_K_j:
cp->cursor_on = true;
goto_mix(cp, ext_count);
break;
- case snd_K_L: case snd_K_l:
- prompt(sp, "load:", NULL);
- sp->loading = true;
- dont_clear_minibuffer = true;
- break;
-
- case snd_K_M: case snd_K_m:
- cp->cursor_on = true;
- prompt_named_mark(cp);
- set_show_marks(true);
- dont_clear_minibuffer = true;
- break;
-
case snd_K_O: case snd_K_o:
/* this doesn't change the View:Controls menu label because (sigh...) it's specific to the currently selected sound */
show_controls(sp);
@@ -1889,9 +1117,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
break;
case snd_K_Q: case snd_K_q:
- prompt(sp, "mix file:", NULL);
- sp->filing = CHANGE_FILING;
- dont_clear_minibuffer = true;
+ make_mix_file_dialog(true);
break;
case snd_K_R: case snd_K_r:
@@ -1899,8 +1125,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
break;
case snd_K_S: case snd_K_s:
- save_edits_with_prompt(sp);
- dont_clear_minibuffer = true;
+ save_edits_from_kbd(sp);
break;
case snd_K_T: case snd_K_t:
@@ -1915,15 +1140,19 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
set_window_percentage(cp, ext_count);
break;
+#if (!USE_NO_GUI)
case snd_K_W: case snd_K_w:
- prompt(sp, "file:", NULL);
- sp->filing = CHANNEL_FILING;
- dont_clear_minibuffer = true;
+ {
+ chan_info *cp;
+ cp = any_selected_channel(any_selected_sound());
+ make_channel_extract_dialog(cp->chan);
+ }
break;
+#endif
case snd_K_Z: case snd_K_z:
cp->cursor_on = true;
- cos_smooth(cp, CURSOR(cp), ext_count, OVER_SOUND);
+ cos_smooth(cp, cursor_sample(cp), ext_count, OVER_SOUND);
break;
case snd_K_Right:
@@ -1943,7 +1172,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
break;
default:
- report_in_minibuffer(sp, "C-x C-%s undefined", key_to_name(keysym));
+ status_report(sp, "C-x C-%s undefined", key_to_name(keysym));
break;
}
}
@@ -2013,7 +1242,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
break;
case snd_K_Home:
- redirect_everything_to(printout_to_minibuffer, (void *)sp);
+ redirect_everything_to(printout_to_status_area, (void *)sp);
sp = snd_update(sp);
redirect_everything_to(NULL, NULL);
break;
@@ -2021,7 +1250,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
case snd_K_space:
if (play_in_progress())
toggle_dac_pausing();
- else play_sound(sp, CURSOR(cp), NO_END_SPECIFIED); /* was deactivate_selection */
+ else play_sound(sp, cursor_sample(cp), NO_END_SPECIFIED); /* was deactivate_selection */
break;
case snd_keypad_Add:
@@ -2106,15 +1335,9 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
goto_listener();
listener_append(buf);
}
- else
- {
- prompt(sp, (char *)"M-x:", buf);
- sp->macro_count = count;
- clear_search = false;
- }
}
#else
- report_in_minibuffer(sp, "key %s%s undefined", (state & snd_MetaMask) ? "M-" : "", key_to_name(keysym));
+ status_report(sp, "key %s%s undefined", (state & snd_MetaMask) ? "M-" : "", key_to_name(keysym));
#endif
break;
}
@@ -2132,15 +1355,6 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
{
switch (keysym)
{
- case snd_K_A: case snd_K_a:
- if (selection_is_active_in_channel(cp))
- {
- get_amp_expression(sp, (!got_ext_count) ? 1 : ext_count, OVER_SELECTION);
- dont_clear_minibuffer = true;
- }
- else string_to_minibuffer(sp, "no active selection");
- break;
-
case snd_K_B: case snd_K_b:
cp->cursor_on = true;
handle_cursor(cp, CURSOR_ON_LEFT);
@@ -2148,19 +1362,13 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
case snd_K_C: case snd_K_c:
if (!(mark_define_region(cp, (!got_ext_count) ? 1 : ext_count)))
- string_to_minibuffer(cp->sound, "no such mark");
- break;
-
- case snd_K_D: case snd_K_d:
- prompt(sp, "temp dir:", NULL);
- sp->filing = TEMP_FILING;
- dont_clear_minibuffer = true;
+ set_status(cp->sound, "no such mark", false);
break;
case snd_K_E: case snd_K_e:
if (defining_macro)
{
- string_to_minibuffer(sp, "can't call macro while it's being defined");
+ set_status(sp, "can't call macro while it's being defined", false);
defining_macro = false;
macro_size = 0; /* so subsequent M-x e doesn't get something silly */
}
@@ -2176,16 +1384,6 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
handle_cursor(cp, CURSOR_ON_RIGHT);
break;
- case snd_K_I: case snd_K_i:
- insert_selection_or_region((!got_ext_count) ? 0 : ext_count, cp);
- break;
-
- case snd_K_J: case snd_K_j:
- prompt(sp, "mark:", NULL);
- sp->finding_mark = true;
- dont_clear_minibuffer = true;
- break;
-
case snd_K_K: case snd_K_k:
snd_close_file(sp);
break;
@@ -2194,7 +1392,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
cp->cursor_on = true;
if (selection_is_active_in_channel(cp))
cursor_moveto(cp, (mus_long_t)(selection_beg(cp) + 0.5 * selection_len()));
- else string_to_minibuffer(sp, "no active selection");
+ else set_status(sp, "no active selection", false);
handle_cursor_with_sync(cp, CURSOR_IN_MIDDLE);
break;
@@ -2224,7 +1422,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
case snd_K_V: case snd_K_v:
if (selection_is_active_in_channel(cp))
- window_frames_selection(cp);
+ window_framples_selection(cp);
else
{
bool complain = true;
@@ -2235,26 +1433,20 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
if ((i != cp->chan) &&
(selection_is_active_in_channel(sp->chans[i])))
{
- window_frames_selection(sp->chans[i]);
+ window_framples_selection(sp->chans[i]);
complain = false;
break;
}
}
if (complain)
- string_to_minibuffer(sp, "no active selection");
+ set_status(sp, "no active selection", false);
}
break;
- case snd_K_W: case snd_K_w:
- prompt(sp, "file:", NULL);
- sp->filing = SELECTION_FILING;
- dont_clear_minibuffer = true;
- break;
-
case snd_K_Z: case snd_K_z:
if (selection_is_active_in_channel(cp))
- cos_smooth(cp, CURSOR(cp), (!got_ext_count) ? 1 : ext_count, OVER_SELECTION);
- else string_to_minibuffer(sp, "no active selection");
+ cos_smooth(cp, cursor_sample(cp), (!got_ext_count) ? 1 : ext_count, OVER_SELECTION);
+ else set_status(sp, "no active selection", false);
break;
case snd_K_Right:
@@ -2285,59 +1477,41 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
case snd_K_openparen:
if (defining_macro)
- string_to_minibuffer(sp, "macro definition already in progress");
+ set_status(sp, "macro definition already in progress", false);
else
{
start_defining_macro();
- string_to_minibuffer(sp, "defining macro...");
+ set_status(sp, "defining macro...", false);
}
- clear_search = false;
break;
case snd_K_closeparen:
if (defining_macro)
{
stop_defining_macro();
- clear_minibuffer(sp);
+ clear_status_area(sp);
}
- clear_search = false;
- break;
-
- case snd_K_slash:
- cp->cursor_on = true;
- prompt_named_mark(cp);
- set_show_marks(true);
- dont_clear_minibuffer = true;
break;
default:
- report_in_minibuffer(sp, "C-x %s undefined", key_to_name(keysym));
+ status_report(sp, "C-x %s undefined", key_to_name(keysym));
break;
}
}
else
{
- report_in_minibuffer(sp, "C-x M-%s undefined", key_to_name(keysym));
+ status_report(sp, "C-x M-%s undefined", key_to_name(keysym));
}
}
}
if (!extended_mode) {got_ext_count = false; ext_count = 1;}
- if ((sp) && (clear_search))
- {
- if ((sp->minibuffer_on == MINI_FIND) && (!dont_clear_minibuffer))
- clear_minibuffer(sp);
- else
- if (!cursor_searching)
- sp->search_count = 0;
- }
}
-/* ---------------- Xen kbd bindings ---------------- */
char *make_key_name(char *buf, int buf_size, int key, int state, bool extended)
{
- mus_snprintf(buf, buf_size, "%s%s%s",
+ snprintf(buf, buf_size, "%s%s%s",
(extended) ? "C-x " : "",
(state & snd_ControlMask) ? ((state & snd_MetaMask) ? "CM-" : "C-") : ((state & snd_MetaMask) ? "M-" : ""),
(key == snd_K_less) ? "<" :
@@ -2350,106 +1524,108 @@ char *make_key_name(char *buf, int buf_size, int key, int state, bool extended)
}
-static int key_name_to_key(XEN key, const char *caller)
+static int key_name_to_key(Xen key, const char *caller)
{
/* Ruby thinks chars are strings */
- if (XEN_INTEGER_P(key))
- return(XEN_TO_C_INT(key)); /* includes 0xffc0 style keys, and in Ruby things like ?a */
+ if (Xen_is_integer(key))
+ return(Xen_integer_to_C_int(key)); /* includes 0xffc0 style keys, and in Ruby things like ?a */
#if (!HAVE_RUBY)
- if (XEN_CHAR_P(key))
- return((int)(XEN_TO_C_CHAR(key)));
+ if (Xen_is_char(key))
+ return((int)(Xen_char_to_C_char(key)));
#endif
#if USE_MOTIF
- return((int)XStringToKeysym(XEN_TO_C_STRING(key))); /* these are the X names: not "+" but "plus" etc */
+ return((int)XStringToKeysym(Xen_string_to_C_string(key))); /* these are the X names: not "+" but "plus" etc */
#endif
#if USE_GTK
- return((int)gdk_keyval_from_name(XEN_TO_C_STRING(key)));
+ return((int)gdk_keyval_from_name(Xen_string_to_C_string(key)));
#endif
return(0);
}
-static XEN check_for_key_error(int k, int s, const char *caller)
+static Xen check_for_key_error(int k, int s, const char *caller)
{
if ((k < MIN_KEY_CODE) || (k > MAX_KEY_CODE) ||
(s < MIN_KEY_STATE) || (s > MAX_KEY_STATE))
- XEN_ERROR(XEN_ERROR_TYPE("no-such-key"),
- XEN_LIST_4(C_TO_XEN_STRING("~A: no such key: ~A, state: ~A"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT(k),
- C_TO_XEN_INT(s)));
- return(XEN_FALSE);
+ Xen_error(Xen_make_error_type("no-such-key"),
+ Xen_list_4(C_string_to_Xen_string("~A: no such key: ~A, state: ~A"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer(k),
+ C_int_to_Xen_integer(s)));
+ return(Xen_false);
}
-static XEN g_key_binding(XEN key, XEN state, XEN cx_extended)
+static Xen g_key_binding(Xen key, Xen state, Xen cx_extended)
{
#define H_key_binding "(" S_key_binding " key :optional (state 0) extended): function bound to this key and associated \
modifiers. As in " S_bind_key ", state is the logical 'or' of ctrl=4, meta=8, and 'extended' is " PROC_TRUE " if the key is \
prefixed with C-x. 'key' can be a character, a key name such as 'Home', or an integer."
int i, k, s;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(key) || XEN_CHAR_P(key) || XEN_STRING_P(key), key, XEN_ARG_1, S_key_binding, "an integer, character, or string");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(state), state, XEN_ARG_2, S_key_binding, "an integer");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(cx_extended), cx_extended, XEN_ARG_3, S_key_binding, "a boolean");
+ Xen_check_type(Xen_is_integer(key) || Xen_is_char(key) || Xen_is_string(key), key, 1, S_key_binding, "an integer, character, or string");
+ Xen_check_type(Xen_is_integer_or_unbound(state), state, 2, S_key_binding, "an integer");
+ Xen_check_type(Xen_is_boolean_or_unbound(cx_extended), cx_extended, 3, S_key_binding, "a boolean");
k = key_name_to_key(key, S_key_binding);
- s = XEN_TO_C_INT_OR_ELSE(state, 0) & 0xfffe; /* no shift bit */
+ s = ((Xen_is_integer(state)) ? Xen_integer_to_C_int(state) : 0) & 0xfffe; /* no shift bit */
check_for_key_error(k, s, S_key_binding);
- i = in_user_keymap(k, s, XEN_TRUE_P(cx_extended));
+ i = in_keymap(k, s, Xen_is_true(cx_extended));
if (i >= 0)
- return(user_keymap[i].func);
+ return(keymap[i].func);
- return(XEN_UNDEFINED);
+ return(Xen_undefined);
}
-static XEN g_bind_key_1(XEN key, XEN state, XEN code, XEN cx_extended, XEN origin, XEN prefs_info, const char *caller)
+static Xen g_bind_key_1(Xen key, Xen state, Xen code, Xen cx_extended, Xen origin, Xen prefs_info, const char *caller)
{
- int args, k = 0, s;
+ int k, s;
bool e;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(key) || XEN_STRING_P(key) || XEN_CHAR_P(key), key, XEN_ARG_1, caller, "an integer, char, or string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(state), state, XEN_ARG_2, caller, "an integer");
- XEN_ASSERT_TYPE((XEN_FALSE_P(code) || XEN_PROCEDURE_P(code)), code, XEN_ARG_3, caller, PROC_FALSE " or a procedure");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(cx_extended), cx_extended, XEN_ARG_4, caller, "a boolean");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, XEN_ARG_5, caller, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(prefs_info), prefs_info, XEN_ARG_6, caller, "a string");
+ Xen_check_type(Xen_is_integer(key) || Xen_is_string(key) || Xen_is_char(key), key, 1, caller, "an integer, char, or string");
+ Xen_check_type(Xen_is_integer(state), state, 2, caller, "an integer");
+ Xen_check_type((Xen_is_false(code) || Xen_is_procedure(code)), code, 3, caller, PROC_FALSE " or a procedure");
+ Xen_check_type(Xen_is_boolean_or_unbound(cx_extended), cx_extended, 4, caller, "a boolean");
+ Xen_check_type(Xen_is_string_or_unbound(origin), origin, 5, caller, "a string");
+ Xen_check_type(Xen_is_string_or_unbound(prefs_info), prefs_info, 6, caller, "a string");
k = key_name_to_key(key, caller);
- s = XEN_TO_C_INT(state) & 0xfffe; /* get rid of shift bit */
+ s = Xen_integer_to_C_int(state) & 0xfffe; /* get rid of shift bit */
check_for_key_error(k, s, caller);
- e = (XEN_TRUE_P(cx_extended));
+ e = (Xen_is_true(cx_extended));
- if (XEN_FALSE_P(code))
- set_keymap_entry(k, s, 0, XEN_UNDEFINED, e, NULL, NULL);
+ if (Xen_is_false(code))
+ set_keymap_entry(k, s, 0, Xen_undefined, e, NULL, NULL);
else
{
char buf[256];
+ int args;
const char *comment = NULL, *prefs = NULL;
- args = XEN_REQUIRED_ARGS(code);
+ args = Xen_required_args(code);
if (args > 1)
{
- XEN errmsg;
+ Xen errmsg;
char *errstr;
errstr = mus_format(S_bind_key " function arg should take either zero or one args, not %d", args);
- errmsg = C_TO_XEN_STRING(errstr);
+ errmsg = C_string_to_Xen_string(errstr);
free(errstr);
return(snd_bad_arity_error(caller, errmsg, code));
}
- if (XEN_STRING_P(origin)) comment = XEN_TO_C_STRING(origin); else comment = make_key_name(buf, 256, k, s, e);
- if (XEN_STRING_P(prefs_info)) prefs = XEN_TO_C_STRING(prefs_info);
+ if (Xen_is_string(origin))
+ comment = Xen_string_to_C_string(origin);
+ else comment = make_key_name(buf, 256, k, s, e);
+ if (Xen_is_string(prefs_info)) prefs = Xen_string_to_C_string(prefs_info);
set_keymap_entry(k, s, args, code, e, comment, prefs);
}
-
return(code);
}
-static XEN g_bind_key(XEN key, XEN state, XEN code, XEN cx_extended, XEN origin, XEN prefs_info)
+static Xen g_bind_key(Xen key, Xen state, Xen code, Xen cx_extended, Xen origin, Xen prefs_info)
{
#define H_bind_key "(" S_bind_key " key modifiers func :optional extended origin prefs-info): \
causes 'key' (an integer, character, or string) \
@@ -2457,35 +1633,36 @@ when typed with 'modifiers' (0:none, 4:control, 8:meta) (and C-x if extended) to
zero or one arguments. If the function takes one argument, it is passed the preceding C-u number, if any. \
The function should return one of the cursor choices (e.g. " S_keyboard_no_action "). 'origin' is \
the name reported if an error occurs. The 'key' argument can be the X/Gtk name of the key (e.g. \"plus\" for \"+\" or \"Home\"), \
-the character on the key (#\a), or the integer corresponding to that character: (\"(char->integer #\a)\" in Scheme, \
-or \"?a\" in Ruby."
+the character on the key (#\\a), or the integer corresponding to that character: (\"(char->integer #\\a)\" in Scheme, \
+\"?a\" in Ruby, \
+or \"<char> a\" in Forth)."
return(g_bind_key_1(key, state, code, cx_extended, origin, prefs_info, S_bind_key));
}
-static XEN g_unbind_key(XEN key, XEN state, XEN cx_extended)
+static Xen g_unbind_key(Xen key, Xen state, Xen cx_extended)
{
#define H_unbind_key "(" S_unbind_key " key state :optional extended): undo the effect of a prior " S_bind_key " call."
- return(g_bind_key_1(key, state, XEN_FALSE, cx_extended, XEN_UNDEFINED, XEN_UNDEFINED, S_unbind_key));
+ return(g_bind_key_1(key, state, Xen_false, cx_extended, Xen_undefined, Xen_undefined, S_unbind_key));
}
-static XEN g_key(XEN kbd, XEN buckybits, XEN snd, XEN chn)
+static Xen g_key(Xen kbd, Xen buckybits, Xen snd, Xen chn)
{
#define H_key "(" S_key " key modifiers :optional snd chn): simulate typing 'key' with 'modifiers' in snd's channel chn"
chan_info *cp;
int k, s;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(kbd) || XEN_CHAR_P(kbd) || XEN_STRING_P(kbd), kbd, XEN_ARG_1, S_key, "an integer, character, or string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(buckybits), buckybits, XEN_ARG_2, S_key, "an integer");
- ASSERT_CHANNEL(S_key, snd, chn, 3);
+ Xen_check_type(Xen_is_integer(kbd) || Xen_is_char(kbd) || Xen_is_string(kbd), kbd, 1, S_key, "an integer, character, or string");
+ Xen_check_type(Xen_is_integer(buckybits), buckybits, 2, S_key, "an integer");
+ Snd_assert_channel(S_key, snd, chn, 3);
cp = get_cp(snd, chn, S_key);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
k = key_name_to_key(kbd, S_key);
- s = XEN_TO_C_INT(buckybits);
+ s = Xen_integer_to_C_int(buckybits);
check_for_key_error(k, s, S_key);
keyboard_command(cp, k, s);
@@ -2493,202 +1670,32 @@ static XEN g_key(XEN kbd, XEN buckybits, XEN snd, XEN chn)
}
-static XEN g_save_macros(XEN file)
-{
- #define H_save_macros "(" S_save_macros " :optional (file \"~/.snd\")): save keyboard macros file"
- FILE *fd = NULL;
- const char *name;
-
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ONLY_ARG, S_save_macros, "a string");
-
- name = XEN_TO_C_STRING(file);
- fd = FOPEN(name, "a");
- if (fd)
- {
- save_macro_state(fd);
- snd_fclose(fd, name);
- }
- else
- {
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_macros ": ~S ~A"),
- file,
- C_TO_XEN_STRING(snd_io_strerror())));
- }
- return(file);
-}
-
-
-/* this doesn't display the full prompt in motif, but I can't find any way to fix it */
-
-static XEN g_prompt_in_minibuffer(XEN msg, XEN callback, XEN snd, XEN raw)
-{
- #if HAVE_SCHEME
- #define prompt_example "(prompt-in-minibuffer \"what?\" (lambda (response) (snd-print response)))"
- #endif
- #if HAVE_RUBY
- #define prompt_example "prompt_in_minibuffer(\"what?\", lambda do | response | snd_print(response) end)"
- #endif
- #if HAVE_FORTH
- #define prompt_example "\"what?\" lambda: <{ response }> response snd-print ; prompt-in-minibuffer"
- #endif
-
- #define H_prompt_in_minibuffer "(" S_prompt_in_minibuffer " msg :optional callback snd raw): post msg in snd's minibuffer \
-then when the user eventually responds, invoke the function callback, if any, with the response. If 'raw' is " PROC_TRUE ", the response is \
-passed as a string to the prompt callback function; otherwise it is evaluated first.\n " prompt_example
-
- snd_info *sp;
-
- XEN_ASSERT_TYPE(XEN_STRING_P(msg), msg, XEN_ARG_1, S_prompt_in_minibuffer, "a string");
- XEN_ASSERT_TYPE((XEN_NOT_BOUND_P(callback)) || (XEN_BOOLEAN_P(callback)) || XEN_PROCEDURE_P(callback),
- callback, XEN_ARG_2, S_prompt_in_minibuffer, PROC_FALSE " or a procedure");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(raw), raw, XEN_ARG_4, S_prompt_in_minibuffer, "a boolean");
- ASSERT_SOUND(S_prompt_in_minibuffer, snd, 3);
-
- sp = get_sp(snd);
- if ((sp == NULL) || (sp->inuse != SOUND_NORMAL))
- return(snd_no_such_sound_error(S_prompt_in_minibuffer, snd));
-
- if (XEN_PROCEDURE_P(sp->prompt_callback))
- {
- snd_unprotect_at(sp->prompt_callback_loc);
- sp->prompt_callback_loc = NOT_A_GC_LOC;
- }
-
- sp->prompt_callback = XEN_FALSE; /* just in case something goes awry */
- if (XEN_BOUND_P(raw)) sp->raw_prompt = XEN_TO_C_BOOLEAN(raw); else sp->raw_prompt = false;
- if (XEN_PROCEDURE_P(callback))
- {
- char *errstr;
- XEN errmsg;
- errstr = procedure_ok(callback, 1, S_prompt_in_minibuffer, "callback", 2);
- if (errstr)
- {
- errmsg = C_TO_XEN_STRING(errstr);
- free(errstr);
- return(snd_bad_arity_error(S_prompt_in_minibuffer,
- errmsg,
- callback));
- }
- sp->prompt_callback_loc = snd_protect(callback);
- }
- sp->prompt_callback = callback;
- make_minibuffer_label(sp, XEN_TO_C_STRING(msg));
- sp->minibuffer_on = MINI_USER;
- sp->prompting = true;
-#if USE_MOTIF
- goto_minibuffer(sp); /* in gtk this somehow calls activate in the text widget, clearing our prompt? */
-#endif
- return(callback);
-}
-
-
-static XEN g_report_in_minibuffer(XEN msg, XEN snd, XEN as_error)
-{
- #define H_report_in_minibuffer "(" S_report_in_minibuffer " msg :optional snd as-error): display msg in snd's minibuffer. \
-If 'as-error' is " PROC_TRUE ", place the message in the minibuffer's error label."
- snd_info *sp;
-
- XEN_ASSERT_TYPE(XEN_STRING_P(msg), msg, XEN_ARG_1, S_report_in_minibuffer, "a string");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(as_error), as_error, XEN_ARG_2, S_report_in_minibuffer, "a boolean");
- ASSERT_SOUND(S_report_in_minibuffer, snd, 2);
-
- sp = get_sp(snd);
- if ((sp == NULL) || (sp->inuse != SOUND_NORMAL))
- return(snd_no_such_sound_error(S_report_in_minibuffer, snd));
-
- if (XEN_TRUE_P(as_error))
- display_minibuffer_error(sp, XEN_TO_C_STRING(msg));
- else string_to_minibuffer(sp, XEN_TO_C_STRING(msg));
- return(msg);
-}
-
-
-static XEN g_clear_minibuffer(XEN snd)
-{
- #define H_clear_minibuffer "(" S_clear_minibuffer " :optional snd) clears snd's minibuffer (erasing any \
-error message as well)."
- snd_info *sp;
-
- ASSERT_SOUND(S_clear_minibuffer, snd, 1);
-
- sp = get_sp(snd);
- if ((sp == NULL) || (sp->inuse != SOUND_NORMAL))
- return(snd_no_such_sound_error(S_clear_minibuffer, snd));
- clear_minibuffer(sp);
- return(XEN_FALSE);
-}
-
-
-#define S_snd_simulate_keystroke "snd-simulate-keystroke"
-
-static XEN g_snd_simulate_keystroke(XEN snd, XEN chn, XEN key, XEN state)
-{
- /* intended for testing */
- chan_info *cp;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(key), key, XEN_ARG_3, S_snd_simulate_keystroke, "key number (int)");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(state), state, XEN_ARG_4, S_snd_simulate_keystroke, "key state (int)");
- ASSERT_CHANNEL(S_snd_simulate_keystroke, snd, chn, 1);
- cp = get_cp(snd, chn, S_snd_simulate_keystroke);
- if (!cp) return(XEN_FALSE);
-
- keyboard_command(cp, XEN_TO_C_INT(key), XEN_TO_C_INT(state));
- return(key);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_3(g_key_binding_w, g_key_binding)
-XEN_ARGIFY_6(g_bind_key_w, g_bind_key)
-XEN_ARGIFY_3(g_unbind_key_w, g_unbind_key)
-XEN_ARGIFY_4(g_key_w, g_key)
-XEN_NARGIFY_1(g_save_macros_w, g_save_macros)
-XEN_ARGIFY_1(g_clear_minibuffer_w, g_clear_minibuffer)
-XEN_ARGIFY_3(g_report_in_minibuffer_w, g_report_in_minibuffer)
-XEN_ARGIFY_4(g_prompt_in_minibuffer_w, g_prompt_in_minibuffer)
-XEN_NARGIFY_4(g_snd_simulate_keystroke_w, g_snd_simulate_keystroke)
-#else
-#define g_key_binding_w g_key_binding
-#define g_bind_key_w g_bind_key
-#define g_unbind_key_w g_unbind_key
-#define g_key_w g_key
-#define g_save_macros_w g_save_macros
-#define g_clear_minibuffer_w g_clear_minibuffer
-#define g_report_in_minibuffer_w g_report_in_minibuffer
-#define g_prompt_in_minibuffer_w g_prompt_in_minibuffer
-#define g_snd_simulate_keystroke_w g_snd_simulate_keystroke
-#endif
+Xen_wrap_3_optional_args(g_key_binding_w, g_key_binding)
+Xen_wrap_6_optional_args(g_bind_key_w, g_bind_key)
+Xen_wrap_3_optional_args(g_unbind_key_w, g_unbind_key)
+Xen_wrap_4_optional_args(g_key_w, g_key)
void g_init_kbd(void)
{
+ int i;
+
#define H_cursor_in_view "The value for a " S_bind_key " function that moves the window so that the cursor is in the view"
#define H_cursor_on_left "The value for a " S_bind_key " function that moves the window so that the cursor is at the left edge"
#define H_cursor_on_right "The value for a " S_bind_key " function that moves the window so that the cursor is at the right edge"
#define H_cursor_in_middle "The value for a " S_bind_key " function that moves the window so that the cursor is in the middle"
#define H_keyboard_no_action "The value for a " S_bind_key " function that does nothing upon return"
- XEN_DEFINE_CONSTANT(S_cursor_in_view, CURSOR_IN_VIEW, H_cursor_in_view);
- XEN_DEFINE_CONSTANT(S_cursor_on_left, CURSOR_ON_LEFT, H_cursor_on_left);
- XEN_DEFINE_CONSTANT(S_cursor_on_right, CURSOR_ON_RIGHT, H_cursor_on_right);
- XEN_DEFINE_CONSTANT(S_cursor_in_middle, CURSOR_IN_MIDDLE, H_cursor_in_middle);
- XEN_DEFINE_CONSTANT(S_keyboard_no_action, KEYBOARD_NO_ACTION, H_keyboard_no_action);
-
- XEN_DEFINE_PROCEDURE(S_key_binding, g_key_binding_w, 1, 2, 0, H_key_binding);
- XEN_DEFINE_PROCEDURE(S_bind_key, g_bind_key_w, 3, 3, 0, H_bind_key);
- XEN_DEFINE_PROCEDURE(S_unbind_key, g_unbind_key_w, 2, 1, 0, H_unbind_key);
- XEN_DEFINE_PROCEDURE(S_key, g_key_w, 2, 2, 0, H_key);
- XEN_DEFINE_PROCEDURE(S_save_macros, g_save_macros_w, 1, 0, 0, H_save_macros);
- XEN_DEFINE_PROCEDURE(S_clear_minibuffer, g_clear_minibuffer_w, 0, 1, 0, H_clear_minibuffer);
- XEN_DEFINE_PROCEDURE(S_report_in_minibuffer, g_report_in_minibuffer_w, 1, 2, 0, H_report_in_minibuffer);
- XEN_DEFINE_PROCEDURE(S_prompt_in_minibuffer, g_prompt_in_minibuffer_w, 1, 3, 0, H_prompt_in_minibuffer);
- XEN_DEFINE_PROCEDURE(S_snd_simulate_keystroke, g_snd_simulate_keystroke_w, 4, 0, 0, "internal testing function");
-
-#if HAVE_SCHEME
- {
- int i;
- for (i = 0; i < NUM_BUILT_IN_KEY_BINDINGS; i++)
- built_in_key_bindings[i].func = XEN_FALSE;
- }
-#endif
+ Xen_define_constant(S_cursor_in_view, CURSOR_IN_VIEW, H_cursor_in_view);
+ Xen_define_constant(S_cursor_on_left, CURSOR_ON_LEFT, H_cursor_on_left);
+ Xen_define_constant(S_cursor_on_right, CURSOR_ON_RIGHT, H_cursor_on_right);
+ Xen_define_constant(S_cursor_in_middle, CURSOR_IN_MIDDLE, H_cursor_in_middle);
+ Xen_define_constant(S_keyboard_no_action, KEYBOARD_NO_ACTION, H_keyboard_no_action);
+
+ Xen_define_safe_procedure(S_key_binding, g_key_binding_w, 1, 2, 0, H_key_binding);
+ Xen_define_safe_procedure(S_bind_key, g_bind_key_w, 3, 3, 0, H_bind_key);
+ Xen_define_safe_procedure(S_unbind_key, g_unbind_key_w, 2, 1, 0, H_unbind_key);
+ Xen_define_safe_procedure(S_key, g_key_w, 2, 2, 0, H_key);
+
+ for (i = 0; i < NUM_BUILT_IN_KEYS; i++)
+ built_in_keys[i].func = Xen_false;
}
diff --git a/snd-ladspa.c b/snd-ladspa.c
index c41e8e9..f57962b 100644
--- a/snd-ladspa.c
+++ b/snd-ladspa.c
@@ -7,7 +7,7 @@
#include "snd.h"
-#if HAVE_LADSPA && HAVE_DLFCN_H && HAVE_DIRENT_H
+#if HAVE_LADSPA
#include <dlfcn.h>
#include <ladspa.h>
@@ -20,7 +20,6 @@
* added code to handle 0-input plugins ("analog osc" in swh for example).
* 21-Sep-03 added plugin help menu item.
* 1-Aug-03 added direct struct readers for LADSPA_Descriptor
- * 6-Jan-03 use free, not free.
* 21-Nov-02 better checks for C-g interrupt.
* 2-May-02 use mus_long_t for sample number.
* 14-Dec-01 various C++ cleanups.
@@ -29,14 +28,6 @@
* 20-Sep-01 changed location of pfInputBuffer to avoid glomming up the stack with a huge array.
*/
-/* ideally we'd post a dialog of controls for these guys, but I think that
- * depends on parsing rdf(?) files -- lrdf in Kjetil's ladspa.scm.
- * ladspa.scm unfortunately depended on the gui/real-time code that
- * was not translated from Guile to s7, mainly because the s7 GC is
- * not real-time safe, but I wonder if that actually matters. Someday...
- */
-
-
/*****************************************************************************/
@@ -63,35 +54,39 @@ static long g_lLADSPARepositoryCount;
static int lInputCount, lOutputCount;
-static void isLADSPAPluginSupported(const LADSPA_Descriptor *psDescriptor) {
+static void isLADSPAPluginSupported(const LADSPA_Descriptor *psDescriptor)
+{
unsigned int lIndex;
- LADSPA_PortDescriptor iPortDescriptor;
lInputCount = lOutputCount = 0;
- for (lIndex = 0; lIndex < psDescriptor->PortCount; lIndex++) {
- iPortDescriptor = psDescriptor->PortDescriptors[lIndex];
- if (LADSPA_IS_PORT_AUDIO(iPortDescriptor)) {
- if (LADSPA_IS_PORT_INPUT(iPortDescriptor))
- lInputCount++;
- else
- lOutputCount++;
+ for (lIndex = 0; lIndex < psDescriptor->PortCount; lIndex++)
+ {
+ LADSPA_PortDescriptor iPortDescriptor;
+ iPortDescriptor = psDescriptor->PortDescriptors[lIndex];
+ if (LADSPA_IS_PORT_AUDIO(iPortDescriptor))
+ {
+ if (LADSPA_IS_PORT_INPUT(iPortDescriptor))
+ lInputCount++;
+ else
+ lOutputCount++;
+ }
}
- }
}
/*****************************************************************************/
/* Assumes repository initialised, returns NULL if not found. */
-static const LADSPA_Descriptor *findLADSPADescriptor(const char *pcPackedFilename, const char *pcLabel) {
+static const LADSPA_Descriptor *findLADSPADescriptor(const char *pcPackedFilename, const char *pcLabel)
+{
long lIndex;
- LADSPAPluginInfo *psInfo;
- for (lIndex = 0; lIndex < g_lLADSPARepositoryCount; lIndex++) {
- psInfo = g_psLADSPARepository[lIndex];
- if ((mus_strcmp(pcLabel, psInfo->m_pcLabel)) &&
- (mus_strcmp(pcPackedFilename, psInfo->m_pcPackedFilename)))
- return psInfo->m_psDescriptor;
- }
-
+ for (lIndex = 0; lIndex < g_lLADSPARepositoryCount; lIndex++)
+ {
+ LADSPAPluginInfo *psInfo;
+ psInfo = g_psLADSPARepository[lIndex];
+ if ((mus_strcmp(pcLabel, psInfo->m_pcLabel)) &&
+ (mus_strcmp(pcPackedFilename, psInfo->m_pcPackedFilename)))
+ return psInfo->m_psDescriptor;
+ }
return NULL;
}
@@ -102,7 +97,8 @@ static const LADSPA_Descriptor *findLADSPADescriptor(const char *pcPackedFilenam
/* Allocate a new string. The string will contain a library filename,
stripped of path and .so (if present) */
-static char *packLADSPAFilename(const char * pcFilename) {
+static char *packLADSPAFilename(const char * pcFilename)
+{
const char *pcStart, * pcEnd;
char *pcPackedFilename;
@@ -127,26 +123,27 @@ static char *packLADSPAFilename(const char * pcFilename) {
/*****************************************************************************/
-static void unloadLADSPA(void) {
-
+static void unloadLADSPA(void)
+{
long lIndex;
LADSPAPluginInfo *pvPluginHandle = NULL;
- LADSPAPluginInfo *psInfo = NULL;
if (g_lLADSPARepositoryCount > 0)
pvPluginHandle = (LADSPAPluginInfo *)(g_psLADSPARepository[0]->m_pvPluginHandle);
pvPluginHandle++;
- for (lIndex = 0; lIndex < g_lLADSPARepositoryCount; lIndex++) {
- psInfo = g_psLADSPARepository[lIndex];
- free(psInfo->m_pcPackedFilename);
- /* Don't free Label or Descriptor - this memory is owned by the
- relevant plugin library. */
- if (pvPluginHandle != psInfo->m_pvPluginHandle) {
- pvPluginHandle = (LADSPAPluginInfo *)(psInfo->m_pvPluginHandle);
- dlclose(pvPluginHandle);
+ for (lIndex = 0; lIndex < g_lLADSPARepositoryCount; lIndex++)
+ {
+ LADSPAPluginInfo *psInfo;
+ psInfo = g_psLADSPARepository[lIndex];
+ free(psInfo->m_pcPackedFilename);
+ /* Don't free Label or Descriptor - this memory is owned by the
+ relevant plugin library. */
+ if (pvPluginHandle != psInfo->m_pvPluginHandle)
+ {
+ pvPluginHandle = (LADSPAPluginInfo *)(psInfo->m_pvPluginHandle);
+ dlclose(pvPluginHandle);
+ }
+ free(psInfo);
}
- free(psInfo);
- }
-
free(g_psLADSPARepository);
g_bLADSPAInitialised = 0;
}
@@ -159,9 +156,9 @@ static void unloadLADSPA(void) {
static void loadLADSPALibrary(void *pvPluginHandle,
char *pcFilename,
- LADSPA_Descriptor_Function fDescriptorFunction) {
-
- LADSPAPluginInfo **psOldRepository, *psInfo;
+ LADSPA_Descriptor_Function fDescriptorFunction)
+{
+ LADSPAPluginInfo **psOldRepository;
long lNewCapacity, lIndex;
const LADSPA_Descriptor *psDescriptor;
@@ -169,17 +166,19 @@ static void loadLADSPALibrary(void *pvPluginHandle,
(psDescriptor = fDescriptorFunction(lIndex)) != NULL;
lIndex++)
{
- if (g_lLADSPARepositoryCount == g_lLADSPARepositoryCapacity) {
- psOldRepository = g_psLADSPARepository;
- lNewCapacity = (g_lLADSPARepositoryCapacity
- + LADSPA_REPOSITORY_CAPACITY_STEP);
- g_psLADSPARepository = (LADSPAPluginInfo **)malloc(lNewCapacity * sizeof(LADSPAPluginInfo *));
- memcpy(g_psLADSPARepository,
- psOldRepository,
- sizeof(LADSPAPluginInfo *) * g_lLADSPARepositoryCount);
- g_lLADSPARepositoryCapacity = lNewCapacity;
- free(psOldRepository);
- }
+ LADSPAPluginInfo *psInfo;
+ if (g_lLADSPARepositoryCount == g_lLADSPARepositoryCapacity)
+ {
+ psOldRepository = g_psLADSPARepository;
+ lNewCapacity = (g_lLADSPARepositoryCapacity
+ + LADSPA_REPOSITORY_CAPACITY_STEP);
+ g_psLADSPARepository = (LADSPAPluginInfo **)malloc(lNewCapacity * sizeof(LADSPAPluginInfo *));
+ memcpy(g_psLADSPARepository,
+ psOldRepository,
+ sizeof(LADSPAPluginInfo *) * g_lLADSPARepositoryCount);
+ g_lLADSPARepositoryCapacity = lNewCapacity;
+ free(psOldRepository);
+ }
psInfo
= g_psLADSPARepository[g_lLADSPARepositoryCount++]
= (LADSPAPluginInfo *)malloc(sizeof(LADSPAPluginInfo));
@@ -197,16 +196,13 @@ static void loadLADSPALibrary(void *pvPluginHandle,
/* Search just the one directory. Called only from within
loadLADSPA. */
-static void loadLADSPADirectory(const char *pcDirectory) {
-
- char *pcFilename = NULL;
+static void loadLADSPADirectory(const char *pcDirectory)
+{
DIR *psDirectory;
LADSPA_Descriptor_Function fDescriptorFunction;
long lDirLength;
long iNeedSlash;
- struct dirent *psDirectoryEntry;
- void *pvPluginHandle;
-
+
lDirLength = strlen(pcDirectory);
if (!lDirLength)
return;
@@ -214,46 +210,54 @@ static void loadLADSPADirectory(const char *pcDirectory) {
iNeedSlash = 0;
else
iNeedSlash = 1;
-
+
psDirectory = opendir(pcDirectory);
if (!psDirectory)
return;
-
- while (true) {
-
- psDirectoryEntry = readdir(psDirectory);
- if (!psDirectoryEntry) {
- closedir(psDirectory);
- return;
- }
-
- pcFilename = (char *)malloc(lDirLength
- + strlen(psDirectoryEntry->d_name)
- + 1 + iNeedSlash);
- strcpy(pcFilename, pcDirectory);
- if (iNeedSlash)
- strcat(pcFilename, "/");
- strcat(pcFilename, psDirectoryEntry->d_name);
-
- pvPluginHandle = dlopen(pcFilename, RTLD_LAZY);
- if (pvPluginHandle) {
- /* This is a file and the file is a shared library! */
-
- dlerror();
- fDescriptorFunction
- = (LADSPA_Descriptor_Function)dlsym(pvPluginHandle,
- "ladspa_descriptor");
- if (dlerror() == NULL && fDescriptorFunction) {
- loadLADSPALibrary(pvPluginHandle, pcFilename, fDescriptorFunction);
- }
- else {
- /* It was a library, but not a LADSPA one. Unload it. */
- /* bil: this is not safe! Could be legit already-loaded library. */
- /* dlclose(pcFilename); */
- }
- }
- if (pcFilename) free(pcFilename);
- pcFilename = NULL;
+
+ while (true)
+ {
+ char *pcFilename = NULL;
+ struct dirent *psDirectoryEntry;
+ void *pvPluginHandle;
+
+ psDirectoryEntry = readdir(psDirectory);
+ if (!psDirectoryEntry)
+ {
+ closedir(psDirectory);
+ return;
+ }
+
+ pcFilename = (char *)malloc(lDirLength
+ + strlen(psDirectoryEntry->d_name)
+ + 1 + iNeedSlash);
+ strcpy(pcFilename, pcDirectory);
+ if (iNeedSlash)
+ strcat(pcFilename, "/");
+ strcat(pcFilename, psDirectoryEntry->d_name);
+
+ pvPluginHandle = dlopen(pcFilename, RTLD_LAZY);
+ if (pvPluginHandle)
+ {
+ /* This is a file and the file is a shared library! */
+
+ dlerror();
+ fDescriptorFunction
+ = (LADSPA_Descriptor_Function)dlsym(pvPluginHandle,
+ "ladspa_descriptor");
+ if (dlerror() == NULL && fDescriptorFunction)
+ {
+ loadLADSPALibrary(pvPluginHandle, pcFilename, fDescriptorFunction);
+ }
+ else
+ {
+ /* It was a library, but not a LADSPA one. Unload it. */
+ /* bil: this is not safe! Could be legit already-loaded library. */
+ /* dlclose(pcFilename); */
+ }
+ }
+ if (pcFilename) free(pcFilename);
+ pcFilename = NULL;
}
}
@@ -261,9 +265,8 @@ static void loadLADSPADirectory(const char *pcDirectory) {
/*****************************************************************************/
-static void loadLADSPA(void) {
-
- char *pcBuffer = NULL;
+static void loadLADSPA(void)
+{
const char *pcEnd;
const char *pcLADSPAPath;
const char *pcStart;
@@ -278,32 +281,34 @@ static void loadLADSPA(void) {
if (!pcLADSPAPath)
{
pcLADSPAPath = getenv("LADSPA_PATH");
- if (pcLADSPAPath == NULL) {
- snd_warning("Warning: You have not set " S_ladspa_dir " or the environment variable LADSPA_PATH.\nUsing /usr/lib/ladspa instead.");
- pcLADSPAPath = "/usr/lib/ladspa";
- }
+ if (pcLADSPAPath == NULL)
+ {
+ snd_warning("Warning: You have not set " S_ladspa_dir " or the environment variable LADSPA_PATH.\nUsing /usr/lib/ladspa instead.");
+ pcLADSPAPath = "/usr/lib/ladspa";
+ }
}
-
+
pcStart = pcLADSPAPath;
- while (*pcStart != '\0') {
- pcEnd = pcStart;
- while (*pcEnd != ':' && *pcEnd != '\0')
- pcEnd++;
-
- pcBuffer = (char *)malloc(1 + pcEnd - pcStart);
- if (pcEnd > pcStart)
- strncpy(pcBuffer, pcStart, pcEnd - pcStart);
- pcBuffer[pcEnd - pcStart] = '\0';
-
- loadLADSPADirectory(pcBuffer);
-
- pcStart = pcEnd;
- if (*pcStart == ':')
- pcStart++;
-
- if (pcBuffer) free(pcBuffer);
- pcBuffer = NULL;
- }
+ while (*pcStart != '\0')
+ {
+ char *pcBuffer;
+ pcEnd = pcStart;
+ while (*pcEnd != ':' && *pcEnd != '\0')
+ pcEnd++;
+
+ pcBuffer = (char *)malloc(1 + pcEnd - pcStart);
+ if (pcEnd > pcStart)
+ strncpy(pcBuffer, pcStart, pcEnd - pcStart);
+ pcBuffer[pcEnd - pcStart] = '\0';
+
+ loadLADSPADirectory(pcBuffer);
+
+ pcStart = pcEnd;
+ if (*pcStart == ':')
+ pcStart++;
+
+ free(pcBuffer);
+ }
}
@@ -329,7 +334,6 @@ static void ladspa_help_callback(GtkWidget *w, gpointer info)
{
/* help dialog with currently loaded plugins (and descriptors), refs to list-ladspa etc */
int len = 0;
- char *desc;
long lIndex;
LADSPAPluginInfo *psInfo;
const LADSPA_Descriptor *psDescriptor;
@@ -347,6 +351,7 @@ static void ladspa_help_callback(GtkWidget *w, gpointer info)
}
if (len > 0)
{
+ char *desc;
desc = (char *)calloc(len, sizeof(char));
for (lIndex = g_lLADSPARepositoryCount - 1; lIndex >= 0; lIndex--)
{
@@ -380,8 +385,8 @@ static void ladspa_help_callback(GtkWidget *w, gpointer info)
#define S_init_ladspa "init-ladspa"
-static XEN g_init_ladspa(void) {
-
+static Xen g_init_ladspa(void)
+{
#define H_init_ladspa "(" S_init_ladspa "): reinitialise LADSPA. This is not \
normally necessary as LADSPA automatically initialises itself, however \
it can be useful when the plugins on the system have changed."
@@ -411,7 +416,7 @@ it can be useful when the plugins on the system have changed."
SG_SIGNAL_CONNECT(m, "activate", ladspa_help_callback, NULL);
}
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -420,29 +425,29 @@ it can be useful when the plugins on the system have changed."
#define S_list_ladspa "list-ladspa"
-static XEN g_list_ladspa(void) {
-
+static Xen g_list_ladspa(void)
+{
#define H_list_ladspa "(" S_list_ladspa "): return a list of lists containing \
information of the LADSPA plugins currently available. For each plugin a \
list containing the plugin-file and plugin-label is included."
long lIndex;
- XEN xenList, xenPluginList;
- LADSPAPluginInfo *psInfo;
+ Xen xenList;
if (!g_bLADSPAInitialised)
loadLADSPA();
+ xenList = Xen_empty_list;
- xenList = XEN_EMPTY_LIST;
-
- for (lIndex = g_lLADSPARepositoryCount - 1; lIndex >= 0; lIndex--) {
- psInfo = g_psLADSPARepository[lIndex];
- xenPluginList = XEN_CONS(C_TO_XEN_STRING(psInfo->m_pcPackedFilename),
- XEN_CONS(C_TO_XEN_STRING((char *)psInfo->m_pcLabel),
- XEN_EMPTY_LIST));
- xenList = XEN_CONS(xenPluginList, xenList);
- }
-
+ for (lIndex = g_lLADSPARepositoryCount - 1; lIndex >= 0; lIndex--)
+ {
+ Xen xenPluginList;
+ LADSPAPluginInfo *psInfo;
+ psInfo = g_psLADSPARepository[lIndex];
+ xenPluginList = Xen_cons(C_string_to_Xen_string(psInfo->m_pcPackedFilename),
+ Xen_cons(C_string_to_Xen_string((char *)psInfo->m_pcLabel),
+ Xen_empty_list));
+ xenList = Xen_cons(xenPluginList, xenList);
+ }
return xenList;
}
@@ -452,9 +457,9 @@ list containing the plugin-file and plugin-label is included."
#define S_analyse_ladspa "analyse-ladspa"
-static XEN g_analyse_ladspa(XEN ladspa_plugin_filename,
- XEN ladspa_plugin_label) {
-
+static Xen g_analyse_ladspa(Xen ladspa_plugin_filename,
+ Xen ladspa_plugin_label)
+{
#define H_analyse_ladspa "(" S_analyse_ladspa " library plugin): return a list of information about \
a LADSPA plugin. The plugin is identified by library and plugin. \
The items are: plugin-name, plugin-maker, \
@@ -468,77 +473,78 @@ a user interface edit the parameter in a useful way."
const LADSPA_Descriptor *psDescriptor;
char *pcFilename;
const char *pcLabel, *pcTmp;
- XEN xenList, xenPortData;
+ Xen xenList, xenPortData;
LADSPA_PortRangeHintDescriptor iHint;
if (!g_bLADSPAInitialised)
loadLADSPA();
- XEN_ASSERT_TYPE(XEN_STRING_P(ladspa_plugin_filename),
+ Xen_check_type(Xen_is_string(ladspa_plugin_filename),
ladspa_plugin_filename,
- XEN_ARG_1,
+ 1,
S_analyse_ladspa, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(ladspa_plugin_label),
+ Xen_check_type(Xen_is_string(ladspa_plugin_label),
ladspa_plugin_label,
- XEN_ARG_2,
+ 2,
S_analyse_ladspa, "a string");
/* Plugin. */
- pcTmp = XEN_TO_C_STRING(ladspa_plugin_filename);
- pcLabel = XEN_TO_C_STRING(ladspa_plugin_label);
+ pcTmp = Xen_string_to_C_string(ladspa_plugin_filename);
+ pcLabel = Xen_string_to_C_string(ladspa_plugin_label);
pcFilename = packLADSPAFilename(pcTmp);
psDescriptor = findLADSPADescriptor(pcFilename, pcLabel);
free(pcFilename);
- if (!psDescriptor) {
- XEN_ERROR(XEN_ERROR_TYPE("no-such-plugin"),
- XEN_LIST_3(C_TO_XEN_STRING(S_analyse_ladspa ": no such plugin file: ~A, plugin label: ~A"),
- ladspa_plugin_filename,
- ladspa_plugin_label));
- return(XEN_FALSE);
- }
+ if (!psDescriptor)
+ {
+ Xen_error(Xen_make_error_type("no-such-plugin"),
+ Xen_list_3(C_string_to_Xen_string(S_analyse_ladspa ": no such plugin file: ~A, plugin label: ~A"),
+ ladspa_plugin_filename,
+ ladspa_plugin_label));
+ return(Xen_false);
+ }
isLADSPAPluginSupported(psDescriptor);
inchans = lInputCount;
outchans = lOutputCount;
- xenList = XEN_EMPTY_LIST;
+ xenList = Xen_empty_list;
for (lIndex = psDescriptor->PortCount - 1; lIndex >= 0; lIndex--)
if (LADSPA_IS_PORT_CONTROL(psDescriptor->PortDescriptors[lIndex])
- && LADSPA_IS_PORT_INPUT(psDescriptor->PortDescriptors[lIndex])) {
-
- iHint = psDescriptor->PortRangeHints[lIndex].HintDescriptor;
-
- xenPortData = XEN_EMPTY_LIST;
- if (LADSPA_IS_HINT_TOGGLED(iHint))
- xenPortData = XEN_CONS(C_TO_XEN_STRING("toggle"), xenPortData);
- if (LADSPA_IS_HINT_LOGARITHMIC(iHint))
- xenPortData = XEN_CONS(C_TO_XEN_STRING("logarithmic"), xenPortData);
- if (LADSPA_IS_HINT_INTEGER(iHint))
- xenPortData = XEN_CONS(C_TO_XEN_STRING("integer"), xenPortData);
- if (LADSPA_IS_HINT_SAMPLE_RATE(iHint))
- xenPortData = XEN_CONS(C_TO_XEN_STRING("sample_rate"), xenPortData);
- if (LADSPA_IS_HINT_BOUNDED_ABOVE(iHint))
- xenPortData = XEN_CONS(C_TO_XEN_STRING("maximum"),
- XEN_CONS(C_TO_XEN_DOUBLE(psDescriptor->PortRangeHints[lIndex].UpperBound),
- xenPortData));
- if (LADSPA_IS_HINT_BOUNDED_BELOW(iHint))
- xenPortData = XEN_CONS(C_TO_XEN_STRING("minimum"),
- XEN_CONS(C_TO_XEN_DOUBLE(psDescriptor->PortRangeHints[lIndex].LowerBound),
- xenPortData));
- xenPortData = XEN_CONS(C_TO_XEN_STRING((char *)psDescriptor->PortNames[lIndex]),
- xenPortData);
- xenList = XEN_CONS(xenPortData, xenList);
- }
+ && LADSPA_IS_PORT_INPUT(psDescriptor->PortDescriptors[lIndex]))
+ {
+ iHint = psDescriptor->PortRangeHints[lIndex].HintDescriptor;
+
+ xenPortData = Xen_empty_list;
+ if (LADSPA_IS_HINT_TOGGLED(iHint))
+ xenPortData = Xen_cons(C_string_to_Xen_string("toggle"), xenPortData);
+ if (LADSPA_IS_HINT_LOGARITHMIC(iHint))
+ xenPortData = Xen_cons(C_string_to_Xen_string("logarithmic"), xenPortData);
+ if (LADSPA_IS_HINT_INTEGER(iHint))
+ xenPortData = Xen_cons(C_string_to_Xen_string("integer"), xenPortData);
+ if (LADSPA_IS_HINT_SAMPLE_RATE(iHint))
+ xenPortData = Xen_cons(C_string_to_Xen_string("sample_rate"), xenPortData);
+ if (LADSPA_IS_HINT_BOUNDED_ABOVE(iHint))
+ xenPortData = Xen_cons(C_string_to_Xen_string("maximum"),
+ Xen_cons(C_double_to_Xen_real(psDescriptor->PortRangeHints[lIndex].UpperBound),
+ xenPortData));
+ if (LADSPA_IS_HINT_BOUNDED_BELOW(iHint))
+ xenPortData = Xen_cons(C_string_to_Xen_string("minimum"),
+ Xen_cons(C_double_to_Xen_real(psDescriptor->PortRangeHints[lIndex].LowerBound),
+ xenPortData));
+ xenPortData = Xen_cons(C_string_to_Xen_string((char *)psDescriptor->PortNames[lIndex]),
+ xenPortData);
+ xenList = Xen_cons(xenPortData, xenList);
+ }
- xenList = XEN_CONS(C_TO_XEN_STRING((char *)psDescriptor->Name),
- XEN_CONS(C_TO_XEN_STRING((char *)psDescriptor->Maker),
- XEN_CONS(C_TO_XEN_STRING((char *)psDescriptor->Copyright),
- XEN_CONS(XEN_LIST_4(C_TO_XEN_STRING("inputs:"),
- C_TO_XEN_INT(inchans),
- C_TO_XEN_STRING("outputs:"),
- C_TO_XEN_INT(outchans)),
- XEN_CONS(xenList, XEN_EMPTY_LIST)))));
+ xenList = Xen_cons(C_string_to_Xen_string((char *)psDescriptor->Name),
+ Xen_cons(C_string_to_Xen_string((char *)psDescriptor->Maker),
+ Xen_cons(C_string_to_Xen_string((char *)psDescriptor->Copyright),
+ Xen_cons(Xen_list_4(C_string_to_Xen_string("inputs:"),
+ C_int_to_Xen_integer(inchans),
+ C_string_to_Xen_string("outputs:"),
+ C_int_to_Xen_integer(outchans)),
+ Xen_cons(xenList, Xen_empty_list)))));
return(xenList);
}
@@ -548,11 +554,11 @@ a user interface edit the parameter in a useful way."
#define S_apply_ladspa "apply-ladspa"
-static XEN g_apply_ladspa(XEN reader,
- XEN ladspa_plugin_configuration,
- XEN samples,
- XEN origin,
- XEN snd, XEN chn) /* these two args added (much) later */
+static Xen g_apply_ladspa(Xen reader,
+ Xen ladspa_plugin_configuration,
+ Xen samples,
+ Xen origin,
+ Xen snd, Xen chn) /* these two args added (much) later */
{
#define H_apply_ladspa "(" S_apply_ladspa " reader (list library plugin pars) dur origin :optional snd chn): apply a LADSPA plugin to process a \
sound. The parameters are soundfile-reader, a ladspa-plugin-configuration, \
@@ -566,21 +572,20 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
char *pcFilename;
const char *pcLabel, *pcTmp;
LADSPA_Handle *psHandle;
- unsigned long lSampleRate, lPortIndex, lBlockSize, lSampleIndex;
+ unsigned long lSampleRate, lPortIndex, lSampleIndex;
mus_long_t lAt;
unsigned long lParameterCount;
- XEN xenParameters;
+ Xen xenParameters;
LADSPA_PortDescriptor iPortDescriptor;
LADSPA_Data *pfControls = NULL;
- chan_info *cp, *ncp;
+ chan_info *cp;
snd_info *sp;
char *ofile, *msg;
- int i, j, ofd, datumb, err = 0, inchans = 1, readers = 0, outchans = 1;
+ int i, ofd, datumb, inchans = 1, readers = 0, outchans = 1;
mus_long_t num;
snd_fd **sf = NULL;
file_info *hdr;
- XEN errmsg;
- mus_sample_t **data;
+ mus_float_t **data;
LADSPA_Data **pfInputBuffer = NULL;
LADSPA_Data **pfOutputBuffer = NULL;
io_error_t io_err = IO_NO_ERROR;
@@ -591,69 +596,71 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
loadLADSPA();
/* First parameter should be a file reader or list thereof. */
- XEN_ASSERT_TYPE(sampler_p(reader) || XEN_LIST_P(reader) || XEN_FALSE_P(reader),
+ Xen_check_type(is_sampler(reader) || Xen_is_list(reader) || Xen_is_false(reader),
reader,
- XEN_ARG_1,
+ 1,
S_apply_ladspa, "a sampler, a list of readers, or " PROC_FALSE);
- if (XEN_LIST_P(reader))
- readers = XEN_LIST_LENGTH(reader);
+ if (Xen_is_list(reader))
+ readers = Xen_list_length(reader);
else
{
- if (!(XEN_FALSE_P(reader)))
+ if (!(Xen_is_false(reader)))
readers = 1;
}
/* Second parameter should be a list of two strings, then any number
(inc 0) of numbers. */
- if ((XEN_LIST_LENGTH(ladspa_plugin_configuration) < 2) ||
- (!(XEN_STRING_P(XEN_CAR(ladspa_plugin_configuration)))) ||
- (!(XEN_STRING_P(XEN_CADR(ladspa_plugin_configuration)))))
- XEN_ASSERT_TYPE(0, ladspa_plugin_configuration, XEN_ARG_2, S_apply_ladspa, "a list of 2 or more strings");
+ if ((Xen_list_length(ladspa_plugin_configuration) < 2) ||
+ (!(Xen_is_string(Xen_car(ladspa_plugin_configuration)))) ||
+ (!(Xen_is_string(Xen_cadr(ladspa_plugin_configuration)))))
+ Xen_check_type(0, ladspa_plugin_configuration, 2, S_apply_ladspa, "a list of 2 or more strings");
/* Third parameter is the number of samples to process. */
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samples),
+ Xen_check_type(Xen_is_number(samples),
samples,
- XEN_ARG_3,
+ 3,
S_apply_ladspa, "a number");
/* Get sample count. */
- num = XEN_TO_C_INT64_T(samples);
- if (num <= 0) return(XEN_FALSE);
+ num = Xen_llong_to_C_llong(samples);
+ if (num <= 0) return(Xen_false);
/* The fourth parameter is a tag to identify the edit. */
- XEN_ASSERT_TYPE(XEN_STRING_P(origin),
+ Xen_check_type(Xen_is_string(origin),
origin,
- XEN_ARG_4,
+ 4,
S_apply_ladspa, "a string");
- ASSERT_CHANNEL(S_apply_ladspa, snd, chn, 5);
+ Snd_assert_channel(S_apply_ladspa, snd, chn, 5);
/* Plugin. */
- pcTmp = XEN_TO_C_STRING(XEN_CAR(ladspa_plugin_configuration));
- pcLabel = XEN_TO_C_STRING(XEN_CADR(ladspa_plugin_configuration));
+ pcTmp = Xen_string_to_C_string(Xen_car(ladspa_plugin_configuration));
+ pcLabel = Xen_string_to_C_string(Xen_cadr(ladspa_plugin_configuration));
pcFilename = packLADSPAFilename(pcTmp);
psDescriptor = findLADSPADescriptor(pcFilename, pcLabel);
free(pcFilename);
if (!psDescriptor)
- XEN_ERROR(XEN_ERROR_TYPE("no-such-plugin"),
- XEN_LIST_2(C_TO_XEN_STRING(S_apply_ladspa ": no such plugin: ~A"),
+ Xen_error(Xen_make_error_type("no-such-plugin"),
+ Xen_list_2(C_string_to_Xen_string(S_apply_ladspa ": no such plugin: ~A"),
ladspa_plugin_configuration));
isLADSPAPluginSupported(psDescriptor);
inchans = lInputCount;
outchans = lOutputCount;
if (outchans == 0)
- XEN_ERROR(XEN_ERROR_TYPE("plugin-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_apply_ladspa ": plugins must have at least 1 output, ~A"),
+ Xen_error(Xen_make_error_type("plugin-error"),
+ Xen_list_2(C_string_to_Xen_string(S_apply_ladspa ": plugins must have at least 1 output, ~A"),
ladspa_plugin_configuration));
if (inchans != readers)
{
+ Xen errmsg;
+
msg = mus_format("Ladspa %s required inputs (%d) != samplers (%d)", pcLabel, inchans, readers);
- errmsg = C_TO_XEN_STRING(msg);
+ errmsg = C_string_to_Xen_string(msg);
free(msg);
- XEN_ERROR(XEN_ERROR_TYPE("plugin-error"),
- XEN_LIST_3(C_TO_XEN_STRING(S_apply_ladspa ": ~A, ~A"),
+ Xen_error(Xen_make_error_type("plugin-error"),
+ Xen_list_3(C_string_to_Xen_string(S_apply_ladspa ": ~A, ~A"),
ladspa_plugin_configuration,
errmsg));
}
@@ -664,22 +671,22 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
&& LADSPA_IS_PORT_INPUT(psDescriptor->PortDescriptors[lPortIndex]))
lParameterCount++;
msg = mus_format("a list of 2 strings + %d parameters", (int)lParameterCount);
- XEN_ASSERT_TYPE(XEN_LIST_LENGTH(ladspa_plugin_configuration) == (int)(2 + lParameterCount),
+ Xen_check_type(Xen_list_length(ladspa_plugin_configuration) == (int)(2 + lParameterCount),
ladspa_plugin_configuration,
- XEN_ARG_2,
+ 2,
S_apply_ladspa,
msg);
free(msg);
pfControls = (LADSPA_Data *)malloc(psDescriptor->PortCount * sizeof(LADSPA_Data));
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
cp = get_cp(snd, chn, S_apply_ladspa);
else
{
if (inchans > 0)
{
- if (XEN_LIST_P(reader))
- tmp_fd = xen_to_sampler(XEN_LIST_REF(reader, 0));
+ if (Xen_is_list(reader))
+ tmp_fd = xen_to_sampler(Xen_list_ref(reader, 0));
else tmp_fd = xen_to_sampler(reader);
cp = tmp_fd->cp;
cp_from_reader = true;
@@ -689,26 +696,27 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
sp = cp->sound;
/* Get parameters. */
- xenParameters = XEN_COPY_ARG(XEN_CDR(XEN_CDR(ladspa_plugin_configuration)));
+ xenParameters = Xen_copy_arg(Xen_cdr(Xen_cdr(ladspa_plugin_configuration)));
for (lPortIndex = 0; lPortIndex < psDescriptor->PortCount; lPortIndex++)
{
- iPortDescriptor = psDescriptor->PortDescriptors[lPortIndex];
- if (LADSPA_IS_PORT_CONTROL(iPortDescriptor)
- && LADSPA_IS_PORT_INPUT(iPortDescriptor)) {
- XEN_ASSERT_TYPE(XEN_NUMBER_P(XEN_CAR(xenParameters)),
- ladspa_plugin_configuration,
- XEN_ARG_2,
- S_apply_ladspa, "a number");
- pfControls[lPortIndex] = (LADSPA_Data)XEN_TO_C_DOUBLE(XEN_CAR(xenParameters));
- xenParameters = XEN_CDR(xenParameters);
+ iPortDescriptor = psDescriptor->PortDescriptors[lPortIndex];
+ if (LADSPA_IS_PORT_CONTROL(iPortDescriptor)
+ && LADSPA_IS_PORT_INPUT(iPortDescriptor))
+ {
+ Xen_check_type(Xen_is_number(Xen_car(xenParameters)),
+ ladspa_plugin_configuration,
+ 2,
+ S_apply_ladspa, "a number");
+ pfControls[lPortIndex] = (LADSPA_Data)Xen_real_to_C_double(Xen_car(xenParameters));
+ xenParameters = Xen_cdr(xenParameters);
+ }
}
- }
-
+
lSampleRate = (unsigned long)(sp->hdr->srate);
psHandle = (LADSPA_Handle *)psDescriptor->instantiate(psDescriptor, lSampleRate);
if (!psHandle)
- XEN_ERROR(XEN_ERROR_TYPE("plugin-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_apply_ladspa ": ~A plugin did not instantiate"),
+ Xen_error(Xen_make_error_type("plugin-error"),
+ Xen_list_2(C_string_to_Xen_string(S_apply_ladspa ": ~A plugin did not instantiate"),
ladspa_plugin_configuration));
/* Temporary file name. */
@@ -716,10 +724,10 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
/* Create initial header for output file */
hdr = make_temp_header(ofile,
- SND_SRATE(sp),
+ snd_srate(sp),
outchans,
num,
- XEN_TO_C_STRING(origin));
+ Xen_string_to_C_string(origin));
/* Open the output file, using the header we've been working on. */
ofd = open_temp_file(ofile, outchans, hdr, &io_err);
@@ -730,27 +738,27 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
free_file_info(hdr);
if (pfControls) free(pfControls);
psDescriptor->cleanup(psHandle);
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_apply_ladspa ": can't save ~S, ~A"),
- C_TO_XEN_STRING(ofile),
- C_TO_XEN_STRING(snd_io_strerror())));
- return(XEN_FALSE);
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_apply_ladspa ": can't save ~S, ~A"),
+ C_string_to_Xen_string(ofile),
+ C_string_to_Xen_string(snd_io_strerror())));
+ return(Xen_false);
}
snd_warning("%s %s: %s", S_apply_ladspa, ofile, io_error_name(io_err));
}
/* Tidy up header. */
- datumb = mus_bytes_per_sample(hdr->format);
+ datumb = mus_bytes_per_sample(hdr->sample_type);
if (readers > 0)
{
sf = (snd_fd **)calloc(readers, sizeof(snd_fd *));
/* Local version of sound descriptor. */
- if (XEN_LIST_P(reader))
+ if (Xen_is_list(reader))
{
for (i = 0; i < readers; i++)
- if (!(XEN_FALSE_P(XEN_LIST_REF(reader, i))))
- sf[i] = xen_to_sampler(XEN_LIST_REF(reader, i));
+ if (!(Xen_is_false(Xen_list_ref(reader, i))))
+ sf[i] = xen_to_sampler(Xen_list_ref(reader, i));
}
else sf[0] = xen_to_sampler(reader);
}
@@ -765,31 +773,33 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
for (i = 0; i < outchans; i++)
pfOutputBuffer[i] = (LADSPA_Data *)calloc(MAX_BUFFER_SIZE, sizeof(LADSPA_Data));
- data = (mus_sample_t **)calloc(outchans, sizeof(mus_sample_t *));
+ data = (mus_float_t **)calloc(outchans, sizeof(mus_float_t *));
for (i = 0; i < outchans; i++)
- data[i] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
+ data[i] = (mus_float_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_float_t));
/* Connect input and output control ports. */
{
int inc = 0, outc = 0;
- for (lPortIndex = 0; lPortIndex < psDescriptor->PortCount; lPortIndex++) {
- if (LADSPA_IS_PORT_CONTROL(psDescriptor->PortDescriptors[lPortIndex])) {
- psDescriptor->connect_port(psHandle,
- lPortIndex,
- pfControls + lPortIndex);
- /* (Output control data is quietly lost.) */
- }
- else /* AUDIO */ {
- if (LADSPA_IS_PORT_INPUT(psDescriptor->PortDescriptors[lPortIndex]))
- psDescriptor->connect_port(psHandle,
- lPortIndex,
- pfInputBuffer[inc++]);
- else
- psDescriptor->connect_port(psHandle,
- lPortIndex,
- pfOutputBuffer[outc++]);
+ for (lPortIndex = 0; lPortIndex < psDescriptor->PortCount; lPortIndex++)
+ {
+ if (LADSPA_IS_PORT_CONTROL(psDescriptor->PortDescriptors[lPortIndex]))
+ {
+ psDescriptor->connect_port(psHandle,
+ lPortIndex,
+ pfControls + lPortIndex);
+ /* (Output control data is quietly lost.) */
+ }
+ else /* AUDIO */ {
+ if (LADSPA_IS_PORT_INPUT(psDescriptor->PortDescriptors[lPortIndex]))
+ psDescriptor->connect_port(psHandle,
+ lPortIndex,
+ pfInputBuffer[inc++]);
+ else
+ psDescriptor->connect_port(psHandle,
+ lPortIndex,
+ pfOutputBuffer[outc++]);
+ }
}
- }
}
if (psDescriptor->activate)
@@ -799,7 +809,8 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
ss->stopped_explicitly = false;
while (lAt < num)
{
-
+ int err;
+ unsigned long lBlockSize;
/* Decide how much audio to process this frame. */
lBlockSize = num - lAt;
if (lBlockSize > MAX_BUFFER_SIZE)
@@ -827,7 +838,7 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
/* Prepare the output data. */
for (i = 0; i < outchans; i++)
for (lSampleIndex = 0; lSampleIndex < lBlockSize; lSampleIndex++)
- data[i][lSampleIndex] = MUS_FLOAT_TO_SAMPLE(pfOutputBuffer[i][lSampleIndex]);
+ data[i][lSampleIndex] = (pfOutputBuffer[i][lSampleIndex]);
/* Send the output data to the outside world. */
err = mus_file_write(ofd,
@@ -835,7 +846,7 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
lBlockSize - 1,
outchans,
data);
- if (err == -1)
+ if (err != MUS_NO_ERROR)
break;
if (ss->stopped_explicitly)
break;
@@ -856,10 +867,12 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
hdr = free_file_info(hdr);
if (!(ss->stopped_explicitly))
{
+ int j;
if (outchans > 1)
remember_temp(ofile, outchans);
for (i = 0, j = 0; i < outchans; i++)
{
+ chan_info *ncp;
mus_long_t beg;
if ((cp_from_reader) && (sf) && (sf[j]))
{
@@ -879,7 +892,7 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
ncp,
i,
(outchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
- XEN_TO_C_STRING(origin),
+ Xen_string_to_C_string(origin),
ncp->edit_ctr))
update_graph(ncp);
j++;
@@ -888,7 +901,7 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
}
else
{
- report_in_minibuffer(sp, S_apply_ladspa " interrupted");
+ status_report(sp, S_apply_ladspa " interrupted");
ss->stopped_explicitly = false;
}
if (ofile) free(ofile);
@@ -908,7 +921,7 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
if (sf) free(sf);
if (pfControls) free(pfControls);
free(data);
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -924,29 +937,29 @@ Information about parameters can be acquired using " S_analyse_ladspa "."
#endif
#if HAVE_SCHEME
- #define DEFINE_INTEGER(Name) s7_define_constant(s7, #Name, C_TO_XEN_INT(Name))
+ #define DEFINE_INTEGER(Name) s7_define_constant(s7, #Name, C_int_to_Xen_integer(Name))
#else
- #define DEFINE_INTEGER(Name) XEN_DEFINE(#Name, C_TO_XEN_INT(Name))
+ #define DEFINE_INTEGER(Name) Xen_define(#Name, C_int_to_Xen_integer(Name))
#endif
-#define DEFINE_READER(Name, Value, Doc) XEN_DEFINE_PROCEDURE(FIELD_PREFIX #Name, Value, 1, 0, 0, Doc)
+#define DEFINE_READER(Name, Value, Doc) Xen_define_procedure(FIELD_PREFIX #Name, Value, 1, 0, 0, Doc)
-#define C_TO_XEN_Ladspa_Descriptor(Value) \
- ((Value) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("Ladspa-Descriptor"), XEN_WRAP_C_POINTER(Value)) : XEN_FALSE)
-#define XEN_TO_C_Ladspa_Descriptor(Value) ((LADSPA_Descriptor *)(XEN_UNWRAP_C_POINTER(XEN_CADR(Value))))
-#define XEN_Ladspa_Descriptor_P(Value) (XEN_LIST_P(Value) && (XEN_LIST_LENGTH(Value) >= 2) && (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp("Ladspa-Descriptor", XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
+#define C_to_Xen_Ladspa_Descriptor(Value) \
+ ((Value) ? Xen_list_2(C_string_to_Xen_symbol("Ladspa-Descriptor"), Xen_wrap_C_pointer(Value)) : Xen_false)
+#define Xen_to_C_Ladspa_Descriptor(Value) ((LADSPA_Descriptor *)(Xen_unwrap_C_pointer(Xen_cadr(Value))))
+#define Xen_is_Ladspa_Descriptor(Value) (Xen_is_list(Value) && (Xen_list_length(Value) >= 2) && (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp("Ladspa-Descriptor", Xen_symbol_to_C_string(Xen_car(Value))) == 0))
-#define C_TO_XEN_Ladspa_Handle(Value) \
- ((Value) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("Ladspa-Handle"), XEN_WRAP_C_POINTER(Value)) : XEN_FALSE)
-#define XEN_TO_C_Ladspa_Handle(Value) ((LADSPA_Handle *)(XEN_UNWRAP_C_POINTER(XEN_CADR(Value))))
-#define XEN_Ladspa_Handle_P(Value) (XEN_LIST_P(Value) && (XEN_LIST_LENGTH(Value) >= 2) && (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp("Ladspa-Handle", XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
+#define C_to_Xen_Ladspa_Handle(Value) \
+ ((Value) ? Xen_list_2(C_string_to_Xen_symbol("Ladspa-Handle"), Xen_wrap_C_pointer(Value)) : Xen_false)
+#define Xen_to_C_Ladspa_Handle(Value) ((LADSPA_Handle *)(Xen_unwrap_C_pointer(Xen_cadr(Value))))
+#define Xen_is_Ladspa_Handle(Value) (Xen_is_list(Value) && (Xen_list_length(Value) >= 2) && (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp("Ladspa-Handle", Xen_symbol_to_C_string(Xen_car(Value))) == 0))
#define S_ladspa_descriptor "ladspa-descriptor"
-static XEN g_ladspa_descriptor(XEN ladspa_plugin_filename, XEN ladspa_plugin_label)
+static Xen g_ladspa_descriptor(Xen ladspa_plugin_filename, Xen ladspa_plugin_label)
{
#define H_ladspa_descriptor "(" S_ladspa_descriptor " library plugin): return the descriptor \
associated with the given plugin."
@@ -954,118 +967,118 @@ associated with the given plugin."
char *pcFilename;
const char *pcLabel, *pcTmp;
if (!g_bLADSPAInitialised) loadLADSPA();
- XEN_ASSERT_TYPE(XEN_STRING_P(ladspa_plugin_filename), ladspa_plugin_filename, XEN_ARG_1, S_ladspa_descriptor, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(ladspa_plugin_label), ladspa_plugin_label, XEN_ARG_2, S_ladspa_descriptor, "a string");
- pcTmp = XEN_TO_C_STRING(ladspa_plugin_filename);
- pcLabel = XEN_TO_C_STRING(ladspa_plugin_label);
+ Xen_check_type(Xen_is_string(ladspa_plugin_filename), ladspa_plugin_filename, 1, S_ladspa_descriptor, "a string");
+ Xen_check_type(Xen_is_string(ladspa_plugin_label), ladspa_plugin_label, 2, S_ladspa_descriptor, "a string");
+ pcTmp = Xen_string_to_C_string(ladspa_plugin_filename);
+ pcLabel = Xen_string_to_C_string(ladspa_plugin_label);
pcFilename = packLADSPAFilename(pcTmp);
psDescriptor = findLADSPADescriptor(pcFilename, pcLabel);
free(pcFilename);
- if (!psDescriptor) return(XEN_FALSE);
- return(C_TO_XEN_Ladspa_Descriptor(psDescriptor));
+ if (!psDescriptor) return(Xen_false);
+ return(C_to_Xen_Ladspa_Descriptor(psDescriptor));
}
-static XEN g_ladspa_Label(XEN ptr)
+static Xen g_ladspa_Label(Xen ptr)
{
#define H_ladspa_Label "(" FIELD_PREFIX "Label descriptor): plugin identifier"
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "Label", "Ladspa descriptor");
- return(C_TO_XEN_STRING((XEN_TO_C_Ladspa_Descriptor(ptr))->Label));
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "Label", "Ladspa descriptor");
+ return(C_string_to_Xen_string((Xen_to_C_Ladspa_Descriptor(ptr))->Label));
}
-static XEN g_ladspa_Name(XEN ptr)
+static Xen g_ladspa_Name(Xen ptr)
{
#define H_ladspa_Name "(" FIELD_PREFIX "Name descriptor): name of plugin"
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "Name", "Ladspa descriptor");
- return(C_TO_XEN_STRING((XEN_TO_C_Ladspa_Descriptor(ptr))->Name));
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "Name", "Ladspa descriptor");
+ return(C_string_to_Xen_string((Xen_to_C_Ladspa_Descriptor(ptr))->Name));
}
-static XEN g_ladspa_Copyright(XEN ptr)
+static Xen g_ladspa_Copyright(Xen ptr)
{
#define H_ladspa_Copyright "(" FIELD_PREFIX "Copyright descriptor): plugin copyright or 'None'"
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "Copyright", "Ladspa descriptor");
- return(C_TO_XEN_STRING((XEN_TO_C_Ladspa_Descriptor(ptr))->Copyright));
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "Copyright", "Ladspa descriptor");
+ return(C_string_to_Xen_string((Xen_to_C_Ladspa_Descriptor(ptr))->Copyright));
}
-static XEN g_ladspa_Maker(XEN ptr)
+static Xen g_ladspa_Maker(Xen ptr)
{
#define H_ladspa_Maker "(" FIELD_PREFIX "Maker descriptor): plugin developer"
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "Maker", "Ladspa descriptor");
- return(C_TO_XEN_STRING((XEN_TO_C_Ladspa_Descriptor(ptr))->Maker));
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "Maker", "Ladspa descriptor");
+ return(C_string_to_Xen_string((Xen_to_C_Ladspa_Descriptor(ptr))->Maker));
}
-static XEN g_ladspa_Properties(XEN ptr)
+static Xen g_ladspa_Properties(Xen ptr)
{
#define H_ladspa_Properties "(" FIELD_PREFIX "Properties descriptor): plugin properties"
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "Properties", "Ladspa descriptor");
- return(C_TO_XEN_INT((XEN_TO_C_Ladspa_Descriptor(ptr))->Properties));
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "Properties", "Ladspa descriptor");
+ return(C_int_to_Xen_integer((Xen_to_C_Ladspa_Descriptor(ptr))->Properties));
}
-static XEN g_ladspa_UniqueID(XEN ptr)
+static Xen g_ladspa_UniqueID(Xen ptr)
{
#define H_ladspa_UniqueID "(" FIELD_PREFIX "UniqueID descriptor): plugin ID number"
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "UniqueID", "Ladspa descriptor");
- return(C_TO_XEN_INT((XEN_TO_C_Ladspa_Descriptor(ptr))->UniqueID));
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "UniqueID", "Ladspa descriptor");
+ return(C_int_to_Xen_integer((Xen_to_C_Ladspa_Descriptor(ptr))->UniqueID));
}
-static XEN g_ladspa_PortCount(XEN ptr)
+static Xen g_ladspa_PortCount(Xen ptr)
{
#define H_ladspa_PortCount "(" FIELD_PREFIX "PortCount descriptor): plugin input and output port count"
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "PortCount", "Ladspa descriptor");
- return(C_TO_XEN_INT((XEN_TO_C_Ladspa_Descriptor(ptr))->PortCount));
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "PortCount", "Ladspa descriptor");
+ return(C_int_to_Xen_integer((Xen_to_C_Ladspa_Descriptor(ptr))->PortCount));
}
-static XEN g_ladspa_PortDescriptors(XEN ptr)
+static Xen g_ladspa_PortDescriptors(Xen ptr)
{
#define H_ladspa_PortDescriptors "(" FIELD_PREFIX "PortDescriptors descriptor): plugin port descriptors (an array of ints)"
LADSPA_Descriptor *descriptor;
int i, len;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "PortDescriptors", "Ladspa descriptor");
- descriptor = XEN_TO_C_Ladspa_Descriptor(ptr);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "PortDescriptors", "Ladspa descriptor");
+ descriptor = Xen_to_C_Ladspa_Descriptor(ptr);
len = descriptor->PortCount;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_INT(descriptor->PortDescriptors[i]), lst);
+ lst = Xen_cons(C_int_to_Xen_integer(descriptor->PortDescriptors[i]), lst);
return(lst);
}
-static XEN g_ladspa_PortRangeHints(XEN ptr)
+static Xen g_ladspa_PortRangeHints(Xen ptr)
{
#define H_ladspa_PortRangeHints "(" FIELD_PREFIX "PortRangeHints descriptor): plugin port hints"
LADSPA_Descriptor *descriptor;
int i, len;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "PortRangeHints", "Ladspa descriptor");
- descriptor = XEN_TO_C_Ladspa_Descriptor(ptr);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "PortRangeHints", "Ladspa descriptor");
+ descriptor = Xen_to_C_Ladspa_Descriptor(ptr);
len = descriptor->PortCount;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(XEN_LIST_3(C_TO_XEN_INT(descriptor->PortRangeHints[i].HintDescriptor),
- C_TO_XEN_DOUBLE(descriptor->PortRangeHints[i].LowerBound),
- C_TO_XEN_DOUBLE(descriptor->PortRangeHints[i].UpperBound)),
+ lst = Xen_cons(Xen_list_3(C_int_to_Xen_integer(descriptor->PortRangeHints[i].HintDescriptor),
+ C_double_to_Xen_real(descriptor->PortRangeHints[i].LowerBound),
+ C_double_to_Xen_real(descriptor->PortRangeHints[i].UpperBound)),
lst);
return(lst);
}
-static XEN g_ladspa_PortNames(XEN ptr)
+static Xen g_ladspa_PortNames(Xen ptr)
{
#define H_ladspa_PortNames "(" FIELD_PREFIX "PortNames descriptor): plugin descriptive port names"
LADSPA_Descriptor *descriptor;
int i, len;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ONLY_ARG, FIELD_PREFIX "PortNames", "Ladspa descriptor");
- descriptor = XEN_TO_C_Ladspa_Descriptor(ptr);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, FIELD_PREFIX "PortNames", "Ladspa descriptor");
+ descriptor = Xen_to_C_Ladspa_Descriptor(ptr);
len = descriptor->PortCount;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(descriptor->PortNames[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(descriptor->PortNames[i]), lst);
return(lst);
}
@@ -1073,106 +1086,105 @@ static XEN g_ladspa_PortNames(XEN ptr)
#define S_ladspa_instantiate "ladspa-instantiate"
-static XEN g_ladspa_instantiate(XEN ptr, XEN srate)
+static Xen g_ladspa_instantiate(Xen ptr, Xen srate)
{
#define H_ladspa_instantiate "(" S_ladspa_instantiate " descriptor srate): run plugin's instantiate function, return handle"
const LADSPA_Descriptor *descriptor;
LADSPA_Handle handle;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(ptr), ptr, XEN_ARG_1, S_ladspa_instantiate, "Ladspa descriptor");
- XEN_ASSERT_TYPE(XEN_ULONG_P(srate), srate, XEN_ARG_2, S_ladspa_instantiate, "int");
- descriptor = XEN_TO_C_Ladspa_Descriptor(ptr);
- handle = descriptor->instantiate(descriptor, XEN_TO_C_ULONG(srate));
- return(C_TO_XEN_Ladspa_Handle(handle));
+ Xen_check_type(Xen_is_Ladspa_Descriptor(ptr), ptr, 1, S_ladspa_instantiate, "Ladspa descriptor");
+ Xen_check_type(Xen_is_ulong(srate), srate, 2, S_ladspa_instantiate, "int");
+ descriptor = Xen_to_C_Ladspa_Descriptor(ptr);
+ handle = descriptor->instantiate(descriptor, Xen_ulong_to_C_ulong(srate));
+ return(C_to_Xen_Ladspa_Handle(handle));
}
#define S_ladspa_activate "ladspa-activate"
-static XEN g_ladspa_activate(XEN desc, XEN ptr)
+static Xen g_ladspa_activate(Xen desc, Xen ptr)
{
#define H_ladspa_activate "(" S_ladspa_activate " descriptor handle): run plugin's activate function"
const LADSPA_Descriptor *descriptor;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(desc), desc, XEN_ARG_1, S_ladspa_activate, "Ladspa descriptor");
- XEN_ASSERT_TYPE(XEN_Ladspa_Handle_P(ptr), ptr, XEN_ARG_2, S_ladspa_activate, "Ladspa handle");
- descriptor = XEN_TO_C_Ladspa_Descriptor(desc);
- if (descriptor->activate) descriptor->activate(XEN_TO_C_Ladspa_Handle(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Ladspa_Descriptor(desc), desc, 1, S_ladspa_activate, "Ladspa descriptor");
+ Xen_check_type(Xen_is_Ladspa_Handle(ptr), ptr, 2, S_ladspa_activate, "Ladspa handle");
+ descriptor = Xen_to_C_Ladspa_Descriptor(desc);
+ if (descriptor->activate) descriptor->activate(Xen_to_C_Ladspa_Handle(ptr));
+ return(Xen_false);
}
#define S_ladspa_deactivate "ladspa-deactivate"
-static XEN g_ladspa_deactivate(XEN desc, XEN ptr)
+static Xen g_ladspa_deactivate(Xen desc, Xen ptr)
{
#define H_ladspa_deactivate "(" S_ladspa_deactivate " descriptor handle): run plugin's deactivate function"
const LADSPA_Descriptor *descriptor;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(desc), desc, XEN_ARG_1, S_ladspa_deactivate, "Ladspa descriptor");
- XEN_ASSERT_TYPE(XEN_Ladspa_Handle_P(ptr), ptr, XEN_ARG_2, S_ladspa_deactivate, "Ladspa handle");
- descriptor = XEN_TO_C_Ladspa_Descriptor(desc);
- if (descriptor->deactivate) descriptor->deactivate(XEN_TO_C_Ladspa_Handle(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Ladspa_Descriptor(desc), desc, 1, S_ladspa_deactivate, "Ladspa descriptor");
+ Xen_check_type(Xen_is_Ladspa_Handle(ptr), ptr, 2, S_ladspa_deactivate, "Ladspa handle");
+ descriptor = Xen_to_C_Ladspa_Descriptor(desc);
+ if (descriptor->deactivate) descriptor->deactivate(Xen_to_C_Ladspa_Handle(ptr));
+ return(Xen_false);
}
#define S_ladspa_cleanup "ladspa-cleanup"
-static XEN g_ladspa_cleanup(XEN desc, XEN ptr)
+static Xen g_ladspa_cleanup(Xen desc, Xen ptr)
{
#define H_ladspa_cleanup "(" S_ladspa_cleanup " descriptor handle): run plugin's cleanup function"
const LADSPA_Descriptor *descriptor;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(desc), desc, XEN_ARG_1, S_ladspa_cleanup, "Ladspa descriptor");
- XEN_ASSERT_TYPE(XEN_Ladspa_Handle_P(ptr), ptr, XEN_ARG_2, S_ladspa_cleanup, "Ladspa handle");
- descriptor = XEN_TO_C_Ladspa_Descriptor(desc);
- if (descriptor->cleanup) descriptor->cleanup(XEN_TO_C_Ladspa_Handle(ptr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Ladspa_Descriptor(desc), desc, 1, S_ladspa_cleanup, "Ladspa descriptor");
+ Xen_check_type(Xen_is_Ladspa_Handle(ptr), ptr, 2, S_ladspa_cleanup, "Ladspa handle");
+ descriptor = Xen_to_C_Ladspa_Descriptor(desc);
+ if (descriptor->cleanup) descriptor->cleanup(Xen_to_C_Ladspa_Handle(ptr));
+ return(Xen_false);
}
#define S_ladspa_run "ladspa-run"
-static XEN g_ladspa_run(XEN desc, XEN ptr, XEN count)
+static Xen g_ladspa_run(Xen desc, Xen ptr, Xen count)
{
#define H_ladspa_run "(" S_ladspa_run " descriptor handle count): run plugin's run function"
const LADSPA_Descriptor *descriptor;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(desc), desc, XEN_ARG_1, S_ladspa_run, "Ladspa descriptor");
- XEN_ASSERT_TYPE(XEN_Ladspa_Handle_P(ptr), ptr, XEN_ARG_2, S_ladspa_run, "Ladspa handle");
- XEN_ASSERT_TYPE(XEN_ULONG_P(count), count, XEN_ARG_3, S_ladspa_run, "unsigned long");
- descriptor = XEN_TO_C_Ladspa_Descriptor(desc);
- if (descriptor->run) descriptor->run(XEN_TO_C_Ladspa_Handle(ptr), XEN_TO_C_ULONG(count));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Ladspa_Descriptor(desc), desc, 1, S_ladspa_run, "Ladspa descriptor");
+ Xen_check_type(Xen_is_Ladspa_Handle(ptr), ptr, 2, S_ladspa_run, "Ladspa handle");
+ Xen_check_type(Xen_is_ulong(count), count, 3, S_ladspa_run, "unsigned long");
+ descriptor = Xen_to_C_Ladspa_Descriptor(desc);
+ if (descriptor->run) descriptor->run(Xen_to_C_Ladspa_Handle(ptr), Xen_ulong_to_C_ulong(count));
+ return(Xen_false);
}
#define S_ladspa_run_adding "ladspa-run-adding"
-static XEN g_ladspa_run_adding(XEN desc, XEN ptr, XEN count)
+static Xen g_ladspa_run_adding(Xen desc, Xen ptr, Xen count)
{
#define H_ladspa_run_adding "(" S_ladspa_run_adding " descriptor handle count): run plugin's run_adding function"
const LADSPA_Descriptor *descriptor;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(desc), desc, XEN_ARG_1, S_ladspa_run_adding, "Ladspa descriptor");
- XEN_ASSERT_TYPE(XEN_Ladspa_Handle_P(ptr), ptr, XEN_ARG_2, S_ladspa_run_adding, "Ladspa handle");
- XEN_ASSERT_TYPE(XEN_ULONG_P(count), count, XEN_ARG_3, S_ladspa_run_adding, "unsigned long");
- descriptor = XEN_TO_C_Ladspa_Descriptor(desc);
- if (descriptor->run_adding) descriptor->run_adding(XEN_TO_C_Ladspa_Handle(ptr), XEN_TO_C_ULONG(count));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Ladspa_Descriptor(desc), desc, 1, S_ladspa_run_adding, "Ladspa descriptor");
+ Xen_check_type(Xen_is_Ladspa_Handle(ptr), ptr, 2, S_ladspa_run_adding, "Ladspa handle");
+ Xen_check_type(Xen_is_ulong(count), count, 3, S_ladspa_run_adding, "unsigned long");
+ descriptor = Xen_to_C_Ladspa_Descriptor(desc);
+ if (descriptor->run_adding) descriptor->run_adding(Xen_to_C_Ladspa_Handle(ptr), Xen_ulong_to_C_ulong(count));
+ return(Xen_false);
}
#define S_ladspa_set_run_adding_gain "ladspa-set-run-adding-gain"
-static XEN g_ladspa_set_run_adding_gain(XEN desc, XEN ptr, XEN gain)
+static Xen g_ladspa_set_run_adding_gain(Xen desc, Xen ptr, Xen gain)
{
#define H_ladspa_set_run_adding_gain "(" S_ladspa_set_run_adding_gain " descriptor handle gain): run plugin's set_run_adding_gain function"
const LADSPA_Descriptor *descriptor;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(desc), desc, XEN_ARG_1, S_ladspa_set_run_adding_gain, "Ladspa descriptor");
- XEN_ASSERT_TYPE(XEN_Ladspa_Handle_P(ptr), ptr, XEN_ARG_2, S_ladspa_set_run_adding_gain, "Ladspa handle");
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(gain), gain, XEN_ARG_3, S_ladspa_set_run_adding_gain, "float");
- descriptor = XEN_TO_C_Ladspa_Descriptor(desc);
- if (descriptor->set_run_adding_gain) descriptor->set_run_adding_gain(XEN_TO_C_Ladspa_Handle(ptr), (LADSPA_Data)(XEN_TO_C_DOUBLE(gain)));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Ladspa_Descriptor(desc), desc, 1, S_ladspa_set_run_adding_gain, "Ladspa descriptor");
+ Xen_check_type(Xen_is_Ladspa_Handle(ptr), ptr, 2, S_ladspa_set_run_adding_gain, "Ladspa handle");
+ Xen_check_type(Xen_is_double(gain), gain, 3, S_ladspa_set_run_adding_gain, "float");
+ descriptor = Xen_to_C_Ladspa_Descriptor(desc);
+ if (descriptor->set_run_adding_gain) descriptor->set_run_adding_gain(Xen_to_C_Ladspa_Handle(ptr), (LADSPA_Data)(Xen_real_to_C_double(gain)));
+ return(Xen_false);
}
-#if WITH_DOUBLES
static float *double_to_float(mus_float_t *data, int data_size)
{
float *ldata;
@@ -1182,95 +1194,63 @@ static float *double_to_float(mus_float_t *data, int data_size)
ldata[i] = (float)(data[i]);
return(ldata);
}
-#endif
#define S_ladspa_connect_port "ladspa-connect-port"
-static XEN g_ladspa_connect_port(XEN desc, XEN ptr, XEN port, XEN data)
+static Xen g_ladspa_connect_port(Xen desc, Xen ptr, Xen port, Xen data)
{
- #define H_ladspa_connect_port "(" S_ladspa_connect_port " descriptor handle port vct-data): run plugin's connect_port function"
+ #define H_ladspa_connect_port "(" S_ladspa_connect_port " descriptor handle port data): run plugin's connect_port function"
const LADSPA_Descriptor *descriptor;
vct *samples;
- XEN_ASSERT_TYPE(XEN_Ladspa_Descriptor_P(desc), desc, XEN_ARG_1, S_ladspa_connect_port, "Ladspa descriptor");
- XEN_ASSERT_TYPE(XEN_Ladspa_Handle_P(ptr), ptr, XEN_ARG_2, S_ladspa_connect_port, "Ladspa handle");
- XEN_ASSERT_TYPE(XEN_ULONG_P(port), port, XEN_ARG_3, S_ladspa_connect_port, "unsigned long");
- XEN_ASSERT_TYPE(MUS_VCT_P(data), data, XEN_ARG_4, S_ladspa_connect_port, "vct");
- descriptor = XEN_TO_C_Ladspa_Descriptor(desc);
- samples = XEN_TO_VCT(data);
+ Xen_check_type(Xen_is_Ladspa_Descriptor(desc), desc, 1, S_ladspa_connect_port, "Ladspa descriptor");
+ Xen_check_type(Xen_is_Ladspa_Handle(ptr), ptr, 2, S_ladspa_connect_port, "Ladspa handle");
+ Xen_check_type(Xen_is_ulong(port), port, 3, S_ladspa_connect_port, "unsigned long");
+ Xen_check_type(mus_is_vct(data), data, 4, S_ladspa_connect_port, S_vct);
+ descriptor = Xen_to_C_Ladspa_Descriptor(desc);
+ samples = Xen_to_vct(data);
if (descriptor->connect_port)
- descriptor->connect_port(XEN_TO_C_Ladspa_Handle(ptr),
- XEN_TO_C_ULONG(port),
-#if (!WITH_DOUBLES)
- samples->data
- /* if --with-doubles, samples->data is a double array */
-#else
- double_to_float(samples->data, samples->length)
-#endif
+ descriptor->connect_port(Xen_to_C_Ladspa_Handle(ptr),
+ Xen_ulong_to_C_ulong(port),
+ double_to_float(mus_vct_data(samples), mus_vct_length(samples))
);
- return(XEN_FALSE);
+ return(Xen_false);
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_2(g_analyse_ladspa_w, g_analyse_ladspa)
-XEN_NARGIFY_2(g_ladspa_descriptor_w, g_ladspa_descriptor)
-XEN_ARGIFY_6(g_apply_ladspa_w, g_apply_ladspa)
-XEN_NARGIFY_0(g_init_ladspa_w, g_init_ladspa)
-XEN_NARGIFY_0(g_list_ladspa_w, g_list_ladspa)
-XEN_NARGIFY_1(g_ladspa_Label_w, g_ladspa_Label)
-XEN_NARGIFY_1(g_ladspa_Name_w, g_ladspa_Name)
-XEN_NARGIFY_1(g_ladspa_Copyright_w, g_ladspa_Copyright)
-XEN_NARGIFY_1(g_ladspa_Maker_w, g_ladspa_Maker)
-XEN_NARGIFY_1(g_ladspa_Properties_w, g_ladspa_Properties)
-XEN_NARGIFY_1(g_ladspa_UniqueID_w, g_ladspa_UniqueID)
-XEN_NARGIFY_1(g_ladspa_PortNames_w, g_ladspa_PortNames)
-XEN_NARGIFY_1(g_ladspa_PortDescriptors_w, g_ladspa_PortDescriptors)
-XEN_NARGIFY_1(g_ladspa_PortRangeHints_w, g_ladspa_PortRangeHints)
-XEN_NARGIFY_1(g_ladspa_PortCount_w, g_ladspa_PortCount)
-XEN_NARGIFY_2(g_ladspa_instantiate_w, g_ladspa_instantiate)
-XEN_NARGIFY_2(g_ladspa_activate_w, g_ladspa_activate)
-XEN_NARGIFY_2(g_ladspa_deactivate_w, g_ladspa_deactivate)
-XEN_NARGIFY_2(g_ladspa_cleanup_w, g_ladspa_cleanup)
-XEN_NARGIFY_3(g_ladspa_run_w, g_ladspa_run)
-XEN_NARGIFY_3(g_ladspa_run_adding_w, g_ladspa_run_adding)
-XEN_NARGIFY_3(g_ladspa_set_run_adding_gain_w, g_ladspa_set_run_adding_gain)
-XEN_NARGIFY_4(g_ladspa_connect_port_w, g_ladspa_connect_port)
-#else
-#define g_analyse_ladspa_w g_analyse_ladspa
-#define g_ladspa_descriptor_w g_ladspa_descriptor
-#define g_apply_ladspa_w g_apply_ladspa
-#define g_init_ladspa_w g_init_ladspa
-#define g_list_ladspa_w g_list_ladspa
-#define g_ladspa_Label_w g_ladspa_Label
-#define g_ladspa_Name_w g_ladspa_Name
-#define g_ladspa_Copyright_w g_ladspa_Copyright
-#define g_ladspa_Maker_w g_ladspa_Maker
-#define g_ladspa_Properties_w g_ladspa_Properties
-#define g_ladspa_UniqueID_w g_ladspa_UniqueID
-#define g_ladspa_PortNames_w g_ladspa_PortNames
-#define g_ladspa_PortDescriptors_w g_ladspa_PortDescriptors
-#define g_ladspa_PortRangeHints_w g_ladspa_PortRangeHints
-#define g_ladspa_PortCount_w g_ladspa_PortCount
-#define g_ladspa_instantiate_w g_ladspa_instantiate
-#define g_ladspa_activate_w g_ladspa_activate
-#define g_ladspa_deactivate_w g_ladspa_deactivate
-#define g_ladspa_cleanup_w g_ladspa_cleanup
-#define g_ladspa_run_w g_ladspa_run
-#define g_ladspa_run_adding_w g_ladspa_run_adding
-#define g_ladspa_set_run_adding_gain_w g_ladspa_set_run_adding_gain
-#define g_ladspa_connect_port_w g_ladspa_connect_port
-#endif
+Xen_wrap_2_args(g_analyse_ladspa_w, g_analyse_ladspa)
+Xen_wrap_2_args(g_ladspa_descriptor_w, g_ladspa_descriptor)
+Xen_wrap_6_optional_args(g_apply_ladspa_w, g_apply_ladspa)
+Xen_wrap_no_args(g_init_ladspa_w, g_init_ladspa)
+Xen_wrap_no_args(g_list_ladspa_w, g_list_ladspa)
+Xen_wrap_1_arg(g_ladspa_Label_w, g_ladspa_Label)
+Xen_wrap_1_arg(g_ladspa_Name_w, g_ladspa_Name)
+Xen_wrap_1_arg(g_ladspa_Copyright_w, g_ladspa_Copyright)
+Xen_wrap_1_arg(g_ladspa_Maker_w, g_ladspa_Maker)
+Xen_wrap_1_arg(g_ladspa_Properties_w, g_ladspa_Properties)
+Xen_wrap_1_arg(g_ladspa_UniqueID_w, g_ladspa_UniqueID)
+Xen_wrap_1_arg(g_ladspa_PortNames_w, g_ladspa_PortNames)
+Xen_wrap_1_arg(g_ladspa_PortDescriptors_w, g_ladspa_PortDescriptors)
+Xen_wrap_1_arg(g_ladspa_PortRangeHints_w, g_ladspa_PortRangeHints)
+Xen_wrap_1_arg(g_ladspa_PortCount_w, g_ladspa_PortCount)
+Xen_wrap_2_args(g_ladspa_instantiate_w, g_ladspa_instantiate)
+Xen_wrap_2_args(g_ladspa_activate_w, g_ladspa_activate)
+Xen_wrap_2_args(g_ladspa_deactivate_w, g_ladspa_deactivate)
+Xen_wrap_2_args(g_ladspa_cleanup_w, g_ladspa_cleanup)
+Xen_wrap_3_args(g_ladspa_run_w, g_ladspa_run)
+Xen_wrap_3_args(g_ladspa_run_adding_w, g_ladspa_run_adding)
+Xen_wrap_3_args(g_ladspa_set_run_adding_gain_w, g_ladspa_set_run_adding_gain)
+Xen_wrap_4_args(g_ladspa_connect_port_w, g_ladspa_connect_port)
void g_ladspa_to_snd(void)
{
- XEN_DEFINE_PROCEDURE(S_analyse_ladspa, g_analyse_ladspa_w, 2, 0, 0, H_analyse_ladspa); /* British spelling not used anywhere else, so why here? */
- XEN_DEFINE_PROCEDURE("analyze-ladspa", g_analyse_ladspa_w, 2, 0, 0, H_analyse_ladspa);
- XEN_DEFINE_PROCEDURE(S_apply_ladspa, g_apply_ladspa_w, 4, 2, 0, H_apply_ladspa);
- XEN_DEFINE_PROCEDURE(S_init_ladspa, g_init_ladspa_w, 0, 0, 0, H_init_ladspa);
- XEN_DEFINE_PROCEDURE(S_list_ladspa, g_list_ladspa_w, 0, 0, 0, H_list_ladspa);
- XEN_DEFINE_PROCEDURE(S_ladspa_descriptor, g_ladspa_descriptor_w, 2, 0, 0, H_ladspa_descriptor);
+ Xen_define_procedure(S_analyse_ladspa, g_analyse_ladspa_w, 2, 0, 0, H_analyse_ladspa); /* British spelling not used anywhere else, so why here? */
+ Xen_define_procedure("analyze-ladspa", g_analyse_ladspa_w, 2, 0, 0, H_analyse_ladspa);
+ Xen_define_procedure(S_apply_ladspa, g_apply_ladspa_w, 4, 2, 0, H_apply_ladspa);
+ Xen_define_procedure(S_init_ladspa, g_init_ladspa_w, 0, 0, 0, H_init_ladspa);
+ Xen_define_procedure(S_list_ladspa, g_list_ladspa_w, 0, 0, 0, H_list_ladspa);
+ Xen_define_procedure(S_ladspa_descriptor, g_ladspa_descriptor_w, 2, 0, 0, H_ladspa_descriptor);
DEFINE_INTEGER(LADSPA_PROPERTY_REALTIME);
DEFINE_INTEGER(LADSPA_PROPERTY_INPLACE_BROKEN);
@@ -1312,16 +1292,16 @@ void g_ladspa_to_snd(void)
DEFINE_READER(PortRangeHints, g_ladspa_PortRangeHints_w, H_ladspa_PortRangeHints);
DEFINE_READER(PortCount, g_ladspa_PortCount_w, H_ladspa_PortCount);
- XEN_DEFINE_PROCEDURE(S_ladspa_instantiate, g_ladspa_instantiate_w, 2, 0, 0, H_ladspa_instantiate);
- XEN_DEFINE_PROCEDURE(S_ladspa_activate, g_ladspa_activate_w, 2, 0, 0, H_ladspa_activate);
- XEN_DEFINE_PROCEDURE(S_ladspa_deactivate, g_ladspa_deactivate_w, 2, 0, 0, H_ladspa_deactivate);
- XEN_DEFINE_PROCEDURE(S_ladspa_cleanup, g_ladspa_cleanup_w, 2, 0, 0, H_ladspa_cleanup);
- XEN_DEFINE_PROCEDURE(S_ladspa_run, g_ladspa_run_w, 3, 0, 0, H_ladspa_run);
- XEN_DEFINE_PROCEDURE(S_ladspa_run_adding, g_ladspa_run_adding_w, 3, 0, 0, H_ladspa_run_adding);
- XEN_DEFINE_PROCEDURE(S_ladspa_set_run_adding_gain, g_ladspa_set_run_adding_gain_w, 3, 0, 0, H_ladspa_set_run_adding_gain);
- XEN_DEFINE_PROCEDURE(S_ladspa_connect_port, g_ladspa_connect_port_w, 4, 0, 0, H_ladspa_connect_port);
-
- XEN_YES_WE_HAVE("snd-ladspa");
+ Xen_define_procedure(S_ladspa_instantiate, g_ladspa_instantiate_w, 2, 0, 0, H_ladspa_instantiate);
+ Xen_define_procedure(S_ladspa_activate, g_ladspa_activate_w, 2, 0, 0, H_ladspa_activate);
+ Xen_define_procedure(S_ladspa_deactivate, g_ladspa_deactivate_w, 2, 0, 0, H_ladspa_deactivate);
+ Xen_define_procedure(S_ladspa_cleanup, g_ladspa_cleanup_w, 2, 0, 0, H_ladspa_cleanup);
+ Xen_define_procedure(S_ladspa_run, g_ladspa_run_w, 3, 0, 0, H_ladspa_run);
+ Xen_define_procedure(S_ladspa_run_adding, g_ladspa_run_adding_w, 3, 0, 0, H_ladspa_run_adding);
+ Xen_define_procedure(S_ladspa_set_run_adding_gain, g_ladspa_set_run_adding_gain_w, 3, 0, 0, H_ladspa_set_run_adding_gain);
+ Xen_define_procedure(S_ladspa_connect_port, g_ladspa_connect_port_w, 4, 0, 0, H_ladspa_connect_port);
+
+ Xen_provide_feature("snd-ladspa");
}
#endif
diff --git a/snd-listener.c b/snd-listener.c
index ad7d200..ede742e 100644
--- a/snd-listener.c
+++ b/snd-listener.c
@@ -1,485 +1,26 @@
#include "snd.h"
-bool is_prompt(const char *str, int beg)
-{
- int i, j;
- for (i = beg, j = ss->listener_prompt_length - 1; (i >= 0) && (j >= 0); i--, j--)
- if (str[i] != ss->Listener_Prompt[j])
- return(false);
- if (j != -1) return(false);
- if ((i == -1) || (str[i] == '\n'))
- return(true);
- return(false);
-}
-
-
-void listener_help_at_cursor(char *buf, int name_curpos, int len, int prompt_pos)
-{
- int i, name_start, name_end;
-
- if (isspace(buf[name_curpos]))
- {
- for (i = name_curpos - 1; i >= 0; i--)
- if ((!isspace(buf[i])) &&
- (buf[i] != '(') &&
- (buf[i] != ')'))
- break;
- if (i > 0)
- name_curpos = i;
- }
-
- for (i = name_curpos; i >= 0; i--)
- if ((isspace(buf[i])) ||
- (buf[i] == '(') ||
- (buf[i] == ')'))
- break;
- name_start = i + 1;
-
- for (i = name_curpos + 1; i < len; i++)
- if ((isspace(buf[i])) ||
- (buf[i] == '(') ||
- (buf[i] == ')'))
- break;
- name_end = i - 1;
-
- if (name_end > name_start)
- {
- XEN help;
- char *new_text;
-
- buf[name_end + 1] = '\0';
- new_text = direct_completions((char *)(buf + name_start));
-
- if (new_text)
- {
- int matches;
- matches = get_possible_completions_size();
-
- if (matches == 1)
- {
- help = g_snd_help(C_TO_XEN_STRING(new_text), 0);
- if (XEN_STRING_P(help))
- snd_help((char *)(buf + name_start), XEN_TO_C_STRING(help), WITH_WORD_WRAP);
- }
- else
- {
- if (matches > 1)
- {
- char **buffer;
- char *help_str;
- int match_len = 0;
-
- buffer = get_possible_completions();
- for (i = 0; i < matches; i++)
- match_len += mus_strlen(buffer[i]);
-
- help_str = (char *)calloc(match_len + matches * 8, sizeof(char));
- for (i = 0; i < matches; i++)
- {
- strcat(help_str, buffer[i]);
- strcat(help_str, "\n");
- }
- snd_help((char *)(buf + name_start), help_str, WITHOUT_WORD_WRAP);
- free(help_str);
- }
- }
-
- free(new_text);
- }
- }
-}
-
-
-bool within_prompt(const char *str, int beg, int end)
-{
- /* search backwards up to prompt length for cr (or 0), check for prompt */
- int i, lim;
- if ((beg + 1 == end) && (str[beg] == '\n')) return(false); /* end-of-page cr within double quotes probably */
- lim = beg - ss->listener_prompt_length;
- if (lim < 0) return(true);
- for (i = beg; i >= lim; i--)
- if ((str[i] == '\n') || (i == 0))
- {
- int j, k;
- for (j = 0, k = i + 1; (j < ss->listener_prompt_length) && (k < end); j++, k++)
- if (str[k] != ss->Listener_Prompt[j])
- return(false);
- return(true);
- }
- return(false);
-}
-
-
-char *trim(char *orig)
-{
- int i, j, start = -1, end = -1, len;
- char *str;
-
- len = mus_strlen(orig);
- if (len == 0) return(NULL);
-
- for (start = 0; start < len; start++)
- if ((!isspace(orig[start])) &&
- (orig[start] != '(') &&
- (orig[start] != ')'))
- break;
- if (start >= len) return(NULL);
- for (end = len - 1; end > start; end--)
- if ((!isspace(orig[end])) &&
- (orig[end] != '(') &&
- (orig[end] != ')'))
- break;
- if (start == end) return(NULL);
-
- len = end - start + 1;
- str = (char *)calloc(len + 1, sizeof(char));
- for (i = start, j = 0; i <= end; i++, j++)
- str[j] = orig[i];
- return(str);
-}
-
-
-int find_matching_paren(const char *str, int parens, int pos, int *highlight_pos)
-{
- int i, j;
- bool quoting = false;
- int up_comment = -1;
- for (i = pos - 1; i > 0;)
- {
- if (is_prompt(str, i))
- break;
- if (str[i] == '\"')
- {
- /* there could be any number of slashified slashes before this quote. */
- int k, slashes = 0;
- for (k = i - 1; k >= 0; k--)
- {
- if (str[k] == '\\')
- slashes++;
- else break;
- }
- if ((slashes & 1) == 0)
- quoting = !quoting;
- }
- if (!quoting)
- {
- if ((i <= 1) || (str[i - 1] != '\\') || (str[i - 2] != '#'))
- {
- if (str[i] == ')') parens++; else
- if (str[i] == '(') parens--; else
- if (str[i] == '\n')
- {
- /* check for comment on next line up */
- bool up_quoting = false;
- int quote_comment = -1;
- for (j = i - 1; j > 0; j--)
- {
- if (str[j] == '\n') break;
- if ((str[j] == '\"') && (str[j - 1] != '\\'))
- up_quoting = !up_quoting;
- if ((str[j] == ';') &&
- ((j <= 1) || (str[j - 1] != '\\') || (str[j - 2] != '#')))
- {
- if (!up_quoting)
- up_comment = j;
- else quote_comment = j;
- }
- }
- if (up_comment < i)
- {
- if (up_comment > 0)
- i = up_comment;
- else
- {
- if ((up_quoting) && (quote_comment > 0))
- i = quote_comment;
- }
- }
- }
- }
- }
- if (parens == 0)
- {
- (*highlight_pos) = i;
- break;
- }
- i--;
- }
- return(parens);
-}
-
-/* this doesn't know about block comments */
-
-int check_balance(const char *expr, int start, int end, bool in_listener)
-{
- int i;
- bool non_whitespace_p = false;
- int paren_count = 0;
- bool prev_separator = true;
- bool quote_wait = false;
-
- i = start;
- while (i < end)
- {
- switch (expr[i])
- {
- case ';' :
- /* skip till newline. */
- do {
- i++;
- } while ((expr[i] != '\n') && (i < end));
- break;
-
- case ' ':
- case '\n':
- case '\t':
- case '\r':
- if ((non_whitespace_p) && (paren_count == 0) && (!quote_wait))
- return(i);
- else
- {
- prev_separator = true;
- i++;
- }
- break;
-
- case '\"' :
- if ((non_whitespace_p) && (paren_count == 0) && (!quote_wait))
- return(i);
- else
- {
- /* skip past ", ignoring \", some cases:
- * "\"\"" '("\"\"") "\\" "#\\(" "'(\"#\\\")"
- */
- while (i < end)
- {
- i++;
- if (expr[i] == '\\')
- i++;
- else
- {
- if (expr[i] == '\"')
- break;
- }
- }
- i++;
- if (paren_count == 0)
- {
- if (i < end)
- return(i);
- else return(0);
- }
- else
- {
- prev_separator = true;
- non_whitespace_p = true;
- quote_wait = false;
- }
- }
- break;
-
- case '\\':
- /* this is an error of some sort or an ignored double quote? */
- i += 2;
- break;
-
- case '#' :
- if ((non_whitespace_p) && (paren_count == 0) && (!quote_wait))
- return(i);
- else
- {
- bool found_it = false;
- if (prev_separator)
- {
- int k, incr = 0;
- for (k = i + 1; k < end; k++)
- {
- if (expr[k] == '(')
- {
- incr = k - i;
- break;
- }
- else
- {
- if ((!isdigit(expr[k])) &&
- (expr[k] != 'D') &&
- (expr[k] != 'd') &&
- (expr[k] != '=') &&
- (expr[k] != '#'))
- break;
- }
- }
- if (incr > 0)
- {
- i += incr;
- found_it = true;
- }
- }
- if (!found_it)
- {
- if ((i + 2 < end) && (expr[i + 1] == '\\') &&
- ((expr[i + 2] == ')') || (expr[i + 2] == ';') || (expr[i + 2] == '\"') || (expr[i + 2] == '(')))
- i += 3;
- else
- {
- prev_separator = false;
- quote_wait = false;
- non_whitespace_p = true;
- i++;
- }
- }
- }
- break;
-
- case '(' :
- if ((non_whitespace_p) && (paren_count == 0) && (!quote_wait))
- return(i);
- else
- {
- i++;
- paren_count++;
- non_whitespace_p = true;
- prev_separator = true;
- quote_wait = false;
- }
- break;
-
- case ')' :
- paren_count--;
- if ((non_whitespace_p) && (paren_count == 0))
- return(i + 1);
- else
- {
- i++;
- non_whitespace_p = true;
- prev_separator = true;
- quote_wait = false;
- }
- break;
-
- case '\'' :
- case '`' : /* `(1 2) */
- if (prev_separator)
- quote_wait = true;
- non_whitespace_p = true;
- i++;
- break;
-
- default:
- prev_separator = false;
- quote_wait = false;
- non_whitespace_p = true;
- i++;
- break;
- }
- }
-
- if ((in_listener) && (!(highlight_unbalanced_paren())))
- return(-1);
- return(0);
-}
-
-
-static char listener_prompt_buffer[LABEL_BUFFER_SIZE];
-
-char *listener_prompt_with_cr(void)
-{
- mus_snprintf(listener_prompt_buffer, LABEL_BUFFER_SIZE, "\n%s", listener_prompt(ss));
- return(listener_prompt_buffer);
-}
-
-
bool listener_is_visible(void)
{
return(listener_height() > 5);
}
-#if (!USE_NO_GUI)
-#if USE_GTK
-#define GUI_TEXT_END(w) gtk_text_buffer_get_char_count(gtk_text_view_get_buffer(GTK_TEXT_VIEW(w)))
-#define GUI_TEXT_POSITION_TYPE gint
-#define GUI_TEXT(w) sg_get_text(w, 0, -1)
-#define GUI_TEXT_INSERTION_POSITION(w) sg_cursor_position(w)
-#define GUI_TEXT_SET_INSERTION_POSITION(w, pos) sg_set_cursor(w, pos)
-#define GUI_LISTENER_TEXT_INSERT(w, pos, text) append_listener_text(0, text)
-#define GUI_FREE(w) g_free(w)
-#define GUI_SET_CURSOR(w, cursor) gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(w), GTK_TEXT_WINDOW_TEXT), cursor)
-#define GUI_UNSET_CURSOR(w, cursor) gdk_window_set_cursor(gtk_text_view_get_window(GTK_TEXT_VIEW(w), GTK_TEXT_WINDOW_TEXT), cursor)
-#define GUI_UPDATE(w)
-#define GUI_TEXT_GOTO(w, pos) sg_set_cursor(w, pos + 1)
-#else
-#define GUI_TEXT_END(w) XmTextGetLastPosition(w)
-#define GUI_TEXT_POSITION_TYPE XmTextPosition
-#define GUI_TEXT(w) XmTextGetString(w)
-#define GUI_TEXT_INSERTION_POSITION(w) XmTextGetInsertionPosition(w)
-#define GUI_TEXT_SET_INSERTION_POSITION(w, pos) XmTextSetInsertionPosition(w, pos)
-#define GUI_LISTENER_TEXT_INSERT(w, pos, text) XmTextInsert(w, pos, text)
-#define GUI_FREE(w) XtFree(w)
-#define GUI_SET_CURSOR(w, cursor) XUndefineCursor(XtDisplay(w), XtWindow(w)); XDefineCursor(XtDisplay(w), XtWindow(w), cursor)
-#define GUI_UNSET_CURSOR(w, cursor) XUndefineCursor(XtDisplay(w), XtWindow(w)); XDefineCursor(XtDisplay(w), XtWindow(w), None)
-#define GUI_UPDATE(w) XmUpdateDisplay(w)
-#define GUI_TEXT_GOTO(w, pos) XmTextShowPosition(w, pos)
-#endif
-#endif
+static Xen read_hook;
-static XEN read_hook;
-
-#if (!USE_NO_GUI)
-static int current_listener_position = -1, listener_positions_size = 0;
-static int *listener_positions = NULL;
-
-
-static void add_listener_position(int pos)
-{
- if (listener_positions_size == 0)
- {
- listener_positions_size = 32;
- listener_positions = (int *)calloc(listener_positions_size, sizeof(int));
- current_listener_position = 0;
- }
- else
- {
- int i;
- if (pos > listener_positions[current_listener_position])
- {
- current_listener_position++;
- if (current_listener_position >= listener_positions_size)
- {
- listener_positions_size += 32;
- listener_positions = (int *)realloc(listener_positions, listener_positions_size * sizeof(int));
- for (i = current_listener_position + 1; i < listener_positions_size; i++) listener_positions[i] = 0;
- }
- }
- else
- {
- for (i = current_listener_position - 1; i >= 0; i--)
- if (listener_positions[i] < pos)
- break;
- current_listener_position = i + 1;
- }
- }
- listener_positions[current_listener_position] = pos;
-}
+#if HAVE_SCHEME && (!USE_NO_GUI)
+static int skipped_calls = 0;
+#define SKIPPING 10
-void backup_listener_to_previous_expression(void)
+void listener_begin_hook(s7_scheme *sc, bool *val)
{
- if (current_listener_position > 0)
+ if (skipped_calls < SKIPPING)
{
- current_listener_position--;
- listener_delete_text(listener_positions[current_listener_position]);
+ skipped_calls++;
+ return;
}
-}
-#else
-void backup_listener_to_previous_expression(void) {}
-#endif
-
-
-
-#if HAVE_SCHEME && (!USE_NO_GUI)
-static bool listener_begin_hook(s7_scheme *sc)
-{
+ skipped_calls = 0;
ss->C_g_typed = false;
#if USE_MOTIF
@@ -492,326 +33,76 @@ static bool listener_begin_hook(s7_scheme *sc)
#endif
#if USE_GTK
+#if 0
if (gdk_events_pending()) /* necessary -- otherwise Snd hangs in gtk_main_iteration */
gtk_main_iteration();
+#else
+ {
+ int i = 50;
+ /* we need to let more than 1 event through at a time, else (for example) the listener popup
+ * menu never actually pops up.
+ *
+ * if no threads (as here) this is just g_main_context_pending(NULL)
+ * then gtk_main_iteration calls g_main_context_iteration(NULL, true),
+ * so g_main_context_iteration(NULL, false) might combine the two.
+ * But the overhead of gtk_events_pending is insignificant. This code
+ * is extremely slow -- it more than doubles the compute time of s7test
+ * for example, and spends 10% of its time fiddling with useless locks.
+ */
+
+ while ((gtk_events_pending()) && (i != 0))
+ {
+ gtk_main_iteration();
+ i--;
+ }
+ }
+#endif
#endif
- /* if c-g, run stop-hook? */
-
- return(ss->C_g_typed);
+ *val = ss->C_g_typed;
}
#endif
-void listener_return(widget_t w, int last_prompt)
+bool have_read_hook(void)
{
-#if (!USE_NO_GUI)
- /* try to find complete form either enclosing current cursor, or just before it */
- GUI_TEXT_POSITION_TYPE cmd_eot = 0;
- char *str = NULL, *full_str = NULL, *prompt;
- int i, j;
- XEN form = XEN_UNDEFINED;
- GUI_TEXT_POSITION_TYPE end_of_text = 0, start_of_text = 0, last_position = 0, current_position = 0;
-
-#if (!HAVE_RUBY && !HAVE_FORTH)
- int parens;
- GUI_TEXT_POSITION_TYPE new_eot = 0;
-#endif
-
- full_str = GUI_TEXT(w);
- current_position = GUI_TEXT_INSERTION_POSITION(w);
- start_of_text = current_position;
- end_of_text = current_position;
- last_position = GUI_TEXT_END(w);
- add_listener_position(last_position);
-
-#if (!HAVE_SCHEME)
- if (XEN_HOOKED(read_hook))
- {
- XEN result;
- int len;
- len = last_position - last_prompt;
- if (len > 0)
- {
- str = (char *)calloc(len + 1, sizeof(char));
- for (i = last_prompt, j = 0; i < last_position; i++, j++) str[j] = full_str[i];
- result = run_or_hook(read_hook,
- XEN_LIST_1(C_TO_XEN_STRING(str)),
- S_read_hook);
- free(str);
- if (XEN_TRUE_P(result))
- {
- if (full_str) GUI_FREE(full_str);
- return;
- }
- }
- }
-#endif
-
- prompt = listener_prompt(ss);
-
- /* first look for a form just before the current mouse location,
- * independent of everything (i.e. user may have made changes
- * in a form included in a comment, then typed return, expecting
- * us to use the new version, but the check_balance procedure
- * tries to ignore comments).
- */
-
- str = NULL;
-
-#if HAVE_RUBY || HAVE_FORTH
- {
- int k, len, start, full_len;
- for (i = current_position - 1; i >= 0; i--)
- if (is_prompt(full_str, i))
- {
- full_len = strlen(full_str);
- for (k = current_position - 1; k < full_len; k++)
- if (full_str[k] == '\n')
- break;
- start = i + 1;
- len = (k - start + 1);
- str = (char *)calloc(len, sizeof(char));
- for (k = 0; k < len - 1; k++)
- str[k] = full_str[k + start];
- break;
- }
- }
-#else
- for (i = current_position - 1; i >= 0; i--)
- if (full_str[i] == '\n')
- break;
- else
- if (full_str[i] == ';')
- {
- /* now look for complete form from current_position backwards */
- parens = 0;
- start_of_text = i;
- end_of_text = -1;
-
- for (i = current_position; i > start_of_text; i--)
- if (full_str[i] == ')')
- {
- if (end_of_text == -1)
- end_of_text = i;
- parens--;
- }
- else
- if (full_str[i] == '(')
- {
- parens++;
- start_of_text = i;
- }
-
- if ((parens == 0) && (end_of_text != -1))
- {
- str = (char *)calloc(end_of_text - start_of_text + 2, sizeof(char));
- for (i = start_of_text, j = 0; i <= end_of_text; j++, i++)
- str[j] = full_str[i];
- }
- else
- {
- start_of_text = current_position;
- end_of_text = current_position;
- }
- break;
- }
-
- if (str == NULL)
- {
- if (last_position > end_of_text)
- {
- end_of_text = last_position; /* added 12-Nov-07 for first form */
- for (i = current_position; i < last_position; i++)
- if (is_prompt(full_str, i + 1))
- {
- end_of_text = i - ss->listener_prompt_length + 1;
- break;
- }
- }
-
- if (start_of_text > 0)
- {
- for (i = end_of_text; i >= 0; i--)
- if (is_prompt(full_str, i))
- {
- start_of_text = i + 1;
- break;
- }
- }
-
- if (end_of_text > start_of_text)
- {
- int slen;
- parens = 0;
- slen = end_of_text - start_of_text + 2;
- str = (char *)calloc(slen, sizeof(char));
- for (i = start_of_text, j = 0; i <= end_of_text; j++, i++)
- {
- str[j] = full_str[i];
- if (str[j] == '(')
- parens++;
- }
- str[end_of_text - start_of_text + 1] = 0;
- end_of_text = mus_strlen(str);
-
- if (parens)
- {
- end_of_text = check_balance(str, 0, (int)end_of_text, true); /* last-arg->we are in the listener */
- if ((end_of_text > 0) &&
- (end_of_text < slen))
- {
- if (end_of_text < (slen - 1))
- str[end_of_text + 1] = 0;
- else str[end_of_text] = 0;
- if (str[end_of_text] == '\n') str[end_of_text] = 0;
- }
- else
- {
- free(str);
- str = NULL;
- if (end_of_text < 0)
- listener_append_and_prompt(NULL);
- else
- {
- new_eot = GUI_TEXT_END(w);
- GUI_LISTENER_TEXT_INSERT(w, new_eot, (char *)"\n");
- }
- if (full_str) GUI_FREE(full_str);
- return;
- }
- }
- else
- {
- /* no parens -- pick up closest entity */
- int loc, k, len;
- char *tmp;
- loc = current_position - start_of_text - 1;
- for (i = loc; i >= 0; i--)
- if ((str[i] == '\n') || (i == 0))
- {
- len = mus_strlen(str);
- tmp = (char *)calloc(len + 1, sizeof(char));
- if (i != 0) i++;
- for (k = 0; i < len; i++, k++)
- if ((i > loc) &&
- ((str[i] == '\n') ||
- (str[i] == ' ')))
- break;
- else tmp[k] = str[i];
- free(str);
- str = tmp;
- break;
- }
- }
- }
- }
-#endif
-
- if (full_str) GUI_FREE(full_str);
- if (str)
- {
- bool got_error = false;
- char *errmsg = NULL;
-
- if (current_position < (last_position - 2))
- GUI_LISTENER_TEXT_INSERT(w, GUI_TEXT_END(w), str);
-
- GUI_SET_CURSOR(w, ss->wait_cursor);
- GUI_UPDATE(w); /* not sure about this... */
-
- if ((mus_strlen(str) > 1) || (str[0] != '\n'))
- remember_listener_string(str);
+ return(Xen_hook_has_list(read_hook));
+}
-#if HAVE_RUBY || HAVE_FORTH
- form = XEN_EVAL_C_STRING(str);
-#endif
-#if HAVE_SCHEME
- /* very tricky -- we need the interface running to see C-g, and in ordinary (not-hung, but very slow-to-compute) code
- * we need to let other interface stuff run. We can't look at each event and flush all but the C-g we're waiting
- * for because that confuses the rest of the GUI, and some such interactions are expected. But if interface actions
- * are tied to scheme code, the check_for_event lets that code be evaluated, even though we're actually running
- * the evaluator already in a separate thread. If we block on the thread ID (pthread_self), bad stuff still gets
- * through somehow.
- *
- * s7 threads here only solves the s7 side of the problem. To make the Gtk calls thread-safe,
- * we have to use gdk threads, and that means either wrapping every gtk section thoughout Snd in
- * gdk_thread_enter/leave, or expecting the caller to do that in every expression he types in the listener.
- *
- * Using clone_s7 code in s7 for CL-like stack-groups is much trickier
- * than I thought -- it's basically importing all the pthread GC and alloc stuff into the main s7.
- *
- * So... set begin_hook to a func that calls gtk_main_iteration or check_for_event;
- * if C-g, the begin_hook func returns true, and s7 calls s7_quit, and C_g_typed is true here.
- * Otherwise, I think anything is safe because we're only looking at the block start, and
- * we're protected there by a stack barrier.
- */
- if (s7_begin_hook(s7) != NULL) return; /* s7 is already running (user typed <cr> during computation) */
-
- if ((mus_strlen(str) > 1) || (str[0] != '\n'))
- {
- int gc_loc;
- s7_pointer old_port;
-
- old_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
- gc_loc = s7_gc_protect(s7, old_port);
- s7_set_begin_hook(s7, listener_begin_hook);
-
- if (XEN_HOOKED(read_hook))
- form = run_or_hook(read_hook,
- XEN_LIST_1(C_TO_XEN_STRING(str)),
- S_read_hook);
- else form = XEN_EVAL_C_STRING(str);
-
- s7_set_begin_hook(s7, NULL);
- if (ss->C_g_typed)
- {
- errmsg = mus_strdup("\nSnd interrupted!");
- ss->C_g_typed = false;
- }
- else errmsg = mus_strdup(s7_get_output_string(s7, s7_current_error_port(s7)));
-
- s7_close_output_port(s7, s7_current_error_port(s7));
- s7_set_current_error_port(s7, old_port);
- s7_gc_unprotect_at(s7, gc_loc);
- }
-#endif
+Xen run_read_hook(char *str)
+{
+ return(run_or_hook(read_hook,
+ Xen_list_1(C_string_to_Xen_string(str)),
+ S_read_hook));
+}
- if (errmsg)
- {
- if (*errmsg)
- snd_display_result(errmsg, NULL);
- free(errmsg);
- got_error = true;
- }
- else snd_report_listener_result(form); /* used to check for unbound form here, but that's no good in Ruby */
-
- free(str);
- str = NULL;
- GUI_UNSET_CURSOR(w, ss->arrow_cursor);
- }
- else
+#if HAVE_FORTH || HAVE_RUBY
+void call_read_hook_or_eval(const char *text)
+{
+ Xen form;
+ if (Xen_hook_has_list(read_hook))
{
- listener_append_and_prompt(NULL);
+ form = run_or_hook(read_hook,
+ Xen_list_1(C_string_to_Xen_string(text)),
+ S_read_hook);
+ if (Xen_is_true(form))
+ return;
}
-
- cmd_eot = GUI_TEXT_END(w);
- add_listener_position(cmd_eot);
- GUI_TEXT_GOTO(w, cmd_eot - 1);
- GUI_TEXT_SET_INSERTION_POSITION(w, cmd_eot + 1);
-#endif
+ else form = Xen_eval_C_string(text);
+ snd_report_listener_result(form);
}
+#endif
-static XEN g_save_listener(XEN filename)
+static Xen g_save_listener(Xen filename)
{
#define H_save_listener "(" S_save_listener " filename): saves the current listener text in filename"
FILE *fp = NULL;
const char *name;
int err = 0;
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ONLY_ARG, S_save_listener, "a string");
- name = XEN_TO_C_STRING(filename);
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_save_listener, "a string");
+ name = Xen_string_to_C_string(filename);
fp = FOPEN(name, "w");
if (fp)
{
@@ -819,34 +110,34 @@ static XEN g_save_listener(XEN filename)
snd_fclose(fp, name);
}
if ((!fp) || (err == -1))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_listener ": can't save ~S, ~A"),
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_save_listener ": can't save ~S, ~A"),
filename,
- C_TO_XEN_STRING(snd_io_strerror())));
+ C_string_to_Xen_string(snd_io_strerror())));
return(filename);
}
-static XEN g_clear_listener(void)
+static Xen g_clear_listener(void)
{
#define H_clear_listener "(" S_clear_listener "): removes listener text from the beginning to the cursor"
clear_listener();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_show_listener(void)
+static Xen g_show_listener(void)
{
#define H_show_listener "(" S_show_listener ") returns " PROC_TRUE " if the listener is open, otherwise " PROC_FALSE "."
- return(C_TO_XEN_BOOLEAN(listener_is_visible()));
+ return(C_bool_to_Xen_boolean(listener_is_visible()));
}
-static XEN g_set_show_listener(XEN val)
+static Xen g_set_show_listener(Xen val)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_show_listener, "a boolean");
- handle_listener(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(listener_is_visible()));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_show_listener, "a boolean");
+ handle_listener(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(listener_is_visible()));
}
@@ -859,9 +150,9 @@ void set_listener_prompt(const char *new_prompt)
{
#if HAVE_FORTH
char *str;
- XEN_EVAL_C_STRING("before-prompt-hook reset-hook!\n");
+ Xen_eval_C_string("before-prompt-hook reset-hook!\n");
str = mus_format("before-prompt-hook lambda: <{ prompt pos }> \"%s\" ; add-hook!", listener_prompt(ss));
- XEN_EVAL_C_STRING(str);
+ Xen_eval_C_string(str);
free(str);
#endif
@@ -881,85 +172,115 @@ void set_listener_prompt(const char *new_prompt)
* we output a new prompt; otherwise the expression finder gets confused
* by the old prompt.
*/
- listener_append_and_prompt(NULL); /* this checks first that the listener exists */
-
+#if (!USE_GTK)
+ listener_append_and_prompt(NULL); /* this checks first that the listener exists */
+#else
+ glistener_set_prompt(ss->listener, listener_prompt(ss)); /* this also checks */
+#endif
#endif
-
}
-static XEN g_listener_prompt(void) {return(C_TO_XEN_STRING(listener_prompt(ss)));}
+static Xen g_listener_prompt(void) {return(C_string_to_Xen_string(listener_prompt(ss)));}
-static XEN g_set_listener_prompt(XEN val)
+static Xen g_set_listener_prompt(Xen val)
{
+ char *new_prompt;
#define H_listener_prompt "(" S_listener_prompt "): the current lisp listener prompt character ('>') "
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_listener_prompt, "a string");
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_listener_prompt, "a string");
+
if (listener_prompt(ss)) free(listener_prompt(ss));
- set_listener_prompt(mus_strdup(XEN_TO_C_STRING(val)));
- return(C_TO_XEN_STRING(listener_prompt(ss)));
+ new_prompt = mus_strdup(Xen_string_to_C_string(val));
+ if (new_prompt == NULL) /* without this fixup, (set! (listener-prompt) "") can cause a segfault, at least in Motif */
+ {
+ new_prompt = (char *)malloc(sizeof(char));
+ new_prompt[0] = 0;
+ }
+ set_listener_prompt(new_prompt);
+
+ return(val);
}
-static XEN g_snd_completion(XEN text)
+static Xen g_snd_completion(Xen text)
{
/* perhaps callable from emacs? */
char *str, *temp;
- XEN res;
- temp = mus_strdup(XEN_TO_C_STRING(text));
+ Xen res;
+
+ Xen_check_type(Xen_is_string(text), text, 1, "snd-completion", "a string");
+
+ temp = mus_strdup(Xen_string_to_C_string(text));
str = expression_completer(NULL_WIDGET, temp, NULL);
- res = C_TO_XEN_STRING(str);
+ res = C_string_to_Xen_string(str);
+
free(str);
free(temp);
+
return(res);
}
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_1(g_save_listener_w, g_save_listener)
-XEN_NARGIFY_0(g_clear_listener_w, g_clear_listener);
-XEN_NARGIFY_0(g_show_listener_w, g_show_listener)
-XEN_NARGIFY_1(g_set_show_listener_w, g_set_show_listener)
-XEN_NARGIFY_0(g_listener_prompt_w, g_listener_prompt)
-XEN_NARGIFY_1(g_set_listener_prompt_w, g_set_listener_prompt)
-XEN_NARGIFY_1(g_snd_completion_w, g_snd_completion)
+static Xen g_listener_colorized(void)
+{
+ #define H_listener_colorized "(" S_listener_colorized ") returns #t if the listener is highlighting syntax."
+#if USE_GTK
+ return(C_bool_to_Xen_boolean(listener_colorized()));
#else
-#define g_save_listener_w g_save_listener
-#define g_clear_listener_w g_clear_listener
-#define g_show_listener_w g_show_listener
-#define g_set_show_listener_w g_set_show_listener
-#define g_listener_prompt_w g_listener_prompt
-#define g_set_listener_prompt_w g_set_listener_prompt
-#define g_snd_completion_w g_snd_completion
+ return(Xen_false);
#endif
+}
-void g_init_listener(void)
+static Xen g_listener_set_colorized(Xen val)
{
- XEN_DEFINE_PROCEDURE(S_save_listener, g_save_listener_w, 1, 0, 0, H_save_listener);
- XEN_DEFINE_PROCEDURE(S_clear_listener, g_clear_listener_w, 0, 0, 0, H_clear_listener);
+#if USE_GTK
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_listener_colorized, "a boolean");
+ listener_set_colorized(Xen_boolean_to_C_bool(val));
+#endif
+ return(val);
+}
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_show_listener, g_show_listener_w, H_show_listener,
- S_setB S_show_listener, g_set_show_listener_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_listener_prompt, g_listener_prompt_w, H_listener_prompt,
- S_setB S_listener_prompt, g_set_listener_prompt_w, 0, 0, 1, 0);
+Xen_wrap_1_arg(g_save_listener_w, g_save_listener)
+Xen_wrap_no_args(g_clear_listener_w, g_clear_listener);
+Xen_wrap_no_args(g_show_listener_w, g_show_listener)
+Xen_wrap_1_arg(g_set_show_listener_w, g_set_show_listener)
+Xen_wrap_no_args(g_listener_prompt_w, g_listener_prompt)
+Xen_wrap_1_arg(g_set_listener_prompt_w, g_set_listener_prompt)
+Xen_wrap_1_arg(g_snd_completion_w, g_snd_completion)
+Xen_wrap_no_args(g_listener_colorized_w, g_listener_colorized)
+Xen_wrap_1_arg(g_listener_set_colorized_w, g_listener_set_colorized)
#if HAVE_SCHEME
- #define H_read_hook S_read_hook " (text): called each time a line is typed into the listener (triggered by the carriage return). \
-If it returns " PROC_TRUE ", Snd assumes you've dealt the text yourself, and does not try to evaluate it. \n\
-(define (read-listener-line prompt) \n\
- (let ((res #f)) \n\
- (add-hook! " S_read_hook " (lambda (str) (set! res str) #t)) \n\
- (" S_snd_print " prompt) \n\
- (do () ((or (" S_c_g ") res))) \n\
- (reset-hook! " S_read_hook ") \n\
- res))"
+#if USE_GTK
+static s7_pointer acc_listener_colorized(s7_scheme *sc, s7_pointer args) {return(g_listener_set_colorized(s7_cadr(args)));}
+#endif
+static s7_pointer acc_listener_prompt(s7_scheme *sc, s7_pointer args) {return(g_set_listener_prompt(s7_cadr(args)));}
#endif
-#if HAVE_RUBY || HAVE_FORTH
+
+void g_init_listener(void)
+{
+ Xen_define_procedure(S_save_listener, g_save_listener_w, 1, 0, 0, H_save_listener);
+ Xen_define_procedure(S_clear_listener, g_clear_listener_w, 0, 0, 0, H_clear_listener);
+
+ Xen_define_dilambda(S_show_listener, g_show_listener_w, H_show_listener, S_set S_show_listener, g_set_show_listener_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_listener_prompt, g_listener_prompt_w, H_listener_prompt, S_set S_listener_prompt, g_set_listener_prompt_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_listener_colorized, g_listener_colorized_w, H_listener_colorized,
+ S_set S_listener_colorized, g_listener_set_colorized_w, 0, 0, 1, 0);
+
#define H_read_hook S_read_hook " (text): called each time a line is typed into the listener (triggered by the carriage return). \
If it returns true, Snd assumes you've dealt the text yourself, and does not try to evaluate it."
-#endif
- read_hook = XEN_DEFINE_HOOK(S_read_hook, 1, H_read_hook);
+ read_hook = Xen_define_hook(S_read_hook, "(make-hook 'text)", 1, H_read_hook);
- XEN_DEFINE_PROCEDURE("snd-completion", g_snd_completion_w, 1, 0, 0, "return completion of arg");
+ Xen_define_procedure("snd-completion", g_snd_completion_w, 1, 0, 0, "return completion of arg");
+
+#if HAVE_SCHEME
+#if USE_GTK
+ s7_symbol_set_documentation(s7, ss->listener_colorized_symbol, "*listener-colorized*: number of vector elements to print in the listener (default: 12)");
+ s7_symbol_set_access(s7, ss->listener_colorized_symbol, s7_make_function(s7, "[acc-" S_listener_colorized "]", acc_listener_colorized, 2, 0, false, "accessor"));
+#endif
+ s7_symbol_set_documentation(s7, ss->listener_prompt_symbol, "*listener-prompt*: the current lisp listener prompt character ('>') ");
+ s7_symbol_set_access(s7, ss->listener_prompt_symbol, s7_make_function(s7, "[acc-" S_listener_prompt "]", acc_listener_prompt, 2, 0, false, "accessor"));
+#endif
}
diff --git a/snd-main.c b/snd-main.c
index 8a870af..5c0309d 100644
--- a/snd-main.c
+++ b/snd-main.c
@@ -24,20 +24,20 @@ static void save_peak_env_info(chan_info *cp)
}
-static XEN exit_hook;
-static XEN before_exit_hook;
+static Xen exit_hook;
+static Xen before_exit_hook;
bool snd_exit_cleanly(bool force_exit)
{
- XEN res = XEN_FALSE;
+ Xen res = Xen_false;
ss->exiting = true; /* if segfault during exit code, don't try to restart at event loop! */
/* before-exit-hook can cancel the exit, whereas exit-hook can't */
- if (XEN_HOOKED(before_exit_hook))
+ if (Xen_hook_has_list(before_exit_hook))
res = run_or_hook(before_exit_hook,
- XEN_EMPTY_LIST,
+ Xen_empty_list,
S_before_exit_hook);
- if ((XEN_TRUE_P(res)) && (!force_exit)) return(false); /* does it make any sense to call this hook if we're forced to exit anyway? */
+ if ((Xen_is_true(res)) && (!force_exit)) return(false); /* does it make any sense to call this hook if we're forced to exit anyway? */
#if (!USE_NO_GUI)
if (ask_about_unsaved_edits(ss))
@@ -63,21 +63,14 @@ bool snd_exit_cleanly(bool force_exit)
if (peak_env_dir(ss))
for_each_chan(save_peak_env_info);
- if (XEN_HOOKED(exit_hook))
+ if (Xen_hook_has_list(exit_hook))
run_hook(exit_hook,
- XEN_EMPTY_LIST,
+ Xen_empty_list,
S_exit_hook);
-#if HAVE_FAM
- if (ss->fam_ok)
- {
- cleanup_edit_header_watcher();
- cleanup_new_file_watcher();
- if (ss->fam_connection)
- FAMClose(ss->fam_connection);
- ss->fam_connection = NULL;
- }
-#endif
+ if (ss->file_monitor_ok)
+ cleanup_file_monitor();
+
cleanup_dac();
for_each_normal_chan(remove_temp_files);
cleanup_region_temp_files();
@@ -90,7 +83,7 @@ void sound_not_current(snd_info *sp)
{
/* check for change in update status */
bool needs_update;
- if (ss->fam_ok) return;
+ if (ss->file_monitor_ok) return;
needs_update = (file_write_date(sp->filename) != sp->write_date);
if (needs_update != sp->need_update)
{
@@ -280,39 +273,39 @@ static bool b_ok = false;
#if HAVE_RUBY
-static void pss_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "set_%s(%s)\n", TO_PROC_NAME(name), val);}
-static void pss_sq(FILE *fd, const char *name, const char *val) {fprintf(fd, "set_%s(\"%s\")\n", TO_PROC_NAME(name), val);}
-static void pss_sd(FILE *fd, const char *name, int val) {fprintf(fd, "set_%s(%d)\n", TO_PROC_NAME(name), val);}
-static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "set_%s(" MUS_LD ")\n", TO_PROC_NAME(name), val);}
-static void pss_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "set_%s(%.4f)\n", TO_PROC_NAME(name), val);}
+static void pss_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "set_%s(%s)\n", to_proc_name(name), val);}
+static void pss_sq(FILE *fd, const char *name, const char *val) {fprintf(fd, "set_%s(\"%s\")\n", to_proc_name(name), val);}
+static void pss_sd(FILE *fd, const char *name, int val) {fprintf(fd, "set_%s(%d)\n", to_proc_name(name), val);}
+static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "set_%s(%lld)\n", to_proc_name(name), val);}
+static void pss_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "set_%s(%.4f)\n", to_proc_name(name), val);}
static void pss_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val2)
- {fprintf(fd, "set_%s([%f, %f])\n", TO_PROC_NAME(name), val1, val2);}
+ {fprintf(fd, "set_%s([%f, %f])\n", to_proc_name(name), val1, val2);}
-static void psp_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "%sset_%s(%s, sfile)\n", white_space, TO_PROC_NAME(name), val);}
-static void psp_sd(FILE *fd, const char *name, int val) {fprintf(fd, "%sset_%s(%d, sfile)\n", white_space, TO_PROC_NAME(name), val);}
-static void psp_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "%sset_%s(%.4f, sfile)\n", white_space, TO_PROC_NAME(name), val);}
+static void psp_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "%sset_%s(%s, sfile)\n", white_space, to_proc_name(name), val);}
+static void psp_sd(FILE *fd, const char *name, int val) {fprintf(fd, "%sset_%s(%d, sfile)\n", white_space, to_proc_name(name), val);}
+static void psp_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "%sset_%s(%.4f, sfile)\n", white_space, to_proc_name(name), val);}
static void psp_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val2)
- {fprintf(fd, "%sset_%s([%f, %f], sfile)\n", white_space, TO_PROC_NAME(name), val1, val2);}
+ {fprintf(fd, "%sset_%s([%f, %f], sfile)\n", white_space, to_proc_name(name), val1, val2);}
static void pcp_ss(FILE *fd, const char *name, const char *val, int chan)
- {fprintf(fd, "%sset_%s(%s, sfile, %d)\n", white_space, TO_PROC_NAME(name), val, chan);}
+ {fprintf(fd, "%sset_%s(%s, sfile, %d)\n", white_space, to_proc_name(name), val, chan);}
static void pcp_sss(FILE *fd, const char *name, const char *val, int chan, const char *grf)
- {fprintf(fd, "%sset_%s(\"%s\", sfile, %d, %s)\n", white_space, TO_PROC_NAME(name), val, chan, TO_VAR_NAME(grf));}
+ {fprintf(fd, "%sset_%s(\"%s\", sfile, %d, %s)\n", white_space, to_proc_name(name), val, chan, TO_VAR_NAME(grf));}
static void pcp_sd(FILE *fd, const char *name, int val, int chan)
- {fprintf(fd, "%sset_%s(%d, sfile, %d)\n", white_space, TO_PROC_NAME(name), val, chan);}
+ {fprintf(fd, "%sset_%s(%d, sfile, %d)\n", white_space, to_proc_name(name), val, chan);}
static void pcp_sod(FILE *fd, const char *name, mus_long_t val, int chan)
- {fprintf(fd, "%sset_%s(" MUS_LD ", sfile, %d)\n", white_space, TO_PROC_NAME(name), val, chan);}
+ {fprintf(fd, "%sset_%s(%lld, sfile, %d)\n", white_space, to_proc_name(name), val, chan);}
static void pcp_sf(FILE *fd, const char *name, mus_float_t val, int chan)
- {fprintf(fd, "%sset_%s(%.4f, sfile, %d)\n", white_space, TO_PROC_NAME(name), val, chan);}
+ {fprintf(fd, "%sset_%s(%.4f, sfile, %d)\n", white_space, to_proc_name(name), val, chan);}
static void pcp_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val2, int chan)
- {fprintf(fd, "%sset_%s([%f, %f], sfile, %d)\n", white_space, TO_PROC_NAME(name), val1, val2, chan);}
+ {fprintf(fd, "%sset_%s([%f, %f], sfile, %d)\n", white_space, to_proc_name(name), val1, val2, chan);}
#endif
@@ -320,7 +313,7 @@ static void pcp_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val
static void pss_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "%s set-%s drop\n", val, name);}
static void pss_sq(FILE *fd, const char *name, const char *val) {fprintf(fd, "\"%s\" set-%s drop\n", val, name);}
static void pss_sd(FILE *fd, const char *name, int val) {fprintf(fd, "%d set-%s drop\n", val, name);}
-static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, MUS_LD " set-%s drop\n", val, name);}
+static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "%lld set-%s drop\n", val, name);}
static void pss_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "%.4f set-%s drop\n", val, name);}
static void pss_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val2)
{fprintf(fd, "%s'( %f %f ) set-%s drop\n", white_space, val1, val2, name);}
@@ -342,7 +335,7 @@ static void pcp_sd(FILE *fd, const char *name, int val, int chan)
{fprintf(fd, "%s%d sfile %d set-%s drop\n", white_space, val, chan, name);}
static void pcp_sod(FILE *fd, const char *name, mus_long_t val, int chan)
- {fprintf(fd, "%s" MUS_LD " sfile %d set-%s drop\n", white_space, val, chan, name);}
+ {fprintf(fd, "%s%lld sfile %d set-%s drop\n", white_space, val, chan, name);}
static void pcp_sf(FILE *fd, const char *name, mus_float_t val, int chan)
{fprintf(fd, "%s%.4f sfile %d set-%s drop\n", white_space, val, chan, name);}
@@ -356,7 +349,7 @@ static void pcp_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val
static void pss_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "(set! (%s) %s)\n", name, val);}
static void pss_sq(FILE *fd, const char *name, const char *val) {fprintf(fd, "(set! (%s) \"%s\")\n", name, val);}
static void pss_sd(FILE *fd, const char *name, int val) {fprintf(fd, "(set! (%s) %d)\n", name, val);}
-static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "(set! (%s) " MUS_LD ")\n", name, val);}
+static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "(set! (%s) %lld)\n", name, val);}
static void pss_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "(set! (%s) %.4f)\n", name, val);}
static void pss_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val2) {fprintf(fd, "(set! (%s) (list %f %f))\n", name, val1, val2);}
@@ -382,7 +375,7 @@ static void pcp_sd(FILE *fd, const char *name, int val, int chan)
{b_ok = true; fprintf(fd, "%s(set! (%s sfile %d) %d)\n", white_space, name, chan, val);}
static void pcp_sod(FILE *fd, const char *name, mus_long_t val, int chan)
- {b_ok = true; fprintf(fd, "%s(set! (%s sfile %d) " MUS_LD ")\n", white_space, name, chan, val);}
+ {b_ok = true; fprintf(fd, "%s(set! (%s sfile %d) %lld)\n", white_space, name, chan, val);}
static void pcp_sf(FILE *fd, const char *name, mus_float_t val, int chan)
{b_ok = true; fprintf(fd, "%s(set! (%s sfile %d) %.4f)\n", white_space, name, chan, val);}
@@ -394,17 +387,9 @@ static void pcp_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val
static void save_options(FILE *fd)
{
- char *locale = NULL;
-
-#if HAVE_SETLOCALE && HAVE_SCHEME
- locale = mus_strdup(setlocale(LC_NUMERIC, "C"));
- /* must use decimal point in floats */
-#endif
-
- fprintf(fd, "\n%s Snd %s (%s) options saved %s\n", XEN_COMMENT_STRING, SND_VERSION, SND_DATE, snd_local_time());
+ fprintf(fd, "\n%s Snd %s (%s) options saved %s\n", Xen_comment_mark, SND_VERSION, SND_DATE, snd_local_time());
if (transform_size(ss) != DEFAULT_TRANSFORM_SIZE) pss_sod(fd, S_transform_size, transform_size(ss));
- if (minibuffer_history_length(ss) != DEFAULT_MINIBUFFER_HISTORY_LENGTH) pss_sd(fd, S_minibuffer_history_length, minibuffer_history_length(ss));
if (fft_window(ss) != DEFAULT_FFT_WINDOW) pss_ss(fd, S_fft_window, TO_VAR_NAME(mus_fft_window_xen_name(fft_window(ss))));
if (transform_graph_type(ss) != DEFAULT_TRANSFORM_GRAPH_TYPE) pss_ss(fd, S_transform_graph_type, transform_graph_type_name(transform_graph_type(ss)));
if (time_graph_type(ss) != DEFAULT_TIME_GRAPH_TYPE) pss_ss(fd, S_time_graph_type, time_graph_type_name(time_graph_type(ss)));
@@ -419,8 +404,6 @@ static void save_options(FILE *fd)
if (transform_type(ss) != DEFAULT_TRANSFORM_TYPE) pss_ss(fd, S_transform_type, TO_VAR_NAME(transform_program_name(transform_type(ss))));
if (zoom_focus_style(ss) != ZOOM_FOCUS_ACTIVE) pss_ss(fd, S_zoom_focus_style, zoom_focus_style_name(zoom_focus_style(ss)));
if (transform_normalization(ss) != DEFAULT_TRANSFORM_NORMALIZATION) pss_ss(fd, S_transform_normalization, transform_normalization_name(transform_normalization(ss)));
- if (optimization(ss) != DEFAULT_OPTIMIZATION) pss_sd(fd, S_optimization, optimization(ss));
- if (trap_segfault(ss) != DEFAULT_TRAP_SEGFAULT) pss_ss(fd, S_trap_segfault, b2s(trap_segfault(ss)));
if (with_file_monitor(ss) != DEFAULT_WITH_FILE_MONITOR) pss_ss(fd, S_with_file_monitor, b2s(with_file_monitor(ss)));
if (just_sounds(ss) != DEFAULT_JUST_SOUNDS) pss_ss(fd, S_just_sounds, b2s(just_sounds(ss)));
if (play_arrow_size(ss) != DEFAULT_PLAY_ARROW_SIZE) pss_sd(fd, S_play_arrow_size, play_arrow_size(ss));
@@ -437,8 +420,8 @@ static void save_options(FILE *fd)
if (default_output_srate(ss) != DEFAULT_OUTPUT_SRATE) pss_sd(fd, S_default_output_srate, default_output_srate(ss));
if (default_output_header_type(ss) != DEFAULT_OUTPUT_HEADER_TYPE)
pss_ss(fd, S_default_output_header_type, mus_header_type_to_string(default_output_header_type(ss)));
- if (default_output_data_format(ss) != DEFAULT_OUTPUT_DATA_FORMAT)
- pss_ss(fd, S_default_output_data_format, mus_data_format_to_string(default_output_data_format(ss)));
+ if (default_output_sample_type(ss) != DEFAULT_OUTPUT_SAMPLE_TYPE)
+ pss_ss(fd, S_default_output_sample_type, mus_sample_type_to_string(default_output_sample_type(ss)));
if (auto_resize(ss) != DEFAULT_AUTO_RESIZE) pss_ss(fd, S_auto_resize, b2s(auto_resize(ss)));
if (graphs_horizontal(ss) != DEFAULT_GRAPHS_HORIZONTAL) pss_ss(fd, S_graphs_horizontal, b2s(graphs_horizontal(ss)));
if (auto_update(ss) != DEFAULT_AUTO_UPDATE) pss_ss(fd, S_auto_update, b2s(auto_update(ss)));
@@ -453,6 +436,7 @@ static void save_options(FILE *fd)
if (save_as_dialog_src(ss) != DEFAULT_SAVE_AS_DIALOG_SRC) pss_ss(fd, S_save_as_dialog_src, b2s(save_as_dialog_src(ss)));
if (save_as_dialog_auto_comment(ss) != DEFAULT_SAVE_AS_DIALOG_AUTO_COMMENT) pss_ss(fd, S_save_as_dialog_auto_comment, b2s(save_as_dialog_auto_comment(ss)));
if (show_full_duration(ss) != DEFAULT_SHOW_FULL_DURATION) pss_ss(fd, S_show_full_duration, b2s(show_full_duration(ss)));
+ if (show_full_range(ss) != DEFAULT_SHOW_FULL_RANGE) pss_ss(fd, S_show_full_range, b2s(show_full_range(ss)));
if (fneq(initial_beg(ss), DEFAULT_INITIAL_BEG)) pss_sf(fd, S_initial_beg, initial_beg(ss));
if (fneq(initial_dur(ss), DEFAULT_INITIAL_DUR)) pss_sf(fd, S_initial_dur, initial_dur(ss));
if (dac_combines_channels(ss) != DEFAULT_DAC_COMBINES_CHANNELS) pss_ss(fd, S_dac_combines_channels, b2s(dac_combines_channels(ss)));
@@ -476,8 +460,9 @@ static void save_options(FILE *fd)
if (fneq(auto_update_interval(ss), DEFAULT_AUTO_UPDATE_INTERVAL)) pss_sf(fd, S_auto_update_interval, auto_update_interval(ss));
if (fneq(cursor_update_interval(ss), DEFAULT_CURSOR_UPDATE_INTERVAL)) pss_sf(fd, S_cursor_update_interval, cursor_update_interval(ss));
if (cursor_location_offset(ss) != DEFAULT_CURSOR_LOCATION_OFFSET) pss_sd(fd, S_cursor_location_offset, cursor_location_offset(ss));
- if (verbose_cursor(ss) != DEFAULT_VERBOSE_CURSOR) pss_ss(fd, S_with_verbose_cursor, b2s(verbose_cursor(ss)));
+ if (with_verbose_cursor(ss) != DEFAULT_WITH_VERBOSE_CURSOR) pss_ss(fd, S_with_verbose_cursor, b2s(with_verbose_cursor(ss)));
if (with_inset_graph(ss) != DEFAULT_WITH_INSET_GRAPH) pss_ss(fd, S_with_inset_graph, b2s(with_inset_graph(ss)));
+ if (with_interrupts(ss) != DEFAULT_WITH_INTERRUPTS) pss_ss(fd, S_with_interrupts, b2s(with_interrupts(ss)));
if (with_smpte_label(ss) != DEFAULT_WITH_SMPTE_LABEL) pss_ss(fd, S_with_smpte_label, b2s(with_smpte_label(ss)));
if (with_pointer_focus(ss) != DEFAULT_WITH_POINTER_FOCUS) pss_ss(fd, S_with_pointer_focus, b2s(with_pointer_focus(ss)));
if (show_indices(ss) != DEFAULT_SHOW_INDICES) pss_ss(fd, S_show_indices, b2s(show_indices(ss)));
@@ -489,7 +474,9 @@ static void save_options(FILE *fd)
if (show_axes(ss) != DEFAULT_SHOW_AXES) pss_ss(fd, S_show_axes, show_axes2string(show_axes(ss)));
if (show_marks(ss) != DEFAULT_SHOW_MARKS) pss_ss(fd, S_show_marks, b2s(show_marks(ss)));
if (clipping(ss) != DEFAULT_CLIPPING) pss_ss(fd, S_clipping, b2s(clipping(ss)));
+#if USE_MOTIF
if (view_files_sort(ss) != DEFAULT_VIEW_FILES_SORT) pss_sd(fd, S_view_files_sort, view_files_sort(ss));
+#endif
if (fft_log_magnitude(ss) != DEFAULT_FFT_LOG_MAGNITUDE) pss_ss(fd, S_fft_log_magnitude, b2s(fft_log_magnitude(ss)));
if (fft_log_frequency(ss) != DEFAULT_FFT_LOG_FREQUENCY) pss_ss(fd, S_fft_log_frequency, b2s(fft_log_frequency(ss)));
if (fft_with_phases(ss) != DEFAULT_FFT_WITH_PHASES) pss_ss(fd, S_fft_with_phases, b2s(fft_with_phases(ss)));
@@ -500,9 +487,9 @@ static void save_options(FILE *fd)
if (mix_tag_width(ss) != DEFAULT_MIX_TAG_WIDTH) pss_sd(fd, S_mix_tag_width, mix_tag_width(ss));
if (mark_tag_height(ss) != DEFAULT_MARK_TAG_HEIGHT) pss_sd(fd, S_mark_tag_height, mark_tag_height(ss));
if (mark_tag_width(ss) != DEFAULT_MARK_TAG_WIDTH) pss_sd(fd, S_mark_tag_width, mark_tag_width(ss));
- if (enved_wave_p(ss) != DEFAULT_ENVED_WAVE_P) pss_ss(fd, S_enved_wave_p, b2s(enved_wave_p(ss)));
+ if (enved_with_wave(ss) != DEFAULT_ENVED_WITH_WAVE) pss_ss(fd, S_enved_with_wave, b2s(enved_with_wave(ss)));
if (enved_in_dB(ss) != DEFAULT_ENVED_IN_DB) pss_ss(fd, S_enved_in_dB, b2s(enved_in_dB(ss)));
- if (enved_clip_p(ss) != DEFAULT_ENVED_CLIP_P) pss_ss(fd, S_enved_clip_p, b2s(enved_clip_p(ss)));
+ if (enved_clipping(ss) != DEFAULT_ENVED_CLIPPING) pss_ss(fd, S_enved_clipping, b2s(enved_clipping(ss)));
if (enved_style(ss) == ENVELOPE_EXPONENTIAL) pss_ss(fd, S_enved_style, TO_VAR_NAME(S_envelope_exponential));
if ((!tiny_font(ss)) || (!(mus_strcmp(tiny_font(ss), DEFAULT_TINY_FONT)))) pss_sq(fd, S_tiny_font, tiny_font(ss));
@@ -534,8 +521,6 @@ static void save_options(FILE *fd)
if ((listener_prompt(ss)) && (!(mus_strcmp(listener_prompt(ss), DEFAULT_LISTENER_PROMPT)))) pss_sq(fd, S_listener_prompt, listener_prompt(ss));
if ((html_program(ss)) && (!(mus_strcmp(html_program(ss), DEFAULT_HTML_PROGRAM)))) pss_sq(fd, S_html_program, html_program(ss));
if (html_dir(ss)) pss_sq(fd, S_html_dir, html_dir(ss));
- if (audio_input_device(ss) != DEFAULT_AUDIO_INPUT_DEVICE) pss_sd(fd, S_audio_input_device, audio_input_device(ss));
- if (audio_output_device(ss) != DEFAULT_AUDIO_OUTPUT_DEVICE) pss_sd(fd, S_audio_output_device, audio_output_device(ss));
if (fneq(fft_window_alpha(ss), DEFAULT_FFT_WINDOW_ALPHA)) pss_sf(fd, S_fft_window_alpha, fft_window_alpha(ss));
if (fneq(fft_window_beta(ss), DEFAULT_FFT_WINDOW_BETA)) pss_sf(fd, S_fft_window_beta, fft_window_beta(ss));
@@ -588,8 +573,7 @@ static void save_options(FILE *fd)
if (filter_control_order(ss) != DEFAULT_FILTER_CONTROL_ORDER) pss_sd(fd, S_filter_control_order, filter_control_order(ss));
if (filter_control_in_dB(ss) != DEFAULT_FILTER_CONTROL_IN_DB) pss_ss(fd, S_filter_control_in_dB, b2s(filter_control_in_dB(ss)));
if (filter_control_in_hz(ss) != DEFAULT_FILTER_CONTROL_IN_HZ) pss_ss(fd, S_filter_control_in_hz, b2s(filter_control_in_hz(ss)));
- if (with_tracking_cursor(ss) != DEFAULT_WITH_TRACKING_CURSOR)
- pss_ss(fd, S_with_tracking_cursor, b2s((bool)(with_tracking_cursor(ss)))); /* a boolean from the user's point of view */
+ if (with_tracking_cursor(ss) != DEFAULT_WITH_TRACKING_CURSOR) pss_sd(fd, S_with_tracking_cursor, (int)with_tracking_cursor(ss));
if (in_show_controls(ss) != DEFAULT_SHOW_CONTROLS) pss_ss(fd, S_show_controls, b2s(in_show_controls(ss)));
save_colors(fd);
@@ -601,41 +585,35 @@ static void save_options(FILE *fd)
if (fneq(clm_default_frequency_c(), MUS_CLM_DEFAULT_FREQUENCY)) pss_sf(fd, S_clm_default_frequency, clm_default_frequency_c());
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
if ((chans != 2) ||
(srate != 44100) ||
- (format != MUS_BSHORT))
+ (samp_type != MUS_BSHORT))
{
#if HAVE_SCHEME
fprintf(fd, "(set! (mus-header-raw-defaults) (list %d %d %s))\n",
srate,
chans,
- mus_data_format_to_string(format));
+ mus_sample_type_to_string(samp_type));
#endif
#if HAVE_RUBY
fprintf(fd, "set_mus_header_raw_defaults([%d, %d, %s])\n",
srate,
chans,
- mus_data_format_to_string(format));
+ mus_sample_type_to_string(samp_type));
#endif
#if HAVE_FORTH
fprintf(fd, "'( %d %d %s ) set-mus-header-raw-defaults drop\n",
srate,
chans,
- mus_data_format_to_string(format));
+ mus_sample_type_to_string(samp_type));
#endif
}
}
- fprintf(fd, "%s end of snd options\n", XEN_COMMENT_STRING);
- if (locale)
- {
-#if HAVE_SETLOCALE
- setlocale(LC_NUMERIC, locale);
-#endif
- free(locale);
- }
+ fprintf(fd, "%s end of snd options\n", Xen_comment_mark);
}
@@ -646,28 +624,28 @@ void global_control_panel_state(void)
char *buf;
snd_help_append("\n\nCurrent control panel defaults:\n\n");
buf = (char *)calloc(1024, sizeof(char));
- mus_snprintf(buf, 1024, "amp bounds: %.3f to %.3f\n",
+ snprintf(buf, 1024, "amp bounds: %.3f to %.3f\n",
amp_control_min(ss), amp_control_max(ss));
snd_help_append(buf);
- mus_snprintf(buf, 1024, "speed bounds: %.3f to %.3f, tones: %d, style: %s\n",
+ snprintf(buf, 1024, "speed bounds: %.3f to %.3f, tones: %d, style: %s\n",
speed_control_min(ss), speed_control_max(ss),
speed_control_tones(ss),
speed_control_style_name(speed_control_style(ss)));
snd_help_append(buf);
- mus_snprintf(buf, 1024, "expand bounds: %.3f to %.3f, ramp: %.3f, hop: %.3f, length: %.3f, jitter: %.3f\n",
+ snprintf(buf, 1024, "expand bounds: %.3f to %.3f, ramp: %.3f, hop: %.3f, length: %.3f, jitter: %.3f\n",
expand_control_min(ss), expand_control_max(ss),
expand_control_ramp(ss), expand_control_hop(ss), expand_control_length(ss), expand_control_jitter(ss));
snd_help_append(buf);
- mus_snprintf(buf, 1024, "contrast bounds: %.3f to %.3f, amp: %.3f\n",
+ snprintf(buf, 1024, "contrast bounds: %.3f to %.3f, amp: %.3f\n",
contrast_control_min(ss), contrast_control_max(ss),
contrast_control_amp(ss));
snd_help_append(buf);
- mus_snprintf(buf, 1024, "reverb scale: %.3f to %.3f, length: %.3f to %.3f, feedbacl: %.3f, lowpass: %.3f, decay: %.3f\n",
+ snprintf(buf, 1024, "reverb scale: %.3f to %.3f, length: %.3f to %.3f, feedbacl: %.3f, lowpass: %.3f, decay: %.3f\n",
reverb_control_scale_min(ss), reverb_control_scale_max(ss),
reverb_control_length_min(ss), reverb_control_length_max(ss),
reverb_control_feedback(ss), reverb_control_lowpass(ss), reverb_control_decay(ss));
snd_help_append(buf);
- mus_snprintf(buf, 1024, "filter order: %d, in dB: %s, in Hz: %s\n",
+ snprintf(buf, 1024, "filter order: %d, in dB: %s, in Hz: %s\n",
filter_control_order(ss),
b2s(filter_control_in_dB(ss)),
b2s(filter_control_in_hz(ss)));
@@ -682,20 +660,20 @@ void global_fft_state(void)
char *buf;
snd_help_append("\n\nCurrent FFT defaults:\n\n");
buf = (char *)calloc(1024, sizeof(char));
- mus_snprintf(buf, 1024, "fft size: " MUS_LD "\n type: %s\n window: %s (alpha: %.3f, beta: %.3f)\n",
+ snprintf(buf, 1024, "fft size: %lld\n type: %s\n window: %s (alpha: %.3f, beta: %.3f)\n",
transform_size(ss),
TO_VAR_NAME(transform_program_name(transform_type(ss))),
TO_VAR_NAME(mus_fft_window_xen_name(fft_window(ss))),
fft_window_alpha(ss),
fft_window_beta(ss));
snd_help_append(buf);
- mus_snprintf(buf, 1024, " graph-type: %s\n show-peaks: %s (max: %d)\n show-selection-fft: %s\n",
+ snprintf(buf, 1024, " graph-type: %s\n show-peaks: %s (max: %d)\n show-selection-fft: %s\n",
transform_graph_type_name(transform_graph_type(ss)),
b2s(show_transform_peaks(ss)),
max_transform_peaks(ss),
b2s(show_selection_transform(ss)));
snd_help_append(buf);
- mus_snprintf(buf, 1024, " log freq: %s (start: %.3f)\n dB: %s, min-dB: %.3f\n normalization: %s\n",
+ snprintf(buf, 1024, " log freq: %s (start: %.3f)\n dB: %s, min-dB: %.3f\n normalization: %s\n",
b2s(fft_log_frequency(ss)),
log_freq_start(ss),
b2s(fft_log_magnitude(ss)),
@@ -711,57 +689,57 @@ void global_fft_state(void)
static void set_print_lengths(int len);
-static void save_property_list(FILE *fd, XEN property_list, int chan, int edpos)
+static void save_property_list(FILE *fd, Xen property_list, int chan, int edpos)
{
- XEN ignore_list;
+ Xen ignore_list;
int old_print_length, old_vct_print_length;
int old_s7_print_length;
- old_s7_print_length = s7_vector_print_length(s7);
+ old_s7_print_length = s7_print_length(s7);
old_vct_print_length = mus_vct_print_length();
old_print_length = print_length(ss);
/* make sure we don't truncate vector output with "..." */
set_print_lengths(1000000); /* this sets all three lengths */
- ignore_list = XEN_ASSOC(C_STRING_TO_XEN_SYMBOL("save-state-ignore"), property_list);
+ ignore_list = Xen_assoc(C_string_to_Xen_symbol("save-state-ignore"), property_list);
- if (!(XEN_LIST_P(ignore_list)))
+ if (!(Xen_is_list(ignore_list)))
{
char *temp = NULL;
if (chan == -1)
- fprintf(fd, "%s(set! (%s sfile) \'%s)\n", white_space, S_sound_properties, temp = XEN_AS_STRING(property_list));
+ fprintf(fd, "%s(set! (%s sfile) \'%s)\n", white_space, S_sound_properties, temp = Xen_object_to_C_string(property_list));
else
{
if (edpos == -1)
- fprintf(fd, "%s(set! (%s sfile %d) \'%s)\n", white_space, S_channel_properties, chan, temp = XEN_AS_STRING(property_list));
- else fprintf(fd, "%s(set! (%s sfile %d %d) \'%s)\n", white_space, S_edit_properties, chan, edpos, temp = XEN_AS_STRING(property_list));
+ fprintf(fd, "%s(set! (%s sfile %d) \'%s)\n", white_space, S_channel_properties, chan, temp = Xen_object_to_C_string(property_list));
+ else fprintf(fd, "%s(set! (%s sfile %d %d) \'%s)\n", white_space, S_edit_properties, chan, edpos, temp = Xen_object_to_C_string(property_list));
}
if (temp) free(temp);
}
else
{
- XEN new_properties = XEN_EMPTY_LIST;
+ Xen new_properties = Xen_empty_list;
int i, property_len, gc_loc;
gc_loc = snd_protect(new_properties);
- property_len = XEN_LIST_LENGTH(property_list);
+ property_len = Xen_list_length(property_list);
for (i = 0; i < property_len; i++)
{
- XEN property;
- property = XEN_LIST_REF(property_list, i);
- if (XEN_FALSE_P(XEN_MEMBER(XEN_CAR(property), ignore_list)))
- new_properties = XEN_CONS(property, new_properties);
+ Xen property;
+ property = Xen_list_ref(property_list, i);
+ if (Xen_is_false(Xen_member(Xen_car(property), ignore_list)))
+ new_properties = Xen_cons(property, new_properties);
}
- if (!(XEN_NULL_P(new_properties)))
+ if (!(Xen_is_null(new_properties)))
{
char *temp = NULL;
if (chan == -1)
- fprintf(fd, "%s(set! (%s sfile) \'%s)\n", white_space, S_sound_properties, temp = XEN_AS_STRING(new_properties));
+ fprintf(fd, "%s(set! (%s sfile) \'%s)\n", white_space, S_sound_properties, temp = Xen_object_to_C_string(new_properties));
else
{
if (edpos == -1)
- fprintf(fd, "%s(set! (%s sfile %d) \'%s)\n", white_space, S_channel_properties, chan, temp = XEN_AS_STRING(new_properties));
- else fprintf(fd, "%s(set! (%s sfile %d %d) \'%s)\n", white_space, S_edit_properties, chan, edpos, temp = XEN_AS_STRING(new_properties));
+ fprintf(fd, "%s(set! (%s sfile %d) \'%s)\n", white_space, S_channel_properties, chan, temp = Xen_object_to_C_string(new_properties));
+ else fprintf(fd, "%s(set! (%s sfile %d %d) \'%s)\n", white_space, S_edit_properties, chan, edpos, temp = Xen_object_to_C_string(new_properties));
}
if (temp) free(temp);
}
@@ -771,58 +749,58 @@ static void save_property_list(FILE *fd, XEN property_list, int chan, int edpos)
/* restore the various print lengths */
set_print_length(old_print_length);
mus_vct_set_print_length(old_vct_print_length);
- s7_set_vector_print_length(s7, old_s7_print_length);
+ s7_set_print_length(s7, old_s7_print_length);
}
#endif
#if HAVE_RUBY
-static void save_property_list(FILE *fd, XEN property_list, int chan, int edpos)
+static void save_property_list(FILE *fd, Xen property_list, int chan, int edpos)
{
- XEN ignore_list;
- ignore_list = rb_ary_assoc(property_list, C_STRING_TO_XEN_SYMBOL("save_state_ignore"));
- if (!(XEN_VECTOR_P(ignore_list)))
+ Xen ignore_list;
+ ignore_list = rb_ary_assoc(property_list, C_string_to_Xen_symbol("save_state_ignore"));
+ if (!(Xen_is_vector(ignore_list)))
{
if (chan == -1)
- fprintf(fd, "%sset_%s(%s, sfile)\n", white_space, TO_PROC_NAME(S_sound_properties), XEN_AS_STRING(property_list));
+ fprintf(fd, "%sset_%s(%s, sfile)\n", white_space, to_proc_name(S_sound_properties), Xen_object_to_C_string(property_list));
else
{
if (edpos == -1)
- fprintf(fd, "%sset_%s(%s, sfile, %d)\n", white_space, TO_PROC_NAME(S_channel_properties), XEN_AS_STRING(property_list), chan);
- else fprintf(fd, "%sset_%s(%s, sfile, %d, %d)\n", white_space, TO_PROC_NAME(S_edit_properties), XEN_AS_STRING(property_list), chan, edpos);
+ fprintf(fd, "%sset_%s(%s, sfile, %d)\n", white_space, to_proc_name(S_channel_properties), Xen_object_to_C_string(property_list), chan);
+ else fprintf(fd, "%sset_%s(%s, sfile, %d, %d)\n", white_space, to_proc_name(S_edit_properties), Xen_object_to_C_string(property_list), chan, edpos);
}
}
else
{
- XEN ignore_vec, new_properties = XEN_EMPTY_LIST;
+ Xen ignore_vec, new_properties = Xen_empty_list;
int i, property_len, gc_loc;
gc_loc = snd_protect(new_properties);
- property_len = XEN_LIST_LENGTH(property_list);
- ignore_vec = XEN_VECTOR_REF(ignore_list, 1);
- if (XEN_VECTOR_P(ignore_vec))
+ property_len = Xen_list_length(property_list);
+ ignore_vec = Xen_vector_ref(ignore_list, 1);
+ if (Xen_is_vector(ignore_vec))
{
for (i = 0; i < property_len; i++)
{
- XEN property;
- property = XEN_LIST_REF(property_list, i);
- if (XEN_FALSE_P(rb_ary_includes(ignore_vec, XEN_CAR(property))))
- new_properties = XEN_CONS(property, new_properties);
+ Xen property;
+ property = Xen_list_ref(property_list, i);
+ if (Xen_is_false(rb_ary_includes(ignore_vec, Xen_car(property))))
+ new_properties = Xen_cons(property, new_properties);
}
}
else
{
for (i = 0; i < property_len; i++)
- new_properties = XEN_CONS(XEN_LIST_REF(property_list, i), new_properties);
+ new_properties = Xen_cons(Xen_list_ref(property_list, i), new_properties);
}
- if (!(XEN_NULL_P(new_properties)))
+ if (!(Xen_is_null(new_properties)))
{
if (chan == -1)
- fprintf(fd, "%sset_%s(%s, sfile)\n", white_space, TO_PROC_NAME(S_sound_properties), XEN_AS_STRING(new_properties));
+ fprintf(fd, "%sset_%s(%s, sfile)\n", white_space, to_proc_name(S_sound_properties), Xen_object_to_C_string(new_properties));
else
{
if (edpos == -1)
- fprintf(fd, "%sset_%s(%s, sfile, %d)\n", white_space, TO_PROC_NAME(S_channel_properties), XEN_AS_STRING(new_properties), chan);
- else fprintf(fd, "%sset_%s(%s, sfile, %d, %d)\n", white_space, TO_PROC_NAME(S_edit_properties), XEN_AS_STRING(new_properties), chan, edpos);
+ fprintf(fd, "%sset_%s(%s, sfile, %d)\n", white_space, to_proc_name(S_channel_properties), Xen_object_to_C_string(new_properties), chan);
+ else fprintf(fd, "%sset_%s(%s, sfile, %d, %d)\n", white_space, to_proc_name(S_edit_properties), Xen_object_to_C_string(new_properties), chan, edpos);
}
}
snd_unprotect_at(gc_loc);
@@ -832,11 +810,11 @@ static void save_property_list(FILE *fd, XEN property_list, int chan, int edpos)
#if HAVE_FORTH
-static void save_property_list(FILE *fd, XEN property_list, int chan, int edpos)
+static void save_property_list(FILE *fd, Xen property_list, int chan, int edpos)
{
- XEN ignore_list;
- ignore_list = XEN_ASSOC(C_STRING_TO_XEN_SYMBOL("save-state-ignore"), property_list);
- if (!(XEN_LIST_P(ignore_list)))
+ Xen ignore_list;
+ ignore_list = Xen_assoc(C_string_to_Xen_symbol("save-state-ignore"), property_list);
+ if (!(Xen_is_list(ignore_list)))
{
if (chan == -1)
fprintf(fd, "%s%s sfile set-%s drop\n", white_space, fth_to_c_dump(property_list), S_sound_properties);
@@ -849,18 +827,18 @@ static void save_property_list(FILE *fd, XEN property_list, int chan, int edpos)
}
else
{
- XEN new_properties = XEN_EMPTY_LIST;
+ Xen new_properties = Xen_empty_list;
int i, property_len, gc_loc;
gc_loc = snd_protect(new_properties);
- property_len = XEN_LIST_LENGTH(property_list);
+ property_len = Xen_list_length(property_list);
for (i = 0; i < property_len; i++)
{
- XEN property;
- property = XEN_LIST_REF(property_list, i);
- if (XEN_FALSE_P(XEN_MEMBER(XEN_CAR(property), ignore_list)))
- new_properties = XEN_CONS(property, new_properties);
+ Xen property;
+ property = Xen_list_ref(property_list, i);
+ if (Xen_is_false(Xen_member(Xen_car(property), ignore_list)))
+ new_properties = Xen_cons(property, new_properties);
}
- if (!(XEN_NULL_P(new_properties)))
+ if (!(Xen_is_null(new_properties)))
{
if (chan == -1)
fprintf(fd, "%s%s sfile set-%s drop\n", white_space, fth_to_c_dump(new_properties), S_sound_properties);
@@ -878,7 +856,7 @@ static void save_property_list(FILE *fd, XEN property_list, int chan, int edpos)
#if (!HAVE_EXTENSION_LANGUAGE)
-static void save_property_list(FILE *fd, XEN property_list, int chan, int edpos) {}
+static void save_property_list(FILE *fd, Xen property_list, int chan, int edpos) {}
#endif
@@ -891,7 +869,7 @@ static void check_selection(FILE *fd, chan_info *cp)
end = selection_end(cp);
pcp_ss(fd, S_selection_member, b2s(true), cp->chan);
pcp_sod(fd, S_selection_position, beg, cp->chan);
- pcp_sod(fd, S_selection_frames, end - beg + 1, cp->chan);
+ pcp_sod(fd, S_selection_framples, end - beg + 1, cp->chan);
}
}
@@ -919,10 +897,10 @@ void open_save_sound_block(snd_info *sp, FILE *fd, bool with_nth)
*/
#if HAVE_RUBY
fprintf(fd, "begin\n sfile = %s(\"%s\", %d)\n if (sfile == false)\n sfile = %s(\"%s\")\n end\n",
- TO_PROC_NAME(S_find_sound),
+ to_proc_name(S_find_sound),
sp->short_filename,
(with_nth) ? find_sound_nth(sp) : 0,
- TO_PROC_NAME((sp->user_read_only == FILE_READ_ONLY) ? S_view_sound : S_open_sound),
+ to_proc_name((sp->user_read_only == FILE_READ_ONLY) ? S_view_sound : S_open_sound),
sp->filename);
#endif
@@ -961,7 +939,7 @@ void close_save_sound_block(FILE *fd, bool need_f)
}
-static bool default_envelope_p(env *e)
+static bool is_default_envelope(env *e)
{
return((e) &&
(e->pts == 2) &&
@@ -979,19 +957,17 @@ void save_sound_state(snd_info *sp, void *ptr)
int chan;
FILE *fd;
chan_info *cp;
- axis_info *ap;
- char *tmpstr = NULL;
fd = (FILE *)ptr;
open_save_sound_block(sp, fd, true);
b_ok = false;
if (sp->sync != DEFAULT_SYNC) psp_sd(fd, S_sync, sp->sync);
- if (sp->contrast_control_p != DEFAULT_CONTRAST_CONTROL_P) psp_ss(fd, S_contrast_control_p, b2s(sp->contrast_control_p));
+ if (sp->contrast_control_on != DEFAULT_CONTRAST_CONTROL_ON) psp_ss(fd, S_contrast_control_on, b2s(sp->contrast_control_on));
if (fneq(sp->contrast_control, DEFAULT_CONTRAST_CONTROL)) psp_sf(fd, S_contrast_control, sp->contrast_control);
if ((fneq(sp->contrast_control_min, DEFAULT_CONTRAST_CONTROL_MIN)) ||
(fneq(sp->contrast_control_max, DEFAULT_CONTRAST_CONTROL_MAX)))
psp_sl(fd, S_contrast_control_bounds, sp->contrast_control_min, sp->contrast_control_max);
if (fneq(sp->contrast_control_amp, DEFAULT_CONTRAST_CONTROL_AMP)) psp_sf(fd, S_contrast_control_amp, sp->contrast_control_amp);
- if (sp->expand_control_p != DEFAULT_EXPAND_CONTROL_P) psp_ss(fd, S_expand_control_p, b2s(sp->expand_control_p));
+ if (sp->expand_control_on != DEFAULT_EXPAND_CONTROL_ON) psp_ss(fd, S_expand_control_on, b2s(sp->expand_control_on));
if (fneq(sp->expand_control, DEFAULT_EXPAND_CONTROL)) psp_sf(fd, S_expand_control, sp->expand_control);
if ((fneq(sp->expand_control_min, DEFAULT_EXPAND_CONTROL_MIN)) ||
(fneq(sp->expand_control_max, DEFAULT_EXPAND_CONTROL_MAX)))
@@ -1021,7 +997,7 @@ void save_sound_state(snd_info *sp, void *ptr)
if ((fneq(sp->speed_control_min, DEFAULT_SPEED_CONTROL_MIN)) ||
(fneq(sp->speed_control_max, DEFAULT_SPEED_CONTROL_MAX)))
psp_sl(fd, S_speed_control_bounds, sp->speed_control_min, sp->speed_control_max);
- if (sp->reverb_control_p != DEFAULT_REVERB_CONTROL_P) psp_ss(fd, S_reverb_control_p, b2s(sp->reverb_control_p));
+ if (sp->reverb_control_on != DEFAULT_REVERB_CONTROL_ON) psp_ss(fd, S_reverb_control_on, b2s(sp->reverb_control_on));
if (fneq(sp->reverb_control_scale, DEFAULT_REVERB_CONTROL_SCALE)) psp_sf(fd, S_reverb_control_scale, sp->reverb_control_scale);
if ((fneq(sp->reverb_control_scale_min, DEFAULT_REVERB_CONTROL_SCALE_MIN)) ||
(fneq(sp->reverb_control_scale_max, DEFAULT_REVERB_CONTROL_SCALE_MAX)))
@@ -1037,36 +1013,39 @@ void save_sound_state(snd_info *sp, void *ptr)
if ((fneq(sp->amp_control_min, DEFAULT_AMP_CONTROL_MIN)) ||
(fneq(sp->amp_control_max, DEFAULT_AMP_CONTROL_MAX)))
psp_sl(fd, S_amp_control_bounds, sp->amp_control_min, sp->amp_control_max);
- if (sp->filter_control_p != DEFAULT_FILTER_CONTROL_P) psp_ss(fd, S_filter_control_p, b2s(sp->filter_control_p));
+ if (sp->filter_control_on != DEFAULT_FILTER_CONTROL_ON) psp_ss(fd, S_filter_control_on, b2s(sp->filter_control_on));
if (sp->filter_control_order != DEFAULT_FILTER_CONTROL_ORDER) psp_sd(fd, S_filter_control_order, sp->filter_control_order);
if (sp->filter_control_in_dB != DEFAULT_FILTER_CONTROL_IN_DB) psp_ss(fd, S_filter_control_in_dB, b2s(sp->filter_control_in_dB));
if (sp->filter_control_in_hz != DEFAULT_FILTER_CONTROL_IN_HZ) psp_ss(fd, S_filter_control_in_hz, b2s(sp->filter_control_in_hz));
- if ((sp->filter_control_envelope) && (!(default_envelope_p(sp->filter_control_envelope))))
+ if ((sp->filter_control_envelope) && (!(is_default_envelope(sp->filter_control_envelope))))
{
+ char *tmpstr = NULL;
psp_ss(fd, S_filter_control_envelope, tmpstr = env_to_string(sp->filter_control_envelope));
if (tmpstr) free(tmpstr);
}
- if ((XEN_VECTOR_P(sp->properties)) &&
- (XEN_LIST_P(XEN_VECTOR_REF(sp->properties, 0))) &&
- (!(XEN_NULL_P(XEN_VECTOR_REF(sp->properties, 0)))))
+ if ((Xen_is_vector(sp->properties)) &&
+ (Xen_is_list(Xen_vector_ref(sp->properties, 0))) &&
+ (!(Xen_is_null(Xen_vector_ref(sp->properties, 0)))))
{
- save_property_list(fd, XEN_VECTOR_REF(sp->properties, 0), -1, -1); /* sound-properties */
+ save_property_list(fd, Xen_vector_ref(sp->properties, 0), -1, -1); /* sound-properties */
}
for (chan = 0; chan < sp->nchans; chan++)
{
+ axis_info *ap;
+
cp = sp->chans[chan];
if ((!cp) || (!cp->edits) || (!cp->sounds)) break;
ap = cp->axis;
- if (!(cp->graph_time_p)) pcp_ss(fd, S_time_graph_p, b2s(cp->graph_time_p), chan);
- if (cp->graph_transform_p) pcp_ss(fd, S_transform_graph_p, b2s(cp->graph_transform_p), chan);
- if (cp->graph_lisp_p) pcp_ss(fd, S_lisp_graph_p, b2s(cp->graph_lisp_p), chan);
+ if (!(cp->graph_time_on)) pcp_ss(fd, S_time_graph_on, b2s(cp->graph_time_on), chan);
+ if (cp->graph_transform_on) pcp_ss(fd, S_transform_graph_on, b2s(cp->graph_transform_on), chan);
+ if (cp->graph_lisp_on) pcp_ss(fd, S_lisp_graph_on, b2s(cp->graph_lisp_on), chan);
if (ap)
{
if (((ap->x0 != 0.0) || (ap->x1 != 0.1)) && (ap->x1 > .0005)) pcp_sl(fd, S_x_bounds, ap->x0, ap->x1, chan);
if ((ap->y0 != -1.0) || (ap->y1 != 1.0)) pcp_sl(fd, S_y_bounds, ap->y0, ap->y1, chan);
}
- if (CURSOR(cp) != 0) pcp_sod(fd, S_cursor, CURSOR(cp), chan);
+ if (cursor_sample(cp) != 0) pcp_sod(fd, S_cursor, cursor_sample(cp), chan);
if (cp->cursor_size != DEFAULT_CURSOR_SIZE) pcp_sd(fd, S_cursor_size, cp->cursor_size, chan);
if (cp->cursor_style != DEFAULT_CURSOR_STYLE) pcp_ss(fd, S_cursor_style, cursor_style_name(cp->cursor_style), chan);
if (cp->tracking_cursor_style != DEFAULT_TRACKING_CURSOR_STYLE) pcp_ss(fd, S_tracking_cursor_style, cursor_style_name(cp->tracking_cursor_style), chan);
@@ -1081,7 +1060,7 @@ void save_sound_state(snd_info *sp, void *ptr)
if (cp->fft_log_frequency != fft_log_frequency(ss)) pcp_ss(fd, S_fft_log_frequency, b2s(cp->fft_log_frequency), chan);
if (cp->fft_log_magnitude != fft_log_magnitude(ss)) pcp_ss(fd, S_fft_log_magnitude, b2s(cp->fft_log_magnitude), chan);
if (cp->fft_with_phases != fft_with_phases(ss)) pcp_ss(fd, S_fft_with_phases, b2s(cp->fft_with_phases), chan);
- if (cp->verbose_cursor != verbose_cursor(ss)) pcp_ss(fd, S_with_verbose_cursor, b2s(cp->verbose_cursor), chan);
+ if (cp->with_verbose_cursor != with_verbose_cursor(ss)) pcp_ss(fd, S_with_verbose_cursor, b2s(cp->with_verbose_cursor), chan);
if (cp->zero_pad != zero_pad(ss)) pcp_sd(fd, S_zero_pad, cp->zero_pad, chan);
if (cp->wavelet_type != wavelet_type(ss)) pcp_sd(fd, S_wavelet_type, cp->wavelet_type, chan);
if (fneq(cp->min_dB, min_dB(ss))) pcp_sf(fd, S_min_dB, cp->min_dB, chan);
@@ -1116,11 +1095,11 @@ void save_sound_state(snd_info *sp, void *ptr)
if (cp->beats_per_measure != beats_per_measure(ss)) pcp_sd(fd, S_beats_per_measure, cp->beats_per_measure, chan);
if (cp->show_axes != show_axes(ss)) pcp_ss(fd, S_show_axes, show_axes2string(cp->show_axes), chan);
if (cp->graphs_horizontal != graphs_horizontal(ss)) pcp_ss(fd, S_graphs_horizontal, b2s(cp->graphs_horizontal), chan);
- if ((XEN_VECTOR_P(cp->properties)) &&
- (XEN_LIST_P(XEN_VECTOR_REF(cp->properties, 0))) &&
- (!(XEN_NULL_P(XEN_VECTOR_REF(cp->properties, 0)))))
+ if ((Xen_is_vector(cp->properties)) &&
+ (Xen_is_list(Xen_vector_ref(cp->properties, 0))) &&
+ (!(Xen_is_null(Xen_vector_ref(cp->properties, 0)))))
{
- save_property_list(fd, XEN_VECTOR_REF(cp->properties, 0), chan, -1); /* channel-properties */
+ save_property_list(fd, Xen_vector_ref(cp->properties, 0), chan, -1); /* channel-properties */
}
/* ap->default_xlabel if not null, user explicitly set it */
@@ -1145,11 +1124,11 @@ void save_sound_state(snd_info *sp, void *ptr)
{
ed_list *ed;
ed = cp->edits[i];
- if ((XEN_VECTOR_P(ed->properties)) &&
- (XEN_LIST_P(XEN_VECTOR_REF(ed->properties, 0))) &&
- (!(XEN_NULL_P(XEN_VECTOR_REF(ed->properties, 0)))))
+ if ((Xen_is_vector(ed->properties)) &&
+ (Xen_is_list(Xen_vector_ref(ed->properties, 0))) &&
+ (!(Xen_is_null(Xen_vector_ref(ed->properties, 0)))))
{
- save_property_list(fd, XEN_VECTOR_REF(ed->properties, 0), chan, i); /* edit-properties */
+ save_property_list(fd, Xen_vector_ref(ed->properties, 0), chan, i); /* edit-properties */
}
}
}
@@ -1176,13 +1155,13 @@ void save_sound_state(snd_info *sp, void *ptr)
}
-static XEN after_save_state_hook;
-static XEN before_save_state_hook;
+static Xen after_save_state_hook;
+static Xen before_save_state_hook;
void save_state(const char *save_state_name)
{
FILE *save_fd;
- char *locale = NULL, *fullname;
+ char *fullname;
bool append_new_state = false;
if (!save_state_name)
{
@@ -1190,13 +1169,13 @@ void save_state(const char *save_state_name)
return;
}
fullname = mus_expand_filename(save_state_name);
- if (XEN_HOOKED(before_save_state_hook))
+ if (Xen_hook_has_list(before_save_state_hook))
{
- XEN res = XEN_FALSE;
+ Xen res;
res = run_or_hook(before_save_state_hook,
- XEN_LIST_1(C_TO_XEN_STRING(fullname)),
+ Xen_list_1(C_string_to_Xen_string(fullname)),
S_before_save_state_hook);
- append_new_state = XEN_TO_C_BOOLEAN(res);
+ append_new_state = Xen_boolean_to_C_bool(res);
}
if (append_new_state)
save_fd = FOPEN(fullname, "a");
@@ -1208,9 +1187,6 @@ void save_state(const char *save_state_name)
return;
}
-#if HAVE_SETLOCALE
- locale = mus_strdup(setlocale(LC_NUMERIC, "C")); /* must use decimal point in floats since Scheme assumes that format */
-#endif
save_options(save_fd); /* options = user-settable global state variables */
/* the global settings need to precede possible local settings */
@@ -1256,22 +1232,21 @@ void save_state(const char *save_state_name)
}
}
fprintf(save_fd, "\n");
- save_macro_state(save_fd); /* current unsaved keyboard macros (snd-chn.c) */
save_envelope_editor_state(save_fd); /* current envelope editor window state */
save_regions(save_fd); /* regions */
- if (transform_dialog_is_active()) fprintf(save_fd, BPAREN "%s" EPAREN "\n", TO_PROC_NAME(S_transform_dialog));
- if (enved_dialog_is_active()) fprintf(save_fd, BPAREN "%s" EPAREN "\n", TO_PROC_NAME(S_enved_dialog));
- if (color_orientation_dialog_is_active()) fprintf(save_fd, BPAREN "%s" EPAREN "\n", TO_PROC_NAME(S_color_orientation_dialog));
- if (region_dialog_is_active()) fprintf(save_fd, BPAREN "%s" EPAREN "\n", TO_PROC_NAME(S_view_regions_dialog));
+ if (transform_dialog_is_active()) fprintf(save_fd, BPAREN "%s" EPAREN "\n", to_proc_name(S_transform_dialog));
+ if (enved_dialog_is_active()) fprintf(save_fd, BPAREN "%s" EPAREN "\n", to_proc_name(S_enved_dialog));
+ if (color_orientation_dialog_is_active()) fprintf(save_fd, BPAREN "%s" EPAREN "\n", to_proc_name(S_color_orientation_dialog));
+ if (region_dialog_is_active()) fprintf(save_fd, BPAREN "%s" EPAREN "\n", to_proc_name(S_view_regions_dialog));
save_post_it_dialog_state(save_fd);
save_find_dialog_state(save_fd);
save_edit_header_dialog_state(save_fd);
#if USE_MOTIF
save_print_dialog_state(save_fd);
+ save_view_files_dialogs(save_fd);
#endif
save_file_dialog_state(save_fd);
- save_view_files_dialogs(save_fd);
/* saving mix/track state is problematic. For example, if we make a selection, mix it,
* then make another selection and mix it, we get an edit list:
@@ -1280,7 +1255,7 @@ void save_state(const char *save_state_name)
* (change-samples-with-origin 1655 480 "set! -mix-1 (mix-selection 1655)" "/home/bil/zap/snd/snd_3309_10.snd" sfile 0 #f (list 1145009982 1964))
* (set! (selection-member? sfile 0) #t)
* (set! (selection-position sfile 0) 816)
- * (set! (selection-frames sfile 0) 480)
+ * (set! (selection-framples sfile 0) 480)
*
* which won't even work for the current selection case! If we mix some piece of a sound
* being edited in another window, we'd need to keep all edits in sync during the restore!
@@ -1303,24 +1278,17 @@ void save_state(const char *save_state_name)
/* the problem here (with saving hooks) is that it is not straightforward to save the function source
* (with the current print-set! source option, or with an earlier procedure->string function using
- * procedure_environment etc); many types print in this case in ways that are not readable.
+ * funclet etc); many types print in this case in ways that are not readable.
* The functions may depend on globals that are not in loaded files, or that were changed since
* loading, and trying to map over the current module's obarray, saving each such variable in
* its current form, is a major undertaking (although this can be done for simple vars); additionally,
* what if the user has changed these before restoring -- should the old forms be restored?
*/
- if (locale)
- {
-#if HAVE_SETLOCALE
- setlocale(LC_NUMERIC, locale);
-#endif
- free(locale);
- }
snd_fclose(save_fd, save_state_name);
- if (XEN_HOOKED(after_save_state_hook))
+ if (Xen_hook_has_list(after_save_state_hook))
run_hook(after_save_state_hook,
- XEN_LIST_1(C_TO_XEN_STRING(save_state_name)),
+ Xen_list_1(C_string_to_Xen_string(save_state_name)),
S_after_save_state_hook);
}
@@ -1371,44 +1339,45 @@ static char *file_extension(char *arg)
#endif
-static XEN start_hook;
+#if (!DISABLE_DEPRECATED)
+static Xen start_hook;
static bool dont_start(char *filename)
{
- XEN res = XEN_FALSE;
- if (XEN_HOOKED(start_hook))
+ Xen res = Xen_false;
+ if (Xen_hook_has_list(start_hook))
res = run_or_hook(start_hook,
- XEN_LIST_1(C_TO_XEN_STRING(filename)),
+ Xen_list_1(C_string_to_Xen_string(filename)),
S_start_hook);
- return(XEN_TRUE_P(res));
+ return(Xen_is_true(res));
}
-
+#endif
static char *startup_filename = NULL;
static int script_arg = 0, script_argn = 0;
static char **script_args;
-static XEN g_script_arg(void)
+static Xen g_script_arg(void)
{
#define H_script_arg "(" S_script_arg "): where we are in the startup arg list"
- return(C_TO_XEN_INT(script_arg));
+ return(C_int_to_Xen_integer(script_arg));
}
-static XEN g_set_script_arg(XEN arg)
+static Xen g_set_script_arg(Xen arg)
{
- script_arg = XEN_TO_C_INT(arg);
+ script_arg = Xen_integer_to_C_int(arg);
return(arg);
}
-static XEN g_script_args(void)
+static Xen g_script_args(void)
{
#define H_script_args "(" S_script_args "): the args passed to Snd at startup as a list of strings"
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
int i;
for (i = script_argn - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(script_args[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(script_args[i]), lst);
return(lst);
}
@@ -1425,29 +1394,31 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
argname = auto_open_file_names[auto_open_ctr];
if (argname)
{ /* wanted to use "-d" and "-i" but they're in use */
- if ((strcmp("-h", argname) == 0) ||
- (strcmp("-horizontal", argname) == 0) ||
- (strcmp("--horizontal", argname) == 0) ||
- (strcmp("-v", argname) == 0) ||
- (strcmp("-vertical", argname) == 0) ||
- (strcmp("--vertical", argname) == 0) ||
- (strcmp("-notebook", argname) == 0) ||
- (strcmp("--notebook", argname) == 0) ||
- (strcmp("-separate", argname) == 0) ||
- (strcmp("--separate", argname) == 0) ||
- (strcmp("-nostdin", argname) == 0) ||
- (strcmp("-noglob", argname) == 0) ||
- (strcmp("-noinit", argname) == 0))
+ if ((mus_strcmp("-h", argname)) ||
+ (mus_strcmp("-horizontal", argname)) ||
+ (mus_strcmp("--horizontal", argname)) ||
+ (mus_strcmp("-v", argname)) ||
+ (mus_strcmp("-vertical", argname)) ||
+ (mus_strcmp("--vertical", argname)) ||
+ (mus_strcmp("-notebook", argname)) ||
+ (mus_strcmp("--notebook", argname)) ||
+ (mus_strcmp("-separate", argname)) ||
+ (mus_strcmp("--separate", argname)) ||
+ (mus_strcmp("-nostdin", argname)) ||
+ (mus_strcmp("-noglob", argname)) ||
+ (mus_strcmp("-noinit", argname)) ||
+ (mus_strcmp("--noinit", argname)))
return(auto_open_ctr + 1);
else
{
- if (strcmp("-init", argname) == 0)
+ if (mus_strcmp("-init", argname))
return(auto_open_ctr + 2);
else
{
- if ((strcmp("-p", argname) == 0) ||
- (strcmp("-preload", argname) == 0) ||
- (strcmp("--preload", argname) == 0))
+#if (!USE_NO_GUI)
+ if ((mus_strcmp("-p", argname)) ||
+ (mus_strcmp("-preload", argname)) ||
+ (mus_strcmp("--preload", argname)))
{
/* preload sound files in dir (can be ., should be unquoted) */
auto_open_ctr++;
@@ -1457,21 +1428,22 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
else view_files_add_directory(NULL_WIDGET, auto_open_file_names[auto_open_ctr]);
}
else
+#endif
{
- if ((strcmp("-l", argname) == 0) ||
- (strcmp("-load", argname) == 0) ||
- (strcmp("--load", argname) == 0) ||
- (strcmp("-b", argname) == 0) ||
- (strcmp("-batch", argname) == 0) ||
- (strcmp("--batch", argname) == 0) ||
- (source_file_p(argname)))
+ if ((mus_strcmp("-l", argname)) ||
+ (mus_strcmp("-load", argname)) ||
+ (mus_strcmp("--load", argname)) ||
+ (mus_strcmp("-b", argname)) ||
+ (mus_strcmp("-batch", argname)) ||
+ (mus_strcmp("--batch", argname)) ||
+ (is_source_file(argname)))
{
- if ((strcmp("-l", argname) == 0) ||
- (strcmp("-load", argname) == 0) ||
- (strcmp("--load", argname) == 0) ||
- (strcmp("-b", argname) == 0) ||
- (strcmp("-batch", argname) == 0) ||
- (strcmp("--batch", argname) == 0))
+ if ((mus_strcmp("-l", argname)) ||
+ (mus_strcmp("-load", argname)) ||
+ (mus_strcmp("--load", argname)) ||
+ (mus_strcmp("-b", argname)) ||
+ (mus_strcmp("-batch", argname)) ||
+ (mus_strcmp("--batch", argname)))
auto_open_ctr++;
if ((auto_open_ctr >= args) ||
(auto_open_file_names[auto_open_ctr] == NULL))
@@ -1490,9 +1462,9 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
}
else
{
- if ((strcmp("-e", argname) == 0) ||
- (strcmp("-eval", argname) == 0) ||
- (strcmp("--eval", argname) == 0))
+ if ((mus_strcmp("-e", argname)) ||
+ (mus_strcmp("-eval", argname)) ||
+ (mus_strcmp("--eval", argname)))
{
/* evaluate expression */
auto_open_ctr++;
@@ -1511,7 +1483,7 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
else
{
if ((with_title) &&
- (strcmp("-title", argname) == 0))
+ (mus_strcmp("-title", argname)))
{
auto_open_ctr++;
if ((auto_open_ctr >= args) ||
@@ -1521,7 +1493,7 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
}
else
{
- if (strcmp("-I", argname) == 0)
+ if (mus_strcmp("-I", argname))
{
/* added 24-Oct-02: add to load path in either extension language */
auto_open_ctr++;
@@ -1530,7 +1502,7 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
snd_error_without_format("-I but no path?");
else
{
- XEN_ADD_TO_LOAD_PATH(auto_open_file_names[auto_open_ctr]);
+ Xen_add_to_load_path(auto_open_file_names[auto_open_ctr]);
}
}
else
@@ -1538,16 +1510,26 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
if (startup_filename == NULL)
{
startup_filename = mus_strdup(argname);
+#if (!DISABLE_DEPRECATED)
if (dont_start(startup_filename)) snd_exit(1);
+#endif
}
ss->open_requestor = FROM_STARTUP;
if (snd_open_file(argname, FILE_READ_WRITE) == NULL)
{
/* non-existent file at startup */
- fprintf(stdout, "can't open %s\n", argname);
- if (ss->startup_errors)
- ss->startup_errors = mus_format("%s\n%s ;%s\"%s\"\n", ss->startup_errors, listener_prompt(ss), "can't open ", argname);
- else ss->startup_errors = mus_format(";%s\"%s\"\n", "can't open ", argname);
+ if (argname[0] == '-')
+ {
+ /* probably a bad option */
+ fprintf(stdout, "bad option: %s\n", argname);
+ }
+ else
+ {
+ fprintf(stdout, "can't open %s\n", argname);
+ if (ss->startup_errors)
+ ss->startup_errors = mus_format("%s\n%s ;%s\"%s\"\n", ss->startup_errors, listener_prompt(ss), "can't open ", argname);
+ else ss->startup_errors = mus_format(";%s\"%s\"\n", "can't open ", argname);
+ }
}
}
}
@@ -1564,49 +1546,49 @@ int handle_next_startup_arg(int auto_open_ctr, char **auto_open_file_names, bool
static void save_state_error_handler(const char *msg, void *data)
{
char *filename = (char *)data;
- XEN fname;
+ Xen fname;
if (filename)
{
- fname = C_TO_XEN_STRING(filename);
+ fname = C_string_to_Xen_string(filename);
free(filename); /* this is "name" below */
}
- else fname = C_TO_XEN_STRING(save_state_file(ss));
+ else fname = C_string_to_Xen_string(save_state_file(ss));
redirect_snd_error_to(NULL, NULL);
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_save_state ": can't save ~S"),
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_save_state ": can't save ~S"),
fname));
}
-static XEN g_save_state(XEN filename)
+static Xen g_save_state(Xen filename)
{
char *name = NULL;
- XEN res;
+ Xen res;
#define H_save_state "(" S_save_state " :optional filename): save the current Snd state in filename; (load filename) restores it. The \
default " S_save_state " filename is " DEFAULT_SAVE_STATE_FILE ". It can be changed via " S_save_state_file "."
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(filename), filename, XEN_ONLY_ARG, S_save_state, "a string");
+ Xen_check_type(Xen_is_string_or_unbound(filename), filename, 1, S_save_state, "a string");
- if (XEN_BOUND_P(filename))
- name = mus_strdup(XEN_TO_C_STRING(filename));
+ if (Xen_is_bound(filename))
+ name = mus_strdup(Xen_string_to_C_string(filename));
else name = mus_strdup(save_state_file(ss));
redirect_snd_error_to(save_state_error_handler, (void *)name);
save_state(name);
redirect_snd_error_to(NULL, NULL);
- res = C_TO_XEN_STRING(name);
+ res = C_string_to_Xen_string(name);
free(name);
return(res);
}
-static XEN g_exit(XEN val)
+static Xen g_exit(Xen val)
{
#define H_exit "(" S_exit " :optional val): exit Snd"
if (snd_exit_cleanly(EXIT_NOT_FORCED))
- snd_exit(XEN_TO_C_INT_OR_ELSE(val, 1));
- return(XEN_FALSE);
+ snd_exit((Xen_is_integer(val)) ? Xen_integer_to_C_int(val) : 1);
+ return(Xen_false);
}
@@ -1618,13 +1600,13 @@ static int snd_access(const char *dir, const char *caller)
err = mus_file_create(temp);
if (err == -1)
{
- XEN res;
+ Xen res;
free(temp);
temp = mus_format("%s: directory %s is not writable: %s", caller, dir, snd_open_strerror());
- res = C_TO_XEN_STRING(temp);
+ res = C_string_to_Xen_string(temp);
free(temp);
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_1(res));
+ Xen_error(NO_SUCH_FILE, Xen_list_1(res));
+ return(0);
}
else snd_close(err, temp);
snd_remove(temp, IGNORE_CACHE);
@@ -1633,33 +1615,33 @@ static int snd_access(const char *dir, const char *caller)
}
-static XEN g_temp_dir(void) {return(C_TO_XEN_STRING(temp_dir(ss)));}
+static Xen g_temp_dir(void) {return(C_string_to_Xen_string(temp_dir(ss)));}
-static XEN g_set_temp_dir(XEN val)
+static Xen g_set_temp_dir(Xen val)
{
#define H_temp_dir "(" S_temp_dir "): name of directory for temp files (or " PROC_FALSE "=null)"
const char *dir = MUS_DEFAULT_TEMP_DIR;
- XEN_ASSERT_TYPE(XEN_STRING_P(val) || XEN_FALSE_P(val), val, XEN_ONLY_ARG, S_setB S_temp_dir, "a string or " PROC_FALSE "=default (null)");
- if (XEN_STRING_P(val)) dir = XEN_TO_C_STRING(val);
+ Xen_check_type(Xen_is_string(val) || Xen_is_false(val), val, 1, S_set S_temp_dir, "a string or " PROC_FALSE "=default (null)");
+ if (Xen_is_string(val)) dir = Xen_string_to_C_string(val);
if (snd_access(dir, S_temp_dir))
{
if (temp_dir(ss)) free(temp_dir(ss));
set_temp_dir(mus_strdup(dir));
}
- return(C_TO_XEN_STRING(temp_dir(ss)));
+ return(C_string_to_Xen_string(temp_dir(ss)));
}
-static XEN g_peak_env_dir(void) {return(C_TO_XEN_STRING(peak_env_dir(ss)));}
+static Xen g_peak_env_dir(void) {return(C_string_to_Xen_string(peak_env_dir(ss)));}
-static XEN g_set_peak_env_dir(XEN val)
+static Xen g_set_peak_env_dir(Xen val)
{
#define H_peak_env_dir "(" S_peak_env_dir "): name of directory for peak env files (or " PROC_FALSE "=null)"
- const char *dir = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(val) || XEN_FALSE_P(val), val, XEN_ONLY_ARG, S_setB S_peak_env_dir, "a string or " PROC_FALSE "=default (null)");
- if (XEN_STRING_P(val))
+ Xen_check_type(Xen_is_string(val) || Xen_is_false(val), val, 1, S_set S_peak_env_dir, "a string or " PROC_FALSE "=default (null)");
+ if (Xen_is_string(val))
{
- dir = XEN_TO_C_STRING(val);
+ const char *dir = NULL;
+ dir = Xen_string_to_C_string(val);
if (snd_access(dir, S_peak_env_dir))
{
if (peak_env_dir(ss)) free(peak_env_dir(ss));
@@ -1671,69 +1653,69 @@ static XEN g_set_peak_env_dir(XEN val)
if (peak_env_dir(ss)) free(peak_env_dir(ss));
set_peak_env_dir(NULL);
}
- return(C_TO_XEN_STRING(peak_env_dir(ss)));
+ return(C_string_to_Xen_string(peak_env_dir(ss)));
}
-static XEN g_ladspa_dir(void) {return(C_TO_XEN_STRING(ladspa_dir(ss)));}
+static Xen g_ladspa_dir(void) {return(C_string_to_Xen_string(ladspa_dir(ss)));}
-static XEN g_set_ladspa_dir(XEN val)
+static Xen g_set_ladspa_dir(Xen val)
{
#define H_ladspa_dir "(" S_ladspa_dir "): name of directory for ladspa plugin libraries"
- XEN_ASSERT_TYPE(XEN_STRING_P(val) || XEN_FALSE_P(val), val, XEN_ONLY_ARG, S_setB S_ladspa_dir, "a string or " PROC_FALSE "=default (null)");
+ Xen_check_type(Xen_is_string(val) || Xen_is_false(val), val, 1, S_set S_ladspa_dir, "a string or " PROC_FALSE "=default (null)");
if (ladspa_dir(ss)) free(ladspa_dir(ss));
- if (XEN_FALSE_P(val))
+ if (Xen_is_false(val))
set_ladspa_dir(mus_strdup(DEFAULT_LADSPA_DIR));
- else set_ladspa_dir(mus_strdup(XEN_TO_C_STRING(val)));
- return(C_TO_XEN_STRING(ladspa_dir(ss)));
+ else set_ladspa_dir(mus_strdup(Xen_string_to_C_string(val)));
+ return(C_string_to_Xen_string(ladspa_dir(ss)));
}
-static XEN g_save_state_file(void) {return(C_TO_XEN_STRING(save_state_file(ss)));}
+static Xen g_save_state_file(void) {return(C_string_to_Xen_string(save_state_file(ss)));}
-static XEN g_set_save_state_file(XEN val)
+static Xen g_set_save_state_file(Xen val)
{
const char *filename;
- #define H_save_state_file "(" S_save_state_file "): the name of the saved state file (\"saved-snd." XEN_FILE_EXTENSION "\")"
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_save_state_file, "a string");
- filename = XEN_TO_C_STRING(val);
+ #define H_save_state_file "(" S_save_state_file "): the name of the saved state file (\"saved-snd." Xen_file_extension "\")"
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_save_state_file, "a string");
+ filename = Xen_string_to_C_string(val);
if (save_state_file(ss)) free(save_state_file(ss));
in_set_save_state_file(mus_strdup(filename));
- return(C_TO_XEN_STRING(save_state_file(ss)));
+ return(C_string_to_Xen_string(save_state_file(ss)));
}
-static XEN g_save_dir(void) {return(C_TO_XEN_STRING(save_dir(ss)));}
+static Xen g_save_dir(void) {return(C_string_to_Xen_string(save_dir(ss)));}
-static XEN g_set_save_dir(XEN val)
+static Xen g_set_save_dir(Xen val)
{
#define H_save_dir "(" S_save_dir "): name of directory for saved state data (or " PROC_FALSE "=null)"
const char *dir = MUS_DEFAULT_SAVE_DIR;
- XEN_ASSERT_TYPE(XEN_STRING_P(val) || XEN_FALSE_P(val), val, XEN_ONLY_ARG, S_setB S_save_dir, "a string or " PROC_FALSE "=default (null)");
- if (XEN_STRING_P(val)) dir = XEN_TO_C_STRING(val);
+ Xen_check_type(Xen_is_string(val) || Xen_is_false(val), val, 1, S_set S_save_dir, "a string or " PROC_FALSE "=default (null)");
+ if (Xen_is_string(val)) dir = Xen_string_to_C_string(val);
if (snd_access(dir, S_save_dir))
{
if (save_dir(ss)) free(save_dir(ss));
set_save_dir(mus_strdup(dir));
}
- return(C_TO_XEN_STRING(save_dir(ss)));
+ return(C_string_to_Xen_string(save_dir(ss)));
}
-static XEN g_open_file_dialog_directory(void) {return(C_TO_XEN_STRING(open_file_dialog_directory(ss)));}
+static Xen g_open_file_dialog_directory(void) {return(C_string_to_Xen_string(open_file_dialog_directory(ss)));}
-static XEN g_set_open_file_dialog_directory(XEN val)
+static Xen g_set_open_file_dialog_directory(Xen val)
{
#define H_open_file_dialog_directory "(" S_open_file_dialog_directory "): name of directory for initial open file dialog search"
const char *dir;
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_open_file_dialog_directory, "a string");
- dir = XEN_TO_C_STRING(val);
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_open_file_dialog_directory, "a string");
+ dir = Xen_string_to_C_string(val);
if (snd_access(dir, S_open_file_dialog_directory))
{
if (open_file_dialog_directory(ss)) free(open_file_dialog_directory(ss));
set_open_file_dialog_directory(mus_strdup(dir));
}
- return(C_TO_XEN_STRING(open_file_dialog_directory(ss)));
+ return(C_string_to_Xen_string(open_file_dialog_directory(ss)));
}
@@ -1765,18 +1747,18 @@ static int snd_screen_width(void)
}
-static XEN g_window_height(void)
+static Xen g_window_height(void)
{
#define H_window_height "(" S_window_height "): current Snd window height in pixels"
- return(C_TO_XEN_INT(widget_height(MAIN_SHELL(ss))));
+ return(C_int_to_Xen_integer(widget_height(MAIN_SHELL(ss))));
}
-static XEN g_set_window_height(XEN height)
+static Xen g_set_window_height(Xen height)
{
int val;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(height), height, XEN_ONLY_ARG, S_setB S_window_height, "a number");
- val = (int)XEN_TO_C_INT_OR_ELSE(height, 0);
+ Xen_check_type(Xen_is_integer(height), height, 1, S_set S_window_height, "an integer");
+ val = Xen_integer_to_C_int(height);
if ((val > 0) && (val < snd_screen_height()))
{
#if (!USE_NO_GUI)
@@ -1788,18 +1770,18 @@ static XEN g_set_window_height(XEN height)
}
-static XEN g_window_width(void)
+static Xen g_window_width(void)
{
#define H_window_width "(" S_window_width "): current Snd window width in pixels"
- return(C_TO_XEN_INT(widget_width(MAIN_SHELL(ss))));
+ return(C_int_to_Xen_integer(widget_width(MAIN_SHELL(ss))));
}
-static XEN g_set_window_width(XEN width)
+static Xen g_set_window_width(Xen width)
{
int val;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(width), width, XEN_ONLY_ARG, S_setB S_window_width, "a number");
- val = XEN_TO_C_INT_OR_ELSE(width, 0);
+ Xen_check_type(Xen_is_integer(width), width, 1, S_set S_window_width, "an integer");
+ val = Xen_integer_to_C_int(width);
if ((val > 0) && (val < snd_screen_width()))
{
#if (!USE_NO_GUI)
@@ -1811,18 +1793,18 @@ static XEN g_set_window_width(XEN width)
}
-static XEN g_window_x(void)
+static Xen g_window_x(void)
{
#define H_window_x "(" S_window_x "): current Snd window x position in pixels"
- return(C_TO_XEN_INT(widget_x(MAIN_SHELL(ss))));
+ return(C_int_to_Xen_integer(widget_x(MAIN_SHELL(ss))));
}
-static XEN g_set_window_x(XEN val)
+static Xen g_set_window_x(Xen val)
{
int x;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_window_x, "a number");
- x = XEN_TO_C_INT_OR_ELSE(val, 0);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_window_x, "an integer");
+ x = Xen_integer_to_C_int(val);
if ((x >= 0) && (x < snd_screen_width()))
{
set_widget_x(MAIN_SHELL(ss), x);
@@ -1832,18 +1814,18 @@ static XEN g_set_window_x(XEN val)
}
-static XEN g_window_y(void)
+static Xen g_window_y(void)
{
#define H_window_y "(" S_window_y "): current Snd window y position in pixels"
- return(C_TO_XEN_INT(widget_y(MAIN_SHELL(ss))));
+ return(C_int_to_Xen_integer(widget_y(MAIN_SHELL(ss))));
}
-static XEN g_set_window_y(XEN val)
+static Xen g_set_window_y(Xen val)
{
int y;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_window_y, "a number");
- y = XEN_TO_C_INT_OR_ELSE(val, 0);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_window_y, "an integer");
+ y = Xen_integer_to_C_int(val);
if ((y >= 0) && (y < snd_screen_height()))
{
set_widget_y(MAIN_SHELL(ss), y);
@@ -1853,256 +1835,239 @@ static XEN g_set_window_y(XEN val)
}
-static XEN g_just_sounds(void)
+static Xen g_just_sounds(void)
{
#define H_just_sounds "(" S_just_sounds "): the 'just sounds' choice in the file chooser dialog"
- return(C_TO_XEN_BOOLEAN(just_sounds(ss)));
+ return(C_bool_to_Xen_boolean(just_sounds(ss)));
}
-static XEN g_set_just_sounds(XEN on)
+static Xen g_set_just_sounds(Xen on)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_just_sounds, "a boolean");
- set_just_sounds(XEN_TO_C_BOOLEAN(on));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_just_sounds, "a boolean");
+ set_just_sounds(Xen_boolean_to_C_bool(on));
reflect_just_sounds();
- return(C_TO_XEN_BOOLEAN(just_sounds(ss)));
+ return(C_bool_to_Xen_boolean(just_sounds(ss)));
}
-static XEN g_play_arrow_size(void)
+static Xen g_play_arrow_size(void)
{
#define H_play_arrow_size "(" S_play_arrow_size "): the size of the play triangles"
- return(C_TO_XEN_INT(play_arrow_size(ss)));
+ return(C_int_to_Xen_integer(play_arrow_size(ss)));
}
-static XEN g_set_play_arrow_size(XEN size)
+static Xen g_set_play_arrow_size(Xen size)
{
int arrow_size;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(size), size, XEN_ONLY_ARG, S_setB S_play_arrow_size, "an integer");
+ Xen_check_type(Xen_is_integer(size), size, 1, S_set S_play_arrow_size, "an integer");
- arrow_size = XEN_TO_C_INT(size);
+ arrow_size = Xen_integer_to_C_int(size);
if (arrow_size >= 0)
set_play_arrow_size(arrow_size);
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_play_arrow_size, XEN_ONLY_ARG, size, "must be >= 0");
+ else Xen_out_of_range_error(S_set S_play_arrow_size, 1, size, "must be >= 0");
for_each_chan(update_graph);
return(size);
}
-static XEN g_with_inset_graph(void)
+static Xen g_with_inset_graph(void)
{
#define H_with_inset_graph "(" S_with_inset_graph "): if " PROC_TRUE " (default is " PROC_FALSE "), display the inset graph in the time domain section."
- return(C_TO_XEN_BOOLEAN(with_inset_graph(ss)));
+ return(C_bool_to_Xen_boolean(with_inset_graph(ss)));
}
-static XEN g_set_with_inset_graph(XEN on)
+static Xen g_set_with_inset_graph(Xen on)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_with_inset_graph, "a boolean");
- set_with_inset_graph(XEN_TO_C_BOOLEAN(on));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_with_inset_graph, "a boolean");
+ set_with_inset_graph(Xen_boolean_to_C_bool(on));
for_each_chan(update_graph);
- return(C_TO_XEN_BOOLEAN(with_inset_graph(ss)));
+ return(C_bool_to_Xen_boolean(with_inset_graph(ss)));
+}
+
+
+static Xen g_with_interrupts(void)
+{
+ #define H_with_interrupts "(" S_with_interrupts "): if " PROC_TRUE ", check for GUI events during computations."
+ return(C_bool_to_Xen_boolean(with_interrupts(ss)));
}
-static XEN g_with_smpte_label(void)
+static Xen g_set_with_interrupts(Xen on)
+{
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_with_interrupts, "a boolean");
+ set_with_interrupts(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(with_interrupts(ss)));
+}
+
+
+static Xen g_with_smpte_label(void)
{
#define H_with_smpte_label "(" S_with_smpte_label "): if " PROC_TRUE " (default is " PROC_FALSE "), display the SMPTE data in the time domain section."
- return(C_TO_XEN_BOOLEAN(with_smpte_label(ss)));
+ return(C_bool_to_Xen_boolean(with_smpte_label(ss)));
}
-static XEN g_set_with_smpte_label(XEN on)
+static Xen g_set_with_smpte_label(Xen on)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_with_smpte_label, "a boolean");
- set_with_smpte_label(XEN_TO_C_BOOLEAN(on));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_with_smpte_label, "a boolean");
+ set_with_smpte_label(Xen_boolean_to_C_bool(on));
for_each_chan(update_graph);
- return(C_TO_XEN_BOOLEAN(with_smpte_label(ss)));
+ return(C_bool_to_Xen_boolean(with_smpte_label(ss)));
}
-static XEN g_with_pointer_focus(void)
+static Xen g_with_pointer_focus(void)
{
#define H_with_pointer_focus "(" S_with_pointer_focus "): if " PROC_TRUE " (default is " PROC_FALSE "), activate the text or graph widget beneath the mouse."
- return(C_TO_XEN_BOOLEAN(with_pointer_focus(ss)));
+ return(C_bool_to_Xen_boolean(with_pointer_focus(ss)));
}
-static XEN g_set_with_pointer_focus(XEN on)
+static Xen g_set_with_pointer_focus(Xen on)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_with_pointer_focus, "a boolean");
- set_with_pointer_focus(XEN_TO_C_BOOLEAN(on));
- return(C_TO_XEN_BOOLEAN(with_pointer_focus(ss)));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_with_pointer_focus, "a boolean");
+ set_with_pointer_focus(Xen_boolean_to_C_bool(on));
+ return(C_bool_to_Xen_boolean(with_pointer_focus(ss)));
}
-static XEN g_tiny_font(void) {return(C_TO_XEN_STRING(tiny_font(ss)));}
+static Xen g_tiny_font(void) {return(C_string_to_Xen_string(tiny_font(ss)));}
-static XEN g_set_tiny_font(XEN val)
+static Xen g_set_tiny_font(Xen val)
{
#define H_tiny_font "(" S_tiny_font "): font use for some info in the graphs"
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_tiny_font, "a string");
- set_tiny_font(XEN_TO_C_STRING(val));
- return(C_TO_XEN_STRING(tiny_font(ss)));
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_tiny_font, "a string");
+ set_tiny_font(Xen_string_to_C_string(val));
+ return(C_string_to_Xen_string(tiny_font(ss)));
}
-static XEN g_axis_label_font(void) {return(C_TO_XEN_STRING(axis_label_font(ss)));}
+static Xen g_axis_label_font(void) {return(C_string_to_Xen_string(axis_label_font(ss)));}
-static XEN g_set_axis_label_font(XEN val)
+static Xen g_set_axis_label_font(Xen val)
{
#define H_axis_label_font "(" S_axis_label_font "): font used for axis labels"
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_axis_label_font, "a string");
- set_axis_label_font(XEN_TO_C_STRING(val));
- return(C_TO_XEN_STRING(axis_label_font(ss)));
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_axis_label_font, "a string");
+ set_axis_label_font(Xen_string_to_C_string(val));
+ return(C_string_to_Xen_string(axis_label_font(ss)));
}
-static XEN g_axis_numbers_font(void) {return(C_TO_XEN_STRING(axis_numbers_font(ss)));}
+static Xen g_axis_numbers_font(void) {return(C_string_to_Xen_string(axis_numbers_font(ss)));}
-static XEN g_set_axis_numbers_font(XEN val)
+static Xen g_set_axis_numbers_font(Xen val)
{
#define H_axis_numbers_font "(" S_axis_numbers_font "): font used for axis numbers"
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_axis_numbers_font, "a string");
- set_axis_numbers_font(XEN_TO_C_STRING(val));
- return(C_TO_XEN_STRING(axis_numbers_font(ss)));
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_axis_numbers_font, "a string");
+ set_axis_numbers_font(Xen_string_to_C_string(val));
+ return(C_string_to_Xen_string(axis_numbers_font(ss)));
}
-static XEN g_listener_font(void) {return(C_TO_XEN_STRING(listener_font(ss)));}
+static Xen g_listener_font(void) {return(C_string_to_Xen_string(listener_font(ss)));}
-static XEN g_set_listener_font(XEN val)
+static Xen g_set_listener_font(Xen val)
{
#define H_listener_font "(" S_listener_font "): font used by the lisp listener"
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_listener_font, "a string");
- set_listener_font(XEN_TO_C_STRING(val));
- return(C_TO_XEN_STRING(listener_font(ss)));
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_listener_font, "a string");
+ set_listener_font(Xen_string_to_C_string(val));
+ return(C_string_to_Xen_string(listener_font(ss)));
}
-static XEN g_bold_peaks_font(void) {return(C_TO_XEN_STRING(bold_peaks_font(ss)));}
+static Xen g_bold_peaks_font(void) {return(C_string_to_Xen_string(bold_peaks_font(ss)));}
-static XEN g_set_bold_peaks_font(XEN val)
+static Xen g_set_bold_peaks_font(Xen val)
{
#define H_bold_peaks_font "(" S_bold_peaks_font "): bold font used by fft peak display"
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_bold_peaks_font, "a string");
- set_bold_peaks_font(XEN_TO_C_STRING(val));
- return(C_TO_XEN_STRING(bold_peaks_font(ss)));
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_bold_peaks_font, "a string");
+ set_bold_peaks_font(Xen_string_to_C_string(val));
+ return(C_string_to_Xen_string(bold_peaks_font(ss)));
}
-static XEN g_peaks_font(void) {return(C_TO_XEN_STRING(peaks_font(ss)));}
+static Xen g_peaks_font(void) {return(C_string_to_Xen_string(peaks_font(ss)));}
-static XEN g_set_peaks_font(XEN val)
+static Xen g_set_peaks_font(Xen val)
{
#define H_peaks_font "(" S_peaks_font "): normal font used by fft peak display"
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_peaks_font, "a string");
- set_peaks_font(XEN_TO_C_STRING(val));
- return(C_TO_XEN_STRING(peaks_font(ss)));
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_peaks_font, "a string");
+ set_peaks_font(Xen_string_to_C_string(val));
+ return(C_string_to_Xen_string(peaks_font(ss)));
}
-static XEN g_audio_output_device(void) {return(C_TO_XEN_INT(audio_output_device(ss)));}
+static Xen g_auto_resize(void) {return(C_bool_to_Xen_boolean(auto_resize(ss)));}
-static XEN g_set_audio_output_device(XEN val)
-{
- #define H_audio_output_device "(" S_audio_output_device "): the current sndlib default output device (" S_mus_audio_default ")"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_audio_output_device, "an integer");
- set_audio_output_device(XEN_TO_C_INT(val));
- return(C_TO_XEN_INT(audio_output_device(ss)));
-}
-
-
-static XEN g_audio_input_device(void) {return(C_TO_XEN_INT(audio_input_device(ss)));}
-
-static XEN g_set_audio_input_device(XEN val)
-{
- #define H_audio_input_device "(" S_audio_input_device "): the current sndlib default input device (" S_mus_audio_default ")"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_audio_input_device, "an integer");
- set_audio_input_device(XEN_TO_C_INT(val));
- return(C_TO_XEN_INT(audio_input_device(ss)));
-}
-
-
-static XEN g_minibuffer_history_length(void) {return(C_TO_XEN_INT(minibuffer_history_length(ss)));}
-
-static XEN g_set_minibuffer_history_length(XEN val)
-{
- #define H_minibuffer_history_length "(" S_minibuffer_history_length "): the minibuffer history length. \
-This pertains to the M-p and M-n commands."
- int len;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_minibuffer_history_length, "an integer");
- len = XEN_TO_C_INT(val);
- if (len > 0)
- set_minibuffer_history_length(len);
- return(C_TO_XEN_INT(minibuffer_history_length(ss)));
-}
-
-
-static XEN g_auto_resize(void) {return(C_TO_XEN_BOOLEAN(auto_resize(ss)));}
-
-static XEN g_set_auto_resize(XEN val)
+static Xen g_set_auto_resize(Xen val)
{
#define H_auto_resize "(" S_auto_resize "): " PROC_TRUE " if Snd can change its main window size as it pleases (default: " PROC_TRUE ")"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_auto_resize, "a boolean");
- set_auto_resize(XEN_TO_C_BOOLEAN(val));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_auto_resize, "a boolean");
+ set_auto_resize(Xen_boolean_to_C_bool(val));
#if USE_MOTIF
XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, auto_resize(ss), NULL);
#endif
- return(C_TO_XEN_BOOLEAN(auto_resize(ss)));
+ return(C_bool_to_Xen_boolean(auto_resize(ss)));
}
-static XEN g_color_cutoff(void) {return(C_TO_XEN_DOUBLE(color_cutoff(ss)));}
+static Xen g_color_cutoff(void) {return(C_double_to_Xen_real(color_cutoff(ss)));}
-static XEN g_set_color_cutoff(XEN val)
+static Xen g_set_color_cutoff(Xen val)
{
#define H_color_cutoff "(" S_color_cutoff "): color map cutoff point (default .003). Any values \
below the cutoff are displayed in the background color"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_color_cutoff, "a number");
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_color_cutoff, "a number");
set_color_cutoff(mus_fclamp(0.0,
- XEN_TO_C_DOUBLE(val),
- 0.25));
- return(C_TO_XEN_DOUBLE(color_cutoff(ss)));
+ Xen_real_to_C_double(val),
+#if USE_MOTIF
+ 0.25
+#else
+ 1.0
+#endif
+ ));
+ return(C_double_to_Xen_real(color_cutoff(ss)));
}
-static XEN g_color_inverted(void) {return(C_TO_XEN_BOOLEAN(color_inverted(ss)));}
+static Xen g_color_inverted(void) {return(C_bool_to_Xen_boolean(color_inverted(ss)));}
-static XEN g_set_color_inverted(XEN val)
+static Xen g_set_color_inverted(Xen val)
{
#define H_color_inverted "(" S_color_inverted "): whether the colormap in operation should be inverted"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_color_inverted, "a boolean");
- set_color_inverted(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(color_inverted(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_color_inverted, "a boolean");
+ set_color_inverted(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(color_inverted(ss)));
}
-static XEN g_color_scale(void) {return(C_TO_XEN_DOUBLE(color_scale(ss)));}
+static Xen g_color_scale(void) {return(C_double_to_Xen_real(color_scale(ss)));}
-static XEN g_set_color_scale(XEN val)
+static Xen g_set_color_scale(Xen val)
{
#define H_color_scale "(" S_color_scale "): darkness setting for colormaps (0.5)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_color_scale, "a number");
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_color_scale, "a number");
set_color_scale(mus_fclamp(0.0,
- XEN_TO_C_DOUBLE(val),
+ Xen_real_to_C_double(val),
1000.0));
- return(C_TO_XEN_DOUBLE(color_scale(ss)));
+ return(C_double_to_Xen_real(color_scale(ss)));
}
-static XEN g_selection_creates_region(void) {return(C_TO_XEN_BOOLEAN(selection_creates_region(ss)));}
+static Xen g_selection_creates_region(void) {return(C_bool_to_Xen_boolean(selection_creates_region(ss)));}
-static XEN g_set_selection_creates_region(XEN val)
+static Xen g_set_selection_creates_region(Xen val)
{
#define H_selection_creates_region "(" S_selection_creates_region "): " PROC_TRUE " if a region should be created each time a selection is made. \
The default is currently " PROC_TRUE ", but that may change. If you're dealing with large selections, and have no need of \
regions (saved selections), you can speed up many operations by setting this flag to " PROC_FALSE
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_selection_creates_region, "a boolean");
- set_selection_creates_region(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(selection_creates_region(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_selection_creates_region, "a boolean");
+ set_selection_creates_region(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(selection_creates_region(ss)));
}
@@ -2111,470 +2076,444 @@ static void set_print_lengths(int len)
set_print_length(len);
mus_vct_set_print_length(len);
#if HAVE_SCHEME
- s7_set_vector_print_length(s7, len);
+ s7_set_print_length(s7, len);
#endif
}
-static XEN g_print_length(void) {return(C_TO_XEN_INT(print_length(ss)));}
+static Xen g_print_length(void) {return(C_int_to_Xen_integer(print_length(ss)));}
-static XEN g_set_print_length(XEN val)
+static Xen g_set_print_length(Xen val)
{
int len;
#define H_print_length "(" S_print_length "): number of vector elements to print in the listener (default: 12)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_print_length, "an integer");
- len = XEN_TO_C_INT(val);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_print_length, "an integer");
+ len = Xen_integer_to_C_int(val);
if (len < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_print_length, XEN_ONLY_ARG, val, "must be >= 0");
+ Xen_out_of_range_error(S_set S_print_length, 1, val, "must be >= 0");
set_print_lengths(len);
- return(C_TO_XEN_INT(print_length(ss)));
+ return(C_int_to_Xen_integer(print_length(ss)));
}
-static XEN g_show_indices(void) {return(C_TO_XEN_BOOLEAN(show_indices(ss)));}
+static Xen g_show_indices(void) {return(C_bool_to_Xen_boolean(show_indices(ss)));}
-static XEN g_set_show_indices(XEN val)
+static Xen g_set_show_indices(Xen val)
{
#define H_show_indices "(" S_show_indices "): " PROC_TRUE " if sound name should be preceded by its index in the sound display."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_show_indices, "a boolean");
- set_show_indices(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(show_indices(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_show_indices, "a boolean");
+ set_show_indices(Xen_boolean_to_C_bool(val));
+ for_each_sound(update_sound_label);
+ return(C_bool_to_Xen_boolean(show_indices(ss)));
}
+static Xen g_with_relative_panes(void) {return(C_bool_to_Xen_boolean(with_relative_panes(ss)));}
-static XEN g_trap_segfault(void) {return(C_TO_XEN_BOOLEAN(trap_segfault(ss)));}
-
-static XEN g_set_trap_segfault(XEN val)
-{
- #define H_trap_segfault "(" S_trap_segfault "): " PROC_TRUE " if Snd should try to trap (and whine about) segfaults"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_trap_segfault, "a boolean");
- set_trap_segfault(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(trap_segfault(ss)));
-}
-
-
-static XEN g_with_relative_panes(void) {return(C_TO_XEN_BOOLEAN(with_relative_panes(ss)));}
-
-static XEN g_set_with_relative_panes(XEN val)
+static Xen g_set_with_relative_panes(Xen val)
{
#define H_with_relative_panes "(" S_with_relative_panes "): " PROC_TRUE " if multichannel sounds should try to maintain relative pane sizes"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_with_relative_panes, "a boolean");
- set_with_relative_panes(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(with_relative_panes(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_with_relative_panes, "a boolean");
+ set_with_relative_panes(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(with_relative_panes(ss)));
}
-static XEN g_with_background_processes(void) {return(C_TO_XEN_BOOLEAN(with_background_processes(ss)));}
+static Xen g_with_background_processes(void) {return(C_bool_to_Xen_boolean(with_background_processes(ss)));}
-static XEN g_set_with_background_processes(XEN val)
+static Xen g_set_with_background_processes(Xen val)
{
#define H_with_background_processes "(" S_with_background_processes "): " PROC_TRUE " if Snd should use background (idle time) processing"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_with_background_processes, "a boolean");
- set_with_background_processes(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(with_background_processes(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_with_background_processes, "a boolean");
+ set_with_background_processes(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(with_background_processes(ss)));
}
-static XEN g_with_file_monitor(void) {return(C_TO_XEN_BOOLEAN(with_file_monitor(ss)));}
+static Xen g_with_file_monitor(void) {return(C_bool_to_Xen_boolean(with_file_monitor(ss)));}
-static XEN g_set_with_file_monitor(XEN val)
+static Xen g_set_with_file_monitor(Xen val)
{
#define H_with_file_monitor "(" S_with_file_monitor "): " PROC_TRUE " if the file alteration monitor is active"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_with_file_monitor, "a boolean");
- set_with_file_monitor(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(with_file_monitor(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_with_file_monitor, "a boolean");
+ set_with_file_monitor(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(with_file_monitor(ss)));
}
-static XEN g_snd_version(void)
+static Xen g_snd_version(void)
{
#define H_snd_version "(" S_snd_version "): current Snd version (a string)"
- return(C_TO_XEN_STRING("Snd " SND_VERSION ", " SND_DATE)); /* make it look like s7-version's output */
+ return(C_string_to_Xen_string("Snd " SND_VERSION ", " SND_DATE)); /* make it look like s7-version's output */
}
-static XEN g_color_orientation_dialog(XEN managed)
+static Xen g_color_orientation_dialog(Xen managed)
{
- widget_t w;
#define H_color_orientation_dialog "(" S_color_orientation_dialog " :optional managed): start the Color/Orientation dialog"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_color_orientation_dialog, "a boolean");
- w = start_color_orientation_dialog(XEN_TO_C_BOOLEAN(managed));
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_color_orientation_dialog, "a boolean");
+ return(Xen_wrap_widget(make_color_orientation_dialog(Xen_boolean_to_C_bool(managed))));
}
-static XEN g_transform_dialog(XEN managed)
+static Xen g_transform_dialog(Xen managed)
{
- widget_t w;
#define H_transform_dialog "(" S_transform_dialog " :optional (managed " PROC_TRUE ")): start the Transforms dialog"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ONLY_ARG, S_transform_dialog, "a boolean");
- w = fire_up_transform_dialog(XEN_TO_C_BOOLEAN(managed));
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_transform_dialog, "a boolean");
+ return(Xen_wrap_widget(make_transform_dialog(Xen_boolean_to_C_bool(managed))));
}
-static XEN g_print_dialog(XEN managed, XEN direct_to_printer)
+static Xen g_print_dialog(Xen managed, Xen direct_to_printer)
{
- widget_t w;
#define H_print_dialog "(" S_print_dialog " :optional managed direct): start the File Print dialog"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ARG_1, S_print_dialog, "a boolean");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(direct_to_printer), direct_to_printer, XEN_ARG_2, S_print_dialog, "a boolean");
- w = make_file_print_dialog(!(XEN_FALSE_P(managed)), XEN_TRUE_P(direct_to_printer));
- return(XEN_WRAP_WIDGET(w));
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_print_dialog, "a boolean");
+ Xen_check_type(Xen_is_boolean_or_unbound(direct_to_printer), direct_to_printer, 2, S_print_dialog, "a boolean");
+ return(Xen_wrap_widget(make_file_print_dialog(!(Xen_is_false(managed)), Xen_is_true(direct_to_printer))));
}
-static XEN g_preferences_dialog(void)
+static Xen g_preferences_dialog(void)
{
- widget_t w;
#define H_preferences_dialog "(" S_preferences_dialog "): start the Options:Preferences dialog"
- w = start_preferences_dialog();
- return(XEN_WRAP_WIDGET(w));
+ return(Xen_wrap_widget(make_preferences_dialog()));
}
-static XEN g_recorder_dialog(void)
-{
- #define H_recorder_dialog "(" S_recorder_dialog "): start the Recorder"
- return(XEN_WRAP_WIDGET(record_file()));
-}
-
-
-static XEN g_abort(void)
+static Xen g_abort(void)
{
#define H_abort "(" S_abort "): exit Snd via \"abort\", presumably to land in the debugger"
abort();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_abortq(void)
+#if (!HAVE_SCHEME)
+static Xen g_abortq(void)
{
#define H_abortQ "(" S_c_g "): allow pending user interface events to occur, returning " PROC_TRUE " if C-g was typed"
check_for_event();
- if ((ss->cg_seen) || (ss->stopped_explicitly))
-
+ if ((ss->C_g_typed) ||
+ (ss->stopped_explicitly))
{
ss->stopped_explicitly = false;
- ss->cg_seen = false;
- return(XEN_TRUE);
+ ss->C_g_typed = false;
+ return(Xen_true);
}
- return(XEN_FALSE);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_save_state_file_w, g_save_state_file)
-XEN_NARGIFY_1(g_set_save_state_file_w, g_set_save_state_file)
-XEN_NARGIFY_0(g_save_dir_w, g_save_dir)
-XEN_NARGIFY_1(g_set_save_dir_w, g_set_save_dir)
-XEN_NARGIFY_0(g_open_file_dialog_directory_w, g_open_file_dialog_directory)
-XEN_NARGIFY_1(g_set_open_file_dialog_directory_w, g_set_open_file_dialog_directory)
-XEN_NARGIFY_0(g_peak_env_dir_w, g_peak_env_dir)
-XEN_NARGIFY_1(g_set_peak_env_dir_w, g_set_peak_env_dir)
-XEN_NARGIFY_0(g_temp_dir_w, g_temp_dir)
-XEN_NARGIFY_1(g_set_temp_dir_w, g_set_temp_dir)
-XEN_NARGIFY_0(g_ladspa_dir_w, g_ladspa_dir)
-XEN_NARGIFY_1(g_set_ladspa_dir_w, g_set_ladspa_dir)
-XEN_ARGIFY_1(g_save_state_w, g_save_state)
-XEN_ARGIFY_1(g_exit_w, g_exit)
-XEN_NARGIFY_0(g_script_arg_w, g_script_arg)
-XEN_NARGIFY_1(g_set_script_arg_w, g_set_script_arg)
-XEN_NARGIFY_0(g_script_args_w, g_script_args)
-XEN_NARGIFY_0(g_window_x_w, g_window_x)
-XEN_NARGIFY_1(g_set_window_x_w, g_set_window_x)
-XEN_NARGIFY_0(g_window_y_w, g_window_y)
-XEN_NARGIFY_1(g_set_window_y_w, g_set_window_y)
-XEN_NARGIFY_0(g_window_width_w, g_window_width)
-XEN_NARGIFY_1(g_set_window_width_w, g_set_window_width)
-XEN_NARGIFY_0(g_window_height_w, g_window_height)
-XEN_NARGIFY_1(g_set_window_height_w, g_set_window_height)
-XEN_NARGIFY_0(g_just_sounds_w, g_just_sounds)
-XEN_NARGIFY_1(g_set_just_sounds_w, g_set_just_sounds)
-XEN_NARGIFY_0(g_play_arrow_size_w, g_play_arrow_size)
-XEN_NARGIFY_1(g_set_play_arrow_size_w, g_set_play_arrow_size)
-XEN_NARGIFY_0(g_with_inset_graph_w, g_with_inset_graph)
-XEN_NARGIFY_1(g_set_with_inset_graph_w, g_set_with_inset_graph)
-XEN_NARGIFY_0(g_with_smpte_label_w, g_with_smpte_label)
-XEN_NARGIFY_1(g_set_with_smpte_label_w, g_set_with_smpte_label)
-XEN_NARGIFY_0(g_with_pointer_focus_w, g_with_pointer_focus)
-XEN_NARGIFY_1(g_set_with_pointer_focus_w, g_set_with_pointer_focus)
-XEN_NARGIFY_0(g_audio_output_device_w, g_audio_output_device)
-XEN_NARGIFY_1(g_set_audio_output_device_w, g_set_audio_output_device)
-XEN_NARGIFY_0(g_audio_input_device_w, g_audio_input_device)
-XEN_NARGIFY_1(g_set_audio_input_device_w, g_set_audio_input_device)
-XEN_NARGIFY_0(g_minibuffer_history_length_w, g_minibuffer_history_length)
-XEN_NARGIFY_1(g_set_minibuffer_history_length_w, g_set_minibuffer_history_length)
-XEN_NARGIFY_0(g_auto_resize_w, g_auto_resize)
-XEN_NARGIFY_1(g_set_auto_resize_w, g_set_auto_resize)
-XEN_NARGIFY_0(g_color_cutoff_w, g_color_cutoff)
-XEN_NARGIFY_1(g_set_color_cutoff_w, g_set_color_cutoff)
-XEN_NARGIFY_0(g_color_inverted_w, g_color_inverted)
-XEN_NARGIFY_1(g_set_color_inverted_w, g_set_color_inverted)
-XEN_NARGIFY_0(g_color_scale_w, g_color_scale)
-XEN_NARGIFY_1(g_set_color_scale_w, g_set_color_scale)
-XEN_NARGIFY_0(g_selection_creates_region_w, g_selection_creates_region)
-XEN_NARGIFY_1(g_set_selection_creates_region_w, g_set_selection_creates_region)
-XEN_NARGIFY_0(g_print_length_w, g_print_length)
-XEN_NARGIFY_1(g_set_print_length_w, g_set_print_length)
-XEN_NARGIFY_0(g_show_indices_w, g_show_indices)
-XEN_NARGIFY_1(g_set_show_indices_w, g_set_show_indices)
-XEN_NARGIFY_0(g_trap_segfault_w, g_trap_segfault)
-XEN_NARGIFY_1(g_set_trap_segfault_w, g_set_trap_segfault)
-XEN_NARGIFY_0(g_with_relative_panes_w, g_with_relative_panes)
-XEN_NARGIFY_1(g_set_with_relative_panes_w, g_set_with_relative_panes)
-XEN_NARGIFY_0(g_with_background_processes_w, g_with_background_processes)
-XEN_NARGIFY_1(g_set_with_background_processes_w, g_set_with_background_processes)
-XEN_NARGIFY_0(g_with_file_monitor_w, g_with_file_monitor)
-XEN_NARGIFY_1(g_set_with_file_monitor_w, g_set_with_file_monitor)
-XEN_NARGIFY_0(g_tiny_font_w, g_tiny_font)
-XEN_NARGIFY_1(g_set_tiny_font_w, g_set_tiny_font)
-XEN_NARGIFY_0(g_peaks_font_w, g_peaks_font)
-XEN_NARGIFY_1(g_set_peaks_font_w, g_set_peaks_font)
-XEN_NARGIFY_0(g_bold_peaks_font_w, g_bold_peaks_font)
-XEN_NARGIFY_1(g_set_bold_peaks_font_w, g_set_bold_peaks_font)
-XEN_NARGIFY_0(g_axis_label_font_w, g_axis_label_font)
-XEN_NARGIFY_1(g_set_axis_label_font_w, g_set_axis_label_font)
-XEN_NARGIFY_0(g_axis_numbers_font_w, g_axis_numbers_font)
-XEN_NARGIFY_1(g_set_axis_numbers_font_w, g_set_axis_numbers_font)
-XEN_NARGIFY_0(g_listener_font_w, g_listener_font)
-XEN_NARGIFY_1(g_set_listener_font_w, g_set_listener_font)
-XEN_NARGIFY_0(g_snd_version_w, g_snd_version)
-XEN_ARGIFY_1(g_color_orientation_dialog_w, g_color_orientation_dialog)
-XEN_ARGIFY_1(g_transform_dialog_w, g_transform_dialog)
-XEN_ARGIFY_2(g_print_dialog_w, g_print_dialog)
-XEN_NARGIFY_0(g_preferences_dialog_w, g_preferences_dialog)
-XEN_NARGIFY_0(g_recorder_dialog_w, g_recorder_dialog)
-XEN_NARGIFY_0(g_abort_w, g_abort)
-XEN_NARGIFY_0(g_abortq_w, g_abortq)
-#else
-#define g_save_state_file_w g_save_state_file
-#define g_set_save_state_file_w g_set_save_state_file
-#define g_save_dir_w g_save_dir
-#define g_set_save_dir_w g_set_save_dir
-#define g_open_file_dialog_directory_w g_open_file_dialog_directory
-#define g_set_open_file_dialog_directory_w g_set_open_file_dialog_directory
-#define g_peak_env_dir_w g_peak_env_dir
-#define g_set_peak_env_dir_w g_set_peak_env_dir
-#define g_temp_dir_w g_temp_dir
-#define g_set_temp_dir_w g_set_temp_dir
-#define g_ladspa_dir_w g_ladspa_dir
-#define g_set_ladspa_dir_w g_set_ladspa_dir
-#define g_save_state_w g_save_state
-#define g_exit_w g_exit
-#define g_script_arg_w g_script_arg
-#define g_set_script_arg_w g_set_script_arg
-#define g_script_args_w g_script_args
-#define g_window_x_w g_window_x
-#define g_set_window_x_w g_set_window_x
-#define g_window_y_w g_window_y
-#define g_set_window_y_w g_set_window_y
-#define g_window_width_w g_window_width
-#define g_set_window_width_w g_set_window_width
-#define g_window_height_w g_window_height
-#define g_set_window_height_w g_set_window_height
-#define g_just_sounds_w g_just_sounds
-#define g_set_just_sounds_w g_set_just_sounds
-#define g_play_arrow_size_w g_play_arrow_size
-#define g_set_play_arrow_size_w g_set_play_arrow_size
-#define g_with_inset_graph_w g_with_inset_graph
-#define g_set_with_inset_graph_w g_set_with_inset_graph
-#define g_with_smpte_label_w g_with_smpte_label
-#define g_set_with_smpte_label_w g_set_with_smpte_label
-#define g_with_pointer_focus_w g_with_pointer_focus
-#define g_set_with_pointer_focus_w g_set_with_pointer_focus
-#define g_audio_output_device_w g_audio_output_device
-#define g_set_audio_output_device_w g_set_audio_output_device
-#define g_audio_input_device_w g_audio_input_device
-#define g_set_audio_input_device_w g_set_audio_input_device
-#define g_minibuffer_history_length_w g_minibuffer_history_length
-#define g_set_minibuffer_history_length_w g_set_minibuffer_history_length
-#define g_auto_resize_w g_auto_resize
-#define g_set_auto_resize_w g_set_auto_resize
-#define g_color_cutoff_w g_color_cutoff
-#define g_set_color_cutoff_w g_set_color_cutoff
-#define g_color_inverted_w g_color_inverted
-#define g_set_color_inverted_w g_set_color_inverted
-#define g_color_scale_w g_color_scale
-#define g_set_color_scale_w g_set_color_scale
-#define g_selection_creates_region_w g_selection_creates_region
-#define g_set_selection_creates_region_w g_set_selection_creates_region
-#define g_print_length_w g_print_length
-#define g_set_print_length_w g_set_print_length
-#define g_show_indices_w g_show_indices
-#define g_set_show_indices_w g_set_show_indices
-#define g_trap_segfault_w g_trap_segfault
-#define g_set_trap_segfault_w g_set_trap_segfault
-#define g_with_relative_panes_w g_with_relative_panes
-#define g_set_with_relative_panes_w g_set_with_relative_panes
-#define g_with_background_processes_w g_with_background_processes
-#define g_set_with_background_processes_w g_set_with_background_processes
-#define g_with_file_monitor_w g_with_file_monitor
-#define g_set_with_file_monitor_w g_set_with_file_monitor
-#define g_tiny_font_w g_tiny_font
-#define g_set_tiny_font_w g_set_tiny_font
-#define g_peaks_font_w g_peaks_font
-#define g_set_peaks_font_w g_set_peaks_font
-#define g_bold_peaks_font_w g_bold_peaks_font
-#define g_set_bold_peaks_font_w g_set_bold_peaks_font
-#define g_axis_label_font_w g_axis_label_font
-#define g_set_axis_label_font_w g_set_axis_label_font
-#define g_axis_numbers_font_w g_axis_numbers_font
-#define g_set_axis_numbers_font_w g_set_axis_numbers_font
-#define g_listener_font_w g_listener_font
-#define g_set_listener_font_w g_set_listener_font
-#define g_snd_version_w g_snd_version
-#define g_color_orientation_dialog_w g_color_orientation_dialog
-#define g_transform_dialog_w g_transform_dialog
-#define g_print_dialog_w g_print_dialog
-#define g_preferences_dialog_w g_preferences_dialog
-#define g_recorder_dialog_w g_recorder_dialog
-#define g_abort_w g_abort
-#define g_abortq_w g_abortq
+ return(Xen_false);
+}
+#endif
+
+
+Xen_wrap_no_args(g_save_state_file_w, g_save_state_file)
+Xen_wrap_1_arg(g_set_save_state_file_w, g_set_save_state_file)
+Xen_wrap_no_args(g_save_dir_w, g_save_dir)
+Xen_wrap_1_arg(g_set_save_dir_w, g_set_save_dir)
+Xen_wrap_no_args(g_open_file_dialog_directory_w, g_open_file_dialog_directory)
+Xen_wrap_1_arg(g_set_open_file_dialog_directory_w, g_set_open_file_dialog_directory)
+Xen_wrap_no_args(g_peak_env_dir_w, g_peak_env_dir)
+Xen_wrap_1_arg(g_set_peak_env_dir_w, g_set_peak_env_dir)
+Xen_wrap_no_args(g_temp_dir_w, g_temp_dir)
+Xen_wrap_1_arg(g_set_temp_dir_w, g_set_temp_dir)
+Xen_wrap_no_args(g_ladspa_dir_w, g_ladspa_dir)
+Xen_wrap_1_arg(g_set_ladspa_dir_w, g_set_ladspa_dir)
+Xen_wrap_1_optional_arg(g_save_state_w, g_save_state)
+Xen_wrap_1_optional_arg(g_exit_w, g_exit)
+Xen_wrap_no_args(g_script_arg_w, g_script_arg)
+Xen_wrap_1_arg(g_set_script_arg_w, g_set_script_arg)
+Xen_wrap_no_args(g_script_args_w, g_script_args)
+Xen_wrap_no_args(g_window_x_w, g_window_x)
+Xen_wrap_1_arg(g_set_window_x_w, g_set_window_x)
+Xen_wrap_no_args(g_window_y_w, g_window_y)
+Xen_wrap_1_arg(g_set_window_y_w, g_set_window_y)
+Xen_wrap_no_args(g_window_width_w, g_window_width)
+Xen_wrap_1_arg(g_set_window_width_w, g_set_window_width)
+Xen_wrap_no_args(g_window_height_w, g_window_height)
+Xen_wrap_1_arg(g_set_window_height_w, g_set_window_height)
+Xen_wrap_no_args(g_just_sounds_w, g_just_sounds)
+Xen_wrap_1_arg(g_set_just_sounds_w, g_set_just_sounds)
+Xen_wrap_no_args(g_play_arrow_size_w, g_play_arrow_size)
+Xen_wrap_1_arg(g_set_play_arrow_size_w, g_set_play_arrow_size)
+Xen_wrap_no_args(g_with_inset_graph_w, g_with_inset_graph)
+Xen_wrap_1_arg(g_set_with_inset_graph_w, g_set_with_inset_graph)
+Xen_wrap_no_args(g_with_interrupts_w, g_with_interrupts)
+Xen_wrap_1_arg(g_set_with_interrupts_w, g_set_with_interrupts)
+Xen_wrap_no_args(g_with_smpte_label_w, g_with_smpte_label)
+Xen_wrap_1_arg(g_set_with_smpte_label_w, g_set_with_smpte_label)
+Xen_wrap_no_args(g_with_pointer_focus_w, g_with_pointer_focus)
+Xen_wrap_1_arg(g_set_with_pointer_focus_w, g_set_with_pointer_focus)
+Xen_wrap_no_args(g_auto_resize_w, g_auto_resize)
+Xen_wrap_1_arg(g_set_auto_resize_w, g_set_auto_resize)
+Xen_wrap_no_args(g_color_cutoff_w, g_color_cutoff)
+Xen_wrap_1_arg(g_set_color_cutoff_w, g_set_color_cutoff)
+Xen_wrap_no_args(g_color_inverted_w, g_color_inverted)
+Xen_wrap_1_arg(g_set_color_inverted_w, g_set_color_inverted)
+Xen_wrap_no_args(g_color_scale_w, g_color_scale)
+Xen_wrap_1_arg(g_set_color_scale_w, g_set_color_scale)
+Xen_wrap_no_args(g_selection_creates_region_w, g_selection_creates_region)
+Xen_wrap_1_arg(g_set_selection_creates_region_w, g_set_selection_creates_region)
+Xen_wrap_no_args(g_print_length_w, g_print_length)
+Xen_wrap_1_arg(g_set_print_length_w, g_set_print_length)
+Xen_wrap_no_args(g_show_indices_w, g_show_indices)
+Xen_wrap_1_arg(g_set_show_indices_w, g_set_show_indices)
+Xen_wrap_no_args(g_with_relative_panes_w, g_with_relative_panes)
+Xen_wrap_1_arg(g_set_with_relative_panes_w, g_set_with_relative_panes)
+Xen_wrap_no_args(g_with_background_processes_w, g_with_background_processes)
+Xen_wrap_1_arg(g_set_with_background_processes_w, g_set_with_background_processes)
+Xen_wrap_no_args(g_with_file_monitor_w, g_with_file_monitor)
+Xen_wrap_1_arg(g_set_with_file_monitor_w, g_set_with_file_monitor)
+Xen_wrap_no_args(g_tiny_font_w, g_tiny_font)
+Xen_wrap_1_arg(g_set_tiny_font_w, g_set_tiny_font)
+Xen_wrap_no_args(g_peaks_font_w, g_peaks_font)
+Xen_wrap_1_arg(g_set_peaks_font_w, g_set_peaks_font)
+Xen_wrap_no_args(g_bold_peaks_font_w, g_bold_peaks_font)
+Xen_wrap_1_arg(g_set_bold_peaks_font_w, g_set_bold_peaks_font)
+Xen_wrap_no_args(g_axis_label_font_w, g_axis_label_font)
+Xen_wrap_1_arg(g_set_axis_label_font_w, g_set_axis_label_font)
+Xen_wrap_no_args(g_axis_numbers_font_w, g_axis_numbers_font)
+Xen_wrap_1_arg(g_set_axis_numbers_font_w, g_set_axis_numbers_font)
+Xen_wrap_no_args(g_listener_font_w, g_listener_font)
+Xen_wrap_1_arg(g_set_listener_font_w, g_set_listener_font)
+Xen_wrap_no_args(g_snd_version_w, g_snd_version)
+Xen_wrap_1_optional_arg(g_color_orientation_dialog_w, g_color_orientation_dialog)
+Xen_wrap_1_optional_arg(g_transform_dialog_w, g_transform_dialog)
+Xen_wrap_2_optional_args(g_print_dialog_w, g_print_dialog)
+Xen_wrap_no_args(g_preferences_dialog_w, g_preferences_dialog)
+Xen_wrap_no_args(g_abort_w, g_abort)
+#if (!HAVE_SCHEME)
+Xen_wrap_no_args(g_abortq_w, g_abortq)
+#endif
+
+#if HAVE_SCHEME
+static s7_pointer acc_temp_dir(s7_scheme *sc, s7_pointer args) {return(g_set_temp_dir(s7_cadr(args)));}
+static s7_pointer acc_save_dir(s7_scheme *sc, s7_pointer args) {return(g_set_save_dir(s7_cadr(args)));}
+static s7_pointer acc_ladspa_dir(s7_scheme *sc, s7_pointer args) {return(g_set_ladspa_dir(s7_cadr(args)));}
+static s7_pointer acc_peak_env_dir(s7_scheme *sc, s7_pointer args) {return(g_set_peak_env_dir(s7_cadr(args)));}
+static s7_pointer acc_listener_font(s7_scheme *sc, s7_pointer args) {return(g_set_listener_font(s7_cadr(args)));}
+static s7_pointer acc_axis_label_font(s7_scheme *sc, s7_pointer args) {return(g_set_axis_label_font(s7_cadr(args)));}
+static s7_pointer acc_axis_numbers_font(s7_scheme *sc, s7_pointer args) {return(g_set_axis_numbers_font(s7_cadr(args)));}
+static s7_pointer acc_tiny_font(s7_scheme *sc, s7_pointer args) {return(g_set_tiny_font(s7_cadr(args)));}
+static s7_pointer acc_peaks_font(s7_scheme *sc, s7_pointer args) {return(g_set_peaks_font(s7_cadr(args)));}
+static s7_pointer acc_bold_peaks_font(s7_scheme *sc, s7_pointer args) {return(g_set_bold_peaks_font(s7_cadr(args)));}
+static s7_pointer acc_with_inset_graph(s7_scheme *sc, s7_pointer args) {return(g_set_with_inset_graph(s7_cadr(args)));}
+static s7_pointer acc_with_pointer_focus(s7_scheme *sc, s7_pointer args) {return(g_set_with_pointer_focus(s7_cadr(args)));}
+static s7_pointer acc_with_smpte_label(s7_scheme *sc, s7_pointer args) {return(g_set_with_smpte_label(s7_cadr(args)));}
+static s7_pointer acc_with_interrupts(s7_scheme *sc, s7_pointer args) {return(g_set_with_interrupts(s7_cadr(args)));}
+static s7_pointer acc_color_scale(s7_scheme *sc, s7_pointer args) {return(g_set_color_scale(s7_cadr(args)));}
+static s7_pointer acc_color_cutoff(s7_scheme *sc, s7_pointer args) {return(g_set_color_cutoff(s7_cadr(args)));}
+static s7_pointer acc_color_inverted(s7_scheme *sc, s7_pointer args) {return(g_set_color_inverted(s7_cadr(args)));}
+static s7_pointer acc_auto_resize(s7_scheme *sc, s7_pointer args) {return(g_set_auto_resize(s7_cadr(args)));}
+static s7_pointer acc_print_length(s7_scheme *sc, s7_pointer args) {return(g_set_print_length(s7_cadr(args)));}
+static s7_pointer acc_selection_creates_region(s7_scheme *sc, s7_pointer args) {return(g_set_selection_creates_region(s7_cadr(args)));}
+static s7_pointer acc_save_state_file(s7_scheme *sc, s7_pointer args) {return(g_set_save_state_file(s7_cadr(args)));}
+static s7_pointer acc_with_background_processes(s7_scheme *sc, s7_pointer args) {return(g_set_with_background_processes(s7_cadr(args)));}
+static s7_pointer acc_with_file_monitor(s7_scheme *sc, s7_pointer args) {return(g_set_with_file_monitor(s7_cadr(args)));}
+static s7_pointer acc_show_indices(s7_scheme *sc, s7_pointer args) {return(g_set_show_indices(s7_cadr(args)));}
+static s7_pointer acc_just_sounds(s7_scheme *sc, s7_pointer args) {return(g_set_just_sounds(s7_cadr(args)));}
+static s7_pointer acc_play_arrow_size(s7_scheme *sc, s7_pointer args) {return(g_set_play_arrow_size(s7_cadr(args)));}
+static s7_pointer acc_with_relative_panes(s7_scheme *sc, s7_pointer args) {return(g_set_with_relative_panes(s7_cadr(args)));}
+static s7_pointer acc_open_file_dialog_directory(s7_scheme *sc, s7_pointer args) {return(g_set_open_file_dialog_directory(s7_cadr(args)));}
#endif
+
void g_init_main(void)
{
- XEN_DEFINE_PROCEDURE(S_save_state, g_save_state_w, 0, 1, 0, H_save_state);
+#if HAVE_SCHEME
+ s7_pointer pl_b, pl_bb, pl_i, pl_ii, pl_s, pl_ss, pl_d, pl_dr, pl_p, pl_z, pl_zb, pl_zbb;
+ {
+ s7_pointer i, b, d, r, s, p, z;
+ i = s7_make_symbol(s7, "integer?");
+ b = s7_make_symbol(s7, "boolean?");
+ d = s7_make_symbol(s7, "float?");
+ r = s7_make_symbol(s7, "real?");
+ s = s7_make_symbol(s7, "string?");
+ p = s7_make_symbol(s7, "pair?");
+
+ z = s7_make_signature(s7, 2, p, b);
+ pl_b = s7_make_signature(s7, 1, b);
+ pl_bb = s7_make_signature(s7, 2, b, b);
+ pl_i = s7_make_signature(s7, 1, i);
+ pl_ii = s7_make_signature(s7, 2, i, i);
+ pl_s = s7_make_signature(s7, 1, s);
+ pl_ss = s7_make_signature(s7, 2, s, s);
+ pl_d = s7_make_signature(s7, 1, d);
+ pl_dr = s7_make_signature(s7, 2, d, r);
+ pl_p = s7_make_signature(s7, 1, p);
+ pl_z = s7_make_signature(s7, 1, z);
+ pl_zb = s7_make_signature(s7, 2, z, b);
+ pl_zbb = s7_make_signature(s7, 3, z, b, b);
+ }
+#endif
+ Xen_define_typed_procedure(S_save_state, g_save_state_w, 0, 1, 0, H_save_state, pl_ss);
#if HAVE_FORTH /* exit is an existing word */
- XEN_DEFINE_PROCEDURE("snd-" S_exit, g_exit_w, 0, 1, 0, H_exit);
+ Xen_define_procedure("snd-" S_exit, g_exit_w, 0, 1, 0, H_exit);
#else
- XEN_DEFINE_PROCEDURE(S_exit, g_exit_w, 0, 1, 0, H_exit);
+ Xen_define_procedure(S_exit, g_exit_w, 0, 1, 0, H_exit);
#endif
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_save_state_file, g_save_state_file_w, H_save_state_file,
- S_setB S_save_state_file, g_set_save_state_file_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_save_dir, g_save_dir_w, H_save_dir,
- S_setB S_save_dir, g_set_save_dir_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_open_file_dialog_directory, g_open_file_dialog_directory_w, H_open_file_dialog_directory,
- S_setB S_open_file_dialog_directory, g_set_open_file_dialog_directory_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_peak_env_dir, g_peak_env_dir_w, H_peak_env_dir,
- S_setB S_peak_env_dir, g_set_peak_env_dir_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_temp_dir, g_temp_dir_w, H_temp_dir,
- S_setB S_temp_dir, g_set_temp_dir_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_ladspa_dir, g_ladspa_dir_w, H_ladspa_dir,
- S_setB S_ladspa_dir, g_set_ladspa_dir_w, 0, 0, 1, 0);
-
- #define H_start_hook S_start_hook " (filename): called upon start-up. If it returns " PROC_TRUE ", snd exits immediately."
- start_hook = XEN_DEFINE_HOOK(S_start_hook, 1, H_start_hook); /* arg = argv filename if any */
-
- #define H_before_exit_hook S_before_exit_hook " (): called upon exit. \
-If it returns " PROC_TRUE ", Snd does not exit. This can be used to check for unsaved edits."
-
- before_exit_hook = XEN_DEFINE_HOOK(S_before_exit_hook, 0, H_before_exit_hook);
-
+ Xen_define_typed_dilambda(S_save_state_file, g_save_state_file_w, H_save_state_file,
+ S_set S_save_state_file, g_set_save_state_file_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_save_dir, g_save_dir_w, H_save_dir,
+ S_set S_save_dir, g_set_save_dir_w, 0, 0, 1, 0, pl_s, pl_ss);
+
+ Xen_define_typed_dilambda(S_open_file_dialog_directory, g_open_file_dialog_directory_w, H_open_file_dialog_directory,
+ S_set S_open_file_dialog_directory, g_set_open_file_dialog_directory_w, 0, 0, 1, 0, pl_s, pl_ss);
+
+ Xen_define_typed_dilambda(S_peak_env_dir, g_peak_env_dir_w, H_peak_env_dir,
+ S_set S_peak_env_dir, g_set_peak_env_dir_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_temp_dir, g_temp_dir_w, H_temp_dir,
+ S_set S_temp_dir, g_set_temp_dir_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_ladspa_dir, g_ladspa_dir_w, H_ladspa_dir,
+ S_set S_ladspa_dir, g_set_ladspa_dir_w, 0, 0, 1, 0, pl_s, pl_ss);
+
+#if (!DISABLE_DEPRECATED)
+#define H_start_hook S_start_hook " (name): called upon start-up. If it returns " PROC_TRUE ", snd exits immediately."
+ start_hook = Xen_define_hook(S_start_hook, "(make-hook 'name)", 1, H_start_hook);
+#endif
+
+ #define H_before_exit_hook S_before_exit_hook " (): called upon exit. If it returns " PROC_TRUE ", Snd does not exit."
+
+ before_exit_hook = Xen_define_hook(S_before_exit_hook, "(make-hook)", 0, H_before_exit_hook);
+
#define H_exit_hook S_exit_hook " (): called upon exit. This can be used to perform cleanup activities."
-
- exit_hook = XEN_DEFINE_HOOK(S_exit_hook, 0, H_exit_hook);
-
- #define H_after_save_state_hook S_after_save_state_hook " (filename): called after Snd state has been saved; \
-filename is the save state file."
- after_save_state_hook = XEN_DEFINE_HOOK(S_after_save_state_hook, 1, H_after_save_state_hook);
-
- #define H_before_save_state_hook S_before_save_state_hook " (filename): called before Snd state is saved. If \
-the hook functions return " PROC_TRUE ", the save state process opens 'filename' for appending, rather than truncating."
- before_save_state_hook = XEN_DEFINE_HOOK(S_before_save_state_hook, 1, H_before_save_state_hook);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_script_arg, g_script_arg_w, H_script_arg, S_setB S_script_arg, g_set_script_arg_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE(S_script_args, g_script_args_w, 0, 0, 0, H_script_args);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_window_x, g_window_x_w, H_window_x,
- S_setB S_window_x, g_set_window_x_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_window_y, g_window_y_w, H_window_y,
- S_setB S_window_y, g_set_window_y_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_window_width, g_window_width_w, H_window_width,
- S_setB S_window_width, g_set_window_width_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_window_height, g_window_height_w, H_window_height,
- S_setB S_window_height, g_set_window_height_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_audio_output_device, g_audio_output_device_w, H_audio_output_device,
- S_setB S_audio_output_device, g_set_audio_output_device_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_audio_input_device, g_audio_input_device_w, H_audio_input_device,
- S_setB S_audio_input_device, g_set_audio_input_device_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_minibuffer_history_length, g_minibuffer_history_length_w, H_minibuffer_history_length,
- S_setB S_minibuffer_history_length, g_set_minibuffer_history_length_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_auto_resize, g_auto_resize_w, H_auto_resize,
- S_setB S_auto_resize, g_set_auto_resize_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_color_cutoff, g_color_cutoff_w, H_color_cutoff,
- S_setB S_color_cutoff, g_set_color_cutoff_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_color_inverted, g_color_inverted_w, H_color_inverted,
- S_setB S_color_inverted, g_set_color_inverted_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_color_scale, g_color_scale_w, H_color_scale,
- S_setB S_color_scale, g_set_color_scale_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_selection_creates_region, g_selection_creates_region_w, H_selection_creates_region,
- S_setB S_selection_creates_region, g_set_selection_creates_region_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_print_length, g_print_length_w, H_print_length,
- S_setB S_print_length, g_set_print_length_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_show_indices, g_show_indices_w, H_show_indices,
- S_setB S_show_indices, g_set_show_indices_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_trap_segfault, g_trap_segfault_w, H_trap_segfault,
- S_setB S_trap_segfault, g_set_trap_segfault_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_relative_panes, g_with_relative_panes_w, H_with_relative_panes,
- S_setB S_with_relative_panes, g_set_with_relative_panes_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_background_processes, g_with_background_processes_w, H_with_background_processes,
- S_setB S_with_background_processes, g_set_with_background_processes_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_file_monitor, g_with_file_monitor_w, H_with_file_monitor,
- S_setB S_with_file_monitor, g_set_with_file_monitor_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_tiny_font, g_tiny_font_w, H_tiny_font,
- S_setB S_tiny_font, g_set_tiny_font_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_peaks_font, g_peaks_font_w, H_peaks_font,
- S_setB S_peaks_font, g_set_peaks_font_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_bold_peaks_font, g_bold_peaks_font_w, H_bold_peaks_font,
- S_setB S_bold_peaks_font, g_set_bold_peaks_font_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_axis_label_font, g_axis_label_font_w, H_axis_label_font,
- S_setB S_axis_label_font, g_set_axis_label_font_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_axis_numbers_font, g_axis_numbers_font_w, H_axis_numbers_font,
- S_setB S_axis_numbers_font, g_set_axis_numbers_font_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_listener_font, g_listener_font_w, H_listener_font,
- S_setB S_listener_font, g_set_listener_font_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_just_sounds, g_just_sounds_w, H_just_sounds,
- S_setB S_just_sounds, g_set_just_sounds_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_play_arrow_size, g_play_arrow_size_w, H_play_arrow_size,
- S_setB S_play_arrow_size, g_set_play_arrow_size_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_inset_graph, g_with_inset_graph_w, H_with_inset_graph,
- S_setB S_with_inset_graph, g_set_with_inset_graph_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_smpte_label, g_with_smpte_label_w, H_with_smpte_label,
- S_setB S_with_smpte_label, g_set_with_smpte_label_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_pointer_focus, g_with_pointer_focus_w, H_with_pointer_focus,
- S_setB S_with_pointer_focus, g_set_with_pointer_focus_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE(S_snd_version, g_snd_version_w, 0, 0, 0, H_snd_version);
- XEN_DEFINE_PROCEDURE(S_color_orientation_dialog, g_color_orientation_dialog_w, 0, 1, 0, H_color_orientation_dialog);
- XEN_DEFINE_PROCEDURE(S_transform_dialog, g_transform_dialog_w, 0, 1, 0, H_transform_dialog);
- XEN_DEFINE_PROCEDURE(S_print_dialog, g_print_dialog_w, 0, 2, 0, H_print_dialog);
- XEN_DEFINE_PROCEDURE(S_preferences_dialog, g_preferences_dialog_w, 0, 0, 0, H_preferences_dialog);
- XEN_DEFINE_PROCEDURE(S_recorder_dialog, g_recorder_dialog_w, 0, 0, 0, H_recorder_dialog);
- XEN_DEFINE_PROCEDURE(S_abort, g_abort_w, 0, 0, 0, H_abort);
- XEN_DEFINE_PROCEDURE(S_c_g, g_abortq_w, 0, 0, 0, H_abortQ);
+
+ exit_hook = Xen_define_hook(S_exit_hook, "(make-hook)", 0, H_exit_hook);
+
+ #define H_after_save_state_hook S_after_save_state_hook " (name): called after Snd state has been saved; filename is the save state file."
+ after_save_state_hook = Xen_define_hook(S_after_save_state_hook, "(make-hook 'name)", 1, H_after_save_state_hook);
+
+ #define H_before_save_state_hook S_before_save_state_hook " (name): called before Snd state is saved. If \
+the hook functions return " PROC_TRUE ", the save state process opens the file 'name' for appending, rather than truncating."
+ before_save_state_hook = Xen_define_hook(S_before_save_state_hook, "(make-hook 'name)", 1, H_before_save_state_hook);
+
+ Xen_define_typed_dilambda(S_script_arg, g_script_arg_w, H_script_arg,
+ S_set S_script_arg, g_set_script_arg_w, 0, 0, 1, 0, pl_i, pl_ii);
+ Xen_define_typed_procedure(S_script_args, g_script_args_w, 0, 0, 0, H_script_args, pl_p);
+
+ Xen_define_typed_dilambda(S_window_x, g_window_x_w, H_window_x,
+ S_set S_window_x, g_set_window_x_w, 0, 0, 1, 0, pl_i, pl_ii);
+ Xen_define_typed_dilambda(S_window_y, g_window_y_w, H_window_y,
+ S_set S_window_y, g_set_window_y_w, 0, 0, 1, 0, pl_i, pl_ii);
+ Xen_define_typed_dilambda(S_window_width, g_window_width_w, H_window_width,
+ S_set S_window_width, g_set_window_width_w, 0, 0, 1, 0, pl_i, pl_ii);
+ Xen_define_typed_dilambda(S_window_height, g_window_height_w, H_window_height,
+ S_set S_window_height, g_set_window_height_w, 0, 0, 1, 0, pl_i, pl_ii);
+
+ Xen_define_typed_dilambda(S_auto_resize, g_auto_resize_w, H_auto_resize,
+ S_set S_auto_resize, g_set_auto_resize_w, 0, 0, 1, 0, pl_b, pl_bb);
+ Xen_define_typed_dilambda(S_color_cutoff, g_color_cutoff_w, H_color_cutoff,
+ S_set S_color_cutoff, g_set_color_cutoff_w, 0, 0, 1, 0, pl_d, pl_dr);
+ Xen_define_typed_dilambda(S_color_inverted, g_color_inverted_w, H_color_inverted,
+ S_set S_color_inverted, g_set_color_inverted_w, 0, 0, 1, 0, pl_b, pl_bb);
+ Xen_define_typed_dilambda(S_color_scale, g_color_scale_w, H_color_scale,
+ S_set S_color_scale, g_set_color_scale_w, 0, 0, 1, 0, pl_d, pl_dr);
+
+ Xen_define_typed_dilambda(S_selection_creates_region, g_selection_creates_region_w, H_selection_creates_region,
+ S_set S_selection_creates_region, g_set_selection_creates_region_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_print_length, g_print_length_w, H_print_length,
+ S_set S_print_length, g_set_print_length_w, 0, 0, 1, 0, pl_i, pl_ii);
+ Xen_define_typed_dilambda(S_show_indices, g_show_indices_w, H_show_indices,
+ S_set S_show_indices, g_set_show_indices_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_with_relative_panes, g_with_relative_panes_w, H_with_relative_panes,
+ S_set S_with_relative_panes, g_set_with_relative_panes_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_with_background_processes, g_with_background_processes_w, H_with_background_processes,
+ S_set S_with_background_processes, g_set_with_background_processes_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_dilambda(S_with_file_monitor, g_with_file_monitor_w, H_with_file_monitor,
+ S_set S_with_file_monitor, g_set_with_file_monitor_w, 0, 0, 1, 0, pl_b, pl_bb);
+ Xen_define_typed_dilambda(S_tiny_font, g_tiny_font_w, H_tiny_font,
+ S_set S_tiny_font, g_set_tiny_font_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_peaks_font, g_peaks_font_w, H_peaks_font,
+ S_set S_peaks_font, g_set_peaks_font_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_bold_peaks_font, g_bold_peaks_font_w, H_bold_peaks_font,
+ S_set S_bold_peaks_font, g_set_bold_peaks_font_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_axis_label_font, g_axis_label_font_w, H_axis_label_font,
+ S_set S_axis_label_font, g_set_axis_label_font_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_axis_numbers_font, g_axis_numbers_font_w, H_axis_numbers_font,
+ S_set S_axis_numbers_font, g_set_axis_numbers_font_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_listener_font, g_listener_font_w, H_listener_font,
+ S_set S_listener_font, g_set_listener_font_w, 0, 0, 1, 0, pl_s, pl_ss);
+ Xen_define_typed_dilambda(S_just_sounds, g_just_sounds_w, H_just_sounds,
+ S_set S_just_sounds, g_set_just_sounds_w, 0, 0, 1, 0, pl_b, pl_bb);
+ Xen_define_typed_dilambda(S_play_arrow_size, g_play_arrow_size_w, H_play_arrow_size,
+ S_set S_play_arrow_size, g_set_play_arrow_size_w, 0, 0, 1, 0, pl_i, pl_ii);
+ Xen_define_typed_dilambda(S_with_inset_graph, g_with_inset_graph_w, H_with_inset_graph,
+ S_set S_with_inset_graph, g_set_with_inset_graph_w, 0, 0, 1, 0, pl_b, pl_bb);
+ Xen_define_typed_dilambda(S_with_interrupts, g_with_interrupts_w, H_with_interrupts,
+ S_set S_with_interrupts, g_set_with_interrupts_w, 0, 0, 1, 0, pl_b, pl_bb);
+ Xen_define_typed_dilambda(S_with_smpte_label, g_with_smpte_label_w, H_with_smpte_label,
+ S_set S_with_smpte_label, g_set_with_smpte_label_w, 0, 0, 1, 0, pl_b, pl_bb);
+ Xen_define_typed_dilambda(S_with_pointer_focus, g_with_pointer_focus_w, H_with_pointer_focus,
+ S_set S_with_pointer_focus, g_set_with_pointer_focus_w, 0, 0, 1, 0, pl_b, pl_bb);
+
+ Xen_define_typed_procedure(S_snd_version, g_snd_version_w, 0, 0, 0, H_snd_version, pl_s);
+ Xen_define_typed_procedure(S_color_orientation_dialog,g_color_orientation_dialog_w, 0, 1, 0, H_color_orientation_dialog, pl_zb);
+ Xen_define_typed_procedure(S_transform_dialog, g_transform_dialog_w, 0, 1, 0, H_transform_dialog, pl_zb);
+ Xen_define_typed_procedure(S_print_dialog, g_print_dialog_w, 0, 2, 0, H_print_dialog, pl_zbb);
+ Xen_define_typed_procedure(S_preferences_dialog, g_preferences_dialog_w, 0, 0, 0, H_preferences_dialog, pl_z);
+ Xen_define_procedure(S_abort, g_abort_w, 0, 0, 0, H_abort);
+#if (!HAVE_SCHEME)
+ Xen_define_procedure(S_c_g, g_abortq_w, 0, 0, 0, H_abortQ);
+#endif
+
+#if HAVE_SCHEME
+ s7_symbol_set_documentation(s7, ss->temp_dir_symbol, "*temp-dir*: name of directory for temp files (or #f=null)");
+ s7_symbol_set_documentation(s7, ss->save_dir_symbol, "*save-dir*: name of directory for saved state data (or #f=null)");
+ s7_symbol_set_documentation(s7, ss->ladspa_dir_symbol, "*ladspa-dir*: name of directory for ladspa plugin libraries");
+ s7_symbol_set_documentation(s7, ss->peak_env_dir_symbol, "*peak-env-dir*: name of directory for peak env files (or #f=null)");
+ s7_symbol_set_documentation(s7, ss->listener_font_symbol, "*listener-font*: font used by the lisp listener");
+ s7_symbol_set_documentation(s7, ss->axis_label_font_symbol, "*axis-label-font*: font used for axis labels");
+ s7_symbol_set_documentation(s7, ss->axis_numbers_font_symbol, "*axis-numbers-font*: font used for axis numbers");
+ s7_symbol_set_documentation(s7, ss->tiny_font_symbol, "*tiny-font*: font use for some info in the graphs");
+ s7_symbol_set_documentation(s7, ss->peaks_font_symbol, "*peaks-font*: normal font used by fft peak display");
+ s7_symbol_set_documentation(s7, ss->bold_peaks_font_symbol, "*bold-peaks-font*: bold font used by fft peak display");
+ s7_symbol_set_documentation(s7, ss->with_inset_graph_symbol, "*with-inset-graph*: if #t, display the inset graph in the time domain section.");
+ s7_symbol_set_documentation(s7, ss->with_pointer_focus_symbol, "*with-pointer-focus*: if #t, activate the text or graph widget beneath the mouse.");
+ s7_symbol_set_documentation(s7, ss->with_smpte_label_symbol, "*with-smpte-label*: if #t, display the SMPTE data in the time domain section.");
+ s7_symbol_set_documentation(s7, ss->with_interrupts_symbol, "*with-interrupts*: if #t, check for GUI events during computations.");
+ s7_symbol_set_documentation(s7, ss->color_scale_symbol, "*color-scale*: darkness setting for colormaps (0.5)");
+ s7_symbol_set_documentation(s7, ss->color_cutoff_symbol, "*color-cutoff*: color map cutoff point (default .003).");
+ s7_symbol_set_documentation(s7, ss->color_inverted_symbol, "*color-inverted*: whether the colormap in operation should be inverted");
+ s7_symbol_set_documentation(s7, ss->auto_resize_symbol, "*auto-resize*: #t if Snd can change its main window size as it pleases");
+ s7_symbol_set_documentation(s7, ss->print_length_symbol, "*print-length*: number of vector elements to print in the listener (12)");
+ s7_symbol_set_documentation(s7, ss->selection_creates_region_symbol, "*selection-creates-region*: #t if a region should be created each time a selection is made.");
+ s7_symbol_set_documentation(s7, ss->save_state_file_symbol, "*save-state-file*: the name of the saved state file (\"saved-snd.scm\")");
+ s7_symbol_set_documentation(s7, ss->with_background_processes_symbol, "*with-background-processes*: #t if Snd should use background (idle time) processing");
+ s7_symbol_set_documentation(s7, ss->with_file_monitor_symbol, "*with-file-monitor*: #t if the file alteration monitor is active");
+ s7_symbol_set_documentation(s7, ss->show_indices_symbol, "*show-indices*: #t if sound name should be preceded by its index in the sound display.");
+ s7_symbol_set_documentation(s7, ss->just_sounds_symbol, "*just-sounds*: the 'just sounds' choice in the file chooser dialog");
+ s7_symbol_set_documentation(s7, ss->play_arrow_size_symbol, "*play-arrow-size*: the size of the play triangles");
+ s7_symbol_set_documentation(s7, ss->with_relative_panes_symbol, "*with-relative-panes*: #t if multichannel sounds should try to maintain relative pane sizes");
+ s7_symbol_set_documentation(s7, ss->open_file_dialog_directory_symbol, "*open-file-dialog-directory*: name of directory for initial open file dialog search");
+
+ s7_symbol_set_access(s7, ss->temp_dir_symbol, s7_make_function(s7, "[acc-" S_temp_dir "]", acc_temp_dir, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->save_dir_symbol, s7_make_function(s7, "[acc-" S_save_dir "]", acc_save_dir, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->ladspa_dir_symbol, s7_make_function(s7, "[acc-" S_ladspa_dir "]", acc_ladspa_dir, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->peak_env_dir_symbol, s7_make_function(s7, "[acc-" S_peak_env_dir "]", acc_peak_env_dir, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->listener_font_symbol, s7_make_function(s7, "[acc-" S_listener_font "]", acc_listener_font, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->axis_label_font_symbol, s7_make_function(s7, "[acc-" S_axis_label_font "]", acc_axis_label_font, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->axis_numbers_font_symbol, s7_make_function(s7, "[acc-" S_axis_numbers_font "]", acc_axis_numbers_font, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->tiny_font_symbol, s7_make_function(s7, "[acc-" S_tiny_font "]", acc_tiny_font, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->peaks_font_symbol, s7_make_function(s7, "[acc-" S_peaks_font "]", acc_peaks_font, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->bold_peaks_font_symbol, s7_make_function(s7, "[acc-" S_bold_peaks_font "]", acc_bold_peaks_font, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_inset_graph_symbol, s7_make_function(s7, "[acc-" S_with_inset_graph "]", acc_with_inset_graph, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_pointer_focus_symbol, s7_make_function(s7, "[acc-" S_with_pointer_focus "]", acc_with_pointer_focus, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_smpte_label_symbol, s7_make_function(s7, "[acc-" S_with_smpte_label "]", acc_with_smpte_label, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_interrupts_symbol, s7_make_function(s7, "[acc-" S_with_interrupts "]", acc_with_interrupts, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->color_scale_symbol, s7_make_function(s7, "[acc-" S_color_scale "]", acc_color_scale, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->color_cutoff_symbol, s7_make_function(s7, "[acc-" S_color_cutoff "]", acc_color_cutoff, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->color_inverted_symbol, s7_make_function(s7, "[acc-" S_color_inverted "]", acc_color_inverted, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->auto_resize_symbol, s7_make_function(s7, "[acc-" S_auto_resize "]", acc_auto_resize, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->print_length_symbol, s7_make_function(s7, "[acc-" S_print_length "]", acc_print_length, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->selection_creates_region_symbol, s7_make_function(s7, "[acc-" S_selection_creates_region "]", acc_selection_creates_region, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->save_state_file_symbol, s7_make_function(s7, "[acc-" S_save_state_file "]", acc_save_state_file, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_background_processes_symbol, s7_make_function(s7, "[acc-" S_with_background_processes "]", acc_with_background_processes, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_file_monitor_symbol, s7_make_function(s7, "[acc-" S_with_file_monitor "]", acc_with_file_monitor, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_indices_symbol, s7_make_function(s7, "[acc-" S_show_indices "]", acc_show_indices, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->just_sounds_symbol, s7_make_function(s7, "[acc-" S_just_sounds "]", acc_just_sounds, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->play_arrow_size_symbol, s7_make_function(s7, "[acc-" S_play_arrow_size "]", acc_play_arrow_size, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_relative_panes_symbol, s7_make_function(s7, "[acc-" S_with_relative_panes "]", acc_with_relative_panes, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->open_file_dialog_directory_symbol, s7_make_function(s7, "[acc-" S_open_file_dialog_directory "]", acc_open_file_dialog_directory, 2, 0, false, "accessor"));
+#endif
}
diff --git a/snd-marks.c b/snd-marks.c
index a2b4b97..75e1eab 100644
--- a/snd-marks.c
+++ b/snd-marks.c
@@ -5,7 +5,7 @@ struct mark {
char *name;
int id, sync;
bool visible;
- XEN properties;
+ Xen properties;
int properties_gc_loc;
};
@@ -44,7 +44,7 @@ static mark *make_mark_1(mus_long_t samp, const char *name, int id, int sc)
mp->id = id;
set_mark_sync(mp, sc);
mp->properties_gc_loc = NOT_A_GC_LOC;
- mp->properties = XEN_FALSE;
+ mp->properties = Xen_false;
return(mp);
}
@@ -70,7 +70,7 @@ static mark *free_mark(mark *mp)
{
snd_unprotect_at(mp->properties_gc_loc);
mp->properties_gc_loc = NOT_A_GC_LOC;
- mp->properties = XEN_FALSE;
+ mp->properties = Xen_false;
}
free(mp);
}
@@ -120,7 +120,7 @@ static mark *map_over_marks_with_int(chan_info *cp, mark *(*func)(chan_info *ncp
{
ed_list *ed;
ed = cp->edits[cp->edit_ctr];
- if (ed->marks)
+ if ((ed) && (ed->marks))
{
int marks;
mark **mps;
@@ -206,20 +206,6 @@ mus_long_t mark_id_to_sample(int id)
}
-static mark *find_named_mark_1(chan_info *cp, mark *mp, void *uname)
-{
- char *name = (char *)uname;
- if ((mp->name) && (mus_strcmp(mp->name, name))) return(mp);
- else return(NULL);
-}
-
-
-static mark *find_named_mark(chan_info *cp, const char *name)
-{
- return(map_over_marks(cp, find_named_mark_1, (void *)name, READ_FORWARD));
-}
-
-
static mark *find_previous_mark_1(chan_info *cp, mark *mp, void *m)
{
if (mp->samp < (*((mus_long_t *)m)))
@@ -263,19 +249,19 @@ void marks_off(chan_info *cp)
static void show_mark(chan_info *cp, mark *mp, bool show);
-static XEN draw_mark_hook;
+static Xen draw_mark_hook;
static void draw_mark_1(chan_info *cp, mark *mp, bool show)
{
/* fields are samp and name */
- if (!(cp->graph_time_p)) return;
- if (XEN_HOOKED(draw_mark_hook))
+ if (!(cp->graph_time_on)) return;
+ if (Xen_hook_has_list(draw_mark_hook))
{
- XEN res = XEN_FALSE;
+ Xen res;
res = run_progn_hook(draw_mark_hook,
- XEN_LIST_1(new_xen_mark(mp->id)),
+ Xen_list_1(new_xen_mark(mp->id)),
S_draw_mark_hook);
- if (XEN_TRUE_P(res))
+ if (Xen_is_true(res))
{
mp->visible = show;
return;
@@ -314,7 +300,7 @@ static mark *hit_mark_1(chan_info *cp, mark *mp, void *m)
if (mp->samp < ap->losamp) return(NULL);
if (mp->samp > ap->hisamp) return(md->all_done); /* grf_x clips so we can be confused by off-screen marks */
- mx = grf_x((double)(mp->samp) / (double)SND_SRATE(cp->sound), cp->axis);
+ mx = grf_x((double)(mp->samp) / (double)snd_srate(cp->sound), cp->axis);
if (mx > (md->x + mark_tag_width(ss))) return(md->all_done); /* past it */
if (mx < (md->x - mark_tag_width(ss))) return(NULL); /* before it */
if (mp->name == NULL) /* check y if unnamed */
@@ -342,7 +328,7 @@ static mark *hit_mark_triangle_1(chan_info *cp, mark *mp, void *m)
if (mp->samp < ap->losamp) return(NULL);
if (mp->samp > ap->hisamp) return(md->all_done); /* grf_x clips so we can be confused by off-screen marks */
- mx = grf_x((double)(mp->samp) / (double)SND_SRATE(cp->sound), cp->axis);
+ mx = grf_x((double)(mp->samp) / (double)snd_srate(cp->sound), cp->axis);
if (mx > (md->x + HIT_SLOP)) return(md->all_done);
if ((mx + play_arrow_size(ss) + HIT_SLOP) < md->x) return(NULL);
y = md->y - ap->y_axis_y0 - play_arrow_size(ss);
@@ -379,8 +365,8 @@ mark *hit_mark_triangle(chan_info *cp, int x, int y)
}
-static XEN mark_drag_hook;
-static XEN mark_hook; /* add, delete, move */
+static Xen mark_drag_hook;
+static Xen mark_hook; /* add, delete, move */
static bool watching_mouse = false; /* this is tracking axis moves */
static int last_mouse_x = 0;
@@ -414,7 +400,9 @@ static void start_mark_watching(chan_info *cp, mark *mp)
static void cancel_mark_watch(chan_info *cp)
{
+#if (!USE_NO_GUI)
if (watch_mouse_button) TIMEOUT_REMOVE(watch_mouse_button);
+#endif
watch_mouse_button = 0;
watching_mouse = false;
moving_mark = NULL;
@@ -427,8 +415,10 @@ static bool move_mark_1(chan_info *cp, mark *mp, int x)
int nx;
mus_long_t samps;
bool redraw;
+
ap = cp->axis;
redraw = (!watching_mouse);
+
if ((x > ap->x_axis_x1) || (x < ap->x_axis_x0))
{
if (watching_mouse)
@@ -437,7 +427,7 @@ static bool move_mark_1(chan_info *cp, mark *mp, int x)
((x > ap->x_axis_x1) && (ap->x1 == ap->xmax)))
return(false);
}
- nx = move_axis(cp, ap, x);
+ nx = move_axis(cp, x);
if (!watching_mouse) start_mark_watching(cp, mp);
}
else
@@ -450,14 +440,18 @@ static bool move_mark_1(chan_info *cp, mark *mp, int x)
redraw = false;
}
}
- mp->samp = (mus_long_t)(ungrf_x(ap, nx) * SND_SRATE(cp->sound));
+
+ mp->samp = (mus_long_t)(ungrf_x(ap, nx) * snd_srate(cp->sound));
if (mp->samp < 0) mp->samp = 0;
- samps = CURRENT_SAMPLES(cp);
+
+ samps = current_samples(cp);
if (mp->samp > samps) mp->samp = samps;
- if (XEN_HOOKED(mark_drag_hook))
- run_hook(mark_drag_hook,
- XEN_LIST_1(new_xen_mark(mp->id)),
- S_mark_drag_hook);
+
+ if (Xen_hook_has_list(mark_drag_hook))
+ ss->squelch_mark_drag_info = Xen_is_true(run_progn_hook(mark_drag_hook,
+ Xen_list_1(new_xen_mark(mp->id)),
+ S_mark_drag_hook));
+ else ss->squelch_mark_drag_info = false;
return(redraw);
}
@@ -477,7 +471,8 @@ static void sort_marks(chan_info *cp)
{
ed_list *ed;
ed = cp->edits[cp->edit_ctr];
- qsort((void *)(ed->marks), ed->mark_ctr + 1, sizeof(mark *), compare_mark_samps);
+ if (ed)
+ qsort((void *)(ed->marks), ed->mark_ctr + 1, sizeof(mark *), compare_mark_samps);
}
@@ -486,16 +481,16 @@ typedef enum {MARK_ADD, MARK_DELETE, MARK_MOVE, MARKS_DELETE, MARK_RELEASE} mark
static void run_mark_hook(chan_info *cp, int id, mark_hook_reason_t reason)
{
/* called after the mark list has been made consistent */
- if (XEN_HOOKED(mark_hook))
+ if (Xen_hook_has_list(mark_hook))
run_hook(mark_hook,
- XEN_LIST_4(new_xen_mark(id),
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_INT((int)reason)),
+ Xen_list_4(new_xen_mark(id),
+ C_int_to_Xen_sound(cp->sound->index),
+ C_int_to_Xen_integer(cp->chan),
+ C_int_to_Xen_integer((int)reason)),
S_mark_hook);
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
}
@@ -567,12 +562,11 @@ bool delete_mark_samp(mus_long_t samp, chan_info *cp)
ed = cp->edits[cp->edit_ctr];
if (ed->marks)
{
- int i;
mark **mps;
mps = ed->marks;
if (mps)
{
- int edm;
+ int i, edm;
edm = ed->mark_ctr;
for (i = 0; i <= edm; i++)
{
@@ -656,11 +650,11 @@ static void delete_marks(chan_info *cp)
ed = cp->edits[cp->edit_ctr];
if (ed->marks)
{
- int i;
mark **mps;
mps = ed->marks;
if (mps)
{
+ int i;
for (i = 0; i < ed->mark_size; i++)
{
mark *mp;
@@ -789,7 +783,7 @@ static mark *find_nth_mark(chan_info *cp, int count)
mark *mp = NULL;
if ((!cp) || (!cp->edits[cp->edit_ctr]->marks)) return(NULL);
if (count > 0) c = count; else c = -count;
- samp = CURSOR(cp);
+ samp = cursor_sample(cp);
for (i = 0; i < c; i++)
{
if (count > 0) mp = find_next_mark(samp, cp);
@@ -812,12 +806,28 @@ bool goto_mark(chan_info *cp, int count)
}
+#if 0
+static mark *find_named_mark_1(chan_info *cp, mark *mp, void *uname)
+{
+ char *name = (char *)uname;
+ if ((mp->name) && (mus_strcmp(mp->name, name))) return(mp);
+ else return(NULL);
+}
+
+
+static mark *find_named_mark(chan_info *cp, const char *name)
+{
+ return(map_over_marks(cp, find_named_mark_1, (void *)name, READ_FORWARD));
+}
+
+
void goto_named_mark(chan_info *cp, const char *name)
{
mark *mp;
mp = find_named_mark(cp, name);
if (mp) cursor_moveto(cp, mp->samp);
}
+#endif
static mark *active_mark_1(chan_info *cp, mark *mp, void *ignore)
@@ -955,7 +965,7 @@ bool mark_define_region(chan_info *cp, int count)
{
mus_long_t beg;
mark *mp;
- beg = CURSOR(cp);
+ beg = cursor_sample(cp);
mp = find_nth_mark(cp, count);
if (mp)
{
@@ -1010,7 +1020,7 @@ void reverse_marks(chan_info *cp, mus_long_t beg, mus_long_t dur) /* beg -1 for
mps = ed->marks;
if (beg == -1)
{
- m = make_mark_1(CURRENT_SAMPLES(cp) - 1, NULL, 0, 0);
+ m = make_mark_1(current_samples(cp) - 1, NULL, 0, 0);
map_over_marks(cp, reverse_mark_1, (void *)m, READ_FORWARD);
free_mark(m);
}
@@ -1315,14 +1325,14 @@ void set_mark_control(chan_info *cp, mark *mp, int key_state)
if ((mark_sd->mark_ctr > 1) &&
(mark_sd->marks[0] != mp))
{
- mark *tm;
- int loc = 1;
- mus_long_t ts;
- chan_info *tc;
+ int loc;
for (loc = 1; loc < mark_sd->mark_ctr; loc++)
if (mark_sd->marks[loc] == mp) break;
if (loc < mark_sd->mark_ctr)
{
+ chan_info *tc;
+ mus_long_t ts;
+ mark *tm;
tm = mark_sd->marks[0];
ts = mark_sd->initial_samples[0];
tc = mark_sd->chans[0];
@@ -1423,7 +1433,7 @@ static void erase_and_draw_grf_points(mark_context *ms, chan_info *cp, int nj)
ax = draw_cp->ax;
#if USE_GTK
- ss->cr = MAKE_CAIRO(ax->wn);
+ ss->cr = make_cairo(ax->wn);
#endif
undraw_gc = erase_GC(draw_cp);
@@ -1446,7 +1456,7 @@ static void erase_and_draw_grf_points(mark_context *ms, chan_info *cp, int nj)
ax->gc = draw_gc;
#if USE_GTK
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
#endif
}
@@ -1470,7 +1480,7 @@ static void erase_and_draw_both_grf_points(mark_context *ms, chan_info *cp, int
ax = draw_cp->ax;
#if USE_GTK
- ss->cr = MAKE_CAIRO(ax->wn);
+ ss->cr = make_cairo(ax->wn);
#endif
undraw_gc = erase_GC(draw_cp);
@@ -1497,7 +1507,7 @@ static void erase_and_draw_both_grf_points(mark_context *ms, chan_info *cp, int
ax->gc = draw_gc;
#if USE_GTK
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
#endif
}
@@ -1534,7 +1544,7 @@ static bool move_syncd_mark(chan_info *cp, mark *m, int x)
erase_mark(ncp, mp);
mp->samp += diff;
if (mp->samp < 0) mp->samp = 0;
- samps = CURRENT_SAMPLES(ncp);
+ samps = current_samples(ncp);
if (mp->samp > samps) mp->samp = samps;
if (mark_control_clicked)
make_mark_graph(ncp, mark_sd->initial_samples[i], mp->samp, i);
@@ -1624,7 +1634,7 @@ void finish_moving_mark(chan_info *cp, mark *m) /* button release called from sn
if ((m->sync != 0) && (mark_sd))
{
int i;
- if (XEN_HOOKED(mark_hook))
+ if (Xen_hook_has_list(mark_hook))
for (i = 0; i < mark_sd->mark_ctr; i++)
run_mark_hook(mark_sd->chans[i], mark_sd->marks[i]->id, MARK_RELEASE);
if (mark_control_clicked)
@@ -1670,7 +1680,7 @@ void play_syncd_mark(chan_info *cp, mark *m)
sd = gather_syncd_marks(m->sync);
if ((sd) && (sd->mark_ctr > 0))
play_channels(sd->chans, sd->mark_ctr, sd->initial_samples, NULL, IN_BACKGROUND,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), false, "play sync'd mark", 0);
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), false, "play sync'd mark", 0);
if (sd) free_syncdata(sd);
}
@@ -1682,15 +1692,15 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
int j = 0;
mus_long_t i, k, samps;
axis_info *ap;
- double samples_per_pixel, samp, x, incr;
+ double samples_per_pixel, x;
int pixels;
snd_fd *sf = NULL;
int x_start, x_end;
- double start_time = 0.0, cur_srate = 1.0;
+ double start_time = 0.0, cur_srate;
sp = cp->sound;
ap = cp->axis;
- cur_srate = (double)SND_SRATE(sp);
+ cur_srate = (double)snd_srate(sp);
ap->losamp = (mus_long_t)(ap->x0 * cur_srate);
if (ap->losamp < 0) ap->losamp = 0;
if (ap->x0 != ((double)(ap->losamp) / cur_srate)) ap->losamp++;
@@ -1711,6 +1721,7 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
if ((samples_per_pixel < 5.0) &&
(samps < POINT_BUFFER_SIZE))
{
+ double incr;
sf = init_sample_read(ap->losamp, cp, READ_FORWARD);
if (sf == NULL) return;
incr = (double)1.0 / cur_srate;
@@ -1728,6 +1739,7 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
{
for (j = 0, i = ap->losamp, x = start_time; i <= ap->hisamp; i++, j++, x += incr)
{
+ double samp;
if ((i < initial_sample) || (i >= current_sample))
samp = read_sample(sf);
else samp = 0.0;
@@ -1738,7 +1750,7 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
}
else
{
- mus_float_t ymin, ymax, msamp;
+ mus_float_t ymin, ymax;
int xi;
double xf;
if (peak_env_usable(cp, samples_per_pixel, ap->hisamp, false, cp->edit_ctr, (samps > PEAK_ENV_CUTOFF)))
@@ -1750,7 +1762,7 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
* this is confusing code!
*/
double step, xk, xki;
- mus_long_t ii, kk;
+ mus_long_t ii;
peak_env_info *ep;
ep = cp->edits[cp->edit_ctr]->peak_env;
step = samples_per_pixel / (mus_float_t)(ep->samps_per_bin);
@@ -1764,6 +1776,7 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
xki = (double)(ap->losamp);
while (i <= ap->hisamp)
{
+ mus_long_t kk;
k = (mus_long_t)xf;
kk = (mus_long_t)(xf + step);
if (((current_sample >= initial_sample) &&
@@ -1813,6 +1826,7 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
}
else
{
+ mus_float_t msamp;
sf = init_sample_read(ap->losamp, cp, READ_FORWARD);
if (sf == NULL) return;
j = 0; /* graph point counter */
@@ -1823,7 +1837,7 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
ymax = MAX_INIT;
if (current_sample < initial_sample)
{
- for (i = ap->losamp, xf = 0.0; i <= ap->hisamp; i++)
+ for (i = ap->losamp; i <= ap->hisamp; i++)
{
if (i == current_sample)
for (k = current_sample; k < initial_sample; k++)
@@ -1882,7 +1896,7 @@ static void make_mark_graph(chan_info *cp, mus_long_t initial_sample, mus_long_t
static void show_mark(chan_info *cp, mark *mp, bool show)
{
- int len, top, cx, y0, y1;
+ int top, cx, y0, y1;
axis_info *ap;
graphics_context *ax;
@@ -1897,15 +1911,16 @@ static void show_mark(chan_info *cp, mark *mp, bool show)
y1 = top;
y0 = ap->y_axis_y0;
if (mp->name) top += 10;
- cx = grf_x((double)(mp->samp) / (double)SND_SRATE(cp->sound), ap);
+ cx = grf_x((double)(mp->samp) / (double)snd_srate(cp->sound), ap);
ax = mark_tag_context(cp);
#if USE_GTK
- ss->cr = MAKE_CAIRO(ax->wn);
+ ss->cr = make_cairo(ax->wn);
#endif
if (mp->name)
{
+ int len;
#if USE_MOTIF
ax->current_font = ss->peaks_fontstruct->fid;
XSetFont(ax->dp, ax->gc, ss->peaks_fontstruct->fid);
@@ -1921,7 +1936,7 @@ static void show_mark(chan_info *cp, mark *mp, bool show)
2 * mark_tag_width(ss), mark_tag_height(ss));
draw_line(ax, cx, top + 4, cx, y0);
- if (mp->samp != CURSOR(cp))
+ if (mp->samp != cursor_sample(cp))
fill_polygon(ax, 4,
cx, y0,
cx + play_arrow_size(ss), y0 + play_arrow_size(ss),
@@ -1929,7 +1944,7 @@ static void show_mark(chan_info *cp, mark *mp, bool show)
cx, y0);
mp->visible = show;
#if USE_GTK
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
copy_context(cp);
#endif
@@ -1949,53 +1964,53 @@ typedef struct {
} xen_mark;
-#define XEN_TO_XEN_MARK(arg) ((xen_mark *)XEN_OBJECT_REF(arg))
+#define Xen_to_xen_mark(arg) ((xen_mark *)Xen_object_ref(arg))
-int xen_mark_to_int(XEN n)
+int xen_mark_to_int(Xen n)
{
xen_mark *mx;
- mx = XEN_TO_XEN_MARK(n);
+ mx = Xen_to_xen_mark(n);
return(mx->n);
}
-static XEN_OBJECT_TYPE xen_mark_tag;
+static Xen_object_type_t xen_mark_tag;
-bool xen_mark_p(XEN obj)
+bool xen_is_mark(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, xen_mark_tag));
+ return(Xen_c_object_is_type(obj, xen_mark_tag));
}
static void xen_mark_free(xen_mark *v) {if (v) free(v);}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(xen_mark, free_xen_mark, xen_mark_free)
+Xen_wrap_free(xen_mark, free_xen_mark, xen_mark_free)
static char *xen_mark_to_string(xen_mark *v)
{
- #define XEN_MARK_PRINT_BUFFER_SIZE 64
+ #define MARK_PRINT_BUFFER_SIZE 64
char *buf;
if (v == NULL) return(NULL);
- buf = (char *)calloc(XEN_MARK_PRINT_BUFFER_SIZE, sizeof(char));
- snprintf(buf, XEN_MARK_PRINT_BUFFER_SIZE, "#<mark %d>", v->n);
+ buf = (char *)calloc(MARK_PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, MARK_PRINT_BUFFER_SIZE, "#<mark %d>", v->n);
return(buf);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(xen_mark, print_xen_mark, xen_mark_to_string)
+Xen_wrap_print(xen_mark, print_xen_mark, xen_mark_to_string)
#if HAVE_FORTH || HAVE_RUBY
-static XEN g_xen_mark_to_string(XEN obj)
+static Xen g_xen_mark_to_string(Xen obj)
{
char *vstr;
- XEN result;
+ Xen result;
#define S_xen_mark_to_string "mark->string"
- XEN_ASSERT_TYPE(XEN_MARK_P(obj), obj, XEN_ONLY_ARG, S_xen_mark_to_string, "a mark");
+ Xen_check_type(xen_is_mark(obj), obj, 1, S_xen_mark_to_string, "a mark");
- vstr = xen_mark_to_string(XEN_TO_XEN_MARK(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = xen_mark_to_string(Xen_to_xen_mark(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
@@ -2009,10 +2024,10 @@ static bool xen_mark_equalp(xen_mark *v1, xen_mark *v2)
(v1->n == v2->n));
}
-static XEN equalp_xen_mark(XEN obj1, XEN obj2)
+static Xen equalp_xen_mark(Xen obj1, Xen obj2)
{
- if ((!(XEN_MARK_P(obj1))) || (!(XEN_MARK_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(xen_mark_equalp(XEN_TO_XEN_MARK(obj1), XEN_TO_XEN_MARK(obj2))));
+ if ((!(xen_is_mark(obj1))) || (!(xen_is_mark(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(xen_mark_equalp(Xen_to_xen_mark(obj1), Xen_to_xen_mark(obj2))));
}
#endif
@@ -2026,14 +2041,14 @@ static xen_mark *xen_mark_make(int n)
}
-XEN new_xen_mark(int n)
+Xen new_xen_mark(int n)
{
xen_mark *mx;
if (n < 0)
- return(XEN_FALSE);
+ return(Xen_false);
mx = xen_mark_make(n);
- XEN_MAKE_AND_RETURN_OBJECT(xen_mark_tag, mx, 0, free_xen_mark);
+ return(Xen_make_object(xen_mark_tag, mx, 0, free_xen_mark));
}
@@ -2045,16 +2060,23 @@ static bool s7_xen_mark_equalp(void *obj1, void *obj2)
}
-static XEN s7_xen_mark_copy(s7_scheme *sc, s7_pointer obj)
+static Xen s7_xen_mark_copy(s7_scheme *sc, s7_pointer args)
{
+ s7_pointer obj;
int id;
- mark *m, *new_m;
- chan_info *cps[1];
+ mark *m;
+ chan_info *cps[1] = {NULL};
+ obj = s7_car(args);
id = xen_mark_to_int(obj);
m = find_mark_from_id(id, cps, AT_CURRENT_EDIT_POSITION);
- new_m = add_mark(m->samp, m->name, cps[0]);
- new_m->sync = m->sync;
- return(new_xen_mark(new_m->id));
+ if (m)
+ {
+ mark *new_m;
+ new_m = add_mark(m->samp, m->name, cps[0]);
+ new_m->sync = m->sync;
+ return(new_xen_mark(new_m->id));
+ }
+ return(obj);
}
#endif
@@ -2062,12 +2084,12 @@ static XEN s7_xen_mark_copy(s7_scheme *sc, s7_pointer obj)
static void init_xen_mark(void)
{
#if HAVE_SCHEME
- xen_mark_tag = XEN_MAKE_OBJECT_TYPE("<mark>", print_xen_mark, free_xen_mark, s7_xen_mark_equalp, NULL, NULL, NULL, NULL, s7_xen_mark_copy, NULL);
+ xen_mark_tag = s7_new_type_x(s7, "<mark>", print_xen_mark, free_xen_mark, s7_xen_mark_equalp, NULL, NULL, NULL, NULL, s7_xen_mark_copy, NULL, NULL);
#else
#if HAVE_RUBY
- xen_mark_tag = XEN_MAKE_OBJECT_TYPE("XenMark", sizeof(xen_mark));
+ xen_mark_tag = Xen_make_object_type("XenMark", sizeof(xen_mark));
#else
- xen_mark_tag = XEN_MAKE_OBJECT_TYPE("Mark", sizeof(xen_mark));
+ xen_mark_tag = Xen_make_object_type("Mark", sizeof(xen_mark));
#endif
#endif
@@ -2079,86 +2101,86 @@ static void init_xen_mark(void)
#endif
#if HAVE_RUBY
- rb_define_method(xen_mark_tag, "to_s", XEN_PROCEDURE_CAST print_xen_mark, 0);
- rb_define_method(xen_mark_tag, "eql?", XEN_PROCEDURE_CAST equalp_xen_mark, 1);
- rb_define_method(xen_mark_tag, "==", XEN_PROCEDURE_CAST equalp_xen_mark, 1);
- rb_define_method(xen_mark_tag, "to_str", XEN_PROCEDURE_CAST g_xen_mark_to_string, 0);
+ rb_define_method(xen_mark_tag, "to_s", Xen_procedure_cast print_xen_mark, 0);
+ rb_define_method(xen_mark_tag, "eql?", Xen_procedure_cast equalp_xen_mark, 1);
+ rb_define_method(xen_mark_tag, "==", Xen_procedure_cast equalp_xen_mark, 1);
+ rb_define_method(xen_mark_tag, "to_str", Xen_procedure_cast g_xen_mark_to_string, 0);
#endif
}
/* -------------------------------------------------------------------------------- */
-static XEN g_integer_to_mark(XEN n)
+static Xen g_integer_to_mark(Xen n)
{
#define H_integer_to_mark "(" S_integer_to_mark " n) returns a mark object corresponding to the given integer"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n), n, XEN_ONLY_ARG, S_integer_to_mark, "an integer");
- return(new_xen_mark(XEN_TO_C_INT(n)));
+ Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_mark, "an integer");
+ return(new_xen_mark(Xen_integer_to_C_int(n)));
}
-static XEN g_mark_to_integer(XEN n)
+static Xen g_mark_to_integer(Xen n)
{
#define H_mark_to_integer "(" S_mark_to_integer " id) returns the integer corresponding to the given mark object"
- XEN_ASSERT_TYPE(XEN_MARK_P(n), n, XEN_ONLY_ARG, S_mark_to_integer, "a mark");
- return(C_TO_XEN_INT(xen_mark_to_int(n)));
+ Xen_check_type(xen_is_mark(n), n, 1, S_mark_to_integer, "a mark");
+ return(C_int_to_Xen_integer(xen_mark_to_int(n)));
}
-static XEN snd_no_such_mark_error(const char *caller, XEN id)
+static Xen snd_no_such_mark_error(const char *caller, Xen id)
{
- XEN_ERROR(XEN_ERROR_TYPE("no-such-mark"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such mark ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("no-such-mark"),
+ Xen_list_3(C_string_to_Xen_string("~A: no such mark ~A"),
+ C_string_to_Xen_string(caller),
id));
- return(XEN_FALSE);
+ return(Xen_false);
}
typedef enum {MARK_SAMPLE, MARK_NAME, MARK_SYNC, MARK_HOME} mark_field_t;
-static XEN mark_get(XEN n, mark_field_t fld, XEN pos_n, const char *caller)
+static Xen mark_get(Xen n, mark_field_t fld, Xen pos_n, const char *caller)
{
int pos;
chan_info *ncp[1];
mark *m = NULL;
- pos = XEN_TO_C_INT_OR_ELSE(pos_n, AT_CURRENT_EDIT_POSITION);
+ pos = (Xen_is_integer(pos_n)) ? Xen_integer_to_C_int(pos_n) : AT_CURRENT_EDIT_POSITION;
- m = find_mark_from_id(XEN_MARK_TO_C_INT(n), ncp, pos);
+ m = find_mark_from_id(Xen_mark_to_C_int(n), ncp, pos);
if (m == NULL)
return(snd_no_such_mark_error(caller, n));
switch (fld)
{
case MARK_SAMPLE:
- return(C_TO_XEN_INT64_T(m->samp));
+ return(C_llong_to_Xen_llong(m->samp));
break;
case MARK_SYNC:
- return(C_TO_XEN_INT(m->sync));
+ return(C_int_to_Xen_integer(m->sync));
break;
case MARK_NAME:
if (m->name)
- return(C_TO_XEN_STRING(m->name));
- else return(C_TO_XEN_STRING(""));
+ return(C_string_to_Xen_string(m->name));
+ else return(C_string_to_Xen_string(""));
break;
case MARK_HOME:
- return(XEN_LIST_2(C_INT_TO_XEN_SOUND((ncp[0]->sound)->index),
- C_TO_XEN_INT(ncp[0]->chan)));
+ return(Xen_list_2(C_int_to_Xen_sound((ncp[0]->sound)->index),
+ C_int_to_Xen_integer(ncp[0]->chan)));
break;
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN mark_set(XEN mark_n, XEN val, mark_field_t fld, const char *caller)
+static Xen mark_set(Xen mark_n, Xen val, mark_field_t fld, const char *caller)
{
chan_info *cp[1];
mark *m;
- m = find_mark_from_id(XEN_MARK_TO_C_INT(mark_n), cp, AT_CURRENT_EDIT_POSITION);
+ m = find_mark_from_id(Xen_mark_to_C_int(mark_n), cp, AT_CURRENT_EDIT_POSITION);
if (m == NULL)
return(snd_no_such_mark_error(caller, mark_n));
@@ -2166,24 +2188,24 @@ static XEN mark_set(XEN mark_n, XEN val, mark_field_t fld, const char *caller)
{
case MARK_SAMPLE:
m->samp = mus_oclamp(0,
- XEN_TO_C_INT64_T_OR_ELSE(val, 0),
- CURRENT_SAMPLES(cp[0]));
+ (Xen_is_llong(val)) ? Xen_llong_to_C_llong(val) : 0,
+ current_samples(cp[0]));
sort_marks(cp[0]); /* update and re-sort current mark list */
run_mark_hook(cp[0], m->id, MARK_MOVE);
update_graph(cp[0]);
break;
case MARK_SYNC:
- if (XEN_INTEGER_P(val))
- set_mark_sync(m, XEN_TO_C_INT(val));
- else set_mark_sync(m, (int)XEN_TO_C_BOOLEAN(val));
+ if (Xen_is_integer(val))
+ set_mark_sync(m, Xen_integer_to_C_int(val));
+ else set_mark_sync(m, (int)Xen_boolean_to_C_bool(val));
break;
case MARK_NAME:
if (m->name) free(m->name);
- if (XEN_FALSE_P(val))
+ if (Xen_is_false(val))
m->name = NULL;
- else m->name = mus_strdup(XEN_TO_C_STRING(val));
+ else m->name = mus_strdup(Xen_string_to_C_string(val));
update_graph(cp[0]);
break;
@@ -2194,77 +2216,77 @@ static XEN mark_set(XEN mark_n, XEN val, mark_field_t fld, const char *caller)
}
-static XEN g_mark_p(XEN id_n)
+static Xen g_is_mark(Xen id_n)
{
- #define H_mark_p "(" S_mark_p " id): " PROC_TRUE " if mark is active"
- if (XEN_MARK_P(id_n))
- return(C_TO_XEN_BOOLEAN(find_mark_from_id(XEN_MARK_TO_C_INT(id_n), NULL, AT_CURRENT_EDIT_POSITION)));
- return(XEN_FALSE);
+ #define H_is_mark "(" S_is_mark " id): " PROC_TRUE " if mark is active"
+ if (xen_is_mark(id_n))
+ return(C_bool_to_Xen_boolean(find_mark_from_id(Xen_mark_to_C_int(id_n), NULL, AT_CURRENT_EDIT_POSITION)));
+ return(Xen_false);
}
-static XEN g_mark_sample(XEN mark_n, XEN pos_n)
+static Xen g_mark_sample(Xen mark_n, Xen pos_n)
{
#define H_mark_sample "(" S_mark_sample " id :optional pos): mark's location (sample number) at edit history pos"
- XEN_ASSERT_TYPE(XEN_MARK_P(mark_n), mark_n, XEN_ARG_1, S_mark_sample, "a mark");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(pos_n), pos_n, XEN_ARG_2, S_mark_sample, "an integer");
+ Xen_check_type(xen_is_mark(mark_n), mark_n, 1, S_mark_sample, "a mark");
+ Xen_check_type(Xen_is_integer_or_unbound(pos_n), pos_n, 2, S_mark_sample, "an integer");
return(mark_get(mark_n, MARK_SAMPLE, pos_n, S_mark_sample));
}
-static XEN g_set_mark_sample(XEN mark_n, XEN samp_n)
+static Xen g_set_mark_sample(Xen mark_n, Xen samp_n)
{
- XEN_ASSERT_TYPE(XEN_MARK_P(mark_n), mark_n, XEN_ARG_1, S_setB S_mark_sample, "a mark");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(samp_n) || XEN_NOT_BOUND_P(samp_n), samp_n, XEN_ARG_2, S_setB S_mark_sample, "an integer");
- return(mark_set(mark_n, samp_n, MARK_SAMPLE, S_setB S_mark_sample));
+ Xen_check_type(xen_is_mark(mark_n), mark_n, 1, S_set S_mark_sample, "a mark");
+ Xen_check_type(Xen_is_llong(samp_n) || !Xen_is_bound(samp_n), samp_n, 2, S_set S_mark_sample, "an integer");
+ return(mark_set(mark_n, samp_n, MARK_SAMPLE, S_set S_mark_sample));
}
-XEN g_mark_sync(XEN mark_n)
+Xen g_mark_sync(Xen mark_n)
{
#define H_mark_sync "(" S_mark_sync " id): mark's sync value (default: 0)"
- XEN_ASSERT_TYPE(XEN_MARK_P(mark_n), mark_n, XEN_ONLY_ARG, S_mark_sync, "a mark");
- return(mark_get(mark_n, MARK_SYNC, XEN_UNDEFINED, S_mark_sync));
+ Xen_check_type(xen_is_mark(mark_n), mark_n, 1, S_mark_sync, "a mark");
+ return(mark_get(mark_n, MARK_SYNC, Xen_undefined, S_mark_sync));
}
-XEN g_set_mark_sync(XEN mark_n, XEN sync_n)
+Xen g_set_mark_sync(Xen mark_n, Xen sync_n)
{
- XEN_ASSERT_TYPE(XEN_MARK_P(mark_n), mark_n, XEN_ARG_1, S_setB S_mark_sync, "a mark");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_P(sync_n), sync_n, XEN_ARG_2, S_setB S_mark_sync, "an integer");
- return(mark_set(mark_n, sync_n, MARK_SYNC, S_setB S_mark_sync));
+ Xen_check_type(xen_is_mark(mark_n), mark_n, 1, S_set S_mark_sync, "a mark");
+ Xen_check_type(Xen_is_integer_or_boolean(sync_n), sync_n, 2, S_set S_mark_sync, "an integer");
+ return(mark_set(mark_n, sync_n, MARK_SYNC, S_set S_mark_sync));
}
-static XEN g_mark_name(XEN mark_n)
+static Xen g_mark_name(Xen mark_n)
{
#define H_mark_name "(" S_mark_name " id): mark's name"
- XEN_ASSERT_TYPE(XEN_MARK_P(mark_n), mark_n, XEN_ONLY_ARG, S_mark_name, "a mark");
- return(mark_get(mark_n, MARK_NAME, XEN_UNDEFINED, S_mark_name));
+ Xen_check_type(xen_is_mark(mark_n), mark_n, 1, S_mark_name, "a mark");
+ return(mark_get(mark_n, MARK_NAME, Xen_undefined, S_mark_name));
}
-static XEN g_set_mark_name(XEN mark_n, XEN name)
+static Xen g_set_mark_name(Xen mark_n, Xen name)
{
- XEN_ASSERT_TYPE(XEN_MARK_P(mark_n), mark_n, XEN_ARG_1, S_setB S_mark_name, "a mark");
- XEN_ASSERT_TYPE(XEN_STRING_P(name) || XEN_FALSE_P(name), name, XEN_ARG_2, S_setB S_mark_name, "a string");
- return(mark_set(mark_n, name, MARK_NAME, S_setB S_mark_name));
+ Xen_check_type(xen_is_mark(mark_n), mark_n, 1, S_set S_mark_name, "a mark");
+ Xen_check_type(Xen_is_string(name) || Xen_is_false(name), name, 2, S_set S_mark_name, "a string");
+ return(mark_set(mark_n, name, MARK_NAME, S_set S_mark_name));
}
-static XEN g_mark_sync_max(void)
+static Xen g_mark_sync_max(void)
{
#define H_mark_sync_max "(" S_mark_sync_max "): max mark sync value seen so far"
- return(C_TO_XEN_INT(mark_sync_max()));
+ return(C_int_to_Xen_integer(mark_sync_max()));
}
-static XEN g_mark_home(XEN mark_n)
+static Xen g_mark_home(Xen mark_n)
{
#define H_mark_home "(" S_mark_home " id): the sound (index) and channel that hold mark id"
- XEN_ASSERT_TYPE(XEN_MARK_P(mark_n), mark_n, XEN_ONLY_ARG, S_mark_home, "a mark");
- return(mark_get(mark_n, MARK_HOME, XEN_UNDEFINED, S_mark_home));
+ Xen_check_type(xen_is_mark(mark_n), mark_n, 1, S_mark_home, "a mark");
+ return(mark_get(mark_n, MARK_HOME, Xen_undefined, S_mark_home));
}
-static XEN g_find_mark(XEN samp_n, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_find_mark(Xen samp_n, Xen snd, Xen chn_n, Xen edpos)
{
#define H_find_mark "(" S_find_mark " samp-or-name :optional snd chn edpos): \
find the mark in snd's channel chn at samp (if a number) or with the given name (if a string); return the mark or " PROC_FALSE " if no mark found."
@@ -2273,11 +2295,11 @@ find the mark in snd's channel chn at samp (if a number) or with the given name
int pos;
chan_info *cp = NULL;
- XEN_ASSERT_TYPE((XEN_NUMBER_P(samp_n) || XEN_STRING_P(samp_n) || (XEN_FALSE_P(samp_n))), samp_n, XEN_ARG_1, S_find_mark, "a number or string or " PROC_FALSE);
- ASSERT_CHANNEL(S_find_mark, snd, chn_n, 2);
+ Xen_check_type((Xen_is_llong(samp_n) || Xen_is_string(samp_n) || (Xen_is_false(samp_n))), samp_n, 1, S_find_mark, "an integer or string or " PROC_FALSE);
+ Snd_assert_channel(S_find_mark, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_find_mark);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, S_find_mark, 4);
mps = cp->edits[pos]->marks;
@@ -2286,9 +2308,13 @@ find the mark in snd's channel chn at samp (if a number) or with the given name
int i;
mus_long_t samp = 0;
const char *name = NULL;
- if (XEN_STRING_P(samp_n))
- name = XEN_TO_C_STRING(samp_n);
- else samp = XEN_TO_C_INT64_T_OR_ELSE(samp_n, 0);
+ if (Xen_is_string(samp_n))
+ name = Xen_string_to_C_string(samp_n);
+ else
+ {
+ if (Xen_is_llong(samp_n))
+ samp = Xen_llong_to_C_llong(samp_n);
+ }
if (name)
{
for (i = 0; i <= cp->edits[pos]->mark_ctr; i++)
@@ -2304,41 +2330,41 @@ find the mark in snd's channel chn at samp (if a number) or with the given name
return(new_xen_mark(mps[i]->id));
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_add_mark_1(XEN samp_n, XEN snd, XEN chn_n, XEN name, XEN sync, bool check_sample)
+static Xen g_add_mark_1(Xen samp_n, Xen snd, Xen chn_n, Xen name, Xen sync, bool check_sample, const char *caller)
{
#define H_add_mark "(" S_add_mark " samp :optional snd chn name (sync 0)): add a mark at sample samp returning the mark."
mark *m = NULL;
chan_info *cp;
- mus_long_t loc;
+ mus_long_t loc = 0;
int msync = 0;
const char *mname = NULL;
- XEN_ASSERT_TYPE(XEN_INT64_T_P(samp_n) || XEN_NOT_BOUND_P(samp_n), samp_n, XEN_ARG_1, S_add_mark, "an integer");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(name) || XEN_FALSE_P(name), name, XEN_ARG_4, S_add_mark, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(sync), sync, XEN_ARG_5, S_add_mark, "an integer");
- ASSERT_CHANNEL(S_add_mark, snd, chn_n, 2);
+ Xen_check_type(Xen_is_llong(samp_n) || !Xen_is_bound(samp_n), samp_n, 1, caller, "an integer");
+ Xen_check_type(Xen_is_string_or_unbound(name) || Xen_is_false(name), name, 4, caller, "a string");
+ Xen_check_type(Xen_is_integer_or_unbound(sync), sync, 5, caller, "an integer");
+ Snd_assert_channel(caller, snd, chn_n, 2);
- cp = get_cp(snd, chn_n, S_add_mark);
- if (!cp) return(XEN_FALSE);
+ cp = get_cp(snd, chn_n, caller);
+ if (!cp) return(Xen_false);
- loc = XEN_TO_C_INT64_T_OR_ELSE(samp_n, 0);
+ if (Xen_is_llong(samp_n)) loc = Xen_llong_to_C_llong(samp_n);
if ((!check_sample) &&
- (loc >= CURRENT_SAMPLES(cp)))
- return(XEN_FALSE);
+ (loc >= current_samples(cp)))
+ return(Xen_false);
if ((loc < 0) ||
- (loc >= CURRENT_SAMPLES(cp)))
- XEN_ERROR(NO_SUCH_SAMPLE,
- XEN_LIST_2(C_TO_XEN_STRING(S_add_mark ": no such sample, ~A"),
+ (loc >= current_samples(cp)))
+ Xen_error(NO_SUCH_SAMPLE,
+ Xen_list_2(C_string_to_Xen_string(S_add_mark ": no such sample, ~A"),
samp_n));
- if (XEN_STRING_P(name)) mname = XEN_TO_C_STRING(name);
- if (XEN_INTEGER_P(sync)) msync = XEN_TO_C_INT(sync);
+ if (Xen_is_string(name)) mname = Xen_string_to_C_string(name);
+ if (Xen_is_integer(sync)) msync = Xen_integer_to_C_int(sync);
m = add_mark(loc, mname, cp);
if (m)
@@ -2347,31 +2373,34 @@ static XEN g_add_mark_1(XEN samp_n, XEN snd, XEN chn_n, XEN name, XEN sync, bool
update_graph(cp);
return(new_xen_mark(m->id));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_add_mark(XEN samp_n, XEN snd, XEN chn_n, XEN name, XEN sync)
+static Xen g_add_mark(Xen samp_n, Xen snd, Xen chn_n, Xen name, Xen sync)
{
- return(g_add_mark_1(samp_n, snd, chn_n, name, sync, true));
+ return(g_add_mark_1(samp_n, snd, chn_n, name, sync, true, S_add_mark));
}
-static XEN g_add_mark_unchecked(XEN samp_n, XEN snd, XEN chn_n, XEN name, XEN sync)
+static Xen g_add_mark_unchecked(Xen samp_n, Xen snd, Xen chn_n, Xen name, Xen sync)
{
- return(g_add_mark_1(samp_n, snd, chn_n, name, sync, false));
+ #define H_add_mark_unchecked "(add-mark! samp :optional snd chn name (sync 0)): add a mark at sample samp returning the mark.\
+Unlike add-mark, add-mark! does not check for an invalid sample number."
+
+ return(g_add_mark_1(samp_n, snd, chn_n, name, sync, false, S_add_mark "!"));
}
-static XEN g_delete_mark(XEN id_n)
+static Xen g_delete_mark(Xen id_n)
{
#define H_delete_mark "(" S_delete_mark " id): delete mark id"
chan_info *cp[1];
mark *m;
int id;
- XEN_ASSERT_TYPE(XEN_MARK_P(id_n), id_n, XEN_ONLY_ARG, S_delete_mark, "a mark");
- id = XEN_MARK_TO_C_INT(id_n);
+ Xen_check_type(xen_is_mark(id_n), id_n, 1, S_delete_mark, "a mark");
+ id = Xen_mark_to_C_int(id_n);
m = find_mark_from_id(id, cp, AT_CURRENT_EDIT_POSITION);
if (m == NULL)
@@ -2385,23 +2414,23 @@ static XEN g_delete_mark(XEN id_n)
}
-static XEN g_delete_marks(XEN snd, XEN chn_n)
+static Xen g_delete_marks(Xen snd, Xen chn_n)
{
#define H_delete_marks "(" S_delete_marks " :optional snd chn): delete all marks in snd's channel chn"
chan_info *cp;
- ASSERT_CHANNEL(S_delete_marks, snd, chn_n, 1);
+ Snd_assert_channel(S_delete_marks, snd, chn_n, 1);
cp = get_cp(snd, chn_n, S_delete_marks);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
delete_marks(cp);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN int_array_to_mark_list(int *arr, int i, int len)
+static Xen int_array_to_mark_list(int *arr, int i, int len)
{
if (i < len)
- return(XEN_CONS(new_xen_mark(arr[i]), int_array_to_mark_list(arr, i + 1, len)));
- return(XEN_CONS(new_xen_mark(arr[i]), XEN_EMPTY_LIST));
+ return(Xen_cons(new_xen_mark(arr[i]), int_array_to_mark_list(arr, i + 1, len)));
+ return(Xen_cons(new_xen_mark(arr[i]), Xen_empty_list));
}
@@ -2420,17 +2449,17 @@ static int *syncd_marks(int sync)
}
-static XEN g_syncd_marks(XEN sync)
+static Xen g_syncd_marks(Xen sync)
{
#define H_syncd_marks "(" S_syncd_marks " sync): list of marks that share a given sync value (" S_mark_sync ")"
int *ids;
- XEN res;
+ Xen res;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(sync), sync, XEN_ONLY_ARG, S_syncd_marks, "an integer");
- ids = syncd_marks(XEN_TO_C_INT(sync));
+ Xen_check_type(Xen_is_integer(sync), sync, 1, S_syncd_marks, "an integer");
+ ids = syncd_marks(Xen_integer_to_C_int(sync));
- if (ids == NULL) return(XEN_EMPTY_LIST);
- if (ids[0] == 0) {free(ids); return(XEN_EMPTY_LIST);}
+ if (ids == NULL) return(Xen_empty_list);
+ if (ids[0] == 0) {free(ids); return(Xen_empty_list);}
res = int_array_to_mark_list(ids, 1, ids[0]);
@@ -2439,31 +2468,31 @@ static XEN g_syncd_marks(XEN sync)
}
-static XEN g_mark_tag_width(void) {return(C_TO_XEN_INT(mark_tag_width(ss)));}
+static Xen g_mark_tag_width(void) {return(C_int_to_Xen_integer(mark_tag_width(ss)));}
-static XEN g_set_mark_tag_width(XEN val)
+static Xen g_set_mark_tag_width(Xen val)
{
#define H_mark_tag_width "(" S_mark_tag_width "): width (pixels) of mark tags (10)"
int width;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_mark_tag_width, "an integer");
- width = mus_iclamp(0, XEN_TO_C_INT(val), LOTSA_PIXELS);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mark_tag_width, "an integer");
+ width = mus_iclamp(0, Xen_integer_to_C_int(val), LOTSA_PIXELS);
set_mark_tag_width(width);
for_each_normal_chan(update_graph);
- return(C_TO_XEN_INT(mark_tag_width(ss)));
+ return(C_int_to_Xen_integer(mark_tag_width(ss)));
}
-static XEN g_mark_tag_height(void) {return(C_TO_XEN_INT(mark_tag_height(ss)));}
+static Xen g_mark_tag_height(void) {return(C_int_to_Xen_integer(mark_tag_height(ss)));}
-static XEN g_set_mark_tag_height(XEN val)
+static Xen g_set_mark_tag_height(Xen val)
{
#define H_mark_tag_height "(" S_mark_tag_height "): height (pixels) of mark tags (4)"
int height;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_mark_tag_height, "an integer");
- height = mus_iclamp(0, XEN_TO_C_INT(val), LOTSA_PIXELS);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mark_tag_height, "an integer");
+ height = mus_iclamp(0, Xen_integer_to_C_int(val), LOTSA_PIXELS);
set_mark_tag_height(height);
for_each_normal_chan(update_graph);
- return(C_TO_XEN_INT(mark_tag_height(ss)));
+ return(C_int_to_Xen_integer(mark_tag_height(ss)));
}
@@ -2491,43 +2520,43 @@ static int *channel_marks(chan_info *cp, int pos)
}
-static XEN g_marks(XEN snd, XEN chn_n, XEN pos_n)
+static Xen g_marks(Xen snd, Xen chn_n, Xen pos_n)
{
#define H_marks "(" S_marks " :optional snd chn edpos): list of marks in snd/chn at edit history position pos. \
mark list is: channel given: (id id ...), snd given: ((id id) (id id ...)), neither given: (((id ...) ...) ...)."
chan_info *cp;
snd_info *sp;
- XEN res1 = XEN_EMPTY_LIST;
+ Xen res1 = Xen_empty_list;
- ASSERT_CHANNEL(S_marks, snd, chn_n, 0);
+ Snd_assert_channel(S_marks, snd, chn_n, 0);
- if (XEN_INTEGER_P(snd) || XEN_SOUND_P(snd))
+ if (Xen_is_integer(snd) || xen_is_sound(snd))
{
- int i, pos;
int *ids;
- XEN res;
- if (XEN_INTEGER_P(chn_n))
+ if (Xen_is_integer(chn_n))
{
+ int pos;
+ Xen res;
cp = get_cp(snd, chn_n, S_marks);
- if (!cp) return(XEN_FALSE);
- if (XEN_INTEGER_P(pos_n))
+ if (!cp) return(Xen_false);
+ if (Xen_is_integer(pos_n))
{
- pos = XEN_TO_C_INT(pos_n);
+ pos = Xen_integer_to_C_int(pos_n);
if (pos == AT_CURRENT_EDIT_POSITION)
pos = cp->edit_ctr;
if ((pos < 0) || (pos >= cp->edit_size) || (cp->edits[pos] == NULL))
- XEN_ERROR(NO_SUCH_EDIT,
- XEN_LIST_2(C_TO_XEN_STRING(S_marks ": no such edit, ~A"),
+ Xen_error(NO_SUCH_EDIT,
+ Xen_list_2(C_string_to_Xen_string(S_marks ": no such edit, ~A"),
pos_n));
}
else pos = cp->edit_ctr;
ids = channel_marks(cp, pos);
- if (ids == NULL) return(XEN_EMPTY_LIST);
+ if (ids == NULL) return(Xen_empty_list);
if (ids[0] == 0)
{
free(ids);
- return(XEN_EMPTY_LIST);
+ return(Xen_empty_list);
}
res = int_array_to_mark_list(ids, 1, ids[0]);
free(ids);
@@ -2535,6 +2564,7 @@ mark list is: channel given: (id id ...), snd given: ((id id) (id id ...)), neit
}
else
{
+ int i;
sp = get_sp(snd);
if (sp == NULL)
return(snd_no_such_sound_error(S_marks, snd));
@@ -2543,8 +2573,8 @@ mark list is: channel given: (id id ...), snd given: ((id id) (id id ...)), neit
cp = sp->chans[i];
ids = channel_marks(cp, cp->edit_ctr);
if ((ids == NULL) || (ids[0] == 0))
- res1 = XEN_CONS(XEN_EMPTY_LIST, res1);
- else res1 = XEN_CONS(int_array_to_mark_list(ids, 1, ids[0]),
+ res1 = Xen_cons(Xen_empty_list, res1);
+ else res1 = Xen_cons(int_array_to_mark_list(ids, 1, ids[0]),
res1);
if (ids) free(ids);
}
@@ -2558,7 +2588,7 @@ mark list is: channel given: (id id ...), snd given: ((id id) (id id ...)), neit
{
sp = ss->sounds[j];
if ((sp) && (sp->inuse == SOUND_NORMAL))
- res1 = XEN_CONS(g_marks(C_TO_XEN_INT(j), XEN_UNDEFINED, XEN_UNDEFINED),
+ res1 = Xen_cons(g_marks(C_int_to_Xen_integer(j), Xen_undefined, Xen_undefined),
res1);
}
}
@@ -2597,7 +2627,7 @@ static char *mark_sync_name(int cur_sync)
{
char *result;
result = (char *)calloc(SYNC_NAME_SIZE, sizeof(char));
- mus_snprintf(result, SYNC_NAME_SIZE, "%s%d", SYNC_BASE, cur_sync);
+ snprintf(result, SYNC_NAME_SIZE, "%s%d", SYNC_BASE, cur_sync);
return(result);
}
@@ -2667,20 +2697,20 @@ static mark *save_mark(chan_info *cp, mark *m, void *info)
#if HAVE_SCHEME
if (m->name)
- fprintf(sv->fd, "(add-mark! " MUS_LD " sfile %d \"%s\" %s)\n", m->samp, cp->chan, m->name, mapped_sync);
- else fprintf(sv->fd, "(add-mark! " MUS_LD " sfile %d #f %s)\n", m->samp, cp->chan, mapped_sync);
+ fprintf(sv->fd, "(add-mark! %lld sfile %d \"%s\" %s)\n", m->samp, cp->chan, m->name, mapped_sync);
+ else fprintf(sv->fd, "(add-mark! %lld sfile %d #f %s)\n", m->samp, cp->chan, mapped_sync);
#endif
#if HAVE_RUBY
if (m->name)
- fprintf(sv->fd, "add_mark!(" MUS_LD ", sfile, %d, \"%s\", %s)\n", m->samp, cp->chan, m->name, mapped_sync);
- else fprintf(sv->fd, "add_mark!(" MUS_LD ", sfile, %d, false, %s)\n", m->samp, cp->chan, mapped_sync);
+ fprintf(sv->fd, "add_mark!(%lld, sfile, %d, \"%s\", %s)\n", m->samp, cp->chan, m->name, mapped_sync);
+ else fprintf(sv->fd, "add_mark!(%lld, sfile, %d, false, %s)\n", m->samp, cp->chan, mapped_sync);
#endif
#if HAVE_FORTH
if (m->name)
- fprintf(sv->fd, MUS_LD " sfile %d \"%s\" %s add-mark! drop\n", m->samp, cp->chan, m->name, mapped_sync);
- else fprintf(sv->fd, MUS_LD " sfile %d #f %s add-mark! drop\n", m->samp, cp->chan, mapped_sync);
+ fprintf(sv->fd, "%lld sfile %d \"%s\" %s add-mark! drop\n", m->samp, cp->chan, m->name, mapped_sync);
+ else fprintf(sv->fd, "%lld sfile %d #f %s add-mark! drop\n", m->samp, cp->chan, mapped_sync);
#endif
free(mapped_sync);
@@ -2731,16 +2761,16 @@ void save_mark_list(FILE *fd, chan_info *cp, bool all_chans)
}
-static XEN g_save_marks(XEN snd, XEN filename)
+static Xen g_save_marks(Xen snd, Xen filename)
{
#define H_save_marks "(" S_save_marks " :optional snd (filename \"<snd-file-name>.marks\")): save snd's marks in filename. \
-The saved file is " XEN_LANGUAGE_NAME " code, so to restore the marks, load that file."
+The saved file is " Xen_language " code, so to restore the marks, load that file."
snd_info *sp;
- XEN res = XEN_FALSE;
+ Xen res = Xen_false;
- ASSERT_SOUND(S_save_marks, snd, 1);
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(filename), filename, XEN_ARG_2, S_save_marks, "a string");
+ Snd_assert_sound(S_save_marks, snd, 1);
+ Xen_check_type(Xen_is_string_or_unbound(filename), filename, 2, S_save_marks, "a string");
sp = get_sp(snd);
if (sp == NULL)
@@ -2749,15 +2779,15 @@ The saved file is " XEN_LANGUAGE_NAME " code, so to restore the marks, load that
if (map_over_sound_chans(sp, find_any_marks)) /* are there any marks? */
{
char *newname = NULL;
- int i, len;
FILE *fd;
- if (XEN_STRING_P(filename))
- newname = mus_strdup(XEN_TO_C_STRING(filename));
+ if (Xen_is_string(filename))
+ newname = mus_strdup(Xen_string_to_C_string(filename));
else
{
+ int i, len;
len = strlen(sp->filename);
newname = (char *)calloc(len + 7, sizeof(char));
- strcpy(newname, sp->filename);
+ strcopy(newname, sp->filename, len + 7);
for (i = len - 1; i > 0; i--)
if (newname[i] == '.')
break;
@@ -2768,13 +2798,13 @@ The saved file is " XEN_LANGUAGE_NAME " code, so to restore the marks, load that
fd = FOPEN(newname, "w");
if (fd == NULL)
{
- XEN lname;
- lname = C_TO_XEN_STRING(newname);
+ Xen lname;
+ lname = C_string_to_Xen_string(newname);
free(newname);
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_marks ": can't save ~S, ~A"),
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_save_marks ": can't save ~S, ~A"),
lname,
- C_TO_XEN_STRING(snd_open_strerror())));
+ C_string_to_Xen_string(snd_open_strerror())));
}
else
{
@@ -2785,7 +2815,7 @@ The saved file is " XEN_LANGUAGE_NAME " code, so to restore the marks, load that
save_mark_list(fd, sp->chans[0], true); /* true -> save all chans, matching cross-channel syncs */
close_save_sound_block(fd, false); /* close the let form */
snd_fclose(fd, newname);
- res = C_TO_XEN_STRING(newname);
+ res = C_string_to_Xen_string(newname);
}
free(newname);
}
@@ -2793,117 +2823,93 @@ The saved file is " XEN_LANGUAGE_NAME " code, so to restore the marks, load that
}
-static XEN g_mark_properties(XEN n)
+static Xen g_mark_properties(Xen n)
{
mark *m;
- #define H_mark_properties "(" S_mark_properties " id): A property list associated with the given mark. \
-The accessor mark-property is provided in mark." XEN_FILE_EXTENSION "."
+ #define H_mark_properties "(" S_mark_properties " id): A property list associated with the given mark."
- XEN_ASSERT_TYPE(XEN_MARK_P(n), n, XEN_ARG_1, S_mark_properties, "a mark");
+ Xen_check_type(xen_is_mark(n), n, 1, S_mark_properties, "a mark");
- m = find_mark_from_id(XEN_MARK_TO_C_INT(n), NULL, AT_CURRENT_EDIT_POSITION);
+ m = find_mark_from_id(Xen_mark_to_C_int(n), NULL, AT_CURRENT_EDIT_POSITION);
if (m == NULL)
return(snd_no_such_mark_error(S_mark_properties, n));
- if (!(XEN_VECTOR_P(m->properties)))
+ if (!(Xen_is_vector(m->properties)))
{
- m->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ m->properties = Xen_make_vector(1, Xen_empty_list);
m->properties_gc_loc = snd_protect(m->properties);
}
- return(XEN_VECTOR_REF(m->properties, 0));
+ return(Xen_vector_ref(m->properties, 0));
}
-static XEN g_set_mark_properties(XEN n, XEN val)
+static Xen g_set_mark_properties(Xen n, Xen val)
{
mark *m;
- XEN_ASSERT_TYPE(XEN_MARK_P(n), n, XEN_ARG_1, S_mark_properties, "a mark");
+ Xen_check_type(xen_is_mark(n), n, 1, S_mark_properties, "a mark");
- m = find_mark_from_id(XEN_MARK_TO_C_INT(n), NULL, AT_CURRENT_EDIT_POSITION);
+ m = find_mark_from_id(Xen_mark_to_C_int(n), NULL, AT_CURRENT_EDIT_POSITION);
if (m == NULL)
- return(snd_no_such_mark_error(S_setB S_mark_properties, n));
+ return(snd_no_such_mark_error(S_set S_mark_properties, n));
- if (!(XEN_VECTOR_P(m->properties)))
+ if (!(Xen_is_vector(m->properties)))
{
- m->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ m->properties = Xen_make_vector(1, Xen_empty_list);
m->properties_gc_loc = snd_protect(m->properties);
}
- XEN_VECTOR_SET(m->properties, 0, val);
- return(XEN_VECTOR_REF(m->properties, 0));
+ Xen_vector_set(m->properties, 0, val);
+ return(Xen_vector_ref(m->properties, 0));
}
-static XEN g_mark_property(XEN key, XEN id)
+static Xen g_mark_property(Xen key, Xen id)
{
- #define H_mark_property "(" S_mark_property " key id) returns the value associated with 'key' in the given mark's property list, or #f"
- return(XEN_ASSOC_REF(key, g_mark_properties(id)));
+ #define H_mark_property "(" S_mark_property " key id) returns the value associated with 'key' in the given mark's property list, or " PROC_FALSE "."
+ Xen_check_type(xen_is_mark(id), id, 2, S_mark_property, "a mark");
+ return(Xen_assoc_ref(key, g_mark_properties(id)));
}
-static XEN g_set_mark_property(XEN key, XEN id, XEN val)
+static Xen g_set_mark_property(Xen key, Xen id, Xen val)
{
- g_set_mark_properties(id, XEN_ASSOC_SET(key, val, g_mark_properties(id)));
+ Xen_check_type(xen_is_mark(id), id, 2, S_mark_property, "a mark");
+ g_set_mark_properties(id, Xen_assoc_set(key, val, g_mark_properties(id)));
return(val);
}
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_2(g_mark_sample_w, g_mark_sample)
-XEN_NARGIFY_2(g_set_mark_sample_w, g_set_mark_sample)
-XEN_NARGIFY_1(g_mark_sync_w, g_mark_sync)
-XEN_NARGIFY_2(g_set_mark_sync_w, g_set_mark_sync)
-XEN_NARGIFY_1(g_mark_name_w, g_mark_name)
-XEN_NARGIFY_2(g_set_mark_name_w, g_set_mark_name)
-XEN_NARGIFY_0(g_mark_sync_max_w, g_mark_sync_max)
-XEN_NARGIFY_1(g_mark_home_w, g_mark_home)
-XEN_ARGIFY_3(g_marks_w, g_marks)
-XEN_ARGIFY_5(g_add_mark_w, g_add_mark)
-XEN_ARGIFY_5(g_add_mark_unchecked_w, g_add_mark_unchecked)
-XEN_NARGIFY_1(g_delete_mark_w, g_delete_mark)
-XEN_ARGIFY_2(g_delete_marks_w, g_delete_marks)
-XEN_NARGIFY_1(g_syncd_marks_w, g_syncd_marks)
-XEN_NARGIFY_0(g_mark_tag_width_w, g_mark_tag_width)
-XEN_NARGIFY_1(g_set_mark_tag_width_w, g_set_mark_tag_width)
-XEN_NARGIFY_0(g_mark_tag_height_w, g_mark_tag_height)
-XEN_NARGIFY_1(g_set_mark_tag_height_w, g_set_mark_tag_height)
-XEN_ARGIFY_4(g_find_mark_w, g_find_mark)
-XEN_ARGIFY_2(g_save_marks_w, g_save_marks)
-XEN_NARGIFY_1(g_mark_p_w, g_mark_p)
-XEN_NARGIFY_1(g_integer_to_mark_w, g_integer_to_mark)
-XEN_NARGIFY_1(g_mark_to_integer_w, g_mark_to_integer)
-XEN_NARGIFY_1(g_mark_properties_w, g_mark_properties)
-XEN_NARGIFY_2(g_set_mark_properties_w, g_set_mark_properties)
-XEN_NARGIFY_2(g_mark_property_w, g_mark_property)
-XEN_NARGIFY_3(g_set_mark_property_w, g_set_mark_property)
-#else
-#define g_mark_sample_w g_mark_sample
-#define g_set_mark_sample_w g_set_mark_sample
-#define g_mark_sync_w g_mark_sync
-#define g_set_mark_sync_w g_set_mark_sync
-#define g_mark_name_w g_mark_name
-#define g_set_mark_name_w g_set_mark_name
-#define g_mark_sync_max_w g_mark_sync_max
-#define g_mark_home_w g_mark_home
-#define g_marks_w g_marks
-#define g_add_mark_w g_add_mark
-#define g_add_mark_unchecked_w g_add_mark_unchecked
-#define g_delete_mark_w g_delete_mark
-#define g_delete_marks_w g_delete_marks
-#define g_syncd_marks_w g_syncd_marks
-#define g_mark_tag_width_w g_mark_tag_width
-#define g_set_mark_tag_width_w g_set_mark_tag_width
-#define g_mark_tag_height_w g_mark_tag_height
-#define g_set_mark_tag_height_w g_set_mark_tag_height
-#define g_find_mark_w g_find_mark
-#define g_save_marks_w g_save_marks
-#define g_mark_p_w g_mark_p
-#define g_integer_to_mark_w g_integer_to_mark
-#define g_mark_to_integer_w g_mark_to_integer
-#define g_mark_properties_w g_mark_properties
-#define g_set_mark_properties_w g_set_mark_properties
-#define g_mark_property_w g_mark_property
-#define g_set_mark_property_w g_set_mark_property
+Xen_wrap_2_optional_args(g_mark_sample_w, g_mark_sample)
+Xen_wrap_2_args(g_set_mark_sample_w, g_set_mark_sample)
+Xen_wrap_1_arg(g_mark_sync_w, g_mark_sync)
+Xen_wrap_2_args(g_set_mark_sync_w, g_set_mark_sync)
+Xen_wrap_1_arg(g_mark_name_w, g_mark_name)
+Xen_wrap_2_args(g_set_mark_name_w, g_set_mark_name)
+Xen_wrap_no_args(g_mark_sync_max_w, g_mark_sync_max)
+Xen_wrap_1_arg(g_mark_home_w, g_mark_home)
+Xen_wrap_3_optional_args(g_marks_w, g_marks)
+Xen_wrap_5_optional_args(g_add_mark_w, g_add_mark)
+Xen_wrap_5_optional_args(g_add_mark_unchecked_w, g_add_mark_unchecked)
+Xen_wrap_1_arg(g_delete_mark_w, g_delete_mark)
+Xen_wrap_2_optional_args(g_delete_marks_w, g_delete_marks)
+Xen_wrap_1_arg(g_syncd_marks_w, g_syncd_marks)
+Xen_wrap_no_args(g_mark_tag_width_w, g_mark_tag_width)
+Xen_wrap_1_arg(g_set_mark_tag_width_w, g_set_mark_tag_width)
+Xen_wrap_no_args(g_mark_tag_height_w, g_mark_tag_height)
+Xen_wrap_1_arg(g_set_mark_tag_height_w, g_set_mark_tag_height)
+Xen_wrap_4_optional_args(g_find_mark_w, g_find_mark)
+Xen_wrap_2_optional_args(g_save_marks_w, g_save_marks)
+Xen_wrap_1_arg(g_is_mark_w, g_is_mark)
+Xen_wrap_1_arg(g_integer_to_mark_w, g_integer_to_mark)
+Xen_wrap_1_arg(g_mark_to_integer_w, g_mark_to_integer)
+Xen_wrap_1_arg(g_mark_properties_w, g_mark_properties)
+Xen_wrap_2_args(g_set_mark_properties_w, g_set_mark_properties)
+Xen_wrap_2_args(g_mark_property_w, g_mark_property)
+Xen_wrap_3_args(g_set_mark_property_w, g_set_mark_property)
+
+#if HAVE_SCHEME
+static s7_pointer acc_mark_tag_height(s7_scheme *sc, s7_pointer args) {return(g_set_mark_tag_height(s7_cadr(args)));}
+static s7_pointer acc_mark_tag_width(s7_scheme *sc, s7_pointer args) {return(g_set_mark_tag_width(s7_cadr(args)));}
#endif
void g_init_marks(void)
@@ -2914,47 +2920,43 @@ void g_init_marks(void)
init_xen_mark();
- mark_drag_hook = XEN_DEFINE_HOOK(S_mark_drag_hook, 1, H_mark_drag_hook); /* arg = id */
- mark_hook = XEN_DEFINE_HOOK(S_mark_hook, 4, H_mark_hook); /* args = id snd chn reason */
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mark_sample, g_mark_sample_w, H_mark_sample,
- S_setB S_mark_sample, g_set_mark_sample_w, 1, 1, 2, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mark_sync, g_mark_sync_w, H_mark_sync,
- S_setB S_mark_sync, g_set_mark_sync_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mark_name, g_mark_name_w, H_mark_name,
- S_setB S_mark_name, g_set_mark_name_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE(S_mark_sync_max, g_mark_sync_max_w, 0, 0, 0, H_mark_sync_max);
- XEN_DEFINE_PROCEDURE(S_mark_home, g_mark_home_w, 1, 0, 0, H_mark_home);
- XEN_DEFINE_PROCEDURE(S_marks, g_marks_w, 0, 3, 0, H_marks);
- XEN_DEFINE_PROCEDURE(S_add_mark, g_add_mark_w, 0, 5, 0, H_add_mark);
- XEN_DEFINE_PROCEDURE(S_add_mark "!", g_add_mark_unchecked_w, 0, 5, 0, H_add_mark);
- XEN_DEFINE_PROCEDURE(S_delete_mark, g_delete_mark_w, 1, 0, 0, H_delete_mark);
- XEN_DEFINE_PROCEDURE(S_delete_marks, g_delete_marks_w, 0, 2, 0, H_delete_marks);
- XEN_DEFINE_PROCEDURE(S_syncd_marks, g_syncd_marks_w, 1, 0, 0, H_syncd_marks);
- XEN_DEFINE_PROCEDURE(S_find_mark, g_find_mark_w, 1, 3, 0, H_find_mark);
- XEN_DEFINE_PROCEDURE(S_save_marks, g_save_marks_w, 0, 2, 0, H_save_marks);
- XEN_DEFINE_PROCEDURE(S_mark_p, g_mark_p_w, 1, 0, 0, H_mark_p);
- XEN_DEFINE_PROCEDURE(S_integer_to_mark, g_integer_to_mark_w, 1, 0, 0, H_integer_to_mark);
- XEN_DEFINE_PROCEDURE(S_mark_to_integer, g_mark_to_integer_w, 1, 0, 0, H_mark_to_integer);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mark_tag_width, g_mark_tag_width_w, H_mark_tag_width,
- S_setB S_mark_tag_width, g_set_mark_tag_width_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mark_tag_height, g_mark_tag_height_w, H_mark_tag_height,
- S_setB S_mark_tag_height, g_set_mark_tag_height_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mark_properties, g_mark_properties_w, H_mark_properties,
- S_setB S_mark_properties, g_set_mark_properties_w, 1, 0, 2, 0);
+ mark_drag_hook = Xen_define_hook(S_mark_drag_hook, "(make-hook 'id)", 1, H_mark_drag_hook);
+ mark_hook = Xen_define_hook(S_mark_hook, "(make-hook 'id 'snd 'chn 'reason)", 4, H_mark_hook);
+
+ Xen_define_dilambda(S_mark_sample, g_mark_sample_w, H_mark_sample, S_set S_mark_sample, g_set_mark_sample_w, 1, 1, 2, 0);
+ Xen_define_dilambda(S_mark_sync, g_mark_sync_w, H_mark_sync, S_set S_mark_sync, g_set_mark_sync_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_mark_name, g_mark_name_w, H_mark_name, S_set S_mark_name, g_set_mark_name_w, 1, 0, 2, 0);
+
+ Xen_define_safe_procedure(S_mark_sync_max, g_mark_sync_max_w, 0, 0, 0, H_mark_sync_max);
+ Xen_define_safe_procedure(S_mark_home, g_mark_home_w, 1, 0, 0, H_mark_home);
+ Xen_define_safe_procedure(S_marks, g_marks_w, 0, 3, 0, H_marks);
+ Xen_define_safe_procedure(S_add_mark, g_add_mark_w, 0, 5, 0, H_add_mark);
+ Xen_define_safe_procedure(S_add_mark "!", g_add_mark_unchecked_w, 0, 5, 0, H_add_mark_unchecked);
+ Xen_define_safe_procedure(S_delete_mark, g_delete_mark_w, 1, 0, 0, H_delete_mark);
+ Xen_define_safe_procedure(S_delete_marks, g_delete_marks_w, 0, 2, 0, H_delete_marks);
+ Xen_define_safe_procedure(S_syncd_marks, g_syncd_marks_w, 1, 0, 0, H_syncd_marks);
+ Xen_define_safe_procedure(S_find_mark, g_find_mark_w, 1, 3, 0, H_find_mark);
+ Xen_define_safe_procedure(S_save_marks, g_save_marks_w, 0, 2, 0, H_save_marks);
+ Xen_define_safe_procedure(S_is_mark, g_is_mark_w, 1, 0, 0, H_is_mark);
+ Xen_define_safe_procedure(S_integer_to_mark, g_integer_to_mark_w, 1, 0, 0, H_integer_to_mark);
+ Xen_define_safe_procedure(S_mark_to_integer, g_mark_to_integer_w, 1, 0, 0, H_mark_to_integer);
+
+ Xen_define_dilambda(S_mark_tag_width, g_mark_tag_width_w, H_mark_tag_width, S_set S_mark_tag_width, g_set_mark_tag_width_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mark_tag_height, g_mark_tag_height_w, H_mark_tag_height, S_set S_mark_tag_height, g_set_mark_tag_height_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mark_properties, g_mark_properties_w, H_mark_properties, S_set S_mark_properties, g_set_mark_properties_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_mark_property, g_mark_property_w, H_mark_property, S_set S_mark_property, g_set_mark_property_w, 2, 0, 3, 0);
+
+ #define H_draw_mark_hook S_draw_mark_hook " (id): called before a mark is drawn. \
+If the hook returns " PROC_TRUE ", the mark is not drawn."
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mark_property, g_mark_property_w, H_mark_property,
- S_setB S_mark_property, g_set_mark_property_w, 2, 0, 3, 0);
+ draw_mark_hook = Xen_define_hook(S_draw_mark_hook, "(make-hook 'id)", 1, H_draw_mark_hook);
- #define H_draw_mark_hook S_draw_mark_hook " (mark-id): called before a mark is drawn (in XOR mode). \
-If the hook returns " PROC_TRUE ", the mark is not drawn."
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->mark_tag_height_symbol, s7_make_function(s7, "[acc-" S_mark_tag_height "]", acc_mark_tag_height, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->mark_tag_width_symbol, s7_make_function(s7, "[acc-" S_mark_tag_width "]", acc_mark_tag_width, 2, 0, false, "accessor"));
- draw_mark_hook = XEN_DEFINE_HOOK(S_draw_mark_hook, 1, H_draw_mark_hook); /* arg = mark-id */
+ s7_symbol_set_documentation(s7, ss->mark_tag_height_symbol, "*mark-tag-height*: height (pixels) of mark tags (4)");
+ s7_symbol_set_documentation(s7, ss->mark_tag_width_symbol, "*mark-tag-width*: width (pixels) of mark tags (10)");
+#endif
}
diff --git a/snd-menu.c b/snd-menu.c
index e8e99dc..584d632 100644
--- a/snd-menu.c
+++ b/snd-menu.c
@@ -8,11 +8,11 @@ void edit_menu_update(void)
/* called when the "Edit" top level menu is clicked -- make sure all items reflect current Snd state */
snd_info *selected_sp = NULL, *any_sp = NULL;
chan_info *cp = NULL;
- bool selection_p = false, region_p = false, file_p = false, undoable_edit_p = false, redoable_edit_p = false;
+ bool has_selection = false, has_region = false, file_open = false, has_undoable_edit = false, has_redoable_edit = false;
selected_sp = selected_sound();
if (selected_sp)
{
- file_p = true;
+ file_open = true;
cp = any_selected_channel(selected_sp);
any_sp = selected_sp;
}
@@ -22,38 +22,42 @@ void edit_menu_update(void)
if (any_sp)
{
cp = any_selected_channel(any_sp);
- file_p = true;
+ file_open = true;
}
}
- selection_p = selection_is_active();
- region_p = region_ok(region_list_position_to_id(0));
+ has_selection = selection_is_active();
+ has_region = region_ok(region_list_position_to_id(0));
if (cp)
{
- undoable_edit_p = (cp->edit_ctr > 0);
- redoable_edit_p = (!(((cp->edit_ctr + 1) == cp->edit_size) ||
+ has_undoable_edit = (cp->edit_ctr > 0);
+ has_redoable_edit = (!(((cp->edit_ctr + 1) == cp->edit_size) ||
(!(cp->edits[cp->edit_ctr + 1]))));
}
/* is there an open sound? */
- set_sensitive(edit_header_menu, file_p);
- set_sensitive(edit_find_menu, file_p);
- set_sensitive(edit_select_all_menu, file_p);
+ set_sensitive(edit_header_menu, file_open);
+#if HAVE_EXTENSION_LANGUAGE
+ set_sensitive(edit_find_menu, file_open);
+#endif
+ set_sensitive(edit_select_all_menu, file_open);
/* is there an active selection? */
- set_sensitive(edit_cut_menu, selection_p);
- set_sensitive(edit_play_menu, selection_p);
- set_sensitive(edit_mix_menu, selection_p);
- set_sensitive(edit_save_as_menu, selection_p);
- set_sensitive(edit_unselect_menu, selection_p);
+ set_sensitive(edit_cut_menu, has_selection);
+#if WITH_AUDIO
+ set_sensitive(edit_play_menu, has_selection);
+#endif
+ set_sensitive(edit_mix_menu, has_selection);
+ set_sensitive(edit_save_as_menu, has_selection);
+ set_sensitive(edit_unselect_menu, has_selection);
/* is there an undoable edit? */
- set_sensitive(edit_undo_menu, undoable_edit_p);
+ set_sensitive(edit_undo_menu, has_undoable_edit);
/* is there a redoable edit? */
- set_sensitive(edit_redo_menu, redoable_edit_p);
+ set_sensitive(edit_redo_menu, has_redoable_edit);
/* does paste make any sense? */
- set_sensitive(edit_paste_menu, (file_p) && (selection_p || region_p));
+ set_sensitive(edit_paste_menu, (file_open) && (has_selection || has_region));
/* make sure edit-header menu option label correctly reflects current selected sound header type */
if (any_sp)
@@ -93,7 +97,7 @@ void view_menu_update(void)
set_menu_label(view_zero_menu, (show_y_zero(ss)) ? "Hide Y = 0" : "Show Y = 0");
/* verbose cursor label */
- set_menu_label(view_cursor_menu, (verbose_cursor(ss)) ? "Silent cursor" : "Verbose cursor");
+ set_menu_label(view_cursor_menu, (with_verbose_cursor(ss)) ? "Silent cursor" : "Verbose cursor");
#if HAVE_EXTENSION_LANGUAGE
/* inset graph label */
@@ -113,44 +117,49 @@ void view_menu_update(void)
set_sensitive(view_all_axes_unlabelled_menu, show_axes(ss) != SHOW_ALL_AXES_UNLABELLED);
set_sensitive(view_bare_x_axis_menu, show_axes(ss) != SHOW_BARE_X_AXIS);
-#if HAVE_EXTENSION_LANGUAGE
+#if HAVE_EXTENSION_LANGUAGE && USE_MOTIF
/* make sure listener menu option label correctly reflects current listener state */
set_menu_label(view_listener_menu, (listener_is_visible()) ? "Hide listener" : "Show listener");
#endif
set_menu_label(view_controls_menu, (in_show_controls(ss)) ? "Hide controls" : "Show controls");
- /* set_sensitive(view_files_menu, get_view_files_end() >= 0); */
+#if USE_GTK
+ set_sensitive(view_files_menu, view_files_has_files());
+#endif
/* zoom focus style */
set_sensitive(view_focus_left_menu, zoom_focus_style(ss) != ZOOM_FOCUS_LEFT);
set_sensitive(view_focus_right_menu, zoom_focus_style(ss) != ZOOM_FOCUS_RIGHT);
set_sensitive(view_focus_middle_menu, zoom_focus_style(ss) != ZOOM_FOCUS_MIDDLE);
set_sensitive(view_focus_active_menu, zoom_focus_style(ss) != ZOOM_FOCUS_ACTIVE);
+
+ /* grid menu label */
+ set_menu_label(view_grid_menu, (show_grid(ss) == WITH_GRID) ? "Without grid" : "With grid");
}
void file_menu_update(void)
{
snd_info *any_sp = NULL;
- bool file_p = false, edits_p = false;
+ bool file_open = false, has_edits = false;
any_sp = any_selected_sound();
if (any_sp)
{
- edits_p = has_unsaved_edits(any_sp);
- file_p = true;
+ has_edits = has_unsaved_edits(any_sp);
+ file_open = true;
}
- set_sensitive(file_close_menu, file_p);
- set_sensitive(file_print_menu, file_p);
- set_sensitive(file_mix_menu, file_p);
- set_sensitive(file_insert_menu, file_p);
- set_sensitive(file_save_as_menu, file_p);
- set_sensitive(file_update_menu, file_p);
+ set_sensitive(file_close_menu, file_open);
+ set_sensitive(file_print_menu, file_open);
+ set_sensitive(file_mix_menu, file_open);
+ set_sensitive(file_insert_menu, file_open);
+ set_sensitive(file_save_as_menu, file_open);
+ set_sensitive(file_update_menu, file_open);
- set_sensitive(file_save_menu, edits_p);
- set_sensitive(file_revert_menu, edits_p);
+ set_sensitive(file_save_menu, has_edits);
+ set_sensitive(file_revert_menu, has_edits);
if (ss->active_sounds > 1)
activate_widget(file_close_all_menu);
@@ -177,7 +186,7 @@ static void file_update(snd_info *sp)
((sp->need_update) ||
(file_write_date(sp->filename) != sp->write_date)))
{
- redirect_everything_to(printout_to_minibuffer, (void *)sp);
+ redirect_everything_to(printout_to_status_area, (void *)sp);
snd_update(sp);
redirect_everything_to(NULL, NULL);
}
@@ -204,24 +213,12 @@ void revert_file_from_menu(void)
}
-void save_options_from_menu(void)
-{
- const char *filename;
- filename = save_options_in_prefs();
- if (filename)
- {
- if (any_selected_sound())
- report_in_minibuffer(any_selected_sound(), "saved options in %s", filename);
- }
-}
-
-
-static bool save_state_error_p = false;
+static bool has_save_state_error = false;
static void save_state_from_menu_error_handler(const char *msg, void *ignore)
{
snd_warning_without_format(msg);
- save_state_error_p = true;
+ has_save_state_error = true;
}
@@ -229,14 +226,14 @@ void save_state_from_menu(void)
{
if (save_state_file(ss))
{
- save_state_error_p = false;
+ has_save_state_error = false;
redirect_everything_to(save_state_from_menu_error_handler, NULL);
save_state(save_state_file(ss));
redirect_everything_to(NULL, NULL);
- if (!save_state_error_p)
+ if (!has_save_state_error)
{
if (any_selected_sound())
- report_in_minibuffer(any_selected_sound(), "saved state in %s", save_state_file(ss));
+ status_report(any_selected_sound(), "saved state in %s", save_state_file(ss));
}
}
else
@@ -249,17 +246,17 @@ void save_state_from_menu(void)
/* ---------------- extlang tie-ins ---------------- */
-static XEN snd_no_such_menu_error(const char *caller, XEN id)
+static Xen snd_no_such_menu_error(const char *caller, Xen id)
{
- XEN_ERROR(XEN_ERROR_TYPE("no-such-menu"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such menu, ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("no-such-menu"),
+ Xen_list_3(C_string_to_Xen_string("~A: no such menu, ~A"),
+ C_string_to_Xen_string(caller),
id));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN *menu_functions = NULL;
+static Xen *menu_functions = NULL;
static int *menu_functions_loc = NULL;
static int callbacks_size = 0;
static int callb = 0;
@@ -270,22 +267,22 @@ static int make_callback_slot(void)
{
int old_callb, i;
for (i = 0; i < callb; i++)
- if (XEN_FALSE_P(menu_functions[i]))
+ if (Xen_is_false(menu_functions[i]))
return(i);
if (callbacks_size == callb)
{
callbacks_size += CALLBACK_INCR;
if (callb == 0)
{
- menu_functions = (XEN *)calloc(callbacks_size, sizeof(XEN));
- for (i = 0; i < callbacks_size; i++) menu_functions[i] = XEN_UNDEFINED;
+ menu_functions = (Xen *)calloc(callbacks_size, sizeof(Xen));
+ for (i = 0; i < callbacks_size; i++) menu_functions[i] = Xen_undefined;
menu_functions_loc = (int *)calloc(callbacks_size, sizeof(int));
for (i = 0; i < callbacks_size; i++) menu_functions_loc[i] = NOT_A_GC_LOC;
}
else
{
- menu_functions = (XEN *)realloc(menu_functions, callbacks_size * sizeof(XEN));
- for (i = callbacks_size - CALLBACK_INCR; i < callbacks_size; i++) menu_functions[i] = XEN_UNDEFINED;
+ menu_functions = (Xen *)realloc(menu_functions, callbacks_size * sizeof(Xen));
+ for (i = callbacks_size - CALLBACK_INCR; i < callbacks_size; i++) menu_functions[i] = Xen_undefined;
menu_functions_loc = (int *)realloc(menu_functions_loc, callbacks_size * sizeof(int));
for (i = callbacks_size - CALLBACK_INCR; i < callbacks_size; i++) menu_functions_loc[i] = NOT_A_GC_LOC;
}
@@ -296,7 +293,7 @@ static int make_callback_slot(void)
}
-static void add_callback(int slot, XEN callback)
+static void add_callback(int slot, Xen callback)
{
if ((slot >= 0) && (slot < callbacks_size))
{
@@ -311,23 +308,23 @@ void unprotect_callback(int slot)
/* called only if menu is being removed */
if ((slot >= 0) && (slot < callbacks_size))
{
- if (XEN_PROCEDURE_P(menu_functions[slot]))
+ if (Xen_is_procedure(menu_functions[slot]))
{
snd_unprotect_at(menu_functions_loc[slot]);
menu_functions_loc[slot] = NOT_A_GC_LOC;
}
- menu_functions[slot] = XEN_FALSE; /* not XEN_UNDEFINED -- need a way to distinguish "no callback" from "recyclable slot" */
+ menu_functions[slot] = Xen_false; /* not Xen_undefined -- need a way to distinguish "no callback" from "recyclable slot" */
}
}
-static XEN gl_add_to_main_menu(XEN label, XEN callback)
+static Xen gl_add_to_main_menu(Xen label, Xen callback)
{
#define H_add_to_main_menu "(" S_add_to_main_menu " label :optional callback): adds label to the main (top-level) menu, returning its index"
int slot = -1;
- XEN_ASSERT_TYPE(XEN_STRING_P(label), label, XEN_ARG_1, S_add_to_main_menu, "a string");
+ Xen_check_type(Xen_is_string(label), label, 1, S_add_to_main_menu, "a string");
slot = make_callback_slot();
- if (XEN_BOUND_P(callback))
+ if (Xen_is_bound(callback))
{
char *err;
err = procedure_ok(callback, 0, S_add_to_main_menu, "menu callback", 2);
@@ -335,119 +332,114 @@ static XEN gl_add_to_main_menu(XEN label, XEN callback)
add_callback(slot, callback);
else
{
- XEN errm;
- errm = C_TO_XEN_STRING(err);
+ Xen errm;
+ errm = C_string_to_Xen_string(err);
free(err);
return(snd_bad_arity_error(S_add_to_main_menu, errm, callback));
}
}
- else menu_functions[slot] = XEN_UNDEFINED;
- return(C_TO_XEN_INT(g_add_to_main_menu((char *)XEN_TO_C_STRING(label), slot)));
+ else menu_functions[slot] = Xen_undefined;
+ return(C_int_to_Xen_integer(g_add_to_main_menu((char *)Xen_string_to_C_string(label), slot)));
}
-static XEN gl_add_to_menu(XEN menu, XEN label, XEN callback, XEN gpos)
+static Xen gl_add_to_menu(Xen menu, Xen label, Xen callback, Xen gpos)
{
#define H_add_to_menu "(" S_add_to_menu " menu label func :optional position): adds label to menu (a main menu index), invokes \
func (a function of no args) when the new menu is activated. Returns the new menu label widget."
+#if (!USE_NO_GUI)
widget_t result;
char *errmsg = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(label) || XEN_FALSE_P(label), label, XEN_ARG_2, S_add_to_menu, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(menu), menu, XEN_ARG_1, S_add_to_menu, "an integer");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(callback) || XEN_FALSE_P(callback), callback, XEN_ARG_3, S_add_to_menu, "a procedure");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(gpos), gpos, XEN_ARG_4, S_add_to_menu, "an integer");
+ Xen_check_type(Xen_is_string(label) || Xen_is_false(label), label, 2, S_add_to_menu, "a string");
+ Xen_check_type(Xen_is_integer(menu), menu, 1, S_add_to_menu, "an integer");
+ Xen_check_type(Xen_is_procedure(callback) || Xen_is_false(callback), callback, 3, S_add_to_menu, "a procedure");
+ Xen_check_type(Xen_is_integer_or_unbound(gpos), gpos, 4, S_add_to_menu, "an integer");
- /* fprintf(stderr, "add-to-menu %s\n", XEN_AS_STRING(XEN_CAR(callback))); */
+ /* fprintf(stderr, "add-to-menu %s\n", Xen_object_to_C_string(Xen_car(callback))); */
- if (XEN_PROCEDURE_P(callback))
+ if (Xen_is_procedure(callback))
errmsg = procedure_ok(callback, 0, S_add_to_menu, "menu callback", 3);
if (errmsg == NULL)
{
int slot = -1, m, position = -1;
- m = XEN_TO_C_INT(menu);
+ m = Xen_integer_to_C_int(menu);
if (m < 0)
return(snd_no_such_menu_error(S_add_to_menu, menu));
- if (XEN_PROCEDURE_P(callback)) slot = make_callback_slot();
- if (XEN_INTEGER_P(gpos)) position = XEN_TO_C_INT(gpos);
+ if (Xen_is_procedure(callback)) slot = make_callback_slot();
+ if (Xen_is_integer(gpos)) position = Xen_integer_to_C_int(gpos);
result = g_add_to_menu(m,
- (XEN_FALSE_P(label)) ? NULL : XEN_TO_C_STRING(label),
+ (Xen_is_false(label)) ? NULL : Xen_string_to_C_string(label),
slot,
position);
-#if (!USE_NO_GUI)
if (result == NULL)
return(snd_no_such_menu_error(S_add_to_menu, menu));
-#endif
- if (XEN_PROCEDURE_P(callback)) add_callback(slot, callback);
+ if (Xen_is_procedure(callback)) add_callback(slot, callback);
}
else
{
- XEN errm;
- errm = C_TO_XEN_STRING(errmsg);
+ Xen errm;
+ errm = C_string_to_Xen_string(errmsg);
free(errmsg);
return(snd_bad_arity_error(S_add_to_menu, errm, callback));
}
- return(XEN_WRAP_WIDGET(result));
+ return(Xen_wrap_widget(result));
+#else
+ return(Xen_false);
+#endif
}
-void g_snd_callback(int callb)
+void g_menu_callback(int callb)
{
- if ((callb >= 0) && (XEN_BOUND_P(menu_functions[callb])))
- XEN_CALL_0(menu_functions[callb], "menu callback func");
+ if ((callb >= 0) && (Xen_is_bound(menu_functions[callb])))
+ Xen_call_with_no_args(menu_functions[callb], "menu callback func");
}
-static XEN gl_remove_from_menu(XEN menu, XEN label)
+static Xen gl_remove_from_menu(Xen menu, Xen label)
{
#define H_remove_from_menu "(" S_remove_from_menu " menu label): removes menu item label from menu"
int m;
- XEN_ASSERT_TYPE(XEN_STRING_P(label), label, XEN_ARG_2, S_remove_from_menu, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(menu), menu, XEN_ARG_1, S_remove_from_menu, "an integer");
+ Xen_check_type(Xen_is_string(label), label, 2, S_remove_from_menu, "a string");
+ Xen_check_type(Xen_is_integer(menu), menu, 1, S_remove_from_menu, "an integer");
- m = XEN_TO_C_INT(menu);
+ m = Xen_integer_to_C_int(menu);
if (m < 0)
return(snd_no_such_menu_error(S_remove_from_menu, menu));
- return(C_TO_XEN_INT(g_remove_from_menu(m, XEN_TO_C_STRING(label))));
+ return(C_int_to_Xen_integer(g_remove_from_menu(m, Xen_string_to_C_string(label))));
}
-static XEN g_main_menu(XEN which)
+static Xen g_main_menu(Xen which)
{
#define H_main_menu "(" S_main_menu " menu): the top-level menu widget referred to by menu"
int which_menu;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(which), which, XEN_ONLY_ARG, S_main_menu, "an integer");
- which_menu = XEN_TO_C_INT(which);
+ Xen_check_type(Xen_is_integer(which), which, 1, S_main_menu, "an integer");
+ which_menu = Xen_integer_to_C_int(which);
if ((which_menu < 0) || (which_menu >= MAX_MAIN_MENUS))
- XEN_ERROR(XEN_ERROR_TYPE("no-such-menu"),
- XEN_LIST_2(C_TO_XEN_STRING(S_main_menu ": no such menu, ~A"),
+ Xen_error(Xen_make_error_type("no-such-menu"),
+ Xen_list_2(C_string_to_Xen_string(S_main_menu ": no such menu, ~A"),
which));
- return(XEN_WRAP_WIDGET(menu_widget(which_menu)));
+ return(Xen_wrap_widget(menu_widget(which_menu)));
}
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_2(gl_add_to_main_menu_w, gl_add_to_main_menu)
-XEN_ARGIFY_4(gl_add_to_menu_w, gl_add_to_menu)
-XEN_NARGIFY_2(gl_remove_from_menu_w, gl_remove_from_menu)
-XEN_NARGIFY_1(g_main_menu_w, g_main_menu)
-#else
-#define gl_add_to_main_menu_w gl_add_to_main_menu
-#define gl_add_to_menu_w gl_add_to_menu
-#define gl_remove_from_menu_w gl_remove_from_menu
-#define g_main_menu_w g_main_menu
-#endif
+Xen_wrap_2_optional_args(gl_add_to_main_menu_w, gl_add_to_main_menu)
+Xen_wrap_4_optional_args(gl_add_to_menu_w, gl_add_to_menu)
+Xen_wrap_2_args(gl_remove_from_menu_w, gl_remove_from_menu)
+Xen_wrap_1_arg(g_main_menu_w, g_main_menu)
void g_init_menu(void)
{
- XEN_DEFINE_PROCEDURE(S_add_to_main_menu, gl_add_to_main_menu_w, 1, 1, 0, H_add_to_main_menu);
- XEN_DEFINE_PROCEDURE(S_add_to_menu, gl_add_to_menu_w, 3, 1, 0, H_add_to_menu);
- XEN_DEFINE_PROCEDURE(S_remove_from_menu, gl_remove_from_menu_w, 2, 0, 0, H_remove_from_menu);
- XEN_DEFINE_PROCEDURE(S_main_menu, g_main_menu_w, 1, 0, 0, H_main_menu);
+ Xen_define_procedure(S_add_to_main_menu, gl_add_to_main_menu_w, 1, 1, 0, H_add_to_main_menu);
+ Xen_define_procedure(S_add_to_menu, gl_add_to_menu_w, 3, 1, 0, H_add_to_menu);
+ Xen_define_procedure(S_remove_from_menu, gl_remove_from_menu_w, 2, 0, 0, H_remove_from_menu);
+ Xen_define_procedure(S_main_menu, g_main_menu_w, 1, 0, 0, H_main_menu);
}
diff --git a/snd-menu.h b/snd-menu.h
index 38e21ba..b885e38 100644
--- a/snd-menu.h
+++ b/snd-menu.h
@@ -1,10 +1,15 @@
#ifndef SND_MENU_H
#define SND_MENU_H
+#define I_LINES_OR_DOTS "Dots or lines"
+#define I_CHANNEL_LAYOUT "Channel layout"
+#define I_ZOOM_CENTERS_ON "Zoom centers on"
+#define I_AXIS_LAYOUT "Axis layout"
+
enum {m_menu,
f_menu, f_cascade_menu,
f_open_menu, f_open_recent_menu, f_open_recent_cascade_menu, f_close_menu, f_close_all_menu, f_save_menu, f_save_as_menu, f_revert_menu, f_exit_menu, f_new_menu,
- f_view_menu, f_print_menu, f_mix_menu, f_insert_menu, f_update_menu, f_record_menu, f_sep_menu,
+ f_view_menu, f_print_menu, f_mix_menu, f_insert_menu, f_update_menu, f_sep_menu,
e_menu, e_cascade_menu,
e_cut_menu, e_paste_menu, e_mix_menu, e_play_menu, e_save_as_menu, e_undo_menu,
e_redo_menu, e_find_menu, e_env_menu, e_header_menu, e_select_all_menu, e_unselect_menu,
@@ -12,12 +17,12 @@ enum {m_menu,
h_menu, h_cascade_menu,
h_about_snd_menu, h_fft_menu, h_find_menu, h_undo_menu, h_sync_menu, h_controls_menu,
h_env_menu, h_marks_menu, h_sound_files_menu, h_init_file_menu,
- h_mix_menu, h_recording_menu, h_keys_menu,
+ h_mix_menu, h_keys_menu,
h_play_menu, h_save_menu, h_resample_menu, h_filter_menu, h_insert_menu,
h_delete_menu, h_reverb_menu, h_debug_menu, h_region_menu, h_selection_menu, h_colors_menu,
o_menu, o_cascade_menu,
o_transform_menu, o_controls_menu,
- o_save_menu, o_save_state_menu, o_sep_menu, o_preferences_menu,
+ o_save_state_menu, o_sep_menu, o_preferences_menu,
v_menu, v_cascade_menu,
v_graph_style_menu, v_graph_style_cascade_menu,
v_lines_menu, v_dots_menu, v_filled_menu, v_dots_and_lines_menu, v_lollipops_menu,
@@ -33,6 +38,7 @@ enum {m_menu,
v_no_axes_menu, v_all_axes_menu, v_just_x_axis_menu, v_all_axes_unlabelled_menu, v_just_x_axis_unlabelled_menu, v_bare_x_axis_menu,
v_focus_style_menu, v_focus_cascade_menu,
v_focus_right_menu, v_focus_left_menu, v_focus_middle_menu, v_focus_active_menu,
+ v_grid_menu,
v_sep2_menu,
NUM_MENU_WIDGETS
};
@@ -56,7 +62,6 @@ enum {m_menu,
#define file_mix_menu (ss->mw[f_mix_menu])
#define file_insert_menu (ss->mw[f_insert_menu])
#define file_update_menu (ss->mw[f_update_menu])
-#define file_record_menu (ss->mw[f_record_menu])
#define file_sep_menu (ss->mw[f_sep_menu])
#define edit_menu (ss->mw[e_menu])
@@ -89,7 +94,6 @@ enum {m_menu,
#define help_sound_files_menu (ss->mw[h_sound_files_menu])
#define help_init_file_menu (ss->mw[h_init_file_menu])
#define help_mix_menu (ss->mw[h_mix_menu])
-#define help_recording_menu (ss->mw[h_recording_menu])
#define help_keys_menu (ss->mw[h_keys_menu])
#define help_play_menu (ss->mw[h_play_menu])
#define help_save_menu (ss->mw[h_save_menu])
@@ -106,7 +110,6 @@ enum {m_menu,
#define options_menu (ss->mw[o_menu])
#define options_cascade_menu (ss->mw[o_cascade_menu])
#define options_transform_menu (ss->mw[o_transform_menu])
-#define options_save_menu (ss->mw[o_save_menu])
#define options_save_state_menu (ss->mw[o_save_state_menu])
#define options_sep_menu (ss->mw[o_sep_menu])
#define options_preferences_menu (ss->mw[o_preferences_menu])
@@ -158,19 +161,19 @@ enum {m_menu,
#define view_focus_left_menu (ss->mw[v_focus_left_menu])
#define view_focus_middle_menu (ss->mw[v_focus_middle_menu])
#define view_focus_active_menu (ss->mw[v_focus_active_menu])
+#define view_grid_menu (ss->mw[v_grid_menu])
void edit_menu_update(void);
void view_menu_update(void);
void file_menu_update(void);
void update_file_from_menu(void);
void revert_file_from_menu(void);
-void save_options_from_menu(void);
void save_state_from_menu(void);
void unprotect_callback(int slot);
int g_add_to_main_menu(const char *label, int slot);
widget_t g_add_to_menu(int which_menu, const char *label, int callb, int position);
int g_remove_from_menu(int which_menu, const char *label);
-void g_snd_callback(int callb);
+void g_menu_callback(int callb);
#endif
diff --git a/snd-mix.c b/snd-mix.c
index f872f27..688db7e 100644
--- a/snd-mix.c
+++ b/snd-mix.c
@@ -2,20 +2,21 @@
static bool mix_vct_untagged(vct *v, chan_info *cp, mus_long_t beg, const char *origin)
{
- mus_sample_t *data;
+ mus_float_t *data, *vdata;
int i, len;
snd_fd *sf;
bool result = false;
- len = v->length;
- data = (mus_sample_t *)calloc(len, sizeof(mus_sample_t)); /* don't add into v->data! */
+ len = mus_vct_length(v);
+ vdata = mus_vct_data(v);
+ data = (mus_float_t *)calloc(len, sizeof(mus_float_t)); /* don't add into v->data! */
sf = init_sample_read(beg, cp, READ_FORWARD);
- for (i = 0; i < len; i++)
- data[i] = read_sample_to_mus_sample(sf) + MUS_FLOAT_TO_SAMPLE(v->data[i]);
+ samples_to_vct_with_reader(len, data, sf);
+ for (i = 0; i < len; i++) data[i] += vdata[i];
sf = free_snd_fd(sf);
- result = change_samples(beg, len, data, cp, origin, cp->edit_ctr); /* cp->edit_ctr since mix-vct has no edpos arg, similarly mix */
+ result = change_samples(beg, len, data, cp, origin, cp->edit_ctr, -1.0); /* cp->edit_ctr since mix-vct has no edpos arg, similarly mix */
if (result) update_graph(cp);
free(data);
@@ -32,10 +33,10 @@ static bool mix_file_untagged(const char *filename, int in_chan, chan_info *cp,
snd_fd *sf = NULL;
mus_long_t i, j, size, in_chans;
int err = 0;
- mus_sample_t **data;
- mus_sample_t *chandata;
+ mus_float_t **data;
+ mus_float_t *chandata;
- if ((num <= 0) || (!editable_p(cp)))
+ if ((num <= 0) || (!is_editable(cp)))
return(false);
ihdr = make_file_info(filename, FILE_READ_ONLY, FILE_NOT_SELECTED);
@@ -48,7 +49,7 @@ static bool mix_file_untagged(const char *filename, int in_chan, chan_info *cp,
}
ofile = snd_tempnam();
- ohdr = make_temp_header(ofile, SND_SRATE(cp->sound), 1, 0, (char *)origin);
+ ohdr = make_temp_header(ofile, snd_srate(cp->sound), 1, 0, (char *)origin);
ofd = open_temp_file(ofile, 1, ohdr, &io_err);
if (ofd == -1)
{
@@ -61,7 +62,7 @@ static bool mix_file_untagged(const char *filename, int in_chan, chan_info *cp,
return(false);
}
- if ((disk_space_p(num * mus_bytes_per_sample(ohdr->format), ofile)) != DISK_SPACE_OK)
+ if ((disk_has_space(num * mus_bytes_per_sample(ohdr->sample_type), ofile)) != DISK_SPACE_OK)
return(false);
sf = init_sample_read(beg, cp, READ_FORWARD);
@@ -81,35 +82,36 @@ static bool mix_file_untagged(const char *filename, int in_chan, chan_info *cp,
in_chans = ihdr->chans;
snd_file_open_descriptors(ifd, filename,
- ihdr->format,
+ ihdr->sample_type,
ihdr->data_location,
ihdr->chans,
ihdr->type);
during_open(ifd, filename, SND_MIX_FILE);
if (num < MAX_BUFFER_SIZE) size = num; else size = MAX_BUFFER_SIZE;
- data = (mus_sample_t **)calloc(in_chans, sizeof(mus_sample_t *));
- data[in_chan] = (mus_sample_t *)calloc(size, sizeof(mus_sample_t));
+ data = (mus_float_t **)calloc(in_chans, sizeof(mus_float_t *));
+ data[in_chan] = (mus_float_t *)calloc(size, sizeof(mus_float_t));
chandata = data[in_chan];
+ sampler_set_safe(sf, num);
lseek(ofd, ohdr->data_location, SEEK_SET);
lseek(ifd, ihdr->data_location, SEEK_SET);
- mus_file_read_chans(ifd, 0, size - 1, in_chans, data, data);
+ mus_file_read_chans(ifd, 0, size, in_chans, data, data);
for (i = 0, j = 0; i < num; i++)
{
if (j == size)
{
err = mus_file_write(ofd, 0, size - 1, 1, &chandata);
- mus_file_read_chans(ifd, 0, size - 1, in_chans, data, data);
+ mus_file_read_chans(ifd, i, size, in_chans, data, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
- chandata[j] += read_sample_to_mus_sample(sf);
+ chandata[j] += read_sample(sf);
j++;
}
if (j > 0) mus_file_write(ofd, 0, j - 1, 1, &chandata);
- close_temp_file(ofile, ofd, ohdr->type, num * mus_bytes_per_sample(ohdr->format));
+ close_temp_file(ofile, ofd, ohdr->type, num * mus_bytes_per_sample(ohdr->sample_type));
mus_file_close(ifd);
sf = free_snd_fd(sf);
free(data[in_chan]);
@@ -136,7 +138,7 @@ int mix_complete_file_at_cursor(snd_info *sp, const char *filename)
char *fullname;
fullname = mus_expand_filename(filename);
cp = any_selected_channel(sp);
- err = mix_complete_file(sp, CURSOR(cp), fullname, with_mix_tags(ss), DONT_DELETE_ME, MIX_FOLLOWS_SYNC, NULL);
+ err = mix_complete_file(sp, cursor_sample(cp), fullname, with_mix_tags(ss), DONT_DELETE_ME, MIX_FOLLOWS_SYNC, NULL);
if (err == MIX_FILE_NO_FILE)
snd_error("can't mix file: %s, %s", filename, snd_io_strerror());
else
@@ -154,8 +156,8 @@ int mix_complete_file_at_cursor(snd_info *sp, const char *filename)
void drag_and_drop_mix_at_x_y(int data, const char *filename, int x, int y)
{
int chn, snd;
- chn = UNPACK_CHANNEL(data);
- snd = UNPACK_SOUND(data);
+ chn = unpack_channel(data);
+ snd = unpack_sound(data);
if ((snd >= 0) &&
(snd < ss->max_sounds) &&
(snd_ok(ss->sounds[snd])) &&
@@ -176,7 +178,7 @@ void drag_and_drop_mix_at_x_y(int data, const char *filename, int x, int y)
chn = cp->chan;
}
select_channel(sp, chn);
- sample = snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)(SND_SRATE(sp)));
+ sample = snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)(snd_srate(sp)));
if (sample < 0) sample = 0;
fullname = mus_expand_filename(filename);
mix_complete_file(sp, sample, fullname, with_mix_tags(ss), DONT_DELETE_ME, MIX_FOLLOWS_SYNC, NULL);
@@ -193,7 +195,7 @@ int mix_complete_file(snd_info *sp, mus_long_t beg, const char *fullname, bool w
mus_long_t len;
sync_info *si = NULL;
- len = mus_sound_frames(fullname);
+ len = mus_sound_framples(fullname);
if (len < 0) return(MIX_FILE_NO_FILE);
if (len == 0) return(MIX_FILE_NO_MIX);
@@ -244,13 +246,13 @@ static int mix_infos_ctr = 0;
static char *tagged_mix_to_string(const char *mixinfile, mus_long_t beg, int file_channel, bool delete_file)
{
#if HAVE_FORTH
- return(mus_format("\"%s\" " MUS_LD " %d snd chn %s %s %s to -mix-%d", mixinfile, beg, file_channel, b2s(true), b2s(delete_file), S_mix, mix_infos_ctr));
+ return(mus_format("\"%s\" %lld %d snd chn %s %s %s to -mix-%d", mixinfile, beg, file_channel, b2s(true), b2s(delete_file), S_mix, mix_infos_ctr));
#endif
#if HAVE_SCHEME
- return(mus_format("(set! -mix-%d (%s \"%s\" " MUS_LD " %d snd chn %s %s))", mix_infos_ctr, S_mix, mixinfile, beg, file_channel, b2s(true), b2s(delete_file)));
+ return(mus_format("(set! -mix-%d (%s \"%s\" %lld %d snd chn %s %s))", mix_infos_ctr, S_mix, mixinfile, beg, file_channel, b2s(true), b2s(delete_file)));
#endif
#if HAVE_RUBY
- return(mus_format("_mix_%d = %s(\"%s\", " MUS_LD ", %d, snd, chn, %s, %s)", mix_infos_ctr, TO_PROC_NAME(S_mix), mixinfile, beg, file_channel, b2s(true), b2s(delete_file)));
+ return(mus_format("_mix_%d = %s(\"%s\", %lld, %d, snd, chn, %s, %s)", mix_infos_ctr, to_proc_name(S_mix), mixinfile, beg, file_channel, b2s(true), b2s(delete_file)));
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
return(NULL);
@@ -261,13 +263,13 @@ static char *tagged_mix_to_string(const char *mixinfile, mus_long_t beg, int fil
static char *untagged_mix_to_string(const char *mixinfile, mus_long_t beg, int file_channel, bool delete_file)
{
#if HAVE_FORTH
- return(mus_format("\"%s\" " MUS_LD " %d snd chn %s %s %s", mixinfile, beg, file_channel, b2s(false), b2s(delete_file), S_mix));
+ return(mus_format("\"%s\" %lld %d snd chn %s %s %s", mixinfile, beg, file_channel, b2s(false), b2s(delete_file), S_mix));
#endif
#if HAVE_SCHEME
- return(mus_format("(%s \"%s\" " MUS_LD " %d snd chn %s %s)", S_mix, mixinfile, beg, file_channel, b2s(false), b2s(delete_file)));
+ return(mus_format("(%s \"%s\" %lld %d snd chn %s %s)", S_mix, mixinfile, beg, file_channel, b2s(false), b2s(delete_file)));
#endif
#if HAVE_RUBY
- return(mus_format("%s(\"%s\", " MUS_LD ", %d, snd, chn, %s, %s)", TO_PROC_NAME(S_mix), mixinfile, beg, file_channel, b2s(false), b2s(delete_file)));
+ return(mus_format("%s(\"%s\", %lld, %d, snd, chn, %s, %s)", to_proc_name(S_mix), mixinfile, beg, file_channel, b2s(false), b2s(delete_file)));
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
return(NULL);
@@ -471,7 +473,7 @@ typedef struct {
int sync, original_sync;
file_delete_t temporary; /* in-filename was written by us and needs to be deleted when mix state is deleted */
peak_env_info *peak_env;
- XEN properties;
+ Xen properties;
int properties_gc_loc;
color_t color, original_color;
int x, y; /* these are needed to know where to erase while dragging the tag */
@@ -610,7 +612,7 @@ static mix_info *free_mix_info(mix_info *md)
{
snd_unprotect_at(md->properties_gc_loc);
md->properties_gc_loc = NOT_A_GC_LOC;
- md->properties = XEN_FALSE;
+ md->properties = Xen_false;
}
if (md->peak_env)
md->peak_env = free_peak_env_info(md->peak_env);
@@ -707,7 +709,7 @@ static mix_info *make_mix_info(chan_info *cp)
md->y = MIX_TAG_ERASED;
md->peak_env = NULL;
md->properties_gc_loc = NOT_A_GC_LOC;
- md->properties = XEN_FALSE;
+ md->properties = Xen_false;
md->sync = 0;
md->original_sync = ORIGINAL_SYNC_UNSET;
return(md);
@@ -739,10 +741,11 @@ static void for_each_channel_mix(chan_info *cp, void (*func)(mix_info *umx))
static void for_each_syncd_mix(int current_mix_id, void (*func)(mix_info *md, void *data), void *udata)
{
- int i, sync;
+ int sync;
sync = mix_sync_from_id(current_mix_id);
if (sync != 0)
{
+ int i;
for (i = 0; i < mix_infos_ctr; i++)
if ((i != current_mix_id) &&
(mix_is_active(i)))
@@ -829,11 +832,11 @@ void goto_mix(chan_info *cp, int count)
else
{
qsort((void *)begs, j, sizeof(mus_long_t), compare_mix_positions);
- /* now find where we are via CURSOR(cp) and go forward or back as per count */
+ /* now find where we are via cursor_sample(cp) and go forward or back as per count */
if (count > 0)
{
for (i = 0; i < j; i++)
- if (begs[i] > CURSOR(cp))
+ if (begs[i] > cursor_sample(cp))
{
count--;
if (count == 0)
@@ -842,13 +845,13 @@ void goto_mix(chan_info *cp, int count)
break;
}
}
- if ((count > 0) && (CURSOR(cp) < begs[j - 1]))
+ if ((count > 0) && (cursor_sample(cp) < begs[j - 1]))
cursor_moveto(cp, begs[j - 1]);
}
else
{
for (i = j - 1; i >= 0; i--)
- if (begs[i] < CURSOR(cp))
+ if (begs[i] < cursor_sample(cp))
{
count++;
if (count == 0)
@@ -857,7 +860,7 @@ void goto_mix(chan_info *cp, int count)
break;
}
}
- if ((count < 0) && (CURSOR(cp) > begs[0]))
+ if ((count < 0) && (cursor_sample(cp) > begs[0]))
cursor_moveto(cp, begs[0]);
}
}
@@ -874,12 +877,12 @@ mus_long_t zoom_focus_mix_in_channel_to_position(chan_info *cp)
if (mxl)
{
mus_long_t lo, hi;
- mix_state *ms;
int i;
lo = cp->axis->losamp;
hi = cp->axis->hisamp;
for (i = 0; i < mxl->size; i++)
{
+ mix_state *ms;
ms = mxl->list[i];
if ((ms) &&
(ms->beg >= lo) &&
@@ -1100,7 +1103,6 @@ bool mix_set_amp_edit(int id, mus_float_t amp)
{
if (old_ms->scaler != amp)
{
- mix_state *ms;
char *origin = NULL;
#if HAVE_FORTH
origin = mus_format("-mix-%d %.4f set-mix-amp", id, amp);
@@ -1115,6 +1117,7 @@ bool mix_set_amp_edit(int id, mus_float_t amp)
free(origin);
if (edited)
{
+ mix_state *ms;
ms = current_mix_state(md); /* this is the new copy reflecting this edit */
ms->scaler = amp;
end_mix_op(md->cp, 0, 0);
@@ -1172,7 +1175,7 @@ static int remake_mix_data(mix_state *ms, mix_info *md)
mix_reader = make_virtual_mix_reader(cp, 0, md->in_samps, md->original_index, 1.0, READ_FORWARD);
if (e)
- egen = mus_make_env_with_length(e->data, e->pts, 1.0, 0.0, 1.0, len);
+ egen = mus_make_env(e->data, e->pts, 1.0, 0.0, 1.0, 0.0, len - 1, NULL);
if (ms->speed != 1.0)
src_gen = mus_make_src(&src_input, ms->speed, sinc_width(ss), (void *)mix_reader);
@@ -1180,24 +1183,24 @@ static int remake_mix_data(mix_state *ms, mix_info *md)
if (cp->sounds[md->original_index]->type == SND_DATA_BUFFER)
{
int i;
- mus_sample_t *new_buffer;
- new_buffer = (mus_sample_t *)malloc(len * sizeof(mus_sample_t));
+ mus_float_t *new_buffer;
+ new_buffer = (mus_float_t *)malloc(len * sizeof(mus_float_t));
if (!src_gen)
{
for (i = 0; i < len; i++)
- new_buffer[i] = MUS_FLOAT_TO_SAMPLE(mus_env(egen) * read_sample(mix_reader));
+ new_buffer[i] = (mus_env(egen) * read_sample(mix_reader));
}
else
{
if (!egen)
{
for (i = 0; i < len; i++)
- new_buffer[i] = MUS_FLOAT_TO_SAMPLE(mus_src(src_gen, 0.0, &src_input));
+ new_buffer[i] = (mus_src(src_gen, 0.0, &src_input));
}
else
{
for (i = 0; i < len; i++)
- new_buffer[i] = MUS_FLOAT_TO_SAMPLE(mus_src(src_gen, 0.0, &src_input) * mus_env(egen));
+ new_buffer[i] = (mus_src(src_gen, 0.0, &src_input) * mus_env(egen));
}
}
cp->sounds[cp->sound_ctr] = make_snd_data_buffer(new_buffer, (int)len, cp->edit_ctr);
@@ -1210,27 +1213,27 @@ static int remake_mix_data(mix_state *ms, mix_info *md)
int fd, err = 0;
char *temp_file;
io_error_t io_err = IO_NO_ERROR;
- mus_sample_t **data;
- mus_sample_t *new_buffer;
+ mus_float_t **data;
+ mus_float_t *new_buffer;
int j = 0;
temp_file = snd_tempnam();
- hdr = make_temp_header(temp_file, SND_SRATE(cp->sound), 1, len, S_setB S_mix_amp_env);
+ hdr = make_temp_header(temp_file, snd_srate(cp->sound), 1, len, S_set S_mix_amp_env);
fd = open_temp_file(temp_file, 1, hdr, &io_err);
- data = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- new_buffer = (mus_sample_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_sample_t));
+ data = (mus_float_t **)malloc(sizeof(mus_float_t *));
+ new_buffer = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
data[0] = new_buffer;
if (!src_gen)
{
for (i = 0; i < len; i++)
{
- new_buffer[j++] = MUS_FLOAT_TO_SAMPLE(read_sample(mix_reader) * mus_env(egen));
+ new_buffer[j++] = (read_sample(mix_reader) * mus_env(egen));
if (j == MAX_BUFFER_SIZE)
{
err = mus_file_write(fd, 0, j - 1, 1, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
}
}
@@ -1240,12 +1243,12 @@ static int remake_mix_data(mix_state *ms, mix_info *md)
{
for (i = 0; i < len; i++)
{
- new_buffer[j++] = MUS_FLOAT_TO_SAMPLE(mus_src(src_gen, 0.0, &src_input));
+ new_buffer[j++] = (mus_src(src_gen, 0.0, &src_input));
if (j == MAX_BUFFER_SIZE)
{
err = mus_file_write(fd, 0, j - 1, 1, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
}
}
@@ -1253,31 +1256,32 @@ static int remake_mix_data(mix_state *ms, mix_info *md)
{
for (i = 0; i < len; i++)
{
- new_buffer[j++] = MUS_FLOAT_TO_SAMPLE(mus_src(src_gen, 0.0, &src_input) * mus_env(egen));
+ new_buffer[j++] = (mus_src(src_gen, 0.0, &src_input) * mus_env(egen));
if (j == MAX_BUFFER_SIZE)
{
err = mus_file_write(fd, 0, j - 1, 1, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
}
}
}
if (j > 0) mus_file_write(fd, 0, j - 1, 1, data);
- close_temp_file(temp_file, fd, hdr->type, len * mus_bytes_per_sample(hdr->format));
+ close_temp_file(temp_file, fd, hdr->type, len * mus_bytes_per_sample(hdr->sample_type));
free_file_info(hdr);
hdr = make_file_info(temp_file, FILE_READ_ONLY, FILE_NOT_SELECTED);
fd = snd_open_read(temp_file);
snd_file_open_descriptors(fd,
temp_file,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
cp->sounds[cp->sound_ctr] = make_snd_data_file(temp_file,
make_file_state(fd, hdr, 0, 0, FILE_BUFFER_SIZE),
hdr, DELETE_ME, cp->edit_ctr, 0);
+ free(temp_file);
free(new_buffer);
free(data);
}
@@ -1303,7 +1307,6 @@ bool mix_set_amp_env_edit(int id, env *e)
if (!(envs_equal(old_ms->amp_env, e)))
{
chan_info *cp;
- mix_state *ms;
char *origin = NULL, *envstr;
envstr = env_to_string(e);
@@ -1323,6 +1326,7 @@ bool mix_set_amp_env_edit(int id, env *e)
free(origin);
if (edited)
{
+ mix_state *ms;
ms = current_mix_state(md); /* this is the new copy reflecting this edit */
if (ms->amp_env) free_env(ms->amp_env);
ms->amp_env = copy_env(e);
@@ -1370,22 +1374,22 @@ bool mix_set_position_edit(int id, mus_long_t pos)
{
if (old_ms->beg != pos)
{
- mix_state *ms;
char *origin = NULL;
#if HAVE_FORTH
- origin = mus_format("-mix-%d " MUS_LD " set-mix-position", id, pos);
+ origin = mus_format("-mix-%d %lld set-mix-position", id, pos);
#endif
#if HAVE_SCHEME
- origin = mus_format("(set! (mix-position -mix-%d) " MUS_LD ")", id, pos);
+ origin = mus_format("(set! (mix-position -mix-%d) %lld)", id, pos);
#endif
#if HAVE_RUBY
- origin = mus_format("set_mix_position(_mix_%d, " MUS_LD ")", id, pos);
+ origin = mus_format("set_mix_position(_mix_%d, %lld)", id, pos);
#endif
edited = begin_mix_op(md->cp, old_ms->beg, old_ms->len, pos, old_ms->len, md->cp->edit_ctr, origin); /* this does not change beg or len */
free(origin);
if (edited)
{
+ mix_state *ms;
ms = current_mix_state(md); /* this is the new copy reflecting this edit */
unmix(md->cp, ms);
ms->beg = pos;
@@ -1410,7 +1414,6 @@ bool mix_set_speed_edit(int id, mus_float_t spd)
if (old_ms->speed != spd)
{
chan_info *cp;
- mix_state *ms;
mus_long_t len;
char *origin = NULL;
#if HAVE_FORTH
@@ -1429,6 +1432,7 @@ bool mix_set_speed_edit(int id, mus_float_t spd)
free(origin);
if (edited)
{
+ mix_state *ms;
ms = current_mix_state(md); /* this is the new copy reflecting this edit */
unmix(cp, ms); /* but unmix before changing mix length! */
@@ -1488,7 +1492,7 @@ void syncd_mix_set_speed(int id, mus_float_t speed)
char *edit_list_mix_init(chan_info *cp)
{
- char *new_list = NULL, *old_list = NULL;
+ char *new_list = NULL;
mix_list *mxl;
mxl = (mix_list *)(cp->edits[cp->edit_ctr]->mixes);
if (mxl)
@@ -1497,6 +1501,7 @@ char *edit_list_mix_init(chan_info *cp)
for (i = 0; i < mxl->size; i++)
if (mxl->list[i])
{
+ char *old_list;
int id;
id = mxl->list[i]->mix_id;
@@ -1547,7 +1552,7 @@ int hit_mix(chan_info *cp, int x, int y) /* mix tag press in snd-chn.c */
int mx, my;
mx = mix_infos[ms->mix_id]->tag_x;
if (mx <= 0)
- mx = grf_x((double)(ms->beg) / (double)(SND_SRATE(cp->sound)), cp->axis);
+ mx = grf_x((double)(ms->beg) / (double)(snd_srate(cp->sound)), cp->axis);
my = mix_infos[ms->mix_id]->tag_y + MIX_TAG_Y_OFFSET + cp->axis->y_offset;
if ((x + SLOPPY_MOUSE >= (mx - width / 2)) &&
(x - SLOPPY_MOUSE <= (mx + width / 2)) &&
@@ -1577,9 +1582,7 @@ int hit_mix_triangle(chan_info *cp, int x, int y)
mxl = (mix_list *)(cp->edits[cp->edit_ctr]->mixes); /* active mixes in the current edit of this channel */
if (mxl)
{
- int i, width, height;
- width = mix_tag_width(ss);
- height = mix_tag_height(ss);
+ int i;
for (i = 0; i < mxl->size; i++)
{
mix_state *ms;
@@ -1589,7 +1592,7 @@ int hit_mix_triangle(chan_info *cp, int x, int y)
int mx, my;
mx = mix_infos[ms->mix_id]->tag_x;
if (mx <= 0)
- mx = grf_x((double)(ms->beg) / (double)(SND_SRATE(cp->sound)), cp->axis);
+ mx = grf_x((double)(ms->beg) / (double)(snd_srate(cp->sound)), cp->axis);
my = mix_infos[ms->mix_id]->tag_y + MIX_TAG_Y_OFFSET + STRING_HEIGHT + cp->axis->y_offset;
if ((mx < (x + HIT_SLOP)) &&
((mx + play_arrow_size(ss) + HIT_SLOP) >= x) &&
@@ -1623,7 +1626,7 @@ void channel_set_mix_tags_erased(chan_info *cp)
}
-static XEN draw_mix_hook;
+static Xen draw_mix_hook;
static void draw_mix_tag(mix_info *md, int x, int y)
{
@@ -1632,24 +1635,24 @@ static void draw_mix_tag(mix_info *md, int x, int y)
graphics_context *ax;
char *lab = NULL;
- if (XEN_HOOKED(draw_mix_hook))
+ if (Xen_hook_has_list(draw_mix_hook))
{
- XEN res;
+ Xen res;
res = run_progn_hook(draw_mix_hook,
- XEN_LIST_5(new_xen_mix(md->id),
- C_TO_XEN_INT(md->x),
- C_TO_XEN_INT(md->y),
- C_TO_XEN_INT(x),
- C_TO_XEN_INT(y)),
+ Xen_list_5(new_xen_mix(md->id),
+ C_int_to_Xen_integer(md->x),
+ C_int_to_Xen_integer(md->y),
+ C_int_to_Xen_integer(x),
+ C_int_to_Xen_integer(y)),
S_draw_mix_hook);
- if (!(XEN_FALSE_P(res)))
+ if (!(Xen_is_false(res)))
{
md->x = x;
md->y = y;
- if (XEN_LIST_P(res))
+ if (Xen_is_list(res))
{
- md->tag_x = XEN_TO_C_INT(XEN_CAR(res));
- md->tag_y = XEN_TO_C_INT(XEN_CADR(res));
+ md->tag_x = Xen_integer_to_C_int(Xen_car(res));
+ md->tag_y = Xen_integer_to_C_int(Xen_cadr(res));
}
return;
}
@@ -1682,7 +1685,7 @@ static void draw_mix_tag(mix_info *md, int x, int y)
else
{
lab = (char *)calloc(16, sizeof(char));
- mus_snprintf(lab, 16, "%d", md->id);
+ snprintf(lab, 16, "%d", md->id);
}
draw_string(ax, x - width / 2, y - height / 2 + STRING_Y_OFFSET, lab, strlen(lab));
if (cp->printing) ps_draw_string(cp->axis, x - width / 2, y - height / 2 + STRING_Y_OFFSET, lab);
@@ -1782,11 +1785,11 @@ static peak_env_info *env_on_env(env *e, peak_env_info *peaks)
if (ep)
{
int i;
- mus_float_t val;
mus_any *me;
- me = mus_make_env_with_length(e->data, e->pts, 1.0, 0.0, e->base, ep->peak_env_size);
+ me = mus_make_env(e->data, e->pts, 1.0, 0.0, e->base, 0.0, ep->peak_env_size - 1, NULL);
for (i = 0; i < ep->peak_env_size; i++)
{
+ mus_float_t val;
val = mus_env(me);
if (val >= 0.0)
{
@@ -1808,7 +1811,7 @@ static peak_env_info *env_on_env(env *e, peak_env_info *peaks)
static int prepare_mix_peak_env(mix_info *md, mus_float_t scl, int yoff, mus_long_t newbeg, mus_long_t newend, double srate, axis_info *ap)
{
int i, j, mix_start;
- int lastx, newx;
+ int lastx;
double xend, xstart, xstep, mix_samps_per_bin;
peak_env_info *ep;
env *amp_env;
@@ -1846,6 +1849,7 @@ static int prepare_mix_peak_env(mix_info *md, mus_float_t scl, int yoff, mus_lon
for (i = mix_start, j = 0; (xstart < xend) && (i < ep->peak_env_size); xstart += xstep, i++)
{
mus_float_t low, high;
+ int newx;
low = ep->data_min[i];
high = ep->data_max[i];
newx = local_grf_x(xstart, ap);
@@ -1878,9 +1882,8 @@ static int prepare_mix_waveform(mix_info *md, mix_state *ms, axis_info *ap, mus_
mus_long_t i, newbeg, newend;
int pts = 0;
mus_long_t samps;
- bool widely_spaced;
mus_float_t samples_per_pixel;
- double x, incr, initial_x;
+ double x;
mus_long_t lo, hi;
snd_fd *sf = NULL;
int x_start, x_end;
@@ -1904,6 +1907,8 @@ static int prepare_mix_waveform(mix_info *md, mix_state *ms, axis_info *ap, mus_
(samps < POINT_BUFFER_SIZE)))
{
int j;
+ bool widely_spaced;
+ double incr, initial_x;
if (newbeg < lo) /* mix starts before current left x0 point */
{
sf = make_virtual_mix_reader(md->cp, lo - newbeg, ms->len, ms->index, ms->scaler * scl, READ_FORWARD);
@@ -1941,7 +1946,7 @@ static int prepare_mix_waveform(mix_info *md, mix_state *ms, axis_info *ap, mus_
{
(*two_sided) = true;
if (mix_input_peak_env_usable(md, samples_per_pixel))
- pts = prepare_mix_peak_env(md, scl, yoff, newbeg, newend, (double)cur_srate, ap);
+ pts = prepare_mix_peak_env(md, ms->scaler * scl, yoff, newbeg, newend, (double)cur_srate, ap);
else
{
int xi, j;
@@ -2017,7 +2022,7 @@ int prepare_mix_dialog_waveform(int mix_id, axis_info *ap, bool *two_sided)
x1 = ap->x1;
y0 = ap->y0;
y1 = ap->y1;
- cur_srate = (double)SND_SRATE(md->cp->sound);
+ cur_srate = (double)snd_srate(md->cp->sound);
ms = current_mix_state(md);
ap->losamp = ms->beg;
ap->hisamp = ms->beg + ms->len;
@@ -2044,7 +2049,9 @@ int prepare_mix_dialog_waveform(int mix_id, axis_info *ap, bool *two_sided)
static void erase_mix_tag_and_waveform(mix_state *ms, chan_info *cp, axis_info *ap, graphics_context *ax, int x, int y)
{
int wave_width, wave_height, old_x;
- wave_width = (int)(ms->len * ((double)(ap->x_axis_x1 - ap->x_axis_x0) / (double)(ap->hisamp - ap->losamp)));
+ if (ap->hisamp > ap->losamp)
+ wave_width = (int)(ms->len * ((double)(ap->x_axis_x1 - ap->x_axis_x0) / (double)(ap->hisamp - ap->losamp)));
+ else wave_width = 0;
wave_height = mix_waveform_height(ss);
old_x = x + mix_tag_width(ss) - 2;
if ((old_x + wave_width) > ap->x_axis_x1)
@@ -2072,7 +2079,7 @@ static void draw_mix_tag_and_waveform(mix_info *md, mix_state *ms, int x)
{
bool two_sided = false;
int pts;
- pts = prepare_mix_waveform(md, ms, ap, mix_waveform_height(ss), y + STRING_HEIGHT / 2, (double)SND_SRATE(cp->sound), &two_sided);
+ pts = prepare_mix_waveform(md, ms, ap, mix_waveform_height(ss), y + STRING_HEIGHT / 2, (double)snd_srate(cp->sound), &two_sided);
if (pts > 0)
{
graphics_context *ax;
@@ -2095,7 +2102,7 @@ static void display_one_mix_with_bounds(mix_state *ms, chan_info *cp, axis_info
mix_info *md;
int x;
md = mix_infos[ms->mix_id];
- x = grf_x((double)(ms->beg) / (double)SND_SRATE(cp->sound), ap);
+ x = grf_x((double)(ms->beg) / (double)snd_srate(cp->sound), ap);
if ((x + mix_tag_width(ss)) <= ap->x_axis_x1) /* not cut off on right */
draw_mix_tag_and_waveform(md, ms, x);
}
@@ -2165,8 +2172,8 @@ static TIMEOUT_TYPE watch_mix(TIMEOUT_ARGS)
static int edpos_before_drag = 0;
static with_hook_t hookable_before_drag;
static bool mix_dragged = false;
-static XEN mix_release_hook;
-static XEN mix_drag_hook;
+static Xen mix_release_hook;
+static Xen mix_drag_hook;
static mus_long_t orig_beg = 0;
/* also mix_click_hook in snd-chn.c */
@@ -2215,7 +2222,7 @@ void move_mix_tag(int mix_id, int x, int y)
keep_dragging_syncd_mixes(mix_id);
}
- pos = snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)(SND_SRATE(cp->sound)));
+ pos = snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)(snd_srate(cp->sound)));
mix_set_position_edit(mix_id, pos);
mix_dragged = true;
@@ -2240,7 +2247,7 @@ void move_mix_tag(int mix_id, int x, int y)
watch_mix_proc = CALL_TIMEOUT(watch_mix, MIX_WAIT_TIME, md);
}
}
- x = move_axis(cp, ap, x); /* calls update_graph eventually (in snd-chn.c reset_x_display) */
+ x = move_axis(cp, x); /* calls update_graph eventually (in snd-chn.c reset_x_display) */
axis_changed = true;
}
else
@@ -2281,11 +2288,11 @@ void move_mix_tag(int mix_id, int x, int y)
#endif
}
- if (XEN_HOOKED(mix_drag_hook))
+ if (Xen_hook_has_list(mix_drag_hook))
run_hook(mix_drag_hook,
- XEN_LIST_3(new_xen_mix(mix_id),
- C_TO_XEN_INT(x),
- C_TO_XEN_INT(y)),
+ Xen_list_3(new_xen_mix(mix_id),
+ C_int_to_Xen_integer(x),
+ C_int_to_Xen_integer(y)),
S_mix_drag_hook);
}
@@ -2314,7 +2321,7 @@ void finish_moving_mix_tag(int mix_id, int x)
/* from mouse release after tag drag in snd-chn.c only */
mix_info *md;
mus_long_t pos;
- XEN res = XEN_FALSE;
+ Xen res = Xen_false;
chan_info *cp;
mix_dragged = false;
@@ -2328,7 +2335,7 @@ void finish_moving_mix_tag(int mix_id, int x)
if (!md) return;
cp = md->cp;
- pos = snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)(SND_SRATE(cp->sound)));
+ pos = snd_round_mus_long_t(ungrf_x(cp->axis, x) * (double)(snd_srate(cp->sound)));
if (pos < 0) pos = 0;
cp->hookable = hookable_before_drag;
@@ -2336,19 +2343,19 @@ void finish_moving_mix_tag(int mix_id, int x)
cp->edit_ctr--;
keep_dragging_syncd_mixes(mix_id); /* fixup edpos */
- if (XEN_HOOKED(mix_release_hook))
+ if (Xen_hook_has_list(mix_release_hook))
res = run_progn_hook(mix_release_hook,
- XEN_LIST_2(new_xen_mix(mix_id),
- C_TO_XEN_INT64_T(pos - mix_position_from_id(mix_id))),
+ Xen_list_2(new_xen_mix(mix_id),
+ C_llong_to_Xen_llong(pos - mix_position_from_id(mix_id))),
S_mix_release_hook);
- if (!(XEN_TRUE_P(res)))
+ if (!(Xen_is_true(res)))
{
mus_long_t old_pos;
old_pos = mix_position_from_id(mix_id);
if (mix_set_position_edit(mix_id, pos))
{
- CURSOR(cp) = pos;
+ cursor_sample(cp) = pos;
after_edit(cp);
update_graph(cp); /* this causes flashing, but it's next to impossible to fix
* display_channel_id assumes previous id was erased, as does any after_graph_hook function
@@ -2373,6 +2380,7 @@ void mix_display_during_drag(int mix_id, mus_long_t drag_beg, mus_long_t drag_en
display_channel_time_data(cp);
else
{
+#if USE_MOTIF
mus_long_t cur_end, ms_beg;
ms_beg = mix_position_from_id(mix_id);
cur_end = ms_beg + mix_length_from_id(mix_id);
@@ -2380,7 +2388,6 @@ void mix_display_during_drag(int mix_id, mus_long_t drag_beg, mus_long_t drag_en
drag_end = cur_end;
if (ms_beg < drag_beg)
drag_beg = ms_beg;
-#if USE_MOTIF
make_partial_graph(cp, drag_beg, drag_end);
display_channel_mixes_with_bounds(cp, drag_beg, drag_end);
#else
@@ -2391,13 +2398,13 @@ void mix_display_during_drag(int mix_id, mus_long_t drag_beg, mus_long_t drag_en
-static XEN snd_no_such_mix_error(const char *caller, XEN n)
+static Xen snd_no_such_mix_error(const char *caller, Xen n)
{
- XEN_ERROR(XEN_ERROR_TYPE("no-such-mix"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such mix, ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("no-such-mix"),
+ Xen_list_3(C_string_to_Xen_string("~A: no such mix, ~A"),
+ C_string_to_Xen_string(caller),
n));
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -2554,53 +2561,53 @@ typedef struct {
/* md->cp->sounds[md->original_index] is the original mix data */
-#define XEN_TO_XEN_MIX(arg) ((xen_mix *)XEN_OBJECT_REF(arg))
+#define Xen_to_xen_mix(arg) ((xen_mix *)Xen_object_ref(arg))
-int xen_mix_to_int(XEN n)
+int xen_mix_to_int(Xen n)
{
xen_mix *mx;
- mx = XEN_TO_XEN_MIX(n);
+ mx = Xen_to_xen_mix(n);
return(mx->n);
}
-static XEN_OBJECT_TYPE xen_mix_tag;
+static Xen_object_type_t xen_mix_tag;
-bool xen_mix_p(XEN obj)
+bool xen_is_mix(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, xen_mix_tag));
+ return(Xen_c_object_is_type(obj, xen_mix_tag));
}
static void xen_mix_free(xen_mix *v) {if (v) free(v);}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(xen_mix, free_xen_mix, xen_mix_free)
+Xen_wrap_free(xen_mix, free_xen_mix, xen_mix_free)
static char *xen_mix_to_string(xen_mix *v)
{
- #define XEN_MIX_PRINT_BUFFER_SIZE 64
+ #define xen_is_mixRINT_BUFFER_SIZE 64
char *buf;
if (v == NULL) return(NULL);
- buf = (char *)calloc(XEN_MIX_PRINT_BUFFER_SIZE, sizeof(char));
- snprintf(buf, XEN_MIX_PRINT_BUFFER_SIZE, "#<mix %d>", v->n);
+ buf = (char *)calloc(xen_is_mixRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, xen_is_mixRINT_BUFFER_SIZE, "#<mix %d>", v->n);
return(buf);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(xen_mix, print_xen_mix, xen_mix_to_string)
+Xen_wrap_print(xen_mix, print_xen_mix, xen_mix_to_string)
#if HAVE_FORTH || HAVE_RUBY
-static XEN g_xen_mix_to_string(XEN obj)
+static Xen g_xen_mix_to_string(Xen obj)
{
char *vstr;
- XEN result;
+ Xen result;
#define S_xen_mix_to_string "mix->string"
- XEN_ASSERT_TYPE(XEN_MIX_P(obj), obj, XEN_ONLY_ARG, S_xen_mix_to_string, "a mix");
+ Xen_check_type(xen_is_mix(obj), obj, 1, S_xen_mix_to_string, "a mix");
- vstr = xen_mix_to_string(XEN_TO_XEN_MIX(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = xen_mix_to_string(Xen_to_xen_mix(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
@@ -2614,10 +2621,10 @@ static bool xen_mix_equalp(xen_mix *v1, xen_mix *v2)
(v1->n == v2->n));
}
-static XEN equalp_xen_mix(XEN obj1, XEN obj2)
+static Xen equalp_xen_mix(Xen obj1, Xen obj2)
{
- if ((!(XEN_MIX_P(obj1))) || (!(XEN_MIX_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(xen_mix_equalp(XEN_TO_XEN_MIX(obj1), XEN_TO_XEN_MIX(obj2))));
+ if ((!(xen_is_mix(obj1))) || (!(xen_is_mix(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(xen_mix_equalp(Xen_to_xen_mix(obj1), Xen_to_xen_mix(obj2))));
}
#endif
@@ -2631,19 +2638,19 @@ static xen_mix *xen_mix_make(int n)
}
-XEN new_xen_mix(int n)
+Xen new_xen_mix(int n)
{
xen_mix *mx;
if (n < 0)
- return(XEN_FALSE);
+ return(Xen_false);
mx = xen_mix_make(n);
- XEN_MAKE_AND_RETURN_OBJECT(xen_mix_tag, mx, 0, free_xen_mix);
+ return(Xen_make_object(xen_mix_tag, mx, 0, free_xen_mix));
}
#if HAVE_SCHEME
-static XEN s7_xen_mix_length(s7_scheme *sc, s7_pointer obj)
+static Xen s7_xen_mix_length(s7_scheme *sc, s7_pointer obj)
{
return(g_mix_length(obj));
}
@@ -2656,9 +2663,11 @@ static bool s7_xen_mix_equalp(void *obj1, void *obj2)
}
-static XEN s7_xen_mix_copy(s7_scheme *sc, s7_pointer obj)
+static Xen s7_xen_mix_copy(s7_scheme *sc, s7_pointer args)
{
- return(new_xen_mix(copy_mix(XEN_MIX_TO_C_INT(obj))));
+ s7_pointer obj;
+ obj = s7_car(args);
+ return(new_xen_mix(copy_mix(Xen_mix_to_C_int(obj))));
}
#endif
@@ -2666,12 +2675,12 @@ static XEN s7_xen_mix_copy(s7_scheme *sc, s7_pointer obj)
static void init_xen_mix(void)
{
#if HAVE_SCHEME
- xen_mix_tag = XEN_MAKE_OBJECT_TYPE("<mix>", print_xen_mix, free_xen_mix, s7_xen_mix_equalp, NULL, NULL, NULL, s7_xen_mix_length, s7_xen_mix_copy, NULL);
+ xen_mix_tag = s7_new_type_x(s7, "<mix>", print_xen_mix, free_xen_mix, s7_xen_mix_equalp, NULL, NULL, NULL, s7_xen_mix_length, s7_xen_mix_copy, NULL, NULL);
#else
#if HAVE_RUBY
- xen_mix_tag = XEN_MAKE_OBJECT_TYPE("XenMix", sizeof(xen_mix));
+ xen_mix_tag = Xen_make_object_type("XenMix", sizeof(xen_mix));
#else
- xen_mix_tag = XEN_MAKE_OBJECT_TYPE("Mix", sizeof(xen_mix));
+ xen_mix_tag = Xen_make_object_type("Mix", sizeof(xen_mix));
#endif
#endif
@@ -2684,112 +2693,112 @@ static void init_xen_mix(void)
#endif
#if HAVE_RUBY
- rb_define_method(xen_mix_tag, "to_s", XEN_PROCEDURE_CAST print_xen_mix, 0);
- rb_define_method(xen_mix_tag, "eql?", XEN_PROCEDURE_CAST equalp_xen_mix, 1);
- rb_define_method(xen_mix_tag, "==", XEN_PROCEDURE_CAST equalp_xen_mix, 1);
- rb_define_method(xen_mix_tag, "length", XEN_PROCEDURE_CAST g_mix_length, 0);
- rb_define_method(xen_mix_tag, "to_str", XEN_PROCEDURE_CAST g_xen_mix_to_string, 0);
+ rb_define_method(xen_mix_tag, "to_s", Xen_procedure_cast print_xen_mix, 0);
+ rb_define_method(xen_mix_tag, "eql?", Xen_procedure_cast equalp_xen_mix, 1);
+ rb_define_method(xen_mix_tag, "==", Xen_procedure_cast equalp_xen_mix, 1);
+ rb_define_method(xen_mix_tag, "length", Xen_procedure_cast g_mix_length, 0);
+ rb_define_method(xen_mix_tag, "to_str", Xen_procedure_cast g_xen_mix_to_string, 0);
#endif
}
/* -------------------------------------------------------------------------------- */
-static XEN g_integer_to_mix(XEN n)
+static Xen g_integer_to_mix(Xen n)
{
#define H_integer_to_mix "(" S_integer_to_mix " n) returns a mix object corresponding to the given integer"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n), n, XEN_ONLY_ARG, S_integer_to_mix, "an integer");
- return(new_xen_mix(XEN_TO_C_INT(n)));
+ Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_mix, "an integer");
+ return(new_xen_mix(Xen_integer_to_C_int(n)));
}
-static XEN g_mix_to_integer(XEN n)
+static Xen g_mix_to_integer(Xen n)
{
#define H_mix_to_integer "(" S_mix_to_integer " id) returns the integer corresponding to the given mix object"
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_to_integer, "a mix");
- return(C_TO_XEN_INT(xen_mix_to_int(n)));
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_to_integer, "a mix");
+ return(C_int_to_Xen_integer(xen_mix_to_int(n)));
}
-XEN g_mix_length(XEN n)
+Xen g_mix_length(Xen n)
{
#define H_mix_length "(" S_mix_length " id): mix's length in samples"
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_length, "a mix");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_length, "a mix");
+ id = Xen_mix_to_C_int(n);
if (mix_is_active(id))
- return(C_TO_XEN_INT64_T(mix_length_from_id(id)));
+ return(C_llong_to_Xen_llong(mix_length_from_id(id)));
return(snd_no_such_mix_error(S_mix_length, n));
}
-static XEN g_mix_position(XEN n)
+static Xen g_mix_position(Xen n)
{
int id;
#define H_mix_position "(" S_mix_position " id): mix's begin time in the output in samples"
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_position, "a mix");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_position, "a mix");
+ id = Xen_mix_to_C_int(n);
if (mix_is_active(id))
- return(C_TO_XEN_INT64_T(mix_position_from_id(id)));
+ return(C_llong_to_Xen_llong(mix_position_from_id(id)));
return(snd_no_such_mix_error(S_mix_position, n));
}
-static XEN g_set_mix_position(XEN n, XEN pos)
+static Xen g_set_mix_position(Xen n, Xen pos)
{
int id;
mus_long_t beg;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_setB S_mix_position, "a mix");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(pos), pos, XEN_ARG_2, S_setB S_mix_position, "an integer");
+ Xen_check_type(xen_is_mix(n), n, 1, S_set S_mix_position, "a mix");
+ Xen_check_type(Xen_is_llong(pos), pos, 2, S_set S_mix_position, "an integer");
- id = XEN_MIX_TO_C_INT(n);
+ id = Xen_mix_to_C_int(n);
if (!(mix_is_active(id)))
- return(snd_no_such_mix_error(S_setB S_mix_position, n));
+ return(snd_no_such_mix_error(S_set S_mix_position, n));
- beg = beg_to_sample(pos, S_setB S_mix_position);
+ beg = beg_to_sample(pos, S_set S_mix_position);
if (mix_set_position_edit(id, beg))
after_mix_edit(id);
return(pos);
}
-static XEN g_mix_amp(XEN n)
+static Xen g_mix_amp(Xen n)
{
#define H_mix_amp "(" S_mix_amp " id): mix's scaler"
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_amp, "a mix");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_amp, "a mix");
+ id = Xen_mix_to_C_int(n);
if (mix_is_active(id))
- return(C_TO_XEN_DOUBLE(mix_amp_from_id(id)));
+ return(C_double_to_Xen_real(mix_amp_from_id(id)));
return(snd_no_such_mix_error(S_mix_amp, n));
}
-static XEN g_set_mix_amp(XEN n, XEN uval)
+static Xen g_set_mix_amp(Xen n, Xen uval)
{
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_setB S_mix_amp, "a mix");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(uval), uval, XEN_ARG_2, S_setB S_mix_amp, "a number");
+ Xen_check_type(xen_is_mix(n), n, 1, S_set S_mix_amp, "a mix");
+ Xen_check_type(Xen_is_number(uval), uval, 2, S_set S_mix_amp, "a number");
- id = XEN_MIX_TO_C_INT(n);
+ id = Xen_mix_to_C_int(n);
if (!(mix_is_active(id)))
- return(snd_no_such_mix_error(S_setB S_mix_amp, n));
+ return(snd_no_such_mix_error(S_set S_mix_amp, n));
- if (mix_set_amp_edit(id, XEN_TO_C_DOUBLE(uval)))
+ if (mix_set_amp_edit(id, Xen_real_to_C_double(uval)))
after_mix_edit(id);
return(uval);
}
-static XEN g_mix_amp_env(XEN n)
+static Xen g_mix_amp_env(Xen n)
{
#define H_mix_amp_env "(" S_mix_amp_env " id): amplitude envelope applied to mix"
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_mix_amp_env, "a mix");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_amp_env, "a mix");
+ id = Xen_mix_to_C_int(n);
if (mix_is_active(id))
return(env_to_xen(mix_amp_env_from_id(id)));
@@ -2797,19 +2806,19 @@ static XEN g_mix_amp_env(XEN n)
}
-static XEN g_set_mix_amp_env(XEN n, XEN val)
+static Xen g_set_mix_amp_env(Xen n, Xen val)
{
env *e = NULL;
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_setB S_mix_amp_env, "a mix");
- XEN_ASSERT_TYPE(XEN_LIST_P(val) || XEN_FALSE_P(val), val, XEN_ARG_2, S_setB S_mix_amp_env, "a list or " PROC_FALSE);
+ Xen_check_type(xen_is_mix(n), n, 1, S_set S_mix_amp_env, "a mix");
+ Xen_check_type(Xen_is_list(val) || Xen_is_false(val), val, 2, S_set S_mix_amp_env, "a list or " PROC_FALSE);
- id = XEN_MIX_TO_C_INT(n);
+ id = Xen_mix_to_C_int(n);
if (!(mix_is_active(id)))
- return(snd_no_such_mix_error(S_setB S_mix_amp_env, n));
+ return(snd_no_such_mix_error(S_set S_mix_amp_env, n));
- if (XEN_LIST_P(val))
- e = get_env(val, S_setB S_mix_amp_env);
+ if (Xen_is_list(val))
+ e = get_env(val, S_set S_mix_amp_env);
if (mix_set_amp_env_edit(id, e))
after_mix_edit(id);
@@ -2820,114 +2829,114 @@ static XEN g_set_mix_amp_env(XEN n, XEN val)
}
-static XEN g_mix_speed(XEN n)
+static Xen g_mix_speed(Xen n)
{
#define H_mix_speed "(" S_mix_speed " id): mix's resampling ratio"
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_speed, "a mix");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_speed, "a mix");
+ id = Xen_mix_to_C_int(n);
if (mix_is_active(id))
- return(C_TO_XEN_DOUBLE(mix_speed_from_id(id)));
+ return(C_double_to_Xen_real(mix_speed_from_id(id)));
return(snd_no_such_mix_error(S_mix_speed, n));
}
-static XEN g_set_mix_speed(XEN n, XEN uval)
+static Xen g_set_mix_speed(Xen n, Xen uval)
{
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_setB S_mix_speed, "a mix");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(uval), uval, XEN_ARG_2, S_setB S_mix_speed, "a number");
+ Xen_check_type(xen_is_mix(n), n, 1, S_set S_mix_speed, "a mix");
+ Xen_check_type(Xen_is_number(uval), uval, 2, S_set S_mix_speed, "a number");
- id = XEN_MIX_TO_C_INT(n);
+ id = Xen_mix_to_C_int(n);
if (!(mix_is_active(id)))
- return(snd_no_such_mix_error(S_setB S_mix_speed, n));
+ return(snd_no_such_mix_error(S_set S_mix_speed, n));
- if (mix_set_speed_edit(id, XEN_TO_C_DOUBLE(uval)))
+ if (mix_set_speed_edit(id, Xen_real_to_C_double(uval)))
after_mix_edit(id);
return(uval);
}
-static XEN g_mix_name(XEN n)
+static Xen g_mix_name(Xen n)
{
#define H_mix_name "(" S_mix_name " id): name of mix"
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_name, "a mix");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_name, "a mix");
+ id = Xen_mix_to_C_int(n);
if (mix_exists(id))
- return(C_TO_XEN_STRING(mix_name_from_id(id)));
+ return(C_string_to_Xen_string(mix_name_from_id(id)));
return(snd_no_such_mix_error(S_mix_name, n));
}
-static XEN g_set_mix_name(XEN n, XEN val)
+static Xen g_set_mix_name(Xen n, Xen val)
{
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_setB S_mix_name, "a mix");
- XEN_ASSERT_TYPE(XEN_STRING_P(val) || XEN_FALSE_P(val), val, XEN_ARG_2, S_setB S_mix_name, "a string");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_set S_mix_name, "a mix");
+ Xen_check_type(Xen_is_string(val) || Xen_is_false(val), val, 2, S_set S_mix_name, "a string");
+ id = Xen_mix_to_C_int(n);
if (mix_exists(id))
{
- mix_set_name_from_id(id, (XEN_STRING_P(val) ? XEN_TO_C_STRING(val) : NULL));
+ mix_set_name_from_id(id, (Xen_is_string(val) ? Xen_string_to_C_string(val) : NULL));
update_graph(mix_chan_info_from_id(id));
}
- else return(snd_no_such_mix_error(S_setB S_mix_name, n));
+ else return(snd_no_such_mix_error(S_set S_mix_name, n));
return(val);
}
-XEN g_mix_sync(XEN n)
+Xen g_mix_sync(Xen n)
{
#define H_mix_sync "(" S_mix_sync " id): mix sync field (an integer)"
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_sync, "a mix");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_sync, "a mix");
+ id = Xen_mix_to_C_int(n);
if (mix_exists(id))
- return(C_TO_XEN_INT(mix_sync_from_id(id)));
+ return(C_int_to_Xen_integer(mix_sync_from_id(id)));
return(snd_no_such_mix_error(S_mix_sync, n));
}
-XEN g_set_mix_sync(XEN n, XEN val)
+Xen g_set_mix_sync(Xen n, Xen val)
{
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_setB S_mix_sync, "a mix");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, S_setB S_mix_sync, "an integer");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_set S_mix_sync, "a mix");
+ Xen_check_type(Xen_is_integer(val), val, 2, S_set S_mix_sync, "an integer");
+ id = Xen_mix_to_C_int(n);
if (mix_exists(id))
- mix_set_sync_from_id(id, XEN_TO_C_INT(val));
- else return(snd_no_such_mix_error(S_setB S_mix_sync, n));
+ mix_set_sync_from_id(id, Xen_integer_to_C_int(val));
+ else return(snd_no_such_mix_error(S_set S_mix_sync, n));
return(val);
}
-static XEN g_mix_sync_max(void)
+static Xen g_mix_sync_max(void)
{
#define H_mix_sync_max "(" S_mix_sync_max "): max mix sync value seen so far"
- return(C_TO_XEN_INT(current_mix_sync_max));
+ return(C_int_to_Xen_integer(current_mix_sync_max));
}
-static XEN g_mix_tag_y(XEN n)
+static Xen g_mix_tag_y(Xen n)
{
#define H_mix_tag_y "(" S_mix_tag_y " id): height of mix's tag"
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_tag_y, "a mix");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_tag_y, "a mix");
+ id = Xen_mix_to_C_int(n);
if (mix_exists(id))
- return(C_TO_XEN_INT(mix_tag_y_from_id(id)));
+ return(C_int_to_Xen_integer(mix_tag_y_from_id(id)));
return(snd_no_such_mix_error(S_mix_tag_y, n));
}
-static XEN g_set_mix_tag_y(XEN n, XEN val)
+static Xen g_set_mix_tag_y(Xen n, Xen val)
{
int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_setB S_mix_tag_y, "a mix");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, S_setB S_mix_tag_y, "an integer");
- id = XEN_MIX_TO_C_INT(n);
+ Xen_check_type(xen_is_mix(n), n, 1, S_set S_mix_tag_y, "a mix");
+ Xen_check_type(Xen_is_integer(val), val, 2, S_set S_mix_tag_y, "an integer");
+ id = Xen_mix_to_C_int(n);
if (mix_exists(id))
{
@@ -2944,93 +2953,94 @@ static XEN g_set_mix_tag_y(XEN n, XEN val)
graphics_context *ax;
ax = erase_context(cp);
#if USE_GTK
- ss->cr = MAKE_CAIRO(ax->wn);
+ ss->cr = make_cairo(ax->wn);
#endif
erase_mix_tag_and_waveform(ms, cp, cp->axis, ax, md->x, cp->axis->y_offset + md->tag_y + MIX_TAG_Y_OFFSET);
- md->tag_y = XEN_TO_C_INT(val);
+ md->tag_y = Xen_integer_to_C_int(val);
display_one_mix(ms, cp);
#if USE_GTK
- FREE_CAIRO(ss->cr);
+ free_cairo(ss->cr);
ss->cr = NULL;
copy_context(cp);
#endif
}
- else md->tag_y = XEN_TO_C_INT(val);
+ else md->tag_y = Xen_integer_to_C_int(val);
}
- else return(snd_no_such_mix_error(S_setB S_mix_tag_y, n));
+ else return(snd_no_such_mix_error(S_set S_mix_tag_y, n));
return(val);
}
-static XEN g_mix_properties(XEN n)
+static Xen g_mix_properties(Xen n)
{
- #define H_mix_properties "(" S_mix_properties " id): A property list associated with the given mix. \
-The accessor mix-property is provided in mix." XEN_FILE_EXTENSION "."
+ #define H_mix_properties "(" S_mix_properties " id): A property list associated with the given mix."
mix_info *md;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_mix_properties, "a mix");
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_properties, "a mix");
- md = md_from_id(XEN_MIX_TO_C_INT(n));
+ md = md_from_id(Xen_mix_to_C_int(n));
if (md == NULL)
return(snd_no_such_mix_error(S_mix_properties, n));
- if (!(XEN_VECTOR_P(md->properties)))
+ if (!(Xen_is_vector(md->properties)))
{
- md->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ md->properties = Xen_make_vector(1, Xen_empty_list);
md->properties_gc_loc = snd_protect(md->properties);
}
- return(XEN_VECTOR_REF(md->properties, 0));
+ return(Xen_vector_ref(md->properties, 0));
}
-static XEN g_set_mix_properties(XEN n, XEN val)
+static Xen g_set_mix_properties(Xen n, Xen val)
{
mix_info *md;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ARG_1, S_mix_properties, "a mix");
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_properties, "a mix");
- md = md_from_id(XEN_MIX_TO_C_INT(n));
+ md = md_from_id(Xen_mix_to_C_int(n));
if (md == NULL)
- return(snd_no_such_mix_error(S_setB S_mix_properties, n));
+ return(snd_no_such_mix_error(S_set S_mix_properties, n));
- if (!(XEN_VECTOR_P(md->properties)))
+ if (!(Xen_is_vector(md->properties)))
{
- md->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ md->properties = Xen_make_vector(1, Xen_empty_list);
md->properties_gc_loc = snd_protect(md->properties);
}
- XEN_VECTOR_SET(md->properties, 0, val);
- return(XEN_VECTOR_REF(md->properties, 0));
+ Xen_vector_set(md->properties, 0, val);
+ return(Xen_vector_ref(md->properties, 0));
}
-static XEN g_mix_property(XEN key, XEN id)
+static Xen g_mix_property(Xen key, Xen id)
{
- #define H_mix_property "(" S_mix_property " key id) returns the value associated with 'key' in the given mix's property list, or #f"
- return(XEN_ASSOC_REF(key, g_mix_properties(id)));
+ #define H_mix_property "(" S_mix_property " key id) returns the value associated with 'key' in the given mix's property list, or " PROC_FALSE "."
+ Xen_check_type(xen_is_mix(id), id, 2, S_mix_property, "a mix");
+ return(Xen_assoc_ref(key, g_mix_properties(id)));
}
-static XEN g_set_mix_property(XEN key, XEN id, XEN val)
+static Xen g_set_mix_property(Xen key, Xen id, Xen val)
{
- g_set_mix_properties(id, XEN_ASSOC_SET(key, val, g_mix_properties(id)));
+ Xen_check_type(xen_is_mix(id), id, 2, S_mix_property, "a mix");
+ g_set_mix_properties(id, Xen_assoc_set(key, val, g_mix_properties(id)));
return(val);
}
-static XEN g_mix_home(XEN n)
+static Xen g_mix_home(Xen n)
{
#define H_mix_home "(" S_mix_home " id): list of sound index and channel for the output of the mix, and the \
filename or " PROC_FALSE " and the input channel for its data."
mix_info *md;
- XEN_ASSERT_TYPE(XEN_MIX_P(n), n, XEN_ONLY_ARG, S_mix_home, "a mix");
- md = md_from_id(XEN_MIX_TO_C_INT(n));
+ Xen_check_type(xen_is_mix(n), n, 1, S_mix_home, "a mix");
+ md = md_from_id(Xen_mix_to_C_int(n));
if (md == NULL)
return(snd_no_such_mix_error(S_mix_home, n));
- return(XEN_LIST_4(C_INT_TO_XEN_SOUND((md->cp->sound)->index),
- C_TO_XEN_INT((md->cp->chan)),
- (md->in_filename) ? C_TO_XEN_STRING(md->in_filename) : XEN_FALSE,
- C_TO_XEN_INT(md->in_chan)));
+ return(Xen_list_4(C_int_to_Xen_sound((md->cp->sound)->index),
+ C_int_to_Xen_integer((md->cp->chan)),
+ (md->in_filename) ? C_string_to_Xen_string(md->in_filename) : Xen_false,
+ C_int_to_Xen_integer(md->in_chan)));
}
@@ -3047,7 +3057,7 @@ void color_mixes(color_t color)
}
-double mix_maxamp(int mix_id)
+static double mix_maxamp(int mix_id)
{
mix_info *md;
mix_state *ms;
@@ -3072,9 +3082,9 @@ double mix_maxamp(int mix_id)
}
-XEN g_mix_maxamp(XEN mix_id)
+Xen g_mix_maxamp(Xen mix_id)
{
- return(C_TO_XEN_DOUBLE(mix_maxamp(XEN_MIX_TO_C_INT(mix_id))));
+ return(C_double_to_Xen_real(mix_maxamp(Xen_mix_to_C_int(mix_id))));
}
@@ -3094,102 +3104,102 @@ void set_mix_waveform_height(int new_val)
}
-static XEN g_mix_waveform_height(void)
+static Xen g_mix_waveform_height(void)
{
#define H_mix_waveform_height "(" S_mix_waveform_height "): max height (pixels) of mix waveforms (20)"
- return(C_TO_XEN_INT(mix_waveform_height(ss)));
+ return(C_int_to_Xen_integer(mix_waveform_height(ss)));
}
-static XEN g_set_mix_waveform_height(XEN val)
+static Xen g_set_mix_waveform_height(Xen val)
{
int new_val;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_mix_waveform_height, "a number");
- new_val = mus_iclamp(0, XEN_TO_C_INT_OR_ELSE(val, 0), LOTSA_PIXELS);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mix_waveform_height, "an integer");
+ new_val = mus_iclamp(0, Xen_integer_to_C_int(val), LOTSA_PIXELS);
set_mix_waveform_height(new_val);
- return(C_TO_XEN_INT(mix_waveform_height(ss)));
+ return(C_int_to_Xen_integer(mix_waveform_height(ss)));
}
-static XEN g_with_mix_tags(void)
+static Xen g_with_mix_tags(void)
{
#define H_with_mix_tags "(" S_with_mix_tags "): " PROC_TRUE " if Snd should try to use virtual (tagged) mixing"
- return(C_TO_XEN_BOOLEAN(with_mix_tags(ss)));
+ return(C_bool_to_Xen_boolean(with_mix_tags(ss)));
}
-static XEN g_set_with_mix_tags(XEN val)
+static Xen g_set_with_mix_tags(Xen val)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_with_mix_tags, "a boolean");
- set_with_mix_tags(XEN_TO_C_BOOLEAN(val));
- return(C_TO_XEN_BOOLEAN(with_mix_tags(ss)));
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_with_mix_tags, "a boolean");
+ set_with_mix_tags(Xen_boolean_to_C_bool(val));
+ return(C_bool_to_Xen_boolean(with_mix_tags(ss)));
}
-static XEN g_mix_tag_width(void)
+static Xen g_mix_tag_width(void)
{
#define H_mix_tag_width "(" S_mix_tag_width "): width (pixels) of mix tags (6)"
- return(C_TO_XEN_INT(mix_tag_width(ss)));
+ return(C_int_to_Xen_integer(mix_tag_width(ss)));
}
-static XEN g_set_mix_tag_width(XEN val)
+static Xen g_set_mix_tag_width(Xen val)
{
int width;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_mix_tag_width, "an integer");
- width = mus_iclamp(0, XEN_TO_C_INT(val), LOTSA_PIXELS);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mix_tag_width, "an integer");
+ width = mus_iclamp(0, Xen_integer_to_C_int(val), LOTSA_PIXELS);
set_mix_tag_width(width);
for_each_normal_chan(update_graph);
- return(C_TO_XEN_INT(mix_tag_width(ss)));
+ return(C_int_to_Xen_integer(mix_tag_width(ss)));
}
-static XEN g_mix_tag_height(void)
+static Xen g_mix_tag_height(void)
{
#define H_mix_tag_height "(" S_mix_tag_height "): height (pixels) of mix tags (14)"
- return(C_TO_XEN_INT(mix_tag_height(ss)));
+ return(C_int_to_Xen_integer(mix_tag_height(ss)));
}
-static XEN g_set_mix_tag_height(XEN val)
+static Xen g_set_mix_tag_height(Xen val)
{
int height;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_mix_tag_height, "an integer");
- height = mus_iclamp(0, XEN_TO_C_INT(val), LOTSA_PIXELS);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mix_tag_height, "an integer");
+ height = mus_iclamp(0, Xen_integer_to_C_int(val), LOTSA_PIXELS);
set_mix_tag_height(height);
for_each_normal_chan(update_graph);
- return(C_TO_XEN_INT(mix_tag_height(ss)));
+ return(C_int_to_Xen_integer(mix_tag_height(ss)));
}
-static XEN g_mix_p(XEN n)
+static Xen g_is_mix(Xen n)
{
- #define H_mix_p "(" S_mix_p " id): returns " PROC_TRUE " if the 'n' is a mix that exists somewhere in the edit list."
- return(C_TO_XEN_BOOLEAN((XEN_MIX_P(n)) && (mix_exists(XEN_MIX_TO_C_INT(n)))));
+ #define H_is_mix "(" S_is_mix " id): returns " PROC_TRUE " if the 'n' is a mix that exists somewhere in the edit list."
+ return(C_bool_to_Xen_boolean((xen_is_mix(n)) && (mix_exists(Xen_mix_to_C_int(n)))));
}
-static XEN g_mixes(XEN snd, XEN chn)
+static Xen g_mixes(Xen snd, Xen chn)
{
#define H_mixes "(" S_mixes " :optional snd chn): list of active mixes (ids) associated with snd and chn"
snd_info *sp;
- chan_info *cp;
- int i, j;
- XEN res1 = XEN_EMPTY_LIST;
+ Xen res1 = Xen_empty_list;
- ASSERT_CHANNEL(S_mixes, snd, chn, 0);
+ Snd_assert_channel(S_mixes, snd, chn, 0);
- if (XEN_INTEGER_P(snd) || XEN_SOUND_P(snd))
+ if (Xen_is_integer(snd) || xen_is_sound(snd))
{
- if (XEN_INTEGER_P(chn))
+ int i;
+ if (Xen_is_integer(chn))
{
/* scan all mixes for any associated with this channel */
+ chan_info *cp;
cp = get_cp(snd, chn, S_mixes);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
for (i = mix_infos_ctr - 1; i >= 0; i--)
if ((mix_is_active(i)) &&
(mix_infos[i]->cp == cp))
- res1 = XEN_CONS(new_xen_mix(i), res1);
+ res1 = Xen_cons(new_xen_mix(i), res1);
}
else
{
@@ -3197,17 +3207,18 @@ static XEN g_mixes(XEN snd, XEN chn)
if (sp == NULL)
return(snd_no_such_sound_error(S_mixes, snd));
for (i = sp->nchans - 1; i >= 0; i--)
- res1 = XEN_CONS(g_mixes(snd, C_TO_XEN_INT(i)), res1);
+ res1 = Xen_cons(g_mixes(snd, C_int_to_Xen_integer(i)), res1);
}
}
else
{
+ int j;
for (j = ss->max_sounds - 1; j >= 0; j--)
{
sp = ss->sounds[j];
if ((sp) && (sp->inuse == SOUND_NORMAL))
- res1 = XEN_CONS(g_mixes(C_TO_XEN_INT(j),
- XEN_UNDEFINED),
+ res1 = Xen_cons(g_mixes(C_int_to_Xen_integer(j),
+ Xen_undefined),
res1);
}
}
@@ -3216,58 +3227,49 @@ static XEN g_mixes(XEN snd, XEN chn)
-static XEN g_mix_vct(XEN obj, XEN beg, XEN snd, XEN chn, XEN with_tag, XEN origin)
+static Xen g_mix_vct(Xen obj, Xen beg, Xen snd, Xen chn, Xen with_tag, Xen origin)
{
#define H_mix_vct "(" S_mix_vct " data :optional (beg 0) snd chn (with-tag " S_with_mix_tags ") origin): \
-mix data (a vct) into snd's channel chn starting at beg; return the new mix id, if any"
+mix data (a " S_vct ") into snd's channel chn starting at beg; return the new mix id, if any"
vct *v;
mus_long_t bg;
chan_info *cp;
const char *edname = NULL;
- mus_sample_t *data;
+ mus_float_t *data;
int len, mix_id = NO_MIX_TAG;
bool with_mixer;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ARG_1, S_mix_vct, "a vct");
- ASSERT_CHANNEL(S_mix_vct, snd, chn, 3);
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(beg), beg, XEN_ARG_2, S_mix_vct, "an integer");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(with_tag), with_tag, XEN_ARG_5, S_mix_vct, "a boolean");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, XEN_ARG_6, S_mix_vct, "a string");
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_mix_vct, "a " S_vct);
+ Snd_assert_channel(S_mix_vct, snd, chn, 3);
+ Xen_check_type(Xen_is_integer_or_unbound(beg), beg, 2, S_mix_vct, "an integer");
+ Xen_check_type(Xen_is_boolean_or_unbound(with_tag), with_tag, 5, S_mix_vct, "a boolean");
+ Xen_check_type(Xen_is_string_or_unbound(origin), origin, 6, S_mix_vct, "a string");
cp = get_cp(snd, chn, S_mix_vct);
- if (!cp) return(XEN_FALSE);
- if (!(editable_p(cp))) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
+ if (!(is_editable(cp))) return(Xen_false);
- if (XEN_STRING_P(origin))
- edname = XEN_TO_C_STRING(origin);
+ if (Xen_is_string(origin))
+ edname = Xen_string_to_C_string(origin);
else edname = S_mix_vct;
bg = beg_to_sample(beg, S_mix_vct);
- v = XEN_TO_VCT(obj);
- len = v->length;
+ v = Xen_to_vct(obj);
+ len = mus_vct_length(v);
with_mixer = virtual_mix_ok(cp, cp->edit_ctr);
if (with_mixer)
{
- if (XEN_NOT_BOUND_P(with_tag))
+ if (!Xen_is_bound(with_tag))
with_mixer = with_mix_tags(ss);
- else with_mixer = XEN_TO_C_BOOLEAN(with_tag);
+ else with_mixer = Xen_boolean_to_C_bool(with_tag);
}
if (!with_mixer)
- return(C_TO_XEN_BOOLEAN(mix_vct_untagged(v, cp, bg, edname)));
+ return(C_bool_to_Xen_boolean(mix_vct_untagged(v, cp, bg, edname)));
-#if SNDLIB_USE_FLOATS
- data = v->data;
-#else
- {
- int i;
- data = (mus_sample_t *)calloc(len, sizeof(mus_sample_t));
- for (i = 0; i < len; i++)
- data[i] = MUS_FLOAT_TO_SAMPLE(v->data[i]);
- }
-#endif
+ data = mus_vct_data(v);
/* make_snd_data_buffer copies the data array, so we don't need GC protection */
/* we can't use v->data directly because the user might change it */
@@ -3285,35 +3287,32 @@ mix data (a vct) into snd's channel chn starting at beg; return the new mix id,
name++;
else
name = S_mix_vct;
- new_origin = mus_format("%.*s " MUS_LD " snd chn %s to -mix-%d",
+ new_origin = mus_format("%.*s %lld snd chn %s to -mix-%d",
(int)(strlen(edname) - strlen(name) - 1), edname,
bg, name, mix_infos_ctr);
}
- else new_origin = mus_format("vct( 0 ) " MUS_LD " snd chn %s to -mix-%d", bg, S_mix_vct, mix_infos_ctr);
+ else new_origin = mus_format("vct( 0 ) %lld snd chn %s to -mix-%d", bg, S_mix_vct, mix_infos_ctr);
}
#endif
#if HAVE_SCHEME
- new_origin = mus_format("(set! -mix-%d (%s " MUS_LD " snd chn))", mix_infos_ctr, edname, bg);
+ new_origin = mus_format("(set! -mix-%d (%s %lld snd chn))", mix_infos_ctr, edname, bg);
#endif
#if HAVE_RUBY
/* mix_vct(vct(0.1, 0.2, 0.3), 100, snd, chn, true, "mix_vct(vct(0.1, 0.2, 0.3)") */
- new_origin = mus_format("_mix_%d = %s, " MUS_LD ", snd, chn)", mix_infos_ctr, edname, bg);
+ new_origin = mus_format("_mix_%d = %s, %lld, snd, chn)", mix_infos_ctr, edname, bg);
#endif
mix_id = mix_buffer_with_tag(cp, data, bg, len, new_origin);
free(new_origin);
}
-#if (!SNDLIB_USE_FLOATS)
- free(data);
-#endif
update_graph(cp);
return(new_xen_mix(mix_id));
}
-static XEN g_mix(XEN file, XEN chn_samp_n, XEN file_chn, XEN snd_n, XEN chn_n, XEN tag, XEN auto_delete)
+static Xen g_mix(Xen file, Xen chn_samp_n, Xen file_chn, Xen snd_n, Xen chn_n, Xen tag, Xen auto_delete)
{
#define H_mix "(" S_mix " file :optional (beg 0) (in-chan 0) snd chn (with-tag " S_with_mix_tags ") auto-delete): \
mix channel in-chan of file into snd's channel chn starting at beg (in the output), returning a list of the new mixes. \
@@ -3327,7 +3326,7 @@ auto-delete is " PROC_TRUE ", the input file is deleted when it is no longer nee
bool with_mixer;
mus_long_t beg = 0, len = 0;
- /* TODO: make mix generic: vct=mix-vct, region=mix-region, sound-data=mix-sound-data, frame=mix-frame,
+ /* it might be nice to make mix generic: vct=mix-vct, region=mix-region, sound-data=mix-sound-data
* also mix-sound|mix-channel (sound object/int), but arg order is confusing (file-chn...)
* and mix-vct has "origin", also file_chn might be env: pan-mix-* [vector list?]
*
@@ -3339,62 +3338,63 @@ auto-delete is " PROC_TRUE ", the input file is deleted when it is no longer nee
* mix in-object out-object :start :end :channel :edit-position :out-channel :with-tag :auto-delete :origin ?
* from
* play object :start :end :channel :edit-position :out-channel :with-sync :wait :stop):
- * save_sound_as :file :sound :header-type :data-format :srate :channel :edit-position :comment):
+ * save_sound_as :file :sound :srate :sample-type :header-type :channel :edit-position :comment):
*/
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ARG_1, S_mix, "a string");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(chn_samp_n), chn_samp_n, XEN_ARG_2, S_mix, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(file_chn), file_chn, XEN_ARG_3, S_mix, "an integer or " PROC_TRUE);
- ASSERT_CHANNEL(S_mix, snd_n, chn_n, 4);
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(tag), tag, XEN_ARG_6, S_mix, "a boolean");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(auto_delete), auto_delete, XEN_ARG_7, S_mix, "a boolean or an integer");
+ Xen_check_type(Xen_is_string(file), file, 1, S_mix, "a string");
+ Xen_check_type(Xen_is_number_or_unbound(chn_samp_n), chn_samp_n, 2, S_mix, "an integer");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(file_chn), file_chn, 3, S_mix, "an integer or " PROC_TRUE);
+ Snd_assert_channel(S_mix, snd_n, chn_n, 4);
+ Xen_check_type(Xen_is_boolean_or_unbound(tag), tag, 6, S_mix, "a boolean");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(auto_delete), auto_delete, 7, S_mix, "a boolean or an integer");
if (name) free(name);
- name = mus_expand_filename(XEN_TO_C_STRING(file));
+ name = mus_expand_filename(Xen_string_to_C_string(file));
if (!(mus_file_probe(name)))
return(snd_no_such_file_error(S_mix, file));
cp = get_cp(snd_n, chn_n, S_mix);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- if (XEN_INT64_T_P(chn_samp_n))
- beg = XEN_TO_C_INT64_T(chn_samp_n);
+ if (Xen_is_llong(chn_samp_n))
+ beg = Xen_llong_to_C_llong(chn_samp_n);
chans = mus_sound_chans(name);
if (chans <= 0)
{
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_3(C_TO_XEN_STRING(S_mix ": ~S chans <= 0? (~A)"),
+ Xen_error(BAD_HEADER,
+ Xen_list_3(C_string_to_Xen_string(S_mix ": ~S chans <= 0? (~A)"),
file,
- C_TO_XEN_INT(chans)));
+ C_int_to_Xen_integer(chans)));
}
- if (XEN_INTEGER_P(file_chn))
+ if (Xen_is_integer(file_chn))
{
- file_channel = XEN_TO_C_INT(file_chn);
- if (file_channel >= chans)
+ file_channel = Xen_integer_to_C_int(file_chn);
+ if ((file_channel >= chans) ||
+ (file_channel < 0))
{
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_4(C_TO_XEN_STRING(S_mix ": chan: ~A, but ~S chans: ~A"),
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_4(C_string_to_Xen_string(S_mix ": chan: ~A, but ~S chans: ~A"),
file_chn,
file,
- C_TO_XEN_INT(chans)));
+ C_int_to_Xen_integer(chans)));
}
}
else
{
- if (XEN_TRUE_P(file_chn)) /* this used to be the default as well -- XEN_NOT_BOUND_P case */
+ if (Xen_is_true(file_chn)) /* this used to be the default as well -- !Xen_is_bound case */
{
int i, out_chans = 1;
- XEN result = XEN_EMPTY_LIST;
+ Xen result = Xen_empty_list;
file_delete_t delete_choice = DONT_DELETE_ME;
- if (XEN_INTEGER_P(auto_delete))
- delete_choice = (file_delete_t)XEN_TO_C_INT(auto_delete);
+ if (Xen_is_integer(auto_delete))
+ delete_choice = (file_delete_t)Xen_integer_to_C_int(auto_delete);
else
{
- if (XEN_BOOLEAN_P(auto_delete))
+ if (Xen_is_boolean(auto_delete))
{
- if (XEN_TO_C_BOOLEAN(auto_delete))
+ if (Xen_boolean_to_C_bool(auto_delete))
{
if ((chans > 1) &&
(cp->sound->nchans > 1)) /* mix_complete_file sets sync locally so all we care about here is nchans */
@@ -3409,26 +3409,26 @@ auto-delete is " PROC_TRUE ", the input file is deleted when it is no longer nee
}
id = mix_complete_file(cp->sound, beg, name,
- (XEN_NOT_BOUND_P(tag)) ? with_mix_tags(ss) : XEN_TO_C_BOOLEAN(tag),
+ (!Xen_is_bound(tag)) ? with_mix_tags(ss) : Xen_boolean_to_C_bool(tag),
delete_choice, MIX_SETS_SYNC_LOCALLY,
&out_chans);
- if (id == -1) return(XEN_FALSE);
+ if (id == -1) return(Xen_false);
for (i = 0; i < out_chans; i++)
- result = XEN_CONS(new_xen_mix(id + i), result);
- return(XEN_LIST_REVERSE(result));
+ result = Xen_cons(new_xen_mix(id + i), result);
+ return(Xen_list_reverse(result));
}
}
- len = mus_sound_frames(name);
- if (len <= 0) return(XEN_FALSE);
+ len = mus_sound_framples(name);
+ if (len <= 0) return(Xen_false);
with_mixer = virtual_mix_ok(cp, cp->edit_ctr);
if (with_mixer)
{
- if (XEN_NOT_BOUND_P(tag))
+ if (!Xen_is_bound(tag))
with_mixer = with_mix_tags(ss);
- else with_mixer = XEN_TO_C_BOOLEAN(tag);
+ else with_mixer = Xen_boolean_to_C_bool(tag);
}
{
@@ -3452,11 +3452,12 @@ auto-delete is " PROC_TRUE ", the input file is deleted when it is no longer nee
if (len < FILE_BUFFER_SIZE)
{
- mus_sample_t *data;
+ mus_float_t *data;
- data = (mus_sample_t *)malloc(len * sizeof(mus_sample_t));
+ data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
len = mus_file_to_array(name, file_channel, 0, len, data);
- id = mix_buffer_with_tag(cp, data, beg, len, origin);
+ if (len > 0)
+ id = mix_buffer_with_tag(cp, data, beg, len, origin);
free(data);
if (delete_file == DELETE_ME)
@@ -3469,10 +3470,10 @@ auto-delete is " PROC_TRUE ", the input file is deleted when it is no longer nee
}
else
{
- mix_info *md;
id = mix_file_with_tag(cp, name, file_channel, beg, delete_file, origin);
if (mix_exists(id)) /* if edit is blocked, mix_file can return NO_MIX_TAG (-1) */
{
+ mix_info *md;
md = md_from_id(id);
if (!md->in_filename)
md->in_filename = mus_strdup(name);
@@ -3484,8 +3485,8 @@ auto-delete is " PROC_TRUE ", the input file is deleted when it is no longer nee
update_graph(cp);
- if (id == -1) return(XEN_FALSE);
- return(XEN_LIST_1(new_xen_mix(id)));
+ if (id == NO_MIX_TAG) return(Xen_false);
+ return(Xen_list_1(new_xen_mix(id)));
}
@@ -3497,22 +3498,20 @@ typedef struct mix_fd {
snd_fd *sf;
} mix_fd;
-static XEN_OBJECT_TYPE mf_tag;
+static Xen_object_type_t mf_tag;
-bool mix_sampler_p(XEN obj)
+bool is_mix_sampler(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, mf_tag));
+ return(Xen_c_object_is_type(obj, mf_tag));
}
-
-#define XEN_TO_MIX_SAMPLER(obj) ((mix_fd *)XEN_OBJECT_REF(obj))
-#define MIX_SAMPLER_P(Obj) XEN_OBJECT_TYPE_P(Obj, mf_tag)
+#define Xen_to_mix_sampler(obj) ((mix_fd *)Xen_object_ref(obj))
-static XEN g_mix_sampler_p(XEN obj)
+static Xen g_is_mix_sampler(Xen obj)
{
- #define H_mix_sampler_p "(" S_mix_sampler_p " obj): " PROC_TRUE " if obj is a mix-sampler"
- return(C_TO_XEN_BOOLEAN(mix_sampler_p(obj)));
+ #define H_is_mix_sampler "(" S_is_mix_sampler " obj): " PROC_TRUE " if obj is a mix-sampler"
+ return(C_bool_to_Xen_boolean(is_mix_sampler(obj)));
}
@@ -3530,19 +3529,19 @@ static char *mix_sampler_to_string(mix_fd *fd)
{
mix_info *md;
md = fd->md;
- mus_snprintf(desc, PRINT_BUFFER_SIZE, "#<mix-sampler mix %d, (from " MUS_LD ", at " MUS_LD "%s): %s>",
+ snprintf(desc, PRINT_BUFFER_SIZE, "#<mix-sampler mix %d, (from %lld, at %lld%s): %s>",
md->id,
fd->sf->initial_samp,
fd->sf->loc,
(fd->sf->at_eof) ? ", at eof" : "",
- (md->in_filename) ? md->in_filename : "<vct>");
+ (md->in_filename) ? md->in_filename : S_vct);
}
else snprintf(desc, PRINT_BUFFER_SIZE, "#<mix-sampler: inactive>");
}
return(desc);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(mix_fd, print_mf, mix_sampler_to_string)
+Xen_wrap_print(mix_fd, print_mf, mix_sampler_to_string)
static void mf_free(mix_fd *fd)
@@ -3558,7 +3557,7 @@ static void mf_free(mix_fd *fd)
}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(mix_fd, free_mf, mf_free)
+Xen_wrap_free(mix_fd, free_mf, mf_free)
#if HAVE_SCHEME
static bool s7_equalp_mf(void *m1, void *m2)
@@ -3568,17 +3567,17 @@ static bool s7_equalp_mf(void *m1, void *m2)
#endif
-XEN g_make_mix_sampler(XEN mix_id, XEN ubeg)
+Xen g_make_mix_sampler(Xen mix_id, Xen ubeg)
{
#define H_make_mix_sampler "(" S_make_mix_sampler " id :optional (beg 0)): return a reader ready to access mix id"
mix_info *md = NULL;
mix_state *ms;
mus_long_t beg;
- XEN_ASSERT_TYPE(XEN_MIX_P(mix_id), mix_id, XEN_ARG_1, S_make_mix_sampler, "a mix");
- ASSERT_SAMPLE_TYPE(S_make_mix_sampler, ubeg, XEN_ARG_2);
+ Xen_check_type(xen_is_mix(mix_id), mix_id, 1, S_make_mix_sampler, "a mix");
+ Snd_assert_sample_type(S_make_mix_sampler, ubeg, 2);
- md = md_from_id(XEN_MIX_TO_C_INT(mix_id));
+ md = md_from_id(Xen_mix_to_C_int(mix_id));
if (md == NULL)
return(snd_no_such_mix_error(S_make_mix_sampler, mix_id));
beg = beg_to_sample(ubeg, S_make_mix_sampler);
@@ -3593,84 +3592,85 @@ XEN g_make_mix_sampler(XEN mix_id, XEN ubeg)
if (mf->sf)
{
mf->sf->region = md->id;
- XEN_MAKE_AND_RETURN_OBJECT(mf_tag, mf, 0, free_mf);
+ return(Xen_make_object(mf_tag, mf, 0, free_mf));
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_read_mix_sample(XEN obj)
+static Xen g_read_mix_sample(Xen obj)
{
mix_fd *mf;
#define H_read_mix_sample "(" S_read_mix_sample " reader): read sample from mix reader"
- XEN_ASSERT_TYPE(MIX_SAMPLER_P(obj), obj, XEN_ONLY_ARG, S_read_mix_sample, "a mix-sampler");
- mf = XEN_TO_MIX_SAMPLER(obj);
- return(C_TO_XEN_DOUBLE(read_sample(mf->sf)));
+ Xen_check_type(is_mix_sampler(obj), obj, 1, S_read_mix_sample, "a mix-sampler");
+ mf = Xen_to_mix_sampler(obj);
+ return(C_double_to_Xen_real(read_sample(mf->sf)));
}
-snd_fd *xen_mix_to_snd_fd(XEN obj)
+snd_fd *xen_mix_to_snd_fd(Xen obj)
{
mix_fd *mf;
- mf = XEN_TO_MIX_SAMPLER(obj);
+ mf = Xen_to_mix_sampler(obj);
return(mf->sf);
}
+snd_fd *mf_to_snd_fd(void *p) {return(((mix_fd *)p)->sf);}
+
#if HAVE_SCHEME
-static XEN s7_read_mix_sample(s7_scheme *sc, XEN obj, XEN args)
+static Xen s7_read_mix_sample(s7_scheme *sc, Xen obj, Xen args)
{
return(g_read_mix_sample(obj));
}
#endif
-XEN g_copy_mix_sampler(XEN obj)
+Xen g_copy_mix_sampler(Xen obj)
{
mix_fd *mf;
- mf = XEN_TO_MIX_SAMPLER(obj);
- return(g_make_mix_sampler(new_xen_mix(mf->md->id),
- C_TO_XEN_INT64_T(current_location(mf->sf))));
+ mf = Xen_to_mix_sampler(obj);
+ return(g_make_mix_sampler(new_xen_mix(mf->md->id), C_llong_to_Xen_llong(current_location(mf->sf))));
}
-XEN g_mix_sampler_home(XEN obj)
+Xen g_mix_sampler_home(Xen obj)
{
mix_fd *mf;
- mf = XEN_TO_MIX_SAMPLER(obj);
+ mf = Xen_to_mix_sampler(obj);
return(new_xen_mix(mf->md->id));
}
-static bool mix_sampler_at_end_p(void *ptr)
+static bool mix_sampler_is_at_end(void *ptr)
{
mix_fd *mf = (mix_fd *)ptr;
return(mf->sf->at_eof);
}
-XEN g_mix_sampler_at_end_p(XEN obj)
+Xen g_mix_sampler_is_at_end(Xen obj)
{
mix_fd *mf;
- mf = XEN_TO_MIX_SAMPLER(obj);
- return(C_TO_XEN_BOOLEAN(mix_sampler_at_end_p(mf)));
+ mf = Xen_to_mix_sampler(obj);
+ return(C_bool_to_Xen_boolean(mix_sampler_is_at_end(mf)));
}
-XEN g_mix_sampler_position(XEN obj)
+Xen g_mix_sampler_position(Xen obj)
{
mix_fd *mf;
- mf = XEN_TO_MIX_SAMPLER(obj);
- if (mix_sampler_at_end_p(mf)) return(XEN_ZERO);
- return(C_TO_XEN_INT64_T(current_location(mf->sf)));
+ mf = Xen_to_mix_sampler(obj);
+ if (mix_sampler_is_at_end(mf)) return(Xen_integer_zero);
+ return(C_llong_to_Xen_llong(current_location(mf->sf)));
}
-XEN g_free_mix_sampler(XEN obj)
+Xen g_free_mix_sampler(Xen obj)
{
mix_fd *mf;
- mf = XEN_TO_MIX_SAMPLER(obj);
+ mf = Xen_to_mix_sampler(obj);
if (mf)
{
@@ -3678,26 +3678,26 @@ XEN g_free_mix_sampler(XEN obj)
mf->sf = free_snd_fd(mf->sf);
mf->md = NULL;
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static io_error_t save_mix(int id, const char *name, int type, int format)
+static io_error_t save_mix(int id, const char *name, mus_header_t head_type, mus_sample_t samp_type)
{
mix_info *md;
chan_info *cp;
snd_info *sp;
mix_state *ms;
io_error_t io_err = IO_NO_ERROR;
- mus_long_t frames;
+ mus_long_t framples;
md = md_from_id(id);
cp = md->cp;
sp = cp->sound;
ms = current_mix_state(md);
- frames = ms->len;
+ framples = ms->len;
- io_err = snd_write_header(name, type, SND_SRATE(sp), 1, frames, format, NULL, NULL);
+ io_err = snd_write_header(name, head_type, snd_srate(sp), 1, framples, samp_type, NULL, NULL);
if (io_err == IO_NO_ERROR)
{
@@ -3707,13 +3707,12 @@ static io_error_t save_mix(int id, const char *name, int type, int format)
ofd = snd_reopen_write(name);
if (ofd != -1)
{
- mus_sample_t **bufs;
- mus_sample_t *data;
- int err = 0;
+ mus_float_t **bufs;
+ mus_float_t *data;
mus_long_t i;
mix_fd *mf = NULL;
- snd_file_open_descriptors(ofd, name, format, oloc, 1, type);
+ snd_file_open_descriptors(ofd, name, samp_type, oloc, 1, head_type);
mus_file_set_clipping(ofd, clipping(ss));
lseek(ofd, oloc, SEEK_SET);
@@ -3722,21 +3721,22 @@ static io_error_t save_mix(int id, const char *name, int type, int format)
mf->sf = make_virtual_mix_reader(md->cp, 0, ms->len, ms->index, ms->scaler, READ_FORWARD);
mf->sf->region = md->id;
- bufs = (mus_sample_t **)calloc(1, sizeof(mus_sample_t *));
- bufs[0] = (mus_sample_t *)calloc(FILE_BUFFER_SIZE, sizeof(mus_sample_t));
+ bufs = (mus_float_t **)calloc(1, sizeof(mus_float_t *));
+ bufs[0] = (mus_float_t *)calloc(FILE_BUFFER_SIZE, sizeof(mus_float_t));
data = bufs[0];
- for (i = 0; i < frames; i += FILE_BUFFER_SIZE)
+ for (i = 0; i < framples; i += FILE_BUFFER_SIZE)
{
+ int err;
int cursamples, k;
- if ((i + FILE_BUFFER_SIZE) < frames)
+ if ((i + FILE_BUFFER_SIZE) < framples)
cursamples = FILE_BUFFER_SIZE;
- else cursamples = (frames - i);
+ else cursamples = (framples - i);
for (k = 0; k < cursamples; k++)
data[k] = read_sample(mf->sf);
err = mus_file_write(ofd, 0, cursamples - 1, 1, bufs);
- if (err == -1)
+ if (err != MUS_NO_ERROR)
{
snd_warning("write error while saving mix");
break;
@@ -3770,7 +3770,7 @@ int copy_mix(int id)
if (!md) return(-1);
filename = snd_tempnam();
- save_mix(id, filename, MUS_NEXT, MUS_OUT_FORMAT);
+ save_mix(id, filename, MUS_NEXT, MUS_OUT_SAMPLE_TYPE);
pos = mix_position_from_id(id);
origin = tagged_mix_to_string(filename, pos, 0, true); /* true = file should be auto-deleted, I think */
@@ -3789,38 +3789,42 @@ int copy_mix(int id)
}
-static XEN g_save_mix(XEN m, XEN file)
+static Xen g_save_mix(Xen m, Xen file)
{
#define H_save_mix "(" S_save_mix " mix filename) saves mix's samples in the file 'filename'"
+ int id;
- XEN_ASSERT_TYPE(XEN_MIX_P(m), m, XEN_ARG_1, S_save_mix, "a mix");
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ARG_2, S_save_mix, "a filename");
+ Xen_check_type(xen_is_mix(m), m, 1, S_save_mix, "a mix");
+ id = Xen_mix_to_C_int(m);
- save_mix(XEN_MIX_TO_C_INT(m), XEN_TO_C_STRING(file), MUS_NEXT, MUS_OUT_FORMAT);
- return(m);
+ if (mix_is_active(id))
+ {
+ Xen_check_type(Xen_is_string(file), file, 2, S_save_mix, "a filename");
+ save_mix(id, Xen_string_to_C_string(file), MUS_NEXT, MUS_OUT_SAMPLE_TYPE);
+ return(m);
+ }
+ return(snd_no_such_mix_error(S_save_mix, m));
}
-static XEN g_view_mixes_dialog(void)
+static Xen g_view_mixes_dialog(void)
{
- widget_t w;
#define H_view_mixes_dialog "(" S_view_mixes_dialog "): start the Mix browser"
- w = make_mix_dialog();
- return(XEN_WRAP_WIDGET(w));
+ return(Xen_wrap_widget(make_mix_dialog()));
}
-static XEN g_mix_dialog_mix(void)
+static Xen g_mix_dialog_mix(void)
{
#define H_mix_dialog_mix "(" S_mix_dialog_mix "): current mix id displayed in mix dialog."
return(new_xen_mix(mix_dialog_mix()));
}
-static XEN g_set_mix_dialog_mix(XEN val)
+static Xen g_set_mix_dialog_mix(Xen val)
{
- XEN_ASSERT_TYPE(XEN_MIX_P(val), val, XEN_ONLY_ARG, S_setB S_mix_dialog_mix, "a mix");
- mix_dialog_set_mix(XEN_MIX_TO_C_INT(val));
+ Xen_check_type(xen_is_mix(val), val, 1, S_set S_mix_dialog_mix, "a mix");
+ mix_dialog_set_mix(Xen_mix_to_C_int(val));
return(val);
}
@@ -3854,11 +3858,11 @@ void syncd_mix_play(int id)
}
-XEN g_play_mix(XEN num, mus_long_t samp)
+Xen g_play_mix(Xen num, mus_long_t samp)
{
mix_info *md;
- md = md_from_id(XEN_MIX_TO_C_INT(num));
+ md = md_from_id(Xen_mix_to_C_int(num));
if (md == NULL)
return(snd_no_such_mix_error(S_play, num));
play_mix(md, samp, true);
@@ -3877,182 +3881,195 @@ bool play_mix_from_id(int mix_id)
}
-#ifdef XEN_ARGIFY_1
-
-XEN_NARGIFY_1(g_mix_position_w, g_mix_position)
-XEN_NARGIFY_2(g_set_mix_position_w, g_set_mix_position)
-XEN_NARGIFY_1(g_mix_speed_w, g_mix_speed)
-XEN_NARGIFY_2(g_set_mix_speed_w, g_set_mix_speed)
-XEN_NARGIFY_1(g_mix_amp_w, g_mix_amp)
-XEN_NARGIFY_2(g_set_mix_amp_w, g_set_mix_amp)
-XEN_NARGIFY_1(g_mix_amp_env_w, g_mix_amp_env)
-XEN_NARGIFY_2(g_set_mix_amp_env_w, g_set_mix_amp_env)
-
-XEN_NARGIFY_1(g_mix_name_w, g_mix_name)
-XEN_NARGIFY_2(g_set_mix_name_w, g_set_mix_name)
-XEN_NARGIFY_1(g_mix_tag_y_w, g_mix_tag_y)
-XEN_NARGIFY_2(g_set_mix_tag_y_w, g_set_mix_tag_y)
-XEN_NARGIFY_1(g_mix_sync_w, g_mix_sync)
-XEN_NARGIFY_2(g_set_mix_sync_w, g_set_mix_sync)
-XEN_NARGIFY_0(g_mix_sync_max_w, g_mix_sync_max)
-XEN_NARGIFY_1(g_mix_length_w, g_mix_length)
-XEN_NARGIFY_1(g_integer_to_mix_w, g_integer_to_mix)
-XEN_NARGIFY_1(g_mix_to_integer_w, g_mix_to_integer)
-XEN_NARGIFY_1(g_mix_home_w, g_mix_home)
-XEN_NARGIFY_1(g_mix_properties_w, g_mix_properties)
-XEN_NARGIFY_2(g_set_mix_properties_w, g_set_mix_properties)
-XEN_NARGIFY_2(g_mix_property_w, g_mix_property)
-XEN_NARGIFY_3(g_set_mix_property_w, g_set_mix_property)
-
-XEN_NARGIFY_0(g_mix_waveform_height_w, g_mix_waveform_height)
-XEN_NARGIFY_1(g_set_mix_waveform_height_w, g_set_mix_waveform_height)
-XEN_NARGIFY_0(g_with_mix_tags_w, g_with_mix_tags)
-XEN_NARGIFY_1(g_set_with_mix_tags_w, g_set_with_mix_tags)
-XEN_NARGIFY_0(g_mix_tag_width_w, g_mix_tag_width)
-XEN_NARGIFY_1(g_set_mix_tag_width_w, g_set_mix_tag_width)
-XEN_NARGIFY_0(g_mix_tag_height_w, g_mix_tag_height)
-XEN_NARGIFY_1(g_set_mix_tag_height_w, g_set_mix_tag_height)
-
-XEN_NARGIFY_1(g_mix_p_w, g_mix_p)
-XEN_ARGIFY_2(g_mixes_w, g_mixes)
-XEN_ARGIFY_7(g_mix_w, g_mix)
-XEN_ARGIFY_6(g_mix_vct_w, g_mix_vct)
-
-XEN_ARGIFY_2(g_make_mix_sampler_w, g_make_mix_sampler)
-XEN_NARGIFY_1(g_read_mix_sample_w, g_read_mix_sample)
-XEN_NARGIFY_1(g_mix_sampler_p_w, g_mix_sampler_p)
-XEN_NARGIFY_2(g_save_mix_w, g_save_mix)
-
-XEN_NARGIFY_0(g_view_mixes_dialog_w, g_view_mixes_dialog)
-XEN_NARGIFY_0(g_mix_dialog_mix_w, g_mix_dialog_mix)
-XEN_NARGIFY_1(g_set_mix_dialog_mix_w, g_set_mix_dialog_mix)
-
+#if HAVE_SCHEME
+ #define S_mix_to_vct "mix->float-vector"
#else
+ #define S_mix_to_vct "mix->vct"
+#endif
+
+Xen g_mix_to_vct(Xen mix_n, Xen beg_n, Xen num)
+{
+ mus_float_t *data;
+ mix_info *md;
+ mus_long_t beg, len;
+ mus_long_t i;
+ mix_fd *mf = NULL;
+ mix_state *ms;
-#define g_mix_position_w g_mix_position
-#define g_set_mix_position_w g_set_mix_position
-#define g_mix_speed_w g_mix_speed
-#define g_set_mix_speed_w g_set_mix_speed
-#define g_mix_amp_w g_mix_amp
-#define g_set_mix_amp_w g_set_mix_amp
-#define g_mix_amp_env_w g_mix_amp_env
-#define g_set_mix_amp_env_w g_set_mix_amp_env
-
-#define g_mix_name_w g_mix_name
-#define g_set_mix_name_w g_set_mix_name
-#define g_mix_tag_y_w g_mix_tag_y
-#define g_set_mix_tag_y_w g_set_mix_tag_y
-#define g_mix_sync_w g_mix_sync
-#define g_set_mix_sync_w g_set_mix_sync
-#define g_mix_sync_max_w g_mix_sync_max
-#define g_mix_length_w g_mix_length
-#define g_integer_to_mix_w g_integer_to_mix
-#define g_mix_to_integer_w g_mix_to_integer
-#define g_mix_home_w g_mix_home
-#define g_mix_properties_w g_mix_properties
-#define g_set_mix_properties_w g_set_mix_properties
-#define g_mix_property_w g_mix_property
-#define g_set_mix_property_w g_set_mix_property
-
-#define g_mix_waveform_height_w g_mix_waveform_height
-#define g_set_mix_waveform_height_w g_set_mix_waveform_height
-#define g_with_mix_tags_w g_with_mix_tags
-#define g_set_with_mix_tags_w g_set_with_mix_tags
-#define g_mix_tag_width_w g_mix_tag_width
-#define g_set_mix_tag_width_w g_set_mix_tag_width
-#define g_mix_tag_height_w g_mix_tag_height
-#define g_set_mix_tag_height_w g_set_mix_tag_height
-
-#define g_mix_p_w g_mix_p
-#define g_mixes_w g_mixes
-#define g_mix_w g_mix
-#define g_mix_vct_w g_mix_vct
-
-#define g_make_mix_sampler_w g_make_mix_sampler
-#define g_read_mix_sample_w g_read_mix_sample
-#define g_mix_sampler_p_w g_mix_sampler_p
-#define g_save_mix_w g_save_mix
-
-#define g_view_mixes_dialog_w g_view_mixes_dialog
-#define g_mix_dialog_mix_w g_mix_dialog_mix
-#define g_set_mix_dialog_mix_w g_set_mix_dialog_mix
+ Xen_check_type(xen_is_mix(mix_n), mix_n, 1, S_mix_to_vct, "a mix");
+ Xen_check_type(Xen_is_integer_or_unbound(beg_n), beg_n, 2, S_mix_to_vct, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(num), num, 3, S_mix_to_vct, "an integer");
-#endif
+ md = md_from_id(Xen_mix_to_C_int(mix_n));
+ if (md == NULL)
+ return(snd_no_such_mix_error(S_mix_to_vct, mix_n));
+ ms = current_mix_state(md);
+ if (Xen_is_integer(num))
+ {
+ len = Xen_llong_to_C_llong(num);
+ if (len < 0)
+ Xen_out_of_range_error(S_mix_to_vct, 2, num, "length < 0?");
+ if (len > mix_length_from_id(md->id))
+ len = mix_length_from_id(md->id);
+ }
+ else len = mix_length_from_id(md->id);
+
+ beg = beg_to_sample(beg_n, S_mix_to_vct);
+ if (beg >= len)
+ return(Xen_false);
+
+ mf = (mix_fd *)calloc(1, sizeof(mix_fd));
+ mf->md = md;
+ mf->sf = make_virtual_mix_reader(md->cp, beg, ms->len, ms->index, ms->scaler, READ_FORWARD);
+ mf->sf->region = md->id;
+
+ data = (mus_float_t *)calloc(len, sizeof(mus_float_t));
+ for (i = 0; i < len; i++)
+ data[i] = read_sample(mf->sf);
+
+ free_snd_fd(mf->sf);
+ free(mf);
+
+ return(xen_make_vct(len, data));
+}
+
+
+Xen_wrap_1_arg(g_mix_position_w, g_mix_position)
+Xen_wrap_2_args(g_set_mix_position_w, g_set_mix_position)
+Xen_wrap_1_arg(g_mix_speed_w, g_mix_speed)
+Xen_wrap_2_args(g_set_mix_speed_w, g_set_mix_speed)
+Xen_wrap_1_arg(g_mix_amp_w, g_mix_amp)
+Xen_wrap_2_args(g_set_mix_amp_w, g_set_mix_amp)
+Xen_wrap_1_arg(g_mix_amp_env_w, g_mix_amp_env)
+Xen_wrap_2_args(g_set_mix_amp_env_w, g_set_mix_amp_env)
+
+Xen_wrap_1_arg(g_mix_name_w, g_mix_name)
+Xen_wrap_2_args(g_set_mix_name_w, g_set_mix_name)
+Xen_wrap_1_arg(g_mix_tag_y_w, g_mix_tag_y)
+Xen_wrap_2_args(g_set_mix_tag_y_w, g_set_mix_tag_y)
+Xen_wrap_1_arg(g_mix_sync_w, g_mix_sync)
+Xen_wrap_2_args(g_set_mix_sync_w, g_set_mix_sync)
+Xen_wrap_no_args(g_mix_sync_max_w, g_mix_sync_max)
+Xen_wrap_1_arg(g_mix_length_w, g_mix_length)
+Xen_wrap_1_arg(g_integer_to_mix_w, g_integer_to_mix)
+Xen_wrap_1_arg(g_mix_to_integer_w, g_mix_to_integer)
+Xen_wrap_1_arg(g_mix_home_w, g_mix_home)
+Xen_wrap_1_arg(g_mix_properties_w, g_mix_properties)
+Xen_wrap_2_args(g_set_mix_properties_w, g_set_mix_properties)
+Xen_wrap_2_args(g_mix_property_w, g_mix_property)
+Xen_wrap_3_args(g_set_mix_property_w, g_set_mix_property)
+
+Xen_wrap_no_args(g_mix_waveform_height_w, g_mix_waveform_height)
+Xen_wrap_1_arg(g_set_mix_waveform_height_w, g_set_mix_waveform_height)
+Xen_wrap_no_args(g_with_mix_tags_w, g_with_mix_tags)
+Xen_wrap_1_arg(g_set_with_mix_tags_w, g_set_with_mix_tags)
+Xen_wrap_no_args(g_mix_tag_width_w, g_mix_tag_width)
+Xen_wrap_1_arg(g_set_mix_tag_width_w, g_set_mix_tag_width)
+Xen_wrap_no_args(g_mix_tag_height_w, g_mix_tag_height)
+Xen_wrap_1_arg(g_set_mix_tag_height_w, g_set_mix_tag_height)
+
+Xen_wrap_1_arg(g_is_mix_w, g_is_mix)
+Xen_wrap_2_optional_args(g_mixes_w, g_mixes)
+Xen_wrap_7_optional_args(g_mix_w, g_mix)
+Xen_wrap_6_optional_args(g_mix_vct_w, g_mix_vct)
+
+Xen_wrap_2_optional_args(g_make_mix_sampler_w, g_make_mix_sampler)
+Xen_wrap_1_arg(g_read_mix_sample_w, g_read_mix_sample)
+Xen_wrap_1_arg(g_is_mix_sampler_w, g_is_mix_sampler)
+Xen_wrap_2_args(g_save_mix_w, g_save_mix)
+
+Xen_wrap_no_args(g_view_mixes_dialog_w, g_view_mixes_dialog)
+Xen_wrap_no_args(g_mix_dialog_mix_w, g_mix_dialog_mix)
+Xen_wrap_1_arg(g_set_mix_dialog_mix_w, g_set_mix_dialog_mix)
+
+#if HAVE_SCHEME
+static s7_pointer acc_mix_tag_height(s7_scheme *sc, s7_pointer args) {return(g_set_mix_tag_height(s7_cadr(args)));}
+static s7_pointer acc_mix_tag_width(s7_scheme *sc, s7_pointer args) {return(g_set_mix_tag_width(s7_cadr(args)));}
+static s7_pointer acc_mix_waveform_height(s7_scheme *sc, s7_pointer args) {return(g_set_mix_waveform_height(s7_cadr(args)));}
+static s7_pointer acc_with_mix_tags(s7_scheme *sc, s7_pointer args) {return(g_set_with_mix_tags(s7_cadr(args)));}
+#endif
void g_init_mix(void)
{
init_xen_mix();
#if HAVE_SCHEME
- mf_tag = XEN_MAKE_OBJECT_TYPE("<mix-sampler>", print_mf, free_mf, s7_equalp_mf, NULL, s7_read_mix_sample, NULL, NULL, NULL, NULL);
+ mf_tag = s7_new_type_x(s7, "<mix-sampler>", print_mf, free_mf, s7_equalp_mf, NULL, s7_read_mix_sample, NULL, NULL, NULL, NULL, NULL);
#else
- mf_tag = XEN_MAKE_OBJECT_TYPE("MixSampler", sizeof(mix_fd));
+ mf_tag = Xen_make_object_type("MixSampler", sizeof(mix_fd));
#endif
#if HAVE_RUBY
- rb_define_method(mf_tag, "to_s", XEN_PROCEDURE_CAST print_mf, 0);
- rb_define_method(mf_tag, "call", XEN_PROCEDURE_CAST g_read_mix_sample, 0);
+ rb_define_method(mf_tag, "to_s", Xen_procedure_cast print_mf, 0);
+ rb_define_method(mf_tag, "call", Xen_procedure_cast g_read_mix_sample, 0);
#endif
#if HAVE_FORTH
fth_set_object_inspect(mf_tag, print_mf);
fth_set_object_free(mf_tag, free_mf);
- fth_set_object_apply(mf_tag, XEN_PROCEDURE_CAST g_read_mix_sample, 0, 0, 0);
+ fth_set_object_apply(mf_tag, Xen_procedure_cast g_read_mix_sample, 0, 0, 0);
#endif
- XEN_DEFINE_PROCEDURE(S_make_mix_sampler, g_make_mix_sampler_w, 1, 1, 0, H_make_mix_sampler);
- XEN_DEFINE_PROCEDURE(S_read_mix_sample, g_read_mix_sample_w, 1, 0, 0, H_read_mix_sample);
- XEN_DEFINE_PROCEDURE(S_mix_sampler_p, g_mix_sampler_p_w, 1, 0, 0, H_mix_sampler_p);
- XEN_DEFINE_PROCEDURE(S_save_mix, g_save_mix_w, 2, 0, 0, H_save_mix);
-
- XEN_DEFINE_PROCEDURE(S_mix, g_mix_w, 1, 6, 0, H_mix);
- XEN_DEFINE_PROCEDURE(S_mix_vct, g_mix_vct_w, 1, 5, 0, H_mix_vct);
- XEN_DEFINE_PROCEDURE(S_mixes, g_mixes_w, 0, 2, 0, H_mixes);
- XEN_DEFINE_PROCEDURE(S_mix_home, g_mix_home_w, 1, 0, 0, H_mix_home);
- XEN_DEFINE_PROCEDURE(S_mix_p, g_mix_p_w, 1, 0, 0, H_mix_p);
- XEN_DEFINE_PROCEDURE(S_mix_length, g_mix_length_w, 1, 0, 0, H_mix_length);
- XEN_DEFINE_PROCEDURE(S_integer_to_mix, g_integer_to_mix_w, 1, 0, 0, H_integer_to_mix);
- XEN_DEFINE_PROCEDURE(S_mix_to_integer, g_mix_to_integer_w, 1, 0, 0, H_mix_to_integer);
- XEN_DEFINE_PROCEDURE(S_view_mixes_dialog, g_view_mixes_dialog_w, 0, 0, 0, H_view_mixes_dialog);
- XEN_DEFINE_PROCEDURE(S_mix_sync_max, g_mix_sync_max_w, 0, 0, 0, H_mix_sync_max);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_position, g_mix_position_w, H_mix_position, S_setB S_mix_position, g_set_mix_position_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_speed, g_mix_speed_w, H_mix_speed, S_setB S_mix_speed, g_set_mix_speed_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_amp, g_mix_amp_w, H_mix_amp, S_setB S_mix_amp, g_set_mix_amp_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_amp_env, g_mix_amp_env_w, H_mix_amp_env, S_setB S_mix_amp_env, g_set_mix_amp_env_w, 1, 0, 2, 0);
+ Xen_define_safe_procedure(S_make_mix_sampler, g_make_mix_sampler_w, 1, 1, 0, H_make_mix_sampler);
+ Xen_define_safe_procedure(S_read_mix_sample, g_read_mix_sample_w, 1, 0, 0, H_read_mix_sample);
+ Xen_define_safe_procedure(S_is_mix_sampler, g_is_mix_sampler_w, 1, 0, 0, H_is_mix_sampler);
+ Xen_define_procedure(S_save_mix, g_save_mix_w, 2, 0, 0, H_save_mix);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_name, g_mix_name_w, H_mix_name, S_setB S_mix_name, g_set_mix_name_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_sync, g_mix_sync_w, H_mix_sync, S_setB S_mix_sync, g_set_mix_sync_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_properties, g_mix_properties_w, H_mix_properties, S_setB S_mix_properties, g_set_mix_properties_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_property, g_mix_property_w, H_mix_property, S_setB S_mix_property, g_set_mix_property_w, 2, 0, 3, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_tag_y, g_mix_tag_y_w, H_mix_tag_y, S_setB S_mix_tag_y, g_set_mix_tag_y_w, 1, 0, 2, 0);
+ Xen_define_procedure(S_mix, g_mix_w, 1, 6, 0, H_mix);
+ Xen_define_procedure(S_mix_vct, g_mix_vct_w, 1, 5, 0, H_mix_vct);
+ Xen_define_safe_procedure(S_mixes, g_mixes_w, 0, 2, 0, H_mixes);
+ Xen_define_safe_procedure(S_mix_home, g_mix_home_w, 1, 0, 0, H_mix_home);
+ Xen_define_safe_procedure(S_is_mix, g_is_mix_w, 1, 0, 0, H_is_mix);
+ Xen_define_safe_procedure(S_mix_length, g_mix_length_w, 1, 0, 0, H_mix_length);
+ Xen_define_safe_procedure(S_integer_to_mix, g_integer_to_mix_w, 1, 0, 0, H_integer_to_mix);
+ Xen_define_safe_procedure(S_mix_to_integer, g_mix_to_integer_w, 1, 0, 0, H_mix_to_integer);
+ Xen_define_safe_procedure(S_view_mixes_dialog, g_view_mixes_dialog_w, 0, 0, 0, H_view_mixes_dialog);
+ Xen_define_safe_procedure(S_mix_sync_max, g_mix_sync_max_w, 0, 0, 0, H_mix_sync_max);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_tag_width, g_mix_tag_width_w, H_mix_tag_width, S_setB S_mix_tag_width, g_set_mix_tag_width_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_tag_height, g_mix_tag_height_w, H_mix_tag_height, S_setB S_mix_tag_height, g_set_mix_tag_height_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mix_position, g_mix_position_w, H_mix_position, S_set S_mix_position, g_set_mix_position_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_mix_speed, g_mix_speed_w, H_mix_speed, S_set S_mix_speed, g_set_mix_speed_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_mix_amp, g_mix_amp_w, H_mix_amp, S_set S_mix_amp, g_set_mix_amp_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_mix_amp_env, g_mix_amp_env_w, H_mix_amp_env, S_set S_mix_amp_env, g_set_mix_amp_env_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_waveform_height, g_mix_waveform_height_w, H_mix_waveform_height,
- S_setB S_mix_waveform_height, g_set_mix_waveform_height_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mix_name, g_mix_name_w, H_mix_name, S_set S_mix_name, g_set_mix_name_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_mix_sync, g_mix_sync_w, H_mix_sync, S_set S_mix_sync, g_set_mix_sync_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_mix_properties, g_mix_properties_w, H_mix_properties, S_set S_mix_properties, g_set_mix_properties_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_mix_property, g_mix_property_w, H_mix_property, S_set S_mix_property, g_set_mix_property_w, 2, 0, 3, 0);
+ Xen_define_dilambda(S_mix_tag_y, g_mix_tag_y_w, H_mix_tag_y, S_set S_mix_tag_y, g_set_mix_tag_y_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_with_mix_tags, g_with_mix_tags_w, H_with_mix_tags,
- S_setB S_with_mix_tags, g_set_with_mix_tags_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mix_tag_width, g_mix_tag_width_w, H_mix_tag_width, S_set S_mix_tag_width, g_set_mix_tag_width_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mix_tag_height, g_mix_tag_height_w, H_mix_tag_height, S_set S_mix_tag_height, g_set_mix_tag_height_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mix_dialog_mix, g_mix_dialog_mix_w, H_mix_dialog_mix,
- S_setB S_mix_dialog_mix, g_set_mix_dialog_mix_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mix_waveform_height, g_mix_waveform_height_w, H_mix_waveform_height, S_set S_mix_waveform_height, g_set_mix_waveform_height_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_with_mix_tags, g_with_mix_tags_w, H_with_mix_tags, S_set S_with_mix_tags, g_set_with_mix_tags_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_mix_dialog_mix, g_mix_dialog_mix_w, H_mix_dialog_mix, S_set S_mix_dialog_mix, g_set_mix_dialog_mix_w, 0, 0, 1, 0);
- #define H_mix_release_hook S_mix_release_hook " (mix-id samps): called after the mouse has dragged a mix to some new position. \
-'samps' = samples moved in the course of the drag. If it returns " PROC_TRUE ", the actual remix is the hook's responsibility."
+ #define H_mix_release_hook S_mix_release_hook " (id samples): called after the mouse has dragged a mix to some new position. \
+'samples' = samples moved in the course of the drag. If it returns " PROC_TRUE ", the actual remix is the hook's responsibility."
- mix_release_hook = XEN_DEFINE_HOOK(S_mix_release_hook, 2, H_mix_release_hook);
+ mix_release_hook = Xen_define_hook(S_mix_release_hook, "(make-hook 'id 'samples)", 2, H_mix_release_hook);
#define H_mix_drag_hook S_mix_drag_hook " (id x y): called when a mix is dragged"
- mix_drag_hook = XEN_DEFINE_HOOK(S_mix_drag_hook, 3, H_mix_drag_hook); /* args = id, mouse x, mouse or tag y */
+ mix_drag_hook = Xen_define_hook(S_mix_drag_hook, "(make-hook 'id 'x 'y)", 3, H_mix_drag_hook); /* args = id, mouse x, mouse or tag y */
/* the name draw-mix-hook is inconsistent with the other mix hooks (mix-draw-hook?), but is intended to parallel draw-mark-hook */
- #define H_draw_mix_hook S_draw_mix_hook " (id): called when a mix tag is about to be displayed"
+ #define H_draw_mix_hook S_draw_mix_hook " (id old-x old-y x y): called when a mix tag is about to be displayed"
- draw_mix_hook = XEN_DEFINE_HOOK(S_draw_mix_hook, 5, H_draw_mix_hook); /* arg = id, old-x, old-y, x, y */
+ draw_mix_hook = Xen_define_hook(S_draw_mix_hook, "(make-hook 'id 'old-x 'old-y 'x 'y)", 5, H_draw_mix_hook);
+
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->mix_tag_height_symbol, s7_make_function(s7, "[acc-" S_mix_tag_height "]", acc_mix_tag_height, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->mix_tag_width_symbol, s7_make_function(s7, "[acc-" S_mix_tag_width "]", acc_mix_tag_width, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->mix_waveform_height_symbol, s7_make_function(s7, "[acc-" S_mix_waveform_height "]", acc_mix_waveform_height, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->with_mix_tags_symbol, s7_make_function(s7, "[acc-" S_with_mix_tags "]", acc_with_mix_tags, 2, 0, false, "accessor"));
+
+ s7_symbol_set_documentation(s7, ss->mix_tag_height_symbol, "*mix-tag-height*: height (pixels) of mix tags (14)");
+ s7_symbol_set_documentation(s7, ss->mix_tag_width_symbol, "*mix-tag-width*: width (pixels) of mix tags (6)");
+ s7_symbol_set_documentation(s7, ss->mix_waveform_height_symbol, "*mix-waveform-height*: max height (pixels) of mix waveforms (20)");
+ s7_symbol_set_documentation(s7, ss->with_mix_tags_symbol, "*with-mix-tags*: #t if Snd should try to use virtual (tagged) mixing");
+#endif
}
diff --git a/snd-motif.c b/snd-motif.c
new file mode 100644
index 0000000..dfa6405
--- /dev/null
+++ b/snd-motif.c
@@ -0,0 +1,31042 @@
+#include "snd.h"
+
+#include <X11/IntrinsicP.h>
+
+#if __GNUC__
+#ifdef LESSTIF_VERSION
+ /* moved the warning here so it only is displayed once */
+ #warning You appear to be using Lesstif: this is not recommended! Expect bugs...
+#endif
+#if (XmVERSION == 1)
+ #warning Motif 1 is no longer supported -- this has little chance of working...
+#endif
+#endif
+
+
+static XmRenderTable get_xm_font(XFontStruct *ignore, const char *font, const char *tag)
+{
+ XmRendition tmp;
+ XmRenderTable tabl;
+ int n;
+ Arg args[12];
+
+ n = 0;
+ XtSetArg(args[n], XmNfontName, font); n++;
+ XtSetArg(args[n], XmNfontType, XmFONT_IS_FONT); n++;
+ XtSetArg(args[n], XmNloadModel, XmLOAD_IMMEDIATE); n++;
+ tmp = XmRenditionCreate(MAIN_SHELL(ss), (char *)tag, args, n);
+ tabl = XmRenderTableAddRenditions(NULL, &tmp, 1, XmMERGE_NEW);
+
+ /* XmRenditionFree(tmp); */ /* valgrind thinks this is a bad idea */
+ return(tabl);
+}
+
+
+/* to see all fonts: (format #f "~{~A~%~}" (XListFonts (XtDisplay (cadr (main-widgets))) "*" 10000))
+ */
+
+bool set_tiny_font(const char *font)
+{
+ XFontStruct *fs = NULL;
+ fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
+ if (fs)
+ {
+ /* it's not clear to me whether this is safe -- what if two fontstructs are pointing to the same font? */
+ if (TINY_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), TINY_FONT(ss));
+ if (tiny_font(ss)) free(tiny_font(ss));
+ in_set_tiny_font(mus_strdup(font));
+ TINY_FONT(ss) = fs;
+ if (ss->tiny_fontlist) XM_FONT_FREE(ss->tiny_fontlist);
+ ss->tiny_fontlist = get_xm_font(TINY_FONT(ss), font, "tiny_font");
+ return(true);
+ }
+ return(false);
+}
+
+
+bool set_listener_font(const char *font)
+{
+ XFontStruct *fs = NULL;
+ fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
+ if (fs)
+ {
+ if (LISTENER_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), LISTENER_FONT(ss));
+ if (listener_font(ss)) free(listener_font(ss));
+ in_set_listener_font(mus_strdup(font));
+ LISTENER_FONT(ss) = fs;
+ if (ss->listener_fontlist) XM_FONT_FREE(ss->listener_fontlist);
+ ss->listener_fontlist = get_xm_font(LISTENER_FONT(ss), font, "listener_font");
+ set_listener_text_font();
+ return(true);
+ }
+ return(false);
+}
+
+
+bool set_peaks_font(const char *font)
+{
+ XFontStruct *fs = NULL;
+ fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
+ if (fs)
+ {
+ if (PEAKS_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), PEAKS_FONT(ss));
+ if (peaks_font(ss)) free(peaks_font(ss));
+ in_set_peaks_font(mus_strdup(font));
+ PEAKS_FONT(ss) = fs;
+ if (ss->peaks_fontlist) XM_FONT_FREE(ss->peaks_fontlist);
+ ss->peaks_fontlist = get_xm_font(PEAKS_FONT(ss), font, "peaks_font");
+ return(true);
+ }
+ return(false);
+}
+
+
+bool set_bold_peaks_font(const char *font)
+{
+ XFontStruct *fs = NULL;
+ fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
+ if (fs)
+ {
+ if (BOLD_PEAKS_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), BOLD_PEAKS_FONT(ss));
+ if (bold_peaks_font(ss)) free(bold_peaks_font(ss));
+ in_set_bold_peaks_font(mus_strdup(font));
+ BOLD_PEAKS_FONT(ss) = fs;
+ if (ss->bold_peaks_fontlist) XM_FONT_FREE(ss->bold_peaks_fontlist);
+ ss->bold_peaks_fontlist = get_xm_font(BOLD_PEAKS_FONT(ss), font, "bold_peaks_font");
+ return(true);
+ }
+ return(false);
+}
+
+
+bool set_axis_label_font(const char *font)
+{
+ XFontStruct *fs = NULL;
+ fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
+ if (fs)
+ {
+ if (AXIS_LABEL_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), AXIS_LABEL_FONT(ss));
+ if (axis_label_font(ss)) free(axis_label_font(ss));
+ in_set_axis_label_font(mus_strdup(font));
+ AXIS_LABEL_FONT(ss) = fs;
+#if HAVE_GL
+ reload_label_font();
+#endif
+ return(true);
+ }
+ return(false);
+}
+
+
+bool set_axis_numbers_font(const char *font)
+{
+ XFontStruct *fs = NULL;
+ fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
+ if (fs)
+ {
+ if (AXIS_NUMBERS_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), AXIS_NUMBERS_FONT(ss));
+ if (axis_numbers_font(ss)) free(axis_numbers_font(ss));
+ in_set_axis_numbers_font(mus_strdup(font));
+ AXIS_NUMBERS_FONT(ss) = fs;
+#if HAVE_GL
+ reload_number_font();
+#endif
+ return(true);
+ }
+ return(false);
+}
+
+
+int mark_name_width(const char *txt)
+{
+ if (txt)
+ return(XTextWidth(PEAKS_FONT(ss), txt, strlen(txt)));
+ return(0);
+}
+
+
+int label_width(const char *txt, bool use_tiny_font)
+{
+ if (txt)
+ return(XTextWidth((use_tiny_font) ? TINY_FONT(ss) : AXIS_LABEL_FONT(ss), txt, strlen(txt)));
+ else return(0);
+}
+
+
+int number_width(const char *num, bool use_tiny_font)
+{
+ if (num)
+ return(XTextWidth((use_tiny_font) ? TINY_FONT(ss) : AXIS_NUMBERS_FONT(ss), num, strlen(num)));
+ return(0);
+}
+
+
+int number_height(XFontStruct *numbers_font)
+{
+ return(numbers_font->ascent);
+}
+
+
+int label_height(bool use_tiny_font)
+{
+ XFontStruct *label_font;
+ if (use_tiny_font)
+ label_font = TINY_FONT(ss);
+ else label_font = AXIS_LABEL_FONT(ss);
+ return(label_font->ascent + label_font->descent);
+}
+
+
+void clear_window(graphics_context *ax)
+{
+ if ((ax) && (ax->dp) && (ax->wn))
+ XClearWindow(ax->dp, ax->wn);
+}
+
+
+static void map_over_children(Widget w, void (*func)(Widget uw))
+{
+ /* apply func to each child in entire tree beneath top widget */
+ /* taken from Douglas Young, "Motif Debugging and Performance Tuning" Prentice-Hall 1995 */
+ /* used mostly to get colors right in environments with "convenience" widgets */
+ if (w)
+ {
+ unsigned int i;
+ (*func)(w);
+ if (XtIsComposite(w))
+ {
+ CompositeWidget cw = (CompositeWidget)w;
+ for (i = 0; i < cw->composite.num_children; i++)
+ map_over_children(cw->composite.children[i], func);
+ }
+
+ if (XtIsWidget(w))
+ for (i = 0; i < w->core.num_popups; i++)
+ map_over_children(w->core.popup_list[i], func);
+ }
+}
+
+
+void map_over_children_with_color(Widget w, void (*func)(Widget uw, color_t color), color_t color)
+{
+ if (w)
+ {
+ unsigned int i;
+ (*func)(w, color);
+ if (XtIsComposite(w))
+ {
+ CompositeWidget cw = (CompositeWidget)w;
+ for (i = 0; i < cw->composite.num_children; i++)
+ map_over_children_with_color(cw->composite.children[i], func, color);
+ }
+
+ if (XtIsWidget(w))
+ for (i = 0; i < w->core.num_popups; i++)
+ map_over_children_with_color(w->core.popup_list[i], func, color);
+ }
+}
+
+
+static void raise_dialog(Widget w)
+{
+ /* since we're using non-transient message dialogs, the dialog window can become completely
+ * hidden behind other windows, with no easy way to raise it back to the top, so...
+ */
+ if ((w) && (XtIsManaged(w)))
+ {
+ Widget parent;
+ parent = XtParent(w);
+ if ((parent) &&
+ (XtIsSubclass(parent, xmDialogShellWidgetClass)))
+ XtPopup(parent, XtGrabNone);
+ /* XtGrabNone means don't lock out events to rest of App (i.e. modeless dialog) */
+ }
+}
+
+
+static void set_main_color_of_widget(Widget w)
+{
+ if (XtIsWidget(w))
+ {
+ if (XmIsScrollBar(w))
+ XmChangeColor(w, (Pixel)ss->position_color);
+ else
+ {
+ Pixel cur_color;
+ XtVaGetValues(w, XmNbackground, &cur_color, NULL);
+ if ((cur_color != ss->highlight_color) &&
+ (cur_color != ss->white))
+ XmChangeColor(w, (Pixel)ss->basic_color);
+ }
+ }
+}
+
+
+void set_label(Widget label, const char *str)
+{
+ XmString s1;
+ s1 = XmStringCreateLocalized((char *)str);
+ XtVaSetValues(label, XmNlabelString, s1, NULL);
+ XmStringFree(s1);
+}
+
+
+static char *get_label(Widget label)
+{
+ char *text;
+ XmString str = NULL;
+ XtVaGetValues(label, XmNlabelString, &str, NULL);
+ if (XmStringEmpty(str)) return(NULL);
+ text = (char *)XmStringUnparse(str, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ XmStringFree(str);
+ return(text);
+}
+
+
+void set_button_label(Widget label, const char *str)
+{
+ set_label(label, str);
+}
+
+
+void set_title(const char *title)
+{
+ XtVaSetValues(MAIN_SHELL(ss), XmNtitle, (char *)title, NULL);
+}
+
+
+void goto_window(Widget text)
+{
+ if (XmIsTraversable(text))
+ XmProcessTraversal(text, XmTRAVERSE_CURRENT);
+}
+
+
+static XtCallbackList make_callback_list(XtCallbackProc callback, XtPointer closure)
+{
+ XtCallbackList nlist;
+ nlist = (XtCallbackList)calloc(2, sizeof(XtCallbackRec));
+ nlist[0].callback = callback;
+ nlist[0].closure = closure;
+ nlist[1].callback = NULL;
+ nlist[1].closure = NULL;
+ return(nlist);
+}
+
+
+#include <Xm/SashP.h>
+static void color_sashes(Widget w)
+{
+ if ((XtIsWidget(w)) &&
+ (XtIsSubclass(w, xmSashWidgetClass)))
+ XmChangeColor(w, (Pixel)ss->sash_color);
+}
+
+
+void check_for_event(void)
+{
+ /* this is needed to force label updates and provide interrupts from long computations */
+ XEvent event;
+ XtInputMask msk = 0;
+ XtAppContext app;
+
+ if (ss->checking_explicitly) return;
+ ss->checking_explicitly = true;
+
+ app = MAIN_APP(ss);
+ while (true)
+ {
+ msk = XtAppPending(app);
+ /* if (msk & (XtIMXEvent | XtIMAlternateInput)) */
+ if (msk & XtIMXEvent)
+ /* was also tracking alternate input events, but these are problematic if libfam is in use (even with check) */
+ {
+ XtAppNextEvent(app, &event);
+ XtDispatchEvent(&event);
+ /* widget = XtWindowToWidget(event.xany.display, event.xany.window); */
+ }
+ else break;
+ }
+ ss->checking_explicitly = false;
+}
+
+
+void color_cursor(Pixel color)
+{
+ ss->cursor_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->cursor_color_symbol, Xen_wrap_pixel(color));
+#endif
+ XSetForeground(MAIN_DISPLAY(ss), ss->cursor_gc, (Pixel)(XOR(color, ss->graph_color)));
+ XSetForeground(MAIN_DISPLAY(ss), ss->selected_cursor_gc, (Pixel)(XOR(color, ss->selected_graph_color)));
+}
+
+
+void color_marks(Pixel color)
+{
+ ss->mark_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->mark_color_symbol, Xen_wrap_pixel(color));
+#endif
+ XSetForeground(MAIN_DISPLAY(ss), ss->mark_gc, (Pixel)(XOR(color, ss->graph_color)));
+ XSetForeground(MAIN_DISPLAY(ss), ss->selected_mark_gc, (Pixel)(XOR(color, ss->selected_graph_color)));
+}
+
+
+void color_selection(Pixel color)
+{
+ ss->selection_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->selection_color_symbol, Xen_wrap_pixel(color));
+#endif
+ XSetForeground(MAIN_DISPLAY(ss), ss->selection_gc, (Pixel)(XOR(color, ss->graph_color)));
+ XSetForeground(MAIN_DISPLAY(ss), ss->selected_selection_gc, (Pixel)(XOR(color, ss->selected_graph_color)));
+}
+
+
+void color_graph(Pixel color)
+{
+ Display *dpy;
+ dpy = MAIN_DISPLAY(ss);
+ XSetBackground(dpy, ss->basic_gc, color);
+ XSetForeground(dpy, ss->erase_gc, color);
+ XSetForeground(dpy, ss->selection_gc, (Pixel)(XOR(ss->selection_color, color)));
+ XSetForeground(dpy, ss->cursor_gc, (Pixel)(XOR(ss->cursor_color, color)));
+ XSetForeground(dpy, ss->mark_gc, (Pixel)(XOR(ss->mark_color, color)));
+}
+
+
+void color_selected_graph(Pixel color)
+{
+ Display *dpy;
+ dpy = MAIN_DISPLAY(ss);
+ XSetBackground(dpy, ss->selected_basic_gc, color);
+ XSetForeground(dpy, ss->selected_erase_gc, color);
+ XSetForeground(dpy, ss->selected_selection_gc, (Pixel)(XOR(ss->selection_color, color)));
+ XSetForeground(dpy, ss->selected_cursor_gc, (Pixel)(XOR(ss->cursor_color, color)));
+ XSetForeground(dpy, ss->selected_mark_gc, (Pixel)(XOR(ss->mark_color, color)));
+}
+
+
+void color_data(Pixel color)
+{
+ Display *dpy;
+ dpy = MAIN_DISPLAY(ss);
+ XSetForeground(dpy, ss->basic_gc, color);
+ XSetBackground(dpy, ss->erase_gc, color);
+}
+
+
+void color_selected_data(Pixel color)
+{
+ Display *dpy;
+ dpy = MAIN_DISPLAY(ss);
+ XSetForeground(dpy, ss->selected_basic_gc, color);
+ XSetBackground(dpy, ss->selected_erase_gc, color);
+}
+
+
+void recolor_graph(chan_info *cp, bool selected)
+{
+ XtVaSetValues(channel_graph(cp), XmNbackground, (selected) ? ss->selected_graph_color : ss->graph_color, NULL);
+}
+
+
+void set_mix_color(Pixel color)
+{
+ Display *dpy;
+ dpy = MAIN_DISPLAY(ss);
+ ss->mix_color = color;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->mix_color_symbol, Xen_wrap_pixel(color));
+#endif
+ XSetForeground(dpy, ss->mix_gc, color);
+
+}
+
+
+void set_sensitive(Widget wid, bool val)
+{
+ if (wid) XtSetSensitive(wid, val);
+}
+
+
+void set_toggle_button(Widget wid, bool val, bool passed, void *ignore)
+{
+ XmToggleButtonSetState(wid, (Boolean)val, (Boolean)passed);
+}
+
+
+Dimension widget_height(Widget w)
+{
+ Dimension height;
+ XtVaGetValues(w, XmNheight, &height, NULL);
+ return(height);
+}
+
+
+Dimension widget_width(Widget w)
+{
+ Dimension width;
+ XtVaGetValues(w, XmNwidth, &width, NULL);
+ return(width);
+}
+
+
+void set_widget_height(Widget w, Dimension height)
+{
+ XtVaSetValues(w, XmNheight, height, NULL);
+}
+
+
+void set_widget_width(Widget w, Dimension width)
+{
+ XtVaSetValues(w, XmNwidth, width, NULL);
+}
+
+
+void set_widget_size(Widget w, Dimension width, Dimension height)
+{
+ XtVaSetValues(w, XmNwidth, width, XmNheight, height, NULL);
+}
+
+
+Position widget_x(Widget w)
+{
+ Position x;
+ XtVaGetValues(w, XmNx, &x, NULL);
+ return(x);
+}
+
+
+Position widget_y(Widget w)
+{
+ Position y;
+ XtVaGetValues(w, XmNy, &y, NULL);
+ return(y);
+}
+
+
+void set_widget_x(Widget w, Position x)
+{
+ XtVaSetValues(w, XmNx, x, NULL);
+}
+
+
+void set_widget_y(Widget w, Position y)
+{
+ XtVaSetValues(w, XmNy, y, NULL);
+}
+
+
+void set_widget_position(Widget w, Position x, Position y)
+{
+ XtVaSetValues(w, XmNx, x, XmNy, y, NULL);
+}
+
+
+idle_t add_work_proc(XtWorkProc func, XtPointer data)
+{
+ /* during auto-testing I need to force the background procs to run to completion */
+ if (with_background_processes(ss))
+ return(XtAppAddWorkProc(MAIN_APP(ss), func, data));
+ else
+ {
+ while (((*func)(data)) == BACKGROUND_CONTINUE) ;
+ return((idle_t)0);
+ }
+}
+
+
+static int attach_all_sides(Arg *args, int n)
+{
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ return(n);
+}
+
+
+static void widget_int_to_text(Widget w, int val)
+{
+ char *str;
+ str = (char *)calloc(8, sizeof(char));
+ snprintf(str, 8, "%d", val);
+ XmTextFieldSetString(w, str);
+ free(str);
+}
+
+
+static void widget_mus_long_t_to_text(Widget w, mus_long_t val)
+{
+ char *str;
+ str = (char *)calloc(32, sizeof(char));
+ snprintf(str, 32, "%lld", val);
+ XmTextFieldSetString(w, str);
+ free(str);
+}
+
+
+static Pixmap rotate_text(Widget w, const char *str, XFontStruct *font, mus_float_t angle_in_degrees, int *nw, int *nh, Pixel bg, Pixel fg, GC d_gc)
+{
+ /* rotate clockwise by angle_in_degrees degrees (i.e. 45 points text south-east),
+ * new bounding box (text centered in it) returned in nw and nh
+ * bg = background color, fg = foreground (text) color)
+ */
+ mus_float_t matrix[4];
+ mus_float_t angle_in_radians;
+ XImage *before, *after;
+ Pixmap pix, rotpix;
+ unsigned int width, height, depth, nwidth, nheight, x, y, nx, ny, tx, ty, depth_bytes;
+ char *data;
+ unsigned long px;
+ Display *dp;
+ Drawable wn;
+ Visual *vis;
+ int scr;
+ int bx0 = 0, bx1 = 0, by0 = 0, by1 = 0, b;
+ if (str == NULL) return(BadPixmap);
+
+ angle_in_radians = mus_degrees_to_radians(angle_in_degrees);
+ matrix[0] = cos(angle_in_radians);
+ matrix[1] = sin(angle_in_radians);
+ matrix[2] = -sin(angle_in_radians);
+ matrix[3] = cos(angle_in_radians);
+
+ dp = XtDisplay(w);
+ wn = XtWindow(w);
+ scr = DefaultScreen(dp);
+ vis = DefaultVisual(dp, scr);
+
+ XtVaGetValues(w, XmNdepth, &depth, NULL);
+ depth_bytes = (depth >> 3);
+ if (depth_bytes == 0) depth_bytes = 1; /* unsigned so can't be negative */
+
+ /* find extent of original text, expand out to byte boundaries */
+ XSetFont(dp, d_gc, font->fid);
+ width = XTextWidth(font, str, strlen(str)) + 8;
+ height = (font->ascent + font->descent) + 8;
+ if (width % 8) width = 8 * (1 + (int)(width / 8));
+ if (height % 8) height = 8 * (1 + (int)(height / 8));
+
+ /* get bounding box of rotated text (this could be simplfied -- used to involve scaling) */
+ b = (int)(width * matrix[0]);
+ if (b < 0) bx0 = b; else bx1 = b;
+ b = (int)(height * matrix[2]);
+ if (b < 0) bx0 += b; else bx1 += b;
+ b = (int)(width * matrix[1]);
+ if (b < 0) by0 = b; else by1 = b;
+ b = (int)(height * matrix[3]);
+ if (b < 0) by0 += b; else by1 += b;
+
+ /* set translation vector so we're centered in the resultant pixmap */
+ if (bx0 < 0) tx = -bx0; else tx = 0;
+ if (by0 < 0) ty = -by0; else ty = 0;
+ nx = bx1 - bx0;
+ ny = by1 - by0;
+
+ /* expand result bounds to byte boundaries */
+ if (nx % 8) nwidth = 8 * (1 + (int)(nx / 8)); else nwidth = nx;
+ if (ny % 8) nheight = 8 * (1 + (int)(ny / 8)); else nheight = ny;
+ (*nw) = nwidth;
+ (*nh) = nheight;
+
+ XSetBackground(dp, d_gc, bg);
+ XSetForeground(dp, d_gc, bg);
+
+ /* create pixmaps, fill with background color, write string to pix */
+ pix = XCreatePixmap(dp, wn, width, height, depth);
+ rotpix= XCreatePixmap(dp, wn, nwidth, nheight, depth);
+ XFillRectangle(dp, pix, d_gc, 0, 0, width, height);
+ XFillRectangle(dp, rotpix, d_gc, 0, 0, nwidth, nheight);
+#if HAVE_SUN
+ XSync(dp, 0);
+ /* needed to get the numbers drawn at all */
+#endif
+ XSetForeground(dp, d_gc, fg);
+ XDrawImageString(dp, pix, d_gc, 4, height - 4, str, strlen(str));
+
+ /* dump pixmap bits into an image; image data will be freed automatically later */
+ data = (char *)calloc((width + 1) * (height + 1) * depth_bytes, sizeof(char)); /* not calloc since X will free this */
+ before = XCreateImage(dp, vis, depth, XYPixmap, 0, data, width, height, 8, 0);
+ XGetSubImage(dp, pix, 0, 0, width, height, AllPlanes, XYPixmap, before, 0, 0);
+ data = (char *)calloc((nwidth + 1) * (nheight + 1) * depth_bytes, sizeof(char));
+ after = XCreateImage(dp, vis, depth, XYPixmap, 0, data, nwidth, nheight, 8, 0);
+
+ /* clear background of result image */
+ for (x = 0; x < nwidth; x++)
+ for (y = 0; y < nheight; y++)
+ XPutPixel(after, x, y, bg);
+
+ /* write rotated pixels to result image */
+ for (x = 0; x < width; x++)
+ for (y = 0; y < height; y++)
+ {
+ px = XGetPixel(before, x, y);
+ if (px != bg)
+ XPutPixel(after,
+ mus_iclamp(0, (int)snd_round(tx + x * matrix[0] + y * matrix[2]), nwidth - 1),
+ mus_iclamp(0, (int)snd_round(ty + x * matrix[1] + y * matrix[3]), nheight - 1),
+ px);
+ }
+
+ /* dump image into result pixmap (needed for later display) */
+ XPutImage(dp, rotpix, d_gc, after, 0, 0, 0, 0, nwidth, nheight);
+
+ /* cleanup */
+ XDestroyImage(before); /* frees data as well */
+ XDestroyImage(after);
+ XFreePixmap(dp, pix);
+ return(rotpix);
+}
+
+
+void draw_rotated_axis_label(chan_info *cp, graphics_context *ax, const char *text, int x0, int y0)
+{
+ Pixmap pix;
+ int h = 0, w = 0;
+ XGCValues gv;
+ Display *dp;
+ Widget widget;
+
+ if ((cp->chan > 0) && (cp->sound->channel_style == CHANNELS_COMBINED))
+ widget = channel_graph(cp->sound->chans[0]);
+ else widget = channel_graph(cp);
+ dp = XtDisplay(widget);
+ XGetGCValues(MAIN_DISPLAY(ss), ax->gc, GCForeground | GCBackground, &gv);
+
+ pix = rotate_text(widget, text, AXIS_LABEL_FONT(ss), -90.0, &w, &h, gv.background, gv.foreground, ax->gc);
+
+ XCopyArea(dp, pix, XtWindow(widget), ax->gc, 0, 0, w, h, x0, y0); /* XtWindow?? */
+ XFreePixmap(dp, pix);
+}
+
+
+static void ensure_list_row_visible(widget_t list, int pos)
+{
+ if (pos >= 0)
+ {
+ int top, visible, num_rows;
+ XtVaGetValues(list,
+ XmNtopItemPosition, &top,
+ XmNvisibleItemCount, &visible,
+ XmNitemCount, &num_rows,
+ NULL);
+ if (pos <= top)
+ XmListSetPos(list, pos); /* was pos+1?? (new file dialog sample type list off by 1 in that case) */
+ else
+ {
+ if (pos >= (top + visible))
+ {
+ if ((pos + visible) > num_rows)
+ XmListSetBottomPos(list, num_rows);
+ else XmListSetPos(list, pos);
+ }
+ }
+ }
+}
+
+
+static void ensure_scrolled_window_row_visible(widget_t list, int row, int num_rows)
+{
+ int minimum, maximum, value, size, new_value, increment, page_increment;
+ Widget scrollbar, work_window;
+
+ XtVaGetValues(list,
+ XmNverticalScrollBar, &scrollbar,
+ XmNworkWindow, &work_window,
+ NULL);
+
+ XtVaGetValues(scrollbar,
+ XmNminimum, &minimum,
+ XmNmaximum, &maximum,
+ XmNvalue, &value,
+ XmNsliderSize, &size,
+ XmNincrement, &increment, /* needed for XmScrollBarSetValues which is needed to force list display update */
+ XmNpageIncrement, &page_increment,
+ NULL);
+
+ maximum -= size;
+ if (row == 0)
+ new_value = 0;
+ else
+ {
+ if (row >= (num_rows - 1))
+ new_value = maximum;
+ else new_value = (int)((row + 0.5) * ((float)(maximum - minimum) / (float)(num_rows - 1)));
+ }
+ XmScrollBarSetValues(scrollbar, new_value, size, increment, page_increment, true);
+}
+
+
+static XmString multi_line_label(const char *s, int *lines)
+{
+ /* taken from the Motif FAQ */
+ XmString xms1, xms2, line, separator;
+ char *p, *tmp;
+
+ (*lines) = 1;
+ tmp = mus_strdup(s);
+ separator = XmStringSeparatorCreate();
+ p = strtok(tmp, "\n");
+ xms1 = XmStringCreateLocalized(p);
+
+ p = strtok(NULL, "\n");
+ while (p)
+ {
+ (*lines)++;
+ line = XmStringCreateLocalized(p);
+ xms2 = XmStringConcat(xms1, separator);
+ XmStringFree(xms1);
+ xms1 = XmStringConcat(xms2, line);
+ XmStringFree(xms2);
+ XmStringFree(line);
+ p = strtok(NULL, "\n");
+ }
+
+ XmStringFree(separator);
+ free(tmp);
+ return(xms1);
+}
+
+#include <Xm/ScaleP.h>
+/* needed to set the scale title background */
+
+
+void draw_line(graphics_context *ax, int x0, int y0, int x1, int y1)
+{
+ XDrawLine(ax->dp, ax->wn, ax->gc, x0, y0, x1, y1);
+}
+
+
+void fill_rectangle(graphics_context *ax, int x0, int y0, int width, int height)
+{
+ XFillRectangle(ax->dp, ax->wn, ax->gc, x0, y0, width, height);
+}
+
+
+void erase_rectangle(chan_info *cp, graphics_context *ax, int x0, int y0, int width, int height)
+{
+ XFillRectangle(ax->dp, ax->wn, erase_GC(cp), x0, y0, width, height);
+}
+
+
+void draw_string(graphics_context *ax, int x0, int y0, const char *str, int len)
+{
+ if ((str) && (*str))
+ XDrawString(ax->dp, ax->wn, ax->gc, x0, y0, str, len);
+}
+
+
+void gtk_style_draw_string(graphics_context *ax, int x0, int y0, const char *str, int len)
+{
+ /* for callers of Scheme-level draw-string, the Motif and Gtk versions should agree on where "y0" is */
+ XGCValues gv;
+ static XFontStruct *fs = NULL;
+
+ XGetGCValues(MAIN_DISPLAY(ss), ax->gc, GCFont, &gv);
+
+ /* now gv.font is the default font */
+ if (fs) XFree(fs);
+ /* this doesn't free all the space */
+ /* but this: */
+ /* if (fs) XFreeFont(MAIN_DISPLAY(ss), fs); */
+ /* gets:
+ X Error of failed request: BadFont (invalid Font parameter)
+ Major opcode of failed request: 56 (X_ChangeGC)
+ Resource id in failed request: 0x4e0035c
+ Serial number of failed request: 8479111
+ Current serial number in output stream: 8479240
+ */
+
+ fs = XQueryFont(MAIN_DISPLAY(ss), gv.font);
+ if (fs)
+ XDrawString(ax->dp, ax->wn, ax->gc, x0, y0 + fs->ascent, str, len);
+ else XDrawString(ax->dp, ax->wn, ax->gc, x0, y0, str, len); /* not sure why this happens... */
+
+ /* XFreeFont here is trouble, but handling it as above seems ok -- Font.c in xlib does allocate new space */
+}
+
+
+static void draw_polygon_va(graphics_context *ax, bool filled, int points, va_list ap)
+{
+ int i;
+ XPoint *pts;
+ pts = (XPoint *)calloc(points, sizeof(XPoint));
+ for (i = 0; i < points; i++)
+ {
+ pts[i].x = va_arg(ap, int);
+ pts[i].y = va_arg(ap, int);
+ }
+ if (filled)
+ XFillPolygon(ax->dp, ax->wn, ax->gc, pts, points, Convex, CoordModeOrigin);
+ else XDrawLines(ax->dp, ax->wn, ax->gc, pts, points, CoordModeOrigin);
+ free(pts);
+}
+
+
+void fill_polygon(graphics_context *ax, int points, ...)
+{ /* currently used only in snd-marks.c */
+ va_list ap;
+ if (points == 0) return;
+ va_start(ap, points);
+ draw_polygon_va(ax, true, points, ap);
+ va_end(ap);
+}
+
+#if 0
+void draw_polygon(graphics_context *ax, int points, ...)
+{
+ va_list ap;
+ if (points == 0) return;
+ va_start(ap, points);
+ draw_polygon_va(ax, false, points, ap);
+ va_end(ap);
+}
+#endif
+
+void draw_lines(graphics_context *ax, point_t *points, int num)
+{
+ if (num == 0) return;
+ XDrawLines(ax->dp, ax->wn, ax->gc, points, num, CoordModeOrigin);
+}
+
+
+void draw_points(graphics_context *ax, point_t *points, int num, int size)
+{
+ if (num == 0) return;
+ if (size == 1)
+ XDrawPoints(ax->dp, ax->wn, ax->gc, points, num, CoordModeOrigin);
+ else
+ {
+ int i, size2;
+ XArc *rs;
+ /* create squares or whatever centered on each point */
+ size2 = size / 2;
+ rs = (XArc *)calloc(num, sizeof(XArc));
+ for (i = 0; i < num; i++)
+ {
+ rs[i].x = points[i].x - size2;
+ rs[i].y = points[i].y - size2;
+ rs[i].angle1 = 0;
+ rs[i].angle2 = 360 * 64;
+ rs[i].width = size;
+ rs[i].height = size;
+ }
+ XFillArcs(ax->dp, ax->wn, ax->gc, rs, num);
+ free(rs);
+ }
+}
+
+
+#if 0
+void draw_point(graphics_context *ax, point_t point, int size)
+{
+ if (size == 1)
+ XDrawPoint(ax->dp, ax->wn, ax->gc, point.x, point.y);
+ else
+ XFillArc(ax->dp, ax->wn, ax->gc,
+ point.x - size / 2,
+ point.y - size / 2,
+ size, size, 0,
+ 360 * 64);
+}
+#endif
+
+
+void draw_dot(graphics_context *ax, int x, int y, int size)
+{
+ XFillArc(ax->dp, ax->wn, ax->gc,
+ x - size / 2,
+ y - size / 2,
+ size, size, 0,
+ 360 * 64);
+}
+
+
+void fill_polygons(graphics_context *ax, point_t *points, int num, int y0)
+{
+ XPoint polypts[4];
+ int i;
+ for (i = 1; i < num; i++)
+ {
+ polypts[0].x = points[i - 1].x;
+ polypts[0].y = points[i - 1].y;
+ polypts[1].x = points[i].x;
+ polypts[1].y = points[i].y;
+ polypts[2].x = polypts[1].x;
+ polypts[2].y = y0;
+ polypts[3].x = points[i - 1].x;
+ polypts[3].y = y0;
+ XFillPolygon(ax->dp, ax->wn, ax->gc, polypts, 4, Convex, CoordModeOrigin);
+ }
+}
+
+
+void fill_two_sided_polygons(graphics_context *ax, point_t *points, point_t *points1, int num)
+{
+ XPoint polypts[4];
+ int i;
+ for (i = 1; i < num; i++)
+ {
+ polypts[0].x = points[i - 1].x;
+ polypts[0].y = points[i - 1].y;
+ polypts[1].x = points[i].x;
+ polypts[1].y = points[i].y;
+ polypts[2].x = points1[i].x;
+ polypts[2].y = points1[i].y;
+ polypts[3].x = points1[i - 1].x;
+ polypts[3].y = points1[i - 1].y;
+ XFillPolygon(ax->dp, ax->wn, ax->gc, polypts, 4, Convex, CoordModeOrigin);
+ }
+}
+
+
+void setup_graphics_context(chan_info *cp, graphics_context *ax)
+{
+ Widget w;
+ w = channel_to_widget(cp);
+ ax->dp = XtDisplay(w);
+ ax->gc = copy_GC(cp);
+ ax->wn = XtWindow(w);
+}
+
+
+/* colormaps */
+
+static int sono_bins = 0; /* tracks total_bins -- each sono_data[i] is an array of total_bins rectangles */
+static Pixel *current_colors = NULL;
+static int current_colors_size = 0;
+static int current_colormap = BLACK_AND_WHITE_COLORMAP;
+static XRectangle **sono_data = NULL; /* each entry in sono_data is an array of colormap_size arrays: sono_data[colormap_size][total_bins] */
+static int sono_colors = 0; /* tracks colormap_size */
+static GC colormap_GC;
+
+
+void check_colormap_sizes(int colors)
+{
+ int i, old_size;
+ if (current_colors_size > 0)
+ {
+ if (current_colormap != BLACK_AND_WHITE_COLORMAP)
+ {
+ int scr;
+ Colormap cmap;
+ Display *dpy;
+ dpy = XtDisplay(MAIN_SHELL(ss));
+ scr = DefaultScreen(dpy);
+ cmap = DefaultColormap(dpy, scr);
+ XFreeColors(dpy, cmap, current_colors, current_colors_size, 0);
+ current_colormap = BLACK_AND_WHITE_COLORMAP;
+ }
+ if ((current_colors) && (current_colors_size < colors))
+ {
+ old_size = current_colors_size;
+ current_colors_size = colors;
+ current_colors = (Pixel *)realloc(current_colors, current_colors_size * sizeof(Pixel));
+ for (i = old_size; i < current_colors_size; i++) current_colors[i] = 0;
+ }
+ }
+ if ((sono_data) && (sono_colors < colors) && (sono_bins > 0))
+ {
+ old_size = sono_colors;
+ sono_colors = colors;
+ sono_data = (XRectangle **)realloc(sono_data, sono_colors * sizeof(XRectangle *));
+ for (i = old_size; i < sono_colors; i++) sono_data[i] = (XRectangle *)calloc(sono_bins, sizeof(XRectangle));
+ }
+}
+
+
+static void initialize_colormap(void)
+{
+ XGCValues gv;
+ gv.background = ss->white;
+ gv.foreground = ss->data_color;
+ colormap_GC = XCreateGC(MAIN_DISPLAY(ss), XtWindow(MAIN_SHELL(ss)), GCForeground | GCBackground, &gv);
+ sono_colors = color_map_size(ss);
+ sono_data = (XRectangle **)calloc(sono_colors, sizeof(XRectangle *));
+ current_colors_size = color_map_size(ss);
+ current_colors = (Pixel *)calloc(current_colors_size, sizeof(Pixel));
+}
+
+
+void draw_spectro_line(graphics_context *ax, int color, int x0, int y0, int x1, int y1)
+{
+ XSetForeground(ax->dp, colormap_GC, current_colors[color]);
+ XDrawLine(ax->dp, ax->wn, colormap_GC, x0, y0, x1, y1);
+}
+
+
+void draw_sono_rectangles(graphics_context *ax, int color, int jmax)
+{
+ XSetForeground(ax->dp, colormap_GC, current_colors[color]);
+ XFillRectangles(ax->dp, ax->wn, colormap_GC, sono_data[color], jmax);
+}
+
+
+void set_sono_rectangle(int j, int color, int x, int y, int width, int height)
+{
+ XRectangle *r;
+ r = sono_data[color];
+ r[j].x = x;
+ r[j].y = y;
+ r[j].width = width;
+ r[j].height = height;
+}
+
+
+void allocate_sono_rects(int bins)
+{
+ if (bins != sono_bins)
+ {
+ int i;
+ for (i = 0; i < sono_colors; i++)
+ {
+ if ((sono_bins > 0) && (sono_data[i]))
+ free(sono_data[i]); /* each is array of XRectangle structs, but it's the wrong size */
+ sono_data[i] = (XRectangle *)calloc(bins, sizeof(XRectangle));
+ }
+ sono_bins = bins;
+ }
+}
+
+
+void allocate_color_map(int colormap)
+{
+ static bool warned_color = false;
+ if (current_colormap != colormap)
+ {
+ int i;
+ Colormap cmap;
+ XColor tmp_color;
+ Display *dpy;
+ int scr;
+ tmp_color.flags = DoRed | DoGreen | DoBlue;
+
+ dpy = XtDisplay(MAIN_SHELL(ss));
+ scr = DefaultScreen(dpy);
+ cmap = DefaultColormap(dpy, scr);
+
+ /* 8-bit color displays can't handle all these colors, apparently, so we have to check status */
+ if (current_colormap != BLACK_AND_WHITE_COLORMAP)
+ XFreeColors(dpy, cmap, current_colors, current_colors_size, 0);
+
+ for (i = 0; i < current_colors_size; i++)
+ {
+ get_current_color(colormap, i, &(tmp_color.red), &(tmp_color.green), &(tmp_color.blue));
+ if ((XAllocColor(dpy, cmap, &tmp_color)) == 0) /* 0 = failure -- try black as a fallback */
+ {
+ tmp_color.red = 0;
+ tmp_color.green = 0;
+ tmp_color.blue = 0;
+ if ((XAllocColor(dpy, cmap, &tmp_color)) == 0)
+ {
+ if (!warned_color)
+ snd_error_without_format("can't even allocate black?!?");
+ warned_color = true;
+ }
+ }
+ current_colors[i] = tmp_color.pixel;
+ }
+ current_colormap = colormap;
+ }
+}
+
+
+void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, int num, int *colors, int axis_y0, color_t default_color)
+{
+ int i, x0, y0, y2 = 0, y00 = -1, cur, prev;
+ color_t old_color;
+
+ if (num <= 0) return;
+
+ old_color = get_foreground_color(ax);
+
+ x0 = points[0].x;
+ y0 = points[0].y;
+
+ if (abs(y0 - axis_y0) < 5)
+ prev = -1;
+ else prev = colors[0];
+
+ set_foreground_color(ax, (prev == -1) ? default_color : current_colors[prev]);
+
+ for (i = 1; i < num; i++)
+ {
+ int x1, y1;
+ x1 = points[i].x;
+ y1 = points[i].y;
+ if (i < num - 1)
+ y2 = points[i + 1].y;
+ else y2 = y1;
+
+ if ((abs(y0 - axis_y0) < 5) &&
+ (abs(y1 - axis_y0) < 5))
+ cur = -1;
+ else
+ {
+ if ((y00 > y0) &&
+ (y00 > y1) &&
+ (i > 1))
+ cur = colors[i - 2];
+ else
+ {
+ if ((y2 > y1) &&
+ (y2 > y0))
+ cur = colors[i + 1];
+ else
+ {
+ if (y0 > y1)
+ cur = colors[i];
+ else cur = colors[i - 1]; /* coords are upside down */
+ }
+ }
+ }
+
+ if (cur != prev)
+ {
+ set_foreground_color(ax, (cur == -1) ? default_color : current_colors[cur]);
+ prev = cur;
+ }
+
+ if (cp->transform_graph_style == GRAPH_DOTS)
+ draw_dot(ax, x0, y0, cp->dot_size);
+ else draw_line(ax, x0, y0, x1, y1);
+
+ y00 = y0;
+ x0 = x1;
+ y0 = y1;
+ }
+
+ set_foreground_color(ax, old_color);
+}
+
+
+
+/* -------- color/orientation browser -------- */
+
+static Xen color_hook;
+
+static void check_color_hook(void)
+{
+ if (Xen_hook_has_list(color_hook))
+ run_hook(color_hook, Xen_empty_list, S_color_hook);
+}
+
+
+static Widget ccd_dialog = NULL, ccd_list, ccd_scale, ccd_invert, ccd_cutoff;
+
+static void update_graph_setting_fft_changed(chan_info *cp)
+{
+ cp->fft_changed = FFT_CHANGE_LOCKED;
+ update_graph(cp);
+}
+
+
+static void invert_color_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ in_set_color_inverted(cb->set);
+ check_color_hook();
+ for_each_chan(update_graph_setting_fft_changed);
+}
+
+
+void set_color_inverted(bool val)
+{
+ in_set_color_inverted(val);
+ if (ccd_dialog)
+ XmToggleButtonSetState(ccd_invert, (Boolean)val, false);
+ check_color_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph_setting_fft_changed);
+}
+
+
+static void scale_color_callback(Widget w, XtPointer context, XtPointer info)
+{
+ mus_float_t val;
+ int scale_val;
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ scale_val = cbs->value;
+ if (scale_val <= 50)
+ val = (mus_float_t)(scale_val + 1) / 51.0;
+ else val = 1.0 + (mus_float_t)((scale_val - 50) * (scale_val - 50)) / 12.5;
+ in_set_color_scale(val);
+ check_color_hook();
+ for_each_chan(update_graph_setting_fft_changed);
+}
+
+
+static void reflect_color_scale(mus_float_t val)
+{
+ if (val < 0.02)
+ XmScaleSetValue(ccd_scale, 0);
+ else
+ {
+ if (val <= 1.0)
+ XmScaleSetValue(ccd_scale, mus_iclamp(0, (int)(val * 51.0 - 1), 100));
+ else XmScaleSetValue(ccd_scale, mus_iclamp(0, 50 + (int)sqrt((val - 1.0) * 12.5), 100));
+ }
+}
+
+
+void set_color_scale(mus_float_t val)
+{
+ in_set_color_scale(val);
+ if (ccd_dialog)
+ reflect_color_scale(color_scale(ss));
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph_setting_fft_changed);
+}
+
+
+static void list_color_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ if (is_colormap(cbs->item_position - 1))
+ {
+ in_set_color_map(cbs->item_position - 1);
+ check_color_hook();
+ for_each_chan(update_graph_setting_fft_changed);
+ }
+}
+
+
+void set_color_map(int val)
+{
+ in_set_color_map(val);
+ if ((ccd_dialog) && (val >= 0))
+ XmListSelectPos(ccd_list, val + 1, false);
+ check_color_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph_setting_fft_changed);
+}
+
+
+static XmString fscale_label(const char *orig_label, mus_float_t value)
+{
+ XmString x;
+ char *lab;
+ lab = mus_format("%s: %.3f", orig_label, value);
+ x = XmStringCreateLocalized(lab);
+ free(lab);
+ return(x);
+}
+
+
+static void fscale_set_label(const char *orig_label, Widget w, mus_float_t value)
+{
+ XmString x;
+ char *lab;
+ lab = mus_format("%s: %.3f", orig_label, value);
+ x = XmStringCreateLocalized(lab);
+ XtVaSetValues(w, XmNtitleString, x, NULL);
+ free(lab);
+ XmStringFree(x);
+}
+
+
+static void cutoff_color_callback(Widget w, XtPointer context, XtPointer info) /* cutoff point */
+{
+ /* cutoff point for color chooser */
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ in_set_color_cutoff((mus_float_t)(cbs->value) / 1000.0);
+ fscale_set_label("data cutoff", w, color_cutoff(ss));
+ check_color_hook();
+ for_each_chan(update_graph_setting_fft_changed);
+}
+
+
+void set_color_cutoff(mus_float_t val)
+{
+ in_set_color_cutoff(val);
+ if (ccd_dialog)
+ XmScaleSetValue(ccd_cutoff, (int)(val * 1000.0));
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph_setting_fft_changed);
+}
+
+
+static void dismiss_color_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtUnmanageChild(ccd_dialog);
+}
+
+
+static void help_color_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ color_orientation_dialog_help();
+}
+
+
+void reflect_color_list(bool setup_time)
+{
+ if ((ccd_dialog) && (ccd_list))
+ {
+ int i, size;
+ XmString *cmaps;
+ size = num_colormaps();
+ cmaps = (XmString *)calloc(size, sizeof(XmString));
+ for (i = 0; i < size; i++)
+ cmaps[i] = XmStringCreateLocalized(colormap_name(i));
+ XtVaSetValues(ccd_list,
+ XmNitems, cmaps,
+ XmNitemCount, size,
+ NULL);
+ if (setup_time)
+ XtVaSetValues(ccd_list,
+ XmNvisibleItemCount, 6,
+ NULL);
+ for (i = 0; i < size; i++) XmStringFree(cmaps[i]);
+ free(cmaps);
+ }
+}
+
+
+static Xen orientation_hook;
+
+static void check_orientation_hook(void)
+{
+ if (Xen_hook_has_list(orientation_hook))
+ run_hook(orientation_hook, Xen_empty_list, S_orientation_hook);
+}
+
+
+static Widget oid_ax, oid_ay, oid_az, oid_sx, oid_sy, oid_sz, oid_hop;
+#if HAVE_GL
+ static Widget oid_glbutton;
+#endif
+
+#define HOP_MAX 20
+
+static XmString scale_label(const char *orig_label, int value, bool dec)
+{
+ XmString x;
+ char *lab;
+ if (!dec)
+ lab = mus_format("%s: %d", orig_label, value);
+ else lab = mus_format("%s: %.2f", orig_label, value * 0.01);
+ x = XmStringCreateLocalized(lab);
+ free(lab);
+ return(x);
+}
+
+
+static void scale_set_label(const char *orig_label, Widget w, int value, bool dec)
+{
+ /* in new motif (after version 2.1), showValue not XmNONE clobbers XmScale title!
+ * also XmNEAR_BORDER has no effect -- same as XmNEAR_SLIDER
+ * so...
+ * we create the full label by hand here.
+ */
+
+ XmString x;
+ char *lab;
+ if (!dec)
+ lab = mus_format("%s: %d", orig_label, value);
+ else lab = mus_format("%s: %.2f", orig_label, value * 0.01);
+ x = XmStringCreateLocalized(lab);
+ XtVaSetValues(w, XmNtitleString, x, NULL);
+ free(lab);
+ XmStringFree(x);
+}
+
+
+static void ax_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ scale_set_label("x angle", w, cbs->value, false);
+ in_set_spectro_x_angle((mus_float_t)(cbs->value));
+ chans_field(FCP_X_ANGLE, (mus_float_t)(cbs->value));
+ check_orientation_hook();
+ for_each_chan(update_graph);
+}
+
+
+void set_spectro_x_angle(mus_float_t val)
+{
+ if (val < 0.0) val += 360.0; else if (val >= 360.0) val = fmod(val, 360.0);
+ in_set_spectro_x_angle(val);
+ if (ccd_dialog)
+ {
+ XmScaleSetValue(oid_ax, (int)val);
+ scale_set_label("x angle", oid_ax, (int)val, false);
+ }
+ chans_field(FCP_X_ANGLE, val);
+ check_orientation_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph);
+}
+
+
+static void ay_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ scale_set_label("y angle", w, cbs->value, false);
+ in_set_spectro_y_angle((mus_float_t)(cbs->value));
+ chans_field(FCP_Y_ANGLE, (mus_float_t)(cbs->value));
+ check_orientation_hook();
+ for_each_chan(update_graph);
+}
+
+
+void set_spectro_y_angle(mus_float_t val)
+{
+ if (val < 0.0) val += 360.0; else if (val >= 360.0) val = fmod(val, 360.0);
+ in_set_spectro_y_angle(val);
+ if (ccd_dialog)
+ {
+ XmScaleSetValue(oid_ay, (int)val);
+ scale_set_label("y angle", oid_ay, (int)val, false);
+ }
+ chans_field(FCP_Y_ANGLE, val);
+ check_orientation_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph);
+}
+
+
+static void az_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ scale_set_label("z angle", w, cbs->value, false);
+ in_set_spectro_z_angle((mus_float_t)(cbs->value));
+ chans_field(FCP_Z_ANGLE, (mus_float_t)(cbs->value));
+ check_orientation_hook();
+ for_each_chan(update_graph);
+}
+
+
+void set_spectro_z_angle(mus_float_t val)
+{
+ if (val < 0.0) val += 360.0; else if (val >= 360.0) val = fmod(val, 360.0);
+ in_set_spectro_z_angle(val);
+ if (ccd_dialog)
+ {
+ XmScaleSetValue(oid_az, (int)val);
+ scale_set_label("z angle", oid_az, (int)val, false);
+ }
+ chans_field(FCP_Z_ANGLE, val);
+ check_orientation_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph);
+}
+
+
+static void sx_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ scale_set_label("x scale", w, cbs->value, true);
+ in_set_spectro_x_scale((mus_float_t)(cbs->value) * 0.01);
+ chans_field(FCP_X_SCALE, (mus_float_t)(cbs->value) * 0.01);
+ check_orientation_hook();
+ for_each_chan(update_graph);
+}
+
+
+void set_spectro_x_scale(mus_float_t val)
+{
+ in_set_spectro_x_scale(val);
+ if (ccd_dialog)
+ {
+ int value;
+ value = mus_iclamp(0, (int)(val * 100), (int)(100 * SPECTRO_X_SCALE_MAX));
+ XmScaleSetValue(oid_sx, value);
+ scale_set_label("x scale", oid_sx, value, true);
+ }
+ chans_field(FCP_X_SCALE, val);
+ check_orientation_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph);
+}
+
+
+static void sy_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ scale_set_label("y scale", w, cbs->value, true);
+ in_set_spectro_y_scale((mus_float_t)(cbs->value) * 0.01);
+ chans_field(FCP_Y_SCALE, (mus_float_t)(cbs->value) * 0.01);
+ check_orientation_hook();
+ for_each_chan(update_graph);
+}
+
+
+void set_spectro_y_scale(mus_float_t val)
+{
+ in_set_spectro_y_scale(val);
+ if (ccd_dialog)
+ {
+ int value;
+ value = mus_iclamp(0, (int)(val * 100), (int)(100 * SPECTRO_Y_SCALE_MAX));
+ XmScaleSetValue(oid_sy, value);
+ scale_set_label("y scale", oid_sy, value, true);
+ }
+ chans_field(FCP_Y_SCALE, val);
+ check_orientation_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph);
+}
+
+
+static void sz_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ scale_set_label("z scale", w, cbs->value, true);
+ in_set_spectro_z_scale((mus_float_t)(cbs->value) * 0.01);
+ chans_field(FCP_Z_SCALE, (mus_float_t)(cbs->value) * 0.01);
+ check_orientation_hook();
+ for_each_chan(update_graph);
+}
+
+
+void set_spectro_z_scale(mus_float_t val)
+{
+ in_set_spectro_z_scale(val);
+ if (ccd_dialog)
+ {
+ int value;
+ value = mus_iclamp(0, (int)(val * 100), (int)(100 * SPECTRO_Z_SCALE_MAX));
+ XmScaleSetValue(oid_sz, value);
+ scale_set_label("z scale", oid_sz, value, true);
+ }
+ chans_field(FCP_Z_SCALE, val);
+ check_orientation_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph);
+}
+
+
+static void chans_spectro_hop(chan_info *cp, int value)
+{
+ cp->spectro_hop = value;
+}
+
+
+static void hop_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int val;
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ scale_set_label("hop", w, cbs->value, false);
+ val = mus_iclamp(1, cbs->value, HOP_MAX);
+ in_set_spectro_hop(val);
+ for_each_chan_with_int(chans_spectro_hop,val);
+ check_orientation_hook();
+ for_each_chan(update_graph);
+}
+
+
+void set_spectro_hop(int val)
+{
+ if (val > 0)
+ {
+ in_set_spectro_hop(val);
+ if (ccd_dialog)
+ {
+ int value;
+ value = mus_iclamp(1, val, HOP_MAX);
+ XmScaleSetValue(oid_hop, value);
+ scale_set_label("hop", oid_hop, value, false);
+ }
+ for_each_chan_with_int(chans_spectro_hop, val);
+ check_orientation_hook();
+ if (!(ss->graph_hook_active))
+ for_each_chan(update_graph);
+ }
+}
+
+
+static int fixup_angle(mus_float_t ang)
+{
+ int na;
+ na = (int)ang;
+ if (na < 0) na += 360;
+ na = na % 360;
+ return(na);
+}
+
+
+void reflect_spectro(void)
+{
+ /* set color/orientaton widget values */
+ if (ccd_dialog)
+ {
+ XmToggleButtonSetState(ccd_invert, (Boolean)(color_inverted(ss)), false);
+ XtVaSetValues(ccd_cutoff, XmNvalue, (int)((color_cutoff(ss)) * 1000), NULL);
+ reflect_color_scale(color_scale(ss));
+
+ XtVaSetValues(oid_ax, XmNvalue, fixup_angle(spectro_x_angle(ss)), NULL);
+ XtVaSetValues(oid_ay, XmNvalue, fixup_angle(spectro_y_angle(ss)), NULL);
+ XtVaSetValues(oid_az, XmNvalue, fixup_angle(spectro_z_angle(ss)), NULL);
+ XtVaSetValues(oid_sx, XmNvalue, mus_iclamp(0, (int)(spectro_x_scale(ss) * 100), 100), NULL);
+ XtVaSetValues(oid_sy, XmNvalue, mus_iclamp(0, (int)(spectro_y_scale(ss) * 100), 100), NULL);
+ XtVaSetValues(oid_sz, XmNvalue, mus_iclamp(0, (int)(spectro_z_scale(ss) * 100), 100), NULL);
+ XtVaSetValues(oid_hop, XmNvalue, mus_iclamp(1, spectro_hop(ss), HOP_MAX), NULL);
+ check_orientation_hook();
+ }
+}
+
+
+void set_with_gl(bool val, bool with_dialogs)
+{
+#if HAVE_GL
+ sgl_save_currents();
+#endif
+ in_set_with_gl(val);
+#if HAVE_GL
+ sgl_set_currents(with_dialogs);
+ if ((ccd_dialog) && (with_dialogs))
+ XmToggleButtonSetState(oid_glbutton, val, false);
+#endif
+}
+
+
+#if HAVE_GL
+static void with_gl_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ sgl_save_currents();
+ in_set_with_gl(cb->set);
+ sgl_set_currents(true);
+ /* this only sets the slider positions -- it doesn't update the labels! */
+ /* and reflect_spectro() doesn't help! */
+ if (ccd_dialog)
+ {
+ scale_set_label("x angle", oid_ax, spectro_x_angle(ss), false);
+ scale_set_label("y angle", oid_ay, spectro_y_angle(ss), false);
+ scale_set_label("z angle", oid_az, spectro_z_angle(ss), false);
+ scale_set_label("x scale", oid_sx, spectro_x_scale(ss), false);
+ scale_set_label("y scale", oid_sy, spectro_y_scale(ss), false);
+ scale_set_label("z scale", oid_sz, spectro_z_scale(ss), false);
+ }
+ for_each_chan(update_graph);
+}
+#endif
+
+
+static void reset_color_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* put everything back the way it was at the start.
+ * this sets everything to the startup defaults -- should they be the dialog startup values instead?
+ */
+ set_color_cutoff(DEFAULT_COLOR_CUTOFF);
+ set_color_inverted(DEFAULT_COLOR_INVERTED);
+ set_color_scale(DEFAULT_COLOR_SCALE);
+ set_color_map(DEFAULT_COLOR_MAP);
+
+ reset_spectro();
+ reflect_spectro();
+ for_each_chan(update_graph);
+}
+
+
+
+/* I tried a scrolled window with each colormap name in an appropriate color, but it looked kinda dumb */
+
+Widget make_color_orientation_dialog(bool managed)
+{
+ if (!ccd_dialog)
+ {
+ Arg args[32];
+ int n, initial_value;
+ XmString xhelp, xdismiss, xinvert, titlestr, xreset, xstr;
+ Widget mainform, light_label, lsep, rsep, sep1, tsep, color_frame, orientation_frame, color_form, orientation_form;
+ Widget color_title, orientation_title;
+#if HAVE_GL
+ XmString glstr;
+#endif
+
+ xdismiss = XmStringCreateLocalized((char *)I_GO_AWAY); /* needed by template dialog */
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ xreset = XmStringCreateLocalized((char *)"Reset");
+ titlestr = XmStringCreateLocalized((char *)"Color and Orientation");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNcancelLabelString, xdismiss); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNokLabelString, xreset); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ ccd_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Color and Orientation", args, n);
+
+ XtAddCallback(ccd_dialog, XmNcancelCallback, dismiss_color_orientation_callback, NULL);
+ XtAddCallback(ccd_dialog, XmNhelpCallback, help_color_orientation_callback, NULL);
+ XtAddCallback(ccd_dialog, XmNokCallback, reset_color_orientation_callback, NULL);
+
+ XmStringFree(xhelp);
+ XmStringFree(xdismiss);
+ XmStringFree(titlestr);
+ XmStringFree(xreset);
+
+ XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(ccd_dialog, XmDIALOG_SEPARATOR)); n++;
+ mainform = XtCreateManagedWidget("formd", xmFormWidgetClass, ccd_dialog, args, n);
+
+ /* color section */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNborderWidth, 10); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ color_frame = XtCreateManagedWidget("color", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ color_form = XtCreateManagedWidget("cform", xmFormWidgetClass, color_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ color_title = XtCreateManagedWidget("colors", xmLabelWidgetClass, color_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 60); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, color_title); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNlistMarginWidth, 3); n++;
+ ccd_list = XmCreateScrolledList(color_form, (char *)"colormap-list", args, n);
+
+ XtVaSetValues(ccd_list,
+ XmNbackground, ss->white,
+ XmNforeground, ss->black,
+ NULL);
+ reflect_color_list(true);
+ XtAddCallback(ccd_list, XmNbrowseSelectionCallback, list_color_callback, NULL);
+ XtManageChild(ccd_list);
+ XmListSelectPos(ccd_list, color_map(ss) + 1, false);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, color_title); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNwidth, 10); n++;
+ lsep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, color_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, ccd_list); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, color_title); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNwidth, 10); n++;
+ rsep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, color_form, args, n);
+
+ /* this horizontal separator exists solely to keep the "light" label from clobbering the "dark" label! */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, lsep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, rsep); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, color_title); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNwidth, 250); n++;
+ XtSetArg(args[n], XmNheight, 10); n++;
+ sep1 = XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, color_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, lsep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, rsep); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep1); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNEAR_SLIDER); n++;
+ XtSetArg(args[n], XmNvalue, 50); n++;
+ ccd_scale = XtCreateManagedWidget("ccdscl", xmScaleWidgetClass, color_form, args, n);
+ XtAddCallback(ccd_scale, XmNvalueChangedCallback, scale_color_callback, NULL);
+ XtAddCallback(ccd_scale, XmNdragCallback, scale_color_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, lsep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, ccd_scale); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ light_label = XtCreateManagedWidget("light", xmLabelWidgetClass, color_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, rsep); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, ccd_scale); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtCreateManagedWidget("dark", xmLabelWidgetClass, color_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, lsep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, rsep); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, light_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNwidth, 250); n++;
+ XtSetArg(args[n], XmNheight, 10); n++;
+ tsep = XtCreateManagedWidget("tsep", xmSeparatorWidgetClass, color_form, args, n);
+
+ n = 0;
+ xstr = fscale_label("data cutoff", color_cutoff(ss));
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, lsep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, rsep); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, tsep); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNmaximum, 250); n++;
+ XtSetArg(args[n], XmNdecimalPoints, 3); n++;
+ XtSetArg(args[n], XmNtitleString, xstr); n++;
+ XtSetArg(args[n], XmNvalue, (int)(color_cutoff(ss) * 1000)); n++;
+ ccd_cutoff = XtCreateManagedWidget("cutoff", xmScaleWidgetClass, color_form, args, n);
+ XtAddCallback(ccd_cutoff, XmNvalueChangedCallback, cutoff_color_callback, NULL);
+ XtAddCallback(ccd_cutoff, XmNdragCallback, cutoff_color_callback, NULL);
+ XmStringFree(xstr);
+
+ XtVaSetValues(((XmScaleWidget)ccd_cutoff)->composite.children[0], XmNbackground, ss->basic_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, lsep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, ccd_cutoff); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNset, color_inverted(ss)); n++;
+ xinvert = XmStringCreateLocalized((char *)"invert");
+ XtSetArg(args[n], XmNlabelString, xinvert); n++;
+ ccd_invert = make_togglebutton_widget("invert", color_form, args, n);
+ XtAddCallback(ccd_invert, XmNvalueChangedCallback, invert_color_callback, NULL);
+ XmStringFree(xinvert);
+
+
+ /* orientation section */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, color_frame); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNborderWidth, 10); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ orientation_frame = XtCreateManagedWidget("color", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ orientation_form = XtCreateManagedWidget("oform", xmFormWidgetClass, orientation_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ orientation_title = XtCreateManagedWidget("orientation", xmLabelWidgetClass, orientation_form, args, n);
+
+ #define SCALE_BORDER_WIDTH 6
+
+ n = 0;
+ initial_value = fixup_angle(spectro_x_angle(ss));
+ xstr = scale_label("x angle", initial_value, false);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNvalue, initial_value); n++;
+ XtSetArg(args[n], XmNmaximum, 360); n++;
+ XtSetArg(args[n], XmNtitleString, xstr); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 48); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, orientation_title); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ oid_ax = XtCreateManagedWidget("ax", xmScaleWidgetClass, orientation_form, args, n);
+ XtAddCallback(oid_ax, XmNvalueChangedCallback, ax_orientation_callback, NULL);
+ XtAddCallback(oid_ax, XmNdragCallback, ax_orientation_callback, NULL);
+ XmStringFree(xstr);
+
+ XtVaSetValues(((XmScaleWidget)oid_ax)->composite.children[0], XmNbackground, ss->basic_color, NULL);
+
+ n = 0;
+ initial_value = mus_iclamp(0, (int)(spectro_x_scale(ss) * 100), (int)(100 * SPECTRO_X_SCALE_MAX));
+ xstr = scale_label("x scale", initial_value, true);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNmaximum, (int)(100 * SPECTRO_X_SCALE_MAX)); n++;
+ XtSetArg(args[n], XmNvalue, initial_value); n++;
+ XtSetArg(args[n], XmNtitleString, xstr); n++;
+ XtSetArg(args[n], XmNdecimalPoints, 2); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 52); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, oid_ax); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ oid_sx = XtCreateManagedWidget("xs", xmScaleWidgetClass, orientation_form, args, n);
+ XtAddCallback(oid_sx, XmNvalueChangedCallback, sx_orientation_callback, NULL);
+ XtAddCallback(oid_sx, XmNdragCallback, sx_orientation_callback, NULL);
+ XmStringFree(xstr);
+
+ XtVaSetValues(((XmScaleWidget)oid_sx)->composite.children[0], XmNbackground, ss->basic_color, NULL);
+
+ n = 0;
+ initial_value = fixup_angle(spectro_y_angle(ss));
+ xstr = scale_label("y angle", initial_value, false);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNvalue, initial_value); n++;
+ XtSetArg(args[n], XmNmaximum, 360); n++;
+ XtSetArg(args[n], XmNtitleString, xstr); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 48); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, oid_ax); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ oid_ay = XtCreateManagedWidget("ay", xmScaleWidgetClass, orientation_form, args, n);
+ XtAddCallback(oid_ay, XmNvalueChangedCallback, ay_orientation_callback, NULL);
+ XtAddCallback(oid_ay, XmNdragCallback, ay_orientation_callback, NULL);
+ XmStringFree(xstr);
+
+ XtVaSetValues(((XmScaleWidget)oid_ay)->composite.children[0], XmNbackground, ss->basic_color, NULL);
+
+ n = 0;
+ initial_value = mus_iclamp(0, (int)(spectro_y_scale(ss) * 100), (int)(100 * SPECTRO_Y_SCALE_MAX));
+ xstr = scale_label("y scale", initial_value, true);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNmaximum, (int)(100 * SPECTRO_Y_SCALE_MAX)); n++;
+ XtSetArg(args[n], XmNvalue, initial_value); n++;
+ XtSetArg(args[n], XmNtitleString, xstr); n++;
+ XtSetArg(args[n], XmNdecimalPoints, 2); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 52); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, oid_sx); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ oid_sy = XtCreateManagedWidget("ys", xmScaleWidgetClass, orientation_form, args, n);
+ XtAddCallback(oid_sy, XmNvalueChangedCallback, sy_orientation_callback, NULL);
+ XtAddCallback(oid_sy, XmNdragCallback, sy_orientation_callback, NULL);
+ XmStringFree(xstr);
+
+ XtVaSetValues(((XmScaleWidget)oid_sy)->composite.children[0], XmNbackground, ss->basic_color, NULL);
+
+ n = 0;
+ initial_value = fixup_angle(spectro_z_angle(ss));
+ xstr = scale_label("z angle", initial_value, false);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNtitleString, xstr); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNvalue, initial_value); n++;
+ XtSetArg(args[n], XmNmaximum, 360); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 48); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, oid_ay); n++;
+ XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ oid_az = XtCreateManagedWidget("az", xmScaleWidgetClass, orientation_form, args, n);
+ XtAddCallback(oid_az, XmNvalueChangedCallback, az_orientation_callback, NULL);
+ XtAddCallback(oid_az, XmNdragCallback, az_orientation_callback, NULL);
+ XmStringFree(xstr);
+
+ XtVaSetValues(((XmScaleWidget)oid_az)->composite.children[0], XmNbackground, ss->basic_color, NULL);
+
+ n = 0;
+ initial_value = mus_iclamp(0, (int)(spectro_z_scale(ss) * 100), (int)(100 * SPECTRO_Z_SCALE_MAX));
+ xstr = scale_label("z scale", initial_value, true);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNdecimalPoints, 2); n++;
+ XtSetArg(args[n], XmNmaximum, (int)(100 * SPECTRO_Z_SCALE_MAX)); n++;
+ XtSetArg(args[n], XmNvalue, initial_value); n++;
+ XtSetArg(args[n], XmNtitleString, xstr); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 52); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, oid_sy); n++;
+ XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ oid_sz = XtCreateManagedWidget("zs", xmScaleWidgetClass, orientation_form, args, n);
+ XtAddCallback(oid_sz, XmNvalueChangedCallback, sz_orientation_callback, NULL);
+ XtAddCallback(oid_sz, XmNdragCallback, sz_orientation_callback, NULL);
+ XmStringFree(xstr);
+
+ XtVaSetValues(((XmScaleWidget)oid_sz)->composite.children[0], XmNbackground, ss->basic_color, NULL);
+
+ n = 0;
+ initial_value = mus_iclamp(1, spectro_hop(ss), HOP_MAX);
+ xstr = scale_label("hop", initial_value, false);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNvalue, initial_value); n++;
+ XtSetArg(args[n], XmNmaximum, HOP_MAX); n++;
+ XtSetArg(args[n], XmNtitleString, xstr); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 48); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, oid_az); n++;
+#if HAVE_GL
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+#else
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+#endif
+ XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ oid_hop = XtCreateManagedWidget("hop", xmScaleWidgetClass, orientation_form, args, n);
+ XtAddCallback(oid_hop, XmNvalueChangedCallback, hop_orientation_callback, NULL);
+ XtAddCallback(oid_hop, XmNdragCallback, hop_orientation_callback, NULL);
+ XmStringFree(xstr);
+
+ XtVaSetValues(((XmScaleWidget)oid_hop)->composite.children[0], XmNbackground, ss->basic_color, NULL);
+
+#if HAVE_GL
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNset, with_gl(ss)); n++;
+ glstr = XmStringCreateLocalized((char *)"use OpenGL");
+ XtSetArg(args[n], XmNlabelString, glstr); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, oid_hop); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ oid_glbutton = make_togglebutton_widget("use OpenGL", orientation_form, args, n);
+ XtAddCallback(oid_glbutton, XmNvalueChangedCallback, with_gl_callback, NULL);
+ XmStringFree(glstr);
+#endif
+
+ if (color_scale(ss) != 1.0)
+ reflect_color_scale(color_scale(ss));
+
+ map_over_children(ccd_dialog, set_main_color_of_widget);
+ set_dialog_widget(COLOR_ORIENTATION_DIALOG, ccd_dialog);
+ if (managed) XtManageChild(ccd_dialog);
+ }
+ else
+ {
+ if (managed)
+ {
+ if (!XtIsManaged(ccd_dialog)) XtManageChild(ccd_dialog);
+ raise_dialog(ccd_dialog);
+ }
+ }
+ return(ccd_dialog);
+}
+
+
+static void view_color_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ make_color_orientation_dialog(true);
+}
+
+
+bool color_orientation_dialog_is_active(void)
+{
+ return((ccd_dialog) && (XtIsManaged(ccd_dialog)));
+}
+
+
+
+void g_init_gxdraw(void)
+{
+ #define H_orientation_hook S_orientation_hook " (): called whenever one of the variables associated with the \
+orientation dialog changes"
+ #define H_color_hook S_color_hook " (): called whenever one of the variables associated with the \
+color dialog changes"
+
+ orientation_hook = Xen_define_hook(S_orientation_hook, "(make-hook)", 0, H_orientation_hook);
+ color_hook = Xen_define_hook(S_color_hook, "(make-hook)", 0, H_color_hook);
+}
+
+
+#define HELP_ROWS 10
+#define HELP_XREFS 8
+#define HELP_COLUMNS 72
+/* these set the initial size of the help dialog text area */
+
+static Widget help_dialog = NULL;
+static Widget help_text = NULL;
+static char *original_help_text = NULL;
+static with_word_wrap_t outer_with_wrap = WITHOUT_WORD_WRAP;
+static const char **help_urls = NULL; /* shouldn't this be static char* const char*? */
+
+static int old_help_text_width = 0;
+
+static void help_expose(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ int curwid;
+ curwid = widget_width(help_text);
+ if (old_help_text_width == 0)
+ old_help_text_width = curwid;
+ else
+ {
+ if ((outer_with_wrap == WITH_WORD_WRAP) &&
+ (abs(curwid - old_help_text_width) > 10))
+ {
+ char *cur_help_str, *new_help_str = NULL;
+ cur_help_str = XmTextGetString(help_text);
+ new_help_str = word_wrap(original_help_text, curwid);
+ XmTextSetString(help_text, new_help_str);
+ if (new_help_str) free(new_help_str);
+ if (cur_help_str) XtFree(cur_help_str);
+ old_help_text_width = curwid;
+ }
+ }
+}
+
+
+static XmString parse_crossref(const char *xref)
+{
+ XmString xs = NULL, tmp;
+ int i, len, start = 0, j, k;
+ char *str;
+ /* crossref has text for scrolled list entry, but url is in '{}'. It is displayed via the texts rendition */
+ len = strlen(xref);
+ for (i = 0; i < len; i++)
+ {
+ if (xref[i] == '{')
+ {
+ if (i > 0)
+ {
+ str = (char *)calloc(i - start + 1, sizeof(char));
+ for (k = 0, j = start; j < i; k++, j++) str[k] = xref[j];
+ tmp = XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"normal_text");
+ free(str);
+ if (xs)
+ xs = XmStringConcatAndFree(xs, tmp);
+ else xs = tmp;
+ }
+ start = i + 1;
+ }
+ else
+ {
+ if (xref[i] == '}')
+ {
+ str = (char *)calloc(i - start + 1, sizeof(char));
+ for (k = 0, j = start; j < i; k++, j++) str[k] = xref[j];
+ if (xs)
+ xs = XmStringConcatAndFree(xs, XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"url_text"));
+ else xs = XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"url_text");
+ free(str);
+ start = i + 1;
+ }
+ }
+ }
+ if (start < len)
+ {
+ str = (char *)calloc(len - start + 1, sizeof(char));
+ for (k = 0, j = start; j < len; k++, j++) str[k] = xref[j];
+ if (xs)
+ xs = XmStringConcatAndFree(xs, XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"normal_text"));
+ else xs = XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"normal_text");
+ free(str);
+ }
+ return(xs);
+}
+
+
+static char *find_highlighted_text(XmString xs)
+{
+ /* search xs for text in "url_text" rendition, returning first such portion */
+ XtPointer text;
+ bool in_red_text = false;
+ unsigned int len;
+ char *result;
+ XmStringComponentType type;
+ XmStringContext ctx;
+
+ XmStringInitContext(&ctx, xs);
+
+ while ((type = XmStringGetNextTriple(ctx, &len, &text)) != XmSTRING_COMPONENT_END)
+ {
+ switch (type)
+ {
+ case XmSTRING_COMPONENT_RENDITION_BEGIN:
+ in_red_text = mus_strcmp((char *)text, "url_text");
+ break;
+
+ case XmSTRING_COMPONENT_RENDITION_END:
+ in_red_text = false;
+ break;
+
+ case XmSTRING_COMPONENT_TEXT:
+ if (in_red_text)
+ {
+ result = mus_strdup((char *)text);
+ XtFree((char *)text);
+ XmStringFreeContext(ctx);
+ return(result);
+ }
+ }
+
+ /* this from the Motif docs, though it looks odd to me */
+ if (text) XtFree((char *)text);
+ text = NULL;
+ }
+
+ XmStringFreeContext(ctx);
+ return(NULL);
+}
+
+
+static Widget related_items = NULL;
+
+static char *help_completer(widget_t w, const char *text, void *data)
+{
+ return(expression_completer(w, text, data));
+ /* might want to look at help topics too */
+}
+
+
+static bool new_help(const char *pattern, bool complain)
+{
+ const char *url = NULL;
+ const char **xrefs;
+
+ url = snd_url(pattern);
+ if (url)
+ {
+ /* given name, find doc string, if any */
+ Xen xstr;
+ xstr = g_snd_help(C_string_to_Xen_string(pattern), 0);
+ if (Xen_is_string(xstr))
+ {
+ int gc_loc;
+ gc_loc = snd_protect(xstr);
+ xrefs = help_name_to_xrefs(pattern);
+ snd_help_with_xrefs(pattern, Xen_string_to_C_string(xstr), WITH_WORD_WRAP, xrefs, NULL);
+ snd_unprotect_at(gc_loc);
+ if (xrefs) free(xrefs);
+ return(true);
+ }
+ url_to_html_viewer(url);
+ return(true);
+ }
+
+ if ((!(snd_topic_help(pattern))) && (complain))
+ {
+ xrefs = help_name_to_xrefs(pattern);
+ if (xrefs)
+ {
+ snd_help_with_xrefs(pattern, "(no help found)", WITH_WORD_WRAP, xrefs, NULL);
+ free(xrefs);
+ return(true);
+ }
+ else snd_help_with_xrefs(pattern, "(no help found)", WITH_WORD_WRAP, NULL, NULL);
+ }
+
+ return(false);
+}
+
+
+static void help_browse_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* single-click to select item in "related items" list */
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ if ((help_urls) && (help_urls[cbs->item_position - 1]))
+ url_to_html_viewer(help_urls[cbs->item_position - 1]);
+ else
+ {
+ char *red_text;
+ red_text = find_highlighted_text(cbs->item);
+ if (red_text)
+ {
+ name_to_html_viewer(red_text);
+ free(red_text);
+ }
+ else
+ {
+ red_text = (char *)XmStringUnparse(cbs->item, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ if (red_text)
+ {
+ new_help(red_text, true);
+ XtFree(red_text);
+ }
+ }
+ }
+}
+
+
+static void help_double_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* double-click item in "related items" list */
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ if ((help_urls) && (help_urls[cbs->item_position - 1]))
+ url_to_html_viewer(help_urls[cbs->item_position - 1]);
+ else
+ {
+ char *red_text;
+ red_text = find_highlighted_text(cbs->selected_items[0]);
+ if (red_text)
+ {
+ name_to_html_viewer(red_text);
+ free(red_text);
+ }
+ else
+ {
+ red_text = (char *)XmStringUnparse(cbs->selected_items[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ if (red_text)
+ {
+ name_to_html_viewer(red_text);
+ XtFree(red_text);
+ }
+ }
+ }
+}
+
+
+static Widget help_search = NULL;
+
+static void help_quit_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* this focus widget check is actually needed! */
+ if (XmGetFocusWidget(help_dialog) == XmMessageBoxGetChild(help_dialog, XmDIALOG_CANCEL_BUTTON))
+ XtUnmanageChild(help_dialog);
+}
+
+
+static void text_release_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ char *help_str;
+ help_str = XmTextGetSelection(w);
+ if (help_str)
+ {
+ int i, len;
+ bool one_word = true;
+ len = mus_strlen(help_str);
+ for (i = 0; i < len; i++)
+ if (isspace(help_str[i]))
+ {
+ one_word = false;
+ break;
+ }
+ if (one_word) new_help(help_str, false);
+ XtFree(help_str);
+ }
+}
+
+
+static void help_search_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *pattern = NULL;
+ pattern = XmTextFieldGetString(w);
+ if (new_help(pattern, true))
+ XmTextFieldSetString(w, (char *)"");
+ if (pattern) XtFree(pattern);
+}
+
+
+static XmRendition texts[2];
+
+static void create_help_monolog(void)
+{
+ /* create scrollable but not editable text window */
+ Arg args[20];
+ int n;
+ XmString titlestr, go_away;
+ Widget holder, xref_label; /* documentation says this isn't needed, but it is */
+ Widget frame, label, inner_holder, sep, parent;
+ XmRenderTable rs = NULL;
+
+ titlestr = XmStringCreateLocalized((char *)I_HELP);
+ go_away = XmStringCreateLocalized((char *)I_GO_AWAY);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ /* this window should be resizable by the user (i.e. have the resize bars), but not resize itself */
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ XtSetArg(args[n], XmNcancelLabelString, go_away); n++;
+
+ help_dialog = XmCreateMessageDialog(MAIN_PANE(ss), (char *)"snd-help", args, n);
+ XtAddEventHandler(help_dialog, ExposureMask, false, help_expose, NULL);
+
+ XtAddCallback(help_dialog, XmNcancelCallback, help_quit_callback, NULL);
+
+ XtUnmanageChild(XmMessageBoxGetChild(help_dialog, XmDIALOG_OK_BUTTON));
+ XtUnmanageChild(XmMessageBoxGetChild(help_dialog, XmDIALOG_HELP_BUTTON));
+ XtUnmanageChild(XmMessageBoxGetChild(help_dialog, XmDIALOG_SYMBOL_LABEL));
+
+ XtVaSetValues(XmMessageBoxGetChild(help_dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->highlight_color, NULL);
+
+ XmStringFree(titlestr);
+ holder = XtCreateManagedWidget("holder", xmFormWidgetClass, help_dialog, NULL, 0);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNeditMode, XmMULTI_LINE_EDIT); n++;
+ XtSetArg(args[n], XmNeditable, false); n++;
+ XtSetArg(args[n], XmNcolumns, HELP_COLUMNS); n++;
+ XtSetArg(args[n], XmNrows, HELP_ROWS); n++;
+ XtSetArg(args[n], XmNforeground, ss->black); n++; /* needed if color allocation fails completely */
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ help_text = XmCreateScrolledText(holder, (char *)"help-text", args, n);
+ XtAddEventHandler(help_text, ButtonReleaseMask, false, text_release_callback, NULL);
+ XtManageChild(help_text);
+
+ /* to display the url-related portion of the text in red, we need a rendition for it in the rendertable */
+ /* try to find the current default render table. */
+ parent = help_text;
+ while ((parent != NULL) && (rs == NULL))
+ {
+ XtVaGetValues(parent, XmNrenderTable, &rs, NULL);
+ parent = XtParent(parent);
+ }
+ n = 0;
+ if (rs == NULL)
+ {
+ /* failed to find a rendertable to specialize, so we need an explicit font */
+ XtSetArg(args[n], XmNfontName, listener_font(ss)); n++;
+ XtSetArg(args[n], XmNfontType, XmFONT_IS_FONT); n++;
+ XtSetArg(args[n], XmNloadModel, XmLOAD_IMMEDIATE); n++;
+ }
+ XtSetArg(args[n], XmNrenditionBackground, ss->white); n++;
+ XtSetArg(args[n], XmNrenditionForeground, ss->red); n++;
+ texts[0] = XmRenditionCreate(help_text, (char *)"url_text", args, n);
+ XtSetArg(args[n - 1], XmNrenditionForeground, ss->black);
+ texts[1] = XmRenditionCreate(help_text, (char *)"normal_text", args, n);
+ rs = XmRenderTableCopy(XmRenderTableAddRenditions(rs, texts, 2, XmMERGE_NEW), NULL, 0);
+ /*
+ * valgrind says this data is used later
+ * XmRenditionFree(texts[0]);
+ * XmRenditionFree(texts[1]);
+ */
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, XtParent(help_text)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNheight, 6); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, holder, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNheight, 24); n++;
+ /* XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++; */
+ label = XtCreateManagedWidget("help topic:", xmLabelWidgetClass, holder, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ help_search = make_textfield_widget("help-search", holder, args, n, ACTIVATABLE, add_completer_func(help_completer, NULL));
+ XtAddCallback(help_search, XmNactivateCallback, help_search_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, help_search); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNshadowThickness, 4); n++;
+ frame = XtCreateManagedWidget("frame", xmFrameWidgetClass, holder, args, n);
+
+ inner_holder = XtCreateManagedWidget("inner-holder", xmFormWidgetClass, frame, NULL, 0);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ xref_label = XtCreateManagedWidget("related topics:", xmLabelWidgetClass, inner_holder, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, xref_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+
+ /* in operton-based solaris 10 this (next) line causes an X server error (with no stack...):
+ * complaint is X_ChangeGC got an invalid font.
+ * Do I need a configure test program for this? Is there some other way to force the render table to take effect?
+ */
+#if (!HAVE_SUN) || (!MUS_LITTLE_ENDIAN)
+ XtSetArg(args[n], XmNfontList, 0); n++; /* needed or new rendertable doesn't take effect! */
+ /* also, 0, not NULL so types match */
+ XtSetArg(args[n], XmNrenderTable, rs); n++;
+#endif
+
+ XtSetArg(args[n], XmNvisibleItemCount, HELP_XREFS); n++; /* appears to be a no-op */
+ XtSetArg(args[n], XmNheight, 150); n++;
+
+ XtSetArg(args[n], XmNscrollBarDisplayPolicy, XmAS_NEEDED); n++;
+ related_items = XmCreateScrolledList(inner_holder, (char *)"help-list", args, n);
+ XtManageChild(related_items);
+ XtAddCallback(related_items, XmNbrowseSelectionCallback, help_browse_callback, NULL);
+ XtAddCallback(related_items, XmNdefaultActionCallback, help_double_click_callback, NULL);
+
+ XtManageChild(help_dialog);
+
+ map_over_children(help_dialog, set_main_color_of_widget);
+ XtVaSetValues(help_text, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ XtVaSetValues(related_items, XmNbackground, ss->highlight_color, XmNforeground, ss->black, NULL);
+ XtVaSetValues(xref_label, XmNbackground, ss->highlight_color, XmNforeground, ss->black, NULL);
+
+ XtVaSetValues(XmMessageBoxGetChild(help_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(help_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ set_dialog_widget(HELP_DIALOG, help_dialog);
+}
+
+
+int help_text_width(const char *txt, int start, int end)
+{
+#if 0
+ /* this is full of problems... -- adding renditions below makes everything else flakey */
+ if ((help_text) && (end > start))
+ {
+ char *msg;
+ int i, j;
+ XmString s1;
+ Dimension text_wid = 0;
+ XmFontList fonts;
+ XtVaGetValues(help_text, XmNfontList, &fonts, NULL);
+ msg = (char *)calloc(end - start + 1, sizeof(char));
+ for (i = start, j = 0; i < end; i++, j++) msg[j] = txt[i];
+ s1 = XmStringCreateLocalized(msg);
+ text_wid = XmStringWidth(fonts, s1);
+ XmStringFree(s1);
+ free(msg);
+ return((int)text_wid);
+ }
+#endif
+ return((end - start) * 8);
+}
+
+
+Widget snd_help(const char *subject, const char *helpstr, with_word_wrap_t with_wrap)
+{
+ /* place help string in scrollable help window */
+ /* if window is already active, add this help at the top and reposition */
+ XmString xstr1;
+
+ outer_with_wrap = with_wrap;
+ if (!(help_dialog))
+ create_help_monolog();
+ else raise_dialog(help_dialog);
+
+ xstr1 = XmStringCreateLocalized((char *)subject);
+ XtVaSetValues(help_dialog, XmNmessageString, xstr1, NULL);
+ original_help_text = (char *)helpstr;
+
+ if (with_wrap == WITH_WORD_WRAP)
+ {
+ char *new_help_str = NULL;
+ new_help_str = word_wrap(helpstr, widget_width(help_text));
+ XmTextSetString(help_text, new_help_str);
+ if (new_help_str) free(new_help_str);
+ }
+ else XmTextSetString(help_text, (char *)helpstr);
+
+ if (!XtIsManaged(help_dialog))
+ XtManageChild(help_dialog);
+
+ XmStringFree(xstr1);
+ XtVaSetValues(related_items, XmNitems, NULL, XmNitemCount, 0, NULL);
+ return(help_dialog);
+}
+
+
+Widget snd_help_with_xrefs(const char *subject, const char *helpstr, with_word_wrap_t with_wrap, const char **xrefs, const char **urls)
+{
+ Widget w;
+ w = snd_help(subject, helpstr, with_wrap);
+ help_urls = urls; /* can't associate the url with the help item in any "natural" way in Motif (no user-data per item) */
+ if (xrefs)
+ {
+ int i, len;
+
+ for (i = 0; ; i++)
+ if (!xrefs[i])
+ {
+ len = i;
+ break;
+ }
+
+ if (len > 0)
+ {
+ XmString *strs;
+ strs = (XmString *)calloc(len, sizeof(XmString));
+
+ for (i = 0; i < len; i++)
+ strs[i] = parse_crossref((const char *)(xrefs[i]));
+ XtVaSetValues(related_items, XmNitems, strs, XmNitemCount, len, NULL);
+
+ for (i = 0; i < len; i++)
+ XmStringFree(strs[i]);
+ free(strs);
+ }
+ }
+ return(w);
+}
+
+
+void snd_help_append(const char *text)
+{
+ if (help_text)
+ XmTextInsert(help_text,
+ XmTextGetLastPosition(help_text),
+ (char *)text);
+}
+
+
+void snd_help_back_to_top(void)
+{
+ if (help_text) XmTextShowPosition(help_text, 0);
+}
+
+
+static Widget edit_find_dialog, edit_find_text, cancelB, edit_find_label, previousB;
+static Widget find_error_frame = NULL, find_error_label = NULL;
+static chan_info *find_channel = NULL; /* sigh */
+
+
+static void clear_find_error(void);
+static void edit_find_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ clear_find_error();
+}
+
+
+static void clear_find_error(void)
+{
+ if ((find_error_frame) && (XtIsManaged(find_error_frame)))
+ XtUnmanageChild(find_error_frame);
+ XtRemoveCallback(edit_find_text, XmNmodifyVerifyCallback, edit_find_modify_callback, NULL);
+ /* squeezing out the error label room here moves the text widget, which is irritating since it
+ * means the text we're typing gets lost
+ */
+}
+
+
+void find_dialog_stop_label(bool show_stop)
+{
+ XmString s1;
+ if (show_stop)
+ s1 = XmStringCreateLocalized((char *)I_STOP);
+ else s1 = XmStringCreateLocalized((char *)I_GO_AWAY);
+ XtVaSetValues(cancelB, XmNlabelString, s1, NULL);
+ XmStringFree(s1);
+}
+
+
+void errors_to_find_text(const char *msg, void *data)
+{
+ Dimension find_height = 0;
+ int lines = 0;
+ XmString label;
+ find_dialog_set_label("error");
+ label = multi_line_label(msg, &lines);
+ XtVaSetValues(find_error_label,
+ XmNlabelString, label,
+ XmNheight, lines * 20,
+ NULL);
+ XtVaSetValues(find_error_frame, XmNheight, lines * 20, NULL);
+ XtVaGetValues(edit_find_dialog, XmNheight, &find_height, NULL);
+ if (find_height < (lines * 20 + 140))
+ {
+ XtUnmanageChild(edit_find_dialog);
+ XtVaSetValues(edit_find_dialog, XmNheight, 140 + 20 * lines, NULL);
+ XtManageChild(edit_find_dialog);
+ }
+ XmStringFree(label);
+ XtManageChild(find_error_frame);
+ XtAddCallback(edit_find_text, XmNmodifyVerifyCallback, edit_find_modify_callback, NULL);
+}
+
+
+void stop_search_if_error(const char *msg, void *data)
+{
+ errors_to_find_text(msg, data);
+ ss->stopped_explicitly = true; /* should be noticed in global_search in snd-find.c */
+}
+
+
+static void edit_find_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ find_dialog_help();
+}
+
+
+static void edit_find_ok_callback(read_direction_t direction, Widget w, XtPointer context, XtPointer info)
+{
+ char *str;
+ str = XmTextGetString(edit_find_text);
+#if HAVE_EXTENSION_LANGUAGE
+ find_dialog_find(str, direction, find_channel);
+#endif
+ if (str) free(str);
+}
+
+
+void find_dialog_set_label(const char *str)
+{
+ if (edit_find_label)
+ set_label(edit_find_label, str);
+}
+
+
+static void edit_find_next_callback(Widget w, XtPointer context, XtPointer info)
+{
+ edit_find_ok_callback(READ_FORWARD, w, context, info);
+}
+
+
+static void edit_find_previous_callback(Widget w, XtPointer context, XtPointer info)
+{
+ edit_find_ok_callback(READ_BACKWARD, w, context, info);
+}
+
+
+static void find_dialog_close(Widget w, XtPointer context, XtPointer info)
+{
+ clear_find_error();
+}
+
+
+static void edit_find_cancel_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (ss->checking_explicitly)
+ ss->stopped_explicitly = true;
+ else
+ {
+ XtUnmanageChild(edit_find_dialog);
+ clear_find_error();
+ }
+}
+
+
+static void make_edit_find_dialog(bool managed, chan_info *cp)
+{
+ find_channel = cp;
+
+ if (!edit_find_dialog)
+ {
+ Widget dl, rc;
+ Arg args[20];
+ int n;
+ XmString go_away, next;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+
+ go_away = XmStringCreateLocalized((char *)I_GO_AWAY);
+ next = XmStringCreateLocalized((char *)I_NEXT);
+
+ XtSetArg(args[n], XmNokLabelString, next); n++;
+ XtSetArg(args[n], XmNcancelLabelString, go_away); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ edit_find_dialog = XmCreateMessageDialog(MAIN_SHELL(ss), (char *)I_FIND, args, n);
+
+ XmStringFree(go_away);
+ XmStringFree(next);
+
+ XtUnmanageChild(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_SYMBOL_LABEL));
+ XtUnmanageChild(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_MESSAGE_LABEL));
+
+ XtAddCallback(edit_find_dialog, XmNhelpCallback, edit_find_help_callback, NULL);
+ XtAddCallback(edit_find_dialog, XmNcancelCallback, edit_find_cancel_callback, NULL);
+ XtAddCallback(edit_find_dialog, XmNokCallback, edit_find_next_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ previousB = XtCreateManagedWidget(I_PREVIOUS, xmPushButtonGadgetClass, edit_find_dialog, args, n);
+ XtAddCallback(previousB, XmNactivateCallback, edit_find_previous_callback, NULL);
+
+ rc = XtCreateManagedWidget("row", xmFormWidgetClass, edit_find_dialog, NULL, 0);
+
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ dl = XtCreateManagedWidget(I_find, xmLabelWidgetClass, rc, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, dl); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ edit_find_text = make_textfield_widget("text", rc, args, n, ACTIVATABLE, add_completer_func(expression_completer, NULL));
+
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, edit_find_text); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNmarginHeight, 10); n++;
+ edit_find_label = XtCreateManagedWidget(" ", xmLabelWidgetClass, rc, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, edit_find_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNshadowThickness, 2); n++;
+ find_error_frame = XtCreateManagedWidget("find-error-frame", xmFrameWidgetClass, rc, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ find_error_label = XtCreateManagedWidget("", xmLabelWidgetClass, find_error_frame, args, n);
+
+ map_over_children(edit_find_dialog, set_main_color_of_widget);
+ XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ cancelB = XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_CANCEL_BUTTON);
+ set_dialog_widget(FIND_DIALOG, edit_find_dialog);
+
+ XtUnmanageChild(find_error_frame);
+ if (managed) XtManageChild(edit_find_dialog);
+ {
+ Atom wm_delete_window;
+ wm_delete_window = XmInternAtom(MAIN_DISPLAY(ss), (char *)"WM_DELETE_WINDOW", false);
+ XmAddWMProtocolCallback(XtParent(edit_find_dialog), wm_delete_window, find_dialog_close, NULL);
+ }
+ }
+ else
+ {
+ if (managed)
+ {
+ if (!XtIsManaged(edit_find_dialog)) XtManageChild(edit_find_dialog);
+ raise_dialog(edit_find_dialog);
+ }
+ }
+
+ {
+ XmString titlestr;
+ if (cp)
+ titlestr = XmStringCreateLocalized(mus_format("%s in %s channel %d", (char *)I_FIND, cp->sound->short_filename, cp->chan));
+ else titlestr = XmStringCreateLocalized((char *)I_FIND);
+ XtVaSetValues(edit_find_dialog, XmNdialogTitle, titlestr, NULL);
+ XmStringFree(titlestr);
+ }
+}
+
+
+static void edit_find_callback(Widget w, XtPointer context, XtPointer info)
+{
+ make_edit_find_dialog(true, NULL);
+}
+
+
+void find_dialog(chan_info *cp)
+{
+ make_edit_find_dialog(true, cp);
+}
+
+
+bool find_dialog_is_active(void)
+{
+ return((edit_find_dialog) && (XtIsManaged(edit_find_dialog)));
+}
+
+
+void save_find_dialog_state(FILE *fd)
+{
+ if (find_dialog_is_active())
+ {
+ char *text = NULL;
+ text = XmTextGetString(edit_find_text);
+ if ((text) && (*text))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t \"%s\")\n", S_find_dialog, text);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true, \"%s\")\n", to_proc_name(S_find_dialog), text);
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t \"%s\" %s drop\n", text, S_find_dialog);
+#endif
+ XtFree(text);
+ }
+ else
+ {
+#if HAVE_SCHEME
+ if (ss->search_expr)
+ fprintf(fd, "(%s #t \"%s\")\n", S_find_dialog, ss->search_expr);
+ else fprintf(fd, "(%s #t)\n", S_find_dialog);
+#endif
+#if HAVE_RUBY
+ if (ss->search_expr)
+ fprintf(fd, "%s(true, \"%s\")\n", to_proc_name(S_find_dialog), ss->search_expr);
+ else fprintf(fd, "%s(true)\n", to_proc_name(S_find_dialog));
+#endif
+#if HAVE_FORTH
+ if (ss->search_expr)
+ fprintf(fd, "#t \"%s\" %s drop\n", ss->search_expr, S_find_dialog);
+ else fprintf(fd, "#t %s drop\n", S_find_dialog);
+#endif
+ }
+ }
+}
+
+
+static Xen g_find_dialog(Xen managed, Xen text)
+{
+ #define H_find_dialog "(" S_find_dialog " :optional managed text): create and activate the Edit:Find dialog, return the dialog widget. \
+If 'text' is included, it is preloaded into the find dialog text widget."
+
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_find_dialog, "a boolean");
+ Xen_check_type(Xen_is_string_or_unbound(text), text, 2, S_find_dialog, "a string");
+
+ make_edit_find_dialog(Xen_boolean_to_C_bool(managed), NULL);
+ if ((edit_find_text) && (Xen_is_string(text)))
+ XmTextSetString(edit_find_text, (char *)Xen_string_to_C_string(text));
+
+ return(Xen_wrap_widget(edit_find_dialog));
+}
+
+
+static Xen g_find_dialog_widgets(void)
+{
+ if (edit_find_dialog)
+ return(Xen_cons(Xen_wrap_widget(edit_find_dialog),
+ Xen_cons(Xen_wrap_widget(edit_find_text),
+ Xen_cons(Xen_wrap_widget(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_OK_BUTTON)), /* find next */
+ Xen_cons(Xen_wrap_widget(previousB), /* find previous */
+ Xen_cons(Xen_wrap_widget(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_CANCEL_BUTTON)), /* go away */
+ Xen_empty_list))))));
+ return(Xen_empty_list);
+}
+
+
+Xen_wrap_2_optional_args(g_find_dialog_w, g_find_dialog)
+Xen_wrap_no_args(g_find_dialog_widgets_w, g_find_dialog_widgets)
+
+void g_init_gxfind(void)
+{
+ Xen_define_safe_procedure(S_find_dialog, g_find_dialog_w, 0, 2, 0, H_find_dialog);
+ Xen_define_safe_procedure("find-dialog-widgets", g_find_dialog_widgets_w, 0, 0, 0, "internal auto-test function");
+}
+
+
+
+#define NAME_COLUMNS 8
+
+/* ---------------- mix dialog ---------------- */
+
+static Widget mix_dialog = NULL;
+static int mix_dialog_id = INVALID_MIX_ID, old_mix_dialog_id = INVALID_MIX_ID;
+static env *dialog_env = NULL;
+
+static bool dragging = false;
+static int edpos_before_drag;
+static with_hook_t hookable_before_drag;
+static mus_long_t drag_beg = 0, drag_end = 0;
+
+static void start_dragging(int mix_id)
+{
+ chan_info *cp;
+ cp = mix_chan_info_from_id(mix_id);
+ edpos_before_drag = cp->edit_ctr;
+ hookable_before_drag = cp->hookable;
+ cp->hookable = WITHOUT_HOOK;
+ dragging = true;
+ drag_beg = mix_position_from_id(mix_id);
+ drag_end = drag_beg + mix_length_from_id(mix_id);
+ start_dragging_syncd_mixes(mix_id);
+}
+
+
+static void keep_dragging(int mix_id)
+{
+ chan_info *cp;
+ cp = mix_chan_info_from_id(mix_id);
+ cp->edit_ctr = edpos_before_drag;
+ keep_dragging_syncd_mixes(mix_id);
+}
+
+
+static void stop_dragging(int mix_id)
+{
+ chan_info *cp;
+ cp = mix_chan_info_from_id(mix_id);
+ undo_edit(cp, 1);
+ cp->hookable = hookable_before_drag;
+ dragging = false;
+ stop_dragging_syncd_mixes(mix_id);
+}
+
+
+/* -------- speed -------- */
+
+static Widget w_speed_number, w_speed_label, w_speed;
+static speed_style_t xmix_speed_control_style = SPEED_CONTROL_AS_FLOAT;
+
+static int speed_to_scrollbar(mus_float_t minval, mus_float_t val, mus_float_t maxval)
+{
+ if (val <= minval) return(0);
+ if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
+ return(snd_round(0.9 * SCROLLBAR_MAX * ((log(val) - log(minval)) / (log(maxval) - log(minval)))));
+}
+
+
+static mus_float_t set_speed_label(Widget speed_number, int ival)
+{
+ char speed_number_buffer[6];
+ mus_float_t speed;
+ speed = speed_changed(exp((ival * (log(speed_control_max(ss)) - log(speed_control_min(ss))) / (0.9 * SCROLLBAR_MAX)) + log(speed_control_min(ss))),
+ speed_number_buffer,
+ xmix_speed_control_style,
+ speed_control_tones(ss),
+ 6);
+ set_label(speed_number, speed_number_buffer);
+ return(speed);
+}
+
+
+static void mix_speed_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char speed_number_buffer[6];
+ mus_float_t speed;
+
+ if (!(mix_is_active(mix_dialog_id))) return;
+ speed = speed_changed(1.0,
+ speed_number_buffer,
+ xmix_speed_control_style,
+ speed_control_tones(ss),
+ 6);
+
+ drag_beg = mix_position_from_id(mix_dialog_id);
+ drag_end = drag_beg + mix_length_from_id(mix_dialog_id);
+
+ mix_set_speed_edit(mix_dialog_id, speed);
+ syncd_mix_set_speed(mix_dialog_id, speed);
+ after_mix_edit(mix_dialog_id);
+ set_label(w_speed_number, speed_number_buffer);
+ XtVaSetValues(w_speed, XmNvalue, speed_to_scrollbar(speed_control_min(ss), 1.0, speed_control_max(ss)), NULL);
+}
+
+
+static void mix_speed_label_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char speed_number_buffer[6];
+ if (!(mix_is_active(mix_dialog_id))) return;
+ switch (xmix_speed_control_style)
+ {
+ default:
+ case SPEED_CONTROL_AS_FLOAT: xmix_speed_control_style = SPEED_CONTROL_AS_RATIO; break;
+ case SPEED_CONTROL_AS_RATIO: xmix_speed_control_style = SPEED_CONTROL_AS_SEMITONE; break;
+ case SPEED_CONTROL_AS_SEMITONE: xmix_speed_control_style = SPEED_CONTROL_AS_FLOAT; break;
+ }
+ speed_changed(mix_speed_from_id(mix_dialog_id),
+ speed_number_buffer,
+ xmix_speed_control_style,
+ speed_control_tones(ss),
+ 6);
+ set_label(w_speed_number, speed_number_buffer);
+}
+
+
+static void mix_speed_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int ival;
+ mus_float_t speed;
+ mus_long_t beg, end;
+
+ if (!(mix_is_active(mix_dialog_id))) return;
+
+ ival = ((XmScrollBarCallbackStruct *)info)->value;
+ if (!dragging)
+ start_dragging(mix_dialog_id);
+ else keep_dragging(mix_dialog_id);
+
+ speed = set_speed_label(w_speed_number, ival);
+ mix_set_speed_edit(mix_dialog_id, speed);
+
+ beg = mix_position_from_id(mix_dialog_id);
+ end = beg + mix_length_from_id(mix_dialog_id);
+ if (drag_beg > beg) drag_beg = beg;
+ if (drag_end < end) drag_end = end;
+
+ mix_display_during_drag(mix_dialog_id, drag_beg, drag_end);
+ syncd_mix_set_speed(mix_dialog_id, speed);
+}
+
+
+static void mix_speed_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ mus_float_t speed;
+
+ if (!(mix_is_active(mix_dialog_id))) return;
+ if (dragging)
+ stop_dragging(mix_dialog_id);
+
+ speed = set_speed_label(w_speed_number, cb->value);
+ mix_set_speed_edit(mix_dialog_id, speed);
+ syncd_mix_set_speed(mix_dialog_id, speed);
+ after_mix_edit(mix_dialog_id);
+ after_syncd_mix_edit(mix_dialog_id);
+}
+
+
+/* -------- amp -------- */
+
+static Widget w_amp_number, w_amp_label, w_amp;
+
+static mus_float_t scrollbar_to_amp(int val)
+{
+ if (val <= 0)
+ return(amp_control_min(ss));
+ if (val >= (0.9 * SCROLLBAR_MAX))
+ return(amp_control_max(ss));
+ if (val > (0.5 * 0.9 * SCROLLBAR_MAX))
+ return((((val / (0.5 * 0.9 * SCROLLBAR_MAX)) - 1.0) * (amp_control_max(ss) - 1.0)) + 1.0);
+ else return((val * (1.0 - amp_control_min(ss)) / (0.5 * 0.9 * SCROLLBAR_MAX)) + amp_control_min(ss));
+}
+
+
+static int amp_to_scrollbar(Widget amp_number, mus_float_t amp)
+{
+ char sfs[6];
+ snprintf(sfs, 6, "%.2f", amp);
+ set_label(amp_number, sfs);
+ return(amp_to_scroll(amp_control_min(ss), amp, amp_control_max(ss)));
+}
+
+
+static void change_mix_amp(int mix_id, mus_float_t val)
+{
+ char sfs[6];
+ mix_set_amp_edit(mix_id, val);
+ syncd_mix_set_amp(mix_id, val);
+ snprintf(sfs, 6, "%.2f", val);
+ set_label(w_amp_number, sfs);
+}
+
+
+static void mix_amp_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (!(mix_is_active(mix_dialog_id))) return;
+ change_mix_amp(mix_dialog_id, 1.0);
+ after_mix_edit(mix_dialog_id);
+ XtVaSetValues(w_amp, XmNvalue, amp_to_scroll(amp_control_min(ss), 1.0, amp_control_max(ss)), NULL);
+}
+
+
+static void mix_amp_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int ival;
+ if (!(mix_is_active(mix_dialog_id))) return;
+ ival = ((XmScrollBarCallbackStruct *)info)->value;
+ if (!dragging)
+ start_dragging(mix_dialog_id);
+ else keep_dragging(mix_dialog_id);
+ change_mix_amp(mix_dialog_id, scrollbar_to_amp(ival));
+ mix_display_during_drag(mix_dialog_id, drag_beg, drag_end);
+}
+
+
+static void mix_amp_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int ival;
+ if (!(mix_is_active(mix_dialog_id))) return;
+ ival = ((XmScrollBarCallbackStruct *)info)->value;
+ if (dragging)
+ stop_dragging(mix_dialog_id);
+ change_mix_amp(mix_dialog_id, scrollbar_to_amp(ival));
+ after_mix_edit(mix_dialog_id);
+ after_syncd_mix_edit(mix_dialog_id);
+}
+
+
+/* -------- amp-env -------- */
+
+static Widget w_env_frame, w_env;
+static graphics_context *ax = NULL;
+static GC cur_gc;
+static env_editor *spf = NULL;
+static bool with_mix_background_wave = false;
+
+static void show_mix_background_wave(int mix_id)
+{
+ int pts;
+ bool two_sided = false;
+ if (spf == NULL) return;
+ pts = prepare_mix_dialog_waveform(mix_id, spf->axis, &two_sided);
+ if (pts > 0)
+ {
+ XSetForeground(MAIN_DISPLAY(ss), ax->gc, ss->enved_waveform_color);
+ if (two_sided)
+ draw_both_grf_points(1, ax, pts, GRAPH_LINES);
+ else draw_grf_points(1, ax, pts, spf->axis, ungrf_y(spf->axis, 0.0), GRAPH_LINES);
+ XSetForeground(MAIN_DISPLAY(ss), ax->gc, ss->black);
+ }
+}
+
+
+static void mix_amp_env_resize(Widget w, XtPointer context, XtPointer info)
+{
+ env *cur_env;
+ if (!(mix_is_active(mix_dialog_id))) return;
+
+ if (ax == NULL)
+ {
+ XGCValues gv;
+ gv.function = GXcopy;
+ XtVaGetValues(w_env, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
+ cur_gc = XtGetGC(w_env, GCForeground | GCFunction, &gv);
+ ax = (graphics_context *)calloc(1, sizeof(graphics_context));
+ ax->wn = XtWindow(w_env);
+ ax->dp = XtDisplay(w_env);
+ ax->gc = cur_gc;
+ }
+ else clear_window(ax);
+
+ cur_env = dialog_env;
+ spf->with_dots = true;
+ env_editor_display_env(spf, cur_env, ax, "mix env", 0, 0, widget_width(w), widget_height(w), NOT_PRINTING);
+ if (with_mix_background_wave)
+ show_mix_background_wave(mix_dialog_id);
+}
+
+
+#ifdef __APPLE__
+static int press_x, press_y;
+#endif
+
+static void mix_drawer_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XMotionEvent *ev = (XMotionEvent *)event;
+ if (!(mix_is_active(mix_dialog_id))) return;
+#ifdef __APPLE__
+ if ((press_x == ev->x) && (press_y == ev->y)) return;
+#endif
+ env_editor_button_motion(spf, ev->x, ev->y, ev->time, dialog_env);
+ mix_amp_env_resize(w, NULL, NULL);
+}
+
+
+static void mix_drawer_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XButtonEvent *ev = (XButtonEvent *)event;
+ if (!(mix_is_active(mix_dialog_id))) return;
+#ifdef __APPLE__
+ press_x = ev->x;
+ press_y = ev->y;
+#endif
+ if (env_editor_button_press(spf, ev->x, ev->y, ev->time, dialog_env))
+ mix_amp_env_resize(w, NULL, NULL);
+}
+
+
+static void mix_drawer_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ if (!(mix_is_active(mix_dialog_id))) return;
+ env_editor_button_release(spf, dialog_env);
+ mix_amp_env_resize(w, NULL, NULL);
+}
+
+
+static Widget w_id = NULL, w_beg = NULL;
+#if WITH_AUDIO
+ static Widget mix_play = NULL;
+#endif
+static Widget error_frame = NULL, error_label = NULL;
+
+static void clear_mix_error(void)
+{
+ if ((error_frame) && (XtIsManaged(error_frame)))
+ XtUnmanageChild(error_frame);
+}
+
+
+static void unpost_mix_error(XtPointer data, XtIntervalId *id)
+{
+ clear_mix_error();
+}
+
+
+static void errors_to_mix_text(const char *msg, void *data)
+{
+ int lines = 0;
+ XmString label;
+ label = multi_line_label(msg, &lines);
+ XtVaSetValues(error_label,
+ XmNlabelString, label,
+ XmNheight, lines * 20,
+ NULL);
+ XtVaSetValues(error_frame, XmNheight, lines * 20, NULL);
+ XmStringFree(label);
+ XtManageChild(error_frame);
+ /* since the offending text is automatically overwritten, we can't depend on subsequent text modify callbacks
+ * to clear things, so we'll just use a timer
+ */
+ XtAppAddTimeOut(MAIN_APP(ss),
+ 5000,
+ (XtTimerCallbackProc)unpost_mix_error,
+ NULL);
+}
+
+
+static void widget_mix_to_text(Widget w, int id)
+{
+ if (mix_name(id))
+ XmTextFieldSetString(w, (char *)mix_name(id));
+ else widget_int_to_text(w, id);
+}
+
+
+static bool id_changed = false;
+
+static void id_activated(void)
+{
+ char *val;
+ id_changed = false;
+ val = XmTextGetString(w_id);
+ if (val)
+ {
+ int id;
+ /* look for a mix name first, then a number */
+ id = mix_name_to_id(val);
+ if (id < 0)
+ {
+ redirect_errors_to(errors_to_mix_text, NULL);
+ id = string_to_int(val, 0, "id");
+ redirect_errors_to(NULL, NULL);
+ }
+ if (mix_is_active(id))
+ {
+ mix_dialog_id = id;
+ reflect_mix_change(id);
+ }
+ XtFree(val);
+ }
+}
+
+
+static void id_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ id_changed = true;
+}
+
+
+static void id_check_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (id_changed) id_activated();
+}
+
+
+static void beg_activated(void)
+{
+ char *val;
+ if (!(mix_is_active(mix_dialog_id))) return;
+ val = XmTextGetString(w_beg);
+ if (val)
+ {
+ chan_info *cp;
+ char *up_to_colon;
+ mus_float_t beg;
+ cp = mix_chan_info_from_id(mix_dialog_id);
+ up_to_colon = string_to_colon(val);
+ redirect_errors_to(errors_to_mix_text, NULL);
+ beg = string_to_mus_float_t(up_to_colon, 0.0, "begin time");
+ redirect_errors_to(NULL, NULL);
+ if (beg >= 0.0)
+ {
+ mus_long_t pos, old_pos;
+ old_pos = mix_position_from_id(mix_dialog_id);
+ pos = (mus_long_t)(beg * snd_srate(cp->sound));
+ mix_set_position_edit(mix_dialog_id, pos);
+ syncd_mix_change_position(mix_dialog_id, pos - old_pos);
+ }
+ after_mix_edit(mix_dialog_id);
+ free(up_to_colon);
+ XtFree(val);
+ }
+}
+
+
+static void apply_mix_dialog_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (!(mix_is_active(mix_dialog_id))) return;
+ if ((dialog_env) &&
+ (!(is_default_env(dialog_env))))
+ {
+ mix_set_amp_env_edit(mix_dialog_id, dialog_env);
+ syncd_mix_set_amp_env(mix_dialog_id, dialog_env);
+ }
+ else
+ {
+ mix_set_amp_env_edit(mix_dialog_id, NULL);
+ syncd_mix_set_amp_env(mix_dialog_id, NULL);
+ }
+ mix_amp_env_resize(w_env, NULL, NULL);
+ after_mix_edit(mix_dialog_id);
+}
+
+
+static void copy_mix_dialog_callback(Widget w, XtPointer context, XtPointer info)
+{
+ Widget active_widget;
+ active_widget = XmGetFocusWidget(mix_dialog);
+ if (active_widget == XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON))
+ {
+ copy_mix(mix_dialog_id);
+ after_mix_edit(mix_dialog_id);
+ }
+ else
+ {
+ if (active_widget == w_id)
+ id_activated();
+ else
+ {
+ if (active_widget == w_beg)
+ beg_activated();
+ }
+ }
+}
+
+
+static void quit_mix_dialog_callback(Widget w, XtPointer context, XtPointer info)
+{
+ clear_mix_error();
+ XtUnmanageChild(mix_dialog);
+}
+
+
+static void help_mix_dialog_callback(Widget w, XtPointer context, XtPointer info)
+{
+ mix_dialog_help();
+}
+
+
+/* -------- play -------- */
+
+#if WITH_AUDIO
+ static bool mix_playing = false;
+#endif
+
+void reflect_mix_play_stop(void)
+{
+#if WITH_AUDIO
+ if (mix_play)
+ XmChangeColor(mix_play, ss->basic_color);
+ mix_playing = false;
+#endif
+}
+
+
+#if WITH_AUDIO
+static void mix_dialog_play_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (mix_playing)
+ reflect_mix_play_stop();
+ else
+ {
+ if (!(mix_exists(mix_dialog_id))) return;
+ if (mix_play)
+ XmChangeColor(mix_play, ss->selection_color); /* this needs to happen before trying to play */
+ syncd_mix_play(mix_dialog_id);
+ mix_playing = true; /* don't use the return value here */
+ play_mix_from_id(mix_dialog_id);
+ }
+}
+#endif
+
+
+/* -------- dB -------- */
+
+static void mix_dB_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ spf->in_dB = cb->set;
+ mix_amp_env_resize(w_env, NULL, NULL);
+}
+
+
+/* -------- sync -------- */
+
+static void mix_sync_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ if ((cb->set) &&
+ (mix_sync_from_id(mix_dialog_id) == 0))
+ {
+ mix_set_sync_from_id(mix_dialog_id, GET_ORIGINAL_SYNC); /* choose a new sync val or return to previous */
+ /* check for resync */
+ syncd_mix_set_color(mix_dialog_id, ss->red);
+ }
+ else
+ {
+ if ((!(cb->set)) &&
+ (mix_sync_from_id(mix_dialog_id) != 0))
+ {
+ syncd_mix_unset_color(mix_dialog_id); /* unset colors of any syncd mixes */
+ mix_set_sync_from_id(mix_dialog_id, 0);
+ }
+ }
+ for_each_normal_chan(display_channel_mixes);
+}
+
+
+/* -------- clip -------- */
+
+static void mix_clip_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ spf->clipping = cb->set;
+ mix_amp_env_resize(w_env, NULL, NULL);
+}
+
+
+/* -------- wave -------- */
+
+static void mix_wave_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ with_mix_background_wave = cb->set;
+ mix_amp_env_resize(w_env, NULL, NULL);
+}
+
+
+/* -------- next/previous -------- */
+
+static Widget mix_next_button, mix_previous_button;
+
+static void mix_next_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int id;
+ clear_mix_error();
+ id = next_mix_id(mix_dialog_id);
+ if (id != INVALID_MIX_ID)
+ {
+ mix_dialog_id = id;
+ reflect_mix_change(id);
+ if (next_mix_id(id) == INVALID_MIX_ID)
+ set_sensitive(mix_next_button, false);
+ }
+}
+
+
+static void mix_previous_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int id;
+ clear_mix_error();
+ id = previous_mix_id(mix_dialog_id);
+ if (id != INVALID_MIX_ID)
+ {
+ mix_dialog_id = id;
+ reflect_mix_change(id);
+ if (previous_mix_id(id) == INVALID_MIX_ID)
+ set_sensitive(mix_previous_button, false);
+ }
+}
+
+
+static Pixmap make_pixmap(unsigned char *bits, int width, int height, int depth, GC gc)
+{
+ Pixmap rb, nr;
+ rb = XCreateBitmapFromData(MAIN_DISPLAY(ss),
+ RootWindowOfScreen(XtScreen(MAIN_PANE(ss))),
+ (const char *)bits,
+ width, height);
+ nr = XCreatePixmap(MAIN_DISPLAY(ss),
+ RootWindowOfScreen(XtScreen(MAIN_PANE(ss))),
+ width, height, depth);
+ XCopyPlane(MAIN_DISPLAY(ss), rb, nr, gc, 0, 0, width, height, 0, 0, 1);
+ XFreePixmap(MAIN_DISPLAY(ss), rb);
+ return(nr);
+}
+
+
+
+#define p_speaker_width 12
+#define p_speaker_height 12
+static unsigned char p_speaker_bits[] = {
+ 0x00, 0x07, 0xc0, 0x04, 0x30, 0x04, 0x0e, 0x04, 0x06, 0x04, 0x06, 0x04,
+ 0x06, 0x04, 0x06, 0x04, 0x0e, 0x04, 0x30, 0x04, 0xc0, 0x04, 0x00, 0x07};
+
+static int mixer_depth;
+static GC gc;
+static Pixmap speaker_r;
+
+void make_mixer_icons_transparent_again(Pixel old_color, Pixel new_color)
+{
+ if (mix_dialog)
+ {
+ XFreePixmap(XtDisplay(mix_dialog), speaker_r);
+ XSetBackground(XtDisplay(mix_dialog), gc, new_color);
+ speaker_r = make_pixmap(p_speaker_bits, p_speaker_width, p_speaker_height, mixer_depth, gc);
+#if WITH_AUDIO
+ XtVaSetValues(mix_play, XmNlabelPixmap, speaker_r, NULL);
+#endif
+ }
+}
+
+static Widget w_sync;
+
+Widget make_mix_dialog(void)
+{
+ if (mix_dialog == NULL)
+ {
+ Widget mainform, mix_row, mix_frame, sep, w_sep1;
+ Widget w_dB_frame, w_dB, w_clip, w_wave, w_dB_row, env_button, copy_button;
+ XmString xgo_away, xhelp, xtitle, s1, xcopy;
+ int n;
+ Arg args[20];
+ XtCallbackList n1, n2;
+ XGCValues v;
+ char amplab[LABEL_BUFFER_SIZE];
+
+ xmix_speed_control_style = speed_control_style(ss);
+
+ mix_dialog_id = any_mix_id();
+ xgo_away = XmStringCreateLocalized((char *)I_GO_AWAY);
+ xcopy = XmStringCreateLocalized((char *)"Copy mix");
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ xtitle = XmStringCreateLocalized((char *)"Mixes");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNokLabelString, xcopy); n++;
+ XtSetArg(args[n], XmNcancelLabelString, xgo_away); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNdialogTitle, xtitle); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ mix_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Mixes", args, n);
+ copy_button = XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON);
+
+ /* XtAddCallback(mix_dialog, XmNokCallback, copy_mix_dialog_callback, NULL); */
+ XtAddCallback(copy_button, XmNactivateCallback, copy_mix_dialog_callback, NULL);
+ XtAddCallback(mix_dialog, XmNcancelCallback, quit_mix_dialog_callback, NULL);
+ XtAddCallback(mix_dialog, XmNhelpCallback, help_mix_dialog_callback, NULL);
+
+ XmStringFree(xhelp);
+ XmStringFree(xcopy);
+ XmStringFree(xgo_away);
+ XmStringFree(xtitle);
+
+ XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ env_button = XtCreateManagedWidget("Apply env", xmPushButtonGadgetClass, mix_dialog, args, n);
+ XtAddCallback(env_button, XmNactivateCallback, apply_mix_dialog_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(mix_dialog, XmDIALOG_SEPARATOR)); n++;
+ mainform = XtCreateManagedWidget("formd", xmFormWidgetClass, mix_dialog, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNshadowThickness, 2); n++;
+ mix_frame = XtCreateManagedWidget("mix-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ mix_row = XtCreateManagedWidget("mix-dialog-row", xmRowColumnWidgetClass, mix_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtCreateManagedWidget("mix:", xmLabelWidgetClass, mix_row, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNresizeWidth, false); n++;
+ XtSetArg(args[n], XmNcolumns, NAME_COLUMNS); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ w_id = make_textfield_widget("mix-id", mix_row, args, n, ACTIVATABLE, NO_COMPLETER);
+ XtAddCallback(w_id, XmNlosingFocusCallback, id_check_callback, NULL);
+ XtAddCallback(w_id, XmNmodifyVerifyCallback, id_modify_callback, NULL);
+ XmTextSetString(w_id, (char *)"0");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ w_beg = make_textfield_widget("mix-times", mix_row, args, n, ACTIVATABLE, NO_COMPLETER);
+ XmTextSetString(w_beg, (char *)"0.000 : 1.000");
+
+ XtVaGetValues(mix_row, XmNforeground, &v.foreground, XmNbackground, &v.background, XmNdepth, &mixer_depth, NULL);
+ gc = XtGetGC(mix_row, GCForeground | GCBackground, &v);
+ speaker_r = make_pixmap(p_speaker_bits, p_speaker_width, p_speaker_height, mixer_depth, gc);
+
+#if WITH_AUDIO
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
+ XtSetArg(args[n], XmNlabelPixmap, speaker_r); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ mix_play = XtCreateManagedWidget("mix-play", xmPushButtonWidgetClass, mix_row, args, n);
+ XtAddCallback(mix_play, XmNactivateCallback, mix_dialog_play_callback, NULL);
+#endif
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ mix_previous_button = XtCreateManagedWidget(I_PREVIOUS, xmPushButtonWidgetClass, mix_row, args, n);
+ if (previous_mix_id(mix_dialog_id) == INVALID_MIX_ID)
+ set_sensitive(mix_previous_button, false);
+ XtAddCallback(mix_previous_button, XmNactivateCallback, mix_previous_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ mix_next_button = XtCreateManagedWidget(I_NEXT, xmPushButtonWidgetClass, mix_row, args, n);
+ if (next_mix_id(mix_dialog_id) == INVALID_MIX_ID)
+ set_sensitive(mix_next_button, false);
+ XtAddCallback(mix_next_button, XmNactivateCallback, mix_next_callback, NULL);
+
+
+
+ /* separator before sliders */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, mix_row); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, 10); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep = XtCreateManagedWidget("mix-dialog-sep", xmSeparatorWidgetClass, mainform, args, n);
+
+ /* SPEED */
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"speed:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ w_speed_label = make_pushbutton_widget("mix-speed-label", mainform, args, n);
+ XtAddCallback(w_speed_label, XmNactivateCallback, mix_speed_click_callback, NULL);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = initial_speed_label(xmix_speed_control_style);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, w_speed_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, w_speed_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ w_speed_number = make_pushbutton_widget("mix-speed-number", mainform, args, n);
+ XtAddCallback(w_speed_number, XmNactivateCallback, mix_speed_label_click_callback, NULL);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, w_speed_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, w_speed_number); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, speed_to_scrollbar(speed_control_min(ss), 1.0, speed_control_max(ss))); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(mix_speed_drag_callback, NULL)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(mix_speed_valuechanged_callback, NULL)); n++;
+ w_speed = XtCreateManagedWidget("mix-speed", xmScrollBarWidgetClass, mainform, args, n);
+
+ free(n1);
+ free(n2);
+
+ n = 0;
+ snprintf(amplab, LABEL_BUFFER_SIZE, "%s", "amp:");
+ s1 = XmStringCreateLocalized(amplab);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, w_speed_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ w_amp_label = make_pushbutton_widget("mix-amp-label", mainform, args, n);
+ XtAddCallback(w_amp_label, XmNactivateCallback, mix_amp_click_callback, NULL);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"1.00");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, w_speed_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, w_amp_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ w_amp_number = XtCreateManagedWidget("mix-amp-number", xmLabelWidgetClass, mainform, args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, w_amp_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, w_amp_number); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, 0); n++;
+ XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(mix_amp_drag_callback, NULL)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(mix_amp_valuechanged_callback, NULL)); n++;
+ w_amp = XtCreateManagedWidget("mix-amp", xmScrollBarWidgetClass, mainform, args, n);
+ free(n1);
+ free(n2);
+
+ /* separator before envelopes */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, w_amp_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, 8); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ w_sep1 = XtCreateManagedWidget("mix-dialog-sep1", xmSeparatorWidgetClass, mainform, args, n);
+
+ /* button box for dB clip wave sync */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, w_sep1); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNshadowThickness, 4); n++;
+ w_dB_frame = XtCreateManagedWidget("mix-dB-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ w_dB_row = XtCreateManagedWidget("mix-dB-row", xmRowColumnWidgetClass, w_dB_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+
+ w_clip = make_togglebutton_widget("clip", w_dB_row, args, n);
+ XtAddCallback(w_clip, XmNvalueChangedCallback, mix_clip_callback, NULL);
+ XmToggleButtonSetState(w_clip, true, false);
+
+ w_wave = make_togglebutton_widget("wave", w_dB_row, args, n);
+ XtAddCallback(w_wave, XmNvalueChangedCallback, mix_wave_callback, NULL);
+
+ w_dB = make_togglebutton_widget("dB", w_dB_row, args, n);
+ XtAddCallback(w_dB, XmNvalueChangedCallback, mix_dB_callback, NULL);
+
+ if (mix_sync_from_id(mix_dialog_id) != 0)
+ {XtSetArg(args[n], XmNset, true); n++;}
+ w_sync = make_togglebutton_widget("sync", w_dB_row, args, n);
+ XtAddCallback(w_sync, XmNvalueChangedCallback, mix_sync_callback, NULL);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNshadowThickness, 2); n++;
+ error_frame = XtCreateManagedWidget("error-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ error_label = XtCreateManagedWidget("", xmLabelWidgetClass, error_frame, args, n);
+
+
+ /* amp env */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, w_sep1); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 4); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, w_dB_frame); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNshadowThickness, 4); n++;
+ w_env_frame = XtCreateManagedWidget("mix-amp-env-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ w_env = XtCreateManagedWidget("mix-amp-env-window", xmDrawingAreaWidgetClass, w_env_frame, args, n);
+
+ XtManageChild(mix_dialog);
+
+ XtAddCallback(w_env, XmNresizeCallback, mix_amp_env_resize, NULL);
+ XtAddCallback(w_env, XmNexposeCallback, mix_amp_env_resize, NULL);
+
+ spf = new_env_editor();
+
+ XtAddEventHandler(w_env, ButtonPressMask, false, mix_drawer_button_press, NULL);
+ XtAddEventHandler(w_env, ButtonMotionMask, false, mix_drawer_button_motion, NULL);
+ XtAddEventHandler(w_env, ButtonReleaseMask, false, mix_drawer_button_release, NULL);
+
+ set_dialog_widget(MIX_DIALOG, mix_dialog);
+
+ XtUnmanageChild(error_frame);
+ }
+ else
+ {
+ if (!(XtIsManaged(mix_dialog))) XtManageChild(mix_dialog);
+ raise_dialog(mix_dialog);
+ }
+ reflect_mix_change(mix_dialog_id);
+ return(mix_dialog);
+}
+
+
+void reflect_mix_change(int mix_id)
+{
+ if ((mix_dialog) &&
+ (XtIsManaged(mix_dialog)))
+ {
+ if (mix_id != ANY_MIX_ID)
+ mix_dialog_id = mix_id;
+
+ if (!(mix_exists(mix_dialog_id)))
+ {
+ mix_dialog_id = any_mix_id();
+ mix_id = mix_dialog_id;
+ }
+
+ if ((mix_id == mix_dialog_id) || (mix_id == ANY_MIX_ID))
+ {
+ mus_float_t val;
+ set_sensitive(mix_next_button, (next_mix_id(mix_dialog_id) != INVALID_MIX_ID));
+ set_sensitive(mix_previous_button, (previous_mix_id(mix_dialog_id) != INVALID_MIX_ID));
+
+ /* now reflect current mix state in mix dialog controls */
+ if (mix_exists(mix_dialog_id))
+ {
+ chan_info *cp = NULL;
+ mus_long_t beg, len;
+ char lab[LABEL_BUFFER_SIZE];
+
+ /* syncd mixes have the same color (red) reverting to old color when sync changes */
+ cp = mix_chan_info_from_id(mix_dialog_id);
+ if (old_mix_dialog_id != INVALID_MIX_ID)
+ {
+ mix_unset_color_from_id(old_mix_dialog_id);
+ syncd_mix_unset_color(old_mix_dialog_id);
+ }
+ old_mix_dialog_id = mix_dialog_id;
+ mix_set_color_from_id(mix_dialog_id, ss->red);
+ syncd_mix_set_color(mix_dialog_id, ss->red);
+
+ for_each_normal_chan(display_channel_mixes);
+
+ if (!dragging)
+ {
+ val = mix_speed_from_id(mix_dialog_id);
+ XtVaSetValues(w_speed, XmNvalue, speed_to_scrollbar(speed_control_min(ss), val, speed_control_max(ss)), NULL);
+ speed_changed(val, lab, xmix_speed_control_style, speed_control_tones(ss), 6);
+ set_label(w_speed_number, lab);
+ }
+ widget_mix_to_text(w_id, mix_dialog_id);
+
+ beg = mix_position_from_id(mix_dialog_id);
+ len = mix_length_from_id(mix_dialog_id);
+ snprintf(lab, LABEL_BUFFER_SIZE, "%.3f : %.3f%s",
+ (float)((double)beg / (float)snd_srate(cp->sound)),
+ (float)((double)(beg + len) / (float)snd_srate(cp->sound)),
+ (mix_is_active(mix_dialog_id)) ? "" : " (locked)");
+ XmTextSetString(w_beg, lab);
+
+ set_sensitive(XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON), true);
+ }
+ else
+ {
+ XmTextSetString(w_id, (char *)"-1");
+ XmTextSetString(w_beg, (char *)"no active mixes");
+ set_sensitive(XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON), false);
+ }
+ if (!dragging)
+ {
+ if (mix_is_active(mix_dialog_id))
+ val = mix_amp_from_id(mix_dialog_id);
+ else val = 1.0;
+ XtVaSetValues(w_amp, XmNvalue, amp_to_scrollbar(w_amp_number, val), NULL);
+ }
+
+ if (mix_amp_env_from_id(mix_dialog_id))
+ {
+ if (dialog_env) free_env(dialog_env);
+ dialog_env = copy_env(mix_amp_env_from_id(mix_dialog_id));
+ }
+ /* copy here else we're editing it directly afterwards (and we free old in mix_set_amp_env_edit) */
+ if (!dialog_env)
+ dialog_env = default_env(1.0, 1.0);
+ mix_amp_env_resize(w_env, NULL, NULL);
+
+ set_toggle_button(w_sync, (mix_sync_from_id(mix_dialog_id) != 0), false, NULL);
+ }
+ }
+}
+
+
+int mix_dialog_mix(void)
+{
+ return(mix_dialog_id);
+}
+
+
+void mix_dialog_set_mix(int id)
+{
+ mix_dialog_id = id;
+ reflect_mix_change(mix_dialog_id);
+}
+
+
+
+/* envelope editor and viewer */
+
+
+static Widget enved_dialog = NULL;
+static Widget apply_button, apply2_button, cancel_button, drawer, show_button, save_button, revert_button, undo_button, redo_button;
+static Widget brkptL, graph_button, flt_button, amp_button, src_button, clip_button;
+static Widget nameL, textL, screnvlst, dB_button, orderL, reset_button, fir_button = NULL;
+static Widget baseScale, baseValue, selection_button;
+static GC gc1, rgc, ggc;
+
+static const char *env_names[3] = {"amp env:", "flt env:", "src env:"};
+
+static bool showing_all_envs = false; /* edit one env (0), or view all currently defined envs (1) */
+static bool apply_to_selection = false, we_turned_selection_off = false;
+
+static int env_window_width = 0;
+static int env_window_height = 0;
+
+static chan_info *active_channel = NULL, *last_active_channel = NULL;
+
+static env* selected_env = NULL; /* if during view, one env is clicked, it is "selected" and can be pasted elsewhere */
+static env* active_env = NULL; /* env currently being edited */
+
+static axis_info *axis = NULL;
+static axis_info *gray_ap = NULL;
+static bool is_FIR = true;
+static bool old_clipping = false;
+static bool ignore_button_release = false;
+static bool cancelling = true;
+
+
+static void fixup_graphics_context(graphics_context *ax, Widget w, GC gc)
+{
+ ax->dp = XtDisplay(w);
+ ax->wn = XtWindow(w);
+ if (gc) ax->gc = gc;
+}
+
+
+axis_info *enved_make_axis(const char *name, graphics_context *ax,
+ int ex0, int ey0, int width, int height,
+ mus_float_t xmin, mus_float_t xmax, mus_float_t ymin, mus_float_t ymax,
+ printing_t printing)
+{
+ /* conjure up minimal context for axis drawer in snd-axis.c */
+ if (!axis)
+ {
+ axis = (axis_info *)calloc(1, sizeof(axis_info));
+ axis->ax = (graphics_context *)calloc(1, sizeof(graphics_context));
+ fixup_graphics_context(axis->ax, drawer, ax->gc);
+ }
+ if (!gray_ap)
+ {
+ gray_ap = (axis_info *)calloc(1, sizeof(axis_info));
+ gray_ap->ax = (graphics_context *)calloc(1, sizeof(graphics_context));
+ gray_ap->graph_active = true;
+ fixup_graphics_context(gray_ap->ax, drawer, ggc);
+ }
+ init_env_axes(axis, name, ex0, ey0, width, height, xmin, xmax, ymin, ymax, printing);
+ return(axis);
+}
+
+
+static void display_env(env *e, const char *name, GC cur_gc, int x0, int y0, int width, int height, bool dots, printing_t printing)
+{
+ graphics_context *ax = NULL;
+ ax = (graphics_context *)calloc(1, sizeof(graphics_context));
+ ax->wn = XtWindow(drawer);
+ if (!(ax->wn)) {free(ax); return;}
+ ax->dp = XtDisplay(drawer);
+ ax->gc = cur_gc;
+ ss->enved->with_dots = dots;
+ env_editor_display_env(ss->enved, e, ax, name, x0, y0, width, height, printing);
+ free(ax);
+}
+
+
+void display_enved_env_with_selection(env *e, const char *name, int x0, int y0, int width, int height, bool dots, printing_t printing)
+{
+ display_env(e, name, (selected_env == e) ? rgc : gc1, x0, y0, width, height, dots, printing);
+}
+
+
+static void reflect_segment_state(void)
+{
+ if ((enved_dialog) &&
+ (active_env) &&
+ (!(showing_all_envs)))
+ env_redisplay();
+}
+
+
+static void prepare_env_edit(env *new_env)
+{
+ prepare_enved_edit(new_env);
+ if (new_env->base == 1.0)
+ set_enved_style(ENVELOPE_LINEAR);
+ else
+ {
+ set_enved_base(new_env->base);
+ set_enved_style(ENVELOPE_EXPONENTIAL);
+ }
+ reflect_segment_state();
+}
+
+
+void set_enved_redo_sensitive(bool val) {set_sensitive(redo_button, val);}
+void set_enved_revert_sensitive(bool val) {set_sensitive(revert_button, val);}
+void set_enved_undo_sensitive(bool val) {set_sensitive(undo_button, val);}
+void set_enved_save_sensitive(bool val) {set_sensitive(save_button, val);}
+void set_enved_show_sensitive(bool val) {set_sensitive(show_button, val);}
+
+
+static bool use_listener_font = false;
+
+void make_scrolled_env_list(void)
+{
+ XmString *strs;
+ int n, size;
+ size = enved_all_envs_top();
+ XtVaSetValues(screnvlst, XmNbackground, ss->highlight_color, NULL);
+ strs = (XmString *)calloc(size, sizeof(XmString));
+ for (n = 0; n < size; n++)
+ strs[n] = XmStringCreate(enved_all_names(n), (char *)((use_listener_font) ? "listener_font" : XmFONTLIST_DEFAULT_TAG));
+ XtVaSetValues(screnvlst,
+ XmNitems, strs,
+ XmNitemCount, size,
+ NULL);
+ for (n = 0; n < size; n++)
+ XmStringFree(strs[n]);
+ free(strs);
+}
+
+
+void enved_reflect_peak_env_completion(snd_info *sp)
+{
+ if ((enved_dialog) && (active_channel) && (enved_with_wave(ss)))
+ if (active_channel->sound == sp)
+ env_redisplay();
+}
+
+
+void new_active_channel_alert(void)
+{
+ if (enved_dialog)
+ {
+ /* if showing current active channel in gray, update */
+ active_channel = current_channel();
+ env_redisplay();
+ }
+}
+
+
+static void dismiss_enved_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (!cancelling)
+ {
+ if (ss->checking_explicitly)
+ ss->stopped_explicitly = true;
+ }
+ else XtUnmanageChild(enved_dialog);
+}
+
+
+static void help_enved_callback(Widget w, XtPointer context, XtPointer info)
+{
+ envelope_editor_dialog_help();
+}
+
+
+static bool within_selection_src = false;
+
+static void apply_enved(void)
+{
+ if (active_env)
+ {
+ active_channel = current_channel();
+ if (active_channel)
+ {
+ int i, j;
+ char *origin = NULL, *estr = NULL;
+ env *max_env = NULL;
+
+ set_sensitive(apply_button, false);
+ set_sensitive(apply2_button, false);
+ set_button_label(cancel_button, I_STOP);
+ cancelling = false;
+ check_for_event();
+
+ switch (enved_target(ss))
+ {
+ case ENVED_AMPLITUDE:
+#if HAVE_FORTH
+ origin = mus_format("%s%s %s drop",
+ estr = env_to_string(active_env),
+ (apply_to_selection) ? "" : " 0 " PROC_FALSE,
+ (apply_to_selection) ? S_env_selection : S_env_channel);
+#else
+ origin = mus_format("%s" PROC_OPEN "%s%s",
+ to_proc_name((apply_to_selection) ? S_env_selection : S_env_channel),
+ estr = env_to_string(active_env),
+ (apply_to_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
+#endif
+ apply_env(active_channel, active_env, 0,
+ current_samples(active_channel),
+ apply_to_selection,
+ origin, NULL,
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
+ /* calls update_graph, I think, but in short files that doesn't update the amp-env */
+ if (estr) free(estr);
+ if (origin) free(origin);
+ break;
+ case ENVED_SPECTRUM:
+#if HAVE_FORTH
+ origin = mus_format("%s %d%s %s drop",
+ estr = env_to_string(active_env),
+ enved_filter_order(ss),
+ (apply_to_selection) ? "" : " 0 " PROC_FALSE,
+ (apply_to_selection) ? S_filter_selection : S_filter_channel);
+#else
+ origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d%s",
+ to_proc_name((apply_to_selection) ? S_filter_selection : S_filter_channel),
+ estr = env_to_string(active_env),
+ enved_filter_order(ss),
+ (apply_to_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
+#endif
+ apply_filter(active_channel,
+ (is_FIR) ? enved_filter_order(ss) : 0,
+ active_env,
+ origin, NULL, apply_to_selection,
+ NULL, NULL,
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0, false);
+ if (estr) free(estr);
+ if (origin) free(origin);
+ break;
+ case ENVED_SRATE:
+ /* mus_src no longer protects against 0 srate */
+ max_env = copy_env(active_env);
+ for (i = 0, j = 1; i < max_env->pts; i++, j += 2)
+ if (max_env->data[j] < .01)
+ max_env->data[j] = .01;
+ within_selection_src = true;
+ src_env_or_num(active_channel, max_env, 0.0,
+ false, "Enved: src",
+ apply_to_selection, NULL,
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
+ within_selection_src = false;
+ max_env = free_env(max_env);
+ break;
+ }
+ if (enved_with_wave(ss)) env_redisplay();
+ set_sensitive(apply_button, true);
+ set_sensitive(apply2_button, true);
+ set_button_label(cancel_button, I_GO_AWAY);
+ cancelling = true;
+ }
+ }
+}
+
+
+static void env_redisplay_1(printing_t printing)
+{
+ if (enved_dialog_is_active())
+ {
+ XClearWindow(XtDisplay(drawer), XtWindow(drawer));
+ if (showing_all_envs)
+ view_envs(env_window_width, env_window_height, printing);
+ else
+ {
+ char *name = NULL;
+ name = XmTextGetString(textL);
+ if (!name) name = mus_strdup("noname");
+ /* active_env can be null here if just showing axes (empty initial graph) */
+
+ if ((enved_with_wave(ss)) &&
+ (active_channel) &&
+ (!(active_channel->squelch_update)))
+ {
+ if ((enved_target(ss) == ENVED_SPECTRUM) && (active_env) && (is_FIR) && (printing == NOT_PRINTING))
+ display_frequency_response(active_env, axis, gray_ap->ax, enved_filter_order(ss), enved_in_dB(ss));
+ enved_show_background_waveform(axis, gray_ap, apply_to_selection, (enved_target(ss) == ENVED_SPECTRUM), printing);
+ }
+
+ display_env(active_env, name, gc1, 0, 0, env_window_width, env_window_height, true, printing);
+ if (name) XtFree(name);
+ }
+ }
+}
+
+
+void env_redisplay(void)
+{
+ env_redisplay_1(NOT_PRINTING);
+}
+
+void env_redisplay_with_print(void)
+{
+ env_redisplay_1(PRINTING);
+}
+
+
+void update_enved_background_waveform(chan_info *cp)
+{
+ if ((enved_dialog_is_active()) &&
+ (enved_with_wave(ss)) &&
+ (enved_target(ss) == ENVED_AMPLITUDE) &&
+ (cp == active_channel) &&
+ ((!apply_to_selection) || (selection_is_active_in_channel(cp))))
+ env_redisplay();
+}
+
+
+static void enved_reset(void)
+{
+ set_enved_clipping(DEFAULT_ENVED_CLIPPING);
+ set_enved_style(ENVELOPE_LINEAR);
+ set_enved_power(DEFAULT_ENVED_POWER);
+ set_enved_base(DEFAULT_ENVED_BASE);
+ set_enved_target(DEFAULT_ENVED_TARGET);
+ set_enved_with_wave(DEFAULT_ENVED_WITH_WAVE);
+ set_enved_in_dB(DEFAULT_ENVED_IN_DB);
+ XmTextSetString(textL, NULL);
+ set_enved_filter_order(DEFAULT_ENVED_FILTER_ORDER);
+ if (active_env) active_env = free_env(active_env);
+#if HAVE_SCHEME
+ active_env = string_to_env("'(0 0 1 0)");
+#endif
+#if HAVE_FORTH
+ active_env = string_to_env("'( 0 0 1 0 )");
+#endif
+#if HAVE_RUBY
+ active_env = string_to_env("[0, 0, 1, 0]");
+#endif
+ set_enved_env_list_top(0);
+ prepare_env_edit(active_env);
+ set_sensitive(save_button, true);
+ reflect_enved_style();
+ env_redisplay();
+}
+
+
+static void clear_point_label(void);
+
+static void clear_xenv_error(void)
+{
+ if (brkptL)
+ clear_point_label();
+}
+
+
+static void unpost_xenv_error(XtPointer data, XtIntervalId *id)
+{
+ clear_xenv_error();
+}
+
+
+static void errors_to_xenv_text(const char *msg, void *data)
+{
+ set_button_label(brkptL, msg);
+ XtAppAddTimeOut(MAIN_APP(ss),
+ 5000,
+ (XtTimerCallbackProc)unpost_xenv_error,
+ NULL);
+}
+
+
+static void order_field_activated(void)
+{
+ /* return in order text field */
+ char *str = NULL;
+ str = XmTextGetString(orderL);
+ if ((str) && (*str))
+ {
+ int order;
+ redirect_errors_to(errors_to_xenv_text, NULL);
+ order = string_to_int(str, 1, "order");
+ redirect_errors_to(NULL, NULL);
+ if (order & 1) order++;
+ if ((order > 0) &&
+ (order < 2000))
+ set_enved_filter_order(order);
+ else widget_int_to_text(orderL, enved_filter_order(ss));
+ }
+ if (str) XtFree(str);
+}
+
+
+static void text_field_activated(void)
+{ /* might be breakpoints to load or an envelope name (<cr> in enved text field) */
+ char *name = NULL;
+ name = XmTextGetString(textL);
+ if ((name) && (*name))
+ {
+ char *str;
+ env *e = NULL;
+ str = name;
+ while (isspace((int)(*str))) str++;
+ e = name_to_env(str);
+ if (!e)
+ {
+ if (isalpha((int)(str[0])))
+ {
+ alert_envelope_editor(str, copy_env(active_env));
+ add_or_edit_symbol(str, active_env);
+ set_sensitive(save_button, false);
+ env_redisplay(); /* updates label */
+ /* e is null here */
+ }
+ else
+ {
+ redirect_errors_to(errors_to_xenv_text, NULL);
+ e = string_to_env(str);
+ redirect_errors_to(NULL, NULL);
+ }
+ }
+ if (e)
+ {
+ if (active_env)
+ {
+ #define ENVED_TEMP_NAME "enved-backup"
+ /* save current under a temp name! -- user might have mistakenly reused a name */
+ alert_envelope_editor((char *)ENVED_TEMP_NAME, copy_env(active_env));
+ add_or_edit_symbol(ENVED_TEMP_NAME, active_env);
+ active_env = free_env(active_env);
+ }
+ active_env = copy_env(e);
+ set_enved_env_list_top(0);
+ prepare_env_edit(active_env);
+ set_sensitive(save_button, true);
+ set_sensitive(undo_button, false);
+ set_sensitive(revert_button, false);
+ env_redisplay();
+ e = free_env(e);
+ }
+ }
+ if (name) XtFree(name);
+}
+
+static void enved_text_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ text_field_activated();
+}
+
+
+static void order_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ order_field_activated();
+}
+
+
+static void save_button_pressed(Widget w, XtPointer context, XtPointer info)
+{
+ char *name = NULL;
+ if (active_env == NULL) return;
+ name = XmTextGetString(textL);
+ if ((!name) || (!(*name)))
+ name = mus_strdup("unnamed");
+ alert_envelope_editor(name, copy_env(active_env));
+ add_or_edit_symbol(name, active_env);
+ set_sensitive(save_button, false);
+ env_redisplay();
+ if (name) XtFree(name);
+}
+
+
+static void apply_enved_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* apply current envs to currently sync'd channels */
+ Widget active_widget;
+ active_widget = XmGetFocusWidget(enved_dialog);
+ if (active_widget == XmMessageBoxGetChild(enved_dialog, XmDIALOG_OK_BUTTON))
+ {
+ apply_enved();
+ last_active_channel = active_channel;
+ }
+}
+
+
+static void undo_and_apply_enved_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* undo previous amp env, then apply */
+ /* this blindly undoes the previous edit (assumed to be an envelope) -- if the user made some other change in the meantime, too bad */
+ if ((active_channel) && (active_channel == last_active_channel))
+ {
+ active_channel->squelch_update = true;
+ undo_edit_with_sync(active_channel, 1);
+ active_channel->squelch_update = false;
+ clear_status_area(active_channel->sound);
+ }
+ apply_enved();
+ last_active_channel = active_channel;
+}
+
+
+static void select_or_edit_env(int pos)
+{
+ if (showing_all_envs)
+ {
+ showing_all_envs = false;
+ set_button_label(show_button, "view envs");
+ }
+ if (active_env) active_env = free_env(active_env);
+ selected_env = position_to_env(pos);
+ if (!selected_env) return;
+ active_env = selected_env;
+ XmTextSetString(textL, enved_all_names(pos));
+ set_enved_env_list_top(0);
+ prepare_env_edit(active_env);
+ set_sensitive(undo_button, false);
+ set_sensitive(revert_button, false);
+ set_sensitive(save_button, false);
+ env_redisplay();
+}
+
+
+static void clear_point_label(void)
+{
+ XtVaSetValues(brkptL, XmNlabelType, XmSTRING, XmNlabelString, NULL, NULL);
+}
+
+
+static void enved_display_point_label(mus_float_t x, mus_float_t y)
+{
+ char brkpt_buf[LABEL_BUFFER_SIZE];
+ if ((enved_in_dB(ss)) && (min_dB(ss) < -60))
+ snprintf(brkpt_buf, LABEL_BUFFER_SIZE, "%.3f : %.5f", x, y);
+ else snprintf(brkpt_buf, LABEL_BUFFER_SIZE, "%.3f : %.3f", x, y);
+ set_button_label(brkptL, brkpt_buf);
+}
+
+
+static void drawer_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XMotionEvent *ev = (XMotionEvent *)event;
+ ignore_button_release = false;
+
+ if (!showing_all_envs)
+ {
+ mus_float_t x, y;
+#ifdef __APPLE__
+ if ((ev->x == press_x) && (ev->y == press_y)) return;
+#endif
+ env_editor_button_motion_with_xy(ss->enved, ev->x, ev->y, ev->time, active_env, &x, &y);
+ enved_display_point_label(x, y);
+ env_redisplay();
+ }
+}
+
+
+static void drawer_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XButtonEvent *ev = (XButtonEvent *)event;
+#ifdef __APPLE__
+ press_x = ev->x;
+ press_y = ev->y;
+#endif
+ ss->enved->down_time = ev->time;
+ ss->enved->env_dragged = false;
+ if (showing_all_envs)
+ {
+ int pos;
+ pos = hit_env(ev->x, ev->y, env_window_width, env_window_height);
+ XmListSelectPos(screnvlst, pos + 1, false);
+ if ((pos >= 0) &&
+ (pos < enved_all_envs_top()))
+ {
+ select_or_edit_env(pos);
+ ignore_button_release = true;
+ }
+ }
+ else
+ {
+ if (!active_env)
+ {
+ active_env = default_env(1.0, 0.0);
+ active_env->base = enved_base(ss);
+ env_redisplay(); /* needed to get current_xs set up correctly */
+ }
+ if (env_editor_button_press(ss->enved, ev->x, ev->y, ev->time, active_env))
+ env_redisplay();
+ enved_display_point_label(ungrf_x(ss->enved->axis, ev->x), env_editor_ungrf_y_dB(ss->enved, ev->y));
+ set_sensitive(save_button, true);
+ set_sensitive(undo_button, true);
+ set_sensitive(revert_button, true);
+ }
+}
+
+
+static void drawer_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ if (ignore_button_release)
+ ignore_button_release = false;
+ else
+ {
+ if ((active_env) && (!showing_all_envs))
+ {
+ env_editor_button_release(ss->enved, active_env);
+ env_redisplay();
+ clear_point_label();
+ }
+ }
+}
+
+
+static void drawer_resize(Widget w, XtPointer context, XtPointer info)
+{
+ /* update display, can be either view of all envs or sequence of current envs */
+ env_window_width = widget_width(w);
+ env_window_height = widget_height(w);
+ env_redisplay();
+}
+
+
+static void show_button_pressed(Widget w, XtPointer context, XtPointer info)
+{
+ /* if show all (as opposed to show current), loop through loaded LV_LISTs */
+ showing_all_envs = (!showing_all_envs);
+ set_button_label(show_button, (showing_all_envs) ? "edit env" : "view envs");
+ env_redisplay();
+}
+
+
+static void selection_button_pressed(Widget s, XtPointer context, XtPointer info)
+{
+ we_turned_selection_off = false;
+ apply_to_selection = (!apply_to_selection);
+ XmChangeColor(selection_button, (apply_to_selection) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
+ set_sensitive(apply2_button, true);
+ if ((enved_with_wave(ss)) &&
+ (!showing_all_envs))
+ env_redisplay();
+}
+
+
+static void revert_button_pressed(Widget w, XtPointer context, XtPointer info)
+{
+ revert_env_edit();
+ if (active_env) active_env = free_env(active_env);
+ active_env = enved_next_env();
+ if (active_env == NULL)
+ text_field_activated();
+ env_redisplay();
+}
+
+
+static void undo_button_pressed(Widget w, XtPointer context, XtPointer info)
+{
+ undo_env_edit();
+ if (active_env) active_env = free_env(active_env);
+ active_env = enved_next_env();
+ env_redisplay();
+}
+
+
+static void redo_button_pressed(Widget w, XtPointer context, XtPointer info)
+{
+ redo_env_edit();
+ if (active_env) active_env = free_env(active_env);
+ active_env = enved_next_env();
+ env_redisplay();
+}
+
+
+static void reflect_apply_state(void)
+{
+ set_label(nameL, env_names[enved_target(ss)]);
+ XmChangeColor(amp_button, (enved_target(ss) == ENVED_AMPLITUDE) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
+ XmChangeColor(flt_button, (enved_target(ss) == ENVED_SPECTRUM) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
+ XmChangeColor(src_button, (enved_target(ss) == ENVED_SRATE) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
+ if ((!showing_all_envs) &&
+ (enved_with_wave(ss)))
+ env_redisplay();
+}
+
+
+static void freq_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ in_set_enved_target(ENVED_SPECTRUM);
+ old_clipping = enved_clipping(ss);
+ set_enved_clipping(true);
+ reflect_apply_state();
+}
+
+
+static void amp_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (enved_target(ss) == ENVED_SPECTRUM)
+ set_enved_clipping(old_clipping);
+ in_set_enved_target(ENVED_AMPLITUDE);
+ reflect_apply_state();
+}
+
+
+static void src_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (enved_target(ss) == ENVED_SPECTRUM)
+ set_enved_clipping(old_clipping);
+ in_set_enved_target(ENVED_SRATE);
+ reflect_apply_state();
+}
+
+
+static void reset_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ enved_reset();
+}
+
+
+static void enved_print(char *name)
+{
+ print_enved(name, env_window_height);
+}
+
+
+static void env_browse_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmListCallbackStruct *cb = (XmListCallbackStruct *)info;
+ select_or_edit_env(cb->item_position - 1);
+}
+
+
+static void graph_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ in_set_enved_with_wave(cb->set);
+ env_redisplay();
+}
+
+
+static void dB_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ in_set_enved_in_dB(cb->set);
+ env_redisplay();
+}
+
+
+static void clip_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ in_set_enved_clipping(cb->set);
+}
+
+
+
+#define BASE_MAX 400
+#define BASE_MID 200
+/* these two just set the granularity of the scale widget, not the user-visible bounds */
+
+static void make_base_label(mus_float_t bval)
+{
+ char *sfs, *buf;
+ int i, len, scale_len;
+ len = (int)(enved_power(ss) * 4);
+ if (len < 32) len = 32;
+ sfs = (char *)calloc(len, sizeof(char));
+ snprintf(sfs, len, "%.3f", bval);
+ scale_len = (int)(enved_power(ss) + 3);
+ if (scale_len < 32) scale_len = 32;
+ buf = (char *)calloc(scale_len, sizeof(char));
+ for (i = 0; i < scale_len - 1; i++)
+ buf[i] = sfs[i];
+ set_button_label(baseValue, buf);
+ free(sfs);
+ free(buf);
+ in_set_enved_base(bval);
+ if ((active_env) &&
+ (!(showing_all_envs)))
+ {
+ active_env->base = enved_base(ss);
+ if (active_env->base == 1.0)
+ set_enved_style(ENVELOPE_LINEAR);
+ else set_enved_style(ENVELOPE_EXPONENTIAL);
+ env_redisplay();
+ }
+}
+
+
+static void base_changed(int val)
+{
+ mus_float_t bval;
+ if (val == 0)
+ bval = 0.0;
+ else
+ {
+ if (val == BASE_MID)
+ bval = 1.0;
+ else
+ {
+ if (val > BASE_MID)
+ bval = pow(1.0 + (10.0 * ((mus_float_t)(val - BASE_MID) / (mus_float_t)BASE_MID)), enved_power(ss));
+ else
+ bval = pow(((mus_float_t)val / (mus_float_t)BASE_MID), enved_power(ss) - 1.0);
+ }
+ }
+ make_base_label(bval);
+ if (active_env)
+ set_sensitive(save_button, true); /* what about undo/redo here? */
+}
+
+
+static void reflect_changed_base(mus_float_t val)
+{
+ int ival;
+ if (val <= 0.0)
+ ival = 0;
+ else
+ {
+ if (val == 1.0)
+ ival = BASE_MID;
+ else
+ {
+ if (val <= 1.0)
+ ival = (int)(pow(val, 1.0 / (enved_power(ss) - 1.0)) * BASE_MID);
+ else ival = (int)(BASE_MID + ((BASE_MID * (pow(val, (1.0 / (enved_power(ss)))) - 1)) / 10.0));
+ }
+ }
+ XtVaSetValues(baseScale, XmNvalue, mus_iclamp(0, ival, (int)(BASE_MAX * .9)), NULL);
+ make_base_label(val);
+}
+
+
+static void base_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *sb = (XmScrollBarCallbackStruct *)info;
+ base_changed(sb->value);
+}
+
+
+static int base_last_value = BASE_MID;
+
+static void base_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *sb = (XmScrollBarCallbackStruct *)info;
+ base_last_value = sb->value;
+ base_changed(sb->value);
+}
+
+
+static void base_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ XButtonEvent *ev;
+ int val;
+ ev = (XButtonEvent *)(cb->event);
+ if (ev->state & (snd_ControlMask | snd_MetaMask))
+ val = base_last_value;
+ else val = BASE_MID; /* this is supposedly 1.0 */
+ base_changed(val);
+ XtVaSetValues(baseScale, XmNvalue, val, NULL);
+}
+
+
+static void FIR_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ is_FIR = (!is_FIR);
+ set_label(w, (is_FIR) ? "fir" : "fft");
+ if (enved_with_wave(ss)) env_redisplay();
+}
+
+
+static void reflect_sound_state(void)
+{
+ bool file_on;
+ file_on = (bool)(any_selected_sound());
+ set_sensitive(apply_button, file_on);
+ set_sensitive(apply2_button, file_on);
+}
+
+
+static Xen reflect_file_in_enved(Xen hook_or_reason)
+{
+ if (enved_dialog) reflect_sound_state();
+ return(Xen_false);
+}
+
+
+Xen_wrap_1_arg(reflect_file_in_enved_w, reflect_file_in_enved)
+
+
+Widget create_envelope_editor(void)
+{
+ if (!enved_dialog)
+ {
+ int n;
+ Arg args[32];
+ Widget colE, colD, colB, colF;
+ Widget spacer, spacer1, aform, mainform, screnvname, baseSep, baseLabel;
+ XmString xhelp, xdismiss, xapply, titlestr, s1;
+ XGCValues gv;
+ XtCallbackList n1, n2;
+ char str[LABEL_BUFFER_SIZE];
+
+ /* -------- DIALOG -------- */
+ xdismiss = XmStringCreateLocalized((char *)I_GO_AWAY);
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ titlestr = XmStringCreateLocalized((char *)"Edit Envelope");
+ xapply = XmStringCreateLocalized((char *)"Apply");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNcancelLabelString, xdismiss); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNokLabelString, xapply); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ enved_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"envelope editor", args, n);
+
+ XtAddCallback(enved_dialog, XmNcancelCallback, dismiss_enved_callback, NULL);
+ XtAddCallback(enved_dialog, XmNhelpCallback, help_enved_callback, NULL);
+ XtAddCallback(enved_dialog, XmNokCallback, apply_enved_callback, NULL);
+
+ XmStringFree(xhelp);
+ XmStringFree(xdismiss);
+ XmStringFree(titlestr);
+ XmStringFree(xapply);
+
+ XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ apply2_button = XtCreateManagedWidget("Undo&Apply", xmPushButtonGadgetClass, enved_dialog, args, n);
+ XtAddCallback(apply2_button, XmNactivateCallback, undo_and_apply_enved_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNforeground, ss->black); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ reset_button = XtCreateManagedWidget("Clear graph", xmPushButtonGadgetClass, enved_dialog, args, n);
+ XtAddCallback(reset_button, XmNactivateCallback, reset_button_callback, NULL);
+
+
+ /* -------- MAIN WIDGET -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(enved_dialog, XmDIALOG_SEPARATOR)); n++;
+ mainform = XtCreateManagedWidget("formd", xmFormWidgetClass, enved_dialog, args, n);
+
+ /* the order in which widgets are defined matters a lot here:
+ * we need to build from the bottom up so that the graph portion expands
+ * when the window is resized (if top-down, the slider at the bottom expands!)
+ */
+
+ /* -------- EXP SLIDER AT BOTTOM -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ baseLabel = make_pushbutton_widget("exp:", mainform, args, n);
+ XtAddCallback(baseLabel, XmNactivateCallback, base_click_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ s1 = XmStringCreateLocalized((char *)"1.000");
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, baseLabel); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, baseLabel); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ /* XtSetArg(args[n], XmNrecomputeSize, false); n++; */
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ baseValue = XtCreateManagedWidget("base-label", xmLabelWidgetClass, mainform, args, n);
+ XmStringFree(s1);
+
+ /* -------- filter order -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNcolumns, 3); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNheight, 24); n++;
+ XtSetArg(args[n], XmNresizeWidth, false); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNmarginBottom, 0); n++;
+ snprintf(str, LABEL_BUFFER_SIZE, "%d", enved_filter_order(ss));
+ XtSetArg(args[n], XmNvalue, str); n++;
+ orderL = make_textfield_widget("orderL", mainform, args, n, ACTIVATABLE, NO_COMPLETER);
+ XtAddCallback(orderL, XmNactivateCallback, order_activate_callback, NULL);
+
+ /* -------- fft/fir choice -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, orderL); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ fir_button = make_pushbutton_widget((char *)((is_FIR) ? "fir" : "fft"), mainform, args, n);
+ XtAddCallback(fir_button, XmNactivateCallback, FIR_click_callback, NULL);
+
+ /* -------- exp base scale -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, baseLabel); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, baseValue); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, fir_button); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, BASE_MAX); n++;
+ XtSetArg(args[n], XmNvalue, BASE_MID); n++;
+ XtSetArg(args[n], XmNincrement, 1); n++;
+ XtSetArg(args[n], XmNpageIncrement, 1); n++;
+ XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(base_drag_callback, NULL)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(base_valuechanged_callback, NULL)); n++;
+ baseScale = XtCreateManagedWidget("expscl", xmScrollBarWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, baseScale); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNmargin, LINE_MARGIN); n++;
+ XtSetArg(args[n], XmNheight, LINE_MARGIN); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNheight, 5); n++;
+ baseSep = XtCreateManagedWidget("snd-rec-sep", xmSeparatorWidgetClass, mainform, args, n);
+
+ /* -------- AMP ENV NAME -------- */
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"amp env:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ nameL = XtCreateManagedWidget("nameL", xmLabelWidgetClass, mainform, args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, nameL); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ textL = make_textfield_widget("textL", mainform, args, n, ACTIVATABLE, add_completer_func(env_name_completer, NULL));
+ XtAddCallback(textL, XmNactivateCallback, enved_text_activate_callback, NULL);
+
+
+ /* -------- dB, GRAPH ('wave') AND CLIP BUTTONS -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ dB_button = make_togglebutton_widget("dB", mainform, args, n);
+ XtAddCallback(dB_button, XmNvalueChangedCallback, dB_button_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, dB_button); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ graph_button = make_togglebutton_widget("wave", mainform, args, n);
+ XtAddCallback(graph_button, XmNvalueChangedCallback, graph_button_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, graph_button); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ clip_button = make_togglebutton_widget("clip", mainform, args, n);
+ XtAddCallback(clip_button, XmNvalueChangedCallback, clip_button_callback, NULL);
+
+ /* -------- BREAKPOINT DATA DISPLAY LABEL -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, textL); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, clip_button); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNlabelType, XmSTRING); n++;
+ brkptL = XtCreateManagedWidget(" ", xmLabelWidgetClass, mainform, args, n);
+
+ /* -------- SPACERS TO DIVIDE WINDOW IN TWO -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, textL); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, 4); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ spacer = XtCreateManagedWidget("spacer", xmSeparatorWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, spacer); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_IN); n++;
+ spacer1 = XtCreateManagedWidget("spacer1", xmSeparatorWidgetClass, mainform, args, n);
+ /* second separator needed because marginTop seems to be broken or non-existent for these widgets */
+
+ /* -------- WINDOW LEFT WIDGET HOLDER -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, spacer1); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ aform = XtCreateManagedWidget("aform", xmFormWidgetClass, mainform, args, n);
+
+ /* -------- BUTTON BOX AT TOP LEFT -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNshadowThickness, 4); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ colF = XtCreateManagedWidget("env-button-frame", xmFrameWidgetClass, aform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ colB = XtCreateManagedWidget("env-button-holder", xmFormWidgetClass, colF, args, n);
+
+ /* VIEW ENVS */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ show_button = XtCreateManagedWidget("view envs", xmPushButtonWidgetClass, colB, args, n);
+ XtAddCallback(show_button, XmNactivateCallback, show_button_pressed, NULL);
+
+ /* SAVE PRINT */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, show_button); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ save_button = XtCreateManagedWidget("define it", xmPushButtonWidgetClass, colB, args, n);
+
+ XtAddCallback(save_button, XmNactivateCallback, save_button_pressed, NULL);
+
+ /* REVERT */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, save_button); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ revert_button = XtCreateManagedWidget("revert", xmPushButtonWidgetClass, colB, args, n);
+
+ XtAddCallback(revert_button, XmNactivateCallback, revert_button_pressed, NULL);
+
+
+ /* UNDO REDO */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, revert_button); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 50); n++;
+ undo_button = XtCreateManagedWidget("undo", xmPushButtonWidgetClass, colB, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, undo_button); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, undo_button); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ redo_button = XtCreateManagedWidget("redo", xmPushButtonWidgetClass, colB, args, n);
+
+ XtAddCallback(undo_button, XmNactivateCallback, undo_button_pressed, NULL);
+ XtAddCallback(redo_button, XmNactivateCallback, redo_button_pressed, NULL);
+
+
+ /* AMP FLT SRC */
+ /* enved_function (target) choice (a row of three push buttons that acts like a "radio box") */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->yellow); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, undo_button); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 33); n++;
+ amp_button = XtCreateManagedWidget("amp", xmPushButtonWidgetClass, colB, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->yellow); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, amp_button); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, amp_button); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 67); n++;
+ flt_button = XtCreateManagedWidget("flt", xmPushButtonWidgetClass, colB, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->yellow); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, flt_button); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, flt_button); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ src_button = XtCreateManagedWidget("src", xmPushButtonWidgetClass, colB, args, n);
+
+ XtAddCallback(flt_button, XmNactivateCallback, freq_button_callback, NULL);
+ XtAddCallback(amp_button, XmNactivateCallback, amp_button_callback, NULL);
+ XtAddCallback(src_button, XmNactivateCallback, src_button_callback, NULL);
+
+ /* SELECTION */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, amp_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ selection_button = make_pushbutton_widget("selection", colB, args, n);
+
+ XtAddCallback(selection_button, XmNactivateCallback, selection_button_pressed, NULL);
+
+
+ /* -------- ENV LIST AT LEFT UNDER BUTTONS -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, colF); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNshadowThickness, 4); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ colE = XtCreateManagedWidget("env-list-frame", xmFrameWidgetClass, aform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ colD = XtCreateManagedWidget("env-list-holder", xmFormWidgetClass, colE, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ screnvname = XtCreateManagedWidget("envs:", xmLabelWidgetClass, colD, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, screnvname); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ if (ss->listener_fontlist)
+ {
+ XtSetArg(args[n], XmNfontList, 0); n++;
+ XtSetArg(args[n], XM_FONT_RESOURCE, ss->listener_fontlist); n++;
+ use_listener_font = true;
+ }
+ screnvlst = XmCreateScrolledList(colD, (char *)"scrolled-env-list", args, n);
+ XtManageChild(screnvlst);
+ XtAddCallback(screnvlst, XmNbrowseSelectionCallback, env_browse_callback, NULL);
+ map_over_children(screnvlst, set_main_color_of_widget);
+ if (enved_all_envs_top() > 0) make_scrolled_env_list();
+
+ /* -------- MAIN GRAPH -------- */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->graph_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, spacer1 /* textL */); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, aform); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNheight, 350); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ drawer = XtCreateManagedWidget("drawer", xmDrawingAreaWidgetClass, mainform, args, n);
+
+ gv.function = GXcopy;
+ XtVaGetValues(drawer, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
+ gc1 = XtGetGC(drawer, GCForeground | GCFunction, &gv);
+ gv.foreground = ss->red;
+ rgc = XtGetGC(drawer, GCBackground | GCForeground | GCFunction, &gv);
+ gv.foreground = ss->enved_waveform_color;
+ ggc = XtGetGC(drawer, GCBackground | GCForeground | GCFunction, &gv);
+
+ XtManageChild(enved_dialog); /* needed so that window is valid when resize callback is invoked */
+ apply_button = XmMessageBoxGetChild(enved_dialog, XmDIALOG_OK_BUTTON);
+ cancel_button = XmMessageBoxGetChild(enved_dialog, XmDIALOG_CANCEL_BUTTON);
+ cancelling = true;
+
+ XtAddCallback(drawer, XmNresizeCallback, drawer_resize, NULL);
+ XtAddCallback(drawer, XmNexposeCallback, drawer_resize, NULL);
+
+ XtAddEventHandler(drawer, ButtonPressMask, false, drawer_button_press, NULL);
+ XtAddEventHandler(drawer, ButtonMotionMask, false, drawer_button_motion, NULL);
+ XtAddEventHandler(drawer, ButtonReleaseMask, false, drawer_button_release, NULL);
+
+ if (enved_all_envs_top() == 0)
+ set_sensitive(show_button, false);
+ set_sensitive(revert_button, false);
+ set_sensitive(undo_button, false);
+ set_sensitive(redo_button, false);
+ set_sensitive(save_button, false);
+ if (!(selection_is_active()))
+ set_sensitive(selection_button, false);
+
+ XmToggleButtonSetState(clip_button, (Boolean)(enved_clipping(ss)), false);
+ XmToggleButtonSetState(graph_button, (Boolean)(enved_with_wave(ss)), false);
+ XmToggleButtonSetState(dB_button, (Boolean)(enved_in_dB(ss)), false);
+
+ free(n1);
+ free(n2);
+
+ reflect_apply_state();
+ reflect_segment_state();
+ reflect_sound_state();
+
+ set_dialog_widget(ENVED_DIALOG, enved_dialog);
+
+ Xen_add_to_hook_list(ss->snd_open_file_hook, reflect_file_in_enved_w, "enved-file-open-handler", "enved dialog's file-open-hook handler");
+ }
+ else raise_dialog(enved_dialog);
+ if (!XtIsManaged(enved_dialog))
+ XtManageChild(enved_dialog);
+ active_channel = current_channel();
+ return(enved_dialog);
+}
+
+
+void set_enved_clipping(bool val)
+{
+ in_set_enved_clipping(val);
+ if (enved_dialog)
+ XmToggleButtonSetState(clip_button, (Boolean)val, false);
+}
+
+
+void reflect_enved_style(void)
+{
+ reflect_segment_state();
+}
+
+
+void set_enved_target(enved_target_t val)
+{
+ in_set_enved_target(val);
+ if (enved_dialog)
+ reflect_apply_state();
+}
+
+
+void set_enved_with_wave(bool val)
+{
+ in_set_enved_with_wave(val);
+ if (enved_dialog)
+ XmToggleButtonSetState(graph_button, (Boolean)val, false);
+}
+
+
+void set_enved_in_dB(bool val)
+{
+ in_set_enved_in_dB(val);
+ if (enved_dialog)
+ XmToggleButtonSetState(dB_button, (Boolean)val, false);
+}
+
+
+void set_enved_base(mus_float_t val)
+{
+ in_set_enved_base(val);
+ if (enved_dialog)
+ reflect_changed_base(val);
+}
+
+
+bool enved_dialog_is_active(void)
+{
+ return((enved_dialog) &&
+ (XtIsManaged(enved_dialog)));
+}
+
+
+void set_enved_filter_order(int order)
+{
+ if ((order > 0) && (order < 2000))
+ {
+ if (order & 1)
+ {in_set_enved_filter_order(order + 1);}
+ else {in_set_enved_filter_order(order);}
+ if (enved_dialog)
+ {
+ widget_int_to_text(orderL, enved_filter_order(ss));
+ if ((enved_dialog) &&
+ (enved_target(ss) == ENVED_SPECTRUM) &&
+ (enved_with_wave(ss)) && (!showing_all_envs))
+ env_redisplay();
+ }
+ }
+}
+
+
+void enved_reflect_selection(bool on)
+{
+ if ((enved_dialog) && (!within_selection_src))
+ {
+ set_sensitive(selection_button, on);
+ if ((apply_to_selection) && (!on))
+ {
+ apply_to_selection = false;
+ we_turned_selection_off = true;
+ }
+ if ((on) && (we_turned_selection_off))
+ {
+ apply_to_selection = true;
+ }
+ XmChangeColor(selection_button, (apply_to_selection) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
+ if ((enved_target(ss) != ENVED_SPECTRUM) &&
+ (enved_with_wave(ss)) &&
+ (!showing_all_envs))
+ env_redisplay();
+ }
+}
+
+
+
+void color_enved_waveform(Pixel pix)
+{
+ if (enved_dialog)
+ {
+ XSetForeground(MAIN_DISPLAY(ss), ggc, pix);
+ if ((enved_with_wave(ss)) &&
+ (enved_dialog))
+ env_redisplay();
+ }
+}
+
+
+static Xen g_enved_envelope(void)
+{
+ #define H_enved_envelope "(" S_enved_envelope "): current envelope editor displayed (active) envelope"
+ return(env_to_xen(active_env));
+}
+
+
+static Xen g_set_enved_envelope(Xen e)
+{
+ Xen_check_type(Xen_is_list(e) || Xen_is_string(e) || Xen_is_symbol(e), e, 1, S_set S_enved_envelope, "a list, symbol, or string");
+ if (active_env) active_env = free_env(active_env);
+ if ((Xen_is_string(e)) || (Xen_is_symbol(e)))
+ active_env = name_to_env((Xen_is_string(e)) ? Xen_string_to_C_string(e) : Xen_symbol_to_C_string(e)); /* xen_to_env in name_to_env, so no copy */
+ else active_env = xen_to_env(e);
+ if ((!active_env) && (!(Xen_is_list(e))))
+ Xen_error(NO_SUCH_ENVELOPE,
+ Xen_list_2(C_string_to_Xen_string(S_set S_enved_envelope ": bad envelope arg: ~A"),
+ e));
+ if (enved_dialog)
+ env_redisplay();
+ return(e);
+}
+
+
+static Xen g_enved_filter(void)
+{
+ #define H_enved_filter "(" S_enved_filter "): envelope editor FIR/FFT filter choice (" PROC_TRUE ": FIR)"
+ return(C_bool_to_Xen_boolean(is_FIR));
+}
+
+
+static Xen g_set_enved_filter(Xen type)
+{
+ Xen_check_type(Xen_is_boolean(type), type, 1, S_set S_enved_filter, "boolean");
+ is_FIR = Xen_boolean_to_C_bool(type);
+ if (fir_button)
+ set_label(fir_button, (is_FIR) ? "fir" : "fft");
+ return(type);
+}
+
+
+Xen_wrap_no_args(g_enved_filter_w, g_enved_filter)
+Xen_wrap_1_arg(g_set_enved_filter_w, g_set_enved_filter)
+Xen_wrap_no_args(g_enved_envelope_w, g_enved_envelope)
+Xen_wrap_1_arg(g_set_enved_envelope_w, g_set_enved_envelope)
+
+void g_init_gxenv(void)
+{
+ Xen_define_dilambda(S_enved_filter, g_enved_filter_w, H_enved_filter,
+ S_set S_enved_filter, g_set_enved_filter_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_enved_envelope, g_enved_envelope_w, H_enved_envelope,
+ S_set S_enved_envelope, g_set_enved_envelope_w, 0, 0, 1, 0);
+}
+/* Transform settings dialog */
+
+
+static Widget transform_dialog = NULL; /* main dialog shell */
+static Widget type_list, size_list, wavelet_list, window_list;
+static Widget beta_scale, alpha_scale, start_scale, end_scale, alpha_number, beta_number, start_number, end_number;
+static Widget db_button, peaks_button, logfreq_button, sono_button, spectro_button, normo_button, normalize_button, selection_button1, phases_button;
+static Widget graph_label, graph_drawer;
+static Widget peak_txt, db_txt, freq_base_txt;
+static Widget error_frame1, error_label1;
+
+#define NUM_TRANSFORM_SIZES 15
+static const char *transform_size_names[NUM_TRANSFORM_SIZES] =
+ {"32", "64", "128", "256", "512", "1024", "2048", "4096", "8192", "16384", "65536", "262144", "1048576", "4194304 ", "16777216"};
+static mus_long_t transform_sizes[NUM_TRANSFORM_SIZES] =
+ {32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 65536, 262144, 1048576, 4194304, 16777216};
+
+
+
+/* ---------------- fft window graph ---------------- */
+
+static GC gc2, fgc;
+
+#define GRAPH_SIZE 128
+static mus_float_t graph_data[GRAPH_SIZE]; /* fft window graph in transform options dialog */
+static mus_float_t graph_fftr[GRAPH_SIZE * 2];
+static mus_float_t graph_ffti[GRAPH_SIZE * 2];
+/* I goofed around with making the graph size dependent on the drawer's width, but there's really nothing gained */
+/* also tried linear/db+min-dB distinction, but linear looks dumb and min-dB is a bother */
+
+static mus_float_t fp_dB(mus_float_t py)
+{
+ return((py <= ss->lin_dB) ? 0.0 : (1.0 - (20.0 * log10(py) / min_dB(ss))));
+}
+
+
+static int local_grf_x(double val, axis_info *ap)
+{
+ if (val >= ap->x1) return(ap->x_axis_x1);
+ if (val <= ap->x0) return(ap->x_axis_x0);
+ return((int)(ap->x_base + val * ap->x_scale));
+}
+
+
+static int local_grf_y(mus_float_t val, axis_info *ap)
+{
+ if (val >= ap->y1) return(ap->y_axis_y1);
+ if (val <= ap->y0) return(ap->y_axis_y0);
+ return((int)(ap->y_base + val * ap->y_scale));
+}
+
+
+static axis_info *axis_ap = NULL;
+
+static void graph_redisplay(void)
+{
+ /* fft_window(ss) is the current choice */
+ int ix0, iy0, ix1, iy1, i;
+ mus_float_t xincr, x;
+ graphics_context *ax;
+
+ if (axis_ap == NULL)
+ {
+ axis_ap = (axis_info *)calloc(1, sizeof(axis_info));
+ ax = (graphics_context *)calloc(1, sizeof(graphics_context));
+ axis_ap->ax = ax;
+ ax->dp = XtDisplay(graph_drawer);
+ ax->wn = XtWindow(graph_drawer);
+ }
+ else ax = axis_ap->ax;
+
+ axis_ap->xmin = 0.0;
+ axis_ap->xmax = 1.0;
+ axis_ap->x_ambit = 1.0;
+ axis_ap->x0 = 0.0;
+ axis_ap->x1 = 1.0;
+
+ if (axis_ap->xlabel) free(axis_ap->xlabel);
+ if (fft_beta_max(fft_window(ss)) != 1.0)
+ axis_ap->xlabel = mus_format("(%d, beta: %.2f)", GRAPH_SIZE, fft_beta_max(fft_window(ss)) * fft_window_beta(ss));
+ else axis_ap->xlabel = mus_format("(%d)", GRAPH_SIZE);
+
+ if (fft_window(ss) == MUS_FLAT_TOP_WINDOW)
+ {
+ axis_ap->ymin = -0.1;
+ axis_ap->ymax = 1.0;
+ axis_ap->y_ambit = 1.1;
+ axis_ap->y0 = -0.1;
+ axis_ap->y1 = 1.0;
+ }
+ else
+ {
+ axis_ap->ymin = 0.0;
+ axis_ap->ymax = 1.0;
+ axis_ap->y_ambit = 1.0;
+ axis_ap->y0 = 0.0;
+ axis_ap->y1 = 1.0;
+ }
+
+ axis_ap->width = widget_width(graph_drawer);
+ axis_ap->window_width = axis_ap->width;
+ axis_ap->y_offset = 0;
+ axis_ap->height = widget_height(graph_drawer);
+ axis_ap->graph_x0 = 0;
+
+ clear_window(ax);
+ ax->gc = gc2;
+ make_axes_1(axis_ap, X_AXIS_IN_SECONDS, 1 /* "srate" */, SHOW_ALL_AXES, NOT_PRINTING, WITH_X_AXIS, NO_GRID, WITH_LINEAR_AXES, grid_density(ss));
+
+ ix1 = local_grf_x(0.0, axis_ap);
+ iy1 = local_grf_y(graph_data[0], axis_ap);
+ xincr = 1.0 / (mus_float_t)GRAPH_SIZE;
+
+ for (i = 1, x = xincr; i < GRAPH_SIZE; i++, x += xincr)
+ {
+ ix0 = ix1;
+ iy0 = iy1;
+ ix1 = local_grf_x(x, axis_ap);
+ iy1 = local_grf_y(graph_data[i], axis_ap);
+ XDrawLine(ax->dp, ax->wn, gc2, ix0, iy0, ix1, iy1);
+ }
+
+ ax->gc = fgc;
+ ix1 = local_grf_x(0.0, axis_ap);
+ iy1 = local_grf_y(graph_fftr[0], axis_ap);
+ xincr = 1.0 / (mus_float_t)GRAPH_SIZE;
+
+ for (i = 1, x = xincr; i < GRAPH_SIZE; i++, x += xincr)
+ {
+ ix0 = ix1;
+ iy0 = iy1;
+ ix1 = local_grf_x(x, axis_ap);
+ if (fft_log_magnitude(ss))
+ iy1 = local_grf_y(fp_dB(graph_fftr[i]), axis_ap);
+ else iy1 = local_grf_y(graph_fftr[i], axis_ap);
+ XDrawLine(ax->dp, ax->wn, fgc, ix0, iy0, ix1, iy1);
+ }
+}
+
+
+static void get_fft_window_data(void)
+{
+ int i;
+ mus_make_fft_window_with_window(fft_window(ss), GRAPH_SIZE,
+ fft_window_beta(ss) * fft_beta_max(fft_window(ss)),
+ fft_window_alpha(ss), graph_data);
+ memset((void *)graph_fftr, 0, GRAPH_SIZE * 2 * sizeof(mus_float_t));
+ memset((void *)graph_ffti, 0, GRAPH_SIZE * 2 * sizeof(mus_float_t));
+ memcpy((void *)graph_fftr, (void *)graph_data, GRAPH_SIZE * sizeof(mus_float_t));
+ mus_spectrum(graph_fftr, graph_ffti, NULL, GRAPH_SIZE * 2, MUS_SPECTRUM_IN_DB);
+ for (i = 0; i < GRAPH_SIZE; i++)
+ graph_fftr[i] = (graph_fftr[i] + 80.0) / 80.0; /* min dB here is -80 */
+}
+
+
+static void widget_float_to_text(Widget w, mus_float_t val)
+{
+ char *str;
+ str = (char *)calloc(16, sizeof(char));
+ snprintf(str, 16, "%.2f", val);
+ XmTextFieldSetString(w, str);
+ free(str);
+}
+
+
+
+/* ---------------- errors ---------------- */
+
+static void clear_fft_error(void)
+{
+ if ((error_frame1) && (XtIsManaged(error_frame1)))
+ XtUnmanageChild(error_frame1);
+}
+
+
+static void unpost_fft_error(XtPointer data, XtIntervalId *id)
+{
+ clear_fft_error();
+}
+
+
+static void errors_to_fft_text(const char *msg, void *data)
+{
+ int lines = 0;
+ XmString label;
+ label = multi_line_label(msg, &lines);
+ XtVaSetValues(error_label1,
+ XmNlabelString, label,
+ XmNheight, lines * 20,
+ NULL);
+ XtVaSetValues(error_frame1, XmNheight, lines * 20, NULL);
+ XmStringFree(label);
+ XtManageChild(error_frame1);
+ /* since the offending text is automatically overwritten, we can't depend on subsequent text modify callbacks
+ * to clear things, so we'll just use a timer
+ */
+ XtAppAddTimeOut(MAIN_APP(ss),
+ 5000,
+ (XtTimerCallbackProc)unpost_fft_error,
+ NULL);
+}
+
+
+
+/* ---------------- transform size ---------------- */
+
+static void chans_transform_size(chan_info *cp, mus_long_t size)
+{
+ cp->transform_size = size;
+ if (cp->fft)
+ cp->fft->size = size;
+}
+
+
+void set_transform_size(mus_long_t val)
+{
+ for_each_chan(force_fft_clear);
+ in_set_transform_size(val);
+ for_each_chan_with_mus_long_t(chans_transform_size, val);
+ if (transform_dialog)
+ {
+ int i;
+ for (i = 0; i < NUM_TRANSFORM_SIZES; i++)
+ if (transform_sizes[i] == val)
+ {
+ XmListSelectPos(size_list, i + 1, false);
+ break;
+ }
+ }
+ if (!(ss->graph_hook_active)) for_each_chan(calculate_fft);
+}
+
+
+static void size_browse_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ for_each_chan(force_fft_clear);
+ in_set_transform_size(transform_sizes[cbs->item_position - 1]);
+ for_each_chan_with_mus_long_t(chans_transform_size, transform_size(ss));
+ for_each_chan(calculate_fft);
+ set_label(graph_label, mus_fft_window_name(fft_window(ss)));
+}
+
+
+/* ---------------- wavelet choice ---------------- */
+
+static void chans_wavelet_type(chan_info *cp, int value)
+{
+ cp->wavelet_type = value;
+}
+
+
+void set_wavelet_type(int val)
+{
+ if (transform_dialog) XmListSelectPos(wavelet_list, val, false);
+ in_set_wavelet_type(val);
+ for_each_chan_with_int(chans_wavelet_type, val);
+ if ((transform_type(ss) == WAVELET) &&
+ (!(ss->graph_hook_active)))
+ for_each_chan(calculate_fft);
+}
+
+
+static void wavelet_browse_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int val;
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ in_set_wavelet_type(val = (cbs->item_position - 1)); /* make these numbers 0-based as in mus.lisp */
+ for_each_chan_with_int(chans_wavelet_type, val);
+ if (transform_type(ss) == WAVELET)
+ for_each_chan(calculate_fft);
+}
+
+
+/* ---------------- fft window choice ---------------- */
+
+static void highlight_alpha_beta_scales(mus_fft_window_t val)
+{
+ if (fft_window_beta_in_use(val))
+ {
+ XtVaSetValues(beta_scale, XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(beta_number, XmNbackground, ss->highlight_color, NULL);
+ }
+ else
+ {
+ XtVaSetValues(beta_scale, XmNbackground, ss->basic_color, NULL);
+ XtVaSetValues(beta_number, XmNbackground, ss->basic_color, NULL);
+ }
+
+ if (fft_window_alpha_in_use(val))
+ {
+ XtVaSetValues(alpha_scale, XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(alpha_number, XmNbackground, ss->highlight_color, NULL);
+ }
+ else
+ {
+ XtVaSetValues(alpha_scale, XmNbackground, ss->basic_color, NULL);
+ XtVaSetValues(alpha_number, XmNbackground, ss->basic_color, NULL);
+ }
+}
+
+
+void set_fft_window(mus_fft_window_t val)
+{
+ in_set_fft_window(val);
+ if (!(ss->graph_hook_active)) for_each_chan(calculate_fft);
+ if (transform_dialog)
+ {
+ XmListSelectPos(window_list, (int)val + 1, false);
+ set_label(graph_label, mus_fft_window_name(val));
+ get_fft_window_data();
+ if (XtIsManaged(transform_dialog))
+ graph_redisplay();
+ highlight_alpha_beta_scales(val);
+ }
+}
+
+
+static void window_browse_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ mus_fft_window_t fft_window_choice;
+
+ fft_window_choice = (mus_fft_window_t)(cbs->item_position - 1); /* make these numbers 0-based as in mus.lisp */
+
+ in_set_fft_window(fft_window_choice);
+ for_each_chan(calculate_fft);
+ set_label(graph_label, mus_fft_window_name(fft_window(ss)));
+ get_fft_window_data();
+ graph_redisplay();
+ highlight_alpha_beta_scales(fft_window_choice);
+}
+
+
+
+/* ---------------- transform choice ---------------- */
+
+static void chans_transform_type(chan_info *cp, int value)
+{
+ cp->transform_type = value;
+}
+
+
+void set_transform_type(int val)
+{
+ if (is_transform(val))
+ {
+ if (!(ss->graph_hook_active)) for_each_chan(force_fft_clear);
+ in_set_transform_type(val);
+ for_each_chan_with_int(chans_transform_type, val);
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+ if (transform_dialog) XmListSelectPos(type_list, transform_type_to_position(val) + 1, false);
+ }
+}
+
+
+static void transform_type_browse_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int type;
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ type = transform_position_to_type(cbs->item_position - 1);
+ for_each_chan(force_fft_clear);
+ in_set_transform_type(type);
+ for_each_chan_with_int(chans_transform_type, type);
+ for_each_chan(calculate_fft);
+}
+
+
+void make_transform_type_list(void)
+{
+ int num;
+ num = max_transform_type();
+ if (transform_dialog)
+ {
+ XmString *types;
+ int i, j;
+ types = (XmString *)calloc(num, sizeof(XmString));
+ for (i = 0, j = 0; i < num; i++)
+ if (is_transform(i))
+ {
+ set_transform_position(i, j);
+ types[j++] = XmStringCreateLocalized((char *)transform_name(i));
+ }
+ XtVaSetValues(type_list,
+ XmNitems, types,
+ XmNitemCount, j,
+ XmNvisibleItemCount, 6,
+ NULL);
+ for (i = 0; i < j; i++)
+ XmStringFree(types[i]);
+ free(types);
+ }
+}
+
+
+
+/* ---------------- transform "graph type" (i.e. sonogram etc) ---------------- */
+
+void set_transform_graph_type(graph_type_t val)
+{
+ in_set_transform_graph_type(val);
+ if (transform_dialog)
+ switch (val)
+ {
+ case GRAPH_ONCE:
+ XmToggleButtonSetState(normo_button, true, false);
+ XmToggleButtonSetState(spectro_button, false, false);
+ XmToggleButtonSetState(sono_button, false, false);
+ break;
+ case GRAPH_AS_SONOGRAM:
+ XmToggleButtonSetState(normo_button, false, false);
+ XmToggleButtonSetState(spectro_button, false, false);
+ XmToggleButtonSetState(sono_button, true, false);
+ break;
+ case GRAPH_AS_SPECTROGRAM:
+ XmToggleButtonSetState(normo_button, false, false);
+ XmToggleButtonSetState(spectro_button, true, false);
+ XmToggleButtonSetState(sono_button, false, false);
+ break;
+ case GRAPH_AS_WAVOGRAM:
+ break;
+ }
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+static void graph_transform_once_callback(Widget w, XtPointer context, XtPointer info)
+{
+ graph_type_t old_type;
+ old_type = transform_graph_type(ss);
+ XmToggleButtonSetState(normo_button, true, false);
+ XmToggleButtonSetState(sono_button, false, false);
+ XmToggleButtonSetState(spectro_button, false, false);
+ in_set_transform_graph_type(GRAPH_ONCE);
+ if (old_type != GRAPH_ONCE)
+ for_each_chan(calculate_fft);
+}
+
+
+static void sonogram_callback(Widget w, XtPointer context, XtPointer info)
+{
+ graph_type_t old_type;
+ old_type = transform_graph_type(ss);
+ XmToggleButtonSetState(sono_button, true, false);
+ XmToggleButtonSetState(normo_button, false, false);
+ XmToggleButtonSetState(spectro_button, false, false);
+ in_set_transform_graph_type(GRAPH_AS_SONOGRAM);
+ if (old_type != GRAPH_AS_SONOGRAM)
+ for_each_chan(calculate_fft);
+}
+
+
+static void spectrogram_callback(Widget w, XtPointer context, XtPointer info)
+{
+ graph_type_t old_type;
+ old_type = transform_graph_type(ss);
+ XmToggleButtonSetState(spectro_button, true, false);
+ XmToggleButtonSetState(normo_button, false, false);
+ XmToggleButtonSetState(sono_button, false, false);
+ in_set_transform_graph_type(GRAPH_AS_SPECTROGRAM);
+ if (old_type != GRAPH_AS_SPECTROGRAM)
+ for_each_chan(calculate_fft);
+}
+
+
+
+/* ---------------- show peaks ---------------- */
+
+static void map_show_transform_peaks(chan_info *cp, bool value)
+{
+ cp->show_transform_peaks = value;
+}
+
+
+static void peaks_callback(Widget w, XtPointer context, XtPointer info)
+{
+ bool val;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ val = (cb->set);
+ in_set_show_transform_peaks(val);
+ for_each_chan_with_bool(map_show_transform_peaks, val);
+ for_each_chan(calculate_fft);
+}
+
+
+void set_show_transform_peaks(bool val)
+{
+ in_set_show_transform_peaks(val);
+ for_each_chan_with_bool(map_show_transform_peaks, val);
+ if (transform_dialog)
+ set_toggle_button(peaks_button, val, false, NULL);
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+void reflect_peaks_in_transform_dialog(void)
+{
+ if (transform_dialog)
+ widget_int_to_text(peak_txt, max_transform_peaks(ss));
+}
+
+
+static void peaks_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *str;
+ str = XmTextFieldGetString(w);
+ if ((str) && (*str))
+ {
+ int new_peaks;
+ redirect_errors_to(errors_to_fft_text, NULL);
+ new_peaks = string_to_int(str, 1, "peaks");
+ redirect_errors_to(NULL, NULL);
+ if (new_peaks >= 1)
+ {
+ set_max_transform_peaks(new_peaks);
+ for_each_chan(calculate_fft);
+ }
+ else widget_int_to_text(w, max_transform_peaks(ss));
+ XtFree(str);
+ }
+}
+
+
+
+/* ---------------- log magnitude ---------------- */
+
+static void chans_fft_log_magnitude(chan_info *cp, bool value)
+{
+ cp->fft_log_magnitude = value;
+ cp->fft_changed = FFT_CHANGE_LOCKED;
+}
+
+
+void set_fft_log_magnitude(bool val)
+{
+ in_set_fft_log_magnitude(val);
+ for_each_chan_with_bool(chans_fft_log_magnitude, val);
+ if (transform_dialog)
+ set_toggle_button(db_button, val, false, NULL);
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+
+/* ---------------- dB ---------------- */
+
+static void fft_db_callback(Widget w, XtPointer context, XtPointer info)
+{
+ bool val;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ val = cb->set;
+ in_set_fft_log_magnitude(val);
+ graph_redisplay();
+ for_each_chan_with_bool(chans_fft_log_magnitude, val);
+ for_each_chan(calculate_fft);
+}
+
+
+void reflect_min_db_in_transform_dialog(void)
+{
+ if (transform_dialog)
+ widget_float_to_text(db_txt, min_dB(ss));
+}
+
+
+static void min_db_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *str;
+ str = XmTextFieldGetString(w);
+ if ((str) && (*str))
+ {
+ mus_float_t new_db;
+ redirect_errors_to(errors_to_fft_text, NULL);
+ new_db = string_to_mus_float_t(str, -10000.0, "dB");
+ redirect_errors_to(NULL, NULL);
+ if (new_db < 0.0)
+ set_min_db(new_db);
+ else widget_float_to_text(w, min_dB(ss));
+ XtFree(str);
+ }
+}
+
+
+
+/* ---------------- log frequency ---------------- */
+
+static void chans_fft_log_frequency(chan_info *cp, bool value)
+{
+ cp->fft_log_frequency = value;
+ cp->fft_changed = FFT_CHANGE_LOCKED;
+}
+
+
+static void logfreq_callback(Widget w, XtPointer context, XtPointer info)
+{
+ bool val;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ val = cb->set;
+ in_set_fft_log_frequency(val);
+ for_each_chan_with_bool(chans_fft_log_frequency, val);
+ for_each_chan(calculate_fft);
+}
+
+
+void set_fft_log_frequency(bool val)
+{
+ in_set_fft_log_frequency(val);
+ for_each_chan_with_bool(chans_fft_log_frequency, val);
+ if (transform_dialog)
+ set_toggle_button(logfreq_button, val, false, NULL);
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+void reflect_log_freq_start_in_transform_dialog(void)
+{
+ if (transform_dialog)
+ widget_float_to_text(freq_base_txt, log_freq_start(ss));
+}
+
+
+static void log_freq_start_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *str;
+ str = XmTextFieldGetString(w);
+ if ((str) && (*str))
+ {
+ mus_float_t new_lfb;
+ redirect_errors_to(errors_to_fft_text, NULL);
+ new_lfb = string_to_mus_float_t(str, 0.0, "log freq start");
+ redirect_errors_to(NULL, NULL);
+ if (new_lfb > 0.0)
+ set_log_freq_start(new_lfb);
+ else widget_float_to_text(w, log_freq_start(ss));
+ XtFree(str);
+ }
+}
+
+
+
+
+/* ---------------- normalization choice ---------------- */
+
+static void chans_transform_normalization(chan_info *cp, int value)
+{
+ cp->transform_normalization = (fft_normalize_t)value;
+ cp->fft_changed = FFT_CHANGE_LOCKED;
+}
+
+
+static void normalize_callback(Widget w, XtPointer context, XtPointer info)
+{
+ fft_normalize_t choice;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ choice = (cb->set) ? NORMALIZE_BY_CHANNEL : DONT_NORMALIZE;
+ in_set_transform_normalization(choice);
+ for_each_chan_with_int(chans_transform_normalization, (int)choice);
+ for_each_chan(calculate_fft);
+}
+
+
+void set_transform_normalization(fft_normalize_t val)
+{
+ in_set_transform_normalization(val);
+ for_each_chan_with_int(chans_transform_normalization, (int)val);
+ if (transform_dialog)
+ set_toggle_button(normalize_button, (val != DONT_NORMALIZE), false, NULL);
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+
+/* ---------------- show selection transform ---------------- */
+
+static void selection_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ in_set_show_selection_transform(cb->set);
+ for_each_chan(calculate_fft);
+}
+
+
+void set_show_selection_transform(bool show)
+{
+ in_set_show_selection_transform(show);
+ if (transform_dialog)
+ set_toggle_button(selection_button1, show, false, NULL);
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+
+/* ---------------- show phases (via color) ---------------- */
+
+static void chans_fft_with_phases(chan_info *cp, bool value)
+{
+ cp->fft_with_phases = value;
+ cp->fft_changed = FFT_CHANGE_LOCKED;
+}
+
+
+static void phases_callback(Widget w, XtPointer context, XtPointer info)
+{
+ bool val;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ val = cb->set;
+ in_set_fft_with_phases(val);
+ graph_redisplay();
+ for_each_chan_with_bool(chans_fft_with_phases, val);
+ for_each_chan(calculate_fft);
+}
+
+
+void set_fft_with_phases(bool val)
+{
+ in_set_fft_with_phases(val);
+ for_each_chan_with_bool(chans_fft_with_phases, val);
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+
+/* ---------------- window alpha parameter ---------------- */
+
+static void alpha_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char alpha_number_buffer[11];
+ mus_float_t alpha;
+
+ alpha = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
+ in_set_fft_window_alpha(alpha);
+ chans_field(FCP_ALPHA, alpha);
+
+ snprintf(alpha_number_buffer, 11, "alpha:%.3f", alpha);
+ set_label(alpha_number, alpha_number_buffer);
+
+ if (fft_window_alpha_in_use(fft_window(ss)))
+ {
+ get_fft_window_data();
+ graph_redisplay();
+ if (transform_type(ss) == FOURIER)
+ for_each_chan(calculate_fft);
+ }
+}
+
+static void set_alpha_scale(mus_float_t val)
+{
+ char alpha_number_buffer[11];
+ XtVaSetValues(alpha_scale, XmNvalue, (int)(val * 90), NULL);
+ snprintf(alpha_number_buffer, 11, "alpha:%.3f", val);
+ set_label(alpha_number, alpha_number_buffer);
+}
+
+
+void set_fft_window_alpha(mus_float_t val)
+{
+ in_set_fft_window_alpha(val);
+ chans_field(FCP_ALPHA, val);
+ if (transform_dialog)
+ {
+ set_alpha_scale(val);
+ get_fft_window_data();
+ if (XtIsManaged(transform_dialog))
+ graph_redisplay();
+ }
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+
+/* ---------------- window beta parameter ---------------- */
+
+static void beta_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char beta_number_buffer[11];
+ mus_float_t beta;
+
+ beta = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
+ in_set_fft_window_beta(beta);
+ chans_field(FCP_BETA, beta);
+
+ snprintf(beta_number_buffer, 11, "beta: %.3f", beta);
+ set_label(beta_number, beta_number_buffer);
+
+ if (fft_window_beta_in_use(fft_window(ss)))
+ {
+ get_fft_window_data();
+ graph_redisplay();
+ if (transform_type(ss) == FOURIER)
+ for_each_chan(calculate_fft);
+ }
+}
+
+
+static void set_beta_scale(mus_float_t val)
+{
+ char beta_number_buffer[11];
+ XtVaSetValues(beta_scale, XmNvalue, (int)(val * 90), NULL);
+ snprintf(beta_number_buffer, 11, "beta: %.3f", val);
+ set_label(beta_number, beta_number_buffer);
+}
+
+
+void set_fft_window_beta(mus_float_t val)
+{
+ in_set_fft_window_beta(val);
+ chans_field(FCP_BETA, val);
+ if (transform_dialog)
+ {
+ set_beta_scale(val);
+ get_fft_window_data();
+ if (XtIsManaged(transform_dialog))
+ graph_redisplay();
+ }
+ if (!(ss->graph_hook_active))
+ for_each_chan(calculate_fft);
+}
+
+
+
+/* ---------------- spectrum start/end ---------------- */
+
+static void chans_spectrum_changed(chan_info *cp)
+{
+ cp->fft_changed = FFT_CHANGE_LOCKED;
+ update_graph(cp);
+}
+
+static void set_spectrum_start_scale(mus_float_t val)
+{
+ char start_number_buffer[11];
+ XtVaSetValues(start_scale, XmNvalue, (int)(val * 90), NULL);
+ snprintf(start_number_buffer, 11, "start:%.3f", val);
+ set_label(start_number, start_number_buffer);
+}
+
+
+static void check_spectrum_start(mus_float_t end)
+{
+ /* don't display chans, but do reset if necessary */
+ if (spectrum_start(ss) > end)
+ {
+ in_set_spectrum_start(end);
+ if (transform_dialog)
+ set_spectrum_start_scale(end);
+ chans_field(FCP_SPECTRUM_START, end);
+ }
+}
+
+static void check_spectrum_end(mus_float_t start);
+
+void set_spectrum_start(mus_float_t val)
+{
+ if (transform_dialog)
+ set_spectrum_start_scale(val);
+ in_set_spectrum_start(val);
+ check_spectrum_end(val);
+ chans_field(FCP_SPECTRUM_START, val);
+ for_each_chan(chans_spectrum_changed);
+}
+
+
+static void start_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char start_number_buffer[11];
+ mus_float_t start;
+
+ start = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
+ snprintf(start_number_buffer, 11, "start:%.3f", start);
+ set_label(start_number, start_number_buffer);
+
+ in_set_spectrum_start(start);
+ check_spectrum_end(start);
+ chans_field(FCP_SPECTRUM_START, start);
+ for_each_chan(chans_spectrum_changed);
+}
+
+
+static void set_spectrum_end_scale(mus_float_t val)
+{
+ char end_number_buffer[11];
+ XtVaSetValues(end_scale, XmNvalue, (int)(val * 90), NULL);
+ snprintf(end_number_buffer, 11, "end: %.3f", val);
+ set_label(end_number, end_number_buffer);
+}
+
+static void check_spectrum_end(mus_float_t start)
+{
+ /* don't display chans, but do reset if necessary */
+ if (spectrum_end(ss) < start)
+ {
+ in_set_spectrum_end(start);
+ if (transform_dialog)
+ set_spectrum_end_scale(start);
+ chans_field(FCP_SPECTRUM_END, start);
+ }
+}
+
+
+void set_spectrum_end(mus_float_t val)
+{
+ if (transform_dialog)
+ set_spectrum_end_scale(val);
+ in_set_spectrum_end(val);
+ check_spectrum_start(val);
+ chans_field(FCP_SPECTRUM_END, val);
+ for_each_chan(chans_spectrum_changed);
+}
+
+
+static void end_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char end_number_buffer[11];
+ mus_float_t end;
+
+ end = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
+ snprintf(end_number_buffer, 11, "end: %.3f", end);
+ set_label(end_number, end_number_buffer);
+
+ in_set_spectrum_end(end);
+ check_spectrum_start(end);
+ chans_field(FCP_SPECTRUM_END, end);
+ for_each_chan(chans_spectrum_changed);
+}
+
+
+
+/* ---------------- dialog buttons etc ---------------- */
+
+static void graph_resize_callback(Widget w, XtPointer context, XtPointer info)
+{
+ graph_redisplay();
+}
+
+
+static void dismiss_transform_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (XmGetFocusWidget(transform_dialog) == XmMessageBoxGetChild(transform_dialog, XmDIALOG_CANCEL_BUTTON))
+ XtUnmanageChild(transform_dialog);
+}
+
+
+static void color_orientation_callback(Widget w, XtPointer context, XtPointer info)
+{
+ make_color_orientation_dialog(true);
+}
+
+
+static void help_transform_callback(Widget w, XtPointer context, XtPointer info)
+{
+ transform_dialog_help();
+}
+
+
+static void fft_blue_textfield_unfocus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtVaSetValues(w, XmNbackground, ss->lighter_blue, NULL);
+ XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
+}
+
+
+static void fft_blue_mouse_leave_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ XtVaSetValues(w, XmNbackground, ss->lighter_blue, NULL);
+ XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
+}
+
+
+static void fft_white_mouse_enter_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ XtVaSetValues(w, XmNbackground, ss->text_focus_color, NULL);
+ XtVaSetValues(w, XmNcursorPositionVisible, true, NULL);
+}
+
+
+
+/* ---------------- transform options dialog ---------------- */
+
+#define FRAME_BORDER_WIDTH 6
+
+static bool need_callback = true;
+
+Widget make_transform_dialog(bool managed)
+{
+ if (!transform_dialog)
+ {
+ Widget mainform, type_frame, type_form, type_label, size_frame, size_form, size_label, display_frame, display_form, display_label;
+ Widget window_frame, window_form, window_label, wavelet_frame, wavelet_form, wavelet_label, graph_frame, graph_form, gsep;
+ Widget ab_form, ab_frame, ab_title, ab_sep;
+ Widget se_form, se_frame, se_title, se_sep, ok_button;
+ XmString s1;
+ XmString xhelp, xgo_away, xtitle, bstr, xorient;
+ Arg args[32];
+ XmString sizes[NUM_TRANSFORM_SIZES];
+ XmString wavelets[NUM_WAVELETS];
+ XmString windows[MUS_NUM_FFT_WINDOWS];
+ XGCValues gv;
+ XtCallbackList n1, n2, n3, n4;
+ int size_pos = 1;
+ int n, i;
+
+ for (i = 0; i < NUM_TRANSFORM_SIZES; i++)
+ if (transform_sizes[i] == transform_size(ss))
+ {
+ size_pos = i + 1;
+ break;
+ }
+ xgo_away = XmStringCreateLocalized((char *)I_GO_AWAY); /* needed by template dialog */
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ xtitle = XmStringCreateLocalized((char *)"Transform Options");
+ xorient = XmStringCreateLocalized((char *)"Color/Orientation");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNcancelLabelString, xgo_away); n++;
+ XtSetArg(args[n], XmNokLabelString, xorient); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNdialogTitle, xtitle); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ transform_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Transform Options", args, n);
+ ok_button = XmMessageBoxGetChild(transform_dialog, XmDIALOG_OK_BUTTON);
+
+ XtAddCallback(transform_dialog, XmNcancelCallback, dismiss_transform_callback, NULL);
+ /* XtAddCallback(transform_dialog, XmNokCallback, color_orientation_callback, NULL); */ /* <cr> in dialog calls this! */
+ XtAddCallback(ok_button, XmNactivateCallback, color_orientation_callback, NULL);
+ XtAddCallback(transform_dialog, XmNhelpCallback, help_transform_callback, NULL);
+ XmStringFree(xhelp);
+ XmStringFree(xgo_away);
+ XmStringFree(xtitle);
+ XmStringFree(xorient);
+
+ XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(transform_dialog, XmDIALOG_SEPARATOR)); n++;
+ mainform = XtCreateManagedWidget("mainform", xmFormWidgetClass, transform_dialog, args, n);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNshadowThickness, 2); n++;
+ error_frame1 = XtCreateManagedWidget("error-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ error_label1 = XtCreateManagedWidget("", xmLabelWidgetClass, error_frame1, args, n);
+
+
+ /* now 7 or 8 boxes within the main box:
+
+ type (list) | size (list) | display (button column)
+ wavelet (list) | window (list) | graph (fft?) of current window
+ alpha/beta ------------------------ |
+ start/end ------------------------- |
+
+ each box has a frame, label, and contents
+ */
+
+ /* -------- SPECTRUM START/END -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 60); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ se_frame = XtCreateManagedWidget("se-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ se_form = XtCreateManagedWidget("se-form", xmFormWidgetClass, se_frame, args, n);
+ /* needed because XmFrame only accepts one child */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ se_title = XtCreateManagedWidget("spectrum start/end", xmLabelWidgetClass, se_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, se_title); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ se_sep = XtCreateManagedWidget("se_sep", xmSeparatorWidgetClass, se_form, args, n);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"start:0.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, se_sep); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ start_number = XtCreateManagedWidget("start-number", xmLabelWidgetClass, se_form, args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, start_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, start_number); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, 100); n++;
+ XtSetArg(args[n], XmNvalue, 0); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNdragCallback, n3 = make_callback_list(start_drag_callback, NULL)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n3); n++;
+ start_scale = XtCreateManagedWidget("start-scale", xmScrollBarWidgetClass, se_form, args, n);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"end: 1.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, start_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ end_number = XtCreateManagedWidget("end-number", xmLabelWidgetClass, se_form, args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, end_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, end_number); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, 100); n++;
+ XtSetArg(args[n], XmNvalue, 90); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNdragCallback, n4 = make_callback_list(end_drag_callback, NULL)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n4); n++;
+ end_scale = XtCreateManagedWidget("end-scale", xmScrollBarWidgetClass, se_form, args, n);
+
+
+
+ /* -------- WINDOW ALPHA/BETA -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 60); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, se_frame); n++;
+ XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ ab_frame = XtCreateManagedWidget("ab-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ ab_form = XtCreateManagedWidget("ab-form", xmFormWidgetClass, ab_frame, args, n);
+ /* needed because XmFrame only accepts one child */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ ab_title = XtCreateManagedWidget("window parameter", xmLabelWidgetClass, ab_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, ab_title); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ ab_sep = XtCreateManagedWidget("ab_sep", xmSeparatorWidgetClass, ab_form, args, n);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"alpha:0.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, ab_sep); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ alpha_number = XtCreateManagedWidget("alpha-number", xmLabelWidgetClass, ab_form, args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, alpha_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, alpha_number); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, 100); n++;
+ XtSetArg(args[n], XmNvalue, 0); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+
+ XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(alpha_drag_callback, NULL)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n1); n++;
+ alpha_scale = XtCreateManagedWidget("alpha-scale", xmScrollBarWidgetClass, ab_form, args, n);
+
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"beta: 0.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, alpha_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ beta_number = XtCreateManagedWidget("beta-number", xmLabelWidgetClass, ab_form, args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, beta_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, beta_number); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, 100); n++;
+ XtSetArg(args[n], XmNvalue, 0); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+
+ XtSetArg(args[n], XmNdragCallback, n2 = make_callback_list(beta_drag_callback, NULL)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n2); n++;
+ beta_scale = XtCreateManagedWidget("beta-scale", xmScrollBarWidgetClass, ab_form, args, n);
+
+
+ /* -------- WINDOW -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 30); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNtopPosition, 35); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, ab_frame); n++;
+ XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ window_frame = XtCreateManagedWidget("window-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ window_form = XtCreateManagedWidget("window-form", xmFormWidgetClass, window_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ window_label = XtCreateManagedWidget("window", xmLabelWidgetClass, window_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomWidget, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, window_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopItemPosition, ((int)fft_window(ss) > 2) ? ((int)fft_window(ss) - 1) : ((int)fft_window(ss) + 1)); n++;
+ window_list = XmCreateScrolledList(window_form, (char *)"window-list", args, n);
+
+ XtVaSetValues(window_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ for (i = 0; i < MUS_NUM_FFT_WINDOWS; i++)
+ windows[i] = XmStringCreateLocalized((char *)mus_fft_window_name((mus_fft_window_t)i));
+
+ XtVaSetValues(window_list,
+ XmNitems, windows,
+ XmNitemCount, MUS_NUM_FFT_WINDOWS,
+ XmNvisibleItemCount, 8,
+ NULL);
+ for (i = 0; i < MUS_NUM_FFT_WINDOWS; i++)
+ XmStringFree(windows[i]);
+
+ XtManageChild(window_list);
+ XtAddCallback(window_list, XmNbrowseSelectionCallback, window_browse_callback, NULL);
+
+
+ /* -------- WAVELET -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, window_frame); n++;
+
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 60); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNtopPosition, 35); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, ab_frame); n++;
+ XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ wavelet_frame = XtCreateManagedWidget("wavelet-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ wavelet_form = XtCreateManagedWidget("wavelet-form", xmFormWidgetClass, wavelet_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ wavelet_label = XtCreateManagedWidget("wavelet", xmLabelWidgetClass, wavelet_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomWidget, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, wavelet_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ wavelet_list = XmCreateScrolledList(wavelet_form, (char *)"wavelet-list", args, n);
+
+ XtVaSetValues(wavelet_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ for (i = 0; i < NUM_WAVELETS; i++)
+ wavelets[i] = XmStringCreateLocalized((char *)wavelet_name(i));
+
+ XtVaSetValues(wavelet_list,
+ XmNitems, wavelets,
+ XmNitemCount, NUM_WAVELETS,
+ XmNvisibleItemCount, 8,
+ NULL);
+ for (i = 0; i < NUM_WAVELETS; i++)
+ XmStringFree(wavelets[i]);
+
+ XtManageChild(wavelet_list);
+ XtAddCallback(wavelet_list, XmNbrowseSelectionCallback, wavelet_browse_callback, NULL);
+
+
+ /* -------- TRANSFORM TYPE -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 30); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNbottomPosition, 35); n++;
+ XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ type_frame = XtCreateManagedWidget("type-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ type_form = XtCreateManagedWidget("type-form", xmFormWidgetClass, type_frame, args, n);
+ /* needed because XmFrame only accepts one child */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ type_label = XtCreateManagedWidget("type", xmLabelWidgetClass, type_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, type_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ type_list = XmCreateScrolledList(type_form, (char *)"type-list", args, n);
+
+ XtVaSetValues(type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ make_transform_type_list();
+
+ XtManageChild(type_list);
+ XtAddCallback(type_list, XmNbrowseSelectionCallback, transform_type_browse_callback, NULL);
+
+
+ /* -------- SIZE -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, type_frame); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 60); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, type_frame); n++;
+ XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ size_frame = XtCreateManagedWidget("size-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ size_form = XtCreateManagedWidget("size-form", xmFormWidgetClass, size_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ size_label = XtCreateManagedWidget("size", xmLabelWidgetClass, size_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, size_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopItemPosition, (size_pos > 2) ? (size_pos - 2) : size_pos); n++;
+ size_list = XmCreateScrolledList(size_form, (char *)"size-list", args, n);
+
+ XtVaSetValues(size_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ for (i = 0; i < NUM_TRANSFORM_SIZES; i++)
+ sizes[i] = XmStringCreateLocalized((char *)transform_size_names[i]);
+
+ XtVaSetValues(size_list,
+ XmNitems, sizes,
+ XmNitemCount, NUM_TRANSFORM_SIZES,
+ XmNvisibleItemCount, 6,
+ NULL);
+ for (i = 0; i < NUM_TRANSFORM_SIZES; i++)
+ XmStringFree(sizes[i]);
+
+ XtManageChild(size_list);
+ XtAddCallback(size_list, XmNbrowseSelectionCallback, size_browse_callback, NULL);
+
+
+ /* -------- DISPLAY BOX BUTTONS -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, size_frame); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ display_frame = XtCreateManagedWidget("display-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
+ n = attach_all_sides(args, n);
+ display_form = XtCreateManagedWidget("display-form", xmFormWidgetClass, display_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ display_label = XtCreateManagedWidget("display", xmLabelWidgetClass, display_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"single transform");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, display_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
+ normo_button = make_togglebutton_widget("normo-button", display_form, args, n);
+ XtAddCallback(normo_button, XmNdisarmCallback, graph_transform_once_callback, NULL);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"sonogram");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, normo_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
+ sono_button = make_togglebutton_widget("sono-button", display_form, args, n);
+ XtAddCallback(sono_button, XmNdisarmCallback, sonogram_callback, NULL);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"spectrogram");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sono_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
+ spectro_button = make_togglebutton_widget("spectro-button", display_form, args, n);
+ XtAddCallback(spectro_button, XmNdisarmCallback, spectrogram_callback, NULL);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"peaks");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 67); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, spectro_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ peaks_button = make_togglebutton_widget("peaks-button", display_form, args, n);
+ XtAddCallback(peaks_button, XmNvalueChangedCallback, peaks_callback, NULL);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNresizeWidth, false); n++;
+ XtSetArg(args[n], XmNcolumns, 6); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ /* XtSetArg(args[n], XmNmarginHeight, 1); n++; */
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, peaks_button); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, peaks_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, peaks_button); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ peak_txt = make_textfield_widget("max-peaks", display_form, args, n, ACTIVATABLE, NO_COMPLETER);
+ XtRemoveCallback(peak_txt, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ XtAddCallback(peak_txt, XmNlosingFocusCallback, fft_blue_textfield_unfocus_callback, NULL);
+ XtAddEventHandler(peak_txt, LeaveWindowMask, false, fft_blue_mouse_leave_text_callback, NULL);
+ XtAddEventHandler(peak_txt, EnterWindowMask, false, fft_white_mouse_enter_text_callback, NULL);
+ widget_int_to_text(peak_txt, max_transform_peaks(ss));
+ XtAddCallback(peak_txt, XmNactivateCallback, peaks_activate_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"dB");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 67); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, peaks_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ db_button = make_togglebutton_widget("db-button", display_form, args, n);
+ XtAddCallback(db_button, XmNvalueChangedCallback, fft_db_callback, NULL);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNresizeWidth, false); n++;
+ XtSetArg(args[n], XmNcolumns, 6); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ /* XtSetArg(args[n], XmNmarginHeight, 1); n++; */
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, db_button); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, db_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, db_button); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ db_txt = make_textfield_widget("db", display_form, args, n, ACTIVATABLE, NO_COMPLETER);
+ XtRemoveCallback(db_txt, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ XtAddCallback(db_txt, XmNlosingFocusCallback, fft_blue_textfield_unfocus_callback, NULL);
+ XtAddEventHandler(db_txt, LeaveWindowMask, false, fft_blue_mouse_leave_text_callback, NULL);
+ XtAddEventHandler(db_txt, EnterWindowMask, false, fft_white_mouse_enter_text_callback, NULL);
+ widget_float_to_text(db_txt, min_dB(ss));
+ XtAddCallback(db_txt, XmNactivateCallback, min_db_activate_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"log freq");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 67); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, db_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ logfreq_button = make_togglebutton_widget("logfreq-button", display_form, args, n);
+ XtAddCallback(logfreq_button, XmNvalueChangedCallback, logfreq_callback, NULL);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNresizeWidth, false); n++;
+ XtSetArg(args[n], XmNcolumns, 6); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ /* XtSetArg(args[n], XmNmarginHeight, 1); n++; */
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, logfreq_button); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, logfreq_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, logfreq_button); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ freq_base_txt = make_textfield_widget("lfb", display_form, args, n, ACTIVATABLE, NO_COMPLETER);
+ XtRemoveCallback(freq_base_txt, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ XtAddCallback(freq_base_txt, XmNlosingFocusCallback, fft_blue_textfield_unfocus_callback, NULL);
+ XtAddEventHandler(freq_base_txt, LeaveWindowMask, false, fft_blue_mouse_leave_text_callback, NULL);
+ XtAddEventHandler(freq_base_txt, EnterWindowMask, false, fft_white_mouse_enter_text_callback, NULL);
+ widget_float_to_text(freq_base_txt, log_freq_start(ss));
+ XtAddCallback(freq_base_txt, XmNactivateCallback, log_freq_start_activate_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"normalize");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, logfreq_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ normalize_button = make_togglebutton_widget("normalize-button", display_form, args, n);
+ XtAddCallback(normalize_button, XmNvalueChangedCallback, normalize_callback, NULL);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"selection");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, normalize_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ selection_button1 = make_togglebutton_widget("selection-button", display_form, args, n);
+ XtAddCallback(selection_button1, XmNvalueChangedCallback, selection_callback, NULL);
+ XmStringFree(bstr);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"with phases");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, selection_button1); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ phases_button = make_togglebutton_widget("phases-button", display_form, args, n);
+ XtAddCallback(phases_button, XmNvalueChangedCallback, phases_callback, NULL);
+ XmStringFree(bstr);
+
+
+
+ /* -------- GRAPH -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, wavelet_frame); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, display_frame); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
+ XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
+ graph_frame = XtCreateManagedWidget("graph-frame", xmFrameWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ graph_form = XtCreateManagedWidget("graph-form", xmFormWidgetClass, graph_frame, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ graph_label = XtCreateManagedWidget("window", xmLabelWidgetClass, graph_form, args, n);
+ /* label should change according to what is being displayed */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, graph_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ gsep = XtCreateManagedWidget("gsep", xmSeparatorWidgetClass, graph_form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->graph_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, gsep); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ graph_drawer = XtCreateManagedWidget("graph-drawer", xmDrawingAreaWidgetClass, graph_form, args, n);
+
+ gv.function = GXcopy;
+ XtVaGetValues(graph_drawer, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
+ gc2 = XtGetGC(graph_drawer, GCForeground | GCFunction, &gv);
+
+ gv.foreground = ss->enved_waveform_color;
+ fgc = XtGetGC(graph_drawer, GCForeground | GCFunction, &gv);
+
+ XmToggleButtonSetState(normo_button, (Boolean)(transform_graph_type(ss) == GRAPH_ONCE), false);
+ XmToggleButtonSetState(sono_button, (Boolean)(transform_graph_type(ss) == GRAPH_AS_SONOGRAM), false);
+ XmToggleButtonSetState(spectro_button, (Boolean)(transform_graph_type(ss) == GRAPH_AS_SPECTROGRAM), false);
+ XmToggleButtonSetState(peaks_button, (Boolean)(show_transform_peaks(ss)), false);
+ XmToggleButtonSetState(db_button, (Boolean)(fft_log_magnitude(ss)), false);
+ XmToggleButtonSetState(logfreq_button, (Boolean)(fft_log_frequency(ss)), false);
+ XmToggleButtonSetState(normalize_button, (Boolean)(transform_normalization(ss) != DONT_NORMALIZE), false);
+ XmToggleButtonSetState(selection_button1, (Boolean)(show_selection_transform(ss)), false);
+ XmToggleButtonSetState(phases_button, (Boolean)(fft_with_phases(ss)), false);
+
+ /* select current list choices */
+ /* display current windowing choice unless wavelet in force */
+
+ XmListSelectPos(type_list, transform_type_to_position(transform_type(ss)) + 1, false);
+ XmListSelectPos(wavelet_list, wavelet_type(ss) + 1, false);
+ XmListSelectPos(size_list, size_pos, false);
+ XmListSelectPos(window_list, (int)fft_window(ss) + 1, false);
+
+ if (spectrum_start(ss) != 0.0) set_spectrum_start_scale(spectrum_start(ss));
+ if (spectrum_end(ss) != 1.0) set_spectrum_end_scale(spectrum_end(ss));
+ if (fft_window_alpha(ss) != 0.0) set_alpha_scale(fft_window_alpha(ss));
+ if (fft_window_beta(ss) != 0.0) set_beta_scale(fft_window_beta(ss));
+
+ highlight_alpha_beta_scales(fft_window(ss));
+
+ free(n1);
+ free(n2);
+ free(n3);
+ free(n4);
+
+ set_dialog_widget(TRANSFORM_DIALOG, transform_dialog);
+
+ XtUnmanageChild(error_frame1);
+ }
+ else
+ {
+ if (managed)
+ raise_dialog(transform_dialog);
+ }
+ if (managed)
+ {
+ if (!XtIsManaged(transform_dialog))
+ XtManageChild(transform_dialog);
+ }
+ else XtUnmanageChild(transform_dialog);
+ if ((need_callback) && (XtIsManaged(transform_dialog)))
+ {
+ set_label(graph_label, mus_fft_window_name(fft_window(ss)));
+ get_fft_window_data();
+ XtAddCallback(graph_drawer, XmNresizeCallback, graph_resize_callback, NULL);
+ XtAddCallback(graph_drawer, XmNexposeCallback, graph_resize_callback, NULL);
+ need_callback = false;
+ }
+ return(transform_dialog);
+}
+
+
+bool transform_dialog_is_active(void)
+{
+ return((transform_dialog) &&
+ (XtIsManaged(transform_dialog)));
+}
+
+
+/* -------- region browser -------- */
+
+typedef struct {
+ Widget rw, nm, pl;
+ int pos;
+} regrow;
+
+static Widget region_dialog = NULL, region_list, region_grf;
+static regrow **region_rows = NULL;
+static int region_rows_size = 0;
+static snd_info *rsp = NULL;
+static int current_region = -1;
+static Widget reg_srtxt, reg_lentxt, reg_chntxt, reg_maxtxt;
+static Widget region_ww = NULL;
+static Widget mix_button = NULL, save_as_button = NULL, insert_button = NULL;
+static regrow *region_row(int n);
+
+
+static void set_current_region(int rg)
+{
+ bool reg_ok = false;
+ current_region = rg;
+ reflect_region_in_save_as_dialog();
+ if (rg >= 0)
+ reg_ok = region_ok(region_list_position_to_id(rg));
+ if (save_as_button) XtSetSensitive(save_as_button, reg_ok);
+ if (mix_button) XtSetSensitive(mix_button, reg_ok);
+ if (insert_button) XtSetSensitive(insert_button, reg_ok);
+}
+
+
+void reflect_regions_in_region_browser(void)
+{
+ if (rsp)
+ {
+ int i;
+ rsp->active = true;
+ if (rsp->chans)
+ for (i = 0; i < rsp->nchans; i++)
+ rsp->chans[i]->active = CHANNEL_HAS_AXES;
+ }
+}
+
+
+void reflect_no_regions_in_region_browser(void)
+{
+ if (rsp)
+ {
+ int i;
+ rsp->active = false;
+ if (rsp->chans)
+ for (i = 0; i < rsp->nchans; i++)
+ rsp->chans[i]->active = CHANNEL_INACTIVE;
+ }
+}
+
+
+static void region_update_graph(chan_info *cp)
+{
+ if (current_region == -1) return;
+ rsp->nchans = region_chans(region_list_position_to_id(current_region));
+ if (rsp->nchans == 0) return;
+ update_graph(cp);
+ rsp->nchans = 1;
+}
+
+
+void reflect_region_graph_style(void)
+{
+ if (current_region == -1) return;
+ if ((rsp) &&
+ (rsp->chans) &&
+ (rsp->chans[0]) &&
+ (region_dialog_is_active()))
+ {
+ rsp->chans[0]->time_graph_style = region_graph_style(ss);
+ rsp->chans[0]->dot_size = dot_size(ss);
+ /* update_graph(rsp->chans[0]); */
+ update_region_browser(true);
+ }
+}
+
+
+static void unhighlight_region(void)
+{
+ if (current_region != -1)
+ {
+ regrow *oldr;
+ oldr = region_row(current_region);
+ XtVaSetValues(oldr->rw, XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(oldr->nm, XmNbackground, ss->highlight_color, NULL);
+ }
+}
+
+
+static void highlight_region(void)
+{
+ if (current_region != -1)
+ {
+ regrow *oldr;
+ oldr = region_row(current_region);
+ XtVaSetValues(oldr->rw, XmNbackground, ss->zoom_color, NULL);
+ XtVaSetValues(oldr->nm, XmNbackground, ss->zoom_color, NULL);
+ }
+}
+
+
+static void make_region_labels(file_info *hdr)
+{
+ char *str;
+ if (hdr == NULL) return;
+ str = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(str, PRINT_BUFFER_SIZE, "srate: %d", hdr->srate);
+ set_label(reg_srtxt, str);
+ snprintf(str, PRINT_BUFFER_SIZE, "chans: %d", hdr->chans);
+ set_label(reg_chntxt, str);
+ snprintf(str, PRINT_BUFFER_SIZE, "length: %.3f", (float)((double)(hdr->samples) / (float)(hdr->chans * hdr->srate)));
+ set_label(reg_lentxt, str);
+ snprintf(str, PRINT_BUFFER_SIZE, "maxamp: %.3f", region_maxamp(region_list_position_to_id(current_region)));
+ set_label(reg_maxtxt, str);
+ free(str);
+}
+
+
+int update_region_browser(bool grf_too)
+{
+ int i, len;
+ region_state *rs;
+
+ rs = region_report();
+ len = rs->len;
+
+ for (i = 0; i < len; i++)
+ {
+ regrow *r;
+ r = region_row(i);
+ set_button_label(r->nm, rs->name[i]);
+#if WITH_AUDIO
+ XmToggleButtonSetState(r->pl, false, false);
+#endif
+ XtManageChild(r->rw);
+ }
+
+ for (i = len; i < max_regions(ss); i++)
+ if (region_rows[i])
+ XtUnmanageChild(region_rows[i]->rw);
+
+ free_region_state(rs);
+ if (len == 0) return(0);
+
+ XtManageChild(region_list);
+ if (grf_too)
+ {
+ chan_info *cp;
+ unhighlight_region();
+ set_current_region(0);
+ highlight_region();
+ goto_window(region_rows[0]->nm);
+ cp = rsp->chans[0];
+ if (cp)
+ {
+ cp->sound = rsp;
+ cp->chan = 0;
+ set_sensitive(channel_f(cp), false);
+ set_sensitive(channel_w(cp), (region_chans(region_list_position_to_id(0)) > 1));
+ rsp->hdr = fixup_region_data(cp, 0, 0);
+ make_region_labels(rsp->hdr);
+ region_update_graph(cp);
+ }
+ }
+ return(len);
+}
+
+
+static void region_quit_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtUnmanageChild(region_dialog);
+}
+
+
+bool region_browser_is_active(void)
+{
+ return((region_dialog) && (XtIsRealized(region_dialog)));
+}
+
+
+static void region_resize_callback(Widget w, XtPointer context, XtPointer info)
+{
+ region_update_graph((chan_info *)context);
+}
+
+
+void delete_region_and_update_browser(int pos)
+{
+ int act;
+ unhighlight_region();
+ act = remove_region_from_list(pos);
+ if (act == INVALID_REGION) return;
+ if (region_dialog)
+ {
+ if (act != NO_REGIONS)
+ {
+ set_current_region(0);
+ highlight_region();
+ goto_window(region_rows[0]->nm);
+ }
+ else set_current_region(-1);
+ update_region_browser(1);
+ }
+}
+
+
+static void region_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ region_dialog_help();
+}
+
+
+static void region_insert_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if ((current_region != -1) &&
+ (selected_channel()))
+ paste_region(region_list_position_to_id(current_region), selected_channel());
+}
+
+
+static void region_mix_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if ((current_region != -1) &&
+ (selected_channel()))
+ add_region(region_list_position_to_id(current_region), selected_channel());
+}
+
+
+static void region_save_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if ((current_region != -1) &&
+ (XmGetFocusWidget(region_dialog) == XmMessageBoxGetChild(region_dialog, XmDIALOG_OK_BUTTON)))
+ make_region_save_as_dialog(true);
+}
+
+
+static void region_up_arrow_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp;
+ cp = rsp->chans[0];
+ cp->sound = rsp;
+ if (cp->chan > 0)
+ {
+ cp->chan--;
+ set_sensitive(channel_f(cp), (cp->chan > 0));
+ set_sensitive(channel_w(cp), true);
+ fixup_region_data(cp, cp->chan, current_region);
+ region_update_graph(cp);
+ }
+}
+
+
+static void region_down_arrow_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp;
+ cp = rsp->chans[0];
+ cp->sound = rsp;
+ if ((cp->chan + 1) < region_chans(region_list_position_to_id(current_region)))
+ {
+ cp->chan++;
+ set_sensitive(channel_f(cp), true);
+ set_sensitive(channel_w(cp), (region_chans(region_list_position_to_id(current_region)) > (cp->chan + 1)));
+ fixup_region_data(cp, cp->chan, current_region);
+ region_update_graph(cp);
+ }
+}
+
+
+static void region_focus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ static oclock_t mouse_down_time = 0;
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ XButtonEvent *ev;
+ chan_info *cp;
+ regrow *r = (regrow *)context;
+
+ ev = (XButtonEvent *)(cb->event);
+ if (mouse_down_time != 0)
+ {
+ if ((ev->time - mouse_down_time) < ss->click_time) /* edit region if double clicked */
+ {
+ mouse_down_time = ev->time;
+ if (current_region != -1)
+ region_edit(current_region);
+ return;
+ }
+ }
+ mouse_down_time = ev->time;
+
+ unhighlight_region();
+ if (region_list_position_to_id(r->pos) == INVALID_REGION) return; /* needed by auto-tester */
+ set_current_region(r->pos);
+ cp = rsp->chans[0];
+ cp->sound = rsp;
+ cp->chan = 0;
+ highlight_region();
+ set_sensitive(channel_f(cp), false);
+ set_sensitive(channel_w(cp), (region_chans(region_list_position_to_id(current_region)) > 1));
+ rsp->hdr = fixup_region_data(cp, 0, current_region);
+ if (rsp->hdr == NULL) return;
+ make_region_labels(rsp->hdr);
+ region_update_graph(cp);
+}
+
+
+void reflect_play_region_stop(int n)
+{
+#if WITH_AUDIO
+ if (region_rows)
+ {
+ regrow *rg;
+ rg = region_row(region_id_to_list_position(n));
+ if (rg) XmToggleButtonSetState(rg->pl, false, false);
+ }
+#endif
+}
+
+
+static void region_play_callback(Widget w, XtPointer context, XtPointer info)
+{
+#if WITH_AUDIO
+ regrow *r = (regrow *)context;
+ if (XmToggleButtonGetState(r->pl))
+ play_region(region_list_position_to_id(r->pos), IN_BACKGROUND);
+ else stop_playing_region(region_list_position_to_id(r->pos), PLAY_BUTTON_UNSET);
+#endif
+}
+
+
+static Xen reflect_file_in_region_browser(Xen hook_or_reason)
+{
+ if (region_dialog)
+ {
+ bool file_on;
+ file_on = (bool)(any_selected_sound());
+ set_sensitive(mix_button, file_on);
+ set_sensitive(insert_button, file_on);
+ }
+ return(Xen_false);
+}
+
+Xen_wrap_1_arg(reflect_file_in_region_browser_w, reflect_file_in_region_browser)
+
+
+static char *regrow_get_label(void *ur)
+{
+ regrow *r = (regrow *)ur;
+ return(get_label(r->nm));
+}
+
+
+static int regrow_get_pos(void *ur)
+{
+ regrow *r = (regrow *)ur;
+ return(r->pos);
+}
+
+
+static void regrow_mouse_enter_label(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ mouse_enter_label(context, REGION_VIEWER);
+}
+
+
+static void regrow_mouse_leave_label(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ mouse_leave_label(context, REGION_VIEWER);
+}
+
+
+static regrow *make_regrow(Widget ww, Widget last_row, XtCallbackProc play_callback, XtCallbackProc name_callback)
+{
+ int n;
+ Arg args[32];
+ regrow *r;
+ XmString s1;
+#if WITH_AUDIO
+ XtCallbackList n1;
+#endif
+ XtCallbackList n3;
+
+ s1 = XmStringCreateLocalized((char *)"");
+ r = (regrow *)calloc(1, sizeof(regrow));
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, (last_row) ? XmATTACH_WIDGET : XmATTACH_FORM); n++;
+ if (last_row) {XtSetArg(args[n], XmNtopWidget, last_row); n++;}
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNheight, 18); n++;
+ r->rw = XtCreateWidget("rw", xmFormWidgetClass, ww, args, n);
+
+#if WITH_AUDIO
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n1 = make_callback_list(play_callback, (XtPointer)r)); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ XtSetArg(args[n], XmNmarginWidth, 8); n++;
+ r->pl = make_togglebutton_widget("pl", r->rw, args, n);
+#endif
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+#if WITH_AUDIO
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, r->pl); n++;
+#else
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+#endif
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNwidth, 300); n++;
+ XtSetArg(args[n], XmNactivateCallback, n3 = make_callback_list(name_callback, (XtPointer)r)); n++;
+ r->nm = XtCreateManagedWidget("nm", xmPushButtonWidgetClass, r->rw, args, n);
+ XmStringFree(s1);
+
+ XtAddEventHandler(r->nm, EnterWindowMask, false, regrow_mouse_enter_label, (XtPointer)r);
+ XtAddEventHandler(r->nm, LeaveWindowMask, false, regrow_mouse_leave_label, (XtPointer)r);
+
+#if WITH_AUDIO
+ free(n1);
+#endif
+ free(n3);
+ return(r);
+}
+
+
+static void make_region_dialog(void)
+{
+ int n, i, id;
+ Arg args[32];
+ Widget formw, last_row, infosep;
+ Widget panes, toppane, sep1 = NULL, sep2;
+#if WITH_AUDIO
+ Widget plw;
+#endif
+ XmString xgo_away, xhelp, titlestr, xsave_as;
+ regrow *r;
+ chan_info *cp;
+
+ xgo_away = XmStringCreateLocalized((char *)I_GO_AWAY);
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ titlestr = XmStringCreateLocalized((char *)"Regions");
+ xsave_as = XmStringCreateLocalized((char *)"Save as");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNcancelLabelString, xgo_away); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNokLabelString, xsave_as); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ region_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Regions", args, n);
+ save_as_button = XmMessageBoxGetChild(region_dialog, XmDIALOG_OK_BUTTON);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ insert_button = XtCreateManagedWidget("Insert", xmPushButtonGadgetClass, region_dialog, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ mix_button = XtCreateManagedWidget("Mix", xmPushButtonGadgetClass, region_dialog, args, n);
+
+ /* XtAddCallback(region_dialog, XmNokCallback, region_save_callback, NULL); */
+ XtAddCallback(save_as_button, XmNactivateCallback, region_save_callback, NULL);
+ XtAddCallback(region_dialog, XmNcancelCallback, region_quit_callback, NULL);
+ XtAddCallback(region_dialog, XmNhelpCallback, region_help_callback, NULL);
+ XtAddCallback(mix_button, XmNactivateCallback, region_mix_callback, NULL);
+ XtAddCallback(insert_button, XmNactivateCallback, region_insert_callback, NULL);
+
+ XmStringFree(xhelp);
+ XmStringFree(xgo_away);
+ XmStringFree(xsave_as);
+ XmStringFree(titlestr);
+
+ XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ insert_button = XmMessageBoxGetChild(region_dialog, XmDIALOG_CANCEL_BUTTON);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(region_dialog, XmDIALOG_SEPARATOR)); n++;
+ formw = XtCreateManagedWidget("formw", xmFormWidgetClass, region_dialog, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep1); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
+ panes = XtCreateManagedWidget("panes", xmPanedWindowWidgetClass, formw, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ XtSetArg(args[n], XmNpaneMinimum, 40); n++;
+ toppane = XtCreateManagedWidget("toppane", xmFormWidgetClass, panes, args, n);
+
+#if WITH_AUDIO
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ plw = XtCreateManagedWidget("play", xmLabelWidgetClass, toppane, args, n);
+#endif
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNheight, 8); n++;
+ sep2 = XtCreateManagedWidget("sep2", xmSeparatorWidgetClass, toppane, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 70); n++;
+#if WITH_AUDIO
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, plw); n++;
+#else
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+#endif
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, sep2); n++;
+ XtSetArg(args[n], XmNscrollingPolicy, XmAUTOMATIC); n++;
+ XtSetArg(args[n], XmNscrollBarDisplayPolicy, XmSTATIC); n++;
+ region_list = XmCreateScrolledWindow(toppane, (char *)"reglist", args, n);
+
+ n = attach_all_sides(args, 0);
+ region_ww = XtCreateManagedWidget("ww", xmFormWidgetClass, region_list, args, n);
+ XtVaSetValues(region_list,
+ XmNworkWindow, region_ww,
+ NULL);
+
+ map_over_children(region_list, set_main_color_of_widget);
+ last_row = NULL;
+
+ region_rows = (regrow **)calloc(max_regions(ss), sizeof(regrow *));
+ region_rows_size = max_regions(ss);
+ for (i = 0; i < max_regions(ss); i++)
+ {
+ r = make_regrow(region_ww, last_row, region_play_callback, region_focus_callback);
+ region_rows[i] = r;
+ r->pos = i;
+ last_row = r->rw;
+ }
+
+ update_region_browser(0);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, region_list); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+#if WITH_AUDIO
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, plw); n++;
+#else
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+#endif
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNwidth, 8); n++;
+ infosep = XtCreateManagedWidget("infosep", xmSeparatorWidgetClass, toppane, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, infosep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+#if WITH_AUDIO
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, plw); n++;
+#else
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+#endif
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ reg_srtxt = XtCreateManagedWidget("srate:", xmLabelWidgetClass, toppane, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, infosep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, reg_srtxt); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ reg_chntxt = XtCreateManagedWidget("chans:", xmLabelWidgetClass, toppane, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, infosep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, reg_chntxt); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ reg_lentxt = XtCreateManagedWidget("length:", xmLabelWidgetClass, toppane, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, infosep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, reg_lentxt); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ reg_maxtxt = XtCreateManagedWidget("maxamp:", xmLabelWidgetClass, toppane, args, n);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ n = attach_all_sides(args, n);
+ XtSetArg(args[n], XmNpaneMinimum, 150); n++;
+ region_grf = XtCreateManagedWidget("grf", xmFormWidgetClass, panes, args, n);
+
+ XtManageChild(region_dialog);
+ if (widget_width(region_dialog) < 400) set_widget_width(region_dialog, 400);
+
+ id = region_list_position_to_id(0);
+ rsp = make_simple_channel_display(region_srate(id), region_len(id), WITH_ARROWS, region_graph_style(ss), region_grf, WITHOUT_EVENTS);
+ rsp->inuse = SOUND_REGION;
+ set_current_region(0);
+ cp = rsp->chans[0];
+ XtVaSetValues(region_rows[0]->nm, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ map_over_children(panes, color_sashes);
+ XtVaSetValues(toppane, XmNpaneMinimum, 1, NULL);
+ XtVaSetValues(region_grf, XmNpaneMinimum, 1, NULL);
+
+ XtAddCallback(channel_graph(cp), XmNresizeCallback, region_resize_callback, (XtPointer)cp);
+ XtAddCallback(channel_graph(cp), XmNexposeCallback, region_resize_callback, (XtPointer)cp);
+
+ /* channel_f is up arrow, channel_w is down arrow */
+ XtAddCallback(channel_f(cp), XmNactivateCallback, region_up_arrow_callback, NULL);
+ XtAddCallback(channel_w(cp), XmNactivateCallback, region_down_arrow_callback, NULL);
+
+ set_sensitive(channel_f(cp), false);
+ set_sensitive(channel_w(cp), (region_chans(region_list_position_to_id(0)) > 1));
+
+ cp->chan = 0;
+ rsp->hdr = fixup_region_data(cp, 0, 0);
+ make_region_labels(rsp->hdr);
+ highlight_region();
+ region_update_graph(cp);
+
+ Xen_add_to_hook_list(ss->snd_open_file_hook, reflect_file_in_region_browser_w, "region-dialog-open-file-watcher", "region dialog open-file-hook handler");
+
+ set_dialog_widget(REGION_DIALOG, region_dialog);
+}
+
+
+static void view_region_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* put up scrollable dialog describing/playing/editing the region list */
+ if (region_dialog == NULL)
+ make_region_dialog();
+ else raise_dialog(region_dialog);
+ if (!XtIsManaged(region_dialog))
+ {
+ set_current_region(0);
+ XtManageChild(region_dialog);
+ }
+}
+
+
+bool region_dialog_is_active(void)
+{
+ return((region_dialog != NULL) &&
+ (XtIsManaged(region_dialog)));
+}
+
+
+void allocate_region_rows(int n)
+{
+ if ((region_dialog) &&
+ (n > region_rows_size))
+ {
+ int i;
+ region_rows = (regrow **)realloc(region_rows, n * sizeof(regrow *));
+ for (i = region_rows_size; i < n; i++) region_rows[i] = NULL;
+ region_rows_size = n;
+ }
+}
+
+
+static regrow *region_row(int n)
+{
+ if (n < region_rows_size)
+ {
+ regrow *r;
+ if (region_rows[n] == NULL)
+ {
+ r = make_regrow(region_ww,
+ (n > 0) ? (region_rows[n - 1]->rw) : NULL,
+ region_play_callback, region_focus_callback);
+ region_rows[n] = r;
+ r->pos = n;
+ }
+ return(region_rows[n]);
+ }
+ return(NULL);
+}
+
+
+static int region_dialog_region(void)
+{
+ return(region_list_position_to_id(current_region));
+}
+
+
+static Xen g_view_regions_dialog(void)
+{
+ #define H_view_regions_dialog "(" S_view_regions_dialog "): start the region dialog"
+ if (snd_regions() > 0)
+ view_region_callback(MAIN_PANE(ss), NULL, NULL);
+ return(Xen_wrap_widget(region_dialog));
+}
+
+
+Xen_wrap_no_args(g_view_regions_dialog_w, g_view_regions_dialog)
+
+void g_init_gxregion(void)
+{
+ Xen_define_safe_procedure(S_view_regions_dialog, g_view_regions_dialog_w, 0, 0, 0, H_view_regions_dialog);
+}
+
+
+#include "snd-file.h"
+
+/* various file-related dialogs:
+ File|Edit:Save-as
+ File:Open|View
+ File|Edit:Mix
+ File:Insert
+ File:Edit-Header
+ File:New
+ Info and Raw
+ View:Files
+*/
+
+static void snd_sort(int sorter, sort_info **data, int len);
+
+
+/* -------------------------------- sorters -------------------------------- */
+
+
+static mus_long_t file_bytes(const char *filename)
+{
+#ifndef _MSC_VER
+ struct stat statbuf;
+ if (stat(filename, &statbuf) >= 0)
+ return(statbuf.st_size);
+ return(0);
+#else
+ int chan;
+ mus_long_t bytes;
+ chan = mus_file_open_read(filename);
+ if (chan == -1) return(0);
+ bytes = lseek(chan, 0L, SEEK_END);
+ snd_close(chan, filename);
+ return(bytes);
+#endif
+}
+
+/* sort files list by name (aphabetical), or some number (date written, size), or by xen proc */
+
+static int sort_a_to_z(const void *a, const void *b)
+{
+ sort_info *d1 = *(sort_info **)a;
+ sort_info *d2 = *(sort_info **)b;
+ return(strcmp(d1->filename, d2->filename));
+}
+
+
+static int sort_z_to_a(const void *a, const void *b)
+{
+ return(-sort_a_to_z(a, b));
+}
+
+
+static int sort_small_to_big(const void *a, const void *b)
+{
+ sort_info *d1 = *(sort_info **)a;
+ sort_info *d2 = *(sort_info **)b;
+ if (d1->samps > d2->samps)
+ return(1);
+ else
+ {
+ if (d1->samps == d2->samps)
+ return(0);
+ else return(-1);
+ }
+}
+
+
+static int sort_big_to_small(const void *a, const void *b)
+{
+ return(-sort_small_to_big(a, b));
+}
+
+
+static int sort_new_to_old(const void *a, const void *b)
+{
+ sort_info *d1 = *(sort_info **)a;
+ sort_info *d2 = *(sort_info **)b;
+ if (d1->time < d2->time)
+ return(1);
+ else
+ {
+ if (d1->time == d2->time)
+ return(0);
+ else return(-1);
+ }
+}
+
+
+static int sort_old_to_new(const void *a, const void *b)
+{
+ return(-sort_new_to_old(a, b));
+}
+
+
+static Xen sorter_func;
+
+static int sort_xen(const void *a, const void *b)
+{
+ /* sorter function gets two names, returns -1, 0, or 1 just like the other comparators */
+ sort_info *d1 = *(sort_info **)a;
+ sort_info *d2 = *(sort_info **)b;
+ return(Xen_integer_to_C_int(Xen_call_with_2_args(sorter_func, C_string_to_Xen_string(d1->full_filename), C_string_to_Xen_string(d2->full_filename), "sort func")));
+}
+
+
+static void snd_sort(int sorter, sort_info **data, int len)
+{
+ int i, sorter_pos;
+ switch (sorter)
+ {
+ case SORT_A_TO_Z:
+ qsort((void *)data, len, sizeof(sort_info *), sort_a_to_z);
+ break;
+
+ case SORT_Z_TO_A:
+ qsort((void *)data, len, sizeof(sort_info *), sort_z_to_a);
+ break;
+
+ case SORT_NEW_TO_OLD:
+ for (i = 0; i < len; i++)
+ data[i]->time = file_write_date(data[i]->full_filename);
+ qsort((void *)data, len, sizeof(sort_info *), sort_new_to_old);
+ break;
+
+ case SORT_OLD_TO_NEW:
+ for (i = 0; i < len; i++)
+ data[i]->time = file_write_date(data[i]->full_filename);
+ qsort((void *)data, len, sizeof(sort_info *), sort_old_to_new);
+ break;
+
+ case SORT_SMALL_TO_BIG:
+ for (i = 0; i < len; i++)
+ data[i]->samps = file_bytes(data[i]->full_filename);
+ qsort((void *)data, len, sizeof(sort_info *), sort_small_to_big);
+ break;
+
+ case SORT_BIG_TO_SMALL:
+ for (i = 0; i < len; i++)
+ data[i]->samps = file_bytes(data[i]->full_filename);
+ qsort((void *)data, len, sizeof(sort_info *), sort_big_to_small);
+ break;
+
+ default:
+ case SORT_XEN:
+ /* sorter is SORT_XEN + index into file_sorters list */
+ /* that list is a vector of pairs (name proc) */
+ sorter_pos = sorter - SORT_XEN;
+ if ((sorter_pos >= 0) &&
+ (sorter_pos < ss->file_sorters_size))
+ {
+ if (Xen_is_list(Xen_vector_ref(ss->file_sorters, sorter_pos)))
+ {
+ sorter_func = Xen_cadr(Xen_vector_ref(ss->file_sorters, sorter_pos));
+ qsort((void *)data, len, sizeof(sort_info *), sort_xen);
+ return;
+ }
+ }
+ snd_warning("no such file-sorter (%d)", sorter_pos);
+ break;
+ }
+}
+
+
+
+static void dialog_set_title(widget_t dialog, const char *titlestr)
+{
+ XmString title;
+ title = XmStringCreateLocalized((char *)titlestr);
+ XtVaSetValues(dialog, XmNdialogTitle, title, NULL);
+ XmStringFree(title);
+}
+
+
+void cleanup_file_monitor(void) {}
+static bool initialize_file_monitor(void) {return(false);}
+void *unmonitor_file(void *watcher) {return(NULL);}
+void monitor_sound(snd_info *sp) {}
+
+/* -------------------------------------------------------------------------------- */
+
+
+
+#define FSB_BOX(Dialog, Child) XmFileSelectionBoxGetChild(Dialog, Child)
+#define MSG_BOX(Dialog, Child) XmMessageBoxGetChild(Dialog, Child)
+
+
+/* ---------------- open/mix/insert/save-as dialogs ---------------- */
+
+static void color_file_selection_box(Widget w)
+{
+ /* overwrite most Motif-default colors */
+ Widget wtmp;
+
+ map_over_children(w, set_main_color_of_widget);
+ XtVaSetValues(FSB_BOX(w, XmDIALOG_DIR_LIST),
+ XmNbackground, ss->white,
+ XmNforeground, ss->black,
+ NULL);
+ XtVaSetValues(FSB_BOX(w, XmDIALOG_LIST),
+ XmNbackground, ss->white,
+ XmNforeground, ss->black,
+ NULL);
+
+ XtVaSetValues(FSB_BOX(w, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(FSB_BOX(w, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(FSB_BOX(w, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(FSB_BOX(w, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(FSB_BOX(w, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(FSB_BOX(w, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ wtmp = FSB_BOX(w, XmDIALOG_TEXT);
+ if (wtmp)
+ {
+ XtVaSetValues(wtmp, XmNhighlightThickness, 1, NULL);
+ XtAddCallback(wtmp, XmNfocusCallback, textfield_focus_callback, NULL);
+ XtAddCallback(wtmp, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ XtAddEventHandler(wtmp, EnterWindowMask, false, mouse_enter_text_callback, NULL);
+ XtAddEventHandler(wtmp, LeaveWindowMask, false, mouse_leave_text_callback, NULL);
+ }
+
+ wtmp = FSB_BOX(w, XmDIALOG_FILTER_TEXT);
+ if (wtmp)
+ {
+ XtVaSetValues(wtmp, XmNhighlightThickness, 1, NULL);
+ XtAddCallback(wtmp, XmNfocusCallback, textfield_focus_callback, NULL);
+ XtAddCallback(wtmp, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ XtAddEventHandler(wtmp, EnterWindowMask, false, mouse_enter_text_callback, NULL);
+ XtAddEventHandler(wtmp, LeaveWindowMask, false, mouse_leave_text_callback, NULL);
+ }
+}
+
+
+static void force_directory_reread(Widget dialog)
+{
+ /* force update, but make sure the filename is not reset to its (dumb) default */
+ XmString dirmask;
+ Widget name_field;
+ char *filename = NULL;
+ name_field = FSB_BOX(dialog, XmDIALOG_TEXT);
+ filename = XmTextGetString(name_field);
+ XtVaGetValues(dialog, XmNdirMask, &dirmask, NULL);
+ XmFileSelectionDoSearch(dialog, dirmask);
+ XmStringFree(dirmask);
+ XmTextSetString(name_field, filename);
+ if (filename)
+ {
+ XmTextSetCursorPosition(name_field, mus_strlen(filename));
+ XtFree(filename);
+ }
+}
+
+
+static void force_directory_reread_and_let_filename_change(Widget dialog)
+{
+ XmString dirmask;
+ XtVaGetValues(dialog, XmNdirMask, &dirmask, NULL);
+ XmFileSelectionDoSearch(dialog, dirmask);
+ XmStringFree(dirmask);
+}
+
+
+
+
+/* -------------------------------- file list positioning -------------------------------- */
+
+typedef struct {
+ char *directory_name;
+ position_t list_top;
+} dirpos_info;
+
+typedef struct {
+ dirpos_info **dirs;
+ int size, top;
+} dirpos_list;
+
+void dirpos_update(dirpos_list *dl, const char *dir, position_t pos);
+position_t dirpos_list_top(dirpos_list *dl, const char *dirname);
+dirpos_list *make_dirpos_list(void);
+
+
+static dirpos_info *make_dirpos_info(const char *dir, position_t pos)
+{
+ dirpos_info *dp;
+ dp = (dirpos_info *)calloc(1, sizeof(dirpos_info));
+ dp->directory_name = mus_strdup(dir);
+ dp->list_top = pos;
+ return(dp);
+}
+
+
+dirpos_list *make_dirpos_list(void)
+{
+ dirpos_list *dl;
+ dl = (dirpos_list *)calloc(1, sizeof(dirpos_list));
+ dl->size = 8;
+ dl->top = 0;
+ dl->dirs = (dirpos_info **)calloc(dl->size, sizeof(dirpos_info *));
+ return(dl);
+}
+
+
+void dirpos_update(dirpos_list *dl, const char *dir, position_t pos)
+{
+ int i;
+ if (!dl) return;
+ for (i = 0; i < dl->top; i++)
+ {
+ if ((dl->dirs[i]) &&
+ (mus_strcmp(dir, dl->dirs[i]->directory_name)))
+ {
+ dirpos_info *dp;
+ dp = dl->dirs[i];
+ dp->list_top = pos;
+ return;
+ }
+ }
+ if (dl->top >= dl->size)
+ {
+ int old_size;
+ old_size = dl->size;
+ dl->size += 8;
+ dl->dirs = (dirpos_info **)realloc(dl->dirs, dl->size * sizeof(dirpos_info *));
+ for (i = old_size; i < dl->size; i++) dl->dirs[i] = NULL;
+ }
+ dl->dirs[dl->top++] = make_dirpos_info(dir, pos);
+}
+
+
+position_t dirpos_list_top(dirpos_list *dl, const char *dirname)
+{
+ int i;
+ if (dl)
+ for (i = 0; i < dl->top; i++)
+ if ((dl->dirs[i]) &&
+ (mus_strcmp(dirname, dl->dirs[i]->directory_name)))
+ return(dl->dirs[i]->list_top);
+ return(POSITION_UNKNOWN);
+}
+
+
+/* -------- popups -------- */
+
+/* I think there is no way to get a key action to popup one of these menus -- Xm/RowColumn.c
+ * appears to insist on a button event, and any change to that via XmNmenuPost gets an
+ * error. Perhaps we should notice the POPUP_BUTTON setting however?
+ */
+
+typedef struct file_pattern_info {
+ /* just-sounds file lists */
+ bool reread_directory;
+ bool in_just_sounds_update;
+ Widget dialog, just_sounds_button;
+ char *last_dir;
+ dir_info *current_files;
+ void *directory_watcher;
+ int filter_choice, sorter_choice;
+ dirpos_list *dir_list;
+} file_pattern_info;
+
+/* popups:
+ * text: history of previous choices,
+ * list: sort and filter choices
+ * dir: higher level dir choices
+ * filter: history of previous choices
+ */
+
+typedef struct file_popup_info {
+ Widget dialog;
+ Widget file_text_popup, file_list_popup, file_dir_popup, file_filter_popup;
+ Widget file_text_popup_label, file_filter_popup_label, file_dir_popup_label, file_list_popup_label;
+ /* file_filter here refers to the dialog filter field, not file-filters */
+ char **file_text_names, **file_filter_names; /* history of choices as array of strings */
+ Widget *file_text_items, *file_filter_items, *file_dir_items, *file_list_items; /* menu items */
+ int file_list_items_size;
+ file_pattern_info *fp;
+} file_popup_info;
+
+
+/* file popup */
+static void file_text_item_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ char *filename;
+ snd_info *sp;
+ filename = get_label(w);
+ XmTextFieldSetString(FSB_BOX(fd->dialog, XmDIALOG_TEXT), filename);
+
+ ss->open_requestor = FROM_OPEN_DIALOG_POPUP;
+ ss->open_requestor_data = NULL;
+ sp = snd_open_file(filename, FILE_READ_WRITE);
+ if (sp) select_channel(sp, 0);
+
+ XtUnmanageChild(fd->dialog);
+ if (filename) XtFree(filename);
+}
+
+
+#define FILE_TEXT_POPUP_LABEL "previous files"
+
+static void file_text_popup_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
+ XEvent *e;
+ e = cb->event;
+ if (e->type == ButtonPress)
+ {
+ /* position menu to match current text widget, show previous choices, if any else "[no previous choices]" */
+ /* XmMenuPosition(popup_menu, event) happens automatically */
+
+ char *current_filename;
+ int i, filenames_to_display = 0;
+
+ if (fd->file_text_items == NULL)
+ {
+ int n = 0;
+ Arg args[12];
+ fd->file_text_items = (Widget *)calloc(FILENAME_LIST_SIZE, sizeof(Widget));
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ for (i = 0; i < FILENAME_LIST_SIZE; i++)
+ {
+ fd->file_text_items[i] = XtCreateWidget("", xmPushButtonWidgetClass, fd->file_text_popup, args, n);
+ XtAddCallback(fd->file_text_items[i], XmNactivateCallback, file_text_item_activate_callback, (void *)fd);
+ }
+ }
+
+ current_filename = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_TEXT));
+ /* w is probably ok here (assumes only text triggers this) */
+
+ for (i = 0; i < FILENAME_LIST_SIZE; i++)
+ if ((fd->file_text_names[i]) &&
+ (mus_file_probe(fd->file_text_names[i])) &&
+ (!(mus_strcmp(fd->file_text_names[i], current_filename))))
+ {
+ set_label(fd->file_text_items[filenames_to_display], fd->file_text_names[i]);
+ XtManageChild(fd->file_text_items[filenames_to_display]);
+ filenames_to_display++;
+ }
+
+ for (i = filenames_to_display; i < FILENAME_LIST_SIZE; i++)
+ if ((fd->file_text_items[i]) &&
+ (XtIsManaged(fd->file_text_items[i])))
+ XtUnmanageChild(fd->file_text_items[i]);
+ XtFree(current_filename);
+
+ /* why was this commented out? */
+ if (filenames_to_display == 0)
+ set_label(fd->file_text_popup_label, "no " FILE_TEXT_POPUP_LABEL);
+ else set_label(fd->file_text_popup_label, FILE_TEXT_POPUP_LABEL);
+
+ cb->menuToPost = fd->file_text_popup;
+ }
+}
+
+
+/* filter popup */
+static void file_filter_text_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ char *filter;
+ filter = XmTextFieldGetString(w);
+ if (filter)
+ {
+ remember_filename(filter, fd->file_filter_names);
+ XtFree(filter);
+ force_directory_reread_and_let_filename_change(fd->dialog);
+ }
+}
+
+
+static void file_filter_item_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ Widget text;
+ char *filtername;
+ filtername = get_label(w);
+ text = FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT);
+ XmTextFieldSetString(text, filtername);
+ force_directory_reread(fd->dialog);
+ if (filtername) XtFree(filtername);
+}
+
+
+#define FILE_FILTER_POPUP_LABEL "previous filters"
+
+static void file_filter_popup_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
+ XEvent *e;
+ e = cb->event;
+ if (e->type == ButtonPress)
+ {
+ char *current_filtername;
+ int i, filternames_to_display = 0;
+
+ if (fd->file_filter_items == NULL)
+ {
+ int n = 0;
+ Arg args[12];
+ fd->file_filter_items = (Widget *)calloc(FILENAME_LIST_SIZE, sizeof(Widget));
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ for (i = 0; i < FILENAME_LIST_SIZE; i++)
+ {
+ fd->file_filter_items[i] = XtCreateWidget("", xmPushButtonWidgetClass, fd->file_filter_popup, args, n);
+ XtAddCallback(fd->file_filter_items[i], XmNactivateCallback, file_filter_item_activate_callback, (void *)fd);
+ }
+ }
+
+ current_filtername = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT));
+
+ for (i = 0; i < FILENAME_LIST_SIZE; i++)
+ if ((fd->file_filter_names[i]) &&
+ (!(mus_strcmp(fd->file_filter_names[i], current_filtername))))
+ {
+ set_label(fd->file_filter_items[filternames_to_display], fd->file_filter_names[i]);
+ XtManageChild(fd->file_filter_items[filternames_to_display]);
+ filternames_to_display++;
+ }
+
+ for (i = filternames_to_display; i < FILENAME_LIST_SIZE; i++)
+ if ((fd->file_filter_items[i]) &&
+ (XtIsManaged(fd->file_filter_items[i])))
+ XtUnmanageChild(fd->file_filter_items[i]);
+ XtFree(current_filtername);
+ /*
+ if (filternames_to_display == 0)
+ set_label(fd->file_filter_popup_label, "no " FILE_FILTER_POPUP_LABEL);
+ else set_label(fd->file_filter_popup_label, FILE_FILTER_POPUP_LABEL);
+ */
+ cb->menuToPost = fd->file_filter_popup;
+ }
+}
+
+
+/* dir list popup */
+
+static void update_dir_list(Widget dialog, char *filter)
+{
+ Widget text;
+ text = FSB_BOX(dialog, XmDIALOG_FILTER_TEXT);
+ XmTextFieldSetString(text, filter);
+ force_directory_reread(dialog);
+}
+
+
+static void file_dir_item_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ char *name, *filter;
+ name = get_label(w);
+ filter = mus_format("%s/*", name);
+ update_dir_list(fd->dialog, filter);
+ if (name) XtFree(name);
+ free(filter);
+}
+
+
+#define FILE_DIR_POPUP_LABEL "dirs"
+
+/* dir_items, but strs generated on the fly, current in filter text */
+
+static void file_dir_popup_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
+ XEvent *e;
+ e = cb->event;
+ if (e->type == ButtonPress)
+ {
+ char *current_filename = NULL;
+ int i, dirs_to_display = 0;
+
+ if (fd->file_dir_items == NULL)
+ {
+ int n = 0;
+ Arg args[12];
+ fd->file_dir_items = (Widget *)calloc(FILENAME_LIST_SIZE, sizeof(Widget));
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ for (i = 0; i < FILENAME_LIST_SIZE; i++)
+ {
+ fd->file_dir_items[i] = XtCreateWidget("", xmPushButtonWidgetClass, fd->file_dir_popup, args, n);
+ XtAddCallback(fd->file_dir_items[i], XmNactivateCallback, file_dir_item_activate_callback, (void *)fd);
+ }
+ }
+
+ {
+ XmStringTable items;
+ int num_dirs;
+ XtVaGetValues(fd->dialog, XmNdirListItems, &items, XmNdirListItemCount, &num_dirs, NULL);
+ if (num_dirs > 0)
+ current_filename = (char *)XmStringUnparse(items[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ }
+ if (!current_filename)
+ {
+ current_filename = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT));
+ if (!current_filename)
+ current_filename = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_TEXT));
+ }
+
+ if (current_filename)
+ {
+ int len;
+ len = strlen(current_filename);
+ for (i = 0; i < len; i++)
+ if (current_filename[i] == '/')
+ dirs_to_display++;
+
+ if (dirs_to_display > FILENAME_LIST_SIZE)
+ dirs_to_display = FILENAME_LIST_SIZE;
+
+ if (dirs_to_display > 0)
+ {
+ char **dirs;
+ int j = 1;
+ dirs = (char **)calloc(dirs_to_display, sizeof(char *));
+ dirs[0] = mus_strdup("/");
+ for (i = 1; i < len; i++)
+ if (current_filename[i] == '/')
+ {
+ dirs[j] = (char *)calloc(i + 1, sizeof(char));
+ strncpy(dirs[j], (const char *)current_filename, i);
+ j++;
+ }
+
+ for (i = 0; i < dirs_to_display; i++)
+ {
+ set_label(fd->file_dir_items[i], dirs[i]);
+ XtManageChild(fd->file_dir_items[i]);
+ free(dirs[i]);
+ }
+ free(dirs);
+ }
+ }
+
+ for (i = dirs_to_display; i < FILENAME_LIST_SIZE; i++)
+ if ((fd->file_dir_items[i]) &&
+ (XtIsManaged(fd->file_dir_items[i])))
+ XtUnmanageChild(fd->file_dir_items[i]);
+ XtFree(current_filename);
+
+ cb->menuToPost = fd->file_dir_popup;
+ }
+}
+
+
+#define FILE_LIST_POPUP_LABEL "sort/filter"
+#define NO_FILTER_LABEL "no filter"
+
+#define FILE_FILTER_OFFSET 1024
+#define NO_FILE_FILTER_OFFSET 2048
+
+static void sort_files_and_redisplay(file_pattern_info *fp);
+
+
+static void file_list_item_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ pointer_or_int_t data;
+ int choice;
+ XtVaGetValues(w, XmNuserData, &data, NULL);
+ choice = (int)data;
+ if (choice >= FILE_FILTER_OFFSET)
+ {
+ XmToggleButtonSetState(fd->fp->just_sounds_button, false, false);
+ if (choice == NO_FILE_FILTER_OFFSET)
+ fd->fp->filter_choice = NO_FILE_FILTER;
+ else fd->fp->filter_choice = choice - FILE_FILTER_OFFSET + 2;
+ fd->fp->in_just_sounds_update = true;
+ force_directory_reread(fd->fp->dialog);
+ fd->fp->in_just_sounds_update = false;
+ }
+ else
+ {
+ fd->fp->sorter_choice = choice;
+ sort_files_and_redisplay(fd->fp);
+ }
+}
+
+
+static Widget make_file_list_item(file_popup_info *fd, int choice)
+{
+ int n;
+ Arg args[12];
+ const char *item_label;
+ Widget w;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+
+ switch (choice)
+ {
+ case 0: item_label = "a..z"; break;
+ case 1: item_label = "z..a"; break;
+ case 2: item_label = "new..old"; break;
+ case 3: item_label = "old..new"; break;
+ case 4: item_label = "small..big"; break;
+ case 5: item_label = "big..small"; break;
+ default: item_label = "unused"; break;
+ }
+
+ XtSetArg(args[n], XmNuserData, choice); /* userData is index into sorters list */
+ w = XtCreateManagedWidget(item_label, xmPushButtonWidgetClass, fd->file_list_popup, args, n + 1);
+ XtAddCallback(w, XmNactivateCallback, file_list_item_activate_callback, (void *)fd);
+ return(w);
+}
+
+
+static void file_list_popup_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_popup_info *fd = (file_popup_info *)context;
+ XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
+ XEvent *e;
+ e = cb->event;
+ if (e->type == ButtonPress)
+ {
+ int i;
+ if (fd->file_list_items == NULL)
+ {
+ /* set up the default menu items */
+
+ fd->file_list_items = (Widget *)calloc(SORT_XEN, sizeof(Widget));
+ fd->file_list_items_size = SORT_XEN;
+
+ for (i = 0; i < SORT_XEN; i++)
+ fd->file_list_items[i] = make_file_list_item(fd, i);
+ }
+
+ /* clear any trailers just in case */
+ if (fd->file_list_items_size > SORT_XEN)
+ for (i = SORT_XEN; i < fd->file_list_items_size; i++)
+ XtUnmanageChild(fd->file_list_items[i]);
+
+ /* check for added sort and filter functions (allocate more items if needed) */
+ {
+ int extra_sorters = 0, extra_filters = 0, items_len;
+ for (i = 0; i < ss->file_sorters_size; i++)
+ if (!(Xen_is_false(Xen_vector_ref(ss->file_sorters, i))))
+ extra_sorters++;
+ for (i = 0; i < ss->file_filters_size; i++)
+ if (!(Xen_is_false(Xen_vector_ref(ss->file_filters, i))))
+ extra_filters++;
+
+ items_len = SORT_XEN + extra_sorters + extra_filters;
+ if (fd->fp->filter_choice != NO_FILE_FILTER) items_len++;
+
+ if (items_len > fd->file_list_items_size)
+ {
+ fd->file_list_items = (Widget *)realloc(fd->file_list_items, items_len * sizeof(Widget));
+ for (i = fd->file_list_items_size; i < items_len; i++)
+ fd->file_list_items[i] = make_file_list_item(fd, i);
+ fd->file_list_items_size = items_len;
+ }
+ }
+
+ /* make sure all the added sorter labels are correct, bg blue, and items active */
+ if (fd->file_list_items_size > SORT_XEN)
+ {
+ int k = SORT_XEN;
+
+ /* sorters */
+ for (i = 0; i < ss->file_sorters_size; i++)
+ {
+ if (!(Xen_is_false(Xen_vector_ref(ss->file_sorters, i))))
+ {
+ set_label(fd->file_list_items[k], Xen_string_to_C_string(Xen_car(Xen_vector_ref(ss->file_sorters, i))));
+ XtVaSetValues(fd->file_list_items[k],
+ XmNbackground, ss->lighter_blue,
+ XmNuserData, SORT_XEN + i,
+ NULL);
+ if (!(XtIsManaged(fd->file_list_items[k])))
+ XtManageChild(fd->file_list_items[k]);
+ k++;
+ }
+ }
+
+ for (i = 0; i < ss->file_filters_size; i++)
+ {
+ if (!(Xen_is_false(Xen_vector_ref(ss->file_filters, i))))
+ {
+ set_label(fd->file_list_items[k], Xen_string_to_C_string(Xen_car(Xen_vector_ref(ss->file_filters, i))));
+ XtVaSetValues(fd->file_list_items[k], XmNbackground, ss->light_blue,
+ XmNuserData, i + FILE_FILTER_OFFSET,
+ NULL);
+ if (!(XtIsManaged(fd->file_list_items[k])))
+ XtManageChild(fd->file_list_items[k]);
+ k++;
+ }
+ }
+
+ /* add "no filter" item if currently filtered */
+ if (fd->fp->filter_choice != NO_FILE_FILTER)
+ {
+ set_label(fd->file_list_items[k], NO_FILTER_LABEL);
+ XtVaSetValues(fd->file_list_items[k], XmNbackground, ss->light_blue,
+ XmNuserData, NO_FILE_FILTER_OFFSET,
+ NULL);
+ if (!(XtIsManaged(fd->file_list_items[k])))
+ XtManageChild(fd->file_list_items[k]);
+ }
+
+ }
+ cb->menuToPost = fd->file_list_popup;
+ }
+}
+
+
+static void add_file_popups(file_popup_info *fd)
+{
+ int n;
+ Arg args[20];
+
+ /* from lib/Xm.RCPopup.c:
+ * When a user creates a new popup menu then we will install a particular
+ * event handler on the menu's widget parent. Along with this we install
+ * a grab on the button specified in XmNmenuPost or XmNwhichButton. [XmNmenuPost is a string = translation table syntax, <Btn3Down> is default]
+ * [XmNwhichButton is obsolete]
+ * The posting algorithm is as follows:
+ *
+ * 1. On receipt of a posting event, the handler will search the child
+ * list for a candidate widget or gadget, and track the most specific
+ * popup menu available (these can be found in the popup list). The
+ * criteria for a match includes matching the XmNmenuPost information.
+ *
+ * 2. Matching criteria include:
+ *
+ * * The menu must have XmNpopupEnabled set to either
+ * XmPOPUP_AUTOMATIC or XmPOPUP_AUTOMATIC_RECURSIVE.
+ *
+ * * The popup menu is chosen according to creation order. If there is
+ * more than one, the first correct match is chosen.
+ *
+ * * If the popup menu is found in a parent of the target widget, and
+ * the popup menu must also have XmNpopupEnabled set to
+ * XmPOPUP_AUTOMATIC_RECURSIVE to match. [sigh -- no one actually reads comments...]
+ *
+ * 3. Once a selection is made, if the menu's parent widget has a
+ * popupHandlerCallback, it is invoked. The callback allows the user to
+ * determine if a more specific menu is necessary, such as would be the
+ * case in a graphical manipulation environment, and includes all the
+ * necessary information.
+ *
+ */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNpopupEnabled, XmPOPUP_AUTOMATIC); n++;
+
+ /* file text */
+ XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_TEXT), XmNpopupHandlerCallback, file_text_popup_callback, (void *)fd);
+ fd->file_text_popup = XmCreatePopupMenu(FSB_BOX(fd->dialog, XmDIALOG_TEXT), (char *)"file-text-popup", args, n);
+ fd->file_text_names = make_filename_list();
+ fd->file_text_popup_label = XtCreateManagedWidget(FILE_TEXT_POPUP_LABEL, xmLabelWidgetClass, fd->file_text_popup, args, n);
+ XtCreateManagedWidget("sep", xmSeparatorWidgetClass, fd->file_text_popup, args, n);
+
+ /* filter text */
+ XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT), XmNpopupHandlerCallback, file_filter_popup_callback, (void *)fd);
+ fd->file_filter_popup = XmCreatePopupMenu(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT), (char *)"file-filter-popup", args, n);
+ fd->file_filter_names = make_filename_list();
+ fd->file_filter_popup_label = XtCreateManagedWidget(FILE_FILTER_POPUP_LABEL, xmLabelWidgetClass, fd->file_filter_popup, args, n);
+ XtCreateManagedWidget("sep", xmSeparatorWidgetClass, fd->file_filter_popup, args, n);
+ {
+ char *startup_filter;
+ startup_filter = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT));
+ if (startup_filter)
+ {
+ remember_filename(startup_filter, fd->file_filter_names);
+ XtFree(startup_filter);
+ }
+ }
+ XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT), XmNactivateCallback, file_filter_text_activate_callback, (void *)fd);
+
+ /* file directory */
+ XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_DIR_LIST), XmNpopupHandlerCallback, file_dir_popup_callback, (void *)fd);
+ fd->file_dir_popup = XmCreatePopupMenu(FSB_BOX(fd->dialog, XmDIALOG_DIR_LIST), (char *)"file-dir-popup", args, n);
+ fd->file_dir_popup_label = XtCreateManagedWidget(FILE_DIR_POPUP_LABEL, xmLabelWidgetClass, fd->file_dir_popup, args, n);
+ XtCreateManagedWidget("sep", xmSeparatorWidgetClass, fd->file_dir_popup, args, n);
+
+ /* file list */
+ XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_LIST), XmNpopupHandlerCallback, file_list_popup_callback, (void *)fd);
+ fd->file_list_popup = XmCreatePopupMenu(FSB_BOX(fd->dialog, XmDIALOG_LIST), (char *)"file-list-popup", args, n);
+ fd->file_list_popup_label = XtCreateManagedWidget(FILE_LIST_POPUP_LABEL, xmLabelWidgetClass, fd->file_list_popup, args, n);
+ XtCreateManagedWidget("sep", xmSeparatorWidgetClass, fd->file_list_popup, args, n);
+}
+
+
+
+/* ---------------- just-sounds (file-filters) ---------------- */
+
+static void file_change_directory_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* click in directory list */
+ file_pattern_info *fp = (file_pattern_info *)context;
+ char *leaving_dir;
+
+ {
+ /* save current directory list position */
+ position_t position = 0;
+ XmString *strs;
+ XtVaGetValues(w,
+ XmNtopItemPosition, &position,
+ XmNselectedItems, &strs,
+ NULL);
+ if (position > 1) /* 1 = .. */
+ {
+ char *filename = NULL;
+ filename = (char *)XmStringUnparse(strs[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ dirpos_update(fp->dir_list, filename, position);
+ XtFree(filename);
+ }
+ }
+
+ leaving_dir = mus_strdup(fp->last_dir);
+ if ((leaving_dir) &&
+ (leaving_dir[strlen(leaving_dir) - 1] == '/'))
+ leaving_dir[strlen(leaving_dir) - 1] = 0;
+
+ fp->reread_directory = true;
+ force_directory_reread_and_let_filename_change(fp->dialog);
+ fp->reread_directory = false;
+
+ if (leaving_dir)
+ {
+ position_t pos;
+ pos = dirpos_list_top(fp->dir_list, leaving_dir);
+ if (pos != POSITION_UNKNOWN)
+ XmListSetPos(w, pos);
+ free(leaving_dir);
+ }
+}
+
+
+static void sort_files_and_redisplay(file_pattern_info *fp)
+{
+ /* if just sorting, no need to read the directory */
+ dir_info *cur_dir;
+
+ cur_dir = fp->current_files;
+ if (cur_dir->len > 0)
+ {
+ XmString *names;
+ int i, new_selected_position = -1;
+ char *selected_filename = NULL;
+
+ {
+ XmString *strs;
+ int selections = 0;
+ XtVaGetValues(XmFileSelectionBoxGetChild(fp->dialog, XmDIALOG_LIST),
+ XmNselectedItems, &strs,
+ XmNselectedItemCount, &selections,
+ NULL);
+ if ((selections > 0) && (strs[0]))
+ selected_filename = (char *)XmStringUnparse(strs[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ }
+
+ snd_sort(fp->sorter_choice, cur_dir->files, cur_dir->len);
+
+ /* here we could use colored text to mark sound files, perhaps different colors for
+ * different chans (as in install-searcher-with-colors), but I would rather have
+ * used different background colors (less intrusive I think). As far as I can tell,
+ * this is impossible given the current XmList widget -- each item is an internal
+ * "Element", not a label widget or whatever, and the selection color, for example,
+ * is done by hand.
+ */
+
+ names = (XmString *)calloc(cur_dir->len, sizeof(XmString));
+ for (i = 0; i < cur_dir->len; i++)
+ {
+ names[i] = XmStringCreateLocalized(cur_dir->files[i]->full_filename);
+ if ((new_selected_position == -1) &&
+ (mus_strcmp(selected_filename, cur_dir->files[i]->full_filename)))
+ new_selected_position = i;
+ }
+
+ XtVaSetValues(fp->dialog,
+ XmNfileListItems, names,
+ XmNfileListItemCount, cur_dir->len,
+ XmNlistUpdated, true,
+ NULL);
+
+ if (new_selected_position >= 0)
+ ensure_list_row_visible(XmFileSelectionBoxGetChild(fp->dialog, XmDIALOG_LIST), new_selected_position);
+
+ for (i = 0; i < cur_dir->len; i++)
+ if (names[i])
+ XmStringFree(names[i]);
+ free(names);
+ }
+ else
+ {
+ /* nothing to sort, but make sure the files list is actually empty */
+ XtVaSetValues(fp->dialog,
+ XmNfileListItems, NULL,
+ XmNfileListItemCount, 0,
+ XmNlistUpdated, true,
+ NULL);
+ }
+}
+
+
+static void snd_directory_reader(Widget dialog, XmFileSelectionBoxCallbackStruct *info)
+{
+ /* replaces the FSB searchProc */
+ file_pattern_info *fp;
+ dir_info *cur_dir = NULL;
+ char *pattern = NULL, *our_dir = NULL;
+
+ XtVaGetValues(dialog, XmNuserData, &fp, NULL);
+ if (!(fp->dialog)) fp->dialog = dialog; /* can be null at initialization */
+
+ pattern = (char *)XmStringUnparse(info->pattern, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ our_dir = (char *)XmStringUnparse(info->dir, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+
+ /* get current directory contents, given filter and pattern */
+ if (mus_strcmp(pattern, "*"))
+ {
+ if (fp->filter_choice == NO_FILE_FILTER)
+ cur_dir = find_files_in_dir(our_dir);
+ else cur_dir = find_filtered_files_in_dir(our_dir, fp->filter_choice);
+ }
+ else cur_dir = find_filtered_files_in_dir_with_pattern(our_dir, fp->filter_choice, pattern);
+
+ if (fp->current_files) free_dir_info(fp->current_files);
+ fp->current_files = cur_dir;
+ if (pattern) XtFree(pattern);
+
+ /* set file_pattern_info->selected_filename list_slider_position from history */
+ {
+ position_t list_pos;
+ Widget file_list;
+ file_list = XmFileSelectionBoxGetChild(dialog, XmDIALOG_LIST);
+ list_pos = dirpos_list_top(fp->dir_list, our_dir);
+
+ /* post the sorted list in the dialog -- alphabetize by default */
+ sort_files_and_redisplay(fp);
+
+ if (list_pos != POSITION_UNKNOWN)
+ XmListSetPos(file_list, list_pos);
+ }
+
+ if ((fp->last_dir == NULL) ||
+ (!mus_strcmp(our_dir, fp->last_dir)))
+ {
+ if (fp->directory_watcher)
+ unmonitor_file(fp->directory_watcher);
+ fp->directory_watcher = NULL;
+ if (fp->last_dir) free(fp->last_dir);
+ fp->last_dir = mus_strdup(our_dir);
+ fp->reread_directory = false;
+ }
+
+ if (our_dir) XtFree(our_dir);
+}
+
+
+static void just_sounds_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ file_pattern_info *fp = (file_pattern_info *)context;
+ if (cb->set)
+ fp->filter_choice = JUST_SOUNDS_FILTER;
+ else fp->filter_choice = NO_FILE_FILTER;
+ fp->in_just_sounds_update = true;
+ force_directory_reread(fp->dialog);
+ fp->in_just_sounds_update = false;
+}
+
+
+/* -------- play selected file handlers -------- */
+
+typedef struct {
+ Widget dialog, play_button;
+ snd_info *player;
+} dialog_play_info;
+
+
+static void file_dialog_stop_playing(dialog_play_info *dp)
+{
+#if WITH_AUDIO
+ if ((dp->player) &&
+ (dp->player->playing))
+ {
+ stop_playing_sound(dp->player, PLAY_BUTTON_UNSET);
+ dp->player = NULL;
+ }
+#endif
+}
+
+
+void clear_deleted_snd_info(void *udp)
+{
+ dialog_play_info *dp = (dialog_play_info *)udp;
+#if WITH_AUDIO
+ dp->player = NULL;
+#endif
+}
+
+
+#if WITH_AUDIO
+static void play_selected_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ dialog_play_info *dp = (dialog_play_info *)context;
+ if (cb->set)
+ {
+ Widget wtmp;
+ char *filename = NULL;
+ if ((dp->player) &&
+ (dp->player->playing))
+ stop_playing_sound(dp->player, PLAY_BUTTON_UNSET);
+ wtmp = FSB_BOX(dp->dialog, XmDIALOG_TEXT);
+ filename = XmTextGetString(wtmp);
+ if (filename)
+ {
+ if (mus_file_probe(filename))
+ {
+ dp->player = make_sound_readable(filename, false);
+ dp->player->delete_me = (void *)dp;
+ if (dp->player)
+ play_sound(dp->player, 0, NO_END_SPECIFIED);
+ }
+ XtFree(filename);
+ }
+ }
+ else file_dialog_stop_playing(dp);
+}
+#endif
+
+
+static void add_play_and_just_sounds_buttons(Widget dialog, Widget parent, file_pattern_info *fp, dialog_play_info *dp)
+{
+ Widget rc;
+ int n;
+ Arg args[12];
+
+ n = 0;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ rc = XtCreateManagedWidget("filebuttons-rc", xmRowColumnWidgetClass, parent, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNset, just_sounds(ss)); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ fp->just_sounds_button = XtCreateManagedWidget("sound files only", xmToggleButtonWidgetClass, rc, args, n);
+ XtAddCallback(fp->just_sounds_button, XmNvalueChangedCallback, just_sounds_callback, (XtPointer)fp);
+
+#if WITH_AUDIO
+ n = 0;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNwidth, 20); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, rc, args, n);
+
+ n = 0;
+ /* XmNmarginLeft here refers to the space between the button and its label! */
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_END); n++;
+ dp->play_button = XtCreateWidget("play selected sound", xmToggleButtonWidgetClass, rc, args, n);
+
+ XtAddCallback(dp->play_button, XmNvalueChangedCallback, play_selected_callback, (XtPointer)dp);
+#endif
+}
+
+
+
+/* -------- File Open/View/Mix Dialogs -------- */
+
+typedef struct file_dialog_info {
+ read_only_t file_dialog_read_only;
+ Widget dialog;
+ Widget info_frame, info1, info2; /* labels giving info on selected file, or an error message */
+ file_pattern_info *fp;
+ dialog_play_info *dp;
+ void *unsound_directory_watcher; /* started if file doesn't exist, not a sound file, bogus header, etc (clears error msg if problem changed) */
+ void *info_filename_watcher; /* watch for change in selected file and repost info */
+ char *unsound_dirname, *unsound_filename;
+ char *info_filename;
+ file_popup_info *fpop;
+} file_dialog_info;
+
+
+static void open_file_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ open_file_dialog_help();
+}
+
+
+static void file_cancel_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_dialog_stop_playing((dialog_play_info *)context);
+ XtUnmanageChild (w);
+}
+
+
+static void file_wm_delete_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_dialog_stop_playing((dialog_play_info *)context);
+}
+
+
+static void post_sound_info(Widget info1, Widget info2, const char *filename, bool with_filename)
+{
+ /* filename is known[strongly believed] to be a sound file, etc */
+ XmString label;
+ char *buf;
+ buf = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, LABEL_BUFFER_SIZE, "%s%s%d chan%s, %d Hz, %.3f secs",
+ (with_filename) ? filename_without_directory(filename) : "",
+ (with_filename) ? ": " : "",
+ mus_sound_chans(filename),
+ (mus_sound_chans(filename) > 1) ? "s" : "",
+ mus_sound_srate(filename),
+ mus_sound_duration(filename));
+ label = XmStringCreateLocalized(buf);
+ XtVaSetValues(info1,
+ XmNlabelString, label,
+ NULL);
+ XmStringFree(label);
+ snprintf(buf, LABEL_BUFFER_SIZE, "%s, %s%s",
+ mus_header_type_name(mus_sound_header_type(filename)),
+ short_sample_type_name(mus_sound_sample_type(filename), filename),
+ snd_strftime(", %d-%b-%Y", mus_sound_write_date(filename)));
+ label = XmStringCreateLocalized(buf);
+ XtVaSetValues(info2, XmNlabelString, label, NULL);
+ XmStringFree(label);
+ free(buf);
+}
+
+
+static void post_file_info(file_dialog_info *fd, const char *filename)
+{
+#if WITH_AUDIO
+ XtManageChild(fd->dp->play_button);
+#endif
+ post_sound_info(fd->info1, fd->info2, filename, true);
+ if (!(XtIsManaged(fd->info1)))
+ XtManageChild(fd->info1);
+ if (!(XtIsManaged(fd->info2)))
+ XtManageChild(fd->info2);
+ if (!(XtIsManaged(fd->info_frame)))
+ XtManageChild(fd->info_frame);
+}
+
+
+static void unpost_file_info(file_dialog_info *fd)
+{
+#if WITH_AUDIO
+ if (XtIsManaged(fd->dp->play_button))
+ XtUnmanageChild(fd->dp->play_button);
+#endif
+ if (XtIsManaged(fd->info_frame))
+ XtUnmanageChild(fd->info_frame);
+
+ if (fd->info_filename_watcher)
+ {
+ fd->info_filename_watcher = unmonitor_file(fd->info_filename_watcher);
+ if (fd->info_filename) {free(fd->info_filename); fd->info_filename = NULL;}
+ }
+}
+
+
+static bool is_empty_file(const char *filename)
+{
+#ifndef _MSC_VER
+ struct stat statbuf;
+ if (stat(filename, &statbuf) >= 0)
+ return(statbuf.st_size == (mus_long_t)0);
+#endif
+ return(false);
+}
+
+
+static int local_error = MUS_NO_ERROR;
+static char *local_error_msg = NULL;
+static mus_error_handler_t *old_error_handler;
+
+static void local_error2snd(int type, char *msg)
+{
+ local_error = type;
+ if (local_error_msg) free(local_error_msg);
+ if (msg)
+ local_error_msg = mus_strdup(msg);
+ else local_error_msg = NULL;
+}
+
+
+static bool is_plausible_sound_file(const char *name)
+{
+ int err = MUS_NO_ERROR;
+ if (is_empty_file(name)) return(false);
+ old_error_handler = mus_error_set_handler(local_error2snd);
+ err = mus_header_read(name);
+ mus_error_set_handler(old_error_handler);
+ return((err == MUS_NO_ERROR) &&
+ (mus_header_type() != MUS_RAW));
+}
+
+
+static void file_dialog_select_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_dialog_info *fd = (file_dialog_info *)context;
+ XmString *strs;
+ char *filename = NULL;
+ XtVaGetValues(w, XmNselectedItems, &strs, NULL);
+ filename = (char *)XmStringUnparse(strs[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ if (filename)
+ {
+ if (is_plausible_sound_file(filename)) /* forces header read to avoid later unwanted error possibility */
+ post_file_info(fd, filename);
+ XtFree(filename);
+ }
+ else unpost_file_info(fd);
+
+ {
+ /* save current list position */
+ position_t position = 0;
+ XtVaGetValues(w, XmNtopItemPosition, &position, NULL);
+ dirpos_update(fd->fp->dir_list, fd->fp->current_files->dir_name, position);
+ }
+}
+
+
+static void unpost_if_filter_changed(Widget w, XtPointer context, XtPointer info)
+{
+ unpost_file_info((file_dialog_info *)context);
+}
+
+
+static void watch_filename_change(Widget w, XtPointer context, XtPointer info)
+{
+ /* try to move file list to show possible matches,
+ * if a sound file, show info
+ */
+ file_dialog_info *fd = (file_dialog_info *)context;
+ char *filename = NULL;
+
+ filename = XmTextGetString(w);
+ if ((filename) && (*filename))
+ {
+ XmStringTable files;
+ Widget file_list;
+ int num_files = 0, pos = -1, l, u;
+
+ file_list = FSB_BOX(fd->dialog, XmDIALOG_LIST);
+ XtVaGetValues(fd->dialog,
+ XmNfileListItemCount, &num_files,
+ XmNfileListItems, &files, /* do not free */
+ NULL);
+ l = 0; /* hooray for Knuth... */
+ u = num_files - 1;
+ while (true)
+ {
+ int i, comp;
+ char *file_list_file = NULL;
+
+ if (u < l) break;
+ i = (l + u) / 2;
+ file_list_file = (char *)XmStringUnparse(files[i], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL); /* p453 */
+ comp = strcmp(file_list_file, filename);
+ XtFree(file_list_file);
+ pos = i + 1;
+ if (comp == 0)
+ break;
+ if (comp < 0) /* files[i] less than filename */
+ l = i + 1;
+ else u = i - 1;
+ }
+ if (pos > 0)
+ ensure_list_row_visible(file_list, pos);
+
+ if ((mus_file_probe(filename)) &&
+ (!is_directory(filename)))
+ {
+ if (is_sound_file(filename))
+ post_file_info(fd, filename);
+ }
+ }
+ if (filename) XtFree(filename);
+}
+
+
+static void focus_filename_text_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtAddCallback(w, XmNvalueChangedCallback, watch_filename_change, context);
+}
+
+
+static void unfocus_filename_text_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtRemoveCallback(w, XmNvalueChangedCallback, watch_filename_change, context);
+}
+
+
+static bool file_is_directory(Widget dialog)
+{
+ char *filename = NULL;
+ bool is_dir = false;
+ filename = XmTextGetString(FSB_BOX(dialog, XmDIALOG_TEXT));
+ if (filename)
+ {
+ is_dir = is_directory(filename);
+ XtFree(filename);
+ }
+ return(is_dir);
+}
+
+
+static bool file_is_nonexistent_directory(Widget dialog)
+{
+ char *filename = NULL;
+ bool is_nonexistent_dir = false;
+ filename = XmTextGetString(FSB_BOX(dialog, XmDIALOG_TEXT));
+ if (filename)
+ {
+ int len;
+ len = strlen(filename);
+ if ((!mus_file_probe(filename)) &&
+ (filename[len - 1] == '/'))
+ {
+ int i;
+ /* check that there's some hope of making this directory */
+ for (i = len - 2; i > 0; i--)
+ if (filename[i] == '/')
+ {
+ filename[i] = '\0';
+ is_nonexistent_dir = is_directory(filename);
+ break;
+ }
+ }
+ XtFree(filename);
+ }
+ return(is_nonexistent_dir);
+}
+
+
+static void reflect_text_in_open_button(Widget w, XtPointer context, XtPointer info)
+{
+ file_dialog_info *fd = (file_dialog_info *)context;
+ /* w here is the text widget, not the button */
+ XtSetSensitive(FSB_BOX(fd->dialog, XmDIALOG_OK_BUTTON), (!(file_is_directory(fd->dialog))));
+}
+
+
+static void multifile_completer(widget_t w, void *data)
+{
+ watch_filename_change(w, (XtPointer)data, NULL);
+}
+
+
+#define FILE_DIALOG_WIDTH 500
+#define FILE_DIALOG_HEIGHT 500
+
+static file_dialog_info *make_file_dialog(read_only_t read_only, char *title, char *select_title,
+ XtCallbackProc file_ok_proc, XtCallbackProc file_help_proc)
+{
+ /* file selection dialog box with added "Just Sound Files" and "Play selected" toggle buttons and info area,
+ * popups, and so on. This applies to the Open, Mix, and Insert dialogs. The save-as
+ * dialogs are handled by make_save_as_dialog below
+ */
+ Widget w;
+ file_dialog_info *fd;
+ Arg args[32];
+ int n;
+ XmString s1, s2, ok_label, filter_list_label, cancel_label;
+ Widget wtmp = NULL, rc1, rc2;
+
+ fd = (file_dialog_info *)calloc(1, sizeof(file_dialog_info));
+ fd->fp = (file_pattern_info *)calloc(1, sizeof(file_pattern_info));
+ fd->fp->in_just_sounds_update = false;
+ if (just_sounds(ss))
+ fd->fp->filter_choice = JUST_SOUNDS_FILTER;
+ else fd->fp->filter_choice = NO_FILE_FILTER;
+
+ fd->dp = (dialog_play_info *)calloc(1, sizeof(dialog_play_info));
+ fd->file_dialog_read_only = read_only;
+ fd->fpop = (file_popup_info *)calloc(1, sizeof(file_popup_info));
+ fd->fpop->fp = fd->fp;
+
+ fd->fp->dir_list = make_dirpos_list();
+
+ w = MAIN_SHELL(ss);
+
+ s1 = XmStringCreateLocalized(select_title);
+ s2 = XmStringCreateLocalized(title);
+ ok_label = XmStringCreateLocalized(title);
+ filter_list_label = XmStringCreateLocalized((char *)"files listed:");
+ cancel_label = XmStringCreateLocalized((char *)I_GO_AWAY);
+
+ n = 0;
+ if (open_file_dialog_directory(ss))
+ {
+ XmString dirstr;
+ dirstr = XmStringCreateLocalized(open_file_dialog_directory(ss));
+ XtSetArg(args[n], XmNdirectory, dirstr); n++;
+ }
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNokLabelString, ok_label); n++;
+ XtSetArg(args[n], XmNselectionLabelString, s1); n++; /* "open", "mix", "insert", "open read-only:" */
+ XtSetArg(args[n], XmNdialogTitle, s2); n++;
+ XtSetArg(args[n], XmNfilterLabelString, filter_list_label); n++; /* default label 'Filter' is confusing in this context */
+ XtSetArg(args[n], XmNfileFilterStyle, XmFILTER_HIDDEN_FILES); n++; /* the dot files mostly just get in the way */
+ XtSetArg(args[n], XmNcancelLabelString, cancel_label); n++;
+ XtSetArg(args[n], XmNuserData, (XtPointer)(fd->fp)); n++;
+ XtSetArg(args[n], XmNfileSearchProc, snd_directory_reader); n++; /* over-ride Motif's directory reader altogether */
+ XtSetArg(args[n], XmNwidth, FILE_DIALOG_WIDTH); n++;
+
+ XtSetArg(args[n], XmNheight, FILE_DIALOG_HEIGHT); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+
+ fd->dialog = XmCreateFileSelectionDialog(w, title, args, n);
+ fd->fp->dialog = fd->dialog;
+ fd->dp->dialog = fd->dialog;
+ fd->fpop->dialog = fd->dialog;
+
+ XtUnmanageChild(FSB_BOX(fd->dialog, XmDIALOG_DIR_LIST_LABEL)); /* these are obvious */
+ XtUnmanageChild(FSB_BOX(fd->dialog, XmDIALOG_LIST_LABEL));
+ XtUnmanageChild(FSB_BOX(fd->dialog, XmDIALOG_APPLY_BUTTON)); /* "Filter" button is useless */
+
+ XtVaSetValues(FSB_BOX(fd->dialog, XmDIALOG_FILTER_LABEL), XmNbackground, ss->basic_color, NULL);
+ XtVaSetValues(FSB_BOX(fd->dialog, XmDIALOG_SELECTION_LABEL), XmNbackground, ss->basic_color, NULL);
+
+ XmStringFree(s1);
+ XmStringFree(s2);
+ XmStringFree(ok_label);
+ XmStringFree(filter_list_label);
+ XmStringFree(cancel_label);
+
+ /* -------- play and just-sounds buttons and info area */
+ rc1 = XtVaCreateManagedWidget("filebuttons-rc1",
+ xmRowColumnWidgetClass, fd->dialog,
+ XmNorientation, XmVERTICAL,
+ NULL);
+
+ add_play_and_just_sounds_buttons(fd->dialog, rc1, fd->fp, fd->dp);
+
+ fd->info_frame = XtVaCreateWidget("", xmFrameWidgetClass, rc1, NULL);
+ rc2 = XtVaCreateManagedWidget("info-rc2",
+ xmRowColumnWidgetClass, fd->info_frame,
+ XmNorientation, XmVERTICAL,
+ XmNbackground, ss->highlight_color,
+ NULL);
+ fd->info1 = XtVaCreateManagedWidget("", xmLabelWidgetClass, rc2, XmNbackground, ss->highlight_color, NULL);
+ fd->info2 = XtVaCreateManagedWidget("", xmLabelWidgetClass, rc2, XmNbackground, ss->highlight_color, NULL);
+
+
+ /* -------- Snd-like color schemes */
+ color_file_selection_box(fd->dialog);
+ XtVaSetValues(fd->fp->just_sounds_button, XmNselectColor, ss->selection_color, NULL);
+#if WITH_AUDIO
+ XtVaSetValues(fd->dp->play_button, XmNselectColor, ss->selection_color, NULL);
+#endif
+
+ /* -------- completions */
+
+ wtmp = FSB_BOX(fd->dialog, XmDIALOG_TEXT);
+ add_completer_to_builtin_textfield(wtmp, add_completer_func_with_multicompleter(sound_filename_completer, (void *)fd, multifile_completer));
+
+ XtAddCallback(wtmp, XmNfocusCallback, focus_filename_text_callback, (XtPointer)fd);
+ XtAddCallback(wtmp, XmNlosingFocusCallback, unfocus_filename_text_callback, (XtPointer)fd);
+
+ wtmp = FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT);
+ add_completer_to_builtin_textfield(wtmp, add_completer_func(filename_completer, NULL));
+
+ XtAddCallback(wtmp, XmNvalueChangedCallback, unpost_if_filter_changed, (XtPointer)fd);
+
+ /* -------- base button callbacks */
+ XtAddCallback(fd->dialog, XmNokCallback, file_ok_proc, (XtPointer)fd);
+ XtAddCallback(fd->dialog, XmNcancelCallback, file_cancel_callback, (XtPointer)(fd->dp));
+ XtAddCallback(fd->dialog, XmNhelpCallback, file_help_proc, NULL);
+ XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_LIST), XmNbrowseSelectionCallback, file_dialog_select_callback, (XtPointer)fd);
+
+ /* -------- single click in directory list */
+ XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_DIR_LIST), XmNbrowseSelectionCallback, file_change_directory_callback, (XtPointer)(fd->fp));
+
+ /* -------- the WM 'close' button */
+ {
+ Atom wm_delete_window;
+ wm_delete_window = XmInternAtom(MAIN_DISPLAY(ss), (char *)"WM_DELETE_WINDOW", false);
+ XmAddWMProtocolCallback(XtParent(fd->dialog), wm_delete_window, file_wm_delete_callback, (XtPointer)(fd->dp));
+ }
+
+ /* -------- special popups */
+ add_file_popups(fd->fpop);
+
+ XtSetSensitive(FSB_BOX(fd->dialog, XmDIALOG_OK_BUTTON), (!(file_is_directory(fd->dialog))));
+ XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_TEXT), XmNvalueChangedCallback, reflect_text_in_open_button, (void *)fd);
+
+ return(fd);
+}
+
+
+/* -------- File:Open/View dialogs -------- */
+
+
+static void file_open_error(const char *error_msg, file_dialog_info *fd)
+{
+ XmString msg;
+ msg = XmStringCreateLocalized((char *)error_msg);
+ XtVaSetValues(fd->info1,
+ XmNlabelString, msg,
+ NULL);
+ XmStringFree(msg);
+
+ if (XtIsManaged(fd->info2))
+ XtUnmanageChild(fd->info2);
+ if (!(XtIsManaged(fd->info_frame)))
+ XtManageChild(fd->info_frame);
+}
+
+
+static void redirect_file_open_error(const char *error_msg, void *ufd)
+{
+ /* called from snd_error, redirecting error handling to the dialog */
+ file_open_error(error_msg, (file_dialog_info *)ufd);
+}
+
+
+static void open_modify_callback(Widget w, XtPointer context, XtPointer info);
+
+static void unpost_open_modify_error(file_dialog_info *fd)
+{
+ Widget dialog_filename_text;
+ if (XtIsManaged(fd->info_frame))
+ XtUnmanageChild(fd->info_frame);
+ dialog_filename_text = FSB_BOX(fd->dialog, XmDIALOG_TEXT);
+ if (dialog_filename_text)
+ XtRemoveCallback(dialog_filename_text, XmNmodifyVerifyCallback, open_modify_callback, (XtPointer)fd);
+
+ if (fd->unsound_directory_watcher)
+ {
+ fd->unsound_directory_watcher = unmonitor_file(fd->unsound_directory_watcher);
+ if (fd->unsound_dirname) {free(fd->unsound_dirname); fd->unsound_dirname = NULL;}
+ if (fd->unsound_filename) {free(fd->unsound_filename); fd->unsound_filename = NULL;}
+ }
+}
+
+
+static void open_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_dialog_info *fd = (file_dialog_info *)context;
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ if (!(fd->fp->in_just_sounds_update)) /* auto trigger from just_sounds button -- unwanted! */
+ unpost_open_modify_error(fd);
+ cbs->doit = true; /* fixup filename elsewhere -- returning false here makes the thing beep! */
+}
+
+
+static void clear_error_if_open_changes(Widget dialog, file_dialog_info *data)
+{
+ Widget dialog_filename_text;
+ dialog_filename_text = FSB_BOX(dialog, XmDIALOG_TEXT);
+ if (dialog_filename_text)
+ XtAddCallback(dialog_filename_text, XmNmodifyVerifyCallback, open_modify_callback, (XtPointer)data);
+}
+
+
+static void file_open_ok_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_dialog_info *fd = (file_dialog_info *)context;
+ XmFileSelectionBoxCallbackStruct *cbs = (XmFileSelectionBoxCallbackStruct *)info;
+ char *filename = NULL;
+ if (XmGetFocusWidget(fd->dialog) == FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT)) return;
+
+ filename = (char *)XmStringUnparse(cbs->value, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ if ((!filename) || (!(*filename)))
+ {
+ file_open_error("no filename given", fd);
+ clear_error_if_open_changes(fd->dialog, fd);
+ }
+ else
+ {
+ file_dialog_stop_playing(fd->dp);
+ if (!(is_directory(filename))) /* this can be a directory name if the user clicked 'ok' when he meant 'cancel' */
+ {
+ snd_info *sp;
+ redirect_snd_error_to(redirect_file_open_error, (void *)fd);
+ ss->requestor_dialog = w;
+ ss->open_requestor = FROM_OPEN_DIALOG;
+ ss->open_requestor_data = NULL;
+ sp = snd_open_file(filename, fd->file_dialog_read_only);
+ redirect_snd_error_to(NULL, NULL);
+ if (sp)
+ {
+ XtUnmanageChild(w);
+ remember_filename(filename, fd->fpop->file_text_names);
+ select_channel(sp, 0);
+ }
+ else
+ {
+ if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
+ {
+ clear_error_if_open_changes(fd->dialog, fd);
+ /* whatever the error was, I think it is correct here to unpost the error
+ * if the underlying file is either changed or created.
+ */
+ }
+ }
+ if (filename) XtFree(filename);
+ }
+ else
+ {
+ char *str;
+ str = mus_format("%s is a directory", filename);
+ file_open_error(str, fd);
+ clear_error_if_open_changes(fd->dialog, fd);
+ free(str);
+ }
+ }
+}
+
+
+static file_dialog_info *odat = NULL;
+
+widget_t make_open_file_dialog(read_only_t read_only, bool managed)
+{
+ char *title, *select_title;
+ if (read_only == FILE_READ_ONLY)
+ {
+ title = (char *)"View";
+ select_title = (char *)"open read-only:";
+ }
+ else
+ {
+ title = (char *)"Open";
+ select_title = (char *)"open:";
+ }
+ if (!odat)
+ {
+ XmString cancel_label;
+ odat = make_file_dialog(read_only, title, select_title, file_open_ok_callback, open_file_help_callback);
+ set_dialog_widget(FILE_OPEN_DIALOG, odat->dialog);
+
+ /* now preload last n files opened before this point */
+ preload_filenames(odat->fpop->file_text_names);
+
+ cancel_label = XmStringCreateLocalized((char *)I_GO_AWAY);
+ XtVaSetValues(odat->dialog, XmNcancelLabelString, cancel_label, NULL);
+ XmStringFree(cancel_label);
+ }
+ else
+ {
+ if (odat->file_dialog_read_only != read_only)
+ {
+ XmString s1, s2;
+ s1 = XmStringCreateLocalized(select_title);
+ s2 = XmStringCreateLocalized(title);
+ XtVaSetValues(odat->dialog,
+ XmNselectionLabelString, s1,
+ XmNdialogTitle, s2,
+ XmNokLabelString, s2, /* "ok" button label can be either "View" or "Open" */
+ NULL);
+ XmStringFree(s1);
+ XmStringFree(s2);
+ }
+ odat->file_dialog_read_only = read_only;
+ if (odat->fp->reread_directory)
+ {
+ force_directory_reread(odat->dialog);
+ odat->fp->reread_directory = false;
+ }
+ }
+ if ((managed) && (!(XtIsManaged(odat->dialog))))
+ XtManageChild(odat->dialog);
+
+ return(odat->dialog);
+}
+
+
+
+/* -------- File:Mix dialog -------- */
+
+static void file_mix_ok_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmFileSelectionBoxCallbackStruct *cbs = (XmFileSelectionBoxCallbackStruct *)info;
+ file_dialog_info *fd = (file_dialog_info *)context;
+ char *filename = NULL;
+
+ filename = (char *)XmStringUnparse(cbs->value, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ if ((!filename) || (!(*filename)))
+ {
+ file_open_error("no filename given", fd);
+ clear_error_if_open_changes(fd->dialog, fd);
+ }
+ else
+ {
+ file_dialog_stop_playing(fd->dp);
+ if (!(is_directory(filename))) /* this can be a directory name if the user clicked 'ok' when he meant 'cancel' */
+ {
+ int id_or_error;
+ snd_info *sp;
+ sp = any_selected_sound();
+ redirect_snd_error_to(redirect_file_open_error, (void *)fd);
+ ss->requestor_dialog = w;
+ ss->open_requestor = FROM_MIX_DIALOG;
+ ss->open_requestor_data = NULL;
+ id_or_error = mix_complete_file_at_cursor(sp, filename);
+ /* "id_or_error" here is either one of the mix id's or an error indication such as MIX_FILE_NO_MIX */
+ /* the possible error conditions have been checked already, or go through snd_error */
+ redirect_snd_error_to(NULL, NULL);
+ if (id_or_error < 0) /* actually -1 .. -3 */
+ {
+ if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
+ {
+ clear_error_if_open_changes(fd->dialog, fd);
+ }
+ }
+ else
+ {
+ status_report(sp, "%s mixed in at cursor", filename);
+ remember_filename(filename, fd->fpop->file_text_names);
+ }
+ if (filename) XtFree(filename);
+ }
+ else
+ {
+ char *str;
+ str = mus_format("%s is a directory", filename);
+ file_open_error(str, fd);
+ clear_error_if_open_changes(fd->dialog, fd);
+ free(str);
+ }
+ }
+}
+
+
+static void mix_file_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ mix_file_dialog_help();
+}
+
+
+static file_dialog_info *mdat = NULL;
+
+static Xen mix_open_file_watcher(Xen hook_or_reason)
+{
+ if ((mdat->dialog) &&
+ (XtIsManaged(mdat->dialog)))
+ set_sensitive(FSB_BOX(mdat->dialog, XmDIALOG_OK_BUTTON), (bool)any_selected_sound());
+ return(Xen_false);
+}
+
+Xen_wrap_1_arg(mix_open_file_watcher_w, mix_open_file_watcher)
+
+
+
+widget_t make_mix_file_dialog(bool managed)
+{
+ /* called from the menu */
+ if (!mdat)
+ {
+ mdat = make_file_dialog(FILE_READ_ONLY, (char *)"Mix Sound", (char *)"mix in:", file_mix_ok_callback, mix_file_help_callback);
+ set_dialog_widget(FILE_MIX_DIALOG, mdat->dialog);
+ Xen_add_to_hook_list(ss->snd_open_file_hook, mix_open_file_watcher_w, "mix-dialog-open-file-watcher", "mix dialog's open-file-hook handler");
+ }
+ else
+ {
+ if (mdat->fp->reread_directory)
+ {
+ force_directory_reread(mdat->dialog);
+ mdat->fp->reread_directory = false;
+ }
+ }
+ if ((managed) && (!XtIsManaged(mdat->dialog)))
+ XtManageChild(mdat->dialog);
+ return(mdat->dialog);
+}
+
+
+/* -------- File:Insert dialog -------- */
+
+static void file_insert_ok_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmFileSelectionBoxCallbackStruct *cbs = (XmFileSelectionBoxCallbackStruct *)info;
+ file_dialog_info *fd = (file_dialog_info *)context;
+ char *filename = NULL;
+
+ filename = (char *)XmStringUnparse(cbs->value, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ if ((!filename) || (!(*filename)))
+ {
+ file_open_error("no filename given", fd);
+ clear_error_if_open_changes(fd->dialog, fd);
+ }
+ else
+ {
+ file_dialog_stop_playing(fd->dp);
+ if (!(is_directory(filename))) /* this can be a directory name if the user clicked 'ok' when he meant 'cancel' */
+ {
+ bool ok;
+ snd_info *sp;
+ sp = any_selected_sound();
+ ss->requestor_dialog = w;
+ ss->open_requestor = FROM_INSERT_DIALOG;
+ ss->open_requestor_data = NULL;
+ redirect_snd_error_to(redirect_file_open_error, (void *)fd);
+ ok = insert_complete_file_at_cursor(sp, filename);
+ redirect_snd_error_to(NULL, NULL);
+ if (!ok)
+ {
+ if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
+ {
+ clear_error_if_open_changes(fd->dialog, fd);
+ /* ideally insert_complete_file would return an indication of what the error was... */
+ }
+ }
+ else
+ {
+ status_report(sp, "%s inserted at cursor", filename);
+ remember_filename(filename, fd->fpop->file_text_names);
+ }
+ if (filename) XtFree(filename);
+ }
+ else
+ {
+ char *str;
+ str = mus_format("%s is a directory", filename);
+ file_open_error(str, fd);
+ clear_error_if_open_changes(fd->dialog, fd);
+ free(str);
+ }
+ }
+}
+
+
+static void insert_file_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ insert_file_dialog_help();
+}
+
+
+static file_dialog_info *idat = NULL;
+
+static Xen insert_open_file_watcher(Xen hook_or_reason)
+{
+ if ((idat->dialog) &&
+ (XtIsManaged(idat->dialog)))
+ set_sensitive(FSB_BOX(idat->dialog, XmDIALOG_OK_BUTTON), (bool)any_selected_sound());
+ return(Xen_false);
+}
+
+Xen_wrap_1_optional_arg(insert_open_file_watcher_w, insert_open_file_watcher)
+
+widget_t make_insert_file_dialog(bool managed)
+{
+ if (!idat)
+ {
+ idat = make_file_dialog(FILE_READ_ONLY, (char *)"Insert Sound", (char *)"insert:", file_insert_ok_callback, insert_file_help_callback);
+ set_dialog_widget(FILE_INSERT_DIALOG, idat->dialog);
+ Xen_add_to_hook_list(ss->snd_open_file_hook, insert_open_file_watcher_w, "insert-dialog-open-file-watcher", "insert dialog's open-file-hook handler");
+ }
+ else
+ {
+ if (idat->fp->reread_directory)
+ {
+ force_directory_reread(idat->dialog);
+ idat->fp->reread_directory = false;
+ }
+ }
+ if ((managed) && (!XtIsManaged(idat->dialog)))
+ XtManageChild(idat->dialog);
+ return(idat->dialog);
+}
+
+
+/* -------- reflect outside changes -------- */
+
+void set_open_file_play_button(bool val)
+{
+#if WITH_AUDIO
+ if ((odat) && (odat->dp->play_button))
+ XmToggleButtonSetState(odat->dp->play_button, (Boolean)val, false);
+ if ((mdat) && (mdat->dp->play_button))
+ XmToggleButtonSetState(mdat->dp->play_button, (Boolean)val, false);
+ if ((idat) && (idat->dp->play_button))
+ XmToggleButtonSetState(idat->dp->play_button, (Boolean)val, false);
+#endif
+}
+
+
+void alert_new_file(void)
+{
+ if (ss->file_monitor_ok) return;
+ /* ideally this would include the save-as dialogs */
+ if (odat)
+ {
+ odat->fp->reread_directory = true;
+ if (XtIsManaged(odat->dialog))
+ {
+ force_directory_reread(odat->dialog);
+ odat->fp->reread_directory = false;
+ }
+ }
+ if (mdat)
+ {
+ mdat->fp->reread_directory = true;
+ if (XtIsManaged(mdat->dialog))
+ {
+ force_directory_reread(mdat->dialog);
+ mdat->fp->reread_directory = false;
+ }
+ }
+ if (idat)
+ {
+ idat->fp->reread_directory = true;
+ if (XtIsManaged(idat->dialog))
+ {
+ force_directory_reread(idat->dialog);
+ idat->fp->reread_directory = false;
+ }
+ }
+}
+
+
+void reflect_just_sounds(void)
+{
+ if ((odat) && (odat->fp->just_sounds_button))
+ XmToggleButtonSetState(odat->fp->just_sounds_button, just_sounds(ss), true);
+ if ((mdat) && (mdat->fp->just_sounds_button))
+ XmToggleButtonSetState(mdat->fp->just_sounds_button, just_sounds(ss), true);
+ if ((idat) && (idat->fp->just_sounds_button))
+ XmToggleButtonSetState(idat->fp->just_sounds_button, just_sounds(ss), true);
+}
+
+
+
+/* ---------------- file data panel ---------------- */
+
+#define NUM_VISIBLE_HEADERS 5
+
+char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, mus_header_t *header_type,
+ mus_sample_t *sample_type, mus_long_t *location, mus_long_t *samples, int min_chan)
+{
+ char *str;
+ int n;
+ int res;
+ int *ns = NULL;
+ fdat->error_widget = NOT_A_SCANF_WIDGET;
+ fdat->scanf_widget = NOT_A_SCANF_WIDGET;
+
+ if ((srate) && (fdat->srate_text))
+ {
+ str = XmTextGetString(fdat->srate_text);
+ fdat->scanf_widget = SRATE_WIDGET;
+ if ((str) && (*str))
+ {
+ (*srate) = string_to_int(str, 1, "srate");
+ XtFree(str);
+ }
+ else snd_error_without_format("no srate?");
+ }
+
+ if ((chans) && (fdat->chans_text))
+ {
+ str = XmTextGetString(fdat->chans_text);
+ fdat->scanf_widget = CHANS_WIDGET;
+ if ((str) && (*str))
+ {
+ (*chans) = string_to_int(str, min_chan, "chans");
+ XtFree(str);
+ }
+ else
+ {
+ if (min_chan > 0)
+ snd_error_without_format("no chans?");
+ }
+ }
+
+ if ((location) && (fdat->location_text))
+ {
+ str = XmTextGetString(fdat->location_text);
+ fdat->scanf_widget = DATA_LOCATION_WIDGET;
+ if ((str) && (*str))
+ {
+ (*location) = string_to_mus_long_t(str, 0, "data location");
+ XtFree(str);
+ }
+ else snd_error_without_format("no data location?");
+ }
+
+ if ((samples) && (fdat->samples_text))
+ {
+ str = XmTextGetString(fdat->samples_text);
+ fdat->scanf_widget = SAMPLES_WIDGET;
+ if ((str) && (*str))
+ {
+ (*samples) = string_to_mus_long_t(str, 0, "samples");
+ XtFree(str);
+ }
+ else snd_error_without_format("no samples?");
+ }
+ fdat->scanf_widget = SAMPLES_WIDGET;
+
+ if ((header_type) && (fdat->header_type_list))
+ {
+ res = XmListGetSelectedPos(fdat->header_type_list, &ns, &n);
+ if (res)
+ {
+ (*header_type) = position_to_header_type(ns[0] - 1);
+ fdat->current_header_type = (*header_type);
+ free(ns);
+ ns = NULL;
+ }
+ }
+
+ if ((sample_type) && (fdat->sample_type_list))
+ {
+ res = XmListGetSelectedPos(fdat->sample_type_list, &ns, &n);
+ if (res)
+ {
+ (*sample_type) = position_to_sample_type(fdat->current_header_type, ns[0] - 1);
+ fdat->current_sample_type = (*sample_type);
+ free(ns);
+ ns = NULL;
+ }
+ }
+
+ if (fdat->comment_text)
+ {
+ char *comment = NULL;
+ comment = XmTextGetString(fdat->comment_text);
+ if (comment)
+ {
+ str = mus_strdup(comment);
+ XtFree(comment);
+ return(str);
+ }
+ }
+
+ return(NULL);
+}
+
+
+#define IGNORE_DATA_LOCATION -1
+#define IGNORE_SAMPLES MUS_UNKNOWN_SAMPLE
+#define IGNORE_CHANS -1
+#define IGNORE_SRATE -1
+#define IGNORE_HEADER_TYPE MUS_UNKNOWN_HEADER
+
+static void set_file_dialog_sound_attributes(file_data *fdat, mus_header_t header_type, mus_sample_t sample_type,
+ int srate, int chans, mus_long_t location, mus_long_t samples, char *comment)
+{
+ int i;
+ const char **fl = NULL;
+ XmString *strs;
+
+ if (header_type != IGNORE_HEADER_TYPE)
+ fdat->current_header_type = header_type;
+ else fdat->current_header_type = MUS_RAW;
+ fdat->current_sample_type = sample_type;
+ fl = header_type_and_sample_type_to_position(fdat, fdat->current_header_type, fdat->current_sample_type);
+ if (fl == NULL) return;
+
+ if ((header_type != IGNORE_HEADER_TYPE) &&
+ (fdat->header_type_list))
+ {
+ XmListSelectPos(fdat->header_type_list, fdat->header_type_pos + 1, false);
+ ensure_list_row_visible(fdat->header_type_list, fdat->header_type_pos + 1);
+ }
+
+ strs = (XmString *)malloc(fdat->sample_types * sizeof(XmString));
+ for (i = 0; i < fdat->sample_types; i++)
+ strs[i] = XmStringCreateLocalized((char *)fl[i]);
+ XtVaSetValues(fdat->sample_type_list,
+ XmNitems, strs,
+ XmNitemCount, fdat->sample_types,
+ NULL);
+ for (i = 0; i < fdat->sample_types; i++)
+ XmStringFree(strs[i]);
+ free(strs);
+ XmListSelectPos(fdat->sample_type_list, fdat->sample_type_pos + 1, false);
+ ensure_list_row_visible(fdat->sample_type_list, fdat->sample_type_pos + 1);
+
+ if ((srate != IGNORE_SRATE) &&
+ (fdat->srate_text))
+ widget_int_to_text(fdat->srate_text, srate);
+
+ if ((chans != IGNORE_CHANS) &&
+ (fdat->chans_text))
+ widget_int_to_text(fdat->chans_text, chans);
+
+ if (fdat->comment_text)
+ XmTextSetString(fdat->comment_text, comment);
+
+ if ((location != IGNORE_DATA_LOCATION) &&
+ (fdat->location_text))
+ widget_mus_long_t_to_text(fdat->location_text, location);
+
+ if ((samples != IGNORE_SAMPLES) &&
+ (fdat->samples_text))
+ widget_mus_long_t_to_text(fdat->samples_text, samples);
+}
+
+
+/* -------- error handling -------- */
+
+/* if an error occurs, a callback is added to the offending text widget, and an error is
+ * posted in the error_text label. When the user modifies the bad entry, the callback
+ * erases the error message, and removes itself from the text widget.
+ */
+
+static void clear_dialog_error(file_data *fd)
+{
+ if (XtIsManaged(fd->error_text))
+ {
+ XtUnmanageChild(fd->error_text);
+ if (fd->comment_text)
+ {
+ XtVaSetValues(fd->comment_text,
+ XmNbottomAttachment, XmATTACH_FORM,
+ NULL);
+ }
+ }
+}
+
+
+static void show_dialog_error(file_data *fd)
+{
+ if (!(XtIsManaged(fd->error_text)))
+ {
+ if (fd->comment_text)
+ {
+ XtVaSetValues(fd->comment_text,
+ XmNbottomAttachment, XmATTACH_WIDGET,
+ XmNbottomWidget, fd->error_text,
+ NULL);
+ }
+ XtManageChild(fd->error_text);
+ }
+}
+
+
+static void post_file_dialog_error(const char *error_msg, file_data *fd)
+{
+ XmString msg;
+ msg = XmStringCreateLocalized((char *)error_msg);
+ XtVaSetValues(fd->error_text,
+ XmNbackground, ss->yellow,
+ XmNlabelString, msg,
+ NULL);
+ XmStringFree(msg);
+ show_dialog_error(fd);
+}
+
+
+static void redirect_post_file_dialog_error(const char *error_msg, void *ufd)
+{
+ post_file_dialog_error(error_msg, (file_data *)ufd);
+}
+
+
+static void filename_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_data *fd = (file_data *)context;
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ Widget dialog_filename_text;
+ clear_dialog_error(fd);
+ dialog_filename_text = FSB_BOX(fd->dialog, XmDIALOG_TEXT);
+ if (dialog_filename_text) XtRemoveCallback(dialog_filename_text, XmNmodifyVerifyCallback, filename_modify_callback, context);
+ cbs->doit = true;
+}
+
+
+static void clear_error_if_filename_changes(Widget dialog, file_data *data)
+{
+ Widget dialog_filename_text;
+ dialog_filename_text = FSB_BOX(dialog, XmDIALOG_TEXT);
+ if (dialog_filename_text)
+ XtAddCallback(dialog_filename_text, XmNmodifyVerifyCallback, filename_modify_callback, (XtPointer)data);
+}
+
+
+static void chans_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_data *fd = (file_data *)context;
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ clear_dialog_error(fd);
+ XtRemoveCallback(fd->chans_text, XmNmodifyVerifyCallback, chans_modify_callback, context);
+ cbs->doit = true;
+}
+
+
+static void clear_error_if_chans_changes(Widget dialog, file_data *fd)
+{
+ if (fd->chans_text) XtAddCallback(fd->chans_text, XmNmodifyVerifyCallback, chans_modify_callback, (XtPointer)fd);
+}
+
+
+static void panel_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_data *fd = (file_data *)context;
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ clear_dialog_error(fd);
+ XtRemoveCallback(w, XmNmodifyVerifyCallback, panel_modify_callback, context);
+ cbs->doit = true;
+}
+
+
+static void clear_error_if_panel_changes(Widget dialog, file_data *fd)
+{
+ Widget baddy;
+ switch (fd->error_widget)
+ {
+ case SRATE_WIDGET: baddy = fd->srate_text; break;
+ case DATA_LOCATION_WIDGET: baddy = fd->location_text; break;
+ case SAMPLES_WIDGET: baddy = fd->samples_text; break;
+ default: baddy = fd->chans_text; break;
+ }
+ if (baddy) XtAddCallback(baddy, XmNmodifyVerifyCallback, panel_modify_callback, (XtPointer)fd);
+}
+
+
+static void post_file_panel_error(const char *error_msg, void *ufd)
+{
+ file_data *fd = (file_data *)ufd;
+ fd->error_widget = fd->scanf_widget;
+ post_file_dialog_error(error_msg, fd);
+}
+
+
+static void file_data_type_callback(Widget w, XtPointer context, XtPointer info)
+{
+ int pos;
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ file_data *fd;
+
+ XtVaGetValues(w, XmNuserData, &fd, NULL);
+ pos = cbs->item_position - 1;
+ if (position_to_header_type(pos) != fd->current_header_type)
+ {
+ position_to_header_type_and_sample_type(fd, pos);
+ set_file_dialog_sound_attributes(fd,
+ fd->current_header_type,
+ fd->current_sample_type,
+ IGNORE_SRATE, IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
+ NULL);
+ }
+}
+
+
+static void file_sample_type_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ file_data *fd;
+ XtVaGetValues(w, XmNuserData, &fd, NULL);
+ fd->current_sample_type = position_to_sample_type(fd->current_header_type, cbs->item_position - 1);
+}
+
+
+static void file_data_src_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_data *fd = (file_data *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ fd->src = cb->set;
+}
+
+
+static void file_data_auto_comment_callback(Widget w, XtPointer context, XtPointer info)
+{
+ file_data *fd = (file_data *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ fd->auto_comment = cb->set;
+}
+
+
+
+/* ---------------- File Data Panel ---------------- */
+
+
+#define PANEL_COMMENT_SPACE 16
+#define WITHOUT_AUTO_COMMENT false
+#define WITH_SRATE true
+#define WITHOUT_SRATE false
+
+
+static file_data *make_file_data_panel(Widget parent, const char *name, Arg *in_args, int in_n,
+ dialog_channels_t with_chan,
+ mus_header_t header_type,
+ mus_sample_t sample_type,
+ dialog_data_location_t with_loc,
+ dialog_samples_t with_samples,
+ dialog_header_type_t with_header_type,
+ dialog_comment_t with_comment,
+ header_choice_t header_choice,
+ bool with_src, bool with_auto_comment)
+{
+ Widget form, header_label, data_label, srate_label, chans_label, sep1, sep2 = NULL, sep3, sep4;
+ Widget comment_label = NULL, location_label, samples_label;
+ file_data *fdat;
+ Arg args[32];
+ int i, n;
+ XmString *strs;
+ int nsample_types = 0, nheaders = 0;
+ const char **sample_types = NULL, **header_types = NULL;
+
+ switch (header_choice)
+ {
+ case WITH_READABLE_HEADERS: header_types = short_readable_headers(&nheaders); break;
+ case WITH_WRITABLE_HEADERS: header_types = short_writable_headers(&nheaders); break;
+ case WITH_BUILTIN_HEADERS: header_types = short_builtin_headers(&nheaders); break;
+ }
+
+ fdat = (file_data *)calloc(1, sizeof(file_data));
+ fdat->src = save_as_dialog_src(ss);
+ fdat->auto_comment = save_as_dialog_auto_comment(ss);
+ fdat->saved_comment = NULL;
+ fdat->current_header_type = header_type;
+ fdat->current_sample_type = sample_type;
+ sample_types = header_type_and_sample_type_to_position(fdat, header_type, sample_type);
+ nsample_types = fdat->sample_types;
+
+ /* pick up all args from caller -- args here are attachment points */
+ form = XtCreateManagedWidget(name, xmFormWidgetClass, parent, in_args, in_n);
+
+ if (with_header_type == WITH_HEADER_TYPE_FIELD)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNwidth, 5); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep1 = XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep1); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ header_label = XtCreateManagedWidget("header", xmLabelWidgetClass, form, args, n);
+
+ /* what is selected depends on current type */
+ strs = (XmString *)calloc(nheaders, sizeof(XmString));
+ for (i = 0; i < nheaders; i++)
+ strs[i] = XmStringCreateLocalized((char *)header_types[i]);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, header_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep1); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlistMarginWidth, 1); n++;
+ XtSetArg(args[n], XmNuserData, (XtPointer)fdat); n++;
+ XtSetArg(args[n], XmNitems, strs); n++;
+ XtSetArg(args[n], XmNitemCount, nheaders); n++;
+ XtSetArg(args[n], XmNvisibleItemCount, NUM_VISIBLE_HEADERS); n++;
+ fdat->header_type_list = XmCreateScrolledList(form, (char *)"header-type", args, n);
+ XtManageChild(fdat->header_type_list);
+
+ for (i = 0; i < nheaders; i++)
+ XmStringFree(strs[i]);
+ free(strs);
+ XmListSelectPos(fdat->header_type_list, fdat->header_type_pos + 1, false);
+ XtAddCallback(fdat->header_type_list, XmNbrowseSelectionCallback, file_data_type_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, fdat->header_type_list); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNwidth, 15); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep2 = XtCreateManagedWidget("sep2", xmSeparatorWidgetClass, form, args, n);
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ if (with_header_type == WITH_HEADER_TYPE_FIELD)
+ {
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep2); n++;
+ }
+ else
+ {
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ }
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ data_label = XtCreateManagedWidget("data", xmLabelWidgetClass, form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, data_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ if (with_header_type == WITH_HEADER_TYPE_FIELD)
+ {
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep2); n++;
+ }
+ else
+ {
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ }
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNuserData, (XtPointer)fdat); n++;
+ fdat->sample_type_list = XmCreateScrolledList(form, (char *)"sample-type", args, n);
+
+ strs = (XmString *)calloc(nsample_types, sizeof(XmString));
+ for (i = 0; i < nsample_types; i++)
+ strs[i] = XmStringCreateLocalized((char *)sample_types[i]);
+ XtVaSetValues(fdat->sample_type_list,
+ XmNitems, strs,
+ XmNitemCount, nsample_types,
+ NULL);
+ for (i = 0; i < nsample_types; i++)
+ XmStringFree(strs[i]);
+ free(strs);
+
+ XmListSelectPos(fdat->sample_type_list, fdat->sample_type_pos + 1, false);
+ XtManageChild(fdat->sample_type_list);
+ XtAddCallback(fdat->sample_type_list, XmNbrowseSelectionCallback, file_sample_type_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, fdat->sample_type_list); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNwidth, 15); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep3 = XtCreateManagedWidget("sep3", xmSeparatorWidgetClass, form, args, n);
+
+
+ /* srate */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep3); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ srate_label = XtCreateManagedWidget("srate", xmLabelWidgetClass, form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNcolumns, 8); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, srate_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep3); n++;
+ if (with_src)
+ {
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ }
+ else
+ {
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ }
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ fdat->srate_text = make_textfield_widget("srate-text", form, args, n, NOT_ACTIVATABLE, add_completer_func(srate_completer, NULL));
+
+ if (with_src)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, srate_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, fdat->srate_text); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++; /* this is probably clobbered by color_file_selection_box */
+ fdat->src_button = make_togglebutton_widget("src", form, args, n);
+ XtAddCallback(fdat->src_button, XmNvalueChangedCallback, file_data_src_callback, (XtPointer)fdat);
+ XmToggleButtonSetState(fdat->src_button, fdat->src, false);
+ }
+
+ if (with_chan != WITHOUT_CHANNELS_FIELD)
+ {
+ /* chans */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, fdat->srate_text); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep3); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ chans_label = XtCreateManagedWidget((char *)((with_chan == WITH_CHANNELS_FIELD) ? "channels" : "extract channel"), xmLabelWidgetClass, form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNcolumns, 6); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, chans_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep3); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ fdat->chans_text = make_textfield_widget("chans-text", form, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
+ XmTextFieldSetString(fdat->chans_text, (char *)"0");
+
+ if (with_loc == WITH_DATA_LOCATION_FIELD)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, fdat->chans_text); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep3); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ location_label = XtCreateManagedWidget("data location", xmLabelWidgetClass, form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNcolumns, 6); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, location_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, (with_samples == WITHOUT_SAMPLES_FIELD) ? XmATTACH_FORM : XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep3); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ fdat->location_text = make_textfield_widget("location-text", form, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
+ }
+ }
+
+ if (with_samples == WITH_SAMPLES_FIELD)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, ((fdat->location_text) ? fdat->location_text :
+ ((fdat->chans_text) ? fdat->chans_text : fdat->srate_text))); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep3); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ samples_label = XtCreateManagedWidget("samples", xmLabelWidgetClass, form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNcolumns, 8); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, samples_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep3); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ fdat->samples_text = make_textfield_widget("samples-text", form, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, form); n++; /* form is the internal XmForm widget holding the lists etc */
+ XtSetArg(args[n], XmNbottomAttachment, (with_comment != WITHOUT_COMMENT_FIELD) ? XmATTACH_NONE : XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, (with_comment != WITHOUT_COMMENT_FIELD) ? PANEL_COMMENT_SPACE : 2); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep4 = XtCreateManagedWidget("sep4", xmSeparatorWidgetClass, parent, args, n);
+
+ /* try to make the comment field the one that grows */
+ n = 0;
+ if (with_comment == WITHOUT_COMMENT_FIELD)
+ {
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep4); n++;
+ }
+ else
+ {
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ }
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++; /* overridden later -> yellow */
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNborderColor, ss->black); n++;
+ XtSetArg(args[n], XmNborderWidth, 2); n++;
+ XtSetArg(args[n], XmNmarginWidth, 10); n++;
+ XtSetArg(args[n], XmNmarginHeight, 10); n++;
+ fdat->error_text = XtCreateWidget("", xmLabelWidgetClass, parent, args, n);
+ /* XtUnmanageChild(fdat->error_text); */
+
+ if (with_comment != WITHOUT_COMMENT_FIELD)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep4); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ comment_label = XtCreateManagedWidget("comment", xmLabelWidgetClass, parent, args, n);
+
+ if (with_auto_comment)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep4); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ fdat->auto_comment_button = make_togglebutton_widget("auto", parent, args, n);
+ XtAddCallback(fdat->auto_comment_button, XmNvalueChangedCallback, file_data_auto_comment_callback, (XtPointer)fdat);
+ XmToggleButtonSetState(fdat->auto_comment_button, fdat->auto_comment, false);
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ if (with_auto_comment)
+ {
+ XtSetArg(args[n], XmNtopWidget, fdat->auto_comment_button); n++;
+ }
+ else
+ {
+ XtSetArg(args[n], XmNtopWidget, comment_label); n++;
+ }
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrows, 4); n++;
+ /* XtSetArg(args[n], XmNcolumns, 16); n++; */ /* this sets the lower size, so we don't want it too big */
+ fdat->comment_text = make_text_widget("comment-text", parent, args, n);
+ }
+ else fdat->comment_text = NULL;
+
+ return(fdat);
+}
+
+
+static void reflect_file_data_panel_change(file_data *fd, void *data, void (*change_action)(Widget w, XtPointer context, XtPointer info))
+{
+ if (fd->srate_text)
+ XtAddCallback(fd->srate_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->chans_text)
+ XtAddCallback(fd->chans_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->samples_text)
+ XtAddCallback(fd->samples_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->location_text)
+ XtAddCallback(fd->location_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->comment_text)
+ XtAddCallback(fd->comment_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->sample_type_list)
+ XtAddCallback(fd->sample_type_list, XmNbrowseSelectionCallback, change_action, (XtPointer)data);
+ if (fd->header_type_list)
+ XtAddCallback(fd->header_type_list, XmNbrowseSelectionCallback, change_action, (XtPointer)data);
+}
+
+
+static void unreflect_file_data_panel_change(file_data *fd, void *data, void (*change_action)(Widget w, XtPointer context, XtPointer info))
+{
+ if (fd->srate_text)
+ XtRemoveCallback(fd->srate_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->chans_text)
+ XtRemoveCallback(fd->chans_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->samples_text)
+ XtRemoveCallback(fd->samples_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->location_text)
+ XtRemoveCallback(fd->location_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->comment_text)
+ XtRemoveCallback(fd->comment_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
+ if (fd->sample_type_list)
+ XtRemoveCallback(fd->sample_type_list, XmNbrowseSelectionCallback, change_action, (XtPointer)data);
+ if (fd->header_type_list)
+ XtRemoveCallback(fd->header_type_list, XmNbrowseSelectionCallback, change_action, (XtPointer)data);
+}
+
+
+/* -------- save as dialog (file and edit menus) -------- */
+
+typedef struct {
+ file_data *panel_data;
+ Widget dialog, filename_widget, extractB, mkdirB;
+ char *filename; /* output name (?) */
+ save_dialog_t type;
+ file_pattern_info *fp;
+ dialog_play_info *dp;
+ void *file_watcher;
+ file_popup_info *fpop;
+ const char *original_filename;
+} save_as_dialog_info;
+
+static save_as_dialog_info *save_sound_as = NULL, *save_selection_as = NULL, *save_region_as = NULL;
+
+
+static save_as_dialog_info *new_save_as_dialog_info(save_dialog_t type)
+{
+ save_as_dialog_info *sd;
+ sd = (save_as_dialog_info *)calloc(1, sizeof(save_as_dialog_info));
+ sd->type = type;
+ return(sd);
+}
+
+
+static void make_auto_comment(save_as_dialog_info *sd)
+{
+ if ((sd == save_sound_as) &&
+ (XtIsManaged(sd->dialog)))
+ {
+ file_data *fd;
+ fd = sd->panel_data;
+
+ if (!(fd->auto_comment))
+ {
+ /* don't erase typed-in comment, if any */
+ XmTextSetString(fd->comment_text, fd->saved_comment);
+ }
+ else
+ {
+ snd_info *sp;
+ bool edits = false;
+ int i;
+ char *original_sound_comment, *comment, *orig_comment = NULL;
+
+ sp = any_selected_sound();
+
+ original_sound_comment = mus_sound_comment(sp->filename);
+ if (original_sound_comment)
+ {
+ if (*original_sound_comment)
+ orig_comment = mus_format("\n%s comment:\n%s\n", sp->short_filename, original_sound_comment);
+ free(original_sound_comment);
+ original_sound_comment = NULL;
+ }
+
+ if (fd->saved_comment) XtFree(fd->saved_comment);
+ fd->saved_comment = XmTextGetString(fd->comment_text);
+ if ((fd->saved_comment) &&
+ (!(*(fd->saved_comment))))
+ {
+ /* this is the norm in Motif */
+ XtFree(fd->saved_comment);
+ fd->saved_comment = NULL;
+ }
+
+ for (i = 0; i < sp->nchans; i++)
+ if (sp->chans[i]->edit_ctr != 0)
+ {
+ edits = true;
+ break;
+ }
+
+ if (!edits)
+ comment = mus_format("%s%ssaved %s from %s (no edits)\n%s",
+ (fd->saved_comment) ? fd->saved_comment : "",
+ (fd->saved_comment) ? "\n" : "",
+ snd_local_time(),
+ sp->filename,
+ (orig_comment) ? orig_comment : "");
+ else
+ {
+ int len;
+ char **edit_strs;
+ char *time;
+
+ time = snd_local_time();
+ len = 2 * mus_strlen(sp->filename) +
+ mus_strlen(time) +
+ 32 * sp->nchans +
+ mus_strlen(fd->saved_comment) +
+ mus_strlen(original_sound_comment);
+
+ edit_strs = (char **)malloc(sp->nchans * sizeof(char *));
+ for (i = 0; i < sp->nchans; i++)
+ {
+ edit_strs[i] = edit_list_to_function(sp->chans[i], 1, sp->chans[i]->edit_ctr);
+ len += mus_strlen(edit_strs[i]);
+ }
+
+ comment = (char *)calloc(len, sizeof(char));
+ snprintf(comment, len, "%s%ssaved %s from %s with edits:\n",
+ (fd->saved_comment) ? fd->saved_comment : "",
+ (fd->saved_comment) ? "\n" : "",
+ snd_local_time(),
+ sp->filename);
+
+ for (i = 0; i < sp->nchans; i++)
+ {
+ if (sp->nchans > 1)
+ {
+ char buf[32];
+ snprintf(buf, 32, "\n-------- channel %d --------\n", i);
+ strcat(comment, buf);
+ }
+ strcat(comment, edit_strs[i]);
+ }
+
+ if (orig_comment)
+ strcat(comment, orig_comment);
+ free(edit_strs);
+ }
+
+ XmTextSetString(fd->comment_text, comment);
+ if (comment) free(comment);
+ if (orig_comment) free(orig_comment);
+ }
+ }
+}
+
+
+static void auto_comment_callback(Widget w, XtPointer context, XtPointer info)
+{
+ save_as_dialog_info *sd = (save_as_dialog_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ sd->panel_data->auto_comment = (cb->set);
+ make_auto_comment(sd);
+}
+
+
+void reflect_save_as_src(bool val)
+{
+ if (save_sound_as)
+ XmToggleButtonSetState(save_sound_as->panel_data->src_button, val, true);
+ if (save_selection_as)
+ XmToggleButtonSetState(save_selection_as->panel_data->src_button, val, true);
+ if (save_region_as)
+ XmToggleButtonSetState(save_region_as->panel_data->src_button, val, true);
+}
+
+
+void reflect_save_as_auto_comment(bool val)
+{
+ if (save_sound_as)
+ XmToggleButtonSetState(save_sound_as->panel_data->auto_comment_button, val, true);
+}
+
+
+void reflect_save_as_sound_selection(const char *sound_name)
+{
+ if ((save_sound_as) &&
+ (XtIsManaged(save_sound_as->dialog)))
+ {
+ XmString xmstr2;
+ char *file_string;
+ file_string = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ if (sound_name)
+ snprintf(file_string, PRINT_BUFFER_SIZE, "save %s", sound_name);
+ else
+ {
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ snprintf(file_string, PRINT_BUFFER_SIZE, "save %s", sp->short_filename);
+ else snprintf(file_string, PRINT_BUFFER_SIZE, "nothing to save!");
+ }
+ xmstr2 = XmStringCreateLocalized(file_string);
+ XtVaSetValues(save_sound_as->dialog, XmNdialogTitle, xmstr2, NULL);
+ XmStringFree(xmstr2);
+ free(file_string);
+ }
+}
+
+
+void reflect_selection_in_save_as_dialog(bool on)
+{
+ if ((on) &&
+ (save_selection_as) &&
+ (save_selection_as->panel_data))
+ clear_dialog_error(save_selection_as->panel_data);
+}
+
+
+void reflect_region_in_save_as_dialog(void)
+{
+ if ((save_region_as) &&
+ (save_region_as->dialog) &&
+ (XtIsManaged(save_region_as->dialog)) &&
+ (region_ok(region_dialog_region())))
+ clear_dialog_error(save_region_as->panel_data);
+}
+
+
+static void save_as_filename_modify_callback(Widget w, XtPointer context, XtPointer info);
+
+static void save_as_undoit(save_as_dialog_info *sd)
+{
+ XmString ok_label;
+ ok_label = XmStringCreateLocalized((char *)"Save");
+ XtVaSetValues(sd->dialog,
+ XmNokLabelString, ok_label,
+ NULL);
+ XmStringFree(ok_label);
+ clear_dialog_error(sd->panel_data);
+ XtRemoveCallback(sd->filename_widget, XmNmodifyVerifyCallback, save_as_filename_modify_callback, (XtPointer)(sd->panel_data));
+ sd->file_watcher = unmonitor_file(sd->file_watcher);
+}
+
+
+static void save_as_filename_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ save_as_undoit((save_as_dialog_info *)context);
+ cbs->doit = true;
+}
+
+
+static void clear_error_if_save_as_filename_changes(Widget dialog, save_as_dialog_info *sd)
+{
+ XtAddCallback(sd->filename_widget, XmNmodifyVerifyCallback, save_as_filename_modify_callback, (XtPointer)sd);
+}
+
+
+static bool srates_differ(int srate, save_as_dialog_info *sd)
+{
+ switch (sd->type)
+ {
+ case SOUND_SAVE_AS:
+ return(snd_srate(any_selected_sound()) != srate);
+
+ case SELECTION_SAVE_AS:
+ return(selection_srate() != srate);
+
+ case REGION_SAVE_AS:
+ return(region_srate(region_dialog_region()) != srate);
+ }
+
+ return(false);
+}
+
+
+static double srate_ratio(int srate, save_as_dialog_info *sd)
+{
+ switch (sd->type)
+ {
+ case SOUND_SAVE_AS:
+ return((double)(snd_srate(any_selected_sound())) / (double)srate);
+
+ case SELECTION_SAVE_AS:
+ return((double)selection_srate() / (double)srate);
+
+ case REGION_SAVE_AS:
+ return((double)region_srate(region_dialog_region()) / (double)srate);
+ }
+
+ return(1.0);
+}
+
+
+static void save_or_extract(save_as_dialog_info *sd, bool saving)
+{
+ char *str = NULL, *comment = NULL, *msg = NULL, *fullname = NULL, *tmpfile = NULL;
+ snd_info *sp = NULL;
+ mus_header_t header_type = MUS_NEXT, output_type;
+ mus_sample_t sample_type = DEFAULT_OUTPUT_SAMPLE_TYPE;
+ int srate = DEFAULT_OUTPUT_SRATE;
+ int chan = 0, extractable_chans = 0;
+ bool file_exists = false;
+ io_error_t io_err = IO_NO_ERROR;
+
+ clear_dialog_error(sd->panel_data);
+
+ if ((sd->type == SELECTION_SAVE_AS) &&
+ (!(selection_is_active())))
+ {
+ if (saving)
+ msg = (char *)"no selection to save";
+ else msg = (char *)"can't extract: no selection";
+ post_file_dialog_error((const char *)msg, sd->panel_data);
+ return;
+ }
+
+ if ((sd->type == REGION_SAVE_AS) &&
+ (!(region_ok(region_dialog_region()))))
+ {
+ post_file_dialog_error("no region to save", sd->panel_data);
+ return;
+ }
+
+ sp = any_selected_sound();
+ if ((!sp) &&
+ (sd->type != REGION_SAVE_AS))
+ {
+ if (saving)
+ msg = (char *)"nothing to save";
+ else msg = (char *)"nothing to extract";
+ post_file_dialog_error((const char *)msg, sd->panel_data);
+ clear_error_if_filename_changes(sd->dialog, sd->panel_data);
+ return;
+ }
+
+ /* get output filename */
+ str = XmTextGetString(sd->filename_widget);
+ if ((!str) || (!*str))
+ {
+ if (saving)
+ msg = (char *)"can't save: no file name given";
+ else msg = (char *)"can't extract: no file name given";
+ post_file_dialog_error((const char *)msg, sd->panel_data);
+ clear_error_if_filename_changes(sd->dialog, sd->panel_data);
+ return;
+ }
+
+ /* get output file attributes */
+ redirect_snd_error_to(post_file_panel_error, (void *)(sd->panel_data));
+ {
+ mus_long_t location = 28, samples = 0;
+ int chans = 1;
+ if (saving)
+ comment = get_file_dialog_sound_attributes(sd->panel_data, &srate, &chans, &header_type, &sample_type, &location, &samples, 0);
+ else comment = get_file_dialog_sound_attributes(sd->panel_data, &srate, &chan, &header_type, &sample_type, &location, &samples, 0);
+ }
+ output_type = header_type;
+ redirect_snd_error_to(NULL, NULL);
+
+ if (sd->panel_data->error_widget != NOT_A_SCANF_WIDGET)
+ {
+ clear_error_if_panel_changes(sd->dialog, sd->panel_data);
+ if (comment) free(comment);
+ XtFree(str);
+ return;
+ }
+
+ switch (sd->type)
+ {
+ case SOUND_SAVE_AS:
+ clear_status_area(sp);
+ if (!saving)
+ extractable_chans = sp->nchans;
+ break;
+
+ case SELECTION_SAVE_AS:
+ if (!saving)
+ extractable_chans = selection_chans();
+ break;
+
+ default:
+ break;
+ }
+
+ if (!saving)
+ {
+ if ((chan > extractable_chans) ||
+ (((extractable_chans > 1) && (chan == extractable_chans)) ||
+ (chan < 0)))
+ {
+ if (chan > extractable_chans)
+ msg = mus_format("can't extract chan %d (%s has %d chan%s)",
+ chan,
+ (sd->type == SOUND_SAVE_AS) ? "sound" : "selection",
+ extractable_chans,
+ (extractable_chans > 1) ? "s" : "");
+ else msg = mus_format("can't extract chan %d (first chan is numbered 0)", chan);
+ post_file_dialog_error((const char *)msg, sd->panel_data);
+ clear_error_if_chans_changes(sd->dialog, sd->panel_data);
+ free(msg);
+ if (comment) free(comment);
+ XtFree(str);
+ return;
+ }
+ }
+
+ fullname = mus_expand_filename(str);
+ if (run_before_save_as_hook(sp, fullname, sd->type != SOUND_SAVE_AS, srate, sample_type, header_type, comment))
+ {
+ msg = mus_format("%s cancelled by %s", (saving) ? "save" : "extract", S_before_save_as_hook);
+ post_file_dialog_error((const char *)msg, sd->panel_data);
+ clear_error_if_filename_changes(sd->dialog, sd->panel_data);
+ free(msg);
+ free(fullname);
+ if (comment) free(comment);
+ XtFree(str);
+ return;
+ }
+
+ file_exists = mus_file_probe(fullname);
+ if ((sd->type == SOUND_SAVE_AS) &&
+ (mus_strcmp(fullname, sp->filename)))
+ {
+ /* save-as here is the same as save */
+ if ((sp->user_read_only == FILE_READ_ONLY) ||
+ (sp->file_read_only == FILE_READ_ONLY))
+ {
+ msg = mus_format("can't overwrite %s (it is write-protected)", sp->short_filename);
+ post_file_dialog_error((const char *)msg, sd->panel_data);
+ clear_error_if_filename_changes(sd->dialog, sd->panel_data);
+ free(msg);
+ free(fullname);
+ if (comment) free(comment);
+ XtFree(str);
+ return;
+ }
+ }
+ else
+ {
+ if (!(sd->file_watcher))
+ {
+ /* check for overwrites that are questionable -- DoIt click will return here with sd->file_watcher active */
+ snd_info *parlous_sp = NULL;
+ if ((file_exists) &&
+ ((ask_before_overwrite(ss)) ||
+ ((sd->type == SOUND_SAVE_AS) &&
+ (parlous_sp = file_is_open_elsewhere_and_has_unsaved_edits(sp, fullname)))))
+ {
+ XmString ok_label;
+ msg = mus_format("%s exists%s. To overwrite it, click 'DoIt'",
+ str,
+ (parlous_sp) ? ", and has unsaved edits" : "");
+ post_file_dialog_error((const char *)msg, sd->panel_data);
+ clear_error_if_save_as_filename_changes(sd->dialog, sd);
+ ok_label = XmStringCreateLocalized((char *)"DoIt");
+ XtVaSetValues(sd->dialog,
+ XmNokLabelString, ok_label,
+ NULL);
+ XmUpdateDisplay(FSB_BOX(sd->dialog, XmDIALOG_OK_BUTTON));
+ XmStringFree(ok_label);
+ free(msg);
+ free(fullname);
+ if (comment) free(comment);
+ XtFree(str);
+ return;
+ }
+ }
+ }
+
+ /* try to save... if it exists already, first write as temp, then move */
+ if (sd->file_watcher)
+ save_as_undoit(sd);
+ ss->local_errno = 0;
+
+ if (header_is_encoded(header_type))
+ {
+ output_type = header_type;
+ sample_type = MUS_LSHORT;
+ header_type = MUS_RIFF;
+ tmpfile = snd_tempnam();
+ }
+ else
+ {
+ tmpfile = fullname;
+ }
+
+ redirect_snd_error_to(redirect_post_file_dialog_error, (void *)(sd->panel_data));
+ switch (sd->type)
+ {
+ case SOUND_SAVE_AS:
+ if (saving)
+ io_err = save_edits_without_display(sp, tmpfile, header_type, sample_type, srate, comment, AT_CURRENT_EDIT_POSITION);
+ else io_err = save_channel_edits(sp->chans[chan], tmpfile, AT_CURRENT_EDIT_POSITION); /* protects if same name */
+ break;
+
+ case SELECTION_SAVE_AS:
+ {
+ char *ofile;
+ if (file_exists) /* file won't exist if we're encoding, so this isn't as wasteful as it looks */
+ ofile = snd_tempnam();
+ else ofile = mus_strdup(tmpfile);
+ io_err = save_selection(ofile, srate, sample_type, header_type, comment, (saving) ? SAVE_ALL_CHANS : chan);
+ if (io_err == IO_NO_ERROR)
+ io_err = move_file(ofile, fullname);
+ free(ofile);
+ }
+ break;
+
+ case REGION_SAVE_AS:
+ {
+ if (region_ok(region_dialog_region()))
+ {
+ char *ofile;
+ if (file_exists)
+ ofile = snd_tempnam();
+ else ofile = mus_strdup(tmpfile);
+ io_err = save_region(region_dialog_region(), ofile, sample_type, header_type, comment);
+ if (io_err == IO_NO_ERROR)
+ io_err = move_file(ofile, fullname);
+ free(ofile);
+ }
+ }
+ break;
+ }
+ redirect_snd_error_to(NULL, NULL);
+
+ /* check for possible srate conversion */
+ if ((sd->panel_data->src) &&
+ (srates_differ(srate, sd)))
+ {
+ /* if src, and srates differ, do the sampling rate conversion.
+ * this needs to happen before the snd_encode (->OGG etc) below
+ * if we do it before the save-as above, then undo it later, it messes up the user's edit history list
+ * so do it here to tmpfile (tmpfile is fullname unless we're doing a translation to something like OGG)
+ */
+ src_file(tmpfile, srate_ratio(srate, sd));
+ }
+
+ if (io_err == IO_NO_ERROR)
+ {
+ if (header_is_encoded(output_type))
+ {
+ snd_encode(output_type, tmpfile, fullname);
+ snd_remove(tmpfile, REMOVE_FROM_CACHE);
+ free(tmpfile);
+ }
+ remember_filename(fullname, sd->fpop->file_text_names);
+
+ if (!file_exists)
+ force_directory_reread(sd->dialog);
+ if (saving)
+ {
+ if (sd->type == SOUND_SAVE_AS)
+ status_report(sp, "%s saved as %s", sp->short_filename, str);
+ else status_report(sp, "%s saved as %s", (sd->type == SELECTION_SAVE_AS) ? "selection" : "region", str);
+ }
+ else
+ {
+ if (sd->type == SOUND_SAVE_AS)
+ status_report(sp, "%s chan %d saved as %s", sp->short_filename, chan, str);
+ else status_report(sp, "selection chan %d saved as %s", chan, str);
+ }
+ run_after_save_as_hook(sp, str, true); /* true => from dialog */
+ XtUnmanageChild(sd->dialog);
+ }
+ else
+ {
+ msg = mus_format("%s as %s: %s (%s)", (saving) ? "save" : "extract chan", str, io_error_name(io_err), snd_io_strerror());
+ post_file_dialog_error((const char *)msg, sd->panel_data);
+ clear_error_if_filename_changes(sd->dialog, sd->panel_data);
+ free(msg);
+ }
+
+ free(fullname);
+ XtFree(str);
+ if (comment) free(comment);
+}
+
+
+static void save_as_ok_callback(Widget w, XtPointer context, XtPointer info)
+{
+ save_or_extract((save_as_dialog_info *)context, true);
+}
+
+
+static void save_as_extract_callback(Widget w, XtPointer context, XtPointer info)
+{
+ save_or_extract((save_as_dialog_info *)context, false);
+}
+
+
+static void save_as_dialog_select_callback(Widget w, XtPointer context, XtPointer info)
+{
+#if WITH_AUDIO
+ dialog_play_info *dp = (dialog_play_info *)context;
+ char *filename = NULL;
+ XmString *strs;
+ XtVaGetValues(w, XmNselectedItems, &strs, NULL);
+ filename = (char *)XmStringUnparse(strs[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ if ((filename) && (is_sound_file(filename)))
+ XtManageChild(dp->play_button);
+ else
+ {
+ if (XtIsManaged(dp->play_button))
+ XtUnmanageChild(dp->play_button);
+ }
+ if (filename) XtFree(filename);
+#endif
+}
+
+
+static void save_as_cancel_callback(Widget w, XtPointer context, XtPointer info)
+{
+ save_as_dialog_info *sd = (save_as_dialog_info *)context;
+ XtUnmanageChild(sd->dialog);
+}
+
+
+static void save_as_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ save_as_dialog_help();
+}
+
+
+static bool directory_exists(char *name)
+{
+ char temp;
+ bool result;
+ int i, len, last_slash = -1;
+ len = strlen(name);
+ for (i = 0; i < len; i++)
+ if (name[i] == '/')
+ last_slash = i;
+ if (last_slash <= 0)
+ return(true);
+ if (last_slash >= len - 1) /* can't be > */
+ return(is_directory(name));
+ temp = name[last_slash + 1];
+ name[last_slash + 1] = '\0';
+ result = is_directory(name);
+ name[last_slash + 1] = temp;
+ return(result);
+}
+
+
+static void save_as_file_exists_check(Widget w, XtPointer context, XtPointer info)
+{
+ Widget dialog = (Widget)context;
+ char *filename = NULL;
+ XmString s1;
+ filename = XmTextGetString(w);
+ if ((filename) && (*filename))
+ {
+ if ((mus_file_probe(filename)) &&
+ (!is_directory(filename)))
+ {
+#ifndef _MSC_VER
+ if (access(filename, W_OK) < 0)
+ s1 = XmStringCreateLocalized((char *)"save as (file write-protected?):");
+ else
+#endif
+ s1 = XmStringCreateLocalized((char *)"save as (overwriting):");
+ }
+ else
+ {
+ if (!(directory_exists(filename)))
+ s1 = XmStringCreateLocalized((char *)"save as (no such directory?):");
+ else s1 = XmStringCreateLocalized((char *)"save as:");
+ }
+ }
+ else s1 = XmStringCreateLocalized((char *)"save as:");
+ XtVaSetValues(dialog,
+ XmNselectionLabelString, s1,
+ NULL);
+ if (filename) XtFree(filename);
+}
+
+
+static int snd_mkdir(const char *filename)
+{
+#ifdef __MINGW32__
+ return(mkdir(filename));
+#else
+ return(mkdir(filename, 0777));
+#endif
+}
+
+
+static void save_as_mkdir_callback(Widget w, XtPointer context, XtPointer info)
+{
+ save_as_dialog_info *sd = (save_as_dialog_info *)context;
+ char *filename = NULL;
+ filename = XmTextGetString(FSB_BOX(sd->dialog, XmDIALOG_TEXT));
+ if (snd_mkdir(filename) < 0)
+ {
+ /* could not make the directory */
+ char *str;
+ str = mus_format("can't make %s: %s", filename, strerror(errno));
+ post_file_dialog_error((const char *)str, sd->panel_data);
+ clear_error_if_filename_changes(sd->dialog, sd->panel_data);
+ free(str);
+ }
+ else
+ {
+ /* set FSB to new dir and force update */
+ char *filter;
+ filter = mus_format("%s*", filename); /* already has the "/" at the end */
+ update_dir_list(sd->dialog, filter);
+ free(filter);
+ XtSetSensitive(w, false);
+ }
+ XtFree(filename);
+}
+
+
+static void reflect_text_in_save_button(Widget w, XtPointer context, XtPointer info)
+{
+ save_as_dialog_info *sd = (save_as_dialog_info *)context;
+ /* w here is text widget, not button */
+ XtSetSensitive(FSB_BOX(sd->dialog, XmDIALOG_OK_BUTTON), (!(file_is_directory(sd->dialog))));
+ if (sd->mkdirB) XtSetSensitive(sd->mkdirB, file_is_nonexistent_directory(sd->dialog));
+}
+
+
+static void reflect_text_in_extract_button(Widget w, XtPointer context, XtPointer info)
+{
+ save_as_dialog_info *sd = (save_as_dialog_info *)context;
+ /* w here is text widget, not button */
+ XtSetSensitive(sd->extractB, (!(file_is_directory(sd->dialog))));
+}
+
+
+static void save_as_filter_text_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ save_as_dialog_info *sd = (save_as_dialog_info *)context;
+ force_directory_reread_and_let_filename_change(sd->dialog);
+}
+
+
+static void make_save_as_dialog(save_as_dialog_info *sd, char *sound_name, mus_header_t header_type, mus_sample_t sample_type)
+{
+ char *file_string;
+
+ sd->original_filename = sound_name;
+ if (!(sd->dialog))
+ {
+ Arg args[32];
+ int n;
+ XmString xmstr1, xmstr2, s1;
+ XmString filter_list_label, cancel_label;
+ Widget extractB, mainform;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ s1 = XmStringCreateLocalized((char *)"save as:");
+ XtSetArg(args[n], XmNselectionLabelString, s1); n++;
+
+ xmstr1 = XmStringCreateLocalized((char *)"Save");
+ XtSetArg(args[n], XmNokLabelString, xmstr1); n++;
+
+ file_string = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(file_string, PRINT_BUFFER_SIZE, "save %s", sound_name);
+
+ xmstr2 = XmStringCreateLocalized(file_string);
+ XtSetArg(args[n], XmNdialogTitle, xmstr2); n++;
+
+ filter_list_label = XmStringCreateLocalized((char *)"files listed:");
+ XtSetArg(args[n], XmNfilterLabelString, filter_list_label); n++;
+
+ cancel_label = XmStringCreateLocalized((char *)I_GO_AWAY);
+ XtSetArg(args[n], XmNcancelLabelString, cancel_label); n++;
+
+ sd->fp = (file_pattern_info *)calloc(1, sizeof(file_pattern_info));
+ sd->fp->in_just_sounds_update = false;
+ if (just_sounds(ss))
+ sd->fp->filter_choice = JUST_SOUNDS_FILTER;
+ else sd->fp->filter_choice = NO_FILE_FILTER;
+
+ sd->dp = (dialog_play_info *)calloc(1, sizeof(dialog_play_info));
+ sd->fpop = (file_popup_info *)calloc(1, sizeof(file_popup_info));
+ sd->fpop->fp = sd->fp;
+
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNchildPlacement, XmPLACE_ABOVE_SELECTION); n++;
+ XtSetArg(args[n], XmNallowOverlap, false); n++;
+ XtSetArg(args[n], XmNheight, 600); n++;
+ XtSetArg(args[n], XmNuserData, (XtPointer)sd->fp); n++;
+ XtSetArg(args[n], XmNfileFilterStyle, XmFILTER_HIDDEN_FILES); n++;
+ XtSetArg(args[n], XmNfileSearchProc, snd_directory_reader); n++; /* over-ride Motif's directory reader altogether */
+
+ sd->dialog = XmCreateFileSelectionDialog(MAIN_SHELL(ss), (char *)"save-as", args, n);
+ sd->fp->dialog = sd->dialog;
+ sd->dp->dialog = sd->dialog;
+ sd->fpop->dialog = sd->dialog;
+
+ free(file_string);
+
+ XtUnmanageChild(FSB_BOX(sd->dialog, XmDIALOG_DIR_LIST_LABEL));
+ XtUnmanageChild(FSB_BOX(sd->dialog, XmDIALOG_LIST_LABEL));
+ XtUnmanageChild(FSB_BOX(sd->dialog, XmDIALOG_APPLY_BUTTON));
+
+ XtVaSetValues(FSB_BOX(sd->dialog, XmDIALOG_FILTER_LABEL), XmNbackground, ss->basic_color, NULL);
+ XtVaSetValues(FSB_BOX(sd->dialog, XmDIALOG_SELECTION_LABEL), XmNbackground, ss->basic_color, NULL);
+
+ XmStringFree(s1);
+ XmStringFree(xmstr1);
+ XmStringFree(xmstr2);
+ XmStringFree(filter_list_label);
+ XmStringFree(cancel_label);
+
+ sd->filename_widget = FSB_BOX(sd->dialog, XmDIALOG_TEXT);
+ XtAddCallback(sd->dialog, XmNhelpCallback, save_as_help_callback, (XtPointer)sd);
+ XtAddCallback(sd->dialog, XmNcancelCallback, save_as_cancel_callback, (XtPointer)sd);
+ XtAddCallback(sd->dialog, XmNokCallback, save_as_ok_callback, (XtPointer)sd);
+
+ mainform = XtVaCreateManagedWidget("filebuttons-mainform", xmFormWidgetClass, sd->dialog, NULL);
+ add_play_and_just_sounds_buttons(sd->dialog, mainform, sd->fp, sd->dp);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sd->fp->just_sounds_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ sd->panel_data = make_file_data_panel(mainform, "data-form", args, n,
+ (sd->type == REGION_SAVE_AS) ? WITHOUT_CHANNELS_FIELD : WITH_EXTRACT_CHANNELS_FIELD,
+ header_type, sample_type,
+ WITHOUT_DATA_LOCATION_FIELD,
+ WITHOUT_SAMPLES_FIELD,
+ WITH_HEADER_TYPE_FIELD,
+ WITH_COMMENT_FIELD,
+ WITH_WRITABLE_HEADERS,
+ WITH_SRATE,
+ sd->type == SOUND_SAVE_AS); /* auto comment */
+
+ sd->panel_data->dialog = sd->dialog;
+
+ color_file_selection_box(sd->dialog);
+
+ XtVaSetValues(sd->panel_data->sample_type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ XtVaSetValues(sd->panel_data->header_type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ XtVaSetValues(sd->fp->just_sounds_button, XmNselectColor, ss->selection_color, NULL);
+#if WITH_AUDIO
+ XtVaSetValues(sd->dp->play_button, XmNselectColor, ss->selection_color, NULL);
+#endif
+
+ XtVaSetValues(sd->panel_data->src_button, XmNselectColor, ss->selection_color, NULL);
+ if (sd->type == SOUND_SAVE_AS)
+ {
+ XtVaSetValues(sd->panel_data->auto_comment_button, XmNselectColor, ss->selection_color, NULL);
+ XtAddCallback(sd->panel_data->auto_comment_button, XmNvalueChangedCallback, auto_comment_callback, (XtPointer)sd);
+ }
+ XtAddCallback(FSB_BOX(sd->dialog, XmDIALOG_LIST),
+ XmNbrowseSelectionCallback, save_as_dialog_select_callback, (XtPointer)(sd->dp));
+ XtAddCallback(sd->filename_widget, XmNvalueChangedCallback, save_as_file_exists_check, (XtPointer)(sd->dialog));
+ XtAddCallback(FSB_BOX(sd->dialog, XmDIALOG_FILTER_TEXT), XmNactivateCallback, save_as_filter_text_activate_callback, (void *)sd);
+
+ {
+ Widget wtmp;
+ wtmp = FSB_BOX(sd->dialog, XmDIALOG_DIR_LIST);
+ if (wtmp) XtAddCallback(wtmp, XmNbrowseSelectionCallback, file_change_directory_callback, (XtPointer)(sd->fp));
+ }
+
+ add_file_popups(sd->fpop);
+
+ /* this must come after the file data panel so that Motif puts it in the button box, not the main work area */
+ if (sd->type != REGION_SAVE_AS)
+ {
+ /* add "Extract" button */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ extractB = XtCreateManagedWidget("Extract", xmPushButtonGadgetClass, sd->dialog, args, n);
+ XtAddCallback(extractB, XmNactivateCallback, save_as_extract_callback, (XtPointer)sd);
+ sd->extractB = extractB;
+
+ XtSetSensitive(extractB, (!(file_is_directory(sd->dialog))));
+ XtAddCallback(FSB_BOX(sd->dialog, XmDIALOG_TEXT), XmNvalueChangedCallback, reflect_text_in_extract_button, (void *)sd);
+ }
+
+ /* add "Mkdir" button */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ sd->mkdirB = XtCreateManagedWidget("Mkdir", xmPushButtonGadgetClass, sd->dialog, args, n);
+ XtAddCallback(sd->mkdirB, XmNactivateCallback, save_as_mkdir_callback, (XtPointer)sd);
+ XtSetSensitive(sd->mkdirB, false);
+
+ XtSetSensitive(FSB_BOX(sd->dialog, XmDIALOG_OK_BUTTON), (!(file_is_directory(sd->dialog))));
+ XtAddCallback(FSB_BOX(sd->dialog, XmDIALOG_TEXT), XmNvalueChangedCallback, reflect_text_in_save_button, (void *)sd);
+
+ XtManageChild(sd->dialog);
+ switch (sd->type)
+ {
+ case SOUND_SAVE_AS:
+ set_dialog_widget(SOUND_SAVE_AS_DIALOG, sd->dialog);
+ break;
+
+ case SELECTION_SAVE_AS:
+ set_dialog_widget(SELECTION_SAVE_AS_DIALOG, sd->dialog);
+ break;
+
+ case REGION_SAVE_AS:
+ set_dialog_widget(REGION_SAVE_AS_DIALOG, sd->dialog);
+ break;
+
+ default:
+ snd_error("internal screw up");
+ break;
+ }
+ }
+ else
+ {
+ XmString xmstr2;
+ file_string = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(file_string, PRINT_BUFFER_SIZE, "save %s", sound_name);
+ xmstr2 = XmStringCreateLocalized(file_string);
+ XtVaSetValues(sd->dialog,
+ XmNdialogTitle, xmstr2,
+ NULL);
+ XmStringFree(xmstr2);
+ free(file_string);
+ }
+}
+
+
+static save_as_dialog_info *make_sound_save_as_dialog_1(bool managed, int chan)
+{
+ /* should the save-as dialog, at least in the file case, reflect the current file attributes/comment?
+ * or should we have a save-as-hook that can set up the dialog fields?
+ */
+
+ snd_info *sp = NULL;
+ char *com = NULL;
+ file_info *hdr = NULL;
+ save_as_dialog_info *sd;
+
+ if (!save_sound_as)
+ save_sound_as = new_save_as_dialog_info(SOUND_SAVE_AS);
+ sd = save_sound_as;
+
+ sp = any_selected_sound();
+ if (sp) hdr = sp->hdr;
+
+ make_save_as_dialog(sd,
+ (char *)((sp) ? sp->short_filename : ""),
+ default_output_header_type(ss),
+ default_output_sample_type(ss));
+
+ set_file_dialog_sound_attributes(sd->panel_data,
+ sd->panel_data->current_header_type,
+ sd->panel_data->current_sample_type,
+ (hdr) ? hdr->srate : selection_srate(),
+ IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
+ com = output_comment(hdr));
+ if (com) free(com);
+
+ if (chan >= 0)
+ {
+ char *chan_str;
+ chan_str = (char *)calloc(8, sizeof(char));
+ snprintf(chan_str, 8, "%d", chan);
+ XmTextFieldSetString(sd->panel_data->chans_text, chan_str);
+ free(chan_str);
+ }
+
+ if (sd->fp->reread_directory)
+ {
+ force_directory_reread(sd->dialog);
+ sd->fp->reread_directory = false;
+ }
+
+ if ((managed) && (!XtIsManaged(sd->dialog)))
+ XtManageChild(sd->dialog);
+
+ make_auto_comment(sd);
+ return(sd);
+}
+
+
+widget_t make_sound_save_as_dialog(bool managed)
+{
+ save_as_dialog_info *sd;
+ sd = make_sound_save_as_dialog_1(managed, -1);
+ return(sd->dialog);
+}
+
+
+void make_channel_extract_dialog(int chan)
+{
+ make_sound_save_as_dialog_1(true, chan);
+}
+
+
+widget_t make_selection_save_as_dialog(bool managed)
+{
+ save_as_dialog_info *sd;
+
+ if (!save_selection_as)
+ save_selection_as = new_save_as_dialog_info(SELECTION_SAVE_AS);
+ sd = save_selection_as;
+
+ make_save_as_dialog(sd,
+ (char *)"current selection",
+ default_output_header_type(ss),
+ default_output_sample_type(ss));
+ set_file_dialog_sound_attributes(sd->panel_data,
+ sd->panel_data->current_header_type,
+ sd->panel_data->current_sample_type,
+ selection_srate(),
+ IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
+ NULL);
+ if (sd->fp->reread_directory)
+ {
+ force_directory_reread(sd->dialog);
+ sd->fp->reread_directory = false;
+ }
+ if ((managed) && (!XtIsManaged(sd->dialog)))
+ XtManageChild(sd->dialog);
+ return(sd->dialog);
+}
+
+
+widget_t make_region_save_as_dialog(bool managed)
+{
+ save_as_dialog_info *sd;
+ char *comment = NULL;
+
+ if (!save_region_as)
+ save_region_as = new_save_as_dialog_info(REGION_SAVE_AS);
+ sd = save_region_as;
+
+ make_save_as_dialog(sd,
+ (char *)"selected region",
+ default_output_header_type(ss),
+ default_output_sample_type(ss));
+ comment = region_description(region_dialog_region());
+ set_file_dialog_sound_attributes(sd->panel_data,
+ sd->panel_data->current_header_type,
+ sd->panel_data->current_sample_type,
+ region_srate(region_dialog_region()),
+ IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
+ comment);
+ if (sd->fp->reread_directory)
+ {
+ force_directory_reread(sd->dialog);
+ sd->fp->reread_directory = false;
+ }
+ if ((managed) && (!XtIsManaged(sd->dialog)))
+ XtManageChild(sd->dialog);
+ if (comment) free(comment);
+ return(sd->dialog);
+}
+
+
+
+/* -------- save/restore for all these dialogs -------- */
+
+void save_file_dialog_state(FILE *fd)
+{
+ if ((odat) && (XtIsManaged(odat->dialog)))
+ {
+ /* odat->file_dialog_read_only -> "view-sound" dialog -- this distinction currently ignored */
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_open_file_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_open_file_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_open_file_dialog);
+#endif
+ }
+ if ((mdat) && (XtIsManaged(mdat->dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_mix_file_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_mix_file_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_mix_file_dialog);
+#endif
+ }
+ if ((idat) && (XtIsManaged(idat->dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_insert_file_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_insert_file_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_insert_file_dialog);
+#endif
+ }
+ if ((save_sound_as) && (XtIsManaged(save_sound_as->dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_save_sound_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_save_sound_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_save_sound_dialog);
+#endif
+ }
+ if ((save_selection_as) && (XtIsManaged(save_selection_as->dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_save_selection_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_save_selection_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_save_selection_dialog);
+#endif
+ }
+ if ((save_region_as) && (XtIsManaged(save_region_as->dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t)\n", S_save_region_dialog);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true)\n", to_proc_name(S_save_region_dialog));
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s drop\n", S_save_region_dialog);
+#endif
+ }
+}
+
+
+
+/* -------------------------------- New File -------------------------------- */
+
+static Widget new_file_dialog = NULL;
+static file_data *ndat = NULL;
+static mus_long_t initial_samples = 1;
+static Widget new_file_text = NULL;
+static char *new_file_filename = NULL;
+static void *new_file_watcher = NULL;
+
+
+static void new_filename_modify_callback(Widget w, XtPointer context, XtPointer info);
+
+static void new_file_undoit(void)
+{
+ XmString ok_label;
+ ok_label = XmStringCreateLocalized((char *)"Ok");
+ XtVaSetValues(new_file_dialog,
+ XmNokLabelString, ok_label,
+ NULL);
+ XmStringFree(ok_label);
+ clear_dialog_error(ndat);
+ XtRemoveCallback(new_file_text, XmNmodifyVerifyCallback, new_filename_modify_callback, NULL);
+ new_file_watcher = unmonitor_file(new_file_watcher);
+}
+
+
+static void new_filename_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ new_file_undoit();
+ cbs->doit = true;
+}
+
+
+static void clear_error_if_new_filename_changes(Widget dialog)
+{
+ XtAddCallback(new_file_text, XmNmodifyVerifyCallback, new_filename_modify_callback, NULL);
+}
+
+
+static void new_file_ok_callback(Widget w, XtPointer context, XtPointer info)
+{
+ mus_long_t loc;
+ char *newer_name = NULL, *msg;
+ mus_header_t header_type;
+ mus_sample_t sample_type;
+ int srate, chans;
+ newer_name = XmTextGetString(new_file_text);
+ if ((!newer_name) || (!(*newer_name)))
+ {
+ msg = (char *)"new sound needs a file name ('New file:' field is empty)";
+ post_file_dialog_error((const char *)msg, ndat);
+ clear_error_if_new_filename_changes(new_file_dialog);
+ }
+ else
+ {
+ char *comment;
+ redirect_snd_error_to(post_file_panel_error, (void *)ndat);
+ comment = get_file_dialog_sound_attributes(ndat, &srate, &chans, &header_type, &sample_type, &loc, &initial_samples, 1);
+ redirect_snd_error_to(NULL, NULL);
+ if (ndat->error_widget != NOT_A_SCANF_WIDGET)
+ {
+ clear_error_if_panel_changes(new_file_dialog, ndat);
+ }
+ else
+ {
+ /* handle the overwrite hook directly */
+ if (new_file_filename) free(new_file_filename);
+ new_file_filename = mus_expand_filename(newer_name);
+ if ((!new_file_watcher) &&
+ (ask_before_overwrite(ss)) &&
+ (mus_file_probe(new_file_filename)))
+ {
+ XmString ok_label;
+ msg = mus_format("%s exists. If you want to overwrite it, click 'DoIt'", newer_name);
+ post_file_dialog_error((const char *)msg, ndat);
+ clear_error_if_new_filename_changes(new_file_dialog);
+ ok_label = XmStringCreateLocalized((char *)"DoIt");
+ XtVaSetValues(new_file_dialog,
+ XmNokLabelString, ok_label,
+ NULL);
+ XmUpdateDisplay(MSG_BOX(new_file_dialog, XmDIALOG_OK_BUTTON));
+ XmStringFree(ok_label);
+ free(msg);
+ }
+ else
+ {
+ snd_info *sp;
+ if (new_file_watcher)
+ new_file_undoit();
+
+ ss->local_errno = 0;
+ redirect_snd_error_to(redirect_post_file_dialog_error, (void *)ndat);
+ sp = snd_new_file(new_file_filename, chans, srate, sample_type, header_type, comment, initial_samples);
+ redirect_snd_error_to(NULL, NULL);
+ if (!sp)
+ {
+ clear_error_if_new_filename_changes(new_file_dialog);
+ }
+ else
+ {
+ XtUnmanageChild(new_file_dialog);
+ }
+ }
+ }
+ XtFree(newer_name);
+ if (comment) free(comment);
+ }
+}
+
+
+static char *new_file_dialog_filename(mus_header_t header_type)
+{
+ static int new_file_dialog_file_ctr = 1;
+ char *filename = NULL;
+ const char *extension = NULL;
+ filename = (char *)calloc(64, sizeof(char));
+ switch (header_type)
+ {
+ case MUS_AIFC: extension = "aiff"; break;
+ case MUS_AIFF: extension = "aiff"; break;
+ case MUS_RIFF: extension = "wav"; break;
+ case MUS_RF64: extension = "wav"; break;
+ case MUS_CAFF: extension = "caf"; break;
+ default: extension = "snd"; break;
+ }
+ snprintf(filename, 64, "new-%d.%s", new_file_dialog_file_ctr++, extension);
+ return(filename);
+}
+
+
+static void load_new_file_defaults(char *newname)
+{
+ char *new_comment = NULL;
+ mus_header_t header_type;
+ mus_sample_t sample_type;
+ int chans, srate;
+
+ header_type = default_output_header_type(ss);
+ chans = default_output_chans(ss);
+ sample_type = default_output_sample_type(ss);
+ srate = default_output_srate(ss);
+ new_comment = output_comment(NULL);
+
+ if ((!newname) || (!(*newname)))
+ newname = new_file_dialog_filename(header_type);
+ mus_sound_forget(newname);
+
+ set_file_dialog_sound_attributes(ndat, header_type, sample_type, srate, chans, IGNORE_DATA_LOCATION, initial_samples, new_comment);
+ if (new_comment) free(new_comment);
+}
+
+
+static void new_file_reset_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *current_name;
+ current_name = XmTextGetString(new_file_text);
+ load_new_file_defaults(current_name);
+ if (current_name) XtFree(current_name);
+ if (new_file_watcher)
+ new_file_undoit();
+}
+
+
+static void new_file_cancel_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtUnmanageChild(w);
+}
+
+
+static void new_file_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ new_file_dialog_help();
+}
+
+
+widget_t make_new_file_dialog(bool managed)
+{
+ if (!new_file_dialog)
+ {
+ Arg args[20];
+ int n;
+ XmString xok, xcancel, xhelp;
+ Widget name_label, form;
+ XmString titlestr;
+ Widget sep, reset_button;
+
+ titlestr = XmStringCreateLocalized((char *)"New file");
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ xcancel = XmStringCreateLocalized((char *)I_GO_AWAY);
+ xok = XmStringCreateLocalized((char *)"Ok");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNcancelLabelString, xcancel); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNokLabelString, xok); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ new_file_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"new", args, n);
+
+ XmStringFree(titlestr);
+ XmStringFree(xok);
+ XmStringFree(xcancel);
+ XmStringFree(xhelp);
+
+ XtAddCallback(new_file_dialog, XmNhelpCallback, new_file_help_callback, NULL);
+ XtAddCallback(new_file_dialog, XmNcancelCallback, new_file_cancel_callback, NULL);
+ XtAddCallback(new_file_dialog, XmNokCallback, new_file_ok_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ reset_button = XtCreateManagedWidget("Reset", xmPushButtonGadgetClass, new_file_dialog, args, n);
+ XtAddCallback(reset_button, XmNactivateCallback, new_file_reset_callback, NULL);
+
+ n = 0;
+ form = XtCreateManagedWidget("newfile", xmFormWidgetClass, new_file_dialog, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNforeground, ss->black); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ name_label = XtCreateManagedWidget("New file:", xmLabelWidgetClass, form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, name_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ new_file_text = make_textfield_widget("newtext", form, args, n, ACTIVATABLE, add_completer_func(filename_completer, NULL));
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, new_file_text); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, 8); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, form, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ ndat = make_file_data_panel(form, "data-form", args, n,
+ WITH_CHANNELS_FIELD,
+ default_output_header_type(ss),
+ default_output_sample_type(ss),
+ WITHOUT_DATA_LOCATION_FIELD,
+ WITH_SAMPLES_FIELD,
+ WITH_HEADER_TYPE_FIELD,
+ WITH_COMMENT_FIELD,
+ WITH_BUILTIN_HEADERS,
+ WITHOUT_SRATE,
+ WITHOUT_AUTO_COMMENT);
+ ndat->dialog = new_file_dialog;
+ XtManageChild(ndat->error_text);
+ XtManageChild(new_file_dialog);
+
+ map_over_children(new_file_dialog, set_main_color_of_widget);
+ XtVaSetValues(ndat->sample_type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ XtVaSetValues(ndat->header_type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+
+ XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ set_dialog_widget(NEW_FILE_DIALOG, new_file_dialog);
+ XtUnmanageChild(ndat->error_text);
+
+ load_new_file_defaults(NULL);
+ }
+ else
+ {
+ char *new_name;
+ new_name = XmTextGetString(new_file_text);
+
+ if (new_file_watcher)
+ {
+ /* if overwrite question pends, but file has been deleted in the meantime, go back to normal state */
+ if ((!new_name) || (!(*new_name)) ||
+ (!(mus_file_probe(new_name))))
+ new_file_undoit();
+ }
+
+ if (strncmp(new_name, "new-", 4) == 0)
+ {
+ /* if file is open with currently posted new-file dialog name, and it's our name (new-%d), then tick the counter */
+ snd_info *sp;
+ sp = find_sound(new_name, 0);
+ if (sp)
+ {
+ char *filename;
+ filename = new_file_dialog_filename(default_output_header_type(ss));
+ XmTextSetString(new_file_text, filename);
+ mus_sound_forget(filename);
+ free(filename);
+ }
+ }
+ if (new_name) XtFree(new_name);
+ }
+ if ((managed) &&
+ (!(XtIsManaged(new_file_dialog))))
+ XtManageChild(new_file_dialog);
+ return(new_file_dialog);
+}
+
+
+
+/* ---------------- Edit Header ---------------- */
+
+typedef struct edhead_info {
+ Widget dialog;
+ file_data *edat;
+ snd_info *sp;
+ bool panel_changed;
+ void *file_ro_watcher;
+ int sp_ro_watcher_loc;
+} edhead_info;
+
+static int edhead_info_size = 0;
+static edhead_info **edhead_infos = NULL;
+
+
+static edhead_info *new_edhead_dialog(void)
+{
+ int loc = -1;
+ if (edhead_info_size == 0)
+ {
+ loc = 0;
+ edhead_info_size = 4;
+ edhead_infos = (edhead_info **)calloc(edhead_info_size, sizeof(edhead_info *));
+ }
+ else
+ {
+ int i;
+ for (i = 0; i < edhead_info_size; i++)
+ if ((!edhead_infos[i]) ||
+ (!(XtIsManaged(edhead_infos[i]->dialog))))
+ {
+ loc = i;
+ break;
+ }
+ if (loc == -1)
+ {
+ loc = edhead_info_size;
+ edhead_info_size += 4;
+ edhead_infos = (edhead_info **)realloc(edhead_infos, edhead_info_size * sizeof(edhead_info *));
+ for (i = loc; i < edhead_info_size; i++) edhead_infos[i] = NULL;
+ }
+ }
+ if (!edhead_infos[loc])
+ {
+ edhead_infos[loc] = (edhead_info *)calloc(1, sizeof(edhead_info));
+ edhead_infos[loc]->dialog = NULL;
+ edhead_infos[loc]->panel_changed = false;
+ }
+ edhead_infos[loc]->sp = NULL;
+ edhead_infos[loc]->file_ro_watcher = NULL;
+ return(edhead_infos[loc]);
+}
+
+
+static XmString make_header_dialog_title(edhead_info *ep, snd_info *sp)
+{
+ /* dialog may not yet exist */
+ char *str;
+ XmString xstr;
+ str = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ if ((sp->user_read_only == FILE_READ_ONLY) ||
+ (sp->file_read_only == FILE_READ_ONLY))
+ {
+ if (sp->hdr->type == MUS_RAW)
+ snprintf(str, PRINT_BUFFER_SIZE, "Add header to (write-protected) %s", sp->short_filename);
+ else snprintf(str, PRINT_BUFFER_SIZE, "Edit header of (write-protected) %s", sp->short_filename);
+ if (ep->dialog)
+ set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), (sp->hdr->type == MUS_RAW));
+ }
+ else
+ {
+ if (sp->hdr->type == MUS_RAW)
+ snprintf(str, PRINT_BUFFER_SIZE, "Add header to %s", sp->short_filename);
+ else snprintf(str, PRINT_BUFFER_SIZE, "Edit header of %s", sp->short_filename);
+ if (ep->dialog)
+ set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), ep->panel_changed);
+ }
+ xstr = XmStringCreateLocalized(str);
+ free(str);
+ return(xstr);
+}
+
+
+static void edit_header_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ edit_header_dialog_help();
+}
+
+
+static void edit_header_set_ok_sensitive(Widget w, XtPointer context, XtPointer info)
+{
+ edhead_info *ep = (edhead_info *)context;
+ if (ep->sp->file_read_only == FILE_READ_WRITE)
+ set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), true);
+ ep->panel_changed = true;
+}
+
+
+static void eh_cancel(edhead_info *ep)
+{
+ unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
+ ep->panel_changed = false;
+ if ((ep->file_ro_watcher) &&
+ (ep->sp) &&
+ (ep->sp->active) &&
+ (ep->sp->filename))
+ ep->file_ro_watcher = unmonitor_file(ep->file_ro_watcher);
+}
+
+
+static void edit_header_cancel_callback(Widget w, XtPointer context, XtPointer info)
+{
+ edhead_info *ep = (edhead_info *)context;
+ XtUnmanageChild(ep->dialog);
+ eh_cancel(ep);
+}
+
+
+static void edit_header_wm_delete_callback(Widget w, XtPointer context, XtPointer info)
+{
+ eh_cancel((edhead_info *)context);
+}
+
+
+static void edit_header_ok_callback(Widget w, XtPointer context, XtPointer info)
+{
+ edhead_info *ep = (edhead_info *)context;
+ if ((ep->sp) && (ep->sp->active))
+ {
+ if (XmGetFocusWidget(ep->dialog) == MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON))
+ {
+ bool ok;
+ redirect_snd_error_to(redirect_post_file_dialog_error, (void *)(ep->edat));
+ ok = edit_header_callback(ep->sp, ep->edat, redirect_post_file_dialog_error, post_file_panel_error);
+ /* edit_header_callback, if all goes well, writes the header, recopies the data,
+ * then calls snd_update which closes the sound and reopens it, to force the
+ * new_header to take effect. The read-only watcher is disabled during that
+ * process to keep it from getting a SOUND_IS_CLOSING message from close.
+ */
+ redirect_snd_error_to(NULL, NULL);
+ if (ep->edat->error_widget != NOT_A_SCANF_WIDGET)
+ {
+ clear_error_if_panel_changes(ep->dialog, ep->edat);
+ return;
+ }
+ else
+ {
+ if (!ok)
+ {
+ set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), false);
+ return;
+ }
+ }
+ ep->file_ro_watcher = unmonitor_file(ep->file_ro_watcher);
+ XtUnmanageChild(ep->dialog);
+ unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
+ }
+ }
+}
+
+
+Widget edit_header(snd_info *sp)
+{
+ file_info *hdr;
+ XmString xstr4;
+ Widget main_w;
+ edhead_info *ep = NULL;
+
+ if (!sp) return(NULL);
+
+ /* look for a dialog already editing this sound, raise if found, else make a new one */
+ if (edhead_info_size > 0)
+ {
+ int i;
+ for (i = 0; i < edhead_info_size; i++)
+ if ((edhead_infos[i]) &&
+ ((edhead_infos[i]->sp == sp) ||
+ ((edhead_infos[i]->sp) && /* maybe same sound open twice -- only one edit header dialog for it */
+ (edhead_infos[i]->sp->inuse == SOUND_NORMAL) &&
+ (mus_strcmp(sp->filename, edhead_infos[i]->sp->filename)))))
+ {
+ ep = edhead_infos[i];
+ break;
+ }
+ }
+ if (!ep)
+ ep = new_edhead_dialog();
+
+ ep->sp = sp;
+ hdr = sp->hdr;
+ ep->panel_changed = (hdr->type == MUS_RAW);
+ xstr4 = make_header_dialog_title(ep, sp);
+
+ if (!ep->dialog)
+ {
+ int n;
+ Arg args[20];
+ XmString xstr1, xstr2, xstr3, titlestr;
+
+ n = 0;
+ xstr1 = XmStringCreateLocalized((char *)I_GO_AWAY); /* needed by template dialog */
+ xstr2 = XmStringCreateLocalized((char *)I_HELP);
+ xstr3 = XmStringCreateLocalized((char *)"Save");
+ titlestr = XmStringCreateLocalized((char *)"Edit Header");
+
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNcancelLabelString, xstr1); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xstr2); n++;
+ XtSetArg(args[n], XmNokLabelString, xstr3); n++;
+ XtSetArg(args[n], XmNmessageString, xstr4); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ ep->dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Edit Header", args, n);
+
+ XtAddCallback(ep->dialog, XmNcancelCallback, edit_header_cancel_callback, (XtPointer)ep);
+ XtAddCallback(ep->dialog, XmNhelpCallback, edit_header_help_callback, (XtPointer)ep);
+ XtAddCallback(ep->dialog, XmNokCallback, edit_header_ok_callback, (XtPointer)ep);
+
+ XmStringFree(xstr1);
+ XmStringFree(xstr2);
+ XmStringFree(xstr3);
+ XmStringFree(titlestr);
+
+ n = 0;
+ main_w = XtCreateManagedWidget("eh-main", xmFormWidgetClass, ep->dialog, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ ep->edat = make_file_data_panel(main_w, "Edit Header", args, n,
+ WITH_CHANNELS_FIELD,
+ hdr->type,
+ hdr->sample_type,
+ WITH_DATA_LOCATION_FIELD,
+ WITH_SAMPLES_FIELD,
+ WITH_HEADER_TYPE_FIELD,
+ WITH_COMMENT_FIELD,
+ WITH_BUILTIN_HEADERS,
+ WITHOUT_SRATE,
+ WITHOUT_AUTO_COMMENT);
+ ep->edat->dialog = ep->dialog;
+
+ if (hdr->type == MUS_RAW)
+ set_file_dialog_sound_attributes(ep->edat,
+ default_output_header_type(ss),
+ hdr->sample_type, hdr->srate, hdr->chans,
+ hdr->data_location, hdr->samples, hdr->comment);
+ else set_file_dialog_sound_attributes(ep->edat,
+ hdr->type, hdr->sample_type, hdr->srate, hdr->chans,
+ hdr->data_location, hdr->samples, hdr->comment);
+ XtManageChild(ep->edat->error_text);
+ XtManageChild(ep->dialog);
+
+ map_over_children(ep->dialog, set_main_color_of_widget);
+ XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(ep->edat->header_type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ XtVaSetValues(ep->edat->sample_type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+
+ XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->basic_color, NULL);
+
+ set_dialog_widget(EDIT_HEADER_DIALOG, ep->dialog);
+
+ {
+ Atom wm_delete_window;
+ wm_delete_window = XmInternAtom(MAIN_DISPLAY(ss), (char *)"WM_DELETE_WINDOW", false);
+ XmAddWMProtocolCallback(XtParent(ep->dialog), wm_delete_window, edit_header_wm_delete_callback, (XtPointer)ep);
+ }
+
+ XtUnmanageChild(ep->edat->error_text);
+ }
+ else
+ {
+ XtVaSetValues(ep->dialog,
+ XmNmessageString, xstr4,
+ NULL);
+ if (hdr->type == MUS_RAW)
+ set_file_dialog_sound_attributes(ep->edat,
+ default_output_header_type(ss),
+ hdr->sample_type, hdr->srate, hdr->chans,
+ hdr->data_location, hdr->samples, hdr->comment);
+ else set_file_dialog_sound_attributes(ep->edat,
+ hdr->type, hdr->sample_type, hdr->srate, hdr->chans,
+ hdr->data_location, hdr->samples, hdr->comment);
+ raise_dialog(ep->dialog);
+ clear_dialog_error(ep->edat);
+ }
+ set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), (hdr->type == MUS_RAW)); /* nothing needs to be saved when we start */
+ XmStringFree(xstr4);
+ if (!(XtIsManaged(ep->dialog))) XtManageChild(ep->dialog);
+ reflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
+ return(ep->dialog);
+}
+
+
+void save_edit_header_dialog_state(FILE *fd)
+{
+ int i;
+ for (i = 0; i < edhead_info_size; i++)
+ if (edhead_infos[i])
+ {
+ edhead_info *ep;
+ ep = edhead_infos[i];
+ if ((ep->dialog) &&
+ (XtIsManaged(ep->dialog)) &&
+ (snd_ok(ep->sp)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s (%s \"%s\"))\n", S_edit_header_dialog, S_find_sound, ep->sp->short_filename);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(%s(\"%s\"))\n", to_proc_name(S_edit_header_dialog), to_proc_name(S_find_sound), ep->sp->short_filename);
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "\"%s\" %s %s drop\n", ep->sp->short_filename, S_find_sound, S_edit_header_dialog);
+#endif
+ break;
+ }
+ }
+}
+
+
+typedef enum {VF_AT_CURSOR, VF_AT_END, VF_AT_BEGINNING, VF_AT_MARK, VF_AT_SAMPLE} vf_location_t;
+
+typedef struct {
+ widget_t rw;
+ widget_t nm;
+#if WITH_AUDIO
+ widget_t pl;
+#endif
+ int pos;
+ void *vdat;
+} vf_row;
+
+typedef struct {
+ vf_row **file_list_entries;
+ int index, size;
+ char **names;
+ char **full_names;
+ int end;
+ int sorter;
+ int *selected_files;
+ int selected_files_size;
+ int currently_selected_files;
+ mus_float_t amp;
+ vf_location_t location_choice;
+ mus_float_t speed;
+ graphics_context *env_ax;
+ env_editor *spf;
+ env *amp_env;
+ bool has_error;
+ int sort_items_size;
+ speed_style_t speed_style;
+ mus_long_t beg;
+
+ int dirs_size;
+ void *dirs;
+ char **dir_names;
+ bool need_update;
+
+ widget_t dialog;
+ widget_t file_list;
+ widget_t file_list_holder;
+ widget_t left_title;
+ widget_t info1;
+ widget_t info2;
+ widget_t mixB;
+ widget_t insertB;
+ widget_t at_cursor_button;
+ widget_t at_end_button;
+ widget_t at_beginning_button;
+ widget_t at_mark_button;
+ widget_t at_sample_button;
+ widget_t at_sample_text;
+ widget_t at_mark_text;
+ widget_t amp_number;
+ widget_t amp_scrollbar;
+ widget_t speed_number;
+ widget_t speed_scrollbar;
+ widget_t env_drawer;
+ widget_t a_to_z;
+ widget_t z_to_a;
+ widget_t new_to_old;
+ widget_t old_to_new;
+ widget_t small_to_big;
+ widget_t big_to_small;
+ widget_t smenu;
+ widget_t current_play_button;
+ widget_t amp_event;
+ widget_t speed_event;
+ widget_t speed_label_event;
+ widget_t add_text;
+ widget_t* sort_items;
+
+ GC env_gc;
+} view_files_info;
+
+static void vf_unhighlight_row(widget_t nm, widget_t rw);
+static void vf_highlight_row(widget_t nm, widget_t rw);
+static void vf_post_info(view_files_info *vdat, int pos);
+static void vf_unpost_info(view_files_info *vdat);
+static mus_long_t vf_location(view_files_info *vdat);
+static void vf_post_error(const char *error_msg, view_files_info *data);
+static void redirect_vf_post_error(const char *error_msg, void *data);
+static void redirect_vf_post_location_error(const char *error_msg, void *data);
+static void vf_post_add_error(const char *error_msg, view_files_info *data);
+static widget_t make_view_files_dialog_1(view_files_info *vdat, bool managed);
+static void vf_post_selected_files_list(view_files_info *vdat);
+static void view_files_add_file_or_directory(view_files_info *vdat, const char *file_or_dir);
+static void vf_reflect_sort_choice_in_menu(view_files_info *vdat);
+static vf_row *view_files_make_row(view_files_info *vdat, widget_t last_row);
+static void vf_flash_row(vf_row *r);
+static void vf_set_amp(view_files_info *vdat, mus_float_t val);
+static void vf_set_speed(view_files_info *vdat, mus_float_t val);
+static void vf_set_amp_env(view_files_info *vdat, env *new_e);
+static void vf_clear_error(view_files_info *vdat);
+static void vf_mix_insert_buttons_set_sensitive(view_files_info *vdat, bool sensitive);
+static int vf_mix(view_files_info *vdat);
+static bool vf_insert(view_files_info *vdat);
+static void view_files_display_list(view_files_info *vdat);
+
+static void view_files_unmonitor_directories(view_files_info *vdat) {}
+static void view_files_monitor_directory(view_files_info *vdat, const char *dirname) {}
+
+
+
+
+/* -------------------------------- Raw Data Dialog -------------------------------- */
+
+/* we keep an array of raw data dialogs so that any number can be active at once */
+
+typedef struct raw_info {
+ Widget dialog;
+ mus_long_t location;
+ file_data *rdat;
+ read_only_t read_only;
+ bool selected;
+ char *filename;
+ char *help;
+ open_requestor_t requestor;
+ void *requestor_data;
+ Widget requestor_dialog;
+} raw_info;
+
+static int raw_info_size = 0;
+static raw_info **raw_infos = NULL;
+
+
+static raw_info *new_raw_dialog(void)
+{
+ int loc = -1;
+ if (raw_info_size == 0)
+ {
+ loc = 0;
+ raw_info_size = 4;
+ raw_infos = (raw_info **)calloc(raw_info_size, sizeof(raw_info *));
+ }
+ else
+ {
+ int i;
+ for (i = 0; i < raw_info_size; i++)
+ if ((!raw_infos[i]) ||
+ (!(XtIsManaged(raw_infos[i]->dialog))))
+ {
+ loc = i;
+ break;
+ }
+ if (loc == -1)
+ {
+ loc = raw_info_size;
+ raw_info_size += 4;
+ raw_infos = (raw_info **)realloc(raw_infos, raw_info_size * sizeof(raw_info *));
+ for (i = loc; i < raw_info_size; i++) raw_infos[i] = NULL;
+ }
+ }
+ if (!raw_infos[loc])
+ {
+ raw_infos[loc] = (raw_info *)calloc(1, sizeof(raw_info));
+ raw_infos[loc]->dialog = NULL;
+ raw_infos[loc]->filename = NULL;
+ raw_infos[loc]->help = NULL;
+ }
+ raw_infos[loc]->requestor = NO_REQUESTOR;
+ raw_infos[loc]->requestor_data = NULL;
+ raw_infos[loc]->location = 0;
+ return(raw_infos[loc]);
+}
+
+
+static void raw_data_ok_callback(Widget w, XtPointer context, XtPointer info)
+{
+ raw_info *rp = (raw_info *)context;
+ int raw_srate = 0, raw_chans = 0;
+ mus_sample_t raw_sample_type = MUS_UNKNOWN_SAMPLE;
+
+ redirect_snd_error_to(post_file_panel_error, (void *)(rp->rdat));
+ get_file_dialog_sound_attributes(rp->rdat, &raw_srate, &raw_chans, NULL, &raw_sample_type, &(rp->location), NULL, 1);
+ redirect_snd_error_to(NULL, NULL);
+
+ if (rp->rdat->error_widget != NOT_A_SCANF_WIDGET)
+ {
+ clear_error_if_panel_changes(rp->dialog, rp->rdat);
+ }
+ else
+ {
+ mus_header_set_raw_defaults(raw_srate, raw_chans, raw_sample_type);
+ mus_sound_override_header(rp->filename, raw_srate, raw_chans,
+ raw_sample_type, MUS_RAW, rp->location,
+ mus_bytes_to_samples(raw_sample_type,
+ mus_sound_length(rp->filename) - rp->location));
+ /* choose action based on how we got here */
+ if ((rp->requestor_dialog) &&
+ ((rp->requestor == FROM_MIX_DIALOG) ||
+ (rp->requestor == FROM_INSERT_DIALOG) ||
+ (rp->requestor == FROM_VIEW_FILES_MIX_DIALOG) ||
+ (rp->requestor == FROM_VIEW_FILES_INSERT_DIALOG)))
+ {
+ ss->reloading_updated_file = true; /* don't reread lack-of-header! */
+ /* redirection may be still set here, but I'll make it obvious */
+ switch (rp->requestor)
+ {
+ case FROM_MIX_DIALOG:
+ redirect_snd_error_to(redirect_file_open_error, (void *)mdat);
+ mix_complete_file_at_cursor(any_selected_sound(), rp->filename);
+ break;
+
+ case FROM_INSERT_DIALOG:
+ redirect_snd_error_to(redirect_file_open_error, (void *)idat);
+ insert_complete_file_at_cursor(any_selected_sound(), rp->filename);
+ break;
+
+ case FROM_VIEW_FILES_MIX_DIALOG:
+ {
+ view_files_info *vdat = (view_files_info *)(rp->requestor_data);
+ redirect_snd_error_to(redirect_vf_post_error, rp->requestor_data);
+ vf_mix(vdat);
+ }
+ break;
+
+ case FROM_VIEW_FILES_INSERT_DIALOG:
+ {
+ view_files_info *vdat = (view_files_info *)(rp->requestor_data);
+ redirect_snd_error_to(redirect_vf_post_error, rp->requestor_data);
+ vf_insert(vdat);
+ }
+ break;
+
+ default:
+ snd_error("wrong requestor type in raw data dialog? %d\n", (int)(rp->requestor));
+ break;
+ }
+ redirect_snd_error_to(NULL, NULL);
+ ss->reloading_updated_file = false;
+ }
+ else
+ {
+ /* FROM_OPEN_DIALOG (has requestor_dialog)
+ * FROM_KEYBOARD (has sp = requestor_data)
+ * FROM_DRAG_AND_DROP (just open, no needed side effects)
+ * FROM_VIEW_FILES (ditto)
+ * FROM_VIEW_FILES_MIX_DIALOG or INSERT -- requestor_data contains needed info to complete the action
+ */
+ file_info *hdr;
+ hdr = (file_info *)calloc(1, sizeof(file_info));
+ hdr->name = mus_strdup(rp->filename);
+ hdr->type = MUS_RAW;
+ hdr->srate = raw_srate;
+ hdr->chans = raw_chans;
+ hdr->sample_type = raw_sample_type;
+ hdr->samples = mus_bytes_to_samples(raw_sample_type,
+ mus_sound_length(rp->filename) - rp->location);
+ hdr->data_location = rp->location;
+ hdr->comment = NULL;
+ if (rp->requestor == FROM_KEYBOARD)
+ {
+ clear_status_area((snd_info *)(rp->requestor_data));
+ rp->selected = true;
+ }
+ finish_opening_sound(add_sound_window(rp->filename, rp->read_only, hdr), rp->selected);
+ }
+ XtUnmanageChild(rp->dialog);
+ }
+}
+
+
+static void raw_data_cancel_callback(Widget w, XtPointer context, XtPointer info)
+{
+ raw_info *rp = (raw_info *)context;
+ XtUnmanageChild(rp->dialog);
+ if ((rp->requestor_dialog) &&
+ ((rp->requestor == FROM_OPEN_DIALOG) ||
+ (rp->requestor == FROM_MIX_DIALOG)))
+ XtManageChild(rp->requestor_dialog);
+}
+
+
+static void raw_data_reset_callback(Widget w, XtPointer context, XtPointer info)
+{
+ raw_info *rp = (raw_info *)context;
+ int raw_srate, raw_chans;
+ mus_sample_t raw_sample_type;
+ rp->location = 0;
+ mus_header_raw_defaults(&raw_srate, &raw_chans, &raw_sample_type); /* pick up defaults */
+ set_file_dialog_sound_attributes(rp->rdat,
+ IGNORE_HEADER_TYPE,
+ raw_sample_type, raw_srate, raw_chans, rp->location,
+ IGNORE_SAMPLES, NULL);
+ if (XtIsManaged(rp->rdat->error_text))
+ XtUnmanageChild(rp->rdat->error_text);
+}
+
+
+static void raw_data_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ raw_info *rp = (raw_info *)context;
+ raw_data_dialog_help(rp->help);
+}
+
+
+static void make_raw_data_dialog(raw_info *rp, const char *title)
+{
+ XmString go_away, xhelp, xok, xtitle, titlestr;
+ int n;
+ int raw_srate, raw_chans;
+ mus_sample_t raw_sample_type;
+ Arg args[20];
+ Widget reset_button, main_w;
+
+ go_away = XmStringCreateLocalized((char *)I_GO_AWAY); /* needed by template dialog */
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ xok = XmStringCreateLocalized((char *)"Ok");
+ if (!title)
+ titlestr = XmStringCreateLocalized((char *)"No header on file");
+ else titlestr = XmStringCreateLocalized((char *)title);
+ xtitle = XmStringCreateLocalized((char *)title);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNcancelLabelString, go_away); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNokLabelString, xok); n++;
+ XtSetArg(args[n], XmNmessageString, xtitle); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNallowShellResize, true); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ /* not transient -- we want this window to remain visible if possible */
+ rp->dialog = XmCreateWarningDialog(MAIN_SHELL(ss), (char *)"raw data", args, n);
+
+ XtAddCallback(rp->dialog, XmNcancelCallback, raw_data_cancel_callback, (XtPointer)rp);
+ XtAddCallback(rp->dialog, XmNhelpCallback, raw_data_help_callback, (XtPointer)rp);
+ XtAddCallback(rp->dialog, XmNokCallback, raw_data_ok_callback, (XtPointer)rp);
+ XmStringFree(go_away);
+ XmStringFree(xhelp);
+ XmStringFree(xok);
+ XmStringFree(xtitle);
+ XmStringFree(titlestr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ reset_button = XtCreateManagedWidget("Reset", xmPushButtonGadgetClass, rp->dialog, args, n);
+ XtAddCallback(reset_button, XmNactivateCallback, raw_data_reset_callback, (XtPointer)rp);
+
+ mus_header_raw_defaults(&raw_srate, &raw_chans, &raw_sample_type); /* pick up defaults */
+
+ n = 0;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_NONE); n++;
+ main_w = XtCreateManagedWidget("raw-main", xmFormWidgetClass, rp->dialog, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ rp->rdat = make_file_data_panel(main_w, "data-form", args, n,
+ WITH_CHANNELS_FIELD,
+ MUS_RAW, raw_sample_type,
+ WITH_DATA_LOCATION_FIELD,
+ WITHOUT_SAMPLES_FIELD,
+ WITHOUT_HEADER_TYPE_FIELD,
+ WITHOUT_COMMENT_FIELD,
+ WITH_READABLE_HEADERS,
+ WITHOUT_SRATE,
+ WITHOUT_AUTO_COMMENT);
+ rp->rdat->dialog = rp->dialog;
+
+ set_file_dialog_sound_attributes(rp->rdat,
+ IGNORE_HEADER_TYPE,
+ raw_sample_type, raw_srate, raw_chans, rp->location,
+ IGNORE_SAMPLES, NULL);
+
+ map_over_children(rp->dialog, set_main_color_of_widget);
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(reset_button, XmNselectColor, ss->selection_color, NULL);
+ XtVaSetValues(rp->rdat->sample_type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ /*
+ * this line makes the dialog take up all vertical space on the screen
+ * XtManageChild(rp->rdat->error_text);
+ */
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->basic_color, NULL);
+
+ XtManageChild(rp->dialog);
+ XtUnmanageChild(rp->rdat->error_text);
+ set_dialog_widget(RAW_DATA_DIALOG, rp->dialog);
+}
+
+
+void raw_data_dialog_to_file_info(const char *filename, char *title, char *info, read_only_t read_only, bool selected)
+{
+ /* put up dialog for srate, chans, sample type */
+ raw_info *rp;
+ rp = new_raw_dialog();
+ rp->read_only = read_only;
+ rp->selected = selected;
+ if (rp->filename) free(rp->filename);
+ rp->filename = mus_strdup(filename);
+ rp->requestor = ss->open_requestor;
+ rp->requestor_data = ss->open_requestor_data;
+ rp->requestor_dialog = ss->requestor_dialog;
+ ss->open_requestor = NO_REQUESTOR;
+ ss->requestor_dialog = NULL;
+ ss->open_requestor_data = NULL;
+ if ((rp->requestor_dialog) &&
+ ((rp->requestor == FROM_OPEN_DIALOG) ||
+ (rp->requestor == FROM_MIX_DIALOG)))
+ XtUnmanageChild(rp->requestor_dialog);
+ if (!title)
+ title = mus_format("no header found on %s\n", filename);
+ if (!(rp->dialog))
+ make_raw_data_dialog(rp, title);
+ else
+ {
+ XmString xstr4;
+ xstr4 = XmStringCreateLocalized(title);
+ XtVaSetValues(rp->dialog,
+ XmNmessageString, xstr4,
+ NULL);
+ XmStringFree(xstr4);
+ }
+ free(title);
+ if (rp->help) free(rp->help);
+ if (info)
+ {
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_HELP_BUTTON),
+ XmNbackground, ss->green,
+ NULL);
+ rp->help = mus_strdup(info);
+ free(info);
+ }
+ else
+ {
+ XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_HELP_BUTTON),
+ XmNbackground, ss->highlight_color,
+ NULL);
+ rp->help = NULL;
+ }
+ raise_dialog(rp->dialog);
+ if (!XtIsManaged(rp->dialog))
+ XtManageChild(rp->dialog);
+}
+
+
+
+/* ---------------- INFO MONOLOG ---------------- */
+
+#define POST_IT_ROWS 12
+#define POST_IT_COLUMNS 56
+
+static Widget post_it_dialog = NULL;
+static Widget post_it_text = NULL;
+
+
+static void create_post_it_monolog(void)
+{
+ /* create scrollable but not editable text window; used for fft peaks, sp info, and raw data help displays */
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ post_it_dialog = XmCreateMessageDialog(MAIN_PANE(ss), (char *)"info", args, n);
+
+ XtUnmanageChild(MSG_BOX(post_it_dialog, XmDIALOG_CANCEL_BUTTON));
+ XtUnmanageChild(MSG_BOX(post_it_dialog, XmDIALOG_HELP_BUTTON));
+ XtUnmanageChild(MSG_BOX(post_it_dialog, XmDIALOG_SYMBOL_LABEL));
+
+ XtVaSetValues(MSG_BOX(post_it_dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->highlight_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNeditMode, XmMULTI_LINE_EDIT); n++;
+ XtSetArg(args[n], XmNeditable, false); n++;
+ XtSetArg(args[n], XmNcolumns, POST_IT_COLUMNS); n++;
+ XtSetArg(args[n], XmNrows, POST_IT_ROWS); n++;
+ XtSetArg(args[n], XmNforeground, ss->black); n++; /* needed if color allocation fails completely */
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ post_it_text = XmCreateScrolledText(post_it_dialog, (char *)"post-it-text", args, n);
+ XtManageChild(post_it_text);
+ XtManageChild(post_it_dialog);
+
+ map_over_children(post_it_dialog, set_main_color_of_widget);
+ XtVaSetValues(post_it_text, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
+ XtVaSetValues(MSG_BOX(post_it_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(post_it_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ set_dialog_widget(POST_IT_DIALOG, post_it_dialog);
+}
+
+
+widget_t post_it(const char *subject, const char *str)
+{
+ /* place string in scrollable help window */
+ XmString xstr1, xstr2;
+ if (ss == NULL) return(NULL); /* an attempt to call this before X/Motif is ready */
+ if (!(post_it_dialog))
+ create_post_it_monolog();
+ else raise_dialog(post_it_dialog);
+ xstr1 = XmStringCreateLocalized((char *)subject);
+ xstr2 = XmStringCreateLocalized((char *)subject);
+ XtVaSetValues(post_it_dialog,
+ XmNmessageString, xstr1,
+ XmNdialogTitle, xstr2,
+ NULL);
+ XmTextSetString(post_it_text, (char *)str);
+ if (!XtIsManaged(post_it_dialog))
+ XtManageChild(post_it_dialog);
+ XmStringFree(xstr1);
+ XmStringFree(xstr2);
+ return(post_it_dialog);
+}
+
+
+void post_it_append(const char *str)
+{
+ if (post_it_dialog)
+ XmTextInsert(post_it_text, XmTextGetLastPosition(post_it_text), (char *)str);
+}
+
+
+void save_post_it_dialog_state(FILE *fd)
+{
+ if ((post_it_dialog) && (XtIsManaged(post_it_dialog)))
+ {
+ char *subject = NULL, *text = NULL;
+ subject = dialog_get_title(post_it_dialog);
+ text = XmTextGetString(post_it_text);
+#if HAVE_SCHEME
+ fprintf(fd, "(%s \"%s\" \"%s\")\n", S_info_dialog, subject, text);
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(\"%s\", \"%s\")\n", to_proc_name(S_info_dialog), subject, text);
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "\"%s\" \"%s\" %s drop\n", subject, text, S_info_dialog);
+#endif
+ if (subject) free(subject);
+ if (text) XtFree(text);
+ }
+}
+
+
+/* ---------------- unsaved edits dialog ---------------- */
+
+static int num_unsaved_edits_dialogs = 0;
+static Widget *unsaved_edits_dialogs = NULL;
+static snd_info **unsaved_edits_sounds = NULL;
+
+static Widget unsaved_edits_dialog(snd_info *sp)
+{
+ int i;
+ /* are there any such dialogs? */
+ if (num_unsaved_edits_dialogs == 0)
+ return(NULL);
+
+ /* now see if we've already prompted about this sound */
+ for (i = 0; i < num_unsaved_edits_dialogs; i++)
+ if (unsaved_edits_sounds[i] == sp)
+ return(unsaved_edits_dialogs[i]);
+
+ /* try to find a free unmanaged dialog */
+ for (i = 0; i < num_unsaved_edits_dialogs; i++)
+ if ((unsaved_edits_dialogs[i]) &&
+ (!XtIsManaged(unsaved_edits_dialogs[i])))
+ return(unsaved_edits_dialogs[i]);
+
+ return(NULL);
+}
+
+static void save_unsaved_edits_dialog(Widget d, snd_info *sp)
+{
+ if (num_unsaved_edits_dialogs == 0)
+ {
+ unsaved_edits_dialogs = (Widget *)calloc(1, sizeof(Widget));
+ unsaved_edits_sounds = (snd_info **)calloc(1, sizeof(snd_info *));
+ }
+ else
+ {
+ unsaved_edits_dialogs = (Widget *)realloc(unsaved_edits_dialogs, (num_unsaved_edits_dialogs + 1) * sizeof(Widget));
+ unsaved_edits_sounds = (snd_info **)realloc(unsaved_edits_sounds, (num_unsaved_edits_dialogs + 1) * sizeof(snd_info *));
+ }
+
+ unsaved_edits_dialogs[num_unsaved_edits_dialogs] = d;
+ unsaved_edits_sounds[num_unsaved_edits_dialogs] = sp;
+ num_unsaved_edits_dialogs++;
+}
+
+
+void unpost_unsaved_edits_if_any(snd_info *sp)
+{
+ int i;
+ for (i = 0; i < num_unsaved_edits_dialogs; i++)
+ if (((unsaved_edits_sounds[i] == sp) ||
+ (!snd_ok(unsaved_edits_sounds[i]))) &&
+ (XtIsManaged(unsaved_edits_dialogs[i])))
+ XtUnmanageChild(unsaved_edits_dialogs[i]);
+}
+
+
+static void zero_edits(chan_info *cp)
+{
+ cp->edit_ctr = 0;
+}
+
+static void unsaved_edits_no_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ for_each_sound_chan(sp, zero_edits);
+ snd_close_file(sp);
+}
+
+static void unsaved_edits_yes_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ save_edits(sp);
+ snd_close_file(sp);
+}
+
+static void unsaved_edits_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_help("save edits?",
+ "You have set " S_ask_about_unsaved_edits " to " PROC_TRUE ", so you will be asked whether you want \
+to save edits if you try to close a sound that has unsaved edits.",
+ WITH_WORD_WRAP);
+}
+
+void save_edits_now(snd_info *sp)
+{
+ char *question;
+ XmString q;
+ Widget dialog;
+
+ question = mus_format("%s has unsaved edits. Save them?", sp->short_filename);
+ q = XmStringCreateLocalized(question);
+
+ dialog = unsaved_edits_dialog(sp);
+ if (!dialog)
+ {
+ Arg args[20];
+ int n;
+ XmString yes, no;
+
+ yes = XmStringCreateLocalized((char *)"yes");
+ no = XmStringCreateLocalized((char *)"no");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNokLabelString, yes); n++;
+ XtSetArg(args[n], XmNcancelLabelString, no); n++;
+ XtSetArg(args[n], XmNmessageString, q); n++;
+ dialog = XmCreateQuestionDialog(MAIN_PANE(ss), sp->filename, args, n);
+ save_unsaved_edits_dialog(dialog, sp);
+
+ XtAddCallback(dialog, XmNhelpCallback, unsaved_edits_help_callback, (XtPointer)sp);
+ XtAddCallback(dialog, XmNokCallback, unsaved_edits_yes_callback, (XtPointer)sp);
+ XtAddCallback(dialog, XmNcancelCallback, unsaved_edits_no_callback, (XtPointer)sp);
+
+ XmStringFree(yes);
+ XmStringFree(no);
+
+ map_over_children(dialog, set_main_color_of_widget);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ }
+ else
+ {
+ XtVaSetValues(dialog, XmNmessageString, q, NULL);
+ }
+
+ XmStringFree(q);
+ free(question);
+ XtManageChild(dialog);
+}
+
+
+
+/* ---------------- file has changed dialog ---------------- */
+
+static int num_file_has_changed_dialogs = 0;
+static Widget *file_has_changed_dialogs = NULL;
+static snd_info **file_has_changed_sounds = NULL;
+
+static Widget file_has_changed_dialog(snd_info *sp)
+{
+ int i;
+ /* are there any such dialogs? */
+ if (num_file_has_changed_dialogs == 0)
+ return(NULL);
+
+ /* now see if we've already prompted about this sound */
+ for (i = 0; i < num_file_has_changed_dialogs; i++)
+ if (file_has_changed_sounds[i] == sp)
+ return(file_has_changed_dialogs[i]);
+
+ /* try to find a free unmanaged dialog */
+ for (i = 0; i < num_file_has_changed_dialogs; i++)
+ if ((file_has_changed_dialogs[i]) &&
+ (!XtIsManaged(file_has_changed_dialogs[i])))
+ return(file_has_changed_dialogs[i]);
+
+ return(NULL);
+}
+
+static void save_file_has_changed_dialog(Widget d, snd_info *sp)
+{
+ if (num_file_has_changed_dialogs == 0)
+ {
+ file_has_changed_dialogs = (Widget *)calloc(1, sizeof(Widget));
+ file_has_changed_sounds = (snd_info **)calloc(1, sizeof(snd_info *));
+ }
+ else
+ {
+ file_has_changed_dialogs = (Widget *)realloc(file_has_changed_dialogs, (num_file_has_changed_dialogs + 1) * sizeof(Widget));
+ file_has_changed_sounds = (snd_info **)realloc(file_has_changed_sounds, (num_file_has_changed_dialogs + 1) * sizeof(snd_info *));
+ }
+
+ file_has_changed_dialogs[num_file_has_changed_dialogs] = d;
+ file_has_changed_sounds[num_file_has_changed_dialogs] = sp;
+ num_file_has_changed_dialogs++;
+}
+
+
+void unpost_file_has_changed_if_any(snd_info *sp)
+{
+ int i;
+ for (i = 0; i < num_file_has_changed_dialogs; i++)
+ if (((file_has_changed_sounds[i] == sp) ||
+ (!snd_ok(file_has_changed_sounds[i]))) &&
+ (XtIsManaged(file_has_changed_dialogs[i])))
+ XtUnmanageChild(file_has_changed_dialogs[i]);
+}
+
+
+static void file_has_changed_no_callback(Widget w, XtPointer context, XtPointer info)
+{
+}
+
+static void file_has_changed_yes_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ save_edits_without_asking(sp);
+ sp->need_update = false;
+ stop_bomb(sp); /* in case Snd already noticed the problem */
+ clear_status_area(sp);
+}
+
+static void file_has_changed_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_help("save edits?",
+ "The file has changed unexpectedly, so in most cases, saving the current edits can't do anything useful. But you can try anyway!",
+ WITH_WORD_WRAP);
+}
+
+void changed_file_dialog(snd_info *sp)
+{
+ char *question;
+ XmString q;
+ Widget dialog;
+
+ question = mus_format("%s has changed! Save edits anyway?", sp->short_filename);
+ q = XmStringCreateLocalized(question);
+
+ dialog = file_has_changed_dialog(sp);
+ if (!dialog)
+ {
+ Arg args[20];
+ int n;
+ XmString yes, no;
+
+ yes = XmStringCreateLocalized((char *)"yes");
+ no = XmStringCreateLocalized((char *)"no");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNokLabelString, yes); n++;
+ XtSetArg(args[n], XmNcancelLabelString, no); n++;
+ XtSetArg(args[n], XmNmessageString, q); n++;
+ dialog = XmCreateQuestionDialog(MAIN_PANE(ss), sp->filename, args, n);
+ save_file_has_changed_dialog(dialog, sp);
+
+ XtAddCallback(dialog, XmNhelpCallback, file_has_changed_help_callback, (XtPointer)sp);
+ XtAddCallback(dialog, XmNokCallback, file_has_changed_yes_callback, (XtPointer)sp);
+ XtAddCallback(dialog, XmNcancelCallback, file_has_changed_no_callback, (XtPointer)sp);
+
+ XmStringFree(yes);
+ XmStringFree(no);
+
+ map_over_children(dialog, set_main_color_of_widget);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ }
+ else
+ {
+ XtVaSetValues(dialog, XmNmessageString, q, NULL);
+ }
+
+ XmStringFree(q);
+ free(question);
+ XtManageChild(dialog);
+}
+
+
+
+/* ---------------- view files dialog ---------------- */
+
+
+/* -------- view files shared code -------- */
+
+static void view_files_clear_selected_files(view_files_info *vdat);
+static int view_files_add_selected_file(view_files_info *vdat, vf_row *r);
+static int view_files_find_row(view_files_info *vdat, const char *name);
+static int view_files_info_size = 0;
+static view_files_info **view_files_infos = NULL;
+
+static Xen vf_open_file_watcher(Xen hook_or_reason)
+{
+ int k;
+ /* reasons are FILE_OPENED|CLOSED, but it's not worth the trouble of splitting them out here */
+
+ /* loop through all vf dialogs ... */
+ for (k = 0; k < view_files_info_size; k++)
+ if ((view_files_infos[k]) &&
+ (view_files_infos[k]->dialog) &&
+ (widget_is_active(view_files_infos[k]->dialog)))
+ {
+ view_files_info *vdat;
+ vdat = view_files_infos[k];
+ vf_mix_insert_buttons_set_sensitive(vdat,
+ ((vdat->currently_selected_files > 0) &&
+ (any_selected_sound())));
+ }
+ return(Xen_false);
+}
+
+Xen_wrap_1_arg(vf_open_file_watcher_w, vf_open_file_watcher)
+
+
+int view_files_dialog_list_length(void)
+{
+ int i, n = 0;
+ for (i = 0; i < view_files_info_size; i++)
+ if ((view_files_infos[i]) &&
+ (view_files_infos[i]->dialog))
+ n++;
+ return(n);
+}
+
+
+char **view_files_dialog_titles(void)
+{
+ int n;
+ n = view_files_dialog_list_length();
+ if (n > 0)
+ {
+ char **titles;
+ int i, j = 0;
+ titles = (char **)calloc(n + 1, sizeof(char *));
+ for (i = 0; i < view_files_info_size; i++)
+ if ((view_files_infos[i]) &&
+ (view_files_infos[i]->dialog))
+ titles[j++] = dialog_get_title(view_files_infos[i]->dialog);
+ return(titles);
+ }
+ return(NULL);
+}
+
+
+void view_files_start_dialog_with_title(const char *title)
+{
+ int i;
+ for (i = 0; i < view_files_info_size; i++)
+ if ((view_files_infos[i]) &&
+ (view_files_infos[i]->dialog))
+ {
+ char *dialog_title = NULL;
+ dialog_title = dialog_get_title(view_files_infos[i]->dialog);
+ if (mus_strcmp(title, dialog_title)) /* this includes NULL == NULL */
+ {
+ if (dialog_title) free(dialog_title);
+ make_view_files_dialog_1(view_files_infos[i], true);
+ return;
+ }
+ if (dialog_title) free(dialog_title);
+ }
+}
+
+
+static view_files_info *new_view_files_dialog(void)
+{
+ /* always returns a new (empty) file viewer -- changed 8-Jan-08 */
+ int loc = -1;
+ view_files_info *vdat;
+
+ if (view_files_info_size == 0)
+ {
+ loc = 0;
+ view_files_info_size = 4;
+ view_files_infos = (view_files_info **)calloc(view_files_info_size, sizeof(view_files_info *));
+ }
+ else
+ {
+ int i;
+ for (i = 0; i < view_files_info_size; i++)
+ if (!view_files_infos[i])
+ {
+ loc = i;
+ break;
+ }
+ if (loc == -1)
+ {
+ loc = view_files_info_size;
+ view_files_info_size += 4;
+ view_files_infos = (view_files_info **)realloc(view_files_infos, view_files_info_size * sizeof(view_files_info *));
+ for (i = loc; i < view_files_info_size; i++) view_files_infos[i] = NULL;
+ }
+ }
+
+ view_files_infos[loc] = (view_files_info *)calloc(1, sizeof(view_files_info));
+ vdat = view_files_infos[loc];
+ vdat->index = loc;
+ vdat->dialog = NULL_WIDGET;
+ vdat->file_list = NULL_WIDGET;
+ vdat->file_list_holder = NULL_WIDGET;
+ vdat->file_list_entries = NULL;
+ vdat->size = 0;
+ vdat->end = -1;
+ vdat->names = NULL;
+ vdat->full_names = NULL;
+ vdat->selected_files = NULL;
+ vdat->selected_files_size = 0;
+ vdat->location_choice = VF_AT_CURSOR;
+ vdat->has_error = false;
+ vdat->need_update = false;
+ vdat->dirs_size = 0;
+ vdat->dirs = NULL;
+ vdat->dir_names = NULL;
+ vdat->amp = 1.0;
+ vdat->speed = 1.0;
+ vdat->amp_env = default_env(1.0, 1.0);
+ vdat->sort_items_size = 0;
+ vdat->sort_items = NULL;
+ vdat->speed_style = speed_control_style(ss);
+
+ /* don't clear at this point! */
+ view_files_infos[loc]->currently_selected_files = 0;
+ view_files_infos[loc]->sorter = view_files_sort(ss);
+ return(view_files_infos[loc]);
+}
+
+
+static int vf_dialog_to_index(widget_t dialog)
+{
+ int i;
+ if ((!dialog) &&
+ (view_files_infos[0]) &&
+ (view_files_infos[0]->dialog))
+ return(0);
+ for (i = 0; i < view_files_info_size; i++)
+ if ((view_files_infos[i]) &&
+ (view_files_infos[i]->dialog == dialog))
+ return(i);
+ return(-1);
+}
+
+
+static view_files_info *vf_dialog_to_info(widget_t dialog)
+{
+ int index;
+ index = vf_dialog_to_index(dialog);
+ if (index >= 0)
+ return(view_files_infos[index]);
+ return(NULL);
+}
+
+
+static char **vf_selected_files(view_files_info *vdat)
+{
+ int len;
+ char **files = NULL;
+ len = vdat->currently_selected_files;
+ if (len > 0)
+ {
+ int i;
+ files = (char **)calloc(len, sizeof(char *));
+ for (i = 0; i < len; i++)
+ files[i] = mus_strdup(vdat->full_names[vdat->selected_files[i]]);
+ }
+ return(files);
+}
+
+
+static char **view_files_selected_files(widget_t dialog, int *len)
+{
+ /* free result */
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ {
+ (*len) = vdat->currently_selected_files;
+ return(vf_selected_files(vdat));
+ }
+ (*len) = 0;
+ return(NULL);
+}
+
+
+static void view_files_run_select_hook(widget_t dialog, const char *selected_file);
+
+static char **view_files_set_selected_files(widget_t dialog, char **files, int len)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ {
+ int i;
+ view_files_clear_selected_files(vdat);
+ for (i = 0; i < len; i++)
+ if (files[i])
+ {
+ int loc;
+ loc = view_files_find_row(vdat, (const char *)(files[i]));
+ if (loc >= 0)
+ {
+ view_files_add_selected_file(vdat, vdat->file_list_entries[loc]);
+ view_files_run_select_hook(vdat->dialog, (const char *)(files[i]));
+ }
+ }
+ vf_mix_insert_buttons_set_sensitive(vdat,
+ ((vdat->currently_selected_files > 0) &&
+ (any_selected_sound())));
+ }
+ return(files);
+}
+
+
+static char **view_files_files(widget_t dialog, int *len)
+{
+ /* don't free result! */
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ {
+ (*len) = vdat->end + 1;
+ return(vdat->full_names);
+ }
+ (*len) = 0;
+ return(NULL);
+}
+
+
+static void view_files_clear_list(view_files_info *vdat);
+
+static char **view_files_set_files(widget_t dialog, char **files, int len)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ {
+ view_files_clear_selected_files(vdat);
+ view_files_clear_list(vdat);
+ if (len > 0)
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ if (files[i])
+ view_files_add_file_or_directory(vdat, (const char *)(files[i]));
+ }
+ view_files_display_list(vdat);
+ }
+ return(files);
+}
+
+
+static void vf_mix_insert_buttons_set_sensitive(view_files_info *vdat, bool sensitive)
+{
+ if (vdat->mixB)
+ {
+ set_sensitive(vdat->mixB, sensitive);
+ set_sensitive(vdat->insertB, sensitive);
+ }
+}
+
+
+static void view_files_clear_selected_files(view_files_info *vdat)
+{
+ int len;
+ len = vdat->currently_selected_files;
+ if (len > 0)
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ {
+ vf_row *r;
+ r = vdat->file_list_entries[vdat->selected_files[i]];
+ if (r)
+ vf_unhighlight_row(r->nm, r->rw);
+ }
+ }
+ vdat->currently_selected_files = 0;
+ vf_mix_insert_buttons_set_sensitive(vdat, false);
+}
+
+
+static void view_files_unselect_file(view_files_info *vdat, vf_row *r)
+{
+ vf_unhighlight_row(r->nm, r->rw);
+ if (vdat->currently_selected_files > 1)
+ {
+ /* need to fixup selected_files list */
+ int i, new_loc = 0;
+ for (i = 0; i < vdat->currently_selected_files; i++)
+ if (vdat->selected_files[i] != r->pos)
+ vdat->selected_files[new_loc++] = vdat->selected_files[i];
+ }
+ vdat->currently_selected_files--;
+ if (vdat->currently_selected_files < 0)
+ vdat->currently_selected_files = 0;
+ if (vdat->currently_selected_files == 0)
+ {
+ vf_mix_insert_buttons_set_sensitive(vdat, false);
+ vf_unpost_info(vdat);
+ }
+}
+
+
+static int view_files_add_selected_file(view_files_info *vdat, vf_row *r)
+{
+ /* returns how many are now selected (counting new) */
+ if (vdat->selected_files_size == 0)
+ {
+ vdat->selected_files_size = 4;
+ vdat->selected_files = (int *)calloc(vdat->selected_files_size, sizeof(int));
+ vdat->selected_files[0] = r->pos;
+ vdat->currently_selected_files = 1;
+ }
+ else
+ {
+ if (vdat->currently_selected_files >= vdat->selected_files_size)
+ {
+ vdat->selected_files_size += 4;
+ vdat->selected_files = (int *)realloc(vdat->selected_files, vdat->selected_files_size * sizeof(int));
+ vdat->selected_files[vdat->currently_selected_files++] = r->pos;
+ }
+ else
+ {
+ vdat->selected_files[vdat->currently_selected_files++] = r->pos;
+ }
+ }
+ vf_highlight_row(r->nm, r->rw);
+ return(vdat->currently_selected_files);
+}
+
+
+static void vf_fixup_selected_files(view_files_info *vdat, char **saved_selected_files, int len)
+{
+ /* various things change the order or contents of the files list, so the selected locs list needs to reflect that */
+ int i, newly_selected = 0;
+ for (i = 0; i < len; i++)
+ {
+ int j;
+ for (j = 0; j <= vdat->end; j++)
+ if ((vdat->full_names[j]) &&
+ (mus_strcmp(vdat->full_names[j], saved_selected_files[i])))
+ {
+ vf_row *old_r, *new_r;
+ /* fprintf(stderr,"old %d at %d -> %d at %d\n", vdat->selected_files[i], i, j, newly_selected); */
+ old_r = vdat->file_list_entries[vdat->selected_files[i]];
+ vdat->selected_files[newly_selected++] = j;
+ new_r = vdat->file_list_entries[j];
+ if (new_r != old_r)
+ {
+ vf_highlight_row(new_r->nm, new_r->rw);
+ vf_unhighlight_row(old_r->nm, old_r->rw);
+ }
+ break;
+ }
+ }
+ vdat->currently_selected_files = newly_selected;
+}
+
+
+static int view_files_find_row(view_files_info *vdat, const char *name)
+{
+ int i;
+ if (vdat->names)
+ for (i = 0; i <= vdat->end; i++)
+ if ((vdat->names[i]) &&
+ (mus_strcmp(vdat->names[i], name)))
+ return(i);
+ if (vdat->full_names)
+ for (i = 0; i <= vdat->end; i++)
+ if ((vdat->full_names[i]) &&
+ (mus_strcmp(vdat->full_names[i], name)))
+ return(i);
+ return(-1);
+}
+
+
+static void view_files_select(vf_row *r, bool add_to_selected)
+{
+ view_files_info *vdat = (view_files_info *)(r->vdat);
+ int i, curloc = -1;
+
+ for (i = 0; i < vdat->currently_selected_files; i++)
+ if (vdat->selected_files[i] == r->pos)
+ {
+ curloc = r->pos;
+ break;
+ }
+ if (curloc == -1)
+ {
+ /* file not currently selected */
+ if (!add_to_selected) /* not shift click, so remove all currently selected files first */
+ view_files_clear_selected_files(vdat);
+ view_files_add_selected_file(vdat, r);
+ view_files_run_select_hook(vdat->dialog, vdat->full_names[r->pos]);
+ }
+ else
+ {
+ /* file already selected, so remove from selected files list */
+ view_files_unselect_file(vdat, r);
+ }
+
+ if ((vdat->currently_selected_files == 0) ||
+ ((vdat->currently_selected_files == 1) &&
+ (!(is_plausible_sound_file(vdat->full_names[vdat->selected_files[0]])))))
+ vf_unpost_info(vdat);
+ else
+ {
+ if (vdat->currently_selected_files == 1)
+ vf_post_info(vdat, vdat->selected_files[0]);
+ else vf_post_selected_files_list(vdat);
+ }
+ vf_mix_insert_buttons_set_sensitive(vdat,
+ ((vdat->currently_selected_files > 0) &&
+ (any_selected_sound())));
+}
+
+
+static bool view_files_play(view_files_info *vdat, int pos, bool play)
+{
+ static snd_info *play_sp;
+ if (play)
+ {
+ if (play_sp)
+ {
+ if (play_sp->playing) return(true); /* can't play two of these at once */
+ if ((vdat->names[pos] == NULL) ||
+ (!mus_strcmp(play_sp->short_filename, vdat->names[pos])))
+ {
+ completely_free_snd_info(play_sp);
+ play_sp = NULL;
+ }
+ }
+ if ((!play_sp) &&
+ (vdat->full_names[pos]))
+ play_sp = make_sound_readable(vdat->full_names[pos], false);
+ if (play_sp)
+ {
+ play_sp->short_filename = vdat->names[pos];
+ play_sp->filename = NULL;
+ /* pass view files dialog settings to play */
+ play_sp->speed_control = vdat->speed;
+ play_sp->amp_control = vdat->amp;
+ play_sound(play_sp, 0, NO_END_SPECIFIED);
+ }
+ else return(true); /* can't find or setup file */
+ }
+ else
+ { /* play toggled off */
+ if ((play_sp) && (play_sp->playing))
+ {
+ stop_playing_sound(play_sp, PLAY_BUTTON_UNSET);
+ vdat->current_play_button = NULL_WIDGET;
+ }
+ }
+ return(false);
+}
+
+
+void view_files_unplay(void)
+{
+ int k;
+ for (k = 0; k < view_files_info_size; k++)
+ if ((view_files_infos[k]) &&
+ (view_files_infos[k]->dialog) &&
+ (widget_is_active(view_files_infos[k]->dialog)))
+ {
+ view_files_info *vdat;
+ vdat = view_files_infos[k];
+ if ((vdat->current_play_button) &&
+ (XmToggleButtonGetState(vdat->current_play_button) != XmUNSET))
+ {
+ set_toggle_button(vdat->current_play_button, false, true, (void *)vdat);
+ vdat->current_play_button = NULL_WIDGET;
+ }
+ }
+}
+
+
+static void view_files_reflect_sort_items(void)
+{
+ int i;
+ view_files_info *vdat;
+ int j = 0, k;
+
+ if (view_files_info_size == 0) return;
+ for (i = 0; i < ss->file_sorters_size; i++)
+ {
+ Xen ref;
+ ref = Xen_vector_ref(ss->file_sorters, i);
+ if (Xen_is_pair(ref))
+ {
+ XmString s1;
+ s1 = XmStringCreateLocalized((char *)Xen_string_to_C_string(Xen_car(ref)));
+ for (k = 0; k < view_files_info_size; k++)
+ if ((view_files_infos[k]) &&
+ (view_files_infos[k]->dialog))
+ {
+ vdat = view_files_infos[k];
+ if (j >= vdat->sort_items_size)
+ {
+ int n = 0, k, old_size;
+ Arg args[20];
+ old_size = vdat->sort_items_size;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ vdat->sort_items_size += 4;
+ vdat->sort_items = (Widget *)realloc(vdat->sort_items, vdat->sort_items_size * sizeof(Widget));
+ for (k = old_size; k < vdat->sort_items_size; k++)
+ vdat->sort_items[k] = XtCreateWidget("unused", xmPushButtonWidgetClass, vdat->smenu, args, n);
+ }
+ XtVaSetValues(vdat->sort_items[j],
+ XmNlabelString, s1,
+ XmNuserData, i + SORT_XEN, /* this is an index into the file_sorters list, not the widget list */
+ NULL);
+ XtManageChild(vdat->sort_items[j]);
+ }
+ j++;
+ XmStringFree(s1);
+ }
+ }
+}
+
+
+/* (add-file-sorter "duration"
+ (lambda (lst)
+ (sort lst
+ (lambda (a b)
+ (> (mus-sound-duration a) (mus-sound-duration b))))))
+
+ */
+
+
+static void vf_add_file(view_files_info *vdat, const char *filename, const char *fullname)
+{
+ vdat->end++;
+ if (vdat->end >= vdat->size)
+ {
+ int new_size;
+ new_size = vdat->size + 32;
+ if (vdat->size == 0)
+ {
+ vdat->names = (char **)calloc(new_size, sizeof(char *));
+ vdat->full_names = (char **)calloc(new_size, sizeof(char *));
+ }
+ else
+ {
+ int i;
+ vdat->names = (char **)realloc(vdat->names, new_size * sizeof(char *));
+ vdat->full_names = (char **)realloc(vdat->full_names, new_size * sizeof(char *));
+ for (i = vdat->size; i < new_size; i++)
+ {
+ vdat->names[i] = NULL;
+ vdat->full_names[i] = NULL;
+ }
+ }
+ if (vdat->file_list_entries == NULL)
+ vdat->file_list_entries = (vf_row **)calloc(new_size, sizeof(vf_row *));
+ else
+ {
+ int i;
+ vdat->file_list_entries = (vf_row **)realloc(vdat->file_list_entries, new_size * sizeof(vf_row *));
+ for (i = vdat->size; i < new_size; i++) vdat->file_list_entries[i] = NULL;
+ }
+ vdat->size = new_size;
+ }
+ vdat->names[vdat->end] = mus_strdup(filename);
+ vdat->full_names[vdat->end] = mus_strdup(fullname);
+}
+
+
+static void add_file_to_view_files_list(view_files_info *vdat, const char *filename, const char *fullname)
+{
+ int row;
+
+ row = view_files_find_row(vdat, filename);
+ if (row != -1)
+ {
+ if ((vdat->dialog) &&
+ (widget_is_active(vdat->dialog)) &&
+ (vdat->file_list_entries[row]))
+ {
+ ensure_scrolled_window_row_visible(vdat->file_list, row, vdat->end + 1);
+ vf_flash_row(vdat->file_list_entries[row]);
+ }
+ return;
+ }
+
+ errno = 0;
+ if (!(mus_file_probe(fullname)))
+ {
+ if ((vdat->dialog) &&
+ (widget_is_active(vdat->dialog)))
+ {
+ char *msg;
+ if (errno != 0)
+ msg = mus_format("%s: %s", filename, strerror(errno));
+ else msg = mus_format("%s does not exist", filename);
+ vf_post_add_error(msg, vdat);
+ free(msg);
+ }
+ return;
+ }
+
+ vf_add_file(vdat, filename, fullname);
+}
+
+
+
+/* what about temps coming and going -- should we just add a need-update switch for later remanage? */
+/* remanagement only through make_view_files_dialog -- this file */
+/* perhaps ss->making|deleting_temp_file -> ignore this fam event? */
+
+static void add_directory_to_view_files_list(view_files_info *vdat, const char *dirname)
+{
+ /* I think all directory additions come through here */
+
+ if ((dirname) && (dirname[strlen(dirname) - 1] != '/'))
+ {
+ char *add_slash;
+ add_slash = mus_format("%s/", dirname);
+ add_directory_to_view_files_list(vdat, add_slash);
+ free(add_slash);
+ }
+ else
+ {
+ dir_info *sound_files = NULL;
+#if (!USE_NO_GUI)
+ view_files_monitor_directory(vdat, dirname);
+#endif
+ sound_files = find_sound_files_in_dir(dirname);
+ if ((sound_files) &&
+ (sound_files->len > 0))
+ {
+ int i, dirs = 0, len = 16;
+ for (i = 0; i < sound_files->len; i++)
+ add_file_to_view_files_list(vdat, sound_files->files[i]->filename, sound_files->files[i]->full_filename);
+ sound_files = free_dir_info(sound_files);
+
+ /* fixup title */
+ for (i = 0; i < vdat->dirs_size; i++)
+ if (vdat->dir_names[i])
+ {
+ dirs++;
+ len += mus_strlen(just_filename(vdat->dir_names[i]));
+ }
+ if ((dirs < 4) &&
+ (len < 512))
+ {
+ int cur_dir = 0;
+ char *titlestr = NULL, *dirstr;
+ titlestr = (char *)calloc(len + dirs * 8, sizeof(char));
+ strcat(titlestr, "Files: ");
+ for (i = 0; i < vdat->dirs_size; i++)
+ if (vdat->dir_names[i])
+ {
+ dirstr = just_filename(vdat->dir_names[i]);
+ strcat(titlestr, dirstr);
+ free(dirstr);
+ cur_dir++;
+ if (cur_dir < dirs)
+ strcat(titlestr, ", ");
+ }
+ dialog_set_title(vdat->dialog, titlestr);
+ free(titlestr);
+ }
+ }
+ }
+}
+
+
+static void view_files_sort_list(view_files_info *vdat)
+{
+ if (vdat->end >= 0)
+ {
+ sort_info **data;
+ int i, len;
+
+ len = vdat->end + 1;
+ data = (sort_info **)calloc(len, sizeof(sort_info *));
+
+ for (i = 0; i < len; i++)
+ {
+ data[i] = (sort_info *)calloc(1, sizeof(sort_info));
+ data[i]->filename = vdat->names[i];
+ data[i]->full_filename = vdat->full_names[i];
+ }
+
+ snd_sort(vdat->sorter, data, len);
+
+ for (i = 0; i < len; i++)
+ {
+ vdat->names[i] = data[i]->filename;
+ vdat->full_names[i] = data[i]->full_filename;
+ free(data[i]);
+ }
+ free(data);
+ }
+}
+
+
+static void view_files_display_list(view_files_info *vdat)
+{
+ int i;
+ vf_row *r;
+
+ if (!vdat) return;
+ if (!(vdat->dialog)) return;
+
+ if (vdat->end >= 0)
+ {
+ int i, old_len;
+ char **old_names = NULL;
+ widget_t last_row = NULL_WIDGET; /* ignored in gtk version */
+
+ old_len = vdat->currently_selected_files;
+ if (old_len > 0)
+ old_names = vf_selected_files(vdat);
+
+ view_files_sort_list(vdat);
+ for (i = 0; i <= vdat->end; i++)
+ {
+ r = vdat->file_list_entries[i];
+ if (!r)
+ {
+ r = view_files_make_row(vdat, last_row);
+ vdat->file_list_entries[i] = r;
+ r->pos = i;
+ }
+ set_button_label(r->nm, vdat->names[r->pos]);
+#if WITH_AUDIO
+ set_toggle_button(r->pl, false, false, (void *)vdat);
+#endif
+ if (!(widget_is_active(r->rw))) activate_widget(r->rw);
+ last_row = r->rw;
+ }
+
+ if (old_names)
+ {
+ vf_fixup_selected_files(vdat, old_names, old_len);
+ for (i = 0; i < old_len; i++) free(old_names[i]);
+ free(old_names);
+ }
+ }
+
+ for (i = vdat->end + 1; i < vdat->size; i++)
+ {
+ r = vdat->file_list_entries[i];
+ if (r)
+ {
+ if (widget_is_active(r->rw))
+ deactivate_widget(r->rw);
+ }
+ }
+
+ if (!(widget_is_active(vdat->file_list)))
+ activate_widget(vdat->file_list);
+}
+
+
+static void view_files_clear_list(view_files_info *vdat)
+{
+#if (!USE_NO_GUI)
+ view_files_unmonitor_directories(vdat);
+#endif
+ if (vdat->names)
+ {
+ int i;
+ for (i = 0; i < vdat->size; i++)
+ if (vdat->names[i])
+ {
+ free(vdat->names[i]);
+ vdat->names[i] = NULL;
+ free(vdat->full_names[i]);
+ vdat->full_names[i] = NULL;
+ }
+ vdat->end = -1;
+ vdat->currently_selected_files = 0;
+ }
+}
+
+#if 0
+static void view_files_update_list(view_files_info *vdat)
+{
+ /* here we need the file's full name */
+ int i, old_len;
+ char **old_names = NULL;
+
+ old_len = vdat->currently_selected_files;
+ if (old_len > 0)
+ old_names = vf_selected_files(vdat);
+
+ if (vdat->names)
+ {
+ int i, j;
+ for (i = 0; i <= vdat->end; i++)
+ if (vdat->names[i])
+ {
+ if (!(mus_file_probe(vdat->full_names[i])))
+ {
+ free(vdat->names[i]);
+ vdat->names[i] = NULL;
+ free(vdat->full_names[i]);
+ vdat->full_names[i] = NULL;
+ }
+ }
+
+ for (i = 0, j = 0; i <= vdat->end; i++)
+ if (vdat->names[i])
+ {
+ if (i != j)
+ {
+ vdat->names[j] = vdat->names[i];
+ vdat->names[i] = NULL;
+ vdat->full_names[j] = vdat->full_names[i];
+ vdat->full_names[i] = NULL;
+ }
+ j++;
+ }
+ vdat->end = j - 1;
+ }
+
+ if (old_names)
+ {
+ vf_fixup_selected_files(vdat, old_names, old_len);
+ for (i = 0; i < old_len; i++) free(old_names[i]);
+ free(old_names);
+ }
+}
+#endif
+
+
+static void vf_clear_error(view_files_info *vdat)
+{
+ if (vdat->currently_selected_files == 1)
+ vf_post_info(vdat, vdat->selected_files[0]);
+ else
+ {
+ if (vdat->currently_selected_files == 0)
+ vf_unpost_info(vdat);
+ else vf_post_selected_files_list(vdat);
+ }
+ vdat->has_error = false;
+}
+
+
+static int vf_mix(view_files_info *vdat)
+{
+ int len, id_or_error = 0;
+ snd_info *sp;
+
+ sp = any_selected_sound();
+ len = vdat->currently_selected_files;
+
+ if ((len == 1) &&
+ (snd_feq(vdat->amp, 1.0)) &&
+ (snd_feq(vdat->speed, 1.0)) &&
+ (is_default_env(vdat->amp_env)))
+ id_or_error = mix_complete_file(sp, vdat->beg,
+ vdat->full_names[vdat->selected_files[0]],
+ with_mix_tags(ss), DONT_DELETE_ME, MIX_SETS_SYNC_LOCALLY, NULL);
+ else
+ {
+ int i;
+ bool err = false;
+ char *tempfile;
+ char **selected_files;
+
+ selected_files = vf_selected_files(vdat);
+ tempfile = scale_and_src(selected_files, len, sp->nchans, vdat->amp, vdat->speed, vdat->amp_env, &err);
+
+ if (err)
+ {
+ vf_post_error(tempfile, vdat);
+ id_or_error = MIX_FILE_NO_TEMP_FILE;
+ }
+ else
+ {
+ if (sp->nchans > 1)
+ remember_temp(tempfile, sp->nchans);
+ id_or_error = mix_complete_file(sp, vdat->beg, tempfile,
+ with_mix_tags(ss),
+ (sp->nchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
+ MIX_SETS_SYNC_LOCALLY, NULL);
+ }
+ free(tempfile);
+ for (i = 0; i < len; i++)
+ free(selected_files[i]);
+ free(selected_files);
+ }
+ return(id_or_error);
+}
+
+
+static void view_files_mix_selected_files(widget_t w, view_files_info *vdat)
+{
+ vdat->has_error = false;
+ redirect_snd_error_to(redirect_vf_post_location_error, (void *)vdat);
+ vdat->beg = vf_location(vdat);
+ redirect_snd_error_to(NULL, NULL);
+
+ if (!(vdat->has_error))
+ {
+ int id_or_error = 0;
+
+ redirect_snd_error_to(redirect_vf_post_error, (void *)vdat);
+ ss->requestor_dialog = w;
+ ss->open_requestor_data = (void *)vdat;
+ ss->open_requestor = FROM_VIEW_FILES_MIX_DIALOG;
+ id_or_error = vf_mix(vdat);
+
+ /* "id_or_error" here is either one of the mix id's or an error indication such as MIX_FILE_NO_MIX */
+ /* the possible error conditions have been checked already, or go through snd_error */
+
+ redirect_snd_error_to(NULL, NULL);
+ if (id_or_error >= 0)
+ {
+ char *msg;
+ if (vdat->currently_selected_files == 1)
+ msg = mus_format("%s mixed in at %lld", vdat->names[vdat->selected_files[0]], vdat->beg);
+ else msg = mus_format("selected files mixed in at %lld", vdat->beg);
+ vf_post_error(msg, vdat);
+ vdat->has_error = false;
+ free(msg);
+ }
+ }
+}
+
+
+static bool vf_insert(view_files_info *vdat)
+{
+ int len;
+ bool ok = false;
+ snd_info *sp;
+ sp = any_selected_sound();
+
+ len = vdat->currently_selected_files;
+ if ((len == 1) &&
+ (snd_feq(vdat->amp, 1.0)) &&
+ (snd_feq(vdat->speed, 1.0)) &&
+ (is_default_env(vdat->amp_env)))
+ ok = insert_complete_file(sp,
+ vdat->full_names[vdat->selected_files[0]],
+ vdat->beg,
+ DONT_DELETE_ME);
+ else
+ {
+ int i;
+ bool err = false;
+ char *tempfile;
+ char **selected_files;
+
+ selected_files = vf_selected_files(vdat);
+ tempfile = scale_and_src(selected_files, len, sp->nchans, vdat->amp, vdat->speed, vdat->amp_env, &err);
+
+ if (err)
+ {
+ vf_post_error(tempfile, vdat);
+ ok = false;
+ }
+ else
+ {
+ vf_clear_error(vdat);
+ if (sp->nchans > 1)
+ remember_temp(tempfile, sp->nchans);
+ ok = insert_complete_file(sp,
+ tempfile,
+ vdat->beg,
+ (sp->nchans > 1) ? MULTICHANNEL_DELETION : DELETE_ME);
+ }
+ free(tempfile);
+ for (i = 0; i < len; i++)
+ free(selected_files[i]);
+ free(selected_files);
+ }
+ return(ok);
+}
+
+
+static void view_files_insert_selected_files(widget_t w, view_files_info *vdat)
+{
+ vdat->has_error = false;
+ redirect_snd_error_to(redirect_vf_post_location_error, (void *)vdat);
+ vdat->beg = vf_location(vdat);
+ redirect_snd_error_to(NULL, NULL);
+
+ if (!(vdat->has_error))
+ {
+ bool ok;
+
+ redirect_snd_error_to(redirect_vf_post_error, (void *)vdat);
+ redirect_snd_warning_to(redirect_vf_post_error, (void *)vdat);
+ ss->requestor_dialog = w;
+ ss->open_requestor = FROM_VIEW_FILES_INSERT_DIALOG;
+ ss->open_requestor_data = (void *)vdat;
+ ok = vf_insert(vdat);
+ redirect_snd_error_to(NULL, NULL);
+ redirect_snd_warning_to(NULL, NULL);
+
+ if (ok)
+ {
+ char *msg;
+ if (vdat->currently_selected_files == 1)
+ msg = mus_format("%s inserted at %lld", vdat->names[vdat->selected_files[0]], vdat->beg);
+ else msg = mus_format("selected files inserted at %lld", vdat->beg);
+ vf_post_error(msg, vdat);
+ vdat->has_error = false;
+ free(msg);
+ }
+ /* else we've already posted whatever went wrong (make_file_info etc) */
+ }
+}
+
+
+static mus_float_t view_files_amp(widget_t dialog)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ return(vdat->amp);
+ return(0.0);
+}
+
+
+static mus_float_t view_files_set_amp(widget_t dialog, mus_float_t new_amp)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ vf_set_amp(vdat, new_amp);
+ return(new_amp);
+}
+
+
+static mus_float_t view_files_speed(widget_t dialog)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ return(vdat->speed);
+ return(1.0);
+}
+
+
+static mus_float_t view_files_set_speed(widget_t dialog, mus_float_t new_speed)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ vf_set_speed(vdat, new_speed);
+ return(new_speed);
+}
+
+
+static speed_style_t view_files_speed_style(widget_t dialog)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ return(vdat->speed_style);
+ return(SPEED_CONTROL_AS_FLOAT);
+}
+
+
+static speed_style_t view_files_set_speed_style(widget_t dialog, speed_style_t speed_style)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ {
+ vdat->speed_style = speed_style;
+ vf_set_speed(vdat, vdat->speed); /* update label etc */
+ }
+ return(speed_style);
+}
+
+
+static env *view_files_amp_env(widget_t dialog)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ return(vdat->amp_env);
+ return(NULL);
+}
+
+
+static void view_files_set_amp_env(widget_t dialog, env *new_e)
+{
+ vf_set_amp_env(vf_dialog_to_info(dialog), new_e);
+}
+
+
+static int view_files_local_sort(widget_t dialog)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ return(vdat->sorter);
+ return(-1);
+}
+
+
+static int view_files_set_local_sort(widget_t dialog, int sort_choice)
+{
+ view_files_info *vdat;
+ vdat = vf_dialog_to_info(dialog);
+ if (vdat)
+ {
+ vdat->sorter = sort_choice;
+ view_files_display_list(vdat);
+ vf_reflect_sort_choice_in_menu(vdat);
+ }
+ return(sort_choice);
+}
+
+
+static view_files_info *view_files_find_dialog(widget_t dialog)
+{
+ int i;
+ for (i = 0; i < view_files_info_size; i++)
+ if ((view_files_infos[i]) &&
+ (view_files_infos[i]->dialog == dialog))
+ return(view_files_infos[i]);
+ return(NULL);
+}
+
+
+widget_t make_view_files_dialog(bool managed, bool make_new)
+{
+ int i;
+ view_files_info *vdat = NULL;
+
+ if (make_new)
+ return(make_view_files_dialog_1(new_view_files_dialog(), managed));
+
+ for (i = 0; i < view_files_info_size; i++)
+ if ((view_files_infos[i]) &&
+ (view_files_infos[i]->dialog))
+ {
+ vdat = view_files_infos[i];
+ if (widget_is_active(vdat->dialog))
+ break;
+ }
+
+ if (vdat)
+ return(make_view_files_dialog_1(vdat, managed));
+ return(make_view_files_dialog_1(new_view_files_dialog(), managed));
+}
+
+
+void save_view_files_dialogs(FILE *fd)
+{
+#if HAVE_EXTENSION_LANGUAGE
+ int i;
+ view_files_info *vdat;
+ for (i = 0; i < view_files_info_size; i++)
+ if ((view_files_infos[i]) &&
+ (view_files_infos[i]->dialog) &&
+ (widget_is_active(view_files_infos[i]->dialog)))
+ {
+ vdat = view_files_infos[i];
+
+#if HAVE_SCHEME
+ fprintf(fd, "(let ((vf (" S_view_files_dialog " #t #t)))\n");
+
+ if (vdat->full_names)
+ {
+ int k;
+ fprintf(fd, " (set! (" S_view_files_files " vf) (list");
+ for (k = 0; k <= vdat->end; k++)
+ fprintf(fd, " \"%s\"", vdat->full_names[k]);
+ fprintf(fd, "))\n");
+ if (vdat->currently_selected_files > 0)
+ {
+ fprintf(fd, " (set! (" S_view_files_selected_files " vf) (list");
+ for (k = 0; k < vdat->currently_selected_files; k++)
+ fprintf(fd, " \"%s\"", vdat->full_names[vdat->selected_files[k]]);
+ fprintf(fd, "))\n");
+ }
+ }
+ if (!(snd_feq(vdat->amp, 1.0)))
+ fprintf(fd, " (set! (" S_view_files_amp " vf) %.3f)\n", vdat->amp);
+
+ if (!(snd_feq(vdat->speed, 1.0)))
+ fprintf(fd, " (set! (" S_view_files_speed " vf) %.3f)\n", vdat->speed);
+
+ if (!(is_default_env(vdat->amp_env)))
+ fprintf(fd, " (set! (" S_view_files_amp_env " vf) %s)\n", env_to_string(vdat->amp_env));
+
+ /* assume file-sorters are set up already */
+ fprintf(fd, " (set! (" S_view_files_sort " vf) %d)\n", vdat->sorter);
+ fprintf(fd, ")\n");
+#endif
+
+#if HAVE_RUBY
+ fprintf(fd, "vf = view_files_dialog(true, true)\n");
+
+ if (vdat->full_names)
+ {
+ int k;
+ fprintf(fd, " set_view_files_files(vf, [");
+ for (k = 0; k < vdat->end; k++)
+ fprintf(fd, "\"%s\", ", vdat->full_names[k]);
+ fprintf(fd, "\"%s\"])\n", vdat->full_names[vdat->end]);
+ if (vdat->currently_selected_files > 0)
+ {
+ fprintf(fd, " set_view_files_selected_files(vf, [");
+ for (k = 0; k < vdat->currently_selected_files - 1; k++)
+ fprintf(fd, "\"%s\", ", vdat->full_names[vdat->selected_files[k]]);
+ fprintf(fd, "\"%s\"])\n", vdat->full_names[vdat->selected_files[vdat->currently_selected_files]]);
+ }
+ }
+ if (!(snd_feq(vdat->amp, 1.0)))
+ fprintf(fd, " set_view_files_amp(vf, %.3f)\n", vdat->amp);
+
+ if (!(snd_feq(vdat->speed, 1.0)))
+ fprintf(fd, " set_view_files_speed(vf, %.3f)\n", vdat->speed);
+
+ if (!(is_default_env(vdat->amp_env)))
+ fprintf(fd, " set_view_files_amp_env(vf, %s)\n", env_to_string(vdat->amp_env));
+
+ /* assume file-sorters are set up already */
+ fprintf(fd, " set_view_files_sort(vf, %d)\n", vdat->sorter);
+ fprintf(fd, "\n");
+#endif
+
+#if HAVE_FORTH
+ fprintf(fd, "#t #t view-files-dialog value vf\n");
+
+ if (vdat->full_names)
+ {
+ int k;
+ fprintf(fd, " vf '(");
+ for (k = 0; k <= vdat->end; k++)
+ fprintf(fd, " \"%s\"", vdat->full_names[k]);
+ fprintf(fd, " ) set-view-files-files drop\n");
+ if (vdat->currently_selected_files > 0)
+ {
+ fprintf(fd, " vf '(");
+ for (k = 0; k <= vdat->currently_selected_files; k++)
+ fprintf(fd, " \"%s\"", vdat->full_names[vdat->selected_files[k]]);
+ fprintf(fd, " ) set-view-files-selected-files drop\n");
+ }
+ }
+ if (!(snd_feq(vdat->amp, 1.0)))
+ fprintf(fd, " vf %.3f set-view-files-amp drop\n", vdat->amp);
+
+ if (!(snd_feq(vdat->speed, 1.0)))
+ fprintf(fd, " vf %.3f set-view-files-speed drop\n", vdat->speed);
+
+ if (!(is_default_env(vdat->amp_env)))
+ fprintf(fd, " vf %s set-view-files-amp-env drop\n", env_to_string(vdat->amp_env));
+
+ /* assume file-sorters are set up already */
+ fprintf(fd, " vf %d set-view-files-sort drop\n\n", vdat->sorter);
+#endif
+ }
+#endif
+}
+
+
+void view_files_add_directory(widget_t dialog, const char *dirname)
+{
+ view_files_info *vdat = NULL;
+
+ if (dialog)
+ vdat = view_files_find_dialog(dialog);
+ else
+ {
+ if (view_files_info_size > 0)
+ vdat = view_files_infos[0];
+ else
+ {
+ vdat = new_view_files_dialog();
+ make_view_files_dialog_1(vdat, false);
+ }
+ }
+
+ if (vdat)
+ {
+ char *full_filename;
+ full_filename = mus_expand_filename((const char *)dirname);
+ if (!(mus_file_probe(full_filename)))
+ {
+ if ((vdat->dialog) &&
+ (widget_is_active(vdat->dialog)))
+ {
+ char *msg;
+ if (errno != 0)
+ msg = mus_format("%s: %s", full_filename, strerror(errno));
+ else msg = mus_format("%s does not exist", full_filename);
+ vf_post_add_error(msg, vdat);
+ free(msg);
+ }
+ }
+ else
+ {
+ add_directory_to_view_files_list(vdat, full_filename);
+ }
+ free(full_filename);
+ }
+}
+
+
+static void view_files_add_file(widget_t dialog, const char *filename)
+{
+ view_files_info *vdat = NULL;
+
+ if (dialog)
+ vdat = view_files_find_dialog(dialog);
+ else
+ {
+ if (view_files_info_size > 0)
+ vdat = view_files_infos[0];
+ else
+ {
+ vdat = new_view_files_dialog();
+ make_view_files_dialog_1(vdat, false);
+ }
+ }
+
+ if (vdat)
+ {
+ char *full_filename;
+ full_filename = mus_expand_filename((const char *)filename);
+ add_file_to_view_files_list(vdat, filename, full_filename);
+ free(full_filename);
+ }
+}
+
+
+static void view_files_open_selected_files(view_files_info *vdat)
+{
+ ss->open_requestor = FROM_VIEW_FILES;
+
+ if (vdat->currently_selected_files > 0)
+ {
+ int i;
+ snd_info *sp = NULL;
+ for (i = 0; i < vdat->currently_selected_files; i++)
+ sp = snd_open_file(vdat->full_names[vdat->selected_files[i]], FILE_READ_WRITE);
+ if (sp) select_channel(sp, 0);
+ }
+}
+
+
+char *view_files_find_any_directory(void)
+{
+ /* find any active directory in any vf dialog */
+ if (view_files_info_size > 0)
+ {
+ int j;
+ for (j = 0; j < view_files_info_size; j++)
+ {
+ view_files_info *vdat;
+ vdat = view_files_infos[j];
+ if ((vdat) &&
+ (vdat->dir_names))
+ {
+ int i;
+ for (i = 0; i < vdat->dirs_size; i++)
+ if (vdat->dir_names[i])
+ return(vdat->dir_names[i]);
+ }
+ }
+ }
+ return(NULL);
+}
+
+
+
+static Xen mouse_enter_label_hook;
+static Xen mouse_leave_label_hook;
+
+static char *vf_row_get_label(void *ur)
+{
+ vf_row *r = (vf_row *)ur;
+ return(((view_files_info *)(r->vdat))->full_names[r->pos]);
+}
+
+
+static int vf_row_get_pos(void *ur)
+{
+ vf_row *r = (vf_row *)ur;
+ return(r->pos);
+}
+
+
+static void mouse_enter_or_leave_label(void *r, int type, Xen hook, const char *caller)
+{
+ if ((r) &&
+ (Xen_hook_has_list(hook)))
+ {
+ char *label = NULL;
+ bool need_free = false;
+ if (type == FILE_VIEWER)
+ label = vf_row_get_label(r);
+ else
+ {
+ label = regrow_get_label(r);
+ if (label) need_free = true;
+ }
+ if (label)
+ run_hook(hook,
+ Xen_list_3(C_int_to_Xen_integer(type),
+ C_int_to_Xen_integer((type == FILE_VIEWER) ? (vf_row_get_pos(r)) : (regrow_get_pos(r))),
+ C_string_to_Xen_string(label)),
+ caller);
+ if (need_free) XtFree(label);
+ }
+}
+
+
+void mouse_leave_label(void *r, int type)
+{
+ mouse_enter_or_leave_label(r, type, mouse_leave_label_hook, S_mouse_leave_label_hook);
+}
+
+
+void mouse_enter_label(void *r, int type)
+{
+ mouse_enter_or_leave_label(r, type, mouse_enter_label_hook, S_mouse_enter_label_hook);
+}
+
+
+static void vf_mouse_enter_label(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ mouse_enter_label(context, FILE_VIEWER);
+}
+
+
+static void vf_mouse_leave_label(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ mouse_leave_label(context, FILE_VIEWER);
+}
+
+
+static vf_row *make_vf_row(view_files_info *vdat,
+ Widget last_row,
+ XtCallbackProc play_callback, XtCallbackProc name_callback)
+{
+ int n;
+ Arg args[32];
+ vf_row *r;
+ XmString s1;
+#if WITH_AUDIO
+ XtCallbackList n1;
+#endif
+ XtCallbackList n3;
+
+ s1 = XmStringCreateLocalized((char *)"");
+ r = (vf_row *)calloc(1, sizeof(vf_row));
+ r->vdat = (void *)vdat;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, (last_row) ? XmATTACH_WIDGET : XmATTACH_FORM); n++;
+ if (last_row) {XtSetArg(args[n], XmNtopWidget, last_row); n++;}
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNheight, 18); n++;
+ r->rw = XtCreateWidget("rw", xmFormWidgetClass, vdat->file_list_holder, args, n);
+
+#if WITH_AUDIO
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n1 = make_callback_list(play_callback, (XtPointer)r)); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ XtSetArg(args[n], XmNmarginWidth, 8); n++;
+ r->pl = make_togglebutton_widget("pl", r->rw, args, n);
+#endif
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+#if WITH_AUDIO
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, r->pl); n++;
+#else
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+#endif
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNwidth, 500); n++; /* this sets the max name length indirectly -- was 300 which truncates some long file names (29-Oct-07) */
+ XtSetArg(args[n], XmNactivateCallback, n3 = make_callback_list(name_callback, (XtPointer)r)); n++;
+ r->nm = XtCreateManagedWidget("nm", xmPushButtonWidgetClass, r->rw, args, n);
+ XmStringFree(s1);
+
+ XtAddEventHandler(r->nm, EnterWindowMask, false, vf_mouse_enter_label, (XtPointer)r);
+ XtAddEventHandler(r->nm, LeaveWindowMask, false, vf_mouse_leave_label, (XtPointer)r);
+
+#if WITH_AUDIO
+ free(n1);
+#endif
+ free(n3);
+ return(r);
+}
+
+
+static void vf_unhighlight_row(widget_t nm, widget_t rw)
+{
+ XtVaSetValues(rw, XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(nm, XmNbackground, ss->highlight_color, NULL);
+}
+
+
+static void vf_highlight_row(widget_t nm, widget_t rw)
+{
+ XtVaSetValues(rw, XmNbackground, ss->zoom_color, NULL);
+ XtVaSetValues(nm, XmNbackground, ss->zoom_color, NULL);
+}
+
+
+typedef struct {
+ vf_row *r;
+ color_t old_color;
+} vf_flash_data;
+
+
+static void vf_unflash_row(XtPointer data, XtIntervalId *id)
+{
+ vf_flash_data *v = (vf_flash_data *)data;
+ XtVaSetValues(v->r->rw, XmNbackground, v->old_color, NULL);
+ XtVaSetValues(v->r->nm, XmNbackground, v->old_color, NULL);
+ free(v);
+}
+
+
+static void vf_flash_row(vf_row *r)
+{
+ vf_flash_data *v;
+ v = (vf_flash_data *)calloc(1, sizeof(vf_flash_data));
+ v->r = r;
+ XtVaGetValues(r->rw, XmNbackground, &(v->old_color), NULL);
+ XtVaSetValues(r->rw, XmNbackground, ss->light_blue, NULL);
+ XtVaSetValues(r->nm, XmNbackground, ss->light_blue, NULL);
+ XtAppAddTimeOut(MAIN_APP(ss),
+ 500,
+ (XtTimerCallbackProc)vf_unflash_row,
+ (void *)v);
+}
+
+
+static void vf_post_info(view_files_info *vdat, int pos)
+{
+ char *title;
+ XmString s3;
+ title = mus_format("%s:", vdat->names[pos]);
+ s3 = XmStringCreateLocalized(title);
+ XtVaSetValues(vdat->left_title,
+ XmNlabelString, s3,
+ NULL);
+ XmStringFree(s3);
+ free(title);
+ post_sound_info(vdat->info1, vdat->info2, vdat->full_names[pos], false);
+}
+
+
+static void vf_post_selected_files_list(view_files_info *vdat)
+{
+ int len;
+ char *msg1 = NULL, *msg2 = NULL, *title;
+ XmString s1, s2, s3;
+ len = vdat->currently_selected_files;
+
+ title = mus_strdup("selected files:");
+ s3 = XmStringCreateLocalized(title);
+ XtVaSetValues(vdat->left_title,
+ XmNlabelString, s3,
+ NULL);
+ XmStringFree(s3);
+ free(title);
+
+ if (len == 2)
+ {
+ msg1 = mus_strdup(vdat->names[vdat->selected_files[0]]);
+ msg2 = mus_strdup(vdat->names[vdat->selected_files[1]]);
+ }
+ else
+ {
+ if (len == 3)
+ {
+ msg1 = mus_format("%s, %s", vdat->names[vdat->selected_files[0]], vdat->names[vdat->selected_files[1]]);
+ msg2 = mus_strdup(vdat->names[vdat->selected_files[2]]);
+ }
+ else
+ {
+ msg1 = mus_format("%s, %s", vdat->names[vdat->selected_files[0]], vdat->names[vdat->selected_files[1]]);
+ msg2 = mus_format("%s, %s%s", vdat->names[vdat->selected_files[2]], vdat->names[vdat->selected_files[3]],
+ (len == 4) ? "" : "...");
+ }
+ }
+
+ s1 = XmStringCreateLocalized(msg1);
+ s2 = XmStringCreateLocalized(msg2);
+ XtVaSetValues(vdat->info1, XmNlabelString, s1, NULL);
+ XtVaSetValues(vdat->info2, XmNlabelString, s2, NULL);
+ XmStringFree(s1);
+ XmStringFree(s2);
+ free(msg1);
+ free(msg2);
+}
+
+
+static void vf_unpost_info(view_files_info *vdat)
+{
+ XmString s1, s2, s3;
+ char *title;
+
+ title = mus_strdup("(no files selected)");
+ s3 = XmStringCreateLocalized(title);
+ XtVaSetValues(vdat->left_title,
+ XmNlabelString, s3,
+ NULL);
+ XmStringFree(s3);
+ free(title);
+
+ s1 = XmStringCreateLocalized((char *)"|");
+ s2 = XmStringCreateLocalized((char *)"|");
+ XtVaSetValues(vdat->info1, XmNlabelString, s1, NULL);
+ XtVaSetValues(vdat->info2, XmNlabelString, s2, NULL);
+ XmStringFree(s1);
+ XmStringFree(s2);
+}
+
+
+static void view_files_select_callback(Widget w, XtPointer context, XtPointer info)
+{
+ static oclock_t mouse_down_time = 0;
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ XButtonEvent *ev;
+ ev = (XButtonEvent *)(cb->event);
+
+ /* cb->click_count is always 1 so we can't detect a double-click that way
+ * ss->click_time has the (very short!) multiclick time
+ */
+
+ if (mouse_down_time != 0)
+ {
+ if ((ev->time - mouse_down_time) < ss->click_time) /* open file if double clicked */
+ {
+ mouse_down_time = ev->time;
+ view_files_open_selected_files((view_files_info *)(((vf_row *)context)->vdat));
+ return;
+ }
+ }
+ mouse_down_time = ev->time;
+ view_files_select((vf_row *)context, ev->state & snd_ShiftMask);
+}
+
+
+static void view_files_play_callback(Widget w, XtPointer context, XtPointer info)
+{
+#if WITH_AUDIO
+ /* open and play -- close at end or when button off toggled */
+ vf_row *r = (vf_row *)context;
+ view_files_info *vdat;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ vdat = (view_files_info *)(r->vdat);
+ if (view_files_play(vdat, r->pos, cb->set))
+ XmToggleButtonSetState(w, false, false);
+ else vdat->current_play_button = w;
+#endif
+}
+
+
+static vf_row *view_files_make_row(view_files_info *vdat, widget_t last_row)
+{
+ return(make_vf_row(vdat, last_row, view_files_play_callback, view_files_select_callback));
+}
+
+
+static void view_files_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_dialog_help();
+}
+
+
+static void view_files_quit_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ XtUnmanageChild(vdat->dialog);
+}
+
+
+static void view_files_new_viewer_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ if ((vdat) &&
+ (vdat->dialog) &&
+ (XtIsManaged(vdat->dialog)) &&
+ (XmGetFocusWidget(vdat->dialog) == XmMessageBoxGetChild(vdat->dialog, XmDIALOG_OK_BUTTON)))
+ {
+ Position x = 0, y = 0;
+
+ /* jog the current one over a bit -- otherwise the new one lands exactly on top of the old! */
+ XtVaGetValues(vdat->dialog, XmNx, &x, XmNy, &y, NULL);
+ XtVaSetValues(vdat->dialog, XmNx, x + 30, XmNy, y - 30, NULL);
+
+ vdat = new_view_files_dialog();
+ make_view_files_dialog_1(vdat, true);
+ }
+}
+
+
+static void sort_vf(view_files_info *vdat, int sort_choice)
+{
+ vdat->sorter = sort_choice;
+ vf_reflect_sort_choice_in_menu(vdat);
+ view_files_display_list(vdat);
+}
+
+
+static void sort_view_files_a_to_z(Widget w, XtPointer context, XtPointer info)
+{
+ sort_vf((view_files_info *)context, SORT_A_TO_Z);
+}
+
+
+static void sort_view_files_z_to_a(Widget w, XtPointer context, XtPointer info)
+{
+ sort_vf((view_files_info *)context, SORT_Z_TO_A);
+}
+
+
+static void sort_view_files_new_to_old(Widget w, XtPointer context, XtPointer info)
+{
+ sort_vf((view_files_info *)context, SORT_NEW_TO_OLD);
+}
+
+
+static void sort_view_files_old_to_new(Widget w, XtPointer context, XtPointer info)
+{
+ sort_vf((view_files_info *)context, SORT_OLD_TO_NEW);
+}
+
+
+static void sort_view_files_big_to_small(Widget w, XtPointer context, XtPointer info)
+{
+ sort_vf((view_files_info *)context, SORT_BIG_TO_SMALL);
+}
+
+
+static void sort_view_files_small_to_big(Widget w, XtPointer context, XtPointer info)
+{
+ sort_vf((view_files_info *)context, SORT_SMALL_TO_BIG);
+}
+
+
+static void sort_view_files_xen(Widget w, XtPointer context, XtPointer info)
+{
+ pointer_or_int_t index;
+ XtVaGetValues(w, XmNuserData, &index, NULL); /* index is location in list of file-sorters */
+ sort_vf((view_files_info *)context, (int)index);
+}
+
+
+static void vf_reflect_sort_choice_in_menu(view_files_info *vdat)
+{
+ int i;
+ set_sensitive(vdat->a_to_z, vdat->sorter != SORT_A_TO_Z);
+ set_sensitive(vdat->z_to_a, vdat->sorter != SORT_Z_TO_A);
+ set_sensitive(vdat->new_to_old, vdat->sorter != SORT_NEW_TO_OLD);
+ set_sensitive(vdat->old_to_new, vdat->sorter != SORT_OLD_TO_NEW);
+ set_sensitive(vdat->small_to_big, vdat->sorter != SORT_SMALL_TO_BIG);
+ set_sensitive(vdat->big_to_small, vdat->sorter != SORT_BIG_TO_SMALL);
+ for (i = 0; i < vdat->sort_items_size; i++)
+ if (XtIsManaged(vdat->sort_items[i]))
+ set_sensitive(vdat->sort_items[i], vdat->sorter != (SORT_XEN + i));
+}
+
+
+static void view_files_add_file_or_directory(view_files_info *vdat, const char *file_or_dir)
+{
+ char *filename;
+ filename = mus_expand_filename((const char *)file_or_dir);
+ if (filename)
+ {
+ int len;
+ len = strlen(filename);
+ if (filename[len - 1] == '*')
+ filename[len - 1] = 0;
+ if (is_directory(filename))
+ add_directory_to_view_files_list(vdat, (const char *)filename);
+ else add_file_to_view_files_list(vdat, file_or_dir, filename);
+ free(filename);
+ }
+}
+
+
+static void view_files_add_files(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ char *file_or_dir;
+ file_or_dir = XmTextFieldGetString(w);
+ if ((file_or_dir) && (*file_or_dir))
+ {
+ view_files_add_file_or_directory(vdat, (const char *)file_or_dir);
+ XtFree(file_or_dir);
+ view_files_display_list(vdat);
+ }
+}
+
+
+static void view_files_drop_watcher(Widget w, const char *str, Position x, Position y, void *context)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ /* incoming str is a single filename (drop watcher code splits the possible list and calls us on each one) */
+ view_files_add_file_or_directory(vdat, str);
+ view_files_display_list(vdat);
+}
+
+
+static void view_files_drag_watcher(Widget w, const char *str, Position x, Position y, drag_style_t dtype, void *context)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ switch (dtype)
+ {
+ case DRAG_ENTER:
+ XmChangeColor(vdat->file_list, ss->selection_color);
+ break;
+
+ case DRAG_LEAVE:
+ XmChangeColor(vdat->file_list, ss->basic_color);
+ break;
+
+ default:
+ break;
+ }
+}
+
+
+static mus_long_t vf_location(view_files_info *vdat)
+{
+ mus_long_t pos = 0;
+ snd_info *sp;
+ chan_info *cp;
+ char *str;
+ switch (vdat->location_choice)
+ {
+ case VF_AT_CURSOR:
+ sp = any_selected_sound();
+ if (sp)
+ {
+ cp = any_selected_channel(sp);
+ return(cursor_sample(cp));
+ }
+ break;
+
+ case VF_AT_END:
+ sp = any_selected_sound();
+ if (sp)
+ {
+ cp = any_selected_channel(sp);
+ return(current_samples(cp));
+ }
+ break;
+
+ case VF_AT_BEGINNING:
+ return(0);
+ break;
+
+ case VF_AT_MARK:
+ str = XmTextGetString(vdat->at_mark_text);
+ if ((str) && (*str))
+ {
+ pos = mark_id_to_sample(string_to_int(str, 0, "mark"));
+ XtFree(str);
+ if (pos < 0)
+ snd_error_without_format("no such mark");
+ }
+ else snd_error_without_format("no mark?");
+ break;
+
+ case VF_AT_SAMPLE:
+ str = XmTextGetString(vdat->at_sample_text);
+ if ((str) && (*str))
+ {
+ pos = string_to_mus_long_t(str, 0, "sample");
+ XtFree(str);
+ /* pos already checked for lower bound */
+ }
+ else snd_error_without_format("no sample number?");
+ break;
+ }
+ return(pos);
+}
+
+
+static void vf_clear_sample(view_files_info *vdat);
+
+static void vf_sample_button_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ vf_clear_sample((view_files_info *)context);
+}
+
+
+static void vf_sample_text_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ vf_clear_sample((view_files_info *)context);
+ cbs->doit = true;
+}
+
+
+static void vf_clear_sample(view_files_info *vdat)
+{
+ vf_clear_error(vdat);
+ XtRemoveCallback(vdat->at_sample_text, XmNmodifyVerifyCallback, vf_sample_text_modify_callback, (XtPointer)vdat);
+ XtRemoveCallback(vdat->at_sample_button, XmNvalueChangedCallback, vf_sample_button_modify_callback, (XtPointer)vdat);
+}
+
+
+static void vf_clear_mark(view_files_info *vdat);
+
+static void vf_mark_button_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ vf_clear_mark((view_files_info *)context);
+}
+
+
+static void vf_mark_text_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ vf_clear_mark((view_files_info *)context);
+ cbs->doit = true;
+}
+
+
+static void vf_clear_mark(view_files_info *vdat)
+{
+ vf_clear_error(vdat);
+ XtRemoveCallback(vdat->at_mark_text, XmNmodifyVerifyCallback, vf_mark_text_modify_callback, (XtPointer)vdat);
+ XtRemoveCallback(vdat->at_mark_button, XmNvalueChangedCallback, vf_mark_button_modify_callback, (XtPointer)vdat);
+}
+
+
+static void vf_add_text_modify_callback(Widget w, XtPointer context, XtPointer info);
+
+static void remove_all_pending_clear_callbacks(view_files_info *vdat)
+{
+ /* docs say this is a no-op if the indicated callback does not exist (i.e. not an error or segfault) */
+ XtRemoveCallback(vdat->at_mark_text, XmNmodifyVerifyCallback, vf_mark_text_modify_callback, (XtPointer)vdat);
+ XtRemoveCallback(vdat->at_mark_button, XmNvalueChangedCallback, vf_mark_button_modify_callback, (XtPointer)vdat);
+ XtRemoveCallback(vdat->at_sample_text, XmNmodifyVerifyCallback, vf_sample_text_modify_callback, (XtPointer)vdat);
+ XtRemoveCallback(vdat->at_sample_button, XmNvalueChangedCallback, vf_sample_button_modify_callback, (XtPointer)vdat);
+ XtRemoveCallback(vdat->add_text, XmNmodifyVerifyCallback, vf_add_text_modify_callback, (XtPointer)vdat);
+}
+
+
+static void vf_post_error(const char *error_msg, view_files_info *vdat)
+{
+ XmString msg;
+ remove_all_pending_clear_callbacks(vdat);
+ vdat->has_error = true;
+ msg = XmStringCreateLocalized((char *)error_msg);
+ XtVaSetValues(vdat->info1,
+ XmNlabelString, msg,
+ NULL);
+ XmStringFree(msg);
+ msg = XmStringCreateLocalized((char *)"");
+ XtVaSetValues(vdat->info2,
+ XmNlabelString, msg,
+ NULL);
+ XmStringFree(msg);
+}
+
+
+static void redirect_vf_post_error(const char *error_msg, void *vdat)
+{
+ vf_post_error(error_msg, (view_files_info *)vdat);
+}
+
+
+static void redirect_vf_post_location_error(const char *error_msg, void *data)
+{
+ view_files_info *vdat = (view_files_info *)data;
+ vf_post_error(error_msg, vdat);
+ if (vdat->location_choice == VF_AT_SAMPLE)
+ {
+ /* watch at_sample_text or button (undo) */
+ XtAddCallback(vdat->at_sample_text, XmNmodifyVerifyCallback, vf_sample_text_modify_callback, (XtPointer)vdat);
+ XtAddCallback(vdat->at_sample_button, XmNvalueChangedCallback, vf_sample_button_modify_callback, (XtPointer)vdat);
+ }
+ else
+ {
+ /* watch at_mark_text or button */
+ XtAddCallback(vdat->at_mark_text, XmNmodifyVerifyCallback, vf_mark_text_modify_callback, (XtPointer)vdat);
+ XtAddCallback(vdat->at_mark_button, XmNvalueChangedCallback, vf_mark_button_modify_callback, (XtPointer)vdat);
+ }
+}
+
+
+static void vf_add_text_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ view_files_info *vdat = (view_files_info *)context;
+ vf_clear_error(vdat);
+ XtRemoveCallback(vdat->add_text, XmNmodifyVerifyCallback, vf_add_text_modify_callback, (XtPointer)vdat);
+ cbs->doit = true;
+}
+
+
+static void vf_post_add_error(const char *error_msg, view_files_info *vdat)
+{
+ vf_post_error(error_msg, vdat);
+ XtAddCallback(vdat->add_text, XmNmodifyVerifyCallback, vf_add_text_modify_callback, (XtPointer)vdat);
+ /* what about other clearing actions? */
+}
+
+
+static void view_files_mix_selected_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_mix_selected_files(w, (view_files_info *)context);
+}
+
+
+static void view_files_insert_selected_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_insert_selected_files(w, (view_files_info *)context);
+}
+
+
+static void view_files_at_cursor_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ if (vdat->has_error)
+ {
+ if (vdat->location_choice == VF_AT_SAMPLE)
+ vf_clear_sample(vdat);
+ else vf_clear_mark(vdat);
+ }
+ XmToggleButtonSetState(vdat->at_cursor_button, true, false);
+ XmToggleButtonSetState(vdat->at_end_button, false, false);
+ XmToggleButtonSetState(vdat->at_beginning_button, false, false);
+ XmToggleButtonSetState(vdat->at_mark_button, false, false);
+ XmToggleButtonSetState(vdat->at_sample_button, false, false);
+ vdat->location_choice = VF_AT_CURSOR;
+}
+
+
+static void view_files_at_end_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ if (vdat->has_error)
+ {
+ if (vdat->location_choice == VF_AT_SAMPLE)
+ vf_clear_sample(vdat);
+ else vf_clear_mark(vdat);
+ }
+ XmToggleButtonSetState(vdat->at_cursor_button, false, false);
+ XmToggleButtonSetState(vdat->at_end_button, true, false);
+ XmToggleButtonSetState(vdat->at_beginning_button, false, false);
+ XmToggleButtonSetState(vdat->at_mark_button, false, false);
+ XmToggleButtonSetState(vdat->at_sample_button, false, false);
+ vdat->location_choice = VF_AT_END;
+}
+
+
+static void view_files_at_beginning_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ if (vdat->has_error)
+ {
+ if (vdat->location_choice == VF_AT_SAMPLE)
+ vf_clear_sample(vdat);
+ else vf_clear_mark(vdat);
+ }
+ XmToggleButtonSetState(vdat->at_cursor_button, false, false);
+ XmToggleButtonSetState(vdat->at_end_button, false, false);
+ XmToggleButtonSetState(vdat->at_beginning_button, true, false);
+ XmToggleButtonSetState(vdat->at_mark_button, false, false);
+ XmToggleButtonSetState(vdat->at_sample_button, false, false);
+ vdat->location_choice = VF_AT_BEGINNING;
+}
+
+
+static void view_files_at_sample_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ if ((vdat->has_error) &&
+ (vdat->location_choice == VF_AT_MARK))
+ vf_clear_mark(vdat);
+ XmToggleButtonSetState(vdat->at_cursor_button, false, false);
+ XmToggleButtonSetState(vdat->at_end_button, false, false);
+ XmToggleButtonSetState(vdat->at_beginning_button, false, false);
+ XmToggleButtonSetState(vdat->at_mark_button, false, false);
+ XmToggleButtonSetState(vdat->at_sample_button, true, false);
+ vdat->location_choice = VF_AT_SAMPLE;
+}
+
+
+static void view_files_at_mark_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ if ((vdat->has_error) &&
+ (vdat->location_choice == VF_AT_SAMPLE))
+ vf_clear_sample(vdat);
+ XmToggleButtonSetState(vdat->at_cursor_button, false, false);
+ XmToggleButtonSetState(vdat->at_end_button, false, false);
+ XmToggleButtonSetState(vdat->at_beginning_button, false, false);
+ XmToggleButtonSetState(vdat->at_mark_button, true, false);
+ XmToggleButtonSetState(vdat->at_sample_button, false, false);
+ vdat->location_choice = VF_AT_MARK;
+}
+
+
+
+/* -------- speed -------- */
+
+static int vf_speed_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
+{
+ if (val <= minval) return(0);
+ if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
+ return(snd_round(0.9 * SCROLLBAR_MAX * ((log(val) - log(minval)) / (log(maxval) - log(minval)))));
+}
+
+
+static void vf_set_speed(view_files_info *vdat, mus_float_t val)
+{
+ char speed_number_buffer[6];
+ vdat->speed = speed_changed(val,
+ speed_number_buffer,
+ vdat->speed_style,
+ speed_control_tones(ss),
+ 6);
+ set_label(vdat->speed_number, speed_number_buffer);
+ XtVaSetValues(vdat->speed_scrollbar,
+ XmNvalue, vf_speed_to_scroll(speed_control_min(ss), val, speed_control_max(ss)),
+ NULL);
+}
+
+
+static void vf_speed_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ vf_set_speed(vdat, 1.0);
+ XtVaSetValues(vdat->speed_scrollbar,
+ XmNvalue, vf_speed_to_scroll(speed_control_min(ss), 1.0, speed_control_max(ss)),
+ NULL);
+}
+
+
+static void vf_speed_label_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char speed_number_buffer[6];
+ view_files_info *vdat = (view_files_info *)context;
+
+ switch (vdat->speed_style)
+ {
+ default:
+ case SPEED_CONTROL_AS_FLOAT: vdat->speed_style = SPEED_CONTROL_AS_RATIO; break;
+ case SPEED_CONTROL_AS_RATIO: vdat->speed_style = SPEED_CONTROL_AS_SEMITONE; break;
+ case SPEED_CONTROL_AS_SEMITONE: vdat->speed_style = SPEED_CONTROL_AS_FLOAT; break;
+ }
+ speed_changed(vdat->speed,
+ speed_number_buffer,
+ vdat->speed_style,
+ speed_control_tones(ss),
+ 6);
+ set_label(vdat->speed_number, speed_number_buffer);
+}
+
+
+static void vf_speed_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ vf_set_speed(vdat, exp((cb->value *
+ (log(speed_control_max(ss)) - log(speed_control_min(ss))) /
+ (0.9 * SCROLLBAR_MAX)) + log(speed_control_min(ss))));
+}
+
+
+static void vf_speed_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ vf_set_speed(vdat, exp((cb->value *
+ (log(speed_control_max(ss)) - log(speed_control_min(ss))) /
+ (0.9 * SCROLLBAR_MAX)) + log(speed_control_min(ss))));
+}
+
+
+
+/* -------- amp -------- */
+
+static mus_float_t vf_scroll_to_amp(int val)
+{
+ if (val <= 0)
+ return(amp_control_min(ss));
+ if (val >= (0.9 * SCROLLBAR_MAX))
+ return(amp_control_max(ss));
+ if (val > (0.5 * 0.9 * SCROLLBAR_MAX))
+ return((((val / (0.5 * 0.9 * SCROLLBAR_MAX)) - 1.0) * (amp_control_max(ss) - 1.0)) + 1.0);
+ else return((val * (1.0 - amp_control_min(ss)) / (0.5 * 0.9 * SCROLLBAR_MAX)) + amp_control_min(ss));
+}
+
+
+static int vf_amp_to_scroll(mus_float_t amp)
+{
+ return(amp_to_scroll(amp_control_min(ss), amp, amp_control_max(ss)));
+}
+
+
+static void vf_set_amp(view_files_info *vdat, mus_float_t val)
+{
+ char sfs[6];
+ vdat->amp = val;
+ snprintf(sfs, 6, "%.2f", val);
+ set_label(vdat->amp_number, sfs);
+ XtVaSetValues(vdat->amp_scrollbar,
+ XmNvalue, amp_to_scroll(amp_control_min(ss), val, amp_control_max(ss)),
+ NULL);
+}
+
+
+static void vf_amp_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ vf_set_amp((view_files_info *)context, 1.0);
+}
+
+
+static void vf_amp_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ vf_set_amp((view_files_info *)context,
+ vf_scroll_to_amp(((XmScrollBarCallbackStruct *)info)->value));
+}
+
+
+static void vf_amp_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ vf_set_amp((view_files_info *)context,
+ vf_scroll_to_amp(((XmScrollBarCallbackStruct *)info)->value));
+}
+
+
+
+
+/* -------- amp-envs -------- */
+
+static void vf_amp_env_resize(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ if (vdat->env_ax == NULL)
+ {
+ XGCValues gv;
+ gv.function = GXcopy;
+ XtVaGetValues(vdat->env_drawer, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
+ vdat->env_gc = XtGetGC(vdat->env_drawer, GCForeground | GCFunction, &gv);
+ vdat->env_ax = (graphics_context *)calloc(1, sizeof(graphics_context));
+ vdat->env_ax->wn = XtWindow(vdat->env_drawer);
+ vdat->env_ax->dp = XtDisplay(vdat->env_drawer);
+ vdat->env_ax->gc = vdat->env_gc;
+ if (!(vdat->env_ax->wn)) return;
+ }
+ else
+ {
+ if (!(vdat->env_ax->wn))
+ {
+ vdat->env_ax->wn = XtWindow(vdat->env_drawer); /* sometimes the dialog window is not ready when display_env gets called */
+ if (!(vdat->env_ax->wn)) return;
+ }
+ clear_window(vdat->env_ax);
+ }
+ vdat->spf->with_dots = true;
+ env_editor_display_env(vdat->spf, vdat->amp_env, vdat->env_ax, "amp env",
+ 0, 0,
+ widget_width(w), widget_height(w),
+ NOT_PRINTING);
+ /* it might be nice to show the sound data in the background, but there are
+ * complications involving multichannel and multiselection cases, also
+ * how to get the "peak-func" and how to call g_channel_amp_envs.
+ * Too many problems...
+ * but perhaps something like the region browser display would work:
+ * label saying file+chan and up/down arrows to see the rest + off button
+ */
+}
+
+
+static void vf_amp_env_redraw(Widget w, view_files_info *vdat)
+{
+ vf_amp_env_resize(w, (void *)vdat, NULL);
+}
+
+
+static void vf_drawer_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ XMotionEvent *ev = (XMotionEvent *)event;
+ /* mus_float_t pos; */
+
+#ifdef __APPLE__
+ if ((press_x == ev->x) && (press_y == ev->y)) return;
+#endif
+
+ /* pos = (mus_float_t)(ev->x) / (mus_float_t)widget_width(w); */
+ env_editor_button_motion(vdat->spf, ev->x, ev->y, ev->time, vdat->amp_env);
+ vf_amp_env_resize(w, context, NULL);
+}
+
+
+static void vf_drawer_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ XButtonEvent *ev = (XButtonEvent *)event;
+ /* mus_float_t pos; */
+
+#ifdef __APPLE__
+ press_x = ev->x;
+ press_y = ev->y;
+#endif
+
+ /* pos = (mus_float_t)(ev->x) / (mus_float_t)widget_width(w); */
+ if (env_editor_button_press(vdat->spf, ev->x, ev->y, ev->time, vdat->amp_env))
+ vf_amp_env_resize(w, context, NULL);
+}
+
+
+static void vf_drawer_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ /* XButtonEvent *ev = (XButtonEvent *)event; */
+ /* mus_float_t pos; */
+
+ /* pos = (mus_float_t)(ev->x) / (mus_float_t)widget_width(w); */
+ env_editor_button_release(vdat->spf, vdat->amp_env);
+ vf_amp_env_resize(w, context, NULL);
+}
+
+
+static void vf_set_amp_env(view_files_info *vdat, env *new_e)
+{
+ if (!vdat) return;
+ if (vdat->amp_env) free_env(vdat->amp_env);
+ vdat->amp_env = copy_env(new_e);
+ if ((vdat->dialog) &&
+ (widget_is_active(vdat->dialog)))
+ vf_amp_env_redraw(vdat->env_drawer, vdat);
+}
+
+
+static void blue_textfield_unfocus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtVaSetValues(w, XmNbackground, ss->lighter_blue, NULL);
+ XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
+}
+
+
+static void blue_mouse_leave_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ XtVaSetValues(w, XmNbackground, ss->lighter_blue, NULL);
+ XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
+}
+
+
+static void white_mouse_enter_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ XtVaSetValues(w, XmNbackground, ss->text_focus_color, NULL);
+ XtVaSetValues(w, XmNcursorPositionVisible, true, NULL);
+}
+
+
+static void view_files_reset_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_info *vdat = (view_files_info *)context;
+ env *e;
+ vf_set_amp(vdat, 1.0);
+ vf_set_speed(vdat, 1.0);
+ vf_set_amp_env(vdat, e = default_env(1.0, 1.0)); /* vf_set_amp_env copies the envelope */
+ free_env(e);
+ sort_vf(vdat, view_files_sort(ss));
+}
+
+
+
+static widget_t make_view_files_dialog_1(view_files_info *vdat, bool managed)
+{
+ if (!(vdat->dialog))
+ {
+ int i, n;
+ Arg args[20];
+ XmString go_away, xhelp, titlestr, new_viewer_str, s1, bstr;
+ Widget mainform, viewform, leftform, reset_button, new_viewer_button;
+ Widget left_title_sep, add_label, sep1, sep3, sep4, sep6, sep7;
+#if WITH_AUDIO
+ Widget plw;
+#endif
+ Widget rlw, sbar;
+ XtCallbackList n1, n2, n3, n4;
+ Widget amp_label, speed_label, env_frame;
+ Widget bframe, bform;
+
+ go_away = XmStringCreateLocalized((char *)I_GO_AWAY);
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ new_viewer_str = XmStringCreateLocalized((char *)"New Viewer");
+
+ {
+ char *filestr = NULL;
+ filestr = mus_format("%s %d", "Files", vdat->index + 1);
+ titlestr = XmStringCreateLocalized(filestr);
+ free(filestr);
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNokLabelString, new_viewer_str); n++;
+ XtSetArg(args[n], XmNcancelLabelString, go_away); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ vdat->dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Files", args, n);
+ new_viewer_button = MSG_BOX(vdat->dialog, XmDIALOG_OK_BUTTON);
+
+ XtAddCallback(vdat->dialog, XmNhelpCallback, view_files_help_callback, (XtPointer)vdat);
+ /* XtAddCallback(vdat->dialog, XmNokCallback, view_files_new_viewer_callback, (XtPointer)vdat); */
+ XtAddCallback(new_viewer_button, XmNactivateCallback, view_files_new_viewer_callback, (XtPointer)vdat);
+ XtAddCallback(vdat->dialog, XmNcancelCallback, view_files_quit_callback, (XtPointer)vdat);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ reset_button = XtCreateManagedWidget("Reset", xmPushButtonGadgetClass, vdat->dialog, args, n);
+ XtAddCallback(reset_button, XmNactivateCallback, view_files_reset_callback, (XtPointer)vdat);
+
+ XmStringFree(xhelp);
+ XmStringFree(go_away);
+ XmStringFree(titlestr);
+ XmStringFree(new_viewer_str);
+
+ XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, MSG_BOX(vdat->dialog, XmDIALOG_SEPARATOR)); n++;
+ XtSetArg(args[n], XmNsashIndent, 2); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNspacing, 24); n++;
+ XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
+ mainform = XtCreateManagedWidget("formd", xmPanedWindowWidgetClass, vdat->dialog, args, n);
+
+ /* -------- left side controls -------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ leftform = XtCreateManagedWidget("leftform", xmFormWidgetClass, mainform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ vdat->left_title = XtCreateManagedWidget("(no files selected)", xmLabelWidgetClass, leftform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->left_title); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmDOUBLE_LINE); n++;
+ left_title_sep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, leftform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, left_title_sep); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ vdat->info1 = XtCreateManagedWidget("|", xmLabelWidgetClass, leftform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->info1); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ vdat->info2 = XtCreateManagedWidget("|", xmLabelWidgetClass, leftform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->info2); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, 8); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep6 = XtCreateManagedWidget("dialog-sep1", xmSeparatorWidgetClass, leftform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
+ XtSetArg(args[n], XmNborderColor, ss->zoom_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep6); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNborderWidth, 2); n++;
+ bframe = XtCreateManagedWidget("bframe", xmFrameWidgetClass, leftform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ bform = XtCreateManagedWidget("bform", xmFormWidgetClass, bframe, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNmarginTop, 0); n++;
+ XtSetArg(args[n], XmNmarginBottom, 0); n++;
+ XtSetArg(args[n], XmNshadowThickness, 1); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 1); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 50); n++;
+ vdat->mixB = XtCreateManagedWidget("Mix", xmPushButtonWidgetClass, bform, args, n);
+ XtAddCallback(vdat->mixB, XmNactivateCallback, view_files_mix_selected_callback, (XtPointer)vdat);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNmarginTop, 0); n++;
+ XtSetArg(args[n], XmNmarginBottom, 0); n++;
+ XtSetArg(args[n], XmNshadowThickness, 1); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 1); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, vdat->mixB); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ vdat->insertB = XtCreateManagedWidget("Insert", xmPushButtonWidgetClass, bform, args, n);
+ XtAddCallback(vdat->insertB, XmNactivateCallback, view_files_insert_selected_callback, (XtPointer)vdat);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"at cursor");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->mixB); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
+ XtSetArg(args[n], XmNset, XmSET); n++;
+ vdat->at_cursor_button = make_togglebutton_widget("at-cursor-button", bform, args, n);
+ XtAddCallback(vdat->at_cursor_button, XmNdisarmCallback, view_files_at_cursor_callback, (XtPointer)vdat);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"at end");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->at_cursor_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
+ vdat->at_end_button = make_togglebutton_widget("at-end-button", bform, args, n);
+ XtAddCallback(vdat->at_end_button, XmNdisarmCallback, view_files_at_end_callback, (XtPointer)vdat);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"at beginning");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->at_end_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
+ vdat->at_beginning_button = make_togglebutton_widget("at-beginning-button", bform, args, n);
+ XtAddCallback(vdat->at_beginning_button, XmNdisarmCallback, view_files_at_beginning_callback, (XtPointer)vdat);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"at sample");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 50); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->at_beginning_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
+ vdat->at_sample_button = make_togglebutton_widget("at-sample-button", bform, args, n);
+ XtAddCallback(vdat->at_sample_button, XmNdisarmCallback, view_files_at_sample_callback, (XtPointer)vdat);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->at_beginning_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, vdat->at_sample_button); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, vdat->at_sample_button); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ vdat->at_sample_text = make_textfield_widget("at-sample-text", bform, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
+ XtRemoveCallback(vdat->at_sample_text, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ XtAddCallback(vdat->at_sample_text, XmNlosingFocusCallback, blue_textfield_unfocus_callback, NULL);
+ XtAddEventHandler(vdat->at_sample_text, LeaveWindowMask, false, blue_mouse_leave_text_callback, NULL);
+ XtAddEventHandler(vdat->at_sample_text, EnterWindowMask, false, white_mouse_enter_text_callback, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNselectColor, ss->red); n++;
+ bstr = XmStringCreateLocalized((char *)"at mark");
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 50); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->at_sample_button); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNlabelString, bstr); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
+ vdat->at_mark_button = make_togglebutton_widget("at-mark-button", bform, args, n);
+ XtAddCallback(vdat->at_mark_button, XmNdisarmCallback, view_files_at_mark_callback, (XtPointer)vdat);
+ XmStringFree(bstr);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->at_sample_text); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, vdat->at_mark_button); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ vdat->at_mark_text = make_textfield_widget("at-mark-text", bform, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
+ XtRemoveCallback(vdat->at_mark_text, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ XtAddCallback(vdat->at_mark_text, XmNlosingFocusCallback, blue_textfield_unfocus_callback, NULL);
+ XtAddEventHandler(vdat->at_mark_text, LeaveWindowMask, false, blue_mouse_leave_text_callback, NULL);
+ XtAddEventHandler(vdat->at_mark_text, EnterWindowMask, false, white_mouse_enter_text_callback, NULL);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, bframe); n++;
+
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNheight, 8); n++;
+ sep4 = XtCreateManagedWidget("sep4", xmSeparatorWidgetClass, leftform, args, n);
+
+ n = 0;
+ /* AMP */
+ s1 = XmStringCreateLocalized((char *)"amp:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep4); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ /* XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++; */
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ amp_label = make_pushbutton_widget("amp-label", leftform, args, n);
+ XtAddCallback(amp_label, XmNactivateCallback, vf_amp_click_callback, (XtPointer)vdat);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"1.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep4); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, amp_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ /* XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++; */
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ /* XtSetArg(args[n], XmNmarginRight, 3); n++; */
+ vdat->amp_number = XtCreateManagedWidget("amp-number", xmLabelWidgetClass, leftform, args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep4); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, vdat->amp_number); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, vf_amp_to_scroll(1.0)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(vf_amp_valuechanged_callback, (XtPointer)vdat)); n++;
+ XtSetArg(args[n], XmNdragCallback, n3 = make_callback_list(vf_amp_drag_callback, (XtPointer)vdat)); n++;
+ vdat->amp_scrollbar = XtCreateManagedWidget("amp-scroll", xmScrollBarWidgetClass, leftform, args, n);
+
+ n = 0;
+ /* SPEED */
+ s1 = XmStringCreateLocalized((char *)"speed:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, amp_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ /* XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++; */
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ speed_label = make_pushbutton_widget("speed-label", leftform, args, n);
+ XtAddCallback(speed_label, XmNactivateCallback, vf_speed_click_callback, (XtPointer)vdat);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = initial_speed_label(speed_control_style(ss));
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, speed_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, speed_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ /* XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++; */
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ /* XtSetArg(args[n], XmNmarginRight, 3); n++; */
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ vdat->speed_number = make_pushbutton_widget("speed-number", leftform, args, n);
+ XtAddCallback(vdat->speed_number, XmNactivateCallback, vf_speed_label_click_callback, (XtPointer)vdat);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, vdat->speed_number); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, vdat->speed_number); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, vf_speed_to_scroll(speed_control_min(ss), 1.0, speed_control_max(ss))); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n4 = make_callback_list(vf_speed_valuechanged_callback, (XtPointer)vdat)); n++;
+ XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(vf_speed_drag_callback, (XtPointer)vdat)); n++;
+ vdat->speed_scrollbar = XtCreateManagedWidget("speed-scroll", xmScrollBarWidgetClass, leftform, args, n);
+
+
+ /* separator before envelope */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, speed_label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, 8); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ sep7 = XtCreateManagedWidget("dialog-sep1", xmSeparatorWidgetClass, leftform, args, n);
+
+
+ /* amp env */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep7); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 4); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 98); n++;
+ XtSetArg(args[n], XmNheight, 100); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNshadowThickness, 4); n++;
+ env_frame = XtCreateManagedWidget("amp-env-frame", xmFrameWidgetClass, leftform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNheight, 100); n++;
+ vdat->env_drawer = XtCreateManagedWidget("amp-env-window", xmDrawingAreaWidgetClass, env_frame, args, n);
+
+ /* right side */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ viewform = XtCreateManagedWidget("viewform", xmFormWidgetClass, mainform, args, n);
+
+ /* Add dir/file text entry at bottom */
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"add:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ add_label = XtCreateManagedWidget("add", xmLabelWidgetClass, viewform, args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, add_label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ vdat->add_text = make_textfield_widget("add-text", viewform, args, n, ACTIVATABLE, add_completer_func(filename_completer, NULL));
+ XtAddCallback(vdat->add_text, XmNactivateCallback, view_files_add_files, (XtPointer)vdat);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, vdat->add_text); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ XtSetArg(args[n], XmNheight, 4); n++;
+ sep3 = XtCreateManagedWidget("sep3", xmSeparatorWidgetClass, viewform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
+ rlw = XtCreateManagedWidget("files", xmLabelWidgetClass, viewform, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, rlw); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNseparatorType, XmDOUBLE_LINE); n++;
+ sep1 = XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, viewform, args, n);
+
+#if WITH_AUDIO
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 5); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep1); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ plw = XtCreateManagedWidget("play", xmLabelWidgetClass, viewform, args, n);
+#endif
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep1); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ sbar = XmCreateMenuBar(viewform, (char *)"menuBar", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ vdat->smenu = XmCreatePulldownMenu(sbar, (char *)"sort-menu", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNsubMenuId, vdat->smenu); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNmarginHeight, 1); n++;
+ XtCreateManagedWidget("sort", xmCascadeButtonWidgetClass, sbar, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ vdat->a_to_z = XtCreateManagedWidget("a..z", xmPushButtonWidgetClass, vdat->smenu, args, n);
+ vdat->z_to_a = XtCreateManagedWidget("z..a", xmPushButtonWidgetClass, vdat->smenu, args, n);
+ vdat->new_to_old = XtCreateManagedWidget("new..old", xmPushButtonWidgetClass, vdat->smenu, args, n);
+ vdat->old_to_new = XtCreateManagedWidget("old..new", xmPushButtonWidgetClass, vdat->smenu, args, n);
+ vdat->small_to_big = XtCreateManagedWidget("small..big", xmPushButtonWidgetClass, vdat->smenu, args, n);
+ vdat->big_to_small = XtCreateManagedWidget("big..small", xmPushButtonWidgetClass, vdat->smenu, args, n);
+
+ vdat->sort_items_size = 4;
+ vdat->sort_items = (Widget *)calloc(vdat->sort_items_size, sizeof(Widget));
+ for (i = 0; i < vdat->sort_items_size; i++)
+ vdat->sort_items[i] = XtCreateWidget("unused", xmPushButtonWidgetClass, vdat->smenu, args, n);
+
+ XtManageChild(sbar);
+
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 5); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+#if WITH_AUDIO
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, plw); n++;
+#else
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, sep1); n++;
+#endif
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, sep3); n++;
+ XtSetArg(args[n], XmNscrollingPolicy, XmAUTOMATIC); n++;
+ XtSetArg(args[n], XmNscrollBarDisplayPolicy, XmSTATIC); n++;
+ vdat->file_list = XmCreateScrolledWindow(viewform, (char *)"file_list", args, n);
+
+ n = attach_all_sides(args, 0);
+ vdat->file_list_holder = XtCreateManagedWidget("file_list_holder", xmRowColumnWidgetClass, vdat->file_list, args, n);
+ XtVaSetValues(vdat->file_list,
+ XmNworkWindow, vdat->file_list_holder,
+ NULL);
+ add_drag_and_drop(vdat->file_list, view_files_drop_watcher, view_files_drag_watcher, (void *)vdat);
+
+ if (managed) view_files_display_list(vdat);
+
+ XtAddCallback(vdat->a_to_z, XmNactivateCallback, sort_view_files_a_to_z, (XtPointer)vdat);
+ XtAddCallback(vdat->z_to_a, XmNactivateCallback, sort_view_files_z_to_a, (XtPointer)vdat);
+ XtAddCallback(vdat->new_to_old, XmNactivateCallback, sort_view_files_new_to_old, (XtPointer)vdat);
+ XtAddCallback(vdat->old_to_new, XmNactivateCallback, sort_view_files_old_to_new, (XtPointer)vdat);
+ XtAddCallback(vdat->small_to_big, XmNactivateCallback, sort_view_files_small_to_big, (XtPointer)vdat);
+ XtAddCallback(vdat->big_to_small, XmNactivateCallback, sort_view_files_big_to_small, (XtPointer)vdat);
+ vf_reflect_sort_choice_in_menu(vdat);
+
+ {
+ int i;
+ for (i = 0; i < vdat->sort_items_size; i++)
+ XtAddCallback(vdat->sort_items[i], XmNactivateCallback, sort_view_files_xen, (XtPointer)vdat);
+ }
+
+ map_over_children(vdat->file_list, set_main_color_of_widget);
+ set_dialog_widget(VIEW_FILES_DIALOG, vdat->dialog);
+
+ if (managed)
+ XtManageChild(vdat->dialog);
+
+ XtAddCallback(vdat->env_drawer, XmNresizeCallback, vf_amp_env_resize, (XtPointer)vdat);
+ XtAddCallback(vdat->env_drawer, XmNexposeCallback, vf_amp_env_resize, (XtPointer)vdat);
+
+ vdat->spf = new_env_editor(); /* one global amp env */
+
+ XtAddEventHandler(vdat->env_drawer, ButtonPressMask, false, vf_drawer_button_press, (XtPointer)vdat);
+ XtAddEventHandler(vdat->env_drawer, ButtonMotionMask, false, vf_drawer_button_motion, (XtPointer)vdat);
+ XtAddEventHandler(vdat->env_drawer, ButtonReleaseMask, false, vf_drawer_button_release, (XtPointer)vdat);
+
+ free(n1);
+ free(n2);
+ free(n3);
+ free(n4);
+
+ vf_mix_insert_buttons_set_sensitive(vdat, false);
+ }
+ else
+ {
+ if (managed)
+ {
+ if (!XtIsManaged(vdat->dialog))
+ XtManageChild(vdat->dialog);
+ raise_dialog(vdat->dialog);
+ view_files_display_list(vdat);
+ }
+ }
+ if (managed)
+ {
+ vf_amp_env_resize(vdat->env_drawer, (XtPointer)vdat, NULL);
+ view_files_reflect_sort_items();
+ }
+ return(vdat->dialog);
+}
+
+
+/* -------- view-files variables -------- */
+
+static Xen g_view_files_dialog(Xen managed, Xen make_new)
+{
+ #define H_view_files_dialog "(" S_view_files_dialog " :optional managed create-new-dialog): start the View Files dialog"
+ Xen_check_type(Xen_is_boolean_or_unbound(managed), managed, 1, S_view_files_dialog, "a boolean");
+ return(Xen_wrap_widget(make_view_files_dialog(Xen_boolean_to_C_bool(managed), Xen_is_true(make_new))));
+}
+
+
+static Xen g_add_directory_to_view_files_list(Xen directory, Xen dialog)
+{
+ #define H_add_directory_to_view_files_list "(" S_add_directory_to_view_files_list " dir :optional w): adds any sound files in 'dir' to the View:Files dialog"
+
+ Xen_check_type(Xen_is_string(directory), directory, 1, S_add_directory_to_view_files_list, "a string");
+ Xen_check_type(Xen_is_widget(dialog) || !Xen_is_bound(dialog), dialog, 2, S_add_directory_to_view_files_list, "a view-files dialog widget");
+
+ if (!Xen_is_bound(dialog))
+ view_files_add_directory(NULL_WIDGET, Xen_string_to_C_string(directory));
+ else view_files_add_directory((widget_t)(Xen_unwrap_widget(dialog)), Xen_string_to_C_string(directory));
+ return(directory);
+}
+
+
+static Xen g_add_file_to_view_files_list(Xen file, Xen dialog)
+{
+ #define H_add_file_to_view_files_list "(" S_add_file_to_view_files_list " file :optional w): adds file to the View:Files dialog's list"
+ char *name = NULL;
+
+ Xen_check_type(Xen_is_string(file), file, 1, S_add_file_to_view_files_list, "a string");
+ Xen_check_type(Xen_is_widget(dialog) || !Xen_is_bound(dialog), dialog, 2, S_add_file_to_view_files_list, "a view-files dialog widget");
+
+ name = mus_expand_filename(Xen_string_to_C_string(file));
+ if (mus_file_probe(name))
+ {
+ if (!Xen_is_bound(dialog))
+ view_files_add_file(NULL_WIDGET, name);
+ else view_files_add_file((widget_t)(Xen_unwrap_widget(dialog)), name);
+ }
+ if (name) free(name);
+ return(file);
+}
+
+
+static Xen g_view_files_sort(Xen dialog)
+{
+ #define H_view_files_sort "(" S_view_files_sort " :optional dialog): sort choice in View:files dialog."
+ if (Xen_is_bound(dialog))
+ {
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_view_files_sort, "a view-files dialog widget");
+ return(C_int_to_Xen_integer(view_files_local_sort((widget_t)(Xen_unwrap_widget(dialog)))));
+ }
+ return(C_int_to_Xen_integer(view_files_sort(ss)));
+}
+
+
+static Xen g_set_view_files_sort(Xen dialog, Xen val)
+{
+ int choice;
+ Xen sort_choice;
+
+ if (Xen_is_bound(val)) sort_choice = val; else sort_choice = dialog;
+ Xen_check_type(Xen_is_integer(sort_choice), sort_choice, 1, S_set S_view_files_sort, "an integer");
+
+ choice = Xen_integer_to_C_int(sort_choice);
+ if ((choice < 0) ||
+ (choice >= (ss->file_sorters_size + SORT_XEN)))
+ Xen_out_of_range_error(S_set S_view_files_sort, 2, sort_choice, "must be a valid file-sorter index");
+
+ if (Xen_is_bound(val))
+ {
+ widget_t w;
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_set S_view_files_sort, "a view-files dialog widget");
+ w = (widget_t)(Xen_unwrap_widget(dialog));
+ view_files_set_local_sort(w, choice);
+ return(C_int_to_Xen_integer((int)view_files_sort(ss)));
+ }
+ /* else set global (default) sort choice */
+ set_view_files_sort(choice);
+ return(C_int_to_Xen_integer((int)view_files_sort(ss)));
+}
+
+
+static Xen g_view_files_amp(Xen dialog)
+{
+ #define H_view_files_amp "(" S_view_files_amp " dialog): amp setting in the given View:Files dialog"
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_view_files_amp, "a view-files dialog widget");
+ return(C_double_to_Xen_real(view_files_amp((widget_t)(Xen_unwrap_widget(dialog)))));
+}
+
+
+static Xen g_view_files_set_amp(Xen dialog, Xen amp)
+{
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_set S_view_files_amp, "a view-files dialog widget");
+ Xen_check_type(Xen_is_number(amp), amp, 2, S_set S_view_files_amp, "a number");
+ view_files_set_amp((widget_t)(Xen_unwrap_widget(dialog)), Xen_real_to_C_double(amp));
+ return(amp);
+}
+
+
+static Xen g_view_files_speed(Xen dialog)
+{
+ #define H_view_files_speed "(" S_view_files_speed " dialog): speed setting in the given View:Files dialog"
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_view_files_speed, "a view-files dialog widget");
+ return(C_double_to_Xen_real(view_files_speed((widget_t)(Xen_unwrap_widget(dialog)))));
+}
+
+
+static Xen g_view_files_set_speed(Xen dialog, Xen speed)
+{
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_set S_view_files_speed, "a view-files dialog widget");
+ Xen_check_type(Xen_is_number(speed), speed, 2, S_set S_view_files_speed, "a number");
+ view_files_set_speed((widget_t)(Xen_unwrap_widget(dialog)), Xen_real_to_C_double(speed));
+ return(speed);
+}
+
+
+static Xen g_view_files_amp_env(Xen dialog)
+{
+ #define H_view_files_amp_env "(" S_view_files_amp_env " dialog): amp env breakpoints in the given View:Files dialog"
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_view_files_amp_env, "a view-files dialog widget");
+ return(env_to_xen(view_files_amp_env((widget_t)(Xen_unwrap_widget(dialog)))));
+}
+
+
+static Xen g_view_files_set_amp_env(Xen dialog, Xen amp_env)
+{
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_set S_view_files_amp_env, "a view-files dialog widget");
+ Xen_check_type(Xen_is_list(amp_env), amp_env, 2, S_set S_view_files_amp_env, "an envelope");
+ view_files_set_amp_env((widget_t)(Xen_unwrap_widget(dialog)), xen_to_env(amp_env));
+ return(amp_env);
+}
+
+
+static Xen g_view_files_speed_style(Xen dialog)
+{
+ #define H_view_files_speed_style "(" S_view_files_speed_style " dialog): speed_style in use in the given View:Files dialog"
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_view_files_speed_style, "a view-files dialog widget");
+ return(C_int_to_Xen_integer((int)(view_files_speed_style((widget_t)(Xen_unwrap_widget(dialog))))));
+}
+
+
+static Xen g_view_files_set_speed_style(Xen dialog, Xen speed_style)
+{
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_set S_view_files_speed_style, "a view-files dialog widget");
+ Xen_check_type(Xen_is_integer(speed_style), speed_style, 2, S_set S_view_files_speed_style, "an int");
+ view_files_set_speed_style((widget_t)(Xen_unwrap_widget(dialog)), (speed_style_t)(Xen_integer_to_C_int(speed_style)));
+ return(speed_style);
+}
+
+
+static Xen g_view_files_selected_files(Xen dialog)
+{
+ #define H_view_files_selected_files "(" S_view_files_selected_files " dialog): list of files currently selected in the given View:Files dialog"
+ Xen result = Xen_empty_list;
+ char **selected_files;
+ int len = 0;
+
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_view_files_selected_files, "a view-files dialog widget");
+
+ selected_files = view_files_selected_files((widget_t)(Xen_unwrap_widget(dialog)), &len);
+ if ((selected_files) && (len > 0))
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ {
+ result = Xen_cons(C_string_to_Xen_string(selected_files[i]), result);
+ free(selected_files[i]);
+ }
+ free(selected_files);
+ }
+ return(result);
+}
+
+
+static Xen g_view_files_set_selected_files(Xen dialog, Xen files)
+{
+ int len;
+
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_set S_view_files_selected_files, "a view-files dialog widget");
+ Xen_check_type(Xen_is_list(files), files, 2, S_set S_view_files_selected_files, "a list of files or directories");
+
+ len = Xen_list_length(files);
+ if (len > 0)
+ {
+ char **cfiles = NULL;
+ int i;
+ for (i = 0; i < len; i++)
+ if (!(Xen_is_string(Xen_list_ref(files, i))))
+ {
+ Xen_check_type(0, Xen_list_ref(files, i), i, S_set S_view_files_selected_files, "a filename (string)");
+ return(Xen_false);
+ }
+ cfiles = (char **)calloc(len, sizeof(char *));
+ for (i = 0; i < len; i++)
+ cfiles[i] = (char *)Xen_string_to_C_string(Xen_list_ref(files, i));
+ view_files_set_selected_files((widget_t)(Xen_unwrap_widget(dialog)), cfiles, len);
+ free(cfiles);
+ }
+ return(files);
+}
+
+
+static Xen g_view_files_files(Xen dialog)
+{
+ #define H_view_files_files "(" S_view_files_files " dialog): list of files currently available in the given View:Files dialog"
+ Xen result = Xen_empty_list;
+ char **files;
+ int i, len = 0;
+
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_view_files_files, "a view-files dialog widget");
+
+ files = view_files_files((widget_t)(Xen_unwrap_widget(dialog)), &len);
+ if ((files) && (len > 0))
+ for (i = 0; i < len; i++)
+ result = Xen_cons(C_string_to_Xen_string(files[i]), result);
+ return(result);
+}
+
+
+static Xen g_view_files_set_files(Xen dialog, Xen files)
+{
+ int len = 0;
+ char **cfiles = NULL;
+
+ Xen_check_type(Xen_is_widget(dialog), dialog, 1, S_set S_view_files_files, "a view-files dialog widget");
+ Xen_check_type(Xen_is_list(files), files, 2, S_set S_view_files_files, "a list of files or directories");
+
+ len = Xen_list_length(files);
+ if (len > 0)
+ {
+ int i;
+ for (i = 0; i < len; i++)
+ if (!(Xen_is_string(Xen_list_ref(files, i))))
+ {
+ Xen_check_type(0, Xen_list_ref(files, i), i, S_set S_view_files_files, "a filename (string)");
+ return(Xen_false);
+ }
+ cfiles = (char **)calloc(len, sizeof(char *));
+ for (i = 0; i < len; i++)
+ cfiles[i] = (char *)Xen_string_to_C_string(Xen_list_ref(files, i));
+ }
+ view_files_set_files((widget_t)(Xen_unwrap_widget(dialog)), cfiles, len);
+ if (cfiles) free(cfiles);
+ return(files);
+}
+
+
+static Xen view_files_select_hook;
+
+static void view_files_run_select_hook(widget_t dialog, const char *selected_file)
+{
+ if (Xen_hook_has_list(view_files_select_hook))
+ run_hook(view_files_select_hook,
+ Xen_list_2(Xen_wrap_widget(dialog),
+ C_string_to_Xen_string(selected_file)),
+ S_view_files_select_hook);
+}
+
+/* -------- file-filters and file-sorters -------- */
+
+#define INITIAL_FILE_SORTERS_SIZE 4
+
+static bool file_sorter_ok(Xen name, Xen proc, const char *caller)
+{
+ char *errmsg;
+ Xen_check_type(Xen_is_string(name), name, 1, caller, "a string");
+ Xen_check_type(Xen_is_procedure(proc), proc, 2, caller, "a procedure of 2 args (file1 and file2)");
+ errmsg = procedure_ok(proc, 2, caller, "file sort", 2);
+ if (errmsg)
+ {
+ Xen errstr;
+ errstr = C_string_to_Xen_string(errmsg);
+ free(errmsg);
+ snd_bad_arity_error(caller, errstr, proc);
+ return(false);
+ }
+ return(true);
+}
+
+
+static Xen g_add_file_sorter(Xen name, Xen proc)
+{
+ #define H_add_file_sorter "(" S_add_file_sorter " name proc) -- add proc with identifier name to file sorter list, returns its index"
+ int choice = -1;
+ /* type checks are redundant here */
+
+ if (file_sorter_ok(name, proc, S_add_file_sorter))
+ {
+ int i, len;
+ len = ss->file_sorters_size;
+ for (i = 0; i < len; i++)
+ {
+ if (Xen_is_false(Xen_vector_ref(ss->file_sorters, i)))
+ {
+ Xen_vector_set(ss->file_sorters, i, Xen_list_2(name, proc));
+ choice = i;
+ break;
+ }
+ }
+ if (choice == -1)
+ {
+ ss->file_sorters_size = len * 2;
+ ss->file_sorters = g_expand_vector(ss->file_sorters, ss->file_sorters_size);
+ Xen_vector_set(ss->file_sorters, len, Xen_list_2(name, proc));
+ choice = len;
+ }
+ view_files_reflect_sort_items();
+ }
+ return(C_int_to_Xen_integer(choice + SORT_XEN));
+}
+
+
+static Xen g_delete_file_sorter(Xen index)
+{
+ #define H_delete_file_sorter "(" S_delete_file_sorter " index) -- delete proc with identifier name from file sorter list"
+ int pos;
+ Xen_check_type(Xen_is_integer(index), index, 1, S_delete_file_sorter, "a file-sorter index");
+ pos = Xen_integer_to_C_int(index);
+ if ((pos >= SORT_XEN) &&
+ ((pos - SORT_XEN) < ss->file_sorters_size))
+ Xen_vector_set(ss->file_sorters, pos - SORT_XEN, Xen_false);
+ view_files_reflect_sort_items();
+ return(index);
+}
+
+
+
+/* -------- drop watcher lists -------- */
+
+/* the rigamarole for dealing with a drop is so messed up that I think it's
+ * worth the trouble of setting up a separate callback list -- hence the
+ * drop watchers
+ */
+
+typedef struct {
+ void (*drop_watcher)(Widget w, const char *message, Position x, Position y, void *data);
+ void (*drag_watcher)(Widget w, const char *message, Position x, Position y, drag_style_t dtype, void *data);
+ Widget caller;
+ void *context;
+} drop_watcher_t;
+
+static drop_watcher_t **drop_watchers = NULL;
+static int drop_watchers_size = 0;
+
+#define DROP_WATCHER_SIZE_INCREMENT 2
+
+
+static int add_drop_watcher(Widget w,
+ void (*drop_watcher)(Widget w, const char *message, Position x, Position y, void *data),
+ void (*drag_watcher)(Widget w, const char *message, Position x, Position y, drag_style_t dtype, void *data),
+ void *context)
+{
+ int loc = -1;
+ if (!(drop_watchers))
+ {
+ loc = 0;
+ drop_watchers_size = DROP_WATCHER_SIZE_INCREMENT;
+ drop_watchers = (drop_watcher_t **)calloc(drop_watchers_size, sizeof(drop_watcher_t *));
+ }
+ else
+ {
+ int i;
+ for (i = 0; i < drop_watchers_size; i++)
+ if (!(drop_watchers[i]))
+ {
+ loc = i;
+ break;
+ }
+ if (loc == -1)
+ {
+ loc = drop_watchers_size;
+ drop_watchers_size += DROP_WATCHER_SIZE_INCREMENT;
+ drop_watchers = (drop_watcher_t **)realloc(drop_watchers, drop_watchers_size * sizeof(drop_watcher_t *));
+ for (i = loc; i < drop_watchers_size; i++) drop_watchers[i] = NULL;
+ }
+ }
+ drop_watchers[loc] = (drop_watcher_t *)calloc(1, sizeof(drop_watcher_t));
+ drop_watchers[loc]->drop_watcher = drop_watcher;
+ drop_watchers[loc]->drag_watcher = drag_watcher;
+ drop_watchers[loc]->context = context;
+ drop_watchers[loc]->caller = w;
+ return(loc);
+}
+
+
+#if 0
+static bool remove_drop_watcher(int loc)
+{
+ if ((drop_watchers) &&
+ (loc < drop_watchers_size) &&
+ (loc >= 0) &&
+ (drop_watchers[loc]))
+ {
+ free(drop_watchers[loc]);
+ drop_watchers[loc] = NULL;
+ return(true);
+ }
+ return(false);
+}
+#endif
+
+
+static drop_watcher_t *find_drop_watcher(Widget caller)
+{
+ if (drop_watchers)
+ {
+ int i;
+ for (i = 0; i < drop_watchers_size; i++)
+ {
+ if (drop_watchers[i])
+ {
+ drop_watcher_t *d;
+ d = drop_watchers[i];
+ if (d->caller == caller)
+ return(d);
+ }
+ }
+ }
+ return(NULL);
+}
+
+
+/* can't move axes if icon dragged to end of graph because the entire system freezes! */
+
+static Atom FILE_NAME; /* Sun uses this, SGI uses STRING */
+static Atom COMPOUND_TEXT; /* various Motif widgets use this and the next */
+static Atom _MOTIF_COMPOUND_STRING;
+static Atom text_plain; /* gtk uses this -- apparently a url */
+static Atom uri_list; /* rox uses this -- looks just like text/plain to me */
+static Atom TEXT; /* ditto */
+
+static Xen drop_hook;
+
+
+static char *atom_to_string(Atom type, XtPointer value, unsigned long length)
+{
+ char *str = NULL;
+ if ((type == XA_STRING) || (type == FILE_NAME) || (type == text_plain) || (type == uri_list) || (type == TEXT))
+ {
+ unsigned long i;
+ str = (char *)calloc(length + 1, sizeof(char));
+ for (i = 0; i < length; i++)
+ str[i] = ((char *)value)[i];
+ }
+ else
+ {
+ if ((type == COMPOUND_TEXT) || (type == _MOTIF_COMPOUND_STRING))
+ {
+ char *temp;
+ XmString cvt, tmp;
+ XmParseTable parser = (XmParseTable)XtCalloc(1, sizeof(XmParseMapping));
+ int n;
+ Arg args[12];
+
+ /* create parse table to catch separator in XmString and insert "\n" in output */
+ /* multiple file names are passed this way in Motif */
+ tmp = XmStringSeparatorCreate();
+ n = 0;
+ XtSetArg(args[n], XmNincludeStatus, XmINSERT); n++;
+ XtSetArg(args[n], XmNsubstitute, tmp); n++;
+ XtSetArg(args[n], XmNpattern, "\n"); n++;
+ parser[0] = XmParseMappingCreate(args, n);
+
+ if (type == _MOTIF_COMPOUND_STRING)
+ cvt = XmCvtByteStreamToXmString((unsigned char *)value);
+ else cvt = XmCvtCTToXmString((char *)value);
+ temp = (char *)XmStringUnparse(cvt, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, parser, 1, XmOUTPUT_ALL);
+
+ XmParseTableFree(parser, 1);
+ XmStringFree(cvt);
+ str = mus_strdup(temp);
+ XtFree(temp);
+ }
+ }
+ return(str);
+}
+
+
+static Position mx, my;
+
+static void massage_selection(Widget w, XtPointer context, Atom *selection, Atom *type, XtPointer value, unsigned long *length, int *format)
+{
+ char *str = NULL;
+ str = atom_to_string(*type, value, *length);
+ /* str can contain more than one name (separated by cr) */
+ if (str)
+ {
+ if ((!(Xen_hook_has_list(drop_hook))) ||
+ (!(Xen_is_true(run_or_hook(drop_hook,
+ Xen_list_1(C_string_to_Xen_string(str)),
+ S_drop_hook)))))
+ {
+ Widget caller; /* "w" above is the transfer control widget, not the drop-receiver */
+ drop_watcher_t *d;
+ caller = (Widget)((XmDropTransferEntry)context)->client_data;
+ d = find_drop_watcher(caller);
+ if (d)
+ {
+ /* loop through possible list of filenames, calling watcher on each */
+ char *filename;
+ int len = 0, i, j = 0;
+ len = mus_strlen(str);
+ filename = (char *)calloc(len, sizeof(char));
+ for (i = 0; i < len; i++)
+ {
+ if ((str[i] == '\n') || (str[i] == '\r')) /* apparently the only space chars here are \n and \r? */
+ {
+ if (j > 0)
+ {
+ filename[j] = '\0';
+ if (strncmp(filename, "file://", 7) == 0)
+ {
+ char *tmp;
+ tmp = (char *)(filename + 7);
+ (*(d->drop_watcher))(caller, (const char *)tmp, mx, my, d->context);
+ }
+ else (*(d->drop_watcher))(caller, (const char *)filename, mx, my, d->context);
+ j = 0;
+ }
+ /* else ignore extra white space chars */
+ }
+ else
+ {
+ filename[j++] = str[i];
+ }
+ }
+ free(filename);
+ }
+ }
+ free(str);
+ }
+}
+
+
+static void handle_drop(Widget w, XtPointer context, XtPointer info)
+{
+ XmDropProcCallbackStruct *cb = (XmDropProcCallbackStruct *)info;
+ Arg args[12];
+ int n, i, num_targets, k;
+ Atom *targets;
+ XmDropTransferEntryRec entries[2];
+
+ if ((cb->dropAction != XmDROP) ||
+ ((cb->operation != XmDROP_COPY) &&
+ (cb->operation != XmDROP_LINK)))
+ {
+ cb->dropSiteStatus = XmINVALID_DROP_SITE;
+ return;
+ }
+
+ k = -1;
+ XtVaGetValues(cb->dragContext,
+ XmNexportTargets, &targets,
+ XmNnumExportTargets, &num_targets,
+ NULL);
+
+ for (i = 0; i < num_targets; i++)
+ if ((targets[i] == XA_STRING) ||
+ (targets[i] == FILE_NAME) ||
+ (targets[i] == COMPOUND_TEXT) ||
+ (targets[i] == _MOTIF_COMPOUND_STRING) ||
+ (targets[i] == TEXT) ||
+ (targets[i] == text_plain) ||
+ (targets[i] == uri_list))
+ {
+ k = i;
+ break;
+ }
+ if (k == -1)
+ {
+#if 0
+ fprintf(stderr, "failed drop attempt:\n");
+ for (i = 0; i < num_targets; i++)
+ fprintf(stderr, " target %d = %s\n", i,
+ XGetAtomName(MAIN_DISPLAY(ss),
+ targets[i]));
+#endif
+ cb->dropSiteStatus = XmINVALID_DROP_SITE;
+ cb->operation = XmDROP_NOOP;
+ n = 0;
+ XtSetArg(args[n], XmNnumDropTransfers, 0); n++;
+ XtSetArg(args[n], XmNtransferStatus, XmTRANSFER_FAILURE); n++;
+ XmDropTransferStart(cb->dragContext, args, n);
+ return;
+ }
+
+ mx = cb->x;
+ my = cb->y;
+ entries[0].target = targets[k];
+ entries[0].client_data = (XtPointer)w;
+ n = 0;
+ XtSetArg(args[n], XmNdropTransfers, entries); n++;
+ XtSetArg(args[n], XmNnumDropTransfers, 1); n++;
+ XtSetArg(args[n], XmNtransferProc, massage_selection); n++;
+ /* cb->operation = XmDROP_COPY; */
+
+ XmDropTransferStart(cb->dragContext, args, n);
+}
+
+
+static void handle_drag(Widget w, XtPointer context, XtPointer info)
+{
+ XmDragProcCallbackStruct *cb = (XmDragProcCallbackStruct *)info;
+ drop_watcher_t *d;
+ d = find_drop_watcher(w);
+ if ((d) && (d->drag_watcher))
+ {
+ switch (cb->reason)
+ {
+ case XmCR_DROP_SITE_MOTION_MESSAGE:
+ (*(d->drag_watcher))(w, NULL, cb->x, cb->y, DRAG_MOTION, d->context);
+ break;
+ case XmCR_DROP_SITE_ENTER_MESSAGE:
+ (*(d->drag_watcher))(w, NULL, cb->x, cb->y, DRAG_ENTER, d->context);
+ break;
+ case XmCR_DROP_SITE_LEAVE_MESSAGE:
+ (*(d->drag_watcher))(w, NULL, cb->x, cb->y, DRAG_LEAVE, d->context);
+ break;
+ }
+ }
+}
+
+#define NUM_TARGETS 7
+void add_drag_and_drop(Widget w,
+ void (*drop_watcher)(Widget w, const char *message, Position x, Position y, void *data),
+ void (*drag_watcher)(Widget w, const char *message, Position x, Position y, drag_style_t dtype, void *data),
+ void *context)
+{
+ Display *dpy;
+ int n;
+ Atom targets[NUM_TARGETS];
+ Arg args[12];
+ dpy = MAIN_DISPLAY(ss);
+ targets[0] = XA_STRING;
+ FILE_NAME = XInternAtom(dpy, "FILE_NAME", false);
+ targets[1] = FILE_NAME;
+ COMPOUND_TEXT = XInternAtom(dpy, "COMPOUND_TEXT", false);
+ targets[2] = COMPOUND_TEXT;
+ _MOTIF_COMPOUND_STRING = XInternAtom(dpy, "_MOTIF_COMPOUND_STRING", false);
+ targets[3] = _MOTIF_COMPOUND_STRING;
+ text_plain = XInternAtom(dpy, "text/plain", false);
+ targets[4] = text_plain;
+ TEXT = XInternAtom(dpy, "TEXT", false);
+ targets[5] = TEXT;
+ uri_list = XInternAtom(dpy, "text/uri-list", false);
+ targets[6] = uri_list;
+ n = 0;
+ XtSetArg(args[n], XmNdropSiteOperations, XmDROP_COPY | XmDROP_LINK); n++;
+ XtSetArg(args[n], XmNimportTargets, targets); n++;
+ XtSetArg(args[n], XmNnumImportTargets, NUM_TARGETS); n++;
+ XtSetArg(args[n], XmNdropProc, handle_drop); n++;
+ XtSetArg(args[n], XmNdragProc, handle_drag); n++;
+ XmDropSiteRegister(w, args, n);
+ add_drop_watcher(w, drop_watcher, drag_watcher, context);
+}
+
+
+
+/* -------------------------------------------------------------------------------- */
+
+Xen_wrap_1_optional_arg(g_view_files_sort_w, g_view_files_sort)
+Xen_wrap_2_optional_args(g_set_view_files_sort_w, g_set_view_files_sort)
+Xen_wrap_2_optional_args(g_add_directory_to_view_files_list_w, g_add_directory_to_view_files_list)
+Xen_wrap_2_optional_args(g_add_file_to_view_files_list_w, g_add_file_to_view_files_list)
+Xen_wrap_2_optional_args(g_view_files_dialog_w, g_view_files_dialog)
+Xen_wrap_1_arg(g_view_files_amp_w, g_view_files_amp)
+Xen_wrap_2_args(g_view_files_set_amp_w, g_view_files_set_amp)
+Xen_wrap_1_arg(g_view_files_speed_w, g_view_files_speed)
+Xen_wrap_2_args(g_view_files_set_speed_w, g_view_files_set_speed)
+Xen_wrap_1_arg(g_view_files_amp_env_w, g_view_files_amp_env)
+Xen_wrap_2_args(g_view_files_set_amp_env_w, g_view_files_set_amp_env)
+Xen_wrap_1_arg(g_view_files_speed_style_w, g_view_files_speed_style)
+Xen_wrap_2_args(g_view_files_set_speed_style_w, g_view_files_set_speed_style)
+Xen_wrap_1_arg(g_view_files_selected_files_w, g_view_files_selected_files)
+Xen_wrap_1_arg(g_view_files_files_w, g_view_files_files)
+Xen_wrap_2_args(g_view_files_set_selected_files_w, g_view_files_set_selected_files)
+Xen_wrap_2_args(g_view_files_set_files_w, g_view_files_set_files)
+Xen_wrap_1_arg(g_delete_file_sorter_w, g_delete_file_sorter)
+Xen_wrap_2_args(g_add_file_sorter_w, g_add_file_sorter)
+
+#if HAVE_SCHEME
+static s7_pointer acc_view_files_sort(s7_scheme *sc, s7_pointer args) {return(g_set_view_files_sort(s7_cadr(args), s7_undefined(sc)));}
+#endif
+
+void g_init_gxfile(void)
+{
+#if HAVE_SCHEME
+ #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
+The 'type' is 1 for view-files, and 2 for regions. The 'position' \
+is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.scm \
+to popup file info as follows: \n\
+(hook-push " S_mouse_enter_label_hook "\n\
+ (lambda (type position name)\n\
+ (if (not (= type 2))\n\
+ (" S_info_dialog " name (finfo name)))))\n\
+See also nb.scm."
+#endif
+#if HAVE_RUBY
+ #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
+The 'type' is 1 for view-files, and 2 for regions. The 'position' \
+is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.rb \
+to popup file info as follows: \n\
+$mouse_enter_label_hook.add_hook!(\"finfo\") do |type, position, name|\n\
+ if type != 2\n\
+ " S_info_dialog "(name, finfo(name))\n\
+ end\n\
+end\n\
+See also nb.rb."
+#endif
+#if HAVE_FORTH
+ #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
+The 'type' is 1 for view-files, and 2 for regions. The 'position' \
+is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.fs \
+to popup file info as follows: \n\
+" S_mouse_enter_label_hook " lambda: <{ type position name }>\n\
+ type 2 <> if\n\
+ name name finfo info-dialog\n\
+ else\n\
+ #f\n\
+ then\n\
+; add-hook!"
+#endif
+
+ #define H_mouse_leave_label_hook S_mouse_leave_label_hook " (type position label): called when the mouse leaves a file viewer or region label"
+
+ mouse_enter_label_hook = Xen_define_hook(S_mouse_enter_label_hook, "(make-hook 'type 'position 'label)", 3, H_mouse_enter_label_hook);
+ mouse_leave_label_hook = Xen_define_hook(S_mouse_leave_label_hook, "(make-hook 'type 'position 'label)", 3, H_mouse_leave_label_hook);
+
+ Xen_define_dilambda(S_view_files_amp, g_view_files_amp_w, H_view_files_amp,
+ S_set S_view_files_amp, g_view_files_set_amp_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_view_files_amp_env, g_view_files_amp_env_w, H_view_files_amp_env,
+ S_set S_view_files_amp_env, g_view_files_set_amp_env_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_view_files_speed_style, g_view_files_speed_style_w, H_view_files_speed_style,
+ S_set S_view_files_speed_style, g_view_files_set_speed_style_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_view_files_speed, g_view_files_speed_w, H_view_files_speed,
+ S_set S_view_files_speed, g_view_files_set_speed_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_view_files_files, g_view_files_files_w, H_view_files_files,
+ S_set S_view_files_files, g_view_files_set_files_w, 1, 0, 2, 0);
+ Xen_define_dilambda(S_view_files_selected_files, g_view_files_selected_files_w, H_view_files_selected_files,
+ S_set S_view_files_selected_files, g_view_files_set_selected_files_w, 1, 0, 2, 0);
+
+ Xen_define_safe_procedure(S_add_directory_to_view_files_list, g_add_directory_to_view_files_list_w, 1, 1, 0, H_add_directory_to_view_files_list);
+ Xen_define_safe_procedure(S_add_file_to_view_files_list, g_add_file_to_view_files_list_w, 1, 1, 0, H_add_file_to_view_files_list);
+ Xen_define_safe_procedure(S_view_files_dialog, g_view_files_dialog_w, 0, 2, 0, H_view_files_dialog);
+
+ Xen_define_dilambda(S_view_files_sort, g_view_files_sort_w, H_view_files_sort,
+ S_set S_view_files_sort, g_set_view_files_sort_w, 0, 1, 1, 1);
+
+ Xen_add_to_hook_list(ss->snd_open_file_hook, vf_open_file_watcher_w, "view-files-dialog-open-file-handler", "view-files dialog open-file handler");
+
+ #define H_view_files_select_hook S_view_files_select_hook "(dialog name): called when a file is selected in the \
+files list of the View Files dialog. If it returns " PROC_TRUE ", the default action, opening the file, is omitted."
+
+ view_files_select_hook = Xen_define_hook(S_view_files_select_hook, "(make-hook 'dialog 'name)", 2, H_view_files_select_hook);
+
+ /* file-filters and file-sorters are lists from user's point of view, but I want to
+ * make sure they're gc-protected through add/delete/set, and want such code compatible
+ * with current Ruby xen macros, so I'll use an array internally.
+ */
+ ss->file_sorters_size = INITIAL_FILE_SORTERS_SIZE;
+ ss->file_sorters = Xen_make_vector(ss->file_sorters_size, Xen_false);
+ Xen_GC_protect(ss->file_sorters);
+
+ Xen_define_safe_procedure(S_add_file_sorter, g_add_file_sorter_w, 2, 0, 0, H_add_file_sorter);
+ Xen_define_safe_procedure(S_delete_file_sorter, g_delete_file_sorter_w, 1, 0, 0, H_delete_file_sorter);
+
+
+ #define H_drop_hook S_drop_hook " (name): called whenever Snd receives a drag-and-drop \
+event. If it returns " PROC_TRUE ", the file is not opened or mixed by Snd."
+
+ drop_hook = Xen_define_hook(S_drop_hook, "(make-hook 'name)", 1, H_drop_hook);
+
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->view_files_sort_symbol, s7_make_function(s7, "[acc-" S_view_files_sort "]", acc_view_files_sort, 2, 0, false, "accessor"));
+#endif
+}
+
+
+#include "sndlib-strings.h"
+
+/* preferences dialog; layout design taken from webmail
+ */
+
+static Widget preferences_dialog = NULL, load_path_text_widget = NULL;
+static bool prefs_unsaved = false;
+static char *prefs_saved_filename = NULL;
+static char *include_load_path = NULL;
+
+#define MID_POSITION 50
+#define PREFS_COLOR_POSITION 62 /* COLOR_POSITION is slider_choice_t in snd-0.h */
+#define FIRST_COLOR_POSITION 6
+#define SECOND_COLOR_POSITION 30
+#define THIRD_COLOR_POSITION 55
+
+#define MID_SPACE 16
+#define INTER_TOPIC_SPACE 3
+#define INTER_VARIABLE_SPACE 2
+
+#define POWER_WAIT_TIME 100
+#define POWER_INITIAL_WAIT_TIME 500
+/* "power" is an old-timey name for auto-repeat */
+#define ERROR_WAIT_TIME 5000
+
+#define STARTUP_WIDTH 925
+#define STARTUP_HEIGHT 800
+
+
+typedef struct prefs_info {
+ Widget label, text, arrow_up, arrow_down, arrow_right, error, toggle, scale, toggle2, toggle3;
+ Widget color, rscl, gscl, bscl, rtxt, gtxt, btxt, list_menu, radio_button;
+ Widget *radio_buttons;
+ bool got_error;
+ timeout_result_t power_id;
+ const char *var_name, *saved_label;
+ int num_buttons;
+ mus_float_t scale_max;
+ void (*toggle_func)(struct prefs_info *prf);
+ void (*toggle2_func)(struct prefs_info *prf);
+ void (*scale_func)(struct prefs_info *prf);
+ void (*arrow_up_func)(struct prefs_info *prf);
+ void (*arrow_down_func)(struct prefs_info *prf);
+ void (*text_func)(struct prefs_info *prf);
+ void (*list_func)(struct prefs_info *prf, char *value);
+ void (*color_func)(struct prefs_info *prf, float r, float g, float b);
+ void (*reflect_func)(struct prefs_info *prf);
+ void (*save_func)(struct prefs_info *prf, FILE *fd);
+ const char *(*help_func)(struct prefs_info *prf);
+ void (*clear_func)(struct prefs_info *prf);
+ void (*revert_func)(struct prefs_info *prf);
+} prefs_info;
+
+
+static void prefs_set_dialog_title(const char *filename);
+static void reflect_key(prefs_info *prf, const char *key_name);
+static void save_key(prefs_info *prf, FILE *fd, char *(*binder)(char *key, bool c, bool m, bool x));
+static void key_bind(prefs_info *prf, char *(*binder)(char *key, bool c, bool m, bool x));
+static void clear_prefs_dialog_error(void);
+static void scale_set_color(prefs_info *prf, color_t pixel);
+static color_t rgb_to_color(mus_float_t r, mus_float_t g, mus_float_t b);
+static void post_prefs_error(const char *msg, prefs_info *data);
+#ifdef __GNUC__
+ static void va_post_prefs_error(const char *msg, prefs_info *data, ...) __attribute__ ((format (printf, 1, 0)));
+#else
+ static void va_post_prefs_error(const char *msg, prefs_info *data, ...);
+#endif
+
+/* used in snd-prefs */
+#define GET_TOGGLE(Toggle) (XmToggleButtonGetState(Toggle) == XmSET)
+#define SET_TOGGLE(Toggle, Value) XmToggleButtonSetState(Toggle, Value, false)
+#define GET_TEXT(Text) XmTextFieldGetString(Text)
+#define SET_TEXT(Text, Val) XmTextFieldSetString(Text, (char *)Val)
+#define free_TEXT(Val) XtFree(Val)
+#define SET_SCALE(Value) XmScaleSetValue(prf->scale, (int)(100 * Value))
+#define SET_SENSITIVE(Wid, Val) XtSetSensitive(Wid, Val)
+#define black_text(Prf) XtVaSetValues(Prf->label, XmNforeground, ss->black, NULL)
+#define red_text(Prf) XtVaSetValues(Prf->label, XmNforeground, ss->red, NULL)
+
+#define TIMEOUT(Func) XtAppAddTimeOut(MAIN_APP(ss), ERROR_WAIT_TIME, Func, (XtPointer)prf)
+
+
+static int get_scale_1(Widget scale)
+{
+ int val = 0;
+ XmScaleGetValue(scale, &val);
+ return(val);
+}
+
+#define GET_SCALE() (get_scale_1(prf->scale) * 0.01)
+
+
+static void set_radio_button(prefs_info *prf, int which)
+{
+ if ((which >= 0) && (which < prf->num_buttons))
+ {
+ int i;
+ for (i = 0; i < prf->num_buttons; i++)
+ {
+ if ((prf->radio_buttons[i]) &&
+ (XmIsToggleButton(prf->radio_buttons[i])))
+ XmToggleButtonSetState(prf->radio_buttons[i], (i == which), false);
+ }
+ prf->radio_button = prf->radio_buttons[which];
+ }
+}
+
+
+static int which_radio_button(prefs_info *prf)
+{
+ pointer_or_int_t which = 0;
+ XtVaGetValues(prf->radio_button, XmNuserData, &which, NULL);
+ return(which);
+}
+
+
+#include "snd-prefs.c"
+
+static bool prefs_dialog_error_is_posted = false;
+
+static void post_prefs_dialog_error(const char *message, void *data)
+{
+ XmString title;
+ title = XmStringCreateLocalized((char *)message);
+ XtVaSetValues(preferences_dialog,
+ XmNmessageString, title,
+ NULL);
+ XmStringFree(title);
+ prefs_dialog_error_is_posted = (message != NULL);
+}
+
+
+static void clear_prefs_dialog_error(void)
+{
+ if (prefs_dialog_error_is_posted)
+ {
+ prefs_dialog_error_is_posted = false;
+ post_prefs_dialog_error(NULL, NULL);
+ }
+}
+
+
+static void prefs_change_callback(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_unsaved = true;
+ prefs_set_dialog_title(NULL);
+ clear_prefs_dialog_error();
+}
+
+
+/* ---------------- row (main) label widget ---------------- */
+
+static Widget make_row_label(prefs_info *prf, const char *label, Widget box, Widget top_widget)
+{
+ Widget w;
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, MID_POSITION); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_END); n++;
+ w = XtCreateManagedWidget(label, xmLabelWidgetClass, box, args, n);
+ prf->saved_label = label;
+ return(w);
+}
+
+
+/* ---------------- row inner label widget ---------------- */
+
+static Widget make_row_inner_label(prefs_info *prf, const char *label, Widget left_widget, Widget box, Widget top_widget)
+{
+ Widget w;
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ w = XtCreateManagedWidget(label, xmLabelWidgetClass, box, args, n);
+ return(w);
+}
+
+
+/* ---------------- row middle separator widget ---------------- */
+
+static Widget make_row_middle_separator(Widget label, Widget box, Widget top_widget)
+{
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, label); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, label); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNwidth, MID_SPACE); n++;
+ XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_OUT); n++;
+ return(XtCreateManagedWidget("sep", xmSeparatorWidgetClass, box, args, n));
+}
+
+
+/* ---------------- row inner separator widget ---------------- */
+
+static Widget make_row_inner_separator(int width, Widget left_widget, Widget box, Widget top_widget)
+{
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNwidth, width); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ return(XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, box, args, n));
+}
+
+
+static Widget make_row_error(prefs_info *prf, Widget box, Widget left_widget, Widget top_widget)
+{
+ Arg args[20];
+ int n;
+ Widget w;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, left_widget); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_END); n++;
+ w = XtCreateManagedWidget("", xmLabelWidgetClass, box, args, n);
+ return(w);
+}
+
+
+/* ---------------- row toggle widget ---------------- */
+
+static Widget make_row_toggle_with_label(prefs_info *prf, bool current_value, Widget left_widget, Widget box, Widget top_widget, const char *label)
+{
+ Widget w;
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNset, (current_value) ? XmSET : XmUNSET); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNborderColor, ss->white); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNindicatorOn, XmINDICATOR_FILL); n++;
+ XtSetArg(args[n], XmNindicatorSize, 14); n++;
+ w = XtCreateManagedWidget(label, xmToggleButtonWidgetClass, box, args, n);
+ return(w);
+}
+
+
+static Widget make_row_toggle(prefs_info *prf, bool current_value, Widget left_widget, Widget box, Widget top_widget)
+{
+ return(make_row_toggle_with_label(prf, current_value, left_widget, box, top_widget, " "));
+}
+
+
+
+/* ---------------- row arrows ---------------- */
+
+static void remove_arrow_func(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if (prf->power_id != 0)
+ {
+ XtRemoveTimeOut(prf->power_id);
+ prf->power_id = 0;
+ }
+}
+
+
+static void arrow_func_up(XtPointer context, XtIntervalId *id)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if (XtIsSensitive(prf->arrow_up))
+ {
+ if ((prf) && (prf->arrow_up_func))
+ {
+ (*(prf->arrow_up_func))(prf);
+ prf->power_id = XtAppAddTimeOut(MAIN_APP(ss),
+ POWER_WAIT_TIME,
+ arrow_func_up,
+ (XtPointer)prf);
+ }
+ else prf->power_id = 0;
+ }
+}
+
+
+static void arrow_func_down(XtPointer context, XtIntervalId *id)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if (XtIsSensitive(prf->arrow_down))
+ {
+ if ((prf) && (prf->arrow_down_func))
+ {
+ (*(prf->arrow_down_func))(prf);
+ prf->power_id = XtAppAddTimeOut(MAIN_APP(ss),
+ POWER_WAIT_TIME,
+ arrow_func_down,
+ (XtPointer)prf);
+ }
+ else prf->power_id = 0;
+ }
+}
+
+
+static void call_arrow_down_press(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->arrow_down_func))
+ {
+ (*(prf->arrow_down_func))(prf);
+ if (XtIsSensitive(w))
+ prf->power_id = XtAppAddTimeOut(MAIN_APP(ss),
+ POWER_INITIAL_WAIT_TIME,
+ arrow_func_down,
+ (XtPointer)prf);
+ else prf->power_id = 0;
+ }
+}
+
+
+static void call_arrow_up_press(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->arrow_up_func))
+ {
+ (*(prf->arrow_up_func))(prf);
+ if (XtIsSensitive(w))
+ prf->power_id = XtAppAddTimeOut(MAIN_APP(ss),
+ POWER_INITIAL_WAIT_TIME,
+ arrow_func_up,
+ (XtPointer)prf);
+ else prf->power_id = 0;
+ }
+}
+
+
+static Widget make_row_arrows(prefs_info *prf, Widget box, Widget left_widget, Widget top_widget)
+{
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ XtSetArg(args[n], XmNarrowDirection, XmARROW_DOWN); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ prf->arrow_down = XtCreateManagedWidget("arrow-down", xmArrowButtonWidgetClass, box, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, prf->arrow_down); n++;
+ XtSetArg(args[n], XmNarrowDirection, XmARROW_UP); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ prf->arrow_up = XtCreateManagedWidget("arrow-up", xmArrowButtonWidgetClass, box, args, n);
+
+ XtAddCallback(prf->arrow_down, XmNarmCallback, call_arrow_down_press, (XtPointer)prf);
+ XtAddCallback(prf->arrow_down, XmNdisarmCallback, remove_arrow_func, (XtPointer)prf);
+ XtAddCallback(prf->arrow_up, XmNarmCallback, call_arrow_up_press, (XtPointer)prf);
+ XtAddCallback(prf->arrow_up, XmNdisarmCallback, remove_arrow_func, (XtPointer)prf);
+
+ XtAddCallback(prf->arrow_up, XmNactivateCallback, prefs_change_callback, NULL);
+ XtAddCallback(prf->arrow_down, XmNactivateCallback, prefs_change_callback, NULL);
+
+ return(prf->arrow_up);
+}
+
+
+/* ---------------- bool row ---------------- */
+
+static void call_toggle_func(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->toggle_func))
+ (*(prf->toggle_func))(prf);
+}
+
+
+static prefs_info *prefs_row_with_toggle(const char *label, const char *varname, bool current_value,
+ Widget box, Widget top_widget,
+ void (*toggle_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->toggle_func = toggle_func;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->toggle = make_row_toggle(prf, current_value, sep, box, top_widget);
+
+ XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
+ return(prf);
+}
+
+
+/* ---------------- two toggles ---------------- */
+
+static void call_toggle2_func(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->toggle2_func))
+ (*(prf->toggle2_func))(prf);
+}
+
+
+static prefs_info *prefs_row_with_two_toggles(const char *label, const char *varname,
+ const char *label1, bool value1,
+ const char *label2, bool value2,
+ Widget box, Widget top_widget,
+ void (*toggle_func)(prefs_info *prf),
+ void (*toggle2_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep, sep1;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->toggle_func = toggle_func;
+ prf->toggle2_func = toggle2_func;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->toggle = make_row_toggle_with_label(prf, value1, sep, box, top_widget, label1);
+ sep1 = make_row_inner_separator(20, prf->toggle, box, top_widget);
+ prf->toggle2 = make_row_toggle_with_label(prf, value2, sep1, box, top_widget, label2);
+
+ XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
+ XtAddCallback(prf->toggle2, XmNvalueChangedCallback, call_toggle2_func, (XtPointer)prf);
+ return(prf);
+}
+
+
+/* ---------------- toggle with text ---------------- */
+
+static void call_text_func(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->text_func))
+ (*(prf->text_func))(prf);
+}
+
+
+/* earlier versions of this dialog assumed the user would type <cr> to save a new value
+ * typed in a text widget, but no one does that anymore, so now, to catch these changes
+ * but not be confused by automatic changes (such as in a scale widget's label),
+ * we'll use XmNfocusCallback to set a text_focussed flag, XmNlosingFocusCallback to
+ * unset it, XmNvalueChangedCallback to set a text_changed flag, XmNactivateCallback
+ * to clear text_changed, and if XmNlosingFocusCallback sees that flag set, it
+ * calls the activate function and unsets the flag.
+ */
+
+typedef struct {
+ bool text_focussed, text_changed;
+ prefs_info *prf;
+} text_info;
+
+
+static void text_change_callback(Widget w, XtPointer context, XtPointer info)
+{
+ text_info *data = (text_info *)context;
+ if (data->text_focussed) /* try to omit non-user actions that change the value */
+ data->text_changed = true;
+}
+
+
+static void text_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ text_info *data = (text_info *)context;
+ data->text_changed = false;
+}
+
+
+static void text_grab_focus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ text_info *data = (text_info *)context;
+ data->text_focussed = true;
+}
+
+
+static void text_lose_focus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ text_info *data = (text_info *)context;
+ if ((data->text_focussed) &&
+ (data->text_changed) &&
+ (data->prf) &&
+ (data->prf->text_func))
+ {
+ (*(data->prf->text_func))(data->prf);
+ data->text_changed = false;
+ }
+}
+
+
+static Widget make_row_text(prefs_info *prf, const char *text_value, int cols, Widget left_widget, Widget box, Widget top_widget)
+{
+ Widget w;
+ int n;
+ Arg args[30];
+ text_info *info;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ if (cols != 0)
+ {
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNcolumns, cols); n++;
+ }
+ else
+ {
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ }
+ if (text_value)
+ {
+ XtSetArg(args[n], XmNvalue, text_value); n++;
+ }
+ XtSetArg(args[n], XmNmarginHeight, 1); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNborderColor, ss->white); n++;
+ XtSetArg(args[n], XmNbottomShadowColor, ss->white); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNtopShadowColor, ss->white); n++;
+ w = make_textfield_widget("text", box, args, n, ACTIVATABLE_BUT_NOT_FOCUSED, NO_COMPLETER);
+
+ XtAddCallback(w, XmNactivateCallback, prefs_change_callback, NULL);
+
+ info = (text_info *)calloc(1, sizeof(text_info));
+ info->prf = prf;
+
+ XtAddCallback(w, XmNactivateCallback, text_activate_callback, (XtPointer)info);
+ XtAddCallback(w, XmNvalueChangedCallback, text_change_callback, (XtPointer)info);
+ XtAddCallback(w, XmNfocusCallback, text_grab_focus_callback, (XtPointer)info);
+ XtAddCallback(w, XmNlosingFocusCallback, text_lose_focus_callback, (XtPointer)info);
+
+ return(w);
+}
+
+
+static prefs_info *prefs_row_with_toggle_with_text(const char *label, const char *varname, bool current_value,
+ const char *text_label, const char *text_value, int cols,
+ Widget box, Widget top_widget,
+ void (*toggle_func)(prefs_info *prf),
+ void (*text_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep, sep1, lab1;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->toggle_func = toggle_func;
+ prf->text_func = text_func;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->toggle = make_row_toggle(prf, current_value, sep, box, top_widget);
+ sep1 = make_row_inner_separator(16, prf->toggle, box, top_widget);
+ lab1 = make_row_inner_label(prf, text_label, sep1, box, top_widget);
+ prf->text = make_row_text(prf, text_value, cols, lab1, box, top_widget);
+
+ XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+
+ return(prf);
+}
+
+
+static prefs_info *prefs_row_with_toggle_with_two_texts(const char *label, const char *varname, bool current_value,
+ const char *label1, const char *text1,
+ const char *label2, const char *text2, int cols,
+ Widget box, Widget top_widget,
+ void (*toggle_func)(prefs_info *prf),
+ void (*text_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep, lab1, lab2, sep1;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->toggle_func = toggle_func;
+ prf->text_func = text_func;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->toggle = make_row_toggle(prf, current_value, sep, box, top_widget);
+ sep1 = make_row_inner_separator(16, prf->toggle, box, top_widget);
+ lab1 = make_row_inner_label(prf, label1, sep1, box, top_widget);
+ prf->text = make_row_text(prf, text1, cols, lab1, box, top_widget);
+ lab2 = make_row_inner_label(prf, label2, prf->text, box, top_widget);
+ prf->rtxt = make_row_text(prf, text2, cols, lab2, box, top_widget);
+
+ XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+ XtAddCallback(prf->rtxt, XmNactivateCallback, call_text_func, (XtPointer)prf);
+
+ return(prf);
+}
+
+
+/* ---------------- text with toggle ---------------- */
+
+static prefs_info *prefs_row_with_text_with_toggle(const char *label, const char *varname, bool current_value,
+ const char *toggle_label, const char *text_value, int cols,
+ Widget box, Widget top_widget,
+ void (*toggle_func)(prefs_info *prf),
+ void (*text_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep, sep1, lab1;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->toggle_func = toggle_func;
+ prf->text_func = text_func;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->text = make_row_text(prf, text_value, cols, sep, box, top_widget);
+ sep1 = make_row_inner_separator(8, prf->text, box, top_widget);
+ lab1 = make_row_inner_label(prf, toggle_label, sep1, box, top_widget);
+ prf->toggle = make_row_toggle(prf, current_value, lab1, box, top_widget);
+
+ XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+
+ return(prf);
+}
+
+
+/* ---------------- text with toggle ---------------- */
+
+static prefs_info *prefs_row_with_text_and_three_toggles(const char *label, const char *varname,
+ const char *text_label, int cols,
+ const char *toggle1_label, const char *toggle2_label, const char *toggle3_label,
+ const char *text_value,
+ bool toggle1_value, bool toggle2_value, bool toggle3_value,
+ Widget box, Widget top_widget,
+ void (*text_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep, sep1, lab1, sep2, lab2, lab3, sep3, lab4;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->text_func = text_func;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ lab3 = make_row_inner_label(prf, text_label, sep, box, top_widget);
+ prf->text = make_row_text(prf, text_value, cols, lab3, box, top_widget);
+ sep1 = make_row_inner_separator(12, prf->text, box, top_widget);
+ lab1 = make_row_inner_label(prf, toggle1_label, sep1, box, top_widget);
+ prf->toggle = make_row_toggle(prf, toggle1_value, lab1, box, top_widget);
+ sep2 = make_row_inner_separator(4, prf->toggle, box, top_widget);
+ lab2 = make_row_inner_label(prf, toggle2_label, sep2, box, top_widget);
+ prf->toggle2 = make_row_toggle(prf, toggle2_value, lab2, box, top_widget);
+ sep3 = make_row_inner_separator(4, prf->toggle2, box, top_widget);
+ lab4 = make_row_inner_label(prf, toggle3_label, sep3, box, top_widget);
+ prf->toggle3 = make_row_toggle(prf, toggle3_value, lab4, box, top_widget);
+
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+
+ return(prf);
+}
+
+
+/* ---------------- radio row ---------------- */
+
+static void call_radio_func(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->toggle_func))
+ {
+ prf->radio_button = w;
+ (*(prf->toggle_func))(prf);
+ }
+}
+
+
+static Widget make_row_radio_box(prefs_info *prf,
+ const char **labels, int num_labels, int current_value,
+ Widget box, Widget left_widget, Widget top_widget)
+{
+ Arg args[20];
+ int i, n;
+ Widget w;
+
+ prf->radio_buttons = (Widget *)calloc(num_labels, sizeof(Widget));
+ prf->num_buttons = num_labels;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNborderColor, ss->white); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNpacking, XmPACK_TIGHT); n++;
+ w = XmCreateRadioBox(box, (char *)"radio-box", args, n);
+ XtManageChild(w);
+
+ for (i = 0; i < num_labels; i++)
+ {
+ Widget button;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNset, (i == current_value) ? XmSET : XmUNSET); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNborderColor, ss->white); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNindicatorOn, XmINDICATOR_FILL); n++;
+ XtSetArg(args[n], XmNindicatorSize, 14); n++;
+ XtSetArg(args[n], XmNselectColor, ss->green); n++;
+ XtSetArg(args[n], XmNuserData, i); n++;
+ button = XtCreateManagedWidget(labels[i], xmToggleButtonWidgetClass, w, args, n);
+ prf->radio_buttons[i] = button;
+
+ XtAddCallback(button, XmNvalueChangedCallback, call_radio_func, (XtPointer)prf);
+ XtAddCallback(button, XmNvalueChangedCallback, prefs_change_callback, NULL);
+ }
+ return(w);
+}
+
+
+static prefs_info *prefs_row_with_radio_box(const char *label, const char *varname,
+ const char **labels, int num_labels, int current_value,
+ Widget box, Widget top_widget,
+ void (*toggle_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->toggle_func = toggle_func;
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->toggle = make_row_radio_box(prf, labels, num_labels, current_value, box, sep, top_widget);
+ return(prf);
+}
+
+
+/* ---------------- radio box + number ---------------- */
+
+static prefs_info *prefs_row_with_radio_box_and_number(const char *label, const char *varname,
+ const char **labels, int num_labels, int current_value,
+ const char *text_value, int text_cols,
+ Widget box, Widget top_widget,
+ void (*toggle_func)(prefs_info *prf),
+ void (*arrow_up_func)(prefs_info *prf), void (*arrow_down_func)(prefs_info *prf),
+ void (*text_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->toggle_func = toggle_func;
+ prf->text_func = text_func;
+ prf->arrow_up_func = arrow_up_func;
+ prf->arrow_down_func = arrow_down_func;
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->toggle = make_row_radio_box(prf, labels, num_labels, current_value, box, sep, top_widget);
+ prf->text = make_row_text(prf, text_value, text_cols, prf->toggle, box, top_widget);
+ prf->arrow_up = make_row_arrows(prf, box, prf->text, top_widget);
+
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+ return(prf);
+}
+
+
+/* ---------------- scale row ---------------- */
+
+static void call_scale_func(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->scale_func))
+ (*(prf->scale_func))(prf);
+}
+
+
+static void call_scale_text_func(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->text_func))
+ (*(prf->text_func))(prf);
+}
+
+
+static void prefs_scale_callback(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ XmScaleCallbackStruct *cb = (XmScaleCallbackStruct *)info;
+ float_to_textfield(prf->text, (cb->value * prf->scale_max) / 100.0);
+}
+
+
+static prefs_info *prefs_row_with_scale(const char *label, const char *varname,
+ mus_float_t max_val, mus_float_t current_value,
+ Widget box, Widget top_widget,
+ void (*scale_func)(prefs_info *prf),
+ void (*text_func)(prefs_info *prf))
+{
+ Arg args[20];
+ int n;
+ prefs_info *prf = NULL;
+ Widget sep;
+ XtCallbackList n1, n2;
+ char *str;
+
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ prf->scale_max = max_val;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+
+ str = (char *)calloc(12, sizeof(char));
+ snprintf(str, 12, "%.3f", current_value);
+ prf->text = make_row_text(prf, str, 6, sep, box, top_widget);
+ free(str);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, prf->text); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNborderColor, ss->white); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowValue, XmNONE); n++;
+ XtSetArg(args[n], XmNvalue, (int)(100 * current_value / max_val)); n++;
+ XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(prefs_scale_callback, (XtPointer)prf)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(prefs_scale_callback, (XtPointer)prf)); n++;
+ prf->scale = XtCreateManagedWidget("", xmScaleWidgetClass, box, args, n);
+
+ prf->scale_func = scale_func;
+ prf->text_func = text_func;
+
+ XtAddCallback(prf->scale, XmNvalueChangedCallback, call_scale_func, (XtPointer)prf);
+ XtAddCallback(prf->text, XmNactivateCallback, call_scale_text_func, (XtPointer)prf);
+ XtAddCallback(prf->scale, XmNvalueChangedCallback, prefs_change_callback, NULL);
+
+ free(n1);
+ free(n2);
+
+ return(prf);
+}
+
+
+/* ---------------- text row ---------------- */
+
+static prefs_info *prefs_row_with_text(const char *label, const char *varname, const char *value,
+ Widget box, Widget top_widget,
+ void (*text_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->text = make_row_text(prf, value, 0, sep, box, top_widget);
+
+ prf->text_func = text_func;
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+ return(prf);
+}
+
+
+
+/* ---------------- two texts in a row ---------------- */
+
+static prefs_info *prefs_row_with_two_texts(const char *label, const char *varname,
+ const char *label1, const char *text1, const char *label2, const char *text2, int cols,
+ Widget box, Widget top_widget,
+ void (*text_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep, lab1, lab2;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ lab1 = make_row_inner_label(prf, label1, sep, box, top_widget);
+ prf->text = make_row_text(prf, text1, cols, lab1, box, top_widget);
+ lab2 = make_row_inner_label(prf, label2, prf->text, box, top_widget);
+ prf->rtxt = make_row_text(prf, text2, cols, lab2, box, top_widget);
+
+ prf->text_func = text_func;
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+ XtAddCallback(prf->rtxt, XmNactivateCallback, call_text_func, (XtPointer)prf);
+
+ return(prf);
+}
+
+
+/* ---------------- number row ---------------- */
+
+static prefs_info *prefs_row_with_number(const char *label, const char *varname, const char *value, int cols,
+ Widget box, Widget top_widget,
+ void (*arrow_up_func)(prefs_info *prf), void (*arrow_down_func)(prefs_info *prf),
+ void (*text_func)(prefs_info *prf))
+{
+ prefs_info *prf = NULL;
+ Widget sep;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+ prf->text = make_row_text(prf, value, cols, sep, box, top_widget);
+ prf->arrow_up = make_row_arrows(prf, box, prf->text, top_widget);
+ prf->error = make_row_error(prf, box, prf->arrow_up, top_widget);
+
+ prf->text_func = text_func;
+ prf->arrow_up_func = arrow_up_func;
+ prf->arrow_down_func = arrow_down_func;
+
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+
+ return(prf);
+}
+
+
+/* ---------------- list row ---------------- */
+
+typedef struct {
+ prefs_info *prf;
+ char *value;
+} list_entry;
+
+static list_entry *make_list_entry(prefs_info *prf, const char *value)
+{
+ list_entry *le;
+ le = (list_entry *)calloc(1, sizeof(list_entry));
+ le->prf = prf;
+ le->value = (char *)value;
+ return(le);
+}
+
+
+static void prefs_list_callback(Widget w, XtPointer context, XtPointer info)
+{
+ list_entry *le = (list_entry *)context;
+ if ((le) && (le->prf->list_func))
+ (*(le->prf->list_func))(le->prf, le->value);
+}
+
+
+static prefs_info *prefs_row_with_list(const char *label, const char *varname, const char *value,
+ const char **values, int num_values,
+ Widget box, Widget top_widget,
+ void (*text_func)(prefs_info *prf),
+ char *(*completion_func)(widget_t w, const char *text, void *context), void *completion_context,
+ void (*list_func)(prefs_info *prf, char *value))
+{
+ Arg args[20];
+ int n, i, cols = 0;
+ prefs_info *prf = NULL;
+ Widget sep, sbar;
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+
+ /* get text widget size */
+ for (i = 0; i < num_values; i++)
+ if (values[i])
+ {
+ int len;
+ len = strlen(values[i]);
+ if (len > cols) cols = len;
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNcolumns, cols + 1); n++;
+ XtSetArg(args[n], XmNvalue, value); n++;
+ XtSetArg(args[n], XmNmarginHeight, 1); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNborderColor, ss->white); n++;
+ XtSetArg(args[n], XmNbottomShadowColor, ss->white); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNtopShadowColor, ss->white); n++;
+ if (completion_func)
+ prf->text = make_textfield_widget("text", box, args, n, ACTIVATABLE_BUT_NOT_FOCUSED, add_completer_func(completion_func, completion_context));
+ else prf->text = make_textfield_widget("text", box, args, n, ACTIVATABLE_BUT_NOT_FOCUSED, NO_COMPLETER);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, prf->text); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ sbar = XmCreateMenuBar(box, (char *)"menuBar", args, n);
+ XtManageChild(sbar);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ prf->list_menu = XmCreatePulldownMenu(sbar, (char *)"sort-menu", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNsubMenuId, prf->list_menu); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNmarginHeight, 1); n++;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, prf->text); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ prf->arrow_right = XtCreateManagedWidget(">", xmCascadeButtonWidgetClass, sbar, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ for (i = 0; i < num_values; i++)
+ if (values[i])
+ {
+ Widget tmp;
+ tmp = XtCreateManagedWidget(values[i], xmPushButtonWidgetClass, prf->list_menu, args, n);
+ XtAddCallback(tmp, XmNactivateCallback, prefs_list_callback, make_list_entry(prf, values[i]));
+ XtAddCallback(tmp, XmNactivateCallback, prefs_change_callback, NULL);
+ }
+
+ prf->error = make_row_error(prf, box, prf->arrow_right, top_widget);
+ prf->text_func = text_func;
+ XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
+ XtAddCallback(prf->text, XmNactivateCallback, prefs_change_callback, NULL);
+ XtAddCallback(prf->arrow_right, XmNactivateCallback, prefs_change_callback, NULL);
+
+ prf->list_func = list_func;
+ return(prf);
+}
+
+
+/* ---------------- color selector row(s) ---------------- */
+
+static XColor *rgb_to_color_1(mus_float_t r, mus_float_t g, mus_float_t b)
+{
+ Display *dpy;
+ XColor *new_color;
+ new_color = (XColor *)calloc(1, sizeof(XColor));
+ new_color->flags = DoRed | DoGreen | DoBlue;
+ new_color->red = float_to_rgb(r);
+ new_color->green = float_to_rgb(g);
+ new_color->blue = float_to_rgb(b);
+ dpy = MAIN_DISPLAY(ss);
+ XAllocColor(dpy, DefaultColormap(dpy, DefaultScreen(dpy)), new_color);
+ return(new_color);
+}
+
+
+#define COLOR_MAX 90
+#define COLOR_MAXF 90.0
+#define COLOR_MARGIN 1
+
+static color_t rgb_to_color(mus_float_t r, mus_float_t g, mus_float_t b)
+{
+ color_t temp;
+ XColor *color;
+ color = rgb_to_color_1(r, g, b);
+ temp = color->pixel;
+ free(color);
+ return(temp);
+}
+
+
+static void pixel_to_rgb(Pixel pix, float *r, float *g, float *b)
+{
+ XColor tmp_color;
+ Display *dpy;
+ dpy = XtDisplay(MAIN_SHELL(ss));
+ tmp_color.flags = DoRed | DoGreen | DoBlue;
+ tmp_color.pixel = pix;
+ XQueryColor(dpy, DefaultColormap(dpy, DefaultScreen(dpy)), &tmp_color);
+ (*r) = rgb_to_float(tmp_color.red);
+ (*g) = rgb_to_float(tmp_color.green);
+ (*b) = rgb_to_float(tmp_color.blue);
+}
+
+
+static void XmScrollBarGetValue(Widget w, int *val)
+{
+ XtVaGetValues(w, XmNvalue, val, NULL);
+}
+
+
+static void XmScrollBarSetValue(Widget w, int val)
+{
+ XtVaSetValues(w, XmNvalue, val, NULL);
+}
+
+
+static void reflect_color(prefs_info *prf)
+{
+ int ir = 0, ig = 0, ib = 0;
+ mus_float_t r, g, b;
+ XColor *current_color;
+ Pixel pixel;
+
+ XmScrollBarGetValue(prf->rscl, &ir);
+ XmScrollBarGetValue(prf->gscl, &ig);
+ XmScrollBarGetValue(prf->bscl, &ib);
+
+ current_color = rgb_to_color_1(ir / COLOR_MAXF, ig / COLOR_MAXF, ib / COLOR_MAXF);
+ r = rgb_to_float(current_color->red);
+ g = rgb_to_float(current_color->green);
+ b = rgb_to_float(current_color->blue);
+
+ pixel = current_color->pixel;
+ free(current_color);
+ current_color = NULL;
+
+ XtVaSetValues(prf->color, XmNbackground, pixel, NULL);
+ float_to_textfield(prf->rtxt, r);
+ float_to_textfield(prf->gtxt, g);
+ float_to_textfield(prf->btxt, b);
+}
+
+
+static void prefs_color_callback(Widget w, XtPointer context, XtPointer info)
+{
+ reflect_color((prefs_info *)context);
+}
+
+
+static void unpost_color_error(XtPointer data, XtIntervalId *id)
+{
+ prefs_info *prf = (prefs_info *)data;
+ reflect_color(prf);
+ prf->got_error = false;
+ black_text(prf);
+ set_label(prf->label, prf->saved_label);
+}
+
+
+static void errors_to_color_text(const char *msg, void *data)
+{
+ prefs_info *prf = (prefs_info *)data;
+ prf->got_error = true;
+ red_text(prf);
+ set_label(prf->label, msg);
+ XtAppAddTimeOut(MAIN_APP(ss),
+ ERROR_WAIT_TIME,
+ (XtTimerCallbackProc)unpost_color_error,
+ data);
+}
+
+
+static void prefs_r_callback(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ char *str;
+ float r;
+ str = XmTextFieldGetString(w);
+ redirect_errors_to(errors_to_color_text, (void *)prf);
+ r = (float)string_to_mus_float_t(str, 0.0, "red amount");
+ redirect_errors_to(NULL, NULL);
+
+ XmScrollBarSetValue(prf->rscl, mus_iclamp(0, (int)(COLOR_MAX * r), COLOR_MAX));
+
+ if (!(prf->got_error)) reflect_color(prf);
+ if (str) XtFree(str);
+}
+
+
+static void prefs_g_callback(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ char *str;
+ float r;
+ str = XmTextFieldGetString(w);
+ redirect_errors_to(errors_to_color_text, (void *)prf);
+ r = (float)string_to_mus_float_t(str, 0.0, "green amount");
+ redirect_errors_to(NULL, NULL);
+
+ XmScrollBarSetValue(prf->gscl, mus_iclamp(0, (int)(COLOR_MAX * r), COLOR_MAX));
+
+ if (!(prf->got_error)) reflect_color(prf);
+ if (str) XtFree(str);
+}
+
+
+static void prefs_b_callback(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ char *str;
+ float r;
+ str = XmTextFieldGetString(w);
+ redirect_errors_to(errors_to_color_text, (void *)prf);
+ r = (float)string_to_mus_float_t(str, 0.0, "blue amount");
+ redirect_errors_to(NULL, NULL);
+
+ XmScrollBarSetValue(prf->bscl, mus_iclamp(0, (int)(COLOR_MAX * r), COLOR_MAX));
+
+ if (!(prf->got_error)) reflect_color(prf);
+ if (str) XtFree(str);
+}
+
+
+static void prefs_call_color_func_callback(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ if ((prf) && (prf->color_func))
+ {
+ int ir = 0, ig = 0, ib = 0;
+
+ XmScrollBarGetValue(prf->rscl, &ir);
+ XmScrollBarGetValue(prf->gscl, &ig);
+ XmScrollBarGetValue(prf->bscl, &ib);
+
+ (*(prf->color_func))(prf, (float)ir / COLOR_MAXF, (float)ig / COLOR_MAXF, (float)ib / COLOR_MAXF);
+ }
+}
+
+
+static void scale_set_color(prefs_info *prf, color_t pixel)
+{
+ float r = 0.0, g = 0.0, b = 0.0;
+ pixel_to_rgb(pixel, &r, &g, &b);
+ float_to_textfield(prf->rtxt, r);
+ XmScrollBarSetValue(prf->rscl, (int)(COLOR_MAX * r));
+ float_to_textfield(prf->gtxt, g);
+ XmScrollBarSetValue(prf->gscl, (int)(COLOR_MAX * g));
+ float_to_textfield(prf->btxt, b);
+ XmScrollBarSetValue(prf->bscl, (int)(COLOR_MAX * b));
+ XtVaSetValues(prf->color, XmNbackground, pixel, NULL);
+}
+
+
+static Pixel red, green, blue;
+
+static prefs_info *prefs_color_selector_row(const char *label, const char *varname,
+ Pixel current_pixel,
+ Widget box, Widget top_widget,
+ void (*color_func)(prefs_info *prf, float r, float g, float b))
+{
+ Arg args[20];
+ int n;
+ prefs_info *prf = NULL;
+ Widget sep, sep1, frame;
+ XtCallbackList n1;
+ float r = 0.0, g = 0.0, b = 0.0;
+
+ prf = (prefs_info *)calloc(1, sizeof(prefs_info));
+ prf->var_name = varname;
+ pixel_to_rgb(current_pixel, &r, &g, &b);
+
+ prf->label = make_row_label(prf, label, box, top_widget);
+ sep = make_row_middle_separator(prf->label, box, top_widget);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, current_pixel); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, sep); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, sep); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, PREFS_COLOR_POSITION); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ frame = XtCreateManagedWidget("frame", xmFrameWidgetClass, box, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, current_pixel); n++;
+ prf->color = XtCreateManagedWidget("", xmLabelWidgetClass, frame, args, n);
+
+ sep1 = make_row_inner_separator(8, prf->color, box, top_widget);
+
+ prf->rtxt = make_row_text(prf, NULL, 6, sep1, box, top_widget);
+ float_to_textfield(prf->rtxt, r);
+
+ prf->gtxt = make_row_text(prf, NULL, 6, prf->rtxt, box, top_widget);
+ float_to_textfield(prf->gtxt, g);
+
+ prf->btxt = make_row_text(prf, NULL, 6, prf->gtxt, box, top_widget);
+ float_to_textfield(prf->btxt, b);
+
+ /* second row = 3 scales */
+ n1 = make_callback_list(prefs_color_callback, (XtPointer)prf);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNforeground, red); n++;
+ XtSetArg(args[n], XmNsliderVisual, XmFOREGROUND_COLOR); n++;
+ XtSetArg(args[n], XmNsliderMark, XmTHUMB_MARK); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, prf->label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ if (FIRST_COLOR_POSITION == 0)
+ {
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ }
+ else
+ {
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, FIRST_COLOR_POSITION); n++;
+ }
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, SECOND_COLOR_POSITION - COLOR_MARGIN); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ /* scale widget borders are messed up in some Motifs -- they aren't erased correctly in a scrolled window
+ * so, try to use a scrollbar instead.
+ */
+ XtSetArg(args[n], XmNmaximum, 100); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowArrows, XmNONE); n++;
+ XtSetArg(args[n], XmNvalue, (int)(COLOR_MAX * r)); n++;
+ XtSetArg(args[n], XmNdragCallback, n1); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n1); n++;
+ prf->rscl = XtCreateManagedWidget("", xmScrollBarWidgetClass, box, args, n);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNforeground, green); n++;
+ XtSetArg(args[n], XmNsliderVisual, XmFOREGROUND_COLOR); n++;
+ XtSetArg(args[n], XmNsliderMark, XmTHUMB_MARK); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, prf->label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, SECOND_COLOR_POSITION + COLOR_MARGIN); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, THIRD_COLOR_POSITION - COLOR_MARGIN); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNmaximum, 100); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowArrows, XmNONE); n++;
+ XtSetArg(args[n], XmNvalue, (int)(COLOR_MAX * g)); n++;
+ XtSetArg(args[n], XmNdragCallback, n1); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n1); n++;
+ prf->gscl = XtCreateManagedWidget("", xmScrollBarWidgetClass, box, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNforeground, blue); n++;
+ XtSetArg(args[n], XmNsliderVisual, XmFOREGROUND_COLOR); n++;
+ XtSetArg(args[n], XmNsliderMark, XmTHUMB_MARK); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, prf->label); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, THIRD_COLOR_POSITION + COLOR_MARGIN); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 80); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNmaximum, 100); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNshowArrows, XmNONE); n++;
+ XtSetArg(args[n], XmNvalue, (int)(COLOR_MAX * b)); n++;
+ XtSetArg(args[n], XmNdragCallback, n1); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n1); n++;
+ prf->bscl = XtCreateManagedWidget("", xmScrollBarWidgetClass, box, args, n);
+
+ XtAddCallback(prf->rtxt, XmNactivateCallback, prefs_r_callback, (XtPointer)prf);
+ XtAddCallback(prf->gtxt, XmNactivateCallback, prefs_g_callback, (XtPointer)prf);
+ XtAddCallback(prf->btxt, XmNactivateCallback, prefs_b_callback, (XtPointer)prf);
+
+ XtAddCallback(prf->rscl, XmNvalueChangedCallback, prefs_call_color_func_callback, (XtPointer)prf);
+ XtAddCallback(prf->gscl, XmNvalueChangedCallback, prefs_call_color_func_callback, (XtPointer)prf);
+ XtAddCallback(prf->bscl, XmNvalueChangedCallback, prefs_call_color_func_callback, (XtPointer)prf);
+
+ XtAddCallback(prf->rscl, XmNvalueChangedCallback, prefs_change_callback, NULL);
+ XtAddCallback(prf->gscl, XmNvalueChangedCallback, prefs_change_callback, NULL);
+ XtAddCallback(prf->bscl, XmNvalueChangedCallback, prefs_change_callback, NULL);
+
+ prf->color_func = color_func;
+ free(n1);
+ return(prf);
+}
+
+
+/* ---------------- topic separator ---------------- */
+
+static Widget make_inter_topic_separator(Widget topics)
+{
+ int n;
+ Arg args[20];
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, INTER_TOPIC_SPACE); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ return(XtCreateManagedWidget("sep", xmSeparatorWidgetClass, topics, args, n));
+}
+
+
+/* ---------------- variable separator ---------------- */
+
+static Widget make_inter_variable_separator(Widget topics, Widget top_widget)
+{
+ int n;
+ Arg args[20];
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, INTER_VARIABLE_SPACE); n++;
+ XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
+ return(XtCreateManagedWidget("sep", xmSeparatorWidgetClass, topics, args, n));
+}
+
+
+/* ---------------- top-level contents label ---------------- */
+
+static Widget make_top_level_label(const char *label, Widget parent)
+{
+ int n;
+ Arg args[20];
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->light_blue); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNheight, 32); n++;
+ return(XtCreateManagedWidget(label, xmLabelWidgetClass, parent, args, n));
+}
+
+
+static Widget make_top_level_box(Widget topics)
+{
+ Widget frame;
+ int n;
+ Arg args[20];
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ frame = XtCreateManagedWidget("pref-frame", xmFrameWidgetClass, topics, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ return(XtCreateManagedWidget("pref-box", xmFormWidgetClass, frame, args, n));
+}
+
+static Widget make_inner_label(const char *label, Widget parent, Widget top_widget)
+{
+ int n;
+ Arg args[20];
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, top_widget); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNheight, 32); n++;
+ return(XtCreateManagedWidget(label, xmLabelWidgetClass, parent, args, n));
+}
+
+
+/* ---------------- base buttons ---------------- */
+
+static void wm_delete_callback(Widget w, XtPointer context, XtPointer info)
+{
+ clear_prefs_dialog_error();
+}
+
+
+static void preferences_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_help("preferences",
+ "This dialog sets various global variables. 'Save' then writes the new values \
+to ~/.snd_prefs_ruby|forth|s7 so that they take effect the next time you start Snd. 'Revert' resets each variable either to \
+its value when the Preferences dialog was started, or to the last saved value. 'Clear' resets each variable to its default value (its \
+value when Snd starts, before loading initialization files). 'Help' starts this dialog, and as long as it's active, it will post helpful \
+information if the mouse lingers over some variable -- sort of a tooltip that stays out of your way. \
+You can also request help on a given topic by clicking the variable name on the far right.",
+ WITH_WORD_WRAP);
+}
+
+
+static void preferences_quit_callback(Widget w, XtPointer context, XtPointer info)
+{
+ clear_prefs_dialog_error();
+ if (XmGetFocusWidget(preferences_dialog) == XmMessageBoxGetChild(preferences_dialog, XmDIALOG_CANCEL_BUTTON))
+ XtUnmanageChild(preferences_dialog);
+}
+
+
+static void prefs_set_dialog_title(const char *filename)
+{
+ XmString title;
+ char *str;
+ if (filename)
+ {
+ if (prefs_saved_filename) free(prefs_saved_filename);
+ prefs_saved_filename = mus_strdup(filename);
+ }
+ if (prefs_saved_filename)
+ str = mus_format("Preferences%s (saved in %s)\n",
+ (prefs_unsaved) ? "*" : "",
+ prefs_saved_filename);
+ else str = mus_format("Preferences%s",
+ (prefs_unsaved) ? "*" : "");
+ title = XmStringCreateLocalized(str);
+ free(str);
+ XtVaSetValues(preferences_dialog,
+ XmNdialogTitle, title,
+ NULL);
+ XmStringFree(title);
+}
+
+
+static void preferences_revert_callback(Widget w, XtPointer context, XtPointer info)
+{
+ preferences_revert_or_clear(true);
+}
+
+
+static void preferences_clear_callback(Widget w, XtPointer context, XtPointer info)
+{
+ preferences_revert_or_clear(false);
+}
+
+
+#if HAVE_EXTENSION_LANGUAGE
+static void preferences_save_callback(Widget w, XtPointer context, XtPointer info)
+{
+ clear_prefs_dialog_error();
+ redirect_snd_error_to(post_prefs_dialog_error, NULL);
+ redirect_snd_warning_to(post_prefs_dialog_error, NULL);
+ save_prefs();
+ redirect_snd_error_to(NULL, NULL);
+ redirect_snd_warning_to(NULL, NULL);
+}
+#endif
+
+
+
+/* ---------------- errors ---------------- */
+
+static void clear_prefs_error(Widget w, XtPointer context, XtPointer info)
+{
+ prefs_info *prf = (prefs_info *)context;
+ XtRemoveCallback(prf->text, XmNvalueChangedCallback, clear_prefs_error, context);
+ set_label(prf->error, "");
+}
+
+
+static void post_prefs_error(const char *msg, prefs_info *prf)
+{
+ prf->got_error = true;
+ set_label(prf->error, msg);
+ XtAddCallback(prf->text, XmNvalueChangedCallback, clear_prefs_error, (XtPointer)prf);
+}
+
+
+static void va_post_prefs_error(const char *msg, prefs_info *data, ...)
+{
+ char *buf;
+ va_list ap;
+ va_start(ap, data);
+ buf = vstr(msg, ap);
+ va_end(ap);
+ post_prefs_error(buf, data);
+ free(buf);
+}
+
+
+/* ---------------- preferences dialog ---------------- */
+
+widget_t make_preferences_dialog(void)
+{
+ Arg args[20];
+ Widget scroller, topics, current_sep;
+ char *str;
+ prefs_info *prf;
+
+ if (preferences_dialog)
+ {
+ /* I don't think this should reflect current state except when it is created */
+ if (!(XtIsManaged(preferences_dialog)))
+ XtManageChild(preferences_dialog);
+ else raise_dialog(preferences_dialog);
+ return(preferences_dialog);
+ }
+
+ /* -------- base buttons -------- */
+ {
+ int n;
+ XmString title, help, revert, clear, save, go_away;
+ Widget clear_button, revert_button;
+#if HAVE_EXTENSION_LANGUAGE
+ Widget save_button;
+
+ save = XmStringCreateLocalized((char *)"Save");
+#endif
+
+ title = XmStringCreateLocalized((char *)"Preferences");
+ help = XmStringCreateLocalized((char *)I_HELP);
+ revert = XmStringCreateLocalized((char *)"Revert");
+ clear = XmStringCreateLocalized((char *)"Clear");
+ go_away = XmStringCreateLocalized((char *)I_GO_AWAY);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ XtSetArg(args[n], XmNcancelLabelString, go_away); n++;
+ XtSetArg(args[n], XmNhelpLabelString, help); n++;
+ XtSetArg(args[n], XmNokLabelString, revert); n++;
+ XtSetArg(args[n], XmNdialogTitle, title); n++;
+ XtSetArg(args[n], XmNallowShellResize, true); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ {
+ Dimension width, height;
+ width = XDisplayWidth(MAIN_DISPLAY(ss), DefaultScreen(MAIN_DISPLAY(ss)));
+ height = XDisplayHeight(MAIN_DISPLAY(ss), DefaultScreen(MAIN_DISPLAY(ss)));
+
+ XtSetArg(args[n], XmNwidth, (STARTUP_WIDTH < width) ? (Dimension)STARTUP_WIDTH : ((Dimension)(width - 50))); n++;
+ XtSetArg(args[n], XmNheight, (STARTUP_HEIGHT < height) ? (Dimension)STARTUP_HEIGHT : ((Dimension)(height - 50))); n++;
+ }
+ preferences_dialog = XmCreateTemplateDialog(MAIN_PANE(ss), (char *)"preferences", args, n);
+ revert_button = XmMessageBoxGetChild(preferences_dialog, XmDIALOG_OK_BUTTON);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ clear_button = XtCreateManagedWidget("Clear", xmPushButtonGadgetClass, preferences_dialog, args, n);
+
+#if HAVE_EXTENSION_LANGUAGE
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ save_button = XtCreateManagedWidget("Save", xmPushButtonGadgetClass, preferences_dialog, args, n);
+ XtAddCallback(save_button, XmNactivateCallback, preferences_save_callback, NULL);
+#endif
+
+ XtAddCallback(preferences_dialog, XmNcancelCallback, preferences_quit_callback, NULL);
+ XtAddCallback(preferences_dialog, XmNhelpCallback, preferences_help_callback, NULL);
+ /* XtAddCallback(preferences_dialog, XmNokCallback, preferences_revert_callback, NULL); */
+ XtAddCallback(revert_button, XmNactivateCallback, preferences_revert_callback, NULL);
+ XtAddCallback(clear_button, XmNactivateCallback, preferences_clear_callback, NULL);
+
+ XmStringFree(title);
+ XmStringFree(help);
+#if HAVE_EXTENSION_LANGUAGE
+ XmStringFree(save);
+#endif
+ XmStringFree(go_away);
+ XmStringFree(revert);
+ XmStringFree(clear);
+
+ map_over_children(preferences_dialog, set_main_color_of_widget);
+#if HAVE_EXTENSION_LANGUAGE
+ XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+#endif
+ XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(preferences_dialog, XmDIALOG_SEPARATOR)); n++;
+ XtSetArg(args[n], XmNscrollingPolicy, XmAUTOMATIC); n++;
+ XtSetArg(args[n], XmNscrollBarDisplayPolicy, XmSTATIC); n++;
+ scroller = XmCreateScrolledWindow(preferences_dialog, (char *)"pref-scroller", args, n);
+ XtManageChild(scroller);
+
+ n = attach_all_sides(args, 0);
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ topics = XtCreateManagedWidget("pref-topics", xmRowColumnWidgetClass, scroller, args, n);
+ XtVaSetValues(scroller,
+ XmNworkWindow, topics,
+ NULL);
+ }
+
+ red = rgb_to_color(1.0, 0.0, 0.0);
+ green = rgb_to_color(0.0, 1.0, 0.0);
+ blue = rgb_to_color(0.0, 0.0, 1.0);
+
+
+ /* ---------------- overall behavior ---------------- */
+
+ {
+ Widget dpy_box, dpy_label, file_label, cursor_label, key_label;
+ char *str1, *str2;
+
+ /* ---------------- overall behavior ----------------*/
+
+ dpy_box = make_top_level_box(topics);
+ dpy_label = make_top_level_label("overall behavior choices", dpy_box);
+
+ current_sep = dpy_label;
+ str1 = mus_format("%d", ss->init_window_width);
+ str2 = mus_format("%d", ss->init_window_height);
+ rts_init_window_width = ss->init_window_width;
+ rts_init_window_height = ss->init_window_height;
+ prf = prefs_row_with_two_texts("start up size", S_window_width,
+ "width:", str1, "height:", str2, 6,
+ dpy_box, current_sep,
+ startup_size_text);
+ remember_pref(prf, reflect_init_window_size, save_init_window_size, help_init_window_size, clear_init_window_size, revert_init_window_size);
+ free(str2);
+ free(str1);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_toggle("ask before overwriting anything", S_ask_before_overwrite,
+ rts_ask_before_overwrite = ask_before_overwrite(ss),
+ dpy_box, current_sep,
+ overwrite_toggle);
+ remember_pref(prf, reflect_ask_before_overwrite, save_ask_before_overwrite, help_ask_before_overwrite, NULL, revert_ask_before_overwrite);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_toggle("ask about unsaved edits before exiting", S_ask_about_unsaved_edits,
+ rts_unsaved_edits = ask_about_unsaved_edits(ss),
+ dpy_box, current_sep,
+ unsaved_edits_toggle);
+ remember_pref(prf, reflect_unsaved_edits, save_unsaved_edits, help_unsaved_edits, clear_unsaved_edits, revert_unsaved_edits);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_toggle("include thumbnail graph in upper right corner", S_with_inset_graph,
+ rts_with_inset_graph = with_inset_graph(ss),
+ dpy_box, current_sep,
+ with_inset_graph_toggle);
+ remember_pref(prf, reflect_with_inset_graph, save_with_inset_graph, help_inset_graph,
+ clear_with_inset_graph, revert_with_inset_graph);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_toggle("resize main window as sounds open and close", S_auto_resize,
+ rts_auto_resize = auto_resize(ss),
+ dpy_box, current_sep,
+ resize_toggle);
+ remember_pref(prf, reflect_auto_resize, save_auto_resize, help_auto_resize, NULL, revert_auto_resize);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_toggle("pointer focus", S_with_pointer_focus,
+ rts_with_pointer_focus = with_pointer_focus(ss),
+ dpy_box, current_sep,
+ with_pointer_focus_toggle);
+ remember_pref(prf, reflect_with_pointer_focus, save_with_pointer_focus, help_pointer_focus,
+ clear_with_pointer_focus, revert_with_pointer_focus);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_sync_style = sync_style(ss);
+ prf = prefs_row_with_two_toggles("operate on all channels together", S_sync,
+ "within each sound", rts_sync_style == SYNC_BY_SOUND,
+ "across all sounds", rts_sync_style == SYNC_ALL,
+ dpy_box, current_sep,
+ sync1_choice, sync2_choice);
+ remember_pref(prf, reflect_sync_style, save_sync_style, help_sync_style, clear_sync_style, revert_sync_style);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_remember_sound_state = remember_sound_state(ss);
+ prf = prefs_row_with_toggle("restore a sound's state if reopened later", S_remember_sound_state,
+ rts_remember_sound_state,
+ dpy_box, current_sep,
+ toggle_remember_sound_state);
+ remember_pref(prf, reflect_remember_sound_state, save_remember_sound_state, help_remember_sound_state,
+ clear_remember_sound_state, revert_remember_sound_state);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_toggle("show the control panel upon opening a sound", S_show_controls,
+ rts_show_controls = in_show_controls(ss),
+ dpy_box, current_sep,
+ controls_toggle);
+ remember_pref(prf, reflect_show_controls, save_show_controls, help_show_controls, NULL, revert_show_controls);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ include_peak_env_directory = mus_strdup(peak_env_dir(ss));
+ rts_peak_env_directory = mus_strdup(include_peak_env_directory);
+ include_peak_envs = find_peak_envs();
+ rts_peak_envs = include_peak_envs;
+ prf = prefs_row_with_toggle_with_text("save peak envs to speed up initial display", S_peak_env_dir,
+ include_peak_envs,
+ "directory:", include_peak_env_directory, 25,
+ dpy_box, current_sep,
+ peak_envs_toggle, peak_envs_text);
+ remember_pref(prf, reflect_peak_envs, save_peak_envs, help_peak_envs, clear_peak_envs, revert_peak_envs);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ str = mus_format("%d", rts_max_regions = max_regions(ss));
+ prf = prefs_row_with_toggle_with_text("selection creates an associated region", S_selection_creates_region,
+ rts_selection_creates_region = selection_creates_region(ss),
+ "max regions:", str, 5,
+ dpy_box, current_sep,
+ selection_creates_region_toggle, max_regions_text);
+ remember_pref(prf, reflect_selection_creates_region, save_selection_creates_region, help_selection_creates_region, NULL, revert_selection_creates_region);
+ free(str);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_with_toolbar = with_toolbar(ss);
+ prf = prefs_row_with_toggle("include a toolbar", S_with_toolbar,
+ rts_with_toolbar,
+ dpy_box, current_sep,
+ toggle_with_toolbar);
+ remember_pref(prf, reflect_with_toolbar, save_with_toolbar, help_with_toolbar, clear_with_toolbar, revert_with_toolbar);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_with_tooltips = with_tooltips(ss);
+ prf = prefs_row_with_toggle("enable tooltips", S_with_tooltips,
+ rts_with_tooltips,
+ dpy_box, current_sep,
+ toggle_with_tooltips);
+ remember_pref(prf, reflect_with_tooltips, save_with_tooltips, help_with_tooltips, clear_with_tooltips, revert_with_tooltips);
+
+
+
+ /* ---------------- file options ---------------- */
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ file_label = make_inner_label(" file options", dpy_box, current_sep);
+
+ rts_load_path = find_sources();
+ prf = prefs_row_with_text("directory containing Snd's " Xen_language " files", "load path",
+ rts_load_path,
+ dpy_box, file_label,
+ load_path_text);
+ remember_pref(prf, reflect_load_path, NULL, help_load_path, clear_load_path, revert_load_path);
+ load_path_text_widget = prf->text;
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_toggle("display only sound files in various file lists", S_just_sounds,
+ rts_just_sounds = just_sounds(ss),
+ dpy_box, current_sep,
+ just_sounds_toggle);
+ remember_pref(prf, prefs_reflect_just_sounds, save_just_sounds, help_just_sounds, NULL, revert_just_sounds);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_temp_dir = mus_strdup(temp_dir(ss));
+ prf = prefs_row_with_text("directory for temporary files", S_temp_dir,
+ temp_dir(ss),
+ dpy_box, current_sep,
+ temp_dir_text);
+ remember_pref(prf, reflect_temp_dir, save_temp_dir, help_temp_dir, NULL, revert_temp_dir);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_save_dir = mus_strdup(save_dir(ss));
+ prf = prefs_row_with_text("directory for save-state files", S_save_dir,
+ save_dir(ss),
+ dpy_box, current_sep,
+ save_dir_text);
+ remember_pref(prf, reflect_save_dir, save_save_dir, help_save_dir, NULL, revert_save_dir);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_save_state_file = mus_strdup(save_state_file(ss));
+ prf = prefs_row_with_text("default save-state filename", S_save_state_file,
+ save_state_file(ss),
+ dpy_box, current_sep,
+ save_state_file_text);
+ remember_pref(prf, reflect_save_state_file, save_save_state_file, help_save_state_file, NULL, revert_save_state_file);
+
+#if HAVE_LADSPA
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_ladspa_dir = mus_strdup(ladspa_dir(ss));
+ prf = prefs_row_with_text("directory for ladspa plugins", S_ladspa_dir,
+ ladspa_dir(ss),
+ dpy_box, current_sep,
+ ladspa_dir_text);
+ remember_pref(prf, reflect_ladspa_dir, save_ladspa_dir, help_ladspa_dir, NULL, revert_ladspa_dir);
+#endif
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_vf_directory = mus_strdup(view_files_find_any_directory());
+ prf = prefs_row_with_text("directory for view-files dialog", S_add_directory_to_view_files_list,
+ rts_vf_directory,
+ dpy_box, current_sep,
+ view_files_directory_text);
+ remember_pref(prf, reflect_view_files_directory, save_view_files_directory, help_view_files_directory, NULL, revert_view_files_directory);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ rts_html_program = mus_strdup(html_program(ss));
+ prf = prefs_row_with_text("external program to read HTML files via snd-help", S_html_program,
+ html_program(ss),
+ dpy_box, current_sep,
+ html_program_text);
+ remember_pref(prf, reflect_html_program, save_html_program, help_html_program, NULL, revert_html_program);
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+
+ rts_default_output_chans = default_output_chans(ss);
+ prf = prefs_row_with_radio_box("default new sound attributes: chans", S_default_output_chans,
+ output_chan_choices, NUM_OUTPUT_CHAN_CHOICES, -1,
+ dpy_box, current_sep,
+ default_output_chans_choice);
+ remember_pref(prf, reflect_default_output_chans, save_default_output_chans, help_default_output_chans, NULL, revert_default_output_chans);
+ reflect_default_output_chans(prf);
+
+ rts_default_output_srate = default_output_srate(ss);
+ prf = prefs_row_with_radio_box("srate", S_default_output_srate,
+ output_srate_choices, NUM_OUTPUT_SRATE_CHOICES, -1,
+ dpy_box, prf->label,
+ default_output_srate_choice);
+ remember_pref(prf, reflect_default_output_srate, save_default_output_srate, help_default_output_srate, NULL, revert_default_output_srate);
+ reflect_default_output_srate(prf);
+
+ rts_default_output_header_type = default_output_header_type(ss);
+ prf = prefs_row_with_radio_box("header type", S_default_output_header_type,
+ output_header_type_choices, NUM_OUTPUT_HEADER_TYPE_CHOICES, -1,
+ dpy_box, prf->label,
+ default_output_header_type_choice);
+ output_header_type_prf = prf;
+ remember_pref(prf, reflect_default_output_header_type, save_default_output_header_type, help_default_output_header_type, NULL, revert_default_output_header_type);
+
+ rts_default_output_sample_type = default_output_sample_type(ss);
+ prf = prefs_row_with_radio_box("sample type", S_default_output_sample_type,
+ output_sample_type_choices, NUM_OUTPUT_SAMPLE_TYPE_CHOICES, -1,
+ dpy_box, prf->label,
+ default_output_sample_type_choice);
+ output_sample_type_prf = prf;
+ remember_pref(prf, reflect_default_output_sample_type, save_default_output_sample_type, help_default_output_sample_type, NULL, revert_default_output_sample_type);
+ reflect_default_output_header_type(output_header_type_prf);
+ reflect_default_output_sample_type(output_sample_type_prf);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ {
+ int i, srate = 0, chans = 0;
+ mus_sample_t sample_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &sample_type);
+ rts_raw_chans = chans;
+ rts_raw_srate = srate;
+ rts_raw_sample_type = sample_type;
+ str = mus_format("%d", chans);
+ str1 = mus_format("%d", srate);
+ raw_sample_type_choices = (char **)calloc(MUS_NUM_SAMPLES - 1, sizeof(char *));
+ for (i = 1; i < MUS_NUM_SAMPLES; i++)
+ raw_sample_type_choices[i - 1] = raw_sample_type_to_string((mus_sample_t)i); /* skip MUS_UNKNOWN_SAMPLE = 0 */
+ prf = prefs_row_with_text("default raw sound attributes: chans", S_mus_header_raw_defaults, str,
+ dpy_box, current_sep,
+ raw_chans_choice);
+ remember_pref(prf, reflect_raw_chans, save_raw_chans, help_raw_chans, NULL, revert_raw_chans);
+
+ prf = prefs_row_with_text("srate", S_mus_header_raw_defaults, str1,
+ dpy_box, prf->label,
+ raw_srate_choice);
+ remember_pref(prf, reflect_raw_srate, save_raw_srate, help_raw_srate, NULL, revert_raw_srate);
+
+ prf = prefs_row_with_list("sample type", S_mus_header_raw_defaults, raw_sample_type_choices[sample_type - 1],
+ (const char **)raw_sample_type_choices, MUS_NUM_SAMPLES - 1,
+ dpy_box, prf->label,
+ raw_sample_type_from_text,
+ NULL, NULL,
+ raw_sample_type_from_menu);
+ remember_pref(prf, reflect_raw_sample_type, save_raw_sample_type, help_raw_sample_type, NULL, revert_raw_sample_type);
+ free(str);
+ free(str1);
+ }
+
+
+ /* ---------------- additional keys ---------------- */
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ key_label = make_inner_label(" additional keys", dpy_box, current_sep);
+
+ {
+ key_info *ki;
+
+ ki = find_prefs_key("play-from-cursor");
+ prf = prefs_row_with_text_and_three_toggles("play all chans from cursor", S_play,
+ "key:", 8, "ctrl:", "meta:", "C-x:",
+ ki->key, ki->c, ki->m, ki->x,
+ dpy_box, key_label,
+ bind_play_from_cursor);
+ remember_pref(prf, reflect_play_from_cursor, save_pfc, help_play_from_cursor, clear_play_from_cursor, NULL);
+ free(ki);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ ki = find_prefs_key("show-all");
+ prf = prefs_row_with_text_and_three_toggles("show entire sound", S_x_bounds,
+ "key:", 8, "ctrl:", "meta:", "C-x:",
+ ki->key, ki->c, ki->m, ki->x,
+ dpy_box, current_sep,
+ bind_show_all);
+ remember_pref(prf, reflect_show_all, save_show_all, help_show_all, clear_show_all, NULL);
+ free(ki);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ ki = find_prefs_key("select-all");
+ prf = prefs_row_with_text_and_three_toggles("select entire sound", S_select_all,
+ "key:", 8, "ctrl:", "meta:", "C-x:",
+ ki->key, ki->c, ki->m, ki->x,
+ dpy_box, current_sep,
+ bind_select_all);
+ remember_pref(prf, reflect_select_all, save_select_all, help_select_all, clear_select_all, NULL);
+ free(ki);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ ki = find_prefs_key("show-selection");
+ prf = prefs_row_with_text_and_three_toggles("show current selection", "show-selection",
+ "key:", 8, "ctrl:", "meta:", "C-x:",
+ ki->key, ki->c, ki->m, ki->x,
+ dpy_box, current_sep,
+ bind_show_selection);
+ remember_pref(prf, reflect_show_selection, save_show_selection, help_show_selection, clear_show_selection, NULL);
+ free(ki);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ ki = find_prefs_key("revert-sound");
+ prf = prefs_row_with_text_and_three_toggles("undo all edits (revert)", S_revert_sound,
+ "key:", 8, "ctrl:", "meta:", "C-x:",
+ ki->key, ki->c, ki->m, ki->x,
+ dpy_box, current_sep,
+ bind_revert);
+ remember_pref(prf, reflect_revert, save_revert, help_revert, clear_revert_sound, NULL);
+ free(ki);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ ki = find_prefs_key("exit");
+ prf = prefs_row_with_text_and_three_toggles("exit from Snd", S_exit,
+ "key:", 8, "ctrl:", "meta:", "C-x:",
+ ki->key, ki->c, ki->m, ki->x,
+ dpy_box, current_sep,
+ bind_exit);
+ remember_pref(prf, reflect_exit, save_exit, help_exit, clear_exit, NULL);
+ free(ki);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ ki = find_prefs_key("goto-maxamp");
+ prf = prefs_row_with_text_and_three_toggles("move cursor to channel's maximum sample", S_maxamp_position,
+ "key:", 8, "ctrl:", "meta:", "C-x:",
+ ki->key, ki->c, ki->m, ki->x,
+ dpy_box, current_sep,
+ bind_goto_maxamp);
+ remember_pref(prf, reflect_goto_maxamp, save_goto_maxamp, help_goto_maxamp, clear_goto_maxamp, NULL);
+ free(ki);
+
+ }
+
+
+ /* ---------------- cursor options ---------------- */
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ cursor_label = make_inner_label(" cursor options", dpy_box, current_sep);
+
+ prf = prefs_row_with_toggle("report cursor location as it moves", S_with_verbose_cursor,
+ rts_with_verbose_cursor = with_verbose_cursor(ss),
+ dpy_box, cursor_label,
+ with_verbose_cursor_toggle);
+ remember_pref(prf, reflect_with_verbose_cursor, save_with_verbose_cursor, help_with_verbose_cursor, NULL, revert_with_verbose_cursor);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ {
+ char *str1;
+ str = mus_format("%.2f", rts_cursor_update_interval = cursor_update_interval(ss));
+ str1 = mus_format("%d", rts_cursor_location_offset = cursor_location_offset(ss));
+ prf = prefs_row_with_toggle_with_two_texts("track current location while playing", S_with_tracking_cursor,
+ (rts_with_tracking_cursor = with_tracking_cursor(ss)),
+ "update:", str,
+ "offset:", str1, 8,
+ dpy_box, current_sep,
+ with_tracking_cursor_toggle,
+ cursor_location_text);
+ remember_pref(prf, reflect_with_tracking_cursor, save_with_tracking_cursor, help_with_tracking_cursor, NULL, revert_with_tracking_cursor);
+ free(str);
+ free(str1);
+ }
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ str = mus_format("%d", rts_cursor_size = cursor_size(ss));
+ prf = prefs_row_with_number("size", S_cursor_size,
+ str, 4,
+ dpy_box, current_sep,
+ cursor_size_up, cursor_size_down, cursor_size_from_text);
+ remember_pref(prf, reflect_cursor_size, save_cursor_size, help_cursor_size, NULL, revert_cursor_size);
+ free(str);
+ if (cursor_size(ss) <= 0) XtSetSensitive(prf->arrow_down, false);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_radio_box("shape", S_cursor_style,
+ cursor_styles, NUM_CURSOR_STYLES,
+ rts_cursor_style = cursor_style(ss),
+ dpy_box, current_sep,
+ cursor_style_choice);
+ remember_pref(prf, reflect_cursor_style, save_cursor_style, help_cursor_style, NULL, revert_cursor_style);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ prf = prefs_row_with_radio_box("tracking cursor shape", S_tracking_cursor_style,
+ cursor_styles, NUM_CURSOR_STYLES,
+ rts_tracking_cursor_style = tracking_cursor_style(ss),
+ dpy_box, current_sep,
+ tracking_cursor_style_choice);
+ remember_pref(prf, reflect_tracking_cursor_style, save_tracking_cursor_style, help_tracking_cursor_style, NULL, revert_tracking_cursor_style);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->label);
+ saved_cursor_color = ss->cursor_color;
+ prf = prefs_color_selector_row("color", S_cursor_color, ss->cursor_color,
+ dpy_box, current_sep,
+ cursor_color_func);
+ remember_pref(prf, NULL, save_cursor_color, help_cursor_color, clear_cursor_color, revert_cursor_color);
+
+
+ /* ---------------- (overall) colors ---------------- */
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->rscl);
+ cursor_label = make_inner_label(" colors", dpy_box, current_sep);
+
+ saved_basic_color = ss->basic_color;
+ prf = prefs_color_selector_row("main background color", S_basic_color, ss->basic_color,
+ dpy_box, cursor_label,
+ basic_color_func);
+ remember_pref(prf, NULL, save_basic_color, help_basic_color, clear_basic_color, revert_basic_color);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->rscl);
+ saved_highlight_color = ss->highlight_color;
+ prf = prefs_color_selector_row("main highlight color", S_highlight_color, ss->highlight_color,
+ dpy_box, current_sep,
+ highlight_color_func);
+ remember_pref(prf, NULL, save_highlight_color, help_highlight_color, clear_highlight_color, revert_highlight_color);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->rscl);
+ saved_position_color = ss->position_color;
+ prf = prefs_color_selector_row("second highlight color", S_position_color, ss->position_color,
+ dpy_box, current_sep,
+ position_color_func);
+ remember_pref(prf, NULL, save_position_color, help_position_color, clear_position_color, revert_position_color);
+
+ current_sep = make_inter_variable_separator(dpy_box, prf->rscl);
+ saved_zoom_color = ss->zoom_color;
+ prf = prefs_color_selector_row("third highlight color", S_zoom_color, ss->zoom_color,
+ dpy_box, current_sep,
+ zoom_color_func);
+ remember_pref(prf, NULL, save_zoom_color, help_zoom_color, clear_zoom_color, revert_zoom_color);
+ }
+
+ current_sep = make_inter_topic_separator(topics);
+
+ /* -------- graphs -------- */
+ {
+ Widget grf_box, grf_label, colgrf_label;
+
+ /* ---------------- graph options ---------------- */
+
+ grf_box = make_top_level_box(topics);
+ grf_label = make_top_level_label("graph options", grf_box);
+
+ prf = prefs_row_with_radio_box("how to connect the dots", S_graph_style,
+ graph_styles, NUM_GRAPH_STYLES,
+ rts_graph_style = graph_style(ss),
+ grf_box, grf_label,
+ graph_style_choice);
+ remember_pref(prf, reflect_graph_style, save_graph_style, help_graph_style, NULL, revert_graph_style);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ str = mus_format("%d", rts_dot_size = dot_size(ss));
+ prf = prefs_row_with_number("dot size", S_dot_size,
+ str, 4,
+ grf_box, current_sep,
+ dot_size_up, dot_size_down, dot_size_from_text);
+ remember_pref(prf, reflect_dot_size, save_dot_size, help_dot_size, NULL, revert_dot_size);
+ free(str);
+ if (dot_size(ss) <= 0) XtSetSensitive(prf->arrow_down, false);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ rts_initial_beg = initial_beg(ss);
+ rts_initial_dur = initial_dur(ss);
+ str = mus_format("%.2f : %.2f", rts_initial_beg, rts_initial_dur);
+ prf = prefs_row_with_text_with_toggle("initial graph x bounds", S_initial_graph_hook,
+ (rts_full_duration = show_full_duration(ss)),
+ "show full duration", str, 16,
+ grf_box, current_sep,
+ initial_bounds_toggle,
+ initial_bounds_text);
+ free(str);
+ remember_pref(prf, reflect_initial_bounds, save_initial_bounds, help_initial_bounds, clear_initial_bounds, revert_initial_bounds);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ prf = prefs_row_with_radio_box("how to layout multichannel graphs", S_channel_style,
+ channel_styles, NUM_CHANNEL_STYLES,
+ rts_channel_style = channel_style(ss),
+ grf_box, current_sep,
+ channel_style_choice);
+ remember_pref(prf, reflect_channel_style, save_channel_style, help_channel_style, NULL, revert_channel_style);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ prf = prefs_row_with_toggle("layout wave and fft graphs horizontally", S_graphs_horizontal,
+ rts_graphs_horizontal = graphs_horizontal(ss),
+ grf_box, current_sep,
+ graphs_horizontal_toggle);
+ remember_pref(prf, reflect_graphs_horizontal, save_graphs_horizontal, help_graphs_horizontal, NULL, revert_graphs_horizontal);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ prf = prefs_row_with_toggle("include y=0 line in sound graphs", S_show_y_zero,
+ rts_show_y_zero = show_y_zero(ss),
+ grf_box, current_sep,
+ y_zero_toggle);
+ remember_pref(prf, reflect_show_y_zero, save_show_y_zero, help_show_y_zero, NULL, revert_show_y_zero);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ rts_show_grid = show_grid(ss);
+ prf = prefs_row_with_toggle("include a grid in sound graphs", S_show_grid,
+ rts_show_grid == WITH_GRID,
+ grf_box, current_sep,
+ grid_toggle);
+ remember_pref(prf, reflect_show_grid, save_show_grid, help_show_grid, NULL, revert_show_grid);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ prf = prefs_row_with_scale("grid density", S_grid_density,
+ 2.0, rts_grid_density = grid_density(ss),
+ grf_box, current_sep,
+ grid_density_scale_callback, grid_density_text_callback);
+ remember_pref(prf, reflect_grid_density, save_grid_density, help_grid_density, NULL, revert_grid_density);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ rts_show_axes = show_axes(ss);
+ prf = prefs_row_with_list("what axes to display", S_show_axes, show_axes_choices[(int)rts_show_axes],
+ show_axes_choices, NUM_SHOW_AXES,
+ grf_box, current_sep,
+ show_axes_from_text,
+ NULL, NULL,
+ show_axes_from_menu);
+ remember_pref(prf, reflect_show_axes, save_show_axes, help_show_axes, clear_show_axes, revert_show_axes);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ rts_x_axis_style = x_axis_style(ss);
+ prf = prefs_row_with_list("time division", S_x_axis_style, x_axis_styles[(int)rts_x_axis_style],
+ x_axis_styles, NUM_X_AXIS_STYLES,
+ grf_box, current_sep,
+ x_axis_style_from_text,
+ NULL, NULL,
+ x_axis_style_from_menu);
+ remember_pref(prf, reflect_x_axis_style, save_x_axis_style, help_x_axis_style, clear_x_axis_style, revert_x_axis_style);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ prf = prefs_row_with_toggle("include smpte info", "show-smpte-label",
+ rts_with_smpte_label = with_smpte_label(ss),
+ grf_box, current_sep,
+ smpte_toggle);
+ remember_pref(prf, reflect_smpte, save_smpte, help_smpte, clear_smpte, revert_smpte);
+
+
+ /* ---------------- (graph) colors ---------------- */
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ colgrf_label = make_inner_label(" colors", grf_box, current_sep);
+
+ saved_data_color = ss->data_color;
+ prf = prefs_color_selector_row("unselected data (waveform) color", S_data_color, ss->data_color,
+ grf_box, colgrf_label,
+ data_color_func);
+ remember_pref(prf, NULL, save_data_color, help_data_color, clear_data_color, revert_data_color);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->rscl);
+ saved_graph_color = ss->graph_color;
+ prf = prefs_color_selector_row("unselected graph (background) color", S_graph_color, ss->graph_color,
+ grf_box, current_sep,
+ graph_color_func);
+ remember_pref(prf, NULL, save_graph_color, help_graph_color, clear_graph_color, revert_graph_color);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->rscl);
+ saved_selected_data_color = ss->selected_data_color;
+ prf = prefs_color_selector_row("selected channel data (waveform) color", S_selected_data_color, ss->selected_data_color,
+ grf_box, current_sep,
+ selected_data_color_func);
+ remember_pref(prf, NULL, save_selected_data_color, help_selected_data_color, clear_selected_data_color, revert_selected_data_color);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->rscl);
+ saved_selected_graph_color = ss->selected_graph_color;
+ prf = prefs_color_selector_row("selected channel graph (background) color", S_selected_graph_color, ss->selected_graph_color,
+ grf_box, current_sep,
+ selected_graph_color_func);
+ remember_pref(prf, NULL, save_selected_graph_color, help_selected_graph_color, clear_selected_graph_color, revert_selected_graph_color);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->rscl);
+ saved_selection_color = ss->selection_color;
+ prf = prefs_color_selector_row("selection color", S_selection_color, ss->selection_color,
+ grf_box, current_sep,
+ selection_color_func);
+ remember_pref(prf, NULL, save_selection_color, help_selection_color, clear_selection_color, revert_selection_color);
+
+ /* ---------------- (graph) fonts ---------------- */
+
+ current_sep = make_inter_variable_separator(grf_box, prf->rscl);
+ colgrf_label = make_inner_label(" fonts", grf_box, current_sep);
+
+ rts_axis_label_font = mus_strdup(axis_label_font(ss));
+ prf = prefs_row_with_text("axis label font", S_axis_label_font,
+ axis_label_font(ss),
+ grf_box, colgrf_label,
+ axis_label_font_text);
+ remember_pref(prf, reflect_axis_label_font, save_axis_label_font, help_axis_label_font, clear_axis_label_font, revert_axis_label_font);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ rts_axis_numbers_font = mus_strdup(axis_numbers_font(ss));
+ prf = prefs_row_with_text("axis number font", S_axis_numbers_font,
+ axis_numbers_font(ss),
+ grf_box, current_sep,
+ axis_numbers_font_text);
+ remember_pref(prf, reflect_axis_numbers_font, save_axis_numbers_font, help_axis_numbers_font, clear_axis_numbers_font, revert_axis_numbers_font);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ rts_peaks_font = mus_strdup(peaks_font(ss));
+ prf = prefs_row_with_text("fft peaks font", S_peaks_font,
+ peaks_font(ss),
+ grf_box, current_sep,
+ peaks_font_text);
+ remember_pref(prf, reflect_peaks_font, save_peaks_font, help_peaks_font, clear_peaks_font, revert_peaks_font);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ rts_bold_peaks_font = mus_strdup(bold_peaks_font(ss));
+ prf = prefs_row_with_text("fft peaks bold font (for main peaks)", S_bold_peaks_font,
+ bold_peaks_font(ss),
+ grf_box, current_sep,
+ bold_peaks_font_text);
+ remember_pref(prf, reflect_bold_peaks_font, save_bold_peaks_font, help_bold_peaks_font, clear_bold_peaks_font, revert_bold_peaks_font);
+
+ current_sep = make_inter_variable_separator(grf_box, prf->label);
+ rts_tiny_font = mus_strdup(tiny_font(ss));
+ prf = prefs_row_with_text("tiny font (for various annotations)", S_peaks_font,
+ tiny_font(ss),
+ grf_box, current_sep,
+ tiny_font_text);
+ remember_pref(prf, reflect_tiny_font, save_tiny_font, help_tiny_font, clear_tiny_font, revert_tiny_font);
+ }
+
+ current_sep = make_inter_topic_separator(topics);
+
+ /* -------- transform -------- */
+ {
+ Widget fft_box, fft_label;
+
+ /* ---------------- transform options ---------------- */
+
+ fft_box = make_top_level_box(topics);
+ fft_label = make_top_level_label("transform options", fft_box);
+
+ rts_fft_size = transform_size(ss);
+ str = mus_format("%lld", rts_fft_size);
+ prf = prefs_row_with_number("size", S_transform_size,
+ str, 12,
+ fft_box, fft_label,
+ fft_size_up, fft_size_down, fft_size_from_text);
+ remember_pref(prf, reflect_fft_size, save_fft_size, help_fft_size, NULL, revert_fft_size);
+ free(str);
+ if (transform_size(ss) <= 2) XtSetSensitive(prf->arrow_down, false);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ prf = prefs_row_with_radio_box("transform graph choice", S_transform_graph_type,
+ transform_graph_types, NUM_TRANSFORM_GRAPH_TYPES,
+ rts_transform_graph_type = transform_graph_type(ss),
+ fft_box, current_sep,
+ transform_graph_type_choice);
+ remember_pref(prf, reflect_transform_graph_type, save_transform_graph_type, help_transform_graph_type, NULL, revert_transform_graph_type);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ rts_transform_type = transform_type(ss);
+ prf = prefs_row_with_list("transform", S_transform_type, transform_types[rts_transform_type],
+ transform_types, NUM_BUILTIN_TRANSFORM_TYPES,
+ fft_box, current_sep,
+ transform_type_from_text,
+ transform_type_completer, NULL,
+ transform_type_from_menu);
+ remember_pref(prf, reflect_transform_type, save_transform_type, help_transform_type, clear_transform_type, revert_transform_type);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ rts_fft_window = fft_window(ss);
+ prf = prefs_row_with_list("data window", S_fft_window, mus_fft_window_name(rts_fft_window),
+ mus_fft_window_names(), MUS_NUM_FFT_WINDOWS,
+ fft_box, current_sep,
+ fft_window_from_text,
+ fft_window_completer, NULL,
+ fft_window_from_menu);
+ remember_pref(prf, reflect_fft_window, save_fft_window, help_fft_window, clear_fft_window, revert_fft_window);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ prf = prefs_row_with_scale("data window family parameter", S_fft_window_beta,
+ 1.0, rts_fft_window_beta = fft_window_beta(ss),
+ fft_box, current_sep,
+ fft_window_beta_scale_callback, fft_window_beta_text_callback);
+ remember_pref(prf, reflect_fft_window_beta, save_fft_window_beta, help_fft_window_beta, NULL, revert_fft_window_beta);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ str = mus_format("%d", rts_max_transform_peaks = max_transform_peaks(ss));
+ prf = prefs_row_with_toggle_with_text("show fft peak data", S_show_transform_peaks,
+ rts_show_transform_peaks = show_transform_peaks(ss),
+ "max peaks:", str, 5,
+ fft_box, current_sep,
+ transform_peaks_toggle, max_peaks_text);
+ remember_pref(prf, reflect_transform_peaks, save_transform_peaks, help_transform_peaks, NULL, revert_transform_peaks);
+ free(str);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ {
+ const char **cmaps;
+ int i, len;
+ len = num_colormaps();
+ cmaps = (const char **)calloc(len, sizeof(const char *));
+ for (i = 0; i < len; i++)
+ cmaps[i] = (const char *)colormap_name(i);
+ rts_colormap = color_map(ss);
+ prf = prefs_row_with_list("sonogram colormap", S_colormap, cmaps[rts_colormap],
+ cmaps, len,
+ fft_box, current_sep,
+ colormap_from_text,
+ colormap_completer, NULL,
+ colormap_from_menu);
+ remember_pref(prf, reflect_colormap, save_colormap, help_colormap, clear_colormap, revert_colormap);
+ free(cmaps);
+ }
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ prf = prefs_row_with_toggle("y axis as log magnitude (dB)", S_fft_log_magnitude,
+ rts_fft_log_magnitude = fft_log_magnitude(ss),
+ fft_box, current_sep,
+ log_magnitude_toggle);
+ remember_pref(prf, reflect_fft_log_magnitude, save_fft_log_magnitude, help_fft_log_magnitude, NULL, revert_fft_log_magnitude);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ str = mus_format("%.1f", rts_min_dB = min_dB(ss));
+ prf = prefs_row_with_text("minimum y-axis dB value", S_min_dB, str,
+ fft_box, current_sep,
+ min_dB_text);
+ remember_pref(prf, reflect_min_dB, save_min_dB, help_min_dB, NULL, revert_min_dB);
+ free(str);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ prf = prefs_row_with_toggle("x axis as log freq", S_fft_log_frequency,
+ rts_fft_log_frequency = fft_log_frequency(ss),
+ fft_box, current_sep,
+ log_frequency_toggle);
+ remember_pref(prf, reflect_fft_log_frequency, save_fft_log_frequency, help_fft_log_frequency, NULL, revert_fft_log_frequency);
+
+ current_sep = make_inter_variable_separator(fft_box, prf->label);
+ prf = prefs_row_with_radio_box("normalization", S_transform_normalization,
+ transform_normalizations, NUM_TRANSFORM_NORMALIZATIONS,
+ rts_transform_normalization = transform_normalization(ss),
+ fft_box, current_sep,
+ transform_normalization_choice);
+ remember_pref(prf, reflect_transform_normalization, save_transform_normalization, help_transform_normalization, NULL, revert_transform_normalization);
+ }
+
+ current_sep = make_inter_topic_separator(topics);
+
+ /* -------- marks, mixes, and regions -------- */
+ {
+ Widget mmr_box, mmr_label;
+ char *str1, *str2;
+
+ /* ---------------- marks and mixes ---------------- */
+
+ mmr_box = make_top_level_box(topics);
+ mmr_label = make_top_level_label("marks and mixes", mmr_box);
+
+ saved_mark_color = ss->mark_color;
+ prf = prefs_color_selector_row("mark and mix tag color", S_mark_color, ss->mark_color,
+ mmr_box, mmr_label,
+ mark_color_func);
+ remember_pref(prf, NULL, save_mark_color, help_mark_color, clear_mark_color, revert_mark_color);
+
+ current_sep = make_inter_variable_separator(mmr_box, prf->rscl);
+
+ str1 = mus_format("%d", rts_mark_tag_width = mark_tag_width(ss));
+ str2 = mus_format("%d", rts_mark_tag_height = mark_tag_height(ss));
+ prf = prefs_row_with_two_texts("mark tag size", S_mark_tag_width,
+ "width:", str1, "height:", str2, 4,
+ mmr_box, current_sep,
+ mark_tag_size_text);
+ remember_pref(prf, reflect_mark_tag_size, save_mark_tag_size, help_mark_tag_size, NULL, revert_mark_tag_size);
+ free(str2);
+ free(str1);
+
+ current_sep = make_inter_variable_separator(mmr_box, prf->label);
+ str1 = mus_format("%d", rts_mix_tag_width = mix_tag_width(ss));
+ str2 = mus_format("%d", rts_mix_tag_height = mix_tag_height(ss));
+ prf = prefs_row_with_two_texts("mix tag size", S_mix_tag_width,
+ "width:", str1, "height:", str2, 4,
+ mmr_box, current_sep,
+ mix_tag_size_text);
+ remember_pref(prf, reflect_mix_tag_size, save_mix_tag_size, help_mix_tag_size, NULL, revert_mix_tag_size);
+ free(str2);
+ free(str1);
+
+ current_sep = make_inter_variable_separator(mmr_box, prf->label);
+ saved_mix_color = ss->mix_color;
+ prf = prefs_color_selector_row("mix waveform color", S_mix_color, ss->mix_color,
+ mmr_box, current_sep,
+ mix_color_func);
+ remember_pref(prf, NULL, save_mix_color, help_mix_color, clear_mix_color, revert_mix_color);
+
+ current_sep = make_inter_variable_separator(mmr_box, prf->rscl);
+ str = mus_format("%d", rts_mix_waveform_height = mix_waveform_height(ss));
+ prf = prefs_row_with_toggle_with_text("show mix waveforms (attached to the mix tag)", S_show_mix_waveforms,
+ rts_show_mix_waveforms = show_mix_waveforms(ss),
+ "max waveform height:", str, 5,
+ mmr_box, current_sep,
+ show_mix_waveforms_toggle, mix_waveform_height_text);
+ remember_pref(prf, reflect_mix_waveforms, save_mix_waveforms, help_mix_waveforms, NULL, revert_mix_waveforms);
+ free(str);
+ }
+
+ current_sep = make_inter_topic_separator(topics);
+
+ /* -------- clm -------- */
+ {
+ Widget clm_box, clm_label;
+
+ /* ---------------- clm options ---------------- */
+
+ clm_box = make_top_level_box(topics);
+ clm_label = make_top_level_label("clm", clm_box);
+
+ rts_speed_control_style = speed_control_style(ss);
+ str = mus_format("%d", rts_speed_control_tones = speed_control_tones(ss));
+ prf = prefs_row_with_radio_box_and_number("speed control choice", S_speed_control_style,
+ speed_control_styles, NUM_SPEED_CONTROL_STYLES, (int)speed_control_style(ss),
+ str, 6,
+ clm_box, clm_label,
+ speed_control_choice, speed_control_up, speed_control_down, speed_control_text);
+ XtSetSensitive(prf->arrow_down, (speed_control_tones(ss) > MIN_SPEED_CONTROL_SEMITONES));
+ remember_pref(prf, reflect_speed_control, save_speed_control, help_speed_control, NULL, revert_speed_control);
+ free(str);
+
+ current_sep = make_inter_variable_separator(clm_box, prf->label);
+ str = mus_format("%d", rts_sinc_width = sinc_width(ss));
+ prf = prefs_row_with_text("sinc interpolation width in srate converter", S_sinc_width, str,
+ clm_box, current_sep,
+ sinc_width_text);
+ remember_pref(prf, reflect_sinc_width, save_sinc_width, help_sinc_width, NULL, revert_sinc_width);
+ free(str);
+ }
+
+ current_sep = make_inter_topic_separator(topics);
+
+ /* -------- programming -------- */
+ {
+ Widget prg_box, prg_label;
+
+ /* ---------------- listener options ---------------- */
+
+ prg_box = make_top_level_box(topics);
+ prg_label = make_top_level_label("listener options", prg_box);
+
+ prf = prefs_row_with_toggle("show listener at start up", S_show_listener,
+ rts_show_listener = listener_is_visible(),
+ prg_box, prg_label,
+ show_listener_toggle);
+ remember_pref(prf, reflect_show_listener, save_show_listener, help_show_listener, clear_show_listener, revert_show_listener);
+
+ current_sep = make_inter_variable_separator(prg_box, prf->label);
+ rts_listener_prompt = mus_strdup(listener_prompt(ss));
+ prf = prefs_row_with_text("prompt", S_listener_prompt,
+ listener_prompt(ss),
+ prg_box, current_sep,
+ listener_prompt_text);
+ remember_pref(prf, reflect_listener_prompt, save_listener_prompt, help_listener_prompt, NULL, revert_listener_prompt);
+
+ current_sep = make_inter_variable_separator(prg_box, prf->label);
+ str = mus_format("%d", rts_print_length = print_length(ss));
+ prf = prefs_row_with_text("number of vector elements to display", S_print_length, str,
+ prg_box, current_sep,
+ print_length_text);
+ remember_pref(prf, reflect_print_length, save_print_length, help_print_length, NULL, revert_print_length);
+ free(str);
+
+ current_sep = make_inter_variable_separator(prg_box, prf->label);
+ rts_listener_font = mus_strdup(listener_font(ss));
+ prf = prefs_row_with_text("font", S_listener_font,
+ listener_font(ss),
+ prg_box, current_sep,
+ listener_font_text);
+ remember_pref(prf, reflect_listener_font, save_listener_font, help_listener_font, clear_listener_font, revert_listener_font);
+
+ current_sep = make_inter_variable_separator(prg_box, prf->label);
+ saved_listener_color = ss->listener_color;
+ prf = prefs_color_selector_row("background color", S_listener_color, ss->listener_color,
+ prg_box, current_sep,
+ listener_color_func);
+ remember_pref(prf, NULL, save_listener_color, help_listener_color, clear_listener_color, revert_listener_color);
+
+ current_sep = make_inter_variable_separator(prg_box, prf->rscl);
+ saved_listener_text_color = ss->listener_text_color;
+ prf = prefs_color_selector_row("text color", S_listener_text_color, ss->listener_text_color,
+ prg_box, current_sep,
+ listener_text_color_func);
+ remember_pref(prf, NULL, save_listener_text_color, help_listener_text_color, clear_listener_text_color, revert_listener_text_color);
+ }
+
+ current_sep = make_inter_topic_separator(topics);
+
+ /* -------- audio -------- */
+ {
+ Widget aud_box, aud_label;
+
+ /* ---------------- audio options ---------------- */
+
+ aud_box = make_top_level_box(topics);
+ aud_label = make_top_level_label("audio options", aud_box);
+
+ str = mus_format("%d", rts_dac_size = dac_size(ss));
+ prf = prefs_row_with_text("dac buffer size", S_dac_size,
+ str,
+ aud_box, aud_label,
+ dac_size_text);
+ remember_pref(prf, reflect_dac_size, save_dac_size, help_dac_size, NULL, revert_dac_size);
+ free(str);
+
+ current_sep = make_inter_variable_separator(aud_box, prf->label);
+ prf = prefs_row_with_toggle("fold in otherwise unplayable channels", S_dac_combines_channels,
+ rts_dac_combines_channels = dac_combines_channels(ss),
+ aud_box, current_sep,
+ dac_combines_channels_toggle);
+ remember_pref(prf, reflect_dac_combines_channels, save_dac_combines_channels, help_dac_combines_channels, NULL, revert_dac_combines_channels);
+ }
+
+ {
+ Atom wm_delete_window;
+ wm_delete_window = XmInternAtom(MAIN_DISPLAY(ss), (char *)"WM_DELETE_WINDOW", false);
+ XmAddWMProtocolCallback(XtParent(preferences_dialog), wm_delete_window, wm_delete_callback, NULL);
+ }
+
+ XtManageChild(preferences_dialog);
+ set_dialog_widget(PREFERENCES_DIALOG, preferences_dialog);
+
+ return(preferences_dialog);
+}
+
+
+#include "snd-menu.h"
+#include <X11/cursorfont.h>
+
+/* X side of file print */
+
+static Widget print_dialog = NULL;
+static Widget print_name = NULL;
+static Widget print_eps_or_lpr = NULL;
+static char print_string[PRINT_BUFFER_SIZE];
+static Widget error_info_box, error_info_frame, error_info;
+
+static void print_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ print_dialog_help();
+}
+
+
+static void clear_print_error(void);
+
+static void print_cancel_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (XmGetFocusWidget(print_dialog) == XmMessageBoxGetChild(print_dialog, XmDIALOG_CANCEL_BUTTON))
+ {
+ ss->print_choice = PRINT_SND;
+ clear_print_error();
+ XtUnmanageChild(print_dialog);
+ }
+ /* else it's the <cr> from the text widget probably */
+}
+
+
+static int lpr(char *name)
+{
+ /* make some desultory effort to print the file */
+ snprintf(print_string, PRINT_BUFFER_SIZE, "lpr %s", name);
+ return(system(print_string));
+}
+
+
+static void watch_print(Widget w, XtPointer context, XtPointer info)
+{
+ clear_print_error();
+}
+
+
+static Widget rc;
+static bool print_watching = false, print_error = false;
+
+static void clear_print_error(void)
+{
+ XtUnmanageChild(rc);
+ XtUnmanageChild(error_info_box);
+ XtVaSetValues(print_eps_or_lpr, XmNbottomAttachment, XmATTACH_FORM, NULL);
+ XtManageChild(rc);
+ print_error = false;
+ if (print_watching)
+ {
+ print_watching = false;
+ XtRemoveCallback(print_name, XmNvalueChangedCallback, watch_print, NULL);
+ XtRemoveCallback(print_eps_or_lpr, XmNvalueChangedCallback, watch_print, NULL);
+ }
+}
+
+
+static void report_in_error_info(const char *msg, void *ignore)
+{
+ XmString s1;
+ if ((!msg) || (!(*msg))) return;
+ print_error = true;
+ s1 = XmStringCreateLocalized((char *)msg);
+ XtVaSetValues(error_info, XmNlabelString, s1, NULL);
+ if (!(XtIsManaged(error_info_box)))
+ {
+ Dimension text_wid = 0, dialog_wid = 0;
+ XmFontList fonts;
+
+ XtVaGetValues(error_info, XmNfontList, &fonts, NULL);
+ XtVaGetValues(print_dialog, XmNwidth, &dialog_wid, NULL);
+ text_wid = XmStringWidth(fonts, s1);
+ XtUnmanageChild(rc);
+
+ XtVaSetValues(print_eps_or_lpr, XmNbottomAttachment, XmATTACH_NONE, NULL);
+ if (text_wid > dialog_wid)
+ {
+ XtUnmanageChild(print_dialog);
+ XtVaSetValues(print_dialog, XmNwidth, text_wid + 40, NULL);
+ XtManageChild(print_dialog);
+ }
+ XtManageChild(error_info_box);
+ XtManageChild(rc);
+ print_watching = true;
+ XtAddCallback(print_name, XmNvalueChangedCallback, watch_print, NULL);
+ XtAddCallback(print_eps_or_lpr, XmNvalueChangedCallback, watch_print, NULL);
+ }
+ XmStringFree(s1);
+}
+
+
+static printing_t printing = NOT_PRINTING;
+
+static void print_ok_callback(Widget w, XtPointer context, XtPointer info)
+{
+ bool quit = false;
+ XmString plab, slab;
+ snd_info *nsp = NULL;
+
+ if (printing)
+ ss->stopped_explicitly = true;
+ else
+ {
+ bool print_it;
+
+ clear_print_error();
+ if (ss->print_choice == PRINT_SND)
+ {
+ plab = XmStringCreateLocalized((char *)I_STOP);
+ nsp = any_selected_sound();
+ snprintf(print_string, PRINT_BUFFER_SIZE, "printing %s", nsp->short_filename);
+ slab = XmStringCreateLocalized(print_string);
+ XtVaSetValues(print_dialog,
+ XmNokLabelString, plab,
+ XmNmessageString, slab,
+ NULL);
+ XmStringFree(plab);
+ XmStringFree(slab);
+ }
+
+ printing = PRINTING;
+ print_it = (bool)XmToggleButtonGetState(print_eps_or_lpr);
+ quit = (ss->print_choice == PRINT_ENV);
+
+ if (print_it)
+ {
+ char *name;
+ name = snd_tempnam();
+
+ redirect_snd_error_to(report_in_error_info, NULL);
+ switch (ss->print_choice)
+ {
+ case PRINT_SND:
+ snd_print(name);
+ break;
+
+ case PRINT_ENV:
+ enved_print(name);
+ break;
+ }
+ redirect_snd_error_to(NULL, NULL);
+ if (!print_error)
+ {
+ int err;
+ err = lpr(name); /* lpr apparently insists on printing to stderr? */
+ if (err != 0)
+ report_in_error_info("can't print!", NULL);
+ snd_remove(name, IGNORE_CACHE);
+ }
+ free(name);
+ }
+ else
+ {
+ char *str = NULL;
+ redirect_snd_error_to(report_in_error_info, NULL);
+ str = XmTextGetString(print_name);
+ switch (ss->print_choice)
+ {
+ case PRINT_SND:
+ if (snd_print(str))
+ status_report(nsp, "printed current view to %s", str);
+ break;
+
+ case PRINT_ENV:
+ enved_print(str);
+ break;
+ }
+ redirect_snd_error_to(NULL, NULL);
+ if (str) XtFree(str);
+ }
+ }
+
+ printing = NOT_PRINTING;
+ if (ss->print_choice == PRINT_SND)
+ {
+ plab = XmStringCreateLocalized((char *)"Print");
+ snprintf(print_string, PRINT_BUFFER_SIZE, "print %s", nsp->short_filename);
+ slab = XmStringCreateLocalized(print_string);
+ XtVaSetValues(print_dialog,
+ XmNokLabelString, plab,
+ XmNmessageString, slab,
+ NULL);
+ XmStringFree(plab);
+ XmStringFree(slab);
+ }
+ ss->print_choice = PRINT_SND;
+ if (quit)
+ XtUnmanageChild(print_dialog);
+}
+
+
+static void start_print_dialog(XmString xmstr4, bool managed)
+{
+ if (!print_dialog)
+ {
+ Widget dl;
+ XmString xmstr1, xmstr2, xmstr3, titlestr;
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ xmstr1 = XmStringCreateLocalized((char *)"Print"); /* "ok" here is confusing -- might mean, ok I'm done */
+ xmstr2 = XmStringCreateLocalized((char *)I_HELP);
+ xmstr3 = XmStringCreateLocalized((char *)I_GO_AWAY);
+ titlestr = XmStringCreateLocalized((char *)"Print");
+
+ XtSetArg(args[n], XmNmessageString, xmstr4); n++;
+ XtSetArg(args[n], XmNokLabelString, xmstr1); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xmstr2); n++;
+ XtSetArg(args[n], XmNcancelLabelString, xmstr3); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++; /* this gives us the resize handles */
+ print_dialog = XmCreateMessageDialog(MAIN_PANE(ss), (char *)"eps file:", args, n);
+
+ XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->basic_color, NULL);
+
+ XmStringFree(xmstr1);
+ XmStringFree(xmstr2);
+ XmStringFree(xmstr3);
+ XmStringFree(titlestr);
+
+ XtUnmanageChild(XmMessageBoxGetChild(print_dialog, XmDIALOG_SYMBOL_LABEL));
+
+ XtAddCallback(print_dialog, XmNhelpCallback, print_help_callback, NULL);
+ XtAddCallback(print_dialog, XmNcancelCallback, print_cancel_callback, NULL);
+ XtAddCallback(print_dialog, XmNokCallback, print_ok_callback, NULL);
+
+ n = 0;
+ rc = XtCreateManagedWidget("form", xmFormWidgetClass, print_dialog, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ dl = XtCreateManagedWidget("eps file:", xmLabelWidgetClass, rc, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, dl); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNvalue, eps_file(ss)); n++;
+ print_name = make_textfield_widget("text", rc, args, n, ACTIVATABLE, NO_COMPLETER);
+
+ n = 0;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, print_name); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ print_eps_or_lpr = make_togglebutton_widget("direct to printer", rc, args, n);
+
+ /* error display */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, print_eps_or_lpr); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNmargin, 0); n++;
+ error_info_box = XtCreateWidget("error-box", xmRowColumnWidgetClass, rc, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNmarginHeight, 4); n++;
+ error_info_frame = XtCreateManagedWidget("error-frame", xmFrameWidgetClass, error_info_box, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ error_info = XtCreateManagedWidget("error-info", xmLabelWidgetClass, error_info_frame, args, n);
+
+ XtVaSetValues(print_eps_or_lpr, XmNbottomAttachment, XmATTACH_FORM, NULL);
+
+ if (managed) XtManageChild(print_dialog);
+
+ map_over_children(print_dialog, set_main_color_of_widget);
+ XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(print_eps_or_lpr, XmNselectColor, ss->selection_color, NULL);
+
+ set_dialog_widget(PRINT_DIALOG, print_dialog);
+ }
+ else
+ {
+ XtVaSetValues(print_dialog, XmNmessageString, xmstr4, NULL);
+ if (managed)
+ {
+ if (!XtIsManaged(print_dialog))
+ XtManageChild(print_dialog);
+ raise_dialog(print_dialog); /* a no-op unless already managed */
+ }
+ }
+}
+
+
+widget_t make_file_print_dialog(bool managed, bool direct_to_printer)
+{
+ XmString xmstr4;
+ xmstr4 = XmStringCreateLocalized((char *)"print");
+ start_print_dialog(xmstr4, managed);
+ XmStringFree(xmstr4);
+ XmToggleButtonSetState(print_eps_or_lpr, direct_to_printer, false);
+ return(print_dialog);
+}
+
+
+static void file_print_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmString xmstr4;
+ if (ss->print_choice == PRINT_SND)
+ {
+ snd_info *nsp;
+ nsp = any_selected_sound();
+ if (!nsp) return;
+ snprintf(print_string, PRINT_BUFFER_SIZE, "print %s", nsp->short_filename);
+ xmstr4 = XmStringCreateLocalized(print_string);
+ }
+ else xmstr4 = XmStringCreateLocalized((char *)"print env");
+ start_print_dialog(xmstr4, true);
+ XmStringFree(xmstr4);
+}
+
+
+void save_print_dialog_state(FILE *fd)
+{
+ if ((print_dialog) && (XtIsManaged(print_dialog)))
+ {
+#if HAVE_SCHEME
+ fprintf(fd, "(%s #t %s)\n", S_print_dialog, ((bool)(XmToggleButtonGetState(print_eps_or_lpr))) ? "#t" : "#f");
+#endif
+#if HAVE_RUBY
+ fprintf(fd, "%s(true, %s)\n", to_proc_name(S_print_dialog), ((bool)(XmToggleButtonGetState(print_eps_or_lpr))) ? "true" : "false");
+#endif
+#if HAVE_FORTH
+ fprintf(fd, "#t %s %s drop\n", ((bool)(XmToggleButtonGetState(print_eps_or_lpr))) ? "#t" : "#f", S_print_dialog);
+#endif
+ }
+}
+
+
+
+void set_menu_label(Widget w, const char *label) {if (w) set_button_label(w, label);}
+
+
+/* -------------------------------- FILE MENU -------------------------------- */
+
+static Widget *recent_file_items = NULL;
+static int recent_file_items_size = 0;
+
+static void open_recent_file_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *filename;
+ snd_info *sp;
+ filename = get_label(w);
+ ss->open_requestor = FROM_OPEN_RECENT_MENU;
+ ss->open_requestor_data = NULL;
+ sp = snd_open_file(filename, FILE_READ_WRITE);
+ if (sp) select_channel(sp, 0);
+}
+
+
+static void file_open_recent_callback(Widget w, XtPointer info, XtPointer context)
+{
+ int size;
+ size = recent_files_size();
+ if (size > 0)
+ {
+ int i;
+ char **recent_file_names;
+
+ if (size > recent_file_items_size)
+ {
+ if (recent_file_items_size == 0)
+ recent_file_items = (Widget *)calloc(size, sizeof(Widget));
+ else
+ {
+ recent_file_items = (Widget *)realloc(recent_file_items, size * sizeof(Widget));
+ for (i = recent_file_items_size; i < size; i++)
+ recent_file_items[i] = NULL;
+ }
+ recent_file_items_size = size;
+ }
+
+ recent_file_names = recent_files();
+
+ for (i = 0; i < size; i++)
+ {
+ if (recent_file_items[i] == NULL)
+ {
+ int n = 0;
+ Arg args[6];
+
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+
+ recent_file_items[i] = XtCreateManagedWidget(recent_file_names[i], xmPushButtonWidgetClass, file_open_recent_menu, args, n);
+ XtAddCallback(recent_file_items[i], XmNactivateCallback, open_recent_file_callback, NULL);
+ }
+ else
+ {
+ set_label(recent_file_items[i], recent_file_names[i]);
+ XtManageChild(recent_file_items[i]);
+ }
+ }
+
+ for (i = size; i < recent_file_items_size; i++) /* maybe previous file was deleted */
+ if ((recent_file_items[i]) &&
+ (XtIsManaged(recent_file_items[i])))
+ XtUnmanageChild(recent_file_items[i]);
+ }
+}
+
+
+static void make_open_recent_menu(void)
+{
+ int n = 0;
+ Arg args[6];
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNpositionIndex, 1); n++; /* just after "Open" menu */
+
+ file_open_recent_menu = XmCreatePulldownMenu(file_menu, (char *)"open-recent", args, n);
+
+ XtSetArg(args[n], XmNsubMenuId, file_open_recent_menu); n++;
+
+ file_open_recent_cascade_menu = XtCreateManagedWidget("Open recent", xmCascadeButtonWidgetClass, file_menu, args, n);
+ XtAddCallback(file_open_recent_cascade_menu, XmNcascadingCallback, file_open_recent_callback, NULL);
+}
+
+
+static void file_menu_update_1(Widget w, XtPointer info, XtPointer context)
+{
+ if (recent_files_size() > 0)
+ {
+ if (file_open_recent_menu == NULL)
+ make_open_recent_menu();
+ else set_sensitive(file_open_recent_cascade_menu, true);
+ }
+ else
+ {
+ if (file_open_recent_menu)
+ set_sensitive(file_open_recent_cascade_menu, false);
+ }
+
+ file_menu_update();
+}
+
+
+static void file_open_callback(Widget w, XtPointer info, XtPointer context) {make_open_file_dialog(FILE_READ_WRITE, true);}
+static void file_view_callback(Widget w, XtPointer info, XtPointer context) {make_open_file_dialog(FILE_READ_ONLY, true);}
+static void file_new_callback(Widget w, XtPointer info, XtPointer context) {make_new_file_dialog(true);}
+static void file_close_callback(Widget w, XtPointer info, XtPointer context) {if (any_selected_sound()) snd_close_file(any_selected_sound());}
+static void file_close_all_callback(Widget w, XtPointer info, XtPointer context) {for_each_sound(snd_close_file);}
+static void file_save_callback(Widget w, XtPointer info, XtPointer context) {if (any_selected_sound()) save_edits_from_kbd(any_selected_sound());}
+static void file_update_callback(Widget w, XtPointer info, XtPointer context) {update_file_from_menu();}
+static void file_save_as_callback(Widget w, XtPointer info, XtPointer context) {make_sound_save_as_dialog(true);}
+static void file_revert_callback(Widget w, XtPointer info, XtPointer context) {revert_file_from_menu();}
+static void file_exit_callback(Widget w, XtPointer info, XtPointer context) {if (snd_exit_cleanly(EXIT_NOT_FORCED)) snd_exit(1);}
+static void file_mix_callback_1(Widget w, XtPointer info, XtPointer context) {make_mix_file_dialog(true);}
+static void file_insert_callback_1(Widget w, XtPointer info, XtPointer context) {make_insert_file_dialog(true);}
+static void file_print_callback_1(Widget w, XtPointer info, XtPointer context) {file_print_callback(w, info, context);}
+
+
+/* -------------------------------- EDIT MENU -------------------------------- */
+
+static void edit_mix_callback(Widget w, XtPointer info, XtPointer context) {add_selection_or_region(0, selected_channel());}
+static void edit_envelope_callback(Widget w, XtPointer info, XtPointer context) {create_envelope_editor();}
+static void edit_cut_callback(Widget w, XtPointer info, XtPointer context) {delete_selection(UPDATE_DISPLAY);}
+static void edit_paste_callback(Widget w, XtPointer info, XtPointer context) {insert_selection_from_menu();}
+static void edit_save_as_callback(Widget w, XtPointer info, XtPointer context) {make_selection_save_as_dialog(true);}
+static void edit_select_all_callback(Widget w, XtPointer info, XtPointer context) {select_all(current_channel());}
+static void edit_unselect_callback(Widget w, XtPointer info, XtPointer context) {deactivate_selection();}
+static void edit_undo_callback(Widget w, XtPointer info, XtPointer context) {undo_edit_with_sync(current_channel(), 1);}
+static void edit_redo_callback(Widget w, XtPointer info, XtPointer context) {redo_edit_with_sync(current_channel(), 1);}
+
+static void edit_menu_update_1(Widget w, XtPointer info, XtPointer context) {edit_menu_update();}
+
+
+#if WITH_AUDIO
+static void edit_play_callback(Widget w, XtPointer info, XtPointer context)
+{
+ if (ss->selection_play_stop)
+ {
+ stop_playing_all_sounds(PLAY_BUTTON_UNSET);
+ reflect_play_selection_stop(); /* if there was an error, stop_playing might not remember to clear this */
+ }
+ else
+ {
+ set_menu_label(edit_play_menu, I_STOP);
+ ss->selection_play_stop = true;
+ play_selection(IN_BACKGROUND);
+ }
+}
+
+
+void reflect_play_selection_stop(void)
+{
+ set_menu_label(edit_play_menu, "Play Selection");
+ ss->selection_play_stop = false;
+}
+
+#else
+
+void reflect_play_selection_stop(void)
+{
+}
+
+#endif
+
+
+static void edit_header_callback_1(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp) edit_header(sp);
+}
+
+
+#if HAVE_EXTENSION_LANGUAGE
+static void edit_find_callback_1(Widget w, XtPointer info, XtPointer context)
+{
+ edit_find_callback(w, info, context);
+}
+#endif
+
+
+
+/* -------------------------------- VIEW MENU -------------------------------- */
+
+static Widget *view_files_items = NULL;
+static Widget view_files_cascade_menu = NULL;
+static int view_files_items_size = 0;
+
+
+static void view_files_item_callback(Widget w, XtPointer context, XtPointer info)
+{
+ view_files_start_dialog_with_title(get_label(w));
+}
+
+
+static void view_files_callback(Widget w, XtPointer info, XtPointer context)
+{
+ int size;
+
+ size = view_files_dialog_list_length();
+ if (size == 0)
+ make_view_files_dialog(true, true); /* managed and empty (brand-new) */
+ else
+ {
+ if (size == 1)
+ make_view_files_dialog(true, false); /* raise current */
+ else
+ {
+ int i;
+ char **view_files_names;
+
+ if ((XmIsPushButton(view_files_menu)) && /* autotest check */
+ (!view_files_cascade_menu))
+ return;
+
+ view_files_names = view_files_dialog_titles();
+ if (size > view_files_items_size)
+ {
+ if (view_files_items_size == 0)
+ view_files_items = (Widget *)calloc(size, sizeof(Widget));
+ else
+ {
+ view_files_items = (Widget *)realloc(view_files_items, size * sizeof(Widget));
+ for (i = view_files_items_size; i < size; i++)
+ view_files_items[i] = NULL;
+ }
+ view_files_items_size = size;
+ }
+
+ for (i = 0; i < size; i++)
+ {
+ if (view_files_items[i] == NULL)
+ {
+ int n = 0;
+ Arg args[6];
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+
+ view_files_items[i] = XtCreateManagedWidget(view_files_names[i], xmPushButtonWidgetClass, view_files_menu, args, n);
+ XtAddCallback(view_files_items[i], XmNactivateCallback, view_files_item_callback, NULL);
+ }
+ else
+ {
+ set_label(view_files_items[i], view_files_names[i]);
+ XtManageChild(view_files_items[i]);
+ }
+ free(view_files_names[i]);
+ }
+ free(view_files_names);
+ }
+ }
+}
+
+
+static void make_view_files_list_menu(void)
+{
+ int n = 0, pos = 2;
+ Arg args[6];
+
+ if ((view_files_menu) &&
+ (XmIsPushButton(view_files_menu)))
+ {
+ XtVaGetValues(view_files_menu, XmNpositionIndex, &pos, NULL);
+ XtUnmanageChild(view_files_menu);
+ }
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNpositionIndex, pos); n++;
+
+ view_files_menu = XmCreatePulldownMenu(view_menu, (char *)"view-files", args, n);
+ XtSetArg(args[n], XmNsubMenuId, view_files_menu); n++;
+
+ view_files_cascade_menu = XtCreateManagedWidget("Files", xmCascadeButtonWidgetClass, view_menu, args, n);
+ XtAddCallback(view_files_cascade_menu, XmNcascadingCallback, view_files_callback, NULL);
+}
+
+
+static void view_menu_update_1(Widget w, XtPointer info, XtPointer context)
+{
+ if ((view_files_dialog_list_length() > 1) &&
+ (!view_files_cascade_menu))
+ make_view_files_list_menu();
+
+ view_menu_update();
+}
+
+
+
+static void view_separate_callback(Widget w, XtPointer info, XtPointer context) {set_channel_style(CHANNELS_SEPARATE);}
+static void view_combined_callback(Widget w, XtPointer info, XtPointer context) {set_channel_style(CHANNELS_COMBINED);}
+static void view_superimposed_callback(Widget w, XtPointer info, XtPointer context) {set_channel_style(CHANNELS_SUPERIMPOSED);}
+static void view_dots_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_DOTS);}
+static void view_lines_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_LINES);}
+static void view_filled_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_FILLED);}
+static void view_dots_and_lines_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_DOTS_AND_LINES);}
+static void view_lollipops_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_LOLLIPOPS);}
+#if HAVE_EXTENSION_LANGUAGE
+static void view_listener_callback(Widget w, XtPointer info, XtPointer context) {handle_listener(!(listener_is_visible()));}
+#endif
+static void view_mix_dialog_callback(Widget w, XtPointer info, XtPointer context) {make_mix_dialog();}
+static void view_zero_callback(Widget w, XtPointer info, XtPointer context){set_show_y_zero((!(show_y_zero(ss))));}
+static void view_cursor_callback(Widget w, XtPointer info, XtPointer context){set_with_verbose_cursor((!(with_verbose_cursor(ss))));}
+
+#if HAVE_EXTENSION_LANGUAGE
+static void view_inset_callback(Widget w, XtPointer info, XtPointer context)
+{
+ set_with_inset_graph((!(with_inset_graph(ss))));
+ for_each_chan(update_graph);
+}
+#endif
+
+static void view_controls_callback(Widget w, XtPointer info, XtPointer context) {set_show_controls(!in_show_controls(ss));}
+static void view_region_callback_1(Widget w, XtPointer info, XtPointer context) {view_region_callback(w, info, context);}
+static void view_color_orientation_callback_1(Widget w, XtPointer info, XtPointer context) {view_color_orientation_callback(w, info, context);}
+
+static void view_x_axis_seconds_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_IN_SECONDS);}
+static void view_x_axis_clock_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_AS_CLOCK);}
+static void view_x_axis_beats_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_IN_BEATS);}
+static void view_x_axis_measures_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_IN_MEASURES);}
+static void view_x_axis_samples_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_IN_SAMPLES);}
+static void view_x_axis_percentage_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_AS_PERCENTAGE);}
+
+static void view_no_axes_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_NO_AXES);}
+static void view_all_axes_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_ALL_AXES);}
+static void view_just_x_axis_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_X_AXIS);}
+static void view_all_axes_unlabelled_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_ALL_AXES_UNLABELLED);}
+static void view_just_x_axis_unlabelled_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_X_AXIS_UNLABELLED);}
+static void view_bare_x_axis_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_BARE_X_AXIS);}
+
+static void view_focus_right_callback(Widget w, XtPointer info, XtPointer context) {set_zoom_focus_style(ZOOM_FOCUS_RIGHT);}
+static void view_focus_left_callback(Widget w, XtPointer info, XtPointer context) {set_zoom_focus_style(ZOOM_FOCUS_LEFT);}
+static void view_focus_middle_callback(Widget w, XtPointer info, XtPointer context) {set_zoom_focus_style(ZOOM_FOCUS_MIDDLE);}
+static void view_focus_active_callback(Widget w, XtPointer info, XtPointer context) {set_zoom_focus_style(ZOOM_FOCUS_ACTIVE);}
+
+static void view_grid_callback(Widget w, XtPointer info, XtPointer context)
+{
+ if (show_grid(ss) == NO_GRID)
+ set_show_grid(WITH_GRID);
+ else set_show_grid(NO_GRID);
+}
+
+
+
+/* -------------------------------- OPTIONS MENU -------------------------------- */
+
+static void options_transform_callback(Widget w, XtPointer info, XtPointer context) {make_transform_dialog(true);}
+static void options_controls_callback(Widget w, XtPointer info, XtPointer context) {make_controls_dialog();}
+#if HAVE_EXTENSION_LANGUAGE
+static void options_save_state_callback(Widget w, XtPointer info, XtPointer context) {save_state_from_menu();}
+#endif
+static void options_preferences_callback(Widget w, XtPointer info, XtPointer context) {make_preferences_dialog();}
+
+
+
+/* -------------------------------- HELP MENU -------------------------------- */
+
+static void help_about_snd_callback(Widget w, XtPointer info, XtPointer context) {about_snd_help();}
+static void help_fft_callback(Widget w, XtPointer info, XtPointer context) {fft_help();}
+#if HAVE_EXTENSION_LANGUAGE
+static void help_find_callback(Widget w, XtPointer info, XtPointer context) {find_help();}
+static void help_init_file_callback(Widget w, XtPointer info, XtPointer context) {init_file_help();}
+#endif
+static void help_undo_callback(Widget w, XtPointer info, XtPointer context) {undo_help();}
+static void help_sync_callback(Widget w, XtPointer info, XtPointer context) {sync_help();}
+static void help_debug_callback(Widget w, XtPointer info, XtPointer context) {debug_help();}
+static void help_controls_callback(Widget w, XtPointer info, XtPointer context) {controls_help();}
+static void help_env_callback(Widget w, XtPointer info, XtPointer context) {env_help();}
+static void help_marks_callback(Widget w, XtPointer info, XtPointer context) {marks_help();}
+static void help_mix_callback(Widget w, XtPointer info, XtPointer context) {mix_help();}
+static void help_sound_files_callback(Widget w, XtPointer info, XtPointer context) {sound_files_help();}
+static void help_keys_callback(Widget w, XtPointer info, XtPointer context) {key_help();}
+static void help_play_callback(Widget w, XtPointer info, XtPointer context) {play_help();}
+static void help_filter_callback(Widget w, XtPointer info, XtPointer context) {filter_help();}
+static void help_save_callback(Widget w, XtPointer info, XtPointer context) {save_help();}
+static void help_reverb_callback(Widget w, XtPointer info, XtPointer context) {reverb_help();}
+static void help_resample_callback(Widget w, XtPointer info, XtPointer context) {resample_help();}
+static void help_insert_callback(Widget w, XtPointer info, XtPointer context) {insert_help();}
+static void help_delete_callback(Widget w, XtPointer info, XtPointer context) {delete_help();}
+static void help_region_callback(Widget w, XtPointer info, XtPointer context) {region_help();}
+static void help_selection_callback(Widget w, XtPointer info, XtPointer context) {selection_help();}
+static void help_colors_callback(Widget w, XtPointer info, XtPointer context) {colors_help();}
+
+void check_menu_labels(int key, int state, bool extended)
+{
+ /* user has redefined key, so erase old key binding info from the menu label */
+ if (extended)
+ {
+ if (state == snd_ControlMask)
+ {
+ if (key == snd_K_f) set_label(file_open_menu, "Open"); else
+ if (key == snd_K_s) set_label(file_save_menu, "Save"); else
+ if (key == snd_K_q) set_label(file_mix_menu, "Mix"); else
+ if (key == snd_K_i) set_label(file_insert_menu, "Insert"); else
+ if (key == snd_K_u) set_label(edit_undo_menu, "Undo"); else
+ if (key == snd_K_r) set_label(edit_redo_menu, "Redo");
+ }
+ else
+ {
+ if (key == snd_K_k) set_label(file_close_menu, "Close"); else
+ if (key == snd_K_i) set_label(edit_paste_menu, "Insert Selection"); else
+ if (key == snd_K_q) set_label(edit_mix_menu, "Mix Selection"); else
+#if WITH_AUDIO
+ if (key == snd_K_p) set_label(edit_play_menu, "Play Selection"); else
+#endif
+ if (key == snd_K_w) set_label(edit_save_as_menu, "Save Selection");
+ }
+ }
+#if HAVE_EXTENSION_LANGUAGE
+ else
+ {
+ if ((key == snd_K_s) && (state == snd_ControlMask))
+ set_label(edit_find_menu, I_FIND);
+ }
+#endif
+}
+
+
+/* -------------------------------- MAIN MENU -------------------------------- */
+
+static void menu_drag_watcher(Widget w, const char *str, Position x, Position y, drag_style_t dtype, void *data)
+{
+ char *new_title;
+ switch (dtype)
+ {
+ case DRAG_ENTER:
+ new_title = mus_format("%s: drop to open file", ss->startup_title);
+ XtVaSetValues(MAIN_SHELL(ss), XmNtitle, (char *)new_title, NULL);
+ XmChangeColor(w, ss->selection_color);
+ free(new_title);
+ break;
+
+ case DRAG_LEAVE:
+ reflect_file_change_in_title();
+ XmChangeColor(w, ss->highlight_color);
+ break;
+
+ default:
+ break;
+ }
+}
+
+
+static void menu_drop_watcher(Widget w, const char *str, Position x, Position y, void *data)
+{
+ snd_info *sp = NULL;
+ ss->open_requestor = FROM_DRAG_AND_DROP;
+ sp = snd_open_file(str, FILE_READ_WRITE);
+ if (sp) select_channel(sp, 0);
+}
+
+
+void add_menu_drop(void)
+{
+ add_drag_and_drop(main_menu, menu_drop_watcher, menu_drag_watcher, NULL);
+}
+
+
+Widget add_menu(void)
+{
+ static Arg main_args[12];
+ static Arg in_args[12];
+ static Arg high_args[12];
+ Arg sep_args[12];
+ int in_n = 0, n, high_n = 0, main_n = 0, start_high_n, k, j;
+
+ ss->mw = (Widget *)calloc(NUM_MENU_WIDGETS, sizeof(Widget));
+
+ XtSetArg(main_args[main_n], XmNbackground, ss->basic_color); main_n++;
+ XtSetArg(high_args[high_n], XmNbackground, ss->highlight_color); high_n++;
+ XtSetArg(in_args[in_n], XmNbackground, ss->basic_color); in_n++;
+
+ start_high_n = high_n;
+ XtSetArg(in_args[in_n], XmNsensitive, false); in_n++;
+
+ n = high_n;
+ XtSetArg(high_args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(high_args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(high_args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(high_args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+
+ main_menu = XmCreateMenuBar(MAIN_PANE(ss), (char *)"menuBar", high_args, n);
+
+
+ /* FILE MENU */
+ XtSetArg(main_args[main_n], XmNuserData, (XtPointer)0);
+ file_menu = XmCreatePulldownMenu(main_menu, (char *)"File", main_args, main_n + 1);
+
+ high_n = start_high_n;
+ XtSetArg(high_args[high_n], XmNsubMenuId, file_menu); high_n++;
+ XtSetArg(high_args[high_n], XmNmnemonic, 'F'); high_n++;
+ XtSetArg(high_args[high_n], XmNuserData, (XtPointer)0); high_n++;
+ file_cascade_menu = XtCreateManagedWidget("File", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
+
+ file_open_menu = XtCreateManagedWidget("Open", xmPushButtonWidgetClass, file_menu, main_args, main_n);
+ XtAddCallback(file_open_menu, XmNactivateCallback, file_open_callback, NULL);
+ XtVaSetValues(file_open_menu, XmNmnemonic, 'O', NULL);
+
+ file_close_menu = XtCreateManagedWidget("Close", xmPushButtonWidgetClass, file_menu, in_args, in_n);
+ XtAddCallback(file_close_menu, XmNactivateCallback, file_close_callback, NULL);
+ XtVaSetValues(file_close_menu, XmNmnemonic, 'C', NULL);
+
+ file_close_all_menu = XtCreateWidget("Close all", xmPushButtonWidgetClass, file_menu, main_args, main_n);
+ XtAddCallback(file_close_all_menu, XmNactivateCallback, file_close_all_callback, NULL);
+
+ file_save_menu = XtCreateManagedWidget("Save", xmPushButtonWidgetClass, file_menu, in_args, in_n);
+ XtAddCallback(file_save_menu, XmNactivateCallback, file_save_callback, NULL);
+ XtVaSetValues(file_save_menu, XmNmnemonic, 'S', NULL);
+
+ file_save_as_menu = XtCreateManagedWidget("Save as", xmPushButtonWidgetClass, file_menu, in_args, in_n);
+ XtAddCallback(file_save_as_menu, XmNactivateCallback, file_save_as_callback, NULL);
+ XtVaSetValues(file_save_as_menu, XmNmnemonic, 'a', NULL);
+
+ file_revert_menu = XtCreateManagedWidget("Revert", xmPushButtonWidgetClass, file_menu, in_args, in_n);
+ XtAddCallback(file_revert_menu, XmNactivateCallback, file_revert_callback, NULL);
+ XtVaSetValues(file_revert_menu, XmNmnemonic, 'R', NULL);
+
+ file_mix_menu = XtCreateManagedWidget("Mix", xmPushButtonWidgetClass, file_menu, in_args, in_n);
+ XtAddCallback(file_mix_menu, XmNactivateCallback, file_mix_callback_1, NULL);
+ XtVaSetValues(file_mix_menu, XmNmnemonic, 'M', NULL);
+
+ file_insert_menu = XtCreateManagedWidget("Insert", xmPushButtonWidgetClass, file_menu, in_args, in_n);
+ XtAddCallback(file_insert_menu, XmNactivateCallback, file_insert_callback_1, NULL);
+ XtVaSetValues(file_insert_menu, XmNmnemonic, 'I', NULL);
+
+ file_update_menu = XtCreateManagedWidget("Update", xmPushButtonWidgetClass, file_menu, in_args, in_n);
+ XtAddCallback(file_update_menu, XmNactivateCallback, file_update_callback, NULL);
+ XtVaSetValues(file_update_menu, XmNmnemonic, 'U', NULL);
+
+ file_new_menu = XtCreateManagedWidget("New", xmPushButtonWidgetClass, file_menu, main_args, main_n);
+ XtAddCallback(file_new_menu, XmNactivateCallback, file_new_callback, NULL);
+ XtVaSetValues(file_new_menu, XmNmnemonic, 'N', NULL);
+
+ file_view_menu = XtCreateManagedWidget("View", xmPushButtonWidgetClass, file_menu, main_args, main_n);
+ XtAddCallback(file_view_menu, XmNactivateCallback, file_view_callback, NULL);
+ XtVaSetValues(file_view_menu, XmNmnemonic, 'V', NULL);
+
+ file_print_menu = XtCreateManagedWidget("Print", xmPushButtonWidgetClass, file_menu, in_args, in_n);
+ XtAddCallback(file_print_menu, XmNactivateCallback, file_print_callback_1, NULL);
+ XtVaSetValues(file_print_menu, XmNmnemonic, 'P', NULL);
+
+ j = 0;
+ XtSetArg(sep_args[j], XmNbackground, ss->basic_color); j++;
+ XtSetArg(sep_args[j], XmNseparatorType, XmSHADOW_ETCHED_IN); j++;
+ file_sep_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, file_menu, sep_args, j);
+
+ file_exit_menu = XtCreateManagedWidget("Exit", xmPushButtonWidgetClass, file_menu, main_args, main_n);
+ XtAddCallback(file_exit_menu, XmNactivateCallback, file_exit_callback, NULL);
+ XtVaSetValues(file_exit_menu, XmNmnemonic, 'E', NULL);
+
+
+ /* EDIT MENU */
+ XtSetArg(main_args[main_n], XmNuserData, (XtPointer)1);
+ edit_menu = XmCreatePulldownMenu(main_menu, (char *)"Edit", main_args, main_n + 1);
+
+ high_n = start_high_n;
+ XtSetArg(high_args[high_n], XmNsubMenuId, edit_menu); high_n++;
+ XtSetArg(high_args[high_n], XmNmnemonic, 'E'); high_n++;
+ XtSetArg(high_args[high_n], XmNuserData, (XtPointer)1); high_n++;
+ edit_cascade_menu = XtCreateManagedWidget("Edit", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
+
+ edit_undo_menu = XtCreateManagedWidget("Undo", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_undo_menu, XmNactivateCallback, edit_undo_callback, NULL);
+ XtVaSetValues(edit_undo_menu, XmNmnemonic, 'U', NULL);
+
+ edit_redo_menu = XtCreateManagedWidget("Redo", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_redo_menu, XmNactivateCallback, edit_redo_callback, NULL);
+ XtVaSetValues(edit_redo_menu, XmNmnemonic, 'R', NULL);
+
+#if HAVE_EXTENSION_LANGUAGE
+ edit_find_menu = XtCreateManagedWidget(I_FIND, xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_find_menu, XmNactivateCallback, edit_find_callback_1, NULL);
+ XtVaSetValues(edit_find_menu, XmNmnemonic, 'F', NULL);
+#endif
+
+ edit_select_sep_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, edit_menu, sep_args, j);
+
+ edit_cut_menu = XtCreateManagedWidget("Delete selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_cut_menu, XmNactivateCallback, edit_cut_callback, NULL);
+ XtVaSetValues(edit_cut_menu, XmNmnemonic, 'C', NULL);
+
+ edit_paste_menu = XtCreateManagedWidget("Insert selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_paste_menu, XmNactivateCallback, edit_paste_callback, NULL);
+ XtVaSetValues(edit_paste_menu, XmNmnemonic, 'P', NULL);
+
+ edit_mix_menu = XtCreateManagedWidget("Mix selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_mix_menu, XmNactivateCallback, edit_mix_callback, NULL);
+ XtVaSetValues(edit_mix_menu, XmNmnemonic, 'M', NULL);
+
+#if WITH_AUDIO
+ edit_play_menu = XtCreateManagedWidget("Play selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_play_menu, XmNactivateCallback, edit_play_callback, NULL);
+ XtVaSetValues(edit_play_menu, XmNmnemonic, 'P', NULL);
+#endif
+
+ edit_save_as_menu = XtCreateManagedWidget("Save selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_save_as_menu, XmNactivateCallback, edit_save_as_callback, NULL);
+ XtVaSetValues(edit_save_as_menu, XmNmnemonic, 'S', NULL);
+
+ edit_select_all_menu = XtCreateManagedWidget("Select all", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_select_all_menu, XmNactivateCallback, edit_select_all_callback, NULL);
+
+ edit_unselect_menu = XtCreateManagedWidget("Unselect all", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_unselect_menu, XmNactivateCallback, edit_unselect_callback, NULL);
+
+ edit_edit_sep_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, edit_menu, sep_args, j);
+
+ edit_env_menu = XtCreateManagedWidget("Edit envelope", xmPushButtonWidgetClass, edit_menu, main_args, main_n);
+ XtAddCallback(edit_env_menu, XmNactivateCallback, edit_envelope_callback, NULL);
+ XtVaSetValues(edit_env_menu, XmNmnemonic, 'E', NULL);
+
+ edit_header_menu = XtCreateManagedWidget("Edit header", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
+ XtAddCallback(edit_header_menu, XmNactivateCallback, edit_header_callback_1, NULL);
+ XtVaSetValues(edit_header_menu, XmNmnemonic, 'H', NULL);
+
+
+ /* VIEW MENU */
+ XtSetArg(main_args[main_n], XmNuserData, (XtPointer)2);
+ view_menu = XmCreatePulldownMenu(main_menu, (char *)"View", main_args, main_n + 1);
+
+ high_n = start_high_n;
+ XtSetArg(high_args[high_n], XmNsubMenuId, view_menu); high_n++;
+ XtSetArg(high_args[high_n], XmNmnemonic, 'V'); high_n++;
+ XtSetArg(high_args[high_n], XmNuserData, (XtPointer)2); high_n++;
+ view_cascade_menu = XtCreateManagedWidget("View", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
+
+#if HAVE_EXTENSION_LANGUAGE
+ view_listener_menu = XtCreateManagedWidget("Open listener", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_listener_menu, XmNactivateCallback, view_listener_callback, NULL);
+ XtVaSetValues(view_listener_menu, XmNmnemonic, 'L', NULL);
+#endif
+
+ view_files_menu = XtCreateManagedWidget("Files", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_files_menu, XmNactivateCallback, view_files_callback, NULL);
+ XtVaSetValues(view_files_menu, XmNmnemonic, 'F', NULL);
+
+ view_mix_dialog_menu = XtCreateManagedWidget("Mixes", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_mix_dialog_menu, XmNactivateCallback, view_mix_dialog_callback, NULL);
+
+ view_region_menu = XtCreateManagedWidget("Regions", xmPushButtonWidgetClass, view_menu, in_args, in_n);
+ XtAddCallback(view_region_menu, XmNactivateCallback, view_region_callback_1, NULL);
+ XtVaSetValues(view_region_menu, XmNmnemonic, 'R', NULL);
+
+ view_color_orientation_menu = XtCreateManagedWidget("Color/Orientation", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_color_orientation_menu, XmNactivateCallback, view_color_orientation_callback_1, NULL);
+
+ view_controls_menu = XtCreateManagedWidget("Show controls", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_controls_menu, XmNactivateCallback, view_controls_callback, NULL);
+ XtVaSetValues(view_controls_menu, XmNmnemonic, 'S', NULL);
+
+ view_sep2_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, view_menu, sep_args, j);
+
+ view_graph_style_menu = XmCreatePulldownMenu(view_menu, (char *)"graph-style", main_args, main_n);
+
+ k = main_n;
+ XtSetArg(main_args[k], XmNsubMenuId, view_graph_style_menu); k++;
+ view_graph_style_cascade_menu = XtCreateManagedWidget(I_LINES_OR_DOTS, xmCascadeButtonWidgetClass, view_menu, main_args, k);
+
+ view_lines_menu = XtCreateManagedWidget("lines", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
+ XtAddCallback(view_lines_menu, XmNactivateCallback, view_lines_callback, NULL);
+ if (graph_style(ss) == GRAPH_LINES) set_sensitive(view_lines_menu, false);
+
+ view_dots_menu = XtCreateManagedWidget("dots", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
+ XtAddCallback(view_dots_menu, XmNactivateCallback, view_dots_callback, NULL);
+ if (graph_style(ss) == GRAPH_DOTS) set_sensitive(view_dots_menu, false);
+
+ view_filled_menu = XtCreateManagedWidget("filled", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
+ XtAddCallback(view_filled_menu, XmNactivateCallback, view_filled_callback, NULL);
+ if (graph_style(ss) == GRAPH_FILLED) set_sensitive(view_filled_menu, false);
+
+ view_dots_and_lines_menu = XtCreateManagedWidget("dots and lines", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
+ XtAddCallback(view_dots_and_lines_menu, XmNactivateCallback, view_dots_and_lines_callback, NULL);
+ if (graph_style(ss) == GRAPH_DOTS_AND_LINES) set_sensitive(view_dots_and_lines_menu, false);
+
+ view_lollipops_menu = XtCreateManagedWidget("lollipops", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
+ XtAddCallback(view_lollipops_menu, XmNactivateCallback, view_lollipops_callback, NULL);
+ if (graph_style(ss) == GRAPH_LOLLIPOPS) set_sensitive(view_lollipops_menu, false);
+
+ view_cursor_menu = XtCreateManagedWidget("Verbose cursor", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_cursor_menu, XmNactivateCallback, view_cursor_callback, NULL);
+
+#if HAVE_EXTENSION_LANGUAGE
+ view_inset_menu = XtCreateManagedWidget("With inset graph", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_inset_menu, XmNactivateCallback, view_inset_callback, NULL);
+#endif
+
+ view_combine_menu = XmCreatePulldownMenu(view_menu, (char *)"combine", main_args, main_n);
+
+ k = main_n;
+ XtSetArg(main_args[k], XmNsubMenuId, view_combine_menu); k++;
+ view_combine_cascade_menu = XtCreateManagedWidget(I_CHANNEL_LAYOUT, xmCascadeButtonWidgetClass, view_menu, main_args, k);
+
+ view_combine_separate_menu = XtCreateManagedWidget("separate", xmPushButtonWidgetClass, view_combine_menu, main_args, main_n);
+ XtAddCallback(view_combine_separate_menu, XmNactivateCallback, view_separate_callback, NULL);
+ if (channel_style(ss) == CHANNELS_SEPARATE) set_sensitive(view_combine_separate_menu, false);
+
+ view_combine_combined_menu = XtCreateManagedWidget("combined", xmPushButtonWidgetClass, view_combine_menu, main_args, main_n);
+ XtAddCallback(view_combine_combined_menu, XmNactivateCallback, view_combined_callback, NULL);
+ if (channel_style(ss) == CHANNELS_COMBINED) set_sensitive(view_combine_combined_menu, false);
+
+ view_combine_superimposed_menu = XtCreateManagedWidget("superimposed", xmPushButtonWidgetClass, view_combine_menu, main_args, main_n);
+ XtAddCallback(view_combine_superimposed_menu, XmNactivateCallback, view_superimposed_callback, NULL);
+ if (channel_style(ss) == CHANNELS_SUPERIMPOSED) set_sensitive(view_combine_superimposed_menu, false);
+
+ view_zero_menu = XtCreateManagedWidget("Show y = 0", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_zero_menu, XmNactivateCallback, view_zero_callback, NULL);
+ XtVaSetValues(view_zero_menu, XmNmnemonic, 'y', NULL);
+
+ view_x_axis_menu = XmCreatePulldownMenu(view_menu, (char *)"xaxis", main_args, main_n);
+
+ k = main_n;
+ XtSetArg(main_args[k], XmNsubMenuId, view_x_axis_menu); k++;
+ view_x_axis_cascade_menu = XtCreateManagedWidget("X axis units", xmCascadeButtonWidgetClass, view_menu, main_args, k);
+
+ view_x_axis_seconds_menu = XtCreateManagedWidget("seconds", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
+ XtAddCallback(view_x_axis_seconds_menu, XmNactivateCallback, view_x_axis_seconds_callback, NULL);
+ set_sensitive(view_x_axis_seconds_menu, false);
+
+ view_x_axis_samples_menu = XtCreateManagedWidget("samples", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
+ XtAddCallback(view_x_axis_samples_menu, XmNactivateCallback, view_x_axis_samples_callback, NULL);
+
+ view_x_axis_clock_menu = XtCreateManagedWidget("clock", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
+ XtAddCallback(view_x_axis_clock_menu, XmNactivateCallback, view_x_axis_clock_callback, NULL);
+
+ view_x_axis_percentage_menu = XtCreateManagedWidget("percentage", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
+ XtAddCallback(view_x_axis_percentage_menu, XmNactivateCallback, view_x_axis_percentage_callback, NULL);
+
+ view_x_axis_beats_menu = XtCreateManagedWidget("beats", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
+ XtAddCallback(view_x_axis_beats_menu, XmNactivateCallback, view_x_axis_beats_callback, NULL);
+
+ view_x_axis_measures_menu = XtCreateManagedWidget("measures", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
+ XtAddCallback(view_x_axis_measures_menu, XmNactivateCallback, view_x_axis_measures_callback, NULL);
+
+
+ view_axes_menu = XmCreatePulldownMenu(view_menu, (char *)"axes", main_args, main_n);
+
+ k = main_n;
+ XtSetArg(main_args[k], XmNsubMenuId, view_axes_menu); k++;
+ view_axes_cascade_menu = XtCreateManagedWidget(I_AXIS_LAYOUT, xmCascadeButtonWidgetClass, view_menu, main_args, k);
+
+ view_no_axes_menu = XtCreateManagedWidget("no axes", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
+ XtAddCallback(view_no_axes_menu, XmNactivateCallback, view_no_axes_callback, NULL);
+ if (show_axes(ss) == SHOW_NO_AXES) set_sensitive(view_no_axes_menu, false); /* false because it is already chosen */
+
+ view_all_axes_menu = XtCreateManagedWidget("both axes", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
+ XtAddCallback(view_all_axes_menu, XmNactivateCallback, view_all_axes_callback, NULL);
+ if (show_axes(ss) == SHOW_ALL_AXES) set_sensitive(view_all_axes_menu, false);
+
+ view_just_x_axis_menu = XtCreateManagedWidget("just x axis", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
+ XtAddCallback(view_just_x_axis_menu, XmNactivateCallback, view_just_x_axis_callback, NULL);
+ if (show_axes(ss) == SHOW_X_AXIS) set_sensitive(view_just_x_axis_menu, false);
+
+ view_all_axes_unlabelled_menu = XtCreateManagedWidget("both axes, no labels", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
+ XtAddCallback(view_all_axes_unlabelled_menu, XmNactivateCallback, view_all_axes_unlabelled_callback, NULL);
+ if (show_axes(ss) == SHOW_ALL_AXES_UNLABELLED) set_sensitive(view_all_axes_unlabelled_menu, false);
+
+ view_just_x_axis_unlabelled_menu = XtCreateManagedWidget("just x axis, no label", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
+ XtAddCallback(view_just_x_axis_unlabelled_menu, XmNactivateCallback, view_just_x_axis_unlabelled_callback, NULL);
+ if (show_axes(ss) == SHOW_X_AXIS_UNLABELLED) set_sensitive(view_just_x_axis_unlabelled_menu, false);
+
+ view_bare_x_axis_menu = XtCreateManagedWidget("bare x axis", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
+ XtAddCallback(view_bare_x_axis_menu, XmNactivateCallback, view_bare_x_axis_callback, NULL);
+ if (show_axes(ss) == SHOW_BARE_X_AXIS) set_sensitive(view_bare_x_axis_menu, false);
+
+ view_focus_style_menu = XmCreatePulldownMenu(view_menu, (char *)"focusstyle", main_args, main_n);
+
+ k = main_n;
+ XtSetArg(main_args[k], XmNsubMenuId, view_focus_style_menu); k++;
+ view_focus_cascade_menu = XtCreateManagedWidget(I_ZOOM_CENTERS_ON, xmCascadeButtonWidgetClass, view_menu, main_args, k);
+
+ view_focus_left_menu = XtCreateManagedWidget("window left edge", xmPushButtonWidgetClass, view_focus_style_menu, main_args, main_n);
+ XtAddCallback(view_focus_left_menu, XmNactivateCallback, view_focus_left_callback, NULL);
+
+ view_focus_right_menu = XtCreateManagedWidget("window right edge", xmPushButtonWidgetClass, view_focus_style_menu, main_args, main_n);
+ XtAddCallback(view_focus_right_menu, XmNactivateCallback, view_focus_right_callback, NULL);
+
+ view_focus_middle_menu = XtCreateManagedWidget("window midpoint", xmPushButtonWidgetClass, view_focus_style_menu, main_args, main_n);
+ XtAddCallback(view_focus_middle_menu, XmNactivateCallback, view_focus_middle_callback, NULL);
+
+ view_focus_active_menu = XtCreateManagedWidget("cursor or selection", xmPushButtonWidgetClass, view_focus_style_menu, main_args, main_n);
+ XtAddCallback(view_focus_active_menu, XmNactivateCallback, view_focus_active_callback, NULL);
+
+
+ view_grid_menu = XtCreateManagedWidget("With grid", xmPushButtonWidgetClass, view_menu, main_args, main_n);
+ XtAddCallback(view_grid_menu, XmNactivateCallback, view_grid_callback, NULL);
+
+
+ /* OPTIONS MENU */
+ XtSetArg(main_args[main_n], XmNuserData, (XtPointer)3);
+ options_menu = XmCreatePulldownMenu(main_menu, (char *)"Option", main_args, main_n + 1);
+
+ high_n = start_high_n;
+ XtSetArg(high_args[high_n], XmNsubMenuId, options_menu); high_n++;
+ XtSetArg(high_args[high_n], XmNmnemonic, 'O'); high_n++;
+ XtSetArg(high_args[high_n], XmNuserData, (XtPointer)3); high_n++;
+ options_cascade_menu = XtCreateManagedWidget("Options", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
+
+ options_transform_menu = XtCreateManagedWidget("Transform options", xmPushButtonWidgetClass, options_menu, main_args, main_n);
+ XtAddCallback(options_transform_menu, XmNactivateCallback, options_transform_callback, NULL);
+ XtVaSetValues(options_transform_menu, XmNmnemonic, 't', NULL);
+
+ options_controls_menu = XtCreateManagedWidget("Control panel options", xmPushButtonWidgetClass, options_menu, main_args, main_n);
+ XtAddCallback(options_controls_menu, XmNactivateCallback, options_controls_callback, NULL);
+ XtVaSetValues(options_controls_menu, XmNmnemonic, 'c', NULL);
+
+
+#if HAVE_EXTENSION_LANGUAGE
+ options_save_state_menu = XtCreateManagedWidget("Save session", xmPushButtonWidgetClass, options_menu, main_args, main_n);
+ XtAddCallback(options_save_state_menu, XmNactivateCallback, options_save_state_callback, NULL);
+#endif
+
+ options_sep_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, options_menu, sep_args, j);
+
+ options_preferences_menu = XtCreateManagedWidget("Preferences", xmPushButtonWidgetClass, options_menu, main_args, main_n);
+ XtAddCallback(options_preferences_menu, XmNactivateCallback, options_preferences_callback, NULL);
+
+
+ /* HELP MENU */
+ XtSetArg(main_args[main_n], XmNuserData, (XtPointer)4);
+ help_menu = XmCreatePulldownMenu(main_menu, (char *)I_HELP, main_args, main_n + 1);
+
+ high_n = start_high_n;
+ XtSetArg(high_args[high_n], XmNsubMenuId, help_menu); high_n++;
+ XtSetArg(high_args[high_n], XmNmnemonic, 'H'); high_n++;
+ XtSetArg(high_args[high_n], XmNuserData, (XtPointer)4); high_n++;
+ help_cascade_menu = XtCreateManagedWidget(I_HELP, xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
+
+ help_about_snd_menu = XtCreateManagedWidget("About Snd", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_about_snd_menu, XmNactivateCallback, help_about_snd_callback, NULL);
+ XtVaSetValues(help_about_snd_menu, XmNmnemonic, 'O', NULL);
+
+#if HAVE_EXTENSION_LANGUAGE
+ help_init_file_menu = XtCreateManagedWidget("Customization", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_init_file_menu, XmNactivateCallback, help_init_file_callback, NULL);
+#endif
+
+ help_controls_menu = XtCreateManagedWidget("Control panel", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_controls_menu, XmNactivateCallback, help_controls_callback, NULL);
+
+ help_keys_menu = XtCreateManagedWidget("Key bindings", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_keys_menu, XmNactivateCallback, help_keys_callback, NULL);
+
+ help_play_menu = XtCreateManagedWidget("Play", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_play_menu, XmNactivateCallback, help_play_callback, NULL);
+
+ help_save_menu = XtCreateManagedWidget("Save", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_save_menu, XmNactivateCallback, help_save_callback, NULL);
+
+ help_mix_menu = XtCreateManagedWidget("Mix", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_mix_menu, XmNactivateCallback, help_mix_callback, NULL);
+
+ help_resample_menu = XtCreateManagedWidget("Resample", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_resample_menu, XmNactivateCallback, help_resample_callback, NULL);
+
+ help_fft_menu = XtCreateManagedWidget("FFT", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_fft_menu, XmNactivateCallback, help_fft_callback, NULL);
+
+ help_filter_menu = XtCreateManagedWidget("Filter", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_filter_menu, XmNactivateCallback, help_filter_callback, NULL);
+
+ help_reverb_menu = XtCreateManagedWidget("Reverb", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_reverb_menu, XmNactivateCallback, help_reverb_callback, NULL);
+
+ help_env_menu = XtCreateManagedWidget("Envelope", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_env_menu, XmNactivateCallback, help_env_callback, NULL);
+
+ help_marks_menu = XtCreateManagedWidget("Mark", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_marks_menu, XmNactivateCallback, help_marks_callback, NULL);
+
+ help_insert_menu = XtCreateManagedWidget("Insert", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_insert_menu, XmNactivateCallback, help_insert_callback, NULL);
+
+ help_delete_menu = XtCreateManagedWidget("Delete", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_delete_menu, XmNactivateCallback, help_delete_callback, NULL);
+
+ help_undo_menu = XtCreateManagedWidget("Undo and redo", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_undo_menu, XmNactivateCallback, help_undo_callback, NULL);
+
+#if HAVE_EXTENSION_LANGUAGE
+ help_find_menu = XtCreateManagedWidget("Search", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_find_menu, XmNactivateCallback, help_find_callback, NULL);
+#endif
+
+ help_sync_menu = XtCreateManagedWidget("Sync and unite", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_sync_menu, XmNactivateCallback, help_sync_callback, NULL);
+
+ help_sound_files_menu = XtCreateManagedWidget("Headers and data", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_sound_files_menu, XmNactivateCallback, help_sound_files_callback, NULL);
+
+ help_debug_menu = XtCreateManagedWidget("Debugging", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_debug_menu, XmNactivateCallback, help_debug_callback, NULL);
+
+ help_region_menu = XtCreateManagedWidget("Regions", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_region_menu, XmNactivateCallback, help_region_callback, NULL);
+
+ help_selection_menu = XtCreateManagedWidget("Selections", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_selection_menu, XmNactivateCallback, help_selection_callback, NULL);
+
+ help_colors_menu = XtCreateManagedWidget("Colors", xmPushButtonWidgetClass, help_menu, main_args, main_n);
+ XtAddCallback(help_colors_menu, XmNactivateCallback, help_colors_callback, NULL);
+
+ XtVaSetValues(main_menu, XmNmenuHelpWidget, help_cascade_menu, NULL);
+
+ XtAddCallback(file_cascade_menu, XmNcascadingCallback, file_menu_update_1, NULL);
+ XtAddCallback(edit_cascade_menu, XmNcascadingCallback, edit_menu_update_1, NULL);
+ XtAddCallback(view_cascade_menu, XmNcascadingCallback, view_menu_update_1, NULL);
+
+ XtManageChild(main_menu);
+ return(main_menu);
+}
+
+
+/* -------------------------------- POPUP MENU -------------------------------- */
+
+static Widget basic_popup_menu = NULL, selection_popup_menu = NULL, fft_popup_menu = NULL;
+
+static Widget add_menu_item(Widget menu, const char *label, void (*callback)(Widget w, XtPointer info, XtPointer context))
+{
+ Arg args[20];
+ int n;
+ Widget w;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ w = XtCreateManagedWidget(label, xmPushButtonWidgetClass, menu, args, n);
+ XtAddCallback(w, XmNactivateCallback, callback, NULL);
+ return(w);
+}
+
+static void popup_info_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp) display_info(sp);
+}
+
+static void popup_normalize_callback(Widget w, XtPointer info, XtPointer context)
+{
+ mus_float_t scl[1];
+ scl[0] = 1.0;
+ scale_to(any_selected_sound(), current_channel(), scl, 1, OVER_SOUND);
+}
+
+
+static void popup_reverse_callback(Widget w, XtPointer info, XtPointer context)
+{
+ reverse_sound(current_channel(), OVER_SOUND, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
+}
+
+
+static void stop_everything_callback(Widget w, XtPointer info, XtPointer context)
+{
+ control_g(any_selected_sound());
+}
+
+
+static void play_channel_callback(Widget w, XtPointer info, XtPointer context)
+{
+ chan_info *cp;
+ cp = current_channel();
+ play_channel(cp, 0, current_samples(cp));
+}
+
+
+static Widget popup_play;
+
+void post_basic_popup_menu(void *e)
+{
+ XButtonPressedEvent *event = (XButtonPressedEvent *)e;
+ snd_info *sp;
+ if (!basic_popup_menu)
+ {
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNpopupEnabled, false); n++; /* this was XmPOPUP_AUTOMATIC_RECURSIVE */
+ basic_popup_menu = XmCreatePopupMenu(MAIN_PANE(ss), (char *)"basic-popup-menu", args, n);
+
+ add_menu_item(basic_popup_menu, "Info", popup_info_callback);
+ add_menu_item(basic_popup_menu, "Select all", edit_select_all_callback);
+ popup_play = add_menu_item(basic_popup_menu, "Play channel", play_channel_callback);
+ add_menu_item(basic_popup_menu, "Stop!", stop_everything_callback);
+ add_menu_item(basic_popup_menu, "-> 1.0", popup_normalize_callback);
+ add_menu_item(basic_popup_menu, "Reverse", popup_reverse_callback);
+ }
+
+ XmMenuPosition(basic_popup_menu, event);
+
+ sp = any_selected_sound();
+ if ((!sp) || (sp->nchans == 1))
+ XtUnmanageChild(popup_play);
+ else XtManageChild(popup_play);
+
+ XtManageChild(basic_popup_menu);
+}
+
+
+/* -------- selection popup -------- */
+
+static void popup_show_selection_callback(Widget w, XtPointer info, XtPointer context)
+{
+ show_selection();
+}
+
+static void popup_zero_selection_callback(Widget w, XtPointer info, XtPointer context)
+{
+ mus_float_t scl[1];
+ scl[0] = 0.0;
+ scale_by(NULL, scl, 1, OVER_SELECTION);
+}
+
+static void popup_normalize_selection_callback(Widget w, XtPointer info, XtPointer context)
+{
+ mus_float_t scl[1];
+ scl[0] = 1.0;
+ scale_to(NULL, NULL, scl, 1, OVER_SELECTION);
+}
+
+static void popup_error_handler(const char *msg, void *data)
+{
+ redirect_snd_error_to(NULL, NULL);
+ redirect_snd_warning_to(NULL, NULL);
+ status_report(any_selected_sound(), "%s: %s", (char *)data, msg);
+}
+
+static void popup_cut_to_new_callback_1(bool cut)
+{
+ char *temp_file;
+ io_error_t io_err = IO_NO_ERROR;
+
+ temp_file = snd_tempnam();
+ io_err = save_selection(temp_file, selection_srate(), default_output_sample_type(ss), default_output_header_type(ss), NULL, SAVE_ALL_CHANS);
+ if (io_err == IO_NO_ERROR)
+ {
+ if (cut) delete_selection(UPDATE_DISPLAY);
+
+ ss->open_requestor = FROM_POPUP_CUT_TO_NEW;
+ redirect_snd_error_to(popup_error_handler, (void *)"popup cut->new");
+ snd_open_file(temp_file, FILE_READ_WRITE);
+ redirect_snd_error_to(NULL, NULL);
+
+ free(temp_file);
+ }
+}
+
+static void popup_cut_to_new_callback(Widget w, XtPointer info, XtPointer context) {popup_cut_to_new_callback_1(true);}
+static void popup_copy_to_new_callback(Widget w, XtPointer info, XtPointer context) {popup_cut_to_new_callback_1(false);}
+
+static void crop(chan_info *cp)
+{
+ if (selection_is_active_in_channel(cp))
+ {
+ mus_long_t beg, end, framples;
+ framples = current_samples(cp);
+ beg = selection_beg(cp);
+ end = selection_end(cp);
+ if (beg > 0)
+ delete_samples(0, beg, cp, cp->edit_ctr);
+ if (end < (framples - 1))
+ delete_samples(end + 1, framples - end, cp, cp->edit_ctr);
+ }
+}
+
+static void popup_crop_callback(Widget w, XtPointer info, XtPointer context)
+{
+ for_each_chan(crop);
+}
+
+
+static void popup_cut_and_smooth_callback(Widget w, XtPointer info, XtPointer context)
+{
+ for_each_chan(cut_and_smooth);
+}
+
+static void mark_selection(chan_info *cp)
+{
+ if (selection_is_active_in_channel(cp))
+ {
+ add_mark(selection_beg(cp), NULL, cp);
+ add_mark(selection_end(cp), NULL, cp);
+ }
+}
+
+static void popup_mark_selection_callback(Widget w, XtPointer info, XtPointer context)
+{
+ for_each_chan(mark_selection);
+}
+
+static void popup_reverse_selection_callback(Widget w, XtPointer info, XtPointer context)
+{
+ reverse_sound(current_channel(), OVER_SELECTION, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
+}
+
+static mus_float_t selection_max = 0.0;
+
+static void selection_info(chan_info *cp)
+{
+ if ((selection_is_active_in_channel(cp)) &&
+ (selection_maxamp(cp) > selection_max))
+ selection_max = selection_maxamp(cp);
+}
+
+static void popup_selection_info_callback(Widget w, XtPointer info, XtPointer context)
+{
+ selection_max = 0.0;
+ for_each_chan(selection_info);
+ status_report(any_selected_sound(), "selection max: %f", selection_max);
+}
+
+#if WITH_AUDIO
+static void popup_loop_play_callback(Widget w, XtPointer info, XtPointer context)
+{
+ if (ss->selection_play_stop)
+ {
+ stop_playing_all_sounds(PLAY_BUTTON_UNSET);
+ reflect_play_selection_stop();
+ }
+ else
+ {
+ set_menu_label(edit_play_menu, I_STOP);
+ ss->selection_play_stop = true;
+ loop_play_selection();
+ }
+}
+#endif
+
+
+void post_selection_popup_menu(void *e)
+{
+ XButtonPressedEvent *event = (XButtonPressedEvent *)e;
+ if (!selection_popup_menu)
+ {
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNpopupEnabled, false); n++; /* this was XmPOPUP_AUTOMATIC_RECURSIVE */
+ selection_popup_menu = XmCreatePopupMenu(MAIN_PANE(ss), (char *)"selection-popup-menu", args, n);
+
+ add_menu_item(selection_popup_menu, "Fill window", popup_show_selection_callback);
+ add_menu_item(selection_popup_menu, "Cut", edit_cut_callback);
+ add_menu_item(selection_popup_menu, "Cut and smooth", popup_cut_and_smooth_callback);
+ add_menu_item(selection_popup_menu, "Cut -> new", popup_cut_to_new_callback);
+ add_menu_item(selection_popup_menu, "Save as", edit_save_as_callback);
+#if WITH_AUDIO
+ add_menu_item(selection_popup_menu, "Play", edit_play_callback);
+ add_menu_item(selection_popup_menu, "Play looping", popup_loop_play_callback);
+#endif
+ add_menu_item(selection_popup_menu, "Crop", popup_crop_callback);
+ add_menu_item(selection_popup_menu, "Unselect all", edit_unselect_callback);
+ add_menu_item(selection_popup_menu, "-> 0.0", popup_zero_selection_callback);
+ add_menu_item(selection_popup_menu, "-> 1.0", popup_normalize_selection_callback);
+ add_menu_item(selection_popup_menu, "Copy -> new", popup_copy_to_new_callback);
+ add_menu_item(selection_popup_menu, "Paste", edit_paste_callback);
+ add_menu_item(selection_popup_menu, "Mix", edit_mix_callback);
+ add_menu_item(selection_popup_menu, "Mark", popup_mark_selection_callback);
+ add_menu_item(selection_popup_menu, "Reverse", popup_reverse_selection_callback);
+ add_menu_item(selection_popup_menu, "Info", popup_selection_info_callback);
+ }
+
+ XmMenuPosition(selection_popup_menu, event);
+ XtManageChild(selection_popup_menu);
+}
+
+
+/* -------- fft popup -------- */
+
+static void popup_peaks_callback(Widget w, XtPointer info, XtPointer context)
+{
+ FILE *peaks_fd;
+ peaks_fd = FOPEN("fft.txt", "w");
+ if (peaks_fd)
+ {
+ write_transform_peaks(peaks_fd, current_channel()); /* follows sync */
+ fclose(peaks_fd);
+ }
+}
+
+static void fft_size_16_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(16);}
+static void fft_size_64_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(64);}
+static void fft_size_256_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(256);}
+static void fft_size_1024_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(1024);}
+static void fft_size_4096_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(4096);}
+static void fft_size_16384_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(16384);}
+static void fft_size_65536_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(65536);}
+static void fft_size_262144_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(262144);}
+static void fft_size_1048576_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(1048576);}
+
+
+static void fft_window_rectangular_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_RECTANGULAR_WINDOW);}
+static void fft_window_hann_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_HANN_WINDOW);}
+static void fft_window_welch_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_WELCH_WINDOW);}
+static void fft_window_parzen_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_PARZEN_WINDOW);}
+static void fft_window_bartlett_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BARTLETT_WINDOW);}
+static void fft_window_blackman2_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN2_WINDOW);}
+static void fft_window_blackman3_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN3_WINDOW);}
+static void fft_window_blackman4_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN4_WINDOW);}
+static void fft_window_hamming_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_HAMMING_WINDOW);}
+static void fft_window_exponential_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_EXPONENTIAL_WINDOW);}
+static void fft_window_riemann_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_RIEMANN_WINDOW);}
+static void fft_window_kaiser_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_KAISER_WINDOW);}
+static void fft_window_cauchy_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_CAUCHY_WINDOW);}
+static void fft_window_poisson_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_POISSON_WINDOW);}
+static void fft_window_gaussian_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_GAUSSIAN_WINDOW);}
+static void fft_window_tukey_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_TUKEY_WINDOW);}
+static void fft_window_dolph_chebyshev_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_DOLPH_CHEBYSHEV_WINDOW);}
+static void fft_window_blackman6_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN6_WINDOW);}
+static void fft_window_blackman8_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN8_WINDOW);}
+static void fft_window_blackman10_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN10_WINDOW);}
+
+static void fft_type_fourier_callback(Widget w, XtPointer info, XtPointer context) {set_transform_type(FOURIER);}
+static void fft_type_wavelet_callback(Widget w, XtPointer info, XtPointer context) {set_transform_type(WAVELET);}
+static void fft_type_autocorrelation_callback(Widget w, XtPointer info, XtPointer context) {set_transform_type(AUTOCORRELATION);}
+static void fft_type_cepstrum_callback(Widget w, XtPointer info, XtPointer context) {set_transform_type(CEPSTRUM);}
+
+
+static void fft_graph_once_callback(Widget w, XtPointer info, XtPointer context) {set_transform_graph_type(GRAPH_ONCE);}
+static void fft_graph_sonogram_callback(Widget w, XtPointer info, XtPointer context) {set_transform_graph_type(GRAPH_AS_SONOGRAM);}
+static void fft_graph_spectrogram_callback(Widget w, XtPointer info, XtPointer context) {set_transform_graph_type(GRAPH_AS_SPECTROGRAM);}
+
+
+static void fft_gray_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(GRAY_COLORMAP);}
+static void fft_hot_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(HOT_COLORMAP);}
+static void fft_cool_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(COOL_COLORMAP);}
+static void fft_bone_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(BONE_COLORMAP);}
+static void fft_copper_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(COPPER_COLORMAP);}
+static void fft_pink_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(PINK_COLORMAP);}
+static void fft_jet_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(JET_COLORMAP);}
+static void fft_prism_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(PRISM_COLORMAP);}
+static void fft_autumn_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(AUTUMN_COLORMAP);}
+static void fft_winter_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(WINTER_COLORMAP);}
+static void fft_spring_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(SPRING_COLORMAP);}
+static void fft_summer_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(SUMMER_COLORMAP);}
+static void fft_rainbow_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(RAINBOW_COLORMAP);}
+static void fft_flag_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(FLAG_COLORMAP);}
+static void fft_phases_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(PHASES_COLORMAP);}
+static void fft_black_and_white_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(BLACK_AND_WHITE_COLORMAP);}
+
+void post_fft_popup_menu(void *e)
+{
+ XButtonPressedEvent *event = (XButtonPressedEvent *)e;
+ if (!fft_popup_menu)
+ {
+ Widget outer_menu;
+ Arg args[20];
+ int n;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNpopupEnabled, false); n++; /* this was XmPOPUP_AUTOMATIC_RECURSIVE */
+ fft_popup_menu = XmCreatePopupMenu(MAIN_PANE(ss), (char *)"fft-popup-menu", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Size", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
+ XtCreateManagedWidget("Size", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
+
+ add_menu_item(outer_menu, "16", fft_size_16_callback);
+ add_menu_item(outer_menu, "64", fft_size_64_callback);
+ add_menu_item(outer_menu, "256", fft_size_256_callback);
+ add_menu_item(outer_menu, "1024", fft_size_1024_callback);
+ add_menu_item(outer_menu, "4096", fft_size_4096_callback);
+ add_menu_item(outer_menu, "16384", fft_size_16384_callback);
+ add_menu_item(outer_menu, "65536", fft_size_65536_callback);
+ add_menu_item(outer_menu, "262144", fft_size_262144_callback);
+ add_menu_item(outer_menu, "1048576", fft_size_1048576_callback);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Window", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
+ XtCreateManagedWidget("Window", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
+
+ add_menu_item(outer_menu, "rectangular", fft_window_rectangular_callback);
+ add_menu_item(outer_menu, "hann", fft_window_hann_callback);
+ add_menu_item(outer_menu, "welch", fft_window_welch_callback);
+ add_menu_item(outer_menu, "parzen", fft_window_parzen_callback);
+ add_menu_item(outer_menu, "bartlett", fft_window_bartlett_callback);
+ add_menu_item(outer_menu, "hamming", fft_window_hamming_callback);
+ add_menu_item(outer_menu, "blackman2", fft_window_blackman2_callback);
+ add_menu_item(outer_menu, "blackman3", fft_window_blackman3_callback);
+ add_menu_item(outer_menu, "blackman4", fft_window_blackman4_callback);
+ add_menu_item(outer_menu, "exponential", fft_window_exponential_callback);
+ add_menu_item(outer_menu, "riemann", fft_window_riemann_callback);
+ add_menu_item(outer_menu, "kaiser", fft_window_kaiser_callback);
+ add_menu_item(outer_menu, "cauchy", fft_window_cauchy_callback);
+ add_menu_item(outer_menu, "poisson", fft_window_poisson_callback);
+ add_menu_item(outer_menu, "gaussian", fft_window_gaussian_callback);
+ add_menu_item(outer_menu, "tukey", fft_window_tukey_callback);
+ add_menu_item(outer_menu, "dolph-chebyshev", fft_window_dolph_chebyshev_callback);
+ add_menu_item(outer_menu, "blackman6", fft_window_blackman6_callback);
+ add_menu_item(outer_menu, "blackman8", fft_window_blackman8_callback);
+ add_menu_item(outer_menu, "blackman10" , fft_window_blackman10_callback);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Graph type", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
+ XtCreateManagedWidget("Graph type", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
+
+ add_menu_item(outer_menu, "one fft", fft_graph_once_callback);
+ add_menu_item(outer_menu, "sonogram", fft_graph_sonogram_callback);
+ add_menu_item(outer_menu, "spectrogram", fft_graph_spectrogram_callback);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Transform type", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
+ XtCreateManagedWidget("Transform type", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
+
+ add_menu_item(outer_menu, "fourier", fft_type_fourier_callback);
+ add_menu_item(outer_menu, "wavelet", fft_type_wavelet_callback);
+ add_menu_item(outer_menu, "autocorrelation", fft_type_autocorrelation_callback);
+ add_menu_item(outer_menu, "cepstrum", fft_type_cepstrum_callback);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Colormap", args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
+ XtCreateManagedWidget("Colormap", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
+
+ add_menu_item(outer_menu, "gray", fft_gray_callback);
+ add_menu_item(outer_menu, "autumn", fft_autumn_callback);
+ add_menu_item(outer_menu, "spring", fft_spring_callback);
+ add_menu_item(outer_menu, "winter", fft_winter_callback);
+ add_menu_item(outer_menu, "summer", fft_summer_callback);
+ add_menu_item(outer_menu, "cool", fft_cool_callback);
+ add_menu_item(outer_menu, "copper", fft_copper_callback);
+ add_menu_item(outer_menu, "flag", fft_flag_callback);
+ add_menu_item(outer_menu, "prism", fft_prism_callback);
+ add_menu_item(outer_menu, "bone", fft_bone_callback);
+ add_menu_item(outer_menu, "hot", fft_hot_callback);
+ add_menu_item(outer_menu, "jet", fft_jet_callback);
+ add_menu_item(outer_menu, "pink", fft_pink_callback);
+ add_menu_item(outer_menu, "rainbow", fft_rainbow_callback);
+ add_menu_item(outer_menu, "phases", fft_phases_callback);
+ add_menu_item(outer_menu, "black and white", fft_black_and_white_callback);
+
+
+ add_menu_item(fft_popup_menu, "Peaks->fft.txt", popup_peaks_callback);
+ }
+
+ XmMenuPosition(fft_popup_menu, event);
+ XtManageChild(fft_popup_menu);
+}
+
+
+
+void post_lisp_popup_menu(void *e) {}
+
+
+
+
+/* ---------------- tooltips ---------------- */
+
+static Widget tooltip_shell = NULL;
+static Widget tooltip_label = NULL;
+static timeout_result_t tool_proc = 0, quit_proc = 0;
+static Time tool_last_time = 0;
+static Position tool_x, tool_y;
+static Widget tool_w;
+
+static void leave_tooltip(XtPointer tooltip, XtIntervalId *id)
+{
+ XtUnmanageChild(tooltip_shell);
+ quit_proc = 0;
+}
+
+
+static void handle_tooltip(XtPointer tooltip, XtIntervalId *id)
+{
+ char *tip = (char *)tooltip;
+ Position rx, ry;
+ XmString str;
+ int lines = 0;
+
+ if (!tooltip_shell)
+ {
+ tooltip_shell = XtVaCreatePopupShell(tip, overrideShellWidgetClass, MAIN_SHELL(ss),
+ XmNallowShellResize, true,
+ NULL);
+ tooltip_label = XtVaCreateManagedWidget("tooltip", xmLabelWidgetClass, tooltip_shell,
+ XmNrecomputeSize, true,
+ XmNbackground, ss->lighter_blue,
+ NULL);
+ }
+ str = multi_line_label(tip, &lines);
+ XtVaSetValues(tooltip_label, XmNlabelString, str, NULL);
+ XmStringFree(str);
+
+ XtTranslateCoords(tool_w, tool_x, tool_y, &rx, &ry);
+ XtVaSetValues(tooltip_shell, XmNx, rx, XmNy, ry, NULL);
+ XtManageChild(tooltip_shell);
+ quit_proc = XtAppAddTimeOut(MAIN_APP(ss), (unsigned long)10000, (XtTimerCallbackProc)leave_tooltip, NULL);
+}
+
+
+static void tool_starter(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XEnterWindowEvent *ev = (XEnterWindowEvent *)event;
+ char *tip = (char *)context;
+ if ((with_tooltips(ss)) &&
+ ((ev->time - tool_last_time) > 2))
+ {
+ tool_x = ev->x;
+ tool_y = ev->y;
+ tool_w = w;
+ tool_last_time = ev->time;
+ tool_proc = XtAppAddTimeOut(MAIN_APP(ss), (unsigned long)300, (XtTimerCallbackProc)handle_tooltip, (XtPointer)tip);
+ }
+}
+
+
+static void tool_stopper(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XLeaveWindowEvent *ev = (XLeaveWindowEvent *)event;
+ tool_last_time = ev->time;
+ if (tool_proc != 0)
+ {
+ XtRemoveTimeOut(tool_proc);
+ tool_proc = 0;
+ }
+ if (quit_proc != 0)
+ {
+ XtRemoveTimeOut(quit_proc);
+ quit_proc = 0;
+ }
+ if ((tooltip_shell) && (XtIsManaged(tooltip_shell)))
+ XtUnmanageChild(tooltip_shell);
+}
+
+
+void add_tooltip(Widget w, const char *tip)
+{
+ XtAddEventHandler(w, EnterWindowMask, false, tool_starter, (XtPointer)tip);
+ XtAddEventHandler(w, LeaveWindowMask, false, tool_stopper, NULL);
+}
+
+
+
+/* ---------------- toolbar ---------------- */
+
+static void add_to_toolbar(Widget bar, Pixmap icon, const char *tip, void (*callback)(Widget w, XtPointer info, XtPointer context))
+{
+ Widget w;
+ w = XtVaCreateManagedWidget("icon", xmPushButtonWidgetClass, bar,
+ XmNlabelPixmap, icon,
+ XmNlabelType, XmPIXMAP,
+ XmNwidth, 24,
+ XmNheight, 24,
+ XmNshadowThickness, 0,
+ XmNhighlightThickness, 0,
+ /* XmNmarginHeight, 0, */
+ XmNbackground, ss->basic_color,
+ NULL);
+ XtAddCallback(w, XmNactivateCallback, callback, NULL);
+ add_tooltip(w, tip);
+}
+
+
+static void add_separator_to_toolbar(Widget bar)
+{
+ XtVaCreateManagedWidget("icon", xmPushButtonWidgetClass, bar,
+ XmNlabelPixmap, toolbar_icon(SND_XPM_SEPARATOR),
+ XmNlabelType, XmPIXMAP,
+ XmNwidth, 8,
+ XmNheight, 24,
+ XmNshadowThickness, 0,
+ XmNhighlightThickness, 0,
+ XmNbackground, ss->basic_color,
+ NULL);
+}
+
+
+#if WITH_AUDIO
+static void play_from_start_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ play_sound(sp, 0, NO_END_SPECIFIED);
+}
+
+
+static void play_from_cursor_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ chan_info *cp;
+ cp = any_selected_channel(sp);
+ if (cp)
+ play_sound(sp, cursor_sample(cp), NO_END_SPECIFIED);
+ }
+}
+
+
+static void stop_playing_callback(Widget w, XtPointer info, XtPointer context)
+{
+ stop_playing_all_sounds(PLAY_C_G);
+ reflect_play_selection_stop(); /* this sets ss->selection_play_stop = false; */
+}
+#endif
+
+
+static void full_dur_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ int i;
+ for (i = 0; i < sp->nchans; i++)
+ set_x_axis_x0x1(sp->chans[i], 0.0, sp->chans[i]->axis->xmax);
+ }
+}
+
+
+static void zoom_out_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ int i;
+ for (i = 0; i < sp->nchans; i++)
+ zx_incremented(sp->chans[i], 2.0);
+ }
+}
+
+
+static void zoom_in_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ int i;
+ for (i = 0; i < sp->nchans; i++)
+ zx_incremented(sp->chans[i], 0.5);
+ }
+}
+
+
+static void goto_start_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ int i;
+ for (i = 0; i < sp->nchans; i++)
+ set_x_axis_x0x1(sp->chans[i], 0.0, sp->chans[i]->axis->x1 - sp->chans[i]->axis->x0);
+ }
+}
+
+static void go_back_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ int i;
+ for (i = 0; i < sp->nchans; i++)
+ sx_incremented(sp->chans[i], -1.0);
+ }
+}
+
+
+static void go_forward_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ int i;
+ for (i = 0; i < sp->nchans; i++)
+ sx_incremented(sp->chans[i], 1.0);
+ }
+}
+
+static void goto_end_callback(Widget w, XtPointer info, XtPointer context)
+{
+ snd_info *sp;
+ sp = any_selected_sound();
+ if (sp)
+ {
+ int i;
+ for (i = 0; i < sp->nchans; i++)
+ set_x_axis_x0x1(sp->chans[i], sp->chans[i]->axis->xmax - sp->chans[i]->axis->x1 + sp->chans[i]->axis->x0, sp->chans[i]->axis->xmax);
+ }
+}
+
+
+
+static Widget toolbar = NULL;
+
+void show_toolbar(void)
+{
+ if (!toolbar)
+ {
+ #define ICON_HEIGHT 28
+ Arg args[32];
+ int n;
+
+ XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
+
+ n = attach_all_sides(args, 0);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNheight, ICON_HEIGHT); n++;
+ XtSetArg(args[n], XmNpaneMaximum, ICON_HEIGHT); n++; /* Xm/Paned initializes each pane max to 1000 apparently! */
+ XtSetArg(args[n], XmNpositionIndex, 0); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+
+ if ((sound_style(ss) == SOUNDS_IN_NOTEBOOK) ||
+ (sound_style(ss) == SOUNDS_HORIZONTAL))
+ toolbar = XtCreateManagedWidget("toolbar", xmRowColumnWidgetClass, SOUND_PANE_BOX(ss), args, n);
+ else toolbar = XtCreateManagedWidget("toolbar", xmRowColumnWidgetClass, SOUND_PANE(ss), args, n);
+ ss->toolbar = toolbar;
+
+ if (auto_resize(ss))
+ XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
+
+ make_toolbar_icons(MAIN_SHELL(ss));
+
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_NEW), "new sound", file_new_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_OPEN), "open sound", file_open_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_SAVE), "save current sound, overwriting it", file_save_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_SAVE_AS), "save current sound in a new file", file_save_as_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_REVERT), "revert to saved", file_revert_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_UNDO), "undo edit", edit_undo_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_REDO), "redo last (undone) edit", edit_redo_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_CLOSE), "close selected sound", file_close_callback);
+ add_separator_to_toolbar(toolbar);
+
+#if WITH_AUDIO
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_PLAY), "play from the start", play_from_start_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_CURSOR_PLAY), "play from the cursor", play_from_cursor_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_STOP_PLAY), "stop playing", stop_playing_callback);
+ add_separator_to_toolbar(toolbar);
+#endif
+
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_UP), "show full sound", full_dur_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_ZOOM_OUT), "zoom out", zoom_out_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_ZOOM_IN), "zoom in", zoom_in_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_BACK_ARROW), "go to start of sound", goto_start_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_BACK), "go back a window", go_back_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_NEXT), "go forward a window", go_forward_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_FORWARD_ARROW), "go to end of sound", goto_end_callback);
+ add_separator_to_toolbar(toolbar);
+
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_CUT), "delete selection", edit_cut_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_PASTE), "insert selection at cursor", edit_paste_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_PREFERENCES), "open preferences dialog", options_preferences_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_STOP), "stop the current operation", stop_everything_callback);
+ add_to_toolbar(toolbar, toolbar_icon(SND_XPM_EXIT), "exit Snd", file_exit_callback);
+
+ }
+ else
+ {
+ XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
+ XtManageChild(toolbar);
+ if (auto_resize(ss))
+ XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
+ }
+}
+
+
+void hide_toolbar(void)
+{
+ if (toolbar)
+ {
+ XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
+ XtUnmanageChild(toolbar);
+ if (auto_resize(ss))
+ XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
+ }
+}
+
+
+
+
+/* ---------------- ext lang tie-ins ---------------- */
+
+#define INVALID_MENU -1
+#define call_index(Data) (Data >> 16)
+#define pack_menu_data(Slot, Menu) ((Slot << 16) | (Menu))
+
+static void menu_callback(Widget w, XtPointer info, XtPointer context)
+{
+ pointer_or_int_t callb;
+ XtVaGetValues(w, XmNuserData, &callb, NULL);
+ g_menu_callback(call_index(callb)); /* menu option activate callback */
+}
+
+
+static void GHC_callback(Widget w, XtPointer info, XtPointer context)
+{
+ pointer_or_int_t slot;
+ XtVaGetValues(w, XmNuserData, &slot, NULL);
+ g_menu_callback(call_index(slot)); /* main menu cascading callback */
+}
+
+
+static Widget *main_menus = NULL;
+static int main_menus_size = 0;
+/* fancy code here looping through the main menus children hangs or segfaults in 86_64 unoptimized cases! */
+
+Widget menu_widget(int which_menu)
+{
+ switch (which_menu)
+ {
+ case 0: return(file_menu); break;
+ case 1: return(edit_menu); break;
+ case 2: return(view_menu); break;
+ case 3: return(options_menu); break;
+ case 4: return(help_menu); break;
+
+ default:
+ if (which_menu < main_menus_size)
+ return(main_menus[which_menu]);
+ break;
+ }
+ return(NULL);
+}
+
+
+static bool or_over_children(Widget w, bool (*func)(Widget uw, const char *ustr), const char *str)
+{
+ if (w)
+ {
+ if ((*func)(w, str)) return(true);
+ if (XtIsComposite(w))
+ {
+ unsigned int i;
+ CompositeWidget cw = (CompositeWidget)w;
+ for (i = 0; i < cw->composite.num_children; i++)
+ if (or_over_children(cw->composite.children[i], func, str))
+ return(true);
+ }
+ }
+ return(false);
+}
+
+
+static bool clobber_menu(Widget w, const char *name)
+{
+ char *wname;
+ wname = XtName(w);
+ if ((wname) &&
+ (mus_strcmp(name, wname)) &&
+ (XtIsManaged(w)))
+ {
+ pointer_or_int_t slot;
+ XtVaGetValues(w, XmNuserData, &slot, NULL);
+ unprotect_callback(call_index(slot));
+ XtUnmanageChild(w);
+ }
+ return(true); /* in any case, don't try to recurse into the children */
+}
+
+
+int g_remove_from_menu(int which_menu, const char *label)
+{
+ Widget top_menu;
+ top_menu = menu_widget(which_menu);
+ if (top_menu)
+ {
+ or_over_children(top_menu, clobber_menu, label);
+ return(0);
+ }
+ return(INVALID_MENU);
+}
+
+
+static void set_widget_name(Widget w, const char *new_name)
+{
+ /* based on XtName in Xt/Intrinsic.c, Xt/Create.c, and Xt/ResourceI.h */
+ w->core.xrm_name = XrmStringToName(new_name);
+}
+
+
+static int new_menu = 5;
+
+int g_add_to_main_menu(const char *label, int slot)
+{
+ static Arg args[12];
+ Widget m, cas;
+ int n;
+
+ if (auto_resize(ss)) XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
+ new_menu++;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNuserData, pack_menu_data(slot, new_menu)); n++;
+ m = XmCreatePulldownMenu(main_menu, (char *)label, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNsubMenuId, m); n++;
+ XtSetArg(args[n], XmNuserData, pack_menu_data(slot, new_menu)); n++;
+ cas = XtCreateManagedWidget(label, xmCascadeButtonWidgetClass, main_menu, args, n);
+ if (slot >= 0) XtAddCallback(cas, XmNcascadingCallback, GHC_callback, NULL);
+
+ if (auto_resize(ss)) XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
+
+ if (main_menus_size == 0)
+ {
+ main_menus_size = 8;
+ main_menus = (Widget *)calloc(main_menus_size, sizeof(Widget));
+ }
+ else
+ {
+ if (new_menu >= main_menus_size)
+ {
+ main_menus_size = new_menu + 8;
+ main_menus = (Widget *)realloc(main_menus, main_menus_size * sizeof(Widget));
+ }
+ }
+ main_menus[new_menu] = m;
+ return(new_menu);
+}
+
+
+Widget g_add_to_menu(int which_menu, const char *label, int callb, int position)
+{
+ Widget m, menw;
+ Arg args[12];
+ int n = 0;
+ menw = menu_widget(which_menu);
+ if (menw == NULL) return(NULL);
+ if (label)
+ {
+ unsigned int i;
+ /* look for currently unused widget first */
+ /* but close-all and open-recent should be left alone! */
+ CompositeWidget cw = (CompositeWidget)menw;
+ for (i = 0; i < cw->composite.num_children; i++)
+ {
+ m = cw->composite.children[i];
+ if ((m) &&
+ (!(XtIsManaged(m))) &&
+ (m != file_close_all_menu) &&
+ (m != file_open_recent_menu) &&
+ (m != file_open_recent_cascade_menu))
+ {
+ if (!(mus_strcmp(XtName(m), label)))
+ {
+ set_widget_name(m, label);
+ set_button_label(m, label);
+ }
+ if (position >= 0) XtVaSetValues(m, XmNpositionIndex, position, NULL);
+ XtVaSetValues(m, XmNuserData, pack_menu_data(callb, which_menu), NULL);
+ XtManageChild(m);
+ return(m);
+ }
+ }
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ if (position >= 0) {XtSetArg(args[n], XmNpositionIndex, position); n++;}
+ XtSetArg(args[n], XmNuserData, pack_menu_data(callb, which_menu)); n++;
+ m = XtCreateManagedWidget(label, xmPushButtonWidgetClass, menw, args, n);
+ XtAddCallback(m, XmNactivateCallback, menu_callback, NULL);
+ }
+ else
+ {
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ if (position >= 0) {XtSetArg(args[n], XmNpositionIndex, position); n++;}
+ m = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, menw, args, n);
+ }
+ return(m);
+}
+
+
+static Xen g_menu_widgets(void)
+{
+ #define H_menu_widgets "(" S_menu_widgets "): a list of top level menu widgets: ((0)main (1)file (2)edit (3)view (4)options (5)help)"
+ return(Xen_cons(Xen_wrap_widget(main_menu),
+ Xen_cons(Xen_wrap_widget(file_cascade_menu),
+ Xen_cons(Xen_wrap_widget(edit_cascade_menu),
+ Xen_cons(Xen_wrap_widget(view_cascade_menu),
+ Xen_cons(Xen_wrap_widget(options_cascade_menu),
+ Xen_cons(Xen_wrap_widget(help_cascade_menu),
+ Xen_empty_list)))))));
+}
+
+
+Xen_wrap_no_args(g_menu_widgets_w, g_menu_widgets)
+
+void g_init_gxmenu(void)
+{
+ Xen_define_safe_procedure(S_menu_widgets, g_menu_widgets_w, 0, 0, 0, H_menu_widgets);
+}
+
+/* Motif bug: the button backgrounds remain in the original highlight color? but the widget (if it is one) is not the child of any obvious widget
+ */
+
+
+/* motif case needs prompt length fixups, listener if no panes, minibuffer as label not text entry
+ */
+
+/* ---------------- listener text history ---------------- */
+
+static char **listener_strings = NULL;
+static int listener_strings_size = 0, listener_strings_pos = 0;
+static bool listener_first_time = true;
+
+static void remember_listener_string(const char *str)
+{
+ int i, top;
+ if (!str) return;
+
+ if (listener_strings_size == 0)
+ {
+ listener_strings_size = 8;
+ listener_strings = (char **)calloc(listener_strings_size, sizeof(char *));
+ }
+
+ listener_strings_pos = 0;
+ listener_first_time = true;
+
+ /* if str matches current history top entry, ignore it (as in tcsh) */
+ if ((listener_strings[0]) &&
+ (mus_strcmp(str, listener_strings[0])))
+ return;
+
+ top = listener_strings_size - 1;
+ if (listener_strings[top]) free(listener_strings[top]);
+ for (i = top; i > 0; i--) listener_strings[i] = listener_strings[i - 1];
+
+ listener_strings[0] = mus_strdup(str);
+}
+
+
+static void restore_listener_string(bool back)
+{
+ if (listener_strings)
+ {
+ char *str;
+ if (!(listener_first_time))
+ {
+ if (back)
+ listener_strings_pos++;
+ else listener_strings_pos--;
+ }
+ listener_first_time = false;
+ if (listener_strings_pos < 0) listener_strings_pos = 0;
+ if (listener_strings_pos > (listener_strings_size - 1)) listener_strings_pos = listener_strings_size - 1;
+ str = listener_strings[listener_strings_pos];
+ if (str)
+ append_listener_text(-1, str);
+ }
+}
+
+static bool is_prompt(const char *str, int beg)
+{
+ int i, j;
+ /* fprintf(stderr, "check %s %s for %d at %d\n", str, ss->Listener_Prompt, ss->listener_prompt_length, beg); */
+
+ for (i = beg, j = ss->listener_prompt_length - 1; (i >= 0) && (j >= 0); i--, j--)
+ if (str[i] != ss->Listener_Prompt[j])
+ {
+ /* fprintf(stderr, "%c != %c at %d\n", str[i], ss->Listener_Prompt[j], j); */
+ return(false);
+ }
+ if (j != -1)
+ {
+ /* fprintf(stderr, "j: %d\n", j); */
+ return(false);
+ }
+ if ((i == -1) || (str[i] == '\n'))
+ {
+ /* fprintf(stderr, "found prompt!\n"); */
+ return(true);
+ }
+ /* fprintf(stderr, "i: %d, str[i]: %c\n", i, str[i]); */
+ return(false);
+}
+
+
+static void listener_help_at_cursor(char *buf, int name_curpos, int len, int prompt_pos)
+{
+ int i, name_start, name_end;
+
+ if (isspace(buf[name_curpos]))
+ {
+ for (i = name_curpos - 1; i >= 0; i--)
+ if ((!isspace(buf[i])) &&
+ (buf[i] != '(') &&
+ (buf[i] != ')'))
+ break;
+ if (i > 0)
+ name_curpos = i;
+ }
+
+ for (i = name_curpos; i >= 0; i--)
+ if ((isspace(buf[i])) ||
+ (buf[i] == '(') ||
+ (buf[i] == ')'))
+ break;
+ name_start = i + 1;
+
+ for (i = name_curpos + 1; i < len; i++)
+ if ((isspace(buf[i])) ||
+ (buf[i] == '(') ||
+ (buf[i] == ')'))
+ break;
+ name_end = i - 1;
+
+ if (name_end > name_start)
+ {
+ char *new_text;
+
+ buf[name_end + 1] = '\0';
+ new_text = direct_completions((char *)(buf + name_start));
+
+ if (new_text)
+ {
+ int matches;
+ matches = get_possible_completions_size();
+
+ if (matches == 1)
+ {
+ Xen help;
+ help = g_snd_help(C_string_to_Xen_string(new_text), 0);
+ if (Xen_is_string(help))
+ snd_help((char *)(buf + name_start), Xen_string_to_C_string(help), WITH_WORD_WRAP);
+ }
+ else
+ {
+ if (matches > 1)
+ {
+ char **buffer;
+ char *help_str;
+ int match_len = 0;
+
+ buffer = get_possible_completions();
+ for (i = 0; i < matches; i++)
+ match_len += mus_strlen(buffer[i]);
+
+ help_str = (char *)calloc(match_len + matches * 8, sizeof(char));
+ for (i = 0; i < matches; i++)
+ {
+ strcat(help_str, buffer[i]);
+ strcat(help_str, "\n");
+ }
+ snd_help((char *)(buf + name_start), help_str, WITHOUT_WORD_WRAP);
+ free(help_str);
+ }
+ }
+ free(new_text);
+ }
+ }
+}
+
+
+static bool within_prompt(const char *str, int beg, int end)
+{
+ /* search backwards up to prompt length for cr (or 0), check for prompt */
+ int i, lim;
+ if ((beg + 1 == end) && (str[beg] == '\n')) return(false); /* end-of-page cr within double quotes probably */
+ lim = beg - ss->listener_prompt_length;
+ if (lim < 0) return(true);
+ for (i = beg; i >= lim; i--)
+ if ((str[i] == '\n') || (i == 0))
+ {
+ int j, k;
+ for (j = 0, k = i + 1; (j < ss->listener_prompt_length) && (k < end); j++, k++)
+ if (str[k] != ss->Listener_Prompt[j])
+ return(false);
+ return(true);
+ }
+ return(false);
+}
+
+
+static char *trim(char *orig)
+{
+ int i, j, start = -1, end = -1, len;
+ char *str;
+
+ len = mus_strlen(orig);
+ if (len == 0) return(NULL);
+
+ for (start = 0; start < len; start++)
+ if ((!isspace(orig[start])) &&
+ (orig[start] != '(') &&
+ (orig[start] != ')'))
+ break;
+ if (start >= len) return(NULL);
+ for (end = len - 1; end > start; end--)
+ if ((!isspace(orig[end])) &&
+ (orig[end] != '(') &&
+ (orig[end] != ')'))
+ break;
+ if (start == end) return(NULL);
+
+ len = end - start + 1;
+ str = (char *)calloc(len + 1, sizeof(char));
+ for (i = start, j = 0; i <= end; i++, j++)
+ str[j] = orig[i];
+ return(str);
+}
+
+
+static int find_matching_paren(const char *str, int parens, int pos, int *highlight_pos)
+{
+ int i, j;
+ bool quoting = false;
+ int up_comment = -1;
+ for (i = pos - 1; i > 0;)
+ {
+ if (is_prompt(str, i))
+ break;
+ if (str[i] == '\"')
+ {
+ /* there could be any number of slashified slashes before this quote. */
+ int k, slashes = 0;
+ for (k = i - 1; k >= 0; k--)
+ {
+ if (str[k] == '\\')
+ slashes++;
+ else break;
+ }
+ if ((slashes & 1) == 0)
+ quoting = !quoting;
+ }
+ if (!quoting)
+ {
+ if ((i <= 1) || (str[i - 1] != '\\') || (str[i - 2] != '#'))
+ {
+ if (str[i] == ')') parens++; else
+ if (str[i] == '(') parens--; else
+ if (str[i] == '\n')
+ {
+ /* check for comment on next line up */
+ bool up_quoting = false;
+ int quote_comment = -1;
+ for (j = i - 1; j > 0; j--)
+ {
+ if (str[j] == '\n') break;
+ if ((str[j] == '\"') && (str[j - 1] != '\\'))
+ up_quoting = !up_quoting;
+ if ((str[j] == ';') &&
+ ((j <= 1) || (str[j - 1] != '\\') || (str[j - 2] != '#')))
+ {
+ if (!up_quoting)
+ up_comment = j;
+ else quote_comment = j;
+ }
+ }
+ if (up_comment < i)
+ {
+ if (up_comment > 0)
+ i = up_comment;
+ else
+ {
+ if ((up_quoting) && (quote_comment > 0))
+ i = quote_comment;
+ }
+ }
+ }
+ }
+ }
+ if (parens == 0)
+ {
+ (*highlight_pos) = i;
+ break;
+ }
+ i--;
+ }
+ return(parens);
+}
+
+#if (!HAVE_RUBY) && (!HAVE_FORTH)
+static bool highlight_unbalanced_paren(void);
+
+static int check_balance(const char *expr, int start, int end, bool in_listener)
+{
+ int i;
+ bool not_whitespace = false;
+ int paren_count = 0;
+ bool prev_separator = true;
+ bool quote_wait = false;
+
+ i = start;
+ while (i < end)
+ {
+ switch (expr[i])
+ {
+ case ';' :
+ /* skip till newline. */
+ do {
+ i++;
+ } while ((expr[i] != '\n') && (i < end));
+ break;
+
+ case ' ':
+ case '\n':
+ case '\t':
+ case '\r':
+ if ((not_whitespace) && (paren_count == 0) && (!quote_wait))
+ return(i);
+ else
+ {
+ prev_separator = true;
+ i++;
+ }
+ break;
+
+ case '\"' :
+ if ((not_whitespace) && (paren_count == 0) && (!quote_wait))
+ return(i);
+ else
+ {
+ /* skip past ", ignoring \", some cases:
+ * "\"\"" '("\"\"") "\\" "#\\(" "'(\"#\\\")"
+ */
+ while (i < end)
+ {
+ i++;
+ if (expr[i] == '\\')
+ i++;
+ else
+ {
+ if (expr[i] == '\"')
+ break;
+ }
+ }
+ i++;
+ if (paren_count == 0)
+ {
+ if (i < end)
+ return(i);
+ else return(0);
+ }
+ else
+ {
+ prev_separator = true;
+ not_whitespace = true;
+ quote_wait = false;
+ }
+ }
+ break;
+
+ case '#':
+ if ((i < end - 1) &&
+ (expr[i + 1] == '|'))
+ {
+ /* (+ #| a comment |# 2 1) */
+ i++;
+ do {
+ i++;
+ } while (((expr[i] != '|') || (expr[i + 1] != '#')) && (i < end));
+ i++;
+ break;
+ }
+ else
+ {
+ /* (set! *#readers* (cons (cons #\c (lambda (str) (apply make-rectangular (read)))) *#readers*))
+ */
+ if ((not_whitespace) && (paren_count == 0) && (!quote_wait))
+ return(i);
+ else
+ {
+ bool found_it = false;
+ if (prev_separator)
+ {
+ int k, incr = 0;
+ for (k = i + 1; k < end; k++)
+ {
+ if (expr[k] == '(')
+ {
+ /* should we look at the readers here? I want to support #c(1 2) for example */
+ not_whitespace = false;
+ prev_separator = false;
+ incr = k - i;
+ break;
+ }
+ else
+ {
+ if ((!isdigit(expr[k])) && /* #2d(...)? */
+ (!isalpha(expr[k])) && /* #c(1 2)? */
+ (expr[k] != 'D') &&
+ (expr[k] != 'd') &&
+ (expr[k] != '=') && /* what is this for? */
+ (expr[k] != '#')) /* perhaps #1d(#(1 2) 3) ? */
+ break;
+ }
+ }
+ if (incr > 0)
+ {
+ i += incr;
+ found_it = true;
+ }
+ }
+ if (!found_it)
+ {
+ if ((i + 2 < end) && (expr[i + 1] == '\\') &&
+ ((expr[i + 2] == ')') || (expr[i + 2] == ';') || (expr[i + 2] == '\"') || (expr[i + 2] == '(')))
+ i += 3;
+ else
+ {
+ prev_separator = false;
+ quote_wait = false;
+ not_whitespace = true;
+ i++;
+ }
+ }
+ }
+ }
+ break;
+
+ case '(' :
+ if ((not_whitespace) && (paren_count == 0) && (!quote_wait))
+ return(i - 1); /* 'a(...) -- ignore the (...) */
+ else
+ {
+ i++;
+ paren_count++;
+ not_whitespace = true;
+ prev_separator = true;
+ quote_wait = false;
+ }
+ break;
+
+ case ')' :
+ paren_count--;
+ if ((not_whitespace) && (paren_count == 0))
+ return(i + 1);
+ else
+ {
+ i++;
+ not_whitespace = true;
+ prev_separator = true;
+ quote_wait = false;
+ }
+ break;
+
+ case '\'' :
+ case '`' : /* `(1 2) */
+ if (prev_separator)
+ quote_wait = true;
+ not_whitespace = true;
+ i++;
+ break;
+
+ case ',': /* `,(+ 1 2) */
+ case '@': /* `,@(list 1 2) */
+ prev_separator = false;
+ not_whitespace = true;
+ i++;
+ break;
+
+ default:
+ prev_separator = false;
+ quote_wait = false;
+ not_whitespace = true;
+ i++;
+ break;
+ }
+ }
+
+ if ((in_listener) && (!(highlight_unbalanced_paren())))
+ return(-1);
+ return(0);
+}
+#endif
+
+static char listener_prompt_buffer[LABEL_BUFFER_SIZE];
+
+static char *listener_prompt_with_cr(void)
+{
+ snprintf(listener_prompt_buffer, LABEL_BUFFER_SIZE, "\n%s", listener_prompt(ss));
+ return(listener_prompt_buffer);
+}
+
+#define GUI_TEXT_END(w) XmTextGetLastPosition(w)
+#define GUI_TEXT_POSITION_TYPE XmTextPosition
+#define GUI_TEXT(w) XmTextGetString(w)
+#define GUI_TEXT_INSERTION_POSITION(w) XmTextGetInsertionPosition(w)
+#define GUI_TEXT_SET_INSERTION_POSITION(w, pos) XmTextSetInsertionPosition(w, pos)
+#define GUI_LISTENER_TEXT_INSERT(w, pos, text) XmTextInsert(w, pos, text)
+#define GUI_FREE(w) XtFree(w)
+#define GUI_SET_CURSOR(w, cursor) XUndefineCursor(XtDisplay(w), XtWindow(w)); XDefineCursor(XtDisplay(w), XtWindow(w), cursor)
+#define GUI_UNSET_CURSOR(w, cursor) XUndefineCursor(XtDisplay(w), XtWindow(w)); XDefineCursor(XtDisplay(w), XtWindow(w), None)
+#define GUI_UPDATE(w) XmUpdateDisplay(w)
+#define GUI_TEXT_GOTO(w, pos) XmTextShowPosition(w, pos)
+
+
+static int current_listener_position = -1, listener_positions_size = 0;
+static int *listener_positions = NULL;
+
+
+static void add_listener_position(int pos)
+{
+ if (listener_positions_size == 0)
+ {
+ listener_positions_size = 32;
+ listener_positions = (int *)calloc(listener_positions_size, sizeof(int));
+ current_listener_position = 0;
+ }
+ else
+ {
+ int i;
+ if (pos > listener_positions[current_listener_position])
+ {
+ current_listener_position++;
+ if (current_listener_position >= listener_positions_size)
+ {
+ listener_positions_size += 32;
+ listener_positions = (int *)realloc(listener_positions, listener_positions_size * sizeof(int));
+ for (i = current_listener_position + 1; i < listener_positions_size; i++) listener_positions[i] = 0;
+ }
+ }
+ else
+ {
+ for (i = current_listener_position - 1; i >= 0; i--)
+ if (listener_positions[i] < pos)
+ break;
+ current_listener_position = i + 1;
+ }
+ }
+ listener_positions[current_listener_position] = pos;
+}
+
+
+static void backup_listener_to_previous_expression(void)
+{
+ if (current_listener_position > 0)
+ {
+ current_listener_position--;
+ listener_delete_text(listener_positions[current_listener_position]);
+ }
+}
+
+#if HAVE_SCHEME
+static s7_pointer top_level_let = NULL;
+static s7_pointer g_top_level_let(s7_scheme *sc, s7_pointer args)
+{
+ return(top_level_let);
+}
+
+static s7_pointer g_set_top_level_let(s7_scheme *sc, s7_pointer args)
+{
+ top_level_let = s7_car(args);
+ return(top_level_let);
+}
+#endif
+
+static void listener_return(widget_t w, int last_prompt)
+{
+#if (!USE_NO_GUI)
+ /* try to find complete form either enclosing current cursor, or just before it */
+ GUI_TEXT_POSITION_TYPE cmd_eot = 0;
+ char *str = NULL, *full_str = NULL;
+ int i, j;
+ Xen form = Xen_undefined;
+ GUI_TEXT_POSITION_TYPE last_position = 0, current_position = 0;
+
+#if (!HAVE_RUBY && !HAVE_FORTH)
+ GUI_TEXT_POSITION_TYPE end_of_text = 0, start_of_text = 0;
+ int parens;
+#if USE_MOTIF
+ GUI_TEXT_POSITION_TYPE new_eot = 0;
+#endif
+#endif
+
+ full_str = GUI_TEXT(w);
+ current_position = GUI_TEXT_INSERTION_POSITION(w);
+#if (!HAVE_RUBY && !HAVE_FORTH)
+ start_of_text = current_position;
+ end_of_text = current_position;
+#endif
+ last_position = GUI_TEXT_END(w);
+ add_listener_position(last_position);
+
+#if (!HAVE_SCHEME)
+ if (have_read_hook())
+ {
+ Xen result;
+ int len;
+ len = last_position - last_prompt;
+ if (len > 0)
+ {
+ str = (char *)calloc(len + 1, sizeof(char));
+ for (i = last_prompt, j = 0; i < last_position; i++, j++) str[j] = full_str[i];
+ result = run_read_hook(str);
+ free(str);
+ if (Xen_is_true(result))
+ {
+ if (full_str) GUI_FREE(full_str);
+ return;
+ }
+ }
+ }
+#endif
+
+ /* prompt = listener_prompt(ss); */
+
+ /* first look for a form just before the current mouse location,
+ * independent of everything (i.e. user may have made changes
+ * in a form included in a comment, then typed return, expecting
+ * us to use the new version, but the check_balance procedure
+ * tries to ignore comments).
+ */
+
+ str = NULL;
+
+#if HAVE_RUBY || HAVE_FORTH
+ {
+ int k, len, start, full_len;
+ for (i = current_position - 1; i >= 0; i--)
+ if (is_prompt(full_str, i))
+ {
+ full_len = strlen(full_str);
+ for (k = current_position - 1; k < full_len; k++)
+ if (full_str[k] == '\n')
+ break;
+ start = i + 1;
+ len = (k - start + 1);
+ str = (char *)calloc(len, sizeof(char));
+ for (k = 0; k < len - 1; k++)
+ str[k] = full_str[k + start];
+ break;
+ }
+ }
+#else
+ if (last_position > end_of_text)
+ {
+ end_of_text = last_position; /* added 12-Nov-07 for first form */
+ for (i = current_position; i < last_position; i++)
+ if (is_prompt(full_str, i + 1))
+ {
+ /* fprintf(stderr, "set end to %d (%d)\n", i - ss->listener_prompt_length + 1, i); */
+ end_of_text = i - ss->listener_prompt_length + 1;
+ break;
+ }
+ }
+ if (start_of_text > 0)
+ {
+ for (i = end_of_text; i >= 0; i--)
+ if (is_prompt(full_str, i))
+ {
+ /* fprintf(stderr, "set start to %d\n", i + 1); */
+ start_of_text = i + 1;
+ break;
+ }
+ }
+
+ /* fprintf(stderr, "found %d %d\n", start_of_text, end_of_text); */
+
+ if (end_of_text > start_of_text)
+ {
+ int slen;
+ parens = 0;
+ slen = end_of_text - start_of_text + 2;
+ str = (char *)calloc(slen, sizeof(char));
+ for (i = start_of_text, j = 0; i <= end_of_text; j++, i++)
+ {
+ str[j] = full_str[i];
+ if (str[j] == '(')
+ parens++;
+ }
+ str[end_of_text - start_of_text + 1] = 0;
+ end_of_text = mus_strlen(str);
+
+ if (parens)
+ {
+ end_of_text = check_balance(str, 0, (int)end_of_text, true); /* last-arg->we are in the listener */
+ if ((end_of_text > 0) &&
+ (end_of_text < slen))
+ {
+ if (end_of_text < (slen - 1))
+ str[end_of_text + 1] = 0;
+ else str[end_of_text] = 0;
+ if (str[end_of_text] == '\n') str[end_of_text] = 0;
+ }
+ else
+ {
+ free(str);
+ str = NULL;
+ if (end_of_text < 0)
+ listener_append_and_prompt(NULL);
+ else
+ {
+#if USE_MOTIF
+ new_eot = GUI_TEXT_END(w);
+ GUI_LISTENER_TEXT_INSERT(w, new_eot, (char *)"\n");
+#else
+ GUI_LISTENER_TEXT_INSERT(w, 0, (char *)"\n");
+#endif
+ }
+ if (full_str) GUI_FREE(full_str);
+ return;
+ }
+ }
+ else
+ {
+ /* no parens -- pick up closest entity */
+ int loc, k, len;
+ char *tmp;
+ loc = current_position - start_of_text - 1;
+ for (i = loc; i >= 0; i--)
+ if ((str[i] == '\n') || (i == 0))
+ {
+ len = mus_strlen(str);
+ tmp = (char *)calloc(len + 1, sizeof(char));
+ if (i != 0) i++;
+ for (k = 0; i < len; i++, k++)
+ if ((i > loc) &&
+ ((str[i] == '\n') ||
+ (str[i] == ' ')))
+ break;
+ else tmp[k] = str[i];
+ free(str);
+ str = tmp;
+ break;
+ }
+ }
+ }
+#endif
+
+ if (full_str) GUI_FREE(full_str);
+ {
+ bool need_eval = false;
+ int i, len;
+ /* fprintf(stderr, "return: %s\n", str); */
+
+ len = mus_strlen(str);
+ for (i = 0; i < len; i++)
+ if ((str[i] != ' ') &&
+ (str[i] != '\n') &&
+ (str[i] != '\r') &&
+ (str[i] != '\t'))
+ {
+ need_eval = true;
+ break;
+ }
+ if (!need_eval)
+ append_listener_text(-1, "\n");
+ else
+ {
+ if (str)
+ {
+ char *errmsg = NULL;
+
+ if (current_position < (last_position - 2))
+ GUI_LISTENER_TEXT_INSERT(w, GUI_TEXT_END(w), str);
+
+ GUI_SET_CURSOR(w, ss->wait_cursor);
+ GUI_UPDATE(w); /* not sure about this... */
+
+ if ((mus_strlen(str) > 1) || (str[0] != '\n'))
+ remember_listener_string(str);
+
+#if HAVE_RUBY || HAVE_FORTH
+ form = Xen_eval_C_string(str);
+#endif
+
+#if HAVE_SCHEME
+ /* very tricky -- we need the interface running to see C-g, and in ordinary (not-hung, but very slow-to-compute) code
+ * we need to let other interface stuff run. We can't look at each event and flush all but the C-g we're waiting
+ * for because that confuses the rest of the GUI, and some such interactions are expected. But if interface actions
+ * are tied to scheme code, the check_for_event lets that code be evaluated, even though we're actually running
+ * the evaluator already in a separate thread. If we block on the thread ID (pthread_self), bad stuff still gets
+ * through somehow.
+ *
+ * s7 threads here only solves the s7 side of the problem. To make the Gtk calls thread-safe,
+ * we have to use gdk threads, and that means either wrapping every gtk section thoughout Snd in
+ * gdk_thread_enter/leave, or expecting the caller to do that in every expression he types in the listener.
+ *
+ * Using clone_s7 code in s7 for CL-like stack-groups is much trickier
+ * than I thought -- it's basically importing all the pthread GC and alloc stuff into the main s7.
+ *
+ * So... set begin_hook to a func that calls gtk_main_iteration or check_for_event;
+ * if C-g, the begin_hook func returns true, and s7 calls s7_quit, and C_g_typed is true here.
+ * Otherwise, I think anything is safe because we're only looking at the block start, and
+ * we're protected there by a stack barrier.
+ *
+ * But this polling at block starts is expensive, mainly because XtAppPending and gtk_events_pending
+ * are very slow. So with_interrupts can turn off this check.
+ */
+
+ if (s7_begin_hook(s7) != NULL) return; /* s7 is already running (user typed <cr> during computation) */
+
+ if ((mus_strlen(str) > 1) || (str[0] != '\n'))
+ {
+ int gc_loc;
+ s7_pointer old_port;
+
+ old_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
+ gc_loc = s7_gc_protect(s7, old_port);
+
+ if (with_interrupts(ss))
+ s7_set_begin_hook(s7, listener_begin_hook);
+
+ if (have_read_hook())
+ form = run_read_hook(str);
+ else form = s7_eval_c_string_with_environment(s7, str, top_level_let);
+
+ s7_set_begin_hook(s7, NULL);
+ if (ss->C_g_typed)
+ {
+ errmsg = mus_strdup("\nSnd interrupted!");
+ ss->C_g_typed = false;
+ }
+ else errmsg = mus_strdup(s7_get_output_string(s7, s7_current_error_port(s7)));
+
+ s7_close_output_port(s7, s7_current_error_port(s7));
+ s7_set_current_error_port(s7, old_port);
+ s7_gc_unprotect_at(s7, gc_loc);
+ }
+#endif
+
+ if (errmsg)
+ {
+ if (*errmsg)
+ snd_display_result(errmsg, NULL);
+ free(errmsg);
+ }
+ else snd_report_listener_result(form); /* used to check for unbound form here, but that's no good in Ruby */
+
+ free(str);
+ str = NULL;
+ GUI_UNSET_CURSOR(w, ss->arrow_cursor);
+ }
+ else
+ {
+ listener_append_and_prompt(NULL);
+ }
+ }
+ }
+
+ cmd_eot = GUI_TEXT_END(w);
+ add_listener_position(cmd_eot);
+ GUI_TEXT_GOTO(w, cmd_eot - 1);
+ GUI_TEXT_SET_INSERTION_POSITION(w, cmd_eot + 1);
+#endif
+}
+
+
+
+/* -------------------------------------------------------------------------------- */
+
+
+#define OVERRIDE_TOGGLE 1
+/* Motif 2.0 defines control-button1 to be "take focus" -- this is not a good idea!! */
+
+
+static void Tab_completion(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ int completer;
+ pointer_or_int_t data;
+
+ XtVaGetValues(w, XmNuserData, &data, NULL);
+ completer = (int)data;
+
+ if (completer >= 0)
+ {
+ int matches;
+ char *old_text, *new_text;
+
+ old_text = XmTextGetString(w);
+ if (mus_strlen(old_text) == 0) return; /* C-x C-f TAB in kbd??, for example */
+
+ new_text = complete_text(w, old_text, completer);
+ if (mus_strlen(new_text) == 0) return; /* can this happen? */
+ XmTextSetString(w, new_text);
+ XmTextSetCursorPosition(w, XmTextGetLastPosition(w));
+
+ matches = get_completion_matches();
+
+ if ((mus_strcmp(old_text, new_text)) &&
+ (matches != -1))
+ {
+ Pixel old_color;
+ XtVaGetValues(w, XmNforeground, &old_color, NULL);
+ if (matches > 1)
+ XtVaSetValues(w, XmNforeground, ss->green, NULL);
+ else
+ if (matches == 0)
+ XtVaSetValues(w, XmNforeground, ss->red, NULL);
+ if (matches != 1)
+ {
+ XmUpdateDisplay(w);
+ sleep(1);
+ XtVaSetValues(w, XmNforeground, old_color, NULL);
+ XmUpdateDisplay(w);
+ }
+
+ if (matches > 1) /* there are several possible completions -- let the widget decide how to handle it */
+ handle_completions(w, completer);
+ }
+
+ if (old_text) XtFree(old_text);
+ if (new_text) free(new_text);
+ }
+}
+
+
+/* listener completions */
+
+static Widget listener_text = NULL;
+static Widget listener_pane = NULL; /* form widget that hold the listener scrolled text widget */
+
+static Widget completions_list = NULL;
+static Widget completions_pane = NULL;
+
+
+static void perform_completion(XmString selection)
+{
+ int i, j, old_len, new_len;
+ char *text = NULL, *old_text = NULL;
+
+ text = (char *)XmStringUnparse(selection, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
+ save_completion_choice(text);
+
+ old_text = XmTextGetString(listener_text);
+ old_len = mus_strlen(old_text);
+ new_len = mus_strlen(text);
+ for (i = old_len - 1, j = new_len - 1; j >= 0; j--)
+ {
+ if (old_text[i] != text[j])
+ {
+ i = old_len - 1;
+ if (old_text[i] == text[j]) i--;
+ /* this added 15-Apr-02 for case like map-chan(nel) */
+ /* probably should go back new_len and scan forwards instead */
+ }
+ else i--;
+ }
+
+ append_listener_text(XmTextGetLastPosition(listener_text), (char *)(text - 1 + old_len - i));
+
+ if (text) XtFree(text);
+ if (old_text) XtFree(old_text);
+}
+
+
+static void listener_completions_browse_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ /* choice = cbs->item_position - 1; */
+ perform_completion(cbs->item);
+ XtUnmanageChild(completions_pane);
+}
+
+
+static int alphabetize(const void *a, const void *b)
+{
+ return(strcmp(*((const char **)a), (*(const char **)b)));
+}
+
+
+static int find_prompt(Widget w, XmTextPosition start)
+{
+ Boolean found_prompt = false, found_newline;
+ XmTextPosition loc = 0;
+
+ if (start == 0) /* try to avoid strlen null in motif */
+ return(0);
+
+ /* the prompt defaults to ">", so a naive backwards search for the prompt is easily confused.
+ * (bugfix thanks to Tito Latini).
+ */
+ while (!found_prompt)
+ {
+ found_newline = XmTextFindString(w, start, (char *)"\n", XmTEXT_BACKWARD, &loc);
+ start = found_newline ? loc : 0;
+ found_prompt = XmTextFindString(w, start, listener_prompt(ss), XmTEXT_FORWARD, &loc);
+ if ((found_prompt && loc <= (start + 1)) || (start == 0))
+ break;
+ start--;
+ }
+
+ if (!found_prompt)
+ return(0);
+ else return((int)loc + mus_strlen(listener_prompt(ss)));
+}
+
+
+static void motif_listener_completion(Widget w, XEvent *event, char **str, Cardinal *num) /* change name because emacs is confused */
+{
+ /* used only by the listener widget -- needs to be smart about text since overall string can be enormous
+ * and we don't want to back up past the last prompt
+ * also if at start of line (or all white-space to previous \n), indent
+ */
+ int beg, end, replace_end, len;
+ char *old_text;
+
+ if ((completions_pane) &&
+ (XtIsManaged(completions_pane)))
+ {
+ XmString *strs;
+ XtVaGetValues(completions_list,
+ XmNselectedItems, &strs,
+ NULL);
+ perform_completion(strs[0]);
+ XtUnmanageChild(completions_pane);
+ return;
+ }
+
+ end = XmTextGetInsertionPosition(w);
+ replace_end = end;
+
+ beg = find_prompt(w, (XmTextPosition)end);
+ len = end - beg + 1;
+
+ old_text = (char *)calloc(len + 1, sizeof(char));
+ XmTextGetSubstring(w, beg, len, len + 1, old_text);
+ /* now old_text is the stuff typed since the last prompt */
+
+ if (old_text[len - 1] == '\n')
+ {
+ old_text[len - 1] = 0;
+ end--;
+ }
+
+ if (old_text)
+ {
+ int matches = 0;
+ char *new_text = NULL, *file_text = NULL;
+ bool try_completion = true;
+ new_text = complete_listener_text(old_text, end, &try_completion, &file_text);
+
+ if (!try_completion)
+ {
+ free(old_text);
+ return;
+ }
+
+ if (mus_strcmp(old_text, new_text))
+ matches = get_completion_matches();
+ else XmTextReplace(w, beg, replace_end, new_text);
+
+ if (new_text)
+ {
+ free(new_text);
+ new_text = NULL;
+ }
+
+ if (matches > 1)
+ {
+ int num;
+ clear_possible_completions();
+ set_save_completions(true);
+ if (file_text)
+ new_text = filename_completer(w, file_text, NULL);
+ else new_text = expression_completer(w, old_text, NULL);
+ if (new_text)
+ {
+ free(new_text);
+ new_text = NULL;
+ }
+ num = get_possible_completions_size();
+ if (num > 0)
+ {
+ int i;
+ XmString *match;
+ char **buffer;
+
+ if (!completions_list)
+ {
+ Arg args[20];
+ int n = 0;
+
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNscrollBarPlacement, XmBOTTOM_LEFT); n++;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNforeground, ss->black); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+
+ completions_list = XmCreateScrolledList(listener_pane, (char *)"completion-help-text", args, n);
+ completions_pane = XtParent(completions_list);
+
+ XtAddCallback(completions_list, XmNbrowseSelectionCallback, listener_completions_browse_callback, NULL);
+ XtManageChild(completions_list);
+ }
+
+ buffer = get_possible_completions();
+ qsort((void *)buffer, num, sizeof(char *), alphabetize);
+
+ match = (XmString *)calloc(num, sizeof(XmString));
+ for (i = 0; i < num; i++)
+ match[i] = XmStringCreateLocalized(buffer[i]);
+
+ XtVaSetValues(completions_list,
+ XmNitems, match,
+ XmNitemCount, num,
+ XmNvisibleItemCount, mus_iclamp(1, num, 20),
+ NULL);
+
+ if (!(XtIsManaged(completions_pane)))
+ XtManageChild(completions_pane);
+
+ /* look at previous completions list first for a match, then
+ * look back from "beg" for any member of the match list previously typed
+ */
+ {
+ int row;
+ row = find_best_completion(buffer, num);
+ XmListSelectPos(completions_list, row, false);
+ ensure_list_row_visible(completions_list, row);
+ }
+
+ for (i = 0; i < num; i++)
+ XmStringFree(match[i]);
+ free(match);
+ }
+ set_save_completions(false);
+ }
+
+ if (file_text) free(file_text);
+ if (old_text) free(old_text);
+ }
+}
+
+
+
+
+/* ---------------- text widget specializations ---------------- */
+
+void textfield_focus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtVaSetValues(w, XmNbackground, ss->text_focus_color, NULL);
+ XtVaSetValues(w, XmNcursorPositionVisible, true, NULL);
+}
+
+
+void textfield_unfocus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtVaSetValues(w, XmNbackground, ss->basic_color, NULL);
+ XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
+}
+
+
+static void textfield_no_color_focus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtVaSetValues(w, XmNcursorPositionVisible, true, NULL);
+}
+
+
+static void textfield_no_color_unfocus_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
+}
+
+
+/* -------- specialized action procs -------- */
+
+static bool actions_loaded = false;
+#define CONTROL_KEY 4
+
+static void No_op(Widget w, XEvent *ev, char **str, Cardinal *num)
+{
+ /* return does not cause widget activation in many textfield cases -- it is a true no-op */
+}
+
+
+#define snd_K_u XK_u
+#define snd_K_x XK_x
+
+static void Activate_keyboard(Widget w, XEvent *ev, char **str, Cardinal *num)
+{
+ /* make the current channel active preloading kbd cmd with str[0]+ctrl bit */
+ chan_info *cp;
+ cp = current_channel();
+ if (cp)
+ {
+ goto_graph(cp);
+ keyboard_command(cp, (str[0][0] == 'u') ? snd_K_u : snd_K_x, CONTROL_KEY);
+ }
+}
+
+
+static char *listener_selection = NULL;
+
+static void Kill_line(Widget w, XEvent *ev, char **str, Cardinal *num)
+{
+ /* C-k with storage of killed text */
+ XmTextPosition curpos, loc;
+ Boolean found;
+ curpos = XmTextGetCursorPosition(w);
+ found = XmTextFindString(w, curpos, (char *)"\n", XmTEXT_FORWARD, &loc);
+ if (!found) loc = XmTextGetLastPosition(w);
+ if (loc > curpos)
+ {
+ if (listener_selection) {XtFree(listener_selection); listener_selection = NULL;}
+ XmTextSetSelection(w, curpos, loc, CurrentTime);
+ listener_selection = XmTextGetSelection(w); /* xm manual p329 sez storage is allocated here */
+ XmTextCut(w, CurrentTime);
+ }
+}
+
+
+static void Yank(Widget w, XEvent *ev, char **str, Cardinal *num)
+{
+ /* copy current selection at current cursor position */
+ if (listener_selection)
+ {
+ XmTextPosition curpos;
+ curpos = XmTextGetCursorPosition(w);
+ XmTextInsert(w, curpos, listener_selection);
+ curpos += strlen(listener_selection);
+ XmTextShowPosition(w, curpos);
+ XmTextSetCursorPosition(w, curpos);
+ XmTextClearSelection(w, ev->xkey.time); /* so C-y + edit doesn't forbid the edit */
+ }
+}
+
+
+static void Begin_of_line(Widget w, XEvent *ev, char **ustr, Cardinal *num)
+{
+ /* don't back up before listener prompt */
+ XmTextPosition curpos, loc;
+ Boolean found;
+ curpos = XmTextGetCursorPosition(w) - 1;
+ found = XmTextFindString(w, curpos, (char *)"\n", XmTEXT_BACKWARD, &loc);
+ if (curpos >= ss->listener_prompt_length - 1)
+ {
+ char *str = NULL;
+ str = (char *)calloc(ss->listener_prompt_length + 3, sizeof(char));
+ loc = found ? loc + 1 : 0;
+ XmTextGetSubstring(w, loc, ss->listener_prompt_length, ss->listener_prompt_length + 2, str);
+ if (strncmp(listener_prompt(ss), str, ss->listener_prompt_length) == 0)
+ XmTextSetCursorPosition(w, loc + ss->listener_prompt_length);
+ else XmTextSetCursorPosition(w, loc);
+ free(str);
+ }
+ else XmTextSetCursorPosition(w, 0);
+}
+
+
+static void Delete_region(Widget w, XEvent *ev, char **str, Cardinal *num)
+{
+ XmTextCut(w, CurrentTime);
+}
+
+
+static XmTextPosition down_pos, last_pos;
+static Xen listener_click_hook;
+
+static void B1_press(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ XmTextPosition pos;
+ XButtonEvent *ev = (XButtonEvent *)event;
+ XmProcessTraversal(w, XmTRAVERSE_CURRENT);
+ /* we're replacing the built-in take_focus action here, so do it by hand, but leave listener blue, so to speak */
+ if (w != listener_text)
+ XtVaSetValues(w, XmNbackground, ss->white, NULL);
+ else XmTextClearSelection(listener_text, CurrentTime); /* should this happen in other windows as well? */
+ pos = XmTextXYToPos(w, (Position)(ev->x), (Position)(ev->y));
+ XmTextSetCursorPosition(w, pos);
+ down_pos = pos;
+ last_pos = pos;
+ if (Xen_hook_has_list(listener_click_hook))
+ run_hook(listener_click_hook,
+ Xen_list_1(C_int_to_Xen_integer((int)pos)),
+ S_listener_click_hook);
+}
+
+
+static void B1_move(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ XmTextPosition pos;
+ XButtonEvent *ev = (XButtonEvent *)event;
+ pos = XmTextXYToPos(w, (Position)(ev->x), (Position)(ev->y));
+ if (last_pos > pos) /* must have backed up the cursor */
+ XmTextSetHighlight(w, pos, last_pos, XmHIGHLIGHT_NORMAL);
+ if (down_pos != pos)
+ XmTextSetHighlight(w, down_pos, pos, XmHIGHLIGHT_SELECTED);
+ last_pos = pos;
+}
+
+
+static void B1_release(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ XmTextPosition pos;
+ XButtonEvent *ev = (XButtonEvent *)event;
+ pos = XmTextXYToPos(w, (Position)(ev->x), (Position)(ev->y));
+ XmTextSetCursorPosition(w, pos);
+ if (down_pos != pos)
+ {
+ XmTextSetHighlight(w, down_pos, pos, XmHIGHLIGHT_SELECTED);
+ if (listener_selection) {XtFree(listener_selection); listener_selection = NULL;}
+ XmTextSetSelection(w, down_pos, pos, CurrentTime);
+ listener_selection = XmTextGetSelection(w);
+ }
+}
+
+
+static void Text_transpose(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ XmTextPosition curpos;
+ curpos = XmTextGetCursorPosition(w);
+ if (curpos > 1)
+ {
+ char buf[3]; /* needs room for null */
+ char tmp;
+ XmTextGetSubstring(w, (XmTextPosition)(curpos - 1), 2, 3, buf);
+ tmp = buf[0];
+ buf[0] = buf[1];
+ buf[1] = tmp;
+ XmTextReplace(w, curpos - 1, curpos + 1, buf);
+ XmTextSetCursorPosition(w, curpos + 1);
+ }
+}
+
+
+static void Complain(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ char *old_text, *new_text;
+ XmTextPosition curpos;
+ int len;
+
+ curpos = XmTextGetCursorPosition(w);
+ old_text = XmTextGetString(w);
+ len = mus_strlen(old_text) + 5;
+ new_text = (char *)calloc(len, sizeof(char));
+ snprintf(new_text, len, "%s C-%c", (old_text) ? old_text : "", str[0][0]);
+
+ XmTextSetString(w, new_text);
+ XmTextSetCursorPosition(w, curpos);
+
+ if (old_text) XtFree(old_text);
+ free(new_text);
+}
+
+
+static void text_at_cursor(Widget w)
+{
+ XmTextPosition curpos, endpos, start, end;
+ int len, prompt_pos;
+ char *buf;
+
+ curpos = XmTextGetCursorPosition(w);
+ if (curpos <= 1)
+ curpos = XmTextGetInsertionPosition(w);
+ if (curpos <= 1)
+ {
+ snd_help("Listener", "This is the 'listener', a text widget in which you can interact with Snd's extension language. See extsnd.html.", WITH_WORD_WRAP);
+ return;
+ }
+
+ prompt_pos = find_prompt(w, curpos);
+
+ if (curpos > 40)
+ start = curpos - 40;
+ else start = 0;
+ if (start < prompt_pos)
+ start = prompt_pos;
+
+ endpos = XmTextGetLastPosition(w);
+ if ((endpos - curpos) > 40)
+ end = curpos + 40;
+ else end = endpos;
+
+ len = end - start + 1;
+ buf = (char *)calloc(len + 1, sizeof(char));
+ XmTextGetSubstring(w, start, len, len + 1, buf);
+
+ listener_help_at_cursor(buf, curpos - start - 1, len, prompt_pos);
+ free(buf);
+}
+
+
+static void Help_At_Cursor(Widget w, XEvent *ev, char **str, Cardinal *num)
+{
+ text_at_cursor(w);
+}
+
+
+static void Word_upper(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ bool up, cap;
+ XmTextPosition curpos, endpos;
+ up = (str[0][0] == 'u');
+ cap = (str[0][0] == 'c');
+ curpos = XmTextGetCursorPosition(w);
+ endpos = XmTextGetLastPosition(w);
+ if (curpos < endpos)
+ {
+ int i, length, wstart, wend;
+ char *buf = NULL;
+ length = endpos - curpos;
+ buf = (char *)calloc(length + 1, sizeof(char));
+ XmTextGetSubstring(w, curpos, length, length + 1, buf);
+ wstart = 0;
+ wend = length;
+ for (i = 0; i < length; i++)
+ if (!isspace((int)(buf[i])))
+ {
+ wstart = i;
+ break;
+ }
+ for (i = wstart + 1; i < length; i++)
+ if (isspace((int)(buf[i])))
+ {
+ wend = i;
+ break;
+ }
+ if (cap)
+ {
+ buf[0] = toupper(buf[wstart]);
+ buf[1] = '\0';
+ XmTextReplace(w, curpos + wstart, curpos + wstart + 1, buf);
+ }
+ else
+ {
+ int j;
+ for (i = wstart, j = 0; i < wend; i++, j++)
+ if (up)
+ buf[j] = toupper(buf[i]);
+ else buf[j] = tolower(buf[i]);
+ buf[j] = '\0';
+ XmTextReplace(w, curpos + wstart, curpos + wend, buf);
+ }
+ XmTextSetCursorPosition(w, curpos + wend);
+ if (buf) free(buf);
+ }
+}
+
+
+void append_listener_text(int end, const char *msg)
+{
+ if (listener_text)
+ {
+ if (end == -1) end = XmTextGetLastPosition(listener_text);
+ XmTextInsert(listener_text, end, (char *)msg);
+ XmTextSetCursorPosition(listener_text, XmTextGetLastPosition(listener_text));
+ }
+}
+
+
+static bool dont_check_motion = false;
+
+void listener_delete_text(int new_end)
+{
+ int old_end;
+ old_end = XmTextGetLastPosition(listener_text);
+ if (old_end > new_end)
+ {
+ dont_check_motion = true;
+ XmTextSetSelection(listener_text, new_end, old_end, CurrentTime);
+ XmTextRemove(listener_text);
+ dont_check_motion = false;
+ }
+}
+
+
+static void Listener_Meta_P(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ listener_delete_text(find_prompt(w, XmTextGetInsertionPosition(w)));
+ restore_listener_string(true);
+}
+
+
+static void Listener_Meta_N(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ listener_delete_text(find_prompt(w, XmTextGetInsertionPosition(w)));
+ restore_listener_string(false);
+}
+
+
+int save_listener_text(FILE *fp)
+{
+ /* return -1 if fwrite problem */
+ if (listener_text)
+ {
+ char *str = NULL;
+ str = XmTextGetString(listener_text);
+ if (str)
+ {
+ size_t bytes;
+ bytes = fwrite((void *)str, sizeof(char), mus_strlen(str), fp);
+ XtFree(str);
+ if (bytes == 0) return(-1);
+ }
+ }
+ return(0);
+}
+
+
+static void Listener_clear(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ clear_listener();
+}
+
+
+static void Listener_g(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ ss->C_g_typed = true;
+ control_g(any_selected_sound());
+}
+
+
+static void Listener_Backup(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ backup_listener_to_previous_expression();
+}
+
+
+static void Listener_Arrow_Up(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ if ((completions_pane) &&
+ (XtIsManaged(completions_pane)))
+ {
+ int *ns;
+ int n;
+ XmListGetSelectedPos(completions_list, &ns, &n);
+ if (ns[0] > 1)
+ XmListSelectPos(completions_list, ns[0] - 1, false);
+ free(ns);
+ }
+ else XtCallActionProc(w, "previous-line", event, str, *num);
+}
+
+
+static void Listener_Arrow_Down(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ if ((completions_pane) &&
+ (XtIsManaged(completions_pane)))
+ {
+ int *ns;
+ int n;
+ XmListGetSelectedPos(completions_list, &ns, &n);
+ XmListSelectPos(completions_list, ns[0] + 1, false);
+ free(ns);
+ }
+ else XtCallActionProc(w, "next-line", event, str, *num);
+}
+
+
+static void Listener_Return(Widget w, XEvent *event, char **str, Cardinal *num)
+{
+ if ((completions_pane) &&
+ (XtIsManaged(completions_pane)))
+ {
+ XmString *strs;
+ XtVaGetValues(completions_list,
+ XmNselectedItems, &strs,
+ NULL);
+ perform_completion(strs[0]);
+ XtUnmanageChild(completions_pane);
+ }
+ else XtCallActionProc(w, "activate", event, str, *num);
+}
+
+
+#define NUM_ACTS 24
+static XtActionsRec acts[NUM_ACTS] = {
+ {(char *)"no-op", No_op},
+ {(char *)"activate-keyboard", Activate_keyboard},
+ {(char *)"yank", Yank},
+ {(char *)"delete-region", Delete_region},
+ {(char *)"kill-line", Kill_line},
+ {(char *)"begin-of-line", Begin_of_line},
+ {(char *)"b1-press", B1_press},
+ {(char *)"b1-move", B1_move},
+ {(char *)"b1-release", B1_release},
+ {(char *)"text-transpose", Text_transpose},
+ {(char *)"word-upper", Word_upper},
+ {(char *)"tab-completion", Tab_completion},
+ {(char *)"listener-completion", motif_listener_completion},
+ {(char *)"listener-clear", Listener_clear},
+ {(char *)"listener-g", Listener_g},
+ {(char *)"listener-meta-p", Listener_Meta_P},
+ {(char *)"listener-meta-n", Listener_Meta_N},
+ {(char *)"listener-next-line", Listener_Arrow_Down},
+ {(char *)"listener-previous-line", Listener_Arrow_Up},
+ {(char *)"listener-return", Listener_Return},
+ {(char *)"delete-to-previous-command", Listener_Backup},
+ {(char *)"complain", Complain},
+ {(char *)"help-at-cursor", Help_At_Cursor},
+};
+
+
+/* translation tables for emacs compatibility and better inter-widget communication */
+/* these values are listed in lib/Xm/Transltns.c */
+
+/* for textfield (single-line) widgets */
+static char TextTrans2[] =
+ "Ctrl <Key>a: beginning-of-line()\n\
+ Ctrl <Key>b: backward-character()\n\
+ Mod1 <Key>b: backward-word()\n\
+ Mod1 <Key>c: word-upper(c)\n\
+ Ctrl <Key>c: complain(c)\n\
+ Ctrl <Key>d: delete-next-character()\n\
+ Mod1 <Key>d: delete-next-word()\n\
+ Ctrl <Key>e: end-of-line()\n\
+ Ctrl <Key>f: forward-character()\n\
+ Mod1 <Key>f: forward-word()\n\
+ Ctrl <Key>g: activate()\n\
+ Ctrl <Key>h: delete-previous-character()\n\
+ Ctrl <Key>i: complain(i)\n\
+ Ctrl <Key>j: complain(j)\n\
+ Ctrl <Key>k: delete-to-end-of-line()\n\
+ Mod1 <Key>l: word-upper(l)\n\
+ Ctrl <Key>m: complain(m)\n\
+ Ctrl <Key>n: complain(n)\n\
+ Mod1 <Key>n: activate()\n\
+ Ctrl <Key>o: complain(o)\n\
+ Mod1 <Key>p: activate()\n\
+ Ctrl <Key>p: complain(p)\n\
+ Ctrl <Key>q: complain(q)\n\
+ Ctrl <Key>r: activate()\n\
+ Ctrl <Key>s: activate()\n\
+ Ctrl <Key>t: text-transpose()\n\
+ Mod1 <Key>u: word-upper(u)\n\
+ Ctrl <Key>u: complain(u)\n\
+ Ctrl <Key>v: complain(v)\n\
+ Ctrl <Key>w: complain(w)\n\
+ Ctrl <Key>x: activate-keyboard(x)\n\
+ Ctrl <Key>y: complain(y)\n\
+ Ctrl <Key>z: complain(z)\n\
+ Mod1 <Key><: beginning-of-line()\n\
+ Mod1 <Key>>: end-of-line()\n\
+ <Key>Delete: delete-previous-character()\n\
+ Mod1 <Key>Delete: delete-to-start-of-line()\n\
+ <Key>Tab: tab-completion()\n\
+ <Key>Return: activate()\n";
+static XtTranslations transTable2 = NULL;
+
+
+/* same (but not activatable), try to avoid causing the currently active pushbutton widget to appear to be activated by <cr> in the text widget */
+static char TextTrans6[] =
+ "Ctrl <Key>a: beginning-of-line()\n\
+ Ctrl <Key>b: backward-character()\n\
+ Mod1 <Key>b: backward-word()\n\
+ Mod1 <Key>c: word-upper(c)\n\
+ Ctrl <Key>d: delete-next-character()\n\
+ Mod1 <Key>d: delete-next-word()\n\
+ Ctrl <Key>e: end-of-line()\n\
+ Ctrl <Key>f: forward-character()\n\
+ Mod1 <Key>f: forward-word()\n\
+ Ctrl <Key>g: no-op()\n\
+ Ctrl <Key>h: delete-previous-character()\n\
+ Ctrl <Key>k: delete-to-end-of-line()\n\
+ Mod1 <Key>l: word-upper(l)\n\
+ Ctrl <Key>t: text-transpose()\n\
+ Mod1 <Key>u: word-upper(u)\n\
+ Mod1 <Key><: beginning-of-line()\n\
+ Mod1 <Key>>: end-of-line()\n\
+ <Key>Delete: delete-previous-character()\n\
+ Mod1 <Key>Delete: delete-to-start-of-line()\n\
+ <Key>Tab: tab-completion()\n\
+ <Key>Return: no-op()\n";
+static XtTranslations transTable6 = NULL;
+
+
+/* for text (multi-line) widgets */
+static char TextTrans3[] =
+ "Ctrl <Key>a: beginning-of-line()\n\
+ Ctrl <Key>b: backward-character()\n\
+ Mod1 <Key>b: backward-word()\n\
+ Mod1 <Key>c: word-upper(c)\n\
+ Ctrl <Key>d: delete-next-character()\n\
+ Mod1 <Key>d: delete-next-word()\n\
+ Ctrl <Key>e: end-of-line()\n\
+ Ctrl <Key>f: forward-character()\n\
+ Mod1 <Key>f: forward-word()\n\
+ Ctrl <Key>g: activate()\n\
+ Ctrl <Key>h: delete-previous-character()\n\
+ Ctrl <Key>j: newline-and-indent()\n\
+ Ctrl <Key>k: kill-line()\n\
+ Mod1 <Key>l: word-upper(l)\n\
+ Ctrl <Key>n: next-line()\n\
+ Ctrl <Key>o: newline-and-backup()\n\
+ Ctrl <Key>p: previous-line()\n\
+ Ctrl <Key>t: text-transpose()\n\
+ Mod1 <Key>u: word-upper(u)\n\
+ Ctrl <Key>v: next-page()\n\
+ Mod1 <Key>v: previous-page()\n\
+ Ctrl <Key>w: delete-region()\n\
+ Ctrl <Key>y: yank()\n\
+ Ctrl <Key>z: activate()\n\
+ Mod1 <Key>[: backward-paragraph()\n\
+ Mod1 <Key>]: forward-paragraph()\n\
+ Mod1 <Key><: beginning-of-file()\n\
+ Mod1 <Key>>: end-of-file()\n\
+ <Key>Delete: delete-previous-character()\n\
+ Mod1 <Key>Delete: delete-to-start-of-line()\n\
+ Ctrl <Key>osfLeft: page-left()\n\
+ Ctrl <Key>osfRight: page-right()\n\
+ Ctrl <Key>osfDown: next-page()\n\
+ Ctrl <Key>osfUp: previous-page()\n\
+ Ctrl <Key>space: set-anchor()\n\
+ <Btn1Down>: b1-press()\n\
+ <Btn1Up>: b1-release()\n\
+ <Btn1Motion>: b1-move()\n\
+ <Key>Return: newline()\n";
+static XtTranslations transTable3 = NULL;
+
+
+/* for lisp listener */
+static char TextTrans4[] =
+ "Ctrl <Key>a: begin-of-line()\n\
+ Ctrl <Key>b: backward-character()\n\
+ Mod1 <Key>b: backward-word()\n\
+ Mod1 <Key>c: word-upper(c)\n\
+ Ctrl <Key>d: delete-next-character()\n\
+ Mod1 <Key>d: delete-next-word()\n\
+ Ctrl <Key>e: end-of-line()\n\
+ Ctrl <Key>f: forward-character()\n\
+ Mod1 <Key>f: forward-word()\n\
+ Ctrl Meta <Key>g: listener-clear()\n\
+ Ctrl <Key>g: listener-g()\n\
+ Ctrl <Key>h: delete-previous-character()\n\
+ Ctrl <Key>j: newline-and-indent()\n\
+ Ctrl <Key>k: kill-line()\n\
+ Ctrl <Key>l: redraw-display()\n\
+ Mod1 <Key>l: word-upper(l)\n\
+ Ctrl <Key>n: next-line()\n\
+ Mod1 <Key>n: listener-meta-n()\n\
+ Ctrl <Key>o: newline-and-backup()\n\
+ Ctrl <Key>p: previous-line()\n\
+ Mod1 <Key>p: listener-meta-p()\n\
+ Ctrl <Key>t: text-transpose()\n\
+ Ctrl <Key>u: activate-keyboard(u)\n\
+ Mod1 <Key>u: word-upper(u)\n\
+ Ctrl <Key>v: next-page()\n\
+ Mod1 <Key>v: previous-page()\n\
+ Ctrl <Key>w: delete-region()\n\
+ Ctrl <Key>x: activate-keyboard(x)\n\
+ Ctrl <Key>y: yank()\n\
+ Ctrl <Key>z: activate()\n\
+ Ctrl <Key>?: help-at-cursor()\n\
+ Mod1 <Key>.: help-at-cursor()\n\
+ Mod1 <Key>[: backward-paragraph()\n\
+ Mod1 <Key>]: forward-paragraph()\n\
+ Mod1 <Key><: beginning-of-file()\n\
+ Mod1 <Key>>: end-of-file()\n\
+ Shift Ctrl <Key>-: delete-to-previous-command()\n\
+ <Key>Delete: delete-previous-character()\n\
+ Mod1 <Key>Delete: delete-to-start-of-line()\n\
+ Ctrl <Key>osfLeft: page-left()\n\
+ Ctrl <Key>osfRight: page-right()\n\
+ Ctrl <Key>osfDown: next-page()\n\
+ Ctrl <Key>osfUp: previous-page()\n\
+ <Key>osfDown: listener-next-line()\n\
+ <Key>osfUp: listener-previous-line()\n\
+ Ctrl <Key>space: set-anchor()\n\
+ <Btn1Down>: b1-press()\n\
+ <Btn1Up>: b1-release()\n\
+ <Btn1Motion>: b1-move()\n\
+ <Key>Tab: listener-completion()\n\
+ <Key>Return: listener-return()\n";
+static XtTranslations transTable4 = NULL;
+
+
+void add_completer_to_builtin_textfield(Widget w, int completer)
+{
+ /* used to make file selection dialog's file and filter text widgets act like other text field widgets */
+ if (!actions_loaded)
+ {
+ XtAppAddActions(MAIN_APP(ss), acts, NUM_ACTS);
+ actions_loaded = true;
+ }
+ if (!transTable2)
+ transTable2 = XtParseTranslationTable(TextTrans2);
+
+ XtOverrideTranslations(w, transTable2);
+ XtVaSetValues(w, XmNuserData, completer, NULL);
+}
+
+
+
+/* -------- text related widgets -------- */
+
+static Xen mouse_enter_text_hook;
+static Xen mouse_leave_text_hook;
+
+void mouse_enter_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ if (with_pointer_focus(ss))
+ goto_window(w);
+
+ if (Xen_hook_has_list(mouse_enter_text_hook))
+ run_hook(mouse_enter_text_hook,
+ Xen_list_1(Xen_wrap_widget(w)),
+ S_mouse_enter_text_hook);
+}
+
+
+void mouse_leave_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ if (Xen_hook_has_list(mouse_leave_text_hook))
+ run_hook(mouse_leave_text_hook,
+ Xen_list_1(Xen_wrap_widget(w)),
+ S_mouse_leave_text_hook);
+}
+
+
+Widget make_textfield_widget(const char *name, Widget parent, Arg *args, int n, text_cr_t activatable, int completer)
+{
+ /* white background when active, emacs translations */
+ Widget df;
+
+ if (!actions_loaded)
+ {
+ XtAppAddActions(MAIN_APP(ss), acts, NUM_ACTS);
+ actions_loaded = true;
+ }
+
+ XtSetArg(args[n], XmNuserData, completer); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 1); n++;
+ XtSetArg(args[n], XmNcursorPositionVisible, false); n++;
+ df = XtCreateManagedWidget(name, xmTextFieldWidgetClass, parent, args, n);
+
+ if (activatable != ACTIVATABLE_BUT_NOT_FOCUSED)
+ {
+ XtAddCallback(df, XmNfocusCallback, textfield_focus_callback, NULL);
+ XtAddCallback(df, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ }
+ else
+ {
+ XtAddCallback(df, XmNfocusCallback, textfield_no_color_focus_callback, NULL);
+ XtAddCallback(df, XmNlosingFocusCallback, textfield_no_color_unfocus_callback, NULL);
+ }
+
+ XtAddEventHandler(df, EnterWindowMask, false, mouse_enter_text_callback, NULL);
+ XtAddEventHandler(df, LeaveWindowMask, false, mouse_leave_text_callback, NULL);
+
+ if ((activatable == ACTIVATABLE) ||
+ (activatable == ACTIVATABLE_BUT_NOT_FOCUSED))
+ {
+ if (!transTable2)
+ transTable2 = XtParseTranslationTable(TextTrans2);
+ XtOverrideTranslations(df, transTable2);
+ }
+ else
+ {
+ if (!transTable6)
+ transTable6 = XtParseTranslationTable(TextTrans6);
+ XtOverrideTranslations(df, transTable6);
+ }
+
+ return(df);
+}
+
+
+
+Widget make_text_widget(const char *name, Widget parent, Arg *args, int n)
+{
+ /* white background when active, emacs translations */
+ /* used only for comment widget in file data box (snd-xfile.c), but needs to be in this file to pick up actions etc */
+ Widget df;
+ if (!actions_loaded)
+ {
+ XtAppAddActions(MAIN_APP(ss), acts, NUM_ACTS);
+ actions_loaded = true;
+ }
+ XtSetArg(args[n], XmNeditMode, XmMULTI_LINE_EDIT); n++;
+ /* XmNblinkRate 0 turns off the cursor blink */
+ XtSetArg(args[n], XmNcursorPositionVisible, false); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 1); n++;
+ df = XmCreateScrolledText(parent, (char *)name, args, n);
+ XtManageChild(df);
+ XtAddCallback(df, XmNfocusCallback, textfield_focus_callback, NULL);
+ XtAddCallback(df, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
+ XtAddEventHandler(df, EnterWindowMask, false, mouse_enter_text_callback, NULL);
+ XtAddEventHandler(df, LeaveWindowMask, false, mouse_leave_text_callback, NULL);
+ if (!transTable3)
+ transTable3 = XtParseTranslationTable(TextTrans3);
+ XtOverrideTranslations(df, transTable3);
+ return(df);
+}
+
+
+/* ---------------- listener widget ---------------- */
+
+static Widget lisp_window = NULL;
+
+void listener_append(const char *msg)
+{
+ if (listener_text)
+ XmTextInsert(listener_text, XmTextGetLastPosition(listener_text), (char *)msg);
+}
+
+
+void listener_append_and_prompt(const char *msg)
+{
+ if (listener_text)
+ {
+ XmTextPosition cmd_eot;
+ if (msg)
+ XmTextInsert(listener_text, XmTextGetLastPosition(listener_text), (char *)msg);
+ cmd_eot = XmTextGetLastPosition(listener_text);
+ XmTextInsert(listener_text, cmd_eot, listener_prompt_with_cr());
+ cmd_eot = XmTextGetLastPosition(listener_text);
+ XmTextShowPosition(listener_text, cmd_eot - 1);
+ }
+}
+
+
+static void listener_return_callback(Widget w, XtPointer context, XtPointer info)
+{
+ listener_return(w, find_prompt(w, XmTextGetInsertionPosition(w)));
+ /* prompt loc (last prompt pos) used only by read hook */
+}
+
+
+#if (!HAVE_FORTH) && (!HAVE_RUBY)
+
+static int flashes = 0;
+static int paren_pos = -1;
+#define FLASH_TIME 150
+
+static void flash_unbalanced_paren(XtPointer context, XtIntervalId *id)
+{
+ flashes--;
+ XmTextSetHighlight(listener_text, paren_pos, paren_pos + 1, (flashes & 1) ? XmHIGHLIGHT_NORMAL : XmHIGHLIGHT_SELECTED);
+ if (flashes > 0)
+ XtAppAddTimeOut(MAIN_APP(ss),
+ (unsigned long)FLASH_TIME,
+ (XtTimerCallbackProc)flash_unbalanced_paren,
+ NULL);
+ else
+ {
+ XmTextSetHighlight(listener_text, paren_pos, paren_pos + 1, XmHIGHLIGHT_NORMAL);
+ paren_pos = -1;
+ }
+}
+
+static bool highlight_unbalanced_paren(void)
+{
+ /* if cursor is positioned at close paren, try to find reason for unbalanced expr and highlight it */
+ int pos;
+ bool success = true;
+ pos = XmTextGetInsertionPosition(listener_text);
+ if (pos > 2)
+ {
+ char *str;
+ str = XmTextGetString(listener_text);
+ if ((str[pos - 1] == ')') &&
+ ((str[pos - 2] != '\\') || (str[pos - 3] != '#')))
+ {
+ int parens;
+ parens = find_matching_paren(str, 2, pos - 1, &paren_pos);
+ if (parens == 0)
+ {
+ XmTextSetHighlight(listener_text, paren_pos, paren_pos + 1, XmHIGHLIGHT_SELECTED);
+ flashes = 4;
+ XtAppAddTimeOut(MAIN_APP(ss),
+ (unsigned long)FLASH_TIME,
+ (XtTimerCallbackProc)flash_unbalanced_paren,
+ NULL);
+ }
+ else success = false;
+ }
+ if (str) XtFree(str);
+ }
+ return(success);
+}
+#endif
+
+
+static int last_highlight_position = -1;
+
+static void listener_motion_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+ int pos;
+
+ cbs->doit = true;
+ if (dont_check_motion) return;
+ if (last_highlight_position != -1)
+ {
+ XmTextSetHighlight(w, last_highlight_position, last_highlight_position + 1, XmHIGHLIGHT_NORMAL);
+ last_highlight_position = -1;
+ }
+
+ pos = cbs->newInsert - 1;
+ if (pos > 0)
+ {
+ char *str = NULL;
+ str = XmTextGetString(w);
+ if ((str[pos] == ')') &&
+ ((pos <= 1) || (str[pos - 1] != '\\') || (str[pos - 2] != '#')))
+ {
+ int parens;
+ parens = find_matching_paren(str, 1, pos, &last_highlight_position);
+ if (parens == 0)
+ XmTextSetHighlight(w, last_highlight_position, last_highlight_position + 1, XmHIGHLIGHT_SECONDARY_SELECTED);
+ }
+ if (str) XtFree(str);
+ }
+}
+
+
+static void listener_modify_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
+
+ /* pure motion stuff (arrow keys) does not trigger this callback */
+
+ if ((completions_pane) &&
+ (XtIsManaged(completions_pane)))
+ XtUnmanageChild(completions_pane);
+
+ if (((cbs->text)->length > 0) || (dont_check_motion))
+ cbs->doit = true;
+ else
+ {
+ char *str = NULL;
+ int len;
+ str = XmTextGetString(w);
+ len = XmTextGetLastPosition(w);
+ if (within_prompt(str, cbs->startPos, len))
+ cbs->doit = false;
+ else cbs->doit = true;
+ if (str) XtFree(str);
+ }
+}
+
+
+static Xen mouse_enter_listener_hook;
+static Xen mouse_leave_listener_hook;
+
+static void listener_focus_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ if (with_pointer_focus(ss))
+ goto_window(listener_text);
+
+ if (Xen_hook_has_list(mouse_enter_listener_hook))
+ run_hook(mouse_enter_listener_hook,
+ Xen_list_1(Xen_wrap_widget(listener_text)), /* not w */
+ S_mouse_enter_listener_hook);
+}
+
+
+static void listener_unfocus_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ if (Xen_hook_has_list(mouse_leave_listener_hook))
+ run_hook(mouse_leave_listener_hook,
+ Xen_list_1(Xen_wrap_widget(listener_text)), /* not w */
+ S_mouse_leave_listener_hook);
+}
+
+
+/* ---------------- popup callbacks ---------------- */
+
+static Widget listener_popup = NULL;
+
+static void listener_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *txt;
+ txt = XmTextGetSelection(listener_text);
+ if (txt)
+ {
+ char *trim_txt;
+ trim_txt = trim(txt);
+ if (trim_txt)
+ {
+ snd_help(trim_txt, Xen_string_to_C_string(g_snd_help(C_string_to_Xen_string(trim_txt), 0)), WITH_WORD_WRAP);
+ free(trim_txt);
+ }
+ XtFree(txt);
+ }
+ else text_at_cursor(listener_text);
+}
+
+static void listener_save_callback(Widget w, XtPointer context, XtPointer info)
+{
+ FILE *fp = NULL;
+ fp = FOPEN("listener.txt", "w");
+ if (fp)
+ {
+ save_listener_text(fp);
+ snd_fclose(fp, "listener.txt");
+ }
+}
+
+
+static void listener_clear_callback(Widget w, XtPointer context, XtPointer info)
+{
+ clear_listener();
+}
+
+
+#if HAVE_SCHEME
+static void listener_stacktrace_callback(Widget w, XtPointer context, XtPointer info)
+{
+ s7_pointer str;
+ str = s7_eval_c_string(s7, "(stacktrace)");
+ if (s7_string_length(str) == 0)
+ str = s7_eval_c_string(s7, "(object->string (owlet))");
+ snd_display_result(s7_string(str), NULL);
+}
+#endif
+
+
+static void listener_stop_callback(Widget w, XtPointer context, XtPointer info)
+{
+ control_g(any_selected_sound());
+}
+
+
+#if HAVE_SCHEME
+static Widget stacktrace_popup_menu = NULL;
+#endif
+
+static void listener_popup_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
+ XEvent *e;
+ e = cb->event;
+ if (e->type == ButtonPress)
+ {
+#if HAVE_SCHEME
+ if (stacktrace_popup_menu)
+ set_menu_label(stacktrace_popup_menu, (s7_is_null(s7, s7_curlet(s7))) ? "Error info" : "Stacktrace");
+#endif
+ cb->menuToPost = listener_popup;
+ }
+}
+
+
+static void make_listener_widget(int height)
+{
+ if (!listener_text)
+ {
+ Arg args[32];
+ Widget wv, wh, w;
+ int n;
+
+ if (!actions_loaded) {XtAppAddActions(MAIN_APP(ss), acts, NUM_ACTS); actions_loaded = true;}
+
+ n = attach_all_sides(args, 0);
+ XtSetArg(args[n], XmNheight, height); n++;
+ XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++; /* Xm/Paned initializes each pane max to 1000 apparently! */
+
+ if ((sound_style(ss) == SOUNDS_IN_NOTEBOOK) || (sound_style(ss) == SOUNDS_HORIZONTAL))
+ listener_pane = XtCreateManagedWidget("frm", xmFormWidgetClass, SOUND_PANE_BOX(ss), args, n);
+ else listener_pane = XtCreateManagedWidget("frm", xmFormWidgetClass, SOUND_PANE(ss), args, n);
+ /* this widget is not redundant at least in Metroworks Motif */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->listener_color); n++;
+ XtSetArg(args[n], XmNforeground, ss->listener_text_color); n++;
+ if (ss->listener_fontlist) {XtSetArg(args[n], XM_FONT_RESOURCE, ss->listener_fontlist); n++;}
+ n = attach_all_sides(args, n);
+ XtSetArg(args[n], XmNeditMode, XmMULTI_LINE_EDIT); n++;
+ XtSetArg(args[n], XmNskipAdjust, true); n++;
+ XtSetArg(args[n], XmNvalue, listener_prompt(ss)); n++;
+ XtSetArg(args[n], XmNpendingDelete, false); n++; /* don't cut selection upon paste */
+ XtSetArg(args[n], XmNpositionIndex, XmLAST_POSITION); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 1); n++;
+ listener_text = XmCreateScrolledText(listener_pane, (char *)"lisp-listener", args, n);
+ ss->listener_pane = listener_text;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNpopupEnabled, XmPOPUP_AUTOMATIC); n++;
+ listener_popup = XmCreatePopupMenu(listener_text, (char *)"listener-popup", args, n);
+
+ w = XtCreateManagedWidget(I_STOP, xmPushButtonWidgetClass, listener_popup, args, n);
+ XtAddCallback(w, XmNactivateCallback, listener_stop_callback, NULL);
+
+#if HAVE_SCHEME
+ w = XtCreateManagedWidget("Stacktrace", xmPushButtonWidgetClass, listener_popup, args, n);
+ XtAddCallback(w, XmNactivateCallback, listener_stacktrace_callback, NULL);
+ stacktrace_popup_menu = w;
+#endif
+
+ w = XtCreateManagedWidget(I_HELP, xmPushButtonWidgetClass, listener_popup, args, n);
+ XtAddCallback(w, XmNactivateCallback, listener_help_callback, NULL);
+
+ w = XtCreateManagedWidget("Clear", xmPushButtonWidgetClass, listener_popup, args, n);
+ XtAddCallback(w, XmNactivateCallback, listener_clear_callback, NULL);
+
+ w = XtCreateManagedWidget("Save", xmPushButtonWidgetClass, listener_popup, args, n);
+ XtAddCallback(w, XmNactivateCallback, listener_save_callback, NULL);
+
+ XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
+
+ XtManageChild(listener_text);
+ XmTextSetCursorPosition(listener_text, 1);
+ if (!transTable4)
+ transTable4 = XtParseTranslationTable(TextTrans4);
+ XtOverrideTranslations(listener_text, transTable4);
+ XtAddCallback(listener_text, XmNactivateCallback, listener_return_callback, NULL);
+ XtAddCallback(listener_text, XmNmodifyVerifyCallback, listener_modify_callback, NULL);
+ XtAddCallback(listener_text, XmNmotionVerifyCallback, listener_motion_callback, NULL);
+
+ lisp_window = XtParent(listener_text);
+ XtAddEventHandler(lisp_window, EnterWindowMask, false, listener_focus_callback, NULL);
+ XtAddEventHandler(lisp_window, LeaveWindowMask, false, listener_unfocus_callback, NULL);
+
+ XtAddCallback(listener_text, XmNpopupHandlerCallback, listener_popup_callback, NULL);
+
+ XmChangeColor(lisp_window, ss->basic_color);
+ XtVaGetValues(lisp_window, XmNverticalScrollBar, &wv,
+ XmNhorizontalScrollBar, &wh,
+ NULL);
+ XmChangeColor(wv, ss->basic_color);
+ XmChangeColor(wh, ss->basic_color);
+ map_over_children(SOUND_PANE(ss), color_sashes);
+
+ if (auto_resize(ss))
+ XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
+ }
+}
+
+
+void goto_listener(void)
+{
+ goto_window(listener_text);
+ XmTextSetCursorPosition(listener_text, XmTextGetLastPosition(listener_text) + 1);
+ XmTextSetInsertionPosition(listener_text, XmTextGetLastPosition(listener_text) + 1);
+}
+
+
+void color_listener(Pixel pix)
+{
+ ss->listener_color = pix;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->listener_color_symbol, Xen_wrap_pixel(pix));
+#endif
+ if (listener_text)
+ XmChangeColor(listener_text, pix);
+}
+
+
+void color_listener_text(Pixel pix)
+{
+ ss->listener_text_color = pix;
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->listener_text_color_symbol, Xen_wrap_pixel(pix));
+#endif
+ if (listener_text)
+ XtVaSetValues(listener_text, XmNforeground, pix, NULL);
+}
+
+
+void handle_listener(bool open)
+{
+ if (open)
+ {
+ if (!listener_text)
+ make_listener_widget(100);
+ else
+ {
+ XtManageChild(listener_pane);
+ if (!(listener_is_visible()))
+ {
+ XtUnmanageChild(listener_pane);
+ XtVaSetValues(listener_pane, XmNpaneMinimum, 100, XmNpaneMaximum, LOTSA_PIXELS, NULL);
+ XtManageChild(listener_pane);
+ XtVaSetValues(listener_pane, XmNpaneMinimum, 1, NULL);
+ }
+ }
+ }
+ else XtUnmanageChild(listener_pane);
+}
+
+
+bool listener_exists(void)
+{
+ return((bool)listener_text);
+}
+
+
+int listener_height(void)
+{
+ if ((listener_text) && (XtIsManaged(listener_pane)))
+ return(widget_height(listener_text));
+ else return(0);
+}
+
+
+int listener_width(void)
+{
+ if ((listener_text) && (XtIsManaged(listener_pane)))
+ return(widget_width(listener_text));
+ else return(0);
+}
+
+
+#if OVERRIDE_TOGGLE
+static char ToggleTrans2[] =
+ "c<Btn1Down>: ArmAndActivate()\n";
+static XtTranslations toggleTable2 = NULL;
+
+static void override_toggle_translation(Widget w)
+{
+ if (!toggleTable2) toggleTable2 = XtParseTranslationTable(ToggleTrans2);
+ XtOverrideTranslations(w, toggleTable2);
+}
+#endif
+
+
+Widget make_togglebutton_widget(const char *name, Widget parent, Arg *args, int n)
+{
+ Widget w;
+ w = XtCreateManagedWidget(name, xmToggleButtonWidgetClass, parent, args, n);
+#if OVERRIDE_TOGGLE
+ override_toggle_translation(w);
+#endif
+ return(w);
+}
+
+
+Widget make_pushbutton_widget(const char *name, Widget parent, Arg *args, int n)
+{
+ Widget w;
+ w = XtCreateManagedWidget(name, xmPushButtonWidgetClass, parent, args, n);
+#if OVERRIDE_TOGGLE
+ override_toggle_translation(w); /* ??? activate here (rather than armandactivate) fails? */
+#endif
+ return(w);
+}
+
+
+static Xen g_listener_selection(void)
+{
+ #define H_listener_selection "(" S_listener_selection "): currently selected text in listener or " PROC_FALSE
+ Xen res = Xen_false;
+ if (listener_text)
+ {
+ char *txt;
+ txt = XmTextGetSelection(listener_text);
+ if (txt)
+ {
+ res = C_string_to_Xen_string(txt);
+ XtFree(txt);
+ }
+ }
+ return(res);
+}
+
+
+static Xen g_reset_listener_cursor(void)
+{
+ #define H_reset_listener_cursor "(" S_reset_listener_cursor "): reset listener cursor to the default pointer"
+ if (listener_text)
+ XUndefineCursor(XtDisplay(listener_text),
+ XtWindow(listener_text));
+ return(Xen_false);
+}
+
+
+void clear_listener(void)
+{
+ if (listener_text) /* this can be called even when there is no listener */
+ {
+ dont_check_motion = true;
+ XmTextSetSelection(listener_text, 0, XmTextGetCursorPosition(listener_text), CurrentTime);
+ XmTextRemove(listener_text);
+ XmTextInsert(listener_text, 0, listener_prompt(ss));
+ XmTextShowPosition(listener_text, ss->listener_prompt_length);
+ dont_check_motion = false;
+ }
+}
+
+
+void set_listener_text_font(void)
+{
+ if (listener_text)
+ XtVaSetValues(listener_text, XM_FONT_RESOURCE, ss->listener_fontlist, NULL);
+}
+
+
+static Xen g_goto_listener_end(void)
+{
+ #define H_goto_listener_end "(" S_goto_listener_end "): move cursor and scroll to bottom of listener pane"
+ if (listener_text)
+ {
+ XmTextPosition eot;
+ eot = XmTextGetLastPosition(listener_text);
+ XmTextShowPosition(listener_text, eot);
+ XmTextSetInsertionPosition(listener_text, eot);
+ return(C_int_to_Xen_integer(eot));
+ }
+ return(Xen_false);
+}
+
+
+Xen_wrap_no_args(g_listener_selection_w, g_listener_selection)
+Xen_wrap_no_args(g_reset_listener_cursor_w, g_reset_listener_cursor)
+Xen_wrap_no_args(g_goto_listener_end_w, g_goto_listener_end)
+
+void g_init_gxlistener(void)
+{
+#if HAVE_SCHEME
+ top_level_let = s7_nil(s7);
+ s7_define_variable(s7, "top-level-let",
+ s7_dilambda(s7, "top-level-let", g_top_level_let, 0, 0, g_set_top_level_let, 1, 0, "listener environment"));
+
+ #define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (widget): called when the mouse \
+enters the lisp listener pane:\n\
+ (hook-push " S_mouse_enter_listener_hook "\n\
+ (lambda (hook)\n\
+ (" S_focus_widget " (hook 'widget))))"
+#endif
+
+#if HAVE_RUBY
+ #define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (listener): called when the mouse \
+enters the lisp listener pane:\n\
+ $mouse_enter_listener_hook.add-hook!(\"enter\") do |widget|\n\
+ focus_widget(widget)\n\
+ end"
+#endif
+
+#if HAVE_FORTH
+ #define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (listener): called when the mouse \
+enters the lisp listener pane:\n\
+" S_mouse_enter_listener_hook " lambda: <{ wid }> wid " S_focus_widget " ; add-hook!"
+#endif
+
+ #define H_mouse_leave_listener_hook S_mouse_leave_listener_hook " (widget): called when the mouse \
+leaves the lisp listener pane"
+
+ mouse_enter_listener_hook = Xen_define_hook(S_mouse_enter_listener_hook, "(make-hook 'widget)", 1, H_mouse_enter_listener_hook);
+ mouse_leave_listener_hook = Xen_define_hook(S_mouse_leave_listener_hook, "(make-hook 'widget)", 1, H_mouse_leave_listener_hook);
+
+#if HAVE_SCHEME
+ #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
+(hook-push " S_mouse_enter_text_hook "\n\
+ (lambda (w)\n\
+ (" S_focus_widget " w)))"
+#endif
+
+#if HAVE_RUBY
+ #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
+$mouse_enter_text_hook.add_hook!(\"enter\") do |w|\n\
+ focus_widget(w)\n\
+ end"
+#endif
+
+#if HAVE_FORTH
+ #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
+" S_mouse_enter_text_hook " lambda: <{ wid }> wid " S_focus_widget " ; add-hook!"
+#endif
+
+ #define H_mouse_leave_text_hook S_mouse_leave_text_hook " (widget): called when the mouse leaves a text widget"
+
+ mouse_enter_text_hook = Xen_define_hook(S_mouse_enter_text_hook, "(make-hook 'widget)", 1, H_mouse_enter_text_hook);
+ mouse_leave_text_hook = Xen_define_hook(S_mouse_leave_text_hook, "(make-hook 'widget)", 1, H_mouse_leave_text_hook);
+
+ Xen_define_safe_procedure(S_listener_selection, g_listener_selection_w, 0, 0, 0, H_listener_selection);
+ Xen_define_safe_procedure(S_reset_listener_cursor, g_reset_listener_cursor_w, 0, 0, 0, H_reset_listener_cursor);
+ Xen_define_safe_procedure(S_goto_listener_end, g_goto_listener_end_w, 0, 0, 0, H_goto_listener_end);
+
+ #define H_listener_click_hook S_listener_click_hook " (position): called when listener clicked; position is text pos of click in listener"
+ listener_click_hook = Xen_define_hook(S_listener_click_hook, "(make-hook 'position)", 1, H_listener_click_hook);
+
+ preload_best_completions();
+}
+
+
+#include <X11/XKBlib.h>
+
+enum {W_top, W_form, W_main_window, W_edhist, W_wf_buttons, W_f, W_w, W_left_scrollers, W_zy, W_sy,
+ W_bottom_scrollers, W_sx, W_zx, W_graph, W_gzy, W_gsy,
+ NUM_CHAN_WIDGETS
+};
+
+
+#if ((XmVERSION >= 2) && (XmREVISION >= 3))
+ #define DEFAULT_EDIT_HISTORY_WIDTH 2
+#else
+ #define DEFAULT_EDIT_HISTORY_WIDTH 1
+#endif
+
+
+Widget channel_main_pane(chan_info *cp)
+{
+ if (cp) return(cp->chan_widgets[W_form]);
+ return(NULL);
+}
+
+
+Widget channel_graph(chan_info *cp) {return(cp->chan_widgets[W_graph]);}
+static Widget channel_sx(chan_info *cp) {return(cp->chan_widgets[W_sx]);}
+static Widget channel_sy(chan_info *cp) {return(cp->chan_widgets[W_sy]);}
+static Widget channel_zx(chan_info *cp) {return(cp->chan_widgets[W_zx]);}
+static Widget channel_zy(chan_info *cp) {return(cp->chan_widgets[W_zy]);}
+static Widget channel_gsy(chan_info *cp) {return(cp->chan_widgets[W_gsy]);}
+static Widget channel_gzy(chan_info *cp) {return(cp->chan_widgets[W_gzy]);}
+Widget channel_w(chan_info *cp) {return(cp->chan_widgets[W_w]);}
+Widget channel_f(chan_info *cp) {return(cp->chan_widgets[W_f]);}
+
+
+bool channel_graph_is_visible(chan_info *cp)
+{
+ return((cp) &&
+ (cp->chan_widgets) &&
+ (channel_graph(cp)) &&
+ (XtIsManaged(channel_graph(cp))) &&
+ (cp->sound) &&
+ /* here we may have a sound wrapper for variable display in which case the sound widgets are not implemented */
+ (((cp->sound->inuse == SOUND_WRAPPER) || (cp->sound->inuse == SOUND_REGION)) ||
+ ((cp->sound->inuse == SOUND_NORMAL) &&
+ /* other choice: SOUND_IDLE -> no display */
+ (w_snd_pane(cp->sound)) &&
+ (XtIsManaged(w_snd_pane(cp->sound))))));
+}
+
+
+#define EDIT_HISTORY_LIST(Cp) (Cp)->chan_widgets[W_edhist]
+
+
+static mus_float_t sqr(mus_float_t a) {return(a * a);}
+
+static mus_float_t cube(mus_float_t a) {return(a * a * a);}
+
+
+static mus_float_t get_scrollbar(Widget w, int val, int scrollbar_max)
+{
+ int size;
+ if (val == 0) return(0.0);
+ XtVaGetValues(w, XmNsliderSize, &size, NULL);
+ return((mus_float_t)val / (mus_float_t)(scrollbar_max - size));
+}
+
+
+static void sy_changed(int value, chan_info *cp)
+{
+ axis_info *ap;
+ mus_float_t low;
+ ap = cp->axis;
+ low = get_scrollbar(channel_sy(cp), value, SCROLLBAR_MAX);
+ ap->sy = (1.0 - ap->zy) * low;
+ apply_y_axis_change(cp);
+}
+
+
+static void sx_changed(int value, chan_info *cp)
+{
+ /* treat as centered with non-slider trough as defining current bounds */
+ axis_info *ap;
+ double low;
+ ap = cp->axis;
+ low = get_scrollbar(channel_sx(cp), value, SCROLLBAR_MAX);
+ ap->sx = low * (1.0 - ap->zx);
+ apply_x_axis_change(cp);
+}
+
+
+static void zy_changed(int value, chan_info *cp)
+{
+ axis_info *ap;
+ mus_float_t old_zy;
+ ap = cp->axis;
+ if (value < 1) value = 1;
+ old_zy = ap->zy;
+ ap->zy = sqr(get_scrollbar(channel_zy(cp), value, SCROLLBAR_MAX));
+ if (ap->zy < 1e-5) ap->zy = 1e-5; /* if this goes to 0, X can hang */
+ ap->sy += (.5 * (old_zy - ap->zy)); /* try to keep wave centered */
+ if (ap->sy < 0) ap->sy = 0;
+ apply_y_axis_change(cp);
+ resize_sy(cp);
+}
+
+
+#define X_RANGE_CHANGEOVER 20.0
+
+static void zx_changed(int value, chan_info *cp)
+{ /* scrollbar change */
+ axis_info *ap;
+ static int old_zx_value = -1;
+ #define ZX_MIN 20
+
+ if (value < ZX_MIN) value = ZX_MIN; /* less than this causes underflow in snd-axis describe_ticks */
+ /* snd-gchn uses .01 -- its equivalent here would be 100 */
+ /* perhaps the definition should be ((int)(0.002 * MAX_SCROLLBAR)) */
+ if (old_zx_value == value) return; /* try to keep click on slider from moving the window! */
+ old_zx_value = value;
+
+ ap = cp->axis;
+ if (ap->xmax == 0.0) return;
+ if (ap->xmax <= ap->xmin)
+ {
+ ap->xmax = ap->xmin + .001;
+ ap->x_ambit = .001;
+ }
+ if (ap->x_ambit < X_RANGE_CHANGEOVER)
+ ap->zx = sqr(get_scrollbar(channel_zx(cp), value, SCROLLBAR_MAX));
+ else ap->zx = cube(get_scrollbar(channel_zx(cp), value, SCROLLBAR_MAX));
+ /* if cursor visible, focus on that, else selection, else mark, else left side */
+ focus_x_axis_change(cp, zoom_focus_style(ss));
+ resize_sx(cp);
+}
+
+
+static void set_scrollbar(Widget w, mus_float_t position, mus_float_t range, int scrollbar_max) /* position and range 0 to 1.0 */
+{
+ int size, val;
+ size = (int)(scrollbar_max * range);
+ if (size > scrollbar_max)
+ size = scrollbar_max; /* this can't happen!?! */
+ if (size < 1) size = 1;
+ val = (int)(scrollbar_max * position);
+ if ((val + size) > scrollbar_max) val = scrollbar_max - size;
+ if (val < 0) val = 0;
+ XtVaSetValues(w,
+ XmNsliderSize, size,
+ XmNvalue, val,
+ NULL);
+}
+
+
+static void change_gzy_1(mus_float_t val, chan_info *cp)
+{
+ mus_float_t chan_frac, new_gsy, new_size;
+ cp->gzy = val;
+ chan_frac = 1.0 / ((mus_float_t)(((snd_info *)(cp->sound))->nchans));
+ new_size = chan_frac + ((1.0 - chan_frac) * cp->gzy);
+ if ((cp->gsy + new_size) > 1.0)
+ new_gsy = 1.0 - new_size;
+ else new_gsy = cp->gsy;
+ if (new_gsy < 0.0) new_gsy = 0.0;
+ set_scrollbar(channel_gsy(cp), new_gsy, new_size, SCROLLBAR_MAX);
+}
+
+
+static void gzy_changed(int value, chan_info *cp)
+{
+ change_gzy_1(get_scrollbar(channel_gzy(cp), value, SCROLLBAR_MAX), cp);
+ for_each_sound_chan(cp->sound, update_graph_or_warn);
+}
+
+
+void change_gzy(mus_float_t val, chan_info *cp)
+{
+ change_gzy_1(val, cp);
+ set_scrollbar(channel_gzy(cp), val, 1.0 / (mus_float_t)(cp->sound->nchans), SCROLLBAR_MAX);
+}
+
+
+static void gsy_changed(int value, chan_info *cp)
+{
+ mus_float_t low;
+ low = get_scrollbar(channel_gsy(cp), value, SCROLLBAR_MAX);
+ cp->gsy = (1.0 - cp->gzy) * low;
+ for_each_sound_chan(cp->sound, update_graph_or_warn);
+}
+
+
+mus_float_t gsy_value(chan_info *cp)
+{
+ Widget wcp;
+ int ival;
+ wcp = channel_gsy(cp);
+ XtVaGetValues(wcp, XmNvalue, &ival, NULL);
+ return((mus_float_t)ival / (mus_float_t)(SCROLLBAR_MAX));
+}
+
+
+mus_float_t gsy_size(chan_info *cp)
+{
+ Widget wcp;
+ int ival;
+ wcp = channel_gsy(cp);
+ XtVaGetValues(wcp, XmNsliderSize, &ival, NULL);
+ return((mus_float_t)ival / (mus_float_t)(SCROLLBAR_MAX));
+}
+
+
+static void set_zx_scrollbar(chan_info *cp, axis_info *ap)
+{
+ if (ap->x_ambit < X_RANGE_CHANGEOVER)
+ set_scrollbar(channel_zx(cp), sqrt(ap->zx), .1, SCROLLBAR_MAX); /* assume size is 10% of scrollbar length */
+ else set_scrollbar(channel_zx(cp), pow(ap->zx, .333), .1, SCROLLBAR_MAX);
+}
+
+
+void set_z_scrollbars(chan_info *cp, axis_info *ap)
+{
+ set_zx_scrollbar(cp, ap);
+ set_scrollbar(channel_zy(cp), sqrt(ap->zy), .1, SCROLLBAR_MAX);
+}
+
+
+void initialize_scrollbars(chan_info *cp)
+{
+ axis_info *ap;
+ snd_info *sp;
+
+ cp->gzy = 1.0;
+ cp->gsy = 1.0;
+
+ ap = cp->axis;
+ sp = cp->sound;
+
+ set_scrollbar(channel_sx(cp), ap->sx, ap->zx, SCROLLBAR_MAX);
+ set_scrollbar(channel_sy(cp), ap->sy, ap->zy, SCROLLBAR_MAX);
+ set_z_scrollbars(cp, ap);
+
+ if ((sp->nchans > 1) &&
+ (cp->chan == 0) &&
+ (channel_gsy(cp)))
+ {
+ set_scrollbar(channel_gsy(cp), 1.0, 1.0, SCROLLBAR_MAX);
+ set_scrollbar(channel_gzy(cp), 1.0, 1.0 / (mus_float_t)(sp->nchans), SCROLLBAR_MAX);
+ }
+}
+
+
+void resize_sy(chan_info *cp)
+{
+ /* something changed the y axis view, so the scale scroller needs to reflect that change (in size and position) */
+ axis_info *ap;
+ ap = cp->axis;
+ if (ap->y_ambit != 0.0)
+ set_scrollbar(channel_sy(cp),
+ (ap->y0 - ap->ymin) / ap->y_ambit,
+ (ap->y1 - ap->y0) / ap->y_ambit,
+ SCROLLBAR_MAX);
+}
+
+
+void resize_sy_and_zy(chan_info *cp)
+{
+ resize_sy(cp);
+ set_scrollbar(channel_zy(cp), sqrt(cp->axis->zy), .1, SCROLLBAR_MAX);
+}
+
+
+void resize_sx(chan_info *cp)
+{
+ axis_info *ap;
+ ap = cp->axis;
+ if (ap->x_ambit != 0.0)
+ set_scrollbar(channel_sx(cp),
+ (ap->x0 - ap->xmin) / ap->x_ambit,
+ (ap->x1 - ap->x0) / ap->x_ambit,
+ SCROLLBAR_MAX);
+}
+
+
+void resize_sx_and_zx(chan_info *cp)
+{
+ resize_sx(cp);
+ /* change zx position (not its size) */
+ set_zx_scrollbar(cp, cp->axis);
+}
+
+
+void channel_open_pane(chan_info *cp)
+{
+ XtManageChild(channel_main_pane(cp));
+}
+
+
+void channel_unlock_pane(chan_info *cp)
+{
+ XtVaSetValues(channel_main_pane(cp),
+ XmNpaneMinimum, 5,
+ XmNpaneMaximum, LOTSA_PIXELS,
+ NULL);
+}
+
+
+static void channel_lock_pane(chan_info *cp, int val)
+{
+ if (val < 6) val = 6;
+ XtUnmanageChild(channel_main_pane(cp));
+ XtVaSetValues(channel_main_pane(cp),
+ XmNpaneMinimum, val - 5,
+ XmNpaneMaximum, val + 5,
+ NULL);
+}
+
+
+static void sy_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ sy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+static void sy_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ sy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+static void sx_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ sx_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+static void sx_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ sx_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+static void sx_increment_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* problem here is that in large files these increments, if determined via scrollbar values, are huge */
+ /* so, move ahead one-tenth window on each tick */
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ sx_incremented(cp, 0.1);
+}
+
+
+static void sx_decrement_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ sx_incremented(cp, -0.1);
+}
+
+
+static void zy_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ zy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+static void zy_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ zy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+static void zx_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ zx_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+/* can't use value changed callback in scrollbars because they are called upon mouse release
+ * even when nothing changed, and the value passed appears to be the right edge of the
+ * slider -- this is too unpredictable, and the result is the window moves when the user
+ * did not want it to.
+ */
+
+
+static void gzy_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ gzy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+static void gsy_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ gsy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+
+static void gsy_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ chan_info *cp = (chan_info *)(context);
+ if (cp->active == CHANNEL_HAS_AXES)
+ gsy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
+}
+
+/* anything special for increment? XmNincrementCallback sx_increment_callback */
+
+
+static void f_toggle_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ XButtonEvent *ev;
+ ev = (XButtonEvent *)(cb->event);
+ f_button_callback((chan_info *)context, cb->set, (ev->state & snd_ControlMask));
+}
+
+
+static void w_toggle_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ XButtonEvent *ev;
+ ev = (XButtonEvent *)(cb->event);
+ w_button_callback((chan_info *)context, cb->set, (ev->state & snd_ControlMask));
+}
+
+
+static void channel_expose_callback(Widget w, XtPointer context, XtPointer info)
+{
+ static oclock_t last_expose_event_time = 0;
+ static chan_info *last_cp = NULL;
+ chan_info *cp = (chan_info *)context;
+ XmDrawingAreaCallbackStruct *cb = (XmDrawingAreaCallbackStruct *)info;
+ XExposeEvent *ev;
+ oclock_t curtime;
+
+ if ((cp == NULL) || (cp->active < CHANNEL_HAS_AXES) || (cp->sound == NULL)) return;
+
+ ev = (XExposeEvent *)(cb->event);
+
+ /* if multiple channels/sounds displayed, each gets an expose event, but the earlier ones
+ * have count>0, and the last can get more than 1, causing our notion of last_cp to
+ * be useless, and we'll drop the earlier ones anyway, so if cp != last_cp, expose
+ * last_cp if last_count>0 or times equal (not sure which is safest).
+ */
+
+ curtime = XtLastTimestampProcessed(MAIN_DISPLAY(ss));
+
+ if ((ev->count == 0) ||
+ (last_expose_event_time != curtime) ||
+ (cp != last_cp))
+ {
+ snd_info *sp;
+ sp = cp->sound;
+ if (sp->channel_style != CHANNELS_SEPARATE)
+ {
+ if ((cp->chan == 0) && (ev->width > 10) && (ev->height > 10))
+ for_each_sound_chan(sp, update_graph_or_warn);
+ }
+ else update_graph_or_warn(cp);
+ }
+
+ last_cp = cp;
+ last_expose_event_time = curtime;
+}
+
+
+static void channel_resize_callback(Widget w, XtPointer context, XtPointer info)
+{
+ channel_resize((chan_info *)context);
+}
+
+
+static Xen mouse_enter_graph_hook;
+static Xen mouse_leave_graph_hook;
+
+static void graph_mouse_enter(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ pointer_or_int_t data;
+ XEnterWindowEvent *ev = (XEnterWindowEvent *)event;
+
+ if (with_pointer_focus(ss))
+ goto_window(w);
+
+ XtVaGetValues(w, XmNuserData, &data, NULL);
+
+ if (Xen_hook_has_list(mouse_enter_graph_hook))
+ run_hook(mouse_enter_graph_hook,
+ Xen_list_2(C_int_to_Xen_sound(unpack_sound(data)),
+ C_int_to_Xen_integer(unpack_channel(data))),
+ S_mouse_enter_graph_hook);
+
+ check_cursor_shape((chan_info *)context, ev->x, ev->y);
+}
+
+
+static void graph_mouse_leave(Widget w, XtPointer context, XEvent *event, Boolean *flag)
+{
+ pointer_or_int_t data;
+ XLeaveWindowEvent *ev = (XLeaveWindowEvent *)event;
+
+ XtVaGetValues(w, XmNuserData, &data, NULL);
+ if (Xen_hook_has_list(mouse_leave_graph_hook))
+ run_hook(mouse_leave_graph_hook,
+ Xen_list_2(C_int_to_Xen_sound(unpack_sound(data)),
+ C_int_to_Xen_integer(unpack_channel(data))),
+ S_mouse_leave_graph_hook);
+
+ /*
+ XUndefineCursor(XtDisplay(w), XtWindow(w));
+ */
+ check_cursor_shape((chan_info *)context, ev->x, ev->y);
+}
+
+
+static void graph_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XButtonEvent *ev = (XButtonEvent *)event;
+ graph_button_press_callback((chan_info *)context, (void *)ev, ev->x, ev->y, ev->state, ev->button, ev->time);
+}
+
+
+static void graph_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont) /* cont = "continue to dispatch" */
+{
+ XButtonEvent *ev = (XButtonEvent *)event;
+ graph_button_release_callback((chan_info *)context, ev->x, ev->y, ev->state, ev->button);
+}
+
+#if 0
+static void graph_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{ /* mouse drag */
+ XMotionEvent *ev = (XMotionEvent *)event;
+ graph_button_motion_callback((chan_info *)context, ev->x, ev->y, ev->time);
+}
+#endif
+
+
+static void graph_mouse_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{ /* mouse movement */
+ XMotionEvent *ev = (XMotionEvent *)event;
+ if ((ev->state & Button1Mask) == 0)
+ check_cursor_shape((chan_info *)context, ev->x, ev->y);
+ else graph_button_motion_callback((chan_info *)context, ev->x, ev->y, ev->time);
+}
+
+
+static int no_padding(Arg *args, int n)
+{
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNmarginWidth, 0); n++;
+ XtSetArg(args[n], XmNmarginTop, 0); n++;
+ XtSetArg(args[n], XmNmarginBottom, 0); n++;
+ XtSetArg(args[n], XmNmarginLeft, 0); n++;
+ XtSetArg(args[n], XmNmarginRight, 0); n++;
+ return(n);
+}
+
+
+static void hide_gz_scrollbars(snd_info *sp)
+{
+ Widget w;
+ w = channel_gsy(sp->chans[0]);
+ if ((w) && (XtIsManaged(w))) XtUnmanageChild(w);
+ w = channel_gzy(sp->chans[0]);
+ if ((w) && (XtIsManaged(w))) XtUnmanageChild(w);
+}
+
+
+static void show_gz_scrollbars(snd_info *sp)
+{
+ Widget w;
+ w = channel_gsy(sp->chans[0]);
+ if ((w) && (!XtIsManaged(w))) XtManageChild(w);
+ w = channel_gzy(sp->chans[0]);
+ if ((w) && (!XtIsManaged(w))) XtManageChild(w);
+}
+
+
+/* edit history support */
+
+static void history_select_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* undo/redo to reach selected position */
+ XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
+ edit_history_select((chan_info *)context, cbs->item_position - 1);
+}
+
+
+#if WITH_RELATIVE_PANES
+
+/* using undocumented callback here, as in snd-xsnd.c */
+static void remake_edit_history(Widget lst, chan_info *cp, int from_graph)
+{
+ snd_info *sp;
+ int i, eds;
+ XmString *edits;
+
+ if (cp->squelch_update) return;
+ XmListDeleteAllItems(lst);
+ sp = cp->sound;
+
+ if (sp->channel_style != CHANNELS_SEPARATE)
+ {
+ chan_info *ncp;
+ int k, all_eds = 0, ed, filelen;
+ char *title;
+
+ for (k = 0; k < sp->nchans; k++)
+ {
+ ncp = sp->chans[k];
+ eds = ncp->edit_ctr;
+ while ((eds < (ncp->edit_size - 1)) && (ncp->edits[eds + 1])) eds++;
+ all_eds += eds;
+ }
+ all_eds += 3 * sp->nchans;
+ edits = (XmString *)calloc(all_eds, sizeof(XmString));
+ filelen = 16 + strlen(sp->filename);
+ title = (char *)calloc(filelen, sizeof(char));
+ for (k = 0, ed = 0; k < sp->nchans; k++)
+ {
+ ncp = sp->chans[k];
+ ncp->edhist_base = ed;
+ snprintf(title, filelen, "chan %d: %s", k + 1, sp->filename);
+ edits[ed++] = XmStringCreateLocalized(title);
+ eds = ncp->edit_ctr;
+ while ((eds < (ncp->edit_size - 1)) && (ncp->edits[eds + 1])) eds++;
+ for (i = 1; i <= eds; i++)
+ {
+ char *temp;
+ temp = edit_to_string(ncp, i);
+ edits[ed++] = XmStringCreateLocalized(temp);
+ free(temp);
+ }
+ if (k < sp->nchans - 1)
+ edits[ed++] = XmStringCreateLocalized((char *)"______________________________");
+ }
+ free(title);
+ XtVaSetValues(lst,
+ XmNitems, edits,
+ XmNitemCount, ed,
+ NULL);
+ for (i = 0; i < ed; i++)
+ XmStringFree(edits[i]);
+ free(edits);
+ XmListSelectPos(lst, cp->edhist_base + cp->edit_ctr + 1, false);
+ if (from_graph) goto_graph(cp);
+ }
+ else
+ {
+ int items = 0;
+ eds = cp->edit_ctr;
+ while ((eds < (cp->edit_size - 1)) && (cp->edits[eds + 1])) eds++;
+ edits = (XmString *)calloc(eds + 1, sizeof(XmString));
+ edits[0] = XmStringCreateLocalized(sp->filename);
+ for (i = 1; i <= eds; i++)
+ {
+ char *temp;
+ temp = edit_to_string(cp, i);
+ edits[i] = XmStringCreateLocalized(temp);
+ free(temp);
+ }
+ XtVaSetValues(lst,
+ XmNitems, edits,
+ XmNitemCount, eds + 1,
+ NULL);
+ for (i = 0; i <= eds; i++)
+ XmStringFree(edits[i]);
+ free(edits);
+ XmListSelectPos(lst, cp->edit_ctr + 1, false);
+ XtVaGetValues(lst, XmNvisibleItemCount, &items, NULL);
+ if (items <= eds)
+ XtVaSetValues(lst, XmNtopItemPosition, eds - items + 2, NULL);
+ if (from_graph) goto_graph(cp);
+ }
+}
+
+
+static void watch_edit_history_sash(Widget w, XtPointer closure, XtPointer info)
+{
+ SashCallData call_data = (SashCallData)info;
+ /* call_data->params[0]: Commit, Move, Key, Start (as strings) */
+ if ((call_data->params) &&
+ (mus_strcmp(call_data->params[0], "Start")))
+ {
+ chan_info *cp = (chan_info *)closure;
+ Widget edhist;
+ if ((cp) && (cp->chan_widgets))
+ {
+ edhist = EDIT_HISTORY_LIST(cp);
+ if (edhist)
+ remake_edit_history(edhist, cp, false);
+ }
+ }
+}
+#endif
+
+
+void reflect_edit_history_change(chan_info *cp)
+{
+ /* new edit so it is added, and any trailing lines removed */
+ snd_info *sp;
+ Widget lst;
+
+ if (cp->squelch_update) return;
+ if (cp->in_as_one_edit > 0) return;
+ sp = cp->sound;
+ lst = EDIT_HISTORY_LIST(cp);
+#if WITH_RELATIVE_PANES
+ if ((lst) && (widget_width(lst) > 1))
+ remake_edit_history(lst, cp, true);
+ else
+ {
+ if ((cp->chan > 0) && (sp->channel_style != CHANNELS_SEPARATE))
+ {
+ lst = EDIT_HISTORY_LIST(sp->chans[0]);
+ if ((lst) && (widget_width(lst) > 1))
+ remake_edit_history(lst, sp->chans[0], true);
+ }
+ }
+#else
+ /* old form */
+ if (lst)
+ {
+ int i, eds, items = 0;
+ XmString *edits;
+ eds = cp->edit_ctr;
+ while ((eds < (cp->edit_size - 1)) && (cp->edits[eds + 1])) eds++;
+ if (eds >= 0)
+ {
+ if ((eds == cp->edit_ctr) && (eds > 1)) /* need to force 0 (1) case to start list with sound file name */
+ {
+ XmString edit;
+ /* special common case -- we're appending a new edit description */
+ XtVaGetValues(lst, XmNitemCount, &items, NULL);
+ if (items > eds )
+ XmListDeleteItemsPos(lst, cp->edit_size, eds + 1);
+ /* cp->edit_size is too large, but the manual says this is the way to delete to the end */
+ {
+ char *temp;
+ temp = edit_to_string(cp, eds);
+ edit = XmStringCreateLocalized(temp);
+ free(temp);
+ }
+ XmListAddItemUnselected(lst, edit, eds + 1);
+ XmStringFree(edit);
+ }
+ else
+ {
+ edits = (XmString *)calloc(eds + 1, sizeof(XmString));
+ edits[0] = XmStringCreateLocalized(sp->filename);
+ for (i = 1; i <= eds; i++)
+ {
+ char *temp;
+ temp = edit_to_string(cp, i);
+ edits[i] = XmStringCreateLocalized(temp);
+ free(temp);
+ }
+ XtVaSetValues(lst,
+ XmNitems, edits,
+ XmNitemCount, eds + 1,
+ NULL);
+ for (i = 0; i <= eds; i++)
+ XmStringFree(edits[i]);
+ free(edits);
+ }
+ XmListSelectPos(lst, cp->edit_ctr + 1, false);
+ XtVaGetValues(lst, XmNvisibleItemCount, &items, NULL);
+ if (items <= eds)
+ XtVaSetValues(lst, XmNtopItemPosition, eds - items + 2, NULL);
+ goto_graph(cp);
+ }
+ }
+#endif
+}
+
+
+void reflect_edit_counter_change(chan_info *cp)
+{
+ /* undo/redo/revert -- change which line is highlighted */
+ Widget lst;
+
+ if (cp->squelch_update) return;
+ lst = EDIT_HISTORY_LIST(cp);
+ if ((lst) && (widget_width(lst) > 1))
+ {
+ int len, top;
+ XmListSelectPos(lst, cp->edit_ctr + 1, false);
+ XtVaGetValues(lst,
+ XmNvisibleItemCount, &len,
+ XmNtopItemPosition, &top,
+ NULL);
+ if ((cp->edit_ctr + 1) < top)
+ XtVaSetValues(lst, XmNtopItemPosition, cp->edit_ctr + 1, NULL);
+ else
+ if ((cp->edit_ctr + 1) >= (top + len))
+ XtVaSetValues(lst, XmNtopItemPosition, cp->edit_ctr, NULL);
+ goto_graph(cp);
+ }
+}
+
+
+/* for combined cases, the incoming chan_info pointer is always chan[0],
+ * but the actual channel depends on placement if mouse oriented.
+ * virtual_selected_channel(cp) (snd-chn.c) retains the current selected channel
+ */
+
+void graph_key_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XKeyEvent *ev = (XKeyEvent *)event;
+ KeySym keysym;
+ int key_state;
+ snd_info *sp = (snd_info *)context;
+ key_state = ev->state;
+ keysym = XkbKeycodeToKeysym(XtDisplay(w),
+ (int)(ev->keycode),
+ 0, (key_state & snd_ShiftMask) ? 1 : 0);
+ key_press_callback(any_selected_channel(sp), ev->x, ev->y, ev->state, keysym);
+}
+
+
+static void cp_graph_key_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ /* called by every key-intercepting widget in the entire sound pane */
+ XKeyEvent *ev = (XKeyEvent *)event;
+ KeySym keysym;
+ int key_state;
+ chan_info *cp = (chan_info *)context;
+ if ((cp == NULL) || (cp->sound == NULL)) return; /* can't happen */
+ key_state = ev->state;
+ keysym = XkbKeycodeToKeysym(XtDisplay(w),
+ (int)(ev->keycode),
+ 0, (key_state & snd_ShiftMask) ? 1 : 0);
+ key_press_callback(cp, ev->x, ev->y, ev->state, keysym);
+}
+
+
+static void channel_drop_watcher(Widget w, const char *str, Position x, Position y, void *context)
+{
+ pointer_or_int_t data;
+ data = (pointer_or_int_t)context;
+ drag_and_drop_mix_at_x_y((int)data, str, x, y);
+}
+
+
+static void channel_drag_watcher(Widget w, const char *str, Position x, Position y, drag_style_t dtype, void *context)
+{
+ int snd, chn;
+ pointer_or_int_t data;
+ snd_info *sp;
+ XtVaGetValues(w, XmNuserData, &data, NULL);
+ chn = unpack_channel(data);
+ snd = unpack_sound(data);
+
+ sp = ss->sounds[snd];
+ if (snd_ok(sp))
+ {
+ float seconds;
+ chan_info *cp;
+ switch (dtype)
+ {
+ case DRAG_ENTER:
+ case DRAG_MOTION:
+ cp = sp->chans[chn];
+ if ((sp->nchans > 1) && (sp->channel_style == CHANNELS_COMBINED))
+ cp = which_channel(sp, y);
+ seconds = (float)(ungrf_x(cp->axis, x));
+ if (seconds < 0.0) seconds = 0.0;
+ if (sp->nchans > 1)
+ status_report(sp, "drop to mix file in chan %d at %.4f", cp->chan + 1, seconds);
+ else status_report(sp, "drop to mix file at %.4f", seconds);
+ break;
+
+ case DRAG_LEAVE:
+ set_status(sp, " ", false); /* not clear_status_area here! => segfault */
+ break;
+ }
+ }
+}
+
+
+int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Widget main, fw_button_t button_style, bool with_events)
+{
+ bool need_extra_scrollbars;
+ Widget *cw;
+ chan_info *cp;
+ graphics_context *cax;
+ bool make_widgets;
+
+ /* if ((main) && ((!(XmIsForm(main))) || (!(XtWindow(main))))) return(-1); */ /* new gcc complains about the XmIsForm for some reason */
+ if ((main) && (!(XtWindow(main)))) return(-1); /* can this happen? */
+
+ make_widgets = ((sp->chans[channel]) == NULL);
+ sp->chans[channel] = make_chan_info(sp->chans[channel], channel, sp);
+ cp = sp->chans[channel];
+
+ if (cp->chan_widgets == NULL)
+ cp->chan_widgets = (Widget *)calloc(NUM_CHAN_WIDGETS, sizeof(Widget));
+ cw = cp->chan_widgets;
+ need_extra_scrollbars = ((!main) && (channel == 0));
+
+ if (make_widgets)
+ {
+ XtCallbackList n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12, n13, n14, n15;
+ int n;
+ Arg args[32];
+
+ /* allocate the entire widget apparatus for this channel of this sound */
+
+ if (!main)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ if (insertion) {XtSetArg(args[n], XmNpositionIndex, (short)channel); n++;}
+ XtSetArg(args[n], XmNpaneMinimum, chan_y); n++;
+
+ cw[W_form] = XtCreateManagedWidget("chn-form", xmFormWidgetClass, w_snd_pane(sp), args, n);
+ if ((sp->channel_style == CHANNELS_COMBINED) && (channel > 0)) XtUnmanageChild(cw[W_form]);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ /* n = no_padding(args, n); */
+ n = attach_all_sides(args, n);
+ XtSetArg(args[n], XmNsashIndent, 2); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
+ cw[W_top] = XtCreateManagedWidget("chn-top", xmPanedWindowWidgetClass, cw[W_form], args, n);
+ XtAddEventHandler(cw[W_top], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->white); n++;
+ XtSetArg(args[n], XmNpaneMaximum, DEFAULT_EDIT_HISTORY_WIDTH); n++;
+ XtSetArg(args[n], XmNlistSizePolicy, XmCONSTANT); n++;
+ cw[W_edhist] = XmCreateScrolledList(cw[W_top], (char *)"chn-edhist", args, n);
+ XtManageChild(cw[W_edhist]);
+
+ XtAddCallback(cw[W_edhist], XmNbrowseSelectionCallback, history_select_callback, cp);
+ XtAddEventHandler(cw[W_edhist], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddEventHandler(XtParent(cw[W_edhist]), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
+ cw[W_main_window] = XtCreateManagedWidget("chn-main-window", xmFormWidgetClass, cw[W_top], args, n);
+ XtAddEventHandler(cw[W_main_window], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+#if WITH_RELATIVE_PANES
+ {
+ int k;
+ Widget child;
+ CompositeWidget w = (CompositeWidget)(cw[W_top]);
+ for (k = w->composite.num_children - 1; k >= 0; k--)
+ {
+ child = w->composite.children[k];
+ if ((XtIsWidget(child)) &&
+ (XtIsSubclass(child, xmSashWidgetClass)))
+ {
+ XtAddCallback(child, XmNcallback, watch_edit_history_sash, (XtPointer)cp);
+ break; /* there seems to be more than 1?? */
+ }
+ }
+ }
+#endif
+ }
+ else cw[W_main_window] = main;
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ n = no_padding(args, n);
+ XtSetArg(args[n], XmNpacking, XmPACK_COLUMN); n++;
+ XtSetArg(args[n], XmNnumColumns, 1); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ cw[W_wf_buttons] = XtCreateManagedWidget("chn-buttons", xmRowColumnWidgetClass, cw[W_main_window], args, n);
+
+ if (button_style == WITH_FW_BUTTONS)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNspacing, 1); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ cw[W_f] = make_togglebutton_widget("f", cw[W_wf_buttons], args, n);
+ XtAddCallback(cw[W_f], XmNvalueChangedCallback, f_toggle_callback, cp);
+ XtAddEventHandler(cw[W_f], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ XtSetArg(args[n], XmNset, true); n++;
+ cw[W_w] = make_togglebutton_widget("w", cw[W_wf_buttons], args, n);
+ XtAddCallback(cw[W_w], XmNvalueChangedCallback, w_toggle_callback, cp);
+ XtAddEventHandler(cw[W_w], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ }
+ else
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNarrowDirection, XmARROW_UP); n++;
+ XtSetArg(args[n], XmNsensitive, false); n++;
+ cw[W_f] = XtCreateManagedWidget("up", xmArrowButtonWidgetClass, cw[W_wf_buttons], args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNarrowDirection, XmARROW_DOWN); n++;
+ XtSetArg(args[n], XmNsensitive, false); n++;
+ cw[W_w] = XtCreateManagedWidget("down", xmArrowButtonWidgetClass, cw[W_wf_buttons], args, n);
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, cw[W_wf_buttons]); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNspacing, 0); n++;
+ cw[W_left_scrollers] = XtCreateManagedWidget("chn-left", xmRowColumnWidgetClass, cw[W_main_window], args, n);
+ XtAddEventHandler(cw[W_left_scrollers], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
+ XtSetArg(args[n], XmNwidth, ss->position_slider_width); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNincrement, 1); n++;
+ XtSetArg(args[n], XmNprocessingDirection, XmMAX_ON_TOP); n++;
+ XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(zy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(zy_valuechanged_callback, (XtPointer)cp)); n++;
+ cw[W_zy] = XtCreateManagedWidget("chn-zy", xmScrollBarWidgetClass, cw[W_left_scrollers], args, n);
+ XtAddEventHandler(cw[W_zy], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNwidth, ss->zoom_slider_width); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, cw[W_zy]); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNincrement, 1); n++;
+ XtSetArg(args[n], XmNprocessingDirection, XmMAX_ON_TOP); n++;
+ XtSetArg(args[n], XmNdragCallback, n3 = make_callback_list(sy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n4 = make_callback_list(sy_valuechanged_callback, (XtPointer)cp)); n++;
+ cw[W_sy] = XtCreateManagedWidget("chn-sy", xmScrollBarWidgetClass, cw[W_left_scrollers], args, n);
+ XtAddEventHandler(cw[W_sy], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, cw[W_wf_buttons]); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNspacing, 0); n++;
+ cw[W_bottom_scrollers] = XtCreateManagedWidget("chn-bottom", xmRowColumnWidgetClass, cw[W_main_window], args, n);
+ XtAddEventHandler(cw[W_bottom_scrollers], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNheight, ss->position_slider_width); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNincrement, 1); n++;
+ XtSetArg(args[n], XmNdragCallback, n5 = make_callback_list(sx_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNincrementCallback, n6 = make_callback_list(sx_increment_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNdecrementCallback, n7 = make_callback_list(sx_decrement_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n8 = make_callback_list(sx_valuechanged_callback, (XtPointer)cp)); n++;
+ cw[W_sx] = XtCreateManagedWidget("chn-sx", xmScrollBarWidgetClass, cw[W_bottom_scrollers], args, n);
+ XtAddEventHandler(cw[W_sx], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
+ XtSetArg(args[n], XmNheight, ss->zoom_slider_width + 2); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, cw[W_sx]); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNincrement, 1); n++;
+ XtSetArg(args[n], XmNdragCallback, n9 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNincrementCallback, n10 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNdecrementCallback, n11 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNpageIncrementCallback, n12 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNpageDecrementCallback, n13 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNtoTopCallback, n14 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNtoBottomCallback, n15 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
+
+ cw[W_zx] = XtCreateManagedWidget("chn-zx", xmScrollBarWidgetClass, cw[W_bottom_scrollers], args, n);
+ XtAddEventHandler(cw[W_zx], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->graph_color); n++;
+ XtSetArg(args[n], XmNforeground, ss->data_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, cw[W_bottom_scrollers]); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, cw[W_left_scrollers]); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNuserData, pack_sound_and_channel(sp->index, cp->chan)); n++;
+ /* this collides with W_gzy below, but a consistent version came up with half a window blank */
+ XtSetArg(args[n], XmNnavigationType, XmNONE); n++;
+ cw[W_graph] = XtCreateManagedWidget("chn-graph", xmDrawingAreaWidgetClass, cw[W_main_window], args, n);
+
+ if (with_events)
+ {
+ /* region regraph sets up its own callbacks */
+ XtAddCallback(cw[W_graph], XmNresizeCallback, channel_resize_callback, (XtPointer)cp);
+ XtAddCallback(cw[W_graph], XmNexposeCallback, channel_expose_callback, (XtPointer)cp);
+ }
+ /* allow cursor in all cases (zoom to cursor in region window for example, or fft axis drag in variable display) */
+ XtAddEventHandler(cw[W_graph], ButtonPressMask, false, graph_button_press, (XtPointer)cp);
+ XtAddEventHandler(cw[W_graph], ButtonReleaseMask, false, graph_button_release, (XtPointer)cp);
+ /* XtAddEventHandler(cw[W_graph], ButtonMotionMask, false, graph_button_motion, (XtPointer)cp); */
+ XtAddEventHandler(cw[W_graph], PointerMotionMask, false, graph_mouse_motion, (XtPointer)cp);
+ if (main == NULL)
+ {
+ pointer_or_int_t data;
+ XtAddEventHandler(cw[W_graph], EnterWindowMask, false, graph_mouse_enter, (XtPointer)cp);
+ XtAddEventHandler(cw[W_graph], LeaveWindowMask, false, graph_mouse_leave, (XtPointer)cp);
+ XtAddEventHandler(cw[W_graph], KeyPressMask, false, cp_graph_key_press, (XtPointer)cp);
+
+ data = (pointer_or_int_t)pack_sound_and_channel(sp->index, cp->chan);
+ add_drag_and_drop(cw[W_graph], channel_drop_watcher, channel_drag_watcher, (void *)data);
+ }
+
+ free(n1);
+ free(n2);
+ free(n3);
+ free(n4);
+ free(n5);
+ free(n6);
+ free(n7);
+ free(n8);
+ free(n9);
+ free(n10);
+ free(n11);
+ free(n12);
+ free(n13);
+ free(n14);
+ free(n15);
+
+ if (need_extra_scrollbars)
+ {
+ /* that is: not region browser chan, might need combined graph, channel 0 is the controller in that case */
+ /* this is independent of sp->nchans because these structs are re-used and added to as needed */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
+ XtSetArg(args[n], XmNwidth, ss->position_slider_width); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, cw[W_bottom_scrollers]); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNincrement, 1); n++;
+ XtSetArg(args[n], XmNprocessingDirection, XmMAX_ON_TOP); n++;
+
+ XtSetArg(args[n], XmNincrementCallback, n1 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNdecrementCallback, n2 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNpageIncrementCallback, n3 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNpageDecrementCallback, n4 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNtoTopCallback, n5 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNtoBottomCallback, n6 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNdragCallback, n7 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
+
+ cw[W_gzy] = XtCreateManagedWidget("chn-gzy", xmScrollBarWidgetClass, cw[W_main_window], args, n);
+ XtAddEventHandler(cw[W_gzy], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNwidth, ss->position_slider_width); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, cw[W_bottom_scrollers]); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, cw[W_gzy]); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNincrement, 1); n++;
+ XtSetArg(args[n], XmNprocessingDirection, XmMAX_ON_TOP); n++;
+ XtSetArg(args[n], XmNdragCallback, n8 = make_callback_list(gsy_drag_callback, (XtPointer)cp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n9 = make_callback_list(gsy_valuechanged_callback, (XtPointer)cp)); n++;
+ cw[W_gsy] = XtCreateManagedWidget("chn-gsy", xmScrollBarWidgetClass, cw[W_main_window], args, n);
+ XtAddEventHandler(cw[W_gsy], KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ free(n1);
+ free(n2);
+ free(n3);
+ free(n4);
+ free(n5);
+ free(n6);
+ free(n7);
+
+ free(n8);
+ free(n9);
+ }
+ else
+ {
+ cw[W_gsy] = NULL;
+ cw[W_gzy] = NULL;
+ }
+ run_new_widget_hook(cw[W_main_window]);
+ /* also position of current graph in overall sound as window */
+
+ } /* end alloc new chan */
+
+ else
+ {
+ int i;
+ /* re-manage currently inactive chan */
+ XtVaSetValues(cw[W_main_window], XmNpaneMinimum, chan_y, NULL);
+ if (cw[W_edhist])
+ XtVaSetValues(XtParent(cw[W_edhist]), XmNpaneMaximum, 1, NULL);
+ if ((sp->channel_style != CHANNELS_COMBINED) ||
+ (channel == 0))
+ for (i = 0; i < NUM_CHAN_WIDGETS - 1; i++)
+ if ((cw[i]) && (!XtIsManaged(cw[i])))
+ XtManageChild(cw[i]);
+ recolor_graph(cp, false); /* in case selection color left over from previous use */
+ }
+
+ if (cw[W_edhist])
+ XtVaSetValues(XtParent(cw[W_edhist]), XmNpaneMaximum, LOTSA_PIXELS, NULL);
+
+ if ((need_extra_scrollbars) &&
+ (sp->channel_style != CHANNELS_COMBINED))
+ hide_gz_scrollbars(sp); /* default is on in this case */
+
+ cax = cp->ax;
+ cax->wn = XtWindow(cw[W_graph]);
+ cax->dp = XtDisplay(cw[W_graph]);
+ cax->gc = ss->basic_gc;
+ return(0);
+}
+
+
+static void set_graph_font(chan_info *cp, graphics_context *ax, XFontStruct *bf)
+{
+ if (!ax) return;
+ ax->current_font = bf->fid;
+ XSetFont(XtDisplay(channel_to_widget(cp)), copy_GC(cp), bf->fid);
+}
+
+
+void set_peak_numbers_font(chan_info *cp, graphics_context *ax) {set_graph_font(cp, ax, PEAKS_FONT(ss));}
+
+void set_tiny_numbers_font(chan_info *cp, graphics_context *ax) {set_graph_font(cp, ax, TINY_FONT(ss));}
+
+void set_bold_peak_numbers_font(chan_info *cp, graphics_context *ax) {set_graph_font(cp, ax, BOLD_PEAKS_FONT(ss));}
+
+
+color_t get_foreground_color(graphics_context *ax)
+{
+ XGCValues gv;
+ XGetGCValues(MAIN_DISPLAY(ss), ax->gc, GCForeground, &gv);
+ return(gv.foreground);
+}
+
+
+void set_foreground_color(graphics_context *ax, Pixel color)
+{
+ XSetForeground(MAIN_DISPLAY(ss), ax->gc, color);
+}
+
+
+GC copy_GC(chan_info *cp)
+{
+ if (cp->selected) return(ss->selected_basic_gc);
+ return(ss->basic_gc);
+}
+
+
+GC erase_GC(chan_info *cp)
+{
+ /* used only to clear partial bgs in chan graphs */
+ snd_info *sp;
+ sp = cp->sound;
+ if ((cp->selected) ||
+ ((sp) &&
+ (sp->channel_style == CHANNELS_SUPERIMPOSED) &&
+ (sp->index == ss->selected_sound)))
+ return(ss->selected_erase_gc);
+ return(ss->erase_gc);
+}
+
+
+void free_fft_pix(chan_info *cp)
+{
+ if ((cp->fft_pix != None) &&
+ (channel_graph(cp)))
+ XFreePixmap(XtDisplay(channel_graph(cp)),
+ cp->fft_pix);
+ cp->fft_pix = None;
+ cp->fft_pix_ready = false;
+}
+
+
+bool restore_fft_pix(chan_info *cp, graphics_context *ax)
+{
+ XCopyArea(ax->dp,
+ cp->fft_pix,
+ ax->wn,
+ copy_GC(cp),
+ 0, 0, /* source x y */
+ cp->fft_pix_width, cp->fft_pix_height,
+ cp->fft_pix_x0, cp->fft_pix_y0);
+ return(true);
+}
+
+
+void save_fft_pix(chan_info *cp, graphics_context *ax, int fwidth, int fheight, int x0, int y1)
+{
+ if ((fwidth == 0) || (fheight == 0)) return;
+ if (cp->fft_pix == None)
+ {
+ /* make new pixmap */
+ cp->fft_pix_width = fwidth;
+ cp->fft_pix_height = fheight;
+ cp->fft_pix_x0 = x0;
+ cp->fft_pix_y0 = y1;
+ cp->fft_pix_cutoff = cp->spectrum_end;
+ cp->fft_pix = XCreatePixmap(ax->dp,
+ RootWindowOfScreen(XtScreen(channel_graph(cp))),
+ fwidth, fheight,
+ DefaultDepthOfScreen(XtScreen(channel_graph(cp))));
+ }
+ XCopyArea(ax->dp,
+ ax->wn,
+ cp->fft_pix,
+ copy_GC(cp),
+ cp->fft_pix_x0, cp->fft_pix_y0,
+ cp->fft_pix_width, cp->fft_pix_height,
+ 0, 0);
+ cp->fft_pix_ready = true;
+}
+
+
+void cleanup_cw(chan_info *cp)
+{
+ if (cp)
+ {
+ Widget *cw;
+ free_fft_pix(cp);
+
+ cp->selected = false;
+ cw = cp->chan_widgets;
+ if (cw)
+ {
+ if (cw[W_w])
+ {
+ XtVaSetValues(cw[W_w], XmNset, true, NULL);
+ XtVaSetValues(cw[W_f], XmNset, false, NULL);
+ }
+ if (channel_main_pane(cp))
+ XtUnmanageChild(channel_main_pane(cp));
+ }
+ }
+}
+
+
+void change_channel_style(snd_info *sp, channel_style_t new_style)
+{
+ if ((sp) &&
+ (sp->nchans > 1))
+ {
+ channel_style_t old_style;
+ chan_info *selected_cp;
+
+ selected_cp = any_selected_channel(sp); /* chan 0 is none is selected */
+ old_style = sp->channel_style;
+ sp->channel_style = new_style;
+
+ if (new_style != old_style)
+ {
+ int i, height;
+
+#if WITH_RELATIVE_PANES
+ if ((new_style == CHANNELS_SEPARATE) || (old_style == CHANNELS_SEPARATE))
+ {
+ Widget lst;
+ lst = EDIT_HISTORY_LIST(sp->chans[0]);
+ if ((lst) && (widget_width(lst) > 1))
+ remake_edit_history(lst, sp->chans[0], true);
+ }
+#endif
+
+ if (old_style == CHANNELS_COMBINED)
+ {
+ hide_gz_scrollbars(sp);
+ for (i = 1; i < sp->nchans; i++) channel_set_mix_tags_erased(sp->chans[i]);
+ }
+ else
+ {
+ if (new_style == CHANNELS_COMBINED)
+ {
+ show_gz_scrollbars(sp);
+ for (i = 1; i < sp->nchans; i++) channel_set_mix_tags_erased(sp->chans[i]);
+ }
+ }
+
+ if (old_style == CHANNELS_SUPERIMPOSED)
+ {
+ syncb(sp, sp->previous_sync);
+ XtVaSetValues(unite_button(sp), XmNselectColor, ss->selection_color, NULL);
+ }
+ else
+ {
+ if (new_style == CHANNELS_SUPERIMPOSED)
+ {
+ sp->previous_sync = sp->sync;
+ if (sp->sync == 0) syncb(sp, 1);
+ XtVaSetValues(unite_button(sp), XmNselectColor, ss->green, NULL);
+
+ apply_y_axis_change(selected_cp);
+ apply_x_axis_change(selected_cp);
+
+ for (i = 0; i < sp->nchans; i++)
+ {
+ if (i != selected_cp->chan)
+ {
+ chan_info *ncp;
+ ncp = sp->chans[i];
+ cursor_sample(ncp) = cursor_sample(selected_cp);
+ if (selected_cp->graph_transform_on != ncp->graph_transform_on)
+ {
+ ncp->graph_transform_on = selected_cp->graph_transform_on;
+ set_toggle_button(channel_f(ncp), selected_cp->graph_transform_on, false, (void *)ncp);
+ }
+ if (selected_cp->graph_time_on != ncp->graph_time_on)
+ {
+ ncp->graph_time_on = selected_cp->graph_time_on;
+ set_toggle_button(channel_w(ncp), selected_cp->graph_time_on, false, (void *)ncp);
+ }
+ }
+ }
+ }
+ }
+
+ height = widget_height(w_snd_pane(sp)) - control_panel_height(sp);
+ if (old_style == CHANNELS_SEPARATE)
+ {
+ axis_info *ap;
+ ap = selected_cp->axis;
+ channel_lock_pane(sp->chans[0], height);
+
+ for (i = 0; i < sp->nchans; i++)
+ {
+ if (i != selected_cp->chan)
+ set_axes(sp->chans[i], ap->x0, ap->x1, ap->y0, ap->y1);
+ if (i > 0)
+ cleanup_cw(sp->chans[i]);
+ }
+
+ channel_open_pane(sp->chans[0]);
+ channel_unlock_pane(sp->chans[0]);
+ XmToggleButtonSetState(unite_button(sp), true, false);
+ }
+ else
+ {
+ if (new_style == CHANNELS_SEPARATE)
+ {
+ /* height = total space available */
+ height /= sp->nchans;
+ for_each_sound_chan_with_int(sp, channel_lock_pane, height);
+ for_each_sound_chan(sp, channel_open_pane);
+ for_each_sound_chan(sp, channel_unlock_pane);
+
+ for (i = 1; i < sp->nchans; i++)
+ {
+ Widget *cw;
+ chan_info *cp;
+ int j;
+
+ cp = sp->chans[i];
+ cw = cp->chan_widgets;
+
+ for (j = 0; j < NUM_CHAN_WIDGETS - 1; j++)
+ if ((cw[j]) && (!XtIsManaged(cw[j])))
+ XtManageChild(cw[j]);
+
+ XmToggleButtonSetState(cw[W_f], (Boolean)(cp->graph_transform_on), false);
+ XmToggleButtonSetState(cw[W_w], (Boolean)(cp->graph_time_on), false);
+ /* these can get out of sync if changes are made in the unseparated case */
+ }
+
+ XmToggleButtonSetState(unite_button(sp), false, false);
+ if (sp->selected_channel > 0) color_selected_channel(sp);
+ }
+ }
+
+ if ((new_style == CHANNELS_COMBINED) &&
+ (sp->selected_channel > 0))
+ color_selected_channel(sp);
+ }
+ }
+}
+
+
+static Xen g_channel_widgets(Xen snd, Xen chn)
+{
+ #define H_channel_widgets "(" S_channel_widgets " :optional snd chn): a list of widgets: ((0)graph (1)w (2)f (3)sx (4)sy (5)zx (6)zy (7)edhist)"
+ chan_info *cp;
+ Snd_assert_channel(S_channel_widgets, snd, chn, 1);
+ cp = get_cp(snd, chn, S_channel_widgets);
+ if (!cp) return(Xen_false);
+ return(Xen_cons(Xen_wrap_widget(channel_graph(cp)),
+ Xen_cons(Xen_wrap_widget(channel_w(cp)),
+ Xen_cons(Xen_wrap_widget(channel_f(cp)),
+ Xen_cons(Xen_wrap_widget(channel_sx(cp)),
+ Xen_cons(Xen_wrap_widget(channel_sy(cp)),
+ Xen_cons(Xen_wrap_widget(channel_zx(cp)),
+ Xen_cons(Xen_wrap_widget(channel_zy(cp)),
+ Xen_cons(Xen_wrap_widget(EDIT_HISTORY_LIST(cp)),
+ Xen_cons(Xen_wrap_widget(channel_gsy(cp)),
+ Xen_cons(Xen_wrap_widget(channel_gzy(cp)),
+ Xen_cons(Xen_wrap_widget(channel_main_pane(cp)),
+ Xen_empty_list))))))))))));
+}
+
+
+/* previous snd-xxen.c contents) */
+
+static void timed_eval(XtPointer in_code, XtIntervalId *id)
+{
+#if HAVE_EXTENSION_LANGUAGE
+ Xen lst = (XEN)in_code;
+ Xen_call_with_no_args(Xen_cadr(lst), "timed callback func");
+ snd_unprotect_at(Xen_integer_to_C_int(Xen_car(lst)));
+#endif
+}
+
+
+static Xen g_in(Xen ms, Xen code)
+{
+ #define H_in "(" S_in " msecs thunk): invoke thunk in msecs milliseconds (named call_in in Ruby)"
+
+#if HAVE_EXTENSION_LANGUAGE
+ Xen_check_type(Xen_is_number(ms), ms, 1, S_in, "a number");
+ Xen_check_type(Xen_is_procedure(code), code, 2, S_in, "a procedure");
+
+ if (Xen_is_aritable(code, 0))
+ {
+ int secs;
+ Xen_check_type(Xen_is_integer(ms), ms, 3, S_in, "an integer");
+ secs = Xen_integer_to_C_int(ms);
+ if (secs < 0)
+ Xen_out_of_range_error(S_in, 1, ms, "a positive integer");
+ else
+ {
+ Xen lst;
+ lst = Xen_list_2(Xen_false, code);
+ Xen_list_set(lst, 0, C_int_to_Xen_integer(snd_protect(lst)));
+ XtAppAddTimeOut(MAIN_APP(ss),
+ (unsigned long)secs,
+ (XtTimerCallbackProc)timed_eval,
+ (XtPointer)lst);
+ }
+ }
+ else Xen_bad_arity_error(S_in, 2, code, "should take no args");
+#endif
+
+ return(ms);
+}
+
+
+void color_unselected_graphs(color_t color)
+{
+ int i;
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ snd_info *sp;
+ int j;
+ sp = ss->sounds[i];
+ if ((sp) && (sp->inuse != SOUND_WRAPPER))
+ for (j = 0; j < sp->allocated_chans; j++)
+ {
+ chan_info *cp;
+ cp = sp->chans[j];
+ if ((cp) && ((i != ss->selected_sound) || (j != sp->selected_channel)))
+ XtVaSetValues(channel_graph(cp), XmNbackground, color, NULL);
+ }
+ }
+}
+
+
+void color_chan_components(color_t color, slider_choice_t which_component)
+{
+ int i;
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ snd_info *sp;
+ int j;
+ sp = ss->sounds[i];
+ if ((sp) && (sp->inuse != SOUND_WRAPPER))
+ for (j = 0; j < sp->allocated_chans; j++)
+ {
+ chan_info *cp;
+ cp = sp->chans[j];
+ if (cp)
+ {
+ if (which_component == COLOR_POSITION)
+ {
+ XtVaSetValues(channel_sx(cp), XmNbackground, color, NULL);
+ XtVaSetValues(channel_sy(cp), XmNbackground, color, NULL);
+ }
+ else
+ {
+ XtVaSetValues(channel_zy(cp), XmNbackground, color, NULL);
+ XtVaSetValues(channel_zx(cp), XmNbackground, color, NULL);
+ }
+ }
+ }
+ }
+}
+
+
+static Xen g_graph_cursor(void)
+{
+ #define H_graph_cursor "(" S_graph_cursor "): current graph cursor shape"
+ return(C_int_to_Xen_integer(in_graph_cursor(ss)));
+}
+
+
+static Xen g_set_graph_cursor(Xen curs)
+{
+ int val;
+ Xen_check_type(Xen_is_integer(curs), curs, 1, S_set S_graph_cursor, "an integer");
+ /* X11/cursorfont.h has various even-numbered glyphs, but the odd numbers are ok, and XC_num_glyphs is a lie */
+ /* if you use too high a number here, X dies */
+ val = Xen_integer_to_C_int(curs);
+ if ((val >= 0) && (val <= XC_xterm))
+ {
+ ss->Graph_Cursor = val;
+ ss->graph_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), in_graph_cursor(ss));
+ }
+ else Xen_out_of_range_error(S_set S_graph_cursor, 1, curs, "invalid cursor");
+ return(curs);
+}
+
+
+Xen_wrap_2_args(g_in_w, g_in)
+Xen_wrap_no_args(g_graph_cursor_w, g_graph_cursor)
+Xen_wrap_1_arg(g_set_graph_cursor_w, g_set_graph_cursor)
+Xen_wrap_2_optional_args(g_channel_widgets_w, g_channel_widgets)
+
+#if HAVE_SCHEME
+static s7_pointer acc_graph_cursor(s7_scheme *sc, s7_pointer args) {return(g_set_graph_cursor(s7_cadr(args)));}
+#endif
+
+
+void g_init_gxchn(void)
+{
+ Xen_define_procedure(S_in, g_in_w, 2, 0, 0, H_in);
+
+ Xen_define_dilambda(S_graph_cursor, g_graph_cursor_w, H_graph_cursor,
+ S_set S_graph_cursor, g_set_graph_cursor_w, 0, 0, 1, 0);
+
+ Xen_define_safe_procedure(S_channel_widgets, g_channel_widgets_w, 0, 2, 0, H_channel_widgets);
+
+#if HAVE_SCHEME
+ #define H_mouse_enter_graph_hook S_mouse_enter_graph_hook " (snd chn): called when the mouse \
+enters the drawing area (graph pane) of the given channel.\n\
+ (hook-push " S_mouse_enter_graph_hook "\n\
+ (lambda (hook)\n\
+ (" S_focus_widget " (car (" S_channel_widgets " (hook 'snd) (hook 'chn))))))"
+
+ #define H_mouse_leave_graph_hook S_mouse_leave_graph_hook " (snd chn): is called when the mouse \
+leaves the drawing area (graph pane) of the given channel."
+#endif
+#if HAVE_RUBY
+ #define H_mouse_enter_graph_hook S_mouse_enter_graph_hook " (snd chn): called when the mouse \
+enters the drawing area (graph pane) of the given channel.\n\
+ $mouse_enter_graph_hook.add-hook!(\"focus\") do |snd chn|\n\
+ focus_widget(channel_widgets(snd, chn)[0])\n\
+ end"
+
+ #define H_mouse_leave_graph_hook S_mouse_leave_graph_hook " (snd chn): called when the mouse \
+leaves the drawing area (graph pane) of the given channel."
+#endif
+#if HAVE_FORTH
+ #define H_mouse_enter_graph_hook S_mouse_enter_graph_hook " (snd chn): called when the mouse \
+enters the drawing area (graph pane) of the given channel.\n\
+" S_mouse_enter_graph_hook " lambda: <{ snd chn }>\n\
+ snd chn " S_channel_widgets " car " S_focus_widget "\n\
+; add-hook!"
+ #define H_mouse_leave_graph_hook S_mouse_leave_graph_hook " (snd chn): is called when the mouse \
+leaves the drawing area (graph pane) of the given channel."
+#endif
+
+ mouse_enter_graph_hook = Xen_define_hook(S_mouse_enter_graph_hook, "(make-hook 'snd 'chn)", 2, H_mouse_enter_graph_hook);
+ mouse_leave_graph_hook = Xen_define_hook(S_mouse_leave_graph_hook, "(make-hook 'snd 'chn)", 2, H_mouse_leave_graph_hook);
+
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->graph_cursor_symbol, s7_make_function(s7, "[acc-" S_graph_cursor "]", acc_graph_cursor, 2, 0, false, "accessor"));
+ s7_symbol_set_documentation(s7, ss->graph_cursor_symbol, "*graph-cursor*: current graph cursor shape");
+#endif
+}
+
+
+#include <X11/xpm.h>
+
+#define sound_env_editor(Sp) ((env_editor *)(sp->flt))
+#define TOGGLE_MARGIN 0
+
+enum {W_pane,
+ W_name_form, W_amp_form,
+ W_amp, W_amp_label, W_amp_number,
+ W_speed, W_speed_label, W_speed_number, W_speed_arrow,
+ W_expand, W_expand_label, W_expand_number, W_expand_button,
+ W_contrast, W_contrast_label, W_contrast_number, W_contrast_button,
+ W_revscl, W_revscl_label, W_revscl_number,
+ W_revlen, W_revlen_label, W_revlen_number, W_reverb_button,
+ W_filter_label, W_filter_order, W_filter_env, W_filter, W_filter_button, W_filter_dB, W_filter_hz, W_filter_frame,
+ W_filter_order_down, W_filter_order_up,
+ W_name, W_lock_or_bomb, W_stop_icon, W_info,
+ W_play, W_sync, W_unite, W_close,
+ NUM_SND_WIDGETS
+};
+
+
+Widget unite_button(snd_info *sp) {return(sp->snd_widgets[W_unite]);}
+Widget w_snd_pane(snd_info *sp) {return(sp->snd_widgets[W_pane]);}
+
+#define SND_PANE(Sp) Sp->snd_widgets[W_pane]
+#define SND_NAME(Sp) Sp->snd_widgets[W_name]
+
+#define NAME_BOX(Sp) Sp->snd_widgets[W_name_form]
+#define LOCK_OR_BOMB(Sp) Sp->snd_widgets[W_lock_or_bomb]
+#define STOP_ICON(Sp) Sp->snd_widgets[W_stop_icon]
+#define NAME_LABEL(Sp) Sp->snd_widgets[W_name]
+#define STATUS_AREA(Sp) Sp->snd_widgets[W_info]
+#define SYNC_BUTTON(Sp) Sp->snd_widgets[W_sync]
+#define PLAY_BUTTON(Sp) Sp->snd_widgets[W_play]
+#define UNITE_BUTTON(Sp) Sp->snd_widgets[W_unite]
+#define CLOSE_BUTTON(Sp) Sp->snd_widgets[W_close]
+
+#define CONTROLS(Sp) Sp->snd_widgets[W_amp_form]
+#define AMP_SCROLLBAR(Sp) Sp->snd_widgets[W_amp]
+#define AMP_LABEL(Sp) Sp->snd_widgets[W_amp_number]
+#define AMP_BUTTON(Sp) Sp->snd_widgets[W_amp_label]
+
+#define SPEED_SCROLLBAR(Sp) Sp->snd_widgets[W_speed]
+#define SPEED_ARROW(Sp) Sp->snd_widgets[W_speed_arrow]
+#define SPEED_LABEL(Sp) Sp->snd_widgets[W_speed_number]
+#define SPEED_BUTTON(Sp) Sp->snd_widgets[W_speed_label]
+
+#define EXPAND_SCROLLBAR(Sp) Sp->snd_widgets[W_expand]
+#define EXPAND_LABEL(Sp) Sp->snd_widgets[W_expand_number]
+#define EXPAND_RIGHT_BUTTON(Sp) Sp->snd_widgets[W_expand_button]
+#define EXPAND_LEFT_BUTTON(Sp) Sp->snd_widgets[W_expand_label]
+
+#define CONTRAST_SCROLLBAR(Sp) Sp->snd_widgets[W_contrast]
+#define CONTRAST_LABEL(Sp) Sp->snd_widgets[W_contrast_number]
+#define CONTRAST_RIGHT_BUTTON(Sp) Sp->snd_widgets[W_contrast_button]
+#define CONTRAST_LEFT_BUTTON(Sp) Sp->snd_widgets[W_contrast_label]
+
+#define REVSCL_SCROLLBAR(Sp) Sp->snd_widgets[W_revscl]
+#define REVLEN_SCROLLBAR(Sp) Sp->snd_widgets[W_revlen]
+#define REVSCL_LABEL(Sp) Sp->snd_widgets[W_revscl_number]
+#define REVLEN_LABEL(Sp) Sp->snd_widgets[W_revlen_number]
+#define REVSCL_BUTTON(Sp) Sp->snd_widgets[W_revscl_label]
+#define REVLEN_BUTTON(Sp) Sp->snd_widgets[W_revlen_label]
+#define REVERB_BUTTON(Sp) Sp->snd_widgets[W_reverb_button]
+
+#define FILTER_ORDER_TEXT(Sp) Sp->snd_widgets[W_filter_order]
+#define FILTER_COEFFS_TEXT(Sp) Sp->snd_widgets[W_filter]
+#define FILTER_BUTTON(Sp) Sp->snd_widgets[W_filter_button]
+#define FILTER_DB_BUTTON(Sp) Sp->snd_widgets[W_filter_dB]
+#define FILTER_HZ_BUTTON(Sp) Sp->snd_widgets[W_filter_hz]
+#define FILTER_LABEL(Sp) Sp->snd_widgets[W_filter_label]
+#define FILTER_GRAPH(Sp) Sp->snd_widgets[W_filter_env]
+#define FILTER_ORDER_UP(Sp) Sp->snd_widgets[W_filter_order_up]
+#define FILTER_ORDER_DOWN(Sp) Sp->snd_widgets[W_filter_order_down]
+#define FILTER_FRAME(Sp) Sp->snd_widgets[W_filter_frame]
+
+#define PROGRESS_ICON(Cp) (Cp)->sound->progress_widgets[(Cp)->chan]
+
+
+int snd_pane_height(snd_info *sp)
+{
+ Dimension height;
+ XtVaGetValues(SND_PANE(sp), XmNheight, &height, NULL);
+ return((int)height);
+}
+
+
+void set_status(snd_info *sp, const char *str, bool update)
+{
+ if ((sp->inuse != SOUND_NORMAL) || (!has_widgets(sp))) return;
+ XmTextSetString(STATUS_AREA(sp), (char *)str);
+ /* updating clears the entire graph widget and triggers an expose event -- this is evil if we're currently displaying! */
+ /* there's also a bug in libxcb (fixed, but not propagated yet) that causes a segfault here if more than
+ * one thread is affected by this global X queue flush.
+ */
+
+ if (update) XmUpdateDisplay(STATUS_AREA(sp));
+}
+
+
+static void name_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *str;
+ snd_info *sp = (snd_info *)context;
+ str = sp_name_click(sp);
+ if (str)
+ {
+ status_report(sp, "%s", str);
+ free(str);
+ }
+}
+
+
+static void stop_sign_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ if ((ss->checking_explicitly) || (play_in_progress()))
+ ss->stopped_explicitly = true;
+ stop_playing_all_sounds(PLAY_C_G);
+ if (sp->applying) stop_applying(sp);
+ for_each_sound_chan(sp, stop_fft_in_progress);
+}
+
+
+/* The 0.9 * SCROLLBAR_MAX reflects the fact that the slider is 10% of the trough, and the left edge of the slider is the readback value */
+
+/* ---------------- AMP-CONTROL ---------------- */
+
+int amp_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
+{
+ if (val <= minval) return(0);
+ if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
+ if (val >= 1.0)
+ return(snd_round(0.9 * 0.5 * SCROLLBAR_MAX * (1.0 + (val - 1.0) / (maxval - 1.0))));
+ return(snd_round(0.9 * 0.5 * SCROLLBAR_MAX * ((val - minval) / (1.0 - minval))));
+}
+
+
+static int scroll_to_amp(snd_info *sp, int val)
+{
+ char amp_number_buffer[6];
+ if (val <= 0)
+ sp->amp_control = sp->amp_control_min;
+ else
+ {
+ if (val >= (0.9 * SCROLLBAR_MAX))
+ sp->amp_control = sp->amp_control_max;
+ else
+ {
+ if (val > (0.5 * 0.9 * SCROLLBAR_MAX))
+ sp->amp_control = (((val / (0.5 * 0.9 * SCROLLBAR_MAX)) - 1.0) * (sp->amp_control_max - 1.0)) + 1.0;
+ else sp->amp_control = (val * (1.0 - sp->amp_control_min) / (0.5 * 0.9 * SCROLLBAR_MAX)) + sp->amp_control_min;
+ }
+ }
+ snprintf(amp_number_buffer, 6, "%.3f", sp->amp_control);
+ set_label(AMP_LABEL(sp), amp_number_buffer);
+ return(val);
+}
+
+
+void set_amp(snd_info *sp, mus_float_t val)
+{
+ if (!has_widgets(sp))
+ sp->amp_control = val;
+ else XtVaSetValues(AMP_SCROLLBAR(sp),
+ XmNvalue,
+ scroll_to_amp(sp, amp_to_scroll(sp->amp_control_min, val, sp->amp_control_max)),
+ NULL);
+}
+
+
+static void amp_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ XButtonEvent *ev;
+ ev = (XButtonEvent *)(cb->event);
+ if (ev->state & (snd_ControlMask | snd_MetaMask))
+ set_amp(sp, sp->last_amp_control);
+ else set_amp(sp, 1.0);
+}
+
+
+static void amp_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ scroll_to_amp((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
+}
+
+
+static void amp_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ scroll_to_amp(sp, cb->value);
+ sp->last_amp_control = sp->saved_amp_control;
+ sp->saved_amp_control = sp->amp_control;
+}
+
+
+/* ---------------- SPEED-CONTROL ---------------- */
+
+XmString initial_speed_label(speed_style_t style)
+{
+ /* used also in snd-xmix.c */
+ switch (style)
+ {
+ case SPEED_CONTROL_AS_RATIO: return(XmStringCreateLocalized((char *)" 1/1")); break;
+ case SPEED_CONTROL_AS_SEMITONE: return(XmStringCreateLocalized((char *)" 0")); break;
+ default: return(XmStringCreateLocalized((char *)" 1.00")); break;
+ }
+}
+
+
+static int speed_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
+{
+ if (val <= minval) return(0);
+ if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
+ return(snd_round(0.9 * SCROLLBAR_MAX * ((log(val) - log(minval)) / (log(maxval) - log(minval)))));
+}
+
+
+static int scroll_to_speed(snd_info *sp, int ival)
+{
+ char speed_number_buffer[6];
+ sp->speed_control = speed_changed(exp((ival * (log(sp->speed_control_max) - log(sp->speed_control_min)) /
+ (0.9 * SCROLLBAR_MAX)) +
+ log(sp->speed_control_min)),
+ speed_number_buffer,
+ sp->speed_control_style,
+ sp->speed_control_tones,
+ 6);
+ set_label(SPEED_LABEL(sp), speed_number_buffer);
+ /* set_label works with buttons or labels */
+ return(ival);
+}
+
+
+void set_speed(snd_info *sp, mus_float_t val)
+{
+ if (!has_widgets(sp))
+ sp->speed_control = val;
+ else XtVaSetValues(SPEED_SCROLLBAR(sp),
+ XmNvalue,
+ scroll_to_speed(sp, speed_to_scroll(sp->speed_control_min, val, sp->speed_control_max)),
+ NULL);
+}
+
+
+static void speed_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ XButtonEvent *ev;
+
+
+ ev = (XButtonEvent *)(cb->event);
+ if (ev->state & (snd_ControlMask | snd_MetaMask))
+ set_speed(sp, sp->last_speed_control);
+ else set_speed(sp, 1.0);
+
+#if XEN_HAVE_RATIOS
+ if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
+ snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
+#endif
+}
+
+
+static void speed_label_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ switch (sp->speed_control_style)
+ {
+ default:
+ case SPEED_CONTROL_AS_FLOAT: sp->speed_control_style = SPEED_CONTROL_AS_RATIO; break;
+ case SPEED_CONTROL_AS_RATIO: sp->speed_control_style = SPEED_CONTROL_AS_SEMITONE; break;
+ case SPEED_CONTROL_AS_SEMITONE: sp->speed_control_style = SPEED_CONTROL_AS_FLOAT; break;
+ }
+ set_speed(sp, sp->speed_control); /* remake label */
+}
+
+
+static void speed_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ scroll_to_speed(sp, ((XmScrollBarCallbackStruct *)info)->value);
+
+#if XEN_HAVE_RATIOS
+ if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
+ snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
+#endif
+}
+
+
+static void speed_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ scroll_to_speed(sp, cb->value);
+
+#if XEN_HAVE_RATIOS
+ if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
+ snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
+#endif
+ sp->last_speed_control = sp->saved_speed_control;
+ sp->saved_speed_control = sp->speed_control;
+}
+
+
+void toggle_direction_arrow(snd_info *sp, bool state)
+{
+ if (!has_widgets(sp))
+ sp->speed_control_direction = ((state) ? -1 : 1);
+ else XmToggleButtonSetState(SPEED_ARROW(sp), (Boolean)state, true);
+}
+
+
+/* ---------------- EXPAND-CONTROL ---------------- */
+
+static int expand_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
+{
+ if (val <= minval) return(0);
+ if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
+ return(snd_round(0.9 * SCROLLBAR_MAX * ((log(val) - log(minval)) / (log(maxval) - log(minval)))));
+}
+
+
+static int scroll_to_expand(snd_info *sp, int val)
+{
+ char expand_number_buffer[6];
+
+ if (val <= 0)
+ sp->expand_control = sp->expand_control_min;
+ else
+ {
+ if (val >= (0.9 * SCROLLBAR_MAX))
+ sp->expand_control = sp->expand_control_max;
+ else sp->expand_control = exp((val * (log(sp->expand_control_max) - log(sp->expand_control_min)) / (0.9 * SCROLLBAR_MAX)) + log(sp->expand_control_min));
+ }
+
+ if (sp->playing) dac_set_expand(sp, sp->expand_control);
+ snprintf(expand_number_buffer, 6, "%.3f", sp->expand_control);
+ set_label(EXPAND_LABEL(sp), expand_number_buffer);
+ return(val);
+}
+
+
+void set_expand(snd_info *sp, mus_float_t val)
+{
+ if (!has_widgets(sp))
+ sp->expand_control = val;
+ else XtVaSetValues(EXPAND_SCROLLBAR(sp),
+ XmNvalue,
+ scroll_to_expand(sp, expand_to_scroll(sp->expand_control_min, val, sp->expand_control_max)),
+ NULL);
+}
+
+
+static void expand_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ XButtonEvent *ev;
+ ev = (XButtonEvent *)(cb->event);
+ if (ev->state & (snd_ControlMask | snd_MetaMask))
+ set_expand(sp, sp->last_expand_control);
+ else set_expand(sp, 1.0);
+}
+
+
+static void expand_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ scroll_to_expand((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
+}
+
+
+static void expand_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ scroll_to_expand(sp, cb->value);
+ sp->last_expand_control = sp->saved_expand_control;
+ sp->saved_expand_control = sp->expand_control;
+}
+
+
+static void expand_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+
+
+ sp->expand_control_on = cb->set;
+ XmChangeColor(EXPAND_SCROLLBAR(sp), (Pixel)((sp->expand_control_on) ? (ss->position_color) : (ss->basic_color)));
+}
+
+
+void toggle_expand_button(snd_info *sp, bool state)
+{
+ if (!has_widgets(sp))
+ sp->expand_control_on = state;
+ else XmToggleButtonSetState(EXPAND_RIGHT_BUTTON(sp), (Boolean)state, true);
+}
+
+
+/* ---------------- CONTRAST-CONTROL ---------------- */
+
+static int contrast_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
+{
+ if (val <= minval) return(0);
+ if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
+ return(snd_round((val - minval) / (maxval - minval) * 0.9 * SCROLLBAR_MAX));
+}
+
+
+static int scroll_to_contrast(snd_info *sp, int val)
+{
+ char contrast_number_buffer[6];
+ sp->contrast_control = sp->contrast_control_min + val * (sp->contrast_control_max - sp->contrast_control_min) / (0.9 * SCROLLBAR_MAX);
+ snprintf(contrast_number_buffer, 6, "%.3f", sp->contrast_control);
+ set_label(CONTRAST_LABEL(sp), contrast_number_buffer);
+ return(val);
+}
+
+
+void set_contrast(snd_info *sp, mus_float_t val)
+{
+ if (!has_widgets(sp))
+ sp->contrast_control = val;
+ else XtVaSetValues(CONTRAST_SCROLLBAR(sp),
+ XmNvalue,
+ scroll_to_contrast(sp, contrast_to_scroll(sp->contrast_control_min, val, sp->contrast_control_max)),
+ NULL);
+}
+
+
+static void contrast_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ XButtonEvent *ev;
+ ev = (XButtonEvent *)(cb->event);
+ if (ev->state & (snd_ControlMask | snd_MetaMask))
+ set_contrast(sp, sp->last_contrast_control);
+ else set_contrast(sp, 0.0);
+}
+
+
+static void contrast_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ scroll_to_contrast((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
+}
+
+
+static void contrast_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ scroll_to_contrast(sp, cb->value);
+ sp->last_contrast_control = sp->saved_contrast_control;
+ sp->saved_contrast_control = sp->contrast_control;
+}
+
+
+static void contrast_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ sp->contrast_control_on = cb->set;
+ XmChangeColor(CONTRAST_SCROLLBAR(sp), (Pixel)((sp->contrast_control_on) ? (ss->position_color) : (ss->basic_color)));
+}
+
+
+void toggle_contrast_button(snd_info *sp, bool state)
+{
+ if (!has_widgets(sp))
+ sp->contrast_control_on = state;
+ else XmToggleButtonSetState(CONTRAST_RIGHT_BUTTON(sp), (Boolean)state, true);
+}
+
+
+/* ---------------- REVERB-CONTROL-SCALE ---------------- */
+
+static int revscl_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
+{
+ if (val <= minval) return(0);
+ if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
+ return(snd_round(0.9 * SCROLLBAR_MAX * (pow(val, 0.333) - pow(minval, 0.333)) / (pow(maxval, 0.333) - pow(minval, 0.333))));
+}
+
+
+/* static mus_float_t cube(mus_float_t a) {return(a*a*a);} */
+
+
+static int scroll_to_revscl(snd_info *sp, int val)
+{
+ char revscl_number_buffer[7];
+
+ if (val <= 0)
+ sp->reverb_control_scale = sp->reverb_control_scale_min;
+ else
+ {
+ if (val >= (0.9 * SCROLLBAR_MAX))
+ sp->reverb_control_scale = sp->reverb_control_scale_max;
+ else sp->reverb_control_scale = cube((val * (pow(sp->reverb_control_scale_max, 0.333) - pow(sp->reverb_control_scale_min, 0.333)) /
+ (0.9 * SCROLLBAR_MAX)) +
+ pow(sp->reverb_control_scale_min, 0.333));
+ }
+
+ snprintf(revscl_number_buffer, 7, "%.4f", sp->reverb_control_scale);
+ set_label(REVSCL_LABEL(sp), revscl_number_buffer);
+ return(val);
+}
+
+
+void set_revscl(snd_info *sp, mus_float_t val)
+{
+ if (!has_widgets(sp))
+ sp->reverb_control_scale = val;
+ else XtVaSetValues(REVSCL_SCROLLBAR(sp),
+ XmNvalue,
+ scroll_to_revscl(sp, revscl_to_scroll(sp->reverb_control_scale_min, val, sp->reverb_control_scale_max)),
+ NULL);
+}
+
+
+static void revscl_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ XButtonEvent *ev;
+ ev = (XButtonEvent *)(cb->event);
+ if (ev->state & (snd_ControlMask | snd_MetaMask))
+ set_revscl(sp, sp->last_reverb_control_scale);
+ else set_revscl(sp, 0.0);
+}
+
+
+static void revscl_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ scroll_to_revscl((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
+}
+
+
+static void revscl_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ scroll_to_revscl(sp, cb->value);
+ sp->last_reverb_control_scale = sp->saved_reverb_control_scale;
+ sp->saved_reverb_control_scale = sp->reverb_control_scale;
+}
+
+
+/* ---------------- REVERB-CONTROL-LENGTH ---------------- */
+
+static int revlen_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
+{
+ if (val <= minval) return(0);
+ if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
+ return(snd_round((val - minval) / (maxval - minval) * 0.9 * SCROLLBAR_MAX));
+}
+
+
+static int scroll_to_revlen(snd_info *sp, int val)
+{
+ char revlen_number_buffer[5];
+
+ sp->reverb_control_length = sp->reverb_control_length_min +
+ (sp->reverb_control_length_max - sp->reverb_control_length_min) * (mus_float_t)val / (0.9 * SCROLLBAR_MAX);
+ snprintf(revlen_number_buffer, 5, "%.2f", sp->reverb_control_length);
+ set_label(REVLEN_LABEL(sp), revlen_number_buffer);
+ return(val);
+}
+
+
+void set_revlen(snd_info *sp, mus_float_t val)
+{
+ if (!has_widgets(sp))
+ sp->reverb_control_length = val;
+ else XtVaSetValues(REVLEN_SCROLLBAR(sp),
+ XmNvalue,
+ scroll_to_revlen(sp, revlen_to_scroll(sp->reverb_control_length_min, val, sp->reverb_control_length_max)),
+ NULL);
+}
+
+
+static void revlen_click_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ XButtonEvent *ev;
+ ev = (XButtonEvent *)(cb->event);
+ if (ev->state & (snd_ControlMask | snd_MetaMask))
+ set_revlen(sp, sp->last_reverb_control_length);
+ else set_revlen(sp, 1.0);
+}
+
+
+static void revlen_drag_callback(Widget w, XtPointer context, XtPointer info)
+{
+ scroll_to_revlen((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
+}
+
+
+static void revlen_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
+ snd_info *sp = (snd_info *)context;
+ scroll_to_revlen(sp, cb->value);
+ sp->last_reverb_control_length = sp->saved_reverb_control_length;
+ sp->saved_reverb_control_length = sp->reverb_control_length;
+}
+
+
+static void reverb_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ sp->reverb_control_on = cb->set;
+ XmChangeColor(REVLEN_SCROLLBAR(sp), (Pixel)((sp->reverb_control_on) ? (ss->position_color) : (ss->basic_color)));
+ XmChangeColor(REVSCL_SCROLLBAR(sp), (Pixel)((sp->reverb_control_on) ? (ss->position_color) : (ss->basic_color)));
+}
+
+
+void toggle_reverb_button(snd_info *sp, bool state)
+{
+ if (!has_widgets(sp))
+ sp->reverb_control_on = state;
+ else XmToggleButtonSetState(REVERB_BUTTON(sp), (Boolean)state, true);
+}
+
+
+/* ---------------- FILTER_CONTROL ---------------- */
+
+static void filter_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ sp->filter_control_on = cb->set;
+}
+
+
+void toggle_filter_button(snd_info *sp, bool state)
+{
+ if (!has_widgets(sp))
+ sp->filter_control_on = state;
+ else XmToggleButtonSetState(FILTER_BUTTON(sp), (Boolean)state, true);
+}
+
+
+static void filter_textfield_deactivate(snd_info *sp)
+{
+ chan_info *active_chan;
+ active_chan = any_selected_channel(sp);
+ if (active_chan)
+ goto_window(channel_graph(active_chan));
+}
+
+
+#define MIN_FILTER_GRAPH_HEIGHT 20
+
+void display_filter_env(snd_info *sp)
+{
+ graphics_context *ax;
+ int height, width;
+ Widget drawer;
+ env_editor *edp;
+
+ if (!(snd_ok(sp))) return; /* autotest close + lagging X updates */
+
+ edp = sp->flt;
+ drawer = FILTER_GRAPH(sp);
+ height = widget_height(drawer);
+ if (height < MIN_FILTER_GRAPH_HEIGHT) return;
+
+ width = widget_width(drawer);
+ ax = (graphics_context *)calloc(1, sizeof(graphics_context));
+ ax->gc = ss->fltenv_basic_gc;
+ ax->wn = XtWindow(drawer);
+ ax->dp = XtDisplay(drawer);
+
+ XClearWindow(ax->dp, ax->wn);
+ edp->in_dB = sp->filter_control_in_dB;
+ edp->with_dots = true;
+
+ if (sp->filter_control_in_hz)
+ sp->filter_control_xmax = (mus_float_t)(snd_srate(sp) / 2);
+ else sp->filter_control_xmax = 1.0;
+
+ if (sp->filter_control_envelope == NULL)
+ sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
+
+ env_editor_display_env(edp, sp->filter_control_envelope, ax, "frequency response", 0, 0, width, height, NOT_PRINTING);
+ if (edp->edited)
+ {
+ ax->gc = ss->fltenv_data_gc;
+ display_frequency_response(sp->filter_control_envelope,
+ (sound_env_editor(sp))->axis, ax,
+ sp->filter_control_order,
+ sp->filter_control_in_dB);
+ }
+ free(ax);
+}
+
+
+void set_filter_text(snd_info *sp, const char *str)
+{
+ if (has_widgets(sp))
+ XmTextSetString(FILTER_COEFFS_TEXT(sp), (char *)str);
+}
+
+
+static void filter_drawer_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ snd_info *sp = (snd_info *)context;
+ XMotionEvent *ev = (XMotionEvent *)event;
+ env_editor *edp;
+#ifdef __APPLE__
+ if ((press_x == ev->x) && (press_y == ev->y)) return;
+#endif
+ edp = sp->flt;
+ edp->in_dB = sp->filter_control_in_dB;
+ env_editor_button_motion(edp, ev->x, ev->y, ev->time, sp->filter_control_envelope);
+ display_filter_env(sp);
+ sp->filter_control_changed = true;
+}
+
+
+static void filter_drawer_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ snd_info *sp = (snd_info *)context;
+ XButtonEvent *ev = (XButtonEvent *)event;
+ env_editor *edp;
+ if (!(sp->filter_control_envelope)) return;
+#ifdef __APPLE__
+ press_x = ev->x;
+ press_y = ev->y;
+#endif
+ edp = sp->flt;
+ edp->in_dB = sp->filter_control_in_dB;
+ if (env_editor_button_press(edp, ev->x, ev->y, ev->time, sp->filter_control_envelope))
+ display_filter_env(sp);
+}
+
+
+static void filter_drawer_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ char *tmpstr = NULL;
+ snd_info *sp = (snd_info *)context;
+ env_editor_button_release(sound_env_editor(sp), sp->filter_control_envelope);
+ display_filter_env(sp);
+ set_filter_text(sp, tmpstr = env_to_string(sp->filter_control_envelope));
+ if (tmpstr) free(tmpstr);
+ sp->filter_control_changed = true;
+}
+
+
+static void filter_drawer_resize(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ display_filter_env(sp);
+}
+
+
+static void filter_dB_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ sp->filter_control_in_dB = (cb->set);
+ display_filter_env(sp);
+}
+
+
+void set_filter_in_dB(snd_info *sp, bool val)
+{
+ sp->filter_control_in_dB = val;
+ if (has_widgets(sp))
+ {
+ XmToggleButtonSetState(FILTER_DB_BUTTON(sp), (Boolean)val, false);
+ display_filter_env(sp);
+ }
+}
+
+
+static void new_in_hz(snd_info *sp, bool val)
+{
+ sp->filter_control_in_hz = val;
+ if (val)
+ sp->filter_control_xmax = (mus_float_t)(snd_srate(sp) / 2);
+ else sp->filter_control_xmax = 1.0;
+ if (sp->filter_control_envelope) free_env(sp->filter_control_envelope);
+ sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
+}
+
+
+static void filter_hz_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ new_in_hz(sp, cb->set);
+ display_filter_env(sp);
+}
+
+
+void set_filter_in_hz(snd_info *sp, bool val)
+{
+ new_in_hz(sp, val);
+ if (has_widgets(sp))
+ {
+ XmToggleButtonSetState(FILTER_HZ_BUTTON(sp), (Boolean)val, false);
+ display_filter_env(sp);
+ }
+}
+
+
+void set_filter_order(snd_info *sp, int order)
+{
+ if (order & 1) order++;
+ if (order <= 0) order = 2;
+ sp->filter_control_order = order;
+ if (has_widgets(sp))
+ {
+ widget_int_to_text(FILTER_ORDER_TEXT(sp), order);
+ display_filter_env(sp);
+ }
+ sp->filter_control_changed = true;
+}
+
+
+static void filter_order_up_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ set_filter_order(sp, sp->filter_control_order + 2);
+}
+
+
+static void filter_order_down_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ if (sp->filter_control_order > 2)
+ set_filter_order(sp, sp->filter_control_order - 2);
+}
+
+
+static void get_filter_order(snd_info *sp, char *str)
+{
+ int order;
+ redirect_errors_to(errors_to_status_area, (void *)sp);
+ order = string_to_int(str, 1, "filter order");
+ redirect_errors_to(NULL, NULL);
+ if (order & 1) order++;
+ if (order <= 0) order = 2;
+ sp->filter_control_order = order;
+}
+
+
+static void filter_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* make an envelope out of the data */
+ snd_info *sp = (snd_info *)context;
+ char *str = NULL;
+
+ str = XmTextGetString(w);
+ if (sp->filter_control_envelope) sp->filter_control_envelope = free_env(sp->filter_control_envelope);
+ redirect_errors_to(errors_to_status_area, (void *)sp);
+ sp->filter_control_envelope = string_to_env((const char *)str);
+ redirect_errors_to(NULL, NULL);
+ if (str) XtFree(str);
+
+ if (!(sp->filter_control_envelope)) /* maybe user cleared text field? */
+ sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
+
+ str = XmTextGetString(FILTER_ORDER_TEXT(sp));
+ if ((str) && (*str))
+ {
+ get_filter_order(sp, str);
+ XtFree(str);
+ }
+ (sound_env_editor(sp))->edited = true;
+ display_filter_env(sp);
+ filter_textfield_deactivate(sp);
+ sp->filter_control_changed = true;
+}
+
+
+static void filter_order_activate_callback(Widget w, XtPointer context, XtPointer info)
+{
+ char *str;
+ snd_info *sp = (snd_info *)context;
+ str = XmTextGetString(w);
+ if ((str) && (*str))
+ {
+ get_filter_order(sp, str);
+ sp->filter_control_changed = true;
+ display_filter_env(sp);
+ XtFree(str);
+ }
+ filter_textfield_deactivate(sp);
+}
+
+
+void filter_env_changed(snd_info *sp, env *e)
+{
+ /* turn e back into a string for textfield widget */
+ if (has_widgets(sp))
+ {
+ char *tmpstr = NULL;
+ XmTextSetString(FILTER_COEFFS_TEXT(sp), tmpstr = env_to_string(e));
+ if (tmpstr) free(tmpstr);
+ (sound_env_editor(sp))->edited = true;
+ display_filter_env(sp);
+ }
+ sp->filter_control_changed = true;
+}
+
+
+/* ---------------- PLAY BUTTON ---------------- */
+
+void set_play_button(snd_info *sp, bool val)
+{
+#if WITH_AUDIO
+ if (has_widgets(sp))
+ XmToggleButtonSetState(PLAY_BUTTON(sp), (Boolean)val, false);
+ set_open_file_play_button(val);
+#endif
+}
+
+
+#if WITH_AUDIO
+static void play_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ chan_info *cp;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ XButtonEvent *ev;
+
+ ev = (XButtonEvent *)(cb->event);
+
+ if (sp->playing)
+ stop_playing_sound(sp, PLAY_BUTTON_UNSET);
+
+ ss->tracking = ((with_tracking_cursor(ss) != DONT_TRACK) ||
+ ((cb->set) &&
+ (ev->state & (snd_ControlMask | snd_MetaMask))));
+
+ cp = any_selected_channel(sp);
+ goto_graph(cp);
+ if (cb->set)
+ {
+ XtVaSetValues(w, XmNselectColor, (ss->tracking) ? ss->green : ss->selection_color, NULL);
+ play_sound(sp, 0, NO_END_SPECIFIED);
+ }
+}
+#endif
+
+
+typedef struct {bool pausing; } pause_data;
+
+#if WITH_AUDIO
+static void set_play_button_pause(snd_info *sp, void *ptr)
+{
+ if ((sp->playing) && (has_widgets(sp)))
+ {
+ pause_data *pd = (pause_data *)ptr;
+ Widget w;
+ w = PLAY_BUTTON(sp);
+ if (pd->pausing)
+ XtVaSetValues(w, XmNselectColor, ss->red, NULL);
+ else XtVaSetValues(w, XmNselectColor, (ss->tracking) ? ss->green : ss->selection_color, NULL);
+ }
+}
+#endif
+
+
+void play_button_pause(bool pausing)
+{
+#if WITH_AUDIO
+ pause_data *pd;
+ pd = (pause_data *)calloc(1, sizeof(pause_data));
+ pd->pausing = pausing;
+ for_each_sound_with_void(set_play_button_pause, (void *)pd);
+ free(pd);
+#endif
+}
+
+
+void set_control_panel_play_button(snd_info *sp)
+{
+#if WITH_AUDIO
+ if (has_widgets(sp))
+ {
+ set_toggle_button(PLAY_BUTTON(sp), false, false, sp);
+ XtVaSetValues(PLAY_BUTTON(sp), XmNselectColor, ss->selection_color, NULL);
+ }
+#endif
+}
+
+
+static void play_arrow_callback(Widget w, XtPointer context, XtPointer info)
+{
+#if WITH_AUDIO
+ snd_info *sp = (snd_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ bool dir;
+ dir = (bool)(cb->set);
+ if (dir) sp->speed_control_direction = -1; else sp->speed_control_direction = 1;
+#endif
+}
+
+
+/* ---------------- SYNC BUTTON ---------------- */
+
+static void set_sync_color(snd_info *sp)
+{
+ Widget syb;
+ syb = SYNC_BUTTON(sp);
+ switch (sp->sync)
+ {
+ case 1: case 0: XtVaSetValues(syb, XmNselectColor, ss->selection_color, NULL); break;
+ case 2: XtVaSetValues(syb, XmNselectColor, ss->green, NULL); break;
+ case 3: XtVaSetValues(syb, XmNselectColor, ss->yellow, NULL); break;
+ case 4: XtVaSetValues(syb, XmNselectColor, ss->red, NULL); break;
+ default: XtVaSetValues(syb, XmNselectColor, ss->black, NULL); break;
+ }
+}
+
+
+void syncb(snd_info *sp, int on)
+{
+ sp->sync = on;
+ if (on > ss->sound_sync_max) ss->sound_sync_max = on;
+ if (has_widgets(sp))
+ {
+ set_sync_color(sp);
+ XmToggleButtonSetState(SYNC_BUTTON(sp), (on != 0), false); /* need actual bool here, not a cast! */
+ }
+}
+
+
+static void sync_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ XButtonEvent *ev;
+
+
+ ev = (XButtonEvent *)(cb->event);
+ if (cb->set)
+ if (ev->state & snd_ControlMask)
+ if (ev->state & snd_MetaMask)
+ if (ev->state & snd_ShiftMask)
+ sp->sync = 4;
+ else sp->sync = 3;
+ else sp->sync = 2;
+ else sp->sync = 1;
+ else sp->sync = 0;
+
+ set_sync_color(sp);
+
+ if (sp->sync != 0)
+ {
+ chan_info *cp;
+ if (sp->sync > ss->sound_sync_max) ss->sound_sync_max = sp->sync;
+ cp = sp->lacp;
+ if (cp == NULL) cp = any_selected_channel(sp);
+ goto_graph(cp);
+ if (cp->cursor_on) sync_cursors(cp, cursor_sample(cp));
+ apply_x_axis_change(cp);
+ }
+}
+
+
+/* ---------------- UNITE BUTTON ---------------- */
+
+static void unite_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* click if set unsets, click if unset->combine, ctrl-click->superimpose */
+ snd_info *sp = (snd_info *)context;
+ XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
+ XButtonEvent *ev;
+ channel_style_t val;
+ ev = (XButtonEvent *)(cb->event);
+
+ if (cb->set)
+ {
+ if (ev->state & (snd_ControlMask | snd_MetaMask))
+ val = CHANNELS_SUPERIMPOSED;
+ else val = CHANNELS_COMBINED;
+ }
+ else val = CHANNELS_SEPARATE;
+
+ set_sound_channel_style(sp, val);
+}
+
+
+/* ---------------- CLOSE BUTTON ---------------- */
+
+static void close_button_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_close_file((snd_info *)context);
+}
+
+
+
+/* apply is only safe if the DAC is currently inactive and remains safe only
+ * if all other apply buttons are locked out (and play).
+ */
+
+/* relative panes needs to notice overall window resize, but there's no way to do so in Motif, as far as I can tell */
+
+#if WITH_RELATIVE_PANES
+/* It would be nice if we could set a paned window to keep its children relative
+ * amounts the same upon outside resize, but the Paned Window widget doesn't
+ * have a resize callback, and no obvious way to advise the resize mechanism.
+ * An attempt to get the same effect by wrapping w_pane in a drawingarea widget
+ * ran into other troubles (the thing is seriously confused about its size).
+ * You'd naively think the Actions "Start" and "Commit" could be used, since
+ * XtActions are said to be a list of XtActionProcs, but I can't find a way to add
+ * my action without deactivating the built-in action of the same name --
+ * XtAugmentTranslations ignores new actions if the old exists, XtOverride
+ * replaces the old, etc. (And XtActions involve far more complexity than
+ * anyone should have to endure).
+ *
+ * so... drop down into the sashes...(using undocumented stuff throughout this code)
+ */
+
+static void sash_lock_control_panel(snd_info *sp)
+{
+ if (showing_controls(sp))
+ {
+ /* lock to its current size */
+ int hgt;
+ hgt = control_panel_height(sp);
+ XtVaSetValues(CONTROLS(sp),
+ XmNpaneMinimum, hgt,
+ XmNpaneMaximum, hgt,
+ NULL);
+ }
+}
+
+
+static void sash_unlock_control_panel(snd_info *sp)
+{
+ if (showing_controls(sp))
+ {
+ XtVaSetValues(CONTROLS(sp),
+ XmNpaneMinimum, 1,
+ XmNpaneMaximum, LOTSA_PIXELS,
+ NULL);
+ }
+}
+
+
+static int outer_panes = 0;
+static int *inner_panes = NULL;
+static Dimension *outer_sizes = NULL;
+static Dimension **inner_sizes = NULL;
+
+static void watch_sash(Widget w, XtPointer closure, XtPointer info)
+{
+ SashCallData call_data = (SashCallData)info;
+ /* call_data->params[0]: Commit, Move, Key, Start (as strings) */
+
+ if ((call_data->params) &&
+ (call_data->params[0]) &&
+ (with_relative_panes(ss)) &&
+ (sound_style(ss) == SOUNDS_VERTICAL))
+ {
+ int i, k;
+ snd_info *sp;
+ if (mus_strcmp(call_data->params[0], "Start"))
+ {
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ sp = ss->sounds[i];
+ if ((sp) &&
+ (sp->inuse == SOUND_NORMAL) &&
+ (sp->nchans > 1) &&
+ (sp->channel_style == CHANNELS_SEPARATE))
+ outer_panes++;
+ }
+
+ for_each_sound(sash_lock_control_panel);
+
+ if (outer_panes > 0)
+ {
+ int outer_ctr;
+ inner_panes = (int *)calloc(outer_panes, sizeof(int));
+ outer_sizes = (Dimension *)calloc(outer_panes, sizeof(Dimension));
+ inner_sizes = (Dimension **)calloc(outer_panes, sizeof(Dimension *));
+ outer_ctr = 0;
+
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ sp = ss->sounds[i];
+ if ((sp) &&
+ (sp->inuse == SOUND_NORMAL) &&
+ (sp->nchans > 1) &&
+ (sp->channel_style == CHANNELS_SEPARATE))
+ {
+ Widget child;
+ child = SND_PANE(sp);
+ inner_panes[outer_ctr] = sp->nchans;
+ inner_sizes[outer_ctr] = (Dimension *)calloc(sp->nchans, sizeof(Dimension));
+ XtVaGetValues(child, XmNheight, &(outer_sizes[outer_ctr]), NULL);
+
+ for (k = 0; k < sp->nchans; k++)
+ XtVaGetValues(channel_main_pane(sp->chans[k]), XmNheight, &(inner_sizes[outer_ctr][k]), NULL);
+
+ outer_ctr++;
+ if (outer_ctr >= outer_panes) break;
+ }
+ }
+ }
+ }
+ else
+ {
+ if (mus_strcmp(call_data->params[0], "Commit")) /* release sash */
+ {
+ if (outer_panes > 0)
+ {
+ int outer_ctr = 0;
+ Dimension cur_outer_size = 0;
+
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ sp = ss->sounds[i];
+ if ((sp) &&
+ (sp->inuse == SOUND_NORMAL) &&
+ (sp->nchans > 1) &&
+ (sp->channel_style == CHANNELS_SEPARATE))
+ {
+ XtVaGetValues(SND_PANE(sp), XmNheight, &cur_outer_size, NULL);
+
+ if ((cur_outer_size > 40) &&
+ (abs(cur_outer_size - outer_sizes[outer_ctr]) > (sp->nchans * 2)))
+ {
+ /* this pane has multiple chans and its size has changed enough to matter */
+ Dimension total_inner = 0, diff;
+ float ratio;
+
+ for (k = 0; k < sp->nchans; k++)
+ total_inner += inner_sizes[outer_ctr][k];
+ diff = outer_sizes[outer_ctr] - total_inner; /* this is non-channel stuff */
+
+ for (k = 0; k < sp->nchans; k++)
+ XtUnmanageChild(channel_main_pane(sp->chans[k]));
+
+ ratio = (float)(cur_outer_size - diff) / (float)(outer_sizes[outer_ctr] - diff);
+ if (ratio > 0.0)
+ {
+ for (k = 0; k < sp->nchans; k++)
+ {
+ int size;
+ size = (int)(ratio * inner_sizes[outer_ctr][k]);
+ XtVaSetValues(channel_main_pane(sp->chans[k]),
+ XmNpaneMinimum, size - 1,
+ XmNpaneMaximum, size + 1,
+ NULL);
+ }
+ for (k = 0; k < sp->nchans; k++)
+ XtManageChild(channel_main_pane(sp->chans[k]));
+ for (k = 0; k < sp->nchans; k++)
+ XtVaSetValues(channel_main_pane(sp->chans[k]),
+ XmNpaneMinimum, 1,
+ XmNpaneMaximum, LOTSA_PIXELS,
+ NULL);
+ }
+ }
+ outer_ctr++;
+ }
+ }
+
+ for (i = 0; i < outer_panes; i++)
+ if (inner_sizes[i])
+ free(inner_sizes[i]);
+ free(inner_panes);
+ free(inner_sizes);
+ free(outer_sizes);
+ outer_panes = 0;
+ }
+
+ for_each_sound(sash_unlock_control_panel);
+ }
+ }
+ }
+}
+
+static Widget *sashes = NULL;
+static int sashes_size = 0;
+
+static void remember_sash(Widget w)
+{
+ /* add callback only once (means remembering which widgets already have our callback */
+ int loc = -1;
+ if (sashes_size == 0)
+ {
+ sashes = (Widget *)calloc(16, sizeof(Widget));
+ sashes_size = 16;
+ loc = 0;
+ }
+ else
+ {
+ int i;
+ for (i = 0; i < sashes_size; i++)
+ {
+ if (sashes[i] == w) return;
+ if (sashes[i] == NULL)
+ {
+ loc = i;
+ break;
+ }
+ }
+ if (loc == -1)
+ {
+ sashes = (Widget *)realloc(sashes, sashes_size * 2 * sizeof(Widget));
+ for (i = sashes_size; i < sashes_size * 2; i++) sashes[i] = NULL;
+ loc = sashes_size;
+ sashes_size *= 2;
+ }
+ }
+ sashes[loc] = w;
+ XtAddCallback(w, XmNcallback, watch_sash, NULL);
+}
+
+
+static void add_sash_watchers(Widget w)
+{
+ /* if relative panes, add sash watchers to the outer paned window sashes (SOUND_PANE(ss)) */
+ unsigned int i;
+ CompositeWidget cw = (CompositeWidget)w;
+ for (i = 0; i < cw->composite.num_children; i++) /* only outermost sashes count here */
+ {
+ Widget child;
+ child = cw->composite.children[i];
+ if ((XtIsWidget(child)) &&
+ (XtIsManaged(child)) &&
+ (XtIsSubclass(child, xmSashWidgetClass)))
+ remember_sash(child);
+ }
+}
+
+#endif
+
+
+static bool cant_write(char *name)
+{
+#ifndef _MSC_VER
+ return((access(name, W_OK)) != 0);
+#else
+ return(false);
+#endif
+}
+
+
+/* bitmaps for the playback direction arrow */
+
+static unsigned char speed_r_bits1[] = {
+ 0x00, 0x04, 0x10, 0x08, 0x00, 0x10, 0x04, 0x20, 0x00, 0x40, 0xa5, 0xbf,
+ 0x00, 0x40, 0x04, 0x20, 0x00, 0x10, 0x10, 0x08, 0x00, 0x04, 0x00, 0x00};
+static unsigned char speed_l_bits1[] = {
+ 0x20, 0x00, 0x10, 0x08, 0x08, 0x00, 0x04, 0x20, 0x02, 0x00, 0xfd, 0xa5,
+ 0x02, 0x00, 0x04, 0x20, 0x08, 0x00, 0x10, 0x08, 0x20, 0x00, 0x00, 0x00};
+
+#define NUM_BOMBS 15
+
+static Pixmap mini_lock = 0;
+static Pixmap close_icon = 0;
+static Pixmap blank_pixmap = 0;
+static bool mini_lock_allocated = false;
+static Pixmap bombs[NUM_BOMBS];
+static Pixmap hourglasses[NUM_HOURGLASSES];
+static Pixmap stop_sign = 0;
+
+void show_lock(snd_info *sp)
+{
+ if (!has_widgets(sp)) return;
+ if (mini_lock)
+ XtVaSetValues(LOCK_OR_BOMB(sp), XmNlabelPixmap, mini_lock, NULL);
+}
+
+
+void hide_lock(snd_info *sp)
+{
+ if (!has_widgets(sp)) return;
+ if (mini_lock)
+ XtVaSetValues(LOCK_OR_BOMB(sp), XmNlabelPixmap, blank_pixmap, NULL);
+ /* these Pixmaps can be null if the colormap is screwed up */
+}
+
+
+static void show_stop_sign(snd_info *sp)
+{
+ if (!has_widgets(sp)) return;
+ if (stop_sign)
+ XtVaSetValues(STOP_ICON(sp), XmNlabelPixmap, stop_sign, NULL);
+}
+
+
+static void hide_stop_sign(snd_info *sp)
+{
+ if (!has_widgets(sp)) return;
+ if (blank_pixmap)
+ XtVaSetValues(STOP_ICON(sp), XmNlabelPixmap, blank_pixmap, NULL);
+}
+
+
+static void show_bomb(snd_info *sp)
+{
+ if (!has_widgets(sp)) return;
+ if (sp->bomb_ctr >= NUM_BOMBS)
+ sp->bomb_ctr = 0;
+ if (bombs[sp->bomb_ctr])
+ XtVaSetValues(LOCK_OR_BOMB(sp), XmNlabelPixmap, bombs[sp->bomb_ctr], NULL);
+ sp->bomb_ctr++;
+}
+
+
+static void hide_bomb(snd_info *sp)
+{
+ if (!has_widgets(sp)) return;
+ XtVaSetValues(LOCK_OR_BOMB(sp), XmNlabelPixmap, blank_pixmap, NULL);
+ sp->bomb_ctr = 0;
+}
+
+
+#define BOMB_TIME 200
+
+static void tick_bomb(XtPointer context, XtIntervalId *id)
+{
+ snd_info *sp = (snd_info *)context;
+ if (!has_widgets(sp)) return;
+ if ((sp->need_update) || (sp->file_unreadable))
+ {
+ show_bomb(sp);
+ XtAppAddTimeOut(MAIN_APP(ss),
+ (unsigned long)BOMB_TIME,
+ (XtTimerCallbackProc)tick_bomb,
+ context);
+ }
+ else
+ {
+ hide_bomb(sp);
+ sp->bomb_in_progress = false;
+ }
+}
+
+
+void start_bomb(snd_info *sp)
+{
+ if (!has_widgets(sp)) return;
+ sp->bomb_ctr = 0;
+ if (!(sp->bomb_in_progress))
+ {
+ sp->bomb_in_progress = true;
+ XtAppAddTimeOut(MAIN_APP(ss),
+ (unsigned long)BOMB_TIME,
+ (XtTimerCallbackProc)tick_bomb,
+ (void *)sp);
+ }
+}
+
+
+void stop_bomb(snd_info *sp)
+{
+ if (!has_widgets(sp)) return;
+ hide_bomb(sp);
+ sp->bomb_in_progress = false;
+}
+
+
+static char *bits_to_string(const char **icon)
+{
+ /* show first few lines */
+ char *buf;
+ buf = (char *)calloc(128, sizeof(char));
+ snprintf(buf, 128, "\n%s\n%s\n%s...", icon[0], icon[1], icon[2]);
+ return(buf);
+}
+
+
+static void allocate_icons(Widget w)
+{
+ Pixmap shape1, shape2, shape3, shape4;
+ XpmAttributes attributes;
+ XpmColorSymbol symbols[1];
+ int scr, k, pixerr;
+ Display *dp;
+ Drawable wn;
+
+ dp = XtDisplay(w);
+ wn = XtWindow(w);
+ scr = DefaultScreen(dp);
+ XtVaGetValues(w, XmNdepth, &attributes.depth, XmNcolormap, &attributes.colormap, NULL);
+ attributes.visual = DefaultVisual(dp, scr);
+ symbols[0].name = (char *)"basiccolor";
+ symbols[0].value = NULL;
+ symbols[0].pixel = ss->basic_color;
+ attributes.colorsymbols = symbols;
+ attributes.numsymbols = 1;
+ attributes.valuemask = XpmColorSymbols | XpmDepth | XpmColormap | XpmVisual;
+
+ pixerr = XpmCreatePixmapFromData(dp, wn, (char **)mini_lock_bits(), &mini_lock, &shape1, &attributes);
+ if (pixerr != XpmSuccess)
+ snd_error("lock pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(mini_lock_bits()));
+
+ pixerr = XpmCreatePixmapFromData(dp, wn, (char **)blank_bits(), &blank_pixmap, &shape1, &attributes);
+ if (pixerr != XpmSuccess)
+ snd_error("blank pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(blank_bits()));
+
+ pixerr = XpmCreatePixmapFromData(dp, wn, (char **)stop_sign_bits(), &stop_sign, &shape4, &attributes);
+ if (pixerr != XpmSuccess)
+ snd_error("stop sign pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(stop_sign_bits()));
+
+ pixerr = XpmCreatePixmapFromData(dp, wn, (char **)close_icon_bits(), &close_icon, &shape1, &attributes);
+ if (pixerr != XpmSuccess)
+ snd_error("stop sign pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(close_icon_bits()));
+
+ for (k = 0; k < NUM_BOMBS; k++)
+ {
+ pixerr = XpmCreatePixmapFromData(dp, wn, (char **)mini_bomb_bits(k), &(bombs[k]), &shape2, &attributes);
+ if (pixerr != XpmSuccess)
+ {
+ snd_error("bomb pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(mini_bomb_bits(k)));
+ break;
+ }
+ pixerr = XpmCreatePixmapFromData(dp, wn, (char **)mini_glass_bits(k), &(hourglasses[k]), &shape3, &attributes);
+ if (pixerr != XpmSuccess)
+ {
+ snd_error("glass pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(mini_glass_bits(k)));
+ break;
+ }
+ }
+ mini_lock_allocated = true;
+}
+
+
+static void change_pixmap_background(Widget w, Pixmap orig, Pixel old_color, Pixel new_color, int width, int height)
+{
+ XImage *before;
+ Display *dp;
+ Drawable wn;
+ Visual *vis;
+ XGCValues v;
+ GC draw_gc;
+ int depth, depth_bytes, x, y;
+ char *data;
+
+ dp = XtDisplay(w);
+ wn = XtWindow(w);
+ vis = DefaultVisual(dp, DefaultScreen(dp));
+ XtVaGetValues(w, XmNdepth, &depth, NULL);
+ depth_bytes = (depth >> 3);
+
+ data = (char *)calloc((width + 1) * (height + 1) * depth_bytes, sizeof(char)); /* not calloc since X will free this */
+ /* there's overflow in X here, apparently -- the +1's fix it according to valgrind */
+ /* perhaps this is supposed to be rounded up to byte boundaries? */
+
+ before = XCreateImage(dp, vis, depth, XYPixmap, 0, data, width, height, 8, 0);
+ XGetSubImage(dp, orig, 0, 0, width, height, AllPlanes, XYPixmap, before, 0, 0);
+
+ v.background = new_color;
+ draw_gc = XCreateGC(dp, wn, GCBackground, &v);
+ XSetBackground(dp, draw_gc, new_color);
+
+ for (x = 0; x < width; x++)
+ for (y = 0; y < height; y++)
+ if (XGetPixel(before, x, y) == old_color)
+ XPutPixel(before, x, y, new_color);
+
+ XPutImage(dp, orig, draw_gc, before, 0, 0, 0, 0, width, height);
+ XDestroyImage(before); /* frees data as well */
+ XFreeGC(dp, draw_gc);
+}
+
+
+void make_sound_icons_transparent_again(Pixel old_color, Pixel new_color)
+{
+ int i;
+ if (!mini_lock_allocated) allocate_icons(MAIN_SHELL(ss));
+ change_pixmap_background(MAIN_SHELL(ss), mini_lock, old_color, new_color, 16, 14);
+ change_pixmap_background(MAIN_SHELL(ss), blank_pixmap, old_color, new_color, 16, 14);
+ change_pixmap_background(MAIN_SHELL(ss), close_icon, old_color, new_color, 16, 14);
+ /* change_pixmap_background(MAIN_SHELL(ss), stop_sign, old_color, new_color, 17, 17); */
+ /* memory corruption here! */
+ for (i = 0; i < NUM_BOMBS; i++)
+ change_pixmap_background(MAIN_SHELL(ss), bombs[i], old_color, new_color, 16, 14);
+ for (i = 0; i < NUM_HOURGLASSES; i++)
+ change_pixmap_background(MAIN_SHELL(ss), hourglasses[i], old_color, new_color, 16, 14);
+}
+
+
+static Pixmap spd_r, spd_l;
+static bool spd_ok = false;
+
+static void close_sound_dialog(Widget w, XtPointer context, XtPointer info)
+{
+ snd_info *sp = (snd_info *)context;
+ if (sp) snd_close_file(sp);
+}
+
+
+static void manage_sync_button(snd_info *sp)
+{
+ XtManageChild(SYNC_BUTTON(sp));
+}
+
+
+static void attach_status_area(snd_info *sp)
+{
+ XtUnmanageChild(STATUS_AREA(sp));
+ XtVaSetValues(STATUS_AREA(sp),
+ XmNrightAttachment, XmATTACH_WIDGET,
+ XmNrightWidget, (XtIsManaged(UNITE_BUTTON(sp))) ? UNITE_BUTTON(sp) : ((XtIsManaged(SYNC_BUTTON(sp))) ? SYNC_BUTTON(sp) : PLAY_BUTTON(sp)),
+ NULL);
+ XtManageChild(STATUS_AREA(sp));
+}
+
+
+snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr)
+{
+ snd_info *sp = NULL, *osp;
+ Widget *sw;
+ XmString s1;
+ int snd_slot, nchans = 1, i, old_chans;
+ bool make_widgets;
+ Arg args[32];
+ char *old_name = NULL, *title;
+ Dimension app_dy, screen_y, chan_min_y;
+ Position app_y;
+ /* these dimensions are used to try to get a reasonable channel graph size without falling off the screen bottom */
+ Pixmap rb, lb;
+ int depth;
+ bool free_filename = false;
+ Widget form;
+ XtCallbackList n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12;
+ Atom sound_delete;
+
+ if (ss->translated_filename)
+ {
+ old_name = filename;
+ filename = ss->translated_filename;
+ free_filename = true;
+ ss->translated_filename = NULL;
+ }
+
+ nchans = hdr->chans;
+ if (nchans <= 0) nchans = 1;
+ XtVaGetValues(MAIN_SHELL(ss),
+ XmNy, &app_y,
+ XmNheight, &app_dy,
+ NULL);
+ screen_y = DisplayHeight(MAIN_DISPLAY(ss),
+ DefaultScreen(MAIN_DISPLAY(ss)));
+ app_dy = (screen_y - app_y - app_dy - 20 * nchans);
+ chan_min_y = (Dimension)(app_dy / (Dimension)nchans);
+ if (chan_min_y > (Dimension)(ss->channel_min_height))
+ chan_min_y = ss->channel_min_height;
+ else
+ if (chan_min_y < 5)
+ chan_min_y = 5;
+
+ snd_slot = find_free_sound_slot(nchans); /* expands sound list if needed */
+ if (ss->sounds[snd_slot]) /* we're trying to re-use an old, inactive set of widgets and whatnot */
+ {
+ osp = ss->sounds[snd_slot];
+ old_chans = osp->allocated_chans;
+ }
+ else old_chans = 0;
+ make_widgets = (ss->sounds[snd_slot] == NULL);
+ ss->sounds[snd_slot] = make_snd_info(ss->sounds[snd_slot], filename, hdr, snd_slot, read_only);
+ sp = ss->sounds[snd_slot];
+ sp->inuse = SOUND_NORMAL;
+ sp->bomb_ctr = 0;
+ sp->write_date = file_write_date(filename); /* needed early in this process by the peak-env handlers */
+
+ if (sp->snd_widgets == NULL)
+ sp->snd_widgets = (Widget *)calloc(NUM_SND_WIDGETS, sizeof(Widget));
+ sw = sp->snd_widgets;
+
+ if ((!make_widgets) && (old_chans < nchans))
+ {
+ for (i = old_chans; i < nchans; i++)
+ add_channel_window(sp, i, chan_min_y, 1, NULL, WITH_FW_BUTTONS, WITH_EVENTS);
+ }
+
+ if (make_widgets)
+ {
+ int n;
+ if (sound_style(ss) == SOUNDS_IN_SEPARATE_WINDOWS)
+ {
+ title = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(title, PRINT_BUFFER_SIZE, "%d: %s", snd_slot, sp->short_filename);
+ if (sp->dialog == NULL)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ sp->dialog = XtCreatePopupShell(title, xmDialogShellWidgetClass, MAIN_SHELL(ss), args, n);
+ /* using popup shell here gets around the problem that the shell passes resize requests to all its children
+ * -- as a popup, it's not considered a child, but that means we don't inherit things like popup menus from
+ * the main shell.
+ */
+ sound_delete = XmInternAtom(XtDisplay(sp->dialog), (char *)"WM_DELETE_WINDOW", false);
+ XmAddWMProtocolCallback(sp->dialog, sound_delete, close_sound_dialog, (XtPointer)sp);
+ }
+ else XtVaSetValues(sp->dialog, XmNtitle, title, NULL);
+ free(title);
+ if (!XtIsManaged(sp->dialog)) XtManageChild(sp->dialog);
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNsashIndent, ss->channel_sash_indent); n++;
+ XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++; /* Xm/Paned.c initializes this to 1000! */
+ if (ss->channel_sash_size != 0)
+ {
+ XtSetArg(args[n], XmNsashHeight, ss->channel_sash_size); n++;
+ XtSetArg(args[n], XmNsashWidth, ss->channel_sash_size); n++;
+ }
+
+ /* if (mumble_style(ss) == CHANNELS_HORIZONTAL) {XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;} */
+ /* this doesn't work yet because the control panel is screwed up when trying to display itself horizontally */
+ /* Perhaps another layer of panes? */
+
+ if (sound_style(ss) == SOUNDS_VERTICAL)
+ {
+ if (ss->toolbar)
+ XtSetArg(args[n], XmNpositionIndex, snd_slot + 1);
+ else XtSetArg(args[n], XmNpositionIndex, snd_slot);
+ n++;
+ }
+ XtSetArg(args[n], XmNuserData, sp->index); n++;
+
+ if (sound_style(ss) == SOUNDS_IN_SEPARATE_WINDOWS)
+ SND_PANE(sp) = XtCreateManagedWidget("snd-pane", xmPanedWindowWidgetClass, sp->dialog, args, n);
+ else
+ {
+ unsigned int i;
+ CompositeWidget cw = (CompositeWidget)SOUND_PANE(ss);
+ SND_PANE(sp) = XtCreateManagedWidget("snd-pane", xmPanedWindowWidgetClass, SOUND_PANE(ss), args, n);
+
+ /* try to make the division between sounds more obvious */
+ for (i = 0; i < cw->composite.num_children; i++)
+ {
+ Widget child;
+ child = cw->composite.children[i];
+ if (((XtIsWidget(child))|| (XmIsGadget(child))) &&
+ (XtIsManaged(child)) &&
+ ((XmIsSeparator(child)) || (XmIsSeparatorGadget(child))))
+ XtVaSetValues(child, XmNseparatorType, XmDOUBLE_LINE,
+ XmNbackground, ss->white,
+ NULL);
+ }
+ }
+
+ XtAddEventHandler(SND_PANE(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ /* if user clicks in controls, then starts typing, try to send key events to current active channel */
+ /* all widgets in the control-pane that would otherwise intercept the key events get this event handler */
+
+ for (i = 0; i < nchans; i++)
+ add_channel_window(sp, i, chan_min_y, 0, NULL, WITH_FW_BUTTONS, WITH_EVENTS);
+ /* creates channel (horizontal) paned window widget as child of w_snd_pane(sp) == SND_PANE(sp) */
+
+
+ /* -------- sound file name, status area, various buttons -------- */
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNpaneMinimum, 20); n++;
+ XtSetArg(args[n], XmNpaneMaximum, 20); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ NAME_BOX(sp) = XtCreateManagedWidget("snd-name-form", xmFormWidgetClass, SND_PANE(sp), args, n);
+ XtAddEventHandler(NAME_BOX(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ if (!mini_lock_allocated)
+ allocate_icons(NAME_BOX(sp));
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
+ XtSetArg(args[n], XmNlabelPixmap, close_icon); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNwidth, 32); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ CLOSE_BUTTON(sp) = XtCreateManagedWidget("close-button", xmPushButtonWidgetClass, NAME_BOX(sp), args, n);
+ XtAddCallback(CLOSE_BUTTON(sp), XmNactivateCallback, close_button_callback, (XtPointer)sp);
+
+ n = 0;
+ s1 = XmStringCreateLocalized(shortname_indexed(sp));
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ /* XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++; */
+
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, CLOSE_BUTTON(sp)); n++;
+
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ NAME_LABEL(sp) = XtCreateManagedWidget("snd-name", xmPushButtonWidgetClass, NAME_BOX(sp), args, n);
+ XtAddEventHandler(NAME_LABEL(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(NAME_LABEL(sp), XmNactivateCallback, name_click_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, NAME_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+
+ if (blank_pixmap)
+ {
+ /* if xpm failed (blank_pixmap == 0), this can cause X to kill Snd! */
+ XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
+ XtSetArg(args[n], XmNlabelPixmap, blank_pixmap); n++;
+ }
+
+ LOCK_OR_BOMB(sp) = XtCreateManagedWidget("", xmLabelWidgetClass, NAME_BOX(sp), args, n);
+
+ {
+ int i;
+ Widget left_widget;
+
+ left_widget = LOCK_OR_BOMB(sp);
+ sp->progress_widgets = (Widget *)calloc(sp->nchans, sizeof(Widget));
+ sp->num_progress_widgets = sp->nchans;
+ /* when an unused sound is reopened in snd-data.c, it's possible for its channel number
+ * to be increased. If we then try to draw the clock icon in the new channel, its
+ * widget will be unallocated -> segfault, so to keep things simple, we check this number.
+ */
+
+ for (i = 0; i < sp->nchans; i++)
+ {
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+
+ if (blank_pixmap)
+ {
+ /* if xpm failed (blank_pixmap == 0), this can cause X to kill Snd! */
+ XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
+ XtSetArg(args[n], XmNlabelPixmap, blank_pixmap); n++;
+ }
+
+ sp->progress_widgets[i] = XtCreateManagedWidget("", xmLabelWidgetClass, NAME_BOX(sp), args, n);
+ left_widget = sp->progress_widgets[i];
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, left_widget); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+
+ if (blank_pixmap)
+ {
+ XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
+ XtSetArg(args[n], XmNlabelPixmap, blank_pixmap); n++;
+ }
+
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ STOP_ICON(sp) = XtCreateManagedWidget("", xmPushButtonWidgetClass, NAME_BOX(sp), args, n);
+ XtAddCallback(STOP_ICON(sp), XmNactivateCallback, stop_sign_click_callback, (XtPointer)sp);
+ }
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, STOP_ICON(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNresizeWidth, true); n++;
+ XtSetArg(args[n], XmNmarginHeight, 1); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNeditable, false); n++;
+ XtSetArg(args[n], XmNcursorPositionVisible, false); n++;
+ STATUS_AREA(sp) = XtCreateManagedWidget("snd-info", xmTextFieldWidgetClass, NAME_BOX(sp), args, n);
+
+#if WITH_AUDIO
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+#ifdef TOGGLE_MARGIN
+ XtSetArg(args[n], XmNmarginHeight, TOGGLE_MARGIN); n++;
+ XtSetArg(args[n], XmNmarginTop, TOGGLE_MARGIN); n++;
+#endif
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ /* in Motif 2.2 this sets up a tooltip:
+ XtSetArg(args[n], XmNtoolTipString, XmStringCreateLocalized((char *)"play this sound")); n++;
+ */
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ PLAY_BUTTON(sp) = make_togglebutton_widget("play", NAME_BOX(sp), args, n);
+ XtAddCallback(PLAY_BUTTON(sp), XmNvalueChangedCallback, play_button_callback, (XtPointer)sp);
+#endif
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+#ifdef TOGGLE_MARGIN
+ XtSetArg(args[n], XmNmarginHeight, TOGGLE_MARGIN); n++;
+ XtSetArg(args[n], XmNmarginTop, TOGGLE_MARGIN); n++;
+#endif
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+#if WITH_AUDIO
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, PLAY_BUTTON(sp)); n++;
+#else
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+#endif
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ SYNC_BUTTON(sp) = make_togglebutton_widget("sync", NAME_BOX(sp), args, n);
+ XtAddEventHandler(SYNC_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(SYNC_BUTTON(sp), XmNvalueChangedCallback, sync_button_callback, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNbottomWidget, SYNC_BUTTON(sp)); n++;
+#ifdef TOGGLE_MARGIN
+ XtSetArg(args[n], XmNmarginHeight, TOGGLE_MARGIN); n++;
+ XtSetArg(args[n], XmNmarginTop, TOGGLE_MARGIN); n++;
+#endif
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, SYNC_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ UNITE_BUTTON(sp) = make_togglebutton_widget("unite", NAME_BOX(sp), args, n);
+ XtAddEventHandler(UNITE_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(UNITE_BUTTON(sp), XmNvalueChangedCallback, unite_button_callback, (XtPointer)sp);
+
+
+ /* ---------------- control panel ---------------- */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ CONTROLS(sp) = XtCreateManagedWidget("snd-amp", xmFormWidgetClass, SND_PANE(sp), args, n);
+ XtAddEventHandler(CONTROLS(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ /* AMP */
+ s1 = XmStringCreateLocalized((char *)"amp:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ AMP_BUTTON(sp) = make_pushbutton_widget("amp-label", CONTROLS(sp), args, n);
+ XtAddEventHandler(AMP_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(AMP_BUTTON(sp), XmNactivateCallback, amp_click_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"1.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, AMP_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, AMP_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginRight, 3); n++;
+ AMP_LABEL(sp) = XtCreateManagedWidget("amp-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, AMP_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, AMP_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, amp_to_scroll(sp->amp_control_min, 1.0, sp->amp_control_max)); n++;
+ XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(amp_drag_callback, (XtPointer)sp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(amp_valuechanged_callback, (XtPointer)sp)); n++;
+ AMP_SCROLLBAR(sp) = XtCreateManagedWidget("amp", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
+ XtAddEventHandler(AMP_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ /* SPEED */
+ s1 = XmStringCreateLocalized((char *)"speed:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, AMP_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ SPEED_BUTTON(sp) = make_pushbutton_widget("speed-label", CONTROLS(sp), args, n);
+ XtAddEventHandler(SPEED_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(SPEED_BUTTON(sp), XmNactivateCallback, speed_click_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = initial_speed_label(sp->speed_control_style);
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, SPEED_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, SPEED_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNmarginRight, 3); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ SPEED_LABEL(sp) = make_pushbutton_widget("speed-number", CONTROLS(sp), args, n);
+ XtAddEventHandler(SPEED_LABEL(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(SPEED_LABEL(sp), XmNactivateCallback, speed_label_click_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, SPEED_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNindicatorOn, false); n++;
+ XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
+ XtSetArg(args[n], XmNmarginHeight, 0); n++;
+ XtSetArg(args[n], XmNmarginWidth, 0); n++;
+ XtSetArg(args[n], XmNmarginTop, 0); n++;
+ XtSetArg(args[n], XmNtopOffset, 0); n++;
+ SPEED_ARROW(sp) = make_togglebutton_widget("dir", CONTROLS(sp), args, n);
+ form = SPEED_ARROW(sp);
+ if (!spd_ok)
+ {
+ rb = XCreateBitmapFromData(XtDisplay(form), RootWindowOfScreen(XtScreen(form)), (const char *)speed_r_bits1, 16, 12);
+ lb = XCreateBitmapFromData(XtDisplay(form), RootWindowOfScreen(XtScreen(form)), (const char *)speed_l_bits1, 16, 12);
+ XtVaGetValues(form, XmNdepth, &depth, NULL);
+ spd_r = XCreatePixmap(XtDisplay(form), RootWindowOfScreen(XtScreen(form)), 16, 12, depth);
+ spd_l = XCreatePixmap(XtDisplay(form), RootWindowOfScreen(XtScreen(form)), 16, 12, depth);
+ XCopyPlane(XtDisplay(form), rb, spd_r, ss->fltenv_basic_gc, 0, 0, 16, 12, 0, 0, 1);
+ XCopyPlane(XtDisplay(form), lb, spd_l, ss->fltenv_basic_gc, 0, 0, 16, 12, 0, 0, 1);
+ XFreePixmap(XtDisplay(form), rb);
+ XFreePixmap(XtDisplay(form), lb);
+ spd_ok = true;
+ }
+ XtVaSetValues(form, XmNselectPixmap, spd_l, XmNlabelPixmap, spd_r, NULL);
+ XtAddEventHandler(SPEED_ARROW(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(SPEED_ARROW(sp), XmNvalueChangedCallback, play_arrow_callback, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->position_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, SPEED_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, SPEED_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, SPEED_ARROW(sp)); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, speed_to_scroll(sp->speed_control_min, 1.0, sp->speed_control_max)); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNdragCallback, n3 = make_callback_list(speed_drag_callback, (XtPointer)sp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n4 = make_callback_list(speed_valuechanged_callback, (XtPointer)sp)); n++;
+ SPEED_SCROLLBAR(sp) = XtCreateManagedWidget("speed-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
+ XtAddEventHandler(SPEED_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ n = 0;
+ /* EXPAND */
+ s1 = XmStringCreateLocalized((char *)"expand:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, SPEED_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ EXPAND_LEFT_BUTTON(sp) = make_pushbutton_widget("expand-label", CONTROLS(sp), args, n);
+ XtAddEventHandler(EXPAND_LEFT_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(EXPAND_LEFT_BUTTON(sp), XmNactivateCallback, expand_click_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"1.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, EXPAND_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, EXPAND_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginRight, 3); n++;
+ EXPAND_LABEL(sp) = XtCreateManagedWidget("expand-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, EXPAND_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNmarginWidth, 0); n++;
+ XtSetArg(args[n], XmNtopOffset, 1); n++;
+ XtSetArg(args[n], XmNspacing, 0); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ EXPAND_RIGHT_BUTTON(sp) = make_togglebutton_widget("expoff", CONTROLS(sp), args, n);
+ XtAddEventHandler(EXPAND_RIGHT_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(EXPAND_RIGHT_BUTTON(sp), XmNvalueChangedCallback, expand_button_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, EXPAND_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, EXPAND_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, EXPAND_RIGHT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, expand_to_scroll(sp->expand_control_min, 1.0, sp->expand_control_max)); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNdragCallback, n5 = make_callback_list(expand_drag_callback, (XtPointer)sp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n6 = make_callback_list(expand_valuechanged_callback, (XtPointer)sp)); n++;
+ EXPAND_SCROLLBAR(sp) = XtCreateManagedWidget("expand-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
+ XtAddEventHandler(EXPAND_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+
+ /* CONTRAST */
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"contrast:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, EXPAND_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ CONTRAST_LEFT_BUTTON(sp) = make_pushbutton_widget("contrast-label", CONTROLS(sp), args, n);
+ XtAddEventHandler(CONTRAST_LEFT_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(CONTRAST_LEFT_BUTTON(sp), XmNactivateCallback, contrast_click_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"1.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginRight, 3); n++;
+ CONTRAST_LABEL(sp) = XtCreateManagedWidget("contrast-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNmarginWidth, 0); n++;
+ XtSetArg(args[n], XmNtopOffset, 1); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNspacing, 0); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ CONTRAST_RIGHT_BUTTON(sp) = make_togglebutton_widget("conoff", CONTROLS(sp), args, n);
+ XtAddEventHandler(CONTRAST_RIGHT_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(CONTRAST_RIGHT_BUTTON(sp), XmNvalueChangedCallback, contrast_button_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, CONTRAST_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, CONTRAST_RIGHT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNvalue, 0); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNdragCallback, n7 = make_callback_list(contrast_drag_callback, (XtPointer)sp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n8 = make_callback_list(contrast_valuechanged_callback, (XtPointer)sp)); n++;
+ CONTRAST_SCROLLBAR(sp) = XtCreateManagedWidget("contrast-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
+ XtAddEventHandler(CONTRAST_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ /* REVERB */
+ /* REVSCL */
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"reverb:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ REVSCL_BUTTON(sp) = make_pushbutton_widget("revscl-label", CONTROLS(sp), args, n);
+ XtAddEventHandler(REVSCL_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(REVSCL_BUTTON(sp), XmNactivateCallback, revscl_click_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"0.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, REVSCL_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, REVSCL_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNmarginRight, 3); n++;
+ REVSCL_LABEL(sp) = XtCreateManagedWidget("revscl-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, REVSCL_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, REVSCL_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 60); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, 0); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNdragCallback, n9 = make_callback_list(revscl_drag_callback, (XtPointer)sp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n10 = make_callback_list(revscl_valuechanged_callback, (XtPointer)sp)); n++;
+ REVSCL_SCROLLBAR(sp) = XtCreateManagedWidget("revscl-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
+ XtAddEventHandler(REVSCL_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ /* REVOFF */
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, REVSCL_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, CONTRAST_RIGHT_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNmarginWidth, 0); n++;
+ XtSetArg(args[n], XmNtopOffset, 1); n++;
+ XtSetArg(args[n], XmNspacing, 0); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ REVERB_BUTTON(sp) = make_togglebutton_widget("revoff", CONTROLS(sp), args, n);
+ XtAddEventHandler(REVERB_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(REVERB_BUTTON(sp), XmNvalueChangedCallback, reverb_button_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+
+ /* REVLEN */
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"len:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, REVSCL_SCROLLBAR(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 60); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ REVLEN_BUTTON(sp) = make_pushbutton_widget("revlen-label", CONTROLS(sp), args, n);
+ XtAddEventHandler(REVLEN_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(REVLEN_BUTTON(sp), XmNactivateCallback, revlen_click_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"1.0 ");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, REVLEN_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, REVLEN_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNmarginRight, 3); n++;
+ REVLEN_LABEL(sp) = XtCreateManagedWidget("revlen-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, REVLEN_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, REVLEN_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, REVERB_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
+ XtSetArg(args[n], XmNvalue, revlen_to_scroll(sp->reverb_control_length_min, 1.0, sp->reverb_control_length_max)); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNdragCallback, n11 = make_callback_list(revlen_drag_callback, (XtPointer)sp)); n++;
+ XtSetArg(args[n], XmNvalueChangedCallback, n12 = make_callback_list(revlen_valuechanged_callback, (XtPointer)sp)); n++;
+ REVLEN_SCROLLBAR(sp) = XtCreateManagedWidget("revlen-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
+ XtAddEventHandler(REVLEN_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+
+ /* FILTER */
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"filter:");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, REVSCL_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ XtSetArg(args[n], XmNshadowThickness, 0); n++;
+ XtSetArg(args[n], XmNhighlightThickness, 0); n++;
+ XtSetArg(args[n], XmNfillOnArm, false); n++;
+ FILTER_LABEL(sp) = XtCreateManagedWidget("filter-label", xmLabelWidgetClass, CONTROLS(sp), args, n);
+ XmStringFree(s1);
+
+ /* filter order */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNresizeWidth, false); n++;
+ XtSetArg(args[n], XmNcolumns, 3); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, FILTER_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, FILTER_LABEL(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ XtSetArg(args[n], XmNrecomputeSize, false); n++;
+ FILTER_ORDER_TEXT(sp) = make_textfield_widget("filter-order", CONTROLS(sp), args, n, ACTIVATABLE, NO_COMPLETER);
+ XmTextSetString(FILTER_ORDER_TEXT(sp), (char *)" 20");
+ XtAddCallback(FILTER_ORDER_TEXT(sp), XmNactivateCallback, filter_order_activate_callback, (XtPointer)sp);
+
+ #define ARROW_SIZE 12
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, FILTER_ORDER_TEXT(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, FILTER_ORDER_TEXT(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNheight, ARROW_SIZE); n++;
+ XtSetArg(args[n], XmNwidth, ARROW_SIZE); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNmarginWidth, 0); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ FILTER_ORDER_DOWN(sp) = make_pushbutton_widget("", CONTROLS(sp), args, n);
+ XtAddEventHandler(FILTER_ORDER_DOWN(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(FILTER_ORDER_DOWN(sp), XmNactivateCallback, filter_order_down_callback, (XtPointer)sp);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, FILTER_ORDER_DOWN(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, FILTER_ORDER_TEXT(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNheight, ARROW_SIZE); n++;
+ XtSetArg(args[n], XmNwidth, ARROW_SIZE); n++;
+ XtSetArg(args[n], XmNborderWidth, 0); n++;
+ XtSetArg(args[n], XmNmarginWidth, 0); n++;
+ XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
+ FILTER_ORDER_UP(sp) = make_pushbutton_widget("", CONTROLS(sp), args, n);
+ XtAddEventHandler(FILTER_ORDER_UP(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(FILTER_ORDER_UP(sp), XmNactivateCallback, filter_order_up_callback, (XtPointer)sp);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, REVERB_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNheight, 16); n++;
+ XtSetArg(args[n], XmNmarginWidth, 0); n++;
+ XtSetArg(args[n], XmNtopOffset, 2); n++;
+ XtSetArg(args[n], XmNspacing, 0); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ FILTER_BUTTON(sp) = make_togglebutton_widget("fltoff", CONTROLS(sp), args, n);
+ XtAddEventHandler(FILTER_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(FILTER_BUTTON(sp), XmNvalueChangedCallback, filter_button_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"hz");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, FILTER_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, FILTER_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNvalue, sp->filter_control_in_hz); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ FILTER_HZ_BUTTON(sp) = make_togglebutton_widget("flthz", CONTROLS(sp), args, n);
+ XtAddEventHandler(FILTER_HZ_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(FILTER_HZ_BUTTON(sp), XmNvalueChangedCallback, filter_hz_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ s1 = XmStringCreateLocalized((char *)"dB");
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, FILTER_HZ_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, FILTER_HZ_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNlabelString, s1); n++;
+ XtSetArg(args[n], XmNvalue, sp->filter_control_in_dB); n++;
+ if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
+ XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
+ FILTER_DB_BUTTON(sp) = make_togglebutton_widget("fltdB", CONTROLS(sp), args, n);
+ XtAddEventHandler(FILTER_DB_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+ XtAddCallback(FILTER_DB_BUTTON(sp), XmNvalueChangedCallback, filter_dB_callback, (XtPointer)sp);
+ XmStringFree(s1);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, FILTER_ORDER_DOWN(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNleftWidget, FILTER_ORDER_DOWN(sp)); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNrightWidget, FILTER_DB_BUTTON(sp)); n++;
+ XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
+ FILTER_COEFFS_TEXT(sp) = make_textfield_widget("filter-text", CONTROLS(sp), args, n, ACTIVATABLE, add_completer_func(filename_completer, NULL));
+ XtAddCallback(FILTER_COEFFS_TEXT(sp), XmNactivateCallback, filter_activate_callback, (XtPointer)sp);
+
+ /* FILTER GRAPH */
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, FILTER_COEFFS_TEXT(sp)); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNleftPosition, 4); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
+ XtSetArg(args[n], XmNrightPosition, 98); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
+ XtSetArg(args[n], XmNshadowThickness, 4); n++;
+ FILTER_FRAME(sp) = XtCreateManagedWidget("filter-frame", xmFrameWidgetClass, CONTROLS(sp), args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
+ n = attach_all_sides(args, n);
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ FILTER_GRAPH(sp) = XtCreateManagedWidget("filter-window", xmDrawingAreaWidgetClass, FILTER_FRAME(sp), args, n);
+ XtAddCallback(FILTER_GRAPH(sp), XmNresizeCallback, filter_drawer_resize, (XtPointer)sp);
+ XtAddCallback(FILTER_GRAPH(sp), XmNexposeCallback, filter_drawer_resize, (XtPointer)sp);
+
+ sp->flt = new_env_editor();
+
+ XtAddEventHandler(FILTER_GRAPH(sp), ButtonPressMask, false, filter_drawer_button_press, sp);
+ XtAddEventHandler(FILTER_GRAPH(sp), ButtonMotionMask, false, filter_drawer_button_motion, sp);
+ XtAddEventHandler(FILTER_GRAPH(sp), ButtonReleaseMask, false, filter_drawer_button_release, sp);
+ XtAddEventHandler(FILTER_GRAPH(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
+
+ free(n1); free(n2); free(n3); free(n4); free(n5); free(n6);
+ free(n7); free(n8); free(n9); free(n10); free(n11); free(n12);
+ /* end if control-panel */
+ if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
+ {
+ char *name;
+ name = just_filename(sp->short_filename); /* copies */
+ if (strlen(name) > 8) name[8] = '\0';
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->graph_color); n++;
+ XtSetArg(args[n], XmNnotebookChildType, XmMAJOR_TAB); n++;
+ XtSetArg(args[n], XmNuserData, sp->index); n++;
+ sp->tab = XtCreateManagedWidget(name, xmPushButtonWidgetClass, SOUND_PANE(ss), args, n);
+ free(name);
+ }
+
+
+ if (sound_style(ss) != SOUNDS_IN_SEPARATE_WINDOWS)
+ run_new_widget_hook(SND_PANE(sp));
+ else run_new_widget_hook(sp->dialog);
+
+#if WITH_RELATIVE_PANES
+ if (sound_style(ss) == SOUNDS_VERTICAL)
+ add_sash_watchers(SOUND_PANE(ss)); /* add in any case since we might later change the sense of with_relative_panes */
+#endif
+
+ } /* new sound ss */
+ else
+ { /* re-manage currently inactive chan */
+ int k;
+ if (sound_style(ss) == SOUNDS_IN_SEPARATE_WINDOWS)
+ {
+ title = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(title, PRINT_BUFFER_SIZE, "%d: %s", snd_slot, sp->short_filename);
+ XtVaSetValues(sp->dialog, XmNtitle, title, NULL);
+ free(title);
+ if (!XtIsManaged(sp->dialog)) XtManageChild(sp->dialog);
+ }
+
+ for (i = 0; i < NUM_SND_WIDGETS - 1; i++)
+ if ((sw[i]) &&
+ (!XtIsManaged(sw[i])) &&
+ (in_show_controls(ss) || (i != W_amp_form)))
+ XtManageChild(sw[i]);
+
+ for (k = 0; k < nchans; k++)
+ add_channel_window(sp, k, chan_min_y, 0, NULL, WITH_FW_BUTTONS, WITH_EVENTS);
+
+ set_button_label(NAME_LABEL(sp), shortname_indexed(sp));
+ XtVaSetValues(SND_PANE(sp), XmNuserData, sp->index, NULL);
+
+ if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
+ {
+ char *name;
+ name = just_filename(sp->short_filename);
+ set_label(sp->tab, name);
+ free(name);
+ }
+ }
+
+ map_over_children(SOUND_PANE(ss), color_sashes);
+ if (!(in_show_controls(ss)))
+ hide_controls(sp);
+ else show_controls(sp);
+
+ if (sp->nchans == 1)
+ {
+ XmToggleButtonSetState(UNITE_BUTTON(sp), false, false);
+ XtUnmanageChild(UNITE_BUTTON(sp));
+
+ if (ss->active_sounds == 0) /* ticked at the end in snd-file.c */
+ {
+ XmToggleButtonSetState(SYNC_BUTTON(sp), false, false);
+ XtUnmanageChild(SYNC_BUTTON(sp));
+ }
+ else
+ {
+ for_each_sound(manage_sync_button);
+ }
+ }
+ else
+ {
+ for_each_sound(manage_sync_button);
+ }
+ attach_status_area(sp);
+
+ add_sound_data(filename, sp, WITH_GRAPH);
+
+ if (cant_write(sp->filename))
+ sp->file_read_only = FILE_READ_ONLY;
+ if ((sp->file_read_only == FILE_READ_ONLY) ||
+ (sp->user_read_only == FILE_READ_ONLY))
+ show_lock(sp);
+ else hide_lock(sp);
+
+ if (old_name)
+ status_report(sp, "(translated %s)", old_name);
+
+ if (sound_style(ss) != SOUNDS_IN_SEPARATE_WINDOWS)
+ {
+ reset_controls(sp);
+ }
+ else
+ {
+ XtVaSetValues(sp->dialog,
+ XmNwidth, 100,
+ XmNheight, 100,
+ NULL);
+ /* this is not redundant -- apparently they're trying to ignore size resets to the "current" */
+ /* value, but forgot that unmanage/remanage does not return to the previous size */
+ XtVaSetValues(sp->dialog,
+ XmNwidth, (Dimension)(widget_width(MAIN_SHELL(ss))),
+ XmNheight, (Dimension)(chan_min_y * nchans), /* bugfix thanks to Paul @pobox */
+ NULL);
+ }
+
+ after_open(sp);
+ if (free_filename) free(filename);
+ return(sp);
+}
+
+
+void update_sound_label(snd_info *sp)
+{
+ if (has_widgets(sp))
+ set_button_label(NAME_LABEL(sp), shortname_indexed(sp));
+}
+
+void snd_info_cleanup(snd_info *sp)
+{
+ if (has_widgets(sp))
+ {
+ clear_status_area(sp);
+ if (SYNC_BUTTON(sp))
+ {
+ XtVaSetValues(SYNC_BUTTON(sp), XmNset, false, NULL);
+ XtVaSetValues(EXPAND_RIGHT_BUTTON(sp), XmNset, false, NULL);
+ XtVaSetValues(CONTRAST_RIGHT_BUTTON(sp), XmNset, false, NULL);
+ XtVaSetValues(SPEED_ARROW(sp), XmNset, false, NULL);
+ XtVaSetValues(FILTER_BUTTON(sp), XmNset, false, NULL);
+ XtVaSetValues(REVERB_BUTTON(sp), XmNset, false, NULL);
+ XmToggleButtonSetState(UNITE_BUTTON(sp), false, false);
+ sp->channel_style = CHANNELS_SEPARATE;
+ if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
+ {
+ set_label(sp->tab, "none");
+ XmChangeColor(sp->tab, ss->graph_color);
+ }
+ XtUnmanageChild(SND_PANE(sp));
+ }
+ if ((sp->dialog) &&
+ (XtIsManaged(sp->dialog)))
+ XtUnmanageChild(sp->dialog);
+ }
+}
+
+
+static Xen reflect_file_close_in_sync(Xen hook_or_reason)
+{
+ int reason;
+#if HAVE_SCHEME
+ reason = Xen_integer_to_C_int(s7_let_ref(s7, hook_or_reason, s7_make_symbol(s7, "reason")));
+#else
+ reason = Xen_integer_to_C_int(hook_or_reason);
+#endif
+ if ((reason == FILE_CLOSED) && /* snd-file.c */
+ (ss->active_sounds == 1))
+ {
+ snd_info *sp;
+ sp = any_selected_sound();
+ if ((sp) && (sp->nchans == 1))
+ {
+ XtUnmanageChild(SYNC_BUTTON(sp));
+ attach_status_area(sp);
+ }
+ }
+ return(Xen_false);
+}
+
+Xen_wrap_1_arg(reflect_file_close_in_sync_w, reflect_file_close_in_sync)
+
+
+void set_sound_pane_file_label(snd_info *sp, const char *str)
+{
+ if (!(mus_strcmp(sp->name_string, str)))
+ {
+ if (sp->name_string) free(sp->name_string);
+ sp->name_string = mus_strdup(str);
+ set_button_label(SND_NAME(sp), str); /* this causes an expose event, so it's worth minimizing */
+ }
+}
+
+
+void color_filter_waveform(Pixel color)
+{
+ int i;
+ XSetForeground(MAIN_DISPLAY(ss), ss->fltenv_data_gc, color);
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ snd_info *sp;
+ sp = ss->sounds[i];
+ if ((sp) && (sp->inuse == SOUND_NORMAL))
+ display_filter_env(sp);
+ }
+}
+
+
+void show_controls(snd_info *sp)
+{
+ Dimension hgt;
+ XtVaGetValues(FILTER_LABEL(sp),
+ XmNy, &hgt,
+ NULL);
+ if (XtIsManaged(CONTROLS(sp)))
+ XtUnmanageChild(CONTROLS(sp));
+ XtVaSetValues(CONTROLS(sp),
+ XmNpaneMinimum, hgt,
+ XmNpaneMaximum, hgt,
+ NULL);
+ XtManageChild(CONTROLS(sp));
+ XtVaSetValues(CONTROLS(sp),
+ XmNpaneMinimum, 1,
+ XmNpaneMaximum, LOTSA_PIXELS,
+ NULL);
+}
+
+
+void hide_controls(snd_info *sp)
+{
+ XtUnmanageChild(CONTROLS(sp));
+}
+
+
+bool showing_controls(snd_info *sp)
+{
+ return((bool)(XtIsManaged(CONTROLS(sp))));
+}
+
+
+void show_all_controls(void)
+{
+ int i;
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ snd_info *sp;
+ sp = ss->sounds[i];
+ if ((sp) && (sp->inuse == SOUND_NORMAL))
+ show_controls(sp);
+ }
+}
+
+
+void hide_all_controls(void)
+{
+ int i;
+ for (i = 0; i < ss->max_sounds; i++)
+ {
+ snd_info *sp;
+ sp = ss->sounds[i];
+ if ((sp) && (sp->inuse == SOUND_NORMAL))
+ hide_controls(sp);
+ }
+}
+
+
+int control_panel_height(snd_info *sp)
+{
+ return(widget_height(CONTROLS(sp)));
+}
+
+
+/* -------- PROGRESS REPORT -------- */
+
+void progress_report(chan_info *cp, mus_float_t pct)
+{
+ int which;
+ snd_info *sp;
+ sp = cp->sound;
+
+ if ((!has_widgets(sp)) || (sp->inuse != SOUND_NORMAL)) return;
+
+ which = (int)(pct * NUM_HOURGLASSES);
+ if (which >= NUM_HOURGLASSES) which = NUM_HOURGLASSES - 1;
+ if (which < 0) which = 0;
+
+ if ((hourglasses[which]) &&
+ (cp->chan < sp->num_progress_widgets) &&
+ ((cp->chan == 0) ||
+ (sp->channel_style != CHANNELS_SUPERIMPOSED)))
+ {
+ XtVaSetValues(PROGRESS_ICON(cp), XmNlabelPixmap, hourglasses[which], NULL);
+ XmUpdateDisplay(PROGRESS_ICON(cp));
+ }
+
+ check_for_event();
+}
+
+void finish_progress_report(chan_info *cp)
+{
+ snd_info *sp;
+ sp = cp->sound;
+
+ if ((!has_widgets(sp)) || (sp->inuse != SOUND_NORMAL)) return;
+
+ if ((cp->chan < sp->num_progress_widgets) &&
+ ((cp->chan == 0) ||
+ (sp->channel_style != CHANNELS_SUPERIMPOSED)))
+ {
+ XtVaSetValues(PROGRESS_ICON(cp), XmNlabelPixmap, blank_pixmap, NULL);
+ XmUpdateDisplay(PROGRESS_ICON(cp));
+ hide_stop_sign(sp);
+ }
+}
+
+
+void start_progress_report(chan_info *cp)
+{
+ snd_info *sp;
+ sp = cp->sound;
+
+ if ((!has_widgets(sp)) || (sp->inuse != SOUND_NORMAL)) return;
+
+ if ((cp->chan < sp->num_progress_widgets) &&
+ ((cp->chan == 0) ||
+ (sp->channel_style != CHANNELS_SUPERIMPOSED)))
+ {
+ XtVaSetValues(PROGRESS_ICON(cp), XmNlabelPixmap, hourglasses[0], NULL);
+ XmUpdateDisplay(PROGRESS_ICON(cp));
+ show_stop_sign(sp);
+ }
+}
+
+
+
+void reflect_sound_selection(snd_info *sp)
+{
+ /* sp is the newly selected sound, ss->selected_sound is the previous one */
+ snd_info *osp = NULL;
+
+ if (ss->selected_sound != NO_SELECTION)
+ osp = ss->sounds[ss->selected_sound];
+
+ if ((osp) &&
+ (sp != osp) &&
+ (osp->inuse == SOUND_NORMAL))
+ {
+ XmChangeColor(SND_NAME(osp), ss->highlight_color);
+ if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
+ XmChangeColor(osp->tab, ss->graph_color);
+ }
+
+ if (sp->selected_channel != NO_SELECTION)
+ {
+ XmChangeColor(SND_NAME(sp), ss->white);
+ if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
+ {
+ int page, current_page;
+ XmNotebookPageStatus status;
+ XmNotebookPageInfo info;
+ XmChangeColor(sp->tab, ss->selected_graph_color);
+ XtVaGetValues(SOUND_PANE(ss), XmNcurrentPageNumber, ¤t_page, NULL);
+ XtVaGetValues(sp->tab, XmNpageNumber, &page, NULL);
+ if (page != current_page)
+ {
+ status = XmNotebookGetPageInfo(SOUND_PANE(ss), page, &info);
+ if (status == XmPAGE_FOUND)
+ {
+ XtVaSetValues(SOUND_PANE(ss), XmNcurrentPageNumber, page, NULL);
+ }
+ }
+ }
+ }
+}
+
+
+/* -------- controls dialog -------- */
+
+static Widget controls_dialog = NULL;
+enum {EXPAND_HOP, EXPAND_LENGTH, EXPAND_RAMP, EXPAND_JITTER, CONTRAST_AMP, REVERB_LOWPASS, REVERB_FEEDBACK};
+static Widget controls[7];
+
+static void reset_all_sliders(void)
+{
+ expand_control_set_hop(DEFAULT_EXPAND_CONTROL_HOP);
+ expand_control_set_length(DEFAULT_EXPAND_CONTROL_LENGTH);
+ expand_control_set_ramp(DEFAULT_EXPAND_CONTROL_RAMP);
+ expand_control_set_jitter(DEFAULT_EXPAND_CONTROL_JITTER);
+ contrast_control_set_amp(DEFAULT_CONTRAST_CONTROL_AMP);
+ reverb_control_set_lowpass(DEFAULT_REVERB_CONTROL_LOWPASS);
+ reverb_control_set_feedback(DEFAULT_REVERB_CONTROL_FEEDBACK);
+
+ XtVaSetValues(controls[EXPAND_HOP], XmNvalue, (int)(expand_control_hop(ss) * 1000), NULL);
+ XtVaSetValues(controls[EXPAND_LENGTH], XmNvalue, (int)(expand_control_length(ss) * 1000), NULL);
+ XtVaSetValues(controls[EXPAND_RAMP], XmNvalue, (int)(expand_control_ramp(ss) * 1000), NULL);
+ XtVaSetValues(controls[EXPAND_JITTER], XmNvalue, (int)(expand_control_jitter(ss) * 1000), NULL);
+ XtVaSetValues(controls[CONTRAST_AMP], XmNvalue, (int)(contrast_control_amp(ss) * 1000), NULL);
+ XtVaSetValues(controls[REVERB_LOWPASS], XmNvalue, (int)(reverb_control_lowpass(ss) * 1000), NULL);
+ XtVaSetValues(controls[REVERB_FEEDBACK], XmNvalue, (int)(reverb_control_feedback(ss) * 1000), NULL);
+}
+
+static void controls_reset_callback(Widget w, XtPointer context, XtPointer info)
+{
+ if (XmGetFocusWidget(controls_dialog) == XmMessageBoxGetChild(controls_dialog, XmDIALOG_OK_BUTTON))
+ reset_all_sliders();
+}
+
+static void controls_help_callback(Widget w, XtPointer context, XtPointer info)
+{
+ snd_help("More controls",
+"This dialog controls all the otherwise hidden control-panel variables.\n\
+Expand-hop sets the time in seconds between successive grains.\n\
+Expand-length sets the length of each grain.\n\
+Expand-ramp sets the ramp-time in the grain envelope.\n\
+Expand-jitter sets the grain timing jitter.\n\
+Contrast-amp sets the prescaler for contrast-enhancement.\n\
+Reverb-lowpass sets the feedback lowpass filter coeficient.\n\
+Reverb-feedback sets the scaler on the feedback.",
+ WITHOUT_WORD_WRAP);
+}
+
+static void controls_quit_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XtUnmanageChild(controls_dialog);
+}
+
+static void expand_hop_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ expand_control_set_hop(cbs->value * 0.001);
+}
+
+static void expand_length_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ expand_control_set_length(cbs->value * 0.001);
+}
+
+static void expand_ramp_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ expand_control_set_ramp(cbs->value * 0.001);
+}
+
+static void expand_jitter_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ expand_control_set_jitter(cbs->value * 0.001);
+}
+
+static void contrast_amp_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ contrast_control_set_amp(cbs->value * 0.001);
+}
+
+static void reverb_lowpass_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ reverb_control_set_lowpass(cbs->value * 0.001);
+}
+
+static void reverb_feedback_callback(Widget w, XtPointer context, XtPointer info)
+{
+ XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
+ reverb_control_set_feedback(cbs->value * 0.001);
+}
+
+void make_controls_dialog(void)
+{
+ #define MSG_BOX(Dialog, Child) XmMessageBoxGetChild(Dialog, Child)
+ if (!controls_dialog)
+ {
+ int n;
+ Arg args[32];
+ XmString go_away, xhelp, titlestr, xreset;
+ Widget mainform, slider, reset_button;
+
+ go_away = XmStringCreateLocalized((char *)I_GO_AWAY);
+ xhelp = XmStringCreateLocalized((char *)I_HELP);
+ titlestr = XmStringCreateLocalized((char *)"More controls");
+ xreset = XmStringCreateLocalized((char *)"Reset");
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
+ XtSetArg(args[n], XmNokLabelString, xreset); n++;
+ XtSetArg(args[n], XmNcancelLabelString, go_away); n++;
+ XtSetArg(args[n], XmNautoUnmanage, false); n++;
+ XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
+ XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
+ XtSetArg(args[n], XmNnoResize, false); n++;
+ XtSetArg(args[n], XmNtransient, false); n++;
+ XtSetArg(args[n], XmNwidth, 400); n++;
+ controls_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"More controls", args, n);
+ reset_button = MSG_BOX(controls_dialog, XmDIALOG_OK_BUTTON);
+
+ XtAddCallback(controls_dialog, XmNhelpCallback, controls_help_callback, NULL);
+ /* XtAddCallback(controls_dialog, XmNokCallback, controls_reset_callback, NULL); */
+ XtAddCallback(reset_button, XmNactivateCallback, controls_reset_callback, NULL);
+ XtAddCallback(controls_dialog, XmNcancelCallback, controls_quit_callback, NULL);
+
+ XmStringFree(xhelp);
+ XmStringFree(go_away);
+ XmStringFree(titlestr);
+ XmStringFree(xreset);
+
+ XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
+ XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
+ XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
+
+ mainform = XtVaCreateManagedWidget("formd", xmRowColumnWidgetClass, controls_dialog,
+ XmNleftAttachment, XmATTACH_FORM,
+ XmNrightAttachment, XmATTACH_FORM,
+ XmNtopAttachment, XmATTACH_FORM,
+ XmNbottomAttachment, XmATTACH_WIDGET,
+ XmNbottomWidget, XmMessageBoxGetChild(controls_dialog, XmDIALOG_SEPARATOR),
+ XmNorientation, XmVERTICAL,
+ NULL);
+
+ titlestr = XmStringCreateLocalized((char *)"expand hop");
+ slider = XtVaCreateManagedWidget("expand-hop", xmScaleWidgetClass, mainform,
+ XmNorientation, XmHORIZONTAL,
+ XmNshowValue, true,
+ XmNminimum, 1,
+ XmNmaximum, 300,
+ XmNvalue, (int)(expand_control_hop(ss) * 1000),
+ XmNdecimalPoints, 3,
+ XmNtitleString, titlestr,
+ XmNborderWidth, 1,
+ XmNbackground, ss->basic_color,
+ NULL);
+ XmStringFree(titlestr);
+ XtAddCallback(slider, XmNvalueChangedCallback, expand_hop_callback, NULL);
+ XtAddCallback(slider, XmNdragCallback, expand_hop_callback, NULL);
+ controls[EXPAND_HOP] = slider;
+
+ titlestr = XmStringCreateLocalized((char *)"expand length");
+ slider = XtVaCreateManagedWidget("expand-length", xmScaleWidgetClass, mainform,
+ XmNorientation, XmHORIZONTAL,
+ XmNshowValue, true,
+ XmNminimum, 10,
+ XmNmaximum, 500,
+ XmNvalue, (int)(expand_control_length(ss) * 1000),
+ XmNdecimalPoints, 3,
+ XmNtitleString, titlestr,
+ XmNborderWidth, 1,
+ XmNbackground, ss->basic_color,
+ NULL);
+ XmStringFree(titlestr);
+ XtAddCallback(slider, XmNvalueChangedCallback, expand_length_callback, NULL);
+ XtAddCallback(slider, XmNdragCallback, expand_length_callback, NULL);
+ controls[EXPAND_LENGTH] = slider;
+
+ titlestr = XmStringCreateLocalized((char *)"expand ramp");
+ slider = XtVaCreateManagedWidget("expand-ramp", xmScaleWidgetClass, mainform,
+ XmNorientation, XmHORIZONTAL,
+ XmNshowValue, true,
+ XmNminimum, 10,
+ XmNmaximum, 500,
+ XmNvalue, (int)(expand_control_ramp(ss) * 1000),
+ XmNdecimalPoints, 3,
+ XmNtitleString, titlestr,
+ XmNborderWidth, 1,
+ XmNbackground, ss->basic_color,
+ NULL);
+ XmStringFree(titlestr);
+ XtAddCallback(slider, XmNvalueChangedCallback, expand_ramp_callback, NULL);
+ XtAddCallback(slider, XmNdragCallback, expand_ramp_callback, NULL);
+ controls[EXPAND_RAMP] = slider;
+
+ titlestr = XmStringCreateLocalized((char *)"expand jitter");
+ slider = XtVaCreateManagedWidget("expand-hop", xmScaleWidgetClass, mainform,
+ XmNorientation, XmHORIZONTAL,
+ XmNshowValue, true,
+ XmNminimum, 0,
+ XmNmaximum, 200,
+ XmNvalue, (int)(expand_control_jitter(ss) * 1000),
+ XmNdecimalPoints, 3,
+ XmNtitleString, titlestr,
+ XmNborderWidth, 1,
+ XmNbackground, ss->basic_color,
+ NULL);
+ XmStringFree(titlestr);
+ XtAddCallback(slider, XmNvalueChangedCallback, expand_jitter_callback, NULL);
+ XtAddCallback(slider, XmNdragCallback, expand_jitter_callback, NULL);
+ controls[EXPAND_JITTER] = slider;
+
+ titlestr = XmStringCreateLocalized((char *)"contrast amp");
+ slider = XtVaCreateManagedWidget("contrast-amp", xmScaleWidgetClass, mainform,
+ XmNorientation, XmHORIZONTAL,
+ XmNshowValue, true,
+ XmNminimum, 0,
+ XmNmaximum, 2000,
+ XmNvalue, (int)(contrast_control_amp(ss) * 1000),
+ XmNdecimalPoints, 3,
+ XmNtitleString, titlestr,
+ XmNborderWidth, 1,
+ XmNbackground, ss->basic_color,
+ NULL);
+ XmStringFree(titlestr);
+ XtAddCallback(slider, XmNvalueChangedCallback, contrast_amp_callback, NULL);
+ XtAddCallback(slider, XmNdragCallback, contrast_amp_callback, NULL);
+ controls[CONTRAST_AMP] = slider;
+
+ titlestr = XmStringCreateLocalized((char *)"reverb lowpass");
+ slider = XtVaCreateManagedWidget("reverb-lowpass", xmScaleWidgetClass, mainform,
+ XmNorientation, XmHORIZONTAL,
+ XmNshowValue, true,
+ XmNminimum, 0,
+ XmNmaximum, 1000,
+ XmNvalue, (int)(reverb_control_lowpass(ss) * 1000),
+ XmNdecimalPoints, 3,
+ XmNtitleString, titlestr,
+ XmNborderWidth, 1,
+ XmNbackground, ss->basic_color,
+ NULL);
+ XmStringFree(titlestr);
+ XtAddCallback(slider, XmNvalueChangedCallback, reverb_lowpass_callback, NULL);
+ XtAddCallback(slider, XmNdragCallback, reverb_lowpass_callback, NULL);
+ controls[REVERB_LOWPASS] = slider;
+
+ titlestr = XmStringCreateLocalized((char *)"reverb feedback");
+ slider = XtVaCreateManagedWidget("reverb-feedback", xmScaleWidgetClass, mainform,
+ XmNorientation, XmHORIZONTAL,
+ XmNshowValue, true,
+ XmNminimum, 0,
+ XmNmaximum, 1250,
+ XmNvalue, (int)(reverb_control_feedback(ss) * 1000),
+ XmNdecimalPoints, 3,
+ XmNtitleString, titlestr,
+ XmNborderWidth, 1,
+ XmNbackground, ss->basic_color,
+ NULL);
+ XmStringFree(titlestr);
+ XtAddCallback(slider, XmNvalueChangedCallback, reverb_feedback_callback, NULL);
+ XtAddCallback(slider, XmNdragCallback, reverb_feedback_callback, NULL);
+ controls[REVERB_FEEDBACK] = slider;
+
+ set_dialog_widget(CONTROLS_DIALOG, controls_dialog);
+ }
+
+ if (!XtIsManaged(controls_dialog))
+ XtManageChild(controls_dialog);
+}
+
+
+/* ---------------------------------------- */
+
+static Xen g_sound_widgets(Xen snd)
+{
+ #define H_sound_widgets "(" S_sound_widgets " :optional snd): a list of \
+widgets: (0)pane (1)name (2)control-panel (3)status area (4)play-button (5)filter-env (6)unite-button (7)name-label (8)name-icon (9)sync-button"
+
+ snd_info *sp;
+
+ Snd_assert_sound(S_sound_widgets, snd, 1);
+
+ sp = get_sp(snd);
+ if (sp == NULL)
+ return(snd_no_such_sound_error(S_sound_widgets, snd));
+ if (!has_widgets(sp))
+ return(Xen_empty_list);
+
+ return(Xen_cons(Xen_wrap_widget(SND_PANE(sp)),
+ Xen_cons(Xen_wrap_widget(SND_NAME(sp)),
+ Xen_cons(Xen_wrap_widget(CONTROLS(sp)),
+ Xen_cons(Xen_wrap_widget(STATUS_AREA(sp)),
+#if WITH_AUDIO
+ Xen_cons(Xen_wrap_widget(PLAY_BUTTON(sp)),
+#else
+ Xen_cons(Xen_false,
+#endif
+ Xen_cons(Xen_wrap_widget(FILTER_GRAPH(sp)), /* this is the drawingarea widget */
+ Xen_cons(Xen_wrap_widget(UNITE_BUTTON(sp)),
+ Xen_cons(Xen_false,
+ Xen_cons(Xen_wrap_widget(LOCK_OR_BOMB(sp)),
+ Xen_cons(Xen_wrap_widget(SYNC_BUTTON(sp)),
+ Xen_empty_list)))))))))));
+}
+
+
+Xen_wrap_1_optional_arg(g_sound_widgets_w, g_sound_widgets)
+
+void g_init_gxsnd(void)
+{
+ Xen_add_to_hook_list(ss->snd_open_file_hook, reflect_file_close_in_sync_w, "sync-open-file-watcher", "sound sync open-file-hook handler");
+ Xen_define_safe_procedure(S_sound_widgets, g_sound_widgets_w, 0, 1, 0, H_sound_widgets);
+}
+
+
+#define FALLBACK_FONT "fixed"
+#define DEFAULT_LISTENER_FONT "9x15"
+#define DEFAULT_FONTLIST "9x15"
+
+#define HIGHLIGHT_COLOR "ivory1"
+#define BASIC_COLOR "ivory2"
+#define POSITION_COLOR "ivory3"
+#define ZOOM_COLOR "ivory4"
+#define CURSOR_COLOR "red"
+#define SELECTION_COLOR "lightsteelblue1"
+#define ENVED_WAVEFORM_COLOR "blue"
+#define MIX_COLOR "darkgray"
+#define GRAPH_COLOR "white"
+#define SELECTED_GRAPH_COLOR "white"
+#define DATA_COLOR "black"
+#define SELECTED_DATA_COLOR "black"
+#define MARK_COLOR "red"
+#define LISTENER_COLOR "AliceBlue"
+#define LISTENER_TEXT_COLOR "black"
+#define LIGHT_BLUE_COLOR "lightsteelblue1"
+#define LIGHTER_BLUE_COLOR "AliceBlue"
+#define WHITE_COLOR "white"
+#define BLACK_COLOR "black"
+#define GREEN_COLOR "green2"
+#define RED_COLOR "red"
+#define YELLOW_COLOR "yellow"
+#define TEXT_FOCUS_COLOR "white"
+#define FILTER_CONTROL_WAVEFORM_COLOR "blue"
+#define SASH_COLOR "lightgreen"
+#define CHANNEL_SASH_INDENT -10
+#define CHANNEL_SASH_SIZE 0
+/* 0 means: use Motif default size */
+
+#define POSITION_SLIDER_WIDTH 13
+#define ZOOM_SLIDER_WIDTH 10
+#if (!__linux__) && (!_LINUX__)
+ #define TOGGLE_SIZE 0
+#else
+ #define TOGGLE_SIZE 15
+#endif
+#define CHANNEL_MIN_HEIGHT 150 /* open size (set to 5 immediately thereafter) */
+ /* paned window default setup is not very smart, so we force these to be this size to begin with */
+ /* this number is only a first approximation -- we try not to expand below the screen */
+ /* if too small (i.e. 100), the scrollbars are sometimes messed up on the initial layout */
+
+#define SASH_SIZE 16
+#define SASH_INDENT -20
+#define AUTO_RESIZE_DEFAULT 1
+
+#define INITIAL_WINDOW_WIDTH 700
+#define INITIAL_WINDOW_HEIGHT 300
+
+
+static void window_close(Widget w, XtPointer context, XtPointer info)
+{
+ /* this is called from the window manager close event, not (exit) or the File:Exit item */
+ snd_exit_cleanly(EXIT_FORCED);
+}
+
+
+static XtIntervalId auto_update_proc = 0;
+
+static void auto_update_check(XtPointer context, XtIntervalId *id)
+{
+ if (auto_update_interval(ss) > 0.0)
+ {
+ if (!(play_in_progress()))
+ for_each_sound(sound_not_current);
+ auto_update_proc = XtAppAddTimeOut(MAIN_APP(ss),
+ (unsigned long)(auto_update_interval(ss) * 1000),
+ (XtTimerCallbackProc)auto_update_check,
+ context);
+ }
+ else auto_update_proc = 0;
+}
+
+
+void auto_update_restart(void)
+{
+ if (auto_update_proc == 0)
+ auto_update_proc = XtAppAddTimeOut(MAIN_APP(ss),
+ (unsigned long)(auto_update_interval(ss) * 1000),
+ (XtTimerCallbackProc)auto_update_check,
+ (XtPointer)NULL);
+}
+
+
+
+/* handle iconification */
+static Widget *iconify_active_dialogs = NULL;
+
+static void minify_maxify_window(Widget w, XtPointer context, XEvent *event, Boolean *cont)
+{
+ XMapEvent *ev = (XMapEvent *)event;
+ int i;
+ if ((!ss) || (!(ss->dialogs)))
+ return;
+
+ /* ev->type can be several things, but the ones we care about here are
+ * MapNotify and UnmapNotify. Snd dialogs are "windows" in X-jargon, so
+ * when the main window is minimized (iconified), other active dialogs
+ * aren't also closed unless we mess with them explicitly here. We keep
+ * a list of created dialogs, and depend on XtIsManaged to tell us which
+ * ones need to be unmanaged. But, if the user has several "desks", a change
+ * of desk can also generate an unmap event, and if we dismiss the dialogs,
+ * they don't come back upon remap; if we save a list of live dialogs, they
+ * don't return to their previous location upon being re-managed. We
+ * need to see just iconfication events here, but there's no way I can
+ * see to distinguish an iconify event from a desk event (WM_STATE atom state
+ * of property changed event is identical etc), so I'll do what I can...
+ * This problem may be a side-effect of using non-transient dialogs:
+ * perhaps XSetTransientFor would handle this more cleanly?
+ *
+ * Also, ideally we'd equalize/relative-panes upon maxify, but ICCC thinks maxify
+ * is the same as map (i.e. from iconified state), and the only difference
+ * I can see in the mwm code is the window size.
+ *
+ * a rumor in the air that what we need is to catch StructureNotify event, then
+ * check in that for UnmapNotify
+ */
+ if (ev->type == UnmapNotify)
+ {
+ if (iconify_active_dialogs) free(iconify_active_dialogs);
+ iconify_active_dialogs = (Widget *)calloc(ss->num_dialogs, sizeof(Widget));
+
+ for (i = 0; i < ss->num_dialogs; i++)
+ if (ss->dialogs[i])
+ {
+ if (XtIsManaged(ss->dialogs[i]))
+ iconify_active_dialogs[i] = ss->dialogs[i];
+ XtUnmanageChild(ss->dialogs[i]);
+ }
+ }
+ else
+ {
+ if (ev->type == MapNotify)
+ {
+ if (iconify_active_dialogs)
+ {
+ for (i = 0; i < ss->num_dialogs; i++)
+ if (iconify_active_dialogs[i])
+ XtManageChild(iconify_active_dialogs[i]);
+
+ free(iconify_active_dialogs);
+ iconify_active_dialogs = NULL;
+ }
+ }
+ }
+}
+
+
+#ifndef _MSC_VER
+#include <setjmp.h>
+
+static jmp_buf top_level_jump;
+
+void top_level_catch(int ignore);
+void top_level_catch(int ignore)
+{
+ longjmp(top_level_jump, 1);
+}
+#endif
+
+
+static char **auto_open_file_names = NULL;
+static int auto_open_files = 0;
+static bool noglob = false, noinit = false, batch = false, nostdin = false;
+
+#if HAVE_EXTENSION_LANGUAGE
+static XtInputId stdin_id = 0;
+
+static void get_stdin_string(XtPointer context, int *fd, XtInputId *id)
+{
+ int size;
+ ssize_t bytes;
+ char *buf;
+ buf = (char *)calloc(1024, sizeof(char));
+ size = 1024;
+ bytes = read(*fd, buf, 1024);
+ if (bytes <= 0)
+ {
+ /* redirected to /dev/null?? -- apparently in kde/kfm the process is started without stdin? */
+ XtRemoveInput(stdin_id);
+ stdin_id = 0;
+ }
+ else
+ {
+ while (bytes == 1024)
+ {
+ size += 1024;
+ buf = (char *)realloc(buf, size);
+ bytes = read(*fd, (char *)(buf + size - 1024), 1024);
+ }
+ snd_eval_stdin_str(buf);
+ }
+ free(buf);
+}
+#endif
+
+
+static void startup_funcs(void)
+{
+ Atom wm_delete_window;
+ Display *dpy;
+ Widget shell;
+ static int auto_open_ctr = 0;
+
+ ss->file_monitor_ok = initialize_file_monitor();
+
+ shell = ss->mainshell;
+ dpy = MAIN_DISPLAY(ss);
+
+#ifndef __alpha__
+ add_menu_drop();
+#endif
+
+ /* trap outer-level Close for cleanup check */
+ wm_delete_window = XmInternAtom(dpy, (char *)"WM_DELETE_WINDOW", false);
+ XmAddWMProtocolCallback(shell, wm_delete_window, window_close, NULL);
+ XtAddEventHandler(shell, StructureNotifyMask, false, minify_maxify_window, NULL);
+
+ ss->graph_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), in_graph_cursor(ss));
+ ss->wait_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_watch);
+ ss->bounds_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_sb_h_double_arrow);
+ ss->yaxis_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_sb_v_double_arrow);
+ ss->play_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_sb_right_arrow);
+ ss->loop_play_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_sb_left_arrow);
+
+#if HAVE_EXTENSION_LANGUAGE
+ snd_load_init_file(noglob, noinit);
+#endif
+
+#if (!_MSC_VER) && HAVE_EXTENSION_LANGUAGE && !__MINGW32__
+ if (!nostdin)
+ {
+ signal(SIGTTIN, SIG_IGN);
+ signal(SIGTTOU, SIG_IGN);
+ /* these signals are sent by a shell if we start Snd as a background process,
+ * but try to read stdin (needed to support the emacs subjob connection). If
+ * we don't do this, the background job is suspended when the shell sends SIGTTIN.
+ */
+ stdin_id = XtAppAddInput(MAIN_APP(ss),
+ STDIN_FILENO,
+ (XtPointer)XtInputReadMask,
+ get_stdin_string,
+ NULL);
+ }
+#endif
+
+ while (auto_open_ctr < auto_open_files)
+ auto_open_ctr = handle_next_startup_arg(auto_open_ctr, auto_open_file_names, false, auto_open_files);
+
+ if (ss->init_window_width > 0) set_widget_width(MAIN_SHELL(ss), ss->init_window_width);
+ if (ss->init_window_height > 0) set_widget_height(MAIN_SHELL(ss), ss->init_window_height);
+ if (ss->init_window_x != DEFAULT_INIT_WINDOW_X) set_widget_x(MAIN_SHELL(ss), ss->init_window_x);
+ if (ss->init_window_y != DEFAULT_INIT_WINDOW_Y) set_widget_y(MAIN_SHELL(ss), ss->init_window_y);
+
+ if (!ss->file_monitor_ok)
+ {
+ if (auto_update_interval(ss) > 0.0)
+ XtAppAddTimeOut(MAIN_APP(ss),
+ (unsigned long)(auto_update_interval(ss) * 1000),
+ auto_update_check,
+ NULL);
+ }
+
+
+ if ((ss->sounds) &&
+ (ss->selected_sound == NO_SELECTION))
+ {
+ snd_info *sp;
+ sp = ss->sounds[0];
+ if ((sp) &&
+ (sp->inuse == SOUND_NORMAL) &&
+ (sp->selected_channel == NO_SELECTION)) /* don't clobber possible select-channel in loaded startup files */
+ select_channel(sp, 0);
+ }
+
+ if ((ss->init_window_height == 0) && (sound_style(ss) == SOUNDS_HORIZONTAL))
+ set_widget_height(MAIN_SHELL(ss), 200); /* otherwise it's just a title bar! */
+}
+
+
+static void SetupIcon(Widget shell)
+{
+ Display *dpy;
+ Window root;
+ int scr;
+ Pixmap pix, mask;
+ XpmAttributes attributes;
+ dpy = XtDisplay(shell);
+ root = DefaultRootWindow(dpy);
+ scr = DefaultScreen(dpy);
+ XtVaGetValues(shell, XmNdepth, &attributes.depth, XmNcolormap, &attributes.colormap, NULL);
+ attributes.visual = DefaultVisual(dpy, scr);
+ attributes.valuemask = XpmDepth | XpmColormap | XpmVisual;
+ XpmCreatePixmapFromData(dpy, root, (char **)snd_icon_bits(), &pix, &mask, &attributes);
+ if (mask) XFreePixmap(dpy, mask);
+ XtVaSetValues(shell, XmNiconPixmap, pix, NULL);
+}
+
+
+static void muffle_warning(char *name, char *type, char *klass, char *defaultp, char **params, unsigned int *num_params)
+{
+}
+
+
+static void notebook_page_changed_callback(Widget w, XtPointer context, XtPointer info)
+{
+ /* if page chosen via major tab click, select that sound */
+ XmNotebookCallbackStruct *nb = (XmNotebookCallbackStruct *)info;
+ Widget page;
+ if ((nb->reason == XmCR_MAJOR_TAB) && (nb->page_widget))
+ {
+ page = nb->page_widget;
+ if (page)
+ {
+ int index;
+ pointer_or_int_t data;
+ XtVaGetValues(page, XmNuserData, &data, NULL);
+ index = (int)data;
+ if ((index < ss->max_sounds) &&
+ (snd_ok(ss->sounds[index])))
+ {
+ snd_info *sp;
+ sp = ss->sounds[index];
+ if (sp->selected_channel == NO_SELECTION)
+ select_channel(ss->sounds[index], 0);
+ else select_channel(ss->sounds[index], sp->selected_channel);
+ }
+ }
+ }
+}
+
+
+color_t get_in_between_color(color_t fg, color_t bg)
+{
+ Colormap cmap;
+ Display *dpy;
+ int scr;
+ XColor fg_color, bg_color, new_color;
+ dpy = MAIN_DISPLAY(ss);
+ scr = DefaultScreen(dpy);
+ cmap = DefaultColormap(dpy, scr);
+ fg_color.flags = DoRed | DoGreen | DoBlue;
+ fg_color.pixel = fg;
+ XQueryColor(dpy, cmap, &fg_color);
+ bg_color.flags = DoRed | DoGreen | DoBlue;
+ bg_color.pixel = bg;
+ XQueryColor(dpy, cmap, &bg_color);
+ new_color.flags = DoRed | DoGreen | DoBlue;
+ new_color.red = (rgb_t)((fg_color.red + (2 * bg_color.red)) / 3);
+ new_color.green = (rgb_t)((fg_color.green + (2 * bg_color.green)) / 3);
+ new_color.blue = (rgb_t)((fg_color.blue + (2 * bg_color.blue)) / 3);
+ if ((XAllocColor(dpy, cmap, &new_color)) == 0)
+ return(fg);
+ return(new_color.pixel);
+}
+
+
+static Pixel get_color(Widget shell, const char *defined_color,
+ const char *fallback_color, const char *second_fallback_color, bool use_white)
+{
+ Colormap cmap;
+ Display *dpy;
+ int scr;
+ XColor tmp_color, ignore;
+
+ dpy = XtDisplay(shell);
+ scr = DefaultScreen(dpy);
+ cmap = DefaultColormap(dpy, scr);
+ /* I suppose we could use XQueryColors and search for the closest available, or try yet again to get XCreateColormap to behave itself */
+
+ if ((!XAllocNamedColor(dpy, cmap, defined_color, &tmp_color, &ignore)) &&
+ ((!fallback_color) ||
+ (!XAllocNamedColor(dpy, cmap, fallback_color, &tmp_color, &ignore))) &&
+ ((!second_fallback_color) ||
+ (!XAllocNamedColor(dpy, cmap, second_fallback_color, &tmp_color, &ignore))))
+ {
+ /* snd_error here causes a seg fault (it builds on mainpane which has not yet been created) */
+ if (use_white)
+ {
+ fprintf(stderr, "can't get color %s -- will use white\n", defined_color);
+ return(WhitePixel(dpy, scr));
+ }
+ else
+ {
+ fprintf(stderr, "can't get color %s -- will use black\n", defined_color);
+ return(BlackPixel(dpy, scr));
+ }
+ }
+ return(tmp_color.pixel);
+}
+
+
+static void save_a_color(FILE *Fp, Display *dpy, Colormap cmap, const char *name, Pixel pix, const char *ext_name)
+{
+#if HAVE_EXTENSION_LANGUAGE
+ Status lookup_ok;
+ XColor default_color, ignore;
+
+ lookup_ok = XLookupColor(dpy, cmap, name, &default_color, &ignore);
+ if (lookup_ok)
+ {
+ XColor current_color;
+ current_color.flags = DoRed | DoGreen | DoBlue;
+ current_color.pixel = pix;
+ XQueryColor(dpy, cmap, ¤t_color);
+ if ((current_color.red != default_color.red) ||
+ (current_color.green != default_color.green) ||
+ (current_color.blue != default_color.blue))
+
+#if HAVE_FORTH
+ fprintf(Fp, "%.3f %.3f %.3f %s set-%s drop\n",
+ rgb_to_float(current_color.red),
+ rgb_to_float(current_color.green),
+ rgb_to_float(current_color.blue),
+ S_make_color,
+ ext_name);
+#else
+
+#if HAVE_SCHEME
+ fprintf(Fp, "(set! (%s) (%s %.3f %.3f %.3f))\n",
+#endif
+
+#if HAVE_RUBY
+ fprintf(Fp, "set_%s(%s(%.3f, %.3f, %.3f))\n",
+#endif
+ to_proc_name(ext_name),
+ to_proc_name(S_make_color),
+ rgb_to_float(current_color.red),
+ rgb_to_float(current_color.green),
+ rgb_to_float(current_color.blue));
+#endif
+ }
+#endif
+}
+
+
+void save_colors(FILE *Fp)
+{
+ Colormap cmap;
+ Display *dpy;
+ int scr;
+
+ dpy = XtDisplay(ss->mainshell);
+ scr = DefaultScreen(dpy);
+ cmap = DefaultColormap(dpy, scr);
+
+ save_a_color(Fp, dpy, cmap, BASIC_COLOR, ss->basic_color, S_basic_color);
+ save_a_color(Fp, dpy, cmap, CURSOR_COLOR, ss->cursor_color, S_cursor_color);
+ save_a_color(Fp, dpy, cmap, DATA_COLOR, ss->data_color, S_data_color);
+ save_a_color(Fp, dpy, cmap, SELECTED_DATA_COLOR, ss->selected_data_color, S_selected_data_color);
+ save_a_color(Fp, dpy, cmap, HIGHLIGHT_COLOR, ss->highlight_color, S_highlight_color);
+ save_a_color(Fp, dpy, cmap, POSITION_COLOR, ss->position_color, S_position_color);
+ save_a_color(Fp, dpy, cmap, ZOOM_COLOR, ss->zoom_color, S_zoom_color);
+ save_a_color(Fp, dpy, cmap, SELECTION_COLOR, ss->selection_color, S_selection_color);
+ save_a_color(Fp, dpy, cmap, MIX_COLOR, ss->mix_color, S_mix_color);
+ save_a_color(Fp, dpy, cmap, ENVED_WAVEFORM_COLOR, ss->enved_waveform_color, S_enved_waveform_color);
+ save_a_color(Fp, dpy, cmap, LISTENER_COLOR, ss->listener_color, S_listener_color);
+ save_a_color(Fp, dpy, cmap, LISTENER_TEXT_COLOR, ss->listener_text_color, S_listener_text_color);
+ save_a_color(Fp, dpy, cmap, GRAPH_COLOR, ss->graph_color, S_graph_color);
+ save_a_color(Fp, dpy, cmap, SELECTED_GRAPH_COLOR, ss->selected_graph_color, S_selected_graph_color);
+ save_a_color(Fp, dpy, cmap, MARK_COLOR, ss->mark_color, S_mark_color);
+ save_a_color(Fp, dpy, cmap, SASH_COLOR, ss->sash_color, S_sash_color);
+ save_a_color(Fp, dpy, cmap, TEXT_FOCUS_COLOR, ss->text_focus_color, S_text_focus_color);
+ save_a_color(Fp, dpy, cmap, FILTER_CONTROL_WAVEFORM_COLOR, ss->filter_control_waveform_color, S_filter_control_waveform_color);
+}
+
+
+static char *fallbacks[] = {
+ (char *)"*fontList: " DEFAULT_FONTLIST,
+ (char *)"*enableEtchedInMenu: True",
+ (char *)"*enableThinThickness: True",
+ (char *)"*enableToggleColor: True",
+ (char *)"*enableToggleVisual: True",
+ NULL
+};
+
+
+void snd_doit(int argc, char **argv)
+{
+ XtAppContext app;
+ Widget shell;
+ Display *dpy;
+ Drawable wn;
+ Arg args[32];
+ int i, n;
+ Widget menu;
+ XGCValues gv;
+ char *app_title = NULL;
+
+ int err = 0;
+ XtSetLanguageProc(NULL, NULL, NULL);
+
+ ss->channel_min_height = CHANNEL_MIN_HEIGHT;
+ ss->Graph_Cursor = DEFAULT_GRAPH_CURSOR;
+
+#ifndef __alpha__
+ XtSetArg(args[0], XtNwidth, INITIAL_WINDOW_WIDTH);
+ XtSetArg(args[1], XtNheight, INITIAL_WINDOW_HEIGHT);
+ shell = XtAppInitialize(&app, "Snd", NULL, 0, &argc, argv, fallbacks, args, 2);
+#else
+ shell = XtVaOpenApplication(&app, "Snd", NULL, 0, &argc, argv, fallbacks, applicationShellWidgetClass,
+ XmNallowShellResize, AUTO_RESIZE_DEFAULT,
+ NULL);
+#endif
+
+#ifndef _MSC_VER
+ setlocale(LC_NUMERIC, "C");
+#endif
+
+ /* if user has *keyboardFocusPolicy: Pointer in .Xdefaults, it can screw up Snd's attempt to
+ * keep the channel graphics window as the active widget in case of keyboard input. So,
+ * we try to force Snd's focus policy to be XmEXPLICIT
+ */
+ XtVaGetValues(shell, XmNkeyboardFocusPolicy, &err, NULL);
+ if (err != XmEXPLICIT)
+ XtVaSetValues(shell, XmNkeyboardFocusPolicy, XmEXPLICIT, NULL);
+
+ auto_open_files = argc - 1;
+ if (argc > 1) auto_open_file_names = (char **)(argv + 1);
+
+ dpy = XtDisplay(shell);
+
+ XtVaGetValues(shell, XmNtitle, &app_title, NULL); /* perhaps caller included -title arg */
+ if (app_title)
+ ss->startup_title = mus_strdup(app_title);
+ else ss->startup_title = mus_strdup("snd");
+
+ for (i = 1; i < argc; i++)
+ if ((mus_strcmp(argv[i], "-h")) ||
+ (mus_strcmp(argv[i], "-horizontal")) ||
+ (mus_strcmp(argv[i], "--horizontal")))
+ set_sound_style(SOUNDS_HORIZONTAL);
+ else
+ if ((mus_strcmp(argv[i], "-v")) ||
+ (mus_strcmp(argv[i], "-vertical")) ||
+ (mus_strcmp(argv[i], "--vertical")))
+ set_sound_style(SOUNDS_VERTICAL);
+ else
+ if ((mus_strcmp(argv[i], "-notebook")) ||
+ (mus_strcmp(argv[i], "--notebook")))
+ {
+ set_sound_style(SOUNDS_IN_NOTEBOOK);
+ set_auto_resize(false);
+ }
+ else
+ if ((mus_strcmp(argv[i], "-separate")) ||
+ (mus_strcmp(argv[i], "--separate")))
+ set_sound_style(SOUNDS_IN_SEPARATE_WINDOWS);
+ else
+ if (mus_strcmp(argv[i], "-noglob"))
+ noglob = true;
+ else
+ if (mus_strcmp(argv[i], "-noinit"))
+ noinit = true;
+ else
+ if (mus_strcmp(argv[i], "-nostdin"))
+ nostdin = true;
+ else
+ if ((mus_strcmp(argv[i], "-b")) ||
+ (mus_strcmp(argv[i], "-batch")) ||
+ (mus_strcmp(argv[i], "--batch")))
+ batch = true;
+ else
+ if (mus_strcmp(argv[i], "--features")) /* testing (compsnd) */
+ check_features_list(argv[i + 1]);
+
+ ss->batch_mode = batch;
+ if (batch) XtSetMappedWhenManaged(shell, 0);
+
+ ss->zoom_slider_width = ZOOM_SLIDER_WIDTH;
+ ss->position_slider_width = POSITION_SLIDER_WIDTH;
+ ss->channel_sash_indent = CHANNEL_SASH_INDENT;
+ ss->channel_sash_size = CHANNEL_SASH_SIZE;
+ ss->sash_size = SASH_SIZE;
+ ss->sash_indent = SASH_INDENT;
+ ss->toggle_size = TOGGLE_SIZE;
+ ss->click_time = (oclock_t)XtGetMultiClickTime(dpy);
+
+#if HAVE_GL
+ {
+ /* this taken from glxmotif.c from xjournal/sgi */
+ XVisualInfo *vi = NULL;
+ Colormap cmap;
+ GLXContext cx;
+ int dblBuf[] = {GLX_RGBA, GLX_DEPTH_SIZE, 16, GLX_DOUBLEBUFFER, None};
+ vi = glXChooseVisual(dpy, DefaultScreen(dpy), dblBuf);
+ if (vi)
+ ss->gl_has_double_buffer = true;
+ else
+ {
+ int snglBuf[] = {GLX_RGBA, GLX_DEPTH_SIZE, 16, None};
+ ss->gl_has_double_buffer = false;
+ vi = glXChooseVisual(dpy, DefaultScreen(dpy), snglBuf);
+ }
+ if (vi == NULL)
+ fprintf(stderr, "%s", "no RGB visual with desired depth\n"); /* not snd_error -- shell not ready yet */
+ else
+ {
+ /* create an OpenGL rendering context */
+ cx = glXCreateContext(dpy, vi, /* no display list sharing */ None, /* favor direct */ GL_TRUE);
+ if (cx == NULL)
+ fprintf(stderr, "%s", "could not create rendering context\n");
+ else
+ {
+ /* create an X colormap since probably not using default visual */
+ cmap = XCreateColormap(dpy, RootWindow(dpy, vi->screen), vi->visual, AllocNone);
+ XtVaSetValues(shell, XtNvisual, vi->visual, XtNdepth, vi->depth, XtNcolormap, cmap, NULL);
+ ss->cx = cx;
+ }
+ XFree(vi);
+ }
+ }
+#endif
+
+ XtAppSetWarningMsgHandler(app, muffle_warning);
+
+ ss->mainapp = app;
+ ss->mainshell = shell;
+ ss->mdpy = dpy;
+ ss->toolbar = NULL;
+
+ ss->white = get_color(shell, WHITE_COLOR, NULL, NULL, true);
+ ss->black = get_color(shell, BLACK_COLOR, NULL, NULL, false);
+ ss->light_blue = get_color(shell, LIGHT_BLUE_COLOR, "blue", NULL, true);
+ ss->lighter_blue = get_color(shell, LIGHTER_BLUE_COLOR, "blue", NULL, true);
+ ss->red = get_color(shell, RED_COLOR, NULL, NULL, false);
+ ss->green = get_color(shell, GREEN_COLOR, NULL, NULL, false);
+ ss->blue = get_color(shell, "blue", NULL, NULL, false);
+ ss->yellow = get_color(shell, YELLOW_COLOR, NULL, NULL, true);
+ ss->highlight_color = get_color(shell, HIGHLIGHT_COLOR, "gray90", NULL, true);
+ ss->basic_color = get_color(shell, BASIC_COLOR, "gray80", "gray", true);
+ ss->position_color = get_color(shell, POSITION_COLOR, "gray60", "blue", false);
+ ss->zoom_color = get_color(shell, ZOOM_COLOR, "gray20", "gray", false);
+ ss->cursor_color = get_color(shell, CURSOR_COLOR, NULL, NULL, false);
+ ss->selection_color = get_color(shell, SELECTION_COLOR, "gray80", NULL, false);
+ ss->mix_color = get_color(shell, MIX_COLOR, "red", NULL, false);
+ ss->enved_waveform_color = get_color(shell, ENVED_WAVEFORM_COLOR, "red", NULL, false);
+ ss->filter_control_waveform_color = get_color(shell, FILTER_CONTROL_WAVEFORM_COLOR, "blue", NULL, false);
+ ss->listener_color = get_color(shell, LISTENER_COLOR, NULL, NULL, true);
+ ss->listener_text_color = get_color(shell, LISTENER_TEXT_COLOR, NULL, NULL, false);
+ ss->graph_color = get_color(shell, GRAPH_COLOR, NULL, NULL, true);
+ ss->selected_graph_color = get_color(shell, SELECTED_GRAPH_COLOR, NULL, NULL, true);
+ ss->data_color = get_color(shell, DATA_COLOR, NULL, NULL, false);
+ ss->selected_data_color = get_color(shell, SELECTED_DATA_COLOR, NULL, NULL, false);
+ ss->mark_color = get_color(shell, MARK_COLOR, "red", NULL, false);
+ ss->sash_color = get_color(shell, SASH_COLOR, NULL, NULL, false);
+ ss->text_focus_color = get_color(shell, TEXT_FOCUS_COLOR, NULL, NULL, true);
+ ss->grid_color = get_in_between_color(ss->data_color, ss->graph_color);
+ ss->selected_grid_color = get_in_between_color(ss->selected_data_color, ss->selected_graph_color);
+
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, ss->highlight_color_symbol, Xen_wrap_pixel(ss->highlight_color));
+ s7_symbol_set_value(s7, ss->basic_color_symbol, Xen_wrap_pixel(ss->basic_color));
+ s7_symbol_set_value(s7, ss->position_color_symbol, Xen_wrap_pixel(ss->position_color));
+ s7_symbol_set_value(s7, ss->zoom_color_symbol, Xen_wrap_pixel(ss->zoom_color));
+ s7_symbol_set_value(s7, ss->cursor_color_symbol, Xen_wrap_pixel(ss->cursor_color));
+ s7_symbol_set_value(s7, ss->selection_color_symbol, Xen_wrap_pixel(ss->selection_color));
+ s7_symbol_set_value(s7, ss->mix_color_symbol, Xen_wrap_pixel(ss->mix_color));
+ s7_symbol_set_value(s7, ss->enved_waveform_color_symbol, Xen_wrap_pixel(ss->enved_waveform_color));
+ s7_symbol_set_value(s7, ss->filter_control_waveform_color_symbol, Xen_wrap_pixel(ss->filter_control_waveform_color));
+ s7_symbol_set_value(s7, ss->listener_color_symbol, Xen_wrap_pixel(ss->listener_color));
+ s7_symbol_set_value(s7, ss->listener_text_color_symbol, Xen_wrap_pixel(ss->listener_text_color));
+ s7_symbol_set_value(s7, ss->graph_color_symbol, Xen_wrap_pixel(ss->graph_color));
+ s7_symbol_set_value(s7, ss->selected_graph_color_symbol, Xen_wrap_pixel(ss->selected_graph_color));
+ s7_symbol_set_value(s7, ss->data_color_symbol, Xen_wrap_pixel(ss->data_color));
+ s7_symbol_set_value(s7, ss->selected_data_color_symbol, Xen_wrap_pixel(ss->selected_data_color));
+ s7_symbol_set_value(s7, ss->mark_color_symbol, Xen_wrap_pixel(ss->mark_color));
+ s7_symbol_set_value(s7, ss->sash_color_symbol, Xen_wrap_pixel(ss->sash_color));
+ s7_symbol_set_value(s7, ss->text_focus_color_symbol, Xen_wrap_pixel(ss->text_focus_color));
+#endif
+
+ ss->axis_color_set = false;
+
+ ss->orig_data_color = ss->data_color;
+ ss->orig_selected_data_color = ss->selected_data_color;
+ ss->orig_mark_color = ss->mark_color;
+ ss->orig_mix_color = ss->mix_color;
+ ss->orig_graph_color = ss->graph_color;
+ ss->orig_selected_graph_color = ss->selected_graph_color;
+ ss->orig_listener_color = ss->listener_color;
+ ss->orig_listener_text_color = ss->listener_text_color;
+ ss->orig_cursor_color = ss->cursor_color;
+ ss->orig_basic_color = ss->basic_color;
+ ss->orig_selection_color = ss->selection_color;
+ ss->orig_zoom_color = ss->zoom_color;
+ ss->orig_position_color = ss->position_color;
+ ss->orig_highlight_color = ss->highlight_color;
+
+ if ((!(set_peaks_font(DEFAULT_PEAKS_FONT))) &&
+ (!(set_peaks_font(FALLBACK_FONT))))
+ fprintf(stderr, "can't find peaks font %s", DEFAULT_PEAKS_FONT);
+
+ if ((!(set_tiny_font(DEFAULT_TINY_FONT))) &&
+ (!(set_tiny_font(FALLBACK_FONT))))
+ fprintf(stderr, "can't find tiny font %s", DEFAULT_TINY_FONT);
+
+ if ((!(set_bold_peaks_font(DEFAULT_BOLD_PEAKS_FONT))) &&
+ (!(set_bold_peaks_font(FALLBACK_FONT))))
+ fprintf(stderr, "can't find bold peaks font %s", DEFAULT_BOLD_PEAKS_FONT);
+
+ if ((!(set_axis_label_font(DEFAULT_AXIS_LABEL_FONT))) &&
+ (!(set_axis_label_font(FALLBACK_FONT))))
+ fprintf(stderr, "can't find axis label font %s", DEFAULT_AXIS_LABEL_FONT);
+
+ if ((!(set_axis_numbers_font(DEFAULT_AXIS_NUMBERS_FONT))) &&
+ (!(set_axis_numbers_font(FALLBACK_FONT))))
+ fprintf(stderr, "can't find axis numbers font %s", DEFAULT_AXIS_NUMBERS_FONT);
+
+ set_listener_font(DEFAULT_LISTENER_FONT); /* we need some sort of font here! */
+
+ ss->orig_axis_label_font = mus_strdup(axis_label_font(ss));
+ ss->orig_axis_numbers_font = mus_strdup(axis_numbers_font(ss));
+ ss->orig_peaks_font = mus_strdup(peaks_font(ss));
+ ss->orig_bold_peaks_font = mus_strdup(bold_peaks_font(ss));
+ ss->orig_listener_font = mus_strdup(listener_font(ss));
+ ss->orig_tiny_font = mus_strdup(tiny_font(ss));
+
+ XtVaSetValues(shell, XmNbackground, ss->basic_color, NULL);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ n = attach_all_sides(args, n);
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ ss->mainpane = XtCreateManagedWidget("mainpane", xmFormWidgetClass, shell, args, n);
+
+ menu = add_menu();
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
+ XtSetArg(args[n], XmNtopWidget, menu); n++;
+ XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
+ XtSetArg(args[n], XmNallowResize, true); n++;
+ XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
+ switch (sound_style(ss))
+ {
+ case SOUNDS_IN_SEPARATE_WINDOWS:
+ ss->soundpane = XtCreateManagedWidget("soundpane", xmFormWidgetClass, ss->mainpane, args, n);
+ break;
+
+ case SOUNDS_HORIZONTAL:
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ ss->soundpanebox = XtCreateManagedWidget("soundpane", xmPanedWindowWidgetClass, ss->mainpane, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNsashHeight, ss->sash_size); n++;
+ XtSetArg(args[n], XmNsashWidth, ss->sash_size); n++;
+ XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
+ XtSetArg(args[n], XmNsashIndent, ss->sash_indent); n++;
+ ss->soundpane = XtCreateManagedWidget("soundpane", xmPanedWindowWidgetClass, ss->soundpanebox, args, n);
+ break;
+
+ case SOUNDS_VERTICAL:
+ XtSetArg(args[n], XmNsashHeight, ss->sash_size); n++;
+ XtSetArg(args[n], XmNsashWidth, ss->sash_size); n++;
+ XtSetArg(args[n], XmNsashIndent, ss->sash_indent); n++;
+ ss->soundpane = XtCreateManagedWidget("soundpane", xmPanedWindowWidgetClass, ss->mainpane, args, n);
+ break;
+
+ case SOUNDS_IN_NOTEBOOK:
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ ss->soundpanebox = XtCreateManagedWidget("soundpane", xmPanedWindowWidgetClass, ss->mainpane, args, n);
+
+ n = 0;
+ XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
+ XtSetArg(args[n], XmNframeBackground, ss->zoom_color); n++;
+ XtSetArg(args[n], XmNbindingType, XmNONE); n++;
+ XtSetArg(args[n], XmNbackPagePlacement, XmTOP_RIGHT); n++;
+ XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
+ ss->soundpane = XtCreateWidget("nb", xmNotebookWidgetClass, ss->soundpanebox, args, n);
+
+ {
+ /* get rid of the useless spinbox */
+ n = 0;
+ XtSetArg(args[n], XmNnotebookChildType, XmPAGE_SCROLLER); n++;
+ XtCreateWidget("scroller", xmScrollBarWidgetClass, ss->soundpane, NULL, 0);
+ }
+ XtManageChild(ss->soundpane);
+ XtAddCallback(ss->soundpane, XmNpageChangedCallback, notebook_page_changed_callback, NULL);
+ map_over_children(ss->soundpane, set_main_color_of_widget); /* appears to be a no-op */
+ break;
+ }
+
+ SetupIcon(shell);
+ XtRealizeWidget(shell);
+ if (auto_resize(ss) != AUTO_RESIZE_DEFAULT)
+ XtVaSetValues(shell, XmNallowShellResize, auto_resize(ss), NULL);
+
+ wn = XtWindow(shell);
+ gv.background = ss->graph_color;
+ gv.foreground = ss->data_color;
+ ss->basic_gc = XCreateGC(dpy, wn, GCForeground | GCBackground, &gv);
+
+ gv.background = ss->graph_color;
+ gv.foreground = ss->data_color;
+ ss->combined_basic_gc = XCreateGC(dpy, wn, GCForeground | GCBackground, &gv);
+
+ gv.background = ss->graph_color;
+ gv.foreground = ss->mix_color;
+ ss->mix_gc = XCreateGC(dpy, wn, GCForeground | GCBackground, &gv);
+
+ gv.function = GXxor;
+ gv.background = ss->graph_color;
+ gv.foreground = (Pixel)(XOR(ss->cursor_color, gv.background));
+ ss->cursor_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
+
+ gv.function = GXxor;
+ gv.background = ss->graph_color;
+ gv.foreground = (Pixel)(XOR(ss->selection_color, gv.background));
+ ss->selection_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
+
+ gv.function = GXxor;
+ gv.background = ss->graph_color;
+ gv.foreground = (Pixel)(XOR(ss->mark_color, gv.background));
+ ss->mark_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
+
+ gv.function = GXcopy;
+ gv.background = ss->data_color;
+ gv.foreground = ss->graph_color;
+ ss->erase_gc = XCreateGC(dpy, wn, GCForeground | GCBackground | GCFunction, &gv);
+
+ gv.background = ss->selected_graph_color;
+ gv.foreground = ss->selected_data_color;
+ ss->selected_basic_gc = XCreateGC(dpy, wn, GCForeground | GCBackground, &gv);
+
+ gv.function = GXxor;
+ gv.background = ss->selected_graph_color;
+ gv.foreground = (Pixel)(XOR(ss->cursor_color, gv.background));
+ ss->selected_cursor_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
+
+ gv.function = GXxor;
+ gv.background = ss->selected_graph_color;
+ gv.foreground = (Pixel)(XOR(ss->selection_color, gv.background));
+ ss->selected_selection_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
+
+ gv.function = GXxor;
+ gv.background = ss->selected_graph_color;
+ gv.foreground = (Pixel)(XOR(ss->mark_color, gv.background));
+ ss->selected_mark_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
+
+ gv.function = GXcopy;
+ gv.background = ss->selected_data_color;
+ gv.foreground = ss->selected_graph_color;
+ ss->selected_erase_gc = XCreateGC(dpy, wn, GCForeground | GCBackground | GCFunction, &gv);
+
+ gv.function = GXcopy;
+ gv.background = ss->basic_color;
+ gv.foreground = ss->black;
+ ss->fltenv_basic_gc = XCreateGC(dpy, wn, GCBackground | GCForeground | GCFunction, &gv);
+
+ gv.function = GXcopy;
+ gv.background = ss->basic_color;
+ gv.foreground = ss->filter_control_waveform_color;
+ ss->fltenv_data_gc = XCreateGC(dpy, wn, GCBackground | GCForeground | GCFunction, &gv);
+
+ initialize_colormap(); /* X11 not ours */
+ make_icons_transparent(BASIC_COLOR);
+
+ if (with_toolbar(ss)) show_toolbar();
+
+#ifndef _MSC_VER
+ if (setjmp(top_level_jump))
+ {
+ if (!(ss->jump_ok))
+ snd_error_without_format("Caught top level error (will try to continue):\n");
+ else ss->jump_ok = false;
+ }
+ else
+#endif
+ startup_funcs(); /* snd /tmp -> segfault if this happens before the setjmp(top_level_jump) */
+
+ if (ss->startup_errors)
+ {
+ post_it("Error in initialization", ss->startup_errors);
+ free(ss->startup_errors);
+ ss->startup_errors = NULL;
+ }
+
+ XtAppMainLoop(app);
+}
diff --git a/snd-motif.scm b/snd-motif.scm
index 49afb6f..81a00c0 100644
--- a/snd-motif.scm
+++ b/snd-motif.scm
@@ -10,11 +10,10 @@
;;; (add-mark-pane) adds a pane of mark locations to each channel that has marks
;;; (snd-clock-icon snd hour) show an animated clock icon
;;; (make-sound-box name parent select-func peak-func sounds args) makes a box of sound icons
-;;; (make-level-meter parent width height args), (display-level data), (with-level-meters n) -- VU meters
;;; (make-channel-drop-site snd chn) -- add a drop site
;;; (set-channel-drop drop snd chn) -- change given graph drop callback to drop
;;; (select-file func title dir filter help) starts a Snd-like File Selection Dialog running func if a file is selected
-;;; (show-disk-space snd) adds a label to the minibuffer area showing the current free space
+;;; (show-disk-space snd) adds a label to the status-area area showing the current free space
;;; (keep-file-dialog-open-upon-ok) changes File:Open so that clicking "ok" does not "unmanage" the dialog
;;; (add-amp-controls) adds amp sliders to the control panel for multi-channel sounds
;;; (remove-main-menu menu) removes a top-level menu
@@ -23,7 +22,6 @@
;;; (add-tooltip widget tip) adds tooltip tip to widget
;;; (menu-option name) to access menu items
;;; (show-all-atoms) shows all X atoms
-;;; show-font-name shows the Snd-related name and the X-related name of a font
;;; show-widget-font shows what fonts are associated with a widget
;;; add-find-to-listener enables C-s and C-r in the listener
;;; add a function to be called when the window manager sends us a "save yourself" message
@@ -34,1171 +32,1141 @@
;;; create-audit-dialog
;;; equalize-panes
-(if (not (provided? 'snd-motif)) (snd-error "snd-motif.scm is Motif-specific"))
-
-(define (find-if pred l)
- (cond ((null? l) #f)
- ((pred (car l)) (car l))
- (else (find-if pred (cdr l)))))
-
-(if (not (provided? 'xm))
- (let ((hxm (dlopen "xm.so")))
- (if (string? hxm)
- (snd-error (format #f "snd-motif.scm needs the xm module (either 'make xm' or build Snd with --with-static-xm): ~A" hxm))
- (dlinit hxm "Init_libxm"))))
-
(provide 'snd-snd-motif.scm)
+(require snd-motif snd-extensions.scm snd-play.scm snd-dsp.scm)
-(if (not (provided? 'snd-extensions.scm)) (load "extensions.scm"))
-(if (not (provided? 'snd-play.scm)) (load "play.scm"))
-
-(define (load-font name)
- "(load-font name) loads the font 'name', returning the font id"
- (let ((fs (XLoadQueryFont (XtDisplay (cadr (main-widgets))) name)))
- (and (XFontStruct? fs) (.fid fs))))
-
-(define (current-screen)
- "(current-screen) returns the current X screen number of the current display"
- (DefaultScreenOfDisplay
- (XtDisplay (cadr (main-widgets)))))
-
-(define (white-pixel)
- "(white-pixel) returns a white pixel"
- (WhitePixelOfScreen (current-screen)))
-
-(define (black-pixel)
- "(black-pixel) returns a black pixel"
- (BlackPixelOfScreen (current-screen)))
-
-(define (screen-depth)
- "(screen-depth) returns the current screen depth"
- (DefaultDepthOfScreen (current-screen)))
-
-(define (xm-clean-string str)
- "(xm-clean-string str) changes slash to underbar in the filename 'str' (for the peak env file)"
- ;; full file name should be unique, so I think we need only fix it up to look like a flat name
- (let* ((len (string-length str))
- (new-str (make-string len #\.)))
- (do ((i 0 (+ i 1)))
- ((= i len) new-str)
- (let ((c (string-ref str i)))
- (if (or (char=? c #\\)
- (char=? c #\/))
- (string-set! new-str i #\_)
- (string-set! new-str i c))))))
-
-
+(with-let *motif*
+
+ (define (find-if pred l)
+ (cond ((null? l) #f)
+ ((pred (car l)) (car l))
+ (else (find-if pred (cdr l)))))
+
+ (define load-font
+ (let ((documentation "(load-font name) loads the font 'name', returning the font id"))
+ (lambda (name)
+ (let ((fs (XLoadQueryFont (XtDisplay (cadr (main-widgets))) name)))
+ (and fs (XFontStruct? fs) (.fid fs))))))
+
+ (define current-screen
+ (let ((documentation "(current-screen) returns the current X screen number of the current display"))
+ (lambda ()
+ (DefaultScreenOfDisplay
+ (XtDisplay (cadr (main-widgets)))))))
+
+ (define white-pixel
+ (let ((documentation "(white-pixel) returns a white pixel"))
+ (lambda ()
+ (WhitePixelOfScreen (current-screen)))))
+
+ (define black-pixel
+ (let ((documentation "(black-pixel) returns a black pixel"))
+ (lambda ()
+ (BlackPixelOfScreen (current-screen)))))
+
+ (define screen-depth
+ (let ((documentation "(screen-depth) returns the current screen depth"))
+ (lambda ()
+ (DefaultDepthOfScreen (current-screen)))))
+
+ (define xm-clean-string
+ (let ((documentation "(xm-clean-string str) changes slash to underbar in the filename 'str' (for the peak env file)"))
+ (lambda (str)
+ ;; full file name should be unique, so I think we need only fix it up to look like a flat name
+ (let* ((len (length str))
+ (new-str (make-string len #\.)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) new-str)
+ (let ((c (str i)))
+ (if (memq c '(#\\ #\/))
+ (set! (new-str i) #\_)
+ (set! (new-str i) c))))))))
+
+
;;; -------- apply func to every widget belonging to w (and w) --------
-
-(define (for-each-child w func)
- "(for-each-child w func) applies func to w and its descendents"
- (func w)
- (if (XtIsComposite w)
- (for-each
- (lambda (n)
- (for-each-child n func))
- (cadr (XtGetValues w (list XmNchildren 0) 1)))))
-
-(define (find-child widget name)
- "(find-child widget name) returns a widget named 'name', if one can be found in the widget hierarchy beneath 'widget'"
- ;; unfortunately, if the widget's name has been set for some non-English locale, this
- ;; won't work -- we need to add gettext support (see snd.c for an example)
- (call-with-exit
- (lambda (return)
- (for-each-child
- widget
- (lambda (child)
- (if (string=? (XtName child) name)
- (return child))))
- (throw 'no-such-widget (list "find-child" name)))))
-
-(define (display-widget-tree widget)
- "(display-widget-tree widget) displays the hierarchy of widgets beneath 'widget'"
- (define (display-widget w spaces)
- (let ((name (XtName w)))
- (if (or (not (string? name))
- (= (string-length name) 0))
- (set! name "<unnamed>"))
- (display (format #f "~A~A~%" spaces name))
- (if (XtIsComposite w)
- (for-each
- (lambda (n)
- (display-widget n (string-append spaces " ")))
- (cadr (XtGetValues w (list XmNchildren 0) 1))))))
- (display-widget widget ""))
-
-(define (set-main-color-of-widget w)
- "(set-main-color-of-widget w) sets the background color of widget 'w'"
- (for-each-child
- w
- (lambda (n)
- (if (XtIsWidget n)
- (if (XmIsScrollBar n)
- (XmChangeColor n (position-color))
- (XmChangeColor n (basic-color)))))))
-
-(define (host-name)
- "(host-name) -> name of current machine"
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets))))
- (host (XGetWindowProperty dpy win (XInternAtom (XtDisplay (cadr (main-widgets))) "WM_CLIENT_MACHINE" #f) 0 32 #f XA_STRING)))
- (and host (list-ref host 5))))
-
-
+
+ (define for-each-child
+ (let ((documentation "(for-each-child w func) applies func to w and its descendents"))
+ (lambda (w func)
+ (func w)
+ (if (XtIsComposite w)
+ (for-each
+ (lambda (n)
+ (for-each-child n func))
+ (cadr (XtGetValues w (list XmNchildren 0) 1)))))))
+
+ (define find-child
+ (let ((documentation "(find-child widget name) returns a widget named 'name', if one can be found in the widget hierarchy beneath 'widget'"))
+ (lambda (widget name)
+ ;; unfortunately, if the widget's name has been set for some non-English locale, this
+ ;; won't work -- we need to add gettext support (see snd.c for an example)
+ (call-with-exit
+ (lambda (return)
+ (for-each-child
+ widget
+ (lambda (child)
+ (if (string=? (XtName child) name)
+ (return child))))
+ (throw 'no-such-widget (list "find-child" name)))))))
+
+ (define display-widget-tree
+ (let ((documentation "(display-widget-tree widget) displays the hierarchy of widgets beneath 'widget'"))
+ (lambda (widget)
+ (define (display-widget w spaces)
+ (let ((name (XtName w)))
+ (if (or (not (string? name))
+ (= (length name) 0))
+ (set! name "<unnamed>"))
+ (format #t "~A~A~%" spaces name)
+ (if (XtIsComposite w)
+ (for-each
+ (lambda (n)
+ (display-widget n (string-append spaces " ")))
+ (cadr (XtGetValues w (list XmNchildren 0) 1))))))
+ (display-widget widget ""))))
+
+ (define set-main-color-of-widget
+ (let ((documentation "(set-main-color-of-widget w) sets the background color of widget 'w'"))
+ (lambda (w)
+ (for-each-child
+ w
+ (lambda (n)
+ (if (XtIsWidget n)
+ (if (XmIsScrollBar n)
+ (XmChangeColor n *position-color*)
+ (XmChangeColor n *basic-color*))))))))
+
+ (define host-name
+ (let ((documentation "(host-name) -> name of current machine"))
+ (lambda ()
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets))))
+ (host (XGetWindowProperty dpy win (XInternAtom (XtDisplay (cadr (main-widgets))) "WM_CLIENT_MACHINE" #f) 0 32 #f XA_STRING)))
+ (and host (host 5))))))
+
+
;;; -------- install-searcher --------
;;;
;;; replaces the current file search procedure in the File Selection Box
-;;;
-;;; (install-searcher (lambda (file) (= (srate file) 44100)))
-;;; (install-searcher (lambda (file) (= (channels file) 4)))
-;;;
-;;; this is obsolete -- use the file-filter mechanism instead
-
-(define (install-searcher proc)
- "(install-searcher proc) replaces the current file search procedure in the File Selection
-Box: (install-searcher (lambda (file) (= (srate file) 44100)))"
- (define match-sound-files
- (lambda args
- "(match-sound-files func dir) applies func to each sound file in dir and returns a list of files for which func does not return #f"
- (let* ((func (car args))
- (matches '()))
- (for-each
- (lambda (file)
- (if (func file)
- (set! matches (cons file matches))))
- (sound-files-in-directory (if (null? (cdr args)) "." (cadr args))))
- matches)))
- (define (XmString->string str)
- (XmStringUnparse str #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
- (define (XmStringTable->list st len)
- (XmStringTableUnparse st len #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
- (define (list->XmStringTable strs)
- (XmStringTableParseStringArray strs (length strs) #f XmCHARSET_TEXT #f 0 #f))
- (XtSetValues (open-file-dialog #f)
- (list XmNfileSearchProc
- (lambda (widget info)
- (let* ((dir (XmString->string (.dir info)))
- (files (match-sound-files proc dir))
- (fileTable (list->XmStringTable
- (map (lambda (n)
- (string-append dir n))
- files))))
- (XtSetValues widget
- (list XmNfileListItems fileTable
- XmNfileListItemCount (length files)
- XmNlistUpdated #t))
- (for-each (lambda (n) (XmStringFree n)) fileTable))))))
-
-
-;;; here's a fancier version that gets rid of the useless directory list,
-;;; and shows multi-channel files in color
-
-(define (install-searcher-with-colors proc)
-
- (define match-sound-files
- (lambda args
- (let* ((func (car args))
- (matches '()))
- (for-each
- (lambda (file)
- (if (func file)
- (set! matches (cons file matches))))
- (sound-files-in-directory (if (null? (cdr args)) "." (cadr args))))
- matches)))
-
- (define (XmString->string str)
- (XmStringUnparse str #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
-
- (let* ((dialog (open-file-dialog #f))
- ;; (XtGetValues dialog (XmNfileSearchProc 0)) to get the default
- (shell (cadr (main-widgets)))
- (tags (list "one" "two" "three" "four"))
- (colors (list "black" "red" "blue" "orange"))
- (pixels (let* ((dpy (XtDisplay shell))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr)))
- (map
- (lambda (color)
- (let ((col (XColor)))
- (if (= (XAllocNamedColor dpy cmap color col col) 0)
- (snd-error (format #f "can't allocate ~A" color))
- (.pixel col))))
- colors)))
- (rendertable (XmRenderTableAddRenditions
- #f
- (map (lambda (tag pix)
- (XmRenditionCreate
- (cadr (main-widgets))
- tag
- (list XmNrenditionForeground pix
- XmNfontName "9x15"
- XmNfontType XmFONT_IS_FONT)))
- tags pixels)
- (length tags)
- XmMERGE_NEW)))
-
- (XtSetValues dialog
- (list XmNfileSearchProc
- (lambda (widget info)
- (let* ((dir (XmString->string (.dir info))) ; may need filter text here?
- (files (sort! (map
- (lambda (n)
- (string-append dir n))
- (match-sound-files proc dir))
- string<?)) ; alphabetical order
- (fileTable (map
- (lambda (n)
- (XmStringGenerate
- n #f XmCHARSET_TEXT
- (if (= (channels n) 1)
- "one"
- (if (= (channels n) 2)
- "two"
- (if (= (channels n) 4)
- "four"
- "three")))))
- files)))
- (XtSetValues widget
- (list XmNfileListItems fileTable
- XmNfileListItemCount (length files)
- XmNlistUpdated #t))
- (for-each (lambda (n) (XmStringFree n)) fileTable)))))
- (XtUnmanageChild (XmFileSelectionBoxGetChild dialog XmDIALOG_DIR_LIST))
- (XtUnmanageChild (XmFileSelectionBoxGetChild dialog XmDIALOG_DIR_LIST_LABEL))
- (XtSetValues (XmFileSelectionBoxGetChild dialog XmDIALOG_LIST)
- (list XmNrenderTable rendertable))
- (XmFileSelectionDoSearch dialog #f)))
+
+ (define (install-searcher-with-colors proc)
-;(install-searcher-with-colors (lambda (file) #t))
-
-
+ (define match-sound-files
+ (lambda args
+ (let ((func (car args))
+ (matches ()))
+ (for-each
+ (lambda (file)
+ (if (func file)
+ (set! matches (cons file matches))))
+ (sound-files-in-directory (if (null? (cdr args)) "." (cadr args))))
+ matches)))
+
+ (define (XmString->string str)
+ (XmStringUnparse str #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
+
+ (let* ((dialog (open-file-dialog #f))
+ ;; (XtGetValues dialog (XmNfileSearchProc 0)) to get the default
+ (shell (cadr (main-widgets)))
+ (tags (list "one" "two" "three" "four"))
+ (colors (list "black" "red" "blue" "orange"))
+ (pixels (let* ((dpy (XtDisplay shell))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr)))
+ (map
+ (lambda (color)
+ (let ((col (XColor)))
+ (if (= (XAllocNamedColor dpy cmap color col col) 0)
+ (snd-error (format #f "can't allocate ~A" color))
+ (.pixel col))))
+ colors)))
+ (rendertable (XmRenderTableAddRenditions
+ #f
+ (map (lambda (tag pix)
+ (XmRenditionCreate
+ (cadr (main-widgets))
+ tag
+ (list XmNrenditionForeground pix
+ XmNfontName "9x15"
+ XmNfontType XmFONT_IS_FONT)))
+ tags pixels)
+ (length tags)
+ XmMERGE_NEW)))
+
+ (XtSetValues dialog
+ (list XmNfileSearchProc
+ (lambda (widget info)
+ (let* ((dir (XmString->string (.dir info))) ; may need filter text here?
+ (files (sort! (map
+ (lambda (n)
+ (string-append dir n))
+ (match-sound-files proc dir))
+ string<?)) ; alphabetical order
+ (fileTable (map
+ (lambda (n)
+ (XmStringGenerate
+ n #f XmCHARSET_TEXT
+ (if (= (channels n) 1)
+ "one"
+ (if (= (channels n) 2)
+ "two"
+ (if (= (channels n) 4)
+ "four"
+ "three")))))
+ files)))
+ (XtSetValues widget
+ (list XmNfileListItems fileTable
+ XmNfileListItemCount (length files)
+ XmNlistUpdated #t))
+ (for-each XmStringFree fileTable)))))
+ (XtUnmanageChild (XmFileSelectionBoxGetChild dialog XmDIALOG_DIR_LIST))
+ (XtUnmanageChild (XmFileSelectionBoxGetChild dialog XmDIALOG_DIR_LIST_LABEL))
+ (XtSetValues (XmFileSelectionBoxGetChild dialog XmDIALOG_LIST)
+ (list XmNrenderTable rendertable))
+ (XmFileSelectionDoSearch dialog #f)))
+
+ ;(install-searcher-with-colors (lambda (file) #t))
+
+
;;; -------- keep-file-dialog-open-upon-ok
;;;
;;; change File:Open (or File:Mix) so that clicking "ok" does not "unmanage" the dialog
-
-(define (keep-file-dialog-open-upon-ok)
- "(keep-file-dialog-open-upon-ok) changes the File:Open menu so that clicking 'ok' does not close the dialog"
- (let ((dialog (open-file-dialog #f)))
- (XtRemoveAllCallbacks dialog XmNokCallback) ; remove built-in version
- (XtAddCallback dialog XmNokCallback
- (lambda (widget context info)
- ;; same as built-in "ok" callback, but does not "unmanage" the dialog
- (let ((filename (XmStringUnparse (.value info) #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
- (format #t "filename: ~A~%" filename)
-
- (if (file-exists? filename)
- (if (not (directory? filename))
- (let ((snd (open-sound filename)))
- (select-channel 0))
- (snd-error (format #f "~S is a directory" filename)))
- (snd-error (format #f "no such file: ~A" filename))))))
- 'ok)) ; prettier in listener than printing out a callback procedure
-
-
-
+
+ (define keep-file-dialog-open-upon-ok
+ (let ((documentation "(keep-file-dialog-open-upon-ok) changes the File:Open menu so that clicking 'ok' does not close the dialog"))
+ (lambda ()
+ (let ((dialog (open-file-dialog #f)))
+ (XtRemoveAllCallbacks dialog XmNokCallback) ; remove built-in version
+ (XtAddCallback dialog XmNokCallback
+ (lambda (widget context info)
+ ;; same as built-in "ok" callback, but does not "unmanage" the dialog
+ (let ((filename (XmStringUnparse (.value info) #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
+ (format #t "filename: ~A~%" filename)
+
+ (if (file-exists? filename)
+ (if (not (directory? filename))
+ (begin
+ (open-sound filename)
+ (select-channel 0))
+ (snd-error (format #f "~S is a directory" filename)))
+ (snd-error (format #f "no such file: ~A" filename))))))
+ 'ok)))) ; prettier in listener than printing out a callback procedure
+
+
+
;;; -------- zync and unzync: start or stop y-zoom slider sync --------
;;;
;;; (i.e. when one y-zoom-slider changes position, all other channels in the sound change in parallel)
;;; (zync) to start and (unzync) to stop
-
-(define (remove-dragger snd)
- "(remove-dragger snd) undoes an earlier add-dragger which syncs together all the y-zoom sliders"
- (let ((calls (sound-property 'dragger snd)))
- (if calls
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (let ((zy (list-ref (channel-widgets snd chn) 6)))
- (XtRemoveCallback zy XmNdragCallback (car calls))
- (set! calls (cdr calls))))))
- (set! (sound-property 'dragger snd) #f)
- #f)
-
-(define (add-dragger snd)
- "(add-dragger snd) syncs together y-zoom sliders"
- (set! (sound-property 'save-state-ignore snd)
- (cons 'dragger
- (or (sound-property 'save-state-ignore snd)
- (list 'save-state-ignore))))
- (set! (sound-property 'dragger snd)
- (let ((calls '()))
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (let* ((zy (list-ref (channel-widgets snd chn) 6))
- (slider-size (cadr (XtGetValues zy (list XmNsliderSize 0)))) ; this is relative to max size
- (max-size (cadr (XtGetValues zy (list XmNmaximum 0))))
- (zy-div (max 10 (- max-size slider-size))))
- (set! calls
- (cons (XtAddCallback zy
- XmNdragCallback
- (lambda (w data info)
- (let ((v (/ (.value info) zy-div)))
- (do ((i 0 (+ i 1)))
- ((= i (channels snd)))
- (if (not (= i chn))
- (begin
- (set! (y-zoom-slider snd i) (* v v))
- (set! (y-position-slider snd i) (y-position-slider snd chn))))))))
- calls))))
- (reverse calls))))
-
-(define (zync)
- "(zync) ties each sound's y-zoom sliders together so that all change in parallel if one changes"
- (hook-push after-open-hook add-dragger)
- (for-each
- (lambda (n)
- (if (not (sound-property 'dragger n))
- (add-dragger n)))
- (sounds)))
-
-(define (unzync)
- "(unzync) undoes a previous (zync) -- subsequently each sound's y-zoom sliders are independent"
- (hook-remove after-open-hook add-dragger)
- (for-each
- (lambda (n)
- (if (sound-property 'dragger n)
- (remove-dragger n)))
- (sounds)))
-
-
-
+
+ (define remove-dragger
+ (let ((documentation "(remove-dragger snd) undoes an earlier add-dragger which syncs together all the y-zoom sliders"))
+ (lambda (snd)
+ (let ((calls (sound-property 'dragger snd)))
+ (if calls
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels snd)))
+ (let ((zy ((channel-widgets snd chn) 6)))
+ (XtRemoveCallback zy XmNdragCallback (car calls))
+ (set! calls (cdr calls))))))
+ (set! (sound-property 'dragger snd) #f))))
+
+ (define add-dragger
+ (let ((documentation "(add-dragger snd) syncs together y-zoom sliders"))
+ (lambda (hook)
+ (let ((snd (hook 'snd)))
+ (set! (sound-property 'save-state-ignore snd)
+ (cons 'dragger
+ (or (sound-property 'save-state-ignore snd)
+ (list 'save-state-ignore))))
+ (set! (sound-property 'dragger snd)
+ (let ((calls ()))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels snd)))
+ (let* ((zy ((channel-widgets snd chn) 6))
+ (slider-size (cadr (XtGetValues zy (list XmNsliderSize 0)))) ; this is relative to max size
+ (max-size (cadr (XtGetValues zy (list XmNmaximum 0))))
+ (zy-div (max 10 (- max-size slider-size))))
+ (set! calls
+ (cons (XtAddCallback zy
+ XmNdragCallback
+ (lambda (w data info)
+ (let ((v (/ (.value info) zy-div)))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels snd)))
+ (if (not (= i chn))
+ (begin
+ (set! (y-zoom-slider snd i) (* v v))
+ (set! (y-position-slider snd i) (y-position-slider snd chn))))))))
+ calls))))
+ (set! (hook 'result) (reverse calls))))))))
+
+ (define zync
+ (let ((documentation "(zync) ties each sound's y-zoom sliders together so that all change in parallel if one changes"))
+ (lambda ()
+ (hook-push after-open-hook add-dragger)
+ (for-each
+ (lambda (n)
+ (if (not (sound-property 'dragger n))
+ (add-dragger n)))
+ (sounds)))))
+
+ (define unzync
+ (let ((documentation "(unzync) undoes a previous (zync) -- subsequently each sound's y-zoom sliders are independent"))
+ (lambda ()
+ (hook-remove after-open-hook add-dragger)
+ (for-each
+ (lambda (n)
+ (if (sound-property 'dragger n)
+ (remove-dragger n)))
+ (sounds)))))
+
+
+
;;; -------- add our own pane to the channel section --------
-
-(define* (add-channel-pane snd chn name type (args '()))
- "(add-channel-pane snd chn name type (args '())) adds a pane to the channel section"
- (XtCreateManagedWidget name type (XtParent (XtParent (list-ref (channel-widgets snd chn) 7))) args))
-
-
+
+ (define add-channel-pane
+ (let ((documentation "(add-channel-pane snd chn name type (args ())) adds a pane to the channel section"))
+ (lambda* (snd chn name type (args ()))
+ (XtCreateManagedWidget name type (XtParent (XtParent ((channel-widgets snd chn) 7))) args))))
+
+
;;; -------- add our own pane to the sound section (underneath the controls in this case) --------
-
-(define* (add-sound-pane snd name type (args '()))
- "(add-sound-pane snd name type (args '())) adds a pane to the sound section (underneath the control panel)"
- (XtCreateManagedWidget name type (car (sound-widgets snd)) args))
-
-
+
+ (define add-sound-pane
+ (let ((documentation "(add-sound-pane snd name type (args ())) adds a pane to the sound section (underneath the control panel)"))
+ (lambda* (snd name type (args ()))
+ (XtCreateManagedWidget name type (car (sound-widgets snd)) args))))
+
+
;;; -------- add our own pane to the overall Snd window (underneath the listener in this case) --------
-
-(define* (add-main-pane name type (args '()))
- "(add-main-pane name type (args '())) adds a pane to Snd (underneath the listener)"
- (XtCreateManagedWidget name type (or (list-ref (main-widgets) 5) (list-ref (main-widgets) 3)) args))
-
-
+
+ (define add-main-pane
+ (let ((documentation "(add-main-pane name type (args ())) adds a pane to Snd (underneath the listener)"))
+ (lambda* (name type (args ()))
+ (XtCreateManagedWidget name type (or ((main-widgets) 5) ((main-widgets) 3)) args))))
+
+
;;; -------- add a widget at the top of the listener
-
-(define (add-listener-pane name type args)
- "(add-listener-pane name type args) adds a widget at the top of the listener"
- (let* ((listener (find-child (cadr (main-widgets)) "lisp-listener"))
- ;; this is the listener text widget, hopefully
- ;; its parent is the scrolled window, its parent is the form widget filling the listener pane
- (listener-scroll (XtParent listener))
- (listener-form (XtParent listener-scroll)))
- ;; to insert the new widget at the top of the listener pane we need to detach the
- ;; listener scrolled window etc -- assume here that the "args" list does not
- ;; include any ATTACH_* arguments
- (XtUnmanageChild listener-scroll)
- (let ((top-widget (XtCreateManagedWidget name type listener-form
- (append
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM)
- args))))
- (XtVaSetValues listener-scroll (list XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget top-widget))
- (XtManageChild listener-scroll)
- top-widget)))
-
-;(add-channel-pane "new-pane"
-; xmDrawingAreaWidgetClass
-; (list XmNbackground (graph-color)
-; XmNforeground (data-color)))
-
-(define (remove-menu-bar-menu which)
- "(remove-menu-bar-menu which) removes a top-level menu; 'which' can be 0: top-level-menu-bar, 1: file-menu, \
-2: edit-menu, 3: view-menu, 4: options-menu, 5: help-menu, 6: default popup menu"
- (XtUnmanageChild (list-ref (menu-widgets) which)))
-
-#|
-(define (add-second-row)
+
+ (define add-listener-pane
+ (let ((documentation "(add-listener-pane name type args) adds a widget at the top of the listener"))
+ (lambda (name type args)
+ (let* ((listener (find-child (cadr (main-widgets)) "lisp-listener"))
+ ;; this is the listener text widget, hopefully
+ ;; its parent is the scrolled window, its parent is the form widget filling the listener pane
+ (listener-scroll (XtParent listener))
+ (listener-form (XtParent listener-scroll)))
+ ;; to insert the new widget at the top of the listener pane we need to detach the
+ ;; listener scrolled window etc -- assume here that the "args" list does not
+ ;; include any ATTACH_* arguments
+ (XtUnmanageChild listener-scroll)
+ (let ((top-widget (XtCreateManagedWidget name type listener-form
+ (append
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM)
+ args))))
+ (XtVaSetValues listener-scroll (list XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget top-widget))
+ (XtManageChild listener-scroll)
+ top-widget)))))
+
+ ;(add-channel-pane "new-pane"
+ ; xmDrawingAreaWidgetClass
+ ; (list XmNbackground *graph-color*
+ ; XmNforeground *data-color*))
+
+ (define remove-menu-bar-menu
+ (let ((documentation "(remove-menu-bar-menu which) removes a top-level menu; 'which' can be 0: top-level-menu-bar, 1: file-menu, \
+2: edit-menu, 3: view-menu, 4: options-menu, 5: help-menu, 6: default popup menu"))
+ (lambda (which)
+ (XtUnmanageChild ((menu-widgets) which)))))
+
+ #|
+ (define (add-second-row)
;; adds a row-column widget just under the menu bar
(let ((menu-bar (car (menu-widgets)))
- (main-pane (caddr (main-widgets)))
- (sound-pane (cadddr (main-widgets))))
- (XtUnmanageChild sound-pane)
- (let* ((second-row (XtCreateManagedWidget "second-row" xmRowColumnWidgetClass main-pane
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget menu-bar
- XmNbackground (highlight-color))))
- (sep (XtCreateManagedWidget "sep" xmSeparatorWidgetClass main-pane
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget second-row
- XmNbackground (highlight-color)
- XmNorientation XmHORIZONTAL
- XmNseparatorType XmSHADOW_ETCHED_OUT))))
- (XtVaSetValues sound-pane (list XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget sep
- XmNbackground (highlight-color)))
- (XtManageChild sound-pane)
- (XtCreateManagedWidget "a name" xmPushButtonWidgetClass second-row
- (list XmNbackground (highlight-color))))))
-|#
-
+ (main-pane (caddr (main-widgets)))
+ (sound-pane (cadddr (main-widgets))))
+ (XtUnmanageChild sound-pane)
+ (let* ((second-row (XtCreateManagedWidget "second-row" xmRowColumnWidgetClass main-pane
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget menu-bar
+ XmNbackground *highlight-color*)))
+ (sep (XtCreateManagedWidget "sep" xmSeparatorWidgetClass main-pane
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget second-row
+ XmNbackground *highlight-color*
+ XmNorientation XmHORIZONTAL
+ XmNseparatorType XmSHADOW_ETCHED_OUT))))
+ (XtVaSetValues sound-pane (list XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget sep
+ XmNbackground *highlight-color*))
+ (XtManageChild sound-pane)
+ (XtCreateManagedWidget "a name" xmPushButtonWidgetClass second-row
+ (list XmNbackground *highlight-color*)))))
+ |#
+
;;; -------- disable control panel --------
-
-(define (disable-control-panel snd)
- "(disable-control-panel snd) disables the control panel for the sound 'snd'"
- (let ((swc (caddr (sound-widgets snd))))
- (for-each-child
- swc
- (lambda (n)
- (if (and (not (string=? (XtName n) "snd-name-form"))
- (not (string=? (XtName (XtParent n)) "snd-name-form")))
- (XtUnmanageChild n))))
- (XtSetValues swc (list XmNpaneMaximum 1
- XmNpaneMinimum 1))
- (remove-from-menu 2 "Show controls")
- (XtManageChild swc)))
-
-
-
+
+ (define disable-control-panel
+ (let ((documentation "(disable-control-panel snd) disables the control panel for the sound 'snd'"))
+ (lambda (snd)
+ (let ((swc (caddr (sound-widgets snd))))
+ (for-each-child swc
+ (lambda (n)
+ (if (and n
+ (not (string=? (XtName n) "snd-name-form"))
+ (not (string=? (XtName (XtParent n)) "snd-name-form")))
+ (XtUnmanageChild n))))
+ (XtSetValues swc (list XmNpaneMaximum 1
+ XmNpaneMinimum 1))
+ (remove-from-menu 2 "Show controls")
+ (XtManageChild swc)))))
+
+
+
;;; -------- bring possibly-obscured dialog to top
-
-(define (raise-dialog w)
- "(raise-dialog w) tries to bring 'w' to the top of the widget heirarchy"
- (if (and (Widget? w)
- (XtIsManaged w))
- (let ((parent (XtParent w)))
- (if (and (Widget? parent)
- (XtIsSubclass parent xmDialogShellWidgetClass))
- (XtPopup parent XtGrabNone)))))
-
-
-
+
+ (define raise-dialog
+ (let ((documentation "(raise-dialog w) tries to bring 'w' to the top of the widget heirarchy"))
+ (lambda (w)
+ (if (and (Widget? w)
+ (XtIsManaged w))
+ (let ((parent (XtParent w)))
+ (if (and (Widget? parent)
+ (XtIsSubclass parent xmDialogShellWidgetClass))
+ (XtPopup parent XtGrabNone)))))))
+
+
+
+#|
;;; -------- create-fmv-dialog --------
-
-(define fmv-dialog #f)
-
-(define (create-fmv-dialog)
- "(create-fmv-dialog) makes a dialog that runs the fm-violin instrument with various controls"
- (if (not (Widget? fmv-dialog))
- (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "FM Violin" XmFONTLIST_DEFAULT_TAG))
- (running #f))
- (set! fmv-dialog
- (XmCreateTemplateDialog (cadr (main-widgets)) "fm-violin"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNwidth 400
- XmNtransient #f) ))
- (XtAddCallback fmv-dialog
- XmNcancelCallback (lambda (w context info)
- (if running (set! running #f))
- (XtUnmanageChild fmv-dialog)))
- (XtAddCallback fmv-dialog XmNhelpCallback (lambda (w context info) (snd-print "set 'play' and move the sliders!")))
- (XmStringFree xhelp)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
-
- (let* ((frequency 440.0)
- (amplitude 0.1)
- (fm-index 1.0)
- (periodic-vibrato-rate 5.0)
- (random-vibrato-rate 16.0)
- (periodic-vibrato-amplitude 0.0025)
- (random-vibrato-amplitude 0.005)
- (noise-amount 0.0)
- (noise-freq 1000.0)
- (fm1-rat 1.0)
- (fm2-rat 3.0)
- (fm3-rat 4.0)
- (frq-scl (hz->radians frequency))
- (maxdev (* frq-scl fm-index))
- (logfreq (log frequency))
- (index1 (min pi (* maxdev (/ 5.0 logfreq))))
- (index2 (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001))))))
- (index3 (min pi (* maxdev (/ 4.0 (sqrt frequency)))))
- (carrier (make-oscil frequency))
- (fmosc1 (make-oscil (* fm1-rat frequency)))
- (fmosc2 (make-oscil (* fm2-rat frequency)))
- (fmosc3 (make-oscil (* fm3-rat frequency)))
- (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
- (ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
- (fm-noi (make-rand noise-freq (* pi noise-amount))))
- (letrec ((v (lambda ()
- (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib)))
- (fuzz (rand fm-noi)))
- (* amplitude
- (oscil carrier
- (+ vib
- (* index1 (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
- (* index2 (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
- (* index3 (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))))))
- (set-frequency (lambda (frq)
- (set! frequency frq)
- (set! frq-scl (hz->radians frequency))
- (set! maxdev (* frq-scl fm-index))
- (set! logfreq (log frequency))
- (set! index1 (min pi (* maxdev (/ 5.0 logfreq))))
- (set! index2 (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001))))))
- (set! index3 (min pi (* maxdev (/ 4.0 (sqrt frequency)))))
- (set! (mus-frequency carrier) frequency)
- (set! (mus-frequency fmosc1) (* fm1-rat frequency))
- (set! (mus-frequency fmosc2) (* fm2-rat frequency))
- (set! (mus-frequency fmosc3) (* fm3-rat frequency))))
- (set-index (lambda (ind)
- (set! fm-index ind)
- (set! maxdev (* frq-scl fm-index))
- (set! index1 (min pi (* maxdev (/ 5.0 logfreq))))
- (set! index2 (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001))))))
- (set! index3 (min pi (* maxdev (/ 4.0 (sqrt frequency)))))))
- (set-noise (lambda (noi)
- (set! noise-amount noi)
- (set! (mus-scaler fm-noi) (* pi noise-amount)))))
- (let* ((mainform
- (XtCreateManagedWidget "formd" xmRowColumnWidgetClass fmv-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild fmv-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color)
- XmNorientation XmVERTICAL)))
- (button
- (XtCreateManagedWidget "play" xmToggleButtonWidgetClass mainform
- (list XmNbackground (basic-color))))
- (ampstr (XmStringCreate "amp" XmFONTLIST_DEFAULT_TAG))
- (amp-scale
- (XtCreateManagedWidget "amp" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue (floor (* amplitude 100))
- XmNmaximum 100
- XmNtitleString ampstr
- XmNdecimalPoints 2)))
- (freqstr (XmStringCreate "freq" XmFONTLIST_DEFAULT_TAG))
- (freq-scale
- (XtCreateManagedWidget "freq" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue (floor frequency)
- XmNmaximum 1000
- XmNtitleString freqstr
- XmNdecimalPoints 0)))
- (indexstr (XmStringCreate "index" XmFONTLIST_DEFAULT_TAG))
- (index-scale
- (XtCreateManagedWidget "index" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue (floor (* 10 fm-index))
- XmNmaximum 100
- XmNtitleString indexstr
- XmNdecimalPoints 1)))
- (noisestr (XmStringCreate "noise" XmFONTLIST_DEFAULT_TAG))
- (noise-scale
- (XtCreateManagedWidget "noise" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue (floor (* 100 noise-amount))
- XmNmaximum 100
- XmNtitleString noisestr
- XmNdecimalPoints 3))))
- (XmStringFree ampstr)
- (XmStringFree freqstr)
- (XmStringFree indexstr)
- (XmStringFree noisestr)
- (XtAddCallback amp-scale XmNvalueChangedCallback (lambda (w context info) (set! amplitude (* .01 (.value info)))))
- (XtAddCallback amp-scale XmNdragCallback (lambda (w context info) (set! amplitude (* .01 (.value info)))))
- (XtAddCallback freq-scale XmNvalueChangedCallback (lambda (w context info) (set-frequency (.value info))))
- (XtAddCallback freq-scale XmNdragCallback (lambda (w context info) (set-frequency (.value info))))
- (XtAddCallback index-scale XmNvalueChangedCallback (lambda (w context info) (set-index (* .1 (.value info)))))
- (XtAddCallback index-scale XmNdragCallback (lambda (w context info) (set-index (* .1 (.value info)))))
- (XtAddCallback noise-scale XmNvalueChangedCallback (lambda (w context info) (set-noise (* .001 (.value info)))))
- (XtAddCallback noise-scale XmNdragCallback (lambda (w context info) (set-noise (* .001 (.value info)))))
- (XtAddCallback button XmNvalueChangedCallback
- (lambda (w context info)
- (if running
- (set! running #f)
- (let* ((audio-info (open-play-output 1 44100 #f 128))
- (audio-fd (car audio-info))
- (outchans (cadr audio-info))
- (frames (caddr audio-info))
- (data (make-sound-data outchans frames)))
- (if (not (= audio-fd -1))
- (begin
- (set! running #t)
- (do ()
- ((not running)
- (begin
- (set! running #f)
- (mus-audio-close audio-fd)))
- (do ((k 0 (+ 1 k)))
- ((= k frames))
- (sound-data-set! data 0 k (v)))
- (mus-audio-write audio-fd data frames)))))))))))))
- (XtManageChild fmv-dialog))
-
-
-
+
+ (define fmv-dialog #f)
+
+ (define create-fmv-dialog
+ (let ((documentation "(create-fmv-dialog) makes a dialog that runs the fm-violin instrument with various controls"))
+ (lambda ()
+ (if (not (Widget? fmv-dialog))
+ (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "FM Violin" XmFONTLIST_DEFAULT_TAG))
+ (running #f))
+ (set! fmv-dialog
+ (XmCreateTemplateDialog (cadr (main-widgets)) "fm-violin"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground *basic-color*
+ XmNwidth 400
+ XmNtransient #f) ))
+ (XtAddCallback fmv-dialog
+ XmNcancelCallback (lambda (w context info)
+ (if running (set! running #f))
+ (XtUnmanageChild fmv-dialog)))
+ (XtAddCallback fmv-dialog XmNhelpCallback (lambda (w context info) (snd-print "set 'play' and move the sliders!")))
+ (XmStringFree xhelp)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+
+ (let* ((frequency 440.0)
+ (amplitude 0.1)
+ (fm-index 1.0)
+ (periodic-vibrato-rate 5.0)
+ (random-vibrato-rate 16.0)
+ (periodic-vibrato-amplitude 0.0025)
+ (random-vibrato-amplitude 0.005)
+ (noise-amount 0.0)
+ (noise-freq 1000.0)
+ (fm1-rat 1.0)
+ (fm2-rat 3.0)
+ (fm3-rat 4.0)
+ (frq-scl (hz->radians frequency))
+ (maxdev (* frq-scl fm-index))
+ (logfreq (log frequency))
+ (index1 (min pi (* maxdev (/ 5.0 logfreq))))
+ (index2 (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001))))))
+ (index3 (min pi (* maxdev (/ 4.0 (sqrt frequency)))))
+ (carrier (make-oscil frequency))
+ (fmosc1 (make-oscil (* fm1-rat frequency)))
+ (fmosc2 (make-oscil (* fm2-rat frequency)))
+ (fmosc3 (make-oscil (* fm3-rat frequency)))
+ (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
+ (ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
+ (fm-noi (make-rand noise-freq (* pi noise-amount))))
+ (letrec ((v (lambda ()
+ (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib)))
+ (fuzz (rand fm-noi)))
+ (* amplitude
+ (oscil carrier
+ (+ vib
+ (* index1 (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
+ (* index2 (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
+ (* index3 (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))))))
+ (set-frequency (lambda (frq)
+ (set! frequency frq)
+ (set! frq-scl (hz->radians frequency))
+ (set! maxdev (* frq-scl fm-index))
+ (set! logfreq (log frequency))
+ (set! index1 (min pi (* maxdev (/ 5.0 logfreq))))
+ (set! index2 (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001))))))
+ (set! index3 (min pi (* maxdev (/ 4.0 (sqrt frequency)))))
+ (set! (mus-frequency carrier) frequency)
+ (set! (mus-frequency fmosc1) (* fm1-rat frequency))
+ (set! (mus-frequency fmosc2) (* fm2-rat frequency))
+ (set! (mus-frequency fmosc3) (* fm3-rat frequency))))
+ (set-index (lambda (ind)
+ (set! fm-index ind)
+ (set! maxdev (* frq-scl fm-index))
+ (set! index1 (min pi (* maxdev (/ 5.0 logfreq))))
+ (set! index2 (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001))))))
+ (set! index3 (min pi (* maxdev (/ 4.0 (sqrt frequency)))))))
+ (set-noise (lambda (noi)
+ (set! noise-amount noi)
+ (set! (mus-scaler fm-noi) (* pi noise-amount)))))
+ (let* ((mainform
+ (XtCreateManagedWidget "formd" xmRowColumnWidgetClass fmv-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild fmv-dialog XmDIALOG_SEPARATOR)
+ XmNbackground *basic-color*
+ XmNorientation XmVERTICAL)))
+ (button
+ (XtCreateManagedWidget "play" xmToggleButtonWidgetClass mainform
+ (list XmNbackground *basic-color*)))
+ (ampstr (XmStringCreate "amp" XmFONTLIST_DEFAULT_TAG))
+ (amp-scale
+ (XtCreateManagedWidget "amp" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue (floor (* amplitude 100))
+ XmNmaximum 100
+ XmNtitleString ampstr
+ XmNdecimalPoints 2)))
+ (freqstr (XmStringCreate "freq" XmFONTLIST_DEFAULT_TAG))
+ (freq-scale
+ (XtCreateManagedWidget "freq" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue (floor frequency)
+ XmNmaximum 1000
+ XmNtitleString freqstr
+ XmNdecimalPoints 0)))
+ (indexstr (XmStringCreate "index" XmFONTLIST_DEFAULT_TAG))
+ (index-scale
+ (XtCreateManagedWidget "index" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue (floor (* 10 fm-index))
+ XmNmaximum 100
+ XmNtitleString indexstr
+ XmNdecimalPoints 1)))
+ (noisestr (XmStringCreate "noise" XmFONTLIST_DEFAULT_TAG))
+ (noise-scale
+ (XtCreateManagedWidget "noise" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue (floor (* 100 noise-amount))
+ XmNmaximum 100
+ XmNtitleString noisestr
+ XmNdecimalPoints 3))))
+ (XmStringFree ampstr)
+ (XmStringFree freqstr)
+ (XmStringFree indexstr)
+ (XmStringFree noisestr)
+ (XtAddCallback amp-scale XmNvalueChangedCallback (lambda (w context info) (set! amplitude (* .01 (.value info)))))
+ (XtAddCallback amp-scale XmNdragCallback (lambda (w context info) (set! amplitude (* .01 (.value info)))))
+ (XtAddCallback freq-scale XmNvalueChangedCallback (lambda (w context info) (set-frequency (.value info))))
+ (XtAddCallback freq-scale XmNdragCallback (lambda (w context info) (set-frequency (.value info))))
+ (XtAddCallback index-scale XmNvalueChangedCallback (lambda (w context info) (set-index (* .1 (.value info)))))
+ (XtAddCallback index-scale XmNdragCallback (lambda (w context info) (set-index (* .1 (.value info)))))
+ (XtAddCallback noise-scale XmNvalueChangedCallback (lambda (w context info) (set-noise (* .001 (.value info)))))
+ (XtAddCallback noise-scale XmNdragCallback (lambda (w context info) (set-noise (* .001 (.value info)))))
+ (XtAddCallback button XmNvalueChangedCallback
+ (lambda (w context info)
+ (if running
+ (set! running #f)
+ (let* ((audio-info (open-play-output 1 44100 #f 128))
+ (audio-fd (car audio-info))
+ (outchans (cadr audio-info))
+ (len (caddr audio-info))
+ (data (make-float-vector (list outchans len) 0.0)))
+ (if (not (= audio-fd -1))
+ (begin
+ (set! running #t)
+ (do ()
+ ((not running)
+ (begin
+ (set! running #f)
+ (mus-audio-close audio-fd)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (vector-set! data 0 k (v)))
+ (mus-audio-write audio-fd data len)))))))))))))
+ (XtManageChild fmv-dialog))))
+|#
+
+
;;; -------- make-pixmap --------
-
-(define arrow-strs (list
-"16 12 6 1"
-" c None s None"
-". c gray50"
-"X c black"
-"o c white"
-"O c yellow"
-"- c ivory2 s basiccolor"
-"--------X---------"
-"---------X--------"
-"----------X-------"
-"-----------X------"
-"------------X-----"
-"XXXXXXXXXXXXXX----"
-"------------X-----"
-"-----------X------"
-"----------X-------"
-"---------X--------"
-"--------X---------"
-"-------X----------"))
-
-(define (make-pixmap widget strs) ; strs is list of strings as in arrow-strs above
- "(make-pixmap w strs) creates a pixmap using the X/Xpm string-based pixmap description"
- (if (defined? 'XpmAttributes)
- (let* ((attr (XpmAttributes))
- (symb (XpmColorSymbol "basiccolor" #f (basic-color)))
- (dpy (XtDisplay widget))
- (win (XtWindow widget))
- (scr (DefaultScreen dpy))
- (depth (cadr (XtGetValues widget (list XmNdepth 0))))
- (colormap (cadr (XtGetValues widget (list XmNcolormap 0)))))
- (set! (.depth attr) depth)
- (set! (.colormap attr) colormap)
- (set! (.visual attr) (DefaultVisual dpy scr))
- (set! (.colorsymbols attr) (list symb))
- (set! (.numsymbols attr) 1)
- (set! (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual))
- (cadr (XpmCreatePixmapFromData dpy win strs attr)))
- #f))
-
-; (XtSetValues (list-ref (sound-widgets) 8) (list XmNlabelPixmap (make-pixmap (cadr (main-widgets)) arrow-strs))))
-
+
+ (define arrow-strs (list
+ "16 12 6 1"
+ " c None s None"
+ ". c gray50"
+ "X c black"
+ "o c white"
+ "O c yellow"
+ "- c ivory2 s basiccolor"
+ "--------X---------"
+ "---------X--------"
+ "----------X-------"
+ "-----------X------"
+ "------------X-----"
+ "XXXXXXXXXXXXXX----"
+ "------------X-----"
+ "-----------X------"
+ "----------X-------"
+ "---------X--------"
+ "--------X---------"
+ "-------X----------"))
+
+ (define make-pixmap
+ (let ((documentation "(make-pixmap w strs) creates a pixmap using the X/Xpm string-based pixmap description"))
+ (lambda (widget strs) ; strs is list of strings as in arrow-strs above
+ (and (defined? 'XpmAttributes)
+ (let* ((attr (XpmAttributes))
+ (symb (XpmColorSymbol "basiccolor" #f *basic-color*))
+ (dpy (XtDisplay widget))
+ (win (XtWindow widget))
+ (scr (DefaultScreen dpy))
+ (depth (cadr (XtGetValues widget (list XmNdepth 0))))
+ (colormap (cadr (XtGetValues widget (list XmNcolormap 0)))))
+ (set! (.depth attr) depth)
+ (set! (.colormap attr) colormap)
+ (set! (.visual attr) (DefaultVisual dpy scr))
+ (set! (.colorsymbols attr) (list symb))
+ (set! (.numsymbols attr) 1)
+ (set! (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual))
+ (cadr (XpmCreatePixmapFromData dpy win strs attr)))))))
+
+ ; (XtSetValues ((sound-widgets) 8) (list XmNlabelPixmap (make-pixmap (cadr (main-widgets)) arrow-strs))))
+
;;; if you have a nice background pixmap, you can map it over all of Snd with:
#|
-(load "new-backgrounds.scm")
-(define wd (make-pixmap (cadr (main-widgets)) wood))
-
-(define (paint-all widget)
- (for-each-child
- widget
- (lambda (w)
- (XtSetValues w (list XmNbackgroundPixmap wd))
- (if (XmIsLabel w)
- (let ((val (cadr (XtVaGetValues w (list XmNlabelType 0)))))
- (if (= val XmPIXMAP)
- (XtVaSetValues w (list XmNlabelPixmap wd))))))))
-
-(paint-all (cadr (main-widgets)))
-(for-each
- (lambda (w)
- (if w
- (paint-all w)))
- (dialog-widgets))
-
-(hook-push new-widget-hook paint-all)
+ (load "new-backgrounds.scm")
+ (define wd (make-pixmap (cadr (main-widgets)) wood))
+
+ (define (paint-all widget)
+ (for-each-child widget (lambda (w)
+ (XtSetValues w (list XmNbackgroundPixmap wd))
+ (if (XmIsLabel w)
+ (let ((val (cadr (XtVaGetValues w (list XmNlabelType 0)))))
+ (if (= val XmPIXMAP)
+ (XtVaSetValues w (list XmNlabelPixmap wd))))))))
+
+ (paint-all (cadr (main-widgets)))
+ (for-each
+ (lambda (w)
+ (if w
+ (paint-all w)))
+ (dialog-widgets))
+
+ (hook-push new-widget-hook (lambda (hook) (paint-all (hook 'widget))))
|#
-
-(define right-arrow (list
- #x00 #x04 #x10 #x08 #x00 #x10 #x04 #x20 #x00 #x40 #xa5 #xbf
- #x00 #x40 #x04 #x20 #x00 #x10 #x10 #x08 #x00 #x04 #x00 #x00))
-
-(define (bitmap->pixmap widget bits width height)
- "(bitmap->pixmap widget bits width height) takes an X-style bitmap and turns it into a pixmap"
- (XCreateBitmapFromData (XtDisplay widget) (XtWindow widget) bits width height))
-
-; (XtSetValues (list-ref (sound-widgets) 8) (list XmNlabelPixmap (bitmap->pixmap (list-ref (sound-widgets) 8) iconw right-arrow 16 12)))
-
-
-
+
+
+ (define right-arrow (list
+ #x00 #x04 #x10 #x08 #x00 #x10 #x04 #x20 #x00 #x40 #xa5 #xbf
+ #x00 #x40 #x04 #x20 #x00 #x10 #x10 #x08 #x00 #x04 #x00 #x00))
+
+ (define bitmap->pixmap
+ (let ((documentation "(bitmap->pixmap widget bits width height) takes an X-style bitmap and turns it into a pixmap"))
+ (lambda (widget bits width height)
+ (XCreateBitmapFromData (XtDisplay widget) (XtWindow widget) bits width height))))
+
+ ; (XtSetValues ((sound-widgets) 8) (list XmNlabelPixmap (bitmap->pixmap ((sound-widgets) 8) iconw right-arrow 16 12)))
+
+
+
+#|
;;; -------- display-scanned-synthesis --------
;;;
;;; open a new main pane below the listener, with two sections
;;; on the left various controls, on the right a graph
;;; push 'start' to start the scanned synthesis display
;;; if spring > mass, you'll get overflows
-
-(define (display-scanned-synthesis)
-
- (define (add-main-pane name type args)
- (XtCreateManagedWidget name type (list-ref (main-widgets) 3) args))
-
- (define compute-uniform-circular-string
- ;; copied from dsp.scm to simplify life
- (lambda (size x0 x1 x2 mass xspring damp)
- (define circle-vct-ref
- (lambda (v i)
- (if (< i 0)
- (v (+ size i))
- (if (>= i size)
- (v (- i size))
- (v i)))))
- (let* ((dm (/ damp mass))
- (km (/ xspring mass))
- (denom (+ 1.0 dm))
- (p1 (/ (+ 2.0 (- dm (* 2.0 km))) denom))
- (p2 (/ km denom))
- (p3 (/ -1.0 denom)))
- (do ((i 0 (+ i 1)))
- ((= i size))
- (set! (x0 i) (min (+ (* p1 (x1 i))
- (* p2 (+ (circle-vct-ref x1 (- i 1)) (circle-vct-ref x1 (+ i 1))))
- (* p3 (x2 i)))
- 1000.0)))
- (vct-fill! x2 0.0)
- (vct-add! x2 x1)
- (vct-fill! x1 0.0)
- (vct-add! x1 x0))))
-
- (if (< (window-height) 520) (set! (window-height) 520))
- (set! (mus-srate) 22050.0)
-
- (let* ((mass 1.0)
- (xspring 0.1)
- (damp 0.0)
- (bounds '())
- (pts0 #f)
- (pts1 #f)
- (playing #f)
- ;; (frequency 440.0)
- (amplitude 0.02)
- (ax0 0) (ax1 0) (ay0 0) (ay1 0)
- (gc (car (snd-gcs)))
- (egc (list-ref (snd-gcs) 7))
- (app (car (main-widgets)))
-
- ;; now set up a paned window in the main Snd window with controllers on the left and the graph on the right
- (scan-outer (add-main-pane "Scanned Synthesis" xmFormWidgetClass
- (list XmNbackground (basic-color)
- XmNpaneMinimum 520)))
- (scan-row (XtCreateManagedWidget "row" xmRowColumnWidgetClass scan-outer
- (list XmNbackground (basic-color)
- XmNorientation XmVERTICAL
- XmNleftAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_POSITION
- XmNrightPosition 32)))
-
- ;; the graph
- (scan-pane (XtCreateManagedWidget "draw" xmDrawingAreaWidgetClass scan-outer
- (list XmNbackground (graph-color)
- XmNforeground (data-color)
- XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget scan-row
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM)))
-
- ;; the controllers
- (scan-start (XtCreateManagedWidget "Start" xmPushButtonWidgetClass scan-row
- (list XmNbackground (basic-color)
- XmNarmColor (selection-color))))
- (scan-continue (XtCreateManagedWidget "Continue" xmPushButtonWidgetClass scan-row
- (list XmNbackground (basic-color)
- XmNarmColor (selection-color))))
- (scan-stop (XtCreateManagedWidget "Stop" xmPushButtonWidgetClass scan-row
- (list XmNbackground (basic-color)
- XmNarmColor (selection-color))))
- (size 128)
- (tbl (make-table-lookup :size size))
- (gx0 (mus-data tbl))
- (gx1 (make-vct size))
- (gx2 (make-vct size))
- (vect (make-vector (* 2 size)))
- (work-proc 0))
-
- (define (y->grfy y range)
- (min ay1
- (max ay0
- (round (+ ay0
- (* range (- 10.0 y)))))))
-
- (define (draw-graph)
- (if (and (> ax1 ax0)
- (> ay1 ay0))
- (let ((diff (* 0.05 (- ay1 ay0))) ; assuming -10 to 10
- (dpy (XtDisplay scan-pane))
- (wn (XtWindow scan-pane))
- (xincr (exact->inexact (/ (- ax1 ax0) size))))
- (if pts1
- (XDrawLinesDirect dpy wn egc pts1 size 0)
- (XFillRectangle dpy wn egc ; erase previous graph
- (+ ax0 2)
- ay0
- (- ax1 ax0 2)
- (- ay1 ay0)))
- (do ((i 0 (+ i 1))
- (j 0 (+ j 2))
- (xi ax0 (+ xi xincr)))
- ((= i size))
- (set! (vect j) (floor xi))
- (set! (vect (+ j 1)) (y->grfy (gx0 i) diff)))
- (if pts1 (freeXPoints pts1))
- (set! pts0 (vector->XPoints vect))
- (set! pts1 pts0)
- (XDrawLinesDirect dpy wn gc pts0 size 0))))
-
- (define (redraw-graph)
- (set! bounds (draw-axes scan-pane gc "scanned synthesis" 0.0 1.0 -10.0 10.0))
- (set! ax0 (+ (car bounds) 2))
- (set! ax1 (caddr bounds))
- (set! ay1 (cadr bounds))
- (set! ay0 (cadddr bounds))
- (draw-graph))
-
- (define (tick-synthesis n)
- ;; background process
- (compute-uniform-circular-string size gx0 gx1 gx2 mass xspring damp)
- (draw-graph)
- #f)
-
- (define (stop-synthesis)
- (if (XtWorkProcId? work-proc)
- (XtRemoveWorkProc work-proc))
- (set! work-proc 0)
- (set! playing #f))
+
+ (define (display-scanned-synthesis)
- (define (start-synthesis)
- (stop-synthesis)
- (vct-fill! gx0 0.0)
- (vct-fill! gx1 0.0)
- (vct-fill! gx2 0.0)
- (do ((i 0 (+ i 1)))
- ((= i 12))
- (let ((val (sin (/ (* 2 pi i) 12.0))))
- (set! (gx1 (+ i (- (/ size 4) 6))) val)))
- (set! work-proc (XtAppAddWorkProc app tick-synthesis)))
+ (define (add-main-pane name type args)
+ (XtCreateManagedWidget name type ((main-widgets) 3) args))
- (define (continue-synthesis)
- (stop-synthesis)
- (set! work-proc (XtAppAddWorkProc app tick-synthesis)))
+ (define compute-uniform-circular-string
+ ;; copied from dsp.scm to simplify life
+ (lambda (size x0 x1 x2 mass xspring damp)
+ (define circle-float-vector-ref
+ (lambda (v i)
+ (if (< i 0)
+ (v (+ size i))
+ (if (>= i size)
+ (v (- i size))
+ (v i)))))
+ (let* ((dm (/ damp mass))
+ (km (/ xspring mass))
+ (denom (+ 1.0 dm))
+ (p1 (/ (+ 2.0 (- dm (* 2.0 km))) denom))
+ (p2 (/ km denom))
+ (p3 (/ -1.0 denom)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (x0 i) (min (+ (* p1 (x1 i))
+ (* p2 (+ (circle-float-vector-ref x1 (- i 1)) (circle-float-vector-ref x1 (+ i 1))))
+ (* p3 (x2 i)))
+ 1000.0)))
+ (copy x1 x2)
+ (copy x0 x1))))
- ;; controller callbacks
- (for-each
- (lambda (data)
- (let* ((title (XmStringCreate (car data) XmFONTLIST_DEFAULT_TAG))
- (button (XtCreateManagedWidget (car data) xmScaleWidgetClass scan-row
- (list XmNbackground (basic-color)
- XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNminimum (list-ref data 1)
- XmNmaximum (list-ref data 2)
- XmNvalue (list-ref data 3)
- XmNdecimalPoints (list-ref data 4)
- XmNtitleString title))))
- (XtAddCallback button XmNdragCallback (lambda (w c i) ((list-ref data 5) (.value i))))
- (XtAddCallback button XmNvalueChangedCallback (lambda (w c i) ((list-ref data 5) (.value i))))
- (XmStringFree title)))
- (list (list "mass" 1 200 100 2 (lambda (val) (set! mass (/ val 100.0))))
- (list "spring" 1 100 10 2 (lambda (val) (set! xspring (/ val 100.0))))
- (list "damping" 0 100 0 4 (lambda (val) (set! damp (/ val 10000.0))))))
+ (if (< (window-height) 520) (set! (window-height) 520))
+ (set! *clm-srate* 22050.0)
- (let* ((scan-size (XtCreateManagedWidget "srow" xmFormWidgetClass scan-row
- (list XmNbackground (basic-color))))
- (scan-label (XtCreateManagedWidget "Size:" xmLabelWidgetClass scan-size
- (list XmNbackground (basic-color)
- XmNleftAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_NONE)))
- (scan-text (XtCreateManagedWidget "stext" xmTextFieldWidgetClass scan-size
- (list XmNbackground (basic-color)
- XmNvalue (number->string size)
+ (let* ((mass 1.0)
+ (xspring 0.1)
+ (damp 0.0)
+ (bounds ())
+ (pts0 #f)
+ (pts1 #f)
+ (playing #f)
+ ;; (frequency 440.0)
+ (amplitude 0.02)
+ (ax0 0) (ax1 0) (ay0 0) (ay1 0)
+ (gc (car (snd-gcs)))
+ (egc ((snd-gcs) 7))
+ (app (car (main-widgets)))
+
+ ;; now set up a paned window in the main Snd window with controllers on the left and the graph on the right
+ (scan-outer (add-main-pane "Scanned Synthesis" xmFormWidgetClass
+ (list XmNbackground *basic-color*
+ XmNpaneMinimum 520)))
+ (scan-row (XtCreateManagedWidget "row" xmRowColumnWidgetClass scan-outer
+ (list XmNbackground *basic-color*
+ XmNorientation XmVERTICAL
+ XmNleftAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_POSITION
+ XmNrightPosition 32)))
+
+ ;; the graph
+ (scan-pane (XtCreateManagedWidget "draw" xmDrawingAreaWidgetClass scan-outer
+ (list XmNbackground *graph-color*
+ XmNforeground *data-color*
XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget scan-label
+ XmNleftWidget scan-row
XmNtopAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_FORM)))
- (play-button (XtCreateManagedWidget "play" xmToggleButtonWidgetClass scan-row
- (list XmNbackground (basic-color)
- XmNselectColor (selection-color))))
- (freq-str (XmStringCreate "frequency" XmFONTLIST_DEFAULT_TAG))
- (freq-scale (XtCreateManagedWidget "frequency" xmScaleWidgetClass scan-row
- (list XmNbackground (basic-color)
- XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNminimum 20
- XmNmaximum 1000
- XmNvalue 440
- XmNdecimalPoints 0
- XmNtitleString freq-str)))
- (amp-str (XmStringCreate "amplitude" XmFONTLIST_DEFAULT_TAG))
- (amp-scale (XtCreateManagedWidget "amplitude" xmScaleWidgetClass scan-row
- (list XmNbackground (basic-color)
- XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNminimum 0
- XmNmaximum 100
- XmNvalue 10
- XmNdecimalPoints 3
- XmNtitleString amp-str))))
- (XmStringFree freq-str)
- (XmStringFree amp-str)
+
+ ;; the controllers
+ (scan-start (XtCreateManagedWidget "Start" xmPushButtonWidgetClass scan-row
+ (list XmNbackground *basic-color*
+ XmNarmColor *selection-color*)))
+ (scan-continue (XtCreateManagedWidget "Continue" xmPushButtonWidgetClass scan-row
+ (list XmNbackground *basic-color*
+ XmNarmColor *selection-color*)))
+ (scan-stop (XtCreateManagedWidget "Stop" xmPushButtonWidgetClass scan-row
+ (list XmNbackground *basic-color*
+ XmNarmColor *selection-color*)))
+ (size 128)
+ (tbl (make-table-lookup :size size))
+ (gx0 (mus-data tbl))
+ (gx1 (make-float-vector size))
+ (gx2 (make-float-vector size))
+ (vect (make-vector (* 2 size)))
+ (work-proc 0))
- (XtAddEventHandler scan-text EnterWindowMask #f
- (lambda (w context ev flag)
- (XmProcessTraversal w XmTRAVERSE_CURRENT)
- (XtSetValues w (list XmNbackground (white-pixel)))))
- (XtAddEventHandler scan-text LeaveWindowMask #f
+ (define (y->grfy y range)
+ (min ay1
+ (max ay0
+ (round (+ ay0
+ (* range (- 10.0 y)))))))
+
+ (define (draw-graph)
+ (if (and (> ax1 ax0)
+ (> ay1 ay0))
+ (let ((diff (* 0.05 (- ay1 ay0))) ; assuming -10 to 10
+ (dpy (XtDisplay scan-pane))
+ (wn (XtWindow scan-pane))
+ (xincr (* 1.0 (/ (- ax1 ax0) size))))
+ (if pts1
+ (XDrawLinesDirect dpy wn egc pts1 size 0)
+ (XFillRectangle dpy wn egc ; erase previous graph
+ (+ ax0 2)
+ ay0
+ (- ax1 ax0 2)
+ (- ay1 ay0)))
+ (do ((i 0 (+ i 1))
+ (j 0 (+ j 2))
+ (xi ax0 (+ xi xincr)))
+ ((= i size))
+ (set! (vect j) (floor xi))
+ (set! (vect (+ j 1)) (y->grfy (gx0 i) diff)))
+ (if pts1 (freeXPoints pts1))
+ (set! pts0 (vector->XPoints vect))
+ (set! pts1 pts0)
+ (XDrawLinesDirect dpy wn gc pts0 size 0))))
+
+ (define (redraw-graph)
+ (set! bounds (draw-axes scan-pane gc "scanned synthesis" 0.0 1.0 -10.0 10.0))
+ (set! ax0 (+ (car bounds) 2))
+ (set! ax1 (caddr bounds))
+ (set! ay1 (cadr bounds))
+ (set! ay0 (cadddr bounds))
+ (draw-graph))
+
+ (define (tick-synthesis n)
+ ;; background process
+ (compute-uniform-circular-string size gx0 gx1 gx2 mass xspring damp)
+ (draw-graph)
+ #f)
+
+ (define (stop-synthesis)
+ (if (XtWorkProcId? work-proc)
+ (XtRemoveWorkProc work-proc))
+ (set! work-proc 0)
+ (set! playing #f))
+
+ (define (start-synthesis)
+ (stop-synthesis)
+ (fill! gx0 0.0)
+ (fill! gx1 0.0)
+ (fill! gx2 0.0)
+ (do ((i 0 (+ i 1)))
+ ((= i 12))
+ (let ((val (sin (/ (* 2 pi i) 12.0))))
+ (set! (gx1 (+ i (- (/ size 4) 6))) val)))
+ (set! work-proc (XtAppAddWorkProc app tick-synthesis)))
+
+ (define (continue-synthesis)
+ (stop-synthesis)
+ (set! work-proc (XtAppAddWorkProc app tick-synthesis)))
+
+ ;; controller callbacks
+ (for-each
+ (lambda (data)
+ (let* ((title (XmStringCreate (car data) XmFONTLIST_DEFAULT_TAG))
+ (button (XtCreateManagedWidget (car data) xmScaleWidgetClass scan-row
+ (list XmNbackground *basic-color*
+ XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNminimum (data 1)
+ XmNmaximum (data 2)
+ XmNvalue (data 3)
+ XmNdecimalPoints (data 4)
+ XmNtitleString title))))
+ (XtAddCallback button XmNdragCallback (lambda (w c i) ((data 5) (.value i))))
+ (XtAddCallback button XmNvalueChangedCallback (lambda (w c i) ((data 5) (.value i))))
+ (XmStringFree title)))
+ (list (list "mass" 1 200 100 2 (lambda (val) (set! mass (/ val 100.0))))
+ (list "spring" 1 100 10 2 (lambda (val) (set! xspring (/ val 100.0))))
+ (list "damping" 0 100 0 4 (lambda (val) (set! damp (/ val 10000.0))))))
+
+ (let* ((scan-size (XtCreateManagedWidget "srow" xmFormWidgetClass scan-row
+ (list XmNbackground *basic-color*)))
+ (scan-label (XtCreateManagedWidget "Size:" xmLabelWidgetClass scan-size
+ (list XmNbackground *basic-color*
+ XmNleftAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_NONE)))
+ (scan-text (XtCreateManagedWidget "stext" xmTextFieldWidgetClass scan-size
+ (list XmNbackground *basic-color*
+ XmNvalue (number->string size)
+ XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget scan-label
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM)))
+ (play-button (XtCreateManagedWidget "play" xmToggleButtonWidgetClass scan-row
+ (list XmNbackground *basic-color*
+ XmNselectColor *selection-color*)))
+ (freq-str (XmStringCreate "frequency" XmFONTLIST_DEFAULT_TAG))
+ (freq-scale (XtCreateManagedWidget "frequency" xmScaleWidgetClass scan-row
+ (list XmNbackground *basic-color*
+ XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNminimum 20
+ XmNmaximum 1000
+ XmNvalue 440
+ XmNdecimalPoints 0
+ XmNtitleString freq-str)))
+ (amp-str (XmStringCreate "amplitude" XmFONTLIST_DEFAULT_TAG))
+ (amp-scale (XtCreateManagedWidget "amplitude" xmScaleWidgetClass scan-row
+ (list XmNbackground *basic-color*
+ XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNminimum 0
+ XmNmaximum 100
+ XmNvalue 10
+ XmNdecimalPoints 3
+ XmNtitleString amp-str))))
+ (XmStringFree freq-str)
+ (XmStringFree amp-str)
+
+ (XtAddEventHandler scan-text EnterWindowMask #f
+ (lambda (w context ev flag)
+ (XmProcessTraversal w XmTRAVERSE_CURRENT)
+ (XtSetValues w (list XmNbackground (white-pixel)))))
+ (XtAddEventHandler scan-text LeaveWindowMask #f
+ (lambda (w context ev flag)
+ (XtSetValues w (list XmNbackground *basic-color*))))
+ (XtAddCallback scan-text XmNactivateCallback
+ (lambda (w c i)
+ (stop-synthesis)
+ (set! size (string->number (cadr (XtGetValues scan-text (list XmNvalue 0)))))
+ (set! tbl (make-table-lookup :size size))
+ (set! gx0 (mus-data tbl))
+ (set! gx1 (make-float-vector size))
+ (set! gx2 (make-float-vector size))
+ (set! vect (make-vector (* size 2)))))
+
+ (XtAddCallback freq-scale XmNdragCallback (lambda (w c i) (set! (mus-frequency tbl) (.value i))))
+ (XtAddCallback freq-scale XmNvalueChangedCallback (lambda (w c i) (set! (mus-frequency tbl) (.value i))))
+ (XtAddCallback amp-scale XmNdragCallback (lambda (w c i) (set! amplitude (* .001 (.value i)))))
+ (XtAddCallback amp-scale XmNvalueChangedCallback (lambda (w c i) (set! amplitude (* .001 (.value i)))))
+
+ (XtAddCallback play-button XmNvalueChangedCallback
+ (lambda (w context info)
+ (if playing
+ (set! playing #f)
+ (let* ((audio-info (open-play-output 1 22050 #f 128))
+ (audio-fd (car audio-info))
+ (outchans (cadr audio-info))
+ (len (caddr audio-info))
+ (data (make-float-vector (list outchans len) 0.0)))
+ (set! playing #t)
+ (if (not (= audio-fd -1))
+ (do ()
+ ((not playing) ; can also happen if top Stop button pressed
+ (begin
+ (set! playing #f)
+ (XmToggleButtonSetValue play-button 0 #f) ; don't send event
+ (mus-audio-close audio-fd)))
+ (tick-synthesis work-proc)
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (vector-set! data 0 k (* amplitude (table-lookup tbl))))
+ (mus-audio-write audio-fd data len))
+ (set! playing #f)))))))
+
+ (XtAddCallback scan-pane XmNresizeCallback (lambda (w context info) (redraw-graph)))
+ (XtAddCallback scan-pane XmNexposeCallback (lambda (w context info) (redraw-graph)))
+ (XtAddEventHandler scan-pane ButtonPressMask #f
(lambda (w context ev flag)
- (XtSetValues w (list XmNbackground (basic-color)))))
- (XtAddCallback scan-text XmNactivateCallback
- (lambda (w c i)
- (stop-synthesis)
- (set! size (string->number (cadr (XtGetValues scan-text (list XmNvalue 0)))))
- (set! tbl (make-table-lookup :size size))
- (set! gx0 (mus-data tbl))
- (set! gx1 (make-vct size))
- (set! gx2 (make-vct size))
- (set! vect (make-vector (* size 2)))))
+ (if (not (XtWorkProcId? work-proc))
+ (if (= (.button ev) 2)
+ (continue-synthesis)
+ (start-synthesis))
+ (stop-synthesis))))
- (XtAddCallback freq-scale XmNdragCallback (lambda (w c i) (set! (mus-frequency tbl) (.value i))))
- (XtAddCallback freq-scale XmNvalueChangedCallback (lambda (w c i) (set! (mus-frequency tbl) (.value i))))
- (XtAddCallback amp-scale XmNdragCallback (lambda (w c i) (set! amplitude (* .001 (.value i)))))
- (XtAddCallback amp-scale XmNvalueChangedCallback (lambda (w c i) (set! amplitude (* .001 (.value i)))))
+ (XtAddCallback scan-start XmNactivateCallback (lambda (w c i) (start-synthesis)))
+ (XtAddCallback scan-continue XmNactivateCallback (lambda (w c i) (continue-synthesis)))
+ (XtAddCallback scan-stop XmNactivateCallback (lambda (w c i) (stop-synthesis)))
- (XtAddCallback play-button XmNvalueChangedCallback
- (lambda (w context info)
- (if playing
- (set! playing #f)
- (let* ((audio-info (open-play-output 1 22050 #f 128))
- (audio-fd (car audio-info))
- (outchans (cadr audio-info))
- (frames (caddr audio-info))
- (data (make-sound-data outchans frames)))
- (set! playing #t)
- (if (not (= audio-fd -1))
- (do ()
- ((not playing) ; can also happen if top Stop button pressed
- (begin
- (set! playing #f)
- (XmToggleButtonSetValue play-button 0 #f) ; don't send event
- (mus-audio-close audio-fd)))
- (tick-synthesis work-proc)
- (do ((k 0 (+ 1 k)))
- ((= k frames))
- (sound-data-set! data 0 k (* amplitude (table-lookup tbl))))
- (mus-audio-write audio-fd data frames))
- (set! playing #f)))))))
-
- (XtAddCallback scan-pane XmNresizeCallback (lambda (w context info) (redraw-graph)))
- (XtAddCallback scan-pane XmNexposeCallback (lambda (w context info) (redraw-graph)))
- (XtAddEventHandler scan-pane ButtonPressMask #f
- (lambda (w context ev flag)
- (if (not (XtWorkProcId? work-proc))
- (if (= (.button ev) 2)
- (continue-synthesis)
- (start-synthesis))
- (stop-synthesis))))
-
- (XtAddCallback scan-start XmNactivateCallback (lambda (w c i) (start-synthesis)))
- (XtAddCallback scan-continue XmNactivateCallback (lambda (w c i) (continue-synthesis)))
- (XtAddCallback scan-stop XmNactivateCallback (lambda (w c i) (stop-synthesis)))
-
- #t ; for slightly prettier listener output
- ))
-
-(define (close-scanned-synthesis-pane)
- "(close-scanned-synthesis-pane) closes the Scanned Sythesis sound pane"
- (for-each-child
- (cadr (main-widgets)) ; this is Snd's outermost shell
- (lambda (n)
- (if (string=? (XtName n) "Scanned Synthesis")
- (XtUnmanageChild n)))))
-
-
-
+ #t ; for slightly prettier listener output
+ ))
+
+ (define close-scanned-synthesis-pane
+ (let ((documentation "(close-scanned-synthesis-pane) closes the Scanned Sythesis sound pane"))
+ (lambda ()
+ (for-each-child
+ (cadr (main-widgets)) ; this is Snd's outermost shell
+ (lambda (n)
+ (if (string=? (XtName n) "Scanned Synthesis")
+ (XtUnmanageChild n)))))))
+|#
+
+
;;; -------- add-mark-pane --------
;;;
;;; adds a pane to each channel giving the current mark locations (sample values)
;;; these can be edited to move the mark, or deleted to delete the mark
;;; can't use channel-property here because the widget lists are permanent (just unmanaged)
-
-(define including-mark-pane #f) ; for prefs
-
-(define (add-mark-pane)
-
- (define (find-mark-list snd chn dats)
- (if (not (null? dats))
- (let ((cur (car dats)))
- (if (and (equal? (car cur) snd)
- (= (cadr cur) chn))
- (caddr cur)
- (find-mark-list snd chn (cdr dats))))
+
+ (define including-mark-pane #f) ; for prefs
+
+ (define (add-mark-pane)
+
+ (define (find-mark-list snd chn dats)
+ (and (pair? dats)
+ (let ((cur (car dats)))
+ (if (and (equal? (car cur) snd)
+ (= (cadr cur) chn))
+ (caddr cur)
+ (find-mark-list snd chn (cdr dats))))))
+
+ (define mark-list-length
+ (let ((mark-list-lengths ()))
+ (define (remove-mark-list snd chn)
+ (set! mark-list-lengths (remove-if
+ (lambda (n)
+ (and (equal? (car n) snd)
+ (= (cadr n) chn)))
+ mark-list-lengths)))
+ (dilambda
+ (lambda (snd chn)
+ (or (find-mark-list snd chn mark-list-lengths)
+ 0))
+ (lambda (snd chn len)
+ (remove-mark-list snd chn)
+ (set! mark-list-lengths (cons (list snd chn len) mark-list-lengths))))))
+
+ (define mark-list
+ (let ((mark-lists ()))
+ (dilambda
+ (lambda (snd chn)
+ (let ((dat (find-mark-list snd chn mark-lists)))
+ (and dat
+ (caddr dat))))
+ (lambda (snd chn wid)
+ (set! mark-lists (cons (list snd chn wid) mark-lists))))))
+
+ (define (deactivate-mark-list snd chn)
+ (let ((current-mark-list-length (mark-list-length snd chn)))
+ (if (and (> current-mark-list-length 0)
+ (Widget? (mark-list snd chn)))
+ (for-each XtUnmanageChild (cadr (XtGetValues (mark-list snd chn) (list XmNchildren 0) 1))))))
+
+ (define (make-mark-list snd chn)
+ (let ((current-mark-list-length (mark-list-length snd chn)))
+ (deactivate-mark-list snd chn)
+ (if (not (Widget? (mark-list snd chn)))
+ (let* ((mark-box (add-channel-pane snd chn "mark-box" xmFormWidgetClass
+ (list XmNbackground *basic-color*
+ XmNorientation XmVERTICAL
+ XmNpaneMinimum 100
+ XmNbottomAttachment XmATTACH_FORM)))
+ (mark-label (XtCreateManagedWidget "Marks" xmLabelWidgetClass mark-box
+ (list XmNbackground *highlight-color*
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNalignment XmALIGNMENT_CENTER
+ XmNtopAttachment XmATTACH_FORM)))
+ (mark-scroller (XtCreateManagedWidget "mark-scroller" xmScrolledWindowWidgetClass mark-box
+ (list XmNbackground *basic-color*
+ XmNscrollingPolicy XmAUTOMATIC
+ XmNscrollBarDisplayPolicy XmSTATIC
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget mark-label
+ XmNbottomAttachment XmATTACH_FORM)))
+ (mlist (XtCreateManagedWidget "mark-list" xmRowColumnWidgetClass mark-scroller
+ (list XmNorientation XmVERTICAL
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNspacing 0))))
+ (set-main-color-of-widget mark-scroller)
+ (XtSetValues mark-box (list XmNpaneMinimum 1))
+ (set! (mark-list snd chn) (list snd chn mlist))))
+
+ (let ((new-marks (marks snd chn)))
+ (if (> (length new-marks) current-mark-list-length)
+ (let ((lst (mark-list snd chn)))
+ (do ((i current-mark-list-length (+ i 1)))
+ ((= i (length new-marks)))
+ (let ((tf (XtCreateWidget "field" xmTextFieldWidgetClass lst
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback tf XmNfocusCallback
+ (lambda (w c i)
+ (XtSetValues w (list XmNbackground (white-pixel)))))
+ (XtAddCallback tf XmNlosingFocusCallback
+ (lambda (w c i)
+ (XtSetValues w (list XmNbackground *basic-color*))))
+ (XtAddCallback tf XmNactivateCallback
+ (lambda (w c i)
+ (let* ((id (integer->mark (cadr (XtGetValues w (list XmNuserData 0)))))
+ (txt (cadr (XtGetValues w (list XmNvalue 0))))
+ (samp (and (string? txt)
+ (> (length txt) 0)
+ (string->number txt))))
+ (if samp
+ (if (mark? id)
+ (set! (mark-sample id) samp))
+ (delete-mark id))
+ (XtSetValues w (list XmNbackground *basic-color*)))))))))
+
+ (set! (mark-list-length snd chn) (length new-marks))
+ (let ((lst (mark-list snd chn)))
+ (call-with-exit
+ (lambda (quit)
+ (for-each
+ (lambda (n)
+ (if (null? new-marks) (quit #f))
+ (if (XmIsTextField n)
+ (begin
+ (XtSetValues n (list XmNvalue (number->string (mark-sample (car new-marks)))
+ XmNuserData (mark->integer (car new-marks))))
+ (XtManageChild n)
+ (set! new-marks (cdr new-marks)))))
+ (cadr (XtGetValues lst (list XmNchildren 0) 1)))))))
#f))
-
- (define mark-list-length
- (let ((mark-list-lengths '()))
- (define (remove-mark-list snd chn)
- (set! mark-list-lengths (remove-if
- (lambda (n)
- (and (equal? (car n) snd)
- (= (cadr n) chn)))
- mark-list-lengths)))
- (make-procedure-with-setter
- (lambda (snd chn)
- (or (find-mark-list snd chn mark-list-lengths)
- 0))
- (lambda (snd chn len)
- (remove-mark-list snd chn)
- (set! mark-list-lengths (cons (list snd chn len) mark-list-lengths))))))
-
- (define mark-list
- (let ((mark-lists '()))
- (make-procedure-with-setter
- (lambda (snd chn)
- (let ((dat (find-mark-list snd chn mark-lists)))
- (and dat
- (caddr dat))))
- (lambda (snd chn wid)
- (set! mark-lists (cons (list snd chn wid) mark-lists))))))
-
- (define (deactivate-mark-list snd chn)
- (let ((current-mark-list-length (mark-list-length snd chn)))
- (if (and (> current-mark-list-length 0)
- (Widget? (mark-list snd chn)))
- (for-each
- (lambda (n)
- (XtUnmanageChild n))
- (cadr (XtGetValues (mark-list snd chn) (list XmNchildren 0) 1))))))
-
- (define (make-mark-list snd chn)
- (let ((current-mark-list-length (mark-list-length snd chn)))
- (deactivate-mark-list snd chn)
- (if (not (Widget? (mark-list snd chn)))
- (let* ((mark-box (add-channel-pane snd chn "mark-box" xmFormWidgetClass
- (list XmNbackground (basic-color)
- XmNorientation XmVERTICAL
- XmNpaneMinimum 100
- XmNbottomAttachment XmATTACH_FORM)))
- (mark-label (XtCreateManagedWidget "Marks" xmLabelWidgetClass mark-box
- (list XmNbackground (highlight-color)
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNalignment XmALIGNMENT_CENTER
- XmNtopAttachment XmATTACH_FORM)))
- (mark-scroller (XtCreateManagedWidget "mark-scroller" xmScrolledWindowWidgetClass mark-box
- (list XmNbackground (basic-color)
- XmNscrollingPolicy XmAUTOMATIC
- XmNscrollBarDisplayPolicy XmSTATIC
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget mark-label
- XmNbottomAttachment XmATTACH_FORM)))
- (mlist (XtCreateManagedWidget "mark-list" xmRowColumnWidgetClass mark-scroller
- (list XmNorientation XmVERTICAL
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNspacing 0))))
- (set-main-color-of-widget mark-scroller)
- (XtSetValues mark-box (list XmNpaneMinimum 1))
- (set! (mark-list snd chn) (list snd chn mlist))))
-
- (let ((new-marks (marks snd chn)))
- (if (> (length new-marks) current-mark-list-length)
- (let* ((lst (mark-list snd chn)))
- (do ((i current-mark-list-length (+ i 1)))
- ((= i (length new-marks)))
- (let ((tf (XtCreateWidget "field" xmTextFieldWidgetClass lst
- (list XmNbackground (basic-color)))))
- (XtAddCallback tf XmNfocusCallback
- (lambda (w c i)
- (XtSetValues w (list XmNbackground (white-pixel)))))
- (XtAddCallback tf XmNlosingFocusCallback
- (lambda (w c i)
- (XtSetValues w (list XmNbackground (basic-color)))))
- (XtAddCallback tf XmNactivateCallback
- (lambda (w c i)
- (let* ((id (integer->mark (cadr (XtGetValues w (list XmNuserData 0)))))
- (txt (cadr (XtGetValues w (list XmNvalue 0))))
- (samp (if (and (string? txt)
- (> (string-length txt) 0))
- (string->number txt)
- #f)))
- (if samp
- (if (mark? id)
- (set! (mark-sample id) samp))
- (delete-mark id))
- (XtSetValues w (list XmNbackground (basic-color))))))))))
-
- (set! (mark-list-length snd chn) (length new-marks))
- (let* ((lst (mark-list snd chn)))
- (call-with-exit
- (lambda (quit)
- (for-each
- (lambda (n)
- (if (null? new-marks) (quit #f))
- (if (XmIsTextField n)
- (begin
- (XtSetValues n (list XmNvalue (number->string (mark-sample (car new-marks)))
- XmNuserData (mark->integer (car new-marks))))
- (XtManageChild n)
- (set! new-marks (cdr new-marks)))))
- (cadr (XtGetValues lst (list XmNchildren 0) 1)))))))
- #f))
-
- (define (remark id snd chn reason)
- (make-mark-list snd chn))
-
- (define (unremark snd)
- (do ((i 0 (+ i 1)))
- ((= i (channels snd)))
- (deactivate-mark-list snd i)))
-
- (define (open-remarks snd)
- (do ((i 0 (+ i 1)))
- ((= i (channels snd)))
- (hook-push (after-edit-hook snd i)
- (lambda ()
- (if (Widget? (mark-list snd i))
- (make-mark-list snd i))))
- (hook-push (undo-hook snd i)
- (lambda ()
- (if (Widget? (mark-list snd i))
- (make-mark-list snd i))))))
-
- (set! including-mark-pane #t)
- (hook-push mark-hook remark)
- (hook-push close-hook unremark)
- (hook-push after-open-hook open-remarks)
- (hook-push update-hook (lambda (snd)
- ;; update-sound (called if header is changed, for example), calls open-sound
- ;; which restores our channel-local mark-pane hooks, but doesn't re-activate
- ;; the mark pane itself. So, we return a procedure from the update-hook
- ;; evaluation that will recreate our pane immediately upon update completion.
- (lambda (updated-snd)
- ;; this is the procedure to be called when the update is done
- (do ((i 0 (+ i 1)))
- ((= i (channels updated-snd)))
- (make-mark-list updated-snd i)))))
- )
-
-
+
+ (define (remark hook)
+ (make-mark-list (hook 'snd) (hook 'chn)))
+
+ (define (unremark hook)
+ (do ((i 0 (+ i 1)))
+ ((= i (channels (hook 'snd))))
+ (deactivate-mark-list (hook 'snd) i)))
+
+ (define (open-remarks hook)
+ (let ((snd (hook 'snd)))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels snd)))
+ (hook-push (after-edit-hook snd i)
+ (lambda (hook)
+ (if (Widget? (mark-list snd i))
+ (make-mark-list snd i))))
+ (hook-push (undo-hook snd i)
+ (lambda (hook)
+ (if (Widget? (mark-list snd i))
+ (make-mark-list snd i)))))))
+
+ (set! including-mark-pane #t)
+ (hook-push mark-hook remark)
+ (hook-push close-hook unremark)
+ (hook-push after-open-hook open-remarks)
+ (hook-push update-hook (lambda (hook)
+ ;; update-sound (called if header is changed, for example), calls open-sound
+ ;; which restores our channel-local mark-pane hooks, but doesn't re-activate
+ ;; the mark pane itself. So, we return a procedure from the update-hook
+ ;; evaluation that will recreate our pane immediately upon update completion.
+ (set! (hook 'result)
+ (lambda (updated-snd)
+ ;; this is the procedure to be called when the update is done
+ (do ((i 0 (+ i 1)))
+ ((= i (channels updated-snd)))
+ (make-mark-list updated-snd i))))))
+ )
+
+
;;; -------- select-file --------
;;;
;;; (select-file func title dir filter help)
@@ -1210,121 +1178,119 @@ Box: (install-searcher (lambda (file) (= (srate file) 44100)))"
;;; (lambda (filename)
;;; (insert-sound filename))
;;; "Insert File" "." "*" "file will be inserted at cursor")))
-
-(define select-file
-
- (let ((file-selector-dialogs '()))
- ;; (list (list widget inuse func title help) ...)
- (define (find-free-dialog ds)
- (if (null? ds)
- #f
- (if (not (cadr (car ds)))
- (begin
- (list-set! (car ds) 1 #t)
- (caar ds))
- (find-free-dialog (cdr ds)))))
- (define (find-dialog-widget wid ds)
- (if (null? ds)
- #f
- (if (equal? wid (caar ds))
- (car ds)
- (find-dialog-widget wid (cdr ds)))))
- (lambda args
- ;; (file-select func title dir filter help)
- (let* ((func (if (> (length args) 0) (list-ref args 0) #f))
- (title (if (> (length args) 1) (list-ref args 1) "select file"))
- (dir (if (> (length args) 2) (list-ref args 2) "."))
- (filter (if (> (length args) 3) (list-ref args 3) "*"))
- (help (if (> (length args) 4) (list-ref args 4) #f))
- (dialog (or (find-free-dialog file-selector-dialogs)
- (let ((new-dialog (XmCreateFileSelectionDialog
- (cadr (main-widgets))
- title
- (list XmNbackground (basic-color)))))
- (XtAddCallback new-dialog XmNhelpCallback
+
+ (define select-file
+
+ (let ((file-selector-dialogs ()))
+ ;; (list (list widget inuse func title help) ...)
+ (define (find-free-dialog ds)
+ (and (pair? ds)
+ (if (not (cadr (car ds)))
+ (begin
+ (set! ((car ds) 1) #t)
+ (caar ds))
+ (find-free-dialog (cdr ds)))))
+ (define (find-dialog-widget wid ds)
+ (and (pair? ds)
+ (if (equal? wid (caar ds))
+ (car ds)
+ (find-dialog-widget wid (cdr ds)))))
+ (lambda args
+ ;; (file-select func title dir filter help)
+ (let* ((func (and (> (length args) 0) (args 0)))
+ (title (if (> (length args) 1) (args 1) "select file"))
+ (dir (if (> (length args) 2) (args 2) "."))
+ (filter (if (> (length args) 3) (args 3) "*"))
+ (help (and (> (length args) 4) (args 4)))
+ (dialog (or (find-free-dialog file-selector-dialogs)
+ (let ((new-dialog (XmCreateFileSelectionDialog
+ (cadr (main-widgets))
+ title
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback new-dialog XmNhelpCallback
(lambda (w c i)
(let ((lst (find-dialog-widget w file-selector-dialogs)))
- (if (list-ref lst 4)
- (help-dialog (list-ref lst 3) (list-ref lst 4))))))
- (XtAddCallback new-dialog XmNokCallback
- (lambda (w c i)
- (let ((lst (find-dialog-widget w file-selector-dialogs)))
- ((list-ref lst 2) (XmStringUnparse (.value i) #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
- (list-set! lst 1 #f)
- (XtUnmanageChild w))))
- (XtAddCallback new-dialog XmNcancelCallback
- (lambda (w c i)
- (let ((lst (find-dialog-widget w file-selector-dialogs)))
- (list-set! lst 1 #f)
- (XtUnmanageChild w))))
- (set! file-selector-dialogs (cons (list new-dialog #t func title help) file-selector-dialogs))
- (set-main-color-of-widget new-dialog)
- (XtSetValues (XmFileSelectionBoxGetChild new-dialog XmDIALOG_DIR_LIST)
- (list XmNbackground (white-pixel)))
- (XtSetValues (XmFileSelectionBoxGetChild new-dialog XmDIALOG_LIST)
- (list XmNbackground (white-pixel)))
- (XtSetValues (XtNameToWidget new-dialog "Cancel")
- (list XmNarmColor (selection-color)))
- (XtSetValues (XtNameToWidget new-dialog "Help")
- (list XmNarmColor (selection-color)))
- (XtSetValues (XtNameToWidget new-dialog "OK")
- (list XmNarmColor (selection-color)))
- new-dialog))))
- (if (not help)
- (XtUnmanageChild (XmFileSelectionBoxGetChild dialog XmDIALOG_HELP_BUTTON))
- (XtManageChild (XmFileSelectionBoxGetChild dialog XmDIALOG_HELP_BUTTON)))
- (let ((dirstr (XmStringCreateLocalized dir))
- (patstr (XmStringCreateLocalized filter))
- (titlestr (XmStringCreateLocalized title)))
- (XtSetValues dialog
- (list XmNdirectory dirstr
- XmNpattern patstr
- XmNdialogTitle titlestr))
- (XmStringFree dirstr)
- (XmStringFree patstr)
- (XmStringFree titlestr)
- (XtManageChild dialog))))))
-
-; (select-file (lambda (n) (snd-print n)))
-
-
-
+ (if (lst 4)
+ (help-dialog (lst 3) (lst 4))))))
+ (XtAddCallback new-dialog XmNokCallback
+ (lambda (w c i)
+ (let ((lst (find-dialog-widget w file-selector-dialogs)))
+ ((lst 2) (XmStringUnparse (.value i) #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
+ (set! (lst 1) #f)
+ (XtUnmanageChild w))))
+ (XtAddCallback new-dialog XmNcancelCallback
+ (lambda (w c i)
+ (let ((lst (find-dialog-widget w file-selector-dialogs)))
+ (set! (lst 1) #f)
+ (XtUnmanageChild w))))
+ (set! file-selector-dialogs (cons (list new-dialog #t func title help) file-selector-dialogs))
+ (set-main-color-of-widget new-dialog)
+ (XtSetValues (XmFileSelectionBoxGetChild new-dialog XmDIALOG_DIR_LIST)
+ (list XmNbackground (white-pixel)))
+ (XtSetValues (XmFileSelectionBoxGetChild new-dialog XmDIALOG_LIST)
+ (list XmNbackground (white-pixel)))
+ (XtSetValues (XtNameToWidget new-dialog "Cancel")
+ (list XmNarmColor *selection-color*))
+ (XtSetValues (XtNameToWidget new-dialog "Help")
+ (list XmNarmColor *selection-color*))
+ (XtSetValues (XtNameToWidget new-dialog "OK")
+ (list XmNarmColor *selection-color*))
+ new-dialog))))
+ (if (not help)
+ (XtUnmanageChild (XmFileSelectionBoxGetChild dialog XmDIALOG_HELP_BUTTON))
+ (XtManageChild (XmFileSelectionBoxGetChild dialog XmDIALOG_HELP_BUTTON)))
+ (let ((dirstr (XmStringCreateLocalized dir))
+ (patstr (XmStringCreateLocalized filter))
+ (titlestr (XmStringCreateLocalized title)))
+ (XtSetValues dialog
+ (list XmNdirectory dirstr
+ XmNpattern patstr
+ XmNdialogTitle titlestr))
+ (XmStringFree dirstr)
+ (XmStringFree patstr)
+ (XmStringFree titlestr)
+ (XtManageChild dialog))))))
+
+ ; (select-file (lambda (n) (snd-print n)))
+
+
+
;;; -------- snd-clock-icon --------
;;;
;;; a clock icon to replace Snd's hourglass
;;; call from a work proc or whatever with hour going from 0 to 12 then #f
-
-(define snd-clock-icon
- (let* ((shell (list-ref (main-widgets) 1))
- (dpy (XtDisplay shell))
- (win (XtWindow shell))
- (clock-pixmaps (make-vector 12))
- (dgc (car (snd-gcs))))
- (do ((i 0 (+ i 1)))
- ((= i 12))
- ;; it's actually possible to simply redraw on one pixmap, but updates are unpredictable
- (let* ((pix (XCreatePixmap dpy win 16 16 (screen-depth)))
- (pixwin (list 'Window (cadr pix)))) ; C-style cast to Window for X graphics procedures
- (set! (clock-pixmaps i) pix)
- (XSetForeground dpy dgc (basic-color))
- (XFillRectangle dpy pixwin dgc 0 0 16 16)
- (XSetForeground dpy dgc (white-pixel))
- (XFillArc dpy pixwin dgc 1 1 14 14 0 (* 64 360))
- (XSetForeground dpy dgc (black-pixel))
- (XDrawArc dpy pixwin dgc 1 1 14 14 0 (* 64 360))
- (XDrawLine dpy pixwin dgc 8 8
- (+ 8 (round (* 7 (sin (* i (/ 3.1416 6.0))))))
- (- 8 (round (* 7 (cos (* i (/ 3.1416 6.0)))))))))
- (XSetBackground dpy dgc (graph-color))
- (XSetForeground dpy dgc (data-color))
- (lambda (snd hour)
- (if hour
- (XtSetValues (list-ref (sound-widgets snd) 8)
- (list XmNlabelPixmap (clock-pixmaps hour)))
- (bomb snd #f))))) ; using bomb to clear the icon
-
-
-
+
+ (define snd-clock-icon
+ (let* ((shell ((main-widgets) 1))
+ (dpy (XtDisplay shell))
+ (win (XtWindow shell))
+ (clock-pixmaps (make-vector 12))
+ (dgc (car (snd-gcs))))
+ (do ((i 0 (+ i 1)))
+ ((= i 12))
+ ;; it's actually possible to simply redraw on one pixmap, but updates are unpredictable
+ (let* ((pix (XCreatePixmap dpy win 16 16 (screen-depth)))
+ (pixwin (list 'Window (cadr pix)))) ; C-style cast to Window for X graphics procedures
+ (set! (clock-pixmaps i) pix)
+ (XSetForeground dpy dgc *basic-color*)
+ (XFillRectangle dpy pixwin dgc 0 0 16 16)
+ (XSetForeground dpy dgc (white-pixel))
+ (XFillArc dpy pixwin dgc 1 1 14 14 0 (* 64 360))
+ (XSetForeground dpy dgc (black-pixel))
+ (XDrawArc dpy pixwin dgc 1 1 14 14 0 (* 64 360))
+ (XDrawLine dpy pixwin dgc 8 8
+ (+ 8 (round (* 7 (sin (* i (/ 3.1416 6.0))))))
+ (- 8 (round (* 7 (cos (* i (/ 3.1416 6.0)))))))))
+ (XSetBackground dpy dgc *graph-color*)
+ (XSetForeground dpy dgc *data-color*)
+ (lambda (snd hour)
+ (if hour
+ (XtSetValues ((sound-widgets snd) 8)
+ (list XmNlabelPixmap (clock-pixmaps hour)))
+ (bomb snd #f))))) ; using bomb to clear the icon
+
+
+
;;; -------- make-sound-box --------
;;;
;;; make-sound-box makes a container of sound file icons, each icon
@@ -1334,1726 +1300,1734 @@ Box: (install-searcher (lambda (file) (= (srate file) 44100)))"
;;; button 2) the icon to the menubar, that sound will be opened,
;;; and if you drag it to a channel graph, it will be mixed at the
;;; drag point in that channel.
-
-
-(define (thumbnail-graph dpy wn gc pts width height)
- "(thumbnail-graph dpy wn gc pts width height) makes a little graph of the data"
- (let* ((top-margin 2)
- (bottom-margin 6)
- (left-margin 2)
- (right-margin 2)
- (ay1 top-margin)
- (ay0 (- height bottom-margin))
- (range (/ (- height top-margin bottom-margin) 2)))
- (define (y->grfy y height)
- (min ay0
- (max ay1
- (round (+ ay1
- (* height (- 1.0 y)))))))
- (let* ((ly (y->grfy (pts 0) range))
- (lx left-margin)
- (len (length pts))
- (xinc (/ (- width left-margin right-margin) len))
- (y 0))
- (do ((i 1 (+ i 1))
- (x lx (+ x xinc)))
- ((= i len))
- (set! y (y->grfy (pts i) range))
- (XDrawLine dpy wn gc lx ly (round x) y)
- (set! lx (round x))
- (set! ly y)))))
-
-(define make-sound-box
- ;; graphics stuff (fonts etc)
- (let* ((gv (XGCValues))
- (shell (list-ref (main-widgets) 1))
- (button-fontstruct (XLoadQueryFont (XtDisplay shell) (or (listener-font) "9x15"))))
- (set! (.foreground gv) (data-color))
- (set! (.background gv) (basic-color))
- (set! (.font gv) (.fid button-fontstruct))
- (let ((gc (XCreateGC (XtDisplay shell)
- (XtWindow shell)
- (logior GCForeground GCBackground GCFont) gv))
- (sound-buttons '()))
-
- ;; button data list handlers
- (define sound-button-gc
- (make-procedure-with-setter
- (lambda (data) (list-ref data 0))
- (lambda (data val) (list-set! data 0 val))))
-
- (define sound-button-filename
- (make-procedure-with-setter
- (lambda (data) (list-ref data 1))
- (lambda (data val) (list-set! data 1 val))))
-
- (define sound-button
- (make-procedure-with-setter
- (lambda (data) (list-ref data 2))
- (lambda (data val) (list-set! data 2 val))))
-
- (define sound-button-peaks
- (make-procedure-with-setter
- (lambda (data) (list-ref data 3))
- (lambda (data val) (list-set! data 3 val))))
-
- (define (sound-button-data button)
+
+
+ (define thumbnail-graph
+ (let ((documentation "(thumbnail-graph dpy wn gc pts width height) makes a little graph of the data"))
+ (lambda (dpy wn gc pts width height)
+ (let* ((top-margin 2)
+ (bottom-margin 6)
+ (left-margin 2)
+ (right-margin 2)
+ (ay1 top-margin)
+ (ay0 (- height bottom-margin))
+ (range (/ (- height top-margin bottom-margin) 2)))
+ (define (y->grfy y height)
+ (min ay0
+ (max ay1
+ (round (+ ay1
+ (* height (- 1.0 y)))))))
+ (let* ((ly (y->grfy (pts 0) range))
+ (lx left-margin)
+ (len (length pts))
+ (xinc (/ (- width left-margin right-margin) len))
+ (y 0))
+ (do ((i 1 (+ i 1))
+ (x lx (+ x xinc)))
+ ((= i len))
+ (set! y (y->grfy (pts i) range))
+ (XDrawLine dpy wn gc lx ly (round x) y)
+ (set! lx (round x))
+ (set! ly y)))))))
+
+ (define make-sound-box
+ ;; graphics stuff (fonts etc)
+ (let* ((gv (XGCValues))
+ (shell ((main-widgets) 1))
+ (button-fontstruct (XLoadQueryFont (XtDisplay shell)
+ (if (> (length *listener-font*) 0)
+ *listener-font*
+ "9x15"))))
+ (set! (.foreground gv) *data-color*)
+ (set! (.background gv) *basic-color*)
+ (if (and button-fontstruct (.fid button-fontstruct))
+ (set! (.font gv) (.fid button-fontstruct)))
+ (let ((gc (XCreateGC (XtDisplay shell)
+ (XtWindow shell)
+ (logior GCForeground GCBackground GCFont) gv))
+ (sound-buttons ()))
+
+ ;; button data list handlers
+ (define sound-button-gc
+ (dilambda
+ (lambda (data) (data 0))
+ (lambda (data val) (set! (data 0) val))))
+
+ (define sound-button-filename
+ (dilambda
+ (lambda (data) (data 1))
+ (lambda (data val) (set! (data 1) val))))
+
+ (define sound-button
+ (dilambda
+ (lambda (data) (data 2))
+ (lambda (data val) (set! (data 2) val))))
+
+ (define sound-button-peaks
+ (dilambda
+ (lambda (data) (data 3))
+ (lambda (data val) (set! (data 3) val))))
+ #|
+ (define (sound-button-data button)
(define (sb-data lst)
- (if (null? lst)
- #f
- (if (equal? button (sound-button (car lst)))
- (car lst)
- (sb-data (cdr lst)))))
+ (if (null? lst)
+ #f
+ (if (equal? button (sound-button (car lst)))
+ (car lst)
+ (sb-data (cdr lst)))))
(sb-data sound-buttons))
-
- (define (make-sound-button-pixmap dpy wn data width height)
- (if (list? (sound-button-peaks data))
- (let* ((mins (car (sound-button-peaks data)))
- (maxes (cadr (sound-button-peaks data)))
- (gc (sound-button-gc data))
- (name (sound-button-filename data)))
- (let* ((secs (format #f "~,1F" (mus-sound-duration (sound-button-filename data))))
- (size (XTextWidth button-fontstruct secs (string-length secs))))
- (if (<= size width)
- (XDrawString dpy wn gc (- width size) height secs (string-length secs))))
- (thumbnail-graph dpy wn gc mins width height)
- (thumbnail-graph dpy wn gc maxes width height))))
-
- (define (make-sound-icon filename parent peak-func gc width height args)
- (define (cast-to-window n) (list 'Window (cadr n)))
- (let* ((dpy (XtDisplay parent))
- (win (XtWindow parent))
- (pix (XCreatePixmap dpy win width height (screen-depth)))
- (str (XmStringCreateLocalized filename))
- (data (list gc filename #f (channel-amp-envs filename 0 width peak-func))))
- (XSetForeground dpy gc (basic-color))
- (XFillRectangle dpy (cast-to-window pix) gc 0 0 width height)
- (XSetForeground dpy gc (data-color))
- (make-sound-button-pixmap dpy (cast-to-window pix) data width height)
- (let ((icon (XtCreateManagedWidget filename xmIconGadgetClass parent
- (append (list XmNbackground (basic-color)
- XmNforeground (data-color)
- XmNlabelString str
- XmNlargeIconPixmap pix
- XmNsmallIconPixmap pix)
- args))))
- (set! (sound-button data) icon)
- (set! sound-buttons (cons data sound-buttons))
- icon)))
-
- ;; now the actual sound-box maker
- (lambda (name parent select-func peak-func sounds args)
- ;; select-func called when sound selected and passed sound file name
- ;; peak-func (if any) tells icon where to find peak-env-info-file (if any)
- ;; sounds is list of sound file names
- ;; args is list of resource settings for each icon
- "(make-sound-box name parent select-func peak-func sounds args) makes a box of sound icons"
- (let ((container (XtCreateManagedWidget name xmContainerWidgetClass parent
- (list XmNlayoutType XmSPATIAL
- XmNspatialResizeModel XmGROW_BALANCED
- XmNbackground (white-pixel)
- XmNentryViewType XmANY_ICON
- XmNlargeCellWidth 120))))
- (XtVaSetValues parent (list XmNworkWindow container))
- (XtAddCallback container XmNselectionCallback
- (lambda (w c i)
- (if (and (= (.auto_selection_type i) XmAUTO_BEGIN) ; just click to select for now
- (list? (.selected_items i))
- (not (null? (.selected_items i))))
- (select-func (XtName (car (.selected_items i)))))))
- (for-each
- (lambda (file)
- (make-sound-icon file
- container
- peak-func
- gc
- 96 64
- args))
- sounds)
- container)))))
-
-(define* (show-sounds-in-directory (dir "."))
- "(show-sounds-in-directory (dir \".\")) calls make-sound-box with the given directory"
-
- (make-sound-box
- "sounds"
- (XtCreateManagedWidget "scrolled-window" xmScrolledWindowWidgetClass (list-ref (main-widgets) 3)
- (list XmNscrollBarDisplayPolicy XmAS_NEEDED
- XmNbackground (basic-color)
- XmNvisualPolicy XmVARIABLE
- XmNscrollingPolicy XmAUTOMATIC))
- (lambda (file)
- (open-sound file))
- (lambda (file chn)
- (format #f "~~/peaks/~A-peaks-~D"
- (xm-clean-string (file-name file))
- chn))
- (sound-files-in-directory dir)
- '()))
-
-
-
+ |#
+ (define (make-sound-button-pixmap dpy wn data width height)
+ (if (pair? (sound-button-peaks data))
+ (let ((mins (car (sound-button-peaks data)))
+ (maxes (cadr (sound-button-peaks data)))
+ (gc (sound-button-gc data))
+ ;;(name (sound-button-filename data))
+ )
+ (let* ((secs (format #f "~,1F" (mus-sound-duration (sound-button-filename data))))
+ (size (XTextWidth button-fontstruct secs (length secs))))
+ (if (<= size width)
+ (XDrawString dpy wn gc (- width size) height secs (length secs))))
+ (thumbnail-graph dpy wn gc mins width height)
+ (thumbnail-graph dpy wn gc maxes width height))))
+
+ (define (make-sound-icon filename parent peak-func gc width height args)
+ (define (cast-to-window n) (list 'Window (cadr n)))
+ (let* ((dpy (XtDisplay parent))
+ (win (XtWindow parent))
+ (pix (XCreatePixmap dpy win width height (screen-depth)))
+ (str (XmStringCreateLocalized filename))
+ (data (list gc filename #f (channel-amp-envs filename 0 width peak-func))))
+ (XSetForeground dpy gc *basic-color*)
+ (XFillRectangle dpy (cast-to-window pix) gc 0 0 width height)
+ (XSetForeground dpy gc *data-color*)
+ (make-sound-button-pixmap dpy (cast-to-window pix) data width height)
+ (let ((icon (XtCreateManagedWidget filename xmIconGadgetClass parent
+ (append (list XmNbackground *basic-color*
+ XmNforeground *data-color*
+ XmNlabelString str
+ XmNlargeIconPixmap pix
+ XmNsmallIconPixmap pix)
+ args))))
+ (set! (sound-button data) icon)
+ (set! sound-buttons (cons data sound-buttons))
+ icon)))
+
+ ;; now the actual sound-box maker
+ (lambda (name parent select-func peak-func snds args)
+ ;; select-func called when sound selected and passed sound file name
+ ;; peak-func (if any) tells icon where to find peak-env-info-file (if any)
+ ;; snds is list of sound file names
+ ;; args is list of resource settings for each icon
+ ;; (make-sound-box name parent select-func peak-func sounds args) makes a box of sound icons
+ (let ((container (XtCreateManagedWidget name xmContainerWidgetClass parent
+ (list XmNlayoutType XmSPATIAL
+ XmNspatialResizeModel XmGROW_BALANCED
+ XmNbackground (white-pixel)
+ XmNentryViewType XmANY_ICON
+ XmNlargeCellWidth 120))))
+ (XtVaSetValues parent (list XmNworkWindow container))
+ (XtAddCallback container XmNselectionCallback
+ (lambda (w c i)
+ (if (and (= (.auto_selection_type i) XmAUTO_BEGIN) ; just click to select for now
+ (pair? (.selected_items i)))
+ (select-func (XtName (car (.selected_items i)))))))
+ (for-each
+ (lambda (file)
+ (make-sound-icon file
+ container
+ peak-func
+ gc
+ 96 64
+ args))
+ snds)
+ container)))))
+
+ (define show-sounds-in-directory
+ (let ((documentation "(show-sounds-in-directory (dir \".\")) calls make-sound-box with the given directory"))
+ (lambda* ((dir "."))
+ (make-sound-box
+ "sounds"
+ (XtCreateManagedWidget "scrolled-window" xmScrolledWindowWidgetClass ((main-widgets) 3)
+ (list XmNscrollBarDisplayPolicy XmAS_NEEDED
+ XmNbackground *basic-color*
+ XmNvisualPolicy XmVARIABLE
+ XmNscrollingPolicy XmAUTOMATIC))
+ open-sound
+ (lambda (file chn)
+ (format #f "~~/peaks/~A-peaks-~D"
+ (xm-clean-string (file-name file))
+ chn))
+ (sound-files-in-directory dir)
+ ()))))
+
+
+
#|
;;; -------- show-smpte-label
;;;
;;; (show-smpte-label on-or-off)
;;; turns on/off a label in the time-domain graph showing the current smpte frame of the leftmost sample
;;; this is now built-in under with-smpte-label
-
-(define smpte-frames-per-second 24.0)
-
-(define draw-smpte-label
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (fs (XLoadQueryFont dpy (axis-numbers-font)))
- (width (+ 8 (XTextWidth fs "00:00:00:00" 11)))
- (height (+ 8 (caddr (XTextExtents fs "0" 1)))))
-
- (define (smpte-label samp sr)
- (define (round-down val) (truncate val))
- (let* ((seconds (/ samp sr))
- (frames (* seconds smpte-frames-per-second))
- (minutes (round-down (/ seconds 60)))
- (hours (round-down (/ minutes 60))))
- (format #f "~2,'0D:~2,'0D:~2,'0D:~2,'0D"
- hours
- (- minutes (* hours 60))
- (round-down (- seconds (* minutes 60)))
- (round-down (- frames (* (round-down seconds) smpte-frames-per-second))))))
-
- (lambda (snd chn)
- "(draw-smpte-label snd chn) draws a SMPTE time stamp in a box on a graph"
- (let* ((axinf (axis-info snd chn))
- (x (list-ref axinf 10))
- (y (list-ref axinf 13))
- (grf-width (- (list-ref axinf 12) x))
- (grf-height (- (list-ref axinf 11) y)))
- (if (and (> grf-height (* 2 height))
- (> grf-width (* 1.5 width))
- (time-graph? snd chn))
- (let* ((smpte (smpte-label (car axinf) (srate snd)))
- (samp (car axinf)))
- (fill-rectangle x y width 2 snd chn)
- (fill-rectangle x (+ y height) width 2 snd chn)
- (fill-rectangle x y 2 height snd chn)
- (fill-rectangle (+ x width -2) y 2 height snd chn)
- (XSetFont dpy
- (if (= chn (selected-channel snd))
- (cadr (snd-gcs))
- (car (snd-gcs)))
- (.fid fs))
- (draw-string smpte (+ x 4) (+ y 4) snd chn)))))))
-
-(define (show-smpte-label . arg)
- "(show-smpte-label on-or-off) turns on/off a label in the time-domain graph showing the current smpte frame of the leftmost sample"
- (if (or (null? arg)
- (car arg))
- (if (not (member draw-smpte-label (hook-functions after-graph-hook)))
- (begin
- (hook-push after-graph-hook draw-smpte-label)
- (update-time-graph #t #t)))
- (begin
- (hook-remove after-graph-hook draw-smpte-label)
- (update-time-graph #t #t))))
-
-(define (smpte-is-on) ; for prefs dialog
- "(smpte-is-on) is #t if we are drawing SMPTE time stamps"
- (member draw-smpte-label (hook-functions after-graph-hook)))
+
+ (define smpte-frames-per-second 24.0)
+
+ (define draw-smpte-label
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (fs (XLoadQueryFont dpy *axis-numbers-font*))
+ (width (+ 8 (XTextWidth fs "00:00:00:00" 11)))
+ (height (+ 8 (caddr (XTextExtents fs "0" 1)))))
+
+ (define (smpte-label samp sr)
+ (define (round-down val) (truncate val))
+ (let* ((seconds (/ samp sr))
+ (len (* seconds smpte-frames-per-second))
+ (minutes (round-down (/ seconds 60)))
+ (hours (round-down (/ minutes 60))))
+ (format #f "~2,'0D:~2,'0D:~2,'0D:~2,'0D"
+ hours
+ (- minutes (* hours 60))
+ (round-down (- seconds (* minutes 60)))
+ (round-down (- len (* (round-down seconds) smpte-frames-per-second))))))
+
+ (let ((documentation "(draw-smpte-label snd chn) draws a SMPTE time stamp in a box on a graph"))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (let* ((axinf (axis-info snd chn))
+ (x (axinf 10))
+ (y (axinf 13))
+ (grf-width (- (axinf 12) x))
+ (grf-height (- (axinf 11) y)))
+ (if (and (> grf-height (* 2 height))
+ (> grf-width (* 1.5 width))
+ (time-graph? snd chn))
+ (let* ((smpte (smpte-label (car axinf) (srate snd)))
+ (samp (car axinf)))
+ (fill-rectangle x y width 2 snd chn)
+ (fill-rectangle x (+ y height) width 2 snd chn)
+ (fill-rectangle x y 2 height snd chn)
+ (fill-rectangle (+ x width -2) y 2 height snd chn)
+ (if (and fs (.fid fs))
+ (XSetFont dpy
+ (if (= chn (selected-channel snd))
+ (cadr (snd-gcs))
+ (car (snd-gcs)))
+ (.fid fs)))
+ (draw-string smpte (+ x 4) (+ y 4) snd chn)))))))))
+
+ (define show-smpte-label
+ (let ((documentation "(show-smpte-label on-or-off) turns on/off a label in the time-domain graph showing the current smpte frame of the leftmost sample"))
+ (lambda arg
+ (if (or (null? arg)
+ (car arg))
+ (if (not (member draw-smpte-label (hook-functions after-graph-hook)))
+ (begin
+ (hook-push after-graph-hook draw-smpte-label)
+ (update-time-graph #t #t)))
+ (begin
+ (hook-remove after-graph-hook draw-smpte-label)
+ (update-time-graph #t #t))))))
+
+ (define smpte-is-on ; for prefs dialog
+ (let ((documentation "(smpte-is-on) is #t if we are drawing SMPTE time stamps"))
+ (lambda ()
+ (member draw-smpte-label (hook-functions after-graph-hook)))))
|#
-
-
-
+
+
+ (define red-pixel
+ (let ((pix #f)
+ (documentation "(red-pixel) returns a red pixel"))
+ (lambda ()
+ (if (not pix)
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr))
+ (col (XColor)))
+ (if (= (XAllocNamedColor dpy cmap "red" col col) 0)
+ (snd-error "can't allocate red!")
+ (set! pix (.pixel col)))))
+ pix)))
+
+#|
;;; -------- with-level-meters, make-level-meter, display-level
-
-(define red-pixel
- (let ((pix #f))
- (lambda ()
- "(red-pixel) returns a red pixel"
- (if (not pix)
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr))
- (col (XColor)))
- (if (= (XAllocNamedColor dpy cmap "red" col col) 0)
- (snd-error "can't allocate red!")
- (set! pix (.pixel col)))))
- pix)))
-
-(define* (make-level-meter parent width height args (resizable #t))
- "(make-level-meter parent width height args (resizable #t)) makes a VU level meter"
- (let* ((frame (XtCreateManagedWidget "meter-frame" xmFrameWidgetClass parent
- (append (list XmNshadowType XmSHADOW_ETCHED_IN
- XmNwidth width
- XmNheight height
- XmNshadowThickness (if (> width 500) 6 3))
- args)))
- (meter (XtCreateManagedWidget "meter" xmDrawingAreaWidgetClass frame
- (if resizable
- (list XmNbackground (white-pixel)
- XmNforeground (black-pixel)
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM)
- (list XmNbackground (white-pixel)
- XmNforeground (black-pixel)
- XmNwidth width
- XmNheight height
- XmNresizePolicy XmRESIZE_NONE
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM))))
- (context (list meter 0.0 1.0 0.0 0.0 width height)))
- (XtAddCallback meter XmNexposeCallback
- (lambda (w c i)
- (display-level c))
- context)
- (if resizable
- (XtAddCallback meter XmNresizeCallback
- (lambda (w c i)
- (list-set! c 5 (cadr (XtGetValues w (list XmNwidth 0))))
- (list-set! c 6 (cadr (XtGetValues w (list XmNheight 0))))
- (display-level c))
- context))
- context))
-
-(define (display-level meter-data)
- "(display-level meter-data) displays a VU level meter"
- (let* ((meter (car meter-data))
- (level (list-ref meter-data 1))
- (last-level (list-ref meter-data 3))
- (red-deg (list-ref meter-data 4))
- (width (list-ref meter-data 5))
- (height (list-ref meter-data 6))
- ;; (size (list-ref meter-data 2))
- (dpy (XtDisplay meter))
- (win (XtWindow meter))
- (major-tick (round (/ width 24)))
- (minor-tick (round (* major-tick .6)))
- (ang0 (* 45 64))
- (ang1 (* 90 64))
- (wid2 (floor (/ width 2)))
- (gc (car (snd-gcs)))
- (top (round (/ height 3.2)))) ; distance of label from top of meter
- (if (and (> top 10)
- (> width 10)
- (> height 10))
- (begin
- (XSetForeground dpy gc (white-pixel))
- (XFillRectangle dpy win gc 0 0 width height)
- (XSetForeground dpy gc (black-pixel))
- (XDrawArc dpy win gc 0 top width width ang0 ang1)
- (XDrawArc dpy win gc 0 (- top 1) width width ang0 ang1)
- (if (> width 100)
- (XDrawArc dpy win gc 0 (- top 2) width width ang0 ang1))
- (XDrawArc dpy win gc 4 (+ top 4) (- width 8) (- width 8) ang0 ang1)
+
+ (define make-level-meter
+ (let ((documentation "(make-level-meter parent width height args (resizable #t)) makes a VU level meter"))
+ (lambda* (parent width height args (resizable #t))
+ (let* ((frame (XtCreateManagedWidget "meter-frame" xmFrameWidgetClass parent
+ (append (list XmNshadowType XmSHADOW_ETCHED_IN
+ XmNwidth width
+ XmNheight height
+ XmNshadowThickness (if (> width 500) 6 3))
+ args)))
+ (meter (XtCreateManagedWidget "meter" xmDrawingAreaWidgetClass frame
+ (if resizable
+ (list XmNbackground (white-pixel)
+ XmNforeground (black-pixel)
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM)
+ (list XmNbackground (white-pixel)
+ XmNforeground (black-pixel)
+ XmNwidth width
+ XmNheight height
+ XmNresizePolicy XmRESIZE_NONE
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM))))
+ (context (list meter 0.0 1.0 0.0 0.0 width height)))
+ (XtAddCallback meter XmNexposeCallback
+ (lambda (w c i)
+ (display-level c))
+ context)
+ (if resizable
+ (XtAddCallback meter XmNresizeCallback
+ (lambda (w c i)
+ (set! (c 5) (cadr (XtGetValues w (list XmNwidth 0))))
+ (set! (c 6) (cadr (XtGetValues w (list XmNheight 0))))
+ (display-level c))
+ context))
+ context))))
+
+ (define display-level
+ (let ((documentation "(display-level meter-data) displays a VU level meter"))
+ (lambda (meter-data)
+ (let* ((meter (car meter-data))
+ (level (meter-data 1))
+ (last-level (meter-data 3))
+ (red-deg (meter-data 4))
+ (width (meter-data 5))
+ (height (meter-data 6))
+ ;; (size (meter-data 2))
+ (dpy (XtDisplay meter))
+ (win (XtWindow meter))
+ (major-tick (round (/ width 24)))
+ (minor-tick (round (* major-tick .6)))
+ (ang0 (* 45 64))
+ (ang1 (* 90 64))
+ (wid2 (floor (/ width 2)))
+ (gc (car (snd-gcs)))
+ (top (round (/ height 3.2)))) ; distance of label from top of meter
+ (if (and (> top 10)
+ (> width 10)
+ (> height 10))
+ (begin
+ (XSetForeground dpy gc (white-pixel))
+ (XFillRectangle dpy win gc 0 0 width height)
+ (XSetForeground dpy gc (black-pixel))
+ (XDrawArc dpy win gc 0 top width width ang0 ang1)
+ (XDrawArc dpy win gc 0 (- top 1) width width ang0 ang1)
+ (if (> width 100)
+ (XDrawArc dpy win gc 0 (- top 2) width width ang0 ang1))
+ (XDrawArc dpy win gc 4 (+ top 4) (- width 8) (- width 8) ang0 ang1)
+ (do ((i 0 (+ i 1)))
+ ((= i 5))
+ (let* ((rdeg (degrees->radians (- 45 (* i 22.5))))
+ (sinr (sin rdeg))
+ (cosr (cos rdeg))
+ (x0 (round (+ wid2 (* wid2 sinr))))
+ (y0 (round (- (+ wid2 top) (* wid2 cosr))))
+ (x1 (round (+ wid2 (* (+ wid2 major-tick) sinr))))
+ (y1 (round (- (+ wid2 top) (* (+ wid2 major-tick) cosr)))))
+ (XDrawLine dpy win gc x0 y0 x1 y1)
+ (XDrawLine dpy win gc (+ x0 1) y0 (+ x1 1) y1)
+ (if (< i 4)
+ (do ((j 1 (+ 1 j)))
+ ((= j 6))
+ (let* ((rdeg (degrees->radians (- 45 (* i 22.5) (* j (/ 90.0 20.0)))))
+ (sinr (sin rdeg))
+ (cosr (cos rdeg))
+ (x0 (round (* wid2 (+ 1.0 sinr))))
+ (y0 (round (- (+ wid2 top) (* wid2 cosr))))
+ (x1 (round (+ wid2 (* (+ wid2 minor-tick) sinr))))
+ (y1 (round (- (+ wid2 top) (* (+ wid2 minor-tick) cosr)))))
+ (XDrawLine dpy win gc x0 y0 x1 y1))))))
+ (let* ((needle-speed 0.25)
+ (bubble-speed 0.025)
+ (bubble-size (* 15 64))
+ (val (+ (* level needle-speed) (* last-level (- 1.0 needle-speed))))
+ (deg (- (* val 90.0) 45.0))
+ (rdeg (degrees->radians deg))
+ (nx1 (round (+ wid2 (* (+ wid2 major-tick) (sin rdeg)))))
+ (ny1 (round (- (+ wid2 top) (* (+ wid2 major-tick) (cos rdeg))))))
+ (XDrawLine dpy win gc wid2 (+ top wid2) nx1 ny1)
+ (set! (meter-data 3) val)
+ (if (> val red-deg)
+ (set! (meter-data 4) val)
+ (set! (meter-data 4) (+ (* val bubble-speed) (* red-deg (- 1.0 bubble-speed)))))
+ (if (> (meter-data 4) .01)
+ (begin
+ (XSetForeground dpy gc (red-pixel))
+ (let* ((redx (floor (* (meter-data 4) 90 64)))
+ (redy (min redx bubble-size)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (XDrawArc dpy win gc i (+ top i) (- width (* i 2)) (- width (* i 2)) (- (* 135 64) redx) redy))
+ (XSetForeground dpy gc (black-pixel))))))))))))
+
+ (define with-level-meters
+ (let ((documentation "(with-level-meters n) adds 'n' level meters to a pane at the top of the Snd window"))
+ (lambda (n)
+ (let* ((parent ((main-widgets) 3))
+ (height 70)
+ (width (floor (/ (cadr (XtGetValues parent (list XmNwidth 0))) n)))
+ (meters (XtCreateManagedWidget "meters" xmFormWidgetClass parent
+ (list XmNpositionIndex 0 ; top pane
+ XmNbackground *basic-color*
+ XmNfractionBase (* n 10)
+ XmNpaneMinimum height)))
+ (meter-list ()))
(do ((i 0 (+ i 1)))
- ((= i 5))
- (let* ((rdeg (degrees->radians (- 45 (* i 22.5))))
- (sinr (sin rdeg))
- (cosr (cos rdeg))
- (x0 (round (+ wid2 (* wid2 sinr))))
- (y0 (round (- (+ wid2 top) (* wid2 cosr))))
- (x1 (round (+ wid2 (* (+ wid2 major-tick) sinr))))
- (y1 (round (- (+ wid2 top) (* (+ wid2 major-tick) cosr)))))
- (XDrawLine dpy win gc x0 y0 x1 y1)
- (XDrawLine dpy win gc (+ x0 1) y0 (+ x1 1) y1)
- (if (< i 4)
- (do ((j 1 (+ 1 j)))
- ((= j 6))
- (let* ((rdeg (degrees->radians (- 45 (* i 22.5) (* j (/ 90.0 20.0)))))
- (sinr (sin rdeg))
- (cosr (cos rdeg))
- (x0 (round (* wid2 (+ 1.0 sinr))))
- (y0 (round (- (+ wid2 top) (* wid2 cosr))))
- (x1 (round (+ wid2 (* (+ wid2 minor-tick) sinr))))
- (y1 (round (- (+ wid2 top) (* (+ wid2 minor-tick) cosr)))))
- (XDrawLine dpy win gc x0 y0 x1 y1))))))
- (let* ((needle-speed 0.25)
- (bubble-speed 0.025)
- (bubble-size (* 15 64))
- (val (+ (* level needle-speed) (* last-level (- 1.0 needle-speed))))
- (deg (- (* val 90.0) 45.0))
- (rdeg (degrees->radians deg))
- (nx1 (round (+ wid2 (* (+ wid2 major-tick) (sin rdeg)))))
- (ny1 (round (- (+ wid2 top) (* (+ wid2 major-tick) (cos rdeg))))))
- (XDrawLine dpy win gc wid2 (+ top wid2) nx1 ny1)
- (list-set! meter-data 3 val)
- (if (> val red-deg)
- (list-set! meter-data 4 val)
- (list-set! meter-data 4 (+ (* val bubble-speed) (* red-deg (- 1.0 bubble-speed)))))
- (if (> (list-ref meter-data 4) .01)
- (begin
- (XSetForeground dpy gc (red-pixel))
- (let* ((redx (floor (* (list-ref meter-data 4) 90 64)))
- (redy (min redx bubble-size)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (XDrawArc dpy win gc i (+ top i) (- width (* i 2)) (- width (* i 2)) (- (* 135 64) redx) redy))
- (XSetForeground dpy gc (black-pixel))))))))))
-
-(define (with-level-meters n)
- "(with-level-meters n) adds 'n' level meters to a pane at the top of the Snd window"
- (let* ((parent (list-ref (main-widgets) 3))
- (height 70)
- (width (floor (/ (cadr (XtGetValues parent (list XmNwidth 0))) n)))
- (meters (XtCreateManagedWidget "meters" xmFormWidgetClass parent
- (list XmNpositionIndex 0 ; top pane
- XmNbackground (basic-color)
- XmNfractionBase (* n 10)
- XmNpaneMinimum height)))
- (meter-list '()))
- (do ((i 0 (+ i 1)))
- ((= i n))
- (set! meter-list
- (cons (make-level-meter meters width height
- (list XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNleftAttachment XmATTACH_POSITION
- XmNleftPosition (* i 10)
- XmNrightAttachment XmATTACH_POSITION
- XmNrightPosition (* (+ 1 i) 10)))
- meter-list)))
- (hook-push dac-hook
- (lambda (sdobj)
- (let* ((maxes (sound-data-maxamp sdobj)))
- (for-each
- (lambda (meter)
- (if (null? maxes)
- (list-set! meter 1 0.0)
- (begin
- (list-set! meter 1 (car maxes))
- (display-level meter)
- (set! maxes (cdr maxes)))))
- (reverse meter-list)))))
- (hook-push stop-dac-hook
- (lambda () ; drain away the bubble
- (XtAppAddWorkProc (car (main-widgets))
- (let ((ctr 0))
- (lambda (ignored)
- (for-each
- (lambda (meter)
- (list-set! meter 1 0.0)
- (display-level meter))
- meter-list)
- (set! ctr (+ ctr 1))
- (> ctr 200))))))
- (XtSetValues meters (list XmNpaneMinimum 1))
- meter-list))
-
-
-
+ ((= i n))
+ (set! meter-list
+ (cons (make-level-meter meters width height
+ (list XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNleftAttachment XmATTACH_POSITION
+ XmNleftPosition (* i 10)
+ XmNrightAttachment XmATTACH_POSITION
+ XmNrightPosition (* (+ 1 i) 10)))
+ meter-list)))
+ (hook-push dac-hook
+ (lambda (hook)
+ (let ((maxes (map float-vector-peak (hook 'data))))
+ (for-each
+ (lambda (meter)
+ (if (null? maxes)
+ (set! (meter 1) 0.0)
+ (begin
+ (set! (meter 1) (car maxes))
+ (display-level meter)
+ (set! maxes (cdr maxes)))))
+ (reverse meter-list)))))
+ (hook-push stop-dac-hook
+ (lambda (hook) ; drain away the bubble
+ (XtAppAddWorkProc (car (main-widgets))
+ (let ((ctr 0))
+ (lambda (ignored)
+ (for-each
+ (lambda (meter)
+ (set! (meter 1) 0.0)
+ (display-level meter))
+ meter-list)
+ (set! ctr (+ ctr 1))
+ (> ctr 200))))))
+ (XtSetValues meters (list XmNpaneMinimum 1))
+ meter-list))))
+|#
+
+
;;; -------- add a drop site
;;;
-;;; this adds a pane to the current channel which can respond to drag-and-drop operations
-;;; (this is a Motif 1.2 style drop -- I've had trouble getting the new style to work at all)
-
-(define make-channel-drop-site
- (lambda args
- "(make-channel-drop-site snd) adds a drop site pane to the current channel"
- (let* ((snd (if (> (length args) 0) (car args) (selected-sound)))
- (chn (selected-channel snd))
- (widget (add-channel-pane snd chn "drop here" xmDrawingAreaWidgetClass
- (list XmNbackground (white-pixel)
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM))))
- (XmDropSiteRegister
- widget
- (list XmNdropSiteOperations XmDROP_COPY
- XmNimportTargets (list XA_STRING) ; list of Atoms we can deal with -- in this case, just strings
- XmNnumImportTargets 1
- XmNdropProc
+;;; this adds a pane to the current channel which can respond to drag-and-drop operations
+;;; (this is a Motif 1.2 style drop -- I've had trouble getting the new style to work at all)
+
+ (define make-channel-drop-site
+ (let ((documentation "(make-channel-drop-site snd) adds a drop site pane to the current channel"))
+ (lambda args
+ (let* ((snd (if (> (length args) 0) (car args) (selected-sound)))
+ (chn (selected-channel snd))
+ (widget (add-channel-pane snd chn "drop here" xmDrawingAreaWidgetClass
+ (list XmNbackground (white-pixel)
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM))))
+ (XmDropSiteRegister
+ widget
+ (list XmNdropSiteOperations XmDROP_COPY
+ XmNimportTargets (list XA_STRING) ; list of Atoms we can deal with -- in this case, just strings
+ XmNnumImportTargets 1
+ XmNdropProc
+ (lambda (w c i)
+ ;; i is the callback data (XmDropProcCallbackStruct), c is always #f
+ (if (or (not (= (.dropAction i) XmDROP))
+ (not (= (.operation i) XmDROP_COPY)))
+ (set! (.dropSiteStatus i) XmINVALID_DROP_SITE)
+ (begin
+ (set! (.operation i) XmDROP_COPY) ; tell system drop has succeeded
+ (XmDropTransferStart
+ (.dragContext i)
+ (list XmNdropTransfers (list XA_STRING)
+ XmNnumDropTransfers 1
+ XmNtransferProc
+ (lambda (w context selection type val len fmt)
+ ;; the actual in-coming string (properly terminated in xm.c) is 'value'
+ (snd-print (format #f "got: ~A ~A ~A ~A ~A ~A ~A~%"
+ w context selection type val len fmt))))))))))))))
+
+
+;;; -------- change a drop callback
+;;;
+;;; drop arg is 3-arg func: filename snd chn
+
+ (define set-channel-drop
+ (let ((documentation "(set-channel-drop drop snd chn) changes a drop callback function; 'drop' is function of 3 args (filename snd chn)"))
+ (lambda (drop snd chn)
+ (XmDropSiteUpdate
+ (car (channel-widgets snd chn))
+ (list XmNdropProc
(lambda (w c i)
- ;; i is the callback data (XmDropProcCallbackStruct), c is always #f
(if (or (not (= (.dropAction i) XmDROP))
(not (= (.operation i) XmDROP_COPY)))
(set! (.dropSiteStatus i) XmINVALID_DROP_SITE)
(begin
- (set! (.operation i) XmDROP_COPY) ; tell system drop has succeeded
+ (set! (.operation i) XmDROP_COPY)
(XmDropTransferStart
- (.dragContext i)
- (list XmNdropTransfers (list XA_STRING)
- XmNnumDropTransfers 1
- XmNtransferProc
- (lambda (w context selection type val len fmt)
- ;; the actual in-coming string (properly terminated in xm.c) is 'value'
- (snd-print (format #f "got: ~A ~A ~A ~A ~A ~A ~A~%"
- w context selection type val len fmt)))))))))))))
-
-
-;;; -------- change a drop callback
-;;;
-;;; drop arg is 3-arg func: filename snd chn
-
-(define (set-channel-drop drop snd chn)
- "(set-channel-drop drop snd chn) changes a drop callback function; 'drop' is function of 3 args (filename snd chn)"
- (XmDropSiteUpdate
- (car (channel-widgets snd chn))
- (list XmNdropProc
- (lambda (w c i)
- (if (or (not (= (.dropAction i) XmDROP))
- (not (= (.operation i) XmDROP_COPY)))
- (set! (.dropSiteStatus i) XmINVALID_DROP_SITE)
- (begin
- (set! (.operation i) XmDROP_COPY)
- (XmDropTransferStart
- (.dragContext i)
- (list XmNdropTransfers (list (XInternAtom (XtDisplay (cadr (main-widgets))) "FILE_NAME" #f))
-
- ;; this is saying that the in-coming drag-and-drop is expected to pass us a FILE_NAME atom
- ;; to find out what Atoms the selection translator can handle, use
- ;; (XtVaGetValues (.dragContext i) (list XmNexportTargets 0))
- ;; which will return a list of acceptable Atoms
-
- XmNnumDropTransfers 1
- XmNtransferProc
- (lambda (w context selection type val len fmt)
- (drop val snd chn))))))))))
-
-
+ (.dragContext i)
+ (list XmNdropTransfers (list (XInternAtom (XtDisplay (cadr (main-widgets))) "FILE_NAME" #f))
+
+ ;; this is saying that the in-coming drag-and-drop is expected to pass us a FILE_NAME atom
+ ;; to find out what Atoms the selection translator can handle, use
+ ;; (XtVaGetValues (.dragContext i) (list XmNexportTargets 0))
+ ;; which will return a list of acceptable Atoms
+
+ XmNnumDropTransfers 1
+ XmNtransferProc
+ (lambda (w context selection type val len fmt)
+ (drop val snd chn))))))))))))
+
+
;;; -------- show-disk-space
;;;
-;;; adds a label to the minibuffer area showing the current free space
-
-(define showing-disk-space #f) ; for prefs dialog
-
-(define show-disk-space
- (let ((labelled-snds '()))
- (define (kmg num)
- (if (<= num 0)
- "disk full!"
- (if (> num 1024)
- (if (> num (* 1024 1024))
- (format #f "space: ~6,3FG" (/ num (* 1024.0 1024.0)))
- (format #f "space: ~6,3FM" (/ num 1024.0)))
- (format #f "space: ~10DK" num))))
- (define (show-label data id)
- (if (sound? (car data))
- (let* ((space (kmg (disk-kspace (file-name (car data)))))
- (str (XmStringCreateLocalized space)))
- (XtSetValues (cadr data) (list XmNlabelString str))
- (XmStringFree str)
- (XtAppAddTimeOut (caddr data) 10000 show-label data))))
- (lambda* (snd-arg)
- "(show-disk-space) adds a label to the minibuffer area showing the current free space (for use with after-open-hook)"
- (let* ((snd (or snd-arg (selected-sound)))
- (previous-label (find-if (lambda (n) (equal? (car n) snd)) labelled-snds)))
- (if (not previous-label)
- (if (not snd)
- (snd-error "no sound found for disk space label")
- (let* ((app (car (main-widgets)))
- (widgets (sound-widgets snd))
- (minibuffer (list-ref widgets 3))
- (unite-button (list-ref widgets 6))
- (sync-button (list-ref widgets 9))
- (name-form (XtParent minibuffer)) ; "snd-name-form"
- (space (kmg (disk-kspace (file-name snd))))
- (str (XmStringCreateLocalized space)))
- (set! showing-disk-space #t)
- (XtUnmanageChild minibuffer)
- (XtVaSetValues minibuffer (list XmNrightAttachment XmATTACH_NONE))
- (let ((new-label (XtCreateManagedWidget "space:" xmLabelWidgetClass name-form
- (list XmNbackground (basic-color)
- XmNleftAttachment XmATTACH_NONE
- XmNlabelString str
- XmNrightAttachment XmATTACH_WIDGET
- XmNrightWidget (if (XtIsManaged unite-button)
- unite-button
- sync-button)
- XmNtopAttachment XmATTACH_FORM))))
- (XtVaSetValues minibuffer (list XmNrightWidget new-label XmNrightAttachment XmATTACH_WIDGET))
- (XtManageChild minibuffer)
- (XmStringFree str)
- (set! previous-label (list snd new-label app))
- (set! labelled-snds (cons previous-label labelled-snds))
- (XtAppAddTimeOut (caddr previous-label) 10000 show-label previous-label)))))))))
-
-
-
+;;; adds a label to the status-area area showing the current free space
+
+ (define showing-disk-space #f) ; for prefs dialog
+
+ (define show-disk-space
+ (let ((labelled-snds ()))
+ (define (kmg num)
+ (if (<= num 0)
+ "disk full!"
+ (if (> num 1024)
+ (if (> num (* 1024 1024))
+ (format #f "space: ~6,3FG" (/ num (* 1024.0 1024.0)))
+ (format #f "space: ~6,3FM" (/ num 1024.0)))
+ (format #f "space: ~10DK" num))))
+ (define (show-label data id)
+ (if (sound? (car data))
+ (let* ((space (kmg (disk-kspace (file-name (car data)))))
+ (str (XmStringCreateLocalized space)))
+ (XtSetValues (cadr data) (list XmNlabelString str))
+ (XmStringFree str)
+ (XtAppAddTimeOut (caddr data) 10000 show-label data))))
+
+ (let ((documentation "(show-disk-space snd) adds a label to snd's status-area area showing the current free space (for use with after-open-hook)"))
+ (lambda (hook)
+ (let* ((snd (hook 'snd))
+ (previous-label (find-if (lambda (n) (equal? (car n) snd)) labelled-snds)))
+ (if (not previous-label)
+ (if (not snd)
+ (snd-error "no sound found for disk space label")
+ (let* ((app (car (main-widgets)))
+ (widgets (sound-widgets snd))
+ (status-area (widgets 3))
+ (unite-button (widgets 6))
+ (sync-button (widgets 9))
+ (name-form (XtParent status-area)) ; "snd-name-form"
+ (space (kmg (disk-kspace (file-name snd))))
+ (str (XmStringCreateLocalized space)))
+ (set! showing-disk-space #t)
+ (XtUnmanageChild status-area)
+ (XtVaSetValues status-area (list XmNrightAttachment XmATTACH_NONE))
+ (let ((new-label (XtCreateManagedWidget "space:" xmLabelWidgetClass name-form
+ (list XmNbackground *basic-color*
+ XmNleftAttachment XmATTACH_NONE
+ XmNlabelString str
+ XmNrightAttachment XmATTACH_WIDGET
+ XmNrightWidget (if (XtIsManaged unite-button)
+ unite-button
+ sync-button)
+ XmNtopAttachment XmATTACH_FORM))))
+ (XtVaSetValues status-area (list XmNrightWidget new-label XmNrightAttachment XmATTACH_WIDGET))
+ (XtManageChild status-area)
+ (XmStringFree str)
+ (set! previous-label (list snd new-label app))
+ (set! labelled-snds (cons previous-label labelled-snds))
+ (XtAppAddTimeOut (caddr previous-label) 10000 show-label previous-label))))))))))
+
+
+
;;; -------- add amp sliders in control panel for multi-channel sounds
;;;
;;; use control-button to move all at once
;;;
;;; the max scrollbar value can change (it's now 10000), so ideally this code should notice it
-
-(define (add-amp-controls)
- "(add-amp-controls) adds amplitude sliders to the control panel for each channel in multi-channel sounds"
-
- (define (label-name chan) (if (= chan 0) "amp-label" (format #f "amp-label-~D" chan)))
- (define (number-name chan) (if (= chan 0) "amp-number" (format #f "amp-number-~D" chan)))
- (define (scroller-name chan) (if (= chan 0) "amp" (format #f "amp-~D" chan)))
-
- (define (amp->scroll minval val maxval)
- (if (<= val minval) 0
- (if (>= val maxval) 9000
- (if (>= val 1.0)
- (floor (* 4500 (+ 1.0 (/ (- val 1.0) (- maxval 1.0)))))
- (floor (* 4500 (/ (- val minval) (- 1.0 minval))))))))
-
- (define (scroll->amp snd val)
- (if (<= val 0)
- (car (amp-control-bounds snd))
- (if (>= val 9000)
- (cadr (amp-control-bounds snd))
- (if (> val 4500)
- (+ (* (- (/ val 4500.0) 1.0) (- (cadr (amp-control-bounds snd)) 1.0)) 1.0)
- (+ (* val (/ (- 1.0 (car (amp-control-bounds snd))) 4500.0)) (car (amp-control-bounds snd)))))))
-
- (define (amp-callback w c info)
- ;; c is (list number-widget snd chan)
- (let* ((snd (cadr c))
- (amp (scroll->amp snd (.value info)))
- (ampstr (XmStringCreateLocalized (format #f "~,3F " amp)))
- (top-chn (- (channels snd) 1))
- (chn (- top-chn (caddr c)))
- (ctrl (and (.event info) (not (= (logand (.state (.event info)) ControlMask) 0)))))
- (XtSetValues (car c) (list XmNlabelString ampstr))
- (XmStringFree ampstr)
- (if ctrl
+
+ (define add-amp-controls
+ (let ((documentation "(add-amp-controls) adds amplitude sliders to the control panel for each channel in multi-channel sounds"))
+ (lambda ()
+
+ (define (label-name chan) (if (= chan 0) "amp-label" (format #f "amp-label-~D" chan)))
+ (define (number-name chan) (if (= chan 0) "amp-number" (format #f "amp-number-~D" chan)))
+ (define (scroller-name chan) (if (= chan 0) "amp" (format #f "amp-~D" chan)))
+
+ (define (amp->scroll minval val maxval)
+ (if (<= val minval) 0
+ (if (>= val maxval) 9000
+ (if (>= val 1.0)
+ (floor (* 4500 (+ 1.0 (/ (- val 1.0) (- maxval 1.0)))))
+ (floor (* 4500 (/ (- val minval) (- 1.0 minval))))))))
+
+ (define (scroll->amp snd val)
+ (if (<= val 0)
+ (car (amp-control-bounds snd))
+ (if (>= val 9000)
+ (cadr (amp-control-bounds snd))
+ (if (> val 4500)
+ (+ (* (- (/ val 4500.0) 1.0) (- (cadr (amp-control-bounds snd)) 1.0)) 1.0)
+ (+ (* val (/ (- 1.0 (car (amp-control-bounds snd))) 4500.0)) (car (amp-control-bounds snd)))))))
+
+ (define (amp-callback w c info)
+ ;; c is (list number-widget snd chan)
+ (let* ((snd (cadr c))
+ (amp (scroll->amp snd (.value info)))
+ (ampstr (XmStringCreateLocalized (format #f "~,3F " amp)))
+ (top-chn (- (channels snd) 1))
+ (chn (- top-chn (caddr c)))
+ (ctrl (and (.event info) (not (= (logand (.state (.event info)) ControlMask) 0)))))
+ (XtSetValues (car c) (list XmNlabelString ampstr))
+ (XmStringFree ampstr)
+ (if ctrl
+ (let* ((wids (sound-widgets snd))
+ (ctrls (wids 2))
+ (snd-amp (find-child ctrls "snd-amp"))
+ (chns (channels snd)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (let* ((ampscr (find-child snd-amp (scroller-name i)))
+ (ampvals (XmScrollBarGetValues ampscr)))
+ (XmScrollBarSetValues ampscr (.value info) (cadr ampvals) (caddr ampvals) (cadddr ampvals) #t)
+ (set! (amp-control snd i) amp))))
+ (set! (amp-control snd chn) amp))))
+
+ (define (reset-to-one scroller number)
+ (XtSetValues scroller (list XmNvalue 4500))
+ (let ((ampstr (XmStringCreateLocalized "1.000 ")))
+ (XtSetValues number (list XmNlabelString ampstr))
+ (XmStringFree ampstr)))
+
+ (define (make-amp-control snd chan parent)
+ (let* ((s1 (XmStringCreateLocalized "amp:"))
+ (label (XtCreateManagedWidget (label-name chan) xmPushButtonWidgetClass parent
+ (list XmNbackground *basic-color*
+ XmNalignment XmALIGNMENT_BEGINNING
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_NONE
+ XmNlabelString s1
+ XmNmarginHeight 1
+ XmNrecomputeSize #f
+ XmNshadowThickness 0
+ XmNhighlightThickness 0
+ XmNfillOnArm #f)))
+ (s2 (XmStringCreateLocalized "1.000 "))
+ (number (XtCreateManagedWidget (number-name chan) xmLabelWidgetClass parent
+ (list XmNbackground *basic-color*
+ XmNalignment XmALIGNMENT_BEGINNING
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget label
+ XmNbottomAttachment XmATTACH_NONE
+ XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget label
+ XmNrightAttachment XmATTACH_NONE
+ XmNlabelString s2
+ XmNmarginHeight 1
+ XmNmarginRight 3
+ XmNrecomputeSize #f)))
+ (scroll (XtCreateManagedWidget (scroller-name chan) xmScrollBarWidgetClass parent
+ (list XmNbackground *position-color*
+ XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
+ XmNtopWidget label
+ XmNbottomAttachment XmATTACH_NONE
+ XmNheight 16
+ XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget number
+ XmNrightAttachment XmATTACH_FORM
+ XmNorientation XmHORIZONTAL
+ XmNmaximum 10000
+ XmNvalue 4500
+ XmNdragCallback (list amp-callback (list number snd chan))
+ XmNvalueChangedCallback (list amp-callback (list number snd chan))))))
+ (XtOverrideTranslations scroll
+ (XtParseTranslationTable "c<Btn1Down>: Select()
+ c<Btn1Motion>: Moved()
+ c<Btn1Up>: Release()"))
+
+ (XtAddCallback label XmNactivateCallback (lambda (w c i)
+ (reset-to-one scroll number)))
+ (XmStringFree s1)
+ (XmStringFree s2)
+ label))
+
+ (define (amp-controls-reflect-chans snd)
(let* ((wids (sound-widgets snd))
- (ctrls (list-ref wids 2))
+ (ctrls (wids 2))
(snd-amp (find-child ctrls "snd-amp"))
(chns (channels snd)))
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (let* ((ampscr (find-child snd-amp (scroller-name i)))
- (ampvals (XmScrollBarGetValues ampscr)))
- (XmScrollBarSetValues ampscr (.value info) (cadr ampvals) (caddr ampvals) (cadddr ampvals) #t)
- (set! (amp-control snd i) amp))))
- (set! (amp-control snd chn) amp))))
-
- (define (reset-to-one scroller number)
- (XtSetValues scroller (list XmNvalue 4500))
- (let ((ampstr (XmStringCreateLocalized "1.000 ")))
- (XtSetValues number (list XmNlabelString ampstr))
- (XmStringFree ampstr)))
-
- (define (make-amp-control snd chan parent)
- (let* ((s1 (XmStringCreateLocalized "amp:"))
- (label (XtCreateManagedWidget (label-name chan) xmPushButtonWidgetClass parent
- (list XmNbackground (basic-color)
- XmNalignment XmALIGNMENT_BEGINNING
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_NONE
- XmNlabelString s1
- XmNmarginHeight 1
- XmNrecomputeSize #f
- XmNshadowThickness 0
- XmNhighlightThickness 0
- XmNfillOnArm #f)))
- (s2 (XmStringCreateLocalized "1.000 "))
- (number (XtCreateManagedWidget (number-name chan) xmLabelWidgetClass parent
- (list XmNbackground (basic-color)
- XmNalignment XmALIGNMENT_BEGINNING
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget label
- XmNbottomAttachment XmATTACH_NONE
- XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget label
- XmNrightAttachment XmATTACH_NONE
- XmNlabelString s2
- XmNmarginHeight 1
- XmNmarginRight 3
- XmNrecomputeSize #f)))
- (scroll (XtCreateManagedWidget (scroller-name chan) xmScrollBarWidgetClass parent
- (list XmNbackground (position-color)
- XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
- XmNtopWidget label
- XmNbottomAttachment XmATTACH_NONE
- XmNheight 16
- XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget number
- XmNrightAttachment XmATTACH_FORM
- XmNorientation XmHORIZONTAL
- XmNmaximum 10000
- XmNvalue 4500
- XmNdragCallback (list amp-callback (list number snd chan))
- XmNvalueChangedCallback (list amp-callback (list number snd chan))))))
- (XtOverrideTranslations scroll
- (XtParseTranslationTable "c<Btn1Down>: Select()
- c<Btn1Motion>: Moved()
- c<Btn1Up>: Release()"))
-
- (XtAddCallback label XmNactivateCallback (lambda (w c i)
- (reset-to-one scroll number)))
- (XmStringFree s1)
- (XmStringFree s2)
- label))
-
- (define (amp-controls-reflect-chans snd)
- (let* ((wids (sound-widgets snd))
- (ctrls (list-ref wids 2))
- (snd-amp (find-child ctrls "snd-amp"))
- (chns (channels snd)))
-
- (if (Widget? snd-amp)
- (let ((height (cadr (XtGetValues ctrls (list XmNheight 0))))
- (panemin (cadr (XtGetValues ctrls (list XmNpaneMinimum 0))))
- (panemax (cadr (XtGetValues ctrls (list XmNpaneMaximum 0)))))
- (XtUnmanageChild ctrls)
-
- (if (not (sound-property 'amp-controls snd))
- (let ((orig-amp (find-child snd-amp "amp")))
- (XtOverrideTranslations orig-amp
- (XtParseTranslationTable "c<Btn1Down>: Select()
+
+ (if (Widget? snd-amp)
+ (let ((height (cadr (XtGetValues ctrls (list XmNheight 0))))
+ (panemin (cadr (XtGetValues ctrls (list XmNpaneMinimum 0))))
+ (panemax (cadr (XtGetValues ctrls (list XmNpaneMaximum 0)))))
+ (XtUnmanageChild ctrls)
+
+ (if (not (sound-property 'amp-controls snd))
+ (let ((orig-amp (find-child snd-amp "amp")))
+ (XtOverrideTranslations orig-amp
+ (XtParseTranslationTable "c<Btn1Down>: Select()
c<Btn1Motion>: Moved()
c<Btn1Up>: Release()"))
- (XtAddCallback orig-amp XmNdragCallback
- (lambda (w c info)
- (if (and (.event info) (not (= (logand (.state (.event info)) ControlMask) 0)))
- (do ((i 1 (+ i 1)))
- ((= i chns))
- (let* ((ampscr (find-child snd-amp (scroller-name i)))
- (ampvals (XmScrollBarGetValues ampscr)))
- (XmScrollBarSetValues ampscr (.value info) (cadr ampvals) (caddr ampvals) (cadddr ampvals) #t))))))))
- (let ((existing-controls (or (sound-property 'amp-controls snd) 1)))
- (if (< existing-controls chns)
- (begin
- (if (> height 20)
- (set! height (+ height (* 18 (- chns existing-controls)))))
- (do ((i existing-controls (+ i 1)))
+ (XtAddCallback orig-amp XmNdragCallback
+ (lambda (w c info)
+ (if (and (.event info) (not (= (logand (.state (.event info)) ControlMask) 0)))
+ (do ((i 1 (+ i 1)))
+ ((= i chns))
+ (let* ((ampscr (find-child snd-amp (scroller-name i)))
+ (ampvals (XmScrollBarGetValues ampscr)))
+ (XmScrollBarSetValues ampscr (.value info) (cadr ampvals) (caddr ampvals) (cadddr ampvals) #t))))))))
+ (let ((existing-controls (or (sound-property 'amp-controls snd) 1)))
+ (if (< existing-controls chns)
+ (begin
+ (if (> height 20)
+ (set! height (+ height (* 18 (- chns existing-controls)))))
+ (do ((i existing-controls (+ i 1)))
+ ((= i chns))
+ (make-amp-control snd i snd-amp))
+ (set! (sound-property 'amp-controls snd) chns)
+ (set! existing-controls chns)))
+ (do ((i 0 (+ i 1)))
+ ((= i existing-controls))
+ (let ((ampc (find-child snd-amp (label-name i)))
+ (ampn (find-child snd-amp (number-name i)))
+ (amp (find-child snd-amp (scroller-name i))))
+ (XtUnmanageChild ampc)
+ (XtUnmanageChild ampn)
+ (XtUnmanageChild amp)))
+ (do ((i 0 (+ i 1)))
((= i chns))
- (make-amp-control snd i snd-amp))
- (set! (sound-property 'amp-controls snd) chns)
- (set! existing-controls chns)))
- (do ((i 0 (+ i 1)))
- ((= i existing-controls))
- (let ((ampc (find-child snd-amp (label-name i)))
- (ampn (find-child snd-amp (number-name i)))
- (amp (find-child snd-amp (scroller-name i))))
- (XtUnmanageChild ampc)
- (XtUnmanageChild ampn)
- (XtUnmanageChild amp)))
- (do ((i 0 (+ i 1)))
- ((= i chns))
- (let ((ampc (find-child snd-amp (label-name i)))
- (ampn (find-child snd-amp (number-name i)))
- (amp (find-child snd-amp (scroller-name i)))
- (next-amp (if (< i (- chns 1))
- (find-child snd-amp (label-name (+ i 1)))
- #f)))
- (reset-to-one amp ampn)
- (if next-amp
- (XtSetValues ampc (list XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget next-amp))
- (XtSetValues ampc (list XmNtopAttachment XmATTACH_FORM)))
- (XtManageChild ampc)
- (XtManageChild ampn)
- (XtManageChild amp))))
-
- (XtSetValues ctrls (list XmNpaneMinimum height XmNpaneMaximum height))
- (XtManageChild ctrls)
- (XtSetValues ctrls (list XmNpaneMinimum panemin XmNpaneMaximum panemax))))))
-
- (define (amp-controls-clear snd)
- (if (> (channels snd) 1)
- (let* ((wids (sound-widgets snd))
- (ctrls (list-ref wids 2))
- (snd-amp (find-child ctrls "snd-amp"))
- (top (- (channels snd) 1)))
- (do ((i 1 (+ i 1)))
- ((= i (channels snd)))
- (let ((ampn (find-child snd-amp (number-name i)))
- (amp (find-child snd-amp (scroller-name i))))
- (reset-to-one amp ampn)
- (set! (amp-control snd (- top i)) 1.0))))))
-
- (hook-push after-open-hook amp-controls-reflect-chans)
- (hook-push after-apply-controls-hook amp-controls-clear))
-
-;(add-amp-controls)
-
-
+ (let ((ampc (find-child snd-amp (label-name i)))
+ (ampn (find-child snd-amp (number-name i)))
+ (amp (find-child snd-amp (scroller-name i)))
+ (next-amp (and (< i (- chns 1))
+ (find-child snd-amp (label-name (+ i 1))))))
+ (reset-to-one amp ampn)
+ (if next-amp
+ (XtSetValues ampc (list XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget next-amp))
+ (XtSetValues ampc (list XmNtopAttachment XmATTACH_FORM)))
+ (XtManageChild ampc)
+ (XtManageChild ampn)
+ (XtManageChild amp))))
+
+ (XtSetValues ctrls (list XmNpaneMinimum height XmNpaneMaximum height))
+ (XtManageChild ctrls)
+ (XtSetValues ctrls (list XmNpaneMinimum panemin XmNpaneMaximum panemax))))))
+
+ (define (amp-controls-clear snd)
+ (if (> (channels snd) 1)
+ (let* ((wids (sound-widgets snd))
+ (ctrls (wids 2))
+ (snd-amp (find-child ctrls "snd-amp"))
+ (top (- (channels snd) 1)))
+ (do ((i 1 (+ i 1)))
+ ((= i (channels snd)))
+ (let ((ampn (find-child snd-amp (number-name i)))
+ (amp (find-child snd-amp (scroller-name i))))
+ (reset-to-one amp ampn)
+ (set! (amp-control snd (- top i)) 1.0))))))
+
+ (hook-push after-open-hook (lambda (hook) (amp-controls-reflect-chans (hook 'snd))))
+ (hook-push after-apply-controls-hook (lambda (hook) (amp-controls-clear (hook 'snd)))))))
+
+ ;(add-amp-controls)
+
+
;;; -------- remove top level menu
;;;
;;; (remove-main-menu 5) removes the Help menu
-
-(define (remove-main-menu menu)
- "(remove-main-menu menu) removes the specified top-level menu: (remove-main-menu 5) removes the Help menu"
- (let* ((cascade (list-ref (menu-widgets) menu))
- (top (cadr (XtGetValues cascade (list XmNsubMenuId 0)))))
- (XtUnmanageChild cascade)
- (XtUnmanageChild top)))
-
-
+
+ (define remove-main-menu
+ (let ((documentation "(remove-main-menu menu) removes the specified top-level menu: (remove-main-menu 5) removes the Help menu"))
+ (lambda (menu)
+ (let* ((cascade ((menu-widgets) menu))
+ (top (cadr (XtGetValues cascade (list XmNsubMenuId 0)))))
+ (XtUnmanageChild cascade)
+ (XtUnmanageChild top)))))
+
+
;;; -------- add delete and rename options to the file menu
-
-(define (add-delete-option)
- "(add-delete-option) adds a delete (file) option to the File menu"
- (add-to-menu 0 "Delete" ; add Delete option to File menu
- (lambda ()
- ;; close current sound and delete it
- (if (selected-sound)
- (let ((filename (file-name)))
- (close-sound)
- (delete-file filename))))
- 8)) ; place after File:New
-
-(define (add-rename-option)
- "(add-rename-option) adds a rename (file) option to the File menu"
- (let ((rename-dialog #f)
- (rename-text #f))
- (add-to-menu 0 "Rename"
+
+ (define add-delete-option
+ (let ((documentation "(add-delete-option) adds a delete (file) option to the File menu"))
(lambda ()
- ;; open dialog to get new name, save-as that name, open
- (if (not rename-dialog)
- ;; make a standard dialog
- (let* ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Rename" XmFONTLIST_DEFAULT_TAG))
- (new-dialog (XmCreateTemplateDialog
- (cadr (main-widgets)) "Rename"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNokLabelString xok
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNtransient #f))))
- (for-each
- (lambda (button color)
- (XtVaSetValues
- (XmMessageBoxGetChild new-dialog button)
- (list XmNarmColor (selection-color)
- XmNbackground color)))
- (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
- (list (highlight-color) (highlight-color) (highlight-color)))
-
- (XtAddCallback new-dialog XmNcancelCallback
- (lambda (w c i) (XtUnmanageChild w)))
-
- (XtAddCallback new-dialog XmNhelpCallback
- (lambda (w c i)
- (help-dialog "Rename" "give a new file name to rename the currently selected sound")))
-
- (XtAddCallback new-dialog XmNokCallback
- (lambda (w c i)
- (let ((new-name (XmTextFieldGetString rename-text)))
- (if (and (string? new-name)
- (> (string-length new-name) 0)
- (selected-sound))
- (let ((current-name (file-name)))
- (save-sound-as new-name)
- (close-sound)
- (rename-file current-name new-name)
- (open-sound new-name)
- (XtUnmanageChild w))))))
-
- (XmStringFree xhelp)
- (XmStringFree xok)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (set! rename-dialog new-dialog)
-
- (let* ((mainform (XtCreateManagedWidget "formd" xmRowColumnWidgetClass rename-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild rename-dialog XmDIALOG_SEPARATOR)
- XmNorientation XmVERTICAL
- XmNbackground (basic-color))))
- (label (XtCreateManagedWidget "new name:" xmLabelWidgetClass mainform
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color)))))
- (set! rename-text
- (XtCreateManagedWidget "newname" xmTextFieldWidgetClass mainform
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget label
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color))))
- (XtAddEventHandler rename-text EnterWindowMask #f
- (lambda (w context ev flag)
- (XmProcessTraversal w XmTRAVERSE_CURRENT)
- (XtSetValues w (list XmNbackground (white-pixel)))))
- (XtAddEventHandler rename-text LeaveWindowMask #f
- (lambda (w context ev flag)
- (XtSetValues w (list XmNbackground (basic-color))))))))
- (if (not (XtIsManaged rename-dialog))
- (XtManageChild rename-dialog)
- (raise-dialog rename-dialog)))
- 8)))
-
-
-(define (change-label widget new-label)
- "(change-label widget new-label) changes widget's label to new-label"
- (let ((str (XmStringCreateLocalized new-label)))
- (XtSetValues widget (list XmNlabelString str))
- (XmStringFree str)))
-
+ (add-to-menu 0 "Delete" ; add Delete option to File menu
+ (lambda ()
+ ;; close current sound and delete it
+ (if (selected-sound)
+ (let ((filename (file-name)))
+ (close-sound)
+ (delete-file filename))))
+ 8)))) ; place after File:New
+
+ (define add-rename-option
+ (let ((documentation "(add-rename-option) adds a rename (file) option to the File menu"))
+ (lambda ()
+ (let ((rename-dialog #f)
+ (rename-text #f))
+ (add-to-menu 0 "Rename"
+ (lambda ()
+ ;; open dialog to get new name, save-as that name, open
+ (if (not rename-dialog)
+ ;; make a standard dialog
+ (let* ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "Rename" XmFONTLIST_DEFAULT_TAG))
+ (new-dialog (XmCreateTemplateDialog
+ (cadr (main-widgets)) "Rename"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNokLabelString xok
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground *basic-color*
+ XmNtransient #f))))
+ (for-each
+ (lambda (button color)
+ (XtVaSetValues
+ (XmMessageBoxGetChild new-dialog button)
+ (list XmNarmColor *selection-color*
+ XmNbackground color)))
+ (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
+ (list *highlight-color* *highlight-color* *highlight-color*))
+
+ (XtAddCallback new-dialog XmNcancelCallback
+ (lambda (w c i) (XtUnmanageChild w)))
+
+ (XtAddCallback new-dialog XmNhelpCallback
+ (lambda (w c i)
+ (help-dialog "Rename" "give a new file name to rename the currently selected sound")))
+
+ (XtAddCallback new-dialog XmNokCallback
+ (lambda (w c i)
+ (let ((new-name (XmTextFieldGetString rename-text)))
+ (if (and (string? new-name)
+ (> (length new-name) 0)
+ (selected-sound))
+ (let ();(current-name (file-name)))
+ (save-sound-as new-name)
+ (close-sound)
+ ;(rename-file current-name new-name) ; was this from Guile?
+ ;(system (format #f "mv ~A ~A" new-name current-name)) ; surely it should be (delete-file current-name)?
+ (open-sound new-name)
+ (XtUnmanageChild w))))))
+
+ (XmStringFree xhelp)
+ (XmStringFree xok)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+ (set! rename-dialog new-dialog)
+
+ (let* ((mainform (XtCreateManagedWidget "formd" xmRowColumnWidgetClass rename-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild rename-dialog XmDIALOG_SEPARATOR)
+ XmNorientation XmVERTICAL
+ XmNbackground *basic-color*)))
+ (label (XtCreateManagedWidget "new name:" xmLabelWidgetClass mainform
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_NONE
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNbackground *basic-color*))))
+ (set! rename-text
+ (XtCreateManagedWidget "newname" xmTextFieldWidgetClass mainform
+ (list XmNleftAttachment XmATTACH_WIDGET
+ XmNleftWidget label
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNbackground *basic-color*)))
+ (XtAddEventHandler rename-text EnterWindowMask #f
+ (lambda (w context ev flag)
+ (XmProcessTraversal w XmTRAVERSE_CURRENT)
+ (XtSetValues w (list XmNbackground (white-pixel)))))
+ (XtAddEventHandler rename-text LeaveWindowMask #f
+ (lambda (w context ev flag)
+ (XtSetValues w (list XmNbackground *basic-color*)))))))
+ (if (not (XtIsManaged rename-dialog))
+ (XtManageChild rename-dialog)
+ (raise-dialog rename-dialog)))
+ 8)))))
+
+
+ (define change-label
+ (let ((documentation "(change-label widget new-label) changes widget's label to new-label"))
+ (lambda (widget new-label)
+ (let ((str (XmStringCreateLocalized new-label)))
+ (XtSetValues widget (list XmNlabelString str))
+ (XmStringFree str)))))
+
;;; this deletes the play button
-;(hook-push after-open-hook
-; (lambda (snd)
-; (let* ((ctrls (list-ref (sound-widgets snd) 2))
-; (play-button (find-child ctrls "play"))
-; (sync-button (find-child ctrls "sync")))
-; (XtUnmanageChild play-button)
-; (XtVaSetValues sync-button (list XmNrightAttachment XmATTACH_FORM)))))
-
-
+ ;(hook-push after-open-hook
+ ; (lambda (hook)
+ ; (let* ((ctrls ((sound-widgets (hook 'snd)) 2))
+ ; (play-button (find-child ctrls "play"))
+ ; (sync-button (find-child ctrls "sync")))
+ ; (XtUnmanageChild play-button)
+ ; (XtVaSetValues sync-button (list XmNrightAttachment XmATTACH_FORM)))))
+
+
;;; -------- mark-sync-color
;;;
;;; (mark-sync-color "blue")
-
-(define (mark-sync-color new-color)
- "(mark-sync-color new-color) sets the color for sync'd marks"
-
- (define get-color
- (lambda (color-name)
- (let* ((col (XColor))
- (dpy (XtDisplay (cadr (main-widgets))))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr)))
- (if (= (XAllocNamedColor dpy cmap color-name col col) 0)
- (snd-error (format #f "can't allocate ~A" color-name))
- (.pixel col)))))
-
- (let* ((mark-gc (list-ref (snd-gcs) 9))
- (selected-mark-gc (list-ref (snd-gcs) 10))
- (dpy (XtDisplay (cadr (main-widgets))))
- (original-mark-color (list 'Pixel (logxor (cadr (mark-color))
- (cadr (graph-color)))))
- (original-selected-mark-color (list 'Pixel (logxor (cadr (mark-color))
- (cadr (selected-graph-color)))))
- (new-mark-color (list 'Pixel (logxor (cadr (graph-color))
- (cadr (get-color new-color)))))
- (new-selected-mark-color (list 'Pixel (logxor (cadr (selected-graph-color))
- (cadr (get-color new-color))))))
- (if (not (null? (hook-functions draw-mark-hook)))
- (set! (hook-functions draw-mark-hook) '()))
- (hook-push draw-mark-hook
- (lambda (id)
- (if (> (sync id) 0)
- (begin
- (XSetForeground dpy mark-gc new-mark-color)
- (XSetForeground dpy selected-mark-gc new-selected-mark-color))
- (begin
- (XSetForeground dpy mark-gc original-mark-color)
- (XSetForeground dpy selected-mark-gc original-selected-mark-color)))
- #f))))
-
-
-
+
+ (define mark-sync-color
+ (let ((documentation "(mark-sync-color new-color) sets the color for sync'd marks"))
+ (lambda (new-color)
+
+ (define get-color
+ (lambda (color-name)
+ (let* ((col (XColor))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr)))
+ (if (= (XAllocNamedColor dpy cmap color-name col col) 0)
+ (snd-error (format #f "can't allocate ~A" color-name))
+ (.pixel col)))))
+
+ (let ((mark-gc ((snd-gcs) 9))
+ (selected-mark-gc ((snd-gcs) 10))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (original-mark-color (list 'Pixel (logxor (cadr *mark-color*)
+ (cadr *graph-color*))))
+ (original-selected-mark-color (list 'Pixel (logxor (cadr *mark-color*)
+ (cadr *selected-graph-color*))))
+ (new-mark-color (list 'Pixel (logxor (cadr *graph-color*)
+ (cadr (get-color new-color)))))
+ (new-selected-mark-color (list 'Pixel (logxor (cadr *selected-graph-color*)
+ (cadr (get-color new-color))))))
+ (if (pair? (hook-functions draw-mark-hook))
+ (set! (hook-functions draw-mark-hook) ()))
+ (hook-push draw-mark-hook
+ (lambda (hook)
+ (if (> (sync (hook 'id)) 0)
+ (begin
+ (XSetForeground dpy mark-gc new-mark-color)
+ (XSetForeground dpy selected-mark-gc new-selected-mark-color))
+ (begin
+ (XSetForeground dpy mark-gc original-mark-color)
+ (XSetForeground dpy selected-mark-gc original-selected-mark-color)))
+ #f))))))
+
+
+
;;; -------- add "tooltip" to a widget
;;;
;;; (add-tooltip (cadr (channel-widgets)) "the w button")
-
-(define tooltip-shell #f)
-(define tooltip-label #f)
-
-(define (add-tooltip widget tip)
- "(add-tooltip widget tip) adds the tooltip 'tip' to the widget"
- (let ((tool-proc #f)
- (quit-proc #f)
- (timeout 500) ; millisecs after mouse enters widget to tip display
- (quittime 3000) ; millisecs to show tip (if pointer not already moved out of widget)
- (last-time 0)) ; try to squelch "fluttering"
-
- (define (stop-tooltip)
- (if tool-proc
- (begin
- (XtRemoveTimeOut tool-proc)
- (set! tool-proc #f)))
- (if quit-proc
- (begin
- (XtRemoveTimeOut quit-proc)
- (set! quit-proc #f)))
- (if (and tooltip-shell (XtIsManaged tooltip-shell))
- (XtUnmanageChild tooltip-shell)))
-
- (define (start-tooltip ev)
- (if (and (with-tooltips)
- (not tool-proc))
- (set! tool-proc (XtAppAddTimeOut
- (car (main-widgets))
- timeout
- (lambda (data id)
- (if (not tooltip-shell)
- (begin
- (set! tooltip-shell (XtCreatePopupShell
- tip
- overrideShellWidgetClass
- (cadr (main-widgets))
- (list XmNallowShellResize #t)))
- (set! tooltip-label
- (XtCreateManagedWidget
- tip
- xmLabelWidgetClass
- tooltip-shell
- (list XmNrecomputeSize #t
- XmNbackground (highlight-color)))))
- (change-label tooltip-label tip))
- (let ((loc (XtTranslateCoords widget (.x ev) (.y ev))))
- (XtVaSetValues tooltip-shell (list XmNx (car loc) XmNy (cadr loc))))
- (XtManageChild tooltip-shell)
- (set! quit-proc (XtAppAddTimeOut
- (car (main-widgets))
- quittime
- (lambda (data id)
- (XtUnmanageChild tooltip-shell)
- (set! quit-proc #f)))))))))
-
- (XtAddEventHandler widget EnterWindowMask #f
- (lambda (w c ev flag)
- (if (> (- (cadr (.time ev)) last-time) 50)
- (start-tooltip ev))
- (set! last-time (cadr (.time ev)))))
- (XtAddEventHandler widget LeaveWindowMask #f
- (lambda (w c ev flag)
- (set! last-time (cadr (.time ev)))
- (stop-tooltip)))))
-
-(define (menu-option name)
- "(menu-option name) finds the widget associated with a given menu item name"
- (call-with-exit
- (lambda (return)
- (for-each
- (lambda (top-menu)
- (for-each-child
- top-menu
- (lambda (w)
- (let ((option-holder (cadr (XtGetValues w (list XmNsubMenuId 0)))))
- (for-each-child
- option-holder
- (lambda (menu)
- (if (string=? name (XtName menu))
- (return menu)
- (if (XmIsCascadeButton menu)
- (let ((options (cadr (XtGetValues menu (list XmNsubMenuId 0)))))
- (for-each-child
- options
- (lambda (inner-menu)
- (if (string=? name (XtName inner-menu))
- (return inner-menu)))))))))))))
- (cdr (menu-widgets)))
- (throw 'no-such-menu (list "menu-option" name)))))
-
-(define (show-all-atoms)
- "(show-all-atoms) displays all current X atom names"
- (let ((i 1)
- (dpy (XtDisplay (cadr (main-widgets))))
- (happy #t))
- (XSetErrorHandler (lambda (dpy err)
- (set! happy #f)
- #f))
- (while happy
- (let ((name (XGetAtomName dpy (list 'Atom i))))
- (if (string? name)
- (display (format #f "~D: ~A~%" i name))
- (set! happy #f)))
- (set! i (+ i 1)))
- (XSetErrorHandler #f)))
-
-
-(define (show-font-name font)
- "(show-font-name font-list) shows the Snd-related name and the X-related name of each font in a font list"
- (define (show-next-font context)
- (let ((next-font (XmFontListGetNextFont context)))
- (if (and next-font (car next-font))
- (begin
- (if (XFontStruct? (caddr next-font))
- (let ((name (XGetFontProperty (caddr next-font) XA_FULL_NAME)))
- (if (not (car name))
- (set! name (XGetFontProperty (caddr next-font) XA_FAMILY_NAME)))
- (snd-print
- (format #f "~A: ~A~%"
- (cadr next-font)
- (XGetAtomName
- (XtDisplay (cadr (main-widgets)))
- (list 'Atom (cadr name))))))
- (snd-print (format #f "no font found!~%")))
- (show-next-font context)))))
- (let ((context (XmFontListInitFontContext font)))
- (if context
- (begin
- (show-next-font context)
- (XmFontListFreeFontContext context))
- "no fonts?")))
-
-
-
-;;; -------- enable C-s and C-r in listener
-
-(define add-find-to-listener
- (let ((dialog #f)
- (find-text #f)
- (find-forward #t)
- (find-new #t)
- (listener-text (list-ref (main-widgets) 4))
- (shell (cadr (main-widgets)))
- (snd-app (car (main-widgets))))
- (lambda ()
-
- (define (start-dialog)
- (if (not dialog)
- (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (xfind (XmStringCreate "Find" XmFONTLIST_DEFAULT_TAG)))
- (set! dialog (XmCreateMessageDialog shell
- "Find"
- (list XmNcancelLabelString xdismiss
- XmNokLabelString xfind
- XmNhelpLabelString xhelp
- XmNautoUnmanage #f
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNtransient #f
- XmNbackground (basic-color))))
- (for-each
- (lambda (button color)
- (XtVaSetValues (XmMessageBoxGetChild dialog button)
- (list XmNarmColor (selection-color)
- XmNbackground color)))
- (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
- (list (highlight-color) (highlight-color) (highlight-color)))
- (XtAddCallback dialog XmNcancelCallback (lambda (w context info) (XtUnmanageChild dialog)))
- (XtAddCallback dialog XmNhelpCallback (lambda (w context info) (help-dialog "Find" "no help yet")))
- (XtAddCallback dialog XmNokCallback (lambda (w context info) (find-it)))
- (XmStringFree xhelp)
- (XmStringFree xdismiss)
- (XmStringFree xfind)
- (set! find-text (XtCreateManagedWidget "text" xmTextFieldWidgetClass dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color))))
- (XtAddCallback find-text XmNfocusCallback
- (lambda (w c i)
- (XtVaSetValues w (list XmNbackground (WhitePixelOfScreen (DefaultScreenOfDisplay (XtDisplay shell)))))))
- (XtAddCallback find-text XmNlosingFocusCallback (lambda (w c i) (XtSetValues w (list XmNbackground (basic-color)))))
- (XtAddCallback find-text XmNvalueChangedCallback (lambda (w c i) (set! find-new #t)))))
- (XtManageChild dialog))
-
- (define (find-it)
- (let* ((search-str (XmTextFieldGetString find-text))
- (len (string-length search-str))
- (pos (XmTextFindString listener-text
- (+ (XmTextGetCursorPosition listener-text)
- (if find-new 0 (if find-forward 1 -1)))
- search-str
- (if find-forward XmTEXT_FORWARD XmTEXT_BACKWARD))))
- (if (not pos)
- (set! pos (XmTextFindString listener-text
- (if find-forward 0 (XmTextGetLastPosition listener-text))
- search-str
- (if find-forward XmTEXT_FORWARD XmTEXT_BACKWARD))))
- (if (number? pos)
- (begin
- (XmTextSetInsertionPosition listener-text pos)
- (XmTextSetHighlight listener-text pos (+ pos len) XmHIGHLIGHT_SELECTED) ; flash the string briefly
- (XtAppAddTimeOut snd-app 200
- (lambda (context id)
- (XmTextSetHighlight listener-text pos (+ pos len) XmHIGHLIGHT_NORMAL)))))
- (set! find-new #f)))
+
+ (define tooltip-shell #f)
+ (define tooltip-label #f)
+
+ (define add-tooltip
+ (let ((documentation "(add-tooltip widget tip) adds the tooltip 'tip' to the widget"))
+ (lambda (widget tip)
+ (let ((tool-proc #f)
+ (quit-proc #f)
+ (timeout 500) ; millisecs after mouse enters widget to tip display
+ (quittime 3000) ; millisecs to show tip (if pointer not already moved out of widget)
+ (last-time 0)) ; try to squelch "fluttering"
+
+ (define (stop-tooltip)
+ (if tool-proc
+ (begin
+ (XtRemoveTimeOut tool-proc)
+ (set! tool-proc #f)))
+ (if quit-proc
+ (begin
+ (XtRemoveTimeOut quit-proc)
+ (set! quit-proc #f)))
+ (if (and tooltip-shell (XtIsManaged tooltip-shell))
+ (XtUnmanageChild tooltip-shell)))
- (XtAppAddActions snd-app
- (list (list "search-forward"
- (lambda args
- (set! find-forward #t)
- (start-dialog)))
- (list "search-backward"
- (lambda args
- (set! find-forward #f)
- (start-dialog)))))
- (XtOverrideTranslations listener-text
- (XtParseTranslationTable "Ctrl <Key>s: search-forward()
+ (define (start-tooltip ev)
+ (if (and *with-tooltips*
+ (not tool-proc))
+ (set! tool-proc (XtAppAddTimeOut
+ (car (main-widgets))
+ timeout
+ (lambda (data id)
+ (if (not tooltip-shell)
+ (begin
+ (set! tooltip-shell (XtCreatePopupShell
+ tip
+ overrideShellWidgetClass
+ (cadr (main-widgets))
+ (list XmNallowShellResize #t)))
+ (set! tooltip-label
+ (XtCreateManagedWidget
+ tip
+ xmLabelWidgetClass
+ tooltip-shell
+ (list XmNrecomputeSize #t
+ XmNbackground *highlight-color*))))
+ (change-label tooltip-label tip))
+ (let ((loc (XtTranslateCoords widget (.x ev) (.y ev))))
+ (XtVaSetValues tooltip-shell (list XmNx (car loc) XmNy (cadr loc))))
+ (XtManageChild tooltip-shell)
+ (set! quit-proc (XtAppAddTimeOut
+ (car (main-widgets))
+ quittime
+ (lambda (data id)
+ (XtUnmanageChild tooltip-shell)
+ (set! quit-proc #f)))))))))
+
+ (XtAddEventHandler widget EnterWindowMask #f
+ (lambda (w c ev flag)
+ (if (> (- (cadr (.time ev)) last-time) 50)
+ (start-tooltip ev))
+ (set! last-time (cadr (.time ev)))))
+ (XtAddEventHandler widget LeaveWindowMask #f
+ (lambda (w c ev flag)
+ (set! last-time (cadr (.time ev)))
+ (stop-tooltip)))))))
+
+ (define menu-option
+ (let ((documentation "(menu-option name) finds the widget associated with a given menu item name"))
+ (lambda (name)
+ (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (top-menu)
+ (for-each-child
+ top-menu
+ (lambda (w)
+ (let ((option-holder (cadr (XtGetValues w (list XmNsubMenuId 0)))))
+ (for-each-child
+ option-holder
+ (lambda (menu)
+ (if (string=? name (XtName menu))
+ (return menu)
+ (if (XmIsCascadeButton menu)
+ (let ((options (cadr (XtGetValues menu (list XmNsubMenuId 0)))))
+ (for-each-child
+ options
+ (lambda (inner-menu)
+ (if (string=? name (XtName inner-menu))
+ (return inner-menu)))))))))))))
+ (cdr (menu-widgets)))
+ (throw 'no-such-menu (list "menu-option" name)))))))
+
+ (define show-all-atoms
+ (let ((documentation "(show-all-atoms) displays all current X atom names"))
+ (lambda ()
+ (let ((i 1)
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (happy #t))
+ (XSetErrorHandler (lambda (dpy err)
+ (set! happy #f)))
+ (while happy
+ (let ((name (XGetAtomName dpy (list 'Atom i))))
+ (if (string? name)
+ (format #t "~D: ~A~%" i name)
+ (set! happy #f)))
+ (set! i (+ i 1)))
+ (XSetErrorHandler #f)))))
+
+
+;;; -------- enable C-s and C-r in listener
+
+ (define add-find-to-listener
+ (let ((dialog #f)
+ (find-text #f)
+ (find-forward #t)
+ (find-new #t)
+ (listener-text ((main-widgets) 4))
+ (shell (cadr (main-widgets)))
+ (snd-app (car (main-widgets))))
+ (lambda ()
+
+ (define (start-dialog)
+ (if (not dialog)
+ (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (xfind (XmStringCreate "Find" XmFONTLIST_DEFAULT_TAG)))
+ (set! dialog (XmCreateMessageDialog shell
+ "Find"
+ (list XmNcancelLabelString xdismiss
+ XmNokLabelString xfind
+ XmNhelpLabelString xhelp
+ XmNautoUnmanage #f
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNtransient #f
+ XmNbackground *basic-color*)))
+ (for-each
+ (lambda (button color)
+ (XtVaSetValues (XmMessageBoxGetChild dialog button)
+ (list XmNarmColor *selection-color*
+ XmNbackground color)))
+ (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
+ (list *highlight-color* *highlight-color* *highlight-color*))
+ (XtAddCallback dialog XmNcancelCallback (lambda (w context info) (XtUnmanageChild dialog)))
+ (XtAddCallback dialog XmNhelpCallback (lambda (w context info) (help-dialog "Find" "no help yet")))
+ (XtAddCallback dialog XmNokCallback (lambda (w context info)
+ (let* ((search-str (XmTextFieldGetString find-text))
+ (len (length search-str))
+ (pos (XmTextFindString listener-text
+ (+ (XmTextGetCursorPosition listener-text)
+ (if find-new 0 (if find-forward 1 -1)))
+ search-str
+ (if find-forward XmTEXT_FORWARD XmTEXT_BACKWARD))))
+ (if (not pos)
+ (set! pos (XmTextFindString listener-text
+ (if find-forward 0 (XmTextGetLastPosition listener-text))
+ search-str
+ (if find-forward XmTEXT_FORWARD XmTEXT_BACKWARD))))
+ (if (number? pos)
+ (begin
+ (XmTextSetInsertionPosition listener-text pos)
+ (XmTextSetHighlight listener-text pos (+ pos len) XmHIGHLIGHT_SELECTED) ; flash the string briefly
+ (XtAppAddTimeOut snd-app 200
+ (lambda (context id)
+ (XmTextSetHighlight listener-text pos (+ pos len) XmHIGHLIGHT_NORMAL)))))
+ (set! find-new #f))))
+ (XmStringFree xhelp)
+ (XmStringFree xdismiss)
+ (XmStringFree xfind)
+ (set! find-text (XtCreateManagedWidget "text" xmTextFieldWidgetClass dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild dialog XmDIALOG_SEPARATOR)
+ XmNbackground *basic-color*)))
+ (XtAddCallback find-text XmNfocusCallback
+ (lambda (w c i)
+ (XtVaSetValues w (list XmNbackground (WhitePixelOfScreen (DefaultScreenOfDisplay (XtDisplay shell)))))))
+ (XtAddCallback find-text XmNlosingFocusCallback (lambda (w c i) (XtSetValues w (list XmNbackground *basic-color*))))
+ (XtAddCallback find-text XmNvalueChangedCallback (lambda (w c i) (set! find-new #t)))))
+ (XtManageChild dialog))
+
+ (XtAppAddActions snd-app
+ (list (list "search-forward"
+ (lambda args
+ (set! find-forward #t)
+ (start-dialog)))
+ (list "search-backward"
+ (lambda args
+ (set! find-forward #f)
+ (start-dialog)))))
+ (XtOverrideTranslations listener-text
+ (XtParseTranslationTable "Ctrl <Key>s: search-forward()
Ctrl <Key>r: search-backward()")))))
;;; -------- add a function to be called when the window manager sends us a "save yourself" or "take focus" message
-
-(define (upon-save-yourself thunk)
- "(upon-save-yourself thunk) causes 'thunk' to be called if a 'save yourself' message is received"
- (XmAddWMProtocolCallback
- (cadr (main-widgets))
- (XmInternAtom (XtDisplay (cadr (main-widgets))) "WM_SAVE_YOURSELF" #f)
- (lambda (w c i)
- (thunk))
- #f))
-
+
+ (define upon-save-yourself
+ (let ((documentation "(upon-save-yourself thunk) causes 'thunk' to be called if a 'save yourself' message is received"))
+ (lambda (thunk)
+ (XmAddWMProtocolCallback
+ (cadr (main-widgets))
+ (XmInternAtom (XtDisplay (cadr (main-widgets))) "WM_SAVE_YOURSELF" #f)
+ (lambda (w c i)
+ (thunk))
+ #f))))
+
;;; similarly for "take focus"
-
-(define (upon-take-focus thunk)
- "(upon-take-focus thunk) causes 'thunk' to be called if a 'take focus' message is received"
- (XmAddWMProtocolCallback
- (cadr (main-widgets))
- (XmInternAtom (XtDisplay (cadr (main-widgets))) "WM_TAKE_FOCUS" #f)
- (lambda (w c i)
- (thunk))
- #f))
-
-
+
+ (define upon-take-focus
+ (let ((documentation "(upon-take-focus thunk) causes 'thunk' to be called if a 'take focus' message is received"))
+ (lambda (thunk)
+ (XmAddWMProtocolCallback
+ (cadr (main-widgets))
+ (XmInternAtom (XtDisplay (cadr (main-widgets))) "WM_TAKE_FOCUS" #f)
+ (lambda (w c i)
+ (thunk))
+ #f))))
+
+
;;; -------- add text widget to notebook "status" area --------
-
-(define (add-text-to-status-area)
- "(add-text-to-status-area) adds a text widget to the notebook status area"
- ;; it might be a better use of this space to put dlp's icon row in it
- (let ((notebook (list-ref (main-widgets) 3)))
- (if (XmIsNotebook notebook)
- (let ((text (XtCreateManagedWidget "notebook-text" xmTextFieldWidgetClass notebook
- (list XmNbackground (basic-color)))))
- (XtAddCallback text XmNfocusCallback
- (lambda (w c i)
- (XtSetValues w (list XmNbackground (white-pixel)))))
- (XtAddCallback text XmNlosingFocusCallback
- (lambda (w c i)
- (XtSetValues w (list XmNbackground (basic-color)))))
- text)
- #f)))
-
-
+
+ (define add-text-to-status-area
+ (let ((documentation "(add-text-to-status-area) adds a text widget to the notebook status area"))
+ (lambda ()
+ ;; it might be a better use of this space to put dlp's icon row in it
+ (let ((notebook ((main-widgets) 3)))
+ (and (XmIsNotebook notebook)
+ (let ((text (XtCreateManagedWidget "notebook-text" xmTextFieldWidgetClass notebook
+ (list XmNbackground *basic-color*))))
+ (XtAddCallback text XmNfocusCallback
+ (lambda (w c i)
+ (XtSetValues w (list XmNbackground (white-pixel)))))
+ (XtAddCallback text XmNlosingFocusCallback
+ (lambda (w c i)
+ (XtSetValues w (list XmNbackground *basic-color*))))
+ text))))))
+
+
;;; -------- variable display panel --------
-
-(define variables-dialog #f)
-(define variables-notebook #f)
-(define variables-pages '())
-
-(define (make-variables-dialog)
- "(make-variables-dialog) makes a variable-display dialog"
- (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Variables" XmFONTLIST_DEFAULT_TAG)))
- (set! variables-dialog
- (XmCreateTemplateDialog (cadr (main-widgets)) "variables-dialog"
- (list XmNokLabelString xdismiss
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNtransient #f
- XmNheight 400
- XmNwidth 400
- XmNbackground (basic-color))))
-
- (XtVaSetValues (XmMessageBoxGetChild variables-dialog XmDIALOG_OK_BUTTON)
- (list XmNarmColor (selection-color)
- XmNbackground (highlight-color)))
- (XtAddCallback variables-dialog
- XmNokCallback (lambda (w context info)
- (XtUnmanageChild variables-dialog)))
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
-
- (set! variables-notebook
- (XtCreateManagedWidget "variables-notebook" xmNotebookWidgetClass variables-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild variables-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color)
- XmNframeBackground (zoom-color)
- XmNbindingWidth 14)))
- (XtManageChild variables-dialog)
- variables-dialog))
-
-(define* (make-variable-display page-name variable-name (type 'text) (range (list 0.0 1.0)))
-"(make-variable-display page-name variable-name (type 'text) (range (list 0.0 1.0))) makes a variable \
-display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"
- (if (not (Widget? variables-dialog)) (make-variables-dialog))
- ;; rowColumn widget gets confused by drawingareas, so I'll split them out into separate panes
- (let ((page-info (assoc page-name variables-pages)))
- (if (not page-info)
- (let* ((panes (XtCreateManagedWidget page-name xmPanedWindowWidgetClass variables-notebook '()))
- (simple-cases (XtCreateManagedWidget page-name xmRowColumnWidgetClass panes
- (list XmNorientation XmVERTICAL
- XmNpaneMinimum 30
- XmNbackground (basic-color)))))
- (set! page-info (cons page-name (list panes simple-cases)))
- (XtCreateManagedWidget page-name xmPushButtonWidgetClass variables-notebook
- (list XmNnotebookChildType XmMAJOR_TAB
- XmNbackground (basic-color)))
- (set! variables-pages (cons page-info variables-pages))))
- (let* ((row-pane (caddr page-info))
- (pane (cadr page-info))
- (var-label (string-append variable-name ":")))
- (case type
- ((text)
- ;; add a horizontal pair: label text
- (let* ((row (XtCreateManagedWidget (string-append variable-name "-row") xmRowColumnWidgetClass row-pane
- (list XmNorientation XmHORIZONTAL
- XmNbackground (basic-color))))
- (label (XtCreateManagedWidget var-label xmLabelWidgetClass row
- (list XmNbackground (basic-color)))))
- (XtCreateManagedWidget (string-append variable-name "-value") xmTextFieldWidgetClass row
- (list XmNeditable #f
- XmNresizeWidth #t
- XmNbackground (WhitePixelOfScreen (DefaultScreenOfDisplay (XtDisplay variables-dialog)))))))
- ((scale)
- ;; scale bar with red "thermometer"
- (let* ((title (XmStringCreate var-label XmFONTLIST_DEFAULT_TAG))
- (scl (XtCreateManagedWidget variable-name xmScaleWidgetClass row-pane
- (list XmNbackground (basic-color)
- XmNslidingMode XmTHERMOMETER
- XmNminimum (floor (* 100 (car range)))
- XmNmaximum (floor (* 100 (cadr range)))
- XmNdecimalPoints 2
- XmNtitleString title
- XmNorientation XmHORIZONTAL
- XmNshowValue XmNEAR_BORDER))))
- (XtVaSetValues (find-child scl "Scrollbar") (list XmNtroughColor (red-pixel)))
- (XmStringFree title)
- scl))
- ((meter)
- ;; using the level meters in snd-motif.scm
- (let* ((height 70)
- (width 210)
- (label (XtCreateManagedWidget var-label xmLabelWidgetClass row-pane
- (list XmNbackground (basic-color)))))
- (make-level-meter row-pane width height '() #f)))
- ((graph)
- (let* ((form (XtCreateManagedWidget var-label xmFormWidgetClass pane
- (list XmNpaneMinimum 100)))
- (snd (make-variable-graph form (string-append variable-name ": time") 2048 (mus-srate))))
- (list (sound->integer snd) (channel-data snd 0))))
- ((spectrum)
- (let* ((form (XtCreateManagedWidget var-label xmFormWidgetClass pane
- (list XmNpaneMinimum 100)))
- (snd (make-variable-graph form variable-name 2048 (floor (mus-srate)))))
- (set! (time-graph? snd 0) #f)
- (set! (transform-graph? snd 0) #t)
- (set! (x-axis-label snd 0 transform-graph) (string-append variable-name ": frequency"))
- (list (sound->integer snd) (channel-data snd 0))))
- (else #f)))))
-
-(define (variable-display var widget)
- "(variable-display var widget) displays the value of 'var' in 'widget'"
- (if (Widget? widget)
- (if (XmIsTextField widget)
- ;; text representation
- (let ((old-str (XmTextFieldGetString widget))
- (new-str (object->string var)))
- (if (not (string=? old-str new-str))
- (begin
- (XmTextFieldSetString widget new-str)
- (if (XtIsManaged widget)
- (XmUpdateDisplay widget)))))
- (if (XmIsScale widget)
- ;; thermometer
- (XmScaleSetValue widget (floor (* 100 var)))))
- (if (list? widget)
- (if (or (number? (car widget))
- (sound? (car widget)))
- ;; graph/spectrum -- does this need an explicit update?
- (let* ((snd (car widget))
- (data (cadr widget))
- (frames (length data))
- (loc (cursor snd 0)))
- (sound-data-set! data 0 loc var)
- (if (time-graph? snd) (update-time-graph snd))
- (if (transform-graph? snd) (update-transform-graph snd))
- (if (= (+ loc 1) frames)
- (set! (cursor snd 0) 0)
- (set! (cursor snd 0) (+ loc 1))))
- (if (XmIsDrawingArea (car widget))
- ;; level meter
- (begin
- (list-set! widget 1 var)
- (display-level widget)
- (XmUpdateDisplay (car widget)))))))
- var)
-
-(define (variable-display-reset widget)
- "(variable-display-reset widget) restarts the variable graphs -- this is intended for the start (or perhaps end) of a note"
- (if (list? widget)
- (if (number? (car widget))
- ;; graph/spectrum
- (let* ((snd (car widget))
- (data (cadr widget))
- (frames (length data)))
- (set! (cursor snd 0) 0)
- (do ((i 0 (+ i 1)))
- ((= i frames))
- (sound-data-set! data 0 i 0.0))))))
-
-
+
+ (define variables-dialog #f)
+ (define variables-notebook #f)
+ (define variables-pages ())
+
+ (define make-variables-dialog
+ (let ((documentation "(make-variables-dialog) makes a variable-display dialog"))
+ (lambda ()
+ (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "Variables" XmFONTLIST_DEFAULT_TAG)))
+ (set! variables-dialog
+ (XmCreateTemplateDialog (cadr (main-widgets)) "variables-dialog"
+ (list XmNokLabelString xdismiss
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNtransient #f
+ XmNheight 400
+ XmNwidth 400
+ XmNbackground *basic-color*)))
+
+ (XtVaSetValues (XmMessageBoxGetChild variables-dialog XmDIALOG_OK_BUTTON)
+ (list XmNarmColor *selection-color*
+ XmNbackground *highlight-color*))
+ (XtAddCallback variables-dialog
+ XmNokCallback (lambda (w context info)
+ (XtUnmanageChild variables-dialog)))
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+
+ (set! variables-notebook
+ (XtCreateManagedWidget "variables-notebook" xmNotebookWidgetClass variables-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild variables-dialog XmDIALOG_SEPARATOR)
+ XmNbackground *basic-color*
+ XmNframeBackground *zoom-color*
+ XmNbindingWidth 14)))
+ (XtManageChild variables-dialog)
+ variables-dialog))))
+
+ (define make-variable-display
+ (let ((documentation "(make-variable-display page-name variable-name (type 'text) (range (list 0.0 1.0))) makes a variable \
+display widget; type = 'text, 'meter, 'graph, 'spectrum, 'scale"))
+ (lambda* (page-name variable-name (type 'text) (range (list 0.0 1.0)))
+ (if (not (Widget? variables-dialog)) (make-variables-dialog))
+ ;; rowColumn widget gets confused by drawingareas, so I'll split them out into separate panes
+ (let ((page-info (assoc page-name variables-pages)))
+ (if (not page-info)
+ (let* ((panes (XtCreateManagedWidget page-name xmPanedWindowWidgetClass variables-notebook ()))
+ (simple-cases (XtCreateManagedWidget page-name xmRowColumnWidgetClass panes
+ (list XmNorientation XmVERTICAL
+ XmNpaneMinimum 30
+ XmNbackground *basic-color*))))
+ (set! page-info (list page-name panes simple-cases))
+ (XtCreateManagedWidget page-name xmPushButtonWidgetClass variables-notebook
+ (list XmNnotebookChildType XmMAJOR_TAB
+ XmNbackground *basic-color*))
+ (set! variables-pages (cons page-info variables-pages))))
+ (let ((row-pane (caddr page-info))
+ (pane (cadr page-info))
+ (var-label (string-append variable-name ":")))
+ (case type
+ ((text)
+ ;; add a horizontal pair: label text
+ (let ((row (XtCreateManagedWidget (string-append variable-name "-row") xmRowColumnWidgetClass row-pane
+ (list XmNorientation XmHORIZONTAL
+ XmNbackground *basic-color*))))
+ (XtCreateManagedWidget var-label xmLabelWidgetClass row
+ (list XmNbackground *basic-color*))
+ (XtCreateManagedWidget (string-append variable-name "-value") xmTextFieldWidgetClass row
+ (list XmNeditable #f
+ XmNresizeWidth #t
+ XmNbackground (WhitePixelOfScreen (DefaultScreenOfDisplay (XtDisplay variables-dialog)))))))
+ ((scale)
+ ;; scale bar with red "thermometer"
+ (let* ((title (XmStringCreate var-label XmFONTLIST_DEFAULT_TAG))
+ (scl (XtCreateManagedWidget variable-name xmScaleWidgetClass row-pane
+ (list XmNbackground *basic-color*
+ XmNslidingMode XmTHERMOMETER
+ XmNminimum (floor (* 100 (car range)))
+ XmNmaximum (floor (* 100 (cadr range)))
+ XmNdecimalPoints 2
+ XmNtitleString title
+ XmNorientation XmHORIZONTAL
+ XmNshowValue XmNEAR_BORDER))))
+ (XtVaSetValues (find-child scl "Scrollbar") (list XmNtroughColor (red-pixel)))
+ (XmStringFree title)
+ scl))
+ #|
+ ((meter)
+ ;; using the level meters in snd-motif.scm
+ (let ((height 70)
+ (width 210))
+ (XtCreateManagedWidget var-label xmLabelWidgetClass row-pane
+ (list XmNbackground *basic-color*))
+ (make-level-meter row-pane width height () #f)))
+ |#
+ ((graph)
+ (let* ((form (XtCreateManagedWidget var-label xmFormWidgetClass pane
+ (list XmNpaneMinimum 100)))
+ (snd (make-variable-graph form (string-append variable-name ": time") 2048 (floor *clm-srate*))))
+ (list (sound->integer snd) (channel-data snd 0))))
+ ((spectrum)
+ (let* ((form (XtCreateManagedWidget var-label xmFormWidgetClass pane
+ (list XmNpaneMinimum 100)))
+ (snd (make-variable-graph form variable-name 2048 (floor *clm-srate*))))
+ (set! (time-graph? snd 0) #f)
+ (set! (transform-graph? snd 0) #t)
+ (set! (x-axis-label snd 0 transform-graph) (string-append variable-name ": frequency"))
+ (list (sound->integer snd) (channel-data snd 0))))
+ (else #f)))))))
+
+ (define variable-display
+ (let ((documentation "(variable-display var widget) displays the value of 'var' in 'widget'"))
+ (lambda (var widget)
+ (if (Widget? widget)
+ (if (XmIsTextField widget)
+ ;; text representation
+ (let ((old-str (XmTextFieldGetString widget))
+ (new-str (object->string var)))
+ (if (not (string=? old-str new-str))
+ (begin
+ (XmTextFieldSetString widget new-str)
+ (if (XtIsManaged widget)
+ (XmUpdateDisplay widget)))))
+ (if (XmIsScale widget)
+ ;; thermometer
+ (XmScaleSetValue widget (floor (* 100 var)))))
+ (if (and (pair? widget)
+ (or (number? (car widget))
+ (sound? (car widget))))
+ ;; graph/spectrum -- does this need an explicit update?
+ (let* ((snd (car widget))
+ (data (cadr widget))
+ (len (length data))
+ (loc (cursor snd 0)))
+ (set! (data loc) var)
+ (if (time-graph? snd) (update-time-graph snd))
+ (if (transform-graph? snd) (update-transform-graph snd))
+ (if (= (+ loc 1) len)
+ (set! (cursor snd 0) 0)
+ (set! (cursor snd 0) (+ loc 1))))))
+ var)))
+
+ (define variable-display-reset
+ (let ((documentation "(variable-display-reset widget) restarts the variable graphs -- this is intended for the start (or perhaps end) of a note"))
+ (lambda (widget)
+ (if (and (pair? widget)
+ (number? (car widget)))
+ ;; graph/spectrum
+ (let* ((snd (car widget))
+ (data (cadr widget))
+ (len (length data)))
+ (set! (cursor snd 0) 0)
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (vector-set! data 0 i 0.0)))))))
+
+
#|
-(define wid (make-variable-display "do-loop" "i*2" 'text))
-(define wid1 (make-variable-display "do-loop" "i" 'text))
-(do ((i 0 (+ i 1)))
- ((= i 10))
- (variable-display (* (variable-display i wid1) 2) wid))
-
-(define wid2 (make-variable-display "a-loop" "k*2" 'meter))
-;(define wid3 (make-variable-display "a-loop" "k" 'scale '(0 40)))
-(do ((k 0 (+ 1 k)))
- ((= k 11))
- (variable-display (* k .02) wid2))
+ (define wid (make-variable-display "do-loop" "i*2" 'text))
+ (define wid1 (make-variable-display "do-loop" "i" 'text))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (variable-display (* (variable-display i wid1) 2) wid))
+
+ (define wid2 (make-variable-display "a-loop" "k*2" 'meter))
+ ;(define wid3 (make-variable-display "a-loop" "k" 'scale '(0 40)))
+ (do ((k 0 (+ k 1)))
+ ((= k 11))
+ (variable-display (* k .02) wid2))
|#
-
-(define with-minmax-button
- (let ((maxed-snds '()))
- (lambda (snd)
- (let ((previous-minmax (find-if (lambda (n) (equal? (car n) snd)) maxed-snds)))
- (if (not previous-minmax)
- (let* ((widgets (sound-widgets snd))
- (minibuffer (list-ref widgets 3))
- (play-button (list-ref widgets 4))
- (cur-size (cadr (XtVaGetValues (car widgets) (list XmNheight 0)))))
- (XtUnmanageChild play-button)
- (let* ((name-form (XtParent minibuffer)) ; "snd-name-form"
- (new-minmax (XtCreateManagedWidget "." xmPushButtonWidgetClass name-form
- (list XmNbackground (basic-color)
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNmarginWidth 2
- XmNmarginHeight 0
- XmNshadowThickness 0
- ))))
- (XtVaSetValues play-button (list XmNrightAttachment XmATTACH_WIDGET
- XmNrightWidget new-minmax))
- (XtManageChild play-button)
- (XtAddCallback
- new-minmax XmNactivateCallback
- (lambda (w c i)
- (let ((mv (find-if (lambda (n) (equal? (car n) c)) maxed-snds)))
- (if mv
- (let ((maxed (caddr mv)))
- (if maxed
- (begin
- (list-set! mv 3 (cadr (XtVaGetValues (car (sound-widgets c)) (list XmNheight 0))))
- (list-set! mv 4 (show-controls c))
- (do ((i 0 (+ i 1)))
- ((= i (channels c)))
- (XtUnmanageChild (list-ref (channel-widgets c i) 10)))
- (set! (show-controls c) #f)
- (XmChangeColor new-minmax (make-color 1 1 0))
- (XtVaSetValues (car (sound-widgets c)) (list XmNpaneMaximum 25)))
- (let ((prev-size (list-ref mv 3)))
- (do ((i 0 (+ i 1)))
- ((= i (channels c)))
- (XtManageChild (list-ref (channel-widgets c i) 10)))
- (if (list-ref mv 4) (set! (show-controls c) #t))
- (XmChangeColor new-minmax (basic-color))
- (XtVaSetValues (car (sound-widgets c)) (list XmNpaneMaximum prev-size XmNpaneMinimum (- prev-size 1)))
- (XtVaSetValues (car (sound-widgets c)) (list XmNpaneMaximum 1000 XmNpaneMinimum 1))))
- (list-set! mv 2 (not maxed))))))
- snd)
-
- (set! previous-minmax (list snd new-minmax #t cur-size (show-controls snd)))
- (set! maxed-snds (cons previous-minmax maxed-snds)))))
- #f))))
-
-
-;(hook-push after-open-hook with-minmax-button)
-
+
+ (define with-minmax-button
+ (let ((maxed-snds ()))
+ (lambda (snd)
+ (let ((previous-minmax (find-if (lambda (n) (equal? (car n) snd)) maxed-snds)))
+ (if (not previous-minmax)
+ (let* ((widgets (sound-widgets snd))
+ (status-area (widgets 3))
+ (play-button (widgets 4))
+ (cur-size (cadr (XtVaGetValues (car widgets) (list XmNheight 0)))))
+ (XtUnmanageChild play-button)
+ (let* ((name-form (XtParent status-area)) ; "snd-name-form"
+ (new-minmax (XtCreateManagedWidget "." xmPushButtonWidgetClass name-form
+ (list XmNbackground *basic-color*
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNmarginWidth 2
+ XmNmarginHeight 0
+ XmNshadowThickness 0
+ ))))
+ (XtVaSetValues play-button (list XmNrightAttachment XmATTACH_WIDGET
+ XmNrightWidget new-minmax))
+ (XtManageChild play-button)
+ (XtAddCallback
+ new-minmax XmNactivateCallback
+ (lambda (w c i)
+ (let ((mv (find-if (lambda (n) (equal? (car n) c)) maxed-snds)))
+ (if mv
+ (let ((maxed (caddr mv)))
+ (if maxed
+ (begin
+ (set! (mv 3) (cadr (XtVaGetValues (car (sound-widgets c)) (list XmNheight 0))))
+ (set! (mv 4) (show-controls c))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels c)))
+ (XtUnmanageChild ((channel-widgets c i) 10)))
+ (set! (show-controls c) #f)
+ (XmChangeColor new-minmax (make-color 1 1 0))
+ (XtVaSetValues (car (sound-widgets c)) (list XmNpaneMaximum 25)))
+ (let ((prev-size (mv 3)))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels c)))
+ (XtManageChild ((channel-widgets c i) 10)))
+ (if (mv 4) (set! (show-controls c) #t))
+ (XmChangeColor new-minmax *basic-color*)
+ (XtVaSetValues (car (sound-widgets c)) (list XmNpaneMaximum prev-size XmNpaneMinimum (- prev-size 1)))
+ (XtVaSetValues (car (sound-widgets c)) (list XmNpaneMaximum 1000 XmNpaneMinimum 1))))
+ (set! (mv 2) (not maxed))))))
+ snd)
+
+ (set! previous-minmax (list snd new-minmax #t cur-size (show-controls snd)))
+ (set! maxed-snds (cons previous-minmax maxed-snds)))))
+ #f))))
+
+
+ ;(hook-push after-open-hook (lambda (hook) (with-minmax-button (hook 'snd))))
+
#|
-(define (set-root-window-color color)
- "(set-root-window-color color) sets the color of the overall X background"
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (root-window (DefaultRootWindow dpy)))
- (XSetWindowBackground dpy root-window color)
- (XClearWindow dpy root-window)))
+ (define set-root-window-color
+ (let ((documentation "(set-root-window-color color) sets the color of the overall X background"))
+ (lambda (color)
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (root-window (DefaultRootWindow dpy)))
+ (XSetWindowBackground dpy root-window color)
+ (XClearWindow dpy root-window)))))
|#
-
-
+
+
;;; you can get a different scrollbar style with:
;;; (XtVaSetValues (XmGetXmDisplay (XtDisplay (cadr (main-widgets)))) (list XmNenableThinThickness #t))
-
-
+
+
;;; get open file list across top of window (like Xemacs): use -notebook, then:
;;; this is now the default
-(define (notebook-with-top-tabs)
- "(notebook-with-top-tabs) posts the list of open sounds across the top of the Snd window (like the Emacs buffer list)"
- (let ((nb (list-ref (main-widgets) 3)))
- (XtVaSetValues nb (list XmNorientation XmVERTICAL
- XmNbindingType XmNONE
- XmNbackPagePlacement XmTOP_RIGHT))))
-
-
+ (define notebook-with-top-tabs
+ (let ((documentation "(notebook-with-top-tabs) posts the list of open sounds across the top of the Snd window (like the Emacs buffer list)"))
+ (lambda ()
+ (let ((nb ((main-widgets) 3)))
+ (XtVaSetValues nb (list XmNorientation XmVERTICAL
+ XmNbindingType XmNONE
+ XmNbackPagePlacement XmTOP_RIGHT))))))
+
+
+#|
;;; -------- create-ssb-dialog --------
;;;
;;; this needs auto-pitch detection
-
-(define ssb-dialog #f)
-
-(define (create-ssb-dialog)
- "(create-ssb-dialog) creates a dialog for testing the ssb-am stuff"
- (if (not (Widget? ssb-dialog))
- (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "SSB-Expand" XmFONTLIST_DEFAULT_TAG))
- (running #f))
- (set! ssb-dialog
- (XmCreateTemplateDialog (cadr (main-widgets)) "ssb-expand"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNwidth 400
- XmNtransient #f) ))
- (XtAddCallback ssb-dialog
- XmNcancelCallback (lambda (w context info)
- (if running (set! running #f))
- (XtUnmanageChild ssb-dialog)))
- (XtAddCallback ssb-dialog XmNhelpCallback (lambda (w context info) (snd-print "set 'play' and move the sliders!")))
- (XmStringFree xhelp)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
-
- (let* ((ratio 1.0)
- (old-freq 550.0)
- (new-freq 550.0)
- (hilbert-order 40)
- (ssb-pairs 10)
- (bw 50.0)
- (ssbs (make-vector 512))
- (bands (make-vector 512))
- (reader #f))
-
- (letrec ((ssb-expand
- (lambda ()
- (mus-ssb-bank ssbs bands (reader) ssb-pairs))) ; clm2xen.c -- an experiment
- (set-freq
- (lambda (nfreq)
- (set! old-freq nfreq)
- (set! ratio (/ (- new-freq old-freq) old-freq))
- (if running
- (do ((i 0 (+ i 1)))
- ((= i ssb-pairs))
- (set! (mus-frequency (ssbs i)) (* (+ i 1) ratio old-freq))))))
- (set-ratio
- (lambda (nfreq)
- (set! new-freq nfreq)
- (set! ratio (/ (- new-freq old-freq) old-freq))
- (if running
- (do ((i 0 (+ i 1)))
- ((= i ssb-pairs))
- (set! (mus-frequency (ssbs i)) (* (+ i 1) ratio old-freq))))))
- (set-pairs
- (lambda (pairs)
- (set! ssb-pairs pairs)))
- (set-order
- (lambda (order)
- (set! hilbert-order order))))
- (let* ((mainform
- (XtCreateManagedWidget "formd" xmRowColumnWidgetClass ssb-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild ssb-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color)
- XmNorientation XmVERTICAL)))
- (button
- (XtCreateManagedWidget "play" xmToggleButtonWidgetClass mainform
- (list XmNbackground (basic-color))))
- (freqstr (XmStringCreate "original freq" XmFONTLIST_DEFAULT_TAG))
- (freq-scale
- (XtCreateManagedWidget "frq" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue (floor old-freq)
- XmNmaximum 1000
- XmNtitleString freqstr
- XmNdecimalPoints 0)))
- (ratiostr (XmStringCreate "new freq" XmFONTLIST_DEFAULT_TAG))
- (ratio-scale
- (XtCreateManagedWidget "nfrq" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue (floor new-freq)
- XmNmaximum 1000
- XmNtitleString ratiostr
- XmNdecimalPoints 0)))
- (orderstr (XmStringCreate "order" XmFONTLIST_DEFAULT_TAG))
- (order-scale
- (XtCreateManagedWidget "order" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue hilbert-order
- XmNmaximum 100
- XmNtitleString orderstr
- XmNdecimalPoints 0)))
- (pairsstr (XmStringCreate "ssbs" XmFONTLIST_DEFAULT_TAG))
- (pairs-scale
- (XtCreateManagedWidget "pairs" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue ssb-pairs
- XmNmaximum 100
- XmNtitleString pairsstr
- XmNdecimalPoints 0))))
- (XmStringFree freqstr)
- (XmStringFree ratiostr)
- (XmStringFree orderstr)
- (XmStringFree pairsstr)
- (XtAddCallback freq-scale XmNvalueChangedCallback (lambda (w context info) (set-freq (.value info))))
- (XtAddCallback freq-scale XmNdragCallback (lambda (w context info) (set-freq (.value info))))
- (XtAddCallback ratio-scale XmNvalueChangedCallback (lambda (w context info) (set-ratio (.value info))))
- (XtAddCallback ratio-scale XmNdragCallback (lambda (w context info) (set-ratio (.value info))))
- (XtAddCallback order-scale XmNvalueChangedCallback (lambda (w context info) (set-order (.value info))))
- (XtAddCallback order-scale XmNdragCallback (lambda (w context info) (set-order (.value info))))
- (XtAddCallback pairs-scale XmNvalueChangedCallback (lambda (w context info) (set-pairs (.value info))))
- (XtAddCallback pairs-scale XmNdragCallback (lambda (w context info) (set-pairs (.value info))))
- (XtAddCallback button XmNvalueChangedCallback
- (lambda (w context info)
- (if running
- (set! running #f)
- (let* ((audio-info (open-play-output 1 44100 #f 128))
- (audio-fd (car audio-info))
- (outchans (cadr audio-info))
- (frames (caddr audio-info))
- (data (make-sound-data outchans frames)))
- (if (not (= audio-fd -1))
- (begin
- (do ((i 1 (+ i 1)))
- ((> i ssb-pairs))
- (let* ((aff (* i old-freq))
- (bwf (* bw (+ 1.0 (/ i (* 2 ssb-pairs))))))
- (set! (ssbs (- i 1)) (make-ssb-am (* i ratio old-freq)))
- (set! (bands (- i 1)) (make-bandpass (hz->2pi (- aff bwf))
- (hz->2pi (+ aff bwf))
- hilbert-order))))
- (set! reader (make-sampler 0))
- (set! running #t)
- (do ()
- ((or (not running)
- (sampler-at-end? reader))
- (begin
- (XmToggleButtonSetValue button 0 #f)
- (set! running #f)
- (free-sampler reader)
- (mus-audio-close audio-fd)))
- (do ((k 0 (+ 1 k)))
- ((= k frames))
- (sound-data-set! data 0 k (ssb-expand)))
- (mus-audio-write audio-fd data frames)))))))))))))
- (XtManageChild ssb-dialog))
-
-
+
+ (define ssb-dialog #f)
+
+ (define create-ssb-dialog
+ (let ((documentation "(create-ssb-dialog) creates a dialog for testing the ssb-am stuff"))
+ (lambda ()
+ (if (not (Widget? ssb-dialog))
+ (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "SSB-Expand" XmFONTLIST_DEFAULT_TAG))
+ (running #f))
+ (set! ssb-dialog
+ (XmCreateTemplateDialog (cadr (main-widgets)) "ssb-expand"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground *basic-color*
+ XmNwidth 400
+ XmNtransient #f) ))
+ (XtAddCallback ssb-dialog
+ XmNcancelCallback (lambda (w context info)
+ (if running (set! running #f))
+ (XtUnmanageChild ssb-dialog)))
+ (XtAddCallback ssb-dialog XmNhelpCallback (lambda (w context info) (snd-print "set 'play' and move the sliders!")))
+ (XmStringFree xhelp)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+
+ (let ((ratio 1.0)
+ (old-freq 550.0)
+ (new-freq 550.0)
+ (hilbert-order 40)
+ (ssb-pairs 10)
+ (bw 50.0)
+ (ssbs (make-vector 512))
+ (bands (make-vector 512))
+ (reader #f))
+
+ (letrec ((ssb-expand
+ (lambda ()
+ (let ((sum 0.0)
+ (sig (reader)))
+ (do ((i 0 (+ i 1)))
+ ((= i ssb-pairs) sum)
+ (set! sum (+ sum (ssb-am (ssbs i) (fir-filter (bands i) sig))))))))
+ (set-freq
+ (lambda (nfreq)
+ (set! old-freq nfreq)
+ (set! ratio (/ (- new-freq old-freq) old-freq))
+ (if running
+ (do ((i 0 (+ i 1)))
+ ((= i ssb-pairs))
+ (set! (mus-frequency (ssbs i)) (* (+ i 1) ratio old-freq))))))
+ (set-ratio
+ (lambda (nfreq)
+ (set! new-freq nfreq)
+ (set! ratio (/ (- new-freq old-freq) old-freq))
+ (if running
+ (do ((i 0 (+ i 1)))
+ ((= i ssb-pairs))
+ (set! (mus-frequency (ssbs i)) (* (+ i 1) ratio old-freq))))))
+ (set-pairs
+ (lambda (pairs)
+ (set! ssb-pairs pairs)))
+ (set-order
+ (lambda (order)
+ (set! hilbert-order order))))
+ (let* ((mainform
+ (XtCreateManagedWidget "formd" xmRowColumnWidgetClass ssb-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild ssb-dialog XmDIALOG_SEPARATOR)
+ XmNbackground *basic-color*
+ XmNorientation XmVERTICAL)))
+ (button
+ (XtCreateManagedWidget "play" xmToggleButtonWidgetClass mainform
+ (list XmNbackground *basic-color*)))
+ (freqstr (XmStringCreate "original freq" XmFONTLIST_DEFAULT_TAG))
+ (freq-scale
+ (XtCreateManagedWidget "frq" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue (floor old-freq)
+ XmNmaximum 1000
+ XmNtitleString freqstr
+ XmNdecimalPoints 0)))
+ (ratiostr (XmStringCreate "new freq" XmFONTLIST_DEFAULT_TAG))
+ (ratio-scale
+ (XtCreateManagedWidget "nfrq" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue (floor new-freq)
+ XmNmaximum 1000
+ XmNtitleString ratiostr
+ XmNdecimalPoints 0)))
+ (orderstr (XmStringCreate "order" XmFONTLIST_DEFAULT_TAG))
+ (order-scale
+ (XtCreateManagedWidget "order" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue hilbert-order
+ XmNmaximum 100
+ XmNtitleString orderstr
+ XmNdecimalPoints 0)))
+ (pairsstr (XmStringCreate "ssbs" XmFONTLIST_DEFAULT_TAG))
+ (pairs-scale
+ (XtCreateManagedWidget "pairs" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue ssb-pairs
+ XmNmaximum 100
+ XmNtitleString pairsstr
+ XmNdecimalPoints 0))))
+ (XmStringFree freqstr)
+ (XmStringFree ratiostr)
+ (XmStringFree orderstr)
+ (XmStringFree pairsstr)
+ (XtAddCallback freq-scale XmNvalueChangedCallback (lambda (w context info) (set-freq (.value info))))
+ (XtAddCallback freq-scale XmNdragCallback (lambda (w context info) (set-freq (.value info))))
+ (XtAddCallback ratio-scale XmNvalueChangedCallback (lambda (w context info) (set-ratio (.value info))))
+ (XtAddCallback ratio-scale XmNdragCallback (lambda (w context info) (set-ratio (.value info))))
+ (XtAddCallback order-scale XmNvalueChangedCallback (lambda (w context info) (set-order (.value info))))
+ (XtAddCallback order-scale XmNdragCallback (lambda (w context info) (set-order (.value info))))
+ (XtAddCallback pairs-scale XmNvalueChangedCallback (lambda (w context info) (set-pairs (.value info))))
+ (XtAddCallback pairs-scale XmNdragCallback (lambda (w context info) (set-pairs (.value info))))
+ (XtAddCallback button XmNvalueChangedCallback
+ (lambda (w context info)
+ (if running
+ (set! running #f)
+ (let* ((audio-info (open-play-output 1 44100 #f 128))
+ (audio-fd (car audio-info))
+ (outchans (cadr audio-info))
+ (len (caddr audio-info))
+ (data (make-float-vector (list outchans len) 0.0)))
+ (if (not (= audio-fd -1))
+ (begin
+ (do ((i 1 (+ i 1)))
+ ((> i ssb-pairs))
+ (let ((aff (* i old-freq))
+ (bwf (* bw (+ 1.0 (/ i (* 2 ssb-pairs))))))
+ (set! (ssbs (- i 1)) (make-ssb-am (* i ratio old-freq)))
+ (set! (bands (- i 1)) (make-bandpass (hz->radians (- aff bwf))
+ (hz->radians (+ aff bwf))
+ hilbert-order))))
+ (set! reader (make-sampler 0))
+ (set! running #t)
+ (do ()
+ ((or (not running)
+ (sampler-at-end? reader))
+ (begin
+ (XmToggleButtonSetValue button 0 #f)
+ (set! running #f)
+ (free-sampler reader)
+ (mus-audio-close audio-fd)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (vector-set! data 0 k (ssb-expand)))
+ (mus-audio-write audio-fd data len)))))))))))))
+ (XtManageChild ssb-dialog))))
+
+
;;; -------- create-audit-dialog --------
;;;
;;; amp + freq sliders up to 20KHz
+
+ (define audit-dialog #f)
+
+ (define create-audit-dialog
+ (let ((documentation "(create-audit-dialog) creates a slightly dangerous hearing test dialog (don't push the amps way up if you can't hear anything)"))
+ (lambda ()
+ (if (not (Widget? audit-dialog))
+ (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "Hear Anything Yet?" XmFONTLIST_DEFAULT_TAG))
+ (running #f))
+ (set! audit-dialog
+ (XmCreateTemplateDialog (cadr (main-widgets)) "audit"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground *basic-color*
+ XmNwidth 400
+ XmNtransient #f) ))
+ (XtAddCallback audit-dialog
+ XmNcancelCallback (lambda (w context info)
+ (if running (set! running #f))
+ (XtUnmanageChild audit-dialog)))
+ (XtAddCallback audit-dialog XmNhelpCallback (lambda (w context info) (snd-print "set 'play' and move the sliders!")))
+ (XmStringFree xhelp)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+ (set! *clm-srate* 44100)
+
+ (let* ((frequency 440.0)
+ (amplitude 0.1)
+ (carrier (make-oscil frequency)))
+ (letrec ((v (lambda ()
+ (* amplitude
+ (oscil carrier)))))
+ (let* ((mainform
+ (XtCreateManagedWidget "formd" xmRowColumnWidgetClass audit-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild audit-dialog XmDIALOG_SEPARATOR)
+ XmNbackground *basic-color*
+ XmNorientation XmVERTICAL)))
+ (button
+ (XtCreateManagedWidget "play" xmToggleButtonWidgetClass mainform
+ (list XmNbackground *basic-color*)))
+ (ampstr (XmStringCreate "amp" XmFONTLIST_DEFAULT_TAG))
+ (amp-scale
+ (XtCreateManagedWidget "amp" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue (floor (* amplitude 100))
+ XmNmaximum 100
+ XmNtitleString ampstr
+ XmNdecimalPoints 2)))
+ (freqstr (XmStringCreate "freq" XmFONTLIST_DEFAULT_TAG))
+ (freq-scale
+ (XtCreateManagedWidget "freq" xmScaleWidgetClass mainform
+ (list XmNorientation XmHORIZONTAL
+ XmNshowValue #t
+ XmNbackground *basic-color*
+ XmNvalue (floor frequency)
+ XmNmaximum 20000
+ XmNtitleString freqstr
+ XmNdecimalPoints 0))))
+ (XmStringFree ampstr)
+ (XmStringFree freqstr)
+ (XtAddCallback amp-scale XmNvalueChangedCallback (lambda (w context info) (set! amplitude (* .01 (.value info)))))
+ (XtAddCallback amp-scale XmNdragCallback (lambda (w context info) (set! amplitude (* .01 (.value info)))))
+ (XtAddCallback freq-scale XmNvalueChangedCallback (lambda (w context info) (set! (mus-frequency carrier) (.value info))))
+ (XtAddCallback freq-scale XmNdragCallback (lambda (w context info) (set! (mus-frequency carrier) (.value info))))
+ (XtAddCallback button XmNvalueChangedCallback
+ (lambda (w context info)
+ (if running
+ (set! running #f)
+ (let* ((audio-info (open-play-output 1 44100 #f 256))
+ (audio-fd (car audio-info))
+ (outchans (cadr audio-info))
+ (len (caddr audio-info))
+ (data (make-float-vector (list outchans len) 0.0)))
+ (if (not (= audio-fd -1))
+ (begin
+ (set! running #t)
+ (do ()
+ ((not running)
+ (begin
+ (set! running #f)
+ (mus-audio-close audio-fd)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (vector-set! data 0 k (v)))
+ (mus-audio-write audio-fd data len)))))))))))))
+ (XtManageChild audit-dialog))))
+|#
-(define audit-dialog #f)
-
-(define (create-audit-dialog)
- "(create-audit-dialog) creates a slightly dangerous hearing test dialog (don't push the amps way up if you can't hear anything)"
- (if (not (Widget? audit-dialog))
- (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Hear Anything Yet?" XmFONTLIST_DEFAULT_TAG))
- (running #f))
- (set! audit-dialog
- (XmCreateTemplateDialog (cadr (main-widgets)) "audit"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNwidth 400
- XmNtransient #f) ))
- (XtAddCallback audit-dialog
- XmNcancelCallback (lambda (w context info)
- (if running (set! running #f))
- (XtUnmanageChild audit-dialog)))
- (XtAddCallback audit-dialog XmNhelpCallback (lambda (w context info) (snd-print "set 'play' and move the sliders!")))
- (XmStringFree xhelp)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (set! (mus-srate) 44100)
-
- (let* ((frequency 440.0)
- (amplitude 0.1)
- (carrier (make-oscil frequency)))
- (letrec ((v (lambda ()
- (* amplitude
- (oscil carrier)))))
- (let* ((mainform
- (XtCreateManagedWidget "formd" xmRowColumnWidgetClass audit-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild audit-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color)
- XmNorientation XmVERTICAL)))
- (button
- (XtCreateManagedWidget "play" xmToggleButtonWidgetClass mainform
- (list XmNbackground (basic-color))))
- (ampstr (XmStringCreate "amp" XmFONTLIST_DEFAULT_TAG))
- (amp-scale
- (XtCreateManagedWidget "amp" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue (floor (* amplitude 100))
- XmNmaximum 100
- XmNtitleString ampstr
- XmNdecimalPoints 2)))
- (freqstr (XmStringCreate "freq" XmFONTLIST_DEFAULT_TAG))
- (freq-scale
- (XtCreateManagedWidget "freq" xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNbackground (basic-color)
- XmNvalue (floor frequency)
- XmNmaximum 20000
- XmNtitleString freqstr
- XmNdecimalPoints 0))))
- (XmStringFree ampstr)
- (XmStringFree freqstr)
- (XtAddCallback amp-scale XmNvalueChangedCallback (lambda (w context info) (set! amplitude (* .01 (.value info)))))
- (XtAddCallback amp-scale XmNdragCallback (lambda (w context info) (set! amplitude (* .01 (.value info)))))
- (XtAddCallback freq-scale XmNvalueChangedCallback (lambda (w context info) (set! (mus-frequency carrier) (.value info))))
- (XtAddCallback freq-scale XmNdragCallback (lambda (w context info) (set! (mus-frequency carrier) (.value info))))
- (XtAddCallback button XmNvalueChangedCallback
- (lambda (w context info)
- (if running
- (set! running #f)
- (let* ((audio-info (open-play-output 1 44100 #f 256))
- (audio-fd (car audio-info))
- (outchans (cadr audio-info))
- (frames (caddr audio-info))
- (data (make-sound-data outchans frames)))
- (if (not (= audio-fd -1))
- (begin
- (set! running #t)
- (do ()
- ((not running)
- (begin
- (set! running #f)
- (mus-audio-close audio-fd)))
- (do ((k 0 (+ 1 k)))
- ((= k frames))
- (sound-data-set! data 0 k (v)))
- (mus-audio-write audio-fd data frames)))))))))))))
- (XtManageChild audit-dialog))
-
-
+
;;; -------- equalize-panes
;;;
;;; this used to be built-in, but never really worked right
+
+ (define* (equalize-panes snd)
+ (define (equalize-sound ind)
+ (let ((old-style (channel-style ind)))
+ (set! (channel-style ind) channels-combined)
+ (set! (channel-style ind) old-style)))
+ (if snd
+ (equalize-sound snd)
+ (for-each equalize-sound (sounds))))
+
+ ) ; end with-let *motif*
-(define* (equalize-panes snd)
- (define (equalize-sound ind)
- (let ((old-style (channel-style ind)))
- (set! (channel-style ind) channels-combined)
- (set! (channel-style ind) old-style)))
- (if snd
- (equalize-sound snd)
- (for-each equalize-sound (sounds))))
diff --git a/snd-nogui.c b/snd-nogui.c
index 5c333ab..9de8cb7 100644
--- a/snd-nogui.c
+++ b/snd-nogui.c
@@ -2,11 +2,13 @@
#include "snd-menu.h"
#include "snd-file.h"
-void display_minibuffer_error(snd_info *sp, const char *str) {fprintf(stderr, "%s\n", str);}
-void clear_minibuffer_error(snd_info *sp) {}
+void cleanup_file_monitor(void) {}
+void *unmonitor_file(void *watcher) {return(NULL);}
+void monitor_sound(snd_info *sp) {}
+
+bool find_dialog_is_active(void) {return(false);}
void snd_help_back_to_top(void) {}
color_t get_in_between_color(color_t fg, color_t bg) {return(0);}
-void set_find_dialog_label(const char *str) {}
void save_find_dialog_state(FILE *fd) {}
void check_menu_labels(int key, int state, bool extended) {}
int add_channel_window(snd_info *sound, int channel, int chan_y, int insertion, widget_t main, fw_button_t arrows, bool with_events) {return(0);}
@@ -38,7 +40,7 @@ void set_with_gl(bool val, bool dpys) {}
void set_sono_rectangle(int j, int color, int x, int y, int width, int height) {}
void draw_sono_rectangles(graphics_context *ax, int color, int jmax) {}
void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, int num, int *colors, int axis_y0, color_t default_color) {}
-widget_t start_color_orientation_dialog(bool managed) {return(0);}
+widget_t make_color_orientation_dialog(bool managed) {return(0);}
void set_color_scale(mus_float_t val) {}
void set_color_inverted(bool val) {}
void set_color_cutoff(mus_float_t val) {}
@@ -60,19 +62,17 @@ void listener_append_and_prompt(const char *msg) {fprintf(stderr, "%s", msg);}
void goto_listener(void) {}
int save_listener_text(FILE *fp) {return(0);}
void append_listener_text(int end, const char *msg) {}
-void listener_delete_text(int new_end) {}
void listener_append(const char *msg) {fprintf(stderr, "%s", msg);}
void handle_listener(bool new_state) {}
bool listener_exists(void) {return(false);}
int listener_height(void) {return(0);}
int listener_width(void) {return(0);}
-bool highlight_unbalanced_paren(void) {return(true);}
void set_button_label(int label, const char *str) {}
int g_add_to_main_menu(const char *label, int slot) {return(0);}
widget_t g_add_to_menu(int which_menu, const char *label, int callb, int position) {return(0);}
int g_remove_from_menu(int which_menu, const char *label) {return(0);}
void reflect_play_selection_stop(void) {}
-int fire_up_transform_dialog(bool managed) {return(0);}
+int make_transform_dialog(bool managed) {return(0);}
bool transform_dialog_is_active(void) {return(false);}
void set_show_transform_peaks(bool val) {}
void set_fft_log_magnitude(bool val) {}
@@ -81,8 +81,9 @@ void set_fft_log_frequency(bool val) {}
void set_transform_normalization(fft_normalize_t val) {}
void set_show_selection_transform(bool show) {}
void reflect_regions_in_region_browser(void) {}
+void reflect_selection_in_save_as_dialog(bool on) {}
void reflect_no_regions_in_region_browser(void) {}
-void update_region_browser(bool grf_too) {}
+int update_region_browser(bool grf_too) {return(0);}
bool region_browser_is_active(void) {return(false);}
void delete_region_and_update_browser(int n) {}
void reflect_play_region_stop(int n) {}
@@ -138,12 +139,7 @@ color_t get_foreground_color(graphics_context *ax) {return(0);}
void set_foreground_color(graphics_context *ax, int color) {}
void change_channel_style(snd_info *sp, channel_style_t new_style) {}
void cleanup_cw(chan_info *cp) {}
-void clear_deleted_snd_info(struct dialog_play_info *dp) {}
-void make_minibuffer_label(snd_info *sp, const char *str) {}
-void goto_minibuffer(snd_info *sp) {}
-void set_minibuffer_string(snd_info *sp, const char *str, bool update) {if ((str) && (*str)) fprintf(stderr, "%s", str);}
-void set_minibuffer_cursor_position(snd_info *sp, int pos) {}
-char *get_minibuffer_string(snd_info *sp) {return(NULL);}
+void set_status(snd_info *sp, const char *str, bool update) {if ((str) && (*str)) fprintf(stderr, "%s", str);}
void snd_info_cleanup(snd_info *sp) {}
void toggle_expand_button(snd_info *sp, bool state) {}
void toggle_contrast_button(snd_info *sp, bool state) {}
@@ -156,8 +152,6 @@ void play_button_pause(bool pausing) {}
void syncb(snd_info *sp, int on) {sp->sync = on; if (on > ss->sound_sync_max) ss->sound_sync_max = on;}
void show_lock(snd_info *sp) {}
void hide_lock(snd_info *sp) {}
-void show_bomb(snd_info *sp) {}
-void hide_bomb(snd_info *sp) {}
void start_bomb(snd_info *sp) {}
void stop_bomb(snd_info *sp) {}
void set_sound_pane_file_label(snd_info *sp, const char *str) {}
@@ -168,13 +162,11 @@ bool showing_controls(snd_info *sp) {return(false);}
void start_progress_report(chan_info *cp) {}
void finish_progress_report(chan_info *cp) {}
void progress_report(chan_info *cp, mus_float_t pct) {}
-char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, int *type, int *format, mus_long_t *location, mus_long_t *samples, int min_chan) {return(NULL);}
-void alert_new_file(void) {}
+char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, mus_header_t *header_type,
+ mus_sample_t *sample_type, mus_long_t *location, mus_long_t *samples, int min_chan) {return(NULL);}
widget_t make_new_file_dialog(bool managed) {return(0);}
int edit_header(snd_info *sp) {return(0);}
void save_edit_header_dialog_state(FILE *fd) {}
-void cleanup_edit_header_watcher(void) {}
-void cleanup_new_file_watcher(void) {}
widget_t make_selection_save_as_dialog(bool managed) {return(0);}
widget_t make_region_save_as_dialog(bool managed) {return(0);}
widget_t make_sound_save_as_dialog(bool managed) {return(0);}
@@ -187,6 +179,7 @@ void set_enved_revert_sensitive(bool val) {}
void set_enved_undo_sensitive(bool val) {}
void set_enved_save_sensitive(bool val) {}
void set_enved_show_sensitive(bool val) {}
+void enved_reflect_selection(bool on) {}
void make_scrolled_env_list(void) {}
void enved_reflect_peak_env_completion(snd_info *sp) {}
void new_active_channel_alert(void) {}
@@ -194,15 +187,14 @@ void env_redisplay(void) {}
void env_redisplay_with_print(void) {}
void update_enved_background_waveform(chan_info *cp) {}
int create_envelope_editor(void) {return(0);}
-void set_enved_clip_p(bool val) {}
+void set_enved_clipping(bool val) {}
void reflect_enved_style(void) {}
void set_enved_base(mus_float_t val) {}
void set_enved_target(enved_target_t val) {}
-void set_enved_wave_p(bool val) {}
+void set_enved_with_wave(bool val) {}
void set_enved_in_dB(bool val) {}
bool enved_dialog_is_active(void) {return(false);}
void set_enved_filter_order(int order) {}
-widget_t record_file(void) {return(0);}
widget_t make_open_file_dialog(read_only_t read_only, bool managed) {return(0);}
widget_t make_mix_file_dialog(bool managed) {return(0);}
widget_t make_insert_file_dialog(bool managed) {return(0);}
@@ -238,33 +230,12 @@ void post_basic_popup_menu(void *ev) {}
void post_lisp_popup_menu(void *ev) {}
void post_fft_popup_menu(void *ev) {}
void post_selection_popup_menu(void *ev) {}
-vf_row *view_files_make_row(view_files_info *vdat, widget_t last_row) {return(NULL);}
-void vf_unhighlight_row(widget_t nm, widget_t rw) {}
-void vf_highlight_row(widget_t nm, widget_t rw) {}
-void vf_post_info(view_files_info *vdat, int pos) {}
-void vf_unpost_info(view_files_info *vdat) {}
-void vf_flash_row(vf_row *r) {}
-mus_long_t vf_location(view_files_info *vdat) {return(0);}
-void vf_post_error(const char *error_msg, view_files_info *data) {}
-void redirect_vf_post_error(const char *error_msg, void *data) {}
-void redirect_vf_post_location_error(const char *error_msg, void *data) {}
-void vf_post_add_error(const char *error_msg, view_files_info *data) {}
-widget_t start_view_files_dialog_1(view_files_info *vdat, bool managed) {return(NULL_WIDGET);}
-void vf_post_selected_files_list(view_files_info *vdat) {}
-void view_files_add_file_or_directory(view_files_info *vdat, const char *file_or_dir) {}
-void vf_reflect_sort_choice_in_menu(view_files_info *vdat) {}
-void vf_set_amp(view_files_info *vdat, mus_float_t val) {}
-void vf_set_speed(view_files_info *vdat, mus_float_t val) {}
-void vf_set_amp_env(view_files_info *vdat, env *new_e) {}
void ensure_scrolled_window_row_visible(widget_t list, int pos, int num_rows) {}
-widget_t start_preferences_dialog(void) {return(NULL_WIDGET);}
+widget_t make_preferences_dialog(void) {return(NULL_WIDGET);}
+void update_sound_label(snd_info *sp) {}
void auto_update_restart(void) {}
-int mus_char_to_bint(const unsigned char *inp);
-int mus_char_to_lint(const unsigned char *inp);
-
-
snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr)
{
snd_info *sp;
@@ -311,21 +282,9 @@ static char **auto_open_file_names = NULL;
static int auto_open_files = 0;
static bool noglob = false, noinit = false, nostdin = false;
-#if HAVE_SETJMP_H
+#ifndef _MSC_VER
#include <setjmp.h>
-#if MUS_TRAP_SEGFAULT
-/* stolen from scwm.c */
-static sigjmp_buf envHandleEventsLoop;
-
-
-static void segv(int ignored)
-{
- siglongjmp(envHandleEventsLoop, 1);
-}
-#endif
-
-
static jmp_buf top_level_jump;
void top_level_catch(int ignore);
void top_level_catch(int ignore)
@@ -336,7 +295,7 @@ void top_level_catch(int ignore)
#define FALLBACK_FONT "9x15"
-static XEN colormap_temp[16]; /* static for Ruby's sake */
+static Xen colormap_temp[16]; /* static for Ruby's sake */
void snd_doit(int argc, char **argv)
{
@@ -345,252 +304,252 @@ void snd_doit(int argc, char **argv)
ss->axis_color_set = false;
#if HAVE_SCHEME
- xen_s7_set_repl_prompt("snd>");
+ xen_s7_set_repl_prompt("snd> ");
#endif
- XEN_DEFINE_VARIABLE("black-and-white-colormap", colormap_temp[0], C_TO_XEN_INT(0));
- XEN_DEFINE_VARIABLE("gray-colormap", colormap_temp[1], C_TO_XEN_INT(1));
- XEN_DEFINE_VARIABLE("hot-colormap", colormap_temp[2], C_TO_XEN_INT(2));
- XEN_DEFINE_VARIABLE("cool-colormap", colormap_temp[3], C_TO_XEN_INT(3));
- XEN_DEFINE_VARIABLE("bone-colormap", colormap_temp[4], C_TO_XEN_INT(4));
- XEN_DEFINE_VARIABLE("copper-colormap", colormap_temp[5], C_TO_XEN_INT(5));
- XEN_DEFINE_VARIABLE("pink-colormap", colormap_temp[6], C_TO_XEN_INT(6));
- XEN_DEFINE_VARIABLE("jet-colormap", colormap_temp[7], C_TO_XEN_INT(7));
- XEN_DEFINE_VARIABLE("prism-colormap", colormap_temp[8], C_TO_XEN_INT(8));
- XEN_DEFINE_VARIABLE("autumn-colormap", colormap_temp[9], C_TO_XEN_INT(9));
- XEN_DEFINE_VARIABLE("winter-colormap", colormap_temp[10], C_TO_XEN_INT(10));
- XEN_DEFINE_VARIABLE("spring-colormap", colormap_temp[11], C_TO_XEN_INT(11));
- XEN_DEFINE_VARIABLE("summer-colormap", colormap_temp[12], C_TO_XEN_INT(12));
- XEN_DEFINE_VARIABLE("rainbow-colormap", colormap_temp[13], C_TO_XEN_INT(13));
- XEN_DEFINE_VARIABLE("flag-colormap", colormap_temp[14], C_TO_XEN_INT(14));
- XEN_DEFINE_VARIABLE("phases-colormap", colormap_temp[15], C_TO_XEN_INT(15));
+ Xen_define_variable("black-and-white-colormap", colormap_temp[0], C_int_to_Xen_integer(0));
+ Xen_define_variable("gray-colormap", colormap_temp[1], C_int_to_Xen_integer(1));
+ Xen_define_variable("hot-colormap", colormap_temp[2], C_int_to_Xen_integer(2));
+ Xen_define_variable("cool-colormap", colormap_temp[3], C_int_to_Xen_integer(3));
+ Xen_define_variable("bone-colormap", colormap_temp[4], C_int_to_Xen_integer(4));
+ Xen_define_variable("copper-colormap", colormap_temp[5], C_int_to_Xen_integer(5));
+ Xen_define_variable("pink-colormap", colormap_temp[6], C_int_to_Xen_integer(6));
+ Xen_define_variable("jet-colormap", colormap_temp[7], C_int_to_Xen_integer(7));
+ Xen_define_variable("prism-colormap", colormap_temp[8], C_int_to_Xen_integer(8));
+ Xen_define_variable("autumn-colormap", colormap_temp[9], C_int_to_Xen_integer(9));
+ Xen_define_variable("winter-colormap", colormap_temp[10], C_int_to_Xen_integer(10));
+ Xen_define_variable("spring-colormap", colormap_temp[11], C_int_to_Xen_integer(11));
+ Xen_define_variable("summer-colormap", colormap_temp[12], C_int_to_Xen_integer(12));
+ Xen_define_variable("rainbow-colormap", colormap_temp[13], C_int_to_Xen_integer(13));
+ Xen_define_variable("flag-colormap", colormap_temp[14], C_int_to_Xen_integer(14));
+ Xen_define_variable("phases-colormap", colormap_temp[15], C_int_to_Xen_integer(15));
#if HAVE_SCHEME
- XEN_EVAL_C_STRING("(define " S_color_hook " (make-hook 0))");
- XEN_EVAL_C_STRING("(define " S_drop_hook " (make-hook 1))");
- XEN_EVAL_C_STRING("(define " S_listener_click_hook " (make-hook 1)) ");
- XEN_EVAL_C_STRING("(define " S_mouse_enter_graph_hook " (make-hook 2))");
- XEN_EVAL_C_STRING("(define " S_mouse_enter_label_hook " (make-hook 3))");
- XEN_EVAL_C_STRING("(define " S_mouse_enter_listener_hook " (make-hook 1))");
- XEN_EVAL_C_STRING("(define " S_mouse_enter_text_hook " (make-hook 1))");
- XEN_EVAL_C_STRING("(define " S_mouse_leave_graph_hook " (make-hook 2))");
- XEN_EVAL_C_STRING("(define " S_mouse_leave_label_hook " (make-hook 3))");
- XEN_EVAL_C_STRING("(define " S_mouse_leave_listener_hook " (make-hook 1))");
- XEN_EVAL_C_STRING("(define " S_mouse_leave_text_hook " (make-hook 1))");
- XEN_EVAL_C_STRING("(define " S_new_widget_hook " (make-hook 1))");
- XEN_EVAL_C_STRING("(define " S_orientation_hook " (make-hook 0))");
-
- XEN_EVAL_C_STRING("(define " S_copy_context " 0)");
- XEN_EVAL_C_STRING("(define " S_cursor_context " 3)");
- XEN_EVAL_C_STRING("(define " S_lisp_graph " 2)");
- XEN_EVAL_C_STRING("(define " S_mark_context " 4)");
- XEN_EVAL_C_STRING("(define " S_selection_context " 2)");
- XEN_EVAL_C_STRING("(define " S_time_graph " 0)");
- XEN_EVAL_C_STRING("(define " S_transform_graph " 1)");
-
- XEN_EVAL_C_STRING("(define " S_basic_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_colormap " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_colormap_size " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_cursor_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_data_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_enved_envelope " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_enved_filter " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_enved_waveform_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_filter_control_waveform_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_graph_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_graph_cursor " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_listener_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_listener_text_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_axis_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_mark_color " (make-procedure-with-setter (lambda args #f) (lambda args #f)))");
- XEN_EVAL_C_STRING("(define " S_mix_color " (make-procedure-with-setter (lambda args #f) (lambda args #f)))");
- XEN_EVAL_C_STRING("(define " S_combined_data_color " (make-procedure-with-setter (lambda args #f) (lambda args #f)))");
- XEN_EVAL_C_STRING("(define " S_position_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_foreground_color " (make-procedure-with-setter (lambda args #f) (lambda args (car args))))");
- XEN_EVAL_C_STRING("(define " S_sash_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_selected_data_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_selected_graph_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_text_focus_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_x_axis_label " (make-procedure-with-setter (lambda args \"\") (lambda args \"\")))");
- XEN_EVAL_C_STRING("(define " S_y_axis_label " (make-procedure-with-setter (lambda args \"\") (lambda args \"\")))");
- XEN_EVAL_C_STRING("(define " S_zoom_color " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_widget_size " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
- XEN_EVAL_C_STRING("(define " S_widget_position " (make-procedure-with-setter (lambda () #f) (lambda (val) val)))");
-
- XEN_EVAL_C_STRING("(define (" S_make_cairo " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_free_cairo " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_axis_info " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_channel_widgets " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_color_p " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_color_to_list " .args) #f)");
- XEN_EVAL_C_STRING("(define (" S_colormap_p " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_current_font ") #f)");
- XEN_EVAL_C_STRING("(define (" S_dialog_widgets ") #f)");
- XEN_EVAL_C_STRING("(define (" S_graph_data " . args) #f)");
-
- XEN_EVAL_C_STRING("(define (" S_in " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_main_widgets " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_make_color " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_make_graph_data " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_menu_widgets " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_reset_listener_cursor ") #f)");
- XEN_EVAL_C_STRING("(define (" S_sound_widgets " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_view_regions_dialog " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_find_dialog " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_widget_text " . args) \"\")");
- XEN_EVAL_C_STRING("(define (" S_goto_listener_end ") #f)");
- XEN_EVAL_C_STRING("(define (" S_y_to_position " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_x_to_position " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_snd_gcs " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_show_widget " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_position_to_y " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_position_to_x " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_listener_selection " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_hide_widget " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_focus_widget " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_fill_rectangle " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_fill_polygon " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_draw_string " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_draw_lines " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_draw_line " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_draw_dots " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_draw_dot " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_draw_axes " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_delete_colormap " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_colormap_ref " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_colormap_name " . args) #f)");
- XEN_EVAL_C_STRING("(define (" S_add_colormap " . args) #f)");
-
- XEN_EVAL_C_STRING("(define " S_x_bounds " (make-procedure-with-setter (lambda args #f) (lambda args #f)))");
- XEN_EVAL_C_STRING("(define " S_y_bounds " (make-procedure-with-setter (lambda args #f) (lambda args #f)))");
+ Xen_eval_C_string("(define " S_color_hook " (make-hook))");
+ Xen_eval_C_string("(define " S_drop_hook " (make-hook 'name))");
+ Xen_eval_C_string("(define " S_listener_click_hook " (make-hook 'position)) ");
+ Xen_eval_C_string("(define " S_mouse_enter_graph_hook " (make-hook 'snd 'chn))");
+ Xen_eval_C_string("(define " S_mouse_enter_label_hook " (make-hook 'type 'position 'label))");
+ Xen_eval_C_string("(define " S_mouse_enter_listener_hook " (make-hook 'widget))");
+ Xen_eval_C_string("(define " S_mouse_enter_text_hook " (make-hook 'widget))");
+ Xen_eval_C_string("(define " S_mouse_leave_graph_hook " (make-hook 'snd 'chn))");
+ Xen_eval_C_string("(define " S_mouse_leave_label_hook " (make-hook 'type 'position 'label))");
+ Xen_eval_C_string("(define " S_mouse_leave_listener_hook " (make-hook 'widget))");
+ Xen_eval_C_string("(define " S_mouse_leave_text_hook " (make-hook 'widget))");
+ Xen_eval_C_string("(define " S_new_widget_hook " (make-hook 'widget))");
+ Xen_eval_C_string("(define " S_orientation_hook " (make-hook))");
+
+ Xen_eval_C_string("(define " S_copy_context " 0)");
+ Xen_eval_C_string("(define " S_cursor_context " 3)");
+ Xen_eval_C_string("(define " S_lisp_graph " 2)");
+ Xen_eval_C_string("(define " S_mark_context " 4)");
+ Xen_eval_C_string("(define " S_selection_context " 2)");
+ Xen_eval_C_string("(define " S_time_graph " 0)");
+ Xen_eval_C_string("(define " S_transform_graph " 1)");
+
+ Xen_eval_C_string("(define " S_basic_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_colormap " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_colormap_size " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_cursor_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_data_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_enved_envelope " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_enved_filter " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_enved_waveform_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_filter_control_waveform_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_graph_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_graph_cursor " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_listener_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_listener_text_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_axis_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_mark_color " (dilambda (lambda args #f) (lambda args #f)))");
+ Xen_eval_C_string("(define " S_mix_color " (dilambda (lambda args #f) (lambda args #f)))");
+ Xen_eval_C_string("(define " S_combined_data_color " (dilambda (lambda args #f) (lambda args #f)))");
+ Xen_eval_C_string("(define " S_position_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_foreground_color " (dilambda (lambda args #f) (lambda args (car args))))");
+ Xen_eval_C_string("(define " S_sash_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_selected_data_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_selected_graph_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_text_focus_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_x_axis_label " (dilambda (lambda args \"\") (lambda args \"\")))");
+ Xen_eval_C_string("(define " S_y_axis_label " (dilambda (lambda args \"\") (lambda args \"\")))");
+ Xen_eval_C_string("(define " S_zoom_color " (dilambda (lambda () #f) (lambda (val) val)))");
+ Xen_eval_C_string("(define " S_widget_size " (dilambda (lambda (w) #f) (lambda (w val) val)))");
+ Xen_eval_C_string("(define " S_widget_position " (dilambda (lambda (w) #f) (lambda (w val) val)))");
+
+ Xen_eval_C_string("(define (" S_make_cairo " . args) #f)");
+ Xen_eval_C_string("(define (" S_free_cairo " . args) #f)");
+ Xen_eval_C_string("(define (" S_axis_info " . args) #f)");
+ Xen_eval_C_string("(define (" S_channel_widgets " . args) #f)");
+ Xen_eval_C_string("(define (" S_is_color " obj) #f)");
+ Xen_eval_C_string("(define (" S_color_to_list " obj) #f)");
+ Xen_eval_C_string("(define (" S_is_colormap " obj) #f)");
+ Xen_eval_C_string("(define (" S_current_font " . args) #f)");
+ Xen_eval_C_string("(define (" S_dialog_widgets ") #f)");
+ Xen_eval_C_string("(define (" S_graph_data " . args) #f)");
+
+ Xen_eval_C_string("(define (" S_in " . args) #f)");
+ Xen_eval_C_string("(define (" S_main_widgets ") #f)");
+ Xen_eval_C_string("(define (" S_make_color " . args) #f)");
+ Xen_eval_C_string("(define (" S_make_graph_data " . args) #f)");
+ Xen_eval_C_string("(define (" S_menu_widgets " . args) #f)");
+ Xen_eval_C_string("(define (" S_reset_listener_cursor ") #f)");
+ Xen_eval_C_string("(define (" S_sound_widgets " . args) #f)");
+ Xen_eval_C_string("(define (" S_view_regions_dialog " . args) #f)");
+ Xen_eval_C_string("(define (" S_find_dialog " . args) #f)");
+ Xen_eval_C_string("(define (" S_widget_text " . args) \"\")");
+ Xen_eval_C_string("(define (" S_goto_listener_end ") #f)");
+ Xen_eval_C_string("(define (" S_y_to_position " . args) #f)");
+ Xen_eval_C_string("(define (" S_x_to_position " . args) #f)");
+ Xen_eval_C_string("(define (" S_snd_gcs " . args) #f)");
+ Xen_eval_C_string("(define (" S_show_widget " . args) #f)");
+ Xen_eval_C_string("(define (" S_position_to_y " . args) #f)");
+ Xen_eval_C_string("(define (" S_position_to_x " . args) #f)");
+ Xen_eval_C_string("(define (" S_listener_selection " . args) #f)");
+ Xen_eval_C_string("(define (" S_hide_widget " arg) #f)");
+ Xen_eval_C_string("(define (" S_focus_widget " arg) #f)");
+ Xen_eval_C_string("(define (" S_fill_rectangle " . args) #f)");
+ Xen_eval_C_string("(define (" S_fill_polygon " . args) #f)");
+ Xen_eval_C_string("(define (" S_draw_string " . args) #f)");
+ Xen_eval_C_string("(define (" S_draw_lines " . args) #f)");
+ Xen_eval_C_string("(define (" S_draw_line " . args) #f)");
+ Xen_eval_C_string("(define (" S_draw_dots " . args) #f)");
+ Xen_eval_C_string("(define (" S_draw_dot " . args) #f)");
+ Xen_eval_C_string("(define (" S_draw_axes " . args) #f)");
+ Xen_eval_C_string("(define (" S_delete_colormap " . args) #f)");
+ Xen_eval_C_string("(define (" S_colormap_ref " . args) #f)");
+ Xen_eval_C_string("(define (" S_colormap_name " arg) #f)");
+ Xen_eval_C_string("(define (" S_add_colormap " . args) #f)");
+
+ Xen_eval_C_string("(define " S_x_bounds " (dilambda (lambda args #f) (lambda args #f)))");
+ Xen_eval_C_string("(define " S_y_bounds " (dilambda (lambda args #f) (lambda args #f)))");
#endif
#if HAVE_RUBY
- XEN_EVAL_C_STRING("def make_cairo (a) false end");
- XEN_EVAL_C_STRING("def free_cairo (a) false end");
- XEN_EVAL_C_STRING("def axis_info (s, c, a) false end");
- XEN_EVAL_C_STRING("def channel_widgets (s, c) false end");
- XEN_EVAL_C_STRING("def color? (a) false end");
- XEN_EVAL_C_STRING("def color_to_list (a) false end");
- XEN_EVAL_C_STRING("def current_font () false end");
- XEN_EVAL_C_STRING("def dialog_widgets () false end");
- XEN_EVAL_C_STRING("def enved_filter () false end");
- XEN_EVAL_C_STRING("def main_widgets (s) false end");
- XEN_EVAL_C_STRING("def make_color (r, g, b) false end");
- XEN_EVAL_C_STRING("def menu_widgets (s) false end");
- XEN_EVAL_C_STRING("def reset_listener_cursor () false end");
- XEN_EVAL_C_STRING("def sound_widgets (s) false end");
- XEN_EVAL_C_STRING("def view_regions_dialog () false end");
- XEN_EVAL_C_STRING("def find_dialog () false end");
- XEN_EVAL_C_STRING("def x_axis_label () false end");
- XEN_EVAL_C_STRING("def y_axis_label () false end");
-
- XEN_EVAL_C_STRING("def basic_color () false end");
- XEN_EVAL_C_STRING("def set_basic_color (a) false end");
- XEN_EVAL_C_STRING("def colormap () false end");
- XEN_EVAL_C_STRING("def set_colormap (a) false end");
- XEN_EVAL_C_STRING("def colormap_size () false end");
- XEN_EVAL_C_STRING("def set_colormap_size (a) false end");
- XEN_EVAL_C_STRING("def cursor_color () false end");
- XEN_EVAL_C_STRING("def set_cursor_color (a) false end");
- XEN_EVAL_C_STRING("def data_color () false end");
- XEN_EVAL_C_STRING("def set_data_color (a) false end");
- XEN_EVAL_C_STRING("def enved_envelope () false end");
- XEN_EVAL_C_STRING("def set_enved_envelope (a) false end");
- XEN_EVAL_C_STRING("def enved_waveform_color () false end");
- XEN_EVAL_C_STRING("def set_enved_waveform_color (a) false end");
- XEN_EVAL_C_STRING("def filter_control_waveform_color () false end");
- XEN_EVAL_C_STRING("def set_filter_control_waveform_color (a) false end");
- XEN_EVAL_C_STRING("def graph_color () false end");
- XEN_EVAL_C_STRING("def set_graph_color (a) false end");
- XEN_EVAL_C_STRING("def graph_cursor () false end");
- XEN_EVAL_C_STRING("def set_graph_cursor (a) false end");
- XEN_EVAL_C_STRING("def listener_color () false end");
- XEN_EVAL_C_STRING("def set_listener_color (a) false end");
- XEN_EVAL_C_STRING("def listener_text_color () false end");
- XEN_EVAL_C_STRING("def set_listener_text_color (a) false end");
- XEN_EVAL_C_STRING("def mark_color () false end");
- XEN_EVAL_C_STRING("def set_mark_color (m) false end");
- XEN_EVAL_C_STRING("def mix_color () false end");
- XEN_EVAL_C_STRING("def set_mix_color (m) false end");
- XEN_EVAL_C_STRING("def combined_data_color (a b) false end");
- XEN_EVAL_C_STRING("def set_combined_data_color (a b c) false end");
- XEN_EVAL_C_STRING("def position_color () false end");
- XEN_EVAL_C_STRING("def set_position_color (a) false end");
- XEN_EVAL_C_STRING("def foreground_color () false end");
- XEN_EVAL_C_STRING("def set_foreground_color (a) false end");
- XEN_EVAL_C_STRING("def sash_color () false end");
- XEN_EVAL_C_STRING("def set_sash_color (a) false end");
- XEN_EVAL_C_STRING("def selected_data_color () false end");
- XEN_EVAL_C_STRING("def set_selected_data_color (a) false end");
- XEN_EVAL_C_STRING("def selected_graph_color () false end");
- XEN_EVAL_C_STRING("def set_selected_graph_color (a) false end");
- XEN_EVAL_C_STRING("def text_focus_color () false end");
- XEN_EVAL_C_STRING("def set_text_focus_color (a) false end");
- XEN_EVAL_C_STRING("def zoom_color () false end");
- XEN_EVAL_C_STRING("def set_zoom_color (a) false end");
- XEN_EVAL_C_STRING("def widget_size () false end");
- XEN_EVAL_C_STRING("def set_widget_size (a) false end");
- XEN_EVAL_C_STRING("def widget_position () false end");
- XEN_EVAL_C_STRING("def set_widget_position (a) false end");
- XEN_EVAL_C_STRING("def colormap? (a) false end");
- XEN_EVAL_C_STRING("def in (a, b) false end");
- XEN_EVAL_C_STRING("def widget_text (a) false end");
-
- XEN_EVAL_C_STRING("def y2position (a) false end");
- XEN_EVAL_C_STRING("def x2position (a) false end");
- XEN_EVAL_C_STRING("def position2y (a) false end");
- XEN_EVAL_C_STRING("def position2x (a) false end");
- XEN_EVAL_C_STRING("def snd_gcs (a) false end");
- XEN_EVAL_C_STRING("def show_widget (a) false end");
- XEN_EVAL_C_STRING("def listener_selection (a) false end");
- XEN_EVAL_C_STRING("def hide_widget (a) false end");
- XEN_EVAL_C_STRING("def focus_widget (a) false end");
- XEN_EVAL_C_STRING("def fill_rectangle (a) false end");
- XEN_EVAL_C_STRING("def fill_polygon (a) false end");
- XEN_EVAL_C_STRING("def draw_string (a) false end");
- XEN_EVAL_C_STRING("def draw_lines (a) false end");
- XEN_EVAL_C_STRING("def draw_line (a) false end");
- XEN_EVAL_C_STRING("def draw_dots (a) false end");
- XEN_EVAL_C_STRING("def draw_dot (a) false end");
- XEN_EVAL_C_STRING("def draw_axes (a) false end");
- XEN_EVAL_C_STRING("def delete_colormap (a) false end");
- XEN_EVAL_C_STRING("def colormap_ref (a) false end");
- XEN_EVAL_C_STRING("def colormap_name (a) false end");
- XEN_EVAL_C_STRING("def add_colormap (a) false end");
-
- XEN_EVAL_C_STRING("def make_graph_data (a, b, c) false end");
- XEN_EVAL_C_STRING("def graph_data (a, b, c) false end");
-
- XEN_EVAL_C_STRING("$drop_hook = false");
- XEN_EVAL_C_STRING("$listener_click_hook = false");
- XEN_EVAL_C_STRING("$mouse_enter_graph_hook = false");
- XEN_EVAL_C_STRING("$mouse_enter_label_hook = false");
- XEN_EVAL_C_STRING("$mouse_enter_listener_hook = false");
- XEN_EVAL_C_STRING("$mouse_enter_text_hook = false");
- XEN_EVAL_C_STRING("$mouse_leave_graph_hook = false");
- XEN_EVAL_C_STRING("$mouse_leave_label_hook = false");
- XEN_EVAL_C_STRING("$mouse_leave_listener_hook = false");
- XEN_EVAL_C_STRING("$mouse_leave_text_hook = false");
- XEN_EVAL_C_STRING("$new_widget_hook = false");
- XEN_EVAL_C_STRING("$orientation_hook = false");
-
- XEN_EVAL_C_STRING("Copy_context = 0");
- XEN_EVAL_C_STRING("Cursor_context = 3");
- XEN_EVAL_C_STRING("Lisp_graph = 2");
- XEN_EVAL_C_STRING("Mark_context = 4");
- XEN_EVAL_C_STRING("Selection_context = 2");
- XEN_EVAL_C_STRING("Time_graph = 0");
- XEN_EVAL_C_STRING("Transform_graph = 1");
-
- XEN_EVAL_C_STRING("def x_bounds (s, c, a) false end");
- XEN_EVAL_C_STRING("def set_x_bounds (s, c, ax, a) false end");
- XEN_EVAL_C_STRING("def y_bounds (s, c, a) false end");
- XEN_EVAL_C_STRING("def set_y_bounds (s, c, ax, a) false end");
+ Xen_eval_C_string("def make_cairo (a) false end");
+ Xen_eval_C_string("def free_cairo (a) false end");
+ Xen_eval_C_string("def axis_info (s, c, a) false end");
+ Xen_eval_C_string("def channel_widgets (s, c) false end");
+ Xen_eval_C_string("def color? (a) false end");
+ Xen_eval_C_string("def color_to_list (a) false end");
+ Xen_eval_C_string("def current_font () false end");
+ Xen_eval_C_string("def dialog_widgets () false end");
+ Xen_eval_C_string("def enved_filter () false end");
+ Xen_eval_C_string("def main_widgets (s) false end");
+ Xen_eval_C_string("def make_color (r, g, b) false end");
+ Xen_eval_C_string("def menu_widgets (s) false end");
+ Xen_eval_C_string("def reset_listener_cursor () false end");
+ Xen_eval_C_string("def sound_widgets (s) false end");
+ Xen_eval_C_string("def view_regions_dialog () false end");
+ Xen_eval_C_string("def find_dialog () false end");
+ Xen_eval_C_string("def x_axis_label () false end");
+ Xen_eval_C_string("def y_axis_label () false end");
+
+ Xen_eval_C_string("def basic_color () false end");
+ Xen_eval_C_string("def set_basic_color (a) false end");
+ Xen_eval_C_string("def colormap () false end");
+ Xen_eval_C_string("def set_colormap (a) false end");
+ Xen_eval_C_string("def colormap_size () false end");
+ Xen_eval_C_string("def set_colormap_size (a) false end");
+ Xen_eval_C_string("def cursor_color () false end");
+ Xen_eval_C_string("def set_cursor_color (a) false end");
+ Xen_eval_C_string("def data_color () false end");
+ Xen_eval_C_string("def set_data_color (a) false end");
+ Xen_eval_C_string("def enved_envelope () false end");
+ Xen_eval_C_string("def set_enved_envelope (a) false end");
+ Xen_eval_C_string("def enved_waveform_color () false end");
+ Xen_eval_C_string("def set_enved_waveform_color (a) false end");
+ Xen_eval_C_string("def filter_control_waveform_color () false end");
+ Xen_eval_C_string("def set_filter_control_waveform_color (a) false end");
+ Xen_eval_C_string("def graph_color () false end");
+ Xen_eval_C_string("def set_graph_color (a) false end");
+ Xen_eval_C_string("def graph_cursor () false end");
+ Xen_eval_C_string("def set_graph_cursor (a) false end");
+ Xen_eval_C_string("def listener_color () false end");
+ Xen_eval_C_string("def set_listener_color (a) false end");
+ Xen_eval_C_string("def listener_text_color () false end");
+ Xen_eval_C_string("def set_listener_text_color (a) false end");
+ Xen_eval_C_string("def mark_color () false end");
+ Xen_eval_C_string("def set_mark_color (m) false end");
+ Xen_eval_C_string("def mix_color () false end");
+ Xen_eval_C_string("def set_mix_color (m) false end");
+ Xen_eval_C_string("def combined_data_color (a b) false end");
+ Xen_eval_C_string("def set_combined_data_color (a b c) false end");
+ Xen_eval_C_string("def position_color () false end");
+ Xen_eval_C_string("def set_position_color (a) false end");
+ Xen_eval_C_string("def foreground_color () false end");
+ Xen_eval_C_string("def set_foreground_color (a) false end");
+ Xen_eval_C_string("def sash_color () false end");
+ Xen_eval_C_string("def set_sash_color (a) false end");
+ Xen_eval_C_string("def selected_data_color () false end");
+ Xen_eval_C_string("def set_selected_data_color (a) false end");
+ Xen_eval_C_string("def selected_graph_color () false end");
+ Xen_eval_C_string("def set_selected_graph_color (a) false end");
+ Xen_eval_C_string("def text_focus_color () false end");
+ Xen_eval_C_string("def set_text_focus_color (a) false end");
+ Xen_eval_C_string("def zoom_color () false end");
+ Xen_eval_C_string("def set_zoom_color (a) false end");
+ Xen_eval_C_string("def widget_size () false end");
+ Xen_eval_C_string("def set_widget_size (a) false end");
+ Xen_eval_C_string("def widget_position () false end");
+ Xen_eval_C_string("def set_widget_position (a) false end");
+ Xen_eval_C_string("def colormap? (a) false end");
+ Xen_eval_C_string("def in (a, b) false end");
+ Xen_eval_C_string("def widget_text (a) false end");
+
+ Xen_eval_C_string("def y2position (a) false end");
+ Xen_eval_C_string("def x2position (a) false end");
+ Xen_eval_C_string("def position2y (a) false end");
+ Xen_eval_C_string("def position2x (a) false end");
+ Xen_eval_C_string("def snd_gcs (a) false end");
+ Xen_eval_C_string("def show_widget (a) false end");
+ Xen_eval_C_string("def listener_selection (a) false end");
+ Xen_eval_C_string("def hide_widget (a) false end");
+ Xen_eval_C_string("def focus_widget (a) false end");
+ Xen_eval_C_string("def fill_rectangle (a) false end");
+ Xen_eval_C_string("def fill_polygon (a) false end");
+ Xen_eval_C_string("def draw_string (a) false end");
+ Xen_eval_C_string("def draw_lines (a) false end");
+ Xen_eval_C_string("def draw_line (a) false end");
+ Xen_eval_C_string("def draw_dots (a) false end");
+ Xen_eval_C_string("def draw_dot (a) false end");
+ Xen_eval_C_string("def draw_axes (a) false end");
+ Xen_eval_C_string("def delete_colormap (a) false end");
+ Xen_eval_C_string("def colormap_ref (a) false end");
+ Xen_eval_C_string("def colormap_name (a) false end");
+ Xen_eval_C_string("def add_colormap (a) false end");
+
+ Xen_eval_C_string("def make_graph_data (a, b, c) false end");
+ Xen_eval_C_string("def graph_data (a, b, c) false end");
+
+ Xen_eval_C_string("$drop_hook = false");
+ Xen_eval_C_string("$listener_click_hook = false");
+ Xen_eval_C_string("$mouse_enter_graph_hook = false");
+ Xen_eval_C_string("$mouse_enter_label_hook = false");
+ Xen_eval_C_string("$mouse_enter_listener_hook = false");
+ Xen_eval_C_string("$mouse_enter_text_hook = false");
+ Xen_eval_C_string("$mouse_leave_graph_hook = false");
+ Xen_eval_C_string("$mouse_leave_label_hook = false");
+ Xen_eval_C_string("$mouse_leave_listener_hook = false");
+ Xen_eval_C_string("$mouse_leave_text_hook = false");
+ Xen_eval_C_string("$new_widget_hook = false");
+ Xen_eval_C_string("$orientation_hook = false");
+
+ Xen_eval_C_string("Copy_context = 0");
+ Xen_eval_C_string("Cursor_context = 3");
+ Xen_eval_C_string("Lisp_graph = 2");
+ Xen_eval_C_string("Mark_context = 4");
+ Xen_eval_C_string("Selection_context = 2");
+ Xen_eval_C_string("Time_graph = 0");
+ Xen_eval_C_string("Transform_graph = 1");
+
+ Xen_eval_C_string("def x_bounds (s, c, a) false end");
+ Xen_eval_C_string("def set_x_bounds (s, c, ax, a) false end");
+ Xen_eval_C_string("def y_bounds (s, c, a) false end");
+ Xen_eval_C_string("def set_y_bounds (s, c, ax, a) false end");
#endif
#if HAVE_FORTH
- XEN_EVAL_C_STRING("\
+ Xen_eval_C_string("\
0 #f create-hook " S_color_hook "\n\
1 #f create-hook " S_drop_hook "\n\
1 #f create-hook " S_listener_click_hook "\n\
@@ -605,7 +564,7 @@ void snd_doit(int argc, char **argv)
1 #f create-hook " S_new_widget_hook "\n\
0 #f create-hook " S_orientation_hook "\n");
- XEN_EVAL_C_STRING("\
+ Xen_eval_C_string("\
0 constant " S_copy_context "\n\
3 constant " S_cursor_context "\n\
2 constant " S_lisp_graph "\n\
@@ -614,7 +573,7 @@ void snd_doit(int argc, char **argv)
0 constant " S_time_graph "\n\
1 constant " S_transform_graph "\n");
- XEN_EVAL_C_STRING("\
+ Xen_eval_C_string("\
: " S_basic_color " #f ;\n\
: set-" S_basic_color " { a } #f ;\n\
: " S_colormap " #f ;\n\
@@ -671,9 +630,9 @@ void snd_doit(int argc, char **argv)
: " S_y_bounds " { s c a } #f ;\n\
: set-" S_y_bounds " { a } #f ;\n\
: " S_channel_widgets " { s c } #f ;\n\
-: " S_color_p " { a } #f ;\n\
+: " S_is_color " { a } #f ;\n\
: " S_color_to_list " { a } #f ;\n\
-: " S_colormap_p " { a } #f ;\n\
+: " S_is_colormap " { a } #f ;\n\
: " S_current_font " #f ;\n\
: " S_dialog_widgets " #f ;\n\
: " S_focus_widget " #f ;\n\
@@ -700,61 +659,65 @@ void snd_doit(int argc, char **argv)
for (i = 1; i < argc; i++)
{
- if (strcmp(argv[i], "-noglob") == 0)
+ if (mus_strcmp(argv[i], "-noglob"))
noglob = true;
else
- if (strcmp(argv[i], "-noinit") == 0)
+ if (mus_strcmp(argv[i], "-noinit"))
noinit = true;
else
- if (strcmp(argv[i], "-nostdin") == 0)
+ if (mus_strcmp(argv[i], "-nostdin"))
nostdin = true;
else
- if ((strcmp(argv[i], "-b") == 0) || (strcmp(argv[i], "-batch") == 0))
+ if ((mus_strcmp(argv[i], "-b")) || (mus_strcmp(argv[i], "-batch")))
ss->batch_mode = true;
else
- if (strcmp(argv[i], "--features") == 0) /* testing (compsnd) */
+ if (mus_strcmp(argv[i], "--features")) /* testing (compsnd) */
check_features_list(argv[i + 1]);
}
snd_load_init_file(noglob, noinit);
-#if HAVE_SIGNAL && !__MINGW32__
+#if (!_MSC_VER) && !__MINGW32__
signal(SIGTTIN, SIG_IGN);
signal(SIGTTOU, SIG_IGN);
#endif
+#ifndef _MSC_VER
+ if (setjmp(top_level_jump))
+ {
+ if (!(ss->jump_ok))
+ snd_error_without_format("Caught top level error (will try to continue):\n");
+ else ss->jump_ok = false;
+ }
+ else
+ {
+#endif
+
auto_open_files = argc - 1;
if (argc > 1) auto_open_file_names = (char **)(argv + 1);
while (auto_open_ctr < auto_open_files)
auto_open_ctr = handle_next_startup_arg(auto_open_ctr, auto_open_file_names, false, auto_open_files);
-#if MUS_TRAP_SEGFAULT
- if (trap_segfault(ss)) signal(SIGSEGV, segv);
+#ifndef _MSC_VER
+ }
#endif
if ((ss->sounds) && (ss->sounds[0]) && ((ss->sounds[0])->inuse == SOUND_NORMAL))
select_channel(ss->sounds[0], 0);
-#if HAVE_SETJMP_H
-#if MUS_TRAP_SEGFAULT
- if (sigsetjmp(envHandleEventsLoop, 1))
- {
- if (!(ss->exiting))
- snd_error_without_format("Caught seg fault (will try to continue):\n");
- else
- {
- snd_error_without_format("Caught seg fault while trying to exit.\n");
- exit(0);
- }
- }
-#endif
- if (setjmp(top_level_jump))
+#if HAVE_SCHEME
+ if (!nostdin)
{
- if (!(ss->jump_ok))
- snd_error_without_format("Caught top level error (will try to continue):\n");
- else ss->jump_ok = false;
+ s7_load(s7, "repl.scm");
+ if ((listener_prompt(ss)) && (strcmp(listener_prompt(ss), DEFAULT_LISTENER_PROMPT) != 0))
+ s7_eval_c_string(s7, "(set! (*repl* 'prompt) \
+ (lambda (num) \
+ (with-let (sublet (*repl* 'repl-let) :num num) \
+ (set! prompt-string (format #f \"(~D)~A\" num *listener-prompt*)) \
+ (set! prompt-length (length prompt-string)))))");
+ s7_eval_c_string(s7, "((*repl* 'run))");
}
-#endif
-
+#else
if (!nostdin)
xen_repl(1, argv);
+#endif
}
diff --git a/snd-nogui0.h b/snd-nogui0.h
index 570d852..121ca66 100644
--- a/snd-nogui0.h
+++ b/snd-nogui0.h
@@ -18,10 +18,10 @@
#define activate_widget(Wid) Wid = 0
#define deactivate_widget(Wid) Wid = 0
-#define XEN_WRAP_WIDGET(Value) XEN_FALSE
-#define XEN_WRAP_WINDOW(Value) XEN_FALSE
-#define XEN_UNWRAP_WIDGET(Value) 0
-#define XEN_WIDGET_P(Value) 0
+#define Xen_wrap_widget(Value) Xen_false
+#define Xen_wrap_window(Value) Xen_false
+#define Xen_unwrap_widget(Value) 0
+#define Xen_is_widget(Value) 0
#define NULL_WIDGET 0
#define LOTSA_PIXELS 10000
@@ -34,6 +34,7 @@
#define TINY_FONT(a) 0
#define AXIS_NUMBERS_FONT(a) 0
#define PEAKS_FONT(a) 0
+#define DEFAULT_GRAPH_CURSOR 0
#define idle_t int
#define idle_func_t int
@@ -44,8 +45,8 @@
#define rgb_t unsigned short
#define RGB_MAX 65535
-#define FLOAT_TO_RGB(Val) (rgb_t)(RGB_MAX * (Val))
-#define RGB_TO_FLOAT(Val) (float)((float)(Val) / (float)RGB_MAX)
+#define float_to_rgb(Val) (rgb_t)(RGB_MAX * (Val))
+#define rgb_to_float(Val) (float)((float)(Val) / (float)RGB_MAX)
typedef struct {
@@ -54,7 +55,9 @@ typedef struct {
} graphics_context;
typedef struct {
- int current_type, current_format, formats, header_pos, format_pos, scanf_widget, error_widget;
+ mus_header_t current_header_type;
+ mus_sample_t current_sample_type;
+ int sample_types, header_type_pos, sample_type_pos, scanf_widget, error_widget;
} file_data;
typedef enum {NOT_A_SCANF_WIDGET} scanf_widget_t;
diff --git a/snd-nogui1.h b/snd-nogui1.h
index 12e4b9c..e19a62f 100644
--- a/snd-nogui1.h
+++ b/snd-nogui1.h
@@ -27,7 +27,7 @@ void allocate_sono_rects(int size);
void set_sono_rectangle(int j, int color, int x, int y, int width, int height);
void draw_sono_rectangles(graphics_context *ax, int color, int jmax);
void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, int num, int *colors, int axis_y0, color_t default_color);
-widget_t start_color_orientation_dialog(bool managed);
+widget_t make_color_orientation_dialog(bool managed);
void set_color_scale(mus_float_t val);
void set_color_inverted(bool val);
void set_color_cutoff(mus_float_t val);
@@ -45,7 +45,7 @@ void set_with_gl(bool val, bool dpys);
/* -------- snd-xfind.c -------- */
-void set_find_dialog_label(const char *str);
+bool find_dialog_is_active(void);
void save_find_dialog_state(FILE *fd);
@@ -53,7 +53,6 @@ void save_find_dialog_state(FILE *fd);
void append_listener_text(int end, const char *msg);
int save_listener_text(FILE *fp);
-void listener_delete_text(int new_end);
void listener_append_and_prompt(const char *msg);
void goto_listener(void);
void listener_append(const char *msg);
@@ -62,7 +61,6 @@ bool listener_exists(void);
int listener_height(void);
int listener_width(void);
void clear_listener(void);
-bool highlight_unbalanced_paren(void);
/* -------- snd-xmenu.c -------- */
@@ -93,7 +91,7 @@ void set_fft_window_alpha(mus_float_t val);
void set_transform_size(mus_long_t val);
void set_fft_window(mus_fft_window_t val);
void set_wavelet_type(int val);
-int fire_up_transform_dialog(bool managed);
+int make_transform_dialog(bool managed);
bool transform_dialog_is_active(void);
void set_transform_type(int val);
void set_show_transform_peaks(bool val);
@@ -115,7 +113,7 @@ void make_transform_type_list(void);
/* -------- snd-xregion.c -------- */
-void update_region_browser(bool grf_too);
+int update_region_browser(bool grf_too);
bool region_browser_is_active(void);
void delete_region_and_update_browser(int n);
void reflect_play_region_stop(int n);
@@ -188,11 +186,7 @@ int add_channel_window(snd_info *sound, int channel, int chan_y, int insertion,
/* -------- snd-xsnd.c -------- */
-void make_minibuffer_label(snd_info *sp, const char *str);
-void goto_minibuffer(snd_info *sp);
-void set_minibuffer_string(snd_info *sp, const char *str, bool update);
-void set_minibuffer_cursor_position(snd_info *sp, int pos);
-char *get_minibuffer_string(snd_info *sp);
+void set_status(snd_info *sp, const char *str, bool update);
void snd_info_cleanup(snd_info *sp);
void set_amp(snd_info *sp, mus_float_t val);
void set_expand(snd_info *sp, mus_float_t val);
@@ -218,8 +212,6 @@ void show_lock(snd_info *sp);
void hide_lock(snd_info *sp);
void start_bomb(snd_info *sp);
void stop_bomb(snd_info *sp);
-void show_bomb(snd_info *sp);
-void hide_bomb(snd_info *sp);
snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr);
void set_sound_pane_file_label(snd_info *sp, const char *str);
void show_controls(snd_info *sp);
@@ -229,19 +221,19 @@ void start_progress_report(chan_info *cp);
void finish_progress_report(chan_info *cp);
void progress_report(chan_info *cp, mus_float_t pct);
void reflect_sound_selection(snd_info *sp);
-void display_minibuffer_error(snd_info *sp, const char *str);
-void clear_minibuffer_error(snd_info *sp);
-
+void update_sound_label(snd_info *sp);
/* -------- snd-xfile.c -------- */
-char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, int *type, int *format, mus_long_t *location, mus_long_t *samples, int min_chan);
-void alert_new_file(void);
+void cleanup_file_monitor(void);
+void *unmonitor_file(void *watcher);
+void monitor_sound(snd_info *sp);
+
+char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, mus_header_t *header_type,
+ mus_sample_t *sample_type, mus_long_t *location, mus_long_t *samples, int min_chan);
widget_t make_new_file_dialog(bool managed);
int edit_header(snd_info *sp);
void save_edit_header_dialog_state(FILE *fd);
-void cleanup_edit_header_watcher(void);
-void cleanup_new_file_watcher(void);
widget_t make_open_file_dialog(read_only_t read_only, bool managed);
void set_open_file_play_button(bool val);
widget_t make_selection_save_as_dialog(bool managed);
@@ -249,11 +241,11 @@ widget_t make_region_save_as_dialog(bool managed);
widget_t make_sound_save_as_dialog(bool managed);
widget_t make_mix_file_dialog(bool managed);
widget_t make_insert_file_dialog(bool managed);
-void clear_deleted_snd_info(struct dialog_play_info *dp);
widget_t post_it(const char *subject, const char *str);
void save_post_it_dialog_state(FILE *fd);
void reflect_just_sounds(void);
void save_file_dialog_state(FILE *fd);
+void reflect_selection_in_save_as_dialog(bool on);
void reflect_save_as_src(bool val);
void reflect_save_as_auto_comment(bool val);
void reflect_save_as_sound_selection(const char *sound_name);
@@ -269,6 +261,7 @@ void set_enved_revert_sensitive(bool val);
void set_enved_undo_sensitive(bool val);
void set_enved_save_sensitive(bool val);
void set_enved_show_sensitive(bool val);
+void enved_reflect_selection(bool on);
void make_scrolled_env_list(void);
void enved_reflect_peak_env_completion(snd_info *sp);
void new_active_channel_alert(void);
@@ -276,11 +269,11 @@ void env_redisplay(void);
void env_redisplay_with_print(void);
void update_enved_background_waveform(chan_info *cp);
int create_envelope_editor(void);
-void set_enved_clip_p(bool val);
+void set_enved_clipping(bool val);
void reflect_enved_style(void);
void set_enved_base(mus_float_t val);
void set_enved_target(enved_target_t val);
-void set_enved_wave_p(bool val);
+void set_enved_with_wave(bool val);
void set_enved_in_dB(bool val);
bool enved_dialog_is_active(void);
void set_enved_filter_order(int order);
@@ -297,12 +290,6 @@ void mix_dialog_set_mix(int id);
-/* -------- snd-xrec.c -------- */
-
-widget_t record_file(void);
-
-
-
/* -------- snd-xprint.c -------- */
widget_t make_file_print_dialog(bool managed, bool direct_to_printer);
@@ -310,7 +297,7 @@ widget_t make_file_print_dialog(bool managed, bool direct_to_printer);
/* -------- snd-xprefs.c -------- */
-widget_t start_preferences_dialog(void);
+widget_t make_preferences_dialog(void);
#endif
diff --git a/snd-prefs.c b/snd-prefs.c
index 5793788..309d391 100644
--- a/snd-prefs.c
+++ b/snd-prefs.c
@@ -1,13 +1,10 @@
/* this file included as text in snd-g|xprefs.c */
-/* TODO: make the current help strings less stupid
- */
-
static void int_to_textfield(widget_t w, int val)
{
char *str;
str = (char *)calloc(16, sizeof(char));
- mus_snprintf(str, 16, "%d", val);
+ snprintf(str, 16, "%d", val);
SET_TEXT(w, str);
free(str);
}
@@ -17,7 +14,7 @@ static void mus_long_t_to_textfield(widget_t w, mus_long_t val)
{
char *str;
str = (char *)calloc(32, sizeof(char));
- mus_snprintf(str, 32, MUS_LD, val);
+ snprintf(str, 32, "%lld", val);
SET_TEXT(w, str);
free(str);
}
@@ -27,7 +24,7 @@ static void float_to_textfield(widget_t w, mus_float_t val)
{
char *str;
str = (char *)calloc(12, sizeof(char));
- mus_snprintf(str, 12, "%.3f", val);
+ snprintf(str, 12, "%.3f", val);
SET_TEXT(w, str);
free(str);
}
@@ -37,7 +34,7 @@ static void float_1_to_textfield(widget_t w, mus_float_t val)
{
char *str;
str = (char *)calloc(12, sizeof(char));
- mus_snprintf(str, 12, "%.1f", val);
+ snprintf(str, 12, "%.1f", val);
SET_TEXT(w, str);
free(str);
}
@@ -203,7 +200,7 @@ static bool local_access(char *dir)
}
-static bool string_member_p(const char *val, char **lst, int len)
+static bool is_string_member(const char *val, char **lst, int len)
{
int i;
if ((len == 0) || (!lst) || (!val)) return(false);
@@ -217,20 +214,21 @@ static bool string_member_p(const char *val, char **lst, int len)
static char **load_path_to_string_array(int *len)
{
char **cdirs = NULL;
- int dir_len = 0, i, j = 0;
- XEN dirs;
+ int dir_len = 0, j = 0;
+ Xen dirs;
- dirs = XEN_LOAD_PATH;
- dir_len = XEN_LIST_LENGTH(dirs);
+ dirs = Xen_load_path;
+ dir_len = Xen_list_length(dirs);
if (dir_len > 0)
{
+ int i;
cdirs = (char **)calloc(dir_len, sizeof(char *));
for (i = 0; i < dir_len; i++)
{
const char *path;
- path = XEN_TO_C_STRING(XEN_LIST_REF(dirs, i));
- if ((path) && (!(string_member_p(path, cdirs, j)))) /* try to remove duplicates */
+ path = Xen_string_to_C_string(Xen_list_ref(dirs, i));
+ if ((path) && (!(is_string_member(path, cdirs, j)))) /* try to remove duplicates */
cdirs[j++] = mus_strdup(path);
}
}
@@ -273,13 +271,13 @@ static void save_prefs(void)
fullname = mus_expand_filename(filename);
fd = FOPEN(fullname, "a");
- fprintf(fd, "\n");
if (fd)
{
char **current_dirs = NULL;
int i, current_dirs_len = 0;
- char *unchecked_load_path = NULL;
+
+ fprintf(fd, "\n");
/* LOAD_PATH has the current load-path list,
* GET_TEXT(load_path_text_widget) has the current text (independent of activation)
@@ -298,15 +296,16 @@ static void save_prefs(void)
add_local_load_path(fd, current_dirs[i]); /* don't try to be smart about startup paths -- just include everybody */
if ((include_load_path) &&
- (!(string_member_p(include_load_path, current_dirs, current_dirs_len))))
+ (!(is_string_member(include_load_path, current_dirs, current_dirs_len))))
add_local_load_path(fd, include_load_path);
if (load_path_text_widget)
{
+ char *unchecked_load_path = NULL;
unchecked_load_path = GET_TEXT(load_path_text_widget);
if ((unchecked_load_path) && /* text widget has an entry */
(local_access(unchecked_load_path)) && /* it's a legit path */
- (!(string_member_p(unchecked_load_path, current_dirs, current_dirs_len))) && /* it's not in LOAD_PATH */
+ (!(is_string_member(unchecked_load_path, current_dirs, current_dirs_len))) && /* it's not in LOAD_PATH */
(!(mus_strcmp(unchecked_load_path, include_load_path)))) /* it's not already included above */
add_local_load_path(fd, unchecked_load_path);
if (unchecked_load_path) {free_TEXT(unchecked_load_path);} /* a no-op in gtk */
@@ -345,9 +344,9 @@ static char *trim_string(const char *str)
char *trimmed_str;
len = strlen(str);
trimmed_str = (char *)calloc(len + 1, sizeof(char));
- while ((i < len) && (isspace(str[i]))) i++;
+ while ((i < len) && (isspace((int)str[i]))) i++;
k = len - 1;
- while ((k > i) && (isspace(str[k]))) k--;
+ while ((k > i) && (isspace((int)str[k]))) k--;
for (m = i; m <= k; m++)
trimmed_str[j++] = str[m];
return(trimmed_str);
@@ -362,9 +361,9 @@ static char *possibly_quote(char *key)
len = mus_strlen(key);
if (len > 12) len = 12;
for (i = 0, j = 0; i < len; i++)
- if (!(isspace(key[i])))
+ if (!(isspace((int)key[i])))
{
- if ((j == 0) && (isalpha(key[i])))
+ if ((j == 0) && (isalpha((int)key[i])))
key_buf[j++] = '\"';
key_buf[j++] = key[i];
}
@@ -432,11 +431,11 @@ static void save_just_sounds(prefs_info *prf, FILE *ignore) {rts_just_sounds = j
/* ---------------- verbose-cursor ---------------- */
-static bool rts_verbose_cursor = DEFAULT_VERBOSE_CURSOR;
-static void reflect_verbose_cursor(prefs_info *prf) {SET_TOGGLE(prf->toggle, verbose_cursor(ss));}
-static void verbose_cursor_toggle(prefs_info *prf) {set_verbose_cursor(GET_TOGGLE(prf->toggle));}
-static void revert_verbose_cursor(prefs_info *prf) {set_verbose_cursor(rts_verbose_cursor);}
-static void save_verbose_cursor(prefs_info *prf, FILE *ignore) {rts_verbose_cursor = verbose_cursor(ss);}
+static bool rts_with_verbose_cursor = DEFAULT_WITH_VERBOSE_CURSOR;
+static void reflect_with_verbose_cursor(prefs_info *prf) {SET_TOGGLE(prf->toggle, with_verbose_cursor(ss));}
+static void with_verbose_cursor_toggle(prefs_info *prf) {set_with_verbose_cursor(GET_TOGGLE(prf->toggle));}
+static void revert_with_verbose_cursor(prefs_info *prf) {set_with_verbose_cursor(rts_with_verbose_cursor);}
+static void save_with_verbose_cursor(prefs_info *prf, FILE *ignore) {rts_with_verbose_cursor = with_verbose_cursor(ss);}
/* ---------------- graphs-horizontal ---------------- */
@@ -1322,7 +1321,7 @@ static const char *help_ladspa_dir(prefs_info *prf)
#endif
-
+#if USE_MOTIF
/* ---------------- view-files directory ---------------- */
static char *rts_vf_directory = NULL;
@@ -1351,7 +1350,7 @@ static void save_view_files_directory(prefs_info *prf, FILE *fd)
#endif
#if HAVE_RUBY
- fprintf(fd, "%s(\"%s\")\n", TO_PROC_NAME(S_add_directory_to_view_files_list), rts_vf_directory);
+ fprintf(fd, "%s(\"%s\")\n", to_proc_name(S_add_directory_to_view_files_list), rts_vf_directory);
#endif
#if HAVE_FORTH
@@ -1371,6 +1370,7 @@ static void view_files_directory_text(prefs_info *prf)
free_TEXT(str);
}
}
+#endif
@@ -1715,7 +1715,7 @@ static void min_dB_text(prefs_info *prf)
str = GET_TEXT(prf->text);
if ((str) && (*str))
{
- float value = 0.0;
+ float value;
redirect_errors_to(any_error_to_text, (void *)prf);
value = (float)string_to_mus_float_t(str, -100000.0, "min dB");
@@ -1751,7 +1751,7 @@ static void fft_window_beta_text_callback(prefs_info *prf)
str = GET_TEXT(prf->text);
if ((str) && (*str))
{
- float value = 0.0;
+ float value;
redirect_errors_to(any_error_to_text, (void *)prf);
value = (float)string_to_mus_float_t(str, 0.0, "fft beta");
@@ -1789,7 +1789,7 @@ static void grid_density_text_callback(prefs_info *prf)
str = GET_TEXT(prf->text);
if ((str) && (*str))
{
- float value = 0.0;
+ float value;
redirect_errors_to(any_error_to_text, (void *)prf);
value = (float)string_to_mus_float_t(str, 0.0, "grid density");
@@ -1817,7 +1817,9 @@ static const char *help_sync_style(prefs_info *prf)
{
return("\
Many operations can operate either on all channels at once,\n\
- or only on the currently selected channel.");
+ or only on the currently selected channel. If 'within each sound'\n\
+ is set, the channels within a sound are tied together, but not\n\
+ across sounds.");
}
@@ -2269,11 +2271,11 @@ static void cursor_size_down(prefs_info *prf)
static void cursor_size_from_text(prefs_info *prf)
{
- int size;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
{
+ int size;
prf->got_error = false;
redirect_errors_to(redirect_post_prefs_error, (void *)prf);
@@ -2341,11 +2343,11 @@ static void dot_size_down(prefs_info *prf)
static void dot_size_from_text(prefs_info *prf)
{
- int size;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
{
+ int size;
prf->got_error = false;
redirect_errors_to(redirect_post_prefs_error, (void *)prf);
@@ -2412,11 +2414,11 @@ static void fft_size_down(prefs_info *prf)
static void fft_size_from_text(prefs_info *prf)
{
- mus_long_t size;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
{
+ mus_long_t size;
prf->got_error = false;
redirect_errors_to(redirect_post_prefs_error, (void *)prf);
@@ -2426,7 +2428,7 @@ static void fft_size_from_text(prefs_info *prf)
free_TEXT(str);
if (!(prf->got_error))
{
- if (POWER_OF_2_P(size))
+ if (is_power_of_2(size))
{
if (size <= MAX_TRANSFORM_SIZE)
set_transform_size(size);
@@ -2464,7 +2466,7 @@ static void save_with_tracking_cursor(prefs_info *prf, FILE *ignore)
static void reflect_with_tracking_cursor(prefs_info *prf)
{
- SET_TOGGLE(prf->toggle, with_tracking_cursor(ss));
+ SET_TOGGLE(prf->toggle, (with_tracking_cursor(ss) != DONT_TRACK));
int_to_textfield(prf->rtxt, cursor_location_offset(ss));
float_to_textfield(prf->text, cursor_update_interval(ss));
}
@@ -2472,7 +2474,7 @@ static void reflect_with_tracking_cursor(prefs_info *prf)
static void with_tracking_cursor_toggle(prefs_info *prf)
{
- set_with_tracking_cursor(ss, (GET_TOGGLE(prf->toggle)) ? ALWAYS_TRACK : TRACK_IF_ASKED);
+ set_with_tracking_cursor(ss, (GET_TOGGLE(prf->toggle)) ? TRACK_AND_RETURN : DONT_TRACK);
}
@@ -2482,7 +2484,7 @@ static void cursor_location_text(prefs_info *prf)
str = GET_TEXT(prf->text);
if ((str) && (*str))
{
- float interval = DEFAULT_CURSOR_UPDATE_INTERVAL;
+ float interval;
redirect_errors_to(any_error_to_text, (void *)prf);
interval = (float)string_to_mus_float_t(str, 0.0, "cursor offset");
@@ -2495,7 +2497,7 @@ static void cursor_location_text(prefs_info *prf)
str = GET_TEXT(prf->rtxt);
if ((str) && (*str))
{
- int loc = DEFAULT_CURSOR_LOCATION_OFFSET;
+ int loc;
redirect_errors_to(any_error_to_text, (void *)prf);
loc = string_to_int(str, 0, "cursor offset");
@@ -2654,11 +2656,11 @@ static void speed_control_down(prefs_info *prf)
static void speed_control_text(prefs_info *prf)
{
- int tones;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
{
+ int tones;
prf->got_error = false;
redirect_errors_to(redirect_post_prefs_error, (void *)prf);
tones = string_to_int(str, MIN_SPEED_CONTROL_SEMITONES, "semitones");
@@ -2706,10 +2708,10 @@ static void save_speed_control(prefs_info *prf, FILE *ignore)
static int rts_default_output_chans = DEFAULT_OUTPUT_CHANS;
static int rts_default_output_srate = DEFAULT_OUTPUT_SRATE;
-static int rts_default_output_data_format = DEFAULT_OUTPUT_DATA_FORMAT;
-static int rts_default_output_header_type = DEFAULT_OUTPUT_HEADER_TYPE;
+static mus_sample_t rts_default_output_sample_type = DEFAULT_OUTPUT_SAMPLE_TYPE;
+static mus_header_t rts_default_output_header_type = DEFAULT_OUTPUT_HEADER_TYPE;
-static prefs_info *output_data_format_prf = NULL, *output_header_type_prf = NULL;
+static prefs_info *output_sample_type_prf = NULL, *output_header_type_prf = NULL;
#define NUM_OUTPUT_CHAN_CHOICES 4
static const char *output_chan_choices[NUM_OUTPUT_CHAN_CHOICES] = {"1 ", "2 ", "4 ", "8"};
@@ -2719,16 +2721,16 @@ static int output_chans[NUM_OUTPUT_CHAN_CHOICES] = {1, 2, 4, 8};
static const char *output_srate_choices[NUM_OUTPUT_SRATE_CHOICES] = {"8000 ", "22050 ", "44100 ", "48000"};
static int output_srates[NUM_OUTPUT_SRATE_CHOICES] = {8000, 22050, 44100, 48000};
-#define NUM_OUTPUT_TYPE_CHOICES 7
-static const char *output_type_choices[NUM_OUTPUT_TYPE_CHOICES] = {"aifc ", "wave ", "au ", "rf64 ", "nist ", "aiff ", "caff"};
-static int output_types[NUM_OUTPUT_TYPE_CHOICES] = {MUS_AIFC, MUS_RIFF, MUS_NEXT, MUS_RF64, MUS_NIST, MUS_AIFF, MUS_CAFF};
+#define NUM_OUTPUT_HEADER_TYPE_CHOICES 7
+static const char *output_header_type_choices[NUM_OUTPUT_HEADER_TYPE_CHOICES] = {"aifc ", "wave ", "au ", "rf64 ", "nist ", "aiff ", "caff"};
+static mus_header_t output_header_types[NUM_OUTPUT_HEADER_TYPE_CHOICES] = {MUS_AIFC, MUS_RIFF, MUS_NEXT, MUS_RF64, MUS_NIST, MUS_AIFF, MUS_CAFF};
-#define NUM_OUTPUT_FORMAT_CHOICES 4
-static const char *output_format_choices[NUM_OUTPUT_FORMAT_CHOICES] = {"short ", "int ", "float ", "double"};
-static int output_formats[NUM_OUTPUT_FORMAT_CHOICES] = {MUS_LSHORT, MUS_LINT, MUS_LFLOAT, MUS_LDOUBLE};
+#define NUM_OUTPUT_SAMPLE_TYPE_CHOICES 4
+static const char *output_sample_type_choices[NUM_OUTPUT_SAMPLE_TYPE_CHOICES] = {"short ", "int ", "float ", "double"};
+static mus_sample_t output_sample_types[NUM_OUTPUT_SAMPLE_TYPE_CHOICES] = {MUS_LSHORT, MUS_LINT, MUS_LFLOAT, MUS_LDOUBLE};
-static int header_to_data(int ht, int frm)
+static mus_sample_t header_to_sample_type(mus_header_t ht, mus_sample_t samp_type)
{
/* nist -> short or int (lb)
aiff -> short or int (b)
@@ -2740,51 +2742,57 @@ static int header_to_data(int ht, int frm)
switch (ht)
{
case MUS_NEXT: case MUS_AIFC:
- switch (frm)
+ switch (samp_type)
{
- case MUS_LSHORT: return(MUS_BSHORT); break;
- case MUS_LINT: return(MUS_BINT); break;
- case MUS_LFLOAT: return(MUS_BFLOAT); break;
+ case MUS_LSHORT: return(MUS_BSHORT); break;
+ case MUS_LINT: return(MUS_BINT); break;
+ case MUS_LFLOAT: return(MUS_BFLOAT); break;
case MUS_LDOUBLE: return(MUS_BDOUBLE); break;
+ default: break;
}
break;
case MUS_AIFF:
- switch (frm)
+ switch (samp_type)
{
case MUS_LSHORT: return(MUS_BSHORT); break;
- case MUS_LINT: return(MUS_BINT); break;
+ case MUS_LINT: return(MUS_BINT); break;
case MUS_LFLOAT: case MUS_LDOUBLE: case MUS_BFLOAT: case MUS_BDOUBLE: return(MUS_BINT); break;
+ default: break;
}
break;
case MUS_NIST:
- switch (frm)
+ switch (samp_type)
{
case MUS_LFLOAT: case MUS_LDOUBLE: return(MUS_LINT); break;
case MUS_BFLOAT: case MUS_BDOUBLE: return(MUS_BINT); break;
+ default: break;
}
break;
case MUS_RF64:
case MUS_RIFF:
- switch (frm)
+ switch (samp_type)
{
- case MUS_BSHORT: return(MUS_LSHORT); break;
- case MUS_BINT: return(MUS_LINT); break;
- case MUS_BFLOAT: return(MUS_LFLOAT); break;
+ case MUS_BSHORT: return(MUS_LSHORT); break;
+ case MUS_BINT: return(MUS_LINT); break;
+ case MUS_BFLOAT: return(MUS_LFLOAT); break;
case MUS_BDOUBLE: return(MUS_LDOUBLE); break;
+ default: break;
}
break;
case MUS_CAFF:
- if (frm == MUS_LINT)
+ if (samp_type == MUS_LINT)
return(MUS_LINTN);
- if (frm == MUS_BINT)
+ if (samp_type == MUS_BINT)
return(MUS_BINTN);
break;
+
+ default: break;
}
- return(frm);
+ return(samp_type);
}
@@ -2844,6 +2852,7 @@ static void reflect_default_output_header_type(prefs_info *prf)
case MUS_NEXT: which = 2; break;
case MUS_NIST: which = 4; break;
case MUS_CAFF: which = 6; break;
+ default: break;
}
set_radio_button(prf, which);
}
@@ -2861,15 +2870,16 @@ static void save_default_output_header_type(prefs_info *prf, FILE *ignore)
}
-static void reflect_default_output_data_format(prefs_info *prf)
+static void reflect_default_output_sample_type(prefs_info *prf)
{
int which = -1;
- switch (default_output_data_format(ss))
+ switch (default_output_sample_type(ss))
{
case MUS_LINT: case MUS_BINT: which = 1; break;
case MUS_LSHORT: case MUS_BSHORT: which = 0; break;
case MUS_LFLOAT: case MUS_BFLOAT: which = 2; break;
case MUS_LDOUBLE: case MUS_BDOUBLE: which = 3; break;
+ default: break;
}
set_radio_button(prf, which);
}
@@ -2879,40 +2889,41 @@ static void default_output_header_type_choice(prefs_info *prf)
{
if (GET_TOGGLE(prf->radio_button))
{
- set_default_output_header_type(output_types[which_radio_button(prf)]);
- set_default_output_data_format(header_to_data(default_output_header_type(ss), default_output_data_format(ss)));
- reflect_default_output_data_format(output_data_format_prf);
+ set_default_output_header_type(output_header_types[which_radio_button(prf)]);
+ set_default_output_sample_type(header_to_sample_type(default_output_header_type(ss), default_output_sample_type(ss)));
+ reflect_default_output_sample_type(output_sample_type_prf);
}
}
-static void revert_default_output_data_format(prefs_info *prf)
+static void revert_default_output_sample_type(prefs_info *prf)
{
- set_default_output_data_format(rts_default_output_data_format);
+ set_default_output_sample_type(rts_default_output_sample_type);
}
-static void save_default_output_data_format(prefs_info *prf, FILE *ignore)
+static void save_default_output_sample_type(prefs_info *prf, FILE *ignore)
{
- rts_default_output_data_format = default_output_data_format(ss);
+ rts_default_output_sample_type = default_output_sample_type(ss);
}
-static void default_output_data_format_choice(prefs_info *prf)
+static void default_output_sample_type_choice(prefs_info *prf)
{
if (GET_TOGGLE(prf->radio_button))
{
- int which = -1;
+ int which;
which = which_radio_button(prf);
- set_default_output_data_format(output_formats[which]);
+ set_default_output_sample_type(output_sample_types[which]);
- switch (default_output_data_format(ss))
+ switch (default_output_sample_type(ss))
{
case MUS_LSHORT:
switch (default_output_header_type(ss))
{
case MUS_AIFC: case MUS_AIFF: case MUS_NEXT:
- set_default_output_data_format(MUS_BSHORT);
+ set_default_output_sample_type(MUS_BSHORT);
break;
+ default: break;
}
break;
@@ -2920,8 +2931,9 @@ static void default_output_data_format_choice(prefs_info *prf)
switch (default_output_header_type(ss))
{
case MUS_AIFC: case MUS_AIFF: case MUS_NEXT:
- set_default_output_data_format(MUS_BINT);
+ set_default_output_sample_type(MUS_BINT);
break;
+ default: break;
}
break;
@@ -2929,15 +2941,16 @@ static void default_output_data_format_choice(prefs_info *prf)
switch (default_output_header_type(ss))
{
case MUS_AIFC: case MUS_NEXT:
- set_default_output_data_format(MUS_BFLOAT);
+ set_default_output_sample_type(MUS_BFLOAT);
break;
case MUS_AIFF:
set_default_output_header_type(MUS_AIFC);
- set_default_output_data_format(MUS_BFLOAT);
+ set_default_output_sample_type(MUS_BFLOAT);
break;
case MUS_NIST:
set_default_output_header_type(MUS_RIFF);
break;
+ default: break;
}
break;
@@ -2945,17 +2958,20 @@ static void default_output_data_format_choice(prefs_info *prf)
switch (default_output_header_type(ss))
{
case MUS_AIFC: case MUS_NEXT:
- set_default_output_data_format(MUS_BDOUBLE);
+ set_default_output_sample_type(MUS_BDOUBLE);
break;
case MUS_AIFF:
set_default_output_header_type(MUS_AIFC);
- set_default_output_data_format(MUS_BDOUBLE);
+ set_default_output_sample_type(MUS_BDOUBLE);
break;
case MUS_NIST:
set_default_output_header_type(MUS_RIFF);
break;
+ default: break;
}
break;
+
+ default: break;
}
reflect_default_output_header_type(output_header_type_prf);
}
@@ -2966,29 +2982,32 @@ static void default_output_data_format_choice(prefs_info *prf)
static int rts_raw_chans = DEFAULT_OUTPUT_CHANS;
static int rts_raw_srate = DEFAULT_OUTPUT_SRATE;
-static int rts_raw_data_format = DEFAULT_OUTPUT_DATA_FORMAT;
+static mus_sample_t rts_raw_sample_type = DEFAULT_OUTPUT_SAMPLE_TYPE;
static void revert_raw_chans(prefs_info *prf)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
chans = rts_raw_chans;
- mus_header_set_raw_defaults(srate, chans, format);
+ mus_header_set_raw_defaults(srate, chans, samp_type);
}
static void save_raw_chans(prefs_info *prf, FILE *ignore)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
rts_raw_chans = chans;
}
static void reflect_raw_chans(prefs_info *prf)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
int_to_textfield(prf->text, chans);
}
@@ -2999,13 +3018,14 @@ static void raw_chans_choice(prefs_info *prf)
str = GET_TEXT(prf->text);
if (str)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
redirect_errors_to(any_error_to_text, (void *)prf);
chans = string_to_int(str, 1, "raw chans");
redirect_errors_to(NULL, NULL);
if (!(prf->got_error))
- mus_header_set_raw_defaults(srate, chans, format);
+ mus_header_set_raw_defaults(srate, chans, samp_type);
free_TEXT(str);
}
}
@@ -3013,25 +3033,28 @@ static void raw_chans_choice(prefs_info *prf)
static void revert_raw_srate(prefs_info *prf)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
srate = rts_raw_srate;
- mus_header_set_raw_defaults(srate, chans, format);
+ mus_header_set_raw_defaults(srate, chans, samp_type);
}
static void save_raw_srate(prefs_info *prf, FILE *ignore)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
rts_raw_srate = srate;
}
static void reflect_raw_srate(prefs_info *prf)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
int_to_textfield(prf->text, srate);
}
@@ -3042,23 +3065,24 @@ static void raw_srate_choice(prefs_info *prf)
str = GET_TEXT(prf->text);
if (str)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
redirect_errors_to(any_error_to_text, (void *)prf);
srate = string_to_int(str, 1, "raw srate");
redirect_errors_to(NULL, NULL);
if (!(prf->got_error))
- mus_header_set_raw_defaults(srate, chans, format);
+ mus_header_set_raw_defaults(srate, chans, samp_type);
free_TEXT(str);
}
}
-static char *raw_data_format_to_string(int format)
+static char *raw_sample_type_to_string(mus_sample_t samp_type)
{
/* the "mus-" prefix carries no information in this context, so strip it off */
const char *name;
- name = mus_data_format_to_string(format);
+ name = mus_sample_type_to_string(samp_type);
if (name)
{
char *rtn;
@@ -3080,49 +3104,53 @@ static char *raw_data_format_to_string(int format)
}
-static void revert_raw_data_format(prefs_info *prf)
+static void revert_raw_sample_type(prefs_info *prf)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
- format = rts_raw_data_format;
- mus_header_set_raw_defaults(srate, chans, format);
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
+ samp_type = rts_raw_sample_type;
+ mus_header_set_raw_defaults(srate, chans, samp_type);
}
-static void save_raw_data_format(prefs_info *prf, FILE *ignore)
+static void save_raw_sample_type(prefs_info *prf, FILE *ignore)
{
- int srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
- rts_raw_data_format = format;
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
+ rts_raw_sample_type = samp_type;
}
-static void reflect_raw_data_format(prefs_info *prf)
+static void reflect_raw_sample_type(prefs_info *prf)
{
- int srate = 0, chans = 0, format = 0;
+ int srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
char *str;
- mus_header_raw_defaults(&srate, &chans, &format);
- str = raw_data_format_to_string(format);
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
+ str = raw_sample_type_to_string(samp_type);
SET_TEXT(prf->text, str);
free(str);
}
-static char **raw_data_format_choices = NULL;
+static char **raw_sample_type_choices = NULL;
-static void raw_data_format_from_text(prefs_info *prf)
+static void raw_sample_type_from_text(prefs_info *prf)
{
char *str;
str = GET_TEXT(prf->text);
if (str)
{
- int i, srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
- for (i = 0; i < MUS_NUM_DATA_FORMATS - 1; i++)
- if (STRCMP(raw_data_format_choices[i], str) == 0)
+ int i, srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
+ for (i = 0; i < MUS_NUM_SAMPLES - 1; i++)
+ if (STRCMP(raw_sample_type_choices[i], str) == 0)
{
- mus_header_set_raw_defaults(srate, chans, i + 1); /* skipping MUS_UNKNOWN = 0 */
- reflect_raw_data_format(prf);
+ mus_header_set_raw_defaults(srate, chans, (mus_sample_t)(i + 1)); /* skipping MUS_UNKNOWN_SAMPLE = 0 */
+ reflect_raw_sample_type(prf);
free_TEXT(str);
return;
}
@@ -3131,15 +3159,16 @@ static void raw_data_format_from_text(prefs_info *prf)
#if USE_MOTIF
-static void raw_data_format_from_menu(prefs_info *prf, char *value)
+static void raw_sample_type_from_menu(prefs_info *prf, char *value)
{
- int i, srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
- for (i = 0; i < MUS_NUM_DATA_FORMATS - 1; i++)
- if (STRCMP(raw_data_format_choices[i], value) == 0)
+ int i, srate = 0, chans = 0;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ mus_header_raw_defaults(&srate, &chans, &samp_type);
+ for (i = 0; i < MUS_NUM_SAMPLES - 1; i++)
+ if (STRCMP(raw_sample_type_choices[i], value) == 0)
{
- mus_header_set_raw_defaults(srate, chans, i + 1);
- SET_TEXT(prf->text, raw_data_format_choices[i]);
+ mus_header_set_raw_defaults(srate, chans, (mus_sample_t)(i + 1));
+ SET_TEXT(prf->text, raw_sample_type_choices[i]);
return;
}
}
@@ -3248,7 +3277,6 @@ static void show_axes_from_menu(prefs_info *prf, char *value)
static void show_axes_from_text(prefs_info *prf)
{
- int i;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
@@ -3258,7 +3286,7 @@ static void show_axes_from_text(prefs_info *prf)
free_TEXT(str);
if (mus_strlen(trimmed_str) > 0)
{
- int curpos = -1;
+ int i, curpos = -1;
for (i = 0; i < NUM_SHOW_AXES; i++)
if (STRCMP(trimmed_str, show_axes_choices[i]) == 0)
{
@@ -3306,7 +3334,6 @@ static void x_axis_style_from_menu(prefs_info *prf, char *value)
static void x_axis_style_from_text(prefs_info *prf)
{
- int i;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
@@ -3316,7 +3343,7 @@ static void x_axis_style_from_text(prefs_info *prf)
free_TEXT(str);
if (mus_strlen(trimmed_str) > 0)
{
- int curpos = -1;
+ int i, curpos = -1;
for (i = 0; i < NUM_X_AXIS_STYLES; i++)
if (STRCMP(trimmed_str, x_axis_styles[i]) == 0)
{
@@ -3386,7 +3413,6 @@ static void transform_type_from_menu(prefs_info *prf, char *value)
static void transform_type_from_text(prefs_info *prf)
{
- int i;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
@@ -3396,7 +3422,7 @@ static void transform_type_from_text(prefs_info *prf)
free_TEXT(str);
if (mus_strlen(trimmed_str) > 0)
{
- int curpos = -1;
+ int i, curpos = -1;
for (i = 0; i < NUM_BUILTIN_TRANSFORM_TYPES; i++)
if (STRCMP(trimmed_str, transform_types[i]) == 0)
{
@@ -3458,7 +3484,6 @@ static void fft_window_from_menu(prefs_info *prf, char *value)
static void fft_window_from_text(prefs_info *prf)
{
- int i;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
@@ -3468,7 +3493,7 @@ static void fft_window_from_text(prefs_info *prf)
free_TEXT(str);
if (mus_strlen(trimmed_str) > 0)
{
- int curpos = -1;
+ int i, curpos = -1;
for (i = 0; i < MUS_NUM_FFT_WINDOWS; i++)
if (STRCMP(trimmed_str, mus_fft_window_name((mus_fft_window_t)i)) == 0)
{
@@ -3526,7 +3551,6 @@ static void revert_colormap(prefs_info *prf)
static void colormap_from_text(prefs_info *prf)
{
- int i;
char *str;
str = GET_TEXT(prf->text);
if ((str) && (*str))
@@ -3536,7 +3560,7 @@ static void colormap_from_text(prefs_info *prf)
free_TEXT(str);
if (mus_strlen(trimmed_str) > 0)
{
- int len, curpos = -1;
+ int i, len, curpos = -1;
len = num_colormaps();
for (i = 0; i < len; i++)
if ((colormap_name(i)) &&
@@ -3661,8 +3685,8 @@ static const char *help_load_path(prefs_info *prf)
from the Scheme, Ruby, or Forth files found in the Snd tarball. \n\
You can run Snd without these files, but there's no reason to! \n\
Just add the directory containing them to the load path \n\
-variable %s. " XEN_LANGUAGE_NAME " searches these directories \n\
-for any *." XEN_FILE_EXTENSION " files that it can't find elsewhere. \n\
+variable %s. " Xen_language " searches these directories \n\
+for any *." Xen_file_extension " files that it can't find elsewhere. \n\
The current load path list is: \n\n%s\n",
#if HAVE_RUBY
", $LOAD_PATH",
@@ -3673,7 +3697,7 @@ The current load path list is: \n\n%s\n",
"",
#endif
#endif
- temp = (char *)XEN_AS_STRING(XEN_LOAD_PATH));
+ temp = (char *)Xen_object_to_C_string(Xen_load_path));
#if HAVE_SCHEME
if (temp) free(temp);
#endif
@@ -3684,22 +3708,22 @@ The current load path list is: \n\n%s\n",
static char *find_sources(void) /* returns directory name where it finds extensions.* */
{
char *file = NULL;
- #define BASE_FILE "extensions." XEN_FILE_EXTENSION
+ #define BASE_FILE "extensions." Xen_file_extension
#if HAVE_SCHEME
/* mimic Forth code below -- get *load-path* value and run through it */
{
int i, len, base_len;
- XEN load_path;
- load_path = XEN_LOAD_PATH;
- len = XEN_LIST_LENGTH(load_path);
+ Xen load_path;
+ load_path = Xen_load_path;
+ len = Xen_list_length(load_path);
base_len = strlen(BASE_FILE);
for (i = 0; i < len; i++)
{
char *fname;
const char *path;
int flen;
- path = XEN_TO_C_STRING(XEN_LIST_REF(load_path, i));
+ path = Xen_string_to_C_string(Xen_list_ref(load_path, i));
flen = base_len + 32 + strlen(path);
fname = (char *)calloc(flen, sizeof(char));
snprintf(fname, flen, "%s/%s", path, BASE_FILE);
@@ -3714,10 +3738,10 @@ static char *find_sources(void) /* returns directory name where it finds extensi
#if HAVE_RUBY
{
- XEN xfile;
- xfile = rb_find_file(C_TO_XEN_STRING(BASE_FILE));
- if (XEN_STRING_P(xfile))
- file = mus_expand_filename(XEN_TO_C_STRING(xfile));
+ Xen xfile;
+ xfile = rb_find_file(C_string_to_Xen_string(BASE_FILE));
+ if (Xen_is_string(xfile))
+ file = mus_expand_filename(Xen_string_to_C_string(xfile));
}
#endif
@@ -3725,8 +3749,8 @@ static char *find_sources(void) /* returns directory name where it finds extensi
{
/* taken from fth/src/misc.c -- fth_find_file looks for an already-loaded file */
int i, len, base_len;
- XEN load_path;
- load_path = XEN_LOAD_PATH;
+ Xen load_path;
+ load_path = Xen_load_path;
len = fth_array_length(load_path);
base_len = strlen(BASE_FILE);
for (i = 0; i < len; i++)
@@ -3801,7 +3825,7 @@ static void load_path_text(prefs_info *prf)
black_text(prf);
if (include_load_path) free(include_load_path);
include_load_path = mus_strdup(str);
- XEN_ADD_TO_LOAD_PATH(include_load_path);
+ Xen_add_to_load_path(include_load_path);
}
if (str) {free_TEXT(str);}
}
@@ -3886,7 +3910,7 @@ static void initial_bounds_text(prefs_info *prf)
static void reflect_key(prefs_info *prf, const char *key_name)
{
key_info *ki;
- ki = find_prefs_key_binding(key_name);
+ ki = find_prefs_key(key_name);
SET_TOGGLE(prf->toggle, ki->c);
SET_TOGGLE(prf->toggle2, ki->m);
SET_TOGGLE(prf->toggle3, ki->x);
@@ -3895,12 +3919,13 @@ static void reflect_key(prefs_info *prf, const char *key_name)
}
-static void save_key_binding(prefs_info *prf, FILE *fd, char *(*binder)(char *key, bool c, bool m, bool x))
+static void save_key(prefs_info *prf, FILE *fd, char *(*binder)(char *key, bool c, bool m, bool x))
{
- char *key, *expr;
+ char *key;
key = GET_TEXT(prf->text);
if ((key) && (*key))
{
+ char *expr;
expr = (*binder)(key,
GET_TOGGLE(prf->toggle),
GET_TOGGLE(prf->toggle2),
@@ -3914,7 +3939,7 @@ static void save_key_binding(prefs_info *prf, FILE *fd, char *(*binder)(char *ke
static void key_bind(prefs_info *prf, char *(*binder)(char *key, bool c, bool m, bool x))
{
- char *key, *expr;
+ char *key;
bool ctrl, meta, cx;
key = GET_TEXT(prf->text);
ctrl = GET_TOGGLE(prf->toggle);
@@ -3922,9 +3947,10 @@ static void key_bind(prefs_info *prf, char *(*binder)(char *key, bool c, bool m,
cx = GET_TOGGLE(prf->toggle3);
if ((key) && (*key))
{
+ char *expr;
expr = (*binder)(key, ctrl, meta, cx);
free_TEXT(key);
- XEN_EVAL_C_STRING(expr);
+ Xen_eval_C_string(expr);
free(expr);
}
}
@@ -3933,7 +3959,7 @@ static void key_bind(prefs_info *prf, char *(*binder)(char *key, bool c, bool m,
static void clear_key(prefs_info *prf, const char *name)
{
key_info *ki;
- ki = find_prefs_key_binding(name);
+ ki = find_prefs_key(name);
if (ki)
{
if (ki->key)
@@ -3942,9 +3968,9 @@ static void clear_key(prefs_info *prf, const char *name)
if (ki->c) state |= 4;
if (ki->m) state |= 8;
#if USE_MOTIF
- set_keymap_entry((int)XStringToKeysym(ki->key), state, 0, XEN_UNDEFINED, ki->x, name, name);
+ set_keymap_entry((int)XStringToKeysym(ki->key), state, 0, Xen_undefined, ki->x, name, name);
#else
- set_keymap_entry((int)gdk_keyval_from_name(ki->key), state, 0, XEN_UNDEFINED, ki->x, name, name);
+ set_keymap_entry((int)gdk_keyval_from_name(ki->key), state, 0, Xen_undefined, ki->x, name, name);
#endif
}
free(ki);
@@ -3961,7 +3987,7 @@ static const char *help_play_from_cursor(prefs_info *prf)
}
-static char *make_pfc_binding(char *key, bool ctrl, bool meta, bool cx)
+static char *make_pfc(char *key, bool ctrl, bool meta, bool cx)
{
#if HAVE_SCHEME
return(mus_format("(bind-key %s %d (lambda () (set! (pausing) #f) (play (cursor))) %s \"play sound from cursor\" \"play-from-cursor\")\n",
@@ -3993,15 +4019,15 @@ static void reflect_play_from_cursor(prefs_info *prf)
}
-static void save_pfc_binding(prefs_info *prf, FILE *fd)
+static void save_pfc(prefs_info *prf, FILE *fd)
{
- save_key_binding(prf, fd, make_pfc_binding);
+ save_key(prf, fd, make_pfc);
}
static void bind_play_from_cursor(prefs_info *prf)
{
- key_bind(prf, make_pfc_binding);
+ key_bind(prf, make_pfc);
}
@@ -4023,13 +4049,13 @@ static const char *help_show_all(prefs_info *prf)
}
-static char *make_show_all_binding(char *key, bool ctrl, bool meta, bool cx)
+static char *make_show_all(char *key, bool ctrl, bool meta, bool cx)
{
#if HAVE_SCHEME
return(mus_format("(bind-key %s %d (lambda () \
(let ((old-sync (sync))) \
(set! (sync) (1+ (sync-max))) \
- (set! (x-bounds) (list 0.0 (/ (frames) (srate)))) \
+ (set! (x-bounds) (list 0.0 (/ (framples) (srate)))) \
(set! (sync) old-sync))) %s \"show entire sound\" \"show-all\")\n",
possibly_quote(key),
((ctrl) ? 4 : 0) + ((meta) ? 8 : 0),
@@ -4040,7 +4066,7 @@ static char *make_show_all_binding(char *key, bool ctrl, bool meta, bool cx)
return(mus_format("bind_key(%s, %d, lambda do\n\
old_sync = sync()\n\
sync(1 + sync_max())\n\
- set_x_bounds([0.0, frames() / srate()])\n\
+ set_x_bounds([0.0, framples() / srate()])\n\
set_sync(old_sync)\n\
end, %s, \"show entire sound\", \"show-all\")\n",
possibly_quote(key),
@@ -4049,7 +4075,7 @@ static char *make_show_all_binding(char *key, bool ctrl, bool meta, bool cx)
#endif
#if HAVE_FORTH
- return(mus_format("%s %d lambda: <{ }> #f sync sync-max 1+ #f set-sync drop '( 0.0 #f #f #f frames #f srate f/ ) #f #f set-x-bounds drop #f set-sync ; %s \"show entire sound\" \"show-all\" bind-key drop\n",
+ return(mus_format("%s %d lambda: <{ }> #f sync sync-max 1+ #f set-sync drop '( 0.0 #f #f #f framples #f srate f/ ) #f #f set-x-bounds drop #f set-sync ; %s \"show entire sound\" \"show-all\" bind-key drop\n",
possibly_quote(key),
((ctrl) ? 4 : 0) + ((meta) ? 8 : 0),
(cx) ? "#t" : "#f"));
@@ -4064,15 +4090,15 @@ static void reflect_show_all(prefs_info *prf)
}
-static void save_show_all_binding(prefs_info *prf, FILE *fd)
+static void save_show_all(prefs_info *prf, FILE *fd)
{
- save_key_binding(prf, fd, make_show_all_binding);
+ save_key(prf, fd, make_show_all);
}
static void bind_show_all(prefs_info *prf)
{
- key_bind(prf, make_show_all_binding);
+ key_bind(prf, make_show_all);
}
@@ -4094,7 +4120,7 @@ static const char *help_select_all(prefs_info *prf)
}
-static char *make_select_all_binding(char *key, bool ctrl, bool meta, bool cx)
+static char *make_select_all(char *key, bool ctrl, bool meta, bool cx)
{
#if HAVE_SCHEME
return(mus_format("(bind-key %s %d (lambda () \
@@ -4135,15 +4161,15 @@ static void reflect_select_all(prefs_info *prf)
}
-static void save_select_all_binding(prefs_info *prf, FILE *fd)
+static void save_select_all(prefs_info *prf, FILE *fd)
{
- save_key_binding(prf, fd, make_select_all_binding);
+ save_key(prf, fd, make_select_all);
}
static void bind_select_all(prefs_info *prf)
{
- key_bind(prf, make_select_all_binding);
+ key_bind(prf, make_select_all);
}
@@ -4164,7 +4190,7 @@ static const char *help_revert(prefs_info *prf)
}
-static char *make_revert_binding(char *key, bool ctrl, bool meta, bool cx)
+static char *make_revert(char *key, bool ctrl, bool meta, bool cx)
{
#if HAVE_SCHEME
return(mus_format("(bind-key %s %d revert-sound %s \"undo all edits\" \"revert-sound\")\n",
@@ -4196,15 +4222,15 @@ static void reflect_revert(prefs_info *prf)
}
-static void save_revert_binding(prefs_info *prf, FILE *fd)
+static void save_revert(prefs_info *prf, FILE *fd)
{
- save_key_binding(prf, fd, make_revert_binding);
+ save_key(prf, fd, make_revert);
}
static void bind_revert(prefs_info *prf)
{
- key_bind(prf, make_revert_binding);
+ key_bind(prf, make_revert);
}
@@ -4225,7 +4251,7 @@ static const char *help_exit(prefs_info *prf)
}
-static char *make_exit_binding(char *key, bool ctrl, bool meta, bool cx)
+static char *make_exit(char *key, bool ctrl, bool meta, bool cx)
{
#if HAVE_SCHEME
return(mus_format("(bind-key %s %d exit %s \"exit\" \"exit\")\n",
@@ -4257,15 +4283,15 @@ static void reflect_exit(prefs_info *prf)
}
-static void save_exit_binding(prefs_info *prf, FILE *fd)
+static void save_exit(prefs_info *prf, FILE *fd)
{
- save_key_binding(prf, fd, make_exit_binding);
+ save_key(prf, fd, make_exit);
}
static void bind_exit(prefs_info *prf)
{
- key_bind(prf, make_exit_binding);
+ key_bind(prf, make_exit);
}
@@ -4286,7 +4312,7 @@ static const char *help_goto_maxamp(prefs_info *prf)
}
-static char *make_goto_maxamp_binding(char *key, bool ctrl, bool meta, bool cx)
+static char *make_goto_maxamp(char *key, bool ctrl, bool meta, bool cx)
{
#if HAVE_SCHEME
return(mus_format("(bind-key %s %d (lambda () (set! (cursor) (maxamp-position))) %s \"goto maxamp\" \"goto-maxamp\")\n",
@@ -4318,15 +4344,15 @@ static void reflect_goto_maxamp(prefs_info *prf)
}
-static void save_goto_maxamp_binding(prefs_info *prf, FILE *fd)
+static void save_goto_maxamp(prefs_info *prf, FILE *fd)
{
- save_key_binding(prf, fd, make_goto_maxamp_binding);
+ save_key(prf, fd, make_goto_maxamp);
}
static void bind_goto_maxamp(prefs_info *prf)
{
- key_bind(prf, make_goto_maxamp_binding);
+ key_bind(prf, make_goto_maxamp);
}
@@ -4347,7 +4373,7 @@ static const char *help_show_selection(prefs_info *prf)
}
-static char *make_show_selection_binding(char *key, bool ctrl, bool meta, bool cx)
+static char *make_show_selection(char *key, bool ctrl, bool meta, bool cx)
{
#if HAVE_SCHEME
return(mus_format("(bind-key %s %d show-selection %s \"show selection\" \"show-selection\")\n",
@@ -4379,15 +4405,15 @@ static void reflect_show_selection(prefs_info *prf)
}
-static void save_show_selection_binding(prefs_info *prf, FILE *fd)
+static void save_show_selection(prefs_info *prf, FILE *fd)
{
- save_key_binding(prf, fd, make_show_selection_binding);
+ save_key(prf, fd, make_show_selection);
}
static void bind_show_selection(prefs_info *prf)
{
- key_bind(prf, make_show_selection_binding);
+ key_bind(prf, make_show_selection);
}
@@ -4414,7 +4440,8 @@ static const char *help_just_sounds(prefs_info *prf)
{
return("\
The various file dialogs can restrict the files \n\
- displayed to just sound files. ");
+ displayed to just sound files. This sets the default\n\
+ value of the 'just sounds' button in those dialogs. ");
}
static const char *help_temp_dir(prefs_info *prf)
@@ -4466,18 +4493,18 @@ static const char *help_default_output_header_type(prefs_info *prf)
when a new sound is opened. ");
}
-static const char *help_default_output_data_format(prefs_info *prf)
+static const char *help_default_output_sample_type(prefs_info *prf)
{
return("\
- This sets the default data format (big-endian float, etc) \n\
+ This sets the default sample type (big-endian float, etc) \n\
when a new sound is opened. ");
}
-static const char *help_verbose_cursor(prefs_info *prf)
+static const char *help_with_verbose_cursor(prefs_info *prf)
{
return("\
If this is set, the cursor's position and the underlying \n\
- sample's value are displayed in the minibuffer as the cursor moves. ");
+ sample's value are displayed in the status area as the cursor moves. ");
}
static const char *help_with_tracking_cursor(prefs_info *prf)
@@ -4499,7 +4526,8 @@ static const char *help_cursor_style(prefs_info *prf)
static const char *help_tracking_cursor_style(prefs_info *prf)
{
- return(" This sets the tracking cursor shape. ");
+ return(" This sets the tracking cursor shape (the 'tracking cursor'\n\
+ tries to show where you are in the sound while it is begin played). ");
}
static const char *help_cursor_color(prefs_info *prf)
@@ -4664,7 +4692,7 @@ static const char *help_colormap(prefs_info *prf)
static const char *help_fft_log_magnitude(prefs_info *prf)
{
- return(" If this option is set, the FFTs show the magnitude axis on a log scale. ");
+ return(" If this option is set, the FFTs show the magnitude axis using a log scale. ");
}
static const char *help_min_dB(prefs_info *prf)
@@ -4676,7 +4704,7 @@ static const char *help_min_dB(prefs_info *prf)
static const char *help_fft_log_frequency(prefs_info *prf)
{
- return(" If this is set, FFTs show the frequency axis on a log scale. ");
+ return(" If this is set, FFTs show the frequency axis using a log scale. ");
}
static const char *help_transform_normalization(prefs_info *prf)
@@ -4703,7 +4731,7 @@ static const char *help_sinc_width(prefs_info *prf)
static const char *help_show_listener(prefs_info *prf)
{
- return(" This option chooses whether to include the listener window. ");
+ return(" This option chooses whether to open the listener window. ");
}
static const char *help_listener_prompt(prefs_info *prf)
@@ -4741,11 +4769,12 @@ static const char *help_dac_combines_channels(prefs_info *prf)
channels are mixed into the existing ones. ");
}
-
+#if USE_MOTIF
static const char *help_view_files_directory(prefs_info *prf)
{
return(" This directory is added to the View:files dialog's list. ");
}
+#endif
static const char *help_raw_chans(prefs_info *prf)
{
@@ -4761,16 +4790,16 @@ static const char *help_raw_srate(prefs_info *prf)
default sampling rate. ");
}
-static const char *help_raw_data_format(prefs_info *prf)
+static const char *help_raw_sample_type(prefs_info *prf)
{
return("\
When a raw (no header) sound is opened, this sets the \n\
- default data format. ");
+ default sample type. ");
}
static const char *help_tiny_font(prefs_info *prf)
{
- return(" When space is tight, Snd uses this font. ");
+ return(" When graph space is tight, Snd uses this font. ");
}
static const char *help_fft_size(prefs_info *prf)
diff --git a/snd-print.c b/snd-print.c
index 03f2fc1..530968e 100644
--- a/snd-print.c
+++ b/snd-print.c
@@ -44,8 +44,6 @@ static void ps_write(const char *buf)
}
-static char *previous_locale = NULL;
-
static int start_ps_graph(const char *output, const char *title)
{
ps_fd = CREAT(output, 0666);
@@ -54,24 +52,20 @@ static int start_ps_graph(const char *output, const char *title)
bbx = 0;
bby = 0;
-#if HAVE_SETLOCALE
- previous_locale = mus_strdup(setlocale(LC_NUMERIC, "C")); /* must use decimal point in floats since PostScript assumes that format */
-#endif
-
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE,
+ snprintf(pbuf, PRINT_BUFFER_SIZE,
"%%!PS-Adobe-2.0 EPSF-2.0\n%%%%Title: %s\n%%%%Creator: Snd: %s\n%%%%CreationDate: %s",
title,
SND_DATE,
snd_local_time());
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE,
+ snprintf(pbuf, PRINT_BUFFER_SIZE,
"\n%%%%BoundingBox:(atend)\n%%%%EndComments\n%%%%EndProlog\n%%%%Page: 1 1\n");
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE,
+ snprintf(pbuf, PRINT_BUFFER_SIZE,
"/LT {lineto} bind def\n/RF {rectfill} bind def\n/RG {setrgbcolor} bind def\n/NAF {newpath arc fill} bind def\n\n");
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE,
+ snprintf(pbuf, PRINT_BUFFER_SIZE,
"gsave [%.3f 0.0 0.0 %.3f %.3f %.3f] concat\n\n",
eps_size(ss), eps_size(ss), eps_left_margin(ss), eps_bottom_margin(ss));
ps_write(pbuf);
@@ -91,7 +85,7 @@ static void ps_graph(chan_info *cp, int x0, int y0)
static void end_ps_graph(void)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE,
+ snprintf(pbuf, PRINT_BUFFER_SIZE,
"%s\nshowpage\n%%%%Trailer\n%%%%BoundingBox: %d %d %d %d\n",
((eps_left_margin(ss) != 0) || (eps_bottom_margin(ss) != 0)) ? "\ngrestore" : "",
0, 0,
@@ -100,14 +94,6 @@ static void end_ps_graph(void)
ps_write(pbuf);
ps_flush(ps_fd);
snd_close(ps_fd, "eps file");
- if (previous_locale)
- {
-#if HAVE_SETLOCALE
- setlocale(LC_NUMERIC, previous_locale);
-#endif
- free(previous_locale);
- previous_locale = NULL;
- }
if (nbuf)
{
free(nbuf);
@@ -173,14 +159,14 @@ static mus_float_t ps_grf_y(axis_info *ap, mus_float_t val)
static void ps_draw_lines(axis_info *ap, int j, mus_float_t *xpts, mus_float_t *ypts)
{
int i;
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f moveto\n", ps_grf_x(ap, xpts[0]), ps_grf_y(ap, ypts[0]));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f moveto\n", ps_grf_x(ap, xpts[0]), ps_grf_y(ap, ypts[0]));
ps_write(pbuf);
for (i = 1; i < j; i++)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts[i]));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts[i]));
ps_write(pbuf);
}
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " stroke\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " stroke\n");
ps_write(pbuf);
}
@@ -192,7 +178,7 @@ static void ps_draw_dots(axis_info *ap, int j, mus_float_t *xpts, mus_float_t *y
arc_size = .5 * dot_size; /* radius here, diameter in X */
for (i = 0; i < j; i++)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f 0 360 NAF\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts[i]), arc_size);
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f 0 360 NAF\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts[i]), arc_size);
ps_write(pbuf);
}
}
@@ -203,15 +189,15 @@ static void ps_fill_polygons(axis_info *ap, int j, mus_float_t *xpts, mus_float_
int i;
for (i = 1; i < j; i++)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f moveto\n", ps_grf_x(ap, xpts[i - 1]), ps_grf_y(ap, ypts[i - 1]));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f moveto\n", ps_grf_x(ap, xpts[i - 1]), ps_grf_y(ap, ypts[i - 1]));
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts[i]));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts[i]));
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, y0));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, y0));
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i - 1]), ps_grf_y(ap, y0));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i - 1]), ps_grf_y(ap, y0));
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " closepath fill\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " closepath fill\n");
ps_write(pbuf);
}
}
@@ -245,7 +231,7 @@ void ps_draw_grf_points(axis_info *ap, int j, mus_float_t y0, graph_style_t grap
if (size4 < 1) size4 = 1;
for (i = 0; i < j; i++)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f %.2f RF\n",
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f %.2f RF\n",
ps_grf_x(ap, xpts[i]) - size8,
(float)gy0,
(float)size4,
@@ -275,15 +261,15 @@ void ps_draw_both_grf_points(axis_info *ap, int j, graph_style_t graph_style, in
case GRAPH_FILLED:
for (i = 1; i < j; i++)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f moveto\n", ps_grf_x(ap, xpts[i - 1]), ps_grf_y(ap, ypts[i - 1]));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f moveto\n", ps_grf_x(ap, xpts[i - 1]), ps_grf_y(ap, ypts[i - 1]));
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts[i]));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts[i]));
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts1[i]));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i]), ps_grf_y(ap, ypts1[i]));
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i - 1]), ps_grf_y(ap, ypts1[i - 1]));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f lineto\n", ps_grf_x(ap, xpts[i - 1]), ps_grf_y(ap, ypts1[i - 1]));
ps_write(pbuf);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " closepath fill\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " closepath fill\n");
ps_write(pbuf);
}
break;
@@ -307,7 +293,7 @@ void ps_draw_both_grf_points(axis_info *ap, int j, graph_style_t graph_style, in
if (size4 < 1) size4 = 1;
for (i = 0; i < j; i++)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f %.2f RF\n",
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f %.2f RF\n",
ps_grf_x(ap, xpts[i]) - size8,
ps_grf_y(ap, ypts[i]),
(float)size4,
@@ -329,17 +315,17 @@ void ps_draw_sono_rectangle(axis_info *ap, int color, mus_float_t x, mus_float_t
{
get_current_color(color_map(ss), color, &r, &g, &b);
last_color = color;
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f RG\n", RGB_TO_FLOAT(r), RGB_TO_FLOAT(g), RGB_TO_FLOAT(b));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f RG\n", rgb_to_float(r), rgb_to_float(g), rgb_to_float(b));
ps_write(pbuf);
}
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.1f %.1f %.2f %.2f RF\n", ps_grf_x(ap, x) + 2, ps_grf_y(ap, y), width, height);
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.1f %.1f %.2f %.2f RF\n", ps_grf_x(ap, x) + 2, ps_grf_y(ap, y), width, height);
ps_write(pbuf);
}
void ps_reset_color(void)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " 0 setgray\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " 0 setgray\n");
ps_write(pbuf);
last_color = -1;
}
@@ -357,17 +343,17 @@ static void ps_set_color(color_t color)
tmp_color.flags = DoRed | DoGreen | DoBlue;
tmp_color.pixel = color;
XQueryColor(dpy, cmap, &tmp_color);
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f RG\n",
- RGB_TO_FLOAT(tmp_color.red),
- RGB_TO_FLOAT(tmp_color.green),
- RGB_TO_FLOAT(tmp_color.blue));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f RG\n",
+ rgb_to_float(tmp_color.red),
+ rgb_to_float(tmp_color.green),
+ rgb_to_float(tmp_color.blue));
ps_write(pbuf);
#else
#if USE_GTK
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f RG\n",
- RGB_TO_FLOAT(color->red),
- RGB_TO_FLOAT(color->green),
- RGB_TO_FLOAT(color->blue));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f RG\n",
+ rgb_to_float(color->red),
+ rgb_to_float(color->green),
+ rgb_to_float(color->blue));
ps_write(pbuf);
#endif
#endif
@@ -396,7 +382,7 @@ void ps_bg(axis_info *ap, graphics_context *ax)
}
#endif
#endif
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %d %d %d %d RF\n",
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %d %d %d %d RF\n",
ap->graph_x0 + bx0, ap->y_offset + by0, ap->width, ap->height);
ps_write(pbuf);
ps_fg(cp, ax);
@@ -433,7 +419,7 @@ void ps_draw_line(axis_info *ap, int x0, int y0, int x1, int y1)
if (px1 > bbx) bbx = px1;
if (py0 > bby) bby = py0;
if (py1 > bby) bby = py1;
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " 0 setlinewidth %d %d moveto %d %d lineto stroke\n", px0, py0, px1, py1);
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " 0 setlinewidth %d %d moveto %d %d lineto stroke\n", px0, py0, px1, py1);
ps_write(pbuf);
}
@@ -446,7 +432,7 @@ void ps_draw_spectro_line(axis_info *ap, int color, mus_float_t x0, mus_float_t
{
get_current_color(color_map(ss), color, &r, &g, &b);
last_color = color;
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f RG\n", RGB_TO_FLOAT(r), RGB_TO_FLOAT(g), RGB_TO_FLOAT(b));
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %.2f %.2f %.2f RG\n", rgb_to_float(r), rgb_to_float(g), rgb_to_float(b));
ps_write(pbuf);
}
ps_draw_line(ap, (int)x0, (int)y0, (int)x1, (int)y1);
@@ -464,7 +450,7 @@ void ps_fill_rectangle(axis_info *ap, int x0, int y0, int width, int height)
if (px1 > bbx) bbx = px1;
if (py0 > bby) bby = py0;
if (py1 > bby) bby = py1;
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %d %d %d %d RF\n", px0, py0, width, -height);
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %d %d %d %d RF\n", px0, py0, width, -height);
ps_write(pbuf);
}
@@ -479,42 +465,42 @@ void ps_draw_string(axis_info *ap, int x0, int y0, const char *str)
#endif
if (px0 > bbx) bbx = px0;
if (py0 > bby) bby = py0;
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " %d %d moveto (%s) show\n", px0, py0, str);
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " %d %d moveto (%s) show\n", px0, py0, str);
ps_write(pbuf);
}
void ps_set_number_font(void)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " /Courier findfont 15 scalefont setfont\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " /Courier findfont 15 scalefont setfont\n");
ps_write(pbuf);
}
void ps_set_label_font(void)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " /Times-Roman findfont 20 scalefont setfont\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " /Times-Roman findfont 20 scalefont setfont\n");
ps_write(pbuf);
}
void ps_set_bold_peak_numbers_font(void)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " /Times-Bold findfont 14 scalefont setfont\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " /Times-Bold findfont 14 scalefont setfont\n");
ps_write(pbuf);
}
void ps_set_peak_numbers_font(void)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " /Times-Roman findfont 14 scalefont setfont\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " /Times-Roman findfont 14 scalefont setfont\n");
ps_write(pbuf);
}
void ps_set_tiny_numbers_font(void)
{
- mus_snprintf(pbuf, PRINT_BUFFER_SIZE, " /Times-Roman findfont 12 scalefont setfont\n");
+ snprintf(pbuf, PRINT_BUFFER_SIZE, " /Times-Roman findfont 12 scalefont setfont\n");
ps_write(pbuf);
}
@@ -527,7 +513,6 @@ static char *snd_print_or_error(const char *output)
{
int j, i, err;
int *offsets = NULL;
- snd_info *sp;
sync_info *si;
chan_info *ccp;
char *errstr = NULL;
@@ -544,6 +529,7 @@ static char *snd_print_or_error(const char *output)
if (si->chans > 1)
for (i = 0; i < si->chans; )
{
+ snd_info *sp;
sp = (si->cps[i])->sound;
if (sp == NULL) break;
if (sp->channel_style == CHANNELS_COMBINED)
@@ -563,7 +549,7 @@ static char *snd_print_or_error(const char *output)
end_ps_graph();
}
else errstr = mus_format("print %s failed: %s", output, snd_io_strerror());
- if (si) si = free_sync_info(si);
+ si = free_sync_info(si);
if (offsets) free(offsets);
return(errstr);
}
@@ -604,31 +590,31 @@ void print_enved(const char *output, int y0)
}
-static XEN g_graph_to_ps(XEN filename)
+static Xen g_graph_to_ps(Xen filename)
{
#define H_graph_to_ps "(" S_graph_to_ps " :optional (filename eps-file)): write the current Snd displays to an EPS file"
char *error;
const char *file;
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(filename), filename, XEN_ONLY_ARG, S_graph_to_ps, "a string (filename)");
+ Xen_check_type(Xen_is_string_or_unbound(filename), filename, 1, S_graph_to_ps, "a string (filename)");
- if (XEN_STRING_P(filename))
- file = XEN_TO_C_STRING(filename);
+ if (Xen_is_string(filename))
+ file = Xen_string_to_C_string(filename);
else file = eps_file(ss);
error = snd_print_or_error(file);
if (error)
{
- XEN result;
- result = C_TO_XEN_STRING(error);
+ Xen result;
+ result = C_string_to_Xen_string(error);
free(error);
- XEN_ERROR(XEN_ERROR_TYPE("cannot-print"),
- XEN_LIST_3(C_TO_XEN_STRING(S_graph_to_ps ": can't print ~S (~A)"),
- C_TO_XEN_STRING(file),
+ Xen_error(Xen_make_error_type("cannot-print"),
+ Xen_list_3(C_string_to_Xen_string(S_graph_to_ps ": can't print ~S (~A)"),
+ C_string_to_Xen_string(file),
result));
}
- return(C_TO_XEN_STRING(file));
+ return(C_string_to_Xen_string(file));
}
@@ -642,7 +628,7 @@ static XEN g_graph_to_ps(XEN filename)
static int gl2ps_types[NUM_GL2PS_TYPES] = {GL2PS_EPS, GL2PS_PS, GL2PS_PDF, GL2PS_TEX, GL2PS_SVG, GL2PS_PGF};
-static XEN g_gl_graph_to_ps(XEN filename, XEN output_type, XEN snd, XEN chn)
+static Xen g_gl_graph_to_ps(Xen filename, Xen output_type, Xen snd, Xen chn)
{
#define H_gl_graph_to_ps "(" S_gl_graph_to_ps " :optional filename (type 0) snd chn) produces a postscript output file from \
OpenGL graphics. type can be 0: eps, 1: ps, 2: pdf, 3: tex, 4: svg, 5: pgf."
@@ -652,30 +638,22 @@ OpenGL graphics. type can be 0: eps, 1: ps, 2: pdf, 3: tex, 4: svg, 5: pgf."
chan_info *cp;
int state = GL2PS_OVERFLOW, buffsize = 1024 * 1024, type = 0;
-#if HAVE_SETLOCALE
- char *old_locale = NULL;
-#endif
-
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(filename), filename, XEN_ARG_1, S_gl_graph_to_ps, "a string (filename)");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(output_type), output_type, XEN_ARG_2, S_gl_graph_to_ps, "an integer, 0=eps");
+ Xen_check_type(Xen_is_string_or_unbound(filename), filename, 1, S_gl_graph_to_ps, "a string (filename)");
+ Xen_check_type(Xen_is_integer_or_unbound(output_type), output_type, 2, S_gl_graph_to_ps, "an integer, 0=eps");
- ASSERT_CHANNEL(S_gl_graph_to_ps, snd, chn, 3);
+ Snd_assert_channel(S_gl_graph_to_ps, snd, chn, 3);
cp = get_cp(snd, chn, S_gl_graph_to_ps);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- if (XEN_STRING_P(filename))
- file = XEN_TO_C_STRING(filename);
+ if (Xen_is_string(filename))
+ file = Xen_string_to_C_string(filename);
else file = eps_file(ss);
- if (XEN_INTEGER_P(output_type))
- type = XEN_TO_C_INT(output_type);
+ if (Xen_is_integer(output_type))
+ type = Xen_integer_to_C_int(output_type);
if ((type < 0) || (type >= NUM_GL2PS_TYPES))
- XEN_OUT_OF_RANGE_ERROR(S_gl_graph_to_ps, XEN_ARG_2, output_type, "must be between 0 and 5");
+ Xen_out_of_range_error(S_gl_graph_to_ps, 2, output_type, "must be between 0 and 5");
-#if HAVE_SETLOCALE
- old_locale = mus_strdup(setlocale(LC_NUMERIC, "C"));
-#endif
-
fp = fopen(file, "wb");
while (state == GL2PS_OVERFLOW)
@@ -702,12 +680,8 @@ OpenGL graphics. type can be 0: eps, 1: ps, 2: pdf, 3: tex, 4: svg, 5: pgf."
}
}
fclose(fp);
-#if HAVE_SETLOCALE
- setlocale(LC_NUMERIC, old_locale);
- if (old_locale) free(old_locale);
-#endif
- return(C_TO_XEN_STRING(file));
+ return(C_string_to_Xen_string(file));
}
@@ -729,108 +703,114 @@ void gl2ps_text(const char *msg)
#else
-static XEN g_gl_graph_to_ps(XEN filename, XEN output_type, XEN snd_ignore, XEN chn_ignore)
+static Xen g_gl_graph_to_ps(Xen filename, Xen output_type, Xen snd_ignore, Xen chn_ignore)
{
#define H_gl_graph_to_ps "gl-graph->ps is a no-op in this version of Snd"
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(filename), filename, XEN_ARG_1, S_gl_graph_to_ps, "a string (filename)");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(output_type), output_type, XEN_ARG_2, S_gl_graph_to_ps, "an integer, 0=eps");
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_string_or_unbound(filename), filename, 1, S_gl_graph_to_ps, "a string (filename)");
+ Xen_check_type(Xen_is_integer_or_unbound(output_type), output_type, 2, S_gl_graph_to_ps, "an integer, 0=eps");
+ return(Xen_false);
}
#endif
/* -------------------------------- */
-static XEN g_eps_file(void) {return(C_TO_XEN_STRING(eps_file(ss)));}
+static Xen g_eps_file(void) {return(C_string_to_Xen_string(eps_file(ss)));}
-static XEN g_set_eps_file(XEN val)
+static Xen g_set_eps_file(Xen val)
{
#define H_eps_file "(" S_eps_file "): File:Print and " S_graph_to_ps " file name (snd.eps)"
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_eps_file, "a string");
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_eps_file, "a string");
if (eps_file(ss)) free(eps_file(ss));
- set_eps_file(mus_strdup(XEN_TO_C_STRING(val)));
- return(C_TO_XEN_STRING(eps_file(ss)));
+ set_eps_file(mus_strdup(Xen_string_to_C_string(val)));
+ return(C_string_to_Xen_string(eps_file(ss)));
}
#define MAX_EPS_MARGIN 1000.0
-static XEN g_eps_left_margin(void) {return(C_TO_XEN_DOUBLE(eps_left_margin(ss)));}
+static Xen g_eps_left_margin(void) {return(C_double_to_Xen_real(eps_left_margin(ss)));}
-static XEN g_set_eps_left_margin(XEN val)
+static Xen g_set_eps_left_margin(Xen val)
{
#define H_eps_left_margin "(" S_eps_left_margin "): File:Print and " S_graph_to_ps " left margin"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_eps_left_margin, "a number");
- set_eps_left_margin(mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), MAX_EPS_MARGIN));
- return(C_TO_XEN_DOUBLE(eps_left_margin(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_eps_left_margin, "a number");
+ set_eps_left_margin(mus_fclamp(0.0, Xen_real_to_C_double(val), MAX_EPS_MARGIN));
+ return(C_double_to_Xen_real(eps_left_margin(ss)));
}
-static XEN g_eps_bottom_margin(void) {return(C_TO_XEN_DOUBLE(eps_bottom_margin(ss)));}
+static Xen g_eps_bottom_margin(void) {return(C_double_to_Xen_real(eps_bottom_margin(ss)));}
-static XEN g_set_eps_bottom_margin(XEN val)
+static Xen g_set_eps_bottom_margin(Xen val)
{
#define H_eps_bottom_margin "(" S_eps_bottom_margin "): File:Print and " S_graph_to_ps " bottom margin"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_eps_bottom_margin, "a number");
- set_eps_bottom_margin(mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), MAX_EPS_MARGIN));
- return(C_TO_XEN_DOUBLE(eps_bottom_margin(ss)));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_eps_bottom_margin, "a number");
+ set_eps_bottom_margin(mus_fclamp(0.0, Xen_real_to_C_double(val), MAX_EPS_MARGIN));
+ return(C_double_to_Xen_real(eps_bottom_margin(ss)));
}
-static XEN g_eps_size(void) {return(C_TO_XEN_DOUBLE(eps_size(ss)));}
+static Xen g_eps_size(void) {return(C_double_to_Xen_real(eps_size(ss)));}
-static XEN g_set_eps_size(XEN val)
+static Xen g_set_eps_size(Xen val)
{
#define MAX_EPS_SIZE 1000.0
#define H_eps_size "(" S_eps_size "): File:Print and " S_graph_to_ps " output size scaler (1.0)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ONLY_ARG, S_setB S_eps_size, "a number");
- set_eps_size(mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), MAX_EPS_SIZE));
- return(C_TO_XEN_DOUBLE(eps_size(ss)));
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_1(g_graph_to_ps_w, g_graph_to_ps)
-XEN_ARGIFY_4(g_gl_graph_to_ps_w, g_gl_graph_to_ps)
-XEN_NARGIFY_0(g_eps_file_w, g_eps_file)
-XEN_NARGIFY_1(g_set_eps_file_w, g_set_eps_file)
-XEN_NARGIFY_0(g_eps_left_margin_w, g_eps_left_margin)
-XEN_NARGIFY_1(g_set_eps_left_margin_w, g_set_eps_left_margin)
-XEN_NARGIFY_0(g_eps_size_w, g_eps_size)
-XEN_NARGIFY_1(g_set_eps_size_w, g_set_eps_size)
-XEN_NARGIFY_0(g_eps_bottom_margin_w, g_eps_bottom_margin)
-XEN_NARGIFY_1(g_set_eps_bottom_margin_w, g_set_eps_bottom_margin)
-#else
-#define g_graph_to_ps_w g_graph_to_ps
-#define g_gl_graph_to_ps_w g_gl_graph_to_ps
-#define g_eps_file_w g_eps_file
-#define g_set_eps_file_w g_set_eps_file
-#define g_eps_left_margin_w g_eps_left_margin
-#define g_set_eps_left_margin_w g_set_eps_left_margin
-#define g_eps_size_w g_eps_size
-#define g_set_eps_size_w g_set_eps_size
-#define g_eps_bottom_margin_w g_eps_bottom_margin
-#define g_set_eps_bottom_margin_w g_set_eps_bottom_margin
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_eps_size, "a number");
+ set_eps_size(mus_fclamp(0.0, Xen_real_to_C_double(val), MAX_EPS_SIZE));
+ return(C_double_to_Xen_real(eps_size(ss)));
+}
+
+
+Xen_wrap_1_optional_arg(g_graph_to_ps_w, g_graph_to_ps)
+Xen_wrap_4_optional_args(g_gl_graph_to_ps_w, g_gl_graph_to_ps)
+Xen_wrap_no_args(g_eps_file_w, g_eps_file)
+Xen_wrap_1_arg(g_set_eps_file_w, g_set_eps_file)
+Xen_wrap_no_args(g_eps_left_margin_w, g_eps_left_margin)
+Xen_wrap_1_arg(g_set_eps_left_margin_w, g_set_eps_left_margin)
+Xen_wrap_no_args(g_eps_size_w, g_eps_size)
+Xen_wrap_1_arg(g_set_eps_size_w, g_set_eps_size)
+Xen_wrap_no_args(g_eps_bottom_margin_w, g_eps_bottom_margin)
+Xen_wrap_1_arg(g_set_eps_bottom_margin_w, g_set_eps_bottom_margin)
+
+#if HAVE_SCHEME
+static s7_pointer acc_eps_bottom_margin(s7_scheme *sc, s7_pointer args) {return(g_set_eps_bottom_margin(s7_cadr(args)));}
+static s7_pointer acc_eps_file(s7_scheme *sc, s7_pointer args) {return(g_set_eps_file(s7_cadr(args)));}
+static s7_pointer acc_eps_left_margin(s7_scheme *sc, s7_pointer args) {return(g_set_eps_left_margin(s7_cadr(args)));}
+static s7_pointer acc_eps_size(s7_scheme *sc, s7_pointer args) {return(g_set_eps_size(s7_cadr(args)));}
#endif
void g_init_print(void)
{
- XEN_DEFINE_PROCEDURE(S_graph_to_ps, g_graph_to_ps_w, 0, 1, 0, H_graph_to_ps);
- XEN_DEFINE_PROCEDURE(S_gl_graph_to_ps, g_gl_graph_to_ps_w, 0, 4, 0, H_gl_graph_to_ps);
+ Xen_define_procedure(S_graph_to_ps, g_graph_to_ps_w, 0, 1, 0, H_graph_to_ps);
+ Xen_define_procedure(S_gl_graph_to_ps, g_gl_graph_to_ps_w, 0, 4, 0, H_gl_graph_to_ps);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_eps_file, g_eps_file_w, H_eps_file,
- S_setB S_eps_file, g_set_eps_file_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_eps_file, g_eps_file_w, H_eps_file,
+ S_set S_eps_file, g_set_eps_file_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_eps_left_margin, g_eps_left_margin_w, H_eps_left_margin,
- S_setB S_eps_left_margin, g_set_eps_left_margin_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_eps_left_margin, g_eps_left_margin_w, H_eps_left_margin,
+ S_set S_eps_left_margin, g_set_eps_left_margin_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_eps_bottom_margin, g_eps_bottom_margin_w, H_eps_bottom_margin,
- S_setB S_eps_bottom_margin, g_set_eps_bottom_margin_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_eps_bottom_margin, g_eps_bottom_margin_w, H_eps_bottom_margin,
+ S_set S_eps_bottom_margin, g_set_eps_bottom_margin_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_eps_size, g_eps_size_w, H_eps_size,
- S_setB S_eps_size, g_set_eps_size_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_eps_size, g_eps_size_w, H_eps_size,
+ S_set S_eps_size, g_set_eps_size_w, 0, 0, 1, 0);
#if HAVE_GL && WITH_GL2PS
- XEN_YES_WE_HAVE("gl2ps");
+ Xen_provide_feature("gl2ps");
+#endif
+
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->eps_bottom_margin_symbol, s7_make_function(s7, "[acc-" S_eps_bottom_margin "]", acc_eps_bottom_margin, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->eps_file_symbol, s7_make_function(s7, "[acc-" S_eps_file "]", acc_eps_file, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->eps_left_margin_symbol, s7_make_function(s7, "[acc-" S_eps_left_margin "]", acc_eps_left_margin, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->eps_size_symbol, s7_make_function(s7, "[acc-" S_eps_size "]", acc_eps_size, 2, 0, false, "accessor"));
+
+ s7_symbol_set_documentation(s7, ss->eps_bottom_margin_symbol, "*eps-bottom-margin*: File:Print and graph->ps bottom margin");
+ s7_symbol_set_documentation(s7, ss->eps_file_symbol, "*eps-file*: File:Print and graph->ps file name (snd.eps)");
+ s7_symbol_set_documentation(s7, ss->eps_left_margin_symbol, "*eps-left-margin*: File:Print and graph->ps left margin");
+ s7_symbol_set_documentation(s7, ss->eps_size_symbol, "*eps-size*: File:Print and graph->ps output size scaler (1.0)");
#endif
}
diff --git a/snd-region.c b/snd-region.c
index 92df0c6..5739269 100644
--- a/snd-region.c
+++ b/snd-region.c
@@ -40,7 +40,7 @@ static deferred_region *free_deferred_region(deferred_region *dr)
typedef struct region {
int chans;
- mus_long_t frames;
+ mus_long_t framples;
int srate; /* for file save (i.e. region->file) */
int header_type; /* for file save */
snd_info *rsp;
@@ -198,7 +198,7 @@ mus_long_t region_len(int n)
region *r;
r = id_to_region(n);
if (r)
- return(r->frames);
+ return(r->framples);
return(0);
}
@@ -233,14 +233,44 @@ const char *region_file_name(int n)
}
+static void get_region_maxamp(region *r)
+{
+ /* it exists as r->filename, so just use sndlib... */
+ mus_float_t *vals;
+ mus_long_t *times;
+ int i;
+ mus_long_t maxpos;
+ mus_float_t maxsamp;
+ vals = (mus_float_t *)calloc(r->chans, sizeof(mus_float_t));
+ times = (mus_long_t *)calloc(r->chans, sizeof(mus_long_t));
+ mus_sound_maxamps(r->filename, r->chans, vals, times);
+ maxpos = times[0];
+ maxsamp = vals[0];
+ for (i = 1; i < r->chans; i++)
+ if (vals[i] > maxsamp)
+ {
+ maxsamp = vals[i];
+ maxpos = times[i];
+ }
+ free(vals);
+ free(times);
+ r->maxamp = maxsamp;
+ r->maxamp_position = maxpos;
+}
+
+
mus_float_t region_maxamp(int n)
{
region *r;
r = id_to_region(n);
if (r)
{
- if ((r->maxamp < 0.0) && (r->use_temp_file == REGION_DEFERRED))
- deferred_region_to_temp_file(r);
+ if (r->maxamp < 0.0)
+ {
+ if (r->use_temp_file == REGION_DEFERRED)
+ deferred_region_to_temp_file(r);
+ get_region_maxamp(r);
+ }
return(r->maxamp);
}
return(0.0);
@@ -253,30 +283,11 @@ static mus_long_t region_maxamp_position(int n)
r = id_to_region(n);
if (r)
{
- if ((r->maxamp < 0.0) && (r->use_temp_file == REGION_DEFERRED))
- deferred_region_to_temp_file(r);
- if ((r->maxamp_position == -1) && (r->filename)) /* not picked up elsewhere */
+ if (r->maxamp < 0.0)
{
- /* it exists as r->filename, so just use sndlib... */
- mus_sample_t *vals;
- mus_long_t *times;
- int i;
- mus_long_t maxpos;
- mus_sample_t maxsamp;
- vals = (mus_sample_t *)calloc(r->chans, sizeof(mus_sample_t));
- times = (mus_long_t *)calloc(r->chans, sizeof(mus_long_t));
- mus_sound_maxamps(r->filename, r->chans, vals, times);
- maxpos = times[0];
- maxsamp = vals[0];
- for (i = 1; i < r->chans; i++)
- if (vals[i] > maxsamp)
- {
- maxsamp = vals[i];
- maxpos = times[i];
- }
- free(vals);
- free(times);
- r->maxamp_position = maxpos;
+ if (r->use_temp_file == REGION_DEFERRED)
+ deferred_region_to_temp_file(r);
+ get_region_maxamp(r);
}
return(r->maxamp_position);
}
@@ -290,7 +301,7 @@ static mus_float_t region_sample(int reg, int chn, mus_long_t samp)
r = id_to_region(reg);
if (r)
{
- if ((samp < r->frames) && (chn < r->chans))
+ if ((samp < r->framples) && (chn < r->chans))
{
snd_fd *sf;
mus_float_t val;
@@ -338,33 +349,25 @@ static void region_samples(int reg, int chn, mus_long_t beg, mus_long_t num, mus
r = id_to_region(reg);
if (r)
{
- if ((beg < r->frames) && (chn < r->chans))
+ if ((beg < r->framples) && (chn < r->chans))
{
snd_fd *sf;
- mus_long_t i, j = 0;
deferred_region *drp;
switch (r->use_temp_file)
{
case REGION_FILE:
sf = init_region_read(beg, reg, chn, READ_FORWARD);
- for (i = beg, j = 0; (i < r->frames) && (j < num); i++, j++)
- data[j] = read_sample(sf);
+ samples_to_vct_with_reader(num, data, sf);
free_snd_fd(sf);
break;
case REGION_DEFERRED:
drp = r->dr;
- sf = init_sample_read_any(beg + r->begs[chn], drp->cps[chn], READ_FORWARD, drp->edpos[chn]);
- for (i = beg, j = 0; (i < r->frames) && (j < num); i++, j++)
- data[j] = read_sample(sf);
+ sf = init_sample_read_any_with_bufsize(beg + r->begs[chn], drp->cps[chn], READ_FORWARD, drp->edpos[chn], num);
+ samples_to_vct_with_reader(num, data, sf);
free_snd_fd(sf);
break;
}
- if (j < num)
- {
- memset((void *)(data + j), 0, (num - j) * sizeof(mus_float_t));
- /* for (; j < num; j++) data[j] = 0.0; */
- }
}
}
}
@@ -403,34 +406,33 @@ static void make_region_readable(region *r)
regsp = make_basic_snd_info(r->chans);
regsp->nchans = r->chans;
regsp->hdr = (file_info *)calloc(1, sizeof(file_info));
- regsp->search_proc = XEN_UNDEFINED;
- regsp->prompt_callback = XEN_UNDEFINED;
regsp->inuse = SOUND_READER;
hdr = regsp->hdr;
- hdr->samples = r->frames * r->chans;
+ hdr->samples = r->framples * r->chans;
hdr->srate = r->srate;
hdr->chans = r->chans;
hdr->comment = NULL;
for (i = 0; i < r->chans; i++)
{
- chan_info *cp;
- cp = make_chan_info(NULL, i, regsp);
- cp->editable = false;
- regsp->chans[i] = cp;
- add_channel_data_1(cp, r->srate, r->frames, WITHOUT_GRAPH);
- cp->hookable = WITHOUT_HOOK;
-
hdr = make_file_info(r->filename, FILE_READ_ONLY, FILE_NOT_SELECTED);
if (hdr)
{
snd_io *io;
int fd;
+ chan_info *cp;
+
+ cp = make_chan_info(NULL, i, regsp);
+ cp->editable = false;
+ regsp->chans[i] = cp;
+ add_channel_data_1(cp, r->srate, r->framples, WITHOUT_GRAPH);
+ cp->hookable = WITHOUT_HOOK;
+
fd = snd_open_read(r->filename);
snd_file_open_descriptors(fd,
r->filename,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
hdr->chans,
hdr->type);
@@ -439,10 +441,10 @@ static void make_region_readable(region *r)
}
else
{
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_3(C_TO_XEN_STRING("can't read region file ~S, ~A"),
- C_TO_XEN_STRING(r->filename),
- C_TO_XEN_STRING(snd_open_strerror())));
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_3(C_string_to_Xen_string("can't read region file ~S, ~A"),
+ C_string_to_Xen_string(r->filename),
+ C_string_to_Xen_string(snd_open_strerror())));
}
}
r->rsp = regsp;
@@ -533,7 +535,7 @@ region_state *region_report(void)
char *reg_buf;
r = regions[i];
reg_buf = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
- mus_snprintf(reg_buf, LABEL_BUFFER_SIZE, "%d: %s (%s:%s)", r->id, r->name, r->start, r->end);
+ snprintf(reg_buf, LABEL_BUFFER_SIZE, "%d: %s (%s:%s)", r->id, r->name, r->start, r->end);
rs->name[i] = reg_buf;
}
return(rs);
@@ -612,16 +614,16 @@ static int paste_region_1(int n, chan_info *cp, bool add, mus_long_t beg, io_err
{
region *r;
char *origin = NULL;
- int i, id = -1;
+ int id = -1;
io_error_t io_err;
sync_info *si = NULL;
r = id_to_region(n);
if ((r == NULL) ||
- (r->frames == 0))
+ (r->framples == 0))
return(INVALID_REGION);
- if (!(editable_p(cp)))
+ if (!(is_editable(cp)))
{
(*err) = IO_EDIT_HOOK_CANCELLATION;
return(NOT_EDITABLE);
@@ -647,18 +649,18 @@ static int paste_region_1(int n, chan_info *cp, bool add, mus_long_t beg, io_err
else
{
#if HAVE_FORTH
- origin = mus_format("%d %s " MUS_LD " %s drop", n, S_integer_to_region, beg, S_mix_region);
+ origin = mus_format("%d %s %lld %s drop", n, S_integer_to_region, beg, S_mix_region);
#endif
#if HAVE_RUBY
- origin = mus_format("%s(%s(%d), " MUS_LD, TO_PROC_NAME(S_mix_region), TO_PROC_NAME(S_integer_to_region), n, beg);
+ origin = mus_format("%s(%s(%d), %lld", to_proc_name(S_mix_region), to_proc_name(S_integer_to_region), n, beg);
#endif
#if HAVE_SCHEME || (!HAVE_EXTENSION_LANGUAGE)
- origin = mus_format("%s (%s %d) " MUS_LD, S_mix_region, S_integer_to_region, n, beg);
+ origin = mus_format("%s (%s %d) %lld", S_mix_region, S_integer_to_region, n, beg);
#endif
if (si->chans > 1)
remember_temp(newname, si->chans);
- id = mix_file(beg, r->frames, si->chans, si->cps, newname,
+ id = mix_file(beg, r->framples, si->chans, si->cps, newname,
(si->chans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
origin, with_mix_tags(ss), start_chan);
free(origin);
@@ -667,6 +669,7 @@ static int paste_region_1(int n, chan_info *cp, bool add, mus_long_t beg, io_err
}
else
{
+ int i;
char *tempfile = NULL;
if (r->use_temp_file == REGION_FILE)
{
@@ -684,20 +687,20 @@ static int paste_region_1(int n, chan_info *cp, bool add, mus_long_t beg, io_err
}
#if HAVE_FORTH
- origin = mus_format("%d %s " MUS_LD " %s drop", n, S_integer_to_region, beg, S_insert_region);
+ origin = mus_format("%d %s %lld %s drop", n, S_integer_to_region, beg, S_insert_region);
#endif
#if HAVE_RUBY
- origin = mus_format("%s(%s(%d), " MUS_LD, TO_PROC_NAME(S_insert_region), TO_PROC_NAME(S_integer_to_region), n, beg);
+ origin = mus_format("%s(%s(%d), %lld", to_proc_name(S_insert_region), to_proc_name(S_integer_to_region), n, beg);
#endif
#if HAVE_SCHEME || (!HAVE_EXTENSION_LANGUAGE)
- origin = mus_format("%s (%s %d) " MUS_LD, S_insert_region, S_integer_to_region, n, beg);
+ origin = mus_format("%s (%s %d) %lld", S_insert_region, S_integer_to_region, n, beg);
#endif
for (i = 0; ((i < r->chans) && (i < si->chans)); i++)
{
chan_info *ncp;
ncp = si->cps[i]; /* currently syncd chan that we might paste to */
- if (file_insert_samples(beg, r->frames, tempfile, ncp, i,
+ if (file_insert_samples(beg, r->framples, tempfile, ncp, i,
(r->chans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
origin, ncp->edit_ctr))
update_graph(si->cps[i]);
@@ -713,21 +716,21 @@ static int paste_region_1(int n, chan_info *cp, bool add, mus_long_t beg, io_err
static io_error_t paste_region_2(int n, chan_info *cp, bool add, mus_long_t beg)
{
io_error_t err = IO_NO_ERROR;
- int id, chans = 0;
- id = paste_region_1(n, cp, add, beg, &err, 0, &chans);
+ int chans = 0;
+ paste_region_1(n, cp, add, beg, &err, 0, &chans);
return(err);
}
io_error_t paste_region(int n, chan_info *cp)
{
- return(paste_region_2(n, cp, false, CURSOR(cp)));
+ return(paste_region_2(n, cp, false, cursor_sample(cp)));
}
io_error_t add_region(int n, chan_info *cp)
{
- return(paste_region_2(n, cp, true, CURSOR(cp)));
+ return(paste_region_2(n, cp, true, cursor_sample(cp)));
}
@@ -760,13 +763,13 @@ int define_region(sync_info *si, mus_long_t *ends)
else regions[0] = r;
r->header_type = (sp0->hdr)->type;
- r->srate = SND_SRATE(sp0);
+ r->srate = snd_srate(sp0);
r->maxamp = -1.0;
r->maxamp_position = -1;
r->editor_copy = NULL;
r->name = mus_strdup(sp0->short_filename);
r->chans = si->chans;
- r->frames = len;
+ r->framples = len;
r->start = prettyf((double)(si->begs[0]) / (double)(r->srate), 2);
r->end = prettyf((double)(ends[0]) / (double)(r->srate), 2);
r->use_temp_file = REGION_DEFERRED;
@@ -808,25 +811,22 @@ int define_region(sync_info *si, mus_long_t *ends)
static void deferred_region_to_temp_file(region *r)
{
- int i, k, ofd = 0, datumb = 0, err = 0;
+ int i, datumb = 0;
bool copy_ok;
- mus_long_t j, len = 0;
- mus_sample_t val;
+ mus_long_t alloc_len, len = 0;
snd_fd **sfs = NULL;
snd_info *sp0;
- file_info *hdr = NULL;
deferred_region *drp = NULL;
- mus_sample_t **data = NULL;
+ mus_float_t **data = NULL;
ss->deferred_regions--;
drp = r->dr;
len = drp->len;
- val = MUS_SAMPLE_0;
r->use_temp_file = REGION_FILE;
r->filename = snd_tempnam();
sp0 = drp->cps[0]->sound;
- copy_ok = ((mus_header_writable(MUS_NEXT, sp0->hdr->format)) &&
+ copy_ok = ((mus_header_writable(MUS_NEXT, sp0->hdr->sample_type)) &&
(r->chans == sp0->nchans) &&
(r->peak_envs != NULL) &&
((drp->len - 1) == r->lens[0]));
@@ -849,19 +849,16 @@ static void deferred_region_to_temp_file(region *r)
* copy len*data-size bytes
* get max from amp envs
*/
- mus_long_t bytes, err;
- int fdi, fdo;
- char *buffer;
- mus_float_t ymax = 0.0;
- peak_env_info *ep;
+ mus_long_t err;
- datumb = mus_bytes_per_sample(sp0->hdr->format);
- err = mus_write_header(r->filename, MUS_NEXT, r->srate, r->chans, drp->len * r->chans, sp0->hdr->format, "region deferred temp");
+ datumb = mus_bytes_per_sample(sp0->hdr->sample_type);
+ err = mus_write_header(r->filename, MUS_NEXT, r->srate, r->chans, drp->len * r->chans, sp0->hdr->sample_type, "region deferred temp");
if (err != MUS_NO_ERROR)
snd_error("can't write region temp file %s: %s", r->filename, snd_io_strerror());
else
{
+ int fdi, fdo;
mus_long_t oloc;
oloc = mus_header_data_location();
fdo = snd_reopen_write(r->filename);
@@ -871,51 +868,48 @@ static void deferred_region_to_temp_file(region *r)
snd_error("can't read region's original sound? %s: %s", sp0->filename, snd_io_strerror());
else
{
- mus_long_t data_size;
+ mus_long_t j, data_size;
+ char *buffer;
+
lseek(fdi, sp0->hdr->data_location + r->chans * datumb * r->begs[0], SEEK_SET);
- buffer = (char *)calloc(MAX_BUFFER_SIZE, sizeof(char));
data_size = drp->len * r->chans * datumb;
- for (j = 0; j < data_size; j += MAX_BUFFER_SIZE)
+ if (data_size > REPORTING_SIZE)
+ alloc_len = REPORTING_SIZE;
+ else alloc_len = data_size;
+ buffer = (char *)malloc(alloc_len * sizeof(char));
+ for (j = 0; j < data_size; j += alloc_len)
{
+ mus_long_t bytes;
ssize_t n;
bytes = data_size - j;
- if (bytes > MAX_BUFFER_SIZE)
- bytes = MAX_BUFFER_SIZE;
- if (bytes > 0)
+ if (bytes > alloc_len)
+ bytes = alloc_len;
+
+ /* read and write return 0 to indicate end of file, apparently */
+ n = read(fdi, buffer, bytes);
+
+ if (n < 0)
+ fprintf(stderr, "IO error while reading region temp file: %d %s\n", (int)n, strerror(errno));
+ if (n > 0)
{
- /* read and write return 0 to indicate end of file, apparently */
- n = read(fdi, buffer, bytes);
+ n = write(fdo, buffer, bytes);
if (n < 0)
- fprintf(stderr, "IO error while reading region temp file: %d %s\n", (int)n, strerror(errno));
- if (n > 0)
- {
- n = write(fdo, buffer, bytes);
- if (n < 0)
- fprintf(stderr, "IO error while writing region temp file: %d %s\n", (int)n, strerror(errno));
- }
+ fprintf(stderr, "IO error while writing region temp file: %d %s\n", (int)n, strerror(errno));
}
}
free(buffer);
snd_close(fdi, sp0->filename);
- for (i = 0; i < r->chans; i++)
- {
- ep = r->peak_envs[i];
- if (ymax < ep->fmax)
- ymax = ep->fmax;
- if (ymax < -ep->fmin)
- ymax = -ep->fmin;
- }
- r->maxamp = ymax;
- r->maxamp_position = -1; /* not tracked in amp-env stuff */
}
snd_close(fdo, r->filename);
}
}
else
{
- mus_long_t max_position = 0;
io_error_t io_err = IO_NO_ERROR;
- hdr = make_temp_header(r->filename, r->srate, r->chans, 0, (char *)c__FUNCTION__);
+ file_info *hdr = NULL;
+ int ofd;
+
+ hdr = make_temp_header(r->filename, r->srate, r->chans, 0, (char *)__func__);
ofd = open_temp_file(r->filename, r->chans, hdr, &io_err);
if (ofd == -1)
snd_error("%s region temp file %s: %s",
@@ -925,43 +919,87 @@ static void deferred_region_to_temp_file(region *r)
else
{
sfs = (snd_fd **)calloc(r->chans, sizeof(snd_fd *));
- data = (mus_sample_t **)calloc(r->chans, sizeof(mus_sample_t *));
- datumb = mus_bytes_per_sample(hdr->format);
+ data = (mus_float_t **)calloc(r->chans, sizeof(mus_float_t *));
+ datumb = mus_bytes_per_sample(hdr->sample_type);
/* here if peak_envs, maxamp exists */
+
+ alloc_len = len;
+ if (alloc_len > REPORTING_SIZE)
+ alloc_len = REPORTING_SIZE;
+
for (i = 0; i < r->chans; i++)
{
sfs[i] = init_sample_read_any(r->begs[i], drp->cps[i], READ_FORWARD, drp->edpos[i]);
- data[i] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
+ data[i] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
}
- for (j = 0, k = 0; j < len; j++, k++)
+
+ if ((r->chans == 1) &&
+ (r->lens[0] == (len - 1)))
{
- if (k == MAX_BUFFER_SIZE)
+ snd_fd *sf;
+ mus_float_t *d;
+
+ sf = sfs[0];
+ d = data[0];
+ if (len <= REPORTING_SIZE)
{
- err = mus_file_write(ofd, 0, k - 1, r->chans, data);
- k = 0;
- if (err == -1) break;
+ samples_to_vct_with_reader(len, d, sf);
+ mus_file_write(ofd, 0, len - 1, 1, data);
}
- for (i = 0; i < r->chans; i++)
+ else
+ {
+ int k;
+ sampler_set_safe(sf, len);
+ for (k = 0; k < len; k += alloc_len)
+ {
+ mus_long_t kdur, n;
+ int err;
+ kdur = len - k;
+ if (kdur > alloc_len) kdur = alloc_len;
+ for (n = 0; n < kdur; n++)
+ d[n] = read_sample(sf);
+ err = mus_file_write(ofd, 0, kdur - 1, 1, data);
+ if (err != MUS_NO_ERROR) break;
+ }
+ }
+ }
+ else
+ {
+ if (len <= REPORTING_SIZE)
+ {
+ for (i = 0; i < r->chans; i++)
+ samples_to_vct_with_reader(len, data[i], sfs[i]);
+ mus_file_write(ofd, 0, len - 1, r->chans, data);
+ }
+ else
{
- if (j <= r->lens[i])
+ int k;
+ for (i = 0; i < r->chans; i++)
+ sampler_set_safe(sfs[i], len);
+ for (k = 0; k < len; k += alloc_len)
{
- mus_sample_t curval;
- data[i][k] = read_sample_to_mus_sample(sfs[i]);
- curval = mus_sample_abs(data[i][k]);
- if (curval > val)
+ int err;
+ mus_long_t kdur;
+
+ kdur = len - k;
+ if (kdur > alloc_len) kdur = alloc_len;
+ for (i = 0; i < r->chans; i++)
{
- val = curval;
- max_position = j;
+ mus_long_t n;
+ snd_fd *p;
+ mus_float_t *buf;
+ buf = data[i];
+ p = sfs[i];
+ for (n = 0; n < kdur; n++)
+ buf[n] = read_sample(p);
}
+ err = mus_file_write(ofd, 0, kdur - 1, r->chans, data);
+ if (err != MUS_NO_ERROR) break;
}
- else data[i][k] = MUS_SAMPLE_0;
}
}
- if (k > 0)
- mus_file_write(ofd, 0, k - 1, r->chans, data);
+
close_temp_file(r->filename, ofd, hdr->type, len * r->chans * datumb);
- r->maxamp = MUS_SAMPLE_TO_FLOAT(val);
- r->maxamp_position = max_position;
for (i = 0; i < r->chans; i++) free(data[i]);
for (i = 0; i < r->chans; i++) free_snd_fd(sfs[i]);
free(sfs);
@@ -991,10 +1029,10 @@ void sequester_deferred_regions(chan_info *cp, int edit_top)
(drp->edpos[j] > edit_top))
{
if (r->lens[j] > 1000000)
- report_in_minibuffer(cp->sound, "sequestering region %d...", r->id);
+ status_report(cp->sound, "sequestering region %d...", r->id);
deferred_region_to_temp_file(r);
if (r->lens[j] > 1000000)
- clear_minibuffer(cp->sound);
+ clear_status_area(cp->sound);
break;
}
}
@@ -1011,7 +1049,7 @@ snd_fd *init_region_read(mus_long_t beg, int n, int chan, read_direction_t direc
{
if ((beg == 0) &&
(direction == READ_BACKWARD))
- beg = r->frames - 1;
+ beg = r->framples - 1;
if (r->use_temp_file == REGION_DEFERRED)
{
deferred_region *drp;
@@ -1082,30 +1120,32 @@ void save_regions(FILE *fd)
io_err = copy_file(r->filename, newname);
if (io_err != IO_NO_ERROR)
{
- snd_warning("trying to save region %d (%s) in %s: %s", r->id, r->filename, newname, io_error_name(io_err));
+ snd_warning("trying to save region %d (%s) in %s: %s, %s",
+ r->id, r->filename, newname, io_error_name(io_err),
+ strerror(ss->local_errno));
}
else
{
#if HAVE_RUBY
- fprintf(fd, "%s(%d, %d, " MUS_LD ", %d, %.4f, \"%s\", \"%s\", \"%s\", ",
- "restore_region", i, r->chans, r->frames, r->srate, r->maxamp, r->name, r->start, r->end);
- fprintf(fd, " \"%s\", [%d, " MUS_LD "])\n",
+ fprintf(fd, "%s(%d, %d, %lld, %d, %.4f, \"%s\", \"%s\", \"%s\", ",
+ "restore_region", i, r->chans, r->framples, r->srate, r->maxamp, r->name, r->start, r->end);
+ fprintf(fd, " \"%s\", [%d, %lld])\n",
newname,
(int)mus_sound_write_date(newname),
mus_sound_length(newname));
#endif
#if HAVE_SCHEME
- fprintf(fd, "(%s %d %d " MUS_LD " %d %.4f \"%s\" \"%s\" \"%s\"",
- S_restore_region, i, r->chans, r->frames, r->srate, r->maxamp, r->name, r->start, r->end);
- fprintf(fd, " \"%s\" (list %d " MUS_LD "))\n",
+ fprintf(fd, "(%s %d %d %lld %d %.4f \"%s\" \"%s\" \"%s\"",
+ S_restore_region, i, r->chans, r->framples, r->srate, r->maxamp, r->name, r->start, r->end);
+ fprintf(fd, " \"%s\" (list %d %lld))\n",
newname,
(int)mus_sound_write_date(newname),
mus_sound_length(newname));
#endif
#if HAVE_FORTH
- fprintf(fd, "%d %d " MUS_LD " %d %.4f \"%s\" \"%s\" \"%s\"",
- i, r->chans, r->frames, r->srate, r->maxamp, r->name, r->start, r->end);
- fprintf(fd, " \"%s\" '( %d " MUS_LD " ) %s drop\n",
+ fprintf(fd, "%d %d %lld %d %.4f \"%s\" \"%s\" \"%s\"",
+ i, r->chans, r->framples, r->srate, r->maxamp, r->name, r->start, r->end);
+ fprintf(fd, " \"%s\" '( %d %lld ) %s drop\n",
newname,
(int)mus_sound_write_date(newname),
mus_sound_length(newname),
@@ -1202,13 +1242,23 @@ void save_region_backpointer(snd_info *sp)
r->use_temp_file = REGION_FILE;
r->maxamp = 0.0;
r->maxamp_position = -1;
- r->frames = CURRENT_SAMPLES(sp->chans[0]);
+ r->framples = current_samples(sp->chans[0]);
for (i = 0; i < sp->nchans; i++)
{
mus_float_t val;
val = channel_maxamp(sp->chans[i], AT_CURRENT_EDIT_POSITION);
if (val > r->maxamp) r->maxamp = val;
+
+ if (r->lens[i] > PEAK_ENV_CUTOFF)
+ {
+ chan_info *cp;
+ cp = sp->chans[i];
+ if (r->peak_envs[i])
+ free_peak_env_info(r->peak_envs[i]);
+ /* if region file was edited, the peak_envs probably changed */
+ r->peak_envs[i] = copy_peak_env_info(cp->edits[0]->peak_env, false);
+ }
}
/* make new region temp file */
@@ -1229,7 +1279,7 @@ void save_region_backpointer(snd_info *sp)
}
-io_error_t save_region(int rg, const char *name, int type, int format, const char *comment)
+io_error_t save_region(int rg, const char *name, mus_sample_t samp_type, mus_header_t head_type, const char *comment)
{
region *r;
io_error_t io_err = IO_NO_ERROR;
@@ -1238,7 +1288,7 @@ io_error_t save_region(int rg, const char *name, int type, int format, const cha
if (r->use_temp_file == REGION_DEFERRED)
deferred_region_to_temp_file(r);
- io_err = snd_write_header(name, type, region_srate(rg), r->chans, r->chans * r->frames, format, comment, NULL);
+ io_err = snd_write_header(name, head_type, region_srate(rg), r->chans, r->chans * r->framples, samp_type, comment, NULL);
if (io_err == IO_NO_ERROR)
{
mus_long_t oloc;
@@ -1248,47 +1298,46 @@ io_error_t save_region(int rg, const char *name, int type, int format, const cha
ofd = snd_reopen_write(name);
if (ofd != -1)
{
- int ifd, ioff;
- snd_file_open_descriptors(ofd, name, format, oloc, r->chans, type);
+ int ifd;
+ snd_file_open_descriptors(ofd, name, samp_type, oloc, r->chans, head_type);
mus_file_set_clipping(ofd, clipping(ss));
lseek(ofd, oloc, SEEK_SET);
- /* copy r->filename with possible header/data format changes */
+ /* copy r->filename with possible header/sample type changes */
ifd = snd_open_read(r->filename);
if (ifd != -1)
{
- mus_long_t iloc, frames, cursamples;
- int chans, i, err = 0;
- mus_sample_t **bufs;
+ mus_long_t iloc, framples, cursamples;
+ int chans, i, err = 0, ioff;
+ mus_float_t **bufs;
chans = mus_sound_chans(r->filename);
- frames = mus_sound_samples(r->filename) / chans;
+ framples = mus_sound_samples(r->filename) / chans;
iloc = mus_sound_data_location(r->filename);
snd_file_open_descriptors(ifd,
r->filename,
- mus_sound_data_format(r->filename),
+ mus_sound_sample_type(r->filename),
iloc,
chans,
mus_sound_header_type(r->filename));
lseek(ifd, iloc, SEEK_SET);
+ bufs = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
+ for (i = 0; i < chans; i++) bufs[i] = (mus_float_t *)calloc(FILE_BUFFER_SIZE, sizeof(mus_float_t));
- bufs = (mus_sample_t **)calloc(chans, sizeof(mus_sample_t *));
- for (i = 0; i < chans; i++) bufs[i] = (mus_sample_t *)calloc(FILE_BUFFER_SIZE, sizeof(mus_sample_t));
-
- if (((frames * chans * mus_sound_datum_size(r->filename)) >> 10) > disk_kspace(name))
- snd_warning("not enough space to save region? -- need " MUS_LD " bytes",
- frames * chans * mus_sound_datum_size(r->filename));
+ if (((framples * chans * mus_sound_datum_size(r->filename)) >> 10) > disk_kspace(name))
+ snd_warning("not enough space to save region? -- need %lld bytes",
+ framples * chans * mus_sound_datum_size(r->filename));
err = 0;
- for (ioff = 0; ioff < frames; ioff += FILE_BUFFER_SIZE)
+ for (ioff = 0; ioff < framples; ioff += FILE_BUFFER_SIZE)
{
- if ((ioff + FILE_BUFFER_SIZE) < frames)
+ if ((ioff + FILE_BUFFER_SIZE) < framples)
cursamples = FILE_BUFFER_SIZE;
- else cursamples = (frames - ioff);
- mus_file_read(ifd, 0, cursamples - 1, chans, bufs);
+ else cursamples = (framples - ioff);
+ mus_file_read(ifd, ioff, cursamples, chans, bufs);
err = mus_file_write(ofd, 0, cursamples - 1, chans, bufs);
- if (err == -1)
+ if (err != MUS_NO_ERROR)
{
snd_warning("write error during %s", S_save_region);
break;
@@ -1301,16 +1350,22 @@ io_error_t save_region(int rg, const char *name, int type, int format, const cha
if (err != 0)
snd_warning("can't close %s input!", S_save_region);
err = mus_file_close(ofd);
- if (ss->fam_ok)
+
+ if (ss->file_monitor_ok)
{
if (err != 0)
snd_error("%s %d: %s %s", S_save_region, rg, r->filename, snd_io_strerror());
}
else
{
+#if USE_MOTIF
if (err == 0)
alert_new_file();
- else snd_error("%s %d: %s %s", S_save_region, rg, r->filename, snd_io_strerror());
+ else
+#else
+ if (err != 0)
+#endif
+ snd_error("%s %d: %s %s", S_save_region, rg, r->filename, snd_io_strerror());
}
}
else snd_error("%s %d: %s %s", S_save_region, rg, r->filename, snd_io_strerror());
@@ -1329,53 +1384,53 @@ typedef struct {
} xen_region;
-#define XEN_TO_XEN_REGION(arg) ((xen_region *)XEN_OBJECT_REF(arg))
+#define Xen_to_xen_region(arg) ((xen_region *)Xen_object_ref(arg))
-int xen_region_to_int(XEN n)
+int xen_region_to_int(Xen n)
{
xen_region *mx;
- mx = XEN_TO_XEN_REGION(n);
+ mx = Xen_to_xen_region(n);
return(mx->n);
}
-static XEN_OBJECT_TYPE xen_region_tag;
+static Xen_object_type_t xen_region_tag;
-bool xen_region_p(XEN obj)
+bool xen_is_region(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, xen_region_tag));
+ return(Xen_c_object_is_type(obj, xen_region_tag));
}
static void xen_region_free(xen_region *v) {if (v) free(v);}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(xen_region, free_xen_region, xen_region_free)
+Xen_wrap_free(xen_region, free_xen_region, xen_region_free)
static char *xen_region_to_string(xen_region *v)
{
- #define XEN_REGION_PRINT_BUFFER_SIZE 64
+ #define REGION_PRINT_BUFFER_SIZE 64
char *buf;
if (v == NULL) return(NULL);
- buf = (char *)calloc(XEN_REGION_PRINT_BUFFER_SIZE, sizeof(char));
- snprintf(buf, XEN_REGION_PRINT_BUFFER_SIZE, "#<region %d>", v->n);
+ buf = (char *)calloc(REGION_PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, REGION_PRINT_BUFFER_SIZE, "#<region %d>", v->n);
return(buf);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(xen_region, print_xen_region, xen_region_to_string)
+Xen_wrap_print(xen_region, print_xen_region, xen_region_to_string)
#if HAVE_FORTH || HAVE_RUBY
-static XEN g_xen_region_to_string(XEN obj)
+static Xen g_xen_region_to_string(Xen obj)
{
char *vstr;
- XEN result;
+ Xen result;
#define S_xen_region_to_string "region->string"
- XEN_ASSERT_TYPE(XEN_REGION_P(obj), obj, XEN_ONLY_ARG, S_xen_region_to_string, "a region");
+ Xen_check_type(xen_is_region(obj), obj, 1, S_xen_region_to_string, "a region");
- vstr = xen_region_to_string(XEN_TO_XEN_REGION(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = xen_region_to_string(Xen_to_xen_region(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
@@ -1389,10 +1444,10 @@ static bool xen_region_equalp(xen_region *v1, xen_region *v2)
(v1->n == v2->n));
}
-static XEN equalp_xen_region(XEN obj1, XEN obj2)
+static Xen equalp_xen_region(Xen obj1, Xen obj2)
{
- if ((!(XEN_REGION_P(obj1))) || (!(XEN_REGION_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(xen_region_equalp(XEN_TO_XEN_REGION(obj1), XEN_TO_XEN_REGION(obj2))));
+ if ((!(xen_is_region(obj1))) || (!(xen_is_region(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(xen_region_equalp(Xen_to_xen_region(obj1), Xen_to_xen_region(obj2))));
}
#endif
@@ -1406,14 +1461,14 @@ static xen_region *xen_region_make(int n)
}
-XEN new_xen_region(int n)
+Xen new_xen_region(int n)
{
xen_region *mx;
if (n < 0)
- return(XEN_FALSE);
+ return(Xen_false);
mx = xen_region_make(n);
- XEN_MAKE_AND_RETURN_OBJECT(xen_region_tag, mx, 0, free_xen_region);
+ return(Xen_make_object(xen_region_tag, mx, 0, free_xen_region));
}
@@ -1424,9 +1479,9 @@ static bool s7_xen_region_equalp(void *obj1, void *obj2)
(((xen_region *)obj1)->n == ((xen_region *)obj2)->n));
}
-static XEN s7_xen_region_length(s7_scheme *sc, XEN obj)
+static Xen s7_xen_region_length(s7_scheme *sc, Xen obj)
{
- return(g_region_frames(obj, XEN_ZERO));
+ return(g_region_framples(obj, Xen_integer_zero));
}
#endif
@@ -1434,12 +1489,12 @@ static XEN s7_xen_region_length(s7_scheme *sc, XEN obj)
static void init_xen_region(void)
{
#if HAVE_SCHEME
- xen_region_tag = XEN_MAKE_OBJECT_TYPE("<region>", print_xen_region, free_xen_region, s7_xen_region_equalp, NULL, NULL, NULL, s7_xen_region_length, NULL, NULL);
+ xen_region_tag = s7_new_type_x(s7, "<region>", print_xen_region, free_xen_region, s7_xen_region_equalp, NULL, NULL, NULL, s7_xen_region_length, NULL, NULL, NULL);
#else
#if HAVE_RUBY
- xen_region_tag = XEN_MAKE_OBJECT_TYPE("XenRegion", sizeof(xen_region));
+ xen_region_tag = Xen_make_object_type("XenRegion", sizeof(xen_region));
#else
- xen_region_tag = XEN_MAKE_OBJECT_TYPE("Region", sizeof(xen_region));
+ xen_region_tag = Xen_make_object_type("Region", sizeof(xen_region));
#endif
#endif
@@ -1451,86 +1506,118 @@ static void init_xen_region(void)
#endif
#if HAVE_RUBY
- rb_define_method(xen_region_tag, "to_s", XEN_PROCEDURE_CAST print_xen_region, 0);
- rb_define_method(xen_region_tag, "eql?", XEN_PROCEDURE_CAST equalp_xen_region, 1);
- rb_define_method(xen_region_tag, "==", XEN_PROCEDURE_CAST equalp_xen_region, 1);
- rb_define_method(xen_region_tag, "to_str", XEN_PROCEDURE_CAST g_xen_region_to_string, 0);
+ rb_define_method(xen_region_tag, "to_s", Xen_procedure_cast print_xen_region, 0);
+ rb_define_method(xen_region_tag, "eql?", Xen_procedure_cast equalp_xen_region, 1);
+ rb_define_method(xen_region_tag, "==", Xen_procedure_cast equalp_xen_region, 1);
+ rb_define_method(xen_region_tag, "to_str", Xen_procedure_cast g_xen_region_to_string, 0);
#endif
}
/* -------------------------------------------------------------------------------- */
-static XEN g_integer_to_region(XEN n)
+static Xen g_integer_to_region(Xen n)
{
#define H_integer_to_region "(" S_integer_to_region " n) returns a region object corresponding to the given integer"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n), n, XEN_ONLY_ARG, S_integer_to_region, "an integer");
- return(new_xen_region(XEN_TO_C_INT(n)));
+ Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_region, "an integer");
+ return(new_xen_region(Xen_integer_to_C_int(n)));
}
-static XEN g_region_to_integer(XEN n)
+static Xen g_region_to_integer(Xen n)
{
#define H_region_to_integer "(" S_region_to_integer " id) returns the integer corresponding to the given region"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ONLY_ARG, S_region_to_integer, "a region");
- return(C_TO_XEN_INT(xen_region_to_int(n)));
+ Xen_check_type(xen_is_region(n), n, 1, S_region_to_integer, "a region");
+ return(C_int_to_Xen_integer(xen_region_to_int(n)));
}
-static XEN snd_no_such_region_error(const char *caller, XEN n)
+static Xen snd_no_such_region_error(const char *caller, Xen n)
{
- XEN_ERROR(XEN_ERROR_TYPE("no-such-region"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such region, ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("no-such-region"),
+ Xen_list_3(C_string_to_Xen_string("~A: no such region, ~A"),
+ C_string_to_Xen_string(caller),
n));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_restore_region(XEN pos, XEN chans, XEN len, XEN srate, XEN maxamp, XEN name, XEN start, XEN end, XEN filename, XEN date)
+/* Xen pos, Xen chans, Xen len, Xen srate, Xen maxamp, Xen name, Xen start, Xen end, Xen filename, Xen date */
+
+static Xen g_restore_region(Xen args)
{
/* internal function used by save-state mechanism -- not intended for external use */
region *r;
int regn;
+ Xen arg, pos, chans, len, srate, maxamp, name, start, end, filename, date;
+
+ arg = args;
+ pos = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(pos), pos, 1, S_restore_region, "a region id");
+
+ arg = Xen_cdr(arg);
+ chans = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(chans), chans, 2, S_restore_region, "an integer");
+
+ arg = Xen_cdr(arg);
+ len = Xen_car(arg);
+ Xen_check_type(Xen_is_number(len), len, 3, S_restore_region, "an integer");
+
+ arg = Xen_cdr(arg);
+ srate = Xen_car(arg);
+ Xen_check_type(Xen_is_integer(srate), srate, 4, S_restore_region, "an integer");
+
+ arg = Xen_cdr(arg);
+ maxamp = Xen_car(arg);
+ Xen_check_type(Xen_is_double(maxamp), maxamp, 5, S_restore_region, "a double");
+
+ arg = Xen_cdr(arg);
+ name = Xen_car(arg);
+ Xen_check_type(Xen_is_string(name), name, 6, S_restore_region, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(pos), pos, XEN_ARG_1, S_restore_region, "a region id");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chans), chans, XEN_ARG_2, S_restore_region, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(len), len, XEN_ARG_3, S_restore_region, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(srate), srate, XEN_ARG_4, S_restore_region, "an integer");
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(maxamp), maxamp, XEN_ARG_5, S_restore_region, "a double");
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_6, S_restore_region, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(start), start, XEN_ARG_7, S_restore_region, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(end), end, XEN_ARG_8, S_restore_region, "a string");
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ARG_9, S_restore_region, "a string");
- XEN_ASSERT_TYPE(XEN_LIST_P(date) && (XEN_LIST_LENGTH(date) == 2), date, XEN_ARG_10, S_restore_region, "a list: '(time bytes)");
+ arg = Xen_cdr(arg);
+ start = Xen_car(arg);
+ Xen_check_type(Xen_is_string(start), start, 7, S_restore_region, "a string");
+
+ arg = Xen_cdr(arg);
+ end = Xen_car(arg);
+ Xen_check_type(Xen_is_string(end), end, 8, S_restore_region, "a string");
+
+ arg = Xen_cdr(arg);
+ filename = Xen_car(arg);
+ Xen_check_type(Xen_is_string(filename), filename, 9, S_restore_region, "a string");
+
+ arg = Xen_cdr(arg);
+ date = Xen_car(arg);
+ Xen_check_type(Xen_is_list(date) && (Xen_list_length(date) == 2), date, 10, S_restore_region, "a list: '(time bytes)");
check_saved_temp_file("region", filename, date);
r = (region *)calloc(1, sizeof(region));
- regn = XEN_TO_C_INT(pos);
+ regn = Xen_integer_to_C_int(pos);
if (regions[regn]) free_region(regions[regn], COMPLETE_DELETION);
regions[regn] = r;
r->id = region_id_ctr++;
- r->maxamp = XEN_TO_C_DOUBLE(maxamp);
+ r->maxamp = Xen_real_to_C_double(maxamp);
r->maxamp_position = -1; /* not saved/restored */
- r->chans = XEN_TO_C_INT(chans);
+ r->chans = Xen_integer_to_C_int(chans);
r->rsp = NULL;
r->editor_copy = NULL;
r->editor_name = NULL;
- r->frames = XEN_TO_C_INT64_T(len);
- r->srate = XEN_TO_C_INT(srate);
- r->name = mus_strdup(XEN_TO_C_STRING(name));
- r->start = mus_strdup(XEN_TO_C_STRING(start));
- r->end = mus_strdup(XEN_TO_C_STRING(end));
+ r->framples = Xen_llong_to_C_llong(len);
+ r->srate = Xen_integer_to_C_int(srate);
+ r->name = mus_strdup(Xen_string_to_C_string(name));
+ r->start = mus_strdup(Xen_string_to_C_string(start));
+ r->end = mus_strdup(Xen_string_to_C_string(end));
r->use_temp_file = REGION_FILE;
- r->filename = mus_strdup(XEN_TO_C_STRING(filename));
+ r->filename = mus_strdup(Xen_string_to_C_string(filename));
reflect_regions_in_region_browser();
- return(C_TO_XEN_INT(r->id));
+ return(C_int_to_Xen_integer(r->id));
}
-static XEN g_insert_region(XEN reg_n, XEN samp_n, XEN snd_n, XEN chn_n) /* opt reg_n */
+static Xen g_insert_region(Xen reg_n, Xen samp_n, Xen snd_n, Xen chn_n) /* opt reg_n */
{
#define H_insert_region "(" S_insert_region " region :optional (start-samp 0) snd chn): \
insert region data into snd's channel chn starting at start-samp"
@@ -1540,189 +1627,189 @@ insert region data into snd's channel chn starting at start-samp"
mus_long_t samp;
io_error_t err = IO_NO_ERROR;
- XEN_ASSERT_TYPE(XEN_REGION_P(reg_n), reg_n, XEN_ARG_1, S_insert_region, "a region id");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(samp_n), samp_n, XEN_ARG_2, S_insert_region, "a number");
+ Xen_check_type(xen_is_region(reg_n), reg_n, 1, S_insert_region, "a region id");
+ Xen_check_type(Xen_is_integer_or_unbound(samp_n), samp_n, 2, S_insert_region, "an integer");
- ASSERT_CHANNEL(S_insert_region, snd_n, chn_n, 3);
+ Snd_assert_channel(S_insert_region, snd_n, chn_n, 3);
cp = get_cp(snd_n, chn_n, S_insert_region);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- rg = XEN_REGION_TO_C_INT(reg_n);
+ rg = Xen_region_to_C_int(reg_n);
if (!(region_ok(rg)))
return(snd_no_such_region_error(S_insert_region, reg_n));
samp = beg_to_sample(samp_n, S_insert_region);
err = paste_region_2(rg, cp, false, samp);
- if (SERIOUS_IO_ERROR(err))
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_3(C_TO_XEN_STRING(S_insert_region ": can't edit ~A (region access problem?), ~A"),
- C_TO_XEN_STRING(cp->sound->filename),
- C_TO_XEN_STRING(io_error_name(err))));
+ if (is_serious_io_error(err))
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_3(C_string_to_Xen_string(S_insert_region ": can't edit ~A (region access problem?), ~A"),
+ C_string_to_Xen_string(cp->sound->filename),
+ C_string_to_Xen_string(io_error_name(err))));
update_graph(cp);
return(reg_n);
}
-static XEN g_max_regions(void)
+static Xen g_max_regions(void)
{
#define H_max_regions "(" S_max_regions "): max number of regions saved on the region list"
- return(C_TO_XEN_INT(max_regions(ss)));
+ return(C_int_to_Xen_integer(max_regions(ss)));
}
-static XEN g_set_max_regions(XEN n)
+static Xen g_set_max_regions(Xen n)
{
int regs;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n), n, XEN_ONLY_ARG, S_setB S_max_regions, "an integer");
+ Xen_check_type(Xen_is_integer(n), n, 1, S_set S_max_regions, "an integer");
- regs = XEN_TO_C_INT(n);
+ regs = Xen_integer_to_C_int(n);
if (regs < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_max_regions, 1, n, S_max_regions " ~A < 0?");
+ Xen_out_of_range_error(S_set S_max_regions, 1, n, S_max_regions "negative?");
set_max_regions(regs);
- return(C_TO_XEN_INT(max_regions(ss)));
+ return(C_int_to_Xen_integer(max_regions(ss)));
}
-static XEN g_region_p(XEN n)
+static Xen g_is_region(Xen n)
{
- #define H_region_p "(" S_region_p " reg): " PROC_TRUE " if region is active"
- return(C_TO_XEN_BOOLEAN((XEN_REGION_P(n)) && (region_ok(XEN_REGION_TO_C_INT(n)))));
+ #define H_is_region "(" S_is_region " reg): " PROC_TRUE " if region is active"
+ return(C_bool_to_Xen_boolean((xen_is_region(n)) && (region_ok(Xen_region_to_C_int(n)))));
}
-XEN g_region_frames(XEN n, XEN chan)
+Xen g_region_framples(Xen n, Xen chan)
{
region *r;
int rg, chn;
- #define H_region_frames "(" S_region_frames " reg :optional (chan 0)): region length in frames"
+ #define H_region_framples "(" S_region_framples " reg :optional (chan 0)): region length in framples"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ARG_1, S_region_frames, "a region");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chan), chan, XEN_ARG_2, S_region_frames, "an integer");
+ Xen_check_type(xen_is_region(n), n, 1, S_region_framples, "a region");
+ Xen_check_type(Xen_is_integer_or_unbound(chan), chan, 2, S_region_framples, "an integer");
- rg = XEN_REGION_TO_C_INT(n);
+ rg = Xen_region_to_C_int(n);
if (!(region_ok(rg)))
- return(snd_no_such_region_error(S_region_frames, n));
+ return(snd_no_such_region_error(S_region_framples, n));
- if (XEN_NOT_BOUND_P(chan))
- return(C_TO_XEN_INT64_T(region_len(rg)));
- chn = XEN_TO_C_INT(chan);
+ if (!Xen_is_bound(chan))
+ return(C_llong_to_Xen_llong(region_len(rg)));
+ chn = Xen_integer_to_C_int(chan);
if ((chn < 0) || (chn >= region_chans(rg)))
- return(snd_no_such_channel_error(S_region_frames, XEN_LIST_1(n), chan));
+ return(snd_no_such_channel_error(S_region_framples, Xen_list_1(n), chan));
r = id_to_region(rg);
- return(C_TO_XEN_INT64_T(r->lens[chn] + 1));
+ return(C_llong_to_Xen_llong(r->lens[chn] + 1));
}
-static XEN g_region_position(XEN n, XEN chan)
+static Xen g_region_position(Xen n, Xen chan)
{
region *r;
- int rg, chn;
+ int rg, chn = 0;
#define H_region_position "(" S_region_position " reg :optional (chan 0)): region's position in the original sound"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ARG_1, S_region_position, "a region");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chan), chan, XEN_ARG_2, S_region_position, "an integer");
+ Xen_check_type(xen_is_region(n), n, 1, S_region_position, "a region");
+ Xen_check_type(Xen_is_integer_or_unbound(chan), chan, 2, S_region_position, "an integer");
- rg = XEN_REGION_TO_C_INT(n);
+ rg = Xen_region_to_C_int(n);
if (!(region_ok(rg)))
return(snd_no_such_region_error(S_region_position, n));
- chn = XEN_TO_C_INT_OR_ELSE(chan, 0);
+ if (Xen_is_integer(chan)) chn = Xen_integer_to_C_int(chan);
if ((chn < 0) || (chn >= region_chans(rg)))
- return(snd_no_such_channel_error(S_region_position, XEN_LIST_1(n), chan));
+ return(snd_no_such_channel_error(S_region_position, Xen_list_1(n), chan));
r = id_to_region(rg);
- return(C_TO_XEN_INT64_T(r->begs[chn]));
+ return(C_llong_to_Xen_llong(r->begs[chn]));
}
typedef enum {REGION_SRATE, REGION_CHANS, REGION_MAXAMP, REGION_FORGET, REGION_MAXAMP_POSITION, REGION_HOME} region_field_t;
-static XEN region_get(region_field_t field, XEN n, const char *caller)
+static Xen region_get(region_field_t field, Xen n, const char *caller)
{
int rg;
- rg = XEN_REGION_TO_C_INT(n);
+ rg = Xen_region_to_C_int(n);
if (!(region_ok(rg)))
return(snd_no_such_region_error(caller, n));
switch (field)
{
- case REGION_SRATE: return(C_TO_XEN_INT(region_srate(rg))); break;
- case REGION_CHANS: return(C_TO_XEN_INT(region_chans(rg))); break;
- case REGION_MAXAMP: return(C_TO_XEN_DOUBLE(region_maxamp(rg))); break;
- case REGION_MAXAMP_POSITION: return(C_TO_XEN_INT64_T(region_maxamp_position(rg))); break;
+ case REGION_SRATE: return(C_int_to_Xen_integer(region_srate(rg))); break;
+ case REGION_CHANS: return(C_int_to_Xen_integer(region_chans(rg))); break;
+ case REGION_MAXAMP: return(C_double_to_Xen_real(region_maxamp(rg))); break;
+ case REGION_MAXAMP_POSITION: return(C_llong_to_Xen_llong(region_maxamp_position(rg))); break;
case REGION_FORGET: delete_region_and_update_browser(region_id_to_list_position(rg)); return(n); break;
case REGION_HOME:
{
region *r;
r = id_to_region(rg);
if (r)
- return(XEN_LIST_3(C_TO_XEN_STRING(r->name),
- C_TO_XEN_INT64_T(r->begs[0]),
- C_TO_XEN_INT64_T(r->lens[0])));
+ return(Xen_list_3(C_string_to_Xen_string(r->name),
+ C_llong_to_Xen_llong(r->begs[0]),
+ C_llong_to_Xen_llong(r->lens[0])));
}
break;
default: break;
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-XEN g_region_srate(XEN n)
+Xen g_region_srate(Xen n)
{
#define H_region_srate "(" S_region_srate " reg): region (nominal) srate"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ONLY_ARG, S_region_srate, "a region");
+ Xen_check_type(xen_is_region(n), n, 1, S_region_srate, "a region");
return(region_get(REGION_SRATE, n, S_region_srate));
}
-XEN g_region_chans(XEN n)
+Xen g_region_chans(Xen n)
{
#define H_region_chans "(" S_region_chans " reg): region channels"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ONLY_ARG, S_region_chans, "a region");
+ Xen_check_type(xen_is_region(n), n, 1, S_region_chans, "a region");
return(region_get(REGION_CHANS, n, S_region_chans));
}
-static XEN g_region_home(XEN n)
+static Xen g_region_home(Xen n)
{
#define H_region_home "(" S_region_home " reg): a list with the region source sound name and position info"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ONLY_ARG, S_region_home, "a region");
+ Xen_check_type(xen_is_region(n), n, 1, S_region_home, "a region");
return(region_get(REGION_HOME, n, S_region_home));
}
-XEN g_region_maxamp(XEN n)
+Xen g_region_maxamp(Xen n)
{
#define H_region_maxamp "(" S_region_maxamp " reg): region maxamp"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ONLY_ARG, S_region_maxamp, "a region");
+ Xen_check_type(xen_is_region(n), n, 1, S_region_maxamp, "a region");
return(region_get(REGION_MAXAMP, n, S_region_maxamp));
}
-static XEN g_region_maxamp_position(XEN n)
+static Xen g_region_maxamp_position(Xen n)
{
#define H_region_maxamp_position "(" S_region_maxamp_position " reg): first sample where region maxamp occurs"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ONLY_ARG, S_region_maxamp_position, "a region");
+ Xen_check_type(xen_is_region(n), n, 1, S_region_maxamp_position, "a region");
return(region_get(REGION_MAXAMP_POSITION, n, S_region_maxamp_position));
}
-static XEN g_forget_region(XEN n)
+static Xen g_forget_region(Xen n)
{
#define H_forget_region "(" S_forget_region " reg): remove region from the region list"
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ONLY_ARG, S_forget_region, "a region");
+ Xen_check_type(xen_is_region(n), n, 1, S_forget_region, "a region");
return(region_get(REGION_FORGET, n, S_forget_region));
}
-XEN g_play_region(XEN n, play_process_t back, XEN stop_proc)
+Xen g_play_region(Xen n, play_process_t back, Xen stop_proc)
{
int rg;
region *r;
- rg = XEN_REGION_TO_C_INT(n);
+ rg = Xen_region_to_C_int(n);
r = id_to_region(rg);
if (r)
{
@@ -1734,49 +1821,50 @@ XEN g_play_region(XEN n, play_process_t back, XEN stop_proc)
}
-static XEN g_regions(void)
+static Xen g_regions(void)
{
#define H_regions "(" S_regions "): current active regions (a list of region ids)"
int i;
- XEN result;
- result = XEN_EMPTY_LIST;
+ Xen result;
+ result = Xen_empty_list;
for (i = (regions_size - 1); i >= 0; i--)
if (regions[i])
- result = XEN_CONS(C_INT_TO_XEN_REGION(regions[i]->id), result);
+ result = Xen_cons(C_int_to_Xen_region(regions[i]->id), result);
return(result);
}
-static XEN g_make_region(XEN beg, XEN end, XEN snd_n, XEN chn_n)
+static Xen g_make_region(Xen beg, Xen end, Xen snd_n, Xen chn_n)
{
#define H_make_region "(" S_make_region " :optional beg end snd chn): make a new region between beg and end in snd. \
If chn is " PROC_TRUE ", all chans are included, taking the snd sync field into account if it's not 0. If no args are passed, the current \
selection is used."
- int id = INVALID_REGION, old_sync, i;
+ int id = INVALID_REGION;
- if (max_regions(ss) <= 0) return(XEN_FALSE);
- if (XEN_NOT_BOUND_P(beg))
+ if (max_regions(ss) <= 0) return(Xen_false);
+ if (!Xen_is_bound(beg))
id = make_region_from_selection();
else
{
- chan_info *cp;
sync_info *si = NULL;
snd_info *sp;
mus_long_t ibeg, iend;
mus_long_t *ends = NULL;
+ int i;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(beg), beg, XEN_ARG_1, S_make_region, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(end), end, XEN_ARG_2, S_make_region, "a number");
+ Xen_check_type(Xen_is_integer(beg), beg, 1, S_make_region, "an integer");
+ Xen_check_type(Xen_is_integer(end), end, 2, S_make_region, "an integer");
ibeg = beg_to_sample(beg, S_make_region);
iend = beg_to_sample(end, S_make_region);
- if (XEN_TRUE_P(chn_n))
+ if (Xen_is_true(chn_n))
{
/* all chans and all sync'd chans if sync not 0 */
sp = get_sp(snd_n);
if (sp)
{
+ int old_sync;
old_sync = sp->sync;
if (sp->sync == 0)
{
@@ -1791,6 +1879,7 @@ selection is used."
}
else
{
+ chan_info *cp;
cp = get_cp(snd_n, chn_n, S_make_region);
si = make_simple_sync(cp, ibeg);
}
@@ -1798,8 +1887,8 @@ selection is used."
ends = (mus_long_t *)calloc(si->chans, sizeof(mus_long_t));
for (i = 0; i < si->chans; i++)
{
- if (CURRENT_SAMPLES(si->cps[i]) - 1 < iend)
- ends[i] = CURRENT_SAMPLES(si->cps[i]) - 1;
+ if (current_samples(si->cps[i]) - 1 < iend)
+ ends[i] = current_samples(si->cps[i]) - 1;
else ends[i] = iend;
si->begs[i] = ibeg;
if (ends[i] < ibeg)
@@ -1807,7 +1896,7 @@ selection is used."
free(ends);
ends = NULL;
si = free_sync_info(si);
- XEN_OUT_OF_RANGE_ERROR(S_make_region, 1, end, "end ~A < beg?");
+ Xen_out_of_range_error(S_make_region, 1, end, "end < beg?");
}
}
if (ends)
@@ -1819,52 +1908,54 @@ selection is used."
free(ends);
}
}
- return(C_INT_TO_XEN_REGION(id));
+ return(C_int_to_Xen_region(id));
}
-static XEN kw_header_type, kw_data_format, kw_comment, kw_file;
+static Xen kw_header_type, kw_comment, kw_file, kw_sample_type;
static void init_region_keywords(void)
{
- kw_header_type = XEN_MAKE_KEYWORD("header-type");
- kw_data_format = XEN_MAKE_KEYWORD("data-format");
- kw_comment = XEN_MAKE_KEYWORD("comment");
- kw_file = XEN_MAKE_KEYWORD("file");
+ kw_header_type = Xen_make_keyword("header-type");
+ kw_sample_type = Xen_make_keyword("sample-type");
+ kw_comment = Xen_make_keyword("comment");
+ kw_file = Xen_make_keyword("file");
}
static void save_region_to_xen_error(const char *msg, void *data)
{
redirect_snd_error_to(NULL, NULL);
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_save_region ": can't save ~S"),
- C_TO_XEN_STRING(msg)));
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_save_region ": can't save ~S"),
+ C_string_to_Xen_string(msg)));
}
-static XEN g_save_region(XEN n, XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+static Xen g_save_region(Xen n, Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
- #define H_save_region "(" S_save_region " region :file :header-type :data-format :comment): save region in file \
-using data format (default depends on machine byte order), header type (" S_mus_next "), and comment"
+ #define H_save_region "(" S_save_region " region file sample-type header-type comment): save region in file \
+using sample-type (default depends on machine byte order), header-type (" S_mus_next "), and comment"
char *name = NULL;
- const char *file = NULL, *com = NULL;
- int rg, data_format = MUS_OUT_FORMAT, header_type = MUS_NEXT;
- XEN args[8];
- XEN keys[4];
+ const char *file = NULL, *com = NULL;
+ int rg;
+ mus_sample_t sample_type = MUS_OUT_SAMPLE_TYPE;
+ mus_header_t header_type = MUS_NEXT;
+ Xen args[8];
+ Xen keys[4];
int orig_arg[4] = {0, 0, 0, 0};
int vals;
keys[0] = kw_file;
- keys[1] = kw_header_type;
- keys[2] = kw_data_format;
+ keys[1] = kw_sample_type;
+ keys[2] = kw_header_type;
keys[3] = kw_comment;
args[0] = arg1; args[1] = arg2; args[2] = arg3; args[3] = arg4; args[4] = arg5; args[5] = arg6; args[6] = arg7; args[7] = arg8;
- XEN_ASSERT_TYPE(XEN_REGION_P(n), n, XEN_ARG_1, S_save_region, "a region id");
+ Xen_check_type(xen_is_region(n), n, 1, S_save_region, "a region id");
- rg = XEN_REGION_TO_C_INT(n);
+ rg = Xen_region_to_C_int(n);
if (!(region_ok(rg)))
return(snd_no_such_region_error(S_save_region, n));
@@ -1872,31 +1963,31 @@ using data format (default depends on machine byte order), header type (" S_mus_
if (vals > 0)
{
file = mus_optkey_to_string(keys[0], S_save_region, orig_arg[0], NULL);
- header_type = mus_optkey_to_int(keys[1], S_save_region, orig_arg[1], header_type);
- data_format = mus_optkey_to_int(keys[2], S_save_region, orig_arg[2], data_format);
+ sample_type = (mus_sample_t)mus_optkey_to_int(keys[1], S_save_region, orig_arg[1], (int)sample_type);
+ header_type = (mus_header_t)mus_optkey_to_int(keys[2], S_save_region, orig_arg[2], (int)header_type);
com = mus_optkey_to_string(keys[3], S_save_region, orig_arg[3], NULL);
}
if (file == NULL)
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_1(C_TO_XEN_STRING(S_save_region ": no output file?")));
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_1(C_string_to_Xen_string(S_save_region ": no output file?")));
name = mus_expand_filename(file);
- if (!(mus_header_writable(header_type, data_format)))
+ if (!(mus_header_writable(header_type, sample_type)))
{
- if (mus_header_writable(MUS_NEXT, data_format))
+ if (mus_header_writable(MUS_NEXT, sample_type))
header_type = MUS_NEXT;
else
{
- if (mus_header_writable(MUS_RIFF, data_format))
+ if (mus_header_writable(MUS_RIFF, sample_type))
header_type = MUS_RIFF;
else header_type = MUS_RAW;
}
}
redirect_snd_error_to(save_region_to_xen_error, NULL); /* could perhaps pass name here for free in case of error */
- save_region(rg, name, header_type, data_format, com);
+ save_region(rg, name, sample_type, header_type, com);
redirect_snd_error_to(NULL, NULL);
if (name) free(name);
@@ -1904,9 +1995,9 @@ using data format (default depends on machine byte order), header type (" S_mus_
}
-static XEN g_mix_region(XEN reg_n, XEN chn_samp_n, XEN snd_n, XEN chn_n, XEN reg_chn)
+static Xen g_mix_region(Xen reg_n, Xen chn_samp_n, Xen snd_n, Xen chn_n, Xen reg_chn)
{
- #define H_mix_region "(" S_mix_region " region :optional (chn-samp 0) snd chn (region-chan #t)): \
+ #define H_mix_region "(" S_mix_region " region :optional (chn-samp 0) snd chn (region-chan " PROC_TRUE ")): \
mix region's channel region-chan (or all chans if region-chan is " PROC_TRUE ") into snd's channel chn starting at chn-samp; \
it returns a list of the new mixes"
@@ -1914,105 +2005,110 @@ it returns a list of the new mixes"
mus_long_t samp;
io_error_t err = IO_NO_ERROR;
int i, rg, id = -1, reg_chan = 0, reg_chans = 0;
- XEN result = XEN_EMPTY_LIST;
+ Xen result = Xen_empty_list;
- XEN_ASSERT_TYPE(XEN_REGION_P(reg_n), reg_n, XEN_ARG_1, S_mix_region, "a region");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(chn_samp_n), chn_samp_n, XEN_ARG_2, S_mix_region, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(reg_chn), reg_chn, XEN_ARG_5, S_mix_region, "an integer or " PROC_TRUE);
- ASSERT_CHANNEL(S_mix_region, snd_n, chn_n, 3);
+ Xen_check_type(xen_is_region(reg_n), reg_n, 1, S_mix_region, "a region");
+ Xen_check_type(Xen_is_integer_or_unbound(chn_samp_n), chn_samp_n, 2, S_mix_region, "an integer");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(reg_chn), reg_chn, 5, S_mix_region, "an integer or " PROC_TRUE);
+ Snd_assert_channel(S_mix_region, snd_n, chn_n, 3);
- rg = XEN_REGION_TO_C_INT(reg_n);
+ rg = Xen_region_to_C_int(reg_n);
if (!(region_ok(rg)))
return(snd_no_such_region_error(S_mix_region, reg_n));
cp = get_cp(snd_n, chn_n, S_mix_region);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- if (XEN_BOUND_P(chn_samp_n))
+ if (Xen_is_bound(chn_samp_n))
samp = beg_to_sample(chn_samp_n, S_mix_region);
- else samp = CURSOR(cp);
+ else samp = cursor_sample(cp);
- if (XEN_INTEGER_P(reg_chn))
- reg_chan = XEN_TO_C_INT(reg_chn);
+ if (Xen_is_integer(reg_chn))
+ reg_chan = Xen_integer_to_C_int(reg_chn);
id = paste_region_1(rg, cp, true, samp, &err, reg_chan, ®_chans);
/* id might legitmately be invalid mix id if with_mix_tags is #f or virtual mix not ok */
- if (SERIOUS_IO_ERROR(err))
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_mix_region ": can't edit, ~A"),
- C_TO_XEN_STRING(io_error_name(err))));
+ if (is_serious_io_error(err))
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_2(C_string_to_Xen_string(S_mix_region ": can't edit, ~A"),
+ C_string_to_Xen_string(io_error_name(err))));
- if (id == -1) return(XEN_FALSE);
+ if (id == -1) return(Xen_false);
for (i = 0; i < reg_chans; i++)
- result = XEN_CONS(new_xen_mix(id + i), result);
+ result = Xen_cons(new_xen_mix(id + i), result);
- return(XEN_LIST_REVERSE(result));
+ return(Xen_list_reverse(result));
}
-static XEN g_region_sample(XEN reg_n, XEN samp_n, XEN chn_n)
+static Xen g_region_sample(Xen reg_n, Xen samp_n, Xen chn_n)
{
#define H_region_sample "(" S_region_sample " region samp :optional (chan 0)): region's sample at samp in chan"
- int rg, chan;
+ int rg, chan = 0;
mus_long_t samp;
- XEN_ASSERT_TYPE(XEN_REGION_P(reg_n), reg_n, XEN_ARG_1, S_region_sample, "a region");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp_n), samp_n, XEN_ARG_2, S_region_sample, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chn_n), chn_n, XEN_ARG_3, S_region_sample, "an integer");
+ Xen_check_type(xen_is_region(reg_n), reg_n, 1, S_region_sample, "a region");
+ Xen_check_type(Xen_is_integer(samp_n), samp_n, 2, S_region_sample, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(chn_n), chn_n, 3, S_region_sample, "an integer");
- chan = XEN_TO_C_INT_OR_ELSE(chn_n, 0);
- rg = XEN_REGION_TO_C_INT(reg_n);
+ if (Xen_is_integer(chn_n)) chan = Xen_integer_to_C_int(chn_n);
+ rg = Xen_region_to_C_int(reg_n);
if (!(region_ok(rg)))
return(snd_no_such_region_error(S_region_sample, reg_n));
samp = beg_to_sample(samp_n, S_region_sample);
if ((chan >= 0) && (chan < region_chans(rg)))
- return(C_TO_XEN_DOUBLE(region_sample(rg, chan, samp)));
- return(snd_no_such_channel_error(S_region_sample, XEN_LIST_1(reg_n), chn_n));
+ return(C_double_to_Xen_real(region_sample(rg, chan, samp)));
+ return(snd_no_such_channel_error(S_region_sample, Xen_list_1(reg_n), chn_n));
}
-static XEN g_region_to_vct(XEN reg_n, XEN beg_n, XEN num, XEN chn_n, XEN v)
+Xen g_region_to_vct(Xen reg_n, Xen beg_n, Xen num, Xen chn_n, Xen v)
{
#define H_region_to_vct "(" S_region_to_vct " region :optional (beg 0) samps (chan 0) v): \
-write region's samples starting at beg for samps in channel chan to vct v; return v (or create a new one)"
+write region's samples starting at beg for samps in channel chan to " S_vct " v; return v (or create a new one)"
- mus_float_t *data;
- int reg, chn;
- mus_long_t len;
+ int reg, chn = 0;
+ mus_long_t len = 0;
vct *v1 = xen_to_vct(v);
- XEN_ASSERT_TYPE(XEN_REGION_P(reg_n), reg_n, XEN_ARG_1, S_region_to_vct, "a region");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(beg_n), beg_n, XEN_ARG_2, S_region_to_vct, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(num), num, XEN_ARG_3, S_region_to_vct, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chn_n), chn_n, XEN_ARG_4, S_region_to_vct, "an integer");
+ Xen_check_type(xen_is_region(reg_n), reg_n, 1, S_region_to_vct, "a region");
+ Xen_check_type(Xen_is_integer_or_unbound(beg_n), beg_n, 2, S_region_to_vct, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(num), num, 3, S_region_to_vct, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(chn_n), chn_n, 4, S_region_to_vct, "an integer");
- reg = XEN_REGION_TO_C_INT(reg_n);
+ reg = Xen_region_to_C_int(reg_n);
if (!(region_ok(reg)))
return(snd_no_such_region_error(S_region_to_vct, reg_n));
- chn = XEN_TO_C_INT_OR_ELSE(chn_n, 0);
- if ((chn < 0) || (chn >= region_chans(reg)))
- return(snd_no_such_channel_error(S_region_to_vct, XEN_LIST_1(reg_n), chn_n));
-
- len = XEN_TO_C_INT64_T_OR_ELSE(num, 0);
- if (len < 0)
- XEN_OUT_OF_RANGE_ERROR(S_region_to_vct, 2, num, "length ~A < 0?");
+ if (Xen_is_integer(chn_n))
+ {
+ chn = Xen_integer_to_C_int(chn_n);
+ if ((chn < 0) || (chn >= region_chans(reg)))
+ return(snd_no_such_channel_error(S_region_to_vct, Xen_list_1(reg_n), chn_n));
+ }
+ if (Xen_is_integer(num))
+ {
+ len = Xen_llong_to_C_llong(num);
+ if (len < 0)
+ Xen_out_of_range_error(S_region_to_vct, 2, num, "length < 0?");
+ }
if ((len == 0) || (len > region_len(reg)))
len = region_len(reg);
if (len > 0)
{
+ mus_float_t *data;
mus_long_t beg;
beg = beg_to_sample(beg_n, S_region_to_vct);
if (beg >= region_len(reg))
- return(XEN_FALSE);
+ return(Xen_false);
if (v1)
{
- data = v1->data;
- if (len > v1->length) len = v1->length;
+ data = mus_vct_data(v1);
+ if (len > mus_vct_length(v1)) len = mus_vct_length(v1);
}
else
{
@@ -2025,24 +2121,24 @@ write region's samples starting at beg for samps in channel chan to vct v; retur
return(v);
else return(xen_make_vct(len, data));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_region_graph_style(void) {return(C_TO_XEN_INT(region_graph_style(ss)));}
+static Xen g_region_graph_style(void) {return(C_int_to_Xen_integer(region_graph_style(ss)));}
-static XEN g_set_region_graph_style(XEN val)
+static Xen g_set_region_graph_style(Xen val)
{
int style;
#define H_region_graph_style "(" S_region_graph_style "): graph style of the region dialog graph. \
The " S_region_graph_style " choices are " S_graph_lines ", " S_graph_dots ", " S_graph_filled ", " S_graph_lollipops ", \
and " S_graph_dots_and_lines "."
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_region_graph_style, "an integer");
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_region_graph_style, "an integer");
- style = XEN_TO_C_INT(val);
- if (!(graph_style_p(style)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_region_graph_style, 1, val, "~A: unknown " S_lisp_graph_style);
+ style = Xen_integer_to_C_int(val);
+ if (!is_graph_style(style))
+ Xen_out_of_range_error(S_set S_region_graph_style, 1, val, "unknown " S_lisp_graph_style);
set_region_graph_style((graph_style_t)style);
reflect_region_graph_style();
@@ -2050,86 +2146,74 @@ and " S_graph_dots_and_lines "."
}
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_10(g_restore_region_w, g_restore_region)
-XEN_ARGIFY_4(g_insert_region_w, g_insert_region)
-XEN_NARGIFY_0(g_regions_w, g_regions)
-XEN_ARGIFY_2(g_region_frames_w, g_region_frames)
-XEN_ARGIFY_2(g_region_position_w, g_region_position)
-XEN_NARGIFY_1(g_region_srate_w, g_region_srate)
-XEN_NARGIFY_1(g_region_chans_w, g_region_chans)
-XEN_NARGIFY_1(g_region_home_w, g_region_home)
-XEN_NARGIFY_1(g_region_maxamp_w, g_region_maxamp)
-XEN_NARGIFY_1(g_region_maxamp_position_w, g_region_maxamp_position)
-XEN_ARGIFY_9(g_save_region_w, g_save_region)
-XEN_NARGIFY_1(g_forget_region_w, g_forget_region)
-XEN_ARGIFY_4(g_make_region_w, g_make_region)
-XEN_ARGIFY_5(g_mix_region_w, g_mix_region)
-XEN_ARGIFY_3(g_region_sample_w, g_region_sample)
-XEN_ARGIFY_5(g_region_to_vct_w, g_region_to_vct)
-XEN_NARGIFY_1(g_region_p_w, g_region_p)
-XEN_NARGIFY_0(g_max_regions_w, g_max_regions)
-XEN_NARGIFY_1(g_set_max_regions_w, g_set_max_regions)
-XEN_NARGIFY_0(g_region_graph_style_w, g_region_graph_style)
-XEN_NARGIFY_1(g_set_region_graph_style_w, g_set_region_graph_style)
-XEN_NARGIFY_1(g_integer_to_region_w, g_integer_to_region)
-XEN_NARGIFY_1(g_region_to_integer_w, g_region_to_integer)
-#else
-#define g_restore_region_w g_restore_region
-#define g_insert_region_w g_insert_region
-#define g_regions_w g_regions
-#define g_region_frames_w g_region_frames
-#define g_region_position_w g_region_position
-#define g_region_srate_w g_region_srate
-#define g_region_chans_w g_region_chans
-#define g_region_home_w g_region_home
-#define g_region_maxamp_w g_region_maxamp
-#define g_region_maxamp_position_w g_region_maxamp_position
-#define g_save_region_w g_save_region
-#define g_forget_region_w g_forget_region
-#define g_make_region_w g_make_region
-#define g_mix_region_w g_mix_region
-#define g_region_sample_w g_region_sample
-#define g_region_to_vct_w g_region_to_vct
-#define g_region_p_w g_region_p
-#define g_max_regions_w g_max_regions
-#define g_set_max_regions_w g_set_max_regions
-#define g_region_graph_style_w g_region_graph_style
-#define g_set_region_graph_style_w g_set_region_graph_style
-#define g_integer_to_region_w g_integer_to_region
-#define g_region_to_integer_w g_region_to_integer
+Xen_wrap_any_args(g_restore_region_w, g_restore_region)
+Xen_wrap_4_optional_args(g_insert_region_w, g_insert_region)
+Xen_wrap_no_args(g_regions_w, g_regions)
+Xen_wrap_2_optional_args(g_region_framples_w, g_region_framples)
+Xen_wrap_2_optional_args(g_region_position_w, g_region_position)
+Xen_wrap_1_arg(g_region_srate_w, g_region_srate)
+Xen_wrap_1_arg(g_region_chans_w, g_region_chans)
+Xen_wrap_1_arg(g_region_home_w, g_region_home)
+Xen_wrap_1_arg(g_region_maxamp_w, g_region_maxamp)
+Xen_wrap_1_arg(g_region_maxamp_position_w, g_region_maxamp_position)
+Xen_wrap_9_optional_args(g_save_region_w, g_save_region)
+Xen_wrap_1_arg(g_forget_region_w, g_forget_region)
+Xen_wrap_4_optional_args(g_make_region_w, g_make_region)
+Xen_wrap_5_optional_args(g_mix_region_w, g_mix_region)
+Xen_wrap_3_optional_args(g_region_sample_w, g_region_sample)
+Xen_wrap_5_optional_args(g_region_to_vct_w, g_region_to_vct)
+Xen_wrap_1_arg(g_is_region_w, g_is_region)
+Xen_wrap_no_args(g_max_regions_w, g_max_regions)
+Xen_wrap_1_arg(g_set_max_regions_w, g_set_max_regions)
+Xen_wrap_no_args(g_region_graph_style_w, g_region_graph_style)
+Xen_wrap_1_arg(g_set_region_graph_style_w, g_set_region_graph_style)
+Xen_wrap_1_arg(g_integer_to_region_w, g_integer_to_region)
+Xen_wrap_1_arg(g_region_to_integer_w, g_region_to_integer)
+
+#if HAVE_SCHEME
+static s7_pointer acc_region_graph_style(s7_scheme *sc, s7_pointer args) {return(g_set_region_graph_style(s7_cadr(args)));}
+static s7_pointer acc_max_regions(s7_scheme *sc, s7_pointer args) {return(g_set_max_regions(s7_cadr(args)));}
#endif
+
void g_init_regions(void)
{
init_xen_region();
init_region_keywords();
- XEN_DEFINE_PROCEDURE(S_restore_region, g_restore_region_w, 9, 1, 0, "internal func used in save-state, restores a region");
- XEN_DEFINE_PROCEDURE(S_insert_region, g_insert_region_w, 2, 2, 0, H_insert_region);
- XEN_DEFINE_PROCEDURE(S_regions, g_regions_w, 0, 0, 0, H_regions);
- XEN_DEFINE_PROCEDURE(S_region_frames, g_region_frames_w, 1, 1, 0, H_region_frames);
- XEN_DEFINE_PROCEDURE(S_region_position, g_region_position_w, 1, 1, 0, H_region_position);
- XEN_DEFINE_PROCEDURE(S_region_srate, g_region_srate_w, 1, 0, 0, H_region_srate);
- XEN_DEFINE_PROCEDURE(S_region_chans, g_region_chans_w, 1, 0, 0, H_region_chans);
- XEN_DEFINE_PROCEDURE(S_region_home, g_region_home_w, 1, 0, 0, H_region_home);
- XEN_DEFINE_PROCEDURE(S_region_maxamp, g_region_maxamp_w, 1, 0, 0, H_region_maxamp);
- XEN_DEFINE_PROCEDURE(S_region_maxamp_position, g_region_maxamp_position_w, 1, 0, 0, H_region_maxamp_position);
- XEN_DEFINE_PROCEDURE(S_save_region, g_save_region_w, 2, 7, 0, H_save_region);
- XEN_DEFINE_PROCEDURE(S_forget_region, g_forget_region_w, 1, 0, 0, H_forget_region);
- XEN_DEFINE_PROCEDURE(S_make_region, g_make_region_w, 0, 4, 0, H_make_region);
- XEN_DEFINE_PROCEDURE(S_mix_region, g_mix_region_w, 1, 4, 0, H_mix_region);
- XEN_DEFINE_PROCEDURE(S_region_sample, g_region_sample_w, 2, 1, 0, H_region_sample);
- XEN_DEFINE_PROCEDURE(S_region_to_vct, g_region_to_vct_w, 1, 4, 0, H_region_to_vct);
- XEN_DEFINE_PROCEDURE(S_region_p, g_region_p_w, 1, 0, 0, H_region_p);
-
- XEN_DEFINE_PROCEDURE(S_integer_to_region, g_integer_to_region_w, 1, 0, 0, H_integer_to_region);
- XEN_DEFINE_PROCEDURE(S_region_to_integer, g_region_to_integer_w, 1, 0, 0, H_region_to_integer);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_max_regions, g_max_regions_w, H_max_regions, S_setB S_max_regions, g_set_max_regions_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_region_graph_style, g_region_graph_style_w, H_region_graph_style,
- S_setB S_region_graph_style, g_set_region_graph_style_w, 0, 0, 1, 0);
+ Xen_define_procedure(S_restore_region, g_restore_region_w, 0, 0, 1, "internal func used in save-state, restores a region");
+ Xen_define_procedure(S_insert_region, g_insert_region_w, 2, 2, 0, H_insert_region);
+ Xen_define_safe_procedure(S_regions, g_regions_w, 0, 0, 0, H_regions);
+ Xen_define_safe_procedure(S_region_framples, g_region_framples_w, 1, 1, 0, H_region_framples);
+ Xen_define_safe_procedure(S_region_position, g_region_position_w, 1, 1, 0, H_region_position);
+ Xen_define_safe_procedure(S_region_srate, g_region_srate_w, 1, 0, 0, H_region_srate);
+ Xen_define_safe_procedure(S_region_chans, g_region_chans_w, 1, 0, 0, H_region_chans);
+ Xen_define_safe_procedure(S_region_home, g_region_home_w, 1, 0, 0, H_region_home);
+ Xen_define_safe_procedure(S_region_maxamp, g_region_maxamp_w, 1, 0, 0, H_region_maxamp);
+ Xen_define_safe_procedure(S_region_maxamp_position, g_region_maxamp_position_w, 1, 0, 0, H_region_maxamp_position);
+ Xen_define_procedure(S_save_region, g_save_region_w, 2, 7, 0, H_save_region);
+ Xen_define_procedure(S_forget_region, g_forget_region_w, 1, 0, 0, H_forget_region);
+ Xen_define_procedure(S_make_region, g_make_region_w, 0, 4, 0, H_make_region);
+ Xen_define_procedure(S_mix_region, g_mix_region_w, 1, 4, 0, H_mix_region);
+ Xen_define_safe_procedure(S_region_sample, g_region_sample_w, 2, 1, 0, H_region_sample);
+ Xen_define_safe_procedure(S_region_to_vct, g_region_to_vct_w, 1, 4, 0, H_region_to_vct);
+ Xen_define_safe_procedure(S_is_region, g_is_region_w, 1, 0, 0, H_is_region);
+
+ Xen_define_safe_procedure(S_integer_to_region, g_integer_to_region_w, 1, 0, 0, H_integer_to_region);
+ Xen_define_safe_procedure(S_region_to_integer, g_region_to_integer_w, 1, 0, 0, H_region_to_integer);
+
+ Xen_define_dilambda(S_max_regions, g_max_regions_w, H_max_regions, S_set S_max_regions, g_set_max_regions_w, 0, 0, 1, 0);
+
+ Xen_define_dilambda(S_region_graph_style, g_region_graph_style_w, H_region_graph_style,
+ S_set S_region_graph_style, g_set_region_graph_style_w, 0, 0, 1, 0);
+
+#if HAVE_SCHEME
+ s7_symbol_set_access(s7, ss->max_regions_symbol, s7_make_function(s7, "[acc-" S_max_regions "]", acc_max_regions, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->region_graph_style_symbol, s7_make_function(s7, "[acc-" S_region_graph_style "]", acc_region_graph_style, 2, 0, false, "accessor"));
+
+ s7_symbol_set_documentation(s7, ss->max_regions_symbol, "*max-regions*: max number of regions saved on the region list");
+ s7_symbol_set_documentation(s7, ss->region_graph_style_symbol, "*region-graph-style*: graph style of the region dialog graph (graph-lines etc)");
+#endif
}
diff --git a/snd-select.c b/snd-select.c
index dc4f010..0baa2d5 100644
--- a/snd-select.c
+++ b/snd-select.c
@@ -126,7 +126,7 @@ static void cp_set_selection_beg(chan_info *cp, mus_long_t beg)
mus_long_t len;
ed = cp->edits[cp->edit_ctr];
- len = CURRENT_SAMPLES(cp);
+ len = current_samples(cp);
if (beg < len)
ed->selection_beg = beg;
else ed->selection_beg = len - 1;
@@ -164,7 +164,7 @@ static void cp_set_selection_len(chan_info *cp, mus_long_t len)
ed_list *ed;
mus_long_t cplen;
ed = cp->edits[cp->edit_ctr];
- cplen = CURRENT_SAMPLES(cp);
+ cplen = current_samples(cp);
ed->selection_end = ed->selection_beg + len - 1;
if (ed->selection_end >= cplen) ed->selection_end = cplen - 1;
ed->selection_maxamp = -1.0;
@@ -190,7 +190,7 @@ int selection_chans(void)
static mus_long_t selection_srate_1(chan_info *cp, mus_long_t *ignored)
{
if (cp_has_selection(cp))
- return((mus_long_t)SND_SRATE(cp->sound));
+ return((mus_long_t)snd_srate(cp->sound));
return(0);
}
@@ -250,14 +250,10 @@ bool delete_selection(cut_selection_regraph_t regraph)
for_each_normal_chan(cp_delete_selection);
if (regraph == UPDATE_DISPLAY)
for_each_normal_chan(update_graph);
+ enved_reflect_selection(false);
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_INACTIVE)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
return(true);
}
@@ -279,14 +275,10 @@ void deactivate_selection(void)
{
for_each_normal_chan(cp_deactivate_selection);
for_each_normal_chan(update_graph);
+ enved_reflect_selection(false);
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_INACTIVE)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
if (syncd_chans)
syncd_chans = free_sync_info(syncd_chans);
@@ -299,7 +291,7 @@ void reactivate_selection(chan_info *cp, mus_long_t beg, mus_long_t end)
mus_long_t len;
ed = cp->edits[cp->edit_ctr];
- len = CURRENT_SAMPLES(cp) - 1;
+ len = current_samples(cp) - 1;
if (beg < 0) beg = 0;
if (end < 0) end = 0;
if (beg > len) beg = len;
@@ -312,14 +304,11 @@ void reactivate_selection(chan_info *cp, mus_long_t beg, mus_long_t end)
ed->selection_maxamp = -1.0;
ed->selection_maxamp_position = -1;
xen_selection_counter++;
+ enved_reflect_selection(true);
+ reflect_selection_in_save_as_dialog(true);
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_ACTIVE)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
}
@@ -378,18 +367,19 @@ sync_info *selection_sync(void)
static int mix_selection(chan_info *cp, sync_info *si_out, mus_long_t beg, io_error_t *err, int start_chan)
{
- char *tempfile = NULL, *origin = NULL;
+ char *tempfile = NULL;
int id = INVALID_MIX_ID;
io_error_t io_err = IO_NO_ERROR;
tempfile = snd_tempnam();
- io_err = save_selection(tempfile, MUS_NEXT, MUS_OUT_FORMAT, SND_SRATE(cp->sound), NULL, SAVE_ALL_CHANS);
+ io_err = save_selection(tempfile, snd_srate(cp->sound), MUS_OUT_SAMPLE_TYPE, MUS_NEXT, NULL, SAVE_ALL_CHANS);
if (io_err == IO_NO_ERROR)
{
+ char *origin = NULL;
#if HAVE_FORTH
- origin = mus_format(MUS_LD " snd chn %s", beg, S_mix_selection);
+ origin = mus_format("%lld snd chn %s", beg, S_mix_selection);
#else
- origin = mus_format("%s" PROC_OPEN MUS_LD, TO_PROC_NAME(S_mix_selection), beg);
+ origin = mus_format("%s" PROC_OPEN "%lld", to_proc_name(S_mix_selection), beg);
#endif
if (si_out->chans > 1)
remember_temp(tempfile, si_out->chans);
@@ -412,7 +402,7 @@ void add_selection_or_region(int reg, chan_info *cp)
/* in all cases, this has a local sound to report in (kbd, xmenu) */
if (cp)
{
- if (editable_p(cp))
+ if (is_editable(cp))
{
io_error_t io_err = IO_NO_ERROR;
bool got_selection;
@@ -421,12 +411,12 @@ void add_selection_or_region(int reg, chan_info *cp)
{
sync_info *si_out;
si_out = sync_to_chan(cp);
- mix_selection(cp, si_out, CURSOR(cp), &io_err, 0);
+ mix_selection(cp, si_out, cursor_sample(cp), &io_err, 0);
free_sync_info(si_out);
}
else io_err = add_region(reg, cp);
if (io_err != IO_NO_ERROR)
- report_in_minibuffer(cp->sound, "can't mix %s: %s",
+ status_report(cp->sound, "can't mix %s: %s",
(got_selection) ? "selection" : "region",
io_error_name(io_err));
}
@@ -437,17 +427,18 @@ void add_selection_or_region(int reg, chan_info *cp)
static io_error_t insert_selection(chan_info *cp, sync_info *si_out, mus_long_t beg)
{
- char *tempfile = NULL, *origin = NULL;
- int i, out_format = MUS_OUT_FORMAT;
+ char *tempfile = NULL;
+ mus_sample_t out_format = MUS_OUT_SAMPLE_TYPE;
io_error_t io_err = IO_NO_ERROR;
- if (mus_header_writable(MUS_NEXT, cp->sound->hdr->format))
- out_format = cp->sound->hdr->format;
+ if (mus_header_writable(MUS_NEXT, cp->sound->hdr->sample_type))
+ out_format = cp->sound->hdr->sample_type;
tempfile = snd_tempnam();
- io_err = save_selection(tempfile, MUS_NEXT, out_format, SND_SRATE(cp->sound), NULL, SAVE_ALL_CHANS);
+ io_err = save_selection(tempfile, snd_srate(cp->sound), out_format, MUS_NEXT, NULL, SAVE_ALL_CHANS);
if (io_err == IO_NO_ERROR)
{
+ int i;
sync_info *si_in;
si_in = selection_sync();
if (si_in)
@@ -456,15 +447,16 @@ static io_error_t insert_selection(chan_info *cp, sync_info *si_out, mus_long_t
remember_temp(tempfile, si_in->chans);
for (i = 0; ((i < si_in->chans) && (i < si_out->chans)); i++)
{
+ char *origin;
chan_info *cp_in, *cp_out;
mus_long_t len;
cp_out = si_out->cps[i]; /* currently syncd chan that we might paste to */
cp_in = si_in->cps[i]; /* selection chan to paste in (no wrap-around here) */
len = cp_selection_len(cp_in, NULL);
#if HAVE_FORTH
- origin = mus_format(MUS_LD " %s", beg, S_insert_selection);
+ origin = mus_format("%lld %s", beg, S_insert_selection);
#else
- origin = mus_format("%s" PROC_OPEN MUS_LD, TO_PROC_NAME(S_insert_selection), beg);
+ origin = mus_format("%s" PROC_OPEN "%lld", to_proc_name(S_insert_selection), beg);
#endif
if (file_insert_samples(beg, len,
tempfile, cp_out, i,
@@ -481,23 +473,23 @@ static io_error_t insert_selection(chan_info *cp, sync_info *si_out, mus_long_t
}
-void insert_selection_or_region(int reg, chan_info *cp)
+static void insert_selection_or_region(int reg, chan_info *cp)
{
- io_error_t err = IO_NO_ERROR;
if (cp)
{
+ io_error_t err = IO_NO_ERROR;
bool got_selection;
got_selection = ((reg == 0) && (selection_is_active()));
if (got_selection)
{
sync_info *si_out;
si_out = sync_to_chan(cp);
- err = insert_selection(cp, si_out, CURSOR(cp));
+ err = insert_selection(cp, si_out, cursor_sample(cp));
free_sync_info(si_out);
}
else err = paste_region(reg, cp);
if (err != IO_NO_ERROR)
- report_in_minibuffer(cp->sound, "can't insert %s: %s",
+ status_report(cp->sound, "can't insert %s: %s",
(got_selection) ? "selection" : "region",
io_error_name(err));
}
@@ -545,14 +537,11 @@ void finish_selection_creation(void)
{
if (selection_creates_region(ss))
make_region_from_selection();
+ enved_reflect_selection(true);
+ reflect_selection_in_save_as_dialog(true);
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_ACTIVE)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
syncd_chans = free_sync_info(syncd_chans);
}
@@ -572,7 +561,7 @@ static void cp_redraw_selection(chan_info *cp)
ap = cp->axis;
beg = selection_beg(cp);
end = selection_end(cp);
- sp_srate = (double)SND_SRATE(cp->sound);
+ sp_srate = (double)snd_srate(cp->sound);
if (ap->losamp < beg)
x0 = grf_x((double)beg / sp_srate, ap);
@@ -632,12 +621,12 @@ static void redraw_selection(void)
{
#if (!USE_GTK)
cp_redraw_selection(cp);
- if ((cp->graph_transform_p) &&
+ if ((cp->graph_transform_on) &&
(!(chan_fft_in_progress(cp))) &&
(show_selection_transform(ss)))
calculate_fft(cp);
#else
- if ((cp->graph_transform_p) &&
+ if ((cp->graph_transform_on) &&
(!(chan_fft_in_progress(cp))) &&
(show_selection_transform(ss)))
update_graph(cp);
@@ -679,8 +668,8 @@ void update_possible_selection_in_progress(mus_long_t samp)
ed = cp->edits[cp->edit_ctr];
ed->selection_maxamp = -1.0;
ed->selection_maxamp_position = -1;
- if (samp > CURRENT_SAMPLES(cp))
- new_end = CURRENT_SAMPLES(cp);
+ if (samp > current_samples(cp))
+ new_end = current_samples(cp);
else new_end = samp;
if (new_end < original_beg)
@@ -735,9 +724,9 @@ int select_all(chan_info *cp)
si = sync_to_chan(cp);
for (i = 0; i < si->chans; i++)
{
- if (CURRENT_SAMPLES(si->cps[i]) > 0)
+ if (current_samples(si->cps[i]) > 0)
{
- reactivate_selection(si->cps[i], 0, CURRENT_SAMPLES(si->cps[i]));
+ reactivate_selection(si->cps[i], 0, current_samples(si->cps[i]));
update_graph(si->cps[i]);
}
}
@@ -756,8 +745,10 @@ static timeout_result_t watch_selection_button = 0;
void cancel_selection_watch(void)
{
+#if (!USE_NO_GUI)
if (watch_selection_button)
TIMEOUT_REMOVE(watch_selection_button);
+#endif
watch_selection_button = 0;
}
@@ -785,7 +776,7 @@ static void move_selection_1(chan_info *cp, int x)
if (((x > ap->x_axis_x1) && (ap->x1 == ap->xmax)) ||
((x < ap->x_axis_x0) && (ap->x0 == ap->xmin)))
return;
- move_axis(cp, ap, x);
+ move_axis(cp, x);
if (!watch_selection_button)
watch_selection_button = CALL_TIMEOUT(watch_selection, 50, cp);
}
@@ -842,7 +833,7 @@ bool hit_selection_triangle(chan_info *cp, int x, int y)
if (beg < ap->losamp) return(false);
if (beg > ap->hisamp) return(false);
- mx = grf_x((double)beg / (double)SND_SRATE(cp->sound), ap);
+ mx = grf_x((double)beg / (double)snd_srate(cp->sound), ap);
if (mx > (x + HIT_SLOP)) return(false); /* click point is to the left of the triangle */
if ((mx + play_arrow_size(ss) + HIT_SLOP) < x) return(false); /* click point is to the right of the triangle */
@@ -864,7 +855,7 @@ bool hit_selection_loop_triangle(chan_info *cp, int x, int y)
if (end < ap->losamp) return(false);
if (end > ap->hisamp) return(false);
- mx = grf_x((double)end / (double)SND_SRATE(cp->sound), ap);
+ mx = grf_x((double)end / (double)snd_srate(cp->sound), ap);
if ((mx - play_arrow_size(ss) - HIT_SLOP) > x) return(false);
if (mx < (x - HIT_SLOP)) return(false);
@@ -885,45 +876,45 @@ typedef struct {
} xen_selection;
-#define XEN_TO_XEN_SELECTION(arg) ((xen_selection *)XEN_OBJECT_REF(arg))
+#define Xen_to_xen_selection(arg) ((xen_selection *)Xen_object_ref(arg))
-static XEN_OBJECT_TYPE xen_selection_tag;
+static Xen_object_type_t xen_selection_tag;
-bool xen_selection_p(XEN obj)
+bool xen_is_selection(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, xen_selection_tag));
+ return(Xen_c_object_is_type(obj, xen_selection_tag));
}
static void xen_selection_free(xen_selection *v) {if (v) free(v);}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(xen_selection, free_xen_selection, xen_selection_free)
+Xen_wrap_free(xen_selection, free_xen_selection, xen_selection_free)
static char *xen_selection_to_string(xen_selection *v)
{
- #define XEN_SELECTION_PRINT_BUFFER_SIZE 64
+ #define xen_is_selectionRINT_BUFFER_SIZE 64
char *buf;
if (v == NULL) return(NULL);
- buf = (char *)calloc(XEN_SELECTION_PRINT_BUFFER_SIZE, sizeof(char));
- snprintf(buf, XEN_SELECTION_PRINT_BUFFER_SIZE, "#<selection %d>", v->n);
+ buf = (char *)calloc(xen_is_selectionRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, xen_is_selectionRINT_BUFFER_SIZE, "#<selection %d>", v->n);
return(buf);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(xen_selection, print_xen_selection, xen_selection_to_string)
+Xen_wrap_print(xen_selection, print_xen_selection, xen_selection_to_string)
#if HAVE_FORTH || HAVE_RUBY
-static XEN g_xen_selection_to_string(XEN obj)
+static Xen g_xen_selection_to_string(Xen obj)
{
char *vstr;
- XEN result;
+ Xen result;
#define S_xen_selection_to_string "selection->string"
- XEN_ASSERT_TYPE(XEN_SELECTION_P(obj), obj, XEN_ONLY_ARG, S_xen_selection_to_string, "a selection");
+ Xen_check_type(xen_is_selection(obj), obj, 1, S_xen_selection_to_string, "a selection");
- vstr = xen_selection_to_string(XEN_TO_XEN_SELECTION(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = xen_selection_to_string(Xen_to_xen_selection(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
@@ -938,10 +929,10 @@ static bool xen_selection_equalp(xen_selection *v1, xen_selection *v2)
}
-static XEN equalp_xen_selection(XEN obj1, XEN obj2)
+static Xen equalp_xen_selection(Xen obj1, Xen obj2)
{
- if ((!(XEN_SELECTION_P(obj1))) || (!(XEN_SELECTION_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(xen_selection_equalp(XEN_TO_XEN_SELECTION(obj1), XEN_TO_XEN_SELECTION(obj2))));
+ if ((!(xen_is_selection(obj1))) || (!(xen_is_selection(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(xen_selection_equalp(Xen_to_xen_selection(obj1), Xen_to_xen_selection(obj2))));
}
#endif
@@ -955,23 +946,23 @@ static xen_selection *xen_selection_make(int n)
}
-static XEN g_selection(void)
+static Xen g_selection(void)
{
#define H_selection "(" S_selection" ) returns an object representing the current selection, or " PROC_FALSE " if there is no active selection"
if (selection_is_active())
{
xen_selection *mx;
mx = xen_selection_make(xen_selection_counter);
- XEN_MAKE_AND_RETURN_OBJECT(xen_selection_tag, mx, 0, free_xen_selection);
+ return(Xen_make_object(xen_selection_tag, mx, 0, free_xen_selection));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
#if HAVE_SCHEME
-static XEN s7_xen_selection_length(s7_scheme *sc, XEN obj)
+static Xen s7_xen_selection_length(s7_scheme *sc, Xen obj)
{
- return(g_selection_frames(XEN_UNDEFINED, XEN_UNDEFINED));
+ return(g_selection_framples(Xen_undefined, Xen_undefined));
}
@@ -982,57 +973,57 @@ static bool s7_xen_selection_equalp(void *obj1, void *obj2)
}
-static XEN s7_xen_selection_copy(s7_scheme *sc, XEN obj)
+static Xen s7_xen_selection_copy(s7_scheme *sc, Xen args)
{
if (selection_is_active())
{
snd_info *sp;
char *name;
name = snd_tempnam();
- save_selection(name, MUS_NEXT, MUS_OUT_FORMAT, selection_srate(), NULL, SAVE_ALL_CHANS);
+ save_selection(name, selection_srate(), MUS_OUT_SAMPLE_TYPE, MUS_NEXT, NULL, SAVE_ALL_CHANS);
sp = snd_open_file(name, FILE_READ_WRITE);
free(name);
return(new_xen_sound(sp->index));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN s7_xen_selection_fill(s7_scheme *sc, XEN obj, XEN val)
+static Xen s7_xen_selection_fill(s7_scheme *sc, Xen args)
{
sync_info *si;
mus_float_t valf;
+ s7_pointer val;
- valf = XEN_TO_C_DOUBLE(val);
+ val = s7_cadr(args);
+ valf = Xen_real_to_C_double(val);
if (valf == 0.0)
{
mus_float_t vals[1] = {0.0};
scale_by(NULL, vals, 1, true); /* 1 entry in vals array, true = over selection */
- return(XEN_FALSE);
+ return(Xen_false);
}
si = selection_sync();
if (si)
{
int i;
- mus_sample_t value;
- value = MUS_FLOAT_TO_SAMPLE(valf);
for (i = 0; i < si->chans; i++)
{
mus_long_t beg, end, len, j;
- mus_sample_t *data;
+ mus_float_t *data;
beg = selection_beg(si->cps[i]);
end = selection_end(si->cps[i]);
len = end - beg + 1;
- data = (mus_sample_t *)malloc(len * sizeof(mus_sample_t));
+ data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
for (j = 0; j < len; j++)
- data[j] = value;
- if (change_samples(beg, len, data, si->cps[i], "fill! selection", si->cps[i]->edit_ctr))
+ data[j] = valf;
+ if (change_samples(beg, len, data, si->cps[i], "fill! selection", si->cps[i]->edit_ctr, fabs(valf)))
update_graph(si->cps[i]);
free(data);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
#endif
@@ -1040,15 +1031,15 @@ static XEN s7_xen_selection_fill(s7_scheme *sc, XEN obj, XEN val)
static void init_xen_selection(void)
{
#if HAVE_SCHEME
- xen_selection_tag = XEN_MAKE_OBJECT_TYPE("<selection>",
- print_xen_selection, free_xen_selection, s7_xen_selection_equalp,
- NULL, NULL, NULL, s7_xen_selection_length,
- s7_xen_selection_copy, s7_xen_selection_fill);
+ xen_selection_tag = s7_new_type_x(s7, "<selection>",
+ print_xen_selection, free_xen_selection, s7_xen_selection_equalp,
+ NULL, NULL, NULL, s7_xen_selection_length,
+ s7_xen_selection_copy, NULL, s7_xen_selection_fill);
#else
#if HAVE_RUBY
- xen_selection_tag = XEN_MAKE_OBJECT_TYPE("XenSelection", sizeof(xen_selection));
+ xen_selection_tag = Xen_make_object_type("XenSelection", sizeof(xen_selection));
#else
- xen_selection_tag = XEN_MAKE_OBJECT_TYPE("selection", sizeof(xen_selection));
+ xen_selection_tag = Xen_make_object_type("selection", sizeof(xen_selection));
#endif
#endif
@@ -1060,49 +1051,49 @@ static void init_xen_selection(void)
#endif
#if HAVE_RUBY
- rb_define_method(xen_selection_tag, "to_s", XEN_PROCEDURE_CAST print_xen_selection, 0);
- rb_define_method(xen_selection_tag, "eql?", XEN_PROCEDURE_CAST equalp_xen_selection, 1);
- rb_define_method(xen_selection_tag, "==", XEN_PROCEDURE_CAST equalp_xen_selection, 1);
- rb_define_method(xen_selection_tag, "to_str", XEN_PROCEDURE_CAST g_xen_selection_to_string, 0);
+ rb_define_method(xen_selection_tag, "to_s", Xen_procedure_cast print_xen_selection, 0);
+ rb_define_method(xen_selection_tag, "eql?", Xen_procedure_cast equalp_xen_selection, 1);
+ rb_define_method(xen_selection_tag, "==", Xen_procedure_cast equalp_xen_selection, 1);
+ rb_define_method(xen_selection_tag, "to_str", Xen_procedure_cast g_xen_selection_to_string, 0);
#endif
}
/* -------------------------------------------------------------------------------- */
-io_error_t save_selection(const char *ofile, int type, int format, int srate, const char *comment, int chan)
+io_error_t save_selection(const char *ofile, int srate, mus_sample_t samp_type, mus_header_t head_type, const char *comment, int chan)
{
/* type and format have already been checked */
- int ofd, bps;
+ int ofd;
io_error_t io_err = IO_NO_ERROR;
- mus_long_t oloc;
+ mus_long_t oloc, alloc_len;
sync_info *si = NULL;
mus_long_t *ends;
int i, j, k, chans;
- mus_long_t dur, num, ioff;
+ mus_long_t dur;
snd_fd **sfs;
snd_info *sp = NULL;
- mus_sample_t **data;
+ mus_float_t **data;
si = selection_sync();
if ((si) && (si->cps) && (si->cps[0])) sp = si->cps[0]->sound;
- if (type == -1)
+ if (head_type == MUS_UNKNOWN_HEADER)
{
- if ((sp) && (mus_header_writable(sp->hdr->type, -2))) /* -2 = ignore data format for the moment */
- type = sp->hdr->type;
- else type = MUS_NEXT;
+ if ((sp) && (mus_header_writable(sp->hdr->type, MUS_IGNORE_SAMPLE)))
+ head_type = sp->hdr->type;
+ else head_type = MUS_NEXT;
}
- if (format == -1)
+ if (samp_type == MUS_UNKNOWN_SAMPLE)
{
- if ((sp) && (mus_header_writable(type, sp->hdr->format)))
- format = sp->hdr->format;
- else format = MUS_OUT_FORMAT;
+ if ((sp) && (mus_header_writable(head_type, sp->hdr->sample_type)))
+ samp_type = sp->hdr->sample_type;
+ else samp_type = MUS_OUT_SAMPLE_TYPE;
}
- if (!mus_header_writable(type, format))
+ if (!mus_header_writable(head_type, samp_type))
{
- type = MUS_NEXT;
- format = MUS_OUT_FORMAT;
+ head_type = MUS_NEXT;
+ samp_type = MUS_OUT_SAMPLE_TYPE;
}
if (srate == -1)
srate = selection_srate();
@@ -1112,7 +1103,7 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
chans = si->chans;
else chans = 1;
- io_err = snd_write_header(ofile, type, srate, chans, chans * dur, format, comment, NULL);
+ io_err = snd_write_header(ofile, head_type, srate, chans, chans * dur, samp_type, comment, NULL);
if (io_err != IO_NO_ERROR)
{
si = free_sync_info(si);
@@ -1124,13 +1115,15 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
if (sp)
{
+ int bps;
+ mus_long_t num;
disk_space_t no_space;
bool copy_ok = false;
- bps = mus_bytes_per_sample(format);
+ bps = mus_bytes_per_sample(samp_type);
num = dur * bps * chans;
- no_space = disk_space_p(num, ofile);
+ no_space = disk_has_space(num, ofile);
if (no_space != DISK_SPACE_OK)
{
snd_close(ofd, ofile);
@@ -1138,7 +1131,7 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
return(IO_DISK_FULL);
}
- copy_ok = ((format == sp->hdr->format) &&
+ copy_ok = ((samp_type == sp->hdr->sample_type) &&
(chans == sp->nchans) &&
(chan == SAVE_ALL_CHANS));
if (copy_ok)
@@ -1157,10 +1150,7 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
* copy len*data-size bytes
* get max from amp envs
*/
- mus_long_t bytes, iloc;
int fdi;
- char *buffer;
-
lseek(ofd, oloc, SEEK_SET);
fdi = mus_file_open_read(sp->filename); /* this does not read the header */
if (fdi == -1)
@@ -1172,12 +1162,16 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
/* snd_error("can't read selection's original sound? %s: %s", sp->filename, snd_io_strerror()); */
else
{
+ mus_long_t iloc;
+ char *buffer;
+
iloc = mus_sound_data_location(sp->filename);
lseek(fdi, iloc + chans * bps * si->begs[0], SEEK_SET);
- buffer = (char *)calloc(MAX_BUFFER_SIZE, sizeof(char));
+ buffer = (char *)malloc(MAX_BUFFER_SIZE * sizeof(char));
for (j = 0; j < num; j += MAX_BUFFER_SIZE)
{
ssize_t n;
+ mus_long_t bytes;
bytes = num - j;
if (bytes > MAX_BUFFER_SIZE) bytes = MAX_BUFFER_SIZE;
n = read(fdi, buffer, bytes);
@@ -1191,8 +1185,10 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
}
snd_close(ofd, ofile);
si = free_sync_info(si);
- if (!(ss->fam_ok))
+#if USE_MOTIF
+ if (!(ss->file_monitor_ok))
alert_new_file();
+#endif
return(IO_NO_ERROR);
}
}
@@ -1200,39 +1196,61 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
ends = (mus_long_t *)calloc(chans, sizeof(mus_long_t));
sfs = (snd_fd **)calloc(chans, sizeof(snd_fd *));
if (chan == SAVE_ALL_CHANS)
- for (i = 0; i < chans; i++)
- {
- ends[i] = selection_end(si->cps[i]);
- sfs[i] = init_sample_read(selection_beg(si->cps[i]), si->cps[i], READ_FORWARD);
- }
+ {
+ for (i = 0; i < chans; i++)
+ {
+ ends[i] = selection_end(si->cps[i]);
+ sfs[i] = init_sample_read(selection_beg(si->cps[i]), si->cps[i], READ_FORWARD);
+ }
+ }
else
{
ends[0] = selection_end(si->cps[chan]);
sfs[0] = init_sample_read(selection_beg(si->cps[chan]), si->cps[chan], READ_FORWARD);
}
- snd_file_open_descriptors(ofd, ofile, format, oloc, chans, type);
+ snd_file_open_descriptors(ofd, ofile, samp_type, oloc, chans, head_type);
mus_file_set_clipping(ofd, clipping(ss));
lseek(ofd, oloc, SEEK_SET);
- data = (mus_sample_t **)calloc(chans, sizeof(mus_sample_t *));
+ data = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
+
+ if (dur > REPORTING_SIZE)
+ alloc_len = REPORTING_SIZE;
+ else alloc_len = dur;
+
for (i = 0; i < chans; i++)
- data[i] = (mus_sample_t *)calloc(FILE_BUFFER_SIZE, sizeof(mus_sample_t));
+ data[i] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
- j = 0;
- ss->stopped_explicitly = false;
- for (ioff = 0; ioff < dur; ioff++)
+ if (alloc_len == dur)
{
for (k = 0; k < chans; k++)
+ samples_to_vct_with_reader(dur, data[k], sfs[k]);
+ mus_file_write(ofd, 0, dur - 1, chans, data);
+ }
+ else
+ {
+ mus_long_t ioff;
+ ss->stopped_explicitly = false;
+ for (k = 0; k < chans; k++)
+ sampler_set_safe(sfs[k], ends[k]);
+
+ for (ioff = 0; ioff < dur; ioff += alloc_len)
{
- if (ioff <= ends[k])
- data[k][j] = read_sample_to_mus_sample(sfs[k]);
- else data[k][j] = MUS_SAMPLE_0;
- }
- j++;
- if (j == FILE_BUFFER_SIZE)
- {
+ mus_long_t kdur;
+
+ kdur = dur - ioff;
+ if (kdur > alloc_len) kdur = alloc_len;
+
+ for (j = 0; j < kdur; j++)
+ {
+ for (k = 0; k < chans; k++)
+ {
+ if ((ioff + j) <= ends[k])
+ data[k][j] = read_sample(sfs[k]);
+ else data[k][j] = 0.0;
+ }
+ }
io_err = sndlib_error_to_snd(mus_file_write(ofd, 0, j - 1, chans, data));
- j = 0;
if (io_err != IO_NO_ERROR)
{
snd_warning("%s %s: %s",
@@ -1250,8 +1268,7 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
}
}
}
- if ((io_err == IO_NO_ERROR) && (j > 0))
- mus_file_write(ofd, 0, j - 1, chans, data);
+
for (i = 0; i < chans; i++)
{
free_snd_fd(sfs[i]);
@@ -1261,27 +1278,31 @@ io_error_t save_selection(const char *ofile, int type, int format, int srate, co
free(data);
si = free_sync_info(si);
free(ends);
+
if (mus_file_close(ofd) != 0)
return(IO_CANT_CLOSE_FILE);
- if (!(ss->fam_ok))
+#if USE_MOTIF
+ if (!(ss->file_monitor_ok))
alert_new_file();
+#endif
+
return(io_err);
}
-static XEN g_delete_selection(void)
+static Xen g_delete_selection(void)
{
#define H_delete_selection "(" S_delete_selection "): delete the currently selected portion"
if (selection_is_active())
{
delete_selection(UPDATE_DISPLAY);
- return(XEN_TRUE);
+ return(Xen_true);
}
return(snd_no_active_selection_error(S_delete_selection));
}
-static XEN g_insert_selection(XEN beg, XEN snd, XEN chn)
+static Xen g_insert_selection(Xen beg, Xen snd, Xen chn)
{
#define H_insert_selection "(" S_insert_selection " :optional (beg 0) snd chn): insert the currently selected portion starting at beg"
if (selection_is_active())
@@ -1291,33 +1312,33 @@ static XEN g_insert_selection(XEN beg, XEN snd, XEN chn)
io_error_t io_err = IO_NO_ERROR;
sync_info *si_out;
- ASSERT_CHANNEL(S_insert_selection, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(beg), beg, XEN_ARG_1, S_insert_selection, "a number");
+ Snd_assert_channel(S_insert_selection, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(beg), beg, 1, S_insert_selection, "an integer");
cp = get_cp(snd, chn, S_insert_selection);
- if ((!cp) || (!(editable_p(cp)))) return(XEN_FALSE);
+ if ((!cp) || (!(is_editable(cp)))) return(Xen_false);
samp = beg_to_sample(beg, S_insert_selection);
- if (XEN_NUMBER_P(chn))
+ if (Xen_is_integer(chn))
si_out = make_simple_sync(cp, samp); /* ignore sync */
else si_out = sync_to_chan(cp);
io_err = insert_selection(cp, si_out, samp);
free_sync_info(si_out);
- if (SERIOUS_IO_ERROR(io_err))
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_insert_selection ": IO error ~A"),
- C_TO_XEN_STRING(io_error_name(io_err))));
- return(XEN_FALSE);
+ if (is_serious_io_error(io_err))
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_2(C_string_to_Xen_string(S_insert_selection ": IO error ~A"),
+ C_string_to_Xen_string(io_error_name(io_err))));
+ return(Xen_false);
}
return(snd_no_active_selection_error(S_insert_selection));
}
-static XEN g_mix_selection(XEN beg, XEN snd, XEN chn, XEN sel_chan)
+static Xen g_mix_selection(Xen beg, Xen snd, Xen chn, Xen sel_chan)
{
- #define H_mix_selection "(" S_mix_selection " :optional (beg 0) snd chn (selection-channel #t)): mix the currently selected portion starting at beg"
+ #define H_mix_selection "(" S_mix_selection " :optional (beg 0) snd chn (selection-channel " PROC_TRUE ")): mix the currently selected portion starting at beg"
if (selection_is_active())
{
chan_info *cp;
@@ -1325,19 +1346,19 @@ static XEN g_mix_selection(XEN beg, XEN snd, XEN chn, XEN sel_chan)
io_error_t io_err = IO_NO_ERROR;
int i, selection_chan = 0, id = -1, chans = 0;
sync_info *si_out;
- XEN result = XEN_EMPTY_LIST;
+ Xen result = Xen_empty_list;
- ASSERT_CHANNEL(S_mix_selection, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(beg), beg, XEN_ARG_1, S_mix_selection, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(sel_chan), sel_chan, XEN_ARG_4, S_mix_selection, "an integer or " PROC_TRUE);
+ Snd_assert_channel(S_mix_selection, snd, chn, 2);
+ Xen_check_type(Xen_is_integer_or_unbound(beg), beg, 1, S_mix_selection, "an integer");
+ Xen_check_type(Xen_is_integer_boolean_or_unbound(sel_chan), sel_chan, 4, S_mix_selection, "an integer or " PROC_TRUE);
cp = get_cp(snd, chn, S_mix_selection);
- if ((!cp) || (!(editable_p(cp)))) return(XEN_FALSE);
+ if ((!cp) || (!(is_editable(cp)))) return(Xen_false);
obeg = beg_to_sample(beg, S_mix_selection);
- if (XEN_INTEGER_P(sel_chan))
- selection_chan = XEN_TO_C_INT(sel_chan);
- if (XEN_NUMBER_P(chn))
+ if (Xen_is_integer(sel_chan))
+ selection_chan = Xen_integer_to_C_int(sel_chan);
+ if (Xen_is_integer(chn))
si_out = make_simple_sync(cp, obeg); /* ignore sync */
else si_out = sync_to_chan(cp);
@@ -1345,21 +1366,21 @@ static XEN g_mix_selection(XEN beg, XEN snd, XEN chn, XEN sel_chan)
chans = si_out->chans; /* save for loop below */
free_sync_info(si_out);
- if (SERIOUS_IO_ERROR(io_err))
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_mix_selection ": IO error ~A"),
- C_TO_XEN_STRING(io_error_name(io_err))));
+ if (is_serious_io_error(io_err))
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_2(C_string_to_Xen_string(S_mix_selection ": IO error ~A"),
+ C_string_to_Xen_string(io_error_name(io_err))));
- if (id == -1) return(XEN_FALSE);
+ if (id == -1) return(Xen_false);
for (i = 0; i < chans; i++)
- result = XEN_CONS(new_xen_mix(id + i), result);
- return(XEN_LIST_REVERSE(result));
+ result = Xen_cons(new_xen_mix(id + i), result);
+ return(Xen_list_reverse(result));
}
return(snd_no_active_selection_error(S_mix_selection));
}
-static XEN g_selection_to_mix(void)
+static Xen g_selection_to_mix(void)
{
#define H_selection_to_mix "(" S_selection_to_mix "): turns the current selection into a mix"
if (selection_is_active())
@@ -1368,28 +1389,28 @@ static XEN g_selection_to_mix(void)
io_error_t io_err = IO_NO_ERROR;
int i, id = INVALID_MIX_ID, chans = 0, sync = GET_NEW_SYNC;
sync_info *si_out;
- XEN result = XEN_EMPTY_LIST;
+ Xen result = Xen_empty_list;
char *tempfile = NULL, *origin = NULL;
si_out = selection_sync();
cp = si_out->cps[0];
tempfile = snd_tempnam();
- io_err = save_selection(tempfile, MUS_NEXT, MUS_OUT_FORMAT, SND_SRATE(cp->sound), NULL, SAVE_ALL_CHANS);
- if (SERIOUS_IO_ERROR(io_err))
+ io_err = save_selection(tempfile, snd_srate(cp->sound), MUS_OUT_SAMPLE_TYPE, MUS_NEXT, NULL, SAVE_ALL_CHANS);
+ if (is_serious_io_error(io_err))
{
if (tempfile) free(tempfile);
free_sync_info(si_out);
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_selection_to_mix ": IO error ~A"),
- C_TO_XEN_STRING(io_error_name(io_err))));
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_2(C_string_to_Xen_string(S_selection_to_mix ": IO error ~A"),
+ C_string_to_Xen_string(io_error_name(io_err))));
}
origin = mus_format("%s", S_selection_to_mix);
if (si_out->chans > 1)
remember_temp(tempfile, si_out->chans);
- g_scale_selection_by(C_TO_XEN_DOUBLE(0.0));
+ g_scale_selection_by(C_double_to_Xen_real(0.0));
id = mix_file(selection_beg(NULL), selection_len(), si_out->chans, si_out->cps, tempfile,
(si_out->chans > 1) ? MULTICHANNEL_DELETION : DELETE_ME,
@@ -1402,69 +1423,69 @@ static XEN g_selection_to_mix(void)
chans = si_out->chans; /* save for loop below */
free_sync_info(si_out);
- if (id == -1) return(XEN_FALSE);
+ if (id == -1) return(Xen_false);
if (chans == 1)
- return(XEN_CONS(new_xen_mix(id), XEN_EMPTY_LIST)); /* no sync */
+ return(Xen_cons(new_xen_mix(id), Xen_empty_list)); /* no sync */
for (i = 0; i < chans; i++)
{
sync = mix_set_sync_from_id(id + i, sync);
- result = XEN_CONS(new_xen_mix(id + i), result);
+ result = Xen_cons(new_xen_mix(id + i), result);
}
if ((mix_dialog_mix() >= id) &&
(mix_dialog_mix() < (id + chans)))
reflect_mix_change(id);
/* this update is needed in a case like: file close (closing old mix), open new, mix -- this mix can now have old mix's id */
- return(XEN_LIST_REVERSE(result));
+ return(Xen_list_reverse(result));
}
return(snd_no_active_selection_error(S_selection_to_mix));
}
-static XEN g_selection_p(XEN sel)
+static Xen g_is_selection(Xen sel)
{
- #define H_selection_p "(" S_selection_p " :optional obj): " PROC_TRUE " if selection is currently active, visible, etc. \
-If 'obj' is passed, " S_selection_p " returns " PROC_TRUE " if obj is a selection object and there is a current selection."
+ #define H_is_selection "(" S_is_selection " :optional obj): " PROC_TRUE " if selection is currently active, visible, etc. \
+If 'obj' is passed, " S_is_selection " returns " PROC_TRUE " if obj is a selection object and there is a current selection."
- if ((XEN_BOUND_P(sel)) &&
- (!(xen_selection_p(sel))))
- return(XEN_FALSE);
+ if ((Xen_is_bound(sel)) &&
+ (!(xen_is_selection(sel))))
+ return(Xen_false);
- return(C_TO_XEN_BOOLEAN(selection_is_active()));
+ return(C_bool_to_Xen_boolean(selection_is_active()));
}
-static XEN g_selection_position(XEN snd, XEN chn)
+static Xen g_selection_position(Xen snd, Xen chn)
{
#define H_selection_position "(" S_selection_position " :optional snd chn): selection start samp"
if (selection_is_active())
{
- if (XEN_NOT_BOUND_P(snd))
- return(C_TO_XEN_INT64_T(selection_beg(NULL)));
+ if (!Xen_is_bound(snd))
+ return(C_llong_to_Xen_llong(selection_beg(NULL)));
else
{
chan_info *cp;
- ASSERT_CHANNEL(S_selection_position, snd, chn, 1);
+ Snd_assert_channel(S_selection_position, snd, chn, 1);
cp = get_cp(snd, chn, S_selection_position);
- if (!cp) return(XEN_FALSE);
- return(C_TO_XEN_INT64_T(selection_beg(cp)));
+ if (!cp) return(Xen_false);
+ return(C_llong_to_Xen_llong(selection_beg(cp)));
}
}
return(snd_no_active_selection_error(S_selection_position));
}
-static XEN g_set_selection_position(XEN pos, XEN snd, XEN chn)
+static Xen g_set_selection_position(Xen pos, Xen snd, Xen chn)
{
chan_info *cp;
mus_long_t beg;
- ASSERT_CHANNEL(S_setB S_selection_position, snd, chn, 2);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(pos), pos, XEN_ARG_1, S_selection_position, "a number");
+ Snd_assert_channel(S_set S_selection_position, snd, chn, 2);
+ Xen_check_type(Xen_is_integer(pos), pos, 1, S_selection_position, "an integer");
- beg = beg_to_sample(pos, S_setB S_selection_position);
- if (XEN_NOT_BOUND_P(snd))
+ beg = beg_to_sample(pos, S_set S_selection_position);
+ if (!Xen_is_bound(snd))
{
sync_info *si = NULL;
if (selection_is_active())
@@ -1484,47 +1505,47 @@ static XEN g_set_selection_position(XEN pos, XEN snd, XEN chn)
}
else
{
- cp = get_cp(snd, chn, S_setB S_selection_position);
- if (!cp) return(XEN_FALSE);
+ cp = get_cp(snd, chn, S_set S_selection_position);
+ if (!cp) return(Xen_false);
cp_set_selection_beg(cp, beg);
}
redraw_selection();
return(pos);
}
-WITH_THREE_SETTER_ARGS(g_set_selection_position_reversed, g_set_selection_position)
+with_three_setter_args(g_set_selection_position_reversed, g_set_selection_position)
-XEN g_selection_frames(XEN snd, XEN chn)
+Xen g_selection_framples(Xen snd, Xen chn)
{
- #define H_selection_frames "(" S_selection_frames " :optional snd chn): selection length"
+ #define H_selection_framples "(" S_selection_framples " :optional snd chn): selection length"
if (selection_is_active())
{
- if (XEN_NOT_BOUND_P(snd))
- return(C_TO_XEN_INT64_T(selection_len()));
+ if (!Xen_is_bound(snd))
+ return(C_llong_to_Xen_llong(selection_len()));
else
{
chan_info *cp;
- ASSERT_CHANNEL(S_selection_frames, snd, chn, 1);
- cp = get_cp(snd, chn, S_selection_frames);
- if (!cp) return(XEN_FALSE);
- return(C_TO_XEN_INT64_T(cp_selection_len(cp, NULL)));
+ Snd_assert_channel(S_selection_framples, snd, chn, 1);
+ cp = get_cp(snd, chn, S_selection_framples);
+ if (!cp) return(Xen_false);
+ return(C_llong_to_Xen_llong(cp_selection_len(cp, NULL)));
}
}
- return(snd_no_active_selection_error(S_selection_frames));
+ return(snd_no_active_selection_error(S_selection_framples));
}
-static XEN g_set_selection_frames(XEN samps, XEN snd, XEN chn)
+static Xen g_set_selection_framples(Xen samps, Xen snd, Xen chn)
{
chan_info *cp;
mus_long_t len;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samps), samps, XEN_ARG_1, S_setB S_selection_frames, "a number");
- len = XEN_TO_C_INT64_T_OR_ELSE(samps, 0);
+ Xen_check_type(Xen_is_llong(samps), samps, 1, S_set S_selection_framples, "an integer");
+ len = Xen_llong_to_C_llong(samps);
if (len <= 0)
- XEN_WRONG_TYPE_ARG_ERROR(S_setB S_selection_frames, XEN_ARG_1, samps, "a positive integer");
- if (XEN_NOT_BOUND_P(snd))
+ Xen_wrong_type_arg_error(S_set S_selection_framples, 1, samps, "a positive integer");
+ if (!Xen_is_bound(snd))
{
sync_info *si = NULL;
if (selection_is_active())
@@ -1544,55 +1565,52 @@ static XEN g_set_selection_frames(XEN samps, XEN snd, XEN chn)
}
else
{
- ASSERT_CHANNEL(S_setB S_selection_frames, snd, chn, 2);
- cp = get_cp(snd, chn, S_setB S_selection_frames);
- if (!cp) return(XEN_FALSE);
+ Snd_assert_channel(S_set S_selection_framples, snd, chn, 2);
+ cp = get_cp(snd, chn, S_set S_selection_framples);
+ if (!cp) return(Xen_false);
cp_set_selection_len(cp, len);
}
redraw_selection();
return(samps);
}
-WITH_THREE_SETTER_ARGS(g_set_selection_frames_reversed, g_set_selection_frames)
+with_three_setter_args(g_set_selection_framples_reversed, g_set_selection_framples)
-static XEN g_selection_member(XEN snd, XEN chn)
+static Xen g_selection_member(Xen snd, Xen chn)
{
#define H_selection_member "(" S_selection_member " :optional snd chn): " PROC_TRUE " if snd's channel chn is a member of the current selection"
chan_info *cp;
- ASSERT_CHANNEL(S_selection_member, snd, chn, 1);
+ Snd_assert_channel(S_selection_member, snd, chn, 1);
cp = get_cp(snd, chn, S_selection_member);
- if (!cp) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(selection_is_active_in_channel(cp)));
+ if (!cp) return(Xen_false);
+ return(C_bool_to_Xen_boolean(selection_is_active_in_channel(cp)));
}
-static XEN g_set_selection_member(XEN on, XEN snd, XEN chn)
+static Xen g_set_selection_member(Xen on, Xen snd, Xen chn)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_selection_member, "a boolean");
- if ((XEN_TRUE_P(snd)) && (XEN_FALSE_P(on)))
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_selection_member, "a boolean");
+ if ((Xen_is_true(snd)) && (Xen_is_false(on)))
deactivate_selection();
else
{
chan_info *cp;
- ASSERT_CHANNEL(S_setB S_selection_member, snd, chn, 2);
- cp = get_cp(snd, chn, S_setB S_selection_member);
- if (!cp) return(XEN_FALSE);
- if (XEN_TRUE_P(on))
+ Snd_assert_channel(S_set S_selection_member, snd, chn, 2);
+ cp = get_cp(snd, chn, S_set S_selection_member);
+ if (!cp) return(Xen_false);
+ if (Xen_is_true(on))
{
if (selection_is_active())
cp_set_selection_beg(cp, selection_beg(NULL));
else cp_set_selection_beg(cp, 0);
}
else cp_deactivate_selection(cp);
+ enved_reflect_selection(selection_is_active());
+ reflect_selection_in_save_as_dialog(selection_is_active());
- if (XEN_HOOKED(ss->snd_selection_hook))
- run_hook(ss->snd_selection_hook,
- XEN_LIST_1(C_TO_XEN_INT(SELECTION_CHANGED)),
- "selection-hook");
-
- if (XEN_HOOKED(ss->effects_hook))
- run_hook(ss->effects_hook, XEN_EMPTY_LIST, S_effects_hook);
+ if (Xen_hook_has_list(ss->effects_hook))
+ run_hook(ss->effects_hook, Xen_empty_list, S_effects_hook);
if (selection_is_active())
redraw_selection();
@@ -1600,51 +1618,53 @@ static XEN g_set_selection_member(XEN on, XEN snd, XEN chn)
return(on);
}
-WITH_THREE_SETTER_ARGS(g_set_selection_member_reversed, g_set_selection_member)
+with_three_setter_args(g_set_selection_member_reversed, g_set_selection_member)
-static XEN g_select_all(XEN snd_n, XEN chn_n)
+static Xen g_select_all(Xen snd_n, Xen chn_n)
{
#define H_select_all "(" S_select_all " :optional snd chn): make a new selection containing all of snd's channel chn. \
If sync is set, all chans are included. The new region id is returned (if " S_selection_creates_region " is " PROC_TRUE ")."
chan_info *cp;
int id;
- ASSERT_CHANNEL(S_select_all, snd_n, chn_n, 1);
+ Snd_assert_channel(S_select_all, snd_n, chn_n, 1);
cp = get_cp(snd_n, chn_n, S_select_all);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
id = select_all(cp);
if (selection_creates_region(ss))
- return(C_INT_TO_XEN_REGION(id));
- else return(XEN_FALSE);
+ return(C_int_to_Xen_region(id));
+ else return(Xen_false);
}
-static XEN kw_header_type, kw_data_format, kw_comment, kw_file, kw_srate, kw_channel;
+static Xen kw_header_type, kw_comment, kw_file, kw_srate, kw_channel, kw_sample_type;
static void init_selection_keywords(void)
{
- kw_header_type = XEN_MAKE_KEYWORD("header-type");
- kw_data_format = XEN_MAKE_KEYWORD("data-format");
- kw_comment = XEN_MAKE_KEYWORD("comment");
- kw_file = XEN_MAKE_KEYWORD("file");
- kw_srate = XEN_MAKE_KEYWORD("srate");
- kw_channel = XEN_MAKE_KEYWORD("channel");
+ kw_header_type = Xen_make_keyword("header-type");
+ kw_sample_type = Xen_make_keyword("sample-type");
+ kw_comment = Xen_make_keyword("comment");
+ kw_file = Xen_make_keyword("file");
+ kw_srate = Xen_make_keyword("srate");
+ kw_channel = Xen_make_keyword("channel");
}
-static XEN g_save_selection(XEN arglist)
+static Xen g_save_selection(Xen arglist)
{
- #define H_save_selection "(" S_save_selection " :file :header-type :data-format :srate :comment :channel): \
+ #define H_save_selection "(" S_save_selection " file srate sample-type header-type comment channel): \
save the current selection in file using the indicated file attributes. If channel is given, save only that channel."
- int type = -1, format = -1, sr = -1, chn = 0;
+ mus_header_t head_type = MUS_UNKNOWN_HEADER;
+ mus_sample_t samp_type = MUS_UNKNOWN_SAMPLE;
+ int sr = -1, chn = 0;
io_error_t io_err = IO_NO_ERROR;
const char *com = NULL, *file = NULL;
char *fname = NULL;
- XEN args[12];
- XEN keys[6];
+ Xen args[12];
+ Xen keys[6];
int orig_arg[6] = {0, 0, 0, 0, 0, 0};
int vals, i, arglist_len;
if (!(selection_is_active()))
@@ -1656,86 +1676,88 @@ save the current selection in file using the indicated file attributes. If chan
*/
keys[0] = kw_file;
- keys[1] = kw_header_type;
- keys[2] = kw_data_format;
- keys[3] = kw_srate;
+ keys[1] = kw_srate;
+ keys[2] = kw_sample_type;
+ keys[3] = kw_header_type;
keys[4] = kw_comment;
keys[5] = kw_channel;
- for (i = 0; i < 12; i++) args[i] = XEN_UNDEFINED;
- arglist_len = XEN_LIST_LENGTH(arglist);
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
+ for (i = 0; i < 12; i++) args[i] = Xen_undefined;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 12)
+ Xen_out_of_range_error(S_save_selection, 0, arglist, "too many arguments");
+ for (i = 0; i < arglist_len; i++) args[i] = Xen_list_ref(arglist, i);
vals = mus_optkey_unscramble(S_save_selection, 6, keys, args, orig_arg);
if (vals > 0)
{
file = mus_optkey_to_string(keys[0], S_save_selection, orig_arg[0], NULL);
- type = mus_optkey_to_int(keys[1], S_save_selection, orig_arg[1], type);
- format = mus_optkey_to_int(keys[2], S_save_selection, orig_arg[2], format);
- sr = mus_optkey_to_int(keys[3], S_save_selection, orig_arg[3], selection_srate());
+ sr = mus_optkey_to_int(keys[1], S_save_selection, orig_arg[1], selection_srate());
+ samp_type = (mus_sample_t)mus_optkey_to_int(keys[2], S_save_selection, orig_arg[2], (int)samp_type);
+ head_type = (mus_header_t)mus_optkey_to_int(keys[3], S_save_selection, orig_arg[3], (int)head_type);
com = mus_optkey_to_string(keys[4], S_save_selection, orig_arg[4], NULL);
chn = mus_optkey_to_int(keys[5], S_save_selection, orig_arg[5], SAVE_ALL_CHANS);
}
if (file == NULL)
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_1(C_TO_XEN_STRING(S_save_selection ": no output file?")));
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_1(C_string_to_Xen_string(S_save_selection ": no output file?")));
- if ((type != -1) && (!(mus_header_writable(type, -2))))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_save_selection ": can't write a ~A header"),
- C_TO_XEN_STRING(mus_header_type_name(type))));
+ if ((head_type != MUS_UNKNOWN_HEADER) && (!(mus_header_writable(head_type, MUS_IGNORE_SAMPLE))))
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_save_selection ": can't write a ~A header"),
+ C_string_to_Xen_string(mus_header_type_name(head_type))));
- if ((type != -1) && (format != -1) && (!(mus_header_writable(type, format))))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_selection ": can't write ~A data to a ~A header"),
- C_TO_XEN_STRING(mus_data_format_name(format)),
- C_TO_XEN_STRING(mus_header_type_name(type))));
+ if ((head_type != MUS_UNKNOWN_HEADER) && (samp_type != MUS_UNKNOWN_SAMPLE) && (!(mus_header_writable(head_type, samp_type))))
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_save_selection ": can't write ~A data to a ~A header"),
+ C_string_to_Xen_string(mus_sample_type_name(samp_type)),
+ C_string_to_Xen_string(mus_header_type_name(head_type))));
if ((sr != -1) && (sr <= 0))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_save_selection ": srate (~A) can't be <= 0"),
- C_TO_XEN_INT(sr)));
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_save_selection ": srate (~A) can't be <= 0"),
+ C_int_to_Xen_integer(sr)));
fname = mus_expand_filename(file);
- io_err = save_selection(fname, type, format, sr, com, chn);
+ io_err = save_selection(fname, sr, samp_type, head_type, com, chn);
if (fname) free(fname);
if ((io_err != IO_NO_ERROR) &&
(io_err != IO_INTERRUPTED) &&
(io_err != IO_SAVE_HOOK_CANCELLATION))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_selection ": can't save ~S, ~A"),
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_save_selection ": can't save ~S, ~A"),
keys[0],
- C_TO_XEN_STRING(snd_open_strerror())));
+ C_string_to_Xen_string(snd_open_strerror())));
return(args[orig_arg[0] - 1]);
}
-XEN g_selection_chans(void)
+Xen g_selection_chans(void)
{
#define H_selection_chans "(" S_selection_chans "): chans in active selection"
- return(C_TO_XEN_INT(selection_chans()));
+ return(C_int_to_Xen_integer(selection_chans()));
}
-XEN g_selection_srate(void)
+Xen g_selection_srate(void)
{
#define H_selection_srate "(" S_selection_srate "): selection srate"
- return(C_TO_XEN_INT(selection_srate()));
+ return(C_int_to_Xen_integer(selection_srate()));
}
-XEN g_selection_maxamp(XEN snd, XEN chn)
+Xen g_selection_maxamp(Xen snd, Xen chn)
{
#define H_selection_maxamp "(" S_selection_maxamp " :optional snd chn): selection maxamp in given channel, or overall maxamp if no args passed."
- if (XEN_BOUND_P(snd))
+ if (Xen_is_bound(snd))
{
chan_info *cp;
- ASSERT_CHANNEL(S_selection_maxamp, snd, chn, 1);
+ Snd_assert_channel(S_selection_maxamp, snd, chn, 1);
cp = get_cp(snd, chn, S_selection_maxamp);
- if (!cp) return(XEN_FALSE);
- return(C_TO_XEN_DOUBLE(selection_maxamp(cp)));
+ if (!cp) return(Xen_false);
+ return(C_double_to_Xen_real(selection_maxamp(cp)));
}
else
{
@@ -1744,7 +1766,7 @@ XEN g_selection_maxamp(XEN snd, XEN chn)
sync_info *si;
si = selection_sync();
if (!si)
- return(C_TO_XEN_DOUBLE(0.0)); /* no selection -- error? */
+ return(C_double_to_Xen_real(0.0)); /* no selection -- error? */
for (i = 0; i < si->chans; i++)
{
mus_float_t cur_mx;
@@ -1753,19 +1775,19 @@ XEN g_selection_maxamp(XEN snd, XEN chn)
mx = cur_mx;
}
free_sync_info(si);
- return(C_TO_XEN_DOUBLE(mx));
+ return(C_double_to_Xen_real(mx));
}
}
-static XEN g_selection_maxamp_position(XEN snd, XEN chn)
+static Xen g_selection_maxamp_position(Xen snd, Xen chn)
{
#define H_selection_maxamp_position "(" S_selection_maxamp_position " :optional snd chn): location of selection maxamp (0 = start of selection)"
chan_info *cp;
- ASSERT_CHANNEL(S_selection_maxamp_position, snd, chn, 1);
+ Snd_assert_channel(S_selection_maxamp_position, snd, chn, 1);
cp = get_cp(snd, chn, S_selection_maxamp_position);
- if (!cp) return(XEN_FALSE);
- return(C_TO_XEN_INT64_T(selection_maxamp_position(cp)));
+ if (!cp) return(Xen_false);
+ return(C_llong_to_Xen_llong(selection_maxamp_position(cp)));
}
@@ -1778,11 +1800,11 @@ static bool get_selection_bounds(chan_info *cp)
mus_long_t samp;
double x;
samp = selection_beg(cp);
- x = (double)samp / SND_SRATE(cp->sound);
+ x = (double)samp / snd_srate(cp->sound);
if ((sel_beg < 0.0) || (x < sel_beg))
sel_beg = x;
samp = selection_end(cp);
- x = (double)samp / SND_SRATE(cp->sound);
+ x = (double)samp / snd_srate(cp->sound);
if ((sel_end < 0.0) || (x > sel_end))
sel_end = x;
}
@@ -1805,65 +1827,48 @@ void show_selection(void)
}
-static XEN g_show_selection(void)
+static Xen g_show_selection(void)
{
#define H_show_selection "(" S_show_selection ") adjusts graph bounds to display the current selection in full"
if (selection_is_active())
show_selection();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_unselect_all(void)
+static Xen g_unselect_all(void)
{
#define H_unselect_all "(" S_unselect_all ") deactivates (unselects) the current selection."
deactivate_selection();
- return(XEN_FALSE);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_2(g_selection_position_w, g_selection_position)
-XEN_ARGIFY_3(g_set_selection_position_w, g_set_selection_position)
-XEN_ARGIFY_2(g_selection_frames_w, g_selection_frames)
-XEN_ARGIFY_3(g_set_selection_frames_w, g_set_selection_frames)
-XEN_ARGIFY_2(g_selection_member_w, g_selection_member)
-XEN_ARGIFY_3(g_set_selection_member_w, g_set_selection_member)
-XEN_NARGIFY_0(g_selection_w, g_selection)
-XEN_ARGIFY_1(g_selection_p_w, g_selection_p)
-XEN_NARGIFY_0(g_selection_chans_w, g_selection_chans)
-XEN_NARGIFY_0(g_selection_srate_w, g_selection_srate)
-XEN_ARGIFY_2(g_selection_maxamp_w, g_selection_maxamp)
-XEN_ARGIFY_2(g_selection_maxamp_position_w, g_selection_maxamp_position)
-XEN_NARGIFY_0(g_delete_selection_w, g_delete_selection)
-XEN_ARGIFY_3(g_insert_selection_w, g_insert_selection)
-XEN_ARGIFY_4(g_mix_selection_w, g_mix_selection)
-XEN_NARGIFY_0(g_selection_to_mix_w, g_selection_to_mix)
-XEN_ARGIFY_2(g_select_all_w, g_select_all)
-XEN_VARGIFY(g_save_selection_w, g_save_selection)
-XEN_NARGIFY_0(g_show_selection_w, g_show_selection)
-XEN_NARGIFY_0(g_unselect_all_w, g_unselect_all)
+ return(Xen_false);
+}
+
+
+Xen_wrap_2_optional_args(g_selection_position_w, g_selection_position)
+Xen_wrap_2_optional_args(g_selection_framples_w, g_selection_framples)
+Xen_wrap_2_optional_args(g_selection_member_w, g_selection_member)
+Xen_wrap_no_args(g_selection_w, g_selection)
+Xen_wrap_1_optional_arg(g_is_selection_w, g_is_selection)
+Xen_wrap_no_args(g_selection_chans_w, g_selection_chans)
+Xen_wrap_no_args(g_selection_srate_w, g_selection_srate)
+Xen_wrap_2_optional_args(g_selection_maxamp_w, g_selection_maxamp)
+Xen_wrap_2_optional_args(g_selection_maxamp_position_w, g_selection_maxamp_position)
+Xen_wrap_no_args(g_delete_selection_w, g_delete_selection)
+Xen_wrap_3_optional_args(g_insert_selection_w, g_insert_selection)
+Xen_wrap_4_optional_args(g_mix_selection_w, g_mix_selection)
+Xen_wrap_no_args(g_selection_to_mix_w, g_selection_to_mix)
+Xen_wrap_2_optional_args(g_select_all_w, g_select_all)
+Xen_wrap_any_args(g_save_selection_w, g_save_selection)
+Xen_wrap_no_args(g_show_selection_w, g_show_selection)
+Xen_wrap_no_args(g_unselect_all_w, g_unselect_all)
+#if HAVE_SCHEME
+#define g_set_selection_position_w g_set_selection_position_reversed
+#define g_set_selection_framples_w g_set_selection_framples_reversed
+#define g_set_selection_member_w g_set_selection_member_reversed
#else
-#define g_selection_position_w g_selection_position
-#define g_set_selection_position_w g_set_selection_position
-#define g_selection_frames_w g_selection_frames
-#define g_set_selection_frames_w g_set_selection_frames
-#define g_selection_member_w g_selection_member
-#define g_set_selection_member_w g_set_selection_member
-#define g_selection_p_w g_selection_p
-#define g_selection_w g_selection
-#define g_selection_chans_w g_selection_chans
-#define g_selection_srate_w g_selection_srate
-#define g_selection_maxamp_w g_selection_maxamp
-#define g_selection_maxamp_position_w g_selection_maxamp_position
-#define g_delete_selection_w g_delete_selection
-#define g_insert_selection_w g_insert_selection
-#define g_mix_selection_w g_mix_selection
-#define g_selection_to_mix_w g_selection_to_mix
-#define g_select_all_w g_select_all
-#define g_save_selection_w g_save_selection
-#define g_show_selection_w g_show_selection
-#define g_unselect_all_w g_unselect_all
+Xen_wrap_3_optional_args(g_set_selection_position_w, g_set_selection_position)
+Xen_wrap_3_optional_args(g_set_selection_framples_w, g_set_selection_framples)
+Xen_wrap_3_optional_args(g_set_selection_member_w, g_set_selection_member)
#endif
void g_init_selection(void)
@@ -1871,30 +1876,22 @@ void g_init_selection(void)
init_selection_keywords();
init_xen_selection();
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_selection_position, g_selection_position_w, H_selection_position,
- S_setB S_selection_position, g_set_selection_position_w, g_set_selection_position_reversed,
- 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_selection_frames, g_selection_frames_w, H_selection_frames,
- S_setB S_selection_frames, g_set_selection_frames_w, g_set_selection_frames_reversed,
- 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_selection_member, g_selection_member_w, H_selection_member,
- S_setB S_selection_member, g_set_selection_member_w, g_set_selection_member_reversed,
- 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE(S_selection, g_selection_w, 0, 0, 0, H_selection);
- XEN_DEFINE_PROCEDURE(S_selection_p, g_selection_p_w, 0, 1, 0, H_selection_p);
- XEN_DEFINE_PROCEDURE(S_selection_chans, g_selection_chans_w, 0, 0, 0, H_selection_chans);
- XEN_DEFINE_PROCEDURE(S_selection_srate, g_selection_srate_w, 0, 0, 0, H_selection_srate);
- XEN_DEFINE_PROCEDURE(S_selection_maxamp, g_selection_maxamp_w, 0, 2, 0, H_selection_maxamp);
- XEN_DEFINE_PROCEDURE(S_selection_maxamp_position, g_selection_maxamp_position_w, 0, 2, 0, H_selection_maxamp_position);
- XEN_DEFINE_PROCEDURE(S_delete_selection, g_delete_selection_w, 0, 0, 0, H_delete_selection);
- XEN_DEFINE_PROCEDURE(S_insert_selection, g_insert_selection_w, 0, 3, 0, H_insert_selection);
- XEN_DEFINE_PROCEDURE(S_mix_selection, g_mix_selection_w, 0, 4, 0, H_mix_selection);
- XEN_DEFINE_PROCEDURE(S_selection_to_mix, g_selection_to_mix_w, 0, 0, 0, H_selection_to_mix);
- XEN_DEFINE_PROCEDURE(S_select_all, g_select_all_w, 0, 2, 0, H_select_all);
- XEN_DEFINE_PROCEDURE(S_save_selection, g_save_selection_w, 0, 0, 1, H_save_selection);
- XEN_DEFINE_PROCEDURE(S_show_selection, g_show_selection_w, 0, 0, 0, H_show_selection);
- XEN_DEFINE_PROCEDURE(S_unselect_all, g_unselect_all_w, 0, 0, 0, H_unselect_all);
+ Xen_define_dilambda(S_selection_position, g_selection_position_w, H_selection_position, S_set S_selection_position, g_set_selection_position_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_selection_framples, g_selection_framples_w, H_selection_framples, S_set S_selection_framples, g_set_selection_framples_w, 0, 2, 1, 2);
+ Xen_define_dilambda(S_selection_member, g_selection_member_w, H_selection_member, S_set S_selection_member, g_set_selection_member_w, 0, 2, 1, 2);
+
+ Xen_define_safe_procedure(S_selection, g_selection_w, 0, 0, 0, H_selection);
+ Xen_define_safe_procedure(S_is_selection, g_is_selection_w, 0, 1, 0, H_is_selection);
+ Xen_define_safe_procedure(S_selection_chans, g_selection_chans_w, 0, 0, 0, H_selection_chans);
+ Xen_define_safe_procedure(S_selection_srate, g_selection_srate_w, 0, 0, 0, H_selection_srate);
+ Xen_define_safe_procedure(S_selection_maxamp, g_selection_maxamp_w, 0, 2, 0, H_selection_maxamp);
+ Xen_define_safe_procedure(S_selection_maxamp_position, g_selection_maxamp_position_w, 0, 2, 0, H_selection_maxamp_position);
+ Xen_define_procedure(S_delete_selection, g_delete_selection_w, 0, 0, 0, H_delete_selection);
+ Xen_define_procedure(S_insert_selection, g_insert_selection_w, 0, 3, 0, H_insert_selection);
+ Xen_define_procedure(S_mix_selection, g_mix_selection_w, 0, 4, 0, H_mix_selection);
+ Xen_define_procedure(S_selection_to_mix, g_selection_to_mix_w, 0, 0, 0, H_selection_to_mix);
+ Xen_define_procedure(S_select_all, g_select_all_w, 0, 2, 0, H_select_all);
+ Xen_define_procedure(S_save_selection, g_save_selection_w, 0, 0, 1, H_save_selection);
+ Xen_define_procedure(S_show_selection, g_show_selection_w, 0, 0, 0, H_show_selection);
+ Xen_define_procedure(S_unselect_all, g_unselect_all_w, 0, 0, 0, H_unselect_all);
}
diff --git a/snd-sig.c b/snd-sig.c
index 5bfa07c..e19bce1 100644
--- a/snd-sig.c
+++ b/snd-sig.c
@@ -2,7 +2,6 @@
#include "clm2xen.h"
#include "clm-strings.h"
-
/* collect syncd chans */
typedef struct {
sync_info *si;
@@ -24,9 +23,9 @@ static void free_sync_state(sync_state *sc)
}
-int to_c_edit_position(chan_info *cp, XEN edpos, const char *caller, int arg_pos)
+int to_c_edit_position(chan_info *cp, Xen edpos, const char *caller, int arg_pos)
{
- int pos;
+ int pos = AT_CURRENT_EDIT_POSITION;
/* need to allow #f here for optargs */
/* also remember that there might be no extension language */
@@ -34,34 +33,10 @@ int to_c_edit_position(chan_info *cp, XEN edpos, const char *caller, int arg_pos
return(cp->edit_ctr);
#endif
- XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(edpos) || XEN_INTEGER_P(edpos) || XEN_PROCEDURE_P(edpos) || XEN_FALSE_P(edpos),
- edpos, arg_pos, caller, "an integer, " PROC_FALSE ", or a procedure");
-
- if (XEN_PROCEDURE_P(edpos))
- {
- char *errmsg = NULL;
- errmsg = procedure_ok(edpos, 2, caller, "edit position", arg_pos);
- if (errmsg)
- {
- XEN errstr;
- errstr = C_TO_XEN_STRING(errmsg);
- free(errmsg);
- snd_bad_arity_error(caller, errstr, edpos);
- return(cp->edit_ctr);
- }
+ Xen_check_type(!Xen_is_bound(edpos) || Xen_is_integer(edpos) || Xen_is_false(edpos), edpos, arg_pos, caller, "an integer, or " PROC_FALSE);
- pos = XEN_TO_C_INT_OR_ELSE(XEN_CALL_2(edpos,
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan),
- caller),
- AT_CURRENT_EDIT_POSITION);
- if (cp->active < CHANNEL_HAS_EDIT_LIST) /* edpos proc clobbered channel somehow... */
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_3(C_TO_XEN_STRING("~A: edpos arg (~A) clobbered the current sound!"),
- C_TO_XEN_STRING(caller),
- edpos));
- }
- else pos = XEN_TO_C_INT_OR_ELSE(edpos, AT_CURRENT_EDIT_POSITION);
+ if (Xen_is_integer(edpos))
+ pos = Xen_integer_to_C_int(edpos);
if (pos == AT_CURRENT_EDIT_POSITION)
return(cp->edit_ctr);
@@ -69,63 +44,75 @@ int to_c_edit_position(chan_info *cp, XEN edpos, const char *caller, int arg_pos
if ((pos < 0) ||
(pos >= cp->edit_size) ||
(cp->edits[pos] == NULL))
- XEN_ERROR(NO_SUCH_EDIT,
- XEN_LIST_8(C_TO_XEN_STRING("~A: no such edpos: ~A (from ~A), sound index: ~A (~S), chan: ~A, current edit: ~A"),
- C_TO_XEN_STRING(caller),
- C_TO_XEN_INT(pos),
+ Xen_error(NO_SUCH_EDIT,
+ Xen_list_8(C_string_to_Xen_string("~A: no such edpos: ~A (from ~A), sound index: ~A (~S), chan: ~A, current edit: ~A"),
+ C_string_to_Xen_string(caller),
+ C_int_to_Xen_integer(pos),
edpos,
- C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_STRING(cp->sound->short_filename),
- C_TO_XEN_INT(cp->chan),
- C_TO_XEN_INT(cp->edit_ctr)));
+ C_int_to_Xen_sound(cp->sound->index),
+ C_string_to_Xen_string(cp->sound->short_filename),
+ C_int_to_Xen_integer(cp->chan),
+ C_int_to_Xen_integer(cp->edit_ctr)));
return(pos);
}
-mus_long_t to_c_edit_samples(chan_info *cp, XEN edpos, const char *caller, int arg_pos)
+mus_long_t to_c_edit_samples(chan_info *cp, Xen edpos, const char *caller, int arg_pos)
{
return(cp->edits[to_c_edit_position(cp, edpos, caller, arg_pos)]->samples);
}
-mus_long_t beg_to_sample(XEN beg, const char *caller)
+mus_long_t beg_to_sample(Xen beg, const char *caller)
{
- mus_long_t start;
- start = XEN_TO_C_INT64_T_OR_ELSE(beg, 0);
- if (start < 0)
- XEN_ERROR(NO_SUCH_SAMPLE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such sample: ~A"),
- C_TO_XEN_STRING(caller),
- beg));
- return(start);
+ if (Xen_is_integer(beg))
+ {
+ mus_long_t start;
+ start = Xen_llong_to_C_llong(beg);
+ if (start < 0)
+ Xen_error(NO_SUCH_SAMPLE, Xen_list_3(C_string_to_Xen_string("~A: no such sample: ~A"), C_string_to_Xen_string(caller), beg));
+ if (start > (1LL << 34))
+ Xen_out_of_range_error(caller, 1, beg, "too large");
+ return(start);
+ }
+ return(0);
}
-mus_long_t dur_to_samples(XEN dur, mus_long_t beg, chan_info *cp, int edpos, int argn, const char *caller)
+mus_long_t dur_to_samples(Xen dur, mus_long_t beg, chan_info *cp, int edpos, int argn, const char *caller)
{
- mus_long_t samps;
- samps = XEN_TO_C_INT64_T_OR_ELSE(dur, cp->edits[edpos]->samples - beg);
- if (samps < 0)
- XEN_WRONG_TYPE_ARG_ERROR(caller, argn, dur, "a positive integer");
- return(samps);
+ if (Xen_is_integer(dur))
+ {
+ mus_long_t samps;
+ samps = Xen_llong_to_C_llong(dur);
+ if (samps < 0)
+ Xen_wrong_type_arg_error(caller, argn, dur, "a positive integer");
+ if (samps > (1LL << 34))
+ Xen_out_of_range_error(caller, argn, dur, "too large");
+ return(samps);
+ }
+ return(cp->edits[edpos]->samples - beg);
}
-static mus_long_t end_to_sample(XEN end, chan_info *cp, int edpos, const char *caller)
+static mus_long_t end_to_sample(Xen end, chan_info *cp, int edpos, const char *caller)
{
- mus_long_t last;
- last = XEN_TO_C_INT64_T_OR_ELSE(end, cp->edits[edpos]->samples - 1);
- if (last < 0)
- XEN_ERROR(NO_SUCH_SAMPLE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such sample: ~A"),
- C_TO_XEN_STRING(caller),
- end));
- return(last);
+ if (Xen_is_integer(end))
+ {
+ mus_long_t last;
+ last = Xen_llong_to_C_llong(end);
+ if (last < 0)
+ Xen_error(NO_SUCH_SAMPLE, Xen_list_3(C_string_to_Xen_string("~A: no such sample: ~A"), C_string_to_Xen_string(caller), end));
+ if (last > (1LL << 34))
+ Xen_out_of_range_error(caller, 2, end, "too large");
+ return(last);
+ }
+ return(cp->edits[edpos]->samples - 1);
}
static sync_state *get_sync_state_1(snd_info *sp, chan_info *cp, mus_long_t beg, bool over_selection,
- read_direction_t forwards, mus_long_t prebeg, XEN edpos, const char *caller, int arg_pos)
+ read_direction_t forwards, mus_long_t prebeg, Xen edpos, const char *caller, int arg_pos)
{
/* can return NULL if over_selection and no current selection */
sync_info *si = NULL;
@@ -204,7 +191,7 @@ static sync_state *get_sync_state_1(snd_info *sp, chan_info *cp, mus_long_t beg,
static sync_state *get_sync_state(snd_info *sp, chan_info *cp, mus_long_t beg, bool over_selection,
- read_direction_t forwards, XEN edpos, const char *caller, int arg_pos)
+ read_direction_t forwards, Xen edpos, const char *caller, int arg_pos)
{
return(get_sync_state_1(sp, cp, beg, over_selection, forwards, 0, edpos, caller, arg_pos));
}
@@ -248,16 +235,16 @@ static sync_state *get_sync_state_without_snd_fds(snd_info *sp, chan_info *cp, m
}
-static char *convolve_with_or_error(char *filename, mus_float_t amp, chan_info *cp, XEN edpos, int arg_pos)
+static char *convolve_with_or_error(char *filename, mus_float_t amp, chan_info *cp, Xen edpos, int arg_pos)
{
/* if string returned, needs to be freed */
/* amp == 0.0 means unnormalized, cp == NULL means current selection */
sync_state *sc;
sync_info *si;
- snd_info *sp = NULL, *gsp = NULL;
- int ip, stop_point = 0, impulse_chan = 0, filter_chans, dataformat;
- bool ok = false;
- mus_long_t filtersize = 0, filesize = 0, dataloc, fftsize;
+ snd_info *sp = NULL;
+ int ip, stop_point = 0, filter_chans;
+ mus_sample_t dataformat;
+ mus_long_t filtersize = 0, dataloc;
chan_info *ncp, *ucp;
char *origin;
@@ -283,7 +270,7 @@ static char *convolve_with_or_error(char *filename, mus_float_t amp, chan_info *
/* if impulse response is stereo, we need to use both its channels */
dataloc = mus_sound_data_location(filename);
- dataformat = mus_sound_data_format(filename);
+ dataformat = mus_sound_sample_type(filename);
sc = get_sync_state_without_snd_fds(sp, ncp, 0, (cp == NULL));
if (sc == NULL) return(NULL);
@@ -294,19 +281,22 @@ static char *convolve_with_or_error(char *filename, mus_float_t amp, chan_info *
filename, amp, (cp == NULL) ? S_convolve_selection_with : S_convolve_with);
#else
origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%.3f",
- TO_PROC_NAME((cp == NULL) ? S_convolve_selection_with : S_convolve_with),
+ to_proc_name((cp == NULL) ? S_convolve_selection_with : S_convolve_with),
filename, amp);
#endif
if (!(ss->stopped_explicitly))
{
+ snd_info *gsp = NULL;
+ int impulse_chan = 0;
for (ip = 0; ip < si->chans; ip++)
{
char *ofile, *saved_chan_file;
io_error_t io_err;
+ bool ok = false;
+ mus_long_t filesize;
- ok = false;
ucp = si->cps[ip];
- if (!(editable_p(ucp))) continue;
+ if (!(is_editable(ucp))) continue;
sp = ucp->sound;
if (!(sp->active)) continue;
if ((ip == 0) || (sp != gsp))
@@ -344,7 +334,7 @@ static char *convolve_with_or_error(char *filename, mus_float_t amp, chan_info *
hdr = sp->hdr;
snd_file_open_descriptors(scfd,
saved_chan_file,
- hdr->format,
+ hdr->sample_type,
hdr->data_location,
1, hdr->type); /* ??? */
fltfd = mus_file_open_read(filename);
@@ -369,6 +359,7 @@ static char *convolve_with_or_error(char *filename, mus_float_t amp, chan_info *
if (filesize > 0)
{
int ipow;
+ mus_long_t fftsize;
ipow = (int)(ceil(log(filtersize + filesize) / log(2.0))) + 1;
fftsize = snd_mus_long_t_pow2(ipow);
ok = true;
@@ -464,20 +455,20 @@ void scale_by(chan_info *cp, mus_float_t *ur_scalers, int len, bool over_selecti
for (i = 0, j = 0; i < si->chans; i++)
{
- mus_long_t beg, frames;
+ mus_long_t beg, framples;
chan_info *ncp;
ncp = si->cps[i];
if (over_selection)
{
beg = selection_beg(ncp);
- frames = selection_end(ncp) - beg + 1;
+ framples = selection_end(ncp) - beg + 1;
}
else
{
beg = 0;
- frames = CURRENT_SAMPLES(ncp);
+ framples = current_samples(ncp);
}
- scale_channel(ncp, ur_scalers[j], beg, frames, ncp->edit_ctr, NOT_IN_AS_ONE_EDIT);
+ scale_channel(ncp, ur_scalers[j], beg, framples, ncp->edit_ctr, NOT_IN_AS_ONE_EDIT);
j++;
if (j >= len) j = 0;
}
@@ -492,12 +483,10 @@ bool scale_to(snd_info *sp, chan_info *cp, mus_float_t *ur_scalers, int len, boo
/* if more than one, get successive maxamps */
bool scaled = false;
int i, chans, nlen, datum_size;
- mus_long_t beg, frames;
sync_info *si = NULL;
chan_info *ncp;
- mus_float_t maxamp = -1.0, val, norm = 1.0;
+ mus_float_t maxamp = -1.0, val;
mus_float_t *scalers;
- char *origin = NULL;
if ((!over_selection) && (cp == NULL)) return(false);
if (over_selection)
@@ -509,7 +498,7 @@ bool scale_to(snd_info *sp, chan_info *cp, mus_float_t *ur_scalers, int len, boo
}
else si = sync_to_chan(cp);
- datum_size = mus_bytes_per_sample((sp->hdr)->format);
+ datum_size = mus_bytes_per_sample((sp->hdr)->sample_type);
chans = si->chans;
scalers = (mus_float_t *)calloc(chans, sizeof(mus_float_t));
if (chans < len)
@@ -583,29 +572,32 @@ bool scale_to(snd_info *sp, chan_info *cp, mus_float_t *ur_scalers, int len, boo
{
for (i = 0; i < si->chans; i++)
{
+ mus_long_t beg, framples;
+ char *origin = NULL;
+ mus_float_t norm = 1.0;
ncp = si->cps[i];
if (nlen > i) norm = ur_scalers[i]; else norm = ur_scalers[0];
if (over_selection)
{
beg = selection_beg(ncp);
- frames = selection_end(ncp) - beg + 1;
+ framples = selection_end(ncp) - beg + 1;
#if HAVE_FORTH
- origin = mus_format("%.3f" PROC_SEP MUS_LD PROC_SEP MUS_LD " %s", norm, beg, frames, S_normalize_channel);
+ origin = mus_format("%.3f" PROC_SEP "%lld" PROC_SEP "%lld %s", norm, beg, framples, S_normalize_channel);
#else
- origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(S_normalize_channel), norm, beg, frames);
+ origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_normalize_channel), norm, beg, framples);
#endif
}
else
{
beg = 0;
- frames = CURRENT_SAMPLES(ncp);
+ framples = current_samples(ncp);
#if HAVE_FORTH
origin = mus_format("%.3f 0 " PROC_FALSE " %s", norm, S_normalize_channel);
#else
- origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "0" PROC_SEP PROC_FALSE, TO_PROC_NAME(S_normalize_channel), norm);
+ origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "0" PROC_SEP PROC_FALSE, to_proc_name(S_normalize_channel), norm);
#endif
}
- scale_channel_with_origin(ncp, scalers[i], beg, frames, ncp->edit_ctr, NOT_IN_AS_ONE_EDIT, origin);
+ scale_channel_with_origin(ncp, scalers[i], beg, framples, ncp->edit_ctr, NOT_IN_AS_ONE_EDIT, origin);
if (origin) free(origin);
origin = NULL;
}
@@ -623,26 +615,27 @@ static void swap_channels(chan_info *cp0, chan_info *cp1, mus_long_t beg, mus_lo
snd_fd *c0, *c1;
snd_info *sp0;
file_info *hdr0 = NULL, *hdr1 = NULL;
- int j, ofd0 = 0, ofd1 = 0, datumb = 0;
+ int ofd0 = 0, ofd1 = 0, datumb = 0;
bool temp_file;
- mus_long_t k;
- mus_sample_t **data0, **data1;
- mus_sample_t *idata0, *idata1;
+ mus_long_t alloc_len;
+ mus_float_t **data0, **data1;
+ mus_float_t *idata0, *idata1;
bool reporting = false;
char *ofile0 = NULL, *ofile1 = NULL;
io_error_t io_err = IO_NO_ERROR;
if (dur <= 0) return;
- if ((!(editable_p(cp0))) || (!(editable_p(cp1)))) return;
+ if ((!(is_editable(cp0))) || (!(is_editable(cp1)))) return;
sp0 = cp0->sound;
reporting = ((sp0) && (dur > REPORTING_SIZE) && (!(cp0->squelch_update)));
if (reporting) start_progress_report(cp0);
- if (dur > MAX_BUFFER_SIZE)
+ if (dur > REPORTING_SIZE)
{
+ alloc_len = REPORTING_SIZE;
temp_file = true;
ofile0 = snd_tempnam();
- hdr0 = make_temp_header(ofile0, SND_SRATE(sp0), 1, dur, (char *)S_swap_channels);
+ hdr0 = make_temp_header(ofile0, snd_srate(sp0), 1, dur, (char *)S_swap_channels);
ofd0 = open_temp_file(ofile0, 1, hdr0, &io_err);
if (ofd0 == -1)
{
@@ -653,9 +646,9 @@ static void swap_channels(chan_info *cp0, chan_info *cp1, mus_long_t beg, mus_lo
snd_open_strerror());
return;
}
- datumb = mus_bytes_per_sample(hdr0->format);
+ datumb = mus_bytes_per_sample(hdr0->sample_type);
ofile1 = snd_tempnam();
- hdr1 = make_temp_header(ofile1, SND_SRATE(sp0), 1, dur, (char *)S_swap_channels);
+ hdr1 = make_temp_header(ofile1, snd_srate(sp0), 1, dur, (char *)S_swap_channels);
ofd1 = open_temp_file(ofile1, 1, hdr1, &io_err);
if (ofd1 == -1)
{
@@ -670,52 +663,52 @@ static void swap_channels(chan_info *cp0, chan_info *cp1, mus_long_t beg, mus_lo
return;
}
}
- else temp_file = false;
+ else
+ {
+ temp_file = false;
+ alloc_len = dur;
+ }
- data0 = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- data0[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
- data1 = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- data1[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
+ data0 = (mus_float_t **)malloc(sizeof(mus_float_t *));
+ data0[0] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
+ data1 = (mus_float_t **)malloc(sizeof(mus_float_t *));
+ data1[0] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
idata0 = data0[0];
idata1 = data1[0];
- c0 = init_sample_read_any(beg, cp0, READ_FORWARD, pos0);
- c1 = init_sample_read_any(beg, cp1, READ_FORWARD, pos1);
+ c0 = init_sample_read_any_with_bufsize(beg, cp0, READ_FORWARD, pos0, alloc_len);
+ c1 = init_sample_read_any_with_bufsize(beg, cp1, READ_FORWARD, pos1, alloc_len);
if (temp_file)
{
+ mus_long_t k;
ss->stopped_explicitly = false;
- j = 0;
- for (k = 0; k < dur; k++)
+ sampler_set_safe(c0, dur);
+ sampler_set_safe(c1, dur);
+ for (k = 0; k < dur; k += alloc_len)
{
- idata0[j] = read_sample_to_mus_sample(c1);
- idata1[j] = read_sample_to_mus_sample(c0);
- j++;
- if (j == MAX_BUFFER_SIZE)
+ int j, n, err;
+ j = dur - k;
+ if (j > alloc_len) j = alloc_len;
+
+ for (n = 0; n < j; n++)
{
- int err;
- err = mus_file_write(ofd0, 0, j - 1, 1, data0);
- err = mus_file_write(ofd1, 0, j - 1, 1, data1);
- j = 0;
- if (err == -1) break;
- if (reporting)
- {
- progress_report(cp0, (mus_float_t)((double)k / (double)dur));
- if (ss->stopped_explicitly) break;
- if ((cp0->active < CHANNEL_HAS_EDIT_LIST) ||
- (cp1->active < CHANNEL_HAS_EDIT_LIST))
- {
- ss->stopped_explicitly = true;
- break;
- }
- }
+ idata0[j] = read_sample(c1);
+ idata1[j] = read_sample(c0);
}
- }
- if (!(ss->stopped_explicitly))
- {
- if (j > 0)
+ mus_file_write(ofd0, 0, j - 1, 1, data0);
+ err = mus_file_write(ofd1, 0, j - 1, 1, data1);
+
+ if (err != MUS_NO_ERROR) break;
+ if (reporting)
{
- mus_file_write(ofd0, 0, j - 1, 1, data0);
- mus_file_write(ofd1, 0, j - 1, 1, data1);
+ progress_report(cp0, (mus_float_t)((double)k / (double)dur));
+ if (ss->stopped_explicitly) break;
+ if ((cp0->active < CHANNEL_HAS_EDIT_LIST) ||
+ (cp1->active < CHANNEL_HAS_EDIT_LIST))
+ {
+ ss->stopped_explicitly = true;
+ break;
+ }
}
}
close_temp_file(ofile0, ofd0, hdr0->type, dur * datumb);
@@ -729,7 +722,7 @@ static void swap_channels(chan_info *cp0, chan_info *cp1, mus_long_t beg, mus_lo
}
else
{
- string_to_minibuffer(sp0, "swap interrupted");
+ set_status(sp0, "swap interrupted", false);
ss->stopped_explicitly = false;
}
if (ofile0) {free(ofile0); ofile0 = NULL;}
@@ -738,13 +731,11 @@ static void swap_channels(chan_info *cp0, chan_info *cp1, mus_long_t beg, mus_lo
}
else
{
- for (k = 0; k < dur; k++)
- {
- idata0[k] = read_sample_to_mus_sample(c1);
- idata1[k] = read_sample_to_mus_sample(c0);
- }
- change_samples(beg, dur, data0[0], cp0, S_swap_channels, cp0->edit_ctr);
- change_samples(beg, dur, data1[0], cp1, S_swap_channels, cp1->edit_ctr);
+ samples_to_vct_with_reader(dur, idata0, c1);
+ samples_to_vct_with_reader(dur, idata1, c0);
+
+ change_samples(beg, dur, data0[0], cp0, S_swap_channels, cp0->edit_ctr, -1.0);
+ change_samples(beg, dur, data1[0], cp1, S_swap_channels, cp1->edit_ctr, -1.0);
}
swap_marks(cp0, cp1);
update_graph(cp0);
@@ -760,6 +751,251 @@ static void swap_channels(chan_info *cp0, chan_info *cp1, mus_long_t beg, mus_lo
}
+/* -------- reverse-channel -------- */
+
+mus_float_t previous_sample_value_unscaled_and_unchecked(snd_fd *sf);
+mus_float_t previous_sample_value_unscaled(snd_fd *sf);
+mus_float_t previous_sample_value_unchecked(snd_fd *sf);
+
+static char *reverse_channel(chan_info *cp, snd_fd *sf, mus_long_t beg, mus_long_t dur, Xen edp, const char *caller, int arg_pos)
+{
+ snd_info *sp;
+ peak_env_info *ep = NULL;
+ file_info *hdr = NULL;
+ int ofd = 0, datumb = 0, edpos = 0;
+ bool section = false, temp_file;
+ mus_long_t k, alloc_len;
+ char *origin = NULL;
+ mus_float_t **data;
+ mus_float_t *idata;
+ char *ofile = NULL;
+ io_error_t io_err = IO_NO_ERROR;
+
+ if ((beg < 0) || (dur <= 0)) return(NULL);
+ if (!(is_editable(cp))) return(NULL);
+ /* if last was reverse and start/end match, we could just copy preceding edlist entry, or undo/redo etc --
+ * how to tell that this is happening?
+ */
+ sp = cp->sound;
+ edpos = to_c_edit_position(cp, edp, caller, arg_pos);
+
+ if (dur > cp->edits[edpos]->samples) dur = cp->edits[edpos]->samples;
+ if (dur > REPORTING_SIZE)
+ {
+ temp_file = true;
+ alloc_len = REPORTING_SIZE;
+ ofile = snd_tempnam();
+ hdr = make_temp_header(ofile, snd_srate(sp), 1, dur, caller);
+ ofd = open_temp_file(ofile, 1, hdr, &io_err);
+ if (ofd == -1)
+ {
+ char *str;
+ str = mus_format("%s %s temp file %s: %s\n",
+ (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
+ caller, ofile,
+ snd_open_strerror());
+ if (ofile) free(ofile);
+ return(str);
+ }
+ datumb = mus_bytes_per_sample(hdr->sample_type);
+ }
+ else
+ {
+ temp_file = false;
+ alloc_len = dur;
+ }
+
+ if ((beg == 0) && (dur == cp->edits[edpos]->samples))
+ ep = peak_env_copy(cp, true, edpos); /* true -> reversed */
+ else
+ {
+ ep = peak_env_copy(cp, false, edpos);
+ if (ep)
+ {
+ int i, j, sbin, ebin;
+ /* now reverse the selection */
+ sbin = (int)ceil(beg / ep->samps_per_bin);
+ ebin = (int)floor((beg + dur) / ep->samps_per_bin);
+ if (ebin > ep->peak_env_size) ebin = ep->peak_env_size;
+ for (i = sbin, j = ebin - 1; i < j; i++, j--)
+ {
+ mus_float_t min1, max1;
+ min1 = ep->data_min[i];
+ max1 = ep->data_max[i];
+ ep->data_min[i] = ep->data_min[j];
+ ep->data_max[i] = ep->data_max[j];
+ ep->data_min[j] = min1;
+ ep->data_max[j] = max1;
+ }
+ if (sbin > 0) pick_one_bin(ep, sbin - 1, ep->samps_per_bin * (sbin - 1), cp, edpos);
+ if (ebin < ep->peak_env_size) pick_one_bin(ep, ebin, ep->samps_per_bin * ebin, cp, edpos);
+ }
+ section = true; /* only for reverse_marks below */
+ }
+
+ sampler_set_safe(sf, dur);
+ data = (mus_float_t **)malloc(sizeof(mus_float_t *));
+ data[0] = (mus_float_t *)malloc(alloc_len * sizeof(mus_float_t));
+ idata = data[0];
+
+#if HAVE_FORTH
+ if (dur == cp->edits[edpos]->samples)
+ origin = mus_format("%lld" PROC_SEP PROC_FALSE " %s", beg, S_reverse_channel);
+ else origin = mus_format("%lld" PROC_SEP "%lld %s", beg, dur, S_reverse_channel);
+#else
+ if (dur == cp->edits[edpos]->samples)
+ origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP PROC_FALSE, to_proc_name(S_reverse_channel), beg);
+ else origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld", to_proc_name(S_reverse_channel), beg, dur);
+#endif
+
+ if (temp_file)
+ {
+ for (k = 0; k < dur; k += alloc_len)
+ {
+ int err;
+ mus_long_t kp, kdur;
+ kdur = dur - k;
+ if (kdur > alloc_len) kdur = alloc_len;
+ for (kp = 0; kp < kdur; kp++)
+ idata[kp] = read_sample(sf);
+ err = mus_file_write(ofd, 0, kdur - 1, 1, data);
+ if (err != MUS_NO_ERROR) break;
+ }
+ close_temp_file(ofile, ofd, hdr->type, dur * datumb);
+ hdr = free_file_info(hdr);
+ file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, origin, edpos);
+ if (ofile)
+ {
+ free(ofile);
+ ofile = NULL;
+ }
+ }
+ else
+ {
+ mus_long_t n;
+ if ((sf->runf == previous_sample_value_unscaled_and_unchecked) ||
+ ((sf->runf == previous_sample_value_unscaled) &&
+ (sf->loc - sf->first >= (dur - 1))))
+ {
+ for (n = sf->loc, k = 0; k < dur; k++, n--)
+ idata[k] = sf->data[n];
+ }
+ else
+ {
+ if (sf->runf == previous_sample_value_unchecked)
+ {
+ for (n = sf->loc, k = 0; k < dur; k++, n--)
+ idata[k] = sf->data[n] * sf->fscaler;
+ }
+ else
+ {
+ /* beg is begin time of the edit, not where the reverse read starts */
+ /* independent of sf, if edpos is 0, and saved_data is available, and beg+dur < saved_data length, just use it.
+ */
+ mus_float_t **d;
+ if ((sf->runf == previous_sample_value_unscaled) &&
+ (edpos == 0) &&
+ (beg + dur <= cp->edits[0]->samples) &&
+ (d = mus_sound_saved_data(sp->filename)))
+ {
+ mus_long_t d2;
+ mus_float_t *dc;
+
+ dc = d[cp->chan];
+ if (dur & 1) d2 = dur - 1; else d2 = dur;
+ for (n = beg + dur, k = 0; k < d2; )
+ {
+ idata[k++] = dc[n--];
+ idata[k++] = dc[n--];
+ }
+ if (k < dur) idata[k] = dc[n];
+ }
+ else
+ {
+ for (k = 0; k < dur; k++)
+ idata[k] = read_sample(sf);
+ }
+ }
+ }
+ change_samples(beg, dur, idata, cp, origin, edpos, -1.0);
+ }
+ if (ep) cp->edits[cp->edit_ctr]->peak_env = ep;
+ reverse_marks(cp, (section) ? beg : -1, dur);
+ update_graph(cp);
+ free(data[0]);
+ free(data);
+ if (origin) free(origin);
+ return(NULL);
+}
+
+
+void reverse_sound(chan_info *ncp, bool over_selection, Xen edpos, int arg_pos)
+{
+ sync_state *sc;
+ sync_info *si;
+ int i, stop_point = 0;
+ snd_fd **sfs;
+ char *caller;
+ snd_info *sp;
+ chan_info *cp;
+
+ sp = ncp->sound;
+ caller = (char *)((over_selection) ? S_reverse_selection : S_reverse_sound);
+ sc = get_sync_state(sp, ncp, 0, over_selection, READ_BACKWARD, edpos, (const char *)caller, arg_pos);
+ if (sc == NULL) return;
+ si = sc->si;
+ sfs = sc->sfs;
+
+ if (!(ss->stopped_explicitly))
+ {
+ for (i = 0; i < si->chans; i++)
+ {
+ char *errmsg = NULL;
+ mus_long_t dur;
+ cp = si->cps[i];
+ sp = cp->sound;
+ if (over_selection)
+ dur = sc->dur;
+ else dur = to_c_edit_samples(cp, edpos, caller, arg_pos);
+ if (dur == 0)
+ {
+ sfs[i] = free_snd_fd(sfs[i]);
+ continue;
+ }
+
+ errmsg = reverse_channel(cp, sfs[i], si->begs[i], dur, edpos, caller, arg_pos);
+
+ sfs[i] = free_snd_fd(sfs[i]);
+ if (errmsg)
+ {
+ snd_error_without_format(errmsg);
+ free(errmsg);
+ break;
+ }
+ if (ss->stopped_explicitly)
+ {
+ stop_point = i;
+ break;
+ }
+ }
+ }
+
+ if (ss->stopped_explicitly)
+ {
+ set_status(sp, "reverse stopped", false);
+ ss->stopped_explicitly = false;
+ for (i = 0; i <= stop_point; i++)
+ {
+ cp = si->cps[i];
+ undo_edit(cp, 1);
+ }
+ }
+ free_sync_state(sc);
+}
+
+
+
+
/* -------- src -------- */
typedef struct {
@@ -784,7 +1020,22 @@ static mus_float_t src_input_as_needed(void *arg, int direction)
}
-static src_state *make_src(mus_float_t srate, snd_fd *sf)
+static mus_float_t src_input_as_needed_unchanged(void *arg, int direction)
+{
+ src_state *sr = (src_state *)arg;
+ sr->sample++;
+ return(read_sample(sr->sf));
+}
+
+
+static mus_float_t read_sample_input(void *arg, int direction)
+{
+ src_state *sr = (src_state *)arg;
+ return(read_sample(sr->sf));
+}
+
+
+static src_state *make_src(mus_float_t srate, snd_fd *sf, bool src_change)
{
src_state *sr;
if ((sinc_width(ss) > MUS_MAX_CLM_SINC_WIDTH) ||
@@ -794,7 +1045,9 @@ static src_state *make_src(mus_float_t srate, snd_fd *sf)
sr = (src_state *)calloc(1, sizeof(src_state));
sr->sf = sf;
if (srate >= 0.0) sr->dir = 1; else sr->dir = -1; /* if env on src, this will be 0.0 even if env vals are < 0.0 */
- sr->gen = mus_make_src(&src_input_as_needed, srate, sinc_width(ss), (void *)sr);
+ if (src_change)
+ sr->gen = mus_make_src(&src_input_as_needed, srate, sinc_width(ss), (void *)sr);
+ else sr->gen = mus_make_src(&src_input_as_needed_unchanged, srate, sinc_width(ss), (void *)sr);
mus_set_increment(sr->gen, srate);
sr->sample = 0;
return(sr);
@@ -819,8 +1072,8 @@ static int mus_long_t_compare(const void *a, const void *b)
return(1);
}
-static char *reverse_channel(chan_info *cp, snd_fd *sf, mus_long_t beg, mus_long_t dur, XEN edp, const char *caller, int arg_pos);
+mus_float_t next_sample_value_unscaled_and_unchecked(snd_fd *sf);
static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, mus_long_t dur, mus_float_t ratio, mus_any *egen,
const char *origin, bool over_selection,
@@ -829,46 +1082,47 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
snd_info *sp = NULL;
bool reporting = false;
bool full_chan;
- mus_sample_t **data;
+ mus_float_t **data;
file_info *hdr = NULL;
int j, ofd = 0, datumb = 0, err = 0;
mus_long_t *old_marks = NULL, *new_marks = NULL;
- int cur_marks = 0, m;
+ int cur_marks = 0;
mus_long_t k;
char *ofile = NULL;
- mus_sample_t *idata;
+ mus_float_t *idata;
io_error_t io_err = IO_NO_ERROR;
src_state *sr;
+ /* fprintf(stderr, "src: %lld %f %s\n", dur, ratio, origin); */
+
if ((egen == NULL) && (sf->edit_ctr == cp->edit_ctr))
{
if (ratio == 1.0)
return(NULL);
if (ratio == -1.0)
- return(reverse_channel(cp, sf, beg, dur, C_TO_XEN_INT(sf->edit_ctr), origin, 0));
+ return(reverse_channel(cp, sf, beg, dur, C_int_to_Xen_integer(sf->edit_ctr), origin, 0));
}
sp = cp->sound;
- if (!(editable_p(cp))) return(NULL); /* edit hook result perhaps */
-
- sr = make_src(ratio, sf); /* ratio is 0.0 if egen because the envelope is the srate, but it's passed as the "sr-change" arg */
- if ((egen) &&
- (mus_phase(egen) < 0.0))
- sr->dir = -1;
+ if (!(is_editable(cp))) return(NULL); /* edit hook result perhaps */
+ sr = make_src(ratio, sf, egen); /* ratio is 0.0 if egen because the envelope is the srate, but it's passed as the "sr-change" arg */
if (sr == NULL)
{
(*clm_err) = true;
return(mus_format("invalid src ratio: %f\n", ratio));
}
+ if ((egen) &&
+ (mus_phase(egen) < 0.0))
+ sr->dir = -1;
- full_chan = ((beg == 0) && (dur == cp->edits[sf->edit_ctr]->samples)); /* not CURRENT_SAMPLES here! */
+ full_chan = ((beg == 0) && (dur == cp->edits[sf->edit_ctr]->samples)); /* not current_samples here! */
reporting = ((sp) && (dur > REPORTING_SIZE) && (!(cp->squelch_update)));
if (reporting) start_progress_report(cp);
ofile = snd_tempnam();
- hdr = make_temp_header(ofile, SND_SRATE(sp), 1, dur, (char *)origin);
+ hdr = make_temp_header(ofile, snd_srate(sp), 1, dur, (char *)origin);
ofd = open_temp_file(ofile, 1, hdr, &io_err);
if (ofd == -1)
{
@@ -878,52 +1132,64 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
snd_open_strerror()));
}
- data = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- data[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
- datumb = mus_bytes_per_sample(hdr->format);
- idata = data[0];
+ data = (mus_float_t **)malloc(sizeof(mus_float_t *));
+ datumb = mus_bytes_per_sample(hdr->sample_type);
+
j = 0;
ss->stopped_explicitly = false;
if (egen == NULL)
{
- if ((ratio == 0.5) || (ratio == 2.0)) /* read forward is built-in in the mus_src_20 (7176) and mus_src_05 cases */
+ if ((ratio == 0.5) && (dur < (1 << 22)))
{
- for (k = 0; sr->sample < dur; k++)
+ mus_long_t in_dur, swid2;
+ mus_float_t *in_data;
+
+ swid2 = 2 * sinc_width(ss);
+ in_dur = dur + 4 + swid2;
+ in_data = (mus_float_t *)calloc(in_dur, sizeof(mus_float_t));
+ samples_to_vct_with_reader(in_dur - swid2, (mus_float_t *)(in_data + swid2), sf);
+ data[0] = mus_src_05(sr->gen, in_data, dur);
+ k = dur * 2 + 1;
+ j = k;
+ free(in_data);
+ }
+ else
+ {
+ if ((ratio == 2.0) && (dur < (1 << 23)))
{
- if (ratio == 2.0)
- idata[j] = (MUS_FLOAT_TO_SAMPLE(mus_src_20(sr->gen, &src_input_as_needed)));
- else idata[j] = (MUS_FLOAT_TO_SAMPLE(mus_src_05(sr->gen, &src_input_as_needed)));
- j++;
- if (j == MAX_BUFFER_SIZE)
- {
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
- if (reporting)
- {
- progress_report(cp, (mus_float_t)((double)(sr->sample) / (double)dur));
- if (ss->stopped_explicitly) break;
- if (!(sp->active))
- {
- ss->stopped_explicitly = true;
- break;
- }
- }
- }
+ /* make and fill input data, make output data, pass mus_src_20 the input data array, new dur, and sr->gen
+ */
+ mus_long_t in_dur, swid2;
+ mus_float_t *in_data;
+
+ swid2 = 2 * sinc_width(ss);
+ in_dur = dur + 4 + swid2;
+ in_data = (mus_float_t *)calloc(in_dur, sizeof(mus_float_t));
+ samples_to_vct_with_reader(in_dur - swid2, (mus_float_t *)(in_data + swid2), sf);
+ data[0] = mus_src_20(sr->gen, in_data, dur);
+ k = dur / 2 + 1;
+ if ((dur & 1) != 0) k++; /* ?? */
+ j = k;
+ free(in_data);
}
- }
- else
- {
- for (k = 0; sr->sample < dur; k++) /* sr->sample tracks input location -- produce output until input exhausted */
+ else
{
- idata[j] = (MUS_FLOAT_TO_SAMPLE(mus_src(sr->gen, 0.0, &src_input_as_needed)));
- j++;
- if (j == MAX_BUFFER_SIZE)
+ mus_long_t out_dur;
+
+ data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
+ idata = data[0];
+ out_dur = ceil(dur / fabs(ratio)) + 1;
+
+ for (k = 0; k < out_dur; k += MAX_BUFFER_SIZE)
{
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
+ mus_long_t kdur;
+ kdur = out_dur - k;
+ if (kdur > MAX_BUFFER_SIZE) kdur = MAX_BUFFER_SIZE;
+ mus_src_to_buffer(sr->gen, &read_sample_input, idata, kdur);
+
+ err = mus_file_write(ofd, 0, kdur - 1, 1, data);
+ if (err != MUS_NO_ERROR) break;
if (reporting)
{
progress_report(cp, (mus_float_t)((double)(sr->sample) / (double)dur));
@@ -935,16 +1201,21 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
}
}
}
+ j = 0;
+ k = out_dur;
}
}
}
else
{
mus_long_t next_pass;
- mus_long_t cur_mark_sample = -1;
+ mus_long_t cur_mark_sample;
int cur_mark = 0, cur_new_mark = 0;
mus_float_t env_val;
+ data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
+ idata = data[0];
+
cur_mark_sample = -1;
env_val = mus_env(egen);
/* envelope case -- have to go by sr->sample, not output sample counter, also check marks */
@@ -952,6 +1223,7 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
if ((cp->edits[cp->edit_ctr]->marks) &&
(cp->edits[cp->edit_ctr]->mark_ctr >= 0))
{
+ int m;
mark **mps;
mps = cp->edits[cp->edit_ctr]->marks;
cur_marks = cp->edits[cp->edit_ctr]->mark_ctr + 1;
@@ -987,13 +1259,13 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
next_pass = sr->sample;
for (k = 0; sr->sample < dur; k++)
{
- idata[j] = (MUS_FLOAT_TO_SAMPLE(mus_src(sr->gen, env_val, &src_input_as_needed)));
+ idata[j] = ((mus_src(sr->gen, env_val, &src_input_as_needed)));
j++;
if (j == MAX_BUFFER_SIZE)
{
err = mus_file_write(ofd, 0, j - 1, 1, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
if (reporting)
{
progress_report(cp, (mus_float_t)((double)(sr->sample) / (double)dur));
@@ -1022,7 +1294,8 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
cur_mark_sample = old_marks[cur_mark];
else cur_mark_sample = -1;
}
- for (jj = 0; jj < idiff; jj++)
+ env_val = mus_env(egen);
+ for (jj = 1; jj < idiff; jj++)
env_val = mus_env(egen);
}
}
@@ -1032,6 +1305,7 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
sr = free_src(sr);
if ((!(ss->stopped_explicitly)) && (j > 0))
mus_file_write(ofd, 0, j - 1, 1, data);
+
close_temp_file(ofile, ofd, hdr->type, k * datumb);
hdr = free_file_info(hdr);
@@ -1044,12 +1318,12 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
#if HAVE_FORTH
if (dur == cp->edits[sf->edit_ctr]->samples)
- new_origin = mus_format("%.4f" PROC_SEP MUS_LD PROC_SEP PROC_FALSE " %s", ratio, beg, S_src_channel);
- else new_origin = mus_format("%.4f" PROC_SEP MUS_LD PROC_SEP MUS_LD " %s", ratio, beg, dur, S_src_channel);
+ new_origin = mus_format("%.4f" PROC_SEP "%lld" PROC_SEP PROC_FALSE " %s", ratio, beg, S_src_channel);
+ else new_origin = mus_format("%.4f" PROC_SEP "%lld" PROC_SEP "%lld %s", ratio, beg, dur, S_src_channel);
#else
if (dur == cp->edits[sf->edit_ctr]->samples)
- new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP MUS_LD PROC_SEP PROC_FALSE, TO_PROC_NAME(S_src_channel), ratio, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(S_src_channel), ratio, beg, dur);
+ new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP "%lld" PROC_SEP PROC_FALSE, to_proc_name(S_src_channel), ratio, beg);
+ else new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_src_channel), ratio, beg, dur);
#endif
}
else
@@ -1065,19 +1339,19 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
if (base == 1.0)
{
if (dur == cp->edits[sf->edit_ctr]->samples)
- new_origin = mus_format("%s" PROC_SEP MUS_LD PROC_SEP PROC_FALSE " %s", envstr, beg, S_src_channel);
- else new_origin = mus_format("%s" PROC_SEP MUS_LD PROC_SEP MUS_LD " %s", envstr, beg, dur, S_src_channel);
+ new_origin = mus_format("%s" PROC_SEP "%lld" PROC_SEP PROC_FALSE " %s", envstr, beg, S_src_channel);
+ else new_origin = mus_format("%s" PROC_SEP "%lld" PROC_SEP "%lld %s", envstr, beg, dur, S_src_channel);
}
- else new_origin = mus_format("%s :base %.4f :end " MUS_LD " %s " MUS_LD PROC_SEP MUS_LD " %s", envstr, base, dur, S_make_env, beg, dur, S_src_channel);
+ else new_origin = mus_format("%s :base %.4f :end %lld %s %lld" PROC_SEP "%lld %s", envstr, base, dur, S_make_env, beg, dur, S_src_channel);
#else
if (base == 1.0)
{
if (dur == cp->edits[sf->edit_ctr]->samples)
- new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP MUS_LD PROC_SEP PROC_FALSE, TO_PROC_NAME(S_src_channel), envstr, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(S_src_channel), envstr, beg, dur);
+ new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%lld" PROC_SEP PROC_FALSE, to_proc_name(S_src_channel), envstr, beg);
+ else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_src_channel), envstr, beg, dur);
}
- else new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP MUS_LD ")" PROC_SEP MUS_LD PROC_SEP MUS_LD,
- TO_PROC_NAME(S_make_env), TO_PROC_NAME(S_src_channel), envstr, base, dur, beg, dur);
+ else new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP "%lld)" PROC_SEP "%lld" PROC_SEP "%lld",
+ to_proc_name(S_make_env), to_proc_name(S_src_channel), envstr, base, dur, beg, dur);
#endif
if (envstr) free(envstr);
free_env(newe);
@@ -1144,7 +1418,7 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
}
else
{
- string_to_minibuffer(sp, "src interrupted");
+ set_status(sp, "src interrupted", false);
/* should we remove the temp file here? */
ss->stopped_explicitly = false;
}
@@ -1162,7 +1436,7 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
void src_env_or_num(chan_info *cp, env *e, mus_float_t ratio, bool just_num,
- const char *origin, bool over_selection, mus_any *gen, XEN edpos, int arg_pos)
+ const char *origin, bool over_selection, mus_any *gen, Xen edpos, int arg_pos)
{
snd_info *sp = NULL;
sync_state *sc;
@@ -1207,7 +1481,7 @@ void src_env_or_num(chan_info *cp, env *e, mus_float_t ratio, bool just_num,
if (!just_num)
{
if (e)
- egen = mus_make_env_with_length(e->data, e->pts, 1.0, 0.0, e->base, dur);
+ egen = mus_make_env(e->data, e->pts, 1.0, 0.0, e->base, 0.0, dur - 1, NULL);
else egen = gen;
if (egen) ratio = 0.0; /* added 14-Mar-01 otherwise the envelope is an offset? */
}
@@ -1255,44 +1529,46 @@ void src_file(const char *file, double ratio)
mus_any **rds, **srcs;
char *temp_out;
const char *comment;
- int k, chan, chans, width, out_fd, data_format, header_type, buffer_size;
+ int k, chan, chans, width, out_fd, buffer_size;
+ mus_sample_t sample_type;
+ mus_header_t header_type;
mus_long_t samp, old_samps, new_samps;
mus_float_t old_srate, new_srate;
- mus_sample_t **obufs;
+ mus_float_t **obufs;
old_srate = mus_srate();
new_srate = mus_sound_srate(file); /* need have no connection with previous CLM srate setting */
mus_set_srate(new_srate);
chans = mus_sound_chans(file);
- data_format = mus_sound_data_format(file);
+ sample_type = mus_sound_sample_type(file);
header_type = mus_sound_header_type(file);
comment = mus_sound_comment(file);
buffer_size = mus_file_buffer_size();
- old_samps = mus_sound_frames(file);
+ old_samps = mus_sound_framples(file);
new_samps = old_samps / ratio; /* old-srate/new-srate in-coming */
width = sinc_width(ss);
if (width < 32) width = 32;
temp_out = snd_tempnam();
- out_fd = mus_sound_open_output(temp_out, new_srate, chans, data_format, header_type, comment);
+ out_fd = mus_sound_open_output(temp_out, new_srate, chans, sample_type, header_type, comment);
srcs = (mus_any **)malloc(chans * sizeof(mus_any *));
rds = (mus_any **)malloc(chans * sizeof(mus_any *));
- obufs = (mus_sample_t **)malloc(chans * sizeof(mus_sample_t *));
+ obufs = (mus_float_t **)malloc(chans * sizeof(mus_float_t *));
for (chan = 0; chan < chans; chan++)
{
rds[chan] = mus_make_readin(file, chan, 0, 1);
srcs[chan] = mus_make_src(NULL, ratio, width, (void *)rds[chan]);
- obufs[chan] = (mus_sample_t *)malloc(buffer_size * sizeof(mus_sample_t));
+ obufs[chan] = (mus_float_t *)malloc(buffer_size * sizeof(mus_float_t));
}
for (k = 0, samp = 0; samp < new_samps; samp++)
{
for (chan = 0; chan < chans; chan++)
- obufs[chan][k] = MUS_FLOAT_TO_SAMPLE(mus_src(srcs[chan], 0.0, &input_as_needed));
+ obufs[chan][k] = (mus_src(srcs[chan], 0.0, &input_as_needed));
k++;
if (k == buffer_size)
{
@@ -1303,7 +1579,7 @@ void src_file(const char *file, double ratio)
if (k > 0)
mus_sound_write(out_fd, 0, k - 1, chans, obufs);
- mus_sound_close_output(out_fd, new_samps * chans * mus_bytes_per_sample(data_format));
+ mus_sound_close_output(out_fd, new_samps * chans * mus_bytes_per_sample(sample_type));
mus_sound_forget(file);
for (chan = 0; chan < chans; chan++)
@@ -1333,7 +1609,7 @@ static mus_float_t *get_filter_coeffs(int order, env *e)
/* get the frequency envelope and design the FIR filter */
fdata = sample_linear_env(e, order);
if (!fdata) return(NULL);
- a = (mus_float_t *)calloc(order, sizeof(mus_float_t));
+ a = (mus_float_t *)calloc(order + 1, sizeof(mus_float_t));
mus_make_fir_coeffs(order, fdata, a);
@@ -1362,10 +1638,9 @@ void display_frequency_response(env *e, axis_info *ap, graphics_context *gax, in
invpts = 1.0 / (mus_float_t)pts;
samps_per_pixel = (mus_float_t)(ap->x_axis_x1 - ap->x_axis_x0) * invpts;
- x1 = ap->x_axis_x0;
coeffs = get_filter_coeffs(order, e);
-
if (!coeffs) return;
+
fsize = 2 * snd_to_int_pow2((pts > order) ? pts : order); /* *2 for 1/2 frqs */
rl = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
im = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
@@ -1407,28 +1682,31 @@ static char *clm_channel(chan_info *cp, mus_any *gen, mus_long_t beg, mus_long_t
/* calls gen over cp[beg for dur] data, replacing. */
snd_info *sp;
file_info *hdr = NULL;
- int j, ofd = 0, datumb = 0, err = 0;
+ int j = 0, ofd = 0, datumb = 0;
bool temp_file;
- mus_long_t k;
- mus_sample_t **data;
- mus_sample_t *idata;
+ mus_long_t k, alloc_len;
+ mus_float_t **data;
+ mus_float_t *idata;
char *ofile = NULL;
snd_fd *sf;
+ mus_float_t (*runf)(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
if ((beg < 0) || ((dur + overlap) <= 0)) return(NULL);
sp = cp->sound;
- if (!(editable_p(cp))) return(NULL);
+ if (!(is_editable(cp))) return(NULL);
sf = init_sample_read_any(beg, cp, READ_FORWARD, edpos);
if (sf == NULL)
return(mus_format("%s can't read %s[%d] channel data!", S_clm_channel, sp->short_filename, cp->chan));
+ runf = mus_run_function(gen);
- if ((dur + overlap) > MAX_BUFFER_SIZE)
+ if ((dur + overlap) > REPORTING_SIZE)
{
io_error_t io_err = IO_NO_ERROR;
+ alloc_len = REPORTING_SIZE;
temp_file = true;
ofile = snd_tempnam();
- hdr = make_temp_header(ofile, SND_SRATE(sp), 1, dur + overlap, S_clm_channel);
+ hdr = make_temp_header(ofile, snd_srate(sp), 1, dur + overlap, S_clm_channel);
ofd = open_temp_file(ofile, 1, hdr, &io_err);
if (ofd == -1)
{
@@ -1438,44 +1716,55 @@ static char *clm_channel(chan_info *cp, mus_any *gen, mus_long_t beg, mus_long_t
S_clm_channel, ofile,
snd_open_strerror()));
}
- datumb = mus_bytes_per_sample(hdr->format);
+ datumb = mus_bytes_per_sample(hdr->sample_type);
}
- else temp_file = false;
- data = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- data[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
+ else
+ {
+ temp_file = false;
+ alloc_len = dur + overlap;
+ }
+
+ data = (mus_float_t **)malloc(sizeof(mus_float_t *));
+ data[0] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
idata = data[0];
+
if (temp_file)
{
- j = 0;
- for (k = 0; k < dur; k++)
+ sampler_set_safe(sf, dur);
+ for (k = 0; k < dur; k += alloc_len)
{
- idata[j++] = MUS_FLOAT_TO_SAMPLE(MUS_RUN(gen, read_sample(sf), 0.0));
- if (j == MAX_BUFFER_SIZE)
- {
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
- }
+ int n, err;
+ j = dur - k;
+ if (j > alloc_len) j = alloc_len;
+
+ for (n = 0; n < j; n++)
+ idata[n] = runf(gen, read_sample(sf), 0.0);
+
+ err = mus_file_write(ofd, 0, j - 1, 1, data);
+ j = 0;
+ if (err != MUS_NO_ERROR) break;
}
}
else
{
+ samples_to_vct_with_reader(dur, idata, sf);
for (k = 0; k < dur; k++)
- idata[k] = MUS_FLOAT_TO_SAMPLE(MUS_RUN(gen, read_sample(sf), 0.0));
+ idata[k] = runf(gen, idata[k], 0.0);
j = (int)dur;
}
- for (k = 0; k < overlap; k++)
+
+ if (overlap > 0)
{
- idata[j++] = MUS_FLOAT_TO_SAMPLE(MUS_RUN(gen, 0.0, 0.0) + read_sample(sf));
- if ((temp_file) && (j == MAX_BUFFER_SIZE))
- {
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
- }
+ snd_fd *fd;
+ fd = init_sample_read_any_with_bufsize(beg + dur, cp, READ_FORWARD, edpos, overlap);
+ for (k = 0; k < overlap; k++)
+ idata[j++] = runf(gen, 0.0, 0.0) + read_sample(fd);
+ free_snd_fd(fd);
+ dur += overlap;
}
- dur += overlap;
+
sf = free_snd_fd(sf);
+
if (temp_file)
{
if (j > 0) mus_file_write(ofd, 0, j - 1, 1, data);
@@ -1491,7 +1780,7 @@ static char *clm_channel(chan_info *cp, mus_any *gen, mus_long_t beg, mus_long_t
else
{
if (dur > 0)
- change_samples(beg, dur, idata, cp, origin, edpos);
+ change_samples(beg, dur, idata, cp, origin, edpos, -1.0);
}
update_graph(cp);
free(data[0]);
@@ -1508,18 +1797,19 @@ static mus_float_t convolve_next_sample(void *ptr, int dir)
}
+
static char *convolution_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_long_t beg, mus_long_t dur,
const char *origin, mus_float_t *precalculated_coeffs)
{
snd_info *sp;
file_info *hdr = NULL;
- int j, ofd = 0, datumb = 0, err = 0;
+ int ofd = 0, datumb = 0;
char *ofile = NULL;
int fsize;
mus_float_t *fltdat = NULL;
io_error_t io_err = IO_NO_ERROR;
- if (!(editable_p(cp))) return(NULL);
+ if (!(is_editable(cp))) return(NULL);
sp = cp->sound;
dur += order;
@@ -1528,16 +1818,16 @@ static char *convolution_filter(chan_info *cp, int order, env *e, snd_fd *sf, mu
else fsize = TWO_30;
ofile = snd_tempnam();
- hdr = make_temp_header(ofile, SND_SRATE(sp), 1, dur, (char *)origin);
+ hdr = make_temp_header(ofile, snd_srate(sp), 1, dur, (char *)origin);
#if MUS_LITTLE_ENDIAN
if (sizeof(mus_float_t) == 4)
- hdr->format = MUS_LFLOAT;
- else hdr->format = MUS_LDOUBLE;
+ hdr->sample_type = MUS_LFLOAT;
+ else hdr->sample_type = MUS_LDOUBLE;
#else
if (sizeof(mus_float_t) == 4)
- hdr->format = MUS_BFLOAT;
- else hdr->format = MUS_BDOUBLE;
+ hdr->sample_type = MUS_BFLOAT;
+ else hdr->sample_type = MUS_BDOUBLE;
#endif
ofd = open_temp_file(ofile, 1, hdr, &io_err);
@@ -1554,41 +1844,50 @@ static char *convolution_filter(chan_info *cp, int order, env *e, snd_fd *sf, mu
/* set up convolution generator and run overlap-add in order-sized blocks */
bool reporting;
mus_any *gen;
- mus_sample_t **data;
- mus_sample_t *idata;
- mus_long_t offk;
+ mus_float_t **data;
+ mus_float_t *idata;
+ mus_long_t alloc_len;
+ int j;
reporting = ((sp) && (dur > REPORTING_SIZE) && (!(cp->squelch_update)));
if (order == 0) order = 65536; /* presumably fsize is enormous here, so no MIN needed */
- if (!(POWER_OF_2_P(order)))
+ if (!(is_power_of_2(order)))
order = snd_to_int_pow2(order);
fsize = 2 * order; /* need room for convolution */
if (precalculated_coeffs)
fltdat = precalculated_coeffs;
else fltdat = get_filter_coeffs(order, e);
- gen = mus_make_convolve(NULL, fltdat, fsize, order, (void *)sf);
+ gen = mus_make_convolve(convolve_next_sample, fltdat, fsize, order, (void *)sf);
- j = 0;
- data = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- data[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
+ if (dur > MAX_BUFFER_SIZE)
+ alloc_len = MAX_BUFFER_SIZE;
+ else alloc_len = dur;
+
+ data = (mus_float_t **)malloc(sizeof(mus_float_t *));
+ data[0] = (mus_float_t *)malloc(alloc_len * sizeof(mus_float_t));
idata = data[0];
+
if (reporting) start_progress_report(cp);
ss->stopped_explicitly = false;
- for (offk = 0; offk < dur; offk++)
+ if (alloc_len == dur)
{
- mus_float_t x;
-
- x = mus_convolve(gen, convolve_next_sample);
-
- idata[j] = MUS_FLOAT_TO_SAMPLE(x);
- j++;
- if (j == MAX_BUFFER_SIZE)
+ for (j = 0; j < dur; j++)
+ idata[j] = mus_convolve(gen, NULL);
+ mus_file_write(ofd, 0, dur - 1, 1, data);
+ }
+ else
+ {
+ mus_long_t offk;
+ for (offk = 0; offk < dur; offk += alloc_len)
{
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
+ mus_long_t kdur;
+ kdur = dur - offk;
+ if (kdur > alloc_len) kdur = alloc_len;
+ for (j = 0; j < kdur; j++)
+ idata[j] = mus_convolve(gen, NULL);
+ mus_file_write(ofd, 0, kdur - 1, 1, data);
if (reporting)
{
progress_report(cp, (mus_float_t)((double)offk / (double)dur));
@@ -1602,14 +1901,12 @@ static char *convolution_filter(chan_info *cp, int order, env *e, snd_fd *sf, mu
}
}
if (reporting) finish_progress_report(cp);
- if ((j > 0) && (!(ss->stopped_explicitly)))
- mus_file_write(ofd, 0, j - 1, 1, data);
close_temp_file(ofile, ofd, hdr->type, dur * datumb);
if (!(ss->stopped_explicitly))
file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, origin, sf->edit_ctr);
else
{
- string_to_minibuffer(sp, "filter interrupted");
+ set_status(sp, "filter interrupted", false);
ss->stopped_explicitly = false;
}
mus_free(gen);
@@ -1632,9 +1929,7 @@ static char *convolution_filter(chan_info *cp, int order, env *e, snd_fd *sf, mu
sndrdat = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
sndidat = (mus_float_t *)calloc(fsize, sizeof(mus_float_t));
- for (k = 0; k < dur; k++)
- sndrdat[k] = (mus_float_t)(read_sample(sf));
-
+ samples_to_vct_with_reader(dur, sndrdat, sf);
mus_fft(sndrdat, sndidat, fsize, 1);
scale = 1.0 / (mus_float_t)fsize;
for (k = 0; k < fsize; k++)
@@ -1650,7 +1945,7 @@ static char *convolution_filter(chan_info *cp, int order, env *e, snd_fd *sf, mu
close_temp_file(ofile, ofd, hdr->type, fsize * sizeof(mus_float_t));
if (bytes != 0)
file_change_samples(beg, dur + order, ofile, cp, 0, DELETE_ME, origin, sf->edit_ctr);
- else string_to_minibuffer(sp, "can't write data?");
+ else set_status(sp, "can't write data?", false);
free(sndrdat);
free(sndidat);
@@ -1673,22 +1968,22 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
const char *origin, bool truncate,
bool over_selection, mus_any *gen, mus_float_t *precalculated_coeffs)
{
- mus_float_t *a = NULL, *d = NULL;
- mus_float_t x = 0.0;
+ mus_float_t *fcoeffs = NULL;
snd_info *sp;
bool reporting = false;
- int m;
mus_long_t offk;
file_info *hdr = NULL;
int j = 0, ofd = 0, datumb = 0, err = 0;
bool temp_file;
char *new_origin = NULL;
- mus_sample_t **data;
- mus_sample_t *idata;
+ mus_float_t **data;
+ mus_float_t *idata;
char *ofile = NULL;
io_error_t io_err = IO_NO_ERROR;
-
- if (!(editable_p(cp))) return(NULL);
+ mus_any *g = NULL;
+ mus_float_t (*runf)(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
+
+ if (!(is_editable(cp))) return(NULL);
sp = cp->sound;
if ((!over_selection) || (!truncate))
dur += order;
@@ -1696,11 +1991,23 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
reporting = ((sp) && (dur > REPORTING_SIZE) && (!(cp->squelch_update)));
if (reporting) start_progress_report(cp);
+ if (!gen)
+ {
+ if (precalculated_coeffs)
+ fcoeffs = precalculated_coeffs;
+ else
+ {
+ if (order & 1) order++;
+ fcoeffs = get_filter_coeffs(order, e);
+ if (!fcoeffs) return(NULL);
+ }
+ }
+
if (dur > MAX_BUFFER_SIZE)
{
temp_file = true;
ofile = snd_tempnam();
- hdr = make_temp_header(ofile, SND_SRATE(sp), 1, dur, (char *)origin);
+ hdr = make_temp_header(ofile, snd_srate(sp), 1, dur, (char *)origin);
ofd = open_temp_file(ofile, 1, hdr, &io_err);
if (ofd == -1)
{
@@ -1709,28 +2016,27 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
origin, ofile,
snd_open_strerror()));
}
- datumb = mus_bytes_per_sample(hdr->format);
+ datumb = mus_bytes_per_sample(hdr->sample_type);
}
else temp_file = false;
- data = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- data[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
+ data = (mus_float_t **)malloc(sizeof(mus_float_t *));
+ data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
idata = data[0];
- if (precalculated_coeffs)
- a = precalculated_coeffs;
- else
+
+ sampler_set_safe(sf, dur);
+
+ if (gen)
{
- if (order & 1) order++;
- a = get_filter_coeffs(order, e);
+ mus_reset(gen);
+ g = gen;
}
- d = (mus_float_t *)calloc(order, sizeof(mus_float_t));
- if (gen)
- mus_reset(gen);
else
{
- for (m = 0; m < order; m++) d[m] = 0.0;
+ g = mus_make_fir_filter(order, fcoeffs, NULL);
if (over_selection)
{
+ int m;
mus_long_t prebeg = 0;
/* see if there's data to pre-load the filter */
if (beg >= order)
@@ -1738,72 +2044,30 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
else prebeg = beg;
if (prebeg > 0)
for (m = (int)prebeg; m > 0; m--)
- d[m] = read_sample(sf);
+ mus_fir_filter(g, read_sample(sf));
}
}
if ((over_selection) && (!truncate))
dur -= order;
- if (!temp_file)
- {
- if (gen)
- {
- for (j = 0; j < dur; j++)
- idata[j] = MUS_FLOAT_TO_SAMPLE(MUS_RUN(gen, read_sample(sf), 0.0));
- }
- else
- {
- /* splitting out symmetric case did not speed up this loop appreciably */
- /* and using memmove for the "state" changes slowed it down by a factor of 2! */
- for (j = 0; j < dur; j++)
- {
- mus_float_t *ap, *dp, *dprev;
- ap = (mus_float_t *)(a + order - 1);
- dp = (mus_float_t *)(d + order - 1);
+ runf = mus_run_function(g);
- d[0] = read_sample(sf);
- x = d[0] * a[0];
-
- while (dp > d)
- {
- x += (*dp) * (*ap--);
- dprev = dp--;
- (*dprev) = (*dp);
- }
- idata[j] = MUS_FLOAT_TO_SAMPLE(x);
- }
- }
+ if (!temp_file)
+ {
+ for (j = 0; j < dur; j++)
+ idata[j] = runf(g, read_sample(sf), 0.0);
}
else
{
for (offk = 0; offk < dur; offk++)
{
- if (gen)
- x = MUS_RUN(gen, read_sample(sf), 0.0);
- else
- {
- mus_float_t *ap, *dp, *dprev;
-
- ap = (mus_float_t *)(a + order - 1);
- dp = (mus_float_t *)(d + order - 1);
-
- d[0] = read_sample(sf);
- x = d[0] * a[0];
-
- while (dp > d)
- {
- x += (*dp) * (*ap--);
- dprev = dp--;
- (*dprev) = (*dp);
- }
- }
- idata[j] = MUS_FLOAT_TO_SAMPLE(x);
+ idata[j] = runf(g, read_sample(sf), 0.0);
j++;
if (j == MAX_BUFFER_SIZE)
{
err = mus_file_write(ofd, 0, j - 1, 1, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
if (reporting)
{
progress_report(cp, (mus_float_t)((double)offk / (double)dur));
@@ -1824,32 +2088,13 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
sfold = init_sample_read_any(beg + dur, cp, READ_FORWARD, sf->edit_ctr);
for (offk = 0; offk < order; offk++)
{
- if (gen)
- x = MUS_RUN(gen, read_sample(sf), 0.0);
- else
- {
- mus_float_t *ap, *dp, *dprev;
-
- ap = (mus_float_t *)(a + order - 1);
- dp = (mus_float_t *)(d + order - 1);
-
- d[0] = read_sample(sf);
- x = d[0] * a[0];
-
- while (dp > d)
- {
- x += (*dp) * (*ap--);
- dprev = dp--;
- (*dprev) = (*dp);
- }
- }
- idata[j] = MUS_FLOAT_TO_SAMPLE(x + read_sample(sfold));
+ idata[j] = runf(g, read_sample(sf), 0.0) + read_sample(sfold);
j++;
if ((temp_file) && (j == MAX_BUFFER_SIZE))
{
err = mus_file_write(ofd, 0, j - 1, 1, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
}
dur += order;
@@ -1866,24 +2111,25 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
vct *v;
char *vstr = NULL;
- v = (vct *)calloc(1, sizeof(vct));
- v->length = order;
- v->data = precalculated_coeffs;
+ v = mus_vct_wrap(order, precalculated_coeffs);
vstr = mus_vct_to_readable_string(v);
#if HAVE_FORTH
if (dur == (order + cp->edits[sf->edit_ctr]->samples))
- new_origin = mus_format("%s %d " MUS_LD PROC_SEP PROC_FALSE " %s", vstr, order, beg, S_filter_channel);
- else new_origin = mus_format("%s %d " MUS_LD PROC_SEP MUS_LD " %s", vstr, order, beg, dur, S_filter_channel);
+ new_origin = mus_format("%s %d %lld" PROC_SEP PROC_FALSE " %s", vstr, order, beg, S_filter_channel);
+ else new_origin = mus_format("%s %d %lld" PROC_SEP "%lld %s", vstr, order, beg, dur, S_filter_channel);
#else
if (dur == (order + cp->edits[sf->edit_ctr]->samples))
- new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP MUS_LD PROC_SEP PROC_FALSE,
- TO_PROC_NAME(S_filter_channel), vstr, order, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP MUS_LD PROC_SEP MUS_LD,
- TO_PROC_NAME(S_filter_channel), vstr, order, beg, dur);
+ new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ to_proc_name(S_filter_channel), vstr, order, beg);
+ else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%lld" PROC_SEP "%lld",
+ to_proc_name(S_filter_channel), vstr, order, beg, dur);
#endif
+
if (vstr) free(vstr);
- free(v); /* not mus_vct_free because we don't own the data array */
+#if (!HAVE_SCHEME)
+ mus_vct_free(v);
+#endif
}
else
{
@@ -1893,14 +2139,14 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
#if HAVE_FORTH
if (dur == (order + cp->edits[sf->edit_ctr]->samples))
- new_origin = mus_format("%s %d " MUS_LD PROC_SEP PROC_FALSE " %s", envstr, order, beg, S_filter_channel);
- else new_origin = mus_format("%s %d " MUS_LD PROC_SEP MUS_LD " %s", envstr, order, beg, dur, S_filter_channel);
+ new_origin = mus_format("%s %d %lld" PROC_SEP PROC_FALSE " %s", envstr, order, beg, S_filter_channel);
+ else new_origin = mus_format("%s %d %lld" PROC_SEP "%lld %s", envstr, order, beg, dur, S_filter_channel);
#else
if (dur == (order + cp->edits[sf->edit_ctr]->samples))
- new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP MUS_LD PROC_SEP PROC_FALSE,
- TO_PROC_NAME(S_filter_channel), envstr, order, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP MUS_LD PROC_SEP MUS_LD,
- TO_PROC_NAME(S_filter_channel), envstr, order, beg, dur);
+ new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ to_proc_name(S_filter_channel), envstr, order, beg);
+ else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%lld" PROC_SEP "%lld",
+ to_proc_name(S_filter_channel), envstr, order, beg, dur);
#endif
if (envstr) free(envstr);
}
@@ -1914,15 +2160,15 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, new_origin, sf->edit_ctr);
if (ofile) {free(ofile); ofile = NULL;}
}
- else change_samples(beg, dur, data[0], cp, new_origin, sf->edit_ctr);
+ else change_samples(beg, dur, data[0], cp, new_origin, sf->edit_ctr, -1.0);
if (new_origin) free(new_origin);
update_graph(cp);
free(data[0]);
free(data);
- if (d) free(d);
- if ((a) && (!precalculated_coeffs)) free(a);
+ if (!gen) mus_free(g);
+ if ((fcoeffs) && (!precalculated_coeffs)) free(fcoeffs);
return(NULL);
}
@@ -1954,11 +2200,10 @@ static char *filter_channel(chan_info *cp, int order, env *e, mus_long_t beg, mu
static char *apply_filter_or_error(chan_info *ncp, int order, env *e,
const char *caller, const char *origin, bool over_selection, mus_float_t *ur_a,
- mus_any *gen, XEN edpos, int arg_pos, bool truncate, bool *clm_error)
+ mus_any *gen, Xen edpos, int arg_pos, bool truncate, bool *clm_error)
{
/* if string returned, needs to be freed */
/* interpret e as frequency response and apply as filter to all sync'd chans */
- mus_float_t *a = NULL;
sync_state *sc;
sync_info *si;
snd_info *sp;
@@ -1971,7 +2216,7 @@ static char *apply_filter_or_error(chan_info *ncp, int order, env *e,
if ((!e) && (!ur_a) && (!gen))
return(NULL);
- if ((gen) && (!(MUS_RUN_P(gen))))
+ if ((gen) && (!(mus_run_function(gen))))
{
(*clm_error) = true;
return(mus_format("%s: can't handle %s generators",
@@ -2025,6 +2270,7 @@ static char *apply_filter_or_error(chan_info *ncp, int order, env *e,
else
{
/* use FIR filter */
+ mus_float_t *a = NULL;
if (order == 0) order = enved_filter_order(ss);
if (!gen)
{
@@ -2073,7 +2319,7 @@ static char *apply_filter_or_error(chan_info *ncp, int order, env *e,
if (ss->stopped_explicitly)
{
/* clean up and undo all edits up to stop_point */
- string_to_minibuffer(sp, "filter stopped");
+ set_status(sp, "filter stopped", false);
ss->stopped_explicitly = false;
for (i = 0; i <= stop_point; i++)
{
@@ -2088,7 +2334,7 @@ static char *apply_filter_or_error(chan_info *ncp, int order, env *e,
void apply_filter(chan_info *ncp, int order, env *e,
const char *caller, const char *origin, bool over_selection, mus_float_t *ur_a, mus_any *gen,
- XEN edpos, int arg_pos, bool truncate)
+ Xen edpos, int arg_pos, bool truncate)
{
char *error;
bool err_type; /* ignored in this context */
@@ -2100,256 +2346,68 @@ void apply_filter(chan_info *ncp, int order, env *e,
}
}
-
-static char *reverse_channel(chan_info *cp, snd_fd *sf, mus_long_t beg, mus_long_t dur, XEN edp, const char *caller, int arg_pos)
+static char *edit_list_envelope(mus_any *egen, mus_long_t beg, mus_long_t env_dur, mus_long_t called_dur, mus_long_t chan_dur, mus_float_t base)
{
- snd_info *sp;
- peak_env_info *ep = NULL;
- file_info *hdr = NULL;
- int i, j, ofd = 0, datumb = 0, err = 0, edpos = 0;
- bool section = false, temp_file;
- mus_long_t k;
- char *origin = NULL;
- mus_sample_t **data;
- mus_sample_t *idata;
- char *ofile = NULL;
- io_error_t io_err = IO_NO_ERROR;
-
- if ((beg < 0) || (dur <= 0)) return(NULL);
- if (!(editable_p(cp))) return(NULL);
- /* if last was reverse and start/end match, we could just copy preceding edlist entry, or undo/redo etc --
- * how to tell that this is happening?
- */
- sp = cp->sound;
- edpos = to_c_edit_position(cp, edp, caller, arg_pos);
+ char *new_origin, *envstr;
+ env *newe;
- if (dur > cp->edits[edpos]->samples) dur = cp->edits[edpos]->samples;
- if (dur > MAX_BUFFER_SIZE)
- {
- temp_file = true;
- ofile = snd_tempnam();
- hdr = make_temp_header(ofile, SND_SRATE(sp), 1, dur, caller);
- ofd = open_temp_file(ofile, 1, hdr, &io_err);
- if (ofd == -1)
- {
- if (ofile) free(ofile);
- return(mus_format("%s %s temp file %s: %s\n",
- (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
- caller, ofile,
- snd_open_strerror()));
- }
- datumb = mus_bytes_per_sample(hdr->format);
- }
- else temp_file = false;
+ newe = make_envelope_with_offset_and_scaler(mus_data(egen), mus_env_breakpoints(egen) * 2, mus_offset(egen), mus_scaler(egen));
+ /* mus_env_offset|scaler are the fixed up versions, the originals are mus_offset|scaler. mus_data is the original data */
- if ((beg == 0) && (dur == cp->edits[edpos]->samples))
- ep = peak_env_copy(cp, true, edpos); /* true -> reversed */
- else
+ envstr = env_to_string(newe);
+ if (((env_dur == chan_dur) || (env_dur == (chan_dur - 1))) &&
+ (called_dur == chan_dur))
{
- int sbin, ebin;
- mus_float_t min1, max1;
- ep = peak_env_copy(cp, false, edpos);
- if (ep)
- {
- /* now reverse the selection */
- sbin = (int)ceil(beg / ep->samps_per_bin);
- ebin = (int)floor((beg + dur) / ep->samps_per_bin);
- if (ebin > ep->peak_env_size) ebin = ep->peak_env_size;
- for (i = sbin, j = ebin - 1; i < j; i++, j--)
- {
- min1 = ep->data_min[i];
- max1 = ep->data_max[i];
- ep->data_min[i] = ep->data_min[j];
- ep->data_max[i] = ep->data_max[j];
- ep->data_min[j] = min1;
- ep->data_max[j] = max1;
- }
- if (sbin > 0) pick_one_bin(ep, sbin - 1, ep->samps_per_bin * (sbin - 1), cp, edpos);
- if (ebin < ep->peak_env_size) pick_one_bin(ep, ebin, ep->samps_per_bin * ebin, cp, edpos);
- }
- section = true; /* only for reverse_marks below */
- }
-
- data = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- data[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
- idata = data[0];
#if HAVE_FORTH
- if (dur == cp->edits[edpos]->samples)
- origin = mus_format(MUS_LD PROC_SEP PROC_FALSE " %s", beg, S_reverse_channel);
- else origin = mus_format(MUS_LD PROC_SEP MUS_LD " %s", beg, dur, S_reverse_channel);
+ if (base == 1.0)
+ new_origin = mus_format("%s %lld" PROC_SEP PROC_FALSE " %s", envstr, beg, S_env_channel);
+ else new_origin = mus_format("%s %.4f %lld" PROC_SEP PROC_FALSE " %s",
+ envstr, base, beg, S_env_channel_with_base);
#else
- if (dur == cp->edits[edpos]->samples)
- origin = mus_format("%s" PROC_OPEN MUS_LD PROC_SEP PROC_FALSE, TO_PROC_NAME(S_reverse_channel), beg);
- else origin = mus_format("%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(S_reverse_channel), beg, dur);
+ if (base == 1.0)
+ new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ to_proc_name(S_env_channel), envstr, beg);
+ else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%.4f" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ to_proc_name(S_env_channel_with_base), envstr, base, beg);
#endif
-
- if (temp_file)
- {
- j = 0;
- for (k = 0; k < dur; k++)
- {
- idata[j++] = read_sample_to_mus_sample(sf);
- if (j == MAX_BUFFER_SIZE)
- {
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
- }
- }
- if (j > 0) mus_file_write(ofd, 0, j - 1, 1, data);
- close_temp_file(ofile, ofd, hdr->type, dur * datumb);
- hdr = free_file_info(hdr);
- file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, origin, edpos);
- if (ofile)
- {
- free(ofile);
- ofile = NULL;
- }
}
else
{
- for (k = 0; k < dur; k++)
- idata[k] = read_sample_to_mus_sample(sf);
- change_samples(beg, dur, idata, cp, origin, edpos);
+ /* env dur was apparently not chan dur, or called dur was not full sound? */
+#if HAVE_FORTH
+ new_origin = mus_format("%s :base %.4f :end %lld %s %lld" PROC_SEP "%lld %s",
+ envstr, base, env_dur, S_make_env, beg, called_dur, S_env_channel);
+#else
+ new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP "%lld)" PROC_SEP "%lld" PROC_SEP "%lld",
+ to_proc_name(S_env_channel), to_proc_name(S_make_env), envstr, base, env_dur, beg, called_dur);
+#endif
}
- if (ep) cp->edits[cp->edit_ctr]->peak_env = ep;
- reverse_marks(cp, (section) ? beg : -1, dur);
- update_graph(cp);
- free(data[0]);
- free(data);
- if (origin) free(origin);
- return(NULL);
+ if (envstr) free(envstr);
+ free_env(newe);
+ return(new_origin);
}
-void reverse_sound(chan_info *ncp, bool over_selection, XEN edpos, int arg_pos)
+void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_selection,
+ const char *origin, mus_any *gen, Xen edpos, int arg_pos)
{
- sync_state *sc;
- sync_info *si;
- int i, stop_point = 0;
- snd_fd **sfs;
- char *caller;
+ /* basic cases: if env has 1 y value, use scale-channel,
+ * if step env (base == 0.0), use sequence of scale-channels,
+ * if not optimizable (via virtual edits), call mus_env on each sample
+ * if optimizable, use sequence of (x)ramp-channels
+ */
+ /* e can be NULL => use gen */
snd_info *sp;
- chan_info *cp;
-
- sp = ncp->sound;
- caller = (char *)((over_selection) ? S_reverse_selection : S_reverse_sound);
- sc = get_sync_state(sp, ncp, 0, over_selection, READ_BACKWARD, edpos, (const char *)caller, arg_pos);
- if (sc == NULL) return;
- si = sc->si;
- sfs = sc->sfs;
-
- if (!(ss->stopped_explicitly))
- {
- for (i = 0; i < si->chans; i++)
- {
- char *errmsg = NULL;
- mus_long_t dur;
- cp = si->cps[i];
- sp = cp->sound;
- if (over_selection)
- dur = sc->dur;
- else dur = to_c_edit_samples(cp, edpos, caller, arg_pos);
- if (dur == 0)
- {
- sfs[i] = free_snd_fd(sfs[i]);
- continue;
- }
-
- errmsg = reverse_channel(cp, sfs[i], si->begs[i], dur, edpos, caller, arg_pos);
-
- sfs[i] = free_snd_fd(sfs[i]);
- if (errmsg)
- {
- snd_error_without_format(errmsg);
- free(errmsg);
- break;
- }
- if (ss->stopped_explicitly)
- {
- stop_point = i;
- break;
- }
- }
- }
-
- if (ss->stopped_explicitly)
- {
- string_to_minibuffer(sp, "reverse stopped");
- ss->stopped_explicitly = false;
- for (i = 0; i <= stop_point; i++)
- {
- cp = si->cps[i];
- undo_edit(cp, 1);
- }
- }
- free_sync_state(sc);
-}
-
-
-static char *edit_list_envelope(mus_any *egen, mus_long_t beg, mus_long_t env_dur, mus_long_t called_dur, mus_long_t chan_dur, mus_float_t base)
-{
- char *new_origin, *envstr;
- env *newe;
-
- newe = make_envelope_with_offset_and_scaler(mus_data(egen), mus_env_breakpoints(egen) * 2, mus_offset(egen), mus_scaler(egen));
- /* mus_env_offset|scaler are the fixed up versions, the originals are mus_offset|scaler. mus_data is the original data */
-
- envstr = env_to_string(newe);
- if (((env_dur == chan_dur) || (env_dur == (chan_dur - 1))) &&
- (called_dur == chan_dur))
- {
-#if HAVE_FORTH
- if (base == 1.0)
- new_origin = mus_format("%s " MUS_LD PROC_SEP PROC_FALSE " %s", envstr, beg, S_env_channel);
- else new_origin = mus_format("%s %.4f " MUS_LD PROC_SEP PROC_FALSE " %s",
- envstr, base, beg, S_env_channel_with_base);
-#else
- if (base == 1.0)
- new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP MUS_LD PROC_SEP PROC_FALSE,
- TO_PROC_NAME(S_env_channel), envstr, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%.4f" PROC_SEP MUS_LD PROC_SEP PROC_FALSE,
- TO_PROC_NAME(S_env_channel_with_base), envstr, base, beg);
-#endif
- }
- else
- {
- /* env dur was apparently not chan dur, or called dur was not full sound? */
-#if HAVE_FORTH
- new_origin = mus_format("%s :base %.4f :end " MUS_LD " %s " MUS_LD PROC_SEP MUS_LD " %s",
- envstr, base, env_dur, S_make_env, beg, called_dur, S_env_channel);
-#else
- new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP MUS_LD ")" PROC_SEP MUS_LD PROC_SEP MUS_LD,
- TO_PROC_NAME(S_env_channel), TO_PROC_NAME(S_make_env), envstr, base, env_dur, beg, called_dur);
-#endif
- }
- if (envstr) free(envstr);
- free_env(newe);
- return(new_origin);
-}
-
-
-void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_selection,
- const char *origin, mus_any *gen, XEN edpos, int arg_pos)
-{
- /* basic cases: if env has 1 y value, use scale-channel,
- * if step env (base == 0.0), use sequence of scale-channels,
- * if not optimizable (via virtual edits), call mus_env on each sample
- * if optimizable, use sequence of (x)ramp-channels
- */
- /* e can be NULL => use gen */
- snd_info *sp;
- sync_info *si;
- sync_state *sc = NULL;
- int i, j, err = 0, k, len;
- bool scalable = true, rampable = true, is_xramp = false;
- mus_float_t val[1];
- mus_any *egen;
- mus_long_t *passes;
- double *rates;
- mus_float_t egen_val, base;
- double scaler, offset;
- char *new_origin;
+ sync_info *si;
+ sync_state *sc = NULL;
+ int i, j, k, len;
+ bool scalable = true, rampable = true, is_xramp = false;
+ mus_float_t val[1];
+ mus_any *egen;
+ mus_long_t *passes;
+ mus_float_t *rates;
+ mus_float_t base;
+ mus_float_t scaler, offset;
if ((!e) && (!gen)) return;
if (over_selection) dur = selection_len();
@@ -2405,7 +2463,7 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
}
if (e)
- egen = mus_make_env_with_length(e->data, e->pts, 1.0, 0.0, e->base, dur);
+ egen = mus_make_env(e->data, e->pts, 1.0, 0.0, e->base, 0.0, dur - 1, NULL);
else egen = gen;
len = mus_env_breakpoints(egen);
passes = mus_env_passes(egen);
@@ -2430,7 +2488,7 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
for (i = 0; i < si->chans; i++)
{
bool edited = false;
- if (!(editable_p(si->cps[i]))) continue;
+ if (!(is_editable(si->cps[i]))) continue;
segbeg = si->begs[i];
segend = si->begs[i] + dur;
segnum = passes[0] + 1;
@@ -2458,7 +2516,7 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
{
as_one_edit(si->cps[i], local_edpos + 1);
if (cp->edits[cp->edit_ctr]->origin) free(cp->edits[cp->edit_ctr]->origin);
- cp->edits[cp->edit_ctr]->origin = edit_list_envelope(egen, si->begs[i], (len > 1) ? (passes[len - 2]) : dur, dur, CURRENT_SAMPLES(si->cps[i]), base);
+ cp->edits[cp->edit_ctr]->origin = edit_list_envelope(egen, si->begs[i], (len > 1) ? (passes[len - 2]) : dur, dur, current_samples(si->cps[i]), base);
after_edit(cp);
update_graph(si->cps[i]);
reflect_edit_history_change(si->cps[i]);
@@ -2485,15 +2543,15 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
if (!rampable)
{
/* ---------------- not optimizable, so call mus_env on each sample ---------------- */
- mus_long_t ioff;
- mus_sample_t **data;
- mus_sample_t *idata;
+ mus_long_t ioff, alloc_len;
+ mus_float_t **data;
+ mus_float_t *idata;
bool reporting = false, temp_file = false;
int ofd = 0, datumb = 0;
file_info *hdr = NULL;
char *ofile = NULL;
snd_fd **sfs;
- snd_fd *sf = NULL;
+
/* run env over samples */
sc = get_sync_state(sp, cp, beg, over_selection, READ_FORWARD, edpos, origin, arg_pos);
if (sc == NULL)
@@ -2503,12 +2561,14 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
}
si = sc->si;
sfs = sc->sfs;
- if (dur > MAX_BUFFER_SIZE) /* if smaller than this, we don't gain anything by using a temp file (its buffers are this large) */
+ if (dur > MAX_BUFFER_SIZE)
{
io_error_t io_err = IO_NO_ERROR;
+
+ alloc_len = MAX_BUFFER_SIZE;
temp_file = true;
ofile = snd_tempnam();
- hdr = make_temp_header(ofile, SND_SRATE(sp), si->chans, dur, (char *)origin);
+ hdr = make_temp_header(ofile, snd_srate(sp), si->chans, dur, (char *)origin);
ofd = open_temp_file(ofile, si->chans, hdr, &io_err);
if (ofd == -1)
{
@@ -2524,16 +2584,18 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
free(ofile);
return;
}
- datumb = mus_bytes_per_sample(hdr->format);
+ datumb = mus_bytes_per_sample(hdr->sample_type);
}
- else temp_file = false;
- data = (mus_sample_t **)malloc(si->chans * sizeof(mus_sample_t *));
- for (i = 0; i < si->chans; i++)
+ else
{
- if (temp_file)
- data[i] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
- else data[i] = (mus_sample_t *)calloc(dur, sizeof(mus_sample_t));
+ temp_file = false;
+ alloc_len = dur;
}
+
+ data = (mus_float_t **)malloc(si->chans * sizeof(mus_float_t *));
+ for (i = 0; i < si->chans; i++)
+ data[i] = (mus_float_t *)calloc(alloc_len, sizeof(mus_float_t));
+
j = 0;
reporting = ((dur > REPORTING_SIZE) && (!(cp->squelch_update)));
if (reporting) start_progress_report(cp);
@@ -2544,12 +2606,14 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
{
for (ioff = 0; ioff < dur; ioff++)
{
+ mus_float_t egen_val;
egen_val = mus_env(egen);
for (k = 0; k < si->chans; k++)
- data[k][j] = MUS_FLOAT_TO_SAMPLE(read_sample(sfs[k]) * egen_val);
+ data[k][j] = (read_sample(sfs[k]) * egen_val);
j++;
- if ((temp_file) && (j == MAX_BUFFER_SIZE))
+ if (j == alloc_len)
{
+ int err;
if (reporting)
{
progress_report(cp, (mus_float_t)((double)ioff / ((double)dur)));
@@ -2562,22 +2626,26 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
}
err = mus_file_write(ofd, 0, j - 1, si->chans, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
}
}
else
{
+ for (k = 0; k < si->chans; k++)
+ samples_to_vct_with_reader(dur, data[k], sfs[k]);
for (j = 0; j < dur; j++)
{
+ mus_float_t egen_val;
egen_val = mus_env(egen);
for (k = 0; k < si->chans; k++)
- data[k][j] = MUS_FLOAT_TO_SAMPLE(read_sample(sfs[k]) * egen_val);
+ data[k][j] *= egen_val;
}
}
}
else
{
+ snd_fd *sf = NULL;
sf = sfs[0];
idata = data[0];
if (temp_file)
@@ -2585,10 +2653,11 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
ss->stopped_explicitly = false;
for (ioff = 0; ioff < dur; ioff++)
{
- idata[j] = MUS_FLOAT_TO_SAMPLE(read_sample(sf) * mus_env(egen));
+ idata[j] = (read_sample(sf) * mus_env(egen));
j++;
- if ((temp_file) && (j == MAX_BUFFER_SIZE))
+ if (j == alloc_len)
{
+ int err;
if (reporting)
{
progress_report(cp, (mus_float_t)((double)ioff / ((double)dur)));
@@ -2601,22 +2670,25 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
}
err = mus_file_write(ofd, 0, j - 1, 1, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
}
}
else
{
+ samples_to_vct_with_reader(dur, idata, sf);
for (j = 0; j < dur; j++)
- idata[j] = MUS_FLOAT_TO_SAMPLE(read_sample(sf) * mus_env(egen));
+ idata[j] *= mus_env(egen);
}
}
+
if (temp_file)
{
if (j > 0) mus_file_write(ofd, 0, j - 1, si->chans, data);
close_temp_file(ofile, ofd, hdr->type, dur * si->chans * datumb);
free_file_info(hdr);
}
+
if (reporting) finish_progress_report(cp);
if (ss->stopped_explicitly)
{
@@ -2631,9 +2703,10 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
remember_temp(ofile, si->chans);
for (i = 0; i < si->chans; i++)
{
+ char *new_origin;
int pos;
pos = to_c_edit_position(si->cps[i], edpos, origin, arg_pos);
- new_origin = edit_list_envelope(egen, si->begs[i], (len > 1) ? (passes[len - 2]) : dur, dur, CURRENT_SAMPLES(si->cps[i]), base);
+ new_origin = edit_list_envelope(egen, si->begs[i], (len > 1) ? (passes[len - 2]) : dur, dur, current_samples(si->cps[i]), base);
if (temp_file)
{
file_change_samples(si->begs[i], dur, ofile, si->cps[i], i,
@@ -2648,7 +2721,7 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
}
}
- else change_samples(si->begs[i], dur, data[i], si->cps[i], new_origin, pos);
+ else change_samples(si->begs[i], dur, data[i], si->cps[i], new_origin, pos, -1.0);
free(new_origin);
update_graph(si->cps[i]);
}
@@ -2684,7 +2757,7 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
for (i = 0; i < si->chans; i++)
{
bool edited = false;
- if (!(editable_p(si->cps[i]))) continue;
+ if (!(is_editable(si->cps[i]))) continue;
segbeg = si->begs[i];
segend = si->begs[i] + dur;
segnum = passes[0];
@@ -2769,7 +2842,7 @@ void apply_env(chan_info *cp, env *e, mus_long_t beg, mus_long_t dur, bool over_
si->cps[i]->edits[si->cps[i]->edit_ctr]->origin = edit_list_envelope(egen,
si->begs[i], (len > 1) ? (passes[len - 2]) : dur,
dur,
- CURRENT_SAMPLES(si->cps[i]),
+ current_samples(si->cps[i]),
base);
after_edit(cp);
update_graph(si->cps[i]);
@@ -2788,11 +2861,11 @@ void cursor_delete(chan_info *cp, mus_long_t count)
snd_info *sp;
if (count == 0) return;
if (count > 0)
- beg = CURSOR(cp);
+ beg = cursor_sample(cp);
else
{
count = -count;
- beg = CURSOR(cp) - count;
+ beg = cursor_sample(cp) - count;
if (beg < 0)
{
count += beg;
@@ -2812,7 +2885,7 @@ void cursor_delete(chan_info *cp, mus_long_t count)
{
if (delete_samples(beg, count, cps[i], cps[i]->edit_ctr))
{
- CURSOR(cps[i]) = beg;
+ cursor_sample(cps[i]) = beg;
update_graph(si->cps[i]);
}
}
@@ -2822,7 +2895,7 @@ void cursor_delete(chan_info *cp, mus_long_t count)
{
if (delete_samples(beg, count, cp, cp->edit_ctr))
{
- CURSOR(cp) = beg;
+ cursor_sample(cp) = beg;
update_graph(cp);
}
}
@@ -2850,7 +2923,7 @@ void cursor_insert(chan_info *cp, mus_long_t beg, mus_long_t count)
{
if ((count > 0) &&
(extend_with_zeros(cps[i],
- mus_oclamp(0, beg, CURRENT_SAMPLES(si->cps[i])),
+ mus_oclamp(0, beg, current_samples(si->cps[i])),
count,
cps[i]->edit_ctr,
"cursor insert")))
@@ -2862,7 +2935,7 @@ void cursor_insert(chan_info *cp, mus_long_t beg, mus_long_t count)
{
if ((count > 0) &&
(extend_with_zeros(cp,
- mus_oclamp(0, beg, CURRENT_SAMPLES(cp)),
+ mus_oclamp(0, beg, current_samples(cp)),
count,
cp->edit_ctr,
"cursor insert")))
@@ -2887,7 +2960,7 @@ void cursor_zeros(chan_info *cp, mus_long_t count, bool over_selection)
{
si = snd_sync(sp->sync);
for (i = 0; i < si->chans; i++)
- si->begs[i] = CURSOR(cp);
+ si->begs[i] = cursor_sample(cp);
}
else
{
@@ -2898,14 +2971,14 @@ void cursor_zeros(chan_info *cp, mus_long_t count, bool over_selection)
}
}
- if (!si) si = make_simple_sync(cp, CURSOR(cp));
+ if (!si) si = make_simple_sync(cp, cursor_sample(cp));
for (i = 0; i < si->chans; i++)
{
/* if zeroing entire sound, set scalers and remake peak_env */
ncp = si->cps[i];
if ((si->begs[i] == 0) &&
- (num >= CURRENT_SAMPLES(ncp)))
+ (num >= current_samples(ncp)))
{
mus_float_t scaler[1];
snd_info *nsp;
@@ -2927,7 +3000,7 @@ void cursor_zeros(chan_info *cp, mus_long_t count, bool over_selection)
/* special case 1 sample -- if already 0, treat as no-op */
if ((count != 1) ||
- (beg >= CURRENT_SAMPLES(ncp)) ||
+ (beg >= current_samples(ncp)) ||
(chn_sample(beg, ncp, ncp->edit_ctr) != 0.0))
scale_channel(ncp, 0.0, beg, num, ncp->edit_ctr, NOT_IN_AS_ONE_EDIT);
}
@@ -2940,12 +3013,13 @@ void cursor_zeros(chan_info *cp, mus_long_t count, bool over_selection)
static void smooth_channel(chan_info *cp, mus_long_t beg, mus_long_t dur, int edpos)
{
- mus_sample_t *data = NULL;
+ mus_float_t *data = NULL;
mus_long_t k;
char *origin = NULL;
- mus_float_t y0, y1, angle, incr, off, scale;
+ mus_float_t y0, y1;
+
if ((beg < 0) || (dur <= 0)) return;
- if (!(editable_p(cp))) return;
+ if (!(is_editable(cp))) return;
if ((beg + dur) > cp->edits[edpos]->samples)
{
dur = cp->edits[edpos]->samples - beg;
@@ -2953,19 +3027,33 @@ static void smooth_channel(chan_info *cp, mus_long_t beg, mus_long_t dur, int ed
}
y0 = chn_sample(beg, cp, edpos);
y1 = chn_sample(beg + dur, cp, edpos); /* one past end -- this is a debatable choice */
- if (y1 > y0) angle = M_PI; else angle = 0.0;
- incr = M_PI / (double)dur;
- off = 0.5 * (y1 + y0);
- scale = 0.5 * fabs(y0 - y1);
- data = (mus_sample_t *)calloc(dur, sizeof(mus_sample_t));
- for (k = 0; k < dur; k++, angle += incr)
- data[k] = MUS_FLOAT_TO_SAMPLE(off + scale * cos(angle));
+
#if HAVE_FORTH
- origin = mus_format(MUS_LD PROC_SEP MUS_LD " %s", beg, dur, S_smooth_channel);
+ origin = mus_format("%lld" PROC_SEP "%lld %s", beg, dur, S_smooth_channel);
#else
- origin = mus_format("%s" PROC_OPEN MUS_LD PROC_SEP MUS_LD, TO_PROC_NAME(S_smooth_channel), beg, dur);
+ origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld", to_proc_name(S_smooth_channel), beg, dur);
#endif
- change_samples(beg, dur, data, cp, origin, edpos);
+
+ data = (mus_float_t *)malloc(dur * sizeof(mus_float_t));
+ if (y0 == y1)
+ {
+ for (k = 0; k < dur; k++)
+ data[k] = y0;
+ change_samples(beg, dur, data, cp, origin, edpos, fabs(y0));
+ }
+ else
+ {
+ mus_float_t angle, incr, off, scale;
+ if (y1 > y0) angle = M_PI; else angle = 0.0;
+ incr = M_PI / (double)dur;
+ off = 0.5 * (y1 + y0);
+ scale = 0.5 * fabs(y0 - y1);
+ /* if scale is very small, it might work here to just use linear interpolation, but that case appears to be very uncommon.
+ */
+ for (k = 0; k < dur; k++, angle += incr)
+ data[k] = (off + scale * cos(angle));
+ change_samples(beg, dur, data, cp, origin, edpos, ((y0 > y1) && (y1 >= 0.0)) ? y0 : -1.0);
+ }
if (origin) free(origin);
update_graph(cp);
free(data);
@@ -2994,96 +3082,8 @@ void cos_smooth(chan_info *cp, mus_long_t beg, mus_long_t num, bool over_selecti
}
-#if HAVE_SCHEME
-static char *run_channel(chan_info *cp, struct ptree *pt, mus_long_t beg, mus_long_t dur, int edpos, const char *origin, const char *caller)
-{
- snd_info *sp;
- file_info *hdr = NULL;
- int j, ofd = 0, datumb = 0, err = 0;
- bool temp_file;
- mus_long_t k;
- mus_sample_t **data;
- mus_sample_t *idata;
- char *ofile = NULL;
- snd_fd *sf;
-
- if ((beg < 0) || (dur <= 0)) return(NULL);
- if (!(editable_p(cp))) return(NULL);
- sp = cp->sound;
- sf = init_sample_read_any(beg, cp, READ_FORWARD, edpos);
- if (sf == NULL)
- {
- return(mus_format("%s: can't read %s[%d] channel data!", caller, sp->short_filename, cp->chan));
- }
-
- if (dur > MAX_BUFFER_SIZE)
- {
- io_error_t io_err = IO_NO_ERROR;
- temp_file = true;
- ofile = snd_tempnam();
- hdr = make_temp_header(ofile, SND_SRATE(sp), 1, dur, "run_channel temp");
- ofd = open_temp_file(ofile, 1, hdr, &io_err);
- if (ofd == -1)
- {
- free_snd_fd(sf);
- return(mus_format("%s %s temp file %s: %s\n",
- (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
- caller, ofile,
- snd_open_strerror()));
- }
- datumb = mus_bytes_per_sample(hdr->format);
- }
- else temp_file = false;
-
- data = (mus_sample_t **)malloc(sizeof(mus_sample_t *));
- data[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
- idata = data[0];
-
- if (temp_file)
- {
- j = 0;
- ss->stopped_explicitly = false;
- for (k = 0; k < dur; k++)
- {
- idata[j++] = MUS_FLOAT_TO_SAMPLE(mus_run_evaluate_ptree_1f2f(pt, read_sample(sf)));
- if (j == MAX_BUFFER_SIZE)
- {
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
- check_for_event();
- if (ss->stopped_explicitly) break;
- }
- }
- if (j > 0) mus_file_write(ofd, 0, j - 1, 1, data);
- close_temp_file(ofile, ofd, hdr->type, dur * datumb);
- hdr = free_file_info(hdr);
- if (err != -1)
- file_change_samples(beg, dur, ofile, cp, 0, DELETE_ME, origin, edpos);
- if (ofile)
- {
- free(ofile);
- ofile = NULL;
- }
- }
- else
- {
- if (dur > 0)
- {
- for (k = 0; k < dur; k++)
- idata[k] = MUS_FLOAT_TO_SAMPLE(mus_run_evaluate_ptree_1f2f(pt, read_sample(sf)));
- change_samples(beg, dur, idata, cp, origin, edpos);
- }
- }
-
- update_graph(cp);
- free_snd_fd(sf);
- free(data[0]);
- free(data);
- return(NULL);
-}
-#endif
-
+#if USE_MOTIF
+/* this is used by the view-files dialog */
typedef struct {
snd_fd **fds;
@@ -3112,7 +3112,7 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
snd_info **sps = NULL;
int i, chan, chans = 0;
mus_long_t k, new_dur = 0, dur = 0;
- mus_sample_t **data;
+ mus_float_t **data;
file_info *hdr = NULL;
int j, ofd = 0, datumb = 0, err = 0, srate = 0;
io_error_t io_err = IO_NO_ERROR;
@@ -3129,7 +3129,7 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
int fchans, fsrate;
mus_long_t flen;
fchans = mus_sound_chans(files[i]);
- flen = mus_sound_frames(files[i]);
+ flen = mus_sound_framples(files[i]);
fsrate = mus_sound_srate(files[i]);
if (chans < fchans) chans = fchans;
if (srate < fsrate) srate = fsrate;
@@ -3164,10 +3164,10 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
/* now we have readers set up for all chans of all sounds about to be mixed/scaled/enveloped/resampled... */
- datumb = mus_bytes_per_sample(hdr->format);
- data = (mus_sample_t **)calloc(chans, sizeof(mus_sample_t *));
+ datumb = mus_bytes_per_sample(hdr->sample_type);
+ data = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
for (i = 0; i < chans; i++)
- data[i] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
+ data[i] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
if (!(snd_feq(speed, 1.0)))
{
@@ -3188,8 +3188,8 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
}
else new_dur = dur;
- if (!(default_env_p(amp_env)))
- e = mus_make_env_with_length(amp_env->data, amp_env->pts, amp, 0.0, 1.0, new_dur);
+ if (!(is_default_env(amp_env)))
+ e = mus_make_env(amp_env->data, amp_env->pts, amp, 0.0, 1.0, 0.0, new_dur - 1, NULL);
j = 0;
if (!sgens)
@@ -3204,14 +3204,14 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
if (fds[i][chan])
sum += read_sample(fds[i][chan]);
sum *= amp;
- data[chan][j] = MUS_FLOAT_TO_SAMPLE(sum);
+ data[chan][j] = (sum);
}
j++;
if (j == MAX_BUFFER_SIZE)
{
err = mus_file_write(ofd, 0, j - 1, chans, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
}
}
@@ -3221,13 +3221,13 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
{
if (e) amp = mus_env(e);
for (chan = 0; chan < chans; chan++)
- data[chan][j] = MUS_FLOAT_TO_SAMPLE(amp * mus_src(sgens[chan], 0.0, &scale_and_src_input));
+ data[chan][j] = (amp * mus_src(sgens[chan], 0.0, &scale_and_src_input));
j++;
if (j == MAX_BUFFER_SIZE)
{
err = mus_file_write(ofd, 0, j - 1, chans, data);
j = 0;
- if (err == -1) break;
+ if (err != MUS_NO_ERROR) break;
}
}
}
@@ -3268,724 +3268,762 @@ char *scale_and_src(char **files, int len, int max_chans, mus_float_t amp, mus_f
return(tempfile);
}
+#endif
-static XEN g_map_chan_1(XEN proc_and_list, XEN s_beg, XEN s_end, XEN org, XEN snd, XEN chn, XEN edpos, XEN s_dur, const char *fallback_caller)
-{
- chan_info *cp;
- const char *caller;
- mus_long_t beg = 0, end = 0, dur = 0;
- mus_long_t num;
- int rpt = 0, i, pos;
- bool temp_file = false, backup = false;
- XEN res = XEN_FALSE;
- XEN proc = XEN_FALSE;
-
- proc = proc_and_list;
-
- if (XEN_STRING_P(org))
- caller = XEN_TO_C_STRING(org);
- else caller = fallback_caller;
-
- XEN_ASSERT_TYPE((XEN_PROCEDURE_P(proc)) || (mus_xen_p(proc)), proc, XEN_ARG_1, caller, "a procedure");
- ASSERT_SAMPLE_TYPE(caller, s_beg, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(caller, s_end, XEN_ARG_3);
- ASSERT_SAMPLE_TYPE(caller, s_dur, XEN_ARG_3);
- ASSERT_CHANNEL(caller, snd, chn, 5);
+static Xen map_channel_to_temp_file(chan_info *cp, snd_fd *sf, Xen proc, mus_long_t beg, mus_long_t num, int pos, const char *caller)
+{
+ snd_info *sp;
+ int rpt4, ofd, datumb;
+ char *filename;
+ file_info *hdr;
+ bool reporting;
+ io_error_t io_err = IO_NO_ERROR;
+ Xen res = Xen_false;
- cp = get_cp(snd, chn, caller);
- if (!cp) return(XEN_FALSE);
- if (!(editable_p(cp))) return(XEN_FALSE);
+ sampler_set_safe(sf, num);
+ sp = cp->sound;
+ reporting = ((num > REPORTING_SIZE) && (!(cp->squelch_update)));
+ if (reporting) start_progress_report(cp);
+ rpt4 = MAX_BUFFER_SIZE / 4;
+
+ filename = snd_tempnam();
+ hdr = make_temp_header(filename, snd_srate(cp->sound), 1, 0, S_map_channel);
+ datumb = mus_bytes_per_sample(hdr->sample_type);
- pos = to_c_edit_position(cp, edpos, caller, 7);
- beg = beg_to_sample(s_beg, caller);
- if (XEN_FALSE_P(s_dur))
- end = end_to_sample(s_end, cp, pos, caller);
- else dur = dur_to_samples(s_dur, beg, cp, pos, 3, caller); /* 3 is arg num from caller's point of view */
- if (end == 0)
- {
- if (dur != 0)
- end = beg + dur - 1;
- else end = cp->edits[pos]->samples - 1;
- }
- num = end - beg + 1;
- if (num > 0)
+ ofd = open_temp_file(filename, 1, hdr, &io_err);
+ if (ofd == -1)
+ snd_error("%s: %s (temp file) %s: %s",
+ S_map_channel,
+ (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
+ filename,
+ snd_open_strerror());
+ else
{
- snd_fd *sf = NULL;
- char *errmsg = NULL;
- snd_info *sp;
-
- errmsg = procedure_ok(proc, 1, caller, "", 1);
- if (errmsg)
- {
- XEN errstr;
- errstr = C_TO_XEN_STRING(errmsg);
- free(errmsg);
- return(snd_bad_arity_error(caller, errstr, proc));
- }
-
- /* added 27-Oct-06 -- can't see why map-channel should be that different from insert-samples et al */
- if (beg > cp->edits[pos]->samples)
- {
- if (!(extend_with_zeros(cp, cp->edits[pos]->samples, beg - cp->edits[pos]->samples, pos, "extend for " S_map_channel)))
- return(XEN_FALSE);
- backup = true;
- pos = cp->edit_ctr;
- }
-
-#if HAVE_SCHEME
- if (optimization(ss) > 0)
+ int err = MUS_NO_ERROR, i, j = 0, rpt = 0;
+ mus_float_t **data = NULL;
+ mus_long_t kp, samps = 0;
+
+ data = (mus_float_t **)malloc(1 * sizeof(mus_float_t *));
+ data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
+ ss->stopped_explicitly = false;
+
+ /* fprintf(stderr, "tempfile %d, %lld %s\n", __LINE__, num, DISPLAY(body)); */
+ for (kp = 0; kp < num; kp++)
{
- struct ptree *pt = NULL;
- pt = mus_run_form_to_ptree_1_f(XEN_PROCEDURE_SOURCE(proc_and_list));
- if (pt)
+ /* changed here to remove catch 24-Mar-02 */
+ res = Xen_unprotected_call_with_1_arg(proc, C_double_to_Xen_real((double)read_sample(sf)));
+ if (Xen_is_number(res)) /* one number -> replace current sample */
{
- char *err_str;
- err_str = run_channel(cp, pt, beg, num, pos, caller, S_map_channel);
- mus_run_free_ptree(pt);
- if (err_str == NULL)
- return(XEN_ZERO);
- else free(err_str); /* and fallback on normal evaluator */
+ samps++;
+ data[0][j++] = Xen_real_to_C_double(res);
+ if (j == MAX_BUFFER_SIZE)
+ {
+ err = mus_file_write(ofd, 0, j - 1, 1, data);
+ j = 0;
+ if (err != MUS_NO_ERROR) break;
+ }
}
- }
-#endif
+ else
+ {
+ if (!Xen_is_false(res)) /* if #f, no output on this pass */
+ {
+ if (Xen_is_true(res)) /* if #t we halt the entire map */
+ break;
+ else
+ {
+ if (mus_is_vct(res))
+ {
+ vct *v;
+ mus_long_t vlen;
+ mus_float_t *vdata;
- sp = cp->sound;
- sf = init_sample_read_any(beg, cp, READ_FORWARD, pos);
- if (sf == NULL)
- return(XEN_TRUE);
-
- temp_file = (num > MAX_BUFFER_SIZE);
- if (temp_file)
- {
- int rpt4, ofd, datumb;
- char *filename;
- file_info *hdr;
- mus_long_t kp, samps = 0;
- int j = 0;
- bool reporting = false;
- io_error_t io_err = IO_NO_ERROR;
-
- reporting = ((num > REPORTING_SIZE) && (!(cp->squelch_update)));
- if (reporting) start_progress_report(cp);
- rpt4 = MAX_BUFFER_SIZE / 4;
-
- filename = snd_tempnam();
- hdr = make_temp_header(filename, SND_SRATE(cp->sound), 1, 0, S_map_channel);
- ofd = open_temp_file(filename, 1, hdr, &io_err);
- if (ofd == -1)
- snd_error("%s: %s (temp file) %s: %s",
- S_map_channel,
- (io_err != IO_NO_ERROR) ? io_error_name(io_err) : "can't open",
- filename,
- snd_open_strerror());
- else
- {
- int err = MUS_NO_ERROR;
- mus_sample_t **data;
-
-#if HAVE_SCHEME
- s7_pointer arg_list;
- int gc_loc;
- arg_list = XEN_LIST_1(XEN_FALSE);
- gc_loc = s7_gc_protect(s7, arg_list);
-#endif
-
- data = (mus_sample_t **)calloc(1, sizeof(mus_sample_t *));
- data[0] = (mus_sample_t *)calloc(MAX_BUFFER_SIZE, sizeof(mus_sample_t));
- datumb = mus_bytes_per_sample(hdr->format);
- ss->stopped_explicitly = false;
+ v = Xen_to_vct(res);
+ vlen = mus_vct_length(v);
+ vdata = mus_vct_data(v);
- for (kp = 0; kp < num; kp++)
- {
- /* changed here to remove catch 24-Mar-02 */
-#if HAVE_SCHEME
- s7_set_car(arg_list, C_TO_XEN_DOUBLE((double)read_sample(sf)));
- res = s7_call_with_location(s7, proc, arg_list, c__FUNCTION__, __FILE__, __LINE__);
-#else
- res = XEN_CALL_1_NO_CATCH(proc, C_TO_XEN_DOUBLE((double)read_sample(sf)));
-#endif
- if (XEN_NUMBER_P(res)) /* one number -> replace current sample */
- {
- samps++;
- data[0][j++] = XEN_TO_C_DOUBLE(res);
- if (j == MAX_BUFFER_SIZE)
- {
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
- }
- }
- else
- {
- if (XEN_NOT_FALSE_P(res)) /* if #f, no output on this pass */
- {
- if (XEN_TRUE_P(res)) /* if #t we halt the entire map */
- break;
- else
+ for (i = 0; i < vlen; i++)
{
- if (MUS_VCT_P(res))
- {
- vct *v;
- v = XEN_TO_VCT(res);
- for (i = 0; i < v->length; i++)
- {
- data[0][j++] = v->data[i];
- if (j == MAX_BUFFER_SIZE)
- {
- err = mus_file_write(ofd, 0, j - 1, 1, data);
- j = 0;
- if (err == -1) break;
- }
- }
- samps += v->length - 1;
- }
- else
+ data[0][j++] = vdata[i];
+ if (j == MAX_BUFFER_SIZE)
{
- close_temp_file(filename, ofd, hdr->type, samps * datumb);
- sf = free_snd_fd(sf);
- if (reporting) finish_progress_report(cp);
- snd_remove(filename, REMOVE_FROM_CACHE);
- free(filename);
- free(data[0]);
- free(data);
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
-
- XEN_ERROR(BAD_TYPE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: result of procedure must be a (non-complex) number, boolean, or vct: ~A"),
- C_TO_XEN_STRING(caller),
- res));
+ err = mus_file_write(ofd, 0, j - 1, 1, data);
+ j = 0;
+ if (err != MUS_NO_ERROR) break;
}
}
+ samps += vlen - 1;
}
- }
- if (reporting)
- {
- rpt++;
- if (rpt > rpt4)
+ else
{
- progress_report(cp, (mus_float_t)((double)kp / (double)num));
- if (!(sp->active))
- {
- ss->stopped_explicitly = true;
- break;
- }
- rpt = 0;
+ close_temp_file(filename, ofd, hdr->type, samps * datumb);
+ sf = free_snd_fd(sf);
+ if (reporting) finish_progress_report(cp);
+ snd_remove(filename, REMOVE_FROM_CACHE);
+ free(filename);
+ free(data[0]);
+ free(data);
+
+ Xen_error(BAD_TYPE,
+ Xen_list_3(C_string_to_Xen_string("~A: result of procedure must be a (non-complex) number, boolean, or vct: ~A"),
+ C_string_to_Xen_string(caller),
+ res));
}
}
- if (ss->stopped_explicitly) break;
}
-
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
- if (j > 0)
- mus_file_write(ofd, 0, j - 1, 1, data);
- close_temp_file(filename, ofd, hdr->type, samps * datumb);
-
- free_file_info(hdr);
- free(data[0]);
- free(data);
-
- sf = free_snd_fd(sf);
-
- if (reporting) finish_progress_report(cp);
- if (ss->stopped_explicitly)
- ss->stopped_explicitly = false;
- else
+ }
+ if (reporting)
+ {
+ rpt++;
+ if (rpt > rpt4)
{
- if (cp->active < CHANNEL_HAS_EDIT_LIST)
- {
- snd_remove(filename, REMOVE_FROM_CACHE);
- free(filename);
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_2(C_TO_XEN_STRING("~A: can't edit closed channel!"),
- C_TO_XEN_STRING(caller)));
- return(XEN_FALSE);
- }
-
- if (samps == num)
- file_change_samples(beg, samps, filename, cp, 0, DELETE_ME, caller, pos);
- else
+ progress_report(cp, (mus_float_t)((double)kp / (double)num));
+ if (!(sp->active))
{
- delete_samples(beg, num, cp, pos);
- if (samps > 0)
- {
- int cured;
- cured = cp->edit_ctr;
- file_insert_samples(beg, samps, filename, cp, 0, DELETE_ME, caller, cp->edit_ctr);
- backup_edit_list(cp);
- if (cp->edit_ctr > cured)
- backup_edit_list(cp);
- ripple_trailing_marks(cp, beg, num, samps);
- }
- else snd_remove(filename, REMOVE_FROM_CACHE);
+ ss->stopped_explicitly = true;
+ break;
}
+ rpt = 0;
}
}
- free(filename);
+ if (ss->stopped_explicitly) break;
}
+
+ if (j > 0)
+ mus_file_write(ofd, 0, j - 1, 1, data);
+
+ close_temp_file(filename, ofd, hdr->type, samps * datumb);
+ free_file_info(hdr);
+ free(data[0]);
+ free(data);
+ sf = free_snd_fd(sf);
+
+ if (reporting) finish_progress_report(cp);
+ if (ss->stopped_explicitly)
+ ss->stopped_explicitly = false;
else
{
- /* not temp_file -- use resizable buffer */
- int data_pos = 0, kp;
- mus_long_t cur_size;
- mus_sample_t *data = NULL;
-#if HAVE_SCHEME
- s7_pointer arg_list;
- int gc_loc;
- arg_list = XEN_LIST_1(XEN_FALSE);
- gc_loc = s7_gc_protect(s7, arg_list);
-#endif
-
- data = (mus_sample_t *)calloc(num, sizeof(mus_sample_t));
- cur_size = num;
-
- for (kp = 0; kp < num; kp++)
- {
-#if HAVE_SCHEME
- s7_set_car(arg_list, C_TO_XEN_DOUBLE((double)read_sample(sf)));
- res = s7_call_with_location(s7, proc, arg_list, c__FUNCTION__, __FILE__, __LINE__);
-#else
- res = XEN_CALL_1_NO_CATCH(proc, C_TO_XEN_DOUBLE((double)read_sample(sf)));
-#endif
- if (XEN_NUMBER_P(res)) /* one number -> replace current sample */
- {
- if (data_pos >= cur_size)
- {
- cur_size *= 2;
- data = (mus_sample_t *)realloc(data, cur_size * sizeof(mus_sample_t));
- }
- data[data_pos++] = MUS_DOUBLE_TO_SAMPLE(XEN_TO_C_DOUBLE(res));
- }
- else
- {
- if (XEN_NOT_FALSE_P(res)) /* if #f, no output on this pass */
- {
- if (XEN_TRUE_P(res)) /* if #t we halt the entire map */
- break;
- else
- {
- if (MUS_VCT_P(res))
- {
- vct *v;
- v = XEN_TO_VCT(res);
- for (i = 0; i < v->length; i++)
- {
- if (data_pos >= cur_size)
- {
- cur_size *= 2;
- data = (mus_sample_t *)realloc(data, cur_size * sizeof(mus_sample_t));
- }
- data[data_pos++] = MUS_DOUBLE_TO_SAMPLE(v->data[i]);
- }
- }
- else
- {
- if (data) {free(data); data = NULL;}
- sf = free_snd_fd(sf);
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
- XEN_ERROR(BAD_TYPE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: result of procedure must be a number, boolean, or vct: ~A"),
- C_TO_XEN_STRING(caller),
- res));
- }
- }
- }
- }
- }
- sf = free_snd_fd(sf);
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
if (cp->active < CHANNEL_HAS_EDIT_LIST)
{
- if (data) {free(data); data = NULL;}
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_2(C_TO_XEN_STRING("~A: can't edit closed channel!"),
- C_TO_XEN_STRING(caller)));
- return(XEN_FALSE);
+ snd_remove(filename, REMOVE_FROM_CACHE);
+ free(filename);
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_2(C_string_to_Xen_string("~A: can't edit closed channel!"),
+ C_string_to_Xen_string(caller)));
+ return(Xen_false);
}
- if (data_pos == num)
- change_samples(beg, data_pos, data, cp, caller, pos);
+
+ if (samps == num)
+ file_change_samples(beg, samps, filename, cp, 0, DELETE_ME, caller, pos);
else
{
- /* the version above truncates to the new length... */
delete_samples(beg, num, cp, pos);
- if (data_pos > 0)
+ if (samps > 0)
{
int cured;
cured = cp->edit_ctr;
- insert_samples(beg, data_pos, data, cp, caller, cp->edit_ctr);
+ file_insert_samples(beg, samps, filename, cp, 0, DELETE_ME, caller, cp->edit_ctr);
backup_edit_list(cp);
if (cp->edit_ctr > cured)
backup_edit_list(cp);
- ripple_trailing_marks(cp, beg, num, data_pos);
+ ripple_trailing_marks(cp, beg, num, samps);
}
+ else snd_remove(filename, REMOVE_FROM_CACHE);
}
- if (data) {free(data); data = NULL;}
}
-
- if (backup)
- backup_edit_list(cp);
-
- update_graph(cp);
}
+ free(filename);
return(res);
}
+#if HAVE_SCHEME
+static bool tree_memq(s7_scheme *sc, s7_pointer symbol, s7_pointer tree)
+{
+ if (symbol == tree)
+ return(true);
+ if (s7_is_pair(tree))
+ return((tree_memq(sc, symbol, s7_car(tree))) ||
+ (tree_memq(sc, symbol, s7_cdr(tree))));
+ return(false);
+}
+#endif
-#define MUS_OUTA_1(Frame, Val, Fd) ((*(Fd->core)->write_sample))(Fd, Frame, 0, Val)
-/* avoids all the CLM error checking */
+static Xen map_channel_to_buffer(chan_info *cp, snd_fd *sf, Xen proc, mus_long_t beg, mus_long_t num, int pos, const char *caller)
+{
+ /* not temp_file -- use resizable buffer */
+ int i, data_pos = 0, kp;
+ mus_long_t cur_size;
+ mus_float_t *data = NULL;
+ Xen res = Xen_false;
-static XEN g_map_chan_ptree_fallback(XEN proc, XEN init_func, chan_info *cp, mus_long_t beg, mus_long_t num, int pos, const char *origin)
-{
- snd_fd *sf = NULL;
- bool temp_file;
- char *filename = NULL;
- mus_long_t kp;
- int loc = NOT_A_GC_LOC;
- mus_sample_t *data = NULL;
- XEN res = XEN_FALSE, v = XEN_FALSE;
-
- if (!(editable_p(cp))) return(XEN_FALSE);
-
- sf = init_sample_read_any(beg, cp, READ_FORWARD, pos);
- if (sf == NULL)
- return(XEN_TRUE);
-
- if (XEN_PROCEDURE_P(init_func))
- {
- if (XEN_REQUIRED_ARGS_OK(init_func, 3))
- v = XEN_CALL_3(init_func,
- C_TO_XEN_INT64_T(0),
- C_TO_XEN_INT64_T(num),
- XEN_TRUE, /* reading forward */
- origin);
- else v = XEN_CALL_2(init_func,
- C_TO_XEN_INT64_T(0),
- C_TO_XEN_INT64_T(num),
- origin);
- loc = snd_protect(v);
- }
-
- temp_file = (num > MAX_BUFFER_SIZE);
- if (temp_file)
- {
- mus_any *outgen = NULL;
- filename = snd_tempnam();
- outgen = mus_make_sample_to_file_with_comment(filename, 1, MUS_OUT_FORMAT, MUS_NEXT, origin);
- if (XEN_REQUIRED_ARGS_OK(proc, 3))
+#if HAVE_SCHEME
+ mus_float_t *in_data;
+ int gc_loc, proc_loc;
+ bool use_apply;
+ s7_pointer arg_list, body, e, slot;
+ s7_pointer (*eval)(s7_scheme *sc, s7_pointer code, s7_pointer e);
+
+ arg_list = xen_nil;
+ body = xen_nil;
+ e = xen_nil;
+ slot = xen_nil;
+ eval = NULL;
+
+ body = s7_closure_body(s7, proc);
+ if ((s7_is_pair(body)) &&
+ (s7_is_pair(s7_closure_args(s7, proc))))
+ {
+ s7_pointer arg;
+ if (s7_is_null(s7, s7_cdr(body)))
{
- for (kp = 0; kp < num; kp++)
+ res = s7_car(body);
+ arg = s7_car(s7_closure_args(s7, proc));
+ if (s7_is_pair(arg)) arg = s7_car(arg); /* lambda* + default */
+
+ if ((s7_is_boolean(res)) ||
+ (res == arg))
{
- res = XEN_CALL_3(proc,
- C_TO_XEN_DOUBLE((double)read_sample(sf)),
- v,
- XEN_TRUE,
- origin);
- MUS_OUTA_1(kp, XEN_TO_C_DOUBLE(res), outgen);
+ /* #f = delete all samples in the range, #t = no-op, (lambda (y) y) a no-op */
+ sf = free_snd_fd(sf);
+ if (res == s7_f(s7))
+ delete_samples(beg, num, cp, pos);
+ return(res);
}
- }
- else
- {
- for (kp = 0; kp < num; kp++)
+
+ if (!s7_is_pair(res))
{
- res = XEN_CALL_1(proc,
- C_TO_XEN_DOUBLE((double)read_sample(sf)),
- origin);
- MUS_OUTA_1(kp, XEN_TO_C_DOUBLE(res), outgen);
+ s7_double x;
+ if (s7_is_symbol(res))
+ {
+ s7_pointer old_e;
+ e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
+ old_e = s7_set_curlet(s7, e); /* new env for map lambda */
+ res = s7_symbol_value(s7, res);
+ s7_set_curlet(s7, old_e);
+ }
+ x = s7_number_to_real_with_caller(s7, res, "map-channel");
+ data = (mus_float_t *)malloc(num * sizeof(mus_float_t));
+ for (kp = 0; kp < num; kp++)
+ data[kp] = x;
+ /* since we're not calling eval or the event checker, the channel can't be closed during the loop (??) */
+ change_samples(beg, num, data, cp, caller, pos, fabs(x));
+ free(data);
+ sf = free_snd_fd(sf);
+ return(res);
}
- }
- if (outgen) mus_free(outgen);
- }
- else
- {
- data = (mus_sample_t *)calloc(num, sizeof(mus_sample_t));
- if (XEN_REQUIRED_ARGS_OK(proc, 3))
- {
- for (kp = 0; kp < num; kp++)
+
+ /* look first for the common scaling case */
+ if ((s7_list_length(s7, res) == 3) &&
+ (s7_cadr(res) != s7_caddr(res)) &&
+ ((s7_car(res) == s7_make_symbol(s7, "*")) || (s7_car(res) == s7_make_symbol(s7, "+"))) &&
+ (((s7_cadr(res) == arg) && (!s7_is_pair(s7_caddr(res)))) ||
+ ((s7_caddr(res) == arg) && (!s7_is_pair(s7_cadr(res))))))
{
- res = XEN_CALL_3(proc,
- C_TO_XEN_DOUBLE((double)read_sample(sf)),
- v,
- XEN_TRUE,
- origin);
- data[kp] = MUS_DOUBLE_TO_SAMPLE(XEN_TO_C_DOUBLE(res));
+ double x;
+ s7_pointer fx;
+ if (s7_cadr(res) == arg) fx = s7_caddr(res); else fx = s7_cadr(res);
+ if (s7_is_symbol(fx))
+ {
+ s7_pointer old_e;
+ e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
+ old_e = s7_set_curlet(s7, e); /* new env for map lambda */
+ fx = s7_symbol_value(s7, fx);
+ s7_set_curlet(s7, old_e);
+ }
+ x = s7_number_to_real_with_caller(s7, fx, "map-channel");
+ if (s7_car(res) == s7_make_symbol(s7, "*"))
+ scale_channel(cp, x, beg, num, pos, NOT_IN_AS_ONE_EDIT);
+ else
+ {
+ data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
+ samples_to_vct_with_reader(num, data, sf);
+ for (kp = 0; kp < num; kp++) data[kp] += x;
+ change_samples(beg, num, data, cp, caller, pos, -1.0);
+ free(data);
+ }
+ sf = free_snd_fd(sf);
+ return(res);
}
- }
- else
- {
- for (kp = 0; kp < num; kp++)
+
+ /* try rf mechanism */
+ if (s7_is_symbol(s7_car(res)))
{
- res = XEN_CALL_1(proc,
- C_TO_XEN_DOUBLE((double)read_sample(sf)),
- origin);
- data[kp] = MUS_DOUBLE_TO_SAMPLE(XEN_TO_C_DOUBLE(res));
+ s7_pointer fcar;
+ fcar = s7_symbol_value(s7, s7_car(res));
+ if (s7_rf_function(s7, fcar))
+ {
+ s7_rf_t rf;
+ s7_pointer yp, old_e, y;
+
+ e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
+ old_e = s7_set_curlet(s7, e); /* new env for map lambda */
+ /* we need to connect to the lambda's closure so subsequent symbol lookups work right */
+ y = s7_make_mutable_real(s7, 1.5); /* slot for the map lambda arg */
+ yp = s7_make_slot(s7, e, arg, y);
+
+ s7_xf_new(s7, e);
+ rf = s7_rf_function(s7, fcar)(s7, res);
+ if (rf)
+ {
+ s7_pointer *top, *p;
+ data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
+ top = s7_xf_start(s7);
+ if (tree_memq(s7, arg, res))
+ {
+ samples_to_vct_with_reader(num, data, sf);
+ for (kp = 0; kp < num; kp++)
+ {
+ s7_slot_set_real_value(s7, yp, data[kp]);
+ p = top;
+ data[kp] = rf(s7, &p);
+ }
+ }
+ else
+ {
+ for (kp = 0; kp < num; kp++)
+ {
+ p = top;
+ data[kp] = rf(s7, &p);
+ }
+ }
+ s7_xf_free(s7);
+ sf = free_snd_fd(sf);
+ change_samples(beg, num, data, cp, caller, pos, -1.0);
+ free(data);
+ s7_set_curlet(s7, old_e);
+ return(res);
+ }
+ s7_xf_free(s7);
+ s7_set_curlet(s7, old_e);
+ }
}
}
+ /* (let ((rd (make-sampler 0))) (map-channel (lambda (y) (+ (next-sample rd) y)))) */
+
+ arg = s7_car(s7_closure_args(s7, proc));
+ e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
+ gc_loc = s7_gc_protect(s7, e);
+ slot = s7_make_slot(s7, e, arg, s7_make_real(s7, 0.0));
+ use_apply = false;
+ if (s7_is_null(s7, s7_cdr(body)))
+ {
+ eval = s7_eval_form;
+ body = s7_car(body);
+ }
+ else eval = s7_eval;
}
- free_snd_fd(sf);
- if (temp_file)
- {
- file_change_samples(beg, num, filename, cp, 0, DELETE_ME, origin, pos);
- free(filename);
- }
- else
+ else
{
- change_samples(beg, num, data, cp, origin, pos);
- free(data);
+ /* presumably "proc" is something like abs */
+ arg_list = Xen_list_1(Xen_false);
+ gc_loc = s7_gc_protect(s7, arg_list);
+ use_apply = true;
}
- if (loc != NOT_A_GC_LOC) snd_unprotect_at(loc);
- update_graph(cp);
- return(proc);
-}
-
+ proc_loc = s7_gc_protect(s7, proc);
+#endif
-static XEN g_ptree_channel(XEN proc_and_list, XEN s_beg, XEN s_dur, XEN snd, XEN chn,
- XEN edpos, XEN env_too, XEN init_func, XEN origin)
-{
- #define H_ptree_channel "(" S_ptree_channel " proc :optional (beg 0) (dur len) snd chn edpos peak-env-also init-func origin): \
-apply 'proc' as a 'virtual edit'; that is, the effect of 'proc' (a function of one argument, the \
-current sample, if init-func is not specified), comes about as an implicit change in the way the data is read. \
-This is similar to scaling and some envelope operations in that no data actually changes. If 'peak-env-also' is " PROC_TRUE ", \
-the same function is applied to the peak env values to get the new version. \
-If 'proc' needs some state, it can be supplied in a vct returned by 'init-func'. \
-'init-func' is a function of 2 or 3 args, the current fragment-relative begin position, \
-the overall fragment duration, and optionally the read direction. In this case, 'proc' is a function of 3 args: \
-the current sample, the vct returned by 'init-func', and the current read direction."
+ /* fprintf(stderr, "map %lld: body: %s\n", num, s7_object_to_c_string(s7, body)); */
- chan_info *cp;
- char *caller = NULL;
- mus_long_t beg = 0, dur = 0;
- bool backup = false;
- int pos;
+ data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
#if HAVE_SCHEME
- bool too_many_ptrees = false;
- struct ptree *pt = NULL;
+ in_data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
+ samples_to_vct_with_reader(num, in_data, sf);
#endif
- XEN proc = XEN_FALSE;
- /* (ptree-channel (lambda (y) (* y 2))) -> ((lambda (y) (* y 2)) #<procedure #f ((y) (* y 2))>) as "proc_and_list" */
- /* the cadr proc gives access to the environment, run walks the car */
-
- proc = proc_and_list;
-
- XEN_ASSERT_TYPE((XEN_PROCEDURE_P(proc)) && ((XEN_REQUIRED_ARGS_OK(proc, 1)) || (XEN_REQUIRED_ARGS_OK(proc, 3))),
- proc, XEN_ARG_1, S_ptree_channel, "a procedure of one or three args");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, 10, S_ptree_channel, "a string");
- ASSERT_SAMPLE_TYPE(S_ptree_channel, s_beg, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(S_ptree_channel, s_dur, XEN_ARG_3);
- ASSERT_CHANNEL(S_ptree_channel, snd, chn, 4);
- cp = get_cp(snd, chn, S_ptree_channel);
- if (!cp) return(XEN_FALSE);
- pos = to_c_edit_position(cp, edpos, S_ptree_channel, 6);
- if (pos > cp->edit_ctr)
- {
- XEN_ERROR(NO_SUCH_EDIT,
- XEN_LIST_6(C_TO_XEN_STRING("~A: no such edpos: ~A, ~S chan ~A has ~A edits"),
- C_TO_XEN_STRING(S_ptree_channel),
- edpos,
- C_TO_XEN_STRING(cp->sound->short_filename),
- chn,
- C_TO_XEN_INT(cp->edit_ctr)));
- }
- beg = beg_to_sample(s_beg, S_ptree_channel);
- dur = dur_to_samples(s_dur, beg, cp, pos, 3, S_ptree_channel);
- if (dur <= 0) return(XEN_FALSE);
- if ((beg + dur) > cp->edits[pos]->samples)
- {
- if (!(extend_with_zeros(cp, cp->edits[pos]->samples, beg + dur - cp->edits[pos]->samples, pos, "extend for " S_ptree_channel)))
- return(XEN_FALSE);
- backup = true;
- pos = cp->edit_ctr;
- }
-
-#if (!HAVE_SCHEME)
- if (XEN_STRING_P(origin)) caller = mus_strdup(XEN_TO_C_STRING(origin)); else caller = mus_strdup(S_ptree_channel);
- g_map_chan_ptree_fallback(proc, init_func, cp, beg, dur, pos, caller);
- if (caller) {free(caller); caller = NULL;}
-#else
-
- too_many_ptrees = unptreeable(cp, beg, dur, pos);
-
- if (XEN_PROCEDURE_P(init_func))
+ cur_size = num;
+ for (kp = 0; kp < num; kp++)
{
+#if HAVE_SCHEME
+ if (use_apply)
+ {
+ s7_set_car(arg_list, s7_make_real(s7, in_data[kp]));
+ if (kp == 0)
+ res = s7_call_with_location(s7, proc, arg_list, __func__, __FILE__, __LINE__);
+ else res = s7_apply_function(s7, proc, arg_list);
+ }
+ else
+ {
+ s7_slot_set_value(s7, slot, s7_make_real(s7, in_data[kp]));
+ res = eval(s7, body, e);
+ }
+#else
+ res = Xen_unprotected_call_with_1_arg(proc, C_double_to_Xen_real((double)read_sample(sf)));
+#endif
- /* fprintf(stderr, "init: %s\n", XEN_AS_STRING(XEN_CAR(XEN_PROCEDURE_SOURCE(init_func)))); */
-
- if ((!(XEN_REQUIRED_ARGS_OK(init_func, 2))) &&
- (!(XEN_REQUIRED_ARGS_OK(init_func, 3))))
- XEN_BAD_ARITY_ERROR(S_ptree_channel, 8, init_func, "init-func must take 2 or 3 args");
- if (!(XEN_REQUIRED_ARGS_OK(proc, 3)))
- XEN_BAD_ARITY_ERROR(S_ptree_channel, 1, proc, "main func must take 3 args if the init-func is present");
- if (XEN_STRING_P(origin)) caller = mus_strdup(XEN_TO_C_STRING(origin)); else caller = mus_strdup(S_ptree_channel);
-
- if (!too_many_ptrees)
+ if (Xen_is_number(res)) /* one number -> replace current sample */
{
- pt = mus_run_form_to_ptree_3_f(XEN_PROCEDURE_SOURCE(proc_and_list));
- if (pt)
+ if (data_pos >= cur_size)
{
- ptree_channel(cp, pt, beg, dur, pos, XEN_TRUE_P(env_too), init_func, caller);
- if (backup)
- backup_edit_list(cp);
- if (caller) {free(caller); caller = NULL;}
- return(proc_and_list);
+ cur_size *= 2;
+ data = (mus_float_t *)realloc(data, cur_size * sizeof(mus_float_t));
}
+ data[data_pos++] = Xen_real_to_C_double(res);
}
+ else
+ {
+ if (!Xen_is_false(res)) /* if #f, no output on this pass */
+ {
+ if (Xen_is_true(res)) /* if #t we halt the entire map */
+ break;
+ else
+ {
+ if (mus_is_vct(res))
+ {
+ vct *v;
+ mus_long_t vlen;
+ mus_float_t *vdata;
- /* fallback on map chan */
- g_map_chan_ptree_fallback(proc, init_func, cp, beg, dur, pos, caller);
- if (backup)
- backup_edit_list(cp);
- if (caller) {free(caller); caller = NULL;}
- return(proc_and_list);
- }
+ v = Xen_to_vct(res);
+ vlen = mus_vct_length(v);
+ vdata = mus_vct_data(v);
- /* no init-func from here on */
+ for (i = 0; i < vlen; i++)
+ {
+ if (data_pos >= cur_size)
+ {
+ cur_size *= 2;
+ data = (mus_float_t *)realloc(data, cur_size * sizeof(mus_float_t));
+ }
+ data[data_pos++] = vdata[i];
+ }
+ }
+ else
+ {
+ if (data) {free(data); data = NULL;}
+ sf = free_snd_fd(sf);
+#if HAVE_SCHEME
+ s7_gc_unprotect_at(s7, gc_loc);
+ s7_gc_unprotect_at(s7, proc_loc);
+#endif
+ Xen_error(BAD_TYPE,
+ Xen_list_3(C_string_to_Xen_string("~A: result of procedure must be a number, boolean, or vct: ~A"),
+ C_string_to_Xen_string(caller),
+ res));
+ }
+ }
+ }
+ }
+ }
+ sf = free_snd_fd(sf);
+#if HAVE_SCHEME
+ free(in_data);
+ s7_gc_unprotect_at(s7, gc_loc);
+ s7_gc_unprotect_at(s7, proc_loc);
+#endif
- if (XEN_STRING_P(origin)) caller = mus_strdup(XEN_TO_C_STRING(origin)); else caller = mus_strdup(S_ptree_channel);
- if (XEN_REQUIRED_ARGS_OK(proc, 1))
- pt = mus_run_form_to_ptree_1_f(XEN_PROCEDURE_SOURCE(proc_and_list));
- else
+ if (cp->active < CHANNEL_HAS_EDIT_LIST)
{
- if ((!too_many_ptrees) && (XEN_REQUIRED_ARGS_OK(proc, 3)))
- pt = mus_run_form_to_ptree_3_f(XEN_PROCEDURE_SOURCE(proc_and_list));
+ if (data) {free(data); data = NULL;}
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_2(C_string_to_Xen_string("~A: can't edit closed channel!"),
+ C_string_to_Xen_string(caller)));
+ return(Xen_false);
}
- if (pt)
+ if (data_pos == num)
+ change_samples(beg, data_pos, data, cp, caller, pos, -1.0);
+ else
{
- if (too_many_ptrees)
+ /* the version above truncates to the new length... */
+ delete_samples(beg, num, cp, pos);
+ if (data_pos > 0)
{
- run_channel(cp, pt, beg, dur, pos, caller, S_ptree_channel);
- mus_run_free_ptree(pt);
- pt = NULL;
+ int cured;
+ cured = cp->edit_ctr;
+ insert_samples(beg, data_pos, data, cp, caller, cp->edit_ctr);
+ backup_edit_list(cp);
+ if (cp->edit_ctr > cured)
+ backup_edit_list(cp);
+ ripple_trailing_marks(cp, beg, num, data_pos);
}
- else ptree_channel(cp, pt, beg, dur, pos, XEN_TRUE_P(env_too), init_func, caller);
}
- else g_map_chan_ptree_fallback(proc, init_func, cp, beg, dur, pos, caller);
- if (backup)
- backup_edit_list(cp);
- if (caller) {free(caller); caller = NULL;}
-#endif
- return(proc_and_list);
+ if (data) {free(data); data = NULL;}
+ return(res);
}
-static XEN g_sp_scan(XEN proc_and_list, XEN s_beg, XEN s_end, XEN snd, XEN chn,
- const char *caller, bool counting, XEN edpos, int arg_pos, XEN s_dur)
-{
+static Xen g_map_chan_1(Xen proc_and_list, Xen s_beg, Xen s_end, Xen org, Xen snd, Xen chn, Xen edpos, Xen s_dur, const char *fallback_caller)
+{
chan_info *cp;
+ const char *caller;
mus_long_t beg = 0, end = 0, dur = 0;
- snd_info *sp;
- snd_fd *sf;
- XEN errstr;
- mus_long_t kp, num;
- int rpt = 0, rpt4;
- bool reporting = false;
- int counts = 0, pos;
- char *errmsg;
- XEN proc = XEN_FALSE;
-#if HAVE_SCHEME
- struct ptree *pt = NULL;
-#endif
+ mus_long_t num;
+ int pos;
+ Xen res = Xen_false;
+ Xen proc;
proc = proc_and_list;
- XEN_ASSERT_TYPE((XEN_PROCEDURE_P(proc)), proc, XEN_ARG_1, caller, "a procedure");
- ASSERT_SAMPLE_TYPE(caller, s_beg, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(caller, s_end, XEN_ARG_3);
- ASSERT_SAMPLE_TYPE(caller, s_dur, XEN_ARG_3);
- ASSERT_CHANNEL(caller, snd, chn, 4);
+ if (Xen_is_string(org))
+ caller = Xen_string_to_C_string(org);
+ else caller = fallback_caller;
- cp = get_cp(snd, chn, caller);
- if (!cp) return(XEN_FALSE);
+ Xen_check_type((Xen_is_procedure(proc)) || (mus_is_xen(proc)), proc, 1, caller, "a procedure");
+ Snd_assert_sample_type(caller, s_beg, 2);
+ Snd_assert_sample_type(caller, s_end, 3);
+ Snd_assert_sample_type(caller, s_dur, 3);
+ Snd_assert_channel(caller, snd, chn, 5);
- pos = to_c_edit_position(cp, edpos, caller, arg_pos);
+ cp = get_cp(snd, chn, caller);
+ if (!cp) return(Xen_false);
+ if (!(is_editable(cp))) return(Xen_false);
+ pos = to_c_edit_position(cp, edpos, caller, 7);
beg = beg_to_sample(s_beg, caller);
- if (beg > cp->edits[pos]->samples) return(XEN_FALSE);
- if (XEN_FALSE_P(s_dur))
+ if (Xen_is_false(s_dur))
end = end_to_sample(s_end, cp, pos, caller);
- else dur = dur_to_samples(s_dur, beg, cp, pos, 3, caller);
-
- errmsg = procedure_ok(proc, 1, caller, "", 1);
- if (errmsg)
- {
- errstr = C_TO_XEN_STRING(errmsg);
- free(errmsg);
- return(snd_bad_arity_error(caller, errstr, proc));
- }
-
- sp = cp->sound;
+ else dur = dur_to_samples(s_dur, beg, cp, pos, 3, caller); /* 3 is arg num from caller's point of view */
if (end == 0)
{
- if (dur != 0)
+ if (dur != 0)
end = beg + dur - 1;
else end = cp->edits[pos]->samples - 1;
}
num = end - beg + 1;
- if (num <= 0) return(XEN_FALSE);
- sf = init_sample_read_any(beg, cp, READ_FORWARD, pos);
- if (sf == NULL) return(XEN_TRUE);
+ if (num > 0)
+ {
+ snd_fd *sf = NULL;
+ char *errmsg = NULL;
+ bool temp_file, backup = false;
+
+ errmsg = procedure_ok(proc, 1, caller, "", 1);
+ if (errmsg)
+ {
+ Xen errstr;
+ errstr = C_string_to_Xen_string(errmsg);
+ free(errmsg);
+ return(snd_bad_arity_error(caller, errstr, proc));
+ }
+
+ /* added 27-Oct-06 -- can't see why map-channel should be that different from insert-samples et al */
+ if (beg > cp->edits[pos]->samples)
+ {
+ if (!(extend_with_zeros(cp, cp->edits[pos]->samples, beg - cp->edits[pos]->samples, pos, "extend for " S_map_channel)))
+ return(Xen_false);
+ backup = true;
+ pos = cp->edit_ctr;
+ }
+
+ sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, pos, (num > REPORTING_SIZE) ? REPORTING_SIZE : num);
+ if (sf == NULL)
+ return(Xen_true);
+
+ temp_file = (num > REPORTING_SIZE);
+ if (temp_file)
+ res = map_channel_to_temp_file(cp, sf, proc, beg, num, pos, caller);
+ else res = map_channel_to_buffer(cp, sf, proc, beg, num, pos, caller);
+
+ if (backup)
+ backup_edit_list(cp);
+
+ update_graph(cp);
+ }
+ return(res);
+}
+
+
+static Xen g_sp_scan(Xen proc_and_list, Xen s_beg, Xen s_end, Xen snd, Xen chn, const char *caller, bool counting, Xen edpos, int arg_pos, Xen s_dur)
+{
+ chan_info *cp;
+ mus_long_t beg = 0, end = 0, dur = 0;
+ snd_info *sp;
+ snd_fd *sf;
+ mus_long_t kp, num;
+ int rpt = 0, rpt4 = 0;
+ bool reporting = false;
+ int counts = 0, pos;
+ char *errmsg;
+ Xen proc;
+
+ proc = proc_and_list;
+
+ Xen_check_type((Xen_is_procedure(proc)), proc, 1, caller, "a procedure");
+ Snd_assert_sample_type(caller, s_beg, 2);
+ Snd_assert_sample_type(caller, s_end, 3);
+ Snd_assert_sample_type(caller, s_dur, 3);
+ Snd_assert_channel(caller, snd, chn, 4);
+
+ cp = get_cp(snd, chn, caller);
+ if (!cp) return(Xen_false);
+
+ pos = to_c_edit_position(cp, edpos, caller, arg_pos);
+
+ beg = beg_to_sample(s_beg, caller);
+ if (beg > cp->edits[pos]->samples) return(Xen_false);
+ if (Xen_is_false(s_dur))
+ end = end_to_sample(s_end, cp, pos, caller);
+ else dur = dur_to_samples(s_dur, beg, cp, pos, 3, caller);
+
+ errmsg = procedure_ok(proc, 1, caller, "", 1);
+ if (errmsg)
+ {
+ Xen errstr;
+ errstr = C_string_to_Xen_string(errmsg);
+ free(errmsg);
+ return(snd_bad_arity_error(caller, errstr, proc));
+ }
+
+ sp = cp->sound;
+ if (end == 0)
+ {
+ if (dur != 0)
+ end = beg + dur - 1;
+ else end = cp->edits[pos]->samples - 1;
+ }
+ num = end - beg + 1;
+ if (num <= 0) return(Xen_false);
+ sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, pos, (num < REPORTING_SIZE) ? REPORTING_SIZE : num);
+ if (sf == NULL) return(Xen_true);
+ sampler_set_safe(sf, num);
#if HAVE_SCHEME
- if (optimization(ss) > 0)
+ {
+ s7_pointer arg_list;
+ int gc_loc;
+ bool use_apply;
+ s7_pointer body, e, slot;
+ s7_pointer (*eval)(s7_scheme *sc, s7_pointer code, s7_pointer e);
+
+ arg_list = xen_nil;
+ body = xen_nil;
+ e = xen_nil;
+ slot = xen_nil;
+ eval = NULL;
+
+ body = s7_closure_body(s7, proc);
+ if ((s7_is_pair(body)) &&
+ (s7_is_pair(s7_closure_args(s7, proc))))
{
- pt = mus_run_form_to_ptree_1_b(XEN_PROCEDURE_SOURCE(proc_and_list));
- if (pt)
+ s7_pointer arg, expr;
+
+ arg = s7_car(s7_closure_args(s7, proc));
+ if (s7_is_pair(arg)) arg = s7_car(arg);
+ expr = s7_car(body);
+
+ if (expr == xen_false)
{
- for (kp = 0; kp < num; kp++)
- if (mus_run_evaluate_ptree_1f2b(pt, read_sample(sf)))
- {
- if (counting)
- counts++;
- else
- {
- sf = free_snd_fd(sf);
- mus_run_free_ptree(pt);
- return(C_TO_XEN_INT64_T(kp + beg));
- }
- }
- sf = free_snd_fd(sf);
- mus_run_free_ptree(pt);
- if (counting)
- return(C_TO_XEN_INT(counts));
- return(XEN_FALSE);
+ free_snd_fd(sf);
+ return(xen_false);
+ }
+ if (!s7_is_pair(expr))
+ {
+ free_snd_fd(sf);
+ return(s_beg);
+ }
+
+ if (s7_is_null(s7, s7_cdr(body)))
+ {
+ s7_pointer res;
+ res = s7_car(body);
+
+ /* try pf mechanism */
+ if (s7_is_symbol(s7_car(res)))
+ {
+ s7_pointer fcar;
+ fcar = s7_symbol_value(s7, s7_car(res));
+ if (s7_pf_function(s7, fcar))
+ {
+ s7_pf_t pf;
+ s7_pointer yp, old_e, y, val;
+
+ e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
+ old_e = s7_set_curlet(s7, e); /* new env for scan lambda */
+ y = s7_make_mutable_real(s7, 1.5); /* slot for the scan lambda arg */
+ yp = s7_make_slot(s7, e, arg, y);
+ val = y;
+
+ s7_xf_new(s7, e);
+ pf = s7_pf_function(s7, fcar)(s7, res);
+
+ if (pf)
+ {
+ s7_pointer *top, *p;
+ top = s7_xf_start(s7);
+ for (kp = 0; kp < num; kp++)
+ {
+ s7_slot_set_real_value(s7, yp, read_sample(sf));
+ p = top;
+ val = pf(s7, &p);
+ if (val != s7_f(s7))
+ {
+ if (counting)
+ counts++;
+ else
+ {
+ if (reporting) finish_progress_report(cp);
+ sf = free_snd_fd(sf);
+ s7_xf_free(s7);
+ s7_set_curlet(s7, old_e);
+ return(C_llong_to_Xen_llong(kp + beg));
+ }
+ }
+ }
+ s7_xf_free(s7);
+ sf = free_snd_fd(sf);
+ s7_set_curlet(s7, old_e);
+ if (counting)
+ return(C_int_to_Xen_integer(counts));
+ return(val);
+ }
+ s7_xf_free(s7);
+ s7_set_curlet(s7, old_e);
+ }
+ }
+ }
+
+ e = s7_sublet(s7, s7_closure_let(s7, proc), s7_nil(s7));
+ gc_loc = s7_gc_protect(s7, e);
+ slot = s7_make_slot(s7, e, arg, s7_make_real(s7, 0.0));
+ use_apply = false;
+
+ if (s7_is_null(s7, s7_cdr(body)))
+ {
+ eval = s7_eval_form;
+ body = s7_car(body);
}
+ else eval = s7_eval;
}
-#endif
+ else
+ {
+ /* is this for built-in funcs? */
+ arg_list = Xen_list_1(Xen_false);
+ gc_loc = s7_gc_protect(s7, arg_list);
+ use_apply = true;
+ }
+
+ /* fprintf(stderr, "scan %lld: body: %s\n", num, s7_object_to_c_string(s7, body)); */
reporting = ((num > REPORTING_SIZE) && (!(cp->squelch_update)));
if (reporting) start_progress_report(cp);
rpt4 = MAX_BUFFER_SIZE / 4;
ss->stopped_explicitly = false;
-#if HAVE_SCHEME
- {
- s7_pointer arg_list;
- int gc_loc;
- arg_list = XEN_LIST_1(XEN_FALSE);
- gc_loc = s7_gc_protect(s7, arg_list);
-#endif
-
for (kp = 0; kp < num; kp++)
{
- XEN res;
-#if HAVE_SCHEME
- s7_set_car(arg_list, C_TO_XEN_DOUBLE((double)read_sample(sf)));
- res = s7_call_with_location(s7, proc, arg_list, c__FUNCTION__, __FILE__, __LINE__);
+ Xen res;
+ if (use_apply)
+ {
+ s7_set_car(arg_list, s7_make_real(s7, read_sample(sf)));
+ if (kp == 0)
+ res = s7_call_with_location(s7, proc, arg_list, __func__, __FILE__, __LINE__);
+ else res = s7_apply_function(s7, proc, arg_list);
+ }
+ else
+ {
+ s7_slot_set_value(s7, slot, s7_make_real(s7, read_sample(sf)));
+ res = eval(s7, body, e);
+ }
+
#else
- res = XEN_CALL_1_NO_CATCH(proc, C_TO_XEN_DOUBLE((double)read_sample(sf)));
+ for (kp = 0; kp < num; kp++)
+ {
+ Xen res;
+ res = Xen_unprotected_call_with_1_arg(proc, C_double_to_Xen_real((double)read_sample(sf)));
#endif
/* leak here -- if reader active and error occurs, we jump out without cleanup */
/* see dynamic_wind above */
- if (XEN_NOT_FALSE_P(res))
+ if (!Xen_is_false(res))
{
if ((counting) &&
- (XEN_TRUE_P(res)))
+ (Xen_is_true(res)))
counts++;
else
{
@@ -3995,7 +4033,7 @@ static XEN g_sp_scan(XEN proc_and_list, XEN s_beg, XEN s_end, XEN snd, XEN chn,
#if HAVE_SCHEME
s7_gc_unprotect_at(s7, gc_loc);
#endif
- return(C_TO_XEN_INT64_T(kp + beg));
+ return(C_llong_to_Xen_llong(kp + beg));
}
}
if (reporting)
@@ -4015,7 +4053,7 @@ static XEN g_sp_scan(XEN proc_and_list, XEN s_beg, XEN s_end, XEN snd, XEN chn,
if (ss->stopped_explicitly)
{
ss->stopped_explicitly = false;
- report_in_minibuffer(sp, "%s stopped at sample " MUS_LD, caller, kp + beg);
+ status_report(sp, "%s stopped at sample %lld", caller, kp + beg);
break;
}
}
@@ -4026,13 +4064,24 @@ static XEN g_sp_scan(XEN proc_and_list, XEN s_beg, XEN s_end, XEN snd, XEN chn,
if (reporting) finish_progress_report(cp);
sf = free_snd_fd(sf);
if (counting)
- return(C_TO_XEN_INT(counts));
+ return(C_int_to_Xen_integer(counts));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_scan_chan(XEN proc, XEN beg, XEN end, XEN snd, XEN chn, XEN edpos)
+mus_long_t scan_channel(chan_info *cp, mus_long_t start, mus_long_t end, Xen proc)
+{
+ Xen result;
+ result = g_sp_scan(proc, C_llong_to_Xen_llong(start), C_llong_to_Xen_llong(end),
+ Xen_false, Xen_false, "search procedure", false, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0, Xen_false);
+ if (Xen_is_llong(result))
+ return(Xen_llong_to_C_llong(result));
+ return(-1);
+}
+
+#if (!HAVE_SCHEME)
+static Xen g_scan_chan(Xen proc, Xen beg, Xen end, Xen snd, Xen chn, Xen edpos)
{
#if HAVE_SCHEME
#define scan_chan_example "(scan-chan (lambda (y) (> y .1)))"
@@ -4049,12 +4098,12 @@ apply 'func' to samples in current channel (or the specified channel). \
'func' is a function of one argument, the current sample. \
if 'func' returns non-" PROC_FALSE ", the scan stops, and the current sample number is returned.\n " scan_chan_example
- ASSERT_CHANNEL(S_scan_chan, snd, chn, 4);
- return(g_sp_scan(proc, beg, end, snd, chn, S_scan_chan, false, edpos, 6, XEN_FALSE));
+ Snd_assert_channel(S_scan_chan, snd, chn, 4);
+ return(g_sp_scan(proc, beg, end, snd, chn, S_scan_chan, false, edpos, 6, Xen_false));
}
+#endif
-
-static XEN g_scan_channel(XEN proc, XEN beg, XEN dur, XEN snd, XEN chn, XEN edpos)
+static Xen g_scan_channel(Xen proc, Xen beg, Xen dur, Xen snd, Xen chn, Xen edpos)
{
#if HAVE_SCHEME
#define scan_channel_example "(scan-channel (lambda (y) (> y .1)))"
@@ -4071,12 +4120,13 @@ apply func to samples in current channel (or the specified channel). \
func is a function of one argument, the current sample. \
if func returns non-" PROC_FALSE ", the scan stops, and the current sample number is returned. \n " scan_channel_example
- ASSERT_CHANNEL(S_scan_channel, snd, chn, 4);
- return(g_sp_scan(proc, beg, XEN_FALSE, snd, chn, S_scan_channel, false, edpos, 6, (XEN_BOUND_P(dur)) ? dur : XEN_FALSE));
+ Snd_assert_channel(S_scan_channel, snd, chn, 4);
+ return(g_sp_scan(proc, beg, Xen_false, snd, chn, S_scan_channel, false, edpos, 6, (Xen_is_bound(dur)) ? dur : Xen_false));
}
-static XEN g_map_chan(XEN proc, XEN s_beg, XEN s_end, XEN org, XEN snd, XEN chn, XEN edpos)
+#if (!HAVE_SCHEME)
+static Xen g_map_chan(Xen proc, Xen s_beg, Xen s_end, Xen org, Xen snd, Xen chn, Xen edpos)
{
#if HAVE_SCHEME
#define map_chan_example "(map-chan (lambda (y) (* y 2.0)))"
@@ -4091,11 +4141,12 @@ static XEN g_map_chan(XEN proc, XEN s_beg, XEN s_end, XEN org, XEN snd, XEN chn,
#define H_map_chan "(" S_map_chan " func :optional (start 0) (end len) edname snd chn edpos): \
apply func to samples in current channel; edname is the edit history name for this editing operation.\n " map_chan_example
- return(g_map_chan_1(proc, s_beg, s_end, org, snd, chn, edpos, XEN_FALSE, S_map_chan));
+ return(g_map_chan_1(proc, s_beg, s_end, org, snd, chn, edpos, Xen_false, S_map_chan));
}
+#endif
-static XEN g_map_channel(XEN proc, XEN s_beg, XEN s_dur, XEN snd, XEN chn, XEN edpos, XEN org)
+static Xen g_map_channel(Xen proc, Xen s_beg, Xen s_dur, Xen snd, Xen chn, Xen edpos, Xen org)
{
#if HAVE_SCHEME
#define map_channel_example "(map-channel (lambda (y) (* y 2.0)))"
@@ -4110,11 +4161,12 @@ static XEN g_map_channel(XEN proc, XEN s_beg, XEN s_dur, XEN snd, XEN chn, XEN e
#define H_map_channel "(" S_map_channel " func :optional (start 0) (dur len) snd chn edpos edname): \
apply func to samples in current channel; edname is the edit history name for this editing operation.\n " map_channel_example
- return(g_map_chan_1(proc, s_beg, XEN_FALSE, org, snd, chn, edpos, (XEN_BOUND_P(s_dur)) ? s_dur : XEN_FALSE, S_map_channel));
+ return(g_map_chan_1(proc, s_beg, Xen_false, org, snd, chn, edpos, (Xen_is_bound(s_dur)) ? s_dur : Xen_false, S_map_channel));
}
-static XEN g_find_channel(XEN expr, XEN sample, XEN snd, XEN chn_n, XEN edpos)
+#if (!HAVE_SCHEME)
+static Xen g_find_channel(Xen expr, Xen sample, Xen snd, Xen chn_n, Xen edpos)
{
#if HAVE_SCHEME
#define find_channel_example "(find-channel (lambda (y) (> y .1)))"
@@ -4130,12 +4182,13 @@ static XEN g_find_channel(XEN expr, XEN sample, XEN snd, XEN chn_n, XEN edpos)
the current sample, to each sample in snd's channel chn, starting at 'start-samp' until func returns something other than " PROC_FALSE ": \n " find_channel_example
/* no free here -- it's handled as ss->search_expr in snd-find.c */
- ASSERT_CHANNEL(S_find_channel, snd, chn_n, 3);
- return(g_sp_scan(expr, sample, XEN_FALSE, snd, chn_n, S_find_channel, false, edpos, 5, XEN_FALSE));
+ Snd_assert_channel(S_find_channel, snd, chn_n, 3);
+ return(g_sp_scan(expr, sample, Xen_false, snd, chn_n, S_find_channel, false, edpos, 5, Xen_false));
}
+#endif
-static XEN g_count_matches(XEN expr, XEN sample, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_count_matches(Xen expr, Xen sample, Xen snd, Xen chn_n, Xen edpos)
{
#if HAVE_SCHEME
#define count_matches_example "(count-matches (lambda (y) (> y .1)))"
@@ -4150,24 +4203,24 @@ static XEN g_count_matches(XEN expr, XEN sample, XEN snd, XEN chn_n, XEN edpos)
#define H_count_matches "(" S_count_matches " func :optional (start-samp 0) snd chn edpos): return how many \
samples satisfy func (a function of one argument, the current sample, returning " PROC_TRUE " upon match):\n " count_matches_example
- ASSERT_CHANNEL(S_count_matches, snd, chn_n, 3);
- return(g_sp_scan(expr, sample, XEN_FALSE, snd, chn_n, S_count_matches, true, edpos, 5, XEN_FALSE));
+ Snd_assert_channel(S_count_matches, snd, chn_n, 3);
+ return(g_sp_scan(expr, sample, Xen_false, snd, chn_n, S_count_matches, true, edpos, 5, Xen_false));
}
-static XEN g_smooth_sound(XEN beg, XEN num, XEN snd, XEN chn_n)
+static Xen g_smooth_sound(Xen beg, Xen num, Xen snd, Xen chn_n)
{
#define H_smooth_sound "(" S_smooth_sound " :optional (start-samp 0) (samps len) snd chn): smooth \
data from start-samp for samps in snd's channel chn"
chan_info *cp;
mus_long_t start, samps;
- ASSERT_SAMPLE_TYPE(S_smooth_sound, beg, XEN_ARG_1);
- ASSERT_SAMPLE_TYPE(S_smooth_sound, num, XEN_ARG_2);
- ASSERT_CHANNEL(S_smooth_sound, snd, chn_n, 3);
+ Snd_assert_sample_type(S_smooth_sound, beg, 1);
+ Snd_assert_sample_type(S_smooth_sound, num, 2);
+ Snd_assert_channel(S_smooth_sound, snd, chn_n, 3);
cp = get_cp(snd, chn_n, S_smooth_sound);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
start = beg_to_sample(beg, S_smooth_sound);
samps = dur_to_samples(num, start, cp, cp->edit_ctr, 2, S_smooth_sound);
@@ -4177,7 +4230,7 @@ data from start-samp for samps in snd's channel chn"
}
-static XEN g_smooth_channel(XEN beg, XEN dur, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_smooth_channel(Xen beg, Xen dur, Xen snd, Xen chn_n, Xen edpos)
{
#define H_smooth_channel "(" S_smooth_channel " :optional (beg 0) (dur len) snd chn edpos): \
smooth data from beg for dur in snd's channel chn"
@@ -4185,12 +4238,12 @@ smooth data from beg for dur in snd's channel chn"
mus_long_t start, num;
int pos;
- ASSERT_SAMPLE_TYPE(S_smooth_channel, beg, XEN_ARG_1);
- ASSERT_SAMPLE_TYPE(S_smooth_channel, dur, XEN_ARG_2);
- ASSERT_CHANNEL(S_smooth_channel, snd, chn_n, 3);
+ Snd_assert_sample_type(S_smooth_channel, beg, 1);
+ Snd_assert_sample_type(S_smooth_channel, dur, 2);
+ Snd_assert_channel(S_smooth_channel, snd, chn_n, 3);
cp = get_cp(snd, chn_n, S_smooth_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, S_smooth_channel, 5);
start = beg_to_sample(beg, S_smooth_channel);
num = dur_to_samples(dur, start, cp, pos, 2, S_smooth_channel);
@@ -4203,74 +4256,72 @@ smooth data from beg for dur in snd's channel chn"
}
-static XEN g_smooth_selection(void)
+static Xen g_smooth_selection(void)
{
#define H_smooth_selection "(" S_smooth_selection "): smooth the data in the currently selected portion"
chan_info *cp;
if (!(selection_is_active()))
return(snd_no_active_selection_error(S_smooth_selection));
- cp = get_cp(XEN_FALSE, XEN_FALSE, S_smooth_selection);
- if (!cp) return(XEN_FALSE);
+ cp = get_cp(Xen_false, Xen_false, S_smooth_selection);
+ if (!cp) return(Xen_false);
cos_smooth(cp, 0, 0, OVER_SELECTION);
- return(XEN_TRUE);
+ return(Xen_true);
}
-static void cut_and_smooth_1(chan_info *cp, mus_long_t beg, mus_long_t end, bool over_selection)
+static void cut_and_smooth_1(chan_info *cp, mus_long_t beg, mus_long_t end, bool over_selection, int pos)
{
#define SPLICE_LEN 32
/* making this 128 is not a big improvement */
- mus_long_t frames, start;
- mus_sample_t splice[2 * SPLICE_LEN];
+ mus_long_t start;
+ mus_float_t splice[2 * SPLICE_LEN];
double ramp, incr;
int i;
snd_fd *sf, *sf_end;
incr = 0.5 / SPLICE_LEN;
- frames = CURRENT_SAMPLES(cp);
-
if (end < SPLICE_LEN)
start = 0;
else start = end - SPLICE_LEN;
- sf_end = init_sample_read_any_with_bufsize(start, cp, READ_FORWARD, cp->edit_ctr, 2 * SPLICE_LEN);
+ sf_end = init_sample_read_any_with_bufsize(start, cp, READ_FORWARD, pos, 2 * SPLICE_LEN);
if (beg < SPLICE_LEN)
start = 0;
else start = beg - SPLICE_LEN;
- sf = init_sample_read_any_with_bufsize(start, cp, READ_FORWARD, cp->edit_ctr, 2 * SPLICE_LEN);
+ sf = init_sample_read_any_with_bufsize(start, cp, READ_FORWARD, pos, 2 * SPLICE_LEN);
for (i = 0, ramp = 1.0; i < 2 * SPLICE_LEN; i++, ramp -= incr)
{
mus_float_t x, y;
x = read_sample(sf);
y = read_sample(sf_end);
- splice[i] = MUS_DOUBLE_TO_SAMPLE((x * ramp) + (y * (1.0 - ramp)));
+ splice[i] = (x * ramp) + (y * (1.0 - ramp));
}
free_snd_fd(sf);
free_snd_fd(sf_end);
if (over_selection)
cp_delete_selection(cp);
- else delete_samples(beg, end - beg + 1, cp, cp->edit_ctr);
+ else delete_samples(beg, end - beg + 1, cp, pos);
change_samples(start, 2 * SPLICE_LEN, splice, cp,
(over_selection) ? S_delete_selection_and_smooth : S_delete_samples_and_smooth,
- cp->edit_ctr);
+ cp->edit_ctr, -1.0);
}
void cut_and_smooth(chan_info *cp)
{
if (selection_is_active_in_channel(cp))
- cut_and_smooth_1(cp, selection_beg(cp), selection_end(cp), true);
+ cut_and_smooth_1(cp, selection_beg(cp), selection_end(cp), true, cp->edit_ctr);
}
-static XEN g_delete_selection_and_smooth(void)
+static Xen g_delete_selection_and_smooth(void)
{
#define H_delete_selection_and_smooth "(" S_delete_selection_and_smooth ") deletes the current selection, and tries to \
make the splice-point smooth."
@@ -4278,12 +4329,12 @@ make the splice-point smooth."
if (!(selection_is_active()))
return(snd_no_active_selection_error(S_delete_selection_and_smooth));
for_each_chan(cut_and_smooth);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_delete_samples_and_smooth(XEN samp_n, XEN samps, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_delete_samples_and_smooth(Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos)
{
#define H_delete_samples_and_smooth "(" S_delete_samples_and_smooth " start-samp samps :optional snd chn edpos): \
delete 'samps' samples from snd's channel chn starting at 'start-samp', then try to smooth-over the splice"
@@ -4292,41 +4343,46 @@ delete 'samps' samples from snd's channel chn starting at 'start-samp', then try
int pos;
mus_long_t samp, len;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samp_n), samp_n, XEN_ARG_1, S_delete_samples_and_smooth, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(samps), samps, XEN_ARG_2, S_delete_samples_and_smooth, "a number");
+ Xen_check_type(Xen_is_integer(samp_n), samp_n, 1, S_delete_samples_and_smooth, "an integer");
+ Xen_check_type(Xen_is_llong(samps), samps, 2, S_delete_samples_and_smooth, "an integer");
- ASSERT_CHANNEL(S_delete_samples_and_smooth, snd, chn_n, 3);
+ Snd_assert_channel(S_delete_samples_and_smooth, snd, chn_n, 3);
cp = get_cp(snd, chn_n, S_delete_samples_and_smooth);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- pos = to_c_edit_position(cp, edpos, S_delete_samples_and_smooth, 6);
+ pos = to_c_edit_position(cp, edpos, S_delete_samples_and_smooth, 5);
samp = beg_to_sample(samp_n, S_delete_samples_and_smooth);
- len = XEN_TO_C_INT64_T_OR_ELSE(samps, 0);
- if (len <= 0) return(XEN_FALSE);
+ if (samp > cp->edits[pos]->samples)
+ Xen_out_of_range_error(S_delete_samples_and_smooth, 1, samp_n, "beyond end of sound");
+
+ len = Xen_llong_to_C_llong(samps);
+ if (len <= 0) return(Xen_false);
+ if (len > cp->edits[pos]->samples)
+ len = cp->edits[pos]->samples;
- cut_and_smooth_1(cp, samp, samp + len - 1, false);
+ cut_and_smooth_1(cp, samp, samp + len - 1, false, pos);
update_graph(cp);
return(samp_n);
}
-static XEN g_reverse_sound(XEN snd, XEN chn_n, XEN edpos)
+static Xen g_reverse_sound(Xen snd, Xen chn_n, Xen edpos)
{
#define H_reverse_sound "(" S_reverse_sound " :optional snd chn edpos): reverse snd's channel chn"
chan_info *cp;
- ASSERT_CHANNEL(S_reverse_sound, snd, chn_n, 1);
+ Snd_assert_channel(S_reverse_sound, snd, chn_n, 1);
cp = get_cp(snd, chn_n, S_reverse_sound);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
reverse_sound(cp, OVER_SOUND, edpos, 3);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_reverse_selection(void)
+static Xen g_reverse_selection(void)
{
#define H_reverse_selection "(" S_reverse_selection "): reverse the data in the currently selected portion"
chan_info *cp;
@@ -4334,16 +4390,16 @@ static XEN g_reverse_selection(void)
if (!(selection_is_active()))
return(snd_no_active_selection_error(S_reverse_selection));
- cp = get_cp(XEN_FALSE, XEN_FALSE, S_reverse_selection);
- if (!cp) return(XEN_FALSE);
+ cp = get_cp(Xen_false, Xen_false, S_reverse_selection);
+ if (!cp) return(Xen_false);
- reverse_sound(cp, OVER_SELECTION, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
+ reverse_sound(cp, OVER_SELECTION, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), 0);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_reverse_channel(XEN s_beg, XEN s_dur, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_reverse_channel(Xen s_beg, Xen s_dur, Xen snd, Xen chn_n, Xen edpos)
{
#define H_reverse_channel "(" S_reverse_channel " :optional (beg 0) (dur len) snd chn edpos): reverse a portion of snd's channel chn"
chan_info *cp;
@@ -4352,16 +4408,16 @@ static XEN g_reverse_channel(XEN s_beg, XEN s_dur, XEN snd, XEN chn_n, XEN edpos
int pos;
snd_fd *sf;
- ASSERT_SAMPLE_TYPE(S_reverse_channel, s_beg, XEN_ARG_1);
- ASSERT_SAMPLE_TYPE(S_reverse_channel, s_dur, XEN_ARG_2);
- ASSERT_CHANNEL(S_reverse_channel, snd, chn_n, 3);
+ Snd_assert_sample_type(S_reverse_channel, s_beg, 1);
+ Snd_assert_sample_type(S_reverse_channel, s_dur, 2);
+ Snd_assert_channel(S_reverse_channel, snd, chn_n, 3);
cp = get_cp(snd, chn_n, S_reverse_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
beg = beg_to_sample(s_beg, S_reverse_channel);
pos = to_c_edit_position(cp, edpos, S_reverse_channel, 5);
dur = dur_to_samples(s_dur, beg, cp, pos, 2, S_reverse_channel);
- if ((beg > cp->edits[pos]->samples) || (dur == 0)) return(XEN_FALSE);
+ if ((beg > cp->edits[pos]->samples) || (dur == 0)) return(Xen_false);
end = beg + dur;
if (end > cp->edits[pos]->samples)
end = cp->edits[pos]->samples;
@@ -4372,35 +4428,35 @@ static XEN g_reverse_channel(XEN s_beg, XEN s_dur, XEN snd, XEN chn_n, XEN edpos
free_snd_fd(sf);
if (errmsg)
{
- XEN str;
- str = C_TO_XEN_STRING(errmsg);
+ Xen str;
+ str = C_string_to_Xen_string(errmsg);
free(errmsg);
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_reverse_channel ": IO error ~A"),
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_2(C_string_to_Xen_string(S_reverse_channel ": IO error ~A"),
str));
}
return(s_beg);
}
-static XEN g_insert_silence(XEN beg, XEN num, XEN snd, XEN chn)
+static Xen g_insert_silence(Xen beg, Xen num, Xen snd, Xen chn)
{
#define H_insert_silence "(" S_insert_silence " beg num :optional snd chn): insert num zeros at beg in snd's chn"
chan_info *cp; /* follows sync */
mus_long_t start = 0, len = 0;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(beg), beg, XEN_ARG_1, S_insert_silence, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(num), num, XEN_ARG_2, S_insert_silence, "a number");
- ASSERT_CHANNEL(S_insert_silence, snd, chn, 3);
+ Xen_check_type(Xen_is_integer(beg), beg, 1, S_insert_silence, "an integer");
+ Xen_check_type(Xen_is_integer(num), num, 2, S_insert_silence, "an integer");
+ Snd_assert_channel(S_insert_silence, snd, chn, 3);
cp = get_cp(snd, chn, S_insert_silence);
- if (!cp) return(XEN_FALSE);
- start = XEN_TO_C_INT64_T(beg);
- if (start < 0) XEN_ERROR(NO_SUCH_SAMPLE,
- XEN_LIST_2(C_TO_XEN_STRING(S_insert_silence ": no such sample: ~A"),
- beg));
- len = XEN_TO_C_INT64_T(num);
- if (len <= 0) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
+
+ start = beg_to_sample(beg, S_insert_silence);
+ len = Xen_llong_to_C_llong(num);
+ if (len <= 0) return(Xen_false);
+ if (len > (1LL << 34))
+ Xen_out_of_range_error(S_insert_silence, 2, num, "too large");
cursor_insert(cp, start, len);
@@ -4408,22 +4464,28 @@ static XEN g_insert_silence(XEN beg, XEN num, XEN snd, XEN chn)
}
-static XEN g_pad_channel(XEN beg, XEN num, XEN snd, XEN chn, XEN edpos)
+static Xen g_pad_channel(Xen beg, Xen num, Xen snd, Xen chn, Xen edpos)
{
#define H_pad_channel "(" S_pad_channel " beg dur :optional snd chn edpos): insert dur zeros at beg in snd's chn"
chan_info *cp;
mus_long_t bg, len;
int pos;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(beg), beg, XEN_ARG_1, S_pad_channel, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(num), num, XEN_ARG_2, S_pad_channel, "a number");
- ASSERT_CHANNEL(S_pad_channel, snd, chn, 3);
+ Xen_check_type(Xen_is_integer(beg), beg, 1, S_pad_channel, "an integer");
+ Xen_check_type(Xen_is_integer(num), num, 2, S_pad_channel, "an integer");
+ Snd_assert_channel(S_pad_channel, snd, chn, 3);
cp = get_cp(snd, chn, S_pad_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
+
bg = beg_to_sample(beg, S_pad_channel);
+
+ len = Xen_llong_to_C_llong(num);
+ if (len <= 0) return(Xen_false); /* to parallel insert-silence above -- maybe better would be an out of range error in both cases */
+ if (len > (1LL << 34))
+ Xen_out_of_range_error(S_pad_channel, 2, num, "too large");
+
pos = to_c_edit_position(cp, edpos, S_pad_channel, 5);
- len = XEN_TO_C_INT64_T_OR_ELSE(num, cp->edits[pos]->samples - bg);
if ((len > 0) &&
(extend_with_zeros(cp, bg, len, pos, S_pad_channel)))
@@ -4432,27 +4494,27 @@ static XEN g_pad_channel(XEN beg, XEN num, XEN snd, XEN chn, XEN edpos)
}
-static XEN g_swap_channels(XEN snd0, XEN chn0, XEN snd1, XEN chn1, XEN beg, XEN dur, XEN edpos0, XEN edpos1)
+static Xen g_swap_channels(Xen snd0, Xen chn0, Xen snd1, Xen chn1, Xen beg, Xen dur, Xen edpos0, Xen edpos1)
{
#define H_swap_channels "(" S_swap_channels " :optional snd0 chn0 snd1 chn1 (beg 0) (dur len) edpos0 edpos1): \
swap the indicated channels"
chan_info *cp0 = NULL, *cp1 = NULL;
snd_info *sp = NULL;
- ASSERT_CHANNEL(S_swap_channels, snd0, chn0, 1);
+ Snd_assert_channel(S_swap_channels, snd0, chn0, 1);
cp0 = get_cp(snd0, chn0, S_swap_channels);
- if (!cp0) return(XEN_FALSE);
- if (!(cp0->editable)) return(XEN_FALSE);
+ if (!cp0) return(Xen_false);
+ if (!(cp0->editable)) return(Xen_false);
- if (XEN_INTEGER_P(chn1))
+ if (Xen_is_integer(chn1))
{
- ASSERT_CHANNEL(S_swap_channels, snd1, chn1, 3);
+ Snd_assert_channel(S_swap_channels, snd1, chn1, 3);
cp1 = get_cp(snd1, chn1, S_swap_channels);
}
else
{
- if (XEN_INTEGER_P(snd1) || XEN_SOUND_P(snd1))
+ if (Xen_is_integer(snd1) || xen_is_sound(snd1))
sp = get_sp(snd1);
else sp = cp0->sound;
if (sp == NULL)
@@ -4466,15 +4528,15 @@ swap the indicated channels"
else cp1 = sp->chans[0];
}
- if (cp0 == cp1) return(XEN_FALSE);
- if (!(cp1->editable)) return(XEN_FALSE);
+ if (cp0 == cp1) return(Xen_false);
+ if (!(cp1->editable)) return(Xen_false);
if ((cp0) && (cp1))
{
int pos0, pos1;
mus_long_t dur0, dur1, beg0 = 0, num;
- if (XEN_NUMBER_P(beg))
- beg0 = XEN_TO_C_INT64_T(beg);
+ if (Xen_is_integer(beg))
+ beg0 = Xen_llong_to_C_llong(beg);
pos0 = to_c_edit_position(cp0, edpos0, S_swap_channels, 7);
pos1 = to_c_edit_position(cp1, edpos1, S_swap_channels, 8);
@@ -4482,8 +4544,8 @@ swap the indicated channels"
dur0 = cp0->edits[pos0]->samples;
dur1 = cp1->edits[pos1]->samples;
- if (XEN_NUMBER_P(dur))
- num = XEN_TO_C_INT64_T(dur);
+ if (Xen_is_integer(dur))
+ num = Xen_llong_to_C_llong(dur);
else
{
if (dur0 > dur1)
@@ -4501,8 +4563,8 @@ swap the indicated channels"
(pos1 == 0))
{
/* common special case -- just setup a new ed-list entry with the channels/sounds swapped */
- if ((dur0 == 0) && (dur1 == 0)) return(XEN_FALSE);
- if ((editable_p(cp0)) && (editable_p(cp1)))
+ if ((dur0 == 0) && (dur1 == 0)) return(Xen_false);
+ if ((is_editable(cp0)) && (is_editable(cp1)))
{
peak_env_info *e0, *e1;
e0 = peak_env_copy(cp0, false, cp0->edit_ctr);
@@ -4520,66 +4582,70 @@ swap the indicated channels"
{
/* look for simple cases where copying the current edit tree entry is not too hard */
if ((num < FILE_BUFFER_SIZE) ||
- (ptree_or_sound_fragments_in_use(cp0, pos0)) ||
- (ptree_or_sound_fragments_in_use(cp1, pos1)))
+ (sound_fragments_in_use(cp0, pos0)) ||
+ (sound_fragments_in_use(cp1, pos1)))
swap_channels(cp0, cp1, beg0, num, pos0, pos1);
else copy_then_swap_channels(cp0, cp1, pos0, pos1); /* snd-edits.c */
}
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static mus_float_t *load_mus_float_ts(XEN scalers, int *result_len, const char *caller)
+static mus_float_t *load_mus_float_ts(Xen scalers, int *result_len, const char *caller)
{
int len = 0, i;
mus_float_t *scls;
vct *v = NULL;
- if (XEN_NUMBER_P(scalers))
+ if (Xen_is_number(scalers))
len = 1;
else
{
- if (MUS_VCT_P(scalers))
+ if (mus_is_vct(scalers))
{
- v = XEN_TO_VCT(scalers);
- len = v->length;
+ v = Xen_to_vct(scalers);
+ len = mus_vct_length(v);
}
else
{
- if (XEN_LIST_P(scalers))
+ if (Xen_is_list(scalers))
{
- len = XEN_LIST_LENGTH(scalers);
- if (len == 0)
- XEN_ERROR(NO_DATA,
- XEN_LIST_2(C_TO_XEN_STRING("~A: scalers list is empty?"),
- C_TO_XEN_STRING(caller)));
+ len = Xen_list_length(scalers);
+ if (len < 0)
+ Xen_wrong_type_arg_error(caller, 1, scalers, "a proper list");
}
- else XEN_WRONG_TYPE_ARG_ERROR(caller, 1, scalers, "a number, list, or vct");
+ else Xen_wrong_type_arg_error(caller, 1, scalers, "a number, list, or " S_vct);
}
+
+ if (len == 0)
+ Xen_error(NO_DATA,
+ Xen_list_2(C_string_to_Xen_string("~A: scalers data is empty?"),
+ C_string_to_Xen_string(caller)));
}
+
scls = (mus_float_t *)calloc(len, sizeof(mus_float_t));
if (v)
- memcpy((void *)scls, (void *)(v->data), len * sizeof(mus_float_t));
+ memcpy((void *)scls, (void *)(mus_vct_data(v)), len * sizeof(mus_float_t));
else
{
- if (XEN_LIST_P(scalers))
+ if (Xen_is_list(scalers))
{
- XEN lst;
- for (i = 0, lst = XEN_COPY_ARG(scalers); i < len; i++, lst = XEN_CDR(lst))
- scls[i] = (mus_float_t)XEN_TO_C_DOUBLE(XEN_CAR(lst));
+ Xen lst;
+ for (i = 0, lst = Xen_copy_arg(scalers); i < len; i++, lst = Xen_cdr(lst))
+ scls[i] = (mus_float_t)Xen_real_to_C_double(Xen_car(lst));
}
- else scls[0] = (mus_float_t)XEN_TO_C_DOUBLE(scalers);
+ else scls[0] = (mus_float_t)Xen_real_to_C_double(scalers);
}
result_len[0] = len;
return(scls);
}
-static XEN g_scale_to(XEN scalers, XEN snd, XEN chn_n)
+static Xen g_scale_to(Xen scalers, Xen snd, Xen chn_n)
{
#define H_scale_to "(" S_scale_to " :optional (norms 1.0) snd chn): \
-normalize snd to norms (following sync); norms can be a float or a vct/list of floats"
+normalize snd to norms (following sync); norms can be a float or a " S_vct "/list of floats"
/* chn_n irrelevant if sync */
chan_info *cp;
@@ -4587,9 +4653,9 @@ normalize snd to norms (following sync); norms can be a float or a vct/list of f
int len[1];
mus_float_t *scls;
- ASSERT_CHANNEL(S_scale_to, snd, chn_n, 2);
+ Snd_assert_channel(S_scale_to, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_scale_to);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
scls = load_mus_float_ts(scalers, len, S_scale_to);
happy = scale_to(cp->sound, cp, scls, len[0], OVER_SOUND);
@@ -4597,24 +4663,33 @@ normalize snd to norms (following sync); norms can be a float or a vct/list of f
free(scls);
if (happy)
return(scalers);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_scale_by(XEN scalers, XEN snd, XEN chn_n)
+static Xen g_scale_by(Xen scalers, Xen snd, Xen chn_n)
{
#define H_scale_by "(" S_scale_by " scalers :optional snd chn): \
-scale snd by scalers (following sync); scalers can be a float or a vct/list of floats"
+scale snd by scalers (following sync); scalers can be a float or a " S_vct "/list of floats"
/* chn_n irrelevant if sync */
chan_info *cp;
int len[1];
mus_float_t *scls;
- ASSERT_CHANNEL(S_scale_by, snd, chn_n, 2);
+
+ Snd_assert_channel(S_scale_by, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_scale_by);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
+ len[0] = 0;
+
+ /* fprintf(stderr, "(scale-by %s %s %s)\n", Xen_object_to_C_string(scalers), Xen_object_to_C_string(snd), Xen_object_to_C_string(chn_n)); */
scls = load_mus_float_ts(scalers, len, S_scale_by);
+ if (len[0] == 0)
+ {
+ /* fprintf(stderr, "len is 0\n"); */
+ return(Xen_false);
+ }
scale_by(cp, scls, len[0], OVER_SOUND);
free(scls);
@@ -4622,7 +4697,7 @@ scale snd by scalers (following sync); scalers can be a float or a vct/list of f
}
-static XEN g_scale_selection_to(XEN scalers)
+static Xen g_scale_selection_to(Xen scalers)
{
#define H_scale_selection_to "(" S_scale_selection_to " norms): normalize selected portion to norms"
if (selection_is_active())
@@ -4637,13 +4712,13 @@ static XEN g_scale_selection_to(XEN scalers)
free(scls);
if (happy)
return(scalers);
- return(XEN_FALSE);
+ return(Xen_false);
}
return(snd_no_active_selection_error(S_scale_selection_to));
}
-XEN g_scale_selection_by(XEN scalers)
+Xen g_scale_selection_by(Xen scalers)
{
#define H_scale_selection_by "(" S_scale_selection_by " scalers): scale selected portion by scalers"
if (selection_is_active())
@@ -4661,7 +4736,7 @@ XEN g_scale_selection_by(XEN scalers)
}
-static XEN g_clm_channel(XEN gen, XEN samp_n, XEN samps, XEN snd, XEN chn_n, XEN edpos, XEN overlap, XEN origin)
+static Xen g_clm_channel(Xen gen, Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos, Xen overlap, Xen origin)
{
#define H_clm_channel "(" S_clm_channel " gen :optional (beg 0) (dur len) snd chn edpos (overlap 0) origin): \
apply gen to snd's channel chn starting at beg for dur samples. overlap is the 'ring' time, if any."
@@ -4672,54 +4747,54 @@ apply gen to snd's channel chn starting at beg for dur samples. overlap is the '
mus_any *egen;
char *errmsg = NULL, *caller = NULL;
- ASSERT_SAMPLE_TYPE(S_clm_channel, samp_n, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(S_clm_channel, samps, XEN_ARG_3);
- XEN_ASSERT_TYPE(XEN_NUMBER_P(overlap) || XEN_FALSE_P(overlap) || XEN_NOT_BOUND_P(overlap), overlap, XEN_ARG_7, S_clm_channel, "a number or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, XEN_ARG_8, S_clm_channel, "a string");
- ASSERT_CHANNEL(S_clm_channel, snd, chn_n, 4);
+ Snd_assert_sample_type(S_clm_channel, samp_n, 2);
+ Snd_assert_sample_type(S_clm_channel, samps, 3);
+ Xen_check_type(Xen_is_integer(overlap) || Xen_is_false(overlap) || !Xen_is_bound(overlap), overlap, 7, S_clm_channel, "an integer or " PROC_FALSE);
+ Xen_check_type(Xen_is_string_or_unbound(origin), origin, 8, S_clm_channel, "a string");
+ Snd_assert_channel(S_clm_channel, snd, chn_n, 4);
cp = get_cp(snd, chn_n, S_clm_channel);
- if (!cp) return(XEN_FALSE);
- pos = to_c_edit_position(cp, edpos, S_clm_channel, XEN_ARG_6);
+ if (!cp) return(Xen_false);
+ pos = to_c_edit_position(cp, edpos, S_clm_channel, 6);
beg = beg_to_sample(samp_n, S_clm_channel);
- dur = dur_to_samples(samps, beg, cp, pos, XEN_ARG_3, S_clm_channel);
- if (dur == 0) return(XEN_FALSE);
- XEN_ASSERT_TYPE(mus_xen_p(gen), gen, XEN_ARG_1, S_clm_channel, "a clm generator");
- egen = XEN_TO_MUS_ANY(gen);
- if (XEN_STRING_P(origin)) caller = mus_strdup(XEN_TO_C_STRING(origin)); else caller = mus_strdup(S_clm_channel);
+ dur = dur_to_samples(samps, beg, cp, pos, 3, S_clm_channel);
+ if (dur == 0) return(Xen_false);
+ Xen_check_type(mus_is_xen(gen), gen, 1, S_clm_channel, "a clm generator");
+ egen = Xen_to_mus_any(gen);
+ if (Xen_is_string(origin)) caller = mus_strdup(Xen_string_to_C_string(origin)); else caller = mus_strdup(S_clm_channel);
- errmsg = clm_channel(cp, egen, beg, dur, pos, XEN_TO_C_INT64_T_OR_ELSE(overlap, 0), caller);
+ errmsg = clm_channel(cp, egen, beg, dur, pos, (Xen_is_llong(overlap)) ? Xen_llong_to_C_llong(overlap) : 0, caller);
free(caller);
if (errmsg)
{
- XEN str;
- str = C_TO_XEN_STRING(errmsg);
+ Xen str;
+ str = C_string_to_Xen_string(errmsg);
free(errmsg);
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_clm_channel ": IO error ~A"),
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_2(C_string_to_Xen_string(S_clm_channel ": IO error ~A"),
str));
}
return(gen);
}
-static XEN g_env_1(XEN edata, mus_long_t beg, mus_long_t dur, XEN ebase, chan_info *cp, XEN edpos, const char *caller, bool over_selection)
+static Xen g_apply_env_1(Xen edata, mus_long_t beg, mus_long_t dur, Xen ebase, chan_info *cp, Xen edpos, const char *caller, bool over_selection)
{
- if (XEN_LIST_P(edata))
+ if (Xen_is_list(edata))
{
env *e;
e = get_env(edata, caller);
if (e)
{
- if (XEN_NUMBER_P(ebase))
+ if (Xen_is_number(ebase))
{
/* env 'e' is a temp here, so we can clobber its base, etc */
- e->base = XEN_TO_C_DOUBLE_OR_ELSE(ebase, 1.0);
+ e->base = Xen_real_to_C_double(ebase);
if (e->base < 0.0)
{
free_env(e);
- XEN_OUT_OF_RANGE_ERROR(caller, 4, ebase, "base ~A < 0.0?");
+ Xen_out_of_range_error(caller, 4, ebase, "base < 0.0?");
}
}
apply_env(cp, e, beg, dur, over_selection, caller, NULL, edpos, 7);
@@ -4730,29 +4805,29 @@ static XEN g_env_1(XEN edata, mus_long_t beg, mus_long_t dur, XEN ebase, chan_in
else
{
mus_any *egen = NULL;
- XEN_ASSERT_TYPE((mus_xen_p(edata)) && (mus_env_p(egen = XEN_TO_MUS_ANY(edata))), edata, XEN_ARG_1, caller, "an env generator or a list");
+ Xen_check_type((mus_is_xen(edata)) && (mus_is_env(egen = Xen_to_mus_any(edata))), edata, 1, caller, "an env generator or a list");
apply_env(cp, NULL, beg, dur, over_selection, caller, egen, edpos, 7);
return(edata);
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_env_selection(XEN edata, XEN base)
+static Xen g_env_selection(Xen edata, Xen base)
{
#define H_env_selection "(" S_env_selection " env :optional (env-base 1.0)): \
apply envelope to the selection using env-base to determine how breakpoints are connected"
if (!(selection_is_active()))
return(snd_no_active_selection_error(S_env_selection));
- return(g_env_1(edata, 0, 0, base,
- get_cp(XEN_FALSE, XEN_FALSE, S_env_selection),
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION),
+ return(g_apply_env_1(edata, 0, 0, base,
+ get_cp(Xen_false, Xen_false, S_env_selection),
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION),
S_env_selection, OVER_SELECTION));
}
-static XEN g_env_sound(XEN edata, XEN samp_n, XEN samps, XEN base, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_env_sound(Xen edata, Xen samp_n, Xen samps, Xen base, Xen snd, Xen chn_n, Xen edpos)
{
#define H_env_sound "(" S_env_sound " env :optional (start-samp 0) (samps len) (env-base 1.0) snd chn edpos): \
apply amplitude envelope (a list of breakpoints or a CLM env) to snd's channel chn starting at start-samp, going \
@@ -4762,21 +4837,21 @@ either to the end of the sound or for samps samples, with segments interpolating
int pos;
chan_info *cp;
- ASSERT_SAMPLE_TYPE(S_env_sound, samp_n, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(S_env_sound, samps, XEN_ARG_3);
- ASSERT_CHANNEL(S_env_sound, snd, chn_n, 5);
+ Snd_assert_sample_type(S_env_sound, samp_n, 2);
+ Snd_assert_sample_type(S_env_sound, samps, 3);
+ Snd_assert_channel(S_env_sound, snd, chn_n, 5);
cp = get_cp(snd, chn_n, S_env_sound);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, S_env_sound, 7);
beg = beg_to_sample(samp_n, S_env_sound);
- dur = dur_to_samples(samps, beg, cp, pos, XEN_ARG_3, S_env_sound);
+ dur = dur_to_samples(samps, beg, cp, pos, 3, S_env_sound);
- return(g_env_1(edata, beg, dur, base, cp, edpos, S_env_sound, OVER_SOUND));
+ return(g_apply_env_1(edata, beg, dur, base, cp, edpos, S_env_sound, OVER_SOUND));
}
-static XEN g_env_channel(XEN gen, XEN samp_n, XEN samps, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_env_channel(Xen gen, Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos)
{
#define H_env_channel "(" S_env_channel " clm-env-gen-or-envelope :optional (beg 0) (dur len) snd chn edpos): \
apply amplitude envelope to snd's channel chn starting at beg for dur samples."
@@ -4785,31 +4860,31 @@ apply amplitude envelope to snd's channel chn starting at beg for dur samples."
snd_info *sp;
mus_long_t beg = 0, dur;
int old_sync = 0, pos;
- XEN val;
+ Xen val;
- ASSERT_SAMPLE_TYPE(S_env_channel, samp_n, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(S_env_channel, samps, XEN_ARG_3);
- ASSERT_CHANNEL(S_env_channel, snd, chn_n, 4);
+ Snd_assert_sample_type(S_env_channel, samp_n, 2);
+ Snd_assert_sample_type(S_env_channel, samps, 3);
+ Snd_assert_channel(S_env_channel, snd, chn_n, 4);
cp = get_cp(snd, chn_n, S_env_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
beg = beg_to_sample(samp_n, S_env_channel);
pos = to_c_edit_position(cp, edpos, S_env_channel, 6);
dur = dur_to_samples(samps, beg, cp, pos, 3, S_env_channel);
- if (dur == 0) return(XEN_FALSE);
- if (beg > cp->edits[pos]->samples) return(XEN_FALSE); /* not redundant */
+ if (dur == 0) return(Xen_false);
+ if (beg > cp->edits[pos]->samples) return(Xen_false); /* not redundant */
sp = cp->sound;
old_sync = sp->sync;
sp->sync = 0;
- val = g_env_1(gen, beg, dur, XEN_FALSE, cp, edpos, S_env_channel, OVER_SOUND);
+ val = g_apply_env_1(gen, beg, dur, Xen_false, cp, edpos, S_env_channel, OVER_SOUND);
sp->sync = old_sync;
return(val);
}
-static XEN g_env_channel_with_base(XEN gen, XEN base, XEN samp_n, XEN samps, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_env_channel_with_base(Xen gen, Xen base, Xen samp_n, Xen samps, Xen snd, Xen chn_n, Xen edpos)
{
#define H_env_channel_with_base "(" S_env_channel_with_base " clm-env-gen-or-envelope :optional (base 1.0) (beg 0) (dur len) snd chn edpos): \
apply amplitude envelope to snd's channel chn starting at beg for dur samples."
@@ -4818,31 +4893,31 @@ apply amplitude envelope to snd's channel chn starting at beg for dur samples."
snd_info *sp;
mus_long_t beg = 0, dur;
int old_sync = 0, pos;
- XEN val;
+ Xen val;
- ASSERT_SAMPLE_TYPE(S_env_channel, samp_n, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(S_env_channel, samps, XEN_ARG_3);
- ASSERT_CHANNEL(S_env_channel, snd, chn_n, 4);
+ Snd_assert_sample_type(S_env_channel, samp_n, 2);
+ Snd_assert_sample_type(S_env_channel, samps, 3);
+ Snd_assert_channel(S_env_channel, snd, chn_n, 4);
cp = get_cp(snd, chn_n, S_env_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
beg = beg_to_sample(samp_n, S_env_channel);
pos = to_c_edit_position(cp, edpos, S_env_channel, 6);
dur = dur_to_samples(samps, beg, cp, pos, 3, S_env_channel);
- if (dur == 0) return(XEN_FALSE);
- if (beg > cp->edits[pos]->samples) return(XEN_FALSE); /* not redundant */
+ if (dur == 0) return(Xen_false);
+ if (beg > cp->edits[pos]->samples) return(Xen_false); /* not redundant */
sp = cp->sound;
old_sync = sp->sync;
sp->sync = 0;
- val = g_env_1(gen, beg, dur, base, cp, edpos, S_env_channel, OVER_SOUND);
+ val = g_apply_env_1(gen, beg, dur, base, cp, edpos, S_env_channel, OVER_SOUND);
sp->sync = old_sync;
return(val);
}
-static XEN g_ramp_channel(XEN rmp0, XEN rmp1, XEN beg, XEN num, XEN snd, XEN chn, XEN edpos)
+static Xen g_ramp_channel(Xen rmp0, Xen rmp1, Xen beg, Xen num, Xen snd, Xen chn, Xen edpos)
{
#define H_ramp_channel "(" S_ramp_channel " rmp0 rmp1 :optional (beg 0) (dur len) snd chn edpos): \
scale samples in the given sound/channel between beg and beg + num by a ramp going from rmp0 to rmp1."
@@ -4852,15 +4927,15 @@ scale samples in the given sound/channel between beg and beg + num by a ramp goi
int pos;
double seg0, seg1;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(rmp0), rmp0, XEN_ARG_1, S_ramp_channel, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(rmp1), rmp1, XEN_ARG_2, S_ramp_channel, "a number");
- ASSERT_SAMPLE_TYPE(S_ramp_channel, beg, XEN_ARG_3);
- ASSERT_SAMPLE_TYPE(S_ramp_channel, num, XEN_ARG_4);
- ASSERT_SOUND(S_ramp_channel, snd, 5);
+ Xen_check_type(Xen_is_number(rmp0), rmp0, 1, S_ramp_channel, "a number");
+ Xen_check_type(Xen_is_number(rmp1), rmp1, 2, S_ramp_channel, "a number");
+ Snd_assert_sample_type(S_ramp_channel, beg, 3);
+ Snd_assert_sample_type(S_ramp_channel, num, 4);
+ Snd_assert_sound(S_ramp_channel, snd, 5);
samp = beg_to_sample(beg, S_ramp_channel);
cp = get_cp(snd, chn, S_ramp_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, S_ramp_channel, 7);
samps = dur_to_samples(num, samp, cp, pos, 4, S_ramp_channel);
@@ -4868,19 +4943,19 @@ scale samples in the given sound/channel between beg and beg + num by a ramp goi
{
snd_info *sp;
int old_sync;
- XEN val;
+ Xen val;
sp = cp->sound;
old_sync = sp->sync;
sp->sync = 0;
- val = g_env_1(XEN_LIST_4(C_TO_XEN_DOUBLE(0.0), rmp0, C_TO_XEN_DOUBLE(1.0), rmp1),
- samp, samps, C_TO_XEN_DOUBLE(1.0), cp, edpos, S_ramp_channel, false);
+ val = g_apply_env_1(Xen_list_4(C_double_to_Xen_real(0.0), rmp0, C_double_to_Xen_real(1.0), rmp1),
+ samp, samps, C_double_to_Xen_real(1.0), cp, edpos, S_ramp_channel, false);
sp->sync = old_sync;
return(val);
}
- seg0 = XEN_TO_C_DOUBLE(rmp0);
- seg1 = XEN_TO_C_DOUBLE(rmp1);
+ seg0 = Xen_real_to_C_double(rmp0);
+ seg1 = Xen_real_to_C_double(rmp1);
if (ramp_channel(cp, seg0, (seg1 - seg0) / (double)(samps - 1),
samp, samps, pos, NOT_IN_AS_ONE_EDIT))
@@ -4898,7 +4973,7 @@ scale samples in the given sound/channel between beg and beg + num by a ramp goi
else
{
mus_any *egen;
- egen = mus_make_env_with_length(data, 2, 1.0, 0.0, 1.0, samps);
+ egen = mus_make_env(data, 2, 1.0, 0.0, 1.0, 0.0, samps - 1, NULL);
amp_env_env_selection_by(cp, egen, samp, samps, pos);
mus_free(egen);
}
@@ -4909,7 +4984,7 @@ scale samples in the given sound/channel between beg and beg + num by a ramp goi
}
-static XEN g_xramp_channel(XEN rmp0, XEN rmp1, XEN base, XEN beg, XEN num, XEN snd, XEN chn, XEN edpos)
+static Xen g_xramp_channel(Xen rmp0, Xen rmp1, Xen base, Xen beg, Xen num, Xen snd, Xen chn, Xen edpos)
{
#define H_xramp_channel "(" S_xramp_channel " rmp0 rmp1 base :optional (beg 0) (dur len) snd chn edpos): \
scale samples in the given sound/channel between beg and beg + num by an exponential ramp going from rmp0 to rmp1 with curvature set by base."
@@ -4919,66 +4994,65 @@ scale samples in the given sound/channel between beg and beg + num by an exponen
int pos;
mus_float_t ebase = 1.0;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(rmp0), rmp0, XEN_ARG_1, S_xramp_channel, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(rmp1), rmp1, XEN_ARG_2, S_xramp_channel, "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(base), base, XEN_ARG_3, S_xramp_channel, "a number");
- ASSERT_SAMPLE_TYPE(S_xramp_channel, beg, XEN_ARG_4);
- ASSERT_SAMPLE_TYPE(S_xramp_channel, num, XEN_ARG_5);
- ASSERT_SOUND(S_xramp_channel, snd, 6);
+ Xen_check_type(Xen_is_number(rmp0), rmp0, 1, S_xramp_channel, "a number");
+ Xen_check_type(Xen_is_number(rmp1), rmp1, 2, S_xramp_channel, "a number");
+ Xen_check_type(Xen_is_number(base), base, 3, S_xramp_channel, "a number");
+ Snd_assert_sample_type(S_xramp_channel, beg, 4);
+ Snd_assert_sample_type(S_xramp_channel, num, 5);
+ Snd_assert_sound(S_xramp_channel, snd, 6);
samp = beg_to_sample(beg, S_xramp_channel);
cp = get_cp(snd, chn, S_xramp_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
pos = to_c_edit_position(cp, edpos, S_xramp_channel, 8);
samps = dur_to_samples(num, samp, cp, pos, 4, S_xramp_channel);
- ebase = XEN_TO_C_DOUBLE(base);
+ ebase = Xen_real_to_C_double(base);
if (ebase < 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_xramp_channel, 3, base, "base ~A < 0.0?");
+ Xen_out_of_range_error(S_xramp_channel, 3, base, "base < 0.0?");
+ if (ebase > 1.0e10)
+ Xen_out_of_range_error(S_xramp_channel, 3, base, "base too large");
if (unrampable(cp, samp, samps, pos, (ebase != 1.0)))
{
snd_info *sp;
int old_sync;
- XEN val;
+ Xen val;
sp = cp->sound;
old_sync = sp->sync;
sp->sync = 0;
- val = g_env_1(XEN_LIST_4(C_TO_XEN_DOUBLE(0.0), rmp0, C_TO_XEN_DOUBLE(1.0), rmp1),
+ val = g_apply_env_1(Xen_list_4(C_double_to_Xen_real(0.0), rmp0, C_double_to_Xen_real(1.0), rmp1),
samp, samps, base, cp, edpos, S_xramp_channel, false);
sp->sync = old_sync;
return(val);
}
else
{
- mus_float_t *data;
- double *rates;
- mus_long_t *passes;
- mus_any *e;
- double seg0, seg1;
+ double seg0;
- seg0 = XEN_TO_C_DOUBLE(rmp0);
+ seg0 = Xen_real_to_C_double(rmp0);
if (ebase == 0.0)
scale_channel(cp, seg0, samp, samps, pos, NOT_IN_AS_ONE_EDIT);
else
{
- seg1 = XEN_TO_C_DOUBLE(rmp1);
-
+ double seg1;
+ seg1 = Xen_real_to_C_double(rmp1);
if (ebase == 1.0)
ramp_channel(cp, seg0, (seg1 - seg0) / (double)(samps - 1), samp, samps, pos, NOT_IN_AS_ONE_EDIT);
else
{
- data = (mus_float_t *)calloc(4, sizeof(mus_float_t));
+ mus_any *e;
+ mus_float_t *data;
+ mus_float_t *rates;
+ data = (mus_float_t *)malloc(4 * sizeof(mus_float_t));
data[0] = 0.0;
data[1] = seg0;
data[2] = 1.0;
data[3] = seg1;
- e = mus_make_env_with_length(data, 2, 1.0, 0.0, ebase, samps);
+ e = mus_make_env(data, 2, 1.0, 0.0, ebase, 0.0, samps - 1, NULL);
rates = mus_env_rates(e);
- passes = mus_env_passes(e);
-
if (xramp_channel(cp, mus_env_initial_power(e), rates[0], mus_env_scaler(e), mus_env_offset(e), samp, samps, pos, NOT_IN_AS_ONE_EDIT, e, 0))
{
if (cp->edits[pos]->peak_env)
@@ -4989,7 +5063,7 @@ scale samples in the given sound/channel between beg and beg + num by an exponen
else
{
mus_any *egen;
- egen = mus_make_env_with_length(data, 2, 1.0, 0.0, ebase, samps);
+ egen = mus_make_env(data, 2, 1.0, 0.0, ebase, 0.0, samps - 1, NULL);
amp_env_env_selection_by(cp, egen, samp, samps, pos);
mus_free(egen);
}
@@ -5005,32 +5079,32 @@ scale samples in the given sound/channel between beg and beg + num by an exponen
}
-static XEN g_fft(XEN reals, XEN imag, XEN sign)
+static Xen g_fft(Xen reals, Xen imag, Xen sign)
{
#define H_fft "(" S_fft " reals imags :optional (sign 1)): fft the data returning the result in reals. \
-If sign is -1, perform inverse fft. Incoming data is in vcts."
+If sign is -1, perform inverse fft. Incoming data is in " S_vct "s."
vct *v1 = NULL, *v2 = NULL;
int n = 0, n2 = 0, isign = 1;
bool need_free = false;
mus_float_t *rl = NULL, *im = NULL;
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(sign), sign, XEN_ARG_3, S_fft, "an integer");
- XEN_ASSERT_TYPE(MUS_VCT_P(reals), reals, XEN_ARG_1, S_fft, "vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(imag), imag, XEN_ARG_2, S_fft, "vct");
+ Xen_check_type(Xen_is_integer_or_unbound(sign), sign, 3, S_fft, "an integer");
+ Xen_check_type(mus_is_vct(reals), reals, 1, S_fft, S_vct);
+ Xen_check_type(mus_is_vct(imag), imag, 2, S_fft, S_vct);
- isign = XEN_TO_C_INT_OR_ELSE(sign, 1);
- v1 = XEN_TO_VCT(reals);
- v2 = XEN_TO_VCT(imag);
+ isign = (Xen_is_integer(sign)) ? Xen_integer_to_C_int(sign) : 1;
+ v1 = Xen_to_vct(reals);
+ v2 = Xen_to_vct(imag);
- n = v1->length;
- if (v2->length < n) n = v2->length;
- if (n == 0) return(XEN_ZERO);
- if (POWER_OF_2_P(n))
+ n = mus_vct_length(v1);
+ if (mus_vct_length(v2) < n) n = mus_vct_length(v2);
+ if (n == 0) return(Xen_integer_zero);
+ if (is_power_of_2(n))
{
n2 = n;
- rl = v1->data;
- im = v2->data;
+ rl = mus_vct_data(v1);
+ im = mus_vct_data(v2);
}
else
{
@@ -5040,16 +5114,16 @@ If sign is -1, perform inverse fft. Incoming data is in vcts."
rl = (mus_float_t *)calloc(n2, sizeof(mus_float_t));
im = (mus_float_t *)calloc(n2, sizeof(mus_float_t));
need_free = true;
- memcpy((void *)rl, (void *)(v1->data), n * sizeof(mus_float_t));
- memcpy((void *)im, (void *)(v2->data), n * sizeof(mus_float_t));
+ memcpy((void *)rl, (void *)(mus_vct_data(v1)), n * sizeof(mus_float_t));
+ memcpy((void *)im, (void *)(mus_vct_data(v2)), n * sizeof(mus_float_t));
}
mus_fft(rl, im, n2, isign);
if (need_free)
{
- memcpy((void *)(v1->data), (void *)rl, n * sizeof(mus_float_t));
- memcpy((void *)(v2->data), (void *)im, n * sizeof(mus_float_t));
+ memcpy((void *)(mus_vct_data(v1)), (void *)rl, n * sizeof(mus_float_t));
+ memcpy((void *)(mus_vct_data(v2)), (void *)im, n * sizeof(mus_float_t));
free(rl);
free(im);
}
@@ -5057,50 +5131,52 @@ If sign is -1, perform inverse fft. Incoming data is in vcts."
}
-static XEN g_snd_spectrum(XEN data, XEN win, XEN len, XEN linear_or_dB, XEN beta, XEN in_place, XEN normalized)
+static Xen g_snd_spectrum(Xen data, Xen win, Xen len, Xen linear_or_dB, Xen beta, Xen in_place, Xen normalized)
{
#define H_snd_spectrum "(" S_snd_spectrum " data :optional (window " S_rectangular_window ") (len data-len) (linear " PROC_TRUE ") (beta 0.0) in-place (normalized " PROC_TRUE ")): \
-magnitude spectrum of data (a vct), in data if in-place, using fft-window win and fft length len."
+magnitude spectrum of data (a " S_vct "), in data if in-place, using fft-window win and fft length len."
bool linear = true, in_data = false, normed = true;
- int i, j, n, n2, wtype;
+ int i, n, n2, wtype;
mus_float_t maxa, lowest, b = 0.0;
mus_float_t *rdat;
vct *v;
- XEN_ASSERT_TYPE((MUS_VCT_P(data)), data, XEN_ARG_1, S_snd_spectrum, "a vct");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(win), win, XEN_ARG_2, S_snd_spectrum, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(len), len, XEN_ARG_3, S_snd_spectrum, "an integer");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(linear_or_dB), linear_or_dB, XEN_ARG_4, S_snd_spectrum, "a boolean");
- XEN_ASSERT_TYPE(XEN_NUMBER_IF_BOUND_P(beta), beta, XEN_ARG_5, S_snd_spectrum, "a number");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(in_place), in_place, XEN_ARG_6, S_snd_spectrum, "a boolean");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(normalized), normalized, XEN_ARG_7, S_snd_spectrum, "a boolean");
-
- v = XEN_TO_VCT(data);
- n = XEN_TO_C_INT_OR_ELSE(len, v->length);
+ Xen_check_type((mus_is_vct(data)), data, 1, S_snd_spectrum, "a " S_vct);
+ Xen_check_type(Xen_is_integer_or_unbound(win), win, 2, S_snd_spectrum, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(len), len, 3, S_snd_spectrum, "an integer");
+ Xen_check_type(Xen_is_boolean_or_unbound(linear_or_dB), linear_or_dB, 4, S_snd_spectrum, "a boolean");
+ Xen_check_type(Xen_is_number_or_unbound(beta), beta, 5, S_snd_spectrum, "a number");
+ Xen_check_type(Xen_is_boolean_or_unbound(in_place), in_place, 6, S_snd_spectrum, "a boolean");
+ Xen_check_type(Xen_is_boolean_or_unbound(normalized), normalized, 7, S_snd_spectrum, "a boolean");
+
+ v = Xen_to_vct(data);
+ n = (Xen_is_integer(len)) ? Xen_integer_to_C_int(len) : mus_vct_length(v);
+ if (n > mus_vct_length(v)) n = mus_vct_length(v);
if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_snd_spectrum, 3, len, "length ~A <= 0?");
- if (n > v->length) n = v->length;
+ Xen_out_of_range_error(S_snd_spectrum, 3, len, "length <= 0 or " S_vct " length == 0?");
- if (XEN_BOOLEAN_P(linear_or_dB)) linear = XEN_TO_C_BOOLEAN(linear_or_dB);
- if (XEN_BOOLEAN_P(in_place)) in_data = XEN_TO_C_BOOLEAN(in_place);
- if (XEN_BOOLEAN_P(normalized)) normed = XEN_TO_C_BOOLEAN(normalized);
+ if (Xen_is_boolean(linear_or_dB)) linear = Xen_boolean_to_C_bool(linear_or_dB);
+ if (Xen_is_boolean(in_place)) in_data = Xen_boolean_to_C_bool(in_place);
+ if (Xen_is_boolean(normalized)) normed = Xen_boolean_to_C_bool(normalized);
- wtype = XEN_TO_C_INT_OR_ELSE(win, (int)MUS_RECTANGULAR_WINDOW);
- if (!(mus_fft_window_p(wtype)))
- XEN_OUT_OF_RANGE_ERROR(S_snd_spectrum, 2, win, "~A: unknown fft window");
+ wtype = (Xen_is_integer(win)) ? Xen_integer_to_C_int(win) : (int)MUS_RECTANGULAR_WINDOW;
+ if (!(mus_is_fft_window(wtype)))
+ Xen_out_of_range_error(S_snd_spectrum, 2, win, "unknown fft window");
- if (XEN_NUMBER_P(beta)) b = XEN_TO_C_DOUBLE(beta);
+ if (Xen_is_number(beta)) b = Xen_real_to_C_double(beta);
if (b < 0.0) b = 0.0; else if (b > 1.0) b = 1.0;
if (!in_data)
{
+ mus_float_t *vdata;
+ vdata = mus_vct_data(v);
rdat = (mus_float_t *)malloc(n * sizeof(mus_float_t));
- if (n < v->length)
- for (i = 0; i < n; i++) rdat[i] = v->data[i];
- else memcpy((void *)rdat, (void *)(v->data), v->length * sizeof(mus_float_t));
+ if (n < mus_vct_length(v))
+ for (i = 0; i < n; i++) rdat[i] = vdata[i];
+ else memcpy((void *)rdat, (void *)vdata, mus_vct_length(v) * sizeof(mus_float_t));
}
- else rdat = v->data;
+ else rdat = mus_vct_data(v);
if (wtype != (int)MUS_RECTANGULAR_WINDOW)
{
@@ -5113,6 +5189,7 @@ magnitude spectrum of data (a vct), in data if in-place, using fft-window win an
n2 = n / 2;
{
+ int j;
mus_float_t *idat;
idat = (mus_float_t *)calloc(n, sizeof(mus_float_t));
mus_fft(rdat, idat, n, 1);
@@ -5168,24 +5245,24 @@ magnitude spectrum of data (a vct), in data if in-place, using fft-window win an
}
-static XEN g_convolve_with_1(XEN file, XEN new_amp, chan_info *cp, XEN edpos, const char *caller)
+static Xen g_convolve_with_1(Xen file, Xen new_amp, chan_info *cp, Xen edpos, const char *caller)
{
/* cp NULL -> selection (see above) */
mus_float_t amp;
static char *fname = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ARG_1, caller, "a string");
+ Xen_check_type(Xen_is_string(file), file, 1, caller, "a string");
- if (XEN_NUMBER_P(new_amp))
- amp = XEN_TO_C_DOUBLE(new_amp);
+ if (Xen_is_number(new_amp))
+ amp = Xen_real_to_C_double(new_amp);
else
{
- if (XEN_FALSE_P(new_amp))
+ if (Xen_is_false(new_amp))
amp = 0.0;
else amp = 1.0;
}
if (fname) free(fname);
- fname = mus_expand_filename(XEN_TO_C_STRING(file));
+ fname = mus_expand_filename(Xen_string_to_C_string(file));
if (mus_file_probe(fname))
{
@@ -5195,12 +5272,12 @@ static XEN g_convolve_with_1(XEN file, XEN new_amp, chan_info *cp, XEN edpos, co
if (error)
{
- XEN errstr;
- errstr = C_TO_XEN_STRING(error);
+ Xen errstr;
+ errstr = C_string_to_Xen_string(error);
free(error);
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: IO error ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_3(C_string_to_Xen_string("~A: IO error ~A"),
+ C_string_to_Xen_string(caller),
errstr));
}
}
@@ -5209,27 +5286,27 @@ static XEN g_convolve_with_1(XEN file, XEN new_amp, chan_info *cp, XEN edpos, co
}
-static XEN g_convolve_with(XEN file, XEN new_amp, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_convolve_with(Xen file, Xen new_amp, Xen snd, Xen chn_n, Xen edpos)
{
#define H_convolve_with "(" S_convolve_with " file :optional (amp 1.0) snd chn edpos): \
convolve file with snd's channel chn (or the currently sync'd channels); amp is the resultant peak amp"
chan_info *cp;
- ASSERT_CHANNEL(S_convolve_with, snd, chn_n, 3);
+ Snd_assert_channel(S_convolve_with, snd, chn_n, 3);
cp = get_cp(snd, chn_n, S_convolve_with);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
return(g_convolve_with_1(file, new_amp, cp, edpos, S_convolve_with));
}
-static XEN g_convolve_selection_with(XEN file, XEN new_amp)
+static Xen g_convolve_selection_with(Xen file, Xen new_amp)
{
#define H_convolve_selection_with "(" S_convolve_selection_with " file :optional (amp 1.0)): \
convolve the selection with file; amp is the resultant peak amp"
if (!(selection_is_active()))
return(snd_no_active_selection_error(S_convolve_selection_with));
- return(g_convolve_with_1(file, new_amp, NULL, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), S_convolve_selection_with));
+ return(g_convolve_with_1(file, new_amp, NULL, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), S_convolve_selection_with));
}
@@ -5274,7 +5351,9 @@ static mus_float_t check_src_envelope(int pts, mus_float_t *data, int *error)
}
-static XEN g_src_channel(XEN ratio_or_env, XEN beg_n, XEN dur_n, XEN snd, XEN chn_n, XEN edpos)
+static bool is_NaN(double x) {return(x != x);}
+
+static Xen g_src_channel(Xen ratio_or_env, Xen beg_n, Xen dur_n, Xen snd, Xen chn_n, Xen edpos)
{
#define H_src_channel "(" S_src_channel " ratio-or-env :optional (beg 0) (dur len) snd chn edpos): \
sampling-rate convert snd's channel chn by ratio, or following an envelope (a list or a CLM env generator)."
@@ -5288,90 +5367,105 @@ sampling-rate convert snd's channel chn by ratio, or following an envelope (a li
mus_any *egen = NULL;
bool need_free = false;
mus_float_t ratio = 0.0; /* not 1.0 here! -- the zero is significant */
+ env *e = NULL;
- XEN_ASSERT_TYPE((XEN_NUMBER_P(ratio_or_env)) ||
- (XEN_LIST_P(ratio_or_env)) ||
- ((mus_xen_p(ratio_or_env)) &&
- (mus_env_p(egen = XEN_TO_MUS_ANY(ratio_or_env)))),
- ratio_or_env, XEN_ARG_1, S_src_channel, "a number, an envelope, or a CLM env generator");
- ASSERT_SAMPLE_TYPE(S_src_channel, beg_n, XEN_ARG_2);
- ASSERT_SAMPLE_TYPE(S_src_channel, dur_n, XEN_ARG_3);
- ASSERT_CHANNEL(S_src_channel, snd, chn_n, 4);
+ Xen_check_type((Xen_is_number(ratio_or_env)) ||
+ (Xen_is_list(ratio_or_env)) ||
+ ((mus_is_xen(ratio_or_env)) &&
+ (mus_is_env(egen = Xen_to_mus_any(ratio_or_env)))),
+ ratio_or_env, 1, S_src_channel, "a number, an envelope, or a CLM env generator");
+ Snd_assert_sample_type(S_src_channel, beg_n, 2);
+ Snd_assert_sample_type(S_src_channel, dur_n, 3);
+ Snd_assert_channel(S_src_channel, snd, chn_n, 4);
cp = get_cp(snd, chn_n, S_src_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
beg = beg_to_sample(beg_n, S_src_channel);
pos = to_c_edit_position(cp, edpos, S_src_channel, 6);
dur = dur_to_samples(dur_n, beg, cp, pos, 3, S_src_channel);
- if (dur == 0) return(XEN_FALSE);
- if (beg > cp->edits[pos]->samples) return(XEN_FALSE);
+ if (dur == 0) return(Xen_false);
+ if (beg > cp->edits[pos]->samples) return(Xen_false);
- if (XEN_NUMBER_P(ratio_or_env))
+ if (Xen_is_number(ratio_or_env))
{
- ratio = XEN_TO_C_DOUBLE(ratio_or_env);
+ ratio = Xen_real_to_C_double(ratio_or_env);
if ((pos == cp->edit_ctr) &&
((ratio == 0.0) || (ratio == 1.0)))
- return(XEN_FALSE);
+ return(Xen_false);
+ if ((is_NaN(ratio)) ||
+ (fabs(ratio) < 1.0e-10)) /* dur > 0 here */
+ Xen_out_of_range_error(S_src_channel, 1, ratio_or_env, "too small (resultant sound will be too large)");
}
else
{
int error = SRC_ENV_NO_ERROR;
if (egen == NULL)
{
- env *e;
e = get_env(ratio_or_env, S_src_channel);
- egen = mus_make_env_with_length(e->data, e->pts, 1.0, 0.0, e->base, dur);
+ egen = mus_make_env(e->data, e->pts, 1.0, 0.0, e->base, 0.0, dur - 1, NULL);
need_free = true;
- free_env(e);
}
check_src_envelope(mus_env_breakpoints(egen), mus_data(egen), &error);
if (error != SRC_ENV_NO_ERROR)
{
- XEN data;
+ Xen data;
+ if (e) free_env(e);
data = mus_array_to_list(mus_data(egen), 0, mus_env_breakpoints(egen) * 2);
if (need_free)
- {
- mus_free(egen);
- need_free = false;
- }
+ mus_free(egen);
+
if (error == SRC_ENV_HIT_ZERO)
- XEN_OUT_OF_RANGE_ERROR(S_src_channel, 1, data, "~A: envelope hits 0.0");
- else XEN_OUT_OF_RANGE_ERROR(S_src_channel, 1, data, "~A: envelope passes through 0.0");
- return(XEN_FALSE); /* just for clarity... */
+ Xen_out_of_range_error(S_src_channel, 1, data, "envelope hits 0.0");
+ else Xen_out_of_range_error(S_src_channel, 1, data, "envelope passes through 0.0");
+
+ return(Xen_false); /* just for clarity... */
}
}
if (((egen) && (mus_phase(egen) >= 0.0)) ||
((!egen) && (ratio >= 0.0))) /* ratio == 0.0 if env in use because env is the srate (as change arg) */
- sf = init_sample_read_any(beg, cp, READ_FORWARD, pos);
+ sf = init_sample_read_any_with_bufsize(beg, cp, READ_FORWARD, pos, (!egen) ? MAX_BUFFER_SIZE : FILE_BUFFER_SIZE);
else sf = init_sample_read_any(beg + dur - 1, cp, READ_BACKWARD, pos);
errmsg = src_channel_with_error(cp, sf, beg, dur, ratio, egen, S_src_channel, OVER_SOUND, &clm_err);
sf = free_snd_fd(sf);
if (need_free) mus_free(egen);
+ if (e) free_env(e);
if (errmsg)
{
- XEN err;
- err = C_TO_XEN_STRING(errmsg);
+ Xen err;
+ err = C_string_to_Xen_string(errmsg);
free(errmsg);
- XEN_ERROR(XEN_ERROR_TYPE((clm_err) ? "mus-error" : "IO-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_src_channel ": ~A"),
+ Xen_error(Xen_make_error_type((clm_err) ? "mus-error" : "IO-error"),
+ Xen_list_2(C_string_to_Xen_string(S_src_channel ": ~A"),
err));
}
return(ratio_or_env);
}
-static XEN g_src_1(XEN ratio_or_env, XEN ebase, XEN snd, XEN chn_n, XEN edpos, const char *caller, bool over_selection)
+#if (defined(__sun) && defined(__SVR4))
+ static bool is_inf(s7_double x) {return((x == x) && (is_NaN(x - x)));} /* there's no isinf in Solaris */
+#else
+ #define is_inf(x) isinf(x)
+#endif
+
+static Xen g_src_1(Xen ratio_or_env, Xen ebase, Xen snd, Xen chn_n, Xen edpos, const char *caller, bool over_selection)
{
chan_info *cp;
- ASSERT_CHANNEL(caller, snd, chn_n, 3);
+
+ Snd_assert_channel(caller, snd, chn_n, 3);
cp = get_cp(snd, chn_n, caller);
- if (!cp) return(XEN_FALSE);
- if (XEN_NUMBER_P(ratio_or_env))
+ if (!cp) return(Xen_false);
+
+ if (Xen_is_number(ratio_or_env))
{
mus_float_t ratio;
- ratio = XEN_TO_C_DOUBLE(ratio_or_env);
+
+ ratio = Xen_real_to_C_double(ratio_or_env);
+ if ((is_NaN(ratio)) || (is_inf(ratio)))
+ Xen_out_of_range_error(caller, 1, ratio_or_env, "src ratio must be a normal number");
+
if (ratio != 1.0)
src_env_or_num(cp, NULL, ratio,
true, caller,
@@ -5380,47 +5474,47 @@ static XEN g_src_1(XEN ratio_or_env, XEN ebase, XEN snd, XEN chn_n, XEN edpos, c
else
{
int error = SRC_ENV_NO_ERROR;
- if (XEN_LIST_P(ratio_or_env))
+ if (Xen_is_list(ratio_or_env))
{
env *e = NULL;
mus_float_t e_ratio = 1.0;
/* env 'e' is a temp here, so we can clobber its base, etc */
e = get_env(ratio_or_env, caller);
- if (XEN_NUMBER_P(ebase))
- e->base = XEN_TO_C_DOUBLE_OR_ELSE(ebase, 1.0);
+ if (Xen_is_number(ebase))
+ e->base = Xen_real_to_C_double(ebase);
e_ratio = check_src_envelope(e->pts, e->data, &error);
if (error != SRC_ENV_NO_ERROR)
{
- XEN data;
+ Xen data;
data = mus_array_to_list(e->data, 0, e->pts * 2);
- if (e) {free_env(e); e = NULL;}
+ free_env(e);
if (error == SRC_ENV_HIT_ZERO)
- XEN_OUT_OF_RANGE_ERROR(caller, 1, data, "~A: envelope hits 0.0");
- else XEN_OUT_OF_RANGE_ERROR(caller, 1, data, "~A: envelope passes through 0.0");
+ Xen_out_of_range_error(caller, 1, data, "envelope hits 0.0");
+ else Xen_out_of_range_error(caller, 1, data, "envelope passes through 0.0");
}
else
{
src_env_or_num(cp, e, e_ratio, false, caller, over_selection, NULL, edpos, 5);
- if (e) free_env(e);
+ free_env(e);
}
}
else
{
mus_any *egen;
- XEN_ASSERT_TYPE(mus_xen_p(ratio_or_env), ratio_or_env, XEN_ARG_1, caller, "a number, list, or env generator");
- egen = XEN_TO_MUS_ANY(ratio_or_env);
- XEN_ASSERT_TYPE(mus_env_p(egen), ratio_or_env, XEN_ARG_1, caller, "a number, list, or env generator");
+ Xen_check_type(mus_is_xen(ratio_or_env), ratio_or_env, 1, caller, "a number, list, or env generator");
+ egen = Xen_to_mus_any(ratio_or_env);
+ Xen_check_type(mus_is_env(egen), ratio_or_env, 1, caller, "a number, list, or env generator");
check_src_envelope(mus_env_breakpoints(egen), mus_data(egen), &error);
if (error != SRC_ENV_NO_ERROR)
{
- XEN data;
+ Xen data;
data = mus_array_to_list(mus_data(egen), 0, mus_env_breakpoints(egen) * 2);
if (error == SRC_ENV_HIT_ZERO)
- XEN_OUT_OF_RANGE_ERROR(S_src_channel, 1, data, "~A: envelope hits 0.0");
- else XEN_OUT_OF_RANGE_ERROR(S_src_channel, 1, data, "~A: envelope passes through 0.0");
+ Xen_out_of_range_error(S_src_channel, 1, data, "envelope hits 0.0");
+ else Xen_out_of_range_error(S_src_channel, 1, data, "envelope passes through 0.0");
}
else
src_env_or_num(cp, NULL,
@@ -5433,7 +5527,7 @@ static XEN g_src_1(XEN ratio_or_env, XEN ebase, XEN snd, XEN chn_n, XEN edpos, c
}
-static XEN g_src_sound(XEN ratio_or_env, XEN base, XEN snd, XEN chn_n, XEN edpos)
+static Xen g_src_sound(Xen ratio_or_env, Xen base, Xen snd, Xen chn_n, Xen edpos)
{
#define H_src_sound "(" S_src_sound " ratio-or-env :optional (base 1.0) snd chn edpos): \
sampling-rate convert snd's channel chn by ratio, or following an envelope. A negative ratio reverses the sound"
@@ -5442,21 +5536,21 @@ sampling-rate convert snd's channel chn by ratio, or following an envelope. A ne
}
-static XEN g_src_selection(XEN ratio_or_env, XEN base)
+static Xen g_src_selection(Xen ratio_or_env, Xen base)
{
#define H_src_selection "(" S_src_selection " ratio-or-env :optional (base 1.0)): \
sampling-rate convert the currently selected data by ratio (which can be an envelope)"
if (!(selection_is_active()))
return(snd_no_active_selection_error(S_src_selection));
- return(g_src_1(ratio_or_env, base, XEN_FALSE, XEN_FALSE, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), S_src_selection, OVER_SELECTION));
+ return(g_src_1(ratio_or_env, base, Xen_false, Xen_false, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION), S_src_selection, OVER_SELECTION));
}
-static XEN g_filter_channel(XEN e, XEN order, XEN beg, XEN dur, XEN snd, XEN chn_n, XEN edpos, XEN truncate, XEN origin)
+static Xen g_filter_channel(Xen e, Xen order, Xen beg, Xen dur, Xen snd, Xen chn_n, Xen edpos, Xen truncate, Xen origin)
{
#define H_filter_channel "(" S_filter_channel " env :optional order beg dur snd chn edpos (truncate " PROC_TRUE ") origin): \
-applies an FIR filter to snd's channel chn. 'env' is the frequency response envelope, or a vct with the coefficients."
+applies an FIR filter to snd's channel chn. 'env' is the frequency response envelope, or a " S_vct " with the coefficients."
chan_info *cp;
char *errstr = NULL;
@@ -5465,103 +5559,112 @@ applies an FIR filter to snd's channel chn. 'env' is the frequency response enve
int order_1 = 0, edpos_1 = AT_CURRENT_EDIT_POSITION;
mus_long_t beg_1 = 0, dur_1 = 0;
env *e_1 = NULL;
- vct *v = NULL;
mus_float_t *coeffs = NULL;
- XEN_ASSERT_TYPE(XEN_LIST_P(e) || MUS_VCT_P(e), e, XEN_ARG_1, S_filter_channel, "an envelope or a vct");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(order), order, XEN_ARG_2, S_filter_channel, "an integer");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, XEN_ARG_9, S_filter_channel, "a string");
+ Xen_check_type(Xen_is_list(e) || mus_is_vct(e), e, 1, S_filter_channel, "an envelope or a " S_vct);
+ Xen_check_type(Xen_is_integer_or_unbound(order), order, 2, S_filter_channel, "an integer");
+ Xen_check_type(Xen_is_string_or_unbound(origin), origin, 9, S_filter_channel, "a string");
- if (XEN_INTEGER_P(order)) order_1 = XEN_TO_C_INT(order);
- ASSERT_CHANNEL(S_filter_channel, snd, chn_n, 5);
+ if (Xen_is_integer(order))
+ {
+ order_1 = Xen_integer_to_C_int(order);
+ if (order_1 < 0)
+ Xen_out_of_range_error(S_filter_channel, 2, order, "order should not be negative");
+ }
+ Snd_assert_channel(S_filter_channel, snd, chn_n, 5);
cp = get_cp(snd, chn_n, S_filter_channel);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(truncate), truncate, XEN_ARG_8, S_filter_channel, "boolean");
- if (XEN_BOOLEAN_P(truncate)) truncate_1 = XEN_TO_C_BOOLEAN(truncate);
+ Xen_check_type(Xen_is_boolean_or_unbound(truncate), truncate, 8, S_filter_channel, "boolean");
+ if (Xen_is_boolean(truncate)) truncate_1 = Xen_boolean_to_C_bool(truncate);
- ASSERT_SAMPLE_TYPE(S_filter_channel, beg, XEN_ARG_3);
- ASSERT_SAMPLE_TYPE(S_filter_channel, dur, XEN_ARG_4);
+ Snd_assert_sample_type(S_filter_channel, beg, 3);
+ Snd_assert_sample_type(S_filter_channel, dur, 4);
beg_1 = beg_to_sample(beg, S_filter_channel);
edpos_1 = to_c_edit_position(cp, edpos, S_filter_channel, 7);
dur_1 = dur_to_samples(dur, beg_1, cp, edpos_1, 4, S_filter_channel);
- if (XEN_LIST_P(e))
+ if (Xen_is_list(e))
{
e_1 = get_env(e, S_filter_channel);
- if (e_1 == NULL) return(XEN_FALSE);
+ if (e_1 == NULL) return(Xen_false);
if (order_1 == 0) order_1 = e_1->pts * 4;
}
else
{
- v = XEN_TO_VCT(e);
- coeffs = v->data;
- if (order_1 == 0) order_1 = v->length;
+ vct *v = NULL;
+ int len;
+ v = Xen_to_vct(e);
+ len = mus_vct_length(v);
+ if (len == 0)
+ Xen_out_of_range_error(S_filter_channel, 1, e, "filter coeffs array is empty");
+ coeffs = mus_vct_data(v);
+ if (order_1 == 0) order_1 = len;
}
- if (XEN_STRING_P(origin))
- caller = XEN_TO_C_STRING(origin);
+ if (Xen_is_string(origin))
+ caller = Xen_string_to_C_string(origin);
errstr = filter_channel(cp, order_1, e_1, beg_1, dur_1, edpos_1, caller, truncate_1, coeffs);
if (e_1) free_env(e_1);
if (errstr)
{
- XEN str;
- str = C_TO_XEN_STRING(errstr);
+ Xen str;
+ str = C_string_to_Xen_string(errstr);
free(errstr);
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_2(C_TO_XEN_STRING(S_filter_channel ": IO error ~A"),
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_2(C_string_to_Xen_string(S_filter_channel ": IO error ~A"),
str));
}
return(e);
}
-static XEN g_filter_1(XEN e, XEN order, XEN snd, XEN chn_n, XEN edpos, const char *caller, const char *origin, bool over_selection, bool truncate)
+static Xen g_filter_1(Xen e, Xen order, Xen snd, Xen chn_n, Xen edpos, const char *caller, const char *origin, bool over_selection, bool truncate)
{
chan_info *cp;
- ASSERT_CHANNEL(caller, snd, chn_n, 3);
+ Snd_assert_channel(caller, snd, chn_n, 3);
cp = get_cp(snd, chn_n, caller);
- if (!cp) return(XEN_FALSE);
- if (mus_xen_p(e))
+ if (!cp) return(Xen_false);
+ if (mus_is_xen(e))
{
char *error;
bool clm_err = false;
- error = apply_filter_or_error(cp, 0, NULL, caller, origin, over_selection, NULL, XEN_TO_MUS_ANY(e), edpos, 5, truncate, &clm_err);
+ error = apply_filter_or_error(cp, 0, NULL, caller, origin, over_selection, NULL, Xen_to_mus_any(e), edpos, 5, truncate, &clm_err);
if (error)
{
- XEN errstr;
- errstr = C_TO_XEN_STRING(error);
+ Xen errstr;
+ errstr = C_string_to_Xen_string(error);
free(error);
- XEN_ERROR(XEN_ERROR_TYPE((clm_err) ? "mus-error" : "IO-error"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type((clm_err) ? "mus-error" : "IO-error"),
+ Xen_list_3(C_string_to_Xen_string("~A: ~A"),
+ C_string_to_Xen_string(caller),
errstr));
}
}
else
{
int len = 0;
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(order), order, XEN_ARG_2, caller, "an integer");
- if (XEN_INTEGER_P(order))
+ Xen_check_type(Xen_is_integer_or_unbound(order), order, 2, caller, "an integer");
+ if (Xen_is_integer(order))
{
- len = XEN_TO_C_INT(order);
+ len = Xen_integer_to_C_int(order);
if (len <= 0)
- XEN_OUT_OF_RANGE_ERROR(caller, 2, order, "> 0 (order = ~A)");
+ Xen_out_of_range_error(caller, 2, order, "order should be positive");
}
- if (MUS_VCT_P(e)) /* the filter coefficients direct */
+ if (mus_is_vct(e)) /* the filter coefficients direct */
{
vct *v;
char *new_origin = NULL, *estr = NULL;
- v = XEN_TO_VCT(e);
- if (len > v->length)
- XEN_OUT_OF_RANGE_ERROR(caller, 2, order, "<= length coeffs (order = ~A)");
+ v = Xen_to_vct(e);
+ if (len > mus_vct_length(v))
+ Xen_out_of_range_error(caller, 2, order, "order > length coeffs");
else
{
- if (len == 0) len = v->length;
+ if (len == 0) len = mus_vct_length(v);
}
- if ((!origin) && (v->length < 16))
+ if ((!origin) && (mus_vct_length(v) < 16))
{
estr = mus_vct_to_readable_string(v);
#if HAVE_FORTH
@@ -5571,12 +5674,12 @@ static XEN g_filter_1(XEN e, XEN order, XEN snd, XEN chn_n, XEN edpos, const cha
caller);
#else
new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d%s",
- TO_PROC_NAME(caller), estr, len,
+ to_proc_name(caller), estr, len,
(over_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
#endif
}
else new_origin = mus_strdup(origin);
- apply_filter(cp, len, NULL, caller, new_origin, over_selection, v->data, NULL, edpos, 5, truncate);
+ apply_filter(cp, len, NULL, caller, new_origin, over_selection, mus_vct_data(v), NULL, edpos, 5, truncate);
if (estr) free(estr);
if (new_origin) free(new_origin);
}
@@ -5584,7 +5687,7 @@ static XEN g_filter_1(XEN e, XEN order, XEN snd, XEN chn_n, XEN edpos, const cha
{
env *ne = NULL;
char *new_origin = NULL, *estr = NULL;
- XEN_ASSERT_TYPE(XEN_LIST_P(e), e, XEN_ARG_1, caller, "a list, vct, or env generator");
+ Xen_check_type(Xen_is_list(e), e, 1, caller, "a list, " S_vct ", or env generator");
ne = get_env(e, caller); /* arg here must be a list */
if (!origin)
{
@@ -5596,7 +5699,7 @@ static XEN g_filter_1(XEN e, XEN order, XEN snd, XEN chn_n, XEN edpos, const cha
caller);
#else
new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d%s",
- TO_PROC_NAME(caller), estr, len, (over_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
+ to_proc_name(caller), estr, len, (over_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
#endif
}
else new_origin = mus_strdup(origin);
@@ -5607,40 +5710,40 @@ static XEN g_filter_1(XEN e, XEN order, XEN snd, XEN chn_n, XEN edpos, const cha
if (new_origin) free(new_origin);
}
}
- return(XEN_TRUE);
+ return(Xen_true);
}
-static XEN g_filter_sound(XEN e, XEN order, XEN snd, XEN chn_n, XEN edpos, XEN origin)
+static Xen g_filter_sound(Xen e, Xen order, Xen snd, Xen chn_n, Xen edpos, Xen origin)
{
#define H_filter_sound "(" S_filter_sound " filter :optional order snd chn edpos origin): \
-applies FIR filter to snd's channel chn. 'filter' is either the frequency response envelope, a CLM filter, or a vct with the actual coefficients"
+applies FIR filter to snd's channel chn. 'filter' is either the frequency response envelope, a CLM filter, or a " S_vct " with the actual coefficients"
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, XEN_ARG_6, S_filter_sound, "a string");
+ Xen_check_type(Xen_is_string_or_unbound(origin), origin, 6, S_filter_sound, "a string");
return(g_filter_1(e, order, snd, chn_n, edpos,
- S_filter_sound, (XEN_STRING_P(origin)) ? XEN_TO_C_STRING(origin) : NULL,
+ S_filter_sound, (Xen_is_string(origin)) ? Xen_string_to_C_string(origin) : NULL,
OVER_SOUND, false));
}
-static XEN g_filter_selection(XEN e, XEN order, XEN truncate)
+static Xen g_filter_selection(Xen e, Xen order, Xen truncate)
{
#define H_filter_selection "(" S_filter_selection " filter :optional order (truncate " PROC_TRUE ")): apply filter to selection. If truncate, \
cut off filter output at end of selection, else mix"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(truncate), truncate, XEN_ARG_3, S_filter_selection, "boolean");
+ Xen_check_type(Xen_is_boolean_or_unbound(truncate), truncate, 3, S_filter_selection, "boolean");
if (!(selection_is_active()))
return(snd_no_active_selection_error(S_filter_selection));
- return(g_filter_1(e, order, XEN_FALSE, XEN_FALSE,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION),
+ return(g_filter_1(e, order, Xen_false, Xen_false,
+ C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION),
S_filter_selection, NULL,
- OVER_SELECTION, XEN_TO_C_BOOLEAN(truncate)));
+ OVER_SELECTION, Xen_boolean_to_C_bool(truncate)));
}
-static XEN g_sinc_width(void) {return(C_TO_XEN_INT(sinc_width(ss)));}
+static Xen g_sinc_width(void) {return(C_int_to_Xen_integer(sinc_width(ss)));}
-static XEN g_set_sinc_width(XEN val)
+static Xen g_set_sinc_width(Xen val)
{
#define H_sinc_width "(" S_sinc_width "): sampling rate conversion sinc width (10). \
The higher this number, the better the src low-pass filter, but the slower \
@@ -5648,163 +5751,15 @@ src runs. If you use too low a setting, you can sometimes hear high \
frequency whistles leaking through."
int len;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_sinc_width, "an integer");
- len = XEN_TO_C_INT(val);
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_sinc_width, "an integer");
+ len = Xen_integer_to_C_int(val);
if ((len >= 0) && (len <= MUS_MAX_CLM_SINC_WIDTH))
set_sinc_width(len);
- return(C_TO_XEN_INT(sinc_width(ss)));
-}
-
-
-#if HAVE_NESTED_FUNCTIONS
-
-#define S_find_min_peak_phases "find-min-peak-phases"
-
-static XEN g_find_min_peak_phases(XEN arglist)
-{
- #define H_find_min_peak_phases "(" S_find_min_peak_phases " dist vcts...) returns a vector of (sample-wise) offsets \
-that give a minimum peak amplitude when the signals are added together."
-
- mus_float_t best = 0.0;
- int n, size = 0, dist = 0;
- int *best_phases;
- int *current_phases;
- mus_float_t *current_max;
- mus_float_t **current_sum;
- mus_float_t **sines;
- int *sizes;
- auto void try_case(int i);
-
- void try_case(int i)
- {
- if ((current_max[i - 1] - n + i) < best)
- {
- int j, k, kk, n1, isize;
-
- n1 = n - 1;
- isize = sizes[i];
-
- for (j = 0; j < dist; j++)
- {
- /* j is current phase of i-th component */
-
- current_max[i] = 0.0;
- current_phases[i] = j;
-
- for (k = 0, kk = j; k < size; k++, kk++)
- {
- mus_float_t fval;
- if (kk >= isize) kk = 0;
- fval = current_sum[i - 1][k] + sines[i][kk];
- current_sum[i][k] = fval;
- fval = fabs(fval);
- if (fval > current_max[i])
- {
- current_max[i] = fval;
- if ((i == n1) &&
- (fval > best))
- break;
- }
- }
-
- if (i == n1)
- {
- if (current_max[i] < best)
- {
- int m;
- best = current_max[i];
- for (m = 0; m < n; m++)
- best_phases[m] = current_phases[m];
- }
- }
- else try_case(i + 1);
- }
- }
- }
-
- int i;
- mus_float_t cmax;
- XEN result = XEN_EMPTY_LIST;
-
- n = (XEN_LIST_LENGTH(arglist) - 1);
- if (n < 2) return(XEN_LIST_1(XEN_ZERO));
- dist = XEN_TO_C_INT(XEN_CAR(arglist));
- arglist = XEN_CDR(arglist);
-
- sines = (mus_float_t **)calloc(n, sizeof(mus_float_t *));
- sizes = (int *)calloc(n, sizeof(int));
- best_phases = (int *)calloc(n, sizeof(int));
- current_phases = (int *)calloc(n, sizeof(int));
- current_sum = (mus_float_t **)calloc(n, sizeof(mus_float_t *));
- current_max = (mus_float_t *)calloc(n, sizeof(mus_float_t));
-
- for (i = 0; i < n; i++)
- {
- vct *v;
- current_max[i] = 0.0;
- v = XEN_TO_VCT(XEN_LIST_REF(arglist, i));
- sines[i] = v->data;
- sizes[i] = v->length;
- if (sizes[i] > size)
- size = sizes[i];
- }
-
- for (i = 0; i < n; i++)
- current_sum[i] = (mus_float_t *)calloc(size, sizeof(mus_float_t));
-
- best = 10000.0;
- cmax = fabs(sines[0][0]);
- for (i = 1; i < sizes[0]; i++)
- {
- mus_float_t absv;
- absv = fabs(sines[0][i]);
- if (absv > cmax) cmax = absv;
- }
- current_max[0] = cmax;
- current_phases[0] = 0;
-
- for (i = 0; i < size; i++)
- current_sum[0][i] = sines[0][i];
-
- try_case(1);
-
- for (i = 0; i < n; i++)
- result = XEN_CONS(C_TO_XEN_INT(best_phases[i]), result);
-
- free(best_phases);
- free(current_phases);
- for (i = 0; i < n; i++)
- free(current_sum[i]);
- free(current_sum);
- free(sines);
- free(current_max);
-
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(best), XEN_LIST_REVERSE(result)));
+ return(C_int_to_Xen_integer(sinc_width(ss)));
}
-#if 0
-(let ((v1 (make-vct 2048))
- (v2 (make-vct 2048))
- (v3 (make-vct 2048))
- (incr (/ (* 2 pi) 2048)))
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x incr)))
- ((= i 2048))
- (vct-set! v1 i (sin x))
- (vct-set! v2 i (sin (* 2 x)))
- (vct-set! v3 i (sin (* 3 x))))
- (find-min-peak-phases 1024 v1 v2 v3))
-
-(1.98045 (0 210 1940))
-
-:(modulo (/ (* 210 2) 1024.0) 2.0)
-0.41015625
-:(modulo (/ (* 1940 3) 1024.0) 2.0)
-1.68359375
-#endif
-
-#if HAVE_SYS_TIME_H
+#ifndef _MSC_VER
#include <sys/time.h>
#endif
@@ -5934,1131 +5889,187 @@ that give a minimum peak amplitude when the signals are added together."
17827, 17837, 17839, 17851, 17863};
#endif
- static mus_float_t all_mins[128] = {1.0000, 1.7600, 1.9797, 2.0390, 2.3435, 2.5493, 2.6394, 2.7947, 2.9618, 3.1027, 3.2184, 3.3891, 3.5249, 3.6131, 3.7690, 3.8751, 3.9815, 4.1454, 4.2237, 4.2901, 4.4844, 4.5881, 4.6077, 4.7308, 4.8556, 5.0083, 5.0665, 5.1610, 5.2447, 5.3667, 5.4835, 5.5298, 5.6351, 5.7213, 5.7695, 5.9314, 5.9340, 6.1129, 6.1310, 6.2990, 6.3364, 6.4649, 6.4824, 6.5525, 6.6395, 6.6997, 6.8394, 6.8711, 6.9216, 7.0120, 7.0727, 7.1459, 7.2091, 7.2660, 7.3406, 7.3610, 7.5091, 7.6053, 7.6560, 7.6103, 7.7751, 7.8116, 7.9156, 7.9789, 8.0499, 8.0795, 8.1638, 8.1884, 8.2338, 8.1968, 8.3426, 8.4850, 8.4463, 8.5225, 8.6321, 8.6432, 8.7160, 8.7442, 8.8668, 8.8540, 8.9808, 9.0923, 8.9618, 9.0446, 9.1551, 9.2307, 9.3580, 9.3434, 9.3772, 9.4308, 9.4958, 9.5482, 9.6927, 9.6443, 9.6193, 9.7318, 9.8398, 9.7998, 9.8862, 9.9650, 10.0902, 10.1064, 10.1018, 10.1518, 10.1994, 10.2676, 10.3088, 10.3414, 10.4690, 10.5395, 10.5284, 10.4941, 10.6286, 10.6666, 10.7175, 10.7015, 10.8042, 10.8311, 10.9236, 10.9160, 10.9630, 10.9875, 11.1268, 11.1133, 11.1959, 11.1842, 11.2172, 11.3515};
-
- static mus_float_t odd_mins[128] = {1.0000, 1.5390, 1.7387, 2.0452, 2.3073, 2.5227, 2.6184, 2.7908, 2.8865, 3.0538, 3.1771, 3.3627, 3.4755, 3.5994, 3.7398, 3.8582, 3.9278, 4.0712, 4.1739, 4.3601, 4.4504, 4.5828, 4.6639, 4.7891, 4.8892, 5.0085, 5.0916, 5.0926, 5.2674, 5.3569, 5.4235, 5.5676, 5.6070, 5.7451, 5.8382, 5.9833, 6.0249, 6.1502, 6.1875, 6.2779, 6.3276, 6.4085, 6.4809, 6.6048, 6.6310, 6.7167, 6.7934, 6.8352, 6.9979, 6.9553, 7.0965, 7.0875, 7.2627, 7.3396, 7.3763, 7.4309, 7.4982, 7.5987, 7.6284, 7.7097, 7.7859, 7.8273, 7.9170, 7.9692, 8.0569, 8.1525, 8.1401, 8.2378, 8.2868, 8.3442, 8.4944, 8.3782, 8.5744, 8.4993, 8.6683, 8.6675, 8.7208, 8.7294, 8.8960, 8.9668, 8.9383, 8.9097, 9.0744, 9.2159, 9.1869, 9.2297, 9.3897, 9.3399, 9.3470, 9.4367, 9.4725, 9.5687, 9.6706, 9.6780, 9.7370, 9.7826, 9.8563, 9.9469, 10.0061, 10.0003, 9.9851, 10.0649, 10.1295, 10.1977, 10.1319, 10.2199, 10.3265, 10.3443, 10.4471, 10.4287, 10.6521, 10.6156, 10.6290, 10.6395, 10.7033, 10.7613, 10.8177, 10.8329, 10.9533, 10.9450, 11.0739, 11.0882, 11.1744, 11.2694, 11.1434, 11.3421, 11.3226, 11.3027};
-
- static mus_float_t prime_mins[128] = {1.0000, 1.7600, 1.9798, 2.1921, 2.4768, 2.8055, 3.0619, 3.2630, 3.3824, 3.6023, 3.7790, 3.9366, 4.1551, 4.3254, 4.4680, 4.6025, 4.7203, 4.8567, 5.0167, 5.1901, 5.3299, 5.4469, 5.5660, 5.6488, 5.8136, 6.0631, 6.1376, 6.1943, 6.3688, 6.4551, 6.7060, 6.8464, 6.8528, 6.9975, 7.1698, 7.2801, 7.2978, 7.4026, 7.4626, 7.7094, 7.8733, 7.9766, 8.0526, 8.1864, 8.1655, 8.2722, 8.4314, 8.4781, 8.6466, 8.6842, 8.6633, 8.8300, 8.9627, 9.1228, 9.1564, 9.4166, 9.5807, 9.5057, 9.4611, 9.6680, 9.8578, 9.8036, 9.7298, 9.9287, 10.2856, 10.2311, 10.3407, 10.4127, 10.4243, 10.4572, 10.5887, 10.6032, 10.7745, 10.7224, 11.0321, 11.0824, 10.8967, 11.1438, 11.2405, 11.4673, 11.5138, 11.4929, 11.5309, 11.5744, 11.6582, 11.5382, 11.9413, 12.0060, 12.2362, 12.0567, 12.1409, 12.1419, 12.3374, 12.3904, 12.5299, 12.6858, 12.6639, 12.9200, 13.1127, 13.1352, 13.0875, 13.4199, 13.4492, 13.2143, 13.1622, 13.2404, 13.5786, 13.6931, 13.7139, 13.8060, 13.7890, 13.8862, 14.0573, 14.2366, 14.1959, 14.4907, 14.6271, 14.5700, 14.4088, 14.5250, 14.5755, 14.8995, 14.6292, 14.9056, 14.7970, 14.9417, 14.9909, 14.6673};
-
- static mus_float_t even_mins[128] = {1.0000, 1.7602, 2.0215, 2.4306, 2.6048, 2.8370, 3.0470, 3.1976, 3.4541, 3.5589, 3.6567, 3.7876, 3.9730, 4.0977, 4.1935, 4.3263, 4.4641, 4.5708, 4.7435, 4.8413, 4.9220, 5.0576, 5.1502, 5.2557, 5.4056, 5.4549, 5.6237, 5.7353, 5.7702, 5.9106, 5.9916, 6.0655, 6.1677, 6.2274, 6.3678, 6.4373, 6.5859, 6.5424, 6.6894, 6.7542, 6.8880, 6.9484, 7.0624, 7.0556, 7.1722, 7.2838, 7.3002, 7.4741, 7.5955, 7.6309, 7.6632, 7.7944, 7.7598, 7.8541, 8.0161, 8.0517, 8.1251, 8.1129, 8.2039, 8.3222, 8.3667, 8.4009, 8.4237, 8.5096, 8.6762, 8.7965, 8.8351, 8.8095, 8.8822, 9.0139, 9.1149, 8.9996, 9.1732, 9.2636, 9.2213, 9.4078, 9.3745, 9.3502, 9.5516, 9.5854, 9.5585, 9.6768, 9.7673, 9.7624, 9.7113, 9.8177, 9.8890, 9.9849, 10.1260, 10.2574, 10.1851, 10.2503, 10.1394, 10.4530, 10.4633, 10.5664, 10.4737, 10.5482, 10.4316, 10.4946, 10.8160, 10.8507, 10.8520, 10.8018, 10.9420, 10.9377, 11.0059, 11.0437, 11.0988, 11.2827, 11.3712, 11.2926, 11.2163, 11.3569, 11.3579, 11.5758, 11.3894, 11.6008, 11.6472, 11.7386, 11.5980, 11.8015, 11.7724, 11.8625, 11.8411, 12.0022, 11.9138, 11.9469};
-
- static mus_float_t min_8[4] = {19.4199, 19.7800, 21.1471, 25.4193};
- static mus_float_t min_9[4] = {31.3912, 31.6276, 31.6281, 40.2509};
- static mus_float_t min_10[4] = {49.8672, 48.8125, 51.6272, 70.1400};
- static mus_float_t min_11[4] = {77.3502, 78.9374, 78.0793, 102.6190};
-
-#define USE_CLM_RANDOM (!HAVE_SCHEME)
-
-static mus_float_t local_random(mus_float_t val)
-{
-#if USE_CLM_RANDOM
- return(mus_random(val));
-#else
- return(val * (1.0 - (s7_random(s7, NULL) * 2.0)));
-#endif
-}
-
-
-static mus_float_t local_frandom(mus_float_t val)
-{
-#if USE_CLM_RANDOM
- return(mus_frandom(val));
-#else
- return(val * s7_random(s7, NULL));
-#endif
-}
-
-
-typedef struct {
- mus_float_t pk;
- mus_float_t *phases;
-} pk_data;
-
-
-#if 0
-
-#define S_fpsa "fpsa"
-
-static XEN g_fpsa(XEN x_choice, XEN x_n, XEN x_size, XEN x_increment, XEN x_counts, XEN x_file, XEN x_just_best)
-{
- #define H_fpsa "(" S_fpsa " choice n (size 2000) (increment 1.0) (counts 50) (output-file \"test.data\") (report-best #t)) searches \
-for a peak-amp minimum using a simulated annealing form of the genetic algorithm. choice: 0=all, 1=odd, 2=even, 3=prime."
+ static mus_float_t all_mins[128] = {1.0000, 1.7600, 1.9797, 2.0390, 2.3435, 2.5493, 2.6394, 2.7946, 2.9617, 3.1023, 3.2180, 3.3887, 3.5241, 3.6122, 3.7680, 3.8738, 3.9802, 4.1438, 4.2210, 4.2890, 4.4824, 4.5866, 4.6052, 4.7280, 4.8531, 5.0050, 5.0640, 5.1573, 5.2413, 5.3623, 5.4800, 5.5259, 5.6320, 5.7167, 5.7648, 5.8770, 5.9291, 6.0764, 6.1247, 6.2388, 6.3296, 6.4351, 6.4755, 6.5454, 6.6312, 6.6921, 6.7592, 6.8630, 6.9144, 7.0054, 7.0637, 7.1368, 7.1997, 7.2564, 7.3299, 7.3515, 7.4959, 7.5862, 7.6389, 7.6004, 7.7602, 7.7988, 7.8838, 7.9463, 8.0038, 8.0641, 8.1270, 8.1759, 8.2203, 8.1858, 8.3294, 8.4352, 8.4355, 8.5093, 8.6129, 8.6292, 8.7018, 8.7310, 8.8164, 8.8399, 8.9113, 8.9487, 8.9469, 9.0279, 9.1400, 9.2143, 9.2076, 9.3188, 9.3608, 9.4148, 9.4762, 9.5310, 9.4369, 9.6238, 9.6045, 9.7150, 9.8146, 9.7808, 9.8684, 9.9374, 9.9893, 10.0292, 10.0825, 10.1311, 10.1809, 10.2348, 10.2757, 10.3212, 10.4394, 10.4438, 10.4982, 10.4710, 10.6004, 10.5194, 10.6682, 10.6756, 10.7494, 10.7909, 10.8383, 10.8805, 10.9294, 10.9655, 11.0898, 11.0638, 11.1608, 11.1455, 11.1939, 11.3092};
- #define FFT_MULT 128
- #define INCR_DOWN 0.9
- #define INCR_MAX 1.0
- #define INCR_MIN 0.001
- #define RETRIES 10
- #define RETRY_MULT 2
- #define INIT_TRIES 1000
- #define ALL 0
- #define ODD 1
- #define EVEN 2
- #define PRIME 3
-
- int choice, n, size, counts = 0, day_counter = 0, days = 0, years = 0, free_top = 0, fft_size = 0;
- mus_long_t ffts = 0;
- mus_float_t increment = INCR_MAX, orig_incr, local_best = 1000.0, incr_mult = INCR_DOWN, overall_min;
- mus_float_t *min_phases = NULL, *temp_phases = NULL, *diff_phases = NULL;
- char *choice_name[4] = {"all", "odd", "even", "prime"};
- pk_data **choices = NULL, **free_choices = NULL;
- mus_float_t *rl, *im;
- const char *file = NULL;
- bool just_best = true;
-
- auto mus_float_t saved_min(int ch, int nn);
- auto mus_float_t get_peak(mus_float_t *phases);
- auto pk_data *next_choice(pk_data *data);
- auto bool day(void);
-
- mus_float_t saved_min(int ch, int nn)
- {
- if (nn <= 128)
- {
- switch (ch)
- {
- case ALL: return(all_mins[nn - 1]);
- case ODD: return(odd_mins[nn - 1]);
- case EVEN: return(even_mins[nn - 1]);
- case PRIME: return(prime_mins[nn - 1]);
- }
- }
- if (nn == 256) return(min_8[ch]);
- if (nn == 512) return(min_9[ch]);
- if (nn == 1024) return(min_10[ch]);
- if (nn == 2048) return(min_11[ch]);
- return((mus_float_t)nn);
- }
-
- mus_float_t get_peak(mus_float_t *phases)
- {
- int i, m;
- mus_float_t pi2, mx_sin, mx_cos;
-
- pi2 = M_PI / 2.0;
- memset((void *)rl, 0, fft_size * sizeof(mus_float_t));
- memset((void *)im, 0, fft_size * sizeof(mus_float_t));
-
- for (m = 0; m < n; m++)
- {
- int bin;
- mus_float_t phi;
- phi = (M_PI * phases[m]) + pi2;
- if (choice == ALL)
- bin = m + 1;
- else
- {
- if (choice == ODD)
- bin = (m * 2) + 1;
- else
- {
- if (choice == EVEN)
- {
- bin = m * 2;
- if (bin == 0) bin = 1;
- }
- else bin = primes[m];
- }
- }
- rl[bin] = cos(phi);
- im[bin] = sin(phi);
- }
-
- mus_fft(rl, im, fft_size, -1);
- /* real part is sine reconstruction, imaginary part is cosine, we're interested in both! */
- /* we could also add and subtract the 2 to get 2 more cases "for free", amp sqrt(2), phase asin(cos(0)/sqrt(2)) */
- /* and repeat this with a shift (rotation from i) for 2n other cases */
- /* resultant amp is between 0 and 2 (cosine) */
-
- ffts++;
- mx_sin = fabs(rl[0]);
- mx_cos = fabs(im[0]);
- for (i = 1; i < fft_size; i++)
- {
- mus_float_t mxtemp;
- mxtemp = fabs(rl[i]);
- if (mxtemp > mx_sin)
- mx_sin = mxtemp;
- mxtemp = fabs(im[i]);
- if (mxtemp > mx_cos)
- mx_cos = mxtemp;
- }
-
- if (mx_sin <= mx_cos)
- return(mx_sin);
-
- /* use the cosine case, but make it sine-based with 0.0 initial phase for the fundamental */
- for (m = 1; m < n; m++)
- {
- int bin;
- if (choice == ALL)
- bin = m + 1;
- else
- {
- if (choice == ODD)
- bin = (m * 2) + 1;
- else
- {
- if (choice == EVEN)
- {
- bin = m * 2;
- if (bin == 0) bin = 1;
- }
- else bin = primes[m];
- }
- }
- phases[m] += (0.5 * (bin - 1)); /* needs fmod! */
- }
-
- return(mx_cos);
- }
-
- pk_data *next_choice(pk_data *data)
- {
- mus_float_t *phases;
- mus_float_t cur_min, temp_min = 100000.0, pk = 100000.0;
- int len, local_try, i, k, local_tries;
- pk_data *new_pk;
-
- new_pk = free_choices[--free_top];
- cur_min = data->pk;
- phases = data->phases;
- len = n;
- local_tries = RETRIES + day_counter * RETRY_MULT;
-
- /* try to find a point nearby that is better */
- for (local_try = 0; (local_try < local_tries) && (pk >= cur_min); local_try++)
- {
- for (i = 1; i < len; i++)
- temp_phases[i] = fmod(phases[i] + local_random(increment), 2.0); /* not mus_frandom! */
- pk = get_peak(temp_phases);
-
- if (pk < temp_min)
- {
- temp_min = pk;
- new_pk->pk = pk;
- for (k = 1; k < len; k++) new_pk->phases[k] = temp_phases[k];
- }
- }
-
- /* if a better point is found, try to follow the slopes */
- if (new_pk->pk < data->pk)
- {
- bool happy = true;
- for (k = 1; k < len; k++)
- diff_phases[k] = new_pk->phases[k] - data->phases[k];
-
- while (happy)
- {
- for (k = 1; k < len; k++)
- temp_phases[k] = fmod(new_pk->phases[k] + diff_phases[k], 2.0); /* frandom here? */
- pk = get_peak(temp_phases);
-
- if (pk < new_pk->pk)
- {
- new_pk->pk = pk;
- for (k = 1; k < len; k++) new_pk->phases[k] = temp_phases[k];
- }
- else happy = false;
- }
- }
-
- pk = new_pk->pk;
-
- if (pk < local_best)
- {
- local_best = pk;
- if ((!just_best) ||
- (pk < overall_min))
- {
- FILE *ofile;
- if (file)
- ofile = fopen(file, "a");
- else ofile = stderr;
- for (k = 1; k < len; k++) min_phases[k] = new_pk->phases[k];
- fprintf(ofile, "[%d, %d, %f, %lld]: %s, %d %f #(", years, days, increment, (long long int)ffts, choice_name[choice], n, pk);
- for (k = 0; k < len - 1; k++) fprintf(ofile, "%f ", min_phases[k]);
- fprintf(ofile, "%f)\n\n", min_phases[len - 1]);
- if (file) fclose(ofile);
- if (pk < overall_min) overall_min = pk;
- }
-
- day_counter = 0;
- }
- return(new_pk);
- }
-
- bool day(void)
- {
- int i, j = 0, k, len;
- mus_float_t sum = 0.0, avg;
- len = size;
- day_counter++;
- days++;
- for (i = 0; i < len; i++) sum += choices[i]->pk;
- avg = sum / len;
-
- for (i = 0; i < len; i++)
- {
- pk_data *datum;
- datum = choices[i];
- choices[i] = NULL;
- if (datum->pk < avg)
- choices[j++] = datum;
- else free_choices[free_top++] = datum;
- }
-
- for (i = 0, k = j; k < len; i++, k++)
- {
- if (i == j)
- i = 0;
- choices[k] = next_choice(choices[i]);
- }
-
- if (day_counter < counts)
- {
- increment *= incr_mult;
- if (increment < INCR_MIN)
- {
- increment = INCR_MIN;
- }
- if (increment > INCR_MAX)
- {
- increment = INCR_MAX;
- incr_mult = INCR_DOWN;
- }
- return(true);
- }
- return(false);
- }
-
-#if HAVE_SYS_TIME_H
- {
- struct timeval tm;
- struct timezone tz;
- gettimeofday(&tm, &tz);
- mus_set_rand_seed((unsigned long)(tm.tv_sec * 1000 + tm.tv_usec / 1000));
- }
-#endif
-
- choice = XEN_TO_C_INT(x_choice);
- if ((choice < ALL) || (choice > PRIME))
- choice = ALL;
-
- n = XEN_TO_C_INT(x_n);
-
- if (XEN_INTEGER_P(x_size))
- size = XEN_TO_C_INT(x_size);
- else size = 2000;
- if (size < 2) size = 2;
-
- if (XEN_INTEGER_P(x_counts))
- counts = XEN_TO_C_INT(x_counts);
- else counts = 50;
-
- if (XEN_DOUBLE_P(x_increment))
- increment = XEN_TO_C_DOUBLE(x_increment);
- else increment = INCR_MAX;
- orig_incr = increment;
- incr_mult = INCR_DOWN;
-
- if (XEN_STRING_P(x_file))
- file = XEN_TO_C_STRING(x_file);
- else file = "test.data";
-
- if (XEN_BOOLEAN_P(x_just_best))
- just_best = XEN_TO_C_BOOLEAN(x_just_best);
- else just_best = true;
-
- min_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
- overall_min = saved_min(choice, n);
-
- temp_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
- diff_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
-
- {
- int start, n1;
-
- if (choice == ALL)
- n1 = n;
- else
- {
- if (choice != PRIME)
- n1 = n * 2;
- else n1 = primes[n];
- }
- fft_size = (int)pow(2.0, (int)ceil(log(FFT_MULT * n1) / log(2.0)));
- rl = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
- im = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
-
- choices = (pk_data **)calloc(size, sizeof(pk_data *));
- free_choices = (pk_data **)calloc(size, sizeof(pk_data *));
-
- for (start = 0; start < size; start++)
- {
- choices[start] = (pk_data *)calloc(1, sizeof(pk_data));
- choices[start]->phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
- }
-
- while (true)
- {
- free_top = 0;
- day_counter = 0;
- days = 0;
- local_best = (mus_float_t)n;
- increment = orig_incr;
-
- for (start = 0; start < size; start++)
- {
- mus_float_t pk, local_pk = 100000.0;
- int k, init_try;
-
- for (init_try = 0; init_try < INIT_TRIES; init_try++)
- {
- for (k = 1; k < n; k++) temp_phases[k] = local_frandom(2.0);
- pk = get_peak(temp_phases);
-
- if (pk < local_best)
- {
- local_best = pk;
- if ((!just_best) ||
- (pk < overall_min))
- {
- FILE *ofile;
- if (file)
- ofile = fopen(file, "a");
- else ofile = stderr;
- for (k = 1; k < n; k++) min_phases[k] = temp_phases[k];
- fprintf(ofile, "[%d, %d, %f, %lld]: %s, %d %f #(", years, days, increment, (long long int)ffts, choice_name[choice], n, pk);
- for (k = 0; k < n - 1; k++) fprintf(ofile, "%f ", min_phases[k]);
- fprintf(ofile, "%f)\n\n", min_phases[n - 1]);
- if (file) fclose(ofile);
- if (pk < overall_min) overall_min = pk;
- }
- }
-
- if (pk < local_pk)
- {
- for (k = 1; k < n; k++) choices[start]->phases[k] = temp_phases[k];
- choices[start]->pk = pk;
- local_pk = pk;
- }
- }
- }
-
- while (day()) {}
-
- /* try again from the top... */
- if (!file) fprintf(stderr, "[%d: %d, %f]\n", years, days, local_best);
- years++;
- }
- }
- return(XEN_FALSE);
-}
-
-/* -------------------------------------------------------------------------------- */
-
-#define S_fpsaf "fpsaf"
-
-static XEN g_fpsaf(XEN mult, XEN x_choice, XEN x_n, XEN x_size, XEN x_increment, XEN x_counts, XEN x_file, XEN x_just_best, XEN start_phases)
-{
- #define H_fpsaf "(" S_fpsaf " mult choice n (size 2000) (increment 1.0) (counts 50) (output-file #f) (report-best #t)) searches \
-for a peak-amp minimum using a simulated annealing form of the genetic algorithm. choice: 0=all, 1=odd, 2=even, 3=prime."
-
- #define FFT_MULT 128
- #define INCR_DOWN 0.9
- #define INCR_MAX 1.0
- #define INCR_MIN 0.001
- #define RETRIES 10
- #define RETRY_MULT 2
- #define INIT_TRIES 1000
- #define ALL 0
- #define ODD 1
- #define EVEN 2
- #define PRIME 3
-
- int choice, n, size, counts = 0, day_counter = 0, days = 0, years = 0, free_top = 0, fft_size = 0;
- mus_long_t ffts = 0;
- mus_float_t increment = INCR_MAX, orig_incr, local_best = 1000.0, incr_mult = INCR_DOWN, overall_min, last_mult = 1.0;
- mus_float_t *min_phases = NULL, *temp_phases = NULL, *diff_phases = NULL, *initial_phases = NULL;
- char *choice_name[4] = {"all", "odd", "even", "prime"};
- pk_data **choices = NULL, **free_choices = NULL;
- mus_float_t *rl, *im;
- const char *file = NULL;
- bool just_best = true;
-
- auto mus_float_t saved_min(int ch, int nn);
- auto mus_float_t get_peak(mus_float_t *phases);
- auto pk_data *next_choice(pk_data *data);
- auto bool day(void);
-
- mus_float_t saved_min(int ch, int nn)
- {
- if (nn <= 128)
- {
- switch (ch)
- {
- case ALL: return(all_mins[nn - 1]);
- case ODD: return(odd_mins[nn - 1]);
- case EVEN: return(even_mins[nn - 1]);
- case PRIME: return(prime_mins[nn - 1]);
- }
- }
- if (nn == 256) return(min_8[ch]);
- if (nn == 512) return(min_9[ch]);
- if (nn == 1024) return(min_10[ch]);
- if (nn == 2048) return(min_11[ch]);
- return((mus_float_t)nn);
- }
-
- mus_float_t get_peak(mus_float_t *phases)
- {
- int i, m;
- mus_float_t pi2, mx_sin, mx_cos;
-
- pi2 = M_PI / 2.0;
- memset((void *)rl, 0, fft_size * sizeof(mus_float_t));
- memset((void *)im, 0, fft_size * sizeof(mus_float_t));
-
- for (m = 0; m < n; m++)
- {
- int bin;
- mus_float_t phi;
- phi = (M_PI * phases[m]) + pi2;
- if (choice == ALL)
- bin = m + 1;
- else
- {
- if (choice == ODD)
- bin = (m * 2) + 1;
- else
- {
- if (choice == EVEN)
- {
- bin = m * 2;
- if (bin == 0) bin = 1;
- }
- else bin = primes[m];
- }
- }
- /* if (m == (n - 1)) */ /* top case mentioned in sndscm.html */
- if ((m > 1) && (m & 1))
- {
- rl[bin] = last_mult * cos(phi);
- im[bin] = last_mult * sin(phi);
- }
- else
- {
- rl[bin] = cos(phi);
- im[bin] = sin(phi);
- }
- }
-
- mus_fft(rl, im, fft_size, -1);
- /* real part is sine reconstruction, imaginary part is cosine, we're interested in both! */
- /* we could also add and subtract the 2 to get 2 more cases "for free", amp sqrt(2), phase asin(cos(0)/sqrt(2)) */
- /* and repeat this with a shift (rotation from i) for 2n other cases */
- /* resultant amp is between 0 and 2 (cosine) */
-
- ffts++;
- mx_sin = fabs(rl[0]);
- mx_cos = fabs(im[0]);
- for (i = 1; i < fft_size; i++)
- {
- mus_float_t mxtemp;
- mxtemp = fabs(rl[i]);
- if (mxtemp > mx_sin)
- mx_sin = mxtemp;
- mxtemp = fabs(im[i]);
- if (mxtemp > mx_cos)
- mx_cos = mxtemp;
- }
-
- return(mx_sin); /* ignore cos case since we're trying to follow a path */
-
- if (mx_sin <= mx_cos)
- return(mx_sin);
-
- /* use the cosine case, but make it sine-based with 0.0 initial phase for the fundamental */
- for (m = 1; m < n; m++)
- {
- int bin;
- if (choice == ALL)
- bin = m + 1;
- else
- {
- if (choice == ODD)
- bin = (m * 2) + 1;
- else
- {
- if (choice == EVEN)
- {
- bin = m * 2;
- if (bin == 0) bin = 1;
- }
- else bin = primes[m];
- }
- }
- phases[m] += (0.5 * (bin - 1));
- }
-
- return(mx_cos);
- }
-
- pk_data *next_choice(pk_data *data)
- {
- mus_float_t *phases;
- mus_float_t cur_min, temp_min = 100000.0, pk = 100000.0;
- int len, local_try, i, k, local_tries;
- pk_data *new_pk;
-
- new_pk = free_choices[--free_top];
- cur_min = data->pk;
- phases = data->phases;
- len = n;
- local_tries = RETRIES + day_counter * RETRY_MULT;
-
- /* try to find a point nearby that is better */
- for (local_try = 0; (local_try < local_tries) && (pk >= cur_min); local_try++)
- {
- for (i = 1; i < len; i++)
- temp_phases[i] = fmod(phases[i] + local_random(increment), 2.0); /* not mus_frandom! */
- pk = get_peak(temp_phases);
-
- if (pk < temp_min)
- {
- temp_min = pk;
- new_pk->pk = pk;
- for (k = 1; k < len; k++) new_pk->phases[k] = temp_phases[k];
- }
- }
-
- /* if a better point is found, try to follow the slopes */
- if (new_pk->pk < data->pk)
- {
- bool happy = true;
- for (k = 1; k < len; k++)
- diff_phases[k] = new_pk->phases[k] - data->phases[k];
-
- while (happy)
- {
- for (k = 1; k < len; k++)
- temp_phases[k] = fmod(new_pk->phases[k] + diff_phases[k], 2.0); /* frandom here? */
- pk = get_peak(temp_phases);
-
- if (pk < new_pk->pk)
- {
- new_pk->pk = pk;
- for (k = 1; k < len; k++) new_pk->phases[k] = temp_phases[k];
- }
- else happy = false;
- }
- }
-
- pk = new_pk->pk;
-
- if (pk < local_best)
- {
- local_best = pk;
- if ((!just_best) ||
- (pk < overall_min))
- {
- FILE *ofile;
- if (file)
- ofile = fopen(file, "a");
- else ofile = stderr;
- for (k = 1; k < len; k++) min_phases[k] = new_pk->phases[k];
- fprintf(ofile, "[%d, %d, %f, %lld]: %s, %d %f #(", years, days, increment, (long long int)ffts, choice_name[choice], n, pk);
- for (k = 0; k < len - 1; k++) fprintf(ofile, "%f ", min_phases[k]);
- fprintf(ofile, "%f)\n\n", min_phases[len - 1]);
- if (file) fclose(ofile);
- if (pk < overall_min) overall_min = pk;
- }
-
- day_counter = 0;
- }
- return(new_pk);
- }
-
- bool day(void)
- {
- int i, j = 0, k, len;
- mus_float_t sum = 0.0, avg;
- len = size;
- day_counter++;
- days++;
- for (i = 0; i < len; i++) sum += choices[i]->pk;
- avg = sum / len;
-
- for (i = 0; i < len; i++)
- {
- pk_data *datum;
- datum = choices[i];
- choices[i] = NULL;
- if (datum->pk < avg)
- choices[j++] = datum;
- else free_choices[free_top++] = datum;
- }
-
- for (i = 0, k = j; k < len; i++, k++)
- {
- if (i == j)
- i = 0;
- choices[k] = next_choice(choices[i]);
- }
-
- if (day_counter < counts)
- {
- increment *= incr_mult;
- if (increment < INCR_MIN)
- {
- increment = INCR_MIN;
- }
- if (increment > INCR_MAX)
- {
- increment = INCR_MAX;
- incr_mult = INCR_DOWN;
- }
- return(true);
- }
- return(false);
- }
-
-#if HAVE_SYS_TIME_H
- {
- struct timeval tm;
- struct timezone tz;
- gettimeofday(&tm, &tz);
- mus_set_rand_seed((unsigned long)(tm.tv_sec * 1000 + tm.tv_usec / 1000));
- }
-#endif
-
- last_mult = XEN_TO_C_DOUBLE(mult);
-
- choice = XEN_TO_C_INT(x_choice);
- if ((choice < ALL) || (choice > PRIME))
- choice = ALL;
-
- n = XEN_TO_C_INT(x_n);
-
- if (XEN_INTEGER_P(x_size))
- size = XEN_TO_C_INT(x_size);
- else size = 2000;
- if (size < 2) size = 2;
-
- if (XEN_INTEGER_P(x_counts))
- counts = XEN_TO_C_INT(x_counts);
- else counts = 50;
-
- if (XEN_DOUBLE_P(x_increment))
- increment = XEN_TO_C_DOUBLE(x_increment);
- else increment = INCR_MAX;
- orig_incr = increment;
- incr_mult = INCR_DOWN;
-
- if (XEN_STRING_P(x_file))
- file = XEN_TO_C_STRING(x_file);
- else file = NULL;
-
- if (XEN_BOOLEAN_P(x_just_best))
- just_best = XEN_TO_C_BOOLEAN(x_just_best);
- else just_best = true;
-
- if (XEN_VECTOR_P(start_phases))
- {
- int i;
- initial_phases = (mus_float_t *)malloc(n * sizeof(mus_float_t));
- for (i = 0; i < n; i++)
- initial_phases[i] = (mus_float_t)XEN_TO_C_DOUBLE(XEN_VECTOR_REF(start_phases, i));
- }
-
-
- {
- FILE *ofile;
- if (file)
- ofile = fopen(file, "a");
- else ofile = stderr;
- fprintf(ofile, "(fpsaf %f %d %d %d %d %f)\n", last_mult, choice, n, size, counts, increment);
- fprintf(stderr, "(fpsaf %f %d %d %d %d %f)\n", last_mult, choice, n, size, counts, increment);
- if (file) fclose(ofile);
- }
-
- min_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
- overall_min = saved_min(choice, n + 1);
-
- temp_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
- diff_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
-
- {
- int start, n1;
-
- if (choice == ALL)
- n1 = n;
- else
- {
- if (choice != PRIME)
- n1 = n * 2;
- else n1 = primes[n];
- }
- fft_size = (int)pow(2.0, (int)ceil(log(FFT_MULT * n1) / log(2.0)));
- rl = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
- im = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
-
- choices = (pk_data **)calloc(size, sizeof(pk_data *));
- free_choices = (pk_data **)calloc(size, sizeof(pk_data *));
-
- for (start = 0; start < size; start++)
- {
- choices[start] = (pk_data *)calloc(1, sizeof(pk_data));
- choices[start]->phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
- }
-
- while (true)
- {
- free_top = 0;
- day_counter = 0;
- days = 0;
- local_best = (mus_float_t)n;
- increment = orig_incr;
-
- for (start = 0; start < size; start++)
- {
- mus_float_t pk, local_pk = 100000.0;
- int k, init_try;
-
- for (init_try = 0; init_try < INIT_TRIES; init_try++)
- {
- if (initial_phases)
- {
- for (k = 1; k < n; k++)
- temp_phases[k] = initial_phases[k] + local_random(increment);
- }
- else
- {
- for (k = 1; k < n; k++)
- temp_phases[k] = local_frandom(2.0);
- }
- pk = get_peak(temp_phases);
-
- if (pk < local_best)
- {
- local_best = pk;
- if ((!just_best) ||
- (pk < overall_min))
- {
- FILE *ofile;
- if (file)
- ofile = fopen(file, "a");
- else ofile = stderr;
- for (k = 1; k < n; k++) min_phases[k] = temp_phases[k];
- fprintf(ofile, "[%d, %d, %f, %lld]: %s, %d %f #(", years, days, increment, (long long int)ffts, choice_name[choice], n, pk);
- for (k = 0; k < n - 1; k++) fprintf(ofile, "%f ", min_phases[k]);
- fprintf(ofile, "%f)\n\n", min_phases[n - 1]);
- if (file) fclose(ofile);
- if (pk < overall_min) overall_min = pk;
- }
- }
-
- if (pk < local_pk)
- {
- for (k = 1; k < n; k++) choices[start]->phases[k] = temp_phases[k];
- choices[start]->pk = pk;
- local_pk = pk;
- }
- }
- }
-
- while (day()) {}
- break;
-
- /* try again from the top... */
- if (!file) fprintf(stderr, "[%d: %d, %f]\n", years, days, local_best);
- years++;
- }
- }
-
- free(temp_phases);
- free(diff_phases);
- free(rl);
- free(im);
- free(free_choices);
- if (initial_phases) free(initial_phases);
-
- {
- int i;
- for (i = 0; i < size; i++)
- {
- free(choices[i]->phases);
- free(choices[i]);
- }
- free(choices);
- }
+ static mus_float_t odd_mins[128] = {1.0000, 1.5390, 1.7387, 2.0452, 2.3073, 2.5227, 2.6183, 2.7907, 2.8862, 3.0534, 3.1766, 3.3619, 3.4745, 3.5985, 3.7384, 3.8570, 3.9264, 4.0695, 4.1719, 4.3580, 4.4485, 4.5810, 4.6616, 4.7864, 4.8868, 5.0064, 5.0888, 5.0889, 5.2634, 5.3531, 5.4189, 5.5633, 5.6030, 5.7405, 5.8333, 5.9776, 6.0191, 6.1443, 6.1815, 6.2725, 6.3216, 6.4032, 6.4742, 6.5992, 6.6249, 6.7092, 6.7852, 6.8280, 6.9896, 6.9471, 7.0877, 7.0801, 7.2526, 7.3281, 7.3642, 7.4191, 7.4889, 7.5859, 7.6178, 7.6996, 7.7755, 7.8170, 7.9041, 7.9574, 8.0418, 8.0952, 8.1280, 8.2044, 8.2749, 8.3285, 8.4066, 8.3664, 8.5147, 8.4879, 8.6495, 8.6513, 8.7070, 8.7153, 8.8646, 8.8701, 8.9263, 8.8955, 9.0607, 9.1335, 9.1729, 9.2133, 9.3199, 9.3240, 9.3316, 9.4217, 9.4566, 9.5527, 9.6288, 9.6539, 9.7169, 9.7594, 9.8323, 9.8526, 9.9278, 9.9678, 9.9646, 10.0458, 10.1025, 10.1685, 10.1158, 10.1983, 10.2960, 10.3255, 10.4140, 10.4081, 10.5889, 10.5826, 10.5864, 10.6208, 10.6743, 10.7333, 10.7833, 10.8122, 10.9166, 10.9086, 11.0006, 11.0363, 11.1211, 11.1342, 11.1221, 11.2224, 11.2680, 11.2612};
- return(xen_make_vct(n, min_phases));
+ static mus_float_t prime_mins[128] = {1.0000, 1.7600, 1.9798, 2.1921, 2.4768, 2.8054, 3.0618, 3.2628, 3.3822, 3.6019, 3.7784, 3.9359, 4.1545, 4.3244, 4.4669, 4.6015, 4.7191, 4.8554, 5.0150, 5.1886, 5.3250, 5.4444, 5.5636, 5.6457, 5.8110, 6.0603, 6.1342, 6.1909, 6.3650, 6.4518, 6.7015, 6.8403, 6.8471, 6.9918, 7.1647, 7.2743, 7.2923, 7.3972, 7.4571, 7.7036, 7.8670, 7.9689, 8.0462, 8.1786, 8.1587, 8.2656, 8.4225, 8.4701, 8.6383, 8.6779, 8.6547, 8.8203, 8.9537, 9.1135, 9.1486, 9.4076, 9.5698, 9.4963, 9.4489, 9.6577, 9.8482, 9.7939, 9.7212, 9.9180, 10.2494, 10.2168, 10.3295, 10.4019, 10.4139, 10.4406, 10.5788, 10.5922, 10.7617, 10.7115, 11.0223, 11.0723, 10.8825, 11.1288, 11.2266, 11.4514, 11.5009, 11.4800, 11.5157, 11.5609, 11.6403, 11.5250, 11.9270, 11.9889, 12.2189, 12.0405, 12.1250, 12.1239, 12.3234, 12.3723, 12.5103, 12.6686, 12.6382, 12.8988, 13.0893, 13.1158, 13.0683, 13.3991, 13.4243, 13.1969, 13.1439, 13.2161, 13.5618, 13.6628, 13.6943, 13.7797, 13.7655, 13.8646, 14.0364, 14.2144, 14.1698, 14.4672, 14.6007, 14.5453, 14.3907, 14.5061, 14.5506, 14.8452, 14.6063, 14.8769, 14.7724, 14.9200, 14.9658, 14.6466};
+
+ static mus_float_t even_mins[128] = {1.0000, 1.7602, 2.0215, 2.4306, 2.6048, 2.8370, 3.0470, 3.1975, 3.4540, 3.5587, 3.6561, 3.7869, 3.9726, 4.0967, 4.1921, 4.3250, 4.4630, 4.5694, 4.7415, 4.8395, 4.9197, 5.0552, 5.1479, 5.2532, 5.4032, 5.4523, 5.6204, 5.7317, 5.7663, 5.9070, 5.9878, 6.0611, 6.1626, 6.2228, 6.3623, 6.4321, 6.5805, 6.5366, 6.6832, 6.7481, 6.8810, 6.9415, 7.0552, 7.0483, 7.1652, 7.2760, 7.2926, 7.4670, 7.5877, 7.6224, 7.6548, 7.7863, 7.7505, 7.8451, 8.0075, 8.0420, 8.1156, 8.1027, 8.1945, 8.3124, 8.3566, 8.3910, 8.4139, 8.5009, 8.6650, 8.7856, 8.8244, 8.7974, 8.8704, 9.0010, 9.0999, 8.9855, 9.1604, 9.2507, 9.2084, 9.3920, 9.3628, 9.3359, 9.5324, 9.5713, 9.5437, 9.6632, 9.7525, 9.7487, 9.6937, 9.8045, 9.8747, 9.9683, 10.1103, 10.2395, 10.1678, 10.2333, 10.1208, 10.4354, 10.4453, 10.5480, 10.4547, 10.5295, 10.4140, 10.4721, 10.7995, 10.8253, 10.8315, 10.7829, 10.9236, 10.9172, 10.9844, 11.0254, 11.0804, 11.2647, 11.3526, 11.2728, 11.1978, 11.3362, 11.3367, 11.5548, 11.3673, 11.5805, 11.6248, 11.7167, 11.5799, 11.7805, 11.7526, 11.8398, 11.8194, 11.9815, 11.8908, 11.9243};
+
+ static mus_float_t min_8[4] = {16.2329, 17.2610, 18.0460, 23.9548};
+ static mus_float_t min_9[4] = {24.1124, 24.0647, 25.2901, 38.6029};
+ static mus_float_t min_10[4] = {34.3800, 35.3998, 35.8426, 65.3493};
+ static mus_float_t min_11[4] = {51.4838, 50.4877, 51.3446, 95.9043};
+
+
+#define USE_CLM_RANDOM (!HAVE_SCHEME)
+
+static mus_float_t local_random(mus_float_t val)
+{
+#if USE_CLM_RANDOM
+ return(mus_random(val));
+#else
+ return(val * (1.0 - (s7_random(s7, NULL) * 2.0)));
+#endif
}
+
+static mus_float_t local_frandom(mus_float_t val)
+{
+#if USE_CLM_RANDOM
+ return(mus_frandom(val));
+#else
+ return(val * s7_random(s7, NULL));
#endif
+}
+
+typedef struct {
+ mus_float_t pk;
+ mus_float_t *phases;
+} pk_data;
/* -------------------------------------------------------------------------------- */
+#define ALL 0
+#define ODD 1
+#define EVEN 2
+#define PRIME 3
+
+#define FFT_MULT 160
+ /* if 64, errors or .005 are common
+ * if 128, which works in 99% of the cases, errors can be as much as .002
+ */
+
#define S_fpsap "fpsap"
-static XEN g_fpsap(XEN x_choice, XEN x_n, XEN start_phases, XEN x_size, XEN x_increment)
+static mus_float_t saved_min(int ch, int nn)
+{
+ if (nn <= 128)
+ {
+ switch (ch)
+ {
+ case ALL: return(all_mins[nn - 1]);
+ case ODD: return(odd_mins[nn - 1]);
+ case EVEN: return(even_mins[nn - 1]);
+ case PRIME: return(prime_mins[nn - 1]);
+ }
+ }
+ if (nn == 256) return(min_8[ch]);
+ if (nn == 512) return(min_9[ch]);
+ if (nn == 1024) return(min_10[ch]);
+ if (nn == 2048) return(min_11[ch]);
+ return((mus_float_t)nn);
+}
+
+
+static mus_float_t get_peak(int choice, int fft_size, int n, mus_float_t *phases, mus_float_t *rl, mus_float_t *im)
+{
+ int i, m;
+ mus_float_t pi2, mx_sin, mx_cos;
+
+ pi2 = M_PI / 2.0;
+ memset((void *)rl, 0, fft_size * sizeof(mus_float_t));
+ memset((void *)im, 0, fft_size * sizeof(mus_float_t));
+
+ for (m = 0; m < n; m++)
+ {
+ int bin;
+ mus_float_t phi;
+ phi = (M_PI * phases[m]) + pi2;
+ if (choice == ALL)
+ bin = m + 1;
+ else
+ {
+ if (choice == ODD)
+ bin = (m * 2) + 1;
+ else
+ {
+ if (choice == EVEN)
+ {
+ bin = m * 2;
+ if (bin == 0) bin = 1;
+ }
+ else bin = primes[m];
+ }
+ }
+ rl[bin] = cos(phi);
+ im[bin] = sin(phi);
+ }
+
+ mus_fft(rl, im, fft_size, -1);
+ /* real part is sine reconstruction, imaginary part is cosine, we're interested in both! */
+ /* we could also add and subtract the 2 to get 2 more cases "for free", amp sqrt(2), phase asin(cos(0)/sqrt(2)) */
+ /* and repeat this with a shift (rotation from i) for 2n other cases */
+ /* resultant amp is between 0 and 2 (cosine) */
+
+ mx_sin = fabs(rl[0]);
+ mx_cos = fabs(im[0]);
+ for (i = 1; i < fft_size; i++)
+ {
+ mus_float_t mxtemp;
+ mxtemp = fabs(rl[i]);
+ if (mxtemp > mx_sin)
+ mx_sin = mxtemp;
+ mxtemp = fabs(im[i]);
+ if (mxtemp > mx_cos)
+ mx_cos = mxtemp;
+ }
+
+ if (mx_sin <= mx_cos)
+ return(mx_sin);
+
+ /* use the cosine case, but make it sine-based with 0.0 initial phase for the fundamental */
+ for (m = 1; m < n; m++)
+ {
+ int bin;
+ if (choice == ALL)
+ bin = m + 1;
+ else
+ {
+ if (choice == ODD)
+ bin = (m * 2) + 1;
+ else
+ {
+ if (choice == EVEN)
+ {
+ bin = m * 2;
+ if (bin == 0) bin = 1;
+ }
+ else bin = primes[m];
+ }
+ }
+ phases[m] += (0.5 * (bin - 1));
+ }
+
+ return(mx_cos);
+}
+
+
+static Xen g_fpsap(Xen x_choice, Xen x_n, Xen start_phases, Xen x_size, Xen x_increment)
{
#define H_fpsap "(" S_fpsap " choice n phases (size 6000) (increment 0.06)) searches \
for a peak-amp minimum using a simulated annealing form of the genetic algorithm. choice: 0=all, 1=odd, 2=even, 3=prime."
- #define FFT_MULT 128
- #define INCR_DOWN 0.9
+ #define INCR_DOWN 0.92
#define INCR_MAX 1.0
- #define INCR_MIN 0.001
+ #define INCR_MIN 0.00005
#define RETRIES 10
#define RETRY_MULT 2
- #define INIT_TRIES 1000
- #define ALL 0
- #define ODD 1
- #define EVEN 2
- #define PRIME 3
+ #define INIT_TRIES 5000
- int choice, n, size, counts = 0, day_counter = 0, free_top = 0, fft_size = 0;
+ int choice, n, size, counts = 0;
mus_float_t increment = INCR_MAX, orig_incr, local_best = 1000.0, incr_mult = INCR_DOWN, overall_min;
mus_float_t *min_phases = NULL, *temp_phases = NULL, *diff_phases = NULL, *initial_phases = NULL;
- char *choice_name[4] = {"all", "odd", "even", "prime"};
+ const char *choice_name[4] = {"all", "odd", "even", "prime"};
pk_data **choices = NULL, **free_choices = NULL;
mus_float_t *rl, *im;
const char *file = NULL;
bool just_best = false;
- auto mus_float_t saved_min(int ch, int nn);
- auto mus_float_t get_peak(mus_float_t *phases);
- auto pk_data *next_choice(pk_data *data);
- auto bool day(void);
-
- mus_float_t saved_min(int ch, int nn)
- {
- if (nn <= 128)
- {
- switch (ch)
- {
- case ALL: return(all_mins[nn - 1]);
- case ODD: return(odd_mins[nn - 1]);
- case EVEN: return(even_mins[nn - 1]);
- case PRIME: return(prime_mins[nn - 1]);
- }
- }
- if (nn == 256) return(min_8[ch]);
- if (nn == 512) return(min_9[ch]);
- if (nn == 1024) return(min_10[ch]);
- if (nn == 2048) return(min_11[ch]);
- return((mus_float_t)nn);
- }
-
- mus_float_t get_peak(mus_float_t *phases)
- {
- int i, m;
- mus_float_t pi2, mx_sin, mx_cos;
-
- pi2 = M_PI / 2.0;
- memset((void *)rl, 0, fft_size * sizeof(mus_float_t));
- memset((void *)im, 0, fft_size * sizeof(mus_float_t));
-
- for (m = 0; m < n; m++)
- {
- int bin;
- mus_float_t phi;
- phi = (M_PI * phases[m]) + pi2;
- if (choice == ALL)
- bin = m + 1;
- else
- {
- if (choice == ODD)
- bin = (m * 2) + 1;
- else
- {
- if (choice == EVEN)
- {
- bin = m * 2;
- if (bin == 0) bin = 1;
- }
- else bin = primes[m];
- }
- }
- rl[bin] = cos(phi);
- im[bin] = sin(phi);
- }
-
- mus_fft(rl, im, fft_size, -1);
- /* real part is sine reconstruction, imaginary part is cosine, we're interested in both! */
- /* we could also add and subtract the 2 to get 2 more cases "for free", amp sqrt(2), phase asin(cos(0)/sqrt(2)) */
- /* and repeat this with a shift (rotation from i) for 2n other cases */
- /* resultant amp is between 0 and 2 (cosine) */
-
- mx_sin = fabs(rl[0]);
- mx_cos = fabs(im[0]);
- for (i = 1; i < fft_size; i++)
- {
- mus_float_t mxtemp;
- mxtemp = fabs(rl[i]);
- if (mxtemp > mx_sin)
- mx_sin = mxtemp;
- mxtemp = fabs(im[i]);
- if (mxtemp > mx_cos)
- mx_cos = mxtemp;
- }
-
- if (mx_sin <= mx_cos)
- return(mx_sin);
-
- /* use the cosine case, but make it sine-based with 0.0 initial phase for the fundamental */
- for (m = 1; m < n; m++)
- {
- int bin;
- if (choice == ALL)
- bin = m + 1;
- else
- {
- if (choice == ODD)
- bin = (m * 2) + 1;
- else
- {
- if (choice == EVEN)
- {
- bin = m * 2;
- if (bin == 0) bin = 1;
- }
- else bin = primes[m];
- }
- }
- phases[m] += (0.5 * (bin - 1));
- }
-
- return(mx_cos);
- }
-
- pk_data *next_choice(pk_data *data)
- {
- mus_float_t *phases;
- mus_float_t cur_min, temp_min = 100000.0, pk = 100000.0;
- int len, local_try, i, k, local_tries;
- pk_data *new_pk;
-
- new_pk = free_choices[--free_top];
- cur_min = data->pk;
- phases = data->phases;
- len = n;
- local_tries = RETRIES + day_counter * RETRY_MULT;
-
- /* try to find a point nearby that is better */
- for (local_try = 0; (local_try < local_tries) && (pk >= cur_min); local_try++)
- {
- for (i = 1; i < len; i++)
- temp_phases[i] = fmod(phases[i] + local_random(increment), 2.0); /* not mus_frandom! */
- pk = get_peak(temp_phases);
-
- if (pk < temp_min)
- {
- temp_min = pk;
- new_pk->pk = pk;
- for (k = 1; k < len; k++) new_pk->phases[k] = temp_phases[k];
- }
- }
-
- /* if a better point is found, try to follow the slopes */
- if (new_pk->pk < data->pk)
- {
- bool happy = true;
- for (k = 1; k < len; k++)
- diff_phases[k] = new_pk->phases[k] - data->phases[k];
-
- while (happy)
- {
- for (k = 1; k < len; k++)
- temp_phases[k] = fmod(new_pk->phases[k] + diff_phases[k], 2.0); /* frandom here? */
- pk = get_peak(temp_phases);
-
- if (pk < new_pk->pk)
- {
- new_pk->pk = pk;
- for (k = 1; k < len; k++) new_pk->phases[k] = temp_phases[k];
- }
- else happy = false;
- }
- }
-
- pk = new_pk->pk;
-
- if (pk < local_best)
- {
- local_best = pk;
- if ((!just_best) ||
- (pk < overall_min))
- {
- FILE *ofile;
- for (k = 1; k < len; k++) min_phases[k] = new_pk->phases[k];
- if (pk < overall_min)
- {
- if (file)
- ofile = fopen(file, "a");
- else ofile = stderr;
- fprintf(ofile, "%s, %d %f #(", choice_name[choice], n, pk);
- for (k = 0; k < len - 1; k++) fprintf(ofile, "%f ", min_phases[k]);
- fprintf(ofile, "%f)\n", min_phases[len - 1]);
- if (file) fclose(ofile);
- overall_min = pk;
- }
- }
-
- day_counter = 0;
- }
- return(new_pk);
- }
-
- bool day(void)
- {
- int i, j = 0, k, len;
- mus_float_t sum = 0.0, avg;
- len = size;
- day_counter++;
- for (i = 0; i < len; i++) sum += choices[i]->pk;
- avg = sum / len;
-
- for (i = 0; i < len; i++)
- {
- pk_data *datum;
- datum = choices[i];
- choices[i] = NULL;
- if (datum->pk < avg)
- choices[j++] = datum;
- else free_choices[free_top++] = datum;
- }
-
- for (i = 0, k = j; k < len; i++, k++)
- {
- if (i == j)
- i = 0;
- choices[k] = next_choice(choices[i]);
- }
-
- if (day_counter < counts)
- {
- increment *= incr_mult;
- if (increment < INCR_MIN)
- {
- increment = INCR_MIN;
- }
- if (increment > INCR_MAX)
- {
- increment = INCR_MAX;
- incr_mult = INCR_DOWN;
- }
- return(true);
- }
- return(false);
- }
-
-#if HAVE_SYS_TIME_H
+#ifndef _MSC_VER
{
struct timeval tm;
struct timezone tz;
@@ -7067,41 +6078,45 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
}
#endif
- choice = XEN_TO_C_INT(x_choice);
+ choice = Xen_integer_to_C_int(x_choice);
if ((choice < ALL) || (choice > PRIME))
choice = ALL;
- n = XEN_TO_C_INT(x_n);
+ n = Xen_integer_to_C_int(x_n);
- if (XEN_INTEGER_P(x_size))
- size = XEN_TO_C_INT(x_size);
- else size = 6000; /* was 3000 */
+ if (Xen_is_integer(x_size))
+ size = Xen_integer_to_C_int(x_size);
+ else size = 3000;
- if (XEN_DOUBLE_P(x_increment))
- increment = XEN_TO_C_DOUBLE(x_increment);
+ if (Xen_is_double(x_increment))
+ increment = Xen_real_to_C_double(x_increment);
else increment = 0.06; /* was .03 */
- counts = 50; /* was 100 */
+ counts = 50; /* 100? */
orig_incr = increment;
incr_mult = INCR_DOWN;
file = "test.data";
just_best = false;
- if (XEN_VECTOR_P(start_phases))
+ if (Xen_is_vector(start_phases))
{
int i;
initial_phases = (mus_float_t *)malloc(n * sizeof(mus_float_t));
for (i = 0; i < n; i++)
- initial_phases[i] = (mus_float_t)XEN_TO_C_DOUBLE(XEN_VECTOR_REF(start_phases, i));
+ initial_phases[i] = (mus_float_t)Xen_real_to_C_double(Xen_vector_ref(start_phases, i));
}
min_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
+
overall_min = saved_min(choice, n);
+ if (overall_min < sqrt((double)n)) overall_min = sqrt((double)n);
+ overall_min += .5;
+
temp_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
diff_phases = (mus_float_t *)calloc(n, sizeof(mus_float_t));
{
- int start, n1;
+ int start, n1, day_counter, free_top, fft_size;
if (choice == ALL)
n1 = n;
@@ -7128,7 +6143,14 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
day_counter = 0;
local_best = (mus_float_t)n;
increment = orig_incr;
-
+
+ /* here to stay focussed,
+ * for (k = 0; k < n; k++) choices[0]->phases[k] = initial_phases[k];
+ * choices[0]->pk = get_peak(choice, fft_size, n, initial_phases, rl, im);
+ * for (start = 1; start < size; start++)
+ * etc
+ * but this is not an improvement
+ */
for (start = 0; start < size; start++)
{
mus_float_t pk, local_pk = 100000.0;
@@ -7139,14 +6161,14 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
if (initial_phases)
{
for (k = 1; k < n; k++)
- temp_phases[k] = initial_phases[k] + local_random(increment);
+ temp_phases[k] = initial_phases[k] + local_random(increment) + local_random(increment);
}
else
{
for (k = 1; k < n; k++)
temp_phases[k] = local_frandom(2.0);
}
- pk = get_peak(temp_phases);
+ pk = get_peak(choice, fft_size, n, temp_phases, rl, im);
if (pk < local_best)
{
@@ -7154,10 +6176,10 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
if ((!just_best) ||
(pk < overall_min))
{
- FILE *ofile;
for (k = 1; k < n; k++) min_phases[k] = temp_phases[k];
if (pk < overall_min)
{
+ FILE *ofile;
if (file)
ofile = fopen(file, "a");
else ofile = stderr;
@@ -7178,9 +6200,131 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
}
}
}
- while (day()) {}
+
+ while (true)
+ {
+ int i, j = 0, k, len;
+ mus_float_t sum = 0.0, avg;
+
+ len = size;
+ day_counter++;
+ for (i = 0; i < len; i++) sum += choices[i]->pk;
+ avg = sum / len;
+
+ for (i = 0; i < len; i++)
+ {
+ pk_data *datum;
+ datum = choices[i];
+ choices[i] = NULL;
+ if (datum->pk < avg)
+ choices[j++] = datum;
+ else free_choices[free_top++] = datum;
+ }
+
+ for (i = 0, k = j; k < len; i++, k++)
+ {
+ pk_data *data;
+ mus_float_t *phases;
+ mus_float_t cur_min, temp_min = 100000.0, pk = 100000.0;
+ int llen, local_try, ii, kk, local_tries;
+ pk_data *new_pk;
+
+ if (i == j)
+ i = 0;
+
+ data = choices[i];
+ new_pk = free_choices[--free_top];
+ cur_min = data->pk;
+ phases = data->phases;
+ llen = n;
+ local_tries = RETRIES + day_counter * RETRY_MULT;
+
+ /* try to find a point nearby that is better */
+ for (local_try = 0; (local_try < local_tries) && (pk >= cur_min); local_try++)
+ {
+ for (ii = 1; ii < llen; ii++)
+ temp_phases[ii] = fmod(phases[ii] + local_random(increment) + local_random(increment), 2.0); /* not mus_frandom! */
+ pk = get_peak(choice, fft_size, n, temp_phases, rl, im);
+
+ if (pk < temp_min)
+ {
+ temp_min = pk;
+ new_pk->pk = pk;
+ for (kk = 1; kk < llen; kk++) new_pk->phases[kk] = temp_phases[kk];
+ }
+ }
+
+ /* if a better point is found, try to follow the slopes */
+ if (new_pk->pk < data->pk)
+ {
+ int happy = 3;
+ for (kk = 1; kk < llen; kk++)
+ diff_phases[kk] = new_pk->phases[kk] - data->phases[kk];
+
+ while (happy > 0)
+ {
+ for (kk = 1; kk < llen; kk++)
+ temp_phases[kk] = fmod(new_pk->phases[kk] + local_frandom(diff_phases[kk]), 2.0); /* use frandom 30-mar-11 */
+ pk = get_peak(choice, fft_size, n, temp_phases, rl, im);
+
+ if (pk < new_pk->pk)
+ {
+ new_pk->pk = pk;
+ for (kk = 1; kk < llen; kk++) new_pk->phases[kk] = temp_phases[kk];
+ happy = 3;
+ }
+ else happy--;
+ }
+ }
+
+ pk = new_pk->pk;
+
+ if (pk < local_best)
+ {
+ local_best = pk;
+ if ((!just_best) ||
+ (pk < overall_min))
+ {
+ for (kk = 1; kk < llen; kk++) min_phases[kk] = new_pk->phases[kk];
+ if (pk < overall_min)
+ {
+ FILE *ofile;
+ if (file)
+ ofile = fopen(file, "a");
+ else ofile = stderr;
+ fprintf(ofile, "%s, %d %f #(", choice_name[choice], n, pk);
+ for (kk = 0; kk < llen - 1; kk++) fprintf(ofile, "%f ", min_phases[kk]);
+ fprintf(ofile, "%f)\n", min_phases[llen - 1]);
+ if (file) fclose(ofile);
+ overall_min = pk;
+ }
+ }
+
+ day_counter = 0;
+ }
+ choices[k] = new_pk;
+ }
+
+ if (day_counter < counts)
+ {
+ /* .9^50 = .005, so starting at .1 bottoms out at .0005
+ * perhaps the counts variable should be (ceiling (log INCR_MIN incr_mult)) = 90 or so in the current case
+ * incr_mult is currently always INCR_DOWN = .9
+ */
+ increment *= incr_mult;
+ if (increment < INCR_MIN)
+ {
+ increment = INCR_MIN;
+ }
+ if (increment > INCR_MAX)
+ {
+ increment = INCR_MAX;
+ incr_mult = INCR_DOWN;
+ }
+ }
+ else break;
+ }
}
-
free(temp_phases);
free(diff_phases);
free(rl);
@@ -7198,170 +6342,250 @@ for a peak-amp minimum using a simulated annealing form of the genetic algorithm
free(choices);
}
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(local_best),
+ return(Xen_list_2(C_double_to_Xen_real(local_best),
xen_make_vct(n, min_phases)));
}
-#endif
+#if HAVE_SCHEME
+static s7_pointer g_phases_get_peak(s7_scheme *sc, s7_pointer args)
+{
+ s7_int choice, i, m, n;
+ int fft_size, fft_mult = 128, n1;
+ s7_pointer phases;
+ s7_pointer *elements;
+ double pi2, mx;
+ mus_float_t *rl, *im;
+
+ pi2 = M_PI / 2.0;
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_6(g_scan_chan_w, g_scan_chan)
-XEN_ARGIFY_7(g_map_chan_w, g_map_chan)
-XEN_ARGIFY_6(g_scan_channel_w, g_scan_channel)
-XEN_ARGIFY_7(g_map_channel_w, g_map_channel)
-XEN_ARGIFY_5(g_find_channel_w, g_find_channel)
-XEN_ARGIFY_5(g_count_matches_w, g_count_matches)
-XEN_ARGIFY_4(g_smooth_sound_w, g_smooth_sound)
-XEN_ARGIFY_5(g_smooth_channel_w, g_smooth_channel)
-XEN_NARGIFY_0(g_smooth_selection_w, g_smooth_selection)
-XEN_NARGIFY_0(g_delete_selection_and_smooth_w, g_delete_selection_and_smooth)
-XEN_ARGIFY_5(g_delete_samples_and_smooth_w, g_delete_samples_and_smooth)
-XEN_ARGIFY_3(g_reverse_sound_w, g_reverse_sound)
-XEN_ARGIFY_5(g_reverse_channel_w, g_reverse_channel)
-XEN_NARGIFY_0(g_reverse_selection_w, g_reverse_selection)
-XEN_ARGIFY_8(g_swap_channels_w, g_swap_channels)
-XEN_ARGIFY_4(g_insert_silence_w, g_insert_silence)
-XEN_ARGIFY_1(g_scale_selection_to_w, g_scale_selection_to)
-XEN_NARGIFY_1(g_scale_selection_by_w, g_scale_selection_by)
-XEN_ARGIFY_3(g_scale_to_w, g_scale_to)
-XEN_ARGIFY_3(g_scale_by_w, g_scale_by)
-XEN_ARGIFY_2(g_env_selection_w, g_env_selection)
-XEN_ARGIFY_7(g_env_sound_w, g_env_sound)
-XEN_ARGIFY_6(g_env_channel_w, g_env_channel)
-XEN_ARGIFY_7(g_env_channel_with_base_w, g_env_channel_with_base)
-XEN_ARGIFY_7(g_ramp_channel_w, g_ramp_channel)
-XEN_ARGIFY_8(g_xramp_channel_w, g_xramp_channel)
-XEN_ARGIFY_3(g_fft_w, g_fft)
-XEN_ARGIFY_7(g_snd_spectrum_w, g_snd_spectrum)
-XEN_ARGIFY_5(g_convolve_with_w, g_convolve_with)
-XEN_ARGIFY_2(g_convolve_selection_with_w, g_convolve_selection_with)
-XEN_ARGIFY_5(g_src_sound_w, g_src_sound)
-XEN_ARGIFY_2(g_src_selection_w, g_src_selection)
-XEN_ARGIFY_6(g_src_channel_w, g_src_channel)
-XEN_ARGIFY_5(g_pad_channel_w, g_pad_channel)
-XEN_ARGIFY_9(g_filter_channel_w, g_filter_channel)
-XEN_ARGIFY_6(g_filter_sound_w, g_filter_sound)
-XEN_ARGIFY_3(g_filter_selection_w, g_filter_selection)
-XEN_ARGIFY_8(g_clm_channel_w, g_clm_channel)
-XEN_NARGIFY_0(g_sinc_width_w, g_sinc_width)
-XEN_NARGIFY_1(g_set_sinc_width_w, g_set_sinc_width)
-XEN_ARGIFY_9(g_ptree_channel_w, g_ptree_channel)
-#if HAVE_NESTED_FUNCTIONS
-XEN_VARGIFY(g_find_min_peak_phases_w, g_find_min_peak_phases)
-#if 0
-XEN_ARGIFY_7(g_fpsa_w, g_fpsa)
-XEN_ARGIFY_9(g_fpsaf_w, g_fpsaf)
-#endif
-XEN_ARGIFY_5(g_fpsap_w, g_fpsap)
-#endif
-#else
-#define g_scan_chan_w g_scan_chan
-#define g_map_chan_w g_map_chan
-#define g_scan_channel_w g_scan_channel
-#define g_map_channel_w g_map_channel
-#define g_find_channel_w g_find_channel
-#define g_count_matches_w g_count_matches
-#define g_smooth_sound_w g_smooth_sound
-#define g_smooth_channel_w g_smooth_channel
-#define g_smooth_selection_w g_smooth_selection
-#define g_delete_selection_and_smooth_w g_delete_selection_and_smooth
-#define g_delete_samples_and_smooth_w g_delete_samples_and_smooth
-#define g_reverse_sound_w g_reverse_sound
-#define g_reverse_channel_w g_reverse_channel
-#define g_reverse_selection_w g_reverse_selection
-#define g_swap_channels_w g_swap_channels
-#define g_insert_silence_w g_insert_silence
-#define g_scale_selection_to_w g_scale_selection_to
-#define g_scale_selection_by_w g_scale_selection_by
-#define g_scale_to_w g_scale_to
-#define g_scale_by_w g_scale_by
-#define g_env_selection_w g_env_selection
-#define g_env_sound_w g_env_sound
-#define g_env_channel_w g_env_channel
-#define g_env_channel_with_base_w g_env_channel_with_base
-#define g_ramp_channel_w g_ramp_channel
-#define g_xramp_channel_w g_xramp_channel
-#define g_fft_w g_fft
-#define g_snd_spectrum_w g_snd_spectrum
-#define g_convolve_with_w g_convolve_with
-#define g_convolve_selection_with_w g_convolve_selection_with
-#define g_src_sound_w g_src_sound
-#define g_src_selection_w g_src_selection
-#define g_src_channel_w g_src_channel
-#define g_pad_channel_w g_pad_channel
-#define g_filter_channel_w g_filter_channel
-#define g_filter_sound_w g_filter_sound
-#define g_filter_selection_w g_filter_selection
-#define g_clm_channel_w g_clm_channel
-#define g_sinc_width_w g_sinc_width
-#define g_set_sinc_width_w g_set_sinc_width
-#define g_ptree_channel_w g_ptree_channel
-#if HAVE_NESTED_FUNCTIONS
-#define g_find_min_peak_phases_w g_find_min_peak_phases
-#if 0
-#define g_fpsa_w g_fpsa
-#define g_fpsaf_w g_fpsaf
+ choice = s7_integer(s7_car(args));
+ n = s7_integer(s7_cadr(args));
+ phases = s7_caddr(args);
+ elements = s7_vector_elements(phases);
+
+ if (choice == 0)
+ n1 = n;
+ else
+ {
+ if (choice == 3)
+ n1 = primes[n];
+ else n1 = 2 * n;
+ }
+
+ fft_size = (int)pow(2.0, (int)ceil(log(fft_mult * n1) / log(2.0)));
+ rl = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
+ im = (mus_float_t *)calloc(fft_size, sizeof(mus_float_t));
+
+ for (m = 0; m < n; m++)
+ {
+ double phi;
+ int bin;
+ phi = pi2 + M_PI * (s7_real(elements[m]));
+ if (choice == 0)
+ bin = m + 1;
+ else
+ {
+ if (choice == 1)
+ bin = 1 + (m * 2);
+ else
+ {
+ if (choice == 2)
+ {
+ bin = m * 2;
+ if (bin == 0) bin = 1;
+ }
+ else bin = primes[m];
+ }
+ }
+ rl[bin] = cos(phi);
+ im[bin] = sin(phi);
+ }
+
+ mus_fft(rl, im, fft_size, -1);
+
+ mx = fabs(rl[0]);
+ for (i = 1; i < fft_size; i++)
+ {
+ double tmp;
+ tmp = fabs(rl[i]);
+ if (tmp > mx)
+ mx = tmp;
+ }
+
+ free(rl);
+ free(im);
+
+ return(s7_make_real(sc, mx));
+}
#endif
-#define g_fpsap_w g_fpsap
+
+
+
+Xen_wrap_6_optional_args(g_scan_channel_w, g_scan_channel)
+Xen_wrap_7_optional_args(g_map_channel_w, g_map_channel)
+#if (!HAVE_SCHEME)
+Xen_wrap_7_optional_args(g_map_chan_w, g_map_chan)
+Xen_wrap_6_optional_args(g_scan_chan_w, g_scan_chan)
+Xen_wrap_5_optional_args(g_find_channel_w, g_find_channel)
#endif
+Xen_wrap_5_optional_args(g_count_matches_w, g_count_matches)
+Xen_wrap_4_optional_args(g_smooth_sound_w, g_smooth_sound)
+Xen_wrap_5_optional_args(g_smooth_channel_w, g_smooth_channel)
+Xen_wrap_no_args(g_smooth_selection_w, g_smooth_selection)
+Xen_wrap_no_args(g_delete_selection_and_smooth_w, g_delete_selection_and_smooth)
+Xen_wrap_5_optional_args(g_delete_samples_and_smooth_w, g_delete_samples_and_smooth)
+Xen_wrap_3_optional_args(g_reverse_sound_w, g_reverse_sound)
+Xen_wrap_5_optional_args(g_reverse_channel_w, g_reverse_channel)
+Xen_wrap_no_args(g_reverse_selection_w, g_reverse_selection)
+Xen_wrap_8_optional_args(g_swap_channels_w, g_swap_channels)
+Xen_wrap_4_optional_args(g_insert_silence_w, g_insert_silence)
+Xen_wrap_1_optional_arg(g_scale_selection_to_w, g_scale_selection_to)
+Xen_wrap_1_arg(g_scale_selection_by_w, g_scale_selection_by)
+Xen_wrap_3_optional_args(g_scale_to_w, g_scale_to)
+Xen_wrap_3_optional_args(g_scale_by_w, g_scale_by)
+Xen_wrap_2_optional_args(g_env_selection_w, g_env_selection)
+Xen_wrap_7_optional_args(g_env_sound_w, g_env_sound)
+Xen_wrap_6_optional_args(g_env_channel_w, g_env_channel)
+Xen_wrap_7_optional_args(g_env_channel_with_base_w, g_env_channel_with_base)
+Xen_wrap_7_optional_args(g_ramp_channel_w, g_ramp_channel)
+Xen_wrap_8_optional_args(g_xramp_channel_w, g_xramp_channel)
+Xen_wrap_3_optional_args(g_fft_w, g_fft)
+Xen_wrap_7_optional_args(g_snd_spectrum_w, g_snd_spectrum)
+Xen_wrap_5_optional_args(g_convolve_with_w, g_convolve_with)
+Xen_wrap_2_optional_args(g_convolve_selection_with_w, g_convolve_selection_with)
+Xen_wrap_5_optional_args(g_src_sound_w, g_src_sound)
+Xen_wrap_2_optional_args(g_src_selection_w, g_src_selection)
+Xen_wrap_6_optional_args(g_src_channel_w, g_src_channel)
+Xen_wrap_5_optional_args(g_pad_channel_w, g_pad_channel)
+Xen_wrap_9_optional_args(g_filter_channel_w, g_filter_channel)
+Xen_wrap_6_optional_args(g_filter_sound_w, g_filter_sound)
+Xen_wrap_3_optional_args(g_filter_selection_w, g_filter_selection)
+Xen_wrap_8_optional_args(g_clm_channel_w, g_clm_channel)
+Xen_wrap_no_args(g_sinc_width_w, g_sinc_width)
+Xen_wrap_1_arg(g_set_sinc_width_w, g_set_sinc_width)
+
+Xen_wrap_5_optional_args(g_fpsap_w, g_fpsap)
+
+#if HAVE_SCHEME
+static s7_pointer acc_sinc_width(s7_scheme *sc, s7_pointer args) {return(g_set_sinc_width(s7_cadr(args)));}
#endif
void g_init_sig(void)
{
- XEN_DEFINE_PROCEDURE(S_scan_channel, g_scan_channel_w, 1, 5, 0, H_scan_channel);
- XEN_DEFINE_PROCEDURE(S_scan_chan, g_scan_chan_w, 1, 5, 0, H_scan_chan);
- XEN_DEFINE_PROCEDURE(S_find_channel, g_find_channel_w, 1, 4, 0, H_find_channel);
- XEN_DEFINE_PROCEDURE(S_count_matches, g_count_matches_w, 1, 4, 0, H_count_matches);
- XEN_DEFINE_PROCEDURE(S_map_chan, g_map_chan_w, 1, 6, 0, H_map_chan);
- XEN_DEFINE_PROCEDURE(S_map_channel, g_map_channel_w, 1, 6, 0, H_map_channel);
- XEN_DEFINE_PROCEDURE(S_ptree_channel, g_ptree_channel_w, 1, 8, 0, H_ptree_channel);
-
- XEN_DEFINE_PROCEDURE(S_smooth_sound, g_smooth_sound_w, 0, 4, 0, H_smooth_sound);
- XEN_DEFINE_PROCEDURE(S_smooth_selection, g_smooth_selection_w, 0, 0, 0, H_smooth_selection);
- XEN_DEFINE_PROCEDURE(S_delete_selection_and_smooth, g_delete_selection_and_smooth_w, 0, 0, 0, H_delete_selection_and_smooth);
- XEN_DEFINE_PROCEDURE(S_delete_samples_and_smooth, g_delete_samples_and_smooth_w, 2, 3, 0, H_delete_samples_and_smooth);
- XEN_DEFINE_PROCEDURE(S_reverse_sound, g_reverse_sound_w, 0, 3, 0, H_reverse_sound);
- XEN_DEFINE_PROCEDURE(S_reverse_selection, g_reverse_selection_w, 0, 0, 0, H_reverse_selection);
- XEN_DEFINE_PROCEDURE(S_swap_channels, g_swap_channels_w, 0, 8, 0, H_swap_channels);
- XEN_DEFINE_PROCEDURE(S_insert_silence, g_insert_silence_w, 2, 2, 0, H_insert_silence);
-
- XEN_DEFINE_PROCEDURE(S_scale_selection_to, g_scale_selection_to_w, 0, 1, 0, H_scale_selection_to);
- XEN_DEFINE_PROCEDURE(S_scale_selection_by, g_scale_selection_by_w, 1, 0, 0, H_scale_selection_by);
- XEN_DEFINE_PROCEDURE(S_scale_to, g_scale_to_w, 0, 3, 0, H_scale_to);
- XEN_DEFINE_PROCEDURE(S_scale_by, g_scale_by_w, 1, 2, 0, H_scale_by);
- XEN_DEFINE_PROCEDURE(S_env_selection, g_env_selection_w, 1, 1, 0, H_env_selection);
- XEN_DEFINE_PROCEDURE(S_env_sound, g_env_sound_w, 1, 6, 0, H_env_sound);
- XEN_DEFINE_PROCEDURE(S_fft, g_fft_w, 2, 1, 0, H_fft);
- XEN_DEFINE_PROCEDURE(S_snd_spectrum, g_snd_spectrum_w, 1, 6, 0, H_snd_spectrum);
- XEN_DEFINE_PROCEDURE(S_convolve_with, g_convolve_with_w, 1, 4, 0, H_convolve_with);
- XEN_DEFINE_PROCEDURE(S_convolve_selection_with, g_convolve_selection_with_w, 1, 1, 0, H_convolve_selection_with);
- XEN_DEFINE_PROCEDURE(S_src_sound, g_src_sound_w, 1, 4, 0, H_src_sound);
- XEN_DEFINE_PROCEDURE(S_src_selection, g_src_selection_w, 1, 1, 0, H_src_selection);
- XEN_DEFINE_PROCEDURE(S_filter_channel, g_filter_channel_w, 1, 8, 0, H_filter_channel);
- XEN_DEFINE_PROCEDURE(S_filter_sound, g_filter_sound_w, 1, 5, 0, H_filter_sound);
- XEN_DEFINE_PROCEDURE(S_filter_selection, g_filter_selection_w, 1, 2, 0, H_filter_selection);
-
- XEN_DEFINE_PROCEDURE(S_reverse_channel, g_reverse_channel_w, 0, 5, 0, H_reverse_channel);
- XEN_DEFINE_PROCEDURE(S_clm_channel, g_clm_channel_w, 1, 7, 0, H_clm_channel);
- XEN_DEFINE_PROCEDURE(S_env_channel, g_env_channel_w, 1, 5, 0, H_env_channel);
- XEN_DEFINE_PROCEDURE(S_env_channel_with_base, g_env_channel_with_base_w, 1, 6, 0, H_env_channel_with_base);
- XEN_DEFINE_PROCEDURE(S_ramp_channel, g_ramp_channel_w, 2, 5, 0, H_ramp_channel);
- XEN_DEFINE_PROCEDURE(S_xramp_channel, g_xramp_channel_w, 2, 6, 0, H_xramp_channel);
- XEN_DEFINE_PROCEDURE(S_smooth_channel, g_smooth_channel_w, 0, 5, 0, H_smooth_channel);
- XEN_DEFINE_PROCEDURE(S_src_channel, g_src_channel_w, 1, 5, 0, H_src_channel);
- XEN_DEFINE_PROCEDURE(S_pad_channel, g_pad_channel_w, 2, 3, 0, H_pad_channel);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_sinc_width, g_sinc_width_w, H_sinc_width,
- S_setB S_sinc_width, g_set_sinc_width_w, 0, 0, 1, 0);
-#if HAVE_NESTED_FUNCTIONS
- XEN_DEFINE_PROCEDURE(S_find_min_peak_phases, g_find_min_peak_phases_w, 0, 0, 1, H_find_min_peak_phases);
-#if 0
- XEN_DEFINE_PROCEDURE(S_fpsa, g_fpsa_w, 2, 5, 0, H_fpsa);
- XEN_DEFINE_PROCEDURE(S_fpsaf, g_fpsaf_w, 3, 6, 0, H_fpsaf);
+ Xen_define_procedure(S_scan_channel, g_scan_channel_w, 1, 5, 0, H_scan_channel);
+#if (!HAVE_SCHEME)
+ Xen_define_procedure(S_scan_chan, g_scan_chan_w, 1, 5, 0, H_scan_chan);
+ Xen_define_procedure(S_find_channel, g_find_channel_w, 1, 4, 0, H_find_channel);
+ Xen_define_procedure(S_map_chan, g_map_chan_w, 1, 6, 0, H_map_chan);
#endif
- XEN_DEFINE_PROCEDURE(S_fpsap, g_fpsap_w, 3, 2, 0, H_fpsap);
+ Xen_define_procedure(S_count_matches, g_count_matches_w, 1, 4, 0, H_count_matches);
+ Xen_define_procedure(S_map_channel, g_map_channel_w, 1, 6, 0, H_map_channel);
+
+ Xen_define_safe_procedure(S_smooth_sound, g_smooth_sound_w, 0, 4, 0, H_smooth_sound);
+ Xen_define_safe_procedure(S_smooth_selection, g_smooth_selection_w, 0, 0, 0, H_smooth_selection);
+ Xen_define_safe_procedure(S_delete_selection_and_smooth, g_delete_selection_and_smooth_w, 0, 0, 0, H_delete_selection_and_smooth);
+ Xen_define_safe_procedure(S_delete_samples_and_smooth, g_delete_samples_and_smooth_w, 2, 3, 0, H_delete_samples_and_smooth);
+ Xen_define_safe_procedure(S_reverse_sound, g_reverse_sound_w, 0, 3, 0, H_reverse_sound);
+ Xen_define_safe_procedure(S_reverse_selection, g_reverse_selection_w, 0, 0, 0, H_reverse_selection);
+ Xen_define_safe_procedure(S_swap_channels, g_swap_channels_w, 0, 8, 0, H_swap_channels);
+ Xen_define_safe_procedure(S_insert_silence, g_insert_silence_w, 2, 2, 0, H_insert_silence);
+
+ Xen_define_safe_procedure(S_scale_selection_to, g_scale_selection_to_w, 0, 1, 0, H_scale_selection_to);
+ Xen_define_safe_procedure(S_scale_selection_by, g_scale_selection_by_w, 1, 0, 0, H_scale_selection_by);
+ Xen_define_safe_procedure(S_scale_to, g_scale_to_w, 0, 3, 0, H_scale_to);
+ Xen_define_safe_procedure(S_scale_by, g_scale_by_w, 1, 2, 0, H_scale_by);
+ Xen_define_safe_procedure(S_env_selection, g_env_selection_w, 1, 1, 0, H_env_selection);
+ Xen_define_safe_procedure(S_env_sound, g_env_sound_w, 1, 6, 0, H_env_sound);
+ Xen_define_safe_procedure(S_fft, g_fft_w, 2, 1, 0, H_fft);
+ Xen_define_safe_procedure(S_snd_spectrum, g_snd_spectrum_w, 1, 6, 0, H_snd_spectrum);
+ Xen_define_safe_procedure(S_convolve_with, g_convolve_with_w, 1, 4, 0, H_convolve_with);
+ Xen_define_safe_procedure(S_convolve_selection_with, g_convolve_selection_with_w, 1, 1, 0, H_convolve_selection_with);
+ Xen_define_safe_procedure(S_src_sound, g_src_sound_w, 1, 4, 0, H_src_sound);
+ Xen_define_safe_procedure(S_src_selection, g_src_selection_w, 1, 1, 0, H_src_selection);
+ Xen_define_safe_procedure(S_filter_channel, g_filter_channel_w, 1, 8, 0, H_filter_channel);
+ Xen_define_safe_procedure(S_filter_sound, g_filter_sound_w, 1, 5, 0, H_filter_sound);
+ Xen_define_safe_procedure(S_filter_selection, g_filter_selection_w, 1, 2, 0, H_filter_selection);
+
+ Xen_define_safe_procedure(S_reverse_channel, g_reverse_channel_w, 0, 5, 0, H_reverse_channel);
+ Xen_define_safe_procedure(S_clm_channel, g_clm_channel_w, 1, 7, 0, H_clm_channel);
+ Xen_define_safe_procedure(S_env_channel, g_env_channel_w, 1, 5, 0, H_env_channel);
+ Xen_define_safe_procedure(S_env_channel_with_base, g_env_channel_with_base_w, 1, 6, 0, H_env_channel_with_base);
+ Xen_define_safe_procedure(S_ramp_channel, g_ramp_channel_w, 2, 5, 0, H_ramp_channel);
+ Xen_define_safe_procedure(S_xramp_channel, g_xramp_channel_w, 2, 6, 0, H_xramp_channel);
+ Xen_define_safe_procedure(S_smooth_channel, g_smooth_channel_w, 0, 5, 0, H_smooth_channel);
+ Xen_define_safe_procedure(S_src_channel, g_src_channel_w, 1, 5, 0, H_src_channel);
+ Xen_define_safe_procedure(S_pad_channel, g_pad_channel_w, 2, 3, 0, H_pad_channel);
+
+ Xen_define_dilambda(S_sinc_width, g_sinc_width_w, H_sinc_width, S_set S_sinc_width, g_set_sinc_width_w, 0, 0, 1, 0);
+
+ Xen_define_procedure(S_fpsap, g_fpsap_w, 3, 2, 0, H_fpsap);
+#if HAVE_SCHEME
+ Xen_define_procedure("phases-get-peak", g_phases_get_peak, 3, 0, 0, "");
+
+ s7_symbol_set_access(s7, ss->sinc_width_symbol, s7_make_function(s7, "[acc-" S_sinc_width "]", acc_sinc_width, 2, 0, false, "accessor"));
+ s7_symbol_set_documentation(s7, ss->sinc_width_symbol, "*sinc-width*: sampling rate conversion sinc width (10).");
#endif
}
+#if 0
+/* these work in snd-test, but are not faster */
+
+(define* (scan-channel func (beg 0) dur snd chn edpos)
+ (let ((end (if dur (min (+ beg dur) (framples snd chn)) (framples snd chn)))
+ (rd (make-sampler beg snd chn 1 edpos)))
+ (do ((pos beg (+ pos 1)))
+ ((or (>= pos end)
+ (func (next-sample rd)))
+ (and (< pos end)
+ pos)))))
+
+(define* (count-matches func (beg 0) snd chn edpos)
+ (let ((end (framples snd chn edpos))
+ (matches 0)
+ (reader (make-sampler beg snd chn 1 edpos)))
+ (do ((i beg (+ i 1)))
+ ((>= i end) matches)
+ (if (func (next-sample reader))
+ (set! matches (+ matches 1))))))
+
+
+(define-macro* (scan-channel-1 func (beg 0) dur snd chn edpos)
+ (let ((end (if dur (min (+ beg dur) (framples snd chn)) (framples snd chn))))
+ `(let ((rd (make-sampler ,beg ,snd ,chn 1 ,edpos))
+ (f ,func))
+ (define (call)
+ (do ((pos ,beg (+ pos 1)))
+ ((or (>= pos ,end)
+ (f (next-sample rd)))
+ (and (< pos ,end)
+ pos))))
+ (call))))
+
+(define* (scan-channel-2 func (beg 0) dur snd chn edpos)
+ (define* (uncons lst (res ()))
+ (if (null? lst) res (uncons (cdr lst) (cons (list (caar lst) (cdar lst)) res))))
+ (let ((end (if dur (min (+ beg dur) (framples snd chn)) (framples snd chn)))
+ (source (procedure-source func))
+ (e (funclet func)))
+ (let ((arg (caadr source))
+ (body (cddr source))
+ (new-e (if (eq? e (rootlet)) () (uncons (let->list e))))
+ (rd (make-sampler beg snd chn 1 edpos)))
+ (define call (apply let new-e
+ `((lambda ()
+ (do ((pos ,beg (+ pos 1))
+ (,arg (next-sample ,rd) (next-sample ,rd)))
+ ((or (>= pos ,end)
+ (begin , at body))
+ (and (< pos ,end)
+ pos)))))))
+ (call))))
+
+
+*/
+#endif
+
+
+
diff --git a/snd-snd.c b/snd-snd.c
index d014052..fe387d8 100644
--- a/snd-snd.c
+++ b/snd-snd.c
@@ -2,7 +2,6 @@
#include "sndlib-strings.h"
#include "clm2xen.h"
-
static snd_info *get_sp_1(int index)
{
if ((index >= 0) &&
@@ -13,26 +12,41 @@ static snd_info *get_sp_1(int index)
return(NULL);
}
-snd_info *get_sp(XEN snd)
+snd_info *get_sp(Xen snd)
{
- if (XEN_SOUND_P(snd))
+ if (xen_is_sound(snd))
return(get_sp_1(xen_sound_to_int(snd)));
-
- if (XEN_INTEGER_P(snd))
- return(get_sp_1(XEN_TO_C_INT(snd)));
- /* use default sound, if any */
- return(any_selected_sound());
+#if (!HAVE_SCHEME)
+ if (Xen_is_integer(snd))
+ return(get_sp_1(Xen_integer_to_C_int(snd)));
+#else
+ if (Xen_is_integer(snd))
+ {
+ s7_int p;
+ p = s7_integer(snd);
+ if ((p < 0) ||
+ (p > ss->max_sounds))
+ return(NULL);
+ return(get_sp_1((int)p));
+ }
+#endif
+
+ if ((Xen_is_boolean(snd)) || (!Xen_is_bound(snd))) /* use default sound, if any */
+ return(any_selected_sound());
+
+ return(NULL);
}
-snd_info *snd_new_file(const char *newname, int header_type, int data_format, int srate, int chans, const char *new_comment, mus_long_t samples)
+snd_info *snd_new_file(const char *newname, int chans, int srate, mus_sample_t sample_type,
+ mus_header_t header_type, const char *new_comment, mus_long_t samples)
{
/* caller checks newname != null, and runs overwrite hook */
- if (mus_header_writable(header_type, data_format))
+ if (mus_header_writable(header_type, sample_type))
{
io_error_t err;
- err = snd_write_header(newname, header_type, srate, chans, samples * chans, data_format, new_comment, NULL);
+ err = snd_write_header(newname, header_type, srate, chans, samples * chans, sample_type, new_comment, NULL);
if (err != IO_NO_ERROR)
snd_error("%s %s: %s",
io_error_name(err),
@@ -45,7 +59,7 @@ snd_info *snd_new_file(const char *newname, int header_type, int data_format, in
/* send out the initial samples */
chan = snd_reopen_write(newname);
lseek(chan, mus_header_data_location(), SEEK_SET);
- size = chans * mus_samples_to_bytes(data_format, samples);
+ size = chans * mus_samples_to_bytes(sample_type, samples);
if (size > 0)
{
ssize_t bytes;
@@ -62,10 +76,10 @@ snd_info *snd_new_file(const char *newname, int header_type, int data_format, in
}
}
else
- snd_error("%s: can't write %s header with %s data format",
+ snd_error("%s: can't write %s header with %s sample type",
newname,
mus_header_type_name(header_type),
- mus_data_format_name(data_format));
+ mus_sample_type_name(sample_type));
return(NULL);
}
@@ -79,7 +93,8 @@ typedef struct env_state {
snd_fd *sf;
unsigned char *direct_data;
- int format, chans, bytes, fd;
+ mus_sample_t format;
+ int chans, bytes, fd;
bool file_open;
} env_state;
@@ -150,6 +165,7 @@ void free_peak_env_state(chan_info *cp)
#define MIN_INIT 1000000.0
#define MAX_INIT -1000000.0
+#define MAX_ENV_SIZE (1 << 30)
static env_state *make_env_state(chan_info *cp, mus_long_t samples)
{
@@ -158,6 +174,7 @@ static env_state *make_env_state(chan_info *cp, mus_long_t samples)
env_state *es;
if (samples <= 0) return(NULL);
+ if (samples > MAX_ENV_SIZE) return(NULL);
stop_peak_env(cp);
pos = cp->edit_ctr;
orig_pos = cp->edits[pos]->edpos; /* don't assume we're editing the preceding state! */
@@ -188,7 +205,7 @@ static env_state *make_env_state(chan_info *cp, mus_long_t samples)
if ((old_ep) &&
(old_ep->completed))
{
- mus_long_t start, end, old_samples;
+ mus_long_t old_samples;
/* here in many cases, the underlying edit's amp env has most of the data we need.
* cp->edits[cp->edit_ctr] describes the current edit, with beg and end, so in the
@@ -201,14 +218,13 @@ static env_state *make_env_state(chan_info *cp, mus_long_t samples)
old_samples = cp->edits[orig_pos]->samples;
if (snd_abs_mus_long_t(samples - old_samples) < (samples / 2))
{
- int start_bin, end_bin, old_end_bin;
-
+ mus_long_t start, end;
start = edit_changes_begin_at(cp, cp->edit_ctr);
end = edit_changes_end_at(cp, cp->edit_ctr);
if (snd_abs_mus_long_t(end - start) < (samples / 2))
{
- int i, j;
+ int i, start_bin;
/* here we'll try to take advantage of an existing envelope */
old_ep = cp->edits[orig_pos]->peak_env;
@@ -229,6 +245,7 @@ static env_state *make_env_state(chan_info *cp, mus_long_t samples)
ep->bin = start_bin;
if (end != 0)
{
+ int j, end_bin, old_end_bin;
old_end_bin = (int)(end / old_ep->samps_per_bin);
end += (samples - old_samples);
end_bin = (int)(end / ep->samps_per_bin);
@@ -281,7 +298,7 @@ static env_state *make_env_state(chan_info *cp, mus_long_t samples)
void start_peak_env_state(chan_info *cp)
{
- cp->peak_env_state = make_env_state(cp, CURRENT_SAMPLES(cp));
+ cp->peak_env_state = make_env_state(cp, current_samples(cp));
}
@@ -295,7 +312,6 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
{
int n, sb, lm;
mus_long_t samps_to_read;
- snd_fd *sfd;
if (ep->top_bin != 0)
lm = (ep->top_bin - ep->bin + 1);
@@ -334,8 +350,7 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
(cp->sound->hdr) &&
(cp->sounds) &&
(cp->sounds[0] != NULL) &&
- (cp->sounds[0]->io) &&
- (mus_file_prescaler(io_filed(cp->sounds[0]->io)) == 1.0))
+ (cp->sounds[0]->io))
{
es->fd = mus_file_open_read(cp->sound->filename);
if (es->fd == -1)
@@ -346,7 +361,7 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
es->file_open = true;
lseek(es->fd, cp->sound->hdr->data_location, SEEK_SET);
- es->format = cp->sound->hdr->format;
+ es->format = cp->sound->hdr->sample_type;
es->chans = cp->sound->nchans;
es->bytes = ep->samps_per_bin * mus_bytes_per_sample(es->format) * es->chans;
es->direct_data = (unsigned char *)malloc(es->bytes * lm);
@@ -356,24 +371,35 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
if (es->direct_data == NULL)
{
+ snd_fd *sfd;
sfd = es->sf;
if (sfd == NULL) return(false);
for (n = 0; (n < lm) && (sb < ep->peak_env_size); n++, sb++)
{
mus_float_t ymin, ymax, val;
- int i;
+ int i, lim;
val = read_sample(sfd);
ymin = val;
ymax = val;
- for (i = 1; i < ep->samps_per_bin; i++)
+ i = 1;
+ lim = ep->samps_per_bin - 4;
+ while (i <= lim)
+ {
+ val = read_sample(sfd);
+ if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
+ val = read_sample(sfd);
+ if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
+ val = read_sample(sfd);
+ if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
+ val = read_sample(sfd);
+ if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
+ i += 4;
+ }
+ for (; i < ep->samps_per_bin; i++)
{
val = read_sample(sfd);
- if (ymin > val)
- ymin = val;
- else
- if (ymax < val)
- ymax = val;
+ if (ymin > val) ymin = val; else if (ymax < val) ymax = val;
}
ep->data_max[sb] = ymax;
ep->data_min[sb] = ymin;
@@ -390,7 +416,7 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
if (bytes_read < lm * es->bytes)
{
int zero_byte;
- zero_byte = mus_data_format_zero(es->format);
+ zero_byte = mus_sample_type_zero(es->format);
if ((zero_byte == 0) ||
((es->format != MUS_UBSHORT) &&
(es->format != MUS_ULSHORT)))
@@ -400,7 +426,7 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
mus_long_t i, start, len;
unsigned short *buf;
- /* (with-sound (:data-format mus-ubshort) (fm-violin 0 2 440 .1)) */
+ /* (with-sound (:sample-type mus-ubshort) (fm-violin 0 2 440 .1)) */
buf = (unsigned short *)(es->direct_data);
start = bytes_read / 2;
@@ -450,19 +476,6 @@ static bool tick_peak_env(chan_info *cp, env_state *es)
}
}
-
-static XEN peak_env_hook;
-
-static void run_peak_env_hook(chan_info *cp)
-{
- if (XEN_HOOKED(peak_env_hook))
- run_hook(peak_env_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(cp->sound->index),
- C_TO_XEN_INT(cp->chan)),
- S_peak_env_hook);
-}
-
-
void finish_peak_env(chan_info *cp)
{
if ((cp->peak_env_in_progress) &&
@@ -493,7 +506,7 @@ idle_func_t get_peak_env(any_pointer_t ptr)
}
if (!(cp->peak_env_state))
- cp->peak_env_state = make_env_state(cp, CURRENT_SAMPLES(cp));
+ cp->peak_env_state = make_env_state(cp, current_samples(cp));
es = cp->peak_env_state;
if (es)
@@ -509,7 +522,6 @@ idle_func_t get_peak_env(any_pointer_t ptr)
update_graph(cp);
cp->new_peaks = false;
}
- run_peak_env_hook(cp);
return(BACKGROUND_QUIT);
}
else return(BACKGROUND_CONTINUE);
@@ -572,13 +584,12 @@ bool peak_env_usable(chan_info *cp, mus_float_t samples_per_pixel, mus_long_t hi
cp->waiting_to_make_graph = false;
update_graph(cp);
}
- run_peak_env_hook(cp);
return(peak_env_usable(cp, samples_per_pixel, hisamp, start_new, edit_pos, false));
}
if ((start_new) &&
(!(cp->peak_env_in_progress)) &&
- (CURRENT_SAMPLES(cp) > PEAK_ENV_CUTOFF) &&
+ (current_samples(cp) > PEAK_ENV_CUTOFF) &&
(cp->sound->short_filename != NULL)) /* region browser jumped in too soon during autotest */
start_peak_env(cp);
return(false);
@@ -593,7 +604,7 @@ static short local_grf_y(mus_float_t val, axis_info *ap)
}
-int peak_env_graph(chan_info *cp, axis_info *ap, mus_float_t samples_per_pixel, int srate)
+int peak_env_graph(chan_info *cp, mus_float_t samples_per_pixel, int srate)
{
mus_float_t step, x, pinc = 0.0;
double xf, xk;
@@ -602,7 +613,9 @@ int peak_env_graph(chan_info *cp, axis_info *ap, mus_float_t samples_per_pixel,
int j = 0;
mus_long_t i;
peak_env_info *ep;
+ axis_info *ap;
+ ap = cp->axis;
ep = cp->edits[cp->edit_ctr]->peak_env;
step = samples_per_pixel / (mus_float_t)(ep->samps_per_bin);
xf = (double)(ap->losamp) / (double)(ep->samps_per_bin);
@@ -647,7 +660,7 @@ int peak_env_graph(chan_info *cp, axis_info *ap, mus_float_t samples_per_pixel,
}
-int peak_env_partial_graph(chan_info *cp, axis_info *ap, mus_long_t beg, mus_long_t end, mus_float_t samples_per_pixel, int srate)
+int peak_env_partial_graph(chan_info *cp, mus_long_t beg, mus_long_t end, mus_float_t samples_per_pixel, int srate)
{
mus_float_t step, x;
double xf, xk;
@@ -656,7 +669,9 @@ int peak_env_partial_graph(chan_info *cp, axis_info *ap, mus_long_t beg, mus_lon
int j = 0;
mus_long_t i;
peak_env_info *ep;
+ axis_info *ap;
+ ap = cp->axis;
ep = cp->edits[cp->edit_ctr]->peak_env;
step = samples_per_pixel / (mus_float_t)(ep->samps_per_bin);
xf = (double)(beg) / (double)(ep->samps_per_bin);
@@ -889,8 +904,6 @@ peak_env_info *copy_peak_env_info(peak_env_info *old_ep, bool reversed)
if ((old_ep) &&
(old_ep->completed))
{
- int i, j;
-
new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
@@ -901,6 +914,7 @@ peak_env_info *copy_peak_env_info(peak_env_info *old_ep, bool reversed)
if (reversed)
{
+ int i, j;
for (i = 0, j = new_ep->peak_env_size - 1; i < new_ep->peak_env_size; i++, j--)
{
new_ep->data_min[j] = old_ep->data_min[i];
@@ -935,7 +949,7 @@ void amp_env_env(chan_info *cp, mus_float_t *brkpts, int npts, int pos, mus_floa
{
int i;
mus_any *e;
- mus_float_t val, fmin, fmax;
+ mus_float_t fmin, fmax;
peak_env_info *new_ep;
new_ep = cp->edits[cp->edit_ctr]->peak_env;
@@ -960,6 +974,7 @@ void amp_env_env(chan_info *cp, mus_float_t *brkpts, int npts, int pos, mus_floa
for (i = 0; i < new_ep->peak_env_size; i++)
{
+ mus_float_t val;
val = mus_env(e);
if (val >= 0.0)
{
@@ -1060,172 +1075,6 @@ void amp_env_env_selection_by(chan_info *cp, mus_any *e, mus_long_t beg, mus_lon
}
-void peak_env_ptree(chan_info *cp, struct ptree *pt, int pos, XEN init_func)
-{
- peak_env_info *old_ep;
- old_ep = cp->edits[pos]->peak_env;
- if ((old_ep) && (old_ep->completed))
- {
- int i;
- vct *vlo = NULL, *vhi = NULL;
- mus_float_t fmin, fmax, dmin, dmax;
- peak_env_info *new_ep;
-
- new_ep = cp->edits[cp->edit_ctr]->peak_env;
- if ((new_ep) &&
- (new_ep->peak_env_size != old_ep->peak_env_size))
- new_ep = free_peak_env(cp, cp->edit_ctr);
-
- if (new_ep == NULL)
- {
- new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
- new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
- new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
- }
-
- new_ep->peak_env_size = old_ep->peak_env_size;
- new_ep->samps_per_bin = old_ep->samps_per_bin;
- fmin = MIN_INIT;
- fmax = MAX_INIT;
-
- if (XEN_PROCEDURE_P(init_func))
- {
- /* probably faster to copy locally than protect from GC */
- vlo = mus_vct_copy(XEN_TO_VCT(XEN_CALL_2(init_func,
- C_TO_XEN_INT64_T(0),
- C_TO_XEN_INT64_T(new_ep->peak_env_size),
- S_ptree_channel " init func")));
- vhi = mus_vct_copy(vlo);
- }
-
- for (i = 0; i < new_ep->peak_env_size; i++)
- {
- if (vlo)
- {
- dmin = mus_run_evaluate_ptree_1f1v1b2f(pt, old_ep->data_min[i], vlo, true);
- dmax = mus_run_evaluate_ptree_1f1v1b2f(pt, old_ep->data_max[i], vhi, true);
- }
- else
- {
- dmin = mus_run_evaluate_ptree_1f2f(pt, old_ep->data_min[i]);
- dmax = mus_run_evaluate_ptree_1f2f(pt, old_ep->data_max[i]);
- }
- if (dmin <= dmax)
- {
- new_ep->data_min[i] = dmin;
- new_ep->data_max[i] = dmax;
- }
- else
- {
- new_ep->data_min[i] = dmax;
- new_ep->data_max[i] = dmin;
- }
- if (new_ep->data_min[i] < fmin) fmin = new_ep->data_min[i];
- if (new_ep->data_max[i] > fmax) fmax = new_ep->data_max[i];
- }
-
- if (vlo) mus_vct_free(vlo);
- if (vhi) mus_vct_free(vhi);
- new_ep->fmin = fmin;
- new_ep->fmax = fmax;
- new_ep->completed = true;
- new_ep->bin = old_ep->bin;
- new_ep->top_bin = old_ep->top_bin;
- cp->edits[cp->edit_ctr]->peak_env = new_ep;
- }
-}
-
-
-void peak_env_ptree_selection(chan_info *cp, struct ptree *pt, mus_long_t beg, mus_long_t num, int pos, XEN init_func)
-{
- peak_env_info *old_ep;
- old_ep = cp->edits[pos]->peak_env;
- if ((old_ep) && (old_ep->completed))
- {
- peak_env_info *new_ep;
- mus_float_t fmax = MAX_INIT, fmin = MIN_INIT, dmin, dmax;
- int i;
- bool closure = false, inited = false;
- vct *vlo = NULL, *vhi = NULL;
- mus_long_t cursamp, start, end;
-
- new_ep = cp->edits[cp->edit_ctr]->peak_env;
- if ((new_ep) &&
- (new_ep->peak_env_size != old_ep->peak_env_size))
- new_ep = free_peak_env(cp, cp->edit_ctr);
-
- if (new_ep == NULL)
- {
- new_ep = (peak_env_info *)calloc(1, sizeof(peak_env_info));
- new_ep->data_max = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
- new_ep->data_min = (mus_float_t *)malloc(old_ep->peak_env_size * sizeof(mus_float_t));
- }
-
- new_ep->peak_env_size = old_ep->peak_env_size;
- new_ep->samps_per_bin = old_ep->samps_per_bin;
- end = beg + num - 1;
- start = beg - new_ep->samps_per_bin;
- if (XEN_PROCEDURE_P(init_func)) closure = true;
-
- for (i = 0, cursamp = 0; i < new_ep->peak_env_size; i++, cursamp += new_ep->samps_per_bin)
- {
- if ((cursamp >= end) || (cursamp <= start))
- {
- new_ep->data_min[i] = old_ep->data_min[i];
- new_ep->data_max[i] = old_ep->data_max[i];
- }
- else
- {
- if ((cursamp >= beg) && ((cursamp + new_ep->samps_per_bin) <= end))
- {
- if (closure)
- {
- if (!inited)
- {
- vlo = mus_vct_copy(XEN_TO_VCT(XEN_CALL_2(init_func,
- C_TO_XEN_INT64_T((mus_long_t)((mus_float_t)(cursamp - beg) / (mus_float_t)(num))),
- C_TO_XEN_INT64_T((mus_long_t)(num / new_ep->samps_per_bin)),
- S_ptree_channel " init func")));
- vhi = mus_vct_copy(vlo);
- inited = true;
- }
- dmin = mus_run_evaluate_ptree_1f1v1b2f(pt, old_ep->data_min[i], vlo, true);
- dmax = mus_run_evaluate_ptree_1f1v1b2f(pt, old_ep->data_max[i], vhi, true);
- }
- else
- {
- dmin = mus_run_evaluate_ptree_1f2f(pt, old_ep->data_min[i]);
- dmax = mus_run_evaluate_ptree_1f2f(pt, old_ep->data_max[i]);
- }
- if (dmin <= dmax)
- {
- new_ep->data_min[i] = dmin;
- new_ep->data_max[i] = dmax;
- }
- else
- {
- new_ep->data_min[i] = dmax;
- new_ep->data_max[i] = dmin;
- }
- }
- else pick_one_bin(new_ep, i, cursamp, cp, cp->edit_ctr);
- }
- if (fmin > new_ep->data_min[i]) fmin = new_ep->data_min[i];
- if (fmax < new_ep->data_max[i]) fmax = new_ep->data_max[i];
- }
-
- if (vlo) mus_vct_free(vlo);
- if (vhi) mus_vct_free(vhi);
- new_ep->fmin = fmin;
- new_ep->fmax = fmax;
- new_ep->completed = true;
- new_ep->bin = old_ep->bin;
- new_ep->top_bin = old_ep->top_bin;
- cp->edits[cp->edit_ctr]->peak_env = new_ep;
- }
-}
-
-
void peak_env_insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int pos)
{
peak_env_info *old_ep;
@@ -1240,7 +1089,7 @@ void peak_env_insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int po
if (new_ep) new_ep = free_peak_env(cp, cp->edit_ctr);
old_samps = cp->edits[pos]->samples;
- cur_samps = CURRENT_SAMPLES(cp);
+ cur_samps = current_samples(cp);
val = (int)(log((double)(cur_samps)));
if (val > 20) val = 20;
val = snd_int_pow2(val);
@@ -1317,12 +1166,12 @@ void peak_env_insert_zeros(chan_info *cp, mus_long_t beg, mus_long_t num, int po
#if XEN_HAVE_RATIOS
void snd_rationalize(mus_float_t a, int *num, int *den)
{
- XEN ratio;
+ Xen ratio;
int gloc;
- ratio = XEN_RATIONALIZE(C_TO_XEN_DOUBLE(a), C_TO_XEN_DOUBLE(a * .04)); /* was .02 until 13-Dec-07 but that gives too many useless choices */
+ ratio = Xen_rationalize(C_double_to_Xen_real(a), C_double_to_Xen_real(a * .04)); /* was .02 until 13-Dec-07 but that gives too many useless choices */
gloc = snd_protect(ratio);
- (*num) = (int)XEN_NUMERATOR(ratio);
- (*den) = (int)XEN_DENOMINATOR(ratio);
+ (*num) = (int)Xen_numerator(ratio);
+ (*den) = (int)Xen_denominator(ratio);
snd_unprotect_at(gloc);
}
#endif
@@ -1352,7 +1201,7 @@ mus_float_t speed_changed(mus_float_t val, char *srcbuf, speed_style_t style, in
{
int num, den;
snd_rationalize(val, &num, &den);
- mus_snprintf(srcbuf, srcbuf_size, "%d/%d", num, den);
+ snprintf(srcbuf, srcbuf_size, "%d/%d", num, den);
return((mus_float_t)num / (mus_float_t)den);
}
#else
@@ -1361,12 +1210,12 @@ mus_float_t speed_changed(mus_float_t val, char *srcbuf, speed_style_t style, in
break;
if ((rat_values[i] - val) < (val - rat_values[i - 1]))
{
- mus_snprintf(srcbuf, srcbuf_size, "%s", rat_names[i]);
+ snprintf(srcbuf, srcbuf_size, "%s", rat_names[i]);
return(rat_values[i]);
}
else
{
- mus_snprintf(srcbuf, srcbuf_size, "%s", rat_names[i - 1]);
+ snprintf(srcbuf, srcbuf_size, "%s", rat_names[i - 1]);
return(rat_values[i - 1]);
}
#endif
@@ -1377,7 +1226,7 @@ mus_float_t speed_changed(mus_float_t val, char *srcbuf, speed_style_t style, in
semi = snd_round(log(val) * ((mus_float_t)tones / log(2.0)));
/* space until (-) num (-52 to 52 is its range if 12-tone) */
for (i = 0; i < srcbuf_size; i++) srcbuf[i] = ' ';
- mus_snprintf(numbuf, 16, "%d", semi);
+ snprintf(numbuf, 16, "%d", semi);
j = strlen(numbuf) - 1;
for (i = 3; (i >= 0) && (j >= 0); i--, j--)
srcbuf[i] = numbuf[j];
@@ -1386,7 +1235,7 @@ mus_float_t speed_changed(mus_float_t val, char *srcbuf, speed_style_t style, in
break;
default:
- mus_snprintf(srcbuf, srcbuf_size, "%.3f", val);
+ snprintf(srcbuf, srcbuf_size, "%.3f", val);
return(val);
break;
}
@@ -1399,9 +1248,9 @@ static char sname[PRINT_BUFFER_SIZE];
char *shortname(snd_info *sp)
{
- if (link_p(sp->filename))
+ if (is_link_file(sp->filename))
{
- mus_snprintf(sname, PRINT_BUFFER_SIZE, "(%s)", sp->short_filename);
+ snprintf(sname, PRINT_BUFFER_SIZE, "(%s)", sp->short_filename);
return(sname);
}
return(sp->short_filename);
@@ -1412,9 +1261,9 @@ char *shortname_indexed(snd_info *sp)
{
if (show_indices(ss))
{
- if (link_p(sp->filename))
- mus_snprintf(sname, PRINT_BUFFER_SIZE, "%d: (%s)", sp->index, sp->short_filename); /* don't try to share sname */
- else mus_snprintf(sname, PRINT_BUFFER_SIZE, "%d: %s", sp->index, sp->short_filename);
+ if (is_link_file(sp->filename))
+ snprintf(sname, PRINT_BUFFER_SIZE, "%d: (%s)", sp->index, sp->short_filename); /* don't try to share sname */
+ else snprintf(sname, PRINT_BUFFER_SIZE, "%d: %s", sp->index, sp->short_filename);
return(sname);
}
return(shortname(sp));
@@ -1429,7 +1278,7 @@ void add_sound_data(char *filename, snd_info *sp, channel_graph_t graphed)
}
-#if HAVE_READLINK
+#ifndef _MSC_VER
static char *linked_file(const char *link_name)
{
char *link_file;
@@ -1443,47 +1292,51 @@ static char *linked_file(const char *link_name)
#endif
-static XEN name_click_hook;
+static Xen name_click_hook;
-void sp_name_click(snd_info *sp)
+char *sp_name_click(snd_info *sp) /* caller should free returned string */
{
if (sp)
{
file_info *hdr;
- /* call name-click-hook (if any) return #t = don't print info in minibuffer */
- if ((XEN_HOOKED(name_click_hook)) &&
- (XEN_TRUE_P(run_or_hook(name_click_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)),
+
+ /* call name-click-hook (if any) return #t = don't print info in the status area */
+ if ((Xen_hook_has_list(name_click_hook)) &&
+ (Xen_is_true(run_or_hook(name_click_hook,
+ Xen_list_1(C_int_to_Xen_sound(sp->index)),
S_name_click_hook))))
- return;
+ return(NULL);
+
hdr = sp->hdr;
if (hdr)
{
mus_float_t dur;
- char *str = NULL;
+ char *result, *str = NULL;
- bool linked = false;
- linked = link_p(sp->filename);
+ bool linked;
+ linked = is_link_file(sp->filename);
dur = (mus_float_t)((double)(hdr->samples) / (double)(hdr->chans * hdr->srate));
- report_in_minibuffer(sp, "%d, %d chan%s, %.3f sec%s, %s: %s, %s%s%s%s",
+ result = mus_format("%d, %d chan%s, %.3f sec%s, %s: %s, %s%s%s%s",
hdr->srate,
hdr->chans,
((hdr->chans > 1) ? "s" : ""),
dur,
((dur == 1.0) ? "" : "s"),
mus_header_type_to_string(hdr->type),
- mus_data_format_to_string(hdr->format),
- snd_strftime(STRFTIME_FORMAT, sp->write_date),
+ mus_sample_type_to_string(hdr->sample_type),
+ snd_strftime("%d-%b-%Y %H:%M", sp->write_date),
(linked) ? ", (link to " : "",
-#if HAVE_READLINK
+#ifndef _MSC_VER
(linked) ? str = linked_file(sp->filename) : "",
#else
(linked) ? "?" : "",
#endif
(linked) ? ")" : "");
if (str) free(str);
+ return(result);
}
}
+ return(NULL);
}
@@ -1525,10 +1378,10 @@ static ctrl_state *current_control_settings(snd_info *sp, ctrl_state *cs)
cs->revscl = sp->reverb_control_scale;
cs->revlen = sp->reverb_control_length;
cs->contrast = sp->contrast_control;
- cs->expand_on = sp->expand_control_p;
- cs->reverb_on = sp->reverb_control_p;
- cs->contrast_on = sp->contrast_control_p;
- cs->filter_on = sp->filter_control_p;
+ cs->expand_on = sp->expand_control_on;
+ cs->reverb_on = sp->reverb_control_on;
+ cs->contrast_on = sp->contrast_control_on;
+ cs->filter_on = sp->filter_control_on;
cs->filter_order = sp->filter_control_order;
if (sp->filter_control_envelope)
{
@@ -1568,10 +1421,10 @@ static ctrl_state *restore_control_settings(snd_info *sp, ctrl_state *cs)
sp->reverb_control_scale = cs->revscl;
sp->reverb_control_length = cs->revlen;
sp->contrast_control = cs->contrast;
- sp->expand_control_p = cs->expand_on;
- sp->reverb_control_p = cs->reverb_on;
- sp->contrast_control_p = cs->contrast_on;
- sp->filter_control_p = cs->filter_on;
+ sp->expand_control_on = cs->expand_on;
+ sp->reverb_control_on = cs->reverb_on;
+ sp->contrast_control_on = cs->contrast_on;
+ sp->filter_control_on = cs->filter_on;
sp->filter_control_order = cs->filter_order;
if (cs->filter_env)
{
@@ -1607,13 +1460,13 @@ void restore_controls(snd_info *sp)
cs->speed = DEFAULT_SPEED_CONTROL;
cs->reversed = false; /* (this is the button's view) */
cs->expand = DEFAULT_EXPAND_CONTROL;
- cs->expand_on = DEFAULT_EXPAND_CONTROL_P;
+ cs->expand_on = DEFAULT_EXPAND_CONTROL_ON;
cs->revscl = DEFAULT_REVERB_CONTROL_SCALE;
cs->revlen = DEFAULT_REVERB_CONTROL_LENGTH;
- cs->reverb_on = DEFAULT_REVERB_CONTROL_P;
+ cs->reverb_on = DEFAULT_REVERB_CONTROL_ON;
cs->contrast = DEFAULT_CONTRAST_CONTROL;
- cs->contrast_on = DEFAULT_CONTRAST_CONTROL_P;
- cs->filter_on = DEFAULT_FILTER_CONTROL_P;
+ cs->contrast_on = DEFAULT_CONTRAST_CONTROL_ON;
+ cs->filter_on = DEFAULT_FILTER_CONTROL_ON;
cs->filter_order = filter_control_order(ss);
cs->filter_env = NULL;
}
@@ -1642,10 +1495,10 @@ void restore_controls(snd_info *sp)
void reset_controls(snd_info *sp)
{
char *tmpstr;
- toggle_expand_button(sp, DEFAULT_EXPAND_CONTROL_P);
- toggle_contrast_button(sp, DEFAULT_CONTRAST_CONTROL_P);
- toggle_reverb_button(sp, DEFAULT_REVERB_CONTROL_P);
- toggle_filter_button(sp, DEFAULT_FILTER_CONTROL_P);
+ toggle_expand_button(sp, DEFAULT_EXPAND_CONTROL_ON);
+ toggle_contrast_button(sp, DEFAULT_CONTRAST_CONTROL_ON);
+ toggle_reverb_button(sp, DEFAULT_REVERB_CONTROL_ON);
+ toggle_filter_button(sp, DEFAULT_FILTER_CONTROL_ON);
toggle_direction_arrow(sp, false);
set_amp(sp, DEFAULT_AMP_CONTROL);
set_speed(sp, DEFAULT_SPEED_CONTROL);
@@ -1667,10 +1520,10 @@ void reset_controls(snd_info *sp)
static void apply_unset_controls(snd_info *sp)
{
/* after apply_controls there's no need to clear everything! */
- toggle_expand_button(sp, DEFAULT_EXPAND_CONTROL_P);
- toggle_contrast_button(sp, DEFAULT_CONTRAST_CONTROL_P);
- toggle_reverb_button(sp, DEFAULT_REVERB_CONTROL_P);
- toggle_filter_button(sp, DEFAULT_FILTER_CONTROL_P);
+ toggle_expand_button(sp, DEFAULT_EXPAND_CONTROL_ON);
+ toggle_contrast_button(sp, DEFAULT_CONTRAST_CONTROL_ON);
+ toggle_reverb_button(sp, DEFAULT_REVERB_CONTROL_ON);
+ toggle_filter_button(sp, DEFAULT_FILTER_CONTROL_ON);
toggle_direction_arrow(sp, false);
set_amp(sp, DEFAULT_AMP_CONTROL);
set_speed(sp, DEFAULT_SPEED_CONTROL);
@@ -1689,158 +1542,6 @@ void set_show_controls(bool val)
-/* ---------------- minibuffer/filter text history ---------------- */
-
-typedef struct mini_history {
- char **strings;
- int strings_size, strings_pos;
- bool first_time;
-} mini_history;
-
-static mini_history *listener_history = NULL;
-typedef enum {MINIBUFFER, FILTER_TEXT, LISTENER_TEXT} mini_history_t;
-
-
-static void remember_string(snd_info *sp, const char *str, mini_history_t which)
-{
- /* if we're called from the listener, sp is null */
-
- mini_history *mh = NULL;
- int i, top;
-
- if (!str) return;
-
- switch (which)
- {
- case MINIBUFFER: mh = sp->minibuffer_history; break;
- case FILTER_TEXT: mh = sp->filter_history; break;
- case LISTENER_TEXT: mh = listener_history; break;
- default: return; break;
- }
-
- if (mh == NULL)
- {
- mh = (mini_history *)calloc(1, sizeof(mini_history));
- mh->strings_size = minibuffer_history_length(ss);
- mh->strings = (char **)calloc(mh->strings_size, sizeof(char *));
- switch (which)
- {
- case MINIBUFFER: sp->minibuffer_history = mh; break;
- case FILTER_TEXT: sp->filter_history = mh; break;
- case LISTENER_TEXT: listener_history = mh; break;
- }
- }
-
- mh->strings_pos = 0;
- mh->first_time = true;
-
- /* if str matches current history top entry, ignore it (as in tcsh) */
- if ((mh->strings[0]) &&
- (strcmp(str, mh->strings[0]) == 0))
- return;
-
- top = mh->strings_size - 1;
- if (mh->strings[top]) free(mh->strings[top]);
- for (i = top; i > 0; i--) mh->strings[i] = mh->strings[i - 1];
-
- mh->strings[0] = mus_strdup(str);
-}
-
-
-void remember_mini_string(snd_info *sp, const char *str)
-{
- remember_string(sp, str, MINIBUFFER);
-}
-
-void remember_filter_string(snd_info *sp, const char *str)
-{
- remember_string(sp, str, FILTER_TEXT);
-}
-
-void remember_listener_string(const char *str)
-{
- remember_string(NULL, str, LISTENER_TEXT);
-}
-
-
-static void restore_string(snd_info *sp, bool back, mini_history_t which)
-{
- /* sp can be NULL */
- mini_history *mh = NULL;
-
- switch (which)
- {
- case MINIBUFFER: mh = sp->minibuffer_history; break;
- case FILTER_TEXT: mh = sp->filter_history; break;
- case LISTENER_TEXT: mh = listener_history; break;
- }
-
- if (mh)
- {
- char *str;
- if (!(mh->first_time))
- {
- if (back)
- mh->strings_pos++;
- else mh->strings_pos--;
- }
- mh->first_time = false;
- if (mh->strings_pos < 0) mh->strings_pos = 0;
- if (mh->strings_pos > (mh->strings_size - 1)) mh->strings_pos = mh->strings_size - 1;
- str = mh->strings[mh->strings_pos];
- if (str)
- {
- switch (which)
- {
- case MINIBUFFER: set_minibuffer_string(sp, str, true); break;
- case FILTER_TEXT: set_filter_text(sp, str); break;
- case LISTENER_TEXT: append_listener_text(-1, str); break;
- }
- }
- }
-}
-
-
-void restore_mini_string(snd_info *sp, bool back) {restore_string(sp, back, MINIBUFFER);}
-void restore_filter_string(snd_info *sp, bool back) {restore_string(sp, back, FILTER_TEXT);}
-void restore_listener_string(bool back) {restore_string(NULL, back, LISTENER_TEXT);}
-
-
-static void clear_strings(snd_info *sp, mini_history_t which)
-{
- /* sp can be NULL */
- mini_history *mh = NULL;
-
- switch (which)
- {
- case MINIBUFFER: mh = sp->minibuffer_history; break;
- case FILTER_TEXT: mh = sp->filter_history; break;
- case LISTENER_TEXT: mh = listener_history; break;
- }
-
- if (mh)
- {
- int i;
- switch (which)
- {
- case MINIBUFFER: sp->minibuffer_history = NULL; break;
- case FILTER_TEXT: sp->filter_history = NULL; break;
- case LISTENER_TEXT: listener_history = NULL; break;
- }
- for (i = 0; i < mh->strings_size; i++)
- if (mh->strings[i])
- free(mh->strings[i]);
- free(mh->strings);
- free(mh);
- }
-}
-
-
-void clear_mini_strings(snd_info *sp) {clear_strings(sp, MINIBUFFER);}
-void clear_filter_strings(snd_info *sp) {clear_strings(sp, FILTER_TEXT);}
-
-
-
/* ---------------- control panel apply ---------------- */
void stop_applying(snd_info *sp)
@@ -1861,7 +1562,7 @@ typedef struct {
} apply_state;
-static XEN after_apply_controls_hook;
+static Xen after_apply_controls_hook;
static void *make_apply_state(snd_info *sp)
{
@@ -1896,25 +1597,25 @@ static bool apply_controls(apply_state *ap)
chan_info *cp = NULL;
sync_info *si;
mus_float_t mult_dur;
- int i, curchan = 0, added_dur = 0;
+ int i, added_dur = 0;
if (ap == NULL) return(false);
sp = ap->sp;
if ((!(sp->active)) || (sp->inuse != SOUND_NORMAL)) return(false);
- if (sp->filter_control_p)
+ if (sp->filter_control_on)
added_dur = sp->filter_control_order;
mult_dur = 1.0 / fabs(sp->speed_control);
- if (sp->expand_control_p)
+ if (sp->expand_control_on)
mult_dur *= sp->expand_control;
- if (sp->reverb_control_p)
- added_dur += (int)((SND_SRATE(sp) * sp->reverb_control_decay));
+ if (sp->reverb_control_on)
+ added_dur += (int)((snd_srate(sp) * sp->reverb_control_decay));
if ((ss->apply_choice != APPLY_TO_SELECTION) &&
(snd_feq(sp->speed_control, 1.0)) &&
(apply_beg == 0) &&
(sp->speed_control_direction == 1) &&
- (!(sp->filter_control_p)) && (!(sp->expand_control_p)) && (!(sp->reverb_control_p)) && (!(sp->contrast_control_p)))
+ (!(sp->filter_control_on)) && (!(sp->expand_control_on)) && (!(sp->reverb_control_on)) && (!(sp->contrast_control_on)))
{
int old_sync;
bool need_scaling = false;
@@ -1963,6 +1664,7 @@ static bool apply_controls(apply_state *ap)
{
mus_long_t orig_apply_dur;
io_error_t io_err = IO_NO_ERROR;
+ int curchan = 0;
orig_apply_dur = apply_dur;
@@ -1972,7 +1674,7 @@ static bool apply_controls(apply_state *ap)
/* apply_beg = 0; */
ap->ofile = NULL;
ap->ofile = snd_tempnam();
- ap->hdr = make_temp_header(ap->ofile, SND_SRATE(sp), sp->nchans, 0, (char *)c__FUNCTION__);
+ ap->hdr = make_temp_header(ap->ofile, snd_srate(sp), sp->nchans, 0, (char *)__func__);
switch (ss->apply_choice)
{
@@ -1981,13 +1683,13 @@ static bool apply_controls(apply_state *ap)
if (sp->selected_channel != NO_SELECTION)
curchan = sp->selected_channel;
if (apply_dur == 0)
- apply_dur = CURRENT_SAMPLES(sp->chans[curchan]) - apply_beg;
+ apply_dur = current_samples(sp->chans[curchan]) - apply_beg;
break;
case APPLY_TO_SOUND:
ap->hdr->chans = sp->nchans;
if (apply_dur == 0)
- apply_dur = CURRENT_SAMPLES(sp->chans[0]) - apply_beg;
+ apply_dur = current_samples(sp->chans[0]) - apply_beg;
break;
case APPLY_TO_SELECTION:
@@ -2014,21 +1716,21 @@ static bool apply_controls(apply_state *ap)
speedstr = mus_format("%.4f",
sp->speed_control * sp->speed_control_direction);
else speedstr = mus_strdup(PROC_FALSE);
- if (sp->contrast_control_p)
+ if (sp->contrast_control_on)
contraststr = mus_format(LIST_OPEN "%.4f" PROC_SEP "%.4f" LIST_CLOSE,
sp->contrast_control, sp->contrast_control_amp);
else contraststr = mus_strdup(PROC_FALSE);
- if (sp->expand_control_p)
+ if (sp->expand_control_on)
expandstr = mus_format(LIST_OPEN "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" LIST_CLOSE,
sp->expand_control, sp->expand_control_length, sp->expand_control_ramp,
sp->expand_control_hop, sp->expand_control_jitter);
else expandstr = mus_strdup(PROC_FALSE);
- if (sp->reverb_control_p)
+ if (sp->reverb_control_on)
reverbstr = mus_format(LIST_OPEN "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" PROC_SEP "%.4f" LIST_CLOSE,
sp->reverb_control_scale, sp->reverb_control_length, sp->reverb_control_feedback,
sp->reverb_control_lowpass, sp->reverb_control_decay);
else reverbstr = mus_strdup(PROC_FALSE);
- if (sp->filter_control_p)
+ if (sp->filter_control_on)
{
char *envstr;
envstr = env_to_string(sp->filter_control_envelope);
@@ -2039,20 +1741,20 @@ static bool apply_controls(apply_state *ap)
else filterstr = mus_strdup(PROC_FALSE);
#if HAVE_FORTH
if (orig_apply_dur == 0)
- ap->origin = mus_format(" '( %s %s %s %s %s %s ) " MUS_LD PROC_SEP PROC_FALSE " %s",
+ ap->origin = mus_format(" '( %s %s %s %s %s %s ) %lld" PROC_SEP PROC_FALSE " %s",
ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
apply_beg, S_controls_to_channel);
- else ap->origin = mus_format(" '( %s %s %s %s %s %s ) " MUS_LD PROC_SEP MUS_LD " %s",
+ else ap->origin = mus_format(" '( %s %s %s %s %s %s ) %lld" PROC_SEP "%lld %s",
ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
apply_beg, apply_dur, S_controls_to_channel);
#else
if (orig_apply_dur == 0)
- ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP MUS_LD PROC_SEP PROC_FALSE,
- TO_PROC_NAME(S_controls_to_channel),
+ ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ to_proc_name(S_controls_to_channel),
ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
apply_beg);
- else ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP MUS_LD PROC_SEP MUS_LD,
- TO_PROC_NAME(S_controls_to_channel),
+ else ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP "%lld" PROC_SEP "%lld",
+ to_proc_name(S_controls_to_channel),
ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
apply_beg, apply_dur);
#endif
@@ -2092,7 +1794,7 @@ static bool apply_controls(apply_state *ap)
else
{
int len;
- len = run_apply(ap->ofd); /* returns frames written (an int) */
+ len = run_apply(ap->ofd); /* returns framples written (an int) */
if (len <= 0)
{
ap->slice++;
@@ -2100,7 +1802,7 @@ static bool apply_controls(apply_state *ap)
}
ap->i += len;
if (ap->i >= apply_dur) ap->slice++;
- check_for_event();
+ /* check_for_event(); */
/* if C-G, stop_applying called which cancels and backs out */
if ((ss->stopped_explicitly) || (!(sp->active)))
ap->slice++;
@@ -2113,7 +1815,7 @@ static bool apply_controls(apply_state *ap)
close_temp_file(ap->ofile,
ap->ofd,
ap->hdr->type,
- apply_dur * (ap->hdr->chans) * mus_bytes_per_sample((ap->hdr)->format));
+ apply_dur * (ap->hdr->chans) * mus_bytes_per_sample((ap->hdr)->sample_type));
if ((sp->apply_ok) && (apply_dur > 0))
{
switch (ss->apply_choice)
@@ -2187,10 +1889,10 @@ static bool apply_controls(apply_state *ap)
si = free_sync_info(si);
break;
}
- clear_minibuffer(sp);
+ clear_status_area(sp);
sp->apply_ok = false;
- if ((sp->expand_control_p) ||
+ if ((sp->expand_control_on) ||
(sp->speed_control_direction != 1) || (!(snd_feq(sp->speed_control, 1.0))))
{
for (i = 0; i < sp->nchans; i++)
@@ -2199,7 +1901,7 @@ static bool apply_controls(apply_state *ap)
if (cp->edits[cp->edit_ctr]->marks)
{
mus_float_t ratio;
- if (!(sp->expand_control_p))
+ if (!(sp->expand_control_on))
ratio = sp->speed_control;
else ratio = sp->speed_control / sp->expand_control;
if (ratio != 1.0)
@@ -2225,45 +1927,18 @@ static bool apply_controls(apply_state *ap)
apply_unset_controls(sp);
- if (XEN_HOOKED(after_apply_controls_hook))
+ if (Xen_hook_has_list(after_apply_controls_hook))
run_hook(after_apply_controls_hook,
- XEN_LIST_1(C_INT_TO_XEN_SOUND(sp->index)),
+ Xen_list_1(C_int_to_Xen_sound(sp->index)),
S_after_apply_controls_hook);
sp->applying = false;
- ap = free_apply_state(ap);
+ free_apply_state(ap);
ss->stopped_explicitly = false;
return(false);
}
-void menu_apply_controls(snd_info *sp)
-{
- apply_state *ap;
- apply_beg = 0;
- apply_dur = 0;
- if (sp->applying)
- string_to_minibuffer(sp, "already applying...");
- else
- {
- ap = (apply_state *)make_apply_state(sp);
- if (ap)
- {
- sp->applying = true;
- redirect_everything_to(printout_to_minibuffer, (void *)sp);
- while (apply_controls(ap)) ;
- redirect_everything_to(NULL, NULL);
- }
- }
-}
-
-
-void menu_reset_controls(snd_info *sp)
-{
- reset_controls(sp);
-}
-
-
void expand_control_set_hop(mus_float_t hop)
{
int i;
@@ -2384,121 +2059,106 @@ void reverb_control_set_feedback(mus_float_t hop)
-/* ---------------------------------------- sound objects ---------------------------------------- */
-
-/* this is my long term plan right now... */
-
-/* generics (besides length, srate, channels, frames, file-name, sync, maxamp, play, copy, fill!, [apply], [set!], [for-each], [map]):
- *
- * source: procedure-source[s7_procedure_source] mix-home mark-home region-home player-home sampler-home
- * mus cases: readin=file+chan? etc, port -> filename?, sound->filename?
- * seems redundant -- why not use file-name?
- *
- * position: mark-sample mix-position region-position sampler-position
- * [location?] port->line number?, mus cases = mus_location?, player? widget? cursor if sound?
- * (CL has position)
- *
- * properties: edit|mark|mix|sound|channel-properties procedure-property? [also property as accessor]
- * but then typos lead to seriously confusing behavior -- I think I'll leave out properties for now.
- *
- * name: mark|mix-name file-name (widget name via XtName) mus-name colormap
- * __func__? port-filename sampler-filename
- *
- * reverse is a special case -- it really only makes sense with lists where reversal happens all the time
- * and for all other types we'd want reverse! (in-place change), but extremely rarely.
- *
- * which leaves:
- * scale(-to|by) convolve fft env filter insert mix save smooth src map|scan pan-mix sampler?
- *
- * save with all the optkey args for all types (treat list/vector etc as sound data)
- * check map/for-each cases -- sound selection etc (and add to extsnd) and set/ref
- * for-each depends on ref, map could depend on copy/set/ref
- *
- * objects are generator(clm2xen), player(snd-dac), sampler(snd-edits), sound-data(sndlib2xen), transform (snd-fft),
- * mark(snd-marks), mix(snd-mix), selection(snd-select), region(snd-region), colormap(snd-gxcolormap),
- * vct(vct), hook(xen), XmObj(xm, xg), plus the base types(s7): string, hash-table, vector, pair, object
- *
- * also needed are further cases of ref/set
- * ref needed: mix? region selection sound
- * set needed: selection? sound
- *
- * possible new objects: menu-item, file-filter|sorter, fft-window?, variable-graph?
- *
- * (scan-channel -> channel-for-each)
- * and channel-map rather than map-channel
- * channel-for-each in the multiarg case would make it easier to compare chans
- * (find-if func snd...)
- * (eval-over-selection -> selection-for-each) *-for-each
- * then selection-map would replace the current selected samples
- *
- * do everything through generic sampler (vector etc)
- * in/out/readin generic as well, so we can use instruments for edits and vice-versa without change
- * selection sampler [no need for snd-sampler (snd-edits) I think]
- *
- * the goal being that all clm and snd structures are compatible, all operations interchangeable
- * so (violin 0 1 440 .1) can appear sensibly in any context
- *
- * then deprecate all the special case stuff, add generic versions of *.scm examples
- * sound-file properties? a data base saving all such info (rather than kludges involving headers)
- * (hash-table makes more sense as a property list than a list in large cases) -- currently it's actually a vector
- * or a global data base for all properties? -- easy to search or display in various ways
- *
- * TODO: make-sampler with mix etc -- let 1st arg be object, also add selection sampler
+/* ---------------- status area ----------------
*/
+void status_report(snd_info *sp, const char *format, ...)
+{
+#if (!USE_NO_GUI)
+ char *buf;
+ va_list ap;
+ if ((!sp) || (!(sp->active)) || (sp->inuse != SOUND_NORMAL)) return;
+ va_start(ap, format);
+ buf = vstr(format, ap);
+ va_end(ap);
+ set_status(sp, buf, false);
+ free(buf);
+#endif
+}
+
+
+void clear_status_area(snd_info *sp)
+{
+ set_status(sp, NULL, true);
+}
+
+
+void errors_to_status_area(const char *msg, void *data)
+{
+ snd_info *sp;
+ sp = (snd_info *)data;
+ if (!(snd_ok(sp)))
+ {
+ sp = any_selected_sound();
+ if (!snd_ok(sp)) return;
+ }
+ status_report((snd_info *)data, "%s", msg);
+}
+
+
+void printout_to_status_area(const char *msg, void *data)
+{
+ set_status((snd_info *)data, msg, false);
+}
+
+
+
+
+
+/* ---------------------------------------- sound objects ---------------------------------------- */
typedef struct {
int n;
} xen_sound;
-#define XEN_TO_XEN_SOUND(arg) ((xen_sound *)XEN_OBJECT_REF(arg))
+#define Xen_to_xen_sound(arg) ((xen_sound *)Xen_object_ref(arg))
-int xen_sound_to_int(XEN n)
+int xen_sound_to_int(Xen n)
{
xen_sound *mx;
- mx = XEN_TO_XEN_SOUND(n);
+ mx = Xen_to_xen_sound(n);
return(mx->n);
}
-static XEN_OBJECT_TYPE xen_sound_tag;
+static Xen_object_type_t xen_sound_tag;
-bool xen_sound_p(XEN obj)
+bool xen_is_sound(Xen obj)
{
- return(XEN_OBJECT_TYPE_P(obj, xen_sound_tag));
+ return(Xen_c_object_is_type(obj, xen_sound_tag));
}
static void xen_sound_free(xen_sound *v) {if (v) free(v);}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(xen_sound, free_xen_sound, xen_sound_free)
+Xen_wrap_free(xen_sound, free_xen_sound, xen_sound_free)
static char *xen_sound_to_string(xen_sound *v)
{
- #define XEN_SOUND_PRINT_BUFFER_SIZE 64
+ #define SOUND_PRINT_BUFFER_SIZE 64
char *buf;
if (v == NULL) return(NULL);
- buf = (char *)calloc(XEN_SOUND_PRINT_BUFFER_SIZE, sizeof(char));
- snprintf(buf, XEN_SOUND_PRINT_BUFFER_SIZE, "#<sound %d>", v->n);
+ buf = (char *)calloc(SOUND_PRINT_BUFFER_SIZE, sizeof(char));
+ snprintf(buf, SOUND_PRINT_BUFFER_SIZE, "#<sound %d>", v->n);
return(buf);
}
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(xen_sound, print_xen_sound, xen_sound_to_string)
+Xen_wrap_print(xen_sound, print_xen_sound, xen_sound_to_string)
#if HAVE_FORTH || HAVE_RUBY
-static XEN g_xen_sound_to_string(XEN obj)
+static Xen g_xen_sound_to_string(Xen obj)
{
char *vstr;
- XEN result;
+ Xen result;
#define S_xen_sound_to_string "sound->string"
- XEN_ASSERT_TYPE(XEN_SOUND_P(obj), obj, XEN_ONLY_ARG, S_xen_sound_to_string, "a sound");
+ Xen_check_type(xen_is_sound(obj), obj, 1, S_xen_sound_to_string, "a sound");
- vstr = xen_sound_to_string(XEN_TO_XEN_SOUND(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = xen_sound_to_string(Xen_to_xen_sound(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
@@ -2512,10 +2172,10 @@ static bool xen_sound_equalp(xen_sound *v1, xen_sound *v2)
(v1->n == v2->n));
}
-static XEN equalp_xen_sound(XEN obj1, XEN obj2)
+static Xen equalp_xen_sound(Xen obj1, Xen obj2)
{
- if ((!(XEN_SOUND_P(obj1))) || (!(XEN_SOUND_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(xen_sound_equalp(XEN_TO_XEN_SOUND(obj1), XEN_TO_XEN_SOUND(obj2))));
+ if ((!(xen_is_sound(obj1))) || (!(xen_is_sound(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(xen_sound_equalp(Xen_to_xen_sound(obj1), Xen_to_xen_sound(obj2))));
}
#endif
@@ -2529,14 +2189,14 @@ static xen_sound *xen_sound_make(int n)
}
-XEN new_xen_sound(int n)
+Xen new_xen_sound(int n)
{
xen_sound *mx;
if (n < 0)
- return(XEN_FALSE);
+ return(Xen_false);
mx = xen_sound_make(n);
- XEN_MAKE_AND_RETURN_OBJECT(xen_sound_tag, mx, 0, free_xen_sound);
+ return(Xen_make_object(xen_sound_tag, mx, 0, free_xen_sound));
}
@@ -2548,97 +2208,90 @@ static bool s7_xen_sound_equalp(void *obj1, void *obj2)
}
-static XEN s7_xen_sound_length(s7_scheme *sc, XEN obj)
+static Xen s7_xen_sound_length(s7_scheme *sc, Xen obj)
{
- return(g_frames(obj, XEN_ZERO, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION)));
+ return(g_framples(obj, Xen_integer_zero, C_int_to_Xen_integer(AT_CURRENT_EDIT_POSITION)));
}
-static XEN s7_xen_sound_copy(s7_scheme *sc, XEN obj)
+static Xen s7_xen_sound_copy(s7_scheme *sc, Xen args)
{
snd_info *sp;
+ s7_pointer obj;
+ obj = s7_car(args);
sp = get_sp(obj);
if (sp)
{
+ io_error_t err;
char *name;
name = snd_tempnam();
- if (mus_header_writable(sp->hdr->type, sp->hdr->format))
- save_edits_without_display(sp, name, sp->hdr->type, sp->hdr->format, sp->hdr->srate, NULL, AT_CURRENT_EDIT_POSITION);
- else save_edits_without_display(sp, name, MUS_NEXT, MUS_OUT_FORMAT, sp->hdr->srate, NULL, AT_CURRENT_EDIT_POSITION);
+ if (mus_header_writable(sp->hdr->type, sp->hdr->sample_type))
+ err = save_edits_without_display(sp, name, sp->hdr->type, sp->hdr->sample_type, sp->hdr->srate, NULL, AT_CURRENT_EDIT_POSITION);
+ else err = save_edits_without_display(sp, name, MUS_NEXT, MUS_OUT_SAMPLE_TYPE, sp->hdr->srate, NULL, AT_CURRENT_EDIT_POSITION);
sp = snd_open_file(name, FILE_READ_WRITE);
free(name);
- return(new_xen_sound(sp->index));
+ if (sp)
+ return(new_xen_sound(sp->index));
+ if (is_serious_io_error(err))
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_2(C_string_to_Xen_string("copy sound: can't save edits, ~A"),
+ C_string_to_Xen_string(io_error_name(err))));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN s7_xen_sound_fill(s7_scheme *sc, XEN obj, XEN val)
+static Xen s7_xen_sound_fill(s7_scheme *sc, Xen args)
{
snd_info *sp;
+ s7_pointer obj;
+
+ obj = s7_car(args);
sp = get_sp(obj);
if (sp)
{
mus_float_t valf;
chan_info *cp;
int i;
-
- valf = XEN_TO_C_DOUBLE(val);
+ s7_pointer val;
+
+ val = s7_cadr(args);
+ valf = Xen_real_to_C_double(val);
if (valf == 0.0)
{
for (i = 0; i < sp->nchans; i++)
{
cp = sp->chans[i];
- scale_channel(cp, 0.0, 0, CURRENT_SAMPLES(cp), cp->edit_ctr, false);
+ scale_channel(cp, 0.0, 0, current_samples(cp), cp->edit_ctr, false);
update_graph(cp);
}
}
else
{
-#if (!HAVE_SCHEME)
+ /* this was #if (!HAVE_SCHEME) which makes no sense -- I think it meant (!HAVE_RUN)
+ * but that means (fill! <sound>) fails if optimization is off.
+ */
mus_long_t len = -1, j;
- mus_sample_t *data = NULL;
- mus_sample_t value;
- value = MUS_FLOAT_TO_SAMPLE(valf);
-
+ mus_float_t *data = NULL;
+
for (i = 0; i < sp->nchans; i++)
{
cp = sp->chans[i];
- if ((!data) || (CURRENT_SAMPLES(cp) != len))
+ if ((!data) || (current_samples(cp) != len))
{
- len = CURRENT_SAMPLES(cp);
+ len = current_samples(cp);
if (data) free(data);
- data = (mus_sample_t *)malloc(len * sizeof(mus_sample_t));
+ data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
for (j = 0; j < len; j++)
- data[j] = value;
+ data[j] = valf;
}
- if (change_samples(0, len, data, cp, "fill! sound", cp->edit_ctr))
+ if (change_samples(0, len, data, cp, "fill! sound", cp->edit_ctr, fabs(valf)))
update_graph(cp);
}
free(data);
-#else
- char *expr;
- XEN func;
- int gc_loc;
-
- func = s7_eval_c_string(s7, expr = mus_format("(lambda (y) %f)", valf));
- gc_loc = s7_gc_protect(s7, func);
- free(expr);
-
- for (i = 0; i < sp->nchans; i++)
- {
- cp = sp->chans[i];
- /* we need a separate ptree for each channel */
- ptree_channel(cp,
- mus_run_form_to_ptree_1_f(XEN_PROCEDURE_SOURCE(func)),
- 0, CURRENT_SAMPLES(cp), cp->edit_ctr, true, XEN_FALSE, "fill! sound");
- }
-
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
#endif
@@ -2646,13 +2299,13 @@ static XEN s7_xen_sound_fill(s7_scheme *sc, XEN obj, XEN val)
static void init_xen_sound(void)
{
#if HAVE_SCHEME
- xen_sound_tag = XEN_MAKE_OBJECT_TYPE("<sound>", print_xen_sound, free_xen_sound, s7_xen_sound_equalp,
- NULL, NULL, NULL, s7_xen_sound_length, s7_xen_sound_copy, s7_xen_sound_fill);
+ xen_sound_tag = s7_new_type_x(s7, "<sound>", print_xen_sound, free_xen_sound, s7_xen_sound_equalp,
+ NULL, NULL, NULL, s7_xen_sound_length, s7_xen_sound_copy, NULL, s7_xen_sound_fill);
#else
#if HAVE_RUBY
- xen_sound_tag = XEN_MAKE_OBJECT_TYPE("XenSound", sizeof(xen_sound));
+ xen_sound_tag = Xen_make_object_type("XenSound", sizeof(xen_sound));
#else
- xen_sound_tag = XEN_MAKE_OBJECT_TYPE("Sound", sizeof(xen_sound));
+ xen_sound_tag = Xen_make_object_type("Sound", sizeof(xen_sound));
#endif
#endif
@@ -2664,73 +2317,64 @@ static void init_xen_sound(void)
#endif
#if HAVE_RUBY
- rb_define_method(xen_sound_tag, "to_s", XEN_PROCEDURE_CAST print_xen_sound, 0);
- rb_define_method(xen_sound_tag, "eql?", XEN_PROCEDURE_CAST equalp_xen_sound, 1);
- rb_define_method(xen_sound_tag, "==", XEN_PROCEDURE_CAST equalp_xen_sound, 1);
- rb_define_method(xen_sound_tag, "to_str", XEN_PROCEDURE_CAST g_xen_sound_to_string, 0);
+ rb_define_method(xen_sound_tag, "to_s", Xen_procedure_cast print_xen_sound, 0);
+ rb_define_method(xen_sound_tag, "eql?", Xen_procedure_cast equalp_xen_sound, 1);
+ rb_define_method(xen_sound_tag, "==", Xen_procedure_cast equalp_xen_sound, 1);
+ rb_define_method(xen_sound_tag, "to_str", Xen_procedure_cast g_xen_sound_to_string, 0);
#endif
}
/* -------------------------------------------------------------------------------- */
-static XEN g_integer_to_sound(XEN n)
+static Xen g_integer_to_sound(Xen n)
{
#define H_integer_to_sound "(" S_integer_to_sound " n) returns a sound object corresponding to the given integer"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n), n, XEN_ONLY_ARG, S_integer_to_sound, "an integer");
- return(new_xen_sound(XEN_TO_C_INT(n)));
+ Xen_check_type(Xen_is_integer(n), n, 1, S_integer_to_sound, "an integer");
+ return(new_xen_sound(Xen_integer_to_C_int(n)));
}
-static XEN g_sound_to_integer(XEN n)
+static Xen g_sound_to_integer(Xen n)
{
#define H_sound_to_integer "(" S_sound_to_integer " id) returns the integer corresponding to the given sound"
- XEN_ASSERT_TYPE(XEN_SOUND_P(n), n, XEN_ONLY_ARG, S_sound_to_integer, "a sound");
- return(C_TO_XEN_INT(xen_sound_to_int(n)));
+ Xen_check_type(xen_is_sound(n), n, 1, S_sound_to_integer, "a sound");
+ return(C_int_to_Xen_integer(xen_sound_to_int(n)));
}
-XEN snd_no_such_sound_error(const char *caller, XEN n)
+Xen snd_no_such_sound_error(const char *caller, Xen n)
{
- XEN_ERROR(XEN_ERROR_TYPE("no-such-sound"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: no such sound: ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("no-such-sound"),
+ Xen_list_3(C_string_to_Xen_string("~A: no such sound: ~A"),
+ C_string_to_Xen_string(caller),
n));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_sound_p(XEN snd)
+static Xen g_is_sound(Xen snd)
{
- #define H_sound_p "(" S_sound_p " snd): " PROC_TRUE " if 'snd' (a sound object or an integer) is an active (accessible) sound"
+ #define H_is_sound "(" S_is_sound " snd): " PROC_TRUE " if 'snd' (a sound object or an integer) is an active (accessible) sound"
- if (XEN_INTEGER_P(snd) || XEN_SOUND_P(snd))
+ if (Xen_is_integer(snd) || xen_is_sound(snd))
{
snd_info *sp;
sp = get_sp(snd);
- return(C_TO_XEN_BOOLEAN((sp) &&
+ return(C_bool_to_Xen_boolean((sp) &&
(snd_ok(sp)) &&
(sp->inuse == SOUND_NORMAL)));
}
- return(XEN_FALSE);
-}
-
-
-#if HAVE_SCHEME
-bool r_sound_p(int i);
-bool r_sound_p(int i)
-{
- return((i < ss->max_sounds) && (snd_ok(ss->sounds[i])) && (ss->sounds[i]->inuse == SOUND_NORMAL));
+ return(Xen_false);
}
-#endif
-static XEN g_select_sound(XEN snd)
+static Xen g_select_sound(Xen snd)
{
#define H_select_sound "(" S_select_sound " snd): make sound 'snd' (a sound object or an index) the default sound for \
any editing operations."
snd_info *sp;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(snd) || XEN_SOUND_P(snd), snd, XEN_ONLY_ARG, S_select_sound, "a sound object or index");
+ Xen_check_type(Xen_is_integer(snd) || xen_is_sound(snd), snd, 1, S_select_sound, "a sound object or index");
sp = get_sp(snd);
if (sp)
@@ -2743,15 +2387,15 @@ any editing operations."
}
-static XEN g_select_channel(XEN chn_n)
+static Xen g_select_channel(Xen chn_n)
{
#define H_select_channel "(" S_select_channel " :optional (chn 0)): make channel 'chn' of the currently selected sound the default \
channel for editing."
snd_info *sp;
- int chan;
+ int chan = 0;
- ASSERT_SOUND(S_select_channel, chn_n, 1);
- chan = XEN_TO_C_INT_OR_ELSE(chn_n, 0);
+ Snd_assert_sound(S_select_channel, chn_n, 1);
+ if (Xen_is_integer(chn_n)) chan = Xen_integer_to_C_int(chn_n);
sp = any_selected_sound();
if ((sp) &&
@@ -2762,48 +2406,28 @@ channel for editing."
return(chn_n);
}
- return(snd_no_such_channel_error(S_select_channel, C_TO_XEN_STRING(S_selected_sound), chn_n));
+ return(snd_no_such_channel_error(S_select_channel, C_string_to_Xen_string(S_selected_sound), chn_n));
}
-static XEN g_find_sound(XEN filename, XEN which)
+static Xen g_find_sound(Xen filename, Xen which)
{
#define H_find_sound "(" S_find_sound " name :optional (nth 0)): return the sound associated with file 'name'. \
If more than one such sound exists, 'nth' chooses which one to return."
snd_info *sp;
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ARG_1, S_find_sound, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(which), which, XEN_ARG_2, S_find_sound, "an integer");
-
- sp = find_sound(XEN_TO_C_STRING(filename), XEN_TO_C_INT_OR_ELSE(which, 0));
- if (sp) return(C_INT_TO_XEN_SOUND(sp->index));
-
- return(XEN_FALSE);
-}
-
-
-static XEN g_bomb(XEN snd, XEN on)
-{
- #define H_bomb "(" S_bomb " :optional snd (on " PROC_TRUE ")): display (or erase if on=" PROC_FALSE ") the bomb icon"
- snd_info *sp;
-
- ASSERT_SOUND(S_bomb, snd, 1);
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_2, S_bomb, "a boolean");
-
- sp = get_sp(snd); /* could also be a variable display handler here */
- if (sp == NULL)
- return(snd_no_such_sound_error(S_bomb, snd));
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_find_sound, "a string");
+ Xen_check_type(Xen_is_integer_or_unbound(which), which, 2, S_find_sound, "an integer");
- if (XEN_FALSE_P(on))
- hide_bomb(sp);
- else show_bomb(sp);
+ sp = find_sound(Xen_string_to_C_string(filename), (Xen_is_integer(which)) ? Xen_integer_to_C_int(which) : 0);
+ if (sp) return(C_int_to_Xen_sound(sp->index));
- return(on);
+ return(Xen_false);
}
typedef enum {SP_SYNC, SP_READ_ONLY, SP_NCHANS, SP_CONTRASTING, SP_EXPANDING, SP_REVERBING, SP_FILTERING, SP_FILTER_ORDER,
- SP_SRATE, SP_DATA_FORMAT, SP_DATA_LOCATION, SP_HEADER_TYPE, SP_SAVE_CONTROLS, SP_RESTORE_CONTROLS, SP_SELECTED_CHANNEL,
+ SP_SRATE, SP_SAMPLE_TYPE, SP_DATA_LOCATION, SP_HEADER_TYPE, SP_SAVE_CONTROLS, SP_RESTORE_CONTROLS, SP_SELECTED_CHANNEL,
SP_COMMENT, SP_FILE_NAME, SP_SHORT_FILE_NAME, SP_CLOSE, SP_UPDATE, SP_SHOW_CONTROLS,
SP_FILTER_DBING, SP_SPEED_TONES, SP_SPEED_STYLE, SP_RESET_CONTROLS,
SP_AMP, SP_CONTRAST, SP_CONTRAST_AMP, SP_EXPAND, SP_EXPAND_LENGTH, SP_EXPAND_RAMP, SP_EXPAND_HOP,
@@ -2814,25 +2438,25 @@ typedef enum {SP_SYNC, SP_READ_ONLY, SP_NCHANS, SP_CONTRASTING, SP_EXPANDING, SP
} sp_field_t;
-static XEN sound_get(XEN snd, sp_field_t fld, const char *caller)
+static Xen sound_get(Xen snd, sp_field_t fld, const char *caller)
{
snd_info *sp;
- int i;
- XEN res = XEN_EMPTY_LIST;
+ Xen res = Xen_empty_list;
- if (XEN_TRUE_P(snd))
+ if (Xen_is_true(snd))
{
+ int i;
for (i = ss->max_sounds - 1; i >= 0; i--)
{
sp = ss->sounds[i];
if ((sp) &&
(sp->inuse == SOUND_NORMAL))
- res = XEN_CONS(sound_get(C_TO_XEN_INT(i), fld, caller), res);
+ res = Xen_cons(sound_get(C_int_to_Xen_integer(i), fld, caller), res);
}
return(res);
}
- if (XEN_PLAYER_P(snd))
+ if (xen_is_player(snd))
{
sp = get_player_sound(snd);
if (!sp)
@@ -2840,7 +2464,7 @@ static XEN sound_get(XEN snd, sp_field_t fld, const char *caller)
}
else
{
- ASSERT_SOUND(caller, snd, 1);
+ Snd_assert_sound(caller, snd, 1);
sp = get_sp(snd);
if (!sp)
return(snd_no_such_sound_error(caller, snd));
@@ -2851,94 +2475,94 @@ static XEN sound_get(XEN snd, sp_field_t fld, const char *caller)
switch (fld)
{
- case SP_SYNC: return(C_TO_XEN_INT(sp->sync)); break;
- case SP_READ_ONLY: return(C_TO_XEN_BOOLEAN(sp->user_read_only == FILE_READ_ONLY)); break;
- case SP_NCHANS: return(C_TO_XEN_INT(sp->nchans)); break;
- case SP_EXPANDING: return(C_TO_XEN_BOOLEAN(sp->expand_control_p)); break;
- case SP_CONTRASTING: return(C_TO_XEN_BOOLEAN(sp->contrast_control_p)); break;
- case SP_REVERBING: return(C_TO_XEN_BOOLEAN(sp->reverb_control_p)); break;
- case SP_FILTERING: return(C_TO_XEN_BOOLEAN(sp->filter_control_p)); break;
- case SP_FILTER_DBING: return(C_TO_XEN_BOOLEAN(sp->filter_control_in_dB)); break;
- case SP_FILTER_HZING: return(C_TO_XEN_BOOLEAN(sp->filter_control_in_hz)); break;
- case SP_FILTER_ORDER: return(C_TO_XEN_INT(sp->filter_control_order)); break;
- case SP_SRATE: return(C_TO_XEN_INT(sp->hdr->srate)); break;
- case SP_DATA_FORMAT: return(C_TO_XEN_INT(sp->hdr->format)); break;
- case SP_HEADER_TYPE: return(C_TO_XEN_INT(sp->hdr->type)); break;
- case SP_DATA_LOCATION: return(C_TO_XEN_INT64_T(sp->hdr->data_location)); break;
- case SP_DATA_SIZE: return(C_TO_XEN_INT64_T(mus_samples_to_bytes(sp->hdr->format, sp->hdr->samples))); break;
- case SP_SAVE_CONTROLS: if (HAS_WIDGETS(sp)) save_controls(sp); break;
- case SP_RESTORE_CONTROLS: if (HAS_WIDGETS(sp)) restore_controls(sp); break;
- case SP_RESET_CONTROLS: if (HAS_WIDGETS(sp)) reset_controls(sp); break;
- case SP_FILE_NAME: return(C_TO_XEN_STRING(sp->filename)); break;
- case SP_SHORT_FILE_NAME: return(C_TO_XEN_STRING(sp->short_filename)); break;
- case SP_CLOSE: if (!(IS_PLAYER_SOUND(sp))) snd_close_file(sp); break;
- case SP_SHOW_CONTROLS: if (HAS_WIDGETS(sp)) return(C_TO_XEN_BOOLEAN(showing_controls(sp))); break;
- case SP_SPEED_TONES: return(C_TO_XEN_INT(sp->speed_control_tones)); break;
- case SP_SPEED_STYLE: return(C_TO_XEN_INT((int)(sp->speed_control_style))); break;
- case SP_COMMENT: return(C_TO_XEN_STRING(sp->hdr->comment)); break;
- case SP_AMP: return(C_TO_XEN_DOUBLE(sp->amp_control)); break;
- case SP_CONTRAST: return(C_TO_XEN_DOUBLE(sp->contrast_control)); break;
- case SP_CONTRAST_AMP: return(C_TO_XEN_DOUBLE(sp->contrast_control_amp)); break;
- case SP_EXPAND: return(C_TO_XEN_DOUBLE(sp->expand_control)); break;
- case SP_EXPAND_LENGTH: return(C_TO_XEN_DOUBLE(sp->expand_control_length)); break;
- case SP_EXPAND_RAMP: return(C_TO_XEN_DOUBLE(sp->expand_control_ramp)); break;
- case SP_EXPAND_HOP: return(C_TO_XEN_DOUBLE(sp->expand_control_hop)); break;
- case SP_EXPAND_JITTER: return(C_TO_XEN_DOUBLE(sp->expand_control_jitter)); break;
- case SP_REVERB_LENGTH: return(C_TO_XEN_DOUBLE(sp->reverb_control_length)); break;
- case SP_REVERB_FEEDBACK: return(C_TO_XEN_DOUBLE(sp->reverb_control_feedback)); break;
- case SP_REVERB_SCALE: return(C_TO_XEN_DOUBLE(sp->reverb_control_scale)); break;
- case SP_REVERB_LOW_PASS: return(C_TO_XEN_DOUBLE(sp->reverb_control_lowpass)); break;
- case SP_REVERB_DECAY: return(C_TO_XEN_DOUBLE(sp->reverb_control_decay)); break;
+ case SP_SYNC: return(C_int_to_Xen_integer(sp->sync)); break;
+ case SP_READ_ONLY: return(C_bool_to_Xen_boolean(sp->user_read_only == FILE_READ_ONLY)); break;
+ case SP_NCHANS: return(C_int_to_Xen_integer(sp->nchans)); break;
+ case SP_EXPANDING: return(C_bool_to_Xen_boolean(sp->expand_control_on)); break;
+ case SP_CONTRASTING: return(C_bool_to_Xen_boolean(sp->contrast_control_on)); break;
+ case SP_REVERBING: return(C_bool_to_Xen_boolean(sp->reverb_control_on)); break;
+ case SP_FILTERING: return(C_bool_to_Xen_boolean(sp->filter_control_on)); break;
+ case SP_FILTER_DBING: return(C_bool_to_Xen_boolean(sp->filter_control_in_dB)); break;
+ case SP_FILTER_HZING: return(C_bool_to_Xen_boolean(sp->filter_control_in_hz)); break;
+ case SP_FILTER_ORDER: return(C_int_to_Xen_integer(sp->filter_control_order)); break;
+ case SP_SRATE: return(C_int_to_Xen_integer(sp->hdr->srate)); break;
+ case SP_SAMPLE_TYPE: return(C_int_to_Xen_integer(sp->hdr->sample_type)); break;
+ case SP_HEADER_TYPE: return(C_int_to_Xen_integer(sp->hdr->type)); break;
+ case SP_DATA_LOCATION: return(C_llong_to_Xen_llong(sp->hdr->data_location)); break;
+ case SP_DATA_SIZE: return(C_llong_to_Xen_llong(mus_samples_to_bytes(sp->hdr->sample_type, sp->hdr->samples))); break;
+ case SP_SAVE_CONTROLS: if (has_widgets(sp)) save_controls(sp); break;
+ case SP_RESTORE_CONTROLS: if (has_widgets(sp)) restore_controls(sp); break;
+ case SP_RESET_CONTROLS: if (has_widgets(sp)) reset_controls(sp); break;
+ case SP_FILE_NAME: return(C_string_to_Xen_string(sp->filename)); break;
+ case SP_SHORT_FILE_NAME: return(C_string_to_Xen_string(sp->short_filename)); break;
+ case SP_CLOSE: if (!(is_player_sound(sp))) snd_close_file(sp); break;
+ case SP_SHOW_CONTROLS: if (has_widgets(sp)) return(C_bool_to_Xen_boolean(showing_controls(sp))); break;
+ case SP_SPEED_TONES: return(C_int_to_Xen_integer(sp->speed_control_tones)); break;
+ case SP_SPEED_STYLE: return(C_int_to_Xen_integer((int)(sp->speed_control_style))); break;
+ case SP_COMMENT: return(C_string_to_Xen_string(sp->hdr->comment)); break;
+ case SP_AMP: return(C_double_to_Xen_real(sp->amp_control)); break;
+ case SP_CONTRAST: return(C_double_to_Xen_real(sp->contrast_control)); break;
+ case SP_CONTRAST_AMP: return(C_double_to_Xen_real(sp->contrast_control_amp)); break;
+ case SP_EXPAND: return(C_double_to_Xen_real(sp->expand_control)); break;
+ case SP_EXPAND_LENGTH: return(C_double_to_Xen_real(sp->expand_control_length)); break;
+ case SP_EXPAND_RAMP: return(C_double_to_Xen_real(sp->expand_control_ramp)); break;
+ case SP_EXPAND_HOP: return(C_double_to_Xen_real(sp->expand_control_hop)); break;
+ case SP_EXPAND_JITTER: return(C_double_to_Xen_real(sp->expand_control_jitter)); break;
+ case SP_REVERB_LENGTH: return(C_double_to_Xen_real(sp->reverb_control_length)); break;
+ case SP_REVERB_FEEDBACK: return(C_double_to_Xen_real(sp->reverb_control_feedback)); break;
+ case SP_REVERB_SCALE: return(C_double_to_Xen_real(sp->reverb_control_scale)); break;
+ case SP_REVERB_LOW_PASS: return(C_double_to_Xen_real(sp->reverb_control_lowpass)); break;
+ case SP_REVERB_DECAY: return(C_double_to_Xen_real(sp->reverb_control_decay)); break;
case SP_AMP_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(sp->amp_control_min), C_TO_XEN_DOUBLE(sp->amp_control_max)));
+ return(Xen_list_2(C_double_to_Xen_real(sp->amp_control_min), C_double_to_Xen_real(sp->amp_control_max)));
break;
case SP_CONTRAST_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(sp->contrast_control_min), C_TO_XEN_DOUBLE(sp->contrast_control_max)));
+ return(Xen_list_2(C_double_to_Xen_real(sp->contrast_control_min), C_double_to_Xen_real(sp->contrast_control_max)));
break;
case SP_EXPAND_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(sp->expand_control_min), C_TO_XEN_DOUBLE(sp->expand_control_max)));
+ return(Xen_list_2(C_double_to_Xen_real(sp->expand_control_min), C_double_to_Xen_real(sp->expand_control_max)));
break;
case SP_SPEED_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(sp->speed_control_min), C_TO_XEN_DOUBLE(sp->speed_control_max)));
+ return(Xen_list_2(C_double_to_Xen_real(sp->speed_control_min), C_double_to_Xen_real(sp->speed_control_max)));
break;
case SP_REVERB_LENGTH_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(sp->reverb_control_length_min), C_TO_XEN_DOUBLE(sp->reverb_control_length_max)));
+ return(Xen_list_2(C_double_to_Xen_real(sp->reverb_control_length_min), C_double_to_Xen_real(sp->reverb_control_length_max)));
break;
case SP_REVERB_SCALE_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(sp->reverb_control_scale_min), C_TO_XEN_DOUBLE(sp->reverb_control_scale_max)));
+ return(Xen_list_2(C_double_to_Xen_real(sp->reverb_control_scale_min), C_double_to_Xen_real(sp->reverb_control_scale_max)));
break;
case SP_SELECTED_CHANNEL:
if (sp->selected_channel != NO_SELECTION)
- return(C_TO_XEN_INT(sp->selected_channel));
- return(XEN_FALSE);
+ return(C_int_to_Xen_integer(sp->selected_channel));
+ return(Xen_false);
break;
case SP_UPDATE:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
mus_sound_forget(sp->filename); /* old record must be out-of-date, so flush it (write date can be troublesome) */
sp = snd_update_within_xen(sp, caller);
if (sp)
- return(C_INT_TO_XEN_SOUND(sp->index));
+ return(C_int_to_Xen_sound(sp->index));
}
break;
case SP_PROPERTIES:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
- if (!(XEN_VECTOR_P(sp->properties)))
+ if (!(Xen_is_vector(sp->properties)))
{
- sp->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ sp->properties = Xen_make_vector(1, Xen_empty_list);
sp->properties_loc = snd_protect(sp->properties);
}
- return(XEN_VECTOR_REF(sp->properties, 0));
+ return(Xen_vector_ref(sp->properties, 0));
}
break;
@@ -2947,13 +2571,13 @@ static XEN sound_get(XEN snd, sp_field_t fld, const char *caller)
if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
{
if (sp->speed_control_direction == -1)
- return(XEN_MAKE_RATIO(C_TO_XEN_INT(-sp->speed_control_numerator), C_TO_XEN_INT(sp->speed_control_denominator)));
- else return(XEN_MAKE_RATIO(C_TO_XEN_INT(sp->speed_control_numerator), C_TO_XEN_INT(sp->speed_control_denominator)));
+ return(Xen_make_ratio(C_int_to_Xen_integer(-sp->speed_control_numerator), C_int_to_Xen_integer(sp->speed_control_denominator)));
+ else return(Xen_make_ratio(C_int_to_Xen_integer(sp->speed_control_numerator), C_int_to_Xen_integer(sp->speed_control_denominator)));
}
#endif
if (sp->speed_control_direction == -1)
- return(C_TO_XEN_DOUBLE((-(sp->speed_control))));
- else return(C_TO_XEN_DOUBLE(sp->speed_control));
+ return(C_double_to_Xen_real((-(sp->speed_control))));
+ else return(C_double_to_Xen_real(sp->speed_control));
break;
case SP_FILTER_COEFFS:
@@ -2975,52 +2599,52 @@ static XEN sound_get(XEN snd, sp_field_t fld, const char *caller)
return(env_to_xen(sp->filter_control_envelope));
break;
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN sound_get_global(XEN snd, sp_field_t fld, const char *caller)
+static Xen sound_get_global(Xen snd, sp_field_t fld, const char *caller)
{
- if (XEN_NOT_BOUND_P(snd))
+ if (!Xen_is_bound(snd))
switch (fld)
{
- case SP_FILTER_DBING: return(C_TO_XEN_BOOLEAN(filter_control_in_dB(ss))); break;
- case SP_FILTER_HZING: return(C_TO_XEN_BOOLEAN(filter_control_in_hz(ss))); break;
- case SP_FILTER_ORDER: return(C_TO_XEN_INT(filter_control_order(ss))); break;
- case SP_SHOW_CONTROLS: return(C_TO_XEN_BOOLEAN(in_show_controls(ss))); break;
- case SP_SPEED_TONES: return(C_TO_XEN_INT(speed_control_tones(ss))); break;
- case SP_SPEED_STYLE: return(C_TO_XEN_INT((int)(speed_control_style(ss)))); break;
- case SP_CONTRAST_AMP: return(C_TO_XEN_DOUBLE(contrast_control_amp(ss))); break;
- case SP_EXPAND_LENGTH: return(C_TO_XEN_DOUBLE(expand_control_length(ss))); break;
- case SP_EXPAND_RAMP: return(C_TO_XEN_DOUBLE(expand_control_ramp(ss))); break;
- case SP_EXPAND_HOP: return(C_TO_XEN_DOUBLE(expand_control_hop(ss))); break;
- case SP_EXPAND_JITTER: return(C_TO_XEN_DOUBLE(expand_control_jitter(ss))); break;
- case SP_REVERB_FEEDBACK: return(C_TO_XEN_DOUBLE(reverb_control_feedback(ss))); break;
- case SP_REVERB_LOW_PASS: return(C_TO_XEN_DOUBLE(reverb_control_lowpass(ss))); break;
- case SP_REVERB_DECAY: return(C_TO_XEN_DOUBLE(reverb_control_decay(ss))); break;
+ case SP_FILTER_DBING: return(C_bool_to_Xen_boolean(filter_control_in_dB(ss))); break;
+ case SP_FILTER_HZING: return(C_bool_to_Xen_boolean(filter_control_in_hz(ss))); break;
+ case SP_FILTER_ORDER: return(C_int_to_Xen_integer(filter_control_order(ss))); break;
+ case SP_SHOW_CONTROLS: return(C_bool_to_Xen_boolean(in_show_controls(ss))); break;
+ case SP_SPEED_TONES: return(C_int_to_Xen_integer(speed_control_tones(ss))); break;
+ case SP_SPEED_STYLE: return(C_int_to_Xen_integer((int)(speed_control_style(ss)))); break;
+ case SP_CONTRAST_AMP: return(C_double_to_Xen_real(contrast_control_amp(ss))); break;
+ case SP_EXPAND_LENGTH: return(C_double_to_Xen_real(expand_control_length(ss))); break;
+ case SP_EXPAND_RAMP: return(C_double_to_Xen_real(expand_control_ramp(ss))); break;
+ case SP_EXPAND_HOP: return(C_double_to_Xen_real(expand_control_hop(ss))); break;
+ case SP_EXPAND_JITTER: return(C_double_to_Xen_real(expand_control_jitter(ss))); break;
+ case SP_REVERB_FEEDBACK: return(C_double_to_Xen_real(reverb_control_feedback(ss))); break;
+ case SP_REVERB_LOW_PASS: return(C_double_to_Xen_real(reverb_control_lowpass(ss))); break;
+ case SP_REVERB_DECAY: return(C_double_to_Xen_real(reverb_control_decay(ss))); break;
case SP_AMP_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(amp_control_min(ss)), C_TO_XEN_DOUBLE(amp_control_max(ss))));
+ return(Xen_list_2(C_double_to_Xen_real(amp_control_min(ss)), C_double_to_Xen_real(amp_control_max(ss))));
break;
case SP_CONTRAST_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(contrast_control_min(ss)), C_TO_XEN_DOUBLE(contrast_control_max(ss))));
+ return(Xen_list_2(C_double_to_Xen_real(contrast_control_min(ss)), C_double_to_Xen_real(contrast_control_max(ss))));
break;
case SP_EXPAND_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(expand_control_min(ss)), C_TO_XEN_DOUBLE(expand_control_max(ss))));
+ return(Xen_list_2(C_double_to_Xen_real(expand_control_min(ss)), C_double_to_Xen_real(expand_control_max(ss))));
break;
case SP_SPEED_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(speed_control_min(ss)), C_TO_XEN_DOUBLE(speed_control_max(ss))));
+ return(Xen_list_2(C_double_to_Xen_real(speed_control_min(ss)), C_double_to_Xen_real(speed_control_max(ss))));
break;
case SP_REVERB_LENGTH_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(reverb_control_length_min(ss)), C_TO_XEN_DOUBLE(reverb_control_length_max(ss))));
+ return(Xen_list_2(C_double_to_Xen_real(reverb_control_length_min(ss)), C_double_to_Xen_real(reverb_control_length_max(ss))));
break;
case SP_REVERB_SCALE_BOUNDS:
- return(XEN_LIST_2(C_TO_XEN_DOUBLE(reverb_control_scale_min(ss)), C_TO_XEN_DOUBLE(reverb_control_scale_max(ss))));
+ return(Xen_list_2(C_double_to_Xen_real(reverb_control_scale_min(ss)), C_double_to_Xen_real(reverb_control_scale_max(ss))));
break;
default:
@@ -3030,25 +2654,25 @@ static XEN sound_get_global(XEN snd, sp_field_t fld, const char *caller)
}
-static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
+static Xen sound_set(Xen snd, Xen val, sp_field_t fld, const char *caller)
{
snd_info *sp;
int i, ival;
mus_float_t fval;
- if (XEN_TRUE_P(snd))
+ if (Xen_is_true(snd))
{
for (i = 0; i < ss->max_sounds; i++)
{
sp = ss->sounds[i];
if ((sp) &&
(sp->inuse == SOUND_NORMAL))
- sound_set(C_TO_XEN_INT(i), val, fld, caller);
+ sound_set(C_int_to_Xen_integer(i), val, fld, caller);
}
return(val);
}
- if (XEN_PLAYER_P(snd))
+ if (xen_is_player(snd))
{
sp = get_player_sound(snd);
if (!sp)
@@ -3056,7 +2680,7 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
}
else
{
- ASSERT_SOUND(caller, snd, 1);
+ Snd_assert_sound(caller, snd, 1);
sp = get_sp(snd);
if (!sp)
return(snd_no_such_sound_error(caller, snd));
@@ -3068,15 +2692,15 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
switch (fld)
{
case SP_SYNC:
- if (XEN_INTEGER_P(val))
- syncb(sp, XEN_TO_C_INT(val));
- else syncb(sp, (int)XEN_TO_C_BOOLEAN(val));
+ if (Xen_is_integer(val))
+ syncb(sp, Xen_integer_to_C_int(val));
+ else syncb(sp, (int)Xen_boolean_to_C_bool(val));
break;
case SP_READ_ONLY:
- if (HAS_WIDGETS(sp))
+ if (has_widgets(sp))
{
- sp->user_read_only = (XEN_TO_C_BOOLEAN(val) ? FILE_READ_ONLY : FILE_READ_WRITE);
+ sp->user_read_only = (Xen_boolean_to_C_bool(val) ? FILE_READ_ONLY : FILE_READ_WRITE);
if ((sp->user_read_only == FILE_READ_ONLY) ||
(sp->file_read_only == FILE_READ_ONLY))
show_lock(sp);
@@ -3085,51 +2709,51 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
break;
case SP_EXPANDING:
- toggle_expand_button(sp, XEN_TO_C_BOOLEAN(val));
+ toggle_expand_button(sp, Xen_boolean_to_C_bool(val));
break;
case SP_CONTRASTING:
- toggle_contrast_button(sp, XEN_TO_C_BOOLEAN(val));
+ toggle_contrast_button(sp, Xen_boolean_to_C_bool(val));
break;
case SP_REVERBING:
- toggle_reverb_button(sp, XEN_TO_C_BOOLEAN(val));
+ toggle_reverb_button(sp, Xen_boolean_to_C_bool(val));
break;
case SP_FILTERING:
- toggle_filter_button(sp, XEN_TO_C_BOOLEAN(val));
+ toggle_filter_button(sp, Xen_boolean_to_C_bool(val));
break;
case SP_FILTER_DBING:
- set_filter_in_dB(sp, XEN_TO_C_BOOLEAN(val));
+ set_filter_in_dB(sp, Xen_boolean_to_C_bool(val));
break;
case SP_FILTER_HZING:
- set_filter_in_hz(sp, XEN_TO_C_BOOLEAN(val));
+ set_filter_in_hz(sp, Xen_boolean_to_C_bool(val));
break;
case SP_FILTER_ORDER:
- set_filter_order(sp, XEN_TO_C_INT(val));
+ set_filter_order(sp, Xen_integer_to_C_int(val));
break;
case SP_SHOW_CONTROLS:
- if (HAS_WIDGETS(sp))
+ if (has_widgets(sp))
{
- if (XEN_TO_C_BOOLEAN(val))
+ if (Xen_boolean_to_C_bool(val))
show_controls(sp);
else hide_controls(sp);
}
break;
case SP_SPEED_TONES:
- sp->speed_control_tones = XEN_TO_C_INT(val);
+ sp->speed_control_tones = Xen_integer_to_C_int(val);
if (sp->speed_control_tones <= 0)
sp->speed_control_tones = DEFAULT_SPEED_CONTROL_TONES;
set_speed(sp, sp->speed_control); /* update label etc */
break;
case SP_SPEED_STYLE:
- sp->speed_control_style = (speed_style_t)XEN_TO_C_INT(val); /* range checked already */
+ sp->speed_control_style = (speed_style_t)Xen_integer_to_C_int(val); /* range checked already */
#if XEN_HAVE_RATIOS
if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
@@ -3138,11 +2762,18 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
break;
case SP_SRATE:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
- ival = XEN_TO_C_INT_OR_ELSE(val, 44100);
+ if (Xen_is_integer(val))
+ ival = Xen_integer_to_C_int(val);
+ else
+ {
+ if (Xen_is_double(val))
+ ival = snd_round(Xen_real_to_C_double(val));
+ else ival = 44100;
+ }
if ((ival <= 0) || (ival > 100000000))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_srate, 1, val, "~A: impossible srate");
+ Xen_out_of_range_error(S_set S_srate, 1, val, "impossible srate");
mus_sound_set_srate(sp->filename, ival);
sp->hdr->srate = ival;
/* if there are pending edits, we certainly don't want to flush them in this case! */
@@ -3153,34 +2784,34 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
/* reset x axis bounds */
int i;
for (i = 0; i < sp->nchans; i++)
- set_x_axis_x0x1(sp->chans[i], 0.0, (double)(CURRENT_SAMPLES(sp->chans[i])) / (double)ival);
+ set_x_axis_x0x1(sp->chans[i], 0.0, (double)(current_samples(sp->chans[i])) / (double)ival);
}
}
break;
case SP_NCHANS:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
- ival = XEN_TO_C_INT_OR_ELSE(val, 1);
+ ival = Xen_integer_to_C_int(val);
if ((ival <= 0) || (ival > 256))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_channels, 1, val, "~A: highly unlikely number of channels");
+ Xen_out_of_range_error(S_set S_channels, 1, val, "highly unlikely number of channels");
mus_sound_set_chans(sp->filename, ival);
sp->hdr->chans = ival;
snd_update_within_xen(sp, caller);
}
break;
- case SP_DATA_FORMAT:
- if (!(IS_PLAYER_SOUND(sp)))
+ case SP_SAMPLE_TYPE:
+ if (!(is_player_sound(sp)))
{
- ival = XEN_TO_C_INT(val);
- if (mus_data_format_p(ival))
+ mus_sample_t ival;
+ ival = (mus_sample_t)Xen_integer_to_C_int(val);
+ if (mus_is_sample_type(ival))
{
- chan_info *cp;
- int old_format;
- old_format = sp->hdr->format;
- mus_sound_set_data_format(sp->filename, ival);
- sp->hdr->format = ival;
+ mus_sample_t old_format;
+ old_format = sp->hdr->sample_type;
+ mus_sound_set_sample_type(sp->filename, ival);
+ sp->hdr->sample_type = ival;
if (mus_bytes_per_sample(old_format) != mus_bytes_per_sample(ival))
{
sp->hdr->samples = (sp->hdr->samples * mus_bytes_per_sample(old_format)) / mus_bytes_per_sample(ival);
@@ -3189,166 +2820,170 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
/* clear peak amp envs, if any -- is this right? (snd-update below...) */
for (i = 0; i < sp->nchans; i++)
{
+ chan_info *cp;
cp = sp->chans[i];
if ((cp) && (cp->edits[cp->edit_ctr]->peak_env))
cp->edits[cp->edit_ctr]->peak_env = free_peak_env(cp, cp->edit_ctr);
}
snd_update_within_xen(sp, caller);
}
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_data_format, 1, val, "~A: unknown data format");
+ else Xen_out_of_range_error(S_set S_sample_type, 1, val, "unknown sample type");
}
break;
case SP_HEADER_TYPE:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
- ival = XEN_TO_C_INT(val);
- if (mus_header_type_p(ival))
+ mus_header_t typ;
+ typ = (mus_header_t)Xen_integer_to_C_int(val);
+ if (mus_is_header_type(typ))
{
- mus_sound_set_header_type(sp->filename, ival);
+ mus_sound_set_header_type(sp->filename, typ);
snd_update_within_xen(sp, caller);
}
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_header_type, 1, val, "~A: unknown header type");
+ else Xen_out_of_range_error(S_set S_header_type, 1, val, "unknown header type");
}
break;
case SP_DATA_LOCATION:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
mus_long_t loc;
- loc = XEN_TO_C_INT64_T(val);
+ loc = Xen_llong_to_C_llong(val);
if (loc >= 0)
{
mus_sound_set_data_location(sp->filename, loc);
snd_update_within_xen(sp, caller);
}
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_data_location, 1, val, "data location ~A < 0?");
+ else Xen_out_of_range_error(S_set S_data_location, 1, val, "data location < 0?");
}
break;
case SP_DATA_SIZE:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
mus_long_t size;
- size = XEN_TO_C_INT64_T(val);
+ size = Xen_llong_to_C_llong(val);
if (size >= 0)
{
- mus_sound_set_samples(sp->filename, mus_bytes_to_samples(sp->hdr->format, size));
+ mus_sound_set_samples(sp->filename, mus_bytes_to_samples(sp->hdr->sample_type, size));
snd_update_within_xen(sp, caller);
}
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_data_size, 1, val, "data size ~A < 0?");
+ else Xen_out_of_range_error(S_set S_data_size, 1, val, "data size < 0?");
}
break;
case SP_COMMENT:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
if (sp->hdr->comment) free(sp->hdr->comment);
- if (XEN_FALSE_P(val))
+ if (Xen_is_false(val))
sp->hdr->comment = NULL;
- else sp->hdr->comment = mus_strdup(XEN_TO_C_STRING(val));
+ else sp->hdr->comment = mus_strdup(Xen_string_to_C_string(val));
}
break;
case SP_PROPERTIES:
- if (!(IS_PLAYER_SOUND(sp)))
+ if (!(is_player_sound(sp)))
{
- if (!(XEN_VECTOR_P(sp->properties)))
+ if (!(Xen_is_vector(sp->properties)))
{
- sp->properties = XEN_MAKE_VECTOR(1, XEN_EMPTY_LIST);
+ sp->properties = Xen_make_vector(1, Xen_empty_list);
sp->properties_loc = snd_protect(sp->properties);
}
- XEN_VECTOR_SET(sp->properties, 0, val);
- return(XEN_VECTOR_REF(sp->properties, 0));
+ Xen_vector_set(sp->properties, 0, val);
+ return(Xen_vector_ref(sp->properties, 0));
}
break;
case SP_AMP:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if (fval >= 0.0) set_amp(sp, fval);
- return(C_TO_XEN_DOUBLE(sp->amp_control));
+ return(C_double_to_Xen_real(sp->amp_control));
break;
case SP_AMP_BOUNDS:
- sp->amp_control_min = XEN_TO_C_DOUBLE(XEN_CAR(val));
- sp->amp_control_max = XEN_TO_C_DOUBLE(XEN_CADR(val));
+ sp->amp_control_min = Xen_real_to_C_double(Xen_car(val));
+ sp->amp_control_max = Xen_real_to_C_double(Xen_cadr(val));
set_amp(sp, mus_fclamp(sp->amp_control_min, sp->amp_control, sp->amp_control_max));
return(val);
break;
case SP_CONTRAST:
- set_contrast(sp, XEN_TO_C_DOUBLE(val));
- return(C_TO_XEN_DOUBLE(sp->contrast_control));
+ set_contrast(sp, Xen_real_to_C_double(val));
+ return(C_double_to_Xen_real(sp->contrast_control));
break;
case SP_CONTRAST_BOUNDS:
- sp->contrast_control_min = XEN_TO_C_DOUBLE(XEN_CAR(val));
- sp->contrast_control_max = XEN_TO_C_DOUBLE(XEN_CADR(val));
+ sp->contrast_control_min = Xen_real_to_C_double(Xen_car(val));
+ sp->contrast_control_max = Xen_real_to_C_double(Xen_cadr(val));
set_contrast(sp, mus_fclamp(sp->contrast_control_min, sp->contrast_control, sp->contrast_control_max));
return(val);
break;
case SP_CONTRAST_AMP:
- sp->contrast_control_amp = XEN_TO_C_DOUBLE(val);
+ sp->contrast_control_amp = Xen_real_to_C_double(val);
if (sp->playing) dac_set_contrast_amp(sp, sp->contrast_control_amp);
break;
case SP_EXPAND:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if (fval > 0.0) set_expand(sp, fval);
- return(C_TO_XEN_DOUBLE(sp->expand_control));
+ return(C_double_to_Xen_real(sp->expand_control));
break;
case SP_EXPAND_BOUNDS:
- sp->expand_control_min = XEN_TO_C_DOUBLE(XEN_CAR(val));
- sp->expand_control_max = XEN_TO_C_DOUBLE(XEN_CADR(val));
+ sp->expand_control_min = Xen_real_to_C_double(Xen_car(val));
+ sp->expand_control_max = Xen_real_to_C_double(Xen_cadr(val));
set_expand(sp, mus_fclamp(sp->expand_control_min, sp->expand_control, sp->expand_control_max));
return(val);
break;
case SP_EXPAND_LENGTH:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if (fval > 0.0)
{
sp->expand_control_length = fval;
if (sp->playing) dac_set_expand_length(sp, sp->expand_control_length);
}
- return(C_TO_XEN_DOUBLE(sp->expand_control_length));
+ else Xen_out_of_range_error(S_set S_expand_control_length, 1, val, "length <= 0.0?");
+ return(C_double_to_Xen_real(sp->expand_control_length));
break;
case SP_EXPAND_RAMP:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if ((fval >= 0.0) && (fval < 0.5))
{
sp->expand_control_ramp = fval;
if (sp->playing) dac_set_expand_ramp(sp, fval);
}
- return(C_TO_XEN_DOUBLE(sp->expand_control_ramp));
+ return(C_double_to_Xen_real(sp->expand_control_ramp));
break;
case SP_EXPAND_HOP:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if (fval > 0.0)
{
sp->expand_control_hop = fval;
if (sp->playing) dac_set_expand_hop(sp, fval);
}
- return(C_TO_XEN_DOUBLE(sp->expand_control_hop));
+ else Xen_out_of_range_error(S_set S_expand_control_hop, 1, val, "hop <= 0.0?");
+ return(C_double_to_Xen_real(sp->expand_control_hop));
break;
case SP_EXPAND_JITTER:
- fval = mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), 100.0);
+ fval = mus_fclamp(0.0, Xen_real_to_C_double(val), 100.0);
sp->expand_control_jitter = fval;
- return(C_TO_XEN_DOUBLE(sp->expand_control_jitter));
+ return(C_double_to_Xen_real(sp->expand_control_jitter));
break;
case SP_SPEED:
#if XEN_HAVE_RATIOS
if ((sp->speed_control_style == SPEED_CONTROL_AS_RATIO) &&
- (XEN_RATIO_P(val)))
+ (Xen_is_ratio(val)))
{
- sp->speed_control_numerator = (int)XEN_NUMERATOR(val);
- sp->speed_control_denominator = (int)XEN_DENOMINATOR(val);
+ sp->speed_control_numerator = (int)Xen_numerator(val);
+ sp->speed_control_denominator = (int)Xen_denominator(val);
fval = (mus_float_t)(sp->speed_control_numerator) / (mus_float_t)(sp->speed_control_denominator);
if (sp->speed_control_numerator < 0)
{
@@ -3362,7 +2997,7 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
return(val);
}
#endif
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if (fval != 0.0)
{
int direction;
@@ -3374,55 +3009,55 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
#endif
toggle_direction_arrow(sp, (direction == -1));
if (sp->speed_control_direction == -1)
- return(C_TO_XEN_DOUBLE((-(sp->speed_control))));
- else return(C_TO_XEN_DOUBLE(sp->speed_control));
+ return(C_double_to_Xen_real((-(sp->speed_control))));
+ else return(C_double_to_Xen_real(sp->speed_control));
}
break;
case SP_SPEED_BOUNDS:
- sp->speed_control_min = XEN_TO_C_DOUBLE(XEN_CAR(val));
- sp->speed_control_max = XEN_TO_C_DOUBLE(XEN_CADR(val));
+ sp->speed_control_min = Xen_real_to_C_double(Xen_car(val));
+ sp->speed_control_max = Xen_real_to_C_double(Xen_cadr(val));
set_speed(sp, mus_fclamp(sp->speed_control_min, sp->speed_control, sp->speed_control_max));
return(val);
break;
case SP_REVERB_LENGTH:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if (fval >= 0.0) set_revlen(sp, fval);
- return(C_TO_XEN_DOUBLE(sp->reverb_control_length));
+ return(C_double_to_Xen_real(sp->reverb_control_length));
break;
case SP_REVERB_LENGTH_BOUNDS:
- sp->reverb_control_length_min = XEN_TO_C_DOUBLE(XEN_CAR(val));
- sp->reverb_control_length_max = XEN_TO_C_DOUBLE(XEN_CADR(val));
+ sp->reverb_control_length_min = Xen_real_to_C_double(Xen_car(val));
+ sp->reverb_control_length_max = Xen_real_to_C_double(Xen_cadr(val));
set_revlen(sp, mus_fclamp(sp->reverb_control_length_min, sp->reverb_control_length, sp->reverb_control_length_max));
return(val);
break;
case SP_REVERB_FEEDBACK:
- sp->reverb_control_feedback = mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), 100.0);
+ sp->reverb_control_feedback = mus_fclamp(0.0, Xen_real_to_C_double(val), 100.0);
if (sp->playing) dac_set_reverb_feedback(sp, sp->reverb_control_feedback);
break;
case SP_REVERB_SCALE:
- set_revscl(sp, XEN_TO_C_DOUBLE(val));
- return(C_TO_XEN_DOUBLE(sp->reverb_control_scale));
+ set_revscl(sp, Xen_real_to_C_double(val));
+ return(C_double_to_Xen_real(sp->reverb_control_scale));
break;
case SP_REVERB_SCALE_BOUNDS:
- sp->reverb_control_scale_min = XEN_TO_C_DOUBLE(XEN_CAR(val));
- sp->reverb_control_scale_max = XEN_TO_C_DOUBLE(XEN_CADR(val));
+ sp->reverb_control_scale_min = Xen_real_to_C_double(Xen_car(val));
+ sp->reverb_control_scale_max = Xen_real_to_C_double(Xen_cadr(val));
set_revscl(sp, mus_fclamp(sp->reverb_control_scale_min, sp->reverb_control_scale, sp->reverb_control_scale_max));
return(val);
break;
case SP_REVERB_LOW_PASS:
- sp->reverb_control_lowpass = mus_fclamp(0.0, XEN_TO_C_DOUBLE(val), 1.0);
+ sp->reverb_control_lowpass = mus_fclamp(0.0, Xen_real_to_C_double(val), 1.0);
if (sp->playing) dac_set_reverb_lowpass(sp, sp->reverb_control_lowpass);
break;
case SP_REVERB_DECAY:
- sp->reverb_control_decay = XEN_TO_C_DOUBLE(val);
+ sp->reverb_control_decay = Xen_real_to_C_double(val);
break;
case SP_FILTER_ENVELOPE:
@@ -3430,7 +3065,7 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
env *e = NULL;
if (sp->filter_control_envelope)
sp->filter_control_envelope = free_env(sp->filter_control_envelope); /* set to null in case get_env throws error */
- if (!(XEN_FALSE_P(val)))
+ if (!(Xen_is_false(val)))
e = get_env(val, caller); /* has some error checks -- val must be list, but we can be #f -- see "get" case above: null env (nogui) -> #f */
if (e)
{
@@ -3439,7 +3074,7 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
(e->data[i * 2 + 1] < 0.0))
{
free_env(e);
- XEN_OUT_OF_RANGE_ERROR(caller, 1, val, "y values ~A < 0.0 or > 1.0");
+ Xen_out_of_range_error(caller, 1, val, "y values < 0.0 or > 1.0");
}
sp->filter_control_envelope = e;
filter_env_changed(sp, sp->filter_control_envelope);
@@ -3454,125 +3089,128 @@ static XEN sound_set(XEN snd, XEN val, sp_field_t fld, const char *caller)
}
-static XEN sound_set_global(XEN snd, XEN val, sp_field_t fld, const char *caller)
+static Xen sound_set_global(Xen snd, Xen val, sp_field_t fld, const char *caller)
{
mus_float_t fval;
- if (XEN_NOT_BOUND_P(snd))
+ if (!Xen_is_bound(snd))
switch (fld)
{
case SP_FILTER_DBING:
- in_set_filter_control_in_dB(ss, XEN_TO_C_BOOLEAN(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_filter_control_in_dB(ss, Xen_boolean_to_C_bool(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_FILTER_HZING:
- in_set_filter_control_in_hz(ss, XEN_TO_C_BOOLEAN(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_filter_control_in_hz(ss, Xen_boolean_to_C_bool(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_FILTER_ORDER:
- if (XEN_TO_C_INT(val) > 0)
- in_set_filter_control_order(ss, XEN_TO_C_INT(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ Xen_check_type(Xen_is_integer(val), val, 0, caller, "an integer");
+ if (Xen_integer_to_C_int(val) > 0)
+ in_set_filter_control_order(ss, Xen_integer_to_C_int(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_SHOW_CONTROLS:
- in_set_show_controls(ss, XEN_TO_C_BOOLEAN(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_show_controls(ss, Xen_boolean_to_C_bool(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_SPEED_TONES:
- in_set_speed_control_tones(ss, XEN_TO_C_INT(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ Xen_check_type(Xen_is_integer(val), val, 0, caller, "an integer");
+ in_set_speed_control_tones(ss, Xen_integer_to_C_int(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_SPEED_STYLE:
- in_set_speed_control_style(ss, (speed_style_t)XEN_TO_C_INT(val)); /* range checked already */
- return(sound_set(XEN_TRUE, val, fld, caller));
+ Xen_check_type(Xen_is_integer(val), val, 0, caller, "an integer");
+ in_set_speed_control_style(ss, (speed_style_t)Xen_integer_to_C_int(val)); /* range checked already */
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_AMP_BOUNDS:
- in_set_amp_control_min(ss, XEN_TO_C_DOUBLE(XEN_CAR(val)));
- in_set_amp_control_max(ss, XEN_TO_C_DOUBLE(XEN_CADR(val)));
+ in_set_amp_control_min(ss, Xen_real_to_C_double(Xen_car(val)));
+ in_set_amp_control_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
reflect_mix_change(ANY_MIX_ID);
- return(sound_set(XEN_TRUE, val, fld, caller));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_CONTRAST_BOUNDS:
- in_set_contrast_control_min(ss, XEN_TO_C_DOUBLE(XEN_CAR(val)));
- in_set_contrast_control_max(ss, XEN_TO_C_DOUBLE(XEN_CADR(val)));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_contrast_control_min(ss, Xen_real_to_C_double(Xen_car(val)));
+ in_set_contrast_control_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_CONTRAST_AMP:
- in_set_contrast_control_amp(ss, XEN_TO_C_DOUBLE(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_contrast_control_amp(ss, Xen_real_to_C_double(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_EXPAND_BOUNDS:
- in_set_expand_control_min(ss, XEN_TO_C_DOUBLE(XEN_CAR(val)));
- in_set_expand_control_max(ss, XEN_TO_C_DOUBLE(XEN_CADR(val)));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_expand_control_min(ss, Xen_real_to_C_double(Xen_car(val)));
+ in_set_expand_control_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_EXPAND_LENGTH:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if (fval > 0.0)
in_set_expand_control_length(ss, fval);
- return(sound_set(XEN_TRUE, val, fld, caller));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_EXPAND_RAMP:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if ((fval >= 0.0) && (fval < 0.5))
in_set_expand_control_ramp(ss, fval);
- return(sound_set(XEN_TRUE, val, fld, caller));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_EXPAND_HOP:
- fval = XEN_TO_C_DOUBLE(val);
+ fval = Xen_real_to_C_double(val);
if (fval > 0.0)
in_set_expand_control_hop(ss, fval);
- return(sound_set(XEN_TRUE, val, fld, caller));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_EXPAND_JITTER:
- in_set_expand_control_jitter(ss, XEN_TO_C_DOUBLE(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_expand_control_jitter(ss, Xen_real_to_C_double(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_SPEED_BOUNDS:
- in_set_speed_control_min(ss, XEN_TO_C_DOUBLE(XEN_CAR(val)));
- in_set_speed_control_max(ss, XEN_TO_C_DOUBLE(XEN_CADR(val)));
+ in_set_speed_control_min(ss, Xen_real_to_C_double(Xen_car(val)));
+ in_set_speed_control_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
reflect_mix_change(ANY_MIX_ID);
- return(sound_set(XEN_TRUE, val, fld, caller));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_REVERB_LENGTH_BOUNDS:
- in_set_reverb_control_length_min(ss, XEN_TO_C_DOUBLE(XEN_CAR(val)));
- in_set_reverb_control_length_max(ss, XEN_TO_C_DOUBLE(XEN_CADR(val)));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_reverb_control_length_min(ss, Xen_real_to_C_double(Xen_car(val)));
+ in_set_reverb_control_length_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_REVERB_FEEDBACK:
- in_set_reverb_control_feedback(ss, XEN_TO_C_DOUBLE(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_reverb_control_feedback(ss, Xen_real_to_C_double(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_REVERB_SCALE_BOUNDS:
- in_set_reverb_control_scale_min(ss, XEN_TO_C_DOUBLE(XEN_CAR(val)));
- in_set_reverb_control_scale_max(ss, XEN_TO_C_DOUBLE(XEN_CADR(val)));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_reverb_control_scale_min(ss, Xen_real_to_C_double(Xen_car(val)));
+ in_set_reverb_control_scale_max(ss, Xen_real_to_C_double(Xen_cadr(val)));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_REVERB_LOW_PASS:
- in_set_reverb_control_lowpass(ss, XEN_TO_C_DOUBLE(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_reverb_control_lowpass(ss, Xen_real_to_C_double(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
case SP_REVERB_DECAY:
- in_set_reverb_control_decay(ss, XEN_TO_C_DOUBLE(val));
- return(sound_set(XEN_TRUE, val, fld, caller));
+ in_set_reverb_control_decay(ss, Xen_real_to_C_double(val));
+ return(sound_set(Xen_true, val, fld, caller));
break;
default: break;
@@ -3581,239 +3219,248 @@ static XEN sound_set_global(XEN snd, XEN val, sp_field_t fld, const char *caller
}
-static XEN g_channels(XEN snd)
+static Xen g_channels(Xen snd)
{
#define H_channels "(" S_channels " :optional obj): how many channels the object obj has"
- if (XEN_STRING_P(snd))
+ if (Xen_is_string(snd))
return(g_mus_sound_chans(snd)); /* mus-sound-chans */
- if ((mus_xen_p(snd)) ||
- (sound_data_p(snd)) || /* sound-data-chans */
- (MUS_VCT_P(snd)) ||
- (XEN_LIST_P(snd)))
+ if ((mus_is_xen(snd)) ||
+ (mus_is_vct(snd)) ||
+ (Xen_is_list(snd)))
return(g_mus_channels(snd)); /* mus-channels */
- if (XEN_MIX_P(snd)) /* mixes are always 1 chan */
- return(C_TO_XEN_INT(1));
+ if (xen_is_mix(snd)) /* mixes are always 1 chan */
+ return(C_int_to_Xen_integer(1));
- if (XEN_REGION_P(snd)) /* region-chans */
+ if (xen_is_region(snd)) /* region-chans */
return(g_region_chans(snd));
- if (XEN_SELECTION_P(snd)) /* selection-chans */
+ if (xen_is_selection(snd)) /* selection-chans */
return(g_selection_chans());
+ if (Xen_is_vector(snd)) /* vector as output in clm */
+ return(C_int_to_Xen_integer(Xen_vector_rank(snd)));
+
return(sound_get(snd, SP_NCHANS, S_channels));
}
-static XEN check_number(XEN val, const char *caller)
+static Xen check_number(Xen val, const char *caller)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, caller, "a number");
+ Xen_check_type(Xen_is_number(val), val, 1, caller, "a number");
return(val);
}
-static XEN g_set_channels(XEN snd, XEN val)
+static Xen check_non_negative_integer(Xen val, const char *caller)
{
- if (XEN_NOT_BOUND_P(val))
- return(sound_set(XEN_UNDEFINED, check_number(snd, S_setB S_channels), SP_NCHANS, S_setB S_channels));
- else return(sound_set(snd, check_number(val, S_setB S_channels), SP_NCHANS, S_setB S_channels));
+ Xen_check_type(Xen_is_integer(val) && (Xen_integer_to_C_int(val) >= 0), val, 1, caller, "a non-negative integer");
+ return(val);
+}
+
+
+static Xen g_set_channels(Xen snd, Xen val)
+{
+ if (!Xen_is_bound(val))
+ return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_channels), SP_NCHANS, S_set S_channels));
+ else return(sound_set(snd, check_non_negative_integer(val, S_set S_channels), SP_NCHANS, S_set S_channels));
}
-static XEN g_srate(XEN snd)
+static Xen g_srate(Xen snd)
{
#define H_srate "(" S_srate " :optional obj): obj's srate; obj can be a region, a string (sound file name), a sound, or an integer (sound index)"
- if (XEN_STRING_P(snd))
+ if (Xen_is_string(snd))
return(g_mus_sound_srate(snd));
- if (XEN_REGION_P(snd))
+ if (xen_is_region(snd))
return(g_region_srate(snd));
- if (XEN_SELECTION_P(snd))
+ if (xen_is_selection(snd))
return(g_selection_srate());
return(sound_get(snd, SP_SRATE, S_srate));
}
-static XEN g_set_srate(XEN snd, XEN val)
+static Xen g_set_srate(Xen snd, Xen val)
{
- if (XEN_NOT_BOUND_P(val))
- return(sound_set(XEN_UNDEFINED, check_number(snd, S_setB S_srate), SP_SRATE, S_setB S_srate));
- else return(sound_set(snd, check_number(val, S_setB S_srate), SP_SRATE, S_setB S_srate));
+ if (!Xen_is_bound(val))
+ return(sound_set(Xen_undefined, check_number(snd, S_set S_srate), SP_SRATE, S_set S_srate));
+ else return(sound_set(snd, check_number(val, S_set S_srate), SP_SRATE, S_set S_srate));
}
-static XEN g_data_location(XEN snd)
+static Xen g_data_location(Xen snd)
{
#define H_data_location "(" S_data_location " :optional snd): snd's data location (bytes)"
return(sound_get(snd, SP_DATA_LOCATION, S_data_location));
}
-static XEN g_set_data_location(XEN snd, XEN val)
+static Xen g_set_data_location(Xen snd, Xen val)
{
- if (XEN_NOT_BOUND_P(val))
- return(sound_set(XEN_UNDEFINED, check_number(snd, S_setB S_data_location), SP_DATA_LOCATION, S_setB S_data_location));
- else return(sound_set(snd, check_number(val, S_setB S_data_location), SP_DATA_LOCATION, S_setB S_data_location));
+ if (!Xen_is_bound(val))
+ return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_data_location), SP_DATA_LOCATION, S_set S_data_location));
+ else return(sound_set(snd, check_non_negative_integer(val, S_set S_data_location), SP_DATA_LOCATION, S_set S_data_location));
}
-static XEN g_data_size(XEN snd)
+static Xen g_data_size(Xen snd)
{
#define H_data_size "(" S_data_size " :optional snd): snd's data size (bytes)"
return(sound_get(snd, SP_DATA_SIZE, S_data_size));
}
-static XEN g_set_data_size(XEN snd, XEN val)
+static Xen g_set_data_size(Xen snd, Xen val)
{
- if (XEN_NOT_BOUND_P(val))
- return(sound_set(XEN_UNDEFINED, check_number(snd, S_setB S_data_size), SP_DATA_SIZE, S_setB S_data_size));
- else return(sound_set(snd, check_number(val, S_setB S_data_size), SP_DATA_SIZE, S_setB S_data_size));
+ if (!Xen_is_bound(val))
+ return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_data_size), SP_DATA_SIZE, S_set S_data_size));
+ else return(sound_set(snd, check_non_negative_integer(val, S_set S_data_size), SP_DATA_SIZE, S_set S_data_size));
}
-static XEN g_data_format(XEN snd)
+static Xen g_sample_type(Xen snd)
{
- #define H_data_format "(" S_data_format " :optional snd): snd's data format (e.g. " S_mus_bshort ")"
- return(sound_get(snd, SP_DATA_FORMAT, S_data_format));
+ #define H_sample_type "(" S_sample_type " :optional snd): snd's sample type (e.g. " S_mus_bshort ")"
+ return(sound_get(snd, SP_SAMPLE_TYPE, S_sample_type));
}
-static XEN g_set_data_format(XEN snd, XEN val)
+static Xen g_set_sample_type(Xen snd, Xen val)
{
- if (XEN_NOT_BOUND_P(val))
- return(sound_set(XEN_UNDEFINED, check_number(snd, S_setB S_data_format), SP_DATA_FORMAT, S_setB S_data_format));
- else return(sound_set(snd, check_number(val, S_setB S_data_format), SP_DATA_FORMAT, S_setB S_data_format));
+ if (!Xen_is_bound(val))
+ return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_sample_type), SP_SAMPLE_TYPE, S_set S_sample_type));
+ else return(sound_set(snd, check_non_negative_integer(val, S_set S_sample_type), SP_SAMPLE_TYPE, S_set S_sample_type));
}
-static XEN g_header_type(XEN snd)
+static Xen g_header_type(Xen snd)
{
#define H_header_type "(" S_header_type " :optional snd): snd's header type (e.g. " S_mus_aiff ")"
return(sound_get(snd, SP_HEADER_TYPE, S_header_type));
}
-static XEN g_set_header_type(XEN snd, XEN val)
+static Xen g_set_header_type(Xen snd, Xen val)
{
- if (XEN_NOT_BOUND_P(val))
- return(sound_set(XEN_UNDEFINED, check_number(snd, S_setB S_header_type), SP_HEADER_TYPE, S_setB S_header_type));
- else return(sound_set(snd, check_number(val, S_setB S_header_type), SP_HEADER_TYPE, S_setB S_header_type));
+ if (!Xen_is_bound(val))
+ return(sound_set(Xen_undefined, check_non_negative_integer(snd, S_set S_header_type), SP_HEADER_TYPE, S_set S_header_type));
+ else return(sound_set(snd, check_non_negative_integer(val, S_set S_header_type), SP_HEADER_TYPE, S_set S_header_type));
}
-static XEN g_comment(XEN snd)
+static Xen g_comment(Xen snd)
{
#define H_comment "(" S_comment " :optional snd): snd's comment (in its header)"
return(sound_get(snd, SP_COMMENT, S_comment));
}
-static XEN g_set_comment(XEN snd, XEN val)
+static Xen g_set_comment(Xen snd, Xen val)
{
- if (XEN_NOT_BOUND_P(val))
+ if (!Xen_is_bound(val))
{
- XEN_ASSERT_TYPE(XEN_STRING_P(snd) || XEN_FALSE_P(snd), snd, XEN_ARG_1, S_setB S_comment, "a string");
- return(sound_set(XEN_UNDEFINED, snd, SP_COMMENT, S_setB S_comment));
+ Xen_check_type(Xen_is_string(snd) || Xen_is_false(snd), snd, 1, S_set S_comment, "a string");
+ return(sound_set(Xen_undefined, snd, SP_COMMENT, S_set S_comment));
}
- XEN_ASSERT_TYPE(XEN_STRING_P(val) || XEN_FALSE_P(val), val, XEN_ARG_2, S_setB S_comment, "a string");
- return(sound_set(snd, val, SP_COMMENT, S_setB S_comment));
+ Xen_check_type(Xen_is_string(val) || Xen_is_false(val), val, 2, S_set S_comment, "a string");
+ return(sound_set(snd, val, SP_COMMENT, S_set S_comment));
}
-static XEN g_sync(XEN snd)
+static Xen g_sync(Xen snd)
{
#define H_sync "(" S_sync " :optional snd): snd's sync value (0 = no sync). Some editing operations \
are applied to all sounds sharing the sync value of the selected sound. 'snd' can also be a mix or mark object."
- if (XEN_MIX_P(snd)) /* mix-sync */
+ if (xen_is_mix(snd)) /* mix-sync */
return(g_mix_sync(snd));
- if (XEN_MARK_P(snd)) /* mark-sync */
+ if (xen_is_mark(snd)) /* mark-sync */
return(g_mark_sync(snd));
return(sound_get(snd, SP_SYNC, S_sync)); /* sync */
}
-static XEN g_set_sync(XEN on, XEN snd)
+static Xen g_set_sync(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_sync, "an integer");
+ Xen_check_type(Xen_is_integer_or_boolean(on), on, 1, S_set S_sync, "an integer");
- if (XEN_MIX_P(snd))
+ if (xen_is_mix(snd))
return(g_set_mix_sync(snd, on));
- if (XEN_MARK_P(snd))
+ if (xen_is_mark(snd))
return(g_set_mark_sync(snd, on));
- return(sound_set(snd, on, SP_SYNC, S_setB S_sync));
+ return(sound_set(snd, on, SP_SYNC, S_set S_sync));
}
-WITH_TWO_SETTER_ARGS(g_set_sync_reversed, g_set_sync)
+with_two_setter_args(g_set_sync_reversed, g_set_sync)
-static XEN g_sync_max(void)
+static Xen g_sync_max(void)
{
#define H_sync_max "(" S_sync_max "): max sound sync value seen so far"
- return(C_TO_XEN_INT(ss->sound_sync_max));
+ return(C_int_to_Xen_integer(ss->sound_sync_max));
}
-static XEN g_sound_properties(XEN snd)
+static Xen g_sound_properties(Xen snd)
{
#define H_sound_properties "(" S_sound_properties " :optional snd): snd's property list"
return(sound_get(snd, SP_PROPERTIES, S_sound_properties));
}
-static XEN g_set_sound_properties(XEN on, XEN snd)
+static Xen g_set_sound_properties(Xen on, Xen snd)
{
- return(sound_set(snd, on, SP_PROPERTIES, S_setB S_sound_properties));
+ return(sound_set(snd, on, SP_PROPERTIES, S_set S_sound_properties));
}
-WITH_TWO_SETTER_ARGS(g_set_sound_properties_reversed, g_set_sound_properties)
+with_two_setter_args(g_set_sound_properties_reversed, g_set_sound_properties)
-static XEN g_sound_property(XEN key, XEN snd)
+static Xen g_sound_property(Xen key, Xen snd)
{
#define H_sound_property "(" S_sound_property " key snd) returns the value associated with 'key' in the given sound's\
property list, or " PROC_FALSE "."
- return(XEN_ASSOC_REF(key, g_sound_properties(snd)));
+ return(Xen_assoc_ref(key, g_sound_properties(snd)));
}
#if HAVE_SCHEME
-static XEN g_set_sound_property(XEN val, XEN key, XEN snd)
+static Xen g_set_sound_property(Xen val, Xen key, Xen snd)
#else
-static XEN g_set_sound_property(XEN key, XEN val, XEN snd)
+static Xen g_set_sound_property(Xen key, Xen val, Xen snd)
#endif
{
- g_set_sound_properties(XEN_ASSOC_SET(key, val, g_sound_properties(snd)), snd);
+ g_set_sound_properties(Xen_assoc_set(key, val, g_sound_properties(snd)), snd);
return(val);
}
-WITH_THREE_SETTER_ARGS(g_set_sound_property_reversed, g_set_sound_property)
+with_three_setter_args(g_set_sound_property_reversed, g_set_sound_property)
-static XEN g_channel_style(XEN snd)
+static Xen g_channel_style(Xen snd)
{
snd_info *sp;
- if (XEN_NOT_BOUND_P(snd))
- return(C_TO_XEN_INT(channel_style(ss)));
+ if (!Xen_is_bound(snd))
+ return(C_int_to_Xen_integer(channel_style(ss)));
- ASSERT_SOUND(S_channel_style, snd, 1);
+ Snd_assert_sound(S_channel_style, snd, 1);
sp = get_sp(snd);
if (sp == NULL)
return(snd_no_such_sound_error(S_channel_style, snd));
- return(C_TO_XEN_INT((int)(sp->channel_style)));
+ return(C_int_to_Xen_integer((int)(sp->channel_style)));
}
@@ -3841,7 +3488,7 @@ void set_channel_style(channel_style_t val)
}
-static XEN g_set_channel_style(XEN style, XEN snd)
+static Xen g_set_channel_style(Xen style, Xen snd)
{
snd_info *sp;
int in_style;
@@ -3851,282 +3498,281 @@ static XEN g_set_channel_style(XEN style, XEN snd)
The default is " S_channels_combined "; other values are " S_channels_separate " and " S_channels_superimposed ". \
As a global (if the 'snd' arg is omitted), it is the default setting for each sound's 'unite' button."
- XEN_ASSERT_TYPE(XEN_INTEGER_P(style), style, XEN_ARG_1, S_setB S_channel_style, "an integer");
- in_style = XEN_TO_C_INT(style);
- if (in_style < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_channel_style, 1, style, "~A, but must be >= 0");
- if (in_style >= NUM_CHANNEL_STYLES)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_channel_style, 1, style, "~A, but must be " S_channels_separate ", " S_channels_combined ", or " S_channels_superimposed);
+ Xen_check_type(Xen_is_integer(style), style, 1, S_set S_channel_style, "an integer");
+ in_style = Xen_integer_to_C_int(style);
+ if ((in_style < 0) ||
+ (in_style >= NUM_CHANNEL_STYLES))
+ Xen_out_of_range_error(S_set S_channel_style, 1, style, S_channel_style " should be " S_channels_separate ", " S_channels_combined ", or " S_channels_superimposed);
new_style = (channel_style_t)in_style;
- if (XEN_NOT_BOUND_P(snd))
+ if (!Xen_is_bound(snd))
{
set_channel_style(new_style);
- return(C_TO_XEN_INT(channel_style(ss)));
+ return(C_int_to_Xen_integer(channel_style(ss)));
}
- ASSERT_SOUND(S_setB S_channel_style, snd, 2);
+ Snd_assert_sound(S_set S_channel_style, snd, 2);
sp = get_sp(snd);
if (sp == NULL)
- return(snd_no_such_sound_error(S_setB S_channel_style, snd));
+ return(snd_no_such_sound_error(S_set S_channel_style, snd));
set_sound_channel_style(sp, new_style);
- return(C_TO_XEN_INT((int)(sp->channel_style)));
+ return(C_int_to_Xen_integer((int)(sp->channel_style)));
}
-WITH_TWO_SETTER_ARGS(g_set_channel_style_reversed, g_set_channel_style)
+with_two_setter_args(g_set_channel_style_reversed, g_set_channel_style)
-static XEN g_read_only(XEN snd)
+static Xen g_read_only(Xen snd)
{
#define H_read_only "(" S_read_only " :optional snd): whether snd is write-protected"
return(sound_get(snd, SP_READ_ONLY, S_read_only));
}
-static XEN g_set_read_only(XEN on, XEN snd)
+static Xen g_set_read_only(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_read_only, "a boolean");
- return(sound_set(snd, on, SP_READ_ONLY, S_setB S_read_only));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_read_only, "a boolean");
+ return(sound_set(snd, on, SP_READ_ONLY, S_set S_read_only));
}
-WITH_TWO_SETTER_ARGS(g_set_read_only_reversed, g_set_read_only)
+with_two_setter_args(g_set_read_only_reversed, g_set_read_only)
-static XEN g_contrast_control_p(XEN snd)
+static Xen g_contrast_control_on(Xen snd)
{
- #define H_contrast_control_p "(" S_contrast_control_p " :optional snd): snd's control panel constrast button state"
- return(sound_get(snd, SP_CONTRASTING, S_contrast_control_p));
+ #define H_contrast_control_on "(" S_contrast_control_on " :optional snd): snd's control panel constrast button state"
+ return(sound_get(snd, SP_CONTRASTING, S_contrast_control_on));
}
-static XEN g_set_contrast_control_p(XEN on, XEN snd)
+static Xen g_set_contrast_control_on(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_contrast_control_p, "a boolean");
- return(sound_set(snd, on, SP_CONTRASTING, S_setB S_contrast_control_p));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_contrast_control_on, "a boolean");
+ return(sound_set(snd, on, SP_CONTRASTING, S_set S_contrast_control_on));
}
-WITH_TWO_SETTER_ARGS(g_set_contrast_control_p_reversed, g_set_contrast_control_p)
+with_two_setter_args(g_set_contrast_control_on_reversed, g_set_contrast_control_on)
-static XEN g_expand_control_p(XEN snd)
+static Xen g_expand_control_on(Xen snd)
{
- #define H_expand_control_p "(" S_expand_control_p " :optional snd): snd's control panel expand button state"
- return(sound_get(snd, SP_EXPANDING, S_expand_control_p));
+ #define H_expand_control_on "(" S_expand_control_on " :optional snd): snd's control panel expand button state"
+ return(sound_get(snd, SP_EXPANDING, S_expand_control_on));
}
-static XEN g_set_expand_control_p(XEN on, XEN snd)
+static Xen g_set_expand_control_on(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_expand_control_p, "a boolean");
- return(sound_set(snd, on, SP_EXPANDING, S_setB S_expand_control_p));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_expand_control_on, "a boolean");
+ return(sound_set(snd, on, SP_EXPANDING, S_set S_expand_control_on));
}
-WITH_TWO_SETTER_ARGS(g_set_expand_control_p_reversed, g_set_expand_control_p)
+with_two_setter_args(g_set_expand_control_on_reversed, g_set_expand_control_on)
-static XEN g_reverb_control_p(XEN snd)
+static Xen g_reverb_control_on(Xen snd)
{
- #define H_reverb_control_p "(" S_reverb_control_p " :optional snd): snd's control panel reverb button state"
- return(sound_get(snd, SP_REVERBING, S_reverb_control_p));
+ #define H_reverb_control_on "(" S_reverb_control_on " :optional snd): snd's control panel reverb button state"
+ return(sound_get(snd, SP_REVERBING, S_reverb_control_on));
}
-static XEN g_set_reverb_control_p(XEN on, XEN snd)
+static Xen g_set_reverb_control_on(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_reverb_control_p, "a boolean");
- return(sound_set(snd, on, SP_REVERBING, S_setB S_reverb_control_p));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_reverb_control_on, "a boolean");
+ return(sound_set(snd, on, SP_REVERBING, S_set S_reverb_control_on));
}
-WITH_TWO_SETTER_ARGS(g_set_reverb_control_p_reversed, g_set_reverb_control_p)
+with_two_setter_args(g_set_reverb_control_on_reversed, g_set_reverb_control_on)
-static XEN g_filter_control_p(XEN snd)
+static Xen g_filter_control_on(Xen snd)
{
- #define H_filter_control_p "(" S_filter_control_p " :optional snd): snd's control panel filter button state"
- return(sound_get(snd, SP_FILTERING, S_filter_control_p));
+ #define H_filter_control_on "(" S_filter_control_on " :optional snd): snd's control panel filter button state"
+ return(sound_get(snd, SP_FILTERING, S_filter_control_on));
}
-static XEN g_set_filter_control_p(XEN on, XEN snd)
+static Xen g_set_filter_control_on(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_filter_control_p, "a boolean");
- return(sound_set(snd, on, SP_FILTERING, S_setB S_filter_control_p));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_filter_control_on, "a boolean");
+ return(sound_set(snd, on, SP_FILTERING, S_set S_filter_control_on));
}
-WITH_TWO_SETTER_ARGS(g_set_filter_control_p_reversed, g_set_filter_control_p)
+with_two_setter_args(g_set_filter_control_on_reversed, g_set_filter_control_on)
-static XEN g_filter_control_in_dB(XEN snd)
+static Xen g_filter_control_in_dB(Xen snd)
{
#define H_filter_control_in_dB "(" S_filter_control_in_dB " :optional snd): " PROC_TRUE " if snd's filter envelope is displayed in dB in control panel"
return(sound_get_global(snd, SP_FILTER_DBING, S_filter_control_in_dB));
}
-static XEN g_set_filter_control_in_dB(XEN on, XEN snd)
+static Xen g_set_filter_control_in_dB(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_filter_control_in_dB, "a boolean");
- return(sound_set_global(snd, on, SP_FILTER_DBING, S_setB S_filter_control_in_dB));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_filter_control_in_dB, "a boolean");
+ return(sound_set_global(snd, on, SP_FILTER_DBING, S_set S_filter_control_in_dB));
}
-WITH_TWO_SETTER_ARGS(g_set_filter_control_in_dB_reversed, g_set_filter_control_in_dB)
+with_two_setter_args(g_set_filter_control_in_dB_reversed, g_set_filter_control_in_dB)
-static XEN g_filter_control_in_hz(XEN snd)
+static Xen g_filter_control_in_hz(Xen snd)
{
#define H_filter_control_in_hz "(" S_filter_control_in_hz " :optional snd): " PROC_TRUE " if snd's filter envelope x axis should be in hz (control panel filter)"
return(sound_get_global(snd, SP_FILTER_HZING, S_filter_control_in_hz));
}
-static XEN g_set_filter_control_in_hz(XEN on, XEN snd)
+static Xen g_set_filter_control_in_hz(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_filter_control_in_hz, "a boolean");
- return(sound_set_global(snd, on, SP_FILTER_HZING, S_setB S_filter_control_in_hz));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_filter_control_in_hz, "a boolean");
+ return(sound_set_global(snd, on, SP_FILTER_HZING, S_set S_filter_control_in_hz));
}
-WITH_TWO_SETTER_ARGS(g_set_filter_control_in_hz_reversed, g_set_filter_control_in_hz)
+with_two_setter_args(g_set_filter_control_in_hz_reversed, g_set_filter_control_in_hz)
-static XEN g_filter_control_coeffs(XEN snd)
+static Xen g_filter_control_coeffs(Xen snd)
{
#define H_filter_control_coeffs "(" S_filter_control_coeffs " :optional snd): control panel filter coeffs"
return(sound_get(snd, SP_FILTER_COEFFS, S_filter_control_coeffs));
}
-static XEN g_filter_control_order(XEN snd)
+static Xen g_filter_control_order(Xen snd)
{
#define H_filter_control_order "(" S_filter_control_order " :optional snd): filter order (in control panel)"
return(sound_get_global(snd, SP_FILTER_ORDER, S_filter_control_order));
}
-static XEN g_set_filter_control_order(XEN on, XEN snd)
+static Xen g_set_filter_control_order(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(on), on, XEN_ARG_1, S_setB S_filter_control_order, "an integer");
- return(sound_set_global(snd, on, SP_FILTER_ORDER, S_setB S_filter_control_order));
+ Xen_check_type(Xen_is_integer(on), on, 1, S_set S_filter_control_order, "an integer");
+ return(sound_set_global(snd, on, SP_FILTER_ORDER, S_set S_filter_control_order));
}
-WITH_TWO_SETTER_ARGS(g_set_filter_control_order_reversed, g_set_filter_control_order)
+with_two_setter_args(g_set_filter_control_order_reversed, g_set_filter_control_order)
-static XEN g_show_controls(XEN snd)
+static Xen g_show_controls(Xen snd)
{
#define H_show_controls "(" S_show_controls " :optional snd): " PROC_TRUE " if snd's control panel is known to be open"
return(sound_get_global(snd, SP_SHOW_CONTROLS, S_show_controls));
}
-static XEN g_set_show_controls(XEN on, XEN snd)
+static Xen g_set_show_controls(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(on), on, XEN_ARG_1, S_setB S_show_controls, "a boolean");
- return(sound_set_global(snd, on, SP_SHOW_CONTROLS, S_setB S_show_controls));
+ Xen_check_type(Xen_is_boolean(on), on, 1, S_set S_show_controls, "a boolean");
+ return(sound_set_global(snd, on, SP_SHOW_CONTROLS, S_set S_show_controls));
}
-WITH_TWO_SETTER_ARGS(g_set_show_controls_reversed, g_set_show_controls)
+with_two_setter_args(g_set_show_controls_reversed, g_set_show_controls)
-static XEN g_save_controls(XEN snd)
+static Xen g_save_controls(Xen snd)
{
#define H_save_controls "(" S_save_controls " :optional snd): save the control panel settings for subsequent " S_restore_controls
return(sound_get(snd, SP_SAVE_CONTROLS, S_save_controls));
}
-static XEN g_restore_controls(XEN snd)
+static Xen g_restore_controls(Xen snd)
{
#define H_restore_controls "(" S_restore_controls " :optional snd): restore the previously saved control panel settings"
return(sound_get(snd, SP_RESTORE_CONTROLS, S_restore_controls));
}
-static XEN g_reset_controls(XEN snd)
+static Xen g_reset_controls(Xen snd)
{
#define H_reset_controls "(" S_reset_controls " :optional snd): reset (clear) the control panel settings"
return(sound_get(snd, SP_RESET_CONTROLS, S_reset_controls));
}
-static XEN g_selected_channel(XEN snd)
+static Xen g_selected_channel(Xen snd)
{
#define H_selected_channel "(" S_selected_channel " :optional snd): currently selected channel in snd (or " PROC_FALSE " if none)"
return(sound_get(snd, SP_SELECTED_CHANNEL, S_selected_channel));
}
-static XEN g_set_selected_channel(XEN snd, XEN chn_n)
+static Xen g_set_selected_channel(Xen snd, Xen chn_n)
{
snd_info *sp;
- if (XEN_NOT_BOUND_P(chn_n))
+ if (!Xen_is_bound(chn_n))
return(g_select_channel(snd));
- ASSERT_SOUND(S_setB S_selected_channel, snd, 1);
+ Snd_assert_sound(S_set S_selected_channel, snd, 1);
sp = get_sp(snd);
if (sp == NULL)
- return(snd_no_such_sound_error(S_setB S_selected_channel, snd));
+ return(snd_no_such_sound_error(S_set S_selected_channel, snd));
- if (XEN_FALSE_P(chn_n))
+ if (Xen_is_false(chn_n))
sp->selected_channel = NO_SELECTION;
else
{
- int chan;
- chan = XEN_TO_C_INT_OR_ELSE(chn_n, 0);
+ mus_long_t chan = 0;
+ if (Xen_is_integer(chn_n)) chan = Xen_integer_to_C_int(chn_n);
if ((chan >= 0) &&
(chan < sp->nchans))
{
- select_channel(sp, chan);
+ select_channel(sp, (int)chan);
return(chn_n);
}
- return(snd_no_such_channel_error(S_setB S_selected_channel, snd, chn_n));
+ return(snd_no_such_channel_error(S_set S_selected_channel, snd, chn_n));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_file_name(XEN snd)
+static Xen g_file_name(Xen snd)
{
#define H_file_name "(" S_file_name " :optional snd): snd's full filename; snd can be a sound, mix, region, string, or generator."
- if (XEN_SOUND_P(snd))
+ if (xen_is_sound(snd))
return(sound_get(snd, SP_FILE_NAME, S_file_name));
- if (mus_xen_p(snd))
+ if (mus_is_xen(snd))
return(g_mus_file_name(snd));
- if (XEN_MIX_P(snd))
- return(C_TO_XEN_STRING(mix_file_name(XEN_MIX_TO_C_INT(snd))));
+ if (xen_is_mix(snd))
+ return(C_string_to_Xen_string(mix_file_name(Xen_mix_to_C_int(snd))));
- if (XEN_REGION_P(snd))
- return(C_TO_XEN_STRING(region_file_name(XEN_REGION_TO_C_INT(snd))));
+ if (xen_is_region(snd))
+ return(C_string_to_Xen_string(region_file_name(Xen_region_to_C_int(snd))));
#if HAVE_SCHEME
if ((s7_is_input_port(s7, snd)) || (s7_is_output_port(s7, snd)))
- return(C_TO_XEN_STRING(s7_port_filename(snd)));
+ return(C_string_to_Xen_string(s7_port_filename(snd)));
#endif
- if (XEN_STRING_P(snd))
+ if (Xen_is_string(snd))
return(g_mus_expand_filename(snd));
- if ((sampler_p(snd)) || (mix_sampler_p(snd)))
+ if ((is_sampler(snd)) || (is_mix_sampler(snd)))
return(g_sampler_file_name(snd));
return(sound_get(snd, SP_FILE_NAME, S_file_name));
}
-static XEN g_short_file_name(XEN snd)
+static Xen g_short_file_name(Xen snd)
{
#define H_short_file_name "(" S_short_file_name " :optional snd): short form of snd's file name (no directory)"
return(sound_get(snd, SP_SHORT_FILE_NAME, S_short_file_name));
}
-static XEN g_close_sound_1(int snd)
+static Xen g_close_sound_1(int snd)
{
if ((snd >= 0) &&
(snd < ss->max_sounds))
@@ -4144,25 +3790,25 @@ static XEN g_close_sound_1(int snd)
else snd_close_file(sp);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_close_sound(XEN snd)
+static Xen g_close_sound(Xen snd)
{
#define H_close_sound "(" S_close_sound " :optional snd): close snd"
- if (XEN_INTEGER_P(snd))
- return(g_close_sound_1(XEN_TO_C_INT(snd)));
+ if (Xen_is_integer(snd))
+ return(g_close_sound_1(Xen_integer_to_C_int(snd)));
- if (XEN_SOUND_P(snd))
- return(g_close_sound_1(XEN_SOUND_TO_C_INT(snd)));
+ if (xen_is_sound(snd))
+ return(g_close_sound_1(Xen_sound_to_C_int(snd)));
return(sound_get(snd, SP_CLOSE, S_close_sound));
}
-static XEN g_update_sound(XEN snd)
+static Xen g_update_sound(Xen snd)
{
#define H_update_sound "(" S_update_sound " :optional snd): update snd (re-read it from the disk after flushing pending edits)"
return(sound_get(snd, SP_UPDATE, S_update_sound));
@@ -4173,20 +3819,20 @@ static void save_sound_error_handler(const char *msg, void *data)
{
redirect_snd_error_to(NULL, NULL);
redirect_snd_warning_to(NULL, NULL);
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING("~A: ~A"),
- C_TO_XEN_STRING((char *)data),
- C_TO_XEN_STRING(msg)));
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string("~A: ~A"),
+ C_string_to_Xen_string((char *)data),
+ C_string_to_Xen_string(msg)));
}
-static XEN g_save_sound(XEN index)
+static Xen g_save_sound(Xen index)
{
snd_info *sp;
io_error_t err = IO_NO_ERROR;
#define H_save_sound "(" S_save_sound " :optional snd): save snd (update the on-disk data to match Snd's current version)"
- ASSERT_SOUND(S_save_sound, index, 1);
+ Snd_assert_sound(S_save_sound, index, 1);
sp = get_sp(index);
if (sp == NULL)
@@ -4196,16 +3842,16 @@ static XEN g_save_sound(XEN index)
(sp->file_read_only == FILE_READ_ONLY))
{
char *msg;
- XEN str;
+ Xen str;
msg = mus_format("%s (index %d) is write-protected",
sp->short_filename,
sp->index);
- str = C_TO_XEN_STRING(msg);
+ str = C_string_to_Xen_string(msg);
free(msg);
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_save_sound ": can't save sound, ~A"),
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_save_sound ": can't save sound, ~A"),
str));
- return(XEN_FALSE);
+ return(Xen_false);
}
redirect_snd_error_to(save_sound_error_handler, (void *)S_save_sound);
@@ -4215,22 +3861,22 @@ static XEN g_save_sound(XEN index)
redirect_snd_warning_to(NULL, NULL);
/* if err and we got here, report it */
- if (SERIOUS_IO_ERROR(err))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_save_sound ": IO error ~A"),
- C_TO_XEN_STRING(io_error_name(err))));
+ if (is_serious_io_error(err))
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_save_sound ": IO error ~A"),
+ C_string_to_Xen_string(io_error_name(err))));
- return(C_INT_TO_XEN_SOUND(sp->index));
+ return(C_int_to_Xen_sound(sp->index));
}
-static XEN g_revert_sound(XEN index)
+static Xen g_revert_sound(Xen index)
{
#define H_revert_sound "(" S_revert_sound " :optional snd): revert snd to its unedited state (undo all)"
snd_info *sp;
int i;
- ASSERT_SOUND(S_revert_sound, index, 1);
+ Snd_assert_sound(S_revert_sound, index, 1);
sp = get_sp(index);
if (sp == NULL)
@@ -4247,14 +3893,14 @@ static XEN g_revert_sound(XEN index)
}
-static XEN g_selected_sound(void)
+static Xen g_selected_sound(void)
{
#define H_selected_sound "(" S_selected_sound "): currently selected sound (or " PROC_FALSE " if none)"
if ((ss->selected_sound != NO_SELECTION) &&
(snd_ok(ss->sounds[ss->selected_sound])))
- return(C_INT_TO_XEN_SOUND(ss->selected_sound));
+ return(C_int_to_Xen_sound(ss->selected_sound));
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -4262,14 +3908,14 @@ static void open_sound_error_handler(const char *msg, void *data)
{
redirect_snd_error_to(NULL, NULL);
redirect_snd_warning_to(NULL, NULL);
- XEN_ERROR(XEN_ERROR_TYPE("not-a-sound-file"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: ~A"),
- C_TO_XEN_STRING((char *)data),
- C_TO_XEN_STRING(msg)));
+ Xen_error(Xen_make_error_type("not-a-sound-file"),
+ Xen_list_3(C_string_to_Xen_string("~A: ~A"),
+ C_string_to_Xen_string((char *)data),
+ C_string_to_Xen_string(msg)));
}
-static XEN g_open_sound(XEN filename)
+static Xen g_open_sound(Xen filename)
{
/* return new sound if successful */
#define H_open_sound "(" S_open_sound " filename): \
@@ -4279,9 +3925,9 @@ open filename (as if opened from File:Open menu option), and return the new soun
snd_info *sp;
bool file_exists;
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ONLY_ARG, S_open_sound, "a string");
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_open_sound, "a string");
- fname = XEN_TO_C_STRING(filename);
+ fname = Xen_string_to_C_string(filename);
{
char *fullname;
/* before probing, need to undo all the Unix-isms */
@@ -4299,72 +3945,78 @@ open filename (as if opened from File:Open menu option), and return the new soun
redirect_snd_error_to(NULL, NULL);
if (sp)
- return(C_INT_TO_XEN_SOUND(sp->index));
+ return(C_int_to_Xen_sound(sp->index));
/* sp NULL is not an error (open-hook func returned #t) */
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN kw_header_type, kw_data_format, kw_file, kw_srate, kw_channel, kw_sound, kw_edit_position, kw_channels, kw_size, kw_comment;
+static Xen kw_header_type, kw_file, kw_srate, kw_channel, kw_sound, kw_edit_position, kw_channels, kw_size, kw_comment, kw_sample_type;
static void init_sound_keywords(void)
{
- kw_header_type = XEN_MAKE_KEYWORD("header-type");
- kw_data_format = XEN_MAKE_KEYWORD("data-format");
- kw_file = XEN_MAKE_KEYWORD("file");
- kw_srate = XEN_MAKE_KEYWORD("srate");
- kw_channel = XEN_MAKE_KEYWORD("channel");
- kw_sound = XEN_MAKE_KEYWORD("sound");
- kw_edit_position = XEN_MAKE_KEYWORD("edit-position");
- kw_channels = XEN_MAKE_KEYWORD("channels");
- kw_size = XEN_MAKE_KEYWORD("size");
- kw_comment = XEN_MAKE_KEYWORD("comment");
+ kw_header_type = Xen_make_keyword("header-type");
+ kw_sample_type = Xen_make_keyword("sample-type");
+ kw_file = Xen_make_keyword("file");
+ kw_srate = Xen_make_keyword("srate");
+ kw_channel = Xen_make_keyword("channel");
+ kw_sound = Xen_make_keyword("sound");
+ kw_edit_position = Xen_make_keyword("edit-position");
+ kw_channels = Xen_make_keyword("channels");
+ kw_size = Xen_make_keyword("size");
+ kw_comment = Xen_make_keyword("comment");
}
-static XEN g_open_raw_sound(XEN arglist)
+static Xen g_open_raw_sound(Xen arglist)
{
- #define H_open_raw_sound "(" S_open_raw_sound " :file :channels :srate :data-format): \
+ #define H_open_raw_sound "(" S_open_raw_sound " file channels srate sample-type): \
open file assuming the data matches the attributes indicated unless the file actually has a header"
const char *file = NULL;
char *fullname;
snd_info *sp;
bool file_exists;
- int os = 1, oc = 1, ofr = MUS_BSHORT;
- XEN args[8];
- XEN keys[4];
+ int os = 1, oc = 1;
+ mus_sample_t ofr = MUS_BSHORT;
+ Xen args[8];
+ Xen keys[4];
int orig_arg[4] = {0, 0, 0, 0};
int vals, i, arglist_len;
keys[0] = kw_file;
keys[1] = kw_channels;
keys[2] = kw_srate;
- keys[3] = kw_data_format;
+ keys[3] = kw_sample_type;
mus_header_raw_defaults(&os, &oc, &ofr);
- for (i = 0; i < 8; i++) args[i] = XEN_UNDEFINED;
- arglist_len = XEN_LIST_LENGTH(arglist);
+ for (i = 0; i < 8; i++) args[i] = Xen_undefined;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 8)
+ Xen_out_of_range_error(S_open_raw_sound, 0, arglist, "too many arguments");
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
+ for (i = 0; i < arglist_len; i++) args[i] = Xen_list_ref(arglist, i);
vals = mus_optkey_unscramble(S_open_raw_sound, 4, keys, args, orig_arg);
if (vals > 0)
{
file = mus_optkey_to_string(keys[0], S_open_raw_sound, orig_arg[0], NULL);
oc = mus_optkey_to_int(keys[1], S_open_raw_sound, orig_arg[1], oc);
- if (!(XEN_KEYWORD_P(keys[1]))) set_fallback_chans(oc);
+ if ((oc < 0) ||
+ (oc > 256))
+ Xen_out_of_range_error(S_open_raw_sound, 2, args[orig_arg[1]], "too many channels requested");
+ if (!(Xen_is_keyword(keys[1]))) set_fallback_chans(oc);
os = mus_optkey_to_int(keys[2], S_open_raw_sound, orig_arg[2], os);
- if (!(XEN_KEYWORD_P(keys[2]))) set_fallback_srate(os);
- ofr = mus_optkey_to_int(keys[3], S_open_raw_sound, orig_arg[3], ofr);
- if (!(XEN_KEYWORD_P(keys[3]))) set_fallback_format(ofr);
+ if (!(Xen_is_keyword(keys[2]))) set_fallback_srate(os);
+ ofr = (mus_sample_t)mus_optkey_to_int(keys[3], S_open_raw_sound, orig_arg[3], (int)ofr);
+ if (!(Xen_is_keyword(keys[3]))) set_fallback_sample_type(ofr);
}
if (file == NULL)
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_1(C_TO_XEN_STRING(S_open_raw_sound ": no output file?")));
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_1(C_string_to_Xen_string(S_open_raw_sound ": no output file?")));
fullname = mus_expand_filename(file);
file_exists = mus_file_probe(fullname);
@@ -4380,15 +4032,15 @@ open file assuming the data matches the attributes indicated unless the file act
set_fallback_chans(0);
set_fallback_srate(0);
- set_fallback_format(MUS_UNKNOWN);
+ set_fallback_sample_type(MUS_UNKNOWN_SAMPLE);
ss->reloading_updated_file = 0;
/* snd_open_file -> snd_open_file_1 -> add_sound_window -> make_file_info -> raw_data_dialog_to_file_info */
/* so here if hooked, we'd need to save the current hook, make it return the current args, open, then restore */
if (sp)
- return(C_INT_TO_XEN_SOUND(sp->index));
- return(XEN_FALSE);
+ return(C_int_to_Xen_sound(sp->index));
+ return(Xen_false);
}
@@ -4402,7 +4054,7 @@ open file assuming the data matches the attributes indicated unless the file act
#define read_only_example "You can make it writable via: #f set-read-only"
#endif
-static XEN g_view_sound(XEN filename)
+static Xen g_view_sound(Xen filename)
{
#define H_view_sound "(" S_view_sound " filename): open a file in read-only mode. " read_only_example " at any time."
@@ -4411,9 +4063,9 @@ static XEN g_view_sound(XEN filename)
snd_info *sp = NULL;
bool file_exists;
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ONLY_ARG, S_view_sound, "a string");
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_view_sound, "a string");
- fname = XEN_TO_C_STRING(filename);
+ fname = Xen_string_to_C_string(filename);
fullname = mus_expand_filename(fname);
file_exists = mus_file_probe(fullname);
free(fullname);
@@ -4424,104 +4076,109 @@ static XEN g_view_sound(XEN filename)
sp = snd_open_file(fname, FILE_READ_ONLY);
if (sp)
- return(C_INT_TO_XEN_SOUND(sp->index));
- return(XEN_FALSE);
+ return(C_int_to_Xen_sound(sp->index));
+ return(Xen_false);
}
-static XEN g_save_sound_as(XEN arglist)
+static Xen g_save_sound_as(Xen arglist)
{
#if HAVE_SCHEME
- #define save_as_example "(" S_save_sound_as " \"test.snd\" index " S_mus_next " " S_mus_bshort ")"
+ #define save_as_example "(" S_save_sound_as " \"test.snd\" index 44100 " S_mus_bshort " " S_mus_next ")"
#endif
#if HAVE_RUBY
- #define save_as_example "save_sound_as(\"test.snd\", index, Mus_next, Mus_bshort)"
+ #define save_as_example "save_sound_as(\"test.snd\", index, 44100, Mus_bshort, Mus_next)"
#endif
#if HAVE_FORTH
- #define save_as_example "\"test.snd\" index mus-next mus-bshort save-sound-as"
+ #define save_as_example "\"test.snd\" index 44100 mus-bshort mus-next save-sound-as"
#endif
- #define H_save_sound_as "(" S_save_sound_as " :file :sound :header-type :data-format :srate :channel :edit-position :comment): \
+ #define H_save_sound_as "(" S_save_sound_as " file sound srate sample-type header-type channel edit-position comment): \
save sound in file using the indicated attributes. If channel is specified, only that channel is saved (extracted). \
Omitted arguments take their value from the sound being saved.\n " save_as_example
snd_info *sp;
file_info *hdr;
- int ht = -1, df = -1, sr = -1, chan = -1, edit_position = AT_CURRENT_EDIT_POSITION;
+ mus_header_t ht = MUS_UNKNOWN_HEADER;
+ mus_sample_t df = MUS_UNKNOWN_SAMPLE;
+ int sr = -1, chan = -1, edit_position = AT_CURRENT_EDIT_POSITION;
io_error_t io_err = IO_NO_ERROR;
char *fname = NULL;
const char *file = NULL, *outcom = NULL;
- XEN args[16];
- XEN keys[8];
+ Xen args[16];
+ Xen keys[8];
int orig_arg[8] = {0, 0, 0, 0, 0, 0, 0, 0};
int vals, i, arglist_len;
- XEN edpos = XEN_UNDEFINED, index = XEN_UNDEFINED;
+ Xen edpos = Xen_undefined, index = Xen_undefined;
bool got_edpos = false, free_outcom = false;
keys[0] = kw_file;
keys[1] = kw_sound;
- keys[2] = kw_header_type;
- keys[3] = kw_data_format;
- keys[4] = kw_srate;
+ keys[2] = kw_srate;
+ keys[3] = kw_sample_type;
+ keys[4] = kw_header_type;
keys[5] = kw_channel;
keys[6] = kw_edit_position;
keys[7] = kw_comment;
- for (i = 0; i < 16; i++) args[i] = XEN_UNDEFINED;
- arglist_len = XEN_LIST_LENGTH(arglist);
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
+ for (i = 0; i < 16; i++) args[i] = Xen_undefined;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 16)
+ Xen_out_of_range_error(S_save_sound_as, 0, arglist, "too many arguments");
+
+ for (i = 0; i < arglist_len; i++) args[i] = Xen_list_ref(arglist, i);
vals = mus_optkey_unscramble(S_save_sound_as, 8, keys, args, orig_arg);
if (vals > 0)
{
file = mus_optkey_to_string(keys[0], S_save_sound_as, orig_arg[0], NULL);
- if (!(XEN_KEYWORD_P(keys[1]))) index = keys[1];
- ht = mus_optkey_to_int(keys[2], S_save_sound_as, orig_arg[2], ht);
- df = mus_optkey_to_int(keys[3], S_save_sound_as, orig_arg[3], df);
- sr = mus_optkey_to_int(keys[4], S_save_sound_as, orig_arg[4], sr);
+ if (!(Xen_is_keyword(keys[1]))) index = keys[1];
+ ht = (mus_header_t)mus_optkey_to_int(keys[4], S_save_sound_as, orig_arg[4], (int)ht);
+ df = (mus_sample_t)mus_optkey_to_int(keys[3], S_save_sound_as, orig_arg[3], (int)df);
+ sr = mus_optkey_to_int(keys[2], S_save_sound_as, orig_arg[2], sr);
- if ((sr <= 0) && (!XEN_KEYWORD_P(keys[4])))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_save_sound_as ": srate (~A) can't be <= 0"),
- C_TO_XEN_INT(sr)));
+ if ((sr <= 0) && (!Xen_is_keyword(keys[2])))
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_save_sound_as ": srate (~A) can't be <= 0"),
+ C_int_to_Xen_integer(sr)));
chan = mus_optkey_to_int(keys[5], S_save_sound_as, orig_arg[5], chan);
- if (!(XEN_KEYWORD_P(keys[6])))
+ if (!(Xen_is_keyword(keys[6])))
{
edpos = keys[6];
- if ((XEN_INTEGER_P(edpos)) || (XEN_PROCEDURE_P(edpos)))
+ if ((Xen_is_integer(edpos)) || (Xen_is_procedure(edpos)))
got_edpos = true;
}
outcom = mus_optkey_to_string(keys[7], S_save_sound_as, orig_arg[7], NULL);
}
if ((file == NULL) ||
- (directory_p(file)))
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_1(C_TO_XEN_STRING(S_save_sound_as ": no output file?")));
+ (is_directory(file)))
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_1(C_string_to_Xen_string(S_save_sound_as ": no output file?")));
- ASSERT_SOUND(S_save_sound_as, index, 2);
+ Snd_assert_sound(S_save_sound_as, index, 2);
sp = get_sp(index);
if (sp == NULL)
return(snd_no_such_sound_error(S_save_sound_as, index));
hdr = sp->hdr;
- if (ht == -1) ht = hdr->type;
- if (!(mus_header_writable(ht, -2)))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_2(C_TO_XEN_STRING(S_save_sound_as ": can't write ~A headers"),
- C_TO_XEN_STRING(mus_header_type_name(ht))));
+ if (ht == MUS_UNKNOWN_HEADER) ht = hdr->type;
+ if (!(mus_header_writable(ht, MUS_IGNORE_SAMPLE)))
+ Xen_error(CANNOT_SAVE,
+ Xen_list_2(C_string_to_Xen_string(S_save_sound_as ": can't write ~A headers"),
+ C_string_to_Xen_string(mus_header_type_name(ht))));
if (sr == -1)
sr = hdr->srate;
- if (df == -1)
+ if (df == MUS_UNKNOWN_SAMPLE)
{
- /* try to find some writable data_format */
- df = hdr->format;
+ /* try to find some writable sample_type */
+ df = hdr->sample_type;
if (!mus_header_writable(ht, df))
- df = MUS_OUT_FORMAT;
+ df = MUS_OUT_SAMPLE_TYPE;
if (!mus_header_writable(ht, df))
{
switch (df)
@@ -4532,13 +4189,14 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
case MUS_LFLOAT: df = MUS_BFLOAT; break;
case MUS_LDOUBLE: df = MUS_BDOUBLE; break;
case MUS_LINT: df = MUS_BINT; break;
+ default: break;
}
if (!mus_header_writable(ht, df))
{
int i;
- for (i = 1; i < MUS_NUM_DATA_FORMATS; i++) /* MUS_UNSUPPORTED is 0 */
+ for (i = 1; i < MUS_NUM_SAMPLES; i++) /* MUS_UNKNOWN_SAMPLE is 0 */
{
- df = i;
+ df = (mus_sample_t)i;
if (mus_header_writable(ht, df))
break;
}
@@ -4547,10 +4205,10 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
}
if (!mus_header_writable(ht, df))
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_sound_as ": can't write ~A data to ~A headers"),
- C_TO_XEN_STRING(mus_data_format_name(df)),
- C_TO_XEN_STRING(mus_header_type_name(ht))));
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_save_sound_as ": can't write ~A data to ~A headers"),
+ C_string_to_Xen_string(mus_sample_type_name(df)),
+ C_string_to_Xen_string(mus_header_type_name(ht))));
if (chan >= sp->nchans)
return(snd_no_such_channel_error(S_save_sound_as, index, keys[5]));
@@ -4560,12 +4218,12 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
edit_position = to_c_edit_position(sp->chans[(chan >= 0) ? chan : 0], edpos, S_save_sound_as, 7);
for (i = 0; i < sp->nchans; i++)
if (edit_position > sp->chans[i]->edit_ctr)
- XEN_ERROR(NO_SUCH_EDIT,
- XEN_LIST_5(C_TO_XEN_STRING(S_save_sound_as ": no such edit position: ~A (~S chan ~A has ~A edits)"),
- C_TO_XEN_INT(edit_position),
- C_TO_XEN_STRING(sp->short_filename),
- C_TO_XEN_INT(i),
- C_TO_XEN_INT(sp->chans[i]->edit_ctr)));
+ Xen_error(NO_SUCH_EDIT,
+ Xen_list_5(C_string_to_Xen_string(S_save_sound_as ": no such edit position: ~A (~S chan ~A has ~A edits)"),
+ C_int_to_Xen_integer(edit_position),
+ C_string_to_Xen_string(sp->short_filename),
+ C_int_to_Xen_integer(i),
+ C_int_to_Xen_integer(sp->chans[i]->edit_ctr)));
}
fname = mus_expand_filename(file);
@@ -4575,10 +4233,10 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
if (outcom) free_outcom = true;
}
- if (!(run_before_save_as_hook(sp, fname, false, sr, ht, df, outcom)))
+ if (!(run_before_save_as_hook(sp, fname, false, sr, df, ht, outcom)))
{
if (chan >= 0)
- io_err = channel_to_file_with_settings(sp->chans[chan], fname, ht, df, sr, outcom, edit_position);
+ io_err = channel_to_file_with_settings(sp->chans[chan], fname, sr, df, ht, outcom, edit_position);
else io_err = save_edits_without_display(sp, fname, ht, df, sr, outcom, edit_position);
}
@@ -4594,13 +4252,13 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
{
if (io_err != IO_SAVE_HOOK_CANCELLATION)
{
- XEN errstr;
- errstr = C_TO_XEN_STRING(fname);
+ Xen errstr;
+ errstr = C_string_to_Xen_string(fname);
if (fname) {free(fname); fname = NULL;}
- XEN_ERROR(CANNOT_SAVE,
- XEN_LIST_3(C_TO_XEN_STRING(S_save_sound_as ": ~A (~A)"),
+ Xen_error(CANNOT_SAVE,
+ Xen_list_3(C_string_to_Xen_string(S_save_sound_as ": ~A (~A)"),
errstr,
- C_TO_XEN_STRING(snd_open_strerror())));
+ C_string_to_Xen_string(snd_open_strerror())));
}
}
@@ -4609,96 +4267,106 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
}
-static XEN g_new_sound(XEN arglist)
+static Xen g_new_sound(Xen arglist)
{
#if HAVE_SCHEME
- #define new_sound_example "(" S_new_sound " \"test.snd\" " S_mus_next " " S_mus_bshort " 22050 1 \"no comment\" 1000)"
+ #define new_sound_example "(" S_new_sound " \"test.snd\" 1 22050 " S_mus_bshort " " S_mus_next " \"no comment\" 1000)"
#endif
#if HAVE_RUBY
- #define new_sound_example "new_sound(\"test.snd\", Mus_next, Mus_bshort, 22050, 1, \"no comment\", 1000)"
+ #define new_sound_example "new_sound(\"test.snd\", 1, 22050, Mus_bshort, Mus_next, \"no comment\", 1000)"
#endif
#if HAVE_FORTH
- #define new_sound_example "\"test.snd\" mus-next mus-bshort 22050 1 \"no comment\" 1000 new-sound"
+ #define new_sound_example "\"test.snd\" 1 22050 mus-bshort mus-next \"no comment\" 1000 new-sound"
#endif
- #define H_new_sound "(" S_new_sound " :file :header-type :data-format :srate :channels :comment :size): \
+ #define H_new_sound "(" S_new_sound " file channels srate sample-type header-type comment size): \
creates a new sound file with the indicated attributes; if any are omitted, the corresponding default-output variable is used. \
The 'size' argument sets the number of samples (zeros) in the newly created sound. \n " new_sound_example
snd_info *sp = NULL;
- int ht, df, sr, ch, err;
- int chan;
+ mus_header_t ht;
+ mus_sample_t df;
+ int sr, ch, chan;
mus_long_t size, len = 1;
char *str = NULL;
const char *com = NULL, *file = NULL;
- XEN args[14];
- XEN keys[7];
+ Xen args[14];
+ Xen keys[7];
int orig_arg[7] = {0, 0, 0, 0, 0, 0, 0};
int vals, i, arglist_len;
+ io_error_t io_err;
keys[0] = kw_file;
- keys[1] = kw_header_type;
- keys[2] = kw_data_format;
- keys[3] = kw_srate;
- keys[4] = kw_channels;
+ keys[1] = kw_channels;
+ keys[2] = kw_srate;
+ keys[3] = kw_sample_type;
+ keys[4] = kw_header_type;
keys[5] = kw_comment;
keys[6] = kw_size;
- for (i = 0; i < 14; i++) args[i] = XEN_UNDEFINED;
- arglist_len = XEN_LIST_LENGTH(arglist);
- for (i = 0; i < arglist_len; i++) args[i] = XEN_LIST_REF(arglist, i);
+ for (i = 0; i < 14; i++) args[i] = Xen_undefined;
+ arglist_len = Xen_list_length(arglist);
+ if (arglist_len > 14)
+ Xen_out_of_range_error(S_open_raw_sound, 0, arglist, "too many arguments");
+
+ for (i = 0; i < arglist_len; i++) args[i] = Xen_list_ref(arglist, i);
vals = mus_optkey_unscramble(S_new_sound, 7, keys, args, orig_arg);
ht = default_output_header_type(ss);
- df = default_output_data_format(ss);
+ df = default_output_sample_type(ss);
sr = default_output_srate(ss);
ch = default_output_chans(ss);
if (vals > 0)
{
file = mus_optkey_to_string(keys[0], S_new_sound, orig_arg[0], NULL);
- ht = mus_optkey_to_int(keys[1], S_new_sound, orig_arg[1], ht);
- df = mus_optkey_to_int(keys[2], S_new_sound, orig_arg[2], df);
- sr = mus_optkey_to_int(keys[3], S_new_sound, orig_arg[3], sr);
- ch = mus_optkey_to_int(keys[4], S_new_sound, orig_arg[4], ch);
+ /* this can be null if :file is not passed as an arg (use temp name below) */
+ ht = (mus_header_t)mus_optkey_to_int(keys[4], S_new_sound, orig_arg[4], (int)ht);
+ df = (mus_sample_t)mus_optkey_to_int(keys[3], S_new_sound, orig_arg[3], (int)df);
+ sr = mus_optkey_to_int(keys[2], S_new_sound, orig_arg[2], sr);
+ ch = mus_optkey_to_int(keys[1], S_new_sound, orig_arg[1], ch);
com = mus_optkey_to_string(keys[5], S_new_sound, orig_arg[5], NULL);
len = mus_optkey_to_mus_long_t(keys[6], S_new_sound, orig_arg[6], len);
}
- if (!(mus_header_type_p(ht)))
- XEN_OUT_OF_RANGE_ERROR(S_new_sound, orig_arg[1], keys[1], "~A: invalid header type");
+ if (!(mus_is_header_type(ht)))
+ Xen_out_of_range_error(S_new_sound, orig_arg[4], keys[4], "invalid header type");
- if (!(mus_data_format_p(df)))
- XEN_OUT_OF_RANGE_ERROR(S_new_sound, orig_arg[2], keys[2], "~A: invalid data format");
+ if (!(mus_is_sample_type(df)))
+ Xen_out_of_range_error(S_new_sound, orig_arg[3], keys[3], "invalid sample type");
if (!(mus_header_writable(ht, df)))
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_3(C_TO_XEN_STRING(S_new_sound ": can't write ~A data to a ~A header"),
- keys[2],
- keys[1]));
+ Xen_error(BAD_HEADER,
+ Xen_list_3(C_string_to_Xen_string(S_new_sound ": can't write ~A data to a ~A header"),
+ C_string_to_Xen_string(mus_sample_type_short_name(df)),
+ C_string_to_Xen_string(mus_header_type_name(ht))));
if (sr <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_new_sound, orig_arg[3], keys[3], "srate ~A <= 0?");
+ Xen_out_of_range_error(S_new_sound, orig_arg[2], keys[2], "srate <= 0?");
if (ch <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_new_sound, orig_arg[4], keys[4], "channels ~A <= 0?");
+ Xen_out_of_range_error(S_new_sound, orig_arg[1], keys[1], "channels <= 0?");
if (len < 0)
- XEN_OUT_OF_RANGE_ERROR(S_new_sound, orig_arg[6], keys[6], "size ~A < 0?");
+ Xen_out_of_range_error(S_new_sound, orig_arg[6], keys[6], "size < 0?");
if (file)
- str = mus_expand_filename(file);
+ {
+ str = mus_expand_filename(file);
+ if (!str)
+ Xen_out_of_range_error(S_new_sound, orig_arg[0], keys[0], "bad file name?");
+ }
else str = snd_tempnam();
mus_sound_forget(str);
- err = snd_write_header(str, ht, sr, ch, len * ch, df, com, NULL); /* last arg is loop info */
- if (err == -1)
+ io_err = snd_write_header(str, ht, sr, ch, len * ch, df, com, NULL); /* last arg is loop info */
+ if (io_err != IO_NO_ERROR)
{
if (str) {free(str); str = NULL;}
- XEN_ERROR(XEN_ERROR_TYPE("IO-error"),
- XEN_LIST_3(C_TO_XEN_STRING(S_new_sound ": ~S, ~A"),
+ Xen_error(Xen_make_error_type("IO-error"),
+ Xen_list_3(C_string_to_Xen_string(S_new_sound ": ~S, ~A"),
keys[0],
- C_TO_XEN_STRING(snd_io_strerror())));
+ C_string_to_Xen_string(snd_io_strerror())));
}
chan = snd_reopen_write(str);
@@ -4719,12 +4387,12 @@ The 'size' argument sets the number of samples (zeros) in the newly created soun
sp = sound_is_silence(snd_open_file(str, FILE_READ_WRITE));
if (str) free(str);
- if (sp) return(C_INT_TO_XEN_SOUND(sp->index));
- return(XEN_FALSE);
+ if (sp) return(C_int_to_Xen_sound(sp->index));
+ return(Xen_false);
}
-static XEN g_speed_control_style(XEN snd)
+static Xen g_speed_control_style(Xen snd)
{
#define H_speed_control_style "(" S_speed_control_style " :optional snd): speed control panel interpretation \
choice: " S_speed_control_as_float ", " S_speed_control_as_ratio ", or " S_speed_control_as_semitone "."
@@ -4733,149 +4401,149 @@ choice: " S_speed_control_as_float ", " S_speed_control_as_ratio ", or " S_speed
}
-static XEN g_set_speed_control_style(XEN speed, XEN snd)
+static Xen g_set_speed_control_style(Xen speed, Xen snd)
{
int in_spd;
speed_style_t spd;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(speed), speed, XEN_ARG_1, S_setB S_speed_control_style, "an integer");
+ Xen_check_type(Xen_is_integer(speed), speed, 1, S_set S_speed_control_style, "an integer");
- in_spd = XEN_TO_C_INT(speed);
+ in_spd = Xen_integer_to_C_int(speed);
if (in_spd < 0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_speed_control_style, 1, speed, "~A, but must be >= 0");
+ Xen_out_of_range_error(S_set S_speed_control_style, 1, speed, "invalid " S_speed_control_style);
spd = (speed_style_t)in_spd;
if (spd >= NUM_SPEED_CONTROL_STYLES)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_speed_control_style, 1, speed,
- "~A, but must be " S_speed_control_as_float ", " S_speed_control_as_ratio ", or " S_speed_control_as_semitone);
+ Xen_out_of_range_error(S_set S_speed_control_style, 1, speed,
+ S_speed_control_style " should be " S_speed_control_as_float ", " S_speed_control_as_ratio ", or " S_speed_control_as_semitone);
- return(sound_set_global(snd, speed, SP_SPEED_STYLE, S_setB S_speed_control_style));
+ return(sound_set_global(snd, speed, SP_SPEED_STYLE, S_set S_speed_control_style));
}
-WITH_TWO_SETTER_ARGS(g_set_speed_control_style_reversed, g_set_speed_control_style)
+with_two_setter_args(g_set_speed_control_style_reversed, g_set_speed_control_style)
-static XEN g_speed_control_tones(XEN snd)
+static Xen g_speed_control_tones(Xen snd)
{
#define H_speed_control_tones "(" S_speed_control_tones " :optional snd): if " S_speed_control_style " is " S_speed_control_as_semitone ", this chooses the octave divisions (12)"
return(sound_get_global(snd, SP_SPEED_TONES, S_speed_control_tones));
}
-static XEN g_set_speed_control_tones(XEN val, XEN snd)
+static Xen g_set_speed_control_tones(Xen val, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_speed_control_tones, "a number");
- return(sound_set_global(snd, val, SP_SPEED_TONES, S_setB S_speed_control_tones));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_speed_control_tones, "a number");
+ return(sound_set_global(snd, val, SP_SPEED_TONES, S_set S_speed_control_tones));
}
-WITH_TWO_SETTER_ARGS(g_set_speed_control_tones_reversed, g_set_speed_control_tones)
+with_two_setter_args(g_set_speed_control_tones_reversed, g_set_speed_control_tones)
-static XEN g_amp_control(XEN snd, XEN chn_n)
+static Xen g_amp_control(Xen snd, Xen chn_n)
{
#define H_amp_control "(" S_amp_control " :optional snd chn): current amp slider setting"
- if (XEN_BOUND_P(chn_n))
+ if (Xen_is_bound(chn_n))
{
chan_info *cp;
- ASSERT_CHANNEL(S_amp_control, snd, chn_n, 1);
+ Snd_assert_channel(S_amp_control, snd, chn_n, 1);
cp = get_cp(snd, chn_n, S_amp_control);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
if (cp->amp_control)
- return(C_TO_XEN_DOUBLE(cp->amp_control[0]));
+ return(C_double_to_Xen_real(cp->amp_control[0]));
}
return(sound_get(snd, SP_AMP, S_amp_control));
}
-static XEN g_set_amp_control(XEN on, XEN snd, XEN chn_n)
+static Xen g_set_amp_control(Xen on, Xen snd, Xen chn_n)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_amp_control, "a number");
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_amp_control, "a number");
- if (XEN_BOUND_P(chn_n))
+ if (Xen_is_bound(chn_n))
{
chan_info *cp;
- ASSERT_CHANNEL(S_amp_control, snd, chn_n, 2);
+ Snd_assert_channel(S_amp_control, snd, chn_n, 2);
cp = get_cp(snd, chn_n, S_amp_control);
- if (!cp) return(XEN_FALSE);
+ if (!cp) return(Xen_false);
if (cp->amp_control == NULL)
cp->amp_control = (mus_float_t *)calloc(1, sizeof(mus_float_t));
- cp->amp_control[0] = (mus_float_t)XEN_TO_C_DOUBLE(on);
+ cp->amp_control[0] = (mus_float_t)Xen_real_to_C_double(on);
return(on);
}
- return(sound_set(snd, on, SP_AMP, S_setB S_amp_control));
+ return(sound_set(snd, on, SP_AMP, S_set S_amp_control));
}
-WITH_THREE_SETTER_ARGS(g_set_amp_control_reversed, g_set_amp_control)
+with_three_setter_args(g_set_amp_control_reversed, g_set_amp_control)
-static XEN g_amp_control_bounds(XEN snd)
+static Xen g_amp_control_bounds(Xen snd)
{
#define H_amp_control_bounds "(" S_amp_control_bounds " :optional snd): current amp slider bounds (default: '(0.0 8.0))"
return(sound_get_global(snd, SP_AMP_BOUNDS, S_amp_control_bounds));
}
-static XEN g_set_amp_control_bounds(XEN on, XEN snd)
+static Xen g_set_amp_control_bounds(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_LIST_P(on), on, XEN_ARG_1, S_setB S_amp_control_bounds, "a list of the new min and max values");
+ Xen_check_type(Xen_is_list(on), on, 1, S_set S_amp_control_bounds, "a list of the new min and max values");
- if ((XEN_LIST_LENGTH(on) != 2) ||
- (!(XEN_NUMBER_P(XEN_CAR(on)))) ||
- (!(XEN_NUMBER_P(XEN_CADR(on)))))
- XEN_WRONG_TYPE_ARG_ERROR(S_setB S_amp_control_bounds, XEN_ARG_1, on, "a list of 2 numbers");
+ if ((Xen_list_length(on) != 2) ||
+ (!(Xen_is_number(Xen_car(on)))) ||
+ (!(Xen_is_number(Xen_cadr(on)))))
+ Xen_wrong_type_arg_error(S_set S_amp_control_bounds, 1, on, "a list of 2 numbers");
- if (XEN_TO_C_DOUBLE(XEN_CAR(on)) >= XEN_TO_C_DOUBLE(XEN_CADR(on)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_amp_control_bounds, 1, on, "min >= max");
+ if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
+ Xen_out_of_range_error(S_set S_amp_control_bounds, 1, on, "min >= max");
- return(sound_set_global(snd, on, SP_AMP_BOUNDS, S_setB S_amp_control_bounds));
+ return(sound_set_global(snd, on, SP_AMP_BOUNDS, S_set S_amp_control_bounds));
}
-WITH_TWO_SETTER_ARGS(g_set_amp_control_bounds_reversed, g_set_amp_control_bounds)
+with_two_setter_args(g_set_amp_control_bounds_reversed, g_set_amp_control_bounds)
-static XEN g_contrast_control(XEN snd)
+static Xen g_contrast_control(Xen snd)
{
#define H_contrast_control "(" S_contrast_control " :optional snd): current contrast slider setting"
return(sound_get(snd, SP_CONTRAST, S_contrast_control));
}
-static XEN g_set_contrast_control(XEN on, XEN snd)
+static Xen g_set_contrast_control(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_contrast_control, "a number");
- return(sound_set(snd, on, SP_CONTRAST, S_setB S_contrast_control));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_contrast_control, "a number");
+ return(sound_set(snd, on, SP_CONTRAST, S_set S_contrast_control));
}
-WITH_TWO_SETTER_ARGS(g_set_contrast_control_reversed, g_set_contrast_control)
+with_two_setter_args(g_set_contrast_control_reversed, g_set_contrast_control)
-static XEN g_contrast_control_bounds(XEN snd)
+static Xen g_contrast_control_bounds(Xen snd)
{
#define H_contrast_control_bounds "(" S_contrast_control_bounds " :optional snd): current contrast slider bounds (default: '(0.0 10.0))"
return(sound_get_global(snd, SP_CONTRAST_BOUNDS, S_contrast_control_bounds));
}
-static XEN g_set_contrast_control_bounds(XEN on, XEN snd)
+static Xen g_set_contrast_control_bounds(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_LIST_P(on), on, XEN_ARG_1, S_setB S_contrast_control_bounds, "a list of the new min and max values");
+ Xen_check_type(Xen_is_list(on), on, 1, S_set S_contrast_control_bounds, "a list of the new min and max values");
- if ((XEN_LIST_LENGTH(on) != 2) ||
- (!(XEN_NUMBER_P(XEN_CAR(on)))) ||
- (!(XEN_NUMBER_P(XEN_CADR(on)))))
- XEN_WRONG_TYPE_ARG_ERROR(S_setB S_contrast_control_bounds, XEN_ARG_1, on, "a list of 2 numbers");
+ if ((Xen_list_length(on) != 2) ||
+ (!(Xen_is_number(Xen_car(on)))) ||
+ (!(Xen_is_number(Xen_cadr(on)))))
+ Xen_wrong_type_arg_error(S_set S_contrast_control_bounds, 1, on, "a list of 2 numbers");
- if (XEN_TO_C_DOUBLE(XEN_CAR(on)) >= XEN_TO_C_DOUBLE(XEN_CADR(on)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_contrast_control_bounds, 1, on, "min >= max");
+ if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
+ Xen_out_of_range_error(S_set S_contrast_control_bounds, 1, on, "min >= max");
- return(sound_set_global(snd, on, SP_CONTRAST_BOUNDS, S_setB S_contrast_control_bounds));
+ return(sound_set_global(snd, on, SP_CONTRAST_BOUNDS, S_set S_contrast_control_bounds));
}
-WITH_TWO_SETTER_ARGS(g_set_contrast_control_bounds_reversed, g_set_contrast_control_bounds)
+with_two_setter_args(g_set_contrast_control_bounds_reversed, g_set_contrast_control_bounds)
-static XEN g_contrast_control_amp(XEN snd)
+static Xen g_contrast_control_amp(Xen snd)
{
#define H_contrast_control_amp "(" S_contrast_control_amp " :optional snd): snd's contrast amp\n\
(scaler on data before contrast operation in control panel, 1.0)"
@@ -4884,310 +4552,310 @@ static XEN g_contrast_control_amp(XEN snd)
}
-static XEN g_set_contrast_control_amp(XEN on, XEN snd)
+static Xen g_set_contrast_control_amp(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_contrast_control_amp, "a number");
- return(sound_set_global(snd, on, SP_CONTRAST_AMP, S_setB S_contrast_control_amp));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_contrast_control_amp, "a number");
+ return(sound_set_global(snd, on, SP_CONTRAST_AMP, S_set S_contrast_control_amp));
}
-WITH_TWO_SETTER_ARGS(g_set_contrast_control_amp_reversed, g_set_contrast_control_amp)
+with_two_setter_args(g_set_contrast_control_amp_reversed, g_set_contrast_control_amp)
-static XEN g_expand_control(XEN snd)
+static Xen g_expand_control(Xen snd)
{
#define H_expand_control "(" S_expand_control " :optional snd): current expand slider setting"
return(sound_get(snd, SP_EXPAND, S_expand_control));
}
-static XEN g_set_expand_control(XEN on, XEN snd)
+static Xen g_set_expand_control(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_expand_control, "a number");
- return(sound_set(snd, on, SP_EXPAND, S_setB S_expand_control));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control, "a number");
+ return(sound_set(snd, on, SP_EXPAND, S_set S_expand_control));
}
-WITH_TWO_SETTER_ARGS(g_set_expand_control_reversed, g_set_expand_control)
+with_two_setter_args(g_set_expand_control_reversed, g_set_expand_control)
-static XEN g_expand_control_bounds(XEN snd)
+static Xen g_expand_control_bounds(Xen snd)
{
#define H_expand_control_bounds "(" S_expand_control_bounds " :optional snd): current expand slider bounds (default: '(0.001 20.0))"
return(sound_get_global(snd, SP_EXPAND_BOUNDS, S_expand_control_bounds));
}
-static XEN g_set_expand_control_bounds(XEN on, XEN snd)
+static Xen g_set_expand_control_bounds(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_LIST_P(on), on, XEN_ARG_1, S_setB S_expand_control_bounds, "a list of the new min and max values");
+ Xen_check_type(Xen_is_list(on), on, 1, S_set S_expand_control_bounds, "a list of the new min and max values");
- if ((XEN_LIST_LENGTH(on) != 2) ||
- (!(XEN_NUMBER_P(XEN_CAR(on)))) ||
- (!(XEN_NUMBER_P(XEN_CADR(on)))))
- XEN_WRONG_TYPE_ARG_ERROR(S_setB S_expand_control_bounds, XEN_ARG_1, on, "a list of 2 numbers");
+ if ((Xen_list_length(on) != 2) ||
+ (!(Xen_is_number(Xen_car(on)))) ||
+ (!(Xen_is_number(Xen_cadr(on)))))
+ Xen_wrong_type_arg_error(S_set S_expand_control_bounds, 1, on, "a list of 2 numbers");
- if (XEN_TO_C_DOUBLE(XEN_CAR(on)) >= XEN_TO_C_DOUBLE(XEN_CADR(on)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_expand_control_bounds, 1, on, "min >= max");
+ if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
+ Xen_out_of_range_error(S_set S_expand_control_bounds, 1, on, "min >= max");
- if (XEN_TO_C_DOUBLE(XEN_CAR(on)) <= 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_expand_control_bounds, 1, on, "min <= 0.0");
+ if (Xen_real_to_C_double(Xen_car(on)) <= 0.0)
+ Xen_out_of_range_error(S_set S_expand_control_bounds, 1, on, "min <= 0.0");
- return(sound_set_global(snd, on, SP_EXPAND_BOUNDS, S_setB S_expand_control_bounds));
+ return(sound_set_global(snd, on, SP_EXPAND_BOUNDS, S_set S_expand_control_bounds));
}
-WITH_TWO_SETTER_ARGS(g_set_expand_control_bounds_reversed, g_set_expand_control_bounds)
+with_two_setter_args(g_set_expand_control_bounds_reversed, g_set_expand_control_bounds)
-static XEN g_expand_control_length(XEN snd)
+static Xen g_expand_control_length(Xen snd)
{
#define H_expand_control_length "(" S_expand_control_length " :optional snd): current expansion segment length in seconds (.15)"
return(sound_get_global(snd, SP_EXPAND_LENGTH, S_expand_control_length));
}
-static XEN g_set_expand_control_length(XEN on, XEN snd)
+static Xen g_set_expand_control_length(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_expand_control_length, "a number");
- return(sound_set_global(snd, on, SP_EXPAND_LENGTH, S_setB S_expand_control_length));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control_length, "a number");
+ return(sound_set_global(snd, on, SP_EXPAND_LENGTH, S_set S_expand_control_length));
}
-WITH_TWO_SETTER_ARGS(g_set_expand_control_length_reversed, g_set_expand_control_length)
+with_two_setter_args(g_set_expand_control_length_reversed, g_set_expand_control_length)
-static XEN g_expand_control_ramp(XEN snd)
+static Xen g_expand_control_ramp(Xen snd)
{
#define H_expand_control_ramp "(" S_expand_control_ramp " :optional snd): current expansion ramp time (.4)"
return(sound_get_global(snd, SP_EXPAND_RAMP, S_expand_control_ramp));
}
-static XEN g_set_expand_control_ramp(XEN on, XEN snd)
+static Xen g_set_expand_control_ramp(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_expand_control_ramp, "a number");
- return(sound_set_global(snd, on, SP_EXPAND_RAMP, S_setB S_expand_control_ramp));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control_ramp, "a number");
+ return(sound_set_global(snd, on, SP_EXPAND_RAMP, S_set S_expand_control_ramp));
}
-WITH_TWO_SETTER_ARGS(g_set_expand_control_ramp_reversed, g_set_expand_control_ramp)
+with_two_setter_args(g_set_expand_control_ramp_reversed, g_set_expand_control_ramp)
-static XEN g_expand_control_hop(XEN snd)
+static Xen g_expand_control_hop(Xen snd)
{
#define H_expand_control_hop "(" S_expand_control_hop " :optional snd): current expansion output grain spacing in seconds (0.05)"
return(sound_get_global(snd, SP_EXPAND_HOP, S_expand_control_hop));
}
-static XEN g_set_expand_control_hop(XEN on, XEN snd)
+static Xen g_set_expand_control_hop(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_expand_control_hop, "a number");
- return(sound_set_global(snd, on, SP_EXPAND_HOP, S_setB S_expand_control_hop));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control_hop, "a number");
+ return(sound_set_global(snd, on, SP_EXPAND_HOP, S_set S_expand_control_hop));
}
-WITH_TWO_SETTER_ARGS(g_set_expand_control_hop_reversed, g_set_expand_control_hop)
+with_two_setter_args(g_set_expand_control_hop_reversed, g_set_expand_control_hop)
-static XEN g_expand_control_jitter(XEN snd)
+static Xen g_expand_control_jitter(Xen snd)
{
#define H_expand_control_jitter "(" S_expand_control_jitter " :optional snd): current expansion output grain spacing jitter (0.1)"
return(sound_get_global(snd, SP_EXPAND_JITTER, S_expand_control_jitter));
}
-static XEN g_set_expand_control_jitter(XEN on, XEN snd)
+static Xen g_set_expand_control_jitter(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_expand_control_jitter, "a number");
- return(sound_set_global(snd, on, SP_EXPAND_JITTER, S_setB S_expand_control_jitter));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_expand_control_jitter, "a number");
+ return(sound_set_global(snd, on, SP_EXPAND_JITTER, S_set S_expand_control_jitter));
}
-WITH_TWO_SETTER_ARGS(g_set_expand_control_jitter_reversed, g_set_expand_control_jitter)
+with_two_setter_args(g_set_expand_control_jitter_reversed, g_set_expand_control_jitter)
-static XEN g_speed_control(XEN snd)
+static Xen g_speed_control(Xen snd)
{
#define H_speed_control "(" S_speed_control " :optional snd): current speed (srate) slider setting"
return(sound_get(snd, SP_SPEED, S_speed_control));
}
-static XEN g_set_speed_control(XEN on, XEN snd)
+static Xen g_set_speed_control(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_speed_control, "a number");
- return(sound_set(snd, on, SP_SPEED, S_setB S_speed_control));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_speed_control, "a number");
+ return(sound_set(snd, on, SP_SPEED, S_set S_speed_control));
}
-WITH_TWO_SETTER_ARGS(g_set_speed_control_reversed, g_set_speed_control)
+with_two_setter_args(g_set_speed_control_reversed, g_set_speed_control)
-static XEN g_speed_control_bounds(XEN snd)
+static Xen g_speed_control_bounds(Xen snd)
{
#define H_speed_control_bounds "(" S_speed_control_bounds " :optional snd): current speed slider bounds (default: '(0.05 20.0))"
return(sound_get_global(snd, SP_SPEED_BOUNDS, S_speed_control_bounds));
}
-static XEN g_set_speed_control_bounds(XEN on, XEN snd)
+static Xen g_set_speed_control_bounds(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_LIST_P(on), on, XEN_ARG_1, S_setB S_speed_control_bounds, "a list of the new min and max values");
+ Xen_check_type(Xen_is_list(on), on, 1, S_set S_speed_control_bounds, "a list of the new min and max values");
- if ((XEN_LIST_LENGTH(on) != 2) ||
- (!(XEN_NUMBER_P(XEN_CAR(on)))) ||
- (!(XEN_NUMBER_P(XEN_CADR(on)))))
- XEN_WRONG_TYPE_ARG_ERROR(S_setB S_speed_control_bounds, XEN_ARG_1, on, "a list of 2 numbers");
+ if ((Xen_list_length(on) != 2) ||
+ (!(Xen_is_number(Xen_car(on)))) ||
+ (!(Xen_is_number(Xen_cadr(on)))))
+ Xen_wrong_type_arg_error(S_set S_speed_control_bounds, 1, on, "a list of 2 numbers");
- if (XEN_TO_C_DOUBLE(XEN_CAR(on)) >= XEN_TO_C_DOUBLE(XEN_CADR(on)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_speed_control_bounds, 1, on, "min >= max");
+ if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
+ Xen_out_of_range_error(S_set S_speed_control_bounds, 1, on, "min >= max");
- if (XEN_TO_C_DOUBLE(XEN_CAR(on)) <= 0.0)
- XEN_OUT_OF_RANGE_ERROR(S_setB S_speed_control_bounds, 1, on, "min <= 0.0");
+ if (Xen_real_to_C_double(Xen_car(on)) <= 0.0)
+ Xen_out_of_range_error(S_set S_speed_control_bounds, 1, on, "min <= 0.0");
- return(sound_set_global(snd, on, SP_SPEED_BOUNDS, S_setB S_speed_control_bounds));
+ return(sound_set_global(snd, on, SP_SPEED_BOUNDS, S_set S_speed_control_bounds));
}
-WITH_TWO_SETTER_ARGS(g_set_speed_control_bounds_reversed, g_set_speed_control_bounds)
+with_two_setter_args(g_set_speed_control_bounds_reversed, g_set_speed_control_bounds)
-static XEN g_reverb_control_length(XEN snd)
+static Xen g_reverb_control_length(Xen snd)
{
#define H_reverb_control_length "(" S_reverb_control_length " :optional snd): reverb decay length scaler"
return(sound_get(snd, SP_REVERB_LENGTH, S_reverb_control_length));
}
-static XEN g_set_reverb_control_length(XEN on, XEN snd)
+static Xen g_set_reverb_control_length(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_reverb_control_length, "a number");
- return(sound_set(snd, on, SP_REVERB_LENGTH, S_setB S_reverb_control_length));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_reverb_control_length, "a number");
+ return(sound_set(snd, on, SP_REVERB_LENGTH, S_set S_reverb_control_length));
}
-WITH_TWO_SETTER_ARGS(g_set_reverb_control_length_reversed, g_set_reverb_control_length)
+with_two_setter_args(g_set_reverb_control_length_reversed, g_set_reverb_control_length)
-static XEN g_reverb_control_length_bounds(XEN snd)
+static Xen g_reverb_control_length_bounds(Xen snd)
{
#define H_reverb_control_length_bounds "(" S_reverb_control_length_bounds " :optional snd): current reverb length slider bounds (default: '(0.0 5.0))"
return(sound_get_global(snd, SP_REVERB_LENGTH_BOUNDS, S_reverb_control_length_bounds));
}
-static XEN g_set_reverb_control_length_bounds(XEN on, XEN snd)
+static Xen g_set_reverb_control_length_bounds(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_LIST_P(on), on, XEN_ARG_1, S_setB S_reverb_control_length_bounds, "a list of the new min and max values");
+ Xen_check_type(Xen_is_list(on), on, 1, S_set S_reverb_control_length_bounds, "a list of the new min and max values");
- if ((XEN_LIST_LENGTH(on) != 2) ||
- (!(XEN_NUMBER_P(XEN_CAR(on)))) ||
- (!(XEN_NUMBER_P(XEN_CADR(on)))))
- XEN_WRONG_TYPE_ARG_ERROR(S_setB S_reverb_control_length_bounds, XEN_ARG_1, on, "a list of 2 numbers");
+ if ((Xen_list_length(on) != 2) ||
+ (!(Xen_is_number(Xen_car(on)))) ||
+ (!(Xen_is_number(Xen_cadr(on)))))
+ Xen_wrong_type_arg_error(S_set S_reverb_control_length_bounds, 1, on, "a list of 2 numbers");
- if (XEN_TO_C_DOUBLE(XEN_CAR(on)) >= XEN_TO_C_DOUBLE(XEN_CADR(on)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_reverb_control_length_bounds, 1, on, "min >= max");
+ if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
+ Xen_out_of_range_error(S_set S_reverb_control_length_bounds, 1, on, "min >= max");
- return(sound_set_global(snd, on, SP_REVERB_LENGTH_BOUNDS, S_setB S_reverb_control_length_bounds));
+ return(sound_set_global(snd, on, SP_REVERB_LENGTH_BOUNDS, S_set S_reverb_control_length_bounds));
}
-WITH_TWO_SETTER_ARGS(g_set_reverb_control_length_bounds_reversed, g_set_reverb_control_length_bounds)
+with_two_setter_args(g_set_reverb_control_length_bounds_reversed, g_set_reverb_control_length_bounds)
-static XEN g_reverb_control_feedback(XEN snd)
+static Xen g_reverb_control_feedback(Xen snd)
{
#define H_reverb_control_feedback "(" S_reverb_control_feedback " :optional snd): reverb feedback scaler"
return(sound_get_global(snd, SP_REVERB_FEEDBACK, S_reverb_control_feedback));
}
-static XEN g_set_reverb_control_feedback(XEN on, XEN snd)
+static Xen g_set_reverb_control_feedback(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_reverb_control_feedback, "a number");
- return(sound_set_global(snd, on, SP_REVERB_FEEDBACK, S_setB S_reverb_control_feedback));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_reverb_control_feedback, "a number");
+ return(sound_set_global(snd, on, SP_REVERB_FEEDBACK, S_set S_reverb_control_feedback));
}
-WITH_TWO_SETTER_ARGS(g_set_reverb_control_feedback_reversed, g_set_reverb_control_feedback)
+with_two_setter_args(g_set_reverb_control_feedback_reversed, g_set_reverb_control_feedback)
-static XEN g_reverb_control_scale(XEN snd)
+static Xen g_reverb_control_scale(Xen snd)
{
#define H_reverb_control_scale "(" S_reverb_control_scale " :optional snd): reverb scaler (the amount of reverb)"
return(sound_get(snd, SP_REVERB_SCALE, S_reverb_control_scale));
}
-static XEN g_set_reverb_control_scale(XEN on, XEN snd)
+static Xen g_set_reverb_control_scale(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_reverb_control_scale, "a number");
- return(sound_set(snd, on, SP_REVERB_SCALE, S_setB S_reverb_control_scale));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_reverb_control_scale, "a number");
+ return(sound_set(snd, on, SP_REVERB_SCALE, S_set S_reverb_control_scale));
}
-WITH_TWO_SETTER_ARGS(g_set_reverb_control_scale_reversed, g_set_reverb_control_scale)
+with_two_setter_args(g_set_reverb_control_scale_reversed, g_set_reverb_control_scale)
-static XEN g_reverb_control_scale_bounds(XEN snd)
+static Xen g_reverb_control_scale_bounds(Xen snd)
{
#define H_reverb_control_scale_bounds "(" S_reverb_control_scale_bounds " :optional snd): current reverb scale slider bounds (default: '(0.0 4.0))"
return(sound_get_global(snd, SP_REVERB_SCALE_BOUNDS, S_reverb_control_scale_bounds));
}
-static XEN g_set_reverb_control_scale_bounds(XEN on, XEN snd)
+static Xen g_set_reverb_control_scale_bounds(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_LIST_P(on), on, XEN_ARG_1, S_setB S_reverb_control_scale_bounds, "a list of the new min and max values");
+ Xen_check_type(Xen_is_list(on), on, 1, S_set S_reverb_control_scale_bounds, "a list of the new min and max values");
- if ((XEN_LIST_LENGTH(on) != 2) ||
- (!(XEN_NUMBER_P(XEN_CAR(on)))) ||
- (!(XEN_NUMBER_P(XEN_CADR(on)))))
- XEN_WRONG_TYPE_ARG_ERROR(S_setB S_reverb_control_scale_bounds, XEN_ARG_1, on, "a list of 2 numbers");
+ if ((Xen_list_length(on) != 2) ||
+ (!(Xen_is_number(Xen_car(on)))) ||
+ (!(Xen_is_number(Xen_cadr(on)))))
+ Xen_wrong_type_arg_error(S_set S_reverb_control_scale_bounds, 1, on, "a list of 2 numbers");
- if (XEN_TO_C_DOUBLE(XEN_CAR(on)) >= XEN_TO_C_DOUBLE(XEN_CADR(on)))
- XEN_OUT_OF_RANGE_ERROR(S_setB S_reverb_control_scale_bounds, 1, on, "min >= max");
+ if (Xen_real_to_C_double(Xen_car(on)) >= Xen_real_to_C_double(Xen_cadr(on)))
+ Xen_out_of_range_error(S_set S_reverb_control_scale_bounds, 1, on, "min >= max");
- return(sound_set_global(snd, on, SP_REVERB_SCALE_BOUNDS, S_setB S_reverb_control_scale_bounds));
+ return(sound_set_global(snd, on, SP_REVERB_SCALE_BOUNDS, S_set S_reverb_control_scale_bounds));
}
-WITH_TWO_SETTER_ARGS(g_set_reverb_control_scale_bounds_reversed, g_set_reverb_control_scale_bounds)
+with_two_setter_args(g_set_reverb_control_scale_bounds_reversed, g_set_reverb_control_scale_bounds)
-static XEN g_reverb_control_lowpass(XEN snd)
+static Xen g_reverb_control_lowpass(Xen snd)
{
#define H_reverb_control_lowpass "(" S_reverb_control_lowpass " :optional snd): reverb lowpass filter coefficient"
return(sound_get_global(snd, SP_REVERB_LOW_PASS, S_reverb_control_lowpass));
}
-static XEN g_set_reverb_control_lowpass(XEN on, XEN snd)
+static Xen g_set_reverb_control_lowpass(Xen on, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(on), on, XEN_ARG_1, S_setB S_reverb_control_lowpass, "a number");
- return(sound_set_global(snd, on, SP_REVERB_LOW_PASS, S_setB S_reverb_control_lowpass));
+ Xen_check_type(Xen_is_number(on), on, 1, S_set S_reverb_control_lowpass, "a number");
+ return(sound_set_global(snd, on, SP_REVERB_LOW_PASS, S_set S_reverb_control_lowpass));
}
-WITH_TWO_SETTER_ARGS(g_set_reverb_control_lowpass_reversed, g_set_reverb_control_lowpass)
+with_two_setter_args(g_set_reverb_control_lowpass_reversed, g_set_reverb_control_lowpass)
-static XEN g_reverb_control_decay(XEN snd)
+static Xen g_reverb_control_decay(Xen snd)
{
#define H_reverb_control_decay "(" S_reverb_control_decay " :optional snd): " S_apply_controls " reverb decay time (1.0 seconds)"
return(sound_get_global(snd, SP_REVERB_DECAY, S_reverb_control_decay));
}
-static XEN g_set_reverb_control_decay(XEN val, XEN snd)
+static Xen g_set_reverb_control_decay(Xen val, Xen snd)
{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_reverb_control_decay, "a number");
- return(sound_set_global(snd, val, SP_REVERB_DECAY, S_setB S_reverb_control_decay));
+ Xen_check_type(Xen_is_number(val), val, 1, S_set S_reverb_control_decay, "a number");
+ return(sound_set_global(snd, val, SP_REVERB_DECAY, S_set S_reverb_control_decay));
}
-WITH_TWO_SETTER_ARGS(g_set_reverb_control_decay_reversed, g_set_reverb_control_decay)
+with_two_setter_args(g_set_reverb_control_decay_reversed, g_set_reverb_control_decay)
-static XEN g_filter_control_envelope(XEN snd)
+static Xen g_filter_control_envelope(Xen snd)
{
#define H_filter_control_envelope "(" S_filter_control_envelope " :optional snd): snd's filter envelope (in the control panel)"
return(sound_get(snd, SP_FILTER_ENVELOPE, S_filter_control_envelope));
}
-static XEN g_set_filter_control_envelope(XEN val, XEN snd)
+static Xen g_set_filter_control_envelope(Xen val, Xen snd)
{
- return(sound_set(snd, val, SP_FILTER_ENVELOPE, S_setB S_filter_control_envelope));
+ return(sound_set(snd, val, SP_FILTER_ENVELOPE, S_set S_filter_control_envelope));
}
-WITH_TWO_SETTER_ARGS(g_set_filter_control_envelope_reversed, g_set_filter_control_envelope)
+with_two_setter_args(g_set_filter_control_envelope_reversed, g_set_filter_control_envelope)
static void squelch_printout(const char *msg, void *ignore)
@@ -5199,14 +4867,14 @@ static void apply_controls_error(const char *msg, void *data)
{
redirect_snd_warning_to(NULL, NULL);
redirect_snd_error_to(NULL, NULL);
- XEN_ERROR(XEN_ERROR_TYPE("cannot-apply-controls"),
- XEN_LIST_3(C_TO_XEN_STRING("~A: ~A"),
- C_TO_XEN_STRING((char *)data),
- C_TO_XEN_STRING(msg)));
+ Xen_error(Xen_make_error_type("cannot-apply-controls"),
+ Xen_list_3(C_string_to_Xen_string("~A: ~A"),
+ C_string_to_Xen_string((char *)data),
+ C_string_to_Xen_string(msg)));
}
-static XEN g_controls_to_channel(XEN settings, XEN beg, XEN dur, XEN snd, XEN chn, XEN origin)
+static Xen g_controls_to_channel(Xen settings, Xen beg, Xen dur, Xen snd, Xen chn, Xen origin)
{
#define H_controls_to_channel "(" S_controls_to_channel " settings :optional beg dur snd chn origin) sets up \
snd's controls to reflect 'settings' (unspecified settings are not changed), then applies the controls as \
@@ -5223,35 +4891,35 @@ where each inner list entry can also be " PROC_FALSE "."
snd_info *sp;
chan_info *cp;
- XEN_ASSERT_TYPE(XEN_LIST_P(settings), settings, XEN_ARG_1, S_controls_to_channel, "a list");
- ASSERT_CHANNEL(S_controls_to_channel, snd, chn, 4);
- XEN_ASSERT_TYPE(XEN_INT64_T_P(beg) || XEN_FALSE_P(beg) || XEN_NOT_BOUND_P(beg), beg, XEN_ARG_2, S_controls_to_channel, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(dur) || XEN_FALSE_P(dur) || XEN_NOT_BOUND_P(dur), dur, XEN_ARG_3, S_controls_to_channel, "an integer");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(origin), origin, XEN_ARG_7, S_controls_to_channel, "a string");
+ Xen_check_type(Xen_is_list(settings), settings, 1, S_controls_to_channel, "a list");
+ Snd_assert_channel(S_controls_to_channel, snd, chn, 4);
+ Xen_check_type(Xen_is_llong(beg) || Xen_is_false(beg) || !Xen_is_bound(beg), beg, 2, S_controls_to_channel, "an integer");
+ Xen_check_type(Xen_is_llong(dur) || Xen_is_false(dur) || !Xen_is_bound(dur), dur, 3, S_controls_to_channel, "an integer");
+ Xen_check_type(Xen_is_string_or_unbound(origin), origin, 7, S_controls_to_channel, "a string");
sp = get_sp(snd); /* control changes make sense, but not 'apply' -- expecting just 'play' if a player */
if (sp)
{
- XEN lst;
apply_state *ap;
int old_selected_channel;
ctrl_state *saved_settings;
if (sp->applying)
{
- XEN_ERROR(XEN_ERROR_TYPE("cannot-apply-controls"),
- XEN_LIST_1(C_TO_XEN_STRING(S_controls_to_channel ": already applying controls")));
+ Xen_error(Xen_make_error_type("cannot-apply-controls"),
+ Xen_list_1(C_string_to_Xen_string(S_controls_to_channel ": already applying controls")));
}
- if (XEN_INT64_T_P(beg)) apply_beg = XEN_TO_C_INT64_T(beg); else apply_beg = 0;
- if (XEN_INT64_T_P(dur)) apply_dur = XEN_TO_C_INT64_T(dur); else apply_dur = 0;
+ if (Xen_is_llong(beg)) apply_beg = Xen_llong_to_C_llong(beg); else apply_beg = 0;
+ if (Xen_is_llong(dur)) apply_dur = Xen_llong_to_C_llong(dur); else apply_dur = 0;
cp = get_cp(snd, chn, S_controls_to_channel);
old_selected_channel = sp->selected_channel;
sp->selected_channel = cp->chan;
saved_settings = current_control_settings(sp, NULL);
/* now read the 'settings' list for any new settings */
- if ((XEN_LIST_P(settings)) && (XEN_NOT_NULL_P(settings)))
+ if ((Xen_is_list(settings)) && (!Xen_is_null(settings)))
{
int i, len, elen;
+ Xen lst;
/* settings:
(list amp speed
(list contrast contrast_amp)
@@ -5260,64 +4928,64 @@ where each inner list entry can also be " PROC_FALSE "."
(list filter_order filter_env))
where any (outer) items can be #f
*/
- len = XEN_LIST_LENGTH(settings);
- for (i = 0, lst = XEN_COPY_ARG(settings); i < len; i++, lst = XEN_CDR(lst))
+ len = Xen_list_length(settings);
+ for (i = 0, lst = Xen_copy_arg(settings); i < len; i++, lst = Xen_cdr(lst))
{
- XEN element;
- element = XEN_CAR(lst);
+ Xen element;
+ element = Xen_car(lst);
switch (i)
{
case 0:
- if (XEN_NUMBER_P(element)) sp->amp_control = XEN_TO_C_DOUBLE(element);
+ if (Xen_is_number(element)) sp->amp_control = Xen_real_to_C_double(element);
break;
case 1:
- if (XEN_NUMBER_P(element)) sp->speed_control = XEN_TO_C_DOUBLE(element);
+ if (Xen_is_number(element)) sp->speed_control = Xen_real_to_C_double(element);
break;
case 2:
- if (XEN_LIST_P(element))
+ if (Xen_is_list(element))
{
- elen = XEN_LIST_LENGTH(element);
- if (elen > 0) sp->contrast_control_p = true;
- if (elen > 0) sp->contrast_control = XEN_TO_C_DOUBLE(XEN_CAR(element));
- if (elen > 1) sp->contrast_control_amp = XEN_TO_C_DOUBLE(XEN_CADR(element));
+ elen = Xen_list_length(element);
+ if (elen > 0) sp->contrast_control_on = true;
+ if (elen > 0) sp->contrast_control = Xen_real_to_C_double(Xen_car(element));
+ if (elen > 1) sp->contrast_control_amp = Xen_real_to_C_double(Xen_cadr(element));
}
break;
case 3:
- if (XEN_LIST_P(element))
+ if (Xen_is_list(element))
{
- elen = XEN_LIST_LENGTH(element);
- if (elen > 0) sp->expand_control_p = true;
- if (elen > 0) sp->expand_control = XEN_TO_C_DOUBLE(XEN_CAR(element));
- if (elen > 1) sp->expand_control_length = XEN_TO_C_DOUBLE(XEN_CADR(element));
- if (elen > 2) sp->expand_control_ramp = XEN_TO_C_DOUBLE(XEN_CADDR(element));
- if (elen > 3) sp->expand_control_hop = XEN_TO_C_DOUBLE(XEN_LIST_REF(element, 3));
- if (elen > 4) sp->expand_control_jitter = XEN_TO_C_DOUBLE(XEN_LIST_REF(element, 4));
+ elen = Xen_list_length(element);
+ if (elen > 0) sp->expand_control_on = true;
+ if (elen > 0) sp->expand_control = Xen_real_to_C_double(Xen_car(element));
+ if (elen > 1) sp->expand_control_length = Xen_real_to_C_double(Xen_cadr(element));
+ if (elen > 2) sp->expand_control_ramp = Xen_real_to_C_double(Xen_caddr(element));
+ if (elen > 3) sp->expand_control_hop = Xen_real_to_C_double(Xen_list_ref(element, 3));
+ if (elen > 4) sp->expand_control_jitter = Xen_real_to_C_double(Xen_list_ref(element, 4));
}
break;
case 4:
- if (XEN_LIST_P(element))
+ if (Xen_is_list(element))
{
- elen = XEN_LIST_LENGTH(element);
- if (elen > 0) sp->reverb_control_p = true;
- if (elen > 0) sp->reverb_control_scale = XEN_TO_C_DOUBLE(XEN_CAR(element));
- if (elen > 1) sp->reverb_control_length = XEN_TO_C_DOUBLE(XEN_CADR(element));
- if (elen > 2) sp->reverb_control_feedback = XEN_TO_C_DOUBLE(XEN_CADDR(element));
- if (elen > 3) sp->reverb_control_lowpass = XEN_TO_C_DOUBLE(XEN_LIST_REF(element, 3));
- if (elen > 4) sp->reverb_control_decay = XEN_TO_C_DOUBLE(XEN_LIST_REF(element, 4));
+ elen = Xen_list_length(element);
+ if (elen > 0) sp->reverb_control_on = true;
+ if (elen > 0) sp->reverb_control_scale = Xen_real_to_C_double(Xen_car(element));
+ if (elen > 1) sp->reverb_control_length = Xen_real_to_C_double(Xen_cadr(element));
+ if (elen > 2) sp->reverb_control_feedback = Xen_real_to_C_double(Xen_caddr(element));
+ if (elen > 3) sp->reverb_control_lowpass = Xen_real_to_C_double(Xen_list_ref(element, 3));
+ if (elen > 4) sp->reverb_control_decay = Xen_real_to_C_double(Xen_list_ref(element, 4));
}
break;
case 5:
- if (XEN_LIST_P(element))
+ if (Xen_is_list(element))
{
- elen = XEN_LIST_LENGTH(element);
- if (elen > 0) sp->filter_control_p = true;
- if (elen > 0) sp->filter_control_order = XEN_TO_C_INT(XEN_CAR(element));
- if (elen > 1) sp->filter_control_envelope = get_env(XEN_CADR(element), S_controls_to_channel);
+ elen = Xen_list_length(element);
+ if (elen > 0) sp->filter_control_on = true;
+ if (elen > 0) sp->filter_control_order = Xen_integer_to_C_int(Xen_car(element));
+ if (elen > 1) sp->filter_control_envelope = get_env(Xen_cadr(element), S_controls_to_channel);
}
}
}
@@ -5329,26 +4997,26 @@ where each inner list entry can also be " PROC_FALSE "."
#if HAVE_EXTENSION_LANGUAGE
#if HAVE_FORTH
- if (!(XEN_NUMBER_P(dur)))
- ap->origin = mus_format("%s " MUS_LD PROC_SEP PROC_FALSE " %s",
- XEN_AS_STRING(settings),
+ if (!(Xen_is_number(dur)))
+ ap->origin = mus_format("%s %lld" PROC_SEP PROC_FALSE " %s",
+ Xen_object_to_C_string(settings),
apply_beg, S_controls_to_channel);
- else ap->origin = mus_format("%s " PROC_SEP MUS_LD PROC_SEP MUS_LD " %s",
- XEN_AS_STRING(settings),
+ else ap->origin = mus_format("%s " PROC_SEP "%lld" PROC_SEP "%lld %s",
+ Xen_object_to_C_string(settings),
apply_beg, apply_dur, S_controls_to_channel);
#else
{
char *temp = NULL;
- if (!(XEN_NUMBER_P(dur)))
- ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP MUS_LD PROC_SEP PROC_FALSE,
- TO_PROC_NAME(S_controls_to_channel),
+ if (!(Xen_is_number(dur)))
+ ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ to_proc_name(S_controls_to_channel),
PROC_QUOTE,
- temp = XEN_AS_STRING(settings),
+ temp = Xen_object_to_C_string(settings),
apply_beg);
- else ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP MUS_LD PROC_SEP MUS_LD,
- TO_PROC_NAME(S_controls_to_channel),
+ else ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP "%lld" PROC_SEP "%lld",
+ to_proc_name(S_controls_to_channel),
PROC_QUOTE,
- temp = XEN_AS_STRING(settings),
+ temp = Xen_object_to_C_string(settings),
apply_beg, apply_dur);
#if HAVE_SCHEME
if (temp) free(temp);
@@ -5374,7 +5042,7 @@ where each inner list entry can also be " PROC_FALSE "."
}
-static XEN g_apply_controls(XEN snd, XEN choice, XEN beg, XEN dur)
+static Xen g_apply_controls(Xen snd, Xen choice, Xen beg, Xen dur)
{
#define H_apply_controls "(" S_apply_controls " :optional snd (choice 0) (beg 0) (dur len)): \
applies the current control panel state as an edit. \
@@ -5382,29 +5050,31 @@ The 'choices' are 0 (apply to sound), 1 (apply to channel), and 2 (apply to sele
snd_info *sp;
- ASSERT_SOUND(S_apply_controls, snd, 1);
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(choice), choice, XEN_ARG_2, S_apply_controls, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(beg), beg, XEN_ARG_3, S_apply_controls, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(dur), dur, XEN_ARG_4, S_apply_controls, "an integer");
+ Snd_assert_sound(S_apply_controls, snd, 1);
+ Xen_check_type(Xen_is_integer_or_unbound(choice), choice, 2, S_apply_controls, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(beg), beg, 3, S_apply_controls, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(dur), dur, 4, S_apply_controls, "an integer");
sp = get_sp(snd); /* control changes make sense, but not 'apply' -- expecting just 'play' if a player */
if (sp)
{
apply_state *ap;
- snd_apply_t cur_choice;
+ snd_apply_t cur_choice = APPLY_TO_SOUND;
if (sp->applying)
{
- XEN_ERROR(XEN_ERROR_TYPE("cannot-apply-controls"),
- XEN_LIST_1(C_TO_XEN_STRING(S_apply_controls ": already applying controls")));
+ Xen_error(Xen_make_error_type("cannot-apply-controls"),
+ Xen_list_1(C_string_to_Xen_string(S_apply_controls ": already applying controls")));
}
- if (XEN_INT64_T_P(beg)) apply_beg = XEN_TO_C_INT64_T(beg); else apply_beg = 0;
- if (XEN_INT64_T_P(dur)) apply_dur = XEN_TO_C_INT64_T(dur); else apply_dur = 0;
- cur_choice = (snd_apply_t)XEN_TO_C_INT_OR_ELSE(choice, (int)APPLY_TO_SOUND);
+ if (Xen_is_llong(beg)) apply_beg = Xen_llong_to_C_llong(beg); else apply_beg = 0;
+ if (Xen_is_llong(dur)) apply_dur = Xen_llong_to_C_llong(dur); else apply_dur = 0;
+ if (Xen_is_integer(choice))
+ cur_choice = (snd_apply_t)Xen_integer_to_C_int(choice);
if (cur_choice > APPLY_TO_SELECTION)
- XEN_OUT_OF_RANGE_ERROR(S_apply_controls, 2, choice, "~A, but must be 0=sound, 1=channel, or 2=selection");
+ Xen_out_of_range_error(S_apply_controls, 2, choice, "choice must be 0=sound, 1=channel, or 2=selection");
+
ss->apply_choice = cur_choice;
sp->applying = true;
ap = (apply_state *)make_apply_state(sp);
@@ -5531,7 +5201,7 @@ typedef enum {PEAK_ENV_NO_ERROR, PEAK_ENV_BAD_HEADER, PEAK_ENV_BAD_FORMAT, PEAK_
static const char *peak_env_error[6] = {
"no error",
"peak-env file has a bad header!",
- "peak-env file is in the wrong data format; will re-make it.",
+ "peak-env file is in the wrong sample type; will re-make it.",
"peak-env file size is messed up!",
"peak-env file has vanished!",
"peak-env file is empty!"};
@@ -5576,7 +5246,7 @@ static peak_env_info *get_peak_env_info(const char *fullname, peak_env_error_t *
(*error) = PEAK_ENV_BAD_FORMAT;
else
{
- if ((ibuf[1] <= 0) || (!(POWER_OF_2_P(ibuf[1]))))
+ if ((ibuf[1] <= 0) || (!(is_power_of_2(ibuf[1]))))
(*error) = PEAK_ENV_BAD_SIZE;
else
{
@@ -5639,38 +5309,47 @@ const char *read_peak_env_info_file(chan_info *cp)
}
-static XEN g_peak_env_info_to_vcts(peak_env_info *ep, int len)
+static Xen g_peak_env_info_to_vcts(peak_env_info *ep, int len)
{
/* changed 5-Jan-03 to return vcts */
/* in snd-test this causes unfreed memory because the sound-icon-box saves all the data for each icon (vcts unfreed) */
- XEN res;
- int i, j, lim;
+ Xen res;
+ int i, lim;
vct *vmax, *vmin;
+ mus_float_t *maxdata, *mindata;
int loc;
+
if ((len == 0) || (len > ep->peak_env_size))
lim = ep->peak_env_size;
else lim = len;
- res = XEN_LIST_2(xen_make_vct(lim, (mus_float_t *)calloc(lim, sizeof(mus_float_t))),
+ if (lim <= 0) return(Xen_empty_list);
+
+ res = Xen_list_2(xen_make_vct(lim, (mus_float_t *)calloc(lim, sizeof(mus_float_t))),
xen_make_vct(lim, (mus_float_t *)calloc(lim, sizeof(mus_float_t))));
loc = snd_protect(res);
- vmin = xen_to_vct(XEN_CAR(res));
- vmax = xen_to_vct(XEN_CADR(res));
+
+ vmin = xen_to_vct(Xen_car(res));
+ vmax = xen_to_vct(Xen_cadr(res));
+ mindata = mus_vct_data(vmin);
+ maxdata = mus_vct_data(vmax);
+
if (ep->peak_env_size == lim)
{
for (i = 0; i < lim; i++)
{
- vmin->data[i] = ep->data_min[i];
- vmax->data[i] = ep->data_max[i];
+ mindata[i] = ep->data_min[i];
+ maxdata[i] = ep->data_max[i];
}
}
else
{
mus_float_t cmax, cmin, incr, x;
+ int j;
incr = (mus_float_t)(ep->peak_env_size - 1) / (mus_float_t)lim; /* make extra room on left */
cmax = ep->fmin;
cmin = ep->fmax;
- vmin->data[0] = ep->data_min[0];
- vmax->data[0] = ep->data_max[0];
+ mindata[0] = ep->data_min[0];
+ maxdata[0] = ep->data_max[0];
for (i = 1, j = 1, x = 0.0; i < ep->peak_env_size; i++)
{
if (ep->data_max[i] > cmax) cmax = ep->data_max[i];
@@ -5678,8 +5357,8 @@ static XEN g_peak_env_info_to_vcts(peak_env_info *ep, int len)
x += 1.0;
if (x >= incr)
{
- vmin->data[j] = cmin;
- vmax->data[j++] = cmax;
+ mindata[j] = cmin;
+ maxdata[j++] = cmax;
x -= incr;
cmax = ep->fmin;
cmin = ep->fmax;
@@ -5697,8 +5376,8 @@ typedef struct {
chan_info *cp;
env_state *es;
int len;
- XEN filename;
- XEN func;
+ Xen filename;
+ Xen func;
int func_gc_loc;
} env_tick;
@@ -5714,15 +5393,15 @@ static idle_func_t tick_it(any_pointer_t pet)
if (val)
{
es = free_env_state(es);
- if (XEN_PROCEDURE_P(et->func))
+ if (Xen_is_procedure(et->func))
{
int loc;
- XEN peak;
+ Xen peak;
peak = g_peak_env_info_to_vcts(cp->edits[0]->peak_env, et->len);
loc = snd_protect(peak);
- XEN_CALL_3(et->func,
+ Xen_call_with_3_args(et->func,
et->filename,
- C_TO_XEN_INT(cp->chan),
+ C_int_to_Xen_integer(cp->chan),
peak,
"amp env tick");
snd_unprotect_at(et->func_gc_loc);
@@ -5737,39 +5416,39 @@ static idle_func_t tick_it(any_pointer_t pet)
#endif
-static XEN g_channel_amp_envs(XEN filename, XEN chan, XEN pts, XEN peak_func, XEN done_func)
+static Xen g_channel_amp_envs(Xen filename, Xen chan, Xen pts, Xen peak_func, Xen done_func)
{
/* return two vectors of size pts containing y vals (min and max) of amp env
* if peak_func, use it to get peak_env_info file if needed
* if done_func set workproc that calls it when done
*/
#define H_channel_amp_envs "(" S_channel_amp_envs " :optional file (chan 0) size peak-file-func work-proc-func): \
-return two vcts of length 'size' containing y vals (min and max) of file's channel chan's amp envs. \
+return two " S_vct "s of length 'size' containing y vals (min and max) of file's channel chan's amp envs. \
'peak-file-func' is used to get the name of the associated peak_env_info file if the file is very large. \
'work-proc-func' is called when the amp envs are ready if the amp envs are gathered in the background. \
If 'filename' is a sound index or a sound object, 'size' is interpreted as an edit-position, and the current amp envs are returned."
char *fullname = NULL;
- int len, chn;
+ int len = 0, chn = 0;
snd_info *sp = NULL;
chan_info *cp = NULL;
peak_env_error_t err = PEAK_ENV_NO_ERROR;
- XEN_ASSERT_TYPE(XEN_STRING_P(filename) || XEN_INTEGER_P(filename) || XEN_NOT_BOUND_P(filename) || XEN_SOUND_P(filename),
- filename, XEN_ARG_1, S_channel_amp_envs, "a string or sound index");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chan), chan, XEN_ARG_2, S_channel_amp_envs, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(pts), pts, XEN_ARG_3, S_channel_amp_envs, "an integer");
-
- XEN_ASSERT_TYPE(((XEN_PROCEDURE_P(peak_func)) && (procedure_arity_ok(peak_func, 2))) ||
- (XEN_FALSE_P(peak_func)) ||
- (XEN_NOT_BOUND_P(peak_func)),
- peak_func, XEN_ARG_4, S_channel_amp_envs, "a procedure of 2 args");
- XEN_ASSERT_TYPE(((XEN_PROCEDURE_P(done_func)) && (procedure_arity_ok(done_func, 3))) ||
- (XEN_FALSE_P(done_func)) ||
- (XEN_NOT_BOUND_P(done_func)),
- done_func, XEN_ARG_5, S_channel_amp_envs, "a procedure of 3 args");
-
- if (!(XEN_STRING_P(filename)))
+ Xen_check_type(Xen_is_string(filename) || Xen_is_integer(filename) || !Xen_is_bound(filename) || xen_is_sound(filename),
+ filename, 1, S_channel_amp_envs, "a string or sound index");
+ Xen_check_type(Xen_is_integer_or_unbound(chan), chan, 2, S_channel_amp_envs, "an integer");
+ Xen_check_type(Xen_is_integer_or_unbound(pts), pts, 3, S_channel_amp_envs, "an integer");
+
+ Xen_check_type(((Xen_is_procedure(peak_func)) && (procedure_arity_ok(peak_func, 2))) ||
+ (Xen_is_false(peak_func)) ||
+ (!Xen_is_bound(peak_func)),
+ peak_func, 4, S_channel_amp_envs, "a procedure of 2 args");
+ Xen_check_type(((Xen_is_procedure(done_func)) && (procedure_arity_ok(done_func, 3))) ||
+ (Xen_is_false(done_func)) ||
+ (!Xen_is_bound(done_func)),
+ done_func, 5, S_channel_amp_envs, "a procedure of 3 args");
+
+ if (!(Xen_is_string(filename)))
{
cp = get_cp(filename, chan, S_channel_amp_envs);
if (cp)
@@ -5780,7 +5459,7 @@ If 'filename' is a sound index or a sound object, 'size' is interpreted as an ed
pos = to_c_edit_position(cp, pts, S_channel_amp_envs, 3); /* here "pts" is edpos, not vector size */
if (cp->edits == NULL)
- return(XEN_EMPTY_LIST);
+ return(Xen_empty_list);
ep = cp->edits[pos]->peak_env; /* this can be null -- we run the peak envs if necessary */
if ((ep) &&
@@ -5798,16 +5477,18 @@ If 'filename' is a sound index or a sound object, 'size' is interpreted as an ed
if (ep)
return(g_peak_env_info_to_vcts(ep, ep->peak_env_size));
}
- return(XEN_EMPTY_LIST);
+ return(Xen_empty_list);
}
/* else get_cp threw an error */
}
/* filename is a string from here down */
- fullname = mus_expand_filename(XEN_TO_C_STRING(filename));
- chn = XEN_TO_C_INT_OR_ELSE(chan, 0);
- len = XEN_TO_C_INT_OR_ELSE(pts, 0);
+ fullname = mus_expand_filename(Xen_string_to_C_string(filename));
+ if (Xen_is_integer(chan)) chn = Xen_integer_to_C_int(chan);
+ if (chn < 0)
+ Xen_out_of_range_error(S_channel_amp_envs, 2, chan, "must be >= 0");
+ if (Xen_is_integer(pts)) len = Xen_integer_to_C_int(pts);
/* look for sp->filename = fullname
then peak
@@ -5823,56 +5504,57 @@ If 'filename' is a sound index or a sound object, 'size' is interpreted as an ed
if (cp->edits[0]->peak_env)
{
if (fullname) free(fullname);
+ /* here len can be 0 */
return(g_peak_env_info_to_vcts(cp->edits[0]->peak_env, len));
}
}
else
{
if (fullname) free(fullname);
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_3(C_TO_XEN_STRING(S_channel_amp_envs ": no such channel (~A in ~S)"),
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_3(C_string_to_Xen_string(S_channel_amp_envs ": no such channel (~A in ~S)"),
chan,
filename));
- return(XEN_FALSE);
+ return(Xen_false);
}
}
if (!(mus_file_probe(fullname)))
{
if (fullname) free(fullname);
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_2(C_TO_XEN_STRING(S_channel_amp_envs ": no such file: ~S"),
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_2(C_string_to_Xen_string(S_channel_amp_envs ": no such file: ~S"),
filename));
- return(XEN_FALSE);
+ return(Xen_false);
}
if (mus_sound_chans(fullname) < chn)
{
if (fullname) free(fullname);
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_3(C_TO_XEN_STRING(S_channel_amp_envs ": no such channel (~A in ~S)"),
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_3(C_string_to_Xen_string(S_channel_amp_envs ": no such channel (~A in ~S)"),
chan,
filename));
- return(XEN_FALSE);
+ return(Xen_false);
}
- if (XEN_PROCEDURE_P(peak_func))
+ if (Xen_is_procedure(peak_func))
{
- XEN peak_filename;
- peak_filename = XEN_CALL_2(peak_func,
+ Xen peak_filename;
+ peak_filename = Xen_call_with_2_args(peak_func,
filename,
chan,
"peak env filename procedure");
- if (XEN_STRING_P(peak_filename))
+ if (Xen_is_string(peak_filename))
{
char *peakname;
- peakname = mus_expand_filename(XEN_TO_C_STRING(peak_filename));
+ peakname = mus_expand_filename(Xen_string_to_C_string(peak_filename));
if (mus_file_probe(peakname))
{
peak_env_info *ep;
ep = get_peak_env_info(peakname, &err);
if (ep)
{
- XEN vcts;
+ Xen vcts;
vcts = g_peak_env_info_to_vcts(ep, len);
ep = free_peak_env_info(ep);
if (peakname) free(peakname);
@@ -5889,557 +5571,550 @@ If 'filename' is a sound index or a sound object, 'size' is interpreted as an ed
sp = make_sound_readable(fullname, false);
if (fullname) free(fullname);
fullname = NULL;
- if (sp)
+ if ((sp) &&
+ (chn < sp->nchans))
{
- env_state *es;
- XEN peak = XEN_FALSE;
cp = sp->chans[chn];
- es = make_env_state(cp, cp->edits[0]->samples);
- if (es)
+ if (cp)
{
-#if (!USE_NO_GUI)
- if (XEN_PROCEDURE_P(done_func))
+ Xen peak = Xen_false;
+ env_state *es;
+ es = make_env_state(cp, cp->edits[0]->samples);
+ if (es)
{
- int id;
- env_tick *et;
- et = (env_tick *)calloc(1, sizeof(env_tick));
- et->cp = cp;
- et->es = es;
- et->func = done_func;
- et->func_gc_loc = snd_protect(done_func);
- et->len = len;
- et->filename = filename;
- id = (int)BACKGROUND_ADD(tick_it, (any_pointer_t)et);
- return(C_TO_XEN_INT(id));
- }
+#if (!USE_NO_GUI)
+ if (Xen_is_procedure(done_func))
+ {
+ int id;
+ env_tick *et;
+
+ if (len <= 0)
+ Xen_out_of_range_error(S_channel_amp_envs, 3, pts, "must be > 0");
+
+ et = (env_tick *)calloc(1, sizeof(env_tick));
+ et->cp = cp;
+ et->es = es;
+ et->func = done_func;
+ et->func_gc_loc = snd_protect(done_func);
+ et->len = len;
+ et->filename = filename;
+ id = (int)BACKGROUND_ADD(tick_it, (any_pointer_t)et);
+ return(C_int_to_Xen_integer(id));
+ }
#endif
- while (!(tick_peak_env(cp, es))) {};
- es = free_env_state(es);
- peak = g_peak_env_info_to_vcts(cp->edits[0]->peak_env, len);
+ while (!(tick_peak_env(cp, es))) {};
+ es = free_env_state(es);
+ peak = g_peak_env_info_to_vcts(cp->edits[0]->peak_env, len);
+ }
+ cp->active = CHANNEL_INACTIVE;
+ completely_free_snd_info(sp);
+ return(peak);
}
- cp->active = CHANNEL_INACTIVE;
- completely_free_snd_info(sp);
- return(peak);
}
- return(XEN_FALSE);
+ return(Xen_false);
}
/* -------------------------------------------------------------------------------- */
-static XEN g_start_progress_report(XEN snd, XEN chn)
+static Xen g_start_progress_report(Xen snd, Xen chn)
{
#define H_start_progress_report "(" S_start_progress_report " :optional snd chn): post the hour-glass icon"
chan_info *cp;
- ASSERT_CHANNEL(S_start_progress_report, snd, chn, 1);
+ Snd_assert_channel(S_start_progress_report, snd, chn, 1);
cp = get_cp(snd, chn, S_start_progress_report);
if (!cp)
return(snd_no_such_channel_error(S_start_progress_report, snd, chn));
start_progress_report(cp);
- return(XEN_TRUE);
+ return(Xen_true);
}
-static XEN g_finish_progress_report(XEN snd, XEN chn)
+static Xen g_finish_progress_report(Xen snd, Xen chn)
{
#define H_finish_progress_report "(" S_finish_progress_report " :optional snd chn): remove the hour-glass icon"
chan_info *cp;
- ASSERT_CHANNEL(S_finish_progress_report, snd, chn, 1);
+ Snd_assert_channel(S_finish_progress_report, snd, chn, 1);
cp = get_cp(snd, chn, S_finish_progress_report);
if (!cp)
return(snd_no_such_channel_error(S_finish_progress_report, snd, chn));
finish_progress_report(cp);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_progress_report(XEN pct, XEN snd, XEN chn)
+static Xen g_progress_report(Xen pct, Xen snd, Xen chn)
{
#define H_progress_report "(" S_progress_report " pct :optional snd chn): \
update an on-going 'progress report' (an animated hour-glass icon) in snd's channel chn using pct to indicate how far along we are"
chan_info *cp;
- ASSERT_CHANNEL(S_progress_report, snd, chn, 2);
+ Snd_assert_channel(S_progress_report, snd, chn, 2);
cp = get_cp(snd, chn, S_progress_report);
if (!cp)
return(snd_no_such_channel_error(S_progress_report, snd, chn));
- XEN_ASSERT_TYPE(XEN_NUMBER_P(pct), pct, XEN_ARG_1, S_progress_report, "a number");
+ Xen_check_type(Xen_is_number(pct), pct, 1, S_progress_report, "a number");
- progress_report(cp, XEN_TO_C_DOUBLE(pct));
+ progress_report(cp, Xen_real_to_C_double(pct));
return(pct);
}
-static XEN g_sounds(void)
+static Xen g_sounds(void)
{
#define H_sounds "(" S_sounds "): list of active sounds"
int i;
- XEN result;
- result = XEN_EMPTY_LIST;
+ Xen result;
+ result = Xen_empty_list;
for (i = 0; i < ss->max_sounds; i++)
{
snd_info *sp;
sp = ss->sounds[i];
if ((sp) && (sp->inuse == SOUND_NORMAL))
- result = XEN_CONS(C_INT_TO_XEN_SOUND(i),
+ result = Xen_cons(C_int_to_Xen_sound(i),
result);
}
return(result);
}
+static Xen g_status_report(Xen msg, Xen snd)
+{
+ #define H_status_report "(" S_status_report " message :optional snd) posts message in snd's status area.\
+If 'snd' is not a currently open sound, the message is sent to the listener, if it is open. \
+If there is no sound or listener, it is sent to stderr."
-#ifdef XEN_ARGIFY_1
-
-XEN_NARGIFY_1(g_sound_p_w, g_sound_p)
-XEN_ARGIFY_2(g_bomb_w, g_bomb)
-XEN_ARGIFY_2(g_find_sound_w, g_find_sound)
-XEN_ARGIFY_1(g_channels_w, g_channels)
-XEN_ARGIFY_2(g_set_channels_w, g_set_channels)
-XEN_ARGIFY_1(g_srate_w, g_srate)
-XEN_ARGIFY_2(g_set_srate_w, g_set_srate)
-XEN_ARGIFY_1(g_data_location_w, g_data_location)
-XEN_ARGIFY_2(g_set_data_location_w, g_set_data_location)
-XEN_ARGIFY_1(g_data_size_w, g_data_size)
-XEN_ARGIFY_2(g_set_data_size_w, g_set_data_size)
-XEN_ARGIFY_1(g_data_format_w, g_data_format)
-XEN_ARGIFY_2(g_set_data_format_w, g_set_data_format)
-XEN_ARGIFY_1(g_header_type_w, g_header_type)
-XEN_ARGIFY_2(g_set_header_type_w, g_set_header_type)
-XEN_ARGIFY_1(g_comment_w, g_comment)
-XEN_ARGIFY_2(g_set_comment_w, g_set_comment)
-XEN_ARGIFY_1(g_file_name_w, g_file_name)
-XEN_ARGIFY_1(g_short_file_name_w, g_short_file_name)
-XEN_ARGIFY_1(g_save_controls_w, g_save_controls)
-XEN_ARGIFY_1(g_restore_controls_w, g_restore_controls)
-XEN_ARGIFY_1(g_reset_controls_w, g_reset_controls)
-XEN_NARGIFY_0(g_selected_sound_w, g_selected_sound)
-XEN_ARGIFY_1(g_selected_channel_w, g_selected_channel)
-XEN_ARGIFY_2(g_set_selected_channel_w, g_set_selected_channel)
-XEN_NARGIFY_1(g_select_sound_w, g_select_sound)
-XEN_ARGIFY_1(g_select_channel_w, g_select_channel)
-XEN_ARGIFY_1(g_close_sound_w, g_close_sound)
-XEN_ARGIFY_1(g_update_sound_w, g_update_sound)
-XEN_ARGIFY_1(g_save_sound_w, g_save_sound)
-XEN_NARGIFY_1(g_open_sound_w, g_open_sound)
-XEN_VARGIFY(g_open_raw_sound_w, g_open_raw_sound)
-XEN_NARGIFY_1(g_view_sound_w, g_view_sound)
-XEN_VARGIFY(g_new_sound_w, g_new_sound)
-XEN_ARGIFY_1(g_revert_sound_w, g_revert_sound)
-XEN_VARGIFY(g_save_sound_as_w, g_save_sound_as)
-XEN_ARGIFY_4(g_apply_controls_w, g_apply_controls)
-XEN_ARGIFY_6(g_controls_to_channel_w, g_controls_to_channel)
-XEN_ARGIFY_1(g_filter_control_envelope_w, g_filter_control_envelope)
-XEN_ARGIFY_2(g_set_filter_control_envelope_w, g_set_filter_control_envelope)
-XEN_ARGIFY_1(g_show_controls_w, g_show_controls)
-XEN_ARGIFY_2(g_set_show_controls_w, g_set_show_controls)
-XEN_ARGIFY_1(g_sync_w, g_sync)
-XEN_ARGIFY_2(g_set_sync_w, g_set_sync)
-XEN_NARGIFY_0(g_sync_max_w, g_sync_max)
-XEN_ARGIFY_1(g_sound_properties_w, g_sound_properties)
-XEN_ARGIFY_2(g_set_sound_properties_w, g_set_sound_properties)
-XEN_ARGIFY_2(g_sound_property_w, g_sound_property)
-XEN_ARGIFY_3(g_set_sound_property_w, g_set_sound_property)
-XEN_ARGIFY_1(g_channel_style_w, g_channel_style)
-XEN_ARGIFY_2(g_set_channel_style_w, g_set_channel_style)
-XEN_ARGIFY_1(g_read_only_w, g_read_only)
-XEN_ARGIFY_2(g_set_read_only_w, g_set_read_only)
-XEN_ARGIFY_1(g_expand_control_p_w, g_expand_control_p)
-XEN_ARGIFY_2(g_set_expand_control_p_w, g_set_expand_control_p)
-XEN_ARGIFY_1(g_contrast_control_p_w, g_contrast_control_p)
-XEN_ARGIFY_2(g_set_contrast_control_p_w, g_set_contrast_control_p)
-XEN_ARGIFY_1(g_reverb_control_p_w, g_reverb_control_p)
-XEN_ARGIFY_2(g_set_reverb_control_p_w, g_set_reverb_control_p)
-XEN_ARGIFY_1(g_filter_control_p_w, g_filter_control_p)
-XEN_ARGIFY_2(g_set_filter_control_p_w, g_set_filter_control_p)
-XEN_ARGIFY_1(g_filter_control_in_dB_w, g_filter_control_in_dB)
-XEN_ARGIFY_2(g_set_filter_control_in_dB_w, g_set_filter_control_in_dB)
-XEN_ARGIFY_1(g_filter_control_in_hz_w, g_filter_control_in_hz)
-XEN_ARGIFY_2(g_set_filter_control_in_hz_w, g_set_filter_control_in_hz)
-XEN_ARGIFY_1(g_filter_control_coeffs_w, g_filter_control_coeffs)
-XEN_ARGIFY_1(g_filter_control_order_w, g_filter_control_order)
-XEN_ARGIFY_2(g_set_filter_control_order_w, g_set_filter_control_order)
-XEN_ARGIFY_1(g_contrast_control_w, g_contrast_control)
-XEN_ARGIFY_2(g_set_contrast_control_w, g_set_contrast_control)
-XEN_ARGIFY_1(g_contrast_control_bounds_w, g_contrast_control_bounds)
-XEN_ARGIFY_2(g_set_contrast_control_bounds_w, g_set_contrast_control_bounds)
-XEN_ARGIFY_1(g_contrast_control_amp_w, g_contrast_control_amp)
-XEN_ARGIFY_2(g_set_contrast_control_amp_w, g_set_contrast_control_amp)
-XEN_ARGIFY_1(g_expand_control_w, g_expand_control)
-XEN_ARGIFY_2(g_set_expand_control_w, g_set_expand_control)
-XEN_ARGIFY_1(g_expand_control_bounds_w, g_expand_control_bounds)
-XEN_ARGIFY_2(g_set_expand_control_bounds_w, g_set_expand_control_bounds)
-XEN_ARGIFY_1(g_expand_control_length_w, g_expand_control_length)
-XEN_ARGIFY_2(g_set_expand_control_length_w, g_set_expand_control_length)
-XEN_ARGIFY_1(g_expand_control_ramp_w, g_expand_control_ramp)
-XEN_ARGIFY_2(g_set_expand_control_ramp_w, g_set_expand_control_ramp)
-XEN_ARGIFY_1(g_expand_control_hop_w, g_expand_control_hop)
-XEN_ARGIFY_2(g_set_expand_control_hop_w, g_set_expand_control_hop)
-XEN_ARGIFY_1(g_expand_control_jitter_w, g_expand_control_jitter)
-XEN_ARGIFY_2(g_set_expand_control_jitter_w, g_set_expand_control_jitter)
-XEN_ARGIFY_1(g_speed_control_w, g_speed_control)
-XEN_ARGIFY_2(g_set_speed_control_w, g_set_speed_control)
-XEN_ARGIFY_1(g_speed_control_bounds_w, g_speed_control_bounds)
-XEN_ARGIFY_2(g_set_speed_control_bounds_w, g_set_speed_control_bounds)
-XEN_ARGIFY_1(g_reverb_control_length_w, g_reverb_control_length)
-XEN_ARGIFY_2(g_set_reverb_control_length_w, g_set_reverb_control_length)
-XEN_ARGIFY_1(g_reverb_control_length_bounds_w, g_reverb_control_length_bounds)
-XEN_ARGIFY_2(g_set_reverb_control_length_bounds_w, g_set_reverb_control_length_bounds)
-XEN_ARGIFY_1(g_reverb_control_scale_w, g_reverb_control_scale)
-XEN_ARGIFY_2(g_set_reverb_control_scale_w, g_set_reverb_control_scale)
-XEN_ARGIFY_1(g_reverb_control_scale_bounds_w, g_reverb_control_scale_bounds)
-XEN_ARGIFY_2(g_set_reverb_control_scale_bounds_w, g_set_reverb_control_scale_bounds)
-XEN_ARGIFY_1(g_reverb_control_feedback_w, g_reverb_control_feedback)
-XEN_ARGIFY_2(g_set_reverb_control_feedback_w, g_set_reverb_control_feedback)
-XEN_ARGIFY_1(g_reverb_control_lowpass_w, g_reverb_control_lowpass)
-XEN_ARGIFY_2(g_set_reverb_control_lowpass_w, g_set_reverb_control_lowpass)
-XEN_ARGIFY_2(g_amp_control_w, g_amp_control)
-XEN_ARGIFY_3(g_set_amp_control_w, g_set_amp_control)
-XEN_ARGIFY_1(g_amp_control_bounds_w, g_amp_control_bounds)
-XEN_ARGIFY_2(g_set_amp_control_bounds_w, g_set_amp_control_bounds)
-XEN_ARGIFY_1(g_reverb_control_decay_w, g_reverb_control_decay)
-XEN_ARGIFY_2(g_set_reverb_control_decay_w, g_set_reverb_control_decay)
-XEN_ARGIFY_1(g_speed_control_style_w, g_speed_control_style)
-XEN_ARGIFY_2(g_set_speed_control_style_w, g_set_speed_control_style)
-XEN_ARGIFY_1(g_speed_control_tones_w, g_speed_control_tones)
-XEN_ARGIFY_2(g_set_speed_control_tones_w, g_set_speed_control_tones)
-XEN_ARGIFY_5(g_channel_amp_envs_w, g_channel_amp_envs);
-XEN_ARGIFY_2(g_start_progress_report_w, g_start_progress_report)
-XEN_ARGIFY_2(g_finish_progress_report_w, g_finish_progress_report)
-XEN_ARGIFY_3(g_progress_report_w, g_progress_report)
-XEN_NARGIFY_0(g_sounds_w, g_sounds)
-XEN_NARGIFY_1(g_integer_to_sound_w, g_integer_to_sound)
-XEN_NARGIFY_1(g_sound_to_integer_w, g_sound_to_integer)
+ snd_info *sp;
+ const char *message;
-#else
+ Xen_check_type(Xen_is_string(msg), msg, 1, S_status_report, "a string");
+ Snd_assert_sound(S_status_report, snd, 2);
-#define g_sound_p_w g_sound_p
-#define g_bomb_w g_bomb
-#define g_find_sound_w g_find_sound
-#define g_channels_w g_channels
-#define g_set_channels_w g_set_channels
-#define g_srate_w g_srate
-#define g_set_srate_w g_set_srate
-#define g_data_location_w g_data_location
-#define g_set_data_location_w g_set_data_location
-#define g_data_size_w g_data_size
-#define g_set_data_size_w g_set_data_size
-#define g_data_format_w g_data_format
-#define g_set_data_format_w g_set_data_format
-#define g_header_type_w g_header_type
-#define g_set_header_type_w g_set_header_type
-#define g_comment_w g_comment
-#define g_set_comment_w g_set_comment
-#define g_file_name_w g_file_name
-#define g_short_file_name_w g_short_file_name
-#define g_save_controls_w g_save_controls
-#define g_restore_controls_w g_restore_controls
-#define g_reset_controls_w g_reset_controls
-#define g_selected_sound_w g_selected_sound
-#define g_selected_channel_w g_selected_channel
-#define g_set_selected_channel_w g_set_selected_channel
-#define g_select_sound_w g_select_sound
-#define g_select_channel_w g_select_channel
-#define g_close_sound_w g_close_sound
-#define g_update_sound_w g_update_sound
-#define g_save_sound_w g_save_sound
-#define g_open_sound_w g_open_sound
-#define g_open_raw_sound_w g_open_raw_sound
-#define g_view_sound_w g_view_sound
-#define g_new_sound_w g_new_sound
-#define g_revert_sound_w g_revert_sound
-#define g_save_sound_as_w g_save_sound_as
-#define g_apply_controls_w g_apply_controls
-#define g_controls_to_channel_w g_controls_to_channel
-#define g_filter_control_envelope_w g_filter_control_envelope
-#define g_set_filter_control_envelope_w g_set_filter_control_envelope
-#define g_show_controls_w g_show_controls
-#define g_set_show_controls_w g_set_show_controls
-#define g_sync_w g_sync
-#define g_set_sync_w g_set_sync
-#define g_sync_max_w g_sync_max
-#define g_sound_properties_w g_sound_properties
-#define g_set_sound_properties_w g_set_sound_properties
-#define g_sound_property_w g_sound_property
-#define g_set_sound_property_w g_set_sound_property
-#define g_channel_style_w g_channel_style
-#define g_set_channel_style_w g_set_channel_style
-#define g_read_only_w g_read_only
-#define g_set_read_only_w g_set_read_only
-#define g_expand_control_p_w g_expand_control_p
-#define g_set_expand_control_p_w g_set_expand_control_p
-#define g_contrast_control_p_w g_contrast_control_p
-#define g_set_contrast_control_p_w g_set_contrast_control_p
-#define g_reverb_control_p_w g_reverb_control_p
-#define g_set_reverb_control_p_w g_set_reverb_control_p
-#define g_filter_control_p_w g_filter_control_p
-#define g_set_filter_control_p_w g_set_filter_control_p
-#define g_filter_control_in_dB_w g_filter_control_in_dB
-#define g_set_filter_control_in_dB_w g_set_filter_control_in_dB
-#define g_filter_control_in_hz_w g_filter_control_in_hz
-#define g_set_filter_control_in_hz_w g_set_filter_control_in_hz
-#define g_filter_control_coeffs_w g_filter_control_coeffs
-#define g_filter_control_order_w g_filter_control_order
-#define g_set_filter_control_order_w g_set_filter_control_order
-#define g_contrast_control_w g_contrast_control
-#define g_set_contrast_control_w g_set_contrast_control
-#define g_contrast_control_bounds_w g_contrast_control_bounds
-#define g_set_contrast_control_bounds_w g_set_contrast_control_bounds
-#define g_contrast_control_amp_w g_contrast_control_amp
-#define g_set_contrast_control_amp_w g_set_contrast_control_amp
-#define g_expand_control_w g_expand_control
-#define g_set_expand_control_w g_set_expand_control
-#define g_expand_control_bounds_w g_expand_control_bounds
-#define g_set_expand_control_bounds_w g_set_expand_control_bounds
-#define g_expand_control_length_w g_expand_control_length
-#define g_set_expand_control_length_w g_set_expand_control_length
-#define g_expand_control_ramp_w g_expand_control_ramp
-#define g_set_expand_control_ramp_w g_set_expand_control_ramp
-#define g_expand_control_hop_w g_expand_control_hop
-#define g_set_expand_control_hop_w g_set_expand_control_hop
-#define g_expand_control_jitter_w g_expand_control_jitter
-#define g_set_expand_control_jitter_w g_set_expand_control_jitter
-#define g_speed_control_w g_speed_control
-#define g_set_speed_control_w g_set_speed_control
-#define g_speed_control_bounds_w g_speed_control_bounds
-#define g_set_speed_control_bounds_w g_set_speed_control_bounds
-#define g_reverb_control_length_w g_reverb_control_length
-#define g_set_reverb_control_length_w g_set_reverb_control_length
-#define g_reverb_control_length_bounds_w g_reverb_control_length_bounds
-#define g_set_reverb_control_length_bounds_w g_set_reverb_control_length_bounds
-#define g_reverb_control_scale_w g_reverb_control_scale
-#define g_set_reverb_control_scale_w g_set_reverb_control_scale
-#define g_reverb_control_scale_bounds_w g_reverb_control_scale_bounds
-#define g_set_reverb_control_scale_bounds_w g_set_reverb_control_scale_bounds
-#define g_reverb_control_feedback_w g_reverb_control_feedback
-#define g_set_reverb_control_feedback_w g_set_reverb_control_feedback
-#define g_reverb_control_lowpass_w g_reverb_control_lowpass
-#define g_set_reverb_control_lowpass_w g_set_reverb_control_lowpass
-#define g_amp_control_w g_amp_control
-#define g_set_amp_control_w g_set_amp_control
-#define g_amp_control_bounds_w g_amp_control_bounds
-#define g_set_amp_control_bounds_w g_set_amp_control_bounds
-#define g_reverb_control_decay_w g_reverb_control_decay
-#define g_set_reverb_control_decay_w g_set_reverb_control_decay
-#define g_speed_control_style_w g_speed_control_style
-#define g_set_speed_control_style_w g_set_speed_control_style
-#define g_speed_control_tones_w g_speed_control_tones
-#define g_set_speed_control_tones_w g_set_speed_control_tones
-#define g_channel_amp_envs_w g_channel_amp_envs
-#define g_start_progress_report_w g_start_progress_report
-#define g_finish_progress_report_w g_finish_progress_report
-#define g_progress_report_w g_progress_report
-#define g_sounds_w g_sounds
-#define g_integer_to_sound_w g_integer_to_sound
-#define g_sound_to_integer_w g_sound_to_integer
+ message = Xen_string_to_C_string(msg);
+ sp = get_sp(snd);
+ if ((sp == NULL) ||
+ (sp->inuse != SOUND_NORMAL))
+ {
+ if ((message) && (*message))
+ {
+ if (listener_exists())
+ append_listener_text(-1, message);
+ else fprintf(stderr, "%s", message);
+ }
+ }
+ else
+ {
+ if ((message) && (*message))
+ set_status(sp, message, false);
+ else clear_status_area(sp);
+ }
+ return(msg);
+}
+
+
+Xen_wrap_1_arg(g_is_sound_w, g_is_sound)
+Xen_wrap_2_optional_args(g_find_sound_w, g_find_sound)
+Xen_wrap_1_optional_arg(g_channels_w, g_channels)
+Xen_wrap_2_optional_args(g_set_channels_w, g_set_channels)
+Xen_wrap_1_optional_arg(g_srate_w, g_srate)
+Xen_wrap_2_optional_args(g_set_srate_w, g_set_srate)
+Xen_wrap_1_optional_arg(g_data_location_w, g_data_location)
+Xen_wrap_2_optional_args(g_set_data_location_w, g_set_data_location)
+Xen_wrap_1_optional_arg(g_data_size_w, g_data_size)
+Xen_wrap_2_optional_args(g_set_data_size_w, g_set_data_size)
+Xen_wrap_1_optional_arg(g_sample_type_w, g_sample_type)
+Xen_wrap_2_optional_args(g_set_sample_type_w, g_set_sample_type)
+Xen_wrap_1_optional_arg(g_header_type_w, g_header_type)
+Xen_wrap_2_optional_args(g_set_header_type_w, g_set_header_type)
+Xen_wrap_1_optional_arg(g_comment_w, g_comment)
+Xen_wrap_2_optional_args(g_set_comment_w, g_set_comment)
+Xen_wrap_1_optional_arg(g_file_name_w, g_file_name)
+Xen_wrap_1_optional_arg(g_short_file_name_w, g_short_file_name)
+Xen_wrap_1_optional_arg(g_save_controls_w, g_save_controls)
+Xen_wrap_1_optional_arg(g_restore_controls_w, g_restore_controls)
+Xen_wrap_1_optional_arg(g_reset_controls_w, g_reset_controls)
+Xen_wrap_no_args(g_selected_sound_w, g_selected_sound)
+Xen_wrap_1_optional_arg(g_selected_channel_w, g_selected_channel)
+Xen_wrap_2_optional_args(g_set_selected_channel_w, g_set_selected_channel)
+Xen_wrap_1_arg(g_select_sound_w, g_select_sound)
+Xen_wrap_1_optional_arg(g_select_channel_w, g_select_channel)
+Xen_wrap_1_optional_arg(g_close_sound_w, g_close_sound)
+Xen_wrap_1_optional_arg(g_update_sound_w, g_update_sound)
+Xen_wrap_1_optional_arg(g_save_sound_w, g_save_sound)
+Xen_wrap_1_arg(g_open_sound_w, g_open_sound)
+Xen_wrap_any_args(g_open_raw_sound_w, g_open_raw_sound)
+Xen_wrap_1_arg(g_view_sound_w, g_view_sound)
+Xen_wrap_any_args(g_new_sound_w, g_new_sound)
+Xen_wrap_1_optional_arg(g_revert_sound_w, g_revert_sound)
+Xen_wrap_any_args(g_save_sound_as_w, g_save_sound_as)
+Xen_wrap_4_optional_args(g_apply_controls_w, g_apply_controls)
+Xen_wrap_6_optional_args(g_controls_to_channel_w, g_controls_to_channel)
+Xen_wrap_1_optional_arg(g_filter_control_envelope_w, g_filter_control_envelope)
+Xen_wrap_1_optional_arg(g_show_controls_w, g_show_controls)
+Xen_wrap_1_optional_arg(g_sync_w, g_sync)
+Xen_wrap_no_args(g_sync_max_w, g_sync_max)
+Xen_wrap_1_optional_arg(g_sound_properties_w, g_sound_properties)
+Xen_wrap_2_optional_args(g_sound_property_w, g_sound_property)
+Xen_wrap_1_optional_arg(g_channel_style_w, g_channel_style)
+Xen_wrap_1_optional_arg(g_read_only_w, g_read_only)
+Xen_wrap_1_optional_arg(g_expand_control_on_w, g_expand_control_on)
+Xen_wrap_1_optional_arg(g_contrast_control_on_w, g_contrast_control_on)
+Xen_wrap_1_optional_arg(g_reverb_control_on_w, g_reverb_control_on)
+Xen_wrap_1_optional_arg(g_filter_control_on_w, g_filter_control_on)
+Xen_wrap_1_optional_arg(g_filter_control_in_dB_w, g_filter_control_in_dB)
+Xen_wrap_1_optional_arg(g_filter_control_in_hz_w, g_filter_control_in_hz)
+Xen_wrap_1_optional_arg(g_filter_control_coeffs_w, g_filter_control_coeffs)
+Xen_wrap_1_optional_arg(g_filter_control_order_w, g_filter_control_order)
+Xen_wrap_1_optional_arg(g_contrast_control_w, g_contrast_control)
+Xen_wrap_1_optional_arg(g_contrast_control_bounds_w, g_contrast_control_bounds)
+Xen_wrap_1_optional_arg(g_contrast_control_amp_w, g_contrast_control_amp)
+Xen_wrap_1_optional_arg(g_expand_control_w, g_expand_control)
+Xen_wrap_1_optional_arg(g_expand_control_bounds_w, g_expand_control_bounds)
+Xen_wrap_1_optional_arg(g_expand_control_length_w, g_expand_control_length)
+Xen_wrap_1_optional_arg(g_expand_control_ramp_w, g_expand_control_ramp)
+Xen_wrap_1_optional_arg(g_expand_control_hop_w, g_expand_control_hop)
+Xen_wrap_1_optional_arg(g_expand_control_jitter_w, g_expand_control_jitter)
+Xen_wrap_1_optional_arg(g_speed_control_w, g_speed_control)
+Xen_wrap_1_optional_arg(g_speed_control_bounds_w, g_speed_control_bounds)
+Xen_wrap_1_optional_arg(g_reverb_control_length_w, g_reverb_control_length)
+Xen_wrap_1_optional_arg(g_reverb_control_length_bounds_w, g_reverb_control_length_bounds)
+Xen_wrap_1_optional_arg(g_reverb_control_scale_w, g_reverb_control_scale)
+Xen_wrap_1_optional_arg(g_reverb_control_scale_bounds_w, g_reverb_control_scale_bounds)
+Xen_wrap_1_optional_arg(g_reverb_control_feedback_w, g_reverb_control_feedback)
+Xen_wrap_1_optional_arg(g_reverb_control_lowpass_w, g_reverb_control_lowpass)
+Xen_wrap_2_optional_args(g_amp_control_w, g_amp_control)
+Xen_wrap_1_optional_arg(g_amp_control_bounds_w, g_amp_control_bounds)
+Xen_wrap_1_optional_arg(g_reverb_control_decay_w, g_reverb_control_decay)
+Xen_wrap_1_optional_arg(g_speed_control_style_w, g_speed_control_style)
+Xen_wrap_1_optional_arg(g_speed_control_tones_w, g_speed_control_tones)
+Xen_wrap_5_optional_args(g_channel_amp_envs_w, g_channel_amp_envs);
+Xen_wrap_2_optional_args(g_start_progress_report_w, g_start_progress_report)
+Xen_wrap_2_optional_args(g_finish_progress_report_w, g_finish_progress_report)
+Xen_wrap_3_optional_args(g_progress_report_w, g_progress_report)
+Xen_wrap_no_args(g_sounds_w, g_sounds)
+Xen_wrap_1_arg(g_integer_to_sound_w, g_integer_to_sound)
+Xen_wrap_1_arg(g_sound_to_integer_w, g_sound_to_integer)
+Xen_wrap_2_optional_args(g_status_report_w, g_status_report)
+#if HAVE_SCHEME
+#define g_set_filter_control_envelope_w g_set_filter_control_envelope_reversed
+#define g_set_read_only_w g_set_read_only_reversed
+#define g_set_sound_properties_w g_set_sound_properties_reversed
+#define g_set_sound_property_w g_set_sound_property_reversed
+#define g_set_sync_w g_set_sync_reversed
+#define g_set_channel_style_w g_set_channel_style_reversed
+#define g_set_show_controls_w g_set_show_controls_reversed
+#define g_set_expand_control_on_w g_set_expand_control_on_reversed
+#define g_set_contrast_control_on_w g_set_contrast_control_on_reversed
+#define g_set_reverb_control_on_w g_set_reverb_control_on_reversed
+#define g_set_filter_control_on_w g_set_filter_control_on_reversed
+#define g_set_filter_control_in_dB_w g_set_filter_control_in_dB_reversed
+#define g_set_filter_control_in_hz_w g_set_filter_control_in_hz_reversed
+#define g_set_filter_control_order_w g_set_filter_control_order_reversed
+#define g_set_contrast_control_w g_set_contrast_control_reversed
+#define g_set_contrast_control_bounds_w g_set_contrast_control_bounds_reversed
+#define g_set_contrast_control_amp_w g_set_contrast_control_amp_reversed
+#define g_set_expand_control_w g_set_expand_control_reversed
+#define g_set_expand_control_bounds_w g_set_expand_control_bounds_reversed
+#define g_set_expand_control_length_w g_set_expand_control_length_reversed
+#define g_set_expand_control_ramp_w g_set_expand_control_ramp_reversed
+#define g_set_expand_control_hop_w g_set_expand_control_hop_reversed
+#define g_set_expand_control_jitter_w g_set_expand_control_jitter_reversed
+#define g_set_speed_control_w g_set_speed_control_reversed
+#define g_set_speed_control_bounds_w g_set_speed_control_bounds_reversed
+#define g_set_reverb_control_length_w g_set_reverb_control_length_reversed
+#define g_set_reverb_control_length_bounds_w g_set_reverb_control_length_bounds_reversed
+#define g_set_reverb_control_scale_w g_set_reverb_control_scale_reversed
+#define g_set_reverb_control_scale_bounds_w g_set_reverb_control_scale_bounds_reversed
+#define g_set_reverb_control_feedback_w g_set_reverb_control_feedback_reversed
+#define g_set_reverb_control_lowpass_w g_set_reverb_control_lowpass_reversed
+#define g_set_amp_control_w g_set_amp_control_reversed
+#define g_set_amp_control_bounds_w g_set_amp_control_bounds_reversed
+#define g_set_reverb_control_decay_w g_set_reverb_control_decay_reversed
+#define g_set_speed_control_style_w g_set_speed_control_style_reversed
+#define g_set_speed_control_tones_w g_set_speed_control_tones_reversed
+#else
+Xen_wrap_2_optional_args(g_set_filter_control_envelope_w, g_set_filter_control_envelope)
+Xen_wrap_2_optional_args(g_set_read_only_w, g_set_read_only)
+Xen_wrap_2_optional_args(g_set_sound_properties_w, g_set_sound_properties)
+Xen_wrap_3_optional_args(g_set_sound_property_w, g_set_sound_property)
+Xen_wrap_2_optional_args(g_set_sync_w, g_set_sync)
+Xen_wrap_2_optional_args(g_set_channel_style_w, g_set_channel_style)
+Xen_wrap_2_optional_args(g_set_show_controls_w, g_set_show_controls)
+Xen_wrap_2_optional_args(g_set_expand_control_on_w, g_set_expand_control_on)
+Xen_wrap_2_optional_args(g_set_contrast_control_on_w, g_set_contrast_control_on)
+Xen_wrap_2_optional_args(g_set_reverb_control_on_w, g_set_reverb_control_on)
+Xen_wrap_2_optional_args(g_set_filter_control_on_w, g_set_filter_control_on)
+Xen_wrap_2_optional_args(g_set_filter_control_in_dB_w, g_set_filter_control_in_dB)
+Xen_wrap_2_optional_args(g_set_filter_control_in_hz_w, g_set_filter_control_in_hz)
+Xen_wrap_2_optional_args(g_set_filter_control_order_w, g_set_filter_control_order)
+Xen_wrap_2_optional_args(g_set_contrast_control_w, g_set_contrast_control)
+Xen_wrap_2_optional_args(g_set_contrast_control_bounds_w, g_set_contrast_control_bounds)
+Xen_wrap_2_optional_args(g_set_contrast_control_amp_w, g_set_contrast_control_amp)
+Xen_wrap_2_optional_args(g_set_expand_control_w, g_set_expand_control)
+Xen_wrap_2_optional_args(g_set_expand_control_bounds_w, g_set_expand_control_bounds)
+Xen_wrap_2_optional_args(g_set_expand_control_length_w, g_set_expand_control_length)
+Xen_wrap_2_optional_args(g_set_expand_control_ramp_w, g_set_expand_control_ramp)
+Xen_wrap_2_optional_args(g_set_expand_control_hop_w, g_set_expand_control_hop)
+Xen_wrap_2_optional_args(g_set_expand_control_jitter_w, g_set_expand_control_jitter)
+Xen_wrap_2_optional_args(g_set_speed_control_w, g_set_speed_control)
+Xen_wrap_2_optional_args(g_set_speed_control_bounds_w, g_set_speed_control_bounds)
+Xen_wrap_2_optional_args(g_set_reverb_control_length_w, g_set_reverb_control_length)
+Xen_wrap_2_optional_args(g_set_reverb_control_length_bounds_w, g_set_reverb_control_length_bounds)
+Xen_wrap_2_optional_args(g_set_reverb_control_scale_w, g_set_reverb_control_scale)
+Xen_wrap_2_optional_args(g_set_reverb_control_scale_bounds_w, g_set_reverb_control_scale_bounds)
+Xen_wrap_2_optional_args(g_set_reverb_control_feedback_w, g_set_reverb_control_feedback)
+Xen_wrap_2_optional_args(g_set_reverb_control_lowpass_w, g_set_reverb_control_lowpass)
+Xen_wrap_3_optional_args(g_set_amp_control_w, g_set_amp_control)
+Xen_wrap_2_optional_args(g_set_amp_control_bounds_w, g_set_amp_control_bounds)
+Xen_wrap_2_optional_args(g_set_reverb_control_decay_w, g_set_reverb_control_decay)
+Xen_wrap_2_optional_args(g_set_speed_control_style_w, g_set_speed_control_style)
+Xen_wrap_2_optional_args(g_set_speed_control_tones_w, g_set_speed_control_tones)
+#endif
+
+#if HAVE_SCHEME
+static s7_pointer acc_channel_style(s7_scheme *sc, s7_pointer args) {return(g_set_channel_style(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_filter_control_in_dB(s7_scheme *sc, s7_pointer args) {return(g_set_filter_control_in_dB(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_filter_control_in_hz(s7_scheme *sc, s7_pointer args) {return(g_set_filter_control_in_hz(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_speed_control_tones(s7_scheme *sc, s7_pointer args) {return(g_set_speed_control_tones(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_speed_control_style(s7_scheme *sc, s7_pointer args) {return(g_set_speed_control_style(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_expand_control_length(s7_scheme *sc, s7_pointer args) {return(g_set_expand_control_length(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_expand_control_ramp(s7_scheme *sc, s7_pointer args) {return(g_set_expand_control_ramp(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_expand_control_hop(s7_scheme *sc, s7_pointer args) {return(g_set_expand_control_hop(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_expand_control_jitter(s7_scheme *sc, s7_pointer args) {return(g_set_expand_control_jitter(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_contrast_control_amp(s7_scheme *sc, s7_pointer args) {return(g_set_contrast_control_amp(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_reverb_control_feedback(s7_scheme *sc, s7_pointer args) {return(g_set_reverb_control_feedback(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_reverb_control_lowpass(s7_scheme *sc, s7_pointer args) {return(g_set_reverb_control_lowpass(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_reverb_control_decay(s7_scheme *sc, s7_pointer args) {return(g_set_reverb_control_decay(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_filter_control_order(s7_scheme *sc, s7_pointer args) {return(g_set_filter_control_order(s7_cadr(args), s7_undefined(sc)));}
+static s7_pointer acc_show_controls(s7_scheme *sc, s7_pointer args) {return(g_set_show_controls(s7_cadr(args), s7_undefined(sc)));}
#endif
void g_init_snd(void)
{
+#if HAVE_SCHEME
+ s7_pointer pl_iq, pl_iqi, pl_sq, pl_sts, pl_i, pl_osi, pl_bt, pl_bo, pl_bob, pl_io, pl_ioi, pl_po, pl_pop, pl_ro, pl_ror, pl_oi, pl_ioz;
+ {
+ s7_pointer i, t, s, b, o, q, p, r, z;
+ i = s7_make_symbol(s7, "integer?");
+ s = s7_make_symbol(s7, "string?");
+ b = s7_make_symbol(s7, "boolean?");
+ p = s7_make_symbol(s7, "pair?");
+ r = s7_make_symbol(s7, "real?");
+ t = s7_t(s7);
+ q = t; /* sigh -- #t is legal here which is idiotic */
+ o = t;
+ z = s7_make_signature(s7, 2, i, b);
+ pl_i = s7_make_signature(s7, 1, i);
+ pl_iq = s7_make_signature(s7, 2, i, q);
+ pl_iqi = s7_make_signature(s7, 3, i, q, i);
+ pl_sts = s7_make_signature(s7, 3, s, t, s);
+ pl_sq = s7_make_signature(s7, 2, s, q);
+ pl_osi = s7_make_signature(s7, 3, o, s, i);
+ pl_bt = s7_make_signature(s7, 2, b, t);
+ pl_bo = s7_make_signature(s7, 2, b, o);
+ pl_bob = s7_make_signature(s7, 3, b, o, b);
+ pl_io = s7_make_signature(s7, 2, i, o);
+ pl_oi = s7_make_signature(s7, 2, o, i);
+ pl_ioi = s7_make_signature(s7, 3, i, o, i);
+ pl_ioz = s7_make_signature(s7, 3, i, o, z);
+ pl_po = s7_make_signature(s7, 2, p, o);
+ pl_pop = s7_make_signature(s7, 3, p, o, p);
+ pl_ro = s7_make_signature(s7, 2, r, o);
+ pl_ror = s7_make_signature(s7, 3, r, o, r);
+ }
+#endif
+
init_xen_sound();
init_sound_keywords();
#define H_name_click_hook S_name_click_hook " (snd): called when sound name clicked. \
-If it returns " PROC_TRUE ", the usual informative minibuffer babbling is squelched."
+If it returns " PROC_TRUE ", the usual informative status babbling is squelched."
#define H_after_apply_controls_hook S_after_apply_controls_hook " (snd): called when " S_apply_controls " finishes."
- #define H_peak_env_hook S_peak_env_hook " (snd chn): called when a new peak env is ready."
-
- name_click_hook = XEN_DEFINE_HOOK(S_name_click_hook, 1, H_name_click_hook); /* args = snd-index */
- after_apply_controls_hook = XEN_DEFINE_HOOK(S_after_apply_controls_hook, 1, H_after_apply_controls_hook); /* args = snd-index */
- peak_env_hook = XEN_DEFINE_HOOK(S_peak_env_hook, 2, H_peak_env_hook); /* args = snd-index, chan */
+ name_click_hook = Xen_define_hook(S_name_click_hook, "(make-hook 'snd)", 1, H_name_click_hook);
+ after_apply_controls_hook = Xen_define_hook(S_after_apply_controls_hook, "(make-hook 'snd)", 1, H_after_apply_controls_hook);
#define H_channels_separate "The value for " S_channel_style " that causes channel graphs to occupy separate panes"
#define H_channels_combined "The value for " S_channel_style " that causes channel graphs to occupy one pane (set by the 'unite' button)"
#define H_channels_superimposed "The value for " S_channel_style " that causes channel graphs to occupy one pane and one axis"
- XEN_DEFINE_CONSTANT(S_channels_separate, CHANNELS_SEPARATE, H_channels_separate);
- XEN_DEFINE_CONSTANT(S_channels_combined, CHANNELS_COMBINED, H_channels_combined);
- XEN_DEFINE_CONSTANT(S_channels_superimposed, CHANNELS_SUPERIMPOSED, H_channels_superimposed);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_channels, g_channels_w, H_channels, S_setB S_channels, g_set_channels_w, 0, 1, 1, 1);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_chans, g_channels_w, H_channels, S_setB S_chans, g_set_channels_w, 0, 1, 1, 1);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_srate, g_srate_w, H_srate, S_setB S_srate, g_set_srate_w, 0, 1, 1, 1);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_data_location, g_data_location_w, H_data_location, S_setB S_data_location, g_set_data_location_w, 0, 1, 1, 1);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_data_size, g_data_size_w, H_data_size, S_setB S_data_size, g_set_data_size_w, 0, 1, 1, 1);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_data_format, g_data_format_w, H_data_format, S_setB S_data_format, g_set_data_format_w, 0, 1, 1, 1);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_header_type, g_header_type_w, H_header_type, S_setB S_header_type, g_set_header_type_w, 0, 1, 1, 1);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_comment, g_comment_w, H_comment, S_setB S_comment, g_set_comment_w, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE(S_sound_p, g_sound_p_w, 1, 0, 0, H_sound_p);
- XEN_DEFINE_PROCEDURE(S_bomb, g_bomb_w, 0, 2, 0, H_bomb);
- XEN_DEFINE_PROCEDURE(S_find_sound, g_find_sound_w, 1, 1, 0, H_find_sound);
- XEN_DEFINE_PROCEDURE(S_file_name, g_file_name_w, 0, 1, 0, H_file_name);
- XEN_DEFINE_PROCEDURE(S_short_file_name, g_short_file_name_w, 0, 1, 0, H_short_file_name);
- XEN_DEFINE_PROCEDURE(S_save_controls, g_save_controls_w, 0, 1, 0, H_save_controls);
- XEN_DEFINE_PROCEDURE(S_restore_controls, g_restore_controls_w, 0, 1, 0, H_restore_controls);
- XEN_DEFINE_PROCEDURE(S_reset_controls, g_reset_controls_w, 0, 1, 0, H_reset_controls);
- XEN_DEFINE_PROCEDURE(S_select_sound, g_select_sound_w, 1, 0, 0, H_select_sound);
- XEN_DEFINE_PROCEDURE(S_select_channel, g_select_channel_w, 0, 1, 0, H_select_channel);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_selected_sound, g_selected_sound_w, H_selected_sound,
- S_setB S_selected_sound, g_select_sound_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_selected_channel, g_selected_channel_w, H_selected_channel,
- S_setB S_selected_channel, g_set_selected_channel_w, 0, 1, 0, 2);
-
- XEN_DEFINE_PROCEDURE(S_start_progress_report, g_start_progress_report_w, 0, 2, 0, H_start_progress_report);
- XEN_DEFINE_PROCEDURE(S_finish_progress_report, g_finish_progress_report_w, 0, 2, 0, H_finish_progress_report);
- XEN_DEFINE_PROCEDURE(S_progress_report, g_progress_report_w, 1, 2, 0, H_progress_report);
-
- XEN_DEFINE_PROCEDURE(S_close_sound, g_close_sound_w, 0, 1, 0, H_close_sound);
- XEN_DEFINE_PROCEDURE(S_update_sound, g_update_sound_w, 0, 1, 0, H_update_sound);
- XEN_DEFINE_PROCEDURE(S_save_sound, g_save_sound_w, 0, 1, 0, H_save_sound);
- XEN_DEFINE_PROCEDURE(S_open_sound, g_open_sound_w, 1, 0, 0, H_open_sound);
- XEN_DEFINE_PROCEDURE(S_open_raw_sound, g_open_raw_sound_w, 0, 0, 1, H_open_raw_sound);
- XEN_DEFINE_PROCEDURE(S_view_sound, g_view_sound_w, 1, 0, 0, H_view_sound);
- XEN_DEFINE_PROCEDURE(S_new_sound, g_new_sound_w, 0, 0, 1, H_new_sound);
- XEN_DEFINE_PROCEDURE(S_revert_sound, g_revert_sound_w, 0, 1, 0, H_revert_sound);
- XEN_DEFINE_PROCEDURE(S_save_sound_as, g_save_sound_as_w, 0, 0, 1, H_save_sound_as);
- XEN_DEFINE_PROCEDURE(S_apply_controls, g_apply_controls_w, 0, 4, 0, H_apply_controls);
- XEN_DEFINE_PROCEDURE(S_controls_to_channel, g_controls_to_channel_w, 0, 6, 0, H_controls_to_channel);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_filter_control_envelope, g_filter_control_envelope_w, H_filter_control_envelope,
- S_setB S_filter_control_envelope, g_set_filter_control_envelope_w, g_set_filter_control_envelope_reversed,
- 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_show_controls, g_show_controls_w, H_show_controls,
- S_setB S_show_controls, g_set_show_controls_w, g_set_show_controls_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_sync, g_sync_w, H_sync,
- S_setB S_sync, g_set_sync_w, g_set_sync_reversed, 0, 1, 1, 1);
- XEN_DEFINE_PROCEDURE(S_sync_max, g_sync_max_w, 0, 0, 0, H_sync_max);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_sound_properties, g_sound_properties_w, H_sound_properties,
- S_setB S_sound_properties, g_set_sound_properties_w, g_set_sound_properties_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_sound_property, g_sound_property_w, H_sound_property,
- S_setB S_sound_property, g_set_sound_property_w, g_set_sound_property_reversed, 1, 1, 2, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_channel_style, g_channel_style_w, H_channel_style,
- S_setB S_channel_style, g_set_channel_style_w, g_set_channel_style_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_read_only, g_read_only_w, H_read_only,
- S_setB S_read_only, g_set_read_only_w, g_set_read_only_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_expand_control_p, g_expand_control_p_w, H_expand_control_p,
- S_setB S_expand_control_p, g_set_expand_control_p_w, g_set_expand_control_p_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_contrast_control_p, g_contrast_control_p_w, H_contrast_control_p,
- S_setB S_contrast_control_p, g_set_contrast_control_p_w, g_set_contrast_control_p_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_reverb_control_p, g_reverb_control_p_w, H_reverb_control_p,
- S_setB S_reverb_control_p, g_set_reverb_control_p_w, g_set_reverb_control_p_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_filter_control_p, g_filter_control_p_w, H_filter_control_p,
- S_setB S_filter_control_p, g_set_filter_control_p_w, g_set_filter_control_p_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_filter_control_in_dB, g_filter_control_in_dB_w, H_filter_control_in_dB,
- S_setB S_filter_control_in_dB, g_set_filter_control_in_dB_w, g_set_filter_control_in_dB_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_filter_control_in_hz, g_filter_control_in_hz_w, H_filter_control_in_hz,
- S_setB S_filter_control_in_hz, g_set_filter_control_in_hz_w, g_set_filter_control_in_hz_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE(S_filter_control_coeffs, g_filter_control_coeffs_w, 0, 1, 0, H_filter_control_coeffs);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_filter_control_order, g_filter_control_order_w, H_filter_control_order,
- S_setB S_filter_control_order, g_set_filter_control_order_w, g_set_filter_control_order_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_contrast_control, g_contrast_control_w, H_contrast_control,
- S_setB S_contrast_control, g_set_contrast_control_w, g_set_contrast_control_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_contrast_control_bounds, g_contrast_control_bounds_w, H_contrast_control_bounds,
- S_setB S_contrast_control_bounds, g_set_contrast_control_bounds_w, g_set_contrast_control_bounds_reversed,
- 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_contrast_control_amp, g_contrast_control_amp_w, H_contrast_control_amp,
- S_setB S_contrast_control_amp, g_set_contrast_control_amp_w, g_set_contrast_control_amp_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_expand_control, g_expand_control_w, H_expand_control,
- S_setB S_expand_control, g_set_expand_control_w, g_set_expand_control_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_expand_control_bounds, g_expand_control_bounds_w, H_expand_control_bounds,
- S_setB S_expand_control_bounds, g_set_expand_control_bounds_w, g_set_expand_control_bounds_reversed,
- 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_expand_control_length, g_expand_control_length_w, H_expand_control_length,
- S_setB S_expand_control_length, g_set_expand_control_length_w, g_set_expand_control_length_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_expand_control_ramp, g_expand_control_ramp_w, H_expand_control_ramp,
- S_setB S_expand_control_ramp, g_set_expand_control_ramp_w, g_set_expand_control_ramp_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_expand_control_hop, g_expand_control_hop_w, H_expand_control_hop,
- S_setB S_expand_control_hop, g_set_expand_control_hop_w, g_set_expand_control_hop_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_expand_control_jitter, g_expand_control_jitter_w, H_expand_control_jitter,
- S_setB S_expand_control_jitter, g_set_expand_control_jitter_w, g_set_expand_control_jitter_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_speed_control, g_speed_control_w, H_speed_control,
- S_setB S_speed_control, g_set_speed_control_w, g_set_speed_control_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_speed_control_bounds, g_speed_control_bounds_w, H_speed_control_bounds,
- S_setB S_speed_control_bounds, g_set_speed_control_bounds_w, g_set_speed_control_bounds_reversed,
- 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_reverb_control_length, g_reverb_control_length_w, H_reverb_control_length,
- S_setB S_reverb_control_length, g_set_reverb_control_length_w, g_set_reverb_control_length_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_reverb_control_length_bounds, g_reverb_control_length_bounds_w, H_reverb_control_length_bounds,
- S_setB S_reverb_control_length_bounds, g_set_reverb_control_length_bounds_w,
- g_set_reverb_control_length_bounds_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_reverb_control_scale, g_reverb_control_scale_w, H_reverb_control_scale,
- S_setB S_reverb_control_scale, g_set_reverb_control_scale_w, g_set_reverb_control_scale_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_reverb_control_scale_bounds, g_reverb_control_scale_bounds_w, H_reverb_control_scale_bounds,
- S_setB S_reverb_control_scale_bounds, g_set_reverb_control_scale_bounds_w,
- g_set_reverb_control_scale_bounds_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_reverb_control_feedback, g_reverb_control_feedback_w, H_reverb_control_feedback,
- S_setB S_reverb_control_feedback, g_set_reverb_control_feedback_w, g_set_reverb_control_feedback_reversed,
- 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_reverb_control_lowpass, g_reverb_control_lowpass_w, H_reverb_control_lowpass,
- S_setB S_reverb_control_lowpass, g_set_reverb_control_lowpass_w, g_set_reverb_control_lowpass_reversed,
- 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_amp_control, g_amp_control_w, H_amp_control,
- S_setB S_amp_control, g_set_amp_control_w, g_set_amp_control_reversed, 0, 2, 1, 2);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_amp_control_bounds, g_amp_control_bounds_w, H_amp_control_bounds,
- S_setB S_amp_control_bounds, g_set_amp_control_bounds_w, g_set_amp_control_bounds_reversed,
- 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_reverb_control_decay, g_reverb_control_decay_w, H_reverb_control_decay,
- S_setB S_reverb_control_decay, g_set_reverb_control_decay_w, g_set_reverb_control_decay_reversed, 0, 1, 1, 1);
+ Xen_define_constant(S_channels_separate, CHANNELS_SEPARATE, H_channels_separate);
+ Xen_define_constant(S_channels_combined, CHANNELS_COMBINED, H_channels_combined);
+ Xen_define_constant(S_channels_superimposed, CHANNELS_SUPERIMPOSED, H_channels_superimposed);
+
+ Xen_define_typed_procedure(S_status_report, g_status_report_w, 1, 1, 0, H_status_report, pl_sts);
+
+ Xen_define_typed_dilambda(S_channels, g_channels_w, H_channels, S_set S_channels, g_set_channels_w, 0, 1, 1, 1, pl_iq, pl_iqi);
+ Xen_define_typed_dilambda(S_chans, g_channels_w, H_channels, S_set S_chans, g_set_channels_w, 0, 1, 1, 1, pl_iq, pl_iqi);
+ Xen_define_typed_dilambda(S_srate, g_srate_w, H_srate, S_set S_srate, g_set_srate_w, 0, 1, 1, 1, pl_iq, pl_iqi);
+ Xen_define_typed_dilambda(S_data_location, g_data_location_w, H_data_location, S_set S_data_location, g_set_data_location_w, 0, 1, 1, 1, pl_iq, pl_iqi);
+ Xen_define_typed_dilambda(S_data_size, g_data_size_w, H_data_size, S_set S_data_size, g_set_data_size_w, 0, 1, 1, 1, pl_iq, pl_iqi);
+ Xen_define_typed_dilambda(S_sample_type, g_sample_type_w, H_sample_type, S_set S_sample_type, g_set_sample_type_w, 0, 1, 1, 1, pl_iq, pl_iqi);
+ Xen_define_typed_dilambda(S_header_type, g_header_type_w, H_header_type, S_set S_header_type, g_set_header_type_w, 0, 1, 1, 1, pl_iq, pl_iqi);
+ Xen_define_typed_dilambda(S_comment, g_comment_w, H_comment, S_set S_comment, g_set_comment_w, 0, 1, 1, 1, NULL, NULL);
+
+ Xen_define_typed_procedure(S_is_sound, g_is_sound_w, 1, 0, 0, H_is_sound, pl_bt);
+ Xen_define_typed_procedure(S_find_sound, g_find_sound_w, 1, 1, 0, H_find_sound, pl_osi);
+ Xen_define_typed_procedure(S_file_name, g_file_name_w, 0, 1, 0, H_file_name, pl_sq);
+ Xen_define_typed_procedure(S_short_file_name, g_short_file_name_w, 0, 1, 0, H_short_file_name, pl_sq);
+ Xen_define_typed_procedure(S_save_controls, g_save_controls_w, 0, 1, 0, H_save_controls, pl_bt);
+ Xen_define_typed_procedure(S_restore_controls, g_restore_controls_w, 0, 1, 0, H_restore_controls, pl_bt);
+ Xen_define_typed_procedure(S_reset_controls, g_reset_controls_w, 0, 1, 0, H_reset_controls, pl_bt);
+ Xen_define_safe_procedure(S_select_sound, g_select_sound_w, 1, 0, 0, H_select_sound);
+ Xen_define_safe_procedure(S_select_channel, g_select_channel_w, 0, 1, 0, H_select_channel);
+
+ Xen_define_dilambda(S_selected_sound, g_selected_sound_w, H_selected_sound,
+ S_set S_selected_sound, g_select_sound_w, 0, 0, 1, 0);
+ Xen_define_dilambda(S_selected_channel, g_selected_channel_w, H_selected_channel,
+ S_set S_selected_channel, g_set_selected_channel_w, 0, 1, 0, 2);
+
+ Xen_define_safe_procedure(S_start_progress_report, g_start_progress_report_w, 0, 2, 0, H_start_progress_report);
+ Xen_define_safe_procedure(S_finish_progress_report, g_finish_progress_report_w, 0, 2, 0, H_finish_progress_report);
+ Xen_define_safe_procedure(S_progress_report, g_progress_report_w, 1, 2, 0, H_progress_report);
+
+ Xen_define_procedure(S_close_sound, g_close_sound_w, 0, 1, 0, H_close_sound);
+ Xen_define_procedure(S_update_sound, g_update_sound_w, 0, 1, 0, H_update_sound);
+ Xen_define_procedure(S_save_sound, g_save_sound_w, 0, 1, 0, H_save_sound);
+ Xen_define_procedure(S_open_sound, g_open_sound_w, 1, 0, 0, H_open_sound); /* not "safe" procedure! */
+ Xen_define_procedure(S_open_raw_sound, g_open_raw_sound_w, 0, 0, 1, H_open_raw_sound);
+ Xen_define_procedure(S_view_sound, g_view_sound_w, 1, 0, 0, H_view_sound);
+ Xen_define_procedure(S_new_sound, g_new_sound_w, 0, 0, 1, H_new_sound);
+ Xen_define_procedure(S_revert_sound, g_revert_sound_w, 0, 1, 0, H_revert_sound);
+ Xen_define_procedure(S_save_sound_as, g_save_sound_as_w, 0, 0, 1, H_save_sound_as);
+ Xen_define_procedure(S_apply_controls, g_apply_controls_w, 0, 4, 0, H_apply_controls);
+ Xen_define_procedure(S_controls_to_channel, g_controls_to_channel_w, 0, 6, 0, H_controls_to_channel);
+ Xen_define_typed_procedure(S_sync_max, g_sync_max_w, 0, 0, 0, H_sync_max, pl_i);
+ Xen_define_safe_procedure(S_filter_control_coeffs, g_filter_control_coeffs_w, 0, 1, 0, H_filter_control_coeffs);
+
+ Xen_define_dilambda(S_filter_control_envelope, g_filter_control_envelope_w, H_filter_control_envelope,
+ S_set S_filter_control_envelope, g_set_filter_control_envelope_w, 0, 1, 1, 1);
+ Xen_define_dilambda(S_sound_properties, g_sound_properties_w, H_sound_properties,
+ S_set S_sound_properties, g_set_sound_properties_w, 0, 1, 1, 1);
+ Xen_define_dilambda(S_sound_property, g_sound_property_w, H_sound_property,
+ S_set S_sound_property, g_set_sound_property_w, 1, 1, 2, 1);
+
+ Xen_define_typed_dilambda(S_show_controls, g_show_controls_w, H_show_controls,
+ S_set S_show_controls, g_set_show_controls_w, 0, 1, 1, 1, pl_bo, pl_bob);
+ Xen_define_typed_dilambda(S_sync, g_sync_w, H_sync,
+ S_set S_sync, g_set_sync_w, 0, 1, 1, 1, pl_io, pl_ioz);
+ Xen_define_typed_dilambda(S_channel_style, g_channel_style_w, H_channel_style,
+ S_set S_channel_style, g_set_channel_style_w, 0, 1, 1, 1, pl_io, pl_ioi);
+ Xen_define_typed_dilambda(S_read_only, g_read_only_w, H_read_only,
+ S_set S_read_only, g_set_read_only_w, 0, 1, 1, 1, pl_bo, pl_bob);
+ Xen_define_typed_dilambda(S_expand_control_on, g_expand_control_on_w, H_expand_control_on,
+ S_set S_expand_control_on, g_set_expand_control_on_w, 0, 1, 1, 1, pl_bo, pl_bob);
+ Xen_define_typed_dilambda(S_contrast_control_on, g_contrast_control_on_w, H_contrast_control_on,
+ S_set S_contrast_control_on, g_set_contrast_control_on_w, 0, 1, 1, 1, pl_bo, pl_bob);
+ Xen_define_typed_dilambda(S_reverb_control_on, g_reverb_control_on_w, H_reverb_control_on,
+ S_set S_reverb_control_on, g_set_reverb_control_on_w, 0, 1, 1, 1, pl_bo, pl_bob);
+ Xen_define_typed_dilambda(S_filter_control_on, g_filter_control_on_w, H_filter_control_on,
+ S_set S_filter_control_on, g_set_filter_control_on_w, 0, 1, 1, 1, pl_bo, pl_bob);
+ Xen_define_typed_dilambda(S_filter_control_in_dB, g_filter_control_in_dB_w, H_filter_control_in_dB,
+ S_set S_filter_control_in_dB, g_set_filter_control_in_dB_w, 0, 1, 1, 1, pl_bo, pl_bob);
+ Xen_define_typed_dilambda(S_filter_control_in_hz, g_filter_control_in_hz_w, H_filter_control_in_hz,
+ S_set S_filter_control_in_hz, g_set_filter_control_in_hz_w, 0, 1, 1, 1, pl_bo, pl_bob);
+ Xen_define_typed_dilambda(S_filter_control_order, g_filter_control_order_w, H_filter_control_order,
+ S_set S_filter_control_order, g_set_filter_control_order_w, 0, 1, 1, 1, pl_io, pl_ioi);
+ Xen_define_typed_dilambda(S_contrast_control, g_contrast_control_w, H_contrast_control,
+ S_set S_contrast_control, g_set_contrast_control_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_contrast_control_bounds, g_contrast_control_bounds_w, H_contrast_control_bounds,
+ S_set S_contrast_control_bounds, g_set_contrast_control_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
+ Xen_define_typed_dilambda(S_contrast_control_amp, g_contrast_control_amp_w, H_contrast_control_amp,
+ S_set S_contrast_control_amp, g_set_contrast_control_amp_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_expand_control, g_expand_control_w, H_expand_control,
+ S_set S_expand_control, g_set_expand_control_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_expand_control_bounds, g_expand_control_bounds_w, H_expand_control_bounds,
+ S_set S_expand_control_bounds, g_set_expand_control_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
+ Xen_define_typed_dilambda(S_expand_control_length, g_expand_control_length_w, H_expand_control_length,
+ S_set S_expand_control_length, g_set_expand_control_length_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_expand_control_ramp, g_expand_control_ramp_w, H_expand_control_ramp,
+ S_set S_expand_control_ramp, g_set_expand_control_ramp_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_expand_control_hop, g_expand_control_hop_w, H_expand_control_hop,
+ S_set S_expand_control_hop, g_set_expand_control_hop_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_expand_control_jitter, g_expand_control_jitter_w, H_expand_control_jitter,
+ S_set S_expand_control_jitter, g_set_expand_control_jitter_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_speed_control, g_speed_control_w, H_speed_control,
+ S_set S_speed_control, g_set_speed_control_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_speed_control_bounds, g_speed_control_bounds_w, H_speed_control_bounds,
+ S_set S_speed_control_bounds, g_set_speed_control_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
+ Xen_define_typed_dilambda(S_reverb_control_length, g_reverb_control_length_w, H_reverb_control_length,
+ S_set S_reverb_control_length, g_set_reverb_control_length_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_reverb_control_length_bounds, g_reverb_control_length_bounds_w, H_reverb_control_length_bounds,
+ S_set S_reverb_control_length_bounds, g_set_reverb_control_length_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
+ Xen_define_typed_dilambda(S_reverb_control_scale, g_reverb_control_scale_w, H_reverb_control_scale,
+ S_set S_reverb_control_scale, g_set_reverb_control_scale_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_reverb_control_scale_bounds, g_reverb_control_scale_bounds_w, H_reverb_control_scale_bounds,
+ S_set S_reverb_control_scale_bounds, g_set_reverb_control_scale_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
+ Xen_define_typed_dilambda(S_reverb_control_feedback, g_reverb_control_feedback_w, H_reverb_control_feedback,
+ S_set S_reverb_control_feedback, g_set_reverb_control_feedback_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_reverb_control_lowpass, g_reverb_control_lowpass_w, H_reverb_control_lowpass,
+ S_set S_reverb_control_lowpass, g_set_reverb_control_lowpass_w, 0, 1, 1, 1, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_amp_control, g_amp_control_w, H_amp_control,
+ S_set S_amp_control, g_set_amp_control_w, 0, 2, 1, 2, pl_ro, pl_ror);
+ Xen_define_typed_dilambda(S_amp_control_bounds, g_amp_control_bounds_w, H_amp_control_bounds,
+ S_set S_amp_control_bounds, g_set_amp_control_bounds_w, 0, 1, 1, 1, pl_po, pl_pop);
+ Xen_define_typed_dilambda(S_reverb_control_decay, g_reverb_control_decay_w, H_reverb_control_decay,
+ S_set S_reverb_control_decay, g_set_reverb_control_decay_w, 0, 1, 1, 1, pl_ro, pl_ror);
#define H_speed_control_as_float "The value for " S_speed_control_style " that interprets the speed slider as a float"
#define H_speed_control_as_ratio "The value for " S_speed_control_style " that interprets the speed slider as a just-intonation ratio"
#define H_speed_control_as_semitone "The value for " S_speed_control_style " that interprets the speed slider as a microtone (via " S_speed_control_tones ")"
- XEN_DEFINE_CONSTANT(S_speed_control_as_float, SPEED_CONTROL_AS_FLOAT, H_speed_control_as_float);
- XEN_DEFINE_CONSTANT(S_speed_control_as_ratio, SPEED_CONTROL_AS_RATIO, H_speed_control_as_ratio);
- XEN_DEFINE_CONSTANT(S_speed_control_as_semitone, SPEED_CONTROL_AS_SEMITONE, H_speed_control_as_semitone);
+ Xen_define_constant(S_speed_control_as_float, SPEED_CONTROL_AS_FLOAT, H_speed_control_as_float);
+ Xen_define_constant(S_speed_control_as_ratio, SPEED_CONTROL_AS_RATIO, H_speed_control_as_ratio);
+ Xen_define_constant(S_speed_control_as_semitone, SPEED_CONTROL_AS_SEMITONE, H_speed_control_as_semitone);
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_speed_control_style, g_speed_control_style_w, H_speed_control_style,
- S_setB S_speed_control_style, g_set_speed_control_style_w, g_set_speed_control_style_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(S_speed_control_tones, g_speed_control_tones_w, H_speed_control_tones,
- S_setB S_speed_control_tones, g_set_speed_control_tones_w, g_set_speed_control_tones_reversed, 0, 1, 1, 1);
-
- XEN_DEFINE_PROCEDURE(S_channel_amp_envs, g_channel_amp_envs_w, 0, 5, 0, H_channel_amp_envs);
+ Xen_define_typed_dilambda(S_speed_control_style, g_speed_control_style_w, H_speed_control_style,
+ S_set S_speed_control_style, g_set_speed_control_style_w, 0, 1, 1, 1, pl_io, pl_ioi);
+ Xen_define_typed_dilambda(S_speed_control_tones, g_speed_control_tones_w, H_speed_control_tones,
+ S_set S_speed_control_tones, g_set_speed_control_tones_w, 0, 1, 1, 1, pl_io, pl_ioi);
- XEN_DEFINE_PROCEDURE(S_sounds, g_sounds_w, 0, 0, 0, H_sounds);
+ Xen_define_procedure(S_channel_amp_envs, g_channel_amp_envs_w, 0, 5, 0, H_channel_amp_envs);
+ Xen_define_safe_procedure(S_sounds, g_sounds_w, 0, 0, 0, H_sounds);
+ Xen_define_typed_procedure(S_integer_to_sound, g_integer_to_sound_w, 1, 0, 0, H_integer_to_sound, pl_oi);
+ Xen_define_typed_procedure(S_sound_to_integer, g_sound_to_integer_w, 1, 0, 0, H_sound_to_integer, pl_io);
- XEN_DEFINE_PROCEDURE(S_integer_to_sound, g_integer_to_sound_w, 1, 0, 0, H_integer_to_sound);
- XEN_DEFINE_PROCEDURE(S_sound_to_integer, g_sound_to_integer_w, 1, 0, 0, H_sound_to_integer);
+#if HAVE_SCHEME
+ s7_symbol_set_documentation(s7, ss->channel_style_symbol, "*channel-style*: how multichannel sounds lay out the channels: channels-combined, channels-separate or channels-superimposed.");
+ s7_symbol_set_documentation(s7, ss->filter_control_in_db_symbol, "*filter-control-in-dB*: #t if snd's filter envelope is displayed in dB in control panel");
+ s7_symbol_set_documentation(s7, ss->filter_control_in_hz_symbol, "*filter-control-in-hz*: #t if snd's filter envelope x axis should be in hz (control panel filter)");
+ s7_symbol_set_documentation(s7, ss->speed_control_tones_symbol, "*speed-control-tones*: the speed-control octave divisions (12)");
+ s7_symbol_set_documentation(s7, ss->speed_control_style_symbol, "*speed-control-style*: speed control choice (speed-control-as-float etc)");
+ s7_symbol_set_documentation(s7, ss->expand_control_length_symbol, "*expand-control-length*: current expansion segment length in seconds (.15)");
+ s7_symbol_set_documentation(s7, ss->expand_control_ramp_symbol, "*expand-control-ramp*: current expansion ramp time (.4)");
+ s7_symbol_set_documentation(s7, ss->expand_control_hop_symbol, "*expand-control-hop*: current expansion output grain spacing in seconds (0.05)");
+ s7_symbol_set_documentation(s7, ss->expand_control_jitter_symbol, "*expand-control-jitter*: current expansion output grain spacing jitter (0.1)");
+ s7_symbol_set_documentation(s7, ss->contrast_control_amp_symbol, "*contrast-control-amp*: contrast amp");
+ s7_symbol_set_documentation(s7, ss->reverb_control_feedback_symbol, "*reverb-control-feedback*: control-panel reverb feedback scaler");
+ s7_symbol_set_documentation(s7, ss->reverb_control_lowpass_symbol, "*reverb-control-lowpass*: control-panel reverb lowpass filter coefficient");
+ s7_symbol_set_documentation(s7, ss->reverb_control_decay_symbol, "*reverb-control-decay*: control-panel reverb decay time (1.0 seconds)");
+ s7_symbol_set_documentation(s7, ss->filter_control_order_symbol, "*filter-control-order*: control-panel filter order");
+ s7_symbol_set_documentation(s7, ss->show_controls_symbol, "*show-controls*: #t if snd's control panel is known to be open");
+
+ s7_symbol_set_access(s7, ss->channel_style_symbol, s7_make_function(s7, "[acc-" S_channel_style "]", acc_channel_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->filter_control_in_db_symbol, s7_make_function(s7, "[acc-" S_filter_control_in_dB "]", acc_filter_control_in_dB, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->filter_control_in_hz_symbol, s7_make_function(s7, "[acc-" S_filter_control_in_hz "]", acc_filter_control_in_hz, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->speed_control_tones_symbol, s7_make_function(s7, "[acc-" S_speed_control_tones "]", acc_speed_control_tones, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->speed_control_style_symbol, s7_make_function(s7, "[acc-" S_speed_control_style "]", acc_speed_control_style, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->expand_control_length_symbol, s7_make_function(s7, "[acc-" S_expand_control_length "]", acc_expand_control_length, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->expand_control_ramp_symbol, s7_make_function(s7, "[acc-" S_expand_control_ramp "]", acc_expand_control_ramp, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->expand_control_hop_symbol, s7_make_function(s7, "[acc-" S_expand_control_hop "]", acc_expand_control_hop, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->expand_control_jitter_symbol, s7_make_function(s7, "[acc-" S_expand_control_jitter "]", acc_expand_control_jitter, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->contrast_control_amp_symbol, s7_make_function(s7, "[acc-" S_contrast_control_amp "]", acc_contrast_control_amp, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->reverb_control_feedback_symbol, s7_make_function(s7, "[acc-" S_reverb_control_feedback "]", acc_reverb_control_feedback, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->reverb_control_lowpass_symbol, s7_make_function(s7, "[acc-" S_reverb_control_lowpass "]", acc_reverb_control_lowpass, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->reverb_control_decay_symbol, s7_make_function(s7, "[acc-" S_reverb_control_decay "]", acc_reverb_control_decay, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->filter_control_order_symbol, s7_make_function(s7, "[acc-" S_filter_control_order "]", acc_filter_control_order, 2, 0, false, "accessor"));
+ s7_symbol_set_access(s7, ss->show_controls_symbol, s7_make_function(s7, "[acc-" S_show_controls "]", acc_show_controls, 2, 0, false, "accessor"));
+#endif
}
diff --git a/snd-strings.h b/snd-strings.h
index 57cc8a4..c9e9c82 100644
--- a/snd-strings.h
+++ b/snd-strings.h
@@ -28,8 +28,6 @@
#define S_as_one_edit "as-one-edit"
#define S_ask_before_overwrite "ask-before-overwrite"
#define S_ask_about_unsaved_edits "ask-about-unsaved-edits"
-#define S_audio_input_device "audio-input-device"
-#define S_audio_output_device "audio-output-device"
#define S_auto_resize "auto-resize"
#define S_auto_update "auto-update"
#define S_auto_update_interval "auto-update-interval"
@@ -50,15 +48,15 @@
#define S_before_transform_hook "before-transform-hook"
#define S_bind_key "bind-key"
#define S_bold_peaks_font "bold-peaks-font"
-#define S_bomb "bomb"
+#if (!HAVE_SCHEME)
#define S_c_g "c-g?"
+#endif
#define S_cepstrum "cepstrum"
#define S_channel_amp_envs "channel-amp-envs"
#define S_channel_data "channel-data"
#define S_channel_properties "channel-properties"
#define S_channel_property "channel-property"
#define S_channel_style "channel-style"
-#define S_channel_to_vct "channel->vct"
#define S_channel_widgets "channel-widgets"
#define S_channels "channels"
#define S_channels_combined "channels-combined"
@@ -66,7 +64,6 @@
#define S_channels_superimposed "channels-superimposed"
#define S_chans "chans"
#define S_clear_listener "clear-listener"
-#define S_clear_minibuffer "clear-minibuffer"
#define S_clip_hook "clip-hook"
#define S_clipping "clipping"
#define S_clm_channel "clm-channel"
@@ -76,12 +73,12 @@
#define S_color_orientation_dialog "color-orientation-dialog"
#define S_color_hook "color-hook"
#define S_color_inverted "color-inverted"
-#define S_color_p "color?"
+#define S_is_color "color?"
#define S_color_scale "color-scale"
#define S_color_to_list "color->list"
#define S_colormap "colormap"
#define S_colormap_name "colormap-name"
-#define S_colormap_p "colormap?"
+#define S_is_colormap "colormap?"
#define S_colormap_ref "colormap-ref"
#define S_colormap_size "colormap-size"
#define S_colormap_to_integer "colormap->integer"
@@ -90,7 +87,7 @@
#define S_contrast_control "contrast-control"
#define S_contrast_control_amp "contrast-control-amp"
#define S_contrast_control_bounds "contrast-control-bounds"
-#define S_contrast_control_p "contrast-control?"
+#define S_contrast_control_on "contrast-control?"
#define S_controls_to_channel "controls->channel"
#define S_convolve_selection_with "convolve-selection-with"
#define S_convolve_with "convolve-with"
@@ -114,14 +111,13 @@
#define S_cursor_style "cursor-style"
#define S_cursor_update_interval "cursor-update-interval"
#define S_dac_combines_channels "dac-combines-channels"
-#define S_dac_hook "dac-hook"
#define S_dac_size "dac-size"
#define S_data_color "data-color"
-#define S_data_format "data-format"
+#define S_sample_type "sample-type"
#define S_data_location "data-location"
#define S_data_size "data-size"
#define S_default_output_chans "default-output-chans"
-#define S_default_output_data_format "default-output-data-format"
+#define S_default_output_sample_type "default-output-sample-type"
#define S_default_output_srate "default-output-srate"
#define S_default_output_header_type "default-output-header-type"
#define S_define_envelope "define-envelope"
@@ -167,7 +163,7 @@
#define S_enved_add_point "enved-add-point"
#define S_enved_amplitude "enved-amplitude"
#define S_enved_base "enved-base"
-#define S_enved_clip_p "enved-clip?"
+#define S_enved_clipping "enved-clip?"
#define S_enved_delete_point "enved-delete-point"
#define S_enved_dialog "enved-dialog"
#define S_enved_envelope "enved-envelope"
@@ -181,7 +177,7 @@
#define S_enved_srate "enved-srate"
#define S_enved_style "enved-style"
#define S_enved_target "enved-target"
-#define S_enved_wave_p "enved-wave?"
+#define S_enved_with_wave "enved-wave?"
#define S_enved_waveform_color "enved-waveform-color"
#define S_envelope_exponential "envelope-exponential"
#define S_envelope_linear "envelope-linear"
@@ -196,7 +192,7 @@
#define S_expand_control_hop "expand-control-hop"
#define S_expand_control_jitter "expand-control-jitter"
#define S_expand_control_length "expand-control-length"
-#define S_expand_control_p "expand-control?"
+#define S_expand_control_on "expand-control?"
#define S_expand_control_ramp "expand-control-ramp"
#define S_fft "fft"
#define S_fft_log_frequency "fft-log-frequency"
@@ -214,7 +210,7 @@
#define S_filter_control_in_dB "filter-control-in-dB"
#define S_filter_control_in_hz "filter-control-in-hz"
#define S_filter_control_order "filter-control-order"
-#define S_filter_control_p "filter-control?"
+#define S_filter_control_on "filter-control?"
#define S_filter_control_waveform_color "filter-control-waveform-color"
#define S_filter_selection "filter-selection"
#define S_filter_sound "filter-sound"
@@ -227,7 +223,7 @@
#define S_foreground_color "foreground-color"
#define S_forget_region "forget-region"
#define S_fourier_transform "fourier-transform"
-#define S_frames "frames"
+#define S_framples "framples"
#define S_free_cairo "free-cairo"
#define S_free_player "free-player"
#define S_free_sampler "free-sampler"
@@ -290,10 +286,11 @@
#define S_left_sample "left-sample"
#define S_lisp_graph "lisp-graph"
#define S_lisp_graph_hook "lisp-graph-hook"
-#define S_lisp_graph_p "lisp-graph?"
+#define S_lisp_graph_on "lisp-graph?"
#define S_lisp_graph_style "lisp-graph-style"
#define S_listener_click_hook "listener-click-hook"
#define S_listener_color "listener-color"
+#define S_listener_colorized "listener-colorized"
#define S_listener_font "listener-font"
#define S_listener_prompt "listener-prompt"
#define S_listener_selection "listener-selection"
@@ -322,7 +319,7 @@
#define S_mark_name "mark-name"
#define S_mark_properties "mark-properties"
#define S_mark_property "mark-property"
-#define S_mark_p "mark?"
+#define S_is_mark "mark?"
#define S_mark_sample "mark-sample"
#define S_mark_sync "mark-sync"
#define S_mark_sync_max "mark-sync-max"
@@ -332,12 +329,10 @@
#define S_marks "marks"
#define S_max_regions "max-regions"
#define S_max_transform_peaks "max-transform-peaks"
-#define S_max_virtual_ptrees "max-virtual-ptrees"
#define S_maxamp "maxamp"
#define S_maxamp_position "maxamp-position"
#define S_menu_widgets "menu-widgets"
#define S_min_dB "min-dB"
-#define S_minibuffer_history_length "minibuffer-history-length"
#define S_mix "mix"
#define S_mix_amp "mix-amp"
#define S_mix_amp_env "mix-amp-env"
@@ -348,14 +343,14 @@
#define S_mix_file_dialog "mix-file-dialog"
#define S_mix_length "mix-length"
#define S_mix_home "mix-home"
-#define S_mix_p "mix?"
+#define S_is_mix "mix?"
#define S_mix_name "mix-name"
#define S_mix_position "mix-position"
#define S_mix_properties "mix-properties"
#define S_mix_property "mix-property"
#define S_mix_region "mix-region"
#define S_mix_release_hook "mix-release-hook"
-#define S_mix_sampler_p "mix-sampler?"
+#define S_is_mix_sampler "mix-sampler?"
#define S_mix_selection "mix-selection"
#define S_mix_speed "mix-speed"
#define S_mix_sync "mix-sync"
@@ -364,7 +359,6 @@
#define S_mix_tag_width "mix-tag-width"
#define S_mix_tag_y "mix-tag-y"
#define S_mix_to_integer "mix->integer"
-#define S_mix_vct "mix-vct"
#define S_mix_waveform_height "mix-waveform-height"
#define S_mixes "mixes"
#define S_mouse_click_hook "mouse-click-hook"
@@ -394,15 +388,11 @@
#define S_open_raw_sound "open-raw-sound"
#define S_open_raw_sound_hook "open-raw-sound-hook"
#define S_open_sound "open-sound"
-#define S_optimization "optimization"
-#define S_optimization_hook "optimization-hook"
#define S_orientation_hook "orientation-hook"
#define S_output_comment_hook "output-comment-hook"
-#define S_output_name_hook "output-name-hook"
#define S_pad_channel "pad-channel"
#define S_pausing "pausing"
#define S_peak_env_dir "peak-env-dir"
-#define S_peak_env_hook "peak-env-hook"
#define S_peaks "peaks"
#define S_peaks_font "peaks-font"
#define S_play "play"
@@ -410,7 +400,7 @@
#define S_play_hook "play-hook"
#define S_playing "playing"
#define S_player_home "player-home"
-#define S_player_p "player?"
+#define S_is_player "player?"
#define S_players "players"
#define S_position_color "position-color"
#define S_position_to_x "position->x"
@@ -418,40 +408,34 @@
#define S_preferences_dialog "preferences-dialog"
#define S_previous_sample "previous-sample"
#define S_print_dialog "print-dialog"
-#define S_print_hook "print-hook"
#define S_print_length "print-length"
#define S_progress_report "progress-report"
-#define S_prompt_in_minibuffer "prompt-in-minibuffer"
-#define S_ptree_channel "ptree-channel"
#define S_ramp_channel "ramp-channel"
#define S_read_hook "read-hook"
#define S_read_mix_sample "read-mix-sample"
#define S_read_only "read-only"
#define S_read_region_sample "read-region-sample"
#define S_read_sample "read-sample"
-#define S_recorder_dialog "recorder-dialog"
#if HAVE_RUBY
#define S_redo "redo-edit"
#else
#define S_redo "redo"
#endif
#define S_region_chans "region-chans"
-#define S_region_frames "region-frames"
+#define S_region_framples "region-framples"
#define S_region_graph_style "region-graph-style"
#define S_region_home "region-home"
#define S_region_maxamp "region-maxamp"
#define S_region_maxamp_position "region-maxamp-position"
-#define S_region_p "region?"
+#define S_is_region "region?"
#define S_region_position "region-position"
#define S_region_sample "region-sample"
-#define S_region_sampler_p "region-sampler?"
+#define S_is_region_sampler "region-sampler?"
#define S_region_srate "region-srate"
#define S_region_to_integer "region->integer"
-#define S_region_to_vct "region->vct"
#define S_regions "regions"
#define S_remember_sound_state "remember-sound-state"
#define S_remove_from_menu "remove-from-menu"
-#define S_report_in_minibuffer "report-in-minibuffer"
#define S_reset_controls "reset-controls"
#define S_reset_listener_cursor "reset-listener-cursor"
#define S_restore_controls "restore-controls"
@@ -461,7 +445,7 @@
#define S_reverb_control_length "reverb-control-length"
#define S_reverb_control_length_bounds "reverb-control-length-bounds"
#define S_reverb_control_lowpass "reverb-control-lowpass"
-#define S_reverb_control_p "reverb-control?"
+#define S_reverb_control_on "reverb-control?"
#define S_reverb_control_scale "reverb-control-scale"
#define S_reverb_control_scale_bounds "reverb-control-scale-bounds"
#define S_reverse_channel "reverse-channel"
@@ -469,11 +453,10 @@
#define S_reverse_sound "reverse-sound"
#define S_revert_sound "revert-sound"
#define S_right_sample "right-sample"
-#define S_run "run"
#define S_sample "sample"
-#define S_sampler_at_end_p "sampler-at-end?"
+#define S_is_sampler_at_end "sampler-at-end?"
#define S_sampler_home "sampler-home"
-#define S_sampler_p "sampler?"
+#define S_is_sampler "sampler?"
#define S_sampler_position "sampler-position"
#define S_samples "samples"
#define S_sash_color "sash-color"
@@ -485,7 +468,6 @@
#define S_save_envelopes "save-envelopes"
#define S_save_hook "save-hook"
#define S_save_listener "save-listener"
-#define S_save_macros "save-macros"
#define S_save_marks "save-marks"
#define S_save_mix "save-mix"
#define S_save_region "save-region"
@@ -522,12 +504,12 @@
#define S_selection_color "selection-color"
#define S_selection_context "selection-context"
#define S_selection_creates_region "selection-creates-region"
-#define S_selection_frames "selection-frames"
+#define S_selection_framples "selection-framples"
#define S_selection_maxamp "selection-maxamp"
#define S_selection_maxamp_position "selection-maxamp-position"
#define S_selection_member "selection-member?"
#define S_selection_to_mix "selection->mix"
-#define S_selection_p "selection?"
+#define S_is_selection "selection?"
#define S_selection_position "selection-position"
#define S_selection_srate "selection-srate"
#define S_short_file_name "short-file-name"
@@ -537,6 +519,7 @@
#define S_show_bare_x_axis "show-bare-x-axis"
#define S_show_controls "show-controls"
#define S_show_full_duration "show-full-duration"
+#define S_show_full_range "show-full-range"
#define S_show_grid "show-grid"
#define S_show_indices "show-indices"
#define S_show_listener "show-listener"
@@ -570,17 +553,17 @@
#define S_snd_spectrum "snd-spectrum"
#define S_snd_tempnam "snd-tempnam"
#define S_snd_to_sample "snd->sample"
-#define S_snd_to_sample_p "snd->sample?"
+#define S_is_snd_to_sample "snd->sample?"
#define S_snd_url "snd-url"
#define S_snd_urls "snd-urls"
#define S_snd_version "snd-version"
#define S_snd_warning "snd-warning"
#define S_snd_warning_hook "snd-warning-hook"
#define S_sound_file_extensions "sound-file-extensions"
-#define S_sound_file_p "sound-file?"
+#define S_is_sound_file "sound-file?"
#define S_sound_files_in_directory "sound-files-in-directory"
#define S_sound_loop_info "sound-loop-info"
-#define S_sound_p "sound?"
+#define S_is_sound "sound?"
#define S_sound_properties "sound-properties"
#define S_sound_property "sound-property"
#define S_sound_widgets "sound-widgets"
@@ -613,7 +596,7 @@
#define S_start_playing_hook "start-playing-hook"
#define S_start_playing_selection_hook "start-playing-selection-hook"
#define S_start_progress_report "start-progress-report"
-#define S_stop_dac_hook "stop-dac-hook"
+#define S_status_report "status-report"
#define S_stop_player "stop-player"
#define S_stop_playing "stop-playing"
#define S_stop_playing_hook "stop-playing-hook"
@@ -629,25 +612,23 @@
#define S_temp_dir "temp-dir"
#define S_text_focus_color "text-focus-color"
#define S_time_graph "time-graph"
-#define S_time_graph_p "time-graph?"
+#define S_time_graph_on "time-graph?"
#define S_time_graph_style "time-graph-style"
#define S_time_graph_type "time-graph-type"
#define S_tiny_font "tiny-font"
#define S_tracking_cursor_style "tracking-cursor-style"
#define S_transform_dialog "transform-dialog"
-#define S_transform_frames "transform-frames"
+#define S_transform_framples "transform-framples"
#define S_transform_graph "transform-graph"
-#define S_transform_graph_p "transform-graph?"
+#define S_transform_graph_on "transform-graph?"
#define S_transform_graph_style "transform-graph-style"
#define S_transform_graph_type "transform-graph-type"
#define S_transform_normalization "transform-normalization"
-#define S_transform_p "transform?"
+#define S_is_transform "transform?"
#define S_transform_sample "transform-sample"
#define S_transform_size "transform-size"
#define S_transform_to_integer "transform->integer"
-#define S_transform_to_vct "transform->vct"
#define S_transform_type "transform-type"
-#define S_trap_segfault "trap-segfault"
#define S_unbind_key "unbind-key"
#define S_undo "undo"
#define S_undo_hook "undo-hook"
@@ -657,8 +638,7 @@
#define S_update_sound "update-sound"
#define S_update_time_graph "update-time-graph"
#define S_update_transform_graph "update-transform-graph"
-#define S_variable_graph_p "variable-graph?"
-#define S_vct_to_channel "vct->channel"
+#define S_is_variable_graph "variable-graph?"
#define S_view_files_amp "view-files-amp"
#define S_view_files_amp_env "view-files-amp-env"
#define S_view_files_dialog "view-files-dialog"
@@ -687,6 +667,7 @@
#define S_with_file_monitor "with-file-monitor"
#define S_with_gl "with-gl"
#define S_with_inset_graph "with-inset-graph"
+#define S_with_interrupts "with-interrupts"
#define S_with_menu_icons "with-menu-icons"
#define S_with_mix_tags "with-mix-tags"
#define S_with_pointer_focus "with-pointer-focus"
@@ -721,4 +702,19 @@
#define S_zoom_focus_middle "zoom-focus-middle"
#define S_zoom_focus_right "zoom-focus-right"
#define S_zoom_focus_style "zoom-focus-style"
+
+#if HAVE_SCHEME
+#define S_channel_to_vct "channel->float-vector"
+#define S_mix_vct "mix-float-vector"
+#define S_region_to_vct "region->float-vector"
+#define S_transform_to_vct "transform->float-vector"
+#define S_vct_to_channel "float-vector->channel"
+#else
+#define S_channel_to_vct "channel->vct"
+#define S_mix_vct "mix-vct"
+#define S_region_to_vct "region->vct"
+#define S_transform_to_vct "transform->vct"
+#define S_vct_to_channel "vct->channel"
+#endif
+
#endif
diff --git a/snd-test.fs b/snd-test.fs
index 516c13a..f279fed 100644
--- a/snd-test.fs
+++ b/snd-test.fs
@@ -1,15 +1,17 @@
\ snd-test.fs -- Snd Forth code and tests
\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Sat Aug 05 00:09:28 CEST 2006
-\ Changed: Sun Mar 06 18:16:26 CET 2011
+\ Created: 06/08/05 00:09:28
+\ Changed: 15/03/05 13:28:40
-\ Commentary:
+\ Tags: FIXME - something is wrong
+\ XXX - info marker
\
\ Tested with:
-\ Snd version 11.14 of 7-Mar-11
-\ FTH 1.2.9 (03-Mar-2011)
-
+\ Snd 15.x
+\ Fth 1.3.x
+\
+\ The most Gtk tests will be skipped if not gtk3.
\
\ Reads init file ./.sndtest.fs or ~/.sndtest.fs for global variables,
\ hooks, etc.
@@ -17,17 +19,25 @@
\ Example:
\
\ cat ./.sndtest.fs
-\ "TMPDIR" getenv set-save-dir to original-save-dir
-\ save-dir set-temp-dir to original-temp-dir
-\
-\ #t to with-big-file
+\ "/tmp" set-save-dir to original-save-dir
+\ save-dir set-temp-dir to original-temp-dir
+\
+\ #t to with-big-file
\ "/usr/opt/sound/SFiles/bigger.snd" to bigger-snd
-\ "/usr/opt/sound/sf1/" to sf-dir
-\ \ #t to all-args
-\ \ #t to *snd-test-verbose*
-\ \ #t to *snd-test-ws-play*
-\ \ #t to *snd-test-ws-statistics*
-\ \ #t to *snd-test-ws-verbose*
+\ "/usr/opt/sound/sf1/" to sf-dir
+\ #t to all-args
+\ 2 to *tests*
+\ #t to *snd-test-verbose*
+\
+\ lambda: <{ output -- }>
+\ "sox -qV1 %s -d" #( output ) string-format file-system unless
+\ "exit %d\n" #( exit-status ) fth-print
+\ then
+\ ; to *snd-test-ws-player*
+\
+\ #t to *snd-test-ws-play*
+\ #t to *snd-test-ws-statistics*
+\ #t to *snd-test-ws-verbose*
\
\ Start tests:
@@ -42,36 +52,43 @@
\ test 03: variables
\ test 04: sndlib
\ test 05: simple overall checks
+\ test 08: clm
\ test 10: marks
\ test 15: chan-local vars
\ test 19: save and restore
\ test 23: with-sound
-\ test 26: Gtk
\ test 27: general ( will be replaced in the future )
\ test 28: errors
-'snd-nogui provided? constant *with-test-nogui*
-*with-test-nogui* not constant *with-test-gui*
-'snd-motif provided? constant *with-test-motif*
-'snd-gtk provided? constant *with-test-gtk*
-'snd-ladspa provided? constant *with-test-ladspa*
+'alsa provided? constant *with-test-alsa*
+'complex provided? constant *with-test-complex*
'gl provided? constant *with-test-gl*
'gl2ps provided? constant *with-test-gl2ps*
'gsl provided? constant *with-test-gsl*
-'alsa provided? constant *with-test-alsa*
-'complex provided? constant *with-test-complex*
+'gtk3 provided? constant *with-test-gtk3*
+'snd-gtk provided? constant *with-test-gtk*
+'snd-ladspa provided? constant *with-test-ladspa*
+'snd-motif provided? constant *with-test-motif*
+'snd-nogui provided? constant *with-test-nogui*
+*with-test-nogui* not constant *with-test-gui*
24 set-object-print-length
+*with-test-complex* [unless]
+ -1 constant 0+i
+[then]
+
*with-test-nogui* [if]
#f value stdout-io
#f value stderr-io
[else]
\ Prints to Snd's listener and stdout/stderr.
- \ The original CLM-PRINT utilizes SND-PRINT only but we want output
+ \ The original CLM-PRINT uses only SND-PRINT but we want output
\ to stdout/stderr too.
- : clm-print ( fmt :optional args -- ) fth-format ( str ) snd-print ( str ) .stdout ;
+ : clm-print ( fmt :optional args -- )
+ fth-format ( str ) snd-print ( str ) .stdout
+ ;
:port-name "sndout"
:write-line lambda: <{ line -- }> line snd-print ( line ) .stdout ;
@@ -82,32 +99,40 @@
make-soft-port set-*stderr* value stderr-io
[then]
-\ Output words: not clm-print here if we want xterm output. That's
-\ why no clm-message which uses clm-print.
+\ Output words: We can't use clm-print here if we want xterm output
+\ (clm-message uses clm-print).
-\ SND-TEST-MESSAGE: Puts a comment sign before output and terminates with a carriage return
+\ SND-TEST-MESSAGE: Puts a comment sign before output
+\ and terminates with a carriage return.
: snd-test-message ( fmt args -- ) ." \ " fth-print cr ;
\ SND-DISPLAY: Wraps text like snd-test-message and prepends text with
\ current line number ("\ [102] text\n").
: (snd-display) { fmt args lno -- }
fmt args string-format { str }
- $" \\ [%d] %s\n" #( lno str ) fth-print
+ "\\ [%d] %s\n" #( lno str ) fth-print
;
-: snd-display ( fmt args -- ) postpone *lineno* postpone (snd-display) ; immediate
+
+: snd-display ( fmt args -- )
+ postpone *lineno*
+ postpone (snd-display)
+; immediate
\ *SND-TEST-VERBOSE*: progress information in long tests
-\
+\
\ test 19-save/restore: function names
\ test 28-errors: prints proc-array length and progress information
#f value *snd-test-verbose*
\ WITH-SOUND control
-\
-\ test 23-with-sound: :play
-\ test 23-with-sound: :statistics
-\ test 23-with-sound: :verbose (event (bird) and instrument names)
+\
+\ options for test 23-with-sound:
+\ :play
+\ :player
+\ :statistics
+\ :verbose (event (bird) and instrument names)
#f value *snd-test-ws-play*
+#f value *snd-test-ws-player*
#f value *snd-test-ws-statistics*
#f value *snd-test-ws-verbose*
@@ -118,24 +143,24 @@
#f value my-snd-error-hook
#f value my-mus-error-hook
-"HOME" getenv value *home*
-save-dir *home* "/zap/snd" $+ || value original-save-dir
-temp-dir *home* "/zap/tmp" $+ || value original-temp-dir
-sound-file-extensions value original-sound-file-extensions
-listener-prompt value original-prompt
-65536 value default-file-buffer-size
-8 value *info-array-print-length*
+"HOME" getenv value *home*
+save-dir *home* "/zap/snd" $+ || value original-save-dir
+temp-dir *home* "/zap/tmp" $+ || value original-temp-dir
+sound-file-extensions value original-sound-file-extensions
+listener-prompt value original-prompt
+mus-file-buffer-size value default-file-buffer-size
+8 value *info-array-print-length*
-"/home/bil/sf1/" value sf-dir
+"/home/bil/sf1/" value sf-dir
"/home/bil/zap/sounds/bigger.snd" value bigger-snd
-#f value with-big-file
-#f value all-args
+#f value with-big-file
+#f value all-args
\ Global variables may be overridden in `pwd`/.sndtest.fs or ~/.sndtest.fs.
".sndtest.fs" load-init-file
\ default 1, can be reset in .sndtest.fs
-*tests* integer? [if]
+*tests* integer? [if]
*tests* 0> [if]
*tests*
[else]
@@ -148,28 +173,70 @@ listener-prompt value original-prompt
*with-test-nogui* [if]
'( 0.0 0.1 ) value x-bounds-value
- : x-bounds <{ :optional snd 0 chn 0 axis 0 -- val }> x-bounds-value ;
- : set-x-bounds <{ bounds :optional snd 0 chn 0 axis 0 -- val }> bounds dup to x-bounds-value ;
+ : x-bounds <{ :optional snd 0 chn 0 axis 0 -- res }>
+ x-bounds-value
+ ;
+
+ : set-x-bounds <{ bounds :optional snd 0 chn 0 axis 0 -- res }>
+ bounds dup to x-bounds-value
+ ;
'( -1.0 1.0 ) value y-bounds-value
- : y-bounds <{ :optional snd 0 chn 0 axis 0 -- val }> y-bounds-value ;
- : set-y-bounds <{ bounds :optional snd 0 chn 0 axis 0 -- val }> bounds dup to y-bounds-value ;
+ : y-bounds <{ :optional snd 0 chn 0 axis 0 -- res }>
+ y-bounds-value
+ ;
+
+ : set-y-bounds <{ bounds :optional snd 0 chn 0 axis 0 -- res }>
+ bounds dup to y-bounds-value
+ ;
+
+ : position->x <{ val :optional snd 0 chn 0 ax time-graph -- res }>
+ #f
+ ;
+ <'> position->x alias position->y
+
+ : x->position <{ val :optional snd 0 chn 0 ax time-graph -- res }>
+ #f
+ ;
+ <'> x->position alias y->position
+
+ : channel-widgets <{ :optional snd 0 chn 0 -- res }>
+ #f
+ ;
#t value enved-filter-value
- : enved-filter <{ -- val }> enved-filter-value ;
- : set-enved-filter <{ val -- val }> val dup to enved-filter-value ;
+ : enved-filter <{ -- res }>
+ enved-filter-value
+ ;
+
+ : set-enved-filter <{ val -- res }>
+ val dup to enved-filter-value
+ ;
34 value graph-cursor-value
- : graph-cursor <{ -- val }> graph-cursor-value ;
- : set-graph-cursor <{ val -- val }> val dup to graph-cursor-value ;
+ : graph-cursor <{ -- res }>
+ graph-cursor-value
+ ;
+
+ : set-graph-cursor <{ val -- res }>
+ val dup to graph-cursor-value
+ ;
nil value enved-envelope-value
- : enved-envelope <{ -- val }> enved-envelope-value ;
- : set-enved-envelope <{ val -- val }> val dup to enved-envelope-value ;
+ : enved-envelope <{ -- res }>
+ enved-envelope-value
+ ;
+
+ : set-enved-envelope <{ val -- res }>
+ val dup to enved-envelope-value
+ ;
hot-colormap value colormap-value
- : colormap <{ -- val }> colormap-value ;
- : set-colormap <{ val -- val }>
+ : colormap <{ -- res }>
+ colormap-value
+ ;
+
+ : set-colormap <{ val -- res }>
val positive?
val 20 <= && if
val to colormap-value
@@ -177,9 +244,33 @@ listener-prompt value original-prompt
val
;
- <'> noop alias integer->colormap
- <'> noop alias colormap->integer
+ : add-colormap <{ name func -- res }>
+ #f
+ ;
+
+ <'> noop alias integer->colormap ( n -- cm )
+ <'> noop alias colormap->integer ( cm -- n )
+
+ : make-graph-data <{ :optional snd 0 chn 0 edpos 0 low -1 high -1 -- res }>
+ #f
+ ;
+
+ : graph-data <{ data :optional snd 0 chn 0 cx 0 low -1 high -1 gs 0 cr 0 -- }>
+ #f
+ ;
+ : draw-line <{ x0 y0 x1 y1 :optional snd 0 chn 0 ax time-graph cr 0 -- res }>
+ #f
+ ;
+
+ : draw-axes <{ wid gc lab :optional x0 0 x1 0 y0 0 y1 0 st 0 axes 0 -- res }>
+ #f
+ ;
+ <'> noop alias axis-color
+ <'> noop alias foreground-color
+ <'> noop alias highlight-color
+ <'> noop alias snd-gcs
+
\ These are already created in snd-nogui.c
\
\ 2 #f create-hook mouse-enter-graph-hook
@@ -206,20 +297,21 @@ require effects
require bird.fsm
*clm-search-list* file-pwd array-push to *clm-search-list*
-
reset-all-hooks
*with-test-motif* [if]
lambda: <{ dpy e -- }>
+ \ XGetErrorText's return code is '( id string )
dpy e Ferror_code nil 1024 FXGetErrorText { res }
- $" Xlib error_code[%s]: %s" res fth-warning
+ "Xlib error_code[%s]: %s" res fth-warning
dpy e Frequest_code nil 1024 FXGetErrorText to res
- $" Xlib request_code[%s]: %s" res fth-warning
+ "Xlib request_code[%s]: %s" res fth-warning
dpy e Fminor_code nil 1024 FXGetErrorText to res
- $" Xlib minor_code[%s]: %s" res fth-warning
+ "Xlib minor_code[%s]: %s" res fth-warning
; FXSetErrorHandler drop
+
lambda: <{ dpy -- }>
- $" Xlib IO Error dpy: %S" #( dpy ) fth-error
+ "Xlib IO Error dpy: %S" #( dpy ) fth-error
; FXSetIOErrorHandler drop
[then]
@@ -245,7 +337,8 @@ reset-all-hooks
{ obj }
obj vct? if
obj
- else obj array? if
+ else
+ obj array? if
obj vector->vct
else
#f
@@ -258,7 +351,7 @@ reset-all-hooks
val0 any->vct { v0 }
val1 any->vct { v1 }
v0
- v1 &&
+ v1 &&
v0 length v1 length = && if
v0 vct-copy v1 vct-subtract! vct-peak err f<=
else
@@ -278,7 +371,13 @@ reset-all-hooks
: feql-err ( obj0 obj1 err -- f )
{ obj0 obj1 err }
obj0 object-length obj1 object-length = if
- #t ( f ) obj0 each ( r0 ) obj1 i object-ref ( r1 ) err fneq-err if not leave then end-each
+ #t ( flag )
+ obj0 each ( r0 )
+ obj1 i object-ref ( r1 ) err fneq-err if
+ not ( toggle flag )
+ leave
+ then
+ end-each ( flag )
else
#f
then
@@ -290,8 +389,12 @@ reset-all-hooks
: fveql ( v1 v2 idx -- f)
{ v1 v2 idx }
- #t v1 length v2 length min idx ?do
- v1 i object-ref v2 i object-ref fneq if not leave then
+ #t ( flag )
+ v1 length v2 length min idx ?do
+ v1 i object-ref v2 i object-ref fneq if
+ not ( toggle flag )
+ leave
+ then
loop
;
@@ -301,8 +404,8 @@ reset-all-hooks
#t ( flag )
obj1 each ( entry )
obj2 i list-ref object-equal? unless
- not ( toggle flag )
- leave
+ not ( toggle flag )
+ leave
then
end-each
else
@@ -310,25 +413,32 @@ reset-all-hooks
then
;
+\ arity: #( req opt rest )
: arity-ok <{ proc args -- f }>
proc proc? if
- \ draw-axes 0/0/#t but it means 3/6/#f
- proc proc-name "draw-axes" string= if
- args 3 >=
- args 9 <= &&
+ proc proc-arity { args-lst }
+ args-lst 0 array-ref { req } \ int
+ args-lst 1 array-ref { opt } \ int
+ args-lst 2 array-ref { rest } \ bool
+ opt 0> if
+ args req >=
+ args req opt + <= &&
else
- proc proc-arity { args-lst }
- args args-lst 0 array-ref >=
- args args-lst 0 array-ref args-lst 1 array-ref + <= &&
+ args req =
+ rest ||
then
else
#f
then
;
-: set-arity-ok <{ proc args -- f }> proc set-xt args arity-ok ;
+: set-arity-ok <{ proc args -- f }>
+ proc set-xt args arity-ok
+;
-: symbol-defined? ( sym -- f ) $" defined? " swap symbol-name $+ string-eval ;
+: symbol-defined? ( sym -- f )
+ "defined? " swap symbol-name $+ string-eval
+;
: vector? { obj -- f }
obj array? if
@@ -344,12 +454,18 @@ reset-all-hooks
obj vector? ||
;
+: snd-test-catch ( xt -- tag )
+ #t nil fth-catch { tag }
+ stack-reset
+ tag
+;
+
: snd-test-format { sndfmt res req fmt args -- str }
sndfmt #( res req ) string-format { str }
fmt empty? if
str
else
- fmt args string-format $" : " $+ str $+
+ fmt args string-format ": " $+ str $+
then
;
@@ -359,12 +475,13 @@ reset-all-hooks
print-length { old-vlen }
*info-array-print-length* set-mus-array-print-length drop
*info-array-print-length* set-print-length drop
- $" res " op $+ $" req?\n\\ => res %S\n\\ => req %S" $+ res req fmt args snd-test-format ( str )
+ "res " op $+ " req?\n\\ => res %S\n\\ => req %S" $+ res req fmt args
+ snd-test-format ( str )
old-alen set-mus-array-print-length drop
old-vlen set-print-length drop
( str )
else
- $" res %S " op $+ $" req %S?" $+ res req fmt args snd-test-format ( str )
+ "res %S " op $+ " req %S?" $+ res req fmt args snd-test-format ( str )
then
;
@@ -383,56 +500,78 @@ reset-all-hooks
: (snd-test-neq) { res req fmt args lno -- }
res req snd-test-equal? unless
res req "!=" fmt args snd-format { str }
- $" \\ [%d] %s\n" #( lno str ) fth-print
+ "\\ [%d] %s\n" #( lno str ) fth-print
then
;
: (snd-test-eq) { res req fmt args lno -- }
res req snd-test-equal? if
res req "==" fmt args snd-format { str }
- $" \\ [%d] %s\n" #( lno str ) fth-print
+ "\\ [%d] %s\n" #( lno str ) fth-print
then
;
: (snd-test-any-neq) { res req func fmt args lno -- }
res req func execute unless
res req "!=" fmt args snd-format { str }
- $" \\ [%d] %s\n" #( lno str ) fth-print
+ "\\ [%d] %s\n" #( lno str ) fth-print
then
;
: (snd-test-any-eq) { res req func fmt args lno -- }
res req func execute if
res req "==" fmt args snd-format { str }
- $" \\ [%d] %s\n" #( lno str ) fth-print
+ "\\ [%d] %s\n" #( lno str ) fth-print
then
;
-: snd-test-neq ( res req fmt args -- ) postpone *lineno* postpone (snd-test-neq) ; immediate
-: snd-test-eq ( res req fmt args -- ) postpone *lineno* postpone (snd-test-eq) ; immediate
+: snd-test-neq ( res req fmt args -- )
+ postpone *lineno*
+ postpone (snd-test-neq)
+; immediate
+
+: snd-test-eq ( res req fmt args -- )
+ postpone *lineno*
+ postpone (snd-test-eq)
+; immediate
-\ res req <'> ffequal? "more info" #() snd-test-any-neq
+\ res req <'> ffeql "more info" #() snd-test-any-neq
: snd-test-any-neq ( res req func fmt args -- )
- postpone *lineno* postpone (snd-test-any-neq)
+ postpone *lineno*
+ postpone (snd-test-any-neq)
; immediate
-\ res req <'> ffequal? "more info" #() snd-test-any-eq
+\ res req <'> ffeql "more info" #() snd-test-any-eq
: snd-test-any-eq ( res req func fmt args -- )
- postpone *lineno* postpone (snd-test-any-eq)
+ postpone *lineno*
+ postpone (snd-test-any-eq)
; immediate
: check-file-name { name -- fsnd }
- name file-exists? if name else sf-dir name $+ then
+ name file-exists? if
+ name
+ else
+ sf-dir name $+
+ then
;
-: make-color-with-catch ( c1 c2 c3 -- color )
- <'> make-color 'no-such-color #t fth-catch if stack-reset 1 0 0 make-color then
+1 0 0 make-color constant safe-color
+
+: make-color-with-catch { c1 c2 c3 -- color }
+ c1 c2 c3 <'> make-color 'no-such-color #t fth-catch if
+ stack-reset
+ safe-color
+ then
;
: reset-almost-all-hooks ( -- )
reset-all-hooks
- my-snd-error-hook proc? if snd-error-hook my-snd-error-hook add-hook! then
- my-mus-error-hook proc? if mus-error-hook my-mus-error-hook add-hook! then
+ my-snd-error-hook proc? if
+ snd-error-hook my-snd-error-hook add-hook!
+ then
+ my-mus-error-hook proc? if
+ mus-error-hook my-mus-error-hook add-hook!
+ then
;
*with-test-nogui* [if]
@@ -442,26 +581,33 @@ reset-all-hooks
nil nil { dialog d }
dialog-widgets each to dialog
dialog if
- dialog 0 array-ref symbol? if
- dialog is-managed? if dialog hide-widget drop then
- else
- dialog each to d
- d 0 array-ref symbol? if
- d is-managed? if d hide-widget drop then
- then
- end-each
- then
- then
+ dialog 0 array-ref symbol? if
+ dialog is-managed? if
+ dialog hide-widget drop
+ then
+ else \ not widget?
+ dialog each to d
+ d 0 array-ref symbol? if
+ d is-managed? if
+ d hide-widget drop
+ then
+ then
+ end-each
+ then \ widget?
+ then \ dialog
end-each
;
[then]
#f value overall-start-time
#() value test-numbers
+
: run-fth-test ( xt -- )
{ xt }
xt xt->name { name }
- test-numbers name 0 2 string-substring string->number array-member? if
+ name 0 2 string-substring { num }
+ num string->number to num
+ test-numbers num array-member? if
name #f snd-test-message
stack-reset
gc-run
@@ -470,12 +616,14 @@ reset-all-hooks
tm stop-timer
stack-reset
sounds if
- $" open sounds: %s" #( #t short-file-name ) snd-test-message
- sounds each ( snd ) close-sound drop end-each
+ "open sounds: %s" #( #t short-file-name ) snd-test-message
+ sounds each ( snd )
+ close-sound drop
+ end-each
then
#f set-ask-about-unsaved-edits drop
#f set-remember-sound-state drop
- $" %s: %s\n\\ " #( name tm ) snd-test-message
+ "%s: %s\n\\ " #( name tm ) snd-test-message
then
;
@@ -487,28 +635,29 @@ reset-all-hooks
"gtk"
else
*with-test-nogui* if
- #t set-with-mix-tags drop
- "nogui"
+ #t set-with-mix-tags drop
+ "nogui"
else
- "unknown"
+ "unknown"
then
then
then { kind }
stack-reset
- "test.snd" file-exists? if "test.snd" 0o644 file-chmod then
- $" === Snd version: %s (snd-%s)" #( snd-version kind ) snd-test-message
- $" === Fth version: %s" #( fth-version ) snd-test-message
+ "test.snd" file-exists? if
+ "test.snd" 0o644 file-chmod
+ then
+ "=== Snd version: %s (snd-%s)" #( snd-version kind ) snd-test-message
+ "=== Fth version: %s" #( fth-version ) snd-test-message
"" #f snd-test-message
date #f snd-test-message
"" #f snd-test-message
default-file-buffer-size set-mus-file-buffer-size to *clm-file-buffer-size*
#f set-with-background-processes drop
- 600 set-window-x drop
- 10 set-window-y drop
- #t set-show-listener drop
+ 600 set-window-x drop
+ 10 set-window-y drop
+ #t set-show-listener drop
reset-almost-all-hooks
- \ set-mus-srate returns old srate
- 22050 dup set-mus-srate drop to *clm-srate*
+ 22050 set-mus-srate f>s to *clm-srate*
stack-reset
make-timer to overall-start-time
;
@@ -517,31 +666,35 @@ reset-all-hooks
overall-start-time stop-timer
.stack
stack-reset
- regions each ( r ) forget-region drop end-each
- 0 set-view-files-sort drop
- clear-sincs drop
- sounds if stop-playing drop then
+ regions each ( r )
+ forget-region drop
+ end-each
+ sounds if
+ stop-playing drop
+ then
reset-almost-all-hooks
#f set-ask-about-unsaved-edits drop
#f set-remember-sound-state drop
- $" all done!" #f snd-test-message
+ "all done!" #f snd-test-message
"" #f snd-test-message
- $" summary: %s" #( overall-start-time ) snd-test-message
+ "summary: %s" #( overall-start-time ) snd-test-message
0 nil nil { file-count path file }
#( original-save-dir original-temp-dir "/tmp" ) each to path
path file-directory? if
path file-dir each to file
- /snd_/ file regexp-match if
- file file-delete
- 1 +to file-count
- then
+ /snd_/ file regexp-match if
+ file file-delete
+ 1 +to file-count
+ then
end-each
then
end-each
"" #f snd-test-message
- $" %d files deleted" #( file-count ) snd-test-message
+ "%d files deleted" #( file-count ) snd-test-message
"" #f snd-test-message
- "test.snd" file-exists? if "test.snd" 0o644 file-chmod then
+ "test.snd" file-exists? if
+ "test.snd" 0o644 file-chmod
+ then
#( "aaa.eps"
"envs.save"
"fmv.snd"
@@ -581,7 +734,9 @@ reset-all-hooks
"with-mix.snd"
"1"
"gtk-errors"
- "accelmap" ) each ( file ) file-delete end-each
+ "accelmap" ) each ( file )
+ file-delete
+ end-each
#( "mus10.snd.snd"
"ieee-text-16.snd.snd"
"trumps22.adp.snd"
@@ -595,37 +750,20 @@ reset-all-hooks
"wood.sds.snd"
"o2_dvi.wave.snd"
"nist-shortpack.wav.snd"
- "bad_data_format.snd.snd" ) each ( file ) sf-dir swap $+ file-delete end-each
+ "bad_data_format.snd.snd" ) each ( file )
+ sf-dir swap $+ file-delete
+ end-each
#t set-show-listener drop
"test-forth.output" save-listener drop
original-prompt set-listener-prompt drop
;
-SIGSEGV lambda: { sig -- }
- stack-reset
- backtrace
- "" #f snd-test-message
- $" Segmentation fault (signal no %d)" #( sig ) snd-test-message
- "" #f snd-test-message
- finish-snd-test
- 2 snd-exit drop
-; signal drop
-
-SIGILL lambda: { sig -- }
- stack-reset
- backtrace
- "" #f snd-test-message
- $" Illegal instruction (signal no %d)" #( sig ) snd-test-message
- "" #f snd-test-message
- finish-snd-test
- 2 snd-exit drop
-; signal drop
-
SIGINT lambda: { sig -- }
stack-reset
backtrace
"" #f snd-test-message
- $" Interrupt received. Clean up %S." #( *filename* #f file-basename ) snd-test-message
+ "Interrupt received. Clean up %S." #( *filename* #f file-basename )
+ snd-test-message
"" #f snd-test-message
finish-snd-test
0 snd-exit drop
@@ -635,32 +773,26 @@ SIGINT lambda: { sig -- }
\ ---------------- test 00: constants ----------------
*with-test-motif* [if]
- $" 6x12"
+ "6x12"
[else]
*with-test-gtk* [if]
- $" Sans 8"
+ "Sans 8"
[else]
- $" 9x15"
+ "9x15"
[then]
[then] constant tiny-font-string
*with-test-motif* [if]
- $" 9x15"
+ "9x15"
[else]
*with-test-gtk* [if]
- $" Monospace 10"
+ "Monospace 10"
[else]
- $" 6x12"
+ "6x12"
[then]
[then] constant tiny-font-set-string
-\ FIXME
-\
-\ temp-dir
-\ save-dir
-\ ladspa-dir
-\ peak-env-dir
-\
+\ XXX: temp-dir, save-dir, ladspa-dir, peak-env-dir
\ These variables default to NULL (snd.c/snd-0.h).
\ snd-test.scm checks for #f
\ snd-test.fs checks for ""
@@ -674,9 +806,10 @@ SIGINT lambda: { sig -- }
mxs ||
mks ||
rgns || if
- $" start up sounds: %s, mixes: %s, marks: %s, regions: %s?" #( snds mxs mks rgns ) snd-display
+ "start up sounds: %s, mixes: %s, marks: %s, regions: %s?"
+ #( snds mxs mks rgns ) snd-display
then
- \
+ \
nil nil nil nil { vals sym req res }
#( #( <'> enved-amplitude 0 )
#( <'> bartlett-window 4 )
@@ -777,7 +910,7 @@ SIGINT lambda: { sig -- }
#( <'> show-x-axis-unlabelled 4 )
#( <'> show-bare-x-axis 5 )
\ sndlib constants
- #( <'> mus-unsupported 0 )
+ #( <'> mus-unknown-header 0 )
#( <'> mus-next 1 )
#( <'> mus-aifc 2 )
#( <'> mus-riff 3 )
@@ -803,7 +936,7 @@ SIGINT lambda: { sig -- }
#( <'> mus-chebyshev-first-kind 1 )
#( <'> mus-chebyshev-second-kind 2 )
\
- #( <'> mus-unknown 0 )
+ #( <'> mus-unknown-sample 0 )
#( <'> mus-bshort 1 )
#( <'> mus-lshort 10 )
#( <'> mus-mulaw 2 )
@@ -831,16 +964,16 @@ SIGINT lambda: { sig -- }
vals 1 array-ref to req
sym execute ( res ) req "%s" #( sym ) snd-test-neq
end-each
- \
+ \
temp-dir { old-dir }
#f set-temp-dir drop
#( #( <'> region-graph-style graph-lines )
#( <'> ask-about-unsaved-edits #f )
#( <'> show-full-duration #f )
+ #( <'> show-full-range #f )
#( <'> initial-beg 0.0 )
#( <'> initial-dur 0.1 )
#( <'> ask-before-overwrite #f )
- #( <'> audio-output-device 0 )
#( <'> auto-resize #t )
#( <'> auto-update #f )
#( <'> channel-style 1 )
@@ -852,16 +985,15 @@ SIGINT lambda: { sig -- }
#( <'> cursor-location-offset 0 )
#( <'> dac-combines-channels #t )
#( <'> dac-size 256 )
- #( <'> minibuffer-history-length 8 )
#( <'> clipping #f )
#( <'> default-output-chans 1 )
- #( <'> default-output-data-format mus-lfloat )
+ #( <'> default-output-sample-type mus-lfloat )
#( <'> default-output-srate 44100 )
#( <'> default-output-header-type mus-next )
#( <'> dot-size 1 )
#( <'> cursor-size 15 )
#( <'> cursor-style cursor-cross )
- #( <'> tracking-cursor-style cursor-cross )
+ #( <'> tracking-cursor-style cursor-line )
#( <'> enved-base 1.0 )
#( <'> enved-clip? #t )
#( <'> enved-filter #t )
@@ -893,12 +1025,10 @@ SIGINT lambda: { sig -- }
#( <'> listener-prompt ">" )
#( <'> max-transform-peaks 100 )
#( <'> max-regions 16 )
- #( <'> max-virtual-ptrees 32 )
#( <'> min-dB -60.0 )
#( <'> log-freq-start 32.0 )
#( <'> selection-creates-region #t )
#( <'> transform-normalization normalize-by-channel )
- #( <'> view-files-sort 0 )
#( <'> print-length 12 )
#( <'> play-arrow-size 10 )
#( <'> save-state-file "saved-snd.fs" )
@@ -927,15 +1057,12 @@ SIGINT lambda: { sig -- }
#( <'> peak-env-dir "" )
#( <'> tiny-font tiny-font-string )
#( <'> transform-type fourier-transform )
- #( <'> trap-segfault #t )
#( <'> with-file-monitor #t )
- \ FIXME
- \ Forth doesn't optimize
- #( <'> optimization 0 )
#( <'> clm-table-size 512 )
#( <'> clm-default-frequency 0.0 )
#( <'> with-verbose-cursor #f )
#( <'> with-inset-graph #f )
+ #( <'> with-interrupts #t )
#( <'> remember-sound-state #f )
#( <'> with-smpte-label #f )
#( <'> with-toolbar *with-test-gtk* if #t else #f then )
@@ -962,15 +1089,17 @@ SIGINT lambda: { sig -- }
vars each to vals
vals 0 array-ref to sym
vals 1 array-ref to req
- sym execute ( val ) sym set-execute ( res ) req "set-%s" #( sym ) snd-test-neq
+ sym execute ( val ) sym set-execute ( res ) req "set-%s" #( sym )
+ snd-test-neq
end-each
old-dir set-temp-dir drop
- \
+ \
-123 set-max-transform-peaks drop
-123 set-zero-pad drop
- max-transform-peaks set-max-transform-peaks 100 "set-max-transform-peaks" #() snd-test-neq
+ max-transform-peaks set-max-transform-peaks 100 "set-max-transform-peaks" #()
+ snd-test-neq
zero-pad set-zero-pad 0 "set-zero-pad" #() snd-test-neq
- #t #t zero-pad nil $" #t #t zero-pad" #() snd-test-neq
+ #t #t zero-pad nil "#t #t zero-pad" #() snd-test-neq
*with-test-motif* if
#( <'> axis-label-font
<'> axis-numbers-font
@@ -979,7 +1108,8 @@ SIGINT lambda: { sig -- }
<'> bold-peaks-font ) { fonts }
fonts each to sym
sym execute to req
- "8x123" sym set-execute ( res ) req $" set-%s to bogus value" #( sym ) snd-test-neq
+ "8x123" sym set-execute ( res ) req "set-%s to bogus value" #( sym )
+ snd-test-neq
end-each
then
#f set-ask-about-unsaved-edits drop
@@ -997,21 +1127,21 @@ black-and-white-colormap constant *better-colormap*
*good-colormap* colormap? unless
#f to *good-colormap*
21 1 do
- i integer->colormap to res
- res colormap? if
- res to *good-colormap*
- leave
- then
+ i integer->colormap to res
+ res colormap? if
+ res to *good-colormap*
+ leave
+ then
loop
then
*better-colormap* colormap? unless
#f to *better-colormap*
21 *good-colormap* colormap->integer do
- i integer->colormap to res
- res colormap? if
- res to *better-colormap*
- leave
- then
+ i integer->colormap to res
+ res colormap? if
+ res to *better-colormap*
+ leave
+ then
loop
then
then
@@ -1020,7 +1150,6 @@ black-and-white-colormap constant *better-colormap*
#f set-temp-dir drop
#( #( <'> ask-about-unsaved-edits #f )
#( <'> ask-before-overwrite #f )
- #( <'> audio-output-device 0 )
#( <'> auto-resize #t )
#( <'> auto-update #f )
#( <'> auto-update-interval 60.0 )
@@ -1035,7 +1164,7 @@ black-and-white-colormap constant *better-colormap*
#( <'> color-scale 1.0 )
#( <'> colormap *good-colormap* )
#( <'> contrast-control-amp 1.0 )
- #( <'> cursor-follows-play #f )
+ #( <'> with-tracking-cursor #f )
#( <'> cursor-location-offset 0 )
#( <'> cursor-size 15 )
#( <'> cursor-style cursor-cross )
@@ -1043,7 +1172,7 @@ black-and-white-colormap constant *better-colormap*
#( <'> dac-combines-channels #t )
#( <'> dac-size 256 )
#( <'> default-output-chans 1 )
- #( <'> default-output-data-format mus-lfloat )
+ #( <'> default-output-sample-type mus-lfloat )
#( <'> default-output-header-type mus-next )
#( <'> default-output-srate 44100 )
#( <'> dot-size 1 )
@@ -1090,18 +1219,14 @@ black-and-white-colormap constant *better-colormap*
#( <'> mark-tag-height 4 )
#( <'> mark-tag-width 10 )
#( <'> max-regions 16 )
- #( <'> max-virtual-ptrees 32 )
#( <'> max-transform-peaks 100 )
#( <'> min-dB -60.0 )
- #( <'> minibuffer-history-length 8 )
#( <'> mix-tag-height 14 )
#( <'> mix-tag-width 6 )
#( <'> mix-waveform-height 20 )
#( <'> mus-array-print-length 8 )
#( <'> mus-clipping #f )
#( <'> mus-float-equal-fudge-factor 0.0000001 )
- #( <'> mus-prescaler 1.0 )
- #( <'> optimization 0 ) \ Forth doesn't optimize
#( <'> play-arrow-size 10 )
#( <'> print-length 12 )
#( <'> region-graph-style graph-lines )
@@ -1115,6 +1240,7 @@ black-and-white-colormap constant *better-colormap*
#( <'> show-axes 1 )
#( <'> show-controls #f )
#( <'> show-full-duration #f )
+ #( <'> show-full-range #f )
#( <'> show-grid #f )
#( <'> show-indices #f )
#( <'> show-marks #t )
@@ -1137,12 +1263,11 @@ black-and-white-colormap constant *better-colormap*
#( <'> temp-dir "" )
#( <'> time-graph-type graph-once )
#( <'> tiny-font tiny-font-string )
- #( <'> tracking-cursor-style cursor-cross )
+ #( <'> tracking-cursor-style cursor-line )
#( <'> transform-graph-type graph-once )
#( <'> transform-normalization normalize-by-channel )
#( <'> transform-size 512 )
#( <'> transform-type fourier-transform )
- #( <'> view-files-sort 0 )
#( <'> wavelet-type 0 )
#( <'> wavo-hop 3 )
#( <'> wavo-trace 64 )
@@ -1151,6 +1276,7 @@ black-and-white-colormap constant *better-colormap*
#( <'> with-tracking-cursor #f )
#( <'> with-verbose-cursor #f )
#( <'> with-inset-graph #f )
+ #( <'> with-interrupts #t )
#( <'> with-smpte-label #f )
#( <'> with-toolbar *with-test-gtk* if #t else #f then )
#( <'> with-tooltips #t )
@@ -1186,7 +1312,7 @@ black-and-white-colormap constant *better-colormap*
<'> transform-graph? ) to procs
'no-such-sound to req
procs each to sym
- sym #t nil fth-catch car 'no-such-sound "%s" #( sym ) snd-test-neq
+ sym snd-test-catch car 'no-such-sound "%s" #( sym ) snd-test-neq
end-each
\ 1 array-ref
#( #( <'> amp-control-bounds 8.0 )
@@ -1202,7 +1328,7 @@ black-and-white-colormap constant *better-colormap*
end-each
\
*snd-opened-sound* if
- $" *snd-opened-sound*: %S" #( *snd-opened-sound* ) snd-display
+ "*snd-opened-sound*: %S" #( *snd-opened-sound* ) snd-display
then
#f set-ask-about-unsaved-edits drop
#f set-remember-sound-state drop
@@ -1211,278 +1337,445 @@ black-and-white-colormap constant *better-colormap*
\ ---------------- test 02: headers ----------------
: test-header-check { res req lno name info -- }
- res req $" %s: %s" #( name info ) lno (snd-test-neq)
+ res req "%s: %s" #( name info ) lno (snd-test-neq)
;
-: (test-headers-with-loop) { name chns sr dur typ frm loop-start loop-end lno -- }
+: (test-headers-with-loop) ( name chns sr dur typ frm loop-s loop-e lno -- )
+ { name chns sr dur typ frm loop-start loop-end lno -- }
name check-file-name { file }
file file-exists? if
file mus-sound-chans { fchns }
file mus-sound-srate { fsr }
file mus-sound-duration { fdur }
- file mus-sound-data-format { ffrm }
+ file mus-sound-sample-type { ffrm }
file mus-sound-header-type { ftyp }
- file mus-sound-frames { fframes }
+ file mus-sound-framples { fframples }
file mus-sound-samples { fsamps }
file mus-sound-length { flen }
fchns chns lno name "chans" test-header-check
fsr sr lno name "srate" test-header-check
fdur dur lno name "duration" test-header-check
file mus-sound-datum-size fdur f* fsr f* fchns f* floor f>s { fsize }
- ffrm mus-unknown <>
- ftyp 27 <> && if
+ ffrm mus-unknown-sample <>
+ ftyp 27 <> && if
flen 1+ fsize < if
- flen 1+ fsize lno name "length" test-header-check
+ flen 1+ fsize lno name "length" test-header-check
then
then
- fframes fsr f/ fdur lno name "frames" test-header-check
- fframes fsamps fchns f/ f- floor fabs f>s { res }
+ fframples fsr f/ fdur lno name "framples" test-header-check
+ fframples fsamps fchns f/ f- floor fabs f>s { res }
res 1 > if
res 1 lno name "samples" test-header-check
then
ftyp mus-header-type-name typ lno name "type" test-header-check
- ffrm mus-data-format-name frm lno name "format" test-header-check
+ ffrm mus-sample-type-name frm lno name "format" test-header-check
file mus-sound-loop-info { lst }
loop-start if
lst nil? if
- $" [%d] %s loop info empty?" #( lno name ) snd-test-message
+ "[%d] %s loop info empty?" #( lno name ) snd-test-message
else
- lst car loop-start lno name "loop-start" test-header-check
- lst cadr loop-end lno name "loop-end" test-header-check
+ lst car loop-start lno name "loop-start" test-header-check
+ lst cadr loop-end lno name "loop-end" test-header-check
then
else
lst empty? unless
- $" [%d] %s thinks it has loop info: %s?" #( lno name lst ) snd-test-message
+ "[%d] %s thinks it has loop info: %s?"
+ #( lno name lst ) snd-test-message
then
then
- else
+ else \ not file-exists?
*fth-debug* if
- $" [%d] %s missing?" #( lno file ) snd-test-message
+ "[%d] %s missing?" #( lno file ) snd-test-message
then
- then
+ then \ file-exists?
;
: test-headers-with-loop ( name chns sr dur typ frm loop-start loop-end -- )
- postpone *lineno* postpone (test-headers-with-loop)
+ postpone *lineno*
+ postpone (test-headers-with-loop)
; immediate
+
: test-headers ( name chns sr dur typ frm -- )
- postpone #f postpone #f postpone *lineno* postpone (test-headers-with-loop)
+ postpone #f
+ postpone #f
+ postpone *lineno*
+ postpone (test-headers-with-loop)
; immediate
: 02-headers ( -- )
- "5_secs.aiff" 1 44100 5.303107 $" AIFF" $" big endian short (16 bits)" test-headers
- "8svx-8.snd" 1 22050 1.88766443729401 $" SVX8" $" signed byte (8 bits)" test-headers
- "Fnonull.aif" 1 8000 0.00112499995157123 $" AIFC" $" mulaw (8 bits)" test-headers
- "Pmiscck.aif" 1 8000 0.00112499995157123 $" AIFC" $" mulaw (8 bits)" test-headers
- "Pmiscck.wav" 1 8000 0.00112499995157123 $" RIFF" $" mulaw (8 bits)" test-headers
- "Poffset.aif" 1 8000 0.00112499995157123 $" AIFC" $" mulaw (8 bits)" test-headers
- "Porder.aif" 1 8000 0.00112499995157123 $" AIFC" $" mulaw (8 bits)" test-headers
- "Ptjunk.aif" 1 8000 0.00112499995157123 $" AIFC" $" mulaw (8 bits)" test-headers
- "Ptjunk.wav" 1 8000 0.00112499995157123 $" RIFF" $" mulaw (8 bits)" test-headers
- "SINE24-S.WAV" 2 44100 2.0 $" RIFF" $" little endian int (24 bits)" test-headers
- "a1.asf" 1 16000 3.736562 $" asf" $" unknown" test-headers
- "a2.asf" 1 8000 4.630625 $" asf" $" unknown" test-headers
- "addf8.afsp" 1 8000 2.9760000705719 $" Sun/Next" $" big endian short (16 bits)" test-headers
- "addf8.d" 1 8000 2.9760000705719 $" SPPACK" $" big endian short (16 bits)" test-headers
- "addf8.dwd" 1 8000 2.976000071 $" DiamondWare" $" little endian short (16 bits)" test-headers
- "addf8.nh" 2 44100 0.269931972 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "addf8.sd" 1 8000 2.9760000705719 $" ESPS" $" big endian short (16 bits)" test-headers
- "addf8.sf_mipseb" 1 8000 2.9760000705719 $" IRCAM" $" big endian short (16 bits)" test-headers
- "addf8.sf_sun" 1 8000 2.9760000705719 $" IRCAM" $" big endian short (16 bits)" test-headers
- "addf8.sf_vax_b" 1 8000 2.9760000705719 $" IRCAM" $" big endian short (16 bits)" test-headers
- "addf8.wav" 1 8000 2.9760000705719 $" RIFF" $" little endian short (16 bits)" test-headers
- "aebass.krz" 1 44100 3.0 $" Kurzweil 2000" $" big endian short (16 bits)" test-headers
- "aiff-16.snd" 2 44100 0.746666669845581 $" AIFF" $" big endian short (16 bits)" test-headers
- "aiff-8.snd" 2 44100 0.746666669845581 $" AIFF" $" signed byte (8 bits)" test-headers
- "alaw.aifc" 1 44100 0.0367800444364548 $" AIFC" $" alaw (8 bits)" test-headers
- "alaw.wav" 1 11025 8.70666694641113 $" RIFF" $" alaw (8 bits)" test-headers
- "astor_basia.mp2" 2 44100 1.022 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "c.asf" 1 8000 21.368126 $" asf" $" unknown" test-headers
- "ce-c3.w02" 1 33000 3.88848495483398 $" TX-16W" $" unknown" test-headers
- "ce-c4.w03" 1 33000 2.91618180274963 $" TX-16W" $" unknown" test-headers
- "ce-d2.w01" 1 33000 3.46439385414124 $" TX-16W" $" unknown" test-headers
- "clbonef.wav" 1 22050 2.57832193374634 $" RIFF" $" little endian float (32 bits)" test-headers
- "cranker.krz" 1 44100 3.48267579 $" Kurzweil 2000" $" big endian short (16 bits)" test-headers
- "d40130.aif" 1 10000 0.100000001490116 $" AIFF" $" big endian short (16 bits)" test-headers
- "d40130.au" 1 10000 0.100000001490116 $" Sun/Next" $" big endian short (16 bits)" test-headers
- "d40130.dsf" 1 8000 0.125 $" Delusion" $" little endian short (16 bits)" test-headers
- "d40130.fsm" 1 8000 0.12524999678 $" Farandole" $" little endian short (16 bits)" test-headers
- "d40130.iff" 1 10000 0.100000001490116 $" SVX8" $" signed byte (8 bits)" test-headers
- "d40130.pat" 1 10000 0.100000001490116 $" Gravis Ultrasound patch" $" little endian short (16 bits)" test-headers
- "d40130.sds" 1 10000 0.100000001490116 $" MIDI sample dump" $" unknown" test-headers
- "d40130.sdx" 1 10000 0.100000001490116 $" Sample dump" $" unsigned little endian short (16 bits)" test-headers
- "d40130.sf" 1 10000 0.100000001490116 $" IRCAM" $" little endian short (16 bits)" test-headers
- "d40130.smp" 1 8000 0.125 $" SMP" $" little endian short (16 bits)" test-headers
- "d40130.sou" 1 8000 0.125 $" SBStudioII" $" little endian short (16 bits)" test-headers
- "d40130.st3" 1 8000 0.125 $" Digiplayer ST3" $" unsigned little endian short (16 bits)" test-headers
- "d40130.uwf" 1 8000 0.1252499 $" Ultratracker" $" little endian short (16 bits)" test-headers
- "d40130.voc" 1 10000 0.100100003182888 $" VOC" $" unsigned byte (8 bits)" test-headers
- "d40130.w00" 1 16000 0.0625 $" TX-16W" $" unknown" test-headers
- "d40130.wav" 1 10000 0.100000001490116 $" RIFF" $" little endian short (16 bits)" test-headers
- "d43.wav" 1 10000 0.100000001490116 $" RIFF" $" little endian short (16 bits)" test-headers
- "digit0v0.aiff" 1 8000 0.560000002384186 $" AIFC" $" big endian short (16 bits)" test-headers
- "esps-16.snd" 1 8000 3.09737491607666 $" ESPS" $" big endian short (16 bits)" test-headers
- "forest.aiff" 2 44100 3.907143 $" AIFF" $" big endian short (16 bits)" 24981 144332 test-headers-with-loop
- "g721.au" 1 11025 4.35328817367554 $" Sun/Next" $" unknown" test-headers
- "g722.aifc" 1 44100 0.0184353739023209 $" AIFC" $" unknown" test-headers
- "gong.wve" 1 8000 3.96799993515015 $" PSION" $" alaw (8 bits)" test-headers
- "gsm610.wav" 1 11025 1.7687075138092 $" RIFF" $" unknown" test-headers
- "inrs-16.snd" 1 8000 2.46399998664856 $" INRS" $" little endian short (16 bits)" test-headers
- "kirk.wve" 1 8000 1.40799999237061 $" PSION" $" alaw (8 bits)" test-headers
- "loop.aiff" 1 44100 0.0367120169103146 $" AIFC" $" big endian short (16 bits)" 12 23 test-headers-with-loop
- "m.asf" 1 8000 64.964622 $" asf" $" unknown" test-headers
- "mary-sun4.sig" 1 8000 4.47612476348877 $" Comdisco SPW signal" $" big endian double (64 bits)" test-headers
- "mocksong.wav" 1 11025 7.869569301605 $" RIFF" $" little endian short (16 bits)" test-headers
- "mono24.wav" 1 22050 1.98997735977173 $" RIFF" $" little endian int (24 bits)" test-headers
- "msadpcm.wav" 1 11025 4.43501138687134 $" RIFF" $" unknown" test-headers
- "n8.snd" 1 44100 0.0367800444364548 $" Sun/Next" $" signed byte (8 bits)" test-headers
- "nasahal.aif" 1 11025 9.89841270446777 $" AIFF" $" signed byte (8 bits)" test-headers
- "nasahal.avi" 1 11025 10.432744 $" AVI" $" little endian short (16 bits)" test-headers
- "nasahal.dig" 1 11025 9.8984 $" Sound Designer 1" $" big endian short (16 bits)" test-headers
- "nasahal.ivc" 2 44100 0.449 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "nasahal.pat" 1 11025 3.95410442352295 $" Gravis Ultrasound patch" $" unsigned byte (8 bits)" test-headers
- "nasahal.snd" 1 11025 9.89841270446777 $" SNDT" $" unsigned byte (8 bits)" test-headers
- "nasahal.svx" 1 11025 9.89841270446777 $" SVX8" $" signed byte (8 bits)" test-headers
- "nasahal.v8" 1 8000 13.6412496566772 $" Covox V8" $" unsigned byte (8 bits)" test-headers
- "nasahal.voc" 1 11025 9.89941024780273 $" VOC" $" unsigned byte (8 bits)" test-headers
- "nasahal.vox" 2 44100 0.22444 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "nasahal8.wav" 1 11025 9.89841270446777 $" RIFF" $" unsigned byte (8 bits)" test-headers
- "nasahalad.smp" 1 11025 4.94920635223389 $" Goldwave sample" $" little endian short (16 bits)" test-headers
- "next-16.snd" 1 22050 1.00004529953003 $" Sun/Next" $" big endian short (16 bits)" test-headers
- "next-8.snd" 1 22050 0.226757362484932 $" Sun/Next" $" signed byte (8 bits)" test-headers
- "next-dbl.snd" 1 22050 0.226757362484932 $" Sun/Next" $" big endian double (64 bits)" test-headers
- "oboe.ldbl" 1 22050 2.30512475967407 $" RIFF" $" little endian double (64 bits)" test-headers
- "next-flt.snd" 1 22050 0.226757362484932 $" Sun/Next" $" big endian float (32 bits)" test-headers
- "aifc-float.snd" 1 22050 0.2267573624849 $" AIFC" $" big endian float (32 bits)" test-headers
- "next-mulaw.snd" 1 8012 2.03295063972473 $" Sun/Next" $" mulaw (8 bits)" test-headers
- "next24.snd" 1 44100 0.0367800444364548 $" Sun/Next" $" big endian int (24 bits)" test-headers
- "nist-01.wav" 1 16000 2.26912498474121 $" NIST" $" little endian short (16 bits)" test-headers
- "nist-10.wav" 1 16000 2.26912498474121 $" NIST" $" big endian short (16 bits)" test-headers
- "nist-16.snd" 1 16000 1.02400004863739 $" NIST" $" big endian short (16 bits)" test-headers
- "nist-shortpack.wav" 1 16000 4.53824996948242 $" NIST" $" unknown" test-headers
- "none.aifc" 1 44100 0.0367800444364548 $" AIFC" $" big endian short (16 bits)" test-headers
- "nylon2.wav" 2 22050 1.14376413822174 $" RIFF" $" unknown" test-headers
- "o2.adf" 1 44100 0.036780 $" CSRE adf" $" little endian short (16 bits)" test-headers
- "o2.avr" 1 44100 0.0183900222182274 $" AVR" $" big endian short (16 bits)" test-headers
- "o2.bicsf" 1 44100 0.0367800444364548 $" IRCAM" $" big endian short (16 bits)" test-headers
- "o2.mpeg1" 2 44100 0.0070975 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "o2.sd2" 2 44100 0.0183900222 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "o2.sf2" 1 44100 0.036780044436 $" SoundFont" $" little endian short (16 bits)" test-headers
- "o2.smp" 1 8000 0.202749997377396 $" SMP" $" little endian short (16 bits)" test-headers
- "o2.voc" 1 44100 0.0368934236466885 $" VOC" $" little endian short (16 bits)" test-headers
- "o2.wave" 1 44100 0.0367800444364548 $" RIFF" $" little endian short (16 bits)" test-headers
- "o2_12bit.aiff" 1 44100 0.036780044436 $" AIFF" $" big endian short (16 bits)" test-headers
- "o2_18bit.aiff" 1 44100 0.0367800444364548 $" AIFF" $" big endian int (24 bits)" test-headers
- "o2_711u.wave" 1 44100 0.0367800444364548 $" RIFF" $" mulaw (8 bits)" test-headers
- "o2_722.snd" 1 44100 0.0183900222182274 $" Sun/Next" $" unknown" test-headers
- "o2_726.aiff" 1 8000 0.0367499999701977 $" AIFC" $" unknown" test-headers
- "o2_726.snd" 1 44100 0.0230158735066652 $" Sun/Next" $" unknown" test-headers
- "o2_728.aiff" 1 8000 0.0367499999701977 $" AIFC" $" unknown" test-headers
- "o2_8.iff" 1 44100 0.0367800444364548 $" SVX8" $" signed byte (8 bits)" test-headers
- "o2_8.voc" 1 44100 0.0370294786989689 $" VOC" $" unsigned byte (8 bits)" test-headers
- "o2_dvi.wave" 1 44100 0.0232199542224407 $" RIFF" $" unknown" test-headers
- "o2_float.bicsf" 1 44100 0.0367800444 $" IRCAM" $" big endian float (32 bits)" test-headers
- "o2_gsm.aiff" 1 8000 0.0367499999701977 $" AIFC" $" unknown" test-headers
- "o2_u8.avr" 1 44100 0.0367800444364548 $" AVR" $" unsigned byte (8 bits)" test-headers
- "o2_u8.wave" 1 44100 0.0367800444364548 $" RIFF" $" unsigned byte (8 bits)" test-headers
- "o28.mpc" 1 44100 0.036780 $" AKAI 4" $" little endian short (16 bits)" test-headers
- "oboe.g721" 1 22050 1.15287983417511 $" Sun/Next" $" unknown" test-headers
- "oboe.g723_24" 1 22050 0.864761888980865 $" Sun/Next" $" unknown" test-headers
- "oboe.g723_40" 1 22050 1.44126987457275 $" Sun/Next" $" unknown" test-headers
- "oboe.kts" 1 22050 2.305125 $" Korg" $" big endian short (16 bits)" test-headers
- "oboe.its" 1 22050 2.305125 $" Impulse Tracker" $" little endian short (16 bits)" test-headers
- "oboe.sf2" 1 22050 2.305124759674 $" SoundFont" $" little endian short (16 bits)" test-headers
- "oboe.paf" 1 22050 2.305125 $" Ensoniq Paris" $" big endian short (16 bits)" test-headers
- "oboe.pf1" 1 22050 2.305125 $" Ensoniq Paris" $" little endian short (16 bits)" test-headers
- "oboe.smp" 1 22050 2.305125 $" snack SMP" $" little endian short (16 bits)" test-headers
- "oboe.rf64" 1 22050 2.305125 $" rf64" $" little endian short (16 bits)" test-headers
- "oboe-be32.caf" 1 22050 2.305125 $" caff" $" normalized big endian int (32 bits)" test-headers
- "oboe-bf64.caf" 1 22050 2.305125 $" caff" $" big endian double (64 bits)" test-headers
- "oboe-lf32.caf" 1 22050 2.305125 $" caff" $" little endian float (32 bits)" test-headers
- "oboe-ulaw.caf" 1 22050 2.305125 $" caff" $" mulaw (8 bits)" test-headers
- "oboe.nsp" 1 22050 2.305125 $" CSL" $" little endian short (16 bits)" test-headers
- "oboe.nvf" 1 8000 6.353500 $" Creative NVF" $" unknown" test-headers
- "oboe-ulaw.voc" 1 22050 2.305669 $" VOC" $" mulaw (8 bits)" test-headers
- "oboe-lf32.sf" 1 22050 2.305669 $" IRCAM" $" little endian float (32 bits)" test-headers
- "oboe.wfp" 1 22050 2.305125 $" Turtle Beach" $" little endian short (16 bits)" test-headers
- "oboe.sox" 1 22050 2.305125 $" Sox" $" normalized little endian int (32 bits)" test-headers
- "oki.snd" 2 44100 0.004195011 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "oki.wav" 1 44100 0.016780 $" RIFF" $" unknown" test-headers
- "orv-dvi-adpcm.wav" 1 44100 1.92725622653961 $" RIFF" $" unknown" test-headers
- "riff-16.snd" 1 22050 1.88766443729401 $" RIFF" $" little endian short (16 bits)" test-headers
- "riff-8-u.snd" 1 11025 0.506848096847534 $" RIFF" $" unsigned byte (8 bits)" test-headers
- "rooster.wve" 1 8000 2.04800009727478 $" PSION" $" alaw (8 bits)" test-headers
- "sd1-16.snd" 1 44100 0.40054 $" Sound Designer 1" $" big endian short (16 bits)" test-headers
- "sf-16.snd" 1 22050 1.88766443729401 $" IRCAM" $" big endian short (16 bits)" test-headers
- "si654.adc" 1 16000 6.71362495422363 $" ADC/OGI" $" big endian short (16 bits)" test-headers
- "smp-16.snd" 1 8000 5.2028751373291 $" SMP" $" little endian short (16 bits)" test-headers
- "sound.pat" 1 8000 1.95050001144409 $" Gravis Ultrasound patch" $" unsigned little endian short (16 bits)" test-headers
- "sound.sap" 1 8000 1.95050001144409 $" Goldwave sample" $" little endian short (16 bits)" test-headers
- "sound.sds" 1 8000 1.95050001144409 $" MIDI sample dump" $" unknown" test-headers
- "sound.sfr" 1 8000 1.95050001144409 $" SRFS" $" little endian short (16 bits)" test-headers
- "sound.v8" 1 8000 1.95050001144409 $" Covox V8" $" unsigned byte (8 bits)" test-headers
- "sound.vox" 2 44100 0.0442177 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "step.omf" 1 11025 8.70666694641113 $" OMF" $" signed byte (8 bits)" test-headers
- "step.qt" 1 11025 8.70630359649658 $" Quicktime" $" unsigned byte (8 bits)" test-headers
- "sun-16-afsp.snd" 1 8000 2.9760000705719 $" Sun/Next" $" big endian short (16 bits)" test-headers
- "sun-mulaw.snd" 1 8000 4.61950016021729 $" Sun/Next" $" mulaw (8 bits)" test-headers
- "sw1038t_short.wav" 2 8000 6.0 $" NIST" $" mulaw (8 bits)" test-headers
- "swirl.pat" 1 22050 1.0619500875473 $" Gravis Ultrasound patch" $" unsigned little endian short (16 bits)" test-headers
- "sy85.snd" 1 8000 5.05600023269653 $" Sy-85" $" big endian short (16 bits)" test-headers
- "sy99.snd" 1 8000 4.54400014877319 $" Sy-99" $" big endian short (16 bits)" test-headers
- "telephone.wav" 1 16000 2.2788124084 $" NIST" $" little endian short (16 bits)" test-headers
- "trumps22.adp" 1 22050 3.092880 $" RIFF" $" unknown" test-headers
- "truspech.wav" 1 8000 1.1599999666214 $" RIFF" $" unknown" test-headers
- "ulaw.aifc" 1 44100 0.0367800444364548 $" AIFC" $" mulaw (8 bits)" test-headers
- "voc-8-u.snd" 1 8000 1.49937498569489 $" VOC" $" unsigned byte (8 bits)" test-headers
- "o28.voc" 1 44100 0.036893 $" VOC" $" little endian short (16 bits)" test-headers
- "voxware.wav" 1 8000 0.324000000953674 $" RIFF" $" unknown" test-headers
- "wd.w00" 1 8000 0.202749997377396 $" Sy-99" $" big endian short (16 bits)" test-headers
- "wd1.smp" 1 8000 0.202749997377396 $" SMP" $" little endian short (16 bits)" test-headers
- "wd1.wav" 1 44100 0.0367800444364548 $" RIFF" $" little endian short (16 bits)" test-headers
- "wheel.mat" 2 44100 0.14564626 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "b8.pvf" 1 44100 0.036803 $" Portable Voice Format" $" signed byte (8 bits)" test-headers
- "b16.pvf" 1 44100 0.0368 $" Portable Voice Format" $" big endian short (16 bits)" test-headers
- "b32.pvf" 1 44100 0.036803 $" Portable Voice Format" $" big endian int (32 bits)" test-headers
- "water.voc" 2 32000 42.3463897705078 $" VOC" $" little endian short (16 bits)" test-headers
- "wood.dsf" 1 8000 0.202749997377 $" Delusion" $" little endian short (16 bits)" test-headers
- "wood.dvi" 1 22100 0.0278733037412167 $" RIFF" $" unknown" test-headers
- "wood.dwd" 1 22100 0.0733936652541161 $" DiamondWare" $" signed byte (8 bits)" test-headers
- "wood.fsm" 1 8000 0.2029999942 $" Farandole" $" little endian short (16 bits)" test-headers
- "wood.mad" 1 22100 0.0372398197650909 $" RIFF" $" unknown" test-headers
- "wood.maud" 1 44100 0.0183900222182274 $" MAUD" $" big endian short (16 bits)" test-headers
- "wood.pat" 1 22100 0.0733936652541161 $" Gravis Ultrasound patch" $" little endian short (16 bits)" test-headers
- "wood.riff" 1 44100 0.0367800444364548 $" RIFF" $" little endian short (16 bits)" test-headers
- "wood.rifx" 1 44100 0.0367800444364548 $" RIFF" $" big endian short (16 bits)" test-headers
- "wood.sds" 1 22100 0.0733936652541161 $" MIDI sample dump" $" unknown" test-headers
- "wood.sdx" 1 22100 0.0733936652541161 $" Sample dump" $" unsigned little endian short (16 bits)" test-headers
- "wood.sf" 1 44100 0.0367800444364548 $" IRCAM" $" big endian short (16 bits)" test-headers
- "wood.sndr" 2 44100 0.009229 $" raw (no header)" $" big endian short (16 bits)" test-headers
- "wood.sndt" 1 44100 0.0367800444364548 $" SNDT" $" unsigned byte (8 bits)" test-headers
- "wood.st3" 1 8000 0.202749997377396 $" Digiplayer ST3" $" unsigned little endian short (16 bits)" test-headers
- "wood.uwf" 1 8000 0.202999994 $" Ultratracker" $" little endian short (16 bits)" test-headers
- "wood.w00" 1 16000 0.101374998688698 $" TX-16W" $" unknown" test-headers
- "wood12.aiff" 1 44100 0.0367800444364548 $" AIFF" $" big endian short (16 bits)" test-headers
- "wood16.dwd" 2 44100 0.03678004 $" DiamondWare" $" little endian short (16 bits)" test-headers
- "wood16.wav" 2 44100 0.03678004 $" RIFF" $" little endian short (16 bits)" test-headers
- "wood16.nsp" 2 44100 0.03678004 $" CSL" $" little endian short (16 bits)" test-headers
- "wood16.smp" 2 44100 0.03678004 $" snack SMP" $" little endian short (16 bits)" test-headers
- "wood24.aiff" 1 44100 0.0367800444364548 $" AIFF" $" big endian int (24 bits)" test-headers
- "woodblock.aiff" 1 44100 0.03678 $" AIFF" $" big endian short (16 bits)" test-headers
- "woodflt.snd" 1 44100 0.0367800444364548 $" Sun/Next" $" big endian float (32 bits)" test-headers
- "RealDrums.sf2" 1 44100 6.397256 $" SoundFont" $" little endian short (16 bits)" test-headers
- "32bit.sf" 1 44100 4.6 $" IRCAM" $" little endian float (32 bits, unscaled)" test-headers
- "PCM_48_8bit_m.w64" 1 48000 0.375 $" SoundForge" $" unsigned byte (8 bits)" test-headers
- "oboe.sf6" 1 22050 2.305125 $" SoundForge" $" little endian short (16 bits)" test-headers
- "addf8.24we" 1 8000 2.976000 $" RIFF" $" little endian int (24 bits)" test-headers
- "hybrid.snd" 1 44100 4.600000 $" BICSF" $" big endian float (32 bits)" test-headers
- "litmanna.sf" 1 44100 0.533 $" IRCAM" $" little endian short (16 bits)" test-headers
- "M1F1-float64C-AFsp.aif" 2 8000 2.9366 $" AIFC" $" big endian double (64 bits)" test-headers
- "MacBoing.wav" 1 11127 0.696 $" RIFF" $" unsigned byte (8 bits)" test-headers
- "t15.aiff" 2 44100 135.00 $" AIFC" $" little endian short (16 bits)" test-headers
- "tomf8.aud" 1 8000 2.016000 $" INRS" $" little endian short (16 bits)" test-headers
- "Xhs001x.nsp" 1 10000 6.017400 $" CSL" $" little endian short (16 bits)" test-headers
- "zulu_a4.w11" 1 33000 1.21987879276276 $" TX-16W" $" unknown" 23342 40042 test-headers-with-loop
+ "5_secs.aiff" 1 44100 5.303107 "AIFF" "big endian short (16 bits)"
+ test-headers
+ "8svx-8.snd" 1 22050 1.88766443729401 "SVX8" "signed byte (8 bits)"
+ test-headers
+ "Fnonull.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers
+ "Pmiscck.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers
+ "Pmiscck.wav" 1 8000 0.00112499995157123 "RIFF" "mulaw (8 bits)" test-headers
+ "Poffset.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers
+ "Porder.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers
+ "Ptjunk.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers
+ "Ptjunk.wav" 1 8000 0.00112499995157123 "RIFF" "mulaw (8 bits)" test-headers
+ "SINE24-S.WAV" 2 44100 2.0 "RIFF" "little endian int (24 bits)" test-headers
+ "a1.asf" 1 16000 3.736562 "asf" "unknown" test-headers
+ "a2.asf" 1 8000 4.630625 "asf" "unknown" test-headers
+ "addf8.afsp" 1 8000 2.9760000705719 "Sun/Next" "big endian short (16 bits)"
+ test-headers
+ "addf8.d" 1 8000 2.9760000705719 "SPPACK" "big endian short (16 bits)"
+ test-headers
+ "addf8.dwd" 1 8000 2.976000071 "DiamondWare" "little endian short (16 bits)"
+ test-headers
+ "addf8.nh" 2 44100 0.269931972 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "addf8.sd" 1 8000 2.9760000705719 "ESPS" "big endian short (16 bits)"
+ test-headers
+ "addf8.sf_mipseb" 1 8000 2.9760000705719 "IRCAM" "big endian short (16 bits)"
+ test-headers
+ "addf8.sf_sun" 1 8000 2.9760000705719 "IRCAM" "big endian short (16 bits)"
+ test-headers
+ "addf8.sf_vax_b" 1 8000 2.9760000705719 "IRCAM" "big endian short (16 bits)"
+ test-headers
+ "addf8.wav" 1 8000 2.9760000705719 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "aebass.krz" 1 44100 3.0 "Kurzweil 2000" "big endian short (16 bits)"
+ test-headers
+ "aiff-16.snd" 2 44100 0.746666669845581 "AIFF" "big endian short (16 bits)"
+ test-headers
+ "aiff-8.snd" 2 44100 0.746666669845581 "AIFF" "signed byte (8 bits)"
+ test-headers
+ "alaw.aifc" 1 44100 0.0367800444364548 "AIFC" "alaw (8 bits)"
+ test-headers
+ "alaw.wav" 1 11025 8.70666694641113 "RIFF" "alaw (8 bits)"
+ test-headers
+ "astor_basia.mp2" 2 44100 1.022 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "c.asf" 1 8000 21.368126 "asf" "unknown" test-headers
+ "ce-c3.w02" 1 33000 3.88848495483398 "TX-16W" "unknown" test-headers
+ "ce-c4.w03" 1 33000 2.91618180274963 "TX-16W" "unknown" test-headers
+ "ce-d2.w01" 1 33000 3.46439385414124 "TX-16W" "unknown" test-headers
+ "clbonef.wav" 1 22050 2.57832193374634 "RIFF" "little endian float (32 bits)"
+ test-headers
+ "cranker.krz" 1 44100 3.48267579 "Kurzweil 2000" "big endian short (16 bits)"
+ test-headers
+ "d40130.aif" 1 10000 0.100000001490116 "AIFF" "big endian short (16 bits)"
+ test-headers
+ "d40130.au" 1 10000 0.100000001490116 "Sun/Next" "big endian short (16 bits)"
+ test-headers
+ "d40130.dsf" 1 8000 0.125 "Delusion" "little endian short (16 bits)"
+ test-headers
+ "d40130.fsm" 1 8000 0.12524999678 "Farandole" "little endian short (16 bits)"
+ test-headers
+ "d40130.iff" 1 10000 0.100000001490116 "SVX8" "signed byte (8 bits)"
+ test-headers
+ "d40130.pat" 1 10000 0.100000001490116
+ "Gravis Ultrasound patch" "little endian short (16 bits)" test-headers
+ "d40130.sds" 1 10000 0.100000001490116 "MIDI sample dump" "unknown"
+ test-headers
+ "d40130.sdx" 1 10000 0.100000001490116
+ "Sample dump" "unsigned little endian short (16 bits)" test-headers
+ "d40130.sf" 1 10000 0.100000001490116
+ "IRCAM" "little endian short (16 bits)" test-headers
+ "d40130.smp" 1 8000 0.125 "SMP" "little endian short (16 bits)"
+ test-headers
+ "d40130.sou" 1 8000 0.125 "SBStudioII" "little endian short (16 bits)"
+ test-headers
+ "d40130.st3" 1 8000 0.125
+ "Digiplayer ST3" "unsigned little endian short (16 bits)" test-headers
+ "d40130.uwf" 1 8000 0.1252499
+ "Ultratracker" "little endian short (16 bits)" test-headers
+ "d40130.voc" 1 10000 0.100100003182888 "VOC" "unsigned byte (8 bits)"
+ test-headers
+ "d40130.w00" 1 16000 0.0625 "TX-16W" "unknown" test-headers
+ "d40130.wav" 1 10000 0.100000001490116 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "d43.wav" 1 10000 0.100000001490116 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "digit0v0.aiff" 1 8000 0.560000002384186 "AIFC" "big endian short (16 bits)"
+ test-headers
+ "esps-16.snd" 1 8000 3.09737491607666 "ESPS" "big endian short (16 bits)"
+ test-headers
+ "forest.aiff" 2 44100 3.907143
+ "AIFF" "big endian short (16 bits)" 24981 144332 test-headers-with-loop
+ "g721.au" 1 11025 4.35328817367554 "Sun/Next" "unknown" test-headers
+ "g722.aifc" 1 44100 0.0184353739023209 "AIFC" "unknown" test-headers
+ "gong.wve" 1 8000 3.96799993515015 "PSION" "alaw (8 bits)" test-headers
+ "gsm610.wav" 1 11025 1.7687075138092 "RIFF" "unknown" test-headers
+ "inrs-16.snd" 1 8000 2.46399998664856 "INRS" "little endian short (16 bits)"
+ test-headers
+ "kirk.wve" 1 8000 1.40799999237061 "PSION" "alaw (8 bits)" test-headers
+ "loop.aiff" 1 44100 0.0367120169103146
+ "AIFC" "big endian short (16 bits)" 12 23 test-headers-with-loop
+ "m.asf" 1 8000 64.964622 "asf" "unknown" test-headers
+ "mary-sun4.sig" 1 8000 4.47612476348877 "Comdisco SPW signal"
+ "big endian double (64 bits)" test-headers
+ "mocksong.wav" 1 11025 7.869569301605 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "mono24.wav" 1 22050 1.98997735977173 "RIFF" "little endian int (24 bits)"
+ test-headers
+ "msadpcm.wav" 1 11025 4.43501138687134 "RIFF" "unknown" test-headers
+ "n8.snd" 1 44100 0.0367800444364548 "Sun/Next" "signed byte (8 bits)"
+ test-headers
+ "nasahal.aif" 1 11025 9.89841270446777 "AIFF" "signed byte (8 bits)"
+ test-headers
+ "nasahal.avi" 1 11025 10.432744 "AVI" "little endian short (16 bits)"
+ test-headers
+ "nasahal.dig" 1 11025 9.8984 "Sound Designer 1" "big endian short (16 bits)"
+ test-headers
+ "nasahal.ivc" 2 44100 0.449 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "nasahal.pat" 1 11025 3.95410442352295 "Gravis Ultrasound patch"
+ "unsigned byte (8 bits)" test-headers
+ "nasahal.snd" 1 11025 9.89841270446777 "SNDT" "unsigned byte (8 bits)"
+ test-headers
+ "nasahal.svx" 1 11025 9.89841270446777 "SVX8" "signed byte (8 bits)"
+ test-headers
+ "nasahal.v8" 1 8000 13.6412496566772 "Covox V8" "unsigned byte (8 bits)"
+ test-headers
+ "nasahal.voc" 1 11025 9.89941024780273 "VOC" "unsigned byte (8 bits)"
+ test-headers
+ "nasahal.vox" 2 44100 0.22444 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "nasahal8.wav" 1 11025 9.89841270446777 "RIFF" "unsigned byte (8 bits)"
+ test-headers
+ "nasahalad.smp" 1 11025 4.94920635223389 "Goldwave sample"
+ "little endian short (16 bits)" test-headers
+ "next-16.snd" 1 22050 1.00004529953003 "Sun/Next"
+ "big endian short (16 bits)" test-headers
+ "next-8.snd" 1 22050 0.226757362484932 "Sun/Next"
+ "signed byte (8 bits)" test-headers
+ "next-dbl.snd" 1 22050 0.226757362484932 "Sun/Next"
+ "big endian double (64 bits)" test-headers
+ "oboe.ldbl" 1 22050 2.30512475967407 "RIFF"
+ "little endian double (64 bits)" test-headers
+ "next-flt.snd" 1 22050 0.226757362484932 "Sun/Next"
+ "big endian float (32 bits)" test-headers
+ "aifc-float.snd" 1 22050 0.2267573624849 "AIFC"
+ "big endian float (32 bits)" test-headers
+ "next-mulaw.snd" 1 8012 2.03295063972473 "Sun/Next"
+ "mulaw (8 bits)" test-headers
+ "next24.snd" 1 44100 0.0367800444364548 "Sun/Next"
+ "big endian int (24 bits)" test-headers
+ "nist-01.wav" 1 16000 2.26912498474121 "NIST"
+ "little endian short (16 bits)" test-headers
+ "nist-10.wav" 1 16000 2.26912498474121 "NIST"
+ "big endian short (16 bits)" test-headers
+ "nist-16.snd" 1 16000 1.02400004863739 "NIST"
+ "big endian short (16 bits)" test-headers
+ "nist-shortpack.wav" 1 16000 4.53824996948242 "NIST" "unknown"
+ test-headers
+ "none.aifc" 1 44100 0.0367800444364548 "AIFC" "big endian short (16 bits)"
+ test-headers
+ "nylon2.wav" 2 22050 1.14376413822174 "RIFF" "unknown" test-headers
+ "o2.adf" 1 44100 0.036780 "CSRE adf" "little endian short (16 bits)"
+ test-headers
+ "o2.avr" 1 44100 0.0183900222182274 "AVR" "big endian short (16 bits)"
+ test-headers
+ "o2.bicsf" 1 44100 0.0367800444364548 "IRCAM" "big endian short (16 bits)"
+ test-headers
+ "o2.mpeg1" 2 44100 0.0070975 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "o2.sd2" 2 44100 0.0183900222 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "o2.sf2" 1 44100 0.036780044436 "SoundFont" "little endian short (16 bits)"
+ test-headers
+ "o2.smp" 1 8000 0.202749997377396 "SMP" "little endian short (16 bits)"
+ test-headers
+ "o2.voc" 1 44100 0.0368934236466885 "VOC" "little endian short (16 bits)"
+ test-headers
+ "o2.wave" 1 44100 0.0367800444364548 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "o2_12bit.aiff" 1 44100 0.036780044436 "AIFF" "big endian short (16 bits)"
+ test-headers
+ "o2_18bit.aiff" 1 44100 0.0367800444364548 "AIFF" "big endian int (24 bits)"
+ test-headers
+ "o2_711u.wave" 1 44100 0.0367800444364548 "RIFF" "mulaw (8 bits)"
+ test-headers
+ "o2_722.snd" 1 44100 0.0183900222182274 "Sun/Next" "unknown" test-headers
+ "o2_726.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown" test-headers
+ "o2_726.snd" 1 44100 0.0230158735066652 "Sun/Next" "unknown" test-headers
+ "o2_728.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown" test-headers
+ "o2_8.iff" 1 44100 0.0367800444364548 "SVX8" "signed byte (8 bits)"
+ test-headers
+ "o2_8.voc" 1 44100 0.0370294786989689 "VOC" "unsigned byte (8 bits)"
+ test-headers
+ "o2_dvi.wave" 1 44100 0.0232199542224407 "RIFF" "unknown" test-headers
+ "o2_float.bicsf" 1 44100 0.0367800444 "IRCAM" "big endian float (32 bits)"
+ test-headers
+ "o2_gsm.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown" test-headers
+ "o2_u8.avr" 1 44100 0.0367800444364548 "AVR" "unsigned byte (8 bits)"
+ test-headers
+ "o2_u8.wave" 1 44100 0.0367800444364548 "RIFF" "unsigned byte (8 bits)"
+ test-headers
+ "o28.mpc" 1 44100 0.036780 "AKAI 4" "little endian short (16 bits)"
+ test-headers
+ "oboe.g721" 1 22050 1.15287983417511 "Sun/Next" "unknown" test-headers
+ "oboe.g723_24" 1 22050 0.864761888980865 "Sun/Next" "unknown" test-headers
+ "oboe.g723_40" 1 22050 1.44126987457275 "Sun/Next" "unknown" test-headers
+ "oboe.kts" 1 22050 2.305125 "Korg" "big endian short (16 bits)" test-headers
+ "oboe.its" 1 22050 2.305125 "Impulse Tracker" "little endian short (16 bits)"
+ test-headers
+ "oboe.sf2" 1 22050 2.305124759674 "SoundFont" "little endian short (16 bits)"
+ test-headers
+ "oboe.paf" 1 22050 2.305125 "Ensoniq Paris" "big endian short (16 bits)"
+ test-headers
+ "oboe.pf1" 1 22050 2.305125 "Ensoniq Paris" "little endian short (16 bits)"
+ test-headers
+ "oboe.smp" 1 22050 2.305125 "snack SMP" "little endian short (16 bits)"
+ test-headers
+ "oboe.rf64" 1 22050 2.305125 "rf64" "little endian short (16 bits)"
+ test-headers
+ "oboe-be32.caf" 1 22050 2.305125 "caff" "normalized big endian int (32 bits)"
+ test-headers
+ "oboe-bf64.caf" 1 22050 2.305125 "caff" "big endian double (64 bits)"
+ test-headers
+ "oboe-lf32.caf" 1 22050 2.305125 "caff" "little endian float (32 bits)"
+ test-headers
+ "oboe-ulaw.caf" 1 22050 2.305125 "caff" "mulaw (8 bits)" test-headers
+ "oboe.nsp" 1 22050 2.305125 "CSL" "little endian short (16 bits)"
+ test-headers
+ "oboe-ulaw.voc" 1 22050 2.305669 "VOC" "mulaw (8 bits)" test-headers
+ "oboe-lf32.sf" 1 22050 2.305669 "IRCAM" "little endian float (32 bits)"
+ test-headers
+ "oboe.wfp" 1 22050 2.305125 "Turtle Beach" "little endian short (16 bits)"
+ test-headers
+ "oboe.sox" 1 22050 2.305125 "Sox" "normalized little endian int (32 bits)"
+ test-headers
+ "oki.snd" 2 44100 0.004195011 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "oki.wav" 1 44100 0.016780 "RIFF" "unknown" test-headers
+ "orv-dvi-adpcm.wav" 1 44100 1.92725622653961 "RIFF" "unknown" test-headers
+ "riff-16.snd" 1 22050 1.88766443729401 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "riff-8-u.snd" 1 11025 0.506848096847534 "RIFF" "unsigned byte (8 bits)"
+ test-headers
+ "rooster.wve" 1 8000 2.04800009727478 "PSION" "alaw (8 bits)" test-headers
+ "sd1-16.snd" 1 44100 0.40054 "Sound Designer 1" "big endian short (16 bits)"
+ test-headers
+ "sf-16.snd" 1 22050 1.88766443729401 "IRCAM" "big endian short (16 bits)"
+ test-headers
+ "si654.adc" 1 16000 6.71362495422363 "ADC/OGI" "big endian short (16 bits)"
+ test-headers
+ "smp-16.snd" 1 8000 5.2028751373291 "SMP" "little endian short (16 bits)"
+ test-headers
+ "sound.pat" 1 8000 1.95050001144409 "Gravis Ultrasound patch"
+ "unsigned little endian short (16 bits)" test-headers
+ "sound.sap" 1 8000 1.95050001144409 "Goldwave sample"
+ "little endian short (16 bits)" test-headers
+ "sound.sds" 1 8000 1.95050001144409 "MIDI sample dump" "unknown" test-headers
+ "sound.sfr" 1 8000 1.95050001144409 "SRFS" "little endian short (16 bits)"
+ test-headers
+ "sound.v8" 1 8000 1.95050001144409 "Covox V8" "unsigned byte (8 bits)"
+ test-headers
+ "sound.vox" 2 44100 0.0442177 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "step.omf" 1 11025 8.70666694641113 "OMF" "signed byte (8 bits)" test-headers
+ "step.qt" 1 11025 8.70630359649658 "Quicktime" "unsigned byte (8 bits)"
+ test-headers
+ "sun-16-afsp.snd" 1 8000 2.9760000705719 "Sun/Next"
+ "big endian short (16 bits)" test-headers
+ "sun-mulaw.snd" 1 8000 4.61950016021729 "Sun/Next" "mulaw (8 bits)"
+ test-headers
+ "sw1038t_short.wav" 2 8000 6.0 "NIST" "mulaw (8 bits)" test-headers
+ "swirl.pat" 1 22050 1.0619500875473 "Gravis Ultrasound patch"
+ "unsigned little endian short (16 bits)" test-headers
+ "sy85.snd" 1 8000 5.05600023269653 "Sy-85" "big endian short (16 bits)"
+ test-headers
+ "sy99.snd" 1 8000 4.54400014877319 "Sy-99" "big endian short (16 bits)"
+ test-headers
+ "telephone.wav" 1 16000 2.2788124084 "NIST" "little endian short (16 bits)"
+ test-headers
+ "trumps22.adp" 1 22050 3.092880 "RIFF" "unknown" test-headers
+ "truspech.wav" 1 8000 1.1599999666214 "RIFF" "unknown" test-headers
+ "ulaw.aifc" 1 44100 0.0367800444364548 "AIFC" "mulaw (8 bits)" test-headers
+ "voc-8-u.snd" 1 8000 1.49937498569489 "VOC" "unsigned byte (8 bits)"
+ test-headers
+ "o28.voc" 1 44100 0.036893 "VOC" "little endian short (16 bits)" test-headers
+ "voxware.wav" 1 8000 0.324000000953674 "RIFF" "unknown" test-headers
+ "wd.w00" 1 8000 0.202749997377396 "Sy-99" "big endian short (16 bits)"
+ test-headers
+ "wd1.smp" 1 8000 0.202749997377396 "SMP" "little endian short (16 bits)"
+ test-headers
+ "wd1.wav" 1 44100 0.0367800444364548 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "wheel.mat" 2 44100 0.14564626 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "b8.pvf" 1 44100 0.036803 "Portable Voice Format" "signed byte (8 bits)"
+ test-headers
+ "b16.pvf" 1 44100 0.0368 "Portable Voice Format" "big endian short (16 bits)"
+ test-headers
+ "b32.pvf" 1 44100 0.036803 "Portable Voice Format" "big endian int (32 bits)"
+ test-headers
+ "water.voc" 2 32000 42.3463897705078 "VOC" "little endian short (16 bits)"
+ test-headers
+ "wood.dsf" 1 8000 0.202749997377 "Delusion" "little endian short (16 bits)"
+ test-headers
+ "wood.dvi" 1 22100 0.0278733037412167 "RIFF" "unknown" test-headers
+ "wood.dwd" 1 22100 0.0733936652541161 "DiamondWare" "signed byte (8 bits)"
+ test-headers
+ "wood.fsm" 1 8000 0.2029999942 "Farandole" "little endian short (16 bits)"
+ test-headers
+ "wood.mad" 1 22100 0.0372398197650909 "RIFF" "unknown" test-headers
+ "wood.maud" 1 44100 0.0183900222182274 "MAUD" "big endian short (16 bits)"
+ test-headers
+ "wood.pat" 1 22100 0.0733936652541161 "Gravis Ultrasound patch"
+ "little endian short (16 bits)" test-headers
+ "wood.riff" 1 44100 0.0367800444364548 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "wood.rifx" 1 44100 0.0367800444364548 "RIFF" "big endian short (16 bits)"
+ test-headers
+ "wood.sds" 1 22100 0.0733936652541161 "MIDI sample dump" "unknown"
+ test-headers
+ "wood.sdx" 1 22100 0.0733936652541161 "Sample dump"
+ "unsigned little endian short (16 bits)" test-headers
+ "wood.sf" 1 44100 0.0367800444364548 "IRCAM" "big endian short (16 bits)"
+ test-headers
+ "wood.sndr" 2 44100 0.009229 "raw (no header)" "big endian short (16 bits)"
+ test-headers
+ "wood.sndt" 1 44100 0.0367800444364548 "SNDT" "unsigned byte (8 bits)"
+ test-headers
+ "wood.st3" 1 8000 0.202749997377396 "Digiplayer ST3"
+ "unsigned little endian short (16 bits)" test-headers
+ "wood.uwf" 1 8000 0.202999994 "Ultratracker" "little endian short (16 bits)"
+ test-headers
+ "wood.w00" 1 16000 0.101374998688698 "TX-16W" "unknown" test-headers
+ "wood12.aiff" 1 44100 0.0367800444364548 "AIFF" "big endian short (16 bits)"
+ test-headers
+ "wood16.dwd" 2 44100 0.03678004 "DiamondWare" "little endian short (16 bits)"
+ test-headers
+ "wood16.wav" 2 44100 0.03678004 "RIFF" "little endian short (16 bits)"
+ test-headers
+ "wood16.nsp" 2 44100 0.03678004 "CSL" "little endian short (16 bits)"
+ test-headers
+ "wood16.smp" 2 44100 0.03678004 "snack SMP" "little endian short (16 bits)"
+ test-headers
+ "wood24.aiff" 1 44100 0.0367800444364548 "AIFF" "big endian int (24 bits)"
+ test-headers
+ "woodblock.aiff" 1 44100 0.03678 "AIFF" "big endian short (16 bits)"
+ test-headers
+ "woodflt.snd" 1 44100 0.0367800444364548 "Sun/Next"
+ "big endian float (32 bits)" test-headers
+ "RealDrums.sf2" 1 44100 6.397256 "SoundFont" "little endian short (16 bits)"
+ test-headers
+ "32bit.sf" 1 44100 4.6 "IRCAM" "little endian float (32 bits, unscaled)"
+ test-headers
+ "PCM_48_8bit_m.w64" 1 48000 0.375 "SoundForge" "unsigned byte (8 bits)"
+ test-headers
+ "oboe.sf6" 1 22050 2.305125 "SoundForge" "little endian short (16 bits)"
+ test-headers
+ "addf8.24we" 1 8000 2.976000 "RIFF" "little endian int (24 bits)"
+ test-headers
+ "hybrid.snd" 1 44100 4.600000 "BICSF" "big endian float (32 bits)"
+ test-headers
+ "litmanna.sf" 1 44100 0.533 "IRCAM" "little endian short (16 bits)"
+ test-headers
+ "M1F1-float64C-AFsp.aif" 2 8000 2.9366 "AIFC" "big endian double (64 bits)"
+ test-headers
+ "MacBoing.wav" 1 11127 0.696 "RIFF" "unsigned byte (8 bits)" test-headers
+ "t15.aiff" 2 44100 135.00 "AIFC" "little endian short (16 bits)" test-headers
+ "tomf8.aud" 1 8000 2.016000 "INRS" "little endian short (16 bits)"
+ test-headers
+ "Xhs001x.nsp" 1 10000 6.017400 "CSL" "little endian short (16 bits)"
+ test-headers
+ "zulu_a4.w11" 1 33000 1.21987879276276 "TX-16W" "unknown" 23342 40042
+ test-headers-with-loop
;
\ ---------------- test 03: variables ----------------
@@ -1503,11 +1796,9 @@ black-and-white-colormap constant *better-colormap*
test-dir set-temp-dir test-dir "set-temp-dir" #() snd-test-neq
old-val set-temp-dir drop
then
- 1000 sample 0.0328 $" sample 1000" #() snd-test-neq
+ 1000 sample 0.0328 "sample 1000" #() snd-test-neq
\
- #( output-name-hook
- output-comment-hook
- peak-env-hook
+ #( output-comment-hook
help-hook
mark-drag-hook
mix-drag-hook
@@ -1534,23 +1825,23 @@ black-and-white-colormap constant *better-colormap*
graph-hook ) each { h }
h hook? not
h empty? not || if
- $" %d: %s?" #( i h ) snd-display
+ "%d: %s?" #( i h ) snd-display
then
end-each
- \
+ \
*with-test-gui* if
show-controls { old-ctrl }
#t set-show-controls drop
enved-dialog { req }
- dialog-widgets 2 array-ref req "enved-dialog" #() snd-test-neq
+ dialog-widgets 1 array-ref req "enved-dialog" #() snd-test-neq
'( 0.0 0.0 1.0 1.0 2.0 0.0 ) to req
req set-enved-envelope drop
enved-envelope req "set-enved-envelope" #() snd-test-neq
enved-envelope set-enved-envelope drop
- enved-envelope req $" set-enved-envelope to self" #() snd-test-neq
+ enved-envelope req "set-enved-envelope to self" #() snd-test-neq
old-ctrl set-show-controls drop
then
- \
+ \
#( #( <'> color-cutoff 0.003 0.01 )
#( <'> color-inverted #t #f )
#( <'> color-scale 1.0 0.5 )
@@ -1577,13 +1868,12 @@ black-and-white-colormap constant *better-colormap*
#( <'> spectro-y-angle *with-test-gl* if 320.0 else 0.0 then 60.0 )
#( <'> spectro-y-scale 1.0 2.0 )
#( <'> spectro-z-angle *with-test-gl* if 0.0 else 358.0 then 60.0 )
- #( <'> spectro-z-scale *with-test-gl* if 1.0 else 0.1 then 0.2 ) ) { gui-lst }
+ #( <'> spectro-z-scale *with-test-gl* if 1.0 else 0.1 then 0.2 )
+ ) { gui-lst }
#( #( <'> amp-control 1.0 0.5 )
#( <'> amp-control-bounds '( 0.0 8.0 ) '( 1.0 5.0 ) )
#( <'> ask-about-unsaved-edits #f #t )
#( <'> ask-before-overwrite #f #t )
- #( <'> audio-input-device 0 1 )
- #( <'> audio-output-device 0 1 )
#( <'> auto-resize #t #f )
#( <'> auto-update #f #t )
#( <'> channel-style 0 1 )
@@ -1597,13 +1887,12 @@ black-and-white-colormap constant *better-colormap*
#( <'> with-tracking-cursor #f #t )
#( <'> cursor-size 15 30 )
#( <'> cursor-style cursor-cross cursor-line )
- #( <'> tracking-cursor-style cursor-cross cursor-line )
+ #( <'> tracking-cursor-style cursor-line cursor-cross )
#( <'> dac-combines-channels #t #f )
#( <'> dac-size 256 512 )
- #( <'> minibuffer-history-length 8 16 )
#( <'> clipping #f #t )
#( <'> default-output-chans 1 2 )
- #( <'> default-output-data-format 1 1 )
+ #( <'> default-output-sample-type 1 1 )
#( <'> default-output-srate 22050 44100 )
#( <'> default-output-header-type mus-next mus-aifc )
#( <'> dot-size 1 4 )
@@ -1646,10 +1935,8 @@ black-and-white-colormap constant *better-colormap*
#( <'> mix-tag-width 6 20 )
#( <'> mark-tag-height 4 20 )
#( <'> mark-tag-width 10 20 )
- #( <'> mus-prescaler 1.0 100.0 )
#( <'> mus-clipping #f #t )
#( <'> selection-creates-region #t #f )
- #( <'> view-files-sort 0 1 )
#( <'> play-arrow-size 10 16 )
#( <'> print-length 12 16 )
#( <'> region-graph-style graph-lines graph-lollipops )
@@ -1662,6 +1949,7 @@ black-and-white-colormap constant *better-colormap*
#( <'> reverb-control-scale-bounds '( 0.0 4.0 ) '( 0.0 0.2 ) )
#( <'> show-axes 1 0 )
#( <'> show-full-duration #f #t )
+ #( <'> show-full-range #f #t )
#( <'> show-indices #f #t )
#( <'> show-marks #t #f )
#( <'> show-mix-waveforms #t #f )
@@ -1711,7 +1999,8 @@ black-and-white-colormap constant *better-colormap*
#( *with-test-gui* if
#( <'> amp-control 1.0 '( -1.0 123.123 ) )
then
- #( <'> amp-control-bounds '( 0.0 8.0 ) '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) )
+ #( <'> amp-control-bounds '( 0.0 8.0 )
+ '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) )
#( <'> channel-style 0 '( 32 -1 1.0 ) )
#( <'> colormap *good-colormap* '( 321 -123 ) )
#( <'> color-cutoff 0.003 '( -1.0 123.123 ) )
@@ -1719,13 +2008,15 @@ black-and-white-colormap constant *better-colormap*
*with-test-gui* if
#( <'> contrast-control 0.0 '( -123.123 123.123 ) )
then
- #( <'> contrast-control-bounds '( 0.0 10.0 ) '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) )
+ #( <'> contrast-control-bounds '( 0.0 10.0 )
+ '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) )
#( <'> cursor-size 15 '( 1.123 -2.5 ) )
#( <'> dac-size 256 '( -1 0 -123 ) )
#( <'> dot-size 1 '( 0 -1 -123 ) )
#( <'> enved-target 0 '( 123 -321 ) )
#( <'> expand-control 1.0 '( -1.0 0.0 ) )
- #( <'> expand-control-bounds '( 0.001 20.0 ) '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) )
+ #( <'> expand-control-bounds '( 0.001 20.0 )
+ '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) )
#( <'> expand-control-hop 0.05 '( -1.0 ) )
#( <'> expand-control-length 0.15 '( -1.0 0.0 ) )
#( <'> expand-control-ramp 0.4 '( -1.0 1.0 123.123 ) )
@@ -1735,7 +2026,7 @@ black-and-white-colormap constant *better-colormap*
#( <'> zero-pad 0 '( -1 -123 ) )
#( <'> cursor-style cursor-cross '( -1 ) )
#( <'> cursor-style cursor-line '( 2 123 ) )
- #( <'> tracking-cursor-style cursor-cross '( -1 ) )
+ #( <'> tracking-cursor-style cursor-line '( -1 ) )
#( <'> tracking-cursor-style cursor-line '( 2 123 ) )
#( <'> transform-graph-type graph-once '( -1 123 ) )
#( <'> fft-window 6 '( -1 123 ) )
@@ -1743,7 +2034,6 @@ black-and-white-colormap constant *better-colormap*
#( <'> filter-control-order 20 '( -10 -1 0 ) )
#( <'> max-transform-peaks 100 '( -1 ) )
#( <'> max-regions 16 '( -1 -123 ) )
- #( <'> view-files-sort 0 '( -1 123 ) )
#( <'> reverb-control-length 1.0 '( -1.0 ) )
#( <'> show-axes 1 '( -1 123 ) )
#( <'> sinc-width 10 '( -10 ) )
@@ -1751,10 +2041,12 @@ black-and-white-colormap constant *better-colormap*
#( <'> spectro-hop 4 '( -10 -1 0 ) )
#( <'> spectrum-start 0.0 '( -1.0 ) )
#( <'> speed-control 1.0 '( 0.0 ) )
- #( <'> speed-control-bounds '( 0.05 20.0 ) '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) )
+ #( <'> speed-control-bounds '( 0.05 20.0 )
+ '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) )
#( <'> speed-control-style 0 '( -1 10 ) )
#( <'> sync-style sync-by-sound '( -1 123 ) )
- #( <'> transform-type fourier-transform '( -1 integer->transform 123 integer->transform ) )
+ #( <'> transform-type fourier-transform
+ '( -1 integer->transform 123 integer->transform ) )
#( <'> wavelet-type 0 '( -1 123 ) )
#( <'> wavo-hop 1 '( 0 -123 ) )
#( <'> wavo-trace 1 '( 0 -123 ) )
@@ -1766,13 +2058,13 @@ black-and-white-colormap constant *better-colormap*
vals 1 array-ref to initval
vals 2 array-ref to newvals
newvals each to newval
- newval sym <'> set-execute #t nil fth-catch stack-reset
+ newval sym <'> set-execute snd-test-catch drop
sym execute to nowval
- nowval newval $" set-%s (bad set)" #( sym ) snd-test-eq
+ nowval newval "set-%s (bad set)" #( sym ) snd-test-eq
initval sym set-execute drop
end-each
end-each
- \
+ \
*with-test-gui* if
sync-none set-sync-style drop
300 set-window-width drop
@@ -1784,291 +2076,335 @@ black-and-white-colormap constant *better-colormap*
color-scale 100.0 "color-scale" #() snd-test-neq
old-val set-color-scale drop
then
- \
+ \
search-procedure proc? if
- $" global search procedure: %s?" #( search-procedure ) snd-display
+ "global search procedure: %s?" #( search-procedure ) snd-display
then
<'> y>0.1-cb set-search-procedure drop
search-procedure proc? unless
- $" set global search procedure: %s?" #( search-procedure ) snd-display
+ "set global search procedure: %s?" #( search-procedure ) snd-display
then
search-procedure #( 0.2 ) run-proc unless
- $" search 0.1 > 0.2?" #() snd-display
+ "search 0.1 > 0.2?" #() snd-display
then
search-procedure #( 0.02 ) run-proc if
- $" search 0.1 > 0.02?" #() snd-display
+ "search 0.1 > 0.02?" #() snd-display
then
<'> y<0.0-cb set-search-procedure drop
search-procedure #( 0.02 ) run-proc if
- $" search 0.0 < 0.02?" #() snd-display
+ "search 0.0 < 0.02?" #() snd-display
then
#f set-search-procedure drop
search-procedure proc? if
- $" global search procedure after reset: %s?" #( search-procedure ) snd-display
+ "global search procedure after reset: %s?" #( search-procedure )
+ snd-display
then
<'> y>0.1-cb set-search-procedure drop
search-procedure proc? unless
- $" set global search procedure: %s?" #( search-procedure ) snd-display
+ "set global search procedure: %s?" #( search-procedure ) snd-display
then
#f set-search-procedure drop
- \
+ \
*with-test-gui* if
enved-filter-order { old-val }
5 set-enved-filter-order drop
- enved-filter-order 6 $" set-enved-filter-order 5" #() snd-test-neq
+ enved-filter-order 6 "set-enved-filter-order 5" #() snd-test-neq
old-val set-enved-filter-order drop
- \ FIXME
- \ This works with global variables. [ms]
- 'zero-to-one <'> set-enved-envelope #t nil fth-catch stack-reset
- enved-envelope zero-to-one $" set-enved-envelope (symbol)" #() snd-test-neq
- "mod-down" <'> set-enved-envelope #t nil fth-catch stack-reset
- enved-envelope mod-down $" set-enved-envelope (string)" #() snd-test-neq
+ \ XXX: This works with global variables. [ms]
+ 'zero-to-one <'> set-enved-envelope snd-test-catch drop
+ enved-envelope zero-to-one "set-enved-envelope (symbol)" #() snd-test-neq
+ "mod-down" <'> set-enved-envelope snd-test-catch drop
+ enved-envelope mod-down "set-enved-envelope (string)" #() snd-test-neq
then
ind close-sound drop
dismiss-all-dialogs
#() { undefined }
- \ FIXME
- \ changes from original snd-test.scm list [ms]:
- \
+ \ XXX: changes from original snd-test.scm list [ms]:
+ \
\ removed (Scheme specific):
\ 'add-clm-field (run.c)
\ 'run (macro in run.c)
\ 'file->string (snd-utils.c)
- \
+ \
+ \ removed (Forth specific):
+ \ 'abort (forth word)
+ \
\ added:
\ 'snd-exit (xen.c; in Forth exit is already in use)
- \
- \ FIXME
- \ Splitted in two arrays because we have a 1024 stack limit. [ms]
- #( '*snd-opened-sound* 'abort 'add-colormap 'add-directory-to-view-files-list 'add-file-filter
- 'add-file-sorter 'add-file-to-view-files-list 'add-mark 'add-player 'add-sound-file-extension
- 'add-source-file-extension 'add-to-main-menu 'add-to-menu 'add-transform
- 'after-apply-controls-hook 'after-edit-hook 'after-graph-hook 'after-lisp-graph-hook
- 'after-open-hook 'after-save-as-hook 'after-save-state-hook 'after-transform-hook 'all-pass
- 'all-pass? 'amp-control 'amp-control-bounds 'amplitude-modulate 'analyse-ladspa
- 'apply-controls 'apply-ladspa 'array->file 'array-interp 'as-one-edit 'ask-about-unsaved-edits
- 'ask-before-overwrite 'asymmetric-fm 'asymmetric-fm? 'audio-input-device 'audio-output-device
- 'auto-resize 'auto-update 'auto-update-interval 'autocorrelate 'autocorrelation
- 'moving-average 'moving-average? 'axis-color 'axis-info 'axis-label-font 'axis-numbers-font
- 'bad-header-hook 'bartlett-window 'bartlett-hann-window 'basic-color 'beats-per-measure
- 'beats-per-minute 'before-close-hook 'before-exit-hook
- 'before-save-as-hook 'before-save-state-hook 'before-transform-hook 'bind-key
- 'blackman2-window 'blackman3-window 'blackman4-window 'blackman5-window 'blackman6-window
- 'blackman7-window 'blackman8-window 'blackman9-window 'blackman10-window 'bohman-window
- 'bold-peaks-font 'bomb 'cauchy-window 'mlt-sine-window 'cepstrum
- 'change-samples-with-origin 'channel->vct 'channel-amp-envs 'channel-data
- 'channel-properties 'channel-property 'channel-style 'channel-widgets 'channels
- 'channels-combined 'channels-separate 'channels-superimposed 'chans 'clear-array
- 'clear-listener 'clear-minibuffer 'clear-sincs 'clip-hook 'clipping 'clm-channel
- 'clm-print 'clm-table-size 'clm-default-frequency 'close-hook 'close-sound 'color->list
- 'color-cutoff 'color-orientation-dialog 'color-hook 'color-inverted 'color-scale 'color?
- 'colormap 'colormap-name 'colormap-ref 'colormap-size 'colormap? 'comb 'comb? 'comment
- 'connes-window 'continue-frame->file 'continue-sample->file 'contrast-control
- 'contrast-control-amp 'contrast-control-bounds
- 'contrast-control? 'contrast-enhancement 'controls->channel 'convolution 'convolve
- 'convolve-files 'convolve-selection-with 'convolve-with 'convolve? 'copy-context
- 'copy-sampler 'count-matches 'current-edit-position
- 'current-font 'cursor 'cursor-color 'cursor-context 'cursor-cross
- 'cursor-in-middle 'cursor-in-view 'cursor-line 'cursor-location-offset 'cursor-on-left
- 'cursor-on-right 'cursor-position 'cursor-size 'cursor-style 'cursor-update-interval
- 'dac-combines-channels 'dac-hook 'dac-size 'data-color 'data-format
- 'data-location 'data-size 'db->linear 'default-output-chans 'default-output-data-format
- 'default-output-header-type 'default-output-srate 'define-envelope 'degrees->radians 'delay
- 'delay-tick 'delay? 'delete-colormap 'delete-file-filter 'delete-file-sorter
- 'delete-mark 'delete-marks 'delete-sample 'delete-samples 'delete-samples-and-smooth
- 'delete-selection 'delete-selection-and-smooth 'delete-transform 'dialog-widgets 'disk-kspace
- 'display-edits 'dolph-chebyshev-window 'dont-normalize
- 'dot-product 'dot-size 'draw-axes 'draw-dot 'draw-dots
- 'draw-line 'draw-lines 'draw-mark-hook 'draw-mix-hook 'draw-string 'drop-hook
- 'during-open-hook 'edit-fragment 'edit-header-dialog 'edit-hook 'edit-list->function
- 'edit-position 'edit-tree 'edits 'edot-product 'env
- 'env-channel 'env-channel-with-base 'env-interp 'env-selection 'env-sound
- 'env? 'enved-add-point 'enved-amplitude 'enved-base 'enved-clip?
- 'enved-delete-point 'enved-dialog 'enved-envelope 'enved-filter 'enved-filter-order
- 'enved-hook 'enved-in-dB 'enved-move-point 'enved-power 'enved-spectrum
- 'enved-srate 'enved-style 'enved-target 'enved-wave? 'enved-waveform-color
- 'envelope-exponential 'envelope-linear 'eps-bottom-margin 'eps-file
- 'eps-left-margin 'eps-size 'exit 'exit-hook 'expand-control 'expand-control-bounds
- 'expand-control-hop 'expand-control-jitter 'expand-control-length
- 'expand-control-ramp 'expand-control? 'exponential-window 'fft 'fft-log-frequency
- 'fft-log-magnitude 'fft-window 'fft-window-alpha 'fft-window-beta 'fft-with-phases 'file->array
- 'file->frame 'file->frame? 'file->sample 'file->sample?
- 'file-name 'file-write-date 'fill-polygon 'fill-rectangle 'filter 'filtered-comb
- 'filtered-comb? 'filter-channel 'filter-control-coeffs 'filter-control-envelope
- 'filter-control-in-dB 'filter-control-in-hz 'filter-control-order
- 'filter-control-waveform-color 'filter-control? 'filter-selection 'filter-sound 'filter?
- 'find-channel 'find-dialog 'find-mark 'find-sound 'finish-progress-report 'fir-filter
- 'fir-filter? 'flat-top-window 'focus-widget 'foreground-color
- 'forget-region 'formant 'formant-bank 'formant? 'firmant 'firmant?
- 'fourier-transform
- 'frame 'frame* 'frame+ 'frame->file 'frame->file?
- 'frame->frame 'frame->list 'frame->sample 'frame-ref 'frame-set!
- 'frame? 'frames 'free-player
- 'free-sampler 'gaussian-window 'gc-off 'gc-on
+ #( '*snd-opened-sound* 'add-colormap 'add-mark
+ 'add-player 'add-sound-file-extension 'add-source-file-extension
+ 'add-to-main-menu 'add-to-menu 'add-transform 'after-apply-controls-hook
+ 'after-edit-hook 'after-graph-hook 'after-lisp-graph-hook 'after-open-hook
+ 'after-save-as-hook 'after-save-state-hook 'after-transform-hook
+ 'all-pass 'all-pass? 'amp-control 'amp-control-bounds 'amplitude-modulate
+ 'analyse-ladspa 'apply-controls 'apply-ladspa 'array->file 'array-interp
+ 'as-one-edit 'ask-about-unsaved-edits 'ask-before-overwrite
+ 'asymmetric-fm 'asymmetric-fm?
+ 'auto-resize 'auto-update 'auto-update-interval 'autocorrelate
+ 'autocorrelation 'axis-color
+ 'axis-info 'axis-label-font 'axis-numbers-font 'bad-header-hook
+ 'bartlett-window 'bartlett-hann-window 'basic-color 'beats-per-measure
+ 'beats-per-minute 'before-close-hook 'before-exit-hook
+ 'before-save-as-hook 'before-save-state-hook 'before-transform-hook
+ 'bind-key 'blackman2-window 'blackman3-window 'blackman4-window
+ 'blackman5-window 'blackman6-window 'blackman7-window 'blackman8-window
+ 'blackman9-window 'blackman10-window 'bohman-window 'bold-peaks-font
+ 'cauchy-window 'mlt-sine-window 'cepstrum 'change-samples-with-origin
+ 'channel->vct 'channel-amp-envs 'channel-data 'channel-properties
+ 'channel-property 'channel-style 'channel-widgets 'channels
+ 'channels-combined 'channels-separate 'channels-superimposed
+ 'chans 'clear-listener 'clip-hook
+ 'clipping 'clm-channel 'clm-table-size
+ 'clm-default-frequency 'close-hook 'close-sound 'color->list
+ 'color-cutoff 'color-orientation-dialog 'color-hook 'color-inverted
+ 'color-scale 'color? 'colormap 'colormap-name 'colormap-ref
+ 'colormap-size 'colormap? 'comb 'comb? 'combined-data-color
+ 'comment 'connes-window 'continue-frample->file 'continue-sample->file
+ 'contrast-control 'contrast-control-amp 'contrast-control-bounds
+ 'contrast-control? 'contrast-enhancement 'controls->channel
+ 'convolution 'convolve 'convolve-files 'convolve-selection-with
+ 'convolve-with 'convolve? 'copy-context 'copy-sampler
+ 'current-edit-position 'current-font 'cursor 'cursor-color
+ 'cursor-context 'cursor-cross 'cursor-in-middle 'cursor-in-view
+ 'cursor-line 'cursor-location-offset 'cursor-on-left 'cursor-on-right
+ 'cursor-position 'cursor-size 'cursor-style 'cursor-update-interval
+ 'dac-combines-channels 'dac-size 'data-color 'sample-type
+ 'data-location 'data-size 'db->linear 'default-output-chans
+ 'default-output-sample-type 'default-output-header-type
+ 'default-output-srate 'define-envelope 'degrees->radians 'delay
+ 'delay-tick 'delay? 'delete-colormap
+ 'delete-mark 'delete-marks 'delete-sample
+ 'delete-samples 'delete-samples-and-smooth 'delete-selection
+ 'delete-selection-and-smooth 'delete-transform 'dialog-widgets
+ 'disk-kspace 'display-edits 'dolph-chebyshev-window 'dont-normalize
+ 'dot-product 'dot-size 'draw-axes 'draw-dot 'draw-dots 'draw-line
+ 'draw-lines 'draw-mark-hook 'draw-mix-hook 'draw-string 'drop-hook
+ 'during-open-hook 'edit-fragment 'edit-header-dialog 'edit-hook
+ 'edit-list->function 'edit-position 'edit-tree 'edits 'edot-product
+ 'env 'env-channel 'env-channel-with-base 'env-interp 'env-selection
+ 'env-sound 'env? 'enved-add-point 'enved-amplitude 'enved-base
+ 'enved-clip? 'enved-delete-point 'enved-dialog 'enved-envelope
+ 'enved-filter 'enved-filter-order 'enved-hook 'enved-in-dB
+ 'enved-move-point 'enved-power 'enved-spectrum 'enved-srate
+ 'enved-style 'enved-target 'enved-wave? 'enved-waveform-color
+ 'envelope-exponential 'envelope-linear 'eps-bottom-margin 'eps-file
+ 'eps-left-margin 'eps-size 'exit 'exit-hook 'expand-control
+ 'expand-control-bounds 'expand-control-hop 'expand-control-jitter
+ 'expand-control-length 'expand-control-ramp 'expand-control?
+ 'exponential-window 'fft 'fft-log-frequency 'fft-log-magnitude
+ 'fft-window 'fft-window-alpha 'fft-window-beta 'fft-with-phases
+ 'file->array 'file->frample 'file->frample? 'file->sample 'file->sample?
+ 'file-name 'file-write-date 'fill-polygon 'fill-rectangle 'filter
+ 'filtered-comb 'filtered-comb? 'filter-channel 'filter-control-coeffs
+ 'filter-control-envelope 'filter-control-in-dB 'filter-control-in-hz
+ 'filter-control-order 'filter-control-waveform-color 'filter-control?
+ 'filter-selection 'filter-sound 'filter? 'find-dialog
+ 'find-mark 'find-sound 'finish-progress-report 'fir-filter 'fir-filter?
+ 'flat-top-window 'focus-widget 'foreground-color 'forget-region
+ 'formant 'formant-bank 'formant-bank? 'formant? 'firmant 'firmant?
+ 'comb-bank 'comb-bank? 'all-pass-bank 'all-pass-bank? 'filtered-comb-bank
+ 'filtered-comb-bank? 'make-comb-bank 'make-all-pass-bank
+ 'make-filtered-comb-bank 'fourier-transform
+ 'frample->file 'frample->file? 'frample->frample 'framples
+ 'free-player 'free-sampler 'gaussian-window 'gc-off 'gc-on
'gl-graph->ps 'glSpectrogram 'goto-listener-end 'granulate 'granulate?
- 'graph 'graph->ps 'graph-as-sonogram 'graph-as-spectrogram 'graph-as-wavogram
- 'graph-color 'graph-cursor 'graph-data 'graph-dots 'graph-dots-and-lines
- 'graph-filled 'graph-hook 'graph-lines 'graph-lollipops 'graph-once
- 'graph-style 'graphs-horizontal 'grid-density 'haar-transform 'hamming-window
- 'hann-poisson-window 'hann-window 'header-type 'help-dialog
- 'help-hook 'hide-widget 'highlight-color 'html-dir 'html-program
- 'hz->radians 'iir-filter 'iir-filter? 'in 'in-any
- 'ina 'inb 'info-dialog 'init-ladspa 'initial-graph-hook
- 'insert-file-dialog 'insert-region 'insert-sample 'insert-samples 'insert-samples-with-origin
- 'insert-selection 'insert-silence 'insert-sound 'just-sounds 'kaiser-window
- 'key 'key-binding 'key-press-hook 'keyboard-no-action 'ladspa-activate 'ladspa-cleanup
- 'ladspa-connect-port 'ladspa-deactivate 'ladspa-descriptor 'ladspa-dir 'peak-env-dir
- 'ladspa-instantiate 'ladspa-run 'ladspa-run-adding 'ladspa-set-run-adding-gain 'left-sample
+ 'graph 'graph->ps 'graph-as-sonogram 'graph-as-spectrogram
+ 'graph-as-wavogram 'graph-color 'graph-cursor 'graph-data 'graph-dots
+ 'graph-dots-and-lines 'graph-filled 'graph-hook 'graph-lines
+ 'graph-lollipops 'graph-once 'graph-style 'graphs-horizontal
+ 'grid-density 'haar-transform 'hamming-window 'hann-poisson-window
+ 'hann-window 'header-type 'help-dialog 'help-hook 'hide-widget
+ 'highlight-color 'html-dir 'html-program 'hz->radians 'iir-filter
+ 'iir-filter? 'in 'in-any 'ina 'inb 'info-dialog
+ 'init-ladspa 'initial-graph-hook 'insert-file-dialog 'insert-region
+ 'insert-sample 'insert-samples 'insert-samples-with-origin
+ 'insert-selection 'insert-silence 'insert-sound 'just-sounds
+ 'kaiser-window 'key 'key-binding 'key-press-hook 'keyboard-no-action
+ 'ladspa-activate 'ladspa-cleanup 'ladspa-connect-port 'ladspa-deactivate
+ 'ladspa-descriptor 'ladspa-dir 'peak-env-dir 'ladspa-instantiate
+ 'ladspa-run 'ladspa-run-adding 'ladspa-set-run-adding-gain 'left-sample
'linear->db 'lisp-graph 'lisp-graph-hook 'lisp-graph-style 'lisp-graph?
- 'list->vct 'list-ladspa 'listener-click-hook 'listener-color 'listener-font
- 'listener-prompt 'listener-selection 'listener-text-color 'little-endian? 'locsig
- 'locsig-ref 'locsig-reverb-ref 'locsig-reverb-set! 'locsig-set! 'locsig-type
+ 'list->vct 'list-ladspa 'listener-click-hook 'listener-color
+ 'listener-font 'listener-prompt 'listener-selection
+ 'listener-text-color 'little-endian? 'locsig 'locsig-ref
+ 'locsig-reverb-ref 'locsig-reverb-set! 'locsig-set! 'locsig-type
'locsig? 'log-freq-start 'main-menu 'main-widgets 'make-all-pass
- 'make-asymmetric-fm 'make-moving-average 'make-bezier 'make-color 'make-comb 'make-filtered-comb
- 'make-convolve 'make-delay 'make-env 'make-fft-window 'make-file->frame
- 'make-file->sample 'make-filter 'make-fir-coeffs 'make-fir-filter 'make-formant 'make-firmant
- 'make-frame 'make-frame->file 'make-granulate 'make-graph-data 'make-iir-filter
- 'make-locsig 'make-mix-sampler 'make-mixer 'make-move-sound 'make-notch 'make-one-pole
- 'make-one-zero 'make-oscil 'make-phase-vocoder 'make-player 'make-polyshape 'make-polywave
- 'make-pulse-train 'make-rand 'make-rand-interp 'make-readin 'make-region 'make-region-sampler
- 'make-sample->file 'make-sampler 'make-sawtooth-wave 'make-scalar-mixer 'make-nrxysin
- 'make-nrxycos 'make-snd->sample 'make-sound-data 'make-square-wave 'make-src 'make-ssb-am
- 'make-ncos 'make-nsin 'make-table-lookup 'make-triangle-wave 'make-two-pole 'make-two-zero
- 'make-variable-graph 'make-vct 'make-wave-train 'map-chan 'map-channel 'mark-click-hook
- 'mark-color 'mark-context 'mark-drag-hook 'mark-home 'mark-hook
- 'mark-name 'mark-properties 'mark-property 'mark-sample 'mark-sync 'mark-sync-max
- 'mark-tag-height 'mark-tag-width 'mark? 'marks 'max-regions 'max-transform-peaks
- 'max-virtual-ptrees 'maxamp 'maxamp-position 'menu-widgets 'min-dB 'minibuffer-history-length
- 'mix 'mix-amp 'mix-amp-env 'mix-click-hook 'mix-color 'mix-dialog-mix 'mix-drag-hook
- 'mix-file-dialog 'mix-length 'mix-home 'mix-name 'mix-position 'mix-properties 'mix-property
- 'mix-region 'mix-release-hook 'mix-sync 'mix-sync-max 'mix-sampler? 'mix-selection
- 'mix-speed 'mix-tag-height 'mix-tag-width 'mix-tag-y 'mix-vct 'mix-waveform-height
- 'mix? 'mixer 'mixer* 'mixer+ 'mixer-ref 'mixer-set! 'mixer? 'mixes 'mouse-click-hook
- 'mouse-drag-hook 'mouse-enter-graph-hook 'mouse-enter-label-hook 'mouse-enter-listener-hook
- 'mouse-enter-text-hook 'mouse-leave-graph-hook 'mouse-leave-label-hook
- 'mouse-leave-listener-hook 'mouse-leave-text-hook 'mouse-press-hook 'move-locsig
- 'move-sound 'move-sound? 'multiply-arrays 'mus-aifc 'mus-aiff 'mus-alaw
- 'mus-alsa-buffer-size 'mus-alsa-buffers 'mus-alsa-capture-device 'mus-alsa-device
- 'mus-alsa-playback-device 'mus-alsa-squelch-warning 'mus-apply 'mus-array-print-length
- 'mus-float-equal-fudge-factor 'mus-b24int 'mus-bdouble 'mus-bdouble-unscaled 'mus-bfloat
- 'mus-bfloat-unscaled 'mus-bicsf 'mus-bint 'mus-bintn
- 'mus-bshort 'mus-byte 'mus-bytes-per-sample 'mus-caff 'mus-channel 'mus-channels
- 'mus-chebyshev-first-kind 'mus-chebyshev-second-kind 'mus-clipping 'mus-close
- 'mus-data 'mus-data-format->string 'mus-data-format-name 'mus-describe 'mus-error-hook
- 'mus-error-type->string 'mus-expand-filename 'mus-feedback 'mus-feedforward 'mus-fft
- 'mus-file-buffer-size 'mus-file-clipping 'mus-file-name 'mus-file-prescaler 'mus-frequency
- 'mus-generator? 'mus-header-raw-defaults 'mus-header-type->string 'mus-header-type-name
- 'mus-hop 'mus-increment 'mus-input? 'mus-interp-all-pass 'mus-interp-bezier
- 'mus-interp-hermite 'mus-interp-lagrange 'mus-interp-linear 'mus-interp-none
- 'mus-interp-sinusoidal 'mus-interp-type 'mus-interpolate 'mus-ircam 'mus-l24int
- 'mus-ldouble 'mus-ldouble-unscaled 'mus-length 'mus-lfloat 'mus-lfloat-unscaled
- 'mus-lint 'mus-lintn 'mus-location 'mus-lshort 'mus-max-malloc 'mus-max-table-size
- 'mus-mix 'mus-mulaw 'mus-name 'mus-next 'mus-nist 'mus-offset 'mus-order
- 'mus-oss-set-buffers 'mus-out-format 'mus-output? 'mus-phase 'mus-prescaler
- 'mus-ramp 'mus-rand-seed 'mus-random 'mus-raw 'mus-reset 'mus-riff 'mus-run
- 'mus-scaler 'mus-set-formant-radius-and-frequency 'mus-sound-chans 'mus-sound-close-input
- 'mus-sound-close-output 'mus-sound-comment 'mus-sound-data-format 'mus-sound-data-location
- 'mus-sound-datum-size 'mus-sound-duration 'mus-sound-forget 'mus-sound-frames
- 'mus-sound-header-type 'mus-sound-length 'mus-sound-loop-info 'mus-sound-mark-info
- 'mus-sound-maxamp 'mus-sound-maxamp-exists? 'mus-sound-open-input 'mus-sound-open-output
- 'mus-sound-prune 'mus-sound-read 'mus-sound-reopen-output 'mus-sound-report-cache
- 'mus-sound-samples 'mus-sound-seek-frame 'mus-sound-srate 'mus-sound-type-specifier
- 'mus-sound-write 'mus-sound-write-date 'mus-soundfont 'mus-srate 'mus-svx 'mus-ubshort
- 'mus-ubyte 'mus-ulshort 'mus-unknown 'mus-unsupported 'mus-voc
- 'mus-width 'mus-xcoeff 'mus-xcoeffs 'mus-ycoeff 'mus-ycoeffs ) { lst-01 }
- #( 'name-click-hook 'new-sound 'new-sound-dialog 'new-sound-hook 'new-widget-hook 'next-sample
- 'normalize-by-channel 'normalize-by-sound 'normalize-channel 'normalize-globally 'notch
- 'notch? 'one-pole 'one-pole? 'one-zero 'one-zero? 'open-file-dialog
- 'open-file-dialog-directory 'open-hook 'open-raw-sound 'open-raw-sound-hook
- 'open-sound 'optimization 'optimization-hook
- 'orientation-hook 'oscil 'oscil? 'out-any 'outa
- 'outb 'outc 'outd 'output-comment-hook 'output-name-hook
- 'override-samples-with-origin 'pad-channel 'partials->polynomial 'partials->wave
- 'parzen-window 'pausing 'peak-env-hook 'peaks 'peaks-font 'phase-partials->wave
- 'phase-vocoder 'phase-vocoder-amp-increments 'phase-vocoder-amps 'phase-vocoder-freqs
- 'phase-vocoder-phase-increments 'phase-vocoder-phases 'phase-vocoder? 'play
- 'play-arrow-size 'play-hook 'player-home 'player? 'players
- 'playing 'poisson-window 'polar->rectangular 'polynomial 'polyshape 'polywave
- 'polyshape? 'polywave? 'position->x 'position->y 'position-color 'preferences-dialog
- 'previous-sample 'print-dialog 'print-hook 'print-length 'progress-report
- 'prompt-in-minibuffer 'ptree-channel 'pulse-train
- 'pulse-train? 'radians->degrees 'radians->hz
- 'ramp-channel 'rand 'rand-interp 'rand-interp? 'rand?
- 'read-hook 'read-mix-sample 'read-only 'read-region-sample
- 'read-sample 'readin 'readin?
- 'rectangular->magnitudes 'rectangular->polar 'rectangular-window 'redo 'redo-edit
- 'region->vct 'region-chans 'region-home 'region-frames 'region-graph-style 'region-maxamp
- 'region-maxamp-position 'region-position 'region-sample 'region-sampler? 'region-srate
- 'region? 'regions 'remember-sound-state 'remove-from-menu 'report-in-minibuffer 'reset-controls
- 'reset-listener-cursor 'restore-controls 'restore-region 'reverb-control-decay
- 'reverb-control-feedback 'reverb-control-length 'reverb-control-length-bounds
- 'reverb-control-lowpass 'reverb-control-scale 'reverb-control-scale-bounds 'reverb-control?
- 'reverse-channel 'reverse-selection 'reverse-sound 'revert-sound 'riemann-window
- 'right-sample 'ring-modulate 'rv2-window 'rv3-window 'rv4-window 'samaraki-window
- 'sample 'sample->file
- 'sample->file? 'sample->frame 'sampler-at-end? 'sampler-home 'sampler-position
- 'sampler? 'samples 'samples->seconds 'sash-color
- 'save-controls 'save-dir 'save-edit-history 'save-envelopes 'save-hook
- 'save-listener 'save-macros 'save-marks 'save-region 'save-region-dialog
- 'save-selection 'save-selection-dialog 'save-sound 'save-sound-as 'save-sound-dialog
- 'save-state 'save-state-file 'save-state-hook 'sawtooth-wave 'sawtooth-wave?
- 'scale-by 'scale-channel 'scale-selection-by 'scale-selection-to 'scale-to
- 'scan-chan 'scan-channel 'script-arg 'script-args 'search-procedure 'seconds->samples
- 'select-all 'select-channel 'select-channel-hook 'select-sound 'select-sound-hook
- 'selected-channel 'selected-data-color 'selected-graph-color 'selected-sound 'selection-chans
- 'selection-color 'selection-context 'selection-creates-region 'selection-frames
- 'selection-maxamp 'selection-maxamp-position 'selection-member? 'selection-position
- 'selection-srate 'selection? 'short-file-name 'show-all-axes 'show-all-axes-unlabelled
- 'show-bare-x-axis 'show-axes 'show-controls 'show-grid 'show-indices
- 'show-full-duration 'initial-beg 'initial-dur 'show-listener
- 'show-marks 'show-mix-waveforms 'show-no-axes 'show-selection 'show-selection-transform
- 'show-sonogram-cursor 'show-transform-peaks 'show-widget 'show-x-axis 'show-x-axis-unlabelled
- 'show-y-zero 'sinc-width 'nrxysin 'nrxysin? 'nrxycos 'nrxycos? 'smooth-channel
- 'smooth-selection 'smooth-sound 'snd->sample 'snd->sample? 'snd-error 'snd-error-hook
- 'snd-exit ( added ) 'snd-gcs 'snd-help 'snd-font 'snd-color 'snd-print 'snd-simulate-keystroke
- 'snd-spectrum 'snd-tempnam 'snd-url 'snd-urls 'snd-version 'snd-warning 'snd-warning-hook
- 'sound-data->sound-data 'sound-data->vct 'sound-data-chans 'sound-data-length
- 'sound-data-maxamp 'sound-data-ref 'sound-data-peak 'sound-data-set! 'sound-data-scale!
- 'sound-data-fill! 'sound-data? 'sound-data-multiply! 'sound-data-add! 'sound-data-offset!
- 'sound-data* 'sound-data+ 'sound-data-copy 'sound-data-reverse! 'sound-file-extensions
- 'sound-file? 'sound-files-in-directory 'sound-loop-info 'sound-properties 'sound-property
- 'sound-widgets 'sound? 'soundfont-info 'sounds 'spectrum-end 'spectro-hop 'spectrum-start
- 'spectro-x-angle 'spectro-x-scale 'spectro-y-angle 'spectro-y-scale 'spectro-z-angle
- 'spectro-z-scale 'spectrum 'speed-control 'speed-control-as-float 'speed-control-as-ratio
- 'speed-control-as-semitone 'speed-control-bounds 'speed-control-style 'speed-control-tones
- 'square-wave 'square-wave? 'squelch-update 'srate 'src 'src-channel 'src-selection
- 'src-sound 'src? 'ssb-am 'ssb-am? 'start-hook 'start-playing 'start-playing-hook
- 'start-playing-selection-hook 'start-progress-report 'stop-dac-hook 'stop-player
- 'stop-playing 'stop-playing-hook 'stop-playing-selection-hook 'ncos 'ncos? 'nsin 'nsin?
- 'swap-channels 'sync 'sync-style 'sync-none 'sync-all 'sync-by-sound
- 'sync-max 'syncd-marks 'table-lookup 'table-lookup? 'tap 'temp-dir
- 'text-focus-color 'time-graph 'time-graph-style 'time-graph-type
- 'time-graph? 'tiny-font 'tracking-cursor-style 'transform->vct 'transform-dialog
- 'transform-frames 'transform-graph 'transform-graph-style 'transform-graph-type
- 'transform-graph? 'transform-normalization 'transform-sample 'transform-size
- 'transform-type 'transform? 'trap-segfault 'triangle-wave 'triangle-wave? 'tukey-window
- 'two-pole 'two-pole? 'two-zero 'two-zero? 'ultraspherical-window 'unbind-key 'undo
- 'undo-edit 'undo-hook 'unselect-all 'update-hook 'update-lisp-graph 'update-sound
- 'update-time-graph 'update-transform-graph 'variable-graph? 'vct 'vct* 'vct+ 'vct->channel
- 'vct->list 'vct->sound-data 'vct->string 'vct->vector 'vct-add! 'vct-copy 'vct-fill!
- 'vct-length 'vct-map! 'vct-move! 'vct-multiply! 'vct-offset! 'vct-peak 'vct-ref 'vct-reverse!
- 'vct-scale! 'vct-set! 'vct-subseq 'vct-subtract! 'vct? 'vector->vct 'view-files-amp
- 'view-files-amp-env 'view-files-dialog 'view-files-files 'view-files-select-hook
- 'view-files-selected-files 'view-files-sort 'view-files-speed 'view-files-speed-style
- 'view-mixes-dialog 'view-regions-dialog 'view-sound 'walsh-transform 'wave-train
- 'wave-train? 'wavelet-transform 'wavelet-type 'wavo-hop 'wavo-trace 'welch-window
- 'widget-position 'widget-size 'widget-text 'window-height 'window-width 'window-x
- 'window-y 'with-background-processes 'with-file-monitor 'with-gl 'with-mix-tags
- 'with-relative-panes 'with-tracking-cursor 'with-verbose-cursor 'with-inset-graph
- 'with-pointer-focus 'with-smpte-label 'with-toolbar 'with-tooltips 'with-menu-icons
- 'save-as-dialog-src 'save-as-dialog-auto-comment
- 'x->position 'x-axis-as-clock 'x-axis-as-percentage 'x-axis-in-beats
- 'x-axis-in-measures 'x-axis-in-samples 'x-axis-in-seconds 'x-axis-label 'x-axis-style
- 'x-bounds 'x-position-slider 'x-zoom-slider 'xramp-channel 'y->position 'y-axis-label
- 'y-bounds 'y-position-slider 'y-zoom-slider 'zero-pad 'zoom-color 'zoom-focus-active
- 'zoom-focus-left 'zoom-focus-middle 'zoom-focus-right 'zoom-focus-style ) { lst-02 }
- \
- lst-01 lst-02 array-append each to sym
+ 'make-asymmetric-fm 'make-moving-average 'make-moving-max
+ 'make-bezier 'make-color 'make-comb 'make-filtered-comb 'make-convolve
+ 'make-delay 'make-env 'make-fft-window 'make-file->frample
+ 'make-file->sample 'make-filter 'make-fir-coeffs 'make-fir-filter
+ 'make-formant 'make-firmant 'make-formant-bank
+ 'make-frample->file 'make-granulate 'make-graph-data
+ 'make-iir-filter 'make-locsig 'make-mix-sampler
+ 'make-move-sound 'make-notch 'make-one-pole
+ 'make-one-pole-all-pass 'make-one-zero
+ 'make-oscil 'make-phase-vocoder 'make-player 'make-polyshape
+ 'make-polywave 'make-pulse-train 'make-rand 'make-rand-interp
+ 'make-readin 'make-region 'make-region-sampler 'make-sample->file
+ 'make-sampler 'make-sawtooth-wave 'make-nrxysin
+ 'make-nrxycos 'make-rxyk!cos 'make-rxyk!sin
+ 'make-snd->sample 'make-square-wave
+ 'make-src 'make-ssb-am 'make-ncos 'make-nsin 'make-table-lookup
+ 'make-triangle-wave 'make-two-pole 'make-two-zero
+ 'make-variable-graph 'make-vct 'make-wave-train 'map-chan
+ 'map-channel 'mark-click-hook 'mark-color 'mark-context
+ 'mark-drag-hook 'mark-home 'mark-hook 'mark-name 'mark-properties
+ 'mark-property 'mark-sample 'mark-sync 'mark-sync-max
+ 'mark-tag-height 'mark-tag-width 'mark? 'marks 'max-regions
+ 'max-transform-peaks 'maxamp 'maxamp-position 'menu-widgets
+ 'min-dB 'mix 'mix-amp 'mix-amp-env 'mix-click-hook 'mix-color
+ 'mix-dialog-mix 'mix-drag-hook 'mix-file-dialog 'mix-length
+ 'mix-home 'mix-name 'mix-position 'mix-properties 'mix-property
+ 'mix-region 'mix-release-hook 'mix-sync 'mix-sync-max 'mix-sampler?
+ 'mix-selection 'mix-speed 'mix-tag-height 'mix-tag-width 'mix-tag-y
+ 'mix-vct 'mix-waveform-height 'mix? 'mixes 'mouse-click-hook
+ 'mouse-drag-hook 'mouse-enter-graph-hook 'mouse-enter-label-hook
+ 'mouse-enter-listener-hook 'mouse-enter-text-hook
+ 'mouse-leave-graph-hook 'mouse-leave-label-hook
+ 'mouse-leave-listener-hook 'mouse-leave-text-hook
+ 'mouse-press-hook 'move-locsig 'move-sound 'move-sound?
+ 'moving-average 'moving-average? 'moving-max 'moving-max?
+ 'mus-aifc 'mus-aiff 'mus-alaw 'mus-alsa-buffer-size
+ 'mus-alsa-buffers 'mus-alsa-capture-device 'mus-alsa-device
+ 'mus-alsa-playback-device 'mus-alsa-squelch-warning 'mus-apply
+ 'mus-array-print-length 'mus-float-equal-fudge-factor 'mus-b24int
+ 'mus-bdouble 'mus-bdouble-unscaled 'mus-bfloat 'mus-bfloat-unscaled
+ 'mus-bicsf 'mus-bint 'mus-bintn 'mus-bshort 'mus-byte
+ 'mus-bytes-per-sample 'mus-caff 'mus-channel 'mus-channels
+ 'mus-chebyshev-first-kind 'mus-chebyshev-second-kind
+ 'mus-clipping 'mus-close 'mus-data 'mus-sample-type->string
+ 'mus-sample-type-name 'mus-describe 'mus-error-hook
+ 'mus-error-type->string 'mus-expand-filename 'mus-feedback
+ 'mus-feedforward 'mus-fft 'mus-file-buffer-size 'mus-file-clipping
+ 'mus-file-name 'mus-frequency 'mus-generator?
+ 'mus-header-raw-defaults 'mus-header-type->string
+ 'mus-header-type-name 'mus-hop 'mus-increment 'mus-input?
+ 'mus-interp-all-pass 'mus-interp-bezier 'mus-interp-hermite
+ 'mus-interp-lagrange 'mus-interp-linear 'mus-interp-none
+ 'mus-interp-sinusoidal 'mus-interp-type 'mus-interpolate
+ 'mus-ircam 'mus-l24int 'mus-ldouble 'mus-ldouble-unscaled
+ 'mus-length 'mus-lfloat 'mus-lfloat-unscaled 'mus-lint 'mus-lintn
+ 'mus-location 'mus-lshort 'mus-max-malloc 'mus-max-table-size
+ 'mus-mulaw 'mus-name 'mus-next 'mus-nist 'mus-offset
+ 'mus-order 'mus-oss-set-buffers 'mus-out-format 'mus-output?
+ 'mus-phase 'mus-ramp 'mus-rand-seed 'mus-random
+ 'mus-raw 'mus-reset 'mus-riff 'mus-run 'mus-scaler
+ 'mus-set-formant-radius-and-frequency 'mus-sound-chans
+ 'mus-sound-comment
+ 'mus-sound-sample-type 'mus-sound-data-location
+ 'mus-sound-datum-size 'mus-sound-duration 'mus-sound-forget
+ 'mus-sound-framples 'mus-sound-header-type 'mus-sound-length
+ 'mus-sound-loop-info 'mus-sound-mark-info 'mus-sound-maxamp
+ 'mus-sound-maxamp-exists?
+ 'mus-sound-prune
+ 'mus-sound-report-cache 'mus-sound-samples
+ 'mus-sound-srate 'mus-sound-type-specifier
+ 'mus-sound-write-date 'mus-soundfont 'mus-srate 'mus-svx 'mus-ubshort
+ 'mus-ubyte 'mus-ulshort 'mus-unknown-sample 'mus-unknown-header
+ 'mus-voc 'mus-width 'mus-xcoeff 'mus-xcoeffs 'mus-ycoeff
+ 'mus-ycoeffs 'name-click-hook 'new-sound 'new-sound-dialog 'new-sound-hook
+ 'new-widget-hook 'next-sample 'normalize-by-channel 'normalize-by-sound
+ 'normalize-channel 'normalize-globally 'notch 'notch? 'one-pole
+ 'one-pole? 'one-pole-all-pass 'one-pole-all-pass?
+ 'one-zero 'one-zero? 'open-file-dialog
+ 'open-file-dialog-directory 'open-hook 'open-raw-sound
+ 'open-raw-sound-hook 'open-sound 'orientation-hook 'oscil
+ 'oscil? 'out-any 'outa 'outb 'outc 'outd 'output-comment-hook
+ 'override-samples-with-origin 'pad-channel
+ 'partials->polynomial 'partials->wave 'parzen-window 'pausing
+ 'peaks 'peaks-font 'phase-partials->wave
+ 'phase-vocoder 'phase-vocoder-amp-increments 'phase-vocoder-amps
+ 'phase-vocoder-freqs 'phase-vocoder-phase-increments
+ 'phase-vocoder-phases 'phase-vocoder? 'play 'play-arrow-size
+ 'play-hook 'player-home 'player? 'players 'playing
+ 'poisson-window 'polar->rectangular 'polynomial 'polyshape
+ 'polywave 'polyshape? 'polywave? 'position->x 'position->y
+ 'position-color 'preferences-dialog 'previous-sample 'print-dialog
+ 'print-length 'progress-report 'pulse-train 'pulse-train?
+ 'radians->degrees 'radians->hz 'ramp-channel 'rand 'rand-interp
+ 'rand-interp? 'rand? 'read-mix-sample 'read-only
+ 'read-region-sample 'read-sample 'readin 'readin?
+ 'rectangular->magnitudes 'rectangular->polar 'rectangular-window
+ 'redo 'redo-edit 'region->vct 'region-chans 'region-home
+ 'region-framples 'region-graph-style 'region-maxamp 'region-maxamp-position
+ 'region-position 'region-sample 'region-sampler? 'region-srate 'region?
+ 'regions 'remember-sound-state 'remove-from-menu 'reset-controls
+ 'reset-listener-cursor 'restore-controls 'restore-region
+ 'reverb-control-decay 'reverb-control-feedback 'reverb-control-length
+ 'reverb-control-length-bounds 'reverb-control-lowpass 'reverb-control-scale
+ 'reverb-control-scale-bounds 'reverb-control? 'reverse-channel
+ 'reverse-selection 'reverse-sound 'revert-sound 'riemann-window
+ 'right-sample 'ring-modulate 'rv2-window 'rv3-window 'rv4-window
+ 'samaraki-window 'sample 'sample->file 'sample->file?
+ 'sampler-at-end? 'sampler-home 'sampler-position 'sampler? 'samples
+ 'samples->seconds 'sash-color 'save-controls 'save-dir 'save-edit-history
+ 'save-envelopes 'save-hook 'save-listener 'save-marks 'save-region
+ 'save-region-dialog 'save-selection 'save-selection-dialog 'save-sound
+ 'save-sound-as 'save-sound-dialog 'save-state 'save-state-file
+ 'save-state-hook 'sawtooth-wave 'sawtooth-wave? 'scale-by 'scale-channel
+ 'scale-selection-by 'scale-selection-to 'scale-to
+ 'scan-channel 'script-arg 'script-args 'search-procedure
+ 'seconds->samples 'select-all 'select-channel 'select-channel-hook
+ 'select-sound 'select-sound-hook 'selected-channel 'selected-data-color
+ 'selected-graph-color 'selected-sound 'selection-chans 'selection-color
+ 'selection-context 'selection-creates-region 'selection-framples
+ 'selection-maxamp 'selection-maxamp-position 'selection-member?
+ 'selection-position 'selection-srate 'selection? 'short-file-name
+ 'show-all-axes 'show-all-axes-unlabelled 'show-bare-x-axis 'show-axes
+ 'show-controls 'show-grid 'show-indices 'show-full-duration
+ 'show-full-range 'initial-beg 'initial-dur 'show-listener 'show-marks
+ 'show-mix-waveforms 'show-no-axes 'show-selection
+ 'show-selection-transform 'show-sonogram-cursor 'show-transform-peaks
+ 'show-widget 'show-x-axis 'show-x-axis-unlabelled 'show-y-zero
+ 'sinc-width 'nrxysin 'nrxysin? 'nrxycos 'nrxycos? 'rxyk!cos 'rxyk!cos?
+ 'rxyk!sin 'rxyk!sin? 'smooth-channel
+ 'smooth-selection 'smooth-sound 'snd->sample 'snd->sample? 'snd-error
+ 'snd-error-hook 'snd-exit ( added ) 'snd-gcs 'snd-help 'snd-font
+ 'snd-color 'snd-print 'snd-spectrum 'snd-tempnam 'snd-url 'snd-urls
+ 'snd-version 'snd-warning 'snd-warning-hook
+ 'sound-file-extensions 'sound-file?
+ 'sound-files-in-directory 'sound-loop-info 'sound-properties
+ 'sound-property 'sound-widgets 'sound? 'soundfont-info 'sounds
+ 'spectrum-end 'spectro-hop 'spectrum-start 'spectro-x-angle
+ 'spectro-x-scale 'spectro-y-angle 'spectro-y-scale 'spectro-z-angle
+ 'spectro-z-scale 'spectrum 'speed-control 'speed-control-as-float
+ 'speed-control-as-ratio 'speed-control-as-semitone 'speed-control-bounds
+ 'speed-control-style 'speed-control-tones 'square-wave 'square-wave?
+ 'squelch-update 'srate 'src 'src-channel 'src-selection 'src-sound
+ 'src? 'ssb-am 'ssb-am? 'start-playing 'start-playing-hook
+ 'start-playing-selection-hook 'start-progress-report 'status-report
+ 'stop-player 'stop-playing 'stop-playing-hook
+ 'stop-playing-selection-hook 'ncos 'ncos? 'nsin 'nsin? 'swap-channels
+ 'sync 'sync-style 'sync-none 'sync-all 'sync-by-sound 'sync-max
+ 'syncd-marks 'table-lookup 'table-lookup? 'tap 'tap? 'temp-dir
+ 'text-focus-color 'time-graph 'time-graph-style 'time-graph-type
+ 'time-graph? 'tiny-font 'tracking-cursor-style 'transform->vct
+ 'transform-dialog 'transform-framples 'transform-graph
+ 'transform-graph-style 'transform-graph-type 'transform-graph?
+ 'transform-normalization 'transform-sample 'transform-size 'transform-type
+ 'transform? 'triangle-wave 'triangle-wave? 'tukey-window
+ 'two-pole 'two-pole? 'two-zero 'two-zero? 'ultraspherical-window
+ 'unbind-key 'undo 'undo-edit 'undo-hook 'unselect-all 'update-hook
+ 'update-lisp-graph 'update-sound 'update-time-graph
+ 'update-transform-graph 'variable-graph? 'vct 'vct* 'vct+
+ 'vct->channel 'vct->list 'vct->string 'vct->vector
+ 'vct-add! 'vct-length 'vct-max 'vct-min 'vct-move!
+ 'vct-multiply! 'vct-offset! 'vct-peak 'vct-ref 'vct-reverse! 'vct-scale!
+ 'vct-set! 'vct-subseq 'vct-subtract! 'vct? 'vector->vct 'walsh-transform
+ 'wave-train 'wave-train? 'wavelet-transform 'wavelet-type 'wavo-hop
+ 'wavo-trace 'welch-window 'widget-position 'widget-size 'widget-text
+ 'window-height 'window-width 'window-x 'window-y
+ 'with-background-processes 'with-file-monitor 'with-gl 'with-mix-tags
+ 'with-relative-panes 'with-tracking-cursor 'with-verbose-cursor
+ 'with-inset-graph 'with-interrupts 'with-pointer-focus 'with-smpte-label
+ 'with-toolbar 'with-tooltips 'with-menu-icons 'save-as-dialog-src
+ 'save-as-dialog-auto-comment 'x->position 'x-axis-as-clock
+ 'x-axis-as-percentage 'x-axis-in-beats 'x-axis-in-measures
+ 'x-axis-in-samples 'x-axis-in-seconds 'x-axis-label 'x-axis-style
+ 'x-bounds 'x-position-slider 'x-zoom-slider 'xramp-channel
+ 'y->position 'y-axis-label 'y-bounds 'y-position-slider 'y-zoom-slider
+ 'zero-pad 'zoom-color 'zoom-focus-active 'zoom-focus-left
+ 'zoom-focus-middle 'zoom-focus-right 'zoom-focus-style ) each to sym
sym symbol-defined? unless
undefined sym array-push to undefined
then
@@ -2083,57 +2419,31 @@ black-and-white-colormap constant *better-colormap*
undefined 'gl-graph->ps array-delete-key drop
then
undefined empty? unless
- $" undefined[%d]: %s" #( undefined length undefined ) snd-display
+ "undefined[%d]: %s" #( undefined length undefined ) snd-display
then
;
\ ---------------- test 04: sndlib ----------------
-: play-sound-1 ( file -- )
- doc" play test func"
- { file }
- file mus-sound-open-input { sound-fd }
- file mus-sound-chans { chans }
- file mus-sound-frames { frames }
- file mus-sound-srate { srate }
- 256 { bufsize }
- chans bufsize make-sound-data { data }
- bufsize chans * 2* { bytes }
- 0 srate chans mus-lshort bytes mus-audio-open-output { audio-fd }
- audio-fd -1 = if
- 0 srate chans mus-bshort bytes mus-audio-open-output to audio-fd
- then
- audio-fd -1 = if
- $" can't play %s" #( file ) snd-display
- else
- frames 0 ?do
- sound-fd 0 bufsize 1- chans data mus-sound-read drop
- audio-fd data bufsize 0 mus-audio-write drop
- bufsize +loop
- audio-fd mus-audio-close drop
- then
- sound-fd mus-sound-close-input drop
-;
-
: sndlib-check-it { snd typ fmt samp -- }
- snd header-type typ $" save-as %s" #( typ mus-header-type-name ) snd-test-neq
+ snd header-type typ "save-as %s" #( typ mus-header-type-name ) snd-test-neq
"test.snd" mus-sound-header-type { ntyp }
ntyp
typ
- $" save-as %s -> %s"
+ "save-as %s -> %s"
#( typ mus-header-type-name
ntyp mus-header-type-name ) snd-test-neq
- snd data-format fmt $" save-as %s" #( fmt mus-data-format-name ) snd-test-neq
- "test.snd" mus-sound-data-format { nfmt }
+ snd sample-type fmt "save-as %s" #( fmt mus-sample-type-name ) snd-test-neq
+ "test.snd" mus-sound-sample-type { nfmt }
nfmt
fmt
- $" save-as %s -> %s"
- #( fmt mus-data-format-name
- nfmt mus-data-format-name ) snd-test-neq
+ "save-as %s -> %s"
+ #( fmt mus-sample-type-name
+ nfmt mus-sample-type-name ) snd-test-neq
1000 snd sample samp "%s[1000]" #( typ mus-header-type-name ) snd-test-neq
;
-: sndlib-check-string <{ string -- str }> string $" [written by me]" $+ ;
+: sndlib-check-string <{ string -- str }> string " [written by me]" $+ ;
: sndlib-true-cb <{ n -- f }> #t ;
@@ -2147,23 +2457,6 @@ black-and-white-colormap constant *better-colormap*
then
;
-: frame->byte { file frame -- pos }
- file mus-sound-chans
- file mus-sound-datum-size *
- frame *
- file mus-sound-data-location +
-;
-
-: sound-data-channel->list { sd chan -- lst }
- sd chan sd sound-data-length 0.0 make-vct sound-data->vct vct->list
-;
-
-: sound-data->list { sd -- lst }
- sd sound-data-chans make-list map!
- sd i sound-data-channel->list
- end-map
-;
-
: sndlib-test-map-10-times-cb <{ y -- y' }> y 10.0 f* ;
: sndlib-test-map-add-cb { mx -- prc; y self -- y' }
@@ -2172,7 +2465,7 @@ black-and-white-colormap constant *better-colormap*
y self @ ( mx ) f+
;
-0 value big-file-frames
+0 value big-file-framples
: sndlib-test-map-x-cb { x incr -- prc; n self -- y }
1 proc-create x , incr , ( prc )
@@ -2196,7 +2489,7 @@ black-and-white-colormap constant *better-colormap*
"oboe.snd" { oboe-snd }
oboe-snd mus-sound-chans { chns }
oboe-snd mus-sound-data-location { dl }
- oboe-snd mus-sound-frames { fr }
+ oboe-snd mus-sound-framples { fr }
oboe-snd mus-sound-samples { smps }
oboe-snd mus-sound-length { len }
oboe-snd mus-sound-datum-size { size }
@@ -2205,9 +2498,9 @@ black-and-white-colormap constant *better-colormap*
oboe-snd mus-sound-maxamp-exists? { m1 }
oboe-snd mus-sound-maxamp { mal }
"z.snd" mus-sound-maxamp { mz }
- oboe-snd mus-sound-data-format mus-bytes-per-sample { bytes }
- mz car 0 $" mus-sound-maxamp z.snd" #() snd-test-neq
- mz cadr 0.0 $" mus-sound-maxamp z.snd" #() snd-test-neq
+ oboe-snd mus-sound-sample-type mus-bytes-per-sample { bytes }
+ mz car 0 "mus-sound-maxamp z.snd" #() snd-test-neq
+ mz cadr 0.0 "mus-sound-maxamp z.snd" #() snd-test-neq
\
#( #( mus-bshort 2 )
#( mus-lshort 2 )
@@ -2237,63 +2530,66 @@ black-and-white-colormap constant *better-colormap*
vals 1 array-ref to siz
frm mus-bytes-per-sample siz "mus-bytes-per-sample" #() snd-test-neq
end-each
- mus-bshort mus-data-format->string "mus-bshort" "mus-data-format->string" #() snd-test-neq
- mus-aifc mus-header-type->string "mus-aifc" "mus-header-type->string" #() snd-test-neq
- \
+ mus-bshort mus-sample-type->string "mus-bshort"
+ "mus-sample-type->string" #() snd-test-neq
+ mus-aifc mus-header-type->string "mus-aifc"
+ "mus-header-type->string" #() snd-test-neq
+ \
"hiho.tmp" { hiho }
hiho mus-sound-report-cache drop
hiho readlines { res }
- res 0 array-ref string-chomp $" sound table:" $" print-cache 1" #() snd-test-neq
+ res 0 array-ref string-chomp "sound table:" "print-cache 1" #() snd-test-neq
hiho file-delete
10 { req }
- mus-audio-describe to res
- res string-length { rln }
- rln req < if
- rln req "<" $" mus-audio-describe: %s?" #( res ) snd-format #() snd-display
- then
- chns 1 $" oboe: mus-sound-chans" #() snd-test-neq
- dl 28 $" oboe: mus-sound-data-location" #() snd-test-neq
- fr 50828 $" oboe: mus-sound-frames" #() snd-test-neq
- smps 50828 $" oboe: mus-sound-samples" #() snd-test-neq
- len 50828 2* 28 + $" oboe: mus-sound-length" #() snd-test-neq
- size 2 $" oboe: mus-sound-datum-size" #() snd-test-neq
- bytes 2 $" oboe: mus-sound-bytes" #() snd-test-neq
- sr 22050 $" oboe: mus-sound-srate" #() snd-test-neq
+ chns 1 "oboe: mus-sound-chans" #() snd-test-neq
+ dl 28 "oboe: mus-sound-data-location" #() snd-test-neq
+ fr 50828 "oboe: mus-sound-framples" #() snd-test-neq
+ smps 50828 "oboe: mus-sound-samples" #() snd-test-neq
+ len 50828 2* 28 + "oboe: mus-sound-length" #() snd-test-neq
+ size 2 "oboe: mus-sound-datum-size" #() snd-test-neq
+ bytes 2 "oboe: mus-sound-bytes" #() snd-test-neq
+ sr 22050 "oboe: mus-sound-srate" #() snd-test-neq
m1
*clmtest* 0= && if
- $" oboe: mus-sound-maxamp-exists before maxamp: %s" #( m1 ) snd-display
+ "oboe: mus-sound-maxamp-exists before maxamp: %s" #( m1 ) snd-display
then
oboe-snd mus-sound-maxamp-exists? to res
res unless
- $" oboe: not mus-sound-maxamp-exists after maxamp: %s" #( res ) snd-display
+ "oboe: not mus-sound-maxamp-exists after maxamp: %s" #( res ) snd-display
then
*clmtest* 0= if
mus-header-raw-defaults to res
res length 3 = if
- res 0 array-ref ( sr ) 44100 $" mus-header-raw-defaults srate" #() snd-test-neq
- res 1 array-ref ( chns ) 2 $" mus-header-raw-defaults chans" #() snd-test-neq
- res 2 array-ref ( frm ) mus-bshort $" mus-header-raw-defaults format" #() snd-test-neq
+ res 0 array-ref ( sr ) 44100 "mus-header-raw-defaults srate"
+ #() snd-test-neq
+ res 1 array-ref ( chns ) 2 "mus-header-raw-defaults chans"
+ #() snd-test-neq
+ res 2 array-ref ( frm ) mus-bshort "mus-header-raw-defaults format"
+ #() snd-test-neq
else
- res object-length 3 $" mus-header-raw-defaults %s" #( res ) snd-test-neq
+ res object-length 3 "mus-header-raw-defaults %s" #( res ) snd-test-neq
then
then
'( 12345 3 mus-bdouble-unscaled ) set-mus-header-raw-defaults drop
mus-header-raw-defaults to res
res length 3 = if
- res 0 array-ref ( sr ) 12345 $" set-mus-header-raw-defaults srate" #() snd-test-neq
- res 1 array-ref ( chns ) 3 $" set-mus-header-raw-defaults chans" #() snd-test-neq
- res 2 array-ref ( frm ) mus-bdouble-unscaled $" set-mus-header-raw-defaults format" #() snd-test-neq
+ res 0 array-ref ( sr ) 12345 "set-mus-header-raw-defaults srate"
+ #() snd-test-neq
+ res 1 array-ref ( chns ) 3 "set-mus-header-raw-defaults chans"
+ #() snd-test-neq
+ res 2 array-ref ( frm ) mus-bdouble-unscaled
+ "set-mus-header-raw-defaults format" #() snd-test-neq
else
- res object-length 3 $" set-mus-header-raw-defaults %s" #( res ) snd-test-neq
+ res object-length 3 "set-mus-header-raw-defaults %s" #( res ) snd-test-neq
then
'( 44100 2 mus-bshort ) set-mus-header-raw-defaults drop
- \
- $" %d-%b %H:%M" oboe-snd mus-sound-write-date strftime
- $" 15-Oct 04:34"
- $" mus-sound-write-date oboe.snd" #() snd-test-neq
- $" %d-%b %H:%M" "pistol.snd" mus-sound-write-date strftime
- $" 01-Jul 13:06"
- $" mus-sound-write-date pistol.snd" #() snd-test-neq
+ \
+ "%d-%b %H:%M" oboe-snd mus-sound-write-date strftime
+ "15-Oct 04:34"
+ "mus-sound-write-date oboe.snd" #() snd-test-neq
+ "%d-%b %H:%M" "pistol.snd" mus-sound-write-date strftime
+ "01-Jul 22:06"
+ "mus-sound-write-date pistol.snd" #() snd-test-neq
\
oboe-snd open-sound { ind }
"test" { long-file-name }
@@ -2302,155 +2598,143 @@ black-and-white-colormap constant *better-colormap*
loop
long-file-name ".snd" string-push drop
ind variable-graph? if
- $" variable-graph thinks anything is a graph..." #() snd-display
+ "variable-graph thinks anything is a graph..." #() snd-display
then
ind player? if
- $" player? thinks anything is a player..." #() snd-display
+ "player? thinks anything is a player..." #() snd-display
then
ind sound? unless
- $" %s is not a sound?" #( ind ) snd-display
+ "%s is not a sound?" #( ind ) snd-display
then
#f sound? if
- $" sound? #f -> #t?" #() snd-display
+ "sound? #f -> #t?" #() snd-display
then
#t sound? if
- $" sound? #t -> #f?" #() snd-display
+ "sound? #t -> #f?" #() snd-display
then
long-file-name ind save-sound-as drop
ind close-sound drop
long-file-name open-sound to ind
ind sound? unless
- $" can't find test...snd" #() snd-display
+ "can't find test...snd" #() snd-display
then
long-file-name string-length { lfnlen }
ind file-name string-length { fnlen }
ind short-file-name string-length { sfnlen }
fnlen lfnlen <
sfnlen lfnlen < || if
- $" file-name lengths: long-file-name %d, file-name %d, short-file-name %d" #(
- lfnlen fnlen sfnlen ) snd-display
+ "file-name lengths: long-file-name %d, file-name %d, short-file-name %d"
+ #( lfnlen fnlen sfnlen ) snd-display
then
ind close-sound drop
long-file-name mus-sound-forget drop
long-file-name file-delete
- \
+ \
"forest.aiff" check-file-name { fsnd }
fsnd file-exists? if
fsnd "fmv.snd" file-copy
"fmv.snd" open-sound to ind
ind sound-loop-info fsnd mus-sound-loop-info "loop-info" #() snd-test-neq
ind '( 12000 14000 1 2 3 4 ) set-sound-loop-info drop
- ind sound-loop-info '( 12000 14000 1 2 3 4 1 1 ) "set-loop-info" #() snd-test-neq
- "fmv1.snd" ind mus-aifc save-sound-as drop
+ ind sound-loop-info '( 12000 14000 1 2 3 4 1 1 ) "set-loop-info"
+ #() snd-test-neq
+ "fmv1.snd" ind :header-type mus-aifc save-sound-as drop
ind close-sound drop
- "fmv1.snd" mus-sound-loop-info '( 12000 14000 1 2 3 4 1 1 ) "saved-loop-info" #() snd-test-neq
+ "fmv1.snd" mus-sound-loop-info '( 12000 14000 1 2 3 4 1 1 )
+ "saved-loop-info" #() snd-test-neq
then
- \
+ \
oboe-snd open-sound to ind
- "fmv.snd" ind mus-aifc save-sound-as drop
+ "fmv.snd" ind :header-type mus-aifc save-sound-as drop
ind close-sound drop
"fmv.snd" open-sound to ind
- ind sound-loop-info '() $" null loop-info" #() snd-test-neq
+ ind sound-loop-info '() "null loop-info" #() snd-test-neq
ind '( 1200 1400 4 3 2 1 ) set-sound-loop-info drop
- ind sound-loop-info '( 1200 1400 4 3 2 1 1 1 ) $" set null loop-info" #() snd-test-neq
- "fmv1.snd" :sound ind :header-type mus-aifc save-sound-as drop
- "fmv1.snd" mus-sound-loop-info '( 1200 1400 4 3 2 1 1 1 ) $" saved null loop-info" #() snd-test-neq
+ ind sound-loop-info '( 1200 1400 4 3 2 1 1 1 ) "set null loop-info" #()
+ snd-test-neq
+ "fmv1.snd" ind :header-type mus-aifc save-sound-as drop
+ "fmv1.snd" mus-sound-loop-info '( 1200 1400 4 3 2 1 1 1 )
+ "saved null loop-info" #() snd-test-neq
ind close-sound drop
"fmv.snd" open-sound to ind
'( 1200 1400 4 3 2 1 1 0 ) set-sound-loop-info drop
- ind sound-loop-info '( 1200 1400 0 0 2 1 1 0 ) $" set null loop-info (no mode1)" #() snd-test-neq
- "fmv1.snd" ind mus-aifc save-sound-as drop
+ ind sound-loop-info '( 1200 1400 0 0 2 1 1 0 )
+ "set null loop-info (no mode1)" #() snd-test-neq
+ "fmv1.snd" ind :header-type mus-aifc save-sound-as drop
ind close-sound drop
- "fmv1.snd" mus-sound-loop-info '( 1200 1400 0 0 2 1 1 0 ) $" saved null loop-info (no mode1)" #() snd-test-neq
- \
+ "fmv1.snd" mus-sound-loop-info '( 1200 1400 0 0 2 1 1 0 )
+ "saved null loop-info (no mode1)" #() snd-test-neq
+ \
com empty? unless
- $" oboe: mus-sound-comment %S?" #( com ) snd-display
- then
- #( #( "nasahal8.wav" $" ICRD: 1997-02-22\nIENG: Paul R. Roger\nISFT: Sound Forge 4.0\n" )
- #( "8svx-8.snd" $" File created by Sound Exchange " )
- #( "sun-16-afsp.snd" $" AFspdate:1981/02/11 23:03:34 UTC" )
- #( "smp-16.snd" $" Converted using Sox. " )
- #( "d40130.au" $" 1994 Jesus Villena" )
- #( "wood.maud" $" file written by SOX MAUD-export " )
- #( "addf8.sf_mipseb" $" date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" " )
- #( "mary-sun4.sig" $" MARY HAD A LITTLE LAMB\n" )
- #( "nasahal.pat" $" This patch saved with Sound Forge 3.0." )
- #( "next-16.snd" $" ;Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91" )
- #( "wood16.nsp" $" Created by Snack " )
- #( "wood.sdx" $" 1994 Jesus Villena" )
- #( "clmcom.aif" $" this is a comment" )
- #( "anno.aif" $" 1994 Jesus Villena\n" )
- #( "telephone.wav" $" sample_byte_format -s2 01\nchannel_count -i 1\nsample_count -i 36461\nsample_rate -i 16000\nsample_n_bytes -i 2\nsample_sig_bits -i 16\n" ) ) { comms }
+ "oboe: mus-sound-comment %S?" #( com ) snd-display
+ then
+ #( #( "nasahal8.wav"
+ "ICRD: 1997-02-22\nIENG: Paul R. Roger\nISFT: Sound Forge 4.0\n" )
+ #( "8svx-8.snd" "File created by Sound Exchange " )
+ #( "sun-16-afsp.snd" "AFspdate:1981/02/11 23:03:34 UTC" )
+ #( "smp-16.snd" "Converted using Sox. " )
+ #( "d40130.au" "1994 Jesus Villena" )
+ #( "wood.maud" "file written by SOX MAUD-export " )
+ #( "addf8.sf_mipseb"
+ "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" " )
+ #( "mary-sun4.sig" "MARY HAD A LITTLE LAMB\n" )
+ #( "nasahal.pat" "This patch saved with Sound Forge 3.0." )
+ #( "next-16.snd"
+ ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91" )
+ #( "wood16.nsp" "Created by Snack " )
+ #( "wood.sdx" "1994 Jesus Villena" )
+ #( "clmcom.aif" "this is a comment" )
+ #( "anno.aif" "1994 Jesus Villena\n" )
+ #( "telephone.wav"
+ "sample_byte_format -s2 01\nchannel_count -i 1\nsample_count -i 36461\nsample_rate -i 16000\nsample_n_bytes -i 2\nsample_sig_bits -i 16\n" ) ) { comms }
comms each to vals
vals 0 array-ref check-file-name to fsnd
fsnd file-exists? if
fsnd mus-sound-comment ( res )
vals 1 array-ref ( req )
- $" mus-sound-comment %s" #( fsnd ) snd-test-neq
+ "mus-sound-comment %s" #( fsnd ) snd-test-neq
then
end-each
- \
+ \
"traffic.aiff" check-file-name to fsnd
fsnd file-exists? if
fsnd mus-sound-comment to res
res string? unless
- $" mus-sound-comment traffic: %s?" #( res ) snd-display
+ "mus-sound-comment traffic: %s?" #( res ) snd-display
then
then
- \
- *clmtest* 0= if
- mal cadr 0.14724 $" oboe: mus-sound-maxamp" #() snd-test-neq
- mal car 24971 $" oboe: mus-sound-maxamp at" #() snd-test-neq
- then
- \
- oboe-snd '( 1234 0.5 ) set-mus-sound-maxamp drop
- oboe-snd mus-sound-maxamp to mal
- mal cadr 0.5 $" oboe: set-mus-sound-maxamp" #() snd-test-neq
- mal car 1234 $" oboe: set-mus-sound-maxamp at" #() snd-test-neq
- \
- "4.aiff" mus-sound-maxamp to mal
+ \
*clmtest* 0= if
- mal
- vct( 810071 0.245 810071 0.490 810071 0.735 810071 0.980 )
- $" mus-sound-maxamp 4.aiff" #() snd-test-neq
- then
- "4.aiff" '( 1234 0.5 54321 0.2 0 0.1 9999 0.01 ) set-mus-sound-maxamp drop
- "4.aiff" mus-sound-maxamp ( mal )
- vct( 1234 0.5 54321 0.2 0 0.1 9999 0.01 )
- $" set-mus-sound-maxamp 4.aiff" #() snd-test-neq
- oboe-snd '( 1234 ) <'> set-mus-sound-maxamp #t nil fth-catch to res
- stack-reset
- res car 'wrong-type-arg <> if
- $" set-mus-sound-maxamp bad arg: %s?" #( res ) snd-display
+ mal cadr 0.14724 "oboe: mus-sound-maxamp" #() snd-test-neq
+ mal car 24971 "oboe: mus-sound-maxamp at" #() snd-test-neq
then
+ \
oboe-snd mus-sound-type-specifier to res
\ 0x646e732e little endian reader
\ 0x2e736e64 big endian reader
res 0x646e732e d<>
res 0x2e736e64 d<> && if
- $" oboe: mus-sound-type-specifier: 0x%x?" #( res ) snd-display
- then
- $" %d-%b-%Y %H:%M" oboe-snd file-write-date strftime
- $" 15-Oct-2006 04:34"
- $" oboe: file-write-date" #() snd-test-neq
- oboe-snd play-sound-1
- oboe-snd mus-sound-forget drop
- \
+ "oboe: mus-sound-type-specifier: %#x?" #( res ) snd-display
+ then
+ "%d-%b-%Y %H:%M" oboe-snd file-write-date strftime
+ "15-Oct-2006 04:34"
+ "oboe: file-write-date" #() snd-test-neq
+ \
0 { lasth }
begin
lasth 1+ to lasth
- lasth mus-header-type-name "unsupported" string=
+ lasth mus-header-type-name "unknown" string=
until
lasth 50 < if
- $" header-type[%d] = %s?" #( lasth dup mus-header-type-name ) snd-display
+ "header-type[%d] = %s?" #( lasth dup mus-header-type-name ) snd-display
then
0 to lasth
begin
lasth 1+ to lasth
- lasth mus-data-format-name "unknown" string=
+ lasth mus-sample-type-name "unknown" string=
until
lasth 10 < if
- $" data-format[%d] = %s?" #( lasth dup mus-data-format-name ) snd-display
+ "sample-type[%d] = %s?" #( lasth dup mus-sample-type-name ) snd-display
then
nil { name }
#( 'dont-normalize
@@ -2458,82 +2742,80 @@ black-and-white-colormap constant *better-colormap*
'normalize-by-channel ) each symbol-name to name
name string-eval to req
req set-transform-normalization drop
- transform-normalization req $" set-transform-normalization %s" #( name ) snd-test-neq
+ transform-normalization req
+ "set-transform-normalization %s" #( name ) snd-test-neq
end-each
- \
- "fmv.snd" mus-next mus-bshort 22050 1 $" set-samples test" 100 new-sound to ind
+ \
+ "fmv.snd" 1 22050 mus-bshort mus-next "set-samples test" 100 new-sound to ind
10 3 3 0.1 make-vct set-samples drop
0 20 ind 0 channel->vct
vct( 0 0 0 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 )
- $" 1 set samples 0 for 0.1" #() snd-test-neq
+ "1 set samples 0 for 0.1" #() snd-test-neq
20 3 3 0.1 make-vct ind 0 set-samples drop
10 20 ind 0 channel->vct
vct( 0.1 0.1 0.1 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 )
- $" 2 set samples 10 for 0.1" #() snd-test-neq
- 30 3 3 0.1 make-vct ind 0 #f $" a name" set-samples drop
+ "2 set samples 10 for 0.1" #() snd-test-neq
+ 30 3 3 0.1 make-vct ind 0 #f "a name" set-samples drop
20 20 ind 0 channel->vct
vct( 0.1 0.1 0.1 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 )
- $" 3 set samples 20 for 0.1" #() snd-test-neq
- 0 3 3 0.2 make-vct ind 0 #f $" a name" 0 1 set-samples drop
+ "3 set samples 20 for 0.1" #() snd-test-neq
+ 0 3 3 0.2 make-vct ind 0 #f "a name" 0 1 set-samples drop
0 20 ind 0 channel->vct
vct( 0.2 0.2 0.2 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 )
- $" 4 set samples 0 at 1 for 0.1" #() snd-test-neq
+ "4 set samples 0 at 1 for 0.1" #() snd-test-neq
20 20 ind 0 channel->vct
20 0.0 make-vct
- $" 5 set samples 20 at 1 for 0.1" #() snd-test-neq
+ "5 set samples 20 at 1 for 0.1" #() snd-test-neq
"fmv1.snd" :channels 2 new-sound { nd }
10 0.5 make-vct 0 10 nd 0 vct->channel drop
10 0.3 make-vct 0 10 nd 1 vct->channel drop
"fmv1.snd" nd save-sound-as drop
nd close-sound drop
"fmv1.snd" file-exists? unless
- $" fmv1.snd not saved??" #() snd-display
+ "fmv1.snd not saved??" #() snd-display
then
- 0 10 "fmv1.snd" ind 0 #f $" another name" 1 set-samples drop
+ 0 10 "fmv1.snd" ind 0 #f "another name" 1 set-samples drop
0 20 ind 0 channel->vct
vct( 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.1 0.1 0.1 0 0 0 0 0 0 0 )
- $" 6 set samples 0 at 1 for 0.1" #() snd-test-neq
- 5 6 "fmv1.snd" ind 0 #f $" another name 7" 0 set-samples drop
+ "6 set samples 0 at 1 for 0.1" #() snd-test-neq
+ 5 6 "fmv1.snd" ind 0 #f "another name 7" 0 set-samples drop
0 20 ind 0 channel->vct
vct( 0.3 0.3 0.3 0.3 0.3 0.5 0.5 0.5 0.5 0.5 0.5 0.1 0.1 0 0 0 0 0 0 0 )
- $" 7 set samples 0 at 1 for 0.1" #() snd-test-neq
- 0 10 "fmv1.snd" ind 0 #f $" another name 8" 1 0 #f set-samples drop
+ "7 set samples 0 at 1 for 0.1" #() snd-test-neq
+ 0 10 "fmv1.snd" ind 0 #f "another name 8" 1 0 #f set-samples drop
0 20 ind 0 channel->vct
vct( 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0 0 0 0 0 0 0 0 0 0 )
- $" 8 set samples 0 at 1 for 0.1" #() snd-test-neq
- 10 10 "fmv1.snd" ind 0 #f $" another name 9" 0 0 set-samples drop
+ "8 set samples 0 at 1 for 0.1" #() snd-test-neq
+ 10 10 "fmv1.snd" ind 0 #f "another name 9" 0 0 set-samples drop
0 20 ind 0 channel->vct
vct( 0 0 0 0 0 0 0 0 0 0 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 )
- $" 9 set samples 0 at 1 for 0.1" #() snd-test-neq
+ "9 set samples 0 at 1 for 0.1" #() snd-test-neq
20 10 "fmv1.snd" set-samples drop
10 20 ind 0 channel->vct
20 0.5 make-vct
- $" 10 set samples 0 at 1 for 0.1" #() snd-test-neq
- 0 10 "fmv1.snd" ind 0 #t $" another name" 1 0 #f set-samples drop
- ind 0 frames 10 $" 11 set samples truncate" #() snd-test-neq
+ "10 set samples 0 at 1 for 0.1" #() snd-test-neq
+ 0 10 "fmv1.snd" ind 0 #t "another name" 1 0 #f set-samples drop
+ ind 0 framples 10 "11 set samples truncate" #() snd-test-neq
ind revert-sound drop
"fmv1.snd" file-delete
\ ;; now try to confuse it
- 0 10 "fmv1.snd" ind 0 <'> set-samples #t nil fth-catch to res
- stack-reset
- res car 'no-such-file $" set-samples, no such file" #() snd-test-neq
+ 0 10 "fmv1.snd" ind 0 <'> set-samples snd-test-catch to res
+ res car 'no-such-file "set-samples, no such file" #() snd-test-neq
"fmv1.snd" :channels 1 new-sound to nd
"fmv1.snd" nd save-sound-as drop
nd close-sound drop
- 0 10 "fmv1.snd" ind 0 #f $" another name" 1 <'> set-samples #t nil fth-catch to res
- stack-reset
- res car 'no-such-channel $" set-samples no such channel" #() snd-test-neq
- 0 10 "fmv1.snd" ind 0 #f $" another name" -1 <'> set-samples #t nil fth-catch to res
- stack-reset
- res car 'no-such-channel $" set-samples no such channel (-1)" #() snd-test-neq
- 0 -10 "fmv1.snd" <'> set-samples #t nil fth-catch to res
- stack-reset
- res car 'wrong-type-arg $" set-samples (-10)" #() snd-test-neq
- -10 10 "fmv1.snd" <'> set-samples #t nil fth-catch to res
- stack-reset
- res car 'no-such-sample $" set-samples (beg -10)" #() snd-test-neq
+ 0 10 "fmv1.snd" ind 0 #f "another name" 1 <'> set-samples
+ snd-test-catch to res
+ res car 'no-such-channel "set-samples no such channel" #() snd-test-neq
+ 0 10 "fmv1.snd" ind 0 #f "another name" -1 <'> set-samples
+ snd-test-catch to res
+ res car 'no-such-channel "set-samples no such channel (-1)" #() snd-test-neq
+ 0 -10 "fmv1.snd" <'> set-samples snd-test-catch to res
+ res car 'wrong-type-arg "set-samples (-10)" #() snd-test-neq
+ -10 10 "fmv1.snd" <'> set-samples snd-test-catch to res
+ res car 'no-such-sample "set-samples (beg -10)" #() snd-test-neq
ind close-sound drop
- \
+ \
100 { len }
#( #( mus-bshort 2 -15 f** )
#( mus-lshort 2 -15 f** )
@@ -2551,11 +2833,12 @@ black-and-white-colormap constant *better-colormap*
#( mus-bfloat 2 -23 f** )
#( mus-bdouble 2 -23 f** )
#( mus-ldouble 2 -23 f** ) ) { types }
- nil nil nil nil nil nil nil nil nil { v v0 v1 diff maxdiff maxpos typ allowed-diff val }
+ nil nil nil nil nil nil { v v0 v1 diff maxdiff maxpos }
+ nil nil nil { typ allowed-diff val }
types each to vals
vals 0 array-ref to typ
vals 1 array-ref to allowed-diff
- "test.snd" mus-next mus-bfloat 22050 1 new-sound to ind
+ "test.snd" 1 22050 mus-bfloat mus-next new-sound to ind
len 0.0 make-vct to v
0.0 to maxdiff
#f to maxpos
@@ -2572,95 +2855,98 @@ black-and-white-colormap constant *better-colormap*
1.9999 random to val
val 2.0 f>
val 0.0 f< || if
- $" random 2.0 -> %s?" #( val ) snd-display
+ "random 2.0 -> %s?" #( val ) snd-display
then
v i 1.0 val f- vct-set! drop
loop
v 0 len ind 0 vct->channel drop
- "test1.snd" ind mus-next :data-format typ save-sound-as drop
+ "test1.snd" ind :header-type mus-next :sample-type typ save-sound-as drop
ind close-sound drop
"test1.snd" open-sound to ind
0 len ind 0 channel->vct to v1
len 0 do
v i vct-ref v1 i vct-ref f- fabs to diff
diff maxdiff f> if
- diff to maxdiff
- i to maxpos
+ diff to maxdiff
+ i to maxpos
then
loop
maxdiff allowed-diff f> if
- $" %s: %s at %d (%s %s)?" #(
- typ mus-data-format-name
- maxdiff maxpos
- v maxpos vct-ref
- v1 maxpos vct-ref ) snd-display
+ "%s: %s at %d (%s %s)?"
+ #( typ mus-sample-type-name
+ maxdiff
+ maxpos
+ v maxpos vct-ref
+ v1 maxpos vct-ref ) snd-display
then
ind close-sound drop
end-each
- \
+ \
oboe-snd view-sound { ob }
1000 ob sample { samp }
oboe-snd mus-sound-comment { old-comment }
- $" written %s" #( $" %a %d-%b-%Y %H:%M %Z" current-time strftime ) string-format { str }
+ "written %s" #( "%a %d-%b-%Y %H:%M %Z" current-time strftime )
+ string-format { str }
ob str set-comment drop
- "test.snd" ob mus-aifc mus-bdouble <'> save-sound-as #t nil fth-catch to res
- stack-reset
- res car 'cannot-save $" save-sound-as test.snd write trouble" #() snd-test-eq
+ "test.snd" ob :header-type mus-aifc :sample-type mus-bdouble
+ <'> save-sound-as snd-test-catch to res
+ res car 'cannot-save "save-sound-as test.snd write trouble" #() snd-test-eq
#t set-filter-control-in-hz drop
"test.snd" open-sound { ab }
ab mus-aifc mus-bdouble samp sndlib-check-it
- "test.snd" mus-sound-comment str $" output-comment" #() snd-test-neq
- ab comment str $" output-comment (comment)" #() snd-test-neq
+ "test.snd" mus-sound-comment str "output-comment" #() snd-test-neq
+ ab comment str "output-comment (comment)" #() snd-test-neq
ab close-sound drop
- oboe-snd mus-sound-comment old-comment $" set-comment overwrote current" #() snd-test-neq
+ oboe-snd mus-sound-comment old-comment "set-comment overwrote current" #()
+ snd-test-neq
#f set-filter-control-in-hz drop
- \
- "test.snd" ob mus-raw save-sound-as drop
+ \
+ "test.snd" ob :header-type mus-raw save-sound-as drop
"test.snd" 1 22050 mus-bshort open-raw-sound to ab
ab mus-raw mus-bshort samp sndlib-check-it
ab close-sound drop
- \
- "test.snd" ob mus-nist mus-bint save-sound-as drop
+ \
+ "test.snd" ob :header-type mus-nist :sample-type mus-bint save-sound-as drop
"test.snd" open-sound to ab
ab mus-nist mus-bint samp sndlib-check-it
ab close-sound drop
- \
+ \
output-comment-hook reset-hook!
output-comment-hook <'> sndlib-check-string add-hook!
- :file "test.snd" :sound ob :header-type mus-riff :data-format mus-lfloat save-sound-as drop
+ "test.snd" ob :header-type mus-riff :sample-type mus-lfloat save-sound-as drop
output-comment-hook reset-hook!
"test.snd" open-sound to ab
ab mus-riff mus-lfloat samp sndlib-check-it
- ab comment str $" [written by me]" $+ "output-comment-hook" #() snd-test-neq
+ ab comment str " [written by me]" $+ "output-comment-hook" #() snd-test-neq
ab close-sound drop
#( #( mus-aiff mus-b24int )
#( mus-ircam mus-mulaw )
#( mus-next mus-alaw )
- #( mus-next mus-bdouble ) ) to types
+ #( mus-next mus-ldouble ) ) to types
nil { fmt }
types each to vals
vals 0 array-ref to typ
vals 1 array-ref to fmt
- "test.snd" ob typ fmt save-sound-as drop
+ "test.snd" ob :header-type typ :sample-type fmt save-sound-as drop
"test.snd" open-sound to ab
ab typ fmt samp sndlib-check-it
ab close-sound drop
end-each
- "test.snd" ob mus-next mus-bshort save-sound-as drop
+ "test.snd" ob :header-type mus-next :sample-type mus-bshort save-sound-as drop
"test.snd" open-sound to ab
ab mus-next mus-bshort samp sndlib-check-it
update-hook reset-hook!
'( -3.0 3.0 ) ab 0 set-y-bounds drop
- ab mus-lshort set-data-format drop
+ ab mus-lshort set-sample-type drop
\ ; these set!'s can change the index via update-sound
"test.snd" find-sound to ab
- ab data-format to fmt
- fmt mus-lshort $" set-data-format %s" #( fmt mus-data-format-name ) snd-test-neq
- ab 0 y-bounds '( -3.0 3.0 ) $" set data format y-bounds" #() snd-test-neq
+ ab sample-type to fmt
+ fmt mus-lshort "set-sample-type %s" #( fmt mus-sample-type-name ) snd-test-neq
+ ab 0 y-bounds '( -3.0 3.0 ) "set data format y-bounds" #() snd-test-neq
'( 2.0 ) ab 0 set-y-bounds drop
- ab 0 y-bounds '( -2.0 2.0 ) $" set data format y-bounds 1" #() snd-test-neq
+ ab 0 y-bounds '( -2.0 2.0 ) "set data format y-bounds 1" #() snd-test-neq
'( -2.0 ) ab 0 set-y-bounds drop
- ab 0 y-bounds '( -2.0 2.0 ) $" set data format y-bounds -2" #() snd-test-neq
+ ab 0 y-bounds '( -2.0 2.0 ) "set data format y-bounds -2" #() snd-test-neq
ab mus-aifc set-header-type drop
"test.snd" find-sound to ab
ab header-type mus-aifc "set-header-type" #() snd-test-neq
@@ -2679,18 +2965,18 @@ black-and-white-colormap constant *better-colormap*
"test.snd" find-sound to ab
ab srate 12345 "set-srate" #() snd-test-neq
ab close-sound drop
- \
- "test.snd" ob mus-next mus-bfloat save-sound-as drop
+ \
+ "test.snd" ob :header-type mus-next :sample-type mus-bfloat save-sound-as drop
"test.snd" open-sound to ab
ab mus-next mus-bfloat samp sndlib-check-it
ab close-sound drop
- \
- "test.snd" ob mus-next mus-bshort save-sound-as drop
+ \
+ "test.snd" ob :header-type mus-next :sample-type mus-bshort save-sound-as drop
ob close-sound drop
"test.snd" open-sound to ab
- mus-lshort set-data-format drop
+ mus-lshort set-sample-type drop
"test.snd" find-sound to ab
- data-format mus-lshort "set-data-format" #() snd-test-neq
+ sample-type mus-lshort "set-sample-type" #() snd-test-neq
mus-aifc set-header-type drop
"test.snd" find-sound to ab
header-type mus-aifc "set-header-type" #() snd-test-neq
@@ -2704,55 +2990,70 @@ black-and-white-colormap constant *better-colormap*
"test.snd" find-sound to ab
srate 12345 "set-srate" #() snd-test-neq
ab close-sound drop
- \
+ \
"2a.snd" open-sound to ind
- "test.snd" :data-format mus-l24int :header-type mus-riff :channel 0 save-sound-as drop
+ "test.snd" :sample-type mus-l24int :header-type mus-riff
+ :channel 0 save-sound-as drop
"test.snd" open-sound { ind0 }
- ind0 channels 1 $" save-sound-as :channel 0 chans" #() snd-test-neq
- ind0 data-format mus-l24int $" save-sound-as :channel 0 data-format" #() snd-test-neq
- ind0 header-type mus-riff $" save-sound-as :channel 0 header-type" #() snd-test-neq
- ind0 srate ind srate $" save-sound-as :channel 0 srates" #() snd-test-neq
- ind0 frames ind 0 undef frames $" save-sound-as :channel 0 frames" #() snd-test-neq
- ind0 maxamp ind 0 undef maxamp $" save-sound-as :channel 0 maxamps" #() snd-test-neq
+ ind0 channels 1 "save-sound-as :channel 0 chans" #() snd-test-neq
+ ind0 sample-type mus-l24int "save-sound-as :channel 0 sample-type" #()
+ snd-test-neq
+ ind0 header-type mus-riff "save-sound-as :channel 0 header-type" #()
+ snd-test-neq
+ ind0 srate ind srate "save-sound-as :channel 0 srates" #() snd-test-neq
+ ind0 framples ind 0 undef framples "save-sound-as :channel 0 framples" #()
+ snd-test-neq
+ ind0 maxamp ind 0 undef maxamp "save-sound-as :channel 0 maxamps" #()
+ snd-test-neq
ind0 close-sound drop
- \
- "test.snd" :data-format mus-bfloat :header-type mus-aifc :channel 1 :srate 12345 save-sound-as drop
+ \
+ "test.snd" :sample-type mus-bfloat :header-type mus-aifc :channel 1
+ :srate 12345 save-sound-as drop
"test.snd" open-sound to ind0
- ind0 channels 1 $" save-sound-as :channel 1 chans" #() snd-test-neq
- ind0 data-format mus-bfloat $" save-sound-as :channel 1 data-format" #() snd-test-neq
- ind0 header-type mus-aifc $" save-sound-as :channel 1 header-type" #() snd-test-neq
- ind0 srate 12345 $" save-sound-as :channel 1 srates" #() snd-test-neq
- ind0 frames ind 1 undef frames $" save-sound-as :channel 1 frames" #() snd-test-neq
- ind0 maxamp ind 1 undef maxamp $" save-sound-as :channel 1 maxamps" #() snd-test-neq
+ ind0 channels 1 "save-sound-as :channel 1 chans" #() snd-test-neq
+ ind0 sample-type mus-bfloat "save-sound-as :channel 1 sample-type" #()
+ snd-test-neq
+ ind0 header-type mus-aifc "save-sound-as :channel 1 header-type" #()
+ snd-test-neq
+ ind0 srate 12345 "save-sound-as :channel 1 srates" #() snd-test-neq
+ ind0 framples ind 1 undef framples "save-sound-as :channel 1 framples" #()
+ snd-test-neq
+ ind0 maxamp ind 1 undef maxamp "save-sound-as :channel 1 maxamps" #()
+ snd-test-neq
ind0 close-sound drop
- \
- "test.snd" :channel 1 :comment $" this is a test" save-sound-as drop
+ \
+ "test.snd" :channel 1 :comment "this is a test" save-sound-as drop
"test.snd" open-sound to ind0
- ind0 channels 1 $" save-sound-as :channel 1 (1) chans" #() snd-test-neq
- ind0 data-format ind data-format $" save-sound-as :channel 1 (1) data-format" #() snd-test-neq
- ind0 header-type ind header-type $" save-sound-as :channel 1 (1) header-type" #() snd-test-neq
- ind0 srate ind srate $" save-sound-as :channel 1 (1) srates" #() snd-test-neq
- ind0 frames ind 1 undef frames $" save-sound-as :channel 1 (1) frames" #() snd-test-neq
- ind0 0 maxamp ind 1 undef maxamp $" save-sound-as :channel 1 (1) maxamps" #() snd-test-neq
- ind0 comment $" this is a test" $" save-sound-as :channel 1 (1) comment" #() snd-test-neq
+ ind0 channels 1 "save-sound-as :channel 1 (1) chans" #() snd-test-neq
+ ind0 sample-type ind sample-type
+ "save-sound-as :channel 1 (1) sample-type" #() snd-test-neq
+ ind0 header-type ind header-type
+ "save-sound-as :channel 1 (1) header-type" #() snd-test-neq
+ ind0 srate ind srate "save-sound-as :channel 1 (1) srates" #() snd-test-neq
+ ind0 framples ind 1 undef framples
+ "save-sound-as :channel 1 (1) framples" #() snd-test-neq
+ ind0 0 maxamp ind 1 undef maxamp
+ "save-sound-as :channel 1 (1) maxamps" #() snd-test-neq
+ ind0 comment "this is a test"
+ "save-sound-as :channel 1 (1) comment" #() snd-test-neq
ind0 close-sound drop
ind close-sound drop
- \
+ \
"t15.aiff" check-file-name to fsnd
fsnd file-exists? if
fsnd open-sound to ind
- 132300 ind 0 sample 0.148 $" aifc sowt trouble (0)" #() snd-test-neq
- 132300 ind 1 sample 0.126 $" aifc sowt trouble (1)" #() snd-test-neq
+ 132300 ind 0 sample 0.148 "aifc sowt trouble (0)" #() snd-test-neq
+ 132300 ind 1 sample 0.126 "aifc sowt trouble (1)" #() snd-test-neq
ind close-sound drop
then
"M1F1-float64C-AFsp.aif" check-file-name to fsnd
fsnd file-exists? if
fsnd open-sound to ind
- 8000 ind 0 sample -0.024 $" aifc fl64 trouble (0)" #() snd-test-neq
- 8000 ind 1 sample 0.021 $" aifc fl64 trouble (1)" #() snd-test-neq
+ 8000 ind 0 sample -0.024 "aifc fl64 trouble (0)" #() snd-test-neq
+ 8000 ind 1 sample 0.021 "aifc fl64 trouble (1)" #() snd-test-neq
ind close-sound drop
then
- \
+ \
#( #( "bad_chans.snd" 0 22050 0 )
#( "bad_srate.snd" 1 0 0 )
#( "bad_data_format.snd" 1 22050 4411 )
@@ -2772,51 +3073,52 @@ black-and-white-colormap constant *better-colormap*
vals 3 array-ref to fr
fsnd file-exists? if
fsnd <'> mus-sound-chans #t nil fth-catch ?dup-if
- car 'mus-error <> if
- $" %s: chans %d (%s)" #( fsnd fc res ) snd-display
- then
- stack-reset
+ car 'mus-error <> if
+ "%s: chans %d (%s)" #( fsnd fc res ) snd-display
+ then
else
- fc <> if
- $" %s: chans %d (%s)" #( fsnd fc res ) snd-display
- then
+ fc <> if
+ "%s: chans %d (%s)" #( fsnd fc res ) snd-display
+ then
+ stack-reset
then
\
fsnd <'> mus-sound-srate #t nil fth-catch ?dup-if
- car 'mus-error <> if
- $" %s: srate %d (%s)" #( fsnd fs res ) snd-display
- then
- stack-reset
+ car 'mus-error <> if
+ "%s: srate %d (%s)" #( fsnd fs res ) snd-display
+ then
+ stack-reset
else
- fs <> if
- $" %s: srate %d (%s)" #( fsnd fs res ) snd-display
- then
+ fs <> if
+ "%s: srate %d (%s)" #( fsnd fs res ) snd-display
+ then
then
\
- fsnd <'> mus-sound-frames #t nil fth-catch ?dup-if
- car 'mus-error <> if
- $" %s: frames %d (%s)" #( fsnd fr res ) snd-display
- then
- stack-reset
+ fsnd <'> mus-sound-framples #t nil fth-catch ?dup-if
+ car 'mus-error <> if
+ "%s: framples %d (%s)" #( fsnd fr res ) snd-display
+ then
+ stack-reset
else
- fr <> if
- $" %s: frames %d (%s)" #( fsnd fr res ) snd-display
- then
+ fr <> if
+ "%s: framples %d (%s)" #( fsnd fr res ) snd-display
+ then
then
- then
+ then \ file-exists?
end-each
- \
- "/usr/include/sys/" file-pwd $+ "/oboe.snd" $+ <'> open-sound #t nil fth-catch ?dup-if
- 1 >list $" open-sound with slashes: %s" swap snd-display
+ \
+ "/usr/include/sys/" file-pwd $+ "/oboe.snd" $+
+ <'> open-sound #t nil fth-catch ?dup-if
+ 1 >list "open-sound with slashes: %s" swap snd-display
stack-reset
- else
+ else \ open-sound with slashes
to ind
ind sound? if
ind short-file-name "oboe.snd" string<> if
- $" open-sound with slashes: %s" #( ind short-file-name ) snd-display
+ "open-sound with slashes: %s" #( ind short-file-name ) snd-display
then
else
- $" open-sound with slashes: %s" #( ind ) snd-display
+ "open-sound with slashes: %s" #( ind ) snd-display
then
bad-header-hook <'> sndlib-true-cb add-hook!
#( "bad_chans.snd"
@@ -2832,174 +3134,18 @@ black-and-white-colormap constant *better-colormap*
"bad_srate.nist"
"bad_length.nist" ) each check-file-name to fsnd
fsnd file-exists? if
- fsnd <'> insert-sound #t nil fth-catch stack-reset
- fsnd <'> convolve-with #t nil fth-catch stack-reset
- fsnd <'> mix #t nil fth-catch stack-reset
- fsnd <'> sndlib-check-bad-file #t nil fth-catch stack-reset
+ fsnd <'> insert-sound snd-test-catch drop
+ fsnd <'> convolve-with snd-test-catch drop
+ fsnd <'> mix snd-test-catch drop
+ fsnd <'> sndlib-check-bad-file snd-test-catch drop
then
end-each
ind close-sound drop
- then
- sounds each ( snd ) close-sound end-each
- \
- "oboe.snd" open-sound { ob }
- channel->vct vct->sound-data { sd }
- sd sound-data-maxamp { mx }
- sd sound-data-length 50828 $" oboe->sd: len" #() snd-test-neq
- sd 0 1000 sound-data-ref 0.0328369 $" oboe->sd[1000]" #() snd-test-neq
- mx length 1 $" sound-data-maxamp oboe.snd" #() snd-test-neq
- ob 0 maxamp mx car $" sound-data-maxamp oboe.snd" #() snd-test-neq
- sd sound-data-peak mx car $" sound-data-peak oboe.snd" #() snd-test-neq
- 1 <'> set-selected-channel #t nil fth-catch to res
- stack-reset
- res car 'no-such-channel $" set selected-channel bad chan: %s" #( res ) snd-test-neq
- 123456 1 <'> set-selected-channel #t nil fth-catch to res
- stack-reset
- res car 'no-such-sound $" set selected-channel bad snd: %s" #( res ) snd-test-neq
- sd 2 1000 <'> sound-data-ref #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data-ref bad chan: %s" #( res ) snd-test-neq
- sd -1 1000 <'> sound-data-ref #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data-ref bad chan -1: %s" #( res ) snd-test-neq
- sd 0 -1 <'> sound-data-ref #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data-ref bad frame: %s" #( res ) snd-test-neq
- sd 0 10000000 <'> sound-data-ref #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data-ref bad frame high: %s" #( res ) snd-test-neq
- sd 2 1000 1 <'> sound-data-set! #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data-set! bad chan: %s" #( res ) snd-test-neq
- sd 0 10000000 1 <'> sound-data-set! #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data-set! bad frame: %s" #( res ) snd-test-neq
- 3 make-vct to v
- v sd 2 <'> vct->sound-data #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" vct->sound-data-set! bad chan: %s" #( res ) snd-test-neq
- ob close-sound drop
- selected-sound if
- $" selected-sound %s %s" #( selected-sound sounds ) snd-display
- then
- "a.sf2" check-file-name to fsnd
- fsnd file-exists? if
- fsnd open-sound { fil }
- fil soundfont-info { loops }
- loops nil?
- loops car caddr 65390 <> ||
- loops cadr cadr 65490 <> || if
- $" soundfont-info: %s" #( loops ) snd-display
- then
- fil close-sound drop
- then
- \
- "fmv5.snd" file-delete
- "fmv5.snd" 22050 1 mus-bshort mus-aiff $" no comment" mus-sound-open-output { fd }
- 1 100 make-sound-data { sdata }
- 100 0 do
- sdata 0 i i 0.01 f* sound-data-set! drop
- loop
- 12 set-print-length drop
- sdata object->string { sdata-str }
- $" #<sound-data[chans=1, length=100]:\n (0.000 0.010 0.020 0.030 0.040 0.050 0.060 0.070 0.080 0.090 0.100 0.110 ...)>"
- sdata-str $" print sound-data" #() snd-test-neq
- sdata { edat }
- 1 100 make-sound-data { edat1 }
- 2 100 make-sound-data { edat2 }
- sdata edat $" sound-data not equal?" #() snd-test-neq
- sdata edat1 $" sound-data 1 equal?" #() snd-test-eq
- edat2 edat1 $" sound-data 2 equal?" #() snd-test-eq
- 100 0 do
- edat1 0 i sdata 0 i sound-data-ref sound-data-set! drop
- loop
- sdata edat1 $" sound-data 3 not equal?" #() snd-test-neq
- 100 make-vct to v0
- 3 make-vct to v1
- sdata 0 v0 sound-data->vct drop
- v0 10 vct-ref 0.1 $" sound-data->vct" #() snd-test-neq
- sdata 0 v1 sound-data->vct drop
- v1 1 vct-ref 0.01 $" sound-data->(small)vct" #() snd-test-neq
- v0 sdata 0 vct->sound-data drop
- sdata 0 10 sound-data-ref 0.1 $" vct->sound-data" #() snd-test-neq
- sdata #( 0 10 ) object-apply 0.1 $" vct->sound-data applied" #() snd-test-neq
- sdata 2 v0 <'> sound-data->vct #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data->vct bad chan" #() snd-test-neq
- 1 3 3 make-sound-data 123 <'> mus-audio-write #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-audio-write bad frames" #() snd-test-neq
- 10 make-vct to v0
- 3 make-vct to v
- 2 10 make-sound-data { sdata2 }
- 10 0 do
- sdata2 0 i 0.1 sound-data-set! drop
- sdata2 1 i 0.2 sound-data-set! drop
- loop
- sdata2 0 v0 sound-data->vct drop
- sdata2 0 v sound-data->vct drop
- v0 1 vct-ref 0.1 $" sound-data->vct[1]" #() snd-test-neq
- sdata2 1 v0 sound-data->vct drop
- v0 1 vct-ref 0.2 $" sound-data->vct[2]" #() snd-test-neq
- v0 sdata2 0 vct->sound-data drop
- sdata2 0 1 sound-data-ref 0.2 $" vct->sound-data[2]" #() snd-test-neq
- v0 0.3 vct-fill! drop
- v0 sdata2 1 vct->sound-data drop
- sdata2 1 1 sound-data-ref 0.3 $" vct->sound-data[3]" #() snd-test-neq
- v sdata2 0 vct->sound-data drop
- fd 0 99 1 sdata mus-sound-write drop
- fd mus-bshort mus-bytes-per-sample 100 * mus-sound-close-output drop
- "fmv5.snd" 1 mus-bshort mus-aiff "fmv5.snd" mus-sound-data-location mus-sound-reopen-output to fd
- fd mus-bshort mus-bytes-per-sample 100 * mus-sound-close-output drop
- "fmv5.snd" mus-sound-open-input to fd
- fd 0 99 1 sdata mus-sound-read drop
- sdata 0 10 sound-data-ref 0.1 $" mus-sound-write" #() snd-test-neq
- fd 20 mus-sound-seek-frame { pos }
- \ FIXME
- \ fd io-fdopen io-tell pos $" 1 mus-sound-seek-frame" #() snd-test-neq
- "fmv5.snd" 20 frame->byte pos $" 2 mus-sound-seek-frame(2)" #() snd-test-neq
- fd 0 10 1 sdata mus-sound-read drop
- sdata 0 0 sound-data-ref 0.2 $" 2 mus-sound-seek" #() snd-test-neq
- fd mus-sound-close-input drop
- \
- 2 10 make-sound-data to sd
- 10 0.25 make-vct sd 0 vct->sound-data drop
- 10 0.50 make-vct sd 1 vct->sound-data drop
- sd 2.0 sound-data-scale! drop
- sd 0 sound-data->vct 10 0.5 make-vct $" sound-data-scale! chan 0" #() snd-test-neq
- sd 1 sound-data->vct 10 1.0 make-vct $" sound-data-scale! chan 1" #() snd-test-neq
- \
- 2 10 make-sound-data to sd
- sd 2.0 sound-data-fill! drop
- sd 0 sound-data->vct 10 2.0 make-vct $" sound-data-fill! chan 0" #() snd-test-neq
- sd 1 sound-data->vct 10 2.0 make-vct $" sound-data-fill! chan 1" #() snd-test-neq
- \
- "fmv.snd" 22050 -1 mus-bshort mus-aiff $" no comment" <'> mus-sound-open-output #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-sound-open-output bad chans" #() snd-test-neq
- "fmv.snd" 22050 1 -1 mus-aiff $" no comment" <'> mus-sound-open-output #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-sound-open-output bad format" #() snd-test-neq
- "fmv.snd" 22050 1 mus-bshort -1 $" no comment" <'> mus-sound-open-output #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-sound-open-output bad type" #() snd-test-neq
- \
- "fmv.snd" -1 mus-bshort mus-aiff #f <'> mus-sound-reopen-output #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-sound-reopen-output bad chans" #() snd-test-neq
- "fmv.snd" 1 -1 mus-aiff #f <'> mus-sound-reopen-output #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-sound-reopen-output bad format" #() snd-test-neq
- "fmv.snd" 1 mus-bshort -1 #f <'> mus-sound-reopen-output #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-sound-reopen-output bad type" #() snd-test-neq
- \
- 2 10 make-sound-data to sd
- \ FIXME
- \ S7 fill! tests skipped
- sd object-copy { sd1 }
- sd sd1 $" object-copy sd" #() snd-test-neq
- \
+ then \ open-sound with slashes
+ sounds each ( snd )
+ close-sound
+ end-each
+ \
#( "trunc.snd"
"trunc.aiff"
"trunc.wav"
@@ -3010,8 +3156,7 @@ black-and-white-colormap constant *better-colormap*
"trunc1.aiff"
"badform.aiff" ) each check-file-name to fsnd
fsnd file-exists? if
- fsnd <'> open-sound #t nil fth-catch to res
- stack-reset
+ fsnd <'> open-sound snd-test-catch to res
res car 'mus-error "open-sound" #() snd-test-neq
then
end-each
@@ -3019,224 +3164,17 @@ black-and-white-colormap constant *better-colormap*
"empty.snd" check-file-name to fsnd
fsnd file-exists? if
fsnd open-sound to ind
- ind data-format mus-bshort $" open raw data-format" #() snd-test-neq
- ind chans 1 $" open raw chans" #() snd-test-neq
- ind srate 22050 $" open raw srate" #() snd-test-neq
- ind data-location 0 $" open raw data-location" #() snd-test-neq
- ind frames 0 $" open raw frames" #() snd-test-neq
+ ind sample-type mus-bshort "open raw sample-type" #() snd-test-neq
+ ind chans 1 "open raw chans" #() snd-test-neq
+ ind srate 22050 "open raw srate" #() snd-test-neq
+ ind data-location 0 "open raw data-location" #() snd-test-neq
+ ind framples 0 "open raw framples" #() snd-test-neq
ind close-sound drop
then
open-raw-sound-hook reset-hook!
- \
- 1 32 make-sound-data to sd1
- 2 64 make-sound-data { sd2 }
- 32 0 do
- sd1 0 i i 0.01 f* sound-data-set! drop
- loop
- 64 0 do
- sd2 0 i i 0.1 f* sound-data-set! drop
- sd2 1 i i 0.2 f* sound-data-set! drop
- loop
- sd2 sd1 3 6 32 sound-data->sound-data drop
- sd1 0 0 sound-data-ref 0.00 $" sound-data->sound-data 0" #() snd-test-neq
- sd1 0 2 sound-data-ref 0.02 $" sound-data->sound-data 2" #() snd-test-neq
- sd1 0 3 sound-data-ref 0.00 $" sound-data->sound-data 3" #() snd-test-neq
- sd1 0 6 sound-data-ref 0.30 $" sound-data->sound-data 6" #() snd-test-neq
- sd1 0 10 sound-data-ref 0.10 $" sound-data->sound-data 10" #() snd-test-neq
- sd1 sd2 0 10 32 sound-data->sound-data drop
- sd2 0 5 sound-data-ref 0.20 $" sound-data->sound-data 2 5" #() snd-test-neq
- 1 32 make-sound-data { sdi }
- 1 32 make-sound-data { sdo }
- sdi sdo 10 32 10 sound-data->sound-data to res
- res 2 $" sound-data->sound-data wrap around" #() snd-test-neq
- sdi sdo 10 32 32 sound-data->sound-data to res
- res 10 $" sound-data->sound-data wrap around" #() snd-test-neq
- \
- sdi sdo -1 10 10 <'> sound-data->sound-data #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data->sound-data start" #() snd-test-neq
- sdi sdo 0 -1 10 <'> sound-data->sound-data #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data->sound-data frames" #() snd-test-neq
- sdi sdo 0 128 10 <'> sound-data->sound-data #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" sound-data->sound-data frames" #() snd-test-neq
- \
- 1 1 make-sound-data to sd
- sd 0 0 sound-data-ref 0.0 $" sound-data ref" #() snd-test-neq
- sd 0 0 1.0 sound-data-set! drop
- sd 0 0 sound-data-ref 1.0 $" sound-data set" #() snd-test-neq
- 1 1 make-sound-data to sd1
- sd1 0 0 1.0 sound-data-set! drop
- sd sd1 $" sound-data set not equal" #() snd-test-neq
- \
- 2 3 make-sound-data to sd
- sd 0 0 sound-data-ref 0.0 $" sound-data ref (1)" #() snd-test-neq
- sd 1 0 1.0 sound-data-set! drop
- sd 1 0 sound-data-ref 1.0 $" sound-data set (1 0)" #() snd-test-neq
- sd 1 2 2.0 sound-data-set! drop
- sd 1 2 sound-data-ref 2.0 $" sound-data set (1 2)" #() snd-test-neq
- 2 3 make-sound-data to sd1
- sd1 1 0 1.0 sound-data-set! drop
- sd1 1 2 2.0 sound-data-set! drop
- sd sd1 $" sound-data set (3) not equal" #() snd-test-neq
- \
- #( #( mus-bshort mus-next )
- #( mus-bfloat mus-aifc )
- #( mus-lshort mus-aifc )
- #( mus-lfloat mus-riff )
- #( mus-lshort mus-nist )
- #( mus-bint mus-aiff )
- #( mus-lint mus-next )
- #( mus-bintn mus-next )
- #( mus-lintn mus-next )
- #( mus-b24int mus-aifc )
- #( mus-l24int mus-riff )
- #( mus-bfloat mus-ircam )
- #( mus-bfloat-unscaled mus-next )
- #( mus-lfloat-unscaled mus-next )
- #( mus-bdouble-unscaled mus-next )
- #( mus-ldouble-unscaled mus-next )
- #( mus-bdouble mus-next )
- #( mus-ldouble mus-next )
- #( mus-ulshort mus-next )
- #( mus-ubshort mus-next ) ) to formats
- nil nil nil nil { df ht samps ndata }
- #( 1 2 4 8 ) each to chns
- formats each to vals
- vals 0 array-ref to df
- vals 1 array-ref to ht
- chns 1 = if
- 100000
- else
- chns 2 = if
- 50000
- else
- 1000
- then
- then to samps
- "fmv5.snd" file-delete
- "fmv5.snd" 22050 chns df ht $" no comment" mus-sound-open-output to fd
- chns samps make-sound-data to sdata
- chns samps make-sound-data to ndata
- chns 0 do
- samps 0 do
- sdata j ( chn ) i ( samp ) 2.0 random 1.0 f- sound-data-set! drop
- loop
- loop
- fd 0 samps 1- chns sdata mus-sound-write drop
- fd samps chns * df mus-bytes-per-sample * mus-sound-close-output drop
- "fmv5.snd" mus-sound-open-input to fd
- fd 0 samps 1- chns ndata mus-sound-read drop
- fd 100 mus-sound-seek-frame to pos
- \ FIXME
- \ fd io-fdopen io-tell pos $" mus-sound-seek-frame[%d]: chans %d" #( pos chns ) snd-test-neq
- "fmv5.snd" 100 frame->byte pos "mus-sound-seek-frame(100)" #() snd-test-neq
- fd mus-sound-close-input drop
- #f ( flag )
- chns 0 do
- samps 0 do
- sdata j ( chn ) i ( samp ) sound-data-ref
- ndata j ( chn ) i ( samp ) sound-data-ref fneq if
- sdata j ( chn ) i ( samp ) sound-data-ref
- ndata j ( chn ) i ( samp ) sound-data-ref
- $" read-write trouble: format %s header %s " #(
- df mus-data-format-name
- ht mus-header-type-name ) snd-test-neq
- not ( toggle flag )
- leave
- then
- loop
- dup ( check flag ) ?leave
- loop
- ( flag ) drop
- end-each
- end-each
- \
- "oboe.snd" open-sound to ind
- 0 22050 1 little-endian? if mus-lshort else mus-bshort then 512 mus-audio-open-input to fd
- 1 256 make-sound-data to sdata
- 256 make-vct to v
- fd -1 = if
- $" can't open audio input port!" #() snd-display
- else
- 10 0 do
- fd sdata 256 mus-audio-read drop
- sdata 0 v sound-data->vct graph drop
- loop
- fd mus-audio-close drop
- then
- ind close-sound drop
- \
- "fmv.snd" 22050 1 mus-bshort mus-next $" no comment" mus-sound-open-output to fd
- 1 10 make-sound-data to sdata
- sdata 0 1 0.1 sound-data-set! drop
- fd 0 9 1 sdata mus-sound-write drop
- fd 20 mus-sound-close-output drop
- "fmv.snd" mus-sound-open-input to fd
- fd 0 9 1 sdata mus-sound-read drop
- sdata 0 0 sound-data-ref 0.0 fneq
- sdata 0 1 sound-data-ref 0.1 fneq ||
- sdata 0 2 sound-data-ref 0.0 fneq ||
- sdata 0 6 sound-data-ref 0.0 fneq || if
- $" read/write: %s?" #( sdata sound-data->list ) snd-display
- then
- fd mus-sound-close-input drop
- "fmv.snd" 1 mus-bshort mus-next "fmv.snd" mus-sound-data-location mus-sound-reopen-output to fd
- fd 0 mus-sound-seek-frame drop
- sdata 0 2 0.1 sound-data-set! drop
- sdata 0 3 0.1 sound-data-set! drop
- fd 0 9 1 sdata mus-sound-write drop
- fd 20 mus-sound-close-output drop
- "fmv.snd" mus-sound-open-input to fd
- 1 10 make-sound-data to ndata
- fd 0 9 1 ndata mus-sound-read drop
- ndata 0 0 sound-data-ref 0.0 fneq
- ndata 0 1 sound-data-ref 0.1 fneq ||
- ndata 0 2 sound-data-ref 0.1 fneq ||
- ndata 0 3 sound-data-ref 0.1 fneq ||
- ndata 0 6 sound-data-ref 0.0 fneq || if
- ndata sound-data->list sdata sound-data->list "!=" "re-read/write" #() snd-format #() snd-display
- then
- fd mus-sound-close-input drop
- \ ;; check clipping choices
- "oboe.snd" view-sound to ind
- #f set-clipping drop
- <'> sndlib-test-map-10-times-cb 0 ind 0 undef frames ind 0 map-channel drop
- "test.snd" ind mus-next mus-bfloat save-sound-as drop
- 1 ind 0 undo drop
- "test.snd" open-sound { ind1 }
- ind1 0 undef maxamp ind 0 undef maxamp 10.0 f* $" clipping 0" #() snd-test-neq
- ind1 close-sound drop
- "test.snd" file-delete
- #t set-clipping drop
- <'> sndlib-test-map-10-times-cb 0 ind 0 undef frames ind 0 map-channel drop
- "test.snd" ind mus-next mus-bfloat save-sound-as drop
- 1 ind 0 undo drop
- "test.snd" open-sound to ind1
- ind1 0 undef maxamp 1.0 $" clipping 1" #() snd-test-neq
- ind1 close-sound drop
- "test.snd" file-delete
- #f set-clipping drop
- ind maxamp to mx
- mx sndlib-test-map-add-cb 0 ind 0 undef frames ind 0 map-channel drop
- "test.snd" ind mus-next mus-bshort save-sound-as drop
- "test.snd" open-sound to ind1
- <'> f0< 1 make-proc scan-channel not #f $" clipping 2" #() snd-test-neq
- ind1 close-sound drop
- "test.snd" file-delete
- #t set-clipping drop
- "test.snd" ind mus-next mus-bshort save-sound-as drop
- "test.snd" open-sound to ind1
- <'> f0< 1 make-proc scan-channel #f $" clipping 3" #() snd-test-neq
- ind1 close-sound drop
- "test.snd" file-delete
- #f set-clipping drop
- ind close-sound drop
- "fmv.snd" file-delete
- \
+ \
#f set-clipping drop
- "test.snd" :data-format mus-lshort new-sound { snd }
+ "test.snd" :sample-type mus-lshort new-sound { snd }
0 10 pad-channel drop
1 1.0000 set-sample drop
2 -1.0000 set-sample drop
@@ -3251,13 +3189,13 @@ black-and-white-colormap constant *better-colormap*
snd close-sound drop
"test.snd" open-sound to snd
0 10 channel->vct
- vct( 0.000 1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000 )
- $" unclipped 1" #() snd-test-neq
+ vct( 0.000 1.000 -1.000 1.000 0.000 0.000 -0.700 0.700 -0.200 0.200 )
+ "unclipped 1" #() snd-test-neq
snd close-sound drop
"test.snd" mus-sound-forget drop
- \
+ \
#t set-clipping drop
- "test.snd" :data-format mus-lshort new-sound to snd
+ "test.snd" :sample-type mus-lshort new-sound to snd
0 10 pad-channel drop
1 1.0000 set-sample drop
2 -1.0000 set-sample drop
@@ -3273,425 +3211,375 @@ black-and-white-colormap constant *better-colormap*
"test.snd" open-sound to snd
0 10 channel->vct
vct( 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000 )
- $" clipped" #() snd-test-neq
+ "clipped" #() snd-test-neq
snd close-sound drop
\
- vct( 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8 ) { data }
- data vct->sound-data to sdata
- "test.snd" 22050 1 mus-lshort mus-riff $" a comment" mus-sound-open-output to snd
- snd #f set-mus-file-clipping drop
- snd 0 9 1 sdata mus-sound-write drop
- snd 40 mus-sound-close-output drop
- "test.snd" open-sound to snd
- 0 10 channel->vct
- vct( 0.000 -1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000 )
- $" unclipped 2" #() snd-test-neq
- snd close-sound drop
- "test.snd" mus-sound-forget drop
+ #( #( "next-dbl.snd" 10 10
+ vct( 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344 ) )
+ #( "oboe.ldbl" 1000 10
+ vct( 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004 ) )
+ #( "next-flt.snd" 10 10
+ vct( 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344 ) )
+ #( "clbonef.wav" 1000 10
+ vct( 0.111 0.101 0.07 0.032 -0.014 -0.06 -0.085 -0.108 -0.129 -0.152 ) )
+ #( "next-8.snd" 10 10
+ vct( 0.898 0.945 0.977 0.992 0.992 0.977 0.945 0.906 0.844 0.773 ) )
+ #( "o2_u8.wave" 1000 10
+ vct( -0.164 -0.219 -0.258 -0.242 -0.18 -0.102 -0.047 0.0 0.039 0.055 ) )
+ #( "next-16.snd" 1000 10
+ vct( -0.026 -0.022 -0.024 -0.03 -0.041
+ -0.048 -0.05 -0.055 -0.048 -0.033 ) )
+ #( "o2.wave" 1000 10
+ vct( -0.160 -0.216 -0.254 -0.239 -0.175
+ -0.102 -0.042 0.005 0.041 0.059 ) )
+ #( "o2_18bit.aiff" 1000 10
+ vct( -0.160 -0.216 -0.254 -0.239 -0.175
+ -0.102 -0.042 0.005 0.041 0.059 ) )
+ #( "o2_12bit.aiff" 1000 10
+ vct( -0.160 -0.216 -0.254 -0.239 -0.175
+ -0.102 -0.042 0.005 0.041 0.059 ) )
+ #( "next24.snd" 1000 10
+ vct( -0.160 -0.216 -0.254 -0.239 -0.175
+ -0.102 -0.042 0.005 0.041 0.059 ) )
+ #( "mono24.wav" 1000 10
+ vct( 0.005 0.010 0.016 0.008 -0.007
+ -0.018 -0.025 -0.021 -0.005 0.001 ) )
+ #( "o2_711u.wave" 1000 10
+ vct( -0.164 -0.219 -0.254 -0.242 -0.172
+ -0.103 -0.042 0.005 0.042 0.060 ) )
+ #( "alaw.wav" 1000 10
+ vct( -0.024 -0.048 -0.024 0.0 0.008 0.008 0.000 -0.040 -0.064 -0.024 ) )
+ \ ;; it is not a bug if these don't match if MUS_SAMPLE_BITS is not 24
+ #( "b32.pvf" 1000 10
+ vct( -0.160 -0.216 -0.254 -0.239 -0.175
+ -0.102 -0.042 0.005 0.041 0.059 ) )
+ #( "b32.wave" 1000 10
+ vct( -0.160 -0.216 -0.254 -0.239 -0.175
+ -0.102 -0.042 0.005 0.041 0.059 ) )
+ #( "b32.snd" 1000 10
+ vct( -0.160 -0.216 -0.254 -0.239 -0.175
+ -0.102 -0.042 0.005 0.041 0.059 ) )
+ #( "32bit.sf" 1000 10
+ vct( 0.016 0.014 0.013 0.011 0.010 0.010 0.010 0.010 0.012 0.014 ) )
+ #( "nist-shortpack.wav" 10000 10
+ vct( 0.021 0.018 0.014 0.009 0.004
+ -0.001 -0.004 -0.006 -0.007 -0.008 ) )
+ #( "wood.sds" 1000 10
+ vct( -0.160 -0.216 -0.254 -0.239 -0.175
+ -0.102 -0.042 0.005 0.041 0.059 ) )
+ #( "mus10.snd" 10000 10
+ vct( 0.004 0.001 0.005 0.009 0.017 0.015 0.008 0.011 0.009 0.012 ) )
+ #( "ieee-text-16.snd" 1000 10
+ vct( -0.052 -0.056 -0.069 -0.077 -0.065
+ -0.049 -0.054 -0.062 -0.066 -0.074 ) )
+ #( "hcom-16.snd" 10000 10
+ vct( 0.000 0.000 0.000 0.008 0.000 -0.016 -0.016 -0.016 -0.008 0.000 ) )
+ #( "ce-c3.w02" 1000 10
+ vct( 0.581 0.598 0.596 0.577 0.552 0.530 0.508 0.479 0.449 0.425 ) )
+ #( "nasahal.avi" 20000 10
+ vct( 0.390 0.120 -0.399 -0.131 0.464 0.189 -0.458 -0.150 0.593 0.439 ) )
+ #( "oki.wav" 100 10
+ vct( 0.396 0.564 0.677 0.779 0.761 0.540 0.209 -0.100 -0.301 -0.265 ) )
+ #( "trumps22.adp" 5000 10
+ vct( 0.267 0.278 0.309 0.360 0.383 0.414 0.464 0.475 0.486 0.495 ) )
+ ) to files
+ nil nil nil nil { file beg dur data }
+ files each to vals
+ vals 0 array-ref to file
+ vals 1 array-ref to beg
+ vals 2 array-ref to dur
+ vals 3 array-ref to data
+ file check-file-name to fsnd
+ fsnd file-exists? if
+ fsnd open-sound to ind
+ beg dur ind 0 channel->vct data "%s" #( file ) snd-test-neq
+ ind close-sound drop
+ then
+ end-each
\
- vct( 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8 ) to data
- data vct->sound-data to sdata
- "test.snd" 22050 1 mus-lshort mus-riff $" a comment" mus-sound-open-output to snd
- snd #t set-mus-file-clipping drop
- snd 0 9 1 sdata mus-sound-write drop
- snd #f set-mus-file-clipping drop
- snd 40 mus-sound-close-output drop
- "test.snd" open-sound to snd
- 0 10 channel->vct
- vct( 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000 )
- $" clipped 1" #() snd-test-neq
- snd close-sound drop
- "test.snd" mus-sound-forget drop
- \
- #f set-mus-clipping drop
- vct( 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8 ) to data
- data vct->sound-data to sdata
- "test.snd" 22050 1 mus-lshort mus-riff $" a comment" mus-sound-open-output to snd
- snd 0 9 1 sdata mus-sound-write drop
- snd 40 mus-sound-close-output drop
- "test.snd" open-sound to snd
- 0 10 channel->vct
- vct( 0.000 -1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000 )
- $" unclipped 3" #() snd-test-neq
- snd close-sound drop
- "test.snd" mus-sound-forget drop
- \
- #t set-mus-clipping drop
- vct( 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8 ) to data
- data vct->sound-data to sdata
- "test.snd" 22050 1 mus-lshort mus-riff $" a comment" mus-sound-open-output to snd
- snd 0 9 1 sdata mus-sound-write drop
- snd 40 mus-sound-close-output drop
- "test.snd" open-sound to snd
- 0 10 channel->vct
- vct( 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000 )
- $" clipped 2" #() snd-test-neq
- snd close-sound drop
- "test.snd" mus-sound-forget drop
- \
- #t set-mus-clipping drop
- vct( 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8 ) to data
- data vct->sound-data to sdata
- "test.snd" 22050 1 mus-lshort mus-riff $" a comment" mus-sound-open-output to snd
- snd 0 10 1 sdata <'> mus-sound-write #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-sound-write too many bytes" #() snd-test-neq
- snd 0 10 1 sdata <'> mus-sound-read #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" mus-sound-read too many bytes" #() snd-test-neq
- snd 0 mus-sound-close-output drop
- "test.snd" file-delete
- "test.snd" mus-sound-forget drop
- #f set-mus-clipping drop \ ; this is the default
- #f set-clipping drop
- \
- $" this is a comment which we'll repeat enough times to trigger an internal loop" { com }
- 3 0 do
- com com $+ to com
- loop
- "fmv.snd" 22050 4 mus-lshort mus-riff com mus-sound-open-output to fd
- 4 10 make-sound-data to sdata
- 4 0 do
- sdata i 1 0.1 sound-data-set! drop
- loop
- fd 0 9 4 sdata mus-sound-write drop
- fd 80 mus-sound-close-output drop
- "fmv.snd" mus-sound-open-input to fd
- fd 0 9 4 sdata mus-sound-read drop
- 4 0 do
- sdata i 0 sound-data-ref 0.0 fneq
- sdata i 1 sound-data-ref 0.1 fneq ||
- sdata i 2 sound-data-ref 0.0 fneq ||
- sdata i 6 sound-data-ref 0.0 fneq || if
- $" 1 read/write[%d]: %s?" #( i sdata i sound-data-channel->list ) snd-display
- then
- loop
- fd mus-sound-close-input drop
- "fmv.snd" 4 mus-lshort mus-riff "fmv.snd" mus-sound-data-location mus-sound-reopen-output to fd
- fd 0 mus-sound-seek-frame drop
- 4 0 do
- sdata i 2 0.1 sound-data-set! drop
- sdata i 3 0.1 sound-data-set! drop
- loop
- fd 0 9 4 sdata mus-sound-write drop
- fd 80 mus-sound-close-output drop
- "fmv.snd" mus-sound-open-input to fd
- 4 10 make-sound-data to ndata
- fd 0 9 4 ndata mus-sound-read drop
- 4 0 do
- ndata i 0 sound-data-ref 0.0 fneq
- ndata i 1 sound-data-ref 0.1 fneq ||
- ndata i 2 sound-data-ref 0.1 fneq ||
- ndata i 3 sound-data-ref 0.1 fneq ||
- ndata i 6 sound-data-ref 0.0 fneq || if
- ndata i sound-data-channel->list
- sdata i sound-data-channel->list "!=" $" 2 re-read/write[%d]" #( i ) snd-format #() snd-display
- then
- loop
- fd mus-sound-close-input drop
- \
- "32bit.sf" check-file-name to fsnd
- fsnd file-exists? if
- fsnd open-sound to ind
- ind 0 maxamp 0.228 $" 32bit max" #() snd-test-neq
- ind close-sound drop
- then
- \
- #( #( "next-dbl.snd" 10 10 vct( 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344 ) )
- #( "oboe.ldbl" 1000 10 vct( 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004 ) )
- #( "next-flt.snd" 10 10 vct( 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344 ) )
- #( "clbonef.wav" 1000 10 vct( 0.111 0.101 0.070 0.032 -0.014 -0.060 -0.085 -0.108 -0.129 -0.152 ) )
- #( "next-8.snd" 10 10 vct( 0.898 0.945 0.977 0.992 0.992 0.977 0.945 0.906 0.844 0.773 ) )
- #( "o2_u8.wave" 1000 10 vct( -0.164 -0.219 -0.258 -0.242 -0.180 -0.102 -0.047 0.000 0.039 0.055 ) )
- #( "next-16.snd" 1000 10 vct( -0.026 -0.022 -0.024 -0.030 -0.041 -0.048 -0.050 -0.055 -0.048 -0.033 ) )
- #( "o2.wave" 1000 10 vct( -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059 ) )
- #( "o2_18bit.aiff" 1000 10 vct( -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059 ) )
- #( "o2_12bit.aiff" 1000 10 vct( -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059 ) )
- #( "next24.snd" 1000 10 vct( -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059 ) )
- #( "mono24.wav" 1000 10 vct( 0.005 0.010 0.016 0.008 -0.007 -0.018 -0.025 -0.021 -0.005 0.001 ) )
- #( "o2_711u.wave" 1000 10 vct( -0.164 -0.219 -0.254 -0.242 -0.172 -0.103 -0.042 0.005 0.042 0.060 ) )
- #( "alaw.wav" 1000 10 vct( -0.024 -0.048 -0.024 0.000 0.008 0.008 0.000 -0.040 -0.064 -0.024 ) )
- \ ;; it is not a bug if these don't match if MUS_SAMPLE_BITS is not 24
- #( "b32.pvf" 1000 10 vct( -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059 ) )
- #( "b32.wave" 1000 10 vct( -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059 ) )
- #( "b32.snd" 1000 10 vct( -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059 ) )
- #( "32bit.sf" 1000 10 vct( 0.016 0.014 0.013 0.011 0.010 0.010 0.010 0.010 0.012 0.014 ) )
- #( "nist-shortpack.wav" 10000 10 vct( 0.021 0.018 0.014 0.009 0.004 -0.001 -0.004 -0.006 -0.007 -0.008 ) )
- #( "wood.sds" 1000 10 vct( -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059 ) )
- #( "oboe.g721" 1000 10 vct( -0.037 -0.040 -0.040 -0.041 -0.042 -0.038 -0.028 -0.015 -0.005 0.002 ) )
- #( "oboe.g723_40" 1000 10 vct( -0.037 -0.040 -0.041 -0.041 -0.041 -0.038 -0.028 -0.015 -0.005 0.003 ) )
- #( "mus10.snd" 10000 10 vct( 0.004 0.001 0.005 0.009 0.017 0.015 0.008 0.011 0.009 0.012 ) )
- #( "ieee-text-16.snd" 1000 10 vct( -0.052 -0.056 -0.069 -0.077 -0.065 -0.049 -0.054 -0.062 -0.066 -0.074 ) )
- #( "hcom-16.snd" 10000 10 vct( 0.000 0.000 0.000 0.008 0.000 -0.016 -0.016 -0.016 -0.008 0.000 ) )
- #( "ce-c3.w02" 1000 10 vct( 0.581 0.598 0.596 0.577 0.552 0.530 0.508 0.479 0.449 0.425 ) )
- #( "nasahal.avi" 20000 10 vct( 0.390 0.120 -0.399 -0.131 0.464 0.189 -0.458 -0.150 0.593 0.439 ) )
- #( "oki.wav" 100 10 vct( 0.396 0.564 0.677 0.779 0.761 0.540 0.209 -0.100 -0.301 -0.265 ) )
- #( "trumps22.adp" 5000 10 vct( 0.267 0.278 0.309 0.360 0.383 0.414 0.464 0.475 0.486 0.495 ) ) ) to files
- nil nil nil nil { file beg dur data }
- files each to vals
- vals 0 array-ref to file
- vals 1 array-ref to beg
- vals 2 array-ref to dur
- vals 3 array-ref to data
- file check-file-name to fsnd
- fsnd file-exists? if
- fsnd open-sound to ind
- beg dur ind 0 channel->vct data $" %s" #( file ) snd-test-neq
- ind close-sound drop
- then
+ #( "no error"
+ "no frequency method"
+ "no phase method"
+ "null gen arg to method"
+ "no length method"
+ "no describe method"
+ "no data method"
+ "no scaler method"
+ "memory allocation failed"
+ "can't open file"
+ "no sample input"
+ "no sample output"
+ "no such channel"
+ "no file name provided"
+ "no location method"
+ "no channel method"
+ "no such fft window"
+ "unknown sample type"
+ "header read failed"
+ "unknown header type"
+ "file descriptors not initialized"
+ "not a sound file"
+ "file closed"
+ "write error"
+ "header write failed"
+ "can't open temp file"
+ "interrupted"
+ "bad envelope"
+ "audio channels not available"
+ "audio srate not available"
+ "audio sample type not available"
+ "no audio input available"
+ "audio configuration not available"
+ "audio write error"
+ "audio size not available"
+ "audio device not available"
+ "can't close audio"
+ "can't open audio"
+ "audio read error"
+ "can't write audio"
+ "can't read audio"
+ "no audio read permission"
+ "can't close file"
+ "arg out of range"
+ "no channels method"
+ "no hop method"
+ "no width method"
+ "no file-name method"
+ "no ramp method"
+ "no run method"
+ "no increment method"
+ "no offset method"
+ "no xcoeff method"
+ "no ycoeff method"
+ "no xcoeffs method"
+ "no ycoeffs method"
+ "no reset"
+ "bad size"
+ "can't convert"
+ "read error"
+ "no feedforward method"
+ "no feedback method"
+ "no interp-type method"
+ "no position method"
+ "no order method"
+ "no copy method"
+ "can't translate" ) each
+ ( err ) i mus-error-type->string "mus-error-type->string[%d]" #( i )
+ snd-test-neq
end-each
- \
- #( $" no error"
- $" no frequency method"
- $" no phase method"
- $" null gen arg to method"
- $" no length method"
- $" no free method"
- $" no describe method"
- $" no data method"
- $" no scaler method"
- $" memory allocation failed"
- $" unstable two pole error"
- $" can't open file"
- $" no sample input"
- $" no sample output"
- $" no such channel"
- $" no file name provided"
- $" no location method"
- $" no channel method"
- $" no such fft window"
- $" unsupported data format"
- $" header read failed"
- $" unsupported header type"
- $" file descriptors not initialized"
- $" not a sound file"
- $" file closed"
- $" write error"
- $" header write failed"
- $" can't open temp file"
- $" interrupted"
- $" bad envelope"
- $" audio channels not available"
- $" audio srate not available"
- $" audio format not available"
- $" no audio input available"
- $" audio configuration not available"
- $" audio write error"
- $" audio size not available"
- $" audio device not available"
- $" can't close audio"
- $" can't open audio"
- $" audio read error"
- $" can't write audio"
- $" can't read audio"
- $" no audio read permission"
- $" can't close file"
- $" arg out of range"
- $" wrong type arg"
- $" no channels method"
- $" no hop method"
- $" no width method"
- $" no file-name method"
- $" no ramp method"
- $" no run method"
- $" no increment method"
- $" no offset method"
- $" no xcoeff method"
- $" no ycoeff method"
- $" no xcoeffs method"
- $" no ycoeffs method"
- $" no reset"
- $" bad size"
- $" can't convert"
- $" read error"
- $" no safety method"
- $" can't translate" ) each
- ( err ) i mus-error-type->string $" mus-error-type->string[%d]" #( i ) snd-test-neq
- end-each
- \
+ \
"oboe.snd" mus-sound-srate { cur-srate }
"oboe.snd" mus-sound-chans { cur-chans }
- "oboe.snd" mus-sound-data-format { cur-format }
+ "oboe.snd" mus-sound-sample-type { cur-format }
"oboe.snd" mus-sound-header-type { cur-type }
"oboe.snd" mus-sound-data-location { cur-loc }
"oboe.snd" mus-sound-samples { cur-samps }
"oboe.snd" cur-srate 2* set-mus-sound-srate drop
- "oboe.snd" mus-sound-srate cur-srate 2* "set-mus-sound-srate" #() snd-test-neq
+ "oboe.snd" mus-sound-srate cur-srate 2* "set-mus-sound-srate" #()
+ snd-test-neq
"oboe.snd" cur-samps 2* set-mus-sound-samples drop
- "oboe.snd" mus-sound-samples cur-samps 2* "set-mus-sound-samples" #() snd-test-neq
+ "oboe.snd" mus-sound-samples cur-samps 2* "set-mus-sound-samples" #()
+ snd-test-neq
"oboe.snd" cur-chans 2* set-mus-sound-chans drop
- "oboe.snd" mus-sound-chans cur-chans 2* "set-mus-sound-chans" #() snd-test-neq
+ "oboe.snd" mus-sound-chans cur-chans 2* "set-mus-sound-chans" #()
+ snd-test-neq
"oboe.snd" cur-loc 2* set-mus-sound-data-location drop
- "oboe.snd" mus-sound-data-location cur-loc 2* "set-mus-sound-data-location" #() snd-test-neq
+ "oboe.snd" mus-sound-data-location cur-loc 2*
+ "set-mus-sound-data-location" #() snd-test-neq
"oboe.snd" mus-nist set-mus-sound-header-type drop
- "oboe.snd" mus-sound-header-type mus-nist "set-mus-sound-header-type" #() snd-test-neq
- "oboe.snd" mus-lintn set-mus-sound-data-format drop
- "oboe.snd" mus-sound-data-format mus-lintn "set-mus-sound-data-format" #() snd-test-neq
+ "oboe.snd" mus-sound-header-type mus-nist "set-mus-sound-header-type" #()
+ snd-test-neq
+ "oboe.snd" mus-lintn set-mus-sound-sample-type drop
+ "oboe.snd" mus-sound-sample-type mus-lintn "set-mus-sound-sample-type" #()
+ snd-test-neq
"oboe.snd" cur-srate set-mus-sound-srate drop
"oboe.snd" cur-samps set-mus-sound-samples drop
"oboe.snd" cur-chans set-mus-sound-chans drop
"oboe.snd" cur-loc set-mus-sound-data-location drop
"oboe.snd" cur-type set-mus-sound-header-type drop
- "oboe.snd" cur-format set-mus-sound-data-format drop
- \
+ "oboe.snd" cur-format set-mus-sound-sample-type drop
+ \
"oboe.snd" open-sound to ind
- "test.wave" ind mus-riff save-sound-as drop
- "test.rf64" ind mus-rf64 save-sound-as drop
- "test.aifc" ind mus-aifc save-sound-as drop
+ "test.wave" ind :header-type mus-riff save-sound-as drop
+ "test.rf64" ind :header-type mus-rf64 save-sound-as drop
+ "test.aifc" ind :header-type mus-aifc save-sound-as drop
ind close-sound drop
- \
+ \
#( "test.wave" "test.rf64" "test.aifc" ) each to file
file mus-sound-srate to cur-srate
file mus-sound-chans to cur-chans
- file mus-sound-data-format to cur-format
+ file mus-sound-sample-type to cur-format
file mus-sound-header-type to cur-type
file mus-sound-data-location to cur-loc
file mus-sound-samples to cur-samps
file cur-srate 2* set-mus-sound-srate drop
- file mus-sound-srate cur-srate 2* $" %s set-mus-sound-srate" #( file ) snd-test-neq
+ file mus-sound-srate cur-srate 2* "%s set-mus-sound-srate" #( file )
+ snd-test-neq
file cur-samps 2* set-mus-sound-samples drop
- file mus-sound-samples cur-samps 2* $" %s set-mus-sound-samples" #( file ) snd-test-neq
+ file mus-sound-samples cur-samps 2* "%s set-mus-sound-samples" #( file )
+ snd-test-neq
file cur-chans 2* set-mus-sound-chans drop
- file mus-sound-chans cur-chans 2* $" %s set-mus-sound-chans" #( file ) snd-test-neq
+ file mus-sound-chans cur-chans 2* "%s set-mus-sound-chans" #( file )
+ snd-test-neq
file cur-loc 2* set-mus-sound-data-location drop
- file mus-sound-data-location cur-loc 2* $" %s set-mus-sound-data-location" #( file ) snd-test-neq
+ file mus-sound-data-location cur-loc 2*
+ "%s set-mus-sound-data-location" #( file ) snd-test-neq
file mus-nist set-mus-sound-header-type drop
- file mus-sound-header-type mus-nist $" %s set-mus-sound-header-type" #( file ) snd-test-neq
- file mus-lintn set-mus-sound-data-format drop
- file mus-sound-data-format mus-lintn $" %s set-mus-sound-data-format" #( file ) snd-test-neq
+ file mus-sound-header-type mus-nist
+ "%s set-mus-sound-header-type" #( file ) snd-test-neq
+ file mus-lintn set-mus-sound-sample-type drop
+ file mus-sound-sample-type mus-lintn
+ "%s set-mus-sound-sample-type" #( file ) snd-test-neq
file cur-srate set-mus-sound-srate drop
file cur-samps set-mus-sound-samples drop
file cur-chans set-mus-sound-chans drop
file cur-loc set-mus-sound-data-location drop
file cur-type set-mus-sound-header-type drop
- file cur-format set-mus-sound-data-format drop
+ file cur-format set-mus-sound-sample-type drop
end-each
#( "test.wave" "test.rf64" "test.aifc" ) each to file
file open-sound to ind
ind srate to cur-srate
ind chans to cur-chans
- ind data-format to cur-format
+ ind sample-type to cur-format
ind header-type to cur-type
ind data-location to cur-loc
- ind frames to cur-samps
+ ind framples to cur-samps
ind cur-srate 2* set-srate drop
- ind srate cur-srate 2* $" %s set-srate" #( ind file-name ) snd-test-neq
- cur-samps 2* ind set-frames drop
- ind frames cur-samps 2* $" %s set-frames" #( ind file-name ) snd-test-neq
- ind cur-chans 2* set-chans drop \ ; this can change the index
+ ind srate cur-srate 2* "%s set-srate" #( ind file-name ) snd-test-neq
+ cur-samps 2* ind set-framples drop
+ ind framples cur-samps 2* "%s set-framples" #( ind file-name ) snd-test-neq
+ ind cur-chans 2* set-chans drop \ ; this can change the index
file find-sound to ind
- ind chans cur-chans 2* $" %s set-chans" #( ind file-name ) snd-test-neq
+ ind chans cur-chans 2* "%s set-chans" #( ind file-name ) snd-test-neq
ind cur-loc 2* set-data-location drop
- ind data-location cur-loc 2* $" %s set-data-location" #( ind file-name ) snd-test-neq
+ ind data-location cur-loc 2* "%s set-data-location" #( ind file-name )
+ snd-test-neq
ind mus-nist set-header-type drop
- ind header-type mus-nist $" %s set-header-type" #( ind file-name ) snd-test-neq
- ind mus-lintn set-data-format drop
- ind data-format mus-lintn $" %s set-data-format" #( ind file-name ) snd-test-neq
+ ind header-type mus-nist "%s set-header-type" #( ind file-name )
+ snd-test-neq
+ ind mus-lintn set-sample-type drop
+ ind sample-type mus-lintn "%s set-sample-type" #( ind file-name )
+ snd-test-neq
ind cur-srate set-srate drop
- cur-samps ind set-frames drop
+ cur-samps ind set-framples drop
ind cur-chans set-chans drop
ind cur-loc set-data-location drop
ind cur-type set-header-type drop
- ind cur-format set-data-format drop
+ ind cur-format set-sample-type drop
ind close-sound drop
file file-delete
end-each
with-big-file if
bigger-snd file-exists? if
\ ; silence as last .9 secs, so it probably wasn't written
- 44100 71999.1 f* floor f>d { probable-frames }
- 3175160310 make-uoff-t { our-frames }
- \ 6350320648 make-uoff-t { our-length }
- 3175160324 make-uoff-t 2 d* { our-length }
- bigger-snd mus-sound-samples our-frames $" bigger samples" #() snd-test-neq
- bigger-snd mus-sound-frames our-frames $" bigger frames" #() snd-test-neq
- bigger-snd mus-sound-frames probable-frames $" bigger frames (probable)" #() snd-test-neq
- bigger-snd mus-sound-length our-length $" bigger bytes" #() snd-test-neq
- bigger-snd mus-sound-duration 71999.1015 $" bigger dur" #() snd-test-neq
+ 44100 71999.1 f* floor f>d { probable-framples }
+ 3175160310 { our-framples }
+ 6350320648 { our-length }
+ bigger-snd mus-sound-samples our-framples "bigger samples"
+ #() snd-test-neq
+ bigger-snd mus-sound-framples our-framples "bigger framples"
+ #() snd-test-neq
+ bigger-snd mus-sound-framples probable-framples <'> d=
+ "bigger framples (probable)" #() snd-test-any-neq
+ bigger-snd mus-sound-length our-length "bigger bytes" #() snd-test-neq
+ bigger-snd mus-sound-duration 71999.1015 "bigger dur" #() snd-test-neq
bigger-snd open-sound to ind
- ind frames our-frames $" bigger frames" #() snd-test-neq
- ind frames to big-file-frames
- ind frames probable-frames $" bigger frames (probable)" #() snd-test-neq
- ind 0 0 frames big-file-frames $" bigger edpos-frames" #() snd-test-neq
+ ind framples our-framples "bigger framples" #() snd-test-neq
+ ind framples to big-file-framples
+ big-file-framples probable-framples <'> d= "bigger framples (probable)"
+ #() snd-test-any-neq
+ big-file-framples ind 0 0 framples "bigger edpos-framples"
+ #() snd-test-neq
44100 50000 d* ind add-mark to m1
- m1 mark-sample 44100 50000 d* $" bigger mark at" #() snd-test-neq
+ m1 mark-sample 44100 50000 d* "bigger mark at" #() snd-test-neq
m1 44100 66000 d* set-mark-sample drop
- m1 mark-sample 44100 66000 d* $" bigger mark to" #() snd-test-neq
- "oboe.snd" 44100 60000 d* mix-sound car to mx
+ m1 mark-sample 44100 66000 d* "bigger mark to" #() snd-test-neq
+ "oboe.snd" 44100 60000 d* mix-sound car { mx }
mx mix? if
- mx mix-position 44100 60000 d* $" bigger mix at" #() snd-test-neq
- mx 44100 61000 d* set-mix-position drop
- mx mix-position 44100 61000 d* $" bigger mix to" #() snd-test-neq
+ mx mix-position 44100 60000 d* "bigger mix at" #() snd-test-neq
+ mx 44100 61000 d* set-mix-position drop
+ mx mix-position 44100 61000 d* "bigger mix to" #() snd-test-neq
else
- $" no mix tag from mix-sound" #() snd-display
+ "no mix tag from mix-sound" #() snd-display
then
2 undo drop
<'> f0<> 1 make-proc find-channel to res
res false?
res 100 > || if
- $" bigger find not 0.0: %s" #( res ) snd-display
+ "bigger find not 0.0: %s" #( res ) snd-display
then
selection-creates-region { old-select }
#f set-selection-creates-region drop
ind select-all drop
- selection-frames ind 0 undef frames $" bigger select all" #() snd-test-neq
+ selection-framples ind 0 undef framples "bigger select all"
+ #() snd-test-neq
44100 50000 d* set-selection-position drop
- selection-position 44100 50000 d* $" bigger select pos" #() snd-test-neq
+ selection-position 44100 50000 d* "bigger select pos" #() snd-test-neq
0 set-selection-position drop
- 44100 65000 d* set-selection-frames drop
- selection-frames 44100 65000 d* $" bigger select len" #() snd-test-neq
+ 44100 65000 d* set-selection-framples drop
+ selection-framples 44100 65000 d* "bigger select len" #() snd-test-neq
old-select set-selection-creates-region drop
44100 50000 d* ind set-cursor drop
- ind cursor 44100 50000 d* $" bigger cursor" #() snd-test-neq
+ ind cursor 44100 50000 d* "bigger cursor" #() snd-test-neq
44123 51234 d* ind add-mark to m1
- m1 mark-sample 44123 51234 d* $" bigger mark at" #() snd-test-neq
+ m1 mark-sample 44123 51234 d* "bigger mark at" #() snd-test-neq
44123 51234 d* find-mark { mid }
- mid m1 $" bigger mark seach" #() snd-test-neq
+ mid m1 "bigger mark seach" #() snd-test-neq
"oboe.snd" 44123 61234 d* mix-sound car to mx
44123 61234 d* find-mix { mxd }
- mxd mx $" bigger find-mix" #() snd-test-neq
+ mxd mx "bigger find-mix" #() snd-test-neq
44123 51234 d* ind set-cursor drop
- ind cursor 44123 51234 d* $" bigger cursor 123" #() snd-test-neq
+ ind cursor 44123 51234 d* "bigger cursor 123" #() snd-test-neq
ind close-sound drop
- else
- $" no such bigger file %s" #( bigger-snd ) snd-display
- then
- then
- \
- "tmp.snd" mus-riff mus-l24int 22050 1 :size 100000 new-sound to ind
+ else \ bigger-snd not file-exists?
+ "no such bigger file %s" #( bigger-snd ) snd-display
+ then \ bigger-snd file-exists?
+ then \ with-big-file
+ \
+ "tmp.snd" 1 22050 mus-l24int mus-riff :size 100000 new-sound to ind
selection-creates-region { old-selection-creates-region }
#t set-selection-creates-region drop
- -0.5 undef undef undef frames 1/f sndlib-test-map-x-cb map-channel drop
+ undef undef undef framples to len
+ len 1/f { incr }
+ -0.5 ( x )
+ len 0.0 make-vct map!
+ ( x ) incr f+ dup
+ end-map ( data ) 0 len undef undef undef "" vct->channel drop ( x ) drop
save-sound drop
ind close-sound drop
"tmp.snd" open-sound to ind
select-all { reg }
- "tmp1.snd" mus-next mus-l24int save-selection drop
- "tmp1.snd" open-sound to ind1
- -0.5 undef undef undef frames 1/f sndlib-test-scan-x-cb 0 100000 ind1 scan-channel to res
- res #f $" l24 (next) selection not saved correctly" #() snd-test-neq
+ "tmp1.snd" 22050 mus-l24int mus-next save-selection drop
+ "tmp1.snd" open-sound { ind1 }
+ -0.5 undef undef undef framples 1/f sndlib-test-scan-x-cb 0 100000 ind1
+ scan-channel to res
+ res #f "l24 (next) selection not saved correctly" #() snd-test-neq
ind1 close-sound drop
- "tmp1.snd" mus-aifc mus-l24int save-selection drop
+ "tmp1.snd" 22050 mus-l24int mus-aifc save-selection drop
"tmp1.snd" open-sound to ind1
- -0.5 undef undef undef frames 1/f sndlib-test-scan-x-cb 0 100000 ind1 scan-channel to res
- res #f $" l24 (aifc) selection not saved correctly" #() snd-test-neq
+ -0.5 undef undef undef framples 1/f sndlib-test-scan-x-cb 0 100000 ind1
+ scan-channel to res
+ res #f "l24 (aifc) selection not saved correctly" #() snd-test-neq
ind1 close-sound drop
- reg "tmp1.snd" mus-next mus-l24int save-region drop
+ reg "tmp1.snd" mus-l24int mus-next save-region drop
"tmp1.snd" open-sound to ind1
- -0.5 undef undef undef frames 1/f sndlib-test-scan-x-cb 0 100000 ind1 scan-channel to res
- res #f $" l24 (next) region not saved correctly" #() snd-test-neq
+ -0.5 undef undef undef framples 1/f sndlib-test-scan-x-cb 0 100000 ind1
+ scan-channel to res
+ res #f "l24 (next) region not saved correctly" #() snd-test-neq
ind1 close-sound drop
"tmp1.snd" file-delete
ind close-sound drop
"tmp.snd" file-delete
old-selection-creates-region set-selection-creates-region drop
- \
- "tmp.snd" mus-next mus-bfloat 22050 1 :size 10 :comment #f new-sound to ind
+ \
+ "tmp.snd" 1 22050 mus-bfloat mus-next :size 10 :comment #f new-sound to ind
<'> sndlib-test-map-set-1.0 map-channel drop
- '( 0 0 0.1 0.1 0.2 0.2 0.3 0.3 0.4 0.4 0.5 0.5 0.6 0.6 0.7 0.7 0.8 0.8 0.9 0.9 ) env-channel drop
+ '( 0 0 0.1 0.1 0.2 0.2 0.3 0.3 0.4 0.4 0.5 0.5
+ 0.6 0.6 0.7 0.7 0.8 0.8 0.9 0.9 ) env-channel drop
channel->vct
vct( 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 )
- $" ramp env by 0.1" #() snd-test-neq
+ "ramp env by 0.1" #() snd-test-neq
ind close-sound drop
;
@@ -3708,14 +3596,14 @@ black-and-white-colormap constant *better-colormap*
io "COMM" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size
io 0o000 port-putc io 0o001 port-putc \ 1 chan
- io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io frms port-putc \ frames
+ io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io frms port-putc \ framples
io 0o000 port-putc io bits port-putc \ bits
io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc
\ srate as 80-bit float (sheesh)
- io "NONE" port-write \ compression
- io 0o016 port-putc \ pascal string len
- io $" not compressed" port-write
+ io "NONE" port-write \ compression
+ io 0o016 port-putc \ pascal string len
+ io "not compressed" port-write
io 0o000 port-putc
io "AUTH" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io auth-lo port-putc \ AUTH chunk size
@@ -3735,30 +3623,31 @@ black-and-white-colormap constant *better-colormap*
bad-header-hook reset-hook!
bad-header-hook <'> sndlib-hook-1-t#-cb add-hook!
open-raw-sound-hook empty? if
- $" add-hook open-raw-sound-hook failed??" #() snd-display
+ "add-hook open-raw-sound-hook failed??" #() snd-display
then
bad-header-hook empty? if
- $" add-hook bad-header-hook failed??" #() snd-display
- then
- #( ".snd" "FORM" "AIFF" "AIFC" "COMM" "COMT" "INFO" "INST" "inst" "MARK" "SSND"
- "FVER" "NONE" "ULAW" "ulaw" "ima4" "raw " "sowt" "in32" "in24" "ni23" "fl32"
- "FL32" "fl64" "twos" "ALAW" "alaw" "APPL" "CLM " "RIFF" "RIFX" "WAVE" "fmt "
- "data" "fact" "clm " "NIST" "8SVX" "16SV" "Crea" "tive" "SOUN" "D SA" "MPLE"
- "BODY" "VHDR" "CHAN" "ANNO" "NAME" "2BIT" "HCOM" "FSSD" "%//\n" "%---" "ALaw"
- "Soun" "MAUD" "MHDR" "MDAT" "mdat" "MThd" "sfbk" "sdta" "shdr" "pdta"
- "LIST" "GF1P" "ATCH" "$SIG" "NAL_" "GOLD" " SAM" "SRFS" "Diam" "ondW" "CSRE"
- "SND " "SNIN" "SNDT" "DDSF" "FSMu" "UWFD" "LM89" "SY80" "SY85" "SCRS" "DSPL"
- "AVI " "strf" "movi" "PRAM" " paf" "fap " "DS16" "HEDR" "HDR8" "SDA_" "SDAB"
- "SD_B" "NOTE" "file" "=sam" "SU7M" "SU7R" "PVF1" "PVF2" "AUTH" "riff" "TWIN"
- "IMPS" "SMP1" "Maui" "SDIF" "NVF " ) { magic-words }
+ "add-hook bad-header-hook failed??" #() snd-display
+ then
+ #( ".snd" "FORM" "AIFF" "AIFC" "COMM" "COMT" "INFO" "INST" "inst" "MARK"
+ "SSND" "FVER" "NONE" "ULAW" "ulaw" "ima4" "raw " "sowt" "in32" "in24"
+ "ni23" "fl32" "FL32" "fl64" "twos" "ALAW" "alaw" "APPL" "CLM " "RIFF"
+ "RIFX" "WAVE" "fmt " "data" "fact" "clm " "NIST" "8SVX" "16SV" "Crea"
+ "tive" "SOUN" "D SA" "MPLE" "BODY" "VHDR" "CHAN" "ANNO" "NAME" "2BIT"
+ "HCOM" "FSSD" "%//\n" "%---" "ALaw" "Soun" "MAUD" "MHDR" "MDAT" "mdat"
+ "MThd" "sfbk" "sdta" "shdr" "pdta" "LIST" "GF1P" "ATCH" "$SIG" "NAL_"
+ "GOLD" " SAM" "SRFS" "Diam" "ondW" "CSRE" "SND " "SNIN" "SNDT" "DDSF"
+ "FSMu" "UWFD" "LM89" "SY80" "SY85" "SCRS" "DSPL" "AVI " "strf" "movi"
+ "PRAM" " paf" "fap " "DS16" "HEDR" "HDR8" "SDA_" "SDAB" "SD_B" "NOTE"
+ "file" "=sam" "SU7M" "SU7R" "PVF1" "PVF2" "AUTH" "riff" "TWIN" "IMPS"
+ "SMP1" "Maui" "SDIF" "NVF " ) { magic-words }
magic-words length { len }
nil nil nil nil { magic io res ind }
magic-words each to magic
open-raw-sound-hook empty? if
- $" open-raw-sound-hook cleared??" #() snd-display
+ "open-raw-sound-hook cleared??" #() snd-display
then
bad-header-hook empty? if
- $" bad-header-hook cleared??" #() snd-display
+ "bad-header-hook cleared??" #() snd-display
then
"test.snd" file-delete
"test.snd" mus-sound-forget drop
@@ -3774,10 +3663,10 @@ black-and-white-colormap constant *better-colormap*
else
to res
res number? if
- res sound? if
- $" open-sound garbage: %s %s" #( magic res ) snd-display
- res close-sound drop
- then
+ res sound? if
+ "open-sound garbage: %s %s" #( magic res ) snd-display
+ res close-sound drop
+ then
then
then
"test.snd" file-delete
@@ -3794,10 +3683,10 @@ black-and-white-colormap constant *better-colormap*
else
to res
res number? if
- res sound? if
- $" open-sound plausible garbage: %s %s" #( magic res ) snd-display
- res close-sound drop
- then
+ res sound? if
+ "open-sound plausible garbage: %s %s" #( magic res ) snd-display
+ res close-sound drop
+ then
then
then
"test.snd" file-delete
@@ -3806,11 +3695,12 @@ black-and-white-colormap constant *better-colormap*
"test.snd" make-file-output-port to io
io magic port-write
12 1 do
- io
- magic-words
- j ( ctr ) i + len < if j i + else i then
- array-ref
- port-write
+ io magic-words
+ j ( ctr ) i + len < if
+ j i +
+ else
+ i
+ then array-ref port-write
loop
io port-close
"test.snd" <'> open-sound #t nil fth-catch if
@@ -3818,16 +3708,16 @@ black-and-white-colormap constant *better-colormap*
else
to res
res number? if
- res sound? if
- $" open-sound very plausible garbage: %s %s" #( magic res ) snd-display
- res close-sound drop
- then
+ res sound? if
+ "open-sound very plausible garbage: %s %s" #( magic res ) snd-display
+ res close-sound drop
+ then
then
then
- end-each
+ end-each \ magic-words
"test.snd" file-delete
"test.snd" mus-sound-forget drop
- \
+ \
"test.snd" make-file-output-port to io
io ".snd" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o034 port-putc \ location
@@ -3838,10 +3728,10 @@ black-and-white-colormap constant *better-colormap*
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ comment
io 0o000 port-putc io 0o001 port-putc \ samp 1
io port-close
- "test.snd" mus-sound-data-format mus-bshort $" next 18" #() snd-test-neq
+ "test.snd" mus-sound-sample-type mus-bshort "next 18" #() snd-test-neq
"test.snd" file-delete
"test.snd" mus-sound-forget drop
- \
+ \
"test.snd" make-file-output-port to io
io ".snd" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ location
@@ -3858,14 +3748,15 @@ black-and-white-colormap constant *better-colormap*
to res
res number? if
res sound? if
- $" open-sound next bad location %d: %s" #( res data-location res ) snd-display
- res close-sound drop
+ "open-sound next bad location %d: %s"
+ #( res data-location res ) snd-display
+ res close-sound drop
then
then
then
"test.snd" file-delete
"test.snd" mus-sound-forget drop
- \
+ \
"test.snd" make-file-output-port to io
io ".snd" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o034 port-putc \ location
@@ -3880,11 +3771,9 @@ black-and-white-colormap constant *better-colormap*
stack-reset
else
to res
- res number? if
- res sound? if
- $" open-sound next bad format %s: %s" #( res data-format res ) snd-display
- res close-sound drop
- then
+ res sound? if
+ "open-sound next bad format %s: %s" #( res sample-type res ) snd-display
+ res close-sound drop
then
then
"test.snd" file-delete
@@ -3894,7 +3783,7 @@ black-and-white-colormap constant *better-colormap*
\ ;;correct (make-aifc-file #o002 #o004 #o020)
0o102 0o004 0o020 make-aifc-file
"test.aif" open-sound to ind
- ind frames 2 $" bad frames in header" #() snd-test-neq
+ ind framples 2 "bad framples in header" #() snd-test-neq
ind close-sound drop
"test.aif" file-delete
"test.aif" mus-sound-forget drop
@@ -3904,11 +3793,10 @@ black-and-white-colormap constant *better-colormap*
stack-reset
else
to res
- res number? if
- res sound? if
- $" open-sound aifc no ssnd chunk %d: %s" #( res data-location res ) snd-display
- res close-sound drop
- then
+ res sound? if
+ "open-sound aifc no ssnd chunk %d: %s"
+ #( res data-location res ) snd-display
+ res close-sound drop
then
then
"test.aif" file-delete
@@ -3919,11 +3807,10 @@ black-and-white-colormap constant *better-colormap*
stack-reset
else
to res
- res number? if
- res sound? if
- $" open-sound aifc 0-len auth chunk %d: %s" #( res data-location res ) snd-display
- res close-sound drop
- then
+ res sound? if
+ "open-sound aifc 0-len auth chunk %d: %s"
+ #( res data-location res ) snd-display
+ res close-sound drop
then
then
"test.aif" file-delete
@@ -3934,11 +3821,9 @@ black-and-white-colormap constant *better-colormap*
stack-reset
else
to res
- res number? if
- res sound? if
- $" open-sound bits 80 %s: %s" #( res data-format res ) snd-display
- res close-sound drop
- then
+ res sound? if
+ "open-sound bits 80 %s: %s" #( res sample-type res ) snd-display
+ res close-sound drop
then
then
"test.aif" file-delete
@@ -3953,14 +3838,14 @@ black-and-white-colormap constant *better-colormap*
io "COMM" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size
io 0o000 port-putc io 0o001 port-putc \ 1 chan
- io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ frames
+ io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ framples
io 0o000 port-putc io 0o020 port-putc \ bits
io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc
\ srate as 80-bit float (sheesh)
- io "NONE" port-write \ compression
- io 0o016 port-putc \ pascal string len
- io $" not compressed" port-write
+ io "NONE" port-write \ compression
+ io 0o016 port-putc \ pascal string len
+ io "not compressed" port-write
io 0o000 port-putc
io "AUTH" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ AUTH chunk size
@@ -3980,7 +3865,7 @@ black-and-white-colormap constant *better-colormap*
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size?
io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples
io port-close
- "test.aif" mus-sound-comment length 15 $" aifc 3 aux comments" #() snd-test-neq
+ "test.aif" mus-sound-comment length 15 "aifc 3 aux comments" #() snd-test-neq
"test.aif" file-delete
"test.aif" mus-sound-forget drop
\
@@ -3996,14 +3881,14 @@ black-and-white-colormap constant *better-colormap*
io "COMM" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size
io 0o000 port-putc io 0o001 port-putc \ 1 chan
- io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ frames
+ io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ framples
io 0o000 port-putc io 0o020 port-putc \ bits
io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc
\ srate as 80-bit float (sheesh)
- io "NONE" port-write \ compression
- io 0o016 port-putc \ pascal string len
- io $" not compressed" port-write
+ io "NONE" port-write \ compression
+ io 0o016 port-putc \ pascal string len
+ io "not compressed" port-write
io 0o000 port-putc
io "COMT" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc
@@ -4012,14 +3897,17 @@ black-and-white-colormap constant *better-colormap*
io "bil" port-write
io 0o000 port-putc
io port-close
- "test.aif" mus-sound-comment 0 3 string-substring "bil" $" aifc trailing comt comments" #() snd-test-neq
- "test.aif" mus-sound-frames 2 $" aifc trailing comt frames" #() snd-test-neq
+ "test.aif" mus-sound-comment 0 3 string-substring "bil"
+ "aifc trailing comt comments" #() snd-test-neq
+ "test.aif" mus-sound-framples 2 "aifc trailing comt framples"
+ #() snd-test-neq
"test.aif" open-sound to ind
0 sample { s0 }
1 sample { s1 }
2 sample { s2 }
3 sample { s3 }
- vct( s0 s1 s2 s3 ) vct( 0.00198 0.00195 0.0 0.0 ) $" aifc trailing comt samps" #() snd-test-neq
+ vct( s0 s1 s2 s3 ) vct( 0.00198 0.00195 0.0 0.0 )
+ "aifc trailing comt samps" #() snd-test-neq
ind close-sound drop
"test.aif" file-delete
"test.aif" mus-sound-forget drop
@@ -4036,14 +3924,14 @@ black-and-white-colormap constant *better-colormap*
io "COMM" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size
io 0o000 port-putc io 0o001 port-putc \ 1 chan
- io 0o000 port-putc io 0o000 port-putc io 0o100 port-putc io 0o102 port-putc \ frames
+ io 0o000 port-putc io 0o000 port-putc io 0o100 port-putc io 0o102 port-putc \ framples
io 0o000 port-putc io 0o020 port-putc \ bits
io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc
\ srate as 80-bit float (sheesh)
- io "NONE" port-write \ compression
- io 0o016 port-putc \ pascal string len
- io $" not compressed" port-write
+ io "NONE" port-write \ compression
+ io 0o016 port-putc \ pascal string len
+ io "not compressed" port-write
io 0o000 port-putc
io "COMT" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc
@@ -4052,14 +3940,17 @@ black-and-white-colormap constant *better-colormap*
io "bil" port-write
io 0o000 port-putc
io port-close
- "test.aif" mus-sound-comment 0 3 string-substring "bil" $" aifc trailing comt comments" #() snd-test-neq
- "test.aif" mus-sound-frames 2 $" aifc trailing comt (bogus) frames" #() snd-test-neq
+ "test.aif" mus-sound-comment 0 3 string-substring "bil"
+ "aifc trailing comt comments" #() snd-test-neq
+ "test.aif" mus-sound-framples 2 "aifc trailing comt (bogus) framples"
+ #() snd-test-neq
"test.aif" open-sound to ind
0 sample to s0
1 sample to s1
2 sample to s2
3 sample to s3
- vct( s0 s1 s2 s3 ) vct( 0.00198 0.00195 0.0 0.0 ) $" aifc trailing comt samps (bogus frame setting)" #() snd-test-neq
+ vct( s0 s1 s2 s3 ) vct( 0.00198 0.00195 0.0 0.0 )
+ "aifc trailing comt samps (bogus frame setting)" #() snd-test-neq
ind close-sound drop
"test.aif" file-delete
"test.aif" mus-sound-forget drop
@@ -4076,14 +3967,14 @@ black-and-white-colormap constant *better-colormap*
io "COMM" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size
io 0o000 port-putc io 0o001 port-putc \ 1 chan
- io 0o000 port-putc io 0o000 port-putc io 0o100 port-putc io 0o102 port-putc \ frames
+ io 0o000 port-putc io 0o000 port-putc io 0o100 port-putc io 0o102 port-putc \ framples
io 0o000 port-putc io 0o020 port-putc \ bits
io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc
\ srate as 80-bit float (sheesh)
- io "NONE" port-write \ compression
- io 0o016 port-putc \ pascal string len
- io $" not compressed" port-write
+ io "NONE" port-write \ compression
+ io 0o016 port-putc \ pascal string len
+ io "not compressed" port-write
io 0o000 port-putc
io "SSND" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size
@@ -4095,11 +3986,10 @@ black-and-white-colormap constant *better-colormap*
stack-reset
else
to res
- res number? if
- res sound? if
- $" open-sound aifc 2 ssnd chunks %d: %s" #( res data-location res ) snd-display
- res close-sound drop
- then
+ res sound? if
+ "open-sound aifc 2 ssnd chunks %d: %s"
+ #( res data-location res ) snd-display
+ res close-sound drop
then
then
"test.aif" file-delete
@@ -4115,10 +4005,11 @@ black-and-white-colormap constant *better-colormap*
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size?
io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples
io port-close
- "test.aif" <'> open-sound #t nil fth-catch to res
- stack-reset
- res car 'mus-error $" open-sound aifc no comm chunk: %s" #( res ) snd-test-neq
- sounds each close-sound drop end-each
+ "test.aif" <'> open-sound snd-test-catch to res
+ res car 'mus-error "open-sound aifc no comm chunk: %s" #( res ) snd-test-neq
+ sounds each ( snd )
+ close-sound drop
+ end-each
"test.aif" file-delete
"test.aif" mus-sound-forget drop
\
@@ -4132,14 +4023,14 @@ black-and-white-colormap constant *better-colormap*
io "COMM" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size
io 0o000 port-putc io 0o001 port-putc \ 1 chan
- io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ frames
+ io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ framples
io 0o000 port-putc io 0o020 port-putc \ bits
io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc
\ srate as 80-bit float (sheesh)
- io "NONE" port-write \ compression
- io 0o016 port-putc \ pascal string len
- io $" not compressed" port-write
+ io "NONE" port-write \ compression
+ io 0o016 port-putc \ pascal string len
+ io "not compressed" port-write
io 0o000 port-putc
io "SSND" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size
@@ -4160,18 +4051,18 @@ black-and-white-colormap constant *better-colormap*
io 0o000 port-putc
io port-close
"test.aif" make-file->sample { gen }
- gen #( 0 ) object-apply 0.93948 $" file->sample chunked 0" #() snd-test-neq
- gen #( 1 ) object-apply 0.50195 $" file->sample chunked 1" #() snd-test-neq
- gen #( 2 ) object-apply 0.0 $" file->sample chunked eof" #() snd-test-neq
- gen #( 3 ) object-apply 0.0 $" file->sample chunked eof+1" #() snd-test-neq
+ gen #( 0 ) object-apply 0.93948 "file->sample chunked 0" #() snd-test-neq
+ gen #( 1 ) object-apply 0.50195 "file->sample chunked 1" #() snd-test-neq
+ gen #( 2 ) object-apply 0.0 "file->sample chunked eof" #() snd-test-neq
+ gen #( 3 ) object-apply 0.0 "file->sample chunked eof+1" #() snd-test-neq
"test.aif" open-sound to ind
- ind frames 2 $" chunked frames" #() snd-test-neq
- 0 sample 0.93948 $" file chunked 0" #() snd-test-neq
- 1 sample 0.50195 $" file chunked 1" #() snd-test-neq
- 2 sample 0.0 $" file chunked eof" #() snd-test-neq
- 3 sample 0.0 $" file chunked eof+1" #() snd-test-neq
+ ind framples 2 "chunked framples" #() snd-test-neq
+ 0 sample 0.93948 "file chunked 0" #() snd-test-neq
+ 1 sample 0.50195 "file chunked 1" #() snd-test-neq
+ 2 sample 0.0 "file chunked eof" #() snd-test-neq
+ 3 sample 0.0 "file chunked eof+1" #() snd-test-neq
ind close-sound drop
- "test.aif" mus-sound-frames 2 $" chunked mus-sound-frames" #() snd-test-neq
+ "test.aif" mus-sound-framples 2 "chunked mus-sound-framples" #() snd-test-neq
"test.aif" file-delete
"test.aif" mus-sound-forget drop
\
@@ -4190,33 +4081,33 @@ black-and-white-colormap constant *better-colormap*
io "COMM" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size
io 0o000 port-putc io 0o001 port-putc \ 1 chan
- io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ frames
+ io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ framples
io 0o000 port-putc io 0o020 port-putc \ bits
io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc
\ srate as 80-bit float (sheesh)
- io "NONE" port-write \ compression
- io 0o016 port-putc \ pascal string len
- io $" not compressed" port-write
+ io "NONE" port-write \ compression
+ io 0o016 port-putc \ pascal string len
+ io "not compressed" port-write
io 0o000 port-putc
io "APPL" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io <char> h port-putc
- io $" CLM ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98" port-write
+ io "CLM ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98" port-write
io 0o000 port-putc
io port-close
"test.aif" make-file->sample to gen
- gen #( 0 ) object-apply 0.93948 $" file->sample chunked 0" #() snd-test-neq
- gen #( 1 ) object-apply 0.50195 $" file->sample chunked 1" #() snd-test-neq
- gen #( 2 ) object-apply 0.0 $" file->sample chunked eof" #() snd-test-neq
- gen #( 3 ) object-apply 0.0 $" file->sample chunked eof+1" #() snd-test-neq
+ gen #( 0 ) object-apply 0.93948 "file->sample chunked 0" #() snd-test-neq
+ gen #( 1 ) object-apply 0.50195 "file->sample chunked 1" #() snd-test-neq
+ gen #( 2 ) object-apply 0.0 "file->sample chunked eof" #() snd-test-neq
+ gen #( 3 ) object-apply 0.0 "file->sample chunked eof+1" #() snd-test-neq
"test.aif" open-sound to ind
- ind frames 2 $" chunked frames" #() snd-test-neq
- 0 sample 0.93948 $" file chunked 0" #() snd-test-neq
- 1 sample 0.50195 $" file chunked 1" #() snd-test-neq
- 2 sample 0.0 $" file chunked eof" #() snd-test-neq
- 3 sample 0.0 $" file chunked eof+1" #() snd-test-neq
- comment $" ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98"
- $" chunked appl comment" #() snd-test-neq
+ ind framples 2 "chunked framples" #() snd-test-neq
+ 0 sample 0.93948 "file chunked 0" #() snd-test-neq
+ 1 sample 0.50195 "file chunked 1" #() snd-test-neq
+ 2 sample 0.0 "file chunked eof" #() snd-test-neq
+ 3 sample 0.0 "file chunked eof+1" #() snd-test-neq
+ comment ";Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98"
+ "chunked appl comment" #() snd-test-neq
ind close-sound drop
"test.aif" file-delete
"test.aif" mus-sound-forget drop
@@ -4236,104 +4127,111 @@ black-and-white-colormap constant *better-colormap*
io "COMM" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size
io 0o000 port-putc io 0o002 port-putc \ 2 chans
- io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o001 port-putc \ frames
+ io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o001 port-putc \ framples
io 0o000 port-putc io 0o020 port-putc \ bits
io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc
\ srate as 80-bit float (sheesh)
- io "NONE" port-write \ compression
- io 0o016 port-putc \ pascal string len
- io $" not compressed" port-write
+ io "NONE" port-write \ compression
+ io 0o016 port-putc \ pascal string len
+ io "not compressed" port-write
io 0o000 port-putc
io "APPL" port-write
io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io <char> h port-putc
- io $" CLM ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98" port-write
+ io "CLM ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98" port-write
io 0o000 port-putc
io port-close
"test.aif" make-file->sample to gen
- gen #( 0 0 ) object-apply 0.93948 $" file->sample chunked 0 0" #() snd-test-neq
- gen #( 0 1 ) object-apply 0.50195 $" file->sample chunked 0 1" #() snd-test-neq
- gen #( 1 0 ) object-apply 0.0 $" file->sample chunked eof (stereo)" #() snd-test-neq
- gen #( 1 1 ) object-apply 0.0 $" file->sample chunked eof+1 (stereo)" #() snd-test-neq
+ gen #( 0 0 ) object-apply 0.93948 "file->sample chunked 0 0" #() snd-test-neq
+ gen #( 0 1 ) object-apply 0.50195 "file->sample chunked 0 1" #() snd-test-neq
+ gen #( 1 0 ) object-apply 0.0 "file->sample chunked eof (stereo)" #()
+ snd-test-neq
+ gen #( 1 1 ) object-apply 0.0 "file->sample chunked eof+1 (stereo)" #()
+ snd-test-neq
"test.aif" open-sound to ind
- ind frames 1 $" chunked frames (1)" #() snd-test-neq
- 0 ind 0 sample 0.93948 $" file chunked 0 0" #() snd-test-neq
- 0 ind 1 sample 0.50195 $" file chunked 0 1" #() snd-test-neq
- 1 ind 0 sample 0.0 $" file chunked eof (stereo)" #() snd-test-neq
- 1 ind 1 sample 0.0 $" file chunked eof+1 (stereo)" #() snd-test-neq
- comment $" ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98"
- $" chunked appl comment (stereo)" #() snd-test-neq
+ ind framples 1 "chunked framples (1)" #() snd-test-neq
+ 0 ind 0 sample 0.93948 "file chunked 0 0" #() snd-test-neq
+ 0 ind 1 sample 0.50195 "file chunked 0 1" #() snd-test-neq
+ 1 ind 0 sample 0.0 "file chunked eof (stereo)" #() snd-test-neq
+ 1 ind 1 sample 0.0 "file chunked eof+1 (stereo)" #() snd-test-neq
+ comment ";Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98"
+ "chunked appl comment (stereo)" #() snd-test-neq
ind close-sound drop
"test.aif" file-delete
"test.aif" mus-sound-forget drop
- \
+ \
file-pwd sound-files-in-directory { files }
files empty? if
- $" no sound files in %s?" #( file-pwd ) snd-display
+ "no sound files in %s?" #( file-pwd ) snd-display
then
sound-files-in-directory { files1 }
- files files1 $" different sound files in %s and default" #( file-pwd ) snd-test-neq
+ files files1 "different sound files in %s and default" #( file-pwd )
+ snd-test-neq
"." sound-files-in-directory { files2 }
- files1 files2 $" sound-files-in-directory dot" #() snd-test-neq
- files files2 $" sound-files-in-directory dot" #() snd-test-neq
- \
+ files1 files2 "sound-files-in-directory dot" #() snd-test-neq
+ files files2 "sound-files-in-directory dot" #() snd-test-neq
+ \
bad-header-hook reset-hook!
open-raw-sound-hook reset-hook!
- sounds each ( snd ) close-sound drop end-each
- \
+ sounds each ( snd )
+ close-sound drop
+ end-each
+ \
:size 0 new-sound to ind
- ind frames 0 $" new-sound :size 0 frames" #() snd-test-neq
- 0 sample 0.0 $" new-sound :size 0 sample 0" #() snd-test-neq
+ ind framples 0 "new-sound :size 0 framples" #() snd-test-neq
+ 0 sample 0.0 "new-sound :size 0 sample 0" #() snd-test-neq
ind file-name { new-file-name }
ind close-sound drop
new-file-name file-delete
:size 1 new-sound to ind
- ind frames 1 $" new-sound :size 1 frames" #() snd-test-neq
- 0 sample 0.0 $" new-sound :size 1 sample 0" #() snd-test-neq
+ ind framples 1 "new-sound :size 1 framples" #() snd-test-neq
+ 0 sample 0.0 "new-sound :size 1 sample 0" #() snd-test-neq
ind file-name to new-file-name
ind close-sound drop
new-file-name file-delete
- :size -1 <'> new-sound #t nil fth-catch to res
- stack-reset
- res car 'out-of-range $" new-sound :size -1: %s" #( res ) snd-test-neq
- \
+ :size -1 <'> new-sound snd-test-catch to res
+ res car 'out-of-range "new-sound :size -1: %s" #( res ) snd-test-neq
+ \
"caruso.asc" check-file-name { fsnd }
fsnd file-exists? if
fsnd read-ascii to ind
ind sound? if
- ind 0 maxamp 0.723 $" read-ascii maxamp" #() snd-test-neq
- ind 0 frames 50000 $" read-ascii frames" #() snd-test-neq
- ind srate 44100 $" read-ascii srate" #() snd-test-neq
+ ind 0 maxamp 0.723 "read-ascii maxamp" #() snd-test-neq
+ ind 0 framples 50000 "read-ascii framples" #() snd-test-neq
+ ind srate 44100 "read-ascii srate" #() snd-test-neq
ind 8000 set-srate drop
- ind 0 maxamp 0.723 $" set srate clobbered new sound (maxamp)" #() snd-test-neq
- ind 0 frames 50000 $" set srate clobbered new sound (frames)" #() snd-test-neq
+ ind 0 maxamp 0.723 "set srate clobbered new sound (maxamp)"
+ #() snd-test-neq
+ ind 0 framples 50000 "set srate clobbered new sound (framples)"
+ #() snd-test-neq
ind close-sound drop
else
- $" read-ascii can't find %s?" #( fsnd ) snd-display
+ "read-ascii can't find %s?" #( fsnd ) snd-display
then
then
- \
+ \
"oboe.snd" open-sound to ind
- $" test space.snd" save-sound-as drop
+ "test space.snd" save-sound-as drop
ind close-sound drop
- $" test space.snd" open-sound to ind
- ind short-file-name $" test space.snd" $" file name with space" #() snd-test-neq
- ind frames $" test space.snd" mus-sound-frames $" spaced filename frames" #() snd-test-neq
+ "test space.snd" open-sound to ind
+ ind short-file-name "test space.snd" "file name with space" #() snd-test-neq
+ ind framples "test space.snd" mus-sound-framples "spaced filename framples"
+ #() snd-test-neq
1234 ind 0 add-mark drop
- ind save-marks drop \ ; should write "test space.marks"
+ ind save-marks drop \ ; should write "test space.marks"
ind close-sound drop
- $" test space.snd" open-sound to ind
- file-pwd "/" $+ $" test space.marks" $+ file-eval
+ "test space.snd" open-sound to ind
+ file-pwd "/" $+ "test space.marks" $+ file-eval
1234 ind find-mark unless
- $" space file name save marks?" #() snd-display
+ "space file name save marks?" #() snd-display
then
- :file $" test space.snd" make-readin { rd }
- rd mus-file-name $" test space.snd" $" file name with space readin" #() snd-test-neq
+ :file "test space.snd" make-readin { rd }
+ rd mus-file-name "test space.snd" "file name with space readin" #()
+ snd-test-neq
ind close-sound drop
- $" test space.snd" file-delete
- $" test space.marks" file-delete
- \ FIXME
- \ S7 specific tests skipped
+ "test space.snd" file-delete
+ "test space.marks" file-delete
+ \ XXX: S7 specific tests skipped
;
: 04-sndlib ( -- )
@@ -4341,7 +4239,7 @@ black-and-white-colormap constant *better-colormap*
i to *clmtest*
*snd-test-verbose*
*tests* 1 > && if
- $" clmtest %d of %d" #( *clmtest* 1+ *tests* ) snd-test-message
+ "clmtest %d of %d" #( *clmtest* 1+ *tests* ) snd-test-message
then
clear-listener drop
(04-sndlib-01)
@@ -4367,18 +4265,11 @@ half-pi fnegate constant -half-pi
incr 2 >vct
;
-: cosine-channel-via-ptree <{ :optional beg 0 dur #f snd #f chn #f edpos #f -- }>
- <'> ccvp-01-cb
- beg dur snd chn edpos #t
- <'> ccvp-02-cb
- ptree-channel drop
-;
-
0 value a-ctr
0 value g-init-val
: append-sound { fname -- }
- fname undef undef undef frames insert-sound drop
+ fname undef undef undef framples insert-sound drop
;
: cc-01-cb { incr -- prc; y self -- r }
@@ -4392,20 +4283,22 @@ half-pi fnegate constant -half-pi
;
: cosine-channel <{ :optional beg 0 dur #f snd #f chn #f edpos #f -- }>
- pi dur if dur else snd chn undef frames then f/ ( incr ) cc-01-cb
- beg dur snd chn edpos
- map-channel drop
+ pi dur if
+ dur
+ else
+ snd chn undef framples
+ then f/ ( incr ) cc-01-cb beg dur snd chn edpos map-channel drop
;
: (05-simple-check-01) ( -- )
playing if
- $" dac is running??" #() snd-display
+ "dac is running??" #() snd-display
then
"oboe.snd" open-sound { ind }
#t ind 0 set-transform-graph? drop
graph-as-sonogram ind 0 set-transform-graph-type drop
"hiho" ind 0 1 <'> y-axis-label 'no-such-axis nil fth-catch if
- $" no fft axis?" #() snd-display
+ "no fft axis?" #() snd-display
then
stack-reset
#t ind 0 set-fft-log-frequency drop
@@ -4418,12 +4311,119 @@ half-pi fnegate constant -half-pi
i to *clmtest*
*snd-test-verbose*
*tests* 1 > && if
- $" clmtest %d of %d" #( *clmtest* 1+ *tests* ) snd-test-message
+ "clmtest %d of %d" #( *clmtest* 1+ *tests* ) snd-test-message
then
(05-simple-check-01)
loop
;
+\ ---------------- test 08: clm ----------------
+
+lambda: <{ -- r }> 0.0 ; value 08-clm-lambda-0.0
+lambda: <{ dir -- r }> 1.0 ; value 08-clm-lambda-dir-1.0
+lambda: <{ a b c -- r }> 1.0 ; value 08-clm-lambda-a-b-c-1.0
+32 make-delay constant make-delay-32
+
+\ xen-mus-apply (using mus-run):
+\ S7: (gen arg)
+\ Ruby: gen.call(arg)
+\ Forth: gen '( arg ) apply
+\
+\ mus-apply ( args -- res )
+\ mus-run ( gen :optional arg1 0.0 arg2 0.0 -- res )
+
+: random-gen-run ( ?? make-prc random-args -- )
+ { make-prc random-args }
+ make-prc #t nil fth-catch if
+ stack-reset
+ nil
+ then { gen }
+ nil { arg }
+ gen mus-generator? if
+ random-args each to arg
+ \ ~608.375s apply
+ \ ~701.320s mus-run
+ \ ~500.867s mus-apply
+ \ gen '( arg ) <'> apply #t nil fth-catch
+ \ gen arg undef <'> mus-run #t nil fth-catch
+ gen arg <'> mus-apply #t nil fth-catch
+ stack-reset
+ end-each
+ then
+;
+
+: random-gen ( -- )
+ #( 2.0 21.5 **
+ 2.0 -18.0 **
+ 1.5
+ "/hiho"
+ list( 0 1 )
+ 1234
+ vct( 0 0 0 )
+ 0.1 0.2 0.3 make-color-with-catch
+ #( 0 1 )
+ 3/4
+ 0+i
+ make-delay-32
+ 08-clm-lambda-0.0
+ 08-clm-lambda-dir-1.0
+ 08-clm-lambda-a-b-c-1.0
+ 0
+ 1
+ -1
+ #f
+ #t
+ <char> c
+ 0.0
+ 1.0
+ -1.0
+ '()
+ 32
+ '( 1 2 ) ) { random-args }
+ #( <'> make-all-pass <'> make-asymmetric-fm <'> make-moving-average
+ <'> make-moving-max <'> make-moving-norm <'> make-table-lookup
+ <'> make-triangle-wave <'> make-comb <'> make-delay <'> make-env
+ <'> make-fft-window <'> make-filter <'> make-filtered-comb
+ <'> make-fir-filter <'> make-formant <'> make-iir-filter <'> make-locsig
+ <'> make-notch <'> make-one-pole <'> make-one-pole-all-pass
+ <'> make-one-zero <'> make-oscil <'> make-pulse-train
+ <'> make-rand <'> make-rand-interp <'> make-sawtooth-wave
+ <'> make-polyshape <'> make-polywave <'> make-square-wave
+ <'> make-two-pole <'> make-two-zero <'> make-wave-train
+ <'> make-ssb-am ) { gen-make-procs }
+ nil { make-prc }
+ nil nil nil nil { arg1 arg2 arg3 arg4 }
+ gen-make-procs each to make-prc
+ make-prc random-args random-gen-run
+ end-each
+ random-args each to arg1
+ gen-make-procs each to make-prc
+ arg1 make-prc random-args random-gen-run
+ end-each
+ random-args each to arg2
+ gen-make-procs each to make-prc
+ arg1 arg2 make-prc random-args random-gen-run
+ end-each
+ random-args each to arg3
+ gen-make-procs each to make-prc
+ arg1 arg2 arg3 make-prc random-args random-gen-run
+ end-each
+ random-args each to arg4
+ gen-make-procs each to make-prc
+ arg1 arg2 arg3 arg4 make-prc random-args random-gen-run
+ end-each
+ end-each
+ end-each
+ end-each
+ end-each
+;
+
+: 08-clm ( -- )
+ all-args if
+ random-gen
+ then
+;
+
\ ---------------- test 10: marks ----------------
: 10-marks ( -- )
@@ -4431,71 +4431,71 @@ half-pi fnegate constant -half-pi
123 add-mark drop
234 ind 0 "hiho" 1 add-mark drop
345 ind 0 #f 1 add-mark drop
- 456 ind 0 $" a mark" 2 add-mark drop
+ 456 ind 0 "a mark" 2 add-mark drop
567 ind 0 #f 1 add-mark drop
ind "oboe.marks" save-marks drop
ind close-sound drop
"oboe.snd" open-sound to ind
- 1 ind 0 $" new mark" 1 add-mark drop
+ 1 ind 0 "new mark" 1 add-mark drop
"oboe.marks" file-eval
123 ind 0 find-mark { m }
m mark? if
m mark-name length zero? unless
- $" saved mark 123 name: %s?" #( m mark-name ) snd-display
+ "saved mark 123 name: %s?" #( m mark-name ) snd-display
then
m mark-sync zero? unless
- $" saved mark 123 sync: %s?" #( m mark-sync ) snd-display
+ "saved mark 123 sync: %s?" #( m mark-sync ) snd-display
then
else
- $" saved marks missed 123: %s?" #( m ) snd-display
+ "saved marks missed 123: %s?" #( m ) snd-display
then
234 ind 0 find-mark to m
m mark? if
- m mark-name $" hiho" string<> if
- $" saved mark 234 name: %s?" #( m mark-name ) snd-display
+ m mark-name "hiho" string<> if
+ "saved mark 234 name: %s?" #( m mark-name ) snd-display
then
m mark-sync { m2sync }
m2sync 0= m2sync 1 = || if
- $" saved mark 234 sync: %s?" #( m mark-sync ) snd-display
+ "saved mark 234 sync: %s?" #( m mark-sync ) snd-display
then
m mark-sync
else
- $" saved marks missed 234: %s?" #( m ) snd-display
+ "saved marks missed 234: %s?" #( m ) snd-display
0
then { m1-sync }
345 ind 0 find-mark to m
m mark? if
m mark-name length zero? unless
- $" saved mark 345 name: %s?" #( m mark-name ) snd-display
+ "saved mark 345 name: %s?" #( m mark-name ) snd-display
then
m mark-sync m1-sync <> if
- $" saved mark 345 sync: %s %s?" #( m mark-sync m1-sync ) snd-display
+ "saved mark 345 sync: %s %s?" #( m mark-sync m1-sync ) snd-display
then
else
- $" saved marks missed 345: %s?" #( m ) snd-display
+ "saved marks missed 345: %s?" #( m ) snd-display
then
456 ind 0 find-mark to m
m mark? if
- m mark-name $" a mark" string<> if
- $" saved mark 456 name: %s?" #( m mark-name ) snd-display
+ m mark-name "a mark" string<> if
+ "saved mark 456 name: %s?" #( m mark-name ) snd-display
then
m mark-sync { m4sync }
m4sync m1-sync = m4sync 0= || m4sync 1 = || if
- $" saved mark 456 sync: %s %s?" #( m mark-sync m1-sync ) snd-display
+ "saved mark 456 sync: %s %s?" #( m mark-sync m1-sync ) snd-display
then
else
- $" saved marks missed 456: %s?" #( m ) snd-display
+ "saved marks missed 456: %s?" #( m ) snd-display
then
567 ind 0 find-mark to m
m mark? if
m mark-name length zero? unless
- $" saved mark 567 name: %s?" #( m mark-name ) snd-display
+ "saved mark 567 name: %s?" #( m mark-name ) snd-display
then
m mark-sync m1-sync <> if
- $" saved mark 567 sync: %s %s?" #( m mark-sync m1-sync ) snd-display
+ "saved mark 567 sync: %s %s?" #( m mark-sync m1-sync ) snd-display
then
else
- $" saved marks missed 567: %s?" #( m ) snd-display
+ "saved marks missed 567: %s?" #( m ) snd-display
then
ind close-sound drop
;
@@ -4515,7 +4515,7 @@ half-pi fnegate constant -half-pi
: freq-peak { beg ind size -- lst }
beg size ind 0 channel->vct { data }
- data blackman2-window size snd-spectrum { spectr }
+ data blackman2-window size #t 0.0 #f #t snd-spectrum { spectr }
0.0 { peak0 }
0 { pk0loc }
size 2/ 0 ?do
@@ -4548,11 +4548,11 @@ half-pi fnegate constant -half-pi
16 1.0 dolph { val1 }
dolph-chebyshev-window 16 1.0 make-fft-window { val2 }
val1 val2 vequal? unless
- $" dolph/dolph 1: %s %s" #( val1 val2 ) snd-display
+ "dolph/dolph 1: %s %s" #( val1 val2 ) snd-display
then
16 1.0 dolph-1 to val1
val1 val2 vequal? unless
- $" dolph-1/dolph 1: %s %s" #( val1 val2 ) snd-display
+ "dolph-1/dolph 1: %s %s" #( val1 val2 ) snd-display
then
;
[else]
@@ -4561,7 +4561,7 @@ half-pi fnegate constant -half-pi
: 15-chan-local-vars ( -- )
\ dsp.fs
- "test.snd" mus-next mus-bfloat 22050 1 $" src-* tests" 10000 new-sound { ind }
+ "test.snd" 1 22050 mus-bfloat mus-next "src-* tests" 10000 new-sound { ind }
\ src-duration tests
#( 0 1 1 2 ) src-duration { d1 }
#( 0 2 1 1 ) src-duration { d2 }
@@ -4571,7 +4571,7 @@ half-pi fnegate constant -half-pi
d2 d1 fneq ||
d3 d1 fneq ||
d4 d1 fneq || if
- $" src-duration test1: %f %f %f %f" #( d1 d2 d3 d4 ) snd-display
+ "src-duration test1: %f %f %f %f" #( d1 d2 d3 d4 ) snd-display
then
#( 0 1 1 0.5 ) src-duration to d1
#( 0 0.5 1 1 ) src-duration to d2
@@ -4581,50 +4581,50 @@ half-pi fnegate constant -half-pi
d2 d1 fneq ||
d3 d1 fneq ||
d4 d1 fneq || if
- $" src-duration test2: %f %f %f %f" #( d1 d2 d3 d4 ) snd-display
+ "src-duration test2: %f %f %f %f" #( d1 d2 d3 d4 ) snd-display
then
#( 0 1 1 1 ) src-duration to d1
#( 0 2 1 2 ) src-duration to d2
d1 1.0 fneq
d2 0.5 fneq || if
- $" src-duration test3: %f %f" #( d1 d2 ) snd-display
+ "src-duration test3: %f %f" #( d1 d2 ) snd-display
then
#( 0 0.5 0.5 3 0.6 1 0.7 0.1 0.8 1.5 1 1 ) src-duration to d1
d1 1.02474349685432 fneq if
- $" src-duration test4: %f" #( d1 ) snd-display
+ "src-duration test4: %f" #( d1 ) snd-display
then
#( 0 1 1 2 2 1 ) src-duration to d1
d1 0.693147180559945 fneq if
- $" src-duration test5: %f" #( d1 ) snd-display
+ "src-duration test5: %f" #( d1 ) snd-display
then
500.0 0.0 make-oscil src-test15-cb map-channel drop
0 ind 8192 freq-peak { vals }
500.0 vals 0 array-ref f4neq
1.0 vals 1 array-ref fneq || if
- $" src no-test: %s" #( vals ) snd-display
+ "src no-test: %s" #( vals ) snd-display
then
ind close-sound drop
- \
+ \
dolph-test
\ env.fs
\ envelope-interp
0.1 #( 0 0 1 1 ) 1.0 envelope-interp dup 0.1 fneq if
- $" envelope-interp 0.1: %s?" swap snd-display
+ "envelope-interp 0.1: %s?" swap snd-display
else
drop
then
0.1 #( 0 0 1 1 ) 32.0 envelope-interp dup 0.01336172 fneq if
- $" envelope-interp 0.013: %s?" swap snd-display
+ "envelope-interp 0.013: %s?" swap snd-display
else
drop
then
0.1 #( 0 0 1 1 ) 0.012 envelope-interp dup 0.36177473 fneq if
- $" envelope-interp 0.361: %s?" swap snd-display
+ "envelope-interp 0.361: %s?" swap snd-display
else
drop
then
0.3 #( 0 0 0.5 1 1 0 ) 1.0 envelope-interp dup 0.6 fneq if
- $" envelope-interp 0.3 #( 0 0 0.5 1 1 0 ): %s?" swap snd-display
+ "envelope-interp 0.3 #( 0 0 0.5 1 1 0 ): %s?" swap snd-display
else
drop
then
@@ -4632,200 +4632,216 @@ half-pi fnegate constant -half-pi
1.0 3.0 #( 0.0 0.0 5.0 1.0 ) window-envelope dup #( 1.0 0.2 3.0 0.6 ) feql if
drop
else
- 1 >array $" window-envelope: %s?" swap snd-display
+ 1 >array "window-envelope: %s?" swap snd-display
then
\ multiply-envelopes
- #( 0 0 1 1 ) #( 0 0 1 1 2 0 ) multiply-envelopes dup #( 0 0 0.5 0.5 1 0 ) feql if
+ #( 0 0 1 1 ) #( 0 0 1 1 2 0 ) multiply-envelopes dup
+ #( 0 0 0.5 0.5 1 0 ) feql if
drop
else
- 1 >array $" multiply-envelopes: %s?" swap snd-display
+ 1 >array "multiply-envelopes: %s?" swap snd-display
then
\ max-envelope
#( 0 0 1 1 2 3 4 0 ) max-envelope dup 3.0 fneq if
- $" max-envelopes (0): %s?" swap snd-display
+ "max-envelopes (0): %s?" swap snd-display
else
drop
then
#( 0 1 ) max-envelope dup 1.0 fneq if
- $" max-envelopes (1): %s?" swap snd-display
+ "max-envelopes (1): %s?" swap snd-display
else
drop
then
#( 0 1 1 1 2 2 ) max-envelope dup 2.0 fneq if
- $" max-envelopes (2): %s?" swap snd-display
+ "max-envelopes (2): %s?" swap snd-display
else
drop
then
#( 0 -1 1 -2 ) max-envelope dup -1.0 fneq if
- $" max-envelopes (3): %s?" swap snd-display
+ "max-envelopes (3): %s?" swap snd-display
else
drop
then
#( 0 -2 1 -1 ) max-envelope dup -1.0 fneq if
- $" max-envelopes (4): %s?" swap snd-display
+ "max-envelopes (4): %s?" swap snd-display
else
drop
then
\ min-envelope
#( 0 0 1 1 2 3 4 0 ) min-envelope dup 0.0 fneq if
- $" min-envelopes (0): %s?" swap snd-display
+ "min-envelopes (0): %s?" swap snd-display
else
drop
then
#( 0 1 ) min-envelope dup 1.0 fneq if
- $" min-envelopes (1): %s?" swap snd-display
+ "min-envelopes (1): %s?" swap snd-display
else
drop
then
#( 0 1 1 1 2 2 ) min-envelope dup 1.0 fneq if
- $" min-envelopes (2): %s?" swap snd-display
+ "min-envelopes (2): %s?" swap snd-display
else
drop
then
#( 0 -1 1 -2 ) min-envelope dup -2.0 fneq if
- $" min-envelopes (3): %s?" swap snd-display
+ "min-envelopes (3): %s?" swap snd-display
else
drop
then
#( 0 -2 1 -1 ) min-envelope dup -2.0 fneq if
- $" min-envelopes (4): %s?" swap snd-display
+ "min-envelopes (4): %s?" swap snd-display
else
drop
then
\ integrate-envelope
#( 0 0 1 1 ) integrate-envelope dup 0.5 fneq if
- $" integrate-envelopes (0): %s?" swap snd-display
+ "integrate-envelopes (0): %s?" swap snd-display
else
drop
then
#( 0 1 1 1 ) integrate-envelope dup 1.0 fneq if
- $" integrate-envelopes (1): %s?" swap snd-display
+ "integrate-envelopes (1): %s?" swap snd-display
else
drop
then
#( 0 0 1 1 2 0.5 ) integrate-envelope dup 1.25 fneq if
- $" integrate-envelopes (2): %s?" swap snd-display
+ "integrate-envelopes (2): %s?" swap snd-display
else
drop
then
\ stretch-envelope
- #( 0 0 1 1 ) 0.1 0.2 #f #f stretch-envelope dup #( 0 0 0.2 0.1 1.0 1 ) feql if
+ #( 0 0 1 1 ) 0.1 0.2 #f #f stretch-envelope dup #( 0 0 0.2 0.1 1.0 1 )
+ feql if
drop
else
- 1 >array $" stretch-envelope att: %s?" swap snd-display
+ 1 >array "stretch-envelope att: %s?" swap snd-display
then
- #( 0 0 1 1 2 0 ) 0.1 0.2 1.5 1.6 stretch-envelope dup #( 0 0 0.2 0.1 1.1 1 1.6 0.5 2 0 ) feql if
+ #( 0 0 1 1 2 0 ) 0.1 0.2 1.5 1.6 stretch-envelope
+ dup #( 0 0 0.2 0.1 1.1 1 1.6 0.5 2 0 ) feql if
drop
else
- 1 >array $" stretch-envelope dec: %s?" swap snd-display
+ 1 >array "stretch-envelope dec: %s?" swap snd-display
then
\ add-envelopes
- #( 0 0 1 1 2 0 ) #( 0 0 1 1 ) add-envelopes dup #( 0 0 0.5 1.5 1 1 ) feql if
+ #( 0 0 1 1 2 0 ) #( 0 0 1 1 ) add-envelopes
+ dup #( 0 0 0.5 1.5 1 1 ) feql if
drop
else
- 1 >array $" add-envelopes: %s?" swap snd-display
+ 1 >array "add-envelopes: %s?" swap snd-display
then
\ scale-envelope
#( 0 0 1 1 ) 2 0 scale-envelope dup #( 0 0 1 2 ) feql if
drop
else
- 1 >array $" scale-envelope: %s?" swap snd-display
+ 1 >array "scale-envelope: %s?" swap snd-display
then
#( 0 0 1 1 ) 2 1 scale-envelope dup #( 0 1 1 3 ) feql if
drop
else
- 1 >array $" scale-envelope off: %s?" swap snd-display
+ 1 >array "scale-envelope off: %s?" swap snd-display
then
\ reverse-envelope
#( 0 0 1 1 ) reverse-envelope dup #( 0 1 1 0 ) feql if
drop
else
- 1 >array $" reverse-envelope ramp: %s?" swap snd-display
+ 1 >array "reverse-envelope ramp: %s?" swap snd-display
then
#( 0 0 0.5 1 2 0 ) reverse-envelope dup #( 0 0 1.5 1 2 0 ) feql if
drop
else
- 1 >array $" reverse-envelope ramp 2: %s?" swap snd-display
+ 1 >array "reverse-envelope ramp 2: %s?" swap snd-display
then
#( 0 0 0.5 1 2 1 ) reverse-envelope dup #( 0 1 1.5 1 2 0 ) feql if
drop
else
- 1 >array $" reverse-envelope ramp 2: %s?" swap snd-display
+ 1 >array "reverse-envelope ramp 2: %s?" swap snd-display
then
\ concatenate-envelopes (from snd/env.scm)
- #( 0 0 1 1 ) #( 0 1 1 0 ) 2 concatenate-envelopes dup #( 0.0 0 1.0 1 2.0 0 ) feql if
+ #( 0 0 1 1 ) #( 0 1 1 0 ) 2 concatenate-envelopes
+ dup #( 0.0 0 1.0 1 2.0 0 ) feql if
drop
else
- 1 >array $" concatenate-envelopes (0): %s?" swap snd-display
+ 1 >array "concatenate-envelopes (0): %s?" swap snd-display
then
- #( 0 0 1 1.5 ) #( 0 1 1 0 ) 2 concatenate-envelopes dup #( 0.0 0 1.0 1.5 1.01 1 2.01 0 ) feql if
+ #( 0 0 1 1.5 ) #( 0 1 1 0 ) 2 concatenate-envelopes
+ dup #( 0.0 0 1.0 1.5 1.01 1 2.01 0 ) feql if
drop
else
- 1 >array $" concatenate-envelopes (1): %s?" swap snd-display
+ 1 >array "concatenate-envelopes (1): %s?" swap snd-display
then
\ envelope-concatenate (from clm/env.lisp)
- #( 0 0 1 1 ) #( 0 1 1 0 ) 2 envelope-concatenate dup #( 0.0 0 1.0 1 1.01 1 2.01 0 ) feql if
+ #( 0 0 1 1 ) #( 0 1 1 0 ) 2 envelope-concatenate
+ dup #( 0.0 0 1.0 1 1.01 1 2.01 0 ) feql if
drop
else
- 1 >array $" envelope-concatenate (0): %s?" swap snd-display
+ 1 >array "envelope-concatenate (0): %s?" swap snd-display
then
- #( 0 0 1 1.5 ) #( 0 1 1 0 ) 2 envelope-concatenate dup #( 0.0 0 1.0 1.5 1.01 1 2.01 0 ) feql if
+ #( 0 0 1 1.5 ) #( 0 1 1 0 ) 2 envelope-concatenate
+ dup #( 0.0 0 1.0 1.5 1.01 1 2.01 0 ) feql if
drop
else
- 1 >array $" envelope-concatenate (1): %s?" swap snd-display
+ 1 >array "envelope-concatenate (1): %s?" swap snd-display
then
\ repeat-envelope
- #( 0 0 1 100 ) 2 #f #f repeat-envelope dup #( 0 0 1 100 1.01 0 2.01 100 ) feql if
+ #( 0 0 1 100 ) 2 #f #f repeat-envelope
+ dup #( 0 0 1 100 1.01 0 2.01 100 ) feql if
drop
else
- 1 >array $" repeat-envelope (0): %s?" swap snd-display
+ 1 >array "repeat-envelope (0): %s?" swap snd-display
then
- #( 0 0 1.5 1 2 0 ) 2 #f #f repeat-envelope dup #( 0 0 1.5 1 2.0 0 3.5 1 4.0 0 ) feql if
+ #( 0 0 1.5 1 2 0 ) 2 #f #f repeat-envelope
+ dup #( 0 0 1.5 1 2.0 0 3.5 1 4.0 0 ) feql if
drop
else
- 1 >array $" repeat-envelope (1): %s?" swap snd-display
+ 1 >array "repeat-envelope (1): %s?" swap snd-display
then
- #( 0 0 1.5 1 2 0 ) 2 #f #t repeat-envelope dup #( 0.0 0 0.75 1 1.0 0 1.75 1 2.0 0 ) feql if
+ #( 0 0 1.5 1 2 0 ) 2 #f #t repeat-envelope
+ dup #( 0.0 0 0.75 1 1.0 0 1.75 1 2.0 0 ) feql if
drop
else
- 1 >array $" repeat-envelope (2): %s?" swap snd-display
+ 1 >array "repeat-envelope (2): %s?" swap snd-display
then
- #( 0 0 1.5 1 2 0 ) 2 #t #f repeat-envelope dup #( 0 0 1.5 1 2.0 0 2.5 1 4.0 0 ) feql if
+ #( 0 0 1.5 1 2 0 ) 2 #t #f repeat-envelope
+ dup #( 0 0 1.5 1 2.0 0 2.5 1 4.0 0 ) feql if
drop
else
- 1 >array $" repeat-envelope (3): %s?" swap snd-display
+ 1 >array "repeat-envelope (3): %s?" swap snd-display
then
#( 0 0 1.5 1 2 0 ) 3 #f #f repeat-envelope dup
#( 0 0 1.5 1 2.0 0 3.5 1 4.0 0 5.5 1 6.0 0 ) feql if
drop
else
- 1 >array $" repeat-envelope (4): %s?" swap snd-display
+ 1 >array "repeat-envelope (4): %s?" swap snd-display
then
\ normalize-envelope
- #( 0 0 1 1.5 2.0 1.0 ) normalize-envelope dup #( 0 0.0 1 1.0 2.0 0.667 ) feql if
+ #( 0 0 1 1.5 2.0 1.0 ) normalize-envelope dup #( 0 0.0 1 1.0 2.0 0.667 )
+ feql if
drop
else
- 1 >array $" normalize-envelope (0): %s?" swap snd-display
+ 1 >array "normalize-envelope (0): %s?" swap snd-display
then
- #( 0 0 1 0.5 2 -0.8 ) normalize-envelope dup #( 0 0.0 1 0.625 2 -1.0 ) feql if
+ #( 0 0 1 0.5 2 -0.8 ) normalize-envelope dup #( 0 0.0 1 0.625 2 -1.0 )
+ feql if
drop
else
- 1 >array $" normalize-envelope (1): %s?" swap snd-display
+ 1 >array "normalize-envelope (1): %s?" swap snd-display
then
\ envelope-exp
#( 0 0 1 1 ) 2.0 10 envelope-exp dup
- #( 0 0 0.1 0.01 0.2 0.04 0.3 0.09 0.4 0.16 0.5 0.25 0.6 0.36 0.7 0.49 0.8 0.64 0.9 0.81 1 1 )
+ #( 0 0 0.1 0.01 0.2 0.04 0.3 0.09 0.4 0.16
+ 0.5 0.25 0.6 0.36 0.7 0.49 0.8 0.64 0.9 0.81 1 1 )
feql if
drop
else
- 1 >array $" envelope-exp (0): %s?" swap snd-display
+ 1 >array "envelope-exp (0): %s?" swap snd-display
then
#( 0 0 1 1 2 0 ) 1.0 10 envelope-exp dup
- #( 0 0 0.2 0.2 0.4 0.4 0.6 0.6 0.8 0.8 1 1 1.2 0.8 1.4 0.6 1.6 0.4 1.8 0.2 2 0 )
+ #( 0 0 0.2 0.2 0.4 0.4 0.6 0.6 0.8 0.8 1 1
+ 1.2 0.8 1.4 0.6 1.6 0.4 1.8 0.2 2 0 )
feql if
drop
else
- 1 >array $" envelope-exp (1): %s?" swap snd-display
+ 1 >array "envelope-exp (1): %s?" swap snd-display
then
;
@@ -4836,221 +4852,219 @@ half-pi fnegate constant -half-pi
;
: random-pi-func <{ x -- y }> pi random ;
-lambda: <{ x -- y }> pi random ; value random-pi-addr
#( #( lambda: <{ -- val }> vct( 1.0 0.5 ) 0 2 #f #f #f insert-vct ;
- $" lambda: <{ snd chn -- val }> vct( 1.000 0.500 ) 0 2 snd chn insert-vct drop ;"
+ "lambda: <{ snd chn -- val }> vct( 1.000 0.500 ) 0 2 snd chn insert-vct drop ;"
"insert-vct" )
#( lambda: <{ -- val }> #f #f clm-channel-test ;
- $" lambda: <{ snd chn -- val }> snd chn clm-channel-test drop ;"
+ "lambda: <{ snd chn -- val }> snd chn clm-channel-test drop ;"
"clm-channel-test" )
( examp.fs )
#( lambda: <{ -- val }> 1000 3000 #f #f fft-edit ;
- $" lambda: <{ snd chn -- val }> 1000 3000 snd chn fft-edit drop ;"
+ "lambda: <{ snd chn -- val }> 1000 3000 snd chn fft-edit drop ;"
"fft-edit" )
#( lambda: <{ -- val }> 0.01 #f #f fft-squelch ;
- $" lambda: <{ snd chn -- val }> 0.01 snd chn fft-squelch drop ;"
+ "lambda: <{ snd chn -- val }> 0.01 snd chn fft-squelch drop ;"
"fft-sqelch" )
#( lambda: <{ -- val }> 1000 3000 #f #f fft-cancel ;
- $" lambda: <{ snd chn -- val }> 1000 3000 snd chn fft-cancel drop ;"
+ "lambda: <{ snd chn -- val }> 1000 3000 snd chn fft-cancel drop ;"
"fft-cancel" )
#( lambda: <{ -- val }> #f #f squelch-vowels ;
- $" lambda: <{ snd chn -- val }> snd chn squelch-vowels drop ;"
+ "lambda: <{ snd chn -- val }> snd chn squelch-vowels drop ;"
"squelch-vowels" )
#( lambda: <{ -- val }> #( 0 0 1 1 2 0 ) #f #f fft-env-edit ;
- $" lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) snd chn fft-env-edit drop ;"
+ "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) snd chn fft-env-edit drop ;"
"fft-env-edit" )
- #( lambda: <{ -- val }> #( 0 0 1 1 2 0 ) #( 0 1 1 0 2 0 ) #( 0 0 1 1 ) #f #f fft-env-interp ;
- $" lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) #( 0 1 1 0 2 0 ) #( 0 0 1 1 ) snd chn fft-env-interp drop ;"
+ #( lambda: <{ -- val }>
+ #( 0 0 1 1 2 0 ) #( 0 1 1 0 2 0 ) #( 0 0 1 1 ) #f #f fft-env-interp
+ ;
+ "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) #( 0 1 1 0 2 0 ) #( 0 0 1 1 ) snd chn fft-env-interp drop ;"
"fft-env-interp" )
#( lambda: <{ -- val }> 10 0.1 #f #f hello-dentist ;
- $" lambda: <{ snd chn -- val }> 10 0.1 snd chn hello-dentist drop ;"
+ "lambda: <{ snd chn -- val }> 10 0.1 snd chn hello-dentist drop ;"
"hello-dentist" )
#( lambda: <{ -- val }> 1 0.3 20 #f #f fp ;
- $" lambda: <{ snd chn -- val }> 1 0.3 20 snd chn fp drop ;"
+ "lambda: <{ snd chn -- val }> 1 0.3 20 snd chn fp drop ;"
"fp" )
#( lambda: <{ -- val }> #( 0 1 1 2 ) #f #f expsnd ;
- $" lambda: <{ snd chn -- val }> #( 0 1 1 2 ) snd chn expsnd drop ;"
+ "lambda: <{ snd chn -- val }> #( 0 1 1 2 ) snd chn expsnd drop ;"
"expsnd" )
#( lambda: <{ -- val }> 1 256 2 2 #f #f voiced->unvoiced ;
- $" lambda: <{ snd chn -- val }> 1 256 2 2 snd chn voiced->unvoiced drop ;"
- "voiced->unvoided" )
+ "lambda: <{ snd chn -- val }> 1 256 2 2 snd chn voiced->unvoiced drop ;"
+ "voiced->unvoiced" )
#( lambda: <{ -- val }> #( 0 0 1 1 2 0 ) 2 #f #f env-sound-interp ;
- $" lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) 2 snd chn env-sound-interp drop ;"
+ "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) 2 snd chn env-sound-interp drop ;"
"env-sound-interp" )
#( lambda: <{ -- val }> #( #( "1a.snd" ) #( "pistol.snd" 1 2 ) ) #f #f add-notes ;
- $" lambda: <{ snd chn -- val }> #( #( \"1a.snd\" ) #( \"pistol.snd\" 1 2 ) ) snd chn add-notes drop ;"
+ "lambda: <{ snd chn -- val }> #( #( \"1a.snd\" ) #( \"pistol.snd\" 1 2 ) ) snd chn add-notes drop ;"
"add-notes" )
- #( lambda: <{ -- val }> 0 #f #f #f compand-channel ;
- $" lambda: <{ snd chn -- val }> 0 #f snd chn compand-channel drop ;"
- "compand-channel" )
- #( lambda: <{ -- val }> 0 #f #f #f #f smooth-channel-via-ptree ;
- $" lambda: <{ snd chn -- val }> 0 #f snd chn smooth-channel-via-ptree drop ;"
- "smooth-channel-via-ptree" )
- #( lambda: <{ -- val }> 300 0 #f #f #f #f ring-modulate-channel ;
- $" lambda: <{ snd chn -- val }> 300 0 #f snd chn ring-modulate-channel drop ;"
- "ring-modulate-channel" )
#( lambda: <{ -- val }> #( 0 0 1 1 2 0 ) #f #f filtered-env ;
- $" lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) snd chn filtered-env drop ;"
+ "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) snd chn filtered-env drop ;"
"filtered-env" )
#( lambda: <{ -- val }> 0.1 #f #f reverse-by-blocks ;
- $" lambda: <{ snd chn -- val }> 0.1 snd chn reverse-by-blocks drop ;"
+ "lambda: <{ snd chn -- val }> 0.1 snd chn reverse-by-blocks drop ;"
"reverse-by-blocks" )
#( lambda: <{ -- val }> 0.1 #f #f reverse-within-blocks ;
- $" lambda: <{ snd chn -- val }> 0.1 snd chn reverse-within-blocks drop ;"
+ "lambda: <{ snd chn -- val }> 0.1 snd chn reverse-within-blocks drop ;"
"reverse-within-blocks" )
( extensions.fs )
#( lambda: <{ -- val }> "1a.snd" 1200 #f #f #f #f mix-channel ;
- $" lambda: <{ snd chn -- val }> \"1a.snd\" 1200 #f snd chn mix-channel drop ;"
+ "lambda: <{ snd chn -- val }> \"1a.snd\" 1200 #f snd chn mix-channel drop ;"
"mix-channel" )
#( lambda: <{ -- val }> "1a.snd" 1200 #f #f #f #f insert-channel ;
- $" lambda: <{ snd chn -- val }> \"1a.snd\" 1200 #f snd chn insert-channel drop ;"
+ "lambda: <{ snd chn -- val }> \"1a.snd\" 1200 #f snd chn insert-channel drop ;"
"insert-channel" )
#( lambda: <{ -- val }> "1a.snd" 0.5 0.9 0 #f #f #f #f sine-ramp ;
- $" lambda: <{ snd chn -- val }> 0.5 0.9 0 #f snd chn sine-ramp drop ;"
+ "lambda: <{ snd chn -- val }> 0.5 0.9 0 #f snd chn sine-ramp drop ;"
"sine-ramp" )
- #( lambda: <{ -- val }> #( 0 0 1 1 2 -0.5 3 1 ) 0 #f #f #f #f sine-env-channel ;
- $" lambda: <{ snd chn -- val }> #( 0 0 1 1 2 -0.5 3 1 ) 0 #f snd chn sine-env-channel drop ;"
+ #( lambda: <{ -- val }>
+ #( 0 0 1 1 2 -0.5 3 1 ) 0 #f #f #f #f sine-env-channel
+ ;
+ "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 -0.5 3 1 ) 0 #f snd chn sine-env-channel drop ;"
"sine-env-channel" )
#( lambda: <{ -- val }> 0 1 0 #f #f #f #f blackman4-ramp ;
- $" lambda: <{ snd chn -- val }> 0 1 0 #f snd chn blackman4-ramp drop ;"
+ "lambda: <{ snd chn -- val }> 0 1 0 #f snd chn blackman4-ramp drop ;"
"blackman4-ramp" )
- #( lambda: <{ -- val }> #( 0 0 1 1 2 -0.5 3 1 ) 0 #f #f #f #f blackman4-env-channel ;
- $" lambda: <{ snd chn -- val }> #( 0 0 1 1 2 -0.5 3 1 ) 0 #f snd chn blackman4-env-channel drop ;"
+ #( lambda: <{ -- val }>
+ #( 0 0 1 1 2 -0.5 3 1 ) 0 #f #f #f #f blackman4-env-channel
+ ;
+ "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 -0.5 3 1 ) 0 #f snd chn blackman4-env-channel drop ;"
"blackman4-env-channel" )
#( lambda: <{ -- val }> 0.2 0.8 #t 0 #f #f #f #f ramp-squared ;
- $" lambda: <{ snd chn -- val }> 0.2 0.8 #t 0 #f snd chn ramp-squared drop ;"
+ "lambda: <{ snd chn -- val }> 0.2 0.8 #t 0 #f snd chn ramp-squared drop ;"
"ramp-squared" )
#( lambda: <{ -- val }> #( 0 0 1 1 ) #t 0 #f #f #f #f env-squared-channel ;
- $" lambda: <{ snd chn -- val }> #( 0 0 1 1 ) #t 0 #f snd chn env-squared-channel drop ;"
+ "lambda: <{ snd chn -- val }> #( 0 0 1 1 ) #t 0 #f snd chn env-squared-channel drop ;"
"env-squared-channel" )
#( lambda: <{ -- val }> 0.2 0.8 32 #t 0 #f #f #f #f ramp-expt ;
- $" lambda: <{ snd chn -- val }> 0.2 0.8 32 #t 0 #f snd chn ramp-expt drop ;"
+ "lambda: <{ snd chn -- val }> 0.2 0.8 32 #t 0 #f snd chn ramp-expt drop ;"
"ramp-expt" )
#( lambda: <{ -- val }> #( 0 0 1 1 ) 32 #t 0 #f #f #f #f env-expt-channel ;
- $" lambda: <{ snd chn -- val }> #( 0 0 1 1 ) 32 #t 0 #f snd chn env-expt-channel drop ;"
+ "lambda: <{ snd chn -- val }> #( 0 0 1 1 ) 32 #t 0 #f snd chn env-expt-channel drop ;"
"env-expt-channel" )
#( lambda: <{ -- val }> 0.1 0 #f #f #f #f offset-channel ;
- $" lambda: <{ snd chn -- val }> 0.1 0 #f snd chn offset-channel drop ;"
+ "lambda: <{ snd chn -- val }> 0.1 0 #f snd chn offset-channel drop ;"
"offset-channel" )
#( lambda: <{ -- val }> 0.1 0 #f #f #f #f dither-channel ;
- $" lambda: <{ snd chn -- val }> 0.1 0 #f snd chn dither-channel drop ;"
+ "lambda: <{ snd chn -- val }> 0.1 0 #f snd chn dither-channel drop ;"
"dither-channel" )
#( lambda: <{ -- val }> 0.1 0 #f #f #f #f contrast-channel ;
- $" lambda: <{ snd chn -- val }> 0.1 0 #f snd chn contrast-channel drop ;"
+ "lambda: <{ snd chn -- val }> 0.1 0 #f snd chn contrast-channel drop ;"
"contrast-channel" )
( dsp.fs )
#( lambda: <{ -- val }> 550 600 10 40 50 0 #f #f #f #f ssb-bank ;
- $" lambda: <{ snd chn -- val }> 550 600 10 40 50 0 #f snd chn ssb-bank drop ;"
+ "lambda: <{ snd chn -- val }> 550 600 10 40 50 0 #f snd chn ssb-bank drop ;"
"ssb-bank" )
- #( lambda: <{ -- val }> 550 600 #( 0 1 1 2 ) 10 40 50 0 #f #f #f #f ssb-bank-env ;
- $" lambda: <{ snd chn -- val }> 550 600 #( 0 1 1 2 ) 10 40 50 0 #f snd chn ssb-bank-env drop ;"
+ #( lambda: <{ -- val }>
+ 550 600 #( 0 1 1 2 ) 10 40 50 0 #f #f #f #f ssb-bank-env
+ ;
+ "lambda: <{ snd chn -- val }> 550 600 #( 0 1 1 2 ) 10 40 50 0 #f snd chn ssb-bank-env drop ;"
"ssb-bank-env" )
#( lambda: <{ -- val }> 1 #f #f down-oct ;
- $" lambda: <{ snd chn -- val }> 1 snd chn down-oct drop ;"
+ "lambda: <{ snd chn -- val }> 1 snd chn down-oct drop ;"
"donw-oct" )
#( lambda: <{ -- val }> 8 #f #f freqdiv ;
- $" lambda: <{ snd chn -- val }> 8 snd chn freqdiv drop ;"
+ "lambda: <{ snd chn -- val }> 8 snd chn freqdiv drop ;"
"freqdiv" )
#( lambda: <{ -- val }> 8 0 #f #f #f adsat ;
- $" lambda: <{ snd chn -- val }> 8 0 #f snd chn adsat drop ;"
+ "lambda: <{ snd chn -- val }> 8 0 #f snd chn adsat drop ;"
"adsat" )
#( lambda: <{ -- val }> #f #f spike ;
- $" lambda: <{ snd chn -- val }> snd chn spike drop ;"
+ "lambda: <{ snd chn -- val }> snd chn spike drop ;"
"spike" )
#( lambda: <{ -- val }> #f #f zero-phase ;
- $" lambda: <{ snd chn -- val }> snd chn zero-phase drop ;"
+ "lambda: <{ snd chn -- val }> snd chn zero-phase drop ;"
"zero-phase" )
#( lambda: <{ -- val }> <'> random-pi-func #f #f rotate-phase ;
- $" lambda: <{ snd chn -- val }> <'> random-pi-func snd chn rotate-phase drop ;"
- "rotate-phase-proc" )
- #( lambda: <{ -- val }> random-pi-addr #f #f rotate-phase ;
- $" lambda: <{ snd chn -- val }> <'> %s snd chn rotate-phase drop ;" #( random-pi-addr ) format
- "rotate-phase-lambda" )
+ "lambda: <{ snd chn -- val }> <'> random-pi-func snd chn rotate-phase drop ;"
+ "rotate-phase" )
#( lambda: <{ -- val }> 0.5 #f #f brighten-slightly ;
- $" lambda: <{ snd chn -- val }> 0.5 snd chn brighten-slightly drop ;"
+ "lambda: <{ snd chn -- val }> 0.5 snd chn brighten-slightly drop ;"
"brighten-slightly" )
#( lambda: <{ -- val }> 100 40 0 #f #f #f #f shift-channel-pitch ;
- $" lambda: <{ snd chn -- val }> 100 40 0 #f snd chn shift-channel-pitch drop ;"
+ "lambda: <{ snd chn -- val }> 100 40 0 #f snd chn shift-channel-pitch drop ;"
"shift-channel-pitch" )
#( lambda: <{ -- val }> vct( 0.0 0.5 ) #f #f channel-polynomial ;
- $" lambda: <{ snd chn -- val }> vct( 0.000 0.500 ) snd chn channel-polynomial drop ;"
+ "lambda: <{ snd chn -- val }> vct( 0.000 0.500 ) snd chn channel-polynomial drop ;"
"channel-polynomial" )
#( lambda: <{ -- val }> vct( 0.0 1.0 ) #f #f spectral-polynomial ;
- $" lambda: <{ snd chn -- val }> vct( 0.000 1.000 ) snd chn spectral-polynomial drop ;"
+ "lambda: <{ snd chn -- val }> vct( 0.000 1.000 ) snd chn spectral-polynomial drop ;"
"spectral-polynomial" )
- #( lambda: <{ -- val }> #( 60.0 120.0 240.0 ) #f 0 #f #f #f #f #t 2 notch-channel ;
- $" lambda: <{ snd chn -- val }> #( 60.0 120.0 240.0 ) #f 0 #f snd chn notch-channel drop ;"
+ #( lambda: <{ -- val }>
+ #( 60.0 120.0 240.0 ) #f 0 #f #f #f #f #t 2 notch-channel
+ ;
+ "lambda: <{ snd chn -- val }> #( 60.0 120.0 240.0 ) #f 0 #f snd chn notch-channel drop ;"
"notch-channel" )
( effects.fs )
#( lambda: <{ -- val }> 0.1 128 effects-squelch-channel ;
- $" lambda: <{ snd chn -- val }> 0.1 128 snd chn effects-squelch-channel drop ;"
+ "lambda: <{ snd chn -- val }> 0.1 128 snd chn effects-squelch-channel drop ;"
"effects-sqelch-channel" )
#( lambda: <{ -- val }> #f 0.5 0.1 0 #f #f #f effects-echo ;
- $" lambda: <{ snd chn -- val }> #f 0.5 0.1 0 #f snd chn effects-echo drop ;"
+ "lambda: <{ snd chn -- val }> #f 0.5 0.1 0 #f snd chn effects-echo drop ;"
"effects-echo" )
#( lambda: <{ -- val }> 0.5 0.1 #f 0 #f #f #f effects-flecho ;
- $" lambda: <{ snd chn -- val }> 0.5 0.1 #f 0 #f snd chn effects-flecho drop ;"
+ "lambda: <{ snd chn -- val }> 0.5 0.1 #f 0 #f snd chn effects-flecho drop ;"
"effects-flecho" )
#( lambda: <{ -- val }> 0.75 0.75 6.0 10.0 #f 0 #f #f #f effects-zecho ;
- $" lambda: <{ snd chn -- val }> 0.75 0.75 6.0 10.0 #f 0 #f snd chn effects-zecho drop ;"
+ "lambda: <{ snd chn -- val }> 0.75 0.75 6.0 10.0 #f 0 #f snd chn effects-zecho drop ;"
"effects-zecho" )
#( lambda: <{ -- val }> 0.1 50 0 #f #f #f effects-comb-filter ;
- $" lambda: <{ snd chn -- val }> 0.1 50 0 #f snd chn effects-comb-filter drop ;"
+ "lambda: <{ snd chn -- val }> 0.1 50 0 #f snd chn effects-comb-filter drop ;"
"effects-comb-filter" )
#( lambda: <{ -- val }> 10000 0.5 0 #f #f #f effects-moog ;
- $" lambda: <{ snd chn -- val }> 10000 0.5 0 #f snd chn effects-moog drop ;"
+ "lambda: <{ snd chn -- val }> 10000 0.5 0 #f snd chn effects-moog drop ;"
"effects-moog" )
#( lambda: <{ -- val }> #f #f effects-remove-dc ;
- $" lambda: <{ snd chn -- val }> snd chn effects-remove-dc drop ;"
+ "lambda: <{ snd chn -- val }> snd chn effects-remove-dc drop ;"
"effects-remove-dc" )
#( lambda: <{ -- val }> #f #f effects-compand ;
- $" lambda: <{ snd chn -- val }> snd chn effects-compand drop ;"
+ "lambda: <{ snd chn -- val }> snd chn effects-compand drop ;"
"effects-compand" )
#( lambda: <{ -- val }> 100.0 #f 0 #f #f #f effects-am ;
- $" lambda: <{ snd chn -- val }> 100.0 #f 0 #f snd chn effects-am drop ;"
+ "lambda: <{ snd chn -- val }> 100.0 #f 0 #f snd chn effects-am drop ;"
"effects-am" )
#( lambda: <{ -- val }> 100.0 #f 0 #f #f #f effects-rm ;
- $" lambda: <{ snd chn -- val }> 100.0 #f 0 #f snd chn effects-rm drop ;"
+ "lambda: <{ snd chn -- val }> 100.0 #f 0 #f snd chn effects-rm drop ;"
"effects-rm" )
#( lambda: <{ -- val }> 1000.0 100.0 0 #f #f #f effects-bbp ;
- $" lambda: <{ snd chn -- val }> 1000.0 100.0 0 #f snd chn effects-bbp drop ;"
+ "lambda: <{ snd chn -- val }> 1000.0 100.0 0 #f snd chn effects-bbp drop ;"
"effects-bbp" )
#( lambda: <{ -- val }> 1000.0 100.0 0 #f #f #f effects-bbr ;
- $" lambda: <{ snd chn -- val }> 1000.0 100.0 0 #f snd chn effects-bbr drop ;"
+ "lambda: <{ snd chn -- val }> 1000.0 100.0 0 #f snd chn effects-bbr drop ;"
"effects-bbr" )
#( lambda: <{ -- val }> 1000.0 0 #f #f #f effects-bhp ;
- $" lambda: <{ snd chn -- val }> 1000.0 0 #f snd chn effects-bhp drop ;"
+ "lambda: <{ snd chn -- val }> 1000.0 0 #f snd chn effects-bhp drop ;"
"effects-bhp" )
#( lambda: <{ -- val }> 1000.0 0 #f #f #f effects-blp ;
- $" lambda: <{ snd chn -- val }> 1000.0 0 #f snd chn effects-blp drop ;"
+ "lambda: <{ snd chn -- val }> 1000.0 0 #f snd chn effects-blp drop ;"
"effects-blp" )
#( lambda: <{ -- val }> 50.0 0.5 0 #f #f #f effects-hello-dentist ;
- $" lambda: <{ snd chn -- val }> 50.0 0.5 0 #f snd chn effects-hello-dentist drop ;"
+ "lambda: <{ snd chn -- val }> 50.0 0.5 0 #f snd chn effects-hello-dentist drop ;"
"effects-hello-dentist" )
#( lambda: <{ -- val }> 1.0 0.3 20.0 0 #f #f #f effects-fp ;
- $" lambda: <{ snd chn -- val }> 1.0 0.3 20.0 0 #f snd chn effects-fp drop ;"
+ "lambda: <{ snd chn -- val }> 1.0 0.3 20.0 0 #f snd chn effects-fp drop ;"
"effects-fp" )
#( lambda: <{ -- val }> 5.0 2.0 0.001 0 #f #f #f effects-flange ;
- $" lambda: <{ snd chn -- val }> 5.0 2.0 0.001 0 #f snd chn effects-flange drop ;"
+ "lambda: <{ snd chn -- val }> 5.0 2.0 0.001 0 #f snd chn effects-flange drop ;"
"effects-flange" )
#( lambda: <{ -- val }> 0.1 0 #f #f #f effects-jc-reverb-1 ;
- $" lambda: <{ snd chn -- val }> 0.1 0 #f snd chn effects-jc-reverb-1 drop ;"
+ "lambda: <{ snd chn -- val }> 0.1 0 #f snd chn effects-jc-reverb-1 drop ;"
"effects-jc-reverb-1" ) ) value test19-*.fs
: 19-save/restore ( -- )
"oboe.snd" open-sound { ind }
- nil nil nil nil nil { vals func1 descr name func }
+ nil nil nil nil nil nil { vals func1 descr name func str }
test19-*.fs each to vals
vals 0 array-ref to func1
vals 1 array-ref to descr
vals 2 array-ref to name
- *snd-test-verbose* if name #f snd-test-message then
+ *snd-test-verbose* if
+ name #f snd-test-message
+ then
func1 #() run-proc drop
ind #f undef undef edit-list->function to func
- func proc-source-ref descr string<> if
- $" edit-list->function %d: %s?" #( i func proc-source-ref ) snd-display
- then
+ func proc-source-ref to str
+ str descr "edit-list->function %s [%d]" #( name i ) snd-test-neq
ind revert-sound drop
func #( ind 0 ) run-proc drop
ind revert-sound drop
@@ -5060,7 +5074,9 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
\ ---------------- test 23: with-sound ----------------
-: test23-notehook { ins start dur -- } $" %14s: %5.2f %5.2f" #( ins start dur ) snd-test-message ;
+: test23-notehook { ins start dur -- }
+ "%14s: %5.2f %5.2f" #( ins start dur ) snd-test-message
+;
: test23-balance ( -- )
make-rmsgain { rg }
@@ -5078,10 +5094,10 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
i rg2 o 0.0 0.0 oscil 0.1 f* e2 env rmsgain-balance *output* outc drop
loop
rg rmsgain-gain-avg 0.98402 fneq if
- $" rmsgain gain-avg: %f (0.98402)?" #( rg rmsgain-gain-avg ) snd-display
+ "rmsgain gain-avg: %f (0.98402)?" #( rg rmsgain-gain-avg ) snd-display
then
- rg2 :rmsg-avgc array-assoc-ref 10000 <> if
- $" rmsgain count: %d (10000)?" #( rg2 :rmsg-avgc array-assoc-ref ) snd-display
+ rg2 rmsgain-avgc 10000 <> if
+ "rmsgain count: %d (10000)?" #( rg2 rmsgain-avgc ) snd-display
then
;
@@ -5140,7 +5156,7 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: sndclm-nrxycos-test ( -- )
440.0 :n 10 make-nrxycos { gen }
- 44100 0 ?do
+ 44100 0 do
i gen 0 nrxycos f2/ *output* outa drop
loop
;
@@ -5148,7 +5164,7 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: sndclm-ssb-am-test ( -- )
440.0 20 make-ssb-am { shifter }
440.0 make-oscil { osc }
- 44100 0 ?do
+ 44100 0 do
i shifter osc 0 0 oscil 0 ssb-am f2/ *output* outa drop
loop
;
@@ -5156,7 +5172,9 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: sndclm-wave-train-test ( -- )
400 10 make-ncos { g }
g -0.5 pi f* set-mus-phase drop
- 64 make-vct map! g 0 ncos end-map { v }
+ 64 make-vct map!
+ g 0 ncos
+ end-map { v }
440.0 :wave v make-wave-train { gen }
44100 0 do
i gen 0 wave-train f2/ *output* outa drop
@@ -5241,11 +5259,11 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
440.0 make-oscil { osc }
44100 4410 - { stop }
0.0 { val }
- stop 0 do
+ stop 0 ?do
osc 0 0 oscil to val
i avg val fabs moving-average val f* *output* outa drop
loop
- 44100 stop do
+ 44100 stop ?do
i avg 0.0 moving-average osc 0 0 oscil f* *output* outa drop
loop
;
@@ -5253,7 +5271,7 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: sndclm-src1-test ( -- )
"oboe.snd" make-readin { rd }
rd 0.5 make-src { sr }
- "oboe.snd" mus-sound-frames 2* ( len ) 0 do
+ "oboe.snd" mus-sound-framples 2* ( len ) 0 ?do
i sr 0 #f src *output* outa drop
loop
;
@@ -5284,7 +5302,7 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: sndclm-convolve2-test ( -- )
"oboe.snd" "pistol.snd" 0.5 "convolved.snd" convolve-files { tempfile }
tempfile make-readin { reader }
- tempfile mus-sound-frames ( len ) 0 do
+ tempfile mus-sound-framples ( len ) 0 ?do
i reader readin *output* outa drop
loop
tempfile file-delete
@@ -5306,7 +5324,8 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: sndclm-granulate2-test ( -- )
440.0 make-oscil { osc }
'( 0 0 1 1 ) :scaler 440.0 hz->radians :length 44100 make-env { sweep }
- osc sweep make-granulate-proc :expansion 2.0 :length 0.5 make-granulate { grn }
+ osc sweep make-granulate-proc :expansion 2.0 :length 0.5
+ make-granulate { grn }
88200 0 do
i grn #f #f granulate *output* outa drop
loop
@@ -5321,7 +5340,7 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: sndclm-phase-vocoder2-test ( -- )
"oboe.snd" make-readin :interp 256 make-phase-vocoder { pv }
- "oboe.snd" mus-sound-frames 2* ( samps ) 0 do
+ "oboe.snd" mus-sound-framples 2* ( samps ) 0 ?do
i pv #f #f #f #f phase-vocoder *output* outa drop
loop
;
@@ -5333,14 +5352,17 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
loop
;
-: sndclm-file->frame->file-test ( -- )
- "stereo.snd" make-file->frame { input }
- 2 make-frame { frm }
- "stereo.snd" mus-sound-frames ( len ) 0 do
- input i frm file->frame ( frm ) 1 frame-ref ( val1 )
- frm 0 frame-ref ( val0 ) frm 1 rot frame-set! drop
- ( val1 ) frm 0 rot frame-set! drop
- *output* i frm frame->file drop
+: sndclm-file->frample->file-test ( -- )
+ "stereo.snd" make-file->frample { input }
+ 2 0.0 make-vct { frm }
+ 0.0 0.0 { val0 val1 }
+ "stereo.snd" mus-sound-framples ( len ) 0 ?do
+ input i frm file->frample to frm
+ frm 0 vct-ref to val0
+ frm 1 vct-ref to val1
+ frm 0 val1 vct-set! drop
+ frm 1 val0 vct-set! drop
+ *output* i frm frample->file drop
loop
;
@@ -5377,25 +5399,40 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
loop
;
-: check-maxamp { fname name -- }
- fname mus-sound-maxamp each { val }
- i 2 mod 0<> if
- val 1.1 f> if $" %s: maxamp chn %s > 1.0: %s" '( name i 1- 2/ val ) snd-display then
+: check-maxamp { fname name lno -- }
+ fname mus-sound-maxamp { amps }
+ amps each { val }
+ i 2 mod if
+ val 1.1 f> if
+ "%s (%s)[%d]: maxamp chn %d > 1.0: %.3f (at %d)"
+ '( name fname lno i 1- 2/ val amps i object-ref ) snd-display
+ then
then
end-each
;
-: ws-close-sound { ws -- }
- ws ws-output 0 find-sound dup sound? if close-sound then drop
- ws :statistics ws-ref unless ws ws-output ws :comment ws-ref check-maxamp then
+: (ws-close-sound) { ws lno -- }
+ ws ws-output 0 find-sound dup sound? if
+ close-sound
+ then drop
+ ws :statistics ws-ref unless
+ ws ws-output ws :comment ws-ref lno check-maxamp
+ then
;
+: ws-close-sound ( ws -- )
+ postpone *lineno*
+ postpone (ws-close-sound)
+; immediate
+
: 23-with-sound ( -- )
1024 1024 * to *clm-file-buffer-size*
*clm-play* { old-play }
*clm-statistics* { old-stats }
*snd-test-ws-play* to *clm-play*
+ *snd-test-ws-player* to *clm-player*
*snd-test-ws-statistics* to *clm-statistics*
+ mus-bfloat to *clm-sample-type*
\ from bird.fsm
<'> bird-test
:comment over object->string
@@ -5404,1334 +5441,116 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
\ from clm-ins.fs
0.0 0.3 <'> clm-ins-test
:comment over object->string
- :notehook *snd-test-ws-verbose* if <'> test23-notehook else #f then
+ :notehook *snd-test-ws-verbose* if
+ <'> test23-notehook
+ else
+ #f
+ then
:channels 2 with-sound ws-close-sound
<'> test23-balance
:comment over object->string
:channels 3 with-sound ws-output 0 find-sound { ind }
- ind sound? if ind close-sound drop else $" with-sound balance?" snd-display then
- "test.snd" "test23-balance" check-maxamp
- "tmp.snd" mus-next mus-bfloat 22050 1 new-sound to ind
+ ind sound? if
+ ind close-sound drop
+ else
+ "with-sound balance?" snd-display
+ then
+ "test.snd" "test23-balance" *lineno* check-maxamp
+ "tmp.snd" 1 22050 mus-bfloat mus-next new-sound to ind
0 1000 ind 0 pad-channel drop
100.0 make-oscil { mg }
1000 make-ssb-fm { gen }
- gen mg test23-ssb-fm <'> map-channel #t nil fth-catch stack-reset
+ gen mg test23-ssb-fm <'> map-channel snd-test-catch drop
ind close-sound drop
\ examples from sndclm.html
- <'> sndclm-oscil-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-env-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-table-lookup-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-polywave-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-triangle-wave-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-ncos-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-nrxycos-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-ssb-am-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-wave-train-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-rand-test :comment over object->string :channels 2 with-sound ws-close-sound
- <'> sndclm-two-pole-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-firmant-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-iir-filter-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-delay-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-comb-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-all-pass-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-moving-average-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-src1-test :comment over object->string :srate 22050 with-sound ws-close-sound
- <'> sndclm-src2-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-convolve1-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-convolve2-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-granulate1-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-granulate2-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-phase-vocoder1-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-phase-vocoder2-test :comment over object->string :srate 22050 with-sound ws-close-sound
- <'> sndclm-asymmetric-fm-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-file->frame->file-test :comment over object->string :channels 2 with-sound ws-close-sound
- <'> sndclm-readin-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-in-out-any-test :comment over object->string with-sound ws-close-sound
- <'> sndclm-locsig-test :comment over object->string :channels 2 with-sound ws-close-sound
- <'> sndclm-amplitude-modulate-test :comment over object->string with-sound ws-close-sound
+ <'> sndclm-oscil-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-env-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-table-lookup-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-polywave-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-triangle-wave-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-ncos-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-nrxycos-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-ssb-am-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-wave-train-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-rand-test
+ :comment over object->string :channels 2 with-sound ws-close-sound
+ <'> sndclm-two-pole-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-firmant-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-iir-filter-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-delay-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-comb-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-all-pass-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-moving-average-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-src1-test
+ :comment over object->string :srate 22050 with-sound ws-close-sound
+ <'> sndclm-src2-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-convolve1-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-convolve2-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-granulate1-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-granulate2-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-phase-vocoder1-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-phase-vocoder2-test
+ :comment over object->string :srate 22050 with-sound ws-close-sound
+ <'> sndclm-asymmetric-fm-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-file->frample->file-test
+ :comment over object->string :channels 2 with-sound ws-close-sound
+ <'> sndclm-readin-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-in-out-any-test
+ :comment over object->string with-sound ws-close-sound
+ <'> sndclm-locsig-test
+ :comment over object->string :channels 2 with-sound ws-close-sound
+ <'> sndclm-amplitude-modulate-test
+ :comment over object->string with-sound ws-close-sound
old-play to *clm-play*
old-stats to *clm-statistics*
;
-\ ---------------- test 26: Gtk ----------------
-
-*with-test-gtk* [if]
- \ FIXME
- \ Splitted in four arrays because we have a 1024 stack limit. [ms]
- #( 'Fg_free 'Fg_signal_lookup 'Fg_source_remove 'Fg_type_from_name
- 'Fg_type_is_a 'Fg_type_name 'Fg_type_parent 'Fg_type_qname 'Fgdk_atom_intern
- 'Fgdk_init 'Fgdk_init_check 'Fgdk_set_show_events 'Fgdk_threads_enter
- 'Fgdk_threads_init 'Fgdk_threads_leave 'Fgdk_utf8_to_string_target
- 'Fgtk_accel_map_load 'Fgtk_accel_map_load_fd 'Fgtk_accel_map_lookup_entry
- 'Fgtk_accel_map_save 'Fgtk_accel_map_save_fd 'Fgtk_button_new_with_label
- 'Fgtk_check_button_new_with_label 'Fgtk_check_menu_item_new_with_label
- 'Fgtk_color_selection_palette_from_string 'Fgtk_disable_setlocale
- 'Fgtk_icon_size_from_name 'Fgtk_image_menu_item_new_with_label 'Fgtk_init
- 'Fgtk_init_check 'Fgtk_key_snooper_install 'Fgtk_key_snooper_remove
- 'Fgtk_main 'Fgtk_main_do_event 'Fgtk_main_iteration 'Fgtk_main_iteration_do
- 'Fgtk_main_level 'Fgtk_main_quit 'Fgtk_menu_item_new_with_label
- 'Fgtk_radio_button_new_with_label 'Fgtk_radio_menu_item_new_with_label
- 'Fgtk_rc_find_module_in_path 'Fgtk_toggle_button_new_with_label
- 'Fpango_coverage_from_bytes 'Fpango_find_paragraph_boundary
- 'Fpango_language_from_string 'Fpango_script_iter_new ) constant breakable-gtk-procs
-
- #( 'FGDK_DEVICE 'FGDK_DISPLAY_OBJECT 'FGDK_DRAG_CONTEXT
- 'FGDK_DRAWABLE 'FGDK_EVENT_ANY 'FGDK_EVENT_BUTTON
- 'FGDK_EVENT_CONFIGURE 'FGDK_EVENT_CROSSING 'FGDK_EVENT_DND
- 'FGDK_EVENT_EXPOSE 'FGDK_EVENT_FOCUS 'FGDK_EVENT_KEY
- 'FGDK_EVENT_MOTION 'FGDK_EVENT_NOEXPOSE 'FGDK_EVENT_PROPERTY
- 'FGDK_EVENT_PROXIMITY 'FGDK_EVENT_SCROLL 'FGDK_EVENT_SELECTION
- 'FGDK_EVENT_SETTING 'FGDK_EVENT_VISIBILITY 'FGDK_EVENT_WINDOWSTATE
- 'FGDK_IS_DEVICE 'FGDK_IS_DISPLAY 'FGDK_IS_DRAG_CONTEXT
- 'FGDK_IS_DRAWABLE 'FGDK_IS_KEYMAP 'FGDK_IS_SCREEN
- 'FGDK_IS_VISUAL 'FGDK_IS_WINDOW 'FGDK_KEYMAP 'FGDK_SCREEN
- 'FGDK_VISUAL 'FGDK_WINDOW 'FGPOINTER 'FGTK_ABOUT_DIALOG
- 'FGTK_ACCEL_GROUP 'FGTK_ACCEL_LABEL 'FGTK_ACCEL_MAP
- 'FGTK_ACCESSIBLE 'FGTK_ACTION 'FGTK_ACTION_GROUP 'FGTK_ADJUSTMENT
- 'FGTK_ALIGNMENT 'FGTK_ARROW 'FGTK_ASPECT_FRAME 'FGTK_BIN
- 'FGTK_BOX 'FGTK_BUTTON 'FGTK_BUTTON_BOX 'FGTK_CALENDAR
- 'FGTK_CELL_EDITABLE 'FGTK_CELL_LAYOUT 'FGTK_CELL_RENDERER
- 'FGTK_CELL_RENDERER_COMBO 'FGTK_CELL_RENDERER_PIXBUF
- 'FGTK_CELL_RENDERER_PROGRESS 'FGTK_CELL_RENDERER_TEXT
- 'FGTK_CELL_RENDERER_TOGGLE 'FGTK_CELL_VIEW 'FGTK_CHECK_BUTTON
- 'FGTK_CHECK_MENU_ITEM 'FGTK_CLIPBOARD 'FGTK_COLOR_BUTTON
- 'FGTK_COLOR_SELECTION 'FGTK_COLOR_SELECTION_DIALOG 'FGTK_COMBO_BOX
- 'FGTK_CONTAINER 'FGTK_DIALOG
- 'FGTK_DRAWING_AREA 'FGTK_EDITABLE 'FGTK_ENTRY
- 'FGTK_ENTRY_COMPLETION 'FGTK_EVENT_BOX 'FGTK_EXPANDER
- 'FGTK_FILE_CHOOSER 'FGTK_FILE_CHOOSER_BUTTON
- 'FGTK_FILE_CHOOSER_DIALOG 'FGTK_FILE_CHOOSER_WIDGET
- 'FGTK_FILE_FILTER 'FGTK_FIXED 'FGTK_FONT_BUTTON
- 'FGTK_FONT_SELECTION 'FGTK_FONT_SELECTION_DIALOG
- 'FGTK_FRAME 'FGTK_HANDLE_BOX 'FGTK_HBOX 'FGTK_HBUTTON_BOX
- 'FGTK_HSCALE 'FGTK_HSCROLLBAR
- 'FGTK_HSEPARATOR 'FGTK_ICON_FACTORY 'FGTK_ICON_THEME
- 'FGTK_ICON_VIEW 'FGTK_IMAGE 'FGTK_IMAGE_MENU_ITEM
- 'FGTK_IM_CONTEXT 'FGTK_IM_CONTEXT_SIMPLE 'FGTK_IM_MULTICONTEXT
- 'FGTK_INVISIBLE 'FGTK_IS_ABOUT_DIALOG 'FGTK_IS_ACCEL_GROUP
- 'FGTK_IS_ACCEL_LABEL 'FGTK_IS_ACCEL_MAP 'FGTK_IS_ACCESSIBLE
- 'FGTK_IS_ACTION 'FGTK_IS_ACTION_GROUP 'FGTK_IS_ADJUSTMENT
- 'FGTK_IS_ALIGNMENT 'FGTK_IS_ARROW 'FGTK_IS_ASPECT_FRAME
- 'FGTK_IS_BIN 'FGTK_IS_BOX 'FGTK_IS_BUTTON 'FGTK_IS_BUTTON_BOX
- 'FGTK_IS_CALENDAR 'FGTK_IS_CELL_EDITABLE 'FGTK_IS_CELL_LAYOUT
- 'FGTK_IS_CELL_RENDERER 'FGTK_IS_CELL_RENDERER_COMBO
- 'FGTK_IS_CELL_RENDERER_PIXBUF 'FGTK_IS_CELL_RENDERER_PROGRESS
- 'FGTK_IS_CELL_RENDERER_TEXT 'FGTK_IS_CELL_RENDERER_TOGGLE
- 'FGTK_IS_CELL_VIEW 'FGTK_IS_CHECK_BUTTON
- 'FGTK_IS_CHECK_MENU_ITEM 'FGTK_IS_CLIPBOARD
- 'FGTK_IS_COLOR_BUTTON 'FGTK_IS_COLOR_SELECTION
- 'FGTK_IS_COLOR_SELECTION_DIALOG 'FGTK_IS_COMBO_BOX
- 'FGTK_IS_CONTAINER
- 'FGTK_IS_DIALOG 'FGTK_IS_DRAWING_AREA 'FGTK_IS_EDITABLE
- 'FGTK_IS_ENTRY 'FGTK_IS_ENTRY_COMPLETION 'FGTK_IS_EVENT_BOX
- 'FGTK_IS_EXPANDER 'FGTK_IS_FILE_CHOOSER 'FGTK_IS_FILE_CHOOSER_BUTTON
- 'FGTK_IS_FILE_CHOOSER_DIALOG 'FGTK_IS_FILE_CHOOSER_WIDGET
- 'FGTK_IS_FILE_FILTER 'FGTK_IS_FIXED 'FGTK_IS_FONT_BUTTON
- 'FGTK_IS_FONT_SELECTION 'FGTK_IS_FONT_SELECTION_DIALOG
- 'FGTK_IS_FRAME 'FGTK_IS_HANDLE_BOX 'FGTK_IS_HBOX
- 'FGTK_IS_HBUTTON_BOX 'FGTK_IS_HPANED
- 'FGTK_IS_HSCALE 'FGTK_IS_HSCROLLBAR 'FGTK_IS_HSEPARATOR
- 'FGTK_IS_ICON_FACTORY 'FGTK_IS_ICON_THEME 'FGTK_IS_ICON_VIEW
- 'FGTK_IS_IMAGE 'FGTK_IS_IMAGE_MENU_ITEM 'FGTK_IS_IM_CONTEXT
- 'FGTK_IS_IM_CONTEXT_SIMPLE 'FGTK_IS_IM_MULTICONTEXT
- 'FGTK_IS_INVISIBLE 'FGTK_IS_LABEL 'FGTK_IS_LAYOUT
- 'FGTK_IS_LIST_STORE 'FGTK_IS_MENU 'FGTK_IS_MENU_BAR
- 'FGTK_IS_MENU_ITEM 'FGTK_IS_MENU_SHELL 'FGTK_IS_MENU_TOOL_BUTTON
- 'FGTK_IS_MISC 'FGTK_IS_NOTEBOOK 'FGTK_IS_OBJECT 'FGTK_IS_PANED
- 'FGTK_IS_PLUG 'FGTK_IS_PROGRESS_BAR 'FGTK_IS_RADIO_ACTION
- 'FGTK_IS_RADIO_BUTTON 'FGTK_IS_RADIO_MENU_ITEM
- 'FGTK_IS_RADIO_TOOL_BUTTON 'FGTK_IS_RANGE 'FGTK_IS_RC_STYLE
- 'FGTK_IS_SCALE 'FGTK_IS_SCROLLBAR
- 'FGTK_IS_SCROLLED_WINDOW 'FGTK_IS_SEPARATOR
- 'FGTK_IS_SEPARATOR_MENU_ITEM 'FGTK_IS_SEPARATOR_TOOL_ITEM
- 'FGTK_IS_SIZE_GROUP 'FGTK_IS_SOCKET 'FGTK_IS_SPIN_BUTTON
- 'FGTK_IS_STATUSBAR 'FGTK_IS_STYLE 'FGTK_IS_TABLE
- 'FGTK_IS_TEAROFF_MENU_ITEM 'FGTK_IS_TEXT_BUFFER
- 'FGTK_IS_TEXT_CHILD_ANCHOR 'FGTK_IS_TEXT_MARK 'FGTK_IS_TEXT_TAG
- 'FGTK_IS_TEXT_TAG_TABLE 'FGTK_IS_TEXT_VIEW
- 'FGTK_IS_TOGGLE_ACTION 'FGTK_IS_TOGGLE_BUTTON
- 'FGTK_IS_TOGGLE_TOOL_BUTTON 'FGTK_IS_TOOLBAR 'FGTK_IS_TOOL_BUTTON
- 'FGTK_IS_TOOL_ITEM 'FGTK_IS_TREE_DRAG_DEST
- 'FGTK_IS_TREE_DRAG_SOURCE 'FGTK_IS_TREE_MODEL
- 'FGTK_IS_TREE_MODEL_FILTER 'FGTK_IS_TREE_MODEL_SORT
- 'FGTK_IS_TREE_SELECTION 'FGTK_IS_TREE_SORTABLE
- 'FGTK_IS_TREE_STORE 'FGTK_IS_TREE_VIEW
- 'FGTK_IS_TREE_VIEW_COLUMN 'FGTK_IS_UI_MANAGER 'FGTK_IS_VBOX
- 'FGTK_IS_VBUTTON_BOX 'FGTK_IS_VIEWPORT 'FGTK_IS_VPANED
- 'FGTK_IS_VSCALE 'FGTK_IS_VSCROLLBAR
- 'FGTK_IS_VSEPARATOR 'FGTK_IS_WIDGET 'FGTK_IS_WINDOW 'FGTK_LABEL
- 'FGTK_LAYOUT 'FGTK_LIST_STORE 'FGTK_MENU 'FGTK_MENU_BAR
- 'FGTK_MENU_ITEM 'FGTK_MENU_SHELL 'FGTK_MENU_TOOL_BUTTON
- 'FGTK_MISC 'FGTK_NOTEBOOK 'FGTK_PANED 'FGTK_PLUG
- 'FGTK_PROGRESS_BAR 'FGTK_RADIO_ACTION 'FGTK_RADIO_BUTTON
- 'FGTK_RADIO_MENU_ITEM 'FGTK_RADIO_TOOL_BUTTON
- 'FGTK_RANGE 'FGTK_SCALE 'FGTK_SCROLLBAR
- 'FGTK_SCROLLED_WINDOW 'FGTK_SEPARATOR 'FGTK_SEPARATOR_MENU_ITEM
- 'FGTK_SEPARATOR_TOOL_ITEM 'FGTK_SIZE_GROUP 'FGTK_SOCKET
- 'FGTK_SPIN_BUTTON 'FGTK_STATUSBAR 'FGTK_STYLE 'FGTK_TABLE
- 'FGTK_TEAROFF_MENU_ITEM 'FGTK_TEXT_BUFFER 'FGTK_TEXT_CHILD_ANCHOR
- 'FGTK_TEXT_MARK 'FGTK_TEXT_TAG 'FGTK_TEXT_TAG_TABLE
- 'FGTK_TEXT_VIEW 'FGTK_TOGGLE_ACTION 'FGTK_TOGGLE_BUTTON
- 'FGTK_TOGGLE_TOOL_BUTTON 'FGTK_TOOLBAR 'FGTK_TOOL_BUTTON
- 'FGTK_TOOL_ITEM 'FGTK_TREE_DRAG_DEST 'FGTK_TREE_DRAG_SOURCE
- 'FGTK_TREE_MODEL 'FGTK_TREE_MODEL_FILTER
- 'FGTK_TREE_MODEL_SORT 'FGTK_TREE_SELECTION
- 'FGTK_TREE_SORTABLE 'FGTK_TREE_STORE 'FGTK_TREE_VIEW
- 'FGTK_TREE_VIEW_COLUMN 'FGTK_UI_MANAGER 'FGTK_VBOX
- 'FGTK_VBUTTON_BOX 'FGTK_VIEWPORT 'FGTK_VPANED
- 'FGTK_VSCALE 'FGTK_VSCROLLBAR 'FGTK_VSEPARATOR 'FGTK_WIDGET
- 'FG_IS_OBJECT 'FG_OBJECT 'FPANGO_CONTEXT 'FPANGO_FONT
- 'FPANGO_FONT_FACE 'FPANGO_FONT_FAMILY 'FPANGO_FONT_MAP
- 'FPANGO_IS_CONTEXT 'FPANGO_IS_FONT 'FPANGO_IS_FONT_FACE
- 'FPANGO_IS_FONT_FAMILY 'FPANGO_IS_FONT_MAP 'FPANGO_IS_LAYOUT
- 'FPANGO_LAYOUT 'Fg_cclosure_new 'Fg_idle_add
- 'Fg_idle_add_full 'Fg_idle_remove_by_data 'Fg_list_copy
- 'Fg_list_first 'Fg_list_free 'Fg_list_last 'Fg_list_length
- 'Fg_list_nth_data 'Fg_list_remove_link 'Fg_list_reverse
- 'Fg_object_get_data 'Fg_object_ref 'Fg_object_set_data
- 'Fg_object_unref 'Fg_quark_from_string 'Fg_quark_to_string
- 'Fg_signal_add_emission_hook 'Fg_signal_connect_closure
- 'Fg_signal_connect_closure_by_id 'Fg_signal_connect_data
- 'Fg_signal_get_invocation_hint 'Fg_signal_handler_block
- 'Fg_signal_handler_disconnect 'Fg_signal_handler_find
- 'Fg_signal_handler_is_connected 'Fg_signal_handler_unblock
- 'Fg_signal_handlers_block_matched 'Fg_signal_handlers_destroy
- 'Fg_signal_handlers_disconnect_matched
- 'Fg_signal_handlers_unblock_matched 'Fg_signal_has_handler_pending
- 'Fg_signal_list_ids 'Fg_signal_name 'Fg_signal_newv
- 'Fg_signal_parse_name 'Fg_signal_query
- 'Fg_signal_remove_emission_hook 'Fg_signal_stop_emission
- 'Fg_signal_stop_emission_by_name 'Fg_timeout_add
- 'Fg_timeout_add_full 'Fgdk_add_client_message_filter
- 'Fgdk_atom_name 'Fgdk_beep 'Fgdk_color_copy 'Fgdk_color_equal
- 'Fgdk_color_free 'Fgdk_color_hash 'Fgdk_color_parse
- 'Fgdk_display_add_client_message_filter 'Fgdk_display_beep
- 'Fgdk_display_close 'Fgdk_display_flush 'Fgdk_display_get_default
- 'Fgdk_display_get_default_cursor_size 'Fgdk_display_get_default_group
- 'Fgdk_display_get_default_screen 'Fgdk_display_get_event
- 'Fgdk_display_get_maximal_cursor_size 'Fgdk_display_get_n_screens
- 'Fgdk_display_get_name 'Fgdk_display_get_pointer
- 'Fgdk_display_get_screen 'Fgdk_display_get_window_at_pointer
- 'Fgdk_display_keyboard_ungrab 'Fgdk_display_open
- 'Fgdk_display_peek_event 'Fgdk_display_pointer_is_grabbed
- 'Fgdk_display_pointer_ungrab 'Fgdk_display_put_event
- 'Fgdk_display_set_double_click_distance 'Fgdk_display_set_double_click_time
- 'Fgdk_display_supports_clipboard_persistence 'Fgdk_display_supports_cursor_alpha
- 'Fgdk_display_supports_cursor_color 'Fgdk_display_sync
- 'Fgdk_drag_abort 'Fgdk_drag_begin 'Fgdk_drag_context_new
- 'Fgdk_drag_drop 'Fgdk_drag_drop_succeeded 'Fgdk_drag_find_window
- 'Fgdk_drag_get_protocol 'Fgdk_drag_get_selection 'Fgdk_drag_motion
- 'Fgdk_drag_status 'Fgdk_drop_finish 'Fgdk_drop_reply
- 'Fgdk_error_trap_pop 'Fgdk_error_trap_push 'Fgdk_event_copy
- 'Fgdk_event_free 'Fgdk_event_get 'Fgdk_event_get_coords
- 'Fgdk_event_get_root_coords 'Fgdk_event_get_state
- 'Fgdk_event_get_time 'Fgdk_event_handler_set 'Fgdk_event_peek
- 'Fgdk_event_put 'Fgdk_event_send_client_message
- 'Fgdk_event_send_clientmessage_toall 'Fgdk_events_pending
- 'Fgdk_flush 'Fgdk_get_default_root_window 'Fgdk_get_display
- 'Fgdk_get_display_arg_name 'Fgdk_get_program_class
- 'Fgdk_get_show_events 'Fgdk_keyboard_grab 'Fgdk_keyboard_ungrab
- 'Fgdk_keymap_get_default 'Fgdk_keymap_get_direction
- 'Fgdk_keymap_get_entries_for_keycode 'Fgdk_keymap_get_entries_for_keyval
- 'Fgdk_keymap_lookup_key 'Fgdk_keyval_convert_case
- 'Fgdk_keyval_from_name 'Fgdk_keyval_is_lower 'Fgdk_keyval_is_upper
- 'Fgdk_keyval_name 'Fgdk_keyval_to_lower 'Fgdk_keyval_to_unicode
- 'Fgdk_keyval_to_upper 'Fgdk_list_visuals
- 'Fgdk_notify_startup_complete 'Fgdk_pango_context_get
- 'Fgdk_pixbuf_add_alpha 'Fgdk_pixbuf_animation_get_height
- 'Fgdk_pixbuf_animation_get_iter 'Fgdk_pixbuf_animation_get_static_image
- 'Fgdk_pixbuf_animation_get_width 'Fgdk_pixbuf_animation_is_static_image
- 'Fgdk_pixbuf_animation_iter_advance 'Fgdk_pixbuf_animation_iter_get_delay_time
- 'Fgdk_pixbuf_animation_iter_get_pixbuf
- 'Fgdk_pixbuf_animation_iter_on_currently_loading_frame
- 'Fgdk_pixbuf_animation_new_from_file 'Fgdk_pixbuf_composite
- 'Fgdk_pixbuf_composite_color 'Fgdk_pixbuf_composite_color_simple
- 'Fgdk_pixbuf_copy 'Fgdk_pixbuf_copy_area 'Fgdk_pixbuf_error_quark
- 'Fgdk_pixbuf_fill 'Fgdk_pixbuf_get_bits_per_sample
- 'Fgdk_pixbuf_get_colorspace 'Fgdk_pixbuf_get_has_alpha
- 'Fgdk_pixbuf_get_height 'Fgdk_pixbuf_get_n_channels
- 'Fgdk_pixbuf_get_option 'Fgdk_pixbuf_get_pixels
- 'Fgdk_pixbuf_get_rowstride 'Fgdk_pixbuf_get_width
- 'Fgdk_pixbuf_new_from_data 'Fgdk_pixbuf_new_from_file
- 'Fgdk_pixbuf_new_from_inline 'Fgdk_pixbuf_new_from_xpm_data
- 'Fgdk_pixbuf_new_subpixbuf 'Fgdk_pixbuf_saturate_and_pixelate
- 'Fgdk_pixbuf_savev 'Fgdk_pixbuf_scale 'Fgdk_pixbuf_scale_simple
- 'Fgdk_pointer_grab 'Fgdk_pointer_is_grabbed 'Fgdk_pointer_ungrab
- 'Fgdk_property_change 'Fgdk_property_delete 'Fgdk_property_get
- 'Fgdk_query_depths 'Fgdk_query_visual_types
- 'Fgdk_rectangle_intersect 'Fgdk_rectangle_union
- 'Fgdk_screen_broadcast_client_message 'Fgdk_screen_get_default
- 'Fgdk_screen_get_display 'Fgdk_screen_get_height
- 'Fgdk_screen_get_height_mm 'Fgdk_screen_get_monitor_at_point
- 'Fgdk_screen_get_monitor_at_window 'Fgdk_screen_get_monitor_geometry
- 'Fgdk_screen_get_n_monitors 'Fgdk_screen_get_number
- 'Fgdk_screen_get_root_window 'Fgdk_screen_get_system_visual
- 'Fgdk_screen_get_toplevel_windows 'Fgdk_screen_get_width
- 'Fgdk_screen_get_width_mm 'Fgdk_screen_height
- 'Fgdk_screen_height_mm 'Fgdk_screen_list_visuals
- 'Fgdk_screen_make_display_name 'Fgdk_screen_width
- 'Fgdk_screen_width_mm 'Fgdk_selection_convert
- 'Fgdk_selection_owner_get 'Fgdk_selection_owner_set
- 'Fgdk_selection_property_get 'Fgdk_selection_send_notify
- 'Fgdk_set_double_click_time 'Fgdk_set_locale
- 'Fgdk_set_program_class 'Fgdk_set_sm_client_id
- 'Fgdk_unicode_to_keyval 'Fgdk_visual_get_best
- 'Fgdk_visual_get_best_depth 'Fgdk_visual_get_best_type
- 'Fgdk_visual_get_best_with_both 'Fgdk_visual_get_best_with_depth
- 'Fgdk_visual_get_best_with_type 'Fgdk_visual_get_system
- 'Fgdk_window_add_filter 'Fgdk_window_at_pointer
- 'Fgdk_window_begin_move_drag 'Fgdk_window_begin_paint_rect
- 'Fgdk_window_begin_resize_drag 'Fgdk_window_configure_finished
- 'Fgdk_window_constrain_size 'Fgdk_window_deiconify
- 'Fgdk_window_destroy 'Fgdk_window_enable_synchronized_configure
- 'Fgdk_window_end_paint 'Fgdk_window_focus
- 'Fgdk_window_foreign_new 'Fgdk_window_freeze_updates
- 'Fgdk_window_get_children 'Fgdk_window_get_decorations
- 'Fgdk_window_get_events 'Fgdk_window_get_frame_extents
- 'Fgdk_window_get_geometry 'Fgdk_window_get_group
- 'Fgdk_window_get_origin 'Fgdk_window_get_parent
- 'Fgdk_window_get_pointer 'Fgdk_window_get_position
- 'Fgdk_window_get_root_origin 'Fgdk_window_get_state
- 'Fgdk_window_get_toplevel 'Fgdk_window_get_user_data
- 'Fgdk_window_get_window_type 'Fgdk_window_hide
- 'Fgdk_window_iconify 'Fgdk_window_invalidate_rect
- 'Fgdk_window_is_viewable 'Fgdk_window_is_visible
- 'Fgdk_window_lookup 'Fgdk_window_lower
- 'Fgdk_window_maximize 'Fgdk_window_merge_child_shapes
- 'Fgdk_window_move 'Fgdk_window_move_resize 'Fgdk_window_new
- 'Fgdk_window_peek_children 'Fgdk_window_process_all_updates
- 'Fgdk_window_process_updates 'Fgdk_window_raise
- 'Fgdk_window_register_dnd 'Fgdk_window_remove_filter
- 'Fgdk_window_reparent 'Fgdk_window_resize 'Fgdk_window_scroll
- 'Fgdk_window_set_background 'Fgdk_window_set_child_shapes
- 'Fgdk_window_set_cursor 'Fgdk_window_set_debug_updates
- 'Fgdk_window_set_decorations 'Fgdk_window_set_events
- 'Fgdk_window_set_functions 'Fgdk_window_set_geometry_hints
- 'Fgdk_window_set_group 'Fgdk_window_set_icon_list
- 'Fgdk_window_set_icon_name 'Fgdk_window_set_keep_above
- 'Fgdk_window_set_keep_below 'Fgdk_window_set_modal_hint
- 'Fgdk_window_set_override_redirect 'Fgdk_window_set_role
- 'Fgdk_window_set_static_gravities 'Fgdk_window_set_title
- 'Fgdk_window_set_transient_for 'Fgdk_window_set_type_hint
- 'Fgdk_window_set_user_data 'Fgdk_window_show
- 'Fgdk_window_show_unraised 'Fgdk_window_stick
- 'Fgdk_window_thaw_updates 'Fgdk_window_unmaximize
- 'Fgdk_window_unstick 'Fgdk_window_withdraw
- 'Fgtk_about_dialog_get_artists 'Fgtk_about_dialog_get_authors
- 'Fgtk_about_dialog_get_comments 'Fgtk_about_dialog_get_copyright
- 'Fgtk_about_dialog_get_documenters 'Fgtk_about_dialog_get_license
- 'Fgtk_about_dialog_get_logo 'Fgtk_about_dialog_get_logo_icon_name
- 'Fgtk_about_dialog_get_translator_credits
- 'Fgtk_about_dialog_get_version 'Fgtk_about_dialog_get_website
- 'Fgtk_about_dialog_get_website_label 'Fgtk_about_dialog_new
- 'Fgtk_about_dialog_set_artists 'Fgtk_about_dialog_set_authors
- 'Fgtk_about_dialog_set_comments 'Fgtk_about_dialog_set_copyright
- 'Fgtk_about_dialog_set_documenters 'Fgtk_about_dialog_set_license
- 'Fgtk_about_dialog_set_logo 'Fgtk_about_dialog_set_logo_icon_name
- 'Fgtk_about_dialog_set_translator_credits
- 'Fgtk_about_dialog_set_version 'Fgtk_about_dialog_set_website
- 'Fgtk_about_dialog_set_website_label
- 'Fgtk_accel_group_activate 'Fgtk_accel_group_connect
- 'Fgtk_accel_group_connect_by_path 'Fgtk_accel_group_disconnect
- 'Fgtk_accel_group_disconnect_key 'Fgtk_accel_group_find
- 'Fgtk_accel_group_from_accel_closure 'Fgtk_accel_group_lock
- 'Fgtk_accel_group_new 'Fgtk_accel_group_query
- 'Fgtk_accel_group_unlock 'Fgtk_accel_groups_activate
- 'Fgtk_accel_groups_from_object 'Fgtk_accel_label_get_accel_widget
- 'Fgtk_accel_label_get_accel_width 'Fgtk_accel_label_new
- 'Fgtk_accel_label_refetch 'Fgtk_accel_label_set_accel_closure
- 'Fgtk_accel_label_set_accel_widget 'Fgtk_accel_map_add_entry
- 'Fgtk_accel_map_add_filter 'Fgtk_accel_map_change_entry
- 'Fgtk_accel_map_foreach 'Fgtk_accel_map_foreach_unfiltered
- 'Fgtk_accel_map_get
- 'Fgtk_accelerator_get_label 'Fgtk_accelerator_name
- 'Fgtk_accelerator_parse 'Fgtk_accelerator_set_default_mod_mask
- 'Fgtk_accelerator_valid 'Fgtk_accessible_connect_widget_destroyed
- 'Fgtk_action_activate 'Fgtk_action_connect_accelerator
- 'Fgtk_action_create_icon 'Fgtk_action_create_menu_item
- 'Fgtk_action_create_tool_item 'Fgtk_action_disconnect_accelerator
- 'Fgtk_action_get_name 'Fgtk_action_get_proxies
- 'Fgtk_action_get_sensitive 'Fgtk_action_get_visible
- 'Fgtk_action_group_add_action 'Fgtk_action_group_add_action_with_accel
- 'Fgtk_action_group_add_actions 'Fgtk_action_group_add_toggle_actions
- 'Fgtk_action_group_add_toggle_actions_full
- 'Fgtk_action_group_get_action 'Fgtk_action_group_get_name
- 'Fgtk_action_group_get_sensitive 'Fgtk_action_group_get_visible
- 'Fgtk_action_group_list_actions 'Fgtk_action_group_new
- 'Fgtk_action_group_remove_action 'Fgtk_action_group_set_sensitive
- 'Fgtk_action_group_set_translation_domain
- 'Fgtk_action_group_set_visible 'Fgtk_action_is_sensitive
- 'Fgtk_action_is_visible 'Fgtk_action_new 'Fgtk_action_set_sensitive
- 'Fgtk_action_set_visible 'Fgtk_adjustment_changed
- 'Fgtk_adjustment_clamp_page 'Fgtk_adjustment_get_value
- 'Fgtk_adjustment_new 'Fgtk_adjustment_set_value
- 'Fgtk_adjustment_value_changed 'Fgtk_alignment_get_padding
- 'Fgtk_alignment_new 'Fgtk_alignment_set 'Fgtk_alignment_set_padding
- 'Fgtk_alternative_dialog_button_order 'Fgtk_arrow_new
- 'Fgtk_arrow_set 'Fgtk_aspect_frame_new 'Fgtk_aspect_frame_set
- 'Fgtk_bin_get_child 'Fgtk_binding_entry_remove
- 'Fgtk_binding_set_add_path 'Fgtk_binding_set_by_class
- 'Fgtk_binding_set_find 'Fgtk_binding_set_new
- 'Fgtk_box_get_homogeneous 'Fgtk_box_get_spacing
- 'Fgtk_box_pack_end 'Fgtk_box_pack_start
- 'Fgtk_box_query_child_packing 'Fgtk_box_reorder_child
- 'Fgtk_box_set_child_packing 'Fgtk_box_set_homogeneous
- 'Fgtk_box_set_spacing 'Fgtk_button_box_get_child_secondary
- 'Fgtk_button_box_get_layout 'Fgtk_button_box_set_child_secondary
- 'Fgtk_button_box_set_layout 'Fgtk_button_get_alignment
- 'Fgtk_button_get_focus_on_click 'Fgtk_button_get_image
- 'Fgtk_button_get_label 'Fgtk_button_get_relief
- 'Fgtk_button_get_use_stock 'Fgtk_button_get_use_underline
- 'Fgtk_button_new 'Fgtk_button_new_from_stock
- 'Fgtk_button_new_with_mnemonic 'Fgtk_button_set_alignment
- 'Fgtk_button_set_focus_on_click 'Fgtk_button_set_image
- 'Fgtk_button_set_label 'Fgtk_button_set_relief
- 'Fgtk_button_set_use_stock 'Fgtk_button_set_use_underline
- 'Fgtk_calendar_clear_marks 'Fgtk_calendar_get_date
- 'Fgtk_calendar_get_display_options 'Fgtk_cell_editable_editing_done
- 'Fgtk_cell_editable_remove_widget 'Fgtk_cell_editable_start_editing
- 'Fgtk_cell_layout_add_attribute 'Fgtk_cell_layout_clear
- 'Fgtk_cell_layout_clear_attributes 'Fgtk_cell_layout_pack_end
- 'Fgtk_cell_layout_pack_start 'Fgtk_cell_layout_reorder
- 'Fgtk_cell_layout_set_attributes 'Fgtk_cell_layout_set_cell_data_func
- 'Fgtk_cell_renderer_activate 'Fgtk_cell_renderer_combo_new
- 'Fgtk_cell_renderer_get_fixed_size 'Fgtk_cell_renderer_get_size
- 'Fgtk_cell_renderer_pixbuf_new 'Fgtk_cell_renderer_progress_new
- 'Fgtk_cell_renderer_set_fixed_size 'Fgtk_cell_renderer_start_editing
- 'Fgtk_cell_renderer_text_new 'Fgtk_cell_renderer_text_set_fixed_height_from_font
- 'Fgtk_cell_renderer_toggle_get_active 'Fgtk_cell_renderer_toggle_get_radio
- 'Fgtk_cell_renderer_toggle_new 'Fgtk_cell_renderer_toggle_set_active
- 'Fgtk_cell_renderer_toggle_set_radio 'Fgtk_cell_view_get_displayed_row
- 'Fgtk_cell_view_new 'Fgtk_cell_view_new_with_markup
- 'Fgtk_cell_view_new_with_pixbuf 'Fgtk_cell_view_new_with_text
- 'Fgtk_cell_view_set_background_color 'Fgtk_cell_view_set_displayed_row
- 'Fgtk_cell_view_set_model 'Fgtk_check_button_new
- 'Fgtk_check_button_new_with_mnemonic 'Fgtk_check_menu_item_get_active
- 'Fgtk_check_menu_item_get_draw_as_radio 'Fgtk_check_menu_item_get_inconsistent
- 'Fgtk_check_menu_item_new 'Fgtk_check_menu_item_new_with_mnemonic
- 'Fgtk_check_menu_item_set_active 'Fgtk_check_menu_item_set_draw_as_radio
- 'Fgtk_check_menu_item_set_inconsistent 'Fgtk_check_menu_item_toggled
- 'Fgtk_check_version 'Fgtk_clipboard_clear 'Fgtk_clipboard_get
- 'Fgtk_clipboard_get_display 'Fgtk_clipboard_get_for_display
- 'Fgtk_clipboard_get_owner 'Fgtk_clipboard_request_contents
- 'Fgtk_clipboard_request_image 'Fgtk_clipboard_request_targets
- 'Fgtk_clipboard_request_text 'Fgtk_clipboard_set_can_store
- 'Fgtk_clipboard_set_image 'Fgtk_clipboard_set_text
- 'Fgtk_clipboard_set_with_data 'Fgtk_clipboard_store
- 'Fgtk_clipboard_wait_for_contents 'Fgtk_clipboard_wait_for_image
- 'Fgtk_clipboard_wait_for_targets 'Fgtk_clipboard_wait_for_text
- 'Fgtk_clipboard_wait_is_image_available 'Fgtk_clipboard_wait_is_target_available
- 'Fgtk_clipboard_wait_is_text_available
- 'Fgtk_color_button_get_alpha 'Fgtk_color_button_get_color
- 'Fgtk_color_button_get_title 'Fgtk_color_button_get_use_alpha
- 'Fgtk_color_button_new 'Fgtk_color_button_new_with_color
- 'Fgtk_color_button_set_alpha 'Fgtk_color_button_set_color
- 'Fgtk_color_button_set_title 'Fgtk_color_button_set_use_alpha
- 'Fgtk_color_selection_dialog_new 'Fgtk_color_selection_get_current_alpha
- 'Fgtk_color_selection_get_current_color 'Fgtk_color_selection_get_has_opacity_control
- 'Fgtk_color_selection_get_has_palette 'Fgtk_color_selection_get_previous_alpha
- 'Fgtk_color_selection_get_previous_color 'Fgtk_color_selection_is_adjusting
- 'Fgtk_color_selection_new 'Fgtk_color_selection_palette_to_string
- 'Fgtk_color_selection_set_current_alpha 'Fgtk_color_selection_set_current_color
- 'Fgtk_color_selection_set_has_opacity_control 'Fgtk_color_selection_set_has_palette
- 'Fgtk_color_selection_set_previous_alpha 'Fgtk_color_selection_set_previous_color
- 'Fgtk_combo_box_get_active 'Fgtk_combo_box_get_active_iter
- 'Fgtk_combo_box_get_add_tearoffs
- 'Fgtk_combo_box_get_column_span_column 'Fgtk_combo_box_get_focus_on_click
- 'Fgtk_combo_box_get_model 'Fgtk_combo_box_get_row_span_column
- 'Fgtk_combo_box_get_wrap_width
- 'Fgtk_combo_box_new
- 'Fgtk_combo_box_new_with_model
- 'Fgtk_combo_box_popdown 'Fgtk_combo_box_popup
- 'Fgtk_combo_box_set_active
- 'Fgtk_combo_box_set_active_iter
- 'Fgtk_combo_box_set_add_tearoffs 'Fgtk_combo_box_set_column_span_column
- 'Fgtk_combo_box_set_focus_on_click 'Fgtk_combo_box_set_model
- 'Fgtk_combo_box_set_row_separator_func 'Fgtk_combo_box_set_row_span_column
- 'Fgtk_combo_box_set_wrap_width 'Fgtk_container_add 'Fgtk_container_check_resize
- 'Fgtk_container_foreach 'Fgtk_container_get_border_width 'Fgtk_container_get_children
- 'Fgtk_container_get_resize_mode 'Fgtk_container_remove
- 'Fgtk_container_set_border_width
- 'Fgtk_container_set_resize_mode 'Fgtk_dialog_add_action_widget
- 'Fgtk_dialog_add_button 'Fgtk_dialog_add_buttons 'Fgtk_dialog_new
- 'Fgtk_dialog_new_with_buttons 'Fgtk_dialog_response 'Fgtk_dialog_run
- 'Fgtk_dialog_set_alternative_button_order_from_array 'Fgtk_dialog_set_default_response
- 'Fgtk_dialog_set_response_sensitive 'Fgtk_drag_begin 'Fgtk_drag_check_threshold
- 'Fgtk_drag_dest_add_image_targets 'Fgtk_drag_dest_add_text_targets
- 'Fgtk_drag_dest_add_uri_targets 'Fgtk_drag_dest_find_target
- 'Fgtk_drag_dest_get_target_list 'Fgtk_drag_dest_set 'Fgtk_drag_dest_set_proxy
- 'Fgtk_drag_dest_set_target_list 'Fgtk_drag_dest_unset 'Fgtk_drag_finish
- 'Fgtk_drag_get_data 'Fgtk_drag_get_source_widget 'Fgtk_drag_highlight
- 'Fgtk_drag_set_icon_default 'Fgtk_drag_set_icon_pixbuf 'Fgtk_drag_set_icon_stock
- 'Fgtk_drag_set_icon_widget 'Fgtk_drag_source_add_image_targets
- 'Fgtk_drag_source_add_text_targets 'Fgtk_drag_source_add_uri_targets
- 'Fgtk_drag_source_get_target_list 'Fgtk_drag_source_set
- 'Fgtk_drag_source_set_icon_pixbuf 'Fgtk_drag_source_set_icon_stock
- 'Fgtk_drag_source_set_target_list 'Fgtk_drag_source_unset
- 'Fgtk_drag_unhighlight 'Fgtk_drawing_area_new 'Fgtk_editable_copy_clipboard
- 'Fgtk_editable_cut_clipboard 'Fgtk_editable_delete_selection
- 'Fgtk_editable_delete_text
- 'Fgtk_editable_get_chars 'Fgtk_editable_get_editable
- 'Fgtk_editable_get_position 'Fgtk_editable_get_selection_bounds
- 'Fgtk_editable_insert_text 'Fgtk_editable_paste_clipboard
- 'Fgtk_editable_set_editable 'Fgtk_editable_set_position
- 'Fgtk_entry_completion_complete 'Fgtk_entry_completion_delete_action
- 'Fgtk_entry_completion_get_entry 'Fgtk_entry_completion_get_inline_completion
- 'Fgtk_entry_completion_get_minimum_key_length 'Fgtk_entry_completion_get_model
- 'Fgtk_entry_completion_get_popup_completion 'Fgtk_entry_completion_get_text_column
- 'Fgtk_entry_completion_insert_action_markup 'Fgtk_entry_completion_insert_action_text
- 'Fgtk_entry_completion_insert_prefix 'Fgtk_entry_completion_new
- 'Fgtk_entry_completion_set_inline_completion 'Fgtk_entry_completion_set_match_func
- 'Fgtk_entry_completion_set_minimum_key_length 'Fgtk_entry_completion_set_model
- 'Fgtk_entry_completion_set_popup_completion 'Fgtk_entry_completion_set_text_column
- 'Fgtk_entry_get_activates_default 'Fgtk_entry_get_alignment
- 'Fgtk_entry_get_completion
- 'Fgtk_entry_get_has_frame 'Fgtk_entry_get_invisible_char 'Fgtk_entry_get_layout
- 'Fgtk_entry_get_max_length 'Fgtk_entry_get_text 'Fgtk_entry_get_visibility
- 'Fgtk_entry_get_width_chars 'Fgtk_entry_layout_index_to_text_index 'Fgtk_entry_new
- 'Fgtk_entry_set_activates_default 'Fgtk_entry_set_alignment
- 'Fgtk_entry_set_completion 'Fgtk_entry_set_has_frame 'Fgtk_entry_set_invisible_char
- 'Fgtk_entry_set_max_length 'Fgtk_entry_set_text 'Fgtk_entry_set_visibility
- 'Fgtk_entry_set_width_chars 'Fgtk_entry_text_index_to_layout_index
- 'Fgtk_event_box_get_above_child 'Fgtk_event_box_get_visible_window
- 'Fgtk_event_box_new 'Fgtk_event_box_set_above_child
- 'Fgtk_event_box_set_visible_window 'Fgtk_events_pending 'Fgtk_expander_get_expanded
- 'Fgtk_expander_get_label 'Fgtk_expander_get_label_widget
- 'Fgtk_expander_get_spacing 'Fgtk_expander_get_use_markup
- 'Fgtk_expander_get_use_underline 'Fgtk_expander_new 'Fgtk_expander_new_with_mnemonic
- 'Fgtk_expander_set_expanded 'Fgtk_expander_set_label 'Fgtk_expander_set_label_widget
- 'Fgtk_expander_set_spacing 'Fgtk_expander_set_use_markup
- 'Fgtk_expander_set_use_underline 'Fgtk_false ) constant gtk-procs-1
-
- #( 'Fgtk_file_chooser_add_filter 'Fgtk_file_chooser_add_shortcut_folder
- 'Fgtk_file_chooser_add_shortcut_folder_uri 'Fgtk_file_chooser_button_get_title
- 'Fgtk_file_chooser_button_get_width_chars 'Fgtk_file_chooser_button_set_title
- 'Fgtk_file_chooser_button_set_width_chars 'Fgtk_file_chooser_dialog_new
- 'Fgtk_file_chooser_get_action 'Fgtk_file_chooser_get_current_folder
- 'Fgtk_file_chooser_get_current_folder_uri 'Fgtk_file_chooser_get_extra_widget
- 'Fgtk_file_chooser_get_filename 'Fgtk_file_chooser_get_filenames
- 'Fgtk_file_chooser_get_filter 'Fgtk_file_chooser_get_local_only
- 'Fgtk_file_chooser_get_preview_filename 'Fgtk_file_chooser_get_preview_uri
- 'Fgtk_file_chooser_get_preview_widget 'Fgtk_file_chooser_get_preview_widget_active
- 'Fgtk_file_chooser_get_select_multiple 'Fgtk_file_chooser_get_show_hidden
- 'Fgtk_file_chooser_get_uri 'Fgtk_file_chooser_get_uris
- 'Fgtk_file_chooser_get_use_preview_label 'Fgtk_file_chooser_list_filters
- 'Fgtk_file_chooser_list_shortcut_folder_uris 'Fgtk_file_chooser_list_shortcut_folders
- 'Fgtk_file_chooser_remove_filter 'Fgtk_file_chooser_remove_shortcut_folder
- 'Fgtk_file_chooser_remove_shortcut_folder_uri 'Fgtk_file_chooser_select_all
- 'Fgtk_file_chooser_select_filename 'Fgtk_file_chooser_select_uri
- 'Fgtk_file_chooser_set_action 'Fgtk_file_chooser_set_current_folder
- 'Fgtk_file_chooser_set_current_folder_uri 'Fgtk_file_chooser_set_current_name
- 'Fgtk_file_chooser_set_extra_widget 'Fgtk_file_chooser_set_filename
- 'Fgtk_file_chooser_set_filter 'Fgtk_file_chooser_set_local_only
- 'Fgtk_file_chooser_set_preview_widget 'Fgtk_file_chooser_set_preview_widget_active
- 'Fgtk_file_chooser_set_select_multiple 'Fgtk_file_chooser_set_show_hidden
- 'Fgtk_file_chooser_set_uri 'Fgtk_file_chooser_set_use_preview_label
- 'Fgtk_file_chooser_unselect_all 'Fgtk_file_chooser_unselect_filename
- 'Fgtk_file_chooser_unselect_uri 'Fgtk_file_filter_add_pattern
- 'Fgtk_file_filter_add_pixbuf_formats 'Fgtk_file_filter_filter
- 'Fgtk_file_filter_get_name 'Fgtk_file_filter_get_needed
- 'Fgtk_file_filter_new 'Fgtk_file_filter_set_name
- 'Fgtk_fixed_move 'Fgtk_fixed_new 'Fgtk_fixed_put
- 'Fgtk_font_button_get_font_name 'Fgtk_font_button_get_show_size
- 'Fgtk_font_button_get_show_style 'Fgtk_font_button_get_title
- 'Fgtk_font_button_get_use_font 'Fgtk_font_button_get_use_size
- 'Fgtk_font_button_new 'Fgtk_font_button_new_with_font
- 'Fgtk_font_button_set_font_name 'Fgtk_font_button_set_show_size
- 'Fgtk_font_button_set_show_style 'Fgtk_font_button_set_title
- 'Fgtk_font_button_set_use_font 'Fgtk_font_button_set_use_size
- 'Fgtk_font_selection_dialog_get_font_name 'Fgtk_font_selection_dialog_get_preview_text
- 'Fgtk_font_selection_dialog_new 'Fgtk_font_selection_dialog_set_font_name
- 'Fgtk_font_selection_dialog_set_preview_text 'Fgtk_font_selection_get_font_name
- 'Fgtk_font_selection_get_preview_text 'Fgtk_font_selection_new
- 'Fgtk_font_selection_set_preview_text 'Fgtk_frame_get_label
- 'Fgtk_frame_get_label_align 'Fgtk_frame_get_label_widget
- 'Fgtk_frame_get_shadow_type 'Fgtk_frame_new
- 'Fgtk_frame_set_label 'Fgtk_frame_set_label_align
- 'Fgtk_frame_set_label_widget 'Fgtk_frame_set_shadow_type
- 'Fgtk_get_current_event 'Fgtk_get_current_event_state
- 'Fgtk_get_current_event_time 'Fgtk_get_default_language
- 'Fgtk_get_event_widget 'Fgtk_grab_add 'Fgtk_grab_get_current
- 'Fgtk_grab_remove 'Fgtk_handle_box_get_handle_position
- 'Fgtk_handle_box_get_shadow_type 'Fgtk_handle_box_get_snap_edge
- 'Fgtk_handle_box_new 'Fgtk_handle_box_set_handle_position
- 'Fgtk_handle_box_set_shadow_type 'Fgtk_handle_box_set_snap_edge
- 'Fgtk_hbox_new 'Fgtk_hbutton_box_new 'Fgtk_hpaned_new
- 'Fgtk_hscale_new 'Fgtk_hscale_new_with_range
- 'Fgtk_hscrollbar_new 'Fgtk_hseparator_new 'Fgtk_icon_factory_add
- 'Fgtk_icon_factory_add_default 'Fgtk_icon_factory_lookup
- 'Fgtk_icon_factory_lookup_default 'Fgtk_icon_factory_new
- 'Fgtk_icon_factory_remove_default 'Fgtk_icon_info_copy
- 'Fgtk_icon_info_free 'Fgtk_icon_info_get_base_size
- 'Fgtk_icon_info_get_builtin_pixbuf 'Fgtk_icon_info_get_display_name
- 'Fgtk_icon_info_get_embedded_rect 'Fgtk_icon_info_get_filename
- 'Fgtk_icon_info_load_icon 'Fgtk_icon_info_set_raw_coordinates
- 'Fgtk_icon_set_add_source 'Fgtk_icon_set_copy
- 'Fgtk_icon_set_get_sizes 'Fgtk_icon_set_new
- 'Fgtk_icon_set_new_from_pixbuf 'Fgtk_icon_set_ref
- 'Fgtk_icon_set_render_icon 'Fgtk_icon_set_unref
- 'Fgtk_icon_size_get_name 'Fgtk_icon_size_lookup
- 'Fgtk_icon_size_register 'Fgtk_icon_size_register_alias
- 'Fgtk_icon_source_copy 'Fgtk_icon_source_free
- 'Fgtk_icon_source_get_direction 'Fgtk_icon_source_get_direction_wildcarded
- 'Fgtk_icon_source_get_filename
- 'Fgtk_icon_source_get_icon_name 'Fgtk_icon_source_get_pixbuf
- 'Fgtk_icon_source_get_size 'Fgtk_icon_source_get_size_wildcarded
- 'Fgtk_icon_source_get_state 'Fgtk_icon_source_get_state_wildcarded
- 'Fgtk_icon_source_new 'Fgtk_icon_source_set_direction
- 'Fgtk_icon_source_set_direction_wildcarded
- 'Fgtk_icon_source_set_filename 'Fgtk_icon_source_set_pixbuf
- 'Fgtk_icon_source_set_size 'Fgtk_icon_source_set_size_wildcarded
- 'Fgtk_icon_source_set_state 'Fgtk_icon_source_set_state_wildcarded
- 'Fgtk_icon_theme_add_builtin_icon 'Fgtk_icon_theme_append_search_path
- 'Fgtk_icon_theme_get_default 'Fgtk_icon_theme_get_example_icon_name
- 'Fgtk_icon_theme_get_for_screen 'Fgtk_icon_theme_get_icon_sizes
- 'Fgtk_icon_theme_get_search_path 'Fgtk_icon_theme_has_icon
- 'Fgtk_icon_theme_list_icons 'Fgtk_icon_theme_load_icon
- 'Fgtk_icon_theme_lookup_icon 'Fgtk_icon_theme_new
- 'Fgtk_icon_theme_prepend_search_path 'Fgtk_icon_theme_rescan_if_needed
- 'Fgtk_icon_theme_set_custom_theme 'Fgtk_icon_theme_set_screen
- 'Fgtk_icon_view_get_markup_column 'Fgtk_icon_view_get_model
- 'Fgtk_icon_view_get_path_at_pos 'Fgtk_icon_view_get_pixbuf_column
- 'Fgtk_icon_view_get_selected_items 'Fgtk_icon_view_get_selection_mode
- 'Fgtk_icon_view_get_text_column 'Fgtk_icon_view_item_activated
- 'Fgtk_icon_view_new 'Fgtk_icon_view_new_with_model
- 'Fgtk_icon_view_path_is_selected 'Fgtk_icon_view_select_all
- 'Fgtk_icon_view_select_path 'Fgtk_icon_view_selected_foreach
- 'Fgtk_icon_view_set_markup_column 'Fgtk_icon_view_set_model
- 'Fgtk_icon_view_set_pixbuf_column 'Fgtk_icon_view_set_selection_mode
- 'Fgtk_icon_view_set_text_column 'Fgtk_icon_view_unselect_all
- 'Fgtk_icon_view_unselect_path 'Fgtk_im_context_delete_surrounding
- 'Fgtk_im_context_filter_keypress 'Fgtk_im_context_focus_in
- 'Fgtk_im_context_focus_out 'Fgtk_im_context_get_preedit_string
- 'Fgtk_im_context_get_surrounding 'Fgtk_im_context_reset
- 'Fgtk_im_context_set_client_window 'Fgtk_im_context_set_cursor_location
- 'Fgtk_im_context_set_surrounding 'Fgtk_im_context_set_use_preedit
- 'Fgtk_im_context_simple_add_table 'Fgtk_im_context_simple_new
- 'Fgtk_im_multicontext_append_menuitems 'Fgtk_im_multicontext_new
- 'Fgtk_label_get_attributes 'Fgtk_label_get_ellipsize
- 'Fgtk_label_get_justify 'Fgtk_label_get_label
- 'Fgtk_label_get_layout 'Fgtk_label_get_layout_offsets
- 'Fgtk_label_get_line_wrap 'Fgtk_label_get_mnemonic_keyval
- 'Fgtk_label_get_mnemonic_widget 'Fgtk_label_get_selectable
- 'Fgtk_label_get_selection_bounds 'Fgtk_label_get_single_line_mode
- 'Fgtk_label_get_text 'Fgtk_label_get_use_markup
- 'Fgtk_label_get_use_underline 'Fgtk_label_get_width_chars
- 'Fgtk_label_new 'Fgtk_label_new_with_mnemonic 'Fgtk_label_set_angle
- 'Fgtk_label_set_attributes 'Fgtk_label_set_ellipsize
- 'Fgtk_label_set_justify 'Fgtk_label_set_label
- 'Fgtk_label_set_line_wrap 'Fgtk_label_set_markup
- 'Fgtk_label_set_markup_with_mnemonic 'Fgtk_label_set_mnemonic_widget
- 'Fgtk_label_set_pattern 'Fgtk_label_set_selectable
- 'Fgtk_label_set_single_line_mode 'Fgtk_label_set_text
- 'Fgtk_label_set_text_with_mnemonic 'Fgtk_label_set_use_markup
- 'Fgtk_label_set_use_underline 'Fgtk_label_set_width_chars
- 'Fgtk_layout_get_size
- 'Fgtk_layout_move 'Fgtk_layout_new
- 'Fgtk_layout_set_size
- 'Fgtk_list_store_append
- 'Fgtk_list_store_clear 'Fgtk_list_store_insert
- 'Fgtk_list_store_insert_after 'Fgtk_list_store_insert_before
- 'Fgtk_list_store_move_after 'Fgtk_list_store_move_before
- 'Fgtk_list_store_new 'Fgtk_list_store_newv 'Fgtk_list_store_prepend
- 'Fgtk_list_store_remove 'Fgtk_list_store_reorder
- 'Fgtk_list_store_set 'Fgtk_list_store_set_column_types
- 'Fgtk_list_store_swap 'Fgtk_menu_attach 'Fgtk_menu_bar_new
- 'Fgtk_menu_detach 'Fgtk_menu_get_accel_group 'Fgtk_menu_get_active
- 'Fgtk_menu_get_attach_widget 'Fgtk_menu_get_for_attach_widget
- 'Fgtk_menu_get_tearoff_state 'Fgtk_menu_get_title
- 'Fgtk_menu_item_activate 'Fgtk_menu_item_deselect
- 'Fgtk_menu_item_get_right_justified 'Fgtk_menu_item_get_submenu
- 'Fgtk_menu_item_new 'Fgtk_menu_item_new_with_mnemonic
- 'Fgtk_menu_item_select 'Fgtk_menu_item_set_accel_path
- 'Fgtk_menu_item_set_right_justified 'Fgtk_menu_item_set_submenu
- 'Fgtk_menu_item_toggle_size_allocate
- 'Fgtk_menu_item_toggle_size_request 'Fgtk_menu_new
- 'Fgtk_menu_popdown 'Fgtk_menu_popup 'Fgtk_menu_reorder_child
- 'Fgtk_menu_reposition 'Fgtk_menu_set_accel_group
- 'Fgtk_menu_set_accel_path 'Fgtk_menu_set_active
- 'Fgtk_menu_set_monitor 'Fgtk_menu_set_screen
- 'Fgtk_menu_set_tearoff_state 'Fgtk_menu_set_title
- 'Fgtk_menu_shell_activate_item 'Fgtk_menu_shell_append
- 'Fgtk_menu_shell_cancel 'Fgtk_menu_shell_deactivate
- 'Fgtk_menu_shell_deselect 'Fgtk_menu_shell_insert
- 'Fgtk_menu_shell_prepend 'Fgtk_menu_shell_select_first
- 'Fgtk_menu_shell_select_item 'Fgtk_menu_tool_button_get_menu
- 'Fgtk_menu_tool_button_new 'Fgtk_menu_tool_button_new_from_stock
- 'Fgtk_menu_tool_button_set_menu 'Fgtk_misc_get_alignment
- 'Fgtk_misc_get_padding 'Fgtk_misc_set_alignment
- 'Fgtk_misc_set_padding 'Fgtk_notebook_append_page
- 'Fgtk_notebook_append_page_menu 'Fgtk_notebook_get_current_page
- 'Fgtk_notebook_get_menu_label 'Fgtk_notebook_get_menu_label_text
- 'Fgtk_notebook_get_n_pages 'Fgtk_notebook_get_nth_page
- 'Fgtk_notebook_get_scrollable 'Fgtk_notebook_get_show_border
- 'Fgtk_notebook_get_show_tabs 'Fgtk_notebook_get_tab_label
- 'Fgtk_notebook_get_tab_label_text 'Fgtk_notebook_get_tab_pos
- 'Fgtk_notebook_insert_page 'Fgtk_notebook_insert_page_menu
- 'Fgtk_notebook_new 'Fgtk_notebook_next_page 'Fgtk_notebook_page_num
- 'Fgtk_notebook_popup_disable 'Fgtk_notebook_popup_enable
- 'Fgtk_notebook_prepend_page 'Fgtk_notebook_prepend_page_menu
- 'Fgtk_notebook_prev_page 'Fgtk_notebook_remove_page
- 'Fgtk_notebook_reorder_child 'Fgtk_notebook_set_current_page
- 'Fgtk_notebook_set_menu_label 'Fgtk_notebook_set_menu_label_text
- 'Fgtk_notebook_set_scrollable 'Fgtk_notebook_set_show_border
- 'Fgtk_notebook_set_show_tabs 'Fgtk_notebook_set_tab_label
- 'Fgtk_notebook_set_tab_label_text 'Fgtk_notebook_set_tab_pos
- 'Fgtk_paned_add1 'Fgtk_paned_add2 'Fgtk_paned_get_child1
- 'Fgtk_paned_get_child2 'Fgtk_paned_get_position 'Fgtk_paned_pack1
- 'Fgtk_paned_pack2 'Fgtk_paned_set_position 'Fgtk_plug_construct
- 'Fgtk_plug_get_id 'Fgtk_plug_new 'Fgtk_progress_bar_get_ellipsize
- 'Fgtk_progress_bar_get_fraction 'Fgtk_progress_bar_get_pulse_step
- 'Fgtk_progress_bar_get_text 'Fgtk_progress_bar_new
- 'Fgtk_progress_bar_pulse 'Fgtk_progress_bar_set_ellipsize
- 'Fgtk_progress_bar_set_fraction 'Fgtk_progress_bar_set_pulse_step
- 'Fgtk_progress_bar_set_text 'Fgtk_propagate_event
- 'Fgtk_radio_action_get_current_value 'Fgtk_radio_action_get_group
- 'Fgtk_radio_action_new 'Fgtk_radio_action_set_group
- 'Fgtk_radio_button_get_group 'Fgtk_radio_button_new
- 'Fgtk_radio_button_new_from_widget 'Fgtk_radio_button_new_with_label_from_widget
- 'Fgtk_radio_button_new_with_mnemonic 'Fgtk_radio_button_new_with_mnemonic_from_widget
- 'Fgtk_radio_button_set_group 'Fgtk_radio_menu_item_get_group
- 'Fgtk_radio_menu_item_new 'Fgtk_radio_menu_item_new_from_widget
- 'Fgtk_radio_menu_item_new_with_label_from_widget
- 'Fgtk_radio_menu_item_new_with_mnemonic
- 'Fgtk_radio_menu_item_new_with_mnemonic_from_widget
- 'Fgtk_radio_menu_item_set_group 'Fgtk_radio_tool_button_get_group
- 'Fgtk_radio_tool_button_new 'Fgtk_radio_tool_button_new_from_stock
- 'Fgtk_radio_tool_button_new_from_widget
- 'Fgtk_radio_tool_button_new_with_stock_from_widget
- 'Fgtk_radio_tool_button_set_group 'Fgtk_range_get_adjustment
- 'Fgtk_range_get_inverted 'Fgtk_range_get_update_policy
- 'Fgtk_range_get_value 'Fgtk_range_set_adjustment
- 'Fgtk_range_set_increments 'Fgtk_range_set_inverted
- 'Fgtk_range_set_range 'Fgtk_range_set_update_policy
- 'Fgtk_range_set_value 'Fgtk_rc_add_default_file
- 'Fgtk_rc_get_default_files 'Fgtk_rc_get_im_module_file
- 'Fgtk_rc_get_im_module_path 'Fgtk_rc_get_module_dir
- 'Fgtk_rc_get_style 'Fgtk_rc_get_theme_dir 'Fgtk_rc_parse
- 'Fgtk_rc_reparse_all 'Fgtk_rc_set_default_files 'Fgtk_rc_style_copy
- 'Fgtk_rc_style_new 'Fgtk_scale_get_digits
- 'Fgtk_scale_get_draw_value 'Fgtk_scale_get_layout
- 'Fgtk_scale_get_layout_offsets 'Fgtk_scale_get_value_pos
- 'Fgtk_scale_set_digits 'Fgtk_scale_set_draw_value
- 'Fgtk_scale_set_value_pos 'Fgtk_scrolled_window_add_with_viewport
- 'Fgtk_scrolled_window_get_hadjustment 'Fgtk_scrolled_window_get_placement
- 'Fgtk_scrolled_window_get_policy 'Fgtk_scrolled_window_get_shadow_type
- 'Fgtk_scrolled_window_get_vadjustment 'Fgtk_scrolled_window_new
- 'Fgtk_scrolled_window_set_hadjustment 'Fgtk_scrolled_window_set_placement
- 'Fgtk_scrolled_window_set_policy 'Fgtk_scrolled_window_set_shadow_type
- 'Fgtk_scrolled_window_set_vadjustment 'Fgtk_selection_add_target
- 'Fgtk_selection_add_targets 'Fgtk_selection_clear_targets
- 'Fgtk_selection_convert 'Fgtk_selection_data_copy
- 'Fgtk_selection_data_free 'Fgtk_selection_data_get_pixbuf
- 'Fgtk_selection_data_get_targets 'Fgtk_selection_data_get_text
- 'Fgtk_selection_data_get_uris 'Fgtk_selection_data_set
- 'Fgtk_selection_data_set_pixbuf 'Fgtk_selection_data_set_text
- 'Fgtk_selection_data_set_uris 'Fgtk_selection_data_targets_include_image
- 'Fgtk_selection_data_targets_include_text 'Fgtk_selection_owner_set
- 'Fgtk_selection_remove_all 'Fgtk_separator_menu_item_new
- 'Fgtk_separator_tool_item_get_draw 'Fgtk_separator_tool_item_new
- 'Fgtk_separator_tool_item_set_draw 'Fgtk_set_locale
- 'Fgtk_size_group_add_widget 'Fgtk_size_group_get_mode
- 'Fgtk_size_group_new 'Fgtk_size_group_remove_widget
- 'Fgtk_size_group_set_mode 'Fgtk_socket_add_id
- 'Fgtk_socket_get_id 'Fgtk_socket_new 'Fgtk_spin_button_configure
- 'Fgtk_spin_button_get_adjustment 'Fgtk_spin_button_get_digits
- 'Fgtk_spin_button_get_increments 'Fgtk_spin_button_get_numeric
- 'Fgtk_spin_button_get_range 'Fgtk_spin_button_get_snap_to_ticks
- 'Fgtk_spin_button_get_update_policy 'Fgtk_spin_button_get_value
- 'Fgtk_spin_button_get_value_as_int 'Fgtk_spin_button_get_wrap
- 'Fgtk_spin_button_new 'Fgtk_spin_button_new_with_range
- 'Fgtk_spin_button_set_adjustment 'Fgtk_spin_button_set_digits
- 'Fgtk_spin_button_set_increments 'Fgtk_spin_button_set_numeric
- 'Fgtk_spin_button_set_range 'Fgtk_spin_button_set_snap_to_ticks
- 'Fgtk_spin_button_set_update_policy 'Fgtk_spin_button_set_value
- 'Fgtk_spin_button_set_wrap 'Fgtk_spin_button_spin
- 'Fgtk_spin_button_update 'Fgtk_statusbar_get_context_id
- 'Fgtk_statusbar_new
- 'Fgtk_statusbar_pop 'Fgtk_statusbar_push
- 'Fgtk_statusbar_remove
- 'Fgtk_stock_add 'Fgtk_stock_add_static 'Fgtk_stock_item_copy
- 'Fgtk_stock_item_free 'Fgtk_stock_list_ids 'Fgtk_stock_lookup
- 'Fgtk_style_attach 'Fgtk_style_copy 'Fgtk_style_detach
- 'Fgtk_style_lookup_icon_set 'Fgtk_style_new 'Fgtk_style_render_icon
- 'Fgtk_style_set_background 'Fgtk_table_attach
- 'Fgtk_table_attach_defaults 'Fgtk_table_get_col_spacing
- 'Fgtk_table_get_default_col_spacing 'Fgtk_table_get_default_row_spacing
- 'Fgtk_table_get_homogeneous 'Fgtk_table_get_row_spacing
- 'Fgtk_table_new 'Fgtk_table_resize 'Fgtk_table_set_col_spacing
- 'Fgtk_table_set_col_spacings 'Fgtk_table_set_homogeneous
- 'Fgtk_table_set_row_spacing 'Fgtk_table_set_row_spacings
- 'Fgtk_target_list_add 'Fgtk_target_list_add_image_targets
- 'Fgtk_target_list_add_table 'Fgtk_target_list_add_text_targets
- 'Fgtk_target_list_add_uri_targets 'Fgtk_target_list_find
- 'Fgtk_target_list_remove 'Fgtk_target_list_unref
- 'Fgtk_tearoff_menu_item_new 'Fgtk_text_attributes_copy
- 'Fgtk_text_attributes_copy_values 'Fgtk_text_attributes_new
- 'Fgtk_text_attributes_unref 'Fgtk_text_buffer_add_selection_clipboard
- 'Fgtk_text_buffer_apply_tag 'Fgtk_text_buffer_apply_tag_by_name
- 'Fgtk_text_buffer_backspace 'Fgtk_text_buffer_begin_user_action
- 'Fgtk_text_buffer_copy_clipboard 'Fgtk_text_buffer_create_child_anchor
- 'Fgtk_text_buffer_create_mark 'Fgtk_text_buffer_create_tag
- 'Fgtk_text_buffer_cut_clipboard 'Fgtk_text_buffer_delete
- 'Fgtk_text_buffer_delete_interactive 'Fgtk_text_buffer_delete_mark
- 'Fgtk_text_buffer_delete_mark_by_name
- 'Fgtk_text_buffer_delete_selection 'Fgtk_text_buffer_end_user_action
- 'Fgtk_text_buffer_get_bounds 'Fgtk_text_buffer_get_char_count
- 'Fgtk_text_buffer_get_end_iter 'Fgtk_text_buffer_get_insert
- 'Fgtk_text_buffer_get_iter_at_child_anchor 'Fgtk_text_buffer_get_iter_at_line
- 'Fgtk_text_buffer_get_iter_at_line_index 'Fgtk_text_buffer_get_iter_at_line_offset
- 'Fgtk_text_buffer_get_iter_at_mark 'Fgtk_text_buffer_get_iter_at_offset
- 'Fgtk_text_buffer_get_line_count 'Fgtk_text_buffer_get_mark
- 'Fgtk_text_buffer_get_modified 'Fgtk_text_buffer_get_selection_bound
- 'Fgtk_text_buffer_get_selection_bounds 'Fgtk_text_buffer_get_slice
- 'Fgtk_text_buffer_get_start_iter 'Fgtk_text_buffer_get_tag_table
- 'Fgtk_text_buffer_get_text 'Fgtk_text_buffer_insert
- 'Fgtk_text_buffer_insert_at_cursor 'Fgtk_text_buffer_insert_child_anchor
- 'Fgtk_text_buffer_insert_interactive 'Fgtk_text_buffer_insert_interactive_at_cursor
- 'Fgtk_text_buffer_insert_pixbuf 'Fgtk_text_buffer_insert_range
- 'Fgtk_text_buffer_insert_range_interactive 'Fgtk_text_buffer_insert_with_tags
- 'Fgtk_text_buffer_insert_with_tags_by_name 'Fgtk_text_buffer_move_mark
- 'Fgtk_text_buffer_move_mark_by_name 'Fgtk_text_buffer_new
- 'Fgtk_text_buffer_paste_clipboard 'Fgtk_text_buffer_place_cursor
- 'Fgtk_text_buffer_remove_all_tags 'Fgtk_text_buffer_remove_selection_clipboard
- 'Fgtk_text_buffer_remove_tag 'Fgtk_text_buffer_remove_tag_by_name
- 'Fgtk_text_buffer_select_range 'Fgtk_text_buffer_set_modified
- 'Fgtk_text_buffer_set_text 'Fgtk_text_child_anchor_get_deleted
- 'Fgtk_text_child_anchor_get_widgets 'Fgtk_text_child_anchor_new
- 'Fgtk_text_iter_backward_char 'Fgtk_text_iter_backward_chars
- 'Fgtk_text_iter_backward_cursor_position 'Fgtk_text_iter_backward_cursor_positions
- 'Fgtk_text_iter_backward_find_char 'Fgtk_text_iter_backward_line
- 'Fgtk_text_iter_backward_lines 'Fgtk_text_iter_backward_search
- 'Fgtk_text_iter_backward_sentence_start 'Fgtk_text_iter_backward_sentence_starts
- 'Fgtk_text_iter_backward_to_tag_toggle 'Fgtk_text_iter_backward_word_start
- 'Fgtk_text_iter_backward_word_starts 'Fgtk_text_iter_begins_tag
- 'Fgtk_text_iter_can_insert 'Fgtk_text_iter_compare
- 'Fgtk_text_iter_copy 'Fgtk_text_iter_editable
- 'Fgtk_text_iter_ends_line 'Fgtk_text_iter_ends_sentence
- 'Fgtk_text_iter_ends_tag 'Fgtk_text_iter_ends_word
- 'Fgtk_text_iter_equal 'Fgtk_text_iter_forward_char
- 'Fgtk_text_iter_forward_chars 'Fgtk_text_iter_forward_cursor_position
- 'Fgtk_text_iter_forward_cursor_positions 'Fgtk_text_iter_forward_find_char
- 'Fgtk_text_iter_forward_line 'Fgtk_text_iter_forward_lines
- 'Fgtk_text_iter_forward_search 'Fgtk_text_iter_forward_sentence_end
- 'Fgtk_text_iter_forward_sentence_ends 'Fgtk_text_iter_forward_to_end
- 'Fgtk_text_iter_forward_to_line_end
- 'Fgtk_text_iter_forward_to_tag_toggle 'Fgtk_text_iter_forward_word_end
- 'Fgtk_text_iter_forward_word_ends 'Fgtk_text_iter_free
- 'Fgtk_text_iter_get_attributes 'Fgtk_text_iter_get_buffer
- 'Fgtk_text_iter_get_bytes_in_line 'Fgtk_text_iter_get_char
- 'Fgtk_text_iter_get_chars_in_line 'Fgtk_text_iter_get_child_anchor
- 'Fgtk_text_iter_get_language 'Fgtk_text_iter_get_line
- 'Fgtk_text_iter_get_line_index 'Fgtk_text_iter_get_line_offset
- 'Fgtk_text_iter_get_marks 'Fgtk_text_iter_get_offset
- 'Fgtk_text_iter_get_pixbuf 'Fgtk_text_iter_get_slice
- 'Fgtk_text_iter_get_tags 'Fgtk_text_iter_get_text
- 'Fgtk_text_iter_get_toggled_tags 'Fgtk_text_iter_get_visible_line_index
- 'Fgtk_text_iter_get_visible_line_offset
- 'Fgtk_text_iter_get_visible_slice 'Fgtk_text_iter_get_visible_text
- 'Fgtk_text_iter_has_tag 'Fgtk_text_iter_in_range
- 'Fgtk_text_iter_inside_sentence 'Fgtk_text_iter_inside_word
- 'Fgtk_text_iter_is_cursor_position 'Fgtk_text_iter_is_end
- 'Fgtk_text_iter_is_start 'Fgtk_text_iter_order
- 'Fgtk_text_iter_set_line 'Fgtk_text_iter_set_line_index
- 'Fgtk_text_iter_set_line_offset 'Fgtk_text_iter_set_offset
- 'Fgtk_text_iter_set_visible_line_index
- 'Fgtk_text_iter_set_visible_line_offset 'Fgtk_text_iter_starts_line
- 'Fgtk_text_iter_starts_sentence 'Fgtk_text_iter_starts_word
- 'Fgtk_text_iter_toggles_tag 'Fgtk_text_mark_get_buffer
- 'Fgtk_text_mark_get_deleted 'Fgtk_text_mark_get_left_gravity
- 'Fgtk_text_mark_get_name 'Fgtk_text_mark_get_visible
- 'Fgtk_text_mark_set_visible 'Fgtk_text_tag_event
- 'Fgtk_text_tag_get_priority 'Fgtk_text_tag_new
- 'Fgtk_text_tag_set_priority 'Fgtk_text_tag_table_add
- 'Fgtk_text_tag_table_foreach 'Fgtk_text_tag_table_get_size
- 'Fgtk_text_tag_table_lookup 'Fgtk_text_tag_table_new
- 'Fgtk_text_tag_table_remove 'Fgtk_text_view_add_child_at_anchor
- 'Fgtk_text_view_add_child_in_window 'Fgtk_text_view_backward_display_line
- 'Fgtk_text_view_backward_display_line_start 'Fgtk_text_view_buffer_to_window_coords
- 'Fgtk_text_view_forward_display_line 'Fgtk_text_view_forward_display_line_end
- 'Fgtk_text_view_get_accepts_tab 'Fgtk_text_view_get_border_window_size
- 'Fgtk_text_view_get_buffer 'Fgtk_text_view_get_cursor_visible
- 'Fgtk_text_view_get_default_attributes 'Fgtk_text_view_get_editable
- 'Fgtk_text_view_get_indent 'Fgtk_text_view_get_iter_at_location
- 'Fgtk_text_view_get_iter_location 'Fgtk_text_view_get_justification
- 'Fgtk_text_view_get_left_margin 'Fgtk_text_view_get_line_at_y
- 'Fgtk_text_view_get_line_yrange 'Fgtk_text_view_get_overwrite
- 'Fgtk_text_view_get_pixels_above_lines 'Fgtk_text_view_get_pixels_below_lines
- 'Fgtk_text_view_get_pixels_inside_wrap 'Fgtk_text_view_get_right_margin
- 'Fgtk_text_view_get_tabs 'Fgtk_text_view_get_visible_rect
- 'Fgtk_text_view_get_window 'Fgtk_text_view_get_window_type
- 'Fgtk_text_view_get_wrap_mode 'Fgtk_text_view_move_child
- 'Fgtk_text_view_move_mark_onscreen 'Fgtk_text_view_move_visually
- 'Fgtk_text_view_new 'Fgtk_text_view_new_with_buffer
- 'Fgtk_text_view_place_cursor_onscreen
- 'Fgtk_text_view_scroll_mark_onscreen 'Fgtk_text_view_scroll_to_iter
- 'Fgtk_text_view_scroll_to_mark 'Fgtk_text_view_set_accepts_tab
- 'Fgtk_text_view_set_border_window_size 'Fgtk_text_view_set_buffer
- 'Fgtk_text_view_set_cursor_visible 'Fgtk_text_view_set_editable
- 'Fgtk_text_view_set_indent 'Fgtk_text_view_set_justification
- 'Fgtk_text_view_set_left_margin 'Fgtk_text_view_set_overwrite
- 'Fgtk_text_view_set_pixels_above_lines 'Fgtk_text_view_set_pixels_below_lines
- 'Fgtk_text_view_set_pixels_inside_wrap 'Fgtk_text_view_set_right_margin
- 'Fgtk_text_view_set_tabs 'Fgtk_text_view_set_wrap_mode
- 'Fgtk_text_view_starts_display_line
- 'Fgtk_text_view_window_to_buffer_coords 'Fgtk_toggle_action_get_active
- 'Fgtk_toggle_action_get_draw_as_radio 'Fgtk_toggle_action_new
- 'Fgtk_toggle_action_set_active 'Fgtk_toggle_action_set_draw_as_radio
- 'Fgtk_toggle_action_toggled 'Fgtk_toggle_button_get_active
- 'Fgtk_toggle_button_get_inconsistent 'Fgtk_toggle_button_get_mode
- 'Fgtk_toggle_button_new 'Fgtk_toggle_button_new_with_mnemonic
- 'Fgtk_toggle_button_set_active 'Fgtk_toggle_button_set_inconsistent
- 'Fgtk_toggle_button_set_mode 'Fgtk_toggle_button_toggled
- 'Fgtk_toggle_tool_button_get_active 'Fgtk_toggle_tool_button_new
- 'Fgtk_toggle_tool_button_new_from_stock
- 'Fgtk_toggle_tool_button_set_active 'Fgtk_tool_button_get_icon_widget
- 'Fgtk_tool_button_get_label 'Fgtk_tool_button_get_label_widget
- 'Fgtk_tool_button_get_stock_id 'Fgtk_tool_button_get_use_underline
- 'Fgtk_tool_button_new 'Fgtk_tool_button_new_from_stock
- 'Fgtk_tool_button_set_icon_widget 'Fgtk_tool_button_set_label
- 'Fgtk_tool_button_set_label_widget 'Fgtk_tool_button_set_stock_id
- 'Fgtk_tool_button_set_use_underline 'Fgtk_tool_item_get_expand
- 'Fgtk_tool_item_get_homogeneous 'Fgtk_tool_item_get_icon_size
- 'Fgtk_tool_item_get_is_important 'Fgtk_tool_item_get_proxy_menu_item
- 'Fgtk_tool_item_get_relief_style 'Fgtk_tool_item_get_toolbar_style
- 'Fgtk_tool_item_get_use_drag_window 'Fgtk_tool_item_get_visible_horizontal
- 'Fgtk_tool_item_get_visible_vertical 'Fgtk_tool_item_new
- 'Fgtk_tool_item_rebuild_menu 'Fgtk_tool_item_retrieve_proxy_menu_item
- 'Fgtk_tool_item_set_expand 'Fgtk_tool_item_set_homogeneous
- 'Fgtk_tool_item_set_is_important 'Fgtk_tool_item_set_proxy_menu_item
- 'Fgtk_tool_item_set_visible_horizontal
- 'Fgtk_tool_item_set_visible_vertical 'Fgtk_toolbar_get_drop_index
- 'Fgtk_toolbar_get_icon_size 'Fgtk_toolbar_get_item_index
- 'Fgtk_toolbar_get_n_items 'Fgtk_toolbar_get_nth_item
- 'Fgtk_toolbar_get_relief_style 'Fgtk_toolbar_get_show_arrow
- 'Fgtk_toolbar_get_style 'Fgtk_toolbar_insert 'Fgtk_toolbar_new
- 'Fgtk_toolbar_set_show_arrow 'Fgtk_toolbar_set_style
- 'Fgtk_toolbar_unset_style 'Fgtk_tree_drag_dest_drag_data_received
- 'Fgtk_tree_drag_dest_row_drop_possible 'Fgtk_tree_drag_source_drag_data_delete
- 'Fgtk_tree_drag_source_drag_data_get 'Fgtk_tree_drag_source_row_draggable
- 'Fgtk_tree_get_row_drag_data 'Fgtk_tree_iter_copy 'Fgtk_tree_iter_free
- 'Fgtk_tree_model_filter_clear_cache 'Fgtk_tree_model_filter_convert_child_path_to_path
- 'Fgtk_tree_model_filter_convert_iter_to_child_iter
- 'Fgtk_tree_model_filter_convert_path_to_child_path
- 'Fgtk_tree_model_filter_get_model 'Fgtk_tree_model_filter_new
- 'Fgtk_tree_model_filter_refilter
- 'Fgtk_tree_model_filter_set_visible_column 'Fgtk_tree_model_foreach
- 'Fgtk_tree_model_get_column_type 'Fgtk_tree_model_get_flags
- 'Fgtk_tree_model_get_iter 'Fgtk_tree_model_get_iter_first
- 'Fgtk_tree_model_get_iter_from_string 'Fgtk_tree_model_get_n_columns
- 'Fgtk_tree_model_get_path 'Fgtk_tree_model_get_string_from_iter
- 'Fgtk_tree_model_iter_children 'Fgtk_tree_model_iter_has_child
- 'Fgtk_tree_model_iter_n_children 'Fgtk_tree_model_iter_next
- 'Fgtk_tree_model_iter_nth_child 'Fgtk_tree_model_iter_parent
- 'Fgtk_tree_model_ref_node 'Fgtk_tree_model_row_changed
- 'Fgtk_tree_model_row_deleted 'Fgtk_tree_model_row_has_child_toggled
- 'Fgtk_tree_model_row_inserted 'Fgtk_tree_model_rows_reordered
- 'Fgtk_tree_model_sort_clear_cache 'Fgtk_tree_model_sort_convert_child_iter_to_iter
- 'Fgtk_tree_model_sort_convert_child_path_to_path
- 'Fgtk_tree_model_sort_convert_iter_to_child_iter
- 'Fgtk_tree_model_sort_convert_path_to_child_path
- 'Fgtk_tree_model_sort_get_model 'Fgtk_tree_model_sort_iter_is_valid
- 'Fgtk_tree_model_sort_new_with_model 'Fgtk_tree_model_sort_reset_default_sort_func
- 'Fgtk_tree_model_unref_node 'Fgtk_tree_path_append_index
- 'Fgtk_tree_path_compare 'Fgtk_tree_path_copy 'Fgtk_tree_path_down
- 'Fgtk_tree_path_free 'Fgtk_tree_path_get_depth
- 'Fgtk_tree_path_get_indices 'Fgtk_tree_path_is_ancestor
- 'Fgtk_tree_path_is_descendant 'Fgtk_tree_path_new
- 'Fgtk_tree_path_new_first 'Fgtk_tree_path_new_from_string
- 'Fgtk_tree_path_next 'Fgtk_tree_path_prepend_index
- 'Fgtk_tree_path_prev 'Fgtk_tree_path_to_string 'Fgtk_tree_path_up
- 'Fgtk_tree_row_reference_deleted 'Fgtk_tree_row_reference_free
- 'Fgtk_tree_row_reference_get_path 'Fgtk_tree_row_reference_inserted
- 'Fgtk_tree_row_reference_new 'Fgtk_tree_row_reference_new_proxy
- 'Fgtk_tree_row_reference_reordered 'Fgtk_tree_row_reference_valid
- 'Fgtk_tree_selection_count_selected_rows 'Fgtk_tree_selection_get_mode
- 'Fgtk_tree_selection_get_selected 'Fgtk_tree_selection_get_selected_rows
- 'Fgtk_tree_selection_get_tree_view 'Fgtk_tree_selection_get_user_data
- 'Fgtk_tree_selection_iter_is_selected 'Fgtk_tree_selection_path_is_selected
- 'Fgtk_tree_selection_select_all 'Fgtk_tree_selection_select_iter
- 'Fgtk_tree_selection_select_path 'Fgtk_tree_selection_select_range
- 'Fgtk_tree_selection_selected_foreach 'Fgtk_tree_selection_set_mode
- 'Fgtk_tree_selection_set_select_function 'Fgtk_tree_selection_unselect_all
- 'Fgtk_tree_selection_unselect_iter 'Fgtk_tree_selection_unselect_path
- 'Fgtk_tree_set_row_drag_data 'Fgtk_tree_sortable_get_sort_column_id
- 'Fgtk_tree_sortable_has_default_sort_func 'Fgtk_tree_sortable_set_default_sort_func
- 'Fgtk_tree_sortable_set_sort_column_id 'Fgtk_tree_sortable_set_sort_func
- 'Fgtk_tree_sortable_sort_column_changed 'Fgtk_tree_store_append
- 'Fgtk_tree_store_clear 'Fgtk_tree_store_insert
- 'Fgtk_tree_store_insert_after 'Fgtk_tree_store_insert_before
- 'Fgtk_tree_store_is_ancestor 'Fgtk_tree_store_iter_depth
- 'Fgtk_tree_store_new 'Fgtk_tree_store_newv 'Fgtk_tree_store_prepend
- 'Fgtk_tree_store_remove 'Fgtk_tree_store_reorder
- 'Fgtk_tree_store_set 'Fgtk_tree_store_set_column_types
- 'Fgtk_tree_store_swap 'Fgtk_tree_view_append_column
- 'Fgtk_tree_view_collapse_all 'Fgtk_tree_view_collapse_row
- 'Fgtk_tree_view_column_add_attribute 'Fgtk_tree_view_column_cell_get_position
- 'Fgtk_tree_view_column_cell_get_size 'Fgtk_tree_view_column_cell_is_visible
- 'Fgtk_tree_view_column_cell_set_cell_data 'Fgtk_tree_view_column_clear
- 'Fgtk_tree_view_column_clear_attributes 'Fgtk_tree_view_column_clicked
- 'Fgtk_tree_view_column_get_alignment 'Fgtk_tree_view_column_get_clickable
- 'Fgtk_tree_view_column_get_expand 'Fgtk_tree_view_column_get_fixed_width
- 'Fgtk_tree_view_column_get_max_width 'Fgtk_tree_view_column_get_min_width
- 'Fgtk_tree_view_column_get_reorderable 'Fgtk_tree_view_column_get_resizable
- 'Fgtk_tree_view_column_get_sizing 'Fgtk_tree_view_column_get_sort_column_id
- 'Fgtk_tree_view_column_get_sort_indicator 'Fgtk_tree_view_column_get_sort_order
- 'Fgtk_tree_view_column_get_spacing 'Fgtk_tree_view_column_get_title
- 'Fgtk_tree_view_column_get_visible 'Fgtk_tree_view_column_get_widget
- 'Fgtk_tree_view_column_get_width 'Fgtk_tree_view_column_new
- 'Fgtk_tree_view_column_new_with_attributes 'Fgtk_tree_view_column_pack_end
- 'Fgtk_tree_view_column_pack_start 'Fgtk_tree_view_column_set_alignment
- 'Fgtk_tree_view_column_set_attributes 'Fgtk_tree_view_column_set_cell_data_func
- 'Fgtk_tree_view_column_set_clickable 'Fgtk_tree_view_column_set_expand
- 'Fgtk_tree_view_column_set_fixed_width 'Fgtk_tree_view_column_set_max_width
- 'Fgtk_tree_view_column_set_min_width 'Fgtk_tree_view_column_set_reorderable
- 'Fgtk_tree_view_column_set_resizable 'Fgtk_tree_view_column_set_sizing
- 'Fgtk_tree_view_column_set_sort_column_id 'Fgtk_tree_view_column_set_sort_indicator
- 'Fgtk_tree_view_column_set_sort_order
- 'Fgtk_tree_view_column_set_spacing 'Fgtk_tree_view_column_set_title
- 'Fgtk_tree_view_column_set_visible 'Fgtk_tree_view_column_set_widget
- 'Fgtk_tree_view_columns_autosize 'Fgtk_tree_view_enable_model_drag_dest
- 'Fgtk_tree_view_enable_model_drag_source 'Fgtk_tree_view_expand_all
- 'Fgtk_tree_view_expand_row 'Fgtk_tree_view_expand_to_path
- 'Fgtk_tree_view_get_background_area 'Fgtk_tree_view_get_bin_window
- 'Fgtk_tree_view_get_cell_area 'Fgtk_tree_view_get_column
- 'Fgtk_tree_view_get_columns 'Fgtk_tree_view_get_cursor
- 'Fgtk_tree_view_get_dest_row_at_pos 'Fgtk_tree_view_get_drag_dest_row
- 'Fgtk_tree_view_get_enable_search 'Fgtk_tree_view_get_expander_column
- 'Fgtk_tree_view_get_fixed_height_mode
- 'Fgtk_tree_view_get_headers_visible 'Fgtk_tree_view_get_hover_expand
- 'Fgtk_tree_view_get_hover_selection 'Fgtk_tree_view_get_model
- 'Fgtk_tree_view_get_path_at_pos 'Fgtk_tree_view_get_reorderable ) constant gtk-procs-2
-
- #( 'Fgtk_tree_view_get_rules_hint 'Fgtk_tree_view_get_search_column
- 'Fgtk_tree_view_get_search_equal_func 'Fgtk_tree_view_get_selection
- 'Fgtk_tree_view_get_visible_rect
- 'Fgtk_tree_view_insert_column 'Fgtk_tree_view_insert_column_with_attributes
- 'Fgtk_tree_view_insert_column_with_data_func 'Fgtk_tree_view_map_expanded_rows
- 'Fgtk_tree_view_move_column_after 'Fgtk_tree_view_new 'Fgtk_tree_view_new_with_model
- 'Fgtk_tree_view_remove_column 'Fgtk_tree_view_row_activated
- 'Fgtk_tree_view_row_expanded 'Fgtk_tree_view_scroll_to_cell
- 'Fgtk_tree_view_scroll_to_point 'Fgtk_tree_view_set_column_drag_function
- 'Fgtk_tree_view_set_cursor 'Fgtk_tree_view_set_drag_dest_row
- 'Fgtk_tree_view_set_enable_search 'Fgtk_tree_view_set_expander_column
- 'Fgtk_tree_view_set_fixed_height_mode
- 'Fgtk_tree_view_set_headers_clickable 'Fgtk_tree_view_set_headers_visible
- 'Fgtk_tree_view_set_hover_expand 'Fgtk_tree_view_set_hover_selection
- 'Fgtk_tree_view_set_model 'Fgtk_tree_view_set_reorderable
- 'Fgtk_tree_view_set_row_separator_func 'Fgtk_tree_view_set_rules_hint
- 'Fgtk_tree_view_set_search_column 'Fgtk_tree_view_set_search_equal_func
- 'Fgtk_tree_view_unset_rows_drag_dest
- 'Fgtk_tree_view_unset_rows_drag_source 'Fgtk_true 'Fgtk_ui_manager_add_ui
- 'Fgtk_ui_manager_add_ui_from_file 'Fgtk_ui_manager_add_ui_from_string
- 'Fgtk_ui_manager_ensure_update 'Fgtk_ui_manager_get_accel_group
- 'Fgtk_ui_manager_get_action 'Fgtk_ui_manager_get_action_groups
- 'Fgtk_ui_manager_get_add_tearoffs 'Fgtk_ui_manager_get_ui
- 'Fgtk_ui_manager_get_widget 'Fgtk_ui_manager_insert_action_group
- 'Fgtk_ui_manager_new 'Fgtk_ui_manager_new_merge_id
- 'Fgtk_ui_manager_remove_action_group 'Fgtk_ui_manager_remove_ui
- 'Fgtk_ui_manager_set_add_tearoffs 'Fgtk_vbox_new 'Fgtk_vbutton_box_new
- 'Fgtk_viewport_get_shadow_type
- 'Fgtk_viewport_new 'Fgtk_viewport_set_shadow_type 'Fgtk_vpaned_new
- 'Fgtk_vscale_new 'Fgtk_vscale_new_with_range 'Fgtk_vscrollbar_new
- 'Fgtk_vseparator_new 'Fgtk_widget_activate 'Fgtk_widget_add_accelerator
- 'Fgtk_widget_add_events 'Fgtk_widget_add_mnemonic_label
- 'Fgtk_widget_can_activate_accel 'Fgtk_widget_child_focus 'Fgtk_widget_child_notify
- 'Fgtk_widget_create_pango_context
- 'Fgtk_widget_create_pango_layout 'Fgtk_widget_destroy 'Fgtk_widget_destroyed
- 'Fgtk_widget_ensure_style 'Fgtk_widget_event 'Fgtk_widget_freeze_child_notify
- 'Fgtk_widget_get_accessible 'Fgtk_widget_get_ancestor
- 'Fgtk_widget_get_child_visible 'Fgtk_widget_get_clipboard
- 'Fgtk_widget_get_composite_name 'Fgtk_widget_get_default_direction
- 'Fgtk_widget_get_default_style 'Fgtk_widget_get_direction 'Fgtk_widget_get_display
- 'Fgtk_widget_get_events 'Fgtk_widget_get_modifier_style 'Fgtk_widget_get_name
- 'Fgtk_widget_get_no_show_all 'Fgtk_widget_get_pango_context 'Fgtk_widget_get_parent
- 'Fgtk_widget_get_parent_window 'Fgtk_widget_get_pointer 'Fgtk_widget_get_root_window
- 'Fgtk_widget_get_screen 'Fgtk_widget_get_size_request 'Fgtk_widget_get_style
- 'Fgtk_widget_get_toplevel 'Fgtk_widget_get_visual 'Fgtk_widget_grab_default
- 'Fgtk_widget_grab_focus 'Fgtk_widget_has_screen 'Fgtk_widget_hide
- 'Fgtk_widget_hide_all 'Fgtk_widget_hide_on_delete 'Fgtk_widget_intersect
- 'Fgtk_widget_is_ancestor 'Fgtk_widget_is_focus 'Fgtk_widget_list_accel_closures
- 'Fgtk_widget_list_mnemonic_labels 'Fgtk_widget_map 'Fgtk_widget_mnemonic_activate
- 'Fgtk_widget_modify_base 'Fgtk_widget_modify_bg 'Fgtk_widget_modify_fg
- 'Fgtk_widget_modify_font 'Fgtk_widget_modify_style 'Fgtk_widget_modify_text
- 'Fgtk_widget_pop_composite_child 'Fgtk_widget_push_composite_child
- 'Fgtk_widget_queue_draw 'Fgtk_widget_queue_draw_area 'Fgtk_widget_queue_resize
- 'Fgtk_widget_queue_resize_no_redraw 'Fgtk_widget_realize
- 'Fgtk_widget_remove_accelerator 'Fgtk_widget_remove_mnemonic_label
- 'Fgtk_widget_render_icon 'Fgtk_widget_reparent 'Fgtk_widget_reset_rc_styles
- 'Fgtk_widget_reset_shapes 'Fgtk_widget_send_expose 'Fgtk_widget_set_accel_path
- 'Fgtk_widget_set_app_paintable 'Fgtk_widget_set_child_visible
- 'Fgtk_widget_set_composite_name 'Fgtk_widget_set_default_direction
- 'Fgtk_widget_set_direction 'Fgtk_widget_set_double_buffered 'Fgtk_widget_set_events
- 'Fgtk_widget_set_name 'Fgtk_widget_set_no_show_all 'Fgtk_widget_set_parent
- 'Fgtk_widget_set_parent_window 'Fgtk_widget_set_redraw_on_allocate
- 'Fgtk_widget_set_sensitive
- 'Fgtk_widget_set_size_request 'Fgtk_widget_set_state 'Fgtk_widget_set_style
- 'Fgtk_widget_show 'Fgtk_widget_show_all 'Fgtk_widget_show_now
- 'Fgtk_widget_size_allocate 'Fgtk_widget_thaw_child_notify
- 'Fgtk_widget_translate_coordinates 'Fgtk_widget_unmap 'Fgtk_widget_unparent
- 'Fgtk_widget_unrealize 'Fgtk_window_activate_default 'Fgtk_window_activate_focus
- 'Fgtk_window_activate_key 'Fgtk_window_add_accel_group 'Fgtk_window_add_embedded_xid
- 'Fgtk_window_add_mnemonic 'Fgtk_window_begin_move_drag 'Fgtk_window_begin_resize_drag
- 'Fgtk_window_deiconify 'Fgtk_window_get_accept_focus 'Fgtk_window_get_decorated
- 'Fgtk_window_get_default_icon_list 'Fgtk_window_get_default_size
- 'Fgtk_window_get_destroy_with_parent 'Fgtk_window_get_focus
- 'Fgtk_window_get_focus_on_map 'Fgtk_window_get_frame_dimensions
- 'Fgtk_window_get_gravity 'Fgtk_window_get_has_frame 'Fgtk_window_get_icon
- 'Fgtk_window_get_icon_list 'Fgtk_window_get_icon_name
- 'Fgtk_window_get_mnemonic_modifier
- 'Fgtk_window_get_modal 'Fgtk_window_get_position 'Fgtk_window_get_resizable
- 'Fgtk_window_get_role 'Fgtk_window_get_size 'Fgtk_window_get_title
- 'Fgtk_window_get_transient_for 'Fgtk_window_has_toplevel_focus 'Fgtk_window_iconify
- 'Fgtk_window_is_active 'Fgtk_window_list_toplevels 'Fgtk_window_maximize
- 'Fgtk_window_mnemonic_activate 'Fgtk_window_move 'Fgtk_window_new
- 'Fgtk_window_parse_geometry 'Fgtk_window_present 'Fgtk_window_propagate_key_event
- 'Fgtk_window_remove_accel_group 'Fgtk_window_remove_embedded_xid
- 'Fgtk_window_remove_mnemonic 'Fgtk_window_reshow_with_initial_size
- 'Fgtk_window_resize 'Fgtk_window_set_accept_focus
- 'Fgtk_window_set_auto_startup_notification 'Fgtk_window_set_decorated
- 'Fgtk_window_set_default 'Fgtk_window_set_default_icon
- 'Fgtk_window_set_default_icon_list 'Fgtk_window_set_default_icon_name
- 'Fgtk_window_set_default_size 'Fgtk_window_set_destroy_with_parent
- 'Fgtk_window_set_focus 'Fgtk_window_set_focus_on_map
- 'Fgtk_window_set_frame_dimensions 'Fgtk_window_set_geometry_hints
- 'Fgtk_window_set_gravity 'Fgtk_window_set_has_frame 'Fgtk_window_set_icon
- 'Fgtk_window_set_icon_list 'Fgtk_window_set_icon_name 'Fgtk_window_set_keep_above
- 'Fgtk_window_set_keep_below 'Fgtk_window_set_mnemonic_modifier
- 'Fgtk_window_set_modal 'Fgtk_window_set_position 'Fgtk_window_set_resizable
- 'Fgtk_window_set_role 'Fgtk_window_set_title 'Fgtk_window_set_transient_for
- 'Fgtk_window_set_type_hint 'Fgtk_window_set_wmclass 'Fgtk_window_stick
- 'Fgtk_window_unmaximize 'Fgtk_window_unstick 'Fpango_attr_background_new
- 'Fpango_attr_fallback_new 'Fpango_attr_family_new 'Fpango_attr_font_desc_new
- 'Fpango_attr_foreground_new 'Fpango_attr_iterator_copy 'Fpango_attr_iterator_destroy
- 'Fpango_attr_iterator_get 'Fpango_attr_iterator_get_attrs
- 'Fpango_attr_iterator_get_font
- 'Fpango_attr_iterator_next 'Fpango_attr_iterator_range 'Fpango_attr_language_new
- 'Fpango_attr_letter_spacing_new 'Fpango_attr_list_change 'Fpango_attr_list_copy
- 'Fpango_attr_list_filter 'Fpango_attr_list_get_iterator 'Fpango_attr_list_insert
- 'Fpango_attr_list_insert_before 'Fpango_attr_list_new 'Fpango_attr_list_splice
- 'Fpango_attr_list_unref 'Fpango_attr_rise_new 'Fpango_attr_scale_new
- 'Fpango_attr_shape_new 'Fpango_attr_size_new 'Fpango_attr_stretch_new
- 'Fpango_attr_strikethrough_color_new 'Fpango_attr_strikethrough_new
- 'Fpango_attr_style_new 'Fpango_attr_type_register 'Fpango_attr_underline_color_new
- 'Fpango_attr_underline_new 'Fpango_attr_variant_new 'Fpango_attr_weight_new
- 'Fpango_attribute_copy 'Fpango_attribute_destroy 'Fpango_attribute_equal
- 'Fpango_break 'Fpango_color_copy 'Fpango_color_free 'Fpango_color_parse
- 'Fpango_context_get_base_dir 'Fpango_context_get_font_description
- 'Fpango_context_get_language 'Fpango_context_get_metrics
- 'Fpango_context_list_families 'Fpango_context_load_font 'Fpango_context_load_fontset
- 'Fpango_context_set_base_dir 'Fpango_context_set_font_description
- 'Fpango_context_set_language 'Fpango_coverage_copy 'Fpango_coverage_get
- 'Fpango_coverage_max 'Fpango_coverage_new 'Fpango_coverage_ref
- 'Fpango_coverage_set
- 'Fpango_coverage_to_bytes 'Fpango_coverage_unref 'Fpango_font_describe
- 'Fpango_font_description_better_match 'Fpango_font_description_copy
- 'Fpango_font_description_copy_static 'Fpango_font_description_equal
- 'Fpango_font_description_free 'Fpango_font_description_from_string
- 'Fpango_font_description_get_family 'Fpango_font_description_get_set_fields
- 'Fpango_font_description_get_size 'Fpango_font_description_get_stretch
- 'Fpango_font_description_get_style 'Fpango_font_description_get_variant
- 'Fpango_font_description_get_weight 'Fpango_font_description_hash
- 'Fpango_font_description_merge 'Fpango_font_description_merge_static
- 'Fpango_font_description_new 'Fpango_font_description_set_family
- 'Fpango_font_description_set_family_static 'Fpango_font_description_set_size
- 'Fpango_font_description_set_stretch 'Fpango_font_description_set_style
- 'Fpango_font_description_set_variant 'Fpango_font_description_set_weight
- 'Fpango_font_description_to_filename 'Fpango_font_description_to_string
- 'Fpango_font_description_unset_fields 'Fpango_font_descriptions_free
- 'Fpango_font_face_describe 'Fpango_font_face_get_face_name
- 'Fpango_font_face_list_sizes 'Fpango_font_family_get_name
- 'Fpango_font_family_is_monospace 'Fpango_font_family_list_faces
- 'Fpango_font_get_coverage 'Fpango_font_get_glyph_extents
- 'Fpango_font_get_metrics 'Fpango_font_map_list_families
- 'Fpango_font_map_load_font 'Fpango_font_map_load_fontset
- 'Fpango_font_metrics_get_approximate_char_width
- 'Fpango_font_metrics_get_approximate_digit_width
- 'Fpango_font_metrics_get_ascent 'Fpango_font_metrics_get_descent
- 'Fpango_font_metrics_get_strikethrough_position
- 'Fpango_font_metrics_get_strikethrough_thickness
- 'Fpango_font_metrics_get_underline_position
- 'Fpango_font_metrics_get_underline_thickness 'Fpango_font_metrics_ref
- 'Fpango_font_metrics_unref 'Fpango_get_log_attrs 'Fpango_glyph_string_copy
- 'Fpango_glyph_string_extents 'Fpango_glyph_string_extents_range
- 'Fpango_glyph_string_free 'Fpango_glyph_string_get_logical_widths
- 'Fpango_glyph_string_index_to_x 'Fpango_glyph_string_new
- 'Fpango_glyph_string_set_size 'Fpango_glyph_string_x_to_index
- 'Fpango_item_copy 'Fpango_item_free 'Fpango_item_new 'Fpango_item_split
- 'Fpango_itemize 'Fpango_language_matches 'Fpango_layout_context_changed
- 'Fpango_layout_copy 'Fpango_layout_get_alignment 'Fpango_layout_get_attributes
- 'Fpango_layout_get_auto_dir 'Fpango_layout_get_context 'Fpango_layout_get_cursor_pos
- 'Fpango_layout_get_extents 'Fpango_layout_get_indent 'Fpango_layout_get_iter
- 'Fpango_layout_get_justify 'Fpango_layout_get_line 'Fpango_layout_get_line_count
- 'Fpango_layout_get_lines 'Fpango_layout_get_log_attrs
- 'Fpango_layout_get_pixel_extents
- 'Fpango_layout_get_pixel_size 'Fpango_layout_get_single_paragraph_mode
- 'Fpango_layout_get_size 'Fpango_layout_get_spacing 'Fpango_layout_get_tabs
- 'Fpango_layout_get_text 'Fpango_layout_get_width 'Fpango_layout_get_wrap
- 'Fpango_layout_index_to_pos 'Fpango_layout_iter_at_last_line 'Fpango_layout_iter_free
- 'Fpango_layout_iter_get_baseline 'Fpango_layout_iter_get_char_extents
- 'Fpango_layout_iter_get_cluster_extents 'Fpango_layout_iter_get_index
- 'Fpango_layout_iter_get_layout_extents 'Fpango_layout_iter_get_line
- 'Fpango_layout_iter_get_line_extents 'Fpango_layout_iter_get_line_yrange
- 'Fpango_layout_iter_get_run 'Fpango_layout_iter_get_run_extents
- 'Fpango_layout_iter_next_char 'Fpango_layout_iter_next_cluster
- 'Fpango_layout_iter_next_line 'Fpango_layout_iter_next_run
- 'Fpango_layout_line_get_extents 'Fpango_layout_line_get_pixel_extents
- 'Fpango_layout_line_get_x_ranges 'Fpango_layout_line_index_to_x
- 'Fpango_layout_line_x_to_index 'Fpango_layout_move_cursor_visually
- 'Fpango_layout_new 'Fpango_layout_set_alignment 'Fpango_layout_set_attributes
- 'Fpango_layout_set_auto_dir 'Fpango_layout_set_font_description
- 'Fpango_layout_set_indent 'Fpango_layout_set_justify 'Fpango_layout_set_markup
- 'Fpango_layout_set_markup_with_accel 'Fpango_layout_set_single_paragraph_mode
- 'Fpango_layout_set_spacing 'Fpango_layout_set_tabs 'Fpango_layout_set_text
- 'Fpango_layout_set_width 'Fpango_layout_set_wrap 'Fpango_layout_xy_to_index
- 'Fpango_parse_markup 'Fpango_renderer_deactivate
- 'Fpango_renderer_draw_error_underline
- 'Fpango_script_iter_free 'Fpango_script_iter_get_range 'Fpango_script_iter_next
- 'FGDK_COLORMAP 'FGDK_IS_COLORMAP 'FG_OBJECT_TYPE 'Fgdk_colormap_alloc_color
- 'Fgdk_colormap_alloc_colors 'Fgdk_colormap_get_system 'Fgdk_colormap_get_visual
- 'Fgdk_colormap_new 'Fgdk_drawable_get_depth 'Fgdk_drawable_get_size
- 'Fgdk_drawable_get_visual 'Fgdk_drawable_set_colormap 'Fgdk_pixbuf_get_from_drawable
- 'Fgdk_pixbuf_render_pixmap_and_mask 'Fgdk_pixbuf_render_pixmap_and_mask_for_colormap
- 'Fgdk_pixbuf_render_threshold_alpha 'Fgdk_screen_get_default_colormap
- 'Fgdk_screen_get_system_colormap 'Fgdk_screen_set_default_colormap
- 'Fgdk_window_clear 'Fgdk_window_clear_area 'Fgdk_window_clear_area_e
- 'Fgdk_window_get_internal_paint_info 'Fgdk_window_set_back_pixmap
- 'Fgdk_window_set_icon
- 'Fgdk_window_shape_combine_mask 'Fgtk_binding_set_activate 'Fgtk_bindings_activate
- 'Fgtk_cell_renderer_render 'Fgtk_cell_view_get_size_of_row 'Fgtk_drag_set_icon_pixmap
- 'Fgtk_drag_source_set_icon 'Fgtk_requisition_copy 'Fgtk_requisition_free
- 'Fgtk_style_apply_default_background 'Fgtk_tree_view_create_row_drag_icon
- 'Fgtk_widget_get_child_requisition 'Fgtk_widget_get_colormap
- 'Fgtk_widget_get_default_colormap 'Fgtk_widget_get_default_visual
- 'Fgtk_widget_pop_colormap 'Fgtk_widget_push_colormap 'Fgtk_widget_set_colormap
- 'Fgtk_widget_set_default_colormap 'Fgtk_widget_shape_combine_mask
- 'Fgtk_widget_size_request 'Fgdk_drawable_get_colormap
- 'Fpango_shape
- \ FIXME
- \ missing functions
- 'FGTK_COMBO_BOX_ENTRY
- 'FGTK_IS_COMBO_BOX_ENTRY
- 'Fgtk_accel_map_load_scanner
- 'Fgtk_accelerator_get_default_mod_mask
- 'Fgtk_combo_box_append_text
- 'Fgtk_combo_box_entry_get_text_column
- 'Fgtk_combo_box_entry_new
- 'Fgtk_combo_box_entry_new_text
- 'Fgtk_combo_box_entry_new_with_model
- 'Fgtk_combo_box_entry_set_text_column
- 'Fgtk_combo_box_get_active_text
- 'Fgtk_combo_box_insert_text
- 'Fgtk_combo_box_new_text
- 'Fgtk_combo_box_prepend_text
- 'Fgtk_combo_box_remove_text
- 'Fgtk_init_add
- 'Fgtk_paint_expander ( special )
- 'Fgtk_quit_add
- 'Fgtk_quit_add_destroy
- 'Fgtk_quit_remove
- 'Fgtk_quit_remove_by_data
- 'Fgtk_statusbar_get_has_resize_grip
- 'Fgtk_statusbar_set_has_resize_grip
- \ FIXME
- \ new missing functions from Wed Oct 27 22:08:17 CEST 2010
- 'Fgtk_layout_get_hadjustment
- 'Fgtk_layout_get_vadjustment
- 'Fgtk_layout_put
- 'Fgtk_layout_set_hadjustment
- 'Fgtk_layout_set_vadjustment
- 'Fgtk_tree_view_get_hadjustment
- 'Fgtk_tree_view_get_vadjustment
- 'Fgtk_tree_view_set_hadjustment
- 'Fgtk_tree_view_set_vadjustment
- 'Fgtk_viewport_get_hadjustment
- 'Fgtk_viewport_get_vadjustment
- 'Fgtk_viewport_set_hadjustment
- 'Fgtk_viewport_set_vadjustment
- 'Fgtk_widget_set_scroll_adjustments
- \ FIXME
- \ new missing functions from Mon Dec 6 14:16:32 CET 2010
- 'FGTK_HPANED
- 'FGTK_HRULER
- 'FGTK_IS_HRULER
- 'FGTK_IS_RULER
- 'FGTK_IS_VRULER
- 'FGTK_RULER
- 'FGTK_VRULER
- 'Fgtk_hruler_new
- 'Fgtk_ruler_get_metric
- 'Fgtk_ruler_get_range
- 'Fgtk_ruler_set_metric
- 'Fgtk_ruler_set_range
- 'Fgtk_vruler_new
- 'Fgtk_ruler_draw_pos
- 'Fgtk_ruler_draw_ticks
- \ FIXME
- \ new missing functions from Sun Dec 11 00:38:19 CET 2010
- 'Fgtk_border_copy
- 'Fgtk_border_free
- 'Fgtk_widget_class_path
- 'Fgtk_widget_path
- 'Fgtk_paint_arrow
- 'Fgtk_paint_box
- 'Fgtk_paint_box_gap
- 'Fgtk_paint_check
- 'Fgtk_paint_diamond
- 'Fgtk_paint_extension
- 'Fgtk_paint_flat_box
- 'Fgtk_paint_focus
- 'Fgtk_paint_handle
- 'Fgtk_paint_hline
- 'Fgtk_paint_layout
- 'Fgtk_paint_option
- 'Fgtk_paint_resize_grip
- 'Fgtk_paint_shadow
- 'Fgtk_paint_shadow_gap
- 'Fgtk_paint_slider
- 'Fgtk_paint_tab
- 'Fgtk_paint_vline ) constant gtk-procs-3
-
- : 26-gtk ( -- )
- nil { sym }
- #() { undefined }
- breakable-gtk-procs gtk-procs-1 array-append { names }
- names gtk-procs-2 array-append to names
- names gtk-procs-3 array-append each to sym
- sym symbol-defined? unless
- undefined sym array-push to undefined
- then
- end-each
- undefined empty? unless
- $" Gtk undefined[%d]: %s" #( undefined dup length swap ) snd-display
- then
- ;
-[else]
- <'> noop alias 26-gtk
-[then]
-
\ ---------------- test 27: general ----------------
*with-test-complex* [if]
: complex-test ( -- )
\ edot-product (test008)
0.0 vct( 1.0 ) edot-product dup 1.0 fneq if
- $" edot 1.0: %s?" swap snd-display
+ "edot 1.0: %s?" swap snd-display
else
drop
then
0.0 vct( 0.0 ) edot-product dup 0.0 fneq if
- $" edot 0.0: %s?" swap snd-display
+ "edot 0.0: %s?" swap snd-display
else
drop
then
0.0 #( 1.0 ) edot-product dup 1.0 fneq if
- $" edot 1.0: %s?" swap snd-display
+ "edot 1.0: %s?" swap snd-display
else
drop
then
0.0 #( 0+1i ) edot-product dup 0+1i cneq if
- $" edot i: %s?" swap snd-display
+ "edot i: %s?" swap snd-display
else
drop
then
@@ -6740,7 +5559,7 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
0.25 two-pi f* fexp f+
0.50 two-pi f* fexp f+
0.75 two-pi f* fexp f+ over over fneq if
- 2 >array $" edot 4: %s %s?" swap snd-display
+ 2 >array "edot 4: %s %s?" swap snd-display
else
2drop
then
@@ -6749,7 +5568,7 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
0.25 two-pi f* 0-1i c* cexp 2 c* c+
0.50 two-pi f* 0-1i c* cexp 3 c* c+
0.75 two-pi f* 0-1i c* cexp 4 c* c+ over over cneq if
- 2 >array $" edot 4 -i: %s %s?" swap snd-display
+ 2 >array "edot 4 -i: %s %s?" swap snd-display
else
2drop
then
@@ -6758,7 +5577,7 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
0.25 two-pi f* 0-1i c* cexp 2+1i c* c+
0.50 two-pi f* 0-1i c* cexp 3+1i c* c+
0.75 two-pi f* 0-1i c* cexp 4+1i c* c+ over over cneq if
- 2 >array $" edot 4 -i * i: %s %s?" swap snd-display
+ 2 >array "edot 4 -i * i: %s %s?" swap snd-display
else
2drop
then
@@ -6769,10 +5588,16 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: print-and-check ( gen name desc -- )
{ gen name desc }
- gen mus-name name string<> if $" mus-name %s: %s?" #( name gen mus-name ) snd-display then
- gen mus-describe desc string<> if $" mus-describe %s: %s?" #( name gen ) snd-display then
+ gen mus-name name string<> if
+ "mus-name %s: %s?" #( name gen mus-name ) snd-display
+ then
+ gen mus-describe desc string<> if
+ "mus-describe %s: %s?" #( name gen ) snd-display
+ then
gen { egen }
- gen egen object-equal? unless $" equal? %s: %s %s?" #( name gen egen ) snd-display then
+ gen egen object-equal? unless
+ "equal? %s: %s %s?" #( name gen egen ) snd-display
+ then
;
: test-gen-equal ( g0 g1 g2 -- )
@@ -6780,17 +5605,27 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
\ g0 g1 =
\ g0 g2 <> at start
g0 { g3 }
- 2 make-frame { gad }
- g0 g3 object-equal? unless $" let %s: %s equal? %s?" #( g0 mus-name g0 g3 ) snd-display then
- g0 g1 object-equal? unless $" %s: %s equal? %s?" #( g0 mus-name g0 g1 ) snd-display then
- g0 g2 object-equal? if $" %s: %s equal? %s?" #( g0 mus-name g0 g2 ) snd-display then
- g0 gad object-equal? if $" %s/frame: %s equal? %s?" #( g0 mus-name g0 gad ) snd-display then
+ g0 g3 object-equal? unless
+ "let %s: %s equal? %s?" #( g0 mus-name g0 g3 ) snd-display
+ then
+ g0 g1 object-equal? unless
+ "%s: %s equal? %s?" #( g0 mus-name g0 g1 ) snd-display
+ then
+ g0 g2 object-equal? if
+ "%s: %s equal? %s?" #( g0 mus-name g0 g2 ) snd-display
+ then
g0 0.0 0.0 mus-apply drop
g3 #( 0.0 0.0 ) object-apply drop
g3 0.0 0.0 mus-apply drop
- g0 g3 object-equal? unless $" run let %s: %s equal? %s?" #( g0 mus-name g0 g3 ) snd-display then
- g0 g1 object-equal? if $" run %s: %s equal? %s?" #( g0 mus-name g0 g1 ) snd-display then
- g0 g2 object-equal? if $" run %s: %s equal? %s?" #( g0 mus-name g0 g2 ) snd-display then
+ g0 g3 object-equal? unless
+ "run let %s: %s equal? %s?" #( g0 mus-name g0 g3 ) snd-display
+ then
+ g0 g1 object-equal? if
+ "run %s: %s equal? %s?" #( g0 mus-name g0 g1 ) snd-display
+ then
+ g0 g2 object-equal? if
+ "run %s: %s equal? %s?" #( g0 mus-name g0 g2 ) snd-display
+ then
;
\ bind-key proc
@@ -6805,104 +5640,141 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
: my-local-thunk <{ -- }>
open-hook object-length 3 <> if
- $" add-hook! local length: %d?" #( open-hook object-length ) snd-display
+ "add-hook! local length: %d?" #( open-hook object-length ) snd-display
then
- open-hook $" my-test3-proc" hook-member? unless
- $" local3 add-hook!: %s" #( open-hook ) snd-display
+ open-hook "my-test3-proc" hook-member? unless
+ "local3 add-hook!: %s" #( open-hook ) snd-display
then
- open-hook $" my-test4-proc" hook-member? unless
- $" local4 add-hook!: %s" #( open-hook ) snd-display
+ open-hook "my-test4-proc" hook-member? unless
+ "local4 add-hook!: %s" #( open-hook ) snd-display
then
- open-hook $" my-test5-proc" hook-member? unless
- $" local5 add-hook!: %s" #( open-hook ) snd-display
+ open-hook "my-test5-proc" hook-member? unless
+ "local5 add-hook!: %s" #( open-hook ) snd-display
then
;
: 27-sel-from-snd ( -- )
+ \ play etc (from test 5)
+ "oboe.snd" open-sound { ind }
+ ind x-bounds { bnds }
+ x-position-slider { xp }
+ y-position-slider { yp }
+ x-zoom-slider { xz }
+ y-zoom-slider { yz }
+ " open-so" snd-completion " open-sound" "completion (1)" #() snd-test-neq
+ " zoom-focus-r" snd-completion " zoom-focus-right" "completion (2)"
+ #() snd-test-neq
+ "oboe.snd" :wait #t play drop
+ "oboe.snd" :start 12000 :wait #t play drop
+ "oboe.snd" :start 1200 :end 15000 :wait #t play drop
+ ind :edit-position #f #f edit-position 1- :wait #t play drop
+ ind close-sound drop
\ hooks
open-hook reset-hook!
open-hook <'> my-test1-proc add-hook!
open-hook <'> my-test2-proc add-hook!
open-hook object-length 2 <> if
- $" add-hook! global length: %d?" #( open-hook object-length ) snd-display
+ "add-hook! global length: %d?" #( open-hook object-length ) snd-display
then
open-hook "my-test1-proc" hook-member? unless
- $" global1 add-hook!: %s" #( open-hook ) snd-display
+ "global1 add-hook!: %s" #( open-hook ) snd-display
then
open-hook <'> my-test2-proc hook-member? unless
- $" global2 add-hook!: %s" #( open-hook ) snd-display
+ "global2 add-hook!: %s" #( open-hook ) snd-display
then
open-hook
#( <'> my-test3-proc
<'> my-test4-proc
<'> my-test5-proc ) <'> my-local-thunk with-local-hook
open-hook object-length 2 <> if
- $" add-hook! reset length: %d?" #( open-hook object-length ) snd-display
+ "add-hook! reset length: %d?" #( open-hook object-length ) snd-display
then
open-hook <'> my-test1-proc hook-member? unless
- $" reset1 add-hook!: %s" #( open-hook ) snd-display
+ "reset1 add-hook!: %s" #( open-hook ) snd-display
then
open-hook "my-test2-proc" hook-member? unless
- $" reset2 add-hook!: %s" #( open-hook ) snd-display
+ "reset2 add-hook!: %s" #( open-hook ) snd-display
then
\ bind-key
<'> C-xC-c { prc }
"c" 4 #t key-binding { old-prc }
"c" 4 prc #t bind-key { prc1 }
"c" 4 #t key-binding { prc2 }
- prc prc1 = unless $" bind-key: %s %s?" #( prc prc1 ) snd-display then
- prc prc2 = unless $" key-binding: %s %s?" #( prc prc2 ) snd-display then
+ prc prc1 <> if
+ "bind-key: %s %s?" #( prc prc1 ) snd-display
+ then
+ prc prc2 <> if
+ "key-binding: %s %s?" #( prc prc2 ) snd-display
+ then
old-prc proc? if
"c" 4 old-prc #t bind-key drop
else
"c" 4 #t unbind-key drop
then
+ "fmv.snd" 1 22050 mus-bshort mus-next "set-samples test" 100 new-sound to ind
\ new-sound
- "fmv.snd" mus-next mus-bshort 22050 1 $" set-samples test" 100 new-sound { ind }
10 3 3 0.1 make-vct set-samples drop
0 20 ind 0 channel->vct { res }
res vct( 0 0 0 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 ) vequal? unless
- $" 1 set samples 0 for 0.1: %s?" #( res ) snd-display
+ "1 set samples 0 for 0.1: %s?" #( res ) snd-display
then
ind close-sound drop
\ x-axis-label (test005)
- *with-test-nogui* unless
+ *with-test-gui* if
"oboe.snd" open-sound to ind
#t set-transform-graph? drop
#t set-time-graph? drop
x-axis-label to res
- res "time" string<> if $" get time x-axis-label: %s?" #( res ) snd-display then
+ res "time" string<> if
+ "get time x-axis-label: %s?" #( res ) snd-display
+ then
"hiho1" ind 0 time-graph set-x-axis-label drop
x-axis-label to res
- res "hiho1" string<> if $" set time x-axis-label: %s?" #( res ) snd-display then
+ res "hiho1" string<> if
+ "set time x-axis-label: %s?" #( res ) snd-display
+ then
update-transform-graph drop
ind 0 transform-graph x-axis-label to res
- res "frequency" string<> if $" get fft x-axis-label: %s?" #( res ) snd-display then
+ res "frequency" string<> if
+ "get fft x-axis-label: %s?" #( res ) snd-display
+ then
"hiho2" ind 0 transform-graph set-x-axis-label drop
update-transform-graph drop
ind 0 transform-graph x-axis-label to res
- res "hiho2" string<> if $" set fft x-axis-label: %s?" #( res ) snd-display then
+ res "hiho2" string<> if
+ "set fft x-axis-label: %s?" #( res ) snd-display
+ then
"frequency" ind 0 transform-graph set-x-axis-label drop
'( 0 0 1 1 2 0 ) "lisp" graph drop
update-lisp-graph drop
ind 0 lisp-graph x-axis-label to res
- res "lisp" string<> if $" get lisp x-axis-label: %s?" #( res ) snd-display then
+ res "lisp" string<> if
+ "get lisp x-axis-label: %s?" #( res ) snd-display
+ then
"hiho3" ind 0 lisp-graph set-x-axis-label drop
ind 0 lisp-graph x-axis-label to res
- res "hiho3" string<> if $" set lisp x-axis-label: %s?" #( res ) snd-display then
+ res "hiho3" string<> if
+ "set lisp x-axis-label: %s?" #( res ) snd-display
+ then
"hiho4" ind 0 time-graph set-y-axis-label drop
y-axis-label to res
- res "hiho4" string<> if $" set time y-axis-label: %s?" #( res ) snd-display then
+ res "hiho4" string<> if
+ "set time y-axis-label: %s?" #( res ) snd-display
+ then
"hiho5" ind 0 lisp-graph set-y-axis-label drop
ind 0 lisp-graph y-axis-label to res
- res "hiho5" string<> if $" set lisp y-axis-label: %s?" #( res ) snd-display then
+ res "hiho5" string<> if
+ "set lisp y-axis-label: %s?" #( res ) snd-display
+ then
#f set-y-axis-label drop
"hiho6" ind 0 set-y-axis-label drop
ind 0 y-axis-label to res
- res "hiho6" string<> if $" set time y-axis-label (time): %s?" #( res ) snd-display then
+ res "hiho6" string<> if
+ "set time y-axis-label (time): %s?" #( res ) snd-display
+ then
#f set-y-axis-label drop
ind close-sound drop
- then
+ then \ *with-test-gui*
\ edot-product (test008)
complex-test
\ delay (test008)
@@ -6910,44 +5782,57 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
3 make-delay { gen2 }
4 :initial-contents #( 1.0 0.5 0.25 0.0 ) make-delay { gen1 }
4 :initial-contents vct( 1.0 0.5 0.25 0.0 ) make-delay { gen3 }
- gen "delay" $" delay line[3, step]: [0.000 0.000 0.000]" print-and-check
- 10 0.0 make-vct map gen i 0.0 delay end-map { v0 }
- 10 0.0 make-vct map gen2 delay? if gen2 i 0.0 delay else -1.0 then end-map { v1 }
- v0 v1 vequal? unless $" map delay: %s %s?" #( v0 v1 ) snd-display then
- gen delay? unless $" %s not a delay?" #( gen ) snd-display then
- gen mus-length 3 <> if $" delay length: %d?" #( gen mus-length ) snd-display then
+ gen "delay" "delay line[3, step]: [0 0 0]" print-and-check
+ 10 0.0 make-vct map
+ gen i 0.0 delay
+ end-map { v0 }
+ 10 0.0 make-vct map
+ gen2 delay? if
+ gen2 i 0.0 delay
+ else
+ -1.0
+ then
+ end-map { v1 }
+ v0 v1 vequal? unless
+ "map delay: %s %s?" #( v0 v1 ) snd-display
+ then
+ gen delay? unless
+ "%s not a delay?" #( gen ) snd-display
+ then
+ gen mus-length 3 <> if
+ "delay length: %d?" #( gen mus-length ) snd-display
+ then
v0 1 vct-ref 0.0 fneq
v0 4 vct-ref 1.0 fneq ||
- v0 8 vct-ref 5.0 fneq || if $" delay output: %s?" #( v0 ) snd-display then
+ v0 8 vct-ref 5.0 fneq || if
+ "delay output: %s?" #( v0 ) snd-display
+ then
gen1 0.0 0.0 delay 1.0 fneq
gen1 0.0 0.0 delay 0.5 fneq ||
gen1 0.0 0.0 delay 0.25 fneq ||
gen1 0.0 0.0 delay 0.0 fneq ||
gen1 0.0 0.0 delay 0.0 fneq || if
- $" delay with list initial-contents confused" #f snd-display
+ "delay with list initial-contents confused" #f snd-display
then
gen3 0.0 0.0 delay 1.0 fneq
gen3 0.0 0.0 delay 0.5 fneq ||
gen3 0.0 0.0 delay 0.25 fneq ||
gen3 0.0 0.0 delay 0.0 fneq ||
gen3 0.0 0.0 delay 0.0 fneq || if
- $" delay with vct initial-contents confused" #f snd-display
+ "delay with vct initial-contents confused" #f snd-display
then
- :size #f <'> make-delay #t nil fth-catch to res
- stack-reset
+ :size #f <'> make-delay snd-test-catch to res
res 0 array-ref 'wrong-type-arg object-equal? unless
- $" make-delay bad size false: %s" #( res ) snd-display
+ "make-delay bad size false: %s" #( res ) snd-display
then
make-oscil { osc }
- 3 :initial-element osc <'> make-delay #t nil fth-catch to res
- stack-reset
+ 3 :initial-element osc <'> make-delay snd-test-catch to res
res 0 array-ref 'wrong-type-arg object-equal? unless
- $" make-delay bad initial element: %s" #( res ) snd-display
+ "make-delay bad initial element: %s" #( res ) snd-display
then
- -3 <'> make-delay #t nil fth-catch to res
- stack-reset
+ -3 <'> make-delay snd-test-catch to res
res 0 array-ref 'out-of-range object-equal? unless
- $" make-delay bad size: %s" #( res ) snd-display
+ "make-delay bad size: %s" #( res ) snd-display
then
3 make-delay { d1 }
3 make-delay { d2 }
@@ -6965,312 +5850,371 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
3 :initial-contents #( 1.0 1.0 1.0 ) make-delay to d3
d1 d2 d3 test-gen-equal
\ mix (test009)
- "hiho.wave" mus-next mus-bshort 22050 1 new-sound { new-index }
- new-index select-sound drop
- 0 new-index 0 find-mix to res
- res if $" found non-existent mix: %s?" #( res ) snd-display then
- "pistol.snd" 100 mix car { mix-id }
- mix-id mix? unless $" %s not mix?" #( mix-id ) snd-display then
- view-mixes-dialog drop
- mix-id mix-position { pos }
- mix-id mix-length { len }
- mix-id mix-speed { spd }
- mix-id mix-home { home-lst }
- home-lst 0 array-ref { snd }
- home-lst 1 array-ref { chn }
- mix-id mix-amp { amp }
- mix-id make-mix-sampler { mr }
- mr mix-sampler? unless $" %s is not mix-sampler?" #( mr ) snd-display then
- mr region-sampler? if $" mix-sampler: region %s?" #( mr ) snd-display then
- mr sampler-position to res
- res 0<> if $" mix sampler-position: %d?" #( res ) snd-display then
- mr sampler-at-end? if $" mix sampler-at-end: %s?" #( mr ) snd-display then
- mr sampler-home to res
- mix-id res object-equal? unless $" mix sampler-home: %d %s?" #( res mr ) snd-display then
- mr object->string 0 16 string-substring to res
- res $" #<mix-sampler mi" string<> if
- $" mix sampler actually got: [%s]?" #( res ) snd-display
- then
- 1234 integer->mix <'> mix-amp #t nil fth-catch to res
- stack-reset
- res 0 array-ref 'no-such-mix object-equal? unless
- $" mix-amp bad id: %s" #( res ) snd-display
- then
- 1234 integer->mix 0.1 <'> set-mix-amp #t nil fth-catch to res
- stack-reset
- res 0 array-ref 'no-such-mix object-equal? unless
- $" set-mix-amp bad id: %s" #( res ) snd-display
- then
- 1234 integer->mix #( 0 0 1 1 ) <'> set-mix-amp-env #t nil fth-catch to res
- stack-reset
- res 0 array-ref 'no-such-mix object-equal? unless
- $" set-mix-amp-env bad id: %s" #( res ) snd-display
- then
- 0.0 0.0 { mx sx }
- 99 0 do
- i odd? if mr read-mix-sample else mr read-mix-sample then to mx
- 100 i + sample to sx
- mx sx fneq if $" read-mix-sample: %s %s?" #( mx sx ) snd-display then
- loop
- \ Scheme: (mr)
- \ Ruby: mr.call
- \ Forth: mr #() apply
- mr #() object-apply to mx
- 199 sample to sx
- mx sx fneq if $" read-mix-sample 100: %s %s?" #( mx sx ) snd-display then
- mr free-sampler drop
- \
- 100 pos <> if $" mix-position: %d?" #( pos ) snd-display then
- 41623 len <> if $" mix-length: %d?" #( len ) snd-display then
- snd new-index object-equal? unless $" snd mix-home: %s?" #( snd ) snd-display then
- chn 0<> if $" chn mix-home: %d?" #( chn ) snd-display then
- amp 1.0 fneq if $" mix-amp: %s?" #( amp ) snd-display then
- spd 1.0 fneq if $" mix-speed: %s?" #( spd ) snd-display then
- .stack
- mix-id <'> play #t nil fth-catch if
- drop \ on stack: mix-id
- $" cannot play mix" #() snd-display
- else
- drop \ on stack: play's return value
- then
- mix-id :start 1000 <'> play #t nil fth-catch if
- stack-reset \ on stack: mix-id :start 1000
- $" cannot play mix from 1000" #() snd-display
- else
- drop \ on stack: play's return value
- then
- .stack
- \
- mix-id 200 set-mix-position drop
- mix-id 0.5 set-mix-amp drop
- mix-id 2.0 set-mix-speed drop
- mix-id #( 0 0 1 1 ) set-mix-amp-env drop
- mix-id mix-amp-env to res
- mix-id res set-mix-amp-env drop
- mix-id mix-amp-env { res1 }
- res res1 vequal? unless $" set-mix-amp-env to self: %s %s?" #( res res1 ) snd-display then
- mix-id 20 set-mix-tag-y drop
- mix-id mix-position to pos
- mix-id mix-speed to spd
- mix-id mix-amp to amp
- mix-id mix-tag-y { my }
- 200 pos <> if $" set-mix-position: %d?" #( pos ) snd-display then
- spd 2.0 fneq if $" set-mix-speed: %s?" #( spd ) snd-display then
- my 20 <> if $" set-mix-tag-y: %d?" #( my ) snd-display then
- amp 0.5 fneq if $" set-mix-amp: %s?" #( amp ) snd-display then
- mix-id mix-amp-env to res
- res #( 0.0 0.0 1.0 1.0 ) array= unless $" set-mix-amp-env: %s?" #( res ) snd-display then
- \
- 3 0.1 make-vct 100 #f #f #t "" mix-vct drop
- 0 set-cursor drop
- 100 #f #f find-mix { nid }
- nid mix? false? unless
- nid mix-position 100 <> if
- new-index 0 mixes map *key* mix-position end-map { mx-pos }
- $" 100 find-mix: %s %s %s?" #( nid dup mix-position mx-pos ) snd-display
+ *with-test-gtk* unless
+ \ FIXME: set-mix-amp-env (gtk segfault)
+ \ crashes in set-mix-amp-env with gtk
+ "hiho.wave" 1 22050 mus-bshort mus-next new-sound { new-index }
+ new-index select-sound drop
+ 0 new-index 0 find-mix to res
+ res if
+ "found non-existent mix: %s?" #( res ) snd-display
then
- else
- $" 100 find-mix: not a mix %s?" #( nid ) snd-display
- then
- 200 #f #f find-mix to nid
- nid mix? false? unless
- nid mix-position 200 <> if
- new-index 0 mixes map *key* mix-position end-map { mx-pos }
- $" 200 find-mix: %s %s %s?" #( nid dup mix-position mx-pos ) snd-display
+ "pistol.snd" 100 mix car { mix-id }
+ mix-id mix? unless
+ "%s not mix?" #( mix-id ) snd-display
then
- else
- $" 200 find-mix: not a mix %s?" #( nid ) snd-display
- then
- \
- "oboe.snd" 100 mix car to mix-id
- 40 set-mix-waveform-height drop
- 'hiho mix-id 123 set-mix-property
- 'hiho mix-id mix-property to res
- res 123 <> if $" mix-property: %s?" #( res ) snd-display then
- 'not-here mix-id mix-property to res
- res if $" mix-property not-here: %s?" #( res ) snd-display then
- #f #f update-time-graph drop
- 20 set-mix-waveform-height drop
- new-index revert-sound drop
- new-index close-sound drop
+ view-mixes-dialog drop
+ mix-id mix-position { pos }
+ mix-id mix-length { len }
+ mix-id mix-speed { spd }
+ mix-id mix-home { home-lst }
+ home-lst 0 array-ref { snd }
+ home-lst 1 array-ref { chn }
+ mix-id mix-amp { amp }
+ mix-id make-mix-sampler { mr }
+ mr mix-sampler? unless
+ "%s is not mix-sampler?" #( mr ) snd-display
+ then
+ mr region-sampler? if
+ "mix-sampler: region %s?" #( mr ) snd-display
+ then
+ mr sampler-position to res
+ res 0<> if
+ "mix sampler-position: %d?" #( res ) snd-display
+ then
+ mr sampler-at-end? if
+ "mix sampler-at-end: %s?" #( mr ) snd-display
+ then
+ mr sampler-home to res
+ mix-id res object-equal? unless
+ "mix sampler-home: %d %s?" #( res mr ) snd-display
+ then
+ mr object->string 0 16 string-substring to res
+ res "#<mix-sampler mi" string<> if
+ "mix sampler actually got: [%s]?" #( res ) snd-display
+ then
+ 1234 integer->mix <'> mix-amp snd-test-catch to res
+ res 0 array-ref 'no-such-mix object-equal? unless
+ "mix-amp bad id: %s" #( res ) snd-display
+ then
+ 1234 integer->mix 0.1 <'> set-mix-amp snd-test-catch to res
+ res 0 array-ref 'no-such-mix object-equal? unless
+ "set-mix-amp bad id: %s" #( res ) snd-display
+ then
+ 1234 integer->mix #( 0 0 1 1 ) <'> set-mix-amp-env snd-test-catch to res
+ res 0 array-ref 'no-such-mix object-equal? unless
+ "set-mix-amp-env bad id: %s" #( res ) snd-display
+ then
+ 0.0 0.0 { mx sx }
+ 99 0 do
+ \ XXX: i odd? if mr read-mix-sample else mr read-mix-sample then to mx
+ mr read-mix-sample to mx
+ 100 i + sample to sx
+ mx sx fneq if
+ "read-mix-sample: %s %s?" #( mx sx ) snd-display
+ then
+ loop
+ \ Scheme: (mr)
+ \ Ruby: mr.call
+ \ Forth: mr #() apply
+ mr #() object-apply to mx
+ 199 sample to sx
+ mx sx fneq if
+ "read-mix-sample 100: %s %s?" #( mx sx ) snd-display
+ then
+ mr free-sampler drop
+ \
+ 100 pos <> if
+ "mix-position: %d?" #( pos ) snd-display
+ then
+ 41623 len <> if
+ "mix-length: %d?" #( len ) snd-display
+ then
+ snd new-index object-equal? unless
+ "snd mix-home: %s?" #( snd ) snd-display
+ then
+ chn 0<> if
+ "chn mix-home: %d?" #( chn ) snd-display
+ then
+ amp 1.0 fneq if
+ "mix-amp: %s?" #( amp ) snd-display
+ then
+ spd 1.0 fneq if
+ "mix-speed: %s?" #( spd ) snd-display
+ then
+ .stack
+ mix-id <'> play #t nil fth-catch if
+ drop \ on stack: mix-id
+ "cannot play mix" #() snd-display
+ else
+ drop \ on stack: play's return value
+ then
+ stack-reset
+ mix-id :start 1000 <'> play #t nil fth-catch if
+ stack-reset \ on stack: mix-id :start 1000
+ "cannot play mix from 1000" #() snd-display
+ else
+ drop \ on stack: play's return value
+ stack-reset
+ then
+ .stack
+ \
+ mix-id 200 set-mix-position drop
+ mix-id 0.5 set-mix-amp drop
+ mix-id 2.0 set-mix-speed drop
+ mix-id #( 0 0 1 1 ) set-mix-amp-env drop
+ mix-id mix-amp-env to res
+ mix-id res set-mix-amp-env drop
+ mix-id mix-amp-env { res1 }
+ res res1 vequal? unless
+ "set-mix-amp-env to self: %s %s?" #( res res1 ) snd-display
+ then
+ mix-id 20 set-mix-tag-y drop
+ mix-id mix-position to pos
+ mix-id mix-speed to spd
+ mix-id mix-amp to amp
+ mix-id mix-tag-y { my }
+ 200 pos <> if
+ "set-mix-position: %d?" #( pos ) snd-display
+ then
+ spd 2.0 fneq if
+ "set-mix-speed: %s?" #( spd ) snd-display
+ then
+ my 20 <> if
+ "set-mix-tag-y: %d?" #( my ) snd-display
+ then
+ amp 0.5 fneq if
+ "set-mix-amp: %s?" #( amp ) snd-display
+ then
+ mix-id mix-amp-env to res
+ res #( 0.0 0.0 1.0 1.0 ) array= unless
+ "set-mix-amp-env: %s?" #( res ) snd-display
+ then
+ \
+ 3 0.1 make-vct 100 #f #f #t "" mix-vct drop
+ 0 set-cursor drop
+ 100 #f #f find-mix { nid }
+ nid mix? false? unless
+ nid mix-position 100 <> if
+ new-index 0 mixes map
+ *key* mix-position
+ end-map { mx-pos }
+ "100 find-mix: %s %s %s?" #( nid dup mix-position mx-pos ) snd-display
+ then
+ else
+ "100 find-mix: not a mix %s?" #( nid ) snd-display
+ then
+ 200 #f #f find-mix to nid
+ nid mix? false? unless
+ nid mix-position 200 <> if
+ new-index 0 mixes map
+ *key* mix-position
+ end-map { mx-pos }
+ "200 find-mix: %s %s %s?" #( nid dup mix-position mx-pos ) snd-display
+ then
+ else
+ "200 find-mix: not a mix %s?" #( nid ) snd-display
+ then
+ \
+ "oboe.snd" 100 mix car to mix-id
+ 40 set-mix-waveform-height drop
+ 'hiho mix-id 123 set-mix-property
+ 'hiho mix-id mix-property to res
+ res 123 <> if
+ "mix-property: %s?" #( res ) snd-display
+ then
+ 'not-here mix-id mix-property to res
+ res if
+ "mix-property not-here: %s?" #( res ) snd-display
+ then
+ #f #f update-time-graph drop
+ 20 set-mix-waveform-height drop
+ new-index revert-sound drop
+ new-index close-sound drop
+ then \ !*with-test-gtk*
\ envelopes (lists, vcts, arrays) (test015)
- 1.0 vct( 0.0 0.0 2.0 1.0 ) 1.0 envelope-interp dup 0.5 fneq if
- $" envelope-interp 0.5: %s?" swap snd-display
+ 1.0 vct( 0.0 0.0 2.0 1.0 ) 1.0 envelope-interp dup 0.5 fneq if
+ "envelope-interp 0.5: %s?" swap snd-display
else
drop
then
- 1.0 #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 1.0 envelope-interp dup 1.0 fneq if
- $" envelope-interp 1.0: %s?" swap snd-display
+ 1.0 #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 1.0 envelope-interp dup 1.0 fneq if
+ "envelope-interp 1.0: %s?" swap snd-display
else
drop
then
- 2.0 #( 0.0 0.0 1.0 1.0 ) 1.0 envelope-interp dup 1.0 fneq if
- $" envelope-interp 1.0: %s?" swap snd-display
+ 2.0 #( 0.0 0.0 1.0 1.0 ) 1.0 envelope-interp dup 1.0 fneq if
+ "envelope-interp 1.0: %s?" swap snd-display
else
drop
then
- 0.0 #( 1.0 0.5 2.0 0.0 ) 1.0 envelope-interp dup 0.5 fneq if
- $" envelope-interp 0.5: %s?" swap snd-display
+ 0.0 #( 1.0 0.5 2.0 0.0 ) 1.0 envelope-interp dup 0.5 fneq if
+ "envelope-interp 0.5: %s?" swap snd-display
else
drop
then
- 0.0 #( -1.0 0.0 0.0 1.0 1.0 -1.0 ) 1.0 envelope-interp dup 1.0 fneq if
- $" envelope-interp 1.0; %s?" swap snd-display
+ 0.0 #( -1.0 0.0 0.0 1.0 1.0 -1.0 ) 1.0 envelope-interp dup 1.0 fneq if
+ "envelope-interp 1.0; %s?" swap snd-display
else
drop
then
- -0.5 #( -1.0 0.0 0.0 1.0 1.0 -1.0 ) 1.0 envelope-interp dup 0.5 fneq if
- $" envelope-interp 0.5: %s?" swap snd-display
+ -0.5 #( -1.0 0.0 0.0 1.0 1.0 -1.0 ) 1.0 envelope-interp dup 0.5 fneq if
+ "envelope-interp 0.5: %s?" swap snd-display
else
drop
then
-0.5 #( -1.0 -1.0 0.0 1.0 1.0 -1.0 ) 1.0 envelope-interp dup 0.0 fneq if
- $" envelope-interp 0.0: %s?" swap snd-display
+ "envelope-interp 0.0: %s?" swap snd-display
else
drop
then
- -0.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup -0.5 fneq if
- $" envelope-interp -0.5: %s?" swap snd-display
+ -0.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup -0.5 fneq if
+ "envelope-interp -0.5: %s?" swap snd-display
else
drop
then
- -1.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup -1.0 fneq if
- $" envelope-interp -1.0: %s?" swap snd-display
+ -1.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup -1.0 fneq if
+ "envelope-interp -1.0: %s?" swap snd-display
else
drop
then
- 1.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup 1.0 fneq if
- $" envelope-interp 1.0: %s?" swap snd-display
+ 1.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup 1.0 fneq if
+ "envelope-interp 1.0: %s?" swap snd-display
else
drop
then
- 0.1 #( 0.0 0.0 1.0 1.0 ) 1.0 envelope-interp dup 0.1 fneq if
- $" envelope-interp 0.1: %s?" swap snd-display
+ 0.1 #( 0.0 0.0 1.0 1.0 ) 1.0 envelope-interp dup 0.1 fneq if
+ "envelope-interp 0.1: %s?" swap snd-display
else
drop
then
- 0.1 #( 0.0 0.0 1.0 1.0 ) 32.0 envelope-interp dup 0.01336172 fneq if
- $" envelope-interp (exp 32): %s?" swap snd-display
+ 0.1 #( 0.0 0.0 1.0 1.0 ) 32.0 envelope-interp dup 0.01336172 fneq if
+ "envelope-interp (exp 32): %s?" swap snd-display
else
drop
then
- 0.1 #( 0.0 0.0 1.0 1.0 ) 0.012 envelope-interp dup 0.36177473 fneq if
- $" envelope-interp (exp 0.012): %s?" swap snd-display
+ 0.1 #( 0.0 0.0 1.0 1.0 ) 0.012 envelope-interp dup 0.36177473 fneq if
+ "envelope-interp (exp 0.012): %s?" swap snd-display
else
drop
then
- 0.3 #( 0.0 0.0 0.5 1.0 1.0 0.0 ) 1.0 envelope-interp dup 0.6 fneq if
- $" envelope-interp 0.6: %s?" swap snd-display
+ 0.3 #( 0.0 0.0 0.5 1.0 1.0 0.0 ) 1.0 envelope-interp dup 0.6 fneq if
+ "envelope-interp 0.6: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 0.5 0.5 1.0 0.5 ) { v0 }
- #( 0.0 0.0 2.0 0.5 ) #( 0.0 0.0 1.0 2.0 2.0 1.0 ) multiply-envelopes dup v0 0 fveql unless
- $" multiply-envelopes: %s?" swap snd-display
+ #( 0.0 0.0 2.0 0.5 ) #( 0.0 0.0 1.0 2.0 2.0 1.0 )
+ multiply-envelopes dup v0 0 fveql unless
+ "multiply-envelopes: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 0.5 0.5 1.0 0.0 ) to v0
- #( 0.0 0.0 1.0 1.0 ) #( 0.0 0.0 1.0 1.0 2.0 0.0 ) multiply-envelopes dup v0 0 fveql unless
- $" multiply-envelopes: %s?" swap snd-display
+ #( 0.0 0.0 1.0 1.0 ) #( 0.0 0.0 1.0 1.0 2.0 0.0 )
+ multiply-envelopes dup v0 0 fveql unless
+ "multiply-envelopes: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 1.0 1.0 2.0 3.0 4.0 0.0 ) max-envelope dup 3.0 fneq if
- $" 0 max-envelope: %s?" swap snd-display
+ "0 max-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 1.0 ) max-envelope dup 1.0 fneq if
- $" 1 max-envelope: %s?" swap snd-display
+ "1 max-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 1.0 1.0 1.0 2.0 2.0 ) max-envelope dup 2.0 fneq if
- $" 2 max-envelope: %s?" swap snd-display
+ "2 max-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 -1.0 1.0 -2.0 ) max-envelope dup -1.0 fneq if
- $" 3 max-envelope: %s?" swap snd-display
+ "3 max-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 -2.0 1.0 -1.0 ) max-envelope dup -1.0 fneq if
- $" 4 max-envelope: %s?" swap snd-display
+ "4 max-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 1.0 1.0 2.0 3.0 4.0 0.0 ) min-envelope dup 0.0 fneq if
- $" 0 min-envelope: %s?" swap snd-display
+ "0 min-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 1.0 ) min-envelope dup 1.0 fneq if
- $" 1 min-envelope: %s?" swap snd-display
+ "1 min-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 1.0 1.0 1.0 2.0 2.0 ) min-envelope dup 1.0 fneq if
- $" 2 min-envelope: %s?" swap snd-display
+ "2 min-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 -1.0 1.0 -2.0 ) min-envelope dup -2.0 fneq if
- $" 3 min-envelope: %s?" swap snd-display
+ "3 min-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 -2.0 1.0 -1.0 ) min-envelope dup -2.0 fneq if
- $" 4 min-envelope: %s?" swap snd-display
+ "4 min-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 0.2 0.1 1.0 1.0 ) to v0
#( 0.0 0.0 1.0 1.0 ) 0.1 0.2 #f #f stretch-envelope dup v0 0 fveql unless
- $" stretch-envelope att: %s?" swap snd-display
+ "stretch-envelope att: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 0.2 0.1 1.1 1.0 1.6 0.5 2.0 0.0 ) to v0
- #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 0.1 0.2 1.5 1.6 stretch-envelope dup v0 0 fveql unless
- $" stretch-envelope dec: %s?" swap snd-display
+ #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 0.1 0.2 1.5 1.6
+ stretch-envelope dup v0 0 fveql unless
+ "stretch-envelope dec: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 0.2 0.1 1.1 1.0 1.6 0.5 2.0 0.0 ) to v0
- #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 0.1 0.2 1.5 1.6 stretch-envelope dup v0 0 fveql unless
- $" stretch-envelope: %s?" swap snd-display
+ #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 0.1 0.2 1.5 1.6
+ stretch-envelope dup v0 0 fveql unless
+ "stretch-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 0.5 1.5 1.0 1.0 ) to v0
- #( 0.0 0.0 1.0 1.0 2.0 0.0 ) #( 0.0 0.0 1.0 1.0 ) add-envelopes dup v0 0 fveql unless
- $" add-envelopes: %s?" swap snd-display
+ #( 0.0 0.0 1.0 1.0 2.0 0.0 ) #( 0.0 0.0 1.0 1.0 )
+ add-envelopes dup v0 0 fveql unless
+ "add-envelopes: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 1.0 2.0 ) to v0
#( 0.0 0.0 1.0 1.0 ) 2.0 scale-envelope dup v0 0 fveql unless
- $" scale-envelope: %s?" swap snd-display
+ "scale-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 1.0 1.0 0.0 ) to v0
#( 0.0 0.0 1.0 1.0 ) reverse-envelope dup v0 0 fveql unless
- $" reverse-envelope: %s?" swap snd-display
+ "reverse-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 0.0 1.5 1.0 2.0 0.0 ) to v0
#( 0.0 0.0 0.5 1.0 2.0 0.0 ) reverse-envelope dup v0 0 fveql unless
- $" reverse-envelope: %s?" swap snd-display
+ "reverse-envelope: %s?" swap snd-display
else
drop
then
#( 0.0 1.0 1.5 1.0 2.0 0.0 ) to v0
#( 0.0 0.0 0.5 1.0 2.0 1.0 ) reverse-envelope dup v0 0 fveql unless
- $" reverse-envelope: %s?" swap snd-display
+ "reverse-envelope: %s?" swap snd-display
else
drop
then
@@ -7279,26 +6223,35 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
\ ---------------- test 28: errors ----------------
: check-error-tag { xt expected-tag -- }
- xt #t nil fth-catch { tag }
- stack-reset
- tag if \ we ignore #f
- tag car expected-tag = unless
- $" %s: expected %s from %s, got %s?" #( get-func-name expected-tag xt tag ) snd-display
+ xt snd-test-catch { tag }
+ tag if \ we ignore #f
+ tag car expected-tag <> if
+ "%s: expected %s from %s, got %s?"
+ #( get-func-name expected-tag xt tag ) snd-display
then
then
;
*with-test-motif* [if]
: snd-motif-error-checks ( -- )
- #( 'Widget 0 ) <'> widget-position 'no-such-widget check-error-tag
- #( 'Widget 0 ) <'> widget-size 'no-such-widget check-error-tag
- #( 'Widget 0 ) <'> widget-text 'no-such-widget check-error-tag
- #( 'Widget 0 ) #( 0 0 ) <'> set-widget-position 'no-such-widget check-error-tag
- #( 'Widget 0 ) #( 10 10 ) <'> set-widget-size 'no-such-widget check-error-tag
- #( 'Widget 0 ) "text" <'> set-widget-text 'no-such-widget check-error-tag
- #( 'Widget 0 ) <'> hide-widget 'no-such-widget check-error-tag
- #( 'Widget 0 ) <'> show-widget 'no-such-widget check-error-tag
- #( 'Widget 0 ) <'> focus-widget 'no-such-widget check-error-tag
+ '( 'Widget 0 ) <'> widget-position 'no-such-widget check-error-tag
+ '( 'Widget 0 ) <'> widget-size 'no-such-widget check-error-tag
+ '( 'Widget 0 ) <'> widget-text 'no-such-widget check-error-tag
+ '( 'Widget 0 ) #( 0 0 ) <'> set-widget-position 'no-such-widget
+ check-error-tag
+ '( 'Widget 0 ) #( 10 10 ) <'> set-widget-size 'no-such-widget
+ check-error-tag
+ '( 'Widget 0 ) "hiho" <'> set-widget-text 'no-such-widget check-error-tag
+ nil nil { prc tag }
+ #( <'> widget-position <'> widget-size <'> widget-text
+ <'> hide-widget <'> show-widget <'> focus-widget ) each to prc
+ '( 'Widget 0 ) prc snd-test-catch to tag
+ tag if
+ tag car 'no-such-widget <> if
+ "%s of null widget -> %s" #( prc tag ) snd-display
+ then
+ then
+ end-each
;
[else]
<'> noop alias snd-motif-error-checks
@@ -7317,299 +6270,305 @@ lambda: <{ x -- y }> pi random ; value random-pi-addr
3 0.0 make-vct constant vct-3
5 0.0 make-vct constant vct-5
-: make-identity-mixer <{ chans -- mx }>
- #f { mx }
- chans 256 < if
- chans make-mixer to mx
- mx mixer? if chans 0 do mx i i 1.0 mixer-set! drop loop else #f to mx then
- then
- mx
-;
-
-#( <'> make-all-pass <'> make-asymmetric-fm <'> make-snd->sample <'> make-moving-average
- <'> make-comb <'> make-filtered-comb <'> make-convolve <'> make-delay <'> make-env
- <'> make-fft-window <'> make-file->frame <'> make-file->sample <'> make-filter
- <'> make-fir-filter <'> make-formant <'> make-firmant <'> make-frame
- <'> make-frame->file <'> make-granulate <'> make-iir-filter <'> make-locsig
- <'> make-mixer <'> make-notch <'> make-one-pole <'> make-one-zero <'> make-oscil
- <'> make-pulse-train <'> make-rand <'> make-rand-interp <'> make-readin
- <'> make-sample->file <'> make-sawtooth-wave <'> make-nrxysin <'> make-nrxycos
- <'> make-square-wave <'> make-src <'> make-ncos <'> make-nsin <'> make-table-lookup
- <'> make-triangle-wave <'> make-two-pole <'> make-two-zero <'> make-wave-train
- <'> make-phase-vocoder <'> make-ssb-am <'> make-polyshape <'> make-polywave
- <'> make-player <'> make-region <'> make-scalar-mixer ) constant make-procs
-
-#( :frequency :initial-phase :wave :cosines :amplitude :ratio :size :a0 :a1 :a2 :b1 :b2 :input
- :srate :file :channel :start :initial-contents :initial-element :scaler :feedforward :feedback
- :max-size :radius :gain :partials :r :a :n :fill-time :order :xcoeffs :ycoeffs :envelope
- :base :duration :offset :end :direction :degree :distance :reverb :output :fft-size :expansion
- :length :hop :ramp :jitter :type :format :comment :channels :filter :revout :width :edit
- :synthesize :analyze :interp :overlap :pitch :distribution :sines :dur ) constant keyargs
+#( <'> make-all-pass <'> make-asymmetric-fm <'> make-snd->sample
+ <'> make-moving-average <'> make-comb <'> make-filtered-comb
+ <'> make-convolve <'> make-delay <'> make-env <'> make-fft-window
+ <'> make-file->frample <'> make-file->sample <'> make-filter
+ <'> make-fir-filter <'> make-formant <'> make-firmant
+ <'> make-frample->file <'> make-granulate <'> make-iir-filter
+ <'> make-locsig <'> make-notch <'> make-one-pole
+ <'> make-one-zero <'> make-oscil <'> make-pulse-train <'> make-rand
+ <'> make-rand-interp <'> make-readin <'> make-sample->file
+ <'> make-sawtooth-wave <'> make-nrxysin <'> make-nrxycos
+ <'> make-square-wave <'> make-src <'> make-ncos <'> make-nsin
+ <'> make-table-lookup <'> make-triangle-wave <'> make-two-pole
+ <'> make-two-zero <'> make-wave-train <'> make-phase-vocoder
+ <'> make-ssb-am <'> make-polyshape <'> make-polywave
+ <'> make-player <'> make-region ) constant make-procs
+
+#( :frequency :initial-phase :wave :cosines :amplitude :ratio :size
+ :a0 :a1 :a2 :b1 :b2 :input :srate :file :channel :start
+ :initial-contents :initial-element :scaler :feedforward
+ :feedback :max-size :radius :gain :partials :r :a :n :fill-time
+ :order :xcoeffs :ycoeffs :envelope :base :duration :offset :end
+ :direction :degree :distance :reverb :output :fft-size :expansion
+ :length :hop :ramp :jitter :type :format :comment :channels :filter
+ :revout :width :edit :synthesize :analyze :interp :overlap :pitch
+ :distribution :sines :dur ) constant keyargs
#( <'> add-mark <'> add-sound-file-extension <'> add-source-file-extension
- <'> sound-file-extensions <'> sound-file? <'> add-to-main-menu <'> add-to-menu <'> add-transform
- <'> amp-control <'> ask-about-unsaved-edits
- <'> as-one-edit <'> ask-before-overwrite <'> audio-input-device
- <'> audio-output-device <'> auto-resize <'> auto-update <'> autocorrelate
- <'> axis-info <'> apply-controls <'> change-samples-with-origin
- <'> channel-style <'> channels <'> chans <'> close-sound
- <'> comment <'> contrast-control <'> contrast-control-amp <'> contrast-control?
- <'> convolve-selection-with <'> convolve-with <'> channel-properties <'> channel-property
- <'> amp-control-bounds
- <'> speed-control-bounds <'> expand-control-bounds <'> contrast-control-bounds
- <'> reverb-control-length-bounds
- <'> reverb-control-scale-bounds <'> cursor-update-interval <'> cursor-location-offset
- <'> auto-update-interval <'> count-matches <'> cursor
- <'> with-tracking-cursor <'> cursor-size <'> cursor-style <'> tracking-cursor-style
- <'> dac-combines-channels <'> dac-size <'> clipping
- <'> data-format <'> data-location <'> data-size <'> default-output-chans
- <'> default-output-data-format <'> default-output-srate <'> default-output-header-type
- <'> define-envelope <'> delete-mark <'> delete-marks <'> forget-region <'> delete-sample
- <'> delete-samples <'> delete-samples-and-smooth <'> delete-selection
+ <'> sound-file-extensions <'> sound-file? <'> add-to-main-menu
+ <'> add-to-menu <'> add-transform <'> amp-control
+ <'> ask-about-unsaved-edits <'> as-one-edit <'> ask-before-overwrite
+ <'> auto-resize
+ <'> auto-update <'> autocorrelate <'> axis-info <'> apply-controls
+ <'> change-samples-with-origin <'> channel-style <'> channels
+ <'> chans <'> close-sound <'> combined-data-color <'> comment
+ <'> contrast-control <'> contrast-control-amp <'> contrast-control?
+ <'> convolve-selection-with <'> convolve-with <'> channel-properties
+ <'> channel-property <'> amp-control-bounds <'> speed-control-bounds
+ <'> expand-control-bounds <'> contrast-control-bounds
+ <'> reverb-control-length-bounds <'> reverb-control-scale-bounds
+ <'> cursor-update-interval <'> cursor-location-offset
+ <'> auto-update-interval <'> cursor
+ <'> with-tracking-cursor <'> cursor-size <'> cursor-style
+ <'> tracking-cursor-style <'> dac-combines-channels <'> dac-size
+ <'> clipping <'> sample-type <'> data-location <'> data-size
+ <'> default-output-chans <'> default-output-sample-type
+ <'> default-output-srate <'> default-output-header-type
+ <'> define-envelope <'> delete-mark <'> delete-marks
+ <'> forget-region <'> delete-sample <'> delete-samples
+ <'> delete-samples-and-smooth <'> delete-selection
<'> delete-selection-and-smooth <'> display-edits
- <'> edit-fragment <'> edit-position <'> edit-tree <'> edits <'> env-selection
- <'> env-sound <'> enved-envelope <'> enved-base <'> enved-clip?
- <'> enved-in-dB <'> enved-style <'> enved-power <'> enved-target <'> enved-wave? <'> eps-file
- <'> eps-left-margin <'> eps-bottom-margin <'> eps-size <'> expand-control
- <'> expand-control-hop <'> expand-control-jitter <'> expand-control-length
- <'> expand-control-ramp <'> expand-control? <'> fft <'> fft-window-alpha <'> fft-window-beta
- <'> fft-log-frequency <'> fft-log-magnitude <'> transform-size <'> disk-kspace
- <'> transform-graph-type <'> fft-window <'> transform-graph? <'> file-name
- <'> filter-sound <'> filter-control-in-dB <'> filter-control-envelope <'> enved-filter-order
- <'> enved-filter <'> filter-control-in-hz <'> filter-control-order <'> filter-selection
- <'> filter-channel <'> filter-control? <'> find-channel
- <'> find-mark <'> find-sound <'> finish-progress-report <'> frames <'> free-sampler
- <'> graph <'> transform? <'> delete-transform
- <'> graph-cursor <'> graph->ps
- <'> gl-graph->ps <'> graph-style <'> lisp-graph? <'> graphs-horizontal <'> header-type
- <'> in <'> insert-region <'> insert-sample <'> insert-samples
- <'> insert-samples-with-origin <'> insert-selection <'> insert-silence <'> insert-sound
- <'> just-sounds <'> left-sample <'> listener-prompt
- <'> make-mix-sampler <'> make-player <'> make-region <'> make-region-sampler
- <'> make-sampler <'> map-chan
- <'> mark-name <'> mark-properties <'> mark-property
- <'> mark-sample <'> mark-sync <'> mark-sync-max
- <'> mark-home <'> marks <'> mark? <'> max-transform-peaks
- <'> max-regions <'> maxamp <'> maxamp-position
- <'> minibuffer-history-length <'> min-dB <'> log-freq-start <'> mix
- <'> mixes <'> mix-amp <'> mix-amp-env <'> mix-length
+ <'> edit-fragment <'> edit-position <'> edit-tree <'> edits
+ <'> env-selection <'> env-sound <'> enved-envelope <'> enved-base
+ <'> enved-clip? <'> enved-in-dB <'> enved-style <'> enved-power
+ <'> enved-target <'> enved-wave? <'> eps-file <'> eps-left-margin
+ <'> eps-bottom-margin <'> eps-size <'> expand-control
+ <'> expand-control-hop <'> expand-control-jitter
+ <'> expand-control-length <'> expand-control-ramp
+ <'> expand-control? <'> fft <'> fft-window-alpha
+ <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude
+ <'> transform-size <'> disk-kspace <'> transform-graph-type
+ <'> fft-window <'> transform-graph? <'> file-name <'> filter-sound
+ <'> filter-control-in-dB <'> filter-control-envelope
+ <'> enved-filter-order <'> enved-filter <'> filter-control-in-hz
+ <'> filter-control-order <'> filter-selection <'> filter-channel
+ <'> filter-control? <'> find-mark <'> find-sound
+ <'> finish-progress-report <'> framples <'> free-sampler <'> graph
+ <'> transform? <'> delete-transform <'> graph-cursor <'> graph->ps
+ <'> gl-graph->ps <'> graph-style <'> lisp-graph? <'> graphs-horizontal
+ <'> header-type <'> in <'> insert-region <'> insert-sample
+ <'> insert-samples <'> insert-samples-with-origin <'> insert-selection
+ <'> insert-silence <'> insert-sound <'> just-sounds <'> left-sample
+ <'> listener-prompt <'> make-mix-sampler <'> make-player
+ <'> make-region <'> make-region-sampler <'> make-sampler
+ <'> map-chan <'> mark-name <'> mark-properties <'> mark-property
+ <'> mark-sample <'> mark-sync <'> mark-sync-max <'> mark-home
+ <'> marks <'> mark? <'> max-transform-peaks <'> max-regions
+ <'> maxamp <'> maxamp-position <'> min-dB <'> log-freq-start
+ <'> mix <'> mixes <'> mix-amp <'> mix-amp-env <'> mix-length
<'> mix? <'> mix-position <'> mix-properties <'> mix-property
- <'> mix-name <'> mix-region <'> mix-sampler?
- <'> mix-selection <'> mix-sound <'> mix-home <'> mix-speed
- <'> mix-tag-height <'> mix-tag-width <'> mark-tag-height <'> mark-tag-width
+ <'> mix-name <'> mix-region <'> mix-sampler? <'> mix-selection
+ <'> mix-sound <'> mix-home <'> mix-speed <'> mix-tag-height
+ <'> mix-tag-width <'> mark-tag-height <'> mark-tag-width
<'> mix-tag-y <'> mix-vct <'> mix-waveform-height <'> time-graph-style
<'> lisp-graph-style <'> transform-graph-style <'> read-mix-sample
- <'> next-sample <'> show-full-duration <'> initial-beg <'> initial-dur
- <'> transform-normalization <'> open-raw-sound
- <'> open-sound <'> previous-sample <'> peaks <'> player? <'> players
- <'> add-directory-to-view-files-list <'> add-file-to-view-files-list
- <'> view-files-sort <'> view-files-amp <'> view-files-speed <'> view-files-files
- <'> view-files-selected-files <'> view-files-speed-style <'> view-files-amp-env
- <'> print-length <'> progress-report <'> prompt-in-minibuffer <'> read-only
- <'> redo <'> region-chans <'> region-home
- <'> region-graph-style <'> region-frames <'> region-position <'> region-maxamp
- <'> region-maxamp-position <'> remember-sound-state
- <'> selection-maxamp <'> selection-maxamp-position
- <'> region-sample <'> region->vct <'> clear-minibuffer <'> region-srate <'> regions
- <'> region? <'> remove-from-menu <'> report-in-minibuffer <'> reset-controls
- <'> restore-controls <'> restore-region <'> reverb-control-decay <'> reverb-control-feedback
- <'> reverb-control-length <'> reverb-control-lowpass <'> reverb-control-scale
- <'> reverb-control? <'> reverse-sound <'> reverse-selection <'> revert-sound
- <'> right-sample <'> sample <'> sampler-at-end? <'> sampler?
- <'> samples <'> sampler-position <'> save-controls
- <'> peak-env-dir <'> save-dir <'> save-edit-history <'> save-envelopes
- <'> save-listener <'> save-marks <'> save-region <'> save-selection
- <'> save-sound <'> save-sound-as <'> save-state <'> save-state-file
- <'> scale-by <'> scale-selection-by <'> scale-selection-to <'> scale-to
- <'> scan-chan <'> search-procedure <'> select-all <'> select-channel
- <'> select-sound <'> selected-channel
+ <'> next-sample <'> show-full-duration <'> show-full-range
+ <'> initial-beg <'> initial-dur <'> transform-normalization
+ <'> open-raw-sound <'> open-sound <'> previous-sample <'> peaks
+ <'> player? <'> players <'> print-length <'> progress-report
+ <'> read-only <'> redo <'> region-chans <'> region-home
+ <'> region-graph-style <'> region-framples <'> region-position
+ <'> region-maxamp <'> region-maxamp-position <'> remember-sound-state
+ <'> selection-maxamp <'> selection-maxamp-position <'> region-sample
+ <'> region->vct <'> region-srate <'> regions <'> region?
+ <'> remove-from-menu <'> reset-controls <'> restore-controls
+ <'> restore-region <'> reverb-control-decay
+ <'> reverb-control-feedback <'> reverb-control-length
+ <'> reverb-control-lowpass <'> reverb-control-scale
+ <'> reverb-control? <'> reverse-sound <'> reverse-selection
+ <'> revert-sound <'> right-sample <'> sample <'> sampler-at-end?
+ <'> sampler? <'> samples <'> sampler-position <'> save-controls
+ <'> peak-env-dir <'> save-dir <'> save-edit-history
+ <'> save-envelopes <'> save-listener <'> save-marks
+ <'> save-region <'> save-selection <'> save-sound <'> save-sound-as
+ <'> save-state <'> save-state-file <'> scale-by <'> scale-selection-by
+ <'> scale-selection-to <'> scale-to <'> search-procedure
+ <'> select-all <'> select-channel <'> select-sound <'> selected-channel
<'> selected-sound <'> selection-position <'> selection-creates-region
- <'> selection-frames <'> selection-member? <'> selection? <'> short-file-name
- <'> show-axes <'> show-controls <'> show-transform-peaks
- <'> show-indices <'> show-listener <'> show-selection <'> unselect-all
- <'> show-marks <'> show-mix-waveforms
- <'> show-selection-transform <'> show-y-zero <'> sinc-width <'> show-grid
- <'> show-sonogram-cursor <'> grid-density <'> smooth-sound <'> smooth-selection
- <'> snd-spectrum <'> snd-tempnam <'> snd-version
- <'> sound-files-in-directory <'> sound-loop-info
- <'> sound? <'> sounds <'> spectrum-end <'> spectro-hop
- <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale <'> spectro-y-angle
- <'> spectro-y-scale <'> spectro-z-angle <'> spectro-z-scale <'> speed-control
- <'> speed-control-style <'> speed-control-tones <'> squelch-update <'> srate
- <'> src-sound <'> src-selection <'> start-progress-report <'> stop-player
- <'> stop-playing <'> swap-channels <'> syncd-marks <'> sync
- <'> sync-max <'> sound-properties <'> sound-property <'> temp-dir <'> region-sampler?
- <'> transform-sample <'> transform->vct <'> transform-frames <'> transform-type
- <'> trap-segfault <'> with-file-monitor <'> optimization
- <'> undo <'> update-transform-graph <'> update-time-graph <'> update-lisp-graph
- <'> update-sound <'> clm-table-size <'> with-verbose-cursor <'> view-sound <'> wavelet-type
- <'> with-inset-graph <'> with-pointer-focus <'> with-smpte-label
- <'> with-toolbar <'> with-tooltips <'> with-menu-icons
- <'> save-as-dialog-src <'> save-as-dialog-auto-comment
- <'> time-graph? <'> time-graph-type <'> wavo-hop <'> wavo-trace
- <'> window-height <'> window-width <'> window-x <'> window-y
- <'> with-mix-tags <'> with-relative-panes <'> with-gl
- <'> x-axis-style <'> beats-per-measure <'> beats-per-minute <'> x-bounds
- <'> x-position-slider <'> x-zoom-slider <'> mus-header-type->string
- <'> mus-data-format->string <'> y-bounds <'> y-position-slider
+ <'> selection-framples <'> selection-member? <'> selection?
+ <'> short-file-name <'> show-axes <'> show-controls
+ <'> show-transform-peaks <'> show-indices <'> show-listener
+ <'> show-selection <'> unselect-all <'> show-marks
+ <'> show-mix-waveforms <'> show-selection-transform
+ <'> show-y-zero <'> sinc-width <'> show-grid <'> show-sonogram-cursor
+ <'> grid-density <'> smooth-sound <'> smooth-selection <'> snd-spectrum
+ <'> snd-tempnam <'> snd-version <'> sound-files-in-directory
+ <'> sound-loop-info <'> sound? <'> sounds <'> spectrum-end
+ <'> spectro-hop <'> spectrum-start <'> spectro-x-angle
+ <'> spectro-x-scale <'> spectro-y-angle <'> spectro-y-scale
+ <'> spectro-z-angle <'> spectro-z-scale <'> speed-control
+ <'> speed-control-style <'> speed-control-tones <'> squelch-update
+ <'> srate <'> src-sound <'> src-selection <'> start-progress-report
+ <'> stop-player <'> stop-playing <'> swap-channels <'> syncd-marks
+ <'> sync <'> sync-max <'> sound-properties <'> sound-property
+ <'> temp-dir <'> region-sampler? <'> transform-sample
+ <'> transform->vct <'> transform-framples <'> transform-type
+ <'> with-file-monitor <'> undo
+ <'> update-transform-graph <'> update-time-graph
+ <'> update-lisp-graph <'> update-sound <'> clm-table-size
+ <'> with-verbose-cursor <'> view-sound <'> wavelet-type
+ <'> with-inset-graph <'> with-interrupts <'> with-pointer-focus
+ <'> with-smpte-label <'> with-toolbar <'> with-tooltips
+ <'> with-menu-icons <'> save-as-dialog-src
+ <'> save-as-dialog-auto-comment <'> time-graph?
+ <'> time-graph-type <'> wavo-hop <'> wavo-trace <'> window-height
+ <'> window-width <'> window-x <'> window-y <'> with-mix-tags
+ <'> with-relative-panes <'> with-gl <'> x-axis-style
+ <'> beats-per-measure <'> beats-per-minute <'> x-bounds
+ <'> x-position-slider <'> x-zoom-slider <'> mus-header-type->string
+ <'> mus-sample-type->string <'> y-bounds <'> y-position-slider
<'> y-zoom-slider <'> zero-pad <'> zoom-focus-style <'> sync-style
- <'> mus-sound-samples <'> mus-sound-frames <'> mus-sound-duration <'> mus-sound-datum-size
- <'> mus-sound-data-location <'> data-size <'> mus-sound-chans <'> mus-sound-srate
- <'> mus-sound-header-type <'> mus-sound-data-format <'> mus-sound-length
- <'> mus-sound-type-specifier
- <'> mus-header-type-name <'> mus-data-format-name <'> mus-sound-comment
- <'> mus-sound-write-date
- <'> mus-bytes-per-sample <'> mus-sound-loop-info
- 'snd-nogui [unless] <'> mus-audio-describe [then]
- <'> mus-alsa-squelch-warning <'> mus-sound-maxamp
- <'> mus-sound-maxamp-exists?
- <'> mus-file-prescaler <'> mus-prescaler <'> mus-clipping <'> mus-file-clipping
- <'> mus-header-raw-defaults <'> moving-average <'> moving-average? <'> make-moving-average
- <'> mus-expand-filename <'> make-sound-data <'> sound-data-ref <'> sound-data-set!
- <'> sound-data-scale! <'> sound-data-fill! <'> sound-data? <'> sound-data-length
- <'> sound-data-multiply! <'> sound-data-add! <'> sound-data-offset! <'> sound-data*
- <'> sound-data+ <'> sound-data-copy <'> sound-data-reverse! <'> sound-data-maxamp
- <'> sound-data-chans <'> sound-data->vct <'> vct->sound-data <'> sound-data-peak
- <'> all-pass <'> all-pass? <'> amplitude-modulate <'> array->file
- <'> array-interp <'> mus-interpolate <'> asymmetric-fm <'> asymmetric-fm?
- <'> sound-data->sound-data <'> clear-array <'> comb <'> comb?
- <'> filtered-comb <'> filtered-comb? <'> contrast-enhancement <'> convolution
- <'> convolve <'> convolve? <'> db->linear <'> degrees->radians
- <'> delay <'> delay? <'> dot-product <'> env
- <'> env-interp <'> env? <'> file->array <'> file->frame
- <'> file->frame? <'> file->sample <'> file->sample? <'> filter
- <'> filter? <'> fir-filter <'> fir-filter? <'> formant
- <'> formant-bank <'> formant? <'> frame* <'> frame+
- <'> frame->file <'> frame->file? <'> frame->frame <'> frame->list
- <'> frame->sample <'> frame-ref <'> frame-set! <'> frame?
+ <'> mus-sound-samples <'> mus-sound-framples <'> mus-sound-duration
+ <'> mus-sound-datum-size <'> mus-sound-data-location <'> data-size
+ <'> mus-sound-chans <'> mus-sound-srate <'> mus-sound-header-type
+ <'> mus-sound-sample-type <'> mus-sound-length
+ <'> mus-sound-type-specifier <'> mus-header-type-name
+ <'> mus-sample-type-name <'> mus-sound-comment
+ <'> mus-sound-write-date <'> mus-bytes-per-sample
+ <'> mus-sound-loop-info <'> mus-alsa-squelch-warning
+ <'> mus-sound-maxamp <'> mus-sound-maxamp-exists?
+ <'> mus-clipping
+ <'> mus-file-clipping <'> mus-header-raw-defaults <'> moving-average
+ <'> moving-average? <'> make-moving-average <'> mus-expand-filename
+ <'> all-pass <'> all-pass? <'> amplitude-modulate
+ <'> array->file <'> array-interp <'> mus-interpolate <'> asymmetric-fm
+ <'> asymmetric-fm? <'> comb
+ <'> comb? <'> filtered-comb <'> filtered-comb? <'> contrast-enhancement
+ <'> convolution <'> convolve <'> convolve? <'> db->linear
+ <'> degrees->radians <'> delay <'> delay? <'> dot-product <'> env
+ <'> env-interp <'> env? <'> file->array <'> file->frample <'> file->frample?
+ <'> file->sample <'> file->sample? <'> filter <'> filter? <'> fir-filter
+ <'> fir-filter? <'> formant <'> formant-bank <'> formant?
+ <'> frample->file <'> frample->file? <'> frample->frample
<'> granulate <'> granulate? <'> hz->radians <'> iir-filter
- <'> iir-filter? <'> in-any <'> ina <'> inb
- <'> linear->db <'> locsig <'> locsig-ref <'> locsig-reverb-ref
- <'> locsig-reverb-set! <'> locsig-set! <'> locsig? <'> make-all-pass
- <'> make-asymmetric-fm <'> make-comb <'> make-filtered-comb <'> make-convolve
- <'> make-delay <'> make-env <'> make-fft-window <'> make-file->frame
- <'> make-file->sample <'> make-filter <'> make-fir-filter <'> make-formant
- <'> make-frame <'> make-frame->file <'> make-granulate <'> make-iir-filter
- <'> make-locsig <'> move-locsig <'> make-mixer <'> make-notch
- <'> make-one-pole <'> make-one-zero <'> make-oscil <'> make-pulse-train
- <'> make-rand <'> make-rand-interp <'> make-readin <'> make-sample->file
- <'> make-sawtooth-wave <'> make-square-wave <'> make-src
- <'> make-ssb-am <'> make-table-lookup
- <'> make-triangle-wave <'> make-two-pole <'> make-two-zero <'> make-wave-train
- <'> mixer* <'> mixer-ref <'> mixer-set!
- <'> mixer? <'> mixer+ <'> move-sound <'> make-move-sound
- <'> move-sound? <'> mus-float-equal-fudge-factor <'> multiply-arrays
- <'> mus-array-print-length
- <'> mus-channel <'> mus-channels <'> make-polyshape <'> polyshape?
- <'> mus-close <'> mus-data <'> mus-feedback
- <'> mus-feedforward <'> mus-fft <'> mus-frequency
- <'> mus-hop <'> mus-increment <'> mus-input? <'> mus-file-name
- <'> mus-length <'> mus-location <'> mus-mix <'> mus-order
- <'> mus-output? <'> mus-phase <'> mus-ramp <'> mus-random
- <'> mus-scaler <'> mus-srate <'> mus-xcoeffs <'> mus-ycoeffs
- <'> notch <'> notch? <'> one-pole <'> one-pole?
- <'> one-zero <'> one-zero? <'> oscil <'> oscil?
- <'> out-any <'> outa <'> outb <'> outc
- <'> outd <'> partials->polynomial <'> partials->wave
- <'> phase-partials->wave <'> polynomial <'> pulse-train <'> pulse-train?
- <'> radians->degrees <'> radians->hz <'> rand <'> rand-interp
- <'> rand-interp? <'> rand? <'> readin <'> readin?
- <'> rectangular->polar <'> rectangular->magnitudes
+ <'> iir-filter? <'> in-any <'> ina <'> inb <'> linear->db <'> locsig
+ <'> locsig-ref <'> locsig-reverb-ref <'> locsig-reverb-set!
+ <'> locsig-set! <'> locsig? <'> make-all-pass <'> make-asymmetric-fm
+ <'> make-comb <'> make-filtered-comb <'> make-convolve <'> make-delay
+ <'> make-env <'> make-fft-window <'> make-file->frample
+ <'> make-file->sample <'> make-filter <'> make-fir-filter
+ <'> make-formant <'> make-frample->file <'> make-granulate
+ <'> make-iir-filter <'> make-locsig <'> move-locsig
+ <'> make-notch <'> make-one-pole <'> make-one-zero <'> make-oscil
+ <'> make-pulse-train <'> make-rand <'> make-rand-interp <'> make-readin
+ <'> make-sample->file <'> make-sawtooth-wave <'> make-square-wave
+ <'> make-src <'> make-ssb-am <'> make-table-lookup <'> make-triangle-wave
+ <'> make-two-pole <'> make-two-zero <'> make-wave-train <'> move-sound
+ <'> make-move-sound <'> move-sound? <'> mus-float-equal-fudge-factor
+ <'> mus-array-print-length <'> mus-channel
+ <'> mus-channels <'> make-polyshape <'> polyshape? <'> mus-close
+ <'> mus-data <'> mus-feedback <'> mus-feedforward <'> mus-fft
+ <'> mus-frequency <'> mus-hop <'> mus-increment <'> mus-input?
+ <'> mus-file-name <'> mus-length <'> mus-location
+ <'> mus-order <'> mus-output? <'> mus-phase <'> mus-ramp <'> mus-random
+ <'> mus-scaler <'> mus-srate <'> mus-xcoeffs <'> mus-ycoeffs <'> notch
+ <'> notch? <'> one-pole <'> one-pole? <'> one-zero <'> one-zero?
+ <'> oscil <'> oscil? <'> out-any <'> outa <'> outb <'> outc <'> outd
+ <'> partials->polynomial <'> partials->wave <'> phase-partials->wave
+ <'> polynomial <'> pulse-train <'> pulse-train? <'> radians->degrees
+ <'> radians->hz <'> rand <'> rand-interp <'> rand-interp? <'> rand?
+ <'> readin <'> readin? <'> rectangular->polar <'> rectangular->magnitudes
<'> ring-modulate <'> sample->file <'> sample->file?
- <'> sample->frame <'> sawtooth-wave <'> sawtooth-wave?
- <'> spectrum <'> square-wave <'> square-wave?
- <'> src <'> src? <'> ssb-am <'> ssb-am?
- <'> table-lookup <'> table-lookup? <'> tap <'> triangle-wave
+ <'> sawtooth-wave <'> sawtooth-wave? <'> spectrum <'> square-wave
+ <'> square-wave? <'> src <'> src? <'> ssb-am <'> ssb-am?
+ <'> table-lookup <'> table-lookup? <'> tap <'> triangle-wave
<'> triangle-wave? <'> two-pole <'> two-pole? <'> two-zero
- <'> two-zero? <'> wave-train <'> wave-train?
- <'> make-vct <'> vct-add! <'> vct-subtract!
- <'> vct-copy <'> vct-length <'> vct-multiply! <'> vct-offset!
- <'> vct-ref <'> vct-scale! <'> vct-fill! <'> vct-set!
- <'> vct-peak <'> vct? <'> list->vct
+ <'> two-zero? <'> wave-train <'> wave-train? <'> make-vct
+ <'> vct-add! <'> vct-subtract! <'> vct-length
+ <'> vct-multiply! <'> vct-offset! <'> vct-ref <'> vct-scale!
+ <'> vct-set! <'> vct-peak <'> vct? <'> list->vct
<'> vct->list <'> vector->vct <'> vct->vector <'> vct-move!
- <'> vct-reverse! <'> vct-subseq <'> vct <'> little-endian?
+ <'> vct-reverse! <'> vct-subseq <'> vct <'> little-endian?
<'> vct->string <'> clm-channel <'> env-channel <'> map-channel
<'> scan-channel <'> reverse-channel <'> seconds->samples
- <'> samples->seconds <'> smooth-channel <'> vct->channel <'> channel->vct
- <'> src-channel <'> scale-channel <'> ramp-channel <'> pad-channel
- <'> normalize-channel <'> cursor-position <'> show-listener <'> mus-sound-prune
- <'> mus-sound-forget <'> xramp-channel <'> ptree-channel <'> snd->sample
- <'> snd->sample? <'> make-snd->sample <'> make-scalar-mixer <'> beats-per-minute
- <'> beats-per-measure <'> channel-amp-envs <'> convolve-files <'> filter-control-coeffs
+ <'> samples->seconds <'> smooth-channel <'> vct->channel
+ <'> channel->vct <'> src-channel <'> scale-channel <'> ramp-channel
+ <'> pad-channel <'> normalize-channel <'> cursor-position
+ <'> show-listener <'> mus-sound-prune <'> mus-sound-forget
+ <'> xramp-channel <'> snd->sample <'> snd->sample? <'> make-snd->sample
+ <'> beats-per-minute <'> beats-per-measure
+ <'> channel-amp-envs <'> convolve-files <'> filter-control-coeffs
<'> locsig-type <'> make-phase-vocoder <'> mus-describe
- <'> mus-error-type->string <'> mus-file-buffer-size <'> mus-name <'> mus-offset
- <'> mus-out-format <'> mus-reset <'> mus-rand-seed <'> mus-width
- <'> phase-vocoder? <'> polar->rectangular <'> phase-vocoder-amp-increments
- <'> phase-vocoder-amps
+ <'> mus-error-type->string <'> mus-file-buffer-size <'> mus-name
+ <'> mus-offset <'> mus-out-format <'> mus-reset <'> mus-rand-seed
+ <'> mus-width <'> phase-vocoder? <'> polar->rectangular
+ <'> phase-vocoder-amp-increments <'> phase-vocoder-amps
<'> phase-vocoder-freqs <'> phase-vocoder-phase-increments
- <'> phase-vocoder-phases
- <'> mus-generator? <'> read-sample <'> reset-listener-cursor <'> goto-listener-end
- <'> sampler-home <'> selection-chans <'> selection-srate <'> snd-warning
+ <'> phase-vocoder-phases <'> mus-generator? <'> read-sample
+ <'> reset-listener-cursor <'> goto-listener-end <'> sampler-home
+ <'> selection-chans <'> selection-srate <'> snd-warning
<'> channel-data <'> x-axis-label <'> variable-graph? <'> y-axis-label
- <'> snd-url <'> snd-urls <'> free-player <'> delete-mix <'> delay-tick <'> playing
- <'> pausing <'> copy-sampler <'> html-dir <'> html-program
- <'> make-fir-coeffs <'> make-identity-mixer <'> mus-interp-type <'> mus-run
- <'> phase-vocoder <'> player-home <'> redo-edit <'> undo-edit ) constant procs
-
-#( <'> amp-control <'> ask-before-overwrite <'> audio-input-device <'> audio-output-device
- <'> auto-update <'> channel-style <'> sound-file-extensions <'> show-full-duration
- <'> initial-beg <'> initial-dur <'> contrast-control <'> contrast-control-amp
- <'> amp-control-bounds <'> speed-control-bounds <'> expand-control-bounds
- <'> contrast-control-bounds <'> reverb-control-length-bounds <'> reverb-control-scale-bounds
- <'> cursor-update-interval <'> cursor-location-offset <'> contrast-control?
- <'> auto-update-interval <'> cursor <'> channel-properties <'> channel-property
- <'> with-tracking-cursor <'> cursor-size <'> cursor-style <'> tracking-cursor-style
- <'> dac-combines-channels <'> dac-size <'> clipping <'> default-output-chans
- <'> default-output-data-format <'> default-output-srate <'> default-output-header-type
- <'> dot-size <'> enved-envelope <'> enved-base <'> enved-clip? <'> enved-in-dB
- <'> enved-style <'> enved-power <'> enved-target <'> enved-wave? <'> eps-file
+ <'> snd-url <'> snd-urls <'> free-player <'> delete-mix <'> delay-tick
+ <'> playing <'> pausing <'> copy-sampler <'> html-dir <'> html-program
+ <'> make-fir-coeffs <'> mus-interp-type
+ <'> mus-run <'> phase-vocoder <'> player-home <'> redo-edit
+ <'> undo-edit ) constant procs
+
+#( <'> amp-control <'> ask-before-overwrite <'> auto-update <'> channel-style
+ <'> sound-file-extensions <'> show-full-duration <'> show-full-range
+ <'> initial-beg <'> initial-dur <'> contrast-control
+ <'> contrast-control-amp <'> combined-data-color <'> amp-control-bounds
+ <'> speed-control-bounds <'> expand-control-bounds
+ <'> contrast-control-bounds <'> reverb-control-length-bounds
+ <'> reverb-control-scale-bounds <'> cursor-update-interval
+ <'> cursor-location-offset <'> contrast-control?
+ <'> auto-update-interval <'> cursor <'> channel-properties
+ <'> channel-property <'> with-tracking-cursor <'> cursor-size
+ <'> cursor-style <'> tracking-cursor-style <'> dac-combines-channels
+ <'> dac-size <'> clipping <'> default-output-chans
+ <'> default-output-sample-type <'> default-output-srate
+ <'> default-output-header-type <'> dot-size <'> enved-envelope
+ <'> enved-base <'> enved-clip? <'> enved-in-dB <'> enved-style
+ <'> enved-power <'> enved-target <'> enved-wave? <'> eps-file
<'> eps-left-margin <'> eps-bottom-margin <'> eps-size <'> expand-control
<'> expand-control-hop <'> expand-control-jitter <'> expand-control-length
- <'> expand-control-ramp <'> expand-control? <'> fft-window-alpha <'> fft-window-beta
- <'> fft-log-frequency <'> fft-log-magnitude <'> transform-size <'> transform-graph-type
- <'> fft-window <'> transform-graph? <'> filter-control-in-dB <'> filter-control-envelope
- <'> enved-filter-order <'> enved-filter <'> filter-control-in-hz <'> filter-control-order
- <'> filter-control? <'> graph-cursor <'> graph-style <'> lisp-graph? <'> graphs-horizontal
- <'> just-sounds <'> left-sample <'> listener-prompt <'> mark-name <'> mark-properties
- <'> mark-property <'> mark-sample <'> mark-sync <'> max-transform-peaks <'> min-dB
- <'> log-freq-start <'> mix-amp <'> mix-amp-env <'> mix-name <'> mix-position
- <'> mix-properties <'> mix-property <'> mix-speed <'> mix-tag-height <'> mix-tag-width
- <'> mix-tag-y <'> mark-tag-width <'> mark-tag-height <'> mix-waveform-height
- <'> transform-normalization <'> view-files-sort <'> print-length <'> play-arrow-size
- <'> view-files-amp <'> view-files-speed <'> view-files-speed-style <'> view-files-amp-env
- <'> view-files-files <'> view-files-selected-files <'> region-graph-style
- <'> reverb-control-decay <'> reverb-control-feedback <'> reverb-control-length
- <'> reverb-control-lowpass <'> reverb-control-scale <'> time-graph-style
- <'> lisp-graph-style <'> transform-graph-style <'> reverb-control? <'> ladspa-dir
- <'> peak-env-dir <'> save-dir <'> save-state-file <'> selection-creates-region
- <'> show-axes <'> show-controls <'> show-transform-peaks <'> show-indices
- <'> show-marks <'> show-mix-waveforms <'> show-selection-transform <'> show-y-zero
- <'> show-grid <'> show-sonogram-cursor <'> sinc-width <'> spectrum-end <'> spectro-hop
- <'> spectrum-start <'> spectro-x-angle <'> grid-density <'> spectro-x-scale
- <'> spectro-y-angle <'> spectro-y-scale <'> spectro-z-angle <'> spectro-z-scale
- <'> speed-control <'> speed-control-style <'> speed-control-tones <'> squelch-update
- <'> sync <'> sound-properties <'> sound-property <'> temp-dir <'> y-bounds
- <'> transform-type <'> trap-segfault <'> with-file-monitor <'> optimization
- <'> with-verbose-cursor <'> with-inset-graph <'> with-pointer-focus <'> wavelet-type
- <'> x-bounds <'> with-smpte-label <'> with-toolbar <'> with-tooltips <'> with-menu-icons
- <'> save-as-dialog-src <'> save-as-dialog-auto-comment <'> time-graph? <'> wavo-hop
- <'> wavo-trace <'> with-gl <'> with-mix-tags <'> x-axis-style <'> beats-per-minute
- <'> zero-pad <'> zoom-focus-style <'> sync-style <'> with-relative-panes <'> window-x
- <'> window-y <'> window-width <'> window-height <'> beats-per-measure <'> channels
- <'> chans <'> comment <'> data-format <'> data-location <'> data-size <'> edit-position
- <'> frames <'> header-type <'> maxamp <'> minibuffer-history-length <'> read-only
- <'> right-sample <'> sample <'> samples <'> selected-channel <'> selected-sound
- <'> selection-position <'> selection-frames <'> selection-member? <'> sound-loop-info
- <'> srate <'> time-graph-type <'> x-position-slider <'> x-zoom-slider <'> y-position-slider
- <'> y-zoom-slider <'> sound-data-ref <'> mus-array-print-length <'> mus-float-equal-fudge-factor
- <'> mus-data <'> mus-feedback <'> mus-feedforward <'> mus-frequency <'> mus-hop
- <'> mus-increment <'> mus-length <'> mus-location <'> mus-phase <'> mus-ramp <'> mus-scaler
- <'> vct-ref <'> x-axis-label <'> filter-control-coeffs <'> locsig-type <'> mus-file-buffer-size
- <'> mus-rand-seed <'> mus-width <'> clm-table-size <'> mus-offset <'> mus-reset
- <'> phase-vocoder-amp-increments <'> phase-vocoder-amps <'> phase-vocoder-freqs
- <'> phase-vocoder-phase-increments <'> phase-vocoder-phases <'> html-dir <'> html-program
- <'> mus-interp-type <'> mixer-ref <'> frame-ref <'> locsig-ref <'> locsig-reverb-ref
- <'> mus-file-prescaler <'> mus-prescaler <'> mus-clipping <'> mus-file-clipping
+ <'> expand-control-ramp <'> expand-control? <'> fft-window-alpha
+ <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude
+ <'> transform-size <'> transform-graph-type <'> fft-window
+ <'> transform-graph? <'> filter-control-in-dB <'> filter-control-envelope
+ <'> enved-filter-order <'> enved-filter <'> filter-control-in-hz
+ <'> filter-control-order <'> filter-control? <'> graph-cursor
+ <'> graph-style <'> lisp-graph? <'> graphs-horizontal <'> just-sounds
+ <'> left-sample <'> listener-prompt <'> mark-name <'> mark-properties
+ <'> mark-property <'> mark-sample <'> mark-sync <'> max-transform-peaks
+ <'> min-dB <'> log-freq-start <'> mix-amp <'> mix-amp-env <'> mix-name
+ <'> mix-position <'> mix-properties <'> mix-property <'> mix-speed
+ <'> mix-tag-height <'> mix-tag-width <'> mix-tag-y <'> mark-tag-width
+ <'> mark-tag-height <'> mix-waveform-height <'> transform-normalization
+ <'> print-length <'> play-arrow-size
+ <'> region-graph-style <'> reverb-control-decay <'> reverb-control-feedback
+ <'> reverb-control-length <'> reverb-control-lowpass
+ <'> reverb-control-scale <'> time-graph-style <'> lisp-graph-style
+ <'> transform-graph-style <'> reverb-control? <'> ladspa-dir
+ <'> peak-env-dir <'> save-dir <'> save-state-file
+ <'> selection-creates-region <'> show-axes <'> show-controls
+ <'> show-transform-peaks <'> show-indices <'> show-marks
+ <'> show-mix-waveforms <'> show-selection-transform <'> show-y-zero
+ <'> show-grid <'> show-sonogram-cursor <'> sinc-width <'> spectrum-end
+ <'> spectro-hop <'> spectrum-start <'> spectro-x-angle <'> grid-density
+ <'> spectro-x-scale <'> spectro-y-angle <'> spectro-y-scale
+ <'> spectro-z-angle <'> spectro-z-scale <'> speed-control
+ <'> speed-control-style <'> speed-control-tones <'> squelch-update
+ <'> sync <'> sound-properties <'> sound-property <'> temp-dir
+ <'> y-bounds <'> transform-type <'> with-file-monitor
+ <'> with-verbose-cursor <'> with-inset-graph <'> with-interrupts
+ <'> with-pointer-focus <'> wavelet-type <'> x-bounds <'> with-smpte-label
+ <'> with-toolbar <'> with-tooltips <'> with-menu-icons
+ <'> save-as-dialog-src <'> save-as-dialog-auto-comment <'> time-graph?
+ <'> wavo-hop <'> wavo-trace <'> with-gl <'> with-mix-tags
+ <'> x-axis-style <'> beats-per-minute <'> zero-pad <'> zoom-focus-style
+ <'> sync-style <'> with-relative-panes <'> window-x <'> window-y
+ <'> window-width <'> window-height <'> beats-per-measure <'> channels
+ <'> chans <'> comment <'> sample-type <'> data-location <'> data-size
+ <'> edit-position <'> framples <'> header-type <'> maxamp <'> read-only
+ <'> right-sample <'> sample <'> samples <'> selected-channel
+ <'> selected-sound <'> selection-position <'> selection-framples
+ <'> selection-member? <'> sound-loop-info <'> srate <'> time-graph-type
+ <'> x-position-slider <'> x-zoom-slider <'> y-position-slider
+ <'> y-zoom-slider <'> mus-array-print-length
+ <'> mus-float-equal-fudge-factor <'> mus-data <'> mus-feedback
+ <'> mus-feedforward <'> mus-frequency <'> mus-hop <'> mus-increment
+ <'> mus-length <'> mus-location <'> mus-phase <'> mus-ramp
+ <'> mus-scaler <'> vct-ref <'> x-axis-label <'> filter-control-coeffs
+ <'> locsig-type <'> mus-file-buffer-size <'> mus-rand-seed
+ <'> mus-width <'> clm-table-size <'> mus-offset <'> mus-reset
+ <'> phase-vocoder-amp-increments <'> phase-vocoder-amps
+ <'> phase-vocoder-freqs <'> phase-vocoder-phase-increments
+ <'> phase-vocoder-phases <'> html-dir <'> html-program
+ <'> mus-interp-type <'> locsig-ref
+ <'> locsig-reverb-ref <'> mus-clipping <'> mus-file-clipping
<'> mus-header-raw-defaults ) constant set-procs
: arity-not-ok <{ prc args -- f }> prc args arity-ok not ;
@@ -7635,7 +6594,9 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
1 proc-create "oboe.snd" open-sound , ( prc )
does> { y self -- val }
self @ { ind }
- ind sound? if ind close-sound drop then
+ ind sound? if
+ ind close-sound drop
+ then
0.0
;
@@ -7667,7 +6628,9 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
1 proc-create "oboe.snd" open-sound , ( prc )
does> { y self -- f }
self @ { ind }
- ind sound? if ind close-sound drop then
+ ind sound? if
+ ind close-sound drop
+ then
#f
;
@@ -7678,28 +6641,19 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
#f
;
-: mc-1-cb { scl -- prc; y self -- val }
- 1 proc-create scl , 0.0 ( mx ) , ( prc )
- does> { y self -- val }
- y 0.4 f> if
- 0.0 self cell+ !
- self cell+ ( addr-of-mx ) sc-1-cb scan-channel drop
- self cell+ @ 1/f self ! ( scl = 1/mx )
- then
- self @ ( scl ) y f*
-;
-
: mc-2-cb { ind -- prc; y self -- val }
1 proc-create ind , ( prc )
does> { y self -- val }
- y 0.4 f> if 1 self @ ( ind ) 0 set-frames drop then
+ y 0.4 f> if
+ 1 self @ ( ind ) 0 set-framples drop
+ then
y
;
*with-test-complex* [if]
: mc-3-cb <{ y -- val }> y 0.0+1.0i c* ;
[else]
- noop alias mc-3-cb
+ <'> noop alias mc-3-cb
[then]
: edpos-1-cb { ind -- prc; self -- edpos }
@@ -7714,535 +6668,614 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
current-edit-position
;
-: check-args-progress-info { msg -- } *snd-test-verbose* if msg #f snd-test-message then ;
+: check-args-progress-info { msg -- }
+ *snd-test-verbose* if
+ msg #f snd-test-message
+ then
+;
: 28-errors ( -- )
#t set-with-background-processes drop
reset-almost-all-hooks
nil nil { prc tag }
- #( <'> amp-control <'> apply-controls <'> close-sound <'> comment <'> contrast-control
- <'> amp-control-bounds <'> speed-control-bounds <'> expand-control-bounds
- <'> contrast-control-bounds <'> reverb-control-length-bounds <'> reverb-control-scale-bounds
- <'> contrast-control-amp <'> contrast-control? <'> data-format <'> data-location
- <'> data-size <'> expand-control <'> expand-control-hop <'> expand-control-jitter
- <'> expand-control-length <'> expand-control-ramp <'> expand-control? <'> file-name
- <'> filter-control-in-dB <'> filter-control-in-hz <'> filter-control-envelope
- <'> filter-control-order <'> filter-control? <'> finish-progress-report <'> frames
- <'> header-type <'> read-only <'> reset-controls <'> restore-controls
- <'> reverb-control-decay <'> reverb-control-feedback <'> reverb-control-length
- <'> reverb-control-lowpass <'> reverb-control-scale <'> reverb-control? <'> save-controls
- <'> select-sound <'> short-file-name <'> sound-loop-info <'> speed-control
- <'> speed-control-style <'> speed-control-tones <'> srate <'> channel-style
- <'> start-progress-report <'> sync <'> sound-properties <'> sound-property
- <'> swap-channels ) { prcs-1 }
- prcs-1 each to prc
- 123 prc #t nil fth-catch to tag
- stack-reset
+ #( <'> amp-control <'> comment
+ <'> contrast-control <'> amp-control-bounds <'> speed-control-bounds
+ <'> expand-control-bounds <'> contrast-control-bounds
+ <'> reverb-control-length-bounds <'> reverb-control-scale-bounds
+ <'> contrast-control-amp <'> contrast-control? <'> sample-type
+ <'> data-location <'> data-size <'> expand-control
+ <'> expand-control-hop <'> expand-control-jitter
+ <'> expand-control-length <'> expand-control-ramp
+ <'> expand-control? <'> filter-control-in-dB
+ <'> filter-control-in-hz <'> filter-control-envelope
+ <'> filter-control-order <'> filter-control?
+ <'> finish-progress-report <'> header-type <'> read-only
+ <'> reset-controls <'> restore-controls <'> reverb-control-decay
+ <'> reverb-control-feedback <'> reverb-control-length
+ <'> reverb-control-lowpass <'> reverb-control-scale <'> reverb-control?
+ <'> save-controls <'> select-sound <'> short-file-name
+ <'> sound-loop-info <'> soundfont-info
+ <'> speed-control <'> speed-control-style
+ <'> speed-control-tones <'> srate <'> channel-style
+ <'> start-progress-report <'> sync <'> swap-channels ) { prcs-1 }
+ prcs-1 #(
+ <'> apply-controls <'> close-sound <'> channels <'> chans
+ <'> file-name <'> framples <'> progress-report
+ <'> sound-property <'> sound-properties ) array-append each to prc
+ 123 integer->sound prc snd-test-catch to tag
tag if
- tag car 'no-such-sound = unless
- $" snd no-such-sound %s: %s" #( prc tag ) snd-display
+ tag car 'no-such-sound <> if
+ "snd no-such-sound %s: %s" #( prc tag ) snd-display
then
then
end-each
- #( vct-5 -1.0 csqrt 1.5 "hiho" ) { args-1 }
+ #( 1 make-array "hiho" 0+i 1.5 '( 1 0 ) #( 0 1 ) ) { args-1 }
+ #( vct-5 1+i "hiho" delay-32 ) { args-2 }
nil { arg }
args-1 each to arg
- prcs-1 each to prc
- arg prc #t nil fth-catch to tag
- stack-reset
+ prcs-1 #( <'> apply-controls
+ <'> close-sound <'> sound-properties ) array-append each to prc
+ arg prc snd-test-catch to tag
tag if
- tag car 'no-such-sound =
- tag car 'wrong-type-arg = ||
- tag car 'mus-error = || unless
- $" snd wrong-type-arg %s: %s (%s)" #( prc tag arg ) snd-display
- then
+ tag car 'wrong-type-arg <>
+ tag car 'mus-error <> && if
+ "snd wrong-type-arg %s: %s (%s)" #( prc tag arg ) snd-display
+ then
then
end-each
end-each
- "obtest.snd" open-sound { ind }
- args-1 each to arg
- prcs-1 each to prc
- \ FIXME
+ args-2 each to arg
+ prcs-1 #( <'> channels <'> chans <'> framples ) array-append each to prc
+ \ XXX: snd/chn val | val snd/chn
\ snd/chn before value
\ g_set_channels(snd, val) arg 0
\ snd/chn after value
\ g_set_amp_control(val, snd, chn) 0 arg
- prc <'> data-format =
+ prc <'> channels =
+ prc <'> chans = ||
+ prc <'> sample-type = ||
prc <'> data-location = ||
prc <'> data-size = ||
prc <'> header-type = ||
prc <'> srate = ||
- prc <'> comment = || if arg 0 else 0 arg then prc set-xt #t nil fth-catch to tag
- stack-reset
+ prc <'> comment = || if
+ arg 0
+ else
+ 0 arg
+ then prc set-xt snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" snd wrong-type-arg set-%s [%s]: %s" #( prc arg tag ) snd-display
- then
+ tag car 'wrong-type-arg <>
+ tag car 'syntax-error <> &&
+ tag car 'error <> && if
+ "snd set wrong-type-arg set-%s [%s]: %s" #( prc arg tag ) snd-display
+ then
then
end-each
end-each
- #( <'> amp-control <'> contrast-control <'> contrast-control-amp <'> contrast-control?
- <'> expand-control <'> amp-control-bounds <'> speed-control-bounds <'> expand-control-bounds
- <'> contrast-control-bounds <'> reverb-control-length-bounds <'> reverb-control-scale-bounds
- <'> expand-control-hop <'> expand-control-jitter <'> expand-control-length
+ "obtest.snd" open-sound { ind }
+ #( <'> amp-control <'> contrast-control <'> contrast-control-amp
+ <'> contrast-control? <'> expand-control <'> amp-control-bounds
+ <'> speed-control-bounds <'> expand-control-bounds
+ <'> contrast-control-bounds <'> reverb-control-length-bounds
+ <'> reverb-control-scale-bounds <'> expand-control-hop
+ <'> expand-control-jitter <'> expand-control-length
<'> expand-control-ramp <'> expand-control? <'> filter-control-in-dB
- <'> filter-control-in-hz <'> filter-control-envelope <'> filter-control-order
- <'> filter-control? <'> reverb-control-decay <'> reverb-control-feedback
- <'> reverb-control-length <'> reverb-control-lowpass <'> reverb-control-scale
- <'> reverb-control? <'> speed-control <'> speed-control-style <'> speed-control-tones
+ <'> filter-control-in-hz <'> filter-control-envelope
+ <'> filter-control-order <'> filter-control? <'> reverb-control-decay
+ <'> reverb-control-feedback <'> reverb-control-length
+ <'> reverb-control-lowpass <'> reverb-control-scale <'> reverb-control?
+ <'> speed-control <'> speed-control-style <'> speed-control-tones
<'> channel-style <'> sync ) { prcs-2 }
- args-1 each to arg
+ args-2 each to arg
prcs-2 each to prc
- arg ind prc set-xt #t nil fth-catch to tag
- stack-reset
+ arg ind prc set-xt snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" snd safe wrong-type-arg set-%s [%s]: %s" #( prc arg tag ) snd-display
- then
+ tag car 'wrong-type-arg <> if
+ "snd safe set wrong-type-arg set-%s [%s]: %s"
+ #( prc arg tag ) snd-display
+ then
then
end-each
end-each
ind close-sound drop
- #( 1 make-array "hiho" -1.0 csqrt 1.5 #( 1 0 ) #( 0 1 ) ) { args-2 }
- args-2 each to arg
- #( <'> make-vct <'> vct-copy <'> vct-length <'> vct->list <'> vct-peak ) each to prc
- arg prc #t nil fth-catch to tag
- stack-reset
+ args-1 each to arg
+ #( <'> make-vct <'> vct-length <'> vct->list <'> vct-peak ) each to prc
+ arg prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" vct 0 wrong-type-arg %s [%s]: %s" #( prc arg tag ) snd-display
- then
+ tag car 'wrong-type-arg <> if
+ "vct 0 wrong-type-arg %s [%s]: %s" #( prc arg tag ) snd-display
+ then
then
end-each
end-each
#( <'> vct-add! <'> vct-subtract! <'> vct-multiply!
- <'> vct-ref <'> vct-scale! <'> vct-fill! ) { vct-prcs-2 }
+ <'> vct-ref <'> vct-scale! ) { vct-prcs-2 }
nil nil { arg1 arg2 }
- args-2 each to arg1
+ args-1 each to arg1
args-1 each to arg2
vct-prcs-2 each to prc
- arg1 arg2 prc #t nil fth-catch to tag
- stack-reset
- tag if
- tag car 'wrong-type-arg =
- tag car 'wrong-number-of-args = ||
- tag car 'mus-error = || unless
- $" vct 1 wrong-whatever %s [%s %s]: %s" #( prc arg1 arg2 tag ) snd-display
- then
- then
+ arg1 arg2 prc snd-test-catch to tag
+ tag if
+ tag car 'wrong-type-arg <>
+ tag car 'wrong-number-of-args <> &&
+ tag car 'mus-error <> && if
+ "vct 1 wrong-whatever %s [%s %s]: %s"
+ #( prc arg1 arg2 tag ) snd-display
+ then
+ then
end-each
end-each
end-each
- args-2 each to arg
+ args-1 each to arg
vct-prcs-2 each to prc
- arg vct-3 prc #t nil fth-catch to tag
- stack-reset
+ arg vct-3 prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" vct 1 wrong-whatever %s [%s]: %s" #( prc arg tag ) snd-display
- then
+ tag car 'wrong-type-arg <> if
+ "vct 2 wrong-whatever %s [%s]: %s" #( prc arg tag ) snd-display
+ then
then
end-each
end-each
- -23 <'> make-vct #t nil fth-catch to tag
- tag car 'out-of-range = unless $" make-vct -23: %s" #( tag ) snd-display then
+ -23 <'> make-vct snd-test-catch to tag
+ tag car 'out-of-range <> if
+ "make-vct -23: %s" #( tag ) snd-display
+ then
vct-3 { v }
- v 12 <'> vct-ref #t nil fth-catch to tag
- tag car 'out-of-range = unless $" vct[12]: %s" #( tag ) snd-display then
+ v 12 <'> vct-ref snd-test-catch to tag
+ tag car 'out-of-range <> if
+ "vct[12]: %s" #( tag ) snd-display
+ then
#( <'> all-pass? <'> asymmetric-fm? <'> comb? <'> filtered-comb?
- <'> convolve? <'> delay? <'> env? <'> file->frame?
- <'> file->sample? <'> snd->sample? <'> filter? <'> fir-filter?
- <'> formant? <'> frame->file? <'> frame? <'> granulate?
- <'> iir-filter? <'> locsig? <'> mixer? <'> move-sound?
- <'> mus-input? <'> mus-output? <'> notch? <'> one-pole?
- <'> one-zero? <'> oscil? <'> phase-vocoder? <'> pulse-train?
- <'> rand-interp? <'> rand? <'> readin? <'> sample->file?
- <'> sawtooth-wave? <'> square-wave? <'> src? <'> table-lookup? <'> triangle-wave?
- <'> two-pole? <'> two-zero? <'> wave-train?
- <'> mix-sampler? <'> moving-average? <'> ssb-am?
+ <'> convolve? <'> delay? <'> env? <'> file->frample? <'> file->sample?
+ <'> snd->sample? <'> filter? <'> fir-filter? <'> formant? <'> firmant?
+ <'> frample->file? <'> granulate? <'> iir-filter?
+ <'> locsig? <'> move-sound? <'> mus-input? <'> mus-output?
+ <'> notch? <'> one-pole? <'> one-zero? <'> oscil? <'> phase-vocoder?
+ <'> pulse-train? <'> rand-interp? <'> rand? <'> readin?
+ <'> sample->file? <'> sawtooth-wave? <'> nrxysin? <'> nrxycos?
+ <'> square-wave? <'> src? <'> ncos? <'> nsin? <'> table-lookup?
+ <'> triangle-wave? <'> two-pole? <'> two-zero? <'> wave-train?
+ <'> color? <'> mix-sampler? <'> moving-average? <'> ssb-am?
<'> sampler? <'> region-sampler? <'> vct? ) { ?prcs }
args-1 each to arg
?prcs each to prc
- arg prc #t nil fth-catch to tag
- stack-reset
+ arg prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" ?proc %s [%s]: %s" #( prc arg tag ) snd-display
- then
+ tag car 'wrong-type-arg <> if
+ "?proc %s [%s]: %s" #( prc arg tag ) snd-display
+ then
then
end-each
end-each
?prcs each to prc
- 440 make-oscil prc #t nil fth-catch to tag
- stack-reset
+ 440 make-oscil prc snd-test-catch to tag
tag if
- tag 'wrong-type-arg = unless
- $" ?proc %s [440 make-oscil]: %s" #( prc tag ) snd-display
- then
+ "oscil?proc %s [440 make-oscil]: %s" #( prc tag ) snd-display
then
end-each
- #( <'> reverse-selection <'> selection-position <'> selection-frames <'> smooth-selection
- <'> scale-selection-to <'> insert-selection <'> delete-selection <'> delete-selection-and-smooth
+ #( <'> reverse-selection <'> selection-position <'> selection-framples
+ <'> smooth-selection <'> scale-selection-to <'> insert-selection
+ <'> delete-selection <'> delete-selection-and-smooth
<'> mix-selection ) each to prc
- prc #t nil fth-catch to tag
- stack-reset
+ prc snd-test-catch to tag
tag if
- tag car 'no-active-selection = unless
- $" [0] selection %s: %s" #( prc tag ) snd-display
+ tag car 'no-active-selection <> if
+ "0 selection %s: %s" #( prc tag ) snd-display
then
then
end-each
#( <'> src-selection <'> filter-selection <'> env-selection ) each to prc
- 0.0 prc #t nil fth-catch to tag
- stack-reset
+ 0.0 prc snd-test-catch to tag
tag if
- tag car 'no-active-selection = unless
- $" [1] selection %s: %s" #( prc tag ) snd-display
+ tag car 'no-active-selection <> if
+ "1 selection %s: %s" #( prc tag ) snd-display
then
then
end-each
-
- #( <'> all-pass <'> asymmetric-fm <'> clear-array <'> comb <'> filtered-comb
- <'> convolve <'> db->linear <'> moving-average <'> degrees->radians <'> delay
- <'> env <'> formant <'> firmant <'> frame->list <'> granulate <'> hz->radians
- <'> linear->db <'> make-all-pass <'> make-asymmetric-fm <'> make-comb
- <'> make-filtered-comb <'> make-convolve <'> make-delay <'> make-env
- <'> make-file->frame <'> make-file->sample <'> make-filter <'> make-fir-filter
- <'> make-formant <'> make-firmant <'> make-frame <'> make-granulate <'> make-iir-filter
- <'> make-locsig <'> make-notch <'> make-one-pole <'> make-one-zero <'> make-oscil
- <'> make-pulse-train <'> make-rand <'> make-rand-interp <'> make-readin
- <'> make-sawtooth-wave <'> make-nrxysin <'> make-nrxycos
- <'> make-square-wave <'> make-src <'> make-ncos
- <'> make-nsin <'> make-table-lookup <'> make-triangle-wave
- <'> make-two-pole <'> make-two-zero <'> make-wave-train <'> make-ssb-am
- <'> mus-channel <'> mus-channels <'> make-polyshape <'> make-polywave
- <'> mus-data <'> mus-feedback <'> mus-feedforward <'> mus-frequency <'> mus-hop
- <'> mus-increment <'> mus-length <'> mus-file-name <'> mus-location <'> mus-name
- <'> mus-order <'> mus-phase <'> mus-ramp <'> mus-random <'> mus-run <'> mus-scaler
- <'> mus-xcoeffs <'> mus-ycoeffs <'> notch <'> one-pole <'> one-zero <'> make-moving-average
- <'> seconds->samples <'> samples->seconds <'> oscil <'> partials->polynomial
- <'> partials->wave <'> phase-partials->wave <'> phase-vocoder <'> pulse-train
- <'> radians->degrees <'> radians->hz <'> rand <'> rand-interp <'> readin
- <'> sawtooth-wave <'> nrxysin <'> nrxycos <'> square-wave <'> src
- <'> ncos <'> nsin <'> table-lookup <'> tap
- <'> triangle-wave <'> two-pole <'> two-zero <'> wave-train <'> ssb-am ) { clm-prcs-1 }
- \ FIXME
- \ 'bad-type added for #( 1 1 1 ) partials->wave
- \ 'out-of-range added for -1.0 csqrt make-frame
- \ -1.0 csqrt make-moving-average
- #( 1 make-array color-95 -1.0 csqrt 1 1.0 make-vct ) each to arg
+ #( <'> all-pass <'> asymmetric-fm <'> comb
+ <'> filtered-comb <'> convolve <'> db->linear <'> moving-average
+ <'> degrees->radians <'> delay <'> env <'> formant <'> firmant
+ <'> granulate <'> hz->radians <'> linear->db
+ <'> make-all-pass <'> make-asymmetric-fm <'> make-comb
+ <'> make-filtered-comb <'> make-convolve <'> make-delay
+ <'> make-env <'> make-file->frample <'> make-file->sample
+ <'> make-filter <'> make-fir-filter <'> make-formant
+ <'> make-firmant <'> make-granulate
+ <'> make-iir-filter <'> make-locsig <'> make-notch
+ <'> make-one-pole <'> make-one-zero <'> make-oscil
+ <'> make-pulse-train <'> make-rand <'> make-rand-interp
+ <'> make-readin <'> make-sawtooth-wave <'> make-nrxysin
+ <'> make-nrxycos <'> make-square-wave <'> make-src <'> make-ncos
+ <'> make-nsin <'> make-table-lookup <'> make-triangle-wave
+ <'> make-two-pole <'> make-two-zero <'> make-wave-train
+ <'> make-ssb-am <'> mus-channel <'> mus-channels <'> make-polyshape
+ <'> make-polywave <'> mus-data <'> mus-feedback <'> mus-feedforward
+ <'> mus-frequency <'> mus-hop <'> mus-increment <'> mus-length
+ <'> mus-file-name <'> mus-location <'> mus-name <'> mus-order
+ <'> mus-phase <'> mus-ramp <'> mus-random <'> mus-run <'> mus-scaler
+ <'> mus-xcoeffs <'> mus-ycoeffs <'> notch <'> one-pole <'> one-zero
+ <'> make-moving-average <'> seconds->samples <'> samples->seconds
+ <'> oscil <'> partials->polynomial <'> partials->wave
+ <'> phase-partials->wave <'> phase-vocoder <'> pulse-train
+ <'> radians->degrees <'> radians->hz <'> rand <'> rand-interp
+ <'> readin <'> sawtooth-wave <'> nrxysin <'> nrxycos <'> square-wave
+ <'> src <'> ncos <'> nsin <'> table-lookup <'> tap <'> triangle-wave
+ <'> two-pole <'> two-zero <'> wave-train <'> ssb-am ) { clm-prcs-1 }
+ #( 1 make-array color-95 '( 1.0 ) ) each to arg
clm-prcs-1 each to prc
- arg prc #t nil fth-catch to tag
- stack-reset
+ arg prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg =
- tag car 'no-data = ||
- tag car 'no-such-method = ||
- tag car 'error = ||
- tag car 'arg-error = ||
- tag car 'bad-type = ||
- tag car 'out-of-range = || unless
- $" clm %s [%s]: %s" #( prc arg tag ) snd-display
- then
+ tag car 'wrong-type-arg <>
+ tag car 'no-data <> &&
+ tag car 'no-such-method <> &&
+ tag car 'bad-type <> &&
+ tag car 'error <> &&
+ tag car 'arg-error <> && if
+ "clm %s [%s]: %s" #( prc arg tag ) snd-display
+ then
then
end-each
end-each
- clm-prcs-1 each to prc
- make-oscil vct-5 prc #t nil fth-catch to tag
- stack-reset
+ #( <'> all-pass <'> array-interp <'> asymmetric-fm <'> comb
+ <'> filtered-comb <'> contrast-enhancement <'> convolution
+ <'> convolve <'> moving-average <'> convolve-files
+ <'> delay <'> dot-product <'> env-interp <'> file->sample
+ <'> snd->sample <'> filter <'> fir-filter <'> formant <'> firmant
+ <'> formant-bank <'> granulate <'> iir-filter <'> ina <'> inb
+ <'> locsig-ref <'> locsig-reverb-ref <'> make-all-pass
+ <'> make-asymmetric-fm <'> make-comb <'> make-filtered-comb
+ <'> make-delay <'> make-env <'> make-fft-window <'> make-filter
+ <'> make-fir-filter <'> make-formant <'> make-firmant
+ <'> make-granulate <'> make-iir-filter <'> make-locsig <'> make-notch
+ <'> make-one-pole <'> make-one-zero <'> make-oscil <'> make-phase-vocoder
+ <'> make-pulse-train <'> make-rand <'> make-rand-interp
+ <'> make-readin <'> make-sawtooth-wave <'> make-moving-average
+ <'> make-nrxysin <'> make-nrxycos <'> make-square-wave <'> make-src
+ <'> make-ncos <'> make-nsin <'> make-table-lookup <'> make-triangle-wave
+ <'> make-two-pole <'> make-two-zero <'> make-wave-train
+ <'> notch <'> one-pole <'> one-zero
+ <'> oscil <'> partials->polynomial <'> partials->wave
+ <'> make-polyshape <'> make-polywave <'> phase-partials->wave
+ <'> phase-vocoder <'> polynomial <'> pulse-train <'> rand <'> rand-interp
+ <'> rectangular->polar <'> rectangular->magnitudes <'> ring-modulate
+ <'> sawtooth-wave <'> nrxysin <'> nrxycos
+ <'> square-wave <'> src <'> ncos <'> nsin <'> table-lookup <'> tap
+ <'> triangle-wave <'> two-pole <'> two-zero <'> wave-train <'> ssb-am
+ <'> make-ssb-am ) each to prc
+ make-oscil vct-5 prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg =
- tag car 'bad-arity = ||
- tag car 'mus-error = || unless
- $" clm 1 %s [make-oscil]: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <>
+ tag car 'bad-arity <> &&
+ tag car 'error <> &&
+ tag car 'mus-error <> && if
+ "clm-1 %s [make-oscil]: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> mus-channel <'> mus-channels <'> mus-data
- <'> mus-feedback <'> mus-feedforward <'> mus-frequency
- <'> mus-hop <'> mus-increment <'> mus-length <'> mus-location
- <'> mus-mix <'> mus-name <'> mus-order <'> mus-phase <'> mus-ramp
- <'> mus-random <'> mus-run <'> mus-scaler <'> mus-xcoeffs <'> mus-ycoeffs ) each to prc
- \ FIXME
- \ 'out-of-range added
- make-oscil vector-0 prc #t nil fth-catch to tag
- stack-reset
+ #( <'> mus-channel <'> mus-channels <'> mus-data <'> mus-feedback
+ <'> mus-feedforward <'> mus-frequency <'> mus-hop <'> mus-increment
+ <'> mus-length <'> mus-location <'> mus-name <'> mus-order
+ <'> mus-phase <'> mus-ramp <'> mus-random <'> mus-run <'> mus-scaler
+ <'> mus-xcoeffs <'> mus-ycoeffs ) each to prc
+ make-oscil vector-0 prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg =
- tag car 'out-of-range = ||
- tag car 'error = || unless
- $" mus-gen %s [make-oscil]: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <>
+ tag car 'syntax-error <> &&
+ tag car 'error <> && if
+ "mus-gen %s [make-oscil]: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> mus-sound-samples <'> mus-sound-frames <'> mus-sound-duration <'> mus-sound-datum-size
- <'> mus-sound-data-location <'> mus-sound-chans <'> mus-sound-srate <'> mus-sound-header-type
- <'> mus-sound-data-format <'> mus-sound-length <'> mus-sound-type-specifier
- <'> mus-header-type-name
- <'> mus-data-format-name <'> mus-sound-comment <'> mus-sound-write-date
- <'> mus-bytes-per-sample
- <'> mus-sound-loop-info <'> mus-sound-maxamp <'> mus-sound-maxamp-exists?
+ #( <'> mus-sound-samples <'> mus-sound-framples <'> mus-sound-duration
+ <'> mus-sound-datum-size <'> mus-sound-data-location <'> mus-sound-chans
+ <'> mus-sound-srate <'> mus-sound-header-type <'> mus-sound-sample-type
+ <'> mus-sound-length <'> mus-sound-type-specifier
+ <'> mus-header-type-name <'> mus-sample-type-name <'> mus-sound-comment
+ <'> mus-sound-write-date <'> mus-bytes-per-sample
+ <'> mus-sound-loop-info <'> mus-sound-mark-info
+ <'> mus-sound-maxamp <'> mus-sound-maxamp-exists?
<'> mus-header-type->string
- <'> mus-data-format->string ) { mus-snd-prcs-1 }
+ <'> mus-sample-type->string ) { mus-snd-prcs-1 }
mus-snd-prcs-1 each to prc
- vct-5 prc #t nil fth-catch to tag
- stack-reset
+ vct-5 prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" mus-sound %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <> if
+ "mus-sound %s: %s" #( prc tag ) snd-display
then
then
end-each
mus-snd-prcs-1 each to prc
- prc #t nil fth-catch to tag
- stack-reset
+ prc snd-test-catch to tag
tag if
- tag car 'wrong-number-of-args = unless
- $" no arg mus-sound %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-number-of-args <>
+ tag car 'error <> && if
+ "no arg mus-sound %s: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> mus-sound-samples <'> mus-sound-frames <'> mus-sound-duration <'> mus-sound-datum-size
- <'> mus-sound-data-location <'> mus-sound-chans <'> mus-sound-srate <'> mus-sound-header-type
- <'> mus-sound-data-format <'> mus-sound-length <'> mus-sound-type-specifier
- <'> mus-sound-comment
- <'> mus-sound-write-date <'> mus-sound-maxamp <'> mus-sound-maxamp-exists? ) each to prc
- "/bad/baddy" prc #t nil fth-catch to tag
- stack-reset
+ #( <'> mus-sound-samples <'> mus-sound-framples <'> mus-sound-duration
+ <'> mus-sound-datum-size <'> mus-sound-data-location
+ <'> mus-sound-chans <'> mus-sound-srate <'> mus-sound-header-type
+ <'> mus-sound-sample-type <'> mus-sound-length
+ <'> mus-sound-type-specifier <'> mus-sound-comment
+ <'> mus-sound-write-date <'> mus-sound-maxamp
+ <'> mus-sound-maxamp-exists? ) each to prc
+ "/bad/baddy" prc snd-test-catch to tag
tag if
- tag car 'mus-error = unless
- $" bad file mus-sound %s: %s" #( prc tag ) snd-display
+ tag car 'mus-error <> if
+ "bad file mus-sound %s: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> count-matches <'> cursor <'> channel-properties <'> channel-property
- <'> with-tracking-cursor <'> cursor-position <'> cursor-size <'> cursor-style
- <'> tracking-cursor-style <'> delete-sample <'> display-edits <'> dot-size
- <'> edit-fragment <'> edit-position
- <'> edit-tree <'> edits <'> fft-window-alpha <'> fft-window-beta
- <'> fft-log-frequency <'> fft-log-magnitude <'> transform-size <'> transform-graph-type
- <'> fft-window <'> transform-graph? <'> find-channel <'> graph
- <'> graph-style <'> lisp-graph? <'> insert-sound
- <'> time-graph-style <'> lisp-graph-style <'> transform-graph-style <'> left-sample
- <'> map-chan <'> max-transform-peaks <'> maxamp-position <'> min-dB <'> mix-region
- <'> transform-normalization <'> peaks <'> reverse-sound
- <'> revert-sound <'> right-sample <'> sample <'> save-sound <'> save-sound-as
- <'> scan-chan <'> select-channel <'> show-axes <'> show-transform-peaks
- <'> show-marks <'> show-mix-waveforms <'> show-y-zero <'> show-grid
- <'> show-sonogram-cursor <'> spectrum-end <'> spectro-hop <'> spectrum-start
- <'> spectro-x-angle <'> spectro-x-scale <'> spectro-y-angle <'> grid-density
- <'> spectro-y-scale <'> spectro-z-angle <'> spectro-z-scale <'> squelch-update
- <'> transform-sample <'> transform->vct <'> transform-frames <'> transform-type
- <'> update-transform-graph <'> update-time-graph <'> update-lisp-graph <'> update-sound
- <'> wavelet-type <'> time-graph? <'> time-graph-type <'> wavo-hop
- <'> wavo-trace <'> x-bounds <'> x-position-slider <'> x-zoom-slider
- <'> x-axis-label <'> y-axis-label <'> y-bounds <'> y-position-slider
- <'> y-zoom-slider <'> zero-pad ) { chn-prcs }
+ "/bad/baddy" mus-sound-forget drop
+ #( <'> channel-widgets <'> cursor <'> channel-properties
+ <'> channel-property <'> cursor-position
+ <'> cursor-size <'> cursor-style <'> tracking-cursor-style
+ <'> delete-sample <'> display-edits <'> dot-size <'> edit-fragment
+ <'> edit-position <'> edit-tree <'> edits <'> fft-window-alpha
+ <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude
+ <'> fft-with-phases <'> transform-size <'> transform-graph-type
+ <'> fft-window <'> transform-graph? <'> graph
+ <'> graph-style <'> lisp-graph? <'> insert-sound <'> time-graph-style
+ <'> lisp-graph-style <'> transform-graph-style
+ <'> left-sample <'> make-graph-data <'> map-chan <'> max-transform-peaks
+ <'> maxamp-position <'> min-dB <'> mix-region
+ <'> transform-normalization <'> peaks <'> position->x <'> position->y
+ <'> reverse-sound <'> revert-sound <'> right-sample <'> sample
+ <'> save-sound <'> save-sound-as <'> select-channel
+ <'> show-axes <'> show-transform-peaks <'> show-marks
+ <'> show-mix-waveforms <'> show-y-zero <'> show-grid
+ <'> show-sonogram-cursor <'> spectrum-end <'> spectro-hop
+ <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale
+ <'> spectro-y-angle <'> grid-density <'> spectro-y-scale
+ <'> spectro-z-angle <'> spectro-z-scale <'> squelch-update
+ <'> transform-sample <'> transform->vct <'> transform-framples
+ <'> transform-type <'> update-transform-graph <'> update-time-graph
+ <'> update-lisp-graph <'> update-sound <'> wavelet-type <'> time-graph?
+ <'> time-graph-type <'> wavo-hop <'> wavo-trace <'> x-bounds
+ <'> x-position-slider <'> x-zoom-slider <'> x-axis-label <'> y-axis-label
+ <'> y-bounds <'> y-position-slider <'> y-zoom-slider
+ <'> zero-pad ) { chn-prcs }
chn-prcs each to prc
- vct-5 prc #t nil fth-catch to tag
- stack-reset
+ vct-5 prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg =
- tag car 'no-such-sound = || unless
- $" chn (no snd) procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <>
+ tag car 'error <> &&
+ tag car 'no-such-sound <> && if
+ "chn (no snd) procs %s: %s" #( prc tag ) snd-display
then
then
end-each
- chn-prcs each to prc
- 0 vct-5 prc #t nil fth-catch to tag
- stack-reset
+ chn-prcs <'> combined-data-color array-push each to prc
+ 0 vct-5 prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" chn (no chn) procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <> if
+ "chn (no chn) procs %s: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> cursor <'> with-tracking-cursor <'> channel-properties <'> channel-property
- <'> cursor-position <'> cursor-size <'> cursor-style <'> tracking-cursor-style
- <'> delete-sample <'> display-edits <'> dot-size <'> edit-fragment
- <'> edit-position <'> edit-tree <'> edits <'> env-sound
- <'> fft-window-alpha <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude
- <'> transform-size <'> transform-graph-type <'> fft-window <'> transform-graph?
- <'> filter-sound <'> graph-style <'> lisp-graph?
- <'> left-sample <'> time-graph-style <'> lisp-graph-style
- <'> transform-graph-style <'> max-transform-peaks <'> maxamp
- <'> maxamp-position <'> min-dB <'> transform-normalization
- <'> redo <'> reverse-sound <'> revert-sound <'> right-sample
- <'> sample <'> save-sound <'> scale-by <'> scale-to
- <'> show-axes <'> show-transform-peaks <'> show-marks <'> show-mix-waveforms
- <'> show-y-zero <'> show-grid <'> show-sonogram-cursor <'> spectrum-end
- <'> spectro-hop <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale
- <'> spectro-y-angle <'> spectro-y-scale <'> spectro-z-angle <'> spectro-z-scale
- <'> squelch-update <'> grid-density <'> src-sound <'> transform-sample
- <'> transform->vct <'> transform-frames <'> transform-type <'> undo
- <'> update-transform-graph <'> update-time-graph <'> update-lisp-graph <'> update-sound
- <'> wavelet-type <'> time-graph? <'> time-graph-type <'> wavo-hop
- <'> wavo-trace <'> x-bounds <'> x-position-slider <'> normalize-channel
- <'> x-zoom-slider <'> y-bounds <'> y-position-slider
- <'> x-axis-label <'> y-axis-label <'> y-zoom-slider
- <'> zero-pad <'> scale-channel ) each to prc
- 1234 prc #t nil fth-catch to tag
- stack-reset
+ #( <'> channel-widgets <'> cursor <'> channel-properties
+ <'> cursor-position <'> cursor-size <'> cursor-style
+ <'> tracking-cursor-style <'> display-edits <'> dot-size <'> edit-position
+ <'> edit-tree <'> edits <'> env-sound <'> fft-window-alpha
+ <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude
+ <'> fft-with-phases <'> transform-size <'> transform-graph-type
+ <'> fft-window <'> transform-graph? <'> filter-sound <'> graph-data
+ <'> graph-style <'> lisp-graph? <'> left-sample <'> time-graph-style
+ <'> lisp-graph-style <'> transform-graph-style <'> make-graph-data
+ <'> max-transform-peaks <'> maxamp <'> maxamp-position <'> min-dB
+ <'> transform-normalization <'> reverse-sound <'> revert-sound
+ <'> right-sample <'> save-sound <'> scale-by <'> scale-to
+ <'> show-axes <'> show-transform-peaks <'> show-marks
+ <'> show-mix-waveforms <'> show-y-zero <'> show-grid
+ <'> show-sonogram-cursor <'> spectrum-end <'> spectro-hop
+ <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale
+ <'> spectro-y-angle <'> spectro-y-scale <'> spectro-z-angle
+ <'> spectro-z-scale <'> squelch-update <'> grid-density <'> src-sound
+ <'> transform->vct <'> transform-framples <'> transform-type
+ <'> update-transform-graph <'> update-time-graph <'> update-lisp-graph
+ <'> update-sound <'> wavelet-type <'> time-graph? <'> time-graph-type
+ <'> wavo-hop <'> wavo-trace <'> x-bounds <'> x-position-slider
+ <'> x-zoom-slider <'> y-bounds <'> y-position-slider <'> x-axis-label
+ <'> y-axis-label <'> y-zoom-slider <'> zero-pad ) each to prc
+ 1234 integer->sound prc snd-test-catch to tag
tag if
- tag car 'no-such-sound = unless
- $" chn procs %s: %s" #( prc tag ) snd-display
+ tag car 'no-such-sound <> if
+ "chn procs %s: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> delete-sample <'> edit-fragment <'> graph-style
- <'> redo <'> time-graph-style <'> lisp-graph-style
- <'> transform-graph-style <'> scale-by <'> scale-to <'> undo <'> x-axis-label ) { prcs-3 }
- prcs-3 each to prc
- 0 1234 prc #t nil fth-catch to tag
- stack-reset
+ #( <'> delete-sample <'> edit-fragment <'> graph-data <'> graph-style
+ <'> play <'> position->x <'> position->y <'> redo
+ <'> time-graph-style <'> lisp-graph-style <'> transform-graph-style
+ <'> scale-by <'> scale-to <'> undo <'> x->position <'> y->position
+ <'> x-axis-label ) each to prc
+ 0 1234 prc snd-test-catch to tag
tag if
- tag car 'no-such-sound = unless
- $" snd(1) chn procs %s: %s" #( prc tag ) snd-display
+ tag car 'no-such-sound <> if
+ "snd(1) chn procs %s: %s" #( prc tag ) snd-display
then
then
end-each
"oboe.snd" open-sound to ind
- prcs-3 each to prc
- prc proc-name "x-axis-label" string= unless
- 0 ind 1234 prc #t nil fth-catch to tag
- stack-reset
+ #( <'> delete-sample <'> edit-fragment <'> graph-data <'> position->x
+ <'> position->y <'> redo <'> scale-by <'> scale-to <'> undo
+ <'> x->position <'> y->position ) each to prc
+ prc proc-name "x-axis-label" string<> if
+ 0 ind 1234 prc snd-test-catch to tag
tag if
- tag car 'no-such-channel = unless
- $" snd(1 1234) chn procs %s: %s" #( prc tag ) snd-display
- then
+ tag car 'no-such-channel <> if
+ "snd(1 1234) chn procs %s: %s" #( prc tag ) snd-display
+ then
then
then
end-each
ind close-sound drop
+ "oboe.snd" find-sound sound? if
+ "oboe.snd is still open?" #() snd-display
+ then
"oboe.snd" open-sound to ind
- #( <'> cursor <'> cursor-position <'> cursor-size
+ #( <'> channel-widgets <'> cursor <'> cursor-position <'> cursor-size
<'> cursor-style <'> tracking-cursor-style <'> display-edits <'> dot-size
<'> edit-position <'> edit-tree <'> edits <'> fft-window-alpha
- <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude <'> transform-size
- <'> transform-graph-type <'> fft-window <'> transform-graph? <'> graph-style
- <'> lisp-graph? <'> left-sample <'> time-graph-style <'> lisp-graph-style
- <'> transform-graph-style <'> max-transform-peaks <'> maxamp
- <'> maxamp-position <'> min-dB <'> transform-normalization
- <'> reverse-sound <'> right-sample <'> show-axes <'> show-transform-peaks
- <'> show-marks <'> show-mix-waveforms <'> show-y-zero <'> show-grid
- <'> show-sonogram-cursor <'> grid-density <'> spectrum-end <'> spectro-hop
- <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale <'> spectro-y-angle
- <'> spectro-y-scale <'> spectro-z-angle <'> spectro-z-scale <'> squelch-update
- <'> transform->vct <'> transform-frames <'> transform-type <'> update-transform-graph
- <'> update-time-graph <'> update-lisp-graph <'> wavelet-type <'> time-graph?
- <'> time-graph-type <'> wavo-hop <'> wavo-trace <'> x-bounds
- <'> x-position-slider <'> x-axis-label <'> x-zoom-slider <'> y-bounds
- <'> y-position-slider <'> y-zoom-slider <'> zero-pad
- <'> channel-properties <'> channel-property ) each to prc
- ind 1234 prc #t nil fth-catch to tag
- stack-reset
+ <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude
+ <'> fft-with-phases <'> transform-size <'> transform-graph-type
+ <'> fft-window <'> transform-graph? <'> graph-style <'> lisp-graph?
+ <'> left-sample <'> time-graph-style <'> lisp-graph-style
+ <'> transform-graph-style <'> combined-data-color <'> make-graph-data
+ <'> max-transform-peaks <'> maxamp <'> maxamp-position <'> min-dB
+ <'> transform-normalization <'> reverse-sound <'> right-sample
+ <'> show-axes <'> show-transform-peaks <'> show-marks
+ <'> show-mix-waveforms <'> show-y-zero <'> show-grid
+ <'> show-sonogram-cursor <'> grid-density <'> spectrum-end
+ <'> spectro-hop <'> spectrum-start <'> spectro-x-angle
+ <'> spectro-x-scale <'> spectro-y-angle <'> spectro-y-scale
+ <'> spectro-z-angle <'> spectro-z-scale <'> squelch-update
+ <'> transform->vct <'> transform-framples <'> transform-type
+ <'> update-transform-graph <'> update-time-graph <'> update-lisp-graph
+ <'> wavelet-type <'> time-graph? <'> time-graph-type <'> wavo-hop
+ <'> wavo-trace <'> x-bounds <'> x-position-slider <'> x-axis-label
+ <'> x-zoom-slider <'> y-bounds <'> y-position-slider <'> y-zoom-slider
+ <'> zero-pad <'> channel-properties <'> channel-property ) each to prc
+ ind 1234 prc snd-test-catch to tag
tag if
- tag car 'no-such-sound =
- tag car 'no-such-channel = || unless
- $" chn (2) procs %s: %s" #( prc tag ) snd-display
+ tag car 'no-such-channel <>
+ tag car 'no-such-sound <> && if
+ "chn (2) procs %s: %s" #( prc tag ) snd-display
then
then
end-each
ind close-sound drop
+ "oboe.snd" find-sound sound? if
+ "oboe.snd is still open?" #() snd-display
+ then
"oboe.snd" open-sound to ind
- chn-prcs each to prc
- vct-5 ind 0 prc set-xt #t nil fth-catch to tag
- stack-reset
+ #( <'> channel-widgets <'> cursor <'> cursor-position <'> display-edits
+ <'> dot-size <'> edit-tree <'> edits <'> fft-window-alpha
+ <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude
+ <'> fft-with-phases <'> transform-size <'> transform-graph-type
+ <'> fft-window <'> transform-graph? <'> graph-style <'> lisp-graph?
+ <'> left-sample <'> make-graph-data <'> max-transform-peaks <'> maxamp
+ <'> maxamp-position <'> lisp-graph-style <'> transform-graph-style
+ <'> make-graph-data <'> combined-data-color <'> min-dB
+ <'> transform-normalization <'> reverse-sound <'> right-sample
+ <'> show-axes <'> grid-density <'> show-transform-peaks <'> show-marks
+ <'> show-mix-waveforms <'> show-y-zero <'> show-grid
+ <'> show-sonogram-cursor <'> spectrum-end <'> spectro-hop
+ <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale
+ <'> spectro-y-angle <'> spectro-y-scale <'> spectro-z-angle
+ <'> spectro-z-scale <'> squelch-update <'> transform->vct
+ <'> transform-framples <'> transform-type <'> update-transform-graph
+ <'> update-time-graph <'> update-lisp-graph <'> wavelet-type
+ <'> time-graph? <'> time-graph-type <'> wavo-hop <'> wavo-trace
+ <'> x-bounds <'> x-position-slider <'> x-zoom-slider <'> y-bounds
+ <'> y-position-slider <'> y-zoom-slider <'> zero-pad
+ <'> x-axis-label ) each to prc
+ vct-5 ind 0 prc set-xt snd-test-catch to tag
tag if
- tag car 'no-such-sound =
- tag car 'wrong-type-arg = || unless
- $" set chn procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <>
+ tag car 'syntax-error <> &&
+ tag car 'error <> && if
+ "set chn procs %s: %s" #( prc tag ) snd-display
then
then
end-each
ind close-sound drop
- #( <'> mix-amp <'> mix-amp-env <'> mix-length <'> mix-name
+ "oboe.snd" find-sound sound? if
+ "oboe.snd is still open?" #() snd-display
+ then
+ #( <'> mix-amp <'> mix-length <'> mix-name
<'> mix-position <'> mix-home <'> mix-speed <'> mix-tag-y ) { mix-prcs }
- mix-prcs each to prc
- vct-5 prc #t nil fth-catch to tag
- stack-reset
+ mix-prcs #( <'> mix-amp-env ) array-append each to prc
+ vct-5 prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" [0] mix procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <>
+ tag car 'syntax-error <> &&
+ tag car 'error <> && if
+ "[0] mix procs %s: %s" #( prc tag ) snd-display
then
then
end-each
mix-prcs each to prc
- 1234 integer->mix prc #t nil fth-catch to tag
- stack-reset
+ 1234 integer->mix prc snd-test-catch to tag
tag if
- tag car 'no-such-mix = unless
- $" [1] mix procs %s: %s" #( prc tag ) snd-display
+ tag car 'no-such-mix <> if
+ "[1] mix procs %s: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> mix-name <'> mix-position <'> mix-home <'> mix-speed <'> mix-tag-y ) { mix-set-prcs }
+ #( <'> mix-name <'> mix-position <'> mix-home <'> mix-speed
+ <'> mix-tag-y ) { mix-set-prcs }
mix-set-prcs each to prc
- 1234 integer->mix vct-5 prc set-xt #t nil fth-catch to tag
- stack-reset
+ 1234 integer->mix vct-5 prc set-xt snd-test-catch to tag
tag if
- tag car 'wrong-type-arg =
- tag car 'no-such-mix = || unless
- $" [2] set mix procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <>
+ tag car 'syntax-error <> &&
+ tag car 'error <> &&
+ tag car 'no-such-mix <> && if
+ "[2] set mix procs %s: %s" #( prc tag ) snd-display
then
then
end-each
"oboe.snd" open-sound to ind
"oboe.snd" 10 mix-sound { id }
mix-set-prcs each to prc
- id vct-5 prc set-xt #t nil fth-catch to tag
- stack-reset
+ id vct-5 prc set-xt snd-test-catch to tag
tag if
- tag car 'wrong-type-arg =
- tag car 'no-such-mix = || unless
- $" [3] set mix procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <>
+ tag car 'syntax-error <> &&
+ tag car 'error <> && if
+ "[3] set mix procs %s: %s" #( prc tag ) snd-display
then
then
end-each
ind close-sound drop
+ "oboe.snd" find-sound sound? if
+ "oboe.snd is still open?" #() snd-display
+ then
#( <'> add-mark <'> mark-name <'> mark-sample <'> mark-sync
<'> mark-home <'> delete-mark <'> delete-marks <'> find-mark ) each to prc
- vct-5 prc #t nil fth-catch to tag
- stack-reset
+ vct-5 prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" mark procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <> if
+ "mark procs %s: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> mark-name <'> mark-sample <'> mark-sync <'> mark-home <'> delete-mark ) each to prc
- 1234 integer->mark prc #t nil fth-catch to tag
- stack-reset
+ #( <'> mark-name <'> mark-sample <'> mark-sync <'> mark-home
+ <'> delete-mark ) each to prc
+ 1234 integer->mark prc snd-test-catch to tag
tag if
- tag car 'no-such-mark = unless
- $" no mark procs %s: %s" #( prc tag ) snd-display
+ tag car 'no-such-mark <> if
+ "no mark procs %s: %s" #( prc tag ) snd-display
then
then
end-each
"oboe.snd" open-sound to ind
0 ind 0 add-mark to id
#( <'> mark-name <'> mark-sample <'> mark-sync ) each to prc
- id vct-5 prc set-xt #t nil fth-catch to tag
- stack-reset
+ id vct-5 prc set-xt snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" set mark procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <> if
+ "set mark procs %s: %s" #( prc tag ) snd-display
then
then
end-each
ind close-sound drop
- \ region-sample, initially here, requires two args
- #( <'> region-chans <'> region-home <'> region-frames
+ "oboe.snd" find-sound sound? if
+ "oboe.snd is still open?" #() snd-display
+ then
+ #( <'> region-chans <'> region-home <'> region-framples
<'> region-position <'> region-maxamp <'> region-maxamp-position
<'> region-srate <'> forget-region ) { reg-prcs-1 }
- #( vct-5 #( 0 1 ) #() "hiho" #( 0 1 ) ) each to arg
- reg-prcs-1 each to prc
- arg prc #t nil fth-catch to tag
- stack-reset
+ #( vct-5 #( 0 1 ) 0+i "hiho" '( 0 1 ) ) each to arg
+ reg-prcs-1 #( <'> region-sample <'> region->vct ) array-append each to prc
+ arg prc snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" region procs %s [%s]: %s" #( prc arg tag ) snd-display
- then
+ tag car 'wrong-type-arg <>
+ tag car 'wrong-number-of-args <> && if
+ "region procs %s [%s]: %s" #( prc arg tag ) snd-display
+ then
then
end-each
end-each
@@ -8250,360 +7283,435 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
1234 integer->region prc #t nil fth-catch to tag
stack-reset
tag if
- tag car 'no-such-region = unless
- $" (no) region procs %s: %s" #( prc tag ) snd-display
+ tag car 'no-such-region <> if
+ "(no) region procs %s: %s" #( prc tag ) snd-display
then
then
end-each
- #( <'> enved-filter-order <'> enved-filter
- <'> ask-before-overwrite <'> auto-resize <'> auto-update
- <'> show-full-duration <'> initial-beg <'> initial-dur <'> channel-style
- <'> dac-combines-channels <'> dac-size <'> clipping
- <'> default-output-chans <'> default-output-data-format <'> default-output-srate
- <'> default-output-header-type
+ #( <'> axis-color <'> enved-filter-order <'> enved-filter
+ <'> filter-control-waveform-color <'> ask-before-overwrite
+ <'> ask-about-unsaved-edits <'> auto-resize <'> auto-update
+ <'> axis-label-font <'> axis-numbers-font <'> basic-color <'> bind-key
+ <'> show-full-duration <'> show-full-range <'> initial-beg <'> initial-dur
+ <'> channel-style <'> color-cutoff <'> color-orientation-dialog
+ <'> color-inverted <'> color-scale <'> cursor-color
+ <'> dac-combines-channels <'> dac-size <'> clipping <'> data-color
+ <'> default-output-chans <'> default-output-sample-type
+ <'> default-output-srate <'> default-output-header-type
<'> enved-envelope <'> enved-base <'> enved-clip? <'> enved-in-dB
- <'> enved-dialog <'> enved-style <'> enved-power <'> enved-target
- <'> enved-wave? <'> eps-file <'> eps-left-margin
- <'> eps-bottom-margin <'> eps-size
- <'> graph-cursor <'> listener-prompt
- <'> max-regions <'> minibuffer-history-length <'> mix-waveform-height <'> region-graph-style
- <'> time-graph-style <'> lisp-graph-style <'> transform-graph-style
- <'> view-files-sort <'> print-length
- <'> ladspa-dir <'> peak-env-dir <'> save-dir
- <'> save-state-file <'> selected-channel
- <'> selected-sound <'> selection-creates-region <'> show-controls
- <'> show-indices <'> show-selection-transform <'> sinc-width
- <'> temp-dir <'> trap-segfault
- <'> with-file-monitor <'> optimization <'> with-verbose-cursor
- <'> with-inset-graph <'> with-pointer-focus <'> window-height <'> beats-per-measure
- <'> with-smpte-label <'> with-toolbar <'> with-tooltips <'> with-menu-icons
- <'> remember-sound-state <'> save-as-dialog-src <'> save-as-dialog-auto-comment
- <'> window-width <'> window-x <'> window-y <'> with-gl
- <'> with-mix-tags <'> x-axis-style <'> beats-per-minute
- <'> mix-tag-height <'> mix-tag-width <'> with-relative-panes
- <'> clm-table-size <'> mark-tag-width <'> mark-tag-height ) each to prc
- vct-5 prc set-xt #t nil fth-catch to tag
- stack-reset
+ <'> enved-dialog <'> enved-style <'> enved-power <'> enved-target
+ <'> enved-waveform-color <'> enved-wave? <'> eps-file <'> eps-left-margin
+ <'> eps-bottom-margin <'> eps-size <'> foreground-color <'> graph-color
+ <'> graph-cursor <'> highlight-color <'> just-sounds <'> key-binding
+ <'> listener-color <'> listener-font <'> listener-prompt
+ <'> listener-text-color <'> max-regions <'> mix-waveform-height
+ <'> region-graph-style <'> position-color <'> time-graph-style
+ <'> lisp-graph-style <'> transform-graph-style <'> peaks-font
+ <'> bold-peaks-font <'> print-length
+ <'> play-arrow-size <'> sash-color <'> ladspa-dir <'> peak-env-dir
+ <'> save-dir <'> save-state-file <'> selected-channel
+ <'> selected-data-color <'> selected-graph-color <'> selected-sound
+ <'> selection-creates-region <'> show-controls <'> show-indices
+ <'> show-listener <'> show-selection-transform <'> sinc-width <'> temp-dir
+ <'> text-focus-color <'> tiny-font <'> with-file-monitor
+ <'> unbind-key <'> with-verbose-cursor
+ <'> with-inset-graph <'> with-interrupts <'> with-pointer-focus
+ <'> window-height <'> beats-per-measure <'> with-smpte-label
+ <'> with-toolbar <'> with-tooltips <'> with-menu-icons
+ <'> remember-sound-state <'> save-as-dialog-src
+ <'> save-as-dialog-auto-comment <'> window-width <'> window-x
+ <'> window-y <'> with-gl <'> with-mix-tags <'> x-axis-style
+ <'> beats-per-minute <'> zoom-color <'> mix-tag-height <'> mix-tag-width
+ <'> with-relative-panes <'> clm-table-size <'> clm-default-frequency
+ <'> mark-tag-width <'> mark-tag-height ) each to prc
+ vct-5 prc set-xt snd-test-catch to tag
tag if
- tag car 'wrong-type-arg = unless
- $" misc procs %s: %s" #( prc tag ) snd-display
+ tag car 'wrong-type-arg <>
+ tag car 'syntax-error <> &&
+ tag car 'error <> && if
+ "misc procs %s: %s" #( prc tag ) snd-display
then
then
end-each
nil { hook }
snd-hooks each to hook
- hook <'> noop 0 make-proc <'> add-hook! #t nil fth-catch to tag
- stack-reset
+ hook <'> noop 0 make-proc <'> add-hook! snd-test-catch to tag
tag if
- \ FIXME
- \ FTH special 'bad-arity (add-hook!) [ms]
- tag car 'bad-arity =
- tag car 'wrong-type-arg = || unless
- $" [0] hooks %s: %s" #( hook hook-name tag ) snd-display
+ \ XXX: FTH special 'bad-arity (add-hook!) [ms]
+ tag car 'bad-arity <>
+ tag car 'wrong-type-arg <> && if
+ "[0] hooks %s: %s" #( hook hook-name tag ) snd-display
then
then
end-each
reset-almost-all-hooks
- #( <'> exit-hook <'> stop-dac-hook <'> stop-playing-selection-hook <'> color-hook
- <'> orientation-hook <'> start-playing-selection-hook ) each to hook
+ #( <'> exit-hook <'> stop-playing-selection-hook
+ <'> color-hook <'> orientation-hook
+ <'> start-playing-selection-hook ) each to hook
hook <'> noop 3 make-proc <'> add-hook! #t nil fth-catch to tag
stack-reset
tag if
- \ FIXME
- \ FTH special 'bad-arity (add-hook!) [ms]
- tag car 'bad-arity =
- tag car 'wrong-type-arg = || unless
- $" [1] hooks %s: %s" #( hook hook-name tag ) snd-display
+ \ XXX: FTH special 'bad-arity (add-hook!) [ms]
+ tag car 'bad-arity <>
+ tag car 'wrong-type-arg <> && if
+ "[1] hooks %s: %s" #( hook hook-name tag ) snd-display
then
then
end-each
reset-almost-all-hooks
- "not-an-env" <'> set-enved-envelope 'no-such-envelope check-error-tag
- "/bad/baddy" <'> save-envelopes 'cannot-save check-error-tag
- "/bad/baddy" <'> save-macros 'cannot-save check-error-tag
- "/bad/baddy" <'> mus-sound-report-cache 'cannot-save check-error-tag
- <'> noop 3 make-proc <'> set-search-procedure 'bad-arity check-error-tag
- 1234 <'> noop 1 make-proc <'> set-search-procedure 'no-such-sound check-error-tag
- 0 "oboe.snd" 1 <'> make-sampler 'no-such-channel check-error-tag
- 0 "oboe.snd" -1 <'> make-sampler 'no-such-channel check-error-tag
- <'> noop 1 make-proc <'> set-zoom-focus-style 'bad-arity check-error-tag
- 1 1.0 make-mixer { mx }
- "oboe.snd" "pistol.snd" 0 12 0 mx $" a string" <'> mus-mix 'wrong-type-arg check-error-tag
- :file "test.snd" new-sound to ind
- "test.snd" sf-dir "bad_chans.aifc" $+ <'> mus-mix 'bad-header check-error-tag
- "test.snd" sf-dir "bad_length.aifc" $+ <'> mus-mix 'mus-error check-error-tag
- ind close-sound drop
- "test.snd" file-delete
- sf-dir "bad_chans.aifc" $+ "oboe.snd" <'> mus-mix 'bad-header check-error-tag
- 123 #( 0 0 1 1 ) <'> set-sound-loop-info 'no-such-sound check-error-tag
- "fmv.snd" mus-nist mus-bfloat 22050 2 "comment" <'> new-sound 'bad-header check-error-tag
- 123 <'> player-home 'wrong-type-arg check-error-tag
- "/hiho" <'> set-temp-dir 'no-such-file check-error-tag
- "/hiho" <'> set-save-dir 'no-such-file check-error-tag
- 20 integer->transform 4 0.0 make-vct <'> snd-transform 'out-of-range check-error-tag
- sf-dir "bad_chans.aifc" $+ <'> mus-sound-maxamp 'bad-header check-error-tag
- sf-dir "bad_chans.snd" $+ #( 0.0 0.0 ) <'> set-mus-sound-maxamp 'bad-header check-error-tag
- :order 32 :ycoeffs 4 0.0 make-vct <'> make-iir-filter 'mus-error check-error-tag
- :coeffs 4 0 make-vct :ycoeffs 4 0 make-vct <'> make-iir-filter 'mus-error check-error-tag
- :coeffs 4 0 make-vct :xcoeffs 4 0 make-vct <'> make-fir-filter 'mus-error check-error-tag
- :size 123456789 <'> make-table-lookup 'out-of-range check-error-tag
- :ramp -0.5 <'> make-granulate 'out-of-range check-error-tag
- :ramp 1.5 <'> make-granulate 'out-of-range check-error-tag
- :expansion 32000.0 <'> make-granulate 'mus-error check-error-tag
- "test.snd" :channels 0 <'> new-sound 'out-of-range check-error-tag
- "test.snd" :srate 0 <'> new-sound 'out-of-range check-error-tag
- "test.snd" :size -1 <'> new-sound 'out-of-range check-error-tag
- "test.snd" :size 0 <'> make-readin 'out-of-range check-error-tag
- "test.snd" :size -1 <'> make-readin 'out-of-range check-error-tag
- "oboe.snd" 0 <'> make-file->sample 'out-of-range check-error-tag
- "oboe.snd" -1 <'> make-file->sample 'out-of-range check-error-tag
- "oboe.snd" 0 <'> make-file->frame 'out-of-range check-error-tag
- "oboe.snd" -1 <'> make-file->frame 'out-of-range check-error-tag
- -1 <'> set-default-output-data-format 'out-of-range check-error-tag
- mus-soundfont <'> set-default-output-header-type 'out-of-range check-error-tag
- sf-dir "bad_location.nist" $+ <'> mus-sound-chans 'mus-error check-error-tag
- sf-dir "bad_field.nist" $+ <'> mus-sound-chans 'mus-error check-error-tag
+ #f set-ask-about-unsaved-edits drop
+ #f set-remember-sound-state drop
+ "not-an-env" <'> set-enved-envelope 'no-such-envelope check-error-tag
+ "/bad/baddy" <'> save-envelopes 'cannot-save check-error-tag
+ "/bad/baddy" <'> mus-sound-report-cache 'cannot-save check-error-tag
+ <'> noop 3 make-proc <'> set-search-procedure 'bad-arity check-error-tag
+ 0 "oboe.snd" 1 <'> make-sampler 'no-such-channel check-error-tag
+ 0 "oboe.snd" -1 <'> make-sampler 'no-such-channel check-error-tag
+ <char> p 0 <'> noop 2 make-proc <'> bind-key 'bad-arity check-error-tag
+ <'> noop 1 make-proc <'> set-zoom-focus-style 'bad-arity check-error-tag
+ 123 #( 0 0 1 1 ) <'> set-sound-loop-info 'no-such-sound check-error-tag
+ "fmv.snd" 2 22050 mus-bfloat mus-nist "comment" <'> new-sound 'bad-header
+ check-error-tag
+ 123 <'> player-home 'wrong-type-arg check-error-tag
+ "/hiho" <'> set-temp-dir 'no-such-file check-error-tag
+ "/hiho" <'> set-save-dir 'no-such-file check-error-tag
+ 20 integer->transform 4 0.0 make-vct <'> snd-transform 'out-of-range
+ check-error-tag
+ sf-dir "bad_chans.snd" $+ <'> mus-sound-maxamp 'bad-header check-error-tag
+ :order 32 :ycoeffs 4 0.0 make-vct <'> make-iir-filter 'mus-error
+ check-error-tag
+ :coeffs 4 0 make-vct :ycoeffs 4 0 make-vct <'> make-iir-filter 'mus-error
+ check-error-tag
+ :coeffs 4 0 make-vct :xcoeffs 4 0 make-vct <'> make-fir-filter 'mus-error
+ check-error-tag
+ :size 123456789 <'> make-table-lookup 'out-of-range check-error-tag
+ :ramp -0.5 <'> make-granulate 'out-of-range check-error-tag
+ :ramp 1.5 <'> make-granulate 'out-of-range check-error-tag
+ :expansion 32000.0 <'> make-granulate 'mus-error check-error-tag
+ "test.snd" :channels 0 <'> new-sound 'out-of-range check-error-tag
+ "test.snd" :srate 0 <'> new-sound 'out-of-range check-error-tag
+ "test.snd" :size -1 <'> new-sound 'out-of-range check-error-tag
+ "test.snd" :size 0 <'> make-readin 'out-of-range check-error-tag
+ "test.snd" :size -1 <'> make-readin 'out-of-range check-error-tag
+ "oboe.snd" 0 <'> make-file->sample 'out-of-range check-error-tag
+ "oboe.snd" -1 <'> make-file->sample 'out-of-range check-error-tag
+ "oboe.snd" 0 <'> make-file->frample 'out-of-range check-error-tag
+ "oboe.snd" -1 <'> make-file->frample 'out-of-range check-error-tag
+ -1 <'> set-default-output-sample-type 'out-of-range check-error-tag
+ mus-soundfont <'> set-default-output-header-type 'out-of-range check-error-tag
+ sf-dir "bad_location.nist" $+ <'> mus-sound-chans 'mus-error check-error-tag
+ sf-dir "bad_field.nist" $+ <'> mus-sound-chans 'mus-error check-error-tag
snd-motif-error-checks
- -1 <'> main-menu 'no-such-menu check-error-tag
- 111 <'> main-menu 'no-such-menu check-error-tag
- "hiho" 123 <'> new-sound 'out-of-range check-error-tag
- "hiho" mus-nist 123 <'> new-sound 'out-of-range check-error-tag
- "hiho" mus-nist mus-bfloat <'> new-sound 'bad-header check-error-tag
- 0 1 <'> make-sound-data 'out-of-range check-error-tag
- -2 1 <'> make-sound-data 'out-of-range check-error-tag
- 1 -1 <'> make-sound-data 'out-of-range check-error-tag
- 1 0 <'> make-sound-data 'out-of-range check-error-tag
- 0 1 <'> mus-sound-close-output 'out-of-range check-error-tag
- 1 1 <'> mus-sound-close-output 'out-of-range check-error-tag
- 2 1 <'> mus-sound-close-output 'out-of-range check-error-tag
- 0 <'> mus-sound-close-input 'out-of-range check-error-tag
- 1 <'> mus-sound-close-input 'out-of-range check-error-tag
- 2 <'> mus-sound-close-input 'out-of-range check-error-tag
- -1 <'> set-mus-array-print-length 'out-of-range check-error-tag
- -1 <'> set-print-length 'out-of-range check-error-tag
- -1 <'> set-play-arrow-size 'out-of-range check-error-tag
- 12 <'> set-enved-style 'out-of-range check-error-tag
- 1.5 0.0 0.0 <'> make-color 'out-of-range check-error-tag
- -0.5 0.0 0.0 <'> make-color 'out-of-range check-error-tag
- #f <'> make-variable-graph 'wrong-type-arg check-error-tag
- <'> graph->ps 'cannot-print check-error-tag
+ -1 <'> main-menu 'no-such-menu check-error-tag
+ 111 <'> main-menu 'no-such-menu check-error-tag
+ "hiho" :header-type 123 <'> new-sound 'out-of-range check-error-tag
+ "hiho" :header-type mus-nist :sample-type 123 <'> new-sound 'out-of-range check-error-tag
+ "hiho" :header-type mus-nist :sample-type mus-bfloat <'> new-sound 'bad-header check-error-tag
+ -1 <'> set-mus-array-print-length 'out-of-range check-error-tag
+ -1 <'> set-print-length 'out-of-range check-error-tag
+ -1 <'> set-play-arrow-size 'out-of-range check-error-tag
+ 12 <'> set-enved-style 'out-of-range check-error-tag
+ 1.5 0.0 0.0 <'> make-color 'out-of-range check-error-tag
+ -0.5 0.0 0.0 <'> make-color 'out-of-range check-error-tag
+ #f <'> make-variable-graph 'wrong-type-arg check-error-tag
+ <'> graph->ps 'cannot-print check-error-tag
"oboe.snd" open-sound to ind
#t set-selection-creates-region drop
select-all drop
- "sel0.snd" :not-a-key 3 <'> save-selection 'mus-error check-error-tag
- #( ind ) <'> read-only 'wrong-type-arg check-error-tag
- ind #( 0 ) <'> frames 'wrong-type-arg check-error-tag
- 0 -10 <'> smooth-sound 'wrong-type-arg check-error-tag
- 0 ind 123 <'> mix-selection 'no-such-channel check-error-tag
- 0 ind 123 <'> insert-selection 'no-such-channel check-error-tag
- ind 0 <'> set-channels 'out-of-range check-error-tag
- ind -1 <'> set-channels 'out-of-range check-error-tag
- ind 12340 <'> set-channels 'out-of-range check-error-tag
- ind 12340 <'> set-data-format 'out-of-range check-error-tag
- ind 12340 <'> set-header-type 'out-of-range check-error-tag
- ind 0 <'> set-srate 'out-of-range check-error-tag
- ind -1 <'> set-data-location 'out-of-range check-error-tag
- ind -1 <'> set-data-size 'out-of-range check-error-tag
- -1 -1 <'> set-sample 'no-such-sample check-error-tag
- -1 <'> sample 'no-such-sample check-error-tag
- -10 <'> set-frames 'out-of-range check-error-tag
- 0.0 <'> set-min-dB 'out-of-range check-error-tag
- 0.0 ind 0 <'> set-min-dB 'out-of-range check-error-tag
- 1 -22 <'> start-playing 'out-of-range check-error-tag
- 1 0 <'> start-playing 'out-of-range check-error-tag
- #( 0.0 1.0 0.1 -0.1 1.0 0.0 ) ind <'> set-filter-control-envelope 'out-of-range check-error-tag
- #( 0.0 1.0 0.1 1.1 1.0 0.0 ) ind <'> set-filter-control-envelope 'out-of-range check-error-tag
- #( 0 0 .1 .1 .05 .1 1 1 ) 32 <'> filter-sound 'env-error check-error-tag
- ind 123 <'> apply-controls 'out-of-range check-error-tag
- #( 0.0 2.0 ) <'> set-speed-control-bounds 'out-of-range check-error-tag
- #( 0.0 2.0 ) <'> set-expand-control-bounds 'out-of-range check-error-tag
- #( 2.0 0.0 ) <'> set-speed-control-bounds 'out-of-range check-error-tag
- #( 2.0 0.0 ) <'> set-expand-control-bounds 'out-of-range check-error-tag
- sf-dir "bad_chans.snd" $+ <'> insert-sound 'bad-header check-error-tag
- sf-dir "bad_chans.snd" $+ <'> convolve-with 'IO-error check-error-tag
- "hiho.snd" ind -12 <'> save-sound-as 'cannot-save check-error-tag
- "hiho.snd" ind mus-next -12 <'> save-sound-as 'cannot-save check-error-tag
- "test.snd" ind mus-nist mus-bdouble <'> save-sound-as 'cannot-save check-error-tag
- "test.snd" ind mus-aifc mus-lfloat <'> save-sound-as 'cannot-save check-error-tag
- "test.snd" ind mus-riff mus-bshort <'> save-sound-as 'cannot-save check-error-tag
- "test.snd" ind mus-voc mus-bshort <'> save-sound-as 'cannot-save check-error-tag
- "test.snd" mus-riff mus-bshort <'> save-selection 'cannot-save check-error-tag
- "test.snd" mus-voc mus-bshort <'> save-selection 'cannot-save check-error-tag
- #( 0 0 1 1 ) :length 11 make-env <'> src-channel 'out-of-range check-error-tag
- #( 0 1 1 0 ) :length 11 make-env <'> src-channel 'out-of-range check-error-tag
- #( 0 1 1 -1 ) :length 11 make-env <'> src-channel 'out-of-range check-error-tag
- #( 0 -1 1 1 ) :length 11 make-env <'> src-channel 'out-of-range check-error-tag
- #( 0 0 1 1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag
- #( 0 1 1 0 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag
- #( 0 1 1 -1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag
- #( 0 -1 1 1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag
- 0.0 0.0 0.0 0.0 0.0 0.0 0.0 <'> make-readin 'mus-error check-error-tag
- vct-3 32 <'> filter-sound 'out-of-range check-error-tag
- #( 0 0 1 1 ) 0 <'> filter-sound 'out-of-range check-error-tag
- ind 0 12345 0 <'> swap-channels 'no-such-sound check-error-tag
- vct( 0.1 0.2 0.3 ) -1 ind 0 #t "" <'> mix-vct 'no-such-sample check-error-tag
- 8 0.0 make-vct 0 -123 <'> snd-spectrum 'out-of-range check-error-tag
- 8 0.0 make-vct 0 0 <'> snd-spectrum 'out-of-range check-error-tag
- "/baddy/hiho" <'> play 'no-such-file check-error-tag
- sf-dir "nist-shortpack.wav" $+ <'> play 'bad-format check-error-tag
- ind 123 <'> make-player 'no-such-channel check-error-tag
- "/baddy/hiho" <'> mix 'no-such-file check-error-tag
- "oboe.snd" 0 2 <'> mix 'no-such-channel check-error-tag
- "/baddy/hiho" 0 <'> mix-sound 'no-such-file check-error-tag
- "/baddy/hiho.snd" <'> insert-sound 'no-such-file check-error-tag
- 0 10 "/baddy/hiho.snd" <'> insert-samples 'no-such-file check-error-tag
- #() ind <'> set-filter-control-envelope 'no-data check-error-tag
- ind 123 <'> set-data-format 'out-of-range check-error-tag
- ind 123 <'> set-header-type 'out-of-range check-error-tag
- ind 123 <'> set-selected-channel 'no-such-channel check-error-tag
- ind <'> noop 3 make-proc <'> set-search-procedure 'bad-arity check-error-tag
- <'> noop 3 make-proc <'> map-chan 'bad-arity check-error-tag
- <'> noop 3 make-proc <'> scan-chan 'bad-arity check-error-tag
- <'> noop 1 make-proc ind 0 <'> set-cursor-style 'bad-arity check-error-tag
- <'> noop 0 make-proc <'> find-channel 'bad-arity check-error-tag
- <'> noop 0 make-proc <'> count-matches 'bad-arity check-error-tag
- ind 0 1234 <'> axis-info 'no-such-axis check-error-tag
- 'snd-nogui unless
- ind 1234 <'> axis-info 'no-such-channel check-error-tag
- 1234 <'> axis-info 'no-such-sound check-error-tag
+ "sel0.snd" :not-a-key 3 <'> save-selection 'mus-error check-error-tag
+ '( ind ) <'> read-only 'wrong-type-arg check-error-tag
+ ind '( 0 ) <'> framples 'wrong-type-arg check-error-tag
+ 0 -10 <'> smooth-sound 'wrong-type-arg check-error-tag
+ 0 ind 123 <'> mix-selection 'no-such-channel check-error-tag
+ 0 ind 123 <'> insert-selection 'no-such-channel check-error-tag
+ ind 0 <'> set-channels 'out-of-range check-error-tag
+ ind -1 <'> set-channels 'wrong-type-arg check-error-tag
+ ind 12340 <'> set-channels 'out-of-range check-error-tag
+ ind 12340 <'> set-sample-type 'out-of-range check-error-tag
+ ind 12340 <'> set-header-type 'out-of-range check-error-tag
+ ind 0 <'> set-srate 'out-of-range check-error-tag
+ ind -1 <'> set-data-location 'wrong-type-arg check-error-tag
+ ind -1 <'> set-data-size 'wrong-type-arg check-error-tag
+ -1 -1 <'> set-sample 'no-such-sample check-error-tag
+ -1 <'> sample 'no-such-sample check-error-tag
+ -10 <'> set-framples 'out-of-range check-error-tag
+ 0.0 <'> set-min-dB 'out-of-range check-error-tag
+ 0.0 ind 0 <'> set-min-dB 'out-of-range check-error-tag
+ 1 -22 <'> start-playing 'out-of-range check-error-tag
+ 1 0 <'> start-playing 'out-of-range check-error-tag
+ #( 0.0 1.0 0.1 -0.1 1.0 0.0 ) ind <'> set-filter-control-envelope
+ 'out-of-range check-error-tag
+ #( 0.0 1.0 0.1 1.1 1.0 0.0 ) ind <'> set-filter-control-envelope
+ 'out-of-range check-error-tag
+ #( 0 0 0.1 0.1 0.05 0.1 1 1 ) 32 <'> filter-sound 'env-error check-error-tag
+ ind 123 <'> apply-controls 'out-of-range check-error-tag
+ #( 0.0 2.0 ) <'> set-speed-control-bounds 'out-of-range check-error-tag
+ #( 0.0 2.0 ) <'> set-expand-control-bounds 'out-of-range check-error-tag
+ #( 2.0 0.0 ) <'> set-speed-control-bounds 'out-of-range check-error-tag
+ #( 2.0 0.0 ) <'> set-expand-control-bounds 'out-of-range check-error-tag
+ sf-dir "bad_chans.snd" $+ <'> insert-sound 'bad-header check-error-tag
+ sf-dir "bad_chans.snd" $+ <'> convolve-with 'IO-error check-error-tag
+ "hiho.snd" ind -12 <'> save-sound-as 'cannot-save check-error-tag
+ "hiho.snd" ind :header-type mus-next :sample-type -12
+ <'> save-sound-as 'cannot-save check-error-tag
+ "test.snd" ind :header-type mus-nist :sample-type mus-bdouble
+ <'> save-sound-as 'cannot-save check-error-tag
+ "test.snd" ind :header-type mus-aifc :sample-type mus-lfloat
+ <'> save-sound-as 'cannot-save check-error-tag
+ "test.snd" ind :header-type mus-riff :sample-type mus-bshort
+ <'> save-sound-as 'cannot-save check-error-tag
+ "test.snd" ind :header-type mus-voc :sample-type mus-bshort
+ <'> save-sound-as 'cannot-save check-error-tag
+ "test.snd" 22050 mus-bshort mus-riff
+ <'> save-selection 'cannot-save check-error-tag
+ "test.snd" 22050 mus-bshort mus-voc
+ <'> save-selection 'cannot-save check-error-tag
+ #( 0 0 1 1 ) :length 11 make-env <'> src-channel 'out-of-range check-error-tag
+ #( 0 1 1 0 ) :length 11 make-env <'> src-channel 'out-of-range check-error-tag
+ #( 0 1 1 -1 ) :length 11 make-env <'> src-channel 'out-of-range
+ check-error-tag
+ #( 0 -1 1 1 ) :length 11 make-env <'> src-channel 'out-of-range
+ check-error-tag
+ #( 0 0 1 1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag
+ #( 0 1 1 0 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag
+ #( 0 1 1 -1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag
+ #( 0 -1 1 1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag
+ 0.0 0.0 0.0 0.0 0.0 0.0 0.0 <'> make-readin 'mus-error check-error-tag
+ vct-3 32 <'> filter-sound 'out-of-range check-error-tag
+ #( 0 0 1 1 ) 0 <'> filter-sound 'out-of-range check-error-tag
+ ind 0 12345 0 <'> swap-channels 'no-such-sound check-error-tag
+ vct( 0.1 0.2 0.3 ) -1 ind 0 #t "" <'> mix-vct 'no-such-sample check-error-tag
+ 8 0.0 make-vct 0 -123 <'> snd-spectrum 'out-of-range check-error-tag
+ 8 0.0 make-vct 0 0 <'> snd-spectrum 'out-of-range check-error-tag
+ "/baddy/hiho" <'> play 'no-such-file check-error-tag
+ sf-dir "nist-shortpack.wav" $+ <'> play 'bad-sample-type check-error-tag
+ ind 123 <'> make-player 'no-such-channel check-error-tag
+ "/baddy/hiho" <'> mix 'no-such-file check-error-tag
+ "oboe.snd" 0 2 <'> mix 'no-such-channel check-error-tag
+ "/baddy/hiho" 0 <'> mix-sound 'no-such-file check-error-tag
+ "/baddy/hiho.snd" <'> insert-sound 'no-such-file check-error-tag
+ 0 10 "/baddy/hiho.snd" <'> insert-samples 'no-such-file check-error-tag
+ '() ind <'> set-filter-control-envelope 'no-data check-error-tag
+ ind 123 <'> set-sample-type 'out-of-range check-error-tag
+ ind 123 <'> set-header-type 'out-of-range check-error-tag
+ ind 123 <'> set-selected-channel 'no-such-channel check-error-tag
+ <'> noop 3 make-proc <'> set-search-procedure 'bad-arity check-error-tag
+ <'> noop 3 make-proc <'> map-chan 'bad-arity check-error-tag
+ <'> noop 1 make-proc ind 0 <'> set-cursor-style 'bad-arity check-error-tag
+ 0 0 1 1 ind 0 1234 <'> draw-line 'no-such-graphics-context check-error-tag
+ ind 0 1234 <'> foreground-color 'no-such-graphics-context check-error-tag
+ ind 0 1234 <'> current-font 'no-such-graphics-context check-error-tag
+ '( vct-3 vct-3 ) ind 0 1234 0 1 0 <'> graph-data 'no-such-graphics-context
+ check-error-tag
+ 100 ind 0 1234 <'> position->x 'no-such-axis check-error-tag
+ 100 ind 0 1234 <'> position->y 'no-such-axis check-error-tag
+ 100 ind 0 1234 <'> x->position 'no-such-axis check-error-tag
+ 100 ind 0 1234 <'> y->position 'no-such-axis check-error-tag
+ ind 0 1234 <'> axis-info 'no-such-axis check-error-tag
+ *with-test-gui* if
+ channel-widgets car snd-gcs car "hiho" 0.0 1.0 -1.0 1.0 x-axis-in-seconds
+ 1234 <'> draw-axes 'out-of-range check-error-tag
+ channel-widgets car snd-gcs car "hiho" 0.0 1.0 -1.0 1.0
+ 1234 <'> draw-axes 'out-of-range check-error-tag
+ ind 1234 <'> axis-info 'no-such-channel check-error-tag
+ 1234 <'> axis-info 'no-such-sound check-error-tag
then
graph-once set-time-graph-type drop
- #( 0.1 -0.1 ) <'> set-x-bounds 'out-of-range check-error-tag
- 100 0 <'> make-region 'out-of-range check-error-tag
- -1 <'> delete-sample 'no-such-sample check-error-tag
- ind frames 2* <'> delete-sample 'no-such-sample check-error-tag
- "/bad/baddy.snd" <'> play 'no-such-file check-error-tag
- 1234 0 <'> play 'no-such-sound check-error-tag
- regions empty? if 0 100 make-region then
- regions 0 array-ref 0 1234 <'> region-sample 'no-such-channel check-error-tag
- regions 0 array-ref 1234 <'> region-frames 'no-such-channel check-error-tag
- regions 0 array-ref 1234 <'> region-position 'no-such-channel check-error-tag
- regions 0 array-ref 0 1 1234 <'> region->vct 'no-such-channel check-error-tag
- "/bad/baddy.snd" <'> save-sound-as 'cannot-save check-error-tag
- 0 1 1234 <'> transform-sample 'no-such-sound check-error-tag
- 0 1 ind 1234 <'> transform-sample 'no-such-channel check-error-tag
- vct( 0 1 ) "hi" 0 1 0 1 1234 <'> graph 'no-such-sound check-error-tag
- vct( 0 1 ) "hi" 0 1 0 1 ind 1234 <'> graph 'no-such-channel check-error-tag
+ #( 0.1 -0.1 ) <'> set-x-bounds 'out-of-range check-error-tag
+ 100 0 <'> make-region 'out-of-range check-error-tag
+ -1 <'> delete-sample 'no-such-sample check-error-tag
+ ind framples 2* <'> delete-sample 'no-such-sample check-error-tag
+ "/bad/baddy.snd" <'> play 'no-such-file check-error-tag
+ 1234 0 <'> play 'no-such-sound check-error-tag
+ regions empty? if
+ 0 100 make-region
+ then
+ regions car 0 1234 <'> region-sample 'no-such-channel check-error-tag
+ regions car 1234 <'> region-framples 'no-such-channel check-error-tag
+ regions car 1234 <'> region-position 'no-such-channel check-error-tag
+ "/bad/baddy.snd" <'> save-sound-as 'cannot-save check-error-tag
+ 0 1 1234 <'> transform-sample 'no-such-sound check-error-tag
+ 0 1 ind 1234 <'> transform-sample 'no-such-channel check-error-tag
+ vct( 0 1 ) "hi" 0 1 0 1 1234 <'> graph 'no-such-sound check-error-tag
+ vct( 0 1 ) "hi" 0 1 0 1 ind 1234 <'> graph 'no-such-channel check-error-tag
#f #t set-selection-member? drop
- vct( 0 0 1 1 ) 4 <'> filter-selection 'no-active-selection check-error-tag
- "/bad/baddy.snd" <'> save-selection 'no-active-selection check-error-tag
- #( 0 0 1 1 ) <'> env-selection 'no-active-selection check-error-tag
- 1234 integer->region "/bad/baddy.snd" <'> save-region 'no-such-region check-error-tag
+ vct( 0 0 1 1 ) 4 <'> filter-selection 'no-active-selection check-error-tag
+ "/bad/baddy.snd" <'> save-selection 'no-active-selection check-error-tag
+ #( 0 0 1 1 ) <'> env-selection 'no-active-selection check-error-tag
+ 1234 integer->region "/bad/baddy.snd" <'> save-region 'no-such-region
+ check-error-tag
0 100 ind 0 make-region drop
- "/bad/baddy.snd" <'> save-selection 'cannot-save check-error-tag
- regions 0 array-ref "/bad/baddy.snd" <'> save-region 'cannot-save check-error-tag
- 1234 integer->mix <'> make-mix-sampler 'no-such-mix check-error-tag
- 0 12 1234 #t <'> make-region 'no-such-sound check-error-tag
+ "/bad/baddy.snd" <'> save-selection 'cannot-save check-error-tag
+ regions car "/bad/baddy.snd" <'> save-region 'cannot-save check-error-tag
+ 1234 integer->mix <'> make-mix-sampler 'no-such-mix check-error-tag
+ 0 12 1234 #t <'> make-region 'no-such-sound check-error-tag
#t ind set-read-only drop
- ind #( 0 0 1 1 ) <'> set-sound-loop-info 'cannot-save check-error-tag
- 0 ind 0 123 <'> make-sampler 'no-such-direction check-error-tag
- 0 ind 0 0 <'> make-sampler 'no-such-direction check-error-tag
- 0 ind 0 -2 <'> make-sampler 'no-such-direction check-error-tag
- #() <'> scale-by 'no-data check-error-tag
- #() <'> scale-to 'no-data check-error-tag
- "hi" <'> noop 2 make-proc <'> prompt-in-minibuffer 'bad-arity check-error-tag
- -999 ind 0 <'> set-selection-position 'no-such-sample check-error-tag
- -999 ind 0 <'> set-selection-frames 'wrong-type-arg check-error-tag
- 0 ind 0 <'> set-selection-frames 'wrong-type-arg check-error-tag
- -1 <'> edit-fragment 'no-such-edit check-error-tag
- 101 ind 0 <'> edit-fragment 'no-such-edit check-error-tag
- ind 0 -2 <'> edit-tree 'no-such-edit check-error-tag
- ind 0 101 <'> edit-tree 'no-such-edit check-error-tag
- -1 <'> add-mark 'no-such-sample check-error-tag
- frames 2* <'> add-mark 'no-such-sample check-error-tag
- "/bad/baddy" <'> convolve-with 'no-such-file check-error-tag
- "/bad/baddy" <'> mix 'no-such-file check-error-tag
- ind 0 123 <'> swap-channels 'no-such-sound check-error-tag
- 123 ind 0 <'> set-show-axes 'out-of-range check-error-tag
- -123 ind 0 <'> set-show-axes 'out-of-range check-error-tag
- 123 ind 0 <'> set-x-axis-style 'out-of-range check-error-tag
- -123 ind 0 <'> set-x-axis-style 'out-of-range check-error-tag
- 123 ind 0 <'> set-graph-style 'out-of-range check-error-tag
- -123 ind 0 <'> set-graph-style 'out-of-range check-error-tag
- #( 0 0 1 1 ) 0 #f -1.5 <'> env-sound 'out-of-range check-error-tag
- 0.0 1.0 -1.6 <'> xramp-channel 'out-of-range check-error-tag
- 0 2 -1 <'> set-samples 'wrong-type-arg check-error-tag
- #( 0 ) <'> left-sample 'wrong-type-arg check-error-tag
- #( 0 ) <'> amp-control 'wrong-type-arg check-error-tag
- #( 0 ) <'> sound-loop-info 'wrong-type-arg check-error-tag
- 123 #( 0 ) <'> add-mark 'wrong-type-arg check-error-tag
- #( 0 0 1 1 ) 100 #f #f 1234 0 <'> filter-channel 'no-such-sound check-error-tag
- #( 0 0 1 1 ) 100 #f #f ind 1 <'> filter-channel 'no-such-channel check-error-tag
- vct( 0 0 1 1 ) 4 #f #f ind 1 <'> filter-channel 'no-such-channel check-error-tag
- vct( 0 0 1 1 ) 0 <'> filter-sound 'out-of-range check-error-tag
- vct( 0 0 1 1 ) 10 <'> filter-sound 'out-of-range check-error-tag
- #( 0.1 0.01 ) ind <'> set-reverb-control-length-bounds 'out-of-range check-error-tag
- #( 0.1 0.01 ) ind <'> set-reverb-control-scale-bounds 'out-of-range check-error-tag
- #f <'> scale-by 'wrong-type-arg check-error-tag
- 2 0.1 0.1 0.2 0.2 make-mixer <'> scale-by 'wrong-type-arg check-error-tag
- 3.0 1.0 #t <'> src-sound 'wrong-type-arg check-error-tag
- 3.0 1.0 ind #t <'> src-sound 'wrong-type-arg check-error-tag
- ind 0 123 <'> display-edits 'no-such-edit check-error-tag
+ \ XXX: snd-nogui and set-read-only
+ \ Snd-nogui has no widget and therefore the sound will not be
+ \ write-protected according to snd-snd.c.
+ ind read-only if
+ ind '( 0 0 1 1 ) <'> set-sound-loop-info 'cannot-save check-error-tag
+ else
+ *with-test-nogui* unless
+ "%s is not read-only?" #( ind ) snd-display
+ then
+ then
+ 0 ind 0 123 <'> make-sampler 'no-such-direction check-error-tag
+ 0 ind 0 0 <'> make-sampler 'no-such-direction check-error-tag
+ 0 ind 0 -2 <'> make-sampler 'no-such-direction check-error-tag
+ '() <'> scale-by 'no-data check-error-tag
+ '() <'> scale-to 'no-data check-error-tag
+ -999 ind 0 <'> set-selection-position 'no-such-sample check-error-tag
+ -999 ind 0 <'> set-selection-framples 'wrong-type-arg check-error-tag
+ 0 ind 0 <'> set-selection-framples 'wrong-type-arg check-error-tag
+ -1 <'> edit-fragment 'no-such-edit check-error-tag
+ 101 ind 0 <'> edit-fragment 'no-such-edit check-error-tag
+ ind 0 -2 <'> edit-tree 'no-such-edit check-error-tag
+ ind 0 101 <'> edit-tree 'no-such-edit check-error-tag
+ -1 <'> add-mark 'no-such-sample check-error-tag
+ framples 2* <'> add-mark 'no-such-sample check-error-tag
+ "/bad/baddy" <'> convolve-with 'no-such-file check-error-tag
+ "/bad/baddy" <'> mix 'no-such-file check-error-tag
+ ind 0 123 <'> swap-channels 'no-such-sound check-error-tag
+ 123 ind 0 <'> set-show-axes 'out-of-range check-error-tag
+ -123 ind 0 <'> set-show-axes 'out-of-range check-error-tag
+ 123 ind 0 <'> set-x-axis-style 'out-of-range check-error-tag
+ -123 ind 0 <'> set-x-axis-style 'out-of-range check-error-tag
+ 123 ind 0 <'> set-graph-style 'out-of-range check-error-tag
+ -123 ind 0 <'> set-graph-style 'out-of-range check-error-tag
+ '( 0 0 1 1 ) 0 #f -1.5 <'> env-sound 'out-of-range check-error-tag
+ 0.0 1.0 -1.6 <'> xramp-channel 'out-of-range check-error-tag
+ 0 2 -1 <'> set-samples 'wrong-type-arg check-error-tag
+ '( 0 ) <'> left-sample 'wrong-type-arg check-error-tag
+ '( 0 ) <'> amp-control 'wrong-type-arg check-error-tag
+ '( 0 ) <'> sound-loop-info 'wrong-type-arg check-error-tag
+ 123 '( 0 ) <'> add-mark 'wrong-type-arg check-error-tag
+ '( 0 0 1 1 ) 100 #f #f 1234 0 <'> filter-channel 'no-such-sound
+ check-error-tag
+ '( 0 0 1 1 ) 100 #f #f ind 1 <'> filter-channel 'no-such-channel
+ check-error-tag
+ vct( 0 0 1 1 ) 4 #f #f ind 1 <'> filter-channel 'no-such-channel
+ check-error-tag
+ vct( 0 0 1 1 ) 0 <'> filter-sound 'out-of-range check-error-tag
+ vct( 0 0 1 1 ) 10 <'> filter-sound 'out-of-range check-error-tag
+ selected-sound 0 :stop <'> noop 0 make-proc <'> play 'bad-arity
+ check-error-tag
+ '( 0.1 0.01 ) ind <'> set-reverb-control-length-bounds 'out-of-range
+ check-error-tag
+ '( 0.1 0.01 ) ind <'> set-reverb-control-scale-bounds 'out-of-range
+ check-error-tag
+ #f <'> scale-by 'wrong-type-arg check-error-tag
+ 3.0 1.0 #t <'> src-sound 'wrong-type-arg check-error-tag
+ 3.0 1.0 ind #t <'> src-sound 'wrong-type-arg check-error-tag
+ ind 0 123 <'> display-edits 'no-such-edit check-error-tag
+ ind 0 123 <'> marks 'no-such-edit check-error-tag
+ "test.snd" :edit-position 123 <'> save-sound-as 'no-such-edit check-error-tag
+ "1a.snd" 0 0 ind 0 0 123 <'> insert-sound 'no-such-auto-delete-choice
+ check-error-tag
ind close-sound drop
- "hiho" "time" 0 1 <'> noop 0 make-proc <'> add-transform 'bad-arity check-error-tag
- "/bad/baddy" <'> save-state 'cannot-save check-error-tag
- 1234 "hi" <'> noop 0 make-proc <'> add-to-menu 'no-such-menu check-error-tag
- "hi" <'> noop 2 make-proc <'> add-to-main-menu 'bad-arity check-error-tag
- 1 "hi" <'> noop 2 make-proc <'> add-to-menu 'bad-arity check-error-tag
- -1 integer->transform <'> set-transform-type 'wrong-type-arg check-error-tag
- 123 integer->transform <'> set-transform-type 'out-of-range check-error-tag
- #( 0 1 ) "hiho" <'> help-dialog 'wrong-type-arg check-error-tag
- #( 0 1 ) "hiho" <'> info-dialog 'wrong-type-arg check-error-tag
- 1234 <'> edit-header-dialog 'no-such-sound check-error-tag
- "/bad/baddy.snd" <'> open-sound 'no-such-file check-error-tag
- "/bad/baddy.snd" 1 22050 mus-lshort <'> open-raw-sound 'no-such-file check-error-tag
- "/bad/baddy.snd" <'> view-sound 'no-such-file check-error-tag
- 0 "/bad/baddy.snd" <'> make-sampler 'no-such-file check-error-tag
- 1234567 integer->region 0 <'> make-region-sampler 'no-such-region check-error-tag
- sf-dir "bad_chans.snd" $+ 0 0 123 234 0.0 make-vct <'> file->array 'bad-header check-error-tag
- sf-dir "bad_chans.snd" $+ <'> make-readin 'bad-header check-error-tag
- 30 3 0 make-vct <'> make-iir-filter 'mus-error check-error-tag
- :size 2 30 f** f>s <'> make-wave-train 'out-of-range check-error-tag
- 0.0 <'> set-mus-srate 'out-of-range check-error-tag
- -1000 <'> set-mus-srate 'out-of-range check-error-tag
- 3 0 make-vct 3 0 make-vct -1 <'> dot-product 'out-of-range check-error-tag
- 3 0 make-vct 3 0 make-vct -1 <'> multiply-arrays 'out-of-range check-error-tag
- 3 vct( 0.1 0.2 0.3 ) 0.0 <'> make-delay 'out-of-range check-error-tag
- 3 vct( 0.1 0.2 0.3 ) :max-size 100 <'> make-delay 'out-of-range check-error-tag
- :size 100 :wave 3 0 make-vct <'> make-table-lookup 'out-of-range check-error-tag
- :size 100 :wave 3 0 make-vct <'> make-wave-train 'out-of-range check-error-tag
- 100 12345678 <'> make-ssb-am 'out-of-range check-error-tag
- :envelope #( 0 0 1 1 ) :distribution 10 0 make-vct <'> make-rand 'mus-error check-error-tag
- :envelope #( 0 0 1 ) <'> make-rand 'mus-error check-error-tag
- :envelope #( 0 0 1 1 ) :size -2 <'> make-rand 'out-of-range check-error-tag
- :envelope #( 0 0 1 1 ) :size 1234567890 <'> make-rand 'out-of-range check-error-tag
- make-granulate #f <'> noop 3 make-proc <'> granulate 'bad-arity check-error-tag
- make-phase-vocoder #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity check-error-tag
- make-phase-vocoder #f #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity check-error-tag
- make-phase-vocoder #f #f #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity check-error-tag
- 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 <'> mus-xcoeff 'mus-error check-error-tag
- 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 <'> mus-ycoeff 'mus-error check-error-tag
- 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 1.0 <'> set-mus-xcoeff 'mus-error check-error-tag
- 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 1.0 <'> set-mus-ycoeff 'mus-error check-error-tag
- :ycoeffs 4 0 make-vct :order 12 <'> make-filter 'mus-error check-error-tag
- make-oscil 1 <'> set-mus-offset 'mus-error check-error-tag
- :channels 2 30 f** f>s <'> make-locsig 'out-of-range check-error-tag
- :width 3000 <'> make-src 'out-of-range check-error-tag
- -1 <'> make-frame 'out-of-range check-error-tag
- 2 0.1 0.2 make-frame 3 <'> frame-ref 'mus-error check-error-tag
- 0 0.1 <'> make-scalar-mixer 'out-of-range check-error-tag
- 2 make-mixer 3 4 <'> mixer-ref 'mus-error check-error-tag
- :input <'> noop 1 make-proc make-src 2000000.0 <'> src 'out-of-range check-error-tag
- #( 1 1 ) -1 <'> partials->polynomial 'out-of-range check-error-tag
- #( 1 1 ) 3 <'> partials->polynomial 'out-of-range check-error-tag
- :partials #( 1 1 ) :kind -1 <'> make-polyshape 'out-of-range check-error-tag
- :partials #( 1 1 ) :kind 3 <'> make-polyshape 'out-of-range check-error-tag
- 1234 <'> set-mus-header-raw-defaults 'wrong-type-arg check-error-tag
- #( 44100 2.123 "hi" ) <'> set-mus-header-raw-defaults 'wrong-type-arg check-error-tag
- 123 <'> set-with-toolbar 'wrong-type-arg check-error-tag
- 123 <'> set-with-tooltips 'wrong-type-arg check-error-tag
- 123 <'> set-with-menu-icons 'wrong-type-arg check-error-tag
- 123 <'> set-save-as-dialog-src 'wrong-type-arg check-error-tag
- 123 <'> set-save-as-dialog-auto-comment 'wrong-type-arg check-error-tag
- 123 <'> set-with-smpte-label 'wrong-type-arg check-error-tag
- 123 <'> set-ask-about-unsaved-edits 'wrong-type-arg check-error-tag
- mix-sync-max 1+ integer->mix <'> mix-properties 'no-such-mix check-error-tag
- mix-sync-max 1+ 1 <'> set-mix-properties 'no-such-mix check-error-tag
+ "hiho" "time" 0 1 <'> noop 0 make-proc <'> add-transform 'bad-arity
+ check-error-tag
+ "/bad/baddy" <'> save-state 'cannot-save check-error-tag
+ 1234 "hi" <'> noop 0 make-proc <'> add-to-menu 'no-such-menu check-error-tag
+ "hi" <'> noop 2 make-proc <'> add-to-main-menu 'bad-arity check-error-tag
+ 1 "hi" <'> noop 2 make-proc <'> add-to-menu 'bad-arity check-error-tag
+ -1 integer->transform <'> set-transform-type 'wrong-type-arg check-error-tag
+ 123 integer->transform <'> set-transform-type 'out-of-range check-error-tag
+ '( 0 1 ) "hiho" <'> help-dialog 'wrong-type-arg check-error-tag
+ '( 0 1 ) "hiho" <'> info-dialog 'wrong-type-arg check-error-tag
+ 1234 <'> edit-header-dialog 'no-such-sound check-error-tag
+ "/bad/baddy.snd" <'> open-sound 'no-such-file check-error-tag
+ "/bad/baddy.snd" 1 22050 mus-lshort <'> open-raw-sound 'no-such-file
+ check-error-tag
+ "/bad/baddy.snd" <'> view-sound 'no-such-file check-error-tag
+ 0 "/bad/baddy.snd" <'> make-sampler 'no-such-file check-error-tag
+ 1234567 integer->region 0 <'> make-region-sampler 'no-such-region
+ check-error-tag
+ -1 0 #f <'> bind-key 'no-such-key check-error-tag
+ 12 17 #f <'> bind-key 'no-such-key check-error-tag
+ 12 -1 #f <'> bind-key 'no-such-key check-error-tag
+ 12345678 0 <'> key-binding 'no-such-key check-error-tag
+ -1 0 <'> key-binding 'no-such-key check-error-tag
+ 12 17 <'> key-binding 'no-such-key check-error-tag
+ 12 -1 <'> key-binding 'no-such-key check-error-tag
+ sf-dir "bad_chans.snd" $+ 0 0 123 123 0.0 make-vct <'> file->array
+ 'bad-header check-error-tag
+ sf-dir "bad_chans.snd" $+ <'> make-readin 'bad-header check-error-tag
+ 30 3 0 make-vct <'> make-iir-filter 'mus-error check-error-tag
+ :size 2 30 f** f>s <'> make-wave-train 'out-of-range check-error-tag
+ 0.0 <'> set-mus-srate 'out-of-range check-error-tag
+ -1000 <'> set-mus-srate 'out-of-range check-error-tag
+ 3 0 make-vct 3 0 make-vct -1 <'> dot-product 'out-of-range check-error-tag
+ 3 :initial-element 0.0 :initial-contents vct( 0.1 0.2 0.3 ) <'> make-delay
+ 'out-of-range check-error-tag
+ 3 :max-size 100 :initial-contents vct( 0.1 0.2 0.3 ) <'> make-delay
+ 'out-of-range check-error-tag
+ :size 100 :wave 3 0 make-vct <'> make-table-lookup 'out-of-range
+ check-error-tag
+ :size 100 :wave 3 0 make-vct <'> make-wave-train 'out-of-range check-error-tag
+ 100 12345678 <'> make-ssb-am 'out-of-range check-error-tag
+ :envelope '( 0 0 1 1 ) :distribution 10 0 make-vct <'> make-rand
+ 'mus-error check-error-tag
+ :envelope '( 0 0 1 ) <'> make-rand 'mus-error check-error-tag
+ :envelope '( 0 0 1 1 ) :size -2 <'> make-rand 'out-of-range check-error-tag
+ :envelope '( 0 0 1 1 ) :size 1234567890 <'> make-rand 'out-of-range
+ check-error-tag
+ make-granulate #f <'> noop 3 make-proc <'> granulate 'bad-arity
+ check-error-tag
+ make-phase-vocoder #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity
+ check-error-tag
+ make-phase-vocoder #f #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity
+ check-error-tag
+ make-phase-vocoder #f #f #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity
+ check-error-tag
+ 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 <'> mus-xcoeff 'mus-error
+ check-error-tag
+ 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 <'> mus-ycoeff 'mus-error
+ check-error-tag
+ 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 1.0 <'> set-mus-xcoeff
+ 'mus-error check-error-tag
+ 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 1.0 <'> set-mus-ycoeff
+ 'mus-error check-error-tag
+ :ycoeffs 4 0 make-vct :order 12 <'> make-filter 'mus-error check-error-tag
+ \ XXX: Switch to float here okay according to clm2xen.c!
+ \ was: make-oscil 1 ==> wrong-type-arg fixnum, wanted a float
+ make-oscil 1.0 <'> set-mus-offset 'mus-error check-error-tag
+ make-oscil 1 <'> set-mus-offset 'wrong-type-arg check-error-tag
+ :channels 2 30 f** f>s <'> make-locsig 'out-of-range check-error-tag
+ :width 3000 <'> make-src 'out-of-range check-error-tag
+ *with-test-gui* if
+ "baddy" <'> noop 0 make-proc <'> add-colormap 'bad-arity check-error-tag
+ "baddy" <'> noop 3 make-proc <'> add-colormap 'bad-arity check-error-tag
+ then
+ :input <'> noop 1 make-proc make-src 2000000.0 <'> src 'out-of-range
+ check-error-tag
+ '( 1 1 ) -1 <'> partials->polynomial 'out-of-range check-error-tag
+ '( 1 1 ) 3 <'> partials->polynomial 'out-of-range check-error-tag
+ :partials '( 1 1 ) :kind -1 <'> make-polyshape 'out-of-range check-error-tag
+ :partials '( 1 1 ) :kind 3 <'> make-polyshape 'out-of-range check-error-tag
+ 32 <'> normalize-partials 'wrong-type-arg check-error-tag
+ '() <'> normalize-partials 'wrong-type-arg check-error-tag
+ '( 1 2 3 ) <'> normalize-partials 'bad-type check-error-tag
+ vct( 3 ) <'> normalize-partials 'bad-type check-error-tag
+ 440.0 :partials vct( 1 1 -2 1 ) <'> make-polyshape 'no-data check-error-tag
+ 440.0 :partials list( 1 1 -2 1 ) <'> make-polyshape 'no-data check-error-tag
+ 440.0 :partials '() <'> make-polyshape 'no-data check-error-tag
+ 1234 <'> set-mus-header-raw-defaults 'wrong-type-arg check-error-tag
+ '( 44100 2.123 "hi" ) <'> set-mus-header-raw-defaults 'wrong-type-arg
+ check-error-tag
+ 123 <'> set-with-toolbar 'wrong-type-arg check-error-tag
+ 123 <'> set-with-tooltips 'wrong-type-arg check-error-tag
+ 123 <'> set-with-menu-icons 'wrong-type-arg check-error-tag
+ 123 <'> set-save-as-dialog-src 'wrong-type-arg check-error-tag
+ 123 <'> set-save-as-dialog-auto-comment 'wrong-type-arg check-error-tag
+ 123 <'> set-with-smpte-label 'wrong-type-arg check-error-tag
+ 123 <'> set-ask-about-unsaved-edits 'wrong-type-arg check-error-tag
+ mix-sync-max 1+ integer->mix <'> mix-properties 'no-such-mix check-error-tag
+ mix-sync-max 1+ integer->mix 1 <'> set-mix-properties 'no-such-mix
+ check-error-tag
+ sounds empty? unless
+ "sounds after error checks: %s" #( sounds ) snd-display
+ then
mus-audio-reinitialize drop
10 set-window-y drop
dismiss-all-dialogs
@@ -8617,15 +7725,15 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
ind <'> update-sound #t nil fth-catch to tag
stack-reset
tag if
- tag car 'cant-update-file = unless
- $" update-sound after deletion: %s" #( tag ) snd-display
+ tag car 'cant-update-file <> if
+ "update-sound after deletion: %s" #( tag ) snd-display
then
then
ind <'> save-sound #t nil fth-catch to tag
stack-reset
tag if
- tag car 'cannot-save = unless
- $" save file deleted: %s" #( tag ) snd-display
+ tag car 'cannot-save <> if
+ "save file deleted: %s" #( tag ) snd-display
then
then
ind close-sound drop
@@ -8645,8 +7753,8 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
ind <'> save-sound #t nil fth-catch to tag
stack-reset
tag if
- tag car 'cannot-save = unless
- $" save protected sound msg: %s" #( tag ) snd-display
+ tag car 'cannot-save <> if
+ "save protected sound msg: %s" #( tag ) snd-display
then
then
ind close-sound drop
@@ -8660,12 +7768,14 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
tag if
tag car 'no-such-file =
tag car 'mus-error = || unless
- $" open read-protected sound worked!: %s" #( tag ) snd-display
+ "open read-protected sound worked!: %s" #( tag ) snd-display
then
then
"test.snd" 0o644 file-chmod
"test.snd" file-delete
- ind sound? if ind close-sound drop then
+ ind sound? if
+ ind close-sound drop
+ then
\
"oboe.snd" "test.snd" file-copy
"test.snd" 0o400 file-chmod
@@ -8674,8 +7784,8 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
"test.snd" <'> save-sound-as #t nil fth-catch to tag
stack-reset
tag if
- tag car 'cannot-save = unless
- $" save-as write-protected sound msg: %s" #( tag ) snd-display
+ tag car 'cannot-save <> if
+ "save-as write-protected sound msg: %s" #( tag ) snd-display
then
then
ind close-sound drop
@@ -8685,8 +7795,8 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
close-sound-mc-cb <'> map-channel #t nil fth-catch to tag
stack-reset
tag if
- tag car 'no-such-channel = unless
- $" map-channel closing own chan: %s" #( tag ) snd-display
+ tag car 'no-such-channel <> if
+ "map-channel closing own chan: %s" #( tag ) snd-display
then
then
\
@@ -8697,64 +7807,81 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
"oboe.snd" open-sound to ind
0 make-sampler { rd }
ind close-sound drop
- 10 0 do rd read-sample drop loop
+ 10 0 do
+ rd read-sample drop
+ loop
rd sampler-home { home }
home array-length 0> if
home 0 array-ref sound? if
- $" reader-home of closed sound: %s %s?" #( home sounds ) snd-display
+ "reader-home of closed sound: %s %s?" #( home sounds ) snd-display
then
then
rd sampler-position { loc }
- loc 0<> if $" closed reader position: %s?" #( loc ) snd-display then
+ loc 0<> if
+ "closed reader position: %s?" #( loc ) snd-display
+ then
rd sampler-at-end? { at-end }
- at-end false? if $" closed sampler at end: %s?" #( at-end ) snd-display then
+ at-end false? if
+ "closed sampler at end: %s?" #( at-end ) snd-display
+ then
\
"oboe.snd" open-sound to ind
vct( 0.1 0.2 0.3 ) mix-vct { mx }
mx make-mix-sampler to rd
ind close-sound drop
- 10 0 do rd read-mix-sample drop loop
- \
+ 10 0 do
+ rd read-mix-sample drop
+ loop
+ \
8 max-regions max set-max-regions drop
"oboe.snd" open-sound to ind
0 100 ind 0 make-region { reg }
reg 0 make-region-sampler to rd
ind close-sound drop
reg forget-region drop
- 10 0 do rd read-sample drop loop
- \
+ 10 0 do
+ rd read-sample drop
+ loop
+ \
"oboe.snd" open-sound to ind
- 1.0 { scl }
100 0.5 ind 0 set-sample drop
- scl mc-1-cb map-channel drop
100 ind 0 sample { s100 }
- s100 1.0 fneq if $" scan + map 100: %s" #( s100 ) snd-display then
- ind revert-sound drop
- \
- 100 0.5 ind 0 set-sample drop
ind mc-2-cb map-channel drop
100 ind 0 sample to s100
- s100 0.5 fneq if $" map + reset frames: %s" #( s100 ) snd-display then
- ind 0 frames { frms }
- frms 50828 <> if $" map + reset frames, frames: %s" #( frms ) snd-display then
+ s100 0.5 fneq if
+ "map + reset framples: %s" #( s100 ) snd-display
+ then
+ ind 0 framples { frms }
+ frms 50828 <> if
+ "map + reset framples, framples: %s" #( frms ) snd-display
+ then
1 ind 0 undo drop
- ind 0 frames to frms
- frms 1 <> if $" map + reset frames, undo frames: %s" #( frms ) snd-display then
+ ind 0 framples to frms
+ frms 1 <> if
+ "map + reset framples, undo framples: %s" #( frms ) snd-display
+ then
ind revert-sound drop
\
100 0.5 ind 0 set-sample drop
- \ FIXME
- \ Doesn't work like expected with FTH. If more values on stack
- \ than needed, no exception can be raised. No one knows who will
- \ take and need them. So we have 'no-such-channel as first
- \ exception.
- \ frames ( snd chn edpos -- frms )
- \ set-frames ( frms snd chn -- val )
- 1 ind 0 <'> set-frames #t nil fth-catch to tag
+ \ XXX: 'wrong-type-arg instead of 'wrong-number-of-args
+ \
+ \ (set! (framples ind 0 1) 1) => too many arguments
+ \ 1 ind 0 1 set-framples => wrong type arg 1 (<sound 0>)
+ \
+ \ With Fth this doesn't work as expected. If stack has more values than
+ \ needed by the next word, no 'wrong-number-of-args exception can be
+ \ raised because no one knows who will take the other values. That's
+ \ why the first exception is 'wrong-type-arg because sound IND is not
+ \ a number.
+ \
+ \ framples ( snd chn edpos -- frms ) /* g_framples(snd, chn, edpos) */
+ \ set-framples ( on snd chn -- val ) /* g_set_framples(on, snd, chn) */
+ 1 ind 0 1 <'> set-framples #t nil fth-catch to tag
stack-reset
tag if
- tag car 'wrong-number-of-args = unless
- $" set frames + edpos: %s" #( tag ) snd-display
+ tag car 'wrong-number-of-args <>
+ tag car 'wrong-type-arg <> && if
+ "set framples + edpos: %s" #( tag ) snd-display
then
then
ind revert-sound drop
@@ -8763,89 +7890,91 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
then
stack-reset
tag if
- tag car 'bad-type = unless
- $" map-channel rtn complex: %s" #( tag ) snd-display
+ tag car 'bad-type <> if
+ "map-channel rtn complex: %s" #( tag ) snd-display
then
then
0 make-sampler to rd
- 10 0 do rd #() apply drop loop
+ 10 0 do
+ rd #() apply drop
+ loop
rd copy-sampler { crd }
ind close-sound drop
- 10 0 do crd read-sample drop loop
+ 10 0 do
+ crd read-sample drop
+ loop
crd sampler-home to home
home array-length 0> if
home 0 array-ref sound? if
- $" copy reader-home of closed sound: %s %s?" #( home sounds ) snd-display
+ "copy reader-home of closed sound: %s %s?" #( home sounds ) snd-display
then
then
crd sampler-position to loc
- loc 0<> if $" closed copy reader position: %s?" #( loc ) snd-display then
- crd sampler-at-end? to at-end
- at-end false? if $" closed copy sampler at end: %s?" #( at-end ) snd-display then
- \
- ind <'> revert-sound #t nil fth-catch to tag
- stack-reset
- tag if
- tag car 'no-such-sound = unless
- $" revert-sound of closed sound: %s" #( tag ) snd-display
- then
+ loc 0<> if
+ "closed copy reader position: %s?" #( loc ) snd-display
then
- \
- "oboe.snd" open-sound to ind
- 100 0.5 ind 0 set-sample drop
- 0.5 0 100 ind 0 ind edpos-1-cb <'> scale-channel #t nil fth-catch to tag
- stack-reset
- tag if
- tag car 'bad-arity = unless
- $" edpos proc bad args: %s" #( tag ) snd-display
- then
+ crd sampler-at-end? to at-end
+ at-end false? if
+ "closed copy sampler at end: %s?" #( at-end ) snd-display
then
- ind sound? unless $" edpos bad arity proc clobbers chan??: %s" #( ind ) snd-display then
\
- 0.5 0 100 ind 0 <'> edpos-2-cb <'> scale-channel #t nil fth-catch to tag
+ ind <'> revert-sound #t nil fth-catch to tag
stack-reset
tag if
- tag car 'no-such-channel = unless
- $" edpos clobbers channel: %s" #( tag ) snd-display
+ tag car 'no-such-sound <> if
+ "revert-sound of closed sound: %s" #( tag ) snd-display
then
then
- ind sound? if $" edpos proc clobbers chan??: %s" #( ind ) snd-display then
+ \
set-procs04 length 2 = if
- $" (%s %s)" set-procs04
+ "(%s %s)" set-procs04
else
"%s" #( set-procs04 )
then string-format { set04fncs }
procs10 length 2 = if
- $" (%s %s)" procs10
+ "(%s %s)" procs10
else
"%s" #( procs10 )
then string-format { 10fncs }
*snd-test-verbose* if
- $" procs prcs/set-prcs" #f snd-test-message
- $" =====================" #f snd-test-message
- $" procs00: %3d/%3d" #( procs00 length set-procs00 length ) snd-test-message
- $" procs01: %3d/%3d" #( procs01 length set-procs01 length ) snd-test-message
- $" procs02: %3d/%3d" #( procs02 length set-procs02 length ) snd-test-message
- $" procs03: %3d/%3d" #( procs03 length set-procs03 length ) snd-test-message
- $" procs04: %3d/%3d %s" #( procs04 length set-procs04 length set04fncs ) snd-test-message
- $" procs05: %3d" #( procs05 length ) snd-test-message
- $" procs06: %3d" #( procs06 length ) snd-test-message
- $" procs07: %3d" #( procs07 length ) snd-test-message
- $" procs08: %3d" #( procs08 length ) snd-test-message
- $" procs10: %3d %s" #( procs10 length 10fncs ) snd-test-message
- then
- #( 1.5 #( 0 1 ) 1234 #t ) { random-args }
- #( 1.5 #( 0 1 ) 1234 vct-3 color-95 -1.0 csqrt delay-32 :feedback #f ) { main-args }
- #( 1.5 #( 0 1 ) 1234 -1.0 csqrt delay-32 #t ) { few-args }
- #( 1.5 vct-3 -1.0 csqrt ) { fewer-args }
- all-args if main-args else few-args then { less-args }
+ "procs prcs/set-prcs" #f snd-test-message
+ "=====================" #f snd-test-message
+ "procs00: %3d/%3d" #( procs00 length set-procs00 length ) snd-test-message
+ "procs01: %3d/%3d" #( procs01 length set-procs01 length ) snd-test-message
+ "procs02: %3d/%3d" #( procs02 length set-procs02 length ) snd-test-message
+ "procs03: %3d/%3d" #( procs03 length set-procs03 length ) snd-test-message
+ set-procs04 length 10 <= if
+ "procs04: %3d/%3d %s"
+ #( procs04 length set-procs04 length set04fncs ) snd-test-message
+ else
+ "procs04: %3d/%3d" #( procs04 length set-procs04 length ) snd-test-message
+ then
+ "procs05: %3d" #( procs05 length ) snd-test-message
+ "procs06: %3d" #( procs06 length ) snd-test-message
+ "procs07: %3d" #( procs07 length ) snd-test-message
+ "procs08: %3d" #( procs08 length ) snd-test-message
+ procs10 length 10 <= if
+ "procs10: %3d %s" #( procs10 length 10fncs ) snd-test-message
+ else
+ "procs10: %3d" #( procs10 length ) snd-test-message
+ then
+ then
+ #( 1.5 #( 0 1 ) 1234 #t ) { random-args }
+ #( 1.5 #( 0 1 ) 1234 vct-3 color-95 0+i delay-32 :feedback #f ) { main-args }
+ #( 1.5 #( 0 1 ) 1234 0+i delay-32 #t ) { few-args }
+ #( 1.5 vct-3 0+i ) { fewer-args }
+ all-args if
+ main-args
+ else
+ few-args
+ then { less-args }
nil nil nil nil nil nil nil { arg1 arg2 arg3 arg4 tm prc tag }
gc-run
"keyargs-2-args" check-args-progress-info
keyargs each to arg1
random-args each to arg2
make-procs each to prc
- arg1 arg2 prc #t nil fth-catch stack-reset
+ arg1 arg2 prc #t nil fth-catch stack-reset
end-each
end-each
end-each
@@ -8855,11 +7984,11 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
"keyargs-3-args" check-args-progress-info
random-args each to arg1
keyargs each to arg2
- random-args each to arg3
- make-procs each to prc
- arg1 arg2 arg3 prc #t nil fth-catch stack-reset
- end-each
- end-each
+ random-args each to arg3
+ make-procs each to prc
+ arg1 arg2 arg3 prc #t nil fth-catch stack-reset
+ end-each
+ end-each
end-each
end-each
dismiss-all-dialogs
@@ -8867,13 +7996,13 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
"keyargs-4-args" check-args-progress-info
keyargs each to arg1
random-args each to arg2
- keyargs each to arg3
- random-args each to arg4
- make-procs each to prc
- arg1 arg2 arg3 arg4 prc #t nil fth-catch stack-reset
- end-each
- end-each
- end-each
+ keyargs each to arg3
+ random-args each to arg4
+ make-procs each to prc
+ arg1 arg2 arg3 arg4 prc #t nil fth-catch stack-reset
+ end-each
+ end-each
+ end-each
end-each
end-each
dismiss-all-dialogs
@@ -8884,7 +8013,7 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
prc #t nil fth-catch to tag
stack-reset
tag car 'wrong-number-of-args = if
- $" procs00: %s %s" #( prc tag ) snd-display
+ "procs00: %s %s" #( prc tag ) snd-display
then
end-each
dismiss-all-dialogs
@@ -8895,7 +8024,7 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
arg prc set-xt #t nil fth-catch to tag
stack-reset
tag car 'wrong-number-of-args = if
- $" set-procs00: (%s) %s %s" #( arg prc tag ) snd-display
+ "set-procs00: (%s) %s %s" #( arg prc tag ) snd-display
then
end-each
end-each
@@ -8908,7 +8037,7 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
arg prc #t nil fth-catch to tag
stack-reset
tag car 'wrong-number-of-args = if
- $" procs01 wna: (%s) %s %s" #( arg prc tag ) snd-display
+ "procs01 wna: (%s) %s %s" #( arg prc tag ) snd-display
then
end-each
end-each
@@ -8918,13 +8047,13 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
main-args each to arg1
main-args each to arg2
set-procs01 each to prc
- prc proc-name "widget-size" string= unless
- arg1 arg2 prc set-xt #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" set-procs01: (%s %s) %s %s" #( arg1 arg2 prc tag ) snd-display
- then
- then
+ prc proc-name "widget-size" string<> if
+ arg1 arg2 prc set-xt #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "set-procs01: (%s %s) %s %s" #( arg1 arg2 prc tag ) snd-display
+ then
+ then
end-each
end-each
end-each
@@ -8934,11 +8063,11 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
main-args each to arg1
main-args each to arg2
procs02 each to prc
- arg1 arg2 prc #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" procs02: (%s %s) %s %s" #( arg1 arg2 prc tag ) snd-display
- then
+ arg1 arg2 prc #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "procs02: (%s %s) %s %s" #( arg1 arg2 prc tag ) snd-display
+ then
end-each
end-each
end-each
@@ -8948,13 +8077,14 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
less-args each to arg1
less-args each to arg2
less-args each to arg3
- set-procs02 each to prc
- arg1 arg2 arg3 prc set-xt #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" set-procs02: (%s %s %s) %s %s" #( arg1 arg2 arg3 prc tag ) snd-display
- then
- end-each
+ set-procs02 each to prc
+ arg1 arg2 arg3 prc set-xt #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "set-procs02: (%s %s %s) %s %s"
+ #( arg1 arg2 arg3 prc tag ) snd-display
+ then
+ end-each
end-each
end-each
end-each
@@ -8965,13 +8095,13 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
less-args each to arg1
less-args each to arg2
less-args each to arg3
- procs03 each to prc
- arg1 arg2 arg3 prc #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" procs03: (%s %s %s) %s %s" #( arg1 arg2 arg3 prc tag ) snd-display
- then
- end-each
+ procs03 each to prc
+ arg1 arg2 arg3 prc #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "procs03: (%s %s %s) %s %s" #( arg1 arg2 arg3 prc tag ) snd-display
+ then
+ end-each
end-each
end-each
end-each
@@ -8981,15 +8111,16 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
less-args each to arg1
less-args each to arg2
less-args each to arg3
- less-args each to arg4
- set-procs03 each to prc
- arg1 arg2 arg3 arg4 prc #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" set-procs03: (%s %s %s %s) %s %s" #( arg1 arg2 arg3 arg4 prc tag ) snd-display
- then
- end-each
- end-each
+ less-args each to arg4
+ set-procs03 each to prc
+ arg1 arg2 arg3 arg4 prc #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "set-procs03: (%s %s %s %s) %s %s"
+ #( arg1 arg2 arg3 arg4 prc tag ) snd-display
+ then
+ end-each
+ end-each
end-each
end-each
end-each
@@ -8999,15 +8130,16 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
few-args each to arg1
few-args each to arg2
few-args each to arg3
- few-args each to arg4
- procs04 each to prc
- arg1 arg2 arg3 arg4 prc #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" procs04: (%s %s %s %s) %s %s" #( arg1 arg2 arg3 arg4 prc tag ) snd-display
- then
- end-each
- end-each
+ few-args each to arg4
+ procs04 each to prc
+ arg1 arg2 arg3 arg4 prc #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "procs04: (%s %s %s %s) %s %s"
+ #( arg1 arg2 arg3 arg4 prc tag ) snd-display
+ then
+ end-each
+ end-each
end-each
end-each
end-each
@@ -9017,22 +8149,21 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
few-args each to arg1
few-args each to arg2
few-args each to arg3
- few-args each to arg4
- few-args each to arg5
- set-procs04 each to prc
- arg1 arg2 arg3 arg4 arg5 prc #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" set-procs04: (%s %s %s %s %s) %s %s"
- #( arg1 arg2 arg3 arg4 arg5 prc tag ) snd-display
- then
- end-each
- end-each
- end-each
+ few-args each to arg4
+ few-args each to arg5
+ set-procs04 each to prc
+ arg1 arg2 arg3 arg4 arg5 prc #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "set-procs04: (%s %s %s %s %s) %s %s"
+ #( arg1 arg2 arg3 arg4 arg5 prc tag ) snd-display
+ then
+ end-each
+ end-each
+ end-each
end-each
end-each
end-each
- clear-sincs drop
stop-playing drop
dismiss-all-dialogs
gc-run
@@ -9040,42 +8171,41 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
fewer-args each to arg1
fewer-args each to arg2
fewer-args each to arg3
- fewer-args each to arg4
- fewer-args each to arg5
- procs05 each to prc
- arg1 arg2 arg3 arg4 arg5 prc #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" procs05: (%s %s %s %s %s) %s %s"
- #( arg1 arg2 arg3 arg4 arg5 prc tag ) snd-display
- then
- end-each
- end-each
- end-each
+ fewer-args each to arg4
+ fewer-args each to arg5
+ procs05 each to prc
+ arg1 arg2 arg3 arg4 arg5 prc #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "procs05: (%s %s %s %s %s) %s %s"
+ #( arg1 arg2 arg3 arg4 arg5 prc tag ) snd-display
+ then
+ end-each
+ end-each
+ end-each
end-each
end-each
end-each
- clear-sincs drop
dismiss-all-dialogs
gc-run
"6-args" check-args-progress-info
fewer-args each to arg1
fewer-args each to arg2
fewer-args each to arg3
- fewer-args each to arg4
- fewer-args each to arg5
- fewer-args each to arg6
- procs06 each to prc
- arg1 arg2 arg3 arg4 arg5 arg6 prc #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" procs06: (%s %s %s %s %s %s) %s %s"
- #( arg1 arg2 arg3 arg4 arg5 arg6 prc tag ) snd-display
- then
- end-each
- end-each
- end-each
- end-each
+ fewer-args each to arg4
+ fewer-args each to arg5
+ fewer-args each to arg6
+ procs06 each to prc
+ arg1 arg2 arg3 arg4 arg5 arg6 prc #t nil fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "procs06: (%s %s %s %s %s %s) %s %s"
+ #( arg1 arg2 arg3 arg4 arg5 arg6 prc tag ) snd-display
+ then
+ end-each
+ end-each
+ end-each
+ end-each
end-each
end-each
end-each
@@ -9085,24 +8215,26 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
fewer-args each to arg1
fewer-args each to arg2
fewer-args each to arg3
- fewer-args each to arg4
- fewer-args each to arg5
- fewer-args each to arg6
- fewer-args each to arg7
- fewer-args each to arg8
- procs08 each to prc
- arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 prc #t nil fth-catch to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" procs08: (%s %s %s %s %s %s %s %s) %s %s"
- #( arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 prc tag ) snd-display
- then
- end-each
- end-each
- end-each
- end-each
- end-each
- end-each
+ fewer-args each to arg4
+ fewer-args each to arg5
+ fewer-args each to arg6
+ fewer-args each to arg7
+ fewer-args each to arg8
+ procs08 each to prc
+ arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 prc #t nil
+ fth-catch to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "procs08: (%s %s %s %s %s %s %s %s) %s %s"
+ #( arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 prc tag )
+ snd-display
+ then
+ end-each
+ end-each
+ end-each
+ end-each
+ end-each
+ end-each
end-each
end-each
end-each
@@ -9112,51 +8244,54 @@ set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04
fewer-args each to arg1
fewer-args each to arg2
fewer-args each to arg3
- fewer-args each to arg4
- fewer-args each to arg5
- fewer-args each to arg6
- fewer-args each to arg7
- fewer-args each to arg8
- fewer-args each to arg9
- fewer-args each to arg0
- procs10 each to prc
- arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg0 prc #t nil fth-catch
- to tag
- stack-reset
- tag car 'wrong-number-of-args = if
- $" procs10: (%s %s %s %s %s %s %s %s %s %s) %s %s"
- #( arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg0 prc tag )
- snd-display
- then
- end-each
- end-each
- end-each
- end-each
- end-each
- end-each
- end-each
- end-each
+ fewer-args each to arg4
+ fewer-args each to arg5
+ fewer-args each to arg6
+ fewer-args each to arg7
+ fewer-args each to arg8
+ fewer-args each to arg9
+ fewer-args each to arg0
+ procs10 each to prc
+ arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg0
+ prc #t nil fth-catch
+ to tag
+ stack-reset
+ tag car 'wrong-number-of-args = if
+ "procs10: (%s %s %s %s %s %s %s %s %s %s) %s %s"
+ #( arg1 arg2 arg3 arg4 arg5 arg6 arg7
+ arg8 arg9 arg0 prc tag ) snd-display
+ then
+ end-each
+ end-each
+ end-each
+ end-each
+ end-each
+ end-each
+ end-each
+ end-each
end-each
end-each
end-each
- clear-sincs drop
dismiss-all-dialogs
gc-run
+ #f set-ask-about-unsaved-edits drop
;
: 30-test
- #( 1.5 #( 0 1 ) 1234 #t ) { random-args }
- #( 1.5 #( 0 1 ) 1234 vct-3 color-95 -1.0 csqrt delay-32 :feedback #f ) { main-args }
- #( 1.5 #( 0 1 ) 1234 -1.0 csqrt delay-32 #t ) { few-args }
- #( 1.5 vct-3 -1.0 csqrt ) { fewer-args }
- fewer-args { less-args }
- fewer-args to random-args
- fewer-args to few-args
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- { ind prc tag arg arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg0 tm }
- make-timer to tm
- tm stop-timer
- \ "%s" #( tm ) snd-test-message
+ \ from clm-ins.fs
+ <'> test23-balance
+ :comment over object->string
+ :channels 3 with-sound ws-output 0 find-sound { ind }
+ ind sound? if
+ ind close-sound drop
+ else
+ "with-sound balance?" snd-display
+ then
+ "test.snd" "test23-balance" *lineno* check-maxamp
+ \ 0.0 0.3 <'> clm-ins-test
+ \ :comment over object->string
+ \ :notehook *snd-test-ws-verbose* if <'> test23-notehook else #f then
+ \ :channels 2 with-sound ws-close-sound
;
let: ( -- )
@@ -9166,32 +8301,37 @@ let: ( -- )
script-args i list-ref string->number { n }
script-arg 1+ set-script-arg drop
n 0< if
- numbs n array-push to numbs \ negative number means exclude this test
+ numbs n array-push to numbs \ negative number means exclude this test
else
- test-numbers n array-push to test-numbers
+ test-numbers n array-push to test-numbers
then
loop
then
test-numbers empty? if
- 29 -1 do test-numbers i array-push to test-numbers loop
+ 29 -1 do
+ test-numbers i array-push to test-numbers
+ loop
then
- numbs each abs { n } test-numbers test-numbers n array-index array-delete! drop end-each
+ numbs each abs { n }
+ test-numbers test-numbers n array-index array-delete! drop
+ end-each
.stack
start-snd-test
<'> 00-constants run-fth-test
<'> 01-defaults run-fth-test
+ mus-ldouble set-default-output-sample-type drop
<'> 02-headers run-fth-test
<'> 03-variables run-fth-test
<'> 04-sndlib run-fth-test
<'> 05-simple-check run-fth-test
+ <'> 08-clm run-fth-test
<'> 10-marks run-fth-test
<'> 15-chan-local-vars run-fth-test
<'> 19-save/restore run-fth-test
<'> 23-with-sound run-fth-test
- <'> 26-gtk run-fth-test
<'> 27-sel-from-snd run-fth-test
<'> 28-errors run-fth-test
- <'> 30-test run-fth-test \ local fragment test
+ <'> 30-test run-fth-test \ local fragment test
finish-snd-test
0 snd-exit drop
;let
diff --git a/snd-test.rb b/snd-test.rb
index c321598..dda5069 100644
--- a/snd-test.rb
+++ b/snd-test.rb
@@ -1,18 +1,15 @@
# snd-test.rb -- Snd Ruby code and tests
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Sat Feb 18 10:18:34 CET 2005
-# Changed: Sun Mar 06 18:15:59 CET 2011
+# Created: 05/02/18 10:18:34
+# Changed: 15/03/05 13:28:53
-# Commentary:
+# Tags: FIXME - something is wrong
+# XXX - info marker
#
# Tested with:
-# Snd version 11.14 of 7-Mar-11
-# ruby 1.8.0 (2003-08-04)
-# ruby 1.8.7 (2010-08-16 patchlevel 302)
-# ruby 1.9.2p0 (2010-08-18 revision 29036)
-# ruby 1.9.3dev (2011-03-06 trunk 31031)
-
+# Snd 15.x
+# Ruby 2.x.x
#
# Reads init file ./.sndtest.rb or ~/.sndtest.rb for global variables,
# hooks, etc.
@@ -24,8 +21,6 @@
# $VERBOSE = true
# $DEBUG = true
-# (ENV["RUBYLIB"] or $HOME + "/share/snd").split(/:/).each do |f| $LOAD_PATH.unshift(f) end
-
$original_save_dir = set_save_dir(ENV["TMPDIR"])
$original_temp_dir = set_temp_dir(save_dir)
$info_array_print_length = 4
@@ -37,9 +32,7 @@ $with_big_file = true
# $bigtest_08 = true
# $tests = 2
-def bye(n = 0)
- exit(n)
-end
+alias bye exit
=end
#
@@ -89,7 +82,7 @@ $original_save_dir = (save_dir or $HOME + "/zap/snd")
$original_temp_dir = (temp_dir or $HOME + "/zap/tmp")
$original_sound_file_extensions = sound_file_extensions
$original_prompt = listener_prompt
-$default_file_buffer_size = 65536
+$default_file_buffer_size = mus_file_buffer_size()
$info_array_print_length = 24
$sf_dir = "/home/bil/sf1/"
@@ -118,17 +111,22 @@ require "clm"
$tests = ((integer?($tests) and $tests > 0) ? $tests : 1)
$clmtest = 0
-$with_test_nogui = provided? :snd_nogui
+$with_test_nogui = provided?("snd-nogui")
$with_test_gui = (not $with_test_nogui)
-$with_test_motif = provided? :snd_motif
-$with_test_gtk = provided? :snd_gtk
-$with_test_ladspa = provided? :snd_ladspa
-$with_test_gl = provided? :gl
-$with_test_gl2ps = provided? :gl2ps
-$with_test_gsl = provided? :gsl
-$with_test_alsa = provided? :alsa
+$with_test_motif = provided?("snd-motif")
+$with_test_gtk = provided?("snd-gtk")
+$with_test_gtk3 = provided?("gtk3")
+$with_test_ladspa = provided?("snd-ladspa")
+$with_test_gl = provided?("gl")
+$with_test_gl2ps = provided?("gl2ps")
+$with_test_gsl = provided?("gsl")
+$with_test_alsa = provided?("alsa")
if $with_test_nogui
+ def noop(*args, &body)
+ false
+ end
+
undef x_bounds
undef set_x_bounds
undef y_bounds
@@ -141,24 +139,25 @@ if $with_test_nogui
undef colormap
undef set_colormap
- # FIXME
- # snd-nogui.c defines "in"
+ # XXX: snd-nogui.c defines "in"
alias call_in in
+ alias integer2colormap noop
+ alias colormap2integer noop
+ alias axis_color noop
+ alias highlight_color noop
+
x_bounds_value = [0.0, 0.1]
make_proc_with_setter(:x_bounds,
- Proc.new do |*args| x_bounds_value end,
- Proc.new do |bounds, *args| x_bounds_value = bounds end)
+ Proc.new do |*args| x_bounds_value end,
+ Proc.new do |bounds, *args| x_bounds_value = bounds end)
y_bounds_value = [-1.0, 1.0]
make_proc_with_setter(:y_bounds,
- Proc.new do |*args| y_bounds_value end,
- Proc.new do |bounds, *args| y_bounds_value = bounds end)
+ Proc.new do |*args| y_bounds_value end,
+ Proc.new do |bounds, *args| y_bounds_value = bounds end)
- #
- # FIXME
- #
- # For ruby18 it's important to define Procs with arity 0 in this way:
+ # XXX: For ruby18 it's important to define Procs with arity 0 in this way:
#
# Proc.new do | | enved_filter_value end
# or Proc.new do enved_filter_value end
@@ -169,32 +168,30 @@ if $with_test_nogui
# lambda do | | enved_filter_value end
#
# Otherwise we can't correctly determine the arity in test 28.
- #
enved_filter_value = true
make_proc_with_setter(:enved_filter,
- Proc.new do | | enved_filter_value end,
- Proc.new do |val| enved_filter_value = val end)
+ Proc.new do | | enved_filter_value end,
+ Proc.new do |val| enved_filter_value = val end)
graph_cursor_value = 34
make_proc_with_setter(:graph_cursor,
- Proc.new do | | graph_cursor_value end,
- Proc.new do |val| graph_cursor_value = val end)
+ Proc.new do | | graph_cursor_value end,
+ Proc.new do |val| graph_cursor_value = val end)
enved_envelope_value = nil
make_proc_with_setter(:enved_envelope,
- Proc.new do | | enved_envelope_value end,
- Proc.new do |val| enved_envelope_value = val end)
+ Proc.new do | | enved_envelope_value end,
+ Proc.new do |val| enved_envelope_value = val end)
colormap_value = $hot_colormap
make_proc_with_setter(:colormap,
- Proc.new do | | colormap_value end,
- Proc.new do |val|
- if val.kind_of?(Numeric) and val.between?(0, 20)
- colormap_value = val
- end
- end)
-
- # These global variables are already defined and set to false in snd-nogui.c.
+ Proc.new do | | colormap_value end,
+ Proc.new do |val|
+ if val.kind_of?(Numeric) and val.between?(0, 20)
+ colormap_value = val
+ end
+ end)
+
$mouse_enter_graph_hook = Hook.new("$mouse_enter_graph_hook", 2)
$mouse_enter_label_hook = Hook.new("$mouse_enter_label_hook", 3)
$mouse_enter_listener_hook = Hook.new("$mouse_enter_listener_hook", 1)
@@ -218,26 +215,25 @@ require "dsp"
require "analog-filter"
require "rgb"
require "effects"
-require "xm-enved"
require "draw"
require "musglyphs"
if $with_test_motif
RXSetErrorHandler(lambda do |dpy, e|
- val, err = RXGetErrorText(dpy, Rerror_code(e), nil, 1024)
- $stderr.printf("Xlib error_code[%s]: %s\n", val, err)
- val, err = RXGetErrorText(dpy, Rrequest_code(e), nil, 1024)
- $stderr.printf("Xlib request_code[%s]: %s\n", val, err)
- val, err = RXGetErrorText(dpy, Rminor_code(e), nil, 1024)
- $stderr.printf("Xlib minor_code[%s]: %s\n", val, err)
- $stderr.printf("Ruby $!: %s\n", $!.inspect)
- $stderr.printf("Ruby $@: %s\n", $@.inspect)
- end)
+ val, err = RXGetErrorText(dpy, Rerror_code(e), nil, 1024)
+ $stderr.printf("Xlib error_code[%s]: %s\n", val, err)
+ val, err = RXGetErrorText(dpy, Rrequest_code(e), nil, 1024)
+ $stderr.printf("Xlib request_code[%s]: %s\n", val, err)
+ val, err = RXGetErrorText(dpy, Rminor_code(e), nil, 1024)
+ $stderr.printf("Xlib minor_code[%s]: %s\n", val, err)
+ $stderr.printf("Ruby $!: %s\n", $!.inspect)
+ $stderr.printf("Ruby $@: %s\n", $@.inspect)
+ end)
RXSetIOErrorHandler(lambda do |dpy|
- $stderr.printf("Xlib IO Error dpy: %s", dpy.inspect)
- $stderr.printf("Ruby $!: %s\n", $!.inspect)
- $stderr.printf("Ruby $@: %s\n", $@.inspect)
- end)
+ $stderr.printf("Xlib IO Error dpy: %s", dpy.inspect)
+ $stderr.printf("Ruby $!: %s\n", $!.inspect)
+ $stderr.printf("Ruby $@: %s\n", $@.inspect)
+ end)
end
# Returns Ascii value of KEY as a Fixnum.
@@ -284,17 +280,12 @@ end
reset_almost_all_hooks
-# to prepare view_files_infos in snd-xfile.c
-# (save_state calls save_view_files_dialogs() in snd-xfile.c)
-Snd.add_sound_path(Dir.pwd)
-
$test_functions = Array.new
def main_test
start_snd_test()
if false
- # FIXME
- # Instead of rand() one can use different command lines:
+ # XXX: Instead of rand() one can use different command lines:
# snd -noinit snd-test.rb 3 2 1
# snd -noinit snd-test.rb 1 3 2
# etc.
@@ -381,12 +372,14 @@ def snd_format(res, req, op = "!=", fmt = "", *args)
if res.nil?
res = "nil"
end
- str = snd_test_format("res #{op} req?\n# => res %s\n# => req %s", res, req, fmt, *args)
+ str = snd_test_format("res #{op} req?\n# => res %s\n# => req %s",
+ res, req, fmt, *args)
set_mus_array_print_length(old_alen)
set_print_length(old_vlen)
str
else
- snd_test_format("res %s #{op} req %s?", res.inspect, req.inspect, fmt, *args)
+ snd_test_format("res %s #{op} req %s?",
+ res.inspect, req.inspect, fmt, *args)
end
end
@@ -394,6 +387,10 @@ def snd_format_neq(res, req, fmt = "", *args)
snd_format(res, req, "!=", fmt, *args)
end
+def snd_format_eq(res, req, fmt = "", *args)
+ snd_format(res, req, "==", fmt, *args)
+end
+
def snd_test_equal?(res, req)
case req
when Float
@@ -443,17 +440,37 @@ def snd_test_any_eq(res, req, func, fmt = "", *args)
end
end
+def snd_test_lt(res, req, fmt = "", *args)
+ if res < req
+ snd_display_prev_caller(snd_format(res, req, "<", fmt, *args))
+ true
+ else
+ false
+ end
+end
+
+def snd_test_gt(res, req, fmt = "", *args)
+ if res > req
+ snd_display_prev_caller(snd_format(res, req, ">", fmt, *args))
+ true
+ else
+ false
+ end
+end
+
# command line args: last arg(s) may be zero or many test numbers
# snd -noinit -load snd-test.rb 3 7 20 # only tests 3, 7, 20
# snd -noinit -load snd-test.rb -23 # all tests except 23
lambda do
- # non existent tests, non wanted tests (negative arguments like -23) added here
+ # non existent tests, non wanted tests (negative arguments like -23)
+ # added here
nargs = [22, 24, 25, 26, 27, 29]
targs = []
if script_arg.positive?
script_args[script_arg..-1].each do |arg|
- if integer?(n = Snd.catch(:all, nil) do Integer(arg) end.first)
+ n = Snd.catch(:all, nil) do Integer(arg) end.first
+ if integer?(n)
if n < 0
nargs << n.abs
elsif n <= 30 # test_30 for short tests
@@ -510,7 +527,9 @@ end
# compares Arrays and Vcts
def vequal_err(val0, val1, err = 0.001)
- (v0 = any2vct(val0)) and (v1 = any2vct(val1)) and v0.subtract(v1).peak <= err
+ (v0 = any2vct(val0)) and
+ (v1 = any2vct(val1)) and
+ (v0.subtract(v1).peak <= err)
end
def vequal?(v0, v1)
@@ -560,6 +579,30 @@ def vcneql(a, b)
end
end
+def cequal?(a, b)
+ if number?(a) and number?(b)
+ fequal?(a.real, b.real) and fequal?(a.imag, b.imag)
+ else
+ false
+ end
+end
+
+def vcequal?(a, b)
+ if a.length != b.length
+ false
+ else
+ a.each_with_index do |x, i|
+ if cneq(x, b[i])
+ return false
+ end
+ end
+ true
+ end
+end
+
+alias cequal cequal?
+alias vcequal vcequal?
+
def vmaxdiff(v0, v1)
v0.dup.subtract(v1).peak
end
@@ -580,11 +623,12 @@ def any_arity(obj)
end
def arity_ok(func, args)
- if integer?(rargs = Snd.catch do any_arity(func) end.first)
+ rargs = Snd.catch do any_arity(func) end.first
+ if integer?(rargs)
if rargs >= 0
args == rargs
else
- args >= (rargs.abs - 1) # We have no idea how much optional args FUNC has.
+ args >= (rargs.abs - 1) # We have no idea how much optional args.
end
else
false
@@ -620,9 +664,11 @@ else
end
end
-def safe_display_edits(snd = false, chn = false, edpos = false, with_source = true)
- Snd.catch(:all, lambda do |*args| snd_display_prev_caller("display_edits: %s", args) end) do
- display_edits(snd, chn, edpos, with_source)
+def safe_display_edits(snd = false, chn = false, edpos = false, with_src = true)
+ Snd.catch(:all, lambda do |*args|
+ snd_display_prev_caller("display_edits: %s", args)
+ end) do
+ display_edits(snd, chn, edpos, with_src)
end.first
end
@@ -630,7 +676,6 @@ def safe_divide(a, b)
b.zero? ? a : (a / b)
end
-set_mus_file_buffer_size($default_file_buffer_size)
set_with_background_processes(false)
def make_color_with_catch(c1, c2, c3)
@@ -640,7 +685,7 @@ rescue
end
def file_copy(f1, f2)
- if File.exists?(f1)
+ if File.exist?(f1)
fin = File.open(f1, "r")
fout = File.open(f2, "w")
fout.write(fin.read) until fin.eof?
@@ -658,11 +703,11 @@ def delete_files(*files)
end
def with_file(file, verbose = $DEBUG, &body)
- if File.exists?(full_name = $sf_dir + file)
+ if File.exist?(full_name = $sf_dir + file)
body.call(full_name)
else
if verbose
- snd_info("%s missing?", full_name)
+ snd_display_prev_caller("%s missing?", full_name)
end
end
end
@@ -676,16 +721,20 @@ def with_gc_disabled
end
Snd_error_tags.each do |tag|
- if (res = Snd.catch(tag) do Snd.throw(tag, "snd-test") end).first != tag
+ res = Snd.catch(tag) do Snd.throw(tag, "snd-test") end
+ if res.first != tag
snd_display("Snd.catch (throwing 1): %s -> %s", tag.inspect, res.inspect)
end
- if (res = Snd.catch(tag) do Snd.raise(tag, "snd-test") end).first != tag
+ res = Snd.catch(:all) do Snd.raise(tag, "snd-test") end
+ if res.first != tag
snd_display("Snd.catch (raising 1): %s -> %s", tag.inspect, res.inspect)
end
- if (res = Snd.catch(tag, :okay) do Snd.throw(tag, "snd-test") end).first != :okay
+ res = Snd.catch(tag, :okay) do Snd.throw(tag, "snd-test") end
+ if res.first != :okay
snd_display("Snd.catch (throwing 2): %s -> %s", tag.inspect, res.inspect)
end
- if (res = Snd.catch(tag, :okay) do Snd.raise(tag, "snd-test") end).first != :okay
+ res = Snd.catch(:all, :okay) do Snd.raise(tag, "snd-test") end
+ if res.first != :okay
snd_display("Snd.catch (raising 2): %s -> %s", tag.inspect, res.inspect)
end
end
@@ -752,9 +801,10 @@ def start_snd_test()
"unknown"
end
snd_info("=== Snd version: %s (snd_%s)", snd_version, kind)
- snd_info("=== Ruby version: %s (%s) [%s]", RUBY_VERSION, RUBY_RELEASE_DATE, RUBY_PLATFORM)
+ snd_info("=== Ruby version: %s (%s) [%s]",
+ RUBY_VERSION, RUBY_RELEASE_DATE, RUBY_PLATFORM)
snd_info("")
- snd_info("%s", Time.now.localtime.strftime("%a %d-%b-%Y %I:%M %p %Z"))
+ snd_info("%s", Time.now.localtime.strftime("%a %d-%b-%Y %I:%M %p"))
snd_info("")
$overall_start_time = Snd_test_time.new
end
@@ -762,8 +812,6 @@ end
def finish_snd_test()
$overall_start_time.stop
Snd.regions.apply(:forget_region)
- set_view_files_sort(0)
- clear_sincs
stop_playing
reset_almost_all_hooks
set_ask_about_unsaved_edits(false)
@@ -771,7 +819,9 @@ def finish_snd_test()
snd_info("all done!")
snd_info("")
unless $timings.empty?
- $timings.each do |tst| snd_info("%s %s", tst.first, tst.last.inspect) end
+ $timings.each do |tst|
+ snd_info("%s %s", tst.first, tst.last.inspect)
+ end
end
snd_info("total %s\n", $overall_start_time.inspect)
set_show_listener(true)
@@ -784,12 +834,13 @@ end
def clear_test_files
fs = 0
[$original_save_dir, $original_temp_dir, "/tmp"].each do |path|
- if File.exists?(path)
+ if File.exist?(path)
fs += Dir[path + "/snd_*"].length
Dir[path + "/snd_*"].each do |f| delete_file(f) end
end
end
- snd_info("%s temporary file%s deleted", fs.zero? ? "no" : fs, fs.between?(0, 1) ? "" : "s")
+ snd_info("%s temporary file%s deleted",
+ fs.zero? ? "no" : fs, fs.between?(0, 1) ? "" : "s")
mus_sound_prune
$snd_opened_sound = false
["1",
@@ -839,7 +890,7 @@ def clear_test_files
"tmp.snd",
"with-mix.rbm",
"with-mix.snd"].each do |file| delete_file(file) end
- ["bad_data_format.snd.snd",
+ ["bad_sample_type.snd.snd",
"ce-c3.w02.snd",
"hcom-16.snd.snd",
"ieee-text-16.snd.snd",
@@ -847,9 +898,6 @@ def clear_test_files
"nasahal.avi.snd",
"nist-shortpack.wav.snd",
"o2_dvi.wave.snd",
- "oboe.g721.snd",
- "oboe.g723_24.snd",
- "oboe.g723_40.snd",
"oki.wav.snd",
"trumps22.adp.snd",
"wood.sds.snd"].each do |file|
@@ -858,6 +906,7 @@ def clear_test_files
end
def before_test(func)
+ set_sync_style(Sync_none)
set_mus_srate($clm_srate = $default_srate.to_i)
set_clipping(false)
set_mus_clipping(false)
@@ -875,7 +924,11 @@ def after_test(func)
set_ask_about_unsaved_edits(false)
set_remember_sound_state(false)
dismiss_all_dialogs
- snd_info("%s done%s\n#", func, $VERBOSE ? format(" (%s)", $timings.last.last) : "")
+ if $VERBOSE
+ snd_info("%s done (%s)\n#", func, $timings.last.last)
+ else
+ snd_info("%s done\n#", func)
+ end
end
# returns body's return value or error symbol (eg. :no_such_sound)
@@ -1086,7 +1139,8 @@ if $with_test_motif
if RWidget?(button)
if RXtIsSensitive(button)
if RXmIsPushButton(button) or RXmIsPushButtonGadget(button)
- if RXtHasCallbacks(button, RXmNactivateCallback) == RXtCallbackHasSome
+ if RXtHasCallbacks(button,
+ RXmNactivateCallback) == RXtCallbackHasSome
but = RXmPushButtonCallbackStruct()
Rset_click_count(but, 0)
e = RXEvent(RButtonPress)
@@ -1094,11 +1148,13 @@ if $with_test_motif
Rset_event(but, e)
RXtCallCallbacks(button, RXmNactivateCallback, but)
else
- snd_display("pushbutton %s has no active callbacks", RXtName(button))
+ snd_display("pushbutton %s has no active callbacks",
+ RXtName(button))
end
else
if RXmIsToggleButton(button) or RXmIsToggleButtonGadget(button)
- if RXtHasCallbacks(button, RXmNvalueChangedCallback) == RXtCallbackHasSome
+ if RXtHasCallbacks(button,
+ RXmNvalueChangedCallback) == RXtCallbackHasSome
tgl = RXmToggleButtonCallbackStruct()
Rset_set(tgl, value)
e = RXEvent(RButtonPress)
@@ -1106,11 +1162,13 @@ if $with_test_motif
Rset_event(tgl, e)
RXtCallCallbacks(button, RXmNvalueChangedCallback, tgl)
else
- snd_display("togglebutton %s has no valueChanged callbacks", RXtName(button))
+ snd_display("togglebutton %s has no valueChanged callbacks",
+ RXtName(button))
end
else
if RXmIsArrowButton(button)
- if RXtHasCallbacks(button, RXmNactivateCallback) == RXtCallbackHasSome
+ if RXtHasCallbacks(button,
+ RXmNactivateCallback) == RXtCallbackHasSome
arr = RXmArrowButtonCallbackStruct()
Rset_click_count(arr, 0)
e = RXEvent(RButtonPress)
@@ -1118,7 +1176,8 @@ if $with_test_motif
Rset_event(arr, e)
RXtCallCallbacks(button, RXmNactivateCallback, arr)
else
- snd_display("arrowbutton %s has no active callbacks", RXtName(button))
+ snd_display("arrowbutton %s has no active callbacks",
+ RXtName(button))
end
else
snd_display("%s (%s) is not a push or toggle button",
@@ -1153,7 +1212,8 @@ if $with_test_motif
end
def take_keyboard_focus(wid)
- if RXmIsTraversable(wid) and (RXmGetVisibility(wid) != RXmVISIBILITY_FULLY_OBSCURED)
+ if RXmIsTraversable(wid) and
+ (RXmGetVisibility(wid) != RXmVISIBILITY_FULLY_OBSCURED)
RXmProcessTraversal(wid, RXmTRAVERSE_CURRENT)
end
end
@@ -1187,9 +1247,11 @@ if $with_test_motif
end
dpy = RXtDisplay(main_widgets[1])
natom = RXInternAtom(dpy, winat, false)
- if RWindow?(window = find_window.call(dpy, RDefaultRootWindow(dpy), natom))
- RXChangeProperty(dpy, window, RXInternAtom(dpy, name, false), RXA_STRING, 8,
- RPropModeReplace, command)
+ window = find_window.call(dpy, RDefaultRootWindow(dpy), natom)
+ if RWindow?(window)
+ RXChangeProperty(dpy, window,
+ RXInternAtom(dpy, name, false),
+ RXA_STRING, 8, RPropModeReplace, command)
RXFlush(dpy)
command
else
@@ -1198,19 +1260,19 @@ if $with_test_motif
end
make_proc_with_setter(:beep_state,
- # returns amp pitch duration
- lambda {
- vals = RXGetKeyboardControl(RXtDisplay(main_widgets.cadr))[1, 3]
- },
- # amp pitch dur
- # set_beep_state([100, 200, 100])
- lambda { |lst|
- RXChangeKeyboardControl(RXtDisplay(main_widgets.cadr),
- RKBBellPercent |
- RKBBellPitch |
- RKBBellDuration,
- [0] + lst)
- })
+ # return amp pitch duration
+ lambda do
+ vals = RXGetKeyboardControl(RXtDisplay(main_widgets.cadr))[1, 3]
+ end,
+ # amp pitch dur
+ # set_beep_state([100, 200, 100])
+ lambda do |lst|
+ RXChangeKeyboardControl(RXtDisplay(main_widgets.cadr),
+ RKBBellPercent |
+ RKBBellPitch |
+ RKBBellDuration,
+ [0] + lst)
+ end)
def beep
RXBell(RXtDisplay(main_widgets.cadr), 100)
@@ -1222,15 +1284,12 @@ end
# snd-test.scm translations
# ---------------- test 00: constants ----------------
-Tiny_font_string = $with_test_motif ? "6x12" : $with_test_gtk ? "Sans 8" : "9x15"
-Tiny_font_set_string = $with_test_motif ? "9x15" : $with_test_gtk ? "Monospace 10" : "6x12"
+Tiny_font_string = $with_test_motif ? "6x12" :
+ $with_test_gtk ? "Sans 8" : "9x15"
+Tiny_font_set_string = $with_test_motif ? "9x15" :
+ $with_test_gtk ? "Monospace 10" : "6x12"
-# FIXME
-#
-# temp_dir
-# save_dir
-# ladspa_dir
-# peak_env_dir
+# XXX: temp_dir save_dir ladspa_dir peak_env_dir
#
# These variables default to NULL (snd.c/snd-0.h).
# snd-test.scm checks for #f
@@ -1270,7 +1329,6 @@ def test_00
[:Cursor_in_view, 0],
[:Cursor_on_left, 1],
[:Cursor_on_right, 2],
- [:Dolph_chebyshev_window, 16],
[:Exponential_window, 9],
[:Flat_top_window, 23],
[:Sync_none, 0],
@@ -1298,8 +1356,6 @@ def test_00
[:Rv2_window, 30],
[:Rv3_window, 31],
[:Rv4_window, 32],
- [:Samaraki_window, 19],
- [:Ultraspherical_window, 20],
[:Graph_as_sonogram, 1],
[:Graph_as_spectrogram, 2],
[:Graph_once, 0],
@@ -1342,7 +1398,7 @@ def test_00
[:Show_x_axis_unlabelled, 4],
[:Show_bare_x_axis, 5],
# sndlib constants
- [:Mus_unsupported, 0],
+ [:Mus_unknown_header, 0],
[:Mus_next, 1],
[:Mus_aifc, 2],
[:Mus_riff, 3],
@@ -1368,7 +1424,7 @@ def test_00
[:Mus_chebyshev_first_kind, 1],
[:Mus_chebyshev_second_kind, 2],
#
- [:Mus_unknown, 0],
+ [:Mus_unknown_sample, 0],
[:Mus_bshort, 1],
[:Mus_lshort, 10],
[:Mus_mulaw, 2],
@@ -1393,16 +1449,23 @@ def test_00
[:Mus_ldouble_unscaled, 22]].each do |sym, req|
snd_test_neq(Module.const_get(sym), req, "%s", sym)
end
+ if $with_test_gsl
+ [[:Dolph_chebyshev_window, 16],
+ [:Samaraki_window, 19],
+ [:Ultraspherical_window, 20]].each do |sym, req|
+ snd_test_neq(Module.const_get(sym), req, "%s", sym)
+ end
+ end
#
old_dir = temp_dir
set_temp_dir(false)
[[:region_graph_style, Graph_lines],
[:ask_about_unsaved_edits, false],
[:show_full_duration, false],
+ [:show_full_range, false],
[:initial_beg, 0.0],
[:initial_dur, 0.1],
[:ask_before_overwrite, false],
- [:audio_output_device, 0],
[:auto_resize, true],
[:auto_update, false],
[:channel_style, 1],
@@ -1414,16 +1477,15 @@ def test_00
[:cursor_location_offset, 0],
[:dac_combines_channels, true],
[:dac_size, 256],
- [:minibuffer_history_length, 8],
[:clipping, false],
[:default_output_chans, 1],
- [:default_output_data_format, Mus_lfloat],
+ [:default_output_sample_type, Mus_lfloat],
[:default_output_srate, 44100],
[:default_output_header_type, Mus_next],
[:dot_size, 1],
[:cursor_size, 15],
[:cursor_style, Cursor_cross],
- [:tracking_cursor_style, Cursor_cross],
+ [:tracking_cursor_style, Cursor_line],
[:enved_base, 1.0],
[:enved_clip?, true],
[:enved_filter, true],
@@ -1455,12 +1517,10 @@ def test_00
[:listener_prompt, ">"],
[:max_transform_peaks, 100],
[:max_regions, 16],
- [:max_virtual_ptrees, 32],
[:min_dB, -60.0],
[:log_freq_start, 32.0],
[:selection_creates_region, true],
[:transform_normalization, Normalize_by_channel],
- [:view_files_sort, 0],
[:print_length, 12],
[:play_arrow_size, 10],
[:save_state_file, "saved-snd.rb"],
@@ -1489,15 +1549,12 @@ def test_00
[:peak_env_dir, ""],
[:tiny_font, Tiny_font_string],
[:transform_type, $fourier_transform],
- [:trap_segfault, true],
[:with_file_monitor, true],
- # FIXME
- # Ruby doesn't optimize
- [:optimization, 0],
[:clm_table_size, 512],
[:clm_default_frequency, 0.0],
[:with_verbose_cursor, false],
[:with_inset_graph, false],
+ [:with_interrupts, true],
[:remember_sound_state, false],
[:with_smpte_label, false],
[:with_toolbar, ($with_test_gtk ? true : false)],
@@ -1539,7 +1596,8 @@ def test_00
:peaks_font,
:bold_peaks_font].each do |sym|
req = snd_func(sym)
- snd_test_neq(set_snd_func(sym, "8x123"), req, "set_%s to bogus value", sym)
+ snd_test_neq(set_snd_func(sym, "8x123"), req,
+ "set_%s to bogus value", sym)
end
end
set_ask_about_unsaved_edits(false)
@@ -1581,7 +1639,6 @@ def test_01
["amp_control_bounds", amp_control_bounds()[1], 8.0],
["ask_about_unsaved_edits", ask_about_unsaved_edits(), false],
["ask_before_overwrite", ask_before_overwrite(), false],
- ["audio_output_device", audio_output_device(), 0],
["auto_resize", auto_resize(), true],
["auto_update", auto_update(), false],
["auto_update_interval", auto_update_interval(), 60.0],
@@ -1595,11 +1652,15 @@ def test_01
["color_inverted", color_inverted(), true],
["color_scale", color_scale(), 1.0],
["colormap", colormap(), $good_colormap],
- ["contrast_control", without_errors do contrast_control() end, :no_such_sound],
+ ["contrast_control", without_errors do
+ contrast_control()
+ end, :no_such_sound],
["contrast_control_amp", contrast_control_amp(), 1.0],
["contrast_control_bounds", contrast_control_bounds()[1], 10.0],
- ["contrast_control?", without_errors do contrast_control?() end, :no_such_sound],
- ["cursor_follows_play", cursor_follows_play(), false],
+ ["contrast_control?", without_errors do
+ contrast_control?()
+ end, :no_such_sound],
+ ["with_tracking_cursor", with_tracking_cursor(), false],
["cursor_location_offset", cursor_location_offset(), 0],
["cursor_size", cursor_size(), 15],
["cursor_style", cursor_style(), Cursor_cross],
@@ -1607,7 +1668,7 @@ def test_01
["dac_combines_channels", dac_combines_channels(), true],
["dac_size", dac_size(), 256],
["default_output_chans", default_output_chans(), 1],
- ["default_output_data_format", default_output_data_format(), Mus_lfloat],
+ ["default_output_sample_type", default_output_sample_type(), Mus_lfloat],
["default_output_header_type", default_output_header_type(), Mus_next],
["default_output_srate", default_output_srate(), 44100],
["dot_size", dot_size(), 1],
@@ -1625,25 +1686,35 @@ def test_01
["eps_file", eps_file(), "snd.eps"],
["eps_left_margin", eps_left_margin(), 0.0],
["eps_size", eps_size(), 1.0],
- ["expand_control", without_errors do expand_control() end, :no_such_sound],
+ ["expand_control", without_errors do
+ expand_control()
+ end, :no_such_sound],
["expand_control_bounds", expand_control_bounds()[1], 20.0],
["expand_control_hop", expand_control_hop(), 0.05],
["expand_control_jitter", expand_control_jitter(), 0.1],
["expand_control_length", expand_control_length(), 0.15],
["expand_control_ramp", expand_control_ramp(), 0.4],
- ["expand_control?", without_errors do expand_control?() end, :no_such_sound],
+ ["expand_control?", without_errors do
+ expand_control?()
+ end, :no_such_sound],
["fft_log_frequency", fft_log_frequency(), false],
["fft_log_magnitude", fft_log_magnitude(), false],
["fft_with_phases", fft_with_phases(), false],
["fft_window", fft_window(), 6],
["fft_window_alpha", fft_window_alpha(), 0.0],
["fft_window_beta", fft_window_beta(), 0.0],
- ["filter_control_coeffs", without_errors do filter_control_coeffs() end, :no_such_sound],
- ["filter_control_envelope", without_errors do filter_control_envelope() end, :no_such_sound],
+ ["filter_control_coeffs", without_errors do
+ filter_control_coeffs()
+ end, :no_such_sound],
+ ["filter_control_envelope", without_errors do
+ filter_control_envelope()
+ end, :no_such_sound],
["filter_control_in_dB", filter_control_in_dB(), false],
["filter_control_in_hz", filter_control_in_hz(), false],
["filter_control_order", filter_control_order(), 20],
- ["filter_control?", without_errors do filter_control?() end, :no_such_sound],
+ ["filter_control?", without_errors do
+ filter_control?()
+ end, :no_such_sound],
["graph_cursor", graph_cursor(), 34],
["graph_style", graph_style(), Graph_lines],
["graphs_horizontal", graphs_horizontal(), true],
@@ -1661,30 +1732,32 @@ def test_01
["mark_tag_height", mark_tag_height(), 4],
["mark_tag_width", mark_tag_width(), 10],
["max_regions", max_regions(), 16],
- ["max_virtual_ptrees", max_virtual_ptrees(), 32],
["max_transform_peaks", max_transform_peaks(), 100],
["min_dB", min_dB(), -60.0],
- ["minibuffer_history_length", minibuffer_history_length(), 8],
["mix_tag_height", mix_tag_height(), 14],
["mix_tag_width", mix_tag_width(), 6],
["mix_waveform_height", mix_waveform_height(), 20],
["mus_array_print_length", mus_array_print_length(), 8],
["mus_clipping", mus_clipping(), false],
["mus_float_equal_fudge_factor", mus_float_equal_fudge_factor(), 0.0000001],
- ["mus_prescaler", mus_prescaler(), 1.0],
- ["optimization", optimization(), 0], # Ruby doesn't optimize
["play_arrow_size", play_arrow_size(), 10],
["print_length", print_length(), 12],
["read_only", without_errors do read_only() end, :no_such_sound],
["region_graph_style", region_graph_style(), Graph_lines],
["remember_sound_state", remember_sound_state(), false],
["reverb_control_feedback", reverb_control_feedback(), 1.09],
- ["reverb_control_length", without_errors do reverb_control_length() end, :no_such_sound],
+ ["reverb_control_length", without_errors do
+ reverb_control_length()
+ end, :no_such_sound],
["reverb_control_length_bounds", reverb_control_length_bounds()[1], 5.0],
["reverb_control_lowpass", reverb_control_lowpass(), 0.7],
- ["reverb_control_scale", without_errors do reverb_control_scale() end, :no_such_sound],
+ ["reverb_control_scale", without_errors do
+ reverb_control_scale()
+ end, :no_such_sound],
["reverb_control_scale_bounds", reverb_control_scale_bounds()[1], 4.0],
- ["reverb_control?", without_errors do reverb_control?() end, :no_such_sound],
+ ["reverb_control?", without_errors do
+ reverb_control?()
+ end, :no_such_sound],
["save_as_dialog_auto_comment", save_as_dialog_auto_comment, false],
["save_as_dialog_src", save_as_dialog_src, false],
["save_state_file", save_state_file(), "saved-snd.rb"],
@@ -1692,6 +1765,7 @@ def test_01
["show_axes", show_axes(), 1],
["show_controls", show_controls(), false],
["show_full_duration", show_full_duration(), false],
+ ["show_full_range", show_full_range(), false],
["show_grid", show_grid(), false],
["show_indices", show_indices(), false],
["show_marks", show_marks(), true],
@@ -1718,13 +1792,14 @@ def test_01
["time_graph_type", time_graph_type(), Graph_once],
["time_graph?", without_errors do time_graph?() end, :no_such_sound],
["tiny_font", tiny_font(), Tiny_font_string],
- ["tracking_cursor_style", tracking_cursor_style(), Cursor_cross],
+ ["tracking_cursor_style", tracking_cursor_style(), Cursor_line],
["transform_graph_type", transform_graph_type(), Graph_once],
- ["transform_graph?", without_errors do transform_graph?() end, :no_such_sound],
+ ["transform_graph?", without_errors do
+ transform_graph?()
+ end, :no_such_sound],
["transform_normalization", transform_normalization(), Normalize_by_channel],
["transform_size", transform_size(), 512],
["transform_type", transform_type(), $fourier_transform],
- ["view_files_sort", view_files_sort(), 0],
["wavelet_type", wavelet_type(), 0],
["wavo_hop", wavo_hop(), 3],
["wavo_trace", wavo_trace(), 64],
@@ -1733,6 +1808,7 @@ def test_01
["with_tracking_cursor", with_tracking_cursor(), false],
["with_verbose_cursor", with_verbose_cursor(), false],
["with_inset_graph", with_inset_graph(), false],
+ ["with_interrupts", with_interrupts(), true],
["with_smpte_label", with_smpte_label, false],
["with_toolbar", with_toolbar, ($with_test_gtk ? true : false)],
["with_tooltips", with_tooltips, true],
@@ -1751,13 +1827,14 @@ end
# ---------------- test 02: headers ----------------
-def test_headers(name, chns, sr, dur, typ, frm, loop_start = false, loop_end = false)
- if File.exists?(name)
+def test_headers(name, chns, sr, dur, typ, frm,
+ loop_start = false, loop_end = false)
+ if File.exist?(name)
file = name
else
file = $sf_dir + name
end
- if File.exists?(file)
+ if File.exist?(file)
fchns = mus_sound_chans(file)
fsr = mus_sound_srate(file)
fdur = mus_sound_duration(file)
@@ -1770,22 +1847,22 @@ def test_headers(name, chns, sr, dur, typ, frm, loop_start = false, loop_end = f
if fneq(fdur, dur)
snd_display_prev_caller(snd_format_neq(fdur, dur, "%s duration", name))
end
- ffrm = mus_sound_data_format(file)
+ ffrm = mus_sound_sample_type(file)
ftyp = mus_sound_header_type(file)
req = mus_sound_length(file)
res = mus_sound_datum_size(file) * fdur * fsr * fchns
- if (ffrm != Mus_unknown) and
+ if (ffrm != Mus_unknown_sample) and
(ftyp != 27) and
(req + 1) < res
snd_display_prev_caller(snd_format_neq(res, req, "%s length", name))
end
- fframes = mus_sound_frames(file)
- res = fframes.to_f / fsr
+ fframples = mus_sound_framples(file)
+ res = fframples.to_f / fsr
if fneq(res, fdur)
- snd_display_prev_caller(snd_format_neq(res, fdur, "%s frames", name))
+ snd_display_prev_caller(snd_format_neq(res, fdur, "%s framples", name))
end
fsamps = mus_sound_samples(file)
- res = fframes - fsamps / fchns
+ res = fframples - fsamps / fchns
if res.abs > 1
snd_display_prev_caller(snd_format_neq(res, fsamps, "%s samples", name))
end
@@ -1793,7 +1870,7 @@ def test_headers(name, chns, sr, dur, typ, frm, loop_start = false, loop_end = f
if res != typ
snd_display_prev_caller(snd_format_neq(res, typ, "%s type", name))
end
- res = mus_data_format_name(ffrm)
+ res = mus_sample_type_name(ffrm)
if res != frm
snd_display_prev_caller(snd_format_neq(res, frm, "%s format", name))
end
@@ -1801,10 +1878,12 @@ def test_headers(name, chns, sr, dur, typ, frm, loop_start = false, loop_end = f
if loop_start and loop_end
if (not lst.nil?) and lst.length > 1
if lst[0] != loop_start
- snd_display_prev_caller(snd_format_neq(lst[0], loop_start, "%s loop start", name))
+ snd_display_prev_caller(snd_format_neq(lst[0],
+ loop_start, "%s loop start", name))
end
if lst[1] != loop_end
- snd_display_prev_caller(snd_format_neq(lst[1], loop_end, "%s loop end", name))
+ snd_display_prev_caller(snd_format_neq(lst[1],
+ loop_end, "%s loop end", name))
end
else
snd_display_prev_caller("%s loop info empty: %s?", name, lst.inspect)
@@ -1939,9 +2018,6 @@ def test_02
test_headers("o2_u8.avr", 1, 44100, 0.0367800444364548, "AVR", "unsigned byte (8 bits)")
test_headers("o2_u8.wave", 1, 44100, 0.0367800444364548, "RIFF", "unsigned byte (8 bits)")
test_headers("o28.mpc", 1, 44100, 0.036780, "AKAI 4", "little endian short (16 bits)")
- test_headers("oboe.g721", 1, 22050, 1.15287983417511, "Sun/Next", "unknown")
- test_headers("oboe.g723_24", 1, 22050, 0.864761888980865, "Sun/Next", "unknown")
- test_headers("oboe.g723_40", 1, 22050, 1.44126987457275, "Sun/Next", "unknown")
test_headers("oboe.kts", 1, 22050, 2.305125, "Korg", "big endian short (16 bits)")
test_headers("oboe.its", 1, 22050, 2.305125, "Impulse Tracker", "little endian short (16 bits)")
test_headers("oboe.sf2", 1, 22050, 2.305124759674, "SoundFont", "little endian short (16 bits)")
@@ -1954,7 +2030,6 @@ def test_02
test_headers("oboe-lf32.caf", 1, 22050, 2.305125, "caff", "little endian float (32 bits)")
test_headers("oboe-ulaw.caf", 1, 22050, 2.305125, "caff", "mulaw (8 bits)")
test_headers("oboe.nsp", 1, 22050, 2.305125, "CSL", "little endian short (16 bits)")
- test_headers("oboe.nvf", 1, 8000, 6.353500, "Creative NVF", "unknown")
test_headers("oboe-ulaw.voc", 1, 22050, 2.305669, "VOC", "mulaw (8 bits)")
test_headers("oboe-lf32.sf", 1, 22050, 2.305669, "IRCAM", "little endian float (32 bits)")
test_headers("oboe.wfp", 1, 22050, 2.305125, "Turtle Beach", "little endian short (16 bits)")
@@ -2056,16 +2131,16 @@ end
def test_03
ind = open_sound("oboe.snd")
test_dir = $HOME + "/test"
- if File.exists?(test_dir)
+ if File.exist?(test_dir)
old_val = temp_dir
snd_test_neq(set_temp_dir(test_dir), test_dir, "set_temp_dir")
set_temp_dir(old_val)
end
snd_test_neq(sample(1000), 0.0328, "sample 1000")
#
- [$output_name_hook,
- $output_comment_hook,
- $peak_env_hook,
+ $snd_error_hook.reset_hook!
+ $mus_error_hook.reset_hook!
+ [$output_comment_hook,
$help_hook,
$mark_drag_hook,
$mix_drag_hook,
@@ -2091,15 +2166,16 @@ def test_03
$after_graph_hook,
$graph_hook].each_with_index do |h, i|
if (not hook?(h)) or (not h.empty?)
- snd_display("%d: %s?", i, h.inspect)
+ snd_display("hook[%d]: %p?", i, h)
end
end
+ reset_almost_all_hooks
#
if $with_test_gui
old_ctrl = show_controls
set_show_controls(true)
req = enved_dialog
- snd_test_neq(dialog_widgets[2], req, "enved_dialog")
+ snd_test_neq(dialog_widgets[1], req, "enved_dialog")
req = [0.0, 0.0, 1.0, 1.0, 2.0, 0.0]
set_enved_envelope(req)
snd_test_neq(enved_envelope, req, "set_enved_envelope")
@@ -2139,8 +2215,6 @@ def test_03
[:amp_control_bounds, [0.0, 8.0], [1.0, 5.0]],
[:ask_about_unsaved_edits, false, true],
[:ask_before_overwrite, false, true],
- [:audio_input_device, 0, 1],
- [:audio_output_device, 0, 1],
[:auto_resize, true, false],
[:auto_update, false, true],
[:channel_style, 0, 1],
@@ -2154,13 +2228,12 @@ def test_03
[:with_tracking_cursor, false, true],
[:cursor_size, 15, 30],
[:cursor_style, Cursor_cross, Cursor_line],
- [:tracking_cursor_style, Cursor_cross, Cursor_line],
+ [:tracking_cursor_style, Cursor_line, Cursor_cross],
[:dac_combines_channels, true, false],
[:dac_size, 256, 512],
- [:minibuffer_history_length, 8, 16],
[:clipping, false, true],
[:default_output_chans, 1, 2],
- [:default_output_data_format, 1, 1],
+ [:default_output_sample_type, Mus_lfloat, Mus_bshort],
[:default_output_srate, 22050, 44100],
[:default_output_header_type, Mus_next, Mus_aifc],
[:dot_size, 1, 4],
@@ -2203,10 +2276,8 @@ def test_03
[:mix_tag_width, 6, 20],
[:mark_tag_height, 4, 20],
[:mark_tag_width, 10, 20],
- [:mus_prescaler, 1.0, 100.0],
[:mus_clipping, false, true],
[:selection_creates_region, true, false],
- [:view_files_sort, 0, 1],
[:play_arrow_size, 10, 16],
[:print_length, 12, 16],
[:region_graph_style, Graph_lines, Graph_lollipops],
@@ -2219,6 +2290,7 @@ def test_03
[:reverb_control_scale_bounds, [0.0, 4.0], [0.0, 0.2]],
[:show_axes, 1, 0],
[:show_full_duration, false, true],
+ [:show_full_range, false, true],
[:show_indices, false, true],
[:show_marks, true, false],
[:show_mix_waveforms, true, false],
@@ -2238,8 +2310,7 @@ def test_03
[:with_verbose_cursor, false, true],
[:wavelet_type, 0, 1],
[:time_graph?, false, true],
- # FIXME see below
- # [:time_graph_type, Graph_once, Graph_as_wavogram],
+ [:time_graph_type, Graph_once, Graph_as_wavogram],
[:wavo_hop, 3, 6],
[:wavo_trace, 64, 128],
[:with_mix_tags, true, false],
@@ -2253,12 +2324,6 @@ def test_03
if $with_test_gui
lst += gui_lst
end
- if $with_test_motif
- # FIXME
- # doesn't work with GTK
- # set_time_graph_type(Graph_as_wavogram) ==> segfault
- lst += [[:time_graph_type, Graph_once, Graph_as_wavogram]]
- end
lst.each do |sym, initval, newval|
next unless symbol?(sym)
2.times do |i|
@@ -2276,10 +2341,7 @@ def test_03
[:colormap, $good_colormap, [321, -123]],
[:color_cutoff, 0.003, [-1.0, 123.123]],
[:color_scale, 1.0, [-32.0, 2000.0]],
- if $with_test_motif
- # FIXME
- # doesn't work with GTK and ruby 1.9.2
- # set_contrast_control(xxx) ==> segfault
+ if $with_test_gui
[:contrast_control, 0.0, [-123.123, 123.123]]
end,
[:contrast_control_bounds, [0.0, 10.0], [false, [0.0], [1.0, 0.0], 2.0]],
@@ -2298,7 +2360,7 @@ def test_03
[:zero_pad, 0, [-1, -123]],
[:cursor_style, Cursor_cross, [-1]],
[:cursor_style, Cursor_line, [2, 123]],
- [:tracking_cursor_style, Cursor_cross, [-1]],
+ [:tracking_cursor_style, Cursor_line, [-1]],
[:tracking_cursor_style, Cursor_line, [2, 123]],
[:transform_graph_type, Graph_once, [-1, 123]],
[:fft_window, 6, [-1, 123]],
@@ -2306,7 +2368,6 @@ def test_03
[:filter_control_order, 20, [-10, -1, 0]],
[:max_transform_peaks, 100, [-1]],
[:max_regions, 16, [-1, -123]],
- [:view_files_sort, 0, [-1, 123]],
[:reverb_control_length, 1.0, [-1.0]],
[:show_axes, 1, [-1, 123]],
[:sinc_width, 10, [-10]],
@@ -2317,7 +2378,8 @@ def test_03
[:speed_control_bounds, [0.05, 20.0], [false, [0.0], [1.0, 0.0], 2.0]],
[:speed_control_style, 0, [-1, 10]],
[:sync_style, Sync_by_sound, [-1, 123]],
- [:transform_type, $fourier_transform, [integer2transform(-1), integer2transform(123)]],
+ [:transform_type, $fourier_transform,
+ [integer2transform(-1), integer2transform(123)]],
[:wavelet_type, 0, [-1, 123]],
[:wavo_hop, 1, [0, -123]],
[:wavo_trace, 1, [0, -123]],
@@ -2362,7 +2424,8 @@ def test_03
end
set_search_procedure(false)
if proc?(search_procedure)
- snd_display("global search procedure after reset: %s?", search_procedure.inspect)
+ snd_display("global search procedure after reset: %s?",
+ search_procedure.inspect)
end
set_search_procedure(lambda do |y| y > 0.1 end)
unless proc?(search_procedure)
@@ -2387,246 +2450,296 @@ def test_03
dismiss_all_dialogs
undefined = []
kernel_global_variables = Kernel.global_variables
- # FIXME
- # from original snd-test.scm list removed or changed:
+ # XXX: from original snd-test.scm list removed or changed:
#
- # :add_clm_field (run.c)
- # :run (macro in run.c)
# :file2string (Scheme specific in snd-utils.c)
# :redo (Ruby statement)
#
# :in replaced by :call_in
- #
- [:snd_opened_sound, :abort, :add_colormap, :add_directory_to_view_files_list, :add_file_filter,
- :add_file_sorter, :add_file_to_view_files_list, :add_mark, :add_player,
- :add_sound_file_extension, :add_source_file_extension, :add_to_main_menu, :add_to_menu,
- :add_transform, :after_apply_controls_hook, :after_edit_hook, :after_graph_hook,
- :after_lisp_graph_hook, :after_open_hook, :after_save_as_hook, :after_save_state_hook,
- :after_transform_hook, :all_pass, :all_pass?, :amp_control, :amp_control_bounds,
- :amplitude_modulate, :analyse_ladspa, :apply_controls, :apply_ladspa, :array2file,
- :array_interp, :as_one_edit, :ask_about_unsaved_edits, :ask_before_overwrite, :asymmetric_fm,
- :asymmetric_fm?, :audio_input_device, :audio_output_device, :auto_resize, :auto_update,
- :auto_update_interval, :autocorrelate, :autocorrelation, :moving_average, :moving_average?,
- :axis_color, :axis_info, :axis_label_font, :axis_numbers_font, :bad_header_hook,
- :bartlett_window, :bartlett_hann_window, :basic_color, :beats_per_measure, :beats_per_minute,
- :before_close_hook, :before_exit_hook, :before_save_as_hook, :before_save_state_hook,
- :before_transform_hook, :bind_key,
- :blackman2_window, :blackman3_window, :blackman4_window, :blackman5_window, :blackman6_window,
- :blackman7_window, :blackman8_window, :blackman9_window, :blackman10_window, :bohman_window,
- :bold_peaks_font, :bomb, :call_in, :cauchy_window, :mlt_sine_window, :cepstrum,
- :change_samples_with_origin, :channel2vct, :channel_amp_envs, :channel_data,
- :channel_properties, :channel_property, :channel_style, :channel_widgets, :channels,
- :channels_combined, :channels_separate, :channels_superimposed, :chans, :clear_array,
- :clear_listener, :clear_minibuffer, :clear_sincs, :clip_hook, :clipping, :clm_channel,
- :clm_print, :clm_table_size, :clm_default_frequency, :close_hook, :close_sound, :color2list,
- :color_cutoff, :color_orientation_dialog, :color_hook, :color_inverted, :color_scale,
- :color?, :colormap, :colormap_name, :colormap_ref, :colormap_size, :colormap?, :comb,
- :comb?, :comment, :connes_window, :continue_frame2file, :continue_sample2file,
- :contrast_control, :contrast_control_amp, :contrast_control_bounds, :contrast_control?,
- :contrast_enhancement, :controls2channel, :convolution, :convolve, :convolve_files,
- :convolve_selection_with, :convolve_with, :convolve?, :copy_context, :copy_sampler,
- :count_matches, :current_edit_position, :current_font, :cursor, :cursor_color,
- :cursor_context, :cursor_cross, :cursor_in_middle, :cursor_in_view, :cursor_line,
- :cursor_location_offset, :cursor_on_left, :cursor_on_right, :cursor_position, :cursor_size,
- :cursor_style, :cursor_update_interval, :dac_combines_channels, :dac_hook, :dac_size,
- :data_color, :data_format, :data_location, :data_size, :db2linear, :default_output_chans,
- :default_output_data_format, :default_output_header_type, :default_output_srate,
- :define_envelope, :degrees2radians, :delay, :delay_tick, :delay?, :delete_colormap,
- :delete_file_filter, :delete_file_sorter, :delete_mark, :delete_marks, :delete_sample,
- :delete_samples, :delete_samples_and_smooth, :delete_selection, :delete_selection_and_smooth,
- :delete_transform, :dialog_widgets, :disk_kspace,
- :display_edits, :dolph_chebyshev_window, :dont_normalize, :dot_product, :dot_size,
- :draw_axes, :draw_dot, :draw_dots, :draw_line, :draw_lines, :draw_mark_hook, :draw_mix_hook,
- :draw_string, :drop_hook, :during_open_hook, :edit_fragment, :edit_header_dialog,
- :edit_hook, :edit_list2function, :edit_position, :edit_tree, :edits, :edot_product,
- :env, :env_channel, :env_channel_with_base, :env_interp, :env_selection, :env_sound,
- :env?, :enved_add_point, :enved_amplitude, :enved_base, :enved_clip?, :enved_delete_point,
- :enved_dialog, :enved_envelope, :enved_filter, :enved_filter_order, :enved_hook, :enved_in_dB,
- :enved_move_point, :enved_power, :enved_spectrum, :enved_srate, :enved_style, :enved_target,
- :enved_wave?, :enved_waveform_color, :envelope_exponential, :envelope_linear,
- :eps_bottom_margin, :eps_file, :eps_left_margin, :eps_size, :exit, :exit_hook,
- :expand_control, :expand_control_bounds, :expand_control_hop, :expand_control_jitter,
- :expand_control_length, :expand_control_ramp, :expand_control?, :exponential_window,
- :fft, :fft_log_frequency, :fft_log_magnitude, :fft_window, :fft_window_alpha,
- :fft_window_beta, :fft_with_phases, :file2array, :file2frame, :file2frame?, :file2sample,
- :file2sample?, :file_name, :file_write_date, :fill_polygon, :fill_rectangle,
- :filter, :filtered_comb, :filtered_comb?, :filter_channel, :filter_control_coeffs,
- :filter_control_envelope, :filter_control_in_dB, :filter_control_in_hz, :filter_control_order,
- :filter_control_waveform_color, :filter_control?, :filter_selection, :filter_sound, :filter?,
- :find_channel, :find_dialog, :find_mark, :find_sound, :finish_progress_report, :fir_filter,
- :fir_filter?, :flat_top_window, :focus_widget, :foreground_color, :forget_region, :formant,
- :formant_bank, :formant?, :firmant, :firmant?, :fourier_transform, :frame, :frame_multiply,
- :frame_add, :frame2file, :frame2file?, :frame2frame, :frame2list, :frame2sample, :frame_ref,
- :frame_set!, :frame?, :frames, :free_player, :free_sampler, :gaussian_window, :gc_off,
- :gc_on, :gl_graph2ps, :glSpectrogram, :goto_listener_end, :granulate, :granulate?, :graph,
- :graph2ps, :graph_as_sonogram, :graph_as_spectrogram, :graph_as_wavogram, :graph_color,
- :graph_cursor, :graph_data, :graph_dots, :graph_dots_and_lines, :graph_filled, :graph_hook,
- :graph_lines, :graph_lollipops, :graph_once, :graph_style, :graphs_horizontal, :grid_density,
- :haar_transform, :hamming_window, :hann_poisson_window, :hann_window, :header_type,
- :help_dialog, :help_hook, :hide_widget, :highlight_color, :html_dir, :html_program,
- :hz2radians, :iir_filter, :iir_filter?, :in_any, :ina, :inb, :info_dialog, :init_ladspa,
- :initial_graph_hook, :insert_file_dialog, :insert_region, :insert_sample, :insert_samples,
- :insert_samples_with_origin, :insert_selection, :insert_silence, :insert_sound, :just_sounds,
- :kaiser_window, :key, :key_binding, :key_press_hook, :keyboard_no_action, :ladspa_activate,
- :ladspa_cleanup, :ladspa_connect_port, :ladspa_deactivate, :ladspa_descriptor, :ladspa_dir,
- :peak_env_dir, :ladspa_instantiate, :ladspa_run, :ladspa_run_adding,
- :ladspa_set_run_adding_gain, :left_sample, :linear2db, :lisp_graph, :lisp_graph_hook,
- :lisp_graph_style, :lisp_graph?, :list2vct, :list_ladspa, :listener_click_hook,
- :listener_color, :listener_font, :listener_prompt, :listener_selection,
- :listener_text_color, :little_endian?, :locsig, :locsig_ref, :locsig_reverb_ref,
- :locsig_reverb_set!, :locsig_set!, :locsig_type, :locsig?, :log_freq_start, :main_menu,
- :main_widgets, :make_all_pass, :make_asymmetric_fm, :make_moving_average, :make_bezier,
- :make_color, :make_comb, :make_filtered_comb, :make_convolve, :make_delay, :make_env,
- :make_fft_window, :make_file2frame, :make_file2sample, :make_filter, :make_fir_coeffs,
- :make_fir_filter, :make_formant, :make_firmant, :make_frame, :make_frame2file,
- :make_granulate, :make_graph_data, :make_iir_filter, :make_locsig, :make_mix_sampler,
- :make_mixer, :make_move_sound, :make_notch, :make_one_pole, :make_one_zero, :make_oscil,
- :make_phase_vocoder, :make_player, :make_polyshape, :make_polywave, :make_pulse_train,
- :make_rand, :make_rand_interp, :make_readin, :make_region, :make_region_sampler,
- :make_sample2file, :make_sampler, :make_sawtooth_wave, :make_scalar_mixer, :make_nrxysin,
- :make_nrxycos, :make_snd2sample, :make_sound_data, :make_square_wave, :make_src,
- :make_ssb_am, :make_ncos, :make_nsin, :make_table_lookup, :make_triangle_wave,
- :make_two_pole, :make_two_zero, :make_variable_graph, :make_vct, :make_wave_train,
- :map_chan, :map_channel, :mark_click_hook, :mark_color, :mark_context, :mark_drag_hook,
- :mark_home, :mark_hook, :mark_name, :mark_properties,
- :mark_property, :mark_sample, :mark_sync, :mark_sync_max, :mark_tag_height,
- :mark_tag_width, :mark?, :marks, :max_regions, :max_transform_peaks, :max_virtual_ptrees,
- :maxamp, :maxamp_position, :menu_widgets, :min_dB, :minibuffer_history_length, :mix,
- :mix_amp, :mix_amp_env, :mix_click_hook, :mix_color, :mix_dialog_mix, :mix_drag_hook,
- :mix_file_dialog, :mix_length, :mix_home, :mix_name, :mix_position, :mix_properties,
- :mix_property, :mix_region, :mix_release_hook, :mix_sync, :mix_sync_max, :mix_sampler?,
- :mix_selection, :mix_speed, :mix_tag_height, :mix_tag_width, :mix_tag_y, :mix_vct,
- :mix_waveform_height, :mix?, :mixer, :mixer_multiply, :mixer_add, :mixer_ref, :mixer_set!,
- :mixer?, :mixes, :mouse_click_hook, :mouse_drag_hook, :mouse_enter_graph_hook,
- :mouse_enter_label_hook, :mouse_enter_listener_hook, :mouse_enter_text_hook,
- :mouse_leave_graph_hook, :mouse_leave_label_hook, :mouse_leave_listener_hook,
- :mouse_leave_text_hook, :mouse_press_hook, :move_locsig, :move_sound, :move_sound?,
- :multiply_arrays, :mus_aifc, :mus_aiff, :mus_alaw, :mus_alsa_buffer_size,
- :mus_alsa_buffers, :mus_alsa_capture_device, :mus_alsa_device, :mus_alsa_playback_device,
- :mus_alsa_squelch_warning, :mus_apply, :mus_array_print_length, :mus_float_equal_fudge_factor,
- :mus_b24int, :mus_bdouble, :mus_bdouble_unscaled, :mus_bfloat, :mus_bfloat_unscaled,
- :mus_bicsf, :mus_bint, :mus_bintn, :mus_bshort, :mus_byte, :mus_bytes_per_sample,
- :mus_caff, :mus_channel, :mus_channels, :mus_chebyshev_first_kind, :mus_chebyshev_second_kind,
- :mus_clipping, :mus_close, :mus_data, :mus_data_format2string, :mus_data_format_name,
- :mus_describe, :mus_error_hook, :mus_error_type2string, :mus_expand_filename,
- :mus_feedback, :mus_feedforward, :mus_fft, :mus_file_buffer_size, :mus_file_clipping,
- :mus_file_name, :mus_file_prescaler, :mus_frequency, :mus_generator?,
- :mus_header_raw_defaults, :mus_header_type2string, :mus_header_type_name,
- :mus_hop, :mus_increment, :mus_input?, :mus_interp_all_pass, :mus_interp_bezier,
- :mus_interp_hermite, :mus_interp_lagrange, :mus_interp_linear, :mus_interp_none,
- :mus_interp_sinusoidal, :mus_interp_type, :mus_interpolate, :mus_ircam, :mus_l24int,
- :mus_ldouble, :mus_ldouble_unscaled, :mus_length, :mus_lfloat, :mus_lfloat_unscaled,
- :mus_lint, :mus_lintn, :mus_location, :mus_lshort, :mus_max_malloc, :mus_max_table_size,
- :mus_mix, :mus_mulaw, :mus_name, :mus_next, :mus_nist, :mus_offset, :mus_order,
- :mus_oss_set_buffers, :mus_out_format, :mus_output?, :mus_phase, :mus_prescaler,
- :mus_ramp, :mus_rand_seed, :mus_random, :mus_raw, :mus_reset, :mus_riff, :mus_run,
- :mus_scaler, :mus_set_formant_radius_and_frequency, :mus_sound_chans, :mus_sound_close_input,
- :mus_sound_close_output, :mus_sound_comment, :mus_sound_data_format, :mus_sound_data_location,
- :mus_sound_datum_size, :mus_sound_duration, :mus_sound_forget, :mus_sound_frames,
- :mus_sound_header_type, :mus_sound_length, :mus_sound_loop_info, :mus_sound_mark_info,
- :mus_sound_maxamp, :mus_sound_maxamp_exists?, :mus_sound_open_input, :mus_sound_open_output,
- :mus_sound_prune, :mus_sound_read, :mus_sound_reopen_output, :mus_sound_report_cache,
- :mus_sound_samples, :mus_sound_seek_frame, :mus_sound_srate, :mus_sound_type_specifier,
- :mus_sound_write, :mus_sound_write_date, :mus_soundfont, :mus_srate, :mus_svx, :mus_ubshort,
- :mus_ubyte, :mus_ulshort, :mus_unknown, :mus_unsupported, :mus_voc, :mus_width, :mus_xcoeff,
- :mus_xcoeffs, :mus_ycoeff, :mus_ycoeffs, :name_click_hook, :new_sound, :new_sound_dialog,
- :new_sound_hook, :new_widget_hook, :next_sample, :normalize_by_channel, :normalize_by_sound,
- :normalize_channel, :normalize_globally, :notch, :notch?, :one_pole, :one_pole?, :one_zero,
- :one_zero?, :open_file_dialog, :open_file_dialog_directory, :open_hook, :open_raw_sound,
- :open_raw_sound_hook, :open_sound, :optimization, :optimization_hook, :orientation_hook,
- :oscil, :oscil?, :out_any, :outa, :outb, :outc, :outd, :output_comment_hook,
- :output_name_hook, :override_samples_with_origin, :pad_channel, :partials2polynomial,
- :partials2wave, :parzen_window, :pausing, :peak_env_hook, :peaks, :peaks_font,
- :phase_partials2wave, :phase_vocoder, :phase_vocoder_amp_increments, :phase_vocoder_amps,
- :phase_vocoder_freqs, :phase_vocoder_phase_increments, :phase_vocoder_phases, :phase_vocoder?,
- :play, :play_arrow_size, :play_hook, :player_home, :player?, :players, :playing,
- :poisson_window, :polar2rectangular, :polynomial, :polyshape, :polywave, :polyshape?,
- :polywave?, :position2x, :position2y, :position_color, :preferences_dialog, :previous_sample,
- :print_dialog, :print_hook, :print_length, :progress_report, :prompt_in_minibuffer,
- :ptree_channel, :pulse_train, :pulse_train?, :radians2degrees, :radians2hz, :ramp_channel,
- :rand, :rand_interp, :rand_interp?, :rand?, :read_hook, :read_mix_sample, :read_only,
- :read_region_sample, :read_sample, :readin, :readin?, :rectangular2magnitudes,
- :rectangular2polar, :rectangular_window, :redo_edit, :region2vct, :region_chans,
- :region_home, :region_frames, :region_graph_style, :region_maxamp, :region_maxamp_position,
- :region_position, :region_sample, :region_sampler?, :region_srate, :region?, :regions,
- :remember_sound_state, :remove_from_menu, :report_in_minibuffer, :reset_controls,
- :reset_listener_cursor, :restore_controls, :restore_region, :reverb_control_decay,
- :reverb_control_feedback, :reverb_control_length, :reverb_control_length_bounds,
- :reverb_control_lowpass, :reverb_control_scale, :reverb_control_scale_bounds, :reverb_control?,
- :reverse_channel, :reverse_selection, :reverse_sound, :revert_sound, :riemann_window,
- :right_sample, :ring_modulate, :rv2_window, :rv3_window, :rv4_window, :samaraki_window,
- :sample, :sample2file, :sample2file?, :sample2frame, :sampler_at_end?, :sampler_home,
- :sampler_position, :sampler?, :samples, :samples2seconds, :sash_color, :save_controls,
- :save_dir, :save_edit_history, :save_envelopes, :save_hook, :save_listener, :save_macros,
- :save_marks, :save_region, :save_region_dialog, :save_selection, :save_selection_dialog,
- :save_sound, :save_sound_as, :save_sound_dialog, :save_state, :save_state_file,
- :save_state_hook, :sawtooth_wave, :sawtooth_wave?, :scale_by, :scale_channel,
- :scale_selection_by, :scale_selection_to, :scale_to, :scan_chan, :scan_channel,
- :script_arg, :script_args, :search_procedure, :seconds2samples, :select_all,
- :select_channel, :select_channel_hook, :select_sound, :select_sound_hook, :selected_channel,
- :selected_data_color, :selected_graph_color, :selected_sound, :selection_chans,
- :selection_color, :selection_context, :selection_creates_region, :selection_frames,
- :selection_maxamp, :selection_maxamp_position, :selection_member?, :selection_position,
- :selection_srate, :selection?, :short_file_name, :show_all_axes, :show_all_axes_unlabelled,
- :show_bare_x_axis, :show_axes, :show_controls, :show_grid, :show_indices,
- :show_full_duration, :initial_beg, :initial_dur, :show_listener,
- :show_marks, :show_mix_waveforms, :show_no_axes, :show_selection, :show_selection_transform,
- :show_sonogram_cursor, :show_transform_peaks, :show_widget, :show_x_axis,
- :show_x_axis_unlabelled, :show_y_zero, :sinc_width, :nrxysin, :nrxysin?, :nrxycos,
- :nrxycos?, :smooth_channel, :smooth_selection, :smooth_sound, :snd2sample, :snd2sample?,
- :snd_error, :snd_error_hook, :snd_gcs, :snd_help, :snd_font, :snd_color, :snd_print,
- :snd_simulate_keystroke, :snd_spectrum, :snd_tempnam, :snd_url, :snd_urls, :snd_version,
- :snd_warning, :snd_warning_hook, :sound_data2sound_data, :sound_data2vct, :sound_data_chans,
- :sound_data_length, :sound_data_maxamp, :sound_data_ref, :sound_data_peak, :sound_data_set!,
- :sound_data_scale!, :sound_data_fill!, :sound_data?, :sound_data_multiply!, :sound_data_add!,
- :sound_data_offset!, :sound_data_multiply, :sound_data_add, :sound_data_copy,
- :sound_data_reverse!, :sound_file_extensions, :sound_file?, :sound_files_in_directory,
- :sound_loop_info, :sound_properties, :sound_property, :sound_widgets, :sound?,
- :soundfont_info, :sounds, :spectrum_end, :spectro_hop, :spectrum_start, :spectro_x_angle,
- :spectro_x_scale, :spectro_y_angle, :spectro_y_scale, :spectro_z_angle, :spectro_z_scale,
- :spectrum, :speed_control, :speed_control_as_float, :speed_control_as_ratio,
- :speed_control_as_semitone, :speed_control_bounds, :speed_control_style,
- :speed_control_tones, :square_wave, :square_wave?, :squelch_update, :srate, :src,
- :src_channel, :src_selection, :src_sound, :src?, :ssb_am, :ssb_am?, :start_hook,
- :start_playing, :start_playing_hook, :start_playing_selection_hook, :start_progress_report,
- :stop_dac_hook, :stop_player, :stop_playing, :stop_playing_hook, :stop_playing_selection_hook,
- :ncos, :ncos?, :nsin, :nsin?, :swap_channels, :sync, :sync_style, :sync_none, :sync_all,
- :sync_by_sound, :sync_max, :syncd_marks, :table_lookup,
- :table_lookup?, :tap, :temp_dir, :text_focus_color, :time_graph,
- :time_graph_style, :time_graph_type, :time_graph?, :tiny_font, :tracking_cursor_style,
- :transform2vct, :transform_dialog, :transform_frames, :transform_graph,
- :transform_graph_style, :transform_graph_type, :transform_graph?, :transform_normalization,
- :transform_sample, :transform_size, :transform_type, :transform?, :trap_segfault,
- :triangle_wave, :triangle_wave?, :tukey_window, :two_pole, :two_pole?, :two_zero,
- :two_zero?, :ultraspherical_window, :unbind_key , :undo, :undo_edit, :undo_hook, :unselect_all,
+ [:snd_opened_sound, :abort, :add_colormap, :add_mark,
+ :add_player, :add_sound_file_extension, :add_source_file_extension,
+ :add_to_main_menu, :add_to_menu, :add_transform, :after_apply_controls_hook,
+ :after_edit_hook, :after_graph_hook, :after_lisp_graph_hook,
+ :after_open_hook, :after_save_as_hook, :after_save_state_hook,
+ :after_transform_hook, :all_pass, :all_pass?, :amp_control,
+ :amp_control_bounds, :amplitude_modulate, :analyse_ladspa, :apply_controls,
+ :apply_ladspa, :array2file, :array_interp, :as_one_edit,
+ :ask_about_unsaved_edits, :ask_before_overwrite, :asymmetric_fm,
+ :asymmetric_fm?, :auto_resize, :auto_update, :auto_update_interval,
+ :autocorrelate, :autocorrelation, :axis_color, :axis_info,
+ :axis_label_font, :axis_numbers_font, :bad_header_hook, :bartlett_window,
+ :bartlett_hann_window, :basic_color, :beats_per_measure, :beats_per_minute,
+ :before_close_hook, :before_exit_hook, :before_save_as_hook,
+ :before_save_state_hook, :before_transform_hook, :bind_key,
+ :blackman2_window, :blackman3_window, :blackman4_window, :blackman5_window,
+ :blackman6_window, :blackman7_window, :blackman8_window, :blackman9_window,
+ :blackman10_window, :bohman_window, :bold_peaks_font, :call_in,
+ :cauchy_window, :mlt_sine_window, :cepstrum, :change_samples_with_origin,
+ :channel2vct, :channel_amp_envs, :channel_data, :channel_properties,
+ :channel_property, :channel_style, :channel_widgets, :channels,
+ :channels_combined, :channels_separate, :channels_superimposed,
+ :chans, :clear_listener, :clip_hook,
+ :clipping, :clm_channel, :clm_table_size,
+ :clm_default_frequency, :close_hook, :close_sound,
+ :color_cutoff, :color_orientation_dialog, :color_hook, :color_inverted,
+ :color_scale, :color?, :colormap, :colormap_name, :colormap_ref,
+ :colormap_size, :colormap?, :comb, :comb?, :combined_data_color,
+ :comment, :connes_window, :continue_frample2file, :continue_sample2file,
+ :contrast_control, :contrast_control_amp, :contrast_control_bounds,
+ :contrast_control?, :contrast_enhancement, :controls2channel, :convolution,
+ :convolve, :convolve_files, :convolve_selection_with, :convolve_with,
+ :convolve?, :copy_context, :copy_sampler,
+ :current_edit_position, :current_font, :cursor, :cursor_color,
+ :cursor_context, :cursor_cross, :cursor_in_middle, :cursor_in_view,
+ :cursor_line, :cursor_location_offset, :cursor_on_left, :cursor_on_right,
+ :cursor_position, :cursor_size, :cursor_style, :cursor_update_interval,
+ :dac_combines_channels, :dac_size, :data_color, :sample_type,
+ :data_location, :data_size, :db2linear, :default_output_chans,
+ :default_output_sample_type, :default_output_header_type,
+ :default_output_srate, :define_envelope, :degrees2radians, :delay,
+ :delay_tick, :delay?, :delete_colormap, :delete_mark, :delete_marks,
+ :delete_sample, :delete_samples, :delete_samples_and_smooth,
+ :delete_selection, :delete_selection_and_smooth, :delete_transform,
+ :dialog_widgets, :disk_kspace, :display_edits, :dolph_chebyshev_window,
+ :dont_normalize,
+ :dot_product, :dot_size, :draw_axes, :draw_dot, :draw_dots, :draw_line,
+ :draw_lines, :draw_mark_hook, :draw_mix_hook, :draw_string, :drop_hook,
+ :during_open_hook, :edit_fragment, :edit_header_dialog, :edit_hook,
+ :edit_list2function, :edit_position, :edit_tree, :edits, :edot_product,
+ :env, :env_channel, :env_channel_with_base, :env_interp, :env_selection,
+ :env_sound, :env?, :enved_add_point, :enved_amplitude, :enved_base,
+ :enved_clip?, :enved_delete_point, :enved_dialog, :enved_envelope,
+ :enved_filter, :enved_filter_order, :enved_hook, :enved_in_dB,
+ :enved_move_point, :enved_power, :enved_spectrum, :enved_srate,
+ :enved_style, :enved_target, :enved_wave?, :enved_waveform_color,
+ :envelope_exponential, :envelope_linear, :eps_bottom_margin, :eps_file,
+ :eps_left_margin, :eps_size, :exit, :exit_hook, :expand_control,
+ :expand_control_bounds, :expand_control_hop, :expand_control_jitter,
+ :expand_control_length, :expand_control_ramp, :expand_control?,
+ :exponential_window, :fft, :fft_log_frequency, :fft_log_magnitude,
+ :fft_window, :fft_window_alpha, :fft_window_beta, :fft_with_phases,
+ :file2array, :file2frample, :file2frample?, :file2sample, :file2sample?,
+ :file_name, :file_write_date, :fill_polygon, :fill_rectangle,
+ :filter, :filtered_comb, :filtered_comb?, :filter_channel,
+ :filter_control_coeffs, :filter_control_envelope, :filter_control_in_dB,
+ :filter_control_in_hz, :filter_control_order,
+ :filter_control_waveform_color, :filter_control?, :filter_selection,
+ :filter_sound, :filter?, :find_dialog, :find_mark,
+ :find_sound, :finish_progress_report, :fir_filter, :fir_filter?,
+ :flat_top_window, :focus_widget, :foreground_color, :forget_region,
+ :formant, :formant_bank, :formant_bank?, :formant?, :firmant, :firmant?,
+ :comb_bank, :comb_bank?, :all_pass_bank, :all_pass_bank?,
+ :filtered_comb_bank, :filtered_comb_bank?, :make_comb_bank,
+ :make_all_pass_bank, :make_filtered_comb_bank,
+ :fourier_transform, :frample2file, :frample2file?, :frample2frample,
+ :framples, :free_player, :free_sampler,
+ :gaussian_window, :gc_off, :gc_on, :gl_graph2ps, :glSpectrogram,
+ :goto_listener_end, :granulate, :granulate?, :graph, :graph2ps,
+ :graph_as_sonogram, :graph_as_spectrogram, :graph_as_wavogram,
+ :graph_color, :graph_cursor, :graph_data, :graph_dots,
+ :graph_dots_and_lines, :graph_filled, :graph_hook, :graph_lines,
+ :graph_lollipops, :graph_once, :graph_style, :graphs_horizontal,
+ :grid_density, :haar_transform, :hamming_window, :hann_poisson_window,
+ :hann_window, :header_type, :help_dialog, :help_hook, :hide_widget,
+ :highlight_color, :html_dir, :html_program, :hz2radians, :iir_filter,
+ :iir_filter?, :in_any, :ina, :inb, :info_dialog,
+ :init_ladspa, :initial_graph_hook, :insert_file_dialog, :insert_region,
+ :insert_sample, :insert_samples, :insert_samples_with_origin,
+ :insert_selection, :insert_silence, :insert_sound, :just_sounds,
+ :kaiser_window, :key, :key_binding, :key_press_hook, :keyboard_no_action,
+ :ladspa_activate, :ladspa_cleanup, :ladspa_connect_port,
+ :ladspa_deactivate, :ladspa_descriptor, :ladspa_dir, :peak_env_dir,
+ :ladspa_instantiate, :ladspa_run, :ladspa_run_adding,
+ :ladspa_set_run_adding_gain, :left_sample, :linear2db, :lisp_graph,
+ :lisp_graph_hook, :lisp_graph_style, :lisp_graph?, :list2vct,
+ :list_ladspa, :listener_click_hook, :listener_color, :listener_font,
+ :listener_prompt, :listener_selection, :listener_text_color,
+ :little_endian?, :locsig, :locsig_ref, :locsig_reverb_ref,
+ :locsig_reverb_set!, :locsig_set!, :locsig_type, :locsig?,
+ :log_freq_start, :main_menu, :main_widgets, :make_all_pass,
+ :make_asymmetric_fm, :make_moving_average, :make_moving_max,
+ :make_bezier, :make_color, :make_comb, :make_filtered_comb, :make_convolve,
+ :make_delay, :make_env, :make_fft_window, :make_file2frample,
+ :make_file2sample, :make_filter, :make_fir_coeffs, :make_fir_filter,
+ :make_formant, :make_firmant, :make_formant_bank,
+ :make_frample2file, :make_granulate, :make_graph_data, :make_iir_filter,
+ :make_locsig, :make_mix_sampler, :make_move_sound,
+ :make_notch, :make_one_pole, :make_one_pole_all_pass, :make_one_zero,
+ :make_oscil, :make_phase_vocoder, :make_player, :make_polyshape,
+ :make_polywave, :make_pulse_train, :make_rand, :make_rand_interp,
+ :make_readin, :make_region, :make_region_sampler, :make_sample2file,
+ :make_sampler, :make_sawtooth_wave, :make_nrxysin,
+ :make_nrxycos, "make_rxyk!cos".intern, "make_rxyk!sin".intern,
+ :make_snd2sample, :make_square_wave,
+ :make_src, :make_ssb_am, :make_ncos, :make_nsin, :make_table_lookup,
+ :make_triangle_wave, :make_two_pole, :make_two_zero, :make_variable_graph,
+ :make_vct, :make_wave_train, :map_chan, :map_channel, :mark_click_hook,
+ :mark_color, :mark_context, :mark_drag_hook, :mark_home, :mark_hook,
+ :mark_name, :mark_properties, :mark_property, :mark_sample, :mark_sync,
+ :mark_sync_max, :mark_tag_height, :mark_tag_width, :mark?, :marks,
+ :max_regions, :max_transform_peaks, :maxamp, :maxamp_position,
+ :menu_widgets, :min_dB, :mix, :mix_amp, :mix_amp_env, :mix_click_hook,
+ :mix_color, :mix_dialog_mix, :mix_drag_hook, :mix_file_dialog,
+ :mix_length, :mix_home, :mix_name, :mix_position, :mix_properties,
+ :mix_property, :mix_region, :mix_release_hook, :mix_sync, :mix_sync_max,
+ :mix_sampler?, :mix_selection, :mix_speed, :mix_tag_height,
+ :mix_tag_width, :mix_tag_y, :mix_vct, :mix_waveform_height, :mix?,
+ :mixes, :mouse_click_hook, :mouse_drag_hook, :mouse_enter_graph_hook,
+ :mouse_enter_label_hook, :mouse_enter_listener_hook,
+ :mouse_enter_text_hook, :mouse_leave_graph_hook, :mouse_leave_label_hook,
+ :mouse_leave_listener_hook, :mouse_leave_text_hook, :mouse_press_hook,
+ :move_locsig, :move_sound, :move_sound?, :moving_average, :moving_average?,
+ :moving_max, :moving_max?, :mus_aifc,
+ :mus_aiff, :mus_alaw, :mus_alsa_buffer_size, :mus_alsa_buffers,
+ :mus_alsa_capture_device, :mus_alsa_device, :mus_alsa_playback_device,
+ :mus_alsa_squelch_warning, :mus_apply, :mus_array_print_length,
+ :mus_float_equal_fudge_factor, :mus_b24int, :mus_bdouble,
+ :mus_bdouble_unscaled, :mus_bfloat, :mus_bfloat_unscaled, :mus_bicsf,
+ :mus_bint, :mus_bintn, :mus_bshort, :mus_byte, :mus_bytes_per_sample,
+ :mus_caff, :mus_channel, :mus_channels, :mus_chebyshev_first_kind,
+ :mus_chebyshev_second_kind,:mus_clipping, :mus_close, :mus_data,
+ :mus_sample_type2string, :mus_sample_type_name, :mus_describe,
+ :mus_error_hook, :mus_error_type2string, :mus_expand_filename,
+ :mus_feedback, :mus_feedforward, :mus_fft, :mus_file_buffer_size,
+ :mus_file_clipping, :mus_file_name, :mus_frequency,
+ :mus_generator?, :mus_header_raw_defaults, :mus_header_type2string,
+ :mus_header_type_name, :mus_hop, :mus_increment, :mus_input?,
+ :mus_interp_all_pass, :mus_interp_bezier, :mus_interp_hermite,
+ :mus_interp_lagrange, :mus_interp_linear, :mus_interp_none,
+ :mus_interp_sinusoidal, :mus_interp_type, :mus_interpolate,
+ :mus_ircam, :mus_l24int, :mus_ldouble, :mus_ldouble_unscaled,
+ :mus_length, :mus_lfloat, :mus_lfloat_unscaled, :mus_lint,
+ :mus_lintn, :mus_location, :mus_lshort, :mus_max_malloc,
+ :mus_max_table_size, :mus_mulaw, :mus_name, :mus_next,
+ :mus_nist, :mus_offset, :mus_order, :mus_oss_set_buffers,
+ :mus_out_format, :mus_output?, :mus_phase, :mus_ramp,
+ :mus_rand_seed, :mus_random, :mus_raw, :mus_reset, :mus_riff, :mus_run,
+ :mus_scaler, :mus_set_formant_radius_and_frequency, :mus_sound_chans,
+ :mus_sound_comment, :mus_sound_sample_type, :mus_sound_data_location,
+ :mus_sound_datum_size, :mus_sound_duration, :mus_sound_forget,
+ :mus_sound_framples, :mus_sound_header_type, :mus_sound_length,
+ :mus_sound_loop_info, :mus_sound_mark_info, :mus_sound_maxamp,
+ :mus_sound_maxamp_exists?, :mus_sound_prune, :mus_sound_report_cache,
+ :mus_sound_samples, :mus_sound_srate, :mus_sound_type_specifier,
+ :mus_sound_write_date, :mus_soundfont, :mus_srate, :mus_svx,
+ :mus_ubshort, :mus_ubyte, :mus_ulshort, :mus_unknown_sample,
+ :mus_unknown_header, :mus_voc, :mus_width, :mus_xcoeff,
+ :mus_xcoeffs, :mus_ycoeff, :mus_ycoeffs, :name_click_hook,
+ :new_sound, :new_sound_dialog, :new_sound_hook, :new_widget_hook,
+ :next_sample, :normalize_by_channel, :normalize_by_sound,
+ :normalize_channel, :normalize_globally, :notch, :notch?,
+ :one_pole, :one_pole?, :one_pole_all_pass, :one_pole_all_pass?,
+ :one_zero, :one_zero?,
+ :open_file_dialog, :open_file_dialog_directory, :open_hook,
+ :open_raw_sound, :open_raw_sound_hook, :open_sound, :orientation_hook,
+ :oscil, :oscil?, :out_any, :outa, :outb, :outc, :outd,
+ :output_comment_hook, :override_samples_with_origin,
+ :pad_channel, :partials2polynomial, :partials2wave, :parzen_window,
+ :pausing, :peaks, :peaks_font, :phase_partials2wave,
+ :phase_vocoder, :phase_vocoder_amp_increments, :phase_vocoder_amps,
+ :phase_vocoder_freqs, :phase_vocoder_phase_increments,
+ :phase_vocoder_phases, :phase_vocoder?, :play, :play_arrow_size,
+ :play_hook, :player_home, :player?, :players, :playing, :poisson_window,
+ :polar2rectangular, :polynomial, :polyshape, :polywave, :polyshape?,
+ :polywave?, :position2x, :position2y, :position_color, :preferences_dialog,
+ :previous_sample, :print_dialog, :print_length, :progress_report,
+ :pulse_train, :pulse_train?, :radians2degrees, :radians2hz, :ramp_channel,
+ :rand, :rand_interp, :rand_interp?, :rand?, :read_mix_sample,
+ :read_only, :read_region_sample, :read_sample, :readin, :readin?,
+ :rectangular2magnitudes, :rectangular2polar, :rectangular_window,
+ :redo_edit, :region2vct, :region_chans, :region_home, :region_framples,
+ :region_graph_style, :region_maxamp, :region_maxamp_position,
+ :region_position, :region_sample, :region_sampler?, :region_srate,
+ :region?, :regions, :remember_sound_state, :remove_from_menu,
+ :reset_controls, :reset_listener_cursor, :restore_controls,
+ :restore_region, :reverb_control_decay, :reverb_control_feedback,
+ :reverb_control_length, :reverb_control_length_bounds,
+ :reverb_control_lowpass, :reverb_control_scale,
+ :reverb_control_scale_bounds, :reverb_control?, :reverse_channel,
+ :reverse_selection, :reverse_sound, :revert_sound, :riemann_window,
+ :right_sample, :ring_modulate, :rv2_window, :rv3_window, :rv4_window,
+ :samaraki_window, :sample, :sample2file, :sample2file?,
+ :sampler_at_end?, :sampler_home, :sampler_position, :sampler?, :samples,
+ :samples2seconds, :sash_color, :save_controls, :save_dir,
+ :save_edit_history, :save_envelopes, :save_hook, :save_listener,
+ :save_marks, :save_region, :save_region_dialog, :save_selection,
+ :save_selection_dialog, :save_sound, :save_sound_as, :save_sound_dialog,
+ :save_state, :save_state_file, :save_state_hook, :sawtooth_wave,
+ :sawtooth_wave?, :scale_by, :scale_channel, :scale_selection_by,
+ :scale_selection_to, :scale_to, :scan_channel, :script_arg,
+ :script_args, :search_procedure, :seconds2samples, :select_all,
+ :select_channel, :select_channel_hook, :select_sound, :select_sound_hook,
+ :selected_channel, :selected_data_color, :selected_graph_color,
+ :selected_sound, :selection_chans, :selection_color,
+ :selection_context, :selection_creates_region, :selection_framples,
+ :selection_maxamp, :selection_maxamp_position, :selection_member?,
+ :selection_position, :selection_srate, :selection?, :short_file_name,
+ :show_all_axes, :show_all_axes_unlabelled, :show_bare_x_axis,
+ :show_axes, :show_controls, :show_grid, :show_indices,
+ :show_full_duration, :show_full_range, :initial_beg, :initial_dur,
+ :show_listener, :show_marks, :show_mix_waveforms, :show_no_axes,
+ :show_selection, :show_selection_transform, :show_sonogram_cursor,
+ :show_transform_peaks, :show_widget, :show_x_axis,
+ :show_x_axis_unlabelled, :show_y_zero, :sinc_width, :nrxysin,
+ :nrxysin?, :nrxycos, :nrxycos?, "rxyk!cos".intern, "rxyk!cos?".intern,
+ "rxyk!sin".intern, "rxyk!sin?".intern, :smooth_channel, :smooth_selection,
+ :smooth_sound, :snd2sample, :snd2sample?, :snd_error, :snd_error_hook,
+ :snd_gcs, :snd_help, :snd_font, :snd_color, :snd_print, :snd_spectrum,
+ :snd_tempnam, :snd_url, :snd_urls, :snd_version, :snd_warning,
+ :snd_warning_hook, :sound_file_extensions, :sound_file?,
+ :sound_files_in_directory, :sound_loop_info, :sound_properties,
+ :sound_property, :sound_widgets, :sound?, :soundfont_info, :sounds,
+ :spectrum_end, :spectro_hop, :spectrum_start, :spectro_x_angle,
+ :spectro_x_scale, :spectro_y_angle, :spectro_y_scale, :spectro_z_angle,
+ :spectro_z_scale, :spectrum, :speed_control, :speed_control_as_float,
+ :speed_control_as_ratio, :speed_control_as_semitone,
+ :speed_control_bounds, :speed_control_style, :speed_control_tones,
+ :square_wave, :square_wave?, :squelch_update, :srate, :src,
+ :src_channel, :src_selection, :src_sound, :src?, :ssb_am, :ssb_am?,
+ :start_playing, :start_playing_hook,
+ :start_playing_selection_hook, :start_progress_report,
+ :status_report, :stop_player, :stop_playing,
+ :stop_playing_hook, :stop_playing_selection_hook, :ncos, :ncos?,
+ :nsin, :nsin?, :swap_channels, :sync, :sync_style, :sync_none,
+ :sync_all, :sync_by_sound, :sync_max, :syncd_marks, :table_lookup,
+ :table_lookup?, :tap, :tap?, :temp_dir, :text_focus_color, :time_graph,
+ :time_graph_style, :time_graph_type, :time_graph?, :tiny_font,
+ :tracking_cursor_style, :transform2vct, :transform_dialog,
+ :transform_framples, :transform_graph, :transform_graph_style,
+ :transform_graph_type, :transform_graph?, :transform_normalization,
+ :transform_sample, :transform_size, :transform_type, :transform?,
+ :triangle_wave, :triangle_wave?, :tukey_window,
+ :two_pole, :two_pole?, :two_zero, :two_zero?, :ultraspherical_window,
+ :unbind_key, :undo, :undo_edit, :undo_hook, :unselect_all,
:update_hook, :update_lisp_graph, :update_sound, :update_time_graph,
- :update_transform_graph, :variable_graph?, :vct, :vct_multiply, :vct_add, :vct2channel,
- :vct2list, :vct2sound_data, :vct2string, :vct2vector, :vct_add!, :vct_copy, :vct_fill!,
- :vct_length, :vct_map!, :vct_move!, :vct_multiply!, :vct_offset!, :vct_peak, :vct_ref,
- :vct_reverse!, :vct_scale!, :vct_set!, :vct_subseq, :vct_subtract!, :vct?, :vector2vct,
- :view_files_amp, :view_files_amp_env, :view_files_dialog, :view_files_files,
- :view_files_select_hook, :view_files_selected_files, :view_files_sort, :view_files_speed,
- :view_files_speed_style, :view_mixes_dialog, :view_regions_dialog, :view_sound,
- :walsh_transform, :wave_train, :wave_train?, :wavelet_transform, :wavelet_type,
- :wavo_hop, :wavo_trace, :welch_window, :widget_position, :widget_size, :widget_text,
- :window_height, :window_width, :window_x, :window_y, :with_background_processes,
- :with_file_monitor, :with_gl, :with_mix_tags, :with_relative_panes, :with_tracking_cursor,
- :with_verbose_cursor, :with_inset_graph, :with_pointer_focus,
- :with_smpte_label, :with_toolbar, :with_tooltips, :with_menu_icons,
- :save_as_dialog_src, :save_as_dialog_auto_comment, :x2position,
- :x_axis_as_clock, :x_axis_as_percentage, :x_axis_in_beats, :x_axis_in_measures,
- :x_axis_in_samples, :x_axis_in_seconds, :x_axis_label, :x_axis_style, :x_bounds,
- :x_position_slider, :x_zoom_slider, :xramp_channel, :y2position, :y_axis_label,
- :y_bounds, :y_position_slider, :y_zoom_slider, :zero_pad, :zoom_color, :zoom_focus_active,
- :zoom_focus_left, :zoom_focus_middle, :zoom_focus_right, :zoom_focus_style].each do |n|
+ :update_transform_graph, :variable_graph?, :vct, :vct_multiply,
+ :vct_add, :vct2channel, :vct2list, :vct2string,
+ :vct2vector, :vct_add!, :vct_length,
+ :vct_max, :vct_min, :vct_move!, :vct_multiply!, :vct_offset!,
+ :vct_peak, :vct_ref, :vct_reverse!, :vct_scale!, :vct_set!, :vct_subseq,
+ :vct_subtract!, :vct?, :vector2vct, :view_sound, :walsh_transform,
+ :wave_train, :wave_train?, :wavelet_transform, :wavelet_type, :wavo_hop,
+ :wavo_trace, :welch_window, :widget_position, :widget_size, :widget_text,
+ :window_height, :window_width, :window_x, :window_y,
+ :with_background_processes, :with_file_monitor, :with_gl,
+ :with_mix_tags, :with_relative_panes, :with_tracking_cursor,
+ :with_verbose_cursor, :with_inset_graph, :with_interrupts,
+ :with_pointer_focus, :with_smpte_label, :with_toolbar, :with_tooltips,
+ :with_menu_icons, :save_as_dialog_src, :save_as_dialog_auto_comment,
+ :x2position, :x_axis_as_clock, :x_axis_as_percentage, :x_axis_in_beats,
+ :x_axis_in_measures, :x_axis_in_samples, :x_axis_in_seconds,
+ :x_axis_label, :x_axis_style, :x_bounds, :x_position_slider,
+ :x_zoom_slider, :xramp_channel, :y2position, :y_axis_label,
+ :y_bounds, :y_position_slider, :y_zoom_slider, :zero_pad,
+ :zoom_color, :zoom_focus_active, :zoom_focus_left, :zoom_focus_middle,
+ :zoom_focus_right, :zoom_focus_style].each do |n|
next if Module.function?(n)
str = n.to_s
next if Object.const_defined?("#{str.capitalize}".intern)
str = "$" + str
- # FIXME
- # ruby18 likes a String
+ # XXX: ruby18 likes a String
next if kernel_global_variables.member?(str)
- # ruby19 likes a Symbol
+ # XXX: ruby19+ likes a Symbol
next if kernel_global_variables.member?(str.intern)
undefined << n
end
@@ -2640,49 +2753,22 @@ def test_03
undefined.delete_if do |s| s == :gl_graph2ps end
end
unless undefined.empty?
- snd_display("undefined: %s", undefined)
+ snd_display("undefined[%d]: %s", undefined.length, undefined)
end
end
# ---------------- test 04: sndlib ----------------
-def play_sound_1(file)
- sound_fd = mus_sound_open_input(file)
- chans = mus_sound_chans(file)
- frames = mus_sound_frames(file)
- srate = mus_sound_srate(file)
- bufsize = 256
- data = SoundData.new(chans, bufsize)
- bytes = bufsize * chans * 2
- audio_fd = mus_audio_open_output(0, srate, chans, Mus_lshort, bytes)
- if audio_fd == -1
- audio_fd = mus_audio_open_output(0, srate, chans, Mus_bshort, bytes)
- end
- if audio_fd == -1
- snd_display("cannot play %s", file)
- else
- 0.step(frames, bufsize) do
- mus_sound_read(sound_fd, 0, bufsize - 1, chans, data)
- mus_audio_write(audio_fd, data, bufsize)
- end
- mus_audio_close(audio_fd)
- end
-rescue
- snd_display("cannot open audio (%s)", file)
-ensure
- data = nil
- mus_sound_close_input(sound_fd)
-end
-
def frame2byte(file, frame)
- mus_sound_data_location(file) + mus_sound_chans(file) * mus_sound_datum_size(file) * frame
+ mus_sound_data_location(file) + mus_sound_chans(file) *
+ mus_sound_datum_size(file) * frame
end
def test_04_00
oboe_snd = "oboe.snd"
chns = mus_sound_chans(oboe_snd)
dl = mus_sound_data_location(oboe_snd)
- fr = mus_sound_frames(oboe_snd)
+ fr = mus_sound_framples(oboe_snd)
smps = mus_sound_samples(oboe_snd)
len = mus_sound_length(oboe_snd)
size = mus_sound_datum_size(oboe_snd)
@@ -2691,7 +2777,7 @@ def test_04_00
m1 = mus_sound_maxamp_exists?(oboe_snd)
mal = mus_sound_maxamp(oboe_snd)
mz = mus_sound_maxamp "z.snd"
- bytes = mus_bytes_per_sample(mus_sound_data_format(oboe_snd))
+ bytes = mus_bytes_per_sample(mus_sound_sample_type(oboe_snd))
snd_test_neq(mz[0], 0, "mus_sound_maxamp z.snd")
snd_test_neq(mz[1], 0.0, "mus_sound_maxamp z.snd")
[[Mus_bshort, 2],
@@ -2718,8 +2804,10 @@ def test_04_00
[Mus_lfloat_unscaled, 4]].each do |frm, siz|
snd_test_neq(mus_bytes_per_sample(frm), siz, "mus_bytes_per_sample")
end
- snd_test_neq(mus_data_format2string(Mus_bshort), "Mus_bshort", "mus_data_format2string")
- snd_test_neq(mus_header_type2string(Mus_aifc), "Mus_aifc", "mus_header_type2string")
+ snd_test_neq(mus_sample_type2string(Mus_bshort), "Mus_bshort",
+ "mus_sample_type2string")
+ snd_test_neq(mus_header_type2string(Mus_aifc), "Mus_aifc",
+ "mus_header_type2string")
hiho = "hiho.tmp"
mus_sound_report_cache(hiho)
fp = File.open(hiho)
@@ -2727,13 +2815,9 @@ def test_04_00
fp.close
delete_file(hiho)
req = 10
- res = mus_audio_describe.length
- if res < req
- snd_display(snd_format(res, req, "<", "mus_audio_describe: %s?", mus_audio_describe))
- end
snd_test_neq(chns, 1, "oboe: mus_sound_chans")
snd_test_neq(dl, 28, "oboe: mus_sound_data_location")
- snd_test_neq(fr, 50828, "oboe: mus_sound_frames")
+ snd_test_neq(fr, 50828, "oboe: mus_sound_framples")
snd_test_neq(smps, 50828, "oboe: mus_sound_samples")
snd_test_neq(len, 50828 * 2 + 28, "oboe: mus_sound_length")
snd_test_neq(size, 2, "oboe: mus_sound_datum_size")
@@ -2768,12 +2852,12 @@ def test_04_00
snd_test_neq(frm, Mus_bdouble_unscaled, "mus_header_raw_defaults format")
set_mus_header_raw_defaults(old_val)
#
- snd_test_neq(Time.at(mus_sound_write_date(oboe_snd)).localtime.strftime("%d-%b %H:%M"),
- "15-Oct 04:34",
- "mus_sound_write_date oboe.snd")
- snd_test_neq(Time.at(mus_sound_write_date("pistol.snd")).localtime.strftime("%d-%b %H:%M"),
- "01-Jul 13:06",
- "mus_sound_write_date pistol.snd")
+ tm = mus_sound_write_date(oboe_snd)
+ snd_test_neq(Time.at(tm).localtime.strftime("%d-%b %H:%M"), "15-Oct 04:34",
+ "mus_sound_write_date oboe.snd")
+ tm = mus_sound_write_date("pistol.snd")
+ snd_test_neq(Time.at(tm).localtime.strftime("%d-%b %H:%M"), "01-Jul 22:06",
+ "mus_sound_write_date pistol.snd")
#
ind = open_sound(oboe_snd)
lfname = "test" + "-test" * 10 + ".snd"
@@ -2800,10 +2884,7 @@ def test_04_00
snd_display("cannot find test...snd")
end
req = lfname.length
- res = file_name(ind).length
- if res < req
- snd_display(snd_format(res, req, "<", "file_name length"))
- end
+ snd_test_lt(file_name(ind).length, req, "file_name length")
snd_test_neq(short_file_name(ind).length, req, "short_file_name length")
close_sound(ind)
mus_sound_forget(lfname)
@@ -2814,47 +2895,58 @@ def test_04_00
ind = open_sound("fmv.snd")
snd_test_neq(sound_loop_info(ind), mus_sound_loop_info(fsnd), "loop_info")
set_sound_loop_info(ind, [12000, 14000, 1, 2, 3, 4])
- snd_test_neq(sound_loop_info(ind), [12000, 14000, 1, 2, 3, 4, 1, 1], "set_loop_info")
- save_sound_as("fmv1.snd", ind, Mus_aifc)
+ snd_test_neq(sound_loop_info(ind),
+ [12000, 14000, 1, 2, 3, 4, 1, 1], "set_loop_info")
+ save_sound_as("fmv1.snd", ind, :header_type, Mus_aifc)
close_sound(ind)
- snd_test_neq(mus_sound_loop_info("fmv1.snd"), [12000, 14000, 1, 2, 3, 4, 1, 1], "saved loop_info")
+ snd_test_neq(mus_sound_loop_info("fmv1.snd"),
+ [12000, 14000, 1, 2, 3, 4, 1, 1], "saved loop_info")
end
#
ind = open_sound(oboe_snd)
- save_sound_as("fmv.snd", ind, Mus_aifc)
+ save_sound_as("fmv.snd", ind, :header_type, Mus_aifc)
close_sound(ind)
ind = open_sound("fmv.snd")
snd_test_neq(sound_loop_info(ind), nil, "null loop_info")
set_sound_loop_info(ind, [1200, 1400, 4, 3, 2, 1])
- snd_test_neq(sound_loop_info(ind), [1200, 1400, 4, 3, 2, 1, 1, 1], "set null loop_info")
+ snd_test_neq(sound_loop_info(ind),
+ [1200, 1400, 4, 3, 2, 1, 1, 1], "set null loop_info")
save_sound_as("fmv1.snd", :sound, ind, :header_type, Mus_aifc)
close_sound(ind)
- snd_test_neq(mus_sound_loop_info("fmv1.snd"), [1200, 1400, 4, 3, 2, 1, 1, 1], "saved null loop_info")
+ snd_test_neq(mus_sound_loop_info("fmv1.snd"),
+ [1200, 1400, 4, 3, 2, 1, 1, 1], "saved null loop_info")
ind = open_sound("fmv.snd")
set_sound_loop_info(ind, [1200, 1400, 4, 3, 2, 1, 1, 0])
- snd_test_neq(sound_loop_info(ind), [1200, 1400, 0, 0, 2, 1, 1, 0], "set null loop_info (no mode1)")
- save_sound_as("fmv1.snd", ind, Mus_aifc)
+ snd_test_neq(sound_loop_info(ind),
+ [1200, 1400, 0, 0, 2, 1, 1, 0], "set null loop_info (no mode1)")
+ save_sound_as("fmv1.snd", ind, :header_type, Mus_aifc)
close_sound(ind)
- snd_test_neq(mus_sound_loop_info("fmv1.snd"), [1200, 1400, 0, 0, 2, 1, 1, 0], "saved null loop_info (no mode1)")
+ snd_test_neq(mus_sound_loop_info("fmv1.snd"),
+ [1200, 1400, 0, 0, 2, 1, 1, 0], "saved null loop_info (no mode1)")
#
unless com.empty?
snd_display("oboe: mus_sound_comment: %s", com.inspect)
end
- [["nasahal8.wav", "ICRD: 1997-02-22\nIENG: Paul R. Roger\nISFT: Sound Forge 4.0\n"],
+ [["nasahal8.wav",
+ "ICRD: 1997-02-22\nIENG: Paul R. Roger\nISFT: Sound Forge 4.0\n"],
["8svx-8.snd", "File created by Sound Exchange "],
["sun-16-afsp.snd", "AFspdate:1981/02/11 23:03:34 UTC"],
["smp-16.snd", "Converted using Sox. "],
["d40130.au", "1994 Jesus Villena"],
["wood.maud", "file written by SOX MAUD-export "],
- ["addf8.sf_mipseb", "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" "],
+ ["addf8.sf_mipseb",
+ "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" "],
["mary-sun4.sig", "MARY HAD A LITTLE LAMB\n"],
["nasahal.pat", "This patch saved with Sound Forge 3.0."],
- ["next-16.snd", ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91"],
+ ["next-16.snd",
+ ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91"],
["wood16.nsp", "Created by Snack "],
["wood.sdx", "1994 Jesus Villena"],
["clmcom.aif", "this is a comment"],
["anno.aif", "1994 Jesus Villena\n"],
- ["telephone.wav", "sample_byte_format -s2 01\nchannel_count -i 1\nsample_count -i 36461\nsample_rate -i 16000\nsample_n_bytes -i 2\nsample_sig_bits -i 16\n"]].each do |f, req|
+ ["telephone.wav",
+ "sample_byte_format -s2 01\nchannel_count -i 1\nsample_count -i 36461\nsample_rate -i 16000\nsample_n_bytes -i 2\nsample_sig_bits -i 16\n"]
+ ].each do |f, req|
with_file(f) do |fsnd|
snd_test_neq(mus_sound_comment(fsnd), req, "mus_sound_comment %s", fsnd)
end
@@ -2869,117 +2961,101 @@ def test_04_00
snd_test_neq(mal[1], 0.14724, "oboe: mus_sound_maxamp")
snd_test_neq(mal[0], 24971, "oboe: mus_sound_maxamp at %d", mal[0])
end
- set_mus_sound_maxamp(oboe_snd, [1234, 0.5])
- mal = mus_sound_maxamp(oboe_snd)
- snd_test_neq(mal[1], 0.5, "oboe: set_mus_sound_maxamp")
- snd_test_neq(mal[0], 1234, "oboe: set_mus_sound_maxamp at %d", mal[0])
- #
- mal = mus_sound_maxamp("4.aiff")
- if $clmtest.zero?
- snd_test_neq(mal,
- vct(810071, 0.245, 810071, 0.490, 810071, 0.735, 810071, 0.980),
- "mus_sound_maxamp 4.aiff")
- end
- set_mus_sound_maxamp("4.aiff", [12345, 0.5, 54321, 0.2, 0, 0.1, 9999, 0.01])
- snd_test_neq(mus_sound_maxamp("4.aiff"),
- vct(12345, 0.5, 54321, 0.2, 0, 0.1, 9999, 0.01),
- "set_mus_sound_maxamp 4.aiff")
- #
- if (res = Snd.catch do set_mus_sound_maxamp(oboe_snd, [1234]) end).first != :wrong_type_arg
- snd_display("set_mus_sound_maxamp bad arg: %s?", res.inspect)
- end
res = mus_sound_type_specifier(oboe_snd)
if res != 0x646e732e and # little endian reader
res != 0x2e736e64 # big endian reader
snd_display("oboe: mus_sound_type_specifier: 0x%x?", res)
end
#
- snd_test_neq(Time.at(file_write_date(oboe_snd)).localtime.strftime("%d-%b-%Y %H:%M"),
- "15-Oct-2006 04:34",
- "file_write_date oboe.snd")
- play_sound_1(oboe_snd)
- mus_sound_forget(oboe_snd)
+ tm = file_write_date(oboe_snd)
+ snd_test_neq(Time.at(tm).localtime.strftime("%d-%b-%Y %H:%M"),
+ "15-Oct-2006 04:34", "file_write_date oboe.snd")
#
lasth = 1
- until mus_header_type_name(lasth) == "unsupported"
+ until mus_header_type_name(lasth) == "unknown"
lasth += 1
end
if lasth < 50
snd_display("header_type[%d] == %s?", lasth, mus_header_type_name(lasth))
end
lasth = 1
- until mus_data_format_name(lasth) == "unknown"
+ until mus_sample_type_name(lasth) == "unknown"
lasth += 1
end
if lasth < 10
- snd_display("data_format[%d] == %s?", lasth, mus_data_format_name(lasth))
+ snd_display("sample_type[%d] == %s?", lasth, mus_sample_type_name(lasth))
end
[:Dont_normalize,
:Normalize_globally,
:Normalize_by_channel].each do |val_sym|
req = Module.const_get(val_sym)
set_transform_normalization(req)
- snd_test_neq(transform_normalization, req, "set_transform_normalization(%s)", val_sym)
+ snd_test_neq(transform_normalization, req,
+ "set_transform_normalization(%s)", val_sym)
end
#
- ind = new_sound("fmv.snd", Mus_next, Mus_bshort, 22050, 1, "set_samples test", 100)
+ ind = new_sound("fmv.snd", 1, 22050, Mus_bshort, Mus_next,
+ "set_samples test", 100)
set_samples(10, 3, Vct.new(3, 0.1))
snd_test_neq(channel2vct(0, 20, ind, 0),
- vct(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
- "1 set samples 0 for 0.1")
+ vct(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
+ "1 set samples 0 for 0.1")
set_samples(20, 3, Vct.new(3, 0.1), ind, 0)
snd_test_neq(channel2vct(10, 20, ind, 0),
- vct(0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
- "2 set samples 10 for 0.1")
+ vct(0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
+ "2 set samples 10 for 0.1")
set_samples(30, 3, Vct.new(3, 0.1), ind, 0, false, "a name")
snd_test_neq(channel2vct(20, 20, ind, 0),
- vct(0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
- "3 set samples 20 for 0.1")
+ vct(0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
+ "3 set samples 20 for 0.1")
set_samples(0, 3, Vct.new(3, 0.2), ind, 0, false, "a name", 0, 1)
snd_test_neq(channel2vct(0, 20, ind, 0),
- vct(0.2, 0.2, 0.2, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
- "4 set samples 0 at 1 for 0.1")
+ vct(0.2, 0.2, 0.2, 0, 0, 0, 0, 0, 0, 0, 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
+ "4 set samples 0 at 1 for 0.1")
snd_test_neq(channel2vct(20, 20, ind, 0),
- Vct.new(20, 0.0),
- "5 set samples 20 at 1 for 0.1")
+ Vct.new(20, 0.0),
+ "5 set samples 20 at 1 for 0.1")
nd = new_sound("fmv1.snd", :channels, 2)
vct2channel(Vct.new(10, 0.5), 0, 10, nd, 0)
vct2channel(Vct.new(10, 0.3), 0, 10, nd, 1)
save_sound_as("fmv1.snd", nd)
close_sound(nd)
- unless File.exists?("fmv1.snd")
+ unless File.exist?("fmv1.snd")
snd_display("fmv1.snd not saved?")
end
set_samples(0, 10, "fmv1.snd", ind, 0, false, "another name", 1)
snd_test_neq(channel2vct(0, 20, ind, 0),
- vct(0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3,
- 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
+ vct(0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3,
+ 0.1, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
"6 set samples 0 at 1 for 0.1")
set_samples(5, 6, "fmv1.snd", ind, 0, false, "another name 7", 0)
snd_test_neq(channel2vct(0, 20, ind, 0),
- vct(0.3, 0.3, 0.3, 0.3, 0.3, 0.5, 0.5, 0.5, 0.5, 0.5,
- 0.5, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
- "7 set samples 0 at 1 for 0.1")
+ vct(0.3, 0.3, 0.3, 0.3, 0.3, 0.5, 0.5, 0.5, 0.5, 0.5,
+ 0.5, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0),
+ "7 set samples 0 at 1 for 0.1")
revert_sound(ind)
set_samples(0, 10, "fmv1.snd", ind, 0, false, "another name 8", 1, 0, false)
snd_test_neq(channel2vct(0, 20, ind, 0),
- vct(0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
- "8 set samples 0 at 1 for 0.1")
+ vct(0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3,
+ 0.3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
+ "8 set samples 0 at 1 for 0.1")
set_samples(10, 10, "fmv1.snd", ind, 0, false, "another name 9", 0, 0)
snd_test_neq(channel2vct(0, 20, ind, 0),
- vct(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5),
- "9 set samples 0 at 1 for 0.1")
+ vct(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.5, 0.5,
+ 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5),
+ "9 set samples 0 at 1 for 0.1")
set_samples(20, 10, "fmv1.snd")
snd_test_neq(channel2vct(10, 20, ind, 0),
- Vct.new(20, 0.5),
- "10 set samples 0 at 1 for 0.1")
+ Vct.new(20, 0.5),
+ "10 set samples 0 at 1 for 0.1")
revert_sound(ind)
set_samples(0, 10, "fmv1.snd", ind, 0, true, "another name", 1, 0, false)
- snd_test_neq(frames(ind, 0), 10, "11 set samples truncate")
+ snd_test_neq(framples(ind, 0), 10, "11 set samples truncate")
revert_sound(ind)
delete_file("fmv1.snd")
#
- if (res = Snd.catch do set_samples(0, 10, "fmv1.snd", ind, 0) end).first != :no_such_file
+ res = Snd.catch do set_samples(0, 10, "fmv1.snd", ind, 0) end
+ if res.first != :no_such_file
snd_display("set samples, no such file: %s", res.inspect)
end
nd = new_sound("fmv1.snd", :channels, 1)
@@ -2996,10 +3072,12 @@ def test_04_00
end).first != :no_such_channel
snd_display("set samples no such channel (-1): %s", res.inspect)
end
- if (res = Snd.catch do set_samples(0, -10, "fmv1.snd") end).first != :wrong_type_arg
+ res = Snd.catch do set_samples(0, -10, "fmv1.snd") end
+ if res.first != :wrong_type_arg
snd_display("set samples (-10): %s", res.inspect)
end
- if (res = Snd.catch do set_samples(-10, 10, "fmv1.snd") end).first != :no_such_sample
+ res = Snd.catch do set_samples(-10, 10, "fmv1.snd") end
+ if res.first != :no_such_sample
snd_display("set samples (beg -10): %s", res.inspect)
end
close_sound(ind)
@@ -3021,7 +3099,7 @@ def test_04_00
[Mus_bfloat, 2 ** -23],
[Mus_bdouble, 2 ** -23],
[Mus_ldouble, 2 ** -23]].each do |type, allowed_diff|
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next)
v = make_vct(len)
maxdiff = 0.0
maxpos = false
@@ -3042,7 +3120,7 @@ def test_04_00
v[i] = 1.0 - val
end
vct2channel(v, 0, len, ind, 0)
- save_sound_as("test1.snd", ind, Mus_next, :data_format, type)
+ save_sound_as("test1.snd", ind, :header_type, Mus_next, :sample_type, type)
close_sound(ind)
ind = open_sound("test1.snd")
v1 = channel2vct(0, len, ind, 0)
@@ -3054,10 +3132,11 @@ def test_04_00
end
end
if maxdiff > allowed_diff
- snd_display(snd_format_neq(v1[maxpos], v[maxpos], "type %s: maxdiff %1.4f, maxpos %d",
- mus_data_format_name(type),
- maxdiff,
- maxpos))
+ snd_display(snd_format_neq(v1[maxpos], v[maxpos],
+ "type %s: maxdiff %1.4f, maxpos %d",
+ mus_sample_type_name(type),
+ maxdiff,
+ maxpos))
end
close_sound(ind)
end
@@ -3065,30 +3144,36 @@ def test_04_00
ob = view_sound(oboe_snd)
samp = sample(1000, ob)
old_comment = mus_sound_comment(oboe_snd)
- str = format("written %s", Time.now.localtime.strftime("%a %d-%b-%Y %H:%M %Z"))
+ str = format("written %s",
+ Time.now.localtime.strftime("%a %d-%b-%Y %H:%M"))
set_comment(ob, str)
#
check_it = lambda do |snd, type, fmt|
- snd_test_neq(header_type(snd), type, "save_as %s", mus_header_type_name(type))
+ snd_test_neq(header_type(snd), type,
+ "save_as %s", mus_header_type_name(type))
ntyp = mus_sound_header_type("test.snd")
snd_test_neq(ntyp,
type,
"saved_as %s -> %s",
mus_header_type_name(type),
mus_header_type_name(ntyp))
- snd_test_neq(data_format(snd), fmt, "save_as %s", mus_data_format_name(fmt))
- nfmt = mus_sound_data_format("test.snd")
+ snd_test_neq(sample_type(snd), fmt,
+ "save_as %s", mus_sample_type_name(fmt))
+ nfmt = mus_sound_sample_type("test.snd")
snd_test_neq(nfmt,
fmt,
"saved_as %s -> %s",
- mus_data_format_name(fmt),
- mus_data_format_name(nfmt))
- snd_test_neq(sample(1000, snd), samp, "%s[1000]", mus_header_type_name(type))
+ mus_sample_type_name(fmt),
+ mus_sample_type_name(nfmt))
+ snd_test_neq(sample(1000, snd), samp,
+ "%s[1000]", mus_header_type_name(type))
end
#
- if (tag = Snd.catch do
- save_sound_as("test.snd", ob, Mus_aifc, Mus_bdouble)
- end).first == :cannot_save
+ tag = Snd.catch do
+ save_sound_as("test.snd", ob,
+ :header_type, Mus_aifc, :sample_type, Mus_bdouble)
+ end
+ if tag.first == :cannot_save
snd_display("save_sound_as test.snd write trouble: %s", tag)
end
#
@@ -3098,15 +3183,16 @@ def test_04_00
snd_test_neq(mus_sound_comment("test.snd"), str, "output_comment")
snd_test_neq(comment(ab), str, "output_comment (comment)")
close_sound(ab)
- snd_test_neq(mus_sound_comment(oboe_snd), old_comment, "set_comment overwrote current")
+ snd_test_neq(mus_sound_comment(oboe_snd), old_comment,
+ "set_comment overwrote current")
set_filter_control_in_hz(false)
#
- save_sound_as("test.snd", ob, Mus_raw)
+ save_sound_as("test.snd", ob, :header_type, Mus_raw)
ab = open_raw_sound("test.snd", 1, 22050, Mus_bshort)
check_it.call(ab, Mus_raw, Mus_bshort)
close_sound(ab)
#
- save_sound_as("test.snd", ob, Mus_nist, Mus_bint)
+ save_sound_as("test.snd", ob, :header_type, Mus_nist, :sample_type, Mus_bint)
ab = open_sound("test.snd")
check_it.call(ab, Mus_nist, Mus_bint)
close_sound(ab)
@@ -3115,7 +3201,10 @@ def test_04_00
$output_comment_hook.add_hook!("snd-test-4") do |string|
string + " [written by me]"
end
- save_sound_as(:file, "test.snd", :sound, ob, :header_type, Mus_riff, :data_format, Mus_lfloat)
+ save_sound_as(:file, "test.snd",
+ :sound, ob,
+ :header_type, Mus_riff,
+ :sample_type, Mus_lfloat)
$output_comment_hook.reset_hook!
ab = open_sound("test.snd")
check_it.call(ab, Mus_riff, Mus_lfloat)
@@ -3124,24 +3213,25 @@ def test_04_00
[[Mus_aiff, Mus_b24int],
[Mus_ircam, Mus_mulaw],
[Mus_next, Mus_alaw],
- [Mus_next, Mus_bdouble]].each do |type, fmt|
- save_sound_as("test.snd", ob, type, fmt)
+ [Mus_next, Mus_ldouble]].each do |type, fmt|
+ save_sound_as("test.snd", ob, :header_type, type, :sample_type, fmt)
ab = open_sound("test.snd")
check_it.call(ab, type, fmt)
close_sound(ab)
end
- save_sound_as("test.snd", ob, Mus_next, Mus_bshort)
+ save_sound_as("test.snd", ob,
+ :header_type, Mus_next, :sample_type, Mus_bshort)
ab = open_sound("test.snd")
check_it.call(ab, Mus_next, Mus_bshort)
$update_hook.reset_hook!
set_y_bounds([-3.0, 3.0], ab, 0)
- set_data_format(ab, Mus_lshort)
+ set_sample_type(ab, Mus_lshort)
# ; these set!'s can change the index via update-sound
if find_sound("test.snd") != ab
ab = find_sound("test.snd")
end
- frm = data_format(ab)
- snd_test_neq(frm, Mus_lshort, "set_data_format %s", mus_data_format_name(frm))
+ frm = sample_type(ab)
+ snd_test_neq(frm, Mus_lshort, "set_sample_type %s", mus_sample_type_name(frm))
snd_test_neq(y_bounds(ab, 0), [-3.0, 3.0], "set data format y_bounds")
set_y_bounds([2.0], ab, 0)
snd_test_neq(y_bounds(ab, 0), [-2.0, 2.0], "set data format y_bounds 1")
@@ -3177,20 +3267,22 @@ def test_04_00
snd_test_neq(srate(ab), 12345, "set_srate")
close_sound(ab)
#
- save_sound_as("test.snd", ob, Mus_next, Mus_bfloat)
+ save_sound_as("test.snd", ob,
+ :header_type, Mus_next, :sample_type, Mus_bfloat)
ab = open_sound("test.snd")
check_it.call(ab, Mus_next, Mus_bfloat)
close_sound(ab)
#
- save_sound_as("test.snd", ob, Mus_next, Mus_bshort)
+ save_sound_as("test.snd", ob,
+ :header_type, Mus_next, :sample_type, Mus_bshort)
close_sound(ob)
ab = open_sound("test.snd")
- set_data_format(Mus_lshort)
+ set_sample_type(Mus_lshort)
if find_sound("test.snd") != ab
ab = find_sound("test.snd")
end
- frm = data_format(ab)
- snd_test_neq(frm, Mus_lshort, "set_data_format %s", mus_data_format_name(frm))
+ frm = sample_type(ab)
+ snd_test_neq(frm, Mus_lshort, "set_sample_type %s", mus_sample_type_name(frm))
set_header_type(Mus_aifc)
if find_sound("test.snd") != ab
ab = find_sound("test.snd")
@@ -3216,13 +3308,16 @@ def test_04_00
#
ind = open_sound("2a.snd")
[[lambda do
- save_sound_as("test.snd", :header_type, Mus_riff, :data_format, Mus_l24int, :channel, 0)
+ save_sound_as("test.snd",
+ :header_type, Mus_riff, :sample_type, Mus_l24int, :channel, 0)
end,
Mus_riff,
Mus_l24int,
srate(ind)],
[lambda do
- save_sound_as("test.snd", :header_type, Mus_aifc, :data_format, Mus_bfloat, :channel, 1, :srate, 12345)
+ save_sound_as("test.snd",
+ :header_type, Mus_aifc, :sample_type, Mus_bfloat, :channel, 1,
+ :srate, 12345)
end,
Mus_aifc,
Mus_bfloat,
@@ -3231,7 +3326,7 @@ def test_04_00
save_sound_as("test.snd", :channel, 1, :comment, "this is a test")
end,
header_type(ind),
- data_format(ind),
+ sample_type(ind),
srate(ind)]].each_with_index do |args, i|
prc, type, fmt, sr = args
prc.call
@@ -3239,16 +3334,17 @@ def test_04_00
info = format("save_sound_as :channel %d", i)
snd_test_neq(channels(snd), 1, "%s channels", info)
snd_test_neq(header_type(snd), type, "%s header_type", info)
- snd_test_neq(data_format(snd), fmt, "%s data_format", info)
+ snd_test_neq(sample_type(snd), fmt, "%s sample_type", info)
snd_test_neq(srate(snd), sr, "%s srate", info)
- snd_test_neq(frames(snd), frames(ind, 0), "%s frames", info)
+ snd_test_neq(framples(snd), framples(ind, 0), "%s framples", info)
snd_test_neq(maxamp(snd, 0), maxamp(ind, 0), "%s maxamp", info)
close_sound(snd)
end
close_sound(ind)
#
[["t15.aiff", [[132300, 0.148], [132300, 0.126]]],
- ["M1F1-float64C-AFsp.aif", [[8000, -0.024], [8000, 0.021]]]].each do |f, vals|
+ ["M1F1-float64C-AFsp.aif",
+ [[8000, -0.024], [8000, 0.021]]]].each do |f, vals|
with_file(f) do |fsnd|
ind = open_sound(fsnd)
chn = -1
@@ -3256,12 +3352,8 @@ def test_04_00
chn += 1
fneq(sample(val[0], ind, chn), val[1])
end
- snd_display("%s trouble[%s]: %s",
- fsnd,
- chn,
- vals.map_with_index do |val, i|
- sample(val[0], ind, i)
- end)
+ snd_display("%s trouble[%s]: %s", fsnd, chn,
+ vals.map_with_index do |val, i| sample(val[0], ind, i) end)
end
close_sound(ind)
end
@@ -3269,7 +3361,7 @@ def test_04_00
#
[["bad_chans.snd", [0, 22050, 0]],
["bad_srate.snd", [1, 0, 0]],
- ["bad_data_format.snd", [1, 22050, 4411]],
+ ["bad_sample_type.snd", [1, 22050, 4411]],
["bad_chans.aifc", [0, 22050, 0]],
["bad_srate.aifc", [1, 0, 0]],
["bad_length.aifc", [1, 22050, -10]],
@@ -3282,7 +3374,7 @@ def test_04_00
res = Snd.catch do
[mus_sound_chans(fsnd),
mus_sound_srate(fsnd),
- mus_sound_frames(fsnd)]
+ mus_sound_framples(fsnd)]
end.first
if res != vals and res != :mus_error
snd_display(snd_format_neq(res, vals, fsnd))
@@ -3321,40 +3413,6 @@ def test_04_00
close_sound(ind)
Snd.sounds.apply(:close_sound)
#
- ob = open_sound(oboe_snd)
- sd = vct2sound_data(channel2vct())
- mx = sound_data_maxamp(sd)
- snd_test_neq(sound_data_length(sd), 50828, "oboe->sd: len")
- snd_test_neq(sd[0, 1000], 0.0328369, "oboe->sd[1000]")
- snd_test_neq(mx.length, 1, "sound_data_maxamp oboe.snd len")
- snd_test_neq(maxamp(ob, 0), mx[0], "sound_data_maxamp oboe.snd")
- snd_test_neq(sound_data_peak(sd), mx[0], "sound_data_peak oboe.snd")
- if (res = Snd.catch do set_selected_channel(1) end).first != :no_such_channel
- snd_display("set_selected_channel bad chan: %s?", res)
- end
- if (res = Snd.catch do set_selected_channel(123456, 1) end).first != :no_such_sound
- snd_display("set_selected_channel bad snd: %s?", res)
- end
- [[2, 1000],
- [-1, 1000],
- [0, -1],
- [0, 10000000]].each do |chn, frm|
- if (res = Snd.catch do sd[chn, frm] end).first != :out_of_range
- snd_display("sound_data_ref bad chan or frame: %s %s %s?", chn, frm, res)
- end
- end
- [[2, 1000],
- [0, 10000000]].each do |chn, frm|
- if (res = Snd.catch do sd[chn, frm] = 1 end).first != :out_of_range
- snd_display("sound_data_set! bad chan or frame: %s %s %s?", chn, frm, res)
- end
- end
- v = make_vct(3)
- if (res = Snd.catch do vct2sound_data(v, sd, 2) end).first != :out_of_range
- snd_display("vct2sound_data set bad chan: %s?", res.inspect)
- end
- close_sound(ob)
- #
if selected_sound
snd_display("selected_sound %s %s?", selected_sound, sounds.inspect)
end
@@ -3370,122 +3428,6 @@ def test_04_00
end
def test_04_01
- fmv5_snd = "fmv5.snd"
- delete_file(fmv5_snd)
- fd = mus_sound_open_output(fmv5_snd, 22050, 1, Mus_bshort, Mus_aiff, "no comment")
- sdata = SoundData.new(1, 100)
- 100.times do |i| sdata[0, i] = i * 0.01 end
- snd_test_neq(sdata.to_s,
- "#<sound-data[chans=1, length=100]:
- (0.000 0.010 0.020 0.030 0.040 0.050 0.060 0.070 0.080 0.090 0.100 0.110 ...)>",
- "print sound_data")
- edat = sdata
- edat1 = SoundData.new(1, 100)
- edat2 = SoundData.new(2, 100)
- snd_test_neq(edat, sdata, "sound_data")
- snd_test_eq(edat1, sdata, "sound_data 1")
- snd_test_eq(edat1, edat2, "sound_data 2")
- 100.times do |i| edat1[0, i] = sdata[0, i] end
- snd_test_neq(edat1, sdata, "sound_data 3")
- v0 = make_vct(100)
- v1 = make_vct(3)
- sound_data2vct(sdata, 0, v0)
- snd_test_neq(v0[10], 0.1, "sound_data2vct")
- sound_data2vct(sdata, 0, v1)
- snd_test_neq(v1[1], 0.01, "sound_data2(small)vct")
- vct2sound_data(v0, sdata, 0)
- snd_test_neq(sound_data_ref(sdata, 0, 10), 0.1, "vct2sound_data")
- snd_test_neq(sdata[0, 10], 0.1, "vct2sound_data applied")
- if (res = Snd.catch do sound_data2vct(sdata, 2, v0) end).first != :out_of_range
- snd_display("sound_data2vct bad chan: %s?", res.inspect)
- end
- if (res = Snd.catch do mus_audio_write(1, make_sound_data(3, 3), 123) end).first != :out_of_range
- snd_display("mus_audio_write bad frames: %s?", res.inspect)
- end
- #
- v0 = make_vct(10)
- vx = make_vct(3)
- sdata2 = SoundData.new(2, 10)
- 10.times do |i|
- sdata2[0, i] = 0.1
- sdata2[1, i] = 0.2
- end
- sound_data2vct(sdata2, 0, v0)
- sound_data2vct(sdata2, 0, vx)
- snd_test_neq(v0[1], 0.1, "sound_data2vct[1]")
- sound_data2vct(sdata2, 1, v0)
- snd_test_neq(v0[1], 0.2, "sound_data2vct[2]")
- vct2sound_data(v0, sdata2, 0)
- snd_test_neq(sdata2[0, 1], 0.2, "vct2sound_data[2]")
- vct_fill!(v0, 0.3)
- vct2sound_data(v0, sdata2, 1)
- snd_test_neq(sdata2[1, 1], 0.3, "vct2sound_data[3]")
- vct2sound_data(vx, sdata2, 0)
- mus_sound_write(fd, 0, 99, 1, sdata)
- mus_sound_close_output(fd, 100 * mus_bytes_per_sample(Mus_bshort))
- fd = mus_sound_reopen_output(fmv5_snd, 1, Mus_bshort, Mus_aiff, mus_sound_data_location(fmv5_snd))
- mus_sound_close_output(fd, 100 * mus_bytes_per_sample(Mus_bshort))
- fd = mus_sound_open_input(fmv5_snd)
- mus_sound_read(fd, 0, 99, 1, sdata)
- snd_test_neq(sdata[0, 10], 0.1, "mus_sound_write")
- pos = mus_sound_seek_frame(fd, 20)
- # FIXME
- # IO.open(fd).pos doesn't work
- # snd_test_neq(IO.open(fd).pos, pos, "1 mus_sound_seek_frame")
- snd_test_neq(frame2byte(fmv5_snd, 20), pos, "2 mus_sound_seek_frame")
- mus_sound_read(fd, 0, 10, 1, sdata)
- snd_test_neq(sdata[0, 0], 0.2, "2 mus_sound_seek")
- mus_sound_close_input(fd)
- #
- sd = make_sound_data(2, 10)
- vct2sound_data(Vct.new(10, 0.25), sd, 0)
- vct2sound_data(Vct.new(10, 0.50), sd, 1)
- sound_data_scale!(sd, 2.0)
- snd_test_neq(sound_data2vct(sd, 0), Vct.new(10, 0.5), "sound_data_scale! chan 0")
- snd_test_neq(sound_data2vct(sd, 1), Vct.new(10, 1.0), "sound_data_scale! chan 1")
- sd = make_sound_data(2, 10)
- sound_data_fill!(sd, 2.0)
- snd_test_neq(sound_data2vct(sd, 0), Vct.new(10, 2.0), "sound_data_fill! chan 0")
- snd_test_neq(sound_data2vct(sd, 1), Vct.new(10, 2.0), "sound_data_fill! chan 1")
- #
- if (res = Snd.catch do
- mus_sound_open_output("fmv.snd", 22050, -1, Mus_bshort, Mus_aiff, "no comment")
- end).first != :out_of_range
- snd_display("mus_sound_open_output bad chans: %s?", res)
- end
- if (res = Snd.catch do
- mus_sound_open_output("fmv.snd", 22050, 1, -1, Mus_aiff, "no comment")
- end).first != :out_of_range
- snd_display("mus_sound_open_output bad format: %s?", res)
- end
- if (res = Snd.catch do
- mus_sound_open_output("fmv.snd", 22050, 1, Mus_bshort, -1, "no comment")
- end).first != :out_of_range
- snd_display("mus_sound_open_output bad type: %s?", res)
- end
- if (res = Snd.catch do
- mus_sound_reopen_output("fmv.snd", -1, Mus_bshort, Mus_aiff, false)
- end).first != :out_of_range
- snd_display("mus_sound_reopen_output bad chans: %s?", res)
- end
- if (res = Snd.catch do
- mus_sound_reopen_output("fmv.snd", 1, -1, Mus_aiff, false)
- end).first != :out_of_range
- snd_display("mus_sound_reopen_output bad format: %s?", res)
- end
- if (res = Snd.catch do
- mus_sound_reopen_output("fmv.snd", 1, Mus_bshort, -1, false)
- end).first != :out_of_range
- snd_display("mus_sound_reopen_output bad type: %s?", res)
- end
- #
- sd = SoundData.new(2, 10)
- sd.fill!(1.0)
- snd_test_neq(sound_data2vct(sd, 0), Vct.new(10, 1.0), "sd.fill! chan 0")
- snd_test_neq(sound_data2vct(sd, 1), Vct.new(10, 1.0), "sd.fill! chan 1")
- sd1 = sd.dup
- snd_test_neq(sd1, sd, "sd.dup (copy)")
- #
["trunc.snd",
"trunc.aiff",
"trunc.wav",
@@ -3500,232 +3442,37 @@ def test_04_01
snd_test_neq(res.first, :mus_error, "open_sound %s", file)
end
end
- $open_raw_sound_hook.add_hook!("snd-test-044") do |file, choice| [1, 22050, Mus_bshort] end
+ $open_raw_sound_hook.add_hook!("snd-test-044") do |file, choice|
+ [1, 22050, Mus_bshort]
+ end
with_file("empty.snd") do |fsnd|
ind = open_sound(fsnd)
- if data_format(ind) != Mus_bshort or
+ if sample_type(ind) != Mus_bshort or
channels(ind) != 1 or
srate(ind) != 22050 or
data_location(ind) != 0 or
- frames(ind) != 0
+ framples(ind) != 0
snd_display("open raw: %s %s %s %s %s?",
- data_format(ind),
+ sample_type(ind),
channels(ind),
srate(ind),
data_location(ind),
- frames(ind))
+ framples(ind))
end
close_sound(ind)
end
$open_raw_sound_hook.reset_hook!
- #
- sd1 = SoundData.new(1, 32)
- sd2 = SoundData.new(2, 64)
- 32.times do |i|
- sd1[0, i] = i * 0.01
- end
- 64.times do |i|
- sd2[0, i] = i * 0.1
- sd2[1, i] = i * 0.2
- end
- sound_data2sound_data(sd2, sd1, 3, 6, 32)
- [[0, 0.00],
- [2, 0.02],
- [3, 0.00],
- [6, 0.30],
- [10, 0.1]].each do |idx, val|
- snd_test_neq(sd1[0, idx], val, "sound_data2sound_data %d", idx)
- end
- sound_data2sound_data(sd1, sd2, 0, 10, 32)
- snd_test_neq(sd2[0, 5], 0.2, "sound_data2sound_data 2 5")
- #
- sdi = SoundData.new(1, 32)
- sdo = SoundData.new(1, 32)
- snd_test_neq(sound_data2sound_data(sdi, sdo, 10, 32, 10), 2, "sound_data2sound_data wrap around")
- snd_test_neq(sound_data2sound_data(sdi, sdo, 10, 32, 32), 10, "sound_data2sound_data wrap around")
- if (res = Snd.catch do
- sound_data2sound_data(sdi, sdo, -1, 10, 10)
- end).first != :out_of_range
- snd_display("sound_data2sound_data start: %s", res)
- end
- if (res = Snd.catch do
- sound_data2sound_data(sdi, sdo, 0, -1, 10)
- end).first != :out_of_range
- snd_display("sound_data2sound_data frames: %s", res)
- end
- if (res = Snd.catch do
- sound_data2sound_data(sdi, sdo, 0, 128, 10)
- end).first != :out_of_range
- snd_display("sound_data2sound_data frames: %s", res)
- end
- #
- sd = SoundData.new(1, 1)
- snd_test_neq(sd[0, 0], 0.0, "sound_data_ref")
- sd[0, 0] = 1.0
- snd_test_neq(sd[0, 0], 1.0, "sound_data_set")
- sd1 = make_sound_data(1, 1)
- sound_data_set!(sd1, 0, 0, 1.0)
- snd_test_neq(sd, sd1, "sound_data_set")
- #
- sd = SoundData.new(2, 3)
- snd_test_neq(sd[0, 0], 0.0, "sound_data_ref (1)")
- sd[1, 0] = 1.0
- snd_test_neq(sd[1, 0], 1.0, "sound_data_set (1 0)")
- sd[1, 2] = 2.0
- snd_test_neq(sd[1, 2], 2.0, "sound_data_set (1 2)")
- sd1 = make_sound_data(2, 3)
- sound_data_set!(sd1, 1, 0, 1.0)
- sound_data_set!(sd1, 1, 2, 2.0)
- snd_test_neq(sd, sd1, "sound_data_set (3)")
- #
-end
-
-def test_04_02
- [1, 2, 4, 8].each do |chans|
- [[Mus_bshort, Mus_next],
- [Mus_bfloat, Mus_aifc],
- [Mus_lshort, Mus_aifc],
- [Mus_lfloat, Mus_riff],
- [Mus_lshort, Mus_nist],
- [Mus_bint, Mus_aiff],
- [Mus_lint, Mus_next],
- [Mus_bintn, Mus_next],
- [Mus_lintn, Mus_next],
- [Mus_b24int, Mus_aifc],
- [Mus_l24int, Mus_riff],
- [Mus_bfloat, Mus_ircam],
- [Mus_bfloat_unscaled, Mus_next],
- [Mus_lfloat_unscaled, Mus_next],
- [Mus_bdouble_unscaled, Mus_next],
- [Mus_ldouble_unscaled, Mus_next],
- [Mus_bdouble, Mus_next],
- [Mus_ldouble, Mus_next],
- [Mus_ulshort, Mus_next],
- [Mus_ubshort, Mus_next]].each do |df, ht|
- samps = case chans
- when 1
- 100000
- when 2
- 50000
- else
- 1000
- end
- delete_file("fmv5.snd")
- fd = mus_sound_open_output("fmv5.snd", 22050, chans, df, ht, "no, comment")
- sdata = SoundData.new(chans, samps)
- ndata = SoundData.new(chans, samps)
- chans.times do |chn|
- samps.times do |i|
- # FIXME
- # This leads to v0 = 1.0 != v1 = -1.0 at some places:
- # sdata[chn, i] = random(2.0) - 1.0
- sdata[chn, i] = random(1.9999) - 1.0
- end
- end
- mus_sound_write(fd, 0, samps - 1, chans, sdata)
- mus_sound_close_output(fd, samps * chans * mus_bytes_per_sample(df))
- fd = mus_sound_open_input("fmv5.snd")
- mus_sound_read(fd, 0, samps - 1, chans, ndata)
- pos = mus_sound_seek_frame(fd, 100)
- # FIXME
- # IO.open(fd).pos doesn't work
- # snd_test_neq(IO.open(fd).pos,
- # pos,
- # "mus_sound_seek_frame(%d) chans %d, (%s %s)",
- # pos,
- # chans,
- # mus_header_type_name(ht),
- # mus_data_format_name(df))
- snd_test_neq(frame2byte("fmv5.snd", 100),
- pos,
- "mus_sound_seek_frame(100) chans %d, (%s %s)",
- chans,
- mus_header_type_name(ht),
- mus_data_format_name(df))
- mus_sound_close_input(fd)
- Snd.catch(:read_write_error, lambda do |*args|
- snd_display("read_write trouble: %s %s (%s != %s at [%s, %s])?",
- *args.first[2..-1])
- end) do
- chans.times do |chn|
- samps.times do |i|
- v0 = sdata[chn, i]
- v1 = ndata[chn, i]
- if fneq(v0, v1)
- Snd.throw(:read_write_error,
- mus_data_format_name(df), mus_header_type_name(ht), v0, v1, chn, i)
- end
- end
- end
- end
- end
- end
end
def test_04_03
- ind = open_sound("oboe.snd")
- our_short = little_endian? ? Mus_lshort : Mus_bshort
- our_srate = 22050
- our_dac_buffer_size_in_bytes = 512
- our_dac_buffer_size_in_shorts = 256
- our_chans = 1
- our_chan = 0
- in_sys = 0
- in_port = Snd.catch(:mus_error, -1) do
- mus_audio_open_input(0, our_srate, our_chans, our_short, our_dac_buffer_size_in_bytes)
- end.first
- data = make_sound_data(our_chans, our_dac_buffer_size_in_shorts)
- vobj = make_vct(our_dac_buffer_size_in_shorts)
- if in_port == -1
- snd_display("cannot open audio input port!")
- else
- 10.times do
- mus_audio_read(in_port, data, our_dac_buffer_size_in_shorts)
- graph(sound_data2vct(data, our_chan, vobj))
- end
- mus_audio_close(in_port)
- end
- close_sound(ind)
- #
- fmv = "fmv.snd"
- fd = mus_sound_open_output(fmv, 22050, 1, Mus_bshort, Mus_next, "no comment")
- sdata = SoundData.new(1, 10)
- sdata[0, 1] = 0.1
- mus_sound_write(fd, 0, 9, 1, sdata)
- mus_sound_close_output(fd, 20)
- fd = mus_sound_open_input(fmv)
- mus_sound_read(fd, 0, 9, 1, sdata)
- if fneq(sdata[0, 0], 0.0) or
- fneq(sdata[0, 1], 0.1) or
- fneq(sdata[0, 2], 0.0) or
- fneq(sdata[0, 6], 0.0)
- snd_display("read/write: %s?", sdata.to_a)
- end
- mus_sound_close_input(fd)
- fd = mus_sound_reopen_output(fmv, 1, Mus_bshort, Mus_next, mus_sound_data_location(fmv))
- mus_sound_seek_frame(fd, 0)
- sdata[0, 2] = 0.1
- sdata[0, 3] = 0.1
- mus_sound_write(fd, 0, 9, 1, sdata)
- mus_sound_close_output(fd, 20)
- fd = mus_sound_open_input(fmv)
- sdata1 = SoundData.new(1, 10)
- mus_sound_read(fd, 0, 9, 1, sdata1)
- if fneq(sdata1[0, 0], 0.0) or
- fneq(sdata1[0, 1], 0.1) or
- fneq(sdata1[0, 2], 0.1) or
- fneq(sdata1[0, 3], 0.1) or
- fneq(sdata1[0, 6], 0.0)
- snd_display(snd_format_neq(sdata1.to_a, sdata.to_a, "re-read/write"))
- end
- mus_sound_close_input(fd)
#
# check clipping choices
#
ind = view_sound("oboe.snd")
set_clipping(false)
- map_channel(lambda do |y| y * 10.0 end, 0, frames(), ind, 0)
- save_sound_as("test.snd", ind, Mus_next, Mus_bfloat)
+ scale_channel(10.0)
+ save_sound_as("test.snd", ind,
+ :header_type, Mus_next, :sample_type, Mus_bfloat)
undo_edit(1, ind, 0)
ind1 = open_sound("test.snd")
snd_test_neq(maxamp(ind1, 0), 10.0 * maxamp(ind, 0), "clipping 0")
@@ -3733,8 +3480,9 @@ def test_04_03
delete_file("test.snd")
#
set_clipping(true)
- map_channel(lambda do |y| y * 10.0 end, 0, frames(), ind, 0)
- save_sound_as("test.snd", ind, Mus_next, Mus_bfloat)
+ map_channel(lambda do |y| y * 10.0 end, 0, framples(), ind, 0)
+ save_sound_as("test.snd", ind,
+ :header_type, Mus_next, :sample_type, Mus_bfloat)
undo_edit(1, ind, 0)
ind1 = open_sound("test.snd")
snd_test_neq(maxamp(ind1, 0), 1.0, "clipping 1")
@@ -3743,17 +3491,19 @@ def test_04_03
#
set_clipping(false)
mx = maxamp(ind)
- map_channel(lambda do |y| y + (1.001 - mx) end, 0, frames(), ind, 0)
- save_sound_as("test.snd", ind, Mus_next, Mus_bshort)
+ map_channel(lambda do |y| y + (1.001 - mx) end, 0, framples(), ind, 0)
+ save_sound_as("test.snd", ind,
+ :header_type, Mus_next, :sample_type, Mus_bfloat)
ind1 = open_sound("test.snd")
- unless res = scan_channel(lambda do |y| y < 0.0 end)
+ if res = scan_channel(lambda do |y| y < 0.0 end)
snd_display("clipping 2: %s?", res)
end
close_sound(ind1)
delete_file("test.snd")
#
set_clipping(true)
- save_sound_as("test.snd", ind, Mus_next, Mus_bshort)
+ save_sound_as("test.snd", ind,
+ :header_type, Mus_next, :sample_type, Mus_bshort)
ind1 = open_sound("test.snd")
if res = scan_channel(lambda do |y| y < 0.0 end)
snd_display("clipping 3: %s?", res)
@@ -3763,10 +3513,9 @@ def test_04_03
#
set_clipping(false)
close_sound(ind)
- delete_file(fmv)
#
set_clipping(false)
- snd = new_sound("test.snd", :data_format, Mus_lshort)
+ snd = new_sound("test.snd", :sample_type, Mus_lshort)
pad_channel(0, 10)
set_sample(1, 1.0)
set_sample(2, -1.0)
@@ -3781,13 +3530,13 @@ def test_04_03
close_sound(snd)
snd = open_sound("test.snd")
snd_test_neq(channel2vct(0, 10),
- vct(0.0, 1.0, -1.0, 1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0),
+ vct(0.0, 1.0, -1.0, 1.0, 0.0, 0.0, -0.7, 0.7, -0.2, 0.2),
"unclipped 1")
close_sound(snd)
mus_sound_forget("test.snd")
#
set_clipping(true)
- snd = new_sound("test.snd", :data_format, Mus_lshort)
+ snd = new_sound("test.snd", :sample_type, Mus_lshort)
pad_channel(0, 10)
set_sample(1, 1.0)
set_sample(2, -1.0)
@@ -3806,113 +3555,6 @@ def test_04_03
"clipped")
close_sound(snd)
#
- data = vct(0.0, 1.0, -1.0, 0.9999, 2.0, -2.0, 1.3, -1.3, 1.8, -1.8)
- sdata = vct2sound_data(data)
- snd = mus_sound_open_output("test.snd", 22050, 1, Mus_lshort, Mus_riff, "a comment")
- set_mus_file_clipping(snd, false)
- mus_sound_write(snd, 0, 9, 1, sdata)
- mus_sound_close_output(snd, 40)
- snd = open_sound("test.snd")
- snd_test_neq(channel2vct(0, 10),
- vct(0.0, -1.0, -1.0, 1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0),
- "unclipped 2")
- close_sound(snd)
- mus_sound_forget("test.snd")
- #
- data = vct(0.0, 1.0, -1.0, 0.9999, 2.0, -2.0, 1.3, -1.3, 1.8, -1.8)
- sdata = vct2sound_data(data)
- snd = mus_sound_open_output("test.snd", 22050, 1, Mus_lshort, Mus_riff, "a comment")
- set_mus_file_clipping(snd, true)
- mus_sound_write(snd, 0, 9, 1, sdata)
- set_mus_file_clipping(snd, false)
- mus_sound_close_output(snd, 40)
- snd = open_sound("test.snd")
- snd_test_neq(channel2vct(0, 10),
- vct(0.0, 1.0, -1.0, 1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0),
- "clipped 1")
- close_sound(snd)
- #
- set_mus_clipping(false)
- data = vct(0.0, 1.0, -1.0, 0.9999, 2.0, -2.0, 1.3, -1.3, 1.8, -1.8)
- sdata = vct2sound_data(data)
- snd = mus_sound_open_output("test.snd", 22050, 1, Mus_lshort, Mus_riff, "a comment")
- mus_sound_write(snd, 0, 9, 1, sdata)
- mus_sound_close_output(snd, 40)
- snd = open_sound("test.snd")
- snd_test_neq(channel2vct(0, 10),
- vct(0.0, -1.0, -1.0, 1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0),
- "unclipped 3")
- close_sound(snd)
- mus_sound_forget("test.snd")
- #
- set_mus_clipping(true)
- data = vct(0.0, 1.0, -1.0, 0.9999, 2.0, -2.0, 1.3, -1.3, 1.8, -1.8)
- sdata = vct2sound_data(data)
- snd = mus_sound_open_output("test.snd", 22050, 1, Mus_lshort, Mus_riff, "a comment")
- mus_sound_write(snd, 0, 9, 1, sdata)
- mus_sound_close_output(snd, 40)
- snd = open_sound("test.snd")
- snd_test_neq(channel2vct(0, 10),
- vct(0.0, 1.0, -1.0, 1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0),
- "clipped 2")
- close_sound(snd)
- #
- set_mus_clipping(true)
- data = vct(0.0, 1.0, -1.0, 0.9999, 2.0, -2.0, 1.3, -1.3, 1.8, -1.8)
- sdata = vct2sound_data(data)
- snd = mus_sound_open_output("test.snd", 22050, 1, Mus_lshort, Mus_riff, "a comment")
- if (res = Snd.catch do mus_sound_write(snd, 0, 10, 1, sdata) end).first != :out_of_range
- snd_display("mus_sound_write too many bytes: %s", res.inspect)
- end
- if (res = Snd.catch do mus_sound_read(snd, 0, 10, 1, sdata) end).first != :out_of_range
- snd_display("mus_sound_read too many bytes: %s", res.inspect)
- end
- mus_sound_close_output(snd, 0)
- delete_file("test.snd")
- mus_sound_forget("test.snd")
- set_mus_clipping(false) # default
- set_clipping(false)
- #
- com = "this is a comment which we'll repeat enough times to trigger an internal loop" * 3
- fd = mus_sound_open_output(fmv, 22050, 4, Mus_lshort, Mus_riff, com)
- sdata = SoundData.new(4, 10)
- 4.times do |i| sdata[i, 1] = 0.1 end
- mus_sound_write(fd, 0, 9, 4, sdata)
- mus_sound_close_output(fd, 80)
- fd = mus_sound_open_input(fmv)
- mus_sound_read(fd, 0, 9, 4, sdata)
- 4.times do |i|
- if fneq(sdata[i, 0], 0.0) or
- fneq(sdata[i, 1], 0.1) or
- fneq(sdata[i, 2], 0.0) or
- fneq(sdata[i, 6], 0.0)
- snd_display("1 read/write[%d]: %s?", i, sdata.to_vct(i).to_a)
- end
- end
- mus_sound_close_input(fd)
- fd = mus_sound_reopen_output(fmv, 4, Mus_lshort, Mus_riff, mus_sound_data_location(fmv))
- mus_sound_seek_frame(fd, 0)
- 4.times do |i|
- sdata[i, 2] = 0.1
- sdata[i, 3] = 0.1
- end
- mus_sound_write(fd, 0, 9, 4, sdata)
- mus_sound_close_output(fd, 80)
- fd = mus_sound_open_input(fmv)
- sdata1 = SoundData.new(4, 10)
- mus_sound_read(fd, 0, 9, 4, sdata1)
- 4.times do |i|
- if fneq(sdata1[i, 0], 0.0) or
- fneq(sdata1[i, 1], 0.1) or
- fneq(sdata1[i, 2], 0.1) or
- fneq(sdata1[i, 3], 0.1) or
- fneq(sdata1[i, 6], 0.0)
- snd_display(snd_format_neq(sdata1.to_vct(i).to_a, sdata.to_vct(i).to_a,
- "2 re-read/write[%d]", i))
- end
- end
- mus_sound_close_input(fd)
- #
with_file("32bit.sf") do |fsnd|
ind = open_sound(fsnd)
snd_test_neq(maxamp(ind, 0), 0.228, "32bit max")
@@ -3958,10 +3600,6 @@ def test_04_03
vct(0.021, 0.018, 0.014, 0.009, 0.004, -0.001, -0.004, -0.006, -0.007, -0.008)],
["wood.sds", 1000, 10,
vct(-0.160, -0.216, -0.254, -0.239, -0.175, -0.102, -0.042, 0.005, 0.041, 0.059)],
- ["oboe.g721", 1000, 10,
- vct(-0.037, -0.040, -0.040, -0.041, -0.042, -0.038, -0.028, -0.015, -0.005, 0.002)],
- ["oboe.g723_40", 1000, 10,
- vct(-0.037, -0.040, -0.041, -0.041, -0.041, -0.038, -0.028, -0.015, -0.005, 0.003)],
["mus10.snd", 10000, 10,
vct(0.004, 0.001, 0.005, 0.009, 0.017, 0.015, 0.008, 0.011, 0.009, 0.012)],
["ieee-text-16.snd", 1000, 10,
@@ -3993,12 +3631,10 @@ def test_04_04
"no phase method",
"null gen arg to method",
"no length method",
- "no free method",
"no describe method",
"no data method",
"no scaler method",
"memory allocation failed",
- "unstable two pole error",
"can't open file",
"no sample input",
"no sample output",
@@ -4007,9 +3643,9 @@ def test_04_04
"no location method",
"no channel method",
"no such fft window",
- "unsupported data format",
+ "unknown sample type",
"header read failed",
- "unsupported header type",
+ "unknown header type",
"file descriptors not initialized",
"not a sound file",
"file closed",
@@ -4020,7 +3656,7 @@ def test_04_04
"bad envelope",
"audio channels not available",
"audio srate not available",
- "audio format not available",
+ "audio sample type not available",
"no audio input available",
"audio configuration not available",
"audio write error",
@@ -4034,7 +3670,6 @@ def test_04_04
"no audio read permission",
"can't close file",
"arg out of range",
- "wrong type arg",
"no channels method",
"no hop method",
"no width method",
@@ -4051,68 +3686,85 @@ def test_04_04
"bad size",
"can't convert",
"read error",
- "no safety method",
+ "no feedforward method",
+ "no feedback method",
+ "no interp-type method",
+ "no position method",
+ "no order method",
+ "no copy method",
"can't translate"].each_with_index do |err, i|
snd_test_neq(err, mus_error_type2string(i), "mus_error_type2string %d", i)
end
oboe_snd = "oboe.snd"
cur_srate = mus_sound_srate(oboe_snd)
cur_chans = mus_sound_chans(oboe_snd)
- cur_format = mus_sound_data_format(oboe_snd)
+ cur_format = mus_sound_sample_type(oboe_snd)
cur_type = mus_sound_header_type(oboe_snd)
cur_loc = mus_sound_data_location(oboe_snd)
cur_samps = mus_sound_samples(oboe_snd)
set_mus_sound_srate(oboe_snd, cur_srate * 2)
- snd_test_neq(mus_sound_srate(oboe_snd), cur_srate * 2, "set_mus_sound_srate")
+ snd_test_neq(mus_sound_srate(oboe_snd), cur_srate * 2,
+ "set_mus_sound_srate")
set_mus_sound_samples(oboe_snd, cur_samps * 2)
- snd_test_neq(mus_sound_samples(oboe_snd), cur_samps * 2, "set_mus_sound_samples")
+ snd_test_neq(mus_sound_samples(oboe_snd), cur_samps * 2,
+ "set_mus_sound_samples")
set_mus_sound_chans(oboe_snd, cur_chans * 2)
- snd_test_neq(mus_sound_chans(oboe_snd), cur_chans * 2, "set_mus_sound_chans")
+ snd_test_neq(mus_sound_chans(oboe_snd), cur_chans * 2,
+ "set_mus_sound_chans")
set_mus_sound_data_location(oboe_snd, cur_loc * 2)
- snd_test_neq(mus_sound_data_location(oboe_snd), cur_loc * 2, "set_mus_sound_data_location")
+ snd_test_neq(mus_sound_data_location(oboe_snd), cur_loc * 2,
+ "set_mus_sound_data_location")
set_mus_sound_header_type(oboe_snd, Mus_nist)
- snd_test_neq(mus_sound_header_type(oboe_snd), Mus_nist, "set_mus_sound_header_type")
- set_mus_sound_data_format(oboe_snd, Mus_lintn)
- snd_test_neq(mus_sound_data_format(oboe_snd), Mus_lintn, "set_mus_sound_data_format")
+ snd_test_neq(mus_sound_header_type(oboe_snd), Mus_nist,
+ "set_mus_sound_header_type")
+ set_mus_sound_sample_type(oboe_snd, Mus_lintn)
+ snd_test_neq(mus_sound_sample_type(oboe_snd), Mus_lintn,
+ "set_mus_sound_sample_type")
set_mus_sound_srate(oboe_snd, cur_srate)
set_mus_sound_samples(oboe_snd, cur_samps)
set_mus_sound_chans(oboe_snd, cur_chans)
set_mus_sound_data_location(oboe_snd, cur_loc)
set_mus_sound_header_type(oboe_snd, cur_type)
- set_mus_sound_data_format(oboe_snd, cur_format)
+ set_mus_sound_sample_type(oboe_snd, cur_format)
#
ind = open_sound("oboe.snd")
- save_sound_as("test.wave", ind, Mus_riff)
- save_sound_as("test.rf64", ind, Mus_rf64)
- save_sound_as("test.aifc", ind, Mus_aifc)
+ save_sound_as("test.wave", ind, :header_type, Mus_riff)
+ save_sound_as("test.rf64", ind, :header_type, Mus_rf64)
+ save_sound_as("test.aifc", ind, :header_type, Mus_aifc)
close_sound(ind)
["test.wave",
"test.rf64",
"test.aifc"].each do |file|
cur_srate = mus_sound_srate(file)
cur_chans = mus_sound_chans(file)
- cur_format = mus_sound_data_format(file)
+ cur_format = mus_sound_sample_type(file)
cur_type = mus_sound_header_type(file)
cur_loc = mus_sound_data_location(file)
cur_samps = mus_sound_samples(file)
set_mus_sound_srate(file, cur_srate * 2)
- snd_test_neq(mus_sound_srate(file), cur_srate * 2, "%s set_mus_sound_srate", file)
+ snd_test_neq(mus_sound_srate(file), cur_srate * 2,
+ "%s set_mus_sound_srate", file)
set_mus_sound_samples(file, cur_samps * 2)
- snd_test_neq(mus_sound_samples(file), cur_samps * 2, "%s set_mus_sound_samples", file)
+ snd_test_neq(mus_sound_samples(file), cur_samps * 2,
+ "%s set_mus_sound_samples", file)
set_mus_sound_chans(file, cur_chans * 2)
- snd_test_neq(mus_sound_chans(file), cur_chans * 2, "%s set_mus_sound_chans", file)
+ snd_test_neq(mus_sound_chans(file), cur_chans * 2,
+ "%s set_mus_sound_chans", file)
set_mus_sound_data_location(file, cur_loc * 2)
- snd_test_neq(mus_sound_data_location(file), cur_loc * 2, "%s set_mus_sound_data_location", file)
+ snd_test_neq(mus_sound_data_location(file), cur_loc * 2,
+ "%s set_mus_sound_data_location", file)
set_mus_sound_header_type(file, Mus_nist)
- snd_test_neq(mus_sound_header_type(file), Mus_nist, "%s set_mus_sound_header_type", file)
- set_mus_sound_data_format(file, Mus_lintn)
- snd_test_neq(mus_sound_data_format(file), Mus_lintn, "%s set_mus_sound_data_format", file)
+ snd_test_neq(mus_sound_header_type(file), Mus_nist,
+ "%s set_mus_sound_header_type", file)
+ set_mus_sound_sample_type(file, Mus_lintn)
+ snd_test_neq(mus_sound_sample_type(file), Mus_lintn,
+ "%s set_mus_sound_sample_type", file)
set_mus_sound_srate(file, cur_srate)
set_mus_sound_samples(file, cur_samps)
set_mus_sound_chans(file, cur_chans)
set_mus_sound_data_location(file, cur_loc)
set_mus_sound_header_type(file, cur_type)
- set_mus_sound_data_format(file, cur_format)
+ set_mus_sound_sample_type(file, cur_format)
end
["test.wave",
"test.rf64",
@@ -4120,14 +3772,14 @@ def test_04_04
ind = open_sound(file)
cur_srate = srate(ind)
cur_chans = chans(ind)
- cur_format = data_format(ind)
+ cur_format = sample_type(ind)
cur_type = header_type(ind)
cur_loc = data_location(ind)
- cur_samps = frames(ind)
+ cur_samps = framples(ind)
set_srate(ind, cur_srate * 2)
snd_test_neq(srate(ind), cur_srate * 2, "%s set_srate", file)
- set_frames(cur_samps * 2, ind)
- snd_test_neq(frames(ind), cur_samps * 2, "%s set_frames", file)
+ set_framples(cur_samps * 2, ind)
+ snd_test_neq(framples(ind), cur_samps * 2, "%s set_framples", file)
set_chans(ind, cur_chans * 2) # this can change the index
xind = find_sound(file)
if ind != xind
@@ -4138,21 +3790,20 @@ def test_04_04
snd_test_neq(data_location(ind), cur_loc * 2, "%s set_location", file)
set_header_type(ind, Mus_nist)
snd_test_neq(header_type(ind), Mus_nist, "%s set_header_type", file)
- set_data_format(ind, Mus_lintn)
- snd_test_neq(data_format(ind), Mus_lintn, "%s set_data_format", file)
+ set_sample_type(ind, Mus_lintn)
+ snd_test_neq(sample_type(ind), Mus_lintn, "%s set_sample_type", file)
set_srate(ind, cur_srate)
- set_frames(cur_samps, ind)
+ set_framples(cur_samps, ind)
set_channels(ind, cur_chans)
set_data_location(ind, cur_loc)
set_header_type(ind, cur_type)
- set_data_format(ind, cur_format)
+ set_sample_type(ind, cur_format)
close_sound(ind)
delete_file(file)
- end
+ end unless $with_test_motif
end
-# FIXME
-# with big file
+# XXX: with big file
#
# with_sound(:output, $bigger_snd, :srate, 44100, :play, false) do
# 72000.times do |i|
@@ -4160,22 +3811,23 @@ end
# end
# end
-$big_file_frames = 0
+$big_file_framples = 0
def test_04_05
- if File.exists?($bigger_snd)
+ if File.exist?($bigger_snd)
# ; silence as last .9 secs, so it probably wasn't written
- probable_frames = (44100 * 71999.1).floor
+ probable_framples = (44100 * 71999.1).floor
snd_test_neq(mus_sound_samples($bigger_snd), 3175160310, "bigger samples")
- snd_test_neq(mus_sound_frames($bigger_snd), 3175160310, "bigger frames")
- snd_test_neq(mus_sound_frames($bigger_snd), probable_frames, "bigger frames (probable)")
+ snd_test_neq(mus_sound_framples($bigger_snd), 3175160310, "bigger framples")
+ snd_test_neq(mus_sound_framples($bigger_snd), probable_framples,
+ "bigger framples (probable)")
snd_test_neq(mus_sound_length($bigger_snd), 6350320648, "bigger length")
snd_test_neq(mus_sound_duration($bigger_snd), 71999.1015, "bigger dur")
ind = open_sound($bigger_snd)
- snd_test_neq(frames(ind), 3175160310, "bigger frames")
- $big_file_frames = frames(ind)
- snd_test_neq(frames(ind), probable_frames, "bigger frames (probable)")
- snd_test_neq(frames(ind, 0, 0), $big_file_frames, "bigger edpos-frames")
+ snd_test_neq(framples(ind), 3175160310, "bigger framples")
+ $big_file_framples = framples(ind)
+ snd_test_neq(framples(ind), probable_framples, "bigger framples (probable)")
+ snd_test_neq(framples(ind, 0, 0), $big_file_framples, "bigger edpos-framples")
m1 = add_mark(44100 * 50000, ind)
snd_test_neq(mark_sample(m1), 44100 * 50000, "bigger mark at")
set_mark_sample(m1, 44100 * 66000)
@@ -4195,12 +3847,12 @@ def test_04_05
old_select = selection_creates_region
set_selection_creates_region(false)
select_all(ind)
- snd_test_neq(selection_frames(), frames(ind), "bigger select all")
+ snd_test_neq(selection_framples(), framples(ind), "bigger select all")
set_selection_position(44100 * 50000)
snd_test_neq(selection_position(), 44100 * 50000, "bigger select pos")
set_selection_position(0)
- set_selection_frames(44100 * 65000)
- snd_test_neq(selection_frames(), 44100 * 65000, "bigger select len")
+ set_selection_framples(44100 * 65000)
+ snd_test_neq(selection_framples(), 44100 * 65000, "bigger select len")
set_selection_creates_region(old_select)
set_cursor(44100 * 50000, ind)
snd_test_neq(cursor(ind), 44100 * 50000, "bigger cursor")
@@ -4218,11 +3870,11 @@ def test_04_05
end
def test_04_06
- ind = new_sound("tmp.snd", Mus_riff, Mus_l24int, 22050, 1, :size, 100000)
+ ind = new_sound("tmp.snd", 1, 22050, Mus_l24int, Mus_riff, :size, 100000)
old_selection_creates_region = selection_creates_region()
set_selection_creates_region(true)
x = -0.5
- incr = 1.0 / frames()
+ incr = 1.0 / framples()
map_channel(lambda do |n|
val = x
x += incr
@@ -4234,10 +3886,12 @@ def test_04_06
reg = select_all
[[:Mus_next, :Mus_l24int],
[:Mus_aifc, :Mus_l24int]].each do |ht, df|
- save_selection("tmp1.snd", Module.const_get(ht), Module.const_get(df))
+ save_selection("tmp1.snd", 44100,
+ Module.const_get(df),
+ Module.const_get(ht))
ind1 = open_sound("tmp1.snd")
x = -0.5
- incr = 1.0 / frames()
+ incr = 1.0 / framples()
err = scan_channel(lambda do |n|
val = x
x += incr
@@ -4248,10 +3902,10 @@ def test_04_06
end
close_sound(ind1)
end
- save_region(reg, "tmp1.snd", Mus_next, Mus_l24int)
+ save_region(reg, "tmp1.snd", Mus_l24int, Mus_next)
ind1 = open_sound("tmp1.snd")
x = -0.5
- incr = 1.0 / frames()
+ incr = 1.0 / framples()
err = scan_channel(lambda do |n|
val = x
x += incr
@@ -4266,12 +3920,14 @@ def test_04_06
delete_file("tmp.snd")
set_selection_creates_region(old_selection_creates_region)
#
- ind = new_sound("tmp.snd", Mus_next, Mus_bfloat, 22050, 1, :size, 10, :comment, false)
+ ind = new_sound("tmp.snd", 1, 22050, Mus_bfloat, Mus_next,
+ :size, 10, :comment, false)
map_channel($init_channel)
env_channel([0.0, 0.0, 0.1, 0.1, 0.2, 0.2, 0.3, 0.3, 0.4, 0.4,
0.5, 0.5, 0.6, 0.6, 0.7, 0.7, 0.8, 0.8, 0.9, 0.9])
snd_test_neq(channel2vct(),
- vct(0.000, 0.100, 0.200, 0.300, 0.400, 0.500, 0.600, 0.700, 0.800, 0.900),
+ vct(0.000, 0.100, 0.200, 0.300, 0.400,
+ 0.500, 0.600, 0.700, 0.800, 0.900),
"ramp env by 0.1")
close_sound(ind)
end
@@ -4361,7 +4017,7 @@ def test_04_07
mus_sound_forget("test.snd")
end
-def make_aifc_file(frames, auth_lo, bits)
+def make_aifc_file(framples, auth_lo, bits)
File.open("test.aif", "w") do |fp|
fp.write "FORM"
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0146); # len
@@ -4371,7 +4027,7 @@ def make_aifc_file(frames, auth_lo, bits)
fp.write "COMM"
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0046); # COMM chunk size
fp.putc(0000); fp.putc(0001); # 1 chan
- fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(frames); # frames
+ fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(framples); # framples
fp.putc(0000); fp.putc(bits); # bits
fp.putc(0100); fp.putc(0016); fp.putc(0254); fp.putc(0104); fp.putc(0000);
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000);
@@ -4399,7 +4055,7 @@ def read_ascii(in_filename,
out_format = Mus_bshort,
out_srate = 44100)
in_buffer = IO.readlines(in_filename) # array of strings
- out_snd = new_sound(out_filename, out_type, out_format, out_srate, 1,
+ out_snd = new_sound(out_filename, 1, out_srate, out_format, out_type,
format("created by %s: %s", get_func_name, in_filename))
bufsize = 512
data = make_vct(bufsize)
@@ -4437,7 +4093,7 @@ def test_04_08
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000); # comment
fp.putc(0000); fp.putc(0001); # samp 1
end
- snd_test_neq(mus_sound_data_format("test.snd"), Mus_bshort, "next 18")
+ snd_test_neq(mus_sound_sample_type("test.snd"), Mus_bshort, "next 18")
delete_file("test.snd")
mus_sound_forget("test.snd")
File.open("test.snd", "w") do |fp|
@@ -4469,7 +4125,7 @@ def test_04_08
end
res = Snd.catch do open_sound("test.snd") end.first
if number?(res) and sound?(res)
- snd_display("open_sound next bad format %s: %s?", data_format(res), res)
+ snd_display("open_sound next bad format %s: %s?", sample_type(res), res)
close_sound(res)
end
delete_file("test.snd")
@@ -4482,7 +4138,7 @@ def test_04_08
make_aifc_file(0102, 004, 020)
Snd.catch do
ind = open_sound("test.aif")
- snd_test_neq(frames(ind), 2, "bad frames in header")
+ snd_test_neq(framples(ind), 2, "bad framples in header")
close_sound(ind)
end
delete_file("test.aif")
@@ -4490,7 +4146,8 @@ def test_04_08
make_aifc_file(002, 150, 020)
res = Snd.catch do open_sound("test.aif") end.first
if number?(res) and sound?(res)
- snd_display("open_sound aifc no ssnd chunk %s: %s?", data_location(res), res)
+ snd_display("open_sound aifc no ssnd chunk %s: %s?",
+ data_location(res), res)
close_sound(res)
end
delete_file("test.aif")
@@ -4506,7 +4163,7 @@ def test_04_08
make_aifc_file(002, 150, 120)
res = Snd.catch do open_sound("test.aif") end.first
if number?(res) and sound?(res)
- snd_display("open_sound aifc bits 80 %s: %s?", data_format(res), res)
+ snd_display("open_sound aifc bits 80 %s: %s?", sample_type(res), res)
close_sound(res)
end
delete_file("test.aif")
@@ -4520,7 +4177,7 @@ def test_04_08
fp.write "COMM"
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0046); # COMM chunk size
fp.putc(0000); fp.putc(0001); # 1 chan
- fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0002); # frames
+ fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0002); # framples
fp.putc(0000); fp.putc(0020); # bits
fp.putc(0100); fp.putc(0016); fp.putc(0254); fp.putc(0104); fp.putc(0000);
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000);
@@ -4550,7 +4207,8 @@ def test_04_08
fp.putc(0000); fp.putc(0101); fp.putc(0000); fp.putc(0100); # two samples
end
Snd.catch do
- snd_test_neq(mus_sound_comment("test.aif").length, 15, "aifc 3 aux comments")
+ snd_test_neq(mus_sound_comment("test.aif").length, 15,
+ "aifc 3 aux comments")
end
delete_file("test.aif")
mus_sound_forget("test.aif")
@@ -4566,7 +4224,7 @@ def test_04_08
fp.write "COMM"
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0046); # COMM chunk size
fp.putc(0000); fp.putc(0001); # 1 chan
- fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0002); # frames
+ fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0002); # framples
fp.putc(0000); fp.putc(0020); # bits
fp.putc(0100); fp.putc(0016); fp.putc(0254); fp.putc(0104); fp.putc(0000);
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000);
@@ -4583,9 +4241,10 @@ def test_04_08
fp.putc(0000);
end
Snd.catch do
- snd_test_neq(mus_sound_comment("test.aif")[0..2], "bil", "aifc trailing comt comments")
+ snd_test_neq(mus_sound_comment("test.aif")[0..2], "bil",
+ "aifc trailing comt comments")
end
- snd_test_neq(mus_sound_frames("test.aif"), 2, "aifc trailing comt frames")
+ snd_test_neq(mus_sound_framples("test.aif"), 2, "aifc trailing comt framples")
Snd.catch do
ind = open_sound("test.aif")
if fneq(sample(0), 0.00198) or
@@ -4611,7 +4270,7 @@ def test_04_08
fp.write "COMM"
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0046); # COMM chunk size
fp.putc(0000); fp.putc(0001); # 1 chan
- fp.putc(0000); fp.putc(0000); fp.putc(0100); fp.putc(0102); # frames
+ fp.putc(0000); fp.putc(0000); fp.putc(0100); fp.putc(0102); # framples
fp.putc(0000); fp.putc(0020); # bits
fp.putc(0100); fp.putc(0016); fp.putc(0254); fp.putc(0104); fp.putc(0000);
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000);
@@ -4627,8 +4286,10 @@ def test_04_08
fp.write "bil"
fp.putc(0000);
end
- snd_test_neq(mus_sound_comment("test.aif")[0..2], "bil", "aifc trailing comt comment")
- snd_test_neq(mus_sound_frames("test.aif"), 2, "aifc trailing comt (bogus) frames")
+ snd_test_neq(mus_sound_comment("test.aif")[0..2], "bil",
+ "aifc trailing comt comment")
+ snd_test_neq(mus_sound_framples("test.aif"), 2,
+ "aifc trailing comt (bogus) framples")
Snd.catch do
ind = open_sound("test.aif")
if fneq(sample(0), 0.00198) or
@@ -4654,7 +4315,7 @@ def test_04_08
fp.write "COMM"
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0046); # COMM chunk size
fp.putc(0000); fp.putc(0001); # 1 chan
- fp.putc(0000); fp.putc(0000); fp.putc(0100); fp.putc(0102); # frames
+ fp.putc(0000); fp.putc(0000); fp.putc(0100); fp.putc(0102); # framples
fp.putc(0000); fp.putc(0020); # bits
fp.putc(0100); fp.putc(0016); fp.putc(0254); fp.putc(0104); fp.putc(0000);
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000);
@@ -4670,7 +4331,8 @@ def test_04_08
end
res = Snd.catch do open_sound("test.aif") end.first
if number?(res) and sound?(res)
- snd_display("open_sound aifc 2 ssnd chunks %s: %s?", data_location(res), res)
+ snd_display("open_sound aifc 2 ssnd chunks %s: %s?",
+ data_location(res), res)
close_sound(res)
end
delete_file("test.aif")
@@ -4705,7 +4367,7 @@ def test_04_08
fp.write "COMM"
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0046); # COMM chunk size
fp.putc(0000); fp.putc(0001); # 1 chan
- fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0002); # frames
+ fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0002); # framples
fp.putc(0000); fp.putc(0020); # bits
fp.putc(0100); fp.putc(0016); fp.putc(0254); fp.putc(0104); fp.putc(0000);
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000);
@@ -4739,7 +4401,7 @@ def test_04_08
snd_test_neq(gen.call(2), 0.00000, "file2sample chunked eof")
snd_test_neq(gen.call(3), 0.00000, "file2sample chunked eof+1")
res = open_sound("test.aif")
- snd_test_neq(frames(res), 2, "chunked frames")
+ snd_test_neq(framples(res), 2, "chunked framples")
snd_test_neq(sample(0), 0.93948, "file chunked 0")
snd_test_neq(sample(1), 0.50195, "file chunked 1")
snd_test_neq(sample(2), 0.00000, "file chunked eof")
@@ -4747,7 +4409,7 @@ def test_04_08
close_sound(res)
end
Snd.catch do
- snd_test_neq(mus_sound_frames("test.aif"), 2, "chunked mus_sound_frames")
+ snd_test_neq(mus_sound_framples("test.aif"), 2, "chunked mus_sound_framples")
end
delete_file("test.aif")
mus_sound_forget("test.aif")
@@ -4767,7 +4429,7 @@ def test_04_08
fp.write "COMM"
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0046); # COMM chunk size
fp.putc(0000); fp.putc(0001); # 1 chan
- fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0002); # frames
+ fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0002); # framples
fp.putc(0000); fp.putc(0020); # bits
fp.putc(0100); fp.putc(0016); fp.putc(0254); fp.putc(0104); fp.putc(0000);
fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(0000);
@@ -4777,7 +4439,7 @@ def test_04_08
fp.write "not compressed"
fp.putc(0000);
fp.write "APPL"
- fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(?h);
+ fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(key_to_int(?h));
fp.write "CLM ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98"
fp.putc(0000);
end
@@ -4788,7 +4450,7 @@ def test_04_08
snd_test_neq(gen.call(2), 0.00000, "file2sample chunked eof")
snd_test_neq(gen.call(3), 0.00000, "file2sample chunked eof+1")
res = open_sound("test.aif")
- snd_test_neq(frames(res), 2, "chunked frames")
+ snd_test_neq(framples(res), 2, "chunked framples")
snd_test_neq(sample(0), 0.93948, "file chunked 0")
snd_test_neq(sample(1), 0.50195, "file chunked 1")
snd_test_neq(sample(2), 0.00000, "file chunked eof")
@@ -4826,7 +4488,7 @@ def test_04_08
fp.write "not compressed"
fp.putc(0000);
fp.write "APPL"
- fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(?h);
+ fp.putc(0000); fp.putc(0000); fp.putc(0000); fp.putc(key_to_int(?h));
fp.write "CLM ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98"
fp.putc(0000);
end
@@ -4837,7 +4499,7 @@ def test_04_08
snd_test_neq(gen.call(1, 0), 0.00000, "file2sample chunked eof (stereo)")
snd_test_neq(gen.call(1, 1), 0.00000, "file2sample chunked eof+1 (stereo)")
res = open_sound("test.aif")
- snd_test_neq(frames(res), 1, "chunked frames (1)")
+ snd_test_neq(framples(res), 1, "chunked framples (1)")
snd_test_neq(sample(0, res, 0), 0.93948, "file chunked 0 0")
snd_test_neq(sample(0, res, 1), 0.50195, "file chunked 0 1")
snd_test_neq(sample(1, res, 0), 0.00000, "file chunked eof (stereo)")
@@ -4855,7 +4517,8 @@ def test_04_08
snd_display("no sound files in %s?", Dir.pwd)
end
files1 = sound_files_in_directory()
- snd_test_neq(files1, files, "different sound files in %s and default?", Dir.pwd)
+ snd_test_neq(files1, files,
+ "different sound files in %s and default?", Dir.pwd)
files2 = sound_files_in_directory(".")
if files1 != files2 or files != files2
snd_display("sound_files_in_directory dot: %s but %s?:", files2, files)
@@ -4865,13 +4528,13 @@ def test_04_08
Snd.sounds.apply(:close_sound)
#
ind = new_sound(:size, 0)
- snd_test_neq(frames(ind), 0, "new_sound :size 0")
+ snd_test_neq(framples(ind), 0, "new_sound :size 0")
snd_test_neq(sample(0), 0.0, "new_sound :size 0 sample 0")
new_file_name = file_name(ind)
close_sound(ind)
delete_file(new_file_name)
ind = new_sound(:size, 1)
- snd_test_neq(frames(ind), 1, "new_sound :size 1")
+ snd_test_neq(framples(ind), 1, "new_sound :size 1")
snd_test_neq(sample(0), 0.0, "new_sound :size 1 sample 0")
new_file_name = file_name(ind)
close_sound(ind)
@@ -4886,10 +4549,10 @@ def test_04_08
snd_display("read_ascii cannot find %s (%s)?", file, ind.inspect)
end
snd_test_neq(maxamp(ind, 0), 0.723, "read_ascii maxamp")
- snd_test_neq(frames(ind, 0), 50000, "read_ascii frames")
+ snd_test_neq(framples(ind, 0), 50000, "read_ascii framples")
snd_test_neq(srate(ind), 44100, "read_ascii srate")
set_srate(ind, 8000)
- snd_test_neq(frames(ind, 0), 50000, "set srate clobbered new sound frames")
+ snd_test_neq(framples(ind, 0), 50000, "set srate clobbered new sound framples")
snd_test_neq(maxamp(ind, 0), 0.723, "set srate clobbered new sound maxamp")
close_sound(ind)
end
@@ -4899,7 +4562,8 @@ def test_04_08
close_sound(ind)
ind = open_sound("test space.snd")
snd_test_neq(short_file_name(ind), "test space.snd", "file name with space")
- snd_test_neq(mus_sound_frames("test space.snd"), frames(ind), "spaced filename frames")
+ snd_test_neq(mus_sound_framples("test space.snd"), framples(ind),
+ "spaced filename framples")
add_mark(1234, ind, 0)
save_marks(ind)
close_sound(ind)
@@ -4909,13 +4573,10 @@ def test_04_08
snd_display("space file name save marks: %s", marks(ind).inspect)
end
rd = make_readin(:file, "test space.snd")
- snd_test_neq(mus_file_name(rd), "test space.snd", "file name with space readin")
+ snd_test_neq(mus_file_name(rd), "test space.snd",
+ "file name with space readin")
close_sound(ind)
delete_files("test space.snd", "test space.marks")
- #
- # FIXME
- # S7 specific tests skipped
- #
end
def test_04
@@ -4927,7 +4588,6 @@ def test_04
clear_listener()
test_04_00
test_04_01
- test_04_02
test_04_03
test_04_04
test_04_05 if $with_big_file
@@ -4940,49 +4600,24 @@ end
# ---------------- test 05: simple overall checks ----------------
def test_edpos(ind1, func_sym, func_body = nil, &change_thunk)
- if proc?(func_body)
- fr1 = func_body.call(ind1, 0, false)
- fr2 = func_body.call(ind1, 0, 0)
- fr3 = func_body.call(ind1, 0, Current_edit_position)
- fr4 = func_body.call(ind1, 0, lambda do |snd, chn| 0 end)
- unless fr1 == fr2 and fr1 == fr3 and fr1 == fr4
- snd_display_prev_caller("initial %s: %s %s %s %s?", func_sym, fr1, fr2, fr3, fr4)
- end
- change_thunk.call
- fr5 = func_body.call(ind1, 0, false)
- fr6 = func_body.call(ind1, 0, 1)
- fr7 = func_body.call(ind1, 0, Current_edit_position)
- fr8 = func_body.call(ind1, 0, lambda do |snd, chn| edit_position(snd, chn) end)
- unless fr5 == fr6 and fr5 == fr7 and fr5 == fr8
- snd_display_prev_caller("%s (edpos 1): %s %s %s %s?", func_sym, fr5, fr6, fr7, fr8)
- end
- fr5 = func_body.call(ind1, 0, 0)
- fr6 = func_body.call(ind1, 0, lambda do |snd, chn| 0 end)
- unless fr1 == fr5 and fr1 == fr6
- snd_display_prev_caller("%s (edpos -1): %s %s %s?", func_sym, fr1, fr5, fr6)
- end
- else
- fr1 = snd_func(func_sym, ind1, 0, false)
- fr2 = snd_func(func_sym, ind1, 0, 0)
- fr3 = snd_func(func_sym, ind1, 0, Current_edit_position)
- fr4 = snd_func(func_sym, ind1, 0, lambda do |snd, chn| 0 end)
- unless fr1 == fr2 and fr1 == fr3 and fr1 == fr4
- snd_display_prev_caller("initial %s: %s %s %s %s?", func_sym, fr1, fr2, fr3, fr4)
- end
- change_thunk.call
- fr5 = snd_func(func_sym, ind1, 0, false)
- fr6 = snd_func(func_sym, ind1, 0, 1)
- fr7 = snd_func(func_sym, ind1, 0, Current_edit_position)
- fr8 = snd_func(func_sym, ind1, 0, lambda do |snd, chn| edit_position(snd, chn) end)
- unless fr5 == fr6 and fr5 == fr7 and fr5 == fr8
- snd_display_prev_caller("%s (edpos 1): %s %s %s %s?", func_sym, fr5, fr6, fr7, fr8)
- end
- fr5 = snd_func(func_sym, ind1, 0, 0)
- fr6 = snd_func(func_sym, ind1, 0, lambda do |snd, chn| 0 end)
- unless fr1 == fr5 and fr1 == fr6
- snd_display_prev_caller("%s (edpos -1): %s %s %s?", func_sym, fr1, fr5, fr6)
+ unless func_body
+ func_body = lambda do |snd, chn, val|
+ snd_func(func_sym, snd, chn, val)
end
end
+ fr1 = func_body.call(ind1, 0, false)
+ fr2 = func_body.call(ind1, 0, 0)
+ fr3 = func_body.call(ind1, 0, Current_edit_position)
+ if fr1 != fr2 or fr1 != fr3
+ snd_display_prev_caller("initial %s: %s %s %s?", func_sym, fr1, fr2, fr3)
+ end
+ change_thunk.call
+ fr5 = func_body.call(ind1, 0, false)
+ fr6 = func_body.call(ind1, 0, 1)
+ fr7 = func_body.call(ind1, 0, Current_edit_position)
+ if fr5 != fr6 or fr5 != fr7
+ snd_display_prev_caller("%s (edpos 1): %s %s %s?", func_sym, fr5, fr6, fr7)
+ end
revert_sound(ind1)
end
@@ -4991,18 +4626,14 @@ def test_edpos_1(func_sym, ind1, &body)
body.call(ind1, 0)
v1 = channel2vct(12000, 10, ind1, 0)
if vequal(v0, v1)
- snd_display_prev_caller(snd_format(v1, v0, "==", "%s (0) no change!", func_sym))
+ s = snd_format(v1, v0, "==", "%s (0) no change!", func_sym)
+ snd_display_prev_caller(s)
end
body.call(ind1, 0)
v2 = channel2vct(12000, 10, ind1, 0)
unless vequal(v1, v2)
snd_display_prev_caller(snd_format(v2, v1, "!=", "%s (1)", func_sym))
end
- body.call(ind1, lambda do |snd, chn| 0 end)
- v2 = channel2vct(12000, 10, ind1, 0)
- unless vequal(v1, v2)
- snd_display_prev_caller(snd_format(v2, v1, "!=", "%s (2)", func_sym))
- end
revert_sound(ind1)
end
@@ -5010,12 +4641,13 @@ def test_orig(func0, func1, name, ind1)
v0 = channel2vct(12000, 10, ind1, 0)
func0.call(ind1)
v1 = channel2vct(12000, 10, ind1, 0)
- if vfequal(v0, v1) # okay
- snd_display_prev_caller(snd_format(v1, v0, "==", "%s (orig 0) no change!", name))
+ if vfequal(v0, v1)
+ snd_display_prev_caller(snd_format(v1, v0, "==",
+ "%s (orig 0) no change!", name))
end
func1.call(ind1)
v2 = channel2vct(12000, 10, ind1, 0)
- unless vfequal(v0, v2) # okay
+ unless vfequal(v0, v2)
snd_display_prev_caller(snd_format(v2, v0, "!=", "%s (orig 1)", name))
end
revert_sound(ind1)
@@ -5034,30 +4666,27 @@ end
def check_maxamp(ind, val, name)
if fneq(maxamp(ind, 0), val)
- snd_display_prev_caller("maxamp amp_env %s: %s should be %s", name, maxamp(ind), val)
+ snd_display_prev_caller("maxamp amp_env %s: %s should be %s",
+ name, maxamp(ind), val)
end
- unless pos = find_channel(lambda do |y| y.abs >= (val - 0.0001) end)
+ pos = find_channel(lambda do |y| y.abs >= (val - 0.0001) end)
+ unless pos
snd_display_prev_caller("actual maxamp %s vals not right", name)
end
maxpos = maxamp_position(ind, 0)
if maxpos != pos
- snd_display_prev_caller("%s: find and maxamp_position disagree: %s (%s) %s (%s)?",
- name, pos, sample(pos, ind, 0), maxpos, sample(maxpos, ind, 0))
+ snd_display_prev_caller("%s: \
+find and maxamp_position disagree: %s (%s) %s (%s)?",
+ name, pos, sample(pos, ind, 0), maxpos, sample(maxpos, ind, 0))
end
- mx = 0.0
- ctr = 0
- mpos = 0
- scan_chan(lambda do |y|
- if fneq(y.abs, mx) and y.abs > mx
- mpos = ctr
- mx = y.abs
- end
- ctr += 1
- false
- end)
+ reader = make_sampler(0, ind, 0)
+ data = Vct.new(framples(ind, 0)) do |i|
+ next_sample(reader)
+ end
+ mx, mpos = vct_peak_and_location(data)
if mpos != maxpos
- snd_display_prev_caller("%s: scan_chan and maxamp_position disagree: %s %s?",
- name, mpos, maxpos)
+ snd_display_prev_caller("%s: scan and maxamp_position disagree: %s %s?",
+ name, mpos, maxpos)
end
if fneq(mx, val)
snd_display_prev_caller("actual %s max: %s (correct: %s)", name, mx, val)
@@ -5065,23 +4694,22 @@ def check_maxamp(ind, val, name)
end
def check_env_vals(name, gen)
- ctr = -1
- scan_chan(lambda do |y|
- ctr += 1
- if fneq(val = env(gen), y)
- snd_display_prev_caller(snd_format_neq(val, y,
- "%s %s at %d",
- get_func_name, name, ctr))
- true
- else
- false
- end
- end)
+ reader = make_sampler()
+ framples().times do |i|
+ val = env(gen)
+ y = next_sample(reader)
+ if fneq(val, y)
+ snd_display_prev_caller(snd_format_neq(val, y,
+ "%s %s at %d", get_func_name, name, i))
+ return
+ end
+ end
end
def our_x2position(ind, x)
ax = axis_info(ind, 0)
- [ax[10].to_f + ((x - ax[2]) * (ax[12].to_f - ax[10])) / (ax[4] - ax[2]), x2position(x, ind)]
+ [ax[10].to_f + ((x - ax[2]) * (ax[12].to_f - ax[10])) / (ax[4] - ax[2]),
+ x2position(x, ind)]
end
def region2vct_1(reg, chn, len)
@@ -5747,7 +5375,7 @@ def test_05_02
(at 10, end_mark)
")
ctr = 0
- if res = scan_chan(lambda do |y|
+ if res = scan_channel(lambda do |y|
if fneq(y, 0.5 * vals[ctr])
true
else
@@ -5765,7 +5393,7 @@ def test_05_02
(at 9, end_mark)
")
ctr = 1
- if res = scan_chan(lambda do |y|
+ if res = scan_channel(lambda do |y|
if fneq(y, vals[ctr])
true
else
@@ -5783,7 +5411,7 @@ def test_05_02
(at 8, end_mark)
")
ctr = 2
- if res = scan_chan(lambda do |y|
+ if res = scan_channel(lambda do |y|
if fneq(y, vals[ctr])
true
else
@@ -5827,7 +5455,7 @@ def test_05_02
(at 10, end_mark)
")
ctr = 0
- if res = scan_chan(lambda do |y|
+ if res = scan_channel(lambda do |y|
if (ctr > 5 and fneq(y, vals[ctr])) or
(ctr < 4 and fneq(y, vals[ctr])) or
((ctr == 4 or ctr == 5) and fneq(y, 0.5 * vals[ctr]))
@@ -6965,8 +6593,10 @@ def test_05_08
check1.call(data)
func2.call
check2.call(data)
- snd_test_neq(channel2vct, data, "3 case %s (%s (%s))", name2, name1, name)
- snd_test_neq(rev_channel2vct.call, data, "3 rev case %s (%s (%s))", name2, name1, name)
+ snd_test_neq(channel2vct, data, "3 case %s (%s (%s))",
+ name2, name1, name)
+ snd_test_neq(rev_channel2vct.call, data, "3 rev case %s (%s (%s))",
+ name2, name1, name)
end
end
end
@@ -7214,9 +6844,9 @@ def test_05_10
xz = x_zoom_slider
yz = y_zoom_slider
snd_test_neq(snd_completion(" open-so"), " open-sound", "completion (1)")
- # FIXME
- # Zoom_focus_right (constant) replaced by zoom_focus_style
- snd_test_neq(snd_completion(" zoom_focus_s"), " zoom_focus_style", "completion (2)")
+ # XXX: Zoom_focus_right (constant) replaced with zoom_focus_style
+ snd_test_neq(snd_completion(" zoom_focus_s"), " zoom_focus_style",
+ "completion (2)")
play("oboe.snd", :wait, true)
play("oboe.snd", :start, 12000, :wait, true)
play("oboe.snd", :start, 12000, :end, 15000, :wait, true)
@@ -7234,54 +6864,54 @@ def test_05_10
set_speed_control(old_speed, ind)
set_speed_control_style(old_style)
set_show_controls(old_open, ind)
- bomb(ind, true)
k = disk_kspace("oboe.snd")
if (not number?(k)) or k <= 0
snd_display("disk_kspace = %s", k)
end
k = disk_kspace("/baddy/hiho")
- # FIXME
- # #if !USE_STATFS in snd-file.c
- # disk_kspace returns 1234567
- if k != 1234567 and k != -1
- snd_display("disk_kspace of bogus file = %s", k)
- end
- snd_test_neq(transform_frames, 0, "transform_frames")
+ snd_test_neq(k, -1, "disk_kspace of bogus file")
+ snd_test_neq(transform_framples, 0, "transform_framples")
set_transform_size(512)
set_transform_graph?(true)
- unless (res = fft_peak(ind, 0, 1.0))
- snd_display("fft_peak %s?", res.inspect)
- end
set_time_graph?(true)
#
- Snd.catch(:all, lambda do |*args| snd_display("axis label error: %s", args) end) do
+ Snd.catch(:all, lambda do |*args|
+ snd_display("axis label error: %s", args)
+ end) do
snd_test_neq(x_axis_label(), "time", "def time x_axis_label")
set_x_axis_label("no time", ind, 0, Time_graph)
snd_test_neq(x_axis_label(), "no time", "set time x_axis_label")
update_transform_graph
- snd_test_neq(x_axis_label(ind, 0, Transform_graph), "frequency", "get fft x_axis_label")
+ snd_test_neq(x_axis_label(ind, 0, Transform_graph), "frequency",
+ "get fft x_axis_label")
set_x_axis_label("hiho", ind, 0, Transform_graph)
update_transform_graph
- snd_test_neq(x_axis_label(ind, 0, Transform_graph), "hiho", "set fft x_axis_label")
+ snd_test_neq(x_axis_label(ind, 0, Transform_graph), "hiho",
+ "set fft x_axis_label")
set_x_axis_label("frequency", ind, 0, Transform_graph) # for later test
#
graph([0, 0, 1, 1, 2, 0], "lisp")
update_lisp_graph
- snd_test_neq(x_axis_label(ind, 0, Lisp_graph), "lisp", "def lisp x_axis_label")
+ snd_test_neq(x_axis_label(ind, 0, Lisp_graph), "lisp",
+ "def lisp x_axis_label")
set_x_axis_label("no lisp", ind, 0, Lisp_graph)
- snd_test_neq(x_axis_label(ind, 0, Lisp_graph), "no lisp", "lisp x_axis_label")
+ snd_test_neq(x_axis_label(ind, 0, Lisp_graph), "no lisp",
+ "lisp x_axis_label")
#
set_y_axis_label("no amp", ind, 0, Time_graph)
snd_test_neq(y_axis_label(), "no amp", "time y_axis_label")
set_y_axis_label("no lamp", ind, 0, Lisp_graph)
- snd_test_neq(y_axis_label(ind, 0, Lisp_graph), "no lamp", "lisp y_axis_label")
+ snd_test_neq(y_axis_label(ind, 0, Lisp_graph), "no lamp",
+ "lisp y_axis_label")
set_y_axis_label(false)
set_y_axis_label("no amp", ind, 0)
snd_test_neq(y_axis_label(), "no amp", "time y_axis_label")
set_y_axis_label(false, ind)
end
- #
- graph_data(make_vct(4))
+ #
+ cr = make_cairo(channel_widgets(ind, 0)[0])
+ graph_data(make_vct(4), ind, 0, Copy_context, false, false, Graph_lines, cr)
+ free_cairo(cr)
update_lisp_graph
graph(vct(0, 0, 1, 1, 2, 0))
32.times do
@@ -7298,28 +6928,34 @@ def test_05_10
left_sample,
right_sample)
mid = (0.5 * data.length).round
- snd_test_neq(sample(left_sample + mid), data[mid], "make_graph_data[%d]", mid)
+ snd_test_neq(sample(left_sample + mid), data[mid],
+ "make_graph_data[%d]", mid)
end
data = make_graph_data(ind, 0, 0, 100, 199)
if vct?(data)
snd_test_neq(data.length, 100, "make_graph_data 100:199")
- snd_test_neq(sample(50), data[50], "make_graph_data")
+ snd_test_neq(sample(50), data[50], "make_graph_data 50")
end
set_x_bounds([0.0, 0.1])
update_transform_graph
- Snd.catch(:no_such_axis, lambda do |*args| snd_display("transform axis not displayed?") end) do
- snd_test_neq(x_axis_label(ind, 0, Transform_graph), "frequency", "def fft x_axis_label")
+ Snd.catch(:no_such_axis, lambda do |*args|
+ snd_display("transform axis not displayed?")
+ end) do
+ snd_test_neq(x_axis_label(ind, 0, Transform_graph), "frequency",
+ "def fft x_axis_label")
set_x_axis_label("fourier", ind, 0, Transform_graph)
- snd_test_neq(x_axis_label(ind, 0, Transform_graph), "fourier", "fft x_axis_label")
+ snd_test_neq(x_axis_label(ind, 0, Transform_graph), "fourier",
+ "fft x_axis_label")
set_x_axis_label("hiho")
#
set_y_axis_label("spectra", ind, 0, Transform_graph)
- snd_test_neq(y_axis_label(ind, 0, Transform_graph), "spectra", "fft y_axis_label")
+ snd_test_neq(y_axis_label(ind, 0, Transform_graph), "spectra",
+ "fft y_axis_label")
set_y_axis_label("hiho")
end
#
- if number?(transform_frames) and transform_frames.zero?
- snd_display("transform_graph? transform-frames: %s?", trandform_frames)
+ if number?(transform_framples) and transform_framples.zero?
+ snd_display("transform_graph? transform-framples: %s?", trandform_framples)
end
update_transform_graph
if (tag = Snd.catch do peaks("/baddy/hiho") end).first != :cant_open_file
@@ -7335,8 +6971,10 @@ def test_05_10
end
delete_file("tmp.peaks")
peaks()
- if $with_test_motif and (!dialog_widgets[20] or !RXtIsManaged(dialog_widgets[20]))
- snd_display("peaks but no help?")
+ if $with_test_motif
+ if (not dialog_widgets[15]) or (not RXtIsManaged(dialog_widgets[15]))
+ snd_display("peaks but no help?")
+ end
end
dismiss_all_dialogs
num_transforms = 6
@@ -7381,19 +7019,22 @@ def test_05_10
delete_file(psf)
set_graph_style(i)
graph2ps
- unless File.exists?(psf)
+ unless File.exist?(psf)
snd_display("graph2ps: %s?", psf)
end
delete_file(psf)
end
end
set_graph_style(old_gstyle)
- if (err = Snd.catch(:cannot_print, 12345) do graph2ps("/bad/bad.eps") end).first != 12345
+ err = Snd.catch(:cannot_print, 12345) do graph2ps("/bad/bad.eps") end
+ if err.first != 12345
snd_display("graph2ps err: %s?", err.inspect)
end
n2 = open_sound("2.snd") or open_sound("4.aiff")
set_transform_graph?(true, n2)
- [Channels_superimposed, Channels_combined, Channels_separate].each do |style|
+ [Channels_superimposed,
+ Channels_combined,
+ Channels_separate].each do |style|
set_channel_style(style, n2)
snd_test_neq(channel_style(n2), style, "channel_style")
graph2ps("aaa.eps")
@@ -7427,19 +7068,21 @@ def test_05_10
[[:sound?, true],
[:chans, 1],
[:channels, 1],
- [:frames, 50828],
+ [:framples, 50828],
[:srate, 22050],
[:data_location, 28],
[:data_size, 50828 * 2],
- [:data_format, Mus_bshort],
+ [:sample_type, Mus_bshort],
[:maxamp, 0.14724],
[:maxamp_position, 24971],
[:comment, ""]].each do |func, val|
snd_test_neq(snd_func(func, ind), val, "oboe")
end
snd_test_neq(short_file_name(ind), "oboe.snd", "oboe: short name")
- snd_test_neq(count_matches(lambda do |y| y > 0.125 end), 1314, "oboe: count_matches")
- snd_test_neq(count_matches(lambda do |y| y > 0.1 end), 2852, "oboe: unopt count_matches")
+ snd_test_neq(count_matches(lambda do |y| y > 0.125 end), 1314,
+ "oboe: count_matches")
+ snd_test_neq(count_matches(lambda do |y| y > 0.1 end), 2852,
+ "oboe: unopt count_matches")
spot = find_channel(lambda do |y| y > 0.13 end)
if spot.kind_of?(FalseClass) or spot != 8862
snd_display("find: %s?", spot)
@@ -7460,7 +7103,6 @@ def test_05_10
snd_display("edit_position: %s %s?", edit_position, eds)
end
play(ind, :channel, 0, :wait, true)
- bomb(ind, false)
select_all(ind, 0)
r0 = regions.first
unless selection?
@@ -7472,11 +7114,13 @@ def test_05_10
snd_test_neq(selection_chans, 1, "selection_chans (1)")
snd_test_neq(selection_srate, srate(ind), "selection_srate")
snd_test_neq(region_maxamp(r0), maxamp(ind), "region_maxamp (1)")
- snd_test_neq(region_maxamp_position(r0), maxamp_position(ind), "region_maxamp_position (1)")
+ snd_test_neq(region_maxamp_position(r0), maxamp_position(ind),
+ "region_maxamp_position (1)")
snd_test_neq(selection_maxamp(ind, 0), maxamp(ind), "selection_maxamp (1)")
- snd_test_neq(selection_maxamp_position(ind, 0), maxamp_position(ind), "selection_maxamp_position (1)")
+ snd_test_neq(selection_maxamp_position(ind, 0), maxamp_position(ind),
+ "selection_maxamp_position (1)")
save_region(r0, "temp.dat")
- if File.exists?("temp.dat")
+ if File.exist?("temp.dat")
File.unlink("temp.dat")
else
snd_display("save_region file disappeared?")
@@ -7490,18 +7134,18 @@ def test_05_10
end
[[:region_srate, 22050],
[:region_chans, 1],
- [:region_frames, 50828],
+ [:region_framples, 50828],
[:region_home, ["oboe.snd", 0, 50827]]].each do |func, req|
snd_test_neq(snd_func(func, r0), req, "%s", func)
end
- snd_test_neq(selection_frames, 50828, "selection_frames")
+ snd_test_neq(selection_framples, 50828, "selection_framples")
snd_test_neq(selection_position, 0, "selection_position")
snd_test_neq(region_position(r0, 0), 0, "region_position")
snd_test_neq(region_maxamp(r0), maxamp(ind), "region_maxamp (2)")
snd_test_neq(selection_maxamp(ind, 0), maxamp(ind), "selection_maxamp (2)")
[[:region_srate, 22050],
[:region_chans, 1],
- [:region_frames, 50828],
+ [:region_framples, 50828],
[:region_maxamp, maxamp(ind)]].each do |func, req|
snd_test_neq(snd_func(func, r0), req, "%s", func)
end
@@ -7530,7 +7174,8 @@ def test_05_10
50827.times do |i|
val = (i % 2).nonzero? ? next_sample(rd) : read_sample(rd)
if val != samps1[i] or val != samps2[i]
- snd_display("readers disagree at %s (%s %s %s)", i, val, samps1[i], samps2[i])
+ snd_display("readers disagree at %s (%s %s %s)",
+ i, val, samps1[i], samps2[i])
break
end
end
@@ -7568,7 +7213,8 @@ def test_05_10
end
revert_sound(ind)
insert_sample(100, 0.5, ind)
- if (res = Snd.catch do insert_sound("oboe.snd", 0, 1) end).first != :no_such_channel
+ res = Snd.catch do insert_sound("oboe.snd", 0, 1) end
+ if res.first != :no_such_channel
snd_display("insert_sound bad chan (1): %s", res.inspect)
end
if (res = Snd.catch do insert_sample(-12, 1.0) end).first != :no_such_sample
@@ -7578,22 +7224,23 @@ def test_05_10
update_transform_graph(ind)
update_time_graph(ind)
snd_test_neq(sample(100), 0.5, "insert_sample (100)")
- snd_test_neq(frames(ind), 50829, "insert_sample (frames)")
+ snd_test_neq(framples(ind), 50829, "insert_sample (framples)")
v0 = Array.new(3, 0.25)
v1 = make_vct(3, 0.75)
insert_samples(200, 3, v0, ind)
insert_samples(300, 3, v1, ind)
snd_test_neq(sample(201), 0.25, "insert_samples (201)")
snd_test_neq(sample(301), 0.75, "insert_samples (301)")
- snd_test_neq(frames(ind), 50835, "insert_samples (frames)")
- save_sound_as("hiho.snd", ind, Mus_next, Mus_bshort, :srate, 22050)
+ snd_test_neq(framples(ind), 50835, "insert_samples (framples)")
+ save_sound_as("hiho.snd", ind, 22050, Mus_bshort, Mus_next)
nind = view_sound("hiho.snd")
snd_test_neq(sample(101, nind), sample(101, ind), "save_sound_as")
unless read_only(nind)
snd_display("read_only view_sound: %s?", read_only(nind))
end
set_speed_control_style(Speed_control_as_semitone, nind)
- snd_test_neq(speed_control_style(nind), Speed_control_as_semitone, "speed_control_style set semi")
+ snd_test_neq(speed_control_style(nind), Speed_control_as_semitone,
+ "speed_control_style set semi")
set_speed_control_tones(-8, nind)
snd_test_neq(speed_control_tones(nind), 12, "speed_control_tones -8")
set_speed_control_tones(18, nind)
@@ -7608,17 +7255,19 @@ def test_05_10
snd_test_neq(sample(60), 0.25, "set_samples (60)")
snd_test_neq(sample(61), 0.25, "set_samples (61)")
set_samples(10, 3, [0.1, 0.2, 0.3], ind)
- snd_test_neq(channel2vct(10, 3, ind), vct(0.1, 0.2, 0.3), "set_samples via list")
+ snd_test_neq(channel2vct(10, 3, ind), vct(0.1, 0.2, 0.3),
+ "set_samples via list")
revert_sound(ind)
save_sound_as("temporary.snd", ind)
set_samples(100000, 20000, "temporary.snd", ind)
- snd_test_neq(channel2vct(110000, 10), channel2vct(10000, 10), "set_samples to self")
+ snd_test_neq(channel2vct(110000, 10), channel2vct(10000, 10),
+ "set_samples to self")
revert_sound(ind)
delete_file("temporary.snd")
delete_sample(100, ind)
- snd_test_neq(frames(ind), 50827, "delete_sample")
+ snd_test_neq(framples(ind), 50827, "delete_sample")
delete_samples(0, 100, ind)
- snd_test_neq(frames(ind), 50727, "delete_samples")
+ snd_test_neq(framples(ind), 50727, "delete_samples")
revert_sound(ind)
maxa = maxamp(ind)
scale_to(0.5, ind)
@@ -7671,8 +7320,8 @@ def test_05_10
revert_sound(ind)
s100 = sample(100)
s40 = sample(40)
- len = frames
- addlen = mus_sound_frames("fyow.snd")
+ len = framples
+ addlen = mus_sound_framples("fyow.snd")
old_csize = cursor_size
old_cstyle = cursor_style
set_cursor_style(Cursor_line)
@@ -7688,16 +7337,20 @@ def test_05_10
set_cursor(20, ind, 0)
if $with_test_gui
set_cursor_style(lambda do |snd, chn, ax|
- x, y = cursor_position
- size = (cursor_size / 2.0).round
- draw_line(x - size, y - size, x + size, y + size, snd, chn, Cursor_context)
- draw_line(x - size, y + size, x + size, y - size, snd, chn, Cursor_context)
- end,
- ind, 0)
+ x, y = cursor_position
+ size = (cursor_size / 2.0).round
+ cr = make_cairo(channel_widgets(snd, chn)[0])
+ draw_line(x - size, y - size, x + size, y + size,
+ snd, chn, Cursor_context, cr)
+ draw_line(x - size, y + size, x + size, y - size,
+ snd, chn, Cursor_context, cr)
+ free_cairo(cr)
+ end, ind, 0)
unless proc?(res = cursor_style(ind, 0))
snd_display("set_cursor_style to Proc: %s", res)
end
end
+
set_cursor_size(old_csize)
set_cursor_style(old_cstyle)
set_cursor(50, ind)
@@ -7706,16 +7359,17 @@ def test_05_10
snd_test_neq(sample(40), s40, "insert_sound s40")
snd_test_eq(ss100, s100, "insert_sound s100")
snd_test_neq(ss100, 0.001831, "insert_sound")
- snd_test_neq(frames, addlen + len, "insert_sound len")
+ snd_test_neq(framples, addlen + len, "insert_sound len")
save_sound_as("not-temporary.snd")
insert_samples(0, 100, "not-temporary.snd")
- set_cursor(frames(ind, 0, 0) - 2, ind, 0, 0)
+ set_cursor(framples(ind, 0, 0) - 2, ind, 0, 0)
revert_sound
- snd_test_neq(cursor(ind, 0), frames(ind, 0, 0) - 2, "set edpos cursor %s", cursor)
+ snd_test_neq(cursor(ind, 0), framples(ind, 0, 0) - 2,
+ "set edpos cursor %s", cursor)
delete_file("not-temporary.snd")
id = make_region(0, 99)
insert_region(id, 60, ind)
- snd_test_neq(frames, len + 100, "insert_region len")
+ snd_test_neq(framples, len + 100, "insert_region len")
snd_test_neq(sample(100), s40, "insert_region")
if (res = Snd.catch do
regmax = if regions
@@ -7730,76 +7384,83 @@ def test_05_10
save_region(id, "fmv.snd")
region_srate(id)
region_chans(id)
- region_frames(id)
+ region_framples(id)
[[:mus_sound_header_type, Mus_next],
- [:mus_sound_data_format, Mus_out_format],
+ [:mus_sound_sample_type, Mus_out_format],
[:mus_sound_srate, region_srate(id)],
[:mus_sound_chans, region_chans(id)],
- [:mus_sound_frames, region_frames(id)]].each do |func, req|
+ [:mus_sound_framples, region_framples(id)]].each do |func, req|
snd_test_neq(snd_func(func, "fmv.snd"), req, "save_region (1) %s", func)
end
if region_position(id, 0).nonzero?
snd_display("save_region position: %s", region_position(id, 0))
end
delete_file("fmv.snd")
- save_region(id, "fmv.snd", Mus_riff, Mus_lshort, "this is a comment")
+ save_region(id, "fmv.snd", Mus_lshort, Mus_riff, "this is a comment")
[[:mus_sound_header_type, Mus_riff],
- [:mus_sound_data_format, Mus_lshort],
+ [:mus_sound_sample_type, Mus_lshort],
[:mus_sound_comment, "this is a comment"],
- [:mus_sound_frames, region_frames(id)]].each do |func, req|
+ [:mus_sound_framples, region_framples(id)]].each do |func, req|
snd_test_neq(snd_func(func, "fmv.snd"), req, "save_region (2) %s", func)
end
delete_file("fmv.snd")
save_region(id,
:file, "fmv.snd",
:header_type, Mus_riff,
- :data_format, Mus_lshort,
+ :sample_type, Mus_lshort,
:comment, "this is a comment")
[[:mus_sound_header_type, Mus_riff],
- [:mus_sound_data_format, Mus_lshort],
+ [:mus_sound_sample_type, Mus_lshort],
[:mus_sound_comment, "this is a comment"],
- [:mus_sound_frames, region_frames(id)]].each do |func, req|
- snd_test_neq(snd_func(func, "fmv.snd"), req, "save_region opt (3) %s", func)
+ [:mus_sound_framples, region_framples(id)]].each do |func, req|
+ snd_test_neq(snd_func(func, "fmv.snd"), req,
+ "save_region opt (3) %s", func)
end
delete_file("fmv.snd")
save_region(id,
:comment, "this is a comment",
:file, "fmv.snd",
- :data_format, Mus_lshort,
+ :sample_type, Mus_lshort,
:header_type, Mus_riff)
[[:mus_sound_header_type, Mus_riff],
- [:mus_sound_data_format, Mus_lshort],
+ [:mus_sound_sample_type, Mus_lshort],
[:mus_sound_comment, "this is a comment"],
- [:mus_sound_frames, region_frames(id)]].each do |func, req|
- snd_test_neq(snd_func(func, "fmv.snd"), req, "save_region opt1 (4) %s", func)
+ [:mus_sound_framples, region_framples(id)]].each do |func, req|
+ snd_test_neq(snd_func(func, "fmv.snd"), req,
+ "save_region opt1 (4) %s", func)
end
delete_file("fmv.snd")
- save_region(id, "fmv.snd", :data_format, Mus_bshort)
+ save_region(id, "fmv.snd", :sample_type, Mus_bshort)
[[:mus_sound_header_type, Mus_next],
- [:mus_sound_data_format, Mus_bshort],
- [:mus_sound_frames, region_frames(id)]].each do |func, req|
- snd_test_neq(snd_func(func, "fmv.snd"), req, "save_region opt2 (5) %s", func)
+ [:mus_sound_sample_type, Mus_bshort],
+ [:mus_sound_framples, region_framples(id)]].each do |func, req|
+ snd_test_neq(snd_func(func, "fmv.snd"), req,
+ "save_region opt2 (5) %s", func)
end
delete_files("fmv.snd", "aaa.eps")
close_sound(ind)
end
def test_05_11
- if (res = Snd.catch do new_sound("hi.snd", 0, 1, 100, 0) end).first != :out_of_range
+ res = Snd.catch do new_sound("hi.snd", :channels, 0) end
+ if res.first != :out_of_range
snd_display("new_sound bad chan: %s?", res)
end
#
- ind = new_sound("fmv.snd", Mus_next, Mus_bshort, 22050, 2, "unequal lens")
+ ind = new_sound("fmv.snd", 2, 22050, Mus_ldouble, Mus_next, "unequal lens")
insert_silence(0, 1000, ind, 1)
- if (res1 = frames(ind, 0)) != 1 or (res2 = frames(ind, 1)) != 1001
- snd_display("silence 1: %s %s?", res1, res2)
+ res1 = framples(ind, 0)
+ res2 = framples(ind, 1)
+ if res1 != 1 or res2 != 1001
+ snd_test_neq(res1, 1, "silence 1")
+ snd_test_neq(res2, 1001, "silence 1 (1001")
end
save_sound(ind)
- if (res1 = frames(ind, 0)) != 1001 or (res2 = frames(ind, 1)) != 1001
+ if (res1 = framples(ind, 0)) != 1001 or (res2 = framples(ind, 1)) != 1001
snd_display("saved silence 1: %s %s?", res1, res2)
end
- if (res = mus_sound_frames("fmv.snd")) != 1001
- snd_display("saved frames silence 1: %s?", res)
+ if (res = mus_sound_framples("fmv.snd")) != 1001
+ snd_display("saved framples silence 1: %s?", res)
end
v0 = channel2vct(0, 1000, ind, 0)
v1 = channel2vct(0, 1000, ind, 1)
@@ -7812,9 +7473,9 @@ def test_05_11
close_sound(ind)
delete_file("fmv.snd")
#
- ind = new_sound("fmv.snd", Mus_next, Mus_bshort, 22050, 2, "unequal lens")
+ ind = new_sound("fmv.snd", 2, 22050, Mus_bshort, Mus_next, "unequal lens")
pad_channel(0, 1000, ind, 1)
- if (res1 = frames(ind, 0)) != 1 or (res2 = frames(ind, 1)) != 1001
+ if (res1 = framples(ind, 0)) != 1 or (res2 = framples(ind, 1)) != 1001
snd_display("silence: %s %s?", res1, res2)
end
v0 = channel2vct(0, 1000, ind, 0)
@@ -7828,13 +7489,14 @@ def test_05_11
map_channel($init_channel, 0, 2, ind, 0)
map_channel($init_channel, 0, 1002, ind, 1)
pad_channel(0, 1000, ind, 0, 1)
- if (res = frames(ind, 1)) != 1002
+ if (res = framples(ind, 1)) != 1002
snd_display("pad_channel ed 1: %s?", res)
end
close_sound(ind)
delete_file("fmv.snd")
#
- ind = new_sound("fmv.snd", Mus_ircam, Mus_bshort, 22050, 1, "this is a comment")
+ ind = new_sound("fmv.snd", 1, 22050, Mus_bshort, Mus_ircam,
+ "this is a comment")
v0 = make_vct(128)
v0[64] = 0.5
v0[127] = 0.5
@@ -7855,7 +7517,9 @@ def test_05_11
set_sinc_width(40)
src_selection(0.5)
v0 = channel2vct(0, 128, ind, 0)
- if fneq(sample(20), 0.5) or fneq(sample(30), 0.0) or fneq(sample(17), -0.1057)
+ if fneq(sample(20), 0.5) or
+ fneq(sample(30), 0.0) or
+ fneq(sample(17), -0.1057)
snd_display("src_selection: %s?", v0)
end
unselect_all
@@ -7871,7 +7535,9 @@ def test_05_11
select_all
filter_selection([0, 0, 0.1, 1, 1, 0], 40)
v0 = channel2vct(0, 128, ind, 0)
- if fneq(sample(29), 0.1945) or fneq(sample(39), -0.0137) or fneq(sample(24), -0.01986)
+ if fneq(sample(29), 0.1945) or
+ fneq(sample(39), -0.0137) or
+ fneq(sample(24), -0.01986)
snd_display("filter_selection: %s?", v0)
end
revert_sound(ind)
@@ -7880,7 +7546,9 @@ def test_05_11
select_all
filter_selection(make_one_zero(:a0, 0.5, :a1, 0.0))
v0 = channel2vct(0, 128, ind, 0)
- if fneq(sample(29), 0.5) or fneq(sample(39), 0.5) or fneq(sample(24), 0.5)
+ if fneq(sample(29), 0.5) or
+ fneq(sample(39), 0.5) or
+ fneq(sample(24), 0.5)
snd_display("filter_selection one_zero: %s?", v0)
end
revert_sound(ind)
@@ -7890,24 +7558,28 @@ def test_05_11
select_all
env_selection([0, 0, 1, 1, 2, 0], 1.0)
v0 = channel2vct(0, 128, ind, 0)
- if fneq(sample(64), 1.0) or fneq(sample(20), 0.3125) or fneq(sample(119), 0.127)
+ if fneq(sample(64), 1.0) or
+ fneq(sample(20), 0.3125) or
+ fneq(sample(119), 0.127)
snd_display("env_selection: %s?", v0)
end
- save_selection("fmv5.snd", Mus_next, Mus_bint, 22050, "")
+ save_selection("fmv5.snd", 22050, Mus_bint, Mus_next, "")
revert_sound(ind)
#
- if (res = Snd.catch do file2array("/baddy/hiho", 0, 0, 128, v0) end).first != :no_such_file
+ res = Snd.catch do file2array("/baddy/hiho", 0, 0, 128, v0) end
+ if res.first != :no_such_file
snd_display("file2array w/o file: %s", res.inspect)
end
- if (res = Snd.catch do file2array("fmv5.snd", 123, 0, 128, v0) end).first != :no_such_channel
+ res = Snd.catch do file2array("fmv5.snd", 123, 0, 128, v0) end
+ if res.first != :no_such_channel
snd_display("file2array w/o channel: %s", res.inspect)
end
file2array("fmv5.snd", 0, 0, 128, v0)
if fneq(v0[64], 1.0) or fneq(v0[20], 0.3125) or fneq(v0[119], 0.127)
snd_display("save_selection: %s %s %s %s?", v0[64], v0[20], v0[119], v0)
end
- if (res = mus_sound_data_format("fmv5.snd")) != Mus_bint
- snd_display("save_selection type: %s?", mus_data_format_name(res))
+ if (res = mus_sound_sample_type("fmv5.snd")) != Mus_bint
+ snd_display("save_selection type: %s?", mus_sample_type_name(res))
end
if (res = mus_sound_header_type("fmv5.snd")) != Mus_next
snd_display("save_selection format: %s?", mus_header_type_name(res))
@@ -7921,7 +7593,7 @@ def test_05_11
vct2channel(v0)
select_all
Snd.catch do reverse_selection end
- save_selection("fmv4.snd", Mus_riff, Mus_lfloat, 44100, "this is a comment")
+ save_selection("fmv4.snd", 44100, Mus_lfloat, Mus_riff, "this is a comment")
v0 = channel2vct(0, 128, ind, 0)
if fneq(sample(27), 0.5) or fneq(sample(125), -0.5)
snd_display("reverse_selection: %s?", v0)
@@ -7933,8 +7605,8 @@ def test_05_11
if (res = mus_sound_header_type("fmv4.snd")) != Mus_riff
snd_display("save_selection type 1: %s", mus_header_type_name(res))
end
- if (res = mus_sound_data_format("fmv4.snd")) != Mus_lfloat
- snd_display("save_selection format 1: %s", mus_data_format_name(res))
+ if (res = mus_sound_sample_type("fmv4.snd")) != Mus_lfloat
+ snd_display("save_selection format 1: %s", mus_sample_type_name(res))
end
if (res = mus_sound_srate("fmv4.snd")) != 44100
snd_display("save_selection srate 1: %s", res)
@@ -7946,14 +7618,14 @@ def test_05_11
#
save_selection(:file, "fmv4.snd",
:header_type, Mus_riff,
- :data_format, Mus_lfloat,
+ :sample_type, Mus_lfloat,
:srate, 44100,
:comment, "this is a comment")
if (res = mus_sound_header_type("fmv4.snd")) != Mus_riff
snd_display("save_selection opt type 1: %s", mus_header_type_name(res))
end
- if (res = mus_sound_data_format("fmv4.snd")) != Mus_lfloat
- snd_display("save_selection opt format 1: %s", mus_data_format_name(res))
+ if (res = mus_sound_sample_type("fmv4.snd")) != Mus_lfloat
+ snd_display("save_selection opt format 1: %s", mus_sample_type_name(res))
end
if (res = mus_sound_srate("fmv4.snd")) != 44100
snd_display("save_selection opt srate 1: %s", res)
@@ -7963,13 +7635,13 @@ def test_05_11
end
delete_file("fmv4.snd")
#
- save_selection(:file, "fmv4.snd", :data_format, Mus_bfloat, :channel, 0)
+ save_selection(:file, "fmv4.snd", :sample_type, Mus_bfloat, :channel, 0)
res = mus_sound_header_type("fmv4.snd")
if res != Mus_next and res != Mus_ircam
snd_display("save_selection opt1 type 1: %s", mus_header_type_name(res))
end
- if (res = mus_sound_data_format("fmv4.snd")) != Mus_bfloat
- snd_display("save_selection opt1 format 1: %s", mus_data_format_name(res))
+ if (res = mus_sound_sample_type("fmv4.snd")) != Mus_bfloat
+ snd_display("save_selection opt1 format 1: %s", mus_sample_type_name(res))
end
if (res = mus_sound_chans("fmv4.snd")) != 1
snd_display("save_selection opt1 chans: %s", res)
@@ -8000,7 +7672,7 @@ end
def test_05_12
obind = open_sound("oboe.snd")
vol = maxamp(obind)
- dur = frames
+ dur = framples
set_amp_control(2.0, obind)
snd_test_neq(amp_control(obind), 2.0, "set_amp_control")
reset_controls(obind)
@@ -8022,44 +7694,49 @@ def test_05_12
set_speed_control_bounds([0.05, 20.0], obind)
add_mark(1234)
apply_controls(obind)
- newdur = frames(obind)
+ newdur = framples(obind)
set_speed_control(1.0, obind)
unless newdur - 2.0 * dur < 256
snd_display("apply speed: %s -> %s?", dur, newdur)
end
set_contrast_control?(true, obind)
set_contrast_control_bounds([0.5, 2.5], obind)
- snd_test_neq(contrast_control_bounds(obind), [0.5, 2.5], "contrast_control_bounds")
+ snd_test_neq(contrast_control_bounds(obind), [0.5, 2.5],
+ "contrast_control_bounds")
set_contrast_control(1.0, obind)
apply_controls(obind)
set_contrast_control_bounds([0.0, 10.0], obind)
- snd_test_neq(contrast_control_bounds(obind), [0.0, 10.0], "contrast_control_bounds (2)")
+ snd_test_neq(contrast_control_bounds(obind), [0.0, 10.0],
+ "contrast_control_bounds (2)")
secamp = maxamp(obind)
- secdur = frames(obind)
+ secdur = framples(obind)
snd_test_neq(secamp, 0.989, "apply contrast")
snd_test_neq(secdur, newdur, "apply contrast length")
undo_edit(3, obind)
set_reverb_control?(true, obind)
set_reverb_control_scale_bounds([0.0, 1.0], obind)
- snd_test_neq(reverb_control_scale_bounds(obind), [0.0, 1.0], "reverb_control_scale_bounds")
+ snd_test_neq(reverb_control_scale_bounds(obind), [0.0, 1.0],
+ "reverb_control_scale_bounds")
set_reverb_control_length_bounds([0.0, 2.0], obind)
- snd_test_neq(reverb_control_length_bounds(obind), [0.0, 2.0], "reverb_control_length_bounds")
+ snd_test_neq(reverb_control_length_bounds(obind), [0.0, 2.0],
+ "reverb_control_length_bounds")
set_reverb_control_scale(0.2, obind)
apply_controls(obind)
revamp = maxamp(obind)
- revdur = frames(obind)
- snd_test_any_neq(revamp, 0.214, :ffequal?, "apply reverb scale") # okay
+ revdur = framples(obind)
+ snd_test_any_neq(revamp, 0.214, :ffequal?, "apply reverb scale")
unless revdur - ((reverb_control_decay * 22050.0).round + 50828) < 256
snd_display("apply reverb length: %s?", revdur)
end
undo_edit(1, obind)
set_expand_control?(true, obind)
set_expand_control_bounds([1.0, 3.0], obind)
- snd_test_neq(expand_control_bounds(obind), [1.0, 3.0], "expand_control_bounds")
+ snd_test_neq(expand_control_bounds(obind), [1.0, 3.0],
+ "expand_control_bounds")
set_expand_control(1.5, obind)
apply_controls(obind)
expamp = maxamp(obind)
- expdur = frames(obind)
+ expdur = framples(obind)
if fneq_err(expamp, 0.152, 0.05)
snd_display("apply expand_control scale: %s?", expamp)
end
@@ -8073,17 +7750,9 @@ def test_05_12
set_filter_control_envelope([0.0, 0.0, 1.0, 0.5, 2.0, 0.0], obind)
apply_controls(obind)
fltamp = maxamp(obind)
- fltdur = frames(obind)
- # FIXME
- # from command line: => 0.054348257295914 (snd-s7|ruby|forth)
- # from listener: => less than 0.025
- if (fltamp - 0.02).abs > 0.005
- snd_display(snd_format(fltamp, 0.025, ">", "apply filter scale"))
- end
- req = 40 + 50828 + 256
- if fltdur - (40 + 50828) > 256
- snd_display(snd_format(fltdur, req, ">", "apply filter length"))
- end
+ fltdur = framples(obind)
+ snd_test_gt((fltamp - 0.02).abs, 0.005, "apply filter scale")
+ snd_test_gt(fltdur - (40 + 50828), 256, "apply filter length")
undo_edit(1, obind)
#
revert_sound(obind)
@@ -8116,13 +7785,13 @@ def test_05_12
[2002, 0, 2002, 2002, 0.999969720840454, 0.0, 0.0, 0],
[2003, 0, 2003, 50827, 1.0, 0.0, 0.0, 0],
[50828, -2, 0, 0, 0.0, 0.0, 0.0, 0]]
- if tree.length != tr_tree.length
- snd_display(snd_format_neq(tree.length, tr_tree.length, "edit trees are not same length"))
- else
+ unless snd_test_neq(tree.length, tr_tree.length,
+ "edit trees are not same length")
tree.each_with_index do |branch, i|
tr_branch = tr_tree[i]
5.times do |j|
- snd_test_neq(branch[j], tr_branch[j], "edit trees disagree at [%d][%d]", i, j)
+ snd_test_neq(branch[j], tr_branch[j],
+ "edit trees disagree at [%d][%d]", i, j)
end
end
end
@@ -8148,14 +7817,13 @@ def test_05_12
[2063, 0, 2002, 2002, 0.999969720840454, 0.0, 0.0, 0],
[2064, 0, 2003, 50827, 1.0, 0.0, 0.0, 0],
[50889, -2, 0, 0, 0.0, 0.0, 0.0, 0]]
- if tree.length != tr_tree.length
- snd_display(snd_format_neq(tree.length, tr_tree.length,
- "silenced edit trees are not same length"))
- else
+ unless snd_test_neq(tree.length, tr_tree.length,
+ "silenced edit trees are not same length")
tree.each_with_index do |branch, i|
tr_branch = tr_tree[i]
5.times do |j|
- snd_test_neq(branch[j], tr_branch[j], "silenced edit trees disagree at [%d][%d]", i, j)
+ snd_test_neq(branch[j], tr_branch[j],
+ "silenced edit trees disagree at [%d][%d]", i, j)
end
end
end
@@ -8172,7 +7840,7 @@ def test_05_12
mark_now = marks(obind, 0).length
snd_test_neq(mark_num, mark_now, "mark lost after scaling")
set_selection_position(0)
- set_selection_frames(100)
+ set_selection_framples(100)
scale_selection_to(0.5)
mark_now = marks(obind, 0).length
snd_test_neq(mark_num, mark_now, "mark lost after scaling scaling")
@@ -8197,29 +7865,31 @@ def test_05_12
key(key_to_int(?j), 4, obind)
snd_test_neq(cursor(obind), 100, "C-- C-j")
revert_sound(obind)
- frs = frames(obind)
+ frs = framples(obind)
make_region(0, 999, obind, 0)
unless selection?
snd_display("make_region but no selection? %s", selection?)
end
delete_selection
- snd_test_neq(frames(obind), frs - 1000, "delete_selection")
+ snd_test_neq(framples(obind), frs - 1000, "delete_selection")
val = sample(0, obind, 0)
undo_edit
snd_test_neq(sample(1000), val, "delete_selection val")
insert_selection
- if (res = Snd.catch do insert_selection(0, obind, 123) end).first != :no_such_channel
+ res = Snd.catch do insert_selection(0, obind, 123) end
+ if res.first != :no_such_channel
snd_display("insert_selection bad chan: %s?", res.inspect)
end
- if (res = Snd.catch do mix_selection(0, obind, 123) end).first != :no_such_channel
+ res = Snd.catch do mix_selection(0, obind, 123) end
+ if res.first != :no_such_channel
snd_display("mix_selection bad chan: %s?", res.inspect)
end
- snd_test_neq(frames(obind), frs + 1000, "insert_selection")
+ snd_test_neq(framples(obind), frs + 1000, "insert_selection")
snd_test_neq(sample(2000), val, "insert_selection val")
val = sample(900)
mix_selection
snd_test_neq(sample(900), val * 2.0, "mix_selection val")
- snd_test_neq(frames(obind), frs + 1000, "mix_selection len")
+ snd_test_neq(framples(obind), frs + 1000, "mix_selection len")
close_sound(obind)
end
@@ -8227,43 +7897,36 @@ Apply_to_sound, Apply_to_channel, Apply_to_selection = [0, 1, 2]
def test_05_13
ind = open_sound("2.snd")
- len = frames(ind)
+ len = framples(ind)
+ len2 = len * 2
+ len4 = len * 4
set_sync(1, ind)
set_speed_control(0.5, ind)
apply_controls(ind, Apply_to_sound) # temp 1
- if (frames - 2 * len).abs > 256
- snd_display("apply srate 0.5: %s %s?", frames, len * 2)
- end
- make_selection(0, frames)
+ snd_test_gt((framples() - len2).abs, 256, "apply srate 0.5")
+ make_selection(0, framples())
set_speed_control(0.5, ind)
apply_controls(ind, Apply_to_selection) # temp 2
- if (frames - 4 * len).abs > 256
- snd_display("apply srate 0.5 to selection: %s %s?", frames, len * 4)
- end
- env_sound([0, 0, 1, 1], 0, frames, 32.0) # temp 3
- reg = select_all # make multi_channel region
+ snd_test_gt((framples() - len4).abs, 256, "apply srate 0.5 to selection")
+ env_sound([0, 0, 1, 1], 0, framples(), 32.0) # temp 3
+ reg = select_all() # make multi_channel region
insert_region(reg, 0) # temp 4
insert_selection(0) # temp 5
revert_sound(ind)
+ #
set_speed_control(0.5)
set_sync(0, ind)
set_selected_channel(ind, 1)
apply_controls(ind, Apply_to_channel)
- if (frames(ind, 1) - 2 * len).abs > 256
- snd_display("apply srate 0.5 to chan 1: %s %s?", frames(ind, 1), len * 2)
- end
- if frames(ind, 0) != len
- snd_display("apply srate 0.5 but chan 0: %s %s?", frames(ind, 0), len)
- end
+ snd_test_gt((framples(ind, 1) - len2).abs, 256, "apply srate 0.5 to chan 1")
+ snd_test_neq(framples(ind, 0), len, "apply srate 0.5 but chan 0")
set_speed_control(0.5, ind)
apply_controls(ind, Apply_to_sound, 1000)
make_selection(2000, 4000)
set_speed_control(0.5, ind)
apply_controls(ind, Apply_to_selection)
set_selected_channel(ind, false)
- if selected_channel(ind)
- snd_display("selected_channel false: %s?", selected_channel(ind))
- end
+ snd_test_neq(selected_channel(ind), false, "selected_channel false")
close_sound(ind)
#
ind1 = open_sound("oboe.snd")
@@ -8273,109 +7936,66 @@ def test_05_13
mx21 = maxamp(ind2, 1)
select_sound(ind1)
scale_sound_by(2.0)
- if fneq(res = maxamp(ind1, 0), 2.0 * mx1)
- snd_display("scale_sound_by 2.0: %s %s?", mx1, res)
- end
- if (res1 = edit_fragment(1, ind1, 0)) !=
- (res2 = ["scale_channel(2.000, 0, false", "scale", 0, 50828])
- snd_display("scale_sound_by:\n# %s\n# %s", res1, res2)
- end
+ snd_test_neq(maxamp(ind1, 0), 2.0 * mx1, "scale_sound_by 2.0")
+ res = edit_fragment(1, ind1, 0)
+ req = ["scale_channel(2.000, 0, false", "scale", 0, 50828]
+ snd_test_neq(res, req, "scale_sound_by")
scale_sound_to(0.5)
- if fneq(res = maxamp(ind1, 0), 0.5)
- snd_display("scale_sound_to 0.5: %s?", res)
- end
- if (res1 = edit_fragment(2, ind1, 0)) !=
- (res2 = ["scale_channel(1.698, 0, false", "scale", 0, 50828])
- snd_display("scale_sound_to:\n# %s\n# %s", res1, res2)
- end
+ snd_test_neq(maxamp(ind1, 0), 0.5, "scale_sound_to 0.5")
+ res = edit_fragment(2, ind1, 0)
+ req = ["scale_channel(1.698, 0, false", "scale", 0, 50828]
+ snd_test_neq(res, req, "scale_sound_to")
scale_sound_by(0.0, 0, 1000, ind1, 0)
- if fneq(res = maxamp(ind1, 0), 0.5)
- snd_display("scale_sound_by 0.0: %s?", res)
- end
- if (res1 = edit_fragment(3, ind1, 0)) !=
- (res2 = ["scale_channel(0.000, 0, 1000", "scale", 0, 1000])
- snd_display("scale_sound_by 0.0:\n# %s\n# %s", res1, res2)
- end
- v = channel2vct(0, 1000, ind1, 0)
- if fneq(res = vct_peak(v), 0.0)
- snd_display("scale_sound_by 0.0 [0:1000]: %s", res)
- end
+ snd_test_neq(maxamp(ind1, 0), 0.5, "scale_sound_by 0.0")
+ res = edit_fragment(3, ind1, 0)
+ req = ["scale_channel(0.000, 0, 1000", "scale", 0, 1000]
+ snd_test_neq(res, req, "scale_sound_by 0.0")
+ res = channel2vct(0, 1000, ind1, 0).peak
+ snd_test_neq(res, 0.0, "0:0 scale_sound_by 0.0 [0:1000]")
revert_sound(ind1)
oldv = channel2vct(12000, 10, ind1, 0)
scale_sound_by(2.0, 12000, 10, ind1, 0)
newv = channel2vct(12000, 10, ind1, 0)
10.times do |i|
- if fneq(res1 = oldv[i] * 2.0, res2 = newv[i])
- snd_display("scale %s: %s %s?", i, res1, res2)
- end
- end
- if (res1 = edit_fragment(1, ind1, 0)) !=
- (res2 = ["scale_channel(2.000, 12000, 10", "scale", 12000, 10])
- snd_display("scale_sound_by 2.0 [12000:10]:\n# %s\n# %s", res1, res2)
+ snd_test_neq(oldv[i] * 2.0, newv[i], "scale %d", i)
end
+ res = edit_fragment(1, ind1, 0)
+ req = ["scale_channel(2.000, 12000, 10", "scale", 12000, 10]
+ snd_test_neq(res, req, "scale_sound_by 2.0 [12000:10]")
revert_sound(ind1)
#
select_sound(ind2)
scale_sound_by(2.0)
- if fneq(res = maxamp(ind2, 0), 2.0 * mx20)
- snd_display("2:0 scale_sound_by 2.0: %s %s?", mx20, res)
- end
- if fneq(res = maxamp(ind2, 1), 2.0 * mx21)
- snd_display("2:1 scale_sound_by 2.0: %s %s?", mx21, res)
- end
- if (res1 = edit_fragment(1, ind2, 0)) !=
- (res2 = ["scale_channel(2.000, 0, false", "scale", 0, 50828])
- snd_display("2 scale_sound_by:\n# %s\n# %s", res1, res2)
- end
+ snd_test_neq(maxamp(ind2, 0), 2.0 * mx20, "2:0 scale_sound_by 2.0")
+ snd_test_neq(maxamp(ind2, 1), 2.0 * mx21, "2:1 scale_sound_by 2.0")
scale_sound_to(0.5)
- if fneq(res = [maxamp(ind2, 0), maxamp(ind2, 1)].max, 0.5)
- snd_display("2 scale_sound_to 0.5: %s %s?", res, maxamp(ind2))
- end
+ res = [maxamp(ind2, 0), maxamp(ind2, 1)].max
+ snd_test_neq(res, 0.5, "2 scale_sound_to 0.5")
scale_sound_by(0.0, 0, 1000, ind2, 1)
- if fneq(res = maxamp(ind2, 0), 0.5)
- snd_display("2 scale_sound_by 0.0: %s?", res)
- end
- if (res1 = edit_fragment(3, ind2, 1)) !=
- (res2 = ["scale_channel(0.000, 0, 1000", "scale", 0, 1000])
- snd_display("2:1 scale_sound_by 0.0:\n# %s\n# %s", res1, res2)
- end
- v = channel2vct(0, 1000, ind2, 1)
- if fneq(res = vct_peak(v), 0.0)
- snd_display("2:1 scale_sound_by 0.0 [0:1000]: %s", res)
- end
+ res = edit_fragment(3, ind2, 1)
+ req = ["scale_channel(0.000, 0, 1000", "scale", 0, 1000]
+ snd_test_neq(res, req, "2:1 scale_sound_by 0.0")
+ res = channel2vct(0, 1000, ind2, 1).peak
+ snd_test_neq(res, 0.0, "2:1 scale_sound_by 0.0 [0:1000]")
revert_sound(ind2)
oldv = channel2vct(12000, 10, ind2, 0)
scale_sound_by(2.0, 12000, 10, ind2, 0)
newv = channel2vct(12000, 10, ind2, 0)
10.times do |i|
- if fneq(res1 = oldv[i] * 2.0, res2 = newv[i])
- snd_display("2 scale %s: %s %s?", i, res1, res2)
- end
+ snd_test_neq(oldv[i] * 2.0, newv[i], "2 scale %d", i)
end
revert_sound(ind2)
#
set_sync(3, ind2)
set_sync(3, ind1)
scale_sound_by(2.0)
- if fneq(res = maxamp(ind1, 0), mx1)
- snd_display("sync scale_sound_by 2.0: %s %s?", mx1, res)
- end
- if fneq(res = maxamp(ind2, 0), 2.0 * mx20)
- snd_display("2:0 sync scale_sound_by 2.0: %s %s?", mx20, res)
- end
- if fneq(res = maxamp(ind2, 1), 2.0 * mx21)
- snd_display("2:1 sync scale_sound_by 2.0: %s %s?", mx21, res)
- end
+ snd_test_neq(maxamp(ind1, 0), mx1, "sync scale_sound_by 2.0")
+ snd_test_neq(maxamp(ind2, 0), 2.0 * mx20, "2:0 sync scale_sound_by 2.0")
+ snd_test_neq(maxamp(ind2, 1), 2.0 * mx21, "2:1 sync scale_sound_by 2.0")
scale_sound_to(1.0, 20000, 40000, ind2, 1)
- if fneq(res = maxamp(ind1, 0), mx1)
- snd_display("sync scale_sound_to 1.0: %s %s?", mx1, res)
- end
- if fneq(res = maxamp(ind2, 0), 2.0 * mx20)
- snd_display("2:0 sync scale_sound_to 1.0: %s %s?", mx20, res)
- end
- if fneq(res = maxamp(ind2, 1), 1.0)
- snd_display("2:1 sync scale_sound_to 1.0: %s?", res)
- end
+ snd_test_neq(maxamp(ind1, 0), mx1, "sync scale_sound_to 1.0")
+ snd_test_neq(maxamp(ind2, 0), 2.0 * mx20, "2:0 sync scale_sound_to 1.0")
+ snd_test_neq(maxamp(ind2, 1), 1.0, "2:1 sync scale_sound_to 1.0")
close_sound(ind1)
close_sound(ind2)
end
@@ -8407,9 +8027,12 @@ def test_05_14
set_transform_graph?(true, ind, 0)
set_transform_graph_type(Graph_as_sonogram, ind, 0)
update_transform_graph(ind, 0)
- res = transform_frames(ind, 0)
- if (not list?(res)) or fneq(res.car, 1.0) or res.caddr != 256
- snd_display("transform_frames: %s (%s)?", res.inspect, transform_size(ind, 0))
+ res = transform_framples(ind, 0)
+ if (not list?(res)) or
+ fneq(res.car, 1.0) or
+ res.caddr != 256
+ snd_display("transform_framples: %s (%s)?",
+ res.inspect, transform_size(ind, 0))
end
close_sound(ind)
#
@@ -8430,7 +8053,9 @@ def test_05_14
end
after_ran = false
$after_apply_controls_hook.reset_hook!
- $after_apply_controls_hook.add_hook!("snd-test") do |snd| after_ran = snd end
+ $after_apply_controls_hook.add_hook!("snd-test") do |snd|
+ after_ran = snd
+ end
apply_controls(ind)
unless ind.eql?(after_ran)
snd_display("$after_apply_controls_hook: %s?", after_ran)
@@ -8440,27 +8065,34 @@ def test_05_14
set_sync(1, ind)
scale_to(vct(0.1, 0.2))
mx = maxamp(ind, true)
- if fneq(mx[0], 0.1) or fneq(mx[1], 0.2) or fneq(mx[2], 0.2) or fneq(mx[3], 0.2)
+ if fneq(mx[0], 0.1) or
+ fneq(mx[1], 0.2) or
+ fneq(mx[2], 0.2) or
+ fneq(mx[3], 0.2)
snd_display("scale_to with vector: %s?", mx)
end
set_filter_control_envelope([0, 0, 1, 1], ind)
if [0.0, 0.0, 1.0, 1.0] != filter_control_envelope(ind)
- snd_display("set_filter_control_envelope: %s?", filter_control_envelope(ind))
+ snd_display("set_filter_control_envelope: %s?",
+ filter_control_envelope(ind))
end
set_filter_control_order(20, ind)
unless vequal(res = filter_control_coeffs(ind),
- vct(-0.007, 0.010, -0.025, 0.029, -0.050, 0.055, -0.096, 0.109, -0.268, 0.241,
- 0.241, -0.268, 0.109, -0.096, 0.055, -0.050, 0.029, -0.025, 0.010, -0.007))
+ vct(-0.007, 0.010, -0.025, 0.029, -0.050, 0.055, -0.096,
+ 0.109, -0.268, 0.241, 0.241, -0.268, 0.109, -0.096,
+ 0.055, -0.050, 0.029, -0.025, 0.010, -0.007))
snd_display("highpass coeffs: %s?", res)
end
set_filter_control_envelope(filter_control_envelope(ind), ind)
if [0.0, 0.0, 1.0, 1.0] != filter_control_envelope(ind)
- snd_display("set_filter_control_envelope to self: %s?", filter_control_envelope(ind))
+ snd_display("set_filter_control_envelope to self: %s?",
+ filter_control_envelope(ind))
end
set_filter_control_envelope([0, 1, 1, 0], ind)
unless vequal(res = filter_control_coeffs(ind),
- vct(0.003, 0.002, 0.004, 0.002, 0.007, 0.003, 0.014, 0.012, 0.059, 0.394,
- 0.394, 0.059, 0.012, 0.014, 0.003, 0.007, 0.002, 0.004, 0.002, 0.003))
+ vct(0.003, 0.002, 0.004, 0.002, 0.007, 0.003, 0.014, 0.012,
+ 0.059, 0.394, 0.394, 0.059, 0.012, 0.014, 0.003, 0.007,
+ 0.002, 0.004, 0.002, 0.003))
snd_display("lowpass coeffs: %s?", res)
end
close_sound(ind)
@@ -8469,7 +8101,8 @@ end
def test_05_15
obind = open_sound("4.aiff")
amps = maxamp(obind, true)
- snd_test_neq(maxamp_position(obind, true), [810071, 810071, 810071, 810071], "4.aiff times")
+ snd_test_neq(maxamp_position(obind, true), [810071, 810071, 810071, 810071],
+ "4.aiff times")
if window_width < 600
set_window_width(600)
end
@@ -8481,7 +8114,8 @@ def test_05_15
update_time_graph
set_amp_control(0.1, obind)
select_channel(2)
- if (res = Snd.catch do apply_controls(obind, 1) end).first == :no_such_sound
+ res = Snd.catch do apply_controls(obind, 1) end
+ if res.first == :no_such_sound
snd_display("apply_controls cannot find 4.aiff: %s?", res.inspect)
end
newamps = maxamp(obind, true)
@@ -8493,7 +8127,7 @@ def test_05_15
end
undo_edit(1, obind, 2)
set_amp_control(0.1, obind)
- make_region(0, frames(obind), obind, 1)
+ make_region(0, framples(obind), obind, 1)
Snd.catch do apply_controls(obind, 2) end
newamps = maxamp(obind, true)
if fneq(amps[0], newamps[0]) or
@@ -8511,7 +8145,8 @@ def test_05_15
select_channel(0)
set_cursor(100, obind)
xy = cursor_position(obind)
- snd_test_neq(position2x(xy[0]), cursor(obind).to_f / srate(obind), "cursor_position %s", xy[0])
+ snd_test_neq(position2x(xy[0]), cursor(obind).to_f / srate(obind),
+ "cursor_position %s", xy[0])
snd_test_neq(position2x(x2position(xpos)), xpos, "x<->position")
if ((res = position2y(y2position(ypos))) - ypos).abs > 0.5
snd_display(snd_format(res, ypos, "y<->position"))
@@ -8535,10 +8170,14 @@ def test_05_15
end
if $clmtest.zero?
cp_x = lambda do |x|
- (axinfo[10] + ((x - x0.to_f) * ((axinfo[12] - axinfo[10].to_f) / (x1 - x0.to_f)))).floor
+ (axinfo[10] +
+ ((x - x0.to_f) *
+ ((axinfo[12] - axinfo[10].to_f) / (x1 - x0.to_f)))).floor
end
cp_y = lambda do |y|
- (axinfo[13] + ((y1.to_f - y) * ((axinfo[11] - axinfo[13].to_f) / (y1 - y0.to_f)))).floor
+ (axinfo[13] +
+ ((y1.to_f - y) *
+ ((axinfo[11] - axinfo[13].to_f) / (y1 - y0.to_f)))).floor
end
if ((res1 = x2position(xpos)) - (res2 = cp_x.call(xpos))).abs > 1
snd_display(snd_format_neq(res2, res1, "cp_x 0.5"))
@@ -8555,9 +8194,10 @@ def test_05_15
if ((res1 = y2position(yypos)) - (res2 = cp_y.call(yypos))).abs > 1
snd_display(snd_format_neq(res2, res1, "cp_y[%d] %1.4f", i, yypos))
end
- snd_test_neq(position2x(cp_x.call(xxpos)), xxpos, "x2position cp_x[%d]", i)
- # okay
- snd_test_any_neq(position2y(cp_y.call(yypos)), yypos, :fffequal?, "y2position cp_y[%d]", i)
+ snd_test_neq(position2x(cp_x.call(xxpos)), xxpos,
+ "x2position cp_x[%d]", i)
+ snd_test_any_neq(position2y(cp_y.call(yypos)), yypos, :fffequal?,
+ "y2position cp_y[%d]", i)
end
end
old_samp = left_sample(obind, 0)
@@ -8621,19 +8261,23 @@ def test_05_16
lambda { |snd| env_sound([0, 1.0, 1, 0.5, 2, 1.0]) },
"env_sound([0, 1.0, 1, 2.0, 2, 1.0])",
ind1)
- test_orig(lambda { |snd| env_channel(make_env([0, 1.0, 1, 2.0], :length, frames(snd))) },
- lambda { |snd| env_channel(make_env([[0, 1.0], [1, 0.5]], :length, frames(snd))) },
- "env_channel(make_env([0, 1.0, 1, 2.0]))",
- ind1)
+ test_orig(lambda { |snd|
+ env_channel(make_env([0, 1.0, 1, 2.0], :length, framples(snd)))
+ },
+ lambda { |snd|
+ env_channel(make_env([[0, 1.0], [1, 0.5]], :length, framples(snd)))
+ }, "env_channel(make_env([0, 1.0, 1, 2.0]))", ind1)
test_orig(lambda { |snd| env_channel([0, 1.0, 1, 2.0]) },
lambda { |snd| env_channel([0, 1.0, 1, 0.5]) },
"env_channel([0, 1.0, 1, 2.0])",
ind1)
test_orig(lambda { |snd|
- env_channel(make_env([0, 2, 1, 2, 2, 0.5, 3, 0.5], :base, 0, :length, frames(snd)))
+ env_channel(make_env([0, 2, 1, 2, 2, 0.5, 3, 0.5],
+ :base, 0, :length, framples(snd)))
},
lambda { |snd|
- env_channel(make_env([0, 0.5, 1, 0.5, 2, 2, 3, 2], :base, 0, :length, frames(snd)))
+ env_channel(make_env([0, 0.5, 1, 0.5, 2, 2, 3, 2],
+ :base, 0, :length, framples(snd)))
},
"env_channel(make_env([0, 2, 1, 2, 2, 0.5, 3, 0.5]))",
ind1)
@@ -8651,7 +8295,9 @@ def test_05_16
ind1)
outp = false
test_orig(lambda { |snd| map_channel(lambda { |y| vct(y * 2.0, y * 2.0) }) },
- lambda { |snd| map_channel(lambda { |y| outp = (outp ? false : y * 0.5) }) },
+ lambda { |snd| map_channel(lambda { |y|
+ outp = (outp ? false : y * 0.5)
+ }) },
"map_channel(lambda { |y| vct(y * 2.0, y * 2.0) })",
ind1)
test_orig(lambda { |snd| map_chan(lambda { |y| y * 2.0 }) },
@@ -8670,8 +8316,10 @@ def test_05_16
lambda { |snd| clm_channel(make_one_pole(:a0, 0.5, :b1, 0.0)) },
"clm_channel(make_one_pole)",
ind1)
- test_orig(lambda { |snd| filter_sound(make_one_zero(:a0, 2.0, :a1, 0.0), 2, snd, 0) },
- lambda { |snd| filter_sound(make_one_zero(:a0, 0.5, :a1, 0.0), 2, snd, 0) },
+ test_orig(lambda { |snd| filter_sound(make_one_zero(:a0, 2.0, :a1, 0.0),
+ 2, snd, 0) },
+ lambda { |snd| filter_sound(make_one_zero(:a0, 0.5, :a1, 0.0),
+ 2, snd, 0) },
"filter_sound(make_one_zero)",
ind1)
if (res = Snd.catch do src_sound([0, 0, 1, 1]) end).first != :out_of_range
@@ -8690,20 +8338,19 @@ def test_05_16
convolve_with("fmv3.snd", 1.0, ind1)
convolve_files("fmv4.snd", "fmv3.snd", 1.0, "fmv5.snd")
v2 = channel2vct(12000, 10, ind1, 0)
- snd_test_any_neq(v2, v1, :vfequal?, "convolve_with (orig 0)") # okay
+ snd_test_any_neq(v2, v1, :vfequal?, "convolve_with (orig 0)")
file2array("fmv5.snd", 0, 12000, 10, v2)
- snd_test_any_neq(v2, v1, :vfequal?, "convolve_files (orig 0)") # okay
+ snd_test_any_neq(v2, v1, :vfequal?, "convolve_files (orig 0)")
delete_files("fmv3.snd", "fmv5.snd")
convolve_files("2.snd", "oboe.snd", 0.5, "fmv5.snd")
res = mus_sound_maxamp("fmv5.snd")
- unless (fneq(res[1], 0.25) or fneq(res[3], 0.5))
- snd_display("convolve_files stereo: %s", res)
- end
+ snd_test_neq(res[1], 0.25, "convolve_files stereo (1)")
+ snd_test_neq(res[3], 0.50, "convolve_files stereo (2)")
delete_file("fmv5.snd")
scale_to(0.25, ind1)
set_y_bounds([], ind1)
- if $with_test_gui and (res = y_bounds(ind1)) != [-0.25, 0.25]
- snd_display("y_bounds []: %s", res)
+ if $with_test_gui
+ snd_test_neq(y_bounds(ind1), [-0.25, 0.25], "y_bounds []")
end
revert_sound(ind1)
#
@@ -8715,9 +8362,9 @@ def test_05_16
convolve_with("fmv3.snd", 1.0, ind1)
convolve_files("fmv4.snd", "fmv3.snd", 1.0, "fmv5.snd")
v2 = channel2vct(12005, 10, ind1, 0)
- snd_test_any_neq(v2, v1, :vfequal?, "convolve_with (orig 2)") # okay
+ snd_test_any_neq(v2, v1, :vfequal?, "convolve_with (orig 2)")
file2array("fmv5.snd", 0, 12005, 10, v2)
- snd_test_any_neq(v2, v1, :vfequal?, "convolve_files (orig 2)") # okay
+ snd_test_any_neq(v2, v1, :vfequal?, "convolve_files (orig 2)")
delete_files("fmv3.snd", "fmv4.snd", "fmv5.snd")
revert_sound(ind1)
#
@@ -8733,7 +8380,7 @@ def test_05_16
data = channel2vct(12000, 10, ind1, 0)
convolve_with("pistol.snd", maxamp(ind1, 0, 0), ind1, 0, 0)
new_data = channel2vct(12000, 10, ind1, 0)
- snd_test_any_neq(new_data, data, :vfequal?, "convolve_selection_with") # okay
+ snd_test_any_neq(new_data, data, :vfequal?, "convolve_selection_with")
revert_sound(ind1)
#
make_selection(1000, 2000, ind1)
@@ -8747,8 +8394,9 @@ def test_05_16
unless region?(id)
snd_display("make_region argless: %s?", id)
end
- if (res1 = region_frames(id, 0)) != (res2 = selection_frames)
- snd_display("region/selection_frames: %s %s (%s)?", res1, res2, region_frames(id))
+ if (res1 = region_framples(id, 0)) != (res2 = selection_framples)
+ snd_display("region/selection_framples: %s %s (%s)?",
+ res1, res2, region_framples(id))
end
if (res1 = region_sample(id, 0)) != (res2 = sample(1000, ind1))
snd_display("region_sample from make_region: %s %s?", res1, res2)
@@ -8774,17 +8422,20 @@ def test_05_17
v2 = channel2vct(12000, 10, ind, 0)
v3 = channel2vct(12000, 10, ind, 1)
if vequal(v0, v2) or vequal(v1, v3)
- snd_display("swap_channels 0: no change!\n# %s\n# %s\n# %s\n# %s", v0, v2, v1, v3)
+ snd_display("swap_channels 0: no change!\n# %s\n# %s\n# %s\n# %s",
+ v0, v2, v1, v3)
end
swap_channels(ind)
v2 = channel2vct(12000, 10, ind, 0)
v3 = channel2vct(12000, 10, ind, 1)
unless vequal(v0, v2) or vequal(v1, v3)
- snd_display("swap_channels 1: \n# %s\n# %s\n# %s\n# %s", v0, v2, v1, v3)
+ snd_display("swap_channels 1: \n# %s\n# %s\n# %s\n# %s",
+ v0, v2, v1, v3)
end
set_cursor(100, ind, 0)
set_cursor(200, ind, 1)
- if (res0 = cursor(ind, 0)) != 100 or (res1 = cursor(ind, 1)) != 200
+ if (res0 = cursor(ind, 0)) != 100 or
+ (res1 = cursor(ind, 1)) != 200
snd_display("cursor: %s %s?", res0, res1)
end
set_sync(1, ind)
@@ -8794,12 +8445,14 @@ def test_05_17
amps = maxamp(ind, true)
swap_channels(ind, 0, ind)
newamps = maxamp(ind, true)
- if fneq(amps[0], newamps[1]) or fneq(amps[1], newamps[0])
+ if fneq(amps[0], newamps[1]) or
+ fneq(amps[1], newamps[0])
snd_display("swap_channels with cp def: %s %s?", amps, newamps)
end
swap_channels(ind, 1)
newamps = maxamp(ind, true)
- if fneq(amps[0], newamps[0]) or fneq(amps[1], newamps[1])
+ if fneq(amps[0], newamps[0]) or
+ fneq(amps[1], newamps[1])
snd_display("swap_channels with cp def 0: %s %s?", amps, newamps)
end
close_sound(ind)
@@ -8810,12 +8463,12 @@ def test_05_18
ind2 = open_sound("2.snd")
ups1 = count_matches(lambda do |n| n > 0.1 end, 0, ind1, 0)
count = 0
- scan_chan(lambda do |n|
- if n > 0.1
- count += 1
- end
- false
- end, 0, frames(ind1), ind1, 0)
+ reader = make_sampler(0, ind1)
+ framples(ind1).times do |i|
+ if next_sample(reader) > 0.1
+ count += 1
+ end
+ end
ups2 = count
if ups1 != ups2
snd_display("scan_chan: %s %s?", ups1, ups2)
@@ -8823,20 +8476,20 @@ def test_05_18
ups1 = count_matches(lambda do |n| n > 0.03 end, 0, ind2, 0)
ups2 = count_matches(lambda do |n| n > 0.03 end, 0, ind2, 1)
count = 0
- scan_chan(lambda do |n|
- if n > 0.03
- count += 1
- end
- false
- end, 0, frames(ind2), ind2, 0)
+ reader = make_sampler(0, ind2, 0)
+ framples(ind2).times do |i|
+ if next_sample(reader) > 0.03
+ count += 1
+ end
+ end
ups3 = count
count = 0
- scan_chan(lambda do |n|
- if n > 0.03
- count += 1
- end
- false
- end, 0, frames(ind2), ind2, 1)
+ reader = make_sampler(0, ind2, 1)
+ framples(ind2).times do |i|
+ if next_sample(reader) > 0.03
+ count += 1
+ end
+ end
ups4 = count
if ups1 != ups3
snd_display("2[0] scan_chan: %s %s?", ups1, ups3)
@@ -8858,7 +8511,7 @@ def test_05_18
end
set_sync(false, ind2)
count = 0
- scan_sound_chans(0, frames(ind2), ind2) do |n|
+ scan_sound_chans(0, framples(ind2), ind2) do |n|
if n > 0.03
count += 1
end
@@ -8904,21 +8557,21 @@ end
def test_05_20
ind1 = open_sound("oboe.snd")
- len = frames(ind1)
+ len = framples(ind1)
ctr = 0
map_chan(lambda do |n|
ctr = (ctr == 1) ? 0 : 1
ctr.zero? ? n * 2.0 : false
- end, 0, frames(ind1), "ignore: cut 2", ind1, 0)
- if frames(ind1) > (len * 2 + 1)
- snd_display("map_chan cut: %s %s?", len, frames(ind1))
+ end, 0, framples(ind1), "ignore: cut 2", ind1, 0)
+ if framples(ind1) > (len * 2 + 1)
+ snd_display("map_chan cut: %s %s?", len, framples(ind1))
end
revert_sound(ind1)
ctr = 0
map_chan(lambda do |n|
ctr += 1
ctr > 3 ? true : n
- end, 0, frames(ind1), "ignore: cut none", ind1, 0)
+ end, 0, framples(ind1), "ignore: cut none", ind1, 0)
if ctr > 4
snd_display("map_chan no-edit count: %s?", ctr)
end
@@ -8928,9 +8581,9 @@ def test_05_20
v1[0] = n
v1[1] = n * 3.0
v1
- end, 0, frames(ind1), "ignore: cut 2", ind1, 0)
- if (frames(ind1) - len * 2).abs > 3
- snd_display("map_chan double: %s %s?", len, frames(ind1))
+ end, 0, framples(ind1), "ignore: cut 2", ind1, 0)
+ if (framples(ind1) - len * 2).abs > 3
+ snd_display("map_chan double: %s %s?", len, framples(ind1))
end
revert_sound(ind1)
otime = maxamp_position(ind1)
@@ -8954,86 +8607,66 @@ def test_05_20
end
set_sample(1234, 0.0)
env_channel([0, 0, 1, 1])
- if (res = maxamp_position) != 35062
- snd_display("env_channel maxamp_position: %s (35062)?", res)
- end
+ snd_test_neq(maxamp_position(), 35062, "env_channel maxamp_position")
ootime = maxamp_position(ind1, 0, 0)
- if ootime != otime
- snd_display("maxamp_position edpos 0 (1): %s %s?", otime, ootime)
- end
+ snd_test_neq(ootime, otime, "maxamp_position edpos 0 (1)")
nntime = maxamp_position(ind1, 0, 1)
- if nntime != 1234
- snd_display("maxamp_position edpos 1 (1): %s (1234)?", nntime)
- end
+ snd_test_neq(nntime, 1234, "maxamp_position edpos 1 (1)")
nntime = maxamp_position(ind1, 0, Current_edit_position)
- if nntime != 35062
- snd_display("maxamp_position edpos current: %s (35062)?", nntime)
- end
+ snd_test_neq(nntime, 35062, "maxamp_position edpos current")
revert_sound(ind1)
make_selection(24000, 25000)
- if (res = selection_maxamp_position) != 971
- snd_display("selection_maxamp_position: %s (971)?", res)
- end
+ snd_test_neq(selection_maxamp_position(), 971, "selection_maxamp_position")
make_region(24000, 25000)
- if (res = region_maxamp_position(regions.first)) != 971
- snd_display("region_maxamp_position: %s (971)?", res)
- end
+ res = region_maxamp_position(regions.first)
+ snd_test_neq(res, 971, "region_maxamp_position")
close_sound(ind1)
ind1 = open_sound("oboe.snd")
test_edpos(ind1, :maxamp) do | | scale_by(2.0, ind1, 0) end
- test_edpos(ind1, :frames) do | | src_sound(2.0, 1.0, ind1, 0) end
+ test_edpos(ind1, :framples) do | | src_sound(2.0, 1.0, ind1, 0) end
test_edpos(ind1, :count_matches, lambda do |*args|
- snd, chn, edpos = get_test_args(args, 0, 0, Current_edit_position)
- count_matches(lambda do |n1| n1 > 0.1 end, 0, snd, chn, edpos)
- end) do | |
+ snd, chn, edpos = get_test_args(args, 0, 0, Current_edit_position)
+ count_matches(lambda do |n1| n1 > 0.1 end, 0, snd, chn, edpos)
+ end) do | |
scale_by(2.0, ind1, 0)
end
test_edpos(ind1, :find, lambda do |*args|
- snd, chn, edpos = get_test_args(args, 0, 0, Current_edit_position)
- find_channel(lambda do |n2| n2 > 0.1 end, 0, snd, chn, edpos)
- end) do | |
+ snd, chn, edpos = get_test_args(args, 0, 0, Current_edit_position)
+ find_channel(lambda do |n2| n2 > 0.1 end, 0, snd, chn, edpos)
+ end) do | |
delete_samples(0, 100, ind1, 0)
end
- test_edpos(ind1, :scan_chan, lambda do |*args|
- snd, chn, edpos = get_test_args(args, 0, 0, Current_edit_position)
- samp = 0
- scan_chan(lambda do |n3|
- if n3 > 0.1
- samp
- else
- samp += 1
- false
- end
- end, 0, frames(snd, chn), snd, chn, edpos)
- samp
- end) do | |
+ test_edpos(ind1, :scan_channel, lambda do |*args|
+ snd, chn, edpos = get_test_args(args, 0, 0, Current_edit_position)
+ samp = 0
+ scan_channel(lambda do |n3|
+ if n3 > 0.1
+ samp
+ else
+ samp += 1
+ false
+ end
+ end, 0, framples(snd, chn), snd, chn, edpos)
+ samp
+ end) do | |
delete_samples(0, 100, ind1, 0)
end
#
- src_sound(2.0, 1.0, ind1, 0)
- play(ind1, :channel, 0, :edit_position, 0, :wait, true)
- play(ind1, :channel, 0, :edit_position, 1, :wait, true)
- play(ind1, :channel, 0, :edit_position, lambda do |snd, chn|
- edit_position(snd, chn)
- end, :wait, true)
- undo_edit(1, ind1, 0)
- play(ind1, :channel, 0, :edit_position, 1, :wait, true)
- #
delete_samples(0, 10000, ind1, 0)
save_sound_as("fmv.snd", ind1, :edit_position, 0)
- save_sound_as("fmv1.snd", ind1, :edit_position, lambda do |snd, chn| 1 end)
+ save_sound_as("fmv1.snd", ind1, :edit_position, 1)
if (res = Snd.catch do
- save_sound_as("fmv2.snd", ind1, :channel, 1234)
- end).first != :no_such_channel
- snd_display("save_sound_as bad chan: %s", res)
+ save_sound_as("fmv2.snd", ind1, :channel, 1234)
+ end).first != :no_such_channel
+ snd_display("save_sound_as bad chan: %s", res)
end
- if (res0 = mus_sound_frames("fmv.snd")) != (res1 = frames(ind1, 0, 0))
+ if (res0 = mus_sound_framples("fmv.snd")) != (res1 = framples(ind1, 0, 0))
snd_display("save_sound_as (edpos): %s %s?", res0, res1)
end
- if (res0 = mus_sound_frames("fmv1.snd")) != (res1 = frames(ind1, 0, 1))
+ if (res0 = mus_sound_framples("fmv1.snd")) != (res1 = framples(ind1, 0, 1))
snd_display("save_sound_as (edpos 1): %s %s?", res0, res1)
end
- if (res0 = mus_sound_frames("fmv.snd")) == (res1 = frames(ind1, 0, 1))
+ if (res0 = mus_sound_framples("fmv.snd")) == (res1 = framples(ind1, 0, 1))
snd_display("save_sound_as (edpos 1)(2): %s %s?", res0, res1)
end
ind2 = open_sound("fmv.snd")
@@ -9046,7 +8679,8 @@ def test_05_20
res1 = channel2vct(12000, 10, ind3, 0))
snd_display("save_sound_as (edpos 4): %s %s?", res0, res1)
end
- if vequal(res0 = channel2vct(12000, 10, ind2), res1 = channel2vct(12000, 10, ind3, 0))
+ if vequal(res0 = channel2vct(12000, 10, ind2),
+ res1 = channel2vct(12000, 10, ind3, 0))
snd_display("save_sound_as (edpos 5): %s %s?", res0, res1)
end
select_sound(ind3)
@@ -9068,14 +8702,18 @@ def test_05_20
src_sound(0.5, 1.0, snd, 0, pos)
end
test_edpos_1(:filter_sound, ind1) do |snd, pos|
- filter_sound(make_fir_filter(6, vct(0.1, 0.2, 0.3, 0.3, 0.2, 0.1)), 6, snd, 0, pos)
+ filter_sound(make_fir_filter(6, vct(0.1, 0.2, 0.3, 0.3, 0.2, 0.1)),
+ 6, snd, 0, pos)
end
test_edpos_1(:convolve_with, ind1) do |snd, pos|
convolve_with("pistol.snd", 0.5, snd, 0, pos)
end
#
ind = new_sound("fmv.snd")
- v = make_vct!(2000) do |i| sin(i * (PI / 5.0)) end
+ e = make_env([0.0, 0.0, 1.0, 2000 * 0.2 * PI], :length, 2001)
+ v = make_vct!(2000) do |i|
+ sin(env(e))
+ end
vct2channel(v, 0, 2000, ind, 0)
filter_sound([0, 0, 0.09, 0, 0.1, 1, 0.11, 0, 1, 0], 1024)
if maxamp > 0.025
@@ -9094,7 +8732,8 @@ def test_05_20
old_ssc = show_sonogram_cursor
old_tgt = transform_graph_type
set_show_sonogram_cursor(true)
- set_cursor_follows_play(true)
+ set_with_tracking_cursor(true)
+ snd_test_neq(with_tracking_cursor(), true, "with_tracking_cursor set to true")
set_transform_graph_type(Graph_as_sonogram)
play(selected_sound, :wait, true)
set_transform_graph?(true)
@@ -9107,7 +8746,7 @@ end
def peak_env_equal?(name, index, e, diff)
rd = make_sampler(0, index, 0)
e_size = e.first.length
- samps_per_bin = (frames(index) / e_size.to_f).ceil
+ samps_per_bin = (framples(index) / e_size.to_f).ceil
mins, maxs = e[0, 2]
max_diff = 0.0
e_bin = 0
@@ -9175,16 +8814,18 @@ def test_05_22
set_selection_member?(false, true)
set_selection_member?(true, ind, 0)
set_selection_position(20000, ind, 0)
- set_selection_frames(12000, ind, 0)
+ set_selection_framples(12000, ind, 0)
scale_selection_by(3.0)
e1 = channel_amp_envs(ind, 0, 1)
mx3 = vct_peak(e1[0])
mx4 = vct_peak(e1[1])
if fneq(3.0 * mx1, mx3) or fneq(3.0 * mx2, mx4)
- snd_display("selection 3.0 amp env max: %s %s %s %s?", mx1, mx2, mx3, mx4)
+ snd_display("selection 3.0 amp env max: %s %s %s %s?",
+ mx1, mx2, mx3, mx4)
end
if fneq(maxamp(ind, 0), 3.0 * mx)
- snd_display("maxamp after selection scale: %s %s?", mx, maxamp(ind, 0))
+ snd_display("maxamp after selection scale: %s %s?",
+ mx, maxamp(ind, 0))
end
peak_env_equal?("selection peak", ind, e1, 0.0001)
#
@@ -9193,10 +8834,12 @@ def test_05_22
mx3 = vct_peak(e1[0])
mx4 = vct_peak(e1[1])
if fneq(3.0 * mx2, mx4)
- snd_display("abs selection 3.0 amp env max: %s %s %s %s?", mx1, mx2, mx3, mx4)
+ snd_display("abs selection 3.0 amp env max: %s %s %s %s?",
+ mx1, mx2, mx3, mx4)
end
if fneq(maxamp(ind, 0), 3.0 * mx)
- snd_display("maxamp after abs selection scale: %s %s?", mx, maxamp(ind, 0))
+ snd_display("maxamp after abs selection scale: %s %s?",
+ mx, maxamp(ind, 0))
end
peak_env_equal?("map_chan peak", ind, e1, 0.0001)
#
@@ -9205,10 +8848,12 @@ def test_05_22
mx3 = vct_peak(e1[0])
mx4 = vct_peak(e1[1])
if fneq(3.0 * mx2, mx4)
- snd_display("abs selection 3.0 amp env max: %s %s %s %s?", mx1, mx2, mx3, mx4)
+ snd_display("abs selection 3.0 amp env max: %s %s %s %s?",
+ mx1, mx2, mx3, mx4)
end
if fneq(maxamp(ind, 0), 3.0 * mx)
- snd_display("maxamp after abs selection scale: %s %s?", mx, maxamp(ind, 0))
+ snd_display("maxamp after abs selection scale: %s %s?",
+ mx, maxamp(ind, 0))
end
peak_env_equal?("delete peak", ind, e1, 0.0001)
#
@@ -9216,7 +8861,8 @@ def test_05_22
e1 = channel_amp_envs(ind, 0, 4)
mx3 = vct_peak(e1[0])
if fneq(maxamp(ind, 0), mx)
- snd_display("maxamp after minus selection scale: %s %s?", mx, maxamp(ind, 0))
+ snd_display("maxamp after minus selection scale: %s %s?",
+ mx, maxamp(ind, 0))
end
if fneq(maxamp(ind, 0), mx3)
snd_display("mx3 maxamp after minus abs selection scale: %s %s?", mx, mx3)
@@ -9230,87 +8876,117 @@ def test_05_22
env_channel([0, 0, 1, 1, 2, 0])
peak_env_equal?("env_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.002)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0], :scaler, 0.5, :length, frames))
- peak_env_equal?("scaled env_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.002)
+ env_channel(make_env([0, 0, 1, 1, 2, 0], :scaler, 0.5, :length, framples))
+ peak_env_equal?("scaled env_channel peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.002)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0], 0.5, :length, frames))
- peak_env_equal?("scaled nokey env_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.001)
+ env_channel(make_env([0, 0, 1, 1, 2, 0], 0.5, :length, framples))
+ peak_env_equal?("scaled nokey env_channel peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.001)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0], :scaler, 0.5, :offset, 0.5, :length, frames))
- peak_env_equal?("scaled and offset env_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.001)
+ env_channel(make_env([0, 0, 1, 1, 2, 0],
+ :scaler, 0.5, :offset, 0.5, :length, framples))
+ peak_env_equal?("scaled and offset env_channel peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.001)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0.5, 3, 0], :base, 0.0, :length, frames))
- peak_env_equal?("env_channel base 0.0 peak", ind, channel_amp_envs(ind, 0, 1), 0.001)
+ env_channel(make_env([0, 0, 1, 1, 2, 0.5, 3, 0],
+ :base, 0.0, :length, framples))
+ peak_env_equal?("env_channel base 0.0 peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.001)
undo_edit
xramp_channel(0.0, 1.0, 32.0)
- peak_env_equal?("xramp_channel 32.0 peak", ind, channel_amp_envs(ind, 0, 1), 0.008)
+ peak_env_equal?("xramp_channel 32.0 peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.008)
undo_edit
xramp_channel(0.0, 1.0, 0.032)
- peak_env_equal?("xramp_channel 0.032 peak", ind, channel_amp_envs(ind, 0, 1), 0.004)
+ peak_env_equal?("xramp_channel 0.032 peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.004)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0.5, 3, 0], :base, 10.0, :length, frames))
- peak_env_equal?("env_channel base 10.0 peak", ind, channel_amp_envs(ind, 0, 1), 0.01)
+ env_channel(make_env([0, 0, 1, 1, 2, 0.5, 3, 0],
+ :base, 10.0, :length, framples))
+ peak_env_equal?("env_channel base 10.0 peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.01)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0], :base, 0.1, :length, frames))
- peak_env_equal?("env_channel base 0.1 peak", ind, channel_amp_envs(ind, 0, 1), 0.003)
+ env_channel(make_env([0, 0, 1, 1, 2, 0], :base, 0.1, :length, framples))
+ peak_env_equal?("env_channel base 0.1 peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.003)
undo_edit
insert_samples(1000, 5000, make_vct(5000, 0.5))
- peak_env_equal?("insert_samples peak", ind, channel_amp_envs(ind, 0, 1), 0.0001)
+ peak_env_equal?("insert_samples peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.0001)
undo_edit
set_samples(500, 100, make_vct(100, 0.1))
- peak_env_equal?("set_samples peak", ind, channel_amp_envs(ind, 0, 1), 0.0001)
+ peak_env_equal?("set_samples peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.0001)
undo_edit
#
revert_sound(ind)
ramp_channel(0.0, 1.0)
ramp_channel(1.0, 0.0)
- peak_env_equal?("2 ramp_channel peak", ind, channel_amp_envs(ind, 0, 2), 0.002)
+ peak_env_equal?("2 ramp_channel peak",
+ ind, channel_amp_envs(ind, 0, 2), 0.002)
#
revert_sound(ind)
env_channel([0, 0, 1, 1])
env_channel([0, 0, 1, 1, 2, 0])
- peak_env_equal?("2 env_channel peak", ind, channel_amp_envs(ind, 0, 2), 0.002)
+ peak_env_equal?("2 env_channel peak",
+ ind, channel_amp_envs(ind, 0, 2), 0.002)
revert_sound(ind)
ramp_channel(0.0, 1.0, 12000, 5000)
- peak_env_equal?("ramp_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.002)
+ peak_env_equal?("ramp_channel peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.002)
undo_edit
env_channel([0, 0, 1, 1, 2, 0], 12000, 5000)
- peak_env_equal?("env_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.003)
+ peak_env_equal?("env_channel peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.003)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0], :scaler, 0.5, :length, 5000), 12000, 5000)
- peak_env_equal?("scaled env_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.004)
+ env_channel(make_env([0, 0, 1, 1, 2, 0],
+ :scaler, 0.5, :length, 5000), 12000, 5000)
+ peak_env_equal?("scaled env_channel peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.004)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0], 0.5, :length, 5000), 12000, 5000)
- peak_env_equal?("scaled nokey env_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.004)
+ env_channel(make_env([0, 0, 1, 1, 2, 0],
+ 0.5, :length, 5000), 12000, 5000)
+ peak_env_equal?("scaled nokey env_channel peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.004)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0], :scaler, 0.5, :offset, 0.5, :length, 5000), 12000, 5000)
- peak_env_equal?("scaled and offset env_channel peak", ind, channel_amp_envs(ind, 0, 1), 0.002)
+ env_channel(make_env([0, 0, 1, 1, 2, 0],
+ :scaler, 0.5, :offset, 0.5, :length, 5000), 12000, 5000)
+ peak_env_equal?("scaled and offset env_channel peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.002)
undo_edit
xramp_channel(0.0, 1.0, 32.0, 2000, 1000)
- peak_env_equal?("xramp_channel 32.0 peak (1)", ind, channel_amp_envs(ind, 0, 1), 0.009)
+ peak_env_equal?("xramp_channel 32.0 peak (1)",
+ ind, channel_amp_envs(ind, 0, 1), 0.009)
undo_edit
xramp_channel(0.0, 1.0, 0.032, 2000, 1000)
- peak_env_equal?("xramp_channel 0.032 peak (1)", ind, channel_amp_envs(ind, 0, 1), 0.01)
+ peak_env_equal?("xramp_channel 0.032 peak (1)",
+ ind, channel_amp_envs(ind, 0, 1), 0.01)
undo_edit
- env_channel(make_env([0, 0, 1, 1, 2, 0.5, 3, 0], :base, 10.0, :length, 5000), 12000, 5000)
- peak_env_equal?("env_channel base 10.0 peak", ind, channel_amp_envs(ind, 0, 1), 0.1)
+ env_channel(make_env([0, 0, 1, 1, 2, 0.5, 3, 0],
+ :base, 10.0, :length, 5000), 12000, 5000)
+ peak_env_equal?("env_channel base 10.0 peak",
+ ind, channel_amp_envs(ind, 0, 1), 0.1)
undo_edit
#
revert_sound(ind)
ramp_channel(0.0, 1.0)
ramp_channel(1.0, 0.0, 2000, 1000)
- peak_env_equal?("2 ramp_channel peak", ind, channel_amp_envs(ind, 0, 2), 0.002)
+ peak_env_equal?("2 ramp_channel peak",
+ ind, channel_amp_envs(ind, 0, 2), 0.002)
#
revert_sound(ind)
env_channel([0, 0, 1, 1])
env_channel([0, 0, 1, 1, 2, 0], 2000, 1000)
- peak_env_equal?("2 env_channel peak", ind, channel_amp_envs(ind, 0, 2), 0.002)
+ peak_env_equal?("2 env_channel peak",
+ ind, channel_amp_envs(ind, 0, 2), 0.002)
#
revert_sound(ind)
env_channel([0, 0, 1, 1])
env_channel([0, 0, 1, 1, 2, 0])
env_channel([0, 0, 1, 1], 12000, 5000)
- peak_env_equal?("3 env_channel peak", ind, channel_amp_envs(ind, 0, 3), 0.01)
+ peak_env_equal?("3 env_channel peak",
+ ind, channel_amp_envs(ind, 0, 3), 0.01)
revert_sound(ind)
close_sound(ind)
#
@@ -9348,7 +9024,7 @@ end
$g_init_val = 0
def test_channel_func(name, index, init_val, func, &val_func)
- len = frames(index)
+ len = framples(index)
chns = chans(index)
$g_init_val = init_val
2.times do |k|
@@ -9356,7 +9032,8 @@ def test_channel_func(name, index, init_val, func, &val_func)
set_sync(k, index)
chns.times do |i|
map_channel(lambda do |n| 0.0 end, 0, len, index, i)
- if res = scan_channel(lambda do |n| n.abs > 0.001 end, 0, len, index, i)
+ res = scan_channel(lambda do |n| n.abs > 0.001 end, 0, len, index, i)
+ if res
snd_display("%s init scan: %s?", name, res)
end
end
@@ -9370,7 +9047,8 @@ def test_channel_func(name, index, init_val, func, &val_func)
snd_display("%s chan func: %s %s?", name, vi, val)
end
else
- if res = scan_channel(lambda do |n| n.abs > 0.001 end, 0, len, index, j)
+ res = scan_channel(lambda do |n| n.abs > 0.001 end, 0, len, index, j)
+ if res
snd_display("%s chan func leaks? %s %s: %s", name, i, j, res)
end
end
@@ -9389,8 +9067,10 @@ def test_channel_func(name, index, init_val, func, &val_func)
snd_display("%s ed chan func: %s %s?", name, vi, val)
end
else
- if res = scan_channel(lambda do |n| n.abs > 0.001 end, 0, len, index, j)
- snd_display("%s ed chan func leaks? %s %s %s: %s", name, i, j, ed, res)
+ res = scan_channel(lambda do |n| n.abs > 0.001 end, 0, len, index, j)
+ if res
+ snd_display("%s ed chan func leaks? %s %s %s: %s",
+ name, i, j, ed, res)
end
end
end
@@ -9415,7 +9095,8 @@ def test_channel_func(name, index, init_val, func, &val_func)
snd_display("%s chan func n: %s %s?", name, vi, val)
end
else
- if res = scan_channel(lambda do |n| n.abs > 0.001 end, 0, len, index, j)
+ res = scan_channel(lambda do |n| n.abs > 0.001 end, 0, len, index, j)
+ if res
snd_display("%s dur chan func leaks? %s %s: %s", name, i, j, res)
end
end
@@ -9426,12 +9107,13 @@ def test_channel_func(name, index, init_val, func, &val_func)
end
def test_05_23
- index = new_sound("fmv.snd", Mus_next, Mus_bshort, 22050, 2, "channel tests")
+ index = new_sound("fmv.snd", 2, 22050, Mus_bshort, Mus_next, "channel tests")
insert_silence(0, 10, index, 0)
insert_silence(0, 10, index, 1)
test_channel_func(:env, index, 0.0,
lambda do |beg, dur, index, chan, edpos|
- clm_channel(make_env(:envelope, [0, 0, 1, 1], :length, dur),
+ clm_channel(make_env(:envelope, [0, 0, 1, 1],
+ :length, dur),
beg, dur, index, chan, edpos)
end) do |dur|
e = make_env(:envelope, [0, 0, 1, 1], :length, dur)
@@ -9439,7 +9121,8 @@ def test_05_23
end
test_channel_func(:oscil, index, 0.0,
lambda do |beg, dur, index, chan, edpos|
- clm_channel(make_oscil(:frequency, 0.0, :initial_phase, PI / 2.0),
+ clm_channel(make_oscil(:frequency, 0.0,
+ :initial_phase, PI / 2.0),
beg, dur, index, chan, edpos)
end) do |dur| make_vct!(dur) do 1.0 end end
test_channel_func(:scale_channel, index, 1.0,
@@ -9448,7 +9131,8 @@ def test_05_23
end) do |dur| make_vct!(dur) do 0.5 end end
test_channel_func(:env_channel, index, 1.0,
lambda do |beg, dur, index, chan, edpos|
- env_channel(make_env(:envelope, [0, 0, 1, 1], :length, dur),
+ env_channel(make_env(:envelope, [0, 0, 1, 1],
+ :length, dur),
beg, dur, index, chan, edpos)
end) do |dur|
e = make_env(:envelope, [0, 0, 1, 1], :length, dur)
@@ -9463,18 +9147,26 @@ def test_05_23
end
test_channel_func(:vct2channel, index, 1.0,
lambda do |beg, dur, index, chan, edpos|
- vct2channel(make_vct!(dur) do -1.0 end, beg, dur, index, chan)
- end) do |dur| make_vct!(dur) do -1.0 end end
+ vct2channel(make_vct!(dur) do -1.0 end,
+ beg, dur, index, chan)
+ end) do |dur|
+ make_vct!(dur) do -1.0 end
+ end
test_channel_func(:pad_channel, index, 1.0,
lambda do |beg, dur, index, chan, edpos|
delete_samples(beg, dur, index, chan, edpos)
pad_channel(beg, dur, index, chan, edpos)
- end) do |dur| make_vct(dur) end
+ end) do |dur|
+ make_vct(dur)
+ end
test_channel_func(:insert_samples, index, 1.0,
lambda do |beg, dur, index, chan, edpos|
delete_samples(beg, dur, index, chan, edpos)
- insert_samples(beg, dur, make_vct!(dur) do -1.0 end, index, chan, edpos)
- end) do |dur| make_vct!(dur) do -1.0 end end
+ insert_samples(beg, dur, make_vct!(dur) do -1.0 end,
+ index, chan, edpos)
+ end) do |dur|
+ make_vct!(dur) do -1.0 end
+ end
test_channel_func(:set_samples, index, 1.0,
lambda do |beg, dur, index, chan, edpos|
set_samples(beg, dur, make_vct!(dur) do -1.0 end,
@@ -9482,7 +9174,8 @@ def test_05_23
end) do |dur| make_vct!(dur) do -1.0 end end
test_channel_func(:reverse_channel, index, 1.0,
lambda do |beg, dur, index, chan, edpos|
- env_channel(make_env(:envelope, [0, 0, 1, 1], :length, dur),
+ env_channel(make_env(:envelope, [0, 0, 1, 1],
+ :length, dur),
beg, dur, index, chan, edpos)
reverse_channel(beg, dur, index, chan)
end) do |dur|
@@ -9491,7 +9184,8 @@ def test_05_23
end
test_channel_func(:smooth_channel, index, 1.0,
lambda do |beg, dur, index, chan, edpos|
- env_channel(make_env(:envelope, [0, 0, 1, 1], :length, dur),
+ env_channel(make_env(:envelope, [0, 0, 1, 1],
+ :length, dur),
beg, dur, index, chan, edpos)
set_sample(beg + dur, 1.0, index, chan)
smooth_channel(beg, dur, index, chan)
@@ -9504,7 +9198,7 @@ def test_05_23
#
old_max = maxamp(index, true)
regdata = Snd.regions.map do |n| region2vct(n, 0, 10) end
- old_reglen = Snd.regions.map do |n| region_frames(n) end
+ old_reglen = Snd.regions.map do |n| region_framples(n) end
s61_files = []
$save_state_hook.add_hook!("snd-test") do |file|
s61_files.push(file)
@@ -9515,12 +9209,16 @@ def test_05_23
close_sound(index)
Snd.regions.apply(:forget_region)
load("s61.rb")
- if (res = Snd.regions.map do |n| region_frames(n) end) != old_reglen
- snd_display("region_frames after save: %s %s?", old_reglen, res)
+ if (res = Snd.regions.map do |n| region_framples(n) end) != old_reglen
+ snd_display("region_framples after save: %s %s?", old_reglen, res)
end
- Snd.regions.zip(regdata) do |n, data|
- unless vequal(res = region2vct(n, 0, 10), data)
- snd_display("region after save %s: %s %s?", n, data, res)
+ Snd.catch(:all, lambda do |*args|
+ snd_display("region2vct: %s", args.inspect)
+ end) do
+ Snd.regions.zip(regdata) do |n, data|
+ unless vequal(res = region2vct(n, 0, 10), data)
+ snd_display("region after save %s: %s %s?", n, data, res)
+ end
end
end
index = find_sound("fmv.snd")
@@ -9532,7 +9230,7 @@ def test_05_23
end
10.times do |i|
pos = random(edits(index).first)
- scale_channel(random(2.0).abs, random(5.0), random(5.0), index, 0, pos)
+ scale_channel(random(2.0), random(5), random(5), index, 0, pos)
set_edit_position((edits(index).first * 0.7).floor, index)
end
close_sound(index)
@@ -9543,7 +9241,7 @@ def test_05_23
end
def test_05_24
- index = new_sound("fmv.snd", Mus_next, Mus_bshort, 22050, 2, "channel tests")
+ index = new_sound("fmv.snd", 2, 22050, Mus_bshort, Mus_next, "channel tests")
sw = sinc_width
set_sinc_width(10)
v0 = make_vct(10)
@@ -9563,21 +9261,22 @@ def test_05_24
unless vequal(res = channel2vct(0, 10, index, 1), make_vct(10))
snd_display("src_channel leaks: %s?", res)
end
- if (res = Snd.catch do src(s, 1.0, lambda do |a, b| a end) end).first != :bad_arity
- snd_display("src bad func: %s?", res.inspect)
- end
- if (res = Snd.catch do src_channel(120000.0) end).first != :mus_error
+ res = Snd.catch do src_channel(120000.0) end
+ if res.first != :mus_error
snd_display("src_channel crazy srate: %s?", res.inspect)
end
- if (res = Snd.catch do filter_sound(make_snd2sample()) end).first != :mus_error
- snd_display("filter_sound + un-run gen: %s?", res.inspect) # not relevant in Ruby?
+ res = Snd.catch do filter_sound(make_snd2sample()) end
+ if res.first != :mus_error
+ # not relevant in Ruby?
+ snd_display("filter_sound + un-run gen: %s?", res.inspect)
end
revert_sound(index)
vct2channel(v0, 0, 10, index, 1)
vct2channel(v0, 10, 10, index, 1)
src_channel(make_env(:envelope, [1, 1, 2, 2], :length, 21), 0, 20, index, 1)
unless vequal(res = channel2vct(0, 10, index, 1),
- vct(1.000, 0.000, -0.048, 0.068, -0.059, 0.022, 0.030, -0.100, 0.273, 0.606))
+ vct(1.000, 0.000, -0.048, 0.068, -0.059,
+ 0.022, 0.030, -0.100, 0.273, 0.606))
snd_display("src_channel env: %s?", res)
end
unless vequal(res = channel2vct(0, 10, index, 0), make_vct(10))
@@ -9589,7 +9288,8 @@ def test_05_24
vct2channel(v0, 10, 10, index, 1)
src_channel(make_env(:envelope, [1, 1, 2, 2], :length, 21), 0, 20, index, 1)
unless vequal(res = channel2vct(0, 10, index, 1),
- vct(1.000, 0.000, -0.048, 0.068, -0.059, 0.022, 0.030, -0.100, 0.273, 0.606))
+ vct(1.000, 0.000, -0.048, 0.068, -0.059,
+ 0.022, 0.030, -0.100, 0.273, 0.606))
snd_display("src_channel env: %s?", res)
end
unless vequal(res = channel2vct(0, 10, index, 0), make_vct(10))
@@ -9601,7 +9301,8 @@ def test_05_24
vct2channel(v0, 10, 10, index, 1)
src_channel([1, 1, 2, 2], 0, 20, index, 1)
unless vequal(res = channel2vct(0, 10, index, 1),
- vct(1.000, 0.000, -0.051, 0.069, -0.056, 0.015, 0.042, -0.117, 0.320, 0.568))
+ vct(1.000, 0.000, -0.051, 0.069, -0.056,
+ 0.015, 0.042, -0.117, 0.320, 0.568))
snd_display("src_channel lst: %s?", res)
end
unless vequal(res = channel2vct(0, 10, index, 0), make_vct(10))
@@ -9621,7 +9322,8 @@ def test_05_25
snd_display("deferred region after scaling:\n# %s\n# %s", rid0_data, res)
end
unless vequal(res = region_to_vct(rid0, 0, 20), rid0_data)
- snd_display("deferred region after scaling (rs):\n# %s\n# %s", rid0_data, res)
+ snd_display("deferred region after scaling (rs):\n# %s\n# %s",
+ rid0_data, res)
end
undo_edit
scale_by(4.0)
@@ -9658,10 +9360,10 @@ def test_05_25
set_selection_member?(false, true)
set_selection_member?(true, ind, 0)
set_selection_position(s1, ind, 0)
- set_selection_frames(l1, ind, 0)
+ set_selection_framples(l1, ind, 0)
set_selection_member?(true, ind, 1)
set_selection_position(s2, ind, 1)
- set_selection_frames(l2, ind, 1)
+ set_selection_framples(l2, ind, 1)
rid2 = make_region
rid20_data = region2vct_1(rid2, 0, l1)
rid21_data = region2vct_1(rid2, 1, l2)
@@ -9670,26 +9372,33 @@ def test_05_25
end
swap_channels(ind, 0, ind, 1)
unless vequal(res = region2vct_1(rid2, 0, l1), rid20_data)
- snd_display("deferred region after scaling (20):\n# %s\n# %s", rid20_data, res)
+ snd_display("deferred region after scaling (20):\n# %s\n# %s",
+ rid20_data, res)
end
unless vequal(res = region_to_vct(rid2, 0, l1), rid20_data)
- snd_display("deferred region after scaling (20 rs):\n# %s\n# %s", rid20_data, res)
+ snd_display("deferred region after scaling (20 rs):\n# %s\n# %s",
+ rid20_data, res)
end
unless vequal(res = region2vct_1(rid2, 1, l2), rid21_data)
- snd_display("deferred region after scaling (21):\n# %s\n# %s", rid21_data, res)
+ snd_display("deferred region after scaling (21):\n# %s\n# %s",
+ rid21_data, res)
end
unless vequal(res = region_to_vct(rid2, 1, l2), rid21_data)
- snd_display("deferred region after scaling (21 rs):\n# %s\n# %s", rid21_data, res)
+ snd_display("deferred region after scaling (21 rs):\n# %s\n# %s",
+ rid21_data, res)
end
close_sound(ind)
unless vequal(res = region2vct_1(rid2, 0, l1), rid20_data)
- snd_display("deferred region after scaling (20):\n# %s\n# %s", rid20_data, res)
+ snd_display("deferred region after scaling (20):\n# %s\n# %s",
+ rid20_data, res)
end
unless vequal(res = region_to_vct(rid2, 0, l1), rid20_data)
- snd_display("deferred region after scaling (20 rs):\n# %s\n# %s", rid20_data, res)
+ snd_display("deferred region after scaling (20 rs):\n# %s\n# %s",
+ rid20_data, res)
end
unless vequal(res = region2vct_1(rid2, 1, l2), rid21_data)
- snd_display("deferred region after scaling (21):\n# %s\n# %s", rid21_data, res)
+ snd_display("deferred region after scaling (21):\n# %s\n# %s",
+ rid21_data, res)
end
unless vequal(res = region_to_vct(rid2, 1, l2), rid21_data)
snd_display("deferred region after scaling (21 rs):\n# %s\n# %s",
@@ -9699,58 +9408,31 @@ def test_05_25
ind = open_sound("obtest.snd")
set_read_only(true, ind)
delete_samples(0, 1000, ind, 0)
- if integer?((res = Snd.catch do save_sound(ind) end).first)
+ res = Snd.catch do save_sound(ind) end
+ if sound?(res.first)
snd_display("save_sound read_only: %s", res)
end
- if (res = edits(ind)) != [1, 0]
- snd_display("read_only ignored: %s?", res)
- end
+ snd_test_neq(edits(ind), [1, 0], "read_only ignored")
set_read_only(false, ind)
revert_sound(ind)
- unless sound?((res = Snd.catch do save_sound(ind) end).first)
+ res = Snd.catch do save_sound(ind) end
+ unless sound?(res.first)
snd_display("save_sound read_write: %s", res)
end
key(key_to_int(?j), 4)
- if $with_test_gui
- if (res = widget_text(sound_widgets(ind)[3])) != "no marks" and res != "no such mark"
- snd_display("C-j w/o marks: %s?", res)
- end
- end
key(key_to_int(?-), 4)
key(key_to_int(?j), 4)
key(key_to_int(?j), 4)
key(key_to_int(?x), 4)
key(key_to_int(?c), 0)
- if $with_test_gui
- if (res = widget_text(main_widgets[1]))
- snd_display("widget_text of non-text widget: %s", res)
- end
- set_widget_text(channel_widgets(ind, 0)[2], "F")
- if (res = widget_text(channel_widgets(ind, 0)[2])) != "F"
- snd_display("set button label to F: %s?", res)
- end
- if (res = widget_text(sound_widgets(ind)[3])) != "no marks" and res != "no such mark"
- snd_display("C-x c w/o marks: %s?", res)
- end
- end
- add_mark(123)
+ Snd.catch do add_mark(123) end
key(key_to_int(?u), 4)
key(key_to_int(?6), 4)
key(key_to_int(?j), 4)
- if $with_test_gui
- if (res = widget_text(sound_widgets(ind)[3])) != "no such mark"
- snd_display("C-u 6 C-j: %s?", res)
- end
- end
key(key_to_int(?u), 4)
key(key_to_int(?6), 4)
key(key_to_int(?x), 4)
key(key_to_int(?c), 0)
- if $with_test_gui
- if (res = widget_text(sound_widgets(ind)[3])) != "no such mark"
- snd_display("C-u 6 C-x c: %s?", res)
- end
- end
close_sound(ind)
#
ns = new_sound
@@ -9762,9 +9444,9 @@ def test_05_25
vct2channel(v, 0, 1000, ns, 0)
set_selection_member?(true, ns, 0)
set_selection_position(200, ns, 0)
- set_selection_frames(300, ns, 0)
+ set_selection_framples(300, ns, 0)
delete_selection_and_smooth
- snd_test_neq(frames(ns, 0), 700, "delete_selection_and_smooth frames")
+ snd_test_neq(framples(ns, 0), 700, "delete_selection_and_smooth framples")
snd_test_neq(sample(167, ns, 0), 0.167, "delete_selection_and_smooth 167")
snd_test_neq(sample(234, ns, 0), 0.534, "delete_selection_and_smooth 234")
snd_test_neq(sample(210, ns, 0), 0.406, "delete_selection_and_smooth 210")
@@ -9782,12 +9464,8 @@ def test_05_25
mindiff = diff
end
end
- if mindiff < 0.0009
- snd_display(snd_format(mindiff, 0.0009, "<", "delete_selection_and_smooth min diff"))
- end
- if maxdiff > 0.007
- snd_display(snd_format(maxdiff, 0.007, ">", "delete_selection_and_smooth max diff"))
- end
+ snd_test_lt(mindiff, 0.0009, "delete_selection_and_smooth min diff")
+ snd_test_gt(maxdiff, 0.007, "delete_selection_and_smooth max diff")
close_sound(ns)
#
ns = new_sound
@@ -9798,7 +9476,7 @@ def test_05_25
end
vct2channel(v, 0, 1000, ns, 0)
delete_samples_and_smooth(200, 300, ns, 0)
- snd_test_neq(frames(ns, 0), 700, "delete_samples_and_smooth frames")
+ snd_test_neq(framples(ns, 0), 700, "delete_samples_and_smooth framples")
snd_test_neq(sample(167, ns, 0), 0.167, "delete_samples_and_smooth 167")
snd_test_neq(sample(234, ns, 0), 0.534, "delete_samples_and_smooth 234")
snd_test_neq(sample(210, ns, 0), 0.406, "delete_samples_and_smooth 210")
@@ -9816,23 +9494,37 @@ def test_05_25
mindiff = diff
end
end
- if mindiff < 0.0009
- snd_display(snd_format(mindiff, 0.0009, "<", "delete_samples_and_smooth min diff"))
- end
- if maxdiff > 0.007
- snd_display(snd_format(maxdiff, 0.007, ">", "delete_samples_and_smooth max diff"))
- end
+ snd_test_lt(mindiff, 0.0009, "delete_samples_and_smooth min diff")
+ snd_test_gt(maxdiff, 0.007, "delete_samples_and_smooth max diff")
close_sound(ns)
#
old_beg = initial_beg
old_dur = initial_dur
old_show = show_full_duration
$initial_graph_hook.reset_hook!
+ #
+ set_show_full_range(true)
+ ns = open_sound("1a.snd")
+ snd_test_neq(y_bounds(ns, 0), [-1.0, 1.0], "show_full_range 1.0 test")
+ close_sound(ns)
+ with_sound(:output, "test.snd", :clipped, false) do
+ fm_violin(0, 1, 440, 3.5)
+ end
+ ns = open_sound("test.snd")
+ snd_test_neq(y_bounds(ns, 0), [-3.5, 3.5], "show_full_range 3.5 test")
+ with_sound(:output, "test.snd", :clipped, false) do
+ fm_violin(0, 1, 440, 1.5)
+ end
+ update_sound(ns = find_sound("test.snd"))
+ snd_test_neq(y_bounds(ns, 0), [-1.5, 1.5], "show_full_range 1.5 test")
+ close_sound(ns)
+ set_show_full_range(false)
+ #
set_show_full_duration(true)
ns = open_sound("1.snd")
ls = left_sample(ns, 0)
rs = right_sample(ns, 0)
- fr = frames(ns, 0)
+ fr = framples(ns, 0)
snd_test_neq([fr, ls, rs], [220501, 0, 220501], "show_full_duration 1")
close_sound(ns)
set_show_full_duration(true)
@@ -9841,7 +9533,7 @@ def test_05_25
ns = open_sound("1.snd")
ls = left_sample(ns, 0)
rs = right_sample(ns, 0)
- fr = frames(ns, 0)
+ fr = framples(ns, 0)
snd_test_neq([fr, ls, rs], [220501, 0, 220501], "show_full_duration 2")
close_sound(ns)
set_show_full_duration(false)
@@ -9850,7 +9542,7 @@ def test_05_25
ns = open_sound("1.snd")
ls = left_sample(ns, 0)
rs = right_sample(ns, 0)
- fr = frames(ns, 0)
+ fr = framples(ns, 0)
snd_test_neq([fr, ls, rs], [220501, 0, 4410], "show_full_duration 3")
close_sound(ns)
set_initial_beg(2.0)
@@ -9858,7 +9550,7 @@ def test_05_25
ns = open_sound("1.snd")
ls = left_sample(ns, 0)
rs = right_sample(ns, 0)
- fr = frames(ns, 0)
+ fr = framples(ns, 0)
snd_test_neq([fr, ls, rs], [220501, 44100, 66150], "show_full_duration 4")
close_sound(ns)
set_initial_beg(old_beg)
@@ -9871,36 +9563,22 @@ def test_05_25
set_sync(1, ns)
set_sync_style(Sync_by_sound)
ns1 = open_sound("1a.snd")
- snd_test_eq(sync(ns1), 0, "Sync_by_sound open")
snd_test_eq(sync(ns1), 1, "Sync_by_sound open")
snd_test_neq(sync(ns), 1, "Sync_by_sound open")
close_sound(ns1)
close_sound(ns)
- set_sync_style(Sync_all)
- ns = open_sound("2.snd")
- ns1 = open_sound("1a.snd")
- snd_test_neq(sync(ns), sync(ns1), "Sync_all open")
- snd_test_eq(sync(ns), 0, "Sync_all open")
- set_sync_style(Sync_none)
- ns2 = open_sound("oboe.snd")
- snd_test_neq(sync(ns), sync(ns1), "back to Sync_none open")
- snd_test_neq(sync(ns2), 0, "back to Sync_none open")
- close_sound(ns2)
- close_sound(ns1)
- close_sound(ns)
set_sync_style(old_sync)
#
- view_sound("obtest.snd")
+ ind = view_sound("obtest.snd")
delete_samples(0, 1000, ind, 0)
- if integer?((res = Snd.catch do save_sound(ind) end).first)
+ res = Snd.catch do save_sound(ind) end
+ if sound?(res.first)
snd_display("save_viewed_sound: %s", res)
end
- if (res = edits(ind)) != [1, 0]
- snd_display("view read_only ignored: %s?", res)
- end
+ snd_test_neq(edits(ind), [1, 0], "view read_only ignored")
close_sound(ind)
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next)
insert_silence(0, 150000)
map_channel(lambda do |y| 0.5 end)
env_sound([0, 0, 1, 1, 2, 0])
@@ -9911,54 +9589,54 @@ def test_05_25
set_with_tracking_cursor(old_cursor)
close_sound(ind)
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next)
[150, 1500, 150000].each do |dur|
insert_silence(0, dur)
map_channel($init_channel)
env_sound([0, 0, 1, 1, 2, 0])
- rd = make_sampler(frames - 1, ind, 0, -1)
- if (res = sampler_position(rd)) != (frames - 1)
+ rd = make_sampler(framples - 1, ind, 0, -1)
+ if (res = sampler_position(rd)) != (framples - 1)
snd_display("sampler_position: %s?", res)
end
map_channel(lambda do |y| rd.call end)
pos = 0
e = make_env([0, 0, 1, 1, 2, 0], :length, dur + 1)
scan_channel(lambda do |y|
- if fneq(val = env(e), y)
- snd_display("trouble in reverse read at %s %s %s", pos, val, y)
- true
- else
- pos += 1
- false
- end
- end)
+ if fneq(val = env(e), y)
+ snd_display("trouble in reverse read at %s %s %s", pos, val, y)
+ true
+ else
+ pos += 1
+ false
+ end
+ end)
revert_sound
end
close_sound(ind)
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next)
insert_silence(0, 1000)
map_channel($init_channel)
env_sound([0, 0, 1, 1, 2, 0])
scale_channel(0.0, 100, 200)
- rd = make_sampler(frames - 1, ind, 0, -1)
+ rd = make_sampler(framples - 1, ind, 0, -1)
map_channel(lambda do |y| rd.call end)
pos = 0
e = make_env([0, 0, 1, 1, 2, 0], :length, 1001)
scan_channel(lambda do |y|
- val = env(e)
- if ((pos > 900 or pos <= 700) and fneq(val, y)) or
- (pos > 700 and pos <= 900 and fneq(y, 0.0))
- snd_display("trouble in reverse read 2 at %s %s %s", pos, val, y)
- true
- else
- pos += 1
- false
- end
- end)
+ val = env(e)
+ if ((pos > 900 or pos <= 700) and fneq(val, y)) or
+ (pos > 700 and pos <= 900 and fneq(y, 0.0))
+ snd_display("trouble in reverse read 2 at %s %s %s", pos, val, y)
+ true
+ else
+ pos += 1
+ false
+ end
+ end)
close_sound(ind)
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next)
insert_silence(0, 150000)
map_channel($init_channel)
edpos = edit_position
@@ -9979,21 +9657,21 @@ def test_05_25
when 6
env_sound([0, 1, 1, 0], 10000, 2000)
end
- rd = make_sampler(frames - 1, ind, 0, -1)
+ rd = make_sampler(framples - 1, ind, 0, -1)
map_channel(lambda do |y| rd.call end)
- rd = make_sampler(frames - 1, ind, 0, -1)
+ rd = make_sampler(framples - 1, ind, 0, -1)
map_channel(lambda do |y| rd.call end)
old_rd = make_sampler(0, ind, 0, 1, edit_position(ind, 0) - 2)
pos = 0
scan_channel(lambda do |y|
- if fneq(val = old_rd.call, y)
- snd_display("trouble in reverse (%s) read at %s %s %s", i, pos, val, y)
- true
- else
- pos += 1
- false
- end
- end)
+ if fneq(val = old_rd.call, y)
+ snd_display("trouble in reverse (%s) read at %s %s %s", i, pos, val, y)
+ true
+ else
+ pos += 1
+ false
+ end
+ end)
end
set_edit_position(edpos, ind, 0)
close_sound(ind)
@@ -10033,8 +9711,8 @@ def test_05_25
snd_display("scan_again: res %s != req %s?", res, req)
end
set_cursor(1000)
- # FIXME
- # set_sample(0.5) isn't possible
+ # XXX: set_sample(0.5) isn't possible
+ # Wrong_type_arg in set_sample: argument 1, 0.5, should be an integer
set_sample(:undefined, 0.5)
if fneq(res = sample(1000), 0.5)
snd_display("set sample no arg: %s %s?", res, sample(0))
@@ -10047,83 +9725,88 @@ def test_05_26
map_chan(lambda do |y| 1.0 end, 0, 1000)
env_channel(make_env([0, 1, 1, 1], :scaler, 0.5, :length, 1001))
check_maxamp(ind, 0.5, "simple scaler")
- check_env_vals("simple scaler", make_env([0, 1, 1, 1], :scaler, 0.5, :length, 1001))
+ check_env_vals("simple scaler",
+ make_env([0, 1, 1, 1], :scaler, 0.5, :length, 1001))
if edit_position == 2
undo_edit
else
snd_display("env+scl was no-op")
end
env_channel(make_env([0, 1, 1, 1], :offset, 0.5, :length, 1001))
- check_maxamp(ind, 1.5, "simple scaler")
- check_env_vals("simple scaler", make_env([0, 1, 1, 1], :offset, 0.5, :length, 1001))
+ check_maxamp(ind, 1.5, "simple offset")
+ check_env_vals("simple offset",
+ make_env([0, 1, 1, 1], :offset, 0.5, :length, 1001))
if edit_position == 2
undo_edit
else
snd_display("env+offset was no-op")
end
- env_channel(make_env([0, 0, 1, 1, 2, 0], :offset, 0.5, :scaler, 2.0, :length, 1001))
+ env_channel(make_env([0, 0, 1, 1, 2, 0],
+ :offset, 0.5, :scaler, 2.0, :length, 1001))
check_maxamp(ind, 2.5, "off+scl")
- check_env_vals("off+scl", make_env([0, 0, 1, 1, 2, 0], :offset, 0.5, :scaler, 2.0, :length, 1001))
+ check_env_vals("off+scl",
+ make_env([0, 0, 1, 1, 2, 0],
+ :offset, 0.5, :scaler, 2.0, :length, 1001))
undo_edit
- env_channel(make_env([0, -0.5, 1, 0, 2, -1], :offset, 0.5, :scaler, 2.0, :length, 1001))
+ env_channel(make_env([0, -0.5, 1, 0, 2, -1],
+ :offset, 0.5, :scaler, 2.0, :length, 1001))
check_maxamp(ind, 1.5, "off+scl #2")
mx = -12.0
- scan_chan(lambda do |y|
- if y > mx
- mx = y
- end
- false
- end)
- snd_test_neq(mx, 0.5, "non abs max")
+ scan_channel(lambda do |y|
+ if y > mx
+ mx = y
+ end
+ false
+ end)
+ snd_test_neq(mx, 0.5, "non abs max (correct 0.5)")
check_env_vals("off+scl #2",
- make_env([0, -0.5, 1, 0, 2, -1], :offset, 0.5, :scaler, 2.0, :length, 1001))
+ make_env([0, -0.5, 1, 0, 2, -1],
+ :offset, 0.5, :scaler, 2.0, :length, 1001))
undo_edit
- env_sound([0, 0.5, 1, 0.75, 2, 0.25], 0, frames, 32.0)
+ env_sound([0, 0.5, 1, 0.75, 2, 0.25], 0, framples(), 32.0)
check_maxamp(ind, 0.75, "xramp")
- check_env_vals("xramp", make_env([0, 0.5, 1, 0.75, 2, 0.25], :base, 32.0, :length, 1001))
+ check_env_vals("xramp",
+ make_env([0, 0.5, 1, 0.75, 2, 0.25],
+ :base, 32.0, :length, 1001))
undo_edit
env_channel_with_base([0, 0.5, 1, 0.75, 2, 0.25], 32.0)
check_maxamp(ind, 0.75, "xramp1")
- check_env_vals("xramp1", make_env([0, 0.5, 1, 0.75, 2, 0.25], :base, 32.0, :length, 1001))
+ check_env_vals("xramp1",
+ make_env([0, 0.5, 1, 0.75, 2, 0.25],
+ :base, 32.0, :length, 1001))
close_sound(ind)
#
hlb = make_hilbert_transform(8)
- snd_test_neq(make_vct!(20) do |i| hilbert_transform(hlb, (i == 0 ? 1.0 : 0.0)) end,
- vct(0, -0.01, 0, -0.046, 0, -0.152, 0, -0.614, 0, 0.614,
- 0, 0.152, 0, 0.046, 0, 0.01, 0, 0, 0, 0),
- "hilbert_transform 8 impulse response")
+ snd_test_neq(make_vct!(20) do |i|
+ hilbert_transform(hlb, (i == 0 ? 1.0 : 0.0))
+ end, vct(0, -0.01, 0, -0.046, 0, -0.152, 0, -0.614, 0,
+ 0.614, 0, 0.152, 0, 0.046, 0, 0.01, 0, 0, 0, 0),
+ "hilbert_transform 8 impulse response")
hlb = make_hilbert_transform(7)
- snd_test_neq(make_vct!(20) do |i| hilbert_transform(hlb, (i == 0 ? 1.0 : 0.0)) end,
- vct(-0.007, 0.0, -0.032, 0.0, -0.136, 0.0, -0.608, 0.0, 0.608, 0.0,
- 0.136, 0.0, 0.032, 0.0, 0.007, 0.0, 0.0, 0.0, 0.0, 0.0),
- "hilbert_transform 7 impulse response")
+ snd_test_neq(make_vct!(20) do |i|
+ hilbert_transform(hlb, (i == 0 ? 1.0 : 0.0))
+ end, vct(-0.007, 0.0, -0.032, 0.0, -0.136, 0.0, -0.608,
+ 0.0, 0.608, 0.0, 0.136, 0.0, 0.032, 0.0, 0.007,
+ 0.0, 0.0, 0.0, 0.0, 0.0), "hilbert_transform 7 impulse response")
ind = new_sound("test.snd")
pad_channel(0, 1000)
set_sample(100, 1.0)
h = make_hilbert_transform(100)
- 4.times do map_channel(lambda do |y| hilbert_transform(h, y) end) end
- res = sample(500)
- if (res - 0.98).abs > 0.01
- snd_display(snd_format(res, 0.01, ">", "hilbert impulse"))
+ 4.times do
+ map_channel(lambda do |y| hilbert_transform(h, y) end)
end
+ snd_test_gt((sample(500) - 0.98).abs, 0.01, "hilbert impulse")
set_sample(500, 0.0)
- res = maxamp(ind, 0)
- if res > 0.02
- snd_display(snd_format(res, 0.02, ">", "hilbert sidelobes"))
- end
+ snd_test_gt(maxamp(ind, 0), 0.02, "hilbert sidelobes")
scale_channel(0.0)
set_sample(100, 1.0)
h = make_hilbert_transform(101)
- 4.times do map_channel(lambda do |y| hilbert_transform(h, y) end) end
- res = sample(504)
- if (res - 0.98).abs > 0.01
- snd_display(snd_format(res, 0.01, ">", "hilbert 101 impulse"))
+ 4.times do
+ map_channel(lambda do |y| hilbert_transform(h, y) end)
end
+ snd_test_gt((sample(504) - 0.98).abs, 0.01, "hilbert 101 impulse")
set_sample(504, 0.0)
- res = maxamp(ind, 0)
- if res > 0.02
- snd_display(snd_format(res, 0.02, ">", "hilbert 101 sidelobes"))
- end
+ snd_test_gt(maxamp(ind, 0), 0.02, "hilbert 101 sidelobes")
revert_sound
pad_channel(0, 1000)
set_sample(100, 1.0)
@@ -10143,7 +9826,7 @@ def test_05_26
close_sound(ind)
#
ind = new_sound("test.snd")
- map_channel(lambda do |y| 1.0 - random(2.0) end, 0, 10000)
+ map_channel(lambda do |y| mus_random(1.0) end, 0, 10000)
f2 = make_bandpass_2(0.12 * PI, 0.15 * PI, 0.22 * PI, 0.25 * PI, 100)
map_channel(lambda do |y| bandpass_2(f2, y) end)
data = channel2vct
@@ -10160,7 +9843,8 @@ def test_05_26
undo_edit
close_sound(ind)
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1, "ramp re-order tests", 100)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next,
+ "ramp re-order tests", 100)
map_channel(lambda do |y| 1.0 end)
[["ramp-xramp", true,
lambda do
@@ -10259,7 +9943,8 @@ def test_05_26
end
close_sound(ind)
# offset channel
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1, "offset tests", 10)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next,
+ "offset tests", 10)
offset_channel(0.1)
snd_test_neq(channel2vct(0, 10), Vct.new(10, 0.1), "offset_channel (0.1)")
offset_channel(-0.2, 5, 5)
@@ -10274,34 +9959,35 @@ def test_05_26
map_channel($init_channel)
sine_ramp(0.0, 1.0)
snd_test_neq(channel2vct,
- vct(0.000, 0.024, 0.095, 0.206, 0.345, 0.500, 0.655, 0.794, 0.905, 0.976),
- "sine_ramp 0 1")
+ vct(0.000, 0.024, 0.095, 0.206, 0.345, 0.500,
+ 0.655, 0.794, 0.905, 0.976), "sine_ramp 0 1")
revert_sound(ind)
offset_channel(1.0)
sine_ramp(1.0, 0.0)
snd_test_neq(channel2vct,
- vct(1.000, 0.976, 0.905, 0.794, 0.655, 0.500, 0.345, 0.206, 0.095, 0.024),
- "sine_ramp 1 0")
+ vct(1.000, 0.976, 0.905, 0.794, 0.655, 0.500,
+ 0.345, 0.206, 0.095, 0.024), "sine_ramp 1 0")
close_sound(ind)
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1, "sine_env tests", 100)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next,
+ "sine_env tests", 100)
# map_channel($init_channel)
map_channel(lambda do |y| 1.0 end)
sine_env_channel([0, 0, 1, 1, 2, -0.5, 3, 1])
snd_test_neq(channel2vct(20, 10),
- vct(0.664, 0.708, 0.750, 0.790, 0.827, 0.862, 0.893, 0.921, 0.944, 0.964),
- "sine_env_channel 0a")
+ vct(0.664, 0.708, 0.750, 0.790, 0.827, 0.862,
+ 0.893, 0.921, 0.944, 0.964), "sine_env_channel 0a")
snd_test_neq(channel2vct(60, 10),
- vct(-0.381, -0.417, -0.446, -0.47, -0.486, -0.497, -0.5, -0.497, -0.486, -0.47),
- "sine_env_channel 0b")
+ vct(-0.381, -0.417, -0.446, -0.47, -0.486, -0.497,
+ -0.5, -0.497, -0.486, -0.47), "sine_env_channel 0b")
snd_test_neq(edit_position(ind, 0), 2, "as_one_edit sine_env_channel")
revert_sound(ind)
offset_channel(-1.0)
sine_env_channel([0, 0, 1, 1, 2, 1, 3, 0], 40, 20)
snd_test_neq(channel2vct(40, 20),
- vct(0, -0.05, -0.188, -0.389, -0.611, -0.812, -0.95, -1, -1, -1,
- -1, -1, -1, -1, -1, -0.95, -0.812, -0.611, -0.389, -0.188),
- "off+sine_env a")
+ vct(0, -0.05, -0.188, -0.389, -0.611, -0.812, -0.95,
+ -1, -1, -1, -1, -1, -1, -1, -1, -0.95, -0.812,
+ -0.611, -0.389, -0.188), "off+sine_env a")
snd_test_neq(channel2vct(30, 10), make_vct(10, -1.0), "off+sine_env b")
revert_sound(ind)
scale_by(0.0)
@@ -10338,7 +10024,8 @@ def test_05_26
end
def test_05_27
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1, "special env tests", 100)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next,
+ "special env tests", 100)
map_channel($init_channel)
blackman4_ramp(0.0, 1.0)
vals = channel2vct
@@ -10358,38 +10045,33 @@ def test_05_27
undo_edit
blackman4_env_channel([0, 0, 1, 1, 2, -0.5, 3, 0])
unless vequal(res = channel2vct(60, 10),
- vct(-0.109, -0.217, -0.313, -0.392, -0.451, -0.488, -0.499, -0.499, -0.499, -0.499))
+ vct(-0.109, -0.217, -0.313, -0.392, -0.451,
+ -0.488, -0.499, -0.499, -0.499, -0.499))
snd_display("blackman4_env_channel to -0.5: %s", res)
end
undo_edit
#
ramp_squared(0.0, 1.0)
- vals = channel2vct
+ vals = channel2vct()
undo_edit
env_squared_channel([0, 0, 1, 1])
- unless vequal(res = channel2vct, vals)
- snd_display("env_squared/ramp:\n# %s\n# %s", vals, res)
- end
+ snd_test_neq(channel2vct(), vals, "env_squared/ramp")
undo_edit
ramp_squared(0.0, 1.0, true, 0, 50)
vals = channel2vct
undo_edit
env_squared_channel([0, 0, 1, 1, 2, 1])
- unless vequal(res = channel2vct, vals)
- snd_display("env_squared/ramp 1:\n# %s\n# %s", vals, res)
- end
+ snd_test_neq(channel2vct(), vals, "env_squared/ramp 1")
undo_edit
env_squared_channel([0, 0, 1, 1, 2, -0.5, 3, 0])
- unless vequal(res = channel2vct(60, 10),
- vct(-0.450, -0.466, -0.478, -0.488, -0.494, -0.499, -0.500, -0.500, -0.498, -0.496))
- snd_display("env_squared to -0.5: %s", res)
- end
+ req = vct(-0.450, -0.466, -0.478, -0.488, -0.494,
+ -0.499, -0.500, -0.500, -0.498, -0.496)
+ snd_test_neq(channel2vct(60, 10), req, "env_squared to -0.5")
undo_edit
env_squared_channel([0, 0, 1, 1, 2, -0.5, 3, 0], false)
- unless vequal(res = channel2vct(60, 10),
- vct(-0.004, -0.080, -0.158, -0.240, -0.324, -0.410, -0.500, -0.500, -0.498, -0.496))
- snd_display("env_squared unsymmetric to -0.5: %s", res)
- end
+ req = vct(-0.004, -0.080, -0.158, -0.240, -0.324,
+ -0.410, -0.500, -0.500, -0.498, -0.496)
+ snd_test_neq(channel2vct(60, 10), req, "env_squared unsymmetric to -0.5")
undo_edit
#
ramp_squared(0.0, 1.0)
@@ -10418,40 +10100,32 @@ def test_05_27
undo_edit
#
ramp_expt(0.0, 1.0, 32.0)
- vals = channel2vct
+ vals = channel2vct()
undo_edit
env_expt_channel([0, 0, 1, 1], 32.0)
- unless vequal(res = channel2vct, vals)
- snd_display("env_expt/ramp 32:\n# %s\n# %s", vals, res)
- end
+ snd_test_neq(channel2vct(), vals, "env_expt/ramp 32")
undo_edit
ramp_expt(0.0, 1.0, 32.0, false, 0, 50)
- vals = channel2vct
+ vals = channel2vct()
undo_edit
env_expt_channel([0, 0, 1, 1, 2, 1], 32.0)
- unless vequal(res = channel2vct, vals)
- snd_display("env_expt/ramp 1 32.0:\n# %s\n# %s", vals, res)
- end
+ snd_test_neq(channel2vct(), vals, "env_expt/ramp 1 32")
undo_edit
ramp_expt(0.0, 1.0, 0.1)
- vals = channel2vct
+ vals = channel2vct()
undo_edit
env_expt_channel([0, 0, 1, 1], 0.1)
- unless vequal(res = channel2vct, vals)
- snd_display("env_expt/ramp 0.1:\n# %s\n# %s", vals, res)
- end
+ snd_test_neq(channel2vct(), vals, "env_expt/ramp 0.1")
undo_edit
env_expt_channel([0, 0, 1, 1, 2, -0.5, 3, 0], 12.0)
- unless vequal(res = channel2vct(30, 10),
- vct(0.319, 0.472, 0.691, 1.000, 0.537, 0.208, -0.022, -0.182, -0.291, -0.365))
- snd_display("env_expt to -0.5 12.0\n# %s\n# %s", vals, res)
- end
+ req = vct(0.319, 0.472, 0.691, 1.000, 0.537,
+ 0.208, -0.022, -0.182, -0.291, -0.365)
+ snd_test_neq(channel2vct(30, 10), req, "env_expt to -0.5 12.0")
undo_edit
env_expt_channel([0, 0, 1, 1, 2, -0.5, 3, 0], 12.0, false)
- unless vequal(res = channel2vct(30, 10),
- vct(0.319, 0.472, 0.691, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000))
- snd_display("env_expt ot -0.5 12.0 unsymmetric:\n# %s\n# %s", vals, res)
- end
+ req = vct(0.319, 0.472, 0.691, 1.000, 1.000,
+ 1.000, 1.000, 1.000, 1.000, 1.000)
+ snd_test_neq(channel2vct(30, 10), req, "env_expt ot -0.5 12.0 unsymmetric")
undo_edit
close_sound(ind)
#
@@ -10472,11 +10146,13 @@ def test_05_27
set_sync(1, ind0)
set_selected_sound(ind0)
env_selection([0, 0, 1, 1])
- if (res0 = edit_position(ind0, 0)) != 0 or (res1 = edit_position(ind1)) != 5
+ if (res0 = edit_position(ind0, 0)) != 0 or
+ (res1 = edit_position(ind1)) != 5
snd_display("selection override of sync field: %s %s?", res0, res1)
end
env_sound([0, 0, 1, 1, 2, 0])
- if (res0 = edit_position(ind0, 0)) != 1 or (res1 = edit_position(ind1)) != 5
+ if (res0 = edit_position(ind0, 0)) != 1 or
+ (res1 = edit_position(ind1)) != 5
snd_display("sync field over selection: %s %s?", res0, res1)
end
close_sound(ind0)
@@ -10522,369 +10198,215 @@ def test_06
v0 = make_vct(10)
v1 = Vct.new(10)
vlst = make_vct(3)
- unless vct?(v0)
- snd_display("v0 is not a vct?")
- end
- unless v0.kind_of?(Vct)
- snd_display("v0 is not kind_of? Vct?")
- end
- if v0 == 10
- snd_display("v0 is 10!?")
- end
- if vct?(10)
- snd_display("10 is a vct?")
- end
- if v0.length != 10
- snd_display("v0 length = %s?", v0.length)
- end
+ snd_test_neq(vct?(v0), true, "v0 is not a vct?")
+ snd_test_neq(v0.kind_of?(Vct), true, "v0 is not kind_of? Vct?")
+ snd_test_eq(v0, 10, "v0 is 10")
+ snd_test_neq(vct?(10), false, "10 is a vct?")
+ snd_test_neq(v0.length, 10, "Vct#length")
vct_fill!(v0, 1.0)
v1.fill(0.5)
if v0.eql?(v1)
- snd_display("vct %s.eql?(%s)?", v0, v1)
+ snd_format_eq(v0, v1, "Vct#eql?")
end
if v0 == v1
- snd_display("vct %s == %s?", v0, v1)
+ snd_format_eq(v0, v1, "Vct#==")
end
v2 = v1
v3 = Vct.new(10)
v4 = make_vct(3)
unless v1.eql?(v2)
- snd_display("vct not %s.eql?(%s)?", v1, v2)
+ snd_format_neq(v1, v2, "not Vct#eql? (1)")
end
vct_fill!(v3, 0.5)
unless v2.eql?(v1)
- snd_display("vct not %s.eql?(%s)?", v2, v1)
+ snd_format_neq(v2, v1, "not Vct#eql? (2)")
end
if v4.eql?(v1)
- snd_display("len diff vct %s.eql?(%s)?", v4, v1)
+ snd_format_eq(v4, v1, "len diff Vct#eql?")
end
+ vct_set!(v3, 0, 1.0)
+ snd_test_neq(vct_ref(v3, 0), 1.0, "vct_set!")
v3[0] = 1.0
- if fneq(v3[0], 1.0)
- snd_display("vct_set!: %s", v3[0])
- end
+ snd_test_neq(v3[0], 1.0, "Vct#[]=")
vlst[1] = 0.1
- unless vequal(res = vct2list(vlst), [0.0, 0.1, 0.0])
- snd_display("vct2list: %s?", res)
- end
+ snd_test_neq(vct2list(vlst), [0.0, 0.1, 0.0], "vct2list")
vect = [0.0, 1.0, 2.0, 3.0]
v123 = vct(0.0, 1.0, 2.0, 3.0)
v2 = vect.to_vct
v3 = v2
str = format("%s", v2.to_s)
str1 = format("%s", make_vct(32).to_s)
- unless vct?(res = vector2vct(make_array(0)))
- snd_display("vector2vct empty vect: %s", res)
- end
- unless vct?(res = make_array(0).to_vct)
- snd_display("make_array(0).to_vct empty vect: %s", res)
- end
- if str != "#<vct[len=4]: 0.000 1.000 2.000 3.000>"
- snd_display("vct print:\n# %s\n# %s?", str, v2.to_s)
- end
- if print_length == 12 and
- str1 != "#<vct[len=32]: 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 ...>"
- snd_display("vct(32) print: %s?", str1)
- end
- unless vequal(v123, v2)
- snd_display("vector2vct: %s", v2)
- end
- unless (res = vct2vector(v123)) == vect
- snd_display("vct2vector:\n# %s\n# %s", vect, res)
- end
- unless (res = v123.to_a) == vect
- snd_display("v123.to_a:\n# %s\n# %s", vect, res)
- end
+ snd_test_neq(vct?(vector2vct(make_array(0))), true, "vector2vct empty vect")
+ snd_test_neq(vct?(make_array(0).to_vct), true,
+ "make_array(0).to_vct empty vect")
+ snd_test_neq(str, "#<vct[len=4]: 0.000 1.000 2.000 3.000>", "Vct#to_s")
+ snd_test_neq(v123, v2, "vector2vct")
+ snd_test_neq(vct2vector(v123), vect, "vct2vector")
+ snd_test_neq(v123.to_a, vect, "Vct#to_a")
unless v3.eql?(v2)
- snd_display("vct=? %s %s", v2, v3)
- end
- if v2.length != 4
- snd_display("vector2vct length: %s?", v2.lenght)
- end
- if fneq(v2[2], 2.0)
- snd_display("vector2vct: %s?", v2)
+ snd_format_neq(v3, v2, "Vct#eql?")
end
+ snd_test_neq(v2.length, 4, "vector2vct#length")
+ snd_test_neq(v2[2], 2.0, "vector2vct[2]")
vct_move!(v2, 0, 2)
- if fneq(v2[0], 2.0)
- snd_display("vct_move!: %s?", v2)
- end
+ snd_test_neq(v2[0], 2.0, "vct_move!")
v2 = Vct.new(4) do |i| i end
v2.move!(3, 2, true)
- if fneq(v2[3], 2.0) or fneq(v2[2], 1.0)
- snd_display("vct_move! back: %s?", v2)
- end
- unless vequal(vct(4, 3, 2, 1), res = vct_reverse!(vct(1, 2, 3, 4)))
- snd_display("vct_reverse: %s?", res)
- end
- unless vequal(vct(3, 2, 1), res = vct(1, 2, 3).reverse)
- snd_display("vct_reverse: %s?", res)
- end
- unless vequal(vct(2, 1), res = vct_reverse!(vct(1, 2)))
- snd_display("vct_reverse: %s?", res)
- end
- unless vequal(vct(1), res = vct(1).reverse)
- snd_display("vct_reverse: %s?", res)
- end
- unless vequal(vct(4, 3, 2, 1), res = vct(1, 2, 3, 4).reverse(4))
- snd_display("vct_reverse: %s?", res)
- end
- unless vequal(vct(3, 2, 1), res = vct_reverse!(vct(1, 2, 3), 3))
- snd_display("vct_reverse: %s?", res)
- end
- unless vequal(vct(2, 1), res = vct(1, 2).reverse(2))
- snd_display("vct_reverse: %s?", res)
- end
- unless vequal(vct(1), res = vct_reverse!(vct(1), 1))
- snd_display("vct_reverse: %s?", res)
- end
+ snd_test_neq(v2[2], 1.0, "Vct#move! back (1)")
+ snd_test_neq(v2[3], 2.0, "Vct#move! back (2)")
+ snd_test_neq(vct(3, 2, 1), vct_reverse!(vct(1, 2, 3)), "vct_reverse!")
+ snd_test_neq(vct(3, 2, 1), vct(1, 2, 3).reverse, "Vct#reverse")
+ snd_test_neq(vct(2, 1), vct_reverse!(vct(1, 2)), "vct_reverse!")
+ snd_test_neq(vct(1), vct(1).reverse, "vct(1)#reverse")
+ snd_test_neq(vct(4, 3, 2, 1), vct(1, 2, 3, 4).reverse(4), "Vct#reverse(4)")
+ snd_test_neq(vct(3, 2, 1), vct_reverse!(vct(1, 2, 3), 3), "vct_reverse(3)")
+ snd_test_neq(vct(2, 1), vct(1, 2).reverse(2), "Vct#reverse(2)")
+ snd_test_neq(vct(1), vct_reverse!(vct(1), 1), "vct_reverse!(1)")
#
vv0 = Vct.new(3)
- if (res = Snd.catch do vct_ref(vv0, 10) end).first != :out_of_range
- snd_display("vct_ref high index: %s", res)
- end
- if (res = Snd.catch do vv0[-4] end).first != :out_of_range
- snd_display("[] low index: %s", res)
- end
- if (res = Snd.catch do vct_set!(vv0, 10, 1.0) end).first != :out_of_range
- snd_display("vct_set! high index: %s", res)
- end
- if (res = Snd.catch do vv0[-1] = 1.0 end).first != :out_of_range
- snd_display("[]= low index: %s", res)
- end
- if (res = Snd.catch do vct_move!(vv0, 10, 0, true) end).first != :out_of_range
- snd_display("vct_move! high index: %s", res)
- end
- if (res = Snd.catch do vv0.move(0, 10, true) end).first != :out_of_range
- snd_display("v.move high 2 index: %s", res)
- end
- if (res = Snd.catch do vct_move!(vv0, -10, 0, false) end).first != :out_of_range
- snd_display("vct_move! back high index: %s", res)
- end
- if (res = Snd.catch do vv0.move!(0, -10, false) end).first != :out_of_range
- snd_display("v.move! back high 2 index: %s", res)
- end
+ snd_test_neq(Snd.catch do vct_ref(vv0, 10) end.first,
+ :out_of_range, "vct_ref high index")
+ snd_test_neq(Snd.catch do vv0[-4] end.first,
+ :out_of_range, "Vct#[] low index")
+ snd_test_neq(Snd.catch do vct_set!(vv0, 10, 1.0) end.first,
+ :out_of_range, "vct_set! high index")
+ snd_test_neq(Snd.catch do vv0[-1] = 1.0 end.first,
+ :out_of_range, "Vct#[]= low index")
+ snd_test_neq(Snd.catch do vct_move!(vv0, 10, 0, true) end.first,
+ :out_of_range, "vct_move! high index")
+ snd_test_neq(Snd.catch do vv0.move(0, 10, true) end.first,
+ :out_of_range, "Vct#move high 2 index")
+ snd_test_neq(Snd.catch do vct_move!(vv0, -10, 0, false) end.first,
+ :out_of_range, "vct_move! back high index")
+ snd_test_neq(Snd.catch do vv0.move!(0, -10, false) end.first,
+ :out_of_range, "Vct#move! back high 2 index")
10.times do |i|
- if fneq(v0[i], 1.0)
- snd_display("fill v0[%s] = %s?", i, v0[i])
- end
- if fneq(v1[i], 0.5)
- snd_display("preset v1[%s] = %s?", i, v1[i])
- end
+ snd_test_neq(v0[i], 1.0, "fill v0[%d]", i)
+ snd_test_neq(v1[i], 0.5, "preset v1[%d]", i)
end
# add
v0.add(v1).each_with_index do |x, i|
- if fneq(x, 1.5)
- snd_display("v0.add[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.5, "Vct#add[%d]", i)
end
(v0 + v1).each_with_index do |x, i|
- if fneq(x, 1.5)
- snd_display("v0 + v1[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.5, "Vct#+[%d]", i)
end
vct_add!(v0, v1)
v0.each_with_index do |x, i|
- if fneq(x, 1.5)
- snd_display("add v0[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.5, "vct_add![%d]", i)
end
# subtract
v0.subtract(v1).each_with_index do |x, i|
- if fneq(x, 1.0)
- snd_display("v0.subtract[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.0, "Vct#subtract[%d]", i)
end
(v0 - v1).each_with_index do |x, i|
- if fneq(x, 1.0)
- snd_display("v0 - v1 [%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.0, "Vct#-[%d]", i)
end
vct_subtract!(v0, v1)
v0.each_with_index do |x, i|
- if fneq(x, 1.0)
- snd_display("subtract v0[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.0, "vct_subtract![%d]", i)
end
# dup, vct_copy
v0.dup.each_with_index do |x, i|
- if fneq(x, 1.0)
- snd_display("v0.dup[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.0, "Vct#dup[%d]", i)
end
v2 = vct_copy(v0)
v2.each_with_index do |x, i|
- if fneq(x, 1.0)
- snd_display("copy v2[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.0, "vct_copy[%d]", i)
end
# scale
v2.scale(5.0).each_with_index do |x, i|
- if fneq(x, 5.0)
- snd_display("v2.scale[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 5.0, "Vct#scale[%d]", i)
end
(v2 * 5.0).each_with_index do |x, i|
- if fneq(x, 5.0)
- snd_display("v2 * 5.0 [%s] = %s?", i, x)
- end
+ snd_test_neq(x, 5.0, "Vct#*[%d]", i)
end
vct_scale!(v2, 5.0)
v2.each_with_index do |x, i|
- if fneq(x, 5.0)
- snd_display("scale v2[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 5.0, "vct_scale![%d]", i)
end
# offset
v0.offset(-1.0).each_with_index do |x, i|
- if fneq(x, 0.0)
- snd_display("v0.offset[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 0.0, "Vct#offset[%d]", i)
end
(v0 + -1.0).each_with_index do |x, i|
- if fneq(x, 0.0)
- snd_display("v0 + -1.0 [%s] = %s?", i, x)
- end
+ snd_test_neq(x, 0.0, "Vct#+[%d]", i)
end
vct_offset!(v0, -1.0)
v0.each_with_index do |x, i|
- if fneq(x, 0.0)
- snd_display("offset v0[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 0.0, "vct_offset![%d]", i)
end
# multiply
v2.multiply(v1).each_with_index do |x, i|
- if fneq(x, 2.5)
- snd_display("v2.multiply[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 2.5, "Vct#multiply[%d]", i)
end
(v2 * v1).each_with_index do |x, i|
- if fneq(x, 2.5)
- snd_display("v2 * v1 [%s] = %s?", i, x)
- end
+ snd_test_neq(x, 2.5, "Vct#*[%d]", i)
end
vct_multiply!(v2, v1)
v2.each_with_index do |x, i|
- if fneq(x, 2.5)
- snd_display("multiply v2[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 2.5, "vct_multiply![%d]", i)
end
#
- if fneq(vct_peak(v2), 2.5)
- snd_display("peak of v2 is %s?", vct_peak(v2))
- end
- if fneq(v2.peak, 2.5)
- snd_display("v2.peak is %s?", vct_peak(v2))
- end
+ snd_test_neq(vct_peak(v2), 2.5, "vct_peak (1)")
+ snd_test_neq(v2.peak, 2.5, "Vct#peak (1)")
v2[5] = 123.0
- if fneq(vct_peak(v2), 123.0)
- snd_display("set peak of v2 is %s?", vct_peak(v2))
- end
- if fneq(v2.peak, 123.0)
- snd_display("v2.peak is %s?", vct_peak(v2))
- end
+ snd_test_neq(vct_peak(v2), 123.0, "vct_peak (2)")
+ snd_test_neq(v2.peak, 123.0, "Vct#peak (2)")
vn = Vct.new(32) do |i| i end
vb = make_vct(64)
vs = make_vct(3)
vss = Vct.new(1)
vnew = vct_subseq(vn, 3)
- if fneq(vnew[0], 3.0)
- snd_display("vct_subseq[3:] %s?", vneq[0])
- end
- if vnew.length != 29
- snd_display("vct_subseq[3:] length %s?", vnew.length)
- end
+ snd_test_neq(vnew[0], 3.0, "vct_subseq[3:]")
+ snd_test_neq(vnew.length, 29, "vct_subseq[3:] length")
vnew = vn.subseq(3, 8)
- if fneq(vnew[0], 3.0)
- snd_display("v.subseq[3:8] %s?", vneq[0])
- end
- if vnew.length != 6
- snd_display("v.subseq[3:8] length %s?", vnew.length)
- end
+ snd_test_neq(vnew[0], 3.0, "Vct#subseq[3:8]")
+ snd_test_neq(vnew.length, 6, "Vct#subseq[3:8] length")
vct_subseq(vn, 3, 3, vs)
- if fneq(vs[0], 3.0) or fneq(vs[1], 0.0) or fneq(vs[2], 0.0)
- snd_display("vct_subseq[3:3->vs] %s?", vs)
- end
+ snd_test_neq(vs[0], 3.0, "vct_subseq[3:3->vs] (1)")
+ snd_test_neq(vs[1], 0.0, "vct_subseq[3:3->vs] (2)")
+ snd_test_neq(vs[2], 0.0, "vct_subseq[3:3->vs] (3)")
vn.subseq(0, 32, vs)
- if vs.length != 3
- snd_display("v.subseq[:32->vs] length %s?", vs.length)
- end
+ snd_test_neq(vs.length, 3, "Vct#subseq[:32->vs] length")
vn.subseq(2, 3, vss)
- if fneq(vss[0], 2.0)
- snd_display("v.subseq[2:3->vss] %s?", vss[0])
- end
+ snd_test_neq(vss[0], 2.0, "Vct#subseq[2:3->vss]")
vb[8] = 123.0
vct_subseq(vn, 1, 8, vb)
- if fneq(vb[0], 1.0)
- snd_display("vct_subseq[1:8->vb] %s?", vb[0])
- end
- if fneq(vb[8], 123.0)
- snd_display("vct_subseq[1:8->vb][8] %s?", vb[8])
- end
+ snd_test_neq(vb[0], 1.0, "vct_subseq[1:8->vb][0]")
+ snd_test_neq(vb[8], 123.0, "vct_subseq[1:8->vb][8]")
# vct_add, vct_multiply (vct+, vct*)
v1 = Vct.new(3, 0.1)
v2 = make_vct(4, 0.2)
- unless vequal(res = vct_add(v1.dup, v2), vct(0.3, 0.3, 0.3))
- snd_display("vct_add 0.1 0.2: %s?", res)
- end
- unless vequal(res = v1 + v2, vct(0.3, 0.3, 0.3))
- snd_display("v1 + v2 0.1 0.2: %s?", res)
- end
+ snd_test_neq(vct_add(v1.dup, v2), vct(0.3, 0.3, 0.3), "vct_add 0.1 0.2")
+ snd_test_neq(v1 + v2, vct(0.3, 0.3, 0.3), "Vct#+ 0.1 0.2")
v1[1] = 0.3
- unless vequal(res = vct_add(v1.dup, v2), vct(0.3, 0.5, 0.3))
- snd_display("vct_add 0.1 0.2 (1): %s?", res)
- end
- unless vequal(res = v1 + v2, vct(0.3, 0.5, 0.3))
- snd_display("v1 + v2 0.1 0.2 (1): %s?", res)
- end
- unless vequal(res = vct_add(v1.dup, 2.0), vct(2.1, 2.3, 2.1))
- snd_display("vct_add 0.1 2.0: %s?", res)
- end
- unless vequal(res = v1 + 2.0, vct(2.1, 2.3, 2.1))
- snd_display("v1 + 2.0 0.1 2.0: %s?", res)
- end
- unless vequal(res = vct_add(2.0, v1.dup), vct(2.1, 2.3, 2.1))
- snd_display("vct_add 0.1 2.0 (1): %s?", res)
- end
- unless vequal(res = 2.0 + v1, vct(2.1, 2.3, 2.1))
- snd_display("2.0 + v1 0.1 2.0 (1): %s?", res)
- end
- unless vequal(res = vct_multiply(2.0, v1.dup), vct(0.2, 0.6, 0.2))
- snd_display("vct_multiply 2.0: %s?", res)
- end
- unless vequal(res = 2.0 * v1, vct(0.2, 0.6, 0.2))
- snd_display("2.0 * v1 2.0: %s?", res)
- end
- unless vequal(res = vct_multiply(v1.dup, 2.0), vct(0.2, 0.6, 0.2))
- snd_display("vct_multiply 2.0 (1): %s?", res)
- end
- unless vequal(res = v1 * 2.0, vct(0.2, 0.6, 0.2))
- snd_display("v1 * 2.0 2.0 (1): %s?", res)
- end
- unless vequal(res = vct_multiply(v1.dup, v2), vct(0.02, 0.06, 0.02))
- snd_display("vct_multiply v1 v2: %s?", res)
- end
- unless vequal(res = v1 * v2, vct(0.02, 0.06, 0.02))
- snd_display("v1 * v2 v1 v2: %s?", res)
- end
+ snd_test_neq(vct_add(v1.dup, v2), vct(0.3, 0.5, 0.3), "vct_add 0.1 0.2 (1)")
+ snd_test_neq(v1 + v2, vct(0.3, 0.5, 0.3), "Vct#+ 0.1 0.2 (1)")
+ snd_test_neq(vct_add(v1.dup, 2.0), vct(2.1, 2.3, 2.1), "vct_add 0.1 2.0")
+ snd_test_neq(v1 + 2.0, vct(2.1, 2.3, 2.1), "Vct#+ 0.1 2.0")
+ snd_test_neq(vct_add(2.0, v1.dup), vct(2.1, 2.3, 2.1), "vct_add 0.1 2.0 (1)")
+ snd_test_neq(2.0 + v1, vct(2.1, 2.3, 2.1), "2.0#+(v1) 0.1 2.0 (1)")
+ snd_test_neq(vct_multiply(2.0, v1.dup), vct(0.2, 0.6, 0.2), "vct_multiply 2")
+ snd_test_neq(2.0 * v1, vct(0.2, 0.6, 0.2), "2.0#*(v1)")
+ snd_test_neq(vct_multiply(v1.dup, 2.0), vct(0.2, 0.6, 0.2),
+ "vct_multiply 2 (1)")
+ snd_test_neq(v1 * 2.0, vct(0.2, 0.6, 0.2), "Vct#* 2 (1)")
+ snd_test_neq(vct_multiply(v1.dup, v2), vct(0.02, 0.06, 0.02),
+ "vct_multiply v1 v2")
+ snd_test_neq(v1 * v2, vct(0.02, 0.06, 0.02), "Vct#*(v2)")
#
v0.map do |val| PI end.each_with_index do |x, i|
- if fneq(x, PI)
- snd_display("v0.map[%s] = %s?", i, x)
- end
+ snd_test_neq(x, PI, "Vct#map[%d]", i)
end
- vct_map!(v0, lambda do | | 1.0 end)
+ v0.map! do |x| 1.0 end
v0.each_with_index do |x, i|
- if fneq(x, 1.0)
- snd_display("map v0[%s] = %s?", i, x)
- end
+ snd_test_neq(x, 1.0, "Vct#map[%d] 1.0", i)
end
#
- if fneq(vct(1.0, 2.0, 3.0)[1], 2.0)
- snd_display("vct(...) = %s?", vct(1.0, 2.0, 3.0)[1])
- end
+ snd_test_neq(vct(1.0, 2.0, 3.0)[1], 2.0, "vct(...)[1]")
v1 = [1, 2, 3, 4].to_vct
- if fneq(v1[1], 2.0)
- snd_display("v1[1] = %s?", v1[1])
- end
+ snd_test_neq(v1[1], 2.0, "Vct#[1]")
#
ind = open_sound("oboe.snd")
set_speed_control(0.5, ind)
@@ -10896,72 +10418,35 @@ def test_06
# try some special cases
#
apply_controls
- if edit_position(ind) != 0
- snd_display("apply_controls with no change: %s: %s", edits(ind), edit_tree(ind))
- end
+ snd_test_neq(edit_position(ind), 0, "apply_controls with no change")
set_speed_control(-1.0, ind)
apply_controls
- if $with_test_gui and edit_position(ind) != 1
- snd_display("apply_controls with srate -1.0: %s: %s", edits(ind), edit_tree(ind))
+ if $with_test_gui
+ snd_test_neq(edit_position(ind), 1, "apply_controls with srate -1.0")
end
- if ((res0 = frames(ind, 0)) - (res1 = frames(ind, 0, 0))).abs > 2
+ if ((res0 = framples(ind, 0)) - (res1 = framples(ind, 0, 0))).abs > 2
snd_display("apply_controls srate -1.0 lengths: %s %s", res0, res1)
end
res1 = sample(9327)
if fneq(res0 = maxamp, 0.147) or res1.abs < 0.01
snd_display("apply_controls srate -1.0 samples: %s %s?", res0, res1)
end
- if fneq(res = speed_control(ind), 1.0)
- snd_display("apply_controls -1.0 -> %s?", res)
- end
- ctr = 0
- $dac_hook.add_hook!("snd-test") do |data|
- ctr += 1
- if ctr >= 3
- set_playing(false)
- end
- end
- play(selected_sound, :wait, true)
- if ctr != 3
- snd_display("ctr after dac_hook: %s", ctr)
- end
+ snd_test_neq(speed_control(ind), 1.0, "apply_controls -1.0")
set_speed_control(1.5)
apply_controls
- $dac_hook.reset_hook!
- revert_sound
- set_speed_control(1.5)
- ctr = 0
- $dac_hook.add_hook!("snd-test") do |data|
- ctr += 1
- if ctr == 3
- apply_controls
- end
- end
- play(selected_sound, :wait, true)
- if edit_position(ind, 0) != 1
- snd_display("apply_controls from hook: %s %s", edits(ind), edit_tree(ind))
- end
- $dac_hook.reset_hook!
revert_sound
set_speed_control(1.5)
- stop_playing
$after_apply_controls_hook.add_hook!("snd-test") do |s|
- if (res = Snd.catch do apply_controls end).first != :cannot_apply_controls
- snd_display("after_apply_controls_hook: recursive attempt apply_controls: %s", res)
- end
+ snd_test_neq(Snd.catch do apply_controls() end.first,
+ :cannot_apply_controls,
+ "after_apply_controls_hook: recursive attempt apply_controls")
end
apply_controls
$after_apply_controls_hook.reset_hook!
- $dac_hook.add_hook!("snd-test") do |s|
- if (res = Snd.catch do apply_controls end).first != :cannot_apply_controls
- snd_display("dac_hook: recursive attempt apply_controls: %s", res)
- end
- end
- $dac_hook.reset_hook!
revert_sound
close_sound(ind)
#
- # Vct.new.map twice, Vct.new twice, and vct_map! twice
+ # Vct.new.map twice, and Vct.new twice
#
v1 = Vct.new(32)
v1.map! do
@@ -10969,176 +10454,93 @@ def test_06
v2.map! do 0.1 end
v2.first
end
- if fneq(v1[12], 0.1)
- snd_display("v.map! twice: %s?", v1[12])
- end
+ snd_test_neq(v1[12], 0.1, "v.map! twice")
Vct.new(32) do Vct.new(3) do 0.1 end.first end
- if fneq(v1[12], 0.1)
- snd_display("Vct.new twice: %s?", v1[12])
- end
- v1 = make_vct(32)
- vct_map!(v1, lambda do | |
- v2 = make_vct(3)
- vct_map!(v2, lambda do | | 0.1 end)
- vct_ref(v2, 0)
- end)
- if fneq(v1[12], 0.1)
- snd_display("vct_map! twice: %s?", v1[12])
- end
+ snd_test_neq(v1[12], 0.1, "v.new twice")
hi = make_vct(3)
- if (res = Snd.catch do vct_subseq(hi, 1, 0) end).first != :out_of_range
- snd_display("vct_subseq 1 0: %s", res.inspect)
- end
- unless vct?(vct())
- snd_display("vct -> %s?", vct().inspect)
- end
- unless vct?(res = make_vct(0))
- snd_display("make_vct(0) -> %s?", res.inspect)
- end
- ho = make_vct(3)
- vct_add!(hi, ho, 4)
+ snd_test_neq(Snd.catch do vct_subseq(hi, 1, 0) end.first,
+ :out_of_range, "vct_subseq 1 0")
+ snd_test_neq(vct?(vct()), true, "vct() not a vct")
+ snd_test_neq(vct?(make_vct(0)), true, "make_vct(0) not a vct")
v0 = make_vct(5, 0.1)
v1 = make_vct(6, 0.2)
v0.add!(v1, 2)
- unless vequal(v0, [0.1, 0.1, 0.3, 0.3, 0.3].to_vct)
- snd_display("v.add! + offset: %s?", v0)
- end
+ snd_test_neq(v0, [0.1, 0.1, 0.3, 0.3, 0.3].to_vct, "v.add! + offset")
#
# vct methods
#
- if (v1 = Vct.new(10)) != (v2 = make_vct(10))
- snd_display("Vct.new 0.000: %s %s?", v1, v2)
- end
- if (v1 = Vct.new(10, 3.14)) != (v2 = make_vct(10, 3.14))
- snd_display("Vct.new 3.140: %s %s?", v1, v2)
- end
+ snd_test_neq(Vct.new(10), make_vct(10), "Vct#new 0.000")
+ snd_test_neq(Vct.new(10, 3.14), make_vct(10, 3.14), "Vct#new 3.140")
v1 = Vct.new(10) do |i| i * 0.01 end
v2 = make_vct(10)
ctr = -1
- vct_map!(v2, lambda do | | (ctr += 1) * 0.01 end)
- if v1 != v2
- snd_display("Vct.new 0.000...0.090: %s %s?", v1, v2)
- end
- if vct_ref(v1, 8) != v2[8] or v2[8] != 0.08
- snd_display("Vct#[]: %s %s?", vct_ref(v1, 8), v2[8])
- end
+ v2.map! do |x| (ctr += 1) * 0.01 end
+ snd_test_neq(v1, v2, "Vct#new 0.000 0.010 0.020...")
+ snd_test_neq(vct_ref(v1, 8), v2[8], "Vct#[] (1)")
+ snd_test_neq(v2[8], 0.08, "Vct#[] (2)")
vct_set!(v1, 8, 0.5)
v2[8] = 0.5
- if vct_ref(v1, 8) != v2[8] or v2[8] != 0.5
- snd_display("Vct#[]=: %s %s?", vct_ref(v1, 8), v2[8])
- end
- if v1.length != vct_length(v2) or v2.length != vct_length(v1) or v2.length != 10
- snd_display("Vct#length: %s %s %s %s?", v1.length, vct_length(v1), v2.length, vct_length(v2))
- end
+ snd_test_neq(vct_ref(v1, 8), v2[8], "Vct#[]= (1)")
+ snd_test_neq(v2[8], 0.5, "Vct#[]= (2)")
+ snd_test_neq(v1.length, vct_length(v2), "Vct#length (1)")
+ snd_test_neq(v2.length, vct_length(v1), "Vct#length (2)")
+ snd_test_neq(v2.length, 10, "Vct#length (3)")
v1.each_with_index do |val, i|
- if val != vct_ref(v2, i)
- snd_display("Vct#each: %s %s?", val, vct_ref(v2, i))
- end
- end
- if (v1 <=> v2).nonzero?
- snd_display("Vct#<=> (0): %s?", (v1 <=> v2))
- end
- if (v3 = Vct.new(10) do |i| i * 0.001 end <=> v1) != -1
- snd_display("Vct#<=> (-1): %s?", (v3 <=> v1))
- end
- if (v2 <=> (v3 = Vct.new(10) do |i| i * 0.001 end)) != 1
- snd_display("Vct#<=> (1): %s?", (v2 <=> v3))
+ snd_test_neq(val, v2[i], "Vct#each (%d)", i)
end
+ snd_test_neq(v1 <=> v2, 0, "Vct#<=> (0)")
+ snd_test_neq(Vct.new(10) do |i| i * 0.001 end <=> v1, -1, "Vct#<=> (-1)")
+ snd_test_neq(v2 <=> Vct.new(10) do |i| i * 0.001 end, 1, "Vct#<=> (1)")
v2.map! do |val| val + 0.5 end
v3 = v1.map do |val| val + 0.5 end
- if v2 != v3
- snd_display("Vct#map(!): %s %s?", v2, v3)
- end
+ snd_test_neq(v2, v3, "Vct#map(!)")
v2 = v1.dup
- if (v1 <=> v2).nonzero?
- snd_display("Vct#dup: %s?", v1, v2)
- end
+ snd_test_neq(v1 <=> v2, 0, "Vct#dup")
vec1 = make_array(10) do |i| i * 0.01 end
vec1[8] = 0.5
vec2 = v2.to_a
- if vec1 != vec2
- snd_display("Vct#to_a: %s %s?", vec1, vec2)
- end
- if vec1.to_vct != v1
- snd_display("Array#to_vct: %s %s?", vec1.to_vct, v1)
- end
- if vct2string(v1) != v2.to_str or
- v2.to_str != "vct(0.000, 0.010, 0.020, 0.030, 0.040, 0.050, 0.060, 0.070, 0.500, 0.090)"
- snd_display("Vct#to_str:\n# %s\n# %s?", vct2string(v1), v2.to_str)
- end
- if v1.peak != vct_peak(v2)
- snd_display("Vct#peak: %s %s?", v1.peak, vct_peak(v2))
- end
+ snd_test_neq(vec1, vec2, "Vct#to_a")
+ snd_test_neq(vec1.to_vct, v1, "Array#to_vct")
+ snd_test_neq(vct2string(v1), v2.to_str, "Vct#to_str")
+ snd_test_neq(v2.to_str, "\
+vct(0.000, 0.010, 0.020, 0.030, 0.040, 0.050, 0.060, 0.070, 0.500, 0.090)",
+ "Vct#to_str")
+ snd_test_neq(v1.peak, vct_peak(v2), "Vct#peak")
v3 = v1.dup
v3.add!(v2)
v4 = v1.add(v2)
- if v3 != v4
- snd_display("Vct#add(!): %s %s?", v3, v4)
- end
+ snd_test_neq(v3, v4, "Vct#add(!)")
v3 = v1.dup
v3.subtract!(v2)
v4 = v1.subtract(v2)
- if v3 != v4
- snd_display("Vct#subtract(!): %s %s?", v3, v4)
- end
+ snd_test_neq(v3, v4, "Vct#subtract(!)")
v3 = v1.dup
v3.multiply!(v2)
v4 = v1.multiply(v2)
- if v3 != v4
- snd_display("Vct#multiply(!): %s %s?", v3, v4)
- end
+ snd_test_neq(v3, v4, "Vct#multiply(!)")
v3 = v1.dup
v3.offset!(0.5)
v4 = v1.offset(0.5)
- if v3 != v4
- snd_display("Vct#offset(!): %s %s?", v3, v4)
- end
+ snd_test_neq(v3, v4, "Vct#offset(!)")
v3 = v1.dup
v3.scale!(2.0)
v4 = v1.scale(2.0)
- if v3 != v4
- snd_display("Vct#scale(!): %s %s?", v3, v4)
- end
+ snd_test_neq(v3, v4, "Vct#scale(!)")
v3 = Vct.new(10)
v4 = Vct.new(10)
v3.fill(0.5)
vct_fill!(v4, 0.5)
- if v3 != v4
- snd_display("Vct#fill: %s %s?", v3, v4)
- end
- if v1.first != vct_ref(v2, 0)
- snd_display("Vct#first: %s %s?", v1.first, vct_ref(v2, 0))
- end
- if v1.last != vct_ref(v2, vct_length(v2) - 1)
- snd_display("Vct#last: %s %s?", v1.last, vct_ref(v2, vct_length(v2) - 1))
- end
+ snd_test_neq(v3, v4, "Vct#fill(!)")
+ snd_test_neq(v1.first, vct_ref(v2, 0), "Vct#first")
+ snd_test_neq(v1.last, vct_ref(v2, vct_length(v2) - 1), "Vct#last")
v1.first = 0.2
vct_set!(v2, 0, 0.2)
- if v1.first != vct_ref(v2, 0) or v1.first != 0.2
- snd_display("Vct#first: %s %s?", v1.first, vct_ref(v2, 0))
- end
+ snd_test_neq(v1.first, vct_ref(v2, 0), "Vct#first (2)")
+ snd_test_neq(v1.first, 0.2, "Vct#first (3)")
v1.last = 0.3
vct_set!(v2, vct_length(v2) - 1, 0.3)
- if v1.last != vct_ref(v2, vct_length(v2) - 1) or v1.last != 0.3
- snd_display("Vct#last: %s %s?", v1.last, vct_ref(v2, vct_length(v2) - 1))
- end
- #
- # make_fm_violin (v.rb)
- #
- samps = 1000
- ind = new_sound(:file, "fmv.snd", :srate, 22050, :channels, 2, :size, samps)
- dur = samples2seconds(samps)
- # thunk
- fmv1 = make_fm_violin(0, dur, 440, 0.5, :thunk?, true)
- v3 = make_vct(samps)
- vct_map!(v3, fmv1)
- vct2channel(v3, 0, samps, ind, 0)
- # proc with one arg
- fmv2 = make_fm_violin(0, dur, 440, 0.5, :thunk?, false)
- map_channel(fmv2, 0, samps, ind, 1)
- snd_test_neq(channel2vct(100, 100, ind, 0), channel2vct(100, 100, ind, 1), "make_fm_violin")
- close_sound(ind)
- delete_file("fmv.snd")
+ snd_test_neq(v1.last, vct_ref(v2, vct_length(v2) - 1), "Vct#last (2)")
+ snd_test_neq(v1.last, 0.3, "Vct#last (3)")
end
# ---------------- test 07: colors ----------------
@@ -11236,9 +10638,9 @@ end
def check_colormap(name, colmap, x, r, g, b, n, err)
r1, g1, b1 = colormap_ref(colmap, x)
if x < (1.0 - (1.0 / n)) and
- (fneq_err(r, r1, err) or # okay
- fneq_err(g, g1, err) or # okay
- fneq_err(b, b1, err)) # okay
+ (fneq_err(r, r1, err) or
+ fneq_err(g, g1, err) or
+ fneq_err(b, b1, err))
snd_display_prev_caller("%s %1.4f (%1.4f): %s %s",
name,
x,
@@ -11428,54 +10830,54 @@ def test_07_02(old_colormap_size)
if (res = colormap_name($rainbow_colormap)) != "rainbow"
snd_display("rainbow: %s?", res)
end
- purple_cmap = add_colormap("purple",
- lambda do |size|
- r = make_vct(size)
- g = make_vct(size)
- b = make_vct(size)
- er = [0, 60, 60, 116, 128, 252, 192, 252, 256, 60]
- eg = [0, 0, 64, 0, 128, 252, 192, 252, 256, 0]
- eb = [0, 80, 128, 252, 192, 0, 256, 80]
- incr = 256.0 / size
- x = 0.0
- size.times do |i|
- r[i] = envelope_interp(x, er) / 256.0
- g[i] = envelope_interp(x, eg) / 256.0
- b[i] = envelope_interp(x, eb) / 256.0
- x += incr
- end
- [r, g, b]
- end)
- sin_cmap = add_colormap("sin",
- lambda do |size|
- r = make_vct(size)
- g = make_vct(size)
- b = make_vct(size)
- incr = (2.0 * PI) / size
- x = 0.0
- size.times do |i|
- r[i] = sin(1.5 * x).abs
- g[i] = sin(3.5 * x).abs
- b[i] = sin(2.5 * x).abs
- x += incr
- end
- [r, g, b]
- end)
- another_sin_cmap = add_colormap("another-sin",
- lambda do |size|
- r = make_vct(size)
- g = make_vct(size)
- b = make_vct(size)
- incr = (2.0 * PI) / size
- x = 0.0
- size.times do |i|
- r[i] = sin(2.5 * x).abs
- g[i] = sin(3.5 * x).abs
- b[i] = sin(4.5 * x).abs
- x += incr
- end
- [r, g, b]
- end)
+ add_colormap("purple",
+ lambda do |size|
+ r = make_vct(size)
+ g = make_vct(size)
+ b = make_vct(size)
+ er = [0, 60, 60, 116, 128, 252, 192, 252, 256, 60]
+ eg = [0, 0, 64, 0, 128, 252, 192, 252, 256, 0]
+ eb = [0, 80, 128, 252, 192, 0, 256, 80]
+ incr = 256.0 / size
+ x = 0.0
+ size.times do |i|
+ r[i] = envelope_interp(x, er) / 256.0
+ g[i] = envelope_interp(x, eg) / 256.0
+ b[i] = envelope_interp(x, eb) / 256.0
+ x += incr
+ end
+ [r, g, b]
+ end)
+ add_colormap("sin",
+ lambda do |size|
+ r = make_vct(size)
+ g = make_vct(size)
+ b = make_vct(size)
+ incr = (2.0 * PI) / size
+ x = 0.0
+ size.times do |i|
+ r[i] = sin(1.5 * x).abs
+ g[i] = sin(3.5 * x).abs
+ b[i] = sin(2.5 * x).abs
+ x += incr
+ end
+ [r, g, b]
+ end)
+ add_colormap("another-sin",
+ lambda do |size|
+ r = make_vct(size)
+ g = make_vct(size)
+ b = make_vct(size)
+ incr = (2.0 * PI) / size
+ x = 0.0
+ size.times do |i|
+ r[i] = sin(2.5 * x).abs
+ g[i] = sin(3.5 * x).abs
+ b[i] = sin(4.5 * x).abs
+ x += incr
+ end
+ [r, g, b]
+ end)
[1024, 256, 2, 512].each do |n|
set_colormap_size(n)
10.times do |i|
@@ -11488,9 +10890,9 @@ def test_07_02(old_colormap_size)
err = 0.01
if n > 2 and
x < (1.0 - (1.0 / n)) and
- (fneq_err(r, r1, err) or # okay
- fneq_err(g, g1, err) or # okay
- fneq_err(b, b1, err)) # okay
+ (fneq_err(r, r1, err) or
+ fneq_err(g, g1, err) or
+ fneq_err(b, b1, err))
snd_display("copper size reset %s: %1.4f (%1.4f): %s %s",
n,
x,
@@ -11517,36 +10919,33 @@ end
# ---------------- test 08: clm ----------------
def sweep2bins(flt, bins)
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1, false, 22050)
- phase = 0.0
- freq = 0.0
- incr = PI / 22050
- map_channel(lambda do |y|
- val = sin(phase)
- phase += freq
- freq += incr
- 0.5 * val
- end)
- if proc?(flt)
- map_channel(flt)
+ ind = open_sound("sweep.snd")
+ if mus_generator?(flt)
+ clm_channel(flt)
else
- map_channel(lambda do |y| flt.run(y, 0.0) end)
+ map_channel(flt)
end
- mx = maxamp
+ mx = maxamp()
size = (22050 / bins).round
- resp = Vct.new(bins) do |i| channel2vct(i * size, size).peak end
+ resp = Vct.new(bins) do |i|
+ channel2vct(i * size, size).peak
+ end
close_sound(ind)
[mx, resp]
end
def filter_response_max(f1)
- mx = 0.0
- 1000.times do |i| mx = [mx, f1.run(i.zero? ? 1.0 : 0.0, 0.0).abs].max end
+ mx = f1.run(1.0).abs
+ 1000.times do |i|
+ mx = [mx, f1.run(0.0).abs].max
+ end
mx
end
def filter_equal?(f1, f2)
- f1.order == f2.order and vequal(f1.xcoeffs, f2.xcoeffs) and vequal(f1.ycoeffs, f2.ycoeffs)
+ f1.order == f2.order and
+ vequal(f1.xcoeffs, f2.xcoeffs) and
+ vequal(f1.ycoeffs, f2.ycoeffs)
end
def f05equal?(f1, f2)
@@ -11557,12 +10956,11 @@ def analog_filter_tests
#
# Butterworth
#
- poles = [vct(1.000, 1.414, 1.000),
- vct(1.000, 1.848, 1.000, 1.000, 0.765, 1.000),
- vct(1.000, 1.932, 1.000, 1.000, 1.414, 1.000, 1.000, 0.518, 1.000),
- vct(1.000, 1.962, 1.000, 1.000, 1.663, 1.000, 1.000, 1.111, 1.000, 1.000, 0.390, 1.000),
- vct(1.000, 1.975, 1.000, 1.000, 1.782, 1.000, 1.000, 1.414, 1.000, 1.000, 0.908, 1.000,
- 1.000, 0.313, 1.000)]
+ poles = [vct(1, 1.414, 1),
+ vct(1, 1.848, 1, 1, 0.765, 1),
+ vct(1, 1.932, 1, 1, 1.414, 1, 1, 0.518, 1),
+ vct(1, 1.962, 1, 1, 1.663, 1, 1, 1.111, 1, 1, 0.390, 1),
+ vct(1, 1.975, 1, 1, 1.782, 1, 1, 1.414, 1, 1, 0.908, 1, 1, 0.313, 1)]
k = 0
2.step(11, 2) do |i|
vals = butterworth_prototype(i)
@@ -11582,10 +10980,12 @@ def analog_filter_tests
2.step(16, 2) do |i|
local = make_butterworth_lowpass(i, cutoff)
dsp = make_butter_lp(k, mus_srate * cutoff)
- snd_test_any_neq(local, dsp, :filter_equal?, "butterworth lowpass %1.4f", cutoff)
+ snd_test_any_neq(local, dsp, :filter_equal?,
+ "butterworth lowpass %1.4f", cutoff)
local = make_butterworth_highpass(i, cutoff)
dsp = make_butter_hp(k, mus_srate * cutoff)
- snd_test_any_neq(local, dsp, :filter_equal?, "butterworth highpass %1.4f", cutoff)
+ snd_test_any_neq(local, dsp, :filter_equal?,
+ "butterworth highpass %1.4f", cutoff)
k += 1
end
cutoff += 0.1
@@ -11599,133 +10999,128 @@ def analog_filter_tests
map_channel(chordalize())
close_sound(ind)
#
+ ind = new_sound("sweep.snd", 1, 22050, Mus_bfloat, Mus_next, false, 22050)
+ phase = 0.0
+ freq = 0.0
+ incr = PI / 22050.0
+ map_channel(lambda do |y|
+ val = sin(phase)
+ phase += freq
+ freq += incr
+ val * 0.5
+ end)
+ save_sound(ind)
+ close_sound(ind)
f1 = make_butterworth_lowpass(8, 0.1)
vals = sweep2bins(f1, 10)
snd_test_neq(vals[0], 0.5, "butterworth lp 8 max")
- snd_test_neq(vals[1],
- vct(0.500, 0.500, 0.359, 0.014, 0.001, 0.000, 0.000, 0.000, 0.000, 0.000),
- "butterworth lp 8 0.1 spect")
+ v1 = vct(0.500, 0.500, 0.359, 0.014, 0.001, 0.000, 0.000, 0.000, 0.000, 0.000)
+ snd_test_neq(vals[1], v1, "butterworth lp 8 0.1 spect")
f1 = make_butterworth_lowpass(12, 0.25)
vals = sweep2bins(f1, 10)
snd_test_neq(vals[0], 0.5, "butterworth lp 12 max")
- snd_test_neq(vals[1],
- vct(0.500, 0.500, 0.500, 0.500, 0.499, 0.358, 0.010, 0.000, 0.000, 0.000),
- "butterworth lp 12 0.25 spect")
+ v1 = vct(0.500, 0.500, 0.500, 0.500, 0.499, 0.358, 0.010, 0.000, 0.000, 0.000)
+ snd_test_neq(vals[1], v1, "butterworth lp 12 0.25 spect")
f1 = make_butterworth_lowpass(10, 0.4)
vals = sweep2bins(f1, 10)
snd_test_neq(vals[0], 0.5, "butterworth lp 10 max")
- if (not vequal(vals[1], vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.499, 0.361, 0.001))) and
- (not vequal(vals[1], vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.499, 0.360, 0.002)))
- snd_display(snd_format_neq(vals[1],
- vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.499, 0.361, 0.001),
- "butterworth lp 10 0.4 spect"))
+ v0 = vals[1]
+ v1 = vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.499, 0.361, 0.001)
+ v2 = vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.499, 0.360, 0.002)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2))
+ snd_test_neq(v0, v1, "butterworth lp 10 0.4 spect (v1)")
+ snd_test_neq(v0, v2, "butterworth lp 10 0.4 spect (v2)")
end
2.step(12, 2) do |i|
0.1.step(0.35, 0.1) do |j|
f1 = make_butterworth_lowpass(i, j)
- mx = filter_response_max(f1)
- if mx > 1.0
- snd_display(snd_format(mx, 1.0, ">", "butter low max %d %d", i, j))
- end
+ snd_test_gt(filter_response_max(f1), 1.0, "butter low max %d %d", i, j)
end
end
#
f1 = make_butterworth_highpass(8, 0.1)
vals = sweep2bins(f1, 10)
snd_test_neq(vals[0], 0.5, "butterworth hp 8 max")
- snd_test_neq(vals[1],
- vct(0.001, 0.348, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500),
- "butterworth hp 8 0.1 spect")
+ v1 = vct(0.001, 0.348, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500)
+ snd_test_neq(vals[1], v1, "butterworth hp 8 0.1 spect")
f1 = make_butterworth_highpass(12, 0.25)
vals = sweep2bins(f1, 10)
snd_test_neq(vals[0], 0.5, "butterworth hp 12 max")
- snd_test_neq(vals[1],
- vct(0.000, 0.000, 0.000, 0.011, 0.348, 0.500, 0.500, 0.500, 0.500, 0.500),
- "butterworth hp 12 0.25 spect")
+ v1 = vct(0.000, 0.000, 0.000, 0.011, 0.348, 0.500, 0.500, 0.500, 0.500, 0.500)
+ snd_test_neq(vals[1], v1, "butterworth hp 12 0.25 spect")
f1 = make_butterworth_highpass(10, 0.4)
vals = sweep2bins(f1, 10)
snd_test_neq(vals[0], 0.5, "butterworth hp 10 max")
- snd_test_neq(vals[1],
- vct(0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.005, 0.343, 0.501, 0.501),
- "butterworth hp 10 0.4 spect")
+ v1 = vct(0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.005, 0.343, 0.501, 0.501)
+ snd_test_neq(vals[1], v1, "butterworth hp 10 0.4 spect")
2.step(12, 2) do |i|
0.1.step(0.35, 0.1) do |j|
f1 = make_butterworth_highpass(i, j)
- mx = filter_response_max(f1)
- if mx > 1.0
- snd_display(snd_format(mx, 1.0, ">", "butter high max %d %d", i, j))
- end
+ snd_test_gt(filter_response_max(f1), 1.0, "butter high max %d %d", i, j)
end
end
#
f1 = make_butterworth_bandpass(4, 0.1, 0.2)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bp 4 max") # okay
- snd_test_neq(vals[1],
- vct(0.028, 0.350, 0.481, 0.479, 0.346, 0.132, 0.038, 0.009, 0.002, 0.000),
- "butterworth bp 4 0.1 0.2 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bp 4 max")
+ v1 = vct(0.028, 0.350, 0.481, 0.479, 0.346, 0.132, 0.038, 0.009, 0.002, 0.000)
+ snd_test_neq(vals[1], v1, "butterworth bp 4 0.1 0.2 spect")
f1 = make_butterworth_bandpass(12, 0.1, 0.2)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bp 12 max") # okay
- snd_test_neq(vals[1],
- vct(0.000, 0.323, 0.501, 0.500, 0.358, 0.009, 0.000, 0.000, 0.000, 0.000),
- "butterworth bp 12 0.1 0.2 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bp 12 max")
+ v1 = vct(0.000, 0.323, 0.501, 0.500, 0.358, 0.009, 0.000, 0.000, 0.000, 0.000)
+ snd_test_neq(vals[1], v1, "butterworth bp 12 0.1 0.2 spect")
f1 = make_butterworth_bandpass(8, 0.3, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bp 8 max") # okay
- snd_test_neq(vals[1],
- vct(0.000, 0.000, 0.000, 0.003, 0.034, 0.344, 0.499, 0.499, 0.353, 0.002),
- "butterworth bp 8 0.3 0.4 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bp 8 max")
+ v1 = vct(0.000, 0.000, 0.000, 0.003, 0.034, 0.344, 0.499, 0.499, 0.353, 0.002)
+ snd_test_neq(vals[1], v1, "butterworth bp 8 0.3 0.4 spect")
#
f1 = make_butterworth_bandstop(4, 0.1, 0.2)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bs 4 max") # okay
- snd_test_neq(vals[1],
- vct(0.500, 0.500, 0.347, 0.339, 0.481, 0.499, 0.500, 0.500, 0.500, 0.500),
- "butterworth bs 4 0.1 0.2 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bs 4 max")
+ v1 = vct(0.500, 0.500, 0.347, 0.339, 0.481, 0.499, 0.500, 0.500, 0.500, 0.500)
+ snd_test_neq(vals[1], v1, "butterworth bs 4 0.1 0.2 spect")
f1 = make_butterworth_bandstop(12, 0.1, 0.2)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bs 12 max") # okay
- snd_test_neq(vals[1],
- vct(0.500, 0.500, 0.365, 0.334, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500),
- "butterworth bs 12 0.1 0.2 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bs 12 max")
+ v1 = vct(0.500, 0.500, 0.365, 0.334, 0.500, 0.500, 0.500, 0.500, 0.500, 0.500)
+ snd_test_neq(vals[1], v1, "butterworth bs 12 0.1 0.2 spect")
f1 = make_butterworth_bandstop(8, 0.3, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bs 8 max") # okay
- snd_test_neq(vals[1],
- vct(0.500, 0.500, 0.500, 0.500, 0.500, 0.498, 0.354, 0.332, 0.500, 0.500),
- "butterworth bs 8 0.3 0.4 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "butterworth bs 8 max")
+ v1 = vct(0.500, 0.500, 0.500, 0.500, 0.500, 0.498, 0.354, 0.332, 0.500, 0.500)
+ snd_test_neq(vals[1], v1, "butterworth bs 8 0.3 0.4 spect")
#
# Chebyshev
#
# ripple 0.01 0.1 1 for 2..10 even
- poles_01 = [vct(1.000, 4.456, 10.426),
- vct(1.000, 0.822, 2.006, 1.000, 1.984, 1.299),
- vct(1.000, 0.343, 1.372, 1.000, 0.937, 0.939, 1.000, 1.280, 0.506),
- vct(1.000, 0.189, 1.196, 1.000, 0.537, 0.925, 1.000, 0.804, 0.542,
- 1.000, 0.948, 0.272),
- vct(1.000, 0.119, 1.121, 1.000, 0.347, 0.940, 1.000, 0.540, 0.646,
- 1.000, 0.680, 0.352, 1.000, 0.754, 0.170)]
- zeros = [vct(0.000, 0.000, 1.000),
- vct(0.000, 0.000, 0.250, 0.000, 0.000, 1.000),
- vct(0.000, 0.000, 0.062, 0.000, 0.000, 1.000, 0.000, 0.000, 1.000),
- vct(0.000, 0.000, 0.016, 0.000, 0.000, 1.000, 0.000, 0.000, 1.000, 0.000, 0.000, 1.000),
- vct(0.000, 0.000, 0.004, 0.000, 0.000, 1.000, 0.000, 0.000, 1.000, 0.000, 0.000, 1.000,
- 0.000, 0.000, 1.000)]
- poles_1 = [vct(1.000, 2.372, 3.314),
- vct(1.000, 0.528, 1.330, 1.000, 1.275, 0.623),
- vct(1.000, 0.229, 1.129, 1.000, 0.627, 0.696, 1.000, 0.856, 0.263),
- vct(1.000, 0.128, 1.069, 1.000, 0.364, 0.799, 1.000, 0.545, 0.416,
- 1.000, 0.643, 0.146),
- vct(1.000, 0.082, 1.044, 1.000, 0.237, 0.862, 1.000, 0.369, 0.568,
- 1.000, 0.465, 0.274, 1.000, 0.515, 0.092)]
- poles_10 = [vct(1.000, 1.098, 1.103),
- vct(1.000, 0.279, 0.987, 1.000, 0.674, 0.279),
- vct(1.000, 0.124, 0.991, 1.000, 0.340, 0.558, 1.000, 0.464, 0.125),
- vct(1.000, 0.070, 0.994, 1.000, 0.199, 0.724, 1.000, 0.298, 0.341,
- 1.000, 0.352, 0.070),
- vct(1.000, 0.045, 0.996, 1.000, 0.130, 0.814, 1.000, 0.203, 0.521,
- 1.000, 0.255, 0.227, 1.000, 0.283, 0.045)]
+ poles_01 = [vct(1, 4.456, 10.426),
+ vct(1, 0.822, 2.006, 1, 1.984, 1.299),
+ vct(1, 0.343, 1.372, 1, 0.937, 0.939, 1, 1.280, 0.506),
+ vct(1, 0.189, 1.196, 1, 0.537, 0.925, 1, 0.804, 0.542,
+ 1, 0.948, 0.272),
+ vct(1, 0.119, 1.121, 1, 0.347, 0.940, 1, 0.540, 0.646,
+ 1, 0.680, 0.352, 1, 0.754, 0.170)]
+ zeros = [vct(0, 0, 1),
+ vct(0, 0, 0.250, 0, 0, 1),
+ vct(0, 0, 0.062, 0, 0, 1, 0, 0, 1),
+ vct(0, 0, 0.016, 0, 0, 1, 0, 0, 1, 0, 0, 1),
+ vct(0, 0, 0.004, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1)]
+ poles_1 = [vct(1, 2.372, 3.314),
+ vct(1, 0.528, 1.330, 1, 1.275, 0.623),
+ vct(1, 0.229, 1.129, 1, 0.627, 0.696, 1, 0.856, 0.263),
+ vct(1, 0.128, 1.069, 1, 0.364, 0.799, 1, 0.545, 0.416,
+ 1, 0.643, 0.146),
+ vct(1, 0.082, 1.044, 1, 0.237, 0.862, 1, 0.369, 0.568,
+ 1, 0.465, 0.274, 1, 0.515, 0.092)]
+ poles_10 = [vct(1, 1.098, 1.103),
+ vct(1, 0.279, 0.987, 1, 0.674, 0.279),
+ vct(1, 0.124, 0.991, 1, 0.340, 0.558, 1, 0.464, 0.125),
+ vct(1, 0.070, 0.994, 1, 0.199, 0.724, 1, 0.298, 0.341,
+ 1, 0.352, 0.070),
+ vct(1, 0.045, 0.996, 1, 0.130, 0.814, 1, 0.203, 0.521,
+ 1, 0.255, 0.227, 1, 0.283, 0.045)]
k = 0
2.step(11, 2) do |i|
vals = chebyshev_prototype(i, 0.01)
@@ -11740,289 +11135,285 @@ def analog_filter_tests
#
f1 = make_chebyshev_lowpass(8, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "chebyshev lp 8 max") # okay
- if (not vequal(vals[1], vct(0.508, 0.512, 0.468, 0.001, 0, 0, 0, 0, 0, 0))) and
- (not vequal(vals[1], vct(0.507, 0.512, 0.467, 0.001, 0, 0, 0, 0, 0, 0))) and
- (not vequal(vals[1], vct(0.508, 0.513, 0.469, 0.001, 0, 0, 0, 0, 0, 0))) and
- (not vequal(vals[1], vct(0.509, 0.508, 0.465, 0.001, 0, 0, 0, 0, 0, 0)))
- snd_display(snd_format_neq(vals[1],
- vct(0.508, 0.512, 0.468, 0.001, 0, 0, 0, 0, 0, 0),
- "chebyshev lp 8 0.1 spect"))
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "chebyshev lp 8 max")
+ v0 = vals[1]
+ v1 = vct(0.508, 0.512, 0.468, 0.001, 0, 0, 0, 0, 0, 0)
+ v2 = vct(0.507, 0.512, 0.467, 0.001, 0, 0, 0, 0, 0, 0)
+ v3 = vct(0.508, 0.513, 0.469, 0.001, 0, 0, 0, 0, 0, 0)
+ v4 = vct(0.509, 0.508, 0.465, 0.001, 0, 0, 0, 0, 0, 0)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2)) and
+ (not vequal(v0, v3)) and (not vequal(v0, v4))
+ snd_test_neq(v0, v1, "chebyshev lp 8 0.1 spect (v1)")
+ snd_test_neq(v0, v2, "chebyshev lp 8 0.1 spect (v2)")
+ snd_test_neq(v0, v3, "chebyshev lp 8 0.1 spect (v3)")
+ snd_test_neq(v0, v4, "chebyshev lp 8 0.1 spect (v4)")
end
f1 = make_chebyshev_lowpass(12, 0.25)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "chebyshev lp 12 max") # okay
- snd_test_neq(vals[1],
- vct(0.509, 0.500, 0.508, 0.508, 0.507, 0.413, 0, 0, 0, 0),
- "chebyshev lp 12 0.25 spect")
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "chebyshev lp 12 max")
+ v1 = vct(0.509, 0.500, 0.508, 0.508, 0.507, 0.413, 0, 0, 0, 0)
+ snd_test_neq(vals[1], v1, "chebyshev lp 12 0.25 spect")
f1 = make_chebyshev_lowpass(10, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "chebyshev lp 10 max") # okay
- snd_test_neq(vals[1],
- vct(0.465, 0.493, 0.509, 0.508, 0.477, 0.507, 0.508, 0.507, 0.431, 0),
- "chebyshev lp 10 0.4 spect")
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "chebyshev lp 10 max")
+ v1 = vct(0.465, 0.493, 0.509, 0.508, 0.477, 0.507, 0.508, 0.507, 0.431, 0)
+ snd_test_neq(vals[1], v1, "chebyshev lp 10 0.4 spect")
f1 = make_chebyshev_lowpass(8, 0.1, 0.01)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.49, :ffequal?, "chebyshev lp 8 0.1 0.01 max") # okay
- snd_test_neq(vals[1],
- vct(0.492, 0.491, 0.483, 0.006, 0, 0, 0, 0, 0, 0),
- "chebyshev lp 8 0.1 0.01 spect")
+ snd_test_any_neq(vals[0], 0.49, :ffequal?, "chebyshev lp 8 0.1 0.01 max")
+ v1 = vct(0.492, 0.491, 0.483, 0.006, 0, 0, 0, 0, 0, 0)
+ snd_test_neq(vals[1], v1, "chebyshev lp 8 0.1 0.01 spect")
f1 = make_chebyshev_lowpass(12, 0.25, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.49, :ffequal?, "chebyshev lp 12 0.1 max") # okay
- snd_test_neq(vals[1],
- vct(0.488, 0.488, 0.488, 0.488, 0.487, 0.403, 0, 0, 0, 0),
- "chebyshev lp 12 0.25 0.1 spect")
+ snd_test_any_neq(vals[0], 0.49, :ffequal?, "chebyshev lp 12 0.1 max")
+ v1 = vct(0.488, 0.488, 0.488, 0.488, 0.487, 0.403, 0, 0, 0, 0)
+ snd_test_neq(vals[1], v1, "chebyshev lp 12 0.25 0.1 spect")
f1 = make_chebyshev_lowpass(10, 0.4, 0.001)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.49, :ffequal?, "chebyshev lp 10 0.001 max") # okay
- snd_test_neq(vals[1],
- vct(0.497, 0.497, 0.497, 0.497, 0.497, 0.497, 0.497, 0.497, 0.488, 0),
- "chebyshev lp 10 0.4 0.001 spect")
+ snd_test_any_neq(vals[0], 0.49, :ffequal?, "chebyshev lp 10 0.001 max")
+ v1 = vct(0.497, 0.497, 0.497, 0.497, 0.497, 0.497, 0.497, 0.497, 0.488, 0)
+ snd_test_neq(vals[1], v1, "chebyshev lp 10 0.4 0.001 spect")
2.step(10, 2) do |i|
0.1.step(0.35, 0.1) do |j|
f1 = make_chebyshev_lowpass(i, j)
- mx = filter_response_max(f1)
- if mx > 1.0
- snd_display(snd_format(mx, 1.0, ">", "cheby low max %d %d", i, j))
- end
+ snd_test_gt(filter_response_max(f1), 1.0, "cheby low max %d %d", i, j)
end
end
#
f1 = make_chebyshev_highpass(8, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.55, :ffequal?, "chebyshev hp 8 max") # okay
- snd_test_neq(vals[1],
- vct(0, 0.341, 0.551, 0.509, 0.466, 0.501, 0.509, 0.505, 0.481, 0.461),
- "chebyshev hp 8 0.1 spect")
+ snd_test_any_neq(vals[0], 0.55, :ffequal?, "chebyshev hp 8 max")
+ v1 = vct(0, 0.341, 0.551, 0.509, 0.466, 0.501, 0.509, 0.505, 0.481, 0.461)
+ snd_test_neq(vals[1], v1, "chebyshev hp 8 0.1 spect")
f1 = make_chebyshev_highpass(12, 0.25)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.55, :ffequal?, "chebyshev hp 12 max") # okay
- snd_test_neq(vals[1],
- vct(0, 0, 0, 0, 0.299, 0.554, 0.509, 0.509, 0.500, 0.509),
- "chebyshev hp 12 0.25 spect")
+ snd_test_any_neq(vals[0], 0.55, :ffequal?, "chebyshev hp 12 max")
+ v1 = vct(0, 0, 0, 0, 0.299, 0.554, 0.509, 0.509, 0.500, 0.509)
+ snd_test_neq(vals[1], v1, "chebyshev hp 12 0.25 spect")
f1 = make_chebyshev_highpass(10, 0.4)
vals = sweep2bins(f1, 10)
- # snd_test_any_neq(vals[0], 0.55, :ffequal?, "chebyshev hp 10 max") # okay
- if (not vequal(vals[1], vct(0, 0, 0, 0, 0, 0, 0, 0.297, 0.786, 0.677))) and
- (not vequal(vals[1], vct(0, 0, 0, 0, 0, 0, 0, 0.301, 0.788, 0.660))) and
- (not vequal(vals[1], vct(0, 0, 0, 0, 0, 0, 0, 0.322, 0.861, 0.724))) and
- (not vequal(vals[1], vct(0, 0, 0, 0, 0, 0, 0, 0.262, 0.571, 0.509)))
- snd_display(snd_format_neq(vals[1],
- vct(0, 0, 0, 0, 0, 0, 0, 0.297, 0.786, 0.677),
- "chebyshev hp 10 0.4 spect"))
+ v0 = vals[1]
+ v1 = vct(0, 0, 0, 0, 0, 0, 0, 0.297, 0.786, 0.677)
+ v2 = vct(0, 0, 0, 0, 0, 0, 0, 0.301, 0.788, 0.660)
+ v3 = vct(0, 0, 0, 0, 0, 0, 0, 0.322, 0.861, 0.724)
+ v4 = vct(0, 0, 0, 0, 0, 0, 0, 0.262, 0.571, 0.509)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2)) and
+ (not vequal(v0, v3)) and (not vequal(v0, v4))
+ snd_test_neq(v0, v1, "chebyshev hp 10 0.4 spect (v1)")
+ snd_test_neq(v0, v2, "chebyshev hp 10 0.4 spect (v2)")
+ snd_test_neq(v0, v3, "chebyshev hp 10 0.4 spect (v3)")
+ snd_test_neq(v0, v4, "chebyshev hp 10 0.4 spect (v4)")
end
f1 = make_chebyshev_highpass(8, 0.1, 0.01)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.49, :ffequal?, "chebyshev hp 8 0.1 0.01 max") # okay
- snd_test_neq(vals[1],
- vct(0, 0.498, 0.498, 0.492, 0.491, 0.492, 0.492, 0.492, 0.491, 0.491),
- "chebyshev hp 8 0.1 0.01 spect")
+ snd_test_any_neq(vals[0], 0.49, :ffequal?, "chebyshev hp 8 0.1 0.01 max")
+ v1 = vct(0, 0.498, 0.498, 0.492, 0.491, 0.492, 0.492, 0.492, 0.491, 0.491)
+ snd_test_neq(vals[1], v1, "chebyshev hp 8 0.1 0.01 spect")
f1 = make_chebyshev_highpass(12, 0.25, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "chebyshev hp 12 0.1 max") # okay
- snd_test_neq(vals[1],
- vct(0, 0, 0, 0, 0.453, 0.516, 0.489, 0.489, 0.488, 0.488),
- "chebyshev hp 12 0.25 0.1 spect")
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "chebyshev hp 12 0.1 max")
+ v1 = vct(0, 0, 0, 0, 0.453, 0.516, 0.489, 0.489, 0.488, 0.488)
+ snd_test_neq(vals[1], v1, "chebyshev hp 12 0.25 0.1 spect")
f1 = make_chebyshev_highpass(10, 0.4, 0.001)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :ffequal?, "chebyshev 10 0.001 max") # okay
- snd_test_neq(vals[1],
- vct(0, 0, 0, 0, 0, 0, 0.002, 0.503, 0.505, 0.504),
- "chebyshev hp 10 0.4 0.001 spect")
+ snd_test_any_neq(vals[0], 0.5, :ffequal?, "chebyshev 10 0.001 max")
+ v0 = vals[1]
+ v1 = vct(0, 0, 0, 0, 0, 0, 0.002, 0.501, 0.504, 0.504)
+ v2 = vct(0, 0, 0, 0, 0, 0, 0.002, 0.503, 0.505, 0.504)
+ v3 = vct(0, 0, 0, 0, 0, 0, 0.002, 0.503, 0.501, 0.497)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2)) and (not vequal(v0, v3))
+ snd_test_neq(v0, v1, "chebyshev hp 10 0.4 0.001 spect (v1)")
+ snd_test_neq(v0, v2, "chebyshev hp 10 0.4 0.001 spect (v2)")
+ snd_test_neq(v0, v3, "chebyshev hp 10 0.4 0.001 spect (v3)")
+ end
2.step(10, 2) do |i|
0.1.step(0.35, 0.1) do |j|
f1 = make_chebyshev_highpass(i, j)
- mx = filter_response_max(f1)
- if mx > 1.0
- snd_display(snd_format(mx, 1.0, ">", "cheby high max %d %d", i, j))
- end
+ snd_test_gt(filter_response_max(f1), 1.0, "cheby high max %d %d", i, j)
end
end
#
f1 = make_chebyshev_bandpass(4, 0.1, 0.2)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bp 4 max") # okay
- snd_test_neq(vals[1],
- vct(0.009, 0.449, 0.509, 0.505, 0.442, 0.065, 0.013, 0.003, 0, 0),
- "chebyshev bp 4 0.1 0.2 spect")
-
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bp 4 max")
+ v1 = vct(0.009, 0.449, 0.509, 0.505, 0.442, 0.065, 0.013, 0.003, 0, 0)
+ snd_test_neq(vals[1], v1, "chebyshev bp 4 0.1 0.2 spect")
f1 = make_chebyshev_bandpass(6, 0.1, 0.2)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bp 6 max") # okay
- snd_test_neq(vals[1],
- vct(0.001, 0.376, 0.505, 0.498, 0.412, 0.011, 0.001, 0, 0, 0),
- "chebyshev bp 6 0.1 0.2 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bp 6 max")
+ v1 = vct(0.001, 0.376, 0.505, 0.498, 0.412, 0.011, 0.001, 0, 0, 0)
+ snd_test_neq(vals[1], v1, "chebyshev bp 6 0.1 0.2 spect")
f1 = make_chebyshev_bandpass(8, 0.3, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bp 8 max") # okay
- snd_test_neq(vals[1],
- vct(0, 0, 0, 0, 0.002, 0.363, 0.517, 0.513, 0.433, 0),
- "chebyshev bp 8 0.3 0.4 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bp 8 max")
+ v1 = vct(0, 0, 0, 0, 0.002, 0.363, 0.517, 0.513, 0.433, 0)
+ snd_test_neq(vals[1], v1, "chebyshev bp 8 0.3 0.4 spect")
f1 = make_chebyshev_bandpass(8, 0.2, 0.2, 0.01)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bp 10 0.2 max") # okay
- snd_test_neq(vals[1],
- vct(0, 0, 0.015, 0.483, 0.482, 0.021, 0.001, 0, 0, 0),
- "chebyshev bp 10 0.2 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bp 10 0.2 max")
+ v1 = vct(0, 0, 0.015, 0.483, 0.482, 0.021, 0.001, 0, 0, 0)
+ snd_test_neq(vals[1], v1, "chebyshev bp 10 0.2 spect")
#
f1 = make_chebyshev_bandstop(4, 0.1, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bs 4 max") # okay
- snd_test_neq(vals[1],
- vct(0.509, 0.505, 0.447, 0.033, 0.006, 0.006, 0.033, 0.445, 0.512, 0.509),
- "chebyshev bs 4 0.1 0.4 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bs 4 max")
+ v1 = vct(0.509, 0.505, 0.447, 0.033, 0.006, 0.006, 0.033, 0.445, 0.512, 0.509)
+ snd_test_neq(vals[1], v1, "chebyshev bs 4 0.1 0.4 spect")
f1 = make_chebyshev_bandstop(8, 0.1, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :f05equal?, "chebyshev bs 8 max") # okay
- if (not vequal(vals[1], vct(0.508, 0.512, 0.468, 0.001, 0, 0, 0.001, 0.345, 0.551, 0.507))) and
- (not vequal(vals[1], vct(0.507, 0.512, 0.467, 0.001, 0, 0, 0.001, 0.344, 0.59, 0.508))) and
- (not vequal(vals[1], vct(0.508, 0.513, 0.469, 0.001, 0, 0, 0.001, 0.345, 0.552, 0.508))) and
- (not vequal(vals[1], vct(0.509, 0.508, 0.465, 0.001, 0, 0, 0.001, 0.343, 0.548, 0.508)))
- snd_display(snd_format(vals[1],
- vct(0.508, 0.512, 0.468, 0.001, 0, 0, 0.001, 0.345, 0.551, 0.507),
- "chebyshev bs 8 0.1 0.4 spect"))
+ snd_test_any_neq(vals[0], 0.51, :f05equal?, "chebyshev bs 8 max")
+ v0 = vals[1]
+ v1 = vct(0.508, 0.512, 0.468, 0.001, 0, 0, 0.001, 0.345, 0.551, 0.507)
+ v2 = vct(0.507, 0.512, 0.467, 0.001, 0, 0, 0.001, 0.344, 0.590, 0.508)
+ v3 = vct(0.508, 0.513, 0.469, 0.001, 0, 0, 0.001, 0.345, 0.552, 0.508)
+ v4 = vct(0.509, 0.508, 0.465, 0.001, 0, 0, 0.001, 0.343, 0.548, 0.508)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2)) and
+ (not vequal(v0, v3)) and (not vequal(v0, v4))
+ snd_test_neq(v0, v1, "chebyshev bs 8 0.1 0.4 spect (v1)")
+ snd_test_neq(v0, v2, "chebyshev bs 8 0.1 0.4 spect (v2)")
+ snd_test_neq(v0, v3, "chebyshev bs 8 0.1 0.4 spect (v3)")
+ snd_test_neq(v0, v4, "chebyshev bs 8 0.1 0.4 spect (v4)")
end
f1 = make_chebyshev_bandstop(8, 0.1, 0.4, 0.01)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bs 8 0.01 max") # okay
- snd_test_neq(vals[1],
- vct(0.492, 0.491, 0.483, 0.006, 0, 0, 0.006, 0.494, 0.495, 0.492),
- "chebyshev bs 8 0.1 0.4 0.01 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "chebyshev bs 8 0.01 max")
+ v1 = vct(0.492, 0.491, 0.483, 0.006, 0, 0, 0.006, 0.494, 0.495, 0.492)
+ snd_test_neq(vals[1], v1, "chebyshev bs 8 0.1 0.4 0.01 spect")
#
# inverse-chebyshev
#
f1 = make_inverse_chebyshev_lowpass(8, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev lp 8 max") # okay
- if (not vequal(vals[1], vct(0.501, 0.496, 0.001, 0, 0.001, 0, 0, 0, 0, 0.001))) and
- (not vequal(vals[1], vct(0.500, 0.498, 0.001, 0, 0.001, 0, 0, 0, 0, 0.001)))
- snd_display(snd_format_neq(vals[1],
- vct(0.501, 0.496, 0.001, 0, 0.001, 0, 0, 0, 0, 0.001),
- "inverse_chebyshev lp 8 0.1 spect"))
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev lp 8 max")
+ v0 = vals[1]
+ v1 = vct(0.501, 0.496, 0.001, 0, 0.001, 0, 0, 0, 0, 0.001)
+ v2 = vct(0.500, 0.498, 0.001, 0, 0.001, 0, 0, 0, 0, 0.001)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2))
+ snd_test_neq(v0, v1, "inverse_chebyshev lp 8 0.1 spect (v1)")
+ snd_test_neq(v0, v2, "inverse_chebyshev lp 8 0.1 spect (v2)")
end
f1 = make_inverse_chebyshev_lowpass(12, 0.25)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev lp 12 max") # okay
- snd_test_neq(vals[1],
- vct(0.500, 0.500, 0.500, 0.500, 0.496, 0.001, 0.001, 0.001, 0.001, 0.001),
- "inverse_chebyshev lp 12 0.25 spect")
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev lp 12 max")
+ v1 = vct(0.500, 0.500, 0.500, 0.500, 0.496, 0.001, 0.001, 0.001, 0.001, 0.001)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev lp 12 0.25 spect")
f1 = make_inverse_chebyshev_lowpass(10, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev lp 10 max") # okay
- if (not vequal(vals[1], vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.497, 0.001, 0.001))) and
- (not vequal(vals[1], vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.497, 0.002, 0.002)))
- snd_display(snd_format_neq(vals[1],
- vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.497, 0.001, 0.001),
- "inverse_chebyshev lp 10 0.4 spect"))
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev lp 10 max")
+ v0 = vals[1]
+ v1 = vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.497, 0.001, 0.001)
+ v2 = vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.497, 0.002, 0.002)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2))
+ snd_test_neq(v0, v1, "inverse_chebyshev lp 10 0.4 spect (v1)")
+ snd_test_neq(v0, v2, "inverse_chebyshev lp 10 0.4 spect (v2)")
end
f1 = make_inverse_chebyshev_lowpass(10, 0.4, 120)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev lp 10 max") # okay
- snd_test_neq(vals[1],
- vct(0.501, 0.501, 0.501, 0.501, 0.501, 0.500, 0.345, 0.007, 0, 0),
- "inverse_chebyshev lp 10 0.4 120 spect")
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev lp 10 max")
+ v1 = vct(0.501, 0.501, 0.501, 0.501, 0.501, 0.500, 0.345, 0.007, 0, 0)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev lp 10 0.4 120 spect")
#
2.step(10, 2) do |i|
0.1.step(0.35, 0.1) do |j|
f1 = make_inverse_chebyshev_lowpass(i, j)
- mx = filter_response_max(f1)
- if mx > 1.0
- snd_display(snd_format(mx, 1.0, ">", "inv cheby low max %d %d", i, j))
- end
+ snd_test_gt(filter_response_max(f1), 1.0, "inv cheby low max %d %d", i, j)
end
end
#
f1 = make_inverse_chebyshev_highpass(8, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev hp 8 max") # okay
- snd_test_neq(vals[1],
- vct(0.001, 0.001, 0.440, 0.505, 0.505, 0.503, 0.502, 0.501, 0.501, 0.501),
- "inverse_chebyshev hp 8 0.1 spect")
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev hp 8 max")
+ v1 = vct(0.001, 0.001, 0.440, 0.505, 0.505, 0.503, 0.502, 0.501, 0.501, 0.501)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev hp 8 0.1 spect")
f1 = make_inverse_chebyshev_highpass(12, 0.25)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev hp 12 max") # okay
- snd_test_neq(vals[1],
- vct(0.001, 0.001, 0.001, 0.001, 0.001, 0.505, 0.506, 0.503, 0.501, 0.501),
- "inverse_chebyshev hp 12 0.25 spect")
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev hp 12 max")
+ v1 = vct(0.001, 0.001, 0.001, 0.001, 0.001, 0.505, 0.506, 0.503, 0.501, 0.501)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev hp 12 0.25 spect")
f1 = make_inverse_chebyshev_highpass(10, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev hp 10 max") # okay
- if (not vequal(vals[1], vct(0, 0, 0, 0.001, 0.001, 0.001, 0.001, 0.001, 0.503, 0.503))) and
- (not vequal(vals[1], vct(0, 0, 0, 0.001, 0.001, 0.001, 0.001, 0.001, 0.505, 0.503))) and
- (not vequal(vals[1], vct(0, 0, 0, 0.001, 0.001, 0.001, 0.001, 0.001, 0.509, 0.504)))
- snd_display(snd_format_neq(vals[1],
- vct(0, 0, 0, 0.001, 0.001, 0.001, 0.001, 0.001, 0.503, 0.503),
- "inverse_chebyshev hp 10 0.4 spect"))
+ snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev hp 10 max")
+ v0 = vals[1]
+ v1 = vct(0, 0, 0, 0.001, 0.001, 0.001, 0.001, 0.001, 0.503, 0.503)
+ v2 = vct(0, 0, 0, 0.001, 0.001, 0.001, 0.001, 0.001, 0.505, 0.503)
+ v3 = vct(0, 0, 0, 0.001, 0.001, 0.001, 0.001, 0.001, 0.509, 0.504)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2)) and (not vequal(v0, v3))
+ snd_test_neq(v0, v1, "inverse_chebyshev hp 10 0.4 spect (v1)")
+ snd_test_neq(v0, v2, "inverse_chebyshev hp 10 0.4 spect (v2)")
+ snd_test_neq(v0, v3, "inverse_chebyshev hp 10 0.4 spect (v3)")
end
f1 = make_inverse_chebyshev_highpass(10, 0.1, 120)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :ffequal?, "inverse_chebyshev hp 10 0.1 120 max") # okay
- snd_test_neq(vals[1],
- vct(0, 0, 0.007, 0.328, 0.502, 0.502, 0.502, 0.501, 0.501, 0.501),
- "inverse_chebyshev hp 10 0.1 120 spect")
+ snd_test_any_neq(vals[0], 0.51, :ffequal?,
+ "inverse_chebyshev hp 10 0.1 120 max")
+ v1 = vct(0, 0, 0.007, 0.328, 0.502, 0.502, 0.502, 0.501, 0.501, 0.501)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev hp 10 0.1 120 spect")
#
2.step(10, 2) do |i|
0.1.step(0.35, 0.1) do |j|
f1 = make_inverse_chebyshev_highpass(i, j)
- mx = filter_response_max(f1)
- if mx > 1.0
- snd_display(snd_format(mx, 1.0, ">", "inv cheby high max %d %d", i, j))
- end
+ snd_test_gt(filter_response_max(f1), 1.0,
+ "inv cheby high max %d %d", i, j)
end
end
#
f1 = make_inverse_chebyshev_bandpass(10, 0.1, 0.2)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bp 10 max") # okay
- snd_test_neq(vals[1],
- vct(0.001, 0.001, 0.498, 0.485, 0.001, 0.001, 0, 0.001, 0, 0.001),
- "inverse_chebyshev bp 10 0.1 0.2 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bp 10 max")
+ v1 = vct(0.001, 0.001, 0.498, 0.485, 0.001, 0.001, 0, 0.001, 0, 0.001)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev bp 10 0.1 0.2 spect")
f1 = make_inverse_chebyshev_bandpass(10, 0.1, 0.2, 30)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bp 10 30 max") # okay
- if (not vequal(vals[1], vct(0.026, 0.025, 0.509, 0.505, 0.02, 0.016, 0.012, 0.016, 0.011, 0.016))) and
- (not vequal(vals[1], vct(0.03, 0.042, 0.511, 0.505, 0.02, 0.016, 0.012, 0.016, 0.011, 0.016))) and
- (not vequal(vals[1], vct(0.022, 0.017, 0.511, 0.505, 0.02, 0.016, 0.012, 0.016, 0.011, 0.016)))
- snd_display(snd_format_neq(vals[1],
- vct(0.026, 0.025, 0.509, 0.505, 0.02, 0.016, 0.012, 0.016, 0.011, 0.016),
- "inverse_chebyshev bp 10 0.1 0.2 30 spect"))
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bp 10 30 max")
+ v0 = vals[1]
+ v1 = vct(0.026, 0.025, 0.509, 0.505, 0.02, 0.016, 0.012, 0.016, 0.011, 0.016)
+ v2 = vct(0.030, 0.042, 0.511, 0.505, 0.02, 0.016, 0.012, 0.016, 0.011, 0.016)
+ v3 = vct(0.022, 0.017, 0.511, 0.505, 0.02, 0.016, 0.012, 0.016, 0.011, 0.016)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2)) and (not vequal(v0, v3))
+ snd_test_neq(v0, v1, "inverse_chebyshev bp 10 0.1 0.2 30 spect (v1)")
+ snd_test_neq(v0, v2, "inverse_chebyshev bp 10 0.1 0.2 30 spect (v2)")
+ snd_test_neq(v0, v3, "inverse_chebyshev bp 10 0.1 0.2 30 spect (v3)")
end
f1 = make_inverse_chebyshev_bandpass(8, 0.1, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bp 8 max") # okay
- snd_test_neq(vals[1],
- vct(0.001, 0.001, 0.440, 0.506, 0.505, 0.503, 0.502, 0.434, 0.001, 0.001),
- "inverse_chebyshev bp 8 0.1 0.4 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bp 8 max")
+ v1 = vct(0.001, 0.001, 0.440, 0.506, 0.505, 0.503, 0.502, 0.434, 0.001, 0.001)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev bp 8 0.1 0.4 spect")
f1 = make_inverse_chebyshev_bandpass(8, 0.3, 0.4, 40)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bp 8 40 max") # okay
- snd_test_neq(vals[1],
- vct(0.002, 0.005, 0.007, 0.007, 0.005, 0.005, 0.503, 0.505, 0.006, 0.005),
- "inverse_chebyshev bp 8 0.3 0.4 40 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bp 8 40 max")
+ v1 = vct(0.002, 0.005, 0.007, 0.007, 0.005, 0.005, 0.503, 0.505, 0.006, 0.005)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev bp 8 0.3 0.4 40 spect")
#
f1 = make_inverse_chebyshev_bandstop(4, 0.1, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bs 4 max") # okay
- snd_test_neq(vals[1],
- vct(0.500, 0.054, 0.001, 0.001, 0, 0, 0, 0.001, 0.055, 0.503),
- "inverse_chebyshev bs 4 0.1 0.4 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bs 4 max")
+ v1 = vct(0.500, 0.054, 0.001, 0.001, 0, 0, 0, 0.001, 0.055, 0.503)
+ snd_test_neq(vals[1], v1, "inverse_chebyshev bs 4 0.1 0.4 spect")
f1 = make_inverse_chebyshev_bandstop(8, 0.1, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.51, :f05equal?, "inverse_chebyshev bs 8 max") # okay
- if (not vequal(vals[1], vct(0.501, 0.496, 0.001, 0.001, 0, 0, 0, 0.001, 0.507, 0.506))) and
- (not vequal(vals[1], vct(0.506, 0.328, 0.001, 0.001, 0, 0, 0, 0, 0.268, 0.511))) and
- (not vequal(vals[1], vct(0.5, 0.498, 0.001, 0.001, 0, 0, 0, 0.001, 0.507, 0.506)))
- snd_display(snd_format_neq(vals[1],
- vct(0.501, 0.496, 0.001, 0.001, 0, 0, 0, 0.001, 0.507, 0.506),
- "inverse_chebyshev bs 8 0.1 0.4 spect"))
+ snd_test_any_neq(vals[0], 0.51, :f05equal?, "inverse_chebyshev bs 8 max")
+ v0 = vals[1]
+ v1 = vct(0.501, 0.496, 0.001, 0.001, 0, 0, 0, 0.001, 0.507, 0.506)
+ v2 = vct(0.506, 0.328, 0.001, 0.001, 0, 0, 0, 0.000, 0.268, 0.511)
+ v3 = vct(0.500, 0.498, 0.001, 0.001, 0, 0, 0, 0.001, 0.507, 0.506)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2)) and (not vequal(v0, v3))
+ snd_test_neq(v0, v1, "inverse_chebyshev bs 8 0.1 0.4 spect (v1)")
+ snd_test_neq(v0, v2, "inverse_chebyshev bs 8 0.1 0.4 spect (v2)")
+ snd_test_neq(v0, v3, "inverse_chebyshev bs 8 0.1 0.4 spect (v3)")
end
f1 = make_inverse_chebyshev_bandstop(8, 0.1, 0.4, 90)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bs 8 90 max") # okay
- snd_test_neq(vals[1],
- vct(0.505, 0.325, 0, 0, 0, 0, 0, 0, 0.270, 0.506),
- "inverse_chebyshev bs 8 0.1 0.4 90 spect")
+ snd_test_any_neq(vals[0], 0.5, :f05equal?, "inverse_chebyshev bs 8 90 max")
+ v0 = vals[1]
+ v1 = vct(0.505, 0.325, 0, 0, 0, 0, 0, 0, 0.270, 0.506)
+ v2 = vct(0.506, 0.328, 0, 0, 0, 0, 0, 0, 0.269, 0.509)
+ v3 = vct(0.501, 0.327, 0, 0, 0, 0, 0, 0, 0.268, 0.506)
+ if (not vequal(v0, v1)) and (not vequal(v0, v2)) and (not vequal(v0, v3))
+ snd_test_neq(v0, v1, "inverse_chebyshev bs 8 0.1 0.4 90 spect (v1)")
+ snd_test_neq(v0, v2, "inverse_chebyshev bs 8 0.1 0.4 90 spect (v2)")
+ snd_test_neq(v0, v3, "inverse_chebyshev bs 8 0.1 0.4 90 spect (v3)")
+ end
if $with_test_gsl
if defined? gsl_roots
# gsl_roots isn't defined for ruby in snd-xen.c
@@ -12059,10 +11450,7 @@ def analog_filter_tests
2.step(11, 2) do |i|
0.1.step(0.44, 0.1) do |j|
f1 = make_bessel_lowpass(i, j)
- mx = filter_response_max(f1)
- if mx > 1.0
- snd_display(snd_format(mx, 1.0, ">", "bess low max %d %d", i, j))
- end
+ snd_test_gt(filter_response_max(f1), 1.0, "bess low max %d %d", i, j)
end
end
#
@@ -12080,7 +11468,7 @@ def analog_filter_tests
"bessel hp 12 0.25 spect")
f1 = make_bessel_highpass(10, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :ffequal?, "bessel hp 10 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :ffequal?, "bessel hp 10 max")
snd_test_neq(vals[1],
vct(0, 0, 0, 0, 0, 0, 0.004, 0.084, 0.343, 0.499),
"bessel hp 12 0.25 0.01 90 spect")
@@ -12104,7 +11492,7 @@ def analog_filter_tests
#
f1 = make_elliptic_lowpass(8, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 8 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 8 max")
if (not vequal(vals[1], vct(0.500, 0.515, 0.379, 0, 0, 0, 0, 0, 0, 0))) and
(not vequal(vals[1], vct(0.500, 0.509, 0.385, 0, 0, 0, 0, 0, 0, 0))) and
(not vequal(vals[1], vct(0.499, 0.498, 0.373, 0, 0, 0, 0, 0, 0, 0)))
@@ -12114,7 +11502,7 @@ def analog_filter_tests
end
f1 = make_elliptic_lowpass(12, 0.25)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 12 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 12 max")
if (not vequal(vals[1], vct(0.476, 0.500, 0.491, 0.499, 0.494, 0.412, 0.003, 0.001, 0, 0))) and
(not vequal(vals[1], vct(0.476, 0.500, 0.491, 0.499, 0.494, 0.561, 0.004, 0, 0, 0))) and
(not vequal(vals[1], vct(0.476, 0.500, 0.491, 0.499, 0.493, 0.299, 0.006, 0.001, 0, 0)))
@@ -12124,38 +11512,38 @@ def analog_filter_tests
end
f1 = make_elliptic_lowpass(4, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 4 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 4 max")
snd_test_neq(vals[1],
vct(0.447, 0.453, 0.462, 0.477, 0.494, 0.500, 0.497, 0.496, 0.445, 0.003),
"elliptic lp 4 0.4 spect")
f1 = make_elliptic_lowpass(8, 0.1, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 8 0.1 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 8 0.1 max")
snd_test_neq(vals[1],
vct(0.500, 0.499, 0.475, 0, 0, 0, 0, 0, 0, 0),
"elliptic lp 8 0.1 0.1 spect")
f1 = make_elliptic_lowpass(8, 0.1, 0.1, 90)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 8 0.1 90 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 8 0.1 90 max")
snd_test_neq(vals[1],
vct(0.500, 0.499, 0.475, 0, 0, 0, 0, 0, 0, 0),
"elliptic lp 8 0.1 0.1 90 spect")
f1 = make_elliptic_lowpass(8, 0.25, 0.01, 90)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 8 0.25 90 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic lp 8 0.25 90 max")
snd_test_neq(vals[1],
vct(0.500, 0.500, 0.500, 0.500, 0.499, 0.495, 0.001, 0, 0, 0),
"elliptic lp 8 0.25 0.01 90 spect")
#
f1 = make_elliptic_highpass(4, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 4 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 4 max")
snd_test_neq(vals[1],
vct(0.004, 0.438, 0.516, 0.499, 0.502, 0.495, 0.478, 0.463, 0.453, 0.447),
"elliptic hp 4 0.1 spect")
f1 = make_elliptic_highpass(12, 0.25)
vals = sweep2bins(f1, 10)
- # snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 12 max") # okay
+ # snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 12 max")
if (not vequal(vals[1], vct(0, 0.001, 0.001, 0.001, 0.026, 0.934, 0.518, 0.495, 0.503, 0.477))) and
(not vequal(vals[1], vct(0, 0.001, 0.001, 0.001, 0.033, 1.185, 0.519, 0.495, 0.503, 0.477))) and
(not vequal(vals[1], vct(0, 0.001, 0.001, 0.001, 0.018, 0.788, 0.520, 0.495, 0.503, 0.477)))
@@ -12165,217 +11553,215 @@ def analog_filter_tests
end
f1 = make_elliptic_highpass(12, 0.25, 0.01, 90)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 12 90 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 12 90 max")
snd_test_neq(vals[1],
vct(0, 0, 0, 0, 0.499, 0.517, 0.503, 0.501, 0.500, 0.500),
"elliptic hp 12 0.25 0.01 90 spect")
f1 = make_elliptic_highpass(4, 0.4)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 4 0.4 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 4 0.4 max")
snd_test_neq(vals[1],
vct(0, 0, 0, 0.001, 0.001, 0.002, 0.023, 0.447, 0.515, 0.502),
"elliptic hp 4 0.4 spect")
f1 = make_elliptic_highpass(8, 0.1, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 8 0.1 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 8 0.1 max")
snd_test_neq(vals[1],
vct(0, 0.478, 0.553, 0.506, 0.499, 0.501, 0.501, 0.499, 0.497, 0.495),
"elliptic hp 8 0.1 0.1 spect")
f1 = make_elliptic_highpass(8, 0.1, 0.1, 90)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 8 0.1 90 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 8 0.1 90 max")
snd_test_neq(vals[1],
vct(0, 0.478, 0.554, 0.506, 0.499, 0.501, 0.501, 0.499, 0.497, 0.495),
"elliptic hp 8 0.1 0.1 90 spect")
f1 = make_elliptic_highpass(8, 0.25, 0.01, 90)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 8 0.25 90 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic hp 8 0.25 90 max")
snd_test_neq(vals[1],
vct(0, 0, 0, 0.001, 0.516, 0.517, 0.507, 0.503, 0.501, 0.500),
"elliptic hp 8 0.25 0.01 90 spect")
#
f1 = make_elliptic_bandpass(4, 0.1, 0.2, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic bp 4 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic bp 4 max")
snd_test_neq(vals[1],
vct(0.036, 0.546, 0.55, 0.51, 0.501, 0.032, 0.024, 0.009, 0.021, 0.024),
"elliptic bp 4 0.1 0.2 0.1 spect")
f1 = make_elliptic_bandpass(6, 0.1, 0.2, 0.1, 90)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic bp 6 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic bp 6 max")
snd_test_neq(vals[1],
vct(0.002, 0.511, 0.532, 0.503, 0.492, 0.003, 0.001, 0.001, 0.001, 0.001),
"elliptic bp 6 0.1 0.2 0.1 90 spect")
#
f1 = make_elliptic_bandstop(4, 0.1, 0.3, 0.1)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic bs 4 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic bs 4 max")
snd_test_neq(vals[1],
vct(0.499, 0.502, 0.498, 0.037, 0.05, 0.54, 0.544, 0.527, 0.526, 0.521),
"elliptic bs 4 0.1 0.3 0.1 spect")
f1 = make_elliptic_bandstop(8, 0.1, 0.3, 0.1, 120)
vals = sweep2bins(f1, 10)
- snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic bs 8 max") # okay
+ snd_test_any_neq(vals[0], 0.5, :fffequal?, "elliptic bs 8 max")
if (not vequal(vals[1], vct(0.500, 0.499, 0.476, 0, 0, 0.495, 0.526, 0.505, 0.501, 0.501))) and
(not vequal(vals[1], vct(0.500, 0.499, 0.475, 0, 0, 0.495, 0.526, 0.505, 0.501, 0.501)))
snd_display(snd_format_neq(vals[1],
vct(0.500, 0.499, 0.476, 0, 0, 0.495, 0.526, 0.505, 0.501, 0.501),
"elliptic bs 8 0.1 0.3 0.1 120 spect"))
end
- end
+ end # $with_test_gsl
end
def poly_roots_tests
# degree=0
- unless (res = poly(0.0).roots).null?
- snd_display("poly_roots 0.0: %s?", res)
- end
- unless (res = poly(12.3).roots).null?
- snd_display("poly_roots 12.3: %s?", res)
- end
+ res = poly(0.0).roots
+ req = poly()
+ snd_test_neq(res, req, "poly_roots 0.0")
+ res = poly(12.3).roots
+ req = poly()
+ snd_test_neq(res, req, "poly_roots 12.3")
# degree 0 + x=0
- if (res = poly(0.0, 1.0).roots) != [0.0]
- snd_display("poly_roots 0.0 1.0: %s?", res)
- end
- if (res = poly(0.0, 0.0, 0.0, 121.0).roots) != [0.0, 0.0, 0.0]
- snd_display("poly_roots 0.0 0.0 0.0 121.0: %s?", res)
- end
+ res = poly(0.0, 1.0).roots
+ req = [0.0]
+ snd_test_neq(res, req, "poly_roots 0.0 1.0")
+ res = poly(0.0, 0.0, 0.0, 121.0).roots
+ req = [0.0, 0.0, 0.0]
+ snd_test_neq(res, req, "poly_roots 0.0 0.0 0.0 121.0")
# degree=1
- if (res = poly(-1.0, 1.0).roots) != [1.0]
- snd_display("poly_roots -1.0 1.0: %s?", res)
- end
- if (res = poly(-2.0, 4.0).roots) != [0.5]
- snd_display("poly_roots -2.0 4.0: %s?", res)
- end
- if (res = poly(Complex(0.0, -1.0), 1).roots) != [Complex(0.0, 1.0)]
- snd_display("poly_roots -i 1: %s?", res)
- end
+ res = poly(-1.0, 1.0).roots
+ req = [1.0]
+ snd_test_neq(res, req, "poly_roots -1.0 1.0")
+ res = poly(-2.0, 4.0).roots
+ req = [0.5]
+ snd_test_neq(res, req, "poly_roots -2.0 4.0")
+ res = poly(Complex(0.0, -1.0), 1).roots
+ req = [Complex(0.0, 1.0)]
+ snd_test_neq(res, req, "poly_roots -i 1")
# linear x^n
- vals = poly(-1.0, 0.0, 0.0, 0.0, 1.0).roots
- if vcneql(vals, [Complex(0.0, -1.0), -1.0, Complex(0.0, 1.0), 1.0]) and
- vcneql(vals, [1.0, -1.0, Complex(0.0, 1.0), Complex(-0.0, -1.0)])
- snd_display("poly_roots -1 0 0 0 1: %s?", vals)
- end
- vals = poly(-16, 0, 0, 0, 1).roots
- if vcneql(vals, [Complex(0.0, -2.0), -2.0, Complex(0.0, 2.0), 2.0]) and
- vcneql(vals, [2.0, -2.0, Complex(0.0, 2.0), Complex(-0.0, -2.0)])
- snd_display("poly_roots -16 0 0 0 1: %s?", vals)
- end
- if vcneql(res = poly(-32, 0, 0, 0, 0, 0, 0.5).roots,
- [Complex(1.0, -1.7320), Complex(-1.0, -1.7320), -2.0,
- Complex(-1.0, 1.7320), Complex(1.0, 1.7320), 2.0])
- snd_display("poly_roots -32 0 0 0 0 0 0.5: %s?", res)
- end
+ res = poly(-1.0, 0.0, 0.0, 0.0, 1.0).roots
+ req1 = [Complex(0.0, -1.0), -1.0, Complex(0.0, 1.0), 1.0]
+ req2 = [1.0, -1.0, Complex(0.0, 1.0), Complex(-0.0, -1.0)]
+ if vcneql(res, req1) and vcneql(res, req2)
+ snd_format_neq(res, req1, "poly_roots -1 0 0 0 1 (a)")
+ snd_format_neq(res, req2, "poly_roots -1 0 0 0 1 (b)")
+ end
+ res = poly(-16, 0, 0, 0, 1).roots
+ req1 = [Complex(0.0, -2.0), -2.0, Complex(0.0, 2.0), 2.0]
+ req2 = [2.0, -2.0, Complex(0.0, 2.0), Complex(-0.0, -2.0)]
+ if vcneql(res, req1) and vcneql(res, req2)
+ snd_format_neq(res, req1, "poly_roots -16 0 0 0 1 (a)")
+ snd_format_neq(res, req2, "poly_roots -16 0 0 0 1 (b)")
+ end
+ res = poly(-32, 0, 0, 0, 0, 0, 0.5).roots
+ req = [Complex(1.0, -1.7320), Complex(-1.0, -1.7320), -2.0,
+ Complex(-1.0, 1.7320), Complex(1.0, 1.7320), 2.0]
+ snd_test_any_neq(res, req, :vcequal?, "poly_roots -32 0 0 0 0 0 0.5")
# linear + x=0
- if (res = poly(0, -2, 4).roots) != [0.0, 0.5]
- snd_display("poly_roots 0 -2 4: %s?", res)
- end
+ res = poly(0, -2, 4).roots
+ req = [0.0, 0.5]
+ snd_test_neq(res, req, "poly_roots 0 -2 4")
# degree=2
- if (res = poly(-1, 0, 1).roots) != [1.0, -1.0]
- snd_display("poly_roots -1 0 1: %s?", res)
- end
- if (res = poly(15, -8, 1).roots) != [5.0, 3.0]
- snd_display("poly_roots 15 -8 1: %s?", res)
- end
- if (res = poly(1, -2, 1).roots) != [1.0, 1.0]
- snd_display("poly_roots 1 -2 1: %s?", res)
- end
- if (res = poly(-1, Complex(0.0, 2.0), 1).roots) != [Complex(0.0, -1.0), Complex(0.0, -1.0)]
- snd_display("poly_roots -1 2i 1: %s?", res)
- end
- if vcneql(res = poly(1, 1, 5).roots, [Complex(-0.1, 0.43589), Complex(-0.1, -0.43589)])
- snd_display("poly_roots 1 1 5: %s?", res)
- end
+ res = poly(-1, 0, 1).roots
+ req = [1.0, -1.0]
+ snd_test_neq(res, req, "poly_roots -1 0 1")
+ res = poly(15, -8, 1).roots
+ req = [5.0, 3.0]
+ snd_test_neq(res, req, "poly_roots 15 -8 1")
+ res = poly(1, -2, 1).roots
+ req = [1.0, 1.0]
+ snd_test_neq(res, req, "poly_roots 1 -2 1")
+ res = poly(-1, Complex(0.0, 2.0), 1).roots
+ req = [Complex(0.0, -1.0), Complex(0.0, -1.0)]
+ snd_test_neq(res, req, "poly_roots -1 2i 1")
+ res = poly(1, 1, 5).roots
+ req = [Complex(-0.1, 0.43589), Complex(-0.1, -0.43589)]
+ snd_test_any_neq(res, req, :vcequal?, "poly_roots 1 1 5")
# 2 + x=0
- if (res = poly(0, 0, -1, 0, 1).roots) != [0.0, 0.0, 1.0, -1.0]
- snd_display("poly_roots 0 0 -1 0 1: %s?", res)
- end
+ res = poly(0, 0, -1, 0, 1).roots
+ req = [0.0, 0.0, 1.0, -1.0]
+ snd_test_neq(res, req, "poly_roots 0 0 -1 0 1")
# quadratic in x^(n/2)
- if (res = poly(1, 0, -2, 0, 1).roots) != [-1.0, 1.0, -1.0, 1.0] and res != [1.0, 1.0, -1.0, -1.0]
- snd_display("poly_roots 1 0 -2 0 1: %s?", res)
- end
- if vcneql(res = poly(64, 0, 0, -16, 0, 0, 1).roots,
- [Complex(-1.0, -1.73205), Complex(-1.0, 1.73205), 2.0,
- Complex(-1.0, -1.73205), Complex(-1.0, 1.73205), 2.0])
- snd_display("poly_roots 64 0 0 -16 0 0 1: %s?", res)
- end
+ res = poly(1, 0, -2, 0, 1).roots
+ req1 = [-1.0, 1.0, -1.0, 1.0]
+ req2 = [1.0, 1.0, -1.0, -1.0]
+ if res != req1 and res != req2
+ snd_format_neq(res, req1, "poly_roots 1 0 -2 0 1 (a)")
+ snd_format_neq(res, req2, "poly_roots 1 0 -2 0 1 (b)")
+ end
+ res = poly(64, 0, 0, -16, 0, 0, 1).roots
+ req = [Complex(-1.0, -1.73205), Complex(-1.0, 1.73205), 2.0,
+ Complex(-1.0, -1.73205), Complex(-1.0, 1.73205), 2.0]
+ snd_test_any_neq(res, req, :vcequal?, "poly_roots 64 0 0 -16 0 0 1")
# degree=3
- unless vequal(res = poly(-15, 23, -9, 1).roots, [5.0, 1.0, 3.0])
- snd_display("poly_roots -15 23 -9 1: %s?", res)
- end
- if vcneql(res = poly(-126, -15, 0, 1).roots,
- [6.0, Complex(-3.0, 3.46410), Complex(-3.0, -3.46410)])
- snd_display("poly_roots -126 -15 0 1: %s?", res)
- end
- if (res = poly(-1, 3, -3, 1).roots) != [1.0, 1.0, 1.0]
- snd_display("poly_roots -1 3 -3 1: %s?", res)
- end
- unless vequal(res = poly(1, -1, -1, 1).roots, [1.0, -1.0, 1.0])
- snd_display("poly_roots 1 -1 -1 1: %s?", res)
- end
- unless vequal(res = poly(2, -2, -2, 2).roots, [1.0, -1.0, 1.0])
- snd_display("poly_roots 2 -2 -2 2: %s %s %s?", res)
- end
+ res = poly(-15, 23, -9, 1).roots
+ req = [5.0, 1.0, 3.0]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots -15 23 -9 1")
+ res = poly(-126, -15, 0, 1).roots
+ req = [6.0, Complex(-3.0, 3.46410), Complex(-3.0, -3.46410)]
+ snd_test_any_neq(res, req, :vcequal?, "poly_roots -126 -15 0 1")
+ res = poly(-1, 3, -3, 1).roots
+ req = [1.0, 1.0, 1.0]
+ snd_test_neq(res, req, "poly_roots -1 3 -3 1")
+ res = poly(1, -1, -1, 1).roots
+ req = [1.0, -1.0, 1.0]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots 1 -1 -1 1")
+ res = poly(2, -2, -2, 2).roots
+ req = [1.0, -1.0, 1.0]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots 2 -2 -2 2")
# degree=4
- if (res = poly(-15, 8, 14, -8, 1).roots) != [5.0, 3.0, 1.0, -1.0]
- snd_display("poly_roots -15 8 14 -8 1: [5.0, 3.0, 1.0, -1.0] != %s?", res)
- end
- vals = (poly(2, 1) * poly(-3, 1) * poly(8, 1) * poly(-9, 1)).reduce.roots
- unless vequal(vals, [9, 3, -2, -8])
- snd_display("poly_roots 4(1): %s?", vals)
- end
- vals = (poly(0.2, 1) * poly(-3, 1) * poly(0.8, 1) * poly(-9, 1)).reduce.roots
- unless vequal(vals, [9, 3, -0.2, -0.8])
- snd_display("poly_roots 4(2): %s?", vals)
- end
- vals = (poly(0.02, 1) * poly(-32, 1) * poly(0.8, 1) * poly(-9, 1)).reduce.roots
- unless vequal(vals, [32, 9, -0.02, -0.8])
- snd_display("poly_roots 4(3): %s?", vals)
- end
+ res = poly(-15, 8, 14, -8, 1).roots
+ req = [5.0, 3.0, 1.0, -1.0]
+ snd_test_neq(res, req, "poly_roots -15 8 14 -8 1: [5.0, 3.0, 1.0, -1.0]")
+ res = (poly(2, 1) * poly(-3, 1) * poly(8, 1) * poly(-9, 1)).reduce.roots
+ req = [9, 3, -2, -8]
+ snd_test_neq(res, req, "poly_roots 4(1)")
+ res = (poly(0.2, 1) * poly(-3, 1) * poly(0.8, 1) * poly(-9, 1)).reduce.roots
+ req = [9, 3, -0.2, -0.8]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots 4(2)")
+ res = (poly(0.02, 1) * poly(-32, 1) * poly(0.8, 1) * poly(-9, 1)).reduce.roots
+ req = [32, 9, -0.02, -0.8]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots 4(3)")
# degree>4
- vals = (poly(1, 1) * poly(2, 1) * poly(-3, 1) * poly(-1, 1) * poly(-2, 1)).reduce.roots
- unless vequal(vals, [3, 2, -1, -2, 1])
- snd_display("poly_roots n(1): %s?", vals)
- end
- vals = (poly(1, 1) * poly(2, 1) * poly(-3, 1) * poly(8, 1) * poly(-9, 1)).reduce.roots
- unless vequal(vals, [9, 3, -2, -8, -1])
- snd_display("poly_roots n(2): %s?", vals)
- end
- vals = (poly(-1, 0, 1) * poly(9, 1) * poly(-3, 1) * poly(-10, 1) * poly(-2, 1)).reduce.roots
- unless vequal(vals, [10, 3, -1, -9, 2, 1])
- snd_display("poly_roots n(3): %s?", vals)
- end
- vals = poly(-1, 0, 1) * poly(-4, 0, 1) * poly(-3, 1) * poly(-10, 1) * poly(-9, 0, 1)
- vals = vals.reduce.roots
- unless vequal(vals, [10, 3, -2, -3, -1, 3, 2, 1])
- snd_display("poly_roots n(4): %s?", vals)
- end
- vals = (poly(-1, 0, 1) * poly(-4, 0, 1) * poly(-16, 0, 1) * poly(-25, 0, 1) *
- poly(-9, 0, 1)).reduce.roots
- unless vequal(vals, [5, -3, -4, -5, 4, -2, 3, -1, 2, 1])
- snd_display("poly_roots n(5): %s?", vals)
- end
- vals = (poly(1, 1) * poly(2, 1) * poly(-3, 1) * poly(1, 1) * poly(-2, 1)).reduce.roots
- unless vequal(vals, [3, -1, -1, -2, 2])
- snd_display("poly_roots n(6): %s?", vals)
- end
- vals = poly(-64, 0, 0, 0, 0, 0, 1).roots
- if vcneql(vals, [Complex(0.999, -1.732), Complex(-1.0, -1.732), -2.0,
- Complex(-1.0, 1.732), Complex(1.0, 1.732), 2.0])
- snd_display("poly_roots 64 6: %s?", vals)
- end
- vals = poly(64, 0, 0, -16, 0, 0, 1).roots
- if vcneql(vals, [Complex(-1.0, -1.732), Complex(-1.0, 1.732), 2.0,
- Complex(-1.0, -1.732), Complex(-1.0, 1.732), 2.0])
- snd_display("poly_roots 64 16 6: %s?", vals)
- end
+ res = poly(1, 1) * poly(2, 1) * poly(-3, 1) * poly(-1, 1) * poly(-2, 1)
+ res = res.reduce.roots
+ req = [3, 2, -1, -2, 1]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots n(1)")
+ res = poly(1, 1) * poly(2, 1) * poly(-3, 1) * poly(8, 1) * poly(-9, 1)
+ res = res.reduce.roots
+ req = [9, 3, -2, -8, -1]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots n(2)")
+ res = poly(-1, 0, 1) * poly(9, 1) * poly(-3, 1) * poly(-10, 1) * poly(-2, 1)
+ res = res.reduce.roots
+ req = [10, 3, -1, -9, 2, 1]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots n(3)")
+ res = poly(-1, 0, 1) * poly(-4, 0, 1) * poly(-3, 1) *
+ poly(-10, 1) * poly(-9, 0, 1)
+ res = res.reduce.roots
+ req = [10, 3, -2, -3, -1, 3, 2, 1]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots n(4)")
+ res = poly(-1, 0, 1) * poly(-4, 0, 1) * poly(-16, 0, 1) *
+ poly(-25, 0, 1) * poly(-9, 0, 1)
+ res = res.reduce.roots
+ req = [5, -3, -4, -5, 4, -2, 3, -1, 2, 1]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots n(5)")
+ res = poly(1, 1) * poly(2, 1) * poly(-3, 1) * poly(1, 1) * poly(-2, 1)
+ res = res.reduce.roots
+ req = [3, -1, -1, -2, 2]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots n(6)")
+ res = poly(-64, 0, 0, 0, 0, 0, 1).roots
+ req = [Complex(0.999, -1.732), Complex(-1.0, -1.732), -2.0,
+ Complex(-1.0, 1.732), Complex(1.0, 1.732), 2.0]
+ snd_test_any_neq(res, req, :vcequal?, "poly_roots 64 6")
+ res = poly(64, 0, 0, -16, 0, 0, 1).roots
+ req = [Complex(-1.0, -1.732), Complex(-1.0, 1.732), 2.0,
+ Complex(-1.0, -1.732), Complex(-1.0, 1.732), 2.0]
+ snd_test_any_neq(res, req, :vcequal?, "poly_roots 64 16 6")
10.times do poly(random(1.0), random(1.0), random(1.0)).roots end
10.times do poly(mus_random(1.0), mus_random(1.0), mus_random(1.0)).roots end
- vals1 = convolution(vct(1, 2, 3, 0, 0, 0, 0, 0), vct(1, 2, 3, 0, 0, 0, 0, 0), 8)
- vals2 = poly(1, 2, 3, 0) * poly(1, 2, 3, 0)
- unless vequal(vals1, vals2)
- snd_display("poly_multiply convolve: %s %s?", vals1, vals2)
- end
+ res = convolution(vct(1, 2, 3, 0, 0, 0, 0, 0), vct(1, 2, 3, 0, 0, 0, 0, 0), 8)
+ req = poly(1, 2, 3, 0) * poly(1, 2, 3, 0)
+ snd_test_any_neq(res, req, :vequal?, "poly_multiply convolve")
10.times do
poly(make_rectangular(mus_random(1.0), mus_random(1.0)),
make_rectangular(mus_random(1.0), mus_random(1.0))).roots
@@ -12385,7 +11771,10 @@ def poly_roots_tests
make_rectangular(mus_random(1.0), mus_random(1.0)),
make_rectangular(mus_random(1.0), mus_random(1.0))).roots
end
- 10.times do poly(mus_random(1.0), mus_random(1.0), mus_random(1.0), mus_random(1.0)).roots end
+ 10.times do
+ poly(mus_random(1.0), mus_random(1.0),
+ mus_random(1.0), mus_random(1.0)).roots
+ end
10.times do
poly(make_rectangular(mus_random(1.0), mus_random(1.0)),
make_rectangular(mus_random(1.0), mus_random(1.0)),
@@ -12393,7 +11782,8 @@ def poly_roots_tests
make_rectangular(mus_random(1.0), mus_random(1.0))).roots
end
10.times do
- poly(mus_random(1.0), mus_random(1.0), mus_random(1.0), mus_random(1.0), mus_random(1.0)).roots
+ poly(mus_random(1.0), mus_random(1.0), mus_random(1.0),
+ mus_random(1.0), mus_random(1.0)).roots
end
10.times do
poly(make_rectangular(mus_random(1.0), mus_random(1.0)),
@@ -12415,38 +11805,36 @@ def poly_roots_tests
v[(i - 1) / 2] = 1.0
v.to_poly.roots
end
- unless vequal(res = poly(1, -1, -1, 1).roots, [1.0, -1.0, 1.0])
- snd_display("poly_roots 1 -1 -1 1: %s?", res)
- end
- unless vequal(res = poly_roots(vct(2, -1, -2, 1)), [2.0, -1.0, 1.0])
- snd_display("poly_roots 2 -1 -2 1: %s?", res)
- end
- # FIXME
- # 0.544 comes first with poly.rb
- if vcneql(res = poly(-1, 1, 1, 1).roots,
- [0.544, Complex(-0.772, 1.115), Complex(-0.772, -1.115)]) and
- vcneql(res = poly(-1, 1, 1, 1).roots,
- [Complex(-0.772, 1.115), Complex(-0.772, -1.115), 0.544])
- snd_display("poly_roots -1 1 1 1: %s?", res)
- end
- if (res = poly_roots(vct(-1, 3, -3, 1))) != [1.0, 1.0, 1.0]
- snd_display("poly_roots -1 3 -3 1: %s?", res)
- end
- if (res = poly_roots(vct(1, -4, 6, -4, 1))) != [1.0, 1.0, 1.0, 1.0]
- snd_display("poly_roots 1 -4 6 -4 1: %s?", res)
- end
- if vcneql(res = poly_roots(vct(0.5, 0, 0, 1)),
- [Complex(0.397, -0.687), -0.794, Complex(0.397, 0.687)]) and
- vcneql(res, [Complex(0.397, 0.687), Complex(0.397, -0.687), -0.794])
- snd_display("poly_roots 0.5 0 0 1: %s?", res)
- end
- # FIXME
- # reduce added
- # without reduce: 3.0 -1.0 -2.0 -3.0 2.0-1.1555579666323415e-33i 1.0+2.9582283945787943e-31i
- res = (poly(-1, 1) * poly(1, 1) * poly(-2, 1) * poly(2, 1) * poly(-3, 1) * poly(3, 1)).reduce.roots
- if vcneql(res, [-3.0, 3.0, -1.0, 1.0, -2.0, 2.0])
- snd_display("cube in 2: %s?", res)
- end
+ res = poly(1, -1, -1, 1).roots
+ req = [1.0, -1.0, 1.0]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots 1 -1 -1 1")
+ res = poly_roots(vct(2, -1, -2, 1))
+ req = [2.0, -1.0, 1.0]
+ snd_test_any_neq(res, req, :vequal?, "poly_roots 2 -1 -2 1")
+ res = poly(-1, 1, 1, 1).roots
+ req = [0.544, Complex(-0.772, 1.115), Complex(-0.772, -1.115)]
+ snd_test_any_neq(res, req, :vcequal?, "poly_roots -1 1 1 1")
+ res = poly_roots(vct(-1, 3, -3, 1))
+ req = [1.0, 1.0, 1.0]
+ snd_test_neq(res, req, "poly_roots -1 3 -3 1")
+ res = poly_roots(vct(1, -4, 6, -4, 1))
+ req = [1.0, 1.0, 1.0, 1.0]
+ snd_test_neq(res, req, "poly_roots 1 -4 6 -4 1")
+ res = poly_roots(vct(0.5, 0, 0, 1))
+ req1 = [Complex(0.397, -0.687), -0.794, Complex(0.397, 0.687)]
+ req2 = [Complex(0.397, 0.687), Complex(0.397, -0.687), -0.794]
+ if vcneql(res, req1) and vcneql(res, req2)
+ snd_format_neq(res, req1, "poly_roots 0.5 0 0 1 (a)")
+ snd_format_neq(res, req2, "poly_roots 0.5 0 0 1 (b)")
+ end
+ # FIXME: reduce added (poly)
+ # without reduce:
+ # 3.0 -1.0 -2.0 -3.0 2.0-1.1555579666323415e-33i 1.0+2.9582283945787943e-31i
+ res = poly(-1, 1) * poly(1, 1) * poly(-2, 1) * poly(2, 1) *
+ poly(-3, 1) * poly(3, 1)
+ res = res.reduce.roots
+ req = [-3.0, 3.0, -1.0, 1.0, -2.0, 2.0]
+ snd_test_any_neq(res, req, :vequal?, "cube in 2")
end
def jc_reverb_1(decay_dur, low_pass, volume, amp_env)
@@ -12458,7 +11846,7 @@ def jc_reverb_1(decay_dur, low_pass, volume, amp_env)
comb3 = make_comb(0.715, 5399)
comb4 = make_comb(0.697, 5801)
outdel = make_delay((0.013 * srate).round)
- dur = decay_dur + frames / srate
+ dur = decay_dur + framples / srate
envA = (amp_env ? make_env(:envelope, amp_env, :scaler, volume, :duration, dur) : false)
comb_sum_1 = comb_sum_2 = comb_sum = all_sums = delA = delB = 0.0
map_chan(lambda do |inval|
@@ -12533,9 +11921,9 @@ def fm_violin_1(start, dur, freq, amp, *args)
fmosc1 = if modulate
if easy_case
make_polyshape(:frequency, fm1_rat * freq,
- :coeffs, partials2polynomial([fm1_rat.to_i, index1,
- (fm2_rat / fm1_rat).floor, index2,
- (fm3_rat / fm1_rat).floor, index3]))
+ :coeffs, partials2polynomial([fm1_rat.to_i, index1,
+ (fm2_rat / fm1_rat).floor, index2,
+ (fm3_rat / fm1_rat).floor, index3]))
else
make_oscil(:frequency, fm1_rat * freq)
end
@@ -12576,8 +11964,8 @@ def fm_violin_1(start, dur, freq, amp, *args)
env(indf1) * polyshape(fmosc1, 1.0, vib)
else
(env(indf1) * oscil(fmosc1, fm1_rat * vib + fuzz) +
- env(indf2) * oscil(fmosc2, fm2_rat * vib + fuzz) +
- env(indf3) * oscil(fmosc3, fm3_rat * vib + fuzz))
+ env(indf2) * oscil(fmosc2, fm2_rat * vib + fuzz) +
+ env(indf3) * oscil(fmosc3, fm3_rat * vib + fuzz))
end
end
env(ampf) * amp_fuzz * oscil(carrier, vib + ind_fuzz * modulation)
@@ -12595,18 +11983,19 @@ end
def fltit
coeffs = vct(0.1, 0.2, 0.3, 0.4, 0.4, 0.3, 0.2, 0.1)
flt = make_fir_filter(8, coeffs)
+ xcof = flt.xcoeffs
es = make_array(8) do |i|
if i == 5
make_env(:envelope, [0, 0.4, 1, 1], :duration, 1.0)
else
- make_env(:envelope, [0, coeffs[i], 1, 0], :length, 101)
+ make_env(:envelope, [0, coeffs[i], 1, 0], :duration, 0.5)
end
end
lambda do |x|
- val = fir_filter(flt, x)
- xcof = flt.xcoeffs
- es.each_with_index do |en, i| xcof[i] = env(en) end
- val
+ es.each_with_index do |en, i|
+ xcof[i] = env(en)
+ end
+ fir_filter(flt, x)
end
end
@@ -12614,12 +12003,14 @@ def freq_sweep(dur)
phase = 0.0
freq = 0.0
incr = PI / (dur * 1.05 * mus_srate)
- map_channel(lambda do |y|
- val = sin(phase)
- phase += freq
- freq += incr
- 0.5 * val
- end)
+ len = framples()
+ data = Vct.new(len) do |i|
+ val = sin(phase)
+ phase += freq
+ freq += incr
+ val
+ end.scale!(0.5)
+ vct2channel(data)
end
def make_ssb_am_1(freq, order = 40)
@@ -12628,7 +12019,7 @@ def make_ssb_am_1(freq, order = 40)
end
freq = freq.to_f
carrier_freq = freq.abs
- cos_carrier = make_oscil(freq, 0.5 * PI)
+ cos_carrier = make_oscil(freq, HALF_PI)
sin_carrier = make_oscil(freq)
dly = make_delay(order)
hlb = make_hilbert_transform(order)
@@ -12651,25 +12042,21 @@ end
def rough_spectrum(ind)
rd = make_sampler(0, ind, 0)
- mx = 0.0
- Vct.new(10) do
+ spect = Vct.new(10) do
sum = 0.0
1000.times do
val = rd.call
sum = sum + val * val
end
- if sum > mx
- mx = sum
- end
sum
- end.scale!(1.0 / mx)
+ end
+ spect.scale!(1.0 / spect.peak)
end
def print_and_check(gen, name, desc, desc1 = "", desc2 = "")
if gen.name != name
- snd_display("mus_name %s: %s?", name, gen.name)
+ snd_display_prev_caller("mus_name %s: %s?", name, gen.name)
end
- # xen->sample: #<Proc:0x084bdd14@/usr/home/mike/Project/Sndtest/snd-test-new.rb:4470>
if gen.name != "xen->sample"
if gen.to_s != desc and gen.to_s != desc1 and gen.to_s != desc2
snd_display_prev_caller("mus_describe %s: %s?", gen.name, gen)
@@ -12684,7 +12071,7 @@ end
def test_gen_equal(g0, g1, g2)
# g0 = g1 at start != g2
g3 = g0
- gad = make_frame(2)
+ gad = make_vct(2)
unless g0.eql?(g3)
snd_display_prev_caller("let %s %s.eql? %s?", g0.name, g0, g3)
end
@@ -12768,46 +12155,6 @@ def fm_test(gen)
end
end
-def frame_equal?(f1, f2)
- if f1 and f2 and (len = f1.length) == f2.length
- len.times do |chn|
- if fneq(frame_ref(f1, chn), frame_ref(f2, chn))
- return false
- end
- end
- true
- else
- false
- end
-end
-
-def make_random_frame(size)
- fr = make_frame(size)
- size.times do |chn| frame_set!(fr, chn, 1.0 - random(2.0)) end
- fr
-end
-
-def make_random_mixer(size)
- mx = make_mixer(size)
- size.times do |i|
- size.times do |j|
- mixer_set!(mx, i, j, 1.0 - random(2.0))
- end
- end
- mx
-end
-
-def mixer_copy(umx)
- size = umx.length
- mx = make_mixer(size)
- size.times do |i|
- size.times do |j|
- mixer_set!(mx, i, j, mixer_ref(umx, i, j))
- end
- end
- mx
-end
-
def test_08_00
set_mus_srate(22050)
samps = seconds2samples(1.0)
@@ -12818,10 +12165,10 @@ def test_08_00
if fneq(secs, 1.0)
snd_display("samples2seconds: %s?", secs)
end
- if mus_file_buffer_size != $default_file_buffer_size
- snd_display("mus_file_buffer_size: %s?", mus_file_buffer_size)
- end
- if (res = Snd.catch do set_mus_file_buffer_size(false) end).first != :wrong_type_arg
+ set_mus_file_buffer_size($default_file_buffer_size)
+ if (res = Snd.catch do
+ set_mus_file_buffer_size(false)
+ end).first != :wrong_type_arg
snd_display("mus_file_buffer_size bad size: %s?", res)
end
set_mus_file_buffer_size(128)
@@ -12832,6 +12179,10 @@ def test_08_00
if (res = mus_array_print_length) != 8
snd_display("mus_array_print_length: %s?", res)
end
+ set_mus_array_print_length(12)
+ if (res = mus_array_print_length) != 12
+ snd_display("mus_array_print_length: %s?", res)
+ end
set_mus_array_print_length(32)
if (res = mus_array_print_length) != 32
snd_display("set_mus_array_print_length: %s?", res)
@@ -12921,15 +12272,15 @@ def test_08_00
end
10.times do
val = mus_random(1.0)
- if fneq(res1 = polynomial(lv7, val), res2 = cosh(7.0 * acosh(val)))
- snd_display("ccosh cheb 7 %s: %s %s?", val, res1, res2)
- end
- if fneq(res1 = polynomial(lv7, val), res2 = cos(7.0 * acos(val)))
- snd_display("cos cheb 7 %s: %s %s?", val, res1, res2)
- end
- if fneq(res1 = polynomial(lv8, val), res2 = sin(7.0 * acos(val)) / sin(acos(val)))
- snd_display("acos cheb 7 %s: %s %s?", val, res1, res2)
- end
+ res = polynomial(lv7, val)
+ req = cosh(7.0 * acosh(val)).to_f
+ snd_test_neq(res, req, "ccosh cheb 7 %s", val)
+ res = polynomial(lv7, val)
+ req = cos(7.0 * acos(val))
+ snd_test_neq(res, req, "cos cheb 7 %s", val)
+ res = polynomial(lv8, val)
+ req = sin(7.0 * acos(val)) / sin(acos(val))
+ snd_test_neq(res, req, "acos cheb 7 %s", val)
end
end
#
@@ -13019,19 +12370,9 @@ def test_08_00
v0 = make_vct(10)
v1 = make_vct(10)
vct_fill!(v0, 1.0)
- multiply_arrays(v0, v1, 1)
- unless vequal(v0, vct(0.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0))
- snd_display("multiply_arrays[0]: %s?", v0)
- end
- multiply_arrays(v0, v1, 100)
- if fneq(vct_peak(v0), 0.0)
- snd_display("multiply_arrays[100]: %s?", v0)
- end
- vct_fill!(v0, 1.0)
vct_fill!(v1, 0.5)
- multiply_arrays(v0, v1)
- if fneq(v0[0], 0.5)
- snd_display("multiply_arrays: %s?", v0[0])
+ v0.map_with_index! do |x, i|
+ x * v1[i]
end
if fneq(res = dot_product(v0, v1), 2.5)
snd_display("dot_product: %s?", res)
@@ -13042,9 +12383,11 @@ def test_08_00
if fneq(res = dot_product(v0, v1, 3), 0.75)
snd_display("dot_product (3): %s?", res)
end
- clear_array(v0)
+ v0.map! do |x|
+ 0.0
+ end
if fneq(v0[3], 0.0)
- snd_display("clear_array: %s?", v0)
+ snd_display("clear v0: %s?", v0)
end
vct_fill!(v0, 1.0)
vct_fill!(v1, 0.5)
@@ -13061,19 +12404,6 @@ def test_08_00
if fneq(v0[0], 1.0) or fneq(v1[0], 1.0)
snd_display("polar2rectangular (1 1): %s %s?", v0[0], v1[0])
end
- v0 = make_vct(1, 1.0)
- v1 = make_vct(1, 1.0)
- val = 0.123
- rectangular2polar(v0, v1)
- val = v0.first
- polar2rectangular(v0, v1)
- v = vct(v1.first)
- if fneq(v[0], 1.0)
- snd_display("run r->p not inverted: %s?", v)
- end
- if fneq(val, sqrt(2.0))
- snd_display("r->p: %s?", val)
- end
#
ind = open_sound("oboe.snd")
rl = channel2vct(1200, 512)
@@ -13167,7 +12497,7 @@ def test_08_00
err = 0.0
x = -10.0
2000.times do |i|
- diff = (Math.cos(x) - new_cos.call(x)).abs
+ diff = (cos(x) - new_cos.call(x)).abs
if diff > err
err = diff
end
@@ -13179,173 +12509,194 @@ def test_08_00
#
# POLY
#
- unless vequal(res = poly(0.1, 0.2, 0.3) + vct(0, 1, 2, 3, 4), vct(0.1, 1.2, 2.3, 3, 4))
- snd_display("poly_add 1: %s?", res)
- end
- unless vequal(res = poly(0.1, 0.2, 0.3) + 0.5, vct(0.6, 0.2, 0.3))
- snd_display("poly_add 2: %s?", res)
- end
- unless vequal(res = 0.5 + poly(0.1, 0.2, 0.3), vct(0.6, 0.2, 0.3))
- snd_display("poly_add 3: %s?", res)
- end
+ res = poly(0.1, 0.2, 0.3) + vct(0, 1, 2, 3, 4)
+ req = vct(0.1, 1.2, 2.3, 3, 4)
+ snd_test_neq(res, req, "poly_add 1")
+ res = poly(0.1, 0.2, 0.3) + 0.5
+ req = vct(0.6, 0.2, 0.3)
+ snd_test_neq(res, req, "poly_add 2")
+ res = 0.5 + poly(0.1, 0.2, 0.3)
+ req = vct(0.6, 0.2, 0.3)
+ snd_test_neq(res, req, "poly_add 3")
#
- unless vequal(res = poly(1, 1) * vct(-1, 1), vct(-1, 0, 1, 0))
- snd_display("poly_multiply 1: %s?", res)
- end
- unless vequal(res = poly(-5, 1) * vct(3, 7, 2), vct(-15, -32, -3, 2, 0))
- snd_display("poly_multiply 2: %s?", res)
- end
- unless vequal(res = poly(-30, -4, 2) * vct(0.5, 1), vct(-15, -32, -3, 2, 0))
- snd_display("poly_multiply 3: %s?", res)
- end
- unless vequal(res = poly(-30, -4, 2) * 0.5, vct(-15, -2, 1))
- snd_display("poly_multiply 4: %s?", res)
- end
- unless vequal(res = 2.0 * poly(-30, -4, 2), vct(-60, -8, 4))
- snd_display("poly_multiply 5: %s?", res)
- end
- #
- if (not vequal((res = poly(-1, 0, 1) / vct(1, 1))[0], vct(-1, 1, 0))) or
- (not vequal(res[1], vct(0, 0, 0)))
- snd_display("poly_div 1: %s?", res)
- end
- if (not vequal((res = poly(-15, -32, -3, 2) / vct(-5, 1))[0], vct(3, 7, 2, 0))) or
- (not vequal(res[1], vct(0, 0, 0, 0)))
- snd_display("poly_div 2: %s?", res)
- end
- if (not vequal((res = poly(-15, -32, -3, 2) / vct(3, 1))[0], vct(-5, -9, 2, 0))) or
- (not vequal(res[1], vct(0, 0, 0, 0)))
- snd_display("poly_div 3: %s?", res)
- end
- if (not vequal((res = poly(-15, -32, -3, 2) / vct(0.5, 1))[0], vct(-30, -4, 2, 0))) or
- (not vequal(res[1], vct(0, 0, 0, 0)))
- snd_display("poly_div 4: %s?", res)
- end
- if (not vequal((res = poly(-15, -32, -3, 2) / vct(3, 7, 2))[0], vct(-5, 1, 0, 0))) or
- (not vequal(res[1], vct(0, 0, 0, 0)))
- snd_display("poly_div 5: %s?", res)
- end
- unless vequal((res = poly(-15, -32, -3, 2) / 2.0)[0], vct(-7.5, -16, -1.5, 1))
- snd_display("poly_div 6: %s?", res)
- end
- unless vequal((res = poly(-1, 0, 0, 0, 1) / vct(1, 0, 1))[0], vct(-1, 0, 1, 0, 0)) and
- vequal(res[1], vct(0, 0, 0, 0, 0))
- snd_display("poly_div 7: %s?", res)
- end
- unless vequal((res = poly(-1, 0, 0, 0, 0, 0, 0, 0, 1) / vct(1, 0, 0, 0, 1))[0],
- vct(-1, 0, 0, 0, 1, 0, 0, 0, 0)) and
- vequal(res[1], vct(0, 0, 0, 0, 0, 0, 0, 0, 0))
- snd_display("poly_div 8: %s?", res)
- end
- unless vequal((res = poly(-1, 0, 1) / vct(-1, 0, 1))[0], vct(1, 0, 0)) and
- vequal(res[1], vct(0, 0, 0))
- snd_display("poly_div 9: %s?", res)
- end
- unless vequal((res = poly(-1, 0, 1) / vct(2, 1))[0], vct(-2, 1, 0)) and
- vequal(res[1], vct(3, 0, 0))
- snd_display("poly_div 10: %s?", res)
- end
- unless vequal((res = poly(2, 1) / vct(-1, 0, 1))[0], vct(0)) and
- vequal(res[1], vct(-1, 0, 1))
- snd_display("poly_div 11: %s?", res)
- end
- unless vequal((res = poly(1, 2, 3, 0, 1) / vct(0, 0, 0, 1))[0], vct(0, 1, 0, 0, 0)) and
- vequal(res[1], vct(1, 2, 3, 0, 0))
- snd_display("poly_div 12: %s?", res)
+ res = poly(1, 1) * vct(-1, 1)
+ req = vct(-1, 0, 1, 0)
+ snd_test_neq(res, req, "poly_multiply 1")
+ res = poly(-5, 1) * vct(3, 7, 2)
+ req = vct(-15, -32, -3, 2, 0)
+ snd_test_neq(res, req, "poly_multiply 2")
+ res = poly(-30, -4, 2) * vct(0.5, 1)
+ req = vct(-15, -32, -3, 2, 0)
+ snd_test_neq(res, req, "poly_multiply 3")
+ res = poly(-30, -4, 2) * 0.5
+ req = vct(-15, -2, 1)
+ snd_test_neq(res, req, "poly_multiply 4")
+ res = 2.0 * poly(-30, -4, 2)
+ req = vct(-60, -8, 4)
+ snd_test_neq(res, req, "poly_multiply 5")
+ #
+ res = poly(-1, 0, 1) / vct(1, 1)
+ req1 = vct(-1, 1, 0)
+ req2 = vct(0, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 1a")
+ snd_format_neq(res[1], req2, "poly_div 1b")
+ end
+ res = poly(-15, -32, -3, 2) / vct(-5, 1)
+ req1 = vct(3, 7, 2, 0)
+ req2 = vct(0, 0, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 2a")
+ snd_format_neq(res[1], req2, "poly_div 2b")
+ end
+ res = poly(-15, -32, -3, 2) / vct(3, 1)
+ req1 = vct(-5, -9, 2, 0)
+ req2 = vct(0, 0, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 3a")
+ snd_format_neq(res[1], req2, "poly_div 3b")
+ end
+ res = poly(-15, -32, -3, 2) / vct(0.5, 1)
+ req1 = vct(-30, -4, 2, 0)
+ req2 = vct(0, 0, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 4a")
+ snd_format_neq(res[1], req2, "poly_div 4b")
+ end
+ res = poly(-15, -32, -3, 2) / vct(3, 7, 2)
+ req1 = vct(-5, 1, 0, 0)
+ req2 = vct(0, 0, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 5a")
+ snd_format_neq(res[1], req2, "poly_div 5b")
+ end
+ res = poly(-15, -32, -3, 2) / 2.0
+ req = vct(-7.5, -16, -1.5, 1)
+ snd_test_neq(res[0], req, "poly_div 6")
+ res = poly(-1, 0, 0, 0, 1) / vct(1, 0, 1)
+ req1 = vct(-1, 0, 1, 0, 0)
+ req2 = vct(0, 0, 0, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 7a")
+ snd_format_neq(res[1], req2, "poly_div 7b")
+ end
+ res = poly(-1, 0, 0, 0, 0, 0, 0, 0, 1) / vct(1, 0, 0, 0, 1)
+ req1 = vct(-1, 0, 0, 0, 1, 0, 0, 0, 0)
+ req2 = vct(0, 0, 0, 0, 0, 0, 0, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 8a")
+ snd_format_neq(res[1], req2, "poly_div 8b")
+ end
+ res = poly(-1, 0, 1) / vct(-1, 0, 1)
+ req1 = vct(1, 0, 0)
+ req2 = vct(0, 0, 0)
+ snd_format_neq(res[0], req1, "poly_div 9a")
+ snd_format_neq(res[1], req2, "poly_div 9b")
+ res = poly(-1, 0, 1) / vct(2, 1)
+ req1 = vct(-2, 1, 0)
+ req2 = vct(3, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 10a")
+ snd_format_neq(res[1], req2, "poly_div 10b")
+ end
+ res = poly(2, 1) / vct(-1, 0, 1)
+ req1 = vct(0)
+ req2 = vct(-1, 0, 1)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 11a")
+ snd_format_neq(res[1], req2, "poly_div 11b")
+ end
+ res = poly(1, 2, 3, 0, 1) / vct(0, 0, 0, 1)
+ req1 = vct(0, 1, 0, 0, 0)
+ req2 = vct(1, 2, 3, 0, 0)
+ unless vequal(res[0], req1) or vequal(res[1], req2)
+ snd_format_neq(res[0], req1, "poly_div 12a")
+ snd_format_neq(res[1], req2, "poly_div 12b")
end
#
ind = open_sound("1a.snd")
v1 = channel2vct(0, 100, ind, 0)
v2 = channel2vct(0, 100, ind, 0)
- vals = poly_div(v1, v2)[0]
- res = make_vct(100)
- res[0] = 1.0
- unless vequal(vals, res)
- snd_display("poly1 1a: %s?", valse)
- end
+ res = poly_div(v1, v2)[0]
+ req = make_vct(100)
+ req[0] = 1.0
+ snd_test_neq(res, req, "poly1 1a")
close_sound(ind)
#
- unless vequal(res = poly(0.5, 1, 2, 4).derivative, vct(1, 4, 12))
- snd_display("poly_derivative: %s?", res)
- end
+ res = poly(0.5, 1, 2, 4).derivative
+ req = vct(1, 4, 12)
+ snd_test_neq(res, req, "poly_derivative")
#
- unless vequal(res = poly(1, 2, 3).reduce, vct(1, 2, 3))
- snd_display("reduce 1: %s?", res)
- end
- unless vequal(res = poly(1, 2, 3, 0, 0, 0).reduce, vct(1, 2, 3))
- snd_display("reduce 2: %s?", res)
- end
- unless vequal(res = poly(0, 0, 0, 0, 1, 0).reduce, vct(0, 0, 0, 0, 1))
- snd_display("reduce 3: %s?", res)
- end
+ res = poly(1, 2, 3).reduce
+ req = vct(1, 2, 3)
+ snd_test_neq(res, req, "reduce 1")
+ res = poly(1, 2, 3, 0, 0, 0).reduce
+ req = vct(1, 2, 3)
+ snd_test_neq(res, req, "reduce 2")
+ res = poly(0, 0, 0, 0, 1, 0).reduce
+ req = vct(0, 0, 0, 0, 1)
+ snd_test_neq(res, req, "reduce 3")
#
res = (poly(2, 1) * vct(-3, 1)).reduce.gcd(vct(2, 1))
- unless vequal(res, vct(2, 1))
- snd_display("poly_gcd 1: %s?", res)
- end
+ req = vct(2, 1)
+ snd_test_neq(res, req, "poly_gcd 1")
res = (poly(2, 1) * vct(-3, 1)).reduce.gcd(vct(3, 1))
- unless vequal(res, vct(0))
- snd_display("poly_gcd 2: %s?", res)
- end
+ req = vct(0)
+ snd_test_neq(res, req, "poly_gcd 2")
res = (poly(2, 1) * vct(-3, 1)).reduce.gcd(vct(-3, 1))
- unless vequal(res, vct(-3, 1))
- snd_display("poly_gcd 3: %s?", res)
- end
+ req = vct(-3, 1)
+ snd_test_neq(res, req, "poly_gcd 3")
res = (poly(8, 1) * poly(2, 1) * poly(-3, 1)).reduce.gcd(vct(-3, 1))
- unless vequal(res, vct(-3, 1))
- snd_display("poly_gcd 4: %s?", res)
- end
- res = (poly(8, 1) * poly(2, 1) * [-3, 1]).reduce.gcd((poly(8, 1) * [-3, 1]).reduce)
- unless vequal(res, vct(-24, 5, 1))
- snd_display("poly_gcd 5: %s?", res)
- end
- unless vequal(res = poly(-1, 0, 1).gcd([2, -2, -1, 1]), [0])
- snd_display("poly_gcd 6: %s?", res)
- end
- unless vequal(res = poly(2, -2, -1, 1).gcd([-1, 0, 1]), [1, -1])
- snd_display("poly_gcd 7: %s?", res)
- end
- unless vequal(res = poly(2, -2, -1, 1).gcd([-2.5, 1]), [0])
- snd_display("poly_gcd 8: %s?", res)
- end
- #
- poly_roots_tests
- #
- if fneq(res = poly(-1, 0, 1).resultant([1, -2, 1]), 0.0)
- snd_display("poly_resultant 0: %s?", res)
- end
- if fneq(res = poly(-1, 0, 2).resultant([1, -2, 1]), 1.0)
- snd_display("poly_resultant 1: %s?", res)
- end
- if fneq(res = poly(-1, 0, 1).resultant([1, 1]), 0.0)
- snd_display("poly_resultant 2: %s?", res)
- end
- if fneq(res = poly(-1, 0, 1).resultant([2, 1]), 3.0)
- snd_display("poly_resultant 3: %s?", res)
- end
-
- if fneq(poly(-1, 0, 1).discriminant, -4.0)
- snd_display("poly_discriminat 0: %s?", res)
- end
- if fneq(poly(1, -2, 1).discriminant, 0.0)
- snd_display("poly_discriminat 1: %s?", res)
- end
+ req = vct(-3, 1)
+ snd_test_neq(res, req, "poly_gcd 4")
+ res = poly(8, 1) * poly(2, 1) * [-3, 1]
+ res = res.reduce.gcd((poly(8, 1) * [-3, 1]).reduce)
+ req = vct(-24, 5, 1)
+ snd_test_neq(res, req, "poly_gcd 5")
+ res = poly(-1, 0, 1).gcd([2, -2, -1, 1])
+ req = [0]
+ snd_test_neq(res, req, "poly_gcd 6")
+ res = poly(2, -2, -1, 1).gcd([-1, 0, 1])
+ req = [1, -1]
+ snd_test_neq(res, req, "poly_gcd 7")
+ res = poly(2, -2, -1, 1).gcd([-2.5, 1])
+ req = [0]
+ snd_test_neq(res, req, "poly_gcd 8")
+ #
+ poly_roots_tests()
+ #
+ res = poly(-1, 0, 1).resultant([1, -2, 1])
+ req = 0.0
+ snd_test_neq(res, req, "poly_resultant 0")
+ res = poly(-1, 0, 2).resultant([1, -2, 1])
+ req = 1.0
+ snd_test_neq(res, req, "poly_resultant 1")
+ res = poly(-1, 0, 1).resultant([1, 1])
+ req = 0.0
+ snd_test_neq(res, req, "poly_resultant 2")
+ res = poly(-1, 0, 1).resultant([2, 1])
+ req = 3.0
+ snd_test_neq(res, req, "poly_resultant 3")
+ #
+ res = poly(-1, 0, 1).discriminant
+ req = -4.0
+ snd_test_neq(res, req, "poly_discriminant 0")
+ res = poly(1, -2, 1).discriminant
+ req = 0.0
+ snd_test_neq(res, req, "poly_discriminant 1")
res = (poly(-1, 1) * poly(-1, 1) * poly(3, 1)).reduce.discriminant
- if fneq(res, 0.0)
- snd_display("poly_discriminat 2: %s?", res)
- end
- res = (poly(-1, 1) * poly(-1, 1) * poly(3, 1) * poly(2, 1)).reduce.discriminant
- if fneq(res, 0.0)
- snd_display("poly_discriminat 3: %s?", res)
- end
+ req = 0.0
+ snd_test_neq(res, req, "poly_discriminant 2")
+ res = (poly(-1, 1) * poly(-1, 1) *
+ poly(3, 1) * poly(2, 1)).reduce.discriminant
+ req = 0.0
+ snd_test_neq(res, req, "poly_discriminant 3")
res = (poly(1, 1) * poly(-1, 1) * poly(3, 1) * poly(2, 1)).reduce.discriminant
- if fneq(res, 2304.0)
- snd_display("poly_discriminat 4: %s?", res)
- end
+ req = 2304.0
+ snd_test_neq(res, req, "poly_discriminant 4")
res = (poly(1, 1) * poly(-1, 1) * poly(3, 1) * poly(3, 1)).reduce.discriminant
- if fneq(res, 0.0)
- snd_display("poly_discriminat 5: %s?", res)
- end
+ req = 0.0
+ snd_test_neq(res, req, "poly_discriminant 5")
#
v0 = make_vct!(10) do |i| i end
if fneq(res = array_interp(v0, 3.5), 3.5)
@@ -13438,7 +12789,7 @@ def test_08_01
gen2 = make_delay(3)
gen1 = make_delay(4, :initial_contents, [1.0, 0.5, 0.25, 0.0])
gen3 = make_delay(4, :initial_contents, vct(1.0, 0.5, 0.25, 0.0))
- print_and_check(gen, "delay", "delay line[3, step]: [0.000 0.000 0.000]")
+ print_and_check(gen, "delay", "delay line[3, step]: [0 0 0]")
v0 = make_vct!(10) do |i| delay(gen, i) end
v1 = make_vct!(10) do |i| delay?(gen2) ? delay(gen2, i) : -1.0 end
unless vequal(v1, v0)
@@ -13517,7 +12868,7 @@ def test_08_01
end
delay(del, 1.0)
delay(del, 0.0, 0.4)
- if (res = del.to_s) != "delay line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000]"
+ if (res = del.to_s) != "delay line[5,8, linear]: [0 0 1 0 0]"
snd_display("describe zdelay: %s", res)
end
if (res = Snd.catch do tap(make_oscil) end).first != :wrong_type_arg
@@ -13528,24 +12879,24 @@ def test_08_01
flt = make_one_zero(0.5, 0.4)
v = make_vct(20)
inval = 1.0
- vct_map!(v, lambda do | |
- res = delay(dly, inval + one_zero(flt, tap(dly)) * 0.6)
- inval = 0.0
- res
- end)
+ v.map! do |x|
+ res = delay(dly, inval + one_zero(flt, tap(dly)) * 0.6)
+ inval = 0.0
+ res
+ end
unless vequal(v, vct(0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.3, 0.24, 0.0, 0.09,
- 0.144, 0.058, 0.027, 0.065, 0.052, 0.022, 0.026, 0.031, 0.019, 0.013))
+ 0.144, 0.058, 0.027, 0.065, 0.052, 0.022, 0.026, 0.031, 0.019, 0.013))
snd_display("tap with low pass: %s?", v)
end
#
dly = make_delay(3)
v = make_vct(20)
inval = 1.0
- vct_map!(v, lambda do | |
- res = delay(dly, inval + tap(dly))
- inval = 0.0
- res
- end)
+ v.map! do |x|
+ res = delay(dly, inval + tap(dly))
+ inval = 0.0
+ res
+ end
unless vequal(v, vct(0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 0.0, 0.0, 1.0,
0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 0.0))
snd_display("simple tap: %s?", v)
@@ -13553,11 +12904,12 @@ def test_08_01
dly = make_delay(6)
v = make_vct(20)
inval = 1.0
- vct_map!(v, lambda do | |
- res = delay(dly, inval + tap(dly, -2.0))
- inval = 0.0
- res
- end)
+ snd_test_neq(tap?(dly), true, "tap?")
+ v.map! do |x|
+ res = delay(dly, inval + tap(dly, -2.0))
+ inval = 0.0
+ res
+ end
unless vequal(v, vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0,
1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0))
snd_display("tap back 2: %s?", v)
@@ -13714,7 +13066,7 @@ def test_08_01
impulse = 0.0
val
end
- unless vequal(data, vct(0.6, 0.0, 0.0, 0.0, 0.0))
+ unless vequal(data, vct(0.6, 0.4, 0.0, 0.0, 0.0))
snd_display("delay size 0, max 1, off 0.4: %s", data)
end
dly = make_delay(:size, 0, :max_size, 1)
@@ -13728,7 +13080,7 @@ def test_08_01
impulse = 0.0
val
end
- unless vequal(data, vct(1.4, 0.0, 0.0, 0.0, 0.0))
+ unless vequal(data, vct(1.4, -0.4, 0.0, 0.0, 0.0))
snd_display("delay size 0, max 1, off -0.4: %s", data)
end
dly = make_delay(:size, 0, :max_size, 100)
@@ -13737,7 +13089,7 @@ def test_08_01
snd_display("delay 0 -> 100: %s", v)
end
9.downto(0) do |i| v[i] = delay(dly, 0.5, i) end
- unless vequal(v, vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.0))
+ unless vequal(v, vct(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5))
snd_display("delay 100 -> 0: %s", v)
end
dly.reset
@@ -13760,10 +13112,10 @@ def test_08_02
gen1 = make_all_pass(0.4, 0.6, 3)
print_and_check(gen,
"all-pass",
- "all-pass feedback: 0.400, feedforward: 0.600, line[3, step]:[0.000 0.000 0.000]")
+ "all-pass feedback: 0.400, feedforward: 0.600, line[3, step]:[0 0 0]")
v0 = make_vct!(10) do all_pass(gen, 1.0) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | all_pass?(gen1) ? all_pass(gen1, 1.0) : -1.0 end)
+ v1.map! do |x| all_pass?(gen1) ? all_pass(gen1, 1.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map all-pass: %s %s?", v0, v1)
end
@@ -13809,7 +13161,9 @@ def test_08_02
test_gen_equal(make_all_pass(0.7, 0.5, 3, :initial_contents, [1.0, 0.0, 0.0]),
make_all_pass(0.7, 0.5, 3, :initial_contents, [1.0, 0.0, 0.0]),
make_all_pass(0.7, 0.5, 3, :initial_contents, [1.0, 1.0, 1.0]))
- err = Snd.catch do make_all_pass(:feedback, 0.2, :feedforward, 0.1, :size, -1) end
+ err = Snd.catch do
+ make_all_pass(:feedback, 0.2, :feedforward, 0.1, :size, -1)
+ end
if err.first != :out_of_range or
err[1] != "make_all_pass" or
err[2] != "size _1 < 0?" or
@@ -13818,10 +13172,11 @@ def test_08_02
#
gen = make_moving_average(4)
gen1 = make_moving_average(4)
- print_and_check(gen, "moving-average", "moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]")
+ print_and_check(gen, "moving-average",
+ "moving-average 0.000, line[4]:[0 0 0 0]")
v0 = make_vct!(10) do moving_average(gen, 1.0) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | moving_average?(gen1) ? moving_average(gen1, 1.0) : -1.0 end)
+ v1.map! do |x| moving_average?(gen1) ? moving_average(gen1, 1.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map moving_average: %s %s?", v0, v1)
end
@@ -13887,19 +13242,19 @@ def test_08_02
test_gen_equal(make_moving_average(3, :initial_contents, [1.0, 0.0, 0.0]),
make_moving_average(3, :initial_contents, [1.0, 0.0, 0.0]),
make_moving_average(3, :initial_contents, [1.0, 1.0, 1.0]))
- err = Snd.catch do make_moving_average(:size, -2) end
+ err = Snd.catch do make_moving_average(:size, -1) end
if err.first != :out_of_range or
err[1] != "make_moving_average" or
- err[2] != "size _2 < 0?" or
+ err[2] != "size -1 < 0?" or
snd_display("make_moving_average bad size error message: %s", err.inspect)
end
#
gen = make_comb(0.4, 3)
gen1 = make_comb(0.4, 3)
- print_and_check(gen, "comb", "comb scaler: 0.400, line[3, step]: [0.000 0.000 0.000]")
+ print_and_check(gen, "comb", "comb scaler: 0.400, line[3, step]: [0 0 0]")
v0 = make_vct!(10) do comb(gen, 1.0) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | comb?(gen1) ? comb(gen1, 1.0) : -1.0 end)
+ v1.map! do |x| comb?(gen1) ? comb(gen1, 1.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map comb: %s %s?", v0, v1)
end
@@ -13943,7 +13298,7 @@ def test_08_02
end
comb(del, 1.0)
comb(del, 0.0, 0.4)
- if (res = del.to_s) != "comb scaler: 0.000, line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000]"
+ if (res = del.to_s) != "comb scaler: 0.000, line[5,8, linear]: [0 0 1 0 0]"
snd_display("describe zcomb: %s", res)
end
del.feedback = 1.0
@@ -13954,12 +13309,11 @@ def test_08_02
gen = make_filtered_comb(0.4, 5, :filter, make_one_zero(0.3, 0.7))
print_and_check(gen,
"filtered-comb",
- "filtered-comb scaler: 0.400, line[5, step]: [0.000 0.000 0.000 0.000 0.000], filter: [one-zero a0: 0.300, a1: 0.700, x1: 0.000]")
+ "filtered-comb scaler: 0.400, line[5, step]: [0 0 0 0 0], filter: [one-zero a0: 0.300, a1: 0.700, x1: 0.000]")
v0 = make_vct!(20) do |i| filtered_comb(gen, (i.zero? ? 1.0 : 0.0)) end
- unless vequal(v0,
- vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0.12, 0.28, 0, 0, 0, 0.014, 0.067, 0.078, 0, 0))
- snd_display("filtered_comb: %s?", v0)
- end
+ v1 = vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0.12, 0.28,
+ 0, 0, 0, 0.014, 0.067, 0.078, 0, 0)
+ snd_test_neq(v0, v1, "filtered_comb")
unless filtered_comb?(gen)
snd_display("%s not filtered_comb?", gen)
end
@@ -13975,22 +13329,21 @@ def test_08_02
gen = make_filtered_comb(0.9, 5, :filter, make_one_zero(0.5, 0.5))
print_and_check(gen,
"filtered-comb",
- "filtered-comb scaler: 0.900, line[5, step]: [0.000 0.000 0.000 0.000 0.000], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]")
+ "filtered-comb scaler: 0.900, line[5, step]: [0 0 0 0 0], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]")
v0 = make_vct!(20) do |i| filtered_comb(gen, (i.zero? ? 1.0 : 0.0)) end
- unless vequal(v0,
- vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0.45, 0.45, 0, 0, 0, 0.202, 0.405, 0.202, 0, 0))
- snd_display("filtered_comb: 0.5 0.5 %s?", v0)
- end
- gen = make_filtered_comb(0.9, 5, :filter, make_fir_filter(5, vct(0.1, 0.2, 0.3, 0.2, 0.1)))
+ v1 = vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0.45, 0.45,
+ 0, 0, 0, 0.202, 0.405, 0.202, 0, 0)
+ snd_test_neq(v0, v1, "filtered_comb: 0.5 0.5")
+ gen = make_filtered_comb(0.9, 5,
+ :filter,
+ make_fir_filter(5, vct(0.1, 0.2, 0.3, 0.2, 0.1)))
print_and_check(gen,
"filtered-comb",
- "filtered-comb scaler: 0.900, line[5, step]: [0.000 0.000 0.000 0.000 0.000], filter: [fir-filter order: 5, xs: [0.100 0.200 0.300 0.200 0.100]]")
+ "filtered-comb scaler: 0.900, line[5, step]: [0 0 0 0 0], filter: [fir-filter order: 5, xs: [0.1 0.2 0.3 0.2 0.1]]")
v0 = make_vct!(20) do |i| filtered_comb(gen, (i.zero? ? 1.0 : 0.0)) end
- unless vequal(v0,
- vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
- 0.09, 0.18, 0.27, 0.18, 0.09, 0.008, 0.032, 0.081, 0.13, 0.154))
- snd_display("filtered_comb (fir): %s?", v0)
- end
+ v1 = vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
+ 0.09, 0.18, 0.27, 0.18, 0.09, 0.008, 0.032, 0.081, 0.13, 0.154)
+ snd_test_neq(v0, v1, "filtered_comb (fir)")
d1 = make_filtered_comb(0.7, 3, :filter, make_one_pole(0.3, 0.7))
d2 = make_filtered_comb(0.7, 3, :filter, make_one_pole(0.3, 0.7))
d3 = make_filtered_comb(0.7, 4, :filter, make_one_pole(0.3, 0.7))
@@ -13998,41 +13351,43 @@ def test_08_02
filtered_comb(d2, 1.0)
filtered_comb(d3, 1.0)
test_gen_equal(d1, d2, d3)
- test_gen_equal(make_filtered_comb(0.7, 3, :initial_element, 1.0,:filter, make_one_zero(0.5, 0.5)),
- make_filtered_comb(0.7, 3, :initial_element, 1.0,:filter, make_one_zero(0.5, 0.5)),
- make_filtered_comb(0.7, 3, :initial_element, 0.5,:filter, make_one_zero(0.5, 0.5)))
- test_gen_equal(make_filtered_comb(0.7, 3, :initial_element, 1.0,:filter, make_one_zero(0.5, 0.5)),
- make_filtered_comb(0.7, 3, :initial_element, 1.0,:filter, make_one_zero(0.5, 0.5)),
- make_filtered_comb(0.7, 3, :initial_element, 1.0,:filter, make_one_zero(0.25, 0.25)))
+ test_gen_equal(make_filtered_comb(0.7, 3, :initial_element, 1.0,
+ :filter, make_one_zero(0.5, 0.5)),
+ make_filtered_comb(0.7, 3, :initial_element, 1.0,
+ :filter, make_one_zero(0.5, 0.5)),
+ make_filtered_comb(0.7, 3, :initial_element, 0.5,
+ :filter, make_one_zero(0.5, 0.5)))
+ test_gen_equal(make_filtered_comb(0.7, 3, :initial_element, 1.0,
+ :filter, make_one_zero(0.5, 0.5)),
+ make_filtered_comb(0.7, 3, :initial_element, 1.0,
+ :filter, make_one_zero(0.5, 0.5)),
+ make_filtered_comb(0.7, 3, :initial_element, 1.0,
+ :filter, make_one_zero(0.25, 0.25)))
test_gen_equal(make_filtered_comb(0.7, 3, :initial_contents, [1.0, 0.0, 0.0],
:filter, make_one_zero(0.5, 0.5)),
make_filtered_comb(0.7, 3, :initial_contents, [1.0, 0.0, 0.0],
:filter, make_one_zero(0.5, 0.5)),
make_filtered_comb(0.7, 3, :initial_contents, [1.0, 1.0, 1.0],
:filter, make_one_zero(0.5, 0.5)))
- del = make_filtered_comb(0.0, 5, :max_size, 8, :filter, make_one_zero(0.5, 0.5))
+ del = make_filtered_comb(0.0, 5, :max_size, 8,
+ :filter, make_one_zero(0.5, 0.5))
filtered_comb(del, 1.0)
4.times do filtered_comb(del, 0.0) end
v0 = make_vct!(5) do filtered_comb(del, 0.0, 0.4) end
- unless vequal(v0, vct(0.6, 0.4, 0, 0, 0))
- snd_display("zfiltered_comb: %s?", v0)
- end
+ snd_test_neq(v0, vct(0.6, 0.4, 0, 0, 0), "zfiltered_comb")
filtered_comb(del, 1.0)
filtered_comb(del, 0.0, 0.4)
- if (res = mus_describe(del)) != "filtered-comb scaler: 0.000, line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]"
- snd_display("describe zfiltered_comb: %s?", res)
- end
+ snd_test_neq(mus_describe(del), "filtered-comb scaler: 0.000, line[5,8, linear]: [0 0 1 0 0], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]",
+ "describe zfiltered_comb")
del.feedback = 1.0
- if fneq(del.feedback, 1.0)
- snd_display("filtered_echo feedback set: %s?", del.feedback)
- end
+ snd_test_neq(del.feedback, 1.0, "filtered_echo feedback set")
#
gen = make_notch(0.4, 3)
gen1 = make_notch(0.4, 3)
- print_and_check(gen, "notch", "notch scaler: 0.400, line[3, step]: [0.000 0.000 0.000]")
+ print_and_check(gen, "notch",
+ "notch scaler: 0.400, line[3, step]: [0 0 0]")
v0 = make_vct!(10) do notch(gen, 1.0) end
- v1 = make_vct(10)
- vct_map!(v1, lambda do | | notch?(gen1) ? notch(gen1, 1.0) : -1.0 end)
+ v1 = Vct.new(10) do |x| notch?(gen1) ? notch(gen1, 1.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map notch: %s %s?", v0, v1)
end
@@ -14069,162 +13424,168 @@ def test_08_02
make_notch(0.7, 3, :initial_contents, [1.0, 1.0, 1.0]))
# make sure all-pass is the same as comb/notch given the appropriate
# feedback/forward settings
- [[make_comb(0.5, 5), vct(0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5)],
- [make_all_pass(0.5, 0.0, 5), vct(0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5)],
- [make_notch(0.5, 5), vct(0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
- [make_all_pass(0.0, 0.5, 5), vct(0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0)]
- ].each do |gen, v1|
- v0 = make_vct!(11) do |i| gen.run(i.zero? ? 1.0 : 0.0) end
- unless vequal(v0, v1)
- snd_display("0 %s (0.5, 0.0, 5): %s", gen.name, v0)
- end
+ [[make_comb(0.5, 5),
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5)],
+ [make_all_pass(0.5, 0.0, 5),
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5)],
+ [make_notch(0.5, 5),
+ vct(0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
+ [make_all_pass(0.0, 0.5, 5),
+ vct(0.5, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0)]].each do |gen, v1|
+ v0 = Vct.new(11) do |i|
+ gen.run(i.zero? ? 1.0 : 0.0)
+ end
+ snd_test_neq(v0, v1, "0 %s (0.5, 0.0, 5)", gen.name)
end
# make sure all-pass is the same as zcomb/znotch given the
# appropriate feedback/forward and "pm" settings
[[make_comb(0.5, 5, :max_size, 20),
- vct(0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5)],
- [make_all_pass(0.5, 0.0, 5, :max_size, 20),
- vct(0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5)],
- [make_notch(0.5, 5, :max_size, 20),
- vct(0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
- [make_all_pass(0.0, 0.5, 5, :max_size, 20),
- vct(0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0)]].each do |gen, v1|
- v0 = make_vct!(11) do |i| gen.run(i.zero? ? 1.0 : 0.0) end
- unless vequal(v0, v1)
- snd_display("1 %s (0.5, 0.0, 5): %s", gen.name, v0)
- end
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5)],
+ [make_all_pass(0.5, 0.0, 5, :max_size, 20),
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.5)],
+ [make_notch(0.5, 5, :max_size, 20),
+ vct(0.5, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
+ [make_all_pass(0.0, 0.5, 5, :max_size, 20),
+ vct(0.5, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0)]].each do |gen, v1|
+ v0 = Vct.new(11) do |i|
+ gen.run(i.zero? ? 1.0 : 0.0)
+ end
+ snd_test_neq(v0, v1, "1 %s (0.5, 0.0, 5)", gen.name)
end
# now actually use the size difference
[[make_comb(0.5, 5, :max_size, 20),
- vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.4, 0.0, 0.0,
- 0.0, 0.0, 0.0, 0.16, 0.36, 0.2, 0.04, 0.0, 0.0, 0.0)],
- [make_all_pass(0.5, 0.0, 5, :max_size, 20),
- vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.4, 0.0, 0.0,
- 0.0, 0.0, 0.0, 0.16, 0.36, 0.2, 0.04, 0.0, 0.0, 0.0)],
- [make_notch(0.5, 5, :max_size, 20),
- vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.4, 0.0, 0.0, 0.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
- [make_all_pass(0.0, 0.5, 5, :max_size, 20),
- vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.4, 0.0, 0.0, 0.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)]].each do |gen, v1|
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.4, 0.0, 0.0,
+ 0.0, 0.0, 0.0, 0.16, 0.36, 0.2, 0.04, 0.0, 0.0, 0.0)],
+ [make_all_pass(0.5, 0.0, 5, :max_size, 20),
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.4, 0.0, 0.0,
+ 0.0, 0.0, 0.0, 0.16, 0.36, 0.2, 0.04, 0.0, 0.0, 0.0)],
+ [make_notch(0.5, 5, :max_size, 20),
+ vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.4, 0.0, 0.0, 0.0,
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
+ [make_all_pass(0.0, 0.5, 5, :max_size, 20),
+ vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.4, 0.0, 0.0, 0.0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)]].each do |gen, v1|
angle = -0.2
- v0 = make_vct!(20) do |i| gen.run((i.zero? ? 1.0 : 0.0), angle += 0.2) end
- unless vequal(v0, v1)
- snd_display("2 %s (0.5, 0.0, 5): %s", gen.name, v0)
+ v0 = Vct.new(20) do |i|
+ gen.run((i.zero? ? 1.0 : 0.0), angle += 0.2)
end
+ snd_test_neq(v0, v1, "2 %s (0.5, 0.0, 5)", gen.name)
end
[[make_comb(0.5, 5, :max_size, 20),
- vct(0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.16, 0.16, 0.0,
- 0.08, 0.064, 0.016, 0.035, 0.013, 0.018, 0.007, 0.007, 0.003, 0.002)],
- [make_all_pass(0.5, 0.0, 5, :max_size, 20),
- vct(0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.16, 0.16, 0.0,
- 0.08, 0.064, 0.016, 0.035, 0.013, 0.018, 0.007, 0.007, 0.003, 0.002)],
- [make_notch(0.5, 5, :max_size, 20),
- vct(0.5, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
- [make_all_pass(0.0, 0.5, 5, :max_size, 20),
- vct(0.5, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)]].each do |gen, v1|
- angle = +0.2
- v0 = make_vct!(20) do |i| gen.run((i.zero? ? 1.0 : 0.0), angle -= 0.2) end
- unless vequal(v0, v1)
- snd_display("3 %s (0.5, 0.0, 5): %s", gen.name, v0)
- end
+ vct(0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.16, 0.16, 0.0,
+ 0.08, 0.064, 0.016, 0.035, 0.013, 0.018, 0.007, 0.007, 0.003, 0.002)],
+ [make_all_pass(0.5, 0.0, 5, :max_size, 20),
+ vct(0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.16, 0.16, 0.0,
+ 0.08, 0.064, 0.016, 0.035, 0.013, 0.018, 0.007, 0.007, 0.003, 0.002)],
+ [make_notch(0.5, 5, :max_size, 20),
+ vct(0.5, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
+ [make_all_pass(0.0, 0.5, 5, :max_size, 20),
+ vct(0.5, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)]].each do |gen, v1|
+ angle = 0.2
+ v0 = Vct.new(20) do |i|
+ gen.run((i.zero? ? 1.0 : 0.0), angle -= 0.2)
+ end
+ snd_test_neq(v0, v1, "3 %s (0.5, 0.0, 5)", gen.name)
end
[[make_comb(0.5, 5, :max_size, 20),
- vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.95, 0.06, 0.0, 0.0, 0.0,
- 0.428, 0.079, 0.004, 0.0, 0.0, 0.182, 0.067, 0.008, 0.0, 0.0)],
- [make_all_pass(0.5, 0.0, 5, :max_size, 20),
- vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.95, 0.06, 0.0, 0.0, 0.0,
- 0.428, 0.079, 0.004, 0.0, 0.0, 0.182, 0.067, 0.008, 0.0, 0.0)],
- [make_notch(0.5, 5, :max_size, 20),
- vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.95, 0.06, 0.0, 0.0, 0.0, 0.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
- [make_all_pass(0.0, 0.5, 5, :max_size, 20),
- vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.95, 0.06, 0.0, 0.0, 0.0, 0.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)]].each do |gen, v1|
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.95, 0.06, 0.0, 0.0, 0.0,
+ 0.428, 0.079, 0.004, 0.0, 0.0, 0.182, 0.067, 0.008, 0.0, 0.0)],
+ [make_all_pass(0.5, 0.0, 5, :max_size, 20),
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.95, 0.06, 0.0, 0.0, 0.0,
+ 0.428, 0.079, 0.004, 0.0, 0.0, 0.182, 0.067, 0.008, 0.0, 0.0)],
+ [make_notch(0.5, 5, :max_size, 20),
+ vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.95, 0.06, 0.0, 0.0, 0.0, 0.0,
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
+ [make_all_pass(0.0, 0.5, 5, :max_size, 20),
+ vct(0.5, 0, 0, 0, 0, 0.95, 0.06, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)]].each do |gen, v1|
angle = -0.01
- v0 = make_vct!(20) do |i| gen.run((i.zero? ? 1.0 : 0.0), angle += 0.01) end
- unless vequal(v0, v1)
- snd_display("4 %s (0.5, 0.0, 5): %s", gen.name, v0)
+ v0 = Vct.new(20) do |i|
+ gen.run((i.zero? ? 1.0 : 0.0), angle += 0.01)
end
+ snd_test_neq(v0, v1, "4 %s (0.5, 0.0, 5)", gen.name)
end
# now run off either end of the delay line "by accident"
[[make_comb(0.5, 5, :max_size, 10),
- vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5,
- 1.0, 0.25, 0.125, 0.094, 0.062, 0.055, 0.047, 0.039, 0.031, 0.029)],
- [make_all_pass(0.5, 0.0, 5, :max_size, 10),
- vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5,
- 1.0, 0.25, 0.125, 0.094, 0.062, 0.055, 0.047, 0.039, 0.031, 0.029)],
- [make_notch(0.5, 5, :max_size, 10),
- vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 1.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
- [make_all_pass(0.0, 0.5, 5, :max_size, 10),
- vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 1.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)]].each do |gen, v1|
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5,
+ 1.0, 0.25, 0.125, 0.094, 0.062, 0.055, 0.047, 0.039, 0.031, 0.029)],
+ [make_all_pass(0.5, 0.0, 5, :max_size, 10),
+ vct(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5,
+ 1.0, 0.25, 0.125, 0.094, 0.062, 0.055, 0.047, 0.039, 0.031, 0.029)],
+ [make_notch(0.5, 5, :max_size, 10),
+ vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 1.0,
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
+ [make_all_pass(0.0, 0.5, 5, :max_size, 10),
+ vct(0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 1.0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)]].each do |gen, v1|
angle = -0.5
- v0 = make_vct!(20) do |i| gen.run((i.zero? ? 1.0 : 0.0), angle += 0.5) end
- unless vequal(v0, v1)
- snd_display("5 %s (0.5, 0.0, 5): %s", gen.name, v0)
+ v0 = Vct.new(20) do |i|
+ gen.run((i.zero? ? 1.0 : 0.0), angle += 0.5)
end
+ snd_test_neq(v0, v1, "5 %s (0.5, 0.0, 5)", gen.name)
end
[[make_comb(0.5, 5, :max_size, 10),
- vct(0.0, 0.0, 0.0, 0.5, 0.0, 0.125, 0.0, 0.031, 0.016, 0.004,
- 1.0, 0.0, 0.25, 0.031, 0.0, 0.012, 0.002, 0.250, 0.125, 0.008)],
- [make_all_pass(0.5, 0.0, 5, :max_size, 10),
- vct(0.0, 0.0, 0.0, 0.5, 0.0, 0.125, 0.0, 0.031, 0.016, 0.004,
- 1.0, 0.0, 0.25, 0.031, 0.0, 0.012, 0.002, 0.250, 0.125, 0.008)],
- [make_notch(0.5, 5, :max_size, 10),
- vct(0.5, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
- [make_all_pass(0.0, 0.5, 5, :max_size, 10),
- vct(0.5, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0,
- 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)]].each do |gen, v1|
- angle = +0.5
- v0 = make_vct!(20) do |i| gen.run((i.zero? ? 1.0 : 0.0), angle -= 0.5) end
- unless vequal(v0, v1)
- snd_display("6 %s (0.0, 0.5, 5): %s", gen.name, v0)
- end
+ vct(0.0, 0.0, 0.0, 0.5, 0.0, 0.125, 0.0, 0.031, 0.016, 0.004,
+ 1.0, 0.0, 0.25, 0.031, 0.0, 0.012, 0.002, 0.250, 0.125, 0.008)],
+ [make_all_pass(0.5, 0.0, 5, :max_size, 10),
+ vct(0.0, 0.0, 0.0, 0.5, 0.0, 0.125, 0.0, 0.031, 0.016, 0.004,
+ 1.0, 0.0, 0.25, 0.031, 0.0, 0.012, 0.002, 0.250, 0.125, 0.008)],
+ [make_notch(0.5, 5, :max_size, 10),
+ vct(0.5, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0,
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)],
+ [make_all_pass(0.0, 0.5, 5, :max_size, 10),
+ vct(0.5, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)]].each do |gen, v1|
+ angle = 0.5
+ v0 = Vct.new(20) do |i|
+ gen.run((i.zero? ? 1.0 : 0.0), angle -= 0.5)
+ end
+ snd_test_neq(v0, v1, "6 %s (0.0, 0.5, 5)", gen.name)
end
#
gen = make_filtered_comb(0.5, 5, :filter, make_one_zero(0.5, 0.5))
v0 = Vct.new(21) do |i| filtered_comb(gen, i.zero? ? 1.0 : 0.0) end
- unless vequal(v0,
- vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
- 0.25, 0.25, 0, 0, 0, 0.062, 0.125, 0.062, 0, 0, 0.016))
- snd_display("0 filtered_comb (0.5, 5): %s?", v0)
- end
- gen = make_filtered_comb(0.5, 5, :max_size, 20, :filter, make_one_zero(0.25, 0.75))
+ v1 = vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
+ 0.25, 0.25, 0, 0, 0, 0.062, 0.125, 0.062, 0, 0, 0.016)
+ snd_test_neq(v0, v1, "0 filtered_comb (0.5, 5)")
+ #
+ gen = make_filtered_comb(0.5, 5, :filter, make_one_zero(0.25, 0.75))
v0 = Vct.new(21) do |i| filtered_comb(gen, i.zero? ? 1.0 : 0.0) end
- unless vequal(v0,
- vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
- 0.125, 0.375, 0, 0, 0, 0.016, 0.094, 0.141, 0, 0, 0.002))
- snd_display("1 filtered_comb (0.5, 5): %s?", v0)
- end
- gen = make_filtered_comb(0.5, 5, :max_size, 20, :filter, make_one_zero(0.5, 0.5))
+ v1 = vct(0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
+ 0.125, 0.375, 0, 0, 0, 0.016, 0.094, 0.141, 0, 0, 0.002)
+ snd_test_neq(v0, v1, "1 filtered_comb (0.5, 5)")
+ #
+ gen = make_filtered_comb(0.5, 5, :max_size, 20,
+ :filter, make_one_zero(0.5, 0.5))
angle = -0.2
- v0 = Vct.new(20) do |i| filtered_comb(gen, i.zero? ? 1.0 : 0.0, angle += 0.2) end
- unless vequal(v0,
- vct(0, 0, 0, 0, 0, 0, 0.8, 0.4, 0, 0,
- 0, 0, 0, 0.08, 0.22, 0.3, 0.140, 0.04, 0, 0))
- snd_display("2 filtered_comb (0.5, 5): %s?", v0)
+ v0 = Vct.new(20) do |i|
+ filtered_comb(gen, i.zero? ? 1.0 : 0.0, angle += 0.2)
end
- gen = make_filtered_comb(0.5, 5, :max_size, 20, :filter, make_one_zero(0.5, 0.5))
+ v1 = vct(0, 0, 0, 0, 0, 0, 0.8, 0.4, 0, 0,
+ 0, 0, 0, 0.08, 0.22, 0.3, 0.140, 0.04, 0, 0)
+ snd_test_neq(v0, v1, "2 filtered_comb (0.5, 5)")
+ #
+ gen = make_filtered_comb(0.5, 5, :max_size, 20,
+ :filter, make_one_zero(0.5, 0.5))
angle = 0.2
- v0 = Vct.new(20) do |i| filtered_comb(gen, i.zero? ? 1.0 : 0.0, angle -= 0.2) end
- unless vequal(v0,
- vct(0, 0, 0, 0, 0.8, 0, 0, 0.08, 0.2, 0.04,
- 0.02, 0.068, 0.042, 0.019, 0.026, 0.015, 0.011, 0.009, 0.006, 0.004))
- snd_display("3 filtered_comb (0.5, 5): %s?", v0)
+ v0 = Vct.new(20) do |i|
+ filtered_comb(gen, i.zero? ? 1.0 : 0.0, angle -= 0.2)
end
- gen = make_filtered_comb(0.5, 5, :max_size, 20, :filter, make_one_zero(0.5, 0.5))
+ v1 = vct(0, 0, 0, 0, 0.8, 0, 0, 0.08, 0.2, 0.04,
+ 0.02, 0.068, 0.042, 0.019, 0.026, 0.015, 0.011, 0.009, 0.006, 0.004)
+ snd_test_neq(v0, v1, "3 filtered_comb (0.5, 5)")
+ #
+ gen = make_filtered_comb(0.5, 5, :max_size, 20,
+ :filter, make_one_zero(0.5, 0.5))
angle = -0.01
- v0 = Vct.new(20) do |i| filtered_comb(gen, i.zero? ? 1.0 : 0.0, angle += 0.01) end
- unless vequal(v0,
- vct(0, 0, 0, 0, 0, 0.95, 0.06, 0, 0, 0,
- 0.214, 0.251, 0.043, 0.002, 0, 0.045, 0.106, 0.081, 0.023, 0.003))
- snd_display("4 filtered_comb (0.5, 5): %s?", v0)
+ v0 = Vct.new(20) do |i|
+ filtered_comb(gen, i.zero? ? 1.0 : 0.0, angle += 0.01)
end
+ v1 = vct(0, 0, 0, 0, 0, 0.95, 0.06, 0, 0, 0,
+ 0.214, 0.251, 0.043, 0.002, 0, 0.045, 0.106, 0.081, 0.023, 0.003)
+ snd_test_neq(v0, v1, "4 filtered_comb (0.5, 5)")
end
def test_08_03
@@ -14232,8 +13593,7 @@ def test_08_03
gen1 = make_one_pole(0.4, 0.7)
print_and_check(gen, "one-pole", "one-pole a0: 0.400, b1: 0.700, y1: 0.000")
v0 = make_vct!(10) do one_pole(gen, 1.0) end
- v1 = make_vct(10)
- vct_map!(v1, lambda do | | one_pole?(gen1) ? one_pole(gen1, 1.0) : -1.0 end)
+ v1 = Vct.new(10) do |x| one_pole?(gen1) ? one_pole(gen1, 1.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map one_pole: %s %s?", v0, v1)
end
@@ -14271,8 +13631,7 @@ def test_08_03
gen1 = make_one_zero(0.4, 0.7)
print_and_check(gen, "one-zero", "one-zero a0: 0.400, a1: 0.700, x1: 0.000")
v0 = make_vct!(10) do one_zero(gen, 1.0) end
- v1 = make_vct(10)
- vct_map!(v1, lambda do | | one_zero?(gen1) ? one_zero(gen1, 1.0) : -1.0 end)
+ v1 = Vct.new(10) do |x| one_zero?(gen1) ? one_zero(gen1, 1.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map one_zero: %s %s?", v0, v1)
end
@@ -14305,8 +13664,7 @@ def test_08_03
"two-zero",
"two-zero a0: 0.400, a1: 0.700, a2: 0.300, x1: 0.000, x2: 0.000")
v0 = make_vct!(10) do two_zero(gen, 1.0) end
- v1 = make_vct(10)
- vct_map!(v1, lambda do | | two_zero?(gen1) ? two_zero(gen1, 1.0) : -1.0 end)
+ v1 = Vct.new(10) do |x| two_zero?(gen1) ? two_zero(gen1, 1.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map two_zero: %s %s?", v0, v1)
end
@@ -14372,8 +13730,7 @@ def test_08_03
"two-pole",
"two-pole a0: 0.400, b1: 0.700, b2: 0.300, y1: 0.000, y2: 0.000")
v0 = make_vct!(10) do two_pole(gen, 1.0) end
- v1 = make_vct(10)
- vct_map!(v1, lambda do | | two_pole?(gen1) ? two_pole(gen1, 1.0) : -1.0 end)
+ v1 = Vct.new(10) do |x| two_pole?(gen1) ? two_pole(gen1, 1.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map two_pole: %s %s?", v0, v1)
end
@@ -14439,18 +13796,6 @@ def test_08_03
if fneq(val = gen.call(1.0, 0.0), 0.336)
snd_display("a0->out 2pole (0.336): %s?", val)
end
- if (res = Snd.catch do make_two_pole(:b1, 3.0) end).first != :mus_error
- snd_display("make_two_pole bad b1: %s", res.inspect)
- end
- if (res = Snd.catch do make_two_pole(:b2, 2.0) end).first != :mus_error
- snd_display("make_two_pole bad b2: %s", res.inspect)
- end
- if (res = Snd.catch do make_two_pole(:b2, 2.0, :b1) end).first != :mus_error
- snd_display("make_two_pole bad keys: %s", res.inspect)
- end
- if (res = Snd.catch do make_two_pole(:b2, 2.0, 3.0) end).first != :mus_error
- snd_display("make_two_pole bad args: %s", res.inspect)
- end
#
gen = make_oscil(440.0)
gen1 = make_oscil(440.0)
@@ -14458,8 +13803,7 @@ def test_08_03
print_and_check(gen, "oscil", "oscil freq: 440.000Hz, phase: 0.000")
v0 = make_vct!(10) do oscil(gen, 0.0) end
v1 = make_vct!(10) do mus_apply(gen1, 0.0, 0.0) end
- v2 = make_vct(10)
- vct_map!(v2, lambda do | | oscil?(gen2) ? oscil(gen2, 0.0) : -1.0 end)
+ v2 = Vct.new(10) do |x| oscil?(gen2) ? oscil(gen2, 0.0) : -1.0 end
unless vequal(v0, v2)
snd_display("map oscil: %s %s?", v0, v2)
end
@@ -14620,8 +13964,9 @@ def test_08_04
"asymmetric-fm",
"asymmetric-fm freq: 440.000Hz, phase: 0.000, ratio: 1.000, r: 1.000")
v0 = make_vct!(10) do asymmetric_fm(gen, 0.0) end
- v1 = make_vct(10)
- vct_map!(v1, lambda do | | asymmetric_fm?(gen1) ? asymmetric_fm(gen1, 0.0) : -1.0 end)
+ v1 = Vct.new(10) do |x|
+ asymmetric_fm?(gen1) ? asymmetric_fm(gen1, 0.0) : -1.0
+ end
unless vequal(v0, v1)
snd_display("map asymmetric_fm: %s %s?", v0, v1)
end
@@ -14686,7 +14031,7 @@ def test_08_04
spectr1 = snd_spectrum(vct0, Rectangular_window, 2048, true)
spectr2 = snd_spectrum(vct1, Rectangular_window, 2048, true)
(1...512).each do |i|
- if fneq_err(spectr1[i], spectr2[i], 0.02) # okay
+ if fneq_err(spectr1[i], spectr2[i], 0.02)
snd_display("asymmetric_fm 2: %s: %s %s?", i, spectr1[i], spectr2[i])
break
end
@@ -14704,7 +14049,8 @@ def test_08_04
sr = 0.5 * (r + (1.0 / r))
th = a
mth = ratio * th
- val2 = exp(index * cr * (1.0 + cos(mth))) * cos(th + (index * sr * sin(mth)))
+ val2 = exp(index * cr * (1.0 + cos(mth))) *
+ cos(th + (index * sr * sin(mth)))
if fneq(val1, val2) or fneq(val1, val3)
snd_display("asyfm by hand: %s: 1 %s 2 %s 3 %s?", i, val1, val2, val3)
end
@@ -14785,14 +14131,14 @@ end
def test_08_05
gen = make_fir_filter(3, vct(0.5, 0.25, 0.125))
gen1 = make_fir_filter(3, vct(0.5, 0.25, 0.125))
- print_and_check(gen, "fir-filter", "fir-filter order: 3, xs: [0.500 0.250 0.125]")
+ print_and_check(gen, "fir-filter", "fir-filter order: 3, xs: [0.5 0.25 0.125]")
v0 = make_vct!(10) do |i| fir_filter(gen, i.zero? ? 1.0 : 0.0) end
v1 = make_vct(10)
inp = -1
- vct_map!(v1, lambda do | |
- inp += 1
- fir_filter?(gen1) ? fir_filter(gen1, inp.zero? ? 1.0 : 0.0) : -1.0
- end)
+ v1.map! do |x|
+ inp += 1
+ fir_filter?(gen1) ? fir_filter(gen1, inp.zero? ? 1.0 : 0.0) : -1.0
+ end
unless vequal(v0, v1)
snd_display("map fir_filter: %s %s?", v0, v1)
end
@@ -14831,12 +14177,16 @@ def test_08_05
test_gen_equal(f1, f2, f3)
coeffs = vct(0.1, 0.2, 0.3, 0.4, 0.4, 0.3, 0.2, 0.1)
flt = make_fir_filter(8, coeffs)
- es = make_array(8) do |i| make_env([0, coeffs[i], 1, 0], :length, 102) end
+ xcof = flt.xcoeffs
+ es = make_array(8) do |i|
+ make_env([0, coeffs[i], 1, 0], :length, 102)
+ end
es[5] = make_env([0, 0.4, 1, 1], :length, 102)
data = make_vct!(100) do |i|
val = fir_filter(flt, (i % 12).zero? ? 1.0 : 0.0)
- xcof = flt.xcoeffs
- es.each_with_index do |en, j| xcof[j] = env(en) end
+ es.each_with_index do |en, j|
+ xcof[j] = env(en)
+ end
val
end
if fneq(data[1], 0.2) or fneq(data[10], 0.0) or
@@ -14857,14 +14207,14 @@ def test_08_05
#
gen = make_iir_filter(3, vct(0.5, 0.25, 0.125))
gen1 = make_iir_filter(3, vct(0.5, 0.25, 0.125))
- print_and_check(gen, "iir-filter", "iir-filter order: 3, ys: [0.500 0.250 0.125]")
+ print_and_check(gen, "iir-filter", "iir-filter order: 3, ys: [0.5 0.25 0.125]")
v0 = make_vct!(10) do |i| iir_filter(gen, i.zero? ? 1.0 : 0.0) end
v1 = make_vct(10)
inp = -1
- vct_map!(v1, lambda do | |
- inp += 1
- iir_filter?(gen1) ? iir_filter(gen1, inp.zero? ? 1.0 : 0.0) : -1.0
- end)
+ v1.map! do |x|
+ inp += 1
+ iir_filter?(gen1) ? iir_filter(gen1, inp.zero? ? 1.0 : 0.0) : -1.0
+ end
unless vequal(v0, v1)
snd_display("map iir_filter: %s %s?", v0, v1)
end
@@ -14906,14 +14256,14 @@ def test_08_05
gen1 = make_filter(3, vct(0.5, 0.25, 0.125), vct(0.5, 0.25, 0.125))
print_and_check(gen,
"filter",
- "filter order: 3, xs: [0.500 0.250 0.125], ys: [0.500 0.250 0.125]")
+ "filter order: 3, xs: [0.5 0.25 0.125], ys: [0.5 0.25 0.125]")
v0 = make_vct!(10) do |i| filter(gen, i.zero? ? 1.0 : 0.0) end
v1 = make_vct(10)
inp = -1
- vct_map!(v1, lambda do | |
- inp += 1
- filter?(gen1) ? filter(gen1, inp.zero? ? 1.0 : 0.0) : -1.0
- end)
+ v1.map! do |x|
+ inp += 1
+ filter?(gen1) ? filter(gen1, inp.zero? ? 1.0 : 0.0) : -1.0
+ end
unless vequal(v0, v1)
snd_display("map filter: %s %s?", v0, v1)
end
@@ -14999,7 +14349,7 @@ def test_08_05
snd_display("cascade2canonical 3: %s?", res)
end
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next)
pad_channel(0, 10000)
freq_sweep(0.45)
sp = rough_spectrum(ind)
@@ -15062,10 +14412,7 @@ def test_08_05
end
undo_edit
#
- # analog filter (requires --with-gsl)
- if $with_test_gsl
- analog_filter_tests
- end
+ analog_filter_tests
#
v = spectrum2coeffs(10, vct(0, 1.0, 0, 0, 0, 0, 0, 0, 1.0, 0))
v1 = make_fir_coeffs(10, vct(0, 1.0, 0, 0, 0, 0, 0, 0, 1.0, 0))
@@ -15218,39 +14565,39 @@ def test_08_05
#
b = make_iir_band_stop_2(440.0, 500.0)
v = make_vct!(10) do |i| butter(b, i.zero? ? 1.0 : 0.0) end
- unless vequal(v, vct(0.992, -0.017, -0.016, -0.015, -0.014, -0.012, -0.011, -0.009, -0.007,-0.005))
- snd_display("iir bp-2 bandstop: %s?", v)
- end
+ v1 = vct(0.992, -0.017, -0.016, -0.015, -0.014,
+ -0.012, -0.011, -0.009, -0.007, -0.005)
+ snd_test_neq(v, v1, "iir bp-2 bandstop: %s?")
b = make_iir_band_stop_2(1000.0, 1500.0)
map_channel(lambda do |y| butter(b, y) end)
sp = rough_spectrum(ind)
if (not vequal(sp, vct(0.836, 0.525, 0.943, 0.979, 0.989, 0.994, 0.997, 0.997, 0.997, 1))) and
- (not vequal(sp, vct(0.838, 0.527, 0.945, 0.981, 0.991, 0.996, 0.999, 1, 0.999, 0.998)))
+ (not vequal(sp, vct(0.838, 0.527, 0.945, 0.981, 0.991, 0.996, 0.999, 1, 0.999, 0.998)))
snd_display("iir bs-2 rough spectrum: %s?", sp)
end
undo_edit
#
b = make_butter_hp(4, 440.0)
v = make_vct!(10) do |i| butter(b, i.zero? ? 1.0 : 0.0) end
- if (not vequal(v, vct(0.725, -0.466, -0.315, -0.196, -0.104,
- -0.036, 0.014, 0.047, 0.0685, 0.0775))) and
- (not vequal(v, vct(0.725, -0.466, -0.315, -0.196, -0.104,
- 0.035, 0.015, 0.049, 0.070, 0.081))) and
- (not vequal(v, vct(0.725, -0.466, -0.315, -0.196, -0.104,
- -0.035, 0.014, 0.049, 0.069, 0.079)))
- snd_display(snd_format_neq(v,
- vct(0.725, -0.466, -0.315, -0.196, -0.104,
- -0.036, 0.014, 0.047, 0.0685, 0.0775),
- "butter hp"))
+ v1 = vct(0.725, -0.466, -0.315, -0.196, -0.104,
+ -0.036, 0.014, 0.047, 0.0685, 0.0775)
+ v2 = vct(0.725, -0.466, -0.315, -0.196, -0.104,
+ -0.035, 0.015, 0.049, 0.070, 0.081)
+ v3 = vct(0.725, -0.466, -0.315, -0.196, -0.104,
+ -0.035, 0.014, 0.049, 0.069, 0.079)
+ if (not vequal(v, v1)) and (not vequal(v, v2)) and (not vequal(v, v3))
+ snd_test_neq(v, v1, "butter hp (1)")
+ snd_test_neq(v, v2, "butter hp (2)")
+ snd_test_neq(v, v3, "butter hp (3)")
end
b = make_butter_hp(4, 1000.0)
map_channel(lambda do |y| butter(b, y) end)
sp = rough_spectrum(ind)
if (not vequal(sp, vct(0.0505, 0.982, 1.0, 1.0, 0.998, 0.998, 0.999, 0.998, 0.996, 0.999))) and
- (not vequal(sp, vct(0.051, 0.982, 1.0, 1.0, 0.998, 0.998, 0.998, 0.999, 0.997, 0.995))) and
- (not vequal(sp, vct(0.051, 0.991, 1.0, 1.0, 0.998, 0.998, 0.999, 0.999, 0.997, 0.995))) and
- (not vequal(sp, vct(0.045, 0.970, 1.0, 1.0, 0.998, 0.998, 0.999, 0.999, 0.997, 0.995))) and
- (not vequal(sp, vct(0.052, 0.971, 1.0, 1.0, 0.998, 0.998, 0.999, 0.999, 0.997, 0.995)))
+ (not vequal(sp, vct(0.051, 0.982, 1.0, 1.0, 0.998, 0.998, 0.998, 0.999, 0.997, 0.995))) and
+ (not vequal(sp, vct(0.051, 0.991, 1.0, 1.0, 0.998, 0.998, 0.999, 0.999, 0.997, 0.995))) and
+ (not vequal(sp, vct(0.045, 0.970, 1.0, 1.0, 0.998, 0.998, 0.999, 0.999, 0.997, 0.995))) and
+ (not vequal(sp, vct(0.052, 0.971, 1.0, 1.0, 0.998, 0.998, 0.999, 0.999, 0.997, 0.995)))
snd_display("butter hp rough spectrum: %s?", sp)
end
undo_edit
@@ -15303,7 +14650,7 @@ def test_08_06
print_and_check(gen, "sawtooth-wave", "sawtooth-wave freq: 440.000Hz, phase: 3.142, amp: 1.000")
v0 = Vct.new(10) do sawtooth_wave(gen, 0.0) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | sawtooth_wave?(gen1) ? sawtooth_wave(gen1, 0.0) : -1.0 end)
+ v1.map! do |x| sawtooth_wave?(gen1) ? sawtooth_wave(gen1, 0.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map sawtooth_wave: %s %s?", v0, v1)
end
@@ -15353,10 +14700,10 @@ def test_08_06
v0 = make_vct!(10) do |i| square_wave(gen, 0.0) end
v1 = make_vct(10)
w = 1.0
- vct_map!(v1, lambda do | |
- w = gen1.width
- square_wave?(gen1) ? square_wave(gen1, 0.0) : -1.0
- end)
+ v1.map! do |x|
+ w = gen1.width
+ square_wave?(gen1) ? square_wave(gen1, 0.0) : -1.0
+ end
if fneq(w, 0.5)
snd_display("mus_width opt: %s?", w)
end
@@ -15414,7 +14761,7 @@ def test_08_06
print_and_check(gen, "triangle-wave", "triangle-wave freq: 440.000Hz, phase: 0.000, amp: 1.000")
v0 = make_vct!(10) do |i| triangle_wave(gen, 0.0) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | triangle_wave?(gen2) ? triangle_wave(gen2, 0.0) : -1.0 end)
+ v1.map! do |x| triangle_wave?(gen2) ? triangle_wave(gen2, 0.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map triangle_wave: %s %s?", v0, v1)
end
@@ -15462,7 +14809,7 @@ def test_08_06
print_and_check(gen, "pulse-train", "pulse-train freq: 440.000Hz, phase: 0.000, amp: 1.000")
v0 = make_vct!(10) do |i| pulse_train(gen, 0.0) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | pulse_train?(gen1) ? pulse_train(gen1, 0.0) : -1.0 end)
+ v1.map! do |x| pulse_train?(gen1) ? pulse_train(gen1, 0.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map pulse_train: %s %s?", v0, v1)
end
@@ -15504,194 +14851,96 @@ def test_08_06
end
set_mus_srate(old_srate)
#
- gen = make_ppolar(1200.0, 0.1)
- v0 = make_vct!(10) do |i| two_pole(gen, i.zero? ? 1.0 : 0.0) end
- unless two_pole?(gen)
- snd_display("%s not ppolar?", gen)
- end
- if gen.order != 2
- snd_display("ppolar order: %s?", gen.order)
- end
- if fneq(gen.a0, 1.0)
- snd_display("ppolar a0: %s?", gen.a0)
- end
- if fneq(gen.b1, -0.188)
- snd_display("ppolar b1: %s?", gen.b1)
- end
- if fneq(gen.b2, 0.01)
- snd_display("ppolar b2: %s?", gen.b2)
- end
- if fneq(v0[0], 1.0) or fneq(v0[1], 0.188)
- snd_display("ppolar output: %s?", v0)
- end
- if fneq(gen.frequency, 1200.0)
- snd_display("ppolar freq: %s?", gen.frequency)
- end
- if fneq(gen.scaler, 0.1)
- snd_display("ppolar scaler: %s?", gen.scaler)
- end
- #
- z1 = make_ppolar(600.0, 0.1)
- z2 = make_ppolar(600.0, 0.1)
- z3 = make_ppolar(1200.0, 0.1)
- two_pole(z1, 1.0)
- two_pole(z2, 1.0)
- two_pole(z3, 1.0)
- test_gen_equal(z1, z2, z3)
- z1 = make_ppolar(:radius, 0.1, :frequency, 600.0)
- z2 = make_ppolar(:radius, 0.1, :frequency, 600.0)
- z3 = make_ppolar(:radius, 0.2, :frequency, 1200.0)
- two_pole(z1, 1.0)
- two_pole(z2, 1.0)
- two_pole(z3, 1.0)
- test_gen_equal(z1, z2, z3)
- z1 = make_ppolar(600.0, 0.1)
- z2 = make_ppolar(600.0, 0.1)
- z3 = make_ppolar(600.0, 0.1)
- two_pole(z1, 1.0)
- two_pole(z2, 1.0)
- two_pole(z3, 0.5)
- test_gen_equal(z1, z2, z3)
- #
gen = make_two_pole(1200.0, 0.1)
unless two_pole?(gen)
- snd_display("%s not 2ppolar?", gen)
+ snd_display("%s not 2-polar?", gen)
end
if gen.order != 2
- snd_display("2ppolar order: %s?", gen.order)
+ snd_display("2-polar order: %s?", gen.order)
end
if fneq(gen.a0, 1.0)
- snd_display("2ppolar a0: %s?", gen.a0)
+ snd_display("2-polar a0: %s?", gen.a0)
end
if fneq(gen.b1, -0.188)
- snd_display("2ppolar b1: %s?", gen.b1)
+ snd_display("2-polar b1: %s?", gen.b1)
end
if fneq(gen.b2, 0.01)
- snd_display("2ppolar b2: %s?", gen.b2)
+ snd_display("2-polar b2: %s?", gen.b2)
end
if fneq(gen.frequency, 1200.0)
- snd_display("2ppolar freq: %s?", gen.frequency)
+ snd_display("2-polar freq: %s?", gen.frequency)
end
if fneq(gen.scaler, 0.1)
- snd_display("2ppolar scaler: %s?", gen.scaler)
+ snd_display("2-polar scaler: %s?", gen.scaler)
end
#
gen = make_two_pole(:frequency, 1200.0, :radius, 0.1)
unless two_pole?(gen)
- snd_display("%s not f2ppolar?", gen)
- end
- if gen.order != 2
- snd_display("f2ppolar order: %s?", gen.order)
- end
- if fneq(gen.a0, 1.0)
- snd_display("f2ppolar a0: %s?", gen.a0)
- end
- if fneq(gen.b1, -0.188)
- snd_display("f2ppolar b1: %s?", gen.b1)
- end
- if fneq(gen.b2, 0.01)
- snd_display("f2ppolar b2: %s?", gen.b2)
- end
- if fneq(gen.frequency, 1200.0)
- snd_display("f2ppolar freq: %s?", gen.frequency)
- end
- if fneq(gen.scaler, 0.1)
- snd_display("f2ppolar scaler: %s?", gen.scaler)
- end
- #
- gen = make_zpolar(:radius, 0.1, :frequency, 1200.0)
- v0 = make_vct!(10) do |i| two_zero(gen, i.zero? ? 1.0 : 0.0) end
- unless two_zero?(gen)
- snd_display("%s not zpolar?", gen)
+ snd_display("%s not f2-polar?", gen)
end
if gen.order != 2
- snd_display("zpolar order: %s?", gen.order)
+ snd_display("f2-polar order: %s?", gen.order)
end
if fneq(gen.a0, 1.0)
- snd_display("zpolar a0: %s?", gen.a0)
- end
- if fneq(gen.a1, -0.188)
- snd_display("zpolar a1: %s?", gen.a1)
+ snd_display("f2-polar a0: %s?", gen.a0)
end
- if fneq(gen.a2, 0.01)
- snd_display("zpolar a2: %s?", gen.a2)
+ if fneq(gen.b1, -0.188)
+ snd_display("f2-polar b1: %s?", gen.b1)
end
- if fneq(v0[0], 1.0) or fneq(v0[1], -0.188)
- snd_display("zpolar output: %s?", v0)
+ if fneq(gen.b2, 0.01)
+ snd_display("f2-polar b2: %s?", gen.b2)
end
if fneq(gen.frequency, 1200.0)
- snd_display("zpolar freq: %s?", gen.frequency)
+ snd_display("f2-polar freq: %s?", gen.frequency)
end
if fneq(gen.scaler, 0.1)
- snd_display("zpolar scaler: %s?", gen.scaler)
- end
- #
- z1 = make_zpolar(0.1, 600.0)
- z2 = make_zpolar(0.1, 600.0)
- z3 = make_zpolar(0.1, 1200.0)
- two_zero(z1, 1.0)
- two_zero(z2, 1.0)
- two_zero(z3, 1.0)
- test_gen_equal(z1, z2, z3)
- z1 = make_zpolar(:radius, 0.1, :frequency, 600.0)
- z2 = make_zpolar(:radius, 0.1, :frequency, 600.0)
- z3 = make_zpolar(:radius, 0.2, :frequency, 1200.0)
- two_zero(z1, 1.0)
- two_zero(z2, 1.0)
- two_zero(z3, 1.0)
- test_gen_equal(z1, z2, z3)
- z1 = make_zpolar(0.1, 600.0)
- z2 = make_zpolar(0.1, 600.0)
- z3 = make_zpolar(0.1, 600.0)
- two_zero(z1, 1.0)
- two_zero(z2, 1.0)
- two_zero(z3, 0.5)
- test_gen_equal(z1, z2, z3)
- #
+ snd_display("f2-polar scaler: %s?", gen.scaler)
+ end
+ #
gen = make_two_zero(1200.0, 0.1)
unless two_zero?(gen)
- snd_display("%s not 2zpolar?", gen)
+ snd_display("%s not 2-zp?", gen)
end
if gen.order != 2
- snd_display("2zpolar order: %s?", gen.order)
+ snd_display("2-zp order: %s?", gen.order)
end
if fneq(gen.a0, 1.0)
- snd_display("2zpolar a0: %s?", gen.a0)
+ snd_display("2-zp a0: %s?", gen.a0)
end
if fneq(gen.a1, -0.188)
- snd_display("2zpolar a1: %s?", gen.a1)
+ snd_display("2-zp a1: %s?", gen.a1)
end
if fneq(gen.a2, 0.01)
- snd_display("2zpolar a2: %s?", gen.a2)
+ snd_display("2-zp a2: %s?", gen.a2)
end
if fneq(gen.frequency, 1200.0)
- snd_display("2zpolar freq: %s?", gen.frequency)
+ snd_display("2-zp freq: %s?", gen.frequency)
end
if fneq(gen.scaler, 0.1)
- snd_display("2zpolar scaler: %s?", gen.scaler)
+ snd_display("2-zp scaler: %s?", gen.scaler)
end
#
gen = make_two_zero(:frequency, 1200.0, :radius, 0.1)
unless two_zero?(gen)
- snd_display("%s not f2zpolar?", gen)
+ snd_display("%s not f2-zp?", gen)
end
if gen.order != 2
- snd_display("f2zpolar order: %s?", gen.order)
+ snd_display("f2-zp order: %s?", gen.order)
end
if fneq(gen.a0, 1.0)
- snd_display("f2zpolar a0: %s?", gen.a0)
+ snd_display("f2-zp a0: %s?", gen.a0)
end
if fneq(gen.a1, -0.188)
- snd_display("f2zpolar a1: %s?", gen.a1)
+ snd_display("f2-zp a1: %s?", gen.a1)
end
if fneq(gen.a2, 0.01)
- snd_display("f2zpolar a2: %s?", gen.a2)
+ snd_display("f2-zp a2: %s?", gen.a2)
end
if fneq(gen.frequency, 1200.0)
- snd_display("f2zpolar freq: %s?", gen.frequency)
+ snd_display("f2-zp freq: %s?", gen.frequency)
end
if fneq(gen.scaler, 0.1)
- snd_display("f2zpolar scaler: %s?", gen.scaler)
+ snd_display("f2-zp scaler: %s?", gen.scaler)
end
#
gen = make_formant(1200.0, 0.9)
@@ -15700,10 +14949,10 @@ def test_08_06
v0 = make_vct!(10) do |i| formant(gen, i.zero? ? 1.0 : 0.0) end
v1 = make_vct(10)
inp = -1
- vct_map!(v1, lambda do | |
- inp += 1
- formant?(gen1) ? formant(gen1, inp.zero? ? 1.0 : 0.0) : -1.0
- end)
+ v1.map! do |x|
+ inp += 1
+ formant?(gen1) ? formant(gen1, inp.zero? ? 1.0 : 0.0) : -1.0
+ end
unless vequal(v0, v1)
snd_display("map formant: %s %s?", v0, v1)
end
@@ -15741,38 +14990,40 @@ def test_08_06
formant(f3, 1.0)
test_gen_equal(f1, f2, f3)
#
- fs = [make_formant(1000.0, 0.1), make_formant(100.0, 0.2)]
+ amps = vct(0.5, 0.25)
+ ff = [make_formant(1000.0, 0.1), make_formant(100.0, 0.2)]
+ fs = make_formant_bank(ff, amps)
f0 = make_formant(1000.0, 0.1)
f1 = make_formant(100.0, 0.2)
- amps = vct(0.5, 0.25)
v0 = make_vct!(10) do |i|
val = i.zero? ? 1.0 : 0.0
(0.5 * formant(f0, val)) + (0.25 * formant(f1, val))
end
- v1 = make_vct!(10) do |i| formant_bank(amps, fs, i.zero? ? 1.0 : 0.0) end
+ v1 = make_vct!(10) do |i|
+ val = i.zero? ? 1.0 : 0.0
+ formant_bank(fs, val)
+ end
unless vequal(v0, v1)
snd_display("formant_bank 1: %s %s?", v0, v1)
end
#
- fs = [make_formant(1000.0, 0.1), make_formant(100.0, 0.2)]
amps = vct(0.5, 0.25)
- v = make_vct!(5) do |i| formant_bank(amps, fs, i.zero? ? 1.0 : 0.0) end
+ ff = [make_formant(1000.0, 0.1), make_formant(100.0, 0.2)]
+ fs = make_formant_bank(ff, amps)
+ v = make_vct!(5) do |i|
+ val = i.zero? ? 1.0 : 0.0
+ formant_bank(fs, val)
+ end
unless vequal(v, vct(0.368, 0.095, -0.346, -0.091, -0.020))
snd_display("run formant_bank: %s?", v)
end
- fs = make_array(1)
- amps = make_vct(1, 1.0)
- fs[0] = make_oscil(440.0)
- if (res = Snd.catch do formant_bank(amps, fs, 1.0) end).first != :wrong_type_arg
- snd_display("formant_bank gets oscil: %s", res.inspect)
- end
#
ob = open_sound("oboe.snd")
poltergeist = lambda do |frek, amp, r, gain, frek_env, r_env|
# test courtesy of Anders Vinjar
filt = make_formant(frek, r)
- fe = make_env(:envelope, frek_env, :length, frames, :offset, frek)
- re = make_env(:envelope, r_env, :length, frames, :offset, r)
+ fe = make_env(:envelope, frek_env, :length, framples, :offset, frek)
+ re = make_env(:envelope, r_env, :length, framples, :offset, r)
lambda do |y|
outval = gain * formant(filt, amp * y)
mus_set_formant_radius_and_frequency(filt, env(re), env(fe))
@@ -15784,671 +15035,88 @@ def test_08_06
close_sound(ob)
end
-include Mixer_matrix
-
-def test_08_07
- gen = make_mixer(2, 0.5, 0.25, 0.125, 1.0)
- fr0 = make_frame(2, 1.0, 1.0)
- fr1 = make_frame(2, 0.0, 0.0)
- print_and_check(gen,
- "mixer",
- "mixer chans: 2, [
- 0.500 0.250
- 0.125 1.000
-]")
- ap = mus_array_print_length
- mx = make_mixer(8)
- set_mus_array_print_length(4)
- mx.length.times do |i|
- mx.length.times do |j|
- mixer_set!(mx, i, j, j + i * 8)
- end
- end
- print_and_check(mx,
- "mixer",
- "mixer chans: 8, [
- 0.000 1.000 2.000 3.000...
- 8.000 9.000 10.000 11.000...
- 16.000 17.000 18.000 19.000...
- 24.000 25.000 26.000 27.000...
-]")
- set_mus_array_print_length(12)
- print_and_check(mx,
- "mixer",
- "mixer chans: 8, [
- 0.000 1.000 2.000 3.000 4.000 5.000 6.000 7.000
- 8.000 9.000 10.000 11.000 12.000 13.000 14.000 15.000
- 16.000 17.000 18.000 19.000 20.000 21.000 22.000 23.000
- 24.000 25.000 26.000 27.000 28.000 29.000 30.000 31.000
- 32.000 33.000 34.000 35.000 36.000 37.000 38.000 39.000
- 40.000 41.000 42.000 43.000 44.000 45.000 46.000 47.000
- 48.000 49.000 50.000 51.000 52.000 53.000 54.000 55.000
- 56.000 57.000 58.000 59.000 60.000 61.000 62.000 63.000
-]")
- set_mus_array_print_length(ap)
- print_and_check(fr0, "frame", "frame[2]: [1.000 1.000]")
- unless frame?(fr0)
- snd_display("%s not a frame?", fr0)
- end
- unless mixer?(gen)
- snd_display("%s not a mixer?", gen)
- end
- if fr0.eql?(fr1)
- snd_display("frame=? %s %s?", fr0, fr1)
- end
- if fr0.channels != 2
- snd_display("frame channels: %s?", fr0.channels)
- end
- if fr1.length != 2
- snd_display("frame length: %s?", fr1.length)
- end
- if gen.channels != 2
- snd_display("mixer channels: %s?", gen.channels)
- end
- frame2frame(fr0, gen, fr1)
- if fneq(frame_ref(fr0, 0), 1.0) or
- fneq(frame_ref(fr1, 1), 1.25) or
- fneq(mixer_ref(gen, 0, 0), 0.5)
- snd_display("fr0: %s?", fr0)
- end
- frame_set!(fr1, 0, 1.0)
- fr3 = frame_add(fr0, fr1)
- fr4 = frame_multiply(fr0, fr1)
- fr5 = sample2frame(fr1, 0.5)
- if fneq(frame_ref(fr3, 0), 2.0) or
- fneq(frame_ref(fr4, 0), 1.0)
- snd_display("fr+*: %s %s?", fr3, fr4)
- end
- if fneq(res = frame_ref(fr5, 0), 0.5)
- snd_display("sample2frame: %s?", res)
- end
- sample2frame(fr1, 0.5, fr5)
- if fneq(res = frame_ref(fr5, 0), 0.5)
- snd_display("repeat sample2frame: %s?", res)
- end
- fr3 = make_frame(2)
- fr4 = make_frame(4)
- frame_set!(fr3, 0, 1.0)
- frame_set!(fr4, 0, 0.5)
- frame_set!(fr4, 2, 0.5)
- unless vequal(frame2list(res = frame_add(fr3, fr4)), [1.5, 0.0])
- snd_display("frame_add unequal chans: %s?", res)
- end
- fr3.reset
- if fneq(frame_ref(fr3, 0), 0.0)
- snd_display("reset frame: %s?", fr3)
- end
- fr3 = make_frame(2)
- fr4 = make_frame(4)
- frame_set!(fr3, 0, 1.0)
- frame_set!(fr4, 0, 0.5)
- frame_set!(fr4, 2, 1.0)
- unless vequal(frame2list(res = frame_multiply(fr3, fr4)), [0.5, 0.0])
- snd_display("frame_multiply unequal chans: %s?", res)
- end
- mx1 = make_mixer(2, 1.0, 0.0, 0.0, 1.0)
- mx2 = mixer_multiply(gen, mx1)
- fr4 = make_frame(2, 1.0, 1.0)
- fr5 = make_frame(2, 1.0, 1.0)
- if fneq(res = frame2sample(mx1, fr1), 1.0)
- snd_display("frame2sample: %s?", res)
- end
- if fneq(res = frame2sample(fr5, fr4), 2.0)
- snd_display("frame2sample: %s?", res)
- end
- unless (res = frame2list(fr1)).eql?([1.0, 1.25])
- snd_display("frame2list: %s?", res)
- end
- if fneq(mixer_ref(mx2, 0, 1), 0.25) or fneq(mixer_ref(mx2, 1, 0), 0.125)
- snd_display("mixer_multiply: %s?", mx2)
- end
- unless mx2.eql?(gen)
- snd_display("mixer=? %s %s?", gen, mx2)
- end
- if mx2.eql?(mx1)
- snd_display("mixer!=? %s %s?", mx1, mx2)
- end
- unless vct?(fr4.data)
- snd_display("mus_data frame: %s?", fr4.data)
- end
- # mus-data doesn't apply from scheme (ruby) level here
- # unless vct?(mx1.data)
- # snd_display("mus_data mixer: %s?", mx1.data)
- # end
- mixer_set!(mx2, 0, 0, 2.0)
- if fneq(mixer_ref(mx2, 0, 0), 2.0)
- snd_display("mixer_set!: %s?", mx2)
- end
- fr0 = sample2frame(mx2, 1.0)
- if fneq(frame_ref(fr0, 0), 2.0) or fneq(frame_ref(fr0, 1), 0.25)
- snd_display("sample2frame: %s?", fr0)
- end
- frout = make_frame(2)
- sample2frame(mx2, 1.0, frout)
- unless frout.eql?(fr0)
- snd_display("sample2frame via frout: %s %s?", frout, fr0)
- end
- fr1 = make_frame(2, 0.1, 0.2)
- val = frame_add(fr1, 1.0)
- if fneq(frame_ref(val, 0), 1.1) or fneq(frame_ref(val, 1), 1.2)
- snd_display("8 frame_offset: %s?", val)
- end
- val = frame_add(1.0, fr1)
- if fneq(frame_ref(val, 0), 1.1) or fneq(frame_ref(val, 1), 1.2)
- snd_display("8 frame_offset a: %s?", val)
- end
- val = frame_multiply(fr1, 2.0)
- if fneq(frame_ref(val, 0), 0.2) or fneq(frame_ref(val, 1), 0.4)
- snd_display("8 frame_scale: %s?", val)
- end
- val = frame_multiply(2.0, fr1)
- if fneq(frame_ref(val, 0), 0.2) or fneq(frame_ref(val, 1), 0.4)
- snd_display("8 frame_scale a: %s?", val)
- end
- val = frame_copy(fr1)
- if fneq(frame_ref(val, 0), 0.1) or fneq(frame_ref(val, 1), 0.2)
- snd_display("8 frame_copy: %s?", val)
- end
- #
- mx1 = make_mixer(2, 1, 2, 3, 4)
- mx2 = mixer_multiply(mx1, 2.0)
- unless mx2.eql?(make_mixer(2, 2, 4, 6, 8))
- snd_display("8 mixer_scale 2: %s?", mx2)
- end
- mx2 = mixer_multiply(2.0, mx1)
- unless mx2.eql?(make_mixer(2, 2, 4, 6, 8))
- snd_display("8 mixer_scale 2a: %s?", mx2)
- end
- mx2 = mixer_add(2.0, mx1)
- unless mx2.eql?(make_mixer(2, 3, 4, 5, 6))
- snd_display("8 mixer_scale 3: %s?", mx2)
- end
- mx2 = mixer_add(mx1, 2.0)
- unless mx2.eql?(make_mixer(2, 3, 4, 5, 6))
- snd_display("8 mixer_scale 3a: %s?", mx2)
- end
- #
- mx1 = make_scalar_mixer(2, 2.0)
- mx2 = make_mixer(2, 0.1, 0.2, 0.3, 0.4)
- nmx = mixer_add(mx1, mx2)
- if fneq(mixer_ref(mx1, 0, 0), 2.0) or
- fneq(mixer_ref(mx1, 0, 1), 0.0) or
- fneq(mixer_ref(mx1, 1, 0), 0.0) or
- fneq(mixer_ref(mx1, 1, 1), 2.0)
- snd_display("make_scalar_mixer 2: %s?", mx1)
- end
- if fneq(mixer_ref(mx2, 0, 0), 0.1) or
- fneq(mixer_ref(mx2, 0, 1), 0.2) or
- fneq(mixer_ref(mx2, 1, 0), 0.3) or
- fneq(mixer_ref(mx2, 1, 1), 0.4)
- snd_display("make_mixer 0.1, 0.2, 0.3, 0.4: %s?", mx2)
- end
- if fneq(mixer_ref(nmx, 0, 0), 2.1) or
- fneq(mixer_ref(nmx, 0, 1), 0.2) or
- fneq(mixer_ref(nmx, 1, 0), 0.3) or
- fneq(mixer_ref(nmx, 1, 1), 2.4)
- snd_display("mixer_add: %s?", nmx)
- end
- mx1 = mixer_multiply(mx1, 0.5)
- if fneq(mixer_ref(mx1, 0, 0), 1.0) or
- fneq(mixer_ref(mx1, 0, 1), 0.0) or
- fneq(mixer_ref(mx1, 1, 0), 0.0) or
- fneq(mixer_ref(mx1, 1, 1), 1.0)
- snd_display("mixer_multiply (identity): %s?", mx1)
- end
- mx1.reset
- if fneq(mixer_ref(mx1, 0, 0), 0.0)
- snd_display("reset mixer: %s?", mx1)
- end
- #
- if (res = Snd.catch do make_mixer(2, 0.0, 0.0, 0.0, 0.0, 0.0) end).first != :mus_error
- snd_display("make_mixer extra args: %s", res.inspect)
- end
- if (res = Snd.catch do
- fr1 = make_frame(2, 1.0, 0.0)
- frame2sample(make_oscil, fr1)
- end).first != :mus_error
- snd_display("frame2sample bad arg: %s", res.inspect)
- end
- hi = make_mixer(1, 1)
- if (res = Snd.catch do mixer_set!(hi, 1, 1, 1.0) end).first != :mus_error
- snd_display("mixer_set! 1 1 of 0: %s (%s)", res.inspect, hi)
- end
- hi = make_mixer(1)
- if (res = Snd.catch do mixer_set!(hi, 1, 0, 1.0) end).first != :mus_error
- snd_display("mixer_set! 1 0 of 0: %s (%s)", res.inspect, hi)
- end
- hi = make_mixer(1)
- if (res = Snd.catch do mixer_set!(hi, 0, 1, 1.0) end).first != :mus_error
- snd_display("mixer_set! 0 1 of 0: %s (%s)", res.inspect, hi)
- end
- hi = make_frame(1)
- if (res = Snd.catch do frame_set!(hi, 1, 1.0) end).first != :mus_error
- snd_display("frame_set! 1 of 0: %s (%s)", res.inspect, hi)
- end
- if (res = Snd.catch do make_frame(0) end).first != :out_of_range
- snd_display("make_frame 0: %s", res.inspect)
- end
- if (res = Snd.catch do make_mixer(0) end).first != :out_of_range
- snd_display("make_mixer 0: %s", res.inspect)
- end
- #
- fr1 = make_frame(1, 1)
- fr2 = make_frame(2, 1, 2)
- fr4 = make_frame(4, 1, 2, 3, 4)
- fr8 = make_frame(8, 1, 2, 3, 4, 5, 6, 7, 8)
- mx1 = make_mixer(1, 5)
- mx1id = make_mixer(1, 1)
- mx2 = make_mixer(2, 1, 2, 3, 4)
- mx2id = make_mixer(2, 1, 0, 0, 1)
- mx4 = make_mixer(4)
- mx4id = make_mixer(4)
- mx8 = make_mixer(8)
- mx8id = make_mixer(8)
- 4.times do |i|
- mixer_set!(mx4id, i, i, 1)
- mixer_set!(mx4, 0, i, 1)
- end
- 8.times do |i|
- mixer_set!(mx8id, i, i, 1)
- mixer_set!(mx8, i, 0, 1)
- end
- unless (res = frame2frame(fr1, mx1id)).eql?(make_frame(1, 1))
- snd_display("frame2frame 1 id: %s?", res)
- end
- unless (res = frame2frame(fr1, mx1)).eql?(make_frame(1, 5))
- snd_display("frame2frame 1: %s?", res)
- end
- unless (res = frame2frame(fr1, mx2id)).eql?(make_frame(2, 1, 0))
- snd_display("frame2frame 2 1 id: %s?", res)
- end
- unless (res = frame2frame(fr1, mx2)).eql?(make_frame(2, 1, 2))
- snd_display("frame2frame 2 1: %s?", res)
- end
- unless (res = frame2frame(fr1, mx4)).eql?(make_frame(4, 1, 1, 1, 1))
- snd_display("frame2frame 4 1: %s?", res)
- end
- unless (res = frame2frame(fr1, mx8)).eql?(make_frame(8, 1, 0, 0, 0, 0, 0, 0, 0))
- snd_display("frame2frame 8 1: %s?", res)
- end
- unless (res = frame2frame(fr2, mx1)).eql?(make_frame(1, 5))
- snd_display("frame2frame 1 2: %s?", res)
- end
- unless (res = frame2frame(fr2, mx2id)).eql?(make_frame(2, 1, 2))
- snd_display("frame2frame 2 id 2: %s?", res)
- end
- unless (res = frame2frame(fr2, mx2)).eql?(make_frame(2, 7, 10))
- snd_display("frame2frame 2 2: %s?", res)
- end
- unless (res = frame2frame(fr2, mx4id)).eql?(make_frame(4, 1, 2, 0, 0))
- snd_display("frame2frame 4 id 2: %s?", res)
- end
- unless (res = frame2frame(fr2, mx8id)).eql?(make_frame(8, 1, 2, 0, 0, 0, 0, 0, 0))
- snd_display("frame2frame 8 id 2: %s?", res)
- end
- unless (res = frame2frame(fr2, mx4)).eql?(make_frame(4, 1, 1, 1, 1))
- snd_display("frame2frame 4 2: %s?", res)
- end
- unless (res = frame2frame(fr2, mx8)).eql?(make_frame(8, 3, 0, 0, 0, 0, 0, 0, 0))
- snd_display("frame2frame 8 2: %s?", res)
- end
- unless (res = frame2frame(fr4, mx1)).eql?(make_frame(1, 5))
- snd_display("frame2frame 1 4: %s?", res)
- end
- unless (res = frame2frame(fr8, mx1)).eql?(make_frame(1, 5))
- snd_display("frame2frame 1 8: %s?", res)
- end
- unless (res = frame2frame(fr4, mx4)).eql?(make_frame(4, 1, 1, 1, 1))
- snd_display("frame2frame 4 4: %s?", res)
- end
- unless (res = frame2frame(fr4, mx8)).eql?(make_frame(8, 10, 0, 0, 0, 0, 0, 0, 0))
- snd_display("frame2frame 8 4: %s?", res)
- end
- #
- fr1 = make_frame(2)
- fr2 = make_frame(2)
- mx1 = make_mixer(2)
- mx2 = make_mixer(2)
- frame_set!(fr1, 0, 0.1)
- fradd = frame_add(fr1, fr1, fr2)
- unless fr2.eql?(fradd)
- snd_display("frame_add with res frame: %s %s?", fr2, fradd)
- end
- unless fr2.eql?(make_frame(2, 0.2, 0.0))
- snd_display("frame_add res: %s?", fr2)
- end
- fradd = frame_multiply(fr1, fr1, fr2)
- unless fr2.eql?(fradd)
- snd_display("frame_multiply with res frame: %s %s?", fr2, fradd)
- end
- if fneq(frame_ref(fr2, 0), 0.01) or fneq(frame_ref(fr2, 1), 0.0)
- snd_display("frame_multiply res: %s?", fr2)
- end
- mixer_set!(mx1, 0, 0, 0.1)
- mxadd = mixer_multiply(mx1, mx1, mx2)
- unless mx2.eql?(mxadd)
- snd_display("mixer_multiply with res mixer: %s %s?", mx2, mxadd)
- end
- if fneq(mixer_ref(mx2, 0, 0), 0.01)
- snd_display("mixer_multiply res: %s?", mx2)
- end
- #
- [1, 2, 4, 8].each do |chans|
- m1 = make_mixer(chans)
- if m1.channels != chans or m1.length != chans
- snd_display("mixer %s chans but: %s %s?", chans, m1.channels, m1.length)
- end
- chans.times do |i|
- chans.times do |j|
- mixer_set!(m1, i, j, i * 0.01 + j * 0.1)
- end
- end
- chans.times do |i|
- chans.times do |j|
- if fneq(res0 = mixer_ref(m1, i, j), res1 = i * 0.01 + j * 0.1)
- snd_display("mixer[%s %s] = %s (%s)?", i, j, res0, res1)
- end
- end
- end
- mempty = make_mixer(chans)
- midentity = make_mixer(chans)
- mpick = make_mixer(chans)
- chans.times do |i| mixer_set!(midentity, i, i, 1.0) end
- mixer_set!(mpick, chans - 1, chans - 1, 1.0)
- mzero = mixer_multiply(m1, mempty)
- msame = mixer_multiply(m1, midentity)
- mone = mixer_multiply(m1, mpick)
- chans.times do |i|
- chans.times do |j|
- if fneq(res = mixer_ref(mzero, i, j), 0.0)
- snd_display("mzero %s %s = %s?", i, j, res)
- end
- if fneq(res0 = mixer_ref(m1, i, j), res1 = mixer_ref(msame, i, j))
- snd_display("msame %s %s?", res0, res1)
- end
- if fneq(res = mixer_ref(mone, i, j), 0.0) and
- i != chans - 1 and
- j != chans - 1
- snd_display("mone %s %s = %s?", i, j, res)
- end
- end
- end
- end
- #
- mx = make_mixer(4, 4)
- if (res = Snd.catch do mx.length = 2 end).first != :mus_error
- snd_display("set_mixer_length: %s %s", res.inspect, mx.length)
- end
- #
- if fneq(res = mixer_determinant(make_mixer(2, 1, 2, 3, 4)), -2.0)
- snd_display("mixer_determinant -2: %s?", res)
- end
- if fneq(res = mixer_determinant(make_mixer(3, 1, 2, 3, 4, 5, 6, 7, 8, 9)), 0.0)
- snd_display("mixer_determinant 0: %s?", res)
- end
- if fneq(res = mixer_determinant(make_mixer(4, 1, 2, 3, 4, 8, 7, 6, 5, 1, 8, 2, 7, 3, 6, 4, 5)),
- -144.0)
- snd_display("mixer_determinant -144: %s?", res)
- end
- if fneq(res = mixer_determinant(make_mixer(5, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29,
- 31, 37, 41, 43, 47, 53, 59, 61, 67, 71,
- 73, 79, 83, 89, 97)), -4656.0)
- snd_display("mixer_determinant -4656: %s?", res)
- end
- if fneq(res = mixer_determinant(make_mixer(6, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37,
- 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89,
- 97, 101, 103, 107, 109, 113,
- 127, 131, 137, 139, 149, 151)), -14304.0)
- snd_display("mixer_determinant -14304: %s?", res)
- end
- unless mixer_equal?(res = mixer_transpose(make_mixer(2, 1, 2, 3, 4)),
- make_mixer(2, 1.0, 3.0, 2.0, 4.0))
- snd_display("mixer_transpose 1: %s?", res)
- end
- unless mixer_equal?(res = mixer_transpose(make_mixer(3, 1, 2, 3, 4, 5, 6, 7, 8, 9)),
- make_mixer(3, 1.0, 4.0, 7.0, 2.0, 5.0, 8.0, 3.0, 6.0, 9.0))
- snd_display("mixer_transpose 2: %s?", res)
- end
- unless mixer_equal?(res = mixer_multiply(make_mixer(2, 1, 0, 0, 1), make_mixer(2, 2, 0, 0, 2)),
- make_mixer(2, 2.0, 0.0, 0.0, 2.0))
- snd_display("mixer_multiply 1: %s?", res)
- end
- unless mixer_equal?(res = mixer_multiply(make_mixer(3, 2, 3, 5, 7, 11, 13, 19, 23, 29),
- make_mixer(3, 41, 43, 47, 53, 59, 61, 67, 71, 73)),
- make_mixer(3, 576, 618, 642, 1741, 1873, 1949, 3941, 4233, 4413))
- snd_display("mixer_multiply 2: %s?", res)
- end
- unless mixer_equal?(res = mixer_inverse(make_mixer(2, 1, 0, 0, 1)), make_mixer(2, 1, 0, 0, 1))
- snd_display("mixer_inverse 1: %s?", res)
- end
- unless mixer_equal?(res = mixer_inverse(make_mixer(2, 2, 3, 5, 8)), make_mixer(2, 8, -3, -5, 2))
- snd_display("mixer_inverse 2: %s?", res)
- end
- unless mixer_equal?(res = mixer_inverse(make_mixer(3, 2, 3, 5, 7, 11, 13, 17, 19, 23)),
- make_mixer(3, -0.077, -0.333, 0.205, -0.769, 0.5, -0.115,
- 0.692, -0.167, -0.013))
- snd_display("mixer_inverse 3: %s?", res)
- end
- unless mixer_equal?(res = mixer_inverse(make_mixer(4, 2, 3, 5, 7, 17, 19, 23, 29,
- 41, 43, 47, 53, 67, 71, 73, 97)),
- make_mixer(4, -7, 4.708, -1.042, -0.333, 9, -6.396, 1.396, 0.5,
- -1, 0.875, -0.042, -0.167, -1, 0.771, -0.271, 0))
- snd_display("mixer_inverse 4: %s?", res)
- end
- unless mixer_equal?(res = mixer_inverse(make_mixer(6, 2, 3, 5, 7, 11, 13,
- 17, -19, 23, 29, 31, 37,
- 41, 43, 47, 53, 59, 61,
- 67, 71, 73, 79, 83, 89,
- 97, 101, 103, 107, 109, 113,
- 127, 131, 137, 139, 149, 151)),
- make_mixer(6, -1.355, 0.02, -0, 1.09, -1.153, 0.333, 0.092,
- -0.025, 0, -0.042, 0.07, -0.029, 1.612,
- 0.006, -0.25, -1.205, 1.249, -0.264,
- 0.079, 0.002, 0.25, -0.314, 0.425, -0.241,
- -0.551, -0.011, 0.25, 0.2, -0.476, 0.188,
- 0.068, 0.009, -0.25, 0.306, -0.145, 0.028))
- snd_display("mixer_inverse 5: %s?", res)
- end
- unless mixer_equal?(res = mixer_multiply(make_mixer(2, 2, 3, 5, 8),
- mixer_inverse(make_mixer(2, 2, 3, 5, 8))),
- make_scalar_mixer(2, 1.0))
- snd_display("mixer_inverse 6: %s?", res)
- end
- unless mixer_equal?(res = mixer_multiply(make_mixer(3, 2, 3, 5, 7, 11, 13, 17, 19, 23),
- mixer_inverse(make_mixer(3, 2, 3, 5,
- 7, 11, 13,
- 17, 19, 23))),
- make_scalar_mixer(3, 1.0))
- snd_display("mixer_inverse 7: %s?", res)
- end
- unless mixer_diagonal?(make_scalar_mixer(2, 2.0))
- snd_display("mixer_diagonal 1")
- end
- unless mixer_diagonal?(make_mixer(3, 1, 0, 0, 0, 1, 0, 0, 0, 1))
- snd_display("mixer_diagonal 2")
- end
- if mixer_diagonal?(make_mixer(3, 1, 0, 0, 0, 1, 1, 0, 0, 1))
- snd_display("mixer_diagonal 3")
- end
- unless mixer_diagonal?(make_mixer(3, 0, 0, 0, 0, 1, 0, 0, 0, 1))
- snd_display("mixer_diagonal 4")
- end
- unless mixer_symmetric?(make_mixer(3, 0, 0, 0, 0, 1, 0, 0, 0, 1))
- snd_display("mixer_symmetric 1")
- end
- unless mixer_symmetric?(make_mixer(3, 1, 2, 0, 2, 1, 0, 0, 0, 1))
- snd_display("mixer_symmetric 2")
- end
- if mixer_symmetric?(make_mixer(3, 1, 2, 0, 2, 1, 0, 0, 2, 1))
- snd_display("mixer_symmetric 3")
- end
- unless mixer_equal?(make_scalar_mixer(2, 2.0), make_mixer(2, 2.0, 0, 0, 2.0))
- snd_display("mixer_equal? 1")
- end
- if mixer_equal?(make_mixer(2, 1, 2, 3, 4), make_mixer(3, 1, 2, 3, 4, 5, 6, 7, 8, 9))
- snd_display("mixer_equal? 2")
- end
- if mixer_equal?(make_mixer(2, 1, 2, 3, 4), make_mixer(2, 1, 2, 3, 5))
- snd_display("mixer_equal? 3")
- end
- unless mixer_equal?(res = mixer_poly(make_mixer(2, 1, 0, 0, 1), 1, 1), make_mixer(2, 2, 0, 0, 2))
- snd_display("mixer_poly 1: %s?", res)
- end
- unless mixer_equal?(res = mixer_poly(make_mixer(1, 1), 1), make_mixer(1, 1))
- snd_display("mixer_poly 2: %s?", res)
- end
- unless mixer_equal?(res = mixer_poly(make_mixer(2, 1, 0, 0, 1), 1, 0, 0),
- make_mixer(2, 1, 0, 0, 1))
- snd_display("mixer_poly 3: %s?", res)
- end
- unless mixer_equal?(res = mixer_poly(make_mixer(2, 1, 2, 4, 3), 1, 0, 0),
- make_mixer(2, 9, 8, 16, 17))
- snd_display("mixer_poly 4: %s?", res)
- end
- unless mixer_equal?(res = mixer_poly(make_mixer(2, 1, 2, 4, 3), 1, 1, 0),
- make_mixer(2, 10, 10, 20, 20))
- snd_display("mixer_poly 5: %s?", res)
- end
- unless mixer_equal?(res = mixer_poly(make_mixer(2, 1, 2, 4, 3), 1, 1, 2),
- make_mixer(2, 12, 10, 20, 22))
- snd_display("mixer_poly 6: %s?", res)
- end
- unless mixer_equal?(res = mixer_poly(make_mixer(2, 1, 2, 4, 3), 1, 0, 0, 0),
- make_mixer(2, 41, 42, 84, 83))
- snd_display("mixer_poly 7: %s?", res)
- end
- unless mixer_equal?(res = mixer_poly(make_mixer(2, 1, 2, 4, 3), 1, 0, 1, 0),
- make_mixer(2, 42, 44, 88, 86))
- snd_display("mixer_poly 8: %s?", res)
- end
-end
-
def test_08_08
- #
- # try random input to mixer_inverse
- #
- (2...20).each do |k|
- mx = make_random_mixer(k)
- imx = mixer_inverse(mixer_copy(mx))
- mmx = mixer_multiply(mx, imx)
- unless mixer_equal?(mmx, make_scalar_mixer(k, 1.0))
- snd_display("mixer_inverse %s: %s * %s -> %s?", k, mx, imx, mmx)
- end
- end
- unless frame_equal?(res = frame_reverse(make_frame(2, 0.5, 2.0)),
- make_frame(2, 2.0, 0.5))
- snd_display("frame_reverse 2: %s?", res)
- end
- unless frame_equal?(res = frame_reverse(make_frame(3, 0.5, 1.0, 2.0)),
- make_frame(3, 2.0, 1.0, 0.5))
- snd_display("frame_reverse 3: %s?", res)
- end
- #
- hi = make_mixer(3, 10, 5, 1, 1, 20, 5, 1, 3, 7)
- ho = make_mixer(3, 10, 5, 2, 1, 3, 2, 1, 3, 2)
- unless mixer_equal?(res = mixer_multiply(hi, ho),
- make_mixer(3, 106, 68, 32, 35, 80, 52, 20, 35, 22))
- snd_display("mixer_multiply 3x3 1: %s?", res)
- end
- unless mixer_equal?(res = mixer_multiply(hi, mixer_transpose(ho)),
- make_mixer(3, 127, 27, 27, 120, 71, 71, 39, 24, 24))
- snd_display("mixer_multiply 3x3 2: %s?", res)
- end
- unless mixer_equal?(res = mixer_multiply(mixer_transpose(hi), mixer_transpose(ho)),
- make_mixer(3, 107, 15, 15, 156, 71, 71, 49, 30, 30))
- snd_display("mixer_multiply 3x3 3: %s?", res)
- end
- unless frame_equal?(res = mixer_solve(make_mixer(2, 0.001, 1, 1, 2), make_frame(2, 1, 3)),
- make_frame(2, 1.002, 0.999))
- snd_display("mixer_solve G1: %s?", res)
- end
- unless frame_equal?(res = mixer_solve(make_mixer(2, 0.0001, 1, 1, 1), make_frame(2, 1, 3)),
- make_frame(2, 2, 1))
- snd_display("mixer_solve G2: %s?", res)
- end
- unless frame_equal?(res = mixer_solve(make_mixer(2, 0.986, 0.579, 0.409, 0.237),
- make_frame(2, 0.235, 0.107)),
- make_frame(2, 2, -3))
- snd_display("mixer_solve G3: %s?", res)
- end
- # G4, G5 (invert_matrix) skipped
- unless frame_equal?(res = mixer_solve(make_mixer(3, 1, 4, 7, 2, 5, 8, 3, 6, 10),
- make_frame(3, 1, 1, 1)),
- make_frame(3, -0.333, 0.333, 0))
- snd_display("mixer_solve G6: %s?", res)
- end
- unless frame_equal?(res = mixer_solve(make_mixer(2, 1, 0, 0, 1.0e-6), make_frame(2, 1, 1.0e-6)),
- make_frame(2, 1, 1))
- snd_display("mixer_solve G7: %s?", res)
- end
- # G8, G9 (invert_matrix) skipped
- unless frame_equal?(res = mixer_solve(make_mixer(2, 10, 100000, 1, 1), make_frame(2, 100000, 2)),
- make_frame(2, 1, 1))
- snd_display("mixer_solve G10: %s?", res)
- end
- #
- [[:Hamming_window, 0.0, vct(0.080, 0.115, 0.215, 0.364, 0.540, 0.716, 0.865, 1.000,
- 1.000, 0.865, 0.716, 0.540, 0.364, 0.215, 0.115, 0.080)],
- [:Rectangular_window, 0.0, vct(1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000,
- 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000)],
- [:Hann_window, 0.0, vct(0.000, 0.038, 0.146, 0.309, 0.500, 0.691, 0.854, 1.000,
- 1.000, 0.854, 0.691, 0.500, 0.309, 0.146, 0.038, 0.000)],
- [:Welch_window, 0.0, vct(0.000, 0.234, 0.438, 0.609, 0.750, 0.859, 0.938, 1.000,
- 1.000, 0.938, 0.859, 0.750, 0.609, 0.438, 0.234, 0.000)],
- [:Connes_window, 0.0, vct(0.000, 0.055, 0.191, 0.371, 0.562, 0.739, 0.879, 1.000,
- 1.000, 0.879, 0.739, 0.562, 0.371, 0.191, 0.055, 0.000)],
- [:Parzen_window, 0.0, vct(0.000, 0.125, 0.250, 0.375, 0.500, 0.625, 0.750, 1.000,
- 1.000, 0.750, 0.625, 0.500, 0.375, 0.250, 0.125, 0.000)],
- [:Bartlett_window, 0.0, vct(0.000, 0.125, 0.250, 0.375, 0.500, 0.625, 0.750, 1.000,
- 1.000, 0.750, 0.625, 0.500, 0.375, 0.250, 0.125, 0.000)],
- [:Blackman2_window, 0.0, vct(0.005, 0.020, 0.071, 0.177, 0.344, 0.558, 0.775, 1.000,
- 1.000, 0.775, 0.558, 0.344, 0.177, 0.071, 0.020, 0.005)],
- [:Blackman3_window, 0.0, vct(0.000, 0.003, 0.022, 0.083, 0.217, 0.435, 0.696, 1.000,
- 1.000, 0.696, 0.435, 0.217, 0.083, 0.022, 0.003, 0.000)],
- [:Blackman4_window, 0.0, vct(0.002, 0.002, 0.003, 0.017, 0.084, 0.263, 0.562, 1.000,
- 1.000, 0.562, 0.263, 0.084, 0.017, 0.003, 0.002, 0.002)],
- [:Blackman5_window, 0.0, vct(0.000, 0.000, 0.003, 0.022, 0.097, 0.280, 0.574, 1.000,
- 1.000, 0.574, 0.280, 0.097, 0.022, 0.003, 0.000, 0.000)],
- [:Blackman6_window, 0.0, vct(0.000, 0.000, 0.001, 0.011, 0.064, 0.223, 0.520, 1.000,
- 1.000, 0.520, 0.223, 0.064, 0.011, 0.001, 0.000, 0.000)],
- [:Blackman7_window, 0.0, vct(0.000, 0.000, 0.000, 0.006, 0.042, 0.177, 0.471, 1.000,
- 1.000, 0.471, 0.177, 0.042, 0.006, 0.000, 0.000, 0.000)],
- [:Blackman8_window, 0.0, vct(0.000, 0.000, 0.000, 0.003, 0.028, 0.141, 0.426, 1.000,
- 1.000, 0.426, 0.141, 0.028, 0.003, 0.000, 0.000, 0.000)],
- [:Blackman9_window, 0.0, vct(0.000, 0.000, 0.000, 0.001, 0.018, 0.112, 0.385, 1.000,
- 1.000, 0.385, 0.112, 0.018, 0.001, 0.000, 0.000, 0.000)],
- [:Blackman10_window, 0.0, vct(0.000, 0.000, 0.000, 0.001, 0.012, 0.089, 0.349, 1.000,
- 1.000, 0.349, 0.089, 0.012, 0.001, 0.000, 0.000, 0.000)],
- [:Rv2_window, 0.0, vct(0.000, 0.001, 0.021, 0.095, 0.250, 0.478, 0.729, 1.000,
- 1.000, 0.729, 0.478, 0.250, 0.095, 0.021, 0.001, 0.000)],
- [:Rv3_window, 0.0, vct(0.000, 0.000, 0.003, 0.029, 0.125, 0.330, 0.622, 1.000,
- 1.000, 0.622, 0.330, 0.125, 0.029, 0.003, 0.000, 0.000)],
- [:Rv4_window, 0.0, vct(0.000, 0.000, 0.000, 0.009, 0.062, 0.228, 0.531, 1.000,
- 1.000, 0.531, 0.228, 0.062, 0.009, 0.000, 0.000, 0.000)],
- [:Exponential_window, 0.0, vct(0.000, 0.087, 0.181, 0.283, 0.394, 0.515, 0.646, 0.944,
- 0.944, 0.646, 0.515, 0.394, 0.283, 0.181, 0.087, 0.000)],
- [:Riemann_window, 0.0, vct(0.000, 0.139, 0.300, 0.471, 0.637, 0.784, 0.900, 1.000,
- 1.000, 0.900, 0.784, 0.637, 0.471, 0.300, 0.139, 0.000)],
- [:Kaiser_window, 2.5, vct(0.304, 0.426, 0.550, 0.670, 0.779, 0.871, 0.941, 1.000,
- 1.000, 0.941, 0.871, 0.779, 0.670, 0.550, 0.426, 0.304)],
- [:Cauchy_window, 2.5, vct(0.138, 0.173, 0.221, 0.291, 0.390, 0.532, 0.719, 1.000,
- 1.000, 0.719, 0.532, 0.390, 0.291, 0.221, 0.173, 0.138)],
- [:Poisson_window, 2.5, vct(0.082, 0.112, 0.153, 0.210, 0.287, 0.392, 0.535, 1.000,
- 1.000, 0.535, 0.392, 0.287, 0.210, 0.153, 0.112, 0.082)],
- [:Gaussian_window, 1.0, vct(0.607, 0.682, 0.755, 0.823, 0.882, 0.932, 0.969, 1.000,
- 1.000, 0.969, 0.932, 0.882, 0.823, 0.755, 0.682, 0.607)],
- [:Tukey_window, 0.0, vct(0.000, 0.038, 0.146, 0.309, 0.500, 0.691, 0.854, 1.000,
- 1.000, 0.854, 0.691, 0.500, 0.309, 0.146, 0.038, 0.000)],
- [:Hann_poisson_window, 0.0, vct(0.000, 0.038, 0.146, 0.309, 0.500, 0.691, 0.854, 1.000,
- 1.000, 0.854, 0.691, 0.500, 0.309, 0.146, 0.038, 0.000)],
- [:Samaraki_window, 0.0, vct(1.000, 0.531, 0.559, 0.583, 0.604, 0.620, 0.631, 0.638,
- 0.640, 0.638, 0.631, 0.620, 0.604, 0.583, 0.559, 0.531)],
- [:Ultraspherical_window, 0.0, vct(1.000, 0.033, 0.034, 0.035, 0.036, 0.036, 0.037, 0.037,
- 0.037, 0.037, 0.037, 0.036, 0.036, 0.035, 0.034, 0.033)],
- [:Dolph_chebyshev_window, 0.0, vct(1.000, 0.033, 0.034, 0.035, 0.036, 0.036, 0.037, 0.037,
- 0.037, 0.037, 0.037, 0.036, 0.036, 0.035, 0.034, 0.033)],
- [:Dolph_chebyshev_window, 1.0, vct(1.000, 0.274, 0.334, 0.393, 0.446, 0.491, 0.525, 0.546,
- 0.553, 0.546, 0.525, 0.491, 0.446, 0.393, 0.334, 0.274)]
+ [[:Hamming_window, 0.0,
+ vct(0.080, 0.115, 0.215, 0.364, 0.540, 0.716, 0.865, 1.000,
+ 1.000, 0.865, 0.716, 0.540, 0.364, 0.215, 0.115, 0.080)],
+ [:Rectangular_window, 0.0,
+ vct(1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000,
+ 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000)],
+ [:Hann_window, 0.0,
+ vct(0.000, 0.038, 0.146, 0.309, 0.500, 0.691, 0.854, 1.000,
+ 1.000, 0.854, 0.691, 0.500, 0.309, 0.146, 0.038, 0.000)],
+ [:Welch_window, 0.0,
+ vct(0.000, 0.234, 0.438, 0.609, 0.750, 0.859, 0.938, 1.000,
+ 1.000, 0.938, 0.859, 0.750, 0.609, 0.438, 0.234, 0.000)],
+ [:Connes_window, 0.0,
+ vct(0.000, 0.055, 0.191, 0.371, 0.562, 0.739, 0.879, 1.000,
+ 1.000, 0.879, 0.739, 0.562, 0.371, 0.191, 0.055, 0.000)],
+ [:Parzen_window, 0.0,
+ vct(0.000, 0.125, 0.250, 0.375, 0.500, 0.625, 0.750, 1.000,
+ 1.000, 0.750, 0.625, 0.500, 0.375, 0.250, 0.125, 0.000)],
+ [:Bartlett_window, 0.0,
+ vct(0.000, 0.125, 0.250, 0.375, 0.500, 0.625, 0.750, 1.000,
+ 1.000, 0.750, 0.625, 0.500, 0.375, 0.250, 0.125, 0.000)],
+ [:Blackman2_window, 0.0,
+ vct(0.005, 0.020, 0.071, 0.177, 0.344, 0.558, 0.775, 1.000,
+ 1.000, 0.775, 0.558, 0.344, 0.177, 0.071, 0.020, 0.005)],
+ [:Blackman3_window, 0.0,
+ vct(0.000, 0.003, 0.022, 0.083, 0.217, 0.435, 0.696, 1.000,
+ 1.000, 0.696, 0.435, 0.217, 0.083, 0.022, 0.003, 0.000)],
+ [:Blackman4_window, 0.0,
+ vct(0.002, 0.002, 0.003, 0.017, 0.084, 0.263, 0.562, 1.000,
+ 1.000, 0.562, 0.263, 0.084, 0.017, 0.003, 0.002, 0.002)],
+ [:Blackman5_window, 0.0,
+ vct(0.000, 0.000, 0.003, 0.022, 0.097, 0.280, 0.574, 1.000,
+ 1.000, 0.574, 0.280, 0.097, 0.022, 0.003, 0.000, 0.000)],
+ [:Blackman6_window, 0.0,
+ vct(0.000, 0.000, 0.001, 0.011, 0.064, 0.223, 0.520, 1.000,
+ 1.000, 0.520, 0.223, 0.064, 0.011, 0.001, 0.000, 0.000)],
+ [:Blackman7_window, 0.0,
+ vct(0.000, 0.000, 0.000, 0.006, 0.042, 0.177, 0.471, 1.000,
+ 1.000, 0.471, 0.177, 0.042, 0.006, 0.000, 0.000, 0.000)],
+ [:Blackman8_window, 0.0,
+ vct(0.000, 0.000, 0.000, 0.003, 0.028, 0.141, 0.426, 1.000,
+ 1.000, 0.426, 0.141, 0.028, 0.003, 0.000, 0.000, 0.000)],
+ [:Blackman9_window, 0.0,
+ vct(0.000, 0.000, 0.000, 0.001, 0.018, 0.112, 0.385, 1.000,
+ 1.000, 0.385, 0.112, 0.018, 0.001, 0.000, 0.000, 0.000)],
+ [:Blackman10_window, 0.0,
+ vct(0.000, 0.000, 0.000, 0.001, 0.012, 0.089, 0.349, 1.000,
+ 1.000, 0.349, 0.089, 0.012, 0.001, 0.000, 0.000, 0.000)],
+ [:Rv2_window, 0.0,
+ vct(0.000, 0.001, 0.021, 0.095, 0.250, 0.478, 0.729, 1.000,
+ 1.000, 0.729, 0.478, 0.250, 0.095, 0.021, 0.001, 0.000)],
+ [:Rv3_window, 0.0,
+ vct(0.000, 0.000, 0.003, 0.029, 0.125, 0.330, 0.622, 1.000,
+ 1.000, 0.622, 0.330, 0.125, 0.029, 0.003, 0.000, 0.000)],
+ [:Rv4_window, 0.0,
+ vct(0.000, 0.000, 0.000, 0.009, 0.062, 0.228, 0.531, 1.000,
+ 1.000, 0.531, 0.228, 0.062, 0.009, 0.000, 0.000, 0.000)],
+ [:Exponential_window, 0.0,
+ vct(0.000, 0.087, 0.181, 0.283, 0.394, 0.515, 0.646, 0.944,
+ 0.944, 0.646, 0.515, 0.394, 0.283, 0.181, 0.087, 0.000)],
+ [:Riemann_window, 0.0,
+ vct(0.000, 0.139, 0.300, 0.471, 0.637, 0.784, 0.900, 1.000,
+ 1.000, 0.900, 0.784, 0.637, 0.471, 0.300, 0.139, 0.000)],
+ [:Kaiser_window, 2.5,
+ vct(0.304, 0.426, 0.550, 0.670, 0.779, 0.871, 0.941, 1.000,
+ 1.000, 0.941, 0.871, 0.779, 0.670, 0.550, 0.426, 0.304)],
+ [:Cauchy_window, 2.5,
+ vct(0.138, 0.173, 0.221, 0.291, 0.390, 0.532, 0.719, 1.000,
+ 1.000, 0.719, 0.532, 0.390, 0.291, 0.221, 0.173, 0.138)],
+ [:Poisson_window, 2.5,
+ vct(0.082, 0.112, 0.153, 0.210, 0.287, 0.392, 0.535, 1.000,
+ 1.000, 0.535, 0.392, 0.287, 0.210, 0.153, 0.112, 0.082)],
+ [:Gaussian_window, 1.0,
+ vct(0.607, 0.682, 0.755, 0.823, 0.882, 0.932, 0.969, 1.000,
+ 1.000, 0.969, 0.932, 0.882, 0.823, 0.755, 0.682, 0.607)],
+ [:Tukey_window, 0.0,
+ vct(0.000, 0.038, 0.146, 0.309, 0.500, 0.691, 0.854, 1.000,
+ 1.000, 0.854, 0.691, 0.500, 0.309, 0.146, 0.038, 0.000)],
+ [:Hann_poisson_window, 0.0,
+ vct(0.000, 0.038, 0.146, 0.309, 0.500, 0.691, 0.854, 1.000,
+ 1.000, 0.854, 0.691, 0.500, 0.309, 0.146, 0.038, 0.000)],
].each do |win, beta, vals|
Snd.catch do
res = make_fft_window(Module.const_get(win), 16, beta)
@@ -16457,35 +15125,57 @@ def test_08_08
end
end
end
- [[:Ultraspherical_window, 0.0, 0.0, :Dolph_chebyshev_window, 0.0, 0.0],
- [:Ultraspherical_window, 0.0, 1.0, :Samaraki_window, 0.0, 0.0],
- [:Ultraspherical_window, 0.5, 0.0, :Dolph_chebyshev_window, 0.5, 0.0],
- [:Ultraspherical_window, 0.5, 1.0, :Samaraki_window, 0.5, 0.0]
- ].each do |win1, beta1, alpha1, win2, beta2, alpha2|
- Snd.catch do
- val1 = make_fft_window(Module.const_get(win1), 16, beta1, alpha1)
- val2 = make_fft_window(Module.const_get(win2), 16, beta2, alpha2)
- unless vequal(val1, vals2)
- snd_display("%s/%s %s: %s %s?", win1, win2, beta1, val1, val2)
+ if $with_test_gsl
+ [[:Samaraki_window, 0.0,
+ vct(1.000, 0.531, 0.559, 0.583, 0.604, 0.620, 0.631, 0.638,
+ 0.640, 0.638, 0.631, 0.620, 0.604, 0.583, 0.559, 0.531)],
+ [:Ultraspherical_window, 0.0,
+ vct(1.000, 0.033, 0.034, 0.035, 0.036, 0.036, 0.037, 0.037,
+ 0.037, 0.037, 0.037, 0.036, 0.036, 0.035, 0.034, 0.033)],
+ [:Dolph_chebyshev_window, 0.0,
+ vct(1.000, 0.033, 0.034, 0.035, 0.036, 0.036, 0.037, 0.037,
+ 0.037, 0.037, 0.037, 0.036, 0.036, 0.035, 0.034, 0.033)],
+ [:Dolph_chebyshev_window, 1.0,
+ vct(1.000, 0.274, 0.334, 0.393, 0.446, 0.491, 0.525, 0.546,
+ 0.553, 0.546, 0.525, 0.491, 0.446, 0.393, 0.334, 0.274)]
+ ].each do |win, beta, vals|
+ Snd.catch do
+ res = make_fft_window(Module.const_get(win), 16, beta)
+ unless vequal(res, vals)
+ snd_display("%s: %s?", win, res)
+ end
end
end
- end
- val1 = dolph(16, 1.0)
- val2 = make_fft_window(Dolph_chebyshev_window, 16, 1.0)
- unless vequal(val1, val2)
- snd_display("dolph/dolph 1: %s %s?", val1, val2)
- end
- val1 = dolph_1(16, 1.0).to_vct
- val2 = make_fft_window(Dolph_chebyshev_window, 16, 1.0)
- unless vequal(val1, val2)
- snd_display("dolph_1/dolph 1: %s %s?", val1, val2)
- end
+ [[:Ultraspherical_window, 0.0, 0.0, :Dolph_chebyshev_window, 0.0, 0.0],
+ [:Ultraspherical_window, 0.0, 1.0, :Samaraki_window, 0.0, 0.0],
+ [:Ultraspherical_window, 0.5, 0.0, :Dolph_chebyshev_window, 0.5, 0.0],
+ [:Ultraspherical_window, 0.5, 1.0, :Samaraki_window, 0.5, 0.0]
+ ].each do |win1, beta1, alpha1, win2, beta2, alpha2|
+ Snd.catch do
+ val1 = make_fft_window(Module.const_get(win1), 16, beta1, alpha1)
+ val2 = make_fft_window(Module.const_get(win2), 16, beta2, alpha2)
+ unless vequal(val1, vals2)
+ snd_display("%s/%s %s: %s %s?", win1, win2, beta1, val1, val2)
+ end
+ end
+ end
+ val1 = dolph(16, 1.0)
+ val2 = make_fft_window(Dolph_chebyshev_window, 16, 1.0)
+ unless vequal(val1, val2)
+ snd_display("dolph/dolph 1: %s %s?", val1, val2)
+ end
+ val1 = dolph_1(16, 1.0).to_vct
+ val2 = make_fft_window(Dolph_chebyshev_window, 16, 1.0)
+ unless vequal(val1, val2)
+ snd_display("dolph_1/dolph 1: %s %s?", val1, val2)
+ end
+ end # $with_test_gsl
#
gen = make_env(:envelope, [0, 0, 1, 1, 2, 0], :scaler, 0.5, :length, 11)
gen1 = make_env(:envelope, [0, 0, 1, 1, 2, 0], :scaler, 0.5, :length, 11)
print_and_check(gen,
"env",
- "env linear, pass: 0 (dur: 11), index: 0, scaler: 0.5000, offset: 0.0000, data: [0.000 0.000 1.000 1.000 2.000 0.000]")
+ "env linear, pass: 0 (dur: 11), index: 0, scaler: 0.5000, offset: 0.0000, data: [0 0 1 1 2 0]")
unless env?(gen)
snd_display("%s not env?", gen)
end
@@ -16501,10 +15191,10 @@ def test_08_08
v0 = make_vct!(10) do env(gen) end
v1 = make_vct(10)
off = 123.0
- vct_map!(v1, lambda do | |
- off = gen1.offset
- env?(gen1) ? env(gen1) : -1.0
- end)
+ v1.map! do |x|
+ off = gen1.offset
+ env?(gen1) ? env(gen1) : -1.0
+ end
if fneq(off, 0.0)
snd_display("mus_offset opt: %s?", off)
end
@@ -16658,7 +15348,7 @@ def test_08_08
if fneq(res = env_interp(0.45, e), 0.6387)
snd_display("env_interp 0011 2 at 0.45: %s?", res)
end
- e = make_env([0, 0, 1, 1], :offset, 2.0)
+ e = make_env([0, 0, 1, 1], :length, 10, :offset, 2.0)
e.offset = 3.0
if fneq(e.offset, 3.0)
snd_display("set_mus_offset env: %s?", e.offset)
@@ -16793,7 +15483,6 @@ end
def test_08_09
gen = make_table_lookup(440.0, :wave, partials2wave([1, 1, 2, 1]))
gen1 = make_table_lookup(440.0, :wave, partials2wave([1, 1, 2, 1], make_vct(512)))
- gen2 = partials2wave([1, 1, 2, 1, 3, 1, 4, 1], false, true)
gen3 = make_table_lookup
gen4 = make_table_lookup(440.0, :wave, partials2wave([1, 1, 2, 1]))
print_and_check(gen,
@@ -16808,12 +15497,12 @@ def test_08_09
v0 = make_vct!(10) do table_lookup(gen, 0.0) end
v1 = make_vct!(10) do mus_apply(gen1, 0.0) end
v2 = make_vct(10)
- vct_map!(v2, lambda do | | table_lookup?(gen4) ? table_lookup(gen4) : -1.0 end)
+ v2.map! do |x| table_lookup?(gen4) ? table_lookup(gen4) : -1.0 end
unless vequal(v0, v2)
snd_display("map table_lookup: %s %s?", v0, v2)
end
gen4 = make_table_lookup(440.0, :wave, partials2wave([1, 1, 2, 1]))
- vct_map!(v2, lambda do | | table_lookup(gen4) end)
+ v2.map! do |x| table_lookup(gen4) end
unless vequal(v0, v2)
snd_display("map table_lookup (no fm): %s %s?", v0, v2)
end
@@ -16969,7 +15658,7 @@ def test_08_09
gen1 = make_polyshape(440.0)
print_and_check(gen,
"polyshape",
- "polyshape freq: 440.000Hz, phase: 0.000, coeffs[2]: [0.000 1.000]")
+ "polyshape freq: 440.000Hz, phase: 0.000, coeffs[2]: [0 1]")
if gen.length != 2
snd_display("polyshape length: %s?", gen.length)
end
@@ -16980,12 +15669,12 @@ def test_08_09
val
end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | polyshape?(gen1) ? polyshape(gen1, 1.0, 0.0) : -1.0 end)
+ v1.map! do |x| polyshape?(gen1) ? polyshape(gen1, 1.0, 0.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map polyshape: %s %s?", v0, v1)
end
gen1 = make_polyshape(440.0, :coeffs, partials2polynomial([1, 1]))
- vct_map!(v1, lambda do | | polyshape(gen1, 1.0) end)
+ v1.map! do |x| polyshape(gen1, 1.0) end
unless vequal(v0, v1)
snd_display("map polyshape (no fm): %s %s?", v0, v1)
end
@@ -17083,7 +15772,7 @@ def test_08_10
end
v0 = make_vct!(10) do wave_train(gen, 0.0) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | wave_train?(gen1) ? wave_train(gen1) : -1.0 end)
+ v1.map! do |x| wave_train?(gen1) ? wave_train(gen1) : -1.0 end
unless vequal(v0, v1)
snd_display("map wave_train: %s %s?", v0, v1)
end
@@ -17118,7 +15807,6 @@ def test_08_10
snd_display("mus_data wave_train: %s?", gen.data)
end
gen.data = make_vct(3)
- make_oscil.data = make_vct(3)
#
test_gen_equal(make_wave_train(440.0, 0.0, make_vct(20)),
make_wave_train(440.0, 0.0, make_vct(20)),
@@ -17157,37 +15845,37 @@ def test_08_10
end
#
ind = new_sound(:size, 10)
- if frames != 10
- snd_display("new_sound size 10: %s?", frames)
+ if framples != 10
+ snd_display("new_sound size 10: %s?", framples)
end
map_channel($init_channel, 7, 8)
- if frames != 15
- snd_display("map_channel 7 8: %s?", frames)
+ if framples != 15
+ snd_display("map_channel 7 8: %s?", framples)
end
map_channel($init_channel)
- if frames != 15
- snd_display("map_channel (no dur): %s?", frames)
+ if framples != 15
+ snd_display("map_channel (no dur): %s?", framples)
end
revert_sound(ind)
map_channel($init_channel, 9, 10)
- if frames != 19
- snd_display("map_channel 9 10: %s?", frames)
+ if framples != 19
+ snd_display("map_channel 9 10: %s?", framples)
end
if (res = edit_position(ind, 0)) > 2
snd_display("map_channel pad edits (1): %s?", res)
end
revert_sound(ind)
map_channel($init_channel, 10, 10)
- if frames != 20
- snd_display("map_channel 10 10: %s?", frames)
+ if framples != 20
+ snd_display("map_channel 10 10: %s?", framples)
end
if (res = edit_position(ind, 0)) > 2
snd_display("map_channel pad edits (2): %s?", res)
end
revert_sound(ind)
map_channel($init_channel, 20, 10)
- if frames != 30
- snd_display("map_channel 20 10: %s?", frames)
+ if framples != 30
+ snd_display("map_channel 20 10: %s?", framples)
end
if (res = edit_position(ind, 0)) > 2
snd_display("map_channel pad edits (3): %s?", res)
@@ -17196,38 +15884,6 @@ def test_08_10
if scan_channel(lambda do |y| false end, 30, 10)
snd_display("scan_channel past end?")
end
- ptree_channel($init_channel, 7, 8)
- if frames != 15
- snd_display("ptree_channel 7 8: %s?", frames)
- end
- ptree_channel($init_channel)
- if frames != 15
- snd_display("ptree_channel (no dur): %s?", frames)
- end
- revert_sound(ind)
- ptree_channel($init_channel, 9, 10)
- if frames != 19
- snd_display("ptree_channel 9 10: %s?", frames)
- end
- if (res = edit_position(ind, 0)) > 2
- snd_display("ptree_channel pad edits (1): %s?", res)
- end
- revert_sound(ind)
- ptree_channel($init_channel, 10, 10)
- if frames != 20
- snd_display("ptree_channel 10 10: %s?", frames)
- end
- if (res = edit_position(ind, 0)) > 2
- snd_display("ptree_channel pad edits (2): %s?", res)
- end
- revert_sound(ind)
- ptree_channel($init_channel, 20, 10)
- if frames != 30
- snd_display("ptree_channel 20 10: %s?", frames)
- end
- if (res = edit_position(ind, 0)) > 2
- snd_display("ptree_channel pad edits (3): %s?", res)
- end
close_sound(ind)
#
ind = new_sound(:size, 1000)
@@ -17426,21 +16082,21 @@ def test_08_10
print_and_check(gen, "readin", "readin oboe.snd[chan 0], loc: 1490, dir: 1")
v0 = make_vct!(10) do readin(gen) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | |
- if readin?(gen1)
- if gen1.channel.zero?
- readin(gen1)
- else
- 1.0
- end
- else
- if gen1.file_name == "oboe.snd"
- -1.0
- else
- -1.0
- end
- end
- end)
+ v1.map! do |x|
+ if readin?(gen1)
+ if gen1.channel.zero?
+ readin(gen1)
+ else
+ 1.0
+ end
+ else
+ if gen1.file_name == "oboe.snd"
+ -1.0
+ else
+ -1.0
+ end
+ end
+ end
unless vequal(v0, v1)
snd_display("map readin: %s %s?", v0, v1)
end
@@ -17544,7 +16200,7 @@ def test_08_10
unless mus_input?(gen)
snd_display("%s not input?", gen)
end
- if gen.length != frames(ind)
+ if gen.length != framples(ind)
snd_display("snd2sample length: %s?", gen.length)
end
if gen.file_name != (Dir.pwd + "/oboe.snd")
@@ -17581,7 +16237,7 @@ def test_08_10
unless mus_input?(gen)
snd_display("%s not input?", gen)
end
- if gen.length != frames(ind)
+ if gen.length != framples(ind)
snd_display("snd2sample length: %s?", gen.length)
end
if gen.file_name != (Dir.pwd + "/2.snd")
@@ -17597,26 +16253,29 @@ def test_08_10
end
def test_08_11
- gen = make_file2frame("oboe.snd")
- print_and_check(gen, "file->frame", "file->frame oboe.snd")
- unless file2frame?(gen)
- snd_display("%s not file2frame?", gen)
+ gen = make_file2frample("oboe.snd")
+ print_and_check(gen, "file->frample", "file->frample oboe.snd")
+ unless file2frample?(gen)
+ snd_display("%s not file2frample?", gen)
end
unless mus_input?(gen)
snd_display("%s not input?", gen)
end
if gen.length != 50828
- snd_display("file2frame length: %s?", gen.length)
+ snd_display("file2frample length: %s?", gen.length)
+ end
+ g1 = make_vct(gen.channels)
+ v0 = make_vct!(10) do |i|
+ file2frample(gen, 1490 + i, g1)[0]
end
- v0 = make_vct!(10) do |i| frame_ref(file2frame(gen, 1490 + i, 0), 0) end
- unless file2frame?(gen)
- snd_display("%s not file2frame?", gen)
+ unless file2frample?(gen)
+ snd_display("%s not file2frample?", gen)
end
if gen.file_name != "oboe.snd"
- snd_display("file2frame mus_file_name: %s?", gen.file_name)
+ snd_display("file2frample mus_file_name: %s?", gen.file_name)
end
if fneq(v0[1], -0.009) or fneq(v0[7], 0.029)
- snd_display("file2frame output: %s?", v0)
+ snd_display("file2frample output: %s?", v0)
end
#
delete_files("fmv.snd", "fmv1.snd", "fmv2.snd", "fmv3.snd")
@@ -17698,63 +16357,12 @@ def test_08_11
snd_display("mus_channels vct: %s?", res)
end
#
- gen = make_sound_data(4, 100)
- 10.times do |i|
- outa(i, 0.1, gen)
- outb(i, 0.2, gen)
- outc(i, 0.3, gen)
- outd(i, 0.4, gen)
- end
- 10.times do |i|
- outa(i, 0.01, gen)
- outb(i, 0.02, gen)
- outc(i, 0.03, gen)
- outd(i, 0.04, gen)
- end
- mus_close(gen)
- 10.times do |i|
- if fneq(res1 = ina(i, gen), 0.11) or
- fneq(res2 = inb(i, gen), 0.22) or
- fneq(res3 = in_any(i, 2, gen), 0.33) or
- fneq(res4 = in_any(i, 3, gen), 0.44)
- snd_display("4-chan sd out/in[%s]: %s %s %s %s?", i, res1, res2, res3, res4)
- end
- end
- if (res = mus_channels(gen)) != 4
- snd_display("mus_channels sd 4: %s?", res)
- end
- #
- gen = make_sound_data(4, 100)
- 10.times do |i|
- out_any(i, 0.1, 0, gen)
- out_any(i, 0.2, 1, gen)
- out_any(i, 0.3, 2, gen)
- out_any(i, 0.4, 3, gen)
- end
- 10.times do |i|
- out_any(i, 0.01, 0, gen)
- out_any(i, 0.02, 1, gen)
- out_any(i, 0.03, 2, gen)
- out_any(i, 0.04, 3, gen)
- end
- mus_close(gen)
- 10.times do |i|
- if fneq(res1 = in_any(i, 0, gen), 0.11) or
- fneq(res2 = in_any(i, 1, gen), 0.22) or
- fneq(res3 = in_any(i, 2, gen), 0.33) or
- fneq(res4 = in_any(i, 3, gen), 0.44)
- snd_display("4-chan sd out/in_any[%s]: %s %s %s %s?", i, res1, res2, res3, res4)
- end
- end
- #
gen = make_oscil(440.0)
- if (res = Snd.catch do outa(0, 0.1, gen) end).first != :wrong_type_arg
+ res = Snd.catch do outa(0, 0.1, gen) end
+ if res.first != :wrong_type_arg and
+ res.first != :mus_error
snd_display("outa -> oscil: %s", res.inspect)
end
- res = Snd.catch do outa(0, 0.1, false) end
- if (not number?(res.car)) or fneq(res.car, 0.1)
- snd_display("outa -> false: %s", res.inspect)
- end
#
gen = make_sample2file("fmv.snd", 4, Mus_lshort, Mus_riff)
print_and_check(gen, "sample->file", "sample->file fmv.snd")
@@ -17800,41 +16408,42 @@ def test_08_11
snd_display("make_sample2file bad type: %s", res.inspect)
end
#
- gen = make_frame2file("fmv1.snd", 2, Mus_bshort, Mus_next)
- print_and_check(gen, "frame->file", "frame->file fmv1.snd")
- unless frame2file?(gen)
- snd_display("%s not frame2file?", gen)
+ gen = make_frample2file("fmv1.snd", 2, Mus_bshort, Mus_next)
+ print_and_check(gen, "frample->file", "frample->file fmv1.snd")
+ unless frample2file?(gen)
+ snd_display("%s not frample2file?", gen)
end
unless mus_output?(gen)
snd_display("%s not output?", gen)
end
if gen.length != mus_file_buffer_size
- snd_display("frame2file length: %s?", gen.length)
+ snd_display("frample2file length: %s?", gen.length)
end
if gen.file_name != "fmv1.snd"
- snd_display("frame2file mus_file_name: %s?", gen.file_name)
+ snd_display("frample2file mus_file_name: %s?", gen.file_name)
end
gen.length = 4096
if gen.length != 4096
- snd_display("frame2file length: %s?", gen.length)
+ snd_display("frample2file length: %s?", gen.length)
end
gen.length = 8192
- fr0 = make_frame(2, 0.0, 0.0)
+ fr0 = make_vct(2, 0.0)
100.times do |i|
- frame_set!(fr0, 0, i * 0.001)
- frame_set!(fr0, 1, i * 0.010)
- frame2file(gen, i, fr0)
+ vct_set!(fr0, 0, i * 0.001)
+ vct_set!(fr0, 1, i * 0.010)
+ frample2file(gen, i, fr0)
end
mus_close(gen)
- gen = make_file2frame("fmv1.snd", 1024)
- val4 = file2frame(gen, 40)
- frout = make_frame(2)
- if fneq(frame_ref(val4, 0), 0.04) or fneq(frame_ref(val4, 1), 0.4)
- snd_display("frame2file output: %s?", val4)
- end
- file2frame(gen, 40, frout)
+ gen = make_file2frample("fmv1.snd", 1024)
+ fr0 = make_vct(gen.channels)
+ val4 = file2frample(gen, 40, fr0)
+ frout = make_vct(2)
+ if fneq(vct_ref(val4, 0), 0.04) or fneq(vct_ref(val4, 1), 0.4)
+ snd_display("frample2file output: %s?", val4)
+ end
+ file2frample(gen, 40, frout)
unless frout.eql?(val4)
- snd_display("frame2file output via frame: %s %s?", frout, val4)
+ snd_display("frample2file output via frame: %s %s?", frout, val4)
end
#
gen = make_sample2file("fmv2.snd", 4, Mus_bshort, Mus_aifc)
@@ -17894,8 +16503,8 @@ def test_08_11
if (res = mus_sound_chans("fmv.snd")) != 2
snd_display("sample2file chans: %s?", res)
end
- if (res = mus_sound_frames("fmv.snd")) != 10
- snd_display("sample2file frames: %s?", res)
+ if (res = mus_sound_framples("fmv.snd")) != 10
+ snd_display("sample2file framples: %s?", res)
end
if (res = mus_sound_samples("fmv.snd")) != 20
snd_display("sample2file samples: %s?", res)
@@ -17903,7 +16512,7 @@ def test_08_11
if (res = mus_sound_header_type("fmv.snd")) != Mus_next
snd_display("sample2file type: %s?", res)
end
- if (res = mus_sound_data_format("fmv.snd")) != Mus_bshort
+ if (res = mus_sound_sample_type("fmv.snd")) != Mus_bshort
snd_display("sample2file format: %s?", res)
end
if (res = mus_sound_comment("fmv.snd")) != "this is a comment"
@@ -17927,8 +16536,8 @@ def test_08_11
if (res = mus_sound_chans("fmv.snd")) != 2
snd_display("continue_sample2file chans: %s?", res)
end
- if (res = mus_sound_frames("fmv.snd")) != 15
- snd_display("continue_sample2file frames: %s?", res)
+ if (res = mus_sound_framples("fmv.snd")) != 15
+ snd_display("continue_sample2file framples: %s?", res)
end
if (res = mus_sound_samples("fmv.snd")) != 30
snd_display("continue_sample2file samples: %s?", res)
@@ -17936,7 +16545,7 @@ def test_08_11
if (res = mus_sound_header_type("fmv.snd")) != Mus_next
snd_display("continue_sample2file type: %s?", res)
end
- if (res = mus_sound_data_format("fmv.snd")) != Mus_bshort
+ if (res = mus_sound_sample_type("fmv.snd")) != Mus_bshort
snd_display("continue_sample2file format: %s?", res)
end
if (res = mus_sound_comment("fmv.snd")) != "this is a comment"
@@ -17957,75 +16566,72 @@ def test_08_11
#
delete_file("fmv.snd")
mus_sound_forget("fmv.snd")
- sf = make_frame2file("fmv.snd", 2, Mus_lfloat, Mus_riff, "this is a comment")
+ msg = "this is a comment"
+ sf = make_frample2file("fmv.snd", 2, Mus_lfloat, Mus_riff, msg)
10.times do |i|
- frame2file(sf, i, make_frame(2, i * 0.10, i * 0.01))
+ frample2file(sf, i, vct(i * 0.10, i * 0.01))
end
mus_close(sf)
if (res = mus_sound_chans("fmv.snd")) != 2
- snd_display("frame2file chans: %s?", res)
+ snd_display("frample2file chans: %s?", res)
end
- if (res = mus_sound_frames("fmv.snd")) != 10
- snd_display("frame2file frames: %s?", res)
+ if (res = mus_sound_framples("fmv.snd")) != 10
+ snd_display("frample2file framples: %s?", res)
end
if (res = mus_sound_samples("fmv.snd")) != 20
- snd_display("frame2file samples: %s?", res)
+ snd_display("frample2file samples: %s?", res)
end
if (res = mus_sound_header_type("fmv.snd")) != Mus_riff
- snd_display("frame2file type: %s?", res)
+ snd_display("frample2file type: %s?", res)
end
- if (res = mus_sound_data_format("fmv.snd")) != Mus_lfloat
- snd_display("frame2file format: %s?", res)
+ if (res = mus_sound_sample_type("fmv.snd")) != Mus_lfloat
+ snd_display("frample2file format: %s?", res)
end
- if (res = mus_sound_comment("fmv.snd")) != "this is a comment"
- snd_display("frame2file comment: %s?", res)
+ if (res = mus_sound_comment("fmv.snd")) != msg
+ snd_display("frample2file comment: %s?", res)
end
- rd = make_file2sample("fmv.snd")
- 10.times do |i|
- f0 = file2frame(rd, i)
- if f0.length != 2 or
- fneq(frame_ref(f0, 0), i * 0.10) or
- fneq(frame_ref(f0, 1), i * 0.01)
- snd_display("frame2file2frame at %s: %s?", i, f0)
- break
- end
+ rd = make_file2frample("fmv.snd")
+ f0 = vct(0, 0)
+ rd.length.times do |i|
+ file2frample(rd, i, f0)
+ snd_test_neq(f0.length, 2, "frample2file2frample at %d: f0.len %s", i, f0)
+ snd_test_neq(f0[0], i * 0.10, "frample2file2frample at %d: f0[0] %s", i, f0)
+ snd_test_neq(f0[1], i * 0.01, "frample2file2frample at %d: f0[1] %s", i, f0)
end
mus_close(rd)
- sf = continue_frame2file("fmv.snd")
+ sf = continue_frample2file("fmv.snd")
10.times do |i|
- frame2file(sf, i + 5, make_frame(2, i * -0.02, i * -0.01))
+ frample2file(sf, i + 5, vct(i * -0.02, i * -0.01))
end
mus_close(sf)
mus_sound_forget("fmv.snd")
if (res = mus_sound_chans("fmv.snd")) != 2
- snd_display("continue_frame2file chans: %s?", res)
+ snd_display("continue_frample2file chans: %s?", res)
end
- if (res = mus_sound_frames("fmv.snd")) != 15
- snd_display("continue_frame2file frames: %s?", res)
+ if (res = mus_sound_framples("fmv.snd")) != 15
+ snd_display("continue_frample2file framples: %s?", res)
end
if (res = mus_sound_samples("fmv.snd")) != 30
- snd_display("continue_frame2file samples: %s?", res)
+ snd_display("continue_frample2file samples: %s?", res)
end
if (res = mus_sound_header_type("fmv.snd")) != Mus_riff
- snd_display("continue_frame2file type: %s?", res)
+ snd_display("continue_frample2file type: %s?", res)
end
- if (res = mus_sound_data_format("fmv.snd")) != Mus_lfloat
- snd_display("continue_frame2file format: %s?", res)
+ if (res = mus_sound_sample_type("fmv.snd")) != Mus_lfloat
+ snd_display("continue_frample2file format: %s?", res)
end
if (res = mus_sound_comment("fmv.snd")) != "this is a comment"
- snd_display("continue_frame2file comment: %s?", res)
+ snd_display("continue_frample2file comment: %s?", res)
end
ind = open_sound("fmv.snd")
- unless vequal(c0 = channel2vct(0, 15, ind, 0),
- vct(0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.58, 0.66,
- 0.74, 0.82, -0.1, -0.12, -0.14, -0.16, -0.18))
- snd_display("continue_frame2file (0): %s", c0)
- end
- unless vequal(c0 = channel2vct(0, 15, ind, 1),
- vct(0.0, 0.01, 0.02, 0.03, 0.04, 0.05, 0.05, 0.05,
- 0.05, 0.05, -0.05, -0.06, -0.07, -0.08, -0.09))
- snd_display("continue_frame2file (1): %s", c0)
- end
+ c0 = channel2vct(0, 15, ind, 0)
+ c1 = channel2vct(0, 15, ind, 1)
+ v0 = vct(0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.58, 0.66,
+ 0.74, 0.82, -0.1, -0.12, -0.14, -0.16, -0.18)
+ v1 = vct(0.0, 0.01, 0.02, 0.03, 0.04, 0.05, 0.05, 0.05,
+ 0.05, 0.05, -0.05, -0.06, -0.07, -0.08, -0.09)
+ snd_test_neq(c0, v0, "continue_frample2file (0)")
+ snd_test_neq(c1, v1, "continue_frample2file (1)")
close_sound(ind)
delete_file("fmv.snd")
mus_sound_forget("fmv.snd")
@@ -18129,14 +16735,10 @@ def test_08_12
end
snd_test_neq(bad1, 0, "rand dist: down/up 1 %d/%d", down1, up1)
snd_test_neq(bad2, 0, "rand dist: down/up 2 %d/%d", down2, up2)
- if 2.5 * down1 > up1
- snd_display(snd_format(2.5 * down1, up1, ">",
- "rand dist: down/up/bad 1 %d/%d/%d", down1, up1, bad1))
- end
- if 2.5 * up2 > down2
- snd_display(snd_format(2.5 * up2, down2, ">",
- "rand dist: down/up/bad 2 %d/%d/%d", down2, up2, bad2))
- end
+ snd_test_gt(2.5 * down1, up1,
+ "rand dist: down/up/bad 1 %d/%d/%d", down1, up1, bad1)
+ snd_test_gt(2.5 * up2, down2,
+ "rand dist: down/up/bad 2 %d/%d/%d", down2, up2, bad2)
#
gen = make_rand_interp(4000.0)
print_and_check(gen, "rand-interp", gen.to_s)
@@ -18302,13 +16904,13 @@ def test_08_13
end
sum
end.call(10000)
- if res < 4.0
+ if res < 3.0
snd_display("mus_random not so random (chi)? %s", res)
end
res = lambda do |n|
hits = make_array(10, 0)
- gen = make_rand(22050.0)
- n.times do |i| hits[(5 + 5 * rand(gen, 0.0)).floor] += 1 end
+ gen = make_rand(22050.0, 5)
+ n.times do |i| hits[(5 + rand(gen, 0.0)).floor] += 1 end
sum = 0.0
pp = n / 10.0
hits.each do |val|
@@ -18316,7 +16918,7 @@ def test_08_13
end
sum
end.call(10000)
- if res < 4.0
+ if res < 3.5
snd_display("rand not so random (chi)? %s", res)
end
#
@@ -18352,7 +16954,7 @@ def test_08_14
gen2 = make_locsig(60.0, :channels, 4)
gen200 = make_locsig(200.0, :channels, 4)
gen3 = gen1
- fr0 = locsig(gen, 0, 1.0)
+ locsig(gen, 0, 1.0)
print_and_check(gen, "locsig", "locsig chans 2, outn: [0.667 0.333], interp: linear")
unless locsig?(gen)
snd_display("%s not locsig?", gen)
@@ -18391,17 +16993,17 @@ def test_08_14
unless vequal(mus_data(gen), vct(0.250, 0.333))
snd_display("locsig gen 0.25 outn: %s?", mus_data(gen))
end
- fr0 = locsig(gen, 0, 1.0)
+ locsig(gen, 0, 1.0)
locsig_set!(gen, 0, 0.5)
unless vequal(mus_data(gen), vct(0.500, 0.333))
snd_display("locsig gen 0.5 outn: %s?", mus_data(gen))
end
- fr0 = locsig(gen, 0, 1.0)
+ locsig(gen, 0, 1.0)
gen = make_locsig(300.0, 2.0, 0.1, :channels, 4)
unless vequal(mus_data(gen), vct(0.167, 0.000, 0.000, 0.333))
snd_display("locsig gen 300 outn: %s?", mus_data(gen))
end
- fr0 = locsig(gen, 0, 1.0)
+ locsig(gen, 0, 1.0)
move_locsig(gen1, 90.0, 1.0)
unless vequal(mus_data(gen1), vct(0.000, 1.000))
snd_display("locsig gen1 90 outn: %s?", mus_data(gen1))
@@ -18559,8 +17161,8 @@ def test_08_14
close_sound(ind)
end
#
- gen = make_frame2file("fmv4.snd", 2, Mus_bshort, Mus_next)
- rev = make_frame2file("fmv4.reverb", 1, Mus_bshort, Mus_next)
+ gen = make_frample2file("fmv4.snd", 2, Mus_bshort, Mus_next)
+ rev = make_frample2file("fmv4.reverb", 1, Mus_bshort, Mus_next)
lc = make_locsig(60.0, :reverb, 0.1, :channels, 2, :output, gen, :revout, rev)
100.times do |i| locsig(lc, i, 1.0) end
if fneq(res = locsig_reverb_ref(lc, 0), 0.1)
@@ -18589,8 +17191,8 @@ def test_08_14
snd_display("locsig direct: %s %s?", v0[0], v1[0])
end
#
- gen = make_frame2file("fmv4.snd", 4, Mus_bshort, Mus_next)
- rev = make_frame2file("fmv4.reverb", 4, Mus_bshort, Mus_next)
+ gen = make_frample2file("fmv4.snd", 4, Mus_bshort, Mus_next)
+ rev = make_frample2file("fmv4.reverb", 4, Mus_bshort, Mus_next)
lc = make_locsig(60.0, :reverb, 0.1, :channels, 4, :distance, 4.0, :output, gen, :revout, rev)
print_and_check(lc,
"locsig",
@@ -18642,9 +17244,6 @@ def test_08_14
print_and_check(make_locsig(-40, :channels, 2),
"locsig",
"locsig chans 2, outn: [1.000 0.000], interp: linear")
- print_and_check(make_locsig(160, :channels, 4, :output, SoundData.new(4, 10)),
- "locsig",
- "locsig chans 4, outn: [0.000 0.222 0.778 0.000], interp: linear")
print_and_check(make_locsig(0, :channels, 1, :output, Vct.new(10)),
"locsig",
"locsig chans 1, outn: [1.000], interp: linear")
@@ -18725,7 +17324,7 @@ def test_08_14
[0, 1, 2, 4].each do |rev_chans|
delete_file("test.reverb")
revfile = if rev_chans > 0
- make_frame2file("test.reverb", rev_chans, Mus_bshort, Mus_next)
+ make_frample2file("test.reverb", rev_chans, Mus_bshort, Mus_next)
else
false
end
@@ -18811,47 +17410,6 @@ def test_08_14
end
#
set_locsig_type(Mus_interp_linear)
- outp = make_sound_data(1, 10)
- gen = make_locsig(0.0, :output, outp)
- if (res = mus_channels(gen)) != 1
- snd_display("make_locsig->sd chans (1)", res)
- end
- 10.times do |i| locsig(gen, i, 1.0) end
- unless vequal(res = sound_data2vct(outp, 0), Vct.new(10, 1.0))
- snd_display("locsig->sd chan 0: %s?", res)
- end
- outp = make_sound_data(2, 10)
- gen = make_locsig(0.0, :output, outp)
- if (res = mus_channels(gen)) != 2
- snd_display("make_locsig->sd chans (2)", res)
- end
- 10.times do |i| locsig(gen, i, 1.0) end
- unless vequal(res = sound_data2vct(outp, 0), Vct.new(10, 1.0))
- snd_display("locsig->sd chan 0: %s?", res)
- end
- unless vequal(res = sound_data2vct(outp, 1), Vct.new(10, 0.0))
- snd_display("locsig->sd chan 1: %s?", res)
- end
- outp = make_sound_data(2, 10)
- gen = make_locsig(45.0, :output, outp)
- if (res = mus_channels(gen)) != 2
- snd_display("make_locsig->sd chans (2)", res)
- end
- 10.times do |i| locsig(gen, i, 1.0) end
- unless vequal(res = sound_data2vct(outp, 0), Vct.new(10, 0.5))
- snd_display("locsig->sd chan 0 (0.5): %s?", res)
- end
- unless vequal(res = sound_data2vct(outp, 1), Vct.new(10, 0.5))
- snd_display("locsig->sd chan 1 (0.5): %s?", res)
- end
- 10.times do |i| locsig(gen, i, 0.5) end
- unless vequal(res = sound_data2vct(outp, 0), Vct.new(10, 0.75))
- snd_display("locsig->sd chan 0 (0.75): %s?", res)
- end
- unless vequal(res = sound_data2vct(outp, 1), Vct.new(10, 0.75))
- snd_display("locsig->sd chan 1 (0.75): %s?", res)
- end
- #
outp = Vct.new(10)
gen = make_locsig(0.0, :output, outp)
if (res = mus_channels(gen)) != 1
@@ -18879,29 +17437,10 @@ def test_08_14
snd_display("locsig(2)->vct chan 0: %s?", outp)
end
#
- outp = make_sound_data(4, 10)
- gen = make_locsig(135.0, :output, outp)
- if (res = mus_channels(gen)) != 4
- snd_display("make_locsig->sd chans (4)", res)
- end
- 10.times do |i| locsig(gen, i, 1.0) end
- unless vequal(res = sound_data2vct(outp, 0), Vct.new(10, 0.0))
- snd_display("locsig(4)->sd chan 0 (0.5): %s?", res)
- end
- unless vequal(res = sound_data2vct(outp, 1), Vct.new(10, 0.5))
- snd_display("locsig(4)->sd chan 1 (0.5): %s?", res)
- end
- unless vequal(res = sound_data2vct(outp, 2), Vct.new(10, 0.5))
- snd_display("locsig(4)->sd chan 2 (0.5): %s?", res)
- end
- unless vequal(res = sound_data2vct(outp, 3), Vct.new(10, 0.0))
- snd_display("locsig(4)->sd chan 3 (0.5): %s?", res)
- end
- #
set_mus_array_print_length(8)
- outf1 = make_frame2file("fmv.snd", 1, Mus_bshort, Mus_next)
- outf4 = make_frame2file("fmv1.snd", 4, Mus_bshort, Mus_next)
- revf = make_frame2file("fmv2.snd", 1, Mus_bshort, Mus_next)
+ outf1 = make_frample2file("fmv.snd", 1, Mus_bshort, Mus_next)
+ outf4 = make_frample2file("fmv1.snd", 4, Mus_bshort, Mus_next)
+ revf = make_frample2file("fmv2.snd", 1, Mus_bshort, Mus_next)
start = 0
len = 1000
dur = 1.0
@@ -18938,13 +17477,13 @@ def test_08_14
print_and_check(gen1,
"move-sound",
"move-sound start: 0, end: 1000, out chans 1, rev chans: 0
- doppler delay line[32, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
- doppler env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
- global reverb env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
+ doppler delay line[32, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
+ doppler env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
+ global reverb env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
out_delays[1]:
- [0]: delay line[32, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
+ [0]: delay line[32, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
out_envs[1]:
- [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
+ [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
rev_envs: nil
out_map[1]: (0)
free: arrays: true, gens: false
@@ -18952,8 +17491,8 @@ def test_08_14
print_and_check(gen2,
"move-sound",
"move-sound start: 0, end: 1000, out chans 4, rev chans: 0
- doppler delay line[12, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
- doppler env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 10.000 1.000]
+ doppler delay line[12, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
+ doppler env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 10 1]
global reverb null
out_delays[4]:
[0]: nil
@@ -18961,10 +17500,10 @@ def test_08_14
[2]: nil
[3]: nil
out_envs[4]:
- [0]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000 2.000 0.000 3.000 0.000...(0: 0.000, 8: 4.000)]
- [1]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 0.000 2.000 1.000 3.000 0.000...(0: 0.000, 8: 4.000)]
- [2]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 0.000 2.000 0.000 3.000 1.000...(0: 0.000, 8: 4.000)]
- [3]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 0.000 2.000 0.000 3.000 0.000...(0: 0.000, 8: 4.000)]
+ [0]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1 2 0 3 0...(0: 0, 8: 4)]
+ [1]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 0 2 1 3 0...(0: 0, 8: 4)]
+ [2]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 0 2 0 3 1...(0: 0, 8: 4)]
+ [3]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 0 2 0 3 0...(0: 0, 8: 4)]
rev_envs: nil
out_map[4]: (0 1 2 3)
free: arrays: true, gens: false
@@ -18972,15 +17511,15 @@ def test_08_14
print_and_check(gen3,
"move-sound",
"move-sound start: 0, end: 1000, out chans 1, rev chans: 1
- doppler delay line[32, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
- doppler env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
- global reverb env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
+ doppler delay line[32, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
+ doppler env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
+ global reverb env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
out_delays[1]:
- [0]: delay line[32, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
+ [0]: delay line[32, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
out_envs[1]:
- [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
+ [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
rev_envs[1]:
- [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 1.000 1.000 1.000]
+ [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 1 1 1]
out_map[1]: (0)
free: arrays: true, gens: false
")
@@ -19035,48 +17574,9 @@ def test_08_14
delete_file("fmv1.snd")
delete_file("fmv2.snd")
mus_sound_prune
-end
-
-def test_08_15
- rd = make_readin("oboe.snd", 0, 2000)
- gen = make_src(:srate, 2.0, :input, rd)
- gen1 = make_src(:srate, 2.0, :input, make_readin("oboe.snd", 0, 2000))
- gen2 = make_src(:srate, 0.0)
- print_and_check(gen, "src", "src width: 10, x: 0.000, incr: 2.000, sinc table len: 10000")
- v0 = Vct.new(10) do
- src(gen)
- end
- v1 = make_vct(10)
- vct_map!(v1, lambda do ||
- src?(gen1) ? src(gen1) : -1.0
- end)
- unless vequal(v0, v1)
- snd_display("run src: %s %s?", v0, v1)
- end
- unless src?(gen)
- snd_display("%s not src?", gen)
- end
- req1 = 0.001
- req2 = 0.021
- snd_test_neq(v0[1], 0.001, "src output v0[1]")
- snd_test_neq(v0[7], 0.021, "src output v0[7]")
- if fneq(gen.increment, 2.0)
- snd_display("src increment: %s?", gen.increment)
- end
- if fneq(gen2.increment, 0.0)
- snd_display("src 0.0 increment: %s?", gen2.increment)
- end
- if fneq(rd.increment, 1.0)
- snd_display("readin increment: %s?", rd.increment)
- end
- if gen.length != 10
- snd_display("src length: %s?", gen.length)
- end
- gold = gen
- gen = make_src(lambda do |dir| 0.0 end)
- if gen.eql? gold
- snd_display("src eql? %s %s?", gen, gold)
- end
+end
+
+def test_08_15
if (res = Snd.catch do make_src(:width, -1) end).first != :out_of_range
snd_display("make_src bad width: %s", res.inspect)
end
@@ -19087,27 +17587,50 @@ def test_08_15
src(s1, 125.0)
src(s1, -25.0)
src(s1, -125.0)
- 10.times do |i| make_src(lambda do |y| 1.0 end, 1.5, :width, 5 + i * 10) end
- clear_sincs
+ 10.times do |i|
+ make_src(lambda do |y|
+ 1.0
+ end,
+ 1.5,
+ :width, 5 + i * 10)
+ end
#
ctr = 0.0
gen = make_src(:srate, 2.0, :input, lambda do |dir|
val = ctr
- ctr += 1
+ ctr += 1.0
val
end)
- v0 = make_vct!(10) do src(gen, 0.0) end
+ v0 = make_vct!(10) do
+ src(gen, 0.0)
+ end
ctr = 0.0
gen.reset
v0.each_with_index do |old_val, i|
- if fneq(old_val, new_val = src(gen, 0.0))
- snd_display("reset src %s: %s %s?", i, old_val, new_val)
- end
+ snd_test_neq(old_val, src(gen, 0.0), "reset src %d", i)
+ end
+ #
+ so1 = lambda do |ss, pp|
+ src(ss, env(pp))
+ end
+ s1 = make_src(:srate, 2.0, :input, make_readin("oboe.snd", 0, 10000))
+ s2 = make_src(:srate, 2.0, :input, make_readin("oboe.snd", 0, 10000))
+ s3 = make_src(:srate, 2.0, :input, make_readin("oboe.snd", 0, 10000))
+ e1 = make_env([0, 1, 2, 0.5], :duration, 1000)
+ e2 = make_env([0, 1, 2, 0.5], :duration, 1000)
+ e3 = make_env([0, 1, 2, 0.5], :duration, 1000)
+ 100.times do |i|
+ x1 = src(s1, env(e1))
+ ex2 = env(e2)
+ x2 = src(s2, ex2)
+ x3 = so1.call(s3, e3)
+ snd_test_neq(x1, x2, "%d", i)
+ snd_test_neq(x1, x3, "%d", i)
end
#
- gen = make_granulate(:expansion, 2.0)
+ gen = make_granulate(:expansion, 2.0,
+ :input, make_readin("oboe.snd", 0, 4000, 1, 2048))
gen1 = make_granulate(:expansion, 2.0)
- rd = make_readin("oboe.snd", 0, 4000, 1, 2048)
rd1 = make_readin(:file, "oboe.snd",
:channel, 0,
:start, 4000,
@@ -19117,12 +17640,12 @@ def test_08_15
"granulate",
"granulate expansion: 2.000 (551/1102), scaler: 0.600, length: 0.150 secs (3308 samps), ramp: 0.060")
v0 = make_vct!(1000) do
- granulate(gen, lambda do |dir| readin(rd) end)
+ granulate(gen)
end
v1 = make_vct(1000)
- vct_map!(v1, lambda do | |
- granulate?(gen1) ? granulate(gen1, lambda do |dir| readin(rd1) end) : -1.0
- end)
+ v1.map! do |x|
+ granulate?(gen1) ? granulate(gen1, lambda do |dir| readin(rd1) end) : -1.0
+ end
if (worst = (vct_peak(v0) - vct_peak(v1)).abs) > 0.01
snd_display("run granulate: %s?", worst)
end
@@ -19145,7 +17668,7 @@ def test_08_15
if fneq(gen.scaler, 0.6)
snd_display("granulate scaler: %s?", gen.scaler)
end
- if ffneq(gen.frequency, 0.05) # okay
+ if ffneq(gen.frequency, 0.05)
snd_display("granulate frequency: %s?", gen.frequency)
end
if gen.ramp != 1323
@@ -19170,7 +17693,7 @@ def test_08_15
snd_display("granulate set_length: %s?", gen.length)
end
gen.increment = 3.0
- if ffneq(gen.increment, 3.0) # okay
+ if ffneq(gen.increment, 3.0)
snd_display("granulate set_increment: %s?", gen.increment)
end
gen.location = 1
@@ -19182,10 +17705,9 @@ def test_08_15
snd_display("granulate set_frequency: %s?", gen.frequency)
end
#
- if (res = Snd.catch do make_granulate(lambda do |a, b| a end) end).first != :bad_arity
- snd_display("make_granulate bad func: %s", res.inspect)
- end
- if (res = Snd.catch do make_granulate(:hop, 35.0, :length, 35.0) end).first != :out_of_range
+ if (res = Snd.catch do
+ make_granulate(:hop, 35.0, :length, 35.0)
+ end).first != :out_of_range
snd_display("make_granulate bad sizes: %s", res.inspect)
end
#
@@ -19199,97 +17721,105 @@ def test_08_15
0
end)
map_channel(lambda do |y| granulate(grn) end)
- if (maxamp / mx) < 1.4 or (mx / maxamp) > 2.5
- snd_display("gran edit 2* (0): %s %s?", mx, maxamp)
+ if (maxamp() / mx) < 1.4 or (mx / maxamp()) > 2.5
+ snd_display("gran edit 2* (0): %s %s?", mx, maxamp())
end
undo_edit
rd = make_sampler(0)
grn = make_granulate(:expansion, 2.0,
- :input, lambda do |dir| rd.call end,
+ :input, lambda do |dir| read_sample(rd) end,
:edit, lambda do |g|
g.data.scale!(4.0)
0
end)
map_channel(lambda do |y| granulate(grn) end)
- if (maxamp / mx) < 3.0 or (mx / maxamp) > 6.0
- snd_display("gran edit 4* (0): %s %s?", mx, maxamp)
+ if (maxamp() / mx) < 3.0 or (mx / maxamp()) > 6.0
+ snd_display("gran edit 4* (0): %s %s?", mx, maxamp())
end
revert_sound(ind)
rd = make_sampler(0)
grn = make_granulate(:expansion, 2.0,
+ :input, lambda do |dir| read_sample(rd) end,
:edit, lambda do |g|
g.data.scale!(2.0)
0
end)
- map_channel(lambda do |y| granulate(grn, lambda do |dir| rd.call end) end)
- if (maxamp / mx) < 1.4 or (mx / maxamp) > 2.5
- snd_display("gran edit 2* (1): %s %s?", mx, maxamp)
+ map_channel(lambda do |y| granulate(grn) end)
+ if (maxamp() / mx) < 1.4 or (mx / maxamp()) > 2.5
+ snd_display("gran edit 2* (1): %s %s?", mx, maxamp())
end
undo_edit
rd = make_sampler(0)
grn = make_granulate(:expansion, 2.0,
+ :input, lambda do |dir| read_sample(rd) end,
:edit, lambda do |g|
g.data.scale!(4.0)
0
end)
- map_channel(lambda do |y| granulate(grn, lambda do |dir| rd.call end) end)
- if (maxamp / mx) < 3.0 or (mx / maxamp) > 6.0
- snd_display("gran edit 4* (1): %s %s?", mx, maxamp)
+ map_channel(lambda do |y| granulate(grn) end)
+ if (maxamp() / mx) < 2.9 or (mx / maxamp()) > 6.0
+ snd_display("gran edit 4* (1): %s %s?", mx, maxamp())
end
revert_sound(ind)
+ # XXX: grn = make_granulate(:expansion, 2.0, :input, make_sampler(0))
+ # Doesn't work with Ruby; make_sampler is not a procedure.
rd = make_sampler(0)
- grn = make_granulate(:expansion, 2.0)
- map_channel(lambda do |y|
- granulate(grn,
- lambda do |dir| rd.call end,
- lambda do |g|
- g.data.scale!(2.0)
- 0
- end)
- end)
- if (maxamp / mx) < 1.4 or (mx / maxamp) > 2.5
- snd_display("gran edit 2* (2): %s %s?", mx, maxamp)
+ input_fnc = lambda do |dir|
+ rd.call
+ end
+ edit_fnc = lambda do |g|
+ g.data.scale!(2.0)
+ 0
+ end
+ grn = make_granulate(:expansion, 2.0, :input, input_fnc, :edit, edit_fnc)
+ map_channel(lambda do |y| granulate(grn) end)
+ if (maxamp() / mx) < 1.4 or (mx / maxamp()) > 2.5
+ snd_display("gran edit 2* (2): %s %s?", mx, maxamp())
end
undo_edit
rd = make_sampler(0)
grn = make_granulate(:expansion, 2.0)
map_channel(lambda do |y|
- granulate(grn,
- lambda do |dir| rd.call end,
- lambda do |g|
- g.data.scale!(4.0)
- 0
- end)
- end)
- if (maxamp / mx) < 3.0 or (mx / maxamp) > 6.0
- snd_display("gran edit 4* (2): %s %s?", mx, maxamp)
+ granulate(grn,
+ lambda do |dir| rd.call end,
+ lambda do |g|
+ g.data.scale!(4.0)
+ 0
+ end)
+ end)
+ if (maxamp() / mx) < 3.0 or (mx / maxamp()) > 6.0
+ snd_display("gran edit 4* (2): %s %s?", mx, maxamp())
end
close_sound(ind)
ind = open_sound("oboe.snd")
- grn = make_granulate(:expansion, 2.0, :length, 0.01, :hop, 0.05)
rd = make_sampler(0)
- map_channel(lambda do |y| granulate(grn, lambda do |dir| rd.call end) end)
+ grn = make_granulate(:expansion, 2.0, :length, 0.01, :hop, 0.05,
+ :input, lambda do |dir| next_sample(rd) end)
+ map_channel(lambda do |y| granulate(grn) end)
if (res = maxamp) > 0.2
snd_display("trouble in granulate len 0.01 hop 0.05: %s?", res)
end
undo_edit
- grn = make_granulate(:expansion, 2.0, :length, 0.04, :hop, 0.05)
rd = make_sampler(0)
- map_channel(lambda do |y| granulate(grn, lambda do |dir| rd.call end) end)
+ grn = make_granulate(:expansion, 2.0, :length, 0.04, :hop, 0.05,
+ :input, lambda do |dir| next_sample(rd) end)
+ map_channel(lambda do |y| granulate(grn) end)
if (res = maxamp) > 0.2
snd_display("trouble in granulate len 0.04 hop 0.05: %s?", res)
end
undo_edit
- grn = make_granulate(:expansion, 2.0, :length, 0.01, :hop, 0.25)
rd = make_sampler(0)
- map_channel(lambda do |y| granulate(grn, lambda do |dir| rd.call end) end)
+ grn = make_granulate(:expansion, 2.0, :length, 0.01, :hop, 0.25,
+ :input, lambda do |dir| next_sample(rd) end)
+ map_channel(lambda do |y| granulate(grn) end)
if (res = maxamp) > 0.2
snd_display("trouble in granulate len 0.01 hop 0.25: %s?", res)
end
undo_edit
- grn = make_granulate(:expansion, 2.0, :length, 0.4, :hop, 0.5)
rd = make_sampler(0)
- map_channel(lambda do |y| granulate(grn, lambda do |dir| rd.call end) end)
+ grn = make_granulate(:expansion, 2.0, :length, 0.4, :hop, 0.5,
+ :input, lambda do |dir| next_sample(rd) end)
+ map_channel(lambda do |y| granulate(grn) end)
if (res = maxamp) > 0.2
snd_display("trouble in granulate len 0.4 hop 0.5: %s?", res)
end
@@ -19299,8 +17829,9 @@ end
def test_08_16
ind = new_sound(:size, 1000)
- gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.06)
snd_display("gran 0 max: %s?", res)
end
@@ -19319,8 +17850,9 @@ def test_08_16
snd_display("gran 0 data 85: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.002, :length, 0.001)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.002, :length, 0.001,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.06)
snd_display("gran 1 max: %s?", res)
end
@@ -19339,8 +17871,9 @@ def test_08_16
snd_display("gran 1 data 40: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.002, :length, 0.001, :ramp, 0.1)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.002, :length, 0.001, :ramp, 0.1,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.06)
snd_display("gran 2 max: %s?", res)
end
@@ -19359,8 +17892,9 @@ def test_08_16
snd_display("gran 2 data 40: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.002, :length, 0.001, :ramp, 0.5)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.002, :length, 0.001, :ramp, 0.5,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.06)
snd_display("gran 3 max: %s?", res)
end
@@ -19379,8 +17913,9 @@ def test_08_16
snd_display("gran 3 data 85: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.001, :ramp, 0.5)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.001, :ramp, 0.5,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.06)
snd_display("gran 4 max: %s?", res)
end
@@ -19399,8 +17934,9 @@ def test_08_16
snd_display("gran 4 data 85: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.001, :ramp, 0.25, :scaler, 1.0)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.001, :ramp, 0.25,
+ :scaler, 1.0, :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.1)
snd_display("gran 5 max: %s?", res)
end
@@ -19419,8 +17955,9 @@ def test_08_16
snd_display("gran 5 data 85: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.002, :ramp, 0.5, :scaler, 1.0)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.002, :ramp, 0.5,
+ :scaler, 1.0, :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.105)
snd_display("gran 6 max: %s?", res)
end
@@ -19439,8 +17976,9 @@ def test_08_16
snd_display("gran 6 data 85: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.005, :ramp, 0.5, :scaler, 1.0)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.005, :ramp, 0.5,
+ :scaler, 1.0, :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.264)
snd_display("gran 7 max: %s?", res)
end
@@ -19460,8 +17998,9 @@ def test_08_16
end
undo_edit
gen = make_granulate(:jitter, 0.0, :hop, 0.01, :length, 0.001, :ramp, 0.5,
- :scaler, 1.0, :expansion, 2.0)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ :scaler, 1.0, :expansion, 2.0,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.1)
snd_display("gran 8 max: %s?", res)
end
@@ -19481,8 +18020,9 @@ def test_08_16
end
undo_edit
gen = make_granulate(:jitter, 0.0, :hop, 0.01, :length, 0.001, :ramp, 0.5,
- :scaler, 1.0, :expansion, 0.5)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ :scaler, 1.0, :expansion, 0.5,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.1)
snd_display("gran 9 max: %s?", res)
end
@@ -19506,7 +18046,7 @@ def test_08_16
granulate(gen,
lambda do |dir| 0.1 end,
lambda do |g|
- g.data.map! do |val| val *= 2.0 end
+ g.data.scale!(2.0)
0
end)
end)
@@ -19528,7 +18068,8 @@ def test_08_16
snd_display("gran 10 data 85: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.005, :length, 0.002, :ramp, 0.0, :scaler, 1.0)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.005, :length, 0.002,
+ :ramp, 0.0, :scaler, 1.0)
forward = true
ctr = -0.5
incr = 0.001
@@ -19569,10 +18110,10 @@ def test_08_16
undo_edit
ctr = -0.5
incr = 0.001
- gen = make_granulate(:jitter, 0.0, :hop, 0.005, :length, 0.002, :ramp, 0.0, :scaler, 1.0,
+ gen = make_granulate(:jitter, 0.0, :hop, 0.005, :length, 0.002, :ramp, 0.0,
+ :scaler, 1.0,
:input, lambda do |dir|
ctr += incr
- ctr
end)
map_channel(lambda do |y| granulate(gen) end)
if (res = maxamp) > 0.6
@@ -19586,17 +18127,19 @@ def test_08_16
snd_display("gran 12 data: %s?", res)
end
unless vequal(res = channel2vct(100, 30),
- vct(0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000,
- 0.000, 0.000, -0.389, -0.388, -0.387, -0.386, -0.385, -0.384,
- -0.383, -0.382, -0.381, -0.380, -0.379, -0.378, -0.377, -0.376,
+ vct(0.0, 0.0, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000,
+ 0.0, 0.0, -0.389, -0.388, -0.387, -0.386, -0.385, -0.384,
+ -0.383, -0.382, -0.381, -0.38,
+ -0.379, -0.378, -0.377, -0.376,
-0.375, -0.374, -0.373, -0.372, -0.371, -0.370))
snd_display("gran 12 data 100: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.005, :ramp, 0.5, :scaler, 1.0,
+ gen = make_granulate(:jitter, 0.0, :hop, 0.001, :length, 0.005, :ramp, 0.5,
+ :scaler, 1.0,
:input, lambda do |dir| 0.1 end,
:edit, lambda do |g|
- g.data.map! do |val| val *= 2.0 end
+ g.data.scale!(2.0)
0
end)
map_channel(lambda do |y| granulate(gen) end)
@@ -19621,7 +18164,8 @@ def test_08_16
forward = true
ctr = -0.5
incr = 0.001
- gen = make_granulate(:jitter, 0.0, :hop, 0.005, :length, 0.002, :ramp, 0.0, :scaler, 1.0,
+ gen = make_granulate(:jitter, 0.0, :hop, 0.005, :length, 0.002, :ramp, 0.0,
+ :scaler, 1.0,
:input, lambda do |dir|
ctr += incr
ctr
@@ -19656,11 +18200,12 @@ def test_08_16
end
undo_edit
#
- gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001, :ramp, 0.0)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001, :ramp, 0.0,
+ :input, lambda do |dir| 0.1 end)
e = make_env(:envelope, [0, 0, 1, 0.5], :length, 1001)
base_ramp_len = mus_length(gen)
map_channel(lambda do |y|
- result = granulate(gen, lambda do |dir| 0.1 end)
+ result = granulate(gen)
set_mus_ramp(gen, (base_ramp_len * env(e)).round)
result
end)
@@ -19692,11 +18237,12 @@ def test_08_16
snd_display("granf 0 data 880: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001, :ramp, 0.0)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001, :ramp, 0.0,
+ :input, lambda do |dir| 0.1 end)
e = make_env(:envelope, [0, 1, 1, 0.25], :length, 1001)
base_hop_len = mus_hop(gen)
map_channel(lambda do |y|
- result = granulate(gen, lambda do |dir| 0.1 end)
+ result = granulate(gen)
set_mus_hop(gen, (base_hop_len * env(e)).round)
result
end)
@@ -19721,11 +18267,12 @@ def test_08_16
snd_display("granf 1 data 900: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001, :ramp, 0.0)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001, :ramp, 0.0,
+ :input, lambda do |dir| 0.1 end)
e = make_env(:envelope, [0, 1, 1, 0.25], :length, 1001)
base_freq = mus_frequency(gen)
map_channel(lambda do |y|
- result = granulate(gen, lambda do |dir| 0.1 end)
+ result = granulate(gen)
set_mus_frequency(gen, base_freq * env(e))
result
end)
@@ -19750,9 +18297,10 @@ def test_08_16
snd_display("granf 2 data 900: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.002, :length, 0.001, :ramp, 0.0, :scaler, 1.0)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.002, :length, 0.001, :ramp, 0.0,
+ :scaler, 1.0, :input, lambda do |dir| 0.1 end)
base_freq = mus_frequency(gen)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ map_channel(lambda do |y| granulate(gen) end)
if fneq(res = maxamp, 0.1)
snd_display("granf 3 max: %s?", res)
end
@@ -19764,11 +18312,12 @@ def test_08_16
snd_display("granf 3 data: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001, :ramp, 0.0, :scaler, 1.0)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.004, :length, 0.001, :ramp, 0.0,
+ :scaler, 1.0, :input, lambda do |dir| 0.1 end)
e = make_env(:envelope, [0, 1, 1, 0], :length, 1001)
base_freq = mus_frequency(gen)
map_channel(lambda do |y|
- result = granulate(gen, lambda do |dir| 0.1 end)
+ result = granulate(gen)
set_mus_scaler(gen, env(e))
result
end)
@@ -19797,11 +18346,12 @@ def test_08_16
snd_display("granf 4 data 900: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.006, :length, 0.001, :ramp, 0.0, :max_size, 2200)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.006, :length, 0.001, :ramp, 0.0,
+ :max_size, 2200, :input, lambda do |dir| 0.1 end)
e = make_env(:envelope, [0, 1, 1, 5], :length, 1001)
base_len = mus_length(gen)
map_channel(lambda do |y|
- result = granulate(gen, lambda do |dir| 0.1 end)
+ result = granulate(gen)
set_mus_length(gen, (base_len * env(e)).round)
result
end)
@@ -19833,11 +18383,12 @@ def test_08_16
snd_display("granf 5 data 800: %s?", res)
end
undo_edit
- gen = make_granulate(:jitter, 0.0, :hop, 0.006, :length, 0.005, :ramp, 0.0, :max_size, 2200)
+ gen = make_granulate(:jitter, 0.0, :hop, 0.006, :length, 0.005, :ramp, 0.0,
+ :max_size, 2200, :input, lambda do |dir| 0.1 end)
e = make_env(:envelope, [0, 1, 1, 0.2], :length, 1001)
base_len = mus_length(gen)
map_channel(lambda do |y|
- result = granulate(gen, lambda do |dir| 0.1 end)
+ result = granulate(gen)
set_mus_length(gen, (base_len * env(e)).round)
result
end)
@@ -19877,38 +18428,43 @@ def test_08_16
pts
end
gen = make_granulate(:jitter, 0.0, :hop, 0.01, :length, 0.001,
- :ramp, 0.5, :scaler, 1.0, :expansion, 0.5)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ :ramp, 0.5, :scaler, 1.0, :expansion, 0.5,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if [11, 231, 451, 671, 891] != (res = max_list.call)
snd_display("grn jitter 0 max: %s?", res)
end
undo_edit
gen = make_granulate(:jitter, 0.3, :hop, 0.01, :length, 0.001,
- :ramp, 0.5, :scaler, 1.0, :expansion, 0.5)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ :ramp, 0.5, :scaler, 1.0, :expansion, 0.5,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if [11, 231, 451, 671, 891] == (res = max_list.call)
snd_display("grn jitter 0.3 max: %s?", res)
end
old_vals = res
undo_edit
gen = make_granulate(:jitter, 0.3, :hop, 0.01, :length, 0.001,
- :ramp, 0.5, :scaler, 1.0, :expansion, 0.5)
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ :ramp, 0.5, :scaler, 1.0, :expansion, 0.5,
+ :input, lambda do |dir| 0.1 end)
+ map_channel(lambda do |y| granulate(gen) end)
if (res = max_list.call) == old_vals
snd_display("grn jitter 0.3 max: %s %s?", res, old_vals)
end
undo_edit
old_vals = false
gen = make_granulate(:jitter, 1.0, :hop, 0.01, :length, 0.001,
- :ramp, 0.5, :scaler, 1.0, :expansion, 0.5)
+ :ramp, 0.5, :scaler, 1.0, :expansion, 0.5,
+ :input, lambda do |dir| 0.1 end)
seed = gen.location
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ map_channel(lambda do |y| granulate(gen) end)
old_vals = max_list.call
undo_edit
gen = make_granulate(:jitter, 1.0, :hop, 0.01, :length, 0.001,
- :ramp, 0.5, :scaler, 1.0, :expansion, 0.5)
+ :ramp, 0.5, :scaler, 1.0, :expansion, 0.5,
+ :input, lambda do |dir| 0.1 end)
gen.location = seed
- map_channel(lambda do |y| granulate(gen, lambda do |dir| 0.1 end) end)
+ map_channel(lambda do |y| granulate(gen) end)
if (res = max_list.call) != old_vals
snd_display("grn jitter 1.0 max with seed: %s %s?", res, old_vals)
end
@@ -19916,16 +18472,10 @@ def test_08_16
fname = file_name(ind)
close_sound(ind)
delete_file(fname)
- if view_files_dialog(false)
- set_view_files_files(view_files_dialog(false), [])
- unless (res = view_files_files(view_files_dialog(false))).null?
- snd_display("set vf files list null: %s?", res)
- end
- end
end
def test_08_17
- ind = new_sound("tmp.snd", Mus_next, Mus_bfloat, 22050, 1, :size, 10000)
+ ind = new_sound("tmp.snd", 1, 22050, Mus_bfloat, Mus_next, :size, 10000)
gen = make_granulate(:expansion, 20.0,
:input, lambda do |dir| 0.01 end,
:length, 0.00995,
@@ -20000,13 +18550,9 @@ def test_08_17
snd_display("granulate ramped 4 data off: %s %s %s?", res1, res2, res3)
end
undo_edit
- ctr = 0
+ e = make_env([0, 0, 1, 1], :length, 10000)
gen = make_granulate(:expansion, 2.0,
- :input, lambda do |dir|
- val = ctr * 0.0001
- ctr += 1
- val
- end,
+ :input, lambda do |dir| env(e) end,
:length, 0.00995,
:hop, 0.01,
:ramp, 0.0,
@@ -20019,7 +18565,7 @@ def test_08_17
vals = count_matches(lambda do |y| y != 0.0 end)
mxoff = 0.0
mx = maxamp
- len = frames
+ len = framples
cur = 0.0
incr = mx / len
scan_channel(lambda do |y|
@@ -20034,13 +18580,9 @@ def test_08_17
snd_display("granulate ramped 5 mxoff: %s?", mxoff)
end
undo_edit
- ctr = 0
+ e = make_env([0, 0, 1, 1], :length, 10000)
gen = make_granulate(:expansion, 2.0,
- :input, lambda do |dir|
- val = ctr * 0.0001
- ctr += 1
- val
- end,
+ :input, lambda do |dir| env(e) end,
:length, 0.00995,
:hop, 0.01,
:ramp, 0.5,
@@ -20057,13 +18599,9 @@ def test_08_17
snd_display("granulate ramped 6 data: %s %s?", res1, res2)
end
undo_edit
- ctr = 0
+ e = make_env([0, 0, 1, 1], :length, 10000)
gen = make_granulate(:expansion, 2.0,
- :input, lambda do |dir|
- val = ctr * 0.0001
- ctr += 1
- val
- end,
+ :input, lambda do |dir| env(e) end,
:length, 0.00995,
:hop, 0.01,
:ramp, 0.25,
@@ -20080,13 +18618,9 @@ def test_08_17
snd_display("granulate ramped 7 data: %s %s?", res1, res2)
end
undo_edit
- ctr = 0
+ e = make_env([0, 0, 1, 1], :length, 10000)
gen = make_granulate(:expansion, 2.0,
- :input, lambda do |dir|
- val = ctr * 0.0001
- ctr += 1
- val
- end,
+ :input, lambda do |dir| env(e) end,
:length, 0.05,
:hop, 0.01,
:ramp, 0.25,
@@ -20094,11 +18628,11 @@ def test_08_17
:jitter, 0.0)
clm_channel(gen)
if fneq(maxamp, 0.201)
- snd_display("granulate ramped 8: %s?", maxamp)
+ snd_display("granulate ramped 7: %s?", maxamp)
end
mxoff = 0.0
mx = maxamp
- len = frames
+ len = framples
cur = 0.0
incr = mx / len
scan_channel(lambda do |y|
@@ -20110,16 +18644,12 @@ def test_08_17
false
end)
if mxoff > 0.01
- snd_display("granulate ramped 8 mxoff: %s?", mxoff)
+ snd_display("granulate ramped 7 mxoff: %s?", mxoff)
end
undo_edit
- ctr = 0
+ e = make_env([0, 0, 1, 1], :length, 10000)
gen = make_granulate(:expansion, 2.0,
- :input, lambda do |dir|
- val = ctr * 0.0001
- ctr += 1
- val
- end,
+ :input, lambda do |dir| env(e) end,
:length, 0.1,
:hop, 0.01,
:ramp, 0.1,
@@ -20127,11 +18657,11 @@ def test_08_17
:jitter, 0.0)
clm_channel(gen)
if fneq(maxamp, 0.501)
- snd_display("granulate ramped 9: %s?", maxamp)
+ snd_display("granulate ramped 8: %s?", maxamp)
end
mxoff = 0.0
mx = maxamp
- len = frames - 2000
+ len = framples - 2000
cur = sample(2000)
incr = (mx - cur) / len
scan_channel(lambda do |y|
@@ -20143,16 +18673,12 @@ def test_08_17
false
end, 2000)
if mxoff > 0.001
- snd_display("granulate ramped 9 mxoff: %s?", mxoff)
+ snd_display("granulate ramped 8 mxoff: %s?", mxoff)
end
undo_edit
- ctr = 0
+ e = make_env([0, 0, 1, 1], :length, 10000)
gen = make_granulate(:expansion, 2.0,
- :input, lambda do |dir|
- val = ctr * 0.0001
- ctr += 1
- val
- end,
+ :input, lambda do |dir| env(e) end,
:length, 0.4,
:hop, 0.01,
:ramp, 0.4,
@@ -20160,7 +18686,7 @@ def test_08_17
:jitter, 0.0)
clm_channel(gen)
if fneq(maxamp, 0.433)
- snd_display("granulate ramped 10: %s?", maxamp)
+ snd_display("granulate ramped 9: %s?", maxamp)
end
undo_edit
close_sound(ind)
@@ -20198,48 +18724,27 @@ def test_08_18
v1[n]
end)
end
- vct_map!(v21, lambda do | |
- if convolve?(gen1)
- convolve(gen1, lambda do |dir|
- n1 += 1
- v11[n1]
- end)
- else
- -1.0
- end
- end)
+ v21.map! do |x|
+ if convolve?(gen1)
+ convolve(gen1, lambda do |dir|
+ n1 += 1
+ v11[n1]
+ end)
+ else
+ -1.0
+ end
+ end
unless vequal(v2, v21)
snd_display("run gran: %s %s?", v2, v21)
end
if fneq(v2[0], 0.0) or fneq(v2[1], 1.0) or fneq(v2[4], 0.25) or fneq(v2[7], 0.143)
snd_display("convolve output: %s?", v2)
end
- if (res = Snd.catch do convolve(gen, lambda do |a, b| a end) end).first != :bad_arity
- snd_display("convolve bad func: %s", res.inspect)
- end
convolve_files("oboe.snd", "fyow.snd", 0.5, "fmv.snd")
if fneq(res = mus_sound_maxamp("fmv.snd")[1], 0.5)
snd_display("convolve_files: %s != 0.5?", res)
end
#
- fd = mus_sound_open_input("oboe.snd")
- chans = mus_sound_chans("oboe.snd")
- data = make_sound_data(chans, 2000)
- unless sound_data?(data)
- snd_display("%s not sound_data?", data)
- end
- if sound_data_chans(data) != 1
- snd_display("sound_data chans: %s?", data.chans)
- end
- if data.length != 2000
- snd_display("sound_data length: %s?", sound_data_length(data))
- end
- mus_sound_read(fd, 0, 1999, chans, data)
- mus_sound_close_input(fd)
- if fneq(res = data[0, 1497], 0.02893066)
- snd_display("mus_sound_read: %s?", res)
- end
- #
ind = new_sound("fmv.snd")
set_sample(1, 0.1)
save_sound(ind)
@@ -20248,8 +18753,8 @@ def test_08_18
end
close_sound(ind)
ind = open_sound("fmv.snd")
- if frames(ind, 0) != 2
- snd_display("save_sound 2 samps: %s?", frames(ind, 0))
+ if framples(ind, 0) != 2
+ snd_display("save_sound 2 samps: %s?", framples(ind, 0))
end
if fneq(sample(0), 0.0) or fneq(sample(1), 0.1)
snd_display("save_sound: %s %s?", sample(0), sample(1))
@@ -20262,8 +18767,8 @@ def test_08_18
end
close_sound(ind)
ind = open_sound("fmv.snd")
- if frames(ind, 0) != i + 1
- snd_display("save_sound %s samps: %s?", i + 1, frames(ind, 0))
+ if framples(ind, 0) != i + 1
+ snd_display("save_sound %s samps: %s?", i + 1, framples(ind, 0))
end
if fneq(sample(0), 0.0) or fneq(sample(1), 0.1) or fneq(sample(i), i * 0.1)
snd_display("save_sound %s: %s %s %s?", i, sample(0), sample(1), sample(i))
@@ -20300,12 +18805,6 @@ def test_08_18
end
close_sound(ind)
#
- if defined? mus_ssb_bank # not defined if --with-modules
- bands = make_array(3) do make_bandpass(hz2radians(500.0), hz2radians(600.0), 10) end
- ssbs = make_array(3) do make_ssb_am(100.0 + random(400.0)) end
- mus_ssb_bank(ssbs, bands, 0.1, 3)
- end
- #
ind = new_sound("test.snd", :srate, 22050, :channels, 1, :size, 1000)
ctr = 0
map_channel(lambda do |y|
@@ -20324,9 +18823,8 @@ def test_08_18
end
close_sound(ind)
#
- snd_test_neq($output, false, "$output")
- $output = false
- nind = new_sound("fmv.snd", Mus_aifc, Mus_bshort, 22050, 1, "this is a comment")
+ nind = new_sound("fmv.snd", 1, 22050, Mus_bshort, Mus_aifc,
+ "this is a comment")
with_time("fm_violin_1(0, 1, 440, 0.1)") do fm_violin_1(0, 1, 440, 0.1) end
play(nind, :wait, true)
save_sound(nind)
@@ -20355,13 +18853,13 @@ def test_08_18
unless sound?(nind)
snd_display("close_sound clobbered %s?", nind)
end
- fr = frames(nind, 0)
+ fr = framples(nind, 0)
10.times do
delete_samples(10, 100, nind, 0)
save_sound(nind)
end
- if frames(nind, 0) != fr - 1000
- snd_display("delete_samples: %s %s?", fr, frames(nind, 0))
+ if framples(nind, 0) != fr - 1000
+ snd_display("delete_samples: %s %s?", fr, framples(nind, 0))
end
revert_sound(nind)
close_sound(nind)
@@ -20372,10 +18870,10 @@ def test_08_18
mus_header_type_name(res1),
mus_header_type_name(res2))
end
- if (res1 = data_format(nind)) != (res2 = default_output_data_format)
- snd_display("new_sound default data_format: %s %s?",
- mus_data_format_name(res1),
- mus_data_format_name(res2))
+ if (res1 = sample_type(nind)) != (res2 = default_output_sample_type)
+ snd_display("new_sound default sample_type: %s %s?",
+ mus_sample_type_name(res1),
+ mus_sample_type_name(res2))
end
if (res1 = channels(nind)) != (res2 = default_output_chans)
snd_display("new_sound default chans: %s %s?", res1, res2)
@@ -20388,7 +18886,8 @@ def test_08_18
end
def test_08_19
- nind = new_sound("fmv.snd", Mus_nist, Mus_bshort, 22050, 1, "this is a comment")
+ nind = new_sound("fmv.snd", 1, 22050, Mus_bshort, Mus_nist,
+ "this is a comment")
set_sample(0, 1.0, nind)
start_progress_report(nind)
convolve_with("oboe.snd")
@@ -20422,9 +18921,10 @@ def test_08_19
revert_sound(nind)
close_sound(nind)
#
- nind = new_sound("fmv.snd", Mus_riff, Mus_lshort, 22050, 1, "this is a comment", 22050)
- if frames(nind) != 22050
- snd_display("new_sound initial_length: %s?", frames(nind))
+ nind = new_sound("fmv.snd", 1, 22050, Mus_lshort, Mus_riff,
+ "this is a comment", 22050)
+ if framples(nind) != 22050
+ snd_display("new_sound initial_length: %s?", framples(nind))
end
mix("pistol.snd")
map_chan(expsrc(2.0, nind))
@@ -20479,14 +18979,6 @@ def test_08_19
close_sound(nind)
end
-def mus_mix_1(outf, inf, outloc = 0, frms = false, inloc = 0, mx = false, envs = false)
- unless number?(frms)
- frms = mus?(inf) ? mus_length(inf) : mus_sound_frames(inf)
- end
- mus_mix(outf, inf, outloc, frms, inloc, mx, envs)
- mus?(outf) and mus_close(outf)
-end
-
def test_08_20
make_mix_output = lambda do |name, i|
if i == 0 or i == 1
@@ -20499,160 +18991,13 @@ def test_08_20
if i == 0 or i == 2
name
else
- make_file2frame(name)
- end
- end
- 4.times do |k|
- delete_files("fmv.snd", "fmv1.snd", "fmv2.snd", "fmv3.snd")
- v0 = make_vct(12)
- vct_fill!(v0, 0.1)
- array2file("fmv1.snd", v0, 12, 22050, 1)
- vct_fill!(v0, 0.2)
- array2file("fmv2.snd", v0, 12, 22050, 2)
- file2array("fmv2.snd", 0, 0, 12, v0)
- vct_fill!(v0, 0.3)
- array2file("fmv3.snd", v0, 12, 22050, 4)
- v0.map_with_index! do |val, i| i * 0.01 end
- array2file("fmv.snd", v0, 12, 22050, 1)
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("fmv1.snd", k))
- file2array("fmv.snd", 0, 0, 12, v0)
- v0.each_with_index do |val, i|
- if fneq(val, 0.1 + i * 0.01)
- snd_display("%s mus_mix(1->1): %s?", k, v0)
- break
- end
+ make_file2frample(name)
end
- mus_mix_1(make_mix_output.call("fmv.snd", k),
- make_mix_input.call("fmv2.snd", k),
- 3, 9, 0, make_mixer(2, 0.3, 0.0, 0.7, 0.0))
- file2array("fmv.snd", 0, 0, 12, v0)
- if fneq(v0[0], 0.1) or fneq(v0[3], 0.33) or fneq(v0[9], 0.19)
- snd_display("%s mus_mix(2->1): %s?", k, v0)
- end
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("fmv3.snd", k))
- file2array("fmv.snd", 0, 0, 12, v0)
- if fneq(v0[0], 0.4) or fneq(v0[3], 0.33)
- snd_display("%s mus_mix(4->1): %s?", k, v0)
- end
- vf = make_array(1) do
- make_array(1) do
- make_env(:envelope, [0, 0, 1, 1], :length, 11)
- end
- end
- mus_mix_1(make_mix_output.call("fmv.snd", k),
- make_mix_input.call("fmv1.snd", k),
- 0, 12, 0, make_mixer(1, 1.0), vf)
- file2array("fmv.snd", 0, 0, 12, v0)
- if fneq(v0[0], 0.4) or fneq(v0[3], 0.36) or fneq(v0[9], 0.28)
- snd_display("%s mus_mix(env): %s?", k, v0)
- end
- mus_mix_1(make_mix_output.call("fmv.snd", k),
- make_mix_input.call("fmv2.snd", k),
- 0, 12, 0, make_mixer(2, 1.0, 1.0, 1.0, 1.0), vf)
- vf = make_array(2)
- vf1 = make_array(2)
- vf2 = make_array(2)
- vf[0] = vf1
- vf[1] = vf2
- vf1[0] = make_env(:envelope, [0, 0, 1, 1], :length, 10)
- vf2[1] = make_env(:envelope, [0, 0, 1, 1], :length, 10)
- mus_mix_1(make_mix_output.call("fmv.snd", k),
- make_mix_input.call("fmv2.snd", k),
- 0, 12, 0, make_mixer(2, 1.0, 1.0, 1.0, 1.0), vf)
- if (res = Snd.catch do
- vf[0] = make_oscil
- mus_mix_1(make_mix_output.call("fmv.snd", k),
- make_mix_input.call("fmv2.snd", k),
- 0, 12, 0, make_mixer(2, 1.0, 1.0, 1.0, 1.0), vf)
- end).first != :bad_type
- snd_display("%s mix w oscil-array: %s", k, res.inspect)
- end
- vf1[0] = make_env(:envelope, [0, 0, 1, 1], :length, 10)
- vf2[1] = make_env(:envelope, [0, 0, 1, 1], :length, 10)
- if (res = Snd.catch do
- vf1[0] = make_oscil
- vf2[1] = sqrt(-1.0)
- mus_mix_1(make_mix_output.call("fmv.snd", k),
- make_mix_input.call("fmv2.snd", k),
- 0, 12, 0, make_mixer(2, 1.0, 1.0, 1.0, 1.0), vf)
- end).first != :bad_type
- snd_display("%s mix w oscil-env: %s", k, res.inspect)
- end
- delete_file("fmv.snd")
- v0.map_with_index! do |val, i| i * 0.01 end
- array2file("fmv.snd", v0, 12, 22050, 4)
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("fmv1.snd", k))
- file2array("fmv.snd", 0, 0, 3, v0) # chan 0 start 0 len 3
- if fneq(v0[0], 0.1) or fneq(v0[2], 0.18)
- snd_display("%s mus_mix(1->4): %s?", k, v0)
- end
- mus_mix_1(make_mix_output.call("fmv.snd", k),
- make_mix_input.call("fmv2.snd", k),
- 0, 3, 0, make_mixer(2, 0.3, 0.0, 0.7, 0.0))
- file2array("fmv.snd", 0, 0, 3, v0)
- if fneq(v0[0], 0.3) or fneq(v0[2], 0.38)
- snd_display("%s mus_mix(2->4): %s?", k, v0)
- end
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("fmv3.snd", k), 0, 2, 0)
- file2array("fmv.snd", 0, 0, 3, v0)
- if fneq(v0[0], 0.6) or fneq(v0[2], 0.38)
- snd_display("%s mus_mix(4->4): %s?", k, v0)
- end
- #
- delete_file("fmv.snd")
- v0 = make_vct(12)
- len = mus_sound_frames("oboe.snd")
- array2file("fmv.snd", v0, 12, 22050, 1)
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("oboe.snd", k))
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("oboe.snd", k),
- 0, len, 0, make_mixer(1, 0.5))
- egen = make_array(1)
- outv = make_array(1)
- outv[0] = egen
- egen[0] = make_env(:envelope, [0, 0, 1, 1], :length, len)
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("oboe.snd", k),
- 0, len, 0, false, outv)
- egen[0] = make_env(:envelope, [0, 1, 1, 0], :length, len)
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("oboe.snd", k),
- 0, len, 0, make_mixer(1, 1.0), outv)
- ind_oboe = open_sound("oboe.snd")
- ind_mix = open_sound("fmv.snd")
- unless vequal(res1 = channel2vct(1000, 10, ind_oboe),
- res2 = vct_scale!(channel2vct(1000, 10, ind_mix), 1.0 / 2.5))
- snd_display("%s mus_mix 1 chan:\n# %s\n# %s?", k, res1, res2)
- end
- close_sound(ind_oboe)
- close_sound(ind_mix)
- #
- delete_file("fmv.snd")
- v0 = make_vct(12)
- len = mus_sound_frames("2.snd")
- array2file("fmv.snd", v0, 12, 22050, 2)
- if (res = mus_sound_chans("fmv.snd")) != 2
- snd_display("%s array2file chans %s?", k, res)
- end
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("2.snd", k))
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("2.snd", k),
- 0, len, 0, make_mixer(2, 0.5, 0.0, 0.0, 0.5))
- egen0 = make_array(2)
- egen1 = make_array(2)
- outv = make_array(2)
- outv[0] = egen0
- outv[1] = egen1
- egen0[0] = make_env(:envelope, [0, 0, 1, 1], :length, len)
- egen1[1] = make_env(:envelope, [0, 0, 1, 1], :length, len)
- mus_mix_1(make_mix_output.call("fmv.snd", k), make_mix_input.call("2.snd", k),
- 0, len, 0, false, outv)
- ind_mix = open_sound("fmv.snd")
- if channels(ind_mix) != 2
- snd_display("%s fmv re-read chans %s %s?", k, mus_sound_chans("fmv.snd"), channels(ind_mix))
- end
- close_sound(ind_mix)
- delete_file("fmv.snd")
end
end
def test_08_21
+ Snd.sounds.apply(:close_sound)
gen = make_phase_vocoder(false, 512, 4, 256, 1.0, false, false, false)
if fneq((res = Snd.catch do phase_vocoder(gen) end).first, 0.0)
snd_display("simple no-in pv call: %s", res.inspect)
@@ -20661,8 +19006,9 @@ def test_08_21
snd_display("pv bad fft: %s?", res.inspect)
end
ind = open_sound("oboe.snd")
- pv = make_phase_vocoder(false, 512, 4, 128, 1.0, false, false, false)
rd = make_sampler(0)
+ pv = make_phase_vocoder(lambda do |dir| next_sample(rd) end,
+ 512, 4, 128, 1.0, false, false, false)
unless phase_vocoder?(pv)
snd_display("%s not phase_vocoder?", pv)
end
@@ -20675,7 +19021,7 @@ def test_08_21
snd_display("pv set outctr: %s?", res)
end
select_sound(ind)
- map_chan(lambda do |val| phase_vocoder(pv, lambda do |dir| next_sample(rd) end) end)
+ map_chan(lambda do |val| phase_vocoder(pv) end)
phase_vocoder_amp_increments(pv)[0] = 0.1
if fneq(res = phase_vocoder_amp_increments(pv)[0], 0.1)
snd_display("set_phase_vocoder_amp_increments: %s?", res)
@@ -20700,9 +19046,11 @@ def test_08_21
free_sampler(rd)
#
lastphases = make_vct(512)
- pv = make_phase_vocoder(false, 512, 4, 128, 1.0,
+ rd = make_sampler(0)
+ pv = make_phase_vocoder(lambda do |dir| next_sample(rd) end,
+ 512, 4, 128, 1.0,
false,
- lambda { |v|
+ lambda do |v|
n = mus_length(v)
d = mus_hop(v)
freqs = phase_vocoder_freqs(v)
@@ -20711,45 +19059,50 @@ def test_08_21
(n / 2).times do |k|
phasediff = freqs[k] - lastphases[k]
lastphases[k] = freqs[k]
- while phasediff > PI
+ if phasediff > PI
phasediff -= TWO_PI
- end
- while phasediff < -PI
- phasediff += TWO_PI
+ else
+ if phasediff < -PI
+ phasediff += TWO_PI
+ end
end
freqs[k] = 0.5 * (pscl * phasediff + k * kscl)
end
false
- },
+ end,
false)
- rd = make_sampler(0)
- map_chan(lambda do |val| phase_vocoder(pv, lambda do |dir| next_sample(rd) end) end)
+ map_chan(lambda do |val| phase_vocoder(pv) end)
undo_edit(1)
free_sampler(rd)
#
- pv = make_phase_vocoder(false, 512, 4, (128 * 2.0).to_i, 1.0, false, false, false)
rd = make_sampler(0)
- len = (2.0 * frames(ind)).to_i
- data = make_vct!(len) do phase_vocoder(pv, lambda do |dir| next_sample(rd) end) end
+ pv = make_phase_vocoder(lambda do |dir| next_sample(rd) end,
+ 512, 4, 128 * 2, 1.0, false, false, false)
+ len = 1000
+ data = make_vct!(len) do
+ phase_vocoder(pv)
+ end
set_samples(0, len, data)
undo_edit(1)
free_sampler(rd)
#
incalls = outcalls = 0
- pv = make_phase_vocoder(false,
+ rd = make_sampler(0)
+ pv = make_phase_vocoder(lambda do |dir| next_sample(rd) end,
512, 4, (128 * 2.0).to_i, 1.0,
- lambda { |v, infunc|
+ lambda do |v, infunc|
incalls += 1
true
- },
+ end,
false,
- lambda { |v|
+ lambda do |v|
outcalls += 1
0.0
- })
- rd = make_sampler(0)
- len = (2.0 * frames(ind)).to_i
- data = make_vct!(len) do phase_vocoder(pv, lambda do |dir| next_sample(rd) end) end
+ end)
+ len = 1000
+ data = make_vct!(len) do
+ phase_vocoder(pv)
+ end
set_samples(0, len, data)
undo_edit(1)
free_sampler(rd)
@@ -20757,23 +19110,27 @@ def test_08_21
snd_display("phase_vocoder incalls: %s, outcalls: %s?", incalls, outcalls)
end
set_mus_location(pv, mus_location(pv))
- if (res = Snd.catch do phase_vocoder(pv, lambda do |a, b| a end) end).first != :bad_arity
- snd_display("phase_vocoder bad input func: %s", res.inspect)
- end
if (res = Snd.catch do
- make_phase_vocoder(false, 512, 4, 256, 1.0, lambda do |a, b, c| false end, false, false)
+ make_phase_vocoder(false,
+ 512, 4, 256, 1.0,
+ lambda do |a, b, c| false end,
+ false,
+ false)
end).first != :bad_arity
snd_display("make_phase_vocoder bad analyze func: %s", res.inspect)
end
if (res = Snd.catch do
- make_phase_vocoder(false, 512, 4, 256, 1.0,
+ make_phase_vocoder(false,
+ 512, 4, 256, 1.0,
lambda do |a, b| 0.0 end,
- lambda do |a, b, c| false end, false)
+ lambda do |a, b, c| false end,
+ false)
end).first != :bad_arity
snd_display("make_phase_vocoder bad edit func: %s", res.inspect)
end
if (res = Snd.catch do
- make_phase_vocoder(false, 512, 4, 256, 1.0,
+ make_phase_vocoder(false,
+ 512, 4, 256, 1.0,
lambda do |a, b| 0.0 end,
lambda do |a| false end,
lambda do |a, b| 0 end)
@@ -20845,13 +19202,13 @@ def test_08_22
gen = make_ssb_am(440.0)
gen1 = make_ssb_am(440.0)
print_and_check(gen,
- "ssb-am",
- "ssb-am shift: up, sin/cos: 439.999975 Hz (0.000000 radians), order: 41",
- "ssb-am shift: up, sin/cos: 440.000000 Hz (0.000000 radians), order: 41",
- "ssb-am shift: up, sin/cos: 439.999969 Hz (0.000000 radians), order: 41")
+ "ssb-am",
+ "ssb-am shift: up, sin/cos: 439.999975 Hz (0.000000 radians), order: 41",
+ "ssb-am shift: up, sin/cos: 440.000000 Hz (0.000000 radians), order: 41",
+ "ssb-am shift: up, sin/cos: 439.999969 Hz (0.000000 radians), order: 41")
v0 = make_vct!(10) do ssb_am(gen, 0.0) end
v1 = make_vct(10)
- vct_map!(v1, lambda do | | ssb_am?(gen1) ? ssb_am(gen1, 0.0) : -1.0 end)
+ v1.map! do |x| ssb_am?(gen1) ? ssb_am(gen1, 0.0) : -1.0 end
unless vequal(v0, v1)
snd_display("map ssb_am: %s %s?", v0, v1)
end
@@ -20886,7 +19243,11 @@ def test_08_22
o2 = make_ssb_am_1(400.0)
100.times do |i|
inval = sin(0.1 * i)
- snd_test_neq(ssb_am_1(o2, inval), ssb_am(o1, inval), "ssb_am (up) at %d", i)
+ req = ssb_am(o1, inval)
+ res = ssb_am_1(o2, inval)
+ if snd_test_neq(res, req, "ssb_am (up) at %d", i)
+ break
+ end
end
#
o1 = make_ssb_am(400.0)
@@ -20894,21 +19255,33 @@ def test_08_22
100.times do |i|
inval = sin(0.1 * i)
fmval = sin(0.2 * i)
- snd_test_neq(ssb_am_1(o2, inval, fmval), ssb_am(o1, inval, fmval), "ssb_am + fm (up) at %d", i)
+ req = ssb_am(o1, inval, fmval)
+ res = ssb_am_1(o2, inval, fmval)
+ if snd_test_neq(res, req, "ssb_am + fm (up) at %d", i)
+ break
+ end
end
#
o1 = make_ssb_am(-100.0)
o2 = make_ssb_am_1(-100.0)
100.times do |i|
inval = random(1.0)
- snd_test_neq(ssb_am_1(o2, inval), ssb_am(o1, inval), "ssb_am (down) at %d", i)
+ req = ssb_am(o1, inval)
+ res = ssb_am_1(o2, inval)
+ if snd_test_neq(res, req, "ssb_am (down) at %d", i)
+ break
+ end
end
#
o1 = make_ssb_am(1000.0, 100)
o2 = make_ssb_am_1(1000.0, 100)
100.times do |i|
inval = random(1.0)
- snd_test_neq(ssb_am_1(o2, inval), ssb_am(o1, inval), "ssb_am (down) at %d", i)
+ req = ssb_am(o1, inval)
+ res = ssb_am_1(o2, inval)
+ if snd_test_neq(res, req, "ssb_am (down) at %d", i)
+ break
+ end
end
#
index = open_sound("pistol.snd")
@@ -20916,15 +19289,11 @@ def test_08_22
convolve_with("oboe.snd", false)
scl = maxamp
convolve_with("oboe.snd", scl, index, 0, 0)
- if ffneq(maxamp, scl) # okay
- snd_display("convolve_with amps: %s %s?", maxmap, scl)
- end
+ snd_test_any_neq(maxamp, scl, :ffequal?, "convolve_with amps")
close_sound(index)
reader = make_sampler(0, "pistol.snd")
10.times do |i|
- if fneq(data[i], next_sample(reader))
- snd_display("external reader trouble")
- end
+ snd_test_neq(data[i], next_sample(reader), "external reader trouble")
end
free_sampler(reader)
#
@@ -20932,53 +19301,43 @@ def test_08_22
iv = vct(0.1, 0.05, -0.2, 0.15, -1.5, 0.1, 0.01, 0.001, 0.0, 0.0)
tv = vct(0.1, 0.1, 0.2, 0.2, 1.5, 1.5, 1.5, 1.5, 0.1, 0.01)
ov = Vct.new(10) do |i| moving_max(gen, iv[i]) end
- unless vequal(tv, ov)
- snd_display("moving_max: %s %s", ov, tv)
- end
+ snd_test_neq(ov, tv, "moving_max")
g1 = make_moving_max(10)
1000.times do |i|
- if fneq(val = moving_max(g1, random(1.0)), pk = g1.data.peak)
- snd_display("moving_max[%s]: %s %s?", i, pk, val)
- end
+ snd_test_neq(moving_max(g1, random(1.0)), g1.data.peak, "moving_max[%d]", i)
end
#
- data = vct(1.0, 0.0, -1.1, 1.1001, 0.1, -1.1, 1.0, 1.0, 0.5, -0.01, 0.02, 0.0, 0.0, 0.0, 0.0)
+ data = vct(1, 0, -1.1, 1.1001, 0.1, -1.1, 1, 1, 0.5, -0.01, 0.02, 0, 0, 0, 0)
g = make_moving_max(3)
odata = Vct.new(15) do |i| moving_max(g, data[i]) end
- unless vequal(odata, vct(1, 1, 1.1, 1.1, 1.1, 1.1, 1.1, 1.1, 1, 1, 0.5, 0.02, 0.02, 0, 0))
- snd_display("moving_max odata: %s?", odata)
- end
+ req = vct(1, 1, 1.1, 1.1, 1.1, 1.1, 1.1, 1.1, 1, 1, 0.5, 0.02, 0.02, 0, 0)
+ snd_test_neq(odata, req, "moving_max")
if odata[4] == odata[7]
- snd_display("moving_max 0.0001 offset?")
+ snd_test_eq(odata[4], odata[7], "moving_max 0.0001 offset")
end
#
- odata = Vct.new(15, 0.0)
data = vct(0.1, -0.2, 0.3, 0.4, -0.5, 0.6, 0.7, 0.8, -0.9, 1.0, 0.0, 0.0)
g = make_moving_sum(3)
+ odata = Vct.new(15, 0.0)
data.each_with_index do |x, i| odata[i] = moving_sum(g, x) end
- unless vequal(odata, vct(0.1, 0.3, 0.6, 0.9, 1.2, 1.5, 1.8, 2.1, 2.4, 2.7, 1.9, 1, 0, 0, 0))
- snd_display("moving_sum odata: %s?", odata)
- end
+ req = vct(0.1, 0.3, 0.6, 0.9, 1.2, 1.5, 1.8, 2.1, 2.4, 2.7, 1.9, 1, 0, 0, 0)
+ snd_test_neq(odata, req, "moving_sum")
#
- odata = Vct.new(15, 0.0)
g = make_moving_rms(4)
+ odata = Vct.new(15, 0.0)
data.each_with_index do |x, i| odata[i] = moving_rms(g, x) end
- unless vequal(odata,
- vct(0.05, 0.112, 0.187, 0.274, 0.367, 0.464, 0.561,
- 0.66, 0.758, 0.857, 0.783, 0.673, 0, 0, 0))
- snd_display("moving_rms odata: %s?", odata)
- end
+ req = vct(0.05, 0.112, 0.187, 0.274, 0.367, 0.464, 0.561,
+ 0.66, 0.758, 0.857, 0.783, 0.673, 0, 0, 0)
+ snd_test_neq(odata, req, "moving_rms")
#
- odata = Vct.new(15, 0.0)
g = make_moving_length(4)
+ odata = Vct.new(15, 0.0)
data.each_with_index do |x, i| odata[i] = moving_length(g, x) end
- unless vequal(odata,
- vct(0.1, 0.224, 0.374, 0.548, 0.735, 0.927, 1.122,
- 1.319, 1.517, 1.715, 1.565, 1.345, 0, 0, 0))
- snd_display("moving_length odata: %s?", odata)
- end
+ req = vct(0.1, 0.224, 0.374, 0.548, 0.735, 0.927, 1.122,
+ 1.319, 1.517, 1.715, 1.565, 1.345, 0, 0, 0)
+ snd_test_neq(odata, req, "moving_length")
#
- 10.times do |i| data[i] = 0.5 - random(1.0) end
+ 10.times do |i| data[i] = mus_random(0.5) end
g = make_moving_length(4)
data.each_with_index do |x, i| odata[i] = moving_length(g, x) end
k = 0
@@ -20989,13 +19348,11 @@ def test_08_22
sum += data[i + j] * data[i + j]
end
end
- if fneq(odata[k], sqrt(sum))
- snd_display("moving_length ran: %s %s?", odata[k], sqrt(sum))
- end
+ snd_test_neq(odata[k], sqrt(sum), "moving_length ran")
k += 1
end
#
- 10.times do |i| data[i] = 0.5 - random(1.0) end
+ 10.times do |i| data[i] = mus_random(0.5) end
g = make_moving_sum(4)
data.each_with_index do |x, i| odata[i] = moving_sum(g, x) end
k = 0
@@ -21006,13 +19363,11 @@ def test_08_22
sum += data[i + j].abs
end
end
- if fneq(odata[k], sum)
- snd_display("moving_sum ran: %s %s?", odata[k], sum)
- end
+ snd_test_neq(odata[k], sum, "moving_sum ran")
k += 1
end
#
- 10.times do |i| data[i] = 0.5 - random(1.0) end
+ 10.times do |i| data[i] = mus_random(0.5) end
g = make_moving_rms(4)
data.each_with_index do |x, i| odata[i] = moving_rms(g, x) end
k = 0
@@ -21023,9 +19378,7 @@ def test_08_22
sum = sum + data[i + j] * data[i + j]
end
end
- if fneq(odata[k], sqrt(sum / 4.0))
- snd_display("moving_rms ran: %s %s?", odata[k], sqrt(sum / 4.0))
- end
+ snd_test_neq(odata[k], sqrt(sum / 4.0), "moving_rms ran")
k += 1
end
#
@@ -21034,11 +19387,13 @@ def test_08_22
close_sound(ind)
#
argslist = make_array(16) do [:frequency, 440.0] end.flatten
- [:make_wave_train, :make_polyshape, :make_delay, :make_moving_average, :make_comb,
- :make_filtered_comb, :make_notch,
- :make_rand, :make_rand_interp, :make_table_lookup, :make_env,
- :make_readin, :make_locsig, :make_granulate, :make_convolve, :make_phase_vocoder].each do |make|
- if (res = Snd.catch do argslist.apply(:snd_func, make) end).first != :mus_error
+ [:make_wave_train, :make_polyshape, :make_delay,
+ :make_moving_average, :make_comb, :make_filtered_comb,
+ :make_notch, :make_rand, :make_rand_interp, :make_table_lookup,
+ :make_env, :make_readin, :make_locsig, :make_granulate,
+ :make_convolve, :make_phase_vocoder].each do |make|
+ res = Snd.catch do argslist.apply(:snd_func, make) end
+ if res.first != :mus_error
snd_display("long arglist to %s: %s", make, res.inspect)
end
end
@@ -21092,55 +19447,42 @@ def test_08_22
end
end
end
- f1 = make_frame(2, 0.1, 0.2)
- f2 = make_frame(2, 0.3, 0.5)
- f3 = make_frame(2, 0, 0)
- f4 = frame_add(f1, f2, f3)
- if f3 != f4
- snd_display("frame_add data !=: %s %s?", f3, f4)
- end
- f4 = frame_multiply(f1, f2, f3)
- if f3 != f4
- snd_display("frame_multiply data !=: %s %s?", f3, f4)
- end
end
def test_08_23
- [[:all_pass, false, 0.0, false],
- [:asymmetric_fm, false, 0.0, false],
+ [[:all_pass, false, 0.0, false],
+ [:asymmetric_fm, false, 0.0, false],
[:moving_average, false, 1.0, false],
- [:comb, false, 0.0, false],
- [:convolve, [:filter, vct(0, 1, 2)], lambda { |dir| 0.0 }, false],
- [:delay, false, 0.0, false],
- [:env, [:envelope, [0, 1, 1, 0]], false, false],
- [:filter, [:xcoeffs, vct(0, 1, 2)], 0.0, false],
- [:filter, [:ycoeffs, vct(0, 1, 2)], 0.0, false],
- [:filter, [:xcoeffs, vct(1, 2, 3), :ycoeffs, vct(0, 1, 2)], 0.0, false],
- [:fir_filter, [:xcoeffs, vct(0, 1, 2)], 0.0, false],
- [:formant, false, 0.0, false],
- [:frame, [3], 0, lambda { |gen, ind| frame_ref(gen, ind) }, false],
- [:granulate, false, lambda { |dir| 0.0 }, false],
- [:iir_filter, [:ycoeffs, vct(0, 1, 2)], 0.0, false],
- [:locsig, false, 0.0, lambda { |gen, a| locsig(gen, 0, a) }],
- [:mixer, [3, 3], 0, lambda { |gen, a| mixer_ref(gen, a, 0) }],
- [:notch, false, 0.0, false],
- [:one_pole, false, 0.0, false],
- [:one_zero, false, 0.0, false],
- [:oscil, false, 0.0, false],
- [:pulse_train, false, 0.0, false],
- [:rand, false, 0.0, false],
- [:rand_interp, false, 0.0, false],
- [:sawtooth_wave, false, 0.0, false],
- [:square_wave, false, 0.0, false],
- [:src, false, lambda { |dir| 0.0 }, lambda { |gen, a| src(gen, 0.0, a) }],
- [:table_lookup, false, 0.0, false],
- [:triangle_wave, false, 0.0, false],
- [:two_pole, false, 0.0, false],
- [:two_zero, false, 0.0, false],
- [:wave_train, false, 0.0, false],
- [:polyshape, false, 0.0, false],
- [:phase_vocoder, false, lambda { |dir| 0.0 }, false],
- [:ssb_am, false, 0.0, false]].each do |name_sym, make_args, arg, run_func|
+ [:comb, false, 0.0, false],
+ [:convolve, [:filter, vct(0, 1, 2)], lambda { |dir| 0.0 }, false],
+ [:delay, false, 0.0, false],
+ [:env, [:length, 11, :envelope, [0, 1, 1, 0]], false, false],
+ [:filter, [:xcoeffs, vct(0, 1, 2)], 0.0, false],
+ [:filter, [:ycoeffs, vct(0, 1, 2)], 0.0, false],
+ [:filter, [:xcoeffs, vct(1, 2, 3), :ycoeffs, vct(0, 1, 2)], 0.0, false],
+ [:fir_filter, [:xcoeffs, vct(0, 1, 2)], 0.0, false],
+ [:formant, false, 0.0, false],
+ [:granulate, false, lambda { |dir| 0.0 }, false],
+ [:iir_filter, [:ycoeffs, vct(0, 1, 2)], 0.0, false],
+ [:locsig, false, 0.0, lambda { |gen, a| locsig(gen, 0, a) }],
+ [:notch, false, 0.0, false],
+ [:one_pole, false, 0.0, false],
+ [:one_zero, false, 0.0, false],
+ [:oscil, false, 0.0, false],
+ [:pulse_train, false, 0.0, false],
+ [:rand, false, 0.0, false],
+ [:rand_interp, false, 0.0, false],
+ [:sawtooth_wave, false, 0.0, false],
+ [:square_wave, false, 0.0, false],
+ [:src, false, lambda { |dir| 0.0 }, lambda { |gen, a| src(gen, 0.0, a) }],
+ [:table_lookup, false, 0.0, false],
+ [:triangle_wave, false, 0.0, false],
+ [:two_pole, false, 0.0, false],
+ [:two_zero, false, 0.0, false],
+ [:wave_train, false, 0.0, false],
+ [:polyshape, false, 0.0, false],
+ [:phase_vocoder, false, lambda { |dir| 0.0 }, false],
+ [:ssb_am, false, 0.0, false]].each do |name_sym, make_args, arg, run_func|
gen = if make_args
snd_func(format("make_%s", name_sym), *make_args)
else
@@ -21150,9 +19492,13 @@ def test_08_23
snd_display("%s: %s?", name_sym, gen)
end
tag = if proc?(run_func)
- Snd.catch do arg ? run_func.call(gen, arg) : run_func.call(gen) end.first
+ Snd.catch do
+ arg ? run_func.call(gen, arg) : run_func.call(gen)
+ end.first
else
- Snd.catch do arg ? snd_func(name_sym, gen, arg) : snd_func(name_sym, gen) end.first
+ Snd.catch do
+ arg ? snd_func(name_sym, gen, arg) : snd_func(name_sym, gen)
+ end.first
end
if (not number?(tag)) and (not frame?(tag))
snd_display("%s (make_gen, gen, gen? test): %s %s?", name_sym, arg, tag)
@@ -21206,42 +19552,49 @@ def test_08_23
set_tag != :wrong_type_arg and
set_tag != :no_method_error
snd_display("%s.%s= tag: %s set_tag: %s?",
- name_sym, func_sym.to_s[4..-1], tag.inspect, set_tag.inspect)
+ name_sym,
+ func_sym.to_s[4..-1],
+ tag.inspect,
+ set_tag.inspect)
end
end
end
end
#
- functions = [[:all_pass, false, false],
- [:asymmetric_fm, false, false],
- [:moving_average, false, false],
- [:comb, false, false],
- [:filtered_comb, [:filter, make_one_zero(0.5, 0.5)], false],
- [:convolve, [:filter, vct(0, 1, 2), :input, lambda { |dir| 1.0 }], false],
- [:delay, false, false],
- [:env, [:envelope, [0, 1, 1, 0], :length, 11], lambda { |gen, ignored| env(gen) }],
- [:filter, [:xcoeffs, vct(0, 1, 2)], false],
- [:filter, [:ycoeffs, vct(0, 1, 2)], false],
- [:filter, [:xcoeffs, vct(1, 2, 3), :ycoeffs, vct(0, 1, 2)], false],
- [:fir_filter, [:xcoeffs, vct(0, 1, 2)], false],
- [:formant, [:radius, 0.1, :frequency, 440.0], false],
- [:granulate, [:input, lambda { |dir| 1.0 }], false],
- [:iir_filter, [:xcoeffs, vct(0, 1, 2)], false],
- [:locsig, false, lambda { |gen, a| locsig(gen, 0, 1.0) }],
- [:notch, false, false],
- [:one_pole, [0.3, 0.7], false],
- [:one_zero, [0.5, 0.5], false],
- [:oscil, false, false],
- [:pulse_train, false, false],
- [:sawtooth_wave, false, false],
- [:square_wave, false, false],
- [:table_lookup, [:wave, make_vct(128, 0.1)], false],
- [:triangle_wave, false, false],
- [:two_pole, [0.1, 0.3, 0.6], false],
- [:two_zero, [0.1, 0.3, 0.5], false],
- [:polyshape, [:frequency, 440.0, :partials, [1, 1]], false],
- [:phase_vocoder, [lambda { |dir| 1.0 }], false],
- [:ssb_am, false, false]]
+ functions = [
+ [:all_pass, false, false],
+ [:asymmetric_fm, false, false],
+ [:moving_average, false, false],
+ [:comb, false, false],
+ [:filtered_comb, [:filter, make_one_zero(0.5, 0.5)], false],
+ [:convolve,
+ [:filter, vct(0, 1, 2), :input, lambda { |dir| 1.0 }], false],
+ [:delay, false, false],
+ [:env,
+ [:envelope, [0, 1, 1, 0], :length, 11],
+ lambda { |gen, ignored| env(gen) }],
+ [:filter, [:xcoeffs, vct(0, 1, 2)], false],
+ [:filter, [:ycoeffs, vct(0, 1, 2)], false],
+ [:filter, [:xcoeffs, vct(1, 2, 3), :ycoeffs, vct(0, 1, 2)], false],
+ [:fir_filter, [:xcoeffs, vct(0, 1, 2)], false],
+ [:formant, [:radius, 0.1, :frequency, 440.0], false],
+ [:granulate, [:input, lambda { |dir| 1.0 }], false],
+ [:iir_filter, [:xcoeffs, vct(0, 1, 2)], false],
+ [:locsig, false, lambda { |gen, a| locsig(gen, 0, 1.0) }],
+ [:notch, false, false],
+ [:one_pole, [0.3, 0.7], false],
+ [:one_zero, [0.5, 0.5], false],
+ [:oscil, false, false],
+ [:pulse_train, false, false],
+ [:sawtooth_wave, false, false],
+ [:square_wave, false, false],
+ [:table_lookup, [:wave, make_vct(128, 0.1)], false],
+ [:triangle_wave, false, false],
+ [:two_pole, [0.1, 0.3, 0.6], false],
+ [:two_zero, [0.1, 0.3, 0.5], false],
+ [:polyshape, [:frequency, 440.0, :partials, [1, 1]], false],
+ [:phase_vocoder, [lambda { |dir| 1.0 }], false],
+ [:ssb_am, false, false]]
functions.each do |name_sym, make_args, run_func|
gen = if make_args
snd_func(format("make_%s", name_sym), *make_args)
@@ -21259,22 +19612,25 @@ def test_08_23
mus_reset(gen)
unless proc?(run_func)
not_zero = false
- first_val = k.zero? ? snd_func(name_sym, gen, 1.0) : mus_apply(gen, 1.0, 0.0)
+ first_val = k.zero? ?
+ snd_func(name_sym, gen, 1.0) : mus_apply(gen, 1.0, 0.0)
if data[0] != 0.0
not_zero = true
end
if fneq(data[0], first_val)
- snd_display("[%s] %s: 0 %s %s?", k.zero? ? :run : :apply, name_sym, data[0], first_val)
+ snd_display("[%s] %s: 0 %s %s?",
+ k.zero? ? :run : :apply, name_sym, data[0], first_val)
end
(1...10).each do |i|
old_val = data[i]
- new_val = k.zero? ? snd_func(name_sym, gen, 0.0) : mus_apply(gen, 0.0, 0.0)
+ new_val = k.zero? ?
+ snd_func(name_sym, gen, 0.0) : mus_apply(gen, 0.0, 0.0)
if old_val != 0.0
not_zero = true
end
if fneq(old_val, new_val)
snd_display("[%s] %s: %s %s %s?",
- k.zero? ? :run : :apply, name_sym, i, old_val, new_val)
+ k.zero? ? :run : :apply, name_sym, i, old_val, new_val)
end
end
unless not_zero
@@ -21298,7 +19654,6 @@ def test_08_23
sqrt(-1.0),
make_delay(32),
lambda do || true end,
- make_sound_data(2, 3),
0,
1,
-1,
@@ -21342,36 +19697,40 @@ def test_08_23
end
def test_08_24
- random_args = [2.0 ** 21.5,
- 2.0 ** -18.0,
- 1.5,
- "/hiho",
- [0, 1],
- 1234,
- # FIXME
- # make_vct(3) removed from list because:
- # if $all_args is true
- # 0x08096617 in print_vct (obj=Cannot access memory at address 0xbf003038)
- # make_vct(3),
- make_color_with_catch(0.1, 0.2, 0.3),
- sqrt(-1.0),
- make_delay(32),
- lambda do || 0.0 end,
- lambda do |dir| 1.0 end,
- lambda do |a, b, c| 1.0 end,
- 0,
- 1,
- -1,
- false,
- true,
- 0.0,
- 1.0,
- -1.0,
- []]
+ random_args = [
+ 2.0 ** 21.5,
+ 2.0 ** -18.0,
+ 1.5,
+ "/hiho",
+ [0, 1],
+ 1234,
+ make_vct(3),
+ make_color_with_catch(0.1, 0.2, 0.3),
+ [0, 1],
+ Rational(3, 4),
+ Complex(0, 1), #sqrt(-1.0),
+ make_delay(32),
+ lambda do || 0.0 end,
+ lambda do |dir| 1.0 end,
+ lambda do |a, b, c| 1.0 end,
+ 0,
+ 1,
+ -1,
+ false,
+ true,
+ key_to_int(?c),
+ 0.0,
+ 1.0,
+ -1.0,
+ [],
+ 32,
+ [1, 2]]
random_gen = lambda do |*args|
[:make_all_pass,
:make_asymmetric_fm,
:make_moving_average,
+ :make_moving_max,
+ :make_moving_norm,
:make_table_lookup,
:make_triangle_wave,
:make_comb,
@@ -21382,15 +19741,13 @@ def test_08_24
:make_filtered_comb,
:make_fir_filter,
:make_formant,
- :make_frame,
:make_iir_filter,
:make_locsig,
- :make_mixer,
:make_notch,
:make_one_pole,
+ :make_one_pole_all_pass,
:make_one_zero,
:make_oscil,
- :make_ppolar,
:make_pulse_train,
:make_rand,
:make_rand_interp,
@@ -21401,20 +19758,16 @@ def test_08_24
:make_two_pole,
:make_two_zero,
:make_wave_train,
- :make_zpolar,
:make_ssb_am].each do |make_func|
- if mus_generator?(gen = Snd.catch do
- snd_func(make_func, *args)
- end.first)
+ gen = Snd.catch do snd_func(make_func, *args) end.first
+ if mus_generator?(gen)
random_args.each do |arg|
- Snd.catch do
- gen.run(arg)
- end
+ Snd.catch do gen.call(arg) end
end
end
end
end
- random_gen.call([])
+ random_gen.call()
random_args.each do |arg1|
random_gen.call(arg1)
random_args.each do |arg2|
@@ -21441,7 +19794,6 @@ def test_08
test_08_04
test_08_05
test_08_06
- test_08_07
test_08_08
test_08_09
test_08_10
@@ -21464,7 +19816,7 @@ end
# ---------------- test 09: mix ----------------
def test_09_00
- new_index = new_sound("hiho.wave", Mus_next, Mus_bshort, 22050, 1)
+ new_index = new_sound("hiho.wave", 1, 22050, Mus_bshort, Mus_next)
select_sound(new_index)
if res = find_mix(0, new_index, 0)
snd_display("found non-existent mix: %s?", res)
@@ -21660,9 +20012,9 @@ def test_09_00
end
def test_09_02
- ind = new_sound("fmv.snd", Mus_next, Mus_bshort, 22050, 1, "mix tests")
+ ind = new_sound("fmv.snd", 1, 22050, Mus_bshort, Mus_next, "mix tests")
insert_silence(0, 20, ind)
- indout = new_sound("test.snd", Mus_next, Mus_bshort, 22050, 1, "mix tests")
+ indout = new_sound("test.snd", 1, 22050, Mus_bshort, Mus_next, "mix tests")
insert_silence(0, 10, indout)
set_sample(2, 0.5, indout, 0)
set_sample(5, 0.25, indout, 0)
@@ -21704,7 +20056,7 @@ def test_09_02
snd_display("mix 1->1 at 0 tag: %s?", tag)
end
undo_edit
- indout = new_sound("test.snd", Mus_next, Mus_bshort, 22050, 2, "mix tests")
+ indout = new_sound("test.snd", 2, 22050, Mus_bshort, Mus_next, "mix tests")
insert_silence(0, 10, indout, 0)
insert_silence(0, 10, indout, 1)
set_sample(2, 0.5, indout, 0)
@@ -21739,7 +20091,7 @@ def test_09_02
undo_edit
close_sound(ind)
#
- ind = new_sound("fmv.snd", Mus_next, Mus_bshort, 22050, 2, "mix tests")
+ ind = new_sound("fmv.snd", 2, 22050, Mus_bshort, Mus_next, "mix tests")
insert_silence(0, 20, ind, 0)
insert_silence(0, 20, ind, 1)
tag = mix("test.snd", 0, true).car
@@ -21778,7 +20130,7 @@ def test_09_02
end
undo_edit(1, ind, 1)
set_sync(1, ind)
- tag = mix("test.snd", 0, true).car
+ mix("test.snd", 0, true).car
samps0 = channel2vct(0, 20, ind, 0)
samps1 = channel2vct(0, 20, ind, 1)
v = make_vct(20)
@@ -21793,22 +20145,6 @@ def test_09_02
snd_display("mix 1->1 (7): %s %s?", samps1, v)
end
undo_edit
- set_cursor(5, ind)
- tag = mix("test.snd", cursor, true).car
- samps0 = channel2vct(0, 20, ind, 0)
- samps1 = channel2vct(0, 20, ind, 1)
- v = make_vct(20)
- v[7] = 0.5
- v[10] = 0.25
- unless vequal(samps0, v)
- snd_display("mix 1->1 (8): %s %s?", samps0, v)
- end
- v[7] = 0.95
- v[10] = 0.125
- unless vequal(samps1, v)
- snd_display("mix 1->1 (9): %s %s?", samps1, v)
- end
- undo_edit
close_sound(ind)
delete_files("test.snd", "fmv.snd")
#
@@ -22040,50 +20376,8 @@ def test_09_03
snd_display("mix_amp no-op: %s %s?", mix_amp_env(id), res)
end
close_sound(ind)
- #
- if $with_test_motif
- ind = open_sound("oboe.snd")
- mix1 = mix_vct([0.1, 0.2, 0.3].to_vct, 120, ind, 0, true, "origin!")
- mix2 = mix_vct([0.1, 0.2, 0.3].to_vct, 1200, ind, 0, true)
- mix3 = mix_vct([0.1, 0.2, 0.3].to_vct, 12000, ind, 0, true)
- unless mixes(ind, 0) == [mix1, mix2, mix3]
- snd_display("mixes: %s %s?", mixes(ind, 0), [mix1, mix2, mix3])
- end
- unless mixes == [[[mix1, mix2, mix3]]]
- snd_display("mixes all: %s %s?", mixes, [[[mix1, mix2, mix3]]])
- end
- view_mixes_dialog
- set_mix_dialog_mix(mix1)
- mixd = dialog_widgets[16]
- if widget?(nxt = Snd.catch(:no_such_widget) do find_child(mixd, "Next") end.first)
- if widget?(prev = Snd.catch(:no_such_widget) do find_child(mixd, "Previous") end.first)
- force_event
- if (not RXtIsSensitive(nxt)) or RXtIsSensitive(prev)
- snd_display("mix_dialog next/previous: %s %s %s %s?",
- nxt, RXtIsSensitive(nxt), prev, RXtIsSensitive(prev))
- end
- click_button(nxt)
- force_event
- click_button(nxt)
- force_event
- if RXtIsSensitive(nxt) or (not RXtIsSensitive(prev))
- snd_display("mix_dialog next/previous: %s %s %s %s?",
- nxt, RXtIsSensitive(nxt), prev, RXtIsSensitive(prev))
- end
- click_button(prev)
- force_event
- click_button(prev)
- force_event
- else
- snd_display("find_child cannot find Previous: %s?", prev.inspect)
- end
- else
- snd_display("find_child cannot find Next: %s?", nxt.inspect)
- end
- close_sound(ind)
- end
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1, "lock mix tests", 300)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next, "lock mix tests", 300)
mix1 = mix_vct(Vct.new(10, 0.5), 10)
set_mix_amp(mix1, 0.0)
if fneq(res = maxamp(ind, 0), 0.0)
@@ -22116,7 +20410,7 @@ def test_09_04
set_with_mix_tags(true)
ind = open_sound("oboe.snd")
mx = mix_vct(Vct.new(100, 0.1), 1000)
- fr = mus_sound_frames("1a.snd")
+ fr = mus_sound_framples("1a.snd")
[[lambda do pad_channel(0, 100) end, 1100, false, :pad0],
[lambda do pad_channel(0, 2000) end, 3000, false, :pad20],
[lambda do pad_channel(800, 100) end, 1100, false, :pad800],
@@ -22267,10 +20561,10 @@ def data_max(beg, fin)
maxval = 0.0
Snd.sounds.each do |snd|
channels(snd).times do |chn|
- scan_chan(lambda do |data|
- maxval = [maxval, data.abs].max
- false
- end, 0, false, snd, chn)
+ scan_channel(lambda do |data|
+ maxval = [maxval, data.abs].max
+ false
+ end, 0, false, snd, chn)
end
end
maxval
@@ -22279,26 +20573,28 @@ end
def data_max2(beg, fin, snd)
maxval = 0.0
channels(snd).times do |chn|
- scan_chan(lambda do |data|
- maxval = [maxval, data.abs].max
- false
- end, 0, false, snd, chn)
+ scan_channel(lambda do |data|
+ maxval = [maxval, data.abs].max
+ false
+ end, 0, false, snd, chn)
end
maxval
end
def data_max1(beg, fin, snd, chn)
maxval = 0.0
- scan_chan(lambda do |data|
- maxval = [maxval, data.abs].max
- false
- end, beg, fin, snd, chn)
+ scan_channel(lambda do |data|
+ maxval = [maxval, data.abs].max
+ false
+ end, beg, fin, snd, chn)
maxval
end
def test_10_00
- ind0 = new_sound("fmv.snd", Mus_aifc, Mus_bshort, 22050, 2, "this is a comment")
- ind1 = new_sound("fmv1.snd", Mus_aifc, Mus_bshort, 22050, 1, "this is a comment")
+ ind0 = new_sound("fmv.snd", 2, 22050, Mus_bshort, Mus_aifc,
+ "this is a comment")
+ ind1 = new_sound("fmv1.snd", 1, 22050, Mus_bshort, Mus_aifc,
+ "this is a comment")
v0 = make_array(10, 1.0)
set_sync(123, ind0)
set_sync(123, ind1)
@@ -22362,7 +20658,8 @@ def test_10_00
close_sound(ind0)
close_sound(ind1)
#
- ind0 = new_sound("fmv.snd", Mus_aifc, Mus_bshort, 22050, 1, "this is a comment")
+ ind0 = new_sound("fmv.snd", 1, 22050, Mus_bshort, Mus_aifc,
+ "this is a comment")
v0 = Vct.new(10, 0.1)
old5 = sample(5, ind0)
insert_samples(10, 10, v0, ind0)
@@ -22389,8 +20686,10 @@ def test_10_00
end
close_sound(ind0)
#
- ind0 = new_sound("fmv.snd", Mus_aifc, Mus_bshort, 22050, 2, "this is a comment")
- ind1 = new_sound("fmv1.snd", Mus_next, Mus_bshort, 22050, 1, "this is a comment")
+ ind0 = new_sound("fmv.snd", 2, 22050, Mus_bshort, Mus_aifc,
+ "this is a comment")
+ ind1 = new_sound("fmv1.snd", 1, 22050, Mus_bshort, Mus_next,
+ "this is a comment")
insert_samples(0, 10, make_array(10, 1.00), ind0, 0)
insert_samples(0, 10, make_array(10, 0.10), ind0, 1)
insert_samples(0, 10, make_array(10, 0.01), ind1, 0)
@@ -22417,7 +20716,8 @@ def test_10_00
end
def test_10_01
- ind0 = new_sound("fmv.snd", Mus_aifc, Mus_bshort, 22050, 2, "this is a comment")
+ ind0 = new_sound("fmv.snd", 2, 22050, Mus_bshort, Mus_aifc,
+ "this is a comment")
mix("oboe.snd")
m1 = add_mark(100)
delete_sample(10)
@@ -22623,10 +20923,10 @@ def test_10_01
end
close_sound(fd)
fd = open_sound("oboe.snd")
- m1 = add_mark(1000)
- m2 = add_mark(2500)
- m3 = add_mark(frames - 4000)
- ms = marks(fd, 0)
+ add_mark(1000)
+ add_mark(2500)
+ add_mark(framples - 4000)
+ marks(fd, 0)
src_sound(-0.5)
unless (res1 = marks(fd, 0)) == (res2 = marks(fd, 0, 0).reverse)
snd_display("src rev marks: %s %s?", res1.inspect, res2.inspect)
@@ -22815,8 +21115,8 @@ def test_10_02
if selection_position != 123
snd_display("selection_position 123: %s?", selection_position)
end
- if selection_frames != 112
- snd_display("selection_frames 112: %s?", selection_frames)
+ if selection_framples != 112
+ snd_display("selection_framples 112: %s?", selection_framples)
end
end
m1 = add_mark(1000, ind, 0)
@@ -22832,8 +21132,8 @@ def test_10_02
if selection_position != 1000
snd_display("selection_position 1000: %s?", selection_position)
end
- if selection_frames != 1001
- snd_display("selection_frames 1001: %s?", selection_frames)
+ if selection_framples != 1001
+ snd_display("selection_framples 1001: %s?", selection_framples)
end
end
set_selection_member?(false, true)
@@ -22842,7 +21142,7 @@ def test_10_02
end
set_selection_member?(true, ind, 0)
set_selection_position(2000, ind, 0)
- set_selection_frames(1234, ind, 0)
+ set_selection_framples(1234, ind, 0)
snap_marks
unless mark?(m1 = find_mark(2000, ind, 0))
snd_display("snap_marks start: %s?", Snd.marks(ind, 0).map do |m| mark_sample(m) end)
@@ -22850,9 +21150,9 @@ def test_10_02
unless mark?(m2 = find_mark(2000 + 1234, ind, 0))
snd_display("snap_marks end: %s?", Snd.marks(ind, 0).map do |m| mark_sample(m) end)
end
- set_selection_position(frames(ind, 0) + 1234, ind, 0)
- if (res = selection_position(ind, 0)) != frames(ind) - 1
- snd_display("selection_position past eof: %s %s?", res, frames(ind) - 1)
+ set_selection_position(framples(ind, 0) + 1234, ind, 0)
+ if (res = selection_position(ind, 0)) != framples(ind) - 1
+ snd_display("selection_position past eof: %s %s?", res, framples(ind) - 1)
end
revert_sound(ind)
src_sound([0, 0.5, 1, 1.75665])
@@ -22886,7 +21186,7 @@ def test_10_02
end
case random(15)
when 0
- beg = random(frames)
+ beg = random(framples)
dur = [1, random(100)].max
insert_silence(beg, dur)
if current_marks and (not current_marks.empty?)
@@ -22919,7 +21219,7 @@ def test_10_02
snd_display("scaling changed mark locations: %s %s?", res, current_samples)
end
when 4
- set_sample(random(frames - 1), 0.5)
+ set_sample(random(framples - 1), 0.5)
unless (res = Snd.marks(ind, 0)) == current_marks
snd_display("set_sample changed marks: %s %s?", res, current_marks)
end
@@ -22927,7 +21227,7 @@ def test_10_02
snd_display("set_sample changed mark location: %s %s?", res, current_samples)
end
when 5
- beg = random(frames)
+ beg = random(framples)
dur = [1, random(100)].max
len = beg + dur
delete_samples(beg, dur)
@@ -22960,7 +21260,7 @@ def test_10_02
end
end
when 8
- rate = (frames > 200000) ? 2.0 : 0.5
+ rate = (framples > 200000) ? 2.0 : 0.5
src_channel(rate)
if current_marks and (not current_marks.empty?)
current_marks.zip(current_samples) do |id, old_loc|
@@ -22980,15 +21280,15 @@ def test_10_02
unless mark?(id)
snd_display("reverse_channel clobbered mark: %s?", id)
else
- if ((frames - old_loc) - (res = mark_sample(id))).abs > 2
+ if ((framples - old_loc) - (res = mark_sample(id))).abs > 2
snd_display("reverse_channel moved mark: %s %s %s (%s)?",
- id, old_loc, frames - old_loc, res)
+ id, old_loc, framples - old_loc, res)
end
end
end
end
else
- add_mark(random(frames - 1))
+ add_mark(random(framples - 1))
end
end
close_sound(ind)
@@ -23038,9 +21338,9 @@ def test_10_02
$draw_mark_hook.add_hook!("snd-test") do |id| true end
m0 = add_mark(4321)
m1 = add_mark(1234)
- dur = frames(ind) / srate(ind).to_f
+ dur = framples(ind) / srate(ind).to_f
pad_marks([m0, m1], 0.01)
- if fneq(res = frames(ind) / srate(ind).to_f, dur + 0.02)
+ if fneq(res = framples(ind) / srate(ind).to_f, dur + 0.02)
snd_display("pad_marks: %s %s?", dur, res)
end
if mark_sample(m0) != 4763 and mark_sample(m0) != 4761
@@ -23054,9 +21354,9 @@ def test_10_02
#
ind = open_sound("oboe.snd")
if res = find_mark(12345)
- snd_display("find_mark when no mark: %s?", res)
+ snd_display("find_mark when no marks: %s?", res)
end
- m0 = add_mark(123, ind, 0)
+ add_mark(123, ind, 0)
delete_sample(0)
m1 = add_mark(23, ind, 0)
set_mark_name(m1, "23")
@@ -23089,7 +21389,7 @@ def test_10_02
snd_display("cannot find 11th mark?")
end
if (m12 = find_mark("23", ind, 0, 2))
- snd_display("found 12th mark: %s %s %s?", m12, mark_sample(m12, 2), mark_name(m12, 2))
+ snd_display("found 12th mark: %s %s %s?", m12, mark_sample(m12, 2), mark_name(m12))
end
set_mark_name(m1, false)
close_sound(ind)
@@ -23236,10 +21536,12 @@ def test_10_02
(m2 and mark_sync(m2) == mark_sync(m3)) or
mark_sync(m3) != mark_sync(m4) or
mark_sync(m3) != mark_sync(m5)
- snd_display("save_marks 2a 20... syncs: %s %s %s?",mark_sync(m3),mark_sync(m4), mark_sync(m5))
+ snd_display("save_marks 2a 20... syncs: %s %s %s?",
+ mark_sync(m3),mark_sync(m4), mark_sync(m5))
end
else
- snd_display("save_marks 2a 20...: %s %s %s?", m3.inspect, m4.inspect, m5.inspect)
+ snd_display("save_marks 2a 20...: %s %s %s?",
+ m3.inspect, m4.inspect, m5.inspect)
end
delete_file("test.marks")
close_sound(ind)
@@ -23250,7 +21552,9 @@ def test_10_02
add_mark(345, ind, 0, false, 1)
add_mark(456, ind, 0, "a mark", 2)
add_mark(567, ind, 0, false, 1)
- $output_comment_hook.add_hook!("mark2string") do |str| marks2string(selected_sound) end
+ $output_comment_hook.add_hook!("mark2string") do |str|
+ marks2string(selected_sound)
+ end
save_sound_as("tst.snd")
new_file_name = file_name(ind)
close_sound(ind)
@@ -23300,10 +21604,10 @@ def test_10_02
add_mark(20)
add_mark(30)
mark_explode
- if File.exists?("mark-0.snd")
+ if File.exist?("mark-0.snd")
ind1 = open_sound("mark-0.snd")
- if frames(ind1, 0) != 10
- snd_display("mark-0 frames: %s?", frames(ind1, 0))
+ if framples(ind1, 0) != 10
+ snd_display("mark-0 framples: %s?", framples(ind1, 0))
end
unless vequal(res = channel2vct, Vct.new(10, 0.1))
snd_display("mark-0 vals: %s?", res)
@@ -23313,10 +21617,10 @@ def test_10_02
else
snd_display("mark_explode did not write mark-0.snd?")
end
- if File.exists?("mark-1.snd")
+ if File.exist?("mark-1.snd")
ind1 = open_sound("mark-1.snd")
- if frames(ind1, 0) != 10
- snd_display("mark-1 frames: %s?", frames(ind1, 0))
+ if framples(ind1, 0) != 10
+ snd_display("mark-1 framples: %s?", framples(ind1, 0))
end
unless vequal(res = channel2vct, Vct.new(10, 0.4))
snd_display("mark-1 vals: %s?", res)
@@ -23326,10 +21630,10 @@ def test_10_02
else
snd_display("mark_explode did not write mark-1.snd?")
end
- if File.exists?("mark-2.snd")
+ if File.exist?("mark-2.snd")
ind1 = open_sound("mark-2.snd")
- if frames(ind1, 0) != 10
- snd_display("mark-2 frames: %s?", frames(ind1, 0))
+ if framples(ind1, 0) != 10
+ snd_display("mark-2 framples: %s?", framples(ind1, 0))
end
unless vequal(res = channel2vct, Vct.new(10, 0.8))
snd_display("mark-2 vals: %s?", res)
@@ -23339,7 +21643,7 @@ def test_10_02
else
snd_display("mark_explode did not write mark-2.snd?")
end
- if File.exists?("mark-3.snd")
+ if File.exist?("mark-3.snd")
snd_display("mark_explode wrote too many files?")
delete_file("mark-3.snd")
end
@@ -23349,7 +21653,6 @@ def test_10_02
end
def test_10
- clear_sincs
test_10_00
test_10_01 if $with_test_gui # load("s61.rb") -> set_transform_size(0)
test_10_02
@@ -23369,7 +21672,6 @@ def test_11
enved_dialog
color_orientation_dialog
transform_dialog
- view_files_dialog
view_regions_dialog
Snd.catch do edit_header_dialog() end
open_file_dialog(false)
@@ -23401,13 +21703,15 @@ def test_11
unless array?(res = snd_urls)
snd_display("snd_urls: %s?", res.inspect)
end
- str2 = snd_help(:open_sound)
+ # XXX: snd_help(:open_sound) => "keyword"
+ # str2 = snd_help(:open_sound) => "keyword"
+ str2 = snd_help(:open_sound.to_s)
str3 = snd_help("open_sound")
unless string_equal_ignore_white_space(str2, str3)
- snd_display("snd_help open_sound: %s %s?", str2, str3)
+ snd_display("snd_help open_sound: expected %s, got %s?", str2, str3)
end
str1 = "(enved-base): envelope editor exponential base value (1.0)"
- str2 = snd_help(:enved_base)
+ str2 = snd_help(:enved_base.to_s)
str3 = snd_help("enved_base")
unless string_equal_ignore_white_space(str1, str2)
snd_display("snd_help :enved_base: expected %s, got %s", str1, str2)
@@ -23416,11 +21720,11 @@ def test_11
snd_display("snd_help \"enved_base\": expected %s, got %s", str1, str3)
end
old_val = Hamming_window
- str1 = snd_help(:Hamming_window)
+ str1 = snd_help(:Hamming_window.to_s)
str2 = snd_help("Hamming_window")
if (not string_equal_ignore_white_space(str1, str2)) or
- (not string_equal_ignore_white_space(str1, "A raised cosine"))
- snd_display("snd_help Hamming_window: %s %s?", str1, str2)
+ (not string_equal_ignore_white_space(str1, "A raised cosine"))
+ snd_display("snd_help Hamming_window: expected %s, got %s?", str1, str2)
end
if (not number?(Hamming_window)) or Hamming_window != old_val
snd_display("snd_help clobbered out-of-module variable: %s %s?", old_val, Hamming_window)
@@ -23437,28 +21741,6 @@ def test_11
help_dialog(fnc, snd_help(fnc, false))
end
end
- #
- set_show_indices(true)
- ind = open_sound("oboe.snd")
- if sound_widgets(ind).length < 4
- snd_display("sound_widgets: %s?", sound_widgets(ind))
- end
- report_in_minibuffer("hi there", ind)
- if (res = widget_text(sound_widgets(ind)[3])) != "hi there"
- snd_display("report_in_minibuffer: %s?", res)
- end
- if (res = widget_text(sound_widgets(ind)[3])) != "hi there"
- snd_display("report_in_minibuffer 1: %s?", res)
- end
- if (res = widget_text(main_widgets[1]))
- snd_display("widget text should be false: %s?", res)
- end
- if (not (res1 = widget_text(sound_widgets(ind)[1]))) or
- res1 != (res2 = format("%s: %s", sound2integer(ind), short_file_name(ind)))
- snd_display("name text: %s %s?", res1, res2)
- end
- clear_minibuffer
- close_sound(ind)
set_show_indices(false)
#
define_envelope("test_ramp", [0, 0, 1, 1])
@@ -23469,113 +21751,13 @@ def test_11
if $test_ramp != [0, 1, 1, 0]
snd_display("re-define-envelope $test_ramp: %s?", $test_ramp)
end
- #
- dialog = view_files_dialog(false)
- vfamp = view_files_amp(dialog)
- vfs = view_files_speed(dialog)
- vfsort = view_files_sort
- vfsort1 = view_files_sort(dialog)
- vfe = view_files_amp_env(dialog)
- vffiles = view_files_files(dialog)
- vfsel = view_files_selected_files(dialog)
- selected_file = false
- if fneq(vfamp, 1.0)
- snd_display("vf amp: %s", vfamp)
- end
- if fneq(vfs, 1.0)
- snd_display("vf speed: %s", vfs)
- end
- if vfsort != 0
- snd_display("vf sort: %s?", vfsort)
- end
- if vfsort1 != 0
- snd_display("vf sort(d): %s?", vfsort1)
- end
- if vfe != [0.0, 1.0, 1.0, 1.0]
- snd_display("vf amp env: %s", vfe)
- end
- unless array?(vffiles) or vffiles.nil?
- snd_display("vf selected files: %s", vffiles.inspect)
- end
- unless array?(vfsel) or vfsel.nil?
- snd_display("vf selected files: %s", vfsel.inspect)
- end
- if (res1 = view_files_speed_style(dialog)) != (res2 = speed_control_style)
- snd_display("vf speed_style def: %s %s", res1, res2)
- end
- old_val = view_files_amp(dialog)
- set_view_files_amp(dialog, 0.5)
- if fneq(res = view_files_amp(dialog), 0.5)
- snd_display("set vf amp: %s", res)
- end
- set_view_files_amp(dialog, old_val)
- old_val = view_files_speed(dialog)
- set_view_files_speed(dialog, 0.5)
- if fneq(res = view_files_speed(dialog), 0.5)
- snd_display("set vf speed: %s", res)
- end
- set_view_files_speed(dialog, old_val)
- old_val = view_files_speed_style(dialog)
- set_view_files_speed_style(dialog, Speed_control_as_ratio)
- if (res = view_files_speed_style(dialog)) != Speed_control_as_ratio
- snd_display("vf speed_style set: %s", res)
- end
- set_view_files_speed_style(dialog, old_val)
-
- old_val = view_files_sort(dialog)
- set_view_files_sort(dialog, 2)
- if (res = view_files_sort()) != 0
- snd_display("vf global sort after local set: %s?", res)
- end
- if (res = view_files_sort(dialog)) != 2
- snd_display("vf local sort after local set: %s?", res)
- end
- set_view_files_sort(4)
- if (res = view_files_sort()) != 4
- snd_display("vf global sort after global set: %s?", res)
- end
- if (res = view_files_sort(dialog)) != 2
- snd_display("vf local sort after global set: %s?", res)
- end
- set_view_files_sort(dialog, old_val)
- old_val = view_files_files(dialog)
- set_view_files_files(dialog, ["oboe.snd", "1a.snd", "pistol.snd", "storm.snd"])
- res = view_files_files(dialog)
- if (!res.member?("1a.snd") and !res.member?(cwd + "1a.snd")) or
- (!res.member?("pistol.snd") and !res.member?(cwd + "pistol.snd")) or
- res.length != 4
- snd_display("vf files set: %s", res)
- end
- old_sel = view_files_selected_files(dialog)
- $view_files_select_hook.reset_hook!
- $view_files_select_hook.add_hook!("test 11") do |w, file|
- unless string?(file)
- snd_display("vf select hook arg: %s", file)
- end
- unless w
- snd_display("vf select hook dialog: %s", w)
- end
- selected_file = file
- end
- set_view_files_selected_files(dialog, ["1a.snd"])
- if !string?(selected_file) or
- (selected_file != "1a.snd" and selected_file != cwd + "1a.snd")
- snd_display("vf set_selected_file select hook arg: %s", selected_file)
- end
- if view_files_selected_files(dialog) != ["1a.snd"] and
- view_files_selected_files(dialog) != [cwd + "1a.snd"]
- snd_display("vf selected_files set: %s", view_files_selected_files(dialog).inspect)
- end
- $view_files_select_hook.reset_hook!
- set_view_files_files(dialog, old_val)
- set_view_files_selected_files(dialog, old_sel)
end
end
# ---------------- test 12: extensions ----------------
def spectral_difference(snd1, snd2)
- size = [frames(snd1), frames(snd2)].max
+ size = [framples(snd1), framples(snd2)].max
pow2 = (log(size) / log(2)).ceil
fftlen = (2 ** pow2).to_i
fdr1 = channel2vct(0, fftlen, snd1, 0)
@@ -23612,9 +21794,9 @@ def test_12
#Snd.catch(:mus_error) do
Snd.catch do
mus_sound_chans(dir).between?(1, 255) and
- mus_sound_data_format(dir) >= 0 and
+ mus_sound_sample_type(dir) >= 0 and
mus_sound_srate(dir) > 0 and
- mus_sound_frames(dir) >= 0 and
+ mus_sound_framples(dir) >= 0 and
sf_dir_files.push(dir)
end
end
@@ -23643,8 +21825,10 @@ def test_12
if len.zero? or random(1.0) > 0.5
name = sf_dir_files[random(sf_dir_files.length).floor]
ht = Snd.catch(:all, 0) do mus_sound_header_type(name) end.first
- df = Snd.catch(:all, 0) do mus_sound_data_format(name) end.first
- fd = if ht == Mus_raw or ht == Mus_unsupported or df == Mus_unknown
+ df = Snd.catch(:all, 0) do mus_sound_sample_type(name) end.first
+ fd = if ht == Mus_raw or
+ ht == Mus_unknown_header or
+ df == Mus_unknown_sample
-1
else
Snd.catch(:all, -1) do view_sound(name) end.first or -1
@@ -23668,19 +21852,17 @@ def test_12
sounds.inspect, Snd.sounds.map do |s| short_file_name(s) end)
end
fd = open_raw_sound(:file, $sf_dir + "addf8.nh",
- :channels, 1, :srate, 8012, :data_format, Mus_mulaw)
- if data_format(fd) != Mus_mulaw
- snd_display("open_raw_sound: %s?", mus_data_format_name(data_format(fd)))
+ :channels, 1, :srate, 8012, :sample_type, Mus_mulaw)
+ if sample_type(fd) != Mus_mulaw
+ snd_display("open_raw_sound: %s?", mus_sample_type_name(sample_type(fd)))
end
close_sound(fd)
#
$bad_header_hook.reset_hook!
- with_time("test_spectral_difference(oboe.snd, oboe.g723_24, 20)") do
- test_spectral_difference("oboe.snd", $sf_dir + "oboe.g723_24", 20.0)
- end
test_spectral_difference($sf_dir + "o2.wave", $sf_dir + "o2_dvi.wave", 10.0)
test_spectral_difference($sf_dir + "wood.riff", $sf_dir + "wood.sds", 4.0)
- test_spectral_difference($sf_dir + "nist-10.wav", $sf_dir + "nist-shortpack.wav", 1.0)
+ test_spectral_difference($sf_dir + "nist-10.wav",
+ $sf_dir + "nist-shortpack.wav", 1.0)
$bad_header_hook.add_hook!("snd-test") do |n| true end
#
# dangling readers (overall)
@@ -23831,7 +22013,7 @@ def test_12
end
end
end
- if File.exists?("s24.snd") and
+ if File.exist?("s24.snd") and
(ffiles != [$sf_dir + "s24.snd"] or
sfiles != [$sf_dir + "s24.snd"])
snd_display("map|for_each_sound_file(s): %s %s?", ffiles, sfiles)
@@ -23993,7 +22175,6 @@ def test_13_00
if $with_test_gui
add_to_menu(mb, "not here", lambda do | | snd_display("oops") end)
remove_from_menu(mb,"not here")
- add_to_menu(3, "Denoise", lambda do | | report_in_minibuffer("denoise") end)
end
$help_hook.reset_hook!
hi = snd_help(:cursor_position)
@@ -24007,13 +22188,9 @@ def test_13_00
"hiho:" + b
end
ho = snd_help(:cursor_position)
- # FIXME
- # HI has one char more than HO:
- # HI: cursor_postion(:optional, snd, chn):
- # HO: (cursor-postion :optional snd chn):
- # That's why +4 instead of +5 like in snd-test.scm.
- if ho.length != (hi.length + 4)
- snd_display("length $help_hook\n\t<[%s]%s>\n\t<[%s]%s>?", hi.length, hi, ho.length, ho)
+ if ho.length != hi.length
+ snd_display("length $help_hook\n\t<[%s]%s>\n\t<[%s]%s>?",
+ hi.length, hi, ho.length, ho)
end
$help_hook.reset_hook!
$help_hook.add_hook!("snd-test") do |a, b| false end
@@ -24023,7 +22200,7 @@ def test_13_00
end
$help_hook.reset_hook!
#
- fr = frames(fd)
+ fr = framples(fd)
chn = chans(fd)
sr = srate(fd)
mx = maxamp(fd)
@@ -24031,12 +22208,10 @@ def test_13_00
if (res = edit_fragment) != ["(cp)", "set", 0, 50828]
snd_display("copyfile: %s?", res)
end
- if fr != frames(fd) or chn != chans(fd) or fneq(mx, maxamp(fd)) or fneq(sr, srate(fd))
- snd_display("copyfile (1): %s %s %s %s?", frames(fd), chans(fd), srate(fd), maxamp(fd))
+ if fr != framples(fd) or chn != chans(fd) or fneq(mx, maxamp(fd)) or fneq(sr, srate(fd))
+ snd_display("copyfile (1): %s %s %s %s?", framples(fd), chans(fd), srate(fd), maxamp(fd))
end
eds = edits
- add_file_to_view_files_list("oboe.snd")
- add_directory_to_view_files_list(".")
select_all
copyfile(true)
if (res = edit_fragment) != ["(cp)", "set", 0, 50828]
@@ -24045,8 +22220,8 @@ def test_13_00
if (res = edits) != [eds[0] + 1, eds[1]]
snd_display("copyfile (select eds): %s %s?", eds, res)
end
- if fr != frames(fd) or chn != chans(fd) or fneq(mx, maxamp(fd)) or fneq(sr, srate(fd))
- snd_display("copyfile (2): %s %s %s %s?", frames(fd), chans(fd), srate(fd), maxamp(fd))
+ if fr != framples(fd) or chn != chans(fd) or fneq(mx, maxamp(fd)) or fneq(sr, srate(fd))
+ snd_display("copyfile (2): %s %s %s %s?", framples(fd), chans(fd), srate(fd), maxamp(fd))
end
#
set_transform_size(256, fd, 0)
@@ -24115,14 +22290,14 @@ def test_13_00
end
$initial_graph_hook.reset_hook!
set_selection_position(1000, fd, 1)
- set_selection_frames(10, fd, 1)
+ set_selection_framples(10, fd, 1)
set_selection_member?(true, fd, 1)
if selection_member?(fd, 0)
snd_display("chan 0 is selection_member?")
end
2.times do |chn|
set_selection_position(1000, fd, chn)
- set_selection_frames(10, fd, chn)
+ set_selection_framples(10, fd, chn)
set_selection_member?(true, fd, chn)
end
scale_selection_to([0.5, 0.25].to_vct)
@@ -24156,46 +22331,9 @@ def test_13_00
key(key_to_int(?x), 4, ind)
key(key_to_int(?o), 0, ind)
key(key_to_int(?x), 4, ind)
- key(key_to_int(?p), 0, ind)
- set_selection_member?(false, true)
- revert_sound(ind)
- set_search_procedure(ind, lambda do |n4| n4 > 0.1 end)
- key(key_to_int(?a), 4, ind, 0)
- if cursor(ind, 0).nonzero?
- snd_display("C-a cursor: %s?", cursor(ind, 0))
- end
- key(key_to_int(?s), 4, ind, 0)
- key(key_to_int(?s), 4, ind, 0)
- if cursor(ind, 0) != 4423
- snd_display("search_procedure C-s C-s cursor: %s?", cursor(ind, 0))
- end
- set_search_procedure(ind, lambda do |n| n > 0.2 end)
- set_cursor(0, ind, 0)
- key(key_to_int(?s), 4, ind, 0)
- key(key_to_int(?s), 4, ind, 0)
- if cursor(ind, 0).nonzero?
- snd_display("search_procedure C-s C-s cursor failed: %s?", cursor(ind, 0))
- end
- snd = chn = 0
- edit_hook(ind, 0).reset_hook!
- edit_hook(ind, 0).add_hook!("snd-test") do | | snd + chn end
- edit_hook(ind, 0).reset_hook!
- after_edit_hook(ind, 0).reset_hook!
- after_edit_hook(ind, 0).add_hook!("snd-test") do | | snd + chn end
- after_edit_hook(ind, 0).reset_hook!
- undo_hook(ind, 0).reset_hook!
- undo_hook(ind, 0).add_hook!("snd-test") do | | snd + chn end
- undo_hook(ind, 0).reset_hook!
- calls = 0
- undo_hook(ind, 0).add_hook!("snd-test") do | | calls += 1 end
- delete_sample(0, ind, 0)
- undo_edit(1)
- redo_edit(1)
+ key(key_to_int(?p), 0, ind)
+ set_selection_member?(false, true)
revert_sound(ind)
- if calls != 3
- snd_display("undo_hook called %s times (3)?", calls)
- end
- undo_hook(ind, 0).reset_hook!
close_sound(ind)
end
@@ -24210,11 +22348,11 @@ def test_13_01
$open_raw_sound_hook.remove_hook!("snd-hook")
if (res = [chans(ind),
srate(ind),
- data_format(ind),
- frames(ind)]) != [1, 22050, Mus_bshort, 23808]
+ sample_type(ind),
+ framples(ind)]) != [1, 22050, Mus_bshort, 23808]
snd_display("open_raw: %s?", res)
end
- set_search_procedure(ind, lambda do |n| n > 0.2 end)
+ set_search_procedure(lambda do |n| n > 0.2 end)
close_sound(ind)
end
save_as_dialog = true
@@ -24227,7 +22365,7 @@ def test_13_01
save_as_dialog = dial
end
ind = open_sound("oboe.snd")
- save_sound_as("test.snd", ind, Mus_raw)
+ save_sound_as("test.snd", ind, :header_type, Mus_raw)
close_sound(ind)
$open_raw_sound_hook.reset_hook!
$after_save_as_hook.reset_hook!
@@ -24250,7 +22388,7 @@ def test_13_01
[2, 44100, Mus_mulaw]
end
ind = open_sound("test.snd")
- if (res = [header_type(ind), data_format(ind), chans(ind), srate(ind), frames(ind)]) \
+ if (res = [header_type(ind), sample_type(ind), chans(ind), srate(ind), framples(ind)]) \
!= [Mus_raw, Mus_mulaw, 2, 44100, 50828]
snd_display("$open_raw_sound_hook 1: %s?", res)
end
@@ -24262,7 +22400,7 @@ def test_13_01
[1, 22050, Mus_lint]
end
ind = open_sound("test.snd")
- if (res = [header_type(ind), data_format(ind), chans(ind), srate(ind), frames(ind)]) \
+ if (res = [header_type(ind), sample_type(ind), chans(ind), srate(ind), framples(ind)]) \
!= [Mus_raw, Mus_lint, 1, 22050, 50828 / 2]
snd_display("$open_raw_sound_hook 2: %s?", res)
end
@@ -24272,7 +22410,7 @@ def test_13_01
[2]
end
ind = open_sound("test.snd")
- if (res = [header_type(ind), data_format(ind), chans(ind), srate(ind)]) \
+ if (res = [header_type(ind), sample_type(ind), chans(ind), srate(ind)]) \
!= [Mus_raw, Mus_lint, 2, 22050]
snd_display("$open_raw_sound_hook 3: %s?", res)
end
@@ -24282,8 +22420,8 @@ def test_13_01
[1, 22050, Mus_bshort, 120, 320]
end
ind = open_sound("test.snd")
- if (res = [header_type(ind), data_format(ind), chans(ind), srate(ind),
- data_location(ind), data_size(ind), frames(ind)]) \
+ if (res = [header_type(ind), sample_type(ind), chans(ind), srate(ind),
+ data_location(ind), data_size(ind), framples(ind)]) \
!= [Mus_raw, Mus_bshort, 1, 22050, 120, 320, 160]
snd_display("$open_raw_sound_hook 4: %s?", res)
end
@@ -24377,10 +22515,12 @@ def test_13_01
cursor
end
$after_transform_hook.add_hook!("snd-test") do |snd, chn, scale|
- if transform_graph?(snd, chn) and transform_graph_type(snd, chn) == Graph_once
- report_in_minibuffer((2 * transform2vct(snd, chn).peak / transform_size(snd, chn)).to_s, snd)
- end
abf = true
+ if transform_graph?(snd, chn) and
+ transform_graph_type(snd, chn) == Graph_once
+ num = (2.0 * transform2vct(snd, chn).peak / transform_size(snd, chn)).to_s
+ status_report(num, snd)
+ end
false
end
set_transform_graph?(true, ind, 0)
@@ -24445,10 +22585,10 @@ def test_13_01
#
spl = stl = ph = ph1 = false
$start_playing_hook.add_hook!("snd-test") do |snd|
+ spl = true
unless snd.eql?(ind)
snd_display("$start_playing_hook: %s not %s?", snd, ind)
end
- spl = true
false
end
$stop_playing_hook.add_hook!("snd-test") do |snd|
@@ -24470,15 +22610,6 @@ def test_13_01
set_reverb_control_feedback(reverb_control_feedback)
ph = true
end
- $dac_hook.add_hook!("snd-test") do |n|
- unless sound_data?(n)
- snd_display("$dac_hook data: %s?", n)
- end
- if sound_data_length(n) < 128 and sound_data_length(n) != 64
- snd_display("$dac_hook data length: %s?", sound_data_length(n))
- end
- ph1 = true
- end
set_expand_control?(true, ind)
set_reverb_control?(true, ind)
play(ind, :wait, true)
@@ -24493,14 +22624,10 @@ def test_13_01
unless ph
snd_display("$play_hook not called?")
end
- unless ph1
- snd_display("$dac_hook not called?")
- end
$start_playing_hook.reset_hook!
$start_playing_selection_hook.reset_hook!
$stop_playing_hook.reset_hook!
$play_hook.reset_hook!
- $dac_hook.reset_hook!
$play_hook.add_hook!("snd-test") do |n|
set_expand_control_hop(0.02)
set_expand_control_length(0.02)
@@ -24509,7 +22636,7 @@ def test_13_01
set_reverb_control_lowpass(0.02)
set_reverb_control_feedback(0.02)
end
- play(ind, :wait, true)
+ # play(ind, :wait, true)
$play_hook.reset_hook!
$start_playing_hook.add_hook!("snd-test") do |snd| true end
play("4.aiff")
@@ -24527,46 +22654,7 @@ def test_13_01
end
$stop_playing_selection_hook.reset_hook!
set_selection_creates_region(old_reg)
- ctr = 0
- $dac_hook.add_hook!("snd-test") do |n|
- ctr += 1
- stop_playing
- end
play(ind, :wait, true)
- if ctr > 2
- snd_display("stop_playing: %s?", ctr)
- end
- $dac_hook.reset_hook!
- #
- pl = make_player(ind, 0)
- ctr = 0
- unless player?(pl)
- snd_display("make_player: %s?", pl)
- end
- if (not players) # players returs nil if empty
- snd_display("players: %s?", players.inspect)
- end
- $dac_hook.add_hook!("snd-test") do |n|
- ctr += 1
- if player?(pl)
- stop_player(pl)
- else
- if ctr == 1
- snd_display("player messed up")
- end
- end
- end
- add_player(pl)
- start_playing(1, 22050, false)
- if ctr > 2
- snd_display("stop_player: %s?", ctr)
- end
- $dac_hook.reset_hook!
- pl = make_player(ind, 0)
- free_player(pl)
- if player?(pl)
- snd_display("free_player: %s?", pl)
- end
#
e0 = e1 = u0 = u1 = a0 = a1 = false
edit_hook(ind, 0).add_hook!("snd-test-1") do | | e0 = true end
@@ -24613,31 +22701,48 @@ def test_13_01
after_edit_hook(ind, 0).reset_hook!
after_edit_hook(other, 0).reset_hook!
#
- se = sw = me = false
- $snd_warning_hook.reset_hook!
$snd_error_hook.reset_hook!
+ $snd_warning_hook.reset_hook!
$mus_error_hook.reset_hook!
- $snd_warning_hook.add_hook!("snd-test") do |msg| sw = true end
- $snd_error_hook.add_hook!("snd-test") do |msg| se = true end
- $mus_error_hook.add_hook!("snd-test") do |type, msg| me = true end
+ se = false
+ sw = false
+ me = false
+ se_msg = "se_msg"
+ sw_msg = "sw_msg"
+ me_msg = "me_msg"
+ $snd_error_hook.add_hook!("snd-test") do |msg|
+ se_msg = msg
+ se = true
+ end
+ $snd_warning_hook.add_hook!("snd-test") do |msg|
+ sw_msg = msg
+ sw = true
+ end
+ $mus_error_hook.add_hook!("snd-test") do |type, msg|
+ me_msg = msg
+ me = true
+ end
snd_error("uhoh")
snd_warning("hiho")
mus_sound_samples("/bad/baddy")
unless se
- snd_display("$snd_error_hook not called?")
+ snd_display("$snd_error_hook not called (%s != uhoh)?", se_msg)
end
unless sw
- snd_display("$snd_warning_hook not called?")
+ snd_display("$snd_warning_hook not called (%s != hiho)?", sw_msg)
end
unless me
- snd_display("$mus_error_hook not called?")
+ snd_display("$mus_error_hook not called (%s)?", me_msg)
end
$snd_error_hook.reset_hook!
$snd_warning_hook.reset_hook!
$mus_error_hook.reset_hook!
- $snd_error_hook.add_hook!("snd-test") do |msg| se = msg; true end
+ $snd_error_hook.add_hook!("snd-test") do |msg|
+ se = msg
+ true
+ end
snd_error("not an error")
- if (not string?(se)) or se != "not an error"
+ if se != "not an error"
snd_display("$snd_error_hook saw: %s?", se)
end
#
@@ -24663,7 +22768,7 @@ def test_13_01
unless sh
snd_display("$save_hook not called?")
end
- if File.exists?("baddy.snd")
+ if File.exist?("baddy.snd")
snd_display("$save_hook did not cancel save?")
delete_file("baddy.snd")
end
@@ -24683,17 +22788,6 @@ def test_13_01
end
def test_13_02
- $print_hook.add_hook!("snd-test") do |str|
- if str[0] == ?[ and (print_length == 30 and
- str != "[1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ...]" or
- print_length == 12 and
- str != "[1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ...]")
- snd_display("array abbreviation: %s?", str)
- end
- false
- end
- snd_print(make_array(128, 1))
- $print_hook.reset_hook!
unless $with_test_alsa
in1 = open_sound("oboe.snd")
in2 = open_sound("2.snd")
@@ -24907,7 +23001,7 @@ def test_13_02
channels(snd).times do |chn|
src_channel(srate(snd).to_f / sr, 0, false, snd, chn)
end
- save_sound_as(fname, snd, :header_type, type, :data_format, fmt, :srate, sr, :comment, com)
+ save_sound_as(fname, snd, :header_type, type, :sample_type, fmt, :srate, sr, :comment, com)
channels(snd).times do |chn| undo_edit(1, snd, chn) end
hook_called = true
true
@@ -24964,7 +23058,8 @@ def test_13_02
set_clipping(true)
set_mus_clipping(true)
$clip_hook.reset_hook!
- index = new_sound("test.snd", Mus_next, Mus_bshort, 22050, 1, "clip-hook test", 10)
+ index = new_sound("test.snd", 1, 22050, Mus_bshort, Mus_next,
+ "clip-hook test", 10)
map_channel(lambda do |y| mus_random(0.999) end)
set_sample(2, 1.0001)
set_sample(4, -1.0)
@@ -25041,11 +23136,11 @@ def test_channel(func)
end
def duration(snd)
- frames(snd) / srate(snd).to_f
+ framples(snd) / srate(snd).to_f
end
def safe_make_selection(beg, fin, snd)
- len = frames(snd)
+ len = framples(snd)
old_choice = selection_creates_region()
set_selection_creates_region(true)
if len > 1
@@ -25079,7 +23174,7 @@ def test_14
if $with_test_gui
cur_dir_files = []
sound_files_in_directory(".").each do |f|
- if Snd.catch(:all, 0) do mus_sound_frames(f) end.first > 0
+ if Snd.catch(:all, 0) do mus_sound_framples(f) end.first > 0
cur_dir_files.push(f)
end
end
@@ -25092,8 +23187,8 @@ def test_14
open_files = []
cur_dir_files.each do |name|
ht = mus_sound_header_type(name)
- df = mus_sound_data_format(name)
- len = mus_sound_frames(name)
+ df = mus_sound_sample_type(name)
+ len = mus_sound_framples(name)
if ht != Mus_raw and len.nonzero? and df != -1
case mus_sound_chans(name)
when 1
@@ -25116,7 +23211,6 @@ def test_14
revert_sound(snd)
end
end
- clear_sincs
files = Snd.sounds.length
delete_file("s61.rb")
Snd.sounds.each do |s|
@@ -25139,7 +23233,7 @@ def test_14
if len.zero?
name = cur_dir_files[random(cur_dir_files.length)]
ht = mus_sound_header_type(name)
- df = mus_sound_data_format(name)
+ df = mus_sound_sample_type(name)
fd = (ht == Mus_raw or df == -1) ? -1 : view_sound(name)
if number?(fd) and fd != -1
open_files.push(fd)
@@ -25160,7 +23254,7 @@ def test_14
end
choose_fd = lambda do Snd.sounds[random(Snd.sounds.length)] end
curfd = choose_fd.call
- curloc = [0, [1200, frames(curfd, 0)].min].max
+ curloc = [0, [1200, framples(curfd, 0)].min].max
old_marks = Snd.marks(curfd, 0).length
if (dur = duration(curfd)) > 0.0
set_x_bounds([0.0, [dur, 1.0].min], curfd)
@@ -25176,11 +23270,11 @@ def test_14
end
set_cursor(curloc, curfd, 0)
cl = cursor(curfd, 0)
- if cl != curloc and (res = frames(curfd, 0)) > curloc
- snd_display("cursor %s != %s (frames: %s)?", cl, curloc, res)
+ if cl != curloc and (res = framples(curfd, 0)) > curloc
+ snd_display("cursor %s != %s (framples: %s)?", cl, curloc, res)
curloc = cursor(curfd, 0)
end
- if curloc >= frames(curfd, 0)
+ if curloc >= framples(curfd, 0)
curloc = 0
end
id = Snd.catch(:all, -1) do add_mark(curloc, curfd) end.car
@@ -25216,7 +23310,7 @@ def test_14
if duration(curfd) > 1.2
set_x_bounds([1.0, 1.1], curfd)
end
- if frames(curfd) > 25
+ if framples(curfd) > 25
add_mark(10, curfd)
add_mark(20, curfd)
key(key_to_int(?m), 0, curfd)
@@ -25232,19 +23326,15 @@ def test_14
end
end
revert_sound
- select_all
+ old_settings = selection_creates_region()
+ set_selection_creates_region(true)
+ reg = select_all()
Snd.catch do
- if region?(0) and selection?
+ if region?(reg) and selection?()
r1 = region_rms(regions.first)
r2 = selection_rms
- r3 = selection_rms
- r4 = region_rms(regions.first)
- if fneq(r1, r4)
- snd_display("region_rms: %s %s?", r1, r4)
- end
- if fneq(r2, r3)
- snd_display("selection_rms: %s %s?", r2, r3)
- end
+ snd_test_neq(r1, r2, "region_rms")
+ set_selection_creates_region(old_settings)
end
end
Snd.catch do
@@ -25252,16 +23342,16 @@ def test_14
play(regions[2], :wait, true)
end
end
- Snd.catch do mix_region(regions[2]) end
- frames < 100000 and play(selected_sound, :wait, true)
+ Snd.catch do
+ mix_region(regions[2])
+ end
+ framples < 100000 and play(selected_sound, :wait, true)
scale_to(0.1, choose_fd.call)
scale_by(2.0, choose_fd.call)
save_controls
set_amp_control(0.5)
test_panel(:amp_control)
restore_controls
- report_in_minibuffer("hi")
- append_to_minibuffer("ho")
Snd.catch do
cfd = choose_fd.call
safe_make_selection(1000, 2000, cfd)
@@ -25324,12 +23414,15 @@ def test_14
open_files.length > 1 and revert_sound(open_files[1])
end
#
- if frames > 1
- make_region(0, frames)
+ frms = framples()
+ if frms > 1 and frms < 10000
+ make_region(0, frms)
convolve_selection_with("fyow.snd", 0.5)
- frames < 100000 and play(selected_sound, :wait, true)
+ play(selected_sound, :wait, true)
+ end
+ if frms > 1 and frms < 10000
+ convolve_with("fyow.snd", 0.25)
end
- convolve_with("fyow.snd", 0.25)
insert_sound("oboe.snd")
$graph_hook.reset_hook!
$after_transform_hook.reset_hook!
@@ -25339,7 +23432,12 @@ def test_14
select_sound(ind)
[[lambda { |beg| insert_sound("2a.snd", beg) }, lambda { |beg| insert_sound("4a.snd", beg) }],
[lambda { |beg| reverse_sound }, lambda { |beg| reverse_sound }],
- [lambda { |beg| convolve_with("2a.snd", 0.5) }, lambda { |beg| src_sound(2.0) }],
+ [lambda { |beg|
+ if framples(ind) < 10000
+ convolve_with("2a.snd", 0.5)
+ else
+ scale_by(2.0)
+ end }, lambda { |beg| src_sound(2.0) }],
[lambda { |beg| env_sound([0, 0, 1, 1, 2, 0]) }, lambda { |beg| env_sound([0, 0, 1, 1]) }],
[lambda { |beg| smooth_sound }, lambda { |beg| insert_silence(beg, 100) }]
].each do |func, func1|
@@ -25356,23 +23454,23 @@ def test_14
revert_sound(ind)
end
delete_samples(0, 1000, ind, 0)
- func.call(2 * frames(ind, 0))
+ func.call(2 * framples(ind, 0))
delete_samples(0, 1000, ind, 0)
- func1.call(2 * frames(ind, 0))
+ func1.call(2 * framples(ind, 0))
revert_sound(ind)
if channels(ind) > 1
delete_samples(0, 1000, ind, 1)
- func.call(2 * frames(ind, 1))
+ func.call(2 * framples(ind, 1))
delete_samples(0, 1000, ind, 1)
- func1.call(2 * frames(ind, 1))
+ func1.call(2 * framples(ind, 1))
revert_sound(ind)
end
end
#
ind = open_sound("z.snd")
restore_controls
- if frames(ind).nonzero?
- snd_display("frames z.snd: %s?", frames(ind))
+ if framples(ind).nonzero?
+ snd_display("framples z.snd: %s?", framples(ind))
end
if samples != false
snd_display("samples of empty file (z): %s?", samples)
@@ -25465,7 +23563,7 @@ def test_14
#
zz = view_sound("z.snd")
select_sound(zz)
- md = mix("4.aiff").car
+ mix("4.aiff").car
add_mark(0)
add_mark(1200)
delete_marks
@@ -25474,7 +23572,7 @@ def test_14
if (res = edit_position(zz)).nonzero?
snd_display("revert_sound edit_position: %s?", res)
end
- s8_snd = (File.exists?("s8.snd") ? "s8.snd" : "oboe.snd")
+ s8_snd = (File.exist?("s8.snd") ? "s8.snd" : "oboe.snd")
as_one_edit_rb do
mix(s8_snd, 24000)
reg = select_all
@@ -25512,9 +23610,7 @@ def test_14
insert_region(reg, 80000)
end
end
- if (res = edit_position) != editctr + 1
- snd_display("as_one_edit s8: %s -> %s?", editctr, res)
- end
+ snd_test_neq(edit_position(), editctr + 1, "as_one_edit s8")
revert_sound(s8)
close_sound(s8)
#
@@ -25522,26 +23618,24 @@ def test_14
if channels(cfd) > 1
uval = random(3)
set_channel_style(uval, cfd)
- if (res = channel_style(cfd)) != uval
- snd_display("channel_style: %s %s?", uval, res)
- end
- end
- src_sound(2.5, 1.0, cfd)
- src_sound(-2.5, 1.0, cfd)
- src_sound(0.5, 1.0, cfd)
- revert_sound(cfd)
- src_sound(-0.5, 1.0, cfd)
- src_sound([0, 0.5, 1, 1.5], 1.0, cfd)
- if frames(cfd) > 0
- src_sound(make_env(:envelope, [0, 0.5, 1, 1.5], :length, frames(cfd)), 1.0, cfd)
+ snd_test_neq(channel_style(cfd), uval, "channel_style")
end
- revert_sound(cfd)
- filter_sound([0, 1, 0.2, 0, 0.5, 1, 1, 0], 20, cfd)
- filter_sound([0, 0, 0.1, 0, 0.11, 1, 0.12, 0, 1, 0], 2048, cfd)
- env_sound([0, 0, 0.5, 1, 1, 0], 0, frames(cfd), 1.0, cfd)
- insert_sample(1200, 0.1, cfd)
- if fneq(res = sample(1200, cfd), 0.1)
- snd_display("insert_sample(looped): %s?", res)
+ if framples(cfd) < 200000
+ src_sound(2.5, 1.0, cfd)
+ src_sound(-2.5, 1.0, cfd)
+ src_sound(0.5, 1.0, cfd)
+ revert_sound(cfd)
+ src_sound(-0.5, 1.0, cfd)
+ src_sound([0, 0.5, 1, 1.5], 1.0, cfd)
+ if framples(cfd) > 0
+ src_sound(make_env([0, 0.5, 1, 1.5], :length, framples(cfd)), 1.0, cfd)
+ end
+ revert_sound(cfd)
+ filter_sound([0, 1, 0.2, 0, 0.5, 1, 1, 0], 20, cfd)
+ filter_sound([0, 0, 0.1, 0, 0.11, 1, 0.12, 0, 1, 0], 2048, cfd)
+ env_sound([0, 0, 0.5, 1, 1, 0], 0, framples(cfd), 1.0, cfd)
+ insert_sample(1200, 0.1, cfd)
+ snd_test_neq(sample(1200, cfd), 0.1, "insert_sample(looped)")
end
revert_sound(cfd)
#
@@ -25553,7 +23647,7 @@ def test_14
set_speed_control(2.0)
test_panel(:speed_control)
apply_controls
- frames < 100000 and play(selected_sound, :wait, true)
+ framples < 100000 and play(selected_sound, :wait, true)
if fneq(res1 = reverb_control_decay(cfd), res2 = reverb_control_decay)
snd_display("reverb_control_decay local: %s, global: %s?", res1, res2)
end
@@ -25564,13 +23658,13 @@ def test_14
test_panel(:reverb_control_lowpass)
test_panel(:reverb_control_feedback)
apply_controls
- frames < 100000 and play(selected_sound, :wait, true)
+ framples < 100000 and play(selected_sound, :wait, true)
set_contrast_control?(true)
set_contrast_control(0.5)
test_panel(:contrast_control)
test_panel(:contrast_control_amp)
apply_controls
- frames < 100000 and play(selected_sound, :wait, true)
+ framples < 100000 and play(selected_sound, :wait, true)
set_expand_control?(true)
set_expand_control(2.5)
test_panel(:expand_control)
@@ -25578,18 +23672,18 @@ def test_14
test_panel(:expand_control_hop)
test_panel(:expand_control_ramp)
apply_controls
- frames < 100000 and play(selected_sound, :wait, true)
+ framples < 100000 and play(selected_sound, :wait, true)
set_filter_control?(true)
set_filter_control_order(40)
test_panel(:filter_control_order)
set_filter_control_envelope([0, 0, 0.1, 1, 0.2, 0, 1, 0])
filter_control_envelope
apply_controls
- frames < 100000 and play(selected_sound, :wait, true)
+ framples < 100000 and play(selected_sound, :wait, true)
set_amp_control(1.5)
test_panel(:amp_control)
apply_controls
- frames < 100000 and play(selected_sound, :wait, true)
+ framples < 100000 and play(selected_sound, :wait, true)
swap_channels(cfd, 0, cfd2, 0)
set_amp_control(0.75, true)
test_panel(:amp_control)
@@ -25621,8 +23715,8 @@ def test_14
snd_display("set_expand_control_ramp 0.025, true: %s?", res)
end
clone = clone_sound_as("/tmp/cloned.snd", cfd2)
- if frames(cfd2) != frames(clone)
- snd_display("clone frames: %s %s?", frames(cfd2), frames(clone))
+ if framples(cfd2) != framples(clone)
+ snd_display("clone framples: %s %s?", framples(cfd2), framples(clone))
end
close_sound(clone)
delete_file("/tmp/cloned.snd")
@@ -25659,15 +23753,18 @@ def test_14
undo_edit(2)
undo_hook.reset_hook!
edit_hook.reset_hook!
- $snd_error_hook.reset_hook!
- $snd_warning_hook.reset_hook!
+ sw_msg = "sw_msg"
$snd_warning_hook.add_hook!("snd-test") do |msg|
+ sw_msg = msg
if msg != "hiho"
snd_display("$snd_warning_hook: %s?", msg)
end
true
end
snd_warning("hiho")
+ if sw_msg != "hiho"
+ snd_display("$snd_warning_hook not called (%s != hiho)?", sw_msg)
+ end
$snd_error_hook.reset_hook!
$snd_warning_hook.reset_hook!
if proc? $my_snd_error_hook
@@ -25683,7 +23780,7 @@ def test_14
test_channel(:transform_graph?)
test_channel(:time_graph?)
test_channel(:lisp_graph?)
- test_channel(:frames)
+ test_channel(:framples)
test_channel(:cursor)
test_channel(:cursor_size)
test_channel(:cursor_style)
@@ -25717,7 +23814,9 @@ def test_14
set_x_bounds([0.1, 0.2])
set_transform_type($fourier_transform)
set_x_bounds([0.1, 0.2])
- $lisp_graph_hook.add_hook!("display_energy") do |snd, chn| display_energy(snd, chn) end
+ $lisp_graph_hook.add_hook!("display_energy") do |snd, chn|
+ display_energy(snd, chn)
+ end
$graph_hook.reset_hook!
if channels() == 2
$graph_hook.add_hook!("correlate") do |snd, chn, y0, y1|
@@ -25732,7 +23831,7 @@ def test_14
buffer = Vct.new(128)
position = 0
current_sample = 0
- chan_samples = frames
+ chan_samples = framples
map_chan_rb do |y|
old_y = buffer[position]
sum_of_squares = (sum_of_squares + y * y) - old_y * old_y
@@ -25764,7 +23863,7 @@ def test_14
#
maxval1 = maxamp + 0.01
unless every_sample? do |y| y < maxval1 end
- res = scan_chan(lambda do |y| y >= maxval1 end)
+ res = scan_channel(lambda do |y| y >= maxval1 end)
snd_display("%s, every_sample?: %s %s [%s: %s]?",
short_file_name, maxval1, res, cursor, sample(cursor))
edit_position.times do |i|
@@ -25781,8 +23880,8 @@ def test_14
end
10.times do |i|
Snd.sounds.each do |snd|
- if frames(snd) > 0
- dur = (frames(snd) / srate(snd).to_f).floor.to_f
+ if framples(snd) > 0
+ dur = (framples(snd) / srate(snd).to_f).floor.to_f
start = [0.0, [dur - 0.1, random(dur)].min].max
if dur > 0.0
set_x_bounds([start, [start + 0.1, dur].min], snd, 0)
@@ -25810,10 +23909,8 @@ def test_14
[:with_tracking_cursor, false, false, true],
[:cursor_size, false, 15, 25],
[:cursor_style, false, Cursor_cross, Cursor_line],
- [:tracking_cursor_style, false, Cursor_cross, Cursor_line],
+ [:tracking_cursor_style, false, Cursor_line, Cursor_cross],
[:clipping, false, false, true],
- [:default_output_chans, false, 1, 8],
- [:default_output_srate, false, 22050, 44100],
[:dot_size, false, 1, 10],
[:enved_base, false, 0.01, 100.0],
[:enved_clip?, false, false, true],
@@ -25835,13 +23932,12 @@ def test_14
[:fft_with_phases, false, false, true],
[:transform_size, false, 16, 128],
[:transform_graph_type, false, Graph_once, Graph_as_spectrogram],
- [:fft_window, false, 0, Dolph_chebyshev_window],
[:transform_graph?, true, false, true],
[:filter_control_in_dB, true, false, true],
[:filter_control_in_hz, true, false, true],
[:filter_control_order, true, 2, 400],
[:filter_control?, true, false, true],
- [:graph_cursor, false, 0, 35],
+ # [:graph_cursor, false, 0, 35],
[:time_graph_style, false, 0, 4],
[:lisp_graph_style, false, 0, 4],
[:transform_graph_style, false, 0, 4],
@@ -25852,7 +23948,6 @@ def test_14
[:log_freq_start, false, 50.0, 5.0],
[:selection_creates_region, false, false, true],
[:transform_normalization, false, Dont_normalize, Normalize_globally],
- [:view_files_sort, false, 0, 3],
[:play_arrow_size, false, 2, 32],
[:print_length, false, 2, 32],
[:region_graph_style, false, Graph_lines, Graph_lollipops],
@@ -25912,7 +24007,6 @@ def test_14
end
end
end
- # save_options("hiho.rb")
if transform_type != $fourier_transform
set_transform_graph?(false, true, true)
set_transform_size([transform_size, 128].min)
@@ -26034,7 +24128,7 @@ end
def test_selection(ind, beg, len, scaler)
set_selection_member?(true, ind, 0)
set_selection_position(beg)
- set_selection_frames(len)
+ set_selection_framples(len)
scale_selection_by(scaler)
diff = 0.0
pos = edit_position(ind, 0)
@@ -26066,7 +24160,7 @@ end
def test_selection_to(ind, beg, len, maxval)
set_selection_member?(true, ind, 0)
set_selection_position(beg)
- set_selection_frames(len)
+ set_selection_framples(len)
scale_selection_to(maxval)
newmax = 0.0
new_reader = make_sampler(beg, ind, 0)
@@ -26108,9 +24202,9 @@ end
def test_15_00
snds = match_sound_files do |file|
- File.exists?(file) and # for $tests > 1
- mus_sound_header_type(file) != Mus_raw and
- mus_sound_chans(file) == 1
+ File.exist?(file) and # for $tests > 1
+ mus_sound_header_type(file) != Mus_raw and
+ mus_sound_chans(file) == 1
end
if snds.length > 0
obi = open_sound(snds.first)
@@ -26118,34 +24212,38 @@ def test_15_00
snd_display("all_chans (1): %s?", all_chans)
end
snds1 = match_sound_files do |file|
- File.exists?(file) and # for $tests > 1
- mus_sound_chans(file) == 2
+ File.exist?(file) and # for $tests > 1
+ mus_sound_chans(file) == 2
end
if snds1.length > 0
s2i = open_sound(snds1.first)
- if all_chans != [[obi, s2i, s2i], [0, 0, 1]] and all_chans != [[s2i, s2i, obi], [0, 1, 0]]
- snd_display("all_chans (2): %s?", all_chans)
- end
- if finfo("oboe.snd") != "oboe.snd: chans: 1, srate: 22050, Sun/Next, big endian short (16 bits), len: 2.305"
- snd_display("finfo: %s?", finfo("oboe.snd"))
- end
+ res = all_chans
+ req1 = [[obi, s2i, s2i], [0, 0, 1]]
+ req2 = [[s2i, s2i, obi], [0, 1, 0]]
+ if res != req1 and res != req2
+ snd_test_neq(res, req1, "all_chans (2a)")
+ snd_test_neq(res, req2, "all_chans (2b)")
+ end
+ res = finfo("oboe.snd")
+ req = "oboe.snd: chans: 1, srate: 22050, Sun/Next, big endian short (16 bits), len: 2.305"
+ snd_test_neq(res, req, "finfo")
close_sound(s2i)
else
snd_display("No sound file found for s2i: %s", snds1)
end
close_sound(obi)
else
- snd_display("No sound file found obi: %s", snds)
- end
- if all_chans != [[], []]
- snd_display("all_chans (3): %s?", all_chans)
+ snd_display("No sound file found obi: %p", snds)
end
+ res = all_chans
+ req = [[], []]
+ snd_test_neq(res, req, "all_chans(0) (3)")
obi = open_sound("oboe.snd")
set_cursor(1000, obi)
- if locate_zero(0.001) != 1050
- snd_display("locate_zero: %s?", locate_zero(0.001))
+ snd_test_neq(locate_zero(0.001), 1050, "locate_zero")
+ $graph_hook.add_hook!("auto_dot") do |snd, chn, y0, y1|
+ auto_dot(snd, chn, y0, y1)
end
- $graph_hook.add_hook!("auto_dot") do |snd, chn, y0, y1| auto_dot(snd, chn, y0, y1) end
$graph_hook.add_hook!("superimpose_ffts") do |snd, chn, y0, y1|
superimpose_ffts(snd, chn, y0, y1)
end
@@ -26153,14 +24251,12 @@ def test_15_00
update_graphs
#
snds = match_sound_files do |file|
- File.exists?(file) and # for $tests > 1
- mus_sound_chans(file) == 2
+ File.exist?(file) and # for $tests > 1
+ mus_sound_chans(file) == 2
end
if snds.length > 0
s2i = open_sound(snds.first)
- if channels(s2i) != 2
- snd_display("match 2 got %s with %s chans", short_file_name(s2i), channels(s2i))
- end
+ snd_test_neq(channels(s2i), 2, "match 2 got %s", short_file_name(s2i))
update_graphs
$graph_hook.remove_hook!("auto_dot")
$graph_hook.remove_hook!("superimpose_ffts")
@@ -26168,103 +24264,101 @@ def test_15_00
select_sound(obi)
m1 = add_mark(100, obi, 0)
first_mark_in_window_at_left
- if (res = left_sample(obi, 0) - 100).abs > 1
- snd_display("first_mark_in_window_at_left: %s %s?", res, mark_sample(m1))
- end
+ res = left_sample(obi, 0) - 100
+ snd_test_gt(res, 1, "first_mark_in_window_at_left %s", mark_sample(m1))
delete_mark(m1)
close_sound(s2i)
else
- snd_display("No sound file found: %s", snds)
+ $graph_hook.remove_hook!("auto_dot")
+ $graph_hook.remove_hook!("superimpose_ffts")
+ snd_display("No sound file found: %p", snds)
end
safe_make_selection(1000, 2000, obi)
- unless selection?
- make_selection(1000, 2000, obi, 0)
- end
delete_selection_and_smooth
- if (res = edit_fragment(0, obi, 0)) != ["", "init", 0, 50828]
- snd_display("edit_fragment (0): %s?", res)
- end
- if (res = edit_fragment(1, obi, 0)) != ["delete_samples(1000, 1001", "delete", 1000, 1001]
- snd_display("edit_fragment (1): %s?", res)
- end
- if (res = edit_fragment(2, obi, 0)) != ["delete_selection_and_smooth(", "set", 968, 64]
- snd_display("edit_fragment (2): %s?", res)
- end
- samp100 = sample(1100, obi, 0)
- select_sound(obi)
- safe_make_selection(1000, 2000, obi)
- unless selection?
- make_selection(1000, 2000, obi, 0)
- end
- eval_over_selection do |val| 2.0 * val end
- nsamp100 = sample(1100, obi, 0)
- if fneq(2.0 * samp100, nsamp100)
- snd_display("eval_over_selection: %s %s [%s %s]?",
- samp100, nsamp100, selection_position, selection_frames)
- end
- m2 = add_mark(1000, obi, 0)
- m3 = add_mark(2000, obi, 0)
- unless (res = marks(obi, 0)).eql?([m2, m3])
- snd_display("add_mark: %s %s?", res, [m2, m3])
- end
- set_left_sample(950, obi, 0)
- eval_between_marks do |val| 2.0 * val end
- msamp100 = sample(1100, obi, 0)
- if fneq(2.0 * nsamp100, msamp100)
- snd_display("eval_between_marks: %s %s?", nsamp100, msamp100)
- end
- revert_sound(obi)
+ res = edit_fragment(0, obi, 0)
+ req = ["", "init", 0, 50828]
+ snd_test_neq(res, req, "edit_fragment (0)")
+ res = edit_fragment(1, obi, 0)
+ req = ["delete_samples(1000, 1001", "delete", 1000, 1001]
+ snd_test_neq(res, req, "edit_fragment (1)")
+ res = edit_fragment(2, obi, 0)
+ req = ["delete-selection-and-smooth", "set", 968, 64]
+ snd_test_neq(res, req, "edit_fragment (2)")
#
maxa = maxamp(obi)
normalized_mix("pistol.snd", 1000, 0, obi, 0)
nmaxa = maxamp(obi)
- if fneq(maxa, nmaxa)
- snd_display("normalized_mix: %s %s?", maxa, nmaxa)
- end
+ snd_test_neq(nmaxa, maxa, "normalized_mix")
revert_sound(obi)
snds = match_sound_files do |file|
- File.exists?(file) and # for $tests > 1
- mus_sound_chans(file) == 2 and
- mus_sound_frames(file) > 1000
+ File.exist?(file) and # for $tests > 1
+ mus_sound_chans(file) == 2 and
+ mus_sound_framples(file) > 1000
end
if snds.length > 0
s2i = open_sound(snds.first)
- if channels(s2i) != 2
- snd_display("match_sound_files: 2+1000 got %s with %s chans?",
- short_file_name(s2i), channels(s2i))
- end
+ res = channels(s2i)
+ snd_test_neq(res, 2,
+ "match_sound_files: 2+1000 got %s with", short_file_name(s2i))
o1 = sample(1000, obi, 0)
s1 = sample(1000, s2i, 0)
s2 = sample(1000, s2i, 1)
- do_all_chans("double all samples") do |val| (val ? (2.0 * val) : false) end
+ do_all_chans("double all samples") do |val|
+ (val ? (2.0 * val) : false)
+ end
o11 = sample(1000, obi, 0)
s11 = sample(1000, s2i, 0)
s21 = sample(1000, s2i, 1)
- if fneq(2.0 * o1, o11) or fneq(2.0 * s1, s11) or fneq(2.0 * s2, s21)
- snd_display("do_all_chans: %s?", [o1, s1, s2, o11, s11, s21])
+ reso1 = 2.0 * o1
+ ress1 = 2.0 * s1
+ ress2 = 2.0 * s2
+ if fneq(reso1, o11) or fneq(ress1, s11) or fneq(ress2, s21)
+ snd_test_neq(reso1, o11, "do_all_chans (a)")
+ snd_test_neq(ress1, s11, "do_all_chans (b)")
+ snd_test_neq(ress2, s21, "do_all_chans (c)")
end
update_graphs
m1 = maxamp(obi, 0)
m2 = maxamp(s2i, 0)
m3 = maxamp(s2i, 1)
- mc = [[obi, 0], [s2i, 0], [s2i, 1]].map do |snd, chn| maxamp(snd, chn) end
+ mc = [[obi, 0], [s2i, 0], [s2i, 1]].map do |snd, chn|
+ maxamp(snd, chn)
+ end
if fneq(m1, mc[0]) or fneq(m2, mc[1]) or fneq(m3, mc[2])
- snd_display("map maxamp: %s %s %s %s?", m1, m2, m3, mc)
+ snd_test_neq(m1, mc[0], "map maxamp (a)")
+ snd_test_neq(m2, mc[1], "map maxamp (b)")
+ snd_test_neq(m3, mc[2], "map maxamp (c)")
end
set_sync(1, obi)
set_sync(1, s2i)
- do_chans("*2") do |val| (val ? (2.0 * val) : false) end
- mc1 = [[obi, 0], [s2i, 0], [s2i, 1]].map do |snd, chn| maxamp(snd, chn) end
- if fneq(2.0 * m1, mc1[0]) or fneq(2.0 * m2, mc1[1]) or fneq(2.0 * m3, mc1[2])
- snd_display("do_chans: %s %s?", mc, mc1)
+ do_chans("*2") do |val|
+ (val ? (2.0 * val) : false)
+ end
+ mc1 = [[obi, 0], [s2i, 0], [s2i, 1]].map do |snd, chn|
+ maxamp(snd, chn)
+ end
+ resm1 = 2.0 * m1
+ resm2 = 2.0 * m2
+ resm3 = 2.0 * m3
+ if fneq(resm1, mc1[0]) or fneq(resm2, mc1[1]) or fneq(resm3, mc1[2])
+ snd_test_neq(resm1, mc1[0], "do_chans (a)")
+ snd_test_neq(resm2, mc1[1], "do_chans (b)")
+ snd_test_neq(resm3, mc1[2], "do_chans (c)")
end
set_sync(0, obi)
set_sync(0, s2i)
select_sound(s2i)
- do_sound_chans("/2") do |val| (val ? (0.5 * val) : false) end
- mc2 = [[obi, 0], [s2i, 0], [s2i, 1]].map do |snd, chn| maxamp(snd, chn) end
- if fneq(2.0 * m1, mc2[0]) or fneq(m2, mc2[1]) or fneq(m3, mc2[2])
- snd_display("do_sound_chans: %s %s %s?", mc, mc1, mc2)
+ do_sound_chans("/2") do |val|
+ (val ? (0.5 * val) : false)
+ end
+ mc2 = [[obi, 0], [s2i, 0], [s2i, 1]].map do |snd, chn|
+ maxamp(snd, chn)
+ end
+ m1 *= 2.0
+ if fneq(m1, mc2[0]) or fneq(m2, mc2[1]) or fneq(m3, mc2[2])
+ snd_test_neq(m1, mc2[0], "do_sound_chans (a)")
+ snd_test_neq(m2, mc2[1], "do_sound_chans (b)")
+ snd_test_neq(m3, mc2[2], "do_sound_chans (c)")
end
if every_sample? do |val| val > 0.5 end
snd_display("every_sample? (0)?")
@@ -26273,13 +24367,13 @@ def test_15_00
snd_display("every_sample? (1)?")
end
select_sound(obi)
- bins = sort_samples(32)
- snd_test_neq(bins[1], 4504, "sort_samples")
+ res = sort_samples(32)[1]
+ snd_test_neq(res, 4504, "sort_samples")
revert_sound(s2i)
revert_sound(obi)
set_sync(3, obi)
set_sync(3, s2i)
- half_way = (0.5 * frames(obi)).floor
+ half_way = (0.5 * framples(obi)).floor
o1 = sample(half_way, obi, 0)
s1 = sample(half_way, s2i, 0)
s2 = sample(half_way, s2i, 1)
@@ -26290,19 +24384,33 @@ def test_15_00
place_sound(obi, s2i, 45.0)
s31 = sample(half_way, s2i, 0)
s32 = sample(half_way, s2i, 1)
- if fneq(s1 + 0.5 * o1, s21) or fneq(s2 + 0.5 * o1, s22) or fneq(s21, s31) or fneq(s22, s32)
- snd_display("place_soundL %s?", [o1, s1, s2, s21, s22, s31, s32])
+ res1 = s1 + 0.5 * o1
+ res2 = s2 + 0.5 * o1
+ if fneq(res1, s21) or fneq(res2, s22) or fneq(s21, s31) or fneq(s22, s32)
+ snd_test_neq(res1, s21, "place_sound (a)")
+ snd_test_neq(res2, s22, "place_sound (b)")
+ snd_test_neq(s21, s31, "place_sound (c)")
+ snd_test_neq(s22, s32, "place_sound (d)")
end
revert_sound(s2i)
revert_sound(obi)
set_sync(0, obi)
set_sync(0, s2i)
- if fneq(res1 = compand.call(0.0), 0.0) or
- fneq(res2 = compand.call(1.0), 1.0) or
- fneq(res3 = compand.call(0.1), 0.2) or
- fneq(res4 = compand.call(0.99), 0.997) or
- fneq(res5 = compand.call(0.95), 0.984)
- snd_display("compand: %s?", [res1, res2, res3, res4, res5])
+ res1 = compand.call(0.0)
+ res2 = compand.call(1.0)
+ res3 = compand.call(0.1)
+ res4 = compand.call(0.99)
+ res5 = compand.call(0.95)
+ if fneq(res1, 0.0) or
+ fneq(res2, 1.0) or
+ fneq(res3, 0.2) or
+ fneq(res4, 0.997) or
+ fneq(res5, 0.984)
+ snd_test_neq(res1, 0.0, "compand (a)")
+ snd_test_neq(res2, 1.0, "compand (b)")
+ snd_test_neq(res3, 0.2, "compand (c)")
+ snd_test_neq(res4, 0.997, "compand (d)")
+ snd_test_neq(res5, 0.984, "compand (e)")
end
close_sound(obi)
revert_sound(s2i)
@@ -26316,25 +24424,28 @@ def test_15_00
Snd.sounds.each do |snd|
channels(snd).times do |chn|
if selection_member?(snd, chn)
- snd_display("%s[%s] at %s?", short_file_name(snd), chn, selection_position(snd, chn))
+ snd_display("%s[%s] at %s?",
+ short_file_name(snd), chn, selection_position(snd, chn))
end
end
end
end
- if selection_srate != srate(s2i)
- snd_display("selection_srate: %s %s?", selection_srate, srate(s2i))
- end
+ res = selection_srate
+ req = srate(s2i)
+ snd_test_neq(res, req, "selection_srate")
if selection_chans == 2
swap_selection_channels
- if fneq(s1, sample(1000, s2i, 1)) or fneq(s2, sample(1000, s2i, 0))
- snd_display("swap_selection_channels: %s?",
- [s1, s2, sample(1000, s2i, 1), sample(1000, s2i, 0)])
+ res1 = sample(1000, s2i, 1)
+ res2 = sample(1000, s2i, 0)
+ if fneq(res1, s1) or fneq(res2, s2)
+ snd_test_neq(res1, s1, "swap_selection_channels (a)")
+ snd_test_neq(res2, s2, "swap_selection_channels (b)")
end
end
revert_sound(s2i)
close_sound(s2i)
else
- snd_display("No sound file found s2i: %s", snds)
+ snd_display("No sound file found s2i: %p", snds)
end
#
obi = open_sound("oboe.snd")
@@ -26349,9 +24460,9 @@ def test_15_00
snd_display("make_region regions: %s?", regions.inspect)
end
revert_sound(obi)
- oldlen = frames(obi)
+ oldlen = framples(obi)
env_sound_interp([0, 0, 1, 1, 2, 0], 2.0, obi, 0)
- newlen = frames(obi)
+ newlen = framples(obi)
if (2 * oldlen - newlen).abs > 3
snd_display("env_sound_interp: %s %s?", oldlen, newlen)
end
@@ -26359,37 +24470,23 @@ def test_15_00
#
revert_sound(obi)
granulated_sound_interp([0, 0, 1, 0.1, 2, 1], 1.0, 0.2, [0, 0, 1, 1, 2, 0])
- if edit_position(obi, 0) != 1
- snd_display("granulated_sound_interp no-op 1?")
- end
- if (res = maxamp(obi, 0)) < 0.15
- snd_display("granulated_sound_interp 1 maxamp: %s?", res)
- end
- if (res = frames(obi, 0) - 50828) > 1000
- snd_display("granulated_sound_interp 1 frames: %s?", res)
- end
+ snd_test_neq(edit_position(obi, 0), 1, "granulated_sound_interp no-op 1")
+ snd_test_lt(maxamp(obi, 0), 0.15, "granulated_sound_interp 1 maxamp")
+ res = (framples(obi, 0) - 50828).abs
+ snd_test_gt(res, 1000, "granulated_sound_interp 1 framples")
revert_sound(obi)
granulated_sound_interp([0, 0, 1, 1], 2.0)
- if edit_position(obi, 0) != 1
- snd_display("granulated_sound_interp no-op 2?")
- end
- if (res = maxamp(obi, 0)) < 0.15
- snd_display("granulated_sound_interp 2 maxamp: %s?", res)
- end
- if (res = frames(obi, 0) - 101656) > 1000
- snd_display("granulated_sound_interp 2 frames: %s?", res)
- end
+ snd_test_neq(edit_position(obi, 0), 1, "granulated_sound_interp no-op 2")
+ snd_test_lt(maxamp(obi, 0), 0.145, "granulated_sound_interp 2 maxamp")
+ res = (framples(obi, 0) - 101656).abs
+ snd_test_gt(res, 1000, "granulated_sound_interp 2 framples")
revert_sound(obi)
- granulated_sound_interp([0, 0, 1, 0.1, 2, 1], 1.0, 0.2, [0, 0, 1, 1, 2, 0], 0.02)
- if edit_position(obi, 0) != 1
- snd_display("granulated_sound_interp no-op 3?")
- end
- if (res = maxamp(obi, 0)) < 0.2
- snd_display("granulated_sound_interp 3 maxamp: %s?", res)
- end
- if (res = frames(obi, 0) - 50828) > 1000
- snd_display("granulated_sound_interp 3 frames: %s?", res)
- end
+ granulated_sound_interp([0, 0, 1, 0.1, 2, 1], 1.0, 0.2,
+ [0, 0, 1, 1, 2, 0], 0.02)
+ snd_test_neq(edit_position(obi, 0), 1, "granulated_sound_interp no-op 3")
+ snd_test_lt(maxamp(obi, 0), 0.2, "granulated_sound_interp 3 maxamp")
+ res = (framples(obi, 0) - 50828).abs
+ snd_test_gt(res, 1000, "granulated_sound_interp 3 framples")
close_sound(obi)
end
@@ -26399,79 +24496,81 @@ def test_15_01
env_sound([0, 0, 1, 1])
osc = make_oscil(:frequency, 1000.0, :initial_phase, PI + HALF_PI)
reader = make_sound_interp(0, ind, 0)
- len = frames(ind, 0) - 1
- map_channel_rb do |val| sound_interp(reader, len * (0.5 + 0.5 * oscil(osc))) end
- unless vequal(res = channel2vct,
- vct(0.000, 0.020, 0.079, 0.172, 0.291, 0.427, 0.569, 0.706, 0.825, 0.919,
- 0.979, 1.000, 0.981, 0.923, 0.831, 0.712, 0.576, 0.434, 0.298, 0.177))
- snd_display("sound_interp: %s?", res)
+ len = framples(ind, 0) - 1
+ map_channel_rb do |val|
+ sound_interp(reader, len * (0.5 + 0.5 * oscil(osc)))
end
+ snd_test_neq(channel2vct(),
+ vct(0.000, 0.020, 0.079, 0.172, 0.291, 0.427, 0.569, 0.706,
+ 0.825, 0.919, 0.979, 1.000, 0.981, 0.923, 0.831, 0.712,
+ 0.576, 0.434, 0.298, 0.177),
+ "sound_interp")
undo_edit
osc = make_oscil(:frequency, 0.5, :initial_phase, PI + HALF_PI)
reader = make_sound_interp(0, ind, 0)
- len = frames(ind, 0) - 1
- map_channel(lambda do |val| sound_interp(reader, len * (0.5 + 0.5 * oscil(osc))) end)
+ len = framples(ind, 0) - 1
+ map_channel(lambda do |val|
+ sound_interp(reader, len * (0.5 + 0.5 * oscil(osc)))
+ end)
undo_edit
env_sound_interp([0, 0, 1, 1])
snd_test_neq(channel2vct(),
- vct(0.000, 0.053, 0.105, 0.158, 0.211, 0.263, 0.316, 0.368, 0.421, 0.474,
- 0.526, 0.579, 0.632, 0.684, 0.737, 0.789, 0.842, 0.895, 0.947, 1.000),
+ vct(0.000, 0.053, 0.105, 0.158, 0.211, 0.263, 0.316, 0.368,
+ 0.421, 0.474, 0.526, 0.579, 0.632, 0.684, 0.737, 0.789,
+ 0.842, 0.895, 0.947, 1.000),
"env_sound_interp no change")
undo_edit
env_sound_interp([0, 0, 1, 0.95, 2, 0], 2.0)
snd_test_neq(channel2vct(),
- vct(0.000, 0.050, 0.100, 0.150, 0.200, 0.250, 0.300, 0.350, 0.400, 0.450,
- 0.500, 0.550, 0.600, 0.650, 0.700, 0.750, 0.800, 0.850, 0.900, 0.950,
- 1.000, 0.950, 0.900, 0.850, 0.800, 0.750, 0.700, 0.650, 0.600, 0.550,
- 0.500, 0.450, 0.400, 0.350, 0.300, 0.250, 0.200, 0.150, 0.100, 0.050),
+ vct(0.000, 0.050, 0.100, 0.150, 0.200, 0.250, 0.300, 0.350,
+ 0.400, 0.450, 0.500, 0.550, 0.600, 0.650, 0.700, 0.750,
+ 0.800, 0.850, 0.900, 0.950, 1.000, 0.950, 0.900, 0.850,
+ 0.800, 0.750, 0.700, 0.650, 0.600, 0.550, 0.500, 0.450,
+ 0.400, 0.350, 0.300, 0.250, 0.200, 0.150, 0.100, 0.050),
"env_sound_interp twice len and back")
revert_sound(ind)
set_sample(10, 0.5)
remove_clicks
- if fneq(sample(10), 0.0)
- snd_display("remove_clicks: %s?", sample(10))
- end
+ snd_test_neq(sample(10), 0.0, "remove_clicks")
undo_edit
val = scan_channel(search_for_click)
- if val != 11
- snd_display("search_for_click: %s?", val)
- end
+ snd_test_neq(val, 11, "search_for_click")
close_sound(ind)
#
id = open_sound("oboe.snd")
- fr = frames(id, 0)
+ fr = framples(id, 0)
mx = maxamp(id, 0)
- set_frames(25000, id, 0)
- if (res = frames(id, 0)) != 25000
- snd_display("set_frames 25000: %s?", res)
+ set_framples(25000, id, 0)
+ if (res = framples(id, 0)) != 25000
+ snd_display("set_framples 25000: %s?", res)
end
if (res = edit_position(id, 0)) != 1
- snd_display("set_frames 25000 edit: %s?", res)
+ snd_display("set_framples 25000 edit: %s?", res)
end
- set_frames(75000, id, 0)
- if (res = frames(id, 0)) != 75000
- snd_display("set_frames 75000: %s?", res)
+ set_framples(75000, id, 0)
+ if (res = framples(id, 0)) != 75000
+ snd_display("set_framples 75000: %s?", res)
end
if (res = edit_position(id, 0)) != 2
- snd_display("set_frames 75000 edit: %s?", res)
+ snd_display("set_framples 75000 edit: %s?", res)
end
if fneq(res = sample(30000, id, 0), 0.0)
- snd_display("set_frames 75000 zeros: %s?", res)
+ snd_display("set_framples 75000 zeros: %s?", res)
end
- set_frames(0, id, 0)
- if (res = frames(id, 0)) != 0
- snd_display("set_frames 0: %s?", res)
+ set_framples(0, id, 0)
+ if (res = framples(id, 0)) != 0
+ snd_display("set_framples 0: %s?", res)
end
- set_frames(100, id, 0)
- if (res = frames(id, 0)) != 100
- snd_display("set_frames 100: %s?", res)
+ set_framples(100, id, 0)
+ if (res = framples(id, 0)) != 100
+ snd_display("set_framples 100: %s?", res)
end
revert_sound
if fneq(res = sample(30000, id, 0), -0.0844)
- snd_display("revert from set_frames: %s?", res)
+ snd_display("revert from set_framples: %s?", res)
end
- if (res = frames(id, 0)) != fr
- snd_display("revert set_frames: %s != %s?", res, fr)
+ if (res = framples(id, 0)) != fr
+ snd_display("revert set_framples: %s != %s?", res, fr)
end
set_maxamp(0.5, id, 0)
if fneq(res = maxamp(id, 0), 0.5)
@@ -26554,16 +24653,17 @@ def test_15_01
if (res = (sound_properties(id) or []).length) != len + 2
snd_display("sound_properties: %s?", res)
end
- if (res = Snd.catch do map_channel(lambda do |y| "hiho" end) end).first != :bad_type
- snd_display("map_channel bad val: %s", res.inspect)
- end
+ # XXX: S7 has here :wrong_type_arg
+ # XXX: Ruby has still :bad_type
+ res = Snd.catch do map_channel(lambda do |y| "hiho" end) end
+ snd_test_neq(res.first, :bad_type, "map_channel bad val")
close_sound(id)
#
id = open_sound("oboe.snd")
prefix_it(1000, id)
key(key_to_int(?x), 4, id)
key(key_to_int(?b), 4, id)
- if (left = left_sample(id)) != 0
+ if (left = left_sample(id)) != 1000
snd_display("u1000: %s?", left)
end
prefix_it(0, id)
@@ -26658,9 +24758,9 @@ def test_15_01
close_sound(id)
#
snds = match_sound_files do |file|
- File.exists?(file) and # for $tests > 1
+ File.exist?(file) and # for $tests > 1
mus_sound_chans(file) >= 2 and
- mus_sound_frames(file) > 1000
+ mus_sound_framples(file) > 1000
end
if snds.length > 0
id = open_sound(snds.first)
@@ -26688,15 +24788,15 @@ def test_15_01
end
def f3neq(a, b)
- fneq_err(a, b, 10) # okay
+ fneq_err(a, b, 10)
end
def f4neq(a, b)
- fneq_err(a, b, 1) # okay
+ fneq_err(a, b, 1)
end
def f5neq(a, b)
- fneq_err(a, b, 0.05 * [a, b].max) # okay
+ fneq_err(a, b, 0.05 * [a, b].max)
end
def test_15_02
@@ -26842,7 +24942,7 @@ def test_15_02
set_with_background_processes(false)
ind = open_sound("1a.snd")
player = make_player(ind, 0)
- len = frames(ind, 0)
+ len = framples(ind, 0)
incr = dac_size
e = make_env(:envelope, [0, 0, 1, 1], :length, (len.to_f / incr).floor + 1)
samp = 0
@@ -26875,12 +24975,12 @@ def test_15_02
if (not (res1 = selection_member?(ind, 0))) or (not (res2 = selection_member?(ind)))
snd_display("selection_member? %s %s %s?", res1, res2, selection?)
end
- if (res = selection_frames) != 1
- snd_display("initial selection_frames: %s?", res)
+ if (res = selection_framples) != 1
+ snd_display("initial selection_framples: %s?", res)
end
- set_selection_frames(1200)
- if (res = selection_frames) != 1200
- snd_display("selection_frames 1200: %s?", res)
+ set_selection_framples(1200)
+ if (res = selection_framples) != 1200
+ snd_display("selection_framples 1200: %s?", res)
end
delete_selection
if selection?
@@ -26893,27 +24993,27 @@ def test_15_02
if (not (res1 = selection_member?(ind, 0))) or (not (res2 = selection_member?(ind)))
snd_display("selection_member? after undo %s %s %s?", res1, res2, selection?)
end
- if (res1 = selection_frames) != 1200 or (res2 = selection_position) != 0
+ if (res1 = selection_framples) != 1200 or (res2 = selection_position) != 0
snd_display("selection after undo: [0, 1200] [%s, %s]?", res2, res1)
end
set_selection_position(1000)
- if (res1 = selection_frames) != 200 or (res2 = selection_position) != 1000
+ if (res1 = selection_framples) != 200 or (res2 = selection_position) != 1000
snd_display("selection after undo: [1000, 200] [%s, %s]?", res2, res1)
end
reverse_selection
- if (res1 = selection_frames) != 200 or (res2 = selection_position) != 1000
+ if (res1 = selection_framples) != 200 or (res2 = selection_position) != 1000
snd_display("selection after reverse: [1000, 200] [%s, %s]?", res2, res1)
end
- old_frames = frames(ind)
+ old_framples = framples(ind)
src_selection(0.5)
- if (frames(ind) - (200 + old_frames)).abs > 5 or
- ((res = selection_frames) - 400).abs > 5
+ if (framples(ind) - (200 + old_framples)).abs > 5 or
+ ((res = selection_framples) - 400).abs > 5
snd_display("selection after src 0.5: [1000, 400] [%s, %s]?", res, selection_position)
end
undo_edit
redo_edit
- if (frames(ind) - (200 + old_frames)).abs > 5 or
- ((res = selection_frames) - 400).abs > 5
+ if (framples(ind) - (200 + old_framples)).abs > 5 or
+ ((res = selection_framples) - 400).abs > 5
snd_display("selection after src 0.5 with undo/redo: [1000, 400] [%s, %s]?",
res, selection_position)
end
@@ -26922,7 +25022,8 @@ def test_15_02
#
# src-duration tests
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1, "src-* tests", 10000)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next,
+ "src-* tests", 10000)
osc = make_oscil(:frequency, 500)
if fneq(res1 = src_duration([0, 1, 1, 2]), 0.693147180559945) or
fneq(res2 = src_duration([0, 2, 1, 1]), src_duration([0, 1, 1, 2])) or
@@ -26962,7 +25063,7 @@ def test_15_02
# src_sound
src_lists1.each do |sr, dur|
src_sound(sr, 1.0, ind, 0)
- if fneq(res = frames(ind, 0) / 10000.0, dur)
+ if fneq(res = framples(ind, 0) / 10000.0, dur)
snd_display("src_sound %s: %s (%s)?", sr, res, dur)
end
vals = freq_peak(0, ind, 8192)
@@ -26973,7 +25074,7 @@ def test_15_02
end
src_lists2.each do |e, f0, f1|
src_sound(e, 1.0, ind, 0)
- if fneq(res1 = frames(ind, 0) / 10000.0, res2 = src_duration(e))
+ if fneq(res1 = framples(ind, 0) / 10000.0, res2 = src_duration(e))
snd_display("src_sound (env) %s: %s (%s)?", e, res1, res2)
end
vals = freq_peak(0, ind, 256)
@@ -26987,8 +25088,8 @@ def test_15_02
undo_edit
end
src_lists2.each do |e, f0, f1|
- src_sound(make_env(:envelope, e, :length, frames), 1.0, ind, 0)
- if fneq(res1 = frames(ind, 0) / 10000.0, res2 = src_duration(e))
+ src_sound(make_env(:envelope, e, :length, framples), 1.0, ind, 0)
+ if fneq(res1 = framples(ind, 0) / 10000.0, res2 = src_duration(e))
snd_display("src_sound (make_env) %s: %s (%s)?", e, res1, res2)
end
vals = freq_peak(0, ind, 256)
@@ -27004,7 +25105,7 @@ def test_15_02
# src_channel
src_lists1.each do |sr, dur|
src_channel(sr)
- if fneq(res = frames(ind, 0) / 10000.0, dur)
+ if fneq(res = framples(ind, 0) / 10000.0, dur)
snd_display("src_channel %s: %s (%s)?", sr, res, dur)
end
vals = freq_peak(0, ind, 8192)
@@ -27015,7 +25116,7 @@ def test_15_02
end
src_lists2.each do |e, f0, f1|
src_channel(e)
- if fneq(res1 = frames(ind, 0) / 10000.0, res2 = src_duration(e))
+ if fneq(res1 = framples(ind, 0) / 10000.0, res2 = src_duration(e))
snd_display("src_channel (env) %s: %s (%s)?", e, res1, res2)
end
vals = freq_peak(0, ind, 256)
@@ -27030,7 +25131,7 @@ def test_15_02
end
src_lists1.each do |sr, dur|
src_channel(sr, 1000, 2500)
- if f4neq(res1 = frames(ind, 0), (res2 = 7500 + dur * 2500))
+ if f4neq(res1 = framples(ind, 0), (res2 = 7500 + dur * 2500))
snd_display("src_channel section: %s %s?", res1, res)
end
vals = freq_peak(0, ind, 512)
@@ -27049,7 +25150,7 @@ def test_15_02
end
src_lists3.each do |e|
src_channel(make_env(:envelope, e, :length, 2501), 1000, 2500)
- if f3neq(res1 = frames(ind, 0), (res2 = 7500 + src_duration(e) * 2500))
+ if f3neq(res1 = framples(ind, 0), (res2 = 7500 + src_duration(e) * 2500))
snd_display("src_channel section (make_env duration) %s: %s (%s %s)?",
e, src_duration(e), res1, res2)
end
@@ -27067,7 +25168,7 @@ def test_15_02
make_selection(1000, 3500, ind, 0)
src_lists1.each do |sr, dur|
src_selection(sr)
- if f3neq(res1 = frames(ind, 0), (res2 = 7500 + dur * 2500))
+ if f3neq(res1 = framples(ind, 0), (res2 = 7500 + dur * 2500))
snd_display("src_selection section: %s %s?", res1, res)
end
vals = freq_peak(0, ind, 512)
@@ -27086,7 +25187,7 @@ def test_15_02
end
src_lists3.each do |e|
src_selection(make_env(:envelope, e, :length, 2501))
- if f3neq(res1 = frames(ind, 0), (res2 = 7500 + src_duration(e) * 2500))
+ if f3neq(res1 = framples(ind, 0), (res2 = 7500 + src_duration(e) * 2500))
snd_display("src_selection section (make_env duration) %s: %s (%s %s)?",
e, src_duration(e), res1, res2)
end
@@ -27102,7 +25203,7 @@ def test_15_02
end
src_lists3.each do |e|
src_selection(e)
- if f3neq(res1 = frames(ind, 0), (res2 = 7500 + src_duration(e) * 2500))
+ if f3neq(res1 = framples(ind, 0), (res2 = 7500 + src_duration(e) * 2500))
snd_display("src_selection section (env duration) %s: %s (%s %s)?",
e, src_duration(e), res1, res2)
end
@@ -27156,28 +25257,16 @@ def test_15_03
delete_file("hi.snd")
#
ind = open_sound("oboe.snd")
- len = frames(ind)
+ len = framples(ind)
set_cursor(1200, ind)
key(key_to_int(?u), 4, ind)
key(key_to_int(?1), 0, ind)
key(key_to_int(?0), 0, ind)
key(key_to_int(?0), 0, ind)
key(key_to_int(?o), 4, ind)
- if frames(ind) != 100 + len
- snd_display("C-o len: %s?", frames)
- end
- if $with_test_gui
- reader = make_sampler(1200, ind)
- 100.times do |i|
- if fneq(val = next_sample(reader), 0.0)
- snd_display("C-o[%s]: %s?", i, val)
- end
- end
- if (res = sampler_position(reader)) != 1300
- snd_display("reader position: %s?", res)
- end
- free_sampler(reader)
- end
+ snd_test_neq(framples(ind), 100 + len, "C-o len")
+ data = channel2vct(1200, 100, ind)
+ snd_test_neq(vct_peak(data), 0.0, "C-o")
revert_sound(ind)
set_cursor(1200, ind)
key(key_to_int(?u), 4, ind)
@@ -27185,18 +25274,9 @@ def test_15_03
key(key_to_int(?0), 0, ind)
key(key_to_int(?0), 0, ind)
key(key_to_int(?z), 4, ind)
- if frames(ind) != len
- snd_display("C-z len: %s?", frames)
- end
- if $with_test_gui
- reader = make_sampler(1200, ind)
- 100.times do |i|
- if fneq(val = next_sample(reader), 0.0)
- snd_display("C-z[%s]: %s?", i, val)
- end
- end
- free_sampler(reader)
- end
+ snd_test_neq(framples(ind), len, "C-z len")
+ data = channel2vct(1200, 100, ind)
+ snd_test_neq(vct_peak(data), 0.0, "C-z")
set_cursor(0, ind)
key(key_to_int(?u), 4, ind)
key(key_to_int(?3), 0, ind)
@@ -27213,18 +25293,9 @@ def test_15_03
key(key_to_int(?.), 0, ind)
key(key_to_int(?0), 0, ind)
key(key_to_int(?o), 4, ind)
- if frames(ind) != srate(ind) + len
- snd_display("C-o 1.0 len: %s?", frames)
- end
- if $with_test_gui
- reader = make_sampler(1200, ind)
- srate(ind).times do |i|
- if fneq(val = next_sample(reader), 0.0)
- snd_display("C-o 1.0[%s]: %s?", i, val)
- end
- end
- free_sampler(reader)
- end
+ snd_test_neq(framples(ind), len + srate(ind), "C-o 1.0 len")
+ data = channel2vct(1200, 100, ind)
+ snd_test_neq(vct_peak(data), 0.0, "C-o 1.0")
revert_sound(ind)
set_cursor(1200, ind)
key(key_to_int(?u), 4, ind)
@@ -27232,18 +25303,9 @@ def test_15_03
key(key_to_int(?.), 0, ind)
key(key_to_int(?0), 0, ind)
key(key_to_int(?z), 4, ind)
- if frames(ind) != len
- snd_display("C-z 1.0 len: %s?", frames)
- end
- if $with_test_gui
- reader = make_sampler(1200, ind)
- srate(ind).times do |i|
- if fneq(val = next_sample(reader), 0.0)
- snd_display("C-z 1.0[%s]: %s?", i, val)
- end
- end
- free_sampler(reader)
- end
+ snd_test_neq(framples(ind), len, "C-z 1.0 len")
+ data = channel2vct(1200, srate(ind), ind)
+ snd_test_neq(vct_peak(data), 0.0, "C-z 1.0")
close_sound(ind)
#
ind = open_sound("2.snd")
@@ -27255,8 +25317,8 @@ def test_15_03
(not (res2 = selection_member?(ind, 1))) or
(res3 = selection_position(ind, 0)) != 0 or
(res4 = selection_position(ind, 1)) != 0 or
- (res5 = selection_frames(ind, 0)) != frames(ind, 0) or
- (res6 = selection_frames(ind, 1)) != frames(ind, 1)
+ (res5 = selection_framples(ind, 0)) != framples(ind, 0) or
+ (res6 = selection_framples(ind, 1)) != framples(ind, 1)
snd_display("sync selection via <-: %s %s %s %s %s %s?", res1, res2, res3, res4, res5, res6)
end
key(key_to_int(?\s), 4)
@@ -27265,8 +25327,8 @@ def test_15_03
(not (res2 = selection_member?(ind, 1))) or
(res3 = selection_position(ind, 0)) != 0 or
(res4 = selection_position(ind, 1)) != 0 or
- (res5 = selection_frames(ind, 0)) != frames(ind, 0) or
- (res6 = selection_frames(ind, 1)) != frames(ind, 1)
+ (res5 = selection_framples(ind, 0)) != framples(ind, 0) or
+ (res6 = selection_framples(ind, 1)) != framples(ind, 1)
snd_display("sync selection via ->: %s %s %s %s %s %s?", res1, res2, res3, res4, res5, res6)
end
set_cursor(0, ind, 1)
@@ -27294,7 +25356,7 @@ def test_15_03
unless selection?
snd_display("no selection from 1 samp region?")
end
- if (res = selection_frames) != 1
+ if (res = selection_framples) != 1
snd_display("1 samp selection: %s samps?", res)
end
scale_selection_to(1.0)
@@ -27304,23 +25366,23 @@ def test_15_03
revert_sound(ind)
id = make_region(500, 1000)
src_selection(0.5)
- if ((res = region_frames(id)) - 500).abs > 1
- snd_display("region_frames after src_selection: %s?", res)
+ if ((res = region_framples(id)) - 500).abs > 1
+ snd_display("region_framples after src_selection: %s?", res)
end
reg_mix_id = mix_region(id, 1500, ind, 0).car
- if (res1 = mix_length(reg_mix_id)) != (res2 = region_frames(id))
+ if (res1 = mix_length(reg_mix_id)) != (res2 = region_framples(id))
snd_display("mix_region: %s != %s?", res1, res2)
end
if (res = mix_home(reg_mix_id)) != [ind, 0, false, 0]
snd_display("mix_region mix_home %s [%s, 0, false, 0]?", res, ind)
end
sel_mix_id = mix_selection(2500, ind, 0).car
- if (res1 = mix_length(sel_mix_id)) != (res2 = selection_frames)
- snd_display("mix_selection frames: %s != %s?", res1, res2)
+ if (res1 = mix_length(sel_mix_id)) != (res2 = selection_framples)
+ snd_display("mix_selection framples: %s != %s?", res1, res2)
end
if ((res1 = mix_length(reg_mix_id)) * 2 - (res2 = mix_length(sel_mix_id))).abs > 3
snd_display("mix selection and region: %s %s %s %s?",
- res1, res2, region_frames(id), selection_frames)
+ res1, res2, region_framples(id), selection_framples)
end
if (res = mix_home(reg_mix_id)) != [ind, 0, false, 0]
snd_display("mix_selection mix_home %s [%s, 0, false, 0]?", res, ind)
@@ -27332,7 +25394,7 @@ def test_15_03
revert_sound(ind)
close_sound(ind)
#
- if File.exists?("storm.snd")
+ if File.exist?("storm.snd")
ind = open_sound("storm.snd")
set_sinc_width(10)
with_time("src_sound(1.3)") do src_sound(1.3) end
@@ -27352,7 +25414,7 @@ def test_15_03
ramp_channel(0.0, 1.0)
close_sound(ind)
end
- if File.exists?("1a.snd") and $all_args
+ if File.exist?("1a.snd") and $all_args
ind = open_sound("1a.snd")
with_time("rubber_sound(1.25)") do rubber_sound(1.25) end
close_sound(ind)
@@ -27360,12 +25422,7 @@ def test_15_03
oboe = open_sound("oboe.snd")
a4 = open_sound("4.aiff")
sr = srate(oboe)
- fr = frames(oboe, 0)
- typ = header_type(oboe)
- frm = data_format(oboe)
- loc = data_location(oboe)
- com = comment(oboe)
- save_sound_as("test.aif", oboe, Mus_aifc)
+ save_sound_as("test.aif", oboe, :header_type, Mus_aifc)
oboe_aif = open_sound("test.aif")
if (res = header_type(oboe_aif)) != Mus_aifc
snd_display("oboe_aif header: %s?", mus_header_type_name(res))
@@ -27382,11 +25439,11 @@ def test_15_03
if (res = data_location(oboe_aif)) != 28
snd_display("set_data_location: %s?", res)
end
- set_data_format(oboe_aif, Mus_mulaw)
- if (res = data_format(oboe_aif)) != Mus_mulaw
- snd_display("set_data_format: %s?", mus_data_format_name(res))
+ set_sample_type(oboe_aif, Mus_mulaw)
+ if (res = sample_type(oboe_aif)) != Mus_mulaw
+ snd_display("set_sample_type: %s?", mus_sample_type_name(res))
end
- save_sound_as("test.aif", oboe_aif, Mus_aifc, Mus_bshort, 22050, 0)
+ save_sound_as("test.aif", oboe_aif, 22050, Mus_bshort, Mus_aifc, 0)
close_sound(oboe_aif)
delete_file("test.aif")
set_selected_sound(a4)
@@ -27539,7 +25596,7 @@ def test_15_04
make_selection(5, 9, ind, 0)
scale_selection_to(0.5)
insert_selection(15, ind)
- if (res = frames(ind)) != 25
+ if (res = framples(ind)) != 25
snd_display("insert_selection 5: %s?", res)
end
unless vequal(res = channel2vct(0, 25),
@@ -27559,7 +25616,10 @@ def test_15_04
old_type = transform_type
old_norm = transform_normalization
old_grf = transform_graph_type
- v = Vct.new(2000) do |i| sin(i * 2.0 * (PI / 10)) end
+ e = make_env([0, 0, 1, 2000 * 0.2 * PI], :length, 2001)
+ v = Vct.new(2000) do |i|
+ sin(env(e))
+ end
vct2channel(v, 0, 2000, ind, 0)
set_transform_size(256, ind)
set_transform_type($fourier_transform)
@@ -27569,7 +25629,7 @@ def test_15_04
set_transform_graph?(true)
make_selection(0, 200)
set_show_selection_transform(true)
- set_selection_frames(300)
+ set_selection_framples(300)
update_transform_graph
if vct?(data = transform2vct)
pk = data.peak
@@ -27610,7 +25670,7 @@ end
def undo_env(snd, chn)
if (len = (edits(snd, chn) or []).first) > 0
1.upto(len) do |i|
- if (ed = edit_fragment(i, snd, chn)) and (ed[1] == "env" or ed[1] == "ptree")
+ if (ed = edit_fragment(i, snd, chn)) and ed[1] == "env"
set_edit_position(i - 1, snd, chn)
return true
end
@@ -27626,15 +25686,15 @@ def opt_test(choice)
curchn = random(channels(cursnd))
cur_maxamps = []
cur_edits = []
- cur_frames = []
+ cur_framples = []
all_chans_zipped.each do |s, c|
cur_maxamps << maxamp(s, c)
cur_edits << edit_position(s, c)
- cur_frames << frames(s, c)
+ cur_framples << framples(s, c)
end
cur_amp = maxamp(cursnd, curchn)
cur_edit = edit_position(cursnd, curchn)
- cur_frame = frames(cursnd, curchn)
+ cur_frame = framples(cursnd, curchn)
snd_lst, chn_lst = all_chans
case choice
when 0 # scale_channel
@@ -27646,8 +25706,8 @@ def opt_test(choice)
snd_display("scale_channel %s[%s] edit pos: %s %s?",
short_file_name(cursnd), curchn, res, cur_edit)
end
- if (res = frames(cursnd, curchn)) != cur_frame
- snd_display("scale_channel %s[%s] frames: %s %s?",
+ if (res = framples(cursnd, curchn)) != cur_frame
+ snd_display("scale_channel %s[%s] framples: %s %s?",
short_file_name(cursnd), curchn, res, cur_frame)
end
if fneq(res1 = maxamp(cursnd, curchn), res2 = scaler * cur_amp)
@@ -27658,13 +25718,13 @@ def opt_test(choice)
snd_display("scale_channel %s[%s] cur_samp: %s %s?",
short_file_name(cursnd), curchn, res1, res2)
end
- snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_frames) do |s, c, amp, ed, fr|
+ snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_framples) do |s, c, amp, ed, fr|
if (not s == cursnd and c == curchn)
if (res = edit_position(s, c)) != ed
snd_display("scale_channel %s[%s] wrong edit pos: %s %s?", short_file_name(s), c, res, ed)
end
- if (res = frames(s, c)) != fr
- snd_display("scale_channel %s[%s] wrong frames: %s %s?", short_file_name(s), c, res, fr)
+ if (res = framples(s, c)) != fr
+ snd_display("scale_channel %s[%s] wrong framples: %s %s?", short_file_name(s), c, res, fr)
end
if fneq(res = maxamp(s, c), amp)
snd_display("scale_channel %s[%s] wrong maxamp: %s %s?", short_file_name(s), c, res, amp)
@@ -27675,13 +25735,13 @@ def opt_test(choice)
maxscl = cur_maxamps.max
scaler = (maxscl < 1.0) ? (random(1.0) + 1.0) : (random(0.5) + 0.5)
scale_by(scaler, cursnd, curchn)
- snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_frames) do |s, c, amp, ed, fr|
+ snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_framples) do |s, c, amp, ed, fr|
if (sync(cursnd) == 0 and (s != cursnd or c != curchn)) or (sync(s) != sync(cursnd))
if (res = edit_position(s, c)) != ed
snd_display("scale_by %s[%s] wrong edit pos: %s %s?", short_file_name(s), c, res, ed)
end
- if (res = frames(s, c)) != fr
- snd_display("scale_by %s[%s] wrong frames: %s %s?", short_file_name(s), c, res, fr)
+ if (res = framples(s, c)) != fr
+ snd_display("scale_by %s[%s] wrong framples: %s %s?", short_file_name(s), c, res, fr)
end
if fneq(res = maxamp(s, c), amp)
snd_display("scale_by %s[%s] wrong maxamp: %s %s?", short_file_name(s), c, res, amp)
@@ -27690,11 +25750,12 @@ def opt_test(choice)
if (res = edit_position(s, c)) != ed + 1 and res != ed
snd_display("scale_by %s[%s] wrong edit pos: %s %s?", short_file_name(s), c, res, ed + 1)
end
- if (res = frames(s, c)) != fr
- snd_display("scale_by %s[%s] wrong frames: %s %s?", short_file_name(s), c, res, fr)
+ if (res = framples(s, c)) != fr
+ snd_display("scale_by %s[%s] wrong framples: %s %s?", short_file_name(s), c, res, fr)
end
if fneq(res1 = maxamp(s, c), res2 = amp * scaler)
- snd_display("scale_by %s[%s] wrong maxamp: %s %s?", short_file_name(s), c, res1, res2)
+ snd_display("scale_by %s[%s] wrong maxamp: %s %s?",
+ short_file_name(s), c, res1, res2)
end
end
end
@@ -27706,7 +25767,7 @@ def opt_test(choice)
0.step(pts - 1, 2) do |i|
e[i] = x
if random(3) > 0
- y = random(2.0) - 1.0
+ y = mus_random(1.0)
end
e[i + 1] = y
if y.abs > maxpt
@@ -27717,14 +25778,14 @@ def opt_test(choice)
if undo_env(cursnd, curchn)
cur_maxamps = []
cur_edits = []
- cur_frames = []
+ cur_framples = []
all_chans_zipped.each do |s, c|
cur_maxamps << maxamp(s, c)
cur_edits << edit_position(s, c)
- cur_frames << frames(s, c)
+ cur_framples << framples(s, c)
cur_amp = maxamp(cursnd, curchn)
cur_edit = edit_position(cursnd, curchn)
- cur_frame = frames(cursnd, curchn)
+ cur_frame = framples(cursnd, curchn)
end
end
env_channel(e, 0, cur_frame, cursnd, curchn)
@@ -27732,8 +25793,8 @@ def opt_test(choice)
snd_display("env_channel %s[%s] edit pos: %s %s?",
short_file_name(cursnd), curchn, res, cur_edit + 1)
end
- if (res = frames(cursnd, curchn)) != cur_frame
- snd_display("env_channel %s[%s] frames: %s %s?",
+ if (res = framples(cursnd, curchn)) != cur_frame
+ snd_display("env_channel %s[%s] framples: %s %s?",
short_file_name(cursnd), curchn, res, cur_frame)
end
if (res1 = maxamp(cursnd, curchn)) - 0.01 > (res2 = maxpt * cur_amp)
@@ -27741,13 +25802,13 @@ def opt_test(choice)
short_file_name(cursnd), curchn, res1, res2, e)
Snd.throw(:mus_error, "env_channel maxamp", short_file_name(cursnd))
end
- snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_frames) do |s, c, amp, ed, fr|
+ snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_framples) do |s, c, amp, ed, fr|
unless s == cursnd and c == curchn
if (res = edit_position(s, c)) != ed
snd_display("env_channel %s[%s] wrong edit pos: %s %s?", short_file_name(s), c, res, ed)
end
- if (res = frames(s, c)) != fr
- snd_display("env_channel %s[%s] wrong frames: %s %s?", short_file_name(s), c, res, fr)
+ if (res = framples(s, c)) != fr
+ snd_display("env_channel %s[%s] wrong framples: %s %s?", short_file_name(s), c, res, fr)
end
if fneq(res = maxamp(s, c), amp)
snd_display("env_channel %s[%s] wrong maxamp: %s %s?", short_file_name(s), c, res, amp)
@@ -27762,7 +25823,7 @@ def opt_test(choice)
0.step(pts - 1, 2) do |i|
e[i] = x
if random(3) > 0
- y = random(2.0) - 1.0
+ y = mus_random(1.0)
end
e[i + 1] = y
if y.abs > maxpt
@@ -27771,7 +25832,7 @@ def opt_test(choice)
x += 0.01 + random(1.0)
end
recalc = false
- minfr = cur_frames.min
+ minfr = cur_framples.min
beg = random((minfr / 2.0).floor)
all_chans_zipped.each do |s, c|
unless (sync(cursnd) == 0 and (s != cursnd or c != curchn)) or sync(s) != sync(cursnd)
@@ -27781,24 +25842,24 @@ def opt_test(choice)
if recalc
cur_maxamps = []
cur_edits = []
- cur_frames = []
+ cur_framples = []
all_chans_zipped.each do |s, c|
cur_maxamps << maxamp(s, c)
cur_edits << edit_position(s, c)
- cur_frames << frames(s, c)
+ cur_framples << framples(s, c)
end
cur_amp = maxamp(cursnd, curchn)
cur_edit = edit_position(cursnd, curchn)
- cur_frame = frames(cursnd, curchn)
+ cur_frame = framples(cursnd, curchn)
end
env_sound(e, beg, [pts, minfr - beg].max, 1.0, cursnd, curchn)
- snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_frames) do |s, c, amp, ed, fr|
+ snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_framples) do |s, c, amp, ed, fr|
if (sync(cursnd) == 0 and (s != cursnd or c != curchn)) or sync(s) != sync(cursnd)
if (res = edit_position(s, c)) != ed
snd_display("env_sound %s[%s] wrong edit pos: %s %s?", short_file_name(s), c, res, ed)
end
- if (res = frames(s, c)) != fr
- snd_display("env_sound %s[%s] wrong frames: %s %s?", short_file_name(s), c, res, fr)
+ if (res = framples(s, c)) != fr
+ snd_display("env_sound %s[%s] wrong framples: %s %s?", short_file_name(s), c, res, fr)
end
if fneq(res = maxamp(s, c), amp)
snd_display("env_sound %s[%s] wrong maxamp: %s %s?", short_file_name(s), c, res, amp)
@@ -27807,8 +25868,8 @@ def opt_test(choice)
if (res = edit_position(s, c)) != ed + 1 and res != ed
snd_display("env_sound %s[%s] edit pos: %s %s?", short_file_name(s), c, res, ed + 1)
end
- if (res = frames(s, c)) != fr
- snd_display("env_sound %s[%s] frames: fr %s orig_fr %s?", short_file_name(s), c, res, fr)
+ if (res = framples(s, c)) != fr
+ snd_display("env_sound %s[%s] framples: fr %s orig_fr %s?", short_file_name(s), c, res, fr)
end
end
end
@@ -27816,14 +25877,14 @@ def opt_test(choice)
maxscl = cur_maxamps.max
scaler = (maxscl < 1.0) ? (random(1.0) + 1.0) : (random(0.5) + 0.5)
scale_sound_by(scaler, 1000, 1000, cursnd)
- snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_frames) do |s, c, amp, ed, fr|
+ snd_lst.zip(chn_lst, cur_maxamps, cur_edits, cur_framples) do |s, c, amp, ed, fr|
if s != cursnd
if (res = edit_position(s, c)) != ed
snd_display("scale_sound_by %s[%s] wrong edit pos: %s %s?",
short_file_name(s), c, res, ed)
end
- if (res = frames(s, c)) != fr
- snd_display("scale_sound_by %s[%s] wrong frames: %s %s?", short_file_name(s), c, res, fr)
+ if (res = framples(s, c)) != fr
+ snd_display("scale_sound_by %s[%s] wrong framples: %s %s?", short_file_name(s), c, res, fr)
end
if fneq(res = maxamp(s, c), amp)
snd_display("scale_sound_by %s[%s] wrong maxamp: %s %s?", short_file_name(s), c, res, amp)
@@ -27833,8 +25894,8 @@ def opt_test(choice)
snd_display("scale_sound_by %s[%s] wrong edit pos: %s %s?",
short_file_name(s), c, res, ed + 1)
end
- if (res = frames(s, c)) != fr
- snd_display("scale_sound_by %s[%s] wrong frames: %s %s?", short_file_name(s), c, res, fr)
+ if (res = framples(s, c)) != fr
+ snd_display("scale_sound_by %s[%s] wrong framples: %s %s?", short_file_name(s), c, res, fr)
end
end
end
@@ -27843,73 +25904,23 @@ def opt_test(choice)
undo_edit(random(pos), cursnd, curchn)
end
when 6
- if (len = frames(cursnd, curchn)) > 10000
+ if (len = framples(cursnd, curchn)) > 10000
delete_samples(random((len / 2).floor), random(100) + 10, cursnd, curchn)
end
when 7
- set_samples(random(frames(cursnd, curchn) + 100), random(100) + 10,
+ set_samples(random(framples(cursnd, curchn) + 100), random(100) + 10,
Vct.new(10, 1.0), cursnd, curchn)
when 8
- insert_samples(random(frames(cursnd, curchn) + 100), random(100) + 10,
+ insert_samples(random(framples(cursnd, curchn) + 100), random(100) + 10,
Vct.new(10, 1.0), cursnd, curchn)
when 9
- add_mark(random(frames(cursnd, curchn)), cursnd, curchn)
+ add_mark(random(framples(cursnd, curchn)), cursnd, curchn)
when 10
mix_vct(Vct.new(random(100) + 10, random(1.0)),
- random(frames(cursnd, curchn) + 100), cursnd, curchn)
+ random(framples(cursnd, curchn) + 100), cursnd, curchn)
when 11
- pad_channel(random(frames(cursnd, curchn) + 100), random(100) + 10, cursnd, curchn)
+ pad_channel(random(framples(cursnd, curchn) + 100), random(100) + 10, cursnd, curchn)
when 12
- beg = random(frames(cursnd, curchn) - 210)
- dur = random(200) + 10
- preader0 = make_sampler(beg + dur - 1, cursnd, curchn, -1)
- reader0 = make_sampler(beg, cursnd, curchn)
- ptree_channel(lambda do |y| y * 2.0 end, beg, dur, cursnd, curchn, false, true)
- preader1 = make_sampler(beg + dur - 1, cursnd, curchn, -1)
- reader1 = make_sampler(beg, cursnd, curchn)
- dur.times do |i|
- pval0 = preader0.call
- val0 = reader0.call
- pval1 = preader1.call
- val1 = reader1.call
- if fneq(val0 * 2.0, val1) or fneq(pval0 * 2.0, pval1)
- snd_display("read ptree at %s: %s %s %s %s (%s %s %s %s): %s?",
- i, val0 * 2.0, val1, pval0 * 2.0, pval1,
- reader0, reader1, preader0, preader1,
- safe_display_edits(cursnd, curchn))
- Snd_throw(:mus_error, "read ptree at", i)
- end
- end
- when 13
- scale_channel(0.5, random(frames(cursnd, curchn) - 100), random(100) + 10, cursnd, curchn)
- when 14
- beg = random(frames(cursnd, curchn) - 200)
- scale_channel(0.5, beg, random(100) + 10, cursnd, curchn)
- scale_channel(0.5, beg + 10, random(100) + 10, cursnd, curchn)
- when 15
- beg = random(frames(cursnd, curchn) - 200)
- scale_channel(0.5, beg, random(100) + 10, cursnd, curchn)
- scale_channel(2.0, beg, random(100) + 10, cursnd, curchn)
- when 16
- beg = random(frames(cursnd, curchn) - 200)
- pad_channel(beg, random(100) + 10, cursnd, curchn)
- pad_channel(beg + 10, random(100) + 10, cursnd, curchn)
- when 17
- beg = random(frames(cursnd, curchn) - 200)
- pad_channel(beg, random(100) + 10, cursnd, curchn)
- pad_channel(beg, random(100) + 10, cursnd, curchn)
- when 18
- beg = random(frames(cursnd, curchn) - 200)
- delete_sample(beg, cursnd, curchn)
- delete_sample(beg + random(100), cursnd, curchn)
- when 19
- beg = random(frames(cursnd, curchn) + 200)
- set_sample(beg, 0.1, cursnd, curchn)
- set_sample(beg + random(100), 0.2, cursnd, curchn)
- when 20
- beg = random(frames(cursnd, curchn) - 200)
- ramp_channel(random(2.0) - 1.0, random(2.0) - 1.0, beg, random(100) + 10, cursnd, curchn)
- when 21
pts = random(8) + 1
maxpt = 0.0
x = y = 0.0
@@ -27917,7 +25928,7 @@ def opt_test(choice)
0.step(pts - 1, 2) do |i|
e[i] = x
if random(3) > 0
- y = random(2.0) - 1.0
+ y = mus_random(1.0)
end
e[i + 1] = y
if y.abs > maxpt
@@ -27925,7 +25936,7 @@ def opt_test(choice)
end
x += 0.01 + random(1.0)
end
- beg = random(frames(cursnd, curchn) - 300)
+ beg = random(framples(cursnd, curchn) - 300)
dur = random(200) + 80
reader0 = make_sampler(beg, cursnd, curchn)
env_channel(e, beg, dur, cursnd, curchn)
@@ -27945,6 +25956,35 @@ def opt_test(choice)
Snd_throw(:mus_error, "read env off at", i)
end
end
+ when 13
+ scale_channel(0.5, random(framples(cursnd, curchn) - 100), random(100) + 10, cursnd, curchn)
+ when 14
+ beg = random(framples(cursnd, curchn) - 200)
+ scale_channel(0.5, beg, random(100) + 10, cursnd, curchn)
+ scale_channel(0.5, beg + 10, random(100) + 10, cursnd, curchn)
+ when 15
+ beg = random(framples(cursnd, curchn) - 200)
+ scale_channel(0.5, beg, random(100) + 10, cursnd, curchn)
+ scale_channel(2.0, beg, random(100) + 10, cursnd, curchn)
+ when 16
+ beg = random(framples(cursnd, curchn) - 200)
+ pad_channel(beg, random(100) + 10, cursnd, curchn)
+ pad_channel(beg + 10, random(100) + 10, cursnd, curchn)
+ when 17
+ beg = random(framples(cursnd, curchn) - 200)
+ pad_channel(beg, random(100) + 10, cursnd, curchn)
+ pad_channel(beg, random(100) + 10, cursnd, curchn)
+ when 18
+ beg = random(framples(cursnd, curchn) - 200)
+ delete_sample(beg, cursnd, curchn)
+ delete_sample(beg + random(100), cursnd, curchn)
+ when 19
+ beg = random(framples(cursnd, curchn) + 200)
+ set_sample(beg, 0.1, cursnd, curchn)
+ set_sample(beg + random(100), 0.2, cursnd, curchn)
+ when 20
+ beg = random(framples(cursnd, curchn) - 200)
+ ramp_channel(random(2.0) - 1.0, random(2.0) - 1.0, beg, random(100) + 10, cursnd, curchn)
end
end
@@ -27997,7 +26037,7 @@ end
def vequal_at(v0, v1)
v0.each_with_index do |val, i|
- if fneq_err(val, v1[i], 0.001) # okay
+ if fneq_err(val, v1[i], 0.001)
return [i, val, v1[i]]
end
end
@@ -28052,23 +26092,23 @@ def check_edit_tree(expected_tree, expected_vals, name)
end
def reversed_read(snd, chn)
- len = frames(snd, chn)
+ len = framples(snd, chn)
sf = make_sampler(len - 1, snd, chn, -1)
Vct.new(len) do read_sample(sf) end.reverse
end
def init_sound(val, dur, chns)
- ind = new_sound("test.snd", Mus_next, Mus_bshort, 22050, chns)
+ ind = new_sound("test.snd", chns, 22050, Mus_bshort, Mus_next)
chns.times do |chn|
insert_silence(0, dur, ind, chn)
- map_channel(lambda do |y| val end, 0, frames, ind, chn)
+ map_channel(lambda do |y| val end, 0, framples, ind, chn)
end
ind
end
def check_back_and_forth(ind, name, v)
happy = true
- unless vequal(res = channel2vct(0, frames, ind, 0), v)
+ unless vequal(res = channel2vct(0, framples, ind, 0), v)
happy = false
snd_display_prev_caller("%s forth: %s %s?", name, res, v)
end
@@ -28080,51 +26120,59 @@ def check_back_and_forth(ind, name, v)
end
def check_both_chans(ind, name, f0, f1)
- if (c0 = scan_channel(f0, 0, frames, ind, 0))
+ if (c0 = scan_channel(f0, 0, framples, ind, 0))
snd_display_prev_caller("%s swap c0: %s?", name, c0)
end
- if (c1 = scan_channel(f1, 0, frames, ind, 1))
+ if (c1 = scan_channel(f1, 0, framples, ind, 1))
snd_display_prev_caller("%s swap c1: %s?", name, c1)
end
end
def test_16_00
oboe = open_sound("oboe.snd")
- [[lambda { scale_channel(2.0, 0, 0, oboe) }, :scale_channel],
- [lambda { env_channel(make_env([0, 0, 1, 1], :length, 123), 0, 0, oboe) }, :env_channel],
- [lambda { clm_channel(make_oscil, 0, 0, oboe) }, :clm_channel],
- [lambda { vct2channel(make_vct(3), 0, 0, oboe) }, :vct2channel],
- [lambda { smooth_channel(0, 0, oboe) }, :smooth_channel],
- [lambda { pad_channel(0, 0, oboe) }, :pad_channel],
- [lambda { src_channel(2.0, 0, 0, oboe) }, :src_channel],
- [lambda { mix_channel("pistol.snd", 0, 0, oboe) }, :mix_channel],
- [lambda { insert_channel("pistol.snd", 0, 0, oboe) }, :insert_channel],
- [lambda { reverse_channel(0, 0, oboe) }, :reverse_channel],
- [lambda { scale_sound_by(2.0, 0, 0, oboe) }, :scale_sound_by],
- [lambda { env_sound([0, 0, 1, 1], 0, 0, oboe) }, :env_sound],
- [lambda { set_samples(0, 0, Vct.new(3), oboe) }, :set_samples],
- [lambda { smooth_sound(0, 0, oboe) }, :smooth_soundxs],
- [lambda { insert_silence(0, 0, oboe) }, :insert_silence]].each do |func, name|
+ [[lambda do scale_channel(2.0, 0, 0, oboe) end, :scale_channel],
+ [lambda do
+ env_channel(make_env([0, 0, 1, 1], :length, 123), 0, 0, oboe)
+ end, :env_channel],
+ [lambda do clm_channel(make_oscil, 0, 0, oboe) end, :clm_channel],
+ [lambda do vct2channel(make_vct(3), 0, 0, oboe) end, :vct2channel],
+ [lambda do smooth_channel(0, 0, oboe) end, :smooth_channel],
+ [lambda do pad_channel(0, 0, oboe) end, :pad_channel],
+ [lambda do src_channel(2.0, 0, 0, oboe) end, :src_channel],
+ [lambda do mix_channel("pistol.snd", 0, 0, oboe) end, :mix_channel],
+ [lambda do insert_channel("pistol.snd", 0, 0, oboe) end, :insert_channel],
+ [lambda do reverse_channel(0, 0, oboe) end, :reverse_channel],
+ [lambda do scale_sound_by(2.0, 0, 0, oboe) end, :scale_sound_by],
+ [lambda do env_sound([0, 0, 1, 1], 0, 0, oboe) end, :env_sound],
+ [lambda do set_samples(0, 0, Vct.new(3), oboe) end, :set_samples],
+ [lambda do smooth_sound(0, 0, oboe) end, :smooth_soundxs],
+ [lambda do
+ insert_silence(0, 0, oboe)
+ end, :insert_silence]].each do |func, name|
func.call
if (res = edit_position(oboe)) != 0
snd_display("dur: 0 %s: %s %s?", name, res, edit_fragment)
end
end
- [[lambda { scale_channel(2.0, -1, 123, oboe) }, :scale_channel],
- [lambda { env_channel(make_env([0, 0, 1, 1], :length, 123), -1, 123, oboe) }, :env_channel],
- [lambda { clm_channel(make_oscil, -1, 123, oboe) }, :clm_channel],
- [lambda { vct2channel(make_vct(3), -1, 123, oboe) }, :vct2channel],
- [lambda { smooth_channel(-1, 123, oboe) }, :smooth_channel],
- [lambda { pad_channel(-1, 123, oboe) }, :pad_channel],
- [lambda { src_channel(2.0, -1, 123, oboe) }, :src_channel],
- [lambda { mix_channel("pistol.snd", -1, 123, oboe) }, :mix_channel],
- [lambda { insert_channel("pistol.snd", -1, 123, oboe) }, :insert_channel],
- [lambda { reverse_channel(-1, 123, oboe) }, :reverse_channel],
- [lambda { scale_sound_by(2.0, -1, 123, oboe) }, :scale_sound_by],
- [lambda { env_sound([0, 0, 1, 1], -1, 123, oboe) }, :env_sound],
- [lambda { set_samples(-1, 123, Vct.new(3), oboe) }, :set_samples],
- [lambda { smooth_sound(-1, 123, oboe) }, :smooth_soundxs],
- [lambda { insert_silence(-1, 123, oboe) }, :insert_silence]].each do |func, name|
+ [[lambda do scale_channel(2.0, -1, 123, oboe) end, :scale_channel],
+ [lambda do
+ env_channel(make_env([0, 0, 1, 1], :length, 123), -1, 123, oboe)
+ end, :env_channel],
+ [lambda do clm_channel(make_oscil, -1, 123, oboe) end, :clm_channel],
+ [lambda do vct2channel(make_vct(3), -1, 123, oboe) end, :vct2channel],
+ [lambda do smooth_channel(-1, 123, oboe) end, :smooth_channel],
+ [lambda do pad_channel(-1, 123, oboe) end, :pad_channel],
+ [lambda do src_channel(2.0, -1, 123, oboe) end, :src_channel],
+ [lambda do mix_channel("pistol.snd", -1, 123, oboe) end, :mix_channel],
+ [lambda do insert_channel("pistol.snd", -1, 123, oboe) end, :insert_channel],
+ [lambda do reverse_channel(-1, 123, oboe) end, :reverse_channel],
+ [lambda do scale_sound_by(2.0, -1, 123, oboe) end, :scale_sound_by],
+ [lambda do env_sound([0, 0, 1, 1], -1, 123, oboe) end, :env_sound],
+ [lambda do set_samples(-1, 123, Vct.new(3), oboe) end, :set_samples],
+ [lambda do smooth_sound(-1, 123, oboe) end, :smooth_soundxs],
+ [lambda do
+ insert_silence(-1, 123, oboe)
+ end, :insert_silence]].each do |func, name|
if (res = Snd.catch do func.call end).first != :no_such_sample
snd_display("%s beg -1 -> %s", name, res.inspect)
end
@@ -28132,44 +26180,54 @@ def test_16_00
snd_display("beg: -1 %s: %s %s?", name, res, edit_fragment)
end
end
- [[lambda { scale_channel(2.0, 12345678, 123, oboe) }, :scale_channel],
- [lambda { env_channel(make_env([0, 0, 1, 1], :length, 123), 12345678, 123, oboe) }, :env_channel],
- [lambda { smooth_channel(12345678, 123, oboe) }, :smooth_channel],
- [lambda { src_channel(2.0, 12345678, 123, oboe) }, :src_channel],
- [lambda { reverse_channel(12345678, 123, oboe) }, :reverse_channel]].each do |func, name|
+ [[lambda do scale_channel(2.0, 12345678, 123, oboe) end, :scale_channel],
+ [lambda do
+ env_channel(make_env([0, 0, 1, 1], :length, 123), 12345678, 123, oboe)
+ end, :env_channel],
+ [lambda do smooth_channel(12345678, 123, oboe) end, :smooth_channel],
+ [lambda do src_channel(2.0, 12345678, 123, oboe) end, :src_channel],
+ [lambda do
+ reverse_channel(12345678, 123, oboe)
+ end, :reverse_channel]].each do |func, name|
func.call
if (res = edit_position(oboe)) != 0
snd_display("beg: 12345678 %s: %s %s?", name, res, edit_fragment)
end
end
pos = 0
- [[lambda { scale_channel(2.0, 0, 123, oboe, 0) }, :scale_channel],
- [lambda { env_channel(make_env([0, 0, 1, 1], :length, 123), 0, 123, oboe, 0) }, :env_channel],
- [lambda { clm_channel(make_oscil, 0, 123, oboe, 0) }, :clm_channel],
- [lambda { vct2channel(make_vct(3), 0, 123, oboe, 0) }, :vct2channel],
- [lambda { smooth_channel(0, 123, oboe, 0) }, :smooth_channel],
- [lambda { pad_channel(0, 123, oboe, 0) }, :pad_channel],
- [lambda { src_channel(2.0, 0, 123, oboe, 0) }, :src_channel],
- [lambda { mix_channel("pistol.snd", 0, 123, oboe, 0) }, :mix_channel],
- [lambda { insert_channel("pistol.snd", 0, 123, oboe, 0) }, :insert_channel],
- [lambda { reverse_channel(0, 123, oboe, 0) }, :reverse_channel],
+ [[lambda do scale_channel(2.0, 0, 123, oboe, 0) end, :scale_channel],
+ [lambda do
+ env_channel(make_env([0, 0, 1, 1], :length, 123), 0, 123, oboe, 0)
+ end, :env_channel],
+ [lambda do clm_channel(make_oscil, 0, 123, oboe, 0) end, :clm_channel],
+ [lambda do vct2channel(make_vct(3), 0, 123, oboe, 0) end, :vct2channel],
+ [lambda do smooth_channel(0, 123, oboe, 0) end, :smooth_channel],
+ [lambda do pad_channel(0, 123, oboe, 0) end, :pad_channel],
+ [lambda do src_channel(2.0, 0, 123, oboe, 0) end, :src_channel],
+ [lambda do mix_channel("pistol.snd", 0, 123, oboe, 0) end, :mix_channel],
+ [lambda do
+ insert_channel("pistol.snd", 0, 123, oboe, 0)
+ end, :insert_channel],
+ [lambda do reverse_channel(0, 123, oboe, 0) end, :reverse_channel],
[let(rd = make_sampler(0),
- make_src(:srate, 2.0, :input, lambda { |dir| rd.call })) { |rd, sr|
- lambda { clm_channel(sr, 0, 12345, oboe, 0) }
- }, "clm_channel src"],
+ make_src(:srate, 2.0,
+ :input, lambda do |dir| rd.call end)) do |rd, sr|
+ lambda do clm_channel(sr, 0, 12345, oboe, 0) end
+ end, "clm_channel src"],
[let(rd = make_sampler(0),
- make_granulate(:expansion, 2.0, :input, lambda { |dir| rd.call })) { |rd, gr|
- lambda { clm_channel(gr, 0, 12345, oboe, 0) }
- }, "clm_channel granulate"],
+ make_granulate(:expansion, 2.0,
+ :input, lambda do |dir| rd.call end)) do |rd, gr|
+ lambda do clm_channel(gr, 0, 12345, oboe, 0) end
+ end, "clm_channel granulate"],
[let(rd = make_sampler(0),
- flt = [1, 0, 0, 0].to_vct,
- make_convolve(:input, lambda { |dir| rd.call }, :filter, flt)) { |rd, flt, cv|
- lambda { clm_channel(cv, 0, 12345, oboe, 0) }
- }, "clm_channel convolve"],
+ make_convolve(:input, lambda do |dir| rd.call end,
+ :filter, vct(1, 0, 0))) do |rd, cv|
+ lambda do clm_channel(cv, 0, 12345, oboe, 0) end
+ end, "clm_channel convolve"],
[let(rd = make_sampler(0),
- make_phase_vocoder(:input, lambda { |dir| rd.call })) { |rd, pv|
- lambda { clm_channel(pv, 0, 12345, oboe, 0) }
- }, "clm_channel phase_vocoder"]].each do |func, name|
+ make_phase_vocoder(:input, lambda do |dir| rd.call end)) do |rd, pv|
+ lambda do clm_channel(pv, 0, 12345, oboe, 0) end
+ end, "clm_channel phase_vocoder"]].each do |func, name|
func.call
if (res = edit_position(oboe)) != pos += 1
snd_display("%s[%s]: %s %s?", name, pos, res, edit_fragment)
@@ -28177,34 +26235,24 @@ def test_16_00
end
#
revert_sound(oboe)
- edpos_fnc = lambda do |hi| false end
- [[lambda { scale_channel(2.0, 0, 123, oboe, 0, edpos_fnc) }, :scale_channel],
- [lambda { env_channel(make_env([0, 0, 1, 1], :length, 123), 0, 123, oboe, 0, edpos_fnc)}, :env_channel],
- [lambda { clm_channel(make_oscil, 0, 123, oboe, 0, edpos_fnc) }, :clm_channel],
- [lambda { vct2channel(make_vct(3), 0, 123, oboe, 0, edpos_fnc) }, :vct2channel],
- [lambda { smooth_channel(0, 123, oboe, 0, edpos_fnc) }, :smooth_channel],
- [lambda { pad_channel(0, 123, oboe, 0, edpos_fnc) }, :pad_channel],
- [lambda { src_channel(2.0, 0, 123, oboe, 0, edpos_fnc) }, :src_channel],
- [lambda { mix_channel("pistol.snd", 0, 123, oboe, 0, edpos_fnc) }, :mix_channel],
- [lambda { insert_channel("pistol.snd", 0, 123, oboe, 0, edpos_fnc) }, :insert_channel],
- [lambda { reverse_channel(0, 123, oboe, 0, edpos_fnc) }, :reverse_channel]].each do |func, name|
- if (res = Snd.catch do func.call end).first != :bad_arity
- snd_display("bad edpos_func %s: %s", name, res.inspect)
- end
- if (res = edit_position(oboe)) != 0
- snd_display("edpos:func %s: %s %s?", name, res, edit_fragment)
- end
- end
- [[lambda { scale_channel(2.0, 0, 123, oboe, 0, 123) }, :scale_channel],
- [lambda { env_channel(make_env([0, 0, 1, 1], :length, 123), 0, 123, oboe, 0, 123)}, :env_channel],
- [lambda { clm_channel(make_oscil, 0, 123, oboe, 0, 123) }, :clm_channel],
- [lambda { vct2channel(make_vct(3), 0, 123, oboe, 0, 123) }, :vct2channel],
- [lambda { smooth_channel(0, 123, oboe, 0, 123) }, :smooth_channel],
- [lambda { pad_channel(0, 123, oboe, 0, 123) }, :pad_channel],
- [lambda { src_channel(2.0, 0, 123, oboe, 0, 123) }, :src_channel],
- [lambda { mix_channel("pistol.snd", 0, 123, oboe, 0, 123) }, :mix_channel],
- [lambda { insert_channel("pistol.snd", 0, 123, oboe, 0, 123) }, :insert_channel],
- [lambda { reverse_channel(0, 123, oboe, 0, 123) }, :reverse_channel]].each do |func, name|
+ [[lambda do scale_channel(2.0, 0, 123, oboe, 0, 123) end, :scale_channel],
+ [lambda do
+ env_channel(make_env([0, 0, 1, 1], :length, 123), 0, 123, oboe, 0, 123)
+ end, :env_channel],
+ [lambda do clm_channel(make_oscil, 0, 123, oboe, 0, 123) end, :clm_channel],
+ [lambda do vct2channel(make_vct(3), 0, 123, oboe, 0, 123) end, :vct2channel],
+ [lambda do smooth_channel(0, 123, oboe, 0, 123) end, :smooth_channel],
+ [lambda do pad_channel(0, 123, oboe, 0, 123) end, :pad_channel],
+ [lambda do src_channel(2.0, 0, 123, oboe, 0, 123) end, :src_channel],
+ [lambda do
+ mix_channel("pistol.snd", 0, 123, oboe, 0, 123)
+ end, :mix_channel],
+ [lambda do
+ insert_channel("pistol.snd", 0, 123, oboe, 0, 123)
+ end, :insert_channel],
+ [lambda do
+ reverse_channel(0, 123, oboe, 0, 123)
+ end, :reverse_channel]].each do |func, name|
if (res = Snd.catch do func.call end).first != :no_such_edit
snd_display("bad edpos %s: %s", name, res.inspect)
end
@@ -28216,17 +26264,17 @@ def test_16_00
oldv = channel2vct(1000, 10, oboe)
mix_channel("oboe.snd", 0)
oldv.scale!(2.0)
- unless (res = channel2vct(1000, 10, oboe), oldv)
+ unless vequal(res = channel2vct(1000, 10, oboe), oldv)
snd_display("mix_channel at 0: %s %s?", oldv, res)
end
revert_sound(oboe)
oldv.scale!(0.5)
insert_channel("oboe.snd", 0)
- unless (res = channel2vct(1000, 10, oboe), oldv)
+ unless vequal(res = channel2vct(1000, 10, oboe), oldv)
snd_display("insert_channel at 0: %s %s?", oldv, res)
end
- if (res1 = frames(oboe, 0)) != (res2 = frames(oboe, 0, 0)) * 2
- snd_display("insert_channel frames: %s %s?", res1, res2)
+ if (res1 = framples(oboe, 0)) != (res2 = framples(oboe, 0, 0)) * 2
+ snd_display("insert_channel framples: %s %s?", res1, res2)
end
revert_sound(oboe)
close_sound(oboe)
@@ -28235,25 +26283,24 @@ end
def funcs_equal?(name, func0, func1, oboe0, oboe1)
func0.call(false, false, oboe0)
func1.call(false, false, oboe1)
- unless vequal(res1 = channel2vct(1000, 100, oboe0), res2 = channel2vct(1000, 100, oboe1))
- snd_display("%s via false:\n# %s\n# %s?", res1, res2)
- end
+ res1 = channel2vct(1000, 100, oboe0)
+ res2 = channel2vct(1000, 100, oboe1)
+ snd_test_neq(channel2vct(1000, 100, oboe0), channel2vct(1000, 100, oboe1),
+ "%s via false", name)
revert_sound(oboe0)
revert_sound(oboe1)
select_sound(oboe0)
func0.call
select_sound(oboe1)
func1.call
- unless vequal(res1 = channel2vct(1000, 100, oboe0), res2 = channel2vct(1000, 100, oboe1))
- snd_display("%s via none:\n# %s\n# %s?", res1, res2)
- end
+ snd_test_neq(channel2vct(1000, 100, oboe0), channel2vct(1000, 100, oboe1),
+ "%s via none", name)
revert_sound(oboe0)
revert_sound(oboe1)
- func0.call(0, frames(oboe0), oboe0)
- func1.call(0, frames(oboe1), oboe1)
- unless vequal(res1 = channel2vct(1000, 100, oboe0), res2 = channel2vct(1000, 100, oboe1))
- snd_display("%s via 0 frames:\n# %s\n# %s?", res1, res2)
- end
+ func0.call(0, framples(oboe0), oboe0)
+ func1.call(0, framples(oboe1), oboe1)
+ snd_test_neq(channel2vct(1000, 100, oboe0), channel2vct(1000, 100, oboe1),
+ "%s via 0 framples", name)
revert_sound(oboe0)
revert_sound(oboe1)
end
@@ -28265,8 +26312,8 @@ def test_16_01
ind = new_sound("fmv.snd")
v0 = Vct.new(20, 1.0)
vct2channel(v0)
- if frames != 20
- snd_display("vct2channel new 20: %s?", frames)
+ if framples != 20
+ snd_display("vct2channel new 20: %s?", framples)
end
if fneq(maxamp, 1.0)
snd_display("vct 1->new: %s?", maxamp)
@@ -28315,16 +26362,16 @@ def test_16_01
#
set_x_axis_style(X_axis_as_percentage)
ind = open_sound("2.snd")
- fr = frames
+ fr = framples
m0 = maxamp(ind, 0)
m1 = maxamp(ind, 1)
set_sync(64, ind)
insert_sound("2.snd")
insert_sound("2.snd")
- if frames != fr * 3
- snd_display("2.snd 3x = %s %s?", fr, frames)
+ if framples != fr * 3
+ snd_display("2.snd 3x = %s %s?", fr, framples)
end
- if (res1 = frames(ind, 0)) != (res2 = frames(ind, 1))
+ if (res1 = framples(ind, 0)) != (res2 = framples(ind, 1))
snd_display("insert synced: %s %s?", res1, res2)
end
swap_channels
@@ -28340,8 +26387,8 @@ def test_16_01
if (res = short_file_name(new_snd)) != "test.snd"
snd_display("mono_files2stereo filename: %s?", res)
end
- if (res = frames(new_snd)) != 50828
- snd_display("mono_files2stereo frames: %s?", res)
+ if (res = framples(new_snd)) != 50828
+ snd_display("mono_files2stereo framples: %s?", res)
end
close_sound(new_snd)
#
@@ -28372,7 +26419,7 @@ def test_16_01
},
lambda { |*args|
snd = (args[2] or selected_sound)
- len = (args[1] and number?(args[1])) ? args[1] : (frames(snd) - 1)
+ len = (args[1] and number?(args[1])) ? args[1] : (framples(snd) - 1)
env_channel(make_env(:envelope, [0, 0, 1, 1], :length, len), *args)
},
oboe0, oboe1)
@@ -28460,80 +26507,86 @@ def test_16_01
set_x_axis_style(X_axis_in_seconds)
#
[1, 2, 4].each do |out_chans|
- ind = new_sound("new.snd", Mus_next, Mus_bfloat, 22050, out_chans, "edpos testing")
+ ind = new_sound("new.snd", out_chans, 22050, Mus_bfloat, Mus_next,
+ "edpos testing")
mx = Snd.sounds.map do |s| sync(s) end.max
set_sync(mx + 1, ind)
["2a.snd", "1a.snd", "4a.snd"].each do |in_snd|
- [lambda { |posfunc|
+ [lambda do |posfunc|
chn = [random(out_chans + 1), out_chans - 1].min
- unless vequal(res = channel2vct(0, frames(ind, chn), ind, chn, 0), [0.0].to_vct)
+ res = channel2vct(0, framples(ind, chn), ind, chn, 0)
+ unless vequal(res, vct(0.0))
snd_display("start bad: %s?", res)
end
set_sample(0, 0.1, ind, chn)
- unless vequal(res = channel2vct(0, frames(ind, chn), ind, chn), [0.1].to_vct)
+ res = channel2vct(0, framples(ind, chn), ind, chn)
+ unless vequal(res, vct(0.1))
snd_display("set bad: %s?", res)
end
pad_channel(0, 1, ind, chn, posfunc.call)
if proc?(pos = posfunc.call)
pos = pos.call(ind, chn)
end
- data = channel2vct(0, frames(ind, chn), ind, chn)
- if (pos.zero? and (not vequal(data, [0.0, 0.0].to_vct))) or
- ((pos == Current_edit_position or pos == edit_position(ind, chn)) and
- (not vequal(data, [0.0, 0.1].to_vct))) or
- (pos == edit_position(ind, chn) - 1 and
- (not vequal(data, [0.0, 0.0].to_vct)))
+ data = channel2vct(0, framples(ind, chn), ind, chn)
+ if (pos.zero? and (not vequal(data, vct(0.0, 0.0)))) or
+ ((pos == Current_edit_position or
+ pos == edit_position(ind, chn)) and
+ (not vequal(data, vct(0.0, 0.1)))) or
+ (pos == edit_position(ind, chn) - 1 and
+ (not vequal(data, vct(0.0, 0.0))))
snd_display("pos[%s]: edpos %s of %s, pad result[%s, %s]: %s?",
chn, pos,
edit_position(ind, chn),
- frames(ind, chn, pos),
- frames(ind, chn),
+ framples(ind, chn, pos),
+ framples(ind, chn),
data)
end
if channels(ind) > 1
channels(ind).times do |i|
next if chn == i
- unless vequal(res = channel2vct(0, frames(ind, i), ind, i), [0.0].to_vct)
+ res = channel2vct(0, framples(ind, i), ind, i)
+ unless vequal(res, vct(0.0))
snd_display("pad[%s / %s] empty: %s?", i, chn, data)
end
end
end
- },
- lambda { |posfunc|
+ end,
+ lambda do |posfunc|
chn = [random(out_chans + 1), out_chans - 1].min
set_sample(0, 0.1, ind, chn)
- set_sample(0, sample(0, ind, chn, posfunc.call()) * 2.0, ind, chn, posfunc.call())
+ set_sample(0, sample(0, ind, chn, posfunc.call()) * 2.0,
+ ind, chn, posfunc.call())
if proc?(pos = posfunc.call)
pos = pos.call(ind, chn)
end
- data = channel2vct(0, frames(ind, chn), ind, chn)
- if (pos.zero? and (not vequal(data, [0.0].to_vct))) or
- ((pos == Current_edit_position or pos == edit_position(ind, chn)) and
- (not vequal(data, [0.2].to_vct))) or
- (pos == edit_position(ind, chn) - 1 and
- (not vequal(data, [0.0].to_vct)))
+ data = channel2vct(0, framples(ind, chn), ind, chn)
+ if (pos.zero? and (not vequal(data, vct(0.0)))) or
+ ((pos == Current_edit_position or
+ pos == edit_position(ind, chn)) and
+ (not vequal(data, vct(0.2)))) or
+ (pos == edit_position(ind, chn) - 1 and
+ (not vequal(data, vct(0.0))))
snd_display("pos[%s]: edpos %s of %s, set *2 result[%s, %s]: %s?",
chn, pos,
edit_position(ind, chn),
- frames(ind, chn, pos),
- frames(ind, chn),
+ framples(ind, chn, pos),
+ framples(ind, chn),
data)
end
if channels(ind) > 1
channels(ind).times do |i|
next if chn == i
- unless vequal(res = channel2vct(0, frames(ind, i), ind, i), [0.0].to_vct)
+ res = channel2vct(0, framples(ind, i), ind, i)
+ unless vequal(res, vct(0.0))
snd_display("scale[%s / %s] empty: %s?", i, chn, data)
end
end
end
- }].each do |func|
- [lambda { Current_edit_position },
- lambda { 0 },
- lambda { lambda { |s, c| edit_position(s, c) - 1 } },
- lambda { lambda { |s, c| edit_position(s, c) } },
- lambda { lambda { |s, c| Current_edit_position } },
- lambda { lambda { |s, c| 0 } }].each do |edpos|
+ end].each do |func|
+ [lambda do Current_edit_position end,
+ lambda do 0 end,
+ lambda do edit_position(ind, 0) - 1 end,
+ lambda do edit_position(ind, 0) end].each do |edpos|
func.call(edpos)
revert_sound(ind)
end
@@ -28544,17 +26597,19 @@ def test_16_01
#
ind = open_sound("oboe.snd")
map_channel(lambda do |y| false end)
- if frames(ind) != 0
- snd_display("map_channel false frames: %s?", frames(ind))
+ if framples(ind) != 0
+ snd_display("map_channel false framples: %s?", framples(ind))
end
if edits(ind) == [0, 0]
snd_display("map_channel false edits backed up")
end
undo_edit(1, ind)
- if frames(ind) == 0
- snd_display("map_channel false frames after undo: %s?", frames(ind))
+ if framples(ind) == 0
+ snd_display("map_channel false framples after undo: %s?", framples(ind))
end
- if (res = Snd.catch do map_channel(lambda do |y| "hiho" end) end).first != :bad_type
+ if (res = Snd.catch do
+ map_channel(lambda do |y| "hiho" end)
+ end).first != :bad_type
snd_display("map_channel bad_type: %s", res.inspect)
end
ctr = 0
@@ -28580,10 +26635,10 @@ def test_16_01
end
revert_sound(ind)
del = make_delay(1000)
- len = frames
+ len = framples
clm_channel(del, 0, len, ind, 0, 0, 2000)
- if frames(ind) != len + 2000
- snd_display("clm_channel overlap length: %s %s?", len, frames)
+ if framples(ind) != len + 2000
+ snd_display("clm_channel overlap length: %s %s?", len, framples)
end
if edit_tree != [[0, 1, 0, 52827, 1.0, 0.0, 0.0, 0], [52828, -2, 0, 0, 0.0, 0.0, 0.0, 0]]
snd_display("clm_channel overlaps: %s?", edit_tree)
@@ -28627,7 +26682,7 @@ def test_16_01
reverse_channel(0, false, ind, 0, 1)
amp = 0.0
loc = 0
- ctr = frames - 1
+ ctr = framples - 1
scan_channel(lambda { |y|
if y.abs > amp
amp = y.abs
@@ -28642,7 +26697,7 @@ def test_16_01
reverse_channel(0, false, ind, 0, 2)
amp = 0.0
loc = 0
- ctr = frames - 1
+ ctr = framples - 1
scan_channel(lambda { |y|
if y.abs > amp
amp = y.abs
@@ -28674,7 +26729,7 @@ end
def test_16_02
mus_clipping and set_mus_clipping(false)
clipping and set_clipping(false)
- ind = new_sound("fmv.snd", Mus_next, Mus_bfloat, 22050, 1,"edit trees")
+ ind = new_sound("fmv.snd", 1, 22050, Mus_bfloat, Mus_next, "edit trees")
select_sound(ind)
select_channel(0)
check_edit_tree([[0, 0, 0, 0, 0.0, 0.0, 0.0, 1],
@@ -28723,7 +26778,7 @@ def test_16_02
[100, -2, 0, 0, 0.0, 0.0, 0.0, 0]],
vals, "env_channel(15, 10) b")
set_selection_position(5)
- set_selection_frames(10)
+ set_selection_framples(10)
scale_selection_to(0.5)
5.upto(14) do |i| vals[i] *= 0.5 end
check_edit_tree([[0, 1, 0, 4, 1.0, 0.0, 0.0, 0],
@@ -28802,7 +26857,7 @@ def test_16_02
snd_display("selection_maxamp after: %s?", res)
end
set_selection_position(50)
- set_selection_frames(10)
+ set_selection_framples(10)
scale_selection_by(0.1)
if fneq(res = selection_maxamp, 0.1)
snd_display("re-selection_maxamp: %s?", res)
@@ -28932,7 +26987,7 @@ def test_16_02
[100, -2, 0, 0, 0.0, 0.0, 0.0, 0]],
vals, "back set via map_channel")
set_selection_position(20)
- set_selection_frames(70)
+ set_selection_framples(70)
env_selection([0, 0, 1, 1])
if fneq(res = selection_maxamp(ind, 0), 1.0)
snd_display("selection_maxamp after env_selection: %s?", res)
@@ -29272,7 +27327,7 @@ def test_16_02
end
def test_16_03
- ind = new_sound("fmv.snd", Mus_next, Mus_bfloat, 22050, 1, "envd edit trees")
+ ind = new_sound("fmv.snd", 1, 22050, Mus_bfloat, Mus_next, "envd edit trees")
vals = Vct.new(10000, 1.0)
select_sound(ind)
select_channel(0)
@@ -29432,8 +27487,8 @@ def test_16_03
if fneq(sample(0), -1.0)
snd_display("sample at end: %s?", sample(0))
end
- if frames != 1
- snd_display("length at end: %s?", frames)
+ if framples != 1
+ snd_display("length at end: %s?", framples)
end
check_edit_tree([[0, 2, 0, 0, 1.0, 0.0, 0.0, 0],
[1, -2, 0, 0, 0.0, 0.0, 0.0, 0]],
@@ -29562,7 +27617,7 @@ end
def test_16_04
[10, 10000].each do |dur|
i1 = new_sound
- i2 = new_sound("fmv1.snd", Mus_next, Mus_bfloat, 44100, 2)
+ i2 = new_sound("fmv1.snd", 2, 44100, Mus_bfloat, Mus_next)
v = Vct.new(dur, 1.0)
vct2channel(v, 0, dur, i1)
vct2channel(v, 0, dur, i2, 0)
@@ -29571,9 +27626,10 @@ def test_16_04
set_sync(1, i2)
env_sound([0, 0, 1, 1])
check_envs(:ramps,
- lambda { |s, c| make_sampler(0, s, c) },
- lambda { |s, c| make_env(:envelope, [0, 0, 1, 1], :length, dur) },
- dur, i1, i2)
+ lambda do |s, c| make_sampler(0, s, c) end,
+ lambda do |s, c|
+ make_env(:envelope, [0, 0, 1, 1], :length, dur)
+ end, dur, i1, i2)
reverse_sound
check_envs(:rev_ramps,
lambda { |s, c| make_sampler(0, s, c) },
@@ -29640,7 +27696,7 @@ def test_16_04
end
#
data = ["1a.snd", "oboe.snd", "storm.snd"].map do |sound|
- if File.exists?(sound)
+ if File.exist?(sound)
ind = view_sound(sound)
set_squelch_update(true, ind)
tms = [lambda { scale_channel(2.0) },
@@ -29661,7 +27717,7 @@ def test_16_04
end
end
if $VERBOSE
- snd_info(" scl rev env map ptree scn pad wrt clm mix src")
+ snd_info(" scl rev env map scn pad wrt clm mix src")
str = ""
data[0].each do |x| str << "%6.2f" % x end
snd_info(" 1a: %s", str)
@@ -29673,7 +27729,7 @@ def test_16_04
snd_info(" storm: %s", str)
end
#
- ind = new_sound("fmv.snd", Mus_next, Mus_bfloat)
+ ind = new_sound("fmv.snd", :header_type, Mus_next, :sample_type, Mus_bfloat)
set_sinc_width(10)
pad_channel(0, 1000, ind)
set_sample(100, 0.5)
@@ -29815,9 +27871,9 @@ def test_16_04
[lambda { |beg, dur| src_channel(0.5, beg, dur) }, 0, 1000, 52829],
[lambda { |beg, dur| insert_silence(beg, dur) }, 0, 1000, 53829]
].each do |func, beg, dur, len|
- old_len = frames(ind)
+ old_len = framples(ind)
func.call(beg, dur)
- if (res = frames(ind)) != len
+ if (res = framples(ind)) != len
snd_display("(%s %s %s) with %s: %s (%s)?", func, beg, dur, old_len, res, len)
end
end
@@ -29828,9 +27884,9 @@ def test_16_04
[62000, 1, 62001],
[62000, 2, 62003],
[62004, 1, 62005]].each do |beg, dur, len|
- old_len = frames(ind)
+ old_len = framples(ind)
pad_channel(beg, dur)
- if (res = frames(ind)) != len
+ if (res = framples(ind)) != len
snd_display("(pad_channel %s %s) with %s: %s (%s)?", beg, dur, old_len, res, len)
end
end
@@ -29846,36 +27902,37 @@ def test_16_04
[lambda { |beg, dur| insert_silence(beg, dur) }, 1000, 54028],
[lambda { |beg, dur| env_sound([0, 0, 1, 1], beg, dur) }, 1000, 54028]
].each do |func, dur, len|
- old_len = frames(ind)
+ old_len = framples(ind)
func.call(old_len + 100, dur)
- if (res = frames(ind)) != len
+ if (res = framples(ind)) != len
snd_display("(%s %s) with %s: %s (%s)?", func, dur, old_len, res, len)
end
end
revert_sound(ind)
+ len = (1.25 * framples()).floor
100.times do
case random(10)
when 0
- pad_channel(random(1.25 * frames), random(1000))
+ pad_channel(random(len), random(1000))
when 1
- env_channel([0, 0, 1, 1, 2, 0], random(1.25 * frames), random(1000))
+ env_channel([0, 0, 1, 1, 2, 0], random(len), random(1000))
when 2
- env_sound([0, 0, 1, 1, 2, 0], random(1.25 * frames), random(1000))
+ env_sound([0, 0, 1, 1, 2, 0], random(len), random(1000))
when 3
- scale_channel(random(1.0), random(1.25 * frames), random(1000))
+ scale_channel(random(1.0), random(len), random(1000))
when 4
- scale_sound_by(random(1.0), random(1.25 * frames), random(1000))
+ scale_sound_by(random(1.0), random(len), random(1000))
when 5
- src_channel(random(0.2) + 0.9, random(1.25 * frames), random(1000))
+ src_channel(random(0.2) + 0.9, random(len), random(1000))
when 6
- ramp_channel(random(1.0), random(1.0), random(1.25 * frames), random(1000))
+ ramp_channel(random(1.0), random(1.0), random(len), random(1000))
when 7
- reverse_channel(random(1.25 * frames), random(1000))
+ reverse_channel(random(len), random(1000))
when 8
dur = [2, random(100)].max
- vct2channel(Vct.new(dur), random(1.25 * frames), dur)
+ vct2channel(Vct.new(dur), random(len), dur)
when 9
- map_channel(lambda { |y| y * 2 }, random(0.5 * frames), random(1000))
+ map_channel(lambda { |y| y * 2 }, random((0.5 * framples()).floor), random(1000))
end
end
close_sound(ind)
@@ -29905,39 +27962,24 @@ def test_16_05
#
ind = init_sound(0.5, 10, 2)
save_sound(ind)
- scale_channel(2.0, 0, frames, ind, 1)
+ scale_channel(2.0, 0, framples, ind, 1)
swap_channels
check_both_chans(ind, "1", lambda { |y| fneq(y, 1.0) }, lambda { |y| fneq(y, 0.5) })
undo_edit(1, ind, 0)
undo_edit(2, ind, 1)
- scale_channel(0.5, 0, frames, ind, 0)
- scale_channel(2.0, 0, frames, ind, 1)
+ scale_channel(0.5, 0, framples, ind, 0)
+ scale_channel(2.0, 0, framples, ind, 1)
swap_channels
check_both_chans(ind, "2", lambda { |y| fneq(y, 1.0) }, lambda { |y| fneq(y, 0.25) })
undo_edit(2, ind, 0)
undo_edit(2, ind, 1)
delete_samples(2, 3, ind, 0)
- env_channel([0, 0, 1, 1, 2, 0], 0, frames(ind, 1), ind, 1)
+ env_channel([0, 0, 1, 1, 2, 0], 0, framples(ind, 1), ind, 1)
swap_channels
- if (res = frames(ind, 1)) != 11
- snd_display("frames swapped: %s?", res)
- end
- unless vequal(res = channel2vct(0, frames(ind, 0), ind, 0),
- vct(0.000, 0.100, 0.200, 0.300, 0.400, 0.500, 0.400, 0.300, 0.200, 0.100, 0.000))
- snd_display("swapped env: %s", res)
- end
undo_edit(2, ind, 0)
undo_edit(2, ind, 1)
delete_samples(2, 7, ind, 0)
swap_channels(ind, 0, ind, 1, 5, 4)
- unless vequal(res = channel2vct(0, 10, ind, 0),
- vct(0.500, 0.500, 0.500, 0.500, 0.000, 0.500, 0.500, 0.500, 0.500, 0.000))
- snd_display("partial swap 1: %s?", res)
- end
- unless vequal(res = channel2vct(0, 10, ind, 1),
- vct(0.500, 0.500, 0.500, 0.500, 0.500, 0.000, 0.000, 0.000, 0.000, 0.500))
- snd_display("partial swap 2: %s?", res)
- end
revert_sound(ind)
m0 = add_mark(3, ind, 0)
m1 = add_mark(4, ind, 1)
@@ -29986,9 +28028,9 @@ def test_16_05
delete_file("test.snd")
#
ind = init_sound(0.5, 10, 4)
- scale_channel(0.5, 0, frames, ind, 1)
- scale_channel(0.25, 0, frames, ind, 2)
- scale_channel(0.125, 0, frames, ind, 3)
+ scale_channel(0.5, 0, framples, ind, 1)
+ scale_channel(0.25, 0, framples, ind, 2)
+ scale_channel(0.125, 0, framples, ind, 3)
swap_channels(ind, 1, ind, 2)
maxs = maxamp(ind, true)
if fneq(maxs[0], 0.5) or
@@ -30072,39 +28114,61 @@ def test_16_05
close_sound(ind)
#
if $all_args
- [[:scale_channel, lambda { |snd, i| scale_channel(i * 0.01) }],
- [:set_sample, lambda { |snd, i| set_sample(i, 0.5) }],
- [:env_channel, lambda { |snd, i| env_channel([0, 0, 1, 1]) }],
- [:env_channel_with_base, lambda { |snd, i| env_channel_with_base([0, 0, 1, 1], 32.0) }],
- [:env_channel_with_base, lambda { |snd, i| env_channel_with_base([0, 0, 1, 1], 0.0) }],
- [:delete_sample, lambda { |snd, i| delete_sample(i * 10) }],
- [:insert_sample, lambda { |snd, i| insert_sample(i * 10, 0.5) }],
- [:pad_channel, lambda { |snd, i| pad_channel(i * 10, i * 10) }],
- [:mix_no_tag, lambda { |snd, i| mix("pistol.snd", 10 * i, 0, snd, 0, false) }],
- [:mix_tag, lambda { |snd, i| mix("pistol.snd", 10 * i, 0, snd, 0, true) }],
- [:mix_scale_to, lambda { |snd, i|
- mx = mix("pistol.snd", 100 * i).car
- set_mix_amp(mx, 0.01)
- }],
- [:mix_amp, lambda { |snd, i| mix("pistol.snd", 100 * i); scale_to(0.5)}],
- [:src_sound_1, lambda { |snd, i| src_sound(2.0); undo_edit }],
- [:src_sound_2, lambda { |snd, i| src_sound(2.01); undo_edit }],
- [:filter_channel_1, lambda { |snd, i| filter_channel(vct(0.25, 0.5, 0.25, 0.1), 4) }],
- [:filter_channel_2, lambda { |snd, i| filter_channel(vct(0.25, 0.5, 0.5, 0.25), 4) }],
- [:filter_channel_3, lambda { |snd, i|
- filter_channel(vct(0.1, 0.2, 0.1, 0.1, 0.1, 0.1, 0.1, 0.2, 0.1, 0.1), 10)
- }],
- [:filter_channel_4, lambda { |snd, i|
- filter_channel(vct(0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1), 10)
- }],
- [:clm_channel, lambda { |snd, i| clm_channel(make_two_zero(0.5, 0.5)) }],
- [:reverse_channel, lambda { |snd, i| reverse_channel(i * 10, i * 100) }]].each do |name, func|
- ["1.snd", "oboe.snd", "1a.snd"].each do |sound|
+ [[:scale_channel,
+ lambda do |snd, i| scale_channel(i * 0.01) end],
+ [:set_sample,
+ lambda do |snd, i| set_sample(i, 0.5) end],
+ [:env_channel,
+ lambda do |snd, i| env_channel([0, 0, 1, 1]) end],
+ [:env_channel_with_base,
+ lambda do |snd, i| env_channel_with_base([0, 0, 1, 1], 32.0) end],
+ [:env_channel_with_base,
+ lambda do |snd, i| env_channel_with_base([0, 0, 1, 1], 0.0) end],
+ [:delete_sample,
+ lambda do |snd, i| delete_sample(i * 10) end],
+ [:insert_sample,
+ lambda do |snd, i| insert_sample(i * 10, 0.5) end],
+ [:pad_channel,
+ lambda do |snd, i| pad_channel(i * 10, i * 10) end],
+ [:mix_no_tag,
+ lambda do |snd, i| mix("pistol.snd", 10 * i, 0, snd, 0, false) end],
+ [:mix_tag,
+ lambda do |snd, i| mix("pistol.snd", 10 * i, 0, snd, 0, true) end],
+ [:mix_scale_to,
+ lambda do |snd, i| set_mix_amp(mix("pistol.snd", 100 * i).car, 0.01) end],
+ [:mix_amp,
+ lambda do |snd, i| mix("pistol.snd", 100 * i); scale_to(0.5) end],
+ [:src_sound_1,
+ lambda do |snd, i| src_sound(2.0); undo_edit end],
+ [:src_sound_2,
+ lambda do |snd, i| src_sound(2.01); undo_edit end],
+ [:filter_channel_1,
+ lambda do |snd, i| filter_channel(vct(0.25, 0.5, 0.25, 0.1), 4) end],
+ [:filter_channel_2,
+ lambda do |snd, i| filter_channel(vct(0.25, 0.5, 0.5, 0.25), 4) end],
+ [:filter_channel_3,
+ lambda do |snd, i|
+ filter_channel(vct(0.1, 0.2, 0.1, 0.1, 0.1, 0.1, 0.1, 0.2, 0.1, 0.1), 10)
+ end],
+ [:filter_channel_4,
+ lambda do |snd, i|
+ filter_channel(vct(0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1), 10)
+ end],
+ [:clm_channel,
+ lambda do |snd, i| clm_channel(make_two_zero(0.5, 0.5)) end],
+ [:reverse_channel,
+ lambda do |snd, i|
+ reverse_channel(i * 10, i * 100)
+ end]].each do |name, func|
+ ["1.snd", "oboe.snd", "1a.snd"].each do |sound|
ind = open_sound(sound)
with_time do
set_squelch_update(true, ind, 0)
with_time(format("%s() [%s]", name, sound)) do
- 256.times do |i| func.call(ind, i) end
+ 256.times do |i|
+ revert_sound(ind) if (i % 10).zero?
+ func.call(ind, i)
+ end
end
revert_sound(ind)
set_squelch_update(false, ind, 0)
@@ -30126,27 +28190,33 @@ end
# ---------------- test 17: dialogs and graphics ----------------
-def arrow2right(x, y, size, snd, chn)
+add_help(:arrow2right,
+ "arrow2right(x, y, size, snd, chn, cr) \
+draw an arrow pointing (from the left) at the point [x, y]")
+
+def arrow2right(x, y, size, snd, chn, cr)
size2 = size * 2
fill_polygon([x, y,
x - size2, y - size,
x - size2, y + size,
x, y],
- snd, chn)
+ snd, chn, Time_graph, cr)
fill_rectangle(x - 4 * size, (y - 0.4 * size).floor,
size2, (0.8 * size).floor,
- snd, chn)
+ snd, chn, Time_graph, false, cr)
end
def test_17
if $with_test_gui
- $after_graph_hook.add_hook!(get_func_name) do |snd, chn| display_previous_edits(snd, chn) end
+ $after_graph_hook.add_hook!(get_func_name, &method(:display_previous_edits).to_proc)
$lisp_graph_hook.add_hook!(get_func_name) do |snd, chn|
lambda do | |
+ cr = make_cairo(channel_widgets(snd, chn)[0])
draw_string("hi",
x2position(0.5, snd, chn, Lisp_graph),
y2position(0.5, snd, chn, Lisp_graph),
- snd, chn)
+ snd, chn, Lisp_graph, cr)
+ free_cairo(cr)
end
end
ind = open_sound("oboe.snd")
@@ -30161,16 +28231,16 @@ def test_17
draw_bass_clef(100, 100, 100, 0, ind, 0)
update_time_graph(ind, 0)
draw_fermata(200, 100, 60, 0, ind, 0)
- draw_line(100, 100, 200, 200, ind, 0)
- draw_fermata(200, 100, 60, 0, ind, 0)
- draw_dot(300, 300, 10, ind, 0)
- draw_string("hiho", 20, 20, ind, 0)
- draw_dots([25, 25, 50, 50, 100, 100], 10, ind, 0)
- arrow2right(100, 50, 10, ind, 0)
- fill_rectangle(20, 20, 100, 100, ind, 0)
+ cr = make_cairo(channel_widgets(ind, 0)[0])
+ draw_line(100, 100, 200, 200, ind, 0, Time_graph, cr)
+ draw_dot(300, 300, 10, ind, 0, Time_graph, cr)
+ draw_string("hiho", 20, 20, ind, 0, Time_graph, cr)
+ draw_dots([25, 25, 50, 50, 100, 100], 10, ind, 0, Time_graph, cr)
+ arrow2right(100, 50, 10, ind, 0, cr)
+ fill_rectangle(20, 20, 100, 100, ind, 0, Time_graph, false, cr)
+ free_cairo(cr)
make_bezier(0, 0, 20, 20, 40, 30, 60, 10, 10)
update_time_graph(ind, 0)
- fill_rectangle(20, 20, 100, 100, ind, 0, Time_graph, true)
$after_graph_hook.reset_hook!
$lisp_graph_hook.reset_hook!
#
@@ -30219,8 +28289,6 @@ end
# ---------------- test 19: save and restore ----------------
-$after_save_state_hook_var = 0
-
def local_neq?(a, b)
if float?(a) or float?(b)
fneq(a, b)
@@ -30263,13 +28331,6 @@ def test_19_00
end
true
end
- $after_save_state_hook.reset_hook!
- $after_save_state_hook.add_hook!("snd-test") do |fname|
- File.open(File.expand_path(fname), "a+") do |f|
- f.printf("\n# from %s in %s", get_func_name, __FILE__)
- f.printf("\n$after_save_state_hook_var = 1234\n")
- end
- end
delete_file(save_state_file)
save_state(save_state_file)
# save_options("test.temp")
@@ -30277,8 +28338,8 @@ def test_19_00
Snd.regions.apply(:forget_region)
load(save_state_file)
ind = find_sound("oboe.snd")
- if fneq_err(old_bounds[0], x_bounds(ind, 0)[0], 0.05) or # okay
- fneq_err(old_bounds[1], x_bounds(ind, 0)[1], 0.05) # okay
+ if fneq_err(old_bounds[0], x_bounds(ind, 0)[0], 0.05) or
+ fneq_err(old_bounds[1], x_bounds(ind, 0)[1], 0.05)
snd_display("save bounds: %s?", x_bounds(ind, 0))
end
if marks(ind, 0).length != 1
@@ -30308,9 +28369,6 @@ def test_19_00
snd_display("channel_property saved: 3.14 -> %s?", res.inspect)
end
close_sound(ind)
- if $after_save_state_hook_var != 1234
- snd_display("$after_save_state_hook_var: %s?", $after_save_state_hook_var)
- end
$before_save_state_hook.reset_hook!
$after_save_state_hook.reset_hook!
if (res = Snd.catch(:cannot_save, 12345) do save_state("/bad/bad.save") end).first != 12345
@@ -30346,14 +28404,14 @@ def test_19_00
snd_display("save_edit_history 5: %s?", res)
end
save_edit_history("hiho.rb", nind, 0)
- scale_sound_to(1.0, 0, frames(nind, 0), nind, 0)
+ scale_sound_to(1.0, 0, framples(nind, 0), nind, 0)
eds = edit_position(nind, 0)
val = insert_sound("zero.snd")
if val.nonzero? or eds != edit_position(nind, 0)
snd_display("insert_sound zero.snd, was an edit? %s %s %s", val, eds, edit_position(nind, 0))
end
revert_sound(nind)
- scale_sound_to(0.5, 0, frames(nind, 0), nind, 0)
+ scale_sound_to(0.5, 0, framples(nind, 0), nind, 0)
if fneq(res = maxamp(nind, 0), 0.5)
snd_display("scale_sound_to(0.5): %s?", res)
end
@@ -30378,54 +28436,6 @@ def test_19_00
snd_display("IO.readlines (file2string): %s?", res)
end
close_sound(nind)
- #
- ind = open_sound("oboe.snd")
- set_speed_control(Rational(2, 3).to_f, ind)
- set_filter_control_envelope([0.0, 0.0, 1.0, 1.0], ind)
- set_sound_property(:hi, 12345, ind)
- insert_samples(0, 100, Vct.new(100, 0.1), ind, 0)
- $save_state_hook.reset_hook!
- $save_state_hook.add_hook!("snd-test") do |fname| "savehook.snd" end
- save_state("s61.rb")
- close_sound(ind)
- if File.exists?("savehook.snd")
- load("s61.rb")
- ind = find_sound("oboe.snd")
- if sound?(ind)
- if fneq(res = speed_control(ind), Rational(2, 3).to_f)
- snd_display("save_state w/hook speed: %s?", res)
- end
- if (res = sound_property(:hi, ind)) != 12345
- snd_display("save_state w/hook property hi: %s?", res)
- end
- if (res = filter_control_envelope(ind)) != [0.0, 0.0, 1.0, 1.0]
- snd_display("save_state w/hook filter env: %s?", res)
- end
- $save_state_hook.reset_hook!
- $save_state_hook.add_hook!("snd-test") do |fname|
- snd_display("bogus $save_state_hook call!")
- "edit-list-to-function-saved.snd"
- end
- func = edit_list2function(ind, 0)
- if File.exists?("edit-list-to-function-saved.snd")
- snd_display("edit_list2function called $save_state_hook")
- delete_file("edit-list-to-function-saved.snd")
- end
- save_edit_history("save-edit-history-saved.rb", ind, 0)
- if File.exists?("edit-list-to-function-saved.snd")
- snd_display("save_edit_history called $save_state_hook")
- delete_file("edit-list-to-function-saved.snd")
- end
- delete_files("save-edit-history-saved.rb", "savehook.snd")
- close_sound(ind)
- else
- snd_display("save_state after hook restored but no sound?")
- end
- else
- snd_display("$save_state_hook redirect failed: %s?", $save_state_hook.inspect)
- end
- delete_file("s61.rb")
- $save_state_hook.reset_hook!
#
add_sound_file_extension("ogg")
add_sound_file_extension("OGG")
@@ -30481,9 +28491,9 @@ def test_19_00
close_sound(ind)
delete_file("t1.rb")
#
- ind = new_sound("fmv.snd", Mus_next, Mus_bshort, 22050, 8,
+ ind = new_sound("fmv.snd", 8, 22050, Mus_bshort, Mus_next,
"this is an 8-channel save-state test")
- ind1 = new_sound("fmv1.snd", Mus_next, Mus_bshort, 22050, 2,
+ ind1 = new_sound("fmv1.snd", 2, 22050, Mus_bshort, Mus_next,
"this is an 2-channel save-state test")
set_sample(10, 0.1, ind, 0)
set_sample(10, 0.2, ind, 1)
@@ -30527,12 +28537,7 @@ def test_19_00
set_transform_normalization(Dont_normalize, ind, 0)
set_graph_style(Graph_filled, ind, 0)
set_transform_graph_type(Graph_as_spectrogram, ind, 0)
- unless $with_test_gtk
- # FIXME
- # doesn't work with GTK
- # snd-ruby-xg -noinit snd-test.rb 19 ==> hangs on load("s61.rb") below
- set_time_graph_type(Graph_as_wavogram, ind, 0)
- end
+ set_time_graph_type(Graph_as_wavogram, ind, 0)
set_x_axis_style(X_axis_as_percentage, ind, 0)
set_speed_control_style(Speed_control_as_semitone, ind, 0)
set_cursor(1234, ind, 0)
@@ -30788,7 +28793,7 @@ def test_19_01
if fneq(sample(10), 0.5)
snd_display("insert_sample save_state: %s?", channel2vct(5, 10, ind, 0))
end
- if (res = frames(ind, 0)) != 101
+ if (res = framples(ind, 0)) != 101
snd_display("insert_sample save_state len: %s?", res)
end
}],
@@ -30797,7 +28802,7 @@ def test_19_01
if fneq(sample(10), 0.0)
snd_display("delete_sample save_state: %s?", channel2vct(5, 10, ind, 0))
end
- if (res = frames(ind, 0)) != 99
+ if (res = framples(ind, 0)) != 99
snd_display("delete_sample save_state len: %s?", res)
end
}],
@@ -30806,7 +28811,7 @@ def test_19_01
if fneq(sample(10), 0.5)
snd_display("set_sample save_state: %s?", channel2vct(5, 10, ind, 0))
end
- if (res = frames(ind, 0)) != 100
+ if (res = framples(ind, 0)) != 100
snd_display("set_sample save_state len: %s?", res)
end
}],
@@ -30815,7 +28820,7 @@ def test_19_01
if fneq(sample(10), 0.25)
snd_display("scl sample save_state: %s?", channel2vct(5, 10, ind, 0))
end
- if (res = frames(ind, 0)) != 100
+ if (res = framples(ind, 0)) != 100
snd_display("scl sample save_state len: %s?", res)
end
if (res = edit_position(ind, 0)) != 2
@@ -30824,7 +28829,7 @@ def test_19_01
}],
[lambda { |ind| vct2channel(Vct.new(10, 0.5), 10, 5, ind, 0); pad_channel(12, 5, ind, 0) },
lambda { |ind|
- if (res = frames(ind, 0)) != 105
+ if (res = framples(ind, 0)) != 105
snd_display("pad sample save_state len: %s?", res)
end
if (res = edit_position(ind, 0)) != 2
@@ -30837,7 +28842,7 @@ def test_19_01
}],
[lambda { |ind| map_channel(lambda { |y| 1.0 }); env_channel([0, 0, 1, 1], 0, 11, ind, 0) },
lambda { |ind|
- if (res = frames(ind, 0)) != 100
+ if (res = framples(ind, 0)) != 100
snd_display("env sample save_state len: %s?", res)
end
if (res = edit_position(ind, 0)) != 2
@@ -30857,7 +28862,7 @@ def test_19_01
})
},
lambda { |ind|
- if (res = frames(ind, 0)) != 50
+ if (res = framples(ind, 0)) != 50
snd_display("map false save_state len: %s?", res)
end
if (res = edit_position(ind, 0)) != 1
@@ -30945,7 +28950,7 @@ def test_19_01
})
snd_display("as_one_edit save_state 5: %s?", res)
end
- if (res = frames(ind, 0)) != 97
+ if (res = framples(ind, 0)) != 97
snd_display("save_state backup del+insert len: %s?", res)
end
}],
@@ -30967,7 +28972,7 @@ def test_19_01
if (res = edit_position(ind, 0)) != 5
snd_display("embed save_state edpos: %s?", res)
end
- if (res = frames(ind, 0)) != 87
+ if (res = framples(ind, 0)) != 87
snd_display("embed save_state len: %s?", res)
end
unless vequal(res = channel2vct(0, 25, ind, 0),
@@ -30978,7 +28983,8 @@ def test_19_01
}]].each_with_index do |args, i|
func = args[0]
test = args[1]
- ind = new_sound("test.snd", Mus_next, Mus_bfloat, 22050, 1, "mono save-state tests", 100)
+ ind = new_sound("test.snd", 1, 22050, Mus_bfloat, Mus_next,
+ "mono save-state tests", 100)
func.call(ind)
delete_file("s61.rb")
save_state("s61.rb")
@@ -30999,7 +29005,7 @@ def test_19_02
#
ind = open_sound("oboe.snd")
mx0 = maxamp
- frs = frames
+ frs = framples
# simple scale
scale_channel(2.0)
if fneq(res = maxamp, 2 * mx0)
@@ -31034,7 +29040,7 @@ def test_19_02
revert_sound(ind)
# simple delete
delete_samples(10, 100)
- if (res = frames) != frs - 100
+ if (res = framples) != frs - 100
snd_display("edit_list2function delete: %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
@@ -31044,12 +29050,12 @@ def test_19_02
snd_display("edit_list2function 2: %s", res)
end
func.call(ind, 0)
- if (res = frames) != frs - 200
+ if (res = framples) != frs - 200
snd_display("edit_list2function called (2): %s %s?", frs, res)
end
revert_sound(ind)
delete_sample(100)
- if (res = frames) != frs - 1
+ if (res = framples) != frs - 1
snd_display("edit_list2function delete (2a): %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
@@ -31059,13 +29065,13 @@ def test_19_02
snd_display("edit_list2function 2a: %s", res)
end
func.call(ind, 0)
- if (res = frames) != frs - 2
+ if (res = framples) != frs - 2
snd_display("edit_list2function called (2a): %s %s?", frs, res)
end
revert_sound(ind)
# simple zero pad
pad_channel(10, 100)
- if (res = frames) != frs + 100
+ if (res = framples) != frs + 100
snd_display("edit_list2function pad: %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
@@ -31075,12 +29081,12 @@ def test_19_02
snd_display("edit_list2function 3: %s", res)
end
func.call(ind, 0)
- if (res = frames) != frs + 200
+ if (res = framples) != frs + 200
snd_display("edit_list2function called (3): %s %s?", frs, res)
end
revert_sound(ind)
insert_silence(10, 100)
- if (res = frames) != frs + 100
+ if (res = framples) != frs + 100
snd_display("edit_list2function pad (3a): %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
@@ -31090,7 +29096,7 @@ def test_19_02
snd_display("edit_list2function 3a: %s", res)
end
func.call(ind, 0)
- if (res = frames) != frs + 200
+ if (res = framples) != frs + 200
snd_display("edit_list2function called (3a): %s %s?", frs, res)
end
revert_sound(ind)
@@ -31203,7 +29209,7 @@ def test_19_02
snd_display("edit_list2function 7e edpos: %s?", res)
end
revert_sound(ind)
- env_sound([0, 0, 1, 1, 2, 0], 0, frames, 32.0)
+ env_sound([0, 0, 1, 1, 2, 0], 0, framples, 32.0)
snd_test_neq(maxamp(), 0.146, "edit_list2function 7f max")
unless proc?(func = edit_list2function)
snd_display("edit_list2function 7f: %s", func)
@@ -31215,7 +29221,7 @@ def test_19_02
func.call(ind, 0)
snd_test_neq(maxamp(), 0.146, "edit_list2function called (7f)")
revert_sound(ind)
- env_sound([0, 0, 1, 1, 2, 1, 3, 0], 0, frames, 0.0)
+ env_sound([0, 0, 1, 1, 2, 1, 3, 0], 0, framples, 0.0)
if fneq(res = sample(4000), 0.0)
snd_display("edit_list2function env 7g: %s?", res)
end
@@ -31231,10 +29237,9 @@ def test_19_02
snd_display("edit_list2function called (7g): %s?", res)
end
revert_sound(ind)
- # simple ptree skipped
# simple 1 sample insert
insert_sample(100, 0.1)
- if (res = frames) != frs + 1
+ if (res = framples) != frs + 1
snd_display("edit_list2function insert_sample: %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
@@ -31247,20 +29252,20 @@ def test_19_02
unless vequal(res = channel2vct(99, 4), vct(0.0, 0.1, 0.1, 0.0))
snd_display("edit_list2function func 9: %s?", res)
end
- if (res = frames) != frs + 2
+ if (res = framples) != frs + 2
snd_display("edit_list2function called (9): %s %s?", frs, res)
end
revert_sound(ind)
# insert_samples with data
insert_samples(0, 100, Vct.new(100, 0.1))
- if (res = frames) != frs + 100
+ if (res = framples) != frs + 100
snd_display("edit_list2function insert_samples (100): %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
snd_display("edit_list2function 9a: %s", func)
end
func.call(ind, 0)
- if (res = frames) != frs + 200
+ if (res = framples) != frs + 200
snd_display("edit_list2function insert_samples (200): %s %s?", frs, res)
end
unless vequal(res = channel2vct(0, 5), vct(0.1, 0.1, 0.1, 0.1, 0.1))
@@ -31269,14 +29274,14 @@ def test_19_02
revert_sound(ind)
# set_samples with data
set_samples(0, 100, Vct.new(100, 0.1))
- if (res = frames) != frs
+ if (res = framples) != frs
snd_display("edit_list2function set_samples (1): %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
snd_display("edit_list2function 9b: %s", func)
end
func.call(ind, 0)
- if (res = frames) != frs
+ if (res = framples) != frs
snd_display("edit_list2function set_samples (2): %s %s?", frs, res)
end
unless vequal(res = channel2vct(0, 5), vct(0.1, 0.1, 0.1, 0.1, 0.1))
@@ -31286,8 +29291,8 @@ def test_19_02
# simple 1 sample set
val = sample(100)
set_sample(100, 0.1)
- if (res = frames) != frs
- snd_display("edit_list2function set_sample frames: %s %s?", frs, res)
+ if (res = framples) != frs
+ snd_display("edit_list2function set_sample framples: %s %s?", frs, res)
end
if fneq(res = sample(100), 0.1)
snd_display("edit_list2function set_sample val: %s %s?", val, res)
@@ -31308,10 +29313,10 @@ def test_19_02
snd_display("edit_list2function func 10: %s?", res)
end
revert_sound(ind)
- pfrs = mus_sound_frames("pistol.snd")
+ pfrs = mus_sound_framples("pistol.snd")
insert_sound("pistol.snd", 1000)
- if (res = frames) != frs + pfrs
- snd_display("edit_list2function insert_sound frames: %s %s?", frs, res)
+ if (res = framples) != frs + pfrs
+ snd_display("edit_list2function insert_sound framples: %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
snd_display("edit_list2function 10a: %s", func)
@@ -31321,14 +29326,14 @@ def test_19_02
end
revert_sound(ind)
func.call(ind, 0)
- if (res = frames) != frs + pfrs
+ if (res = framples) != frs + pfrs
snd_display("edit_list2function called (10a): %s %s?", frs, res)
end
revert_sound(ind)
- pfrs = mus_sound_frames("pistol.snd")
+ pfrs = mus_sound_framples("pistol.snd")
insert_samples(1000, pfrs, "pistol.snd")
- if (res = frames) != frs + pfrs
- snd_display("edit_list2function insert_samples frames: %s %s?", frs, res)
+ if (res = framples) != frs + pfrs
+ snd_display("edit_list2function insert_samples framples: %s %s?", frs, res)
end
unless proc?(func = edit_list2function)
snd_display("edit_list2function 11: %s", func)
@@ -31340,7 +29345,7 @@ def test_19_02
end
revert_sound(ind)
func.call(ind, 0)
- if (res = frames) != frs + pfrs
+ if (res = framples) != frs + pfrs
snd_display("edit_list2function called (11): %s %s?", frs, res)
end
revert_sound(ind)
@@ -31438,7 +29443,8 @@ def test_19_02
env_channel([0, 0, 1, 1, 2, 0])
func = edit_list2function
close_sound(ind)
- ind = new_sound("tmp.snd", Mus_next, Mus_bfloat, 22050, 1, :size, 20, :comment, false)
+ ind = new_sound("tmp.snd", 1, 22050, Mus_bfloat, Mus_next,
+ :size, 20, :comment, false)
map_channel(lambda do |y| 1.0 end)
func.call(ind, 0)
unless vequal(res = channel2vct,
@@ -31504,8 +29510,8 @@ def test_19_02
revert_sound(ind)
# src
src_sound(2.0)
- if (frames - 25415).abs > 2
- snd_display("edit_list2function 18 len: %s?", frames)
+ if (framples - 25415).abs > 2
+ snd_display("edit_list2function 18 len: %s?", framples)
end
unless proc?(func = edit_list2function)
snd_display("edit_list2function 18: %s", func)
@@ -31515,12 +29521,12 @@ def test_19_02
end
revert_sound(ind)
func.call(ind, 0)
- if (frames - 25415).abs > 2
- snd_display("edit_list2function 18 re-len: %s?", frames)
+ if (framples - 25415).abs > 2
+ snd_display("edit_list2function 18 re-len: %s?", framples)
end
revert_sound(ind)
src_channel(2.0, 1000, 500)
- frs = frames
+ frs = framples
unless proc?(func = edit_list2function)
snd_display("edit_list2function 18a: %s", func)
end
@@ -31529,12 +29535,12 @@ def test_19_02
end
revert_sound(ind)
func.call(ind, 0)
- if frames != frs
- snd_display("edit_list2function 18a re-len: %s?", frames)
+ if framples != frs
+ snd_display("edit_list2function 18a re-len: %s?", framples)
end
revert_sound(ind)
src_sound([0, 1, 1, 2, 2, 1])
- frs = frames
+ frs = framples
unless proc?(func = edit_list2function)
snd_display("edit_list2function 18b: %s", func)
end
@@ -31543,12 +29549,12 @@ def test_19_02
end
revert_sound(ind)
func.call(ind, 0)
- if frames != frs
- snd_display("edit_list2function 18b re-len: %s?", frames)
+ if framples != frs
+ snd_display("edit_list2function 18b re-len: %s?", framples)
end
revert_sound(ind)
src_channel([0, 1, 1, 2], 1000, 500)
- frs = frames
+ frs = framples
unless proc?(func = edit_list2function)
snd_display("edit_list2function 18c: %s", func)
end
@@ -31557,8 +29563,8 @@ def test_19_02
end
revert_sound(ind)
func.call(ind, 0)
- if frames != frs
- snd_display("edit_list2function 18c re-len: %s?", frames)
+ if framples != frs
+ snd_display("edit_list2function 18c re-len: %s?", framples)
end
revert_sound(ind)
# filter-channel
@@ -31605,12 +29611,6 @@ def test_19_02
"Proc.new {|snd, chn| env_sound_interp([0, 0, 1, 1, 2, 0], 2.0, snd, chn) }"],
[lambda { add_notes([["1a.snd"], ["pistol.snd", 1.0, 2.0]]) },
"Proc.new {|snd, chn| add_notes([[\"1a.snd\"], [\"pistol.snd\", 1.0, 2.0]], snd, chn) }"],
- [lambda { compand_channel },
- "Proc.new {|snd, chn| compand_channel(0, false, snd, chn) }"],
- [lambda { smooth_channel_via_ptree },
- "Proc.new {|snd, chn| smooth_channel_via_ptree(0, false, snd, chn) }"],
- [lambda { ring_modulate_channel(300) },
- "Proc.new {|snd, chn| ring_modulate_channel(300, 0, false, snd, chn) }"],
[lambda { filtered_env([0, 0, 1, 1, 2, 0]) },
"Proc.new {|snd, chn| filtered_env([0, 0, 1, 1, 2, 0], snd, chn) }"],
[lambda { reverse_by_blocks(0.1) },
@@ -32422,8 +30422,7 @@ def test_lgamma
res1 = lgamma(x)
res2 = gammln(x)
if array?(res1)
- # FIXME
- # Ruby 1.9 returns an array
+ # XXX: Ruby 1.9+ returns an array
res1 = res1[0]
end
snd_test_neq(res1, res2, "lgamma(%1.1f)", x)
@@ -32547,7 +30546,6 @@ def corr(x, y, n, m)
end
def cross_correlate_3(rl1, rl2, fftlen)
- fftlen2 = fftlen / 2
fftscale = 1.0 / fftlen
im1 = Vct.new(fftlen)
im2 = Vct.new(fftlen)
@@ -32555,7 +30553,6 @@ def cross_correlate_3(rl1, rl2, fftlen)
fft(rl2, im2, 1)
tmprl = rl1.dup
tmpim = im1.dup
- data3 = Vct.new(fftlen)
tmprl *= rl2
tmpim *= im2
im2 *= rl1
@@ -32566,7 +30563,7 @@ def cross_correlate_3(rl1, rl2, fftlen)
end
def automorph(a, b, c, d, snd = false, chn = false)
- len = frames(snd, chn)
+ len = framples(snd, chn)
pow2 = (log(len) / log(2)).ceil.to_i
fftlen = (2 ** pow2).round
fftscale = 1.0 / fftlen
@@ -33400,20 +31397,6 @@ def test_20_01
end
close_sound(ind)
#
- if defined? gsl_dht
- add_transform("Hankel", "Hankel", 0.0, 1.0,
- lambda do |n, rd|
- v = make_vct!(n) do rd.call end
- gsl_dht(n, v, 1.0, 1.0)
- end)
- n = 16
- v = make_vct(n, 1.0)
- gsl_dht(n, v, 1.0, 1.0)
- if (res = Snd.catch do gsl_dht(-1, Vct.new(3), 1.0, 1.0) end).first != :out_of_range
- snd_display("gsl_dht bad size: %s?", res.inspect)
- end
- end
- #
ind1 = open_sound("oboe.snd")
set_time_graph_style(Graph_lollipops, ind1, 0)
graph2ps("aaa.eps")
@@ -33421,47 +31404,21 @@ def test_20_01
set_transform_graph_type(Graph_as_sonogram, ind1, 0)
set_transform_size(256)
update_transform_graph
- size = transform_frames(ind1, 0)
+ size = transform_framples(ind1, 0)
if number?(size) or size.length != 3
- snd_display("transform_frames of sonogram: %s?", size)
+ snd_display("transform_framples of sonogram: %s?", size)
end
graph2ps("aaa.eps")
- if $with_test_gui
- Snd.catch do
- unless (ax = axis_info(ind1, 0, Transform_graph))
- snd_display("axis_info Transform_graph?")
- end
- if $with_test_motif
- cwid = channel_widgets(ind1, 0).first
- focus_widget(cwid)
- click_event(cwid, 0, 0, (0.5 * (ax[10] + ax[12])).floor, (0.5 * (ax[11] + ax[13])).floor)
- force_event
- end
- end
- end
old_colormap = colormap
set_colormap(integer2colormap(0))
update_transform_graph
set_transform_graph_type(Graph_as_spectrogram, ind1, 0)
update_transform_graph
graph2ps("aaa.eps")
- if $with_test_gui
- Snd.catch do
- unless (ax = axis_info(ind1, 0, Transform_graph))
- snd_display("axis_info Transform_graph?")
- end
- if $with_test_motif
- cwid = channel_widgets(ind1, 0).first
- focus_widget(cwid)
- click_event(cwid, 0, 0, (0.5 * (ax[10] + ax[12])).floor, (0.5 * (ax[11] + ax[13])).floor)
- force_event
- end
- end
- end
set_colormap(old_colormap)
close_sound(ind1)
#
- ind = new_sound("test.snd", Mus_next, Mus_bfloat)
+ ind = new_sound("test.snd", :header_type, Mus_next, :sample_type, Mus_bfloat)
pad_channel(0, 1000)
set_transform_graph_type(Graph_once, ind, 0)
set_show_transform_peaks(true, ind, 0)
@@ -33498,13 +31455,7 @@ def test_20_01
set_transform_graph_type(Graph_as_sonogram, ind, 0)
set_fft_log_magnitude(false, ind, 0)
update_transform_graph
- unless $with_test_gtk
- # FIXME
- # doens't work with GTK
- # Assertion failed: (! surface->finished), function _cairo_surface_begin_modification, file cairo-surface.c, line 385.
- # Abort (core dumped)
- graph2ps("aaa.eps")
- end
+ graph2ps("aaa.eps")
set_with_gl(false)
set_spectrum_end(0.2, ind, 0)
set_transform_graph_type(Graph_as_spectrogram, ind, 0)
@@ -33521,9 +31472,9 @@ def test_20_02
1.000, 0.963, 0.860, 0.709, 0.536, 0.366, 0.221, 0.113),
"dolph 16 2.5 (dsp.rb)")
v = Vct.new(8)
- v0 = Vct.new(8) do |i| v[i] = random(2.0) - 1.0 end
+ v0 = Vct.new(8) do |i| v[i] = mus_random(1.0) end
v = dht(dht(v)).scale(1.0 / 8.0)
- snd_test_any_neq(v, v0, :vvequal?, "dht twice") # okay
+ snd_test_any_neq(v, v0, :vvequal?, "dht twice")
v.fill 0.0
v[1] = 1.0
snd_test_neq(dht(v), vct(1, 1.414, 1, 0, -1, -1.414, -1, 0), "dht of pulse")
@@ -33549,7 +31500,7 @@ def test_20_02
close_sound(ind)
#
ind = open_sound("1a.snd")
- frms = frames(ind)
+ frms = framples(ind)
valf = find_sine(440.0, 0, frms, ind).first
valg = 2 * (goertzel(440.0, 0, frms, ind) / frms)
valf1 = find_sine(100.0, 0, frms, ind).first
@@ -33598,15 +31549,15 @@ def test_20_02
undo_edit
spectral_polynomial(vct(0, 1), ind, 0)
snd_test_neq(maxamp(), 0.493, "spectral_polynomial 0 mx")
- snd_test_neq(frames(ind, 0), 41623, "spectral_polynomial 0 len")
+ snd_test_neq(framples(ind, 0), 41623, "spectral_polynomial 0 len")
undo_edit
spectral_polynomial(vct(0, 0.5, 0.5), ind, 0)
snd_test_neq(maxamp(), 0.493, "spectral_polynomial 1 mx")
- snd_test_neq(frames(ind, 0), 41623 * 2, "spectral_polynomial 1 len")
+ snd_test_neq(framples(ind, 0), 41623 * 2, "spectral_polynomial 1 len")
undo_edit
spectral_polynomial(vct(0, 0, 0, 1), ind, 0)
snd_test_neq(maxamp(), 0.493, "spectral_polynomial 2 mx")
- snd_test_neq(frames(ind, 0), 41623 * 3, "spectral_polynomial 2 len")
+ snd_test_neq(framples(ind, 0), 41623 * 3, "spectral_polynomial 2 len")
close_sound(ind)
#
vals = scentroid("oboe.snd")
@@ -33665,7 +31616,7 @@ def test_20_02
gen = make_oscil(440)
map_chan(lambda { |y| oscil(gen) })
down_oct(2)
- snd_test_neq(frames(), 200, "down_oct new len")
+ snd_test_neq(framples(), 200, "down_oct new len")
r1 = make_sampler(0, ind, 0, 1, 1)
r2 = make_sampler(0, ind, 0, 1, 2)
200.times do |i|
@@ -33738,9 +31689,7 @@ def test_20_02
end
false
end)
- if mxdiff > 0.003
- snd_display(snd_format(mxdiff, 0.003, ">", "automorph rotation"))
- end
+ snd_test_gt(mxdiff, 0.003, "automorph rotation")
close_sound(ind)
end
@@ -33780,7 +31729,10 @@ def display_samps_in_red(snd, chn)
offset = [0, 1000 - left].max
new_data = data.subseq(offset, offset + samps)
set_foreground_color(red, snd, chn)
- graph_data(new_data, snd, chn, Copy_context, [1000, left].max, [2000, right].min)
+ cr = make_cairo(channel_widgets(snd, chn)[0])
+ graph_data(new_data, snd, chn, Copy_context,
+ [1000, left].max, [2000, right].min, Graph_lines, cr)
+ free_cairo(cr)
set_foreground_color(old_color, snd, chn)
when Array
low_data = data[0]
@@ -33794,24 +31746,33 @@ def display_samps_in_red(snd, chn)
new_low_data = low_data.subseq(left_bin, right_bin)
new_high_data = high_data.subseq(left_bin, right_bin)
set_foreground_color(red, snd, chn)
- graph_data([new_low_data, new_high_data], snd, chn, Copy_context, left_bin, right_bin)
+ cr = make_cairo(channel_widgets(snd, chn)[0])
+ graph_data([new_low_data, new_high_data], snd, chn, Copy_context,
+ left_bin, right_bin, Graph_lines, cr)
+ free_cairo(cr)
set_foreground_color(old_color, snd, chn)
end
end
+rescue
+ snd_display("draw error in %s", get_func_name)
end
-def show_hiho(snd, chn)
+def show_greeting(snd, chn)
ls = left_sample(snd, chn)
rs = right_sample(snd, chn)
if ls < 1000 and rs > 1000
pos = x2position(1000.0 / srate(snd), snd, chn)
old_color = foreground_color(snd, chn)
+ cr = make_cairo(channel_widgets(snd, chn)[0])
set_foreground_color(make_color_with_catch(0.75, 0.75, 0.75), snd, chn)
- fill_rectangle(pos, 10, 50, 20, snd, chn)
+ fill_rectangle(pos, 10, 50, 20, snd, chn, Time_graph, false, cr)
set_foreground_color(make_color_with_catch(1, 0, 0), snd, chn)
- draw_string("hiho", pos + 5, 24, snd, chn)
+ draw_string("hi!", pos + 5, 24, snd, chn, Time_graph, cr)
set_foreground_color(old_color, snd, chn)
+ free_cairo(cr)
end
+rescue
+ snd_display("draw error in %s", get_func_name)
end
def st_equal?(a, b)
@@ -33826,7 +31787,8 @@ def st_vequal_2(a, b)
vequal(a[0], b[0]) and vequal(a[1], b[1])
end
-def test_sound_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, set_p, chan, global)
+def test_sound_func_1(func, ind_1, ind_2, new_val,
+ eq_func, leq_func, set_p, chan, global)
old_val = snd_func(func)
old_vals = snd_func(func, true)
old_default = snd_func(func, false)
@@ -33835,10 +31797,12 @@ def test_sound_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, set_p, cha
sel_snd = selected_sound()
unsel_snd = sel_snd == ind_1 ? ind_2 : ind_1
caller = chan ? "channel" : "sound"
- snd_test_any_neq(old_val, old_default, eq_func, "%s sound_func: no arg false", func)
+ snd_test_any_neq(old_val, old_default, eq_func,
+ "%s sound_func: no arg false", func)
unless method(leq_func).call(old_vals, [old_1, old_2]) or
- method(leq_func).call(old_vals, [old_2, old_1])
- snd_display(snd_format_neq(old_vals, [old_1, old_2], "%s sound_func true", func))
+ method(leq_func).call(old_vals, [old_2, old_1])
+ s = snd_format_neq(old_vals, [old_1, old_2], "%s sound_func true", func)
+ snd_display_prev_caller(s)
end
if set_p
set_snd_func(func, new_val)
@@ -33848,12 +31812,16 @@ def test_sound_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, set_p, cha
snd_test_any_neq(res1, new_val, eq_func, "set_%s no arg", func)
snd_test_any_neq(res1, res2, eq_func, "set_%s no arg sel", func)
if (global and (not method(eq_func).call(res1, res3))) or
- (not global and method(eq_func).call(res1, res3))
- snd_display(snd_format_neq(res1, res3, "set_%s no arg unsel", func))
+ ((not global) and method(eq_func).call(res1, res3))
+ s = snd_format_neq(res1, res3, "set_%s no arg unsel", func)
+ snd_display_prev_caller(s)
end
res1 = snd_func(func, true)
- unless method(leq_func).call(res1, [res2, res3]) or method(leq_func).call(res1, [res3, res2])
- snd_display(snd_format_neq(res1, [res2, res3], "set_%s %s_func true", func, caller))
+ unless method(leq_func).call(res1, [res2, res3]) or
+ method(leq_func).call(res1, [res3, res2])
+ s = snd_format_neq(res1, [res2, res3],
+ "set_%s %s_func true", func, caller)
+ snd_display_prev_caller(s)
end
set_snd_func(func, old_val)
if set_p == :swap
@@ -33861,13 +31829,21 @@ def test_sound_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, set_p, cha
else
set_snd_func(func, new_val, ind_1)
end
- snd_test_any_neq(snd_func(func, ind_1), new_val, eq_func, "set_%s arg", func)
- snd_test_any_eq(snd_func(func, ind_2), new_val, eq_func, "set_%s arg (2)", func)
- res1 = snd_func(func, true)
- res2 = snd_func(func, ind_1)
- res3 = snd_func(func, ind_2)
- unless method(leq_func).call(res1, [res2, res3]) or method(leq_func).call(res1, [res3, res2])
- snd_display(snd_format_neq(res1, [res2, res3], "set_%s %s_func arg", func, caller))
+ res0 = snd_func(func, true)
+ res1 = snd_func(func, ind_1)
+ res2 = snd_func(func, ind_2)
+ unless method(eq_func).call(res1, new_val)
+ s = snd_format_neq(res1, new_val, "set_%s arg", func)
+ snd_display_prev_caller(s)
+ end
+ if method(eq_func).call(res2, new_val)
+ s = snd_format_eq(res2, new_val, "set_%s arg (2)", func)
+ snd_display_prev_caller(s)
+ end
+ unless method(leq_func).call(res0, [res1, res2]) or
+ method(leq_func).call(res0, [res2, res1])
+ s = snd_format_neq(res0, [res1, res2], "set_%s %s_func arg", func, caller)
+ snd_display_prev_caller(s)
end
if set_p == :swap
set_snd_func(func, ind_1, old_1)
@@ -33876,12 +31852,23 @@ def test_sound_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, set_p, cha
set_snd_func(func, old_1, ind_1)
set_snd_func(func, new_val, true)
end
- res1 = snd_func(func, true)
- res2 = snd_func(func, ind_1)
- res3 = snd_func(func, ind_2)
- snd_test_any_neq(res1, [new_val, new_val], leq_func, "set_%s %s_func arg true", func, caller)
- snd_test_any_neq(res2, new_val, eq_func, "set_%s %s_func arg true", func, caller)
- snd_test_any_neq(res3, new_val, eq_func, "set_%s %s_func arg true (2)", func, caller)
+ res0 = snd_func(func, true)
+ res1 = snd_func(func, ind_1)
+ res2 = snd_func(func, ind_2)
+ unless method(leq_func).call(res0, [new_val, new_val])
+ s = snd_format_neq(res0, [new_val, new_val],
+ "set_%s %s_func arg true", func, caller)
+ snd_display_prev_caller(s)
+ end
+ unless method(eq_func).call(res1, new_val)
+ s = snd_format_neq(res1, new_val, "set_%s %s_func arg true", func, caller)
+ snd_display_prev_caller(s)
+ end
+ unless method(eq_func).call(res2, new_val)
+ s = snd_format_neq(res2, new_val,
+ "set_%s %s_func arg true (2)", func, caller)
+ snd_display_prev_caller(s)
+ end
if set_p == :swap
set_snd_func(func, ind_1, old_1)
set_snd_func(func, ind_2, old_2)
@@ -33889,14 +31876,21 @@ def test_sound_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, set_p, cha
set_snd_func(func, old_1, ind_1)
set_snd_func(func, old_2, ind_2)
end
- res2 = snd_func(func, ind_1)
- res3 = snd_func(func, ind_2)
- snd_test_any_neq(res2, old_1, eq_func, "set_%s arg true old", func)
- snd_test_any_neq(res3, old_2, eq_func, "set_%s arg true old (2)", func)
+ res1 = snd_func(func, ind_1)
+ res2 = snd_func(func, ind_2)
+ unless method(eq_func).call(res1, old_1)
+ s = snd_format_neq(res1, old_1, "set_%s arg true old", func)
+ snd_display_prev_caller(s)
+ end
+ unless method(eq_func).call(res2, old_2)
+ s = snd_format_neq(res2, old_2, "set_%s arg true old (2)", func)
+ snd_display_prev_caller(s)
+ end
end
end
-def test_channel_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, set_p, global)
+def test_channel_func_1(func, ind_1, ind_2, new_val,
+ eq_func, leq_func, set_p, global)
old_1_0 = snd_func(func, ind_1, 0)
old_2_0 = snd_func(func, ind_2, 0)
old_2_1 = snd_func(func, ind_2, 1)
@@ -33904,29 +31898,74 @@ def test_channel_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, set_p, g
old_2_all = snd_func(func, ind_2, true)
old_all_0 = snd_func(func, true, 0)
old_all_all = snd_func(func, true, true)
- snd_test_any_neq(old_1_0, old_1_all[0], eq_func, "%s channel_func: old 1/true", func)
- snd_test_any_neq(old_2_0, old_2_all[0], eq_func, "%s channel_func: old 2-1/true", func)
- snd_test_any_neq(old_2_1, old_2_all[1], eq_func, "%s channel_func: old 2-2/true", func)
- snd_test_any_neq(old_1_all, [old_1_0], leq_func, "%s channel_func true", func)
- snd_test_any_neq(old_2_all, [old_2_0, old_2_1], leq_func, "%s channel_func true", func)
+ unless method(eq_func).call(old_1_0, old_1_all[0])
+ s = snd_format_neq(old_1_0, old_1_all[0],
+ "%s channel_func: old 1/true", func)
+ snd_display_prev_caller(s)
+ end
+ unless method(eq_func).call(old_2_0, old_2_all[0])
+ s = snd_format_neq(old_2_0, old_2_all[0],
+ "%s channel_func: old 2-1/true", func)
+ snd_display_prev_caller(s)
+ end
+ unless method(eq_func).call(old_2_1, old_2_all[1])
+ s = snd_format_neq(old_2_1, old_2_all[1],
+ "%s channel_func: old 2-2/true", func)
+ snd_display_prev_caller(s)
+ end
+ unless method(leq_func).call(old_1_all, [old_1_0])
+ s = snd_format_neq(old_1_all, [old_1_0], "%s channel_func true", func)
+ snd_display_prev_caller(s)
+ end
+ unless method(leq_func).call(old_2_all, [old_2_0, old_2_1])
+ s = snd_format_neq(old_2_all, [old_2_0, old_2_1],
+ "%s channel_func true", func)
+ snd_display_prev_caller(s)
+ end
unless ((method(leq_func).call(old_all_all[0], old_1_all) or
method(leq_func).call(old_all_all[0], old_2_all)) and
(method(leq_func).call(old_all_all[1], old_1_all) or
(method(leq_func).call(old_all_all[1], old_2_all))))
- snd_display(snd_format_neq(old_all_all[0], old_1_all, "%s channel_func true true", func))
+ s = snd_format_neq(old_all_all[0], old_1_all,
+ "%s channel_func true true", func)
+ snd_display_prev_caller(s)
end
if set_p
set_snd_func(func, new_val, ind_1, 0)
- snd_test_any_neq(snd_func(func, ind_1, 0), new_val, eq_func, "set_%s channel_func", func)
- snd_test_any_eq(snd_func(func, ind_2, 0), new_val, eq_func, "set_%s 2 channel_func", func)
+ res1 = snd_func(func, ind_1, 0)
+ res2 = snd_func(func, ind_2, 1)
+ unless method(eq_func).call(res1, new_val)
+ s = snd_format_neq(res1, new_val, "set_%s channel_func", func)
+ snd_display_prev_caller(s)
+ end
+ if method(eq_func).call(res2, new_val)
+ s = snd_format_eq(res2, new_val, "set_%s 2 channel_func", func)
+ snd_display_prev_caller(s)
+ end
set_snd_func(func, old_1_0, ind_1, 0)
set_snd_func(func, new_val, ind_2, 1)
- snd_test_any_eq(snd_func(func, ind_1, 0), new_val, eq_func, "set_%s (2) channel_func", func)
- snd_test_any_neq(snd_func(func, ind_2, 1), new_val, eq_func, "set_%s (2) 2 channel_func", func)
+ res1 = snd_func(func, ind_1, 0)
+ res2 = snd_func(func, ind_2, 1)
+ if method(eq_func).call(res1, new_val)
+ s = snd_format_eq(res1, new_val, "set_%s (2) channel_func", func)
+ snd_display_prev_caller(s)
+ end
+ unless method(eq_func).call(res2, new_val)
+ s = snd_format_neq(res2, new_val, "set_%s (2) 2 channel_func", func)
+ snd_display_prev_caller(s)
+ end
set_snd_func(func, new_val, ind_2, 0)
set_snd_func(func, old_2_0, ind_2, true)
- snd_test_any_neq(snd_func(func, ind_2, 0), old_2_0, eq_func, "set_%s (true 0) 2 channel_func", func)
- snd_test_any_neq(snd_func(func, ind_2, 1), old_2_0, eq_func, "set_%s (true 1) 2 channel_func", func)
+ res1 = snd_func(func, ind_2, 0)
+ res2 = snd_func(func, ind_2, 1)
+ unless method(eq_func).call(res1, old_2_0)
+ s = snd_format_neq(res1, old_2_0, "set_%s (true 0) 2 channel_func", func)
+ snd_display_prev_caller(s)
+ end
+ unless method(eq_func).call(res2, old_2_0)
+ s = snd_format_neq(res2, old_2_0, "set_%s (true 1) 2 channel_func", func)
+ snd_display_prev_caller(s)
+ end
set_snd_func(func, old_2_0, ind_2, 0)
set_snd_func(func, old_2_1, ind_2, 1)
end
@@ -33951,7 +31990,7 @@ def test_21_00
unless channels_eql?(ind1, 0, ind2, 0)
snd_display("channels_eql? of copy")
end
- pad_channel(frames(ind2, 0), 100)
+ pad_channel(framples(ind2, 0), 100)
if channels_equal?(ind1, 0, ind2, 0)
snd_display("channels_equal? of pad")
end
@@ -33977,9 +32016,7 @@ def test_21_00
display_db(ind1, 0)
display_samps_in_red(ind1, 0)
update_time_graph
- Snd.catch(:all, lambda do |*args| snd_display("show_hiho trouble: %s", args) end) do
- show_hiho(ind1, 0)
- end
+ show_greeting(ind1, 0)
update_time_graph
color_samples(highlight_color, 0, 100, ind1, 0)
update_time_graph
@@ -33987,10 +32024,31 @@ def test_21_00
update_time_graph
$with_test_motif and show_disk_space(ind1)
update_time_graph
+ revert_sound(ind1)
+ make_selection(10000, 20000, ind1, 0)
+ if selection?
+ show_selection
+ vals = x_bounds(ind1, 0)
+ if vals.length == 2
+ snd_test_neq(vals[0], 10000.0 / srate(ind1), "show_selection")
+ snd_test_neq(vals[1], 20000.0 / srate(ind1), "show_selection")
+ end
+ else
+ snd_display("make_selection for show failed?")
+ end
+ $graph_hook.add_hook!("test-21-zoom-spectrum", &method(:zoom_spectrum).to_proc)
+ set_transform_graph?(true, ind1, 0)
+ ind3 = open_sound("pistol.snd")
+ overlay_sounds(ind2, ind1, ind3)
+ update_time_graph(ind2, 0)
+ $after_graph_hook.reset_hook!
+ close_sound(ind3)
+ samples_via_colormap(ind1, 0)
close_sound(ind1)
+ $graph_hook.remove_hook!("test-21-zoom-spectrum")
close_sound(ind2)
#
- ind = new_sound("tmp.snd", Mus_next, Mus_bfloat, 22050, 1, :size, 50)
+ ind = new_sound("tmp.snd", 1, 22050, Mus_bfloat, Mus_next, :size, 50)
set_sample(3, 1.0)
filter_channel(vct(0.5, 1.0, 0.5), 3)
unless vequal(res = channel2vct(0, 10), vct(0, 0, 0, 0.5, 1, 0.5, 0, 0, 0, 0))
@@ -34014,7 +32072,7 @@ def test_21_00
undo_edit
close_sound(ind)
#
- ind = new_sound("tmp.snd", Mus_next, Mus_bfloat, 22050, 1, false, 100)
+ ind = new_sound("tmp.snd", 1, 22050, Mus_bfloat, Mus_next, false, 100)
set_sample(10, 0.5)
filter_sound(vct(1, 0, 1), 3)
unless vequal(res = channel2vct(5, 10), vct(0, 0, 0, 0, 0, 0.5, 0, 0.5, 0, 0))
@@ -34108,7 +32166,7 @@ def test_21_00
undo_edit
close_sound(ind)
#
- ind = new_sound("tmp.snd", Mus_next, Mus_bfloat, 22050, 2, false, 100)
+ ind = new_sound("tmp.snd", 2, 22050, Mus_bfloat, Mus_next, false, 100)
set_sample(10, 0.5)
set_sample(5, -0.5, ind, 1)
set_sync(1, ind)
@@ -34174,7 +32232,7 @@ def test_21_00
undo_edit(1, ind, 1)
close_sound(ind)
#
- ind = new_sound("tmp.snd", Mus_next, Mus_bshort, 22050, 1, :size, 100)
+ ind = new_sound("tmp.snd", 1, 22050, Mus_bshort, Mus_next, :size, 100)
set_sample(10, 0.5)
set_sample(20, -0.5)
scale_to(1.0)
@@ -34185,7 +32243,7 @@ def test_21_00
snd_display("scale_to 1.0 Mus_bshort (20): %s?", sample(20))
end
close_sound(ind)
- ind = new_sound("tmp.snd", Mus_next, Mus_byte, 22050, 1, :size, 100)
+ ind = new_sound("tmp.snd", 1, 22050, Mus_byte, Mus_next, :size, 100)
set_sample(10, 0.5)
set_sample(20, -0.5)
scale_to(1.0)
@@ -34214,13 +32272,15 @@ def test_21_00
set_spectro_hop(4)
set_fft_window_alpha(0.0)
set_fft_window_beta(0.0)
- ind_1 = new_sound("test-1.snd", Mus_next, Mus_bfloat, 22050, 1, "mono testing", 100)
- ind_2 = new_sound("test-2.snd", Mus_aifc, Mus_bshort, 44100, 2, "stereo testing", 300)
+ ind_1 = new_sound("test-1.snd", 1, 22050, Mus_lfloat, Mus_next,
+ "mono testing", 100)
+ ind_2 = new_sound("test-2.snd", 2, 44100, Mus_bshort, Mus_aifc,
+ "stereo testing", 300)
[[:srate, 48000, :st_equal?, :st_eql?, :swap],
- [:data_format, Mus_byte, :st_equal?, :st_eql?, :swap],
+ [:sample_type, Mus_byte, :st_equal?, :st_eql?, :swap],
[:data_location, 123, :st_equal?, :st_eql?, :swap],
[:data_size, 12348, :st_equal?, :st_eql?, :swap],
- [:frames, 12348, :st_equal?, :st_eql?, true],
+ [:framples, 12348, :st_equal?, :st_eql?, true],
[:sync, 2, :st_equal?, :st_eql?, true],
[:channels, 0, :st_equal?, :st_eql?, false],
[:chans, 0, :st_equal?, :st_eql?, false],
@@ -34240,7 +32300,8 @@ def test_21_00
[:short_file_name, nil, :st_equal?, :st_eql?, false],
[:comment, nil, :st_equal?, :st_eql?, false]
].each do |func, new_val, eq_func, leq_func, settable|
- test_sound_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, settable, false, false)
+ test_sound_func_1(func, ind_1, ind_2, new_val,
+ eq_func, leq_func, settable, false, false)
end
save_controls(true)
restore_controls(true)
@@ -34252,8 +32313,10 @@ def test_21_00
#
# snd chn cases
#
- ind_1 = new_sound("test-1.snd", Mus_next, Mus_bfloat, 22050, 1, "mono testing", 100)
- ind_2 = new_sound("test-2.snd", Mus_aifc, Mus_bshort, 44100, 2, "stereo testing", 300)
+ ind_1 = new_sound("test-1.snd", 1, 22050, Mus_bfloat, Mus_next,
+ "mono testing", 100)
+ ind_2 = new_sound("test-2.snd", 2, 44100, Mus_bshort, Mus_aifc,
+ "stereo testing", 300)
set_sample(1, 0.1, ind_1, 0)
set_sample(2, 0.2, ind_2, 0)
set_sample(3, 0.3, ind_2, 1)
@@ -34277,11 +32340,10 @@ def test_21_00
[:cursor, 50, :st_equal?, :st_eql?, true, false],
[:cursor_style, 1, :st_equal?, :st_eql?, true, true],
[:cursor_size, 10, :st_equal?, :st_eql?, true, true],
- [:frames, 50, :st_equal?, :st_eql?, true, false],
+ [:framples, 50, :st_equal?, :st_eql?, true, false],
[:zero_pad, 1, :st_equal?, :st_eql?, true, true],
[:wavelet_type, 1, :st_equal?, :st_eql?, true, true],
- # FIXME see below
- # [:time_graph_type, Graph_as_wavogram, :st_equal?, :st_eql?, true, true],
+ [:time_graph_type, Graph_as_wavogram, :st_equal?, :st_eql?, true, true],
[:wavo_hop, 10, :st_equal?, :st_eql?, true, true],
[:wavo_trace, 10, :st_equal?, :st_eql?, true, true],
[:transform_size, 64, :st_equal?, :st_eql?, true, true],
@@ -34305,15 +32367,11 @@ def test_21_00
[:fft_log_magnitude, true, :st_equal?, :st_eql?, true, true],
[:show_mix_waveforms, false, :st_equal?, :st_eql?, true, true],
[:with_verbose_cursor, true, :st_equal?, :st_eql?, true, true]]
- unless $with_test_gtk
- # FIXME
- # doesn't work with GTK
- # set_time_graph_type(Graph_as_wavogram) ==> hangs or even segfaults
- vals += [[:time_graph_type, Graph_as_wavogram, :st_equal?, :st_eql?, true, true]]
- end
vals.each do |func, new_val, eq_func, leq_func, settable, global|
- test_sound_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, settable, true, global)
- test_channel_func_1(func, ind_1, ind_2, new_val, eq_func, leq_func, settable, global)
+ test_sound_func_1(func, ind_1, ind_2, new_val,
+ eq_func, leq_func, settable, true, global)
+ test_channel_func_1(func, ind_1, ind_2, new_val,
+ eq_func, leq_func, settable, global)
end
update_time_graph(true, true)
update_transform_graph(true, true)
@@ -34324,13 +32382,14 @@ def test_21_00
snd_display("sounds after close_sound(false) twice: %s?", sounds)
end
#
- ind_1 = new_sound("test-1.snd", Mus_next, Mus_bfloat, 22050, 1, "mono testing", 100)
- ind_2 = new_sound("test-2.snd", Mus_aifc, Mus_bshort, 44100, 2, "stereo testing", 300)
+ ind_1 = new_sound("test-1.snd", 1, 22050, Mus_bfloat, Mus_next,
+ "mono testing", 100)
+ ind_2 = new_sound("test-2.snd", 2, 44100, Mus_bshort, Mus_aifc,
+ "stereo testing", 300)
# test_sound_func_2
[[:filter_control_in_dB, true, :st_eql?, :st_eql?],
[:filter_control_in_hz, true, :st_eql?, :st_eql?],
[:show_controls, true, :st_eql?, :st_eql?],
- [:with_tracking_cursor, true, :st_eql?, :st_eql?],
[:speed_control_tones, 14, :st_equal?, :st_eql?],
[:speed_control_style, Speed_control_as_semitone, :st_equal?, :st_eql?],
[:filter_control_order, 14, :st_equal?, :st_eql?],
@@ -34401,45 +32460,6 @@ def test_21_00
close_sound(true)
end
-def test_21_01
- file_copy("2a.snd", "test.snd")
- ind = open_sound("test.snd")
- clear_listener
- 2500.times do |i|
- k = random(200) + 1
- s = case random(5)
- when 1
- 4
- when 2
- 8
- when 3
- 12
- else
- 0
- end
- if k > 127
- k = key_to_int(?x)
- s = 4
- end
- if random(1.0) > 0.99
- clear_listener
- end
- if k == key_to_int(?e) or k == key_to_int(?E)
- snd_simulate_keystroke(ind, 0, key_to_int(?g), 0)
- end
- snd_simulate_keystroke(ind, random(channels(ind)), k, s)
- if sound?(ind) and frames(ind, 0) > 1000000
- close_sound(ind)
- file_copy("2a.snd", "test.snd")
- end
- unless sound?(ind)
- ind = open_sound("test.snd")
- end
- end
- clear_listener
- close_sound(ind)
-end
-
def test_21_02
set_remember_sound_state(true)
ind = open_sound("oboe.snd")
@@ -34559,7 +32579,7 @@ def test_21_02
mx = maxamp(ind, 0)
chns = channels(ind)
sr = srate(ind)
- fr = frames(ind, 0)
+ fr = framples(ind, 0)
with_local_hook($update_hook,
lambda do |orig_ind|
lambda do |new_ind|
@@ -34573,7 +32593,7 @@ def test_21_02
snd_test_neq(maxamp(ind, 0), mx, "update_sound looped maxamp %d", i)
snd_test_neq(chans(ind), chns, "update_sound looped chans")
snd_test_neq(srate(ind), sr, "update_sound looped srate")
- snd_test_neq(frames(ind), fr, "update_sound looped frames")
+ snd_test_neq(framples(ind), fr, "update_sound looped framples")
end
old_ind = open_sound("oboe.snd")
diff = 0.0
@@ -34594,8 +32614,8 @@ def test_21_02
ind = open_sound("oboe.snd")
data = channel2vct
5.times do |i|
- array2file("test.snd", data, frames(ind), 22050, 1)
- file2array("test.snd", 0, 0, frames, data)
+ array2file("test.snd", data, framples(ind), 22050, 1)
+ file2array("test.snd", 0, 0, framples, data)
diff = 0.0
ctr = 0
scan_channel(lambda do |y|
@@ -34627,7 +32647,7 @@ def test_21_02
delete_files("test.snd", "fmv.snd")
rdin = false
rdout = false
- len = mus_sound_frames("oboe.snd")
+ len = mus_sound_framples("oboe.snd")
types = [Mus_riff, Mus_aifc, Mus_next, Mus_nist, Mus_ircam]
forms = [Mus_lshort, Mus_bshort, Mus_b24int, Mus_l24int, Mus_bint]
file_copy("oboe.snd", "fmv.snd")
@@ -34673,7 +32693,7 @@ def test_21_02
env_sound([0, 2, 1, 2])
end],
["env_channel", lambda do
- env_channel(make_env([0, 1, 1, 1], :scaler, 2.0, :length, frames))
+ env_channel(make_env([0, 1, 1, 1], :scaler, 2.0, :length, framples))
end],
["clm_channel", lambda do
clm_channel(make_one_zero(:a0, 2.0, :a1, 0.0))
@@ -34697,13 +32717,6 @@ def test_21_02
mix("temp.snd", 0)
delete_file("temp.snd")
end],
- ["sound_data", lambda do
- sd = vct2sound_data(channel2vct())
- frames.times do |i|
- sd[0, i] *= 2.0
- end
- set_samples(0, frames, sd.to_vct)
- end],
["convolve", lambda do
flt = Vct.new(8)
flt[0] = 2.0
@@ -34712,7 +32725,7 @@ def test_21_02
map_channel(lambda do |y| convolve(cnv, lambda do |dir| read_sample(sf) end) end)
end],
["fft", lambda do
- len = frames
+ len = framples
fsize = 2 ** (log(len) / log(2)).ceil
rl = channel2vct(0, fsize)
im = Vct.new(fsize)
@@ -34756,7 +32769,6 @@ end
def test_21
test_21_00 if $with_test_gui
- test_21_01
test_21_02
end
@@ -34764,16 +32776,11 @@ end
require "clm-ins"
-class Instrument
- # v.rb
- alias fm_violin fm_violin_rb
- alias jc_reverb jc_reverb_rb
- # clm-ins.rb
- alias nrev nrev_rb
-end
-
-def bigbird_2(start, dur, freq, freqskew, amp, freq_envelope, amp_envelope, partials)
- gls_env = make_env(:envelope, freq_envelope, :scaler, hz2radians(freqskew), :duration, dur)
+def bigbird_2(start, dur, freq,
+ freqskew, amp, freq_envelope, amp_envelope, partials)
+ gls_env = make_env(:envelope, freq_envelope,
+ :scaler, hz2radians(freqskew),
+ :duration, dur)
os = make_oscil(:frequency, freq)
amp_env = make_env(:envelope, amp_envelope, :scaler, amp, :duration, dur)
coeffs = partials2polynomial(normalize_partials(partials))
@@ -34783,7 +32790,9 @@ def bigbird_2(start, dur, freq, freqskew, amp, freq_envelope, amp_envelope, part
end
def bird_2(start, dur, freq, freqskew, amp, freq_envelope, amp_envelope)
- gls_env = make_env(:envelope, freq_envelope, :scaler, hz2radians(freqskew), :duration, dur)
+ gls_env = make_env(:envelope, freq_envelope,
+ :scaler, hz2radians(freqskew),
+ :duration, dur)
os = make_oscil(:frequency, freq)
amp_env = make_env(:envelope, amp_envelope, :scaler, amp, :duration, dur)
run_instrument(start, dur) do
@@ -34847,22 +32856,23 @@ end
def step_src
rd = make_sampler(0)
os = make_oscil(2205)
- sr = make_src(:srate, 0.0)
+ sr = make_src(:srate, 0.0, :input, lambda do |dir| read_sample(rd) end)
incr = 2.0 + oscil(os)
- tempfile = with_sound(:output, snd_tempnam,
- :srate, srate,
+ tempfile = with_sound(:output, snd_tempnam(),
+ :srate, srate(),
:comment, get_func_name) do
samp = 0
until sampler_at_end?(rd)
- out_any(samp, src(sr, incr, lambda do |dir| read_sample(rd) end), 0, $output)
+ out_any(samp, src(sr, incr), 0, $output)
if (samp % 2205).zero?
incr = 2.0 + oscil(os)
end
samp += 1
end
end.output
- len = mus_sound_frames(tempfile)
- set_samples(0, len - 1, tempfile, false, false, true, get_func_name, 0, false, true)
+ len = mus_sound_framples(tempfile)
+ set_samples(0, len - 1, tempfile, false, false, true,
+ get_func_name, 0, false, true)
end
# optkey returns an array of values or, if array length is 1, returns
@@ -34901,7 +32911,7 @@ end
def test_23_00
set_mus_srate($clm_srate = 22050)
set_default_output_srate(22050)
- with_sound(:reverb, :nrev) do
+ with_sound(:reverb, :nrev, :play, false) do
fmt1 = [0, 1200, 100, 1000]
fmt2 = [0, 2250, 100, 1800]
fmt3 = [0, 4500, 100, 4500]
@@ -34970,7 +32980,7 @@ end
def test_23_01
set_mus_srate($clm_srate = 22050)
set_default_output_srate(22050)
- with_sound(:srate, 22050) do
+ with_sound(:srate, 22050, :play, false) do
fm_violin(0, 0.01, 440, 0.1, :noise_amount, 0.0)
pluck(0.05, 0.01, 330, 0.1, 0.95, 0.95)
maraca(0.1, 0.1)
@@ -35059,10 +33069,12 @@ def test_23_01
[0, 0, 25, 1, 75, 1, 100, 0], 0.75, 1.0, 0, 0, 0, 0, 1, 0, 0, 220,
[0, 0, 25, 1, 75, 1, 100, 0], 0, 0, 0, 0,
[0, 0, 100, 0], 0, 0, 0, 0, [0, 0, 100, 0])
+ clm_expsrc(14.75, 2.5, "oboe.snd", 2.0, 1.0, 1.0)
scratch(15.0, "now.snd", 1.5, [0.0, 0.5, 0.25, 1.0])
two_tab(15, 1, 440, 0.1)
- exp_snd("fyow.snd", 15, 3, 1, [0, 1, 1, 3], 0.4, 0.15, [0, 2, 1, 0.5], 0.05)
- exp_snd("oboe.snd", 16, 3, 1, [0, 1, 1, 3], 0.4, 0.15, [0, 2, 1, 0.5], 0.2)
+ exp_snd("fyow.snd", 15, 1.5, 1, [0, 1, 1, 3], 0.4, 0.15,
+ [0, 2, 1, 0.5], 0.05)
+ exp_snd("oboe.snd", 16, 1, 1, [0, 1, 1, 3], 0.4, 0.15, [0, 2, 1, 0.5], 0.2)
gran_synth(15.5, 1, 300, 0.0189, 0.03, 0.4)
spectra(16, 1, 440, 0.1,
[1, 0.4, 2, 0.2, 3, 0.2, 4, 0.1, 6, 0.1],
@@ -35076,7 +33088,7 @@ def test_23_01
false, false,
500, 0.995, 0.1, 1000, 0.995, 0.1, 2000, 0.995, 0.1)
bes_fm(18, 1, 440, 10.0, 1.0, 4.0)
- graph_eq("oboe.snd")
+ graph_eq("oboe.snd", 19, 1)
end
if sound?(ind = find_sound("test.snd"))
close_sound(ind)
@@ -35104,13 +33116,14 @@ def test_23_02
Mus_bfloat,
Mus_bdouble,
Mus_ldouble].each do |type|
- ind = find_sound(with_sound(:data_format, type) do
+ ind = find_sound(with_sound(:sample_type, type, :srate, 22050) do
fm_violin(0, 0.1, 440, 0.1)
fm_violin(10, 0.1, 440, 0.1)
fm_violin(100, 0.1, 440, 0.1)
- fm_violin(1000, 0.1, 440, 0.1)
+ fm_violin(250, 0.1, 440, 0.1)
end.output)
- snd_test_any_neq(maxamp(ind), 0.1, :ffequal?, "format %s", mus_data_format2string(type)) # okay
+ snd_test_any_neq(maxamp(ind), 0.1, :ffequal?,
+ "format %s", mus_sample_type2string(type))
end
3.times do |i|
with_sound(:srate, 22050) do
@@ -35127,31 +33140,10 @@ def test_23_02
snd_display("with_sound srate: %s (%s %s)?",
srate(ind), mus_srate, mus_sound_srate("test.snd"))
end
- if frames(ind) != 2205
- snd_display("with_sound frames (%s): %s?", i, frames(ind))
+ if framples(ind) != 2205
+ snd_display("with_sound framples (%s): %s?", i, framples(ind))
end
end
- with_sound(:continue_old_file, true) do
- fm_violin(0.2, 0.1, 440, 0.25)
- end
- ind = find_sound("test.snd")
- unless ind
- snd_display("with_sound continued: %s?", file_name(true))
- end
- if Snd.sounds.length != 1
- snd_display("with_sound continued: %s?", short_file_name(true))
- end
- if fneq(res = maxamp, 0.25)
- snd_display("with_sound continued max: %s?", res)
- end
- if srate(ind) != 22050
- snd_display("with_sound continued srate: %s (%s %s)?",
- srate(ind), mus_srate, mus_sound_srate("test.snd"))
- end
- if frames(ind) != 3 * 2205
- snd_display("with_sound continued frames: %s?", frames(ind))
- end
- close_sound(ind)
#
with_sound do
fm_violin(0, 0.1, 440, 0.1)
@@ -35163,7 +33155,7 @@ def test_23_02
if fneq(res = maxamp, 0.1)
snd_display("maxamp after continued sound: %s?", res)
end
- if fneq(res = frames(ind) / srate(ind).to_f, 0.3)
+ if fneq(res = framples(ind) / srate(ind).to_f, 0.3)
snd_display("duration after continued sound: %s?", res)
end
close_sound(ind)
@@ -35184,8 +33176,8 @@ def test_23_02
snd_display("with_sound srate (1): %s (%s %s)?",
srate(ind), mus_srate, mus_sound_srate("test1.snd"))
end
- if frames(ind) != 2205
- snd_display("with_sound frames (1): %s?", frames(ind))
+ if framples(ind) != 2205
+ snd_display("with_sound framples (1): %s?", framples(ind))
end
if chans(ind) != 2 or mus_sound_chans("test1.snd") != 2
snd_display("with_sound chans (1): %s?", chans(ind))
@@ -35196,7 +33188,7 @@ def test_23_02
with_sound(:srate, 48000,
:channels, 2,
:header_type, Mus_riff,
- :data_format, Mus_lshort,
+ :sample_type, Mus_lshort,
:output, "test1.snd") do
fm_violin(0, 0.1, 440, 0.1)
end
@@ -35219,7 +33211,7 @@ def test_23_02
with_sound(:srate, 48000,
:channels, 2,
:header_type, Mus_caff,
- :data_format, Mus_lshort,
+ :sample_type, Mus_lshort,
:output, "test1.snd") do
fm_violin(0, 0.1, 440, 0.1)
end
@@ -35319,31 +33311,14 @@ def test_23_02
fm_violin(0, 0.1, 440, 0.1, :degree, 45.0)
end
if sound?(ind = find_sound("test1.snd"))
- if frames(ind) != 22050 + 2205
- snd_display("with_sound reverbed frames (2): %s?", frames(ind))
+ if framples(ind) - (22050 + 2205) > 1
+ snd_display("with_sound reverbed framples (2): %s?", framples(ind))
end
close_sound(ind)
else
snd_display("with_sound (2): %s?", file_name(true))
end
#
- 3.times do
- with_sound(:srate, 22050,
- :output, "test1.snd",
- :reverb, :jc_reverb) do
- fm_violin(0, 0.1, 440, 0.1)
- end
- end
- ind = find_sound("test1.snd")
- unless ind
- snd_display("with_sound (3): %s?", file_name(true))
- end
- if frames(ind) != 22050 + 2205
- snd_display("with_sound reverbed frames (3): %s?", frames(ind))
- end
- close_sound(ind)
- delete_file("test1.snd")
- #
with_sound(:srate, 22050,
:comment, "Snd+Run!",
:scaled_to, 0.5) do
@@ -35364,7 +33339,7 @@ def test_23_02
with_sound(:srate, 22050,
:scaled_by, 0.5,
:header_type, Mus_aifc,
- :data_format, Mus_bfloat) do
+ :sample_type, Mus_bfloat) do
fm_violin(0, 0.1, 440, 0.1)
end
ind = find_sound("test.snd")
@@ -35377,8 +33352,8 @@ def test_23_02
if (res = header_type(ind)) != Mus_aifc
snd_display("with_sound type: %s (%s)?", res, mus_header_type_name(res))
end
- if (res = data_format(ind)) != Mus_bfloat
- snd_display("with_sound format: %s (%s)?", res, mus_data_format_name(res))
+ if (res = sample_type(ind)) != Mus_bfloat
+ snd_display("with_sound format: %s (%s)?", res, mus_sample_type_name(res))
end
close_sound(ind)
#
@@ -35393,8 +33368,10 @@ def test_23_02
if (res = header_type(ind)) != Mus_raw
snd_display("with_sound type raw: %s (%s)?", res, mus_header_type_name(res))
end
- if (res = data_format(ind)) != Mus_bshort and res != Mus_bfloat and res != Mus_lfloat
- snd_display("with_sound format raw: %s (%s)?", res, mus_data_format_name(res))
+ if (res = sample_type(ind)) != Mus_bshort and
+ res != Mus_bfloat and
+ res != Mus_lfloat
+ snd_display("with_sound format raw: %s (%s)?", res, mus_sample_type_name(res))
end
close_sound(ind)
#
@@ -35414,7 +33391,7 @@ def test_23_02
})
close_sound(ind)
#
- if File.exists?("ii.rb")
+ if File.exist?("ii.rb")
with_time("load(\"ii.rb\")") do load("ii.rb") end
Snd.sounds.apply(:close_sound)
delete_files("test.snd", "rest.reverb")
@@ -35423,16 +33400,17 @@ def test_23_02
set_default_output_srate(22050)
#
outer = with_sound do
- sound_let(Proc.new do fm_violin(0, 0.1, 440, 0.1) end) do |a|
- mus_mix(@output, a)
+ sound_let(Proc.new do fm_violin(0, 0.1, 440, 0.1) end) do |tmp|
+ clm_mix(tmp)
end
end.output
unless string?(outer)
snd_display("with_sound returns: %s?", outer)
end
ind = find_sound(outer)
- if (not sound?(ind)) or frames(ind) != (mus_srate * 0.1).floor
- snd_display("sound_let: %s %s?", frames(ind), (mus_srate * 0.1).floor)
+ if (not sound?(ind)) or
+ (framples(ind) - (res = (mus_srate * 0.1).floor)) > 1
+ snd_display("sound_let: %s %s?", framples(ind), res)
end
close_sound(ind)
delete_file("test.snd")
@@ -35440,10 +33418,10 @@ def test_23_02
outer = with_sound do
sound_let(Proc.new do fm_violin(0, 0.1, 440, 0.1) end,
100) do |a, b|
- mus_mix(@output, a, b)
+ clm_mix(a, b)
sound_let([:channels, 1, :output, "temp.snd",
Proc.new do fm_violin(0, 0.1, 110, 0.1) end]) do |c|
- mus_mix(@output, c)
+ clm_mix(c)
end
end
end.output
@@ -35451,10 +33429,11 @@ def test_23_02
snd_display("with_sound (2) returns: %s?", outer)
end
ind = find_sound(outer)
- if (not sound?(ind)) or frames(ind) != (res = 100 + (mus_srate * 0.1).floor)
- snd_display("sound_let (2): %s %s?", frames(ind), res)
+ if (not sound?(ind)) or
+ (framples(ind) - (res = 100 + (mus_srate * 0.1).floor)) > 1
+ snd_display("sound_let (2): %s %s?", framples(ind), res)
end
- if File.exists?("temp.snd")
+ if File.exist?("temp.snd")
snd_display("sound_let explicit output exists?")
end
close_sound(ind)
@@ -35465,74 +33444,91 @@ def test_23_03
set_default_output_srate(22050)
with_sound(:channels, 2) do
fullmix("pistol.snd")
- fullmix("oboe.snd", 1, 2, 0, [[0.1, make_env([0, 0, 1, 1], :duration, 2, :scaler, 0.5)]])
+ fullmix("oboe.snd", 1, 2, 0,
+ [[0.1, make_env([0, 0, 1, 1], :duration, 2, :scaler, 0.5)]])
end
if sound?(ind = find_sound("test.snd"))
close_sound(ind)
end
with_sound(:channels, 2) do
- fullmix("4.aiff", 0.0, 0.1, 36.4, [[0.0, 0.0], [0.0, 0.0], [1.0, 0.0], [0.0, 1.0]])
+ fullmix("4.aiff", 0.0, 0.1, 36.4,
+ [[0.0, 0.0], [0.0, 0.0], [1.0, 0.0], [0.0, 1.0]])
end
if sound?(ind = find_sound("test.snd"))
- snd_test_neq(maxamp(), 0.664947509765625, "4->2(0) fullmix")
+ snd_test_neq(maxamp(), 0.8865, "4->2(0) fullmix")
close_sound(ind)
end
with_sound(:channels, 1) do
- fullmix("4.aiff", 0.0, 0.1, 36.4, [[1.0], [0.0], [0.0], [0.0]])
+ fullmix("4.aiff", 0.0, 0.1, 36.4,
+ [[1.0], [0.0], [0.0], [0.0]])
end
if sound?(ind = find_sound("test.snd"))
snd_test_neq(maxamp(), 0.221649169921875, "4->1(0) fullmix")
close_sound(ind)
end
with_sound(:channels, 1) do
- fullmix("4.aiff", 0.0, 0.1, 36.4, [[0.0], [1.0], [0.0], [0.0]])
+ fullmix("4.aiff", 0.0, 0.1, 36.4,
+ [[0.0], [1.0], [0.0], [0.0]])
end
if sound?(ind = find_sound("test.snd"))
snd_test_neq(maxamp(), 0.44329833984375, "4->1(1) fullmix")
close_sound(ind)
end
with_sound(:channels, 1) do
- fullmix("4.aiff", 0.0, 0.1, 36.4, [[0.0], [0.0], [1.0], [0.0]])
+ fullmix("4.aiff", 0.0, 0.1, 36.4,
+ [[0.0], [0.0], [1.0], [0.0]])
end
if sound?(ind = find_sound("test.snd"))
snd_test_neq(maxamp(), 0.664947509765625, "4->1(2) fullmix")
close_sound(ind)
end
with_sound(:channels, 1) do
- fullmix("4.aiff", 0.0, 0.1, 36.4, [[0.0], [0.0], [0.0], [1.0]])
+ fullmix("4.aiff", 0.0, 0.1, 36.4,
+ [[0.0], [0.0], [0.0], [1.0]])
end
if sound?(ind = find_sound("test.snd"))
snd_test_neq(maxamp(), 0.8865966796875, "4->1(3) fullmix")
close_sound(ind)
end
with_sound(:channels, 2) do
- fullmix("4.aiff", 0.0, 0.1, 36.4, [[0.0, 0.0], [0.0, 0.0], [1.0, 0.0], [0.0, 1.0]])
+ fullmix("4.aiff", 0.0, 0.1, 36.4,
+ [[0.0, 0.0], [0.0, 0.0], [1.0, 0.0], [0.0, 1.0]])
end
if sound?(ind = find_sound("test.snd"))
mxs = maxamp(ind, true)
- snd_test_neq(mxs[0], 0.664947509765625, "4->2(1) fullmix")
- snd_test_neq(mxs[1], 0.8865966796875, "4->2(1) fullmix")
+ req1 = 0.664947509765625
+ req2 = 0.8865966796875
+ if fneq(mxs[0], req1) or fneq(mxs[1], req2)
+ snd_test_neq(mxs[0], req1, "4->2(1a) fullmix")
+ snd_test_neq(mxs[1], req2, "4->2(1b) fullmix")
+ end
close_sound(ind)
end
with_sound(:channels, 2) do
- fullmix("4.aiff", 0.0, 0.1, 36.4, [[0.0, 0.0], [0.0, 0.0], [0.0, 1.0], [1.0, 0.0]])
+ fullmix("4.aiff", 0.0, 0.1, 36.4,
+ [[0.0, 0.0], [0.0, 0.0], [0.0, 1.0], [1.0, 0.0]])
end
if sound?(ind = find_sound("test.snd"))
- req1 = 0.664947509765625
- req2 = 0.8865966796875
mxs = maxamp(ind, true)
- snd_test_neq(mxs[0], 0.8865966796875, "4->2(2) fullmix")
- snd_test_neq(mxs[1], 0.664947509765625, "4->2(2) fullmix")
+ req1 = 0.8865966796875
+ req2 = 0.664947509765625
+ if fneq(mxs[0], req1) or fneq(mxs[1], req2)
+ snd_test_neq(mxs[0], req2, "4->2(2a) fullmix")
+ snd_test_neq(mxs[1], req1, "4->2(2b) fullmix")
+ end
close_sound(ind)
end
with_sound(:channels, 2, :reverb, :nrev) do
- fullmix("pistol.snd", 0.0, 2.0, 0.25, nil, 2.0, 0.1)
+ fullmix("pistol.snd", 0.0, 2.0, 0.25, false, 2.0, 0.1)
fullmix("pistol.snd", 1.0, 2.0, 0.25, 0.2, 2.0, 0.1)
- fullmix("2a.snd", nil, nil, nil, [[0.5, 0.0], [0.0, 0.75]])
- fullmix("oboe.snd", nil, nil, nil, [[[0, 0, 1, 1, 2, 0], 0.5]])
- fullmix("oboe.snd", 3, 2, 0, [[0.1, make_env([0, 0, 1, 1], :duration, 2, :scaler, 0.5)]])
+ fullmix("2a.snd", false, false, false, [[0.5, 0.0], [0.0, 0.75]])
+ fullmix("oboe.snd", false, false, false, [[[0, 0, 1, 1, 2, 0], 0.5]])
+ fullmix("oboe.snd", 3, 2, 0,
+ [[0.1, make_env([0, 0, 1, 1], :duration, 2, :scaler, 0.5)]])
+ end
+ if sound?(ind = find_sound("test.snd"))
+ close_sound(ind)
end
- Snd.sounds.apply(:close_sound)
end
def test_23_04
@@ -35546,70 +33542,127 @@ def test_23_04
fm_violin(0, 2, 660, 0.1, :base, 32.0)
fm_violin(0.125, 0.5, 880, 0.1)
end) do |temp_1, temp_2|
- mus_mix(@output, temp_1, 0)
- mus_mix(@output, temp_2, 22050)
+ clm_mix(temp_1, 0)
+ clm_mix(temp_2, 22050)
end
end
if sound?(ind = find_sound("test.snd"))
unless maxamp(ind).between?(0.15, 0.2)
snd_display("with_sound+sound_lets maxamp: %s?", maxamp(ind))
end
- if fneq(res = frames(ind) / srate(ind).to_f, 3.0)
- snd_display("with_sound+sound_lets dur: res %s frms %s sr %s?", res, frames(ind), srate(ind))
+ if fneq(res = framples(ind) / srate(ind).to_f, 3.0)
+ snd_display("with_sound+sound_lets dur: res %s frms %s sr %s?",
+ res, framples(ind), srate(ind))
end
close_sound(ind)
else
snd_display("with_sound+sound_lets init: no test.snd?")
end
- #
+ #
with_sound(:srate, 44100) do
bigbird_2(0, 2.0, 60, 0, 0.5,
[0, 0, 1, 1],
[0, 0, 1, 1, 2, 1, 3, 0],
[1, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 1, 7, 1, 8, 1, 9, 1, 10, 1])
end
- ind = (find_sound("test.snd") or open_sound("test.snd"))
+ ind = (find_sound("test.snd") or open_sound("oboe.snd"))
mx = maxamp
- freqs = []
- 60.step(3000, 60) do |i| freqs.push(i) end
+ val = 0.0
+ freqs = Array.new(50) do |i| val += 60.0 end
notch_sound(freqs)
- snd_test_neq(mx, 0.5, "notch_sound 60 Hz 1a")
- snd_test_any_neq(maxamp(), 0.027, :ffequal?, "notch_sound 60 Hz 1b") # okay
+ snd_test_neq(mx, 0.5, "notch_sound 60 Hz (1a)")
+ snd_test_any_neq(maxamp(), 0.027, :ffequal?, "notch_sound 60 Hz (1b)")
undo_edit
notch_sound(freqs, false, ind, 0, 10)
- snd_test_neq(maxamp(), 0.004, "notch_sound 60 Hz 2")
+ snd_test_any_neq(maxamp(), 0.011, :ffequal?, "notch_sound 60 Hz 2")
undo_edit
notch_channel(freqs, false, false, false, ind, 0, false, false, 10)
snd_test_neq(maxamp(), 0.004, "notch_channel 60 Hz 2")
undo_edit
make_selection(10000, 11000)
- notch_selection(freqs, false)
- play_sound do |data| data.map!(0) do |val| val * 2.0 end end
+ notch_selection(freqs, false, 10)
close_sound(ind)
#
with_sound(:srate, 44100) do
- bigbird_2(0, 60.0, 60, 0, 0.5,
+ bigbird_2(0, 30, 60, 0, 0.5,
[0, 0, 1, 1],
[0, 0, 1, 1, 2, 1, 3, 0],
[1, 1, 2, 1, 3, 1, 4, 1, 5, 1, 6, 1, 7, 1, 8, 1, 9, 1, 10, 1])
end
ind = find_sound("test.snd")
- freqs = []
- 60.step(3000, 60) do |i| freqs.push(i) end
notch_sound(freqs, false, ind, 0, 10)
- snd_test_neq(maxamp(), 0.036, "notch_sound 60 Hz 2 60")
+ snd_test_neq(maxamp(), 0.011, "notch_sound 60 Hz 2 60")
close_sound(ind)
#
+ # from play.rb
play_sine(440, 0.1)
- play_sines([[425, 0.05], [450, 0.01], [470, 0.01], [546, 0.02],
- [667, 0.01], [789, 0.034], [910, 0.032]])
+ play_sines([425, 0.05], [450, 0.01], [470, 0.01], [546, 0.02],
+ [667, 0.01], [789, 0.034], [910, 0.032])
+ # grani from clm-ins.rb
+ with_sound(:channels, 2,
+ :reverb, :jc_reverb,
+ :reverb_channels, 1) do
+ grani(0, 1, 0.5, "oboe.snd",
+ :grain_envelope, [0, 0, 0.2, 0.2, 0.5, 1, 0.8, 0.2, 1, 0])
+ grani(0, 4, 1, "oboe.snd")
+ grani(0, 4, 1, "oboe.snd", :grains, 10)
+ grani(0, 4, 1, "oboe.snd",
+ :grain_start, 0.11,
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 8,
+ :grain_envelope, [0, 0, 0.2, 0.2, 0.5, 1, 0.8, 0.2, 1, 0],
+ :grain_envelope_end, [0, 0, 0.01, 1, 0.99, 1, 1, 0],
+ :grain_envelope_transition, [0, 0, 0.4, 1, 0.8, 0, 1, 0])
+ grani(0, 3, 1, "oboe.snd",
+ :grain_start, 0.1,
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 20,
+ :grain_duration, [0, 0.003, 0.2, 0.01, 1, 0.3])
+ grani(0, 3, 1, "oboe.snd",
+ :grain_start, 0.1,
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 20,
+ :grain_duration, [0, 0.003, 0.2, 0.01, 1, 0.3],
+ :grain_duration_limit, 0.02)
+ grani(0, 2, 1, "oboe.snd",
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 40,
+ :grain_start, [0, 0.1, 0.3, 0.1, 1, 0.6])
+ grani(0, 2, 1, "oboe.snd",
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 40,
+ :grain_start, [0, 0.1, 0.3, 0.1, 1, 0.6],
+ :grain_start_spread, 0.01)
+ grani(0, 2.6, 1, "oboe.snd",
+ :grain_start, 0.1, :grain_start_spread, 0.01,
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 40,
+ :srate, [0, 0, 0.2, 0, 0.6, 5, 1, 5])
+ grani(0, 2.6, 1, "oboe.snd",
+ :grain_start, 0.1, :grain_start_spread, 0.01,
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 40,
+ :srate_base, 2,
+ :srate, [0, 0, 0.2, 0, 0.6, -1, 1, -1])
+ grani(0, 2.6, 1, "oboe.snd",
+ :grain_start, 0.1, :grain_start_spread, 0.01,
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 40,
+ :srate_linear, true,
+ :srate, [0, 0, 0.2, 1, 0.6, 2 ** (5.0 / 12.0), 1, 2 ** (5.0 / 12.0)])
+ grani(0, 2, 1, "oboe.snd",
+ :grain_start, 0.1, :grain_start_spread, 0.01,
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 40,
+ :grain_duration, [0, 0.02, 1, 0.1],
+ :grain_duration_spread, [0, 0, 0.5, 0.1, 1, 0],
+ :where_to, Grani_to_grain_duration,
+ :where_bins, vct(0, 0.05, 1))
+ grani(0, 2, 1, "oboe.snd",
+ :grain_start, 0.1, :grain_start_spread, 0.01,
+ :amp_envelope, [0, 1, 1, 1], :grain_density, 40,
+ :grain_degree, [0, 0, 1, 90],
+ :grain_degree_spread, 10)
+ end
#
ind = open_sound("oboe.snd")
with_sound(:output, "test1.snd") do
fm_violin(0, 0.1, 440, 0.1)
end
- set_samples(0, 2205, "test1.snd", ind, 0, false, "set_samples auto-delete test", 0, false, true)
- unless File.exists?("test1.snd")
+ set_samples(0, 2205, "test1.snd", ind, 0, false,
+ "set_samples auto-delete test", 0, false, true)
+ unless File.exist?("test1.snd")
snd_display("oops: auto-delete test1.snd?")
end
undo_edit(1, ind)
@@ -35617,7 +33670,7 @@ def test_23_04
fm_violin(0, 0.1, 440, 0.1)
end
insert_sound("test2.snd", 0, 0, ind, 0, false, true)
- if File.exists?("test1.snd")
+ if File.exist?("test1.snd")
snd_display("auto-delete set_samples?")
end
undo_edit(1, ind)
@@ -35625,7 +33678,7 @@ def test_23_04
fm_violin(0, 0.1, 440, 0.1)
end
insert_samples(0, 2205, "test3.snd", ind, 0, false, true)
- if File.exists?("test2.snd")
+ if File.exist?("test2.snd")
snd_display("auto-delete insert_sound?")
end
undo_edit(1, ind)
@@ -35633,12 +33686,12 @@ def test_23_04
fm_violin(0, 0.1, 440, 0.1)
end
mix("test4.snd", 0, 0, ind, 0, false, true)
- if File.exists?("test3.snd")
+ if File.exist?("test3.snd")
snd_display("auto-delete insert_samples?")
end
undo_edit(1, ind)
delete_sample(100, ind, 0)
- if File.exists?("test4.snd")
+ if File.exist?("test4.snd")
snd_display("auto-delete mix?")
end
with_sound(:output, "test5.snd") do
@@ -35647,7 +33700,7 @@ def test_23_04
mix("test5.snd", 0, 0, ind, 0, true, true)
revert_sound(ind)
close_sound(ind)
- if File.exists?("test5.snd")
+ if File.exist?("test5.snd")
snd_display("auto-delete mix (with-tag)?")
end
Snd.sounds.apply(:close_sound)
@@ -35699,20 +33752,19 @@ def test_23_04
end
#
if defined? variable_display
- wid1 = Snd.catch do make_variable_display("do-loop-1", "i*1", :text) end.first
- wid2 = Snd.catch do make_variable_display("do-loop-2", "i*2", :scale, [-1.0, 1.0]) end.first
- wid3 = Snd.catch do make_variable_display("do-loop-3", "i3", :spectrum) end.first
- wid4 = Snd.catch do make_variable_display("do-loop-4", "i4", :graph) end.first
+ wid1 = make_variable_display("do-loop-1", "i*1", :text)
+ wid2 = make_variable_display("do-loop-2", "i*2", :scale, [-1.0, 1.0])
+ wid3 = make_variable_display("do-loop-3", "i3", :spectrum)
+ wid4 = make_variable_display("do-loop-4", "i4", :graph)
if variable_display?(wid1) and
- variable_display?(wid2) and
- variable_display?(wid3) and
- variable_display?(wid4)
+ variable_display?(wid2) and
+ variable_display?(wid3) and
+ variable_display?(wid4)
1000.times do |i|
variable_display(wid4,
- variable_display(wid3,
- variable_display(wid2,
- sin(variable_display(wid1, 1) * 0.1)) * \
- 0.5))
+ variable_display(wid3,
+ variable_display(wid2,
+ sin(variable_display(wid1, 1) * 0.1)) * 0.5))
end
tag = Snd.catch do set_sample(0, 0.5, wid3.snd, 0) end
if (res = edit_position(wid3.snd, 0)) > 0
@@ -35736,7 +33788,7 @@ def test_23_04
[[:clm_srate, default_output_srate],
[:clm_channels, default_output_chans],
[:clm_header_type, default_output_header_type],
- [:clm_data_format, default_output_data_format],
+ [:clm_sample_type, default_output_sample_type],
[:clm_reverb_channels, 1],
[:clm_file_name, "test.snd"],
[:clm_play, false],
@@ -35754,7 +33806,7 @@ def test_23_04
$clm_verbose = false
$clm_statistics = false
$clm_play = false
- $clm_data_format = Mus_mulaw
+ $clm_sample_type = Mus_mulaw
$clm_header_type = Mus_riff
$clm_delete_reverb = true
$clm_reverb = :jc_reverb
@@ -35771,16 +33823,16 @@ def test_23_04
if (res = channels(ind)) != 2
snd_display("default channels in ws: %s %s?", res, $clm_channels)
end
- if (res = data_format(ind)) != Mus_mulaw
- snd_display("default format in ws: %s %s?", res, $clm_data_format)
+ if (res = sample_type(ind)) != Mus_mulaw
+ snd_display("default format in ws: %s %s?", res, $clm_sample_type)
end
if (res = header_type(ind)) != Mus_riff
snd_display("default type in ws: %s %s?", res, $clm_header_type)
end
- if (res = frames(ind)) != 88200
+ if (res = framples(ind)) != 88200
snd_display("reverb+1 sec out in ws: %s?", res)
end
- if File.exists?("test.reverb")
+ if File.exist?("test.reverb")
snd_display("perhaps reverb not deleted in ws?")
end
close_sound(ind)
@@ -35815,7 +33867,7 @@ def test_23_04
$clm_verbose = false
$clm_statistics = false
$clm_play = false
- $clm_data_format = Mus_lfloat
+ $clm_sample_type = Mus_lfloat
$clm_header_type = Mus_next
$clm_delete_reverb = false
$clm_reverb = nil
@@ -35860,7 +33912,7 @@ def test_23_04
# clm23.scm tests skipped
#
file = with_sound(:clipped, false,
- :data_format, Mus_bfloat,
+ :sample_type, Mus_bfloat,
:header_type, Mus_next) do
fm_violin(0, 0.1, 440, PI)
end.output
@@ -35870,7 +33922,7 @@ def test_23_04
end
close_sound(ind)
file = with_sound(:clipped, true,
- :data_format, Mus_bfloat,
+ :sample_type, Mus_bfloat,
:header_type, Mus_next) do
fm_violin(0, 0.1, 440, PI)
end.output
@@ -35880,7 +33932,7 @@ def test_23_04
end
close_sound(ind)
file = with_sound(:clipped, false,
- :data_format, Mus_bfloat,
+ :sample_type, Mus_bfloat,
:header_type, Mus_next,
:scaled_by, 0.1) do
fm_violin(0, 0.1, 440, PI)
@@ -35891,7 +33943,7 @@ def test_23_04
end
close_sound(ind)
file = with_sound(:clipped, false,
- :data_format, Mus_bfloat,
+ :sample_type, Mus_bfloat,
:header_type, Mus_next,
:scaled_to, 0.1) do
fm_violin(0, 0.1, 440, PI)
@@ -35911,7 +33963,7 @@ def test_23_04
tsize = 0
arrp = 0
mx = 0
- file = with_sound(:data_format, Mus_bfloat,
+ file = with_sound(:sample_type, Mus_bfloat,
:header_type, Mus_next) do
mx = mus_file_buffer_size
tsize = clm_table_size
@@ -35933,26 +33985,18 @@ def test_23_04
$clm_array_print_length = old_arrp
close_sound(ind)
#
- # FIXME
- # bug in ws.rb (with_sound)
- ind = find_sound(with_sound do
- fm_violin(0, 3, 440, 0.1)
- end.output)
- if $with_test_gui
- set_amp_control(0.5, ind)
- set_x_bounds([1.0, 2.0], ind, 0)
- end
- ind = find_sound(with_sound do
- fm_violin(0, 4, 440, 0.1)
- end.output)
- if $with_test_gui
- if fneq(res = amp_control(ind), 0.5)
- snd_display("update ws amp: %s?", res)
- end
- res = x_bounds(ind, 0)
- if (fneq(res[0], 1.0) or fneq(res[1], 2.0))
- snd_display("update ws bounds: %s?", res)
- end
+ file = with_sound() do fm_violin(0, 3.0, 440, 0.1) end.output
+ ind = find_sound(file)
+ set_amp_control(0.5, ind)
+ set_x_bounds([1.0, 2.0], ind, 0)
+ file = with_sound(:clm, false) do fm_violin(0, 4.0, 440, 0.1) end.output
+ ind = find_sound(file)
+ res = amp_control(ind)
+ snd_test_neq(res, 0.5, "update ws amp")
+ res = x_bounds(ind, 0)
+ req = [1.0, 2.0]
+ if fneq(res[0], req[0]) or fneq(res[1], req[1])
+ snd_format_neq(res, req, "update ws bounds")
end
close_sound(ind)
#
@@ -35962,7 +34006,7 @@ def test_23_04
ind = find_sound(file)
mx = maxamp(ind)
file = with_sound(:reverb, :jc_reverb,
- :reverb_data, [:volume, 12.0, :amp_env, [0, 0, 1, 1, 20, 1, 21, 0]]) do
+ :reverb_data, [:volume, 12.0, :amp_env, [0, 0, 1, 1, 20, 1, 21, 0]]) do
fm_violin(0, 4, 440, 0.1, :reverb_amount, 0.1)
end.output
ind = find_sound(file)
@@ -35973,8 +34017,8 @@ def test_23_04
#
ind = open_sound("oboe.snd")
step_src
- if (frames - 24602).abs > 100
- snd_display("step_src frames: %s (%s)?", frames, edits)
+ if (framples - 24602).abs > 100
+ snd_display("step_src framples: %s (%s)?", framples, edits)
end
close_sound(ind)
Snd.sounds.apply(:close_sound)
@@ -36018,267 +34062,326 @@ end
# ---------------- test 28: errors ----------------
def check_error_tag(expected_tag, &thunk)
- if (tag = Snd.catch do thunk.call end).first != expected_tag
- snd_display_prev_caller("%s %s: %s", get_func_name, expected_tag.inspect, tag.inspect)
- end
-end
-
-Procs = [:add_mark, :add_sound_file_extension, :add_source_file_extension, :sound_file_extensions,
- :sound_file?, :add_to_main_menu, :add_to_menu, :add_transform, :amp_control,
- :ask_about_unsaved_edits, :as_one_edit, :ask_before_overwrite,
- :audio_input_device, :audio_output_device, :auto_resize, :auto_update,
- :autocorrelate, :axis_color, :axis_info, :axis_label_font, :axis_numbers_font,
- :basic_color, :bind_key, :bomb, :apply_controls, :change_samples_with_origin,
- :channel_style, :channel_widgets, :channels, :chans, :peaks_font, :bold_peaks_font,
- :close_sound, :color_cutoff, :color_orientation_dialog, :colormap_ref, :add_colormap,
- :delete_colormap, :colormap_size, :colormap_name, :color_inverted, :color_scale,
- :color2list, :colormap, :color?, :comment, :contrast_control, :contrast_control_amp,
- :channel_properties, :channel_property, :controls2channel, :amp_control_bounds,
- :speed_control_bounds, :expand_control_bounds, :contrast_control_bounds,
- :sound_file_extensions, :reverb_control_length_bounds, :reverb_control_scale_bounds,
- :cursor_update_interval, :cursor_location_offset, :auto_update_interval,
- :count_matches, :current_font, :cursor, :cursor_color, :with_tracking_cursor,
- :cursor_size, :cursor_style, :tracking_cursor_style, :dac_combines_channels,
- :dac_size, :clipping, :data_color, :data_format, :data_location, :data_size,
- :default_output_chans, :default_output_data_format, :default_output_srate,
- :default_output_header_type, :insert_file_dialog, :file_write_date, :define_envelope,
- :delete_mark, :delete_marks, :forget_region, :delete_sample, :delete_samples,
- :delete_samples_and_smooth, :delete_selection, :delete_selection_and_smooth,
- :dialog_widgets, :display_edits, :dot_size, :draw_dot,
- :draw_dots, :draw_line, :draw_lines, :draw_string, :edit_header_dialog,
- :edit_fragment, :edit_list2function, :edit_position, :edit_tree, :edits,
- :env_selection, :env_sound, :enved_envelope, :enved_base, :enved_clip?,
- :enved_in_dB, :enved_dialog, :enved_style, :enved_power, :enved_target,
- :enved_waveform_color, :enved_wave?, :eps_file, :eps_left_margin, :eps_bottom_margin,
- :eps_size, :expand_control, :expand_control_hop, :expand_control_jitter,
- :expand_control_length, :expand_control_ramp, :expand_control?, :fft,
- :fft_window_beta, :fft_window_alpha, :fft_with_phases, :fft_log_frequency,
- :fft_log_magnitude, :transform_size, :disk_kspace, :transform_graph_type,
- :fft_window, :transform_graph?, :view_files_dialog, :mix_file_dialog, :file_name,
- :fill_polygon, :fill_rectangle, :filter_sound, :filter_control_in_dB,
- :filter_control_envelope, :enved_filter_order, :enved_filter, :filter_control_in_hz,
- :filter_control_order, :filter_selection, :filter_channel,
- :filter_control_waveform_color, :filter_control?, :find_channel, :find_mark,
- :find_sound, :finish_progress_report, :foreground_color, :frames, :free_sampler,
- :graph, :transform?, :delete_transform,
- :graph_color, :graph_cursor, :graph_data, :graph2ps, :gl_graph2ps, :graph_style,
- :lisp_graph?, :graphs_horizontal, :header_type, :help_dialog, :info_dialog,
- :highlight_color, :call_in, :insert_region, :insert_sample, :insert_samples,
- :insert_samples_with_origin, :insert_selection, :insert_silence, :insert_sound,
- :just_sounds, :key, :key_binding, :left_sample, :listener_color, :listener_font,
- :listener_prompt, :listener_selection, :listener_text_color, :main_widgets,
- :make_color, :make_graph_data, :make_mix_sampler, :make_player, :make_region,
- :make_region_sampler, :make_sampler, :map_chan, :mark_color, :mark_name,
- :mark_properties, :mark_property, :mark_sample, :mark_sync, :mark_sync_max,
- :mark_home, :marks, :mark?, :max_transform_peaks, :max_regions,
- :max_virtual_ptrees, :maxamp, :maxamp_position, :menu_widgets,
- :minibuffer_history_length, :min_dB, :log_freq_start, :mix, :mixes, :mix_amp,
- :mix_amp_env, :mix_color, :mix_length, :mix?, :view_mixes_dialog, :mix_position,
- :mix_dialog_mix, :mix_name, :mix_sync_max, :mix_sync, :mix_properties, :mix_property,
- :mix_region, :mix_sampler?, :mix_selection, :mix_home, :mix_speed, :mix_tag_height,
- :mix_tag_width, :mark_tag_height, :mark_tag_width, :mix_tag_y, :mix_vct,
- :mix_waveform_height, :time_graph_style, :lisp_graph_style, :transform_graph_style,
- :read_mix_sample, :next_sample, :read_region_sample,
- :show_full_duration, :initial_beg, :initial_dur, :transform_normalization,
- :open_file_dialog_directory, :open_raw_sound, :open_sound, :color_orientation_dialog,
- :previous_sample, :peaks, :player?, :players, :play_arrow_size, :position_color,
- :position2x, :position2y, :add_directory_to_view_files_list, :add_file_to_view_files_list,
- :view_files_amp, :view_files_speed, :view_files_files, :view_files_selected_files,
- :view_files_speed_style, :view_files_amp_env, :view_files_sort,
- :print_length, :progress_report, :prompt_in_minibuffer, :read_only,
- :redo_edit, :region_chans, :view_regions_dialog, :region_home,
- :region_graph_style, :region_frames, :region_position, :region_maxamp,
- :region_maxamp_position, :remember_sound_state, :selection_maxamp,
- :selection_maxamp_position, :region_sample, :region2vct, :region_srate, :regions, :region?,
- :remove_from_menu, :report_in_minibuffer, :reset_controls, :restore_controls,
- :restore_region, :reverb_control_decay, :reverb_control_feedback,
- :reverb_control_length, :reverb_control_lowpass, :reverb_control_scale,
- :reverb_control?, :reverse_sound, :reverse_selection, :revert_sound,
- :right_sample, :sample, :sampler_at_end?, :sampler?, :samples, :sampler_position,
- :sash_color, :save_controls, :ladspa_dir, :peak_env_dir, :save_dir,
- :save_edit_history, :save_envelopes, :save_listener, :save_marks, :save_region,
- :save_selection, :save_sound, :save_sound_as, :save_state, :save_state_file,
- :scale_by, :scale_selection_by, :scale_selection_to, :scale_to, :scan_chan,
- :search_procedure, :select_all, :select_channel, :select_sound, :selected_channel,
- :selected_data_color, :selected_graph_color, :selected_sound, :selection_position,
- :selection_color, :selection_creates_region, :selection_frames, :selection_member?,
- :selection?, :short_file_name, :show_axes, :show_controls, :show_transform_peaks,
- :show_indices, :show_listener, :show_selection, :unselect_all, :show_marks,
- :show_mix_waveforms, :show_selection_transform, :show_y_zero, :sinc_width, :show_grid,
- :show_sonogram_cursor, :grid_density, :smooth_sound, :smooth_selection, :snd_spectrum,
- :snd_tempnam, :snd_version, :sound_files_in_directory, :sound_loop_info, :sound_widgets,
- :soundfont_info, :sound?, :sounds, :spectrum_end, :spectro_hop, :spectrum_start,
- :spectro_x_angle, :spectro_x_scale, :spectro_y_angle, :spectro_y_scale, :spectro_z_angle,
- :spectro_z_scale, :speed_control, :speed_control_style, :speed_control_tones,
- :squelch_update, :srate, :src_sound, :src_selection, :start_progress_report,
- :stop_player, :stop_playing, :swap_channels, :syncd_marks, :sync, :sync_max,
- :sound_properties, :sound_property, :temp_dir, :text_focus_color, :tiny_font,
- :region_sampler?, :transform_dialog, :transform_sample, :transform2vct,
- :transform_frames, :transform_type, :trap_segfault, :with_file_monitor,
- :unbind_key, :update_transform_graph, :update_time_graph, :update_lisp_graph,
- :update_sound, :clm_table_size, :with_verbose_cursor, :view_sound, :wavelet_type,
- :with_inset_graph, :with_pointer_focus, :with_smpte_label, :with_toolbar, :with_tooltips,
- :with_menu_icons, :save_as_dialog_src, :save_as_dialog_auto_comment,
- :time_graph?, :time_graph_type, :wavo_hop,
- :wavo_trace, :window_height, :window_width, :window_x, :window_y, :with_mix_tags,
- :with_relative_panes, :with_gl, :x_axis_style, :beats_per_measure, :beats_per_minute,
- :x_bounds, :x_position_slider, :x2position, :x_zoom_slider, :mus_header_type2string,
- :mus_data_format2string, :y_bounds, :y_position_slider, :y2position, :y_zoom_slider,
- :zero_pad, :zoom_color, :zoom_focus_style, :sync_style,
- :mus_set_formant_radius_and_frequency, :mus_sound_samples, :mus_sound_frames,
- :mus_sound_duration, :mus_sound_datum_size, :mus_sound_data_location, :data_size,
- :mus_sound_chans, :mus_sound_srate, :mus_sound_header_type, :mus_sound_data_format,
- :mus_sound_length, :mus_sound_type_specifier, :mus_header_type_name,
- :mus_data_format_name, :mus_sound_comment, :mus_sound_write_date, :mus_bytes_per_sample,
- :mus_sound_loop_info, :mus_sound_mark_info, :mus_audio_describe,
- :mus_sound_maxamp, :mus_sound_maxamp_exists?, :mus_file_prescaler,
- :mus_prescaler, :mus_clipping, :mus_file_clipping, :mus_header_raw_defaults,
- :moving_average, :moving_average?, :make_moving_average, :mus_expand_filename,
- :make_sound_data, :sound_data_ref, :sound_data_set!, :sound_data_scale!,
- :sound_data_fill!, :sound_data?, :sound_data_length, :sound_data_multiply!,
- :sound_data_add!, :sound_data_offset!, :sound_data_copy, :sound_data_reverse!,
- :sound_data_maxamp, :sound_data_chans, :sound_data2vct, :vct2sound_data,
- :sound_data_peak, :all_pass, :all_pass?, :amplitude_modulate, :array2file,
- :array_interp, :mus_interpolate, :asymmetric_fm, :asymmetric_fm?,
- :sound_data2sound_data, :clear_array, :comb, :comb?, :filtered_comb,
- :filtered_comb?, :contrast_enhancement, :convolution, :convolve, :convolve?,
- :db2linear, :degrees2radians, :delay, :delay?, :dot_product, :env, :env_interp,
- :env?, :file2array, :file2frame, :file2frame?, :file2sample, :file2sample?,
- :filter, :filter?, :fir_filter, :fir_filter?, :formant, :formant_bank, :formant?,
- :frame_multiply, :frame_add, :frame2file, :clear_minibuffer, :frame2file?,
- :frame2frame, :frame2list, :frame2sample, :frame_ref, :frame_set!, :frame?,
- :granulate, :granulate?, :hz2radians, :iir_filter, :iir_filter?, :in_any, :ina, :inb,
- :linear2db, :locsig, :locsig_ref, :locsig_reverb_ref, :locsig_reverb_set!, :locsig_set!,
- :locsig?, :make_all_pass, :make_asymmetric_fm, :make_comb, :make_convolve, :make_delay,
- :make_env, :make_fft_window, :make_file2frame, :make_file2sample, :make_filter,
- :make_fir_filter, :make_formant, :make_frame, :make_frame2file, :make_granulate,
- :make_iir_filter, :make_locsig, :move_locsig, :make_mixer, :make_notch,
- :make_one_pole, :make_one_zero, :make_oscil, :make_pulse_train, :make_rand,
- :make_rand_interp, :make_readin, :make_sample2file, :make_sawtooth_wave,
- :make_square_wave, :make_src, :make_ssb_am, :make_table_lookup, :make_triangle_wave,
- :make_two_pole, :make_two_zero, :make_wave_train, :mixer_multiply, :mixer_ref,
- :mixer_set!, :mixer?, :mixer_add, :move_sound, :make_move_sound, :move_sound?,
- :mus_float_equal_fudge_factor, :multiply_arrays, :mus_array_print_length, :mus_channel,
- :mus_channels, :make_polyshape, :polyshape, :polyshape?, :mus_close, :mus_data,
- :mus_feedback, :mus_feedforward, :mus_fft, :mus_frequency, :mus_hop, :mus_increment,
- :mus_input?, :mus_file_name, :mus_length, :mus_location, :mus_mix, :mus_order,
- :mus_output?, :mus_phase, :mus_ramp, :mus_random, :mus_scaler, :mus_srate,
- :mus_xcoeffs, :mus_ycoeffs, :notch, :notch?, :one_pole, :one_pole?, :one_zero,
- :one_zero?, :oscil, :oscil?, :out_any, :outa, :outb, :outc, :outd, :partials2polynomial,
- :partials2wave, :phase_partials2wave, :polynomial, :pulse_train, :pulse_train?,
- :radians2degrees, :radians2hz, :rand, :rand_interp, :rand_interp?, :rand?, :readin,
- :readin?, :rectangular2polar, :rectangular2magnitudes, :ring_modulate, :sample2file,
- :sample2file?, :sample2frame, :sawtooth_wave, :sawtooth_wave?, :spectrum, :square_wave,
- :square_wave?, :src, :src?, :ssb_am, :ssb_am?, :table_lookup, :table_lookup?, :tap,
- :triangle_wave, :triangle_wave?, :two_pole, :two_pole?, :two_zero, :two_zero?,
- :wave_train, :wave_train?, :make_vct, :vct_add!, :vct_subtract!, :vct_copy,
- :vct_length, :vct_multiply!, :vct_offset!, :vct_ref, :vct_scale!, :vct_fill!,
- :vct_set!, :vct_peak, :vct?, :list2vct, :vct2list, :vector2vct, :vct2vector,
- :vct_move!, :vct_reverse!, :vct_subseq, :vct, :little_endian?, :vct2string,
- :clm_channel, :env_channel, :map_channel, :scan_channel, :reverse_channel,
- :seconds2samples, :samples2seconds, :vct2channel, :smooth_channel, :channel2vct,
- :src_channel, :scale_channel, :ramp_channel, :pad_channel, :normalize_channel,
- :cursor_position, :mus_sound_prune, :mus_sound_forget, :xramp_channel, :ptree_channel,
- :snd2sample, :snd2sample?, :make_snd2sample, :make_scalar_mixer, :beats_per_minute,
- :beats_per_measure, :channel_amp_envs, :convolve_files, :filter_control_coeffs,
- :locsig_type, :make_phase_vocoder, :mus_describe, :mus_error_type2string,
- :mus_file_buffer_size, :mus_name, :mus_offset, :mus_reset, :mus_rand_seed,
- :mus_width, :phase_vocoder?, :polar2rectangular, :phase_vocoder_amp_increments,
- :phase_vocoder_amps, :phase_vocoder_freqs, :phase_vocoder_phase_increments,
- :phase_vocoder_phases, :mus_generator?, :read_sample, :reset_listener_cursor,
- :goto_listener_end, :sampler_home, :selection_chans, :selection_srate, :snd_gcs,
- :snd_font, :snd_color, :snd_warning, :channel_data, :x_axis_label, :variable_graph?,
- :y_axis_label, :snd_url, :snd_urls, :free_player, :delay_tick, :playing, :draw_axes,
- :copy_sampler, :html_dir, :html_program, :make_fir_coeffs, :mus_interp_type, :mus_run,
- :phase_vocoder, :player_home, :redo_edit, :undo_edit, :widget_position, :widget_size,
- :focus_widget]
-
-Set_procs = [:amp_control, :ask_before_overwrite, :audio_input_device, :audio_output_device,
- :auto_resize, :sound_file_extensions, :auto_update, :axis_color, :axis_label_font,
- :axis_numbers_font, :channel_style, :peaks_font, :bold_peaks_font,
- :show_full_duration, :initial_beg, :initial_dur, :color_cutoff,
- :color_inverted, :color_scale, :contrast_control, :contrast_control_amp,
- :amp_control_bounds, :speed_control_bounds, :expand_control_bounds,
- :contrast_control_bounds, :reverb_control_length_bounds,
- :reverb_control_scale_bounds, :cursor_update_interval, :cursor_location_offset,
- :contrast_control?, :auto_update_interval, :current_font, :cursor, :cursor_color,
- :channel_properties, :channel_property, :with_tracking_cursor, :cursor_size,
- :cursor_style, :tracking_cursor_style, :dac_combines_channels, :dac_size,
- :clipping, :data_color, :default_output_chans, :default_output_data_format,
- :default_output_srate, :default_output_header_type, :dot_size, :enved_envelope,
- :enved_base, :enved_clip?, :enved_in_dB, :enved_style, :enved_power,
- :enved_target, :enved_waveform_color, :enved_wave?, :eps_file, :eps_left_margin,
- :eps_bottom_margin, :eps_size, :expand_control, :expand_control_hop,
- :expand_control_jitter, :expand_control_length, :expand_control_ramp,
- :expand_control?, :fft_window_beta, :fft_window_alpha, :fft_with_phases,
- :fft_log_frequency, :fft_log_magnitude, :transform_size, :transform_graph_type,
- :fft_window, :transform_graph?, :filter_control_in_dB, :filter_control_envelope,
- :axis_color, :enved_filter_order, :enved_filter, :filter_control_in_hz,
- :filter_control_order, :filter_control_waveform_color, :filter_control?,
- :foreground_color, :graph_color, :graph_cursor, :graph_style, :lisp_graph?,
- :graphs_horizontal, :highlight_color, :just_sounds, :left_sample, :listener_color,
- :listener_font, :listener_prompt, :listener_text_color, :mark_color, :mark_name,
- :mark_properties, :mark_property, :mark_sample, :mark_sync, :max_transform_peaks,
- :max_regions, :min_dB, :log_freq_start, :mix_amp, :mix_amp_env, :mix_color,
- :mix_name, :mix_position, :mix_sync, :mix_properties, :mix_property,
- :max_virtual_ptrees, :mix_speed, :mix_tag_height, :mix_tag_width, :mix_tag_y,
- :mark_tag_width, :mark_tag_height, :mix_waveform_height, :transform_normalization,
- :open_file_dialog_directory, :position_color, :view_files_sort, :print_length,
- :play_arrow_size, :region_graph_style, :reverb_control_decay, :reverb_control_feedback,
- :reverb_control_length, :reverb_control_lowpass, :reverb_control_scale,
- :time_graph_style, :lisp_graph_style, :transform_graph_style, :reverb_control?,
- :sash_color, :ladspa_dir, :peak_env_dir, :save_dir, :save_state_file,
- :selected_data_color, :selected_graph_color, :selection_color,
- :selection_creates_region, :show_axes, :show_controls, :show_transform_peaks,
- :show_indices, :show_marks, :show_mix_waveforms, :show_selection_transform,
- :show_listener, :show_y_zero, :show_grid, :show_sonogram_cursor, :sinc_width,
- :spectrum_end, :spectro_hop, :spectrum_start, :spectro_x_angle, :grid_density,
- :spectro_x_scale, :spectro_y_angle, :spectro_y_scale, :spectro_z_angle,
- :spectro_z_scale, :speed_control, :speed_control_style, :speed_control_tones,
- :squelch_update, :sync, :sound_properties, :sound_property, :temp_dir,
- :text_focus_color, :tiny_font, :y_bounds, :transform_type, :trap_segfault,
- :with_file_monitor, :with_verbose_cursor, :with_inset_graph, :with_pointer_focus,
- :wavelet_type, :x_bounds, :with_smpte_label, :with_toolbar, :with_tooltips,
- :with_menu_icons, :save_as_dialog_src, :save_as_dialog_auto_comment,
- :time_graph?, :wavo_hop, :wavo_trace, :with_gl, :with_mix_tags,
- :x_axis_style, :beats_per_minute, :zero_pad, :zoom_color, :zoom_focus_style,
- :sync_style, :with_relative_panes, :window_x, :window_y,
- :window_width, :window_height, :mix_dialog_mix, :beats_per_measure,
- :channels, :chans, :colormap, :comment, :data_format, :data_location,
- :data_size, :edit_position, :frames, :header_type, :maxamp,
- :minibuffer_history_length, :read_only, :right_sample, :sample, :samples,
- :selected_channel, :colormap_size, :selected_sound, :selection_position,
- :selection_frames, :selection_member?, :sound_loop_info, :srate, :time_graph_type,
- :x_position_slider, :x_zoom_slider, :y_position_slider, :y_zoom_slider,
- :sound_data_ref, :mus_array_print_length, :mus_float_equal_fudge_factor,
- :mus_data, :mus_feedback, :mus_feedforward, :mus_frequency, :mus_hop,
- :mus_increment, :mus_length, :mus_location, :mus_phase, :mus_ramp,
- :mus_scaler, :x_axis_label, :locsig_type, :mus_file_buffer_size,
- :mus_rand_seed, :mus_width, :clm_table_size, :mus_offset, :html_dir,
- :html_program, :widget_position, :widget_size, :mus_file_prescaler,
- :mus_clipping, :mus_prescaler, :mus_header_raw_defaults, :view_files_amp,
- :view_files_speed, :view_files_files, :view_files_selected_files,
- :view_files_speed_style, :view_files_amp_env]
-
-Make_procs = [:make_all_pass, :make_asymmetric_fm, :make_snd2sample, :make_moving_average,
- :make_comb, :make_filtered_comb, :make_convolve, :make_delay, :make_env,
- :make_fft_window, :make_file2frame, :make_file2sample, :make_filter,
- :make_fir_filter, :make_formant, :make_frame, :make_frame2file, :make_granulate,
- :make_iir_filter, :make_locsig, :make_mixer, :make_notch, :make_one_pole,
- :make_one_zero, :make_oscil, :make_pulse_train, :make_rand, :make_rand_interp,
- :make_readin, :make_sample2file, :make_sawtooth_wave, :make_square_wave,
- :make_src, :make_table_lookup, :make_triangle_wave, :make_two_pole,
- :make_two_zero, :make_wave_train, :make_phase_vocoder, :make_ssb_am,
- :make_polyshape, :make_color, :make_player, :make_region, :make_scalar_mixer]
-
-Keyargs = [:frequency, :initial_phase, :wave, :cosines, :amplitude, :ratio, :size,
- :a0, :a1, :a2, :b1, :b2, :input, :srate, :file, :channel, :start, :initial_contents,
- :initial_element, :scaler, :feedforward, :feedback, :max_size, :radius, :gain,
- :partials, :r, :a, :n, :fill_time, :order, :xcoeffs, :ycoeffs, :envelope, :base,
- :duration, :offset, :end, :direction, :degree, :distance, :reverb, :output, :fft_size,
- :expansion, :length, :hop, :ramp, :jitter, :type, :format, :comment, :channels, :filter,
- :revout, :width, :edit, :synthesize, :analyze, :interp, :overlap, :pitch, :distribution,
- :sines, :dur]
+ tag = Snd.catch do
+ thunk.call
+ end
+ if tag.first != expected_tag
+ snd_display_prev_caller("%s %s: %s",
+ get_func_name,
+ expected_tag.inspect,
+ tag.inspect)
+ end
+end
+
+Procs = [
+ :add_mark, :add_sound_file_extension, :add_source_file_extension,
+ :sound_file_extensions, :sound_file?, :add_to_main_menu,
+ :add_to_menu, :add_transform, :amp_control, :ask_about_unsaved_edits,
+ :as_one_edit, :ask_before_overwrite,
+ :auto_resize, :auto_update, :autocorrelate,
+ :axis_color, :axis_info, :axis_label_font, :axis_numbers_font,
+ :basic_color, :bind_key, :apply_controls,
+ :change_samples_with_origin, :channel_style, :channel_widgets,
+ :channels, :chans, :peaks_font, :bold_peaks_font, :close_sound,
+ :combined_data_color, :color_cutoff,
+ :color_orientation_dialog, :colormap_ref, :add_colormap,
+ :delete_colormap, :colormap_size, :colormap_name, :color_inverted,
+ :color_scale, :color2list, :colormap, :color?, :comment,
+ :contrast_control, :contrast_control_amp,
+ :channel_properties, :channel_property, :controls2channel,
+ :amp_control_bounds, :speed_control_bounds, :expand_control_bounds,
+ :contrast_control_bounds, :sound_file_extensions,
+ :reverb_control_length_bounds, :reverb_control_scale_bounds,
+ :cursor_update_interval, :cursor_location_offset,
+ :auto_update_interval,
+ :current_font, :cursor, :cursor_color, :with_tracking_cursor,
+ :cursor_size, :cursor_style, :tracking_cursor_style,
+ :dac_combines_channels, :dac_size, :clipping, :data_color,
+ :sample_type, :data_location, :data_size, :default_output_chans,
+ :default_output_sample_type, :default_output_srate,
+ :default_output_header_type, :insert_file_dialog, :file_write_date,
+ :define_envelope, :delete_mark, :delete_marks, :forget_region,
+ :delete_sample, :delete_samples, :delete_samples_and_smooth,
+ :delete_selection, :delete_selection_and_smooth,
+ :dialog_widgets, :display_edits, :dot_size, :draw_dot,
+ :draw_dots, :draw_line, :draw_lines, :draw_string, :edit_header_dialog,
+ :edit_fragment, :edit_list2function, :edit_position, :edit_tree,
+ :edits, :env_selection, :env_sound, :enved_envelope, :enved_base,
+ :enved_clip?, :enved_in_dB, :enved_dialog, :enved_style,
+ :enved_power, :enved_target, :enved_waveform_color, :enved_wave?,
+ :eps_file, :eps_left_margin, :eps_bottom_margin, :eps_size,
+ :expand_control, :expand_control_hop, :expand_control_jitter,
+ :expand_control_length, :expand_control_ramp, :expand_control?, :fft,
+ :fft_window_beta, :fft_window_alpha, :fft_with_phases,
+ :fft_log_frequency, :fft_log_magnitude, :transform_size,
+ :disk_kspace, :transform_graph_type, :fft_window,
+ :transform_graph?, :mix_file_dialog, :file_name, :fill_polygon,
+ :fill_rectangle, :filter_sound, :filter_control_in_dB,
+ :filter_control_envelope, :enved_filter_order, :enved_filter,
+ :filter_control_in_hz, :filter_control_order, :filter_selection,
+ :filter_channel, :filter_control_waveform_color, :filter_control?,
+ :find_mark, :find_sound, :finish_progress_report, :foreground_color,
+ :framples, :free_sampler, :graph, :transform?, :delete_transform,
+ :graph_color, :graph_cursor, :graph_data, :graph2ps, :gl_graph2ps,
+ :graph_style, :lisp_graph?, :graphs_horizontal, :header_type,
+ :help_dialog, :info_dialog, :highlight_color, :call_in,
+ :insert_region, :insert_sample, :insert_samples,
+ :insert_samples_with_origin, :insert_selection, :insert_silence,
+ :insert_sound, :just_sounds, :key, :key_binding, :left_sample,
+ :listener_color, :listener_font, :listener_prompt,
+ :listener_selection, :listener_text_color, :main_widgets,
+ :make_color, :make_graph_data, :make_mix_sampler, :make_player,
+ :make_region, :make_region_sampler, :make_sampler, :map_chan,
+ :mark_color, :mark_name, :mark_properties, :mark_property,
+ :mark_sample, :mark_sync, :mark_sync_max,
+ :mark_home, :marks, :mark?, :max_transform_peaks, :max_regions,
+ :maxamp, :maxamp_position, :menu_widgets,
+ :min_dB, :log_freq_start, :mix, :mixes, :mix_amp,
+ :mix_amp_env, :mix_color, :mix_length, :mix?, :view_mixes_dialog,
+ :mix_position, :mix_dialog_mix, :mix_name, :mix_sync_max,
+ :mix_sync, :mix_properties, :mix_property, :mix_region,
+ :mix_sampler?, :mix_selection, :mix_home, :mix_speed,
+ :mix_tag_height, :mix_tag_width, :mark_tag_height, :mark_tag_width,
+ :mix_tag_y, :mix_vct, :mix_waveform_height, :time_graph_style,
+ :lisp_graph_style, :transform_graph_style,
+ :read_mix_sample, :next_sample, :read_region_sample,
+ :show_full_duration, :show_full_range, :initial_beg, :initial_dur,
+ :transform_normalization, :open_file_dialog_directory,
+ :open_raw_sound, :open_sound, :color_orientation_dialog,
+ :previous_sample, :peaks, :player?, :players,
+ :play_arrow_size, :position_color,
+ :position2x, :position2y, :print_length, :progress_report, :read_only,
+ :redo_edit, :region_chans, :view_regions_dialog, :region_home,
+ :region_graph_style, :region_framples, :region_position, :region_maxamp,
+ :region_maxamp_position, :remember_sound_state, :selection_maxamp,
+ :selection_maxamp_position, :region_sample, :region2vct,
+ :region_srate, :regions, :region?, :remove_from_menu,
+ :reset_controls, :restore_controls, :restore_region,
+ :reverb_control_decay, :reverb_control_feedback,
+ :reverb_control_length, :reverb_control_lowpass,
+ :reverb_control_scale, :reverb_control?, :reverse_sound,
+ :reverse_selection, :revert_sound, :right_sample, :sample,
+ :sampler_at_end?, :sampler?, :samples, :sampler_position,
+ :sash_color, :save_controls, :ladspa_dir, :peak_env_dir,
+ :save_dir, :save_edit_history, :save_envelopes, :save_listener,
+ :save_marks, :save_region, :save_selection, :save_sound,
+ :save_sound_as, :save_state, :save_state_file,
+ :scale_by, :scale_selection_by, :scale_selection_to, :scale_to,
+ :search_procedure, :select_all, :select_channel,
+ :select_sound, :selected_channel, :selected_data_color,
+ :selected_graph_color, :selected_sound, :selection_position,
+ :selection_color, :selection_creates_region, :selection_framples,
+ :selection_member?, :selection?, :short_file_name,
+ :show_axes, :show_controls, :show_transform_peaks, :show_indices,
+ :show_listener, :show_selection, :unselect_all, :show_marks,
+ :show_mix_waveforms, :show_selection_transform, :show_y_zero,
+ :sinc_width, :show_grid, :show_sonogram_cursor, :grid_density,
+ :smooth_sound, :smooth_selection, :snd_spectrum, :snd_tempnam,
+ :snd_version, :sound_files_in_directory, :sound_loop_info,
+ :sound_widgets, :soundfont_info, :sound?, :sounds,
+ :spectrum_end, :spectro_hop, :spectrum_start, :spectro_x_angle,
+ :spectro_x_scale, :spectro_y_angle, :spectro_y_scale,
+ :spectro_z_angle, :spectro_z_scale, :speed_control,
+ :speed_control_style, :speed_control_tones, :squelch_update,
+ :srate, :src_sound, :src_selection, :start_progress_report,
+ :stop_player, :stop_playing, :swap_channels, :syncd_marks,
+ :sync, :sync_max, :sound_properties, :sound_property,
+ :temp_dir, :text_focus_color, :tiny_font,
+ :region_sampler?, :transform_dialog, :transform_sample, :transform2vct,
+ :transform_framples, :transform_type, :with_file_monitor,
+ :unbind_key, :update_transform_graph, :update_time_graph,
+ :update_lisp_graph, :update_sound, :clm_table_size,
+ :with_verbose_cursor, :view_sound, :wavelet_type,
+ :with_inset_graph, :with_interrupts, :with_pointer_focus,
+ :with_smpte_label, :with_toolbar, :with_tooltips,
+ :with_menu_icons, :save_as_dialog_src,
+ :save_as_dialog_auto_comment, :time_graph?, :time_graph_type,
+ :wavo_hop, :wavo_trace, :window_height, :window_width,
+ :window_x, :window_y, :with_mix_tags, :with_relative_panes,
+ :with_gl, :x_axis_style, :beats_per_measure, :beats_per_minute,
+ :x_bounds, :x_position_slider, :x2position, :x_zoom_slider,
+ :mus_header_type2string, :mus_sample_type2string, :y_bounds,
+ :y_position_slider, :y2position, :y_zoom_slider, :zero_pad,
+ :zoom_color, :zoom_focus_style, :sync_style,
+ :mus_set_formant_radius_and_frequency,
+ :mus_sound_samples, :mus_sound_framples, :mus_sound_duration,
+ :mus_sound_datum_size, :mus_sound_data_location, :data_size,
+ :mus_sound_chans, :mus_sound_srate, :mus_sound_header_type,
+ :mus_sound_sample_type, :mus_sound_length,
+ :mus_sound_type_specifier, :mus_header_type_name,
+ :mus_sample_type_name, :mus_sound_comment,
+ :mus_sound_write_date, :mus_bytes_per_sample,
+ :mus_sound_loop_info, :mus_sound_mark_info,
+ :mus_sound_maxamp, :mus_sound_maxamp_exists?,
+ :mus_clipping, :mus_file_clipping, :mus_header_raw_defaults,
+ :moving_average, :moving_average?, :make_moving_average,
+ :mus_expand_filename, :all_pass, :all_pass?,
+ :amplitude_modulate, :array2file, :array_interp,
+ :mus_interpolate, :asymmetric_fm, :asymmetric_fm?,
+ :comb, :comb?, :filtered_comb, :filtered_comb?,
+ :contrast_enhancement, :convolution, :convolve, :convolve?,
+ :db2linear, :degrees2radians, :delay, :delay?, :dot_product,
+ :env, :env_interp, :env?, :file2array, :file2frample,
+ :file2frample?, :file2sample, :file2sample?,
+ :filter, :filter?, :fir_filter, :fir_filter?, :formant,
+ :formant_bank, :formant_bank?, :formant?,
+ :frample2file, :frample2file?, :frample2frample,
+ :granulate, :granulate?, :hz2radians, :iir_filter, :iir_filter?,
+ :in_any, :ina, :inb, :linear2db, :locsig, :locsig_ref,
+ :locsig_reverb_ref, :locsig_reverb_set!, :locsig_set!,
+ :locsig?, :make_all_pass, :make_asymmetric_fm, :make_comb,
+ :make_convolve, :make_delay, :make_env, :make_fft_window,
+ :make_file2frample, :make_file2sample, :make_filter,
+ :make_fir_filter, :make_formant, :make_frample2file,
+ :make_granulate, :make_iir_filter, :make_locsig, :move_locsig,
+ :make_notch, :make_one_pole, :make_one_zero,
+ :make_oscil, :make_pulse_train, :make_rand, :make_rand_interp,
+ :make_readin, :make_sample2file, :make_sawtooth_wave,
+ :make_square_wave, :make_src, :make_ssb_am,
+ :make_table_lookup, :make_triangle_wave, :make_two_pole,
+ :make_two_zero, :make_wave_train, :move_sound,
+ :make_move_sound, :move_sound?, :mus_float_equal_fudge_factor,
+ :mus_array_print_length, :mus_channel, :mus_channels,
+ :make_polyshape, :polyshape, :polyshape?, :mus_close,
+ :mus_data, :mus_feedback, :mus_feedforward, :mus_fft,
+ :mus_frequency, :mus_hop, :mus_increment, :mus_input?,
+ :mus_file_name, :mus_length, :mus_location, :mus_order,
+ :mus_output?, :mus_phase, :mus_ramp, :mus_random,
+ :mus_scaler, :mus_srate, :mus_xcoeffs, :mus_ycoeffs,
+ :notch, :notch?, :one_pole, :one_pole?, :one_zero, :one_zero?,
+ :oscil, :oscil?, :out_any, :outa, :outb, :outc, :outd,
+ :partials2polynomial, :partials2wave, :phase_partials2wave,
+ :polynomial, :pulse_train, :pulse_train?, :radians2degrees,
+ :radians2hz, :rand, :rand_interp, :rand_interp?, :rand?, :readin,
+ :readin?, :rectangular2polar, :rectangular2magnitudes, :ring_modulate,
+ :sample2file, :sample2file?, :sawtooth_wave, :sawtooth_wave?,
+ :spectrum, :square_wave, :square_wave?, :src, :src?, :ssb_am,
+ :ssb_am?, :table_lookup, :table_lookup?, :tap, :triangle_wave,
+ :triangle_wave?, :two_pole, :two_pole?, :two_zero, :two_zero?,
+ :wave_train, :wave_train?, :make_vct, :vct_add!, :vct_subtract!,
+ :vct_copy, :vct_length, :vct_multiply!, :vct_offset!, :vct_ref,
+ :vct_scale!, :vct_set!, :vct_peak, :vct?, :list2vct, :vct2list,
+ :vector2vct, :vct2vector, :vct_move!, :vct_reverse!, :vct_subseq,
+ :vct, :little_endian?, :vct2string, :clm_channel, :env_channel,
+ :map_channel, :scan_channel, :reverse_channel, :seconds2samples,
+ :samples2seconds, :vct2channel, :smooth_channel, :channel2vct,
+ :src_channel, :scale_channel, :ramp_channel, :pad_channel,
+ :normalize_channel, :cursor_position, :mus_sound_prune,
+ :mus_sound_forget, :xramp_channel, :snd2sample, :snd2sample?,
+ :make_snd2sample, :beats_per_minute, :beats_per_measure,
+ :channel_amp_envs, :convolve_files, :filter_control_coeffs,
+ :locsig_type, :make_phase_vocoder, :mus_describe,
+ :mus_error_type2string, :mus_file_buffer_size, :mus_name,
+ :mus_offset, :mus_reset, :mus_rand_seed, :mus_width,
+ :phase_vocoder?, :polar2rectangular, :phase_vocoder_amp_increments,
+ :phase_vocoder_amps, :phase_vocoder_freqs, :phase_vocoder_phase_increments,
+ :phase_vocoder_phases, :mus_generator?, :read_sample,
+ :reset_listener_cursor, :goto_listener_end, :sampler_home,
+ :selection_chans, :selection_srate, :snd_gcs, :snd_font,
+ :snd_color, :snd_warning, :channel_data, :x_axis_label,
+ :variable_graph?, :y_axis_label, :snd_url, :snd_urls,
+ :free_player, :delay_tick, :playing, :draw_axes,
+ :copy_sampler, :html_dir, :html_program, :make_fir_coeffs,
+ :mus_interp_type, :mus_run, :phase_vocoder, :player_home,
+ :redo_edit, :undo_edit, :widget_position, :widget_size, :focus_widget]
+
+Set_procs = [
+ :amp_control, :ask_before_overwrite, :auto_resize, :sound_file_extensions,
+ :auto_update, :axis_color, :axis_label_font, :axis_numbers_font,
+ :channel_style, :peaks_font, :bold_peaks_font, :show_full_duration,
+ :show_full_range, :initial_beg, :initial_dur, :color_cutoff,
+ :color_inverted, :color_scale, :contrast_control, :contrast_control_amp,
+ :combined_data_color, :amp_control_bounds, :speed_control_bounds,
+ :expand_control_bounds, :contrast_control_bounds,
+ :reverb_control_length_bounds, :reverb_control_scale_bounds,
+ :cursor_update_interval, :cursor_location_offset, :contrast_control?,
+ :auto_update_interval, :current_font, :cursor, :cursor_color,
+ :channel_properties, :channel_property, :with_tracking_cursor, :cursor_size,
+ :cursor_style, :tracking_cursor_style, :dac_combines_channels, :dac_size,
+ :clipping, :data_color, :default_output_chans, :default_output_sample_type,
+ :default_output_srate, :default_output_header_type, :dot_size,
+ :enved_envelope, :enved_base, :enved_clip?, :enved_in_dB, :enved_style,
+ :enved_power, :enved_target, :enved_waveform_color, :enved_wave?, :eps_file,
+ :eps_left_margin,
+ :eps_bottom_margin, :eps_size, :expand_control, :expand_control_hop,
+ :expand_control_jitter, :expand_control_length, :expand_control_ramp,
+ :expand_control?, :fft_window_beta, :fft_window_alpha, :fft_with_phases,
+ :fft_log_frequency, :fft_log_magnitude, :transform_size,
+ :transform_graph_type, :fft_window, :transform_graph?,
+ :filter_control_in_dB, :filter_control_envelope, :axis_color,
+ :enved_filter_order, :enved_filter, :filter_control_in_hz,
+ :filter_control_order, :filter_control_waveform_color, :filter_control?,
+ :foreground_color, :graph_color, :graph_cursor, :graph_style, :lisp_graph?,
+ :graphs_horizontal, :highlight_color, :just_sounds, :left_sample,
+ :listener_color, :listener_font, :listener_prompt,
+ :listener_text_color, :mark_color, :mark_name, :mark_properties,
+ :mark_property, :mark_sample, :mark_sync, :max_transform_peaks,
+ :max_regions, :min_dB, :log_freq_start, :mix_amp,
+ :mix_amp_env, :mix_color, :mix_name, :mix_position, :mix_sync,
+ :mix_properties, :mix_property, :mix_speed, :mix_tag_height,
+ :mix_tag_width, :mix_tag_y, :mark_tag_width, :mark_tag_height,
+ :mix_waveform_height, :transform_normalization,
+ :open_file_dialog_directory, :position_color, :print_length,
+ :play_arrow_size, :region_graph_style, :reverb_control_decay,
+ :reverb_control_feedback, :reverb_control_length,
+ :reverb_control_lowpass, :reverb_control_scale, :time_graph_style,
+ :lisp_graph_style, :transform_graph_style, :reverb_control?,
+ :sash_color, :ladspa_dir, :peak_env_dir, :save_dir, :save_state_file,
+ :selected_data_color, :selected_graph_color, :selection_color,
+ :selection_creates_region, :show_axes, :show_controls, :show_transform_peaks,
+ :show_indices, :show_marks, :show_mix_waveforms, :show_selection_transform,
+ :show_listener, :show_y_zero, :show_grid, :show_sonogram_cursor, :sinc_width,
+ :spectrum_end, :spectro_hop, :spectrum_start, :spectro_x_angle, :grid_density,
+ :spectro_x_scale, :spectro_y_angle, :spectro_y_scale, :spectro_z_angle,
+ :spectro_z_scale, :speed_control, :speed_control_style, :speed_control_tones,
+ :squelch_update, :sync, :sound_properties, :sound_property, :temp_dir,
+ :text_focus_color, :tiny_font, :y_bounds, :transform_type,
+ :with_file_monitor, :with_verbose_cursor, :with_inset_graph, :with_interrupts,
+ :with_pointer_focus, :wavelet_type, :x_bounds, :with_smpte_label,
+ :with_toolbar, :with_tooltips, :with_menu_icons, :save_as_dialog_src,
+ :save_as_dialog_auto_comment, :time_graph?, :wavo_hop,
+ :wavo_trace, :with_gl, :with_mix_tags, :x_axis_style,
+ :beats_per_minute, :zero_pad, :zoom_color, :zoom_focus_style,
+ :sync_style, :with_relative_panes, :window_x, :window_y,
+ :window_width, :window_height, :mix_dialog_mix, :beats_per_measure,
+ :channels, :chans, :colormap, :comment, :sample_type, :data_location,
+ :data_size, :edit_position, :framples, :header_type, :maxamp,
+ :read_only, :right_sample, :sample, :samples,
+ :selected_channel, :colormap_size, :selected_sound, :selection_position,
+ :selection_framples, :selection_member?, :sound_loop_info, :srate,
+ :time_graph_type, :x_position_slider, :x_zoom_slider,
+ :y_position_slider, :y_zoom_slider,
+ :mus_array_print_length, :mus_float_equal_fudge_factor,
+ :mus_feedback, :mus_feedforward, :mus_frequency, :mus_hop,
+ :mus_increment, :mus_length, :mus_location, :mus_phase, :mus_ramp,
+ :mus_scaler, :x_axis_label, :locsig_type, :mus_file_buffer_size,
+ :mus_rand_seed, :mus_width, :clm_table_size, :mus_offset, :html_dir,
+ :html_program, :widget_position, :widget_size,
+ :mus_clipping, :mus_header_raw_defaults]
+
+Make_procs = [
+ :make_all_pass, :make_asymmetric_fm, :make_snd2sample, :make_moving_average,
+ :make_moving_max, :make_comb, :make_filtered_comb, :make_convolve,
+ :make_delay, :make_env, :make_fft_window, :make_file2frample,
+ :make_file2sample, :make_filter, :make_fir_filter, :make_formant,
+ :make_frample2file, :make_granulate, :make_iir_filter, :make_locsig,
+ :make_notch, :make_one_pole, :make_one_zero, :make_oscil,
+ :make_pulse_train, :make_rand, :make_rand_interp, :make_readin,
+ :make_sample2file, :make_sawtooth_wave, :make_square_wave, :make_src,
+ :make_table_lookup, :make_triangle_wave, :make_two_pole, :make_two_zero,
+ :make_wave_train, :make_phase_vocoder, :make_ssb_am, :make_polyshape,
+ :make_color, :make_player, :make_region]
+
+Keyargs = [
+ :frequency, :initial_phase, :wave, :cosines, :amplitude, :ratio, :size,
+ :a0, :a1, :a2, :b1, :b2, :input, :srate, :file, :channel, :start,
+ :initial_contents, :initial_element, :scaler, :feedforward, :feedback,
+ :max_size, :radius, :gain, :partials, :r, :a, :n, :fill_time, :order,
+ :xcoeffs, :ycoeffs, :envelope, :base, :duration, :offset, :end,
+ :direction, :degree, :distance, :reverb, :output, :fft_size, :expansion,
+ :length, :hop, :ramp, :jitter, :type, :format, :comment, :channels,
+ :filter, :revout, :width, :edit, :synthesize, :analyze, :interp,
+ :overlap, :pitch, :distribution, :sines, :dur]
class Array
# If body results in true, returns the rejected elements in a new
@@ -36298,44 +34401,80 @@ class Array
end
end
-Procs00 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 0) end
-Set_procs00 = Set_procs.remove_if! do |n| function?(n) and set_arity_ok(n, 1) end
-Procs01 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 1) end
-Set_procs01 = Set_procs.remove_if! do |n| function?(n) and set_arity_ok(n, 2) end
-Procs02 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 2) end
-Set_procs02 = Set_procs.remove_if! do |n| function?(n) and set_arity_ok(n, 3) end
-Procs03 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 3) end
-Set_procs03 = Set_procs.remove_if! do |n| function?(n) and set_arity_ok(n, 4) end
-Procs04 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 4) end
-Set_procs04 = Set_procs.remove_if! do |n| function?(n) and set_arity_ok(n, 5) end
-Procs05 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 5) end
-Procs06 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 6) end
-Procs07 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 7) end # not used
-Procs08 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 8) end
-Procs10 = Procs.remove_if! do |n| function?(n) and arity_ok(n, 10) end
+Procs00 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 0)
+end
+Set_procs00 = Set_procs.remove_if! do |n|
+ function?(n) and set_arity_ok(n, 1)
+end
+Procs01 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 1)
+end
+Set_procs01 = Set_procs.remove_if! do |n|
+ function?(n) and set_arity_ok(n, 2)
+end
+Procs02 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 2)
+end
+Set_procs02 = Set_procs.remove_if! do |n|
+ function?(n) and set_arity_ok(n, 3)
+end
+Procs03 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 3)
+end
+Set_procs03 = Set_procs.remove_if! do |n|
+ function?(n) and set_arity_ok(n, 4)
+end
+Procs04 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 4)
+end
+Set_procs04 = Set_procs.remove_if! do |n|
+ function?(n) and set_arity_ok(n, 5)
+end
+Procs05 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 5)
+end
+Procs06 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 6)
+end
+# Procs07 is not used
+Procs07 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 7)
+end
+Procs08 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 8)
+end
+Procs10 = Procs.remove_if! do |n|
+ function?(n) and arity_ok(n, 10)
+end
$delay_32 = make_oscil(440)
-$color_95 = [1, 2, 3]
+$color_95 = vector(1, 2, 3)
$vector_0 = make_comb(0.1, 3)
-$vct_3 = make_vct(3)
+$vct_3 = Vct.new(3)
def test_28_00
- procs1 =
- [:amp_control, :apply_controls, :comment,
- :contrast_control, :amp_control_bounds, :speed_control_bounds, :expand_control_bounds,
- :contrast_control_bounds, :reverb_control_length_bounds, :reverb_control_scale_bounds,
- :contrast_control_amp, :contrast_control?, :data_format, :data_location, :data_size,
- :expand_control, :expand_control_hop, :expand_control_jitter, :expand_control_length,
- :expand_control_ramp, :expand_control?, :filter_control_in_dB,
- :filter_control_in_hz, :filter_control_envelope, :filter_control_order, :filter_control?,
- :finish_progress_report, :frames, :header_type, :progress_report, :read_only,
- :reset_controls, :restore_controls, :reverb_control_decay, :reverb_control_feedback,
- :reverb_control_length, :reverb_control_lowpass, :reverb_control_scale, :reverb_control?,
- :save_controls, :select_sound, :short_file_name, :sound_loop_info, :soundfont_info,
- :speed_control, :speed_control_style, :speed_control_tones, :srate, :channel_style,
- :start_progress_report, :sync, :sound_properties, :sound_property, :swap_channels]
+ procs1 = [
+ :amp_control, :apply_controls, :comment, :contrast_control,
+ :amp_control_bounds, :speed_control_bounds, :expand_control_bounds,
+ :contrast_control_bounds, :reverb_control_length_bounds,
+ :reverb_control_scale_bounds, :contrast_control_amp,
+ :contrast_control?, :sample_type, :data_location, :data_size,
+ :expand_control, :expand_control_hop, :expand_control_jitter,
+ :expand_control_length, :expand_control_ramp, :expand_control?,
+ :filter_control_in_dB, :filter_control_in_hz, :filter_control_envelope,
+ :filter_control_order, :filter_control?, :finish_progress_report,
+ :framples, :header_type, :progress_report, :read_only, :reset_controls,
+ :restore_controls, :reverb_control_decay, :reverb_control_feedback,
+ :reverb_control_length, :reverb_control_lowpass, :reverb_control_scale,
+ :reverb_control?, :save_controls, :select_sound, :short_file_name,
+ :sound_loop_info, :soundfont_info, :speed_control,
+ :speed_control_style, :speed_control_tones, :srate, :channel_style,
+ :start_progress_report, :sync, :sound_properties, :sound_property,
+ :swap_channels]
procs1.each do |n|
- if (tag = Snd.catch do snd_func(n, integer2sound(123)) end).first != :no_such_sound
+ tag = Snd.catch do snd_func(n, integer2sound(123)) end
+ if tag.first != :no_such_sound
snd_display("snd :no_such_sound %s: %s", n, tag)
end
end
@@ -36350,24 +34489,26 @@ def test_28_00
end
end
end
- progs2 =
- [:amp_control, :channels, :chans, :comment,
- :contrast_control, :amp_control_bounds, :speed_control_bounds, :expand_control_bounds,
- :contrast_control_bounds, :reverb_control_length_bounds, :reverb_control_scale_bounds,
- :contrast_control_amp, :contrast_control?, :data_format, :data_location, :data_size,
- :expand_control, :expand_control_hop, :expand_control_jitter, :expand_control_length,
- :expand_control_ramp, :expand_control?, :filter_control_in_dB,
- :filter_control_in_hz, :filter_control_envelope, :filter_control_order, :filter_control?,
- :frames, :header_type, :read_only,
- :reverb_control_decay, :reverb_control_feedback,
- :reverb_control_length, :reverb_control_lowpass, :reverb_control_scale, :reverb_control?,
- :sound_loop_info,
- :speed_control, :speed_control_style, :speed_control_tones, :srate, :channel_style, :sync]
+ progs2 = [
+ :amp_control, :channels, :chans, :comment, :contrast_control,
+ :amp_control_bounds, :speed_control_bounds, :expand_control_bounds,
+ :contrast_control_bounds, :reverb_control_length_bounds,
+ :reverb_control_scale_bounds, :contrast_control_amp,
+ :contrast_control?, :sample_type, :data_location, :data_size,
+ :expand_control, :expand_control_hop, :expand_control_jitter,
+ :expand_control_length, :expand_control_ramp, :expand_control?,
+ :filter_control_in_dB, :filter_control_in_hz, :filter_control_envelope,
+ :filter_control_order, :filter_control?, :framples, :header_type,
+ :read_only, :reverb_control_decay, :reverb_control_feedback,
+ :reverb_control_length, :reverb_control_lowpass,
+ :reverb_control_scale, :reverb_control?, :sound_loop_info,
+ :speed_control, :speed_control_style, :speed_control_tones,
+ :srate, :channel_style, :sync]
[sqrt(-1.0), 1.5, "hiho"].each do |arg|
progs2.each_with_index do |n, i|
if (tag = Snd.catch do
case n
- when :channels, :chans, :data_format, :data_location, :data_size,
+ when :channels, :chans, :sample_type, :data_location, :data_size,
:header_type, :srate, :comment
# g_set_channels(snd, val)
set_snd_func(n, arg, 0)
@@ -36380,21 +34521,24 @@ def test_28_00
end
end
end
- progs3 =
- [:amp_control,
- :contrast_control, :amp_control_bounds, :speed_control_bounds, :expand_control_bounds,
- :contrast_control_bounds, :reverb_control_length_bounds, :reverb_control_scale_bounds,
- :contrast_control_amp, :contrast_control?,
- :expand_control, :expand_control_hop, :expand_control_jitter, :expand_control_length,
- :expand_control_ramp, :expand_control?, :filter_control_in_dB,
- :filter_control_in_hz, :filter_control_envelope, :filter_control_order, :filter_control?,
- :reverb_control_decay, :reverb_control_feedback,
- :reverb_control_length, :reverb_control_lowpass, :reverb_control_scale, :reverb_control?,
- :speed_control, :speed_control_style, :speed_control_tones, :channel_style, :sync]
+ progs3 = [
+ :amp_control, :contrast_control, :amp_control_bounds,
+ :speed_control_bounds, :expand_control_bounds, :contrast_control_bounds,
+ :reverb_control_length_bounds, :reverb_control_scale_bounds,
+ :contrast_control_amp, :contrast_control?, :expand_control,
+ :expand_control_hop, :expand_control_jitter,
+ :expand_control_length, :expand_control_ramp, :expand_control?,
+ :filter_control_in_dB, :filter_control_in_hz,
+ :filter_control_envelope, :filter_control_order, :filter_control?,
+ :reverb_control_decay, :reverb_control_feedback,
+ :reverb_control_length, :reverb_control_lowpass,
+ :reverb_control_scale, :reverb_control?, :speed_control,
+ :speed_control_style, :speed_control_tones, :channel_style, :sync]
index = open_sound("obtest.snd")
[sqrt(-1.0), "hiho"].each do |arg|
progs3.each_with_index do |n, i|
- if (tag = Snd.catch do set_snd_func(n, arg, index) end).first != :wrong_type_arg
+ tag = Snd.catch do set_snd_func(n, arg, index) end
+ if tag.first != :wrong_type_arg
snd_display("snd safe set :wrong_type_arg %s %s: %s %s", i, n, tag, arg)
end
end
@@ -36409,19 +34553,23 @@ def test_28_00
end
[Array.new(1), "hiho", sqrt(-1.0), 1.5, [1, 0], [0, 1]].each do |arg1|
["hiho", sqrt(-1.0), 1.5, [1, 0], [0, 1]].each do |arg2|
- [:vct_add!, :vct_subtract!, :vct_multiply!, :vct_ref, :vct_scale!, :vct_fill!].each do |n|
+ [:vct_add!, :vct_subtract!,
+ :vct_multiply!, :vct_ref, :vct_scale!].each do |n|
case tag = (res = Snd.catch do snd_func(n, arg1, arg2) end).first
when :wrong_type_arg, :wrong_number_of_args, :mus_error
nil
else
- snd_display("vct 1 :wrong_whatever %s: %s %s %s (%s)", n, tag, arg1, arg2, res)
+ snd_display("vct 1 :wrong_whatever %s: %s %s %s (%s)",
+ n, tag, arg1, arg2, res)
end
end
end
end
[Array.new(1), "hiho", sqrt(-1.0), [1, 0], [0, 1]].each do |arg|
- [:vct_add!, :vct_subtract!, :vct_multiply!, :vct_ref, :vct_scale!, :vct_fill!].each do |n|
- if (tag = Snd.catch do snd_func(n, $vct_3, arg) end).first != :wrong_type_arg
+ [:vct_add!, :vct_subtract!,
+ :vct_multiply!, :vct_ref, :vct_scale!].each do |n|
+ tag = Snd.catch do snd_func(n, $vct_3, arg) end
+ if tag.first != :wrong_type_arg
snd_display("vct 2 :wrong_type_arg %s: %s %s", n, tag, arg)
end
end
@@ -36439,16 +34587,17 @@ def test_28_00
if (tag = Snd.catch do v[12] end).first != :out_of_range
snd_display("v[12]: %s", tag)
end
- procs_p =
- [:all_pass?, :asymmetric_fm?, :comb?, :filtered_comb?, :convolve?, :delay?, :env?,
- :file2frame?, :file2sample?, :snd2sample?, :filter?, :fir_filter?, :formant?,
- :frame2file?, :frame?, :granulate?, :iir_filter?, :locsig?, :mixer?, :move_sound?, :mus_input?,
- :mus_output?, :notch?, :one_pole?, :one_zero?, :oscil?, :phase_vocoder?,
- :pulse_train?, :rand_interp?, :rand?, :readin?, :sample2file?, :sawtooth_wave?,
- :square_wave?, :src?,
- :table_lookup?, :triangle_wave?, :two_pole?, :two_zero?, :wave_train?,
- :color?, :mix_sampler?, :moving_average?, :ssb_am?, :sampler?,
- :region_sampler?, :vct?]
+ procs_p = [
+ :all_pass?, :asymmetric_fm?, :comb?, :filtered_comb?, :convolve?,
+ :delay?, :env?, :file2frample?, :file2sample?, :snd2sample?,
+ :filter?, :fir_filter?, :formant?, :frample2file?, :frame?,
+ :granulate?, :iir_filter?, :locsig?, :mixer?, :move_sound?,
+ :mus_input?, :mus_output?, :notch?, :one_pole?, :one_zero?,
+ :oscil?, :phase_vocoder?, :pulse_train?, :rand_interp?, :rand?,
+ :readin?, :sample2file?, :sawtooth_wave?, :square_wave?, :src?,
+ :table_lookup?, :triangle_wave?, :two_pole?, :two_zero?,
+ :wave_train?, :color?, :mix_sampler?, :moving_average?,
+ :ssb_am?, :sampler?, :region_sampler?, :vct?]
[Array.new(1), "hiho", sqrt(-1.0), 1.5, [1, 0], [0, 1]].each do |arg|
procs_p.each do |n|
if (tag = Snd.catch do snd_func(n, arg) end).first.kind_of?(TrueClass)
@@ -36458,131 +34607,169 @@ def test_28_00
end
procs_p.each do |n|
next if n == :oscil?
- if (tag = Snd.catch do snd_func(n, make_oscil(440)) end).first.kind_of?(TrueClass)
+ tag = Snd.catch do snd_func(n, make_oscil(440)) end
+ if tag.first.kind_of?(TrueClass)
snd_display("oscil?proc %s: %s", n, tag)
end
end
- [:reverse_selection, :selection_position, :selection_frames, :smooth_selection,
- :scale_selection_to, :insert_selection, :delete_selection, :delete_selection_and_smooth,
+ [:reverse_selection, :selection_position, :selection_framples,
+ :smooth_selection, :scale_selection_to, :insert_selection,
+ :delete_selection, :delete_selection_and_smooth,
:mix_selection].each do |n|
if (tag = Snd.catch do snd_func(n) end).first != :no_active_selection
snd_display("selection %s: %s", n, tag)
end
end
- # FIXME
- # Array.new(1): *partials_* functions return :bad_type (odd length partials list?)
- # We can't use arrays here like [:Pixel, ...] or [0, 1].
- [sqrt(-1.0)].each do |arg|
- [:all_pass, :asymmetric_fm, :clear_array, :comb, :filtered_comb, :convolve, :db2linear,
- :moving_average, :degrees2radians, :delay, :env, :formant, :frame2list, :granulate,
- :hz2radians, :linear2db, :make_all_pass, :make_asymmetric_fm, :make_comb, :make_filtered_comb,
- :make_convolve, :make_delay, :make_env, :make_file2frame, :make_file2sample,
- :make_filter, :make_fir_filter, :make_formant, :make_frame, :make_granulate,
- :make_iir_filter, :make_locsig, :make_notch, :make_one_pole, :make_one_zero,
- :make_oscil, :make_pulse_train, :make_rand, :make_rand_interp,
- :make_readin, :make_sawtooth_wave, :make_square_wave,
- :make_src, :make_table_lookup,
- :make_triangle_wave, :make_two_pole, :make_two_zero, :make_wave_train, :make_ssb_am,
- :mus_channel, :mus_channels, :make_polyshape,
- :mus_data, :mus_feedback, :mus_feedforward,
- :mus_frequency, :mus_hop, :mus_increment, :mus_length, :mus_file_name, :mus_location,
- :mus_order, :mus_phase, :mus_ramp, :mus_random, :mus_run, :mus_scaler, :mus_xcoeffs,
- :mus_ycoeffs, :notch, :one_pole, :one_zero, :make_moving_average, :seconds2samples,
- :samples2seconds, :oscil, :partials2polynomial, :partials2wave,
- :phase_partials2wave, :phase_vocoder, :pulse_train, :radians2degrees, :radians2hz,
- :rand, :rand_interp, :readin, :sawtooth_wave, :square_wave, :src,
- :table_lookup, :tap, :triangle_wave, :two_pole,
- :two_zero, :wave_train, :ssb_am].each_with_index do |n, i|
- case (tag = Snd.catch do snd_func(n, arg) end).first
- when :wrong_type_arg, :no_data, :bad_type, :arg_error
+ [:src_selection, :filter_selection, :env_selection].each do |n|
+ if (tag = Snd.catch do snd_func(n, 0.0) end).first != :no_active_selection
+ snd_display("selection %s: %s", n, tag)
+ end
+ end
+ [make_vector(1), $color_95, [1.0]].each do |arg|
+ [:all_pass, :asymmetric_fm, :comb, :filtered_comb,
+ :convolve, :db2linear, :moving_average, :degrees2radians, :delay,
+ :env, :formant, :granulate, :hz2radians, :linear2db,
+ :make_all_pass, :make_asymmetric_fm, :make_comb,
+ :make_filtered_comb, :make_convolve, :make_delay, :make_env,
+ :make_file2frample, :make_file2sample, :make_filter,
+ :make_fir_filter, :make_formant, :make_granulate,
+ :make_iir_filter, :make_locsig, :make_notch, :make_one_pole,
+ :make_one_zero, :make_oscil, :make_pulse_train, :make_rand,
+ :make_rand_interp, :make_readin, :make_sawtooth_wave,
+ :make_square_wave, :make_src, :make_table_lookup,
+ :make_triangle_wave, :make_two_pole, :make_two_zero,
+ :make_wave_train, :make_ssb_am, :mus_channel, :mus_channels,
+ :make_polyshape, :mus_data, :mus_feedback, :mus_feedforward,
+ :mus_frequency, :mus_hop, :mus_increment, :mus_length,
+ :mus_file_name, :mus_location, :mus_order, :mus_phase,
+ :mus_ramp, :mus_random, :mus_run, :mus_scaler, :mus_xcoeffs,
+ :mus_ycoeffs, :notch, :one_pole, :one_zero, :make_moving_average,
+ :seconds2samples, :samples2seconds, :oscil, :partials2polynomial,
+ :partials2wave, :phase_vocoder, :pulse_train,
+ :radians2degrees, :radians2hz, :rand, :rand_interp, :readin,
+ :sawtooth_wave, :square_wave, :src, :table_lookup, :tap,
+ :triangle_wave, :two_pole, :two_zero, :wave_train, :ssb_am].each do |n|
+ tag = Snd.catch do snd_func(n, arg) end
+ case tag.first
+ when :wrong_type_arg, :no_data, :no_such_method,
+ :bad_type, :error, :arg_error
next
else
- snd_display("clm %s: tag %s, arg %s [%s]", n, tag, arg, i)
+ snd_display("clm %s: tag %s, arg %s", n, tag, arg)
end
end
end
- [:all_pass, :array_interp, :asymmetric_fm, :comb, :filtered_comb, :contrast_enhancement,
- :convolution, :convolve, :moving_average, :convolve_files, :delay, :dot_product, :env_interp,
- :file2frame,
- :file2sample, :snd2sample, :filter, :fir_filter, :formant, :firmant, :formant_bank,
- :frame_multiply, :frame_add, :frame2frame, :frame_ref, :frame2sample, :granulate,
- :iir_filter, :ina, :inb, :locsig_ref, :locsig_reverb_ref, :make_all_pass,
- :make_asymmetric_fm, :make_comb, :make_filtered_comb, :make_delay, :make_env, :make_fft_window,
- :make_filter, :make_fir_filter, :make_formant, :make_firmant, :make_frame, :make_granulate,
+ # XXX: phase_partials2wave in clm (test 28)
+ # Original included in test above but Ruby's phase_partials2wave
+ # takes Arrays and Vecs as lists.
+ [make_vector(1), $color_95.to_a + [0], [1.0]].each do |arg|
+ n = :phase_partials2wave
+ tag = Snd.catch do snd_func(n, arg) end
+ case tag.first
+ when :wrong_type_arg, :no_data, :no_such_method,
+ :bad_type, :error, :arg_error
+ next
+ else
+ snd_display("clm %s: tag %s, arg %s", n, tag, arg)
+ end
+ end
+ [:all_pass, :array_interp, :asymmetric_fm, :comb, :filtered_comb,
+ :contrast_enhancement, :convolution, :convolve, :moving_average,
+ :moving_max, :convolve_files, :delay, :dot_product, :env_interp,
+ :file2frample, :file2sample, :snd2sample, :filter, :fir_filter,
+ :formant, :firmant, :formant_bank,
+ :granulate, :iir_filter, :ina, :inb, :locsig_ref,
+ :locsig_reverb_ref, :make_all_pass, :make_asymmetric_fm,
+ :make_comb, :make_filtered_comb, :make_delay, :make_env,
+ :make_fft_window, :make_filter, :make_fir_filter, :make_formant,
+ :make_firmant, :make_granulate,
:make_iir_filter, :make_locsig, :make_notch, :make_one_pole, :make_one_zero,
:make_oscil, :make_phase_vocoder, :make_pulse_train, :make_rand,
:make_rand_interp, :make_readin, :make_sawtooth_wave, :make_moving_average,
- :make_nrxysin, :make_nrxycos,
- :make_square_wave, :make_src, :make_ncos, :make_nsin,
- :make_table_lookup, :make_triangle_wave, :make_two_pole, :make_two_zero,
- :make_wave_train, :mixer_multiply, :mixer_add, :multiply_arrays, :notch, :one_pole, :one_zero,
- :oscil, :partials2polynomial, :partials2wave, :make_polyshape, :make_polywave,
- :phase_partials2wave, :phase_vocoder, :polynomial, :pulse_train, :rand, :rand_interp,
- :rectangular2polar, :rectangular2magnitudes,
- :ring_modulate, :sample2frame, :sawtooth_wave, :nrxysin, :nrxycos,
+ :make_nrxysin, :make_nrxycos, :make_square_wave, :make_src,
+ :make_ncos, :make_nsin, :make_table_lookup, :make_triangle_wave,
+ :make_two_pole, :make_two_zero, :make_wave_train,
+ :notch, :one_pole, :one_zero, :oscil, :partials2polynomial,
+ :partials2wave, :make_polyshape, :make_polywave,
+ :phase_partials2wave, :phase_vocoder, :polynomial, :pulse_train,
+ :rand, :rand_interp, :rectangular2polar, :rectangular2magnitudes,
+ :ring_modulate, :sawtooth_wave, :nrxysin, :nrxycos,
:square_wave, :src, :ncos, :nsin, :table_lookup, :tap, :triangle_wave,
:two_pole, :two_zero, :wave_train, :ssb_am, :make_ssb_am].each do |n|
- case tag = (res = Snd.catch do snd_func(n, make_oscil, $vct_3) end).first
- when :wrong_type_arg, :bad_arity, :mus_error
+ tag = Snd.catch do snd_func(n, make_oscil, $vct_3) end
+ case tag.first
+ when :wrong_type_arg, :bad_arity, :error, :mus_error
next
else
- snd_display("clm 1 %s: %s %s", n, tag, res)
+ snd_display("clm-1 %s: %s", n, tag)
end
end
[:mus_data, :mus_feedback, :mus_feedforward,
:mus_frequency, :mus_hop, :mus_increment, :mus_length, :mus_location,
:mus_phase, :mus_ramp, :mus_scaler].each do |n|
- if (tag = Snd.catch do set_snd_func(n, make_oscil, $vector_0) end).first != :wrong_type_arg
- snd_display("mus_gen %s: %s", n, tag)
- end
- end
- mus_procs = [:mus_sound_samples, :mus_sound_frames, :mus_sound_duration, :mus_sound_datum_size,
- :mus_sound_data_location, :mus_sound_chans, :mus_sound_srate, :mus_sound_header_type,
- :mus_sound_data_format, :mus_sound_length, :mus_sound_type_specifier,
- :mus_header_type_name, :mus_data_format_name, :mus_sound_comment,
- :mus_sound_write_date, :mus_bytes_per_sample, :mus_sound_loop_info,
- :mus_sound_mark_info, :mus_sound_maxamp, :mus_sound_maxamp_exists?,
- :mus_header_type2string, :mus_data_format2string]
+ tag = Snd.catch do set_snd_func(n, make_oscil, $vector_0) end
+ case tag.first
+ when :wrong_type_arg, :error
+ next
+ else
+ snd_display("mus-gen %s: %s", n, tag)
+ end
+ end
+ mus_procs = [
+ :mus_sound_samples, :mus_sound_framples, :mus_sound_duration,
+ :mus_sound_datum_size, :mus_sound_data_location, :mus_sound_chans,
+ :mus_sound_srate, :mus_sound_header_type, :mus_sound_sample_type,
+ :mus_sound_length, :mus_sound_type_specifier,
+ :mus_header_type_name, :mus_sample_type_name, :mus_sound_comment,
+ :mus_sound_write_date, :mus_bytes_per_sample, :mus_sound_loop_info,
+ :mus_sound_mark_info, :mus_sound_maxamp, :mus_sound_maxamp_exists?,
+ :mus_header_type2string, :mus_sample_type2string]
mus_procs.each do |n|
- if (tag = Snd.catch do snd_func(n, $vct_3) end).first != :wrong_type_arg
- snd_display("mus_sound %s: %s", n, tag)
+ tag = Snd.catch do snd_func(n, $vct_3) end
+ if tag.first != :wrong_type_arg
+ snd_display("mus-sound %s: %s", n, tag)
end
end
mus_procs.each do |n|
- if (tag = Snd.catch do snd_func(n) end).first != :wrong_number_of_args
- snd_display("no arg mus_sound %s: %s", n, tag)
+ tag = Snd.catch do snd_func(n) end
+ case tag.first
+ when :wrong_number_of_args, :error
+ next
+ else
+ snd_display("no arg mus-sound %s: %s", n, tag)
end
end
end
def test_28_01
- [:mus_sound_samples, :mus_sound_frames, :mus_sound_duration, :mus_sound_datum_size,
- :mus_sound_data_location, :mus_sound_chans, :mus_sound_srate, :mus_sound_header_type,
- :mus_sound_data_format, :mus_sound_length, :mus_sound_type_specifier,
- :mus_sound_comment, :mus_sound_write_date, :mus_sound_maxamp,
+ [:mus_sound_samples, :mus_sound_framples, :mus_sound_duration,
+ :mus_sound_datum_size, :mus_sound_data_location, :mus_sound_chans,
+ :mus_sound_srate, :mus_sound_header_type, :mus_sound_sample_type,
+ :mus_sound_length, :mus_sound_type_specifier, :mus_sound_comment,
+ :mus_sound_write_date, :mus_sound_maxamp,
:mus_sound_maxamp_exists?].each do |n|
- if (tag = Snd.catch do snd_func(n, "/bad/baddy") end).first != :mus_error
- snd_display("bad file mus_sound %s: %s", n, tag)
+ tag = Snd.catch do snd_func(n, "/bad/baddy") end
+ if tag.first != :mus_error
+ snd_display("bad file mus-sound %s: %s", n, tag)
end
end
mus_sound_forget("/bad/baddy")
- [:channel_widgets, :count_matches, :cursor, :channel_properties, :channel_property,
- :with_tracking_cursor,
+ [:channel_widgets, :cursor, :channel_properties, :channel_property,
:cursor_position, :cursor_size, :cursor_style, :tracking_cursor_style, :delete_sample,
:display_edits, :dot_size, :draw_dots, :draw_lines, :edit_fragment, :edit_list2function,
:edit_position, :edit_tree, :edits, :fft_window_alpha,
:fft_window_beta, :fft_log_frequency, :fft_log_magnitude, :fft_with_phases, :transform_size,
- :transform_graph_type, :fft_window, :transform_graph?, :find_channel, :graph, :graph_style,
+ :transform_graph_type, :fft_window, :transform_graph?, :graph, :graph_style,
:lisp_graph?, :insert_sound, :time_graph_style, :lisp_graph_style,
:transform_graph_style, :left_sample, :make_graph_data, :map_chan, :max_transform_peaks,
:maxamp_position, :min_dB, :mix_region, :transform_normalization,
:peaks, :play, :position2x, :position2y, :reverse_sound,
:revert_sound, :right_sample, :sample, :save_sound, :save_sound_as,
- :scan_chan, :select_channel, :show_axes, :show_transform_peaks, :show_marks,
+ :select_channel, :show_axes, :show_transform_peaks, :show_marks,
:show_mix_waveforms, :show_y_zero, :show_grid, :show_sonogram_cursor, :spectrum_end,
:spectro_hop, :spectrum_start, :spectro_x_angle, :spectro_x_scale, :spectro_y_angle,
:grid_density, :spectro_y_scale, :spectro_z_angle, :spectro_z_scale, :squelch_update,
- :transform_sample, :transform2vct, :transform_frames, :transform_type,
+ :transform_sample, :transform2vct, :transform_framples, :transform_type,
:update_transform_graph, :update_time_graph, :update_lisp_graph, :update_sound,
:wavelet_type, :time_graph?, :time_graph_type, :wavo_hop, :wavo_trace, :x_bounds,
:x_position_slider, :x_zoom_slider, :x_axis_label, :y_axis_label, :y_bounds,
@@ -36594,22 +34781,20 @@ def test_28_01
snd_display("%s: chn (no snd) procs %s: %s", i, n, tag)
end
end
- [:channel_widgets, :count_matches, :cursor, :channel_properties, :channel_property,
- :cursor_position,
- :cursor_size, :cursor_style, :tracking_cursor_style, :delete_sample, :display_edits, :dot_size,
- :draw_dots, :draw_lines, :edit_fragment, :edit_position, :edit_tree, :edits, :fft_window_beta,
- :fft_window_alpha, :fft_with_phases, :fft_log_frequency, :fft_log_magnitude, :transform_size,
- :transform_graph_type, :fft_window, :transform_graph?, :find_channel, :graph, :graph_style,
- :lisp_graph?, :insert_region,
+ [:channel_widgets, :cursor, :channel_properties, :channel_property,
+ :combined_data_color, :cursor_position, :cursor_size, :cursor_style, :tracking_cursor_style,
+ :delete_sample, :display_edits, :dot_size, :draw_dots, :draw_lines, :edit_fragment,
+ :edit_position, :edit_tree, :edits, :fft_window_beta, :fft_window_alpha, :fft_with_phases,
+ :fft_log_frequency, :fft_log_magnitude, :transform_size, :transform_graph_type, :fft_window,
+ :transform_graph?, :graph, :graph_style, :lisp_graph?, :insert_region,
:insert_sound, :left_sample, :time_graph_style, :lisp_graph_style, :transform_graph_style,
:make_graph_data, :map_chan, :max_transform_peaks, :maxamp, :maxamp_position, :min_dB,
- :mix_region, :transform_normalization, :peaks,
- :position2x, :position2y, :reverse_sound, :right_sample, :sample,
- :save_sound_as, :scan_chan, :show_axes, :show_transform_peaks, :show_marks,
- :show_mix_waveforms, :show_y_zero, :show_grid, :show_sonogram_cursor, :spectrum_end,
+ :mix_region, :transform_normalization, :peaks, :position2x, :position2y, :reverse_sound,
+ :right_sample, :sample, :save_sound_as, :show_axes, :show_transform_peaks,
+ :show_marks, :show_mix_waveforms, :show_y_zero, :show_grid, :show_sonogram_cursor, :spectrum_end,
:spectro_hop, :spectrum_start, :spectro_x_angle, :spectro_x_scale, :spectro_y_angle,
:spectro_y_scale, :spectro_z_angle, :spectro_z_scale, :squelch_update, :grid_density,
- :transform_sample, :transform2vct, :transform_frames, :transform_type,
+ :transform_sample, :transform2vct, :transform_framples, :transform_type,
:update_transform_graph, :update_time_graph, :update_lisp_graph, :wavelet_type,
:time_graph?, :time_graph_type, :wavo_hop, :wavo_trace, :x_bounds, :x_position_slider,
:x_zoom_slider, :x_axis_label, :y_axis_label, :y_bounds, :y_position_slider,
@@ -36618,29 +34803,37 @@ def test_28_01
snd_display("%s: chn (no chn) procs %s: %s", i, n, tag)
end
end
- [:channel_widgets, :cursor, :with_tracking_cursor, :channel_properties, :channel_property,
- :cursor_position,
- :cursor_size, :cursor_style, :tracking_cursor_style, :display_edits, :dot_size,
- :edit_position, :edit_tree, :edits, :env_sound, :fft_window_beta,
- :fft_window_alpha, :fft_log_frequency, :fft_with_phases,
- :fft_log_magnitude, :transform_size, :transform_graph_type, :fft_window, :transform_graph?,
- :filter_sound, :graph_data, :graph_style, :lisp_graph?, :left_sample,
- :time_graph_style, :lisp_graph_style, :transform_graph_style, :make_graph_data,
- :max_transform_peaks, :maxamp, :maxamp_position, :min_dB, :transform_normalization,
- :reverse_sound, :revert_sound, :right_sample, :save_sound, :scale_by,
- :scale_to, :show_axes, :show_transform_peaks, :show_marks, :show_mix_waveforms,
- :show_y_zero, :show_grid, :show_sonogram_cursor, :spectrum_end, :spectro_hop,
- :spectrum_start, :spectro_x_angle, :spectro_x_scale, :spectro_y_angle, :spectro_y_scale,
- :spectro_z_angle, :spectro_z_scale, :squelch_update, :grid_density, :src_sound,
- :transform2vct, :transform_frames, :transform_type,
- :update_transform_graph, :update_time_graph, :update_lisp_graph, :update_sound,
- :wavelet_type, :time_graph?, :time_graph_type, :wavo_hop, :wavo_trace, :x_bounds,
- :x_position_slider, :x_zoom_slider, :y_bounds, :y_position_slider, :x_axis_label,
- :y_axis_label, :y_zoom_slider, :zero_pad].each_with_index do |n, i|
- if (tag = Snd.catch do snd_func(n, integer2sound(1234)) end).first != :no_such_sound
+ idx = open_sound("oboe.snd")
+ [:delete_sample, :edit_fragment, :graph_data, :position2x, :position2y, :redo_edit, :scale_by,
+ :scale_to, :undo_edit, :x2position, :y2position].each_with_index do |n, i|
+ tag = Snd.catch do snd_func(n, 0, idx, 1234) end
+ if tag.first != :no_such_channel
+ snd_display("%s: snd(1 1234) chn procs %s: %s", i, n, tag)
+ end
+ end
+ close_sound(idx)
+ idx = open_sound("oboe.snd")
+ [:channel_widgets, :cursor, :cursor_position, :cursor_size, :cursor_style,
+ :tracking_cursor_style, :display_edits, :dot_size, :edit_position, :edit_tree, :edits,
+ :fft_window_alpha, :fft_window_beta, :fft_log_frequency, :fft_log_magnitude, :fft_with_phases,
+ :transform_size, :transform_graph_type, :fft_window, :transform_graph?, :graph_style,
+ :lisp_graph?, :left_sample, :time_graph_style, :lisp_graph_style, :transform_graph_style,
+ :combined_data_color, :make_graph_data, :max_transform_peaks, :maxamp, :maxamp_position,
+ :min_dB, :transform_normalization, :reverse_sound, :right_sample, :show_axes,
+ :show_transform_peaks, :show_marks, :show_mix_waveforms, :show_y_zero, :show_grid,
+ :show_sonogram_cursor, :grid_density, :spectrum_end, :spectro_hop, :spectrum_start,
+ :spectro_x_angle, :spectro_x_scale, :spectro_y_angle, :spectro_y_scale, :spectro_z_angle,
+ :spectro_z_scale, :squelch_update, :transform2vct, :transform_framples, :transform_type,
+ :update_transform_graph, :update_time_graph, :update_lisp_graph, :wavelet_type, :time_graph?,
+ :time_graph_type, :wavo_hop, :wavo_trace, :x_bounds, :x_position_slider, :x_axis_label,
+ :x_zoom_slider, :y_bounds, :y_position_slider, :y_zoom_slider, :zero_pad,
+ :channel_properties, :channel_property].each_with_index do |n, i|
+ tag = Snd.catch do snd_func(n, idx, 1234) end
+ if tag.first != :no_such_sound and tag.first != :no_such_channel
snd_display("%s: chn procs %s: %s", i, n, tag)
end
end
+ close_sound(idx)
[:delete_sample, :edit_fragment, :graph_data, :graph_style,
:position2x, :position2y, :redo_edit, :time_graph_style, :lisp_graph_style,
:transform_graph_style, :scale_by, :scale_to, :undo_edit, :x2position, :y2position,
@@ -36649,13 +34842,7 @@ def test_28_01
snd_display("%s: snd(1) chn procs %s: %s", i, n, tag)
end
end
- index = open_sound("oboe.snd")
- [:delete_sample, :edit_fragment, :graph_data, :position2x, :position2y, :redo_edit,
- :scale_by, :scale_to, :undo_edit, :x2position, :y2position].each_with_index do |n, i|
- if (tag = Snd.catch do snd_func(n, 0, index, 1234) end).first != :no_such_channel
- snd_display("%s: snd(1 1234) chn procs %s: %s", i, n, tag)
- end
- end
+ idx = open_sound("oboe.snd")
[:channel_widgets, :cursor, :cursor_position, :cursor_size, :cursor_style, :tracking_cursor_style,
:display_edits, :dot_size, :edit_position, :edit_tree, :edits, :fft_window_beta,
:fft_window_alpha, :fft_with_phases,
@@ -36667,13 +34854,13 @@ def test_28_01
:show_marks, :show_mix_waveforms, :show_y_zero, :show_grid, :show_sonogram_cursor,
:grid_density, :spectrum_end, :spectro_hop, :spectrum_start, :spectro_x_angle,
:spectro_x_scale, :spectro_y_angle, :spectro_y_scale, :spectro_z_angle,
- :spectro_z_scale, :squelch_update, :transform2vct, :transform_frames,
+ :spectro_z_scale, :squelch_update, :transform2vct, :transform_framples,
:transform_type, :update_transform_graph, :update_time_graph, :update_lisp_graph,
:wavelet_type, :time_graph?, :time_graph_type, :wavo_hop, :wavo_trace,
:x_bounds, :x_position_slider, :x_axis_label, :x_zoom_slider, :y_bounds,
:y_position_slider, :y_zoom_slider, :zero_pad,
:channel_properties, :channel_property].each_with_index do |n, i|
- case (tag = Snd.catch do snd_func(n, index, 1234) end).first
+ case (tag = Snd.catch do snd_func(n, idx, 1234) end).first
when :no_such_sound, :no_such_channel
next
else
@@ -36686,22 +34873,22 @@ def test_28_01
:transform_size, :transform_graph_type, :fft_window, :transform_graph?,
:graph_style, :lisp_graph?, :left_sample, :make_graph_data,
:max_transform_peaks, :maxamp, :maxamp_position, :time_graph_style,
- :lisp_graph_style, :transform_graph_style, :min_dB, :transform_normalization,
- :reverse_sound, :right_sample, :show_axes, :grid_density,
+ :lisp_graph_style, :transform_graph_style, :combined_data_color, :min_dB,
+ :transform_normalization, :reverse_sound, :right_sample, :show_axes, :grid_density,
:show_transform_peaks, :show_marks, :show_mix_waveforms, :show_y_zero,
:show_grid, :show_sonogram_cursor, :spectrum_end, :spectro_hop, :spectrum_start,
:spectro_x_angle, :spectro_x_scale, :spectro_y_angle, :spectro_y_scale,
:spectro_z_angle, :spectro_z_scale, :squelch_update, :transform2vct,
- :transform_frames, :transform_type, :update_transform_graph, :update_time_graph,
+ :transform_framples, :transform_type, :update_transform_graph, :update_time_graph,
:update_lisp_graph, :wavelet_type, :time_graph?, :time_graph_type, :wavo_hop,
:wavo_trace, :x_bounds, :x_position_slider, :x_zoom_slider, :y_bounds,
:y_position_slider, :y_zoom_slider, :zero_pad, :x_axis_label].each_with_index do |n, i|
- tag = Snd.catch do set_snd_func(n, $vct_3, index, 0) end
+ tag = Snd.catch do set_snd_func(n, $vct_3, idx, 0) end
if tag.first != :wrong_type_arg and tag.first != :no_method_error and tag.first != :name_error
snd_display("%s: set chn procs %s: %s", i, n, tag)
end
end
- close_sound(index)
+ close_sound(idx)
[:mix_amp, :mix_amp_env, :mix_length, :mix_name, :mix_position, :mix_home, :mix_speed,
:mix_tag_y].each_with_index do |n, i|
if (tag = Snd.catch do snd_func(n, $vct_3) end).first != :wrong_type_arg
@@ -36748,7 +34935,7 @@ def test_28_01
end
close_sound(index)
[[0, 1], sqrt(-1.0), "hiho", [0, 1]].each do |arg|
- [:region_chans, :region_home, :region_frames, :region_position,
+ [:region_chans, :region_home, :region_framples, :region_position,
:region_maxamp, :region_maxamp_position, :region_sample, :region2vct,
:region_srate, :forget_region].each_with_index do |n, i|
if (tag = Snd.catch do snd_func(n, arg) end).first != :wrong_type_arg
@@ -36756,7 +34943,7 @@ def test_28_01
end
end
end
- [:region_chans, :region_home, :region_frames, :region_position,
+ [:region_chans, :region_home, :region_framples, :region_position,
:region_maxamp, :region_maxamp_position, :region_srate,
:forget_region].each_with_index do |n, i|
if (tag = Snd.catch do snd_func(n, integer2region(1234)) end).first != :no_such_region
@@ -36765,26 +34952,26 @@ def test_28_01
end
[:enved_filter_order, :enved_filter, :filter_control_waveform_color,
:ask_before_overwrite, :auto_resize, :auto_update, :axis_label_font,
- :axis_numbers_font, :basic_color, :show_full_duration, :initial_beg, :initial_dur,
- :channel_style, :color_cutoff, :color_inverted, :color_scale, :cursor_color,
+ :axis_numbers_font, :basic_color, :show_full_duration, :show_full_range, :initial_beg,
+ :initial_dur, :channel_style, :color_cutoff, :color_inverted, :color_scale, :cursor_color,
:dac_combines_channels, :dac_size, :clipping, :data_color,
- :default_output_chans, :default_output_data_format, :default_output_srate,
+ :default_output_chans, :default_output_sample_type, :default_output_srate,
:default_output_header_type, :enved_envelope, :enved_base, :enved_clip?,
:enved_in_dB, :enved_style, :enved_power, :enved_target,
:enved_waveform_color, :enved_wave?, :eps_file, :eps_left_margin,
:eps_bottom_margin, :eps_size, :foreground_color, :graph_color, :graph_cursor,
:highlight_color, :just_sounds, :listener_color, :listener_font,
:listener_prompt, :listener_text_color, :max_regions,
- :minibuffer_history_length, :mix_waveform_height, :region_graph_style,
+ :mix_waveform_height, :region_graph_style,
:position_color, :time_graph_style, :lisp_graph_style, :transform_graph_style,
- :peaks_font, :bold_peaks_font, :view_files_sort, :print_length, :play_arrow_size,
+ :peaks_font, :bold_peaks_font, :print_length, :play_arrow_size,
:sash_color, :ladspa_dir, :peak_env_dir, :save_dir, :save_state_file, :selected_channel,
:selected_data_color, :selected_graph_color, :selected_sound,
:selection_creates_region, :show_controls, :show_indices,
:show_listener, :show_selection_transform, :sinc_width, :temp_dir,
- :text_focus_color, :tiny_font, :trap_segfault, :with_file_monitor,
- :with_verbose_cursor,
- :with_inset_graph, :with_pointer_focus, :window_height, :beats_per_measure, :with_smpte_label,
+ :text_focus_color, :tiny_font, :with_file_monitor,
+ :with_verbose_cursor, :with_inset_graph, :with_interrupts, :with_pointer_focus,
+ :window_height, :beats_per_measure, :with_smpte_label,
:with_toolbar, :with_tooltips, :with_menu_icons, :remember_sound_state,
:save_as_dialog_src, :save_as_dialog_auto_comment, :window_width, :window_x, :window_y, :with_gl,
:with_mix_tags, :x_axis_style, :beats_per_minute, :zoom_color, :mix_tag_height,
@@ -36799,67 +34986,76 @@ def test_28_01
:mix_release_hook, :save_hook, :before_save_as_hook, :after_save_as_hook,
:save_state_hook, :new_sound_hook, :mus_error_hook, :mouse_enter_graph_hook,
:mouse_leave_graph_hook, :open_raw_sound_hook, :select_channel_hook,
- :output_name_hook, :peak_env_hook, :after_open_hook, :close_hook, :draw_mark_hook,
+ :after_open_hook, :close_hook, :draw_mark_hook,
:draw_mix_hook, :mark_click_hook, :listener_click_hook, :mix_click_hook,
- :after_save_state_hook, :before_save_state_hook, :mark_hook, :mark_drag_hook,
- :mix_drag_hook, :name_click_hook, :after_apply_controls_hook,
- :open_hook, :output_comment_hook, :help_hook, :play_hook, :dac_hook,
- :new_widget_hook, :read_hook, :bad_header_hook, :snd_error_hook,
- :snd_warning_hook, :start_hook, :start_playing_hook, :stop_playing_hook,
- :mouse_enter_listener_hook, :mouse_leave_listener_hook,
- :select_sound_hook, :view_files_select_hook,
- :during_open_hook, :after_transform_hook, :mouse_enter_label_hook,
- :mouse_leave_label_hook, :initial_graph_hook, :graph_hook, :key_press_hook,
- :mouse_drag_hook, :mouse_press_hook, :mouse_click_hook, :enved_hook].each_with_index do |n, i|
+ :after_save_state_hook, :before_save_state_hook, :mark_hook,
+ :mark_drag_hook, :mix_drag_hook, :name_click_hook,
+ :after_apply_controls_hook, :open_hook, :output_comment_hook,
+ :help_hook, :play_hook, :new_widget_hook, :read_hook, :bad_header_hook,
+ :snd_error_hook, :snd_warning_hook, :start_playing_hook,
+ :stop_playing_hook, :mouse_enter_listener_hook, :mouse_leave_listener_hook,
+ :select_sound_hook, :during_open_hook, :after_transform_hook,
+ :mouse_enter_label_hook, :mouse_leave_label_hook, :initial_graph_hook,
+ :graph_hook, :key_press_hook, :mouse_drag_hook, :mouse_press_hook,
+ :mouse_click_hook, :enved_hook].each_with_index do |n, i|
hook = eval("$#{n}")
fnc = lambda do || 1 + 2 end
- if (tag = Snd.catch do hook.add_hook!("test28-1", &fnc) end).first != :wrong_type_arg
+ tag = Snd.catch do hook.add_hook!("test28-1", &fnc) end
+ if tag.first != :wrong_type_arg
snd_display("%s: hooks (1) %s: %s", i, n, tag)
end
end
- [:exit_hook, :stop_dac_hook, :stop_playing_selection_hook,
- :color_hook, :orientation_hook, :start_playing_selection_hook].each_with_index do |n, i|
+ [:exit_hook, :stop_playing_selection_hook, :color_hook,
+ :orientation_hook, :start_playing_selection_hook].each_with_index do |n, i|
hook = eval("$#{n}")
fnc = lambda do |a, b, c| a + b + c end
- if (tag = Snd.catch do hook.add_hook!("test28-2", &fnc) end).first != :wrong_type_arg
+ tag = Snd.catch do hook.add_hook!("test28-2", &fnc) end
+ if tag.first != :wrong_type_arg
snd_display("%s: hooks (2) %s: %s", i, n, tag)
end
end
end
def test_28_02
- not_an_env = nil # otherwise name_error: no such variable or function
+ # XXX: 'not_an_env = nil' otherwise name_error: no such variable or function
+ not_an_env = nil
check_error_tag(:no_such_envelope) do set_enved_envelope("not_an_env") end
check_error_tag(:cannot_save) do save_envelopes("/bad/baddy") end
- check_error_tag(:cannot_save) do save_macros("/bad/baddy") end
check_error_tag(:cannot_save) do mus_sound_report_cache("/bad/baddy") end
- check_error_tag(:bad_arity) do set_search_procedure(lambda do |a, b, c| a end) end
- check_error_tag(:no_such_sound) do set_search_procedure(1234, lambda do |a| a end) end
+ check_error_tag(:bad_arity) do
+ set_search_procedure(lambda do |a, b, c| a end)
+ end
check_error_tag(:no_such_channel) do make_sampler(0, "oboe.snd", 1) end
check_error_tag(:no_such_channel) do make_sampler(0, "oboe.snd", -1) end
check_error_tag(:bad_arity) do
bind_key(key_to_int(?p), 0, lambda do |a, b| play_often([1, a].max) end)
end
check_error_tag(:bad_arity) do set_zoom_focus_style(lambda do |a| 0 end) end
- check_error_tag(:wrong_type_arg) do
- mus_mix("oboe.snd", "pistol.snd", 0, 12, 0, make_mixer(1, 1.0), "a string")
- end
- check_error_tag(:bad_header) do mus_mix("oboe.snd", $sf_dir + "bad_chans.aifc") end
- check_error_tag(:mus_error) do mus_mix("oboe.snd", $sf_dir + "bad_length.aifc") end
- check_error_tag(:bad_header) do mus_mix($sf_dir + "bad_chans.aifc", "oboe.snd") end
check_error_tag(:no_such_sound) do set_sound_loop_info(123, [0, 0, 1, 1]) end
check_error_tag(:bad_header) do
- new_sound("fmv.snd", Mus_nist, Mus_bfloat, 22050, 2, "this is a comment")
+ new_sound("fmv.snd", 2, 22050, Mus_bfloat, Mus_nist, "this is a comment")
end
check_error_tag(:wrong_type_arg) do player_home(123) end
check_error_tag(:no_such_file) do set_temp_dir("/hiho") end
check_error_tag(:no_such_file) do set_save_dir("/hiho") end
- check_error_tag(:out_of_range) do snd_transform(integer2transform(20), make_vct(4)) end
- check_error_tag(:bad_header) do mus_sound_maxamp($sf_dir + "bad_chans.snd") end
- check_error_tag(:bad_header) do set_mus_sound_maxamp($sf_dir + "bad_chans.snd", [0.0, 0.0]) end
- check_error_tag(:mus_error) do make_iir_filter(:order, 32, :ycoeffs, make_vct(4)) end
- check_error_tag(:mus_error) do make_iir_filter(:coeffs, make_vct(4), :ycoeffs, make_vct(4)) end
- check_error_tag(:mus_error) do make_iir_filter(:coeffs, make_vct(4), :xcoeffs, make_vct(4)) end
+ check_error_tag(:out_of_range) do
+ snd_transform(integer2transform(20), make_vct(4))
+ end
+ check_error_tag(:bad_header) do
+ mus_sound_maxamp($sf_dir + "bad_chans.snd")
+ end
+ check_error_tag(:bad_header) do
+ set_mus_sound_maxamp($sf_dir + "bad_chans.snd", [0.0, 0.0])
+ end
+ check_error_tag(:mus_error) do
+ make_iir_filter(:order, 32, :ycoeffs, make_vct(4))
+ end
+ check_error_tag(:mus_error) do
+ make_iir_filter(:coeffs, make_vct(4), :ycoeffs, make_vct(4))
+ end
+ check_error_tag(:mus_error) do
+ make_iir_filter(:coeffs, make_vct(4), :xcoeffs, make_vct(4))
+ end
check_error_tag(:out_of_range) do make_table_lookup(:size, 123456789) end
check_error_tag(:out_of_range) do make_granulate(:ramp, -0.5) end
check_error_tag(:out_of_range) do make_granulate(:ramp, 1.5) end
@@ -36871,35 +35067,41 @@ def test_28_02
check_error_tag(:out_of_range) do make_readin("oboe.snd", :size, -1) end
check_error_tag(:out_of_range) do make_file2sample("oboe.snd", 0) end
check_error_tag(:out_of_range) do make_file2sample("oboe.snd", -1) end
- check_error_tag(:out_of_range) do make_file2frame("oboe.snd", 0) end
- check_error_tag(:out_of_range) do make_file2frame("oboe.snd", -1) end
- check_error_tag(:out_of_range) do set_default_output_data_format(-1) end
- check_error_tag(:out_of_range) do set_default_output_header_type(Mus_soundfont) end
- check_error_tag(:mus_error) do mus_sound_chans($sf_dir + "bad_location.nist") end
+ check_error_tag(:out_of_range) do make_file2frample("oboe.snd", 0) end
+ check_error_tag(:out_of_range) do make_file2frample("oboe.snd", -1) end
+ check_error_tag(:out_of_range) do set_default_output_sample_type(-1) end
+ check_error_tag(:out_of_range) do
+ set_default_output_header_type(Mus_soundfont)
+ end
+ check_error_tag(:mus_error) do
+ mus_sound_chans($sf_dir + "bad_location.nist")
+ end
check_error_tag(:mus_error) do mus_sound_chans($sf_dir + "bad_field.nist") end
if $with_test_motif
check_error_tag(:no_such_widget) do widget_position([:Widget, 0]) end
check_error_tag(:no_such_widget) do widget_size([:Widget, 0]) end
check_error_tag(:no_such_widget) do widget_text([:Widget, 0]) end
- check_error_tag(:no_such_widget) do set_widget_position([:Widget, 0], [0, 0]) end
- check_error_tag(:no_such_widget) do set_widget_size([:Widget, 0], [10, 10]) end
- check_error_tag(:no_such_widget) do set_widget_text([:Widget, 0], "hiho") end
+ check_error_tag(:no_such_widget) do
+ set_widget_position([:Widget, 0], [0, 0])
+ end
+ check_error_tag(:no_such_widget) do
+ set_widget_size([:Widget, 0], [10, 10])
+ end
+ check_error_tag(:no_such_widget) do
+ set_widget_text([:Widget, 0], "hiho")
+ end
end
check_error_tag(:no_such_menu) do main_menu(-1) end
check_error_tag(:no_such_menu) do main_menu(111) end
- check_error_tag(:out_of_range) do new_sound("hiho", 123) end
- check_error_tag(:out_of_range) do new_sound("hiho", Mus_nist, 123) end
- check_error_tag(:bad_header) do new_sound("hiho", Mus_nist, Mus_bfloat) end
- check_error_tag(:out_of_range) do make_sound_data(0, 1) end
- check_error_tag(:out_of_range) do make_sound_data(-2, 1) end
- check_error_tag(:out_of_range) do make_sound_data(1, -1) end
- check_error_tag(:out_of_range) do make_sound_data(1, 0) end
- check_error_tag(:out_of_range) do mus_sound_close_output(0, 1) end
- check_error_tag(:out_of_range) do mus_sound_close_output(1, 1) end
- check_error_tag(:out_of_range) do mus_sound_close_output(2, 1) end
- check_error_tag(:out_of_range) do mus_sound_close_input(0) end
- check_error_tag(:out_of_range) do mus_sound_close_input(1) end
- check_error_tag(:out_of_range) do mus_sound_close_input(2) end
+ check_error_tag(:out_of_range) do
+ new_sound("hiho", :header_type, 123)
+ end
+ check_error_tag(:out_of_range) do
+ new_sound("hiho", :header_type, Mus_nist, :sample_type, 123)
+ end
+ check_error_tag(:bad_header) do
+ new_sound("hiho", :header_type, Mus_nist, :sample_type, Mus_bfloat)
+ end
check_error_tag(:out_of_range) do set_mus_array_print_length(-1) end
check_error_tag(:out_of_range) do set_print_length(-1) end
check_error_tag(:out_of_range) do set_play_arrow_size(-1) end
@@ -36914,21 +35116,21 @@ def test_28_02
select_all
check_error_tag(:mus_error) do save_selection("sel0.snd", :not_a_key, 3) end
check_error_tag(:wrong_type_arg) do read_only([ind]) end
- check_error_tag(:wrong_type_arg) do frames(ind, [0]) end
+ check_error_tag(:wrong_type_arg) do framples(ind, [0]) end
check_error_tag(:wrong_type_arg) do smooth_sound(0, -10) end
check_error_tag(:no_such_channel) do mix_selection(0, ind, 123) end
check_error_tag(:no_such_channel) do insert_selection(0, ind, 123) end
check_error_tag(:out_of_range) do set_channels(ind, 0) end
- check_error_tag(:out_of_range) do set_channels(ind, -1) end
+ check_error_tag(:wrong_type_arg) do set_channels(ind, -1) end
check_error_tag(:out_of_range) do set_channels(ind, 12340) end
- check_error_tag(:out_of_range) do set_data_format(ind, 12340) end
+ check_error_tag(:out_of_range) do set_sample_type(ind, 12340) end
check_error_tag(:out_of_range) do set_header_type(ind, 12340) end
check_error_tag(:out_of_range) do set_srate(ind, 0) end
- check_error_tag(:out_of_range) do set_data_location(ind, -1) end
- check_error_tag(:out_of_range) do set_data_size(ind, -1) end
+ check_error_tag(:wrong_type_arg) do set_data_location(ind, -1) end
+ check_error_tag(:wrong_type_arg) do set_data_size(ind, -1) end
check_error_tag(:no_such_sample) do set_sample(-1, -1) end
check_error_tag(:no_such_sample) do sample(-1) end
- check_error_tag(:out_of_range) do set_frames(-10) end
+ check_error_tag(:out_of_range) do set_framples(-10) end
check_error_tag(:out_of_range) do set_min_dB(0.0) end
check_error_tag(:out_of_range) do set_min_dB(0.0, ind, 0) end
check_error_tag(:out_of_range) do start_playing(1, -22) end
@@ -36939,7 +35141,9 @@ def test_28_02
check_error_tag(:out_of_range) do
set_filter_control_envelope([0.0, 1.0, 0.1, 1.1, 1.0, 0.0], ind)
end
- check_error_tag(:env_error) do filter_sound([0, 0, 0.1, 0.1, 0.05, 0.1, 1, 1], 32) end
+ check_error_tag(:env_error) do
+ filter_sound([0, 0, 0.1, 0.1, 0.05, 0.1, 1, 1], 32)
+ end
check_error_tag(:out_of_range) do apply_controls(ind, 123) end
check_error_tag(:out_of_range) do set_speed_control_bounds([0.0, 2.0]) end
check_error_tag(:out_of_range) do set_expand_control_bounds([0.0, 2.0]) end
@@ -36947,33 +35151,72 @@ def test_28_02
check_error_tag(:out_of_range) do set_expand_control_bounds([2.0, 0.0]) end
check_error_tag(:bad_header) do insert_sound($sf_dir + "bad_chans.snd") end
check_error_tag(:io_error) do convolve_with($sf_dir + "bad_chans.snd") end
- check_error_tag(:cannot_save) do save_sound_as("hiho.snd", ind, -12) end
- check_error_tag(:cannot_save) do save_sound_as("hiho.snd", ind, Mus_next, -12) end
- check_error_tag(:cannot_save) do save_sound_as("test.snd", ind, Mus_nist, Mus_bdouble) end
- check_error_tag(:cannot_save) do save_sound_as("test.snd", ind, Mus_aifc, Mus_lfloat) end
- check_error_tag(:cannot_save) do save_sound_as("test.snd", ind, Mus_riff, Mus_bshort) end
- check_error_tag(:cannot_save) do save_sound_as("test.snd", ind, Mus_voc, Mus_bshort) end
- check_error_tag(:cannot_save) do save_selection("test.snd", Mus_riff, Mus_bshort) end
- check_error_tag(:cannot_save) do save_selection("test.snd", Mus_voc, Mus_bshort) end
- check_error_tag(:no_data) do draw_lines([]) end
- check_error_tag(:bad_length) do draw_lines([1, 2, 3]) end
- check_error_tag(:out_of_range) do src_channel(make_env([0, 0, 1, 1], :length, 11)) end
- check_error_tag(:out_of_range) do src_channel(make_env([0, 1, 1, 0], :length, 11)) end
- check_error_tag(:out_of_range) do src_channel(make_env([0, 1, 1, -1], :length, 11)) end
- check_error_tag(:out_of_range) do src_channel(make_env([0, -1, 1, 1], :length, 11)) end
- check_error_tag(:out_of_range) do src_sound(make_env([0, 0, 1, 1], :length, 11)) end
- check_error_tag(:out_of_range) do src_sound(make_env([0, 1, 1, 0], :length, 11)) end
- check_error_tag(:out_of_range) do src_sound(make_env([0, 1, 1, -1], :length, 11)) end
- check_error_tag(:out_of_range) do src_sound(make_env([0, -1, 1, 1], :length, 11)) end
- check_error_tag(:mus_error) do make_readin(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0) end
+ check_error_tag(:cannot_save) do
+ save_sound_as("hiho.snd", ind, -12)
+ end
+ check_error_tag(:cannot_save) do
+ save_sound_as("hiho.snd", ind,
+ :header_type, Mus_next, :sample_type, -12)
+ end
+ check_error_tag(:cannot_save) do
+ save_sound_as("test.snd", ind,
+ :header_type, Mus_nist, :sample_type, Mus_bdouble)
+ end
+ check_error_tag(:cannot_save) do
+ save_sound_as("test.snd", ind,
+ :header_type, Mus_aifc, :sample_type, Mus_lfloat)
+ end
+ check_error_tag(:cannot_save) do
+ save_sound_as("test.snd", ind,
+ :header_type, Mus_riff, :sample_type, Mus_bshort)
+ end
+ check_error_tag(:cannot_save) do
+ save_sound_as("test.snd", ind,
+ :header_type, Mus_voc, :sample_type, Mus_bshort)
+ end
+ check_error_tag(:cannot_save) do
+ save_selection("test.snd", 22050, Mus_bshort, Mus_riff)
+ end
+ check_error_tag(:cannot_save) do
+ save_selection("test.snd", 22050, Mus_bshort, Mus_voc)
+ end
+ check_error_tag(:out_of_range) do
+ src_channel(make_env([0, 0, 1, 1], :length, 11))
+ end
+ check_error_tag(:out_of_range) do
+ src_channel(make_env([0, 1, 1, 0], :length, 11))
+ end
+ check_error_tag(:out_of_range) do
+ src_channel(make_env([0, 1, 1, -1], :length, 11))
+ end
+ check_error_tag(:out_of_range) do
+ src_channel(make_env([0, -1, 1, 1], :length, 11))
+ end
+ check_error_tag(:out_of_range) do
+ src_sound(make_env([0, 0, 1, 1], :length, 11))
+ end
+ check_error_tag(:out_of_range) do
+ src_sound(make_env([0, 1, 1, 0], :length, 11))
+ end
+ check_error_tag(:out_of_range) do
+ src_sound(make_env([0, 1, 1, -1], :length, 11))
+ end
+ check_error_tag(:out_of_range) do
+ src_sound(make_env([0, -1, 1, 1], :length, 11))
+ end
+ check_error_tag(:mus_error) do
+ make_readin(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)
+ end
check_error_tag(:out_of_range) do filter_sound($vct_3, 32) end
check_error_tag(:out_of_range) do filter_sound([0, 0, 1, 1], 0) end
check_error_tag(:no_such_sound) do swap_channels(ind, 0, 12345, 0) end
- check_error_tag(:no_such_sample) do mix_vct(vct(0.1, 0.2, 0.3), -1, ind, 0, true) end
+ check_error_tag(:no_such_sample) do
+ mix_vct(vct(0.1, 0.2, 0.3), -1, ind, 0, true)
+ end
check_error_tag(:out_of_range) do snd_spectrum(Vct.new(8), 0, -123) end
check_error_tag(:out_of_range) do snd_spectrum(Vct.new(8), 0, 0) end
check_error_tag(:no_such_file) do play("/baddy/hiho") end
- check_error_tag(:bad_format) do play($sf_dir + "nist-shortpack.wav") end
+ check_error_tag(:bad_sample_type) do play($sf_dir + "nist-shortpack.wav") end
check_error_tag(:no_such_sound) do play(123, 0) end
check_error_tag(:no_such_channel) do make_player(ind, 123) end
check_error_tag(:no_such_file) do mix("/baddy/hiho") end
@@ -36982,17 +35225,23 @@ def test_28_02
check_error_tag(:no_such_file) do insert_sound("/baddy/hiho.snd") end
check_error_tag(:no_such_file) do insert_samples(0, 10, "/baddy/hiho.snd") end
check_error_tag(:no_data) do set_filter_control_envelope([], ind) end
- check_error_tag(:out_of_range) do set_data_format(ind, 123) end
+ check_error_tag(:out_of_range) do set_sample_type(ind, 123) end
check_error_tag(:out_of_range) do set_header_type(ind, 123) end
check_error_tag(:no_such_channel) do set_selected_channel(ind, 123) end
- check_error_tag(:bad_arity) do set_search_procedure(ind, lambda do |a, b, c| true end) end
+ check_error_tag(:bad_arity) do
+ set_search_procedure(lambda do |a, b, c| true end)
+ end
check_error_tag(:bad_arity) do map_chan(lambda do |a, b, c| 1.0 end) end
- check_error_tag(:bad_arity) do scan_chan(lambda do |a, b, c| 1.0 end) end
- check_error_tag(:bad_arity) do set_cursor_style(lambda do |a| 32 end, ind, 0) end
- check_error_tag(:bad_arity) do find_channel(lambda do | | 1.0 end) end
- check_error_tag(:bad_arity) do count_matches(lambda do | | 1.0 end) end
- check_error_tag(:no_such_graphics_context) do draw_line(0, 0, 1, 1, ind, 0, 1234) end
- check_error_tag(:no_such_graphics_context) do foreground_color(ind, 0, 1234) end
+ check_error_tag(:bad_arity) do scan_channel(lambda do |a, b, c| 1.0 end) end
+ check_error_tag(:bad_arity) do
+ set_cursor_style(lambda do |a| 32 end, ind, 0)
+ end
+ check_error_tag(:no_such_graphics_context) do
+ draw_line(0, 0, 1, 1, ind, 0, 1234)
+ end
+ check_error_tag(:no_such_graphics_context) do
+ foreground_color(ind, 0, 1234)
+ end
check_error_tag(:no_such_graphics_context) do current_font(ind, 0, 1234) end
check_error_tag(:no_such_graphics_context) do
graph_data([$vct_3, $vct_3], ind, 0, 1234, 0, 1, 0)
@@ -37003,10 +35252,12 @@ def test_28_02
check_error_tag(:no_such_axis) do y2position(100, ind, 0, 1234) end
check_error_tag(:no_such_axis) do axis_info(ind, 0, 1234) end
check_error_tag(:out_of_range) do
- draw_axes(channel_widgets.car, snd_gcs.car, "hiho", 0.0, 1.0, -1.0, 1.0, X_axis_in_seconds,1234)
+ draw_axes(channel_widgets.car, snd_gcs.car, "hiho",
+ 0.0, 1.0, -1.0, 1.0, X_axis_in_seconds,1234)
end
check_error_tag(:out_of_range) do
- draw_axes(channel_widgets.car, snd_gcs.car, "hiho", 0.0, 1.0, -1.0, 1.0, 1234)
+ draw_axes(channel_widgets.car, snd_gcs.car, "hiho",
+ 0.0, 1.0, -1.0, 1.0, 1234)
end
check_error_tag(:no_such_channel) do axis_info(ind, 1234) end
check_error_tag(:no_such_sound) do axis_info(1234) end
@@ -37014,25 +35265,35 @@ def test_28_02
check_error_tag(:out_of_range) do set_x_bounds([0.1, -0.1]) end
check_error_tag(:out_of_range) do make_region(100, 0) end
check_error_tag(:no_such_sample) do delete_sample(-1) end
- check_error_tag(:no_such_sample) do delete_sample(2 * frames(ind)) end
+ check_error_tag(:no_such_sample) do delete_sample(2 * framples(ind)) end
regions.empty? and make_region(0, 100)
check_error_tag(:no_such_channel) do region_sample(regions.car, 0, 1234) end
- check_error_tag(:no_such_channel) do region_frames(regions.car, 1234) end
+ check_error_tag(:no_such_channel) do region_framples(regions.car, 1234) end
check_error_tag(:no_such_channel) do region_position(regions.car, 1234) end
check_error_tag(:no_such_channel) do region2vct(regions.car, 0, 1, 1234) end
check_error_tag(:cannot_save) do save_sound_as("/bad/baddy.snd") end
check_error_tag(:no_such_sound) do transform_sample(0, 1, 1234) end
check_error_tag(:no_such_channel) do transform_sample(0, 1, ind, 1234) end
- check_error_tag(:no_such_sound) do graph(vct(0, 1), "hi", 0, 1, 0, 1, 1234) end
- check_error_tag(:no_such_channel) do graph(vct(0, 1), "hi", 0, 1, 0, 1, ind, 1234) end
+ check_error_tag(:no_such_sound) do
+ graph(vct(0, 1), "hi", 0, 1, 0, 1, 1234)
+ end
+ check_error_tag(:no_such_channel) do
+ graph(vct(0, 1), "hi", 0, 1, 0, 1, ind, 1234)
+ end
set_selection_member?(false, true)
- check_error_tag(:no_active_selection) do filter_selection(vct(0, 0, 1, 1), 4) end
+ check_error_tag(:no_active_selection) do
+ filter_selection(vct(0, 0, 1, 1), 4)
+ end
check_error_tag(:no_active_selection) do save_selection("/bad/baddy.snd") end
check_error_tag(:no_active_selection) do env_selection([0, 0, 1, 1]) end
- check_error_tag(:no_such_region) do save_region(integer2region(1234), "/bad/baddy.snd") end
+ check_error_tag(:no_such_region) do
+ save_region(integer2region(1234), "/bad/baddy.snd")
+ end
make_region(0, 100, ind, 0)
check_error_tag(:cannot_save) do save_selection("/bad/baddy.snd") end
- check_error_tag(:cannot_save) do save_region(regions.car, "/bad/baddy.snd") end
+ check_error_tag(:cannot_save) do
+ save_region(regions.car, "/bad/baddy.snd")
+ end
check_error_tag(:no_such_mix) do make_mix_sampler(integer2mix(1234)) end
check_error_tag(:no_such_sound) do make_region(0, 12, 1234, true) end
set_read_only(true, ind)
@@ -37042,16 +35303,15 @@ def test_28_02
check_error_tag(:no_such_direction) do make_sampler(0, ind, 0, -2) end
check_error_tag(:no_data) do scale_by([]) end
check_error_tag(:no_data) do scale_to([]) end
- check_error_tag(:bad_arity) do prompt_in_minibuffer("hi", lambda do |x, y| x + y end) end
check_error_tag(:no_such_sample) do set_selection_position(-999, ind, 0) end
- check_error_tag(:wrong_type_arg) do set_selection_frames(-999, ind, 0) end
- check_error_tag(:wrong_type_arg) do set_selection_frames(0, ind, 0) end
+ check_error_tag(:wrong_type_arg) do set_selection_framples(-999, ind, 0) end
+ check_error_tag(:wrong_type_arg) do set_selection_framples(0, ind, 0) end
check_error_tag(:no_such_edit) do edit_fragment(-1) end
check_error_tag(:no_such_edit) do edit_fragment(101, ind, 0) end
check_error_tag(:no_such_edit) do edit_tree(ind, 0, -2) end
check_error_tag(:no_such_edit) do edit_tree(ind, 0, 101) end
check_error_tag(:no_such_sample) do add_mark(-1) end
- check_error_tag(:no_such_sample) do add_mark(frames * 2) end
+ check_error_tag(:no_such_sample) do add_mark(framples * 2) end
check_error_tag(:no_such_file) do convolve_with("/bad/baddy") end
check_error_tag(:no_such_file) do mix("/bad/baddy") end
check_error_tag(:no_such_sound) do swap_channels(ind, 0, 123) end
@@ -37068,37 +35328,66 @@ def test_28_02
check_error_tag(:wrong_type_arg) do amp_control([0]) end
check_error_tag(:wrong_type_arg) do sound_loop_info([0]) end
check_error_tag(:wrong_type_arg) do add_mark(123, [0]) end
- check_error_tag(:no_such_sound) do filter_channel([0, 0, 1, 1], 100, false, false, 1234, 0) end
- check_error_tag(:no_such_channel) do filter_channel([0, 0, 1, 1], 100, false, false, ind, 1) end
- check_error_tag(:no_such_channel) do filter_channel(vct(0, 0, 1, 1), 4, false, false, ind, 1) end
+ check_error_tag(:no_such_sound) do
+ filter_channel([0, 0, 1, 1], 100, false, false, 1234, 0)
+ end
+ check_error_tag(:no_such_channel) do
+ filter_channel([0, 0, 1, 1], 100, false, false, ind, 1)
+ end
+ check_error_tag(:no_such_channel) do
+ filter_channel(vct(0, 0, 1, 1), 4, false, false, ind, 1)
+ end
check_error_tag(:out_of_range) do filter_sound(vct(0, 0, 1, 1), 0) end
check_error_tag(:out_of_range) do filter_sound(vct(0, 0, 1, 1), 10) end
- check_error_tag(:out_of_range) do set_reverb_control_length_bounds([0.1, 0.01], ind) end
- check_error_tag(:out_of_range) do set_reverb_control_scale_bounds([0.1, 0.01], ind) end
+ check_error_tag(:out_of_range) do
+ set_reverb_control_length_bounds([0.1, 0.01], ind)
+ end
+ check_error_tag(:out_of_range) do
+ set_reverb_control_scale_bounds([0.1, 0.01], ind)
+ end
check_error_tag(:wrong_type_arg) do scale_by(false) end
- check_error_tag(:wrong_type_arg) do scale_by(make_mixer(2, 0.1, 0.1, 0.2, 0.2)) end
check_error_tag(:wrong_type_arg) do src_sound(3.0, 1.0, true) end
check_error_tag(:wrong_type_arg) do src_sound(3.0, 1.0, ind, true) end
check_error_tag(:no_such_edit) do display_edits(ind, 0, 123) end
check_error_tag(:no_such_edit) do marks(ind, 0, 123) end
- check_error_tag(:no_such_edit) do save_sound_as("test.snd", :edit_position, 123) end
- check_error_tag(:no_such_auto_delete_choice) do insert_sound("1a.snd", 0, 0, ind, 0, 0, 123) end
+ check_error_tag(:no_such_edit) do
+ save_sound_as("test.snd", :edit_position, 123)
+ end
+ check_error_tag(:no_such_auto_delete_choice) do
+ insert_sound("1a.snd", 0, 0, ind, 0, 0, 123)
+ end
close_sound(ind)
- check_error_tag(:bad_arity) do add_transform("hiho", "time", 0, 1, lambda do | | 1.0 end) end
+ check_error_tag(:bad_arity) do
+ add_transform("hiho", "time", 0, 1, lambda do | | 1.0 end)
+ end
check_error_tag(:cannot_save) do save_state("/bad/baddy") end
- check_error_tag(:no_such_menu) do add_to_menu(1234, "hi", lambda do | | false end) end
- check_error_tag(:bad_arity) do add_to_main_menu("hi", lambda do |a, b| false end) end
- check_error_tag(:bad_arity) do add_to_menu(1, "hi", lambda do |a, b| false end) end
- check_error_tag(:wrong_type_arg) do set_transform_type(integer2transform(-1)) end
- check_error_tag(:out_of_range) do set_transform_type(integer2transform(123)) end
+ check_error_tag(:no_such_menu) do
+ add_to_menu(1234, "hi", lambda do | | false end)
+ end
+ check_error_tag(:bad_arity) do
+ add_to_main_menu("hi", lambda do |a, b| false end)
+ end
+ check_error_tag(:bad_arity) do
+ add_to_menu(1, "hi", lambda do |a, b| false end)
+ end
+ check_error_tag(:wrong_type_arg) do
+ set_transform_type(integer2transform(-1))
+ end
+ check_error_tag(:out_of_range) do
+ set_transform_type(integer2transform(123))
+ end
check_error_tag(:wrong_type_arg) do help_dialog([0, 1], "hiho") end
check_error_tag(:wrong_type_arg) do info_dialog([0, 1], "hiho") end
check_error_tag(:no_such_sound) do edit_header_dialog(1234) end
check_error_tag(:no_such_file) do open_sound("/bad/baddy.snd") end
- check_error_tag(:no_such_file) do open_raw_sound("/bad/baddy.snd", 1, 22050, Mus_lshort) end
+ check_error_tag(:no_such_file) do
+ open_raw_sound("/bad/baddy.snd", 1, 22050, Mus_lshort)
+ end
check_error_tag(:no_such_file) do view_sound("/bad/baddy.snd") end
check_error_tag(:no_such_file) do make_sampler(0, "/bad/baddy.snd") end
- check_error_tag(:no_such_region) do make_region_sampler(integer2region(1234567), 0) end
+ check_error_tag(:no_such_region) do
+ make_region_sampler(integer2region(1234567), 0)
+ end
check_error_tag(:no_such_key) do bind_key(12345678, 0, false) end
check_error_tag(:no_such_key) do bind_key(-1, 0, false) end
check_error_tag(:no_such_key) do bind_key(12, 17, false) end
@@ -37107,27 +35396,38 @@ def test_28_02
check_error_tag(:no_such_key) do key_binding(-1, 0) end
check_error_tag(:no_such_key) do key_binding(12, 17) end
check_error_tag(:no_such_key) do key_binding(12, -1) end
- check_error_tag(:bad_header) do file2array($sf_dir + "bad_chans.snd", 0, 0, 123, Vct.new(123)) end
+ check_error_tag(:bad_header) do
+ file2array($sf_dir + "bad_chans.snd", 0, 0, 123, Vct.new(123))
+ end
check_error_tag(:bad_header) do make_readin($sf_dir + "bad_chans.snd") end
check_error_tag(:mus_error) do make_iir_filter(30, Vct.new(3)) end
check_error_tag(:out_of_range) do make_wave_train(:size, 2 ** 30) end
check_error_tag(:out_of_range) do set_mus_srate(0.0) end
check_error_tag(:out_of_range) do set_mus_srate(-1000) end
check_error_tag(:out_of_range) do dot_product(Vct.new(3), Vct.new(3), -1) end
- check_error_tag(:out_of_range) do multiply_arrays(Vct.new(3), Vct.new(3), -1) end
check_error_tag(:out_of_range) do
make_delay(3, :initial_element, 0.0, :initial_contents, vct(0.1, 0.2, 0.3))
end
check_error_tag(:out_of_range) do
make_delay(3, :max_size, 100, :initial_contents, vct(0.1, 0.2, 0.3))
end
- check_error_tag(:out_of_range) do make_table_lookup(:size, 100, :wave, Vct.new(3)) end
- check_error_tag(:out_of_range) do make_wave_train(:size, 100, :wave, Vct.new(3)) end
+ check_error_tag(:out_of_range) do
+ make_table_lookup(:size, 100, :wave, Vct.new(3))
+ end
+ check_error_tag(:out_of_range) do
+ make_wave_train(:size, 100, :wave, Vct.new(3))
+ end
check_error_tag(:out_of_range) do make_ssb_am(100, 12345678) end
- check_error_tag(:mus_error) do make_rand(:envelope, [0, 0, 1, 1], :distribution, Vct.new(10)) end
+ check_error_tag(:mus_error) do
+ make_rand(:envelope, [0, 0, 1, 1], :distribution, Vct.new(10))
+ end
check_error_tag(:mus_error) do make_rand(:envelope, [0, 0, 1]) end
- check_error_tag(:out_of_range) do make_rand(:envelope, [0, 0, 1, 1], :size, -2) end
- check_error_tag(:out_of_range) do make_rand(:envelope, [0, 0, 1, 1], :size, 1234567890) end
+ check_error_tag(:out_of_range) do
+ make_rand(:envelope, [0, 0, 1, 1], :size, -2)
+ end
+ check_error_tag(:out_of_range) do
+ make_rand(:envelope, [0, 0, 1, 1], :size, 1234567890)
+ end
check_error_tag(:bad_arity) do
grn = make_granulate
granulate(grn, false, lambda do |a, s, d| false end)
@@ -37160,35 +35460,37 @@ def test_28_02
f = make_filter(3, :xcoeffs, $vct_3, :ycoeffs, $vct_3)
set_mus_ycoeff(f, 4, 1.0)
end
- check_error_tag(:mus_error) do make_filter(:ycoeffs, Vct.new(4), :order, 12) end
+ check_error_tag(:mus_error) do
+ make_filter(:ycoeffs, Vct.new(4), :order, 12)
+ end
check_error_tag(:mus_error) do
hi = make_oscil
set_mus_offset(hi, 1)
end
check_error_tag(:out_of_range) do make_locsig(:channels, 2 ** 30) end
check_error_tag(:out_of_range) do make_src(:width, 3000) end
- check_error_tag(:out_of_range) do make_frame(-1) end
- check_error_tag(:mus_error) do
- hi = make_frame(2, 0.1, 0.2)
- frame_ref(hi, 3)
+ check_error_tag(:bad_arity) do
+ add_colormap("baddy", lambda do | | false end)
end
- check_error_tag(:out_of_range) do make_scalar_mixer(0, 0.1) end
- check_error_tag(:mus_error) do
- m = make_mixer(2)
- mixer_ref(m, 3, 4)
+ check_error_tag(:bad_arity) do
+ add_colormap("baddy", lambda do |a, b, c| false end)
end
- check_error_tag(:bad_arity) do add_colormap("baddy", lambda do | | false end) end
- check_error_tag(:bad_arity) do add_colormap("baddy", lambda do |a, b, c| false end) end
check_error_tag(:out_of_range) do
sr = make_src(:input, lambda do |dir| 1.0 end)
src(sr, 2000000.0)
end
check_error_tag(:out_of_range) do partials2polynomial([1, 1], -1) end
check_error_tag(:out_of_range) do partials2polynomial([1, 1], 3) end
- check_error_tag(:out_of_range) do make_polyshape(440.0, :partials, [1, 1], :kind, -1) end
- check_error_tag(:out_of_range) do make_polyshape(440.0, :partials, [1, 1], :kind, 3) end
+ check_error_tag(:out_of_range) do
+ make_polyshape(440.0, :partials, [1, 1], :kind, -1)
+ end
+ check_error_tag(:out_of_range) do
+ make_polyshape(440.0, :partials, [1, 1], :kind, 3)
+ end
check_error_tag(:wrong_type_arg) do set_mus_header_raw_defaults(1234) end
- check_error_tag(:wrong_type_arg) do set_mus_header_raw_defaults([44100, 2.123, "hi"]) end
+ check_error_tag(:wrong_type_arg) do
+ set_mus_header_raw_defaults([44100, 2.123, "hi"])
+ end
check_error_tag(:wrong_type_arg) do set_with_toolbar(123) end
check_error_tag(:wrong_type_arg) do set_with_tooltips(123) end
check_error_tag(:wrong_type_arg) do set_with_menu_icons(123) end
@@ -37196,13 +35498,18 @@ def test_28_02
check_error_tag(:wrong_type_arg) do set_save_as_dialog_auto_comment(123) end
check_error_tag(:wrong_type_arg) do set_with_smpte_label(123) end
check_error_tag(:wrong_type_arg) do set_ask_about_unsaved_edits(123) end
- check_error_tag(:no_such_mix) do mix_properties(integer2mix(mix_sync_max + 1)) end
- check_error_tag(:no_such_mix) do set_mix_properties(integer2mix(mix_sync_max + 1), 1) end
+ check_error_tag(:no_such_mix) do
+ mix_properties(integer2mix(mix_sync_max + 1))
+ end
+ check_error_tag(:no_such_mix) do
+ set_mix_properties(integer2mix(mix_sync_max + 1), 1)
+ end
#
if $with_test_motif
[:widget_position, :widget_size, :widget_text,
:hide_widget, :show_widget, :focus_widget].each do |n|
- if (tag = Snd.catch do snd_func(n, [:Widget, 0]) end).first != :no_such_widget
+ tag = Snd.catch do snd_func(n, [:Widget, 0]) end
+ if tag.first != :no_such_widget
snd_display("%s of null widget: %s", n, tag)
end
end
@@ -37229,8 +35536,9 @@ def test_28_03
:make_sawtooth_wave,
:make_rand,
:make_rand_interp].each do |g|
- if (res = Snd.catch do snd_func(g, :frequency, 440.0) end).first != :out_of_range
- snd_display("srate %s: %s -> %s", n, g, res.inspect)
+ tag = Snd.catch do snd_func(g, :frequency, 440.0) end
+ if tag.first != :out_of_range
+ snd_display("srate %s: %s -> %s", n, g, tag.inspect)
end
end
end
@@ -37494,7 +35802,6 @@ def test_28_03
end
end
end
- clear_sincs
stop_playing
dismiss_all_dialogs
end
@@ -37522,7 +35829,6 @@ def test_28_03
end
end
end
- clear_sincs
dismiss_all_dialogs
end
#
@@ -37620,16 +35926,13 @@ def test_28_03
end
end
end
- clear_sincs
dismiss_all_dialogs
end
+ set_ask_about_unsaved_edits(false)
end
def test_28_04
- if defined? mus_audio_reinitialize
- mus_audio_reinitialize
- end
- File.exists?("test.snd") and File.chmod(0644, "test.snd") and File.unlink("test.snd")
+ File.exist?("test.snd") and File.chmod(0644, "test.snd") and File.unlink("test.snd")
file_copy("oboe.snd", "test.snd")
ind = open_sound("test.snd")
delete_file("test.snd")
@@ -37709,18 +36012,16 @@ def test_28
test_28_01
test_28_02
end
- # FIXME
- # with snd-gtk test_28_04 should come before test_28_03 because of:
- # (snd-ruby-xg:2371): Gdk-WARNING **: GdkWindow 0x160015b unexpectedly destroyed
- # ...
- test_28_04
test_28_03
+ test_28_04
end
# ---------------- test all done
def test_30
- test_04_08
+ # $bigtest_08 = true
+ # test_08_24
+ test_28_00
end
main_test
diff --git a/snd-test.scm b/snd-test.scm
index b3e5d4e..e2569cc 100644
--- a/snd-test.scm
+++ b/snd-test.scm
@@ -1,112 +1,119 @@
;;; Snd tests
;;;
-;;; test 0: constants [607]
-;;; test 1: defaults [1186]
-;;; test 2: headers [1399]
-;;; test 3: variables [1714]
-;;; test 4: sndlib [2344]
-;;; test 5: simple overall checks [5071]
-;;; test 6: vcts [14194]
-;;; test 7: colors [14631]
-;;; test 8: clm [15149]
-;;; test 9: mix [27028]
-;;; test 10: marks [29257]
-;;; test 11: dialogs [30224]
-;;; test 12: extensions [30435]
-;;; test 13: menus, edit lists, hooks, etc [30704]
-;;; test 14: all together now [32200]
-;;; test 15: chan-local vars [33100]
-;;; test 16: regularized funcs [34900]
-;;; test 17: dialogs and graphics [39849]
-;;; test 18: enved [39941]
-;;; test 19: save and restore [39960]
-;;; test 20: transforms [41726]
-;;; test 21: new stuff [43913]
-;;; test 22: run [45950]
-;;; test 23: with-sound [52866]
-;;; test 25: X/Xt/Xm [57373]
-;;; test 26: [61076]
-;;; test 27: GL [61082]
-;;; test 28: errors [61206]
-;;; test 29: s7 [63421]
-;;; test all done [63492]
-;;; test the end [63681]
+;;; test 0: constants [554]
+;;; test 1: defaults [1226]
+;;; test 2: headers [1596]
+;;; test 3: variables [1911]
+;;; test 4: sndlib [2475]
+;;; test 5: simple overall checks [4490]
+;;; test 6: float-vectors [9242]
+;;; test 7: colors [9513]
+;;; test 8: clm [10032]
+;;; test 9: mix [22115]
+;;; test 10: marks [23894]
+;;; test 11: dialogs [24832]
+;;; test 12: extensions [25005]
+;;; test 13: menus, edit lists, hooks, etc [25271]
+;;; test 14: all together now [26604]
+;;; test 15: chan-local vars [27487]
+;;; test 16: regularized funcs [29224]
+;;; test 17: dialogs and graphics [32973]
+;;; test 18: save and restore [33085]
+;;; test 19: transforms [34737]
+;;; test 20: new stuff [36837]
+;;; test 21: optimizer [38030]
+;;; test 22: with-sound [40924]
+;;; test 23: X/Xt/Xm [43909]
+;;; test 24: GL [47583]
+;;; test 25: errors [47706]
+;;; test 26: s7 [49224]
+;;; test all done [49295]
+;;; test the end [49477]
+
+;;; (set! (hook-functions *load-hook*) (list (lambda (hook) (format *stderr* "loading ~S...~%" (hook 'name)))))
+
+;(set! (*s7* 'gc-stats) 6)
+
+(when (provided? 'pure-s7)
+ (define (make-polar mag ang)
+ (if (and (real? mag) (real? ang))
+ (complex (* mag (cos ang)) (* mag (sin ang)))
+ (error 'wrong-type-arg "make-polar args should be real")))
+ (define (memq a b) (member a b eq?))
+ (define (memv a b) (member a b eqv?)))
(define tests 1)
(define keep-going #f)
(define all-args #f)
(define test-at-random 0)
- ;(show-ptree 1)
-;; (define profiling #f)
-
- ;(set! (hook-functions *load-hook*) (list (lambda (name) (format #t "load ~S~%" name))))
(if (<= tests 0) (set! tests 1))
+#|
(set! *#readers*
(cons (cons #\_ (lambda (str)
(if (string=? str "__line__")
(port-line-number)
#f)))
*#readers*))
+|#
+(set! *#readers* (cons (cons #\_ _snd-line-reader_) *#readers*))
-(if (defined? 'run-clear-counts) (run-clear-counts))
-(define (copy-file src dest) (system (string-append "cp " src " " dest)))
+(define (copy-file source dest) (system (string-append "cp " source " " dest)))
-(define (procedure-property func prop)
- (if (eq? prop 'arity)
- (procedure-arity func)
- (procedure-documentation func)))
+(define-expansion (fill-float-vector v body)
+ `(let ((len (length ,v)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) ,v)
+ (float-vector-set! ,v i ,body))))
-(define (string-downcase str)
- (let* ((len (string-length str))
- (newstr (make-string len)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (string-set! newstr i (char-downcase (string-ref str i))))
- newstr))
+(define-expansion (outa->fv v body)
+ `(let ((len (length ,v)))
+ (set! *output* ,v)
+ (do ((i 0 (+ i 1)))
+ ((= i len) (set! *output* #f) ,v)
+ (outa i ,body))))
(define* (cfft! data n (dir 1))
(if (not n) (set! n (length data)))
- (do ((i 0 (+ i 1))
- (j 0))
- ((= i n))
- (if (> j i)
- (let ((temp (data j)))
- (set! (data j) (data i))
- (set! (data i) temp)))
- (let ((m (/ n 2)))
- (do ()
- ((or (< m 2) (< j m)))
- (set! j (- j m))
- (set! m (/ m 2)))
- (set! j (+ j m))))
- (let ((ipow (floor (log n 2)))
- (prev 1))
- (do ((lg 0 (+ lg 1))
- (mmax 2 (* mmax 2))
- (pow (/ n 2) (/ pow 2))
- (theta (make-rectangular 0.0 (* pi dir)) (* theta 0.5)))
- ((= lg ipow))
- (let ((wpc (exp theta))
- (wc 1.0))
- (do ((ii 0 (+ ii 1)))
- ((= ii prev))
- (do ((jj 0 (+ jj 1))
- (i ii (+ i mmax))
- (j (+ ii prev) (+ j mmax)))
- ((>= jj pow))
- (let ((tc (* wc (data j))))
- (set! (data j) (- (data i) tc))
- (set! (data i) (+ (data i) tc))))
- (set! wc (* wc wpc)))
- (set! prev mmax))))
- data)
+ (let ((t0 (complex 0.0 (* pi dir))))
+ (do ((i 0 (+ i 1))
+ (j 0))
+ ((= i n))
+ (if (> j i)
+ (let ((temp (data j)))
+ (set! (data j) (data i))
+ (set! (data i) temp)))
+ (let ((m (/ n 2)))
+ (do ()
+ ((or (< m 2) (< j m)))
+ (set! j (- j m))
+ (set! m (/ m 2)))
+ (set! j (+ j m))))
+ (let ((ipow (floor (log n 2)))
+ (prev 1))
+ (do ((lg 0 (+ lg 1))
+ (mmax 2 (* mmax 2))
+ (pow (/ n 2) (/ pow 2))
+ (theta t0 (* theta 0.5)))
+ ((= lg ipow))
+ (let ((wpc (exp theta))
+ (wc 1.0))
+ (do ((ii 0 (+ ii 1)))
+ ((= ii prev))
+ (do ((jj 0 (+ jj 1))
+ (i ii (+ i mmax))
+ (j (+ ii prev) (+ j mmax)))
+ ((>= jj pow))
+ (let ((tc (* wc (data j))))
+ (set! (data j) (- (data i) tc))
+ (set! (data i) (+ (data i) tc))))
+ (set! wc (* wc wpc)))
+ (set! prev mmax))))
+ data))
(define* (fft! rl im n (dir 1))
(if (not im)
- (let ((clear (copy rl)))
- (fill! clear 0.0)
- (set! im clear)))
+ (set! im (make-float-vector (length rl))))
(if (not n)
(set! n (length rl)))
(do ((i 0 (+ i 1))
@@ -156,29 +163,33 @@
(if (not (defined? 'snd-test)) (define snd-test -1))
(define full-test (< snd-test 0))
-(define total-tests 29)
+(define total-tests 26)
(if (not (defined? 'with-exit)) (define with-exit (< snd-test 0)))
+(define s7test-exits #f)
(define test-number -1)
-(define (snd-display line . args)
+(define-constant (snd-display line . args)
(let ((str (if (null? (cdr args))
(car args)
- (apply format #f args))))
- (format #t "~%~A: ~8T~A" line str)
+ (if (or (string? (car args))
+ (and (not (car args))
+ (string? (cadr args))))
+ (apply format #f args)
+ (object->string args)))))
+ (format *stderr* "~%~A: ~8T~A" line str)
(if (not (provided? 'snd-nogui))
(snd-print (format #f "~%~A: ~A" line str)))))
(define with-big-file #f)
(define big-file-name "/home/bil/zap/sounds/bigger.snd")
-(if (and with-big-file
- (not (string=? (version) "1.8.0")))
+(if with-big-file
(begin
(set! with-big-file (file-exists? big-file-name))
(if (not with-big-file) (snd-display #__line__ ";no big file"))))
-(define big-file-frames 0)
+(define big-file-framples 0)
-(define original-save-dir (or (save-dir) "~/zap/snd"))
-(define original-temp-dir (or (temp-dir) "~/zap/tmp"))
+(define original-save-dir (or *save-dir* "~/zap/snd"))
+(define original-temp-dir (or *temp-dir* "~/zap/tmp"))
(define original-sound-file-extensions (sound-file-extensions))
(unbind-key #\c 4 #t)
@@ -197,7 +208,7 @@
(system "rm /var/tmp/*.snd")))
(system "rm core*")
-(define home-dir "/home/bil")
+(define home-dir (getenv "HOME"))
(define sf-dir "/sf1")
(if (not (file-exists? (string-append home-dir "/cl/oboe.snd")))
@@ -206,7 +217,9 @@
(if (file-exists? "/Users/bil/cl/oboe.snd")
(set! home-dir "/Users/bil")
(if (file-exists? "/users/b/bil/cl/oboe.snd")
- (set! home-dir "/users/b/bil")))))
+ (set! home-dir "/users/b/bil")
+ (if (file-exists? "/usr/home/bil/cl/oboe.snd")
+ (set! home-dir "/usr/home/bil"))))))
(define cwd (string-append (getcwd) "/"))
(define sf-dir1 (string-append home-dir sf-dir "/"))
@@ -225,331 +238,257 @@
(lambda (file)
(if (not (file-exists? file))
(begin
- (display (format #f "copying ~A~%" file))
+ (format #t "copying ~A~%" file)
(copy-file (string-append home-dir "/cl/" file) (string-append (getcwd) "/" file)))))
(list "4.aiff" "2.snd" "obtest.snd" "oboe.snd" "pistol.snd" "1a.snd" "now.snd" "fyow.snd"
"storm.snd" "z.snd" "1.snd" "cardinal.snd" "now.snd.scm" "2a.snd" "4a.snd" "zero.snd"
- "loop.scm" "cmn-glyphs.lisp" "bullet.xpm" "mb.snd" "funcs.cl" "trumpet.snd" "1234.snd")))
+ "loop.scm" "cmn-glyphs.lisp" "bullet.xpm" "mb.snd" "funcs.scm" "trumpet.snd" "1234.snd")))
+
+(for-each mus-sound-preload (list "4.aiff" "2.snd" "obtest.snd" "oboe.snd" "pistol.snd" "1a.snd" "now.snd"
+ "fyow.snd" "storm.snd" "1.snd" "cardinal.snd" "2a.snd"))
+
;;(setlocale LC_ALL "de_DE")
-(set! (with-background-processes) #f)
-(define max-optimization 6)
-(define sampler-tests 300)
+(set! *with-background-processes* #f)
;; try to get a different random number sequence on each run
(set! (mus-rand-seed) (current-time))
-(set! (hook-functions bad-header-hook) '())
-(hook-push bad-header-hook (lambda (n) #t))
+(set! (hook-functions bad-header-hook) ())
+(hook-push bad-header-hook (lambda (hook) (set! (hook 'result) #t)))
+
+(define with-motif (provided? 'snd-motif))
(define with-gui (or (provided? 'snd-gtk)
(provided? 'snd-motif)))
(if (not with-gui)
- (define y-bounds (make-procedure-with-setter
+ (define y-bounds (dilambda
(lambda args (list -1.0 1.0))
(lambda args (list -1.0 1.0)))))
(if (not with-gui)
- (define x-bounds (make-procedure-with-setter
+ (define x-bounds (dilambda
(lambda args (list 0.0 0.1))
(lambda args (list 0.0 0.1)))))
-(if (file-exists? "optimizer.log")
- (delete-file "optimizer.log"))
-(define optimizer-log (open-output-file "optimizer.log"))
-(define optimizer-test -1)
-
-(set! (hook-functions optimization-hook) '())
-(define *opt* #f)
-(hook-push optimization-hook
- (lambda (msg)
- (set! *opt* #f)
- (if (= (optimization) max-optimization)
- (begin
- (if (not (= test-number optimizer-test))
- (begin
- (display (format #f "-------- test ~A --------~%" test-number) optimizer-log)
- (set! optimizer-test test-number)))
- (display msg optimizer-log)
- (newline optimizer-log)))))
-
-(define (real-time) (exact->inexact (/ (get-internal-real-time) internal-time-units-per-second)))
+(define real-time get-internal-real-time)
(define (hundred n) (round (* 100 n)))
-(define times '())
-(defmacro time (a)
+(define times ())
+(define-macro (time a)
`(let ((start (real-time)))
,a
(let ((val (hundred (- (real-time) start))))
(set! times (cons (list ',a val) times)))))
-(define original-prompt (listener-prompt))
+(define original-prompt *listener-prompt*)
(set! (show-listener) #t)
(set! (window-x) 600)
(set! (window-y) 10)
-(define test14-file #f)
-(define (fneq a b)
- "float equal within .001"
- (> (abs (- a b)) .001))
+(define-expansion (fneq a b)
+ `(> (magnitude (- ,a ,b)) .001))
-(define (ffneq a b)
- "float equal within .01"
- (> (abs (- a b)) .01))
+(define-expansion (ffneq a b)
+ `(> (magnitude (- ,a ,b)) .01))
-(define (fffneq a b)
- "float equal within .1"
- (> (abs (- a b)) .1))
+(define-expansion (fffneq a b)
+ `(> (magnitude (- ,a ,b)) .1))
(define (cneq a b)
- "complex equal within .001"
- (or (> (abs (- (real-part a) (real-part b))) .001)
- (> (abs (- (imag-part a) (imag-part b))) .001)))
-
-(define (feql a b)
- "list equal with fneq"
- (if (null? a)
- (null? b)
- (if (null? b)
- #f
- (if (list? (car a))
- (and (list? (car b))
- (feql (car a) (car b)))
- (if (fneq (car a) (car b))
- #f
- (feql (cdr a) (cdr b)))))))
-
-(define (ffeql a b)
- "list equal with fffneq"
- (if (null? a)
- (null? b)
- (if (null? b)
- #f
- (if (list? (car a))
- (and (list? (car b))
- (ffeql (car a) (car b)))
- (if (fffneq (car a) (car b))
- #f
- (ffeql (cdr a) (cdr b)))))))
-
-(define (fveql a b i)
- "vct equal with fneq"
- (if (null? b)
- #t
- (if (fneq (car b) (vct-ref a i))
- #f
- (fveql a (cdr b) (+ i 1)))))
-
-(define (vequal v0 v1)
- "general equal with .001"
- (let ((old-fudge (mus-float-equal-fudge-factor)))
- (set! (mus-float-equal-fudge-factor) .001)
- (let ((result (equal? v0 v1)))
- (set! (mus-float-equal-fudge-factor) old-fudge)
- result)))
+ (> (magnitude (- a b)) .001))
+
+(define-constant (feql a b)
+ (let ((old-eps (*s7* 'morally-equal-float-epsilon)))
+ (set! (*s7* 'morally-equal-float-epsilon) .001)
+ (let ((res (morally-equal? a b)))
+ (set! (*s7* 'morally-equal-float-epsilon) old-eps)
+ res)))
+
+(define-constant (ffeql a b)
+ (let ((old-eps (*s7* 'morally-equal-float-epsilon)))
+ (set! (*s7* 'morally-equal-float-epsilon) .1)
+ (let ((res (morally-equal? a b)))
+ (set! (*s7* 'morally-equal-float-epsilon) old-eps)
+ res)))
+
+(define-constant (fveql a b i)
+ (or (null? b)
+ (and (not (fneq (car b) (a i)))
+ (fveql a (cdr b) (+ i 1)))))
+
+(define* (mus-arrays-equal? x y (err .001))
+ (let ((old-eps (*s7* 'morally-equal-float-epsilon)))
+ (set! (*s7* 'morally-equal-float-epsilon) err)
+ (let ((res (morally-equal? x y)))
+ (set! (*s7* 'morally-equal-float-epsilon) old-eps)
+ res)))
+
+(define-constant sd-equal mus-arrays-equal?)
+(define-constant vequal mus-arrays-equal?)
(define (vequal1 v0 v1)
- "general equal with .01"
- (let ((old-fudge (mus-float-equal-fudge-factor)))
- (set! (mus-float-equal-fudge-factor) .01)
- (let ((result (equal? v0 v1)))
- (set! (mus-float-equal-fudge-factor) old-fudge)
- result)))
+ (mus-arrays-equal? v0 v1 .01))
(define (vvequal v0 v1)
- "general equal with .00002"
- (let ((old-fudge (mus-float-equal-fudge-factor)))
- (set! (mus-float-equal-fudge-factor) .00002)
- (let ((result (equal? v0 v1)))
- (set! (mus-float-equal-fudge-factor) old-fudge)
- result)))
+ (mus-arrays-equal? v0 v1 .00002))
(define (vmaxdiff v0 v1)
- (vct-peak (vct-subtract! (vct-copy v0) v1)))
-
-(define (sd-equal v0 v1)
- "sound-data equal within .001"
- (let ((old-fudge (mus-float-equal-fudge-factor)))
- (set! (mus-float-equal-fudge-factor) .001)
- (let ((result (equal? v0 v1)))
- (set! (mus-float-equal-fudge-factor) old-fudge)
- result)))
-
-(define* (my-substring str start end)
- "substring with end"
- (substring str start (or end (string-length str))))
-
-(define (string-=? a b)
- "string=? but ignore -0.0"
- (or (string=? a b)
- (let* ((alen (string-length a))
- (blen (string-length b))
- (j 0)
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy)
- (= i alen))
- (and happy
- (= j blen)))
- (let ((ac (string-ref a i))
- (bc (string-ref b j)))
- (if (char=? ac bc)
- (set! j (+ 1 j))
- (if (not (and (char=? ac #\-)
- (<= i (- alen 7))
- (string=? (substring a i (+ i 6)) "-0.000")))
- (if (and (char=? bc #\-)
- (<= j (- blen 7))
- (string=? (substring b j (+ j 6)) "-0.000"))
- (begin
- (set! j (+ 1 j))
- (if (not (char=? ac (string-ref b j)))
- (set! happy #f)
- (set! j (+ 1 j))))
- (set! happy #f)))))))))
+ (float-vector-peak (float-vector-subtract! (copy v0) v1)))
-(define (dismiss-all-dialogs)
- "(dismiss-all-dialogs) hides all dialogs"
- (if (or (provided? 'xm)
- (provided? 'xg))
- (for-each
- (lambda (dialog)
- (if dialog
- (if (symbol? (car dialog))
- (if (provided? 'snd-motif)
- (if (XtIsManaged dialog)
- (XtUnmanageChild dialog))
- (if (provided? 'snd-gtk)
- (gtk_widget_hide dialog)))
- (for-each
- (lambda (d)
- (if (symbol? (car d))
- (if (provided? 'snd-motif)
- (if (XtIsManaged d)
- (XtUnmanageChild d))
- (if (provided? 'snd-gtk)
- (gtk_widget_hide d)))))
- dialog))))
- (dialog-widgets))))
+(define (within-.01? a b) (< (abs (- a b)) .01))
+
+(define-constant (string-=? a b) ;(format *stderr* "str: ~A ~A~%" a b)
+ (or (string=? a b)
+ (and (or (char-position #\- a)
+ (char-position #\- b))
+ (let ((alen (length a))
+ (blen (length b))
+ (j 0)
+ (happy #t))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy)
+ (= i alen))
+ (and happy
+ (= j blen)))
+ (let ((ac (a i))
+ (bc (b j)))
+ (if (char=? ac bc)
+ (set! j (+ j 1))
+ (if (not (and (char=? ac #\-)
+ (<= i (- alen 7))
+ (string=? (substring a i (+ i 6)) "-0.000")))
+ (if (and (char=? bc #\-)
+ (<= j (- blen 7))
+ (string=? (substring b j (+ j 6)) "-0.000"))
+ (begin
+ (set! j (+ j 1))
+ (if (not (char=? ac (b j)))
+ (set! happy #f)
+ (set! j (+ j 1))))
+ (set! happy #f))))))))))
+
+(define dismiss-all-dialogs
+ (let ((documentation "(dismiss-all-dialogs) hides all dialogs"))
+ (lambda ()
+ (if (or (provided? 'xm)
+ (provided? 'xg))
+ (for-each
+ (lambda (dialog)
+ (if dialog
+ (if (symbol? (car dialog))
+ (if (provided? 'snd-motif)
+ (if ((*motif* 'XtIsManaged) dialog)
+ ((*motif* 'XtUnmanageChild) dialog))
+ (if (provided? 'snd-gtk)
+ ((*gtk* 'gtk_widget_hide) dialog)))
+ (for-each
+ (lambda (d)
+ (if (symbol? (car d))
+ (if (provided? 'snd-motif)
+ (if ((*motif* 'XtIsManaged) d)
+ ((*motif* 'XtUnmanageChild) d))
+ (if (provided? 'snd-gtk)
+ ((*gtk* 'gtk_widget_hide) d)))))
+ dialog))))
+ (dialog-widgets))))))
(define safe-color (make-color 1 0 0))
-(define (make-color-with-catch c1 c2 c3)
- "make-color but catch 'no-such-color"
- (catch 'no-such-color
- (lambda () (make-color c1 c2 c3))
- (lambda args safe-color)))
-
-(define* (safe-display-edits snd chn edpos (with-source #t))
- "display-edits but catch all errors"
- (catch #t
- (lambda () (display-edits snd chn edpos with-source))
- (lambda args (snd-display #__line__ ";display-edits error: ~A" args))))
+(define make-color-with-catch
+ (let ((documentation "make-color but catch 'no-such-color"))
+ (lambda (c1 c2 c3)
+ (catch 'no-such-color
+ (lambda () (make-color c1 c2 c3))
+ (lambda args safe-color)))))
+
+(define safe-display-edits
+ (let ((documentation "display-edits but catch all errors"))
+ (lambda* (snd chn edpos)
+ (catch #t
+ (lambda () (display-edits snd chn edpos))
+ (lambda args (snd-display #__line__ ";display-edits error: ~A" args))))))
(define (safe-divide a b)
- "divide but check for 0 denom"
(if (zero? b)
a
(/ a b)))
(define timings (make-vector (+ total-tests 1) 0))
-(define default-srate (mus-srate))
+(define default-srate *clm-srate*)
(snd-display #__line__ ";;~A" (snd-version))
-(if (not (defined? 'before-test-hook)) (define before-test-hook (make-hook 1)))
-(if (not (defined? 'after-test-hook)) (define after-test-hook (make-hook 1)))
-(set! (hook-functions before-test-hook) '())
-(hook-push before-test-hook (lambda (n)
- (set! (mus-srate) default-srate)
- (dismiss-all-dialogs)
- (set! (clipping) #f)
- (set! (mus-clipping) #f) ; this cost me a morning of confusion!
- (set! test-number n)
- (vector-set! timings n (real-time))
- (snd-display #__line__ ";test ~D" n)
-
- ))
+(if (not (defined? 'before-test-hook)) (define before-test-hook (make-hook 'n)))
+(if (not (defined? 'after-test-hook)) (define after-test-hook (make-hook 'n)))
+(set! (hook-functions before-test-hook) ())
+(hook-push before-test-hook (lambda (hook)
+ (let ((n (hook 'n)))
+ (set! *clm-srate* default-srate)
+ (dismiss-all-dialogs)
+ (set! *clipping* #f)
+ (set! (mus-clipping) #f) ; this cost me a morning of confusion!
+ (set! test-number n)
+ (set! (timings n) (real-time))
+ (snd-display #__line__ ";test ~D" n)
+ )))
(define (clear-save-state-files)
- "forget regions and whatnot"
- (let ((regs (regions)))
- (for-each
- (lambda (n)
- (forget-region n))
- regs))
-
- (system (format #f "rm -f ~A/snd_*" (or (save-dir) original-save-dir)))
+ (for-each forget-region (regions))
+ (system (format #f "rm -f ~A/snd_*" (or *save-dir* original-save-dir)))
(if (file-exists? "/var/tmp")
- (system (format #f "rm -f /var/tmp/snd_save_*")))
+ (system "rm -f /var/tmp/snd_save_*"))
(if (file-exists? "/tmp")
- (system (format #f "rm -f /tmp/snd_save_*")))
+ (system "rm -f /tmp/snd_save_*"))
(mus-sound-prune))
-(set! (hook-functions after-test-hook) '())
+(set! (hook-functions after-test-hook) ())
(hook-push after-test-hook
- (lambda (n)
- (clear-save-state-files)
- (clear-listener)
- (set! (ask-about-unsaved-edits) #f)
- (if (not (null? (sounds)))
- (begin
- (snd-display #__line__ ";end test ~D: open sounds: ~A" n (map short-file-name (sounds)))
- (for-each close-sound (sounds))))
- (if (number? (vector-ref timings n))
- (vector-set! timings n (hundred (- (real-time) (vector-ref timings n)))))))
+ (lambda (hook)
+ (let ((n (hook 'n)))
+ (clear-save-state-files)
+ (clear-listener)
+ (set! *ask-about-unsaved-edits* #f)
+ (if (pair? (sounds))
+ (begin
+ (snd-display #__line__ ";end test ~D: open sounds: ~A" n (map short-file-name (sounds)))
+ (for-each close-sound (sounds))))
+ (if (number? (vector-ref timings n))
+ (set! (timings n) (hundred (- (real-time) (vector-ref timings n))))))))
(define overall-start-time (real-time))
(snd-display #__line__ ";~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
(define (log-mem tst)
- (if (> tests 1) (begin (snd-display #__line__ ";test ~D:~D " test-number (+ 1 tst)) )))
+ (if (> tests 1) (snd-display #__line__ ";test ~D:~D " test-number (+ 1 tst))))
-(defmacro without-errors (func)
- `(catch #t
+(define-macro (without-errors func)
+ `(catch #t ; but this also squelches syntax errors!
(lambda ()
,func)
(lambda args
(car args))))
-(if (not (provided? 'snd-hooks.scm)) (load "hooks.scm"))
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-
-(define (reset-almost-all-hooks)
- (with-local-hook optimization-hook '() reset-all-hooks))
-
-
-(define (arity-ok func args)
- "func accepts args"
- (let ((arity (procedure-arity func)))
- (and (pair? arity)
- (>= args (car arity))
- (or (and (pair? (cddr arity))
- (caddr arity))
- (<= args (+ (car arity) (cadr arity)))))))
+(require snd-hooks.scm snd-ws.scm)
(define (set-arity-ok func args)
- "set proc accepts args"
- (let ((arity (if (procedure-with-setter? func)
- (cdddr (procedure-arity func))
- (procedure-arity func))))
- (and (pair? arity)
- (>= args (car arity))
- (or (and (pair? (cddr arity))
- (caddr arity))
- (<= args (+ (car arity) (cadr arity)))))))
+ (let ((arit (if (dilambda? func)
+ (arity (procedure-setter func))
+ (and (procedure? (procedure-setter func))
+ (arity (procedure-setter func))))))
+ (and (pair? arit)
+ (>= args (car arit))
+ (<= args (cdr arit)))))
(define* (scale-sound-by scl beg dur snd chn edpos)
- "(scale-sound-by scl beg dur snd chn edpos) is an old form of scale-sound"
(if (integer? chn)
(scale-channel scl beg dur snd chn edpos)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (channels snd)))
(scale-channel scl beg dur snd i))))
(define* (scale-sound-to norm beg dur snd chn)
- "(scale-sound-to norm beg dur snd chn) is an old form of normalize-sound"
(if (integer? chn)
(let ((mx (maxamp snd chn)))
(if (and (not (= mx 0.0))
@@ -558,45 +497,51 @@
(let ((mx (apply max (maxamp snd #t))))
(if (and (not (= mx 0.0))
(not (= mx norm)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (channels snd)))
(scale-channel (/ norm mx) beg dur snd i))))))
+(define (file->floats file) (samples 0 (framples file) file))
+
+(define* (floats->file v file (srate 22050) (comment ""))
+ (if (float-vector? v)
+ (begin
+ (array->file file v (length v) srate 1)
+ file)
+ (error 'wrong-type-arg "file->floats: ~A" v)))
+
+
(if (and (> (length (script-args)) 0)
(> (script-arg) 0))
(let ((arg (script-arg))
(args (script-args)))
- (if (not (string=? (list-ref args (- arg 1)) "-l"))
- (snd-display #__line__ ";script-args[~A]: ~A (~A)?" (- arg 1) (list-ref args (- arg 1)) args))
- (if (not (string=? (list-ref args arg) "snd-test"))
- (snd-display #__line__ ";script-args[~A]: ~A (~A)?" arg (list-ref args arg) args))
+ (if (not (string=? (args (- arg 1)) "-l"))
+ (snd-display #__line__ ";script-args[~A]: ~A (~A)?" (- arg 1) (args (- arg 1)) args))
+ (if (not (string=? (args arg) "snd-test"))
+ (snd-display #__line__ ";script-args[~A]: ~A (~A)?" arg (args arg) args))
(if (> (length args) (+ 1 arg))
(begin
;; test-number tests
- (set! snd-test (string->number (list-ref args (+ 1 arg))))
+ (set! snd-test (string->number (args (+ 1 arg))))
(set! test-at-random 0)
(set! full-test (< snd-test 0))
(set! with-exit #t)
(set! (script-arg) (+ 1 arg))
(if (> (length (script-args)) (+ arg 2))
(begin
- (set! tests (string->number (list-ref args (+ arg 2))))
+ (set! tests (string->number (args (+ arg 2))))
(set! (script-arg) (+ arg 2))))))))
(if (and (provided? 'snd-motif)
(provided? 'xm))
- (begin
- (if (not (provided? 'snd-snd-motif.scm)) (load "snd-motif.scm")))
+ (require snd-snd-motif.scm)
(if (and (provided? 'snd-gtk)
(provided? 'xg))
- (begin
- (if (not (provided? 'snd-snd-gtk.scm)) (load "snd-gtk.scm")))))
+ (require snd-snd-gtk.scm)))
-(if (not (provided? 'snd-snd9.scm)) (load "snd9.scm")) ; make-ppolar|zpolar, various generators later moved to generators.scm
-
-(define default-file-buffer-size 65536)
-(set! (mus-file-buffer-size) default-file-buffer-size)
+(define default-file-buffer-size *clm-file-buffer-size*)
+;(set! *clm-file-buffer-size* default-file-buffer-size)
(if (not (defined? 'pi))
(snd-display #__line__ ";pi is not defined!")
@@ -609,17 +554,17 @@
(define (snd_test_0)
(letrec ((test-constants
(lambda (lst)
- (if (not (null? lst))
+ (if (pair? lst)
(begin
(if (not (= (cadr lst) (caddr lst)))
(snd-display #__line__ ";~A is not ~A (~A)~%"
(car lst) (cadr lst) (caddr lst)))
(test-constants (cdddr lst)))))))
- (if (or (not (null? (sounds)))
- (not (null? (mixes)))
- (not (null? (marks)))
- (not (null? (regions))))
+ (if (or (pair? (sounds))
+ (pair? (mixes))
+ (pair? (marks))
+ (pair? (regions)))
(snd-display #__line__ ";start up: ~A ~A ~A ~A" (sounds) (mixes) (marks) (regions)))
(test-constants
(list
@@ -723,7 +668,7 @@
'show-bare-x-axis show-bare-x-axis 5
;; sndlib constants
- 'mus-unsupported mus-unsupported 0
+ 'mus-unknown-header mus-unknown-header 0
'mus-next mus-next 1
'mus-aifc mus-aifc 2
'mus-riff mus-riff 3
@@ -749,7 +694,7 @@
'mus-chebyshev-first-kind mus-chebyshev-first-kind 1
'mus-chebyshev-second-kind mus-chebyshev-second-kind 2
- 'mus-unknown mus-unknown 0
+ 'mus-unknown-sample mus-unknown-sample 0
'mus-bshort mus-bshort 1
'mus-lshort mus-lshort 10
'mus-mulaw mus-mulaw 2
@@ -774,407 +719,490 @@
'mus-ldouble-unscaled mus-ldouble-unscaled 22
))
- (set! (region-graph-style) (region-graph-style))
- (if (not (equal? (region-graph-style) graph-lines))
- (snd-display #__line__ ";region-graph-style set def: ~A" (region-graph-style)))
- (set! (ask-about-unsaved-edits) (ask-about-unsaved-edits))
- (if (not (equal? (ask-about-unsaved-edits) #f))
- (snd-display #__line__ ";ask-about-unsaved-edits set def: ~A" (ask-about-unsaved-edits)))
- (set! (show-full-duration) (show-full-duration))
- (if (not (equal? (show-full-duration) #f))
- (snd-display #__line__ ";show-full-duration set def: ~A" (show-full-duration)))
- (set! (initial-beg) (initial-beg))
- (if (fneq (initial-beg) 0.0)
- (snd-display #__line__ ";initial-beg set def: ~A" (initial-beg)))
- (set! (initial-dur) (initial-dur))
- (if (fneq (initial-dur) 0.1)
- (snd-display #__line__ ";initial-dur set def: ~A" (initial-dur)))
- (set! (ask-before-overwrite) (ask-before-overwrite))
- (if (not (equal? (ask-before-overwrite) #f))
- (snd-display #__line__ ";ask-before-overwrite set def: ~A" (ask-before-overwrite)))
- (set! (audio-output-device) (audio-output-device))
- (if (not (equal? (audio-output-device) 0))
- (snd-display #__line__ ";audio-output-device set def: ~A" (audio-output-device)))
- (set! (auto-resize) (auto-resize))
- (if (not (equal? (auto-resize) #t ))
- (snd-display #__line__ ";auto-resize set def: ~A" (auto-resize)))
- (set! (auto-update) (auto-update))
- (if (not (equal? (auto-update) #f))
- (snd-display #__line__ ";auto-update set def: ~A" (auto-update)))
- (set! (channel-style) (channel-style))
- (if (not (equal? (channel-style) 1 ))
- (snd-display #__line__ ";channel-style set def: ~A" (channel-style)))
- (set! (color-cutoff) (color-cutoff))
- (if (fneq (color-cutoff) 0.003 )
- (snd-display #__line__ ";color-cutoff set def: ~A" (color-cutoff)))
- (set! (color-inverted) (color-inverted))
- (if (not (equal? (color-inverted) #t))
- (snd-display #__line__ ";color-inverted set def: ~A" (color-inverted)))
- (set! (color-scale) (color-scale))
- (if (fneq (color-scale) 1.0 )
- (snd-display #__line__ ";color-scale set def: ~A" (color-scale)))
- (set! (auto-update-interval) (auto-update-interval))
- (if (fneq (auto-update-interval) 60.0 )
- (snd-display #__line__ ";auto-update-interval set def: ~A" (auto-update-interval)))
- (set! (cursor-update-interval) (cursor-update-interval))
- (if (fneq (cursor-update-interval) 0.05 )
- (snd-display #__line__ ";cursor-update-interval set def: ~A" (cursor-update-interval)))
- (set! (cursor-location-offset) (cursor-location-offset))
- (if (not (= (cursor-location-offset) 0))
- (snd-display #__line__ ";cursor-location-offset set def: ~A" (cursor-location-offset)))
- (set! (dac-combines-channels) (dac-combines-channels))
- (if (not (equal? (dac-combines-channels) #t))
- (snd-display #__line__ ";dac-combines-channels set def: ~A" (dac-combines-channels)))
- (set! (dac-size) (dac-size))
- (if (not (equal? (dac-size) 256 ))
- (snd-display #__line__ ";dac-size set def: ~A" (dac-size)))
- (set! (minibuffer-history-length) (minibuffer-history-length))
- (if (not (equal? (minibuffer-history-length) 8))
- (snd-display #__line__ ";minibuffer-history-length set def: ~A" (minibuffer-history-length)))
- (set! (clipping) (clipping))
- (if (not (equal? (clipping) #f ))
- (snd-display #__line__ ";clipping set def: ~A" (clipping)))
- (set! (default-output-chans) (default-output-chans))
- (if (not (equal? (default-output-chans) 1 ))
- (snd-display #__line__ ";default-output-chans set def: ~A" (default-output-chans)))
- (set! (default-output-data-format) (default-output-data-format))
- (if (and (not (equal? (default-output-data-format) mus-bfloat))
- (not (equal? (default-output-data-format) mus-lfloat)))
- (snd-display #__line__ ";default-output-data-format set def: ~A" (default-output-data-format)))
- (set! (default-output-srate) (default-output-srate))
- (if (not (equal? (default-output-srate) 44100 ))
- (snd-display #__line__ ";default-output-srate set def: ~A" (default-output-srate)))
- (set! (default-output-header-type) (default-output-header-type))
- (if (not (equal? (default-output-header-type) mus-next))
- (snd-display #__line__ ";default-output-header-type set def: ~A" (default-output-header-type)))
- (set! (dot-size) (dot-size))
- (if (not (equal? (dot-size) 1 ))
- (snd-display #__line__ ";dot-size set def: ~A" (dot-size)))
- (set! (cursor-size) (cursor-size))
- (if (not (equal? (cursor-size) 15 ))
- (snd-display #__line__ ";cursor-size set def: ~A" (cursor-size)))
- (set! (cursor-style) (cursor-style))
- (if (not (equal? (cursor-style) cursor-cross ))
- (snd-display #__line__ ";cursor-style set def: ~A" (cursor-style)))
- (set! (tracking-cursor-style) (tracking-cursor-style))
- (if (not (equal? (tracking-cursor-style) cursor-line ))
- (snd-display #__line__ ";tracking-cursor-style set def: ~A" (tracking-cursor-style)))
- (set! (enved-base) (enved-base))
- (if (fneq (enved-base) 1.0 )
- (snd-display #__line__ ";enved-base set def: ~A" (enved-base)))
- (set! (enved-clip?) (enved-clip?))
- (if (not (equal? (enved-clip?) #t ))
- (snd-display #__line__ ";enved-clip? set def: ~A" (enved-clip?)))
- (set! (enved-filter) (enved-filter))
- (if (not (equal? (enved-filter) #t))
- (snd-display #__line__ ";enved-filter set def: ~A" (enved-filter)))
- (set! (enved-filter-order) (enved-filter-order))
- (if (not (equal? (enved-filter-order) 40))
- (snd-display #__line__ ";enved-filter-order set def: ~A" (enved-filter-order)))
- (set! (enved-in-dB) (enved-in-dB))
- (if (not (equal? (enved-in-dB) #f ))
- (snd-display #__line__ ";enved-in-dB set def: ~A" (enved-in-dB)))
- (set! (enved-style) (enved-style))
- (if (not (equal? (enved-style) envelope-linear ))
- (snd-display #__line__ ";enved-style set def: ~A" (enved-style)))
- (set! (enved-power) (enved-power))
- (if (fneq (enved-power) 3.0)
- (snd-display #__line__ ";enved-power set def: ~A" (enved-power)))
- (set! (enved-target) (enved-target))
- (if (not (equal? (enved-target) 0 ))
- (snd-display #__line__ ";enved-target set def: ~A" (enved-target)))
- (set! (enved-wave?) (enved-wave?))
- (if (not (equal? (enved-wave?) #f ))
- (snd-display #__line__ ";enved-wave? set def: ~A" (enved-wave?)))
- (if with-gui
- (begin
- (set! (enved-envelope) (enved-envelope))
- (if (not (equal? (enved-envelope) '()))
- (snd-display #__line__ ";enved-envelope set def: ~A" (enved-envelope)))))
- (set! (eps-file) (eps-file))
- (if (not (equal? (eps-file) "snd.eps" ))
- (snd-display #__line__ ";eps-file set def: ~A" (eps-file)))
- (set! (eps-bottom-margin) (eps-bottom-margin))
- (if (fneq (eps-bottom-margin) 0.0)
- (snd-display #__line__ ";eps-bottom-margin set def: ~A" (eps-bottom-margin)))
- (set! (eps-left-margin) (eps-left-margin))
- (if (fneq (eps-left-margin) 0.0)
- (snd-display #__line__ ";eps-left-margin set def: ~A" (eps-left-margin)))
- (set! (eps-size) (eps-size))
- (if (fneq (eps-size) 1.0)
- (snd-display #__line__ ";eps-size set def: ~A" (eps-size)))
- (set! (fft-window-alpha) (fft-window-alpha))
- (if (fneq (fft-window-alpha) 0.0 )
- (snd-display #__line__ ";fft-window-alpha set def: ~A" (fft-window-alpha)))
- (set! (fft-window-beta) (fft-window-beta))
- (if (fneq (fft-window-beta) 0.0 )
- (snd-display #__line__ ";fft-window-beta set def: ~A" (fft-window-beta)))
- (set! (fft-log-frequency) (fft-log-frequency))
- (if (not (equal? (fft-log-frequency) #f ))
- (snd-display #__line__ ";fft-log-frequency set def: ~A" (fft-log-frequency)))
- (set! (fft-log-magnitude) (fft-log-magnitude))
- (if (not (equal? (fft-log-magnitude) #f ))
- (snd-display #__line__ ";fft-log-magnitude set def: ~A" (fft-log-magnitude)))
- (set! (fft-with-phases) (fft-with-phases))
- (if (not (equal? (fft-with-phases) #f ))
- (snd-display #__line__ ";fft-with-phases set def: ~A" (fft-with-phases)))
- (set! (transform-size) (transform-size))
- (if (not (equal? (transform-size) 512 ))
- (snd-display #__line__ ";transform-size set def: ~A" (transform-size)))
- (set! (transform-graph-type) (transform-graph-type))
- (if (not (equal? (transform-graph-type) graph-once))
- (snd-display #__line__ ";transform-graph-type set def: ~A" (transform-graph-type)))
- (set! (fft-window) (fft-window))
- (if (not (equal? (fft-window) 6 ))
- (snd-display #__line__ ";fft-window set def: ~A" (fft-window)))
- (set! (graph-cursor) (graph-cursor))
- (if (not (equal? (graph-cursor) 34))
- (snd-display #__line__ ";graph-cursor set def: ~A" (graph-cursor)))
- (set! (graph-style) (graph-style))
- (if (not (equal? (graph-style) graph-lines ))
- (snd-display #__line__ ";graph-style set def: ~A" (graph-style)))
- (set! (graphs-horizontal) (graphs-horizontal))
- (if (not (equal? (graphs-horizontal) #t))
- (snd-display #__line__ ";graphs-horizontal set def: ~A" (graphs-horizontal)))
- (set! (html-dir) (html-dir))
- (if (not (equal? (html-dir) "."))
- (snd-display #__line__ ";html-dir set def: ~A" (html-dir)))
- (set! (html-program) (html-program))
- (if (not (equal? (html-program) "firefox"))
- (snd-display #__line__ ";html-program set def: ~A" (html-program)))
- (set! (just-sounds) (just-sounds))
- (if (not (equal? (just-sounds) #t))
- (snd-display #__line__ ";just-sounds set def: ~A" (just-sounds)))
- (set! (listener-prompt) (listener-prompt))
- (if (not (equal? (listener-prompt) ">" ))
- (snd-display #__line__ ";listener-prompt set def: ~A" (listener-prompt)))
- (set! (max-transform-peaks) (max-transform-peaks))
- (if (not (equal? (max-transform-peaks) 100))
- (snd-display #__line__ ";max-transform-peaks set def: ~A" (max-transform-peaks)))
- (set! (max-transform-peaks) -123)
- (if (not (equal? (max-transform-peaks) 100))
- (snd-display #__line__ ";max-transform-peaks set -123: ~A" (max-transform-peaks)))
- (set! (max-regions) (max-regions))
- (if (not (equal? (max-regions) 16 ))
- (snd-display #__line__ ";max-regions set def: ~A" (max-regions)))
- (set! (max-virtual-ptrees) (max-virtual-ptrees))
- (if (not (equal? (max-virtual-ptrees) 32 ))
- (snd-display #__line__ ";max-virtual-ptrees set def: ~A" (max-virtual-ptrees)))
- (set! (min-dB) (min-dB))
- (if (fneq (min-dB) -60.0 )
- (snd-display #__line__ ";min-dB set def: ~A" (min-dB)))
- (set! (log-freq-start) (log-freq-start))
- (if (fneq (log-freq-start) 32.0 )
- (snd-display #__line__ ";log-freq-start set def: ~A" (log-freq-start)))
- (set! (selection-creates-region) (selection-creates-region))
- (if (not (equal? (selection-creates-region) #t ))
- (snd-display #__line__ ";selection-creates-region set def: ~A" (selection-creates-region)))
- (set! (transform-normalization) (transform-normalization))
- (if (not (equal? (transform-normalization) normalize-by-channel))
- (snd-display #__line__ ";transform-normalization set def: ~A" (transform-normalization)))
- (set! (view-files-sort) (view-files-sort))
- (if (not (equal? (view-files-sort) 0 ))
- (snd-display #__line__ ";view-files-sort set def: ~A" (view-files-sort)))
- (set! (print-length) (print-length))
- (if (not (equal? (print-length) 12 ))
- (snd-display #__line__ ";print-length set def: ~A" (print-length)))
- (set! (play-arrow-size) (play-arrow-size))
- (if (not (equal? (play-arrow-size) 10 ))
- (snd-display #__line__ ";play-arrow-size set def: ~A" (play-arrow-size)))
- (set! (save-state-file) (save-state-file))
- (if (not (equal? (save-state-file) "saved-snd.scm" ))
- (snd-display #__line__ ";save-state-file set def: ~A" (save-state-file)))
- (set! (show-axes) (show-axes))
- (if (not (equal? (show-axes) 1))
- (snd-display #__line__ ";show-axes set def: ~A" (show-axes)))
- (set! (show-transform-peaks) (show-transform-peaks))
- (if (not (equal? (show-transform-peaks) #f ))
- (snd-display #__line__ ";show-transform-peaks set def: ~A" (show-transform-peaks)))
- (set! (show-indices) (show-indices))
- (if (not (equal? (show-indices) #f))
- (snd-display #__line__ ";show-indices set def: ~A" (show-indices)))
- (set! (show-marks) (show-marks))
- (if (not (equal? (show-marks) #t ))
- (snd-display #__line__ ";show-marks set def: ~A" (show-marks)))
- (set! (show-mix-waveforms) (show-mix-waveforms))
- (if (not (equal? (show-mix-waveforms) #t))
- (snd-display #__line__ ";show-mix-waveforms set def: ~A" (show-mix-waveforms)))
- (set! (show-selection-transform) (show-selection-transform))
- (if (not (equal? (show-selection-transform) #f ))
- (snd-display #__line__ ";show-selection-transform set def: ~A" (show-selection-transform)))
- (set! (show-y-zero) (show-y-zero))
- (if (not (equal? (show-y-zero) #f ))
- (snd-display #__line__ ";show-y-zero set def: ~A" (show-y-zero)))
- (set! (show-grid) (show-grid))
- (if (not (equal? (show-grid) #f ))
- (snd-display #__line__ ";show-grid set def: ~A" (show-grid)))
- (set! (grid-density) (grid-density))
- (if (fneq (grid-density) 1.0)
- (snd-display #__line__ ";grid-density set def: ~A" (grid-density)))
- (set! (show-sonogram-cursor) (show-sonogram-cursor))
- (if (not (equal? (show-sonogram-cursor) #f ))
- (snd-display #__line__ ";show-sonogram-cursor set def: ~A" (show-sonogram-cursor)))
- (set! (sinc-width) (sinc-width))
- (if (not (equal? (sinc-width) 10 ))
- (snd-display #__line__ ";sinc-width set def: ~A" (sinc-width)))
- (set! (spectrum-end) (spectrum-end))
- (if (fneq (spectrum-end) 1.0)
- (snd-display #__line__ ";spectrum-end set def: ~A" (spectrum-end)))
- (set! (spectro-hop) (spectro-hop))
- (if (not (equal? (spectro-hop) 4 ))
- (snd-display #__line__ ";spectro-hop set def: ~A" (spectro-hop)))
- (set! (spectrum-start) (spectrum-start))
- (if (fneq (spectrum-start) 0.0 )
- (snd-display #__line__ ";spectrum-start set def: ~A" (spectrum-start)))
- (set! (spectro-x-angle) (spectro-x-angle))
- (if (fneq (spectro-x-angle) (if (provided? 'gl) 300.0 90.0))
- (snd-display #__line__ ";spectro-x-angle set def: ~A" (spectro-x-angle)))
- (set! (spectro-x-scale) (spectro-x-scale))
- (if (fneq (spectro-x-scale) (if (provided? 'gl) 1.5 1.0))
- (snd-display #__line__ ";spectro-x-scale set def: ~A" (spectro-x-scale)))
- (set! (spectro-y-angle) (spectro-y-angle))
- (if (fneq (spectro-y-angle) (if (provided? 'gl) 320.0 0.0))
- (snd-display #__line__ ";spectro-y-angle set def: ~A" (spectro-y-angle)))
- (set! (spectro-y-scale) (spectro-y-scale))
- (if (fneq (spectro-y-scale) 1.0 )
- (snd-display #__line__ ";spectro-y-scale set def: ~A" (spectro-y-scale)))
- (set! (spectro-z-angle) (spectro-z-angle))
- (if (fneq (spectro-z-angle) (if (provided? 'gl) 0.0 358.0))
- (snd-display #__line__ ";spectro-z-angle set def: ~A" (spectro-z-angle)))
- (set! (spectro-z-scale) (spectro-z-scale))
- (if (fneq (spectro-z-scale) (if (provided? 'gl) 1.0 0.1))
- (snd-display #__line__ ";spectro-z-scale set def: ~A" (spectro-z-scale)))
- (set! (temp-dir) (temp-dir))
- (if (not (equal? (temp-dir) #f ))
- (snd-display #__line__ ";temp-dir set def: ~A" (temp-dir)))
- (set! (ladspa-dir) (ladspa-dir))
- (if (not (equal? (ladspa-dir) #f ))
- (snd-display #__line__ ";ladspa-dir set def: ~A" (ladspa-dir)))
- (set! (peak-env-dir) (peak-env-dir))
- (if (not (equal? (peak-env-dir) #f ))
- (snd-display #__line__ ";peak-env-dir set def: ~A" (peak-env-dir)))
- (set! (tiny-font) (tiny-font))
- (if (and (not (equal? (tiny-font) "6x12"))
- (not (equal? (tiny-font) "Sans 8")))
- (snd-display #__line__ ";tiny-font set def: ~A" (tiny-font)))
- (set! (transform-type) (transform-type))
- (if (not (equal? (transform-type) fourier-transform ))
- (snd-display #__line__ ";transform-type set def: ~A" (transform-type)))
- (set! (trap-segfault) (trap-segfault))
- (if (not (equal? (trap-segfault) #t))
- (snd-display #__line__ ";trap-segfault set def: ~A" (trap-segfault)))
- (set! (with-file-monitor) (with-file-monitor))
- (if (not (equal? (with-file-monitor) #t))
- (snd-display #__line__ ";with-file-monitor set def: ~A" (with-file-monitor)))
- (set! (optimization) (optimization))
- (if (not (equal? (optimization) 6))
- (snd-display #__line__ ";optimization set def: ~A" (optimization)))
- (set! (clm-table-size) (clm-table-size))
- (if (not (equal? (clm-table-size) 512))
- (snd-display #__line__ ";clm-table-size set def: ~A" (clm-table-size)))
- (set! (clm-default-frequency) (clm-default-frequency))
- (if (fneq (clm-default-frequency) 0.0)
- (snd-display #__line__ ";clm-default-frequency set def: ~A" (clm-default-frequency)))
- (set! (with-verbose-cursor) (with-verbose-cursor))
- (if (not (equal? (with-verbose-cursor) #f))
- (snd-display #__line__ ";with-verbose-cursor set def: ~A" (with-verbose-cursor)))
- (set! (with-inset-graph) (with-inset-graph))
- (if (not (equal? (with-inset-graph) #f))
- (snd-display #__line__ ";with-inset-graph set def: ~A" (with-inset-graph)))
- (set! (remember-sound-state) (remember-sound-state))
- (if (not (equal? (remember-sound-state) #f))
- (snd-display #__line__ ";remember-sound-state set def: ~A" (remember-sound-state)))
- (set! (with-smpte-label) (with-smpte-label))
- (if (not (equal? (with-smpte-label) #f))
- (snd-display #__line__ ";with-smpte-label set def: ~A" (with-smpte-label)))
- (set! (with-toolbar) (with-toolbar))
- (if (not (equal? (with-toolbar) (if (provided? 'snd-gtk) #t #f)))
- (snd-display #__line__ ";with-toolbar set def: ~A" (with-toolbar)))
- (set! (with-tooltips) (with-tooltips))
- (if (not (equal? (with-tooltips) #t))
- (snd-display #__line__ ";with-tooltips set def: ~A" (with-tooltips)))
- (set! (with-menu-icons) (with-menu-icons))
- (if (not (equal? (with-menu-icons) #f))
- (snd-display #__line__ ";with-menu-icons set def: ~A" (with-menu-icons)))
- (set! (save-as-dialog-src) (save-as-dialog-src))
- (if (not (equal? (save-as-dialog-src) #f))
- (snd-display #__line__ ";save-as-dialog-src set def: ~A" (save-as-dialog-src)))
- (set! (save-as-dialog-auto-comment) (save-as-dialog-auto-comment))
- (if (not (equal? (save-as-dialog-auto-comment) #f))
- (snd-display #__line__ ";save-as-dialog-auto-comment set def: ~A" (save-as-dialog-auto-comment)))
- (set! (with-pointer-focus) (with-pointer-focus))
- (if (not (equal? (with-pointer-focus) #f))
- (snd-display #__line__ ";with-pointer-focus set def: ~A" (with-pointer-focus)))
- (set! (wavelet-type) (wavelet-type))
- (if (not (equal? (wavelet-type) 0 ))
- (snd-display #__line__ ";wavelet-type set def: ~A" (wavelet-type)))
- (set! (time-graph-type) (time-graph-type))
- (if (not (equal? (time-graph-type) graph-once))
- (snd-display #__line__ ";time-graph-type set def: ~A" (time-graph-type)))
- (set! (wavo-hop) (wavo-hop))
- (if (not (equal? (wavo-hop) 3 ))
- (snd-display #__line__ ";wavo-hop set def: ~A" (wavo-hop)))
- (set! (wavo-trace) (wavo-trace))
- (if (not (equal? (wavo-trace) 64 ))
- (snd-display #__line__ ";wavo-trace set def: ~A" (wavo-trace)))
- (set! (x-axis-style) (x-axis-style))
- (if (not (equal? (x-axis-style) 0 ))
- (snd-display #__line__ ";x-axis-style set def: ~A" (x-axis-style)))
- (set! (beats-per-minute) (beats-per-minute))
- (if (fneq (beats-per-minute) 60.0 )
- (snd-display #__line__ ";beats-per-minute set def: ~A" (beats-per-minute)))
- (set! (beats-per-measure) (beats-per-measure))
- (if (not (= (beats-per-measure) 4))
- (snd-display #__line__ ";beats-per-measure set def: ~A" (beats-per-measure)))
- (set! (zero-pad) (zero-pad))
- (if (not (equal? (zero-pad) 0))
- (snd-display #__line__ ";zero-pad set def: ~A" (zero-pad)))
- (set! (zero-pad) -123)
- (if (not (equal? (zero-pad) 0))
- (snd-display #__line__ ";zero-pad set -123: ~A" (zero-pad)))
- (if (not (equal? (zero-pad #t #t) '()))
+ (if (not (equal? *region-graph-style* graph-lines))
+ (snd-display #__line__ ";region-graph-style set default: ~A" *region-graph-style*))
+ (if *ask-about-unsaved-edits*
+ (snd-display #__line__ ";ask-about-unsaved-edits set default: ~A" *ask-about-unsaved-edits*))
+ (if (not (boolean? *show-full-duration*))
+ (snd-display #__line__ ";show-full-duration set default: ~A" *show-full-duration*))
+ (if *show-full-range*
+ (snd-display #__line__ ";show-full-range set default: ~A" *show-full-range*))
+ (if (fneq *initial-beg* 0.0)
+ (snd-display #__line__ ";initial-beg set default: ~A" *initial-beg*))
+ (if (fneq *initial-dur* 0.1)
+ (snd-display #__line__ ";initial-dur set default: ~A" *initial-dur*))
+ (if *ask-before-overwrite*
+ (snd-display #__line__ ";ask-before-overwrite set default: ~A" *ask-before-overwrite*))
+ (if (not *auto-resize*)
+ (snd-display #__line__ ";auto-resize set default: ~A" *auto-resize*))
+ (if *auto-update*
+ (snd-display #__line__ ";auto-update set default: ~A" *auto-update*))
+ (if (not (eqv? *channel-style* 1 ))
+ (snd-display #__line__ ";channel-style set default: ~A" *channel-style*))
+ (if (and (fneq *color-cutoff* 0.003 ) (fneq *color-cutoff* 0.001))
+ (snd-display #__line__ ";color-cutoff set default: ~A" *color-cutoff*))
+ (if (not *color-inverted*)
+ (snd-display #__line__ ";color-inverted set default: ~A" *color-inverted*))
+ (if (fneq *color-scale* 1.0 )
+ (snd-display #__line__ ";color-scale set default: ~A" *color-scale*))
+ (if (fneq *auto-update-interval* 60.0 )
+ (snd-display #__line__ ";auto-update-interval set default: ~A" *auto-update-interval*))
+ (if (fneq *cursor-update-interval* 0.05 )
+ (snd-display #__line__ ";cursor-update-interval set default: ~A" *cursor-update-interval*))
+ (if (not (= *cursor-location-offset* 0))
+ (snd-display #__line__ ";cursor-location-offset set default: ~A" *cursor-location-offset*))
+ (if (not *dac-combines-channels*)
+ (snd-display #__line__ ";dac-combines-channels set default: ~A" *dac-combines-channels*))
+ (if (not (eqv? *dac-size* 256 ))
+ (snd-display #__line__ ";dac-size set default: ~A" *dac-size*))
+ (if *clipping*
+ (snd-display #__line__ ";clipping set default: ~A" *clipping*))
+ (if (not (eqv? *default-output-chans* 1 ))
+ (snd-display #__line__ ";default-output-chans set default: ~A" *default-output-chans*))
+ (if (and (not (equal? *default-output-sample-type* mus-bdouble))
+ (not (equal? *default-output-sample-type* mus-ldouble)))
+ (snd-display #__line__ ";default-output-sample-type set default: ~A" *default-output-sample-type*))
+ (if (not (eqv? *default-output-srate* 44100 ))
+ (snd-display #__line__ ";default-output-srate set default: ~A" *default-output-srate*))
+ (if (not (equal? *default-output-header-type* mus-next))
+ (snd-display #__line__ ";default-output-header-type set default: ~A" *default-output-header-type*))
+ (if (not (eqv? *dot-size* 1 ))
+ (snd-display #__line__ ";dot-size set default: ~A" *dot-size*))
+ (if (not (eqv? *cursor-size* 15 ))
+ (snd-display #__line__ ";cursor-size set default: ~A" *cursor-size*))
+ (if (not (equal? *cursor-style* cursor-cross ))
+ (snd-display #__line__ ";cursor-style set default: ~A" *cursor-style*))
+ (if (not (equal? *tracking-cursor-style* cursor-line ))
+ (snd-display #__line__ ";tracking-cursor-style set default: ~A" *tracking-cursor-style*))
+ (if (fneq *enved-base* 1.0 )
+ (snd-display #__line__ ";enved-base set default: ~A" *enved-base*))
+ (if (not (enved-clip?))
+ (snd-display #__line__ ";enved-clip? set default: ~A" (enved-clip?)))
+ (if (not (enved-filter))
+ (snd-display #__line__ ";enved-filter set default: ~A" (enved-filter)))
+ (if (not (eqv? *enved-filter-order* 40))
+ (snd-display #__line__ ";enved-filter-order set default: ~A" *enved-filter-order*))
+ (if (enved-in-dB)
+ (snd-display #__line__ ";enved-in-dB set default: ~A" (enved-in-dB)))
+ (if (not (equal? *enved-style* envelope-linear ))
+ (snd-display #__line__ ";enved-style set default: ~A" *enved-style*))
+ (if (fneq *enved-power* 3.0)
+ (snd-display #__line__ ";enved-power set default: ~A" *enved-power*))
+ (if (not (eqv? *enved-target* 0 ))
+ (snd-display #__line__ ";enved-target set default: ~A" *enved-target*))
+ (if *enved-wave?*
+ (snd-display #__line__ ";enved-wave? set default: ~A" *enved-wave?*))
+ (if (and with-gui
+ (pair? (enved-envelope)))
+ (snd-display #__line__ ";enved-envelope set default: ~A" (enved-envelope)))
+ (if (not (equal? *eps-file* "snd.eps" ))
+ (snd-display #__line__ ";eps-file set default: ~A" *eps-file*))
+ (if (fneq *eps-bottom-margin* 0.0)
+ (snd-display #__line__ ";eps-bottom-margin set default: ~A" *eps-bottom-margin*))
+ (if (fneq *eps-left-margin* 0.0)
+ (snd-display #__line__ ";eps-left-margin set default: ~A" *eps-left-margin*))
+ (if (fneq *eps-size* 1.0)
+ (snd-display #__line__ ";eps-size set default: ~A" *eps-size*))
+ (if (fneq *fft-window-alpha* 0.0 )
+ (snd-display #__line__ ";fft-window-alpha set default: ~A" *fft-window-alpha*))
+ (if (fneq *fft-window-beta* 0.0 )
+ (snd-display #__line__ ";fft-window-beta set default: ~A" *fft-window-beta*))
+ (if *fft-log-frequency*
+ (snd-display #__line__ ";fft-log-frequency set default: ~A" *fft-log-frequency*))
+ (if *fft-log-magnitude*
+ (snd-display #__line__ ";fft-log-magnitude set default: ~A" *fft-log-magnitude*))
+ (if *fft-with-phases*
+ (snd-display #__line__ ";fft-with-phases set default: ~A" *fft-with-phases*))
+ (if (not (member *transform-size* (list 1024 4096)))
+ (snd-display #__line__ ";transform-size set default: ~A" *transform-size*))
+ (if (not (equal? *transform-graph-type* graph-once))
+ (snd-display #__line__ ";transform-graph-type set default: ~A" *transform-graph-type*))
+ (if (not (eqv? *fft-window* 6 ))
+ (snd-display #__line__ ";fft-window set default: ~A" *fft-window*))
+ (if (not (eqv? *graph-cursor* 34))
+ (snd-display #__line__ ";graph-cursor set default: ~A" *graph-cursor*))
+ (if (not (equal? *graph-style* graph-lines ))
+ (snd-display #__line__ ";graph-style set default: ~A" *graph-style*))
+ (if (not *graphs-horizontal*)
+ (snd-display #__line__ ";graphs-horizontal set default: ~A" *graphs-horizontal*))
+ (if (not (equal? *html-dir* "."))
+ (snd-display #__line__ ";html-dir set default: ~A" *html-dir*))
+ (if (not (equal? *html-program* "firefox"))
+ (snd-display #__line__ ";html-program set default: ~A" *html-program*))
+ (if (not *just-sounds*)
+ (snd-display #__line__ ";just-sounds set default: ~A" *just-sounds*))
+ (if (not (string? *listener-prompt*))
+ (snd-display #__line__ ";listener-prompt set default: ~A" *listener-prompt*))
+ (if (not (eqv? *max-transform-peaks* 100))
+ (snd-display #__line__ ";max-transform-peaks set default: ~A" *max-transform-peaks*))
+ (if (not (eqv? *max-transform-peaks* 100))
+ (snd-display #__line__ ";max-transform-peaks set -123: ~A" *max-transform-peaks*))
+ (if (not (eqv? *max-regions* 16 ))
+ (snd-display #__line__ ";max-regions set default: ~A" *max-regions*))
+ (if (fneq *min-dB* -60.0 )
+ (snd-display #__line__ ";min-dB set default: ~A" *min-dB*))
+ (if (fneq *log-freq-start* 32.0 )
+ (snd-display #__line__ ";log-freq-start set default: ~A" *log-freq-start*))
+ (if (not *selection-creates-region*)
+ (snd-display #__line__ ";selection-creates-region set default: ~A" *selection-creates-region*))
+ (if (not (equal? *transform-normalization* normalize-by-channel))
+ (snd-display #__line__ ";transform-normalization set default: ~A" *transform-normalization*))
+
+ (if (and with-motif
+ (not (eqv? (view-files-sort) 0 )))
+ (snd-display #__line__ ";view-files-sort set default: ~A" (view-files-sort)))
+
+ (if (not (member *print-length* '(12 32) ))
+ (snd-display #__line__ ";print-length set default: ~A" *print-length*))
+ (if (not (eqv? *play-arrow-size* 10 ))
+ (snd-display #__line__ ";play-arrow-size set default: ~A" *play-arrow-size*))
+ (if (not (equal? *save-state-file* "saved-snd.scm" ))
+ (snd-display #__line__ ";save-state-file set default: ~A" *save-state-file*))
+ (if (not (eqv? *show-axes* 1))
+ (snd-display #__line__ ";show-axes set default: ~A" *show-axes*))
+ (if (not (boolean? *show-transform-peaks*))
+ (snd-display #__line__ ";show-transform-peaks set default: ~A" *show-transform-peaks*))
+ (if (not (boolean? *show-indices*))
+ (snd-display #__line__ ";show-indices set default: ~A" *show-indices*))
+ (if (not *show-marks*)
+ (snd-display #__line__ ";show-marks set default: ~A" *show-marks*))
+ (if (not *show-mix-waveforms*)
+ (snd-display #__line__ ";show-mix-waveforms set default: ~A" *show-mix-waveforms*))
+ (if *show-selection-transform*
+ (snd-display #__line__ ";show-selection-transform set default: ~A" *show-selection-transform*))
+ (if *show-y-zero*
+ (snd-display #__line__ ";show-y-zero set default: ~A" *show-y-zero*))
+ (if *show-grid*
+ (snd-display #__line__ ";show-grid set default: ~A" *show-grid*))
+ (if (fneq *grid-density* 1.0)
+ (snd-display #__line__ ";grid-density set default: ~A" *grid-density*))
+ (if *show-sonogram-cursor*
+ (snd-display #__line__ ";show-sonogram-cursor set default: ~A" *show-sonogram-cursor*))
+ (if (not (eqv? *sinc-width* 10 ))
+ (snd-display #__line__ ";sinc-width set default: ~A" *sinc-width*))
+ (if (fneq *spectrum-end* 1.0)
+ (snd-display #__line__ ";spectrum-end set default: ~A" *spectrum-end*))
+ (if (not (eqv? *spectro-hop* 4 ))
+ (snd-display #__line__ ";spectro-hop set default: ~A" *spectro-hop*))
+ (if (fneq *spectrum-start* 0.0 )
+ (snd-display #__line__ ";spectrum-start set default: ~A" *spectrum-start*))
+ (if (fneq *spectro-x-angle* (if (provided? 'gl) 300.0 90.0))
+ (snd-display #__line__ ";spectro-x-angle set default: ~A" *spectro-x-angle*))
+ (if (fneq *spectro-x-scale* (if (provided? 'gl) 1.5 1.0))
+ (snd-display #__line__ ";spectro-x-scale set default: ~A" *spectro-x-scale*))
+ (if (fneq *spectro-y-angle* (if (provided? 'gl) 320.0 0.0))
+ (snd-display #__line__ ";spectro-y-angle set default: ~A" *spectro-y-angle*))
+ (if (fneq *spectro-y-scale* 1.0 )
+ (snd-display #__line__ ";spectro-y-scale set default: ~A" *spectro-y-scale*))
+ (if (fneq *spectro-z-angle* (if (provided? 'gl) 0.0 358.0))
+ (snd-display #__line__ ";spectro-z-angle set default: ~A" *spectro-z-angle*))
+ (if (fneq *spectro-z-scale* (if (provided? 'gl) 1.0 0.1))
+ (snd-display #__line__ ";spectro-z-scale set default: ~A" *spectro-z-scale*))
+ (if (and *temp-dir* (not (equal? *temp-dir* "/home/bil/zap/tmp")))
+ (snd-display #__line__ ";temp-dir set default: ~A" *temp-dir*))
+ (if (not (equal? *ladspa-dir* "" ))
+ (snd-display #__line__ ";ladspa-dir set default: ~A" *ladspa-dir*))
+ (if (and *peak-env-dir* (not (equal? *peak-env-dir* "/home/bil/peaks")))
+ (snd-display #__line__ ";peak-env-dir set default: ~A" *peak-env-dir*))
+ (if (and (not (equal? *tiny-font* "6x12"))
+ (not (equal? *tiny-font* "Sans 8")))
+ (snd-display #__line__ ";tiny-font set default: ~A" *tiny-font*))
+ (if (not (equal? *transform-type* fourier-transform ))
+ (snd-display #__line__ ";transform-type set default: ~A" *transform-type*))
+ (if (not (eq? *with-file-monitor* #t))
+ (snd-display #__line__ ";with-file-monitor set default: ~A" *with-file-monitor*))
+ (if (not (eqv? *clm-table-size* 512))
+ (snd-display #__line__ ";clm-table-size set default: ~A" *clm-table-size*))
+ (if (not (eqv? *clm-table-size* 512))
+ (snd-display #__line__ ";*clm-table-size*: ~A" *clm-table-size*))
+ (if (fneq *clm-default-frequency* 0.0)
+ (snd-display #__line__ ";clm-default-frequency set default: ~A" *clm-default-frequency*))
+ (if (fneq *clm-default-frequency* 0.0)
+ (snd-display #__line__ ";*clm-default-frequency*: ~A" *clm-default-frequency*))
+ (if (not (boolean? *with-verbose-cursor*))
+ (snd-display #__line__ ";with-verbose-cursor set default: ~A" *with-verbose-cursor*))
+ (if (not (boolean? *with-inset-graph*))
+ (snd-display #__line__ ";with-inset-graph set default: ~A" *with-inset-graph*))
+ (if (not *with-interrupts*)
+ (snd-display #__line__ ";with-interrupts set default: ~A" *with-interrupts*))
+ (if *remember-sound-state*
+ (snd-display #__line__ ";remember-sound-state set default: ~A" *remember-sound-state*))
+ (if *with-smpte-label*
+ (snd-display #__line__ ";with-smpte-label set default: ~A" *with-smpte-label*))
+ (if (not (eq? *with-toolbar* (provided? 'snd-gtk)))
+ (snd-display #__line__ ";with-toolbar set default: ~A" *with-toolbar*))
+ (if (not *with-tooltips*)
+ (snd-display #__line__ ";with-tooltips set default: ~A" *with-tooltips*))
+ (if (not (boolean? *with-menu-icons*))
+ (snd-display #__line__ ";with-menu-icons set default: ~A" *with-menu-icons*))
+ (if *save-as-dialog-src*
+ (snd-display #__line__ ";save-as-dialog-src set default: ~A" *save-as-dialog-src*))
+ (if *save-as-dialog-auto-comment*
+ (snd-display #__line__ ";save-as-dialog-auto-comment set default: ~A" *save-as-dialog-auto-comment*))
+ (if (not (boolean? *with-pointer-focus*))
+ (snd-display #__line__ ";with-pointer-focus set default: ~A" *with-pointer-focus*))
+ (if (not (eqv? *wavelet-type* 0 ))
+ (snd-display #__line__ ";wavelet-type set default: ~A" *wavelet-type*))
+ (if (not (equal? *time-graph-type* graph-once))
+ (snd-display #__line__ ";time-graph-type set default: ~A" *time-graph-type*))
+ (if (not (eqv? *wavo-hop* 3 ))
+ (snd-display #__line__ ";wavo-hop set default: ~A" *wavo-hop*))
+ (if (not (eqv? *wavo-trace* 64 ))
+ (snd-display #__line__ ";wavo-trace set default: ~A" *wavo-trace*))
+ (if (not (eqv? *x-axis-style* 0 ))
+ (snd-display #__line__ ";x-axis-style set default: ~A" *x-axis-style*))
+ (if (fneq *beats-per-minute* 60.0 )
+ (snd-display #__line__ ";beats-per-minute set default: ~A" *beats-per-minute*))
+ (if (not (= *beats-per-measure* 4))
+ (snd-display #__line__ ";beats-per-measure set default: ~A" *beats-per-measure*))
+ (if (not (eqv? *zero-pad* 0))
+ (snd-display #__line__ ";zero-pad set default: ~A" *zero-pad*))
+ (if (not (eqv? *zero-pad* 0))
+ (snd-display #__line__ ";zero-pad set -123: ~A" *zero-pad*))
+ (if (not (null? (zero-pad #t #t)))
(snd-display #__line__ ";zero-pad #t: ~A" (zero-pad #t #t)))
- (set! (zoom-focus-style) (zoom-focus-style))
- (if (not (equal? (zoom-focus-style) 2 ))
- (snd-display #__line__ ";zoom-focus-style set def: ~A" (zoom-focus-style)))
- (set! (sync-style) sync-by-sound)
- (if (not (equal? (sync-style) sync-by-sound ))
- (snd-display #__line__ ";sync-style set def: ~A" (sync-style)))
- (set! (mix-waveform-height) (mix-waveform-height))
- (if (not (equal? (mix-waveform-height) 20 ))
- (snd-display #__line__ ";mix-waveform-height set def: ~A" (mix-waveform-height)))
- (set! (mix-tag-width) (mix-tag-width))
- (if (not (equal? (mix-tag-width) 6))
- (snd-display #__line__ ";mix-tag-width set def: ~A" (mix-tag-width)))
- (set! (mix-tag-height) (mix-tag-height))
- (if (not (equal? (mix-tag-height) 14))
- (snd-display #__line__ ";mix-tag-height set def: ~A" (mix-tag-height)))
- (set! (mark-tag-width) (mark-tag-width))
- (if (not (equal? (mark-tag-width) 10))
- (snd-display #__line__ ";mark-tag-width set def: ~A" (mark-tag-width)))
- (set! (mark-tag-height) (mark-tag-height))
- (if (not (equal? (mark-tag-height) 4))
- (snd-display #__line__ ";mark-tag-height set def: ~A" (mark-tag-height)))
- (set! (audio-output-device) (audio-output-device))
- (if (not (equal? (audio-output-device) 0 ))
- (snd-display #__line__ ";audio-output-device set def: ~A" (audio-output-device)))
- (set! (view-files-sort) (view-files-sort))
- (if (not (= (view-files-sort) 0))
+ (if (not (eqv? *zoom-focus-style* 2 ))
+ (snd-display #__line__ ";zoom-focus-style set default: ~A" *zoom-focus-style*))
+ (if (not (equal? *sync-style* sync-by-sound ))
+ (snd-display #__line__ ";sync-style set default: ~A" *sync-style*))
+ (if (not (eqv? *mix-waveform-height* 20 ))
+ (snd-display #__line__ ";mix-waveform-height set default: ~A" *mix-waveform-height*))
+ (if (not (eqv? *mix-tag-width* 6))
+ (snd-display #__line__ ";mix-tag-width set default: ~A" *mix-tag-width*))
+ (if (not (eqv? *mix-tag-height* 14))
+ (snd-display #__line__ ";mix-tag-height set default: ~A" *mix-tag-height*))
+ (if (not (eqv? *mark-tag-width* 10))
+ (snd-display #__line__ ";mark-tag-width set default: ~A" *mark-tag-width*))
+ (if (not (eqv? *mark-tag-height* 4))
+ (snd-display #__line__ ";mark-tag-height set default: ~A" *mark-tag-height*))
+
+ (if (not (equal? *region-graph-style* graph-lines))
+ (snd-display #__line__ ";* region-graph-style set default: ~A" *region-graph-style*))
+ (if *ask-about-unsaved-edits*
+ (snd-display #__line__ ";* ask-about-unsaved-edits set default: ~A" *ask-about-unsaved-edits*))
+ (if *show-full-range*
+ (snd-display #__line__ ";* show-full-range set default: ~A" *show-full-range*))
+ (if (fneq *initial-beg* 0.0)
+ (snd-display #__line__ ";* initial-beg set default: ~A" *initial-beg*))
+ (if (fneq *initial-dur* 0.1)
+ (snd-display #__line__ ";* initial-dur set default: ~A" *initial-dur*))
+ (if *ask-before-overwrite*
+ (snd-display #__line__ ";* ask-before-overwrite set default: ~A" *ask-before-overwrite*))
+ (if (not *auto-resize*)
+ (snd-display #__line__ ";* auto-resize set default: ~A" *auto-resize*))
+ (if *auto-update*
+ (snd-display #__line__ ";* auto-update set default: ~A" *auto-update*))
+ (if (not (eqv? *channel-style* 1 ))
+ (snd-display #__line__ ";* channel-style set default: ~A" *channel-style*))
+ (if (and (fneq *color-cutoff* 0.003 ) (fneq *color-cutoff* 0.001))
+ (snd-display #__line__ ";* color-cutoff set default: ~A" *color-cutoff*))
+ (if (not (eq? *color-inverted* #t))
+ (snd-display #__line__ ";* color-inverted set default: ~A" *color-inverted*))
+ (if (fneq *color-scale* 1.0 )
+ (snd-display #__line__ ";* color-scale set default: ~A" *color-scale*))
+ (if (fneq *auto-update-interval* 60.0 )
+ (snd-display #__line__ ";* auto-update-interval set default: ~A" *auto-update-interval*))
+ (if (fneq *cursor-update-interval* 0.05 )
+ (snd-display #__line__ ";* cursor-update-interval set default: ~A" *cursor-update-interval*))
+ (if (not (= *cursor-location-offset* 0))
+ (snd-display #__line__ ";* cursor-location-offset set default: ~A" *cursor-location-offset*))
+ (if (not (eq? *dac-combines-channels* #t))
+ (snd-display #__line__ ";* dac-combines-channels set default: ~A" *dac-combines-channels*))
+ (if (not (eqv? *dac-size* 256 ))
+ (snd-display #__line__ ";* dac-size set default: ~A" *dac-size*))
+ (if *clipping*
+ (snd-display #__line__ ";* clipping set default: ~A" *clipping*))
+ (if (not (eqv? *default-output-chans* 1 ))
+ (snd-display #__line__ ";* default-output-chans set default: ~A" *default-output-chans*))
+ (if (and (not (equal? *default-output-sample-type* mus-bdouble))
+ (not (equal? *default-output-sample-type* mus-ldouble)))
+ (snd-display #__line__ ";* default-output-sample-type set default: ~A" *default-output-sample-type*))
+ (if (not (eqv? *default-output-srate* 44100 ))
+ (snd-display #__line__ ";* default-output-srate set default: ~A" *default-output-srate*))
+ (if (not (equal? *default-output-header-type* mus-next))
+ (snd-display #__line__ ";* default-output-header-type set default: ~A" *default-output-header-type*))
+ (if (not (eqv? *dot-size* 1 ))
+ (snd-display #__line__ ";* dot-size set default: ~A" *dot-size*))
+ (if (not (eqv? *cursor-size* 15 ))
+ (snd-display #__line__ ";* cursor-size set default: ~A" *cursor-size*))
+ (if (not (equal? *cursor-style* cursor-cross ))
+ (snd-display #__line__ ";* cursor-style set default: ~A" *cursor-style*))
+ (if (not (equal? *tracking-cursor-style* cursor-line ))
+ (snd-display #__line__ ";* tracking-cursor-style set default: ~A" *tracking-cursor-style*))
+ (if (fneq *enved-base* 1.0 )
+ (snd-display #__line__ ";* enved-base set default: ~A" *enved-base*))
+ (if (not (eqv? *enved-filter-order* 40))
+ (snd-display #__line__ ";* enved-filter-order set default: ~A" *enved-filter-order*))
+ (if (not (equal? *enved-style* envelope-linear ))
+ (snd-display #__line__ ";* enved-style set default: ~A" *enved-style*))
+ (if (fneq *enved-power* 3.0)
+ (snd-display #__line__ ";* enved-power set default: ~A" *enved-power*))
+ (if (not (eqv? *enved-target* 0 ))
+ (snd-display #__line__ ";* enved-target set default: ~A" *enved-target*))
+ (if *enved-wave?*
+ (snd-display #__line__ ";* enved-wave? set default: ~A" *enved-wave?*))
+ (if (not (equal? *eps-file* "snd.eps" ))
+ (snd-display #__line__ ";* eps-file set default: ~A" *eps-file*))
+ (if (fneq *eps-bottom-margin* 0.0)
+ (snd-display #__line__ ";* eps-bottom-margin set default: ~A" *eps-bottom-margin*))
+ (if (fneq *eps-left-margin* 0.0)
+ (snd-display #__line__ ";* eps-left-margin set default: ~A" *eps-left-margin*))
+ (if (fneq *eps-size* 1.0)
+ (snd-display #__line__ ";* eps-size set default: ~A" *eps-size*))
+ (if (fneq *fft-window-alpha* 0.0 )
+ (snd-display #__line__ ";* fft-window-alpha set default: ~A" *fft-window-alpha*))
+ (if (fneq *fft-window-beta* 0.0 )
+ (snd-display #__line__ ";* fft-window-beta set default: ~A" *fft-window-beta*))
+ (if *fft-log-frequency*
+ (snd-display #__line__ ";* fft-log-frequency set default: ~A" *fft-log-frequency*))
+ (if *fft-log-magnitude*
+ (snd-display #__line__ ";* fft-log-magnitude set default: ~A" *fft-log-magnitude*))
+ (if *fft-with-phases*
+ (snd-display #__line__ ";* fft-with-phases set default: ~A" *fft-with-phases*))
+ (if (not (member *transform-size* (list 1024 4096)))
+ (snd-display #__line__ ";* transform-size set default: ~A" *transform-size*))
+ (if (not (equal? *transform-graph-type* graph-once))
+ (snd-display #__line__ ";* transform-graph-type set default: ~A" *transform-graph-type*))
+ (if (not (eqv? *fft-window* 6 ))
+ (snd-display #__line__ ";* fft-window set default: ~A" *fft-window*))
+ (if (not (eqv? *graph-cursor* 34))
+ (snd-display #__line__ ";* graph-cursor set default: ~A" *graph-cursor*))
+ (if (not (equal? *graph-style* graph-lines ))
+ (snd-display #__line__ ";* graph-style set default: ~A" *graph-style*))
+ (if (not *graphs-horizontal*)
+ (snd-display #__line__ ";* graphs-horizontal set default: ~A" *graphs-horizontal*))
+ (if (not (equal? *html-dir* "."))
+ (snd-display #__line__ ";* html-dir set default: ~A" *html-dir*))
+ (if (not (equal? *html-program* "firefox"))
+ (snd-display #__line__ ";* html-program set default: ~A" *html-program*))
+ (if (not *just-sounds*)
+ (snd-display #__line__ ";* just-sounds set default: ~A" *just-sounds*))
+ (if (not (eqv? *max-transform-peaks* 100))
+ (snd-display #__line__ ";* max-transform-peaks set default: ~A" *max-transform-peaks*))
+ (if (not (eqv? *max-transform-peaks* 100))
+ (snd-display #__line__ ";* max-transform-peaks set -123: ~A" *max-transform-peaks*))
+ (if (not (eqv? *max-regions* 16 ))
+ (snd-display #__line__ ";* max-regions set default: ~A" *max-regions*))
+ (if (fneq *min-dB* -60.0 )
+ (snd-display #__line__ ";* min-dB set default: ~A" *min-dB*))
+ (if (fneq *log-freq-start* 32.0 )
+ (snd-display #__line__ ";* log-freq-start set default: ~A" *log-freq-start*))
+ (if (not (eq? *selection-creates-region* #t ))
+ (snd-display #__line__ ";* selection-creates-region set default: ~A" *selection-creates-region*))
+ (if (not (equal? *transform-normalization* normalize-by-channel))
+ (snd-display #__line__ ";* transform-normalization set default: ~A" *transform-normalization*))
+
+ (if (and with-motif
+ (not (eqv? *view-files-sort* 0 )) )
+ (snd-display #__line__ ";* view-files-sort set default: ~A" *view-files-sort*))
+
+ (if (not (eqv? *play-arrow-size* 10 ))
+ (snd-display #__line__ ";* play-arrow-size set default: ~A" *play-arrow-size*))
+ (if (not (equal? *save-state-file* "saved-snd.scm" ))
+ (snd-display #__line__ ";* save-state-file set default: ~A" *save-state-file*))
+ (if (not (eqv? *show-axes* 1))
+ (snd-display #__line__ ";* show-axes set default: ~A" *show-axes*))
+ (if (not *show-marks*)
+ (snd-display #__line__ ";* show-marks set default: ~A" *show-marks*))
+ (if (not *show-mix-waveforms*)
+ (snd-display #__line__ ";* show-mix-waveforms set default: ~A" *show-mix-waveforms*))
+ (if *show-selection-transform*
+ (snd-display #__line__ ";* show-selection-transform set default: ~A" *show-selection-transform*))
+ (if *show-y-zero*
+ (snd-display #__line__ ";* show-y-zero set default: ~A" *show-y-zero*))
+ (if *show-grid*
+ (snd-display #__line__ ";* show-grid set default: ~A" *show-grid*))
+ (if (fneq *grid-density* 1.0)
+ (snd-display #__line__ ";* grid-density set default: ~A" *grid-density*))
+ (if *show-sonogram-cursor*
+ (snd-display #__line__ ";* show-sonogram-cursor set default: ~A" *show-sonogram-cursor*))
+ (if (not (eqv? *sinc-width* 10 ))
+ (snd-display #__line__ ";* sinc-width set default: ~A" *sinc-width*))
+ (if (fneq *spectrum-end* 1.0)
+ (snd-display #__line__ ";* spectrum-end set default: ~A" *spectrum-end*))
+ (if (not (eqv? *spectro-hop* 4 ))
+ (snd-display #__line__ ";* spectro-hop set default: ~A" *spectro-hop*))
+ (if (fneq *spectrum-start* 0.0 )
+ (snd-display #__line__ ";* spectrum-start set default: ~A" *spectrum-start*))
+ (if (fneq *spectro-x-angle* (if (provided? 'gl) 300.0 90.0))
+ (snd-display #__line__ ";* spectro-x-angle set default: ~A" *spectro-x-angle*))
+ (if (fneq *spectro-x-scale* (if (provided? 'gl) 1.5 1.0))
+ (snd-display #__line__ ";* spectro-x-scale set default: ~A" *spectro-x-scale*))
+ (if (fneq *spectro-y-angle* (if (provided? 'gl) 320.0 0.0))
+ (snd-display #__line__ ";* spectro-y-angle set default: ~A" *spectro-y-angle*))
+ (if (fneq *spectro-y-scale* 1.0 )
+ (snd-display #__line__ ";* spectro-y-scale set default: ~A" *spectro-y-scale*))
+ (if (fneq *spectro-z-angle* (if (provided? 'gl) 0.0 358.0))
+ (snd-display #__line__ ";* spectro-z-angle set default: ~A" *spectro-z-angle*))
+ (if (fneq *spectro-z-scale* (if (provided? 'gl) 1.0 0.1))
+ (snd-display #__line__ ";* spectro-z-scale set default: ~A" *spectro-z-scale*))
+ (if (and (not (equal? *tiny-font* "6x12"))
+ (not (equal? *tiny-font* "Sans 8")))
+ (snd-display #__line__ ";* tiny-font set default: ~A" *tiny-font*))
+ (if (not *with-file-monitor*)
+ (snd-display #__line__ ";* with-file-monitor set default: ~A" *with-file-monitor*))
+ (if (not *with-interrupts*)
+ (snd-display #__line__ ";* with-interrupts set default: ~A" *with-interrupts*))
+ (if *remember-sound-state*
+ (snd-display #__line__ ";* remember-sound-state set default: ~A" *remember-sound-state*))
+ (if *with-smpte-label*
+ (snd-display #__line__ ";* with-smpte-label set default: ~A" *with-smpte-label*))
+ (if (not (eq? *with-toolbar* (provided? 'snd-gtk)))
+ (snd-display #__line__ ";* with-toolbar set default: ~A" *with-toolbar*))
+ (if (not *with-tooltips*)
+ (snd-display #__line__ ";* with-tooltips set default: ~A" *with-tooltips*))
+ (if *save-as-dialog-src*
+ (snd-display #__line__ ";* save-as-dialog-src set default: ~A" *save-as-dialog-src*))
+ (if *save-as-dialog-auto-comment*
+ (snd-display #__line__ ";* save-as-dialog-auto-comment set default: ~A" *save-as-dialog-auto-comment*))
+ (if (not (eqv? *wavelet-type* 0 ))
+ (snd-display #__line__ ";* wavelet-type set default: ~A" *wavelet-type*))
+ (if (not (equal? *time-graph-type* graph-once))
+ (snd-display #__line__ ";* time-graph-type set default: ~A" *time-graph-type*))
+ (if (not (eqv? *wavo-hop* 3 ))
+ (snd-display #__line__ ";* wavo-hop set default: ~A" *wavo-hop*))
+ (if (not (eqv? *wavo-trace* 64 ))
+ (snd-display #__line__ ";* wavo-trace set default: ~A" *wavo-trace*))
+ (if (not (eqv? *x-axis-style* 0 ))
+ (snd-display #__line__ ";* x-axis-style set default: ~A" *x-axis-style*))
+ (if (fneq *beats-per-minute* 60.0 )
+ (snd-display #__line__ ";* beats-per-minute set default: ~A" *beats-per-minute*))
+ (if (not (= *beats-per-measure* 4))
+ (snd-display #__line__ ";* beats-per-measure set default: ~A" *beats-per-measure*))
+ (if (not (eqv? *zero-pad* 0))
+ (snd-display #__line__ ";* zero-pad set default: ~A" *zero-pad*))
+ (if (not (eqv? *zoom-focus-style* 2 ))
+ (snd-display #__line__ ";* zoom-focus-style set default: ~A" *zoom-focus-style*))
+ (if (not (equal? *sync-style* sync-by-sound ))
+ (snd-display #__line__ ";* sync-style set default: ~A" *sync-style*))
+ (if (not (eqv? *mix-waveform-height* 20 ))
+ (snd-display #__line__ ";* mix-waveform-height set default: ~A" *mix-waveform-height*))
+ (if (not (eqv? *mix-tag-width* 6))
+ (snd-display #__line__ ";* mix-tag-width set default: ~A" *mix-tag-width*))
+ (if (not (eqv? *mix-tag-height* 14))
+ (snd-display #__line__ ";* mix-tag-height set default: ~A" *mix-tag-height*))
+ (if (not (eqv? *mark-tag-width* 10))
+ (snd-display #__line__ ";* mark-tag-width set default: ~A" *mark-tag-width*))
+ (if (not (eqv? *mark-tag-height* 4))
+ (snd-display #__line__ ";* mark-tag-height set default: ~A" *mark-tag-height*))
+
+ (if (and with-motif
+ (not (= (view-files-sort) 0)))
(snd-display #__line__ ";view-files-sort def: ~A" (view-files-sort)))
(if (> most-positive-fixnum (expt 2 36))
(begin
- (let ((old-max-malloc (mus-max-malloc)))
- (set! (mus-max-malloc) (expt 2 36))
- (if (not (= (mus-max-malloc) (expt 2 36)))
- (snd-display #__line__ ";mus-max-malloc as bignum: ~A" (mus-max-malloc)))
- (set! (mus-max-malloc) old-max-malloc))
-
- (let ((old-max-table-size (mus-max-table-size)))
- (set! (mus-max-table-size) (expt 2 36))
- (if (not (= (mus-max-table-size) (expt 2 36)))
- (snd-display #__line__ ";mus-max-table-size as bignum: ~A" (mus-max-table-size)))
- (set! (mus-max-table-size) old-max-table-size))))
+ (let ((old-max-malloc *mus-max-malloc*))
+ (set! *mus-max-malloc* (expt 2 36))
+ (if (not (= *mus-max-malloc* (expt 2 36)))
+ (snd-display #__line__ ";mus-max-malloc as bignum: ~A" *mus-max-malloc*))
+ (set! *mus-max-malloc* old-max-malloc))
+
+ (let ((old-max-table-size *mus-max-table-size*))
+ (set! *mus-max-table-size* (expt 2 36))
+ (if (not (= *mus-max-table-size* (expt 2 36)))
+ (snd-display #__line__ ";mus-max-table-size as bignum: ~A" *mus-max-table-size*))
+ (set! *mus-max-table-size* old-max-table-size))))
(if (not (provided? 'snd-gtk))
(for-each
@@ -1187,8 +1215,8 @@
(list axis-label-font axis-numbers-font tiny-font peaks-font bold-peaks-font)
(list 'axis-label-font 'axis-numbers-font 'tiny-font 'peaks-font 'bold-peaks-font)))
- (set! (ask-about-unsaved-edits) #f)
- (set! (remember-sound-state) #f)
+ (set! *ask-about-unsaved-edits* #f)
+ (set! *remember-sound-state* #f)
))
@@ -1197,217 +1225,370 @@
(define good-colormap hot-colormap)
(define better-colormap black-and-white-colormap)
-(if with-gui
- (if (not (colormap? good-colormap))
- (set! good-colormap
- (call-with-exit
- (lambda (return)
- (do ((i 1 (+ 1 i)))
- ((= i 20))
- (if (colormap? (integer->colormap i))
- (return (integer->colormap i)))))))))
-(if with-gui
- (if (not (colormap? better-colormap))
- (set! better-colormap
- (call-with-exit
- (lambda (return)
- (do ((i good-colormap (+ 1 i)))
- ((= i 20))
- (if (colormap? (integer->colormap i))
- (return (integer->colormap i)))))))))
+(if (and with-gui
+ (not (colormap? good-colormap)))
+ (set! good-colormap
+ (call-with-exit
+ (lambda (return)
+ (do ((i 1 (+ i 1)))
+ ((= i 20))
+ (if (colormap? (integer->colormap i))
+ (return (integer->colormap i))))))))
+(if (and with-gui
+ (not (colormap? better-colormap)))
+ (set! better-colormap
+ (call-with-exit
+ (lambda (return)
+ (do ((i good-colormap (+ i 1)))
+ ((= i 20))
+ (if (colormap? (integer->colormap i))
+ (return (integer->colormap i))))))))
(define (snd_test_1)
- (letrec ((test-defaults
- (lambda (lst)
- (if (not (null? lst))
- (begin
- (if (not (equal? (cadr lst) (caddr lst)))
- (if (and (number? (caddr lst))
- (not (rational? (caddr lst))))
- (if (fneq (cadr lst) (caddr lst))
- (snd-display #__line__ ";~A is not ~A (~A)" (car lst) (caddr lst) (cadr lst)))
- (snd-display #__line__ ";~A is not ~A (~A)" (car lst) (caddr lst) (cadr lst))))
- (test-defaults (cdddr lst)))))))
-
- (for-each close-sound (sounds)) ; in case others opened elsewhere
- (test-defaults
- (list
- 'amp-control (without-errors (amp-control)) 'no-such-sound
- 'amp-control-bounds (cadr (amp-control-bounds)) 8.0
- 'ask-about-unsaved-edits (ask-about-unsaved-edits) #f
- 'ask-before-overwrite (ask-before-overwrite) #f
- 'audio-output-device (audio-output-device) 0
- 'audio-output-device (audio-output-device) 0
- 'auto-resize (auto-resize) #t
- 'auto-update (auto-update) #f
- 'auto-update-interval (auto-update-interval) 60.0
- 'beats-per-measure (beats-per-measure) 4
- 'beats-per-minute (beats-per-minute) 60.0
- 'channel-style (channel-style) 1
- 'clipping (clipping) #f
- 'clm-table-size (clm-table-size) 512
- 'clm-default-frequency (clm-default-frequency) 0.0
- 'color-cutoff (color-cutoff) 0.003
- 'color-inverted (color-inverted) #t
- 'color-scale (color-scale) 1.0
- 'colormap (colormap) good-colormap
- 'contrast-control (without-errors (contrast-control)) 'no-such-sound
- 'contrast-control-amp (contrast-control-amp) 1.0
- 'contrast-control-bounds (cadr (contrast-control-bounds)) 10.0
- 'contrast-control? (without-errors (contrast-control?)) 'no-such-sound
- 'with-tracking-cursor (with-tracking-cursor) #f
- 'cursor-location-offset (cursor-location-offset) 0
- 'cursor-size (cursor-size) 15
- 'cursor-style (cursor-style) cursor-cross
- 'cursor-update-interval (cursor-update-interval) 0.05
- 'dac-combines-channels (dac-combines-channels) #t
- 'dac-size (dac-size) 256
- 'default-output-chans (default-output-chans) 1
- 'default-output-data-format (default-output-data-format) mus-lfloat
- 'default-output-header-type (default-output-header-type) mus-next
- 'default-output-srate (default-output-srate) 44100
- 'dot-size (dot-size) 1
- 'enved-base (enved-base) 1.0
- 'enved-clip? (enved-clip?) #t
- 'enved-envelope (enved-envelope) '()
- 'enved-filter (enved-filter) #t
- 'enved-filter-order (enved-filter-order) 40
- 'enved-in-dB (enved-in-dB) #f
- 'enved-power (enved-power) 3.0
- 'enved-style (enved-style) envelope-linear
- 'enved-target (enved-target) 0
- 'enved-wave? (enved-wave?) #f
- 'eps-bottom-margin (eps-bottom-margin) 0.0
- 'eps-file (eps-file) "snd.eps"
- 'eps-left-margin (eps-left-margin) 0.0
- 'eps-size (eps-size) 1.0
- 'expand-control (without-errors (expand-control)) 'no-such-sound
- 'expand-control-bounds (cadr (expand-control-bounds)) 20.0
- 'expand-control-hop (expand-control-hop) 0.05
- 'expand-control-jitter (expand-control-jitter) 0.1
- 'expand-control-length (expand-control-length) 0.15
- 'expand-control-ramp (expand-control-ramp) 0.4
- 'expand-control? (without-errors (expand-control?)) 'no-such-sound
- 'fft-log-frequency (fft-log-frequency) #f
- 'fft-log-magnitude (fft-log-magnitude) #f
- 'fft-with-phases (fft-with-phases) #f
- 'fft-window (fft-window) 6
- 'fft-window-alpha (fft-window-alpha) 0.0
- 'fft-window-beta (fft-window-beta) 0.0
- 'filter-control-coeffs (without-errors (filter-control-coeffs)) 'no-such-sound
- 'filter-control-envelope (without-errors (filter-control-envelope)) 'no-such-sound
- 'filter-control-in-dB (filter-control-in-dB) #f
- 'filter-control-in-hz (filter-control-in-hz) #f
- 'filter-control-order (filter-control-order) 20
- 'filter-control? (without-errors (filter-control?)) 'no-such-sound
- 'graph-cursor (graph-cursor) 34
- 'graph-style (graph-style) graph-lines
- 'graphs-horizontal (graphs-horizontal) #t
- 'grid-density (grid-density) 1.0
- 'html-dir (html-dir) "."
- 'html-program (html-program) "firefox"
- 'initial-beg (initial-beg) 0.0
- 'initial-dur (initial-dur) 0.1
- 'just-sounds (just-sounds) #t
- 'ladspa-dir (ladspa-dir) #f
- 'peak-env-dir (peak-env-dir) #f
- 'lisp-graph? (without-errors (lisp-graph?)) 'no-such-sound
- 'listener-prompt (listener-prompt) ">"
- 'log-freq-start (log-freq-start) 32.0
- 'mark-tag-height (mark-tag-height) 4
- 'mark-tag-width (mark-tag-width) 10
- 'max-regions (max-regions) 16
- 'max-virtual-ptrees (max-virtual-ptrees) 32
- 'max-transform-peaks (max-transform-peaks) 100
- 'min-dB (min-dB) -60.0
- 'minibuffer-history-length (minibuffer-history-length) 8
- 'mix-tag-height (mix-tag-height) 14
- 'mix-tag-width (mix-tag-width) 6
- 'mix-waveform-height (mix-waveform-height) 20
- 'mus-array-print-length (mus-array-print-length) 8
- 'mus-clipping (mus-clipping) #f
- 'mus-float-equal-fudge-factor (mus-float-equal-fudge-factor) .0000001
- 'mus-prescaler (mus-prescaler) 1.0
- 'optimization (optimization) 6
- 'play-arrow-size (play-arrow-size) 10
- 'print-length (print-length) 12
- 'read-only (without-errors (read-only)) 'no-such-sound
- 'region-graph-style (region-graph-style) graph-lines
- 'remember-sound-state (remember-sound-state) #f
- 'reverb-control-feedback (reverb-control-feedback) 1.09
- 'reverb-control-length (without-errors (reverb-control-length)) 'no-such-sound
- 'reverb-control-length-bounds (cadr (reverb-control-length-bounds)) 5.0
- 'reverb-control-lowpass (reverb-control-lowpass) 0.7
- 'reverb-control-scale (without-errors (reverb-control-scale)) 'no-such-sound
- 'reverb-control-scale-bounds (cadr (reverb-control-scale-bounds)) 4.0
- 'reverb-control? (without-errors (reverb-control?)) 'no-such-sound
- 'save-as-dialog-auto-comment (save-as-dialog-auto-comment) #f
- 'save-as-dialog-src (save-as-dialog-src) #f
- 'save-state-file (save-state-file) "saved-snd.scm"
- 'selection-creates-region (selection-creates-region) #t
- 'show-axes (show-axes) 1
- 'show-controls (show-controls) #f
- 'show-full-duration (show-full-duration) #f
- 'show-grid (show-grid) #f
- 'show-indices (show-indices) #f
- 'show-marks (show-marks) #t
- 'show-mix-waveforms (show-mix-waveforms) #t
- 'show-selection-transform (show-selection-transform) #f
- 'show-sonogram-cursor (show-sonogram-cursor) #f
- 'show-transform-peaks (show-transform-peaks) #f
- 'show-y-zero (show-y-zero) #f
- 'sinc-width (sinc-width) 10
- 'spectrum-end (spectrum-end) 1.0
- 'spectro-hop (spectro-hop) 4
- 'spectrum-start (spectrum-start) 0.0
- 'spectro-x-angle (spectro-x-angle) (if (provided? 'gl) 300.0 90.0)
- 'spectro-x-scale (spectro-x-scale) (if (provided? 'gl) 1.5 1.0)
- 'spectro-y-angle (spectro-y-angle) (if (provided? 'gl) 320.0 0.0)
- 'spectro-y-scale (spectro-y-scale) 1.0
- 'spectro-z-angle (spectro-z-angle) (if (provided? 'gl) 0.0 358.0)
- 'spectro-z-scale (spectro-z-scale) (if (provided? 'gl) 1.0 0.1)
- 'speed-control (without-errors (speed-control)) 'no-such-sound
- 'speed-control-bounds (cadr (speed-control-bounds)) 20.0
- 'sync (without-errors (sync)) 'no-such-sound
- 'sync-style (sync-style) sync-by-sound
- 'temp-dir (temp-dir) #f
- 'time-graph-type (time-graph-type) graph-once
- 'time-graph? (without-errors (time-graph?)) 'no-such-sound
- 'tiny-font (tiny-font) (if (provided? 'snd-motif) "6x12" "Sans 8")
- 'tracking-cursor-style (tracking-cursor-style) cursor-line
- 'transform-graph-type (transform-graph-type) graph-once
- 'transform-graph? (without-errors (transform-graph?)) 'no-such-sound
- 'transform-normalization (transform-normalization) normalize-by-channel
- 'transform-size (transform-size) 512
- 'transform-type (transform-type) fourier-transform
- 'view-files-sort (view-files-sort) 0
- 'view-files-sort (view-files-sort) 0
- 'wavelet-type (wavelet-type) 0
- 'wavo-hop (wavo-hop) 3
- 'wavo-trace (wavo-trace) 64
- 'with-mix-tags (with-mix-tags) #t
- 'with-relative-panes (with-relative-panes) #t
- 'with-tracking-cursor (with-tracking-cursor) #f
- 'with-verbose-cursor (with-verbose-cursor) #f
- 'with-inset-graph (with-inset-graph) #f
- 'with-smpte-label (with-smpte-label) #f
- 'with-toolbar (with-toolbar) #f
- 'with-tooltips (with-tooltips) #f
- 'with-menu-icons (with-menu-icons) #f
- 'with-pointer-focus (with-pointer-focus) #f
- 'x-axis-style (x-axis-style) 0
- 'zero-pad (zero-pad) 0
- 'zoom-focus-style (zoom-focus-style) 2
- ))
- (if *snd-opened-sound* (snd-display #__line__ ";*snd-opened-sound*: ~A" *snd-opened-sound*))
- (set! (ask-about-unsaved-edits) #f)
- (set! (remember-sound-state) #f)
+ (when with-gui
+ (letrec ((test-defaults
+ (lambda (lst)
+ (if (pair? lst)
+ (begin
+ (if (and (not (equal? (cadr lst) (caddr lst)))
+ (or (not (pair? (caddr lst)))
+ (not (member (cadr lst) (caddr lst)))))
+ (if (and (number? (caddr lst))
+ (not (rational? (caddr lst))))
+ (if (fneq (cadr lst) (caddr lst))
+ (snd-display #__line__ ";~A is not ~A (~A)" (car lst) (caddr lst) (cadr lst)))
+ (snd-display #__line__ ";~A is not ~A (~A)" (car lst) (caddr lst) (cadr lst))))
+ (test-defaults (cdddr lst)))))))
+
+ (for-each close-sound (sounds)) ; in case others opened elsewhere
+ (test-defaults
+ (list
+ 'amp-control (without-errors (amp-control)) 'no-such-sound
+ 'amp-control-bounds (cadr (amp-control-bounds)) 8.0
+ 'ask-about-unsaved-edits *ask-about-unsaved-edits* #f
+ 'ask-before-overwrite *ask-before-overwrite* #f
+ 'auto-resize *auto-resize* #t
+ 'auto-update *auto-update* #f
+ 'auto-update-interval *auto-update-interval* 60.0
+
+ 'beats-per-measure *beats-per-measure* 4
+ 'beats-per-minute *beats-per-minute* 60.0
+ 'channel-style *channel-style* 1
+ 'clipping *clipping* #f
+ 'clm-table-size *clm-table-size* 512
+ 'clm-default-frequency *clm-default-frequency* 0.0
+
+ 'color-cutoff *color-cutoff* '(0.003 0.001)
+ 'color-inverted *color-inverted* #t
+ 'color-scale *color-scale* 1.0
+ 'colormap *colormap* (list hot-colormap jet-colormap)
+ 'contrast-control (without-errors (contrast-control)) 'no-such-sound
+ 'contrast-control-amp *contrast-control-amp* 1.0
+ 'contrast-control-bounds (cadr (contrast-control-bounds)) 10.0
+ 'contrast-control? (without-errors (contrast-control?)) 'no-such-sound
+ 'cursor-location-offset *cursor-location-offset* 0
+ 'cursor-size *cursor-size* 15
+ 'cursor-style *cursor-style* cursor-cross
+ 'cursor-update-interval *cursor-update-interval* 0.05
+ 'dac-combines-channels *dac-combines-channels* #t
+ 'dac-size *dac-size* 256
+ 'default-output-chans *default-output-chans* 1
+ 'default-output-sample-type *default-output-sample-type* mus-ldouble
+ 'default-output-header-type *default-output-header-type* mus-next
+ 'default-output-srate *default-output-srate* 44100
+ 'dot-size *dot-size* 1
+
+ 'enved-base *enved-base* 1.0
+ 'enved-clip? (enved-clip?) #t
+ 'enved-envelope (enved-envelope) ()
+ 'enved-filter (enved-filter) #t
+ 'enved-filter-order *enved-filter-order* 40
+ 'enved-in-dB (enved-in-dB) #f
+ 'enved-power *enved-power* 3.0
+ 'enved-style *enved-style* envelope-linear
+ 'enved-target *enved-target* 0
+ 'enved-wave? *enved-wave?* #f
+ 'eps-bottom-margin *eps-bottom-margin* 0.0
+ 'eps-file *eps-file* "snd.eps"
+ 'eps-left-margin *eps-left-margin* 0.0
+ 'eps-size *eps-size* 1.0
+ 'expand-control (without-errors (expand-control)) 'no-such-sound
+ 'expand-control-bounds (cadr (expand-control-bounds)) 20.0
+ 'expand-control-hop *expand-control-hop* 0.05
+ 'expand-control-jitter *expand-control-jitter* 0.1
+ 'expand-control-length *expand-control-length* 0.15
+ 'expand-control-ramp *expand-control-ramp* 0.4
+ 'expand-control? (without-errors (expand-control?)) 'no-such-sound
+ 'fft-log-frequency *fft-log-frequency* #f
+ 'fft-log-magnitude *fft-log-magnitude* #f
+ 'fft-with-phases *fft-with-phases* #f
+ 'fft-window *fft-window* 6
+ 'fft-window-alpha *fft-window-alpha* 0.0
+ 'fft-window-beta *fft-window-beta* 0.0
+ 'filter-control-coeffs (without-errors (filter-control-coeffs)) 'no-such-sound
+ 'filter-control-envelope (without-errors (filter-control-envelope)) 'no-such-sound
+ 'filter-control-in-dB *filter-control-in-dB* #f
+ 'filter-control-in-hz *filter-control-in-hz* #f
+ 'filter-control-order *filter-control-order* 20
+ 'filter-control? (without-errors (filter-control?)) 'no-such-sound
+ 'graph-cursor *graph-cursor* 34
+ 'graph-style *graph-style* graph-lines
+ 'graphs-horizontal *graphs-horizontal* #t
+ 'grid-density *grid-density* 1.0
+ 'html-dir *html-dir* "."
+ 'html-program *html-program* "firefox"
+ 'initial-beg *initial-beg* 0.0
+ 'initial-dur *initial-dur* 0.1
+ 'just-sounds *just-sounds* #t
+ 'ladspa-dir *ladspa-dir* ""
+ 'peak-env-dir *peak-env-dir* (list "" "/home/bil/peaks")
+ 'lisp-graph? (without-errors (lisp-graph?)) 'no-such-sound
+ ; 'listener-prompt *listener-prompt* ">"
+ 'log-freq-start *log-freq-start* 32.0
+ 'mark-tag-height *mark-tag-height* 4
+ 'mark-tag-width *mark-tag-width* 10
+ 'max-regions *max-regions* 16
+ 'max-transform-peaks *max-transform-peaks* 100
+ 'min-dB *min-dB* -60.0
+ 'mix-tag-height *mix-tag-height* 14
+ 'mix-tag-width *mix-tag-width* 6
+ 'mix-waveform-height *mix-waveform-height* 20
+ 'mus-array-print-length *mus-array-print-length* 8
+ 'mus-clipping (mus-clipping) #f
+ 'mus-float-equal-fudge-factor *mus-float-equal-fudge-factor* .0000001
+ 'play-arrow-size *play-arrow-size* 10
+ 'print-length *print-length* '(12 32)
+ 'read-only (without-errors (read-only)) 'no-such-sound
+ 'region-graph-style *region-graph-style* graph-lines
+ 'remember-sound-state *remember-sound-state* #f
+ 'reverb-control-feedback *reverb-control-feedback* 1.09
+ 'reverb-control-length (without-errors (reverb-control-length)) 'no-such-sound
+ 'reverb-control-length-bounds (cadr (reverb-control-length-bounds)) 5.0
+ 'reverb-control-lowpass *reverb-control-lowpass* 0.7
+ 'reverb-control-scale (without-errors (reverb-control-scale)) 'no-such-sound
+ 'reverb-control-scale-bounds (cadr (reverb-control-scale-bounds)) 4.0
+ 'reverb-control? (without-errors (reverb-control?)) 'no-such-sound
+ 'save-as-dialog-auto-comment *save-as-dialog-auto-comment* #f
+ 'save-as-dialog-src *save-as-dialog-src* #f
+ 'save-state-file *save-state-file* "saved-snd.scm"
+ 'selection-creates-region *selection-creates-region* #t
+ 'show-axes *show-axes* 1
+ 'show-controls *show-controls* #f
+ 'show-full-duration *show-full-duration* '(#f #t)
+ 'show-full-range *show-full-range* #f
+ 'show-grid *show-grid* #f
+ 'show-indices *show-indices* '(#f #t)
+ 'show-marks *show-marks* #t
+ 'show-mix-waveforms *show-mix-waveforms* #t
+ 'show-selection-transform *show-selection-transform* #f
+ 'show-sonogram-cursor *show-sonogram-cursor* #f
+ 'show-transform-peaks *show-transform-peaks* '(#f #t)
+ 'show-y-zero *show-y-zero* #f
+ 'sinc-width *sinc-width* 10
+ 'spectrum-end *spectrum-end* 1.0
+ 'spectro-hop *spectro-hop* 4
+ 'spectrum-start *spectrum-start* 0.0
+ 'spectro-x-angle *spectro-x-angle* (if (provided? 'gl) 300.0 90.0)
+ 'spectro-x-scale *spectro-x-scale* (if (provided? 'gl) 1.5 1.0)
+ 'spectro-y-angle *spectro-y-angle* (if (provided? 'gl) 320.0 0.0)
+ 'spectro-y-scale *spectro-y-scale* 1.0
+ 'spectro-z-angle *spectro-z-angle* (if (provided? 'gl) 0.0 358.0)
+ 'spectro-z-scale *spectro-z-scale* (if (provided? 'gl) 1.0 0.1)
+ 'speed-control (without-errors (speed-control)) 'no-such-sound
+ 'speed-control-bounds (cadr (speed-control-bounds)) 20.0
+ 'sync (without-errors (sync)) 'no-such-sound
+ 'sync-style *sync-style* sync-by-sound
+ 'temp-dir *temp-dir* (list "" "/home/bil/zap/tmp")
+ 'time-graph-type *time-graph-type* graph-once
+ 'time-graph? (without-errors (time-graph?)) 'no-such-sound
+ 'tiny-font *tiny-font* (if (provided? 'snd-motif) "6x12" "Sans 8")
+ 'tracking-cursor-style *tracking-cursor-style* cursor-line
+ 'transform-graph-type *transform-graph-type* graph-once
+ 'transform-graph? (without-errors (transform-graph?)) 'no-such-sound
+ 'transform-normalization *transform-normalization* normalize-by-channel
+ 'transform-size *transform-size* *transform-size*
+ 'transform-type *transform-type* fourier-transform
+ 'wavelet-type *wavelet-type* 0
+ 'wavo-hop *wavo-hop* 3
+ 'wavo-trace *wavo-trace* 64
+ 'with-mix-tags *with-mix-tags* #t
+ 'with-relative-panes *with-relative-panes* #t
+ ; 'with-tracking-cursor *with-tracking-cursor* '(#f 1)
+ 'with-verbose-cursor *with-verbose-cursor* '(#f #t)
+ 'with-inset-graph *with-inset-graph* '(#f #t)
+ 'with-interrupts *with-interrupts* #t
+ 'with-smpte-label *with-smpte-label* #f
+ 'with-toolbar *with-toolbar* '(#f #t)
+ 'with-tooltips *with-tooltips* #t
+ 'with-menu-icons *with-menu-icons* '(#f #t)
+ 'with-pointer-focus *with-pointer-focus* '(#f #t)
+ 'x-axis-style *x-axis-style* 0
+ 'zero-pad *zero-pad* 0
+ 'zoom-focus-style *zoom-focus-style* 2
+ ))
+ (if *snd-opened-sound* (snd-display #__line__ ";*snd-opened-sound*: ~A" *snd-opened-sound*))
+
+ (let ((s (open-sound "oboe.snd")))
+ (letrec ((test-vars
+ (lambda (lst)
+ (if (pair? lst)
+ (let* ((args (car lst))
+ (name (args 0))
+ (getfnc (args 1))
+ (setfnc (lambda (val) (set! (getfnc) val)))
+ (initval (args 2))
+ (newval (args 3))
+ (star-name (args 4)))
+ (setfnc newval)
+ (let ((nowval (symbol->value star-name)))
+ (if (and (not (equal? newval nowval))
+ (or (not (list? newval))
+ (not (feql newval nowval))))
+ (if (and (number? newval) (not (rational? newval)))
+ (if (> (abs (- newval nowval)) .01)
+ (snd-display #__line__ ";~A is not ~A (~A)" star-name newval nowval))
+ (snd-display #__line__ ";~A is not ~A (~A)" star-name newval nowval)))
+ (eval `(set! ,star-name ,initval))
+ (if (not (morally-equal? (getfnc) initval))
+ (snd-display #__line__ ";* ~A is not ~A" name initval))
+ (eval `(set! ,star-name ,newval))
+ (let ((nowval (getfnc)))
+ (if (and (not (equal? newval nowval))
+ (or (not (list? newval))
+ (not (feql newval nowval))))
+ (if (and (number? newval) (not (rational? newval)))
+ (if (> (abs (- newval nowval)) .01)
+ (snd-display #__line__ ";set! ~A is not ~A (~A)" star-name newval nowval))
+ (snd-display #__line__ ";set! ~A is not ~A (~A)" star-name newval nowval)))
+ (setfnc initval))
+ (test-vars (cdr lst))))))))
+ (test-vars
+ (list
+ (list 'ask-about-unsaved-edits ask-about-unsaved-edits #f #t '*ask-about-unsaved-edits*)
+ (list 'ask-before-overwrite ask-before-overwrite #f #t '*ask-before-overwrite*)
+ (list 'auto-resize auto-resize #t #f '*auto-resize*)
+ (list 'auto-update auto-update #f #t '*auto-update*)
+ (list 'channel-style channel-style 0 1 '*channel-style*)
+ (list 'color-cutoff color-cutoff 0.003 0.01 '*color-cutoff*)
+ (list 'color-inverted color-inverted #t #f '*color-inverted*)
+ (list 'color-scale color-scale 1.0 0.5 '*color-scale*)
+ (list 'contrast-control-amp contrast-control-amp 1.0 0.5 '*contrast-control-amp*)
+ (list 'auto-update-interval auto-update-interval 60.0 120.0 '*auto-update-interval*)
+ (list 'cursor-update-interval cursor-update-interval 0.05 0.10 '*cursor-update-interval*)
+ (list 'cursor-location-offset cursor-location-offset 0 32768 '*cursor-location-offset*)
+ ; (list 'with-tracking-cursor with-tracking-cursor 2 1 '*with-tracking-cursor*)
+ (list 'cursor-size cursor-size 15 30 '*cursor-size*)
+ (list 'cursor-style cursor-style cursor-cross cursor-line '*cursor-style*)
+ (list 'tracking-cursor-style tracking-cursor-style cursor-line cursor-cross '*tracking-cursor-style*)
+ (list 'dac-combines-channels dac-combines-channels #t #f '*dac-combines-channels*)
+ (list 'dac-size dac-size 256 512 '*dac-size*)
+ (list 'clipping clipping #f #t '*clipping*)
+ (list 'default-output-chans default-output-chans 1 2 '*default-output-chans*)
+ (list 'default-output-sample-type default-output-sample-type 1 1 '*default-output-sample-type*)
+ (list 'default-output-srate default-output-srate 22050 44100 '*default-output-srate*)
+ (list 'default-output-header-type default-output-header-type mus-next mus-aifc '*default-output-header-type*)
+ (list 'dot-size dot-size 1 4 '*dot-size*)
+
+ (list 'enved-base enved-base 1.0 1.5 '*enved-base*)
+ (list 'enved-style enved-style envelope-linear envelope-exponential '*enved-style*)
+ (list 'enved-power enved-power 3.0 3.5 '*enved-power*)
+ (list 'enved-target enved-target 0 1 '*enved-target*)
+ (list 'enved-wave? enved-wave? #f #t '*enved-wave?*)
+ (list 'eps-file eps-file "snd.eps" "snd-1.eps" '*eps-file*)
+ (list 'eps-left-margin eps-left-margin 0.0 72.0 '*eps-left-margin*)
+ (list 'eps-size eps-size 1.0 2.0 '*eps-size*)
+ (list 'eps-bottom-margin eps-bottom-margin 0.0 36.0 '*eps-bottom-margin*)
+ (list 'expand-control-hop expand-control-hop 0.05 0.1 '*expand-control-hop*)
+ (list 'expand-control-jitter expand-control-jitter 0.1 0.2 '*expand-control-jitter*)
+ (list 'expand-control-length expand-control-length 0.15 0.2 '*expand-control-length*)
+ (list 'expand-control-ramp expand-control-ramp 0.4 0.2 '*expand-control-ramp*)
+
+ (list 'fft-window-alpha fft-window-alpha 0.0 1.0 '*fft-window-alpha*)
+ (list 'fft-window-beta fft-window-beta 0.0 0.5 '*fft-window-beta*)
+ (list 'fft-log-frequency fft-log-frequency #f #t '*fft-log-frequency*)
+ (list 'fft-log-magnitude fft-log-magnitude #f #t '*fft-log-magnitude*)
+ (list 'fft-with-phases fft-with-phases #f #t '*fft-with-phases*)
+ (list 'transform-size transform-size 512 1024 '*transform-size*)
+ (list 'transform-graph-type transform-graph-type graph-once graph-as-sonogram '*transform-graph-type*)
+ (list 'fft-window fft-window 6 5 '*fft-window*)
+ (list 'filter-control-in-dB filter-control-in-dB #f #t '*filter-control-in-dB*)
+ (list 'enved-filter-order enved-filter-order 40 20 '*enved-filter-order*)
+ (list 'filter-control-in-hz filter-control-in-hz #f #t '*filter-control-in-hz*)
+ (list 'filter-control-order filter-control-order 20 40 '*filter-control-order*)
+ ; (list 'graph-cursor graph-cursor 34 32 '*graph-cursor*)
+
+ (list 'graph-style graph-style 0 1 '*graph-style*)
+ (list 'initial-beg initial-beg 0.0 1.0 '*initial-beg*)
+ (list 'initial-dur initial-dur 0.1 1.0 '*initial-dur*)
+ (list 'just-sounds just-sounds #f #t '*just-sounds*)
+ (list 'listener-prompt listener-prompt ">" ":" '*listener-prompt*)
+ (list 'max-transform-peaks max-transform-peaks 100 10 '*max-transform-peaks*)
+ (list 'max-regions max-regions 16 6 '*max-regions*)
+ (list 'min-dB min-dB -60.0 -90.0 '*min-dB*)
+ (list 'log-freq-start log-freq-start 32.0 10.0 '*log-freq-start*)
+ (list 'mix-waveform-height mix-waveform-height 20 40 '*mix-waveform-height*)
+ (list 'mix-tag-height mix-tag-height 14 20 '*mix-tag-height*)
+ (list 'mix-tag-width mix-tag-width 6 20 '*mix-tag-width*)
+ (list 'mark-tag-height mark-tag-height 4 20 '*mark-tag-height*)
+ (list 'mark-tag-width mark-tag-width 10 20 '*mark-tag-width*)
+ (list 'selection-creates-region selection-creates-region #t #f '*selection-creates-region*)
+ (list 'transform-normalization transform-normalization normalize-by-channel dont-normalize '*transform-normalization*)
+ (list 'play-arrow-size play-arrow-size 10 16 '*play-arrow-size*)
+ (list 'print-length print-length 12 16 '*print-length*)
+ (list 'region-graph-style region-graph-style graph-lines graph-lollipops '*region-graph-style*)
+ (list 'reverb-control-decay reverb-control-decay 1.0 2.0 '*reverb-control-decay*)
+ (list 'reverb-control-feedback reverb-control-feedback 1.09 1.6 '*reverb-control-feedback*)
+ (list 'reverb-control-lowpass reverb-control-lowpass 0.7 0.9 '*reverb-control-lowpass*)
+ (list 'show-axes show-axes 1 0 '*show-axes*)
+ (list 'show-full-duration show-full-duration #f #t '*show-full-duration*)
+ (list 'show-full-range show-full-range #f #t '*show-full-range*)
+ (list 'show-transform-peaks show-transform-peaks #f #t '*show-transform-peaks*)
+ (list 'show-indices show-indices #f #t '*show-indices*)
+ (list 'show-marks show-marks #t #f '*show-marks*)
+ (list 'show-mix-waveforms show-mix-waveforms #t #f '*show-mix-waveforms*)
+ (list 'show-selection-transform show-selection-transform #f #t '*show-selection-transform*)
+ (list 'show-y-zero show-y-zero #f #t '*show-y-zero*)
+ (list 'show-grid show-grid #f #t '*show-grid*)
+ (list 'grid-density grid-density 1.0 0.5 '*grid-density*)
+ (list 'show-sonogram-cursor show-sonogram-cursor #f #t '*show-sonogram-cursor*)
+ (list 'sinc-width sinc-width 10 40 '*sinc-width*)
+ (list 'spectrum-end spectrum-end 1.0 0.7 '*spectrum-end*)
+ (list 'spectro-hop spectro-hop 4 10 '*spectro-hop*)
+ (list 'spectrum-start spectrum-start 0.0 0.1 '*spectrum-start*)
+ (list 'spectro-x-angle spectro-x-angle (if (provided? 'gl) 300.0 90.0) 60.0 '*spectro-x-angle*)
+ (list 'spectro-x-scale spectro-x-scale (if (provided? 'gl) 1.5 1.0) 2.0 '*spectro-x-scale*)
+ (list 'spectro-y-angle spectro-y-angle (if (provided? 'gl) 320.0 0.0) 60.0 '*spectro-y-angle*)
+ (list 'spectro-y-scale spectro-y-scale 1.0 2.0 '*spectro-y-scale*)
+ (list 'spectro-z-angle spectro-z-angle (if (provided? 'gl) 0.0 358.0) 60.0 '*spectro-z-angle*)
+ (list 'spectro-z-scale spectro-z-scale (if (provided? 'gl) 1.0 0.1) 0.2 '*spectro-z-scale*)
+ (list 'speed-control-style speed-control-style 0 1 '*speed-control-style*)
+ (list 'speed-control-tones speed-control-tones 12 18 '*speed-control-tones*)
+ (list 'sync-style sync-style sync-by-sound sync-all '*sync-style*)
+ (list 'tiny-font tiny-font (if (provided? 'snd-gtk) "Sans 8" "6x12") (if (provided? 'snd-gtk) "Monospace 10" "9x15") '*tiny-font*)
+ (list 'with-verbose-cursor with-verbose-cursor #f #t '*with-verbose-cursor*)
+ (list 'wavelet-type wavelet-type 0 1 '*wavelet-type*)
+ (list 'time-graph-type time-graph-type graph-once graph-as-wavogram '*time-graph-type*)
+ (list 'wavo-hop wavo-hop 3 6 '*wavo-hop*)
+ (list 'wavo-trace wavo-trace 64 128 '*wavo-trace*)
+ ;(list 'with-mix-tags with-mix-tags #t #f '*with-mix-tags*)
+ (list 'with-relative-panes with-relative-panes #t #f '*with-relative-panes*)
+ (list 'with-gl with-gl (provided? 'gl) #f '*with-gl*)
+ (list 'x-axis-style x-axis-style 0 1 '*x-axis-style*)
+ (list 'beats-per-minute beats-per-minute 30.0 120.0 '*beats-per-minute*)
+ (list 'beats-per-measure beats-per-measure 1 120 '*beats-per-measure*)
+ (list 'zero-pad zero-pad 0 1 '*zero-pad*)
+ (list 'zoom-focus-style zoom-focus-style 2 1 '*zoom-focus-style*)
+ )))
+ (close-sound s)
+ ))
+
+ (set! *ask-about-unsaved-edits* #f)
+ (set! *remember-sound-state* #f)
))
-(if (and (not (= (default-output-data-format) mus-bfloat))
- (not (= (default-output-data-format) mus-lfloat)))
- (set! (default-output-data-format) mus-lfloat))
+(set! (with-mix-tags) #t) ; assumed in test 16(!)
+(set! *default-output-sample-type* mus-ldouble)
;;; ---------------- test 2: headers ----------------
@@ -1415,27 +1596,27 @@
(if (string? sf-dir)
(letrec ((test-headers
(lambda (base-files)
- (if (not (null? base-files))
+ (if (pair? base-files)
(let ((testf (car base-files)))
- (let ((file (string-append sf-dir (list-ref testf 0))))
+ (let ((file (string-append sf-dir (testf 0))))
(if (file-exists? file)
(begin
- (if (not (equal? (mus-sound-chans file) (list-ref testf 1)))
+ (if (not (equal? (mus-sound-chans file) (testf 1)))
(snd-display #__line__ ";~A: chans ~A is not ~A"
- (list-ref testf 0)
+ (testf 0)
(mus-sound-chans file)
- (list-ref testf 1)))
- (if (not (equal? (mus-sound-srate file) (list-ref testf 2)))
+ (testf 1)))
+ (if (not (equal? (mus-sound-srate file) (testf 2)))
(snd-display #__line__ ";~A: srate ~A is not ~A"
- (list-ref testf 0)
+ (testf 0)
(mus-sound-srate file)
- (list-ref testf 2)))
- (if (fneq (mus-sound-duration file) (list-ref testf 3))
+ (testf 2)))
+ (if (fneq (mus-sound-duration file) (testf 3))
(snd-display #__line__ ";~A: duration ~A is not ~A"
- (list-ref testf 0)
+ (testf 0)
(mus-sound-duration file)
- (list-ref testf 3)))
- (if (and (not (= (mus-sound-data-format file) mus-unknown))
+ (testf 3)))
+ (if (and (not (= (mus-sound-sample-type file) mus-unknown-sample))
(not (= (mus-sound-header-type file) 27)) ; bogus header on test case (comdisco)
(< (+ (mus-sound-length file) 1)
(* (mus-sound-datum-size file) (mus-sound-duration file)
@@ -1444,40 +1625,40 @@
(mus-sound-length file)
(* (mus-sound-duration file) (mus-sound-srate file)
(mus-sound-chans file) (mus-sound-datum-size file))))
- (if (fneq (/ (mus-sound-frames file) (mus-sound-srate file)) (mus-sound-duration file))
- (snd-display #__line__ ";mus-sound-frames ~A: ~A (~A ~A)" file
- (mus-sound-frames file)
+ (if (fneq (/ (mus-sound-framples file) (mus-sound-srate file)) (mus-sound-duration file))
+ (snd-display #__line__ ";mus-sound-framples ~A: ~A (~A ~A)" file
+ (mus-sound-framples file)
(mus-sound-duration file)
- (/ (mus-sound-frames file) (mus-sound-srate file))))
- (if (> (abs (- (mus-sound-frames file) (/ (mus-sound-samples file) (mus-sound-chans file)))) 1)
+ (/ (mus-sound-framples file) (mus-sound-srate file))))
+ (if (> (abs (- (mus-sound-framples file) (/ (mus-sound-samples file) (mus-sound-chans file)))) 1)
(snd-display #__line__ ";mus-sound-samples ~A: ~A ~A" file
(mus-sound-samples file)
- (* (mus-sound-frames file) (mus-sound-chans file))))
- (if (not (equal? (mus-header-type-name (mus-sound-header-type file)) (list-ref testf 4)))
+ (* (mus-sound-framples file) (mus-sound-chans file))))
+ (if (not (equal? (mus-header-type-name (mus-sound-header-type file)) (testf 4)))
(snd-display #__line__ ";~A: type ~A is not ~A"
- (list-ref testf 0)
+ (testf 0)
(mus-header-type-name (mus-sound-header-type file))
- (list-ref testf 4)))
- (if (not (equal? (mus-data-format-name (mus-sound-data-format file)) (list-ref testf 5)))
+ (testf 4)))
+ (if (not (equal? (mus-sample-type-name (mus-sound-sample-type file)) (testf 5)))
(snd-display #__line__ ";~A: type ~A is not ~A"
- (list-ref testf 0)
- (mus-data-format-name (mus-sound-data-format file))
- (list-ref testf 5)))
+ (testf 0)
+ (mus-sample-type-name (mus-sound-sample-type file))
+ (testf 5)))
(let ((lst (mus-sound-loop-info file)))
(if (> (length testf) 6)
(begin
- (if (not (equal? (car lst) (list-ref testf 6)))
- (snd-display #__line__ ";~A: loop start: ~A" (car lst) (list-ref testf 6)))
- (if (not (equal? (cadr lst) (list-ref testf 7)))
- (snd-display #__line__ ";~A: loop end: ~A" (cadr lst) (list-ref testf 7))))
- (if (not (null? lst))
+ (if (not (equal? (car lst) (testf 6)))
+ (snd-display #__line__ ";~A: loop start: ~A" (car lst) (testf 6)))
+ (if (not (equal? (cadr lst) (testf 7)))
+ (snd-display #__line__ ";~A: loop end: ~A" (cadr lst) (testf 7))))
+ (if (pair? lst)
(snd-display #__line__ ";~A thinks it has loop info: ~A" file lst))))
(mus-sound-forget file))
(snd-display #__line__ ";~A missing?" file))
(test-headers (cdr base-files))))))))
;; need to make sure raw defaults are consistent with following tests
- (let ((ind (open-raw-sound :file (string-append sf-dir "addf8.nh") :channels 2 :srate 44100 :data-format mus-bshort)))
+ (let ((ind (open-raw-sound :file (string-append sf-dir "addf8.nh") :channels 2 :srate 44100 :sample-type mus-bshort)))
(if (sound? ind) (close-sound ind)))
(catch #t
(lambda ()
@@ -1539,8 +1720,8 @@
(list "digit0v0.aiff" 1 8000 0.560000002384186 "AIFC" "big endian short (16 bits)")
(list "esps-16.snd" 1 8000 3.09737491607666 "ESPS" "big endian short (16 bits)")
(list "forest.aiff" 2 44100 3.907143 "AIFF" "big endian short (16 bits)" 24981 144332)
- (list "g721.au" 1 11025 4.35328817367554 "Sun/Next" "unknown")
- (list "g722.aifc" 1 44100 0.0184353739023209 "AIFC" "unknown")
+; (list "g721.au" 1 11025 4.35328817367554 "Sun/Next" "unknown")
+; (list "g722.aifc" 1 44100 0.0184353739023209 "AIFC" "unknown")
(list "gong.wve" 1 8000 3.96799993515015 "PSION" "alaw (8 bits)")
(list "gsm610.wav" 1 11025 1.7687075138092 "RIFF" "unknown")
(list "inrs-16.snd" 1 8000 2.46399998664856 "INRS" "little endian short (16 bits)")
@@ -1589,11 +1770,11 @@
(list "o2.wave" 1 44100 0.0367800444364548 "RIFF" "little endian short (16 bits)")
(list "o2_12bit.aiff" 1 44100 0.0367800444364548 "AIFF" "big endian short (16 bits)")
(list "o2_18bit.aiff" 1 44100 0.0367800444364548 "AIFF" "big endian int (24 bits)")
- (list "o2_711u.wave" 1 44100 0.0367800444364548 "RIFF" "mulaw (8 bits)")
- (list "o2_722.snd" 1 44100 0.0183900222182274 "Sun/Next" "unknown")
- (list "o2_726.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown")
- (list "o2_726.snd" 1 44100 0.0230158735066652 "Sun/Next" "unknown")
- (list "o2_728.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown")
+; (list "o2_711u.wave" 1 44100 0.0367800444364548 "RIFF" "mulaw (8 bits)")
+; (list "o2_722.snd" 1 44100 0.0183900222182274 "Sun/Next" "unknown")
+; (list "o2_726.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown")
+; (list "o2_726.snd" 1 44100 0.0230158735066652 "Sun/Next" "unknown")
+; (list "o2_728.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown")
(list "o2_8.iff" 1 44100 0.0367800444364548 "SVX8" "signed byte (8 bits)")
(list "o2_8.voc" 1 44100 0.0370294786989689 "VOC" "unsigned byte (8 bits)")
(list "o2_dvi.wave" 1 44100 0.0232199542224407 "RIFF" "unknown")
@@ -1602,9 +1783,9 @@
(list "o2_u8.avr" 1 44100 0.0367800444364548 "AVR" "unsigned byte (8 bits)")
(list "o2_u8.wave" 1 44100 0.0367800444364548 "RIFF" "unsigned byte (8 bits)")
(list "o28.mpc" 1 44100 0.036780 "AKAI 4" "little endian short (16 bits)")
- (list "oboe.g721" 1 22050 1.15287983417511 "Sun/Next" "unknown")
- (list "oboe.g723_24" 1 22050 0.864761888980865 "Sun/Next" "unknown")
- (list "oboe.g723_40" 1 22050 1.44126987457275 "Sun/Next" "unknown")
+; (list "oboe.g721" 1 22050 1.15287983417511 "Sun/Next" "unknown")
+; (list "oboe.g723_24" 1 22050 0.864761888980865 "Sun/Next" "unknown")
+; (list "oboe.g723_40" 1 22050 1.44126987457275 "Sun/Next" "unknown")
(list "oboe.kts" 1 22050 2.305125 "Korg" "big endian short (16 bits)")
(list "oboe.its" 1 22050 2.305125 "Impulse Tracker" "little endian short (16 bits)")
(list "oboe.sf2" 1 22050 2.30512475967407 "SoundFont" "little endian short (16 bits)")
@@ -1617,7 +1798,7 @@
(list "oboe-lf32.caf" 1 22050 2.305125 "caff" "little endian float (32 bits)")
(list "oboe-ulaw.caf" 1 22050 2.305125 "caff" "mulaw (8 bits)")
(list "oboe.nsp" 1 22050 2.305125 "CSL" "little endian short (16 bits)")
- (list "oboe.nvf" 1 8000 6.353500 "Creative NVF" "unknown")
+; (list "oboe.nvf" 1 8000 6.353500 "Creative NVF" "unknown")
(list "oboe-ulaw.voc" 1 22050 2.305669 "VOC" "mulaw (8 bits)")
(list "oboe-lf32.sf" 1 22050 2.305669 "IRCAM" "little endian float (32 bits)")
(list "oboe.wfp" 1 22050 2.305125 "Turtle Beach" "little endian short (16 bits)")
@@ -1731,418 +1912,356 @@
(let ((ind #f))
(set! ind (open-sound "oboe.snd"))
- (if (and (file-exists? "funcs.cl")
+ (if (and (file-exists? "funcs.scm")
(not (defined? 'swellf)))
- (load "funcs.cl"))
- (let ((td (temp-dir)))
+ (load "funcs.scm"))
+ (let ((td *temp-dir*))
(catch #t
(lambda ()
- (set! (temp-dir) (string-append home-dir "/test"))
- (if (not (string=? (temp-dir) (string-append home-dir "/test")))
- (snd-display #__line__ ";set temp-dir: ~A?" (temp-dir))))
+ (set! *temp-dir* (string-append home-dir "/test"))
+ (if (not (string=? *temp-dir* (string-append home-dir "/test")))
+ (snd-display #__line__ ";set temp-dir: ~A?" *temp-dir*)))
(lambda args args))
(if td
- (set! (temp-dir) td)
- (set! (temp-dir) "")))
+ (set! *temp-dir* td)
+ (set! *temp-dir* "")))
(if (fneq (sample 1000) 0.0328) (snd-display #__line__ ";sample: ~A?" (sample 1000)))
- (if (or (not (hook? output-name-hook)) (not (null? (hook-functions output-name-hook))))
- (snd-display #__line__ ";output-name-hook: ~A?" output-name-hook))
- (if (or (not (hook? output-comment-hook)) (not (null? (hook-functions output-comment-hook))))
- (snd-display #__line__ ";output-comment-hook: ~A?" output-comment-hook))
- (if (or (not (hook? peak-env-hook)) (not (null? (hook-functions peak-env-hook))))
- (snd-display #__line__ ";peak-env-hook: ~A?" peak-env-hook))
- (if (or (not (hook? help-hook)) (not (null? (hook-functions help-hook))))
- (snd-display #__line__ ";help-hook: ~A?" help-hook))
- (if (or (not (hook? mark-drag-hook)) (not (null? (hook-functions mark-drag-hook))))
- (snd-display #__line__ ";mark-drag-hook: ~A?" mark-drag-hook))
- (if (or (not (hook? mix-drag-hook)) (not (null? (hook-functions mix-drag-hook))))
- (snd-display #__line__ ";mix-drag-hook: ~A?" mix-drag-hook))
- (if (or (not (hook? mouse-drag-hook)) (not (null? (hook-functions mouse-drag-hook))))
- (snd-display #__line__ ";mouse-drag-hook: ~A?" mouse-drag-hook))
- (if (or (not (hook? mouse-click-hook)) (not (null? (hook-functions mouse-click-hook))))
- (snd-display #__line__ ";mouse-click-hook: ~A?" mouse-click-hook))
- (if (or (not (hook? mouse-press-hook)) (not (null? (hook-functions mouse-press-hook))))
- (snd-display #__line__ ";mouse-press-hook: ~A?" mouse-press-hook))
- (if (or (not (hook? start-playing-hook)) (not (null? (hook-functions start-playing-hook))))
- (snd-display #__line__ ";start-playing-hook: ~A?" start-playing-hook))
- (if (or (not (hook? start-playing-selection-hook)) (not (null? (hook-functions start-playing-selection-hook))))
- (snd-display #__line__ ";start-playing-selection-hook: ~A?" start-playing-selection-hook))
- (if (not (hook? stop-playing-hook))
- (snd-display #__line__ ";stop-playing-hook: ~A?" stop-playing-hook))
- (if (or (not (hook? key-press-hook)) (not (null? (hook-functions key-press-hook))))
- (snd-display #__line__ ";key-press-hook: ~A?" key-press-hook))
- (if (or (not (hook? snd-error-hook)) (not (null? (hook-functions snd-error-hook))))
- (snd-display #__line__ ";snd-error-hook: ~A?" snd-error-hook))
- (if (or (not (hook? snd-warning-hook)) (not (null? (hook-functions snd-warning-hook))))
- (snd-display #__line__ ";snd-warning-hook: ~A?" snd-warning-hook))
- (if (or (not (hook? name-click-hook)) (not (null? (hook-functions name-click-hook))))
- (snd-display #__line__ ";name-click-hook: ~A?" name-click-hook))
- (if (or (not (hook? after-apply-controls-hook)) (not (null? (hook-functions after-apply-controls-hook))))
- (snd-display #__line__ ";after-apply-controls-hook: ~A?" after-apply-controls-hook))
- (if (or (not (hook? enved-hook)) (not (null? (hook-functions enved-hook))))
- (snd-display #__line__ ";enved-hook: ~A?" enved-hook))
- (if (or (not (hook? mouse-enter-label-hook)) (not (null? (hook-functions mouse-enter-label-hook))))
- (snd-display #__line__ ";mouse-enter-label-hook: ~A?" mouse-enter-label-hook))
- (if (or (not (hook? mouse-enter-graph-hook)) (not (null? (hook-functions mouse-enter-graph-hook))))
- (snd-display #__line__ ";mouse-enter-graph-hook: ~A?" mouse-enter-graph-hook))
- (if (or (not (hook? mouse-enter-listener-hook)) (not (null? (hook-functions mouse-enter-listener-hook))))
- (snd-display #__line__ ";mouse-enter-listener-hook: ~A?" mouse-enter-listener-hook))
- (if (or (not (hook? mouse-leave-label-hook)) (not (null? (hook-functions mouse-leave-label-hook))))
- (snd-display #__line__ ";mouse-leave-label-hook: ~A?" mouse-leave-label-hook))
- (if (or (not (hook? mouse-leave-graph-hook)) (not (null? (hook-functions mouse-leave-graph-hook))))
- (snd-display #__line__ ";mouse-leave-graph-hook: ~A?" mouse-leave-graph-hook))
- (if (or (not (hook? mouse-leave-listener-hook)) (not (null? (hook-functions mouse-leave-listener-hook))))
- (snd-display #__line__ ";mouse-leave-listener-hook: ~A?" mouse-leave-listener-hook))
- (if (or (not (hook? initial-graph-hook)) (not (null? (hook-functions initial-graph-hook))))
- (snd-display #__line__ ";initial-graph-hook: ~A?" initial-graph-hook))
- (if (or (not (hook? after-graph-hook)) (not (null? (hook-functions after-graph-hook))))
- (snd-display #__line__ ";after-graph-hook: ~A?" after-graph-hook))
- (if (or (not (hook? graph-hook)) (not (null? (hook-functions graph-hook))))
- (snd-display #__line__ ";graph-hook: ~A?" graph-hook))
-
- (set! (show-controls) #t)
- (if with-gui
- (begin
- (let ((wid (enved-dialog) ))
- (if (not (equal? wid (list-ref (dialog-widgets) 2)))
- (snd-display #__line__ ";enved-dialog -> ~A ~A" wid (list-ref (dialog-widgets) 2))))
- ;(if (not (list-ref (dialog-widgets) 2)) (snd-display #__line__ ";enved-dialog?"))
- (set! (enved-envelope) '(0.0 0.0 1.0 1.0 2.0 0.0))
- (if (not (equal? (enved-envelope) (list 0.0 0.0 1.0 1.0 2.0 0.0)))
- (snd-display #__line__ ";set enved-envelope: ~A?" (enved-envelope)))
- (set! (enved-envelope) (enved-envelope))
- (if (not (equal? (enved-envelope) (list 0.0 0.0 1.0 1.0 2.0 0.0)))
- (snd-display #__line__ ";set enved-envelope to self: ~A?" (enved-envelope)))))
-
- (letrec ((test-vars
- (lambda (lst)
- (if (not (null? lst))
- (let* ((name (list-ref (car lst) 0))
- (getfnc (list-ref (car lst) 1))
- (setfnc (lambda (val) (set! (getfnc) val)))
- (initval (list-ref (car lst) 2))
- (newval (list-ref (car lst) 3)))
-
- (setfnc newval)
- (let ((nowval (getfnc)))
- (if (and (not (equal? newval nowval))
- (or (not (list? newval))
- (not (feql newval nowval))))
- (if (and (number? newval) (not (rational? newval)))
- (if (> (abs (- newval nowval)) .01)
- (snd-display #__line__ ";~A is not ~A (~A)" name newval nowval))
- (snd-display #__line__ ";~A is not ~A (~A)" name newval nowval)))
- (setfnc initval)
- (set! (getfnc) newval)
+
+ (when with-gui
+ (set! *show-controls* #t)
+
+ (let ((wid (enved-dialog) ))
+ (if (not (equal? wid ((dialog-widgets) 1)))
+ (snd-display #__line__ ";enved-dialog -> ~A ~A" wid ((dialog-widgets) 1))))
+ ;(if (not ((dialog-widgets) 1)) (snd-display #__line__ ";enved-dialog?"))
+ (set! (enved-envelope) '(0.0 0.0 1.0 1.0 2.0 0.0))
+ (if (not (equal? (enved-envelope) (list 0.0 0.0 1.0 1.0 2.0 0.0)))
+ (snd-display #__line__ ";set enved-envelope to self: ~A?" (enved-envelope)))
+
+ (letrec ((test-vars
+ (lambda (lst)
+ (if (pair? lst)
+ (let* ((name ((car lst) 0))
+ (getfnc ((car lst) 1))
+ (setfnc (lambda (val) (set! (getfnc) val)))
+ (initval ((car lst) 2))
+ (newval ((car lst) 3)))
+
+ (setfnc newval)
(let ((nowval (getfnc)))
(if (and (not (equal? newval nowval))
(or (not (list? newval))
(not (feql newval nowval))))
(if (and (number? newval) (not (rational? newval)))
(if (> (abs (- newval nowval)) .01)
- (snd-display #__line__ ";set! ~A is not ~A (~A)" name newval nowval))
- (snd-display #__line__ ";set! ~A is not ~A (~A)" name newval nowval)))
- (setfnc initval))
- (test-vars (cdr lst))))))))
- (test-vars
- (list
- (list 'amp-control amp-control 1.0 0.5)
- (list 'amp-control-bounds amp-control-bounds (list 0.0 8.0) (list 1.0 5.0))
- (list 'ask-about-unsaved-edits ask-about-unsaved-edits #f #t)
- (list 'ask-before-overwrite ask-before-overwrite #f #t)
- (list 'audio-input-device audio-input-device 0 1)
- (list 'audio-output-device audio-output-device 0 1)
- (list 'auto-resize auto-resize #t #f)
- (list 'auto-update auto-update #f #t)
- (list 'channel-style channel-style 0 1)
- (list 'colormap colormap good-colormap better-colormap)
- (list 'color-cutoff color-cutoff 0.003 0.01)
- (list 'color-inverted color-inverted #t #f)
- (list 'color-scale color-scale 1.0 0.5)
- (list 'contrast-control contrast-control 0.0 0.5)
- (list 'contrast-control-bounds contrast-control-bounds (list 0.0 10.0) (list 1.0 5.0))
- (list 'contrast-control-amp contrast-control-amp 1.0 0.5)
- (list 'contrast-control? contrast-control? #f #t)
- (list 'auto-update-interval auto-update-interval 60.0 120.0)
- (list 'cursor-update-interval cursor-update-interval 0.05 0.10)
- (list 'cursor-location-offset cursor-location-offset 0 32768)
- (list 'with-tracking-cursor with-tracking-cursor #f #t)
- (list 'cursor-size cursor-size 15 30)
- (list 'cursor-style cursor-style cursor-cross cursor-line)
- (list 'tracking-cursor-style tracking-cursor-style cursor-line cursor-cross)
- (list 'dac-combines-channels dac-combines-channels #t #f)
- (list 'dac-size dac-size 256 512)
- (list 'minibuffer-history-length minibuffer-history-length 8 16)
- (list 'clipping clipping #f #t)
- (list 'default-output-chans default-output-chans 1 2)
- (list 'default-output-data-format default-output-data-format 1 1)
- (list 'default-output-srate default-output-srate 22050 44100)
- (list 'default-output-header-type default-output-header-type mus-next mus-aifc)
- (list 'dot-size dot-size 1 4)
- (list 'enved-base enved-base 1.0 1.5)
- (list 'enved-clip? enved-clip? #f #t)
- (list 'enved-in-dB enved-in-dB #f #t)
- (list 'enved-style enved-style envelope-linear envelope-exponential)
- (list 'enved-power enved-power 3.0 3.5)
- (list 'enved-target enved-target 0 1)
- (list 'enved-wave? enved-wave? #f #t)
- (list 'eps-file eps-file "snd.eps" "snd-1.eps")
- (list 'eps-left-margin eps-left-margin 0.0 72.0)
- (list 'eps-size eps-size 1.0 2.0)
- (list 'eps-bottom-margin eps-bottom-margin 0.0 36.0)
- (list 'expand-control expand-control 1.0 2.0)
- (list 'expand-control-bounds expand-control-bounds (list .001 20.0) (list 1.0 2.0))
- (list 'expand-control-hop expand-control-hop 0.05 0.1)
- (list 'expand-control-jitter expand-control-jitter 0.1 0.2)
- (list 'expand-control-length expand-control-length 0.15 0.2)
- (list 'expand-control-ramp expand-control-ramp 0.4 0.2)
- (list 'expand-control? expand-control? #f #t)
- (list 'fft-window-alpha fft-window-alpha 0.0 1.0)
- (list 'fft-window-beta fft-window-beta 0.0 0.5)
- (list 'fft-log-frequency fft-log-frequency #f #t)
- (list 'fft-log-magnitude fft-log-magnitude #f #t)
- (list 'fft-with-phases fft-with-phases #f #t)
- (list 'transform-size transform-size 512 1024)
- (list 'transform-graph-type transform-graph-type graph-once graph-as-sonogram)
- (list 'fft-window fft-window 6 5)
- (list 'transform-graph? transform-graph? #f #t)
- (list 'filter-control-in-dB filter-control-in-dB #f #t)
- (list 'filter-control-envelope filter-control-envelope (list 0.0 1.0 1.0 1.0) (list 0.0 1.0 1.0 0.0))
- (list 'enved-filter enved-filter #t #f)
- (list 'enved-filter-order enved-filter-order 40 20)
- (list 'filter-control-in-hz filter-control-in-hz #f #t)
- (list 'filter-control-order filter-control-order 20 40)
- (list 'filter-control? filter-control? #f #t)
- (list 'graph-cursor graph-cursor 34 32)
- (list 'graph-style graph-style 0 1)
- (list 'initial-beg initial-beg 0.0 1.0)
- (list 'initial-dur initial-dur 0.1 1.0)
- (list 'just-sounds just-sounds #f #t)
- (list 'listener-prompt listener-prompt ">" ":")
- (list 'max-transform-peaks max-transform-peaks 100 10)
- (list 'max-regions max-regions 16 6)
- (list 'min-dB min-dB -60.0 -90.0)
- (list 'log-freq-start log-freq-start 32.0 10.0)
- (list 'mix-waveform-height mix-waveform-height 20 40)
- (list 'mix-tag-height mix-tag-height 14 20)
- (list 'mix-tag-width mix-tag-width 6 20)
- (list 'mark-tag-height mark-tag-height 4 20)
- (list 'mark-tag-width mark-tag-width 10 20)
- (list 'mus-prescaler mus-prescaler 1.0 100.0)
- (list 'mus-clipping mus-clipping #f #t)
- (list 'selection-creates-region selection-creates-region #t #f)
- (list 'transform-normalization transform-normalization normalize-by-channel dont-normalize)
- (list 'view-files-sort view-files-sort 0 1)
- (list 'play-arrow-size play-arrow-size 10 16)
- (list 'print-length print-length 12 16)
- (list 'region-graph-style region-graph-style graph-lines graph-lollipops)
- (list 'reverb-control-decay reverb-control-decay 1.0 2.0)
- (list 'reverb-control-feedback reverb-control-feedback 1.09 1.6)
- (list 'reverb-control-length reverb-control-length 1.0 2.0)
- (list 'reverb-control-length-bounds reverb-control-length-bounds (list 0.0 5.0) (list 1.0 2.0))
- (list 'reverb-control-lowpass reverb-control-lowpass 0.7 0.9)
- (list 'reverb-control-scale reverb-control-scale 0.0 0.2)
- (list 'reverb-control-scale-bounds reverb-control-scale-bounds (list 0.0 4.0) (list 0.0 0.2))
- (list 'reverb-control? reverb-control? #f #t)
- (list 'show-axes show-axes 1 0)
- (list 'show-full-duration show-full-duration #f #t)
- (list 'show-transform-peaks show-transform-peaks #f #t)
- (list 'show-indices show-indices #f #t)
- (list 'show-marks show-marks #t #f)
- (list 'show-mix-waveforms show-mix-waveforms #t #f)
- (list 'show-selection-transform show-selection-transform #f #t)
- (list 'show-y-zero show-y-zero #f #t)
- (list 'show-grid show-grid #f #t)
- (list 'grid-density grid-density 1.0 0.5)
- (list 'show-sonogram-cursor show-sonogram-cursor #f #t)
- (list 'sinc-width sinc-width 10 40)
- (list 'spectrum-end spectrum-end 1.0 0.7)
- (list 'spectro-hop spectro-hop 4 10)
- (list 'spectrum-start spectrum-start 0.0 0.1)
- (list 'spectro-x-angle spectro-x-angle (if (provided? 'gl) 300.0 90.0) 60.0)
- (list 'spectro-x-scale spectro-x-scale (if (provided? 'gl) 1.5 1.0) 2.0)
- (list 'spectro-y-angle spectro-y-angle (if (provided? 'gl) 320.0 0.0) 60.0)
- (list 'spectro-y-scale spectro-y-scale 1.0 2.0)
- (list 'spectro-z-angle spectro-z-angle (if (provided? 'gl) 0.0 358.0) 60.0)
- (list 'spectro-z-scale spectro-z-scale (if (provided? 'gl) 1.0 0.1) 0.2)
- (list 'speed-control speed-control 1.0 0.5)
- (list 'speed-control-bounds speed-control-bounds (list 0.05 20.0) (list 1.0 5.0))
- (list 'speed-control-style speed-control-style 0 1)
- (list 'speed-control-tones speed-control-tones 12 18)
- (list 'sync sync 0 1)
- (list 'sync-style sync-style sync-by-sound sync-all)
- (list 'tiny-font tiny-font (if (provided? 'snd-gtk) "Sans 8" "6x12") (if (provided? 'snd-gtk) "Monospace 10" "9x15"))
- (list 'transform-type transform-type fourier-transform autocorrelation)
- (list 'with-verbose-cursor with-verbose-cursor #f #t)
- (list 'wavelet-type wavelet-type 0 1)
- (list 'time-graph? time-graph? #f #t)
- (list 'time-graph-type time-graph-type graph-once graph-as-wavogram)
- (list 'wavo-hop wavo-hop 3 6)
- (list 'wavo-trace wavo-trace 64 128)
- (list 'with-mix-tags with-mix-tags #t #f)
- (list 'with-relative-panes with-relative-panes #t #f)
- (list 'with-gl with-gl (provided? 'gl) #f)
- (list 'x-axis-style x-axis-style 0 1)
- (list 'beats-per-minute beats-per-minute 30.0 120.0)
- (list 'beats-per-measure beats-per-measure 1 120)
- (list 'zero-pad zero-pad 0 1)
- (list 'zoom-focus-style zoom-focus-style 2 1))))
- (set! (ask-about-unsaved-edits) #f)
- (letrec ((test-bad-args
- (lambda (lst)
- (if (not (null? lst))
- (let* ((name (list-ref (car lst) 0))
- (getfnc (list-ref (car lst) 1))
- (setfnc (lambda (val) (set! (getfnc) val)))
- (initval (list-ref (car lst) 2))
- (newvals (list-ref (car lst) 3)))
- (for-each
- (lambda (n)
- (catch #t
- (lambda ()
- (setfnc n))
- (lambda args (car args)))
- (let ((nowval (getfnc)))
- (if (equal? n nowval)
- (snd-display #__line__ ";(bad set) ~A = ~A (~A)" name n initval))
- (setfnc initval)))
- newvals)
- (test-bad-args (cdr lst)))))))
- (test-bad-args
- (list
- (list 'amp-control amp-control 1.0 '(-1.0 123.123))
- (list 'amp-control-bounds amp-control-bounds (list 0.0 8.0) (list #f (list 0.0) (list 1.0 0.0) 2.0))
- (list 'channel-style channel-style 0 '(32 -1 1.0))
- (list 'colormap colormap good-colormap '(321 -123))
- (list 'color-cutoff color-cutoff 0.003 '(-1.0 123.123))
- (list 'color-scale color-scale 1.0 '(-32.0 2000.0))
- (list 'contrast-control contrast-control 0.0 '(-123.123 123.123))
- (list 'contrast-control-bounds contrast-control-bounds (list 0.0 10.0) (list #f (list 0.0) (list 1.0 0.0) 2.0))
- (list 'cursor-size cursor-size 15 '(1.123 -2.5))
- (list 'dac-size dac-size 256 '(-1 0 -123))
- (list 'dot-size dot-size 1 '(0 -1 -123))
- (list 'enved-target enved-target 0 '(123 -321))
- (list 'expand-control expand-control 1.0 '(-1.0 0.0))
- (list 'expand-control-bounds expand-control-bounds (list 0.001 20.0) (list #f (list 0.0) (list 1.0 0.0) 2.0))
- (list 'expand-control-hop expand-control-hop 0.05 '(-1.0))
- (list 'expand-control-length expand-control-length 0.15 '(-1.0 0.0))
- (list 'expand-control-ramp expand-control-ramp 0.4 '(-1.0 1.0 123.123))
- (list 'fft-window-alpha fft-window-alpha 0.0 '(-1.0 123.123))
- (list 'fft-window-beta fft-window-beta 0.0 '(-1.0 123.123))
- (list 'transform-size transform-size 512 '(-1 0))
- (list 'zero-pad zero-pad 0 '(-1 -123))
- (list 'cursor-style cursor-style cursor-cross '(-1))
- (list 'cursor-style cursor-style cursor-line '(2 123))
- (list 'tracking-cursor-style tracking-cursor-style cursor-line '(-1))
- (list 'tracking-cursor-style tracking-cursor-style cursor-line '(2 123))
- (list 'transform-graph-type transform-graph-type graph-once '(-1 123))
- (list 'fft-window fft-window 6 '(-1 123))
- (list 'enved-filter-order enved-filter-order 40 '(-1 0))
- (list 'filter-control-order filter-control-order 20 '(-10 -1 0))
- (list 'max-transform-peaks max-transform-peaks 100 '(-1))
- (list 'max-regions max-regions 16 '(-1 -123))
- (list 'view-files-sort view-files-sort 0 '(-1 123))
- (list 'reverb-control-length reverb-control-length 1.0 '(-1.0))
- (list 'show-axes show-axes 1 '(-1 123))
- (list 'sinc-width sinc-width 10 '(-10))
- (list 'spectrum-end spectrum-end 1.0 '(-1.0))
- (list 'spectro-hop spectro-hop 4 '(-10 -1 0))
- (list 'spectrum-start spectrum-start 0.0 '(-1.0))
- (list 'speed-control speed-control 1.0 '(0.0))
- (list 'speed-control-bounds speed-control-bounds (list 0.05 20.0) (list #f (list 0.0) (list 1.0 0.0) 2.0))
- (list 'speed-control-style speed-control-style 0 '(-1 10))
- (list 'sync-style sync-style sync-by-sound '(-1 123))
- (list 'transform-type transform-type fourier-transform (list (integer->transform -1) (integer->transform 123)))
- (list 'wavelet-type wavelet-type 0 '(-1 123))
- (list 'wavo-hop wavo-hop 1 '(0 -123))
- (list 'wavo-trace wavo-trace 1 '(0 -123))
- (list 'x-axis-style x-axis-style 0 '(-1 123))
- (list 'zoom-focus-style zoom-focus-style 2 '(-1 123)))))
-
- (set! (sync-style) sync-none)
-
- (set! (window-width) 300)
- (set! (window-height) 300)
- (if (not (equal? (window-width) 300))
- (snd-display #__line__ ";window width: ~A is not 300?" (window-width)))
- (if (not (equal? (window-height) 300))
- (snd-display #__line__ ";window height: ~A is not 300?" (window-height)))
-; (set! (window-x) 123)
-; (set! (window-y) 321)
-; (if (not (equal? (window-x) 123))
-; (snd-display #__line__ ";window x: ~A is not 123?" (window-x)))
-; (if (not (equal? (window-y) 321))
-; (snd-display #__line__ ";window y: ~A is not 321?" (window-y)))
-; (set! (window-y) 10) ; get it back out of harm's way
- (set! (color-scale) 100.0)
- (if (fneq (color-scale) 100.0) (snd-display #__line__ ";color-scale to 100: ~A" (color-scale)))
-
- (if (procedure? (search-procedure))
- (snd-display #__line__ ";global search procedure: ~A?" (search-procedure)))
- (set! (search-procedure) (lambda (y) (> y .1)))
- (if (not (procedure? (search-procedure)))
- (snd-display #__line__ ";set global search procedure: ~A?" (search-procedure)))
- (if (not ((search-procedure) .2))
- (snd-display #__line__ ";search > .1 .2"))
- (if ((search-procedure) .02)
- (snd-display #__line__ ";search > .1 .02"))
- (set! (search-procedure) (lambda (y) (< y 0.0)))
- (if ((search-procedure) .02)
- (snd-display #__line__ ";search < 0.0 .02"))
- (set! (search-procedure) #f)
- (if (procedure? (search-procedure))
- (snd-display #__line__ ";global search procedure after reset: ~A?" (search-procedure)))
- (set! (search-procedure) (lambda (y) (> y .1)))
- (if (not (procedure? (search-procedure)))
- (snd-display #__line__ ";set global search procedure: ~A?" (search-procedure)))
-
- (set! (enved-filter-order) 5)
- (if (not (= (enved-filter-order) 6)) (snd-display #__line__ ";set enved-filter-order 5: ~A" (enved-filter-order)))
- (if with-gui
- (begin
- (set! (enved-envelope) 'zero_to_one) ; funcs.cl above
- (if (not (feql (enved-envelope) zero_to_one)) (snd-display #__line__ ";set symbol enved-envelope: ~A ~A" (enved-envelope) zero_to_one))
- (set! (enved-envelope) "mod_down")
- (if (not (feql (enved-envelope) mod_down)) (snd-display #__line__ ";set string enved-envelope: ~A ~A" (enved-envelope) mod_down))))
-
+ (snd-display #__line__ ";~A is not ~A (~A)" name newval nowval))
+ (snd-display #__line__ ";~A is not ~A (~A)" name newval nowval)))
+ (setfnc initval)
+ (set! (getfnc) newval)
+ (let ((nowval (getfnc)))
+ (if (and (not (equal? newval nowval))
+ (or (not (list? newval))
+ (not (feql newval nowval))))
+ (if (and (number? newval) (not (rational? newval)))
+ (if (> (abs (- newval nowval)) .01)
+ (snd-display #__line__ ";set! ~A is not ~A (~A)" name newval nowval))
+ (snd-display #__line__ ";set! ~A is not ~A (~A)" name newval nowval)))
+ (setfnc initval))
+ (test-vars (cdr lst))))))))
+ (test-vars
+ (list
+ (list 'amp-control amp-control 1.0 0.5)
+ (list 'amp-control-bounds amp-control-bounds (list 0.0 8.0) (list 1.0 5.0))
+ (list 'ask-about-unsaved-edits ask-about-unsaved-edits #f #t)
+ (list 'ask-before-overwrite ask-before-overwrite #f #t)
+ (list 'auto-resize auto-resize #t #f)
+ (list 'auto-update auto-update #f #t)
+ (list 'channel-style channel-style 0 1)
+ (list 'colormap colormap good-colormap better-colormap)
+ (list 'color-cutoff color-cutoff 0.003 0.01)
+ (list 'color-inverted color-inverted #t #f)
+ (list 'color-scale color-scale 1.0 0.5)
+ (list 'contrast-control contrast-control 0.0 0.5)
+ (list 'contrast-control-bounds contrast-control-bounds (list 0.0 10.0) (list 1.0 5.0))
+ (list 'contrast-control-amp contrast-control-amp 1.0 0.5)
+ (list 'contrast-control? contrast-control? #f #t)
+ (list 'auto-update-interval auto-update-interval 60.0 120.0)
+ (list 'cursor-update-interval cursor-update-interval 0.05 0.10)
+ (list 'cursor-location-offset cursor-location-offset 0 32768)
+ (list 'with-tracking-cursor with-tracking-cursor #f #t)
+ (list 'cursor-size cursor-size 15 30)
+ (list 'cursor-style cursor-style cursor-cross cursor-line)
+ (list 'tracking-cursor-style tracking-cursor-style cursor-line cursor-cross)
+ (list 'dac-combines-channels dac-combines-channels #t #f)
+ (list 'dac-size dac-size 256 512)
+ (list 'clipping clipping #f #t)
+ (list 'default-output-chans default-output-chans 1 2)
+ (list 'default-output-sample-type default-output-sample-type 1 1)
+ (list 'default-output-srate default-output-srate 22050 44100)
+ (list 'default-output-header-type default-output-header-type mus-next mus-aifc)
+ (list 'dot-size dot-size 1 4)
+ (list 'enved-base enved-base 1.0 1.5)
+ (list 'enved-clip? enved-clip? #f #t)
+ (list 'enved-in-dB enved-in-dB #f #t)
+ (list 'enved-style enved-style envelope-linear envelope-exponential)
+ (list 'enved-power enved-power 3.0 3.5)
+ (list 'enved-target enved-target 0 1)
+ (list 'enved-wave? enved-wave? #f #t)
+ (list 'eps-file eps-file "snd.eps" "snd-1.eps")
+ (list 'eps-left-margin eps-left-margin 0.0 72.0)
+ (list 'eps-size eps-size 1.0 2.0)
+ (list 'eps-bottom-margin eps-bottom-margin 0.0 36.0)
+ (list 'expand-control expand-control 1.0 2.0)
+ (list 'expand-control-bounds expand-control-bounds (list .001 20.0) (list 1.0 2.0))
+ (list 'expand-control-hop expand-control-hop 0.05 0.1)
+ (list 'expand-control-jitter expand-control-jitter 0.1 0.2)
+ (list 'expand-control-length expand-control-length 0.15 0.2)
+ (list 'expand-control-ramp expand-control-ramp 0.4 0.2)
+ (list 'expand-control? expand-control? #f #t)
+ (list 'fft-window-alpha fft-window-alpha 0.0 1.0)
+ (list 'fft-window-beta fft-window-beta 0.0 0.5)
+ (list 'fft-log-frequency fft-log-frequency #f #t)
+ (list 'fft-log-magnitude fft-log-magnitude #f #t)
+ (list 'fft-with-phases fft-with-phases #f #t)
+ (list 'transform-size transform-size 512 1024)
+ (list 'transform-graph-type transform-graph-type graph-once graph-as-sonogram)
+ (list 'fft-window fft-window 6 5)
+ (list 'transform-graph? transform-graph? #f #t)
+ (list 'filter-control-in-dB filter-control-in-dB #f #t)
+ (list 'filter-control-envelope filter-control-envelope (list 0.0 1.0 1.0 1.0) (list 0.0 1.0 1.0 0.0))
+ (list 'enved-filter enved-filter #t #f)
+ (list 'enved-filter-order enved-filter-order 40 20)
+ (list 'filter-control-in-hz filter-control-in-hz #f #t)
+ (list 'filter-control-order filter-control-order 20 40)
+ (list 'filter-control? filter-control? #f #t)
+ (list 'graph-cursor graph-cursor 34 32)
+ (list 'graph-style graph-style 0 1)
+ (list 'initial-beg initial-beg 0.0 1.0)
+ (list 'initial-dur initial-dur 0.1 1.0)
+ (list 'just-sounds just-sounds #f #t)
+ (list 'listener-prompt listener-prompt ">" ":")
+ (list 'max-transform-peaks max-transform-peaks 100 10)
+ (list 'max-regions max-regions 16 6)
+ (list 'min-dB min-dB -60.0 -90.0)
+ (list 'log-freq-start log-freq-start 32.0 10.0)
+ (list 'mix-waveform-height mix-waveform-height 20 40)
+ (list 'mix-tag-height mix-tag-height 14 20)
+ (list 'mix-tag-width mix-tag-width 6 20)
+ (list 'mark-tag-height mark-tag-height 4 20)
+ (list 'mark-tag-width mark-tag-width 10 20)
+ (list 'mus-clipping mus-clipping #f #t)
+ (list 'selection-creates-region selection-creates-region #t #f)
+ (list 'transform-normalization transform-normalization normalize-by-channel dont-normalize)
+ (list 'play-arrow-size play-arrow-size 10 16)
+ (list 'print-length print-length 12 16)
+ (list 'region-graph-style region-graph-style graph-lines graph-lollipops)
+ (list 'reverb-control-decay reverb-control-decay 1.0 2.0)
+ (list 'reverb-control-feedback reverb-control-feedback 1.09 1.6)
+ (list 'reverb-control-length reverb-control-length 1.0 2.0)
+ (list 'reverb-control-length-bounds reverb-control-length-bounds (list 0.0 5.0) (list 1.0 2.0))
+ (list 'reverb-control-lowpass reverb-control-lowpass 0.7 0.9)
+ (list 'reverb-control-scale reverb-control-scale 0.0 0.2)
+ (list 'reverb-control-scale-bounds reverb-control-scale-bounds (list 0.0 4.0) (list 0.0 0.2))
+ (list 'reverb-control? reverb-control? #f #t)
+ (list 'show-axes show-axes 1 0)
+ (list 'show-full-duration show-full-duration #f #t)
+ (list 'show-full-range show-full-range #f #t)
+ (list 'show-transform-peaks show-transform-peaks #f #t)
+ (list 'show-indices show-indices #f #t)
+ (list 'show-marks show-marks #t #f)
+ (list 'show-mix-waveforms show-mix-waveforms #t #f)
+ (list 'show-selection-transform show-selection-transform #f #t)
+ (list 'show-y-zero show-y-zero #f #t)
+ (list 'show-grid show-grid #f #t)
+ (list 'grid-density grid-density 1.0 0.5)
+ (list 'show-sonogram-cursor show-sonogram-cursor #f #t)
+ (list 'sinc-width sinc-width 10 40)
+ (list 'spectrum-end spectrum-end 1.0 0.7)
+ (list 'spectro-hop spectro-hop 4 10)
+ (list 'spectrum-start spectrum-start 0.0 0.1)
+ (list 'spectro-x-angle spectro-x-angle (if (provided? 'gl) 300.0 90.0) 60.0)
+ (list 'spectro-x-scale spectro-x-scale (if (provided? 'gl) 1.5 1.0) 2.0)
+ (list 'spectro-y-angle spectro-y-angle (if (provided? 'gl) 320.0 0.0) 60.0)
+ (list 'spectro-y-scale spectro-y-scale 1.0 2.0)
+ (list 'spectro-z-angle spectro-z-angle (if (provided? 'gl) 0.0 358.0) 60.0)
+ (list 'spectro-z-scale spectro-z-scale (if (provided? 'gl) 1.0 0.1) 0.2)
+ (list 'speed-control speed-control 1.0 0.5)
+ (list 'speed-control-bounds speed-control-bounds (list 0.05 20.0) (list 1.0 5.0))
+ (list 'speed-control-style speed-control-style 0 1)
+ (list 'speed-control-tones speed-control-tones 12 18)
+ (list 'sync sync 0 1)
+ (list 'sync-style sync-style sync-by-sound sync-all)
+ (list 'tiny-font tiny-font (if (provided? 'snd-gtk) "Sans 8" "6x12") (if (provided? 'snd-gtk) "Monospace 10" "9x15"))
+ (list 'transform-type transform-type fourier-transform autocorrelation)
+ (list 'with-verbose-cursor with-verbose-cursor #f #t)
+ (list 'wavelet-type wavelet-type 0 1)
+ (list 'time-graph? time-graph? #f #t)
+ (list 'time-graph-type time-graph-type graph-once graph-as-wavogram)
+ (list 'wavo-hop wavo-hop 3 6)
+ (list 'wavo-trace wavo-trace 64 128)
+ (list 'with-mix-tags with-mix-tags #t #f)
+ (list 'with-relative-panes with-relative-panes #t #f)
+ (list 'with-gl with-gl (provided? 'gl) #f)
+ (list 'x-axis-style x-axis-style 0 1)
+ (list 'beats-per-minute beats-per-minute 30.0 120.0)
+ (list 'beats-per-measure beats-per-measure 1 120)
+ (list 'zero-pad zero-pad 0 1)
+ (list 'zoom-focus-style zoom-focus-style 2 1))))
+
+ (set! *ask-about-unsaved-edits* #f)
+ (letrec ((test-bad-args
+ (lambda (lst)
+ (if (pair? lst)
+ (let* ((name ((car lst) 0))
+ (getfnc ((car lst) 1))
+ (setfnc (lambda (val) (set! (getfnc) val)))
+ (initval ((car lst) 2))
+ (newvals ((car lst) 3)))
+ (for-each
+ (lambda (n)
+ (catch #t
+ (lambda ()
+ (setfnc n))
+ (lambda args (car args)))
+ (let ((nowval (getfnc)))
+ (if (equal? n nowval)
+ (snd-display #__line__ ";(bad set) ~A = ~A (~A)" name n initval))
+ (setfnc initval)))
+ newvals)
+ (test-bad-args (cdr lst)))))))
+ (test-bad-args
+ (list
+ (list 'amp-control amp-control 1.0 '(-1.0 123.123))
+ (list 'amp-control-bounds amp-control-bounds (list 0.0 8.0) (list #f (list 0.0) (list 1.0 0.0) 2.0))
+ (list 'channel-style channel-style 0 '(32 -1 1.0))
+ (list 'colormap colormap good-colormap '(321 -123))
+ (list 'color-cutoff color-cutoff 0.003 '(-1.0 123.123))
+ (list 'color-scale color-scale 1.0 '(-32.0 2000.0))
+ (list 'contrast-control contrast-control 0.0 '(-123.123 123.123))
+ (list 'contrast-control-bounds contrast-control-bounds (list 0.0 10.0) (list #f (list 0.0) (list 1.0 0.0) 2.0))
+ (list 'cursor-size cursor-size 15 '(1.123 -2.5))
+ (list 'dac-size dac-size 256 '(-1 0 -123))
+ (list 'dot-size dot-size 1 '(0 -1 -123))
+ (list 'enved-target enved-target 0 '(123 -321))
+ (list 'expand-control expand-control 1.0 '(-1.0 0.0))
+ (list 'expand-control-bounds expand-control-bounds (list 0.001 20.0) (list #f (list 0.0) (list 1.0 0.0) 2.0))
+ (list 'expand-control-hop expand-control-hop 0.05 '(-1.0))
+ (list 'expand-control-length expand-control-length 0.15 '(-1.0 0.0))
+ (list 'expand-control-ramp expand-control-ramp 0.4 '(-1.0 1.0 123.123))
+ (list 'fft-window-alpha fft-window-alpha 0.0 '(-1.0 123.123))
+ (list 'fft-window-beta fft-window-beta 0.0 '(-1.0 123.123))
+ (list 'transform-size transform-size 512 '(-1 0))
+ (list 'zero-pad zero-pad 0 '(-1 -123))
+ (list 'cursor-style cursor-style cursor-cross '(-1))
+ (list 'cursor-style cursor-style cursor-line '(2 123))
+ (list 'tracking-cursor-style tracking-cursor-style cursor-line '(-1))
+ (list 'tracking-cursor-style tracking-cursor-style cursor-line '(2 123))
+ (list 'transform-graph-type transform-graph-type graph-once '(-1 123))
+ (list 'fft-window fft-window 6 '(-1 123))
+ (list 'enved-filter-order enved-filter-order 40 '(-1 0))
+ (list 'filter-control-order filter-control-order 20 '(-10 -1 0))
+ (list 'max-transform-peaks max-transform-peaks 100 '(-1))
+ (list 'max-regions max-regions 16 '(-1 -123))
+ (list 'reverb-control-length reverb-control-length 1.0 '(-1.0))
+ (list 'show-axes show-axes 1 '(-1 123))
+ (list 'sinc-width sinc-width 10 '(-10))
+ (list 'spectrum-end spectrum-end 1.0 '(-1.0))
+ (list 'spectro-hop spectro-hop 4 '(-10 -1 0))
+ (list 'spectrum-start spectrum-start 0.0 '(-1.0))
+ (list 'speed-control speed-control 1.0 '(0.0))
+ (list 'speed-control-bounds speed-control-bounds (list 0.05 20.0) (list #f (list 0.0) (list 1.0 0.0) 2.0))
+ (list 'speed-control-style speed-control-style 0 '(-1 10))
+ (list 'sync-style sync-style sync-by-sound '(-1 123))
+ (list 'transform-type transform-type fourier-transform (list (integer->transform -1) (integer->transform 123)))
+ (list 'wavelet-type wavelet-type 0 '(-1 123))
+ (list 'wavo-hop wavo-hop 1 '(0 -123))
+ (list 'wavo-trace wavo-trace 1 '(0 -123))
+ (list 'x-axis-style x-axis-style 0 '(-1 123))
+ (list 'zoom-focus-style zoom-focus-style 2 '(-1 123)))))
+
+ (set! *sync-style* sync-none)
+
+ (set! (window-width) 300)
+ (set! (window-height) 300)
+ (if (<= (window-width) 30)
+ (snd-display #__line__ ";window width: ~A is not 300?" (window-width)))
+ (if (<= (window-height) 30)
+ (snd-display #__line__ ";window height: ~A is not 300?" (window-height)))
+ ; (set! (window-x) 123)
+ ; (set! (window-y) 321)
+ ; (if (not (equal? (window-x) 123))
+ ; (snd-display #__line__ ";window x: ~A is not 123?" (window-x)))
+ ; (if (not (equal? (window-y) 321))
+ ; (snd-display #__line__ ";window y: ~A is not 321?" (window-y)))
+ ; (set! (window-y) 10) ; get it back out of harm's way
+ (set! *color-scale* 100.0)
+ (if (fneq *color-scale* 100.0) (snd-display #__line__ ";color-scale to 100: ~A" *color-scale*))
+
+ (if (procedure? (search-procedure))
+ (snd-display #__line__ ";global search procedure: ~A?" (search-procedure)))
+ (set! (search-procedure) (lambda (y) (> y .1)))
+ (if (not (procedure? (search-procedure)))
+ (snd-display #__line__ ";set global search procedure: ~A?" (search-procedure)))
+ (if (not ((search-procedure) .2))
+ (snd-display #__line__ ";search > .1 .2"))
+ (if ((search-procedure) .02)
+ (snd-display #__line__ ";search > .1 .02"))
+ (set! (search-procedure) (lambda (y) (< y 0.0)))
+ (if ((search-procedure) .02)
+ (snd-display #__line__ ";search < 0.0 .02"))
+ (set! (search-procedure) #f)
+ (if (procedure? (search-procedure))
+ (snd-display #__line__ ";global search procedure after reset: ~A?" (search-procedure)))
+ (set! (search-procedure) (lambda (y) (> y .1)))
+ (if (not (procedure? (search-procedure)))
+ (snd-display #__line__ ";set global search procedure: ~A?" (search-procedure)))
+
+ (set! *enved-filter-order* 5)
+ (if (not (= *enved-filter-order* 6)) (snd-display #__line__ ";set enved-filter-order 5: ~A" *enved-filter-order*))
+ (if with-gui
+ (begin
+ (set! (enved-envelope) 'zero_to_one) ; funcs.scm above
+ (if (not (feql (enved-envelope) zero_to_one)) (snd-display #__line__ ";set symbol enved-envelope: ~A ~A" (enved-envelope) zero_to_one))
+ (set! (enved-envelope) "mod_down")
+ (if (not (feql (enved-envelope) mod_down)) (snd-display #__line__ ";set string enved-envelope: ~A ~A" (enved-envelope) mod_down))))
+
+ (dismiss-all-dialogs))
(close-sound ind)
- (dismiss-all-dialogs)
-
- (let ((undef '())
- (names (list '*snd-opened-sound* 'abort 'add-clm-field 'add-colormap
- 'add-directory-to-view-files-list 'add-file-filter 'add-file-sorter 'add-file-to-view-files-list 'add-mark
+
+ (let ((undef ())
+ (names (list '*snd-opened-sound* 'abort 'add-colormap 'add-mark
'add-player 'add-sound-file-extension 'add-source-file-extension 'add-to-main-menu 'add-to-menu
'add-transform 'after-apply-controls-hook 'after-edit-hook 'after-graph-hook 'after-lisp-graph-hook
'after-open-hook 'after-save-as-hook 'after-save-state-hook 'after-transform-hook 'all-pass
- 'all-pass? 'amp-control 'amp-control-bounds 'amplitude-modulate 'analyse-ladspa
- 'apply-controls 'apply-ladspa 'array->file 'array-interp 'as-one-edit 'ask-about-unsaved-edits
- 'ask-before-overwrite 'asymmetric-fm 'asymmetric-fm? 'audio-input-device 'audio-output-device
+ 'all-pass? 'amp-control 'amp-control-bounds 'amplitude-modulate
+ 'apply-controls 'array->file 'array-interp 'as-one-edit 'ask-about-unsaved-edits
+ 'ask-before-overwrite 'asymmetric-fm 'asymmetric-fm?
'auto-resize 'auto-update 'auto-update-interval 'autocorrelate 'autocorrelation
- 'moving-average 'moving-average? 'axis-color 'axis-info 'axis-label-font 'axis-numbers-font
+ 'axis-color 'axis-info 'axis-label-font 'axis-numbers-font
'bad-header-hook 'bartlett-window 'bartlett-hann-window 'basic-color 'beats-per-measure 'beats-per-minute
'before-close-hook 'before-exit-hook 'before-save-as-hook 'before-save-state-hook 'before-transform-hook
'bind-key 'blackman2-window 'blackman3-window 'blackman4-window
'blackman5-window 'blackman6-window 'blackman7-window 'blackman8-window 'blackman9-window 'blackman10-window
- 'bohman-window 'bold-peaks-font 'bomb 'cauchy-window 'mlt-sine-window
- 'cepstrum 'change-samples-with-origin 'channel->vct 'channel-amp-envs 'channel-data
+ 'bohman-window 'bold-peaks-font 'cauchy-window 'mlt-sine-window
+ 'cepstrum 'change-samples-with-origin 'channel->float-vector 'channel-amp-envs
'channel-properties 'channel-property 'channel-style 'channel-widgets 'channels 'channels-combined
- 'channels-separate 'channels-superimposed 'chans 'clear-array 'clear-listener
- 'clear-minibuffer 'clear-sincs 'clip-hook 'clipping 'clm-channel 'clm-print
+ 'channels-separate 'channels-superimposed 'chans 'clear-listener
+ 'clip-hook 'clipping 'clm-channel
'clm-table-size 'clm-default-frequency 'close-hook 'close-sound 'color->list
'color-cutoff 'color-orientation-dialog 'color-hook 'color-inverted 'color-scale
'color? 'colormap 'colormap-name 'colormap-ref 'colormap-size
'colormap? 'comb 'comb? 'combined-data-color 'comment 'connes-window
- 'continue-frame->file 'continue-sample->file 'contrast-control 'contrast-control-amp 'contrast-control-bounds
+ 'continue-frample->file 'continue-sample->file 'contrast-control 'contrast-control-amp 'contrast-control-bounds
'contrast-control? 'contrast-enhancement 'controls->channel 'convolution 'convolve
'convolve-files 'convolve-selection-with 'convolve-with 'convolve? 'copy-context
- 'copy-sampler 'count-matches 'current-edit-position
+ 'copy-sampler 'current-edit-position
'current-font 'cursor 'cursor-color 'cursor-context 'cursor-cross
'cursor-in-middle 'cursor-in-view 'cursor-line 'cursor-location-offset 'cursor-on-left
'cursor-on-right 'cursor-position 'cursor-size 'cursor-style 'cursor-update-interval
- 'dac-combines-channels 'dac-hook 'dac-size 'data-color 'data-format
- 'data-location 'data-size 'db->linear 'default-output-chans 'default-output-data-format
+ 'dac-combines-channels 'dac-size 'data-color 'sample-type
+ 'data-location 'data-size 'db->linear 'default-output-chans 'default-output-sample-type
'default-output-header-type 'default-output-srate 'define-envelope 'degrees->radians 'delay
- 'delay-tick 'delay? 'delete-colormap 'delete-file-filter 'delete-file-sorter
+ 'delay-tick 'delay? 'delete-colormap
'delete-mark 'delete-marks 'delete-sample 'delete-samples 'delete-samples-and-smooth
'delete-selection 'delete-selection-and-smooth 'delete-transform 'dialog-widgets 'disk-kspace
'display-edits 'dolph-chebyshev-window 'dont-normalize
@@ -2156,24 +2275,24 @@
'enved-hook 'enved-in-dB 'enved-move-point 'enved-power 'enved-spectrum
'enved-srate 'enved-style 'enved-target 'enved-wave? 'enved-waveform-color
'envelope-exponential 'envelope-linear 'eps-bottom-margin 'eps-file
- 'eps-left-margin 'eps-size 'exit 'exit-hook
+ 'eps-left-margin 'eps-size 'even-multiple 'even-weight 'exit 'exit-hook
'expand-control 'expand-control-bounds 'expand-control-hop 'expand-control-jitter 'expand-control-length
'expand-control-ramp 'expand-control? 'exponential-window 'fft 'fft-log-frequency
'fft-log-magnitude 'fft-window 'fft-window-alpha 'fft-window-beta 'fft-with-phases 'file->array
- 'file->frame 'file->frame? 'file->sample 'file->sample? 'file->string
+ 'file->frample 'file->frample? 'file->sample 'file->sample? 'file->string
'file-name 'file-write-date 'fill-polygon 'fill-rectangle 'filter
'filtered-comb 'filtered-comb?
'filter-channel 'filter-control-coeffs 'filter-control-envelope 'filter-control-in-dB 'filter-control-in-hz
'filter-control-order 'filter-control-waveform-color 'filter-control? 'filter-selection 'filter-sound
- 'filter? 'find-channel 'find-dialog 'find-mark 'find-sound
+ 'filter? 'find-dialog 'find-mark 'find-sound
'finish-progress-report 'fir-filter 'fir-filter? 'flat-top-window 'focus-widget 'foreground-color
- 'forget-region 'formant 'formant-bank 'formant? 'firmant 'firmant?
+ 'forget-region 'formant 'formant-bank 'formant-bank? 'formant? 'firmant 'firmant?
+ 'comb-bank 'comb-bank? 'all-pass-bank 'all-pass-bank? 'filtered-comb-bank 'filtered-comb-bank?
+ 'make-comb-bank 'make-all-pass-bank 'make-filtered-comb-bank
'fourier-transform
- 'frame 'frame* 'frame+ 'frame->file 'frame->file?
- 'frame->frame 'frame->list 'frame->sample 'frame-ref 'frame-set!
- 'frame? 'frames 'free-player
- 'free-sampler 'gaussian-window 'gc-off 'gc-on
- 'gl-graph->ps 'glSpectrogram 'goto-listener-end 'granulate 'granulate?
+ 'free-player 'free-sampler 'gaussian-window 'gc-off 'gc-on
+ ;'gl-graph->ps 'glSpectrogram
+ 'goto-listener-end 'granulate 'granulate?
'graph 'graph->ps 'graph-as-sonogram 'graph-as-spectrogram 'graph-as-wavogram
'graph-color 'graph-cursor 'graph-data 'graph-dots 'graph-dots-and-lines
'graph-filled 'graph-hook 'graph-lines 'graph-lollipops 'graph-once
@@ -2181,129 +2300,127 @@
'hann-poisson-window 'hann-window 'header-type 'help-dialog
'help-hook 'hide-widget 'highlight-color 'html-dir 'html-program
'hz->radians 'iir-filter 'iir-filter? 'in 'in-any
- 'ina 'inb 'info-dialog 'init-ladspa 'initial-graph-hook
+ 'ina 'inb 'info-dialog 'initial-graph-hook
'insert-file-dialog 'insert-region 'insert-sample 'insert-samples 'insert-samples-with-origin
'insert-selection 'insert-silence 'insert-sound 'just-sounds 'kaiser-window
- 'key 'key-binding 'key-press-hook 'keyboard-no-action 'ladspa-activate
- 'ladspa-cleanup 'ladspa-connect-port 'ladspa-deactivate 'ladspa-descriptor 'ladspa-dir 'peak-env-dir
- 'ladspa-instantiate 'ladspa-run 'ladspa-run-adding 'ladspa-set-run-adding-gain 'left-sample
+ 'key 'key-binding 'key-press-hook 'keyboard-no-action 'peak-env-dir
+; 'ladspa-activate 'ladspa-cleanup 'ladspa-connect-port 'ladspa-deactivate 'ladspa-descriptor 'ladspa-dir
+; 'ladspa-instantiate 'ladspa-run 'ladspa-run-adding 'ladspa-set-run-adding-gain 'list-ladspa 'init-ladspa 'apply-ladspa 'analyse-ladspa
+ 'left-sample
'linear->db 'lisp-graph 'lisp-graph-hook 'lisp-graph-style 'lisp-graph?
- 'list->vct 'list-ladspa 'listener-click-hook 'listener-color 'listener-font
+ 'listener-click-hook 'listener-color 'listener-font
'listener-prompt 'listener-selection 'listener-text-color 'little-endian? 'locsig
'locsig-ref 'locsig-reverb-ref 'locsig-reverb-set! 'locsig-set! 'locsig-type
'locsig? 'log-freq-start 'main-menu 'main-widgets 'make-all-pass
- 'make-asymmetric-fm 'make-moving-average 'make-bezier 'make-color 'make-comb 'make-filtered-comb
- 'make-convolve 'make-delay 'make-env 'make-fft-window 'make-file->frame
- 'make-file->sample 'make-filter 'make-fir-coeffs 'make-fir-filter 'make-formant 'make-firmant
- 'make-frame 'make-frame->file 'make-granulate 'make-graph-data 'make-iir-filter
- 'make-locsig 'make-mix-sampler 'make-mixer 'make-move-sound 'make-notch 'make-one-pole
+ 'make-asymmetric-fm 'make-moving-average 'make-moving-max 'make-moving-norm 'make-bezier 'make-color 'make-comb 'make-filtered-comb
+ 'make-convolve 'make-delay 'make-env 'make-fft-window 'make-file->frample
+ 'make-file->sample 'make-filter 'make-fir-coeffs 'make-fir-filter 'make-formant 'make-firmant 'make-formant-bank
+ 'make-granulate 'make-graph-data 'make-iir-filter
+ 'make-locsig 'make-mix-sampler 'make-move-sound 'make-notch 'make-one-pole 'make-one-pole-all-pass
'make-one-zero 'make-oscil 'make-phase-vocoder 'make-player 'make-polyshape 'make-polywave
'make-pulse-train 'make-rand 'make-rand-interp 'make-readin
'make-region 'make-region-sampler 'make-sample->file 'make-sampler 'make-sawtooth-wave
- 'make-scalar-mixer 'make-nrxysin 'make-nrxycos 'make-snd->sample 'make-sound-data 'make-square-wave
+ 'make-nrxysin 'make-nrxycos 'make-rxyk!cos 'make-rxyk!sin
+ 'make-snd->sample 'make-square-wave
'make-src 'make-ssb-am 'make-ncos 'make-nsin 'make-table-lookup
'make-triangle-wave 'make-two-pole 'make-two-zero
- 'make-variable-graph 'make-vct 'make-wave-train
- 'map-chan 'map-channel 'mark-click-hook 'mark-color 'mark-context
+ 'make-variable-graph 'make-float-vector 'make-wave-train
+ 'map-channel 'mark-click-hook 'mark-color 'mark-context
'mark-drag-hook 'mark-home 'mark-hook 'mark-name 'mark-properties 'mark-property
'mark-sample 'mark-sync 'mark-sync-max 'mark-tag-height 'mark-tag-width
- 'mark? 'marks 'max-regions 'max-transform-peaks 'max-virtual-ptrees 'maxamp
- 'maxamp-position 'menu-widgets 'min-dB 'minibuffer-history-length 'mix
+ 'mark? 'marks 'max-regions 'max-transform-peaks 'maxamp
+ 'maxamp-position 'menu-widgets 'min-dB 'mix
'mix-amp 'mix-amp-env 'mix-click-hook 'mix-color
'mix-dialog-mix 'mix-drag-hook 'mix-file-dialog 'mix-length 'mix-home
'mix-name 'mix-position 'mix-properties 'mix-property 'mix-region 'mix-release-hook 'mix-sync 'mix-sync-max
'mix-sampler? 'mix-selection 'mix-speed 'mix-tag-height
'mix-tag-width 'mix-tag-y
- 'mix-vct 'mix-waveform-height 'mix? 'mixer 'mixer*
- 'mixer+ 'mixer-ref 'mixer-set! 'mixer?
+ 'mix-float-vector 'mix-waveform-height 'mix?
'mixes 'mouse-click-hook 'mouse-drag-hook 'mouse-enter-graph-hook
'mouse-enter-label-hook 'mouse-enter-listener-hook 'mouse-enter-text-hook 'mouse-leave-graph-hook 'mouse-leave-label-hook
- 'mouse-leave-listener-hook 'mouse-leave-text-hook 'mouse-press-hook 'move-locsig 'move-sound 'move-sound? 'multiply-arrays
+ 'mouse-leave-listener-hook 'mouse-leave-text-hook 'mouse-press-hook 'move-locsig 'move-sound 'move-sound?
+ 'moving-average 'moving-average? 'moving-max 'moving-max? 'moving-norm 'moving-norm?
'mus-aifc 'mus-aiff 'mus-alaw 'mus-alsa-buffer-size 'mus-alsa-buffers
'mus-alsa-capture-device 'mus-alsa-device 'mus-alsa-playback-device 'mus-alsa-squelch-warning 'mus-apply
'mus-array-print-length 'mus-float-equal-fudge-factor
-
'mus-b24int 'mus-bdouble 'mus-bdouble-unscaled
'mus-bfloat 'mus-bfloat-unscaled 'mus-bicsf 'mus-bint 'mus-bintn
'mus-bshort 'mus-byte 'mus-bytes-per-sample 'mus-caff 'mus-channel 'mus-channels
'mus-chebyshev-first-kind 'mus-chebyshev-second-kind 'mus-clipping 'mus-close
- 'mus-data 'mus-data-format->string 'mus-data-format-name 'mus-describe 'mus-error-hook
+ 'mus-data 'mus-sample-type->string 'mus-sample-type-name 'mus-describe 'mus-error-hook
'mus-error-type->string 'mus-expand-filename 'mus-feedback 'mus-feedforward 'mus-fft
- 'mus-file-buffer-size 'mus-file-clipping 'mus-file-name 'mus-file-prescaler
+ 'mus-file-buffer-size 'mus-file-clipping 'mus-file-name
'mus-frequency 'mus-generator? 'mus-header-raw-defaults 'mus-header-type->string 'mus-header-type-name
'mus-hop 'mus-increment 'mus-input? 'mus-interp-all-pass 'mus-interp-bezier
'mus-interp-hermite 'mus-interp-lagrange 'mus-interp-linear 'mus-interp-none 'mus-interp-sinusoidal
'mus-interp-type 'mus-interpolate 'mus-ircam 'mus-l24int 'mus-ldouble
'mus-ldouble-unscaled 'mus-length 'mus-lfloat 'mus-lfloat-unscaled 'mus-lint
'mus-lintn 'mus-location 'mus-lshort 'mus-max-malloc 'mus-max-table-size
- 'mus-mix 'mus-mulaw 'mus-name
+ 'mus-file-mix 'mus-mulaw 'mus-name
'mus-next 'mus-nist 'mus-offset 'mus-order 'mus-oss-set-buffers
- 'mus-out-format 'mus-output? 'mus-phase 'mus-prescaler 'mus-ramp
+ 'mus-out-format 'mus-output? 'mus-phase 'mus-ramp
'mus-rand-seed 'mus-random 'mus-raw 'mus-reset 'mus-riff
- 'mus-run 'mus-scaler 'mus-set-formant-radius-and-frequency 'mus-sound-chans 'mus-sound-close-input
- 'mus-sound-close-output 'mus-sound-comment 'mus-sound-data-format 'mus-sound-data-location 'mus-sound-datum-size
- 'mus-sound-duration 'mus-sound-forget 'mus-sound-frames 'mus-sound-header-type 'mus-sound-length
- 'mus-sound-loop-info 'mus-sound-mark-info 'mus-sound-maxamp 'mus-sound-maxamp-exists? 'mus-sound-open-input 'mus-sound-open-output
- 'mus-sound-prune 'mus-sound-read 'mus-sound-reopen-output 'mus-sound-report-cache 'mus-sound-samples
- 'mus-sound-seek-frame 'mus-sound-srate 'mus-sound-type-specifier 'mus-sound-write 'mus-sound-write-date
+ 'mus-run 'mus-scaler 'mus-set-formant-radius-and-frequency 'mus-sound-chans
+ 'mus-sound-comment 'mus-sound-sample-type 'mus-sound-data-location 'mus-sound-datum-size
+ 'mus-sound-duration 'mus-sound-forget 'mus-sound-framples 'mus-sound-header-type 'mus-sound-length
+ 'mus-sound-loop-info 'mus-sound-mark-info 'mus-sound-maxamp 'mus-sound-maxamp-exists? 'mus-sound-path
+ 'mus-sound-prune 'mus-sound-report-cache 'mus-sound-samples
+ 'mus-sound-srate 'mus-sound-type-specifier 'mus-sound-write-date
'mus-soundfont 'mus-srate 'mus-svx 'mus-ubshort
- 'mus-ubyte 'mus-ulshort 'mus-unknown 'mus-unsupported 'mus-voc
+ 'mus-ubyte 'mus-ulshort 'mus-unknown-sample 'mus-unknown-header 'mus-voc
'mus-width 'mus-xcoeff 'mus-xcoeffs 'mus-ycoeff 'mus-ycoeffs
'name-click-hook 'new-sound 'new-sound-dialog 'new-sound-hook 'new-widget-hook
'next-sample 'normalize-by-channel 'normalize-by-sound 'normalize-channel 'normalize-globally
- 'notch 'notch? 'one-pole 'one-pole? 'one-zero
- 'one-zero? 'open-file-dialog 'open-file-dialog-directory 'open-hook 'open-raw-sound 'open-raw-sound-hook
- 'open-sound 'optimization 'optimization-hook
+ 'notch 'notch? 'odd-multiple 'odd-weight 'one-pole 'one-pole? 'one-pole-all-pass 'one-pole-all-pass?
+ 'one-zero 'one-zero? 'open-file-dialog 'open-file-dialog-directory 'open-hook 'open-raw-sound 'open-raw-sound-hook
+ 'open-sound
'orientation-hook 'oscil 'oscil? 'out-any 'outa
- 'outb 'outc 'outd 'output-comment-hook 'output-name-hook
+ 'outb 'outc 'outd 'output-comment-hook
'override-samples-with-origin 'pad-channel 'partials->polynomial 'partials->wave
- 'parzen-window 'pausing 'peak-env-hook 'peaks 'peaks-font
+ 'parzen-window 'pausing 'peaks 'peaks-font
'phase-partials->wave 'phase-vocoder 'phase-vocoder-amp-increments 'phase-vocoder-amps 'phase-vocoder-freqs
'phase-vocoder-phase-increments 'phase-vocoder-phases 'phase-vocoder? 'play 'play-arrow-size
'play-hook 'player-home 'player? 'players
'playing 'poisson-window 'polar->rectangular 'polynomial 'polyshape 'polywave
'polyshape? 'polywave? 'position->x 'position->y 'position-color 'preferences-dialog
- 'previous-sample 'print-dialog 'print-hook 'print-length 'progress-report
- 'prompt-in-minibuffer 'ptree-channel 'pulse-train
+ 'previous-sample 'print-dialog 'print-length 'progress-report
+ 'pulse-train
'pulse-train? 'radians->degrees 'radians->hz
'ramp-channel 'rand 'rand-interp 'rand-interp? 'rand?
- 'read-hook 'read-mix-sample 'read-only 'read-region-sample
+ 'read-mix-sample 'read-only 'read-region-sample
'read-sample 'readin 'readin?
'rectangular->magnitudes 'rectangular->polar 'rectangular-window 'redo 'redo-edit
- 'region->vct 'region-chans 'region-home 'region-frames 'region-graph-style 'region-maxamp
+ 'region->float-vector 'region-chans 'region-home 'region-framples 'region-graph-style 'region-maxamp
'region-maxamp-position 'region-position 'region-sample 'region-sampler? 'region-srate
- 'region? 'regions 'remember-sound-state 'remove-from-menu 'report-in-minibuffer
+ 'region? 'regions 'remember-sound-state 'remove-from-menu 'status-report
'reset-controls 'reset-listener-cursor 'restore-controls 'restore-region
'reverb-control-decay 'reverb-control-feedback 'reverb-control-length 'reverb-control-length-bounds 'reverb-control-lowpass
'reverb-control-scale 'reverb-control-scale-bounds 'reverb-control? 'reverse-channel 'reverse-selection
'reverse-sound 'revert-sound 'riemann-window 'right-sample 'ring-modulate
- 'run 'rv2-window 'rv3-window 'rv4-window
+ 'rv2-window 'rv3-window 'rv4-window
'samaraki-window 'sample 'sample->file
- 'sample->file? 'sample->frame 'sampler-at-end? 'sampler-home 'sampler-position
+ 'sample->file? 'sampler-at-end? 'sampler-home 'sampler-position
'sampler? 'samples 'samples->seconds 'sash-color
'save-controls 'save-dir 'save-edit-history 'save-envelopes 'save-hook
- 'save-listener 'save-macros 'save-marks 'save-region 'save-region-dialog
+ 'save-listener 'save-marks 'save-region 'save-region-dialog
'save-selection 'save-selection-dialog 'save-sound 'save-sound-as 'save-sound-dialog
'save-state 'save-state-file 'save-state-hook 'sawtooth-wave 'sawtooth-wave?
'scale-by 'scale-channel 'scale-selection-by 'scale-selection-to 'scale-to
- 'scan-chan 'scan-channel 'script-arg 'script-args 'search-procedure
+ 'scan-channel 'script-arg 'script-args 'search-procedure
'seconds->samples 'select-all 'select-channel 'select-channel-hook 'select-sound
'select-sound-hook 'selected-channel 'selected-data-color 'selected-graph-color 'selected-sound
'selection-chans 'selection-color 'selection-context 'selection-creates-region
- 'selection-frames 'selection-maxamp 'selection-maxamp-position 'selection-member? 'selection-position
+ 'selection-framples 'selection-maxamp 'selection-maxamp-position 'selection-member? 'selection-position
'selection-srate 'selection?
'short-file-name 'show-all-axes 'show-all-axes-unlabelled 'show-bare-x-axis
- 'show-axes 'show-controls 'show-grid 'show-indices 'show-full-duration 'initial-beg 'initial-dur
+ 'show-axes 'show-controls 'show-grid 'show-indices 'show-full-duration 'show-full-range 'initial-beg 'initial-dur
'show-listener 'show-marks 'show-mix-waveforms 'show-no-axes 'show-selection 'show-selection-transform
'show-sonogram-cursor 'show-transform-peaks 'show-widget 'show-x-axis 'show-x-axis-unlabelled
- 'show-y-zero 'sinc-width 'nrxysin 'nrxysin? 'nrxycos 'nrxycos?
+ 'show-y-zero 'sinc-width 'nrxysin 'nrxysin? 'nrxycos 'nrxycos? 'rxyk!cos 'rxyk!cos? 'rxyk!sin 'rxyk!sin?
'smooth-channel 'smooth-selection 'smooth-sound 'snd->sample 'snd->sample?
'snd-error 'snd-error-hook 'snd-gcs 'snd-help 'snd-font 'snd-color
- 'snd-print 'snd-simulate-keystroke 'snd-spectrum 'snd-tempnam 'snd-url
- 'snd-urls 'snd-version 'snd-warning 'snd-warning-hook 'sound-data->sound-data
- 'sound-data->vct 'sound-data-chans 'sound-data-length 'sound-data-maxamp 'sound-data-ref 'sound-data-peak
- 'sound-data-set! 'sound-data-scale! 'sound-data-fill! 'sound-data?
- 'sound-data-multiply! 'sound-data-add! 'sound-data-offset! 'sound-data* 'sound-data+ 'sound-data-copy 'sound-data-reverse!
+ 'snd-print 'snd-spectrum 'snd-tempnam 'snd-url
+ 'snd-urls 'snd-version 'snd-warning 'snd-warning-hook
'sound-file-extensions 'sound-file? 'sound-files-in-directory
'sound-loop-info 'sound-properties 'sound-property 'sound-widgets 'sound? 'soundfont-info
'sounds 'spectrum-end 'spectro-hop 'spectrum-start 'spectro-x-angle
@@ -2311,35 +2428,32 @@
'spectrum 'speed-control 'speed-control-as-float 'speed-control-as-ratio 'speed-control-as-semitone
'speed-control-bounds 'speed-control-style 'speed-control-tones 'square-wave 'square-wave?
'squelch-update 'srate 'src 'src-channel 'src-selection
- 'src-sound 'src? 'ssb-am 'ssb-am? 'start-hook
- 'start-playing 'start-playing-hook 'start-playing-selection-hook 'start-progress-report 'stop-dac-hook
+ 'src-sound 'src? 'ssb-am 'ssb-am?
+ 'start-playing 'start-playing-hook 'start-playing-selection-hook 'start-progress-report
'stop-player 'stop-playing 'stop-playing-hook 'stop-playing-selection-hook 'ncos
'ncos? 'nsin 'nsin? 'swap-channels 'sync 'sync-style 'sync-none 'sync-all 'sync-by-sound
- 'sync-max 'syncd-marks 'table-lookup 'table-lookup? 'tap
+ 'sync-max 'syncd-marks 'table-lookup 'table-lookup? 'tap 'tap?
'temp-dir 'text-focus-color 'time-graph 'time-graph-style
'time-graph-type 'time-graph? 'tiny-font
- 'tracking-cursor-style 'transform->vct
- 'transform-dialog 'transform-frames 'transform-graph 'transform-graph-style 'transform-graph-type
+ 'tracking-cursor-style 'transform->float-vector
+ 'transform-dialog 'transform-framples 'transform-graph 'transform-graph-style 'transform-graph-type
'transform-graph? 'transform-normalization 'transform-sample 'transform-size 'transform-type
- 'transform? 'trap-segfault 'triangle-wave 'triangle-wave? 'tukey-window
+ 'transform? 'triangle-wave 'triangle-wave? 'tukey-window
'two-pole 'two-pole? 'two-zero 'two-zero? 'ultraspherical-window
'unbind-key 'undo 'undo-edit 'undo-hook 'unselect-all 'update-hook 'update-lisp-graph
- 'update-sound 'update-time-graph 'update-transform-graph 'variable-graph? 'vct
- 'vct* 'vct+ 'vct->channel 'vct->list 'vct->sound-data
- 'vct->string 'vct->vector 'vct-add! 'vct-copy
- 'vct-fill! 'vct-length 'vct-map! 'vct-move!
- 'vct-multiply! 'vct-offset! 'vct-peak 'vct-ref 'vct-reverse!
- 'vct-scale! 'vct-set! 'vct-subseq 'vct-subtract! 'vct?
- 'vector->vct 'view-files-amp 'view-files-amp-env
- 'view-files-dialog 'view-files-files 'view-files-select-hook 'view-files-selected-files 'view-files-sort
- 'view-files-speed 'view-files-speed-style 'view-mixes-dialog 'view-regions-dialog 'view-sound
+ 'update-sound 'update-time-graph 'update-transform-graph 'variable-graph? 'float-vector
+ 'float-vector* 'float-vector+ 'float-vector->channel
+ 'float-vector->string 'float-vector-add!
+ 'length 'float-vector-max 'float-vector-min 'float-vector-move!
+ 'float-vector-multiply! 'float-vector-offset! 'float-vector-peak 'float-vector-ref 'reverse!
+ 'float-vector-scale! 'float-vector-set! 'float-vector-subseq 'float-vector-subtract! 'float-vector?
'walsh-transform
'wave-train 'wave-train? 'wavelet-transform 'wavelet-type
'wavo-hop 'wavo-trace 'welch-window 'widget-position
'widget-size 'widget-text 'window-height
'window-width 'window-x 'window-y 'with-background-processes 'with-file-monitor 'with-gl
'with-mix-tags 'with-relative-panes 'with-tracking-cursor 'with-verbose-cursor
- 'with-inset-graph 'with-pointer-focus 'with-smpte-label 'with-toolbar 'with-tooltips 'with-menu-icons
+ 'with-inset-graph 'with-interrupts 'with-pointer-focus 'with-smpte-label 'with-toolbar 'with-tooltips 'with-menu-icons
'save-as-dialog-src 'save-as-dialog-auto-comment
'x->position 'x-axis-as-clock 'x-axis-as-percentage 'x-axis-in-beats 'x-axis-in-measures
'x-axis-in-samples 'x-axis-in-seconds 'x-axis-label 'x-axis-style 'x-bounds
@@ -2351,1830 +2465,1275 @@
(if (not (defined? n))
(set! undef (cons n undef))))
names)
- (if (not (null? undef))
+ (if (pair? undef)
(snd-display #__line__ ";undefined: ~A" undef)))
))
;;; ---------------- test 4: sndlib ----------------
-(define buffer-menu #f) ; needed by examp.scm
-
(if (or (not (provided? 'snd-examp.scm))
(and (defined? 'ramp) ; why this? protection against funcs?
(list? ramp)))
(load "examp.scm"))
-(if (not (provided? 'snd-mix.scm)) (load "mix.scm"))
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
-
-(define (play-sound-1 file)
- "play test func"
- (let* ((sound-fd (mus-sound-open-input file))
- (chans (mus-sound-chans file))
- (frames (mus-sound-frames file))
- (bufsize 256)
- (data (make-sound-data chans bufsize))
- (bytes (* bufsize chans 2)))
- (mus-sound-read sound-fd 0 (- bufsize 1) chans data)
- (catch #t
- (lambda ()
- (let ((audio-fd (mus-audio-open-output 0 (mus-sound-srate file) chans mus-lshort bytes)))
- (if (= audio-fd -1)
- (set! audio-fd (mus-audio-open-output 0 (mus-sound-srate file) chans mus-bshort bytes)))
- (if (= audio-fd -1)
- (snd-display #__line__ ";can't play ~A" file)
- (begin
- (catch #t
- (lambda ()
- (do ((i 0 (+ i bufsize)))
- ((>= i frames))
- (mus-audio-write audio-fd data bufsize)
- (mus-sound-read sound-fd 0 (- bufsize 1) chans data)))
- (lambda args (snd-display #__line__ ";play-sound-1: can play audio: ~A" args)))
- (mus-audio-close audio-fd)))))
- (lambda args (snd-display #__line__ ";play-sound-1: can't open audio: ~A" args)))
- (mus-sound-close-input sound-fd)))
+(require snd-mix.scm snd-env.scm)
(definstrument (out-samps beg chan data)
- (let ((len (vct-length data)))
- (run
- (do ((i 0 (+ 1 i)))
+ (let ((len (length data)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (out-any (+ beg i) (vct-ref data i) chan)))))
+ (out-any (+ beg i) (data i) chan))))
(definstrument (out-samps-invert beg chan data)
- (let ((len (vct-length data)))
- (run
- (do ((i 0 (+ 1 i)))
+ (let ((len (length data)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (out-any (+ beg i) (- (vct-ref data i)) chan)))))
+ (out-any (+ beg i) (- (data i)) chan))))
(define (snd_test_4)
- (define (frame->byte file frame)
+ (define (frame->byte file fr)
(+ (mus-sound-data-location file)
(* (mus-sound-chans file)
(mus-sound-datum-size file)
- frame)))
-
- (define (show-input-1 . arg)
- ;; from rtio.scm
- (define (card+device card device)
- (logior (ash card 16) device))
- (let* ((our-short (if (little-endian?) mus-lshort mus-bshort))
- (our-srate 22050)
- (our-dac-buffer-size-in-bytes 512)
- (our-dac-buffer-size-in-shorts 256)
- (our-chans 1)
- (our-chan 0)
- (our-default-card-number 0)
- (in-sys (if (not (null? arg))
- (car arg)
- our-default-card-number))
- (in-port (catch 'mus-error
- (lambda ()
- (mus-audio-open-input
- (card+device in-sys 0)
- our-srate our-chans our-short our-dac-buffer-size-in-bytes))
- (lambda args -1)))
- (data (make-sound-data our-chans our-dac-buffer-size-in-shorts))
- (vobj (make-vct our-dac-buffer-size-in-shorts)))
- (if (= in-port -1)
- (snd-display #__line__ ";can't open audio input port!")
- (begin
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (mus-audio-read in-port data our-dac-buffer-size-in-shorts)
- (graph (sound-data->vct data our-chan vobj)))
- (mus-audio-close in-port)))))
+ fr)))
- (begin
-
- (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
- (log-mem clmtest)
- (clear-listener)
- (let ((chns (mus-sound-chans "oboe.snd"))
- (dl (mus-sound-data-location "oboe.snd"))
- (fr (mus-sound-frames "oboe.snd"))
- (smps (mus-sound-samples "oboe.snd"))
- (len (mus-sound-length "oboe.snd"))
- (size (mus-sound-datum-size "oboe.snd"))
- (com (mus-sound-comment "oboe.snd"))
- (sr (mus-sound-srate "oboe.snd"))
- (m1 (mus-sound-maxamp-exists? "oboe.snd"))
- (mal (mus-sound-maxamp "oboe.snd"))
- (mz (mus-sound-maxamp "z.snd"))
- (bytes (mus-bytes-per-sample (mus-sound-data-format "oboe.snd"))))
- (if (or (not (= (car mz) 0))
- (fneq (cadr mz) 0.0))
- (snd-display #__line__ ";mus-sound-maxamp z.snd: ~A (~A ~A)" mz (not (= (car mz) 0)) (fneq (cadr mz) 0.0)))
- (let ((formats (list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat mus-lfloat
- mus-bint mus-lint mus-bintn mus-lintn mus-b24int mus-l24int mus-bdouble mus-ldouble
- mus-ubshort mus-ulshort mus-bdouble-unscaled mus-ldouble-unscaled mus-bfloat-unscaled
- mus-lfloat-unscaled))
- (sizes (list 2 2 1 1 1 1 4 4
- 4 4 4 4 3 3 8 8
- 2 2 8 8 4
- 4)))
- (for-each
- (lambda (frm siz)
- (if (not (= (mus-bytes-per-sample frm) siz))
- (snd-display #__line__ ";mus-bytes-per-sample ~A: ~A" (mus-data-format-name frm) siz)))
- formats
- sizes))
- (if (not (string=? (mus-data-format->string mus-bshort) "mus-bshort"))
- (snd-display #__line__ ";mus-data-format->string: ~A" (mus-data-format->string mus-bshort)))
- (if (not (string=? (mus-header-type->string mus-aifc) "mus-aifc"))
- (snd-display #__line__ ";mus-header-type->string: ~A" (mus-header-type->string mus-aifc)))
- (mus-sound-report-cache "hiho.tmp")
- (let ((p (open-input-file "hiho.tmp")))
- (if (not p)
- (snd-display #__line__ ";mus-sound-report-cache->hiho.tmp failed?")
- (let ((line (read-line p)))
- (if (or (not (string? line))
- (and (not (string=? line "sound table:"))
- (not (string=? line (string-append "sound table:" (string #\newline))))))
- (snd-display #__line__ ";print-cache 1: ~A?" line))
- (close-input-port p)
- (delete-file "hiho.tmp"))))
- (if (< (string-length (mus-audio-describe)) 10)
- (snd-display #__line__ ";mus-audio-describe: ~A" (mus-audio-describe)))
- (if (not (= chns 1)) (snd-display #__line__ ";oboe: mus-sound-chans ~D?" chns))
- (if (not (= dl 28)) (snd-display #__line__ ";oboe: mus-sound-data-location ~D (~A)?" dl (= dl 28)))
- (if (not (= fr 50828)) (snd-display #__line__ ";oboe: mus-sound-frames ~D?" fr))
- (if (not (= smps 50828)) (snd-display #__line__ ";oboe: mus-sound-samples ~D?" smps))
- (if (not (= len (+ 28 (* 2 50828)))) (snd-display #__line__ ";oboe: mus-sound-length ~D?" len))
- (if (not (= size 2)) (snd-display #__line__ ";oboe: mus-sound-datum-size ~D?" size))
- (if (not (= bytes 2)) (snd-display #__line__ ";oboe: sound-bytes ~D?" bytes))
- (if (not (= sr 22050)) (snd-display #__line__ ";oboe: mus-sound-srate ~D?" sr))
- (if (and m1 (= clmtest 0)) (snd-display #__line__ ";oboe: mus-sound-maxamp-exists before maxamp: ~A" m1))
- (if (not (mus-sound-maxamp-exists? "oboe.snd"))
- (snd-display #__line__ ";oboe: not mus-sound-maxamp-exists after maxamp: ~A" (mus-sound-maxamp-exists? "oboe.snd")))
-
- (if (= clmtest 0)
- (let ((vals (mus-header-raw-defaults)))
- (if (or (not (list? vals))
- (not (= (length vals) 3)))
- (snd-display #__line__ ";mus-header-raw-defaults: ~A" vals)
- (let ((sr (car vals))
- (chns (cadr vals))
- (frm (caddr vals)))
- (if (not (= sr 44100)) (snd-display #__line__ ";mus-header-raw-defaults srate: ~A" sr))
- (if (not (= chns 2)) (snd-display #__line__ ";mus-header-raw-defaults chns: ~A" chns))
- (if (not (= frm mus-bshort)) (snd-display #__line__ ";mus-header-raw-defaults format: ~A: ~A" frm (mus-data-format-name frm)))))))
- (set! (mus-header-raw-defaults) (list 12345 3 mus-bdouble-unscaled))
- (let ((vals (mus-header-raw-defaults)))
- (if (or (not (list? vals))
- (not (= (length vals) 3)))
- (snd-display #__line__ ";set mus-header-raw-defaults: ~A" vals)
- (let ((sr (car vals))
- (chns (cadr vals))
- (frm (caddr vals)))
- (if (not (= sr 12345)) (snd-display #__line__ ";set mus-header-raw-defaults srate: ~A" sr))
- (if (not (= chns 3)) (snd-display #__line__ ";set mus-header-raw-defaults chns: ~A" chns))
- (if (not (= frm mus-bdouble-unscaled)) (snd-display #__line__ ";set mus-header-raw-defaults format: ~A: ~A" frm (mus-data-format-name frm))))))
- (set! (mus-header-raw-defaults) (list 44100 2 mus-bshort))
-
- (let ((str (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "oboe.snd")))))
- (if (not (string=? str "15-Oct 04:34 PDT"))
- (snd-display #__line__ ";mus-sound-write-date oboe.snd: ~A?" str)))
- (let ((str (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "pistol.snd")))))
- (if (not (string-=? str "01-Jul 13:06 PDT"))
- (snd-display #__line__ ";mus-sound-write-date pistol.snd: ~A?" str)))
-
- (let ((index (open-sound "oboe.snd"))
- (long-file-name (let ((name "test"))
- (do ((i 0 (+ 1 i)))
- ((= i 10)) ; 40 is about the limit in Linux (256 char limit here from OS, not Snd)
- (set! name (string-append name "-test")))
- (string-append name ".snd"))))
- (if (variable-graph? index) (snd-display #__line__ ";variable-graph thinks anything is a graph..."))
- (if (player? index) (snd-display #__line__ ";player? thinks anything is a player..."))
- (if (not (sound? index)) (snd-display #__line__ ";~A is not a sound?" index))
- (if (sound? #f) (snd-display #__line__ ";sound? #f -> #t?"))
- (if (sound? #t) (snd-display #__line__ ";sound? #t -> #t?"))
- (save-sound-as long-file-name index)
+ (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
+ (log-mem clmtest)
+ (clear-listener)
+ (let ((chns (mus-sound-chans "oboe.snd"))
+ (dl (mus-sound-data-location "oboe.snd"))
+ (fr (mus-sound-framples "oboe.snd"))
+ (smps (mus-sound-samples "oboe.snd"))
+ (len (mus-sound-length "oboe.snd"))
+ (size (mus-sound-datum-size "oboe.snd"))
+ (com (mus-sound-comment "oboe.snd"))
+ (sr (mus-sound-srate "oboe.snd"))
+ (m1 (mus-sound-maxamp-exists? "oboe.snd"))
+ (mal (mus-sound-maxamp "oboe.snd"))
+ (mz (mus-sound-maxamp "z.snd"))
+ (bytes (mus-bytes-per-sample (mus-sound-sample-type "oboe.snd"))))
+ (if (or (not (= (car mz) 0))
+ (fneq (cadr mz) 0.0))
+ (snd-display #__line__ ";mus-sound-maxamp z.snd: ~A (~A ~A)" mz (not (= (car mz) 0)) (fneq (cadr mz) 0.0)))
+ (let ((formats (list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat mus-lfloat
+ mus-bint mus-lint mus-bintn mus-lintn mus-b24int mus-l24int mus-bdouble mus-ldouble
+ mus-ubshort mus-ulshort mus-bdouble-unscaled mus-ldouble-unscaled mus-bfloat-unscaled
+ mus-lfloat-unscaled))
+ (sizes (list 2 2 1 1 1 1 4 4
+ 4 4 4 4 3 3 8 8
+ 2 2 8 8 4
+ 4)))
+ (for-each
+ (lambda (frm siz)
+ (if (not (= (mus-bytes-per-sample frm) siz))
+ (snd-display #__line__ ";mus-bytes-per-sample ~A: ~A" (mus-sample-type-name frm) siz)))
+ formats
+ sizes))
+ (if (not (string=? (mus-sample-type->string mus-bshort) "mus-bshort"))
+ (snd-display #__line__ ";mus-sample-type->string: ~A" (mus-sample-type->string mus-bshort)))
+ (if (not (string=? (mus-header-type->string mus-aifc) "mus-aifc"))
+ (snd-display #__line__ ";mus-header-type->string: ~A" (mus-header-type->string mus-aifc)))
+ (mus-sound-report-cache "hiho.tmp")
+ (let ((p (open-input-file "hiho.tmp")))
+ (if (not p)
+ (snd-display #__line__ ";mus-sound-report-cache->hiho.tmp failed?")
+ (let ((line (read-line p)))
+ (if (or (not (string? line))
+ (and (not (string=? line "sound table:"))
+ (not (string=? line (string-append "sound table:" (string #\newline))))))
+ (snd-display #__line__ ";print-cache 1: ~A?" line))
+ (close-input-port p)
+ (delete-file "hiho.tmp"))))
+ (if (not (= chns 1)) (snd-display #__line__ ";oboe: mus-sound-chans ~D?" chns))
+ (if (not (= dl 28)) (snd-display #__line__ ";oboe: mus-sound-data-location ~D (~A)?" dl (= dl 28)))
+ (if (not (= fr 50828)) (snd-display #__line__ ";oboe: mus-sound-framples ~D?" fr))
+ (if (not (= smps 50828)) (snd-display #__line__ ";oboe: mus-sound-samples ~D?" smps))
+ (if (not (= len (+ 28 (* 2 50828)))) (snd-display #__line__ ";oboe: mus-sound-length ~D?" len))
+ (if (not (= size 2)) (snd-display #__line__ ";oboe: mus-sound-datum-size ~D?" size))
+ (if (not (= bytes 2)) (snd-display #__line__ ";oboe: sound-bytes ~D?" bytes))
+ (if (not (= sr 22050)) (snd-display #__line__ ";oboe: mus-sound-srate ~D?" sr))
+ (if (and m1 (= clmtest 0)) (snd-display #__line__ ";oboe: mus-sound-maxamp-exists before maxamp: ~A" m1))
+ (if (not (mus-sound-maxamp-exists? "oboe.snd"))
+ (snd-display #__line__ ";oboe: not mus-sound-maxamp-exists after maxamp: ~A" (mus-sound-maxamp-exists? "oboe.snd")))
+
+ (if (= clmtest 0)
+ (let ((vals (mus-header-raw-defaults)))
+ (if (or (not (list? vals))
+ (not (= (length vals) 3)))
+ (snd-display #__line__ ";mus-header-raw-defaults: ~A" vals)
+ (let ((sr (car vals))
+ (chns (cadr vals))
+ (frm (caddr vals)))
+ (if (not (= sr 44100)) (snd-display #__line__ ";mus-header-raw-defaults srate: ~A" sr))
+ (if (not (= chns 2)) (snd-display #__line__ ";mus-header-raw-defaults chns: ~A" chns))
+ (if (not (= frm mus-bshort)) (snd-display #__line__ ";mus-header-raw-defaults format: ~A: ~A" frm (mus-sample-type-name frm)))))))
+ (set! (mus-header-raw-defaults) (list 12345 3 mus-bdouble-unscaled))
+ (let ((vals (mus-header-raw-defaults)))
+ (if (or (not (list? vals))
+ (not (= (length vals) 3)))
+ (snd-display #__line__ ";set mus-header-raw-defaults: ~A" vals)
+ (let ((sr (car vals))
+ (chns (cadr vals))
+ (frm (caddr vals)))
+ (if (not (= sr 12345)) (snd-display #__line__ ";set mus-header-raw-defaults srate: ~A" sr))
+ (if (not (= chns 3)) (snd-display #__line__ ";set mus-header-raw-defaults chns: ~A" chns))
+ (if (not (= frm mus-bdouble-unscaled)) (snd-display #__line__ ";set mus-header-raw-defaults format: ~A: ~A" frm (mus-sample-type-name frm))))))
+ (set! (mus-header-raw-defaults) (list 44100 2 mus-bshort))
+
+ (let ((str (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "oboe.snd")))))
+ (if (not (string=? str "23-Nov 06:56 PST"))
+ (snd-display #__line__ ";mus-sound-write-date oboe.snd: ~A?" str)))
+ (let ((str (strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "pistol.snd")))))
+ (if (not (string=? str "23-Nov 06:56 PST"))
+ (snd-display #__line__ ";mus-sound-write-date pistol.snd: ~A?" str)))
+
+ (let ((index (open-sound "oboe.snd"))
+ (long-file-name (let ((name "test"))
+ (do ((i 0 (+ i 1)))
+ ((= i 10)) ; 40 is about the limit in Linux (256 char limit here from OS, not Snd)
+ (set! name (string-append name "-test")))
+ (string-append name ".snd"))))
+ (if (variable-graph? index) (snd-display #__line__ ";variable-graph thinks anything is a graph..."))
+ (if (player? index) (snd-display #__line__ ";player? thinks anything is a player..."))
+ (if (not (sound? index)) (snd-display #__line__ ";~A is not a sound?" index))
+ (if (sound? #f) (snd-display #__line__ ";sound? #f -> #t?"))
+ (if (sound? #t) (snd-display #__line__ ";sound? #t -> #t?"))
+ (save-sound-as long-file-name index)
+ (close-sound index)
+ (set! index (open-sound long-file-name))
+ (if (not (sound? index)) (snd-display #__line__ ";can't find test...snd"))
+ (if (or (< (length (file-name index)) (length long-file-name))
+ (< (length (short-file-name index)) (length long-file-name)))
+ (snd-display #__line__ ";file-name lengths: ~A ~A ~A"
+ (length (file-name index))
+ (length (short-file-name index))
+ (length long-file-name)))
+ (close-sound index)
+ (mus-sound-forget long-file-name)
+ (delete-file long-file-name))
+
+ (let ((old-sound-path *mus-sound-path*)
+ (new-path (if (provided? 'osx) "/Users/bil/sf1" "/home/bil/sf1")))
+ (set! *mus-sound-path* (list new-path))
+ (let ((ind (catch #t (lambda () (open-sound "o2.bicsf")) (lambda args #f))))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";*mus-sound-path*: ~A~%" ind)
+ (begin
+ (close-sound ind)
+ (set! (mus-sound-path) (list new-path))
+ (set! ind (catch #t (lambda () (open-sound "o2.bicsf")) (lambda args #f)))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";(mus-sound-path): ~A~%" ind)
+ (close-sound ind)))))
+ (set! *mus-sound-path* old-sound-path))
+
+ (let ((fsnd (string-append sf-dir "forest.aiff")))
+ (if (file-exists? fsnd)
+ (begin
+ (system (format #f "cp ~A fmv.snd" fsnd))
+ (let ((index (open-sound "fmv.snd")))
+ (if (not (equal? (sound-loop-info index) (mus-sound-loop-info fsnd)))
+ (snd-display #__line__ ";loop-info: ~A ~A" (sound-loop-info index) (mus-sound-loop-info fsnd)))
+ (set! (sound-loop-info index) (list 12000 14000 1 2 3 4))
+ (if (not (equal? (sound-loop-info index) (list 12000 14000 1 2 3 4 1 1)))
+ (snd-display #__line__ ";set loop-info: ~A" (sound-loop-info index)))
+ (save-sound-as "fmv1.snd" index :header-type mus-aifc)
+ (close-sound index)
+ (if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 12000 14000 1 2 3 4 1 1)))
+ (snd-display #__line__ ";saved loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))))
+ (let ((index (open-sound "oboe.snd")))
+ (save-sound-as "fmv.snd" index :header-type mus-aifc)
+ (close-sound index))
+ (let ((index (open-sound "fmv.snd")))
+ (if (not (null? (sound-loop-info index)))
+ (snd-display #__line__ ";null loop-info: ~A" (sound-loop-info index)))
+ (set! (sound-loop-info index) (list 1200 1400 4 3 2 1))
+ (if (not (equal? (sound-loop-info index) (list 1200 1400 4 3 2 1 1 1)))
+ (snd-display #__line__ ";set null loop-info: ~A" (sound-loop-info index)))
+ (save-sound-as "fmv1.snd" :sound index :header-type mus-aifc)
(close-sound index)
- (set! index (open-sound long-file-name))
- (if (not (sound? index)) (snd-display #__line__ ";can't find test...snd"))
- (if (or (not (>= (string-length (file-name index)) (string-length long-file-name)))
- (not (>= (string-length (short-file-name index)) (string-length long-file-name))))
- (snd-display #__line__ ";file-name lengths: ~A ~A ~A"
- (string-length (file-name index))
- (string-length (short-file-name index))
- (string-length long-file-name)))
+ (if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 1200 1400 4 3 2 1 1 1)))
+ (snd-display #__line__ ";saved null loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))
+ (let ((index (open-sound "fmv.snd")))
+ (set! (sound-loop-info) (list 1200 1400 4 3 2 1 1 0))
+ (if (not (equal? (sound-loop-info index) (list 1200 1400 0 0 2 1 1 0)))
+ (snd-display #__line__ ";set null loop-info (no mode1): ~A" (sound-loop-info index)))
+ (save-sound-as "fmv1.snd" index :header-type mus-aifc)
(close-sound index)
- (mus-sound-forget long-file-name)
- (delete-file long-file-name))
-
- (let* ((fsnd (string-append sf-dir "forest.aiff")))
- (if (file-exists? fsnd)
- (begin
- (system (format #f "cp ~A fmv.snd" fsnd))
- (let ((index (open-sound "fmv.snd")))
- (if (not (equal? (sound-loop-info index) (mus-sound-loop-info fsnd)))
- (snd-display #__line__ ";loop-info: ~A ~A" (sound-loop-info index) (mus-sound-loop-info fsnd)))
- (set! (sound-loop-info index) (list 12000 14000 1 2 3 4))
- (if (not (equal? (sound-loop-info index) (list 12000 14000 1 2 3 4 1 1)))
- (snd-display #__line__ ";set loop-info: ~A" (sound-loop-info index)))
- (save-sound-as "fmv1.snd" index mus-aifc)
- (close-sound index)
- (if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 12000 14000 1 2 3 4 1 1)))
- (snd-display #__line__ ";saved loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))))
- (let ((index (open-sound "oboe.snd")))
- (save-sound-as "fmv.snd" index mus-aifc)
- (close-sound index))
- (let ((index (open-sound "fmv.snd")))
- (if (not (equal? (sound-loop-info index) '()))
- (snd-display #__line__ ";null loop-info: ~A" (sound-loop-info index)))
- (set! (sound-loop-info index) (list 1200 1400 4 3 2 1))
- (if (not (equal? (sound-loop-info index) (list 1200 1400 4 3 2 1 1 1)))
- (snd-display #__line__ ";set null loop-info: ~A" (sound-loop-info index)))
- (save-sound-as "fmv1.snd" :sound index :header-type mus-aifc)
- (close-sound index)
- (if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 1200 1400 4 3 2 1 1 1)))
- (snd-display #__line__ ";saved null loop-info: ~A" (mus-sound-loop-info "fmv1.snd"))))
- (let ((index (open-sound "fmv.snd")))
- (set! (sound-loop-info) (list 1200 1400 4 3 2 1 1 0))
- (if (not (equal? (sound-loop-info index) (list 1200 1400 0 0 2 1 1 0)))
- (snd-display #__line__ ";set null loop-info (no mode1): ~A" (sound-loop-info index)))
- (save-sound-as "fmv1.snd" index mus-aifc)
- (close-sound index)
- (if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 1200 1400 0 0 2 1 1 0)))
- (snd-display #__line__ ";saved null loop-info (no mode1): ~A" (mus-sound-loop-info "fmv1.snd")))))
-
- (if com (snd-display #__line__ ";oboe: mus-sound-comment ~A?" com))
- (let ((fsnd (string-append sf-dir "nasahal8.wav")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com
- (string-append "ICRD: 1997-02-22"
- (string #\newline)
- "IENG: Paul R. Roger"
- (string #\newline)
- "ISFT: Sound Forge 4.0"
- (string #\newline)))))
- (snd-display #__line__ ";mus-sound-comment \"nasahal8.wav\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "8svx-8.snd")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "File created by Sound Exchange ")))
- (snd-display #__line__ ";mus-sound-comment \"8svx-8.snd\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "sun-16-afsp.snd")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "AFspdate:1981/02/11 23:03:34 UTC")))
- (snd-display #__line__ ";mus-sound-comment \"sun-16-afsp.snd\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "smp-16.snd")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "Converted using Sox. ")))
- (snd-display #__line__ ";mus-sound-comment \"smp-16.snd\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "d40130.au")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "1994 Jesus Villena")))
- (snd-display #__line__ ";mus-sound-comment \"d40130.au\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "wood.maud")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "file written by SOX MAUD-export ")))
- (snd-display #__line__ ";mus-sound-comment \"wood.maud\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "addf8.sf_mipseb")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com))
- (not (string-=? com "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" ")))
- (snd-display #__line__ ";mus-sound-comment \"addf8.sf_mipseb\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "mary-sun4.sig")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com (string-append "MARY HAD A LITTLE LAMB" (string #\newline)))))
- (snd-display #__line__ ";mus-sound-comment \"mary-sun4.sig\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "nasahal.pat")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "This patch saved with Sound Forge 3.0.")))
- (snd-display #__line__ ";mus-sound-comment \"nasahal.pat\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "next-16.snd")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com))
- (not (string-=? com ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91")))
- (snd-display #__line__ ";mus-sound-comment \"next-16.snd\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "wood16.nsp")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "Created by Snack ")))
- (snd-display #__line__ ";mus-sound-comment \"wood16.nsp\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "wood.sdx")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "1994 Jesus Villena")))
- (snd-display #__line__ ";mus-sound-comment \"wood.sdx\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "clmcom.aif")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com "this is a comment")))
- (snd-display #__line__ ";mus-sound-comment \"clmcom.aif\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "anno.aif")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com)) (not (string-=? com (string-append "1994 Jesus Villena" (string #\newline)))))
- (snd-display #__line__ ";mus-sound-comment \"anno.aif\") -> ~A?" com)))))
- (let ((fsnd (string-append sf-dir "telephone.wav")))
- (if (file-exists? fsnd)
- (begin
- (set! com (mus-sound-comment fsnd))
- (if (or (not (string? com))
- (not (string-=? com (string-append "sample_byte_format -s2 01"
- (string #\newline)
- "channel_count -i 1"
- (string #\newline)
- "sample_count -i 36461"
- (string #\newline)
- "sample_rate -i 16000"
- (string #\newline)
- "sample_n_bytes -i 2"
- (string #\newline)
- "sample_sig_bits -i 16"
- (string #\newline)))))
- (snd-display #__line__ ";mus-sound-comment \"telephone.wav\") -> ~A?" com)))))
-
- (if (not (string? (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
- (snd-display #__line__ ";mus-sound-comment traffic: ~A" (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
-
- (if (= clmtest 0)
+ (if (not (equal? (mus-sound-loop-info "fmv1.snd") (list 1200 1400 0 0 2 1 1 0)))
+ (snd-display #__line__ ";saved null loop-info (no mode1): ~A" (mus-sound-loop-info "fmv1.snd")))))
+
+ (if (> (length com) 0) (snd-display #__line__ ";oboe: mus-sound-comment ~A?" com))
+ (let ((fsnd (string-append sf-dir "nasahal8.wav")))
+ (if (file-exists? fsnd)
(begin
- (if (fneq (cadr mal) .14724) (snd-display #__line__ ";oboe: mus-sound-maxamp ~F?" (cadr mal)))
- (if (not (= (car mal) 24971)) (snd-display #__line__ ";oboe: mus-sound-maxamp at ~D?" (car mal)))))
- (set! (mus-sound-maxamp "oboe.snd") (list 1234 .5))
- (set! mal (mus-sound-maxamp "oboe.snd"))
- (if (fneq (cadr mal) .5) (snd-display #__line__ ";oboe: set! mus-sound-maxamp ~F?" (cadr mal)))
- (if (not (= (car mal) 1234)) (snd-display #__line__ ";oboe: set! mus-sound-maxamp at ~D?" (car mal)))
- (set! mal (mus-sound-maxamp "4.aiff"))
- (if (= clmtest 0)
- (if (not (feql mal (list 810071 0.245 810071 0.490 810071 0.735 810071 0.980)))
- (snd-display #__line__ ";mus-sound-maxamp 4.aiff: ~A?" mal)))
- (set! (mus-sound-maxamp "4.aiff") (list 12345 .5 54321 .2 0 .1 9999 .01))
- (set! mal (mus-sound-maxamp "4.aiff"))
- (if (not (feql mal (list 12345 .5 54321 .2 0 .1 9999 .01)))
- (snd-display #__line__ ";set! mus-sound-maxamp 4.aiff: ~A?" mal))
- (let ((var (catch #t (lambda () (set! (mus-sound-maxamp "oboe.snd") (list 1234))) (lambda args args))))
- (if (not (eq? (car var) 'wrong-type-arg))
- (snd-display #__line__ ";set! mus-sound-maxamp bad arg: ~A" var)))
- (if (and (not (= (mus-sound-type-specifier "oboe.snd") #x646e732e)) ;little endian reader
- (not (= (mus-sound-type-specifier "oboe.snd") #x2e736e64))) ;big endian reader
- (snd-display #__line__ ";oboe: mus-sound-type-specifier: ~X?" (mus-sound-type-specifier "oboe.snd")))
- (if (not (string-=? (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd"))) "15-Oct-2006 04:34"))
- (snd-display #__line__ ";oboe: file-write-date: ~A?" (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd")))))
- (play-sound-1 "oboe.snd")
- (mus-sound-forget "oboe.snd")
-
- (let ((lasth (do ((i 1 (+ 1 i)))
- ((string-=? (mus-header-type-name i) "unsupported") i))))
- (if (< lasth 50) (snd-display #__line__ ";header-type[~A] = ~A" lasth (mus-header-type-name lasth))))
- (let ((lasth (do ((i 1 (+ 1 i)))
- ((string-=? (mus-data-format-name i) "unknown") i))))
- (if (< lasth 10) (snd-display #__line__ ";data-format[~A] = ~A" lasth (mus-data-format-name lasth))))
-
- (set! (transform-normalization) dont-normalize)
- (if (not (= (transform-normalization) dont-normalize))
- (snd-display #__line__ ";set-transform-normalization none -> ~A" (transform-normalization)))
- (set! (transform-normalization) normalize-globally)
- (if (not (= (transform-normalization) normalize-globally))
- (snd-display #__line__ ";set-transform-normalization globally -> ~A" (transform-normalization)))
- (set! (transform-normalization) normalize-by-channel)
- (if (not (= (transform-normalization) normalize-by-channel))
- (snd-display #__line__ ";set-transform-normalization channel -> ~A" (transform-normalization)))
-
- (let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 1 "set-samples test" 100)))
- (set! (samples 10 3) (make-vct 3 .1))
- (if (not (vequal (channel->vct 0 20 ind 0) (vct 0 0 0 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";1 set samples 0 for .1: ~A" (channel->vct 0 20 ind 0)))
- (set! (samples 20 3 ind 0) (make-vct 3 .1))
- (if (not (vequal (channel->vct 10 20 ind 0) (vct .1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";2 set samples 10 for .1: ~A" (channel->vct 10 20 ind 0)))
- (set! (samples 30 3 ind 0 #f "a name") (make-vct 3 .1))
- (if (not (vequal (channel->vct 20 20 ind 0) (vct .1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";3 set samples 20 for .1: ~A" (channel->vct 20 20 ind 0)))
- (set! (samples 0 3 ind 0 #f "a name" 0 1) (make-vct 3 .2))
- (if (not (vequal (channel->vct 0 20 ind 0) (vct .2 .2 .2 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";4 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
- (if (not (vequal (channel->vct 20 20 ind 0) (make-vct 20 0.0)))
- (snd-display #__line__ ";5 set samples 20 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
- (let ((nd (new-sound "fmv1.snd" :channels 2)))
- (vct->channel (make-vct 10 .5) 0 10 nd 0)
- (vct->channel (make-vct 10 .3) 0 10 nd 1)
- (save-sound-as "fmv1.snd" nd)
- (close-sound nd))
- (if (not (file-exists? "fmv1.snd")) (snd-display #__line__ ";fmv1 not saved??"))
- (set! (samples 0 10 ind 0 #f "another name" 1) "fmv1.snd")
- (if (not (vequal (channel->vct 0 20 ind 0) (vct .3 .3 .3 .3 .3 .3 .3 .3 .3 .3 .1 .1 .1 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";6 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
- (set! (samples 5 6 ind 0 #f "another name 7" 0) "fmv1.snd")
- (if (not (vequal (channel->vct 0 20 ind 0) (vct .3 .3 .3 .3 .3 .5 .5 .5 .5 .5 .5 .1 .1 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";7 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
- (revert-sound ind)
- (set! (samples 0 10 ind 0 #f "another name 8" 1 0 #f) "fmv1.snd")
- (if (not (vequal (channel->vct 0 20 ind 0) (vct .3 .3 .3 .3 .3 .3 .3 .3 .3 .3 0 0 0 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";8 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
- (set! (samples 10 10 ind 0 #f "another name 9" 0 0) "fmv1.snd")
- (if (not (vequal (channel->vct 0 20 ind 0) (vct 0 0 0 0 0 0 0 0 0 0 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5)))
- (snd-display #__line__ ";9 set samples 0 at 1 for .1: ~A" (channel->vct 0 20 ind 0)))
- (set! (samples 20 10) "fmv1.snd")
- (if (not (vequal (channel->vct 10 20 ind 0) (make-vct 20 .5)))
- (snd-display #__line__ ";10 set samples 0 at 1 for .1: ~A" (channel->vct 10 20 ind 0)))
- (revert-sound ind)
- (set! (samples 0 10 ind 0 #t "another name" 1 0 #f) "fmv1.snd")
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";11 set-samples truncate to ~A" (frames ind 0)))
- (revert-sound ind)
- (delete-file "fmv1.snd")
-
- ;; now try to confuse it
- (let ((tag (catch #t
- (lambda () (set! (samples 0 10 ind 0) "fmv1.snd"))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";set-samples, no such file: ~A" tag)))
- (let ((nd (new-sound "fmv1.snd" :channels 1)))
- (vct->channel (make-vct 10 .5) 0 10 nd 0)
- (save-sound-as "fmv1.snd" nd)
- (close-sound nd))
- (let ((tag (catch #t
- (lambda () (set! (samples 0 10 ind 0 #f "another name" 1) "fmv1.snd")) ; chan 1 does not exist
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";set-samples no such channel: ~A" tag)))
- (let ((tag (catch #t
- (lambda () (set! (samples 0 10 ind 0 #f "another name" -1) "fmv1.snd"))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";set-samples no such channel (-1): ~A" tag)))
- (let ((tag (catch #t
- (lambda () (set! (samples 0 -10) "fmv1.snd"))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-samples (-10): ~A" tag)))
- (let ((tag (catch #t
- (lambda () (set! (samples -10 10) "fmv1.snd"))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample)) (snd-display #__line__ ";set-samples (beg -10): ~A" tag)))
- (close-sound ind))
-
- (let ((len 100))
- (for-each
- (lambda (type allowed-diff)
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1))
- (v (make-vct len))
- (maxdiff 0.0)
- (maxpos #f))
- (vct-set! v 0 0.999)
- (vct-set! v 1 -1.0)
- (vct-set! v 2 .1)
- (vct-set! v 3 -.1)
- (vct-set! v 4 .01)
- (vct-set! v 5 -.01)
- (vct-set! v 4 .001)
- (vct-set! v 5 -.001)
- (vct-set! v 6 0.0)
- (do ((i 7 (+ 1 i)))
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com))
+ (not (string=? com
+ (string-append "ICRD: 1997-02-22"
+ (string #\newline)
+ "IENG: Paul R. Roger"
+ (string #\newline)
+ "ISFT: Sound Forge 4.0"
+ (string #\newline)))))
+ (snd-display #__line__ ";mus-sound-comment \"nasahal8.wav\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "8svx-8.snd")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "File created by Sound Exchange ")))
+ (snd-display #__line__ ";mus-sound-comment \"8svx-8.snd\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "sun-16-afsp.snd")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "AFspdate:1981/02/11 23:03:34 UTC")))
+ (snd-display #__line__ ";mus-sound-comment \"sun-16-afsp.snd\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "smp-16.snd")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "Converted using Sox. ")))
+ (snd-display #__line__ ";mus-sound-comment \"smp-16.snd\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "d40130.au")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "1994 Jesus Villena")))
+ (snd-display #__line__ ";mus-sound-comment \"d40130.au\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "wood.maud")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "file written by SOX MAUD-export ")))
+ (snd-display #__line__ ";mus-sound-comment \"wood.maud\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "addf8.sf_mipseb")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com))
+ (not (string=? com "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" ")))
+ (snd-display #__line__ ";mus-sound-comment \"addf8.sf_mipseb\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "mary-sun4.sig")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com (string-append "MARY HAD A LITTLE LAMB" (string #\newline)))))
+ (snd-display #__line__ ";mus-sound-comment \"mary-sun4.sig\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "nasahal.pat")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "This patch saved with Sound Forge 3.0.")))
+ (snd-display #__line__ ";mus-sound-comment \"nasahal.pat\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "next-16.snd")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com))
+ (not (string=? com ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91")))
+ (snd-display #__line__ ";mus-sound-comment \"next-16.snd\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "wood16.nsp")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "Created by Snack ")))
+ (snd-display #__line__ ";mus-sound-comment \"wood16.nsp\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "wood.sdx")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "1994 Jesus Villena")))
+ (snd-display #__line__ ";mus-sound-comment \"wood.sdx\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "clmcom.aif")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com "this is a comment")))
+ (snd-display #__line__ ";mus-sound-comment \"clmcom.aif\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "anno.aif")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com)) (not (string=? com (string-append "1994 Jesus Villena" (string #\newline)))))
+ (snd-display #__line__ ";mus-sound-comment \"anno.aif\") -> ~A?" com)))))
+ (let ((fsnd (string-append sf-dir "telephone.wav")))
+ (if (file-exists? fsnd)
+ (begin
+ (set! com (mus-sound-comment fsnd))
+ (if (or (not (string? com))
+ (not (string=? com (string-append "sample_byte_format -s2 01"
+ (string #\newline)
+ "channel_count -i 1"
+ (string #\newline)
+ "sample_count -i 36461"
+ (string #\newline)
+ "sample_rate -i 16000"
+ (string #\newline)
+ "sample_n_bytes -i 2"
+ (string #\newline)
+ "sample_sig_bits -i 16"
+ (string #\newline)))))
+ (snd-display #__line__ ";mus-sound-comment \"telephone.wav\") -> ~A?" com)))))
+
+ (if (not (string? (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
+ (snd-display #__line__ ";mus-sound-comment traffic: ~A" (mus-sound-comment (string-append sf-dir "traffic.aiff"))))
+
+ (if (= clmtest 0)
+ (begin
+ (if (fneq (cadr mal) .14724) (snd-display #__line__ ";oboe: mus-sound-maxamp ~F?" (cadr mal)))
+ (if (not (= (car mal) 24971)) (snd-display #__line__ ";oboe: mus-sound-maxamp at ~D?" (car mal)))))
+ (if (and (not (= (mus-sound-type-specifier "oboe.snd") #x646e732e)) ;little endian reader
+ (not (= (mus-sound-type-specifier "oboe.snd") #x2e736e64))) ;big endian reader
+ (snd-display #__line__ ";oboe: mus-sound-type-specifier: ~X?" (mus-sound-type-specifier "oboe.snd")))
+ (if (not (string=? (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd"))) "23-Nov-2012 06:56"))
+ (snd-display #__line__ ";oboe: file-write-date: ~A?" (strftime "%d-%b-%Y %H:%M" (localtime (file-write-date "oboe.snd")))))
+ ; (mus-sound-forget "oboe.snd")
+
+ (let ((lasth (do ((i 1 (+ i 1)))
+ ((string=? (mus-header-type-name i) "unknown") i))))
+ (if (< lasth 50) (snd-display #__line__ ";header-type[~A] = ~A" lasth (mus-header-type-name lasth))))
+ (let ((lasth (do ((i 1 (+ i 1)))
+ ((string=? (mus-sample-type-name i) "unknown") i))))
+ (if (< lasth 10) (snd-display #__line__ ";sample-type[~A] = ~A" lasth (mus-sample-type-name lasth))))
+
+ (when with-gui
+ (set! *transform-normalization* dont-normalize)
+ (if (not (= *transform-normalization* dont-normalize))
+ (snd-display #__line__ ";set-transform-normalization none -> ~A" *transform-normalization*))
+ (set! *transform-normalization* normalize-globally)
+ (if (not (= *transform-normalization* normalize-globally))
+ (snd-display #__line__ ";set-transform-normalization globally -> ~A" *transform-normalization*))
+ (set! *transform-normalization* normalize-by-channel)
+ (if (not (= *transform-normalization* normalize-by-channel))
+ (snd-display #__line__ ";set-transform-normalization channel -> ~A" *transform-normalization*)))
+
+ (let ((ind (new-sound "fmv.snd" 1 22050 mus-ldouble mus-next "set-samples test" 100)))
+ (set! (samples 10 3) (make-float-vector 3 .1))
+ (if (not (vequal (channel->float-vector 0 20 ind 0) (float-vector 0 0 0 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";1 set samples 0 for .1: ~A" (channel->float-vector 0 20 ind 0)))
+ (set! (samples 20 3 ind 0) (make-float-vector 3 .1))
+ (if (not (vequal (channel->float-vector 10 20 ind 0) (float-vector .1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";2 set samples 10 for .1: ~A" (channel->float-vector 10 20 ind 0)))
+ (set! (samples 30 3 ind 0 #f "a name") (make-float-vector 3 .1))
+ (if (not (vequal (channel->float-vector 20 20 ind 0) (float-vector .1 .1 .1 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";3 set samples 20 for .1: ~A" (channel->float-vector 20 20 ind 0)))
+ (set! (samples 0 3 ind 0 #f "a name" 0 1) (make-float-vector 3 .2))
+ (if (not (vequal (channel->float-vector 0 20 ind 0) (float-vector .2 .2 .2 0 0 0 0 0 0 0 .1 .1 .1 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";4 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
+ (if (not (vequal (channel->float-vector 20 20 ind 0) (make-float-vector 20 0.0)))
+ (snd-display #__line__ ";5 set samples 20 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
+ (let ((nd (new-sound "fmv1.snd" :channels 2)))
+ (float-vector->channel (make-float-vector 10 .5) 0 10 nd 0)
+ (float-vector->channel (make-float-vector 10 .3) 0 10 nd 1)
+ (save-sound-as "fmv1.snd" nd)
+ (close-sound nd))
+ (if (not (file-exists? "fmv1.snd")) (snd-display #__line__ ";fmv1 not saved??"))
+ (set! (samples 0 10 ind 0 #f "another name" 1) "fmv1.snd")
+ (if (not (vequal (channel->float-vector 0 20 ind 0) (float-vector .3 .3 .3 .3 .3 .3 .3 .3 .3 .3 .1 .1 .1 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";6 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
+ (set! (samples 5 6 ind 0 #f "another name 7" 0) "fmv1.snd")
+ (if (not (vequal (channel->float-vector 0 20 ind 0) (float-vector .3 .3 .3 .3 .3 .5 .5 .5 .5 .5 .5 .1 .1 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";7 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
+ (revert-sound ind)
+ (set! (samples 0 10 ind 0 #f "another name 8" 1 0 #f) "fmv1.snd")
+ (if (not (vequal (channel->float-vector 0 20 ind 0) (float-vector .3 .3 .3 .3 .3 .3 .3 .3 .3 .3 0 0 0 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";8 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
+ (set! (samples 10 10 ind 0 #f "another name 9" 0 0) "fmv1.snd")
+ (if (not (vequal (channel->float-vector 0 20 ind 0) (float-vector 0 0 0 0 0 0 0 0 0 0 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5)))
+ (snd-display #__line__ ";9 set samples 0 at 1 for .1: ~A" (channel->float-vector 0 20 ind 0)))
+ (set! (samples 20 10) "fmv1.snd")
+ (if (not (vequal (channel->float-vector 10 20 ind 0) (make-float-vector 20 .5)))
+ (snd-display #__line__ ";10 set samples 0 at 1 for .1: ~A" (channel->float-vector 10 20 ind 0)))
+ (revert-sound ind)
+ (set! (samples 0 10 ind 0 #t "another name" 1 0 #f) "fmv1.snd")
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";11 set-samples truncate to ~A" (framples ind 0)))
+ (revert-sound ind)
+ (delete-file "fmv1.snd")
+
+ ;; now try to confuse it
+ (let ((tag (catch #t
+ (lambda () (set! (samples 0 10 ind 0) "fmv1.snd"))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";set-samples, no such file: ~A" tag)))
+ (let ((nd (new-sound "fmv1.snd" :channels 1)))
+ (float-vector->channel (make-float-vector 10 .5) 0 10 nd 0)
+ (save-sound-as "fmv1.snd" nd)
+ (close-sound nd))
+ (let ((tag (catch #t
+ (lambda () (set! (samples 0 10 ind 0 #f "another name" 1) "fmv1.snd")) ; chan 1 does not exist
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";set-samples no such channel: ~A" tag)))
+ (let ((tag (catch #t
+ (lambda () (set! (samples 0 10 ind 0 #f "another name" -1) "fmv1.snd"))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";set-samples no such channel (-1): ~A" tag)))
+ (let ((tag (catch #t
+ (lambda () (set! (samples 0 -10) "fmv1.snd"))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-samples (-10): ~A" tag)))
+ (let ((tag (catch #t
+ (lambda () (set! (samples -10 10) "fmv1.snd"))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-sample)) (snd-display #__line__ ";set-samples (beg -10): ~A" tag)))
+ (close-sound ind))
+
+ (let ((len 100))
+ (for-each
+ (lambda (type allowed-diff)
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next))
+ (v (make-float-vector len))
+ (maxdiff 0.0)
+ (maxpos #f))
+ (set! (v 0) 0.999)
+ (set! (v 1) -1.0)
+ (set! (v 2) .1)
+ (set! (v 3) -.1)
+ (set! (v 4) .01)
+ (set! (v 5) -.01)
+ (set! (v 4) .001)
+ (set! (v 5) -.001)
+ (set! (v 6) 0.0)
+ (do ((i 7 (+ i 1)))
+ ((= i len))
+ (let ((val (random 1.9999)))
+ (if (or (> val 2.0)
+ (< val 0.0))
+ (snd-display #__line__ ";random 2.0 -> ~A?" val))
+ (set! (v i) (- 1.0 val))))
+ (float-vector->channel v 0 len ind 0)
+ (save-sound-as "test1.snd" ind :header-type mus-next :sample-type type)
+ (close-sound ind)
+ (set! ind (open-sound "test1.snd"))
+ (let ((v1 (channel->float-vector 0 len ind 0)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((val (random 1.9999)))
- (if (or (> val 2.0)
- (< val 0.0))
- (snd-display #__line__ ";random 2.0 -> ~A?" val))
- (vct-set! v i (- 1.0 val))))
- (vct->channel v 0 len ind 0)
- (save-sound-as "test1.snd" ind mus-next :data-format type)
- (close-sound ind)
- (set! ind (open-sound "test1.snd"))
- (let ((v1 (channel->vct 0 len ind 0)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let ((diff (abs (- (vct-ref v i) (vct-ref v1 i)))))
- (if (> diff maxdiff)
- (begin
- (set! maxdiff diff)
- (set! maxpos i)))))
- (if (> maxdiff allowed-diff)
- (snd-display #__line__ ";[line 2841] ~A: ~A at ~A (~A ~A)"
- (mus-data-format-name type)
- maxdiff maxpos
- (vct-ref v maxpos) (vct-ref v1 maxpos)))
- (close-sound ind))))
- (list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte
- mus-lfloat mus-bint mus-lint mus-b24int mus-l24int
- mus-ubshort mus-ulshort mus-ubyte mus-bfloat mus-bdouble
- mus-ldouble)
- (list (expt 2 -15) (expt 2 -15) 0.02 0.02 (expt 2 -7)
- (expt 2 -23) (expt 2 -23) (expt 2 -23) (expt 2 -23) (expt 2 -23) ; assuming sndlib bits=24 here (if int)
- (expt 2 -15) (expt 2 -15) (expt 2 -7) (expt 2 -23) (expt 2 -23)
- (expt 2 -23))))
-
- (let* ((ob (view-sound "oboe.snd"))
- (samp (sample 1000 ob))
- (old-comment (mus-sound-comment "oboe.snd"))
- (str (string-append "written "
- (strftime "%a %d-%b-%Y %H:%M %Z"
- (localtime (current-time))))))
- (set! (comment ob) str)
- (let ((tag (catch #t
- (lambda ()
- (save-sound-as "test.snd" ob mus-aifc mus-bdouble))
- (lambda args (car args)))))
- (if (eq? tag 'cannot-save) (snd-display #__line__ ";save-sound-as test.snd write trouble")))
- (set! (filter-control-in-hz) #t)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (provided? 'snd-debug)
- (if (snd-sound-pointer 12345) (snd-display #__line__ ";snd-sound-pointer #f: ~A" (snd-sound-pointer 12345))))
- (if (not (= (header-type ab) mus-aifc))
- (snd-display #__line__ ";save-as aifc -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-aifc))
- (snd-display #__line__ ";saved-as aifc -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";aifc[1000] = ~A?" (sample 1000 ab)))
- (if (or (not (string? (mus-sound-comment "test.snd")))
- (not (string-=? (mus-sound-comment "test.snd") str)))
- (snd-display #__line__ ";output-comment: ~A ~A" (mus-sound-comment "test.snd") str))
- (if (or (not (string? (comment ab)))
- (not (string-=? (comment ab) str)))
- (snd-display #__line__ ";output-comment (comment): ~A ~A" (comment ab) str))
- (close-sound ab))
- (if (not (equal? old-comment (mus-sound-comment "oboe.snd")))
- (snd-display #__line__ ";set-comment overwrote current ~A ~A" old-comment (mus-sound-comment "oboe.snd")))
- (set! (filter-control-in-hz) #f)
- (save-sound-as "test.snd" ob mus-raw)
- (let ((ab (open-raw-sound "test.snd" 1 22050 mus-bshort)))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-raw))
- (snd-display #__line__ ";save-as raw -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-raw))
- (snd-display #__line__ ";saved-as raw -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";raw[1000] = ~A?" (sample 1000 ab)))
- (close-sound ab))
- (save-sound-as "test.snd" ob mus-nist mus-bint)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-nist))
- (snd-display #__line__ ";save-as nist -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-nist))
- (snd-display #__line__ ";saved-as nist -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (not (= (data-format ab) mus-bint))
- (snd-display #__line__ ";save-as int -> ~A?" (mus-data-format-name (data-format ab))))
- (if (not (= (mus-sound-data-format "test.snd") mus-bint))
- (snd-display #__line__ ";saved-as int -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";nist[1000] = ~A?" (sample 1000 ab)))
- (close-sound ab))
- (set! (hook-functions output-comment-hook) '())
- (hook-push output-comment-hook
- (lambda (str)
- (string-append str " [written by me]")))
- (save-sound-as :file "test.snd" :sound ob :header-type mus-riff :data-format mus-lfloat)
- (set! (hook-functions output-comment-hook) '())
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-riff))
- (snd-display #__line__ ";save-as riff -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-riff))
- (snd-display #__line__ ";saved-as riff -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (not (= (data-format ab) mus-lfloat))
- (snd-display #__line__ ";save-as float -> ~A?" (mus-data-format-name (data-format ab))))
- (if (not (= (mus-sound-data-format "test.snd") mus-lfloat))
- (snd-display #__line__ ";saved-as float -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";riff[1000] = ~A?" (sample 1000 ab)))
- (if (or (not (string? (comment ab)))
- (not (string-=? (comment ab)
- (string-append "written "
- (strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time)))
- " [written by me]"))))
- (snd-display #__line__ ";output-comment-hook: ~A~%(~A)" (comment ab) (mus-sound-comment "test.snd")))
- (close-sound ab))
- (save-sound-as "test.snd" ob mus-aiff mus-b24int)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-aiff))
- (snd-display #__line__ ";save-as aiff -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-aiff))
- (snd-display #__line__ ";saved-as aiff -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (not (= (data-format ab) mus-b24int))
- (snd-display #__line__ ";save-as 24-bit -> ~A?" (mus-data-format-name (data-format ab))))
- (if (not (= (mus-sound-data-format "test.snd") mus-b24int))
- (snd-display #__line__ ";saved-as 24-bit -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";aiff[1000] = ~A?" (sample 1000 ab)))
- (close-sound ab))
- (save-sound-as "test.snd" ob mus-ircam mus-mulaw)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-ircam))
- (snd-display #__line__ ";save-as ircam -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-ircam))
- (snd-display #__line__ ";saved-as ircam -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (not (= (data-format ab) mus-mulaw))
- (snd-display #__line__ ";save-as mulaw -> ~A?" (mus-data-format-name (data-format ab))))
- (if (not (= (mus-sound-data-format "test.snd") mus-mulaw))
- (snd-display #__line__ ";saved-as mulaw -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";ircam[1000] = ~A?" (sample 1000 ab)))
- (close-sound ab))
- (save-sound-as "test.snd" ob mus-next mus-alaw)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-next))
- (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-next))
- (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (not (= (data-format ab) mus-alaw))
- (snd-display #__line__ ";save-as alaw -> ~A?" (mus-data-format-name (data-format ab))))
- (if (not (= (mus-sound-data-format "test.snd") mus-alaw))
- (snd-display #__line__ ";saved-as alaw -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (alaw)[1000] = ~A?" (sample 1000 ab)))
- (close-sound ab))
- (save-sound-as "test.snd" ob mus-next mus-bdouble)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-next))
- (snd-display #__line__ ";save-as dbl next -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (data-format ab) mus-bdouble))
- (snd-display #__line__ ";save-as dbl -> ~A?" (mus-data-format-name (data-format ab))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (dbl)[1000] = ~A?" (sample 1000 ab)))
- (close-sound ab))
- (save-sound-as "test.snd" ob mus-next mus-bshort)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-next))
- (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-next))
- (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (not (= (data-format ab) mus-bshort))
- (snd-display #__line__ ";save-as short -> ~A?" (mus-data-format-name (data-format ab))))
- (if (not (= (mus-sound-data-format "test.snd") mus-bshort))
- (snd-display #__line__ ";saved-as short -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (short)[1000] = ~A?" (sample 1000 ab)))
- (set! (hook-functions update-hook) '())
- (set! (y-bounds ab 0) (list -3.0 3.0))
- (set! (data-format ab) mus-lshort)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd"))) ; these set!'s can change the index via update-sound
- (if (not (= (data-format ab) mus-lshort)) (snd-display #__line__ ";set data-format: ~A?" (mus-data-format-name (data-format ab))))
- (if (not (equal? (y-bounds ab 0) (list -3.0 3.0))) (snd-display #__line__ ";set data format y-bounds: ~A?" (y-bounds ab 0)))
- (set! (y-bounds ab 0) (list 2.0))
- (if (not (equal? (y-bounds ab 0) (list -2.0 2.0))) (snd-display #__line__ ";set data format y-bounds 1: ~A?" (y-bounds ab 0)))
- (set! (y-bounds ab 0) (list -2.0))
- (if (not (equal? (y-bounds ab 0) (list -2.0 2.0))) (snd-display #__line__ ";set data format y-bounds -2: ~A?" (y-bounds ab 0)))
- (set! (header-type ab) mus-aifc)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (header-type ab) mus-aifc)) (snd-display #__line__ ";set header-type: ~A?" (mus-header-type-name (header-type ab))))
- (set! (channels ab) 3)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (channels ab) 3)) (snd-display #__line__ ";set chans: ~A?" (channels ab)))
- (set! (data-location ab) 1234)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (data-location ab) 1234)) (snd-display #__line__ ";set data-location: ~A?" (data-location ab)))
- (let ((old-size (data-size ab)))
- (set! (data-size ab) 1234)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (data-size ab) 1234)) (snd-display #__line__ ";set data-size: ~A?" (data-size ab)))
- (set! (data-size ab) old-size))
- (set! (srate ab) 12345)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (srate ab) 12345)) (snd-display #__line__ ";set srate: ~A?" (srate ab)))
- (close-sound ab))
- (save-sound-as "test.snd" ob mus-next mus-bfloat)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (if (not (= (header-type ab) mus-next))
- (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
- (if (not (= (mus-sound-header-type "test.snd") mus-next))
- (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
- (if (not (= (data-format ab) mus-bfloat))
- (snd-display #__line__ ";save-as float -> ~A?" (mus-data-format-name (data-format ab))))
- (if (not (= (mus-sound-data-format "test.snd") mus-bfloat))
- (snd-display #__line__ ";saved-as float -> ~A?" (mus-data-format-name (mus-sound-data-format "test.snd"))))
- (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (float)[1000] = ~A?" (sample 1000 ab)))
- (close-sound ab))
- (save-sound-as "test.snd" ob mus-next mus-bshort)
- (close-sound ob)
- (let ((ab (open-sound "test.snd")))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ab)) XmNactivateCallback (snd-sound-pointer ab)))
- (set! (data-format) mus-lshort)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (data-format) mus-lshort)) (snd-display #__line__ ";set data-format: ~A?" (mus-data-format-name (data-format))))
- (set! (header-type) mus-aifc)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (header-type) mus-aifc)) (snd-display #__line__ ";set header-type: ~A?" (mus-header-type-name (header-type))))
- (set! (channels) 3)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (channels) 3)) (snd-display #__line__ ";set chans: ~A?" (channels)))
- (set! (data-location) 1234)
- (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (data-location) 1234)) (snd-display #__line__ ";set data-location: ~A?" (data-location)))
- (set! (srate) 12345)
+ (let ((diff (abs (- (v i) (v1 i)))))
+ (if (> diff maxdiff)
+ (begin
+ (set! maxdiff diff)
+ (set! maxpos i)))))
+ (if (> maxdiff allowed-diff)
+ (snd-display #__line__ ";[line 2841] ~A: ~A at ~A (~A ~A)"
+ (mus-sample-type-name type)
+ maxdiff maxpos
+ (v maxpos) (v1 maxpos)))
+ (close-sound ind))))
+ (list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte
+ mus-lfloat mus-bint mus-lint mus-b24int mus-l24int
+ mus-ubshort mus-ulshort mus-ubyte mus-bfloat mus-bdouble
+ mus-ldouble)
+ (list (expt 2 -15) (expt 2 -15) 0.02 0.02 (expt 2 -7)
+ (expt 2 -23) (expt 2 -23) (expt 2 -23) (expt 2 -23) (expt 2 -23) ; assuming sndlib bits=24 here (if int)
+ (expt 2 -15) (expt 2 -15) (expt 2 -7) (expt 2 -23) (expt 2 -23)
+ (expt 2 -23))))
+
+ (let* ((ob (view-sound "oboe.snd"))
+ (samp (sample 1000 ob))
+ (old-comment (mus-sound-comment "oboe.snd"))
+ (str (string-append "written "
+ (strftime "%a %d-%b-%Y %H:%M %Z"
+ (localtime (current-time))))))
+ (set! (comment ob) str)
+ (let ((tag (catch #t
+ (lambda ()
+ (save-sound-as "test.snd" ob :header-type mus-aifc :sample-type mus-bdouble))
+ (lambda args (car args)))))
+ (if (eq? tag 'cannot-save) (snd-display #__line__ ";save-sound-as test.snd write trouble")))
+ (set! *filter-control-in-hz* #t)
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-aifc))
+ (snd-display #__line__ ";save-as aifc -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-aifc))
+ (snd-display #__line__ ";saved-as aifc -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";aifc[1000] = ~A?" (sample 1000 ab)))
+ (if (or (not (string? (mus-sound-comment "test.snd")))
+ (not (string=? (mus-sound-comment "test.snd") str)))
+ (snd-display #__line__ ";output-comment: ~A ~A" (mus-sound-comment "test.snd") str))
+ (if (or (not (string? (comment ab)))
+ (not (string=? (comment ab) str)))
+ (snd-display #__line__ ";output-comment (comment): ~A ~A" (comment ab) str))
+ (close-sound ab))
+ (if (not (equal? old-comment (mus-sound-comment "oboe.snd")))
+ (snd-display #__line__ ";set-comment overwrote current ~A ~A" old-comment (mus-sound-comment "oboe.snd")))
+ (set! *filter-control-in-hz* #f)
+ (save-sound-as "test.snd" ob :header-type mus-raw)
+ (let ((ab (open-raw-sound "test.snd" 1 22050 mus-bshort)))
+ (if (not (= (header-type ab) mus-raw))
+ (snd-display #__line__ ";save-as raw -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-raw))
+ (snd-display #__line__ ";saved-as raw -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";raw[1000] = ~A?" (sample 1000 ab)))
+ (close-sound ab))
+ (save-sound-as "test.snd" ob :header-type mus-nist :sample-type mus-bint)
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-nist))
+ (snd-display #__line__ ";save-as nist -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-nist))
+ (snd-display #__line__ ";saved-as nist -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (not (= (sample-type ab) mus-bint))
+ (snd-display #__line__ ";save-as int -> ~A?" (mus-sample-type-name (sample-type ab))))
+ (if (not (= (mus-sound-sample-type "test.snd") mus-bint))
+ (snd-display #__line__ ";saved-as int -> ~A?" (mus-sample-type-name (mus-sound-sample-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";nist[1000] = ~A?" (sample 1000 ab)))
+ (close-sound ab))
+ (set! (hook-functions output-comment-hook) ())
+ (hook-push output-comment-hook
+ (lambda (hook)
+ (set! (hook 'result) (string-append (hook 'comment) " [written by me]"))))
+ (save-sound-as :file "test.snd" :sound ob :header-type mus-riff :sample-type mus-lfloat)
+ (set! (hook-functions output-comment-hook) ())
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-riff))
+ (snd-display #__line__ ";save-as riff -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-riff))
+ (snd-display #__line__ ";saved-as riff -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (not (= (sample-type ab) mus-lfloat))
+ (snd-display #__line__ ";save-as float -> ~A?" (mus-sample-type-name (sample-type ab))))
+ (if (not (= (mus-sound-sample-type "test.snd") mus-lfloat))
+ (snd-display #__line__ ";saved-as float -> ~A?" (mus-sample-type-name (mus-sound-sample-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";riff[1000] = ~A?" (sample 1000 ab)))
+ (if (or (not (string? (comment ab)))
+ (not (string=? (comment ab)
+ (string-append "written "
+ (strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time)))
+ " [written by me]"))))
+ (snd-display #__line__ ";output-comment-hook: ~A~%(~A)" (comment ab) (mus-sound-comment "test.snd")))
+ (close-sound ab))
+ (save-sound-as "test.snd" ob :header-type mus-aiff :sample-type mus-b24int)
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-aiff))
+ (snd-display #__line__ ";save-as aiff -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-aiff))
+ (snd-display #__line__ ";saved-as aiff -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (not (= (sample-type ab) mus-b24int))
+ (snd-display #__line__ ";save-as 24-bit -> ~A?" (mus-sample-type-name (sample-type ab))))
+ (if (not (= (mus-sound-sample-type "test.snd") mus-b24int))
+ (snd-display #__line__ ";saved-as 24-bit -> ~A?" (mus-sample-type-name (mus-sound-sample-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";aiff[1000] = ~A?" (sample 1000 ab)))
+ (close-sound ab))
+ (save-sound-as "test.snd" ob :header-type mus-ircam :sample-type mus-mulaw)
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-ircam))
+ (snd-display #__line__ ";save-as ircam -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-ircam))
+ (snd-display #__line__ ";saved-as ircam -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (not (= (sample-type ab) mus-mulaw))
+ (snd-display #__line__ ";save-as mulaw -> ~A?" (mus-sample-type-name (sample-type ab))))
+ (if (not (= (mus-sound-sample-type "test.snd") mus-mulaw))
+ (snd-display #__line__ ";saved-as mulaw -> ~A?" (mus-sample-type-name (mus-sound-sample-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";ircam[1000] = ~A?" (sample 1000 ab)))
+ (close-sound ab))
+ (save-sound-as "test.snd" ob :header-type mus-next :sample-type mus-alaw)
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-next))
+ (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-next))
+ (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (not (= (sample-type ab) mus-alaw))
+ (snd-display #__line__ ";save-as alaw -> ~A?" (mus-sample-type-name (sample-type ab))))
+ (if (not (= (mus-sound-sample-type "test.snd") mus-alaw))
+ (snd-display #__line__ ";saved-as alaw -> ~A?" (mus-sample-type-name (mus-sound-sample-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (alaw)[1000] = ~A?" (sample 1000 ab)))
+ (close-sound ab))
+ (save-sound-as "test.snd" ob :header-type mus-next :sample-type mus-ldouble)
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-next))
+ (snd-display #__line__ ";save-as dbl next -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (sample-type ab) mus-ldouble))
+ (snd-display #__line__ ";save-as dbl -> ~A?" (mus-sample-type-name (sample-type ab))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (dbl)[1000] = ~A?" (sample 1000 ab)))
+ (close-sound ab))
+ (save-sound-as "test.snd" ob :header-type mus-next :sample-type mus-bshort)
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-next))
+ (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-next))
+ (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (not (= (sample-type ab) mus-bshort))
+ (snd-display #__line__ ";save-as short -> ~A?" (mus-sample-type-name (sample-type ab))))
+ (if (not (= (mus-sound-sample-type "test.snd") mus-bshort))
+ (snd-display #__line__ ";saved-as short -> ~A?" (mus-sample-type-name (mus-sound-sample-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (short)[1000] = ~A?" (sample 1000 ab)))
+ (set! (hook-functions update-hook) ())
+ (set! (y-bounds ab 0) (list -3.0 3.0))
+ (set! (sample-type ab) mus-lshort)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd"))) ; these set!'s can change the index via update-sound
+ (if (not (= (sample-type ab) mus-lshort)) (snd-display #__line__ ";set sample-type: ~A?" (mus-sample-type-name (sample-type ab))))
+ (when with-gui
+ (if (not (equal? (y-bounds ab 0) (list -3.0 3.0))) (snd-display #__line__ ";set sample type y-bounds: ~A?" (y-bounds ab 0))))
+ (set! (y-bounds ab 0) (list 2.0))
+ (when with-gui
+ (if (not (equal? (y-bounds ab 0) (list -2.0 2.0))) (snd-display #__line__ ";set sample type y-bounds 1: ~A?" (y-bounds ab 0))))
+ (set! (y-bounds ab 0) (list -2.0))
+ (when with-gui
+ (if (not (equal? (y-bounds ab 0) (list -2.0 2.0))) (snd-display #__line__ ";set sample type y-bounds -2: ~A?" (y-bounds ab 0))))
+ (set! (header-type ab) mus-aifc)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (header-type ab) mus-aifc)) (snd-display #__line__ ";set header-type: ~A?" (mus-header-type-name (header-type ab))))
+ (set! (channels ab) 3)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (channels ab) 3)) (snd-display #__line__ ";set chans: ~A?" (channels ab)))
+ (set! (data-location ab) 1234)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (data-location ab) 1234)) (snd-display #__line__ ";set data-location: ~A?" (data-location ab)))
+ (let ((old-size (data-size ab)))
+ (set! (data-size ab) 1234)
(if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
- (if (not (= (srate) 12345)) (snd-display #__line__ ";set srate: ~A?" (srate)))
- (close-sound ab)))
-
- (let ((ind (open-sound "2a.snd")))
- (save-sound-as "test.snd" :data-format mus-l24int :header-type mus-riff :channel 0)
- (let ((ind0 (open-sound "test.snd")))
- (if (not (= (channels ind0) 1))
- (snd-display #__line__ ";save-sound-as :channel 0 chans: ~A" (channels ind0)))
- (if (not (= (data-format ind0) mus-l24int))
- (snd-display #__line__ ";save-sound-as :channel 0 data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
- (if (not (= (header-type ind0) mus-riff))
- (snd-display #__line__ ";save-sound-as :channel 0 header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
- (if (not (= (srate ind0) (srate ind)))
- (snd-display #__line__ ";save-sound-as :channel 0 srates: ~A ~A" (srate ind0) (srate ind)))
- (if (not (= (frames ind0) (frames ind 0)))
- (snd-display #__line__ ";save-sound-as :channel 0 frames: ~A ~A" (frames ind0) (frames ind 0)))
- (if (fneq (maxamp ind0 0) (maxamp ind 0))
- (snd-display #__line__ ";save-sound-as :channel 0 maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 0)))
- (close-sound ind0))
- (save-sound-as "test.snd" :data-format mus-bfloat :header-type mus-aifc :channel 1 :srate 12345)
- (let ((ind0 (open-sound "test.snd")))
- (if (not (= (channels ind0) 1))
- (snd-display #__line__ ";save-sound-as :channel 1 chans: ~A" (channels ind0)))
- (if (not (= (data-format ind0) mus-bfloat))
- (snd-display #__line__ ";save-sound-as :channel 1 data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
- (if (not (= (header-type ind0) mus-aifc))
- (snd-display #__line__ ";save-sound-as :channel 1 header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
- (if (not (= (srate ind0) 12345))
- (snd-display #__line__ ";save-sound-as :channel 1 srates: ~A ~A" (srate ind0) (srate ind)))
- (if (not (= (frames ind0) (frames ind 1)))
- (snd-display #__line__ ";save-sound-as :channel 1 frames: ~A ~A" (frames ind0) (frames ind 1)))
- (if (fneq (maxamp ind0 0) (maxamp ind 1))
- (snd-display #__line__ ";save-sound-as :channel 1 maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 1)))
- (close-sound ind0))
- (save-sound-as "test.snd" :channel 1 :comment "this is a test")
- (let ((ind0 (open-sound "test.snd")))
- (if (not (= (channels ind0) 1))
- (snd-display #__line__ ";save-sound-as :channel 1 (1) chans: ~A" (channels ind0)))
- (if (not (= (data-format ind0) (data-format ind)))
- (snd-display #__line__ ";save-sound-as :channel 1 (1) data-format: ~A ~A" (data-format ind0) (mus-data-format-name (data-format ind0))))
- (if (not (= (header-type ind0) (header-type ind)))
- (snd-display #__line__ ";save-sound-as :channel 1 (1) header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
- (if (not (= (srate ind0) (srate ind)))
- (snd-display #__line__ ";save-sound-as :channel 1 (1) srates: ~A ~A" (srate ind0) (srate ind)))
- (if (not (= (frames ind0) (frames ind 1)))
- (snd-display #__line__ ";save-sound-as :channel 1 (1) frames: ~A ~A" (frames ind0) (frames ind 1)))
- (if (fneq (maxamp ind0 0) (maxamp ind 1))
- (snd-display #__line__ ";save-sound-as :channel 1 (1) maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 1)))
- (if (not (string=? (comment ind0) "this is a test"))
- (snd-display #__line__ ";save-sound-as :channel 0 (1) comment: ~A" (comment ind0)))
- (close-sound ind0))
- (close-sound ind))
-
- (let ((fsnd (string-append sf-dir "t15.aiff")))
- (if (file-exists? fsnd)
- (let ((ind (open-sound fsnd)))
- (if (or (fneq (sample 132300 ind 0) .148)
- (fneq (sample 132300 ind 1) .126))
- (snd-display #__line__ ";aifc sowt trouble: ~A ~A" (sample 132300 ind 0) (sample 132300 ind 1)))
- (close-sound ind))))
- (let ((fsnd (string-append sf-dir "M1F1-float64C-AFsp.aif")))
- (if (file-exists? fsnd)
- (let ((ind (open-sound fsnd)))
- (if (or (fneq (sample 8000 ind 0) -0.024)
- (fneq (sample 8000 ind 1) 0.021))
- (snd-display #__line__ ";aifc fl64 trouble: ~A ~A" (sample 8000 ind 0) (sample 8000 ind 1)))
- (close-sound ind))))
-
- (for-each (lambda (n vals)
- (let ((val (catch #t (lambda ()
- (list (mus-sound-chans n)
- (mus-sound-srate n)
- (mus-sound-frames n)))
- (lambda args (car args)))))
- (if (and (not (equal? val vals))
- (not (eq? val 'mus-error)))
- (snd-display #__line__ ";~A: ~A ~A" n val vals))))
+ (if (not (= (data-size ab) 1234)) (snd-display #__line__ ";set data-size: ~A?" (data-size ab)))
+ (set! (data-size ab) old-size))
+ (set! (srate ab) 12345)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (srate ab) 12345)) (snd-display #__line__ ";set srate: ~A?" (srate ab)))
+ (close-sound ab))
+ (save-sound-as "test.snd" ob :header-type mus-next :sample-type mus-bfloat)
+ (let ((ab (open-sound "test.snd")))
+ (if (not (= (header-type ab) mus-next))
+ (snd-display #__line__ ";save-as next -> ~A?" (mus-header-type-name (header-type ab))))
+ (if (not (= (mus-sound-header-type "test.snd") mus-next))
+ (snd-display #__line__ ";saved-as next -> ~A?" (mus-header-type-name (mus-sound-header-type "test.snd"))))
+ (if (not (= (sample-type ab) mus-bfloat))
+ (snd-display #__line__ ";save-as float -> ~A?" (mus-sample-type-name (sample-type ab))))
+ (if (not (= (mus-sound-sample-type "test.snd") mus-bfloat))
+ (snd-display #__line__ ";saved-as float -> ~A?" (mus-sample-type-name (mus-sound-sample-type "test.snd"))))
+ (if (fneq (sample 1000 ab) samp) (snd-display #__line__ ";next (float)[1000] = ~A?" (sample 1000 ab)))
+ (close-sound ab))
+ (save-sound-as "test.snd" ob :header-type mus-next :sample-type mus-ldouble)
+ (close-sound ob)
+ (let ((ab (open-sound "test.snd")))
+ (set! (sample-type) mus-lshort)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (sample-type) mus-lshort)) (snd-display #__line__ ";set sample-type: ~A?" (mus-sample-type-name (sample-type))))
+ (set! (header-type) mus-aifc)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (header-type) mus-aifc)) (snd-display #__line__ ";set header-type: ~A?" (mus-header-type-name (header-type))))
+ (set! (channels) 3)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (channels) 3)) (snd-display #__line__ ";set chans: ~A?" (channels)))
+ (set! (data-location) 1234)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (data-location) 1234)) (snd-display #__line__ ";set data-location: ~A?" (data-location)))
+ (set! (srate) 12345)
+ (if (not (equal? ab (find-sound "test.snd"))) (set! ab (find-sound "test.snd")))
+ (if (not (= (srate) 12345)) (snd-display #__line__ ";set srate: ~A?" (srate)))
+ (close-sound ab)))
+
+ (let ((ind (open-sound "2a.snd")))
+ (save-sound-as "test.snd" :sample-type mus-l24int :header-type mus-riff :channel 0)
+ (let ((ind0 (open-sound "test.snd")))
+ (if (not (= (channels ind0) 1))
+ (snd-display #__line__ ";save-sound-as :channel 0 chans: ~A" (channels ind0)))
+ (if (not (= (sample-type ind0) mus-l24int))
+ (snd-display #__line__ ";save-sound-as :channel 0 sample-type: ~A ~A" (sample-type ind0) (mus-sample-type-name (sample-type ind0))))
+ (if (not (= (header-type ind0) mus-riff))
+ (snd-display #__line__ ";save-sound-as :channel 0 header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
+ (if (not (= (srate ind0) (srate ind)))
+ (snd-display #__line__ ";save-sound-as :channel 0 srates: ~A ~A" (srate ind0) (srate ind)))
+ (if (not (= (framples ind0) (framples ind 0)))
+ (snd-display #__line__ ";save-sound-as :channel 0 framples: ~A ~A" (framples ind0) (framples ind 0)))
+ (if (fneq (maxamp ind0 0) (maxamp ind 0))
+ (snd-display #__line__ ";save-sound-as :channel 0 maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 0)))
+ (close-sound ind0))
+ (save-sound-as "test.snd" :sample-type mus-l24int :header-type mus-riff)
+ (let ((ind0 (open-sound "test.snd")))
+ (if (not (= (channels ind0) 2))
+ (snd-display #__line__ ";save-sound-as chans: ~A" (channels ind0)))
+ (if (not (= (sample-type ind0) mus-l24int))
+ (snd-display #__line__ ";save-sound-as sample-type: ~A ~A" (sample-type ind0) (mus-sample-type-name (sample-type ind0))))
+ (if (not (= (header-type ind0) mus-riff))
+ (snd-display #__line__ ";save-sound-as header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
+ (if (not (= (srate ind0) (srate ind)))
+ (snd-display #__line__ ";save-sound-as srates: ~A ~A" (srate ind0) (srate ind)))
+ (if (not (= (framples ind0) (framples ind 0)))
+ (snd-display #__line__ ";save-sound-as framples: ~A ~A" (framples ind0) (framples ind 0)))
+ (if (fneq (maxamp ind0 0) (maxamp ind 0))
+ (snd-display #__line__ ";save-sound-as maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 0)))
+ (close-sound ind0))
+ (save-sound-as "test.snd" :sample-type mus-b24int :header-type mus-aiff)
+ (let ((ind0 (open-sound "test.snd")))
+ (if (not (= (channels ind0) 2))
+ (snd-display #__line__ ";save-sound-as chans: ~A" (channels ind0)))
+ (if (not (= (sample-type ind0) mus-b24int))
+ (snd-display #__line__ ";save-sound-as sample-type: ~A ~A" (sample-type ind0) (mus-sample-type-name (sample-type ind0))))
+ (if (not (= (header-type ind0) mus-aiff))
+ (snd-display #__line__ ";save-sound-as header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
+ (if (not (= (srate ind0) (srate ind)))
+ (snd-display #__line__ ";save-sound-as srates: ~A ~A" (srate ind0) (srate ind)))
+ (if (not (= (framples ind0) (framples ind 0)))
+ (snd-display #__line__ ";save-sound-as framples: ~A ~A" (framples ind0) (framples ind 0)))
+ (if (fneq (maxamp ind0 0) (maxamp ind 0))
+ (snd-display #__line__ ";save-sound-as maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 0)))
+ (close-sound ind0))
+ (save-sound-as "test.snd" :sample-type mus-bfloat :header-type mus-aifc :channel 1 :srate 12345)
+ (let ((ind0 (open-sound "test.snd")))
+ (if (not (= (channels ind0) 1))
+ (snd-display #__line__ ";save-sound-as :channel 1 chans: ~A" (channels ind0)))
+ (if (not (= (sample-type ind0) mus-bfloat))
+ (snd-display #__line__ ";save-sound-as :channel 1 sample-type: ~A ~A" (sample-type ind0) (mus-sample-type-name (sample-type ind0))))
+ (if (not (= (header-type ind0) mus-aifc))
+ (snd-display #__line__ ";save-sound-as :channel 1 header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
+ (if (not (= (srate ind0) 12345))
+ (snd-display #__line__ ";save-sound-as :channel 1 srates: ~A ~A" (srate ind0) (srate ind)))
+ (if (not (= (framples ind0) (framples ind 1)))
+ (snd-display #__line__ ";save-sound-as :channel 1 framples: ~A ~A" (framples ind0) (framples ind 1)))
+ (if (fneq (maxamp ind0 0) (maxamp ind 1))
+ (snd-display #__line__ ";save-sound-as :channel 1 maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 1)))
+ (close-sound ind0))
+ (save-sound-as "test.snd" :channel 1 :comment "this is a test")
+ (let ((ind0 (open-sound "test.snd")))
+ (if (not (= (channels ind0) 1))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) chans: ~A" (channels ind0)))
+ (if (not (= (sample-type ind0) (sample-type ind)))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) sample-type: ~A ~A" (sample-type ind0) (mus-sample-type-name (sample-type ind0))))
+ (if (not (= (header-type ind0) (header-type ind)))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) header-type: ~A ~A" (header-type ind0) (mus-header-type-name (header-type ind0))))
+ (if (not (= (srate ind0) (srate ind)))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) srates: ~A ~A" (srate ind0) (srate ind)))
+ (if (not (= (framples ind0) (framples ind 1)))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) framples: ~A ~A" (framples ind0) (framples ind 1)))
+ (if (fneq (maxamp ind0 0) (maxamp ind 1))
+ (snd-display #__line__ ";save-sound-as :channel 1 (1) maxamps: ~A ~A" (maxamp ind0 0) (maxamp ind 1)))
+ (if (not (string=? (comment ind0) "this is a test"))
+ (snd-display #__line__ ";save-sound-as :channel 0 (1) comment: ~A" (comment ind0)))
+ (close-sound ind0))
+ (close-sound ind))
+
+ (let ((fsnd (string-append sf-dir "t15.aiff")))
+ (if (file-exists? fsnd)
+ (let ((ind (open-sound fsnd)))
+ (if (or (fneq (sample 132300 ind 0) .148)
+ (fneq (sample 132300 ind 1) .126))
+ (snd-display #__line__ ";aifc sowt trouble: ~A ~A" (sample 132300 ind 0) (sample 132300 ind 1)))
+ (close-sound ind))))
+ (let ((fsnd (string-append sf-dir "M1F1-float64C-AFsp.aif")))
+ (if (file-exists? fsnd)
+ (let ((ind (open-sound fsnd)))
+ (if (or (fneq (sample 8000 ind 0) -0.024)
+ (fneq (sample 8000 ind 1) 0.021))
+ (snd-display #__line__ ";aifc fl64 trouble: ~A ~A" (sample 8000 ind 0) (sample 8000 ind 1)))
+ (close-sound ind))))
+
+ (for-each (lambda (n vals)
+ (let ((val (catch #t (lambda ()
+ (list (mus-sound-chans n)
+ (mus-sound-srate n)
+ (mus-sound-framples n)))
+ (lambda args (car args)))))
+ (if (and (not (equal? val vals))
+ (not (eq? val 'mus-error)))
+ (snd-display #__line__ ";~A: ~A ~A" n val vals))))
+ (list (string-append sf-dir "bad_chans.snd")
+ (string-append sf-dir "bad_srate.snd")
+ (string-append sf-dir "bad_data_format.snd")
+ (string-append sf-dir "bad_chans.aifc")
+ (string-append sf-dir "bad_srate.aifc")
+ (string-append sf-dir "bad_length.aifc")
+ (string-append sf-dir "bad_chans.riff")
+ (string-append sf-dir "bad_srate.riff")
+ (string-append sf-dir "bad_chans.nist")
+ (string-append sf-dir "bad_srate.nist")
+ (string-append sf-dir "bad_length.nist"))
+ (list (list 0 22050 0)
+ (list 1 0 0)
+ (list 1 22050 4411)
+ (list 0 22050 0)
+ (list 1 0 0)
+ (list 1 22050 -10)
+ (list 0 22050 0)
+ (list 1 0 0)
+ (list 0 22050 0)
+ (list 1 0 0)
+ (list 1 22050 -10)))
+
+ (let ((ind (open-sound (string-append "/usr/include/sys/" home-dir "/cl/oboe.snd"))))
+ (if (or (not (sound? ind))
+ (not (string=? (short-file-name ind) "oboe.snd")))
+ (snd-display #__line__ ";open-sound with slashes: ~A ~A" ind (and (sound? ind) (short-file-name ind))))
+ (hook-push bad-header-hook (lambda (hook) (set! (hook 'result) #t)))
+ (for-each (lambda (n)
+ (catch #t (lambda ()
+ (insert-sound n))
+ (lambda args (car args)))
+ (catch #t (lambda ()
+ (convolve-with n))
+ (lambda args (car args)))
+ (catch #t (lambda ()
+ (mix n))
+ (lambda args (car args)))
+ (catch #t (lambda ()
+ (let ((ind (open-sound n)))
+ (if (and (number? ind)
+ (sound? ind))
+ (close-sound ind))))
+ (lambda args (car args))))
(list (string-append sf-dir "bad_chans.snd")
(string-append sf-dir "bad_srate.snd")
- (string-append sf-dir "bad_data_format.snd")
(string-append sf-dir "bad_chans.aifc")
(string-append sf-dir "bad_srate.aifc")
(string-append sf-dir "bad_length.aifc")
(string-append sf-dir "bad_chans.riff")
(string-append sf-dir "bad_srate.riff")
(string-append sf-dir "bad_chans.nist")
+ (string-append sf-dir "bad_location.nist")
+ (string-append sf-dir "bad_field.nist")
(string-append sf-dir "bad_srate.nist")
- (string-append sf-dir "bad_length.nist"))
- (list (list 0 22050 0)
- (list 1 0 0)
- (list 1 22050 4411)
- (list 0 22050 0)
- (list 1 0 0)
- (list 1 22050 -10)
- (list 0 22050 0)
- (list 1 0 0)
- (list 0 22050 0)
- (list 1 0 0)
- (list 1 22050 -10)))
-
- (let ((ind (open-sound (string-append "/usr/include/sys/" home-dir "/cl/oboe.snd"))))
- (if (or (not (sound? ind))
- (not (string=? (short-file-name ind) "oboe.snd")))
- (snd-display #__line__ ";open-sound with slashes: ~A ~A" ind (and (sound? ind) (short-file-name ind))))
- (hook-push bad-header-hook (lambda (n) #t))
- (for-each (lambda (n)
- (begin
- (catch #t (lambda ()
- (insert-sound n))
- (lambda args (car args)))
- (catch #t (lambda ()
- (convolve-with n))
- (lambda args (car args)))
- (catch #t (lambda ()
- (mix n))
- (lambda args (car args)))
- (catch #t (lambda ()
- (let ((ind (open-sound n)))
- (if (and (number? ind)
- (sound? ind))
- (close-sound ind))))
- (lambda args (car args)))))
- (list (string-append sf-dir "bad_chans.snd")
- (string-append sf-dir "bad_srate.snd")
- (string-append sf-dir "bad_chans.aifc")
- (string-append sf-dir "bad_srate.aifc")
- (string-append sf-dir "bad_length.aifc")
- (string-append sf-dir "bad_chans.riff")
- (string-append sf-dir "bad_srate.riff")
- (string-append sf-dir "bad_chans.nist")
- (string-append sf-dir "bad_location.nist")
- (string-append sf-dir "bad_field.nist")
- (string-append sf-dir "bad_srate.nist")
- (string-append sf-dir "bad_length.nist")))
- (close-sound ind))
-
- (map close-sound (sounds))
-
- (let* ((ob (open-sound (string-append "~/baddy/" home-dir "/cl/oboe.snd")))
- (sd (vct->sound-data (channel->vct)))
- (mx (sound-data-maxamp sd)))
- (if (not (= (sound-data-length sd) 50828)) (snd-display #__line__ ";oboe->sd: len ~A?" (sound-data-length sd)))
- (if (fneq (sound-data-ref sd 0 1000) .0328369) (snd-display #__line__ ";oboe->sd[1000]: ~A?" (sound-data-ref sd 0 1000)))
- (if (not (= (length mx) 1)) (snd-display #__line__ ";sound-data-maxamp oboe.snd: ~A?" mx))
- (if (not (= (maxamp ob 0) (car mx))) (snd-display #__line__ ";sound-data-maxamp oboe.snd: ~A ~A?" mx (maxamp ob 0)))
- (if (fneq (sound-data-peak sd) (car mx)) (snd-display #__line__ ";sound-data-peak oboe.snd: ~A ~A" (sound-data-peak sd) mx))
-
- (let ((var (catch #t (lambda () (set! (selected-channel) 1)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-channel))
- (snd-display #__line__ ";set selected-channel bad chan: ~A" var)))
- (let ((var (catch #t (lambda () (set! (selected-channel 123456) 1)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-sound))
- (snd-display #__line__ ";set selected-channel bad snd: ~A" var)))
- (let ((var (catch #t (lambda () (sound-data-ref sd 2 1000)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";sound-data-ref bad chan: ~A" var)))
- (let ((var (catch #t (lambda () (sound-data-ref sd -1 1000)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";sound-data-ref bad chan -1: ~A" var)))
- (let ((var (catch #t (lambda () (sound-data-ref sd 0 -1)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";sound-data-ref bad frame: ~A" var)))
- (let ((var (catch #t (lambda () (sound-data-ref sd 0 10000000)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";sound-data-ref bad frame high: ~A" var)))
- (let ((var (catch #t (lambda () (sound-data-set! sd 2 1000 1)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";sound-data-set! bad chan: ~A" var)))
- (let ((var (catch #t (lambda () (sound-data-set! sd 0 10000000 1)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";sound-data-set! bad frame: ~A" var)))
- (let* ((v (make-vct 3))
- (var (catch #t (lambda () (vct->sound-data v sd 2)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct->sound-data-set! bad chan: ~A" var)))
- (close-sound ob))
- (if (selected-sound)
- (snd-display #__line__ ";selected-sound ~A ~A" (selected-sound) (sounds)))
-
- (if (file-exists? (string-append (or sf-dir "") "a.sf2"))
- (let ((fil (open-sound (string-append (or sf-dir "") "a.sf2"))))
- (if fil
- (let ((loops (and fil (soundfont-info))))
- (if (or (null? loops)
- (not (= (caddar loops) 65390))
- (not (= (cadadr loops) 65490)))
- (snd-display #__line__ ";soundfont-info: ~A?" loops))
- (close-sound fil)))))
-
- (if (file-exists? "fmv5.snd") (delete-file "fmv5.snd"))
- (set! (print-length) 12)
- (let ((fd (mus-sound-open-output "fmv5.snd" 22050 1 mus-bshort mus-aiff "no comment"))
- (sdata (make-sound-data 1 100)))
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (sound-data-set! sdata 0 i (* i .01)))
- (if (not (string-=? "#<sound-data[chans=1, length=100]:\n (0.000 0.010 0.020 0.030 0.040 0.050 0.060 0.070 0.080 0.090 0.100 0.110 ...)>"
- (format #f "~A" sdata)))
- (snd-display #__line__ ";print sound-data: ~A?" (format #f "~A" sdata)))
- (let ((edat sdata)
- (edat1 (make-sound-data 1 100))
- (edat2 (make-sound-data 2 100)))
- (if (not (eq? sdata edat)) (snd-display #__line__ ";sound-data not eq? ~A ~A" sdata edat))
- (if (not (equal? sdata edat)) (snd-display #__line__ ";sound-data not equal? ~A ~A" sdata edat))
- (if (equal? sdata edat1) (snd-display #__line__ ";sound-data 1 equal? ~A ~A" sdata edat1))
- (if (equal? edat2 edat1) (snd-display #__line__ ";sound-data 2 equal? ~A ~A" edat2 edat1))
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (set! (sound-data-ref edat1 0 i) (sound-data-ref sdata 0 i)))
- (if (not (equal? sdata edat1)) (snd-display #__line__ ";sound-data 3 not equal? ~A ~A" sdata edat1)))
- (let ((v0 (make-vct 100))
- (v1 (make-vct 3)))
- (sound-data->vct sdata 0 v0)
- (if (fneq (vct-ref v0 10) .1) (snd-display #__line__ ";sound-data->vct: ~A?" v0))
- (sound-data->vct sdata 0 v1)
- (if (fneq (vct-ref v1 1) .01) (snd-display #__line__ ";sound-data->(small)vct: ~A?" v1))
- (vct->sound-data v0 sdata 0)
- (if (fneq (sound-data-ref sdata 0 10) .1) (snd-display #__line__ ";vct->sound-data: ~A?" (sound-data-ref sdata 0 10)))
- (if (fneq (sdata 0 10) .1) (snd-display #__line__ ";vct->sound-data applied: ~A?" (sdata 0 10)))
- (let ((var (catch #t (lambda () (sound-data->vct sdata 2 v0)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";sound-data->vct bad chan: ~A" var)))
- (let ((var (catch #t (lambda () (mus-audio-write 1 (make-sound-data 3 3) 123)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";mus-audio-write bad frames: ~A" var))))
-
- (let ((v0 (make-vct 10))
- (vx (make-vct 3))
- (sdata2 (make-sound-data 2 10)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sdata2 0 i 0.1)
- (sound-data-set! sdata2 1 i 0.2))
- (sound-data->vct sdata2 0 v0)
- (sound-data->vct sdata2 0 vx)
- (if (fneq (vct-ref v0 1) .1) (snd-display #__line__ ";sound-data->vct[1]: ~A?" v0))
- (sound-data->vct sdata2 1 v0)
- (if (fneq (vct-ref v0 1) .2) (snd-display #__line__ ";sound-data->vct[2]: ~A?" v0))
- (vct->sound-data v0 sdata2 0)
- (if (fneq (sound-data-ref sdata2 0 1) .2)
- (snd-display #__line__ ";vct->sound-data[2]: ~A?" (sound-data-ref sdata2 0 1)))
- (vct-fill! v0 .3)
- (vct->sound-data v0 sdata2 1)
- (if (fneq (sound-data-ref sdata2 1 1) .3)
- (snd-display #__line__ ";vct->sound-data[3]: ~A?" (sound-data-ref sdata2 1 1)))
- (vct->sound-data vx sdata2 0))
- (mus-sound-write fd 0 99 1 sdata)
- (mus-sound-close-output fd (* 100 (mus-bytes-per-sample mus-bshort))) ; bshort chosen at open
- (set! fd (mus-sound-reopen-output "fmv5.snd" 1 mus-bshort mus-aiff (mus-sound-data-location "fmv5.snd")))
- (mus-sound-close-output fd (* 100 (mus-bytes-per-sample mus-bshort)))
- (set! fd (mus-sound-open-input "fmv5.snd"))
- (mus-sound-read fd 0 99 1 sdata)
- (if (fneq (sound-data-ref sdata 0 10) .1) (snd-display #__line__ ";mus-sound-write: ~A?" (sound-data-ref sdata 0 10)))
- (let ((pos (mus-sound-seek-frame fd 20)))
- (if (not (= pos (ftell fd)))
- (snd-display #__line__ ";1 mus-sound-seek-frame: ~A ~A?" pos (ftell fd)))
- (if (not (= pos (frame->byte "fmv5.snd" 20)))
- (snd-display #__line__ ";2 mus-sound-seek-frame(2): ~A ~A?" pos (frame->byte "fmv5.snd" 20))))
- (mus-sound-read fd 0 10 1 sdata)
- (if (fneq (sound-data-ref sdata 0 0) .2) (snd-display #__line__ ";2 mus-sound-seek: ~A?" (sound-data-ref sdata 0 0)))
- (mus-sound-close-input fd))
-
- (let ((sd (make-sound-data 2 10)))
- (vct->sound-data (make-vct 10 .25) sd 0)
- (vct->sound-data (make-vct 10 .5) sd 1)
- (sound-data-scale! sd 2.0)
- (if (not (vequal (sound-data->vct sd 0) (make-vct 10 .5)))
- (snd-display #__line__ ";sound-data-scale! chan 0: ~A" (sound-data->vct sd 0)))
- (if (not (vequal (sound-data->vct sd 1) (make-vct 10 1.0)))
- (snd-display #__line__ ";sound-data-scale! chan 1: ~A" (sound-data->vct sd 1))))
-
- (let ((sd (make-sound-data 2 10)))
- (sound-data-fill! sd 2.0)
- (if (not (vequal (sound-data->vct sd 0) (make-vct 10 2.0)))
- (snd-display #__line__ ";sound-data-fill! chan 0: ~A" (sound-data->vct sd 0)))
- (if (not (vequal (sound-data->vct sd 1) (make-vct 10 2.0)))
- (snd-display #__line__ ";sound-data-fill! chan 1: ~A" (sound-data->vct sd 1))))
-
- (let ((var (catch #t (lambda () (mus-sound-open-output "fmv.snd" 22050 -1 mus-bshort mus-aiff "no comment")) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";mus-sound-open-output bad chans: ~A" var)))
- (let ((var (catch #t (lambda () (mus-sound-open-output "fmv.snd" 22050 1 -1 mus-aiff "no comment")) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";mus-sound-open-output bad format: ~A" var)))
- (let ((var (catch #t (lambda () (mus-sound-open-output "fmv.snd" 22050 1 mus-bshort -1 "no comment")) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";mus-sound-open-output bad type: ~A" var)))
-
- (let ((var (catch #t (lambda () (mus-sound-reopen-output "fmv.snd" -1 mus-bshort mus-aiff #f)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";mus-sound-reopen-output bad chans: ~A" var)))
- (let ((var (catch #t (lambda () (mus-sound-reopen-output "fmv.snd" 1 -1 mus-aiff #f)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";mus-sound-reopen-output bad format: ~A" var)))
- (let ((var (catch #t (lambda () (mus-sound-reopen-output "fmv.snd" 1 mus-bshort -1 #f)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";mus-sound-reopen-output bad type: ~A" var)))
-
- (let ((sd (make-sound-data 2 10)))
- (fill! sd 1.0)
- (if (not (vequal (sound-data->vct sd 0) (make-vct 10 1.0)))
- (snd-display #__line__ ";fill! sd chan 0: ~A" (sound-data->vct sd 0)))
- (if (not (vequal (sound-data->vct sd 1) (make-vct 10 1.0)))
- (snd-display #__line__ ";fill! sd chan 1: ~A" (sound-data->vct sd 1)))
- (let ((sd1 (copy sd)))
- (if (not (equal? sd sd1)) (snd-display #__line__ ";copy sd: ~A ~A"))))
-
- (for-each
- (lambda (file)
- (let ((tag (catch #t
- (lambda () (open-sound (string-append sf-dir file)))
- (lambda args args))))
- (if (not (eq? (car tag) 'mus-error))
- (snd-display #__line__ ";open-sound ~A: ~A" file tag))))
- (list "trunc.snd" "trunc.aiff" "trunc.wav" "trunc.sf" "trunc.voc" "trunc.nist" "bad.wav"
- "trunc1.aiff" "badform.aiff"))
- (hook-push open-raw-sound-hook (lambda (file choice) (list 1 22050 mus-bshort)))
- (let ((ind (open-sound (string-append sf-dir "empty.snd"))))
- (if (or (not (= (data-format ind) mus-bshort))
- (not (= (chans ind) 1))
- (not (= (srate ind) 22050))
- (not (= (data-location ind) 0))
- (not (= (frames ind) 0)))
- (snd-display #__line__ ";open raw: ~A ~A ~A ~A ~A" (data-format ind) (chans ind) (srate ind) (data-location ind) (frames ind)))
- (set! (hook-functions open-raw-sound-hook) '())
- (close-sound ind))
-
- (let ((sd1 (make-sound-data 1 32))
- (sd2 (make-sound-data 2 64)))
- (do ((i 0 (+ 1 i)))
- ((= i 32))
- (sound-data-set! sd1 0 i (* .01 i)))
- (do ((i 0 (+ 1 i)))
- ((= i 64))
- (sound-data-set! sd2 0 i (* .1 i))
- (sound-data-set! sd2 1 i (* .2 i)))
- (sound-data->sound-data sd2 sd1 3 6 32)
- (if (fneq (sound-data-ref sd1 0 0) 0.0) (snd-display #__line__ ";sound-data->sound-data 0: ~A" (sound-data-ref sd1 0 0)))
- (if (fneq (sound-data-ref sd1 0 2) 0.02) (snd-display #__line__ ";sound-data->sound-data 2: ~A" (sound-data-ref sd1 0 2)))
- (if (fneq (sound-data-ref sd1 0 3) 0.0) (snd-display #__line__ ";sound-data->sound-data 3: ~A" (sound-data-ref sd1 0 3)))
- (if (fneq (sound-data-ref sd1 0 6) 0.3) (snd-display #__line__ ";sound-data->sound-data 6: ~A" (sound-data-ref sd1 0 6)))
- (if (fneq (sound-data-ref sd1 0 10) 0.1) (snd-display #__line__ ";sound-data->sound-data 10: ~A" (sound-data-ref sd1 0 10)))
- (sound-data->sound-data sd1 sd2 0 10 32)
- (if (fneq (sound-data-ref sd2 0 5) 0.2) (snd-display #__line__ ";sound-data->sound-data 2 5: ~A" (sound-data-ref sd2 0 5))))
- (let ((sdi (make-sound-data 1 32))
- (sdo (make-sound-data 1 32)))
- (let ((j (sound-data->sound-data sdi sdo 10 32 10)))
- (if (not (= j 2)) (snd-display #__line__ ";sound-data->sound-data wrap around 2: ~A" j)))
- (let ((j (sound-data->sound-data sdi sdo 10 32 32)))
- (if (not (= j 10)) (snd-display #__line__ ";sound-data->sound-data wrap around 10: ~A" j)))
- (let ((tag (catch #t
- (lambda () (sound-data->sound-data sdi sdo -1 10 10))
- (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";sound-data->sound-data start: ~A" tag)))
- (let ((tag (catch #t
- (lambda () (sound-data->sound-data sdi sdo 0 -1 10))
- (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";sound-data->sound-data frames: ~A" tag)))
- (let ((tag (catch #t
- (lambda () (sound-data->sound-data sdi sdo 0 128 10))
- (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";sound-data->sound-data frames: ~A" tag))))
-
-
- (let ((sd (make-sound-data 1 1)))
- (if (fneq (sd 0 0) 0.0) (snd-display #__line__ ";sound-data ref: ~A" (sd 0 0)))
- (set! (sd 0 0) 1.0)
- (if (fneq (sd 0 0) 1.0) (snd-display #__line__ ";sound-data set: ~A" (sd 0 0)))
- (if (not (equal? sd (let ((sd1 (make-sound-data 1 1))) (sound-data-set! sd1 0 0 1.0) sd1)))
- (snd-display #__line__ ";sound-data set not equal: ~A" sd)))
-
- (let ((sd (make-sound-data 2 3)))
- (if (fneq (sd 0 0) 0.0) (snd-display #__line__ ";sound-data ref (1): ~A" (sd 0 0)))
- (set! (sd 1 0) 1.0)
- (if (fneq (sd 1 0) 1.0) (snd-display #__line__ ";sound-data set (1 0): ~A" (sd 1 0)))
- (set! (sd 1 2) 2.0)
- (if (fneq (sd 1 2) 2.0) (snd-display #__line__ ";sound-data set (1 2): ~A" (sd 1 2)))
- (if (not (equal? sd (let ((sd1 (make-sound-data 2 3)))
- (sound-data-set! sd1 1 0 1.0)
- (sound-data-set! sd1 1 2 2.0)
- sd1)))
- (snd-display #__line__ ";sound-data set (3) not equal: ~A" sd)))
-
-
- (for-each
- (lambda (chans)
- (for-each
- (lambda (df-ht)
- (let ((samps (if (= chans 1) 100000
- (if (= chans 2) 50000
- 1000))))
- (if (file-exists? "fmv5.snd") (delete-file "fmv5.snd"))
- (let ((fd (mus-sound-open-output "fmv5.snd" 22050 chans (car df-ht) (cadr df-ht) "no comment"))
- (sdata (make-sound-data chans samps))
- (ndata (make-sound-data chans samps)))
- (run
- (do ((k 0 (+ 1 k)))
- ((= k chans))
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (sound-data-set! sdata k i (- (random 2.0) 1.0)))))
- (mus-sound-write fd 0 (- samps 1) chans sdata)
- (mus-sound-close-output fd (* samps chans (mus-bytes-per-sample (car df-ht))))
- (set! fd (mus-sound-open-input "fmv5.snd"))
- (mus-sound-read fd 0 (- samps 1) chans ndata)
- (let ((pos (mus-sound-seek-frame fd 100)))
- (if (not (= pos (ftell fd)))
- (snd-display #__line__ ";mus-sound-seek-frame[~A]: chans ~A ~A (~A ~A)?"
- pos chans (ftell fd) (mus-header-type-name (cadr df-ht)) (mus-data-format-name (car df-ht))))
- (if (not (= pos (frame->byte "fmv5.snd" 100)))
- (snd-display #__line__ ";mus-sound-seek-frame(100): ~A ~A (~A ~A ~A)?"
- pos (frame->byte "fmv5.snd" 100) chans (mus-header-type-name (cadr df-ht)) (mus-data-format-name (car df-ht)))))
- (mus-sound-close-input fd)
- (let ((v0 0.0)
- (v1 0.0))
- (catch 'read-write-error
- (lambda ()
- (run
- (do ((k 0 (+ 1 k)))
- ((= k chans))
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (if (fneq (sound-data-ref sdata k i) (sound-data-ref ndata k i))
- (begin
- (set! v0 (sound-data-ref sdata k i))
- (set! v1 (sound-data-ref ndata k i))
- ;(snd-display #__line__ ";v0: ~A, v1: ~A, diff: ~A, k: ~A, i: ~A" v0 v1 (- v1 v0) k i)
- (throw 'read-write-error)))))))
- (lambda args
- (begin
- (snd-display #__line__ ";read-write trouble: ~A ~A (~A != ~A): ~A"
- (mus-data-format-name (car df-ht))
- (mus-header-type-name (cadr df-ht))
- v0 v1 args)
- (car args))))))))
- (list (list mus-bshort mus-next)
- (list mus-bfloat mus-aifc)
- (list mus-lshort mus-aifc)
- (list mus-lfloat mus-riff)
- (list mus-lshort mus-nist)
- (list mus-bint mus-aiff)
- (list mus-lint mus-next)
- (list mus-bintn mus-next)
- (list mus-lintn mus-next)
- (list mus-b24int mus-aifc)
- (list mus-l24int mus-riff)
- (list mus-bfloat mus-ircam)
- (list mus-bfloat-unscaled mus-next)
- (list mus-lfloat-unscaled mus-next)
- (list mus-bdouble-unscaled mus-next)
- (list mus-ldouble-unscaled mus-next)
- (list mus-bdouble mus-next)
- (list mus-ldouble mus-next)
- (list mus-ulshort mus-next)
- (list mus-ubshort mus-next))))
- (list 1 2 4 8))
-
-#|
- ;; big sound-data objects (needs 32 Gbytes):
- (if (and (string? (getenv "HOSTNAME"))
- (string=? (getenv "HOSTNAME") "fatty8"))
- (let ((size (+ 2 (expt 2 31))))
- (if (not (= size 2147483650))
- (snd-display #__line__ ";big sd, size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
- (set! (mus-max-malloc) (expt 2 40))
- (if (not (= (mus-max-malloc) 1099511627776))
- (snd-display #__line__ ";big sd, mus-max-malloc: ~A" (mus-max-malloc)))
- (let ((hi (make-sound-data 1 size)))
- (if (not (sound-data? hi))
- (snd-display #__line__ ";big sd, not a sound-data?? ~A" hi))
- (if (fneq (sound-data-ref hi 0 (expt 2 31)) 0.0)
- (snd-display #__line__ ";big sd, created at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
- (if (not (= (sound-data-chans hi) 1))
- (snd-display #__line__ ";big sd, sound-data-chans: ~A" (sound-data-chans hi)))
- (sound-data+ hi .1)
- (if (fneq (sound-data-ref hi 0 (expt 2 31)) 0.1)
- (snd-display #__line__ ";big sd, add .1 at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
- (let ((pk (sound-data-peak hi)))
- (if (fneq pk .1)
- (snd-display #__line__ ";big sd, sound-data-peak: ~A" pk)))
- (let ((len (sound-data-length hi)))
- (if (not (= len size))
- (snd-display #__line__ ";big sd, len: ~A" len)))
- (sound-data-scale! hi 2.0)
- (if (fneq (sound-data-ref hi 0 (+ 1 (expt 2 31))) .2)
- (snd-display #__line__ ";big sd, scale: ~A ~A" (sound-data-ref hi 0 (+ 1 (expt 2 31))) hi))
- (sound-data-set! hi 0 (expt 2 31) 1.0)
- (if (fneq (sound-data-ref hi 0 (expt 2 31)) 1.0)
- (snd-display #__line__ ";big sd, set at end: ~A" (sound-data-ref hi 0 (expt 2 31))))
- (sound-data-offset! hi .2)
- (if (fneq (sound-data-ref hi 0 (expt 2 31)) 1.2)
- (snd-display #__line__ ";big sd, offset: ~A" (sound-data-ref hi 0 (expt 2 31))))
- (let ((pk (sound-data-maxamp hi)))
- (if (fneq (car pk) 1.2)
- (snd-display #__line__ ";big sd, subtract sound-data-maxamp: ~A ~A" pk hi)))
- (let ((pk (sound-data-peak hi)))
- (if (fneq pk 1.2)
- (snd-display #__line__ ";big sd, sound-data-peak: ~A ~A" pk hi)))
- (sound-data-fill! hi 1.0)
- (if (fneq (sound-data-ref hi 0 (expt 2 31)) 1.0)
- (snd-display #__line__ ";big sd, fill: ~A ~A" (sound-data-ref hi 0 (expt 2 31)) hi))
- (sound-data-reverse! hi)
- (let ((v (sound-data->vct hi 0)))
- (if (not (= (vct-length v) size))
- (snd-display #__line__ ";big sd, sound-data->vct length: ~A" (vct-length v)))
- (if (fneq (vct-ref v (expt 2 31)) 1.0)
- (snd-display #__line__ ";big sd, sd->v ref: ~A" (vct-ref v (expt 2 31)))))
- )))
-|#
-
- (let ((ind (open-sound (string-append "/usr//usr/include/" home-dir "/cl/oboe.snd"))))
- (show-input-1)
- (close-sound ind))
-
- (let ((fd (mus-sound-open-output "fmv.snd" 22050 1 mus-bshort mus-next "no comment"))
- (sdata (make-sound-data 1 10)))
- (define (sound-data-channel->list sd chan)
- (let ((ls '()))
- (do ((i (- (sound-data-length sd) 1) (- i 1)))
- ((< i 0) ls)
- (set! ls (cons (sound-data-ref sd chan i) ls)))))
- (define (sound-data->list sd)
- (let ((lst '()))
- (do ((i (- (sound-data-chans sd) 1) (- i 1)))
- ((< i 0) lst)
- (set! lst (cons (sound-data-channel->list sd i) lst)))))
- (sound-data-set! sdata 0 1 .1)
- (mus-sound-write fd 0 9 1 sdata)
- (mus-sound-close-output fd 20)
- (set! fd (mus-sound-open-input "fmv.snd"))
- (mus-sound-read fd 0 9 1 sdata)
- (if (or (fneq (sound-data-ref sdata 0 0) 0.0)
- (fneq (sound-data-ref sdata 0 1) 0.1)
- (fneq (sound-data-ref sdata 0 2) 0.0)
- (fneq (sound-data-ref sdata 0 6) 0.0))
- (snd-display #__line__ ";read/write: ~A?" (sound-data->list sdata)))
- (mus-sound-close-input fd)
- (set! fd (mus-sound-reopen-output "fmv.snd" 1 mus-bshort mus-next (mus-sound-data-location "fmv.snd")))
- (mus-sound-seek-frame fd 0)
- (sound-data-set! sdata 0 2 .1)
- (sound-data-set! sdata 0 3 .1)
- (mus-sound-write fd 0 9 1 sdata)
- (mus-sound-close-output fd 20)
- (set! fd (mus-sound-open-input "fmv.snd"))
- (let ((sdata1 (make-sound-data 1 10)))
- (mus-sound-read fd 0 9 1 sdata1)
- (if (or (fneq (sound-data-ref sdata1 0 0) 0.0)
- (fneq (sound-data-ref sdata1 0 1) 0.1)
- (fneq (sound-data-ref sdata1 0 2) 0.1)
- (fneq (sound-data-ref sdata1 0 3) 0.1)
- (fneq (sound-data-ref sdata1 0 6) 0.0))
- (snd-display #__line__ ";re-read/write: ~A ~A?" (sound-data->list sdata1) (sound-data->lisp sdata))))
- (mus-sound-close-input fd)
-
- ;; check clipping choices
- (let ((ind (view-sound "oboe.snd")))
- (set! (clipping) #f)
- (map-channel (lambda (y) (* y 10.0)) 0 (frames) ind 0)
- (save-sound-as "test.snd" ind mus-next mus-bfloat)
- (undo 1 ind 0)
- (let ((ind1 (open-sound "test.snd")))
- (if (fneq (maxamp ind1 0) (* 10 (maxamp ind 0)))
- (snd-display #__line__ ";clipping 0: ~A ~A" (maxamp ind1 0) (maxamp ind 0)))
- (close-sound ind1))
- (delete-file "test.snd")
- (set! (clipping) #t)
- (map-channel (lambda (y) (* y 10.0)) 0 (frames) ind 0)
- (save-sound-as "test.snd" ind mus-next mus-bfloat)
- (undo 1 ind 0)
- (let ((ind1 (open-sound "test.snd")))
- (if (fneq (maxamp ind1 0) 1.0)
- (snd-display #__line__ ";clipping 1: ~A ~A" (maxamp ind1 0) (maxamp ind 0)))
- (close-sound ind1))
- (delete-file "test.snd")
- (set! (clipping) #f)
- (let ((mx (maxamp ind)))
- (map-channel (lambda (y) (+ y (- 1.001 mx))) 0 (frames) ind 0)
- (save-sound-as "test.snd" ind mus-next mus-bshort)
- (let* ((ind1 (open-sound "test.snd"))
- (baddy (scan-channel (lambda (y) (< y 0.0)))))
- (if (not baddy)
- (snd-display #__line__ ";clipping 2: ~A" baddy))
- (close-sound ind1))
- (delete-file "test.snd")
- (set! (clipping) #t)
- (save-sound-as "test.snd" ind mus-next mus-bshort)
- (let* ((ind1 (open-sound "test.snd"))
- (baddy (scan-channel (lambda (y) (< y 0.0)))))
- (if baddy
- (snd-display #__line__ ";clipping 3: ~A" baddy))
- (close-sound ind1))
- (delete-file "test.snd")
- (set! (clipping) #f))
- (close-sound ind))
- (delete-file "fmv.snd")
-
- (set! (clipping) #f)
- (let ((snd (new-sound "test.snd" :data-format mus-lshort)))
- (pad-channel 0 10)
- (set! (sample 1) 1.0)
- (set! (sample 2) -1.0)
- (set! (sample 3) 0.9999)
- (set! (sample 4) 2.0)
- (set! (sample 5) -2.0)
- (set! (sample 6) 1.3)
- (set! (sample 7) -1.3)
- (set! (sample 8) 1.8)
- (set! (sample 9) -1.8)
- (save-sound snd)
- (close-sound snd))
- (let ((snd (open-sound "test.snd")))
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000)))
- (snd-display #__line__ ";unclipped 1: ~A" data)))
- (close-sound snd))
- (mus-sound-forget "test.snd")
-
- (set! (clipping) #t)
- (let ((snd (new-sound "test.snd" :data-format mus-lshort)))
- (pad-channel 0 10)
- (set! (sample 1) 1.0)
- (set! (sample 2) -1.0)
- (set! (sample 3) 0.9999)
- (set! (sample 4) 2.0)
- (set! (sample 5) -2.0)
- (set! (sample 6) 1.3)
- (set! (sample 7) -1.3)
- (set! (sample 8) 1.8)
- (set! (sample 9) -1.8)
- (save-sound snd)
- (close-sound snd))
- (let ((snd (open-sound "test.snd")))
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
- (snd-display #__line__ ";clipped: ~A" data)))
- (close-sound snd))
-
- (let* ((data (vct 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8))
- (sdata (vct->sound-data data))
- (snd (mus-sound-open-output "test.snd" 22050 1 mus-lshort mus-riff "a comment")))
- (set! (mus-file-clipping snd) #f)
- (mus-sound-write snd 0 9 1 sdata)
- (mus-sound-close-output snd 40))
-
- (let ((snd (open-sound "test.snd")))
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 -1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000)))
- (snd-display #__line__ ";unclipped 2: ~A" data)))
- (close-sound snd))
- (mus-sound-forget "test.snd")
-
- (let* ((data (vct 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8))
- (sdata (vct->sound-data data))
- (snd (mus-sound-open-output "test.snd" 22050 1 mus-lshort mus-riff "a comment")))
- (set! (mus-file-clipping snd) #t)
- (mus-sound-write snd 0 9 1 sdata)
- (set! (mus-file-clipping snd) #f)
- (mus-sound-close-output snd 40))
-
- (let ((snd (open-sound "test.snd")))
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
- (snd-display #__line__ ";clipped 1: ~A" data)))
- (close-sound snd))
-
- (set! (mus-clipping) #f)
- (let* ((data (vct 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8))
- (sdata (vct->sound-data data))
- (snd (mus-sound-open-output "test.snd" 22050 1 mus-lshort mus-riff "a comment")))
- (mus-sound-write snd 0 9 1 sdata)
- (mus-sound-close-output snd 40))
-
- (let ((snd (open-sound "test.snd")))
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 -1.000 -1.000 1.000 -1.000 -1.000 -1.000 -1.000 -1.000 -1.000)))
- (snd-display #__line__ ";unclipped 3: ~A" data)))
- (close-sound snd))
- (mus-sound-forget "test.snd")
-
- (set! (mus-clipping) #t)
- (let* ((data (vct 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8))
- (sdata (vct->sound-data data))
- (snd (mus-sound-open-output "test.snd" 22050 1 mus-lshort mus-riff "a comment")))
- (mus-sound-write snd 0 9 1 sdata)
- (mus-sound-close-output snd 40))
-
- (let ((snd (open-sound "test.snd")))
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
- (snd-display #__line__ ";clipped 2: ~A" data)))
- (close-sound snd))
-
- (set! (mus-clipping) #t)
- (let* ((data (vct 0.0 1.0 -1.0 0.9999 2.0 -2.0 1.3 -1.3 1.8 -1.8))
- (sdata (vct->sound-data data))
- (snd (mus-sound-open-output "test.snd" 22050 1 mus-lshort mus-riff "a comment")))
- (let ((tag (catch #t
- (lambda () (mus-sound-write snd 0 10 1 sdata))
- (lambda args args))))
- (if (or (not (list? tag)) (not (eq? (car tag) 'out-of-range))) (snd-display #__line__ ";mus-sound-write too many bytes: ~A" tag)))
- (let ((tag (catch #t
- (lambda () (mus-sound-read snd 0 10 1 sdata))
- (lambda args args))))
- (if (or (not (list? tag)) (not (eq? (car tag) 'out-of-range))) (snd-display #__line__ ";mus-sound-read too many bytes: ~A" tag)))
- (mus-sound-close-output snd 0))
+ (string-append sf-dir "bad_length.nist")))
+ (close-sound ind))
+
+ (for-each close-sound (sounds))
+
+ (if (selected-sound)
+ (snd-display #__line__ ";selected-sound ~A ~A" (selected-sound) (sounds)))
+
+ (if (file-exists? (string-append (or sf-dir "") "a.sf2"))
+ (let ((fil (open-sound (string-append (or sf-dir "") "a.sf2"))))
+ (if fil
+ (let ((loops (and fil (soundfont-info))))
+ (if (or (null? loops)
+ (not (= (caddar loops) 65390))
+ (not (= (cadadr loops) 65490)))
+ (snd-display #__line__ ";soundfont-info: ~A?" loops))
+ (close-sound fil)))))
+
+ (if (file-exists? "fmv5.snd") (delete-file "fmv5.snd"))
+ (set! *print-length* 12)
+
+ (for-each
+ (lambda (file)
+ (let ((tag (catch #t
+ (lambda () (open-sound (string-append sf-dir file)))
+ (lambda args args))))
+ (if (not (eq? (car tag) 'mus-error))
+ (snd-display #__line__ ";open-sound ~A: ~A" file tag))))
+ (list "trunc.snd" "trunc.aiff" "trunc.wav" "trunc.sf" "trunc.voc" "trunc.nist" "bad.wav"
+ "trunc1.aiff" "badform.aiff"))
+
+ (hook-push open-raw-sound-hook (lambda (hook) (set! (hook 'result) (list 1 22050 mus-bshort))))
+ (let ((ind (open-sound (string-append sf-dir "empty.snd"))))
+ (if (or (not (= (sample-type ind) mus-bshort))
+ (not (= (chans ind) 1))
+ (not (= (srate ind) 22050))
+ (not (= (data-location ind) 0))
+ (not (= (framples ind) 0)))
+ (snd-display #__line__ ";open raw: ~A ~A ~A ~A ~A" (sample-type ind) (chans ind) (srate ind) (data-location ind) (framples ind)))
+ (set! (hook-functions open-raw-sound-hook) ())
+ (close-sound ind))
+
+ (let ((sd (make-float-vector (list 1 1) 0.0)))
+ (if (fneq (sd 0 0) 0.0) (snd-display #__line__ ";vector2 ref: ~A" (sd 0 0)))
+ (set! (sd 0 0) 1.0)
+ (if (fneq (sd 0 0) 1.0) (snd-display #__line__ ";vector2 set: ~A" (sd 0 0)))
+ (if (not (equal? sd (let ((sd1 (make-float-vector (list 1 1) 0.0))) (vector-set! sd1 0 0 1.0) sd1)))
+ (snd-display #__line__ ";vector2 set not equal: ~A" sd)))
+
+ (let ((sd (make-float-vector (list 2 3) 0.0)))
+ (if (fneq (sd 0 0) 0.0) (snd-display #__line__ ";vector2 ref (1): ~A" (sd 0 0)))
+ (set! (sd 1 0) 1.0)
+ (if (fneq (sd 1 0) 1.0) (snd-display #__line__ ";vector2 set (1 0): ~A" (sd 1 0)))
+ (set! (sd 1 2) 2.0)
+ (if (fneq (sd 1 2) 2.0) (snd-display #__line__ ";vector2 set (1 2): ~A" (sd 1 2)))
+ (if (not (equal? sd (let ((sd1 (make-float-vector (list 2 3) 0.0)))
+ (vector-set! sd1 1 0 1.0)
+ (vector-set! sd1 1 2 2.0)
+ sd1)))
+ (snd-display #__line__ ";vector2 set (3) not equal: ~A" sd)))
+
+ ;; check clipping choices
+ (let ((ind (view-sound "oboe.snd")))
+ (set! *clipping* #f)
+ (scale-channel 10.0)
+ (save-sound-as "test.snd" ind :header-type mus-next :sample-type mus-ldouble)
+ (undo 1 ind 0)
+ (let ((ind1 (open-sound "test.snd")))
+ (if (fneq (maxamp ind1 0) (* 10 (maxamp ind 0)))
+ (snd-display #__line__ ";clipping 0: ~A ~A" (maxamp ind1 0) (maxamp ind 0)))
+ (close-sound ind1))
+ (delete-file "test.snd")
+ (set! *clipping* #t)
+ (map-channel (lambda (y) (* y 10.0)) 0 #f ind 0)
+ (save-sound-as "test.snd" ind :header-type mus-next :sample-type mus-lshort)
+ (undo 1 ind 0)
+ (let ((ind1 (open-sound "test.snd")))
+ (if (fneq (maxamp ind1 0) 1.0)
+ (snd-display #__line__ ";clipping 1: ~A ~A" (maxamp ind1 0) (maxamp ind 0)))
+ (close-sound ind1))
+ (delete-file "test.snd")
+ (set! *clipping* #f)
+ (let* ((mx (maxamp ind))
+ (sub (- 1.001 mx)))
+ (map-channel (lambda (y) (+ y sub)) 0 #f ind 0)
+ (save-sound-as "test.snd" ind :header-type mus-next :sample-type mus-lfloat)
+ (let ((ind1 (open-sound "test.snd"))
+ (baddy (scan-channel (lambda (y) (< y 0.0)))))
+ (if baddy
+ (snd-display #__line__ ";clipping 2: ~A" baddy))
+ (close-sound ind1))
(delete-file "test.snd")
- (mus-sound-forget "test.snd")
-
- (set! (mus-clipping) #f) ; this is the default
- (set! (clipping) #f)
-
- (let ((com "this is a comment which we'll repeat enough times to trigger an internal loop"))
- (do ((i 0 (+ 1 i)))
- ((= i 3))
- (set! com (string-append com com)))
- (set! fd (mus-sound-open-output "fmv.snd" 22050 4 mus-lshort mus-riff com)))
- (set! sdata (make-sound-data 4 10))
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (sound-data-set! sdata i 1 .1))
- (mus-sound-write fd 0 9 4 sdata)
- (mus-sound-close-output fd 80)
- (set! fd (mus-sound-open-input "fmv.snd"))
- (mus-sound-read fd 0 9 4 sdata)
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (if (or (fneq (sound-data-ref sdata i 0) 0.0)
- (fneq (sound-data-ref sdata i 1) 0.1)
- (fneq (sound-data-ref sdata i 2) 0.0)
- (fneq (sound-data-ref sdata i 6) 0.0))
- (snd-display #__line__ ";1 read/write[~A]: ~A?" i (sound-data-channel->list sdata i))))
- (mus-sound-close-input fd)
- (set! fd (mus-sound-reopen-output "fmv.snd" 4 mus-lshort mus-riff (mus-sound-data-location "fmv.snd")))
- (mus-sound-seek-frame fd 0)
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (sound-data-set! sdata i 2 .1)
- (sound-data-set! sdata i 3 .1))
- (mus-sound-write fd 0 9 4 sdata)
- (mus-sound-close-output fd 80)
- (set! fd (mus-sound-open-input "fmv.snd"))
- (let ((sdata1 (make-sound-data 4 10)))
- (mus-sound-read fd 0 9 4 sdata1)
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (if (or (fneq (sound-data-ref sdata1 i 0) 0.0)
- (fneq (sound-data-ref sdata1 i 1) 0.1)
- (fneq (sound-data-ref sdata1 i 2) 0.1)
- (fneq (sound-data-ref sdata1 i 3) 0.1)
- (fneq (sound-data-ref sdata1 i 6) 0.0))
- (snd-display #__line__ ";2 re-read/write[~A]: ~A ~A?" i (sound-data-channel->list sdata1 i) (sound-data-channel->list sdata i)))))
- (mus-sound-close-input fd))
-
- (if (file-exists? (string-append sf-dir "32bit.sf"))
- (let ((ind (open-sound (string-append sf-dir "32bit.sf"))))
- (if (fneq (maxamp ind 0) .228) (snd-display #__line__ ";32bit max: ~A" (maxamp ind 0)))
- (close-sound ind)))
-
- (let ((test-data (lambda (file beg dur data)
- (catch #t
- (lambda ()
- (let* ((ind (open-sound file))
- (ndata (channel->vct beg dur ind 0)))
- (if (not (vequal data ndata))
- (snd-display #__line__ ";~A: ~A != ~A" file data ndata))
- (close-sound ind)))
- (lambda args args)))))
- (test-data (string-append sf-dir "next-dbl.snd") 10 10 (vct 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
- (test-data (string-append sf-dir "oboe.ldbl") 1000 10 (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004))
-
- (test-data (string-append sf-dir "next-flt.snd") 10 10 (vct 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
- (test-data (string-append sf-dir "clbonef.wav") 1000 10 (vct 0.111 0.101 0.070 0.032 -0.014 -0.060 -0.085 -0.108 -0.129 -0.152))
-
- (test-data (string-append sf-dir "next-8.snd") 10 10 (vct 0.898 0.945 0.977 0.992 0.992 0.977 0.945 0.906 0.844 0.773))
- (test-data (string-append sf-dir "o2_u8.wave") 1000 10 (vct -0.164 -0.219 -0.258 -0.242 -0.180 -0.102 -0.047 0.000 0.039 0.055))
-
- (test-data (string-append sf-dir "next-16.snd") 1000 10 (vct -0.026 -0.022 -0.024 -0.030 -0.041 -0.048 -0.050 -0.055 -0.048 -0.033))
- (test-data (string-append sf-dir "o2.wave") 1000 10 (vct -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
-
- (test-data (string-append sf-dir "o2_18bit.aiff") 1000 10 (vct -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "o2_12bit.aiff") 1000 10 (vct -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
-
- (test-data (string-append sf-dir "next24.snd") 1000 10 (vct -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "mono24.wav") 1000 10 (vct 0.005 0.010 0.016 0.008 -0.007 -0.018 -0.025 -0.021 -0.005 0.001))
-
- (test-data (string-append sf-dir "o2_711u.wave") 1000 10 (vct -0.164 -0.219 -0.254 -0.242 -0.172 -0.103 -0.042 0.005 0.042 0.060))
- (test-data (string-append sf-dir "alaw.wav") 1000 10 (vct -0.024 -0.048 -0.024 0.000 0.008 0.008 0.000 -0.040 -0.064 -0.024))
-
- ;; it is not a bug if these don't match if MUS_SAMPLE_BITS is not 24
- (test-data (string-append sf-dir "b32.pvf") 1000 10 (vct -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "b32.wave") 1000 10 (vct -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "b32.snd") 1000 10 (vct -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "32bit.sf") 1000 10 (vct 0.016 0.014 0.013 0.011 0.010 0.010 0.010 0.010 0.012 0.014))
-
- (test-data (string-append sf-dir "nist-shortpack.wav") 10000 10 (vct 0.021 0.018 0.014 0.009 0.004 -0.001 -0.004 -0.006 -0.007 -0.008))
- (test-data (string-append sf-dir "wood.sds") 1000 10 (vct -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
- (test-data (string-append sf-dir "oboe.g721") 1000 10 (vct -0.037 -0.040 -0.040 -0.041 -0.042 -0.038 -0.028 -0.015 -0.005 0.002))
- (test-data (string-append sf-dir "oboe.g723_40") 1000 10 (vct -0.037 -0.040 -0.041 -0.041 -0.041 -0.038 -0.028 -0.015 -0.005 0.003))
- (test-data (string-append sf-dir "mus10.snd") 10000 10 (vct 0.004 0.001 0.005 0.009 0.017 0.015 0.008 0.011 0.009 0.012))
- (test-data (string-append sf-dir "ieee-text-16.snd") 1000 10 (vct -0.052 -0.056 -0.069 -0.077 -0.065 -0.049 -0.054 -0.062 -0.066 -0.074))
- (test-data (string-append sf-dir "hcom-16.snd") 10000 10 (vct 0.000 0.000 0.000 0.008 0.000 -0.016 -0.016 -0.016 -0.008 0.000))
- (test-data (string-append sf-dir "ce-c3.w02") 1000 10 (vct 0.581 0.598 0.596 0.577 0.552 0.530 0.508 0.479 0.449 0.425))
- (test-data (string-append sf-dir "nasahal.avi") 20000 10 (vct 0.390 0.120 -0.399 -0.131 0.464 0.189 -0.458 -0.150 0.593 0.439))
- (test-data (string-append sf-dir "oki.wav") 100 10 (vct 0.396 0.564 0.677 0.779 0.761 0.540 0.209 -0.100 -0.301 -0.265))
-
- (test-data (string-append sf-dir "trumps22.adp") 5000 10 (vct 0.267 0.278 0.309 0.360 0.383 0.414 0.464 0.475 0.486 0.495))
- )
-
- (let ((errs (list "no error" "no frequency method" "no phase method" "null gen arg to method" "no length method"
- "no free method" "no describe method" "no data method" "no scaler method"
- "memory allocation failed" "unstable two pole error"
- "can't open file" "no sample input" "no sample output"
- "no such channel" "no file name provided" "no location method" "no channel method"
- "no such fft window" "unsupported data format" "header read failed"
- "unsupported header type" "file descriptors not initialized" "not a sound file" "file closed" "write error"
- "header write failed" "can't open temp file" "interrupted" "bad envelope"
- "audio channels not available" "audio srate not available" "audio format not available"
- "no audio input available" "audio configuration not available"
- "audio write error" "audio size not available" "audio device not available"
- "can't close audio" "can't open audio" "audio read error"
- "can't write audio" "can't read audio" "no audio read permission"
- "can't close file" "arg out of range" "wrong type arg"
- "no channels method" "no hop method" "no width method" "no file-name method" "no ramp method" "no run method"
- "no increment method" "no offset method"
- "no xcoeff method" "no ycoeff method" "no xcoeffs method" "no ycoeffs method" "no reset" "bad size" "can't convert"
- "read error" "no safety method"
- "can't translate"
- )))
- (let ((happy #t)
- (len (length errs)))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i len)))
- (if (not (string-=? (list-ref errs i) (mus-error-type->string i)))
- (begin
- (snd-display #__line__ ";mus-error-type->string ~D: ~A ~A" i (list-ref errs i) (mus-error-type->string i))
- (set! happy #f))))))
-
+ (set! *clipping* #t)
+ (save-sound-as "test.snd" ind :header-type mus-next :sample-type mus-ldouble)
+ (let ((ind1 (open-sound "test.snd"))
+ (baddy (scan-channel (lambda (y) (< y 0.0)))))
+ (if baddy
+ (snd-display #__line__ ";clipping 3: ~A ~A" baddy (sample baddy)))
+ (close-sound ind1))
+ (delete-file "test.snd")
+ (set! *clipping* #f))
+ (close-sound ind))
+ (delete-file "fmv.snd")
+
+ (set! *clipping* #f)
+ (let ((snd (new-sound "test.snd" :sample-type mus-lshort)))
+ (pad-channel 0 10)
+ (set! (sample 1) 1.0)
+ (set! (sample 2) -1.0)
+ (set! (sample 3) 0.9999)
+ (set! (sample 4) 2.0)
+ (set! (sample 5) -2.0)
+ (set! (sample 6) 1.3)
+ (set! (sample 7) -1.3)
+ (set! (sample 8) 1.8)
+ (set! (sample 9) -1.8)
+ (save-sound snd)
+ (close-sound snd))
+ (let ((snd (open-sound "test.snd")))
+ (let ((data (channel->float-vector 0 10)))
+ (if (not (vequal data (float-vector 0.000 1.000 -1.000 1.000 0.000 0.000 -0.700 0.700 -0.200 0.200)))
+ (snd-display #__line__ ";unclipped 1: ~A" data)))
+ (close-sound snd))
+ (mus-sound-forget "test.snd")
+
+ (set! *clipping* #t)
+ (let ((snd (new-sound "test.snd" :sample-type mus-lshort)))
+ (pad-channel 0 10)
+ (set! (sample 1) 1.0)
+ (set! (sample 2) -1.0)
+ (set! (sample 3) 0.9999)
+ (set! (sample 4) 2.0)
+ (set! (sample 5) -2.0)
+ (set! (sample 6) 1.3)
+ (set! (sample 7) -1.3)
+ (set! (sample 8) 1.8)
+ (set! (sample 9) -1.8)
+ (save-sound snd)
+ (close-sound snd))
+ (let ((snd (open-sound "test.snd")))
+ (let ((data (channel->float-vector 0 10)))
+ (if (not (vequal data (float-vector 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
+ (snd-display #__line__ ";clipped: ~A" data)))
+ (close-sound snd))
+ (set! *clipping* #f)
+
+ (let ((test-data (lambda (file beg dur data)
+ (catch #t
+ (lambda ()
+ (let* ((ind (open-sound file))
+ (ndata (channel->float-vector beg dur ind 0)))
+ (if (not (vequal data ndata))
+ (snd-display #__line__ ";~A: ~A != ~A" file data ndata))
+ (close-sound ind)))
+ (lambda args args)))))
+ (test-data (string-append sf-dir "next-dbl.snd") 10 10 (float-vector 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
+ (test-data (string-append sf-dir "oboe.ldbl") 1000 10 (float-vector 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004))
+
+ (test-data (string-append sf-dir "next-flt.snd") 10 10 (float-vector 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344))
+ (test-data (string-append sf-dir "clbonef.wav") 1000 10 (float-vector 0.111 0.101 0.070 0.032 -0.014 -0.060 -0.085 -0.108 -0.129 -0.152))
+
+ (test-data (string-append sf-dir "next-8.snd") 10 10 (float-vector 0.898 0.945 0.977 0.992 0.992 0.977 0.945 0.906 0.844 0.773))
+ (test-data (string-append sf-dir "o2_u8.wave") 1000 10 (float-vector -0.164 -0.219 -0.258 -0.242 -0.180 -0.102 -0.047 0.000 0.039 0.055))
+
+ (test-data (string-append sf-dir "next-16.snd") 1000 10 (float-vector -0.026 -0.022 -0.024 -0.030 -0.041 -0.048 -0.050 -0.055 -0.048 -0.033))
+ (test-data (string-append sf-dir "o2.wave") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+
+ (test-data (string-append sf-dir "o2_18bit.aiff") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "o2_12bit.aiff") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+
+ (test-data (string-append sf-dir "next24.snd") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "mono24.wav") 1000 10 (float-vector 0.005 0.010 0.016 0.008 -0.007 -0.018 -0.025 -0.021 -0.005 0.001))
+
+ (test-data (string-append sf-dir "o2_711u.wave") 1000 10 (float-vector -0.164 -0.219 -0.254 -0.242 -0.172 -0.103 -0.042 0.005 0.042 0.060))
+ (test-data (string-append sf-dir "alaw.wav") 1000 10 (float-vector -0.024 -0.048 -0.024 0.000 0.008 0.008 0.000 -0.040 -0.064 -0.024))
+
+ ;; it is not a bug if these don't match if MUS_SAMPLE_BITS is not 24
+ (test-data (string-append sf-dir "b32.pvf") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "b32.wave") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "b32.snd") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ (test-data (string-append sf-dir "32bit.sf") 1000 10 (float-vector 0.016 0.014 0.013 0.011 0.010 0.010 0.010 0.010 0.012 0.014))
+
+ (test-data (string-append sf-dir "nist-shortpack.wav") 10000 10 (float-vector 0.021 0.018 0.014 0.009 0.004 -0.001 -0.004 -0.006 -0.007 -0.008))
+ (test-data (string-append sf-dir "wood.sds") 1000 10 (float-vector -0.160 -0.216 -0.254 -0.239 -0.175 -0.102 -0.042 0.005 0.041 0.059))
+ ; (test-data (string-append sf-dir "oboe.g721") 1000 10 (float-vector -0.037 -0.040 -0.040 -0.041 -0.042 -0.038 -0.028 -0.015 -0.005 0.002))
+ ; (test-data (string-append sf-dir "oboe.g723_40") 1000 10 (float-vector -0.037 -0.040 -0.041 -0.041 -0.041 -0.038 -0.028 -0.015 -0.005 0.003))
+ (test-data (string-append sf-dir "mus10.snd") 10000 10 (float-vector 0.004 0.001 0.005 0.009 0.017 0.015 0.008 0.011 0.009 0.012))
+ (test-data (string-append sf-dir "ieee-text-16.snd") 1000 10 (float-vector -0.052 -0.056 -0.069 -0.077 -0.065 -0.049 -0.054 -0.062 -0.066 -0.074))
+ (test-data (string-append sf-dir "hcom-16.snd") 10000 10 (float-vector 0.000 0.000 0.000 0.008 0.000 -0.016 -0.016 -0.016 -0.008 0.000))
+ (test-data (string-append sf-dir "ce-c3.w02") 1000 10 (float-vector 0.581 0.598 0.596 0.577 0.552 0.530 0.508 0.479 0.449 0.425))
+ (test-data (string-append sf-dir "nasahal.avi") 20000 10 (float-vector 0.390 0.120 -0.399 -0.131 0.464 0.189 -0.458 -0.150 0.593 0.439))
+ (test-data (string-append sf-dir "oki.wav") 100 10 (float-vector 0.396 0.564 0.677 0.779 0.761 0.540 0.209 -0.100 -0.301 -0.265))
+
+ (test-data (string-append sf-dir "trumps22.adp") 5000 10 (float-vector 0.267 0.278 0.309 0.360 0.383 0.414 0.464 0.475 0.486 0.495))
+ )
+
+ (let ((errs (list "no error" "no frequency method" "no phase method" "null gen arg to method" "no length method"
+ "no describe method" "no data method" "no scaler method"
+ "memory allocation failed"
+ "can't open file" "no sample input" "no sample output"
+ "no such channel" "no file name provided" "no location method" "no channel method"
+ "no such fft window" "unknown sample type" "header read failed"
+ "unknown header type" "file descriptors not initialized" "not a sound file" "file closed" "write error"
+ "header write failed" "can't open temp file" "interrupted" "bad envelope"
+ "audio channels not available" "audio srate not available" "audio sample type not available"
+ "no audio input available" "audio configuration not available"
+ "audio write error" "audio size not available" "audio device not available"
+ "can't close audio" "can't open audio" "audio read error"
+ "can't write audio" "can't read audio" "no audio read permission"
+ "can't close file" "arg out of range"
+ "no channels method" "no hop method" "no width method" "no file-name method" "no ramp method" "no run method"
+ "no increment method" "no offset method"
+ "no xcoeff method" "no ycoeff method" "no xcoeffs method" "no ycoeffs method" "no reset" "bad size" "can't convert"
+ "read error"
+ "no feedforward method" "no feedback method" "no interp-type method" "no position method" "no order method" "no copy method"
+ "can't translate"
+ )))
+ (let ((happy #t)
+ (len (length errs)))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy) (= i len)))
+ (if (not (string=? (errs i) (mus-error-type->string i)))
+ (begin
+ (snd-display #__line__ ";mus-error-type->string ~D: ~A ~A" i (errs i) (mus-error-type->string i))
+ (set! happy #f))))))
+
; (let ((new-id (mus-make-error "hiho all messed up")))
; (if (not (string=? (mus-error-type->string new-id) "hiho all messed up"))
; (snd-display #__line__ ";mus-make-error :~A ~A" new-id (mus-error-type->string new-id))))
+
+ (let ((cur-srate (mus-sound-srate "oboe.snd"))
+ (cur-chans (mus-sound-chans "oboe.snd"))
+ (cur-format (mus-sound-sample-type "oboe.snd"))
+ (cur-type (mus-sound-header-type "oboe.snd"))
+ (cur-loc (mus-sound-data-location "oboe.snd"))
+ (cur-samps (mus-sound-samples "oboe.snd")))
+ (set! (mus-sound-srate "oboe.snd") (* cur-srate 2))
+ (if (not (= (* cur-srate 2) (mus-sound-srate "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-srate: ~A -> ~A" cur-srate (mus-sound-srate "oboe.snd")))
+ (set! (mus-sound-samples "oboe.snd") (* cur-samps 2))
+ (if (not (= (* cur-samps 2) (mus-sound-samples "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-samples: ~A -> ~A" cur-samps (mus-sound-samples "oboe.snd")))
+ (set! (mus-sound-chans "oboe.snd") (* cur-chans 2))
+ (if (not (= (* cur-chans 2) (mus-sound-chans "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-chans: ~A -> ~A" cur-chans (mus-sound-chans "oboe.snd")))
+ (set! (mus-sound-data-location "oboe.snd") (* cur-loc 2))
+ (if (not (= (* cur-loc 2) (mus-sound-data-location "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-data-location: ~A -> ~A" cur-loc (mus-sound-data-location "oboe.snd")))
+ (set! (mus-sound-header-type "oboe.snd") mus-nist)
+ (if (not (= mus-nist (mus-sound-header-type "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-header-type: ~A -> ~A" cur-type (mus-sound-header-type "oboe.snd")))
+ (set! (mus-sound-sample-type "oboe.snd") mus-lintn)
+ (if (not (= mus-lintn (mus-sound-sample-type "oboe.snd")))
+ (snd-display #__line__ ";set mus-sound-sample-type: ~A -> ~A" cur-format (mus-sound-sample-type "oboe.snd")))
+ (set! (mus-sound-srate "oboe.snd") cur-srate)
+ (set! (mus-sound-samples "oboe.snd") cur-samps)
+ (set! (mus-sound-chans "oboe.snd") cur-chans)
+ (set! (mus-sound-data-location "oboe.snd") cur-loc)
+ (set! (mus-sound-header-type "oboe.snd") cur-type)
+ (set! (mus-sound-sample-type "oboe.snd") cur-format))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (save-sound-as "test.wave" ind :header-type mus-riff)
+ (save-sound-as "test.rf64" ind :header-type mus-rf64)
+ (save-sound-as "test.aifc" ind :header-type mus-aifc)
+ (close-sound ind)
- (let ((cur-srate (mus-sound-srate "oboe.snd"))
- (cur-chans (mus-sound-chans "oboe.snd"))
- (cur-format (mus-sound-data-format "oboe.snd"))
- (cur-type (mus-sound-header-type "oboe.snd"))
- (cur-loc (mus-sound-data-location "oboe.snd"))
- (cur-samps (mus-sound-samples "oboe.snd")))
- (set! (mus-sound-srate "oboe.snd") (* cur-srate 2))
- (if (not (= (* cur-srate 2) (mus-sound-srate "oboe.snd")))
- (snd-display #__line__ ";set mus-sound-srate: ~A -> ~A" cur-srate (mus-sound-srate "oboe.snd")))
- (set! (mus-sound-samples "oboe.snd") (* cur-samps 2))
- (if (not (= (* cur-samps 2) (mus-sound-samples "oboe.snd")))
- (snd-display #__line__ ";set mus-sound-samples: ~A -> ~A" cur-samps (mus-sound-samples "oboe.snd")))
- (set! (mus-sound-chans "oboe.snd") (* cur-chans 2))
- (if (not (= (* cur-chans 2) (mus-sound-chans "oboe.snd")))
- (snd-display #__line__ ";set mus-sound-chans: ~A -> ~A" cur-chans (mus-sound-chans "oboe.snd")))
- (set! (mus-sound-data-location "oboe.snd") (* cur-loc 2))
- (if (not (= (* cur-loc 2) (mus-sound-data-location "oboe.snd")))
- (snd-display #__line__ ";set mus-sound-data-location: ~A -> ~A" cur-loc (mus-sound-data-location "oboe.snd")))
- (set! (mus-sound-header-type "oboe.snd") mus-nist)
- (if (not (= mus-nist (mus-sound-header-type "oboe.snd")))
- (snd-display #__line__ ";set mus-sound-header-type: ~A -> ~A" cur-type (mus-sound-header-type "oboe.snd")))
- (set! (mus-sound-data-format "oboe.snd") mus-lintn)
- (if (not (= mus-lintn (mus-sound-data-format "oboe.snd")))
- (snd-display #__line__ ";set mus-sound-data-format: ~A -> ~A" cur-format (mus-sound-data-format "oboe.snd")))
- (set! (mus-sound-srate "oboe.snd") cur-srate)
- (set! (mus-sound-samples "oboe.snd") cur-samps)
- (set! (mus-sound-chans "oboe.snd") cur-chans)
- (set! (mus-sound-data-location "oboe.snd") cur-loc)
- (set! (mus-sound-header-type "oboe.snd") cur-type)
- (set! (mus-sound-data-format "oboe.snd") cur-format))
+ (for-each
+ (lambda (file)
+ (let ((cur-srate (mus-sound-srate file))
+ (cur-chans (mus-sound-chans file))
+ (cur-format (mus-sound-sample-type file))
+ (cur-type (mus-sound-header-type file))
+ (cur-loc (mus-sound-data-location file))
+ (cur-samps (mus-sound-samples file)))
+ (set! (mus-sound-srate file) (* cur-srate 2))
+ (if (not (= (* cur-srate 2) (mus-sound-srate file)))
+ (snd-display #__line__ ";~A: set mus-sound-srate: ~A -> ~A" file cur-srate (mus-sound-srate file)))
+ (set! (mus-sound-samples file) (* cur-samps 2))
+ (if (not (= (* cur-samps 2) (mus-sound-samples file)))
+ (snd-display #__line__ ";~A: set mus-sound-samples: ~A -> ~A" file cur-samps (mus-sound-samples file)))
+ (set! (mus-sound-chans file) (* cur-chans 2))
+ (if (not (= (* cur-chans 2) (mus-sound-chans file)))
+ (snd-display #__line__ ";~A: set mus-sound-chans: ~A -> ~A" file cur-chans (mus-sound-chans file)))
+ (set! (mus-sound-data-location file) (* cur-loc 2))
+ (if (not (= (* cur-loc 2) (mus-sound-data-location file)))
+ (snd-display #__line__ ";~A: set mus-sound-data-location: ~A -> ~A" file cur-loc (mus-sound-data-location file)))
+ (set! (mus-sound-header-type file) mus-nist)
+ (if (not (= mus-nist (mus-sound-header-type file)))
+ (snd-display #__line__ ";~A: set mus-sound-header-type: ~A -> ~A" file cur-type (mus-sound-header-type file)))
+ (set! (mus-sound-sample-type file) mus-lintn)
+ (if (not (= mus-lintn (mus-sound-sample-type file)))
+ (snd-display #__line__ ";~A: set mus-sound-sample-type: ~A -> ~A" file cur-format (mus-sound-sample-type file)))
+ (set! (mus-sound-srate file) cur-srate)
+ (set! (mus-sound-samples file) cur-samps)
+ (set! (mus-sound-chans file) cur-chans)
+ (set! (mus-sound-data-location file) cur-loc)
+ (set! (mus-sound-header-type file) cur-type)
+ (set! (mus-sound-sample-type file) cur-format)))
+ (list "test.wave" "test.rf64" "test.aifc"))
- (let ((ind (open-sound "oboe.snd")))
- (save-sound-as "test.wave" ind mus-riff)
- (save-sound-as "test.rf64" ind mus-rf64)
- (save-sound-as "test.aifc" ind mus-aifc)
- (close-sound ind)
+ (for-each
+ (lambda (file)
+ (let ((ind (open-sound file)))
+ (let ((cur-srate (srate ind))
+ (cur-chans (chans ind))
+ (cur-format (sample-type ind))
+ (cur-type (header-type ind))
+ (cur-loc (data-location ind))
+ (cur-samps (framples ind)))
+ (set! (srate ind) (* cur-srate 2))
+ (if (not (= (* cur-srate 2) (srate ind)))
+ (snd-display #__line__ ";~A: set srate: ~A -> ~A" file cur-srate (srate ind)))
+ (set! (framples ind) (* cur-samps 2))
+ (if (not (= (* cur-samps 2) (framples ind)))
+ (snd-display #__line__ ";~A: set framples: ~A -> ~A" file cur-samps (framples ind)))
+ (set! (chans ind) (* cur-chans 2)) ; this can change the index
+ (let ((xind (find-sound file)))
+ (if (not (equal? ind xind))
+ (set! ind xind)))
+ (if (not (= (* cur-chans 2) (chans ind)))
+ (snd-display #__line__ ";~A: set chans: ~A -> ~A" file cur-chans (chans ind)))
+ (set! (data-location ind) (* cur-loc 2))
+ (if (not (= (* cur-loc 2) (data-location ind)))
+ (snd-display #__line__ ";~A: set data-location: ~A -> ~A" file cur-loc (data-location ind)))
+ (set! (header-type ind) mus-nist)
+ (if (not (= mus-nist (header-type ind)))
+ (snd-display #__line__ ";~A: set header-type: ~A -> ~A" file cur-type (header-type ind)))
+ (set! (sample-type ind) mus-lintn)
+ (if (not (= mus-lintn (sample-type ind)))
+ (snd-display #__line__ ";~A: set sample-type: ~A -> ~A" file cur-format (sample-type ind)))
+ (set! (srate ind) cur-srate)
+ (set! (framples ind) cur-samps)
+ (set! (chans ind) cur-chans)
+ (set! (data-location ind) cur-loc)
+ (set! (header-type ind) cur-type)
+ (set! (sample-type ind) cur-format))
+ (close-sound ind))
+ (if (file-exists? file)
+ (delete-file file)))
+ (list "test.wave" "test.rf64" "test.aifc")))
+
+ ;; (with-sound (big-file-name :srate 44100 :play #f)
+ ;; (do ((i 0 (+ i 1))) ((= i 72000))
+ ;; (fm-violin i .1 440 (+ .01 (* (/ i 72000.0) .9)))))
+
+ (if with-big-file
+ (let ((probable-framples (floor (* (floor *clm-srate*) 71999.1)))) ; silence as last .9 secs, so it probably wasn't written
+ (if (not (= (mus-sound-samples big-file-name) 3175160310))
+ (snd-display #__line__ ";bigger samples: ~A" (mus-sound-samples big-file-name)))
+ (if (not (= (mus-sound-framples big-file-name) 3175160310))
+ (snd-display #__line__ ";bigger framples: ~A" (mus-sound-framples big-file-name)))
+ (if (not (= (mus-sound-framples big-file-name) probable-framples))
+ (snd-display #__line__ ";bigger framples: ~A (probable: ~A)" (mus-sound-framples big-file-name) probable-framples))
+ (if (not (= (mus-sound-length big-file-name) 6350320648))
+ (snd-display #__line__ ";bigger bytes: ~A" (mus-sound-length big-file-name)))
+ (if (fneq (mus-sound-duration big-file-name) 71999.1015)
+ (snd-display #__line__ ";bigger dur: ~A" (mus-sound-duration big-file-name)))
+ (let ((ind (open-sound big-file-name)))
+ (if (not (= (framples ind) 3175160310)) (snd-display #__line__ ";bigger framples: ~A" (framples ind)))
+ (set! big-file-framples (framples ind))
+ (if (not (= (framples ind) probable-framples)) (snd-display #__line__ ";bigger framples: ~A (probable: ~A)" (framples ind) probable-framples))
+ (if (not (= (framples ind 0 0) big-file-framples)) (snd-display #__line__ ";bigger edpos-framples: ~A" (framples ind)))
+ (let ((m1 (add-mark (* (floor *clm-srate*) 50000) ind)))
+ (if (not (= (mark-sample m1) (* (floor *clm-srate*) 50000))) (snd-display #__line__ ";bigger mark at: ~A" (mark-sample m1)))
+ (set! (mark-sample m1) (* (floor *clm-srate*) 66000))
+ (if (not (= (mark-sample m1) (* (floor *clm-srate*) 66000))) (snd-display #__line__ ";bigger mark to: ~A" (mark-sample m1))))
+ (let ((mx (mix-sound "oboe.snd" (* (floor *clm-srate*) 60000))))
+ (if (mix? mx)
+ (begin
+ (if (not (= (mix-position mx) (* (floor *clm-srate*) 60000))) (snd-display #__line__ ";bigger mix at: ~A" (mix-position mx)))
+ (set! (mix-position mx) (* (floor *clm-srate*) 61000))
+ (if (not (= (mix-position mx) (* (floor *clm-srate*) 61000))) (snd-display #__line__ ";bigger mix to: ~A" (mix-position mx))))
+ (snd-display #__line__ ";no mix tag from mix-sound"))
+ (undo 2))
+ (let ((res (scan-channel (lambda (y) (> (abs y) 0.0)))))
+ (if (or (not res)
+ (> (cadr res) 100))
+ (snd-display #__line__ ";bigger find not 0.0: ~A" res)))
+ (let ((old-select *selection-creates-region*))
+ (set! *selection-creates-region* #f)
+ (select-all ind)
+ (if (not (= (selection-framples) (framples ind))) (snd-display #__line__ ";bigger select all: ~A ~A" (selection-framples) (framples)))
+ (set! (selection-position) (* (floor *clm-srate*) 50000))
+ (if (not (= (selection-position) (* (floor *clm-srate*) 50000))) (snd-display #__line__ ";bigger select pos: ~A" (selection-position)))
+ (set! (selection-position) 0)
+ (set! (selection-framples) (* (floor *clm-srate*) 65000))
+ (if (not (= (selection-framples) (* (floor *clm-srate*) 65000))) (snd-display #__line__ ";bigger select len: ~A" (selection-framples)))
+ (set! *selection-creates-region* old-select))
+ (set! (cursor ind) (* (floor *clm-srate*) 50000))
+ (if (not (= (cursor ind) (* (floor *clm-srate*) 50000))) (snd-display #__line__ ";bigger cursor: ~A" (cursor ind)))
+ (let ((m1 (add-mark (* 44123 51234) ind)))
+ (if (not (= (mark-sample m1) (* 44123 51234))) (snd-display #__line__ ";bigger mark at: ~A" (mark-sample m1)))
+ (let ((mid (find-mark (* 44123 51234))))
+ (if (or (not (number? mid)) (not (= mid m1))) (snd-display #__line__ ";bigger mark seach: ~A ~A" mid m1))))
+ (let ((mx (mix-sound "oboe.snd" (* 44123 61234))))
+ (let ((mxd (find-mix (* 44123 61234))))
+ (if (or (not (number? mxd)) (not (= mxd mx))) (snd-display #__line__ ";bigger find-mix ~A ~A" mxd mx))))
+ (set! (cursor ind) (* 44123 51234))
+ (if (not (= (cursor ind) (* 44123 51234))) (snd-display #__line__ ";bigger cursor 123: ~A" (cursor ind)))
+ (close-sound ind))))
+
+ (let ((ind (new-sound "tmp.snd" 1 22050 mus-l24int mus-riff :size 100000))
+ (old-selection-creates-region *selection-creates-region*))
+ (set! *selection-creates-region* #t)
+ (let ((incr (/ 1.0 (framples)))
+ (data (make-float-vector (framples))))
+ (outa->fv data (- (* i incr) 0.5))
+ (float-vector->channel data))
+ (save-sound)
+ (close-sound ind)
+ (set! ind (open-sound "tmp.snd"))
+ (let ((reg (select-all))
+ (v1 (make-float-vector 100000)))
+ (save-selection "tmp1.snd" 22050 mus-l24int mus-next)
+ (let ((ind1 (open-sound "tmp1.snd")))
+ (let ((incr (/ 1.0 (framples))))
+ (outa->fv v1 (- (* i incr) 0.5))
+ (let ((v0 (samples 0 100000 ind1 0)))
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ ";l24 (next) selection not saved correctly? ~A" v0))))
+ (close-sound ind1))
- (for-each
- (lambda (file)
- (let ((cur-srate (mus-sound-srate file))
- (cur-chans (mus-sound-chans file))
- (cur-format (mus-sound-data-format file))
- (cur-type (mus-sound-header-type file))
- (cur-loc (mus-sound-data-location file))
- (cur-samps (mus-sound-samples file)))
- (set! (mus-sound-srate file) (* cur-srate 2))
- (if (not (= (* cur-srate 2) (mus-sound-srate file)))
- (snd-display #__line__ ";~A: set mus-sound-srate: ~A -> ~A" file cur-srate (mus-sound-srate file)))
- (set! (mus-sound-samples file) (* cur-samps 2))
- (if (not (= (* cur-samps 2) (mus-sound-samples file)))
- (snd-display #__line__ ";~A: set mus-sound-samples: ~A -> ~A" file cur-samps (mus-sound-samples file)))
- (set! (mus-sound-chans file) (* cur-chans 2))
- (if (not (= (* cur-chans 2) (mus-sound-chans file)))
- (snd-display #__line__ ";~A: set mus-sound-chans: ~A -> ~A" file cur-chans (mus-sound-chans file)))
- (set! (mus-sound-data-location file) (* cur-loc 2))
- (if (not (= (* cur-loc 2) (mus-sound-data-location file)))
- (snd-display #__line__ ";~A: set mus-sound-data-location: ~A -> ~A" file cur-loc (mus-sound-data-location file)))
- (set! (mus-sound-header-type file) mus-nist)
- (if (not (= mus-nist (mus-sound-header-type file)))
- (snd-display #__line__ ";~A: set mus-sound-header-type: ~A -> ~A" file cur-type (mus-sound-header-type file)))
- (set! (mus-sound-data-format file) mus-lintn)
- (if (not (= mus-lintn (mus-sound-data-format file)))
- (snd-display #__line__ ";~A: set mus-sound-data-format: ~A -> ~A" file cur-format (mus-sound-data-format file)))
- (set! (mus-sound-srate file) cur-srate)
- (set! (mus-sound-samples file) cur-samps)
- (set! (mus-sound-chans file) cur-chans)
- (set! (mus-sound-data-location file) cur-loc)
- (set! (mus-sound-header-type file) cur-type)
- (set! (mus-sound-data-format file) cur-format)))
- (list "test.wave" "test.rf64" "test.aifc"))
+ (save-selection "tmp1.snd" 22050 mus-l24int mus-aifc)
+ (let ((ind1 (open-sound "tmp1.snd")))
+ (let ((v0 (samples 0 100000 ind1 0)))
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ ";l24 (aifc) selection not saved correctly? ~A" v0)))
+ (close-sound ind1))
- (for-each
- (lambda (file)
- (let ((ind (open-sound file)))
- (let ((cur-srate (srate ind))
- (cur-chans (chans ind))
- (cur-format (data-format ind))
- (cur-type (header-type ind))
- (cur-loc (data-location ind))
- (cur-samps (frames ind)))
- (set! (srate ind) (* cur-srate 2))
- (if (not (= (* cur-srate 2) (srate ind)))
- (snd-display #__line__ ";~A: set srate: ~A -> ~A" file cur-srate (srate ind)))
- (set! (frames ind) (* cur-samps 2))
- (if (not (= (* cur-samps 2) (frames ind)))
- (snd-display #__line__ ";~A: set frames: ~A -> ~A" file cur-samps (frames ind)))
- (set! (chans ind) (* cur-chans 2)) ; this can change the index
- (let ((xind (find-sound file)))
- (if (not (equal? ind xind))
- (set! ind xind)))
- (if (not (= (* cur-chans 2) (chans ind)))
- (snd-display #__line__ ";~A: set chans: ~A -> ~A" file cur-chans (chans ind)))
- (set! (data-location ind) (* cur-loc 2))
- (if (not (= (* cur-loc 2) (data-location ind)))
- (snd-display #__line__ ";~A: set data-location: ~A -> ~A" file cur-loc (data-location ind)))
- (set! (header-type ind) mus-nist)
- (if (not (= mus-nist (header-type ind)))
- (snd-display #__line__ ";~A: set header-type: ~A -> ~A" file cur-type (header-type ind)))
- (set! (data-format ind) mus-lintn)
- (if (not (= mus-lintn (data-format ind)))
- (snd-display #__line__ ";~A: set data-format: ~A -> ~A" file cur-format (data-format ind)))
- (set! (srate ind) cur-srate)
- (set! (frames ind) cur-samps)
- (set! (chans ind) cur-chans)
- (set! (data-location ind) cur-loc)
- (set! (header-type ind) cur-type)
- (set! (data-format ind) cur-format))
- (close-sound ind))
- (if (file-exists? file)
- (delete-file file)))
- (list "test.wave" "test.rf64" "test.aifc")))
-
- ;; (with-sound (:output big-file-name :srate 44100 :play #f)
- ;; (do ((i 0 (+ 1 i))) ((= i 72000))
- ;; (fm-violin i .1 440 (+ .01 (* (/ i 72000.0) .9)))))
-
- (if with-big-file
- (let ((probable-frames (floor (* 44100 71999.1)))) ; silence as last .9 secs, so it probably wasn't written
- (if (not (= (mus-sound-samples big-file-name) 3175160310))
- (snd-display #__line__ ";bigger samples: ~A" (mus-sound-samples big-file-name)))
- (if (not (= (mus-sound-frames big-file-name) 3175160310))
- (snd-display #__line__ ";bigger frames: ~A" (mus-sound-frames big-file-name)))
- (if (not (= (mus-sound-frames big-file-name) probable-frames))
- (snd-display #__line__ ";bigger frames: ~A (probable: ~A)" (mus-sound-frames big-file-name) probable-frames))
- (if (not (= (mus-sound-length big-file-name) 6350320648))
- (snd-display #__line__ ";bigger bytes: ~A" (mus-sound-length big-file-name)))
- (if (fneq (mus-sound-duration big-file-name) 71999.1015)
- (snd-display #__line__ ";bigger dur: ~A" (mus-sound-duration big-file-name)))
- (let ((ind (open-sound big-file-name)))
- (if (not (= (frames ind) 3175160310)) (snd-display #__line__ ";bigger frames: ~A" (frames ind)))
- (set! big-file-frames (frames ind))
- (if (not (= (frames ind) probable-frames)) (snd-display #__line__ ";bigger frames: ~A (probable: ~A)" (frames ind) probable-frames))
- (if (not (= (frames ind 0 0) big-file-frames)) (snd-display #__line__ ";bigger edpos-frames: ~A" (frames ind)))
- (let ((m1 (add-mark (* 44100 50000) ind)))
- (if (not (= (mark-sample m1) (* 44100 50000))) (snd-display #__line__ ";bigger mark at: ~A" (mark-sample m1)))
- (set! (mark-sample m1) (* 44100 66000))
- (if (not (= (mark-sample m1) (* 44100 66000))) (snd-display #__line__ ";bigger mark to: ~A" (mark-sample m1))))
- (let ((mx (mix-sound "oboe.snd" (* 44100 60000))))
- (if (mix? mx)
- (begin
- (if (not (= (mix-position mx) (* 44100 60000))) (snd-display #__line__ ";bigger mix at: ~A" (mix-position mx)))
- (set! (mix-position mx) (* 44100 61000))
- (if (not (= (mix-position mx) (* 44100 61000))) (snd-display #__line__ ";bigger mix to: ~A" (mix-position mx))))
- (snd-display #__line__ ";no mix tag from mix-sound"))
- (undo 2))
- (let ((res (find-channel (lambda (y) (not (= y 0.0))))))
- (if (or (not res)
- (> (cadr res) 100))
- (snd-display #__line__ ";bigger find not 0.0: ~A" res)))
- (let ((old-select (selection-creates-region)))
- (set! (selection-creates-region) #f)
- (select-all ind)
- (if (not (= (selection-frames) (frames ind))) (snd-display #__line__ ";bigger select all: ~A ~A" (selection-frames) (frames)))
- (set! (selection-position) (* 44100 50000))
- (if (not (= (selection-position) (* 44100 50000))) (snd-display #__line__ ";bigger select pos: ~A" (selection-position)))
- (set! (selection-position) 0)
- (set! (selection-frames) (* 44100 65000))
- (if (not (= (selection-frames) (* 44100 65000))) (snd-display #__line__ ";bigger select len: ~A" (selection-frames)))
- (set! (selection-creates-region) old-select))
- (set! (cursor ind) (* 44100 50000))
- (if (not (= (cursor ind) (* 44100 50000))) (snd-display #__line__ ";bigger cursor: ~A" (cursor ind)))
- (let ((m1 (add-mark (* 44123 51234) ind)))
- (if (not (= (mark-sample m1) (* 44123 51234))) (snd-display #__line__ ";bigger mark at: ~A" (mark-sample m1)))
- (let ((mid (find-mark (* 44123 51234))))
- (if (or (not (number? mid)) (not (= mid m1))) (snd-display #__line__ ";bigger mark seach: ~A ~A" mid m1))))
- (let ((mx (mix-sound "oboe.snd" (* 44123 61234))))
- (let ((mxd (find-mix (* 44123 61234))))
- (if (or (not (number? mxd)) (not (= mxd mx))) (snd-display #__line__ ";bigger find-mix ~A ~A" mxd mx))))
- (set! (cursor ind) (* 44123 51234))
- (if (not (= (cursor ind) (* 44123 51234))) (snd-display #__line__ ";bigger cursor 123: ~A" (cursor ind)))
- (close-sound ind))))
-
- (let ((ind (new-sound "tmp.snd" mus-riff mus-l24int 22050 1 :size 100000))
- (old-selection-creates-region (selection-creates-region)))
- (set! (selection-creates-region) #t)
- (let ((x -0.5)
- (incr (/ 1.0 (frames))))
- (map-channel (lambda (n)
- (let ((val x))
- (set! x (+ x incr))
- val))))
- (save-sound)
+ (save-region reg "tmp1.snd" mus-l24int mus-next)
+ (let ((ind1 (open-sound "tmp1.snd")))
+ (let ((v0 (samples 0 100000 ind1 0)))
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ ";l24 (next) region not saved correctly? ~A" v0)))
+ (close-sound ind1))
+ (delete-file "tmp1.snd")
(close-sound ind)
- (set! ind (open-sound "tmp.snd"))
- (let ((reg (select-all)))
- (save-selection "tmp1.snd" mus-next mus-l24int)
- (let ((ind1 (open-sound "tmp1.snd")))
- (let* ((x -0.5)
- (incr (/ 1.0 (frames)))
- (err (scan-channel
- (lambda (n)
- (let ((val x))
- (set! x (+ x incr))
- (fneq val n)))
- 0 100000 ind1)))
- (if err (snd-display #__line__ ";l24 (next) selection not saved correctly? ~A" err)))
- (close-sound ind1))
- (save-selection "tmp1.snd" mus-aifc mus-l24int)
- (let ((ind1 (open-sound "tmp1.snd")))
- (let* ((x -0.5)
- (incr (/ 1.0 (frames)))
- (err (scan-channel
- (lambda (n)
- (let ((val x))
- (set! x (+ x incr))
- (fneq val n)))
- 0 100000 ind1)))
- (if err (snd-display #__line__ ";l24 (aifc) selection not saved correctly? ~A" err)))
- (close-sound ind1))
- (save-region reg "tmp1.snd" mus-next mus-l24int)
- (let ((ind1 (open-sound "tmp1.snd")))
- (let* ((x -0.5)
- (incr (/ 1.0 (frames)))
- (err (scan-channel
- (lambda (n)
- (let ((val x))
- (set! x (+ x incr))
- (fneq val n)))
- 0 100000 ind1)))
- (if err (snd-display #__line__ ";l24 (next) region not saved correctly? ~A" err)))
- (close-sound ind1))
- (delete-file "tmp1.snd")
- (close-sound ind)
- (delete-file "tmp.snd"))
- (set! (selection-creates-region) old-selection-creates-region))
-
- (let ((ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1 :size 10 :comment #f)))
- (map-channel (lambda (y) 1.0))
- (env-channel '(0 0 .1 .1 .2 .2 .3 .3 .4 .4 .5 .5 .6 .6 .7 .7 .8 .8 .9 .9))
- (if (not (vequal (channel->vct) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";ramp env by .1: ~A" (channel->vct)))
- (close-sound ind))
- ))
-
- (set! (hook-functions open-raw-sound-hook) '())
- (hook-push open-raw-sound-hook (lambda (a b) #t))
- (set! (hook-functions bad-header-hook) '())
- (hook-push bad-header-hook (lambda (n) #t))
- (if (null? (hook-functions open-raw-sound-hook)) (snd-display #__line__ ";add-hook open-raw-sound-hook failed??"))
- (if (null? (hook-functions bad-header-hook)) (snd-display #__line__ ";add-hook bad-header-hook failed??"))
+ (delete-file "tmp.snd"))
+ (set! *selection-creates-region* old-selection-creates-region))
+
+ (let ((ind (new-sound "tmp.snd" 1 22050 mus-ldouble mus-next :size 10 :comment #f)))
+ (map-channel (lambda (y) 1.0))
+ (env-channel '(0 0 .1 .1 .2 .2 .3 .3 .4 .4 .5 .5 .6 .6 .7 .7 .8 .8 .9 .9))
+ (if (not (vequal (channel->float-vector) (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
+ (snd-display #__line__ ";ramp env by .1: ~A" (channel->float-vector)))
+ (close-sound ind))
+ )
+
+ (set! (hook-functions open-raw-sound-hook) ())
+ (hook-push open-raw-sound-hook (lambda (hook) (set! (hook 'result) #t)))
+ (set! (hook-functions bad-header-hook) ())
+ (hook-push bad-header-hook (lambda (hook) (set! (hook 'result) #t)))
+ (if (null? (hook-functions open-raw-sound-hook)) (snd-display #__line__ ";add hook open-raw-sound-hook failed??"))
+ (if (null? (hook-functions bad-header-hook)) (snd-display #__line__ ";add hook bad-header-hook failed??"))
(let* ((magic-words (list ".snd" "FORM" "AIFF" "AIFC" "COMM" "COMT" "INFO" "INST" "inst" "MARK" "SSND"
"FVER" "NONE" "ULAW" "ulaw" "ima4" "raw " "sowt" "in32" "in24" "ni23" "fl32"
"FL32" "fl64" "twos" "ALAW" "alaw" "APPL" "CLM " "RIFF" "RIFX" "WAVE" "fmt "
@@ -4185,7 +3744,7 @@
"SND " "SNIN" "SNDT" "DDSF" "FSMu" "UWFD" "LM89" "SY80" "SY85" "SCRS" "DSPL"
"AVI " "strf" "movi" "PRAM" " paf" "fap " "DS16" "HEDR" "HDR8" "SDA_" "SDAB"
"SD_B" "NOTE" "file" "=sam" "SU7M" "SU7R" "PVF1" "PVF2" "AUTH" "riff" "TWIN"
- "IMPS" "SMP1" "Maui" "SDIF" "NVF "))
+ "IMPS" "SMP1" "Maui" "SDIF"))
(len (length magic-words))
(ctr 0))
(for-each
@@ -4199,7 +3758,7 @@
(with-output-to-file "test.snd"
(lambda ()
(display magic)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 128))
(write (random 1.0)))))
(let ((tag (catch #t
@@ -4217,7 +3776,7 @@
(with-output-to-file "test.snd"
(lambda ()
(display magic)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 128))
(write (random 128)))))
(let ((tag (catch #t
@@ -4235,11 +3794,11 @@
(with-output-to-file "test.snd"
(lambda ()
(display magic)
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((= i 12))
(if (< (+ ctr i) len)
- (display (list-ref magic-words (+ ctr i)))
- (display (list-ref magic-words i))))))
+ (display (magic-words (+ ctr i)))
+ (display (magic-words i))))))
(let ((tag (catch #t
(lambda ()
(open-sound "test.snd"))
@@ -4249,11 +3808,12 @@
(begin
(snd-display #__line__ ";open-sound very plausible garbage ~A: ~A?" magic tag)
(if (sound? tag) (close-sound tag)))))
- (set! ctr (+ 1 ctr)))
+ (set! ctr (+ ctr 1)))
magic-words))
(if (file-exists? "test.snd") (delete-file "test.snd"))
(mus-sound-forget "test.snd")
+
(with-output-to-file "test.snd"
(lambda ()
(display ".snd")
@@ -4265,8 +3825,8 @@
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; comment
(write-byte #o000) (write-byte #o001) ; samp 1
))
- (if (not (= (mus-sound-data-format "test.snd") mus-bshort))
- (snd-display #__line__ ";next 18: ~A" (mus-sound-data-format "test.snd")))
+ (if (not (= (mus-sound-sample-type "test.snd") mus-bshort))
+ (snd-display #__line__ ";next 18: ~A" (mus-sound-sample-type "test.snd")))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
(with-output-to-file "test.snd"
@@ -4291,32 +3851,9 @@
(close-sound tag))))
(delete-file "test.snd")
(mus-sound-forget "test.snd")
- (with-output-to-file "test.snd"
- (lambda ()
- (display ".snd")
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o034) ; location
- (write-byte #o000) (write-byte #o001) (write-byte #o215) (write-byte #o030) ; nominal size
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o122) ; format
- (write-byte #o000) (write-byte #o000) (write-byte #o126) (write-byte #o042) ; srate
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o001) ; chans
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; comment
- (write-byte #o000) (write-byte #o001) ; samp 1
- ))
-
- (let ((tag (catch #t
- (lambda ()
- (open-sound "test.snd"))
- (lambda args (car args)))))
- (if (and (number? tag)
- (sound? tag))
- (begin
- (snd-display #__line__ ";open-sound next bad format ~A: ~A?" (data-format tag) tag)
- (close-sound tag))))
- (delete-file "test.snd")
- (mus-sound-forget "test.snd")
-
+
(letrec ((make-aifc-file
- (lambda (frames auth-lo bits)
+ (lambda (len auth-lo bits)
(with-output-to-file "test.aif"
(lambda ()
(display "FORM")
@@ -4327,7 +3864,7 @@
(display "COMM")
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o046) ; COMM chunk size
(write-byte #o000) (write-byte #o001) ; 1 chan
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte frames) ; frames
+ (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte len) ; framples
(write-byte #o000) (write-byte bits) ; bits
(write-byte #o100) (write-byte #o016) (write-byte #o254) (write-byte #o104) (write-byte #o000)
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ;
@@ -4350,12 +3887,13 @@
(mus-sound-forget "test.aif")
;;correct (make-aifc-file #o002 #o004 #o020)
(make-aifc-file #o102 #o004 #o020)
+
(catch #t
(lambda ()
(let ((ind (open-sound "test.aif")))
- (if (not (= (frames ind) 2)) (snd-display #__line__ ";bad frames in header: ~A" (frames ind)))
+ (if (not (= (framples ind) 2)) (snd-display #__line__ ";bad framples in header: ~A" (framples ind)))
(close-sound ind)))
- (lambda args (snd-display #__line__ args)))
+ (lambda args (snd-display #__line__ ";~S" args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(make-aifc-file #o002 #o150 #o020)
@@ -4371,6 +3909,7 @@
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(make-aifc-file #o002 #o000 #o020)
+
(let ((tag (catch #t
(lambda ()
(open-sound "test.aif"))
@@ -4390,10 +3929,11 @@
(if (and (number? tag)
(sound? tag))
(begin
- (snd-display #__line__ ";open-sound bits 80 ~A: ~A?" (data-format tag) tag)
+ (snd-display #__line__ ";open-sound bits 80 ~A: ~A?" (sample-type tag) tag)
(close-sound tag))))
(delete-file "test.aif")
(mus-sound-forget "test.aif"))
+
(with-output-to-file "test.aif"
(lambda ()
(display "FORM")
@@ -4404,7 +3944,7 @@
(display "COMM")
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o046) ; COMM chunk size
(write-byte #o000) (write-byte #o001) ; 1 chan
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o002) ; frames
+ (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o002) ; framples
(write-byte #o000) (write-byte #o020) ; bits
(write-byte #o100) (write-byte #o016) (write-byte #o254) (write-byte #o104) (write-byte #o000)
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; srate as 80-bit float (sheesh)
@@ -4432,9 +3972,9 @@
))
(catch #t
(lambda ()
- (if (not (= (string-length (mus-sound-comment "test.aif")) 15))
+ (if (not (= (length (mus-sound-comment "test.aif")) 15))
(snd-display #__line__ ";aifc 3 aux comments: ~A?" (mus-sound-comment "test.aif"))))
- (lambda args (snd-display #__line__ args)))
+ (lambda args (snd-display #__line__ ";~S" args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(with-output-to-file "test.aif"
@@ -4450,7 +3990,7 @@
(display "COMM")
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o046) ; COMM chunk size
(write-byte #o000) (write-byte #o001) ; 1 chan
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o002) ; frames
+ (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o002) ; framples
(write-byte #o000) (write-byte #o020) ; bits
(write-byte #o100) (write-byte #o016) (write-byte #o254) (write-byte #o104) (write-byte #o000)
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; srate as 80-bit float (sheesh)
@@ -4465,13 +4005,14 @@
(display "bil")
(write-byte #o000)
))
+
(catch #t
(lambda ()
(if (not (string=? (substring (mus-sound-comment "test.aif") 0 3) "bil"))
(snd-display #__line__ ";aifc trailing comt comment: ~A?" (mus-sound-comment "test.aif"))))
- (lambda args (snd-display #__line__ args)))
- (if (not (= (mus-sound-frames "test.aif") 2))
- (snd-display #__line__ ";aifc trailing comt frames: ~A?" (mus-sound-frames "test.aif")))
+ (lambda args (snd-display #__line__ ";~S" args)))
+ (if (not (= (mus-sound-framples "test.aif") 2))
+ (snd-display #__line__ ";aifc trailing comt framples: ~A?" (mus-sound-framples "test.aif")))
(catch #t
(lambda ()
(let ((ind (open-sound "test.aif")))
@@ -4481,7 +4022,7 @@
(fneq (sample 3) 0.0))
(snd-display #__line__ ";aifc trailing comt samps: ~A ~A ~A ~A" (sample 0) (sample 1) (sample 2) (sample 3)))
(close-sound ind)))
- (lambda args (snd-display #__line__ args)))
+ (lambda args (snd-display #__line__ ";~S" args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(with-output-to-file "test.aif"
@@ -4497,7 +4038,7 @@
(display "COMM")
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o046) ; COMM chunk size
(write-byte #o000) (write-byte #o001) ; 1 chan
- (write-byte #o000) (write-byte #o000) (write-byte #o100) (write-byte #o102) ; frames
+ (write-byte #o000) (write-byte #o000) (write-byte #o100) (write-byte #o102) ; framples
(write-byte #o000) (write-byte #o020) ; bits
(write-byte #o100) (write-byte #o016) (write-byte #o254) (write-byte #o104) (write-byte #o000)
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; srate as 80-bit float (sheesh)
@@ -4515,8 +4056,8 @@
(if (or (not (string? (mus-sound-comment "test.aif")))
(not (string=? (substring (mus-sound-comment "test.aif") 0 3) "bil")))
(snd-display #__line__ ";aifc trailing comt comment: ~A?" (mus-sound-comment "test.aif")))
- (if (not (= (mus-sound-frames "test.aif") 2))
- (snd-display #__line__ ";aifc trailing comt (bogus) frames: ~A?" (mus-sound-frames "test.aif")))
+ (if (not (= (mus-sound-framples "test.aif") 2))
+ (snd-display #__line__ ";aifc trailing comt (bogus) framples: ~A?" (mus-sound-framples "test.aif")))
(catch #t
(lambda ()
(let ((ind (open-sound "test.aif")))
@@ -4526,7 +4067,7 @@
(fneq (sample 3) 0.0))
(snd-display #__line__ ";aifc trailing comt samps (bogus frame setting): ~A ~A ~A ~A" (sample 0) (sample 1) (sample 2) (sample 3)))
(close-sound ind)))
- (lambda args (snd-display #__line__ args)))
+ (lambda args (snd-display #__line__ ";~S" args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
(with-output-to-file "test.aif"
@@ -4542,7 +4083,7 @@
(display "COMM")
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o046) ; COMM chunk size
(write-byte #o000) (write-byte #o001) ; 1 chan
- (write-byte #o000) (write-byte #o000) (write-byte #o100) (write-byte #o102) ; frames
+ (write-byte #o000) (write-byte #o000) (write-byte #o100) (write-byte #o102) ; framples
(write-byte #o000) (write-byte #o020) ; bits
(write-byte #o100) (write-byte #o016) (write-byte #o254) (write-byte #o104) (write-byte #o000)
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; srate as 80-bit float (sheesh)
@@ -4556,6 +4097,7 @@
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; block size?
(write-byte #o000) (write-byte #o101) (write-byte #o000) (write-byte #o100) ; two samples
))
+
(let ((tag (catch #t
(lambda ()
(open-sound "test.aif"))
@@ -4603,7 +4145,7 @@
(display "COMM")
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o046) ; COMM chunk size
(write-byte #o000) (write-byte #o001) ; 1 chan
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o002) ; frames
+ (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o002) ; framples
(write-byte #o000) (write-byte #o020) ; bits
(write-byte #o100) (write-byte #o016) (write-byte #o254) (write-byte #o104) (write-byte #o000)
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; srate as 80-bit float (sheesh)
@@ -4637,20 +4179,20 @@
(if (fneq (gen 2) 0.0) (snd-display #__line__ ";file->sample chunked eof: ~A" (gen 2)))
(if (fneq (gen 3) 0.0) (snd-display #__line__ ";file->sample chunked eof+1: ~A" (gen 3))))
(let ((file (open-sound "test.aif")))
- (if (not (= (frames file) 2)) (snd-display #__line__ ";chunked frames: ~A" (frames file)))
+ (if (not (= (framples file) 2)) (snd-display #__line__ ";chunked framples: ~A" (framples file)))
(if (fneq (sample 0) 0.93948) (snd-display #__line__ ";file chunked 0: ~A" (sample 0)))
(if (fneq (sample 1) 0.50195) (snd-display #__line__ ";file chunked 1: ~A" (sample 1)))
(if (fneq (sample 2) 0.0) (snd-display #__line__ ";file chunked eof: ~A" (sample 2)))
(if (fneq (sample 3) 0.0) (snd-display #__line__ ";file chunked eof+1: ~A" (sample 3)))
(close-sound file)))
- (lambda args (snd-display #__line__ args)))
+ (lambda args (snd-display #__line__ ";~S" args)))
(catch #t
(lambda ()
- (if (not (= (mus-sound-frames "test.aif") 2)) (snd-display #__line__ ";chunked mus-sound-frames: ~A" (mus-sound-frames "test.aif"))))
- (lambda args (snd-display #__line__ args)))
+ (if (not (= (mus-sound-framples "test.aif") 2)) (snd-display #__line__ ";chunked mus-sound-framples: ~A" (mus-sound-framples "test.aif"))))
+ (lambda args (snd-display #__line__ ";~S" args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
-
+
(with-output-to-file "test.aif"
(lambda ()
;write AIFC with trailing chunks to try to confuse file->sample
@@ -4667,7 +4209,7 @@
(display "COMM")
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o046) ; COMM chunk size
(write-byte #o000) (write-byte #o001) ; 1 chan
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o002) ; frames
+ (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o002) ; framples
(write-byte #o000) (write-byte #o020) ; bits
(write-byte #o100) (write-byte #o016) (write-byte #o254) (write-byte #o104) (write-byte #o000)
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; srate as 80-bit float (sheesh)
@@ -4688,7 +4230,7 @@
(if (fneq (gen 2) 0.0) (snd-display #__line__ ";file->sample chunked eof: ~A" (gen 2)))
(if (fneq (gen 3) 0.0) (snd-display #__line__ ";file->sample chunked eof+1: ~A" (gen 3))))
(let ((file (open-sound "test.aif")))
- (if (not (= (frames file) 2)) (snd-display #__line__ ";chunked frames: ~A" (frames file)))
+ (if (not (= (framples file) 2)) (snd-display #__line__ ";chunked framples: ~A" (framples file)))
(if (fneq (sample 0) 0.93948) (snd-display #__line__ ";file chunked 0: ~A" (sample 0)))
(if (fneq (sample 1) 0.50195) (snd-display #__line__ ";file chunked 1: ~A" (sample 1)))
(if (fneq (sample 2) 0.0) (snd-display #__line__ ";file chunked eof: ~A" (sample 2)))
@@ -4697,7 +4239,7 @@
(not (string=? (comment) ";Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98")))
(snd-display #__line__ ";chunked appl comment: ~A" (comment)))
(close-sound file)))
- (lambda args (snd-display #__line__ args)))
+ (lambda args (snd-display #__line__ ";~S" args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
@@ -4717,7 +4259,7 @@
(display "COMM")
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o046) ; COMM chunk size
(write-byte #o000) (write-byte #o002) ; 2 chans
- (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o001) ; frames
+ (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o001) ; framples
(write-byte #o000) (write-byte #o020) ; bits
(write-byte #o100) (write-byte #o016) (write-byte #o254) (write-byte #o104) (write-byte #o000)
(write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) (write-byte #o000) ; srate as 80-bit float (sheesh)
@@ -4738,7 +4280,7 @@
(if (fneq (gen 1 0) 0.0) (snd-display #__line__ ";file->sample chunked eof(stereo): ~A" (gen 1 0)))
(if (fneq (gen 1 1) 0.0) (snd-display #__line__ ";file->sample chunked eof+1 (stereo): ~A" (gen 1 1))))
(let ((file (open-sound "test.aif")))
- (if (not (= (frames file) 1)) (snd-display #__line__ ";chunked frames (1): ~A" (frames file)))
+ (if (not (= (framples file) 1)) (snd-display #__line__ ";chunked framples (1): ~A" (framples file)))
(if (fneq (sample 0 file 0) 0.93948) (snd-display #__line__ ";file chunked 0 0: ~A" (sample 0 file 0)))
(if (fneq (sample 0 file 1) 0.50195) (snd-display #__line__ ";file chunked 0 1: ~A" (sample 0 file 1)))
(if (fneq (sample 1 file 0) 0.0) (snd-display #__line__ ";file chunked eof (stereo): ~A" (sample 1 file 0)))
@@ -4747,31 +4289,42 @@
(not (string=? (comment) ";Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98")))
(snd-display #__line__ ";chunked appl comment (stereo): ~A" (comment)))
(close-sound file)))
- (lambda args (snd-display #__line__ args)))
+ (lambda args (snd-display #__line__ ";~S" args)))
(delete-file "test.aif")
(mus-sound-forget "test.aif")
-
+
(let ((files (sound-files-in-directory cwd)))
+ (define (difference a b)
+ (let ((diffs ()))
+ (for-each
+ (lambda (f)
+ (if (not (member f b)) (set! diffs (cons f diffs))))
+ a)
+ (for-each
+ (lambda (f)
+ (if (not (member f a)) (set! diffs (cons f diffs))))
+ b)
+ diffs))
(if (null? files) (snd-display #__line__ ";no sound files in ~A?" cwd))
(let ((files1 (sound-files-in-directory)))
- (if (not (equal? files files1)) (snd-display #__line__ ";different sound files in ~A and default?" cwd))
+ (if (not (equal? files files1)) (snd-display #__line__ ";different sound files in ~A and default?~% ~A~% ~A~%" cwd files files1))
(let ((files2 (sound-files-in-directory ".")))
(if (or (not (equal? files1 files2))
(not (equal? files files2)))
- (snd-display #__line__ ";sound-files-in-directory dot: ~A but ~A" files2 files)))))
+ (snd-display #__line__ ";sound-files-in-directory dot: ~A~% ~A~% but ~A" (difference files2 files) files2 files)))))
- (set! (hook-functions bad-header-hook) '())
- (set! (hook-functions open-raw-sound-hook) '())
- (if (not (null? (sounds))) (for-each close-sound (sounds)))
+ (set! (hook-functions bad-header-hook) ())
+ (set! (hook-functions open-raw-sound-hook) ())
+ (if (pair? (sounds)) (for-each close-sound (sounds)))
(let ((ind (new-sound :size 0)))
- (if (not (= (frames ind) 0)) (snd-display #__line__ ";new-sound :size 0 -> ~A frames" (frames ind)))
+ (if (not (= (framples ind) 0)) (snd-display #__line__ ";new-sound :size 0 -> ~A framples" (framples ind)))
(if (fneq (sample 0) 0.0) (snd-display #__line__ ";new-sound :size 0 sample 0: ~A" (sample 0)))
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
(let ((ind (new-sound :size 1)))
- (if (not (= (frames ind) 1)) (snd-display #__line__ ";new-sound :size 1 -> ~A frames" (frames ind)))
+ (if (not (= (framples ind) 1)) (snd-display #__line__ ";new-sound :size 1 -> ~A framples" (framples ind)))
(if (fneq (sample 0) 0.0) (snd-display #__line__ ";new-sound :size 1 sample 0: ~A" (sample 0)))
(let ((new-file-name (file-name ind)))
(close-sound ind)
@@ -4782,19 +4335,19 @@
(if (not (eq? tag 'out-of-range))
(begin
(snd-display #__line__ ";new-sound :size -1: ~A" tag)
- (if (not (null? (sounds))) (for-each close-sound (sounds))))))
+ (if (pair? (sounds)) (for-each close-sound (sounds))))))
(let ((ind (read-ascii (string-append sf-dir "caruso.asc"))))
(if (not (sound? ind))
(snd-display #__line__ ";read-ascii can't find ~A (~A)" (string-append sf-dir "caruso.asc") (map file-name (sounds)))
(begin
(if (fneq (maxamp ind 0) 0.723) (snd-display #__line__ ";read-ascii maxamp: ~A" (maxamp ind 0)))
- (if (not (= (frames ind 0) 50000)) (snd-display #__line__ ";read-ascii frames: ~A" (frames ind 0)))
+ (if (not (= (framples ind 0) 50000)) (snd-display #__line__ ";read-ascii framples: ~A" (framples ind 0)))
(if (not (= (srate ind) 44100)) (snd-display #__line__ ";read-ascii srate: ~A" (srate ind)))
(set! (srate ind) 8000)
- (if (or (not (= (frames ind 0) 50000))
+ (if (or (not (= (framples ind 0) 50000))
(fneq (maxamp ind 0) .723))
- (snd-display #__line__ ";set srate clobbered new sound: ~A ~A (~A)" (frames ind 0) (maxamp ind 0) (srate ind)))
+ (snd-display #__line__ ";set srate clobbered new sound: ~A ~A (~A)" (framples ind 0) (maxamp ind 0) (srate ind)))
(close-sound ind))))
@@ -4804,9 +4357,9 @@
(set! ind (open-sound "test space.snd"))
(if (not (string=? (short-file-name ind) "test space.snd"))
(snd-display #__line__ ";file name with space: ~A" (short-file-name ind)))
- (let ((len (frames ind))
- (slen (mus-sound-frames "test space.snd")))
- (if (not (= len slen)) (snd-display #__line__ ";spaced filename frames: ~A ~A" len slen)))
+ (let ((len (framples ind))
+ (slen (mus-sound-framples "test space.snd")))
+ (if (not (= len slen)) (snd-display #__line__ ";spaced filename framples: ~A ~A" len slen)))
(add-mark 1234 ind 0)
(save-marks ind) ; should write "test space.marks"
(close-sound ind)
@@ -4823,177 +4376,26 @@
(if (file-exists? "test space.marks")
(delete-file "test space.marks")))
- (if (provided? 'snd-threads)
- (let ((old-file-buffer-size *clm-file-buffer-size*))
-
- (let* ((result (with-threaded-sound ()
- (outa 0 0.5)
- (outa 1 0.25)
- (outa 2 0.125)
- (outa 3 -0.5)))
- (snd (find-sound result)))
- (if (not (sound? snd))
- (snd-display #__line__ ";with-threaded-sound 0 no output: ~A ~A" result snd)
- (let ((samps (channel->vct 0 (frames snd) snd 0)))
- (if (not (vequal samps (vct 0.5 0.25 0.125 -0.5)))
- (snd-display #__line__ ";with-threaded-sound 0 output: ~A" samps)))))
-
- (let* ((result (with-threaded-sound ()
- (outa 0 0.5)
- (outa 1 0.25)
- (outa 2 0.125)
- (outa 3 -0.5)
- (outa 4 -0.25)
- (outa 5 -0.125)))
- (snd (find-sound result)))
- (if (not (sound? snd))
- (snd-display #__line__ ";with-threaded-sound 0a no output: ~A ~A" result snd)
- (let ((samps (channel->vct 0 (frames snd) snd 0)))
- (if (not (vequal samps (vct 0.5 0.25 0.125 -0.5 -0.25 -0.125)))
- (snd-display #__line__ ";with-threaded-sound 0a output: ~A" samps)))))
-
- (let* ((result (with-threaded-sound ()
- (outa 0 0.5)
- (outa 1 0.25)
- (outa 1 -0.5)))
- (snd (find-sound result)))
- (if (not (sound? snd))
- (snd-display #__line__ ";with-threaded-sound 0b no output: ~A ~A" result snd)
- (let ((samps (channel->vct 0 (frames snd) snd 0)))
- (if (not (vequal samps (vct 0.5 -0.25)))
- (snd-display #__line__ ";with-threaded-sound 0b output: ~A" samps)))))
-
- (let ((samps (make-vct 512)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 512))
- (vct-set! samps i (- (random 2.0) 1.0))))
- (let* ((result (with-threaded-sound (:channels 2)
- (out-samps 0 0 samps)
- (out-samps 0 1 samps)))
- (snd (find-sound result)))
- (if (not (sound? snd))
- (snd-display #__line__ ";with-threaded-sound 1 no output: ~A ~A" result snd)
- (let ((new-samps-0 (channel->vct 0 (frames snd) snd 0))
- (new-samps-1 (channel->vct 0 (frames snd) snd 1)))
- (if (not (vequal samps new-samps-0))
- (snd-display #__line__ ";with-threaded-sound 1 chan 0 output differs"))
- (if (not (vequal samps new-samps-1))
- (snd-display #__line__ ";with-threaded-sound 1 chan 1 output differs"))))))
-
- (for-each
- (lambda (buflen)
- (set! *clm-file-buffer-size* buflen)
- (let* ((len 1000000)
- (samps (make-vct len)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! samps i (- (random 2.0) 1.0))))
- (let* ((result (with-threaded-sound (:channels 2)
- (out-samps 0 0 samps)
- (out-samps 0 1 samps)))
- (snd (find-sound result)))
- (if (not (sound? snd))
- (snd-display #__line__ ";with-threaded-sound 2 (~D) no output: ~A ~A" buflen result snd)
- (let ((new-samps-0 (channel->vct 0 (frames snd) snd 0))
- (new-samps-1 (channel->vct 0 (frames snd) snd 1)))
- (if (not (vequal samps new-samps-0))
- (snd-display #__line__ ";with-threaded-sound 2 (~D) chan 0 output differs" buflen))
- (if (not (vequal samps new-samps-1))
- (snd-display #__line__ ";with-threaded-sound 2 (~D) chan 1 output differs" buflen)))))))
- (list 65536 8192 1024 256 1234))
- (set! *clm-file-buffer-size* old-file-buffer-size)
- (set! (mus-file-buffer-size) old-file-buffer-size)
-
- (let ((samps (make-vct 512)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 512))
- (vct-set! samps i (- (random 2.0) 1.0))))
- (with-threaded-sound (:channels 1 :output "thread-test.snd")
- (out-samps 0 0 samps))
- (let* ((inp (make-file->sample "thread-test.snd"))
- (inres (make-vct 512))
- (result (with-threaded-sound ()
- (do ((i 0 (+ 1 i)))
- ((= i 512))
- (let ((val (ina i inp)))
- (vct-set! inres i val)
- (outa i val)))))
- (snd (find-sound result)))
- (if (not (sound? snd))
- (snd-display #__line__ ";with-threaded-sound 3 no output: ~A ~A" result snd)
- (let ((new-samps-0 (channel->vct 0 (frames snd) snd 0)))
- (if (not (vequal samps new-samps-0))
- (snd-display #__line__ ";with-threaded-sound 3 output differs"))
- (if (not (vequal samps inres))
- (snd-display #__line__ ";with-threaded-sound 3 input differs"))))
- (close-sound snd)
- (set! snd (find-sound "thread-test.snd"))
- (if (sound? snd) (close-sound snd))
- (delete-file "thread-test.snd")))
-
- (let ((samps (make-vct 512)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 512))
- (vct-set! samps i (- (random 2.0) 1.0))))
- (let* ((result (with-threaded-sound (:channels 1)
- (out-samps 0 0 samps)
- (out-samps-invert 0 0 samps)))
- (snd (find-sound result)))
- (if (not (sound? snd))
- (snd-display #__line__ ";with-threaded-sound 4 no output: ~A ~A" result snd)
- (let ((new-samps-0 (channel->vct 0 (frames snd) snd 0)))
- (if (fneq (vct-peak new-samps-0) 0.0)
- (snd-display #__line__ ";with-threaded-sound 4 chan 1 output differs"))))))
-
- (for-each
- (lambda (buflen)
- (set! *clm-file-buffer-size* buflen)
- (let* ((len 1000000)
- (samps (make-vct len)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! samps i (- (random 2.0) 1.0))))
- (let* ((result (with-threaded-sound (:channels 1)
- (out-samps 0 0 samps)
- (out-samps-invert 0 0 samps)))
- (snd (find-sound result)))
- (if (not (sound? snd))
- (snd-display #__line__ ";with-threaded-sound 5 (~D) no output: ~A ~A" buflen result snd)
- (let ((new-samps-0 (channel->vct 0 (frames snd) snd 0)))
- (if (fneq (vct-peak new-samps-0) 0.0)
- (snd-display #__line__ ";with-threaded-sound 5 chan 1 output differs")))))))
- (list 65536 8192 1024 256 1234))
- (set! *clm-file-buffer-size* old-file-buffer-size)
- (set! (mus-file-buffer-size) old-file-buffer-size)
- (for-each (lambda (snd) (close-sound snd)) (sounds))
- ))
-
(if (directory? "oboe.snd") (snd-display #__line__ ";directory? oboe.snd!"))
(if (not (directory? ".")) (snd-display #__line__ ";directory? . #f!"))
(if (not (getenv "PATH")) (snd-display #__line__ ";getenv: no PATH?"))
(if (not (number? (getpid))) (snd-display #__line__ ";getpid: ~A" (getpid)))
- (if (not (list? (global-environment))) (snd-display #__line__ ";global-environment not a list?: ~A" (global-environment)))
+ (unless (provided? 'pure-s7)
+ (let ((ip (current-input-port)))
+ (let ((tag (catch #t (lambda () (set-current-input-port "hiho!")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-input-port tag: ~A" tag))
+ (if (not (equal? ip (current-input-port))) (snd-display #__line__ ";set-current-input-port clobbered port? ~A ~A" ip (current-input-port)))))
- (let ((ip (current-input-port)))
- (let ((tag (catch #t (lambda () (set-current-input-port "hiho!")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-input-port tag: ~A" tag))
- (if (not (equal? ip (current-input-port))) (snd-display #__line__ ";set-current-input-port clobbered port? ~A ~A" ip (current-input-port)))))
+ (let ((ip (current-output-port)))
+ (let ((tag (catch #t (lambda () (set-current-output-port "hiho!")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-output-port tag: ~A" tag))
+ (if (not (equal? ip (current-output-port))) (snd-display #__line__ ";set-current-output-port clobbered port? ~A ~A" ip (current-output-port)))))
- (let ((ip (current-output-port)))
- (let ((tag (catch #t (lambda () (set-current-output-port "hiho!")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-output-port tag: ~A" tag))
- (if (not (equal? ip (current-output-port))) (snd-display #__line__ ";set-current-output-port clobbered port? ~A ~A" ip (current-output-port)))))
-
- (let ((ip (current-error-port)))
- (let ((tag (catch #t (lambda () (set-current-error-port "hiho!")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-error-port tag: ~A" tag))
- (if (not (equal? ip (current-error-port))) (snd-display #__line__ ";set-current-error-port clobbered port? ~A ~A" ip (current-error-port)))))
+ (let ((ip (current-error-port)))
+ (let ((tag (catch #t (lambda () (set-current-error-port "hiho!")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";set-current-error-port tag: ~A" tag))
+ (if (not (equal? ip (current-error-port))) (snd-display #__line__ ";set-current-error-port clobbered port? ~A ~A" ip (current-error-port))))))
(if (not (provided? 'gmp))
(let* ((LONG_MAX 2147483647)
@@ -5015,28 +4417,28 @@
(do ((i 0 (+ i 1)))
((= i 11))
- (write-lint32 (list-ref ints i))
- (write-bint32 (list-ref ints i)))
+ (write-lint32 (ints i))
+ (write-bint32 (ints i)))
(do ((i 0 (+ i 1)))
((= i 11))
- (write-lint16 (list-ref shorts i))
- (write-bint16 (list-ref shorts i)))
+ (write-lint16 (shorts i))
+ (write-bint16 (shorts i)))
(do ((i 0 (+ i 1)))
((= i 11))
- (write-lint64 (list-ref longs i))
- (write-bint64 (list-ref longs i)))
+ (write-lint64 (longs i))
+ (write-bint64 (longs i)))
(do ((i 0 (+ i 1)))
((= i 11))
- (write-lfloat32 (list-ref floats i))
- (write-bfloat32 (list-ref floats i)))
+ (write-lfloat32 (floats i))
+ (write-bfloat32 (floats i)))
(do ((i 0 (+ i 1)))
((= i 11))
- (write-lfloat64 (list-ref doubles i))
- (write-bfloat64 (list-ref doubles i)))
+ (write-lfloat64 (doubles i))
+ (write-bfloat64 (doubles i)))
))
(with-input-from-file "idf1.data"
@@ -5046,37 +4448,37 @@
(if (not (= val1 val2))
(if (and (not (eq? name 'lfloat32))
(not (eq? name 'bfloat32)))
- (format #t ";~A: ~A != ~A~%" name val1 val2)
+ (snd-display #__line__ ";testf ~A: ~A != ~A~%" name val1 val2)
(if (> (abs (- val1 val2)) 1.0e-6)
- (format #t ";~A: ~A != ~A (~A)~%" name val1 val2 (abs (- val1 val2)))))))
+ (snd-display #__line__ ";testf ~A: ~A != ~A (~A)~%" name val1 val2 (abs (- val1 val2)))))))
(testf (read-lint32) 123 'lint32)
(testf (read-bint32) 321 'bint32)
(do ((i 0 (+ i 1)))
((= i 11))
- (testf (read-lint32) (list-ref ints i) 'lint32)
- (testf (read-bint32) (list-ref ints i) 'bint32))
+ (testf (read-lint32) (ints i) 'lint32)
+ (testf (read-bint32) (ints i) 'bint32))
(do ((i 0 (+ i 1)))
((= i 11))
- (testf (read-lint16) (list-ref shorts i) 'lint16)
- (testf (read-bint16) (list-ref shorts i) 'bint16))
+ (testf (read-lint16) (shorts i) 'lint16)
+ (testf (read-bint16) (shorts i) 'bint16))
(do ((i 0 (+ i 1)))
((= i 11))
- (testf (read-lint64) (list-ref longs i) 'lint64)
- (testf (read-bint64) (list-ref longs i) 'bint64))
+ (testf (read-lint64) (longs i) 'lint64)
+ (testf (read-bint64) (longs i) 'bint64))
(do ((i 0 (+ i 1)))
((= i 11))
- (testf (read-lfloat32) (list-ref floats i) 'lfloat32)
- (testf (read-bfloat32) (list-ref floats i) 'bfloat32))
+ (testf (read-lfloat32) (floats i) 'lfloat32)
+ (testf (read-bfloat32) (floats i) 'bfloat32))
(do ((i 0 (+ i 1)))
((= i 11))
- (testf (read-lfloat64) (list-ref doubles i) 'lfloat64)
- (testf (read-bfloat64) (list-ref doubles i) 'bfloat64))
+ (testf (read-lfloat64) (doubles i) 'lfloat64)
+ (testf (read-bfloat64) (doubles i) 'bfloat64))
))
))
))
@@ -5085,125 +4487,88 @@
;;; ---------------- test 5: simple overall checks ----------------
-(if (not (provided? 'snd-selection.scm)) (load "selection.scm"))
-(if (not (provided? 'snd-extensions.scm)) (load "extensions.scm"))
-(if (not (provided? 'snd-selection.scm)) (load "selection.scm"))
-(if (not (provided? 'snd-dsp.scm)) (load "dsp.scm"))
-(if (not (provided? 'snd-pvoc.scm)) (load "pvoc.scm"))
-(if (and with-gui (not (provided? 'snd-edit-menu.scm))) (load "edit-menu.scm"))
-
-(define* (cosine-channel-via-ptree (beg 0) dur snd chn edpos)
- ;; vct: angle increment
- (ptree-channel
- (lambda (y data forward)
- (let* ((angle (vct-ref data 0))
- (incr (vct-ref data 1))
- (val (* y (cos angle))))
- (if forward
- (vct-set! data 0 (+ angle incr))
- (vct-set! data 0 (- angle incr)))
- val))
- beg dur snd chn edpos #t
- (lambda (frag-beg frag-dur)
- (let ((incr (/ pi frag-dur)))
- (vct (+ (* -0.5 pi) (* frag-beg incr))
- incr)))))
-
-(define old-opt-val (optimization))
+(require snd-selection.scm snd-extensions.scm snd-selection.scm snd-dsp.scm snd-pvoc.scm)
+(if with-gui (require snd-edit-menu.scm))
(define (snd_test_5)
(define a-ctr 0)
(define g-init-val 0)
(define (append-sound filename)
- (insert-sound filename (frames)))
+ (insert-sound filename (framples)))
(define (test-edpos test-func func-name change-thunk ind1)
(let ((fr1 (test-func ind1 0))
(fr2 (test-func ind1 0 0))
- (fr3 (test-func ind1 0 current-edit-position))
- (fr4 (test-func ind1 0 (lambda (snd chn) 0))))
- (if (not (and (= fr1 fr2)
- (= fr1 fr3)
- (= fr1 fr4)))
- (snd-display #__line__ ";initial ~A: ~A ~A ~A ~A?" func-name fr1 fr2 fr3 fr4))
+ (fr3 (test-func ind1 0 current-edit-position)))
+ (if (not (= fr1 fr2 fr3))
+ (snd-display #__line__ ";initial ~A: ~A ~A ~A?" func-name fr1 fr2 fr3))
(change-thunk)
(let ((fr5 (test-func ind1 0))
(fr6 (test-func ind1 0 1))
- (fr7 (test-func ind1 0 current-edit-position))
- (fr8 (test-func ind1 0 (lambda (snd chn) (edit-position snd chn)))))
- (if (not (and (= fr5 fr6)
- (= fr5 fr7)
- (= fr5 fr8)))
- (snd-display #__line__ ";~A (edpos 1): ~A ~A ~A ~A?" func-name fr5 fr6 fr7 fr8))
- (set! fr5 (test-func ind1 0 0))
- (set! fr6 (test-func ind1 0 (lambda (snd chn) 0)))
- (if (not (and (= fr1 fr5)
- (= fr1 fr6)))
- (snd-display #__line__ ";~A (edpos -1): ~A ~A ~A?" func-name fr1 fr5 fr6))))
+ (fr7 (test-func ind1 0 current-edit-position)))
+ (if (not (= fr5 fr6 fr7))
+ (snd-display #__line__ ";~A (edpos 1): ~A ~A ~A?" func-name fr5 fr6 fr7))))
(revert-sound ind1))
(define (test-edpos-1 test-func func-name ind1)
- (let ((v0 (channel->vct 12000 10 ind1 0)))
+ (let ((v0 (channel->float-vector 12000 10 ind1 0)))
(test-func ind1 0)
- (let ((v1 (channel->vct 12000 10 ind1 0)))
+ (let ((v1 (channel->float-vector 12000 10 ind1 0)))
(if (vequal v0 v1)
(snd-display #__line__ ";~A (0) no change! ~A ~A" func-name v0 v1))
(test-func ind1 0)
- (let ((v2 (channel->vct 12000 10 ind1 0)))
- (if (not (vequal v1 v2))
- (snd-display #__line__ ";~A (1) ~A ~A" func-name v1 v2))
- (test-func ind1 (lambda (snd chn) 0))
- (set! v2 (channel->vct 12000 10 ind1 0))
+ (let ((v2 (channel->float-vector 12000 10 ind1 0)))
(if (not (vequal v1 v2))
- (snd-display #__line__ ";~A (2) ~A ~A" func-name v1 v2)))))
+ (snd-display #__line__ ";~A (1) ~A ~A" func-name v1 v2)))))
(revert-sound ind1))
- (define (vfequal v0 v1)
- (define (dequal ctr len)
- (if (= ctr len)
- #t
- (and (< (abs (- (vct-ref v0 ctr) (vct-ref v1 ctr))) .01)
- (dequal (+ 1 ctr) len))))
- (let ((len (vct-length v0)))
- (and (= len (vct-length v1))
- (dequal 0 len))))
-
(define (test-orig func0 func1 func-name ind1)
- (let ((v0 (channel->vct 12000 10 ind1 0)))
+ (let ((v0 (channel->float-vector 12000 10 ind1 0)))
(func0 ind1)
- (let ((v1 (channel->vct 12000 10 ind1 0)))
- (if (vfequal v0 v1)
+ (let ((v1 (channel->float-vector 12000 10 ind1 0)))
+ (if (vequal1 v0 v1)
(snd-display #__line__ ";~A (orig: 0) no change! ~A ~A" func-name v0 v1))
(func1 ind1)
- (let ((v2 (channel->vct 12000 10 ind1 0)))
- (if (not (vfequal v0 v2))
+ (let ((v2 (channel->float-vector 12000 10 ind1 0)))
+ (if (not (vequal1 v0 v2))
(snd-display #__line__ ";~A (orig: 1) ~A ~A" func-name v0 v2))))
(revert-sound ind1)))
(define* (make-bandpass-2 flo1 fhi1 flo2 fhi2 (len 30))
- (let* ((f1 (make-bandpass flo1 fhi1 len))
+ (let ((f1 (make-bandpass flo1 fhi1 len))
(f2 (make-bandpass flo2 fhi2 len)))
- (vct-add! (mus-xcoeffs f1) (mus-xcoeffs f2))
+ (float-vector-add! (mus-xcoeffs f1) (mus-xcoeffs f2))
f1))
+#|
(define* (cosine-channel (beg 0) dur snd chn edpos)
- (let ((old-opt (optimization))
- (samps (or dur (frames snd chn))))
- (set! (optimization) 0)
+ (let ((samps (or dur (framples snd chn))))
(map-channel
- (let* ((incr (/ pi samps))
- (angle (* -0.5 pi)))
+ (let ((incr (/ pi samps))
+ (angle (* -0.5 pi)))
(lambda (y)
(let ((val (* y (cos angle))))
(set! angle (+ angle incr))
val)))
beg dur snd chn edpos)
- (set! (optimization) old-opt)))
-
- (define (check-maxamp ind val name)
+ ))
+|#
+ (define* (cosine-channel (beg 0) dur snd chn edpos)
+ (let ((samps (or dur (framples snd chn))))
+ (map-channel
+ (let ((incr (/ pi samps))
+ (angle (* -0.5 pi))
+ (p (make-one-pole 1.0 -1.0)))
+ (one-pole p (- angle incr))
+ (lambda (y)
+ (* y (cos (one-pole p incr)))))
+ beg dur snd chn edpos)
+ ))
+
+ (define (check-maxamp caller-line ind val name)
(if (fneq (maxamp ind 0) val) (snd-display #__line__ ";maxamp amp-env ~A: ~A should be ~A" name (maxamp ind) val))
- (let ((pos (find-channel (lambda (y) (>= (abs y) (- val .0001)))))
+ (let ((pos (scan-channel (lambda (y) (>= (abs y) (- val .0001)))))
(maxpos (maxamp-position ind 0)))
(if (not pos)
(snd-display #__line__ ";actual maxamp ~A vals not right" name)
@@ -5211,194 +4576,161 @@
(snd-display #__line__ ";~A: find and maxamp-position disagree: ~A (~A) ~A (~A)"
name pos (sample pos ind 0) maxpos (sample maxpos ind 0))))
(let ((mx 0.0)
- (ctr 0)
- (mpos 0))
- (scan-chan (lambda (y)
- (if (> (abs y) mx)
- (begin
- (set! mpos ctr)
- (set! mx (abs y))))
- (set! ctr (+ 1 ctr))
- #f))
+ (data #f)
+ (mpos 0)
+ (len (framples ind)))
+ (let ((info (float-vector-peak-and-location (samples 0 len ind))))
+ (set! mpos (cadr info))
+ (set! mx (car info)))
(if (not (= mpos maxpos))
- (snd-display #__line__ ";scan-chan and maxamp-position disagree: ~A ~A" mpos maxpos))
- (if (fneq mx val) (snd-display #__line__ ";actual ~A max: ~A (correct: ~A)" name mx val)))))
+ (snd-display #__line__ ";(~D) scan and maxamp-position disagree: ~A ~A" caller-line mpos maxpos))
+ (if (fneq mx val) (snd-display #__line__ ";(~D) actual ~A max: ~A (correct: ~A)" caller-line name mx val)))))
(define (check-env-vals name gen)
- (let ((ctr -1))
- (scan-chan (lambda (y)
- (let ((val (env gen)))
- (set! ctr (+ 1 ctr))
- (if (fneq val y)
- (begin
- (display (format #f "~%;check-env-vals ~A at ~D: ~A ~A" name ctr val y))
- #t)
- #f))))))
-
+ (let ((len (framples))
+ (reader (make-sampler)))
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((val (env gen))
+ (y (next-sample reader)))
+ (if (fneq val y)
+ (begin
+ (format #t "~%;check-env-vals ~A at ~D: ~A ~A" name i val y)
+ (quit)))))))))
+
(define (our-x->position ind x)
(let ((ax (axis-info ind 0)))
(list
- (+ (list-ref ax 10)
- (/ (* (- x (list-ref ax 2))
- (- (list-ref ax 12) (list-ref ax 10)))
- (- (list-ref ax 4) (list-ref ax 2))))
+ (+ (ax 10)
+ (/ (* (- x (ax 2))
+ (- (ax 12) (ax 10)))
+ (- (ax 4) (ax 2))))
(x->position x ind))))
- (define (region-to-vct r c len)
- (let* ((rs (make-region-sampler r 0 c))
- (v (make-vct len)))
- (do ((i 0 (+ 1 i)))
- ((= i len) v)
- (vct-set! v i (next-sample rs)))))
-
- (define (region2vct r c len)
- (region->vct r 0 len c))
-
- ;; extensions.scm (commented out)
- (define* (delay-channel dly (beg 0) dur snd chn edpos)
- (let ((cur-edpos (if (or (not edpos)
- (= edpos current-edit-position))
- (edit-position snd chn)
- edpos)))
- (ptree-channel (lambda (y data dir)
- (let* ((pos (floor (vct-ref data 0)))
- (len (floor (vct-ref data 1)))
- (val (vct-ref data (+ pos 2))))
- (vct-set! data (+ pos 2) y)
- (set! pos (+ 1 pos))
- (if (>= pos len) (vct-set! data 0 0) (vct-set! data 0 pos))
- val))
- beg dur snd chn edpos #f
- (lambda (fpos fdur)
- (let ((data (make-vct (+ dly 2))))
- (vct-set! data 0 0.0)
- (vct-set! data 1 dly)
- (if (= fpos 0)
- data
- (let* ((reader (make-sampler (- fpos 1) snd chn -1 cur-edpos)))
- (do ((i (- dly 1) (- i 1)))
- ((< i 0))
- (vct-set! data (+ i 2) (reader)))
- data)))))))
-
- (begin
-
- (set! (optimization) max-optimization) ; these trees assume optimization is on
-
- (if (playing) (snd-display #__line__ ";dac is running??"))
- (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
- (log-mem clmtest)
-
- (let ((ind (open-sound "oboe.snd")))
- (set! (transform-graph? ind 0) #t)
- (set! (transform-graph-type ind 0) graph-as-sonogram)
- (catch 'no-such-axis
- (lambda ()
- (set! (y-axis-label ind 0 1) "hiho"))
- (lambda args
- (snd-display #__line__ ";no fft axis: ~A" args)))
- (set! (fft-log-frequency ind 0) #t) ; segfault here originally
- (update-transform-graph ind 0)
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd" :size 10)))
- (vct->channel (make-vct 10 1.0))
- (env-channel '(0 0 1 1 2 0))
- (let ((data (channel->vct)))
- (if (not (vequal data (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display #__line__ ";pyr 10: ~A" data)))
- (undo)
- (env-channel '((0 0) (1 1) (2 0)))
- (let ((data (channel->vct)))
- (if (not (vequal data (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display #__line__ ";pyr 10: ~A" data)))
- (undo)
- (env-channel (make-env '(0 0 1 1 2 0) :length 10))
- (let ((data (channel->vct)))
- (if (not (vequal data (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display #__line__ ";pyr 10: ~A" data)))
- (undo)
- (close-sound ind))
-
- (for-each
- (lambda (size)
- (let ((ind (new-sound "test.snd" :size size))
- (incr (/ 1.0 (- size 1)))
- (e (make-env '(0 0 1 1) :length size)))
- (vct->channel (make-vct size 1.0))
-
- (ramp-channel 0.0 1.0)
- (let ((data (channel->vct)))
- (if (or (fneq (vct-ref data 0) 0.0)
- (fneq (vct-ref data (- size 1)) 1.0))
- (snd-display #__line__ ";ramp-channel ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
- (do ((i 0 (+ 1 i)))
+ (define (region-to-float-vector r c len)
+ (let ((rs (make-region-sampler r 0 c))
+ (v (make-float-vector len)))
+ (outa->fv v (next-sample rs))))
+
+ (define (region2float-vector r c len)
+ (region->float-vector r 0 len c))
+
+ (if (playing) (snd-display #__line__ ";dac is running??"))
+ (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
+ (log-mem clmtest)
+
+ (let ((ind (open-sound "oboe.snd")))
+ (set! (transform-graph? ind 0) #t)
+ (set! (transform-graph-type ind 0) graph-as-sonogram)
+ (catch 'no-such-axis
+ (lambda ()
+ (set! (y-axis-label ind 0 1) "hiho"))
+ (lambda args
+ (snd-display #__line__ ";no fft axis: ~A" args)))
+ (set! (fft-log-frequency ind 0) #t) ; segfault here originally
+ (update-transform-graph ind 0)
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd" :size 10)))
+ (float-vector->channel (make-float-vector 10 1.0))
+ (env-channel '(0 0 1 1 2 0))
+ (let ((data (channel->float-vector)))
+ (if (not (vequal data (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (snd-display #__line__ ";pyr 10: ~A" data)))
+ (undo)
+ (env-channel '((0 0) (1 1) (2 0)))
+ (let ((data (channel->float-vector)))
+ (if (not (vequal data (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (snd-display #__line__ ";pyr 10: ~A" data)))
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 0) :length 10))
+ (let ((data (channel->float-vector)))
+ (if (not (vequal data (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (snd-display #__line__ ";pyr 10: ~A" data)))
+ (undo)
+ (close-sound ind))
+
+ (for-each
+ (lambda (size)
+ (let ((ind (new-sound "test.snd" :size size))
+ (incr (/ 1.0 (- size 1)))
+ (e (make-env '(0 0 1 1) :length size)))
+ (float-vector->channel (make-float-vector size 1.0))
+
+ (ramp-channel 0.0 1.0)
+ (let ((data (channel->float-vector)))
+ (if (or (fneq (data 0) 0.0)
+ (fneq (data (- size 1)) 1.0))
+ (snd-display #__line__ ";ramp-channel ~A end points: ~A ~A" size (data 0) (data (- size 1))))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0)))
+ (segval (env e)))
+ (if (or (fneq segval val)
+ (fneq (data i) val))
+ (snd-display #__line__ ";ramp-channel ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (data i) val segval)))))
+ (undo)
+ (xramp-channel 0.0 1.0 32.0)
+ (let ((e (make-env '(0 0 1 1) :length size :base 32.0)))
+ (let ((data (channel->float-vector)))
+ (if (or (fneq (data 0) 0.0)
+ (fneq (data (- size 1)) 1.0))
+ (snd-display #__line__ ";xramp-channel 32 ~A end points: ~A ~A" size (data 0) (data (- size 1))))
+ (do ((i 0 (+ i 1)))
((= i size))
- (let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0)))
+ (let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0) 32.0))
(segval (env e)))
(if (or (fneq segval val)
- (fneq (vct-ref data i) val))
- (snd-display #__line__ ";ramp-channel ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval)))))
- (undo)
- (xramp-channel 0.0 1.0 32.0)
- (let ((e (make-env '(0 0 1 1) :length size :base 32.0)))
- (let ((data (channel->vct)))
- (if (or (fneq (vct-ref data 0) 0.0)
- (fneq (vct-ref data (- size 1)) 1.0))
- (snd-display #__line__ ";xramp-channel 32 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
- (do ((i 0 (+ 1 i)))
- ((= i size))
- (let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0) 32.0))
- (segval (env e)))
- (if (or (fneq segval val)
- (fneq (vct-ref data i) val))
- (snd-display #__line__ ";xramp-channel 32 ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval))))))
- (undo)
- (xramp-channel 0.0 1.0 0.4)
- (let ((e (make-env '(0 0 1 1) :length size :base 0.4)))
- (let ((data (channel->vct)))
- (if (or (fneq (vct-ref data 0) 0.0)
- (fneq (vct-ref data (- size 1)) 1.0))
- (snd-display #__line__ ";xramp-channel .4 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
- (do ((i 0 (+ 1 i)))
- ((= i size))
- (let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0) 0.4))
- (segval (env e)))
- (if (or (fneq segval val)
- (fneq (vct-ref data i) val))
- (snd-display #__line__ ";xramp-channel .4 ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (vct-ref data i) val segval))))))
- (undo)
- (xramp-channel 1.0 -1.0 8.0)
- (let ((e (make-env '(0 1 1 -1) :length size :base 8.0)))
- (let ((data (channel->vct)))
- (if (or (fneq (vct-ref data 0) 1.0)
- (fneq (vct-ref data (- size 1)) -1.0))
- (snd-display #__line__ ";xramp-channel 1 -1 8 ~A end points: ~A ~A" size (vct-ref data 0) (vct-ref data (- size 1))))
- (do ((i 0 (+ 1 i)))
- ((= i size))
- (let ((segval (env e)))
- (if (fneq segval (vct-ref data i))
- (snd-display #__line__ ";xramp-channel 1 -1 8 ~A of ~A: ramp: ~A, env: ~A" i size (vct-ref data i) segval))))))
- (undo)
- (close-sound ind)))
- (list 10 100 1000))
+ (fneq (data i) val))
+ (snd-display #__line__ ";xramp-channel 32 ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (data i) val segval))))))
+ (undo)
+ (xramp-channel 0.0 1.0 0.4)
+ (let ((e (make-env '(0 0 1 1) :length size :base 0.4)))
+ (let ((data (channel->float-vector)))
+ (if (or (fneq (data 0) 0.0)
+ (fneq (data (- size 1)) 1.0))
+ (snd-display #__line__ ";xramp-channel .4 ~A end points: ~A ~A" size (data 0) (data (- size 1))))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (let ((val (envelope-interp (* i incr) '(0.0 0.0 1.0 1.0) 0.4))
+ (segval (env e)))
+ (if (or (fneq segval val)
+ (fneq (data i) val))
+ (snd-display #__line__ ";xramp-channel .4 ~A of ~A: ramp: ~A, interp: ~A, env: ~A" i size (data i) val segval))))))
+ (undo)
+ (xramp-channel 1.0 -1.0 8.0)
+ (let ((e (make-env '(0 1 1 -1) :length size :base 8.0)))
+ (let ((data (channel->float-vector)))
+ (if (or (fneq (data 0) 1.0)
+ (fneq (data (- size 1)) -1.0))
+ (snd-display #__line__ ";xramp-channel 1 -1 8 ~A end points: ~A ~A" size (data 0) (data (- size 1))))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (let ((segval (env e)))
+ (if (fneq segval (data i))
+ (snd-display #__line__ ";xramp-channel 1 -1 8 ~A of ~A: ramp: ~A, env: ~A" i size (data i) segval))))))
+ (undo)
+ (close-sound ind)))
+ (list 10 100 1000))
+
+ ;; basic edit tree cases
+ (let ((ind (new-sound "test.snd")))
+ (if (not (= (redo) 0)) (snd-display #__line__ ";redo with no ops: ~A" (redo)))
+ (if (not (= (undo) 0)) (snd-display #__line__ ";undo with no ops: ~A" (undo)))
- ;; basic edit tree cases
- (let ((ind (new-sound "test.snd")))
- (if (not (= (redo) 0)) (snd-display #__line__ ";redo with no ops: ~A" (redo)))
- (if (not (= (undo) 0)) (snd-display #__line__ ";undo with no ops: ~A" (undo)))
-
- (if (not (string-=? (display-edits) (string-append "
+ (if (not (string-=? (display-edits) (string-append "
EDITS: 0
(begin) [0:2]:
(at 0, cp->sounds[0][0:0, 0.000]) [file: " cwd "test.snd[0]]
(at 1, end_mark)
")))
- (snd-display #__line__ ";new 0: ~A" (display-edits)))
- (insert-samples 10 10 (make-vct 10))
- (if (not (= (frames) 20)) (snd-display #__line__ ";new 1 frames: ~A" (frames)))
- (if (not (string-=? (display-edits) (string-append "
+ (snd-display #__line__ ";new 0: ~A" (display-edits)))
+ (insert-samples 10 10 (make-float-vector 10))
+ (if (not (= (framples) 20)) (snd-display #__line__ ";new 1 framples: ~A" (framples)))
+ (if (not (string-=? (display-edits) (string-append "
EDITS: 1
(begin) [0:2]:
@@ -5411,11 +4743,11 @@ EDITS: 1
(at 10, cp->sounds[1][0:9, 1.000]) [buf: 10]
(at 20, end_mark)
")))
- (snd-display #__line__ ";new 1: ~A" (display-edits)))
- (undo)
- (insert-samples 0 10 (make-vct 10))
- (if (not (= (frames) 11)) (snd-display #__line__ ";new 2 frames: ~A" (frames))) ; 11 because there was 1 sample when new-sound created
- (if (not (string-=? (display-edits) (string-append "
+ (snd-display #__line__ ";new 1: ~A" (display-edits)))
+ (undo)
+ (insert-samples 0 10 (make-float-vector 10))
+ (if (not (= (framples) 11)) (snd-display #__line__ ";new 2 framples: ~A" (framples))) ; 11 because there was 1 sample when new-sound created
+ (if (not (string-=? (display-edits) (string-append "
EDITS: 1
(begin) [0:2]:
@@ -5427,12 +4759,12 @@ EDITS: 1
(at 10, cp->sounds[0][0:0, 0.000]) [file: " cwd "test.snd[0]]
(at 11, end_mark)
")))
- (snd-display #__line__ ";new 2: ~A" (display-edits)))
- (let ((eds (undo 2)))
- (if (not (= eds 2)) (snd-display #__line__ ";new 3 undo: ~A" eds)))
- (insert-samples 0 10 (make-vct 10))
- (if (not (= (frames) 11)) (snd-display #__line__ ";new 3 frames: ~A" (frames)))
- (if (not (string-=? (display-edits) (string-append "
+ (snd-display #__line__ ";new 2: ~A" (display-edits)))
+ (let ((eds (undo 2)))
+ (if (not (= eds 2)) (snd-display #__line__ ";new 3 undo: ~A" eds)))
+ (insert-samples 0 10 (make-float-vector 10))
+ (if (not (= (framples) 11)) (snd-display #__line__ ";new 3 framples: ~A" (framples)))
+ (if (not (string-=? (display-edits) (string-append "
EDITS: 1
(begin) [0:2]:
@@ -5444,11 +4776,11 @@ EDITS: 1
(at 10, cp->sounds[0][0:0, 0.000]) [file: " cwd "test.snd[0]]
(at 11, end_mark)
")))
- (snd-display #__line__ ";new 3: ~A" (display-edits)))
- (undo)
- (set! (sample 0) .5)
- (if (not (= (frames) 1)) (snd-display #__line__ ";new 4 frames: ~A" (frames)))
- (if (not (string-=? (display-edits) (string-append "
+ (snd-display #__line__ ";new 3: ~A" (display-edits)))
+ (undo)
+ (set! (sample 0) .5)
+ (if (not (= (framples) 1)) (snd-display #__line__ ";new 4 framples: ~A" (framples)))
+ (if (not (string-=? (display-edits) (string-append "
EDITS: 1
(begin) [0:2]:
@@ -5459,12 +4791,12 @@ EDITS: 1
(at 0, cp->sounds[1][0:0, 1.000]) [buf: 1]
(at 1, end_mark)
")))
- (snd-display #__line__ ";new 4: ~A" (display-edits)))
- (undo)
-
- (set! (samples 0 10) (make-vct 10))
- (if (not (= (frames) 10)) (snd-display #__line__ ";new 5 frames: ~A" (frames)))
- (if (not (string-=? (display-edits) (string-append "
+ (snd-display #__line__ ";new 4: ~A" (display-edits)))
+ (undo)
+
+ (set! (samples 0 10) (make-float-vector 10))
+ (if (not (= (framples) 10)) (snd-display #__line__ ";new 5 framples: ~A" (framples)))
+ (if (not (string-=? (display-edits) (string-append "
EDITS: 1
(begin) [0:2]:
@@ -5475,35 +4807,35 @@ EDITS: 1
(at 0, cp->sounds[1][0:9, 1.000]) [buf: 10]
(at 10, end_mark)
")))
- (snd-display #__line__ ";new 5: ~A" (display-edits)))
-
- (delete-samples 3 4)
- (if (not (= (frames) 6)) (snd-display #__line__ ";new 6 frames: ~A" (frames)))
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";new 5: ~A" (display-edits)))
+
+ (delete-samples 3 4)
+ (if (not (= (framples) 6)) (snd-display #__line__ ";new 6 framples: ~A" (framples)))
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(delete 3 4) ; delete-samples 3 4 [2:3]:
(at 0, cp->sounds[1][0:2, 1.000]) [buf: 10]
(at 3, cp->sounds[1][7:9, 1.000]) [buf: 10]
(at 6, end_mark)
"))
- (snd-display #__line__ ";new 6: ~A" (safe-display-edits ind 0 2)))
-
- (set! (samples 1 4) (make-vct 4))
- (if (not (= (frames) 6)) (snd-display #__line__ ";new 7 frames: ~A" (frames)))
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";new 6: ~A" (safe-display-edits ind 0 2)))
+
+ (set! (samples 1 4) (make-float-vector 4))
+ (if (not (= (framples) 6)) (snd-display #__line__ ";new 7 framples: ~A" (framples)))
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(set 1 4) ; set-samples [3:4]:
(at 0, cp->sounds[1][0:0, 1.000]) [buf: 10]
(at 1, cp->sounds[2][0:3, 1.000]) [buf: 4]
(at 5, cp->sounds[1][9:9, 1.000]) [buf: 10]
(at 6, end_mark)
"))
- (snd-display #__line__ ";new 7: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
- (insert-samples 2 3 (make-vct 3))
- (insert-samples 2 1 (make-vct 1))
- (insert-samples 4 1 (make-vct 1))
- (insert-samples 15 1 (make-vct 1))
- (if (not (= (frames) 16)) (snd-display #__line__ ";new 8 frames: ~A" (frames)))
- (if (not (string-=? (display-edits) (string-append "
+ (snd-display #__line__ ";new 7: ~A" (safe-display-edits ind 0 3)))
+ (undo 2)
+ (insert-samples 2 3 (make-float-vector 3))
+ (insert-samples 2 1 (make-float-vector 1))
+ (insert-samples 4 1 (make-float-vector 1))
+ (insert-samples 15 1 (make-float-vector 1))
+ (if (not (= (framples) 16)) (snd-display #__line__ ";new 8 framples: ~A" (framples)))
+ (if (not (string-=? (display-edits) (string-append "
EDITS: 5
(begin) [0:2]:
@@ -5546,9 +4878,9 @@ EDITS: 5
(at 15, cp->sounds[5][0:0, 1.000]) [buf: 1]
(at 16, end_mark)
")))
- (snd-display #__line__ ";new 8: ~A" (display-edits)))
- (delete-samples 2 1)
- (if (not (string-=? (safe-display-edits ind 0 6) "
+ (snd-display #__line__ ";new 8: ~A" (display-edits)))
+ (delete-samples 2 1)
+ (if (not (string-=? (safe-display-edits ind 0 6) "
(delete 2 1) ; delete-samples 2 1 [6:7]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[2][0:0, 1.000]) [buf: 3]
@@ -5558,88 +4890,88 @@ EDITS: 5
(at 14, cp->sounds[5][0:0, 1.000]) [buf: 1]
(at 15, end_mark)
"))
- (snd-display #__line__ ";new 9: ~A" (safe-display-edits ind 0 6)))
- (delete-samples 0 5)
- (if (not (string-=? (safe-display-edits ind 0 7) "
+ (snd-display #__line__ ";new 9: ~A" (safe-display-edits ind 0 6)))
+ (delete-samples 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 7) "
(delete 0 5) ; delete-samples 0 5 [7:4]:
(at 0, cp->sounds[2][2:2, 1.000]) [buf: 3]
(at 1, cp->sounds[1][2:9, 1.000]) [buf: 10]
(at 9, cp->sounds[5][0:0, 1.000]) [buf: 1]
(at 10, end_mark)
"))
- (snd-display #__line__ ";new 10: ~A" (safe-display-edits ind 0 7)))
- (delete-samples 6 4)
- (if (not (string-=? (safe-display-edits ind 0 8) "
+ (snd-display #__line__ ";new 10: ~A" (safe-display-edits ind 0 7)))
+ (delete-samples 6 4)
+ (if (not (string-=? (safe-display-edits ind 0 8) "
(delete 6 4) ; delete-samples 6 4 [8:3]:
(at 0, cp->sounds[2][2:2, 1.000]) [buf: 3]
(at 1, cp->sounds[1][2:6, 1.000]) [buf: 10]
(at 6, end_mark)
"))
- (snd-display #__line__ ";new 11: ~A" (safe-display-edits ind 0 8)))
- (delete-samples 0 1)
- (if (not (string-=? (safe-display-edits ind 0 9) "
+ (snd-display #__line__ ";new 11: ~A" (safe-display-edits ind 0 8)))
+ (delete-samples 0 1)
+ (if (not (string-=? (safe-display-edits ind 0 9) "
(delete 0 1) ; delete-samples 0 1 [9:2]:
(at 0, cp->sounds[1][2:6, 1.000]) [buf: 10]
(at 5, end_mark)
"))
- (snd-display #__line__ ";new 12: ~A" (safe-display-edits ind 0 9)))
-
- (delete-samples 0 5)
- (if (not (string-=? (safe-display-edits ind 0 10) "
+ (snd-display #__line__ ";new 12: ~A" (safe-display-edits ind 0 9)))
+
+ (delete-samples 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 10) "
(delete 0 5) ; delete-samples 0 5 [10:1]:
(at 0, end_mark)
"))
- (snd-display #__line__ ";new 13: ~A" (safe-display-edits ind 0 10)))
- (delete-samples 0 10)
- (if (not (= (edit-position) 10))
- (snd-display #__line__ ";no-op delete deleted something! ~A" (display-edits)))
- (insert-samples 0 3 (make-vct 3))
- (if (not (string-=? (safe-display-edits ind 0 11) "
+ (snd-display #__line__ ";new 13: ~A" (safe-display-edits ind 0 10)))
+ (delete-samples 0 10)
+ (if (not (= (edit-position) 10))
+ (snd-display #__line__ ";no-op delete deleted something! ~A" (display-edits)))
+ (insert-samples 0 3 (make-float-vector 3))
+ (if (not (string-=? (safe-display-edits ind 0 11) "
(insert 0 3) ; insert-samples [11:2]:
(at 0, cp->sounds[6][0:2, 1.000]) [buf: 3]
(at 3, end_mark)
"))
- (snd-display #__line__ ";new 14: ~A" (safe-display-edits ind 0 11)))
- (delete-samples 2 1)
- (if (not (string-=? (safe-display-edits ind 0 12) "
+ (snd-display #__line__ ";new 14: ~A" (safe-display-edits ind 0 11)))
+ (delete-samples 2 1)
+ (if (not (string-=? (safe-display-edits ind 0 12) "
(delete 2 1) ; delete-samples 2 1 [12:2]:
(at 0, cp->sounds[6][0:1, 1.000]) [buf: 3]
(at 2, end_mark)
"))
- (snd-display #__line__ ";new 15: ~A" (safe-display-edits ind 0 12)))
- (set! (sample 0) .5)
- (if (not (string-=? (safe-display-edits ind 0 13) "
+ (snd-display #__line__ ";new 15: ~A" (safe-display-edits ind 0 12)))
+ (set! (sample 0) .5)
+ (if (not (string-=? (safe-display-edits ind 0 13) "
(set 0 1) ; set-sample 0 0.5000 [13:3]:
(at 0, cp->sounds[7][0:0, 1.000]) [buf: 1]
(at 1, cp->sounds[6][1:1, 1.000]) [buf: 3]
(at 2, end_mark)
"))
- (snd-display #__line__ ";new 16: ~A" (safe-display-edits ind 0 13)))
- (set! (sample 1) .5)
- (if (not (string-=? (safe-display-edits ind 0 14) "
+ (snd-display #__line__ ";new 16: ~A" (safe-display-edits ind 0 13)))
+ (set! (sample 1) .5)
+ (if (not (string-=? (safe-display-edits ind 0 14) "
(set 1 1) ; set-sample 1 0.5000 [14:3]:
(at 0, cp->sounds[7][0:0, 1.000]) [buf: 1]
(at 1, cp->sounds[8][0:0, 1.000]) [buf: 1]
(at 2, end_mark)
"))
- (snd-display #__line__ ";new 17: ~A" (safe-display-edits ind 0 14)))
- (map-channel (lambda (y) 1.0) 0 10)
- (if (not (string-=? (safe-display-edits ind 0 15) "
+ (snd-display #__line__ ";new 17: ~A" (safe-display-edits ind 0 14)))
+ (map-channel (lambda (y) 1.0) 0 10)
+ (if (not (string-=? (safe-display-edits ind 0 15) "
(set 0 10) ; map-channel [15:2]:
(at 0, cp->sounds[9][0:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";new 18: ~A" (safe-display-edits ind 0 15)))
- (insert-samples 0 10 (make-vct 10))
- (if (not (string-=? (safe-display-edits ind 0 16) "
+ (snd-display #__line__ ";new 18: ~A" (safe-display-edits ind 0 15)))
+ (insert-samples 0 10 (make-float-vector 10))
+ (if (not (string-=? (safe-display-edits ind 0 16) "
(insert 0 10) ; insert-samples [16:3]:
(at 0, cp->sounds[10][0:9, 1.000]) [buf: 10]
(at 10, cp->sounds[9][0:9, 1.000]) [buf: 10]
(at 20, end_mark)
"))
- (snd-display #__line__ ";new 19: ~A" (safe-display-edits ind 0 16)))
- (set! (samples 2 3) (make-vct 3))
- (if (not (string-=? (safe-display-edits ind 0 17) "
+ (snd-display #__line__ ";new 19: ~A" (safe-display-edits ind 0 16)))
+ (set! (samples 2 3) (make-float-vector 3))
+ (if (not (string-=? (safe-display-edits ind 0 17) "
(set 2 3) ; set-samples [17:5]:
(at 0, cp->sounds[10][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[11][0:2, 1.000]) [buf: 3]
@@ -5647,17 +4979,17 @@ EDITS: 5
(at 10, cp->sounds[9][0:9, 1.000]) [buf: 10]
(at 20, end_mark)
"))
- (snd-display #__line__ ";new 20: ~A" (safe-display-edits ind 0 17)))
- (set! (samples 0 12) (make-vct 12))
- (if (not (string-=? (safe-display-edits ind 0 18) "
+ (snd-display #__line__ ";new 20: ~A" (safe-display-edits ind 0 17)))
+ (set! (samples 0 12) (make-float-vector 12))
+ (if (not (string-=? (safe-display-edits ind 0 18) "
(set 0 12) ; set-samples [18:3]:
(at 0, cp->sounds[12][0:11, 1.000]) [buf: 12]
(at 12, cp->sounds[9][2:9, 1.000]) [buf: 10]
(at 20, end_mark)
"))
- (snd-display #__line__ ";new 21: ~A" (safe-display-edits ind 0 18)))
- (set! (samples 30 10) (make-vct 10))
- (if (not (string-=? (safe-display-edits ind 0 19) "
+ (snd-display #__line__ ";new 21: ~A" (safe-display-edits ind 0 18)))
+ (set! (samples 30 10) (make-float-vector 10))
+ (if (not (string-=? (safe-display-edits ind 0 19) "
(set 20 21) ; set-samples [19:5]:
(at 0, cp->sounds[12][0:11, 1.000]) [buf: 12]
(at 12, cp->sounds[9][2:9, 1.000]) [buf: 10]
@@ -5665,92 +4997,92 @@ EDITS: 5
(at 30, cp->sounds[13][0:9, 1.000]) [buf: 10]
(at 40, end_mark)
"))
- (snd-display #__line__ ";new 21: ~A" (safe-display-edits ind 0 19)))
- (close-sound ind))
-
- ;; scale/ramp
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 10)
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";new 21: ~A" (safe-display-edits ind 0 19)))
+ (close-sound ind))
+
+ ;; scale/ramp
+ (let ((ind (new-sound "test.snd")))
+ (map-channel (lambda (y) 1.0) 0 10)
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(scale 0 10) ; scale-channel 0.500 0 #f [2:2]:
(at 0, cp->sounds[1][0:9, 0.500]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 0: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (scale-channel 0.5 0 3)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";scl 0: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (scale-channel 0.5 0 3)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(scale 0 3) ; scale-channel 0.500 0 3 [2:3]:
(at 0, cp->sounds[1][0:2, 0.500]) [buf: 10]
(at 3, cp->sounds[1][3:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 1: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (scale-channel 0.5 5 5)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";scl 1: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (scale-channel 0.5 5 5)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(scale 5 5) ; scale-channel 0.500 5 5 [2:3]:
(at 0, cp->sounds[1][0:4, 1.000]) [buf: 10]
(at 5, cp->sounds[1][5:9, 0.500]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 2: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";scl 2: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (scale-channel 0.5 2 4)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(scale 2 4) ; scale-channel 0.500 2 4 [2:4]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:5, 0.500]) [buf: 10]
(at 6, cp->sounds[1][6:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 2a: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (scale-channel 0.5 10 10)
- (if (not (= (edit-position) 1))
- (snd-display #__line__ ";scale beyond end edited? ~A" (display-edits)))
- (scale-channel 0.5 100 10)
- (if (not (= (edit-position) 1))
- (snd-display #__line__ ";scale way beyond end edited? ~A" (display-edits)))
- (scale-channel 0.5 5 10)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";scl 2a: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (scale-channel 0.5 10 10)
+ (if (not (= (edit-position) 1))
+ (snd-display #__line__ ";scale beyond end edited? ~A" (display-edits)))
+ (scale-channel 0.5 100 10)
+ (if (not (= (edit-position) 1))
+ (snd-display #__line__ ";scale way beyond end edited? ~A" (display-edits)))
+ (scale-channel 0.5 5 10)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(scale 5 5) ; scale-channel 0.500 5 5 [2:3]:
(at 0, cp->sounds[1][0:4, 1.000]) [buf: 10]
(at 5, cp->sounds[1][5:9, 0.500]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 3: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";scl 3: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (set! (sample 4) .5)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(set 4 1) ; set-sample 4 0.5000 [2:4]:
(at 0, cp->sounds[1][0:3, 1.000]) [buf: 10]
(at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
(at 5, cp->sounds[1][5:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 4: ~A" (safe-display-edits ind 0 2)))
- (scale-channel 0.5 0 4)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";scl 4: ~A" (safe-display-edits ind 0 2)))
+ (scale-channel 0.5 0 4)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 4) ; scale-channel 0.500 0 4 [3:4]:
(at 0, cp->sounds[1][0:3, 0.500]) [buf: 10]
(at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
(at 5, cp->sounds[1][5:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 4 1)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";scl 5: ~A" (safe-display-edits ind 0 3)))
+ (scale-channel 0.5 4 1)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(scale 4 1) ; scale-channel 0.500 4 1 [4:4]:
(at 0, cp->sounds[1][0:3, 0.500]) [buf: 10]
(at 4, cp->sounds[2][0:0, 0.500]) [buf: 1]
(at 5, cp->sounds[1][5:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 6: ~A" (safe-display-edits ind 0 4)))
- (scale-channel 0.5 0 7)
- (if (not (string-=? (safe-display-edits ind 0 5) "
+ (snd-display #__line__ ";scl 6: ~A" (safe-display-edits ind 0 4)))
+ (scale-channel 0.5 0 7)
+ (if (not (string-=? (safe-display-edits ind 0 5) "
(scale 0 7) ; scale-channel 0.500 0 7 [5:5]:
(at 0, cp->sounds[1][0:3, 0.250]) [buf: 10]
(at 4, cp->sounds[2][0:0, 0.250]) [buf: 1]
@@ -5758,9 +5090,9 @@ EDITS: 5
(at 7, cp->sounds[1][7:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 7: ~A" (safe-display-edits ind 0 5)))
- (scale-channel 0.5 1 4)
- (if (not (string-=? (safe-display-edits ind 0 6) "
+ (snd-display #__line__ ";scl 7: ~A" (safe-display-edits ind 0 5)))
+ (scale-channel 0.5 1 4)
+ (if (not (string-=? (safe-display-edits ind 0 6) "
(scale 1 4) ; scale-channel 0.500 1 4 [6:6]:
(at 0, cp->sounds[1][0:0, 0.250]) [buf: 10]
(at 1, cp->sounds[1][1:3, 0.125]) [buf: 10]
@@ -5769,10 +5101,10 @@ EDITS: 5
(at 7, cp->sounds[1][7:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 8: ~A" (safe-display-edits ind 0 6)))
- (undo 4)
- (scale-channel 0.5 1 8)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";scl 8: ~A" (safe-display-edits ind 0 6)))
+ (undo 4)
+ (scale-channel 0.5 1 8)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 1 8) ; scale-channel 0.500 1 8 [3:6]:
(at 0, cp->sounds[1][0:0, 1.000]) [buf: 10]
(at 1, cp->sounds[1][1:3, 0.500]) [buf: 10]
@@ -5781,63 +5113,63 @@ EDITS: 5
(at 9, cp->sounds[1][9:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";scl 9: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";scl 9: ~A" (safe-display-edits ind 0 3)))
+ (undo 2)
+
+ (ramp-channel 0.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(ramp 0 10) ; ramp-channel 0.000 1.000 0 #f [2:2]:
(at 0, cp->sounds[1][0:9, 1.000, [1]-0.000 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 0: ~A" (safe-display-edits ind 0 2)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 0: ~A" (safe-display-edits ind 0 2)))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 10) ; scale-channel 0.500 0 #f [3:2]:
(at 0, cp->sounds[1][0:9, 0.500, [1]-0.000 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 1: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 1: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 5) ; scale-channel 0.500 0 5 [3:3]:
(at 0, cp->sounds[1][0:4, 0.500, [1]-0.000 -> 0.444]) [buf: 10]
(at 5, cp->sounds[1][5:9, 1.000, [1]0.556 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 2: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 2: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5 2 4)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 2 4) ; scale-channel 0.500 2 4 [3:4]:
(at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.111]) [buf: 10]
(at 2, cp->sounds[1][2:5, 0.500, [1]0.222 -> 0.556]) [buf: 10]
(at 6, cp->sounds[1][6:9, 1.000, [1]0.667 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 3: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5 5 5)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 3: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5 5 5)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 5 5) ; scale-channel 0.500 5 5 [3:3]:
(at 0, cp->sounds[1][0:4, 1.000, [1]-0.000 -> 0.444]) [buf: 10]
(at 5, cp->sounds[1][5:9, 0.500, [1]0.556 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 4: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
- (ramp-channel .2 .6 2 6)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";ramp 4: ~A" (safe-display-edits ind 0 3)))
+ (undo 2)
+ (ramp-channel .2 .6 2 6)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [2:4]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.600]) [buf: 10]
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 5: ~A" (safe-display-edits ind 0 2)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 5: ~A" (safe-display-edits ind 0 2)))
+ (scale-channel 0.5 0 5)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 5) ; scale-channel 0.500 0 5 [3:5]:
(at 0, cp->sounds[1][0:1, 0.500]) [buf: 10]
(at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.360]) [buf: 10]
@@ -5845,20 +5177,20 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 6: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5 2 6)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 6: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5 2 6)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 2 6) ; scale-channel 0.500 2 6 [3:4]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:7, 0.500, [1]0.200 -> 0.600]) [buf: 10]
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 7: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5 5 4)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 7: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5 5 4)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 5 4) ; scale-channel 0.500 5 4 [3:6]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:4, 1.000, [1]0.200 -> 0.360]) [buf: 10]
@@ -5867,10 +5199,10 @@ EDITS: 5
(at 9, cp->sounds[1][9:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 8: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 8: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (set! (sample 4) .5)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(set 4 1) ; set-sample 4 0.5000 [3:6]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
@@ -5879,10 +5211,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 9: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5 4 1)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 9: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5 4 1)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 4 1) ; scale-channel 0.500 4 1 [3:6]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
@@ -5891,10 +5223,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 10: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (delete-sample 4)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 10: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (delete-sample 4)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 4 1) ; delete-samples 4 1 [3:5]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
@@ -5902,10 +5234,10 @@ EDITS: 5
(at 7, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 9, end_mark)
"))
- (snd-display #__line__ ";ramp 11: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (delete-samples 4 2)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 11: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (delete-samples 4 2)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 4 2) ; delete-samples 4 2 [3:5]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
@@ -5913,10 +5245,10 @@ EDITS: 5
(at 6, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 8, end_mark)
"))
- (snd-display #__line__ ";ramp 12: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (delete-samples 4 3)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 12: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (delete-samples 4 3)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 4 3) ; delete-samples 4 3 [3:5]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
@@ -5924,30 +5256,30 @@ EDITS: 5
(at 5, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 7, end_mark)
"))
- (snd-display #__line__ ";ramp 13: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (delete-samples 4 4)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 13: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (delete-samples 4 4)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 4 4) ; delete-samples 4 4 [3:4]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
(at 4, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 6, end_mark)
"))
- (snd-display #__line__ ";ramp 14: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (delete-samples 4 5)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 14: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (delete-samples 4 5)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 4 5) ; delete-samples 4 5 [3:4]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
(at 4, cp->sounds[1][9:9, 1.000]) [buf: 10]
(at 5, end_mark)
"))
- (snd-display #__line__ ";ramp 15: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5 4 2)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 15: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5 4 2)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 4 2) ; scale-channel 0.500 4 2 [3:6]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
@@ -5956,10 +5288,10 @@ EDITS: 5
(at 8, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";ramp 16: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (pad-channel 4 1)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";ramp 16: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (pad-channel 4 1)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(silence 4 1) ; pad-channel [3:6]:
(at 0, cp->sounds[1][0:1, 1.000]) [buf: 10]
(at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280]) [buf: 10]
@@ -5968,204 +5300,208 @@ EDITS: 5
(at 9, cp->sounds[1][8:9, 1.000]) [buf: 10]
(at 11, end_mark)
"))
- (snd-display #__line__ ";ramp 17: ~A" (safe-display-edits ind 0 3)))
- (close-sound ind))
-
- ;; xramp
- (let ((ind (new-sound "test.snd"))) ; 2nd main let
- (map-channel (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";ramp 17: ~A" (safe-display-edits ind 0 3)))
+ (close-sound ind))
+
+ ;; xramp
+ (let ((ind (new-sound "test.snd"))) ; second main let
+ (map-channel (lambda (y) 1.0) 0 10)
+ (xramp-channel 0.0 1.0 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(ramp 0 10) ; xramp-channel 0.000 1.000 32.000 0 #f [2:2]:
(at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 1: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (xramp-channel 0.0 1.0 0.325)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";xramp 1: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (xramp-channel 0.0 1.0 0.325)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(ramp 0 10) ; xramp-channel 0.000 1.000 0.325 0 #f [2:2]:
(at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 1.000, off: 1.481, scl: -1.481]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 2: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (xramp-channel 0.0 1.0 0.0)
- (if (not (string-=? (safe-display-edits ind 0 2) (string-append "
+ (snd-display #__line__ ";xramp 2: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (xramp-channel 0.0 1.0 0.0)
+ (if (not (string-=? (safe-display-edits ind 0 2) (string-append "
(scale 0 10) ; scale-channel 0.000 0 #f [2:2]:
(at 0, cp->sounds[0][0:9, 0.000]) [file: " (getcwd) "/test.snd[0]]
(at 10, end_mark)
")))
- (snd-display #__line__ ";xramp 3: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (xramp-channel 0.0 1.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";xramp 3: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (xramp-channel 0.0 1.0 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(ramp 0 10) ; ramp-channel 0.000 1.000 0 #f [2:2]:
(at 0, cp->sounds[1][0:9, 1.000, [1]-0.000 -> 1.000]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 4: ~A" (safe-display-edits ind 0 2)))
- (undo)
- (xramp-channel 0.5 1.5 32.0)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";xramp 4: ~A" (safe-display-edits ind 0 2)))
+ (undo)
+ (xramp-channel 0.5 1.5 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(ramp 0 10) ; xramp-channel 0.500 1.500 32.000 0 #f [2:2]:
(at 0, cp->sounds[1][0:9, 1.000, [1]0.500 -> 1.500, off: 0.468, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 5: ~A" (safe-display-edits ind 0 2)))
- (if (or (fneq (maxamp) 1.5) (fneq (sample 0) 0.5))
- (snd-display #__line__ ";xramp 5 vals: ~A ~A" (maxamp) (sample 0)))
- (undo)
- (xramp-channel -0.5 1.5 32.0)
- (if (not (string-=? (safe-display-edits ind 0 2) "
+ (snd-display #__line__ ";xramp 5: ~A" (safe-display-edits ind 0 2)))
+ (if (or (fneq (maxamp) 1.5) (fneq (sample 0) 0.5))
+ (snd-display #__line__ ";xramp 5 vals: ~A ~A" (maxamp) (sample 0)))
+ (undo)
+ (xramp-channel -0.5 1.5 32.0)
+ (if (not (string-=? (safe-display-edits ind 0 2) "
(ramp 0 10) ; xramp-channel -0.500 1.500 32.000 0 #f [2:2]:
(at 0, cp->sounds[1][0:9, 1.000, [1]-0.500 -> 1.500, off: -0.565, scl: 0.065]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 6: ~A" (safe-display-edits ind 0 2)))
- (if (or (fneq (maxamp) 1.5) (fneq (sample 0) -0.5))
- (snd-display #__line__ ";xramp 6 vals: ~A ~A" (maxamp) (sample 0)))
- (undo)
- (xramp-channel 0.0 1.0 32.0)
- (let ((vals (channel->vct))
- (ctr 0))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 6: ~A" (safe-display-edits ind 0 2)))
+ (if (or (fneq (maxamp) 1.5) (fneq (sample 0) -0.5))
+ (snd-display #__line__ ";xramp 6 vals: ~A ~A" (maxamp) (sample 0)))
+ (undo)
+ (xramp-channel 0.0 1.0 32.0)
+ (let ((vals (channel->float-vector))
+ (ctr 0))
+ (scale-channel 0.5)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 10) ; scale-channel 0.500 0 #f [3:2]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 7: ~A" (safe-display-edits ind 0 3)))
- (set! ctr 0)
- (let ((baddy (scan-chan (lambda (y) (if (fneq y (* 0.5 (vct-ref vals ctr))) #t (begin (set! ctr (+ 1 ctr)) #f))))))
- (if baddy (snd-display #__line__ ";trouble in xramp 7: ~A" baddy)))
- (undo)
- (delete-sample 0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 7: ~A" (safe-display-edits ind 0 3)))
+ (set! ctr 0)
+ (let ((p (make-one-pole 1.0 -1.0)))
+ (let ((baddy (scan-channel (lambda (y) (fneq y (* 0.5 (float-vector-ref vals (floor (- (one-pole p 1.0) 1.0)))))))))
+ (if baddy (snd-display #__line__ ";trouble in xramp 7: ~A" baddy))))
+ (undo)
+ (delete-sample 0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 0 1) ; delete-samples 0 1 [3:2]:
(at 0, cp->sounds[1][1:9, 1.000, [1]0.015 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 9, end_mark)
"))
- (snd-display #__line__ ";xramp 8: ~A" (safe-display-edits ind 0 3)))
- (set! ctr 1)
- (let ((baddy (scan-chan (lambda (y) (if (fneq y (vct-ref vals ctr)) #t (begin (set! ctr (+ 1 ctr)) #f))))))
- (if baddy (snd-display #__line__ ";trouble in xramp 8: ~A" baddy)))
- (undo)
- (delete-samples 0 2)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 8: ~A" (safe-display-edits ind 0 3)))
+ (set! ctr 1)
+ (let ((p (make-one-pole 1.0 -1.0)))
+ (let ((baddy (scan-channel (lambda (y) (fneq y (float-vector-ref vals (floor (one-pole p 1.0))))))))
+ (if baddy (snd-display #__line__ ";trouble in xramp 8: ~A" baddy))))
+ (undo)
+ (delete-samples 0 2)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 0 2) ; delete-samples 0 2 [3:2]:
(at 0, cp->sounds[1][2:9, 1.000, [1]0.037 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 8, end_mark)
"))
- (snd-display #__line__ ";xramp 9: ~A" (safe-display-edits ind 0 3)))
- (set! ctr 2)
- (let ((baddy (scan-chan (lambda (y) (if (fneq y (vct-ref vals ctr)) #t (begin (set! ctr (+ 1 ctr)) #f))))))
- (if baddy (snd-display #__line__ ";trouble in xramp 9: ~A" baddy)))
- (undo)
- (delete-sample 0)
- (delete-sample 0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp 9: ~A" (safe-display-edits ind 0 3)))
+ (set! ctr 2)
+ (let ((p (make-one-pole 1.0 -1.0)))
+ (one-pole p 1.0)
+ (let ((baddy (scan-channel (lambda (y) (fneq y (float-vector-ref vals (floor (one-pole p 1.0))))))))
+ (if baddy (snd-display #__line__ ";trouble in xramp 9: ~A" baddy))))
+ (undo)
+ (delete-sample 0)
+ (delete-sample 0)
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(delete 0 1) ; delete-samples 0 1 [4:2]:
(at 0, cp->sounds[1][2:9, 1.000, [1]0.037 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 8, end_mark)
"))
- (snd-display #__line__ ";xramp 10: ~A" (safe-display-edits ind 0 4)))
- (undo 2)
- (delete-sample 4)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 10: ~A" (safe-display-edits ind 0 4)))
+ (undo 2)
+ (delete-sample 4)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 4 1) ; delete-samples 4 1 [3:3]:
(at 0, cp->sounds[1][0:3, 1.000, [1]0.000 -> 0.070, off: -0.032, scl: 0.032]) [buf: 10]
(at 4, cp->sounds[1][5:9, 1.000, [1]0.189 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 9, end_mark)
"))
- (snd-display #__line__ ";xramp 11: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (delete-samples 4 2)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 11: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (delete-samples 4 2)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(delete 4 2) ; delete-samples 4 2 [3:3]:
(at 0, cp->sounds[1][0:3, 1.000, [1]0.000 -> 0.070, off: -0.032, scl: 0.032]) [buf: 10]
(at 4, cp->sounds[1][6:9, 1.000, [1]0.293 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 8, end_mark)
"))
- (snd-display #__line__ ";xramp 12: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5 4 2)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 12: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5 4 2)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 4 2) ; scale-channel 0.500 4 2 [3:4]:
(at 0, cp->sounds[1][0:3, 1.000, [1]0.000 -> 0.070, off: -0.032, scl: 0.032]) [buf: 10]
(at 4, cp->sounds[1][4:5, 0.500, [1]0.118 -> 0.189, off: -0.032, scl: 0.032]) [buf: 10]
(at 6, cp->sounds[1][6:9, 1.000, [1]0.293 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 13: ~A" (safe-display-edits ind 0 3)))
- (set! ctr 0)
- (let ((baddy (scan-chan (lambda (y)
- (if (or (and (> ctr 5) (fneq y (vct-ref vals ctr)))
- (and (< ctr 4) (fneq y (vct-ref vals ctr)))
- (and (or (= ctr 4) (= ctr 5)) (fneq y (* 0.5 (vct-ref vals ctr)))))
- #t
- (begin (set! ctr (+ 1 ctr)) #f))))))
- (if baddy (snd-display #__line__ ";trouble in xramp 8: ~A" baddy)))
- (undo)
- (scale-channel 0.5 0 2)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 13: ~A" (safe-display-edits ind 0 3)))
+ (set! ctr 0)
+ (let ((baddy (scan-channel (lambda (y)
+ (if (or (and (> ctr 5) (fneq y (vals ctr)))
+ (and (< ctr 4) (fneq y (vals ctr)))
+ (and (or (= ctr 4) (= ctr 5)) (fneq y (* 0.5 (vals ctr)))))
+ #t
+ (begin (set! ctr (+ ctr 1)) #f))))))
+ (if baddy (snd-display #__line__ ";trouble in xramp 8: ~A" baddy)))
+ (undo)
+ (scale-channel 0.5 0 2)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(scale 0 2) ; scale-channel 0.500 0 2 [3:3]:
(at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.015, off: -0.032, scl: 0.032]) [buf: 10]
(at 2, cp->sounds[1][2:9, 1.000, [1]0.037 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 14: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (pad-channel 4 2)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 14: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (pad-channel 4 2)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(silence 4 2) ; pad-channel [3:4]:
(at 0, cp->sounds[1][0:3, 1.000, [1]0.000 -> 0.070, off: -0.032, scl: 0.032]) [buf: 10]
(at 4, cp->sounds[-1][0:1, 0.000])
(at 6, cp->sounds[1][4:9, 1.000, [1]0.118 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 12, end_mark)
"))
- (snd-display #__line__ ";xramp 15: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (set! (sample 4) 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 15: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (set! (sample 4) 1.0)
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(set 4 1) ; set-sample 4 1.0000 [3:4]:
(at 0, cp->sounds[1][0:3, 1.000, [1]0.000 -> 0.070, off: -0.032, scl: 0.032]) [buf: 10]
(at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
(at 5, cp->sounds[1][5:9, 1.000, [1]0.189 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 16: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (set! (samples 4 2) (make-vct 2))
- (if (not (string-=? (safe-display-edits ind 0 3) "
+ (snd-display #__line__ ";xramp 16: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (set! (samples 4 2) (make-float-vector 2))
+ (if (not (string-=? (safe-display-edits ind 0 3) "
(set 4 2) ; set-samples [3:4]:
(at 0, cp->sounds[1][0:3, 1.000, [1]0.000 -> 0.070, off: -0.032, scl: 0.032]) [buf: 10]
(at 4, cp->sounds[2][0:1, 1.000]) [buf: 2]
(at 6, cp->sounds[1][6:9, 1.000, [1]0.293 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 17: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-channel 0.5)
- (set! (samples 4 2) (make-vct 2))
- (if (not (string-=? (safe-display-edits ind 0 4) "
+ (snd-display #__line__ ";xramp 17: ~A" (safe-display-edits ind 0 3)))
+ (undo)
+ (scale-channel 0.5)
+ (set! (samples 4 2) (make-float-vector 2))
+ (if (not (string-=? (safe-display-edits ind 0 4) "
(set 4 2) ; set-samples [4:4]:
(at 0, cp->sounds[1][0:3, 0.500, [1]0.000 -> 0.070, off: -0.032, scl: 0.032]) [buf: 10]
(at 4, cp->sounds[2][0:1, 1.000]) [buf: 2]
(at 6, cp->sounds[1][6:9, 0.500, [1]0.293 -> 1.000, off: -0.032, scl: 0.032]) [buf: 10]
(at 10, end_mark)
"))
- (snd-display #__line__ ";xramp 18: ~A" (safe-display-edits ind 0 4)))
- )
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd"))) ; 3rd
- (map-channel (lambda (y) 1.0) 0 100)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (if (not (string=? (safe-display-edits ind 0 12) "
+ (snd-display #__line__ ";xramp 18: ~A" (safe-display-edits ind 0 4)))
+ )
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd"))) ; third
+ (map-channel (lambda (y) 1.0) 0 100)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (ramp-channel 0.0 1.0)
+ (if (not (string=? (safe-display-edits ind 0 12) "
(ramp 0 100) ; ramp-channel 0.000 1.000 0 #f [12:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192]) [buf: 100]
@@ -6179,11 +5515,11 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display #__line__ ";multi-ramp 1: ~A" (safe-display-edits ind 0 12)))
- (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 1 maxamp: ~A" (maxamp)))
- (undo)
- (ramp-channel 0.1 1.0 10 90)
- (if (not (string=? (safe-display-edits ind 0 12) "
+ (snd-display #__line__ ";multi-ramp 1: ~A" (safe-display-edits ind 0 12)))
+ (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 1 maxamp: ~A" (maxamp)))
+ (undo)
+ (ramp-channel 0.1 1.0 10 90)
+ (if (not (string=? (safe-display-edits ind 0 12) "
(ramp 10 90) ; ramp-channel 0.100 1.000 10 90 [12:11]:
(at 0, cp->sounds[1][0:9, 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.100 -> 0.191]) [buf: 100]
@@ -6197,11 +5533,11 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display #__line__ ";multi-ramp 2: ~A" (safe-display-edits ind 0 12)))
- (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 2 maxamp: ~A" (maxamp)))
- (undo)
- (ramp-channel 0.0 0.9 0 90)
- (if (not (string=? (safe-display-edits ind 0 12) "
+ (snd-display #__line__ ";multi-ramp 2: ~A" (safe-display-edits ind 0 12)))
+ (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 2 maxamp: ~A" (maxamp)))
+ (undo)
+ (ramp-channel 0.0 0.9 0 90)
+ (if (not (string=? (safe-display-edits ind 0 12) "
(ramp 0 90) ; ramp-channel 0.000 0.900 0 90 [12:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192]) [buf: 100]
@@ -6215,13 +5551,13 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display #__line__ ";multi-ramp 3: ~A" (safe-display-edits ind 0 12)))
- (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 3 maxamp: ~A" (maxamp)))
- (if (fneq (sample 89) 0.45) (snd-display #__line__ ";multi ramp 3 sample 89: ~A" (sample 89)))
- (if (fneq (sample 90) 0.5) (snd-display #__line__ ";multi ramp 3 sample 90: ~A" (sample 90)))
- (undo)
- (ramp-channel 0.1 0.9 10 80)
- (if (not (string=? (safe-display-edits ind 0 12) "
+ (snd-display #__line__ ";multi-ramp 3: ~A" (safe-display-edits ind 0 12)))
+ (if (fneq (maxamp) 0.5) (snd-display #__line__ ";multi ramp 3 maxamp: ~A" (maxamp)))
+ (if (fneq (sample 89) 0.45) (snd-display #__line__ ";multi ramp 3 sample 89: ~A" (sample 89)))
+ (if (fneq (sample 90) 0.5) (snd-display #__line__ ";multi ramp 3 sample 90: ~A" (sample 90)))
+ (undo)
+ (ramp-channel 0.1 0.9 10 80)
+ (if (not (string=? (safe-display-edits ind 0 12) "
(ramp 10 80) ; ramp-channel 0.100 0.900 10 80 [12:11]:
(at 0, cp->sounds[1][0:9, 0.500]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.100 -> 0.191]) [buf: 100]
@@ -6235,14 +5571,14 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display #__line__ ";multi-ramp 4: ~A" (safe-display-edits ind 0 12)))
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (ramp-channel 0.0 1.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string=? (safe-display-edits ind 0 12) "
+ (snd-display #__line__ ";multi-ramp 4: ~A" (safe-display-edits ind 0 12)))
+ (revert-sound)
+ (map-channel (lambda (y) 1.0) 0 100)
+ (ramp-channel 0.0 1.0)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (scale-channel 0.5 (* i 10) 10))
+ (if (not (string=? (safe-display-edits ind 0 12) "
(scale 90 10) ; scale-channel 0.500 90 10 [12:11]:
(at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091]) [buf: 100]
(at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192]) [buf: 100]
@@ -6256,8194 +5592,3836 @@ EDITS: 5
(at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
(at 100, end_mark)
"))
- (snd-display #__line__ ";multi-ramp 5: ~A" (safe-display-edits ind 0 12)))
- (close-sound ind))
+ (snd-display #__line__ ";multi-ramp 5: ~A" (safe-display-edits ind 0 12)))
+ (close-sound ind))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (if (not (= (redo 1 ind 0) 0)) (snd-display #__line__ ";open redo with no ops: ~A" (redo)))
+ (if (not (= (undo 1 ind 0) 0)) (snd-display #__line__ ";open undo with no ops: ~A" (undo)))
+ (set! (cursor) 1000)
+ (delete-sample 321)
+ (if (not (= (cursor) 999)) (snd-display #__line__ ";delete-sample before cursor: ~A" (cursor)))
+ (if (not (= (cursor ind 0 0) 1000)) (snd-display #__line__ ";delete-sample before cursor (0): ~A" (cursor ind 0 0)))
+ (undo)
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-sample after cursor undo: ~A" (cursor)))
+ (undo -1)
+ (if (not (= (cursor) 999)) (snd-display #__line__ ";delete-sample before cursor redo: ~A" (cursor)))
+ (redo -1)
+ (delete-sample 1321)
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-sample after cursor: ~A" (cursor)))
+ (undo)
+ (delete-samples 0 100)
+ (if (not (= (cursor) 900)) (snd-display #__line__ ";delete-samples before cursor: ~A" (cursor)))
+ (undo)
+ (delete-samples 1100 100)
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-samples after cursor: ~A" (cursor)))
+ (undo)
+ (insert-samples 100 100 (make-float-vector 100))
+ (if (not (= (cursor) 1100)) (snd-display #__line__ ";insert-samples before cursor: ~A" (cursor)))
+ (undo)
+ (insert-samples 1100 100 (make-float-vector 100))
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";insert-samples after cursor: ~A" (cursor)))
+ (undo)
+ (set! (samples 0 100) (make-float-vector 100))
+ (if (not (= (cursor) 1000)) (snd-display #__line__ ";set-samples cursor: ~A" (cursor)))
+ (set! (show-axes ind 0) show-x-axis-unlabelled)
+ (update-time-graph)
+ (set! (show-axes ind 0) show-all-axes-unlabelled)
+ (update-time-graph)
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd" :size 100)))
+ (float-vector->channel (make-float-vector 3 1.0) 10 8)
+ (if (fneq (maxamp ind 0) 1.0)
+ (snd-display #__line__ ";float-vector->channel size mismatch maxamp: ~A" (maxamp ind 0)))
+ (if (not (vequal (channel->float-vector 0 20 ind 0)
+ (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";float-vector->channel size mismatch: ~A" (channel->float-vector 0 20 ind 0)))
+ (revert-sound ind)
+ (set! (samples 10 5) (make-float-vector 3 1.0))
+ (if (fneq (maxamp ind 0) 1.0)
+ (snd-display #__line__ ";set samples size mismatch maxamp: ~A" (maxamp ind 0)))
+ (if (not (vequal (channel->float-vector 0 20 ind 0)
+ (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";set samples size mismatch: ~A" (channel->float-vector 0 20 ind 0)))
+ (revert-sound ind)
+ (insert-samples 10 8 (make-float-vector 3 1.0) ind 0)
+ (if (fneq (maxamp ind 0) 1.0)
+ (snd-display #__line__ ";insert samples size mismatch maxamp: ~A" (maxamp ind 0)))
+ (if (not (vequal (channel->float-vector 0 20 ind 0)
+ (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";insert samples size mismatch: ~A" (channel->float-vector 0 20 ind 0)))
+ (close-sound ind))
+
+ (let* ((index (open-sound "oboe.snd"))
+ (bnds (x-bounds index))
+ (xp (x-position-slider))
+ (yp (y-position-slider))
+ (xz (x-zoom-slider))
+ (yz (y-zoom-slider)))
+ (if (not (string=? (snd-completion " open-so") " open-sound"))
+ (snd-display #__line__ ";completion: ~A" (snd-completion " open-so")))
+ ; (if (not (string=? (snd-completion " open-sound") " open-sound"))
+ ; (snd-display #__line__ ";completion: ~A" (snd-completion " open-so")))
+ (if (not (string=? (snd-completion " zoom-focus-r") " zoom-focus-right"))
+ (snd-display #__line__ ";completion: ~A" (snd-completion " zoom-focus-r")))
+ (play "oboe.snd" :wait #t)
+ (play "oboe.snd" :start 12000 :wait #t)
+ (play "oboe.snd" :start 12000 :end 15000 :wait #t)
+ (play :edit-position (- (edit-position) 1) :wait #t)
+ (let ((old-speed (speed-control index))
+ (old-style *speed-control-style*)
+ (old-open (show-controls index)))
+ (set! (show-controls index) #t)
+ (set! (speed-control index) -2.0)
+ (play index :start 12345 :wait #t)
+ (set! *speed-control-style* speed-control-as-semitone)
+ (set! (speed-control index) 0.5)
+ (set! *speed-control-style* speed-control-as-ratio)
+ (set! (speed-control index) 0.25)
+ (set! (speed-control index) old-speed)
+ (set! *speed-control-style* old-style)
+ (set! (show-controls index) old-open))
+ (let ((k (disk-kspace "oboe.snd")))
+ (if (or (not (number? k))
+ (<= k 0))
+ (snd-display #__line__ ";disk-kspace = ~A" (disk-kspace "oboe.snd")))
+ (set! k (disk-kspace "/baddy/hiho"))
+ (if (not (= k -1))
+ (snd-display #__line__ ";disk-kspace of bogus file = ~A" (disk-kspace "/baddy/hiho"))))
+ (if (not (= (transform-framples) 0)) (snd-display #__line__ ";transform-framples ~A?" (transform-framples)))
+ (set! *transform-size* 512)
+
+ (set! (transform-graph?) #t)
+ (set! (time-graph?) #t)
+
+ (if with-gui
+ (catch #t
+ (lambda ()
+ (if (not (string=? (x-axis-label) "time"))
+ (snd-display #__line__ ";def time x-axis-label: ~A" (x-axis-label)))
+ (set! (x-axis-label index 0 time-graph) "no time")
+ (if (not (string=? (x-axis-label) "no time"))
+ (snd-display #__line__ ";time x-axis-label: ~A" (x-axis-label index 0 time-graph)))
+
+ (update-transform-graph)
+ (if (not (string=? (x-axis-label index 0 transform-graph) "frequency"))
+ (snd-display #__line__ ";get fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
+ (set! (x-axis-label index 0 transform-graph) "hiho")
+ (update-transform-graph)
+ (if (not (string=? (x-axis-label index 0 transform-graph) "hiho"))
+ (snd-display #__line__ ";set fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
+ (set! (x-axis-label index 0 transform-graph) "frequency") ; for later test
+
+ (graph '(0 0 1 1 2 0) "lisp")
+ (update-lisp-graph)
+ (if (not (string=? (x-axis-label index 0 lisp-graph) "lisp"))
+ (snd-display #__line__ ";def lisp x-axis-label: ~A" (x-axis-label index 0 lisp-graph)))
+ (set! (x-axis-label index 0 lisp-graph) "no lisp")
+ (if (not (string=? (x-axis-label index 0 lisp-graph) "no lisp"))
+ (snd-display #__line__ ";lisp x-axis-label: ~A" (x-axis-label index 0 lisp-graph)))
+
+ (set! (y-axis-label index 0 time-graph) "no amp")
+ (if (not (string=? (y-axis-label) "no amp"))
+ (snd-display #__line__ ";time y-axis-label: ~A" (y-axis-label index 0 time-graph)))
+ (set! (y-axis-label index 0 lisp-graph) "no lamp")
+ (if (not (string=? (y-axis-label index 0 lisp-graph) "no lamp"))
+ (snd-display #__line__ ";lisp y-axis-label: ~A" (y-axis-label index 0 lisp-graph)))
+ (set! (y-axis-label) #f)
+ (set! (y-axis-label index 0) "no amp")
+ (if (not (string=? (y-axis-label) "no amp"))
+ (snd-display #__line__ ";time y-axis-label (time): ~A" (y-axis-label index 0 time-graph)))
+ (set! (y-axis-label index) #f))
+ (lambda args (snd-display #__line__ ";axis label error: ~A" args))))
+
+ (if with-gui
+ (begin
+ (let ((cr (make-cairo (car (channel-widgets index 0)))))
+ (graph-data (make-float-vector 4) index 0 copy-context #f #f graph-lines cr)
+ (free-cairo cr)
+ (update-lisp-graph))
+ (graph (float-vector 0 0 1 1 2 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 32))
+ (graph (float-vector 0 1 2))
+ (graph (list (float-vector 0 1 2) (float-vector 3 2 1) (float-vector 1 2 3)))
+ (graph (list (float-vector 0 1 2) (float-vector 3 2 1))))
+ (set! (x-bounds) (list 0.0 0.01))
+ (let ((data (make-graph-data)))
+ (if (float-vector? data)
+ (let ((mid (round (* .5 (length data)))))
+ (if (not (= (length data) (+ 1 (- (right-sample) (left-sample)))))
+ (snd-display #__line__ ";make-graph-data bounds: ~A ~A -> ~A" (left-sample) (right-sample) (length data)))
+ (if (fneq (data mid)
+ (sample (+ (left-sample) mid)))
+ (snd-display #__line__ ";make-graph-data[~D]: ~A ~A" mid (data mid) (sample (+ (left-sample) mid)))))))
+ (let ((data (make-graph-data index 0 0 100 199)))
+ (if (float-vector? data)
+ (begin
+ (if (not (= (length data) 100))
+ (snd-display #__line__ ";make-graph-data 100:199: ~A" (length data)))
+ (if (fneq (data 50) (sample 50))
+ (snd-display #__line__ ";make-graph-data 50: ~A ~A" (data 50) (sample 50))))))
+ (set! (x-bounds) (list 0.0 0.1))
+ (update-transform-graph)
+ (catch 'no-such-axis
+ (lambda ()
+ (if (not (string=? (x-axis-label index 0 transform-graph) "frequency"))
+ (snd-display #__line__ ";def fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
+ (set! (x-axis-label index 0 transform-graph) "fourier")
+ (if (not (string=? (x-axis-label index 0 transform-graph) "fourier"))
+ (snd-display #__line__ ";fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
+ (set! (x-axis-label) "hiho")
+
+ (set! (y-axis-label index 0 transform-graph) "spectra")
+ (let ((val (y-axis-label index 0 transform-graph)))
+ (if (or (not (string? val))
+ (not (string=? val "spectra")))
+ (snd-display #__line__ ";fft y-axis-label: ~A" val)))
+ (set! (y-axis-label) "hiho"))
+ (lambda args (snd-display #__line__ ";transform axis not displayed?")))
+ ))
+ (if (and (number? (transform-framples))
+ (= (transform-framples) 0))
+ (snd-display #__line__ ";transform-graph? transform-framples ~A?" (transform-framples)))
+ (update-transform-graph)
+ (let ((tag (catch #t (lambda () (peaks "/baddy/hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'cant-open-file)) (snd-display #__line__ ";peaks bad file: ~A" tag)))
+ (peaks "tmp.peaks")
+ (let ((p (open-input-file "tmp.peaks")))
+ (if (not p)
+ (snd-display #__line__ ";peaks->tmp.peaks failed?")
+ (let ((line (read-line p)))
+ (if (or (not (string? line))
+ (not (string=? "Snd: fft peaks" (substring line 0 14))))
+ (snd-display #__line__ ";peaks 1: ~A?" line))
+ (set! line (read-line p))
+ (set! line (read-line p))
+ (if (and (not (eof-object? line))
+ (or (not (string? line))
+ (and (not (string=? "oboe.snd, fft 512 points beginning at sample 0 (0.000 secs), Blackman2" line))
+ (not (string=? (string-append "oboe.snd, fft 512 points beginning at sample 0 (0.000 secs), Blackman2" (string #\newline)) line)))))
+ (snd-display #__line__ ";peaks 2: ~A?" line))
+ (set! line (read-line p))
+ (set! line (read-line p))
+ (close-input-port p))))
+ (delete-file "tmp.peaks")
+ (peaks)
+ (if (and (provided? 'xm)
+ (or (not ((dialog-widgets) 15))
+ (not ((*motif* 'XtIsManaged) ((dialog-widgets) 15)))))
+ (snd-display #__line__ ";peaks but no help?"))
+ (dismiss-all-dialogs)
+ (let ((num-transforms 6)
+ (num-transform-graph-types 3))
+ (set! (transform-graph? index 0) #t)
+ (set! (transform-size index 0) 64)
+ (do ((i 0 (+ i 1)))
+ ((= i num-transforms))
+ (set! *transform-type* (integer->transform i))
+ (if (not (transform? (integer->transform i))) (snd-display #__line__ ";transform? ~A?" i))
+ (do ((j 0 (+ j 1)))
+ ((= j num-transform-graph-types))
+ (set! (transform-graph-type index 0) j)
+ (update-transform-graph index 0))))
+ (set! *transform-type* fourier-transform)
+ (if (not (transform? *transform-type*)) (snd-display #__line__ ";transform? ~A ~A?" *transform-type* fourier-transform))
+ (if (not (transform? autocorrelation)) (snd-display #__line__ ";transform? autocorrelation"))
+
+ (if (read-only index) (snd-display #__line__ ";read-only open-sound: ~A?" (read-only index)))
+ (set! (read-only index) #t)
+ (if (not (read-only index)) (snd-display #__line__ ";set-read-only: ~A?" (read-only index)))
+ (bind-key #\a 0 (lambda () (set! a-ctr 3)))
+ (key (char->integer #\a) 0)
+ (if (not (= a-ctr 3)) (snd-display #__line__ ";bind-key: ~A?" a-ctr))
+ (let ((str (with-output-to-string (lambda () (display (procedure-source (key-binding (char->integer #\a) 0)))))))
+ (if (not (string=? str "(lambda () (set! a-ctr 3))"))
+ (snd-display #__line__ ";key-binding: ~A?" str)))
+ (unbind-key (char->integer #\a) 0)
+ (set! a-ctr 0)
+ (key (char->integer #\a) 0)
+ (do ((i 0 (+ i 1)))
+ ((= i 5))
+ (let ((psf *eps-file*))
+ (if (and psf (string? psf))
+ (begin
+ (if (file-exists? psf) (delete-file psf))
+ (set! *graph-style* i)
+ (graph->ps)
+ (if (not (file-exists? psf))
+ (snd-display #__line__ ";graph->ps: ~A?" psf)
+ (delete-file psf))))))
+ (let ((err (catch 'cannot-print
+ (lambda ()
+ (graph->ps "/bad/bad.eps"))
+ (lambda args 12345))))
+ (if (not (= err 12345)) (snd-display #__line__ ";graph->ps err: ~A?" err)))
+ (when with-gui
+ (let ((n2 (or (open-sound "2.snd") (open-sound "4.aiff"))))
+ (set! (transform-graph? n2) #t)
+ (set! (channel-style n2) channels-superimposed)
+ (if (not (= (channel-style n2) channels-superimposed)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-superimposed (channel-style n2)))
+ (graph->ps "aaa.eps")
+ (set! (channel-style n2) channels-combined)
+ (if (not (= (channel-style n2) channels-combined)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-combined (channel-style n2)))
+ (graph->ps "aaa.eps")
+ (set! (channel-style n2) channels-separate)
+ (if (not (= (channel-style n2) channels-separate)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-separate (channel-style n2)))
+ (graph->ps "aaa.eps")
+ (close-sound n2)))
+ (if (= (channels index) 1)
+ (begin
+ (set! (channel-style index) channels-superimposed)
+ (if (not (= (channel-style index) channels-separate)) (snd-display #__line__ ";channel-style[0]->~D: ~A?" channels-separate (channel-style index)))))
+ (set! (sync index) 32)
+ (if (not (= (sync index) 32)) (snd-display #__line__ ";sync->32: ~A?" (sync index)))
+ (if (< (sync-max) 32) (snd-display #__line__ ";sync-max 32: ~A" (sync-max)))
+ (set! (sync index) 0)
+ (set! (channel-sync index 0) 12)
+ (if (not (= (channel-sync index 0) 12)) (snd-display #__line__ ";sync-chn->12: ~A?" (channel-sync index 0)))
+ (set! (channel-sync index 0) 0)
+ (if (not (= a-ctr 0)) (snd-display #__line__ ";unbind-key: ~A?" a-ctr))
+ (if (fneq xp 0.0) (snd-display #__line__ ";x-position-slider: ~A?" xp))
+ (if (fneq yp 0.0) (snd-display #__line__ ";y-position-slider: ~A?" yp))
+ (if (and (fneq xz 0.04338) (fneq xz 1.0)) (snd-display #__line__ ";x-zoom-slider: ~A?" xz))
+ (if (fneq yz 1.0) (snd-display #__line__ ";y-zoom-slider: ~A?" yz))
+ (if (and (or (fneq (car bnds) 0.0) (fneq (cadr bnds) 0.1))
+ (or (fneq (car bnds) 0.0) (fneq (cadr bnds) 2.305))) ; open-hook from ~/.snd*
+ (snd-display #__line__ ";x-bounds: ~A?" bnds))
+ (if (not (equal? (find-sound "oboe.snd") index)) (snd-display #__line__ ";oboe: index ~D is not ~D?" (find-sound "oboe.snd") index))
+ (if (not (sound? index)) (snd-display #__line__ ";oboe: ~D not ok?" index))
+ (if (not (= (chans index) 1)) (snd-display #__line__ ";oboe: chans ~D?" (chans index)))
+ (if (not (= (channels index) 1)) (snd-display #__line__ ";oboe: channels ~D?" (channels index)))
+ (if (not (= (framples index) 50828)) (snd-display #__line__ ";oboe: framples ~D?" (framples index)))
+ (if (not (= (srate index) 22050)) (snd-display #__line__ ";oboe: srate ~D?" (srate index)))
+ (if (not (= (data-location index) 28)) (snd-display #__line__ ";oboe: location ~D?" (data-location index)))
+ (if (not (= (data-size index) (* 50828 2))) (snd-display #__line__ ";oboe: size ~D?" (data-size index)))
+ (if (not (= (sample-type index) mus-bshort)) (snd-display #__line__ ";oboe: format ~A?" (sample-type index)))
+ (if (fneq (maxamp index) .14724) (snd-display #__line__ ";oboe: maxamp ~F?" (maxamp index)))
+ (if (not (= (maxamp-position index) 24971)) (snd-display #__line__ ";oboe: maxamp-position ~A?" (maxamp-position index)))
+ (if (> (length (comment index)) 0) (snd-display #__line__ ";oboe: comment ~A?" (comment index)))
+ (if (not (= (length "asdf") 4)) (snd-display #__line__ ";string-length: ~A?" (length "asdf")))
+ (if (not (string=? (short-file-name index) "oboe.snd")) (snd-display #__line__ ";oboe short name: ~S?" (short-file-name index)))
+ (let ((matches (count-matches (lambda (a) (> a .125)))))
+ (if (not (= matches 1313)) (snd-display #__line__ ";count-matches: ~A?" matches)))
+ (let ((spot (scan-channel (lambda (a) (> a .13)))))
+ (if (or (not spot) (not (= spot 8862))) (snd-display #__line__ ";find: ~A?" spot)))
+ (set! (right-sample) 3000)
+ (let ((samp (right-sample)))
+ (if (> (abs (- samp 3000)) 1) (snd-display #__line__ ";right-sample: ~A?" samp)))
+ (set! (left-sample) 1000)
+ (let ((samp (left-sample)))
+ (if (> (abs (- samp 1000)) 1) (snd-display #__line__ ";left-sample: ~A?" samp)))
+ (let ((eds (edits)))
+ (if (not (= (car eds) 0 (cadr eds)))
+ (snd-display #__line__ ";edits: ~A?" eds))
+ (if (not (= (edit-position) (car eds)))
+ (snd-display #__line__ ";edit-position: ~A ~A?" (edit-position) eds)))
+ (play index :channel 0 :wait #t)
+
+ (if (not *selection-creates-region*) (set! *selection-creates-region* #t))
+ (select-all index 0)
+ (let ((r0 (car (regions)))
+ (sel (selection)))
+ (if (not (selection?)) (snd-display #__line__ ";selection?"))
+ (if (not (selection? sel)) (snd-display #__line__ ";selection? sel"))
+ (if (not (region? r0)) (snd-display #__line__ ";region?"))
+ (if (not (= (selection-chans) 1)) (snd-display #__line__ ";selection-chans(1): ~A" (selection-chans)))
+ (if (not (= (channels sel) 1)) (snd-display #__line__ ";generic selection-chans(1): ~A" (channels sel)))
+ (if (not (= (selection-srate) (srate index))) (snd-display #__line__ ";selection-srate: ~A ~A" (selection-srate) (srate index)))
+ (if (not (= (srate sel) (srate index))) (snd-display #__line__ ";generic selection-srate: ~A ~A" (srate sel) (srate index)))
+ (if (fneq (region-maxamp r0) (maxamp index)) (snd-display #__line__ ";region-maxamp (1): ~A?" (region-maxamp r0)))
+ (if (not (= (region-maxamp-position r0) (maxamp-position index)))
+ (snd-display #__line__ ";region-maxamp-position (1): ~A ~A?" (region-maxamp-position r0) (maxamp-position index)))
+ (if (fneq (selection-maxamp index 0) (maxamp index)) (snd-display #__line__ ";selection-maxamp (1): ~A?" (selection-maxamp index 0)))
+ (if (fneq (maxamp sel index 0) (maxamp index)) (snd-display #__line__ ";generic selection-maxamp (1): ~A?" (maxamp sel index 0)))
+ (if (not (= (selection-maxamp-position index 0) (maxamp-position index)))
+ (snd-display #__line__ ";selection-maxamp-position (1): ~A ~A?" (selection-maxamp-position index 0) (maxamp-position index)))
+ (save-region r0 "temp.dat")
+ (if (file-exists? "temp.dat")
+ (delete-file "temp.dat")
+ (snd-display #__line__ ";save-region file disappeared?"))
+ (play r0 :wait #t) ;needs to be #t here or it never gets run
+ (if (not (= (length (regions)) 1)) (snd-display #__line__ ";regions: ~A?" (regions)))
+ (if (not (selection-member? index)) (snd-display #__line__ ";selection-member?: ~A" (selection-member? index)))
+ (if (not (= (region-srate r0) 22050)) (snd-display #__line__ ";region-srate: ~A?" (region-srate r0)))
+ (if (not (= (region-chans r0) 1)) (snd-display #__line__ ";region-chans: ~A?" (region-chans r0)))
+ (if (not (equal? (region-home r0) (list "oboe.snd" 0 50827))) (snd-display #__line__ ";region-home: ~A" (region-home r0)))
+ (if (not (= (region-framples r0) 50828)) (snd-display #__line__ ";region-framples: ~A?" (region-framples r0)))
+ (if (not (= (selection-framples) 50828)) (snd-display #__line__ ";selection-framples: ~A?" (selection-framples 0)))
+ (if (not (= (framples sel) 50828)) (snd-display #__line__ ";generic selection-framples: ~A?" (framples sel)))
+ (if (not (= (length sel) 50828)) (snd-display #__line__ ";generic length selection-framples: ~A?" (length sel)))
+ (if (not (= (selection-position) 0)) (snd-display #__line__ ";selection-position: ~A?" (selection-position)))
+ (if (not (= (region-position r0 0) 0)) (snd-display #__line__ ";region-position: ~A?" (region-position r0 0)))
+ (if (fneq (region-maxamp r0) (maxamp index)) (snd-display #__line__ ";region-maxamp: ~A?" (region-maxamp r0)))
+ (if (fneq (selection-maxamp index 0) (maxamp index)) (snd-display #__line__ ";selection-maxamp: ~A?" (selection-maxamp index 0)))
+ (let ((samps1 (channel->float-vector 0 50827 index 0))
+ (samps2 (region->float-vector r0 0 50828 0))
+ (vr (make-sampler 0 index 0 1)))
+ (if (not (sampler? vr)) (snd-display #__line__ ";~A not sampler?" vr))
+ (if (not (= (sampler-position vr) 0)) (snd-display #__line__ ";initial sampler-position: ~A" (sampler-position vr)))
+ (if (not (equal? (sampler-home vr) (list index 0)))
+ (snd-display #__line__ ";sampler-home: ~A ~A?" (sampler-home vr) (list index 0)))
+ (if (sampler-at-end? vr) (snd-display #__line__ ";~A init at end?" vr))
+ (let ((err (catch #t
+ (lambda ()
+ (region->float-vector r0 -1 1233))
+ (lambda args (car args)))))
+ (if (not (eq? err 'no-such-sample)) (snd-display #__line__ ";region->float-vector -1: ~A" err)))
+ (let ((err (catch #t
+ (lambda ()
+ (region->float-vector r0 12345678 1))
+ (lambda args (car args)))))
+ ;; should this return 'no-such-sample?
+ (if err (snd-display #__line__ ";region->float-vector 12345678: ~A" err)))
+ (let ((reader-string (format #f "~A" vr)))
+ (if (not (string=? reader-string "#<sampler: oboe.snd[0: 0] from 0, at 0, forward>"))
+ (snd-display #__line__ ";sampler actually got: [~S]" reader-string)))
+ (let ((evr vr))
+ (if (not (equal? evr vr)) (snd-display #__line__ ";sampler equal? ~A ~A" vr evr)))
+ (catch 'break
+ (lambda ()
+ (do ((i 0 (+ i 1)))
+ ((= i 50827))
+ (if (not (= (if (odd? i) (next-sample vr) (read-sample vr)) (samps1 i) (samps2 i)))
+ (begin
+ (snd-display #__line__ ";readers disagree at ~D" i)
+ (throw 'break)))))
+ (lambda args (car args)))
+ (free-sampler vr)))
+ (let ((var (catch #t (lambda () (make-sampler 0 index -1)) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-channel))
+ (snd-display #__line__ ";make-sampler bad chan (-1): ~A" var)))
+ (let ((var (catch #t (lambda () (make-sampler 0 index 1)) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-channel))
+ (snd-display #__line__ ";make-sampler bad chan (1): ~A, ~A" var index)))
+ (let ((fd (make-sampler 0)))
+ (if (mix-sampler? fd) (snd-display #__line__ ";sampler: mix ~A" fd))
+ (if (region-sampler? fd) (snd-display #__line__ ";sampler: region ~A" fd))
+ (if (not (sampler? fd)) (snd-display #__line__ ";sampler: normal ~A" fd))
+ (if (not (= (sampler-position fd) 0)) (snd-display #__line__ ";sampler: position: ~A" fd))
+ (free-sampler fd)
+ (let ((str (format #f "~A" fd)))
+ (if (not (string=? (substring str (- (length str) 16)) "at eof or freed>"))
+ (snd-display #__line__ ";freed sampler: ~A [~A]?" str (substring str (- (length str) 16))))))
+ (let* ((reg (car (regions)))
+ (chns (region-chans reg))
+ (var (catch #t (lambda () (make-region-sampler reg 0 (+ chns 1))) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-channel))
+ (snd-display #__line__ ";make-region-sampler bad chan (2): ~A ~A" var (regions)))
+ (let ((tag (catch #t (lambda () (make-region-sampler reg 0 0 -2)) (lambda args args))))
+ (if (not (eq? (car tag) 'no-such-direction))
+ (snd-display #__line__ ";make-region-sampler bad dir (-2): ~A" tag))))
- (let ((ind (new-sound "test.snd")))
-
- ;; ptree+scale
- (map-channel (lambda (y) 1.0) 0 100)
- (cosine-channel 0 100)
- (let ((map-data (channel->vct)))
- (undo)
- (cosine-channel-via-ptree 0 100)
- (let ((tree-data (channel->vct)))
- (if (not (vequal map-data tree-data))
- (snd-display #__line__ ";map and ptree cosine disagree: ~A ~A" map-data tree-data)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string=? (safe-display-edits ind 0 12 #f) "
- (scale 90 10) ; scale-channel 0.500 90 10 [12:11]:
- (at 0, cp->sounds[1][0:9, 0.500, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, loc: 0, pos: 10, scl: 1.000]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, loc: 0, pos: 20, scl: 1.000]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, loc: 0, pos: 30, scl: 1.000]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, loc: 0, pos: 40, scl: 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, loc: 0, pos: 50, scl: 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, loc: 0, pos: 60, scl: 1.000]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, loc: 0, pos: 70, scl: 1.000]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, loc: 0, pos: 80, scl: 1.000]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, loc: 0, pos: 90, scl: 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 0: ~A" (safe-display-edits ind 0 12 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and ptree->scl cosine disagree: ~% ~A~% ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 0 100)
- (if (not (string=? (safe-display-edits ind 0 12 #f) "
- (ptree[0] 0 100) ; ptree-channel [12:11]:
- (at 0, cp->sounds[1][0:9, 1.000, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, loc: 0, pos: 20, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 1.000, loc: 0, pos: 30, scl: 0.500]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, loc: 0, pos: 40, scl: 0.500]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, loc: 0, pos: 50, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 1.000, loc: 0, pos: 60, scl: 0.500]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 1.000, loc: 0, pos: 70, scl: 0.500]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 1.000, loc: 0, pos: 80, scl: 0.500]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 1.000, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 1: ~A" (safe-display-edits ind 0 12 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and scl->ptree cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (cosine-channel 10 90)
- (set! map-data (channel->vct))
-
- (undo)
- (cosine-channel-via-ptree 10 90)
- (let ((tree-data (channel->vct)))
- (if (not (vequal map-data tree-data))
- (snd-display #__line__ ";map and ptree 10:90 cosine disagree: ~A ~A" map-data tree-data)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 12 #f) "
- (scale 90 10) ; scale-channel 0.500 90 10 [12:11]:
- (at 0, cp->sounds[1][0:9, 0.500]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, loc: 0, pos: 10, scl: 1.000]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, loc: 0, pos: 20, scl: 1.000]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, loc: 0, pos: 30, scl: 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, loc: 0, pos: 40, scl: 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, loc: 0, pos: 50, scl: 1.000]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, loc: 0, pos: 60, scl: 1.000]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, loc: 0, pos: 70, scl: 1.000]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, loc: 0, pos: 80, scl: 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 2: ~A" (safe-display-edits ind 0 12 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and scl->ptree 10:90 cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (cosine-channel 10 80)
- (set! map-data (channel->vct))
- (undo)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 10 80)
- (let ((tree-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data tree-data))
- (snd-display #__line__ ";map and ptree 10:80 cosine disagree: ~A ~A" map-data tree-data)))
- (if (not (string-=? (safe-display-edits ind 0 12 #f) "
- (ptree[0] 10 80) ; ptree-channel [12:11]:
- (at 0, cp->sounds[1][0:9, 0.500]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 1.000, loc: 0, pos: 20, scl: 0.500]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, loc: 0, pos: 30, scl: 0.500]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, loc: 0, pos: 40, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 1.000, loc: 0, pos: 50, scl: 0.500]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 1.000, loc: 0, pos: 60, scl: 0.500]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 1.000, loc: 0, pos: 70, scl: 0.500]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 3: ~A" (safe-display-edits ind 0 12 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and scl->ptree 10:80 cosine disagree: ~A ~A" map-data scl-data)))
-
- ;; ptree + ramp
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '(0 0 1 1))
- (cosine-channel 0 100)
- (set! map-data (channel->vct))
- (undo)
- (cosine-channel-via-ptree 0 100)
- (let ((tree-data (channel->vct)))
- (if (not (vequal map-data tree-data))
- (snd-display #__line__ ";ptree->ramp cosine disagree: ~A ~A" map-data tree-data)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (scale 90 10) ; scale-channel 0.500 90 10 [13:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, loc: 0, pos: 10, scl: 1.000]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.202 -> 0.293, loc: 0, pos: 20, scl: 1.000]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.303 -> 0.394, loc: 0, pos: 30, scl: 1.000]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.404 -> 0.495, loc: 0, pos: 40, scl: 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.505 -> 0.596, loc: 0, pos: 50, scl: 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.606 -> 0.697, loc: 0, pos: 60, scl: 1.000]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.707 -> 0.798, loc: 0, pos: 70, scl: 1.000]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.808 -> 0.899, loc: 0, pos: 80, scl: 1.000]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, loc: 0, pos: 90, scl: 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 4: ~A" (safe-display-edits ind 0 13 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and (scl) ptree->ramp cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '((0 0) (1 1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 0 100)
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (ptree[0] 0 100) ; ptree-channel [13:11]:
- (at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 0.091, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, [1]0.101 -> 0.192, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, [1]0.202 -> 0.293, loc: 0, pos: 20, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 1.000, [1]0.303 -> 0.394, loc: 0, pos: 30, scl: 0.500]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, [1]0.404 -> 0.495, loc: 0, pos: 40, scl: 0.500]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]0.505 -> 0.596, loc: 0, pos: 50, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 1.000, [1]0.606 -> 0.697, loc: 0, pos: 60, scl: 0.500]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 1.000, [1]0.707 -> 0.798, loc: 0, pos: 70, scl: 0.500]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 1.000, [1]0.808 -> 0.899, loc: 0, pos: 80, scl: 0.500]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 1.000, [1]0.909 -> 1.000, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 5: ~A" (safe-display-edits ind 0 13 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and ptree->ramp (scl) cosine disagree: ~A ~A" map-data scl-data)))
-
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 14 #f) "
- (scale 0 100) ; scale-channel 0.500 0 #f [14:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.202 -> 0.293, loc: 0, pos: 20, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.303 -> 0.394, loc: 0, pos: 30, scl: 0.500]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.404 -> 0.495, loc: 0, pos: 40, scl: 0.500]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.505 -> 0.596, loc: 0, pos: 50, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.606 -> 0.697, loc: 0, pos: 60, scl: 0.500]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.707 -> 0.798, loc: 0, pos: 70, scl: 0.500]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.808 -> 0.899, loc: 0, pos: 80, scl: 0.500]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 5 + scl: ~A" (safe-display-edits ind 0 14 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 4.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and ptree->ramp (scl twice) cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '(0 0 1 1))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 10 80)
- (set! map-data (channel->vct))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (ptree[0] 10 80) ; ptree-channel [13:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, [1]0.101 -> 0.192, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, [1]0.202 -> 0.293, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 1.000, [1]0.303 -> 0.394, loc: 0, pos: 20, scl: 0.500]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, [1]0.404 -> 0.495, loc: 0, pos: 30, scl: 0.500]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]0.505 -> 0.596, loc: 0, pos: 40, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 1.000, [1]0.606 -> 0.697, loc: 0, pos: 50, scl: 0.500]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 1.000, [1]0.707 -> 0.798, loc: 0, pos: 60, scl: 0.500]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 1.000, [1]0.808 -> 0.899, loc: 0, pos: 70, scl: 0.500]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 6: ~A" (safe-display-edits ind 0 13 #f)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '(0 0 1 1))
- (cosine-channel-via-ptree 10 80)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (let ((scl-data (channel->vct)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";ptree+ramp order matters? ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-channel '(0 0 1 1))
- (cosine-channel-via-ptree 15 70)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (scale 90 10) ; scale-channel 0.500 90 10 [13:13]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091]) [buf: 100]
- (at 10, cp->sounds[1][10:14, 0.500, [1]0.101 -> 0.141]) [buf: 100]
- (at 15, cp->sounds[1][15:19, 0.500, [1]0.152 -> 0.192, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.202 -> 0.293, loc: 0, pos: 5, scl: 1.000]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.303 -> 0.394, loc: 0, pos: 15, scl: 1.000]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.404 -> 0.495, loc: 0, pos: 25, scl: 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.505 -> 0.596, loc: 0, pos: 35, scl: 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.606 -> 0.697, loc: 0, pos: 45, scl: 1.000]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.707 -> 0.798, loc: 0, pos: 55, scl: 1.000]) [buf: 100]
- (at 80, cp->sounds[1][80:84, 0.500, [1]0.808 -> 0.848, loc: 0, pos: 65, scl: 1.000]) [buf: 100]
- (at 85, cp->sounds[1][85:89, 0.500, [1]0.859 -> 0.899]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 7: ~A" (safe-display-edits ind 0 13 #f)))
- (close-sound ind)))
+ (revert-sound index)
+ (insert-sample 100 .5 index)
+ (let ((var (catch #t (lambda () (insert-sound "oboe.snd" 0 1)) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-channel))
+ (snd-display #__line__ ";insert-sound bad chan (1): ~A" var)))
+ (let ((var (catch #t (lambda () (insert-sample -12 1.0)) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-sample))
+ (snd-display #__line__ ";insert-sample bad pos: ~A" var)))
+ (set! (show-axes index 0) show-no-axes)
+ (update-transform-graph index)
+ (update-time-graph index)
+ (if (or (fneq (sample 100) .5)
+ (not (= (framples index) 50829)))
+ (snd-display #__line__ ";insert-sample: ~A ~A?" (sample 100) (framples index)))
+ (let ((v0 (make-vector 3))
+ (v1 (make-float-vector 3)))
+ (fill! v1 .75)
+ (fill! v0 0.25)
+ (insert-samples 200 3 v0 index)
+ (insert-samples 300 3 v1 index)
+ (if (or (fneq (sample 201) .25)
+ (fneq (sample 301) .75)
+ (not (= (framples index) 50835)))
+ (snd-display #__line__ ";insert-samples: ~A ~A ~A?" (sample 201) (sample 301) (framples index))))
+ (save-sound-as "hiho.snd" index 22050 mus-ldouble mus-next)
+ (let ((nindex (view-sound "hiho.snd")))
+ (if (fneq (sample 101 nindex) (sample 101 index))
+ (snd-display #__line__ ";save-sound-as: ~A ~A?" (sample 101 nindex) (sample 101 index)))
+ (if (not (read-only nindex)) (snd-display #__line__ ";read-only view-sound: ~A?" (read-only nindex)))
+
+ (set! (speed-control-style nindex) speed-control-as-semitone)
+ (if (not (= (speed-control-style nindex) speed-control-as-semitone))
+ (snd-display #__line__ ";speed-control-style set semi: ~A" (speed-control-style nindex)))
+ (set! (speed-control-tones nindex) -8)
+ (if (not (= (speed-control-tones nindex) 12))
+ (snd-display #__line__ ";speed-control-tones -8: ~A" (speed-control-tones nindex)))
+ (set! (speed-control-tones nindex) 18)
+ (if (not (= (speed-control-tones nindex) 18))
+ (snd-display #__line__ ";speed-control-tones 18: ~A" (speed-control-tones nindex)))
+ (graph->ps "aaa.eps")
+ (close-sound nindex))
+ (revert-sound index)
+ (set! (sample 50 index) .5)
+ (if (fneq (sample 50) .5) (snd-display #__line__ ";set-sample: ~A?" (sample 50)))
+ (let ((v0 (make-vector 3 0.25)))
+ (set! (samples 60 3 index) v0)
+ (if (or (fneq (sample 60) .25) (fneq (sample 61) .25))
+ (snd-display #__line__ ";set-samples: ~A ~A ~A?" (sample 60) (sample 61) (sample 62))))
+ (set! (samples 10 3 index) (list 0.1 0.2 0.3))
+ (if (not (vequal (channel->float-vector 10 3 index) (float-vector 0.1 0.2 0.3)))
+ (snd-display #__line__ ";set-samples via list: ~A" (channel->float-vector 10 3 index)))
+ (revert-sound index)
+ (save-sound-as "temporary.snd" index)
+ (set! (samples 100000 20000 index) "temporary.snd")
+ (if (not (vequal (channel->float-vector 110000 10) (channel->float-vector 10000 10)))
+ (snd-display #__line__ ";set samples to self: ~A ~A" (channel->float-vector 110000 10) (channel->float-vector 10000 10)))
+ (revert-sound index)
+ (delete-sample 100 index)
+ (if (not (file-exists? "temporary.snd"))
+ (snd-display #__line__ ";set-samples temp deleted?"))
+ (delete-file "temporary.snd")
+ (if (not (= (framples index) 50827)) (snd-display #__line__ ";delete-sample: ~A?" (framples index)))
+ (delete-samples 0 100 index)
+ (if (not (= (framples index) 50727)) (snd-display #__line__ ";delete-samples: ~A?" (framples index)))
+ (revert-sound index)
+ (let ((maxa (maxamp index)))
+ (scale-to .5 index)
+ (let ((newmaxa (maxamp index)))
+ (if (fneq newmaxa .5) (snd-display #__line__ ";scale-to: ~A?" newmaxa))
+ (undo 1 index)
+ (scale-by 2.0 index)
+ (set! newmaxa (maxamp index))
+ (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";scale-by: ~A?" newmaxa))
+ (revert-sound index)
+ (scale-by -1 index)
+ (mix "oboe.snd")
+ (if (fneq (maxamp index 0) 0.0) (snd-display #__line__ ";invert+mix->~A" (maxamp)))
+ (revert-sound index)
+ (select-all index)
+ (if (not (= (length (regions)) 2)) (snd-display #__line__ ";regions(2): ~A?" (regions)))
+ (scale-selection-to .5)
+ (set! newmaxa (maxamp index))
+ (if (fneq newmaxa .5) (snd-display #__line__ ";scale-selection-to: ~A?" newmaxa))
+ (revert-sound index)
+ (select-all index)
+ (scale-selection-by 2.0)
+ (set! newmaxa (maxamp index))
+ (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";scale-selection-by: ~A?" newmaxa))
+ (revert-sound index)
+ (with-temporary-selection (lambda () (scale-selection-by 2.0)) 0 (framples) index 0)
+ (set! newmaxa (maxamp index))
+ (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";with-temporary-selection: ~A?" newmaxa))
+ (revert-sound index)
+ (let ((samp999 (sample 999 index 0))
+ (samp1001 (sample 1001 index 0)))
+ (with-temporary-selection (lambda () (scale-selection-to 2.0)) 1000 1 index 0)
+ (if (fneq (sample 1000 index 0) 2.0) (snd-display #__line__ ";with-temporary-selection 1000: ~A" (sample 1000 index 0)))
+ (if (fneq (sample 999 index 0) samp999) (snd-display #__line__ ";with-temporary-selection 999: ~A from ~A" (sample 999 index 0) samp999))
+ (if (fneq (sample 1001 index 0) samp1001) (snd-display #__line__ ";with-temporary-selection 1001: ~A from ~A" (sample 1001 index 0) samp1001)))
+ (revert-sound index)
+ (make-selection 100 199 index 0)
+ (let ((old-start (selection-position index 0))
+ (old-len (selection-framples index 0)))
+ (with-temporary-selection (lambda () (scale-selection-to 2.0)) 1000 1 index 0)
+ (if (not (selection?)) (snd-display #__line__ ";with-temporary-selection restore?"))
+ (if (not (selection-member? index 0)) (snd-display #__line__ ";with-temporary-selection not member?"))
+ (if (not (= (selection-position index 0) old-start)) (snd-display #__line__ ";with-temporary-selection start: ~A" (selection-position index 0)))
+ (if (not (= (selection-framples index 0) old-len)) (snd-display #__line__ ";with-temporary-selection len: ~A" (selection-framples index 0))))
+ (unselect-all)
+ (if (selection-member? index 0) (snd-display #__line__ ";unselect all ~D 0?" index))
+ (revert-sound index)
+ (select-all index)
+ (let ((rread (make-region-sampler (car (regions)) 0))
+ (sread (make-sampler 0 index))
+ (rvect (region->float-vector (car (regions)) 0 100))
+ (svect (samples 0 100 index)))
+ (if (fneq (rvect 1) (region-sample (car (regions)) 1))
+ (snd-display #__line__ ";region-sample: ~A ~A?" (region-sample (car (regions)) 1) (rvect 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((rval (next-sample rread))
+ (sval (next-sample sread)))
+ (if (fneq rval sval) (snd-display #__line__ ";sample-read: ~A ~A?" rval sval))
+ (if (fneq rval (rvect i)) (snd-display #__line__ ";region-samples: ~A ~A?" rval (rvect i)))
+ (if (fneq sval (svect i)) (snd-display #__line__ ";samples: ~A ~A?" sval (svect i)))))
+ (free-sampler rread)
+ (let ((val0 (next-sample sread)))
+ (if (sampler-at-end? sread) (snd-display #__line__ ";premature end?"))
+ (previous-sample sread)
+ (let ((val1 (previous-sample sread)))
+ (if (fneq val0 val1) (snd-display #__line__ ";previous-sample: ~A ~A?" val0 val1))))
+ (free-sampler sread))))
+ (revert-sound index)
+ (let ((s100 (sample 100))
+ (s40 (sample 40))
+ (len (framples))
+ (addlen (mus-sound-framples "fyow.snd")))
+ (set! *cursor-style* cursor-line)
+ (set! *cursor-size* 25)
+ (set! (cursor index) 50)
+ (if (not (= *cursor-style* cursor-line))
+ (snd-display #__line__ ";cursor-style: ~A? " *cursor-style*))
+ (if (not (= *cursor-size* 25))
+ (snd-display #__line__ ";cursor-size: ~A? " *cursor-size*))
+ (set! *cursor-style* cursor-cross)
+ (set! *cursor-size* 15)
+ (set! (cursor index 0) 30)
+ (set! *cursor-style* cursor-line)
+ (set! (cursor index 0) 20)
+ (if with-gui
+ (begin
+ (set! (cursor-style index 0)
+ (lambda (snd chn ax)
+ (let* ((point (cursor-position))
+ (x (car point))
+ (y (cadr point))
+ (size (floor (/ *cursor-size* 2)))
+ (cr (make-cairo (car (channel-widgets snd chn)))))
+ (draw-line (- x size) (- y size) (+ x size) (+ y size) snd chn cursor-context cr)
+ (draw-line (- x size) (+ y size) (+ x size) (- y size) snd chn cursor-context cr)
+ (free-cairo cr))))
+ (if (not (procedure? (cursor-style index 0))) (snd-display #__line__ ";set cursor-style to proc: ~A" (cursor-style index 0)))))
+ (set! (cursor index) 50)
+ (insert-sound "fyow.snd" (cursor) 0 index 0)
+ (if (or (fneq (sample 40) s40) (not (fneq (sample 100) s100)) (fneq (sample 100) 0.001831))
+ (snd-display #__line__ ";insert-sound: ~A?" (sample 100)))
+ (if (not (= (framples) (+ len addlen))) (snd-display #__line__ ";insert-sound len: ~A?" (framples)))
+ (save-sound-as "not-temporary.snd")
+ (insert-samples 0 100 "not-temporary.snd")
+ (set! (cursor index 0 0) (- (framples index 0 0) 2))
+ (revert-sound)
+ (if (not (= (cursor index 0) (- (framples index 0) 2)))
+ (snd-display #__line__ ";set edpos cursor: ~A ~A ~A" (cursor) (cursor index 0 0) (- (framples index 0 0) 2)))
+ (if (not (file-exists? "not-temporary.snd"))
+ (snd-display #__line__ ";insert-samples deleted its file?")
+ (delete-file "not-temporary.snd"))
+ (let ((id (make-region 0 99)))
+ (insert-region id 60 index)
+ (if (not (= (framples) (+ len 100))) (snd-display #__line__ ";insert-region len: ~A?" (framples)))
+ (if (fneq (sample 100) s40) (snd-display #__line__ ";insert-region: ~A ~A?" (sample 100) s40))
+ (let ((var (catch #t (lambda () (insert-region (integer->region (+ 1000 (apply max (map region->integer (regions))))) 0)) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-region))
+ (snd-display #__line__ ";insert-region bad id: ~A" var)))
+ (save-region id "fmv.snd")
+ (if (not (= (mus-sound-header-type "fmv.snd") mus-next))
+ (snd-display #__line__ ";save-region header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-out-format))
+ (snd-display #__line__ ";save-region format: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
+ (if (not (= (mus-sound-srate "fmv.snd") (region-srate id)))
+ (snd-display #__line__ ";save-region srate: ~A (~A)" (mus-sound-srate "fmv.snd") (region-srate id)))
+ (if (not (= (mus-sound-chans "fmv.snd") (region-chans id)))
+ (snd-display #__line__ ";save-region chans: ~A (~A)" (mus-sound-chans "fmv.snd") (region-chans id)))
+ (if (not (= (mus-sound-framples "fmv.snd") (region-framples id)))
+ (snd-display #__line__ ";save-region length: ~A (~A)" (mus-sound-framples "fmv.snd") (region-framples id)))
+ (if (not (= (region-position id 0) 0))
+ (snd-display #__line__ ";save-region position: ~A" (region-position id 0)))
+ (delete-file "fmv.snd")
+ (save-region id "fmv.snd" mus-lshort mus-riff "this is a comment")
+ (if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
+ (snd-display #__line__ ";save-region riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-lshort))
+ (snd-display #__line__ ";save-region lshort format: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
+ (if (not (= (mus-sound-framples "fmv.snd") (region-framples id)))
+ (snd-display #__line__ ";save-region length: ~A (~A)" (mus-sound-framples "fmv.snd") (region-framples id)))
+ (if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
+ (snd-display #__line__ ";save-region comment: ~A" (mus-sound-comment "fmv.snd")))
+ (delete-file "fmv.snd")
+ (save-region id :file "fmv.snd" :header-type mus-riff :sample-type mus-lshort :comment "this is a comment")
+ (if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
+ (snd-display #__line__ ";save-region opt riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-lshort))
+ (snd-display #__line__ ";save-region opt lshort format: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
+ (if (not (= (mus-sound-framples "fmv.snd") (region-framples id)))
+ (snd-display #__line__ ";save-region opt length: ~A (~A)" (mus-sound-framples "fmv.snd") (region-framples id)))
+ (if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
+ (snd-display #__line__ ";save-region opt comment: ~A" (mus-sound-comment "fmv.snd")))
+ (delete-file "fmv.snd")
+ (save-region id :comment "this is a comment" :file "fmv.snd" :sample-type mus-lshort :header-type mus-riff)
+ (if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
+ (snd-display #__line__ ";save-region opt1 riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-lshort))
+ (snd-display #__line__ ";save-region opt1 lshort format: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
+ (if (not (= (mus-sound-framples "fmv.snd") (region-framples id)))
+ (snd-display #__line__ ";save-region opt1 length: ~A (~A)" (mus-sound-framples "fmv.snd") (region-framples id)))
+ (if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
+ (snd-display #__line__ ";save-region opt1 comment: ~A" (mus-sound-comment "fmv.snd")))
+ (delete-file "fmv.snd")
+ (save-region id "fmv.snd" :sample-type mus-bshort)
+ (if (not (= (mus-sound-header-type "fmv.snd") mus-next))
+ (snd-display #__line__ ";save-region opt2 next header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-bshort))
+ (snd-display #__line__ ";save-region opt2 bshort format: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
+ (delete-file "fmv.snd")
+ ))
+ (close-sound index)
+ (let ((var (catch #t (lambda () (new-sound "hi.snd" :channels 0)) (lambda args args))))
+ (if (or (not (pair? var))
+ (not (eq? (car var) 'out-of-range)))
+ (snd-display #__line__ ";new-sound bad chan: ~A" var)))
+ (set! index (new-sound "fmv.snd" 2 22050 mus-ldouble mus-next "unequal lens"))
+ (insert-silence 0 1000 index 1)
+ (if (or (not (= (framples index 0) 1))
+ (not (= (framples index 1) 1001)))
+ (snd-display #__line__ ";silence 1: ~A ~A" (framples index 0) (framples index 1)))
+ (save-sound index)
+ (if (or (not (= (framples index 0) 1001))
+ (not (= (framples index 1) 1001)))
+ (snd-display #__line__ ";saved silence 1: ~A ~A" (framples index 0) (framples index 1)))
+ (if (not (= (mus-sound-framples "fmv.snd") 1001))
+ (snd-display #__line__ ";saved framers silence 1: ~A" (mus-sound-framples "fmv.snd")))
+ (let ((v0 (channel->float-vector 0 1000 index 0))
+ (v1 (channel->float-vector 0 1000 index 1)))
+ (if (fneq (float-vector-peak v0) 0.0)
+ (snd-display #__line__ ";auto-pad 0: ~A" (float-vector-peak v0)))
+ (if (fneq (float-vector-peak v1) 0.0)
+ (snd-display #__line__ ";silence 0: ~A" (float-vector-peak v1))))
+ (close-sound index)
+ (delete-file "fmv.snd")
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.75 (* i 10) 10))
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f
- (lambda (pos dur)
- (vct 0.5)))
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 20 45 ind 0 #f #f
- (lambda (pos dur)
- (vct 0.25)))
- (let ((data (channel->vct))
- (orig (make-vct 100 1.0)))
- (vct-scale! orig 0.75) ; scale-channel
- (vct-scale! orig 0.5) ; ptree-channel
- (do ((i 20 (+ 1 i)))
- ((= i 65))
- (vct-set! orig i (* (vct-ref orig i) .25)))
- (if (not (vvequal orig data))
- (snd-display #__line__ ";p2 pos test data: ~A" data))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (ptree[1] 20 45) ; ptree-channel [13:12]:
- (at 0, cp->sounds[1][0:9, 1.000, loc: 0, pos: 0, scl: 0.750]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, loc: 0, pos: 10, scl: 0.750]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 20, scl: 0.750]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 1.000, loc2: 1, pos2: 10, scl2: 1.000, loc: 0, pos: 30, scl: 0.750]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, loc2: 1, pos2: 20, scl2: 1.000, loc: 0, pos: 40, scl: 0.750]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, loc2: 1, pos2: 30, scl2: 1.000, loc: 0, pos: 50, scl: 0.750]) [buf: 100]
- (at 60, cp->sounds[1][60:64, 1.000, loc2: 1, pos2: 40, scl2: 1.000, loc: 0, pos: 60, scl: 0.750]) [buf: 100]
- (at 65, cp->sounds[1][65:69, 1.000, loc: 0, pos: 65, scl: 0.750]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 1.000, loc: 0, pos: 70, scl: 0.750]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 1.000, loc: 0, pos: 80, scl: 0.750]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 1.000, loc: 0, pos: 90, scl: 0.750]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";p2 pos multi: ~A" (safe-display-edits ind 0 13 #f)))
- (close-sound ind)))
+ (set! index (new-sound "fmv.snd" 2 22050 mus-ldouble mus-next "unequal lens"))
+ (pad-channel 0 1000 index 1)
+ (if (or (not (= (framples index 0) 1))
+ (not (= (framples index 1) 1001)))
+ (snd-display #__line__ ";pad-channel 1: ~A ~A" (framples index 0) (framples index 1)))
+ (let ((v0 (channel->float-vector 0 1000 index 0))
+ (v1 (channel->float-vector 0 1000 index 1)))
+ (if (fneq (float-vector-peak v0) 0.0)
+ (snd-display #__line__ ";pad 0: ~A" (float-vector-peak v0)))
+ (if (fneq (float-vector-peak v1) 0.0)
+ (snd-display #__line__ ";pad 1: ~A" (float-vector-peak v1))))
+ (map-channel (lambda (n) 1.0) 0 2 index 0)
+ (map-channel (lambda (n) 1.0) 0 1002 index 1)
+ (pad-channel 0 1000 index 0 1)
+ (if (not (= (framples index 1) 1002))
+ (snd-display #__line__ ";pad-channel ed 1: ~A ~A" (framples index 0) (framples index 1)))
+ (close-sound index)
+ (delete-file "fmv.snd")
- (let ((ind (new-sound "test.snd"))
- (map-data #f))
-
- ;; ptree + xramp
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (cosine-channel 0 100)
- (set! map-data (channel->vct))
- (undo)
- (cosine-channel-via-ptree 0 100)
- (let ((tree-data (channel->vct)))
- (if (not (vequal map-data tree-data))
- (snd-display #__line__ ";ptree->xramp cosine disagree: ~A ~A" map-data tree-data)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (scale 90 10) ; scale-channel 0.500 90 10 [13:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.012, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.014 -> 0.030, off: -0.032, scl: 0.032, loc: 0, pos: 10, scl: 1.000]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.033 -> 0.057, off: -0.032, scl: 0.032, loc: 0, pos: 20, scl: 1.000]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.060 -> 0.094, off: -0.032, scl: 0.032, loc: 0, pos: 30, scl: 1.000]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.099 -> 0.147, off: -0.032, scl: 0.032, loc: 0, pos: 40, scl: 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.153 -> 0.222, off: -0.032, scl: 0.032, loc: 0, pos: 50, scl: 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.231 -> 0.329, off: -0.032, scl: 0.032, loc: 0, pos: 60, scl: 1.000]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.342 -> 0.480, off: -0.032, scl: 0.032, loc: 0, pos: 70, scl: 1.000]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.499 -> 0.695, off: -0.032, scl: 0.032, loc: 0, pos: 80, scl: 1.000]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.721 -> 1.000, off: -0.032, scl: 0.032, loc: 0, pos: 90, scl: 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 9: ~A" (safe-display-edits ind 0 13 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and (scl) ptree->xramp cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 0 100)
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (ptree[0] 0 100) ; ptree-channel [13:11]:
- (at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 0.012, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, [1]0.014 -> 0.030, off: -0.032, scl: 0.032, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, [1]0.033 -> 0.057, off: -0.032, scl: 0.032, loc: 0, pos: 20, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 1.000, [1]0.060 -> 0.094, off: -0.032, scl: 0.032, loc: 0, pos: 30, scl: 0.500]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, [1]0.099 -> 0.147, off: -0.032, scl: 0.032, loc: 0, pos: 40, scl: 0.500]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]0.153 -> 0.222, off: -0.032, scl: 0.032, loc: 0, pos: 50, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 1.000, [1]0.231 -> 0.329, off: -0.032, scl: 0.032, loc: 0, pos: 60, scl: 0.500]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 1.000, [1]0.342 -> 0.480, off: -0.032, scl: 0.032, loc: 0, pos: 70, scl: 0.500]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 1.000, [1]0.499 -> 0.695, off: -0.032, scl: 0.032, loc: 0, pos: 80, scl: 0.500]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 1.000, [1]0.721 -> 1.000, off: -0.032, scl: 0.032, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 10: ~A" (safe-display-edits ind 0 13 #f)))
- (let ((scl-data (vct-scale! (channel->vct) 2.0)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";map and ptree->xramp (scl) cosine disagree: ~A ~A" map-data scl-data)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (cosine-channel-via-ptree 10 80)
- (set! map-data (channel->vct))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (ptree[0] 10 80) ; ptree-channel [13:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.012, off: -0.032, scl: 0.032]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, [1]0.014 -> 0.030, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, [1]0.033 -> 0.057, off: -0.032, scl: 0.032, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 1.000, [1]0.060 -> 0.094, off: -0.032, scl: 0.032, loc: 0, pos: 20, scl: 0.500]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, [1]0.099 -> 0.147, off: -0.032, scl: 0.032, loc: 0, pos: 30, scl: 0.500]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]0.153 -> 0.222, off: -0.032, scl: 0.032, loc: 0, pos: 40, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 1.000, [1]0.231 -> 0.329, off: -0.032, scl: 0.032, loc: 0, pos: 50, scl: 0.500]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 1.000, [1]0.342 -> 0.480, off: -0.032, scl: 0.032, loc: 0, pos: 60, scl: 0.500]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 1.000, [1]0.499 -> 0.695, off: -0.032, scl: 0.032, loc: 0, pos: 70, scl: 0.500]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.721 -> 1.000, off: -0.032, scl: 0.032]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 11: ~A" (safe-display-edits ind 0 13 #f)))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (cosine-channel-via-ptree 10 80)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (let ((scl-data (channel->vct)))
- (if (not (vequal map-data scl-data))
- (snd-display #__line__ ";ptree+xramp order matters? ~A ~A" map-data scl-data)))
+ (let ((ind (open-sound "1a.snd")))
+ (scale-to 1.0 ind 0)
+ (make-selection 1000 2000 ind 0)
+ (filter-selection-and-smooth .01 (float-vector .25 .5 .5 .5 .25))
+ ; (if (fneq (sample 1500 ind 0) -0.0045776) (snd-display #__line__ ";filter-selection-and-smooth: ~A" (sample 1500 ind 0)))
+ (revert-sound ind)
+ (close-sound ind))
+
+ (set! index (new-sound "fmv.snd" 1 22050 mus-bshort mus-ircam "this is a comment"))
+ (let ((v0 (make-float-vector 128)))
+ (set! (v0 64) .5)
+ (set! (v0 127) .5)
+ (float-vector->channel v0 0 128 index 0)
+ (make-selection 0 126)
+ (smooth-selection)
+ (set! v0 (channel->float-vector 0 128 index 0))
+ (if (or (fneq (sample 127) .5) (fneq (sample 120) .4962) (fneq (sample 32) 0.07431) (fneq (sample 64) 0.25308))
+ (snd-display #__line__ ";smooth-selection: ~A?" v0))
+ (revert-sound index)
+ (fill! v0 0.0)
+ (set! (v0 10) .5)
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (env-sound '(0 0 1 1) 0 100 32.0)
- (cosine-channel-via-ptree 15 70)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (if (not (string-=? (safe-display-edits ind 0 13 #f) "
- (scale 90 10) ; scale-channel 0.500 90 10 [13:13]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.012, off: -0.032, scl: 0.032]) [buf: 100]
- (at 10, cp->sounds[1][10:14, 0.500, [1]0.014 -> 0.020, off: -0.032, scl: 0.032]) [buf: 100]
- (at 15, cp->sounds[1][15:19, 0.500, [1]0.022 -> 0.030, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 1.000]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.033 -> 0.057, off: -0.032, scl: 0.032, loc: 0, pos: 5, scl: 1.000]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.060 -> 0.094, off: -0.032, scl: 0.032, loc: 0, pos: 15, scl: 1.000]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.099 -> 0.147, off: -0.032, scl: 0.032, loc: 0, pos: 25, scl: 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.153 -> 0.222, off: -0.032, scl: 0.032, loc: 0, pos: 35, scl: 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.231 -> 0.329, off: -0.032, scl: 0.032, loc: 0, pos: 45, scl: 1.000]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.342 -> 0.480, off: -0.032, scl: 0.032, loc: 0, pos: 55, scl: 1.000]) [buf: 100]
- (at 80, cp->sounds[1][80:84, 0.500, [1]0.499 -> 0.578, off: -0.032, scl: 0.032, loc: 0, pos: 65, scl: 1.000]) [buf: 100]
- (at 85, cp->sounds[1][85:89, 0.500, [1]0.600 -> 0.695, off: -0.032, scl: 0.032]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.721 -> 1.000, off: -0.032, scl: 0.032]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-tree 12: ~A" (safe-display-edits ind 0 13 #f)))
+ (float-vector->channel v0)
+ (select-all)
+ (let ((old-wid *sinc-width*))
+ (set! *sinc-width* 40)
+ (src-selection 0.5)
+ (set! *sinc-width* old-wid))
+ (set! v0 (channel->float-vector 0 128 index 0))
+ (if (or (fneq (sample 20) .5) (fneq (sample 30) 0.0) (fneq (sample 17) -.1057) )
+ (snd-display #__line__ ";src-selection: ~A?" v0))
+ (unselect-all)
+ (if (selection-member?) (snd-display #__line__ ";unselect-all but still a selection?"))
+ (unselect-all)
+ (revert-sound index)
+ (fill! v0 0.0)
+ (set! (v0 10) .5)
+ (float-vector->channel v0 0)
+ (select-all)
+ (filter-selection '(0 0 .1 1 1 0) 40)
+ (set! v0 (channel->float-vector 0 128 index 0))
+ (if (or (fneq (sample 29) .1945) (fneq (sample 39) -.0137) (fneq (sample 24) -0.01986))
+ (snd-display #__line__ ";filter-selection: ~A?" v0))
+ (revert-sound index)
+ (fill! v0 1.0)
+ (float-vector->channel v0 0 128 index 0)
+ (select-all)
+ (filter-selection (make-one-zero :a0 .5 :a1 0.0))
+ (set! v0 (channel->float-vector 0 128 index 0))
+ (if (or (fneq (sample 29) .5) (fneq (sample 39) .5) (fneq (sample 24) 0.5))
+ (snd-display #__line__ ";filter-selection one-zero: ~A?" v0))
+ (revert-sound index)
+ (fill! v0 1.0)
+ (float-vector->channel v0 0 128 index 0)
+ (if (file-exists? "fmv5.snd") (delete-file "fmv5.snd"))
+ (select-all)
+ (env-selection '(0 0 1 1 2 0) 1.0)
+ (set! v0 (channel->float-vector 0 128 index 0))
+ (if (or (fneq (sample 64) 1.0) (fneq (sample 20) .3125) (fneq (sample 119) 0.127))
+ (snd-display #__line__ ";env-selection [len: ~A]: ~A ~A ~A ~A?" (selection-framples) (sample 64) (sample 20) (sample 119) v0))
+ (save-selection "fmv5.snd" 22050 mus-bint mus-next "") ;1.0->-1.0 if short
+ (revert-sound index)
+ (let ((tag (catch #t (lambda () (file->array "/baddy/hiho" 0 0 128 v0)) (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";file->array w/o file: ~A" tag)))
+ (let ((tag (catch #t (lambda () (file->array "fmv5.snd" 123 0 128 v0)) (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";file->array w/o channel: ~A" tag)))
+ (file->array "fmv5.snd" 0 0 128 v0)
+ (if (or (fneq (v0 64) 1.0) (fneq (v0 20) .3125) (fneq (v0 119) 0.127))
+ (snd-display #__line__ ";save-selection: ~A ~A ~A ~A?" (v0 64) (v0 20) (v0 119) v0))
+ (if (not (= (mus-sound-header-type "fmv5.snd") mus-next))
+ (snd-display #__line__ ";save-selection type: ~A?" (mus-header-type-name (mus-sound-header-type "fmv5.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv5.snd") mus-bint))
+ (snd-display #__line__ ";save-selection format: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv5.snd"))))
+ (if (not (= (mus-sound-srate "fmv5.snd") 22050))
+ (snd-display #__line__ ";save-selection srate: ~A?" (mus-sound-srate "fmv5.snd")))
+ (fill! v0 0.0)
+ (set! (v0 100) .5)
+ (set! (v0 2) -.5)
+ (float-vector->channel v0 0 128 index 0)
+ (select-all)
+ (without-errors (reverse-selection))
+ (save-selection "fmv4.snd" 44100 mus-lfloat mus-riff "this is a comment")
+ (set! v0 (channel->float-vector 0 128 index 0))
+ (if (or (fneq (sample 27) 0.5) (fneq (sample 125) -.5))
+ (snd-display #__line__ ";reverse-selection: ~A?" v0))
+ (file->array "fmv4.snd" 0 0 128 v0)
+ (if (or (fneq (sample 27) 0.5) (fneq (sample 125) -.5))
+ (snd-display #__line__ ";save reverse-selection: ~A?" v0))
+ (if (not (= (mus-sound-header-type "fmv4.snd") mus-riff))
+ (snd-display #__line__ ";save-selection type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv4.snd") mus-lfloat))
+ (snd-display #__line__ ";save-selection format 1: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv4.snd"))))
+ (if (not (= (mus-sound-srate "fmv4.snd") 44100))
+ (snd-display #__line__ ";save-selection srate 1: ~A?" (mus-sound-srate "fmv4.snd")))
+ (if (not (string=? (mus-sound-comment "fmv4.snd") "this is a comment"))
+ (snd-display #__line__ ";save-selection comment: ~A?" (mus-sound-comment "fmv4.snd")))
+ (delete-file "fmv4.snd")
+ (save-selection :file "fmv4.snd" :header-type mus-riff :sample-type mus-lfloat :srate 44100 :comment "this is a comment")
+ (if (not (= (mus-sound-header-type "fmv4.snd") mus-riff))
+ (snd-display #__line__ ";save-selection opt type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv4.snd") mus-lfloat))
+ (snd-display #__line__ ";save-selection opt format 1: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv4.snd"))))
+ (if (not (= (mus-sound-srate "fmv4.snd") 44100))
+ (snd-display #__line__ ";save-selection opt srate 1: ~A?" (mus-sound-srate "fmv4.snd")))
+ (if (not (string=? (mus-sound-comment "fmv4.snd") "this is a comment"))
+ (snd-display #__line__ ";save-selection opt comment: ~A?" (mus-sound-comment "fmv4.snd")))
+ (delete-file "fmv4.snd")
+ (save-selection :file "fmv4.snd" :sample-type mus-bfloat :channel 0)
+ (if (and (not (= (mus-sound-header-type "fmv4.snd") mus-next))
+ (not (= (mus-sound-header-type "fmv4.snd") mus-ircam)))
+ (snd-display #__line__ ";save-selection opt1 type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv4.snd") mus-bfloat))
+ (snd-display #__line__ ";save-selection opt1 format 1: ~A?" (mus-sample-type-name (mus-sound-sample-type "fmv4.snd"))))
+ (if (not (= (mus-sound-chans "fmv4.snd") 1))
+ (snd-display #__line__ ";save-selection opt1 chans: ~A?" (mus-sound-chans "fmv4.snd")))
+ (delete-file "fmv4.snd")
+ (revert-sound index)
+ (fill! v0 0.0)
+ (set! (v0 2) 1.0)
+ (let ((v1 (make-float-vector 256)))
+ (copy v0 v1 0 128)
+ (float-vector->channel v1 0 128 index 0))
+ (select-all)
+ (if (mus-clipping) (set! (mus-clipping) #f))
+ (if *clipping* (set! *clipping* #f))
+ (convolve-selection-with "fmv5.snd" .5)
+ (set! v0 (channel->float-vector 0 128 index 0))
+ (if (fneq (sample 66) -.5) (snd-display #__line__ ";convolve-selection-with: ~A ~A ~A?" (v0 66) (sample 66) v0))
+ (close-sound index))
+ (let* ((obind (open-sound "oboe.snd"))
+ (vol (maxamp obind))
+ (dur (framples)))
+ (when with-gui
+ (set! (amp-control obind) 2.0)
+ (if (fffneq (amp-control obind) 2.0) (snd-display #__line__ ";set amp-control ~A" (amp-control obind)))
+ (reset-controls obind)
+ (if (ffneq (amp-control obind) 1.0) (snd-display #__line__ ";reset amp-control ~A" (amp-control obind)))
+ (set! (amp-control-bounds obind) (list 0.0 4.0))
+ (if (not (equal? (amp-control-bounds obind) (list 0.0 4.0))) (snd-display #__line__ ";amp-control-bounds: ~A" (amp-control-bounds)))
+ (set! (amp-control obind) 2.0)
+ (if (eq? (without-errors (apply-controls obind)) 'no-such-sound) (snd-display #__line__ ";apply-controls can't find oboe.snd?"))
+ (let ((newamp (maxamp obind)))
+ (if (> (abs (- (* 2.0 vol) newamp)) .05) (snd-display #__line__ ";apply amp: ~A -> ~A?" vol newamp))
+ (set! (amp-control-bounds obind) (list 0.0 8.0))
+ (set! (speed-control-bounds obind) (list 1.0 5.0))
+ (if (not (equal? (speed-control-bounds obind) (list 1.0 5.0))) (snd-display #__line__ ";speed-control-bounds: ~A" (speed-control-bounds)))
+ (set! (speed-control obind) 0.5)
+ (set! (speed-control-bounds obind) (list .05 20.0))
+ (add-mark 1234)
+ (apply-controls obind)
+ (let ((newdur (framples obind)))
+ (set! (speed-control obind) 1.0)
+ (if (>= (- newdur (* 2.0 dur)) 256) (snd-display #__line__ ";apply speed: ~A -> ~A?" dur newdur))
+ ;; within 256 which is apply's buffer size (it always flushes full buffers)
+ (set! (contrast-control? obind) #t)
+ (set! (contrast-control-bounds obind) (list 0.5 2.5))
+ (if (not (equal? (contrast-control-bounds obind) (list 0.5 2.5))) (snd-display #__line__ ";contrast-control-bounds: ~A" (contrast-control-bounds)))
+ (set! (contrast-control obind) 1.0)
+ (apply-controls obind)
+ (set! (contrast-control-bounds obind) (list 0.0 10.0))
+ (if (not (equal? (contrast-control-bounds obind) (list 0.0 10.0))) (snd-display #__line__ ";contrast-control-bounds (2): ~A" (contrast-control-bounds)))
+ (let ((secamp (maxamp obind))
+ (secdur (framples obind)))
+ (if (fneq secamp .989) (snd-display #__line__ ";apply contrast: ~A?" secamp))
+ (if (not (= secdur newdur)) (snd-display #__line__ ";apply contrast length: ~A -> ~A?" newdur secdur)))
+ (undo 3 obind)
+ (set! (reverb-control? obind) #t)
+ (set! (reverb-control-scale-bounds obind) (list 0.0 1.0))
+ (if (not (equal? (reverb-control-scale-bounds obind) (list 0.0 1.0)))
+ (snd-display #__line__ ";reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds)))
+ (set! (reverb-control-length-bounds obind) (list 0.0 2.0))
+ (if (not (equal? (reverb-control-length-bounds obind) (list 0.0 2.0)))
+ (snd-display #__line__ ";reverb-control-length-bounds: ~A" (reverb-control-length-bounds)))
+ (set! (reverb-control-scale obind) .2)
+ (let ((nowamp (maxamp obind)))
+ (apply-controls obind)
+ (let ((revamp (maxamp obind))
+ (revdur (framples obind)))
+ (if (ffneq revamp .214)
+ (snd-display #__line__ ";apply reverb scale: ~A at ~A, scale: ~A previous max: ~A?"
+ revamp (maxamp-position obind) (reverb-control-scale obind) nowamp))
+ (if (>= (- revdur (+ 50828 (round (* *reverb-control-decay* 22050)))) 256)
+ (snd-display #__line__ ";apply reverb length: ~A?" revdur))))
+ (undo 1 obind)
+ (set! (expand-control? obind) #t)
+ (set! (expand-control-bounds obind) (list 1.0 3.0))
+ (if (not (equal? (expand-control-bounds obind) (list 1.0 3.0))) (snd-display #__line__ ";expand-control-bounds: ~A" (expand-control-bounds)))
+ (set! (expand-control obind) 1.5)
+ (apply-controls obind)
+ (let ((expamp (maxamp obind))
+ (expdur (framples obind)))
+ (if (> (abs (- expamp .152)) .05) (snd-display #__line__ ";apply expand-control scale: ~A?" expamp))
+ (if (<= expdur (* 1.25 50828)) (snd-display #__line__ ";apply expand-control length: ~A?" expdur))
+ (set! (expand-control-bounds obind) (list 0.001 20.0)))
+ (undo 1 obind)
+ (set! (filter-control? obind) #t)
+ (set! (filter-control-order obind) 40)
+ (set! (filter-control-envelope obind) '(0 0 1 .5 2 0))
+ (apply-controls obind)
+ (let ((fltamp (maxamp obind))
+ (fltdur (framples obind)))
+ (if (> (abs (- fltamp .02)) .005) (snd-display #__line__ ";apply filter scale: ~A?" fltamp))
+ (if (> (- fltdur (+ 40 50828)) 256) (snd-display #__line__ ";apply filter length: ~A?" fltdur))
+ (undo 1 obind)))))
+
+ (revert-sound obind)
+ (make-selection 1000 1000)
+ (scale-selection-to .1)
+ (scale-selection-by 2.0)
+ (make-selection 2000 2001)
+ (scale-selection-by 2.0)
+ (scale-selection-to .5)
+ (make-selection 1000 2001)
+ (scale-selection-to .5)
+ (scale-selection-by .5)
+ (make-selection 2000 2000)
+ (scale-selection-by 2.0)
+ (scale-selection-to .5)
+ (make-selection 1000 1001)
+ (scale-selection-to .1)
+ (scale-selection-by 2.0)
+ (make-selection 999 2002)
+ (scale-selection-to 1.0)
+ (scale-selection-by .5)
+ (let ((tree (edit-tree))
+ (true-tree '((0 0 0 998 1.0 0.0 0.0 0)
+ (999 0 999 999 0.999969720840454 0.0 0.0 0)
+ (1000 0 1000 1000 6.09052181243896 0.0 0.0 0)
+ (1001 0 1001 1001 0.999969720840454 0.0 0.0 0)
+ (1002 0 1002 1999 0.499984979629517 0.0 0.0 0)
+ (2000 0 2000 2000 7.54652404785156 0.0 0.0 0)
+ (2001 0 2001 2001 3.7732629776001 0.0 0.0 0)
+ (2002 0 2002 2002 0.999969720840454 0.0 0.0 0)
+ (2003 0 2003 50827 1.0 0.0 0.0 0)
+ (50828 -2 0 0 0.0 0.0 0.0 0))))
+ (if (not (= (length tree) (length true-tree)))
+ (snd-display #__line__ ";edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
+ (let ((len (length tree)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((branch (tree i))
+ (true-branch (true-tree i)))
+ (if (or (not (= (car branch) (car true-branch)))
+ (not (= (cadr branch) (cadr true-branch)))
+ (not (= (caddr branch) (caddr true-branch)))
+ (not (= (cadddr branch) (cadddr true-branch)))
+ (fneq (branch 4) (true-branch 4)))
+ (snd-display #__line__ ";edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
+ (insert-silence 1001 8)
+ (insert-silence 900 50)
+ (insert-silence 2005 1)
+ (insert-silence 999 2)
+ (let ((tree (edit-tree))
+ (true-tree '((0 0 0 899 1.0 0.0 0.0 0)
+ (900 -1 0 49 0.0 0.0 0.0 0)
+ (950 0 900 948 1.0 0.0 0.0 0)
+ (999 -1 0 1 0.0 0.0 0.0 0)
+ (1001 0 949 998 1.0 0.0 0.0 0)
+ (1051 0 999 999 0.999969720840454 0.0 0.0 0)
+ (1052 0 1000 1000 6.09052181243896 0.0 0.0 0)
+ (1053 -1 0 7 0.0 0.0 0.0 0)
+ (1061 0 1001 1001 0.999969720840454 0.0 0.0 0)
+ (1062 0 1002 1946 0.499984979629517 0.0 0.0 0)
+ (2007 -1 0 0 0.0 0.0 0.0 0)
+ (2008 0 1947 1999 0.499984979629517 0.0 0.0 0)
+ (2061 0 2000 2000 7.54652404785156 0.0 0.0 0)
+ (2062 0 2001 2001 3.7732629776001 0.0 0.0 0)
+ (2063 0 2002 2002 0.999969720840454 0.0 0.0 0)
+ (2064 0 2003 50827 1.0 0.0 0.0 0)
+ (50889 -2 0 0 0.0 0.0 0.0 0))))
+ (if (not (= (length tree) (length true-tree)))
+ (snd-display #__line__ ";silenced edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
+ (let ((len (length tree)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((branch (tree i))
+ (true-branch (true-tree i)))
+ (if (or (not (= (car branch) (car true-branch)))
+ (not (= (cadr branch) (cadr true-branch)))
+ (not (= (caddr branch) (caddr true-branch)))
+ (not (= (cadddr branch) (cadddr true-branch)))
+ (fneq (branch 4) (true-branch 4)))
+ (snd-display #__line__ ";silenced edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
+ (if (or (fneq (sample 998) -.03)
+ (fneq (sample 999) 0.0)
+ (fneq (sample 1000) 0.0)
+ (fneq (sample 1001) -.03))
+ (snd-display #__line__ ";insert-silence [999 for 2]: ~A ~A ~A ~A?" (sample 998) (sample 999) (sample 1000) (sample 1001) ))
+ (if (or (fneq (sample 2006) -.033)
+ (fneq (sample 2007) 0.0)
+ (fneq (sample 2008) -.033))
+ (snd-display #__line__ ";insert-silence [2007 for 1]: ~A ~A ~A?" (sample 2006) (sample 2007) (sample 2008)))
+ (revert-sound obind)
+ (add-mark 1200 obind 0)
+ (let ((mark-num (length (marks obind 0))))
+ (scale-by 2.0 obind 0)
+ (let ((mark-now (length (marks obind 0))))
+ (if (not (= mark-num mark-now))
+ (snd-display #__line__ ";mark lost after scaling?"))
+ (set! (selection-position) 0)
+ (set! (selection-framples) 100)
+ (scale-selection-to .5)
+ (set! mark-now (length (marks obind 0)))
+ (if (not (= mark-num mark-now))
+ (snd-display #__line__ ";mark lost after selection scaling?")))
+ (let ((m1 (add-mark 1000)))
+ (set! (cursor obind 0) 100)
+ (key (char->integer #\u) 4 obind)
+ (key (char->integer #\1) 0 obind)
+ (key (char->integer #\0) 0 obind)
+ (key (char->integer #\0) 0 obind)
+ (key (char->integer #\o) 4 obind)
+ (if (not (= (mark-sample m1) 1100))
+ (snd-display #__line__ ";mark after zeros: ~D (1100)? " (mark-sample m1)))
+ (set! (cursor obind) 0)
+ (key (char->integer #\j) 4 obind)
+ (if (not (= (cursor obind) 1100)) (snd-display #__line__ ";c-j to ~A" (cursor obind)))
+ (add-mark 100)
+ (set! (cursor obind) 0)
+ (key (char->integer #\u) 4 obind)
+ (key (char->integer #\2) 0 obind)
+ (key (char->integer #\j) 4 obind)
+ (if (not (= (cursor obind) 1100)) (snd-display #__line__ ";c-u 2 c-j ~A" (cursor obind)))
+ (key (char->integer #\-) 4 obind)
+ (key (char->integer #\j) 4 obind)
+ (if (not (= (cursor obind) 100)) (snd-display #__line__ ";c-- c-j ~A" (cursor obind)))))
+ (revert-sound obind)
+ (let ((frs (framples obind)))
+ (make-region 0 999 obind 0)
+ (if (not (selection?)) (snd-display #__line__ ";make-region but no selection? ~A" (selection?)))
+ (delete-selection)
+ (if (not (= (framples obind) (- frs 1000)))
+ (snd-display #__line__ ";delete-selection: ~A?" (framples obind)))
+ (let ((val (sample 0 obind 0)))
+ (undo)
+ (if (fneq (sample 1000) val)
+ (snd-display #__line__ ";delete-selection val: ~A ~A" val (sample 1000)))
+ (insert-selection)
+ (let ((var (catch #t (lambda () (insert-selection 0 obind 123)) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-channel))
+ (snd-display #__line__ ";insert-selection bad chan: ~A" var)))
+ (let ((var (catch #t (lambda () (mix-selection 0 obind 123)) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-channel))
+ (snd-display #__line__ ";mix-selection bad chan: ~A" var)))
+ (if (not (= (framples obind) (+ frs 1000)))
+ (snd-display #__line__ ";insert-selection: ~A?" (framples obind)))
+ (if (fneq (sample 2000) val)
+ (snd-display #__line__ ";insert-selection val: ~A ~A" val (sample 2000)))
+ (set! val (sample 900))
+ (mix-selection)
+ (if (fneq (sample 900) (* 2 val))
+ (snd-display #__line__ ";mix-selection val: ~A ~A" (* 2 val) (sample 900)))
+ (if (not (= (framples obind) (+ frs 1000)))
+ (snd-display #__line__ ";mix-selection len: ~A?" (framples obind)))))
+ (close-sound obind))
+
+ (let* ((ind (open-sound "2.snd"))
+ (apply-to-sound 0)
+ (apply-to-channel 1)
+ (apply-to-selection 2)
+ (len (framples ind)))
+ (set! (sync ind) 1)
+ (set! (speed-control ind) .5)
+ (apply-controls ind apply-to-sound) ; temp 1
+ (if (> (abs (- (framples) (* 2 len))) 256)
+ (snd-display #__line__ ";apply srate .5: ~A ~A" (framples) (* 2 len)))
+ (make-selection 0 (framples))
+ (set! (speed-control ind) .5)
+ (apply-controls ind apply-to-selection) ; temp 2
+ (if (> (abs (- (framples) (* 4 len))) 256)
+ (snd-display #__line__ ";apply srate .5 to selection: ~A ~A" (framples) (* 4 len)))
+ (env-sound '(0 0 1 1) 0 (framples) 32.0) ; temp 3
+ (let ((reg (select-all))) ; make multi-channel region
+ (insert-region reg 0) ; temp 4
+ (insert-selection 0)) ; temp 5
+ (revert-sound ind)
+ (set! (speed-control) .5)
+ (set! (sync ind) 0)
+ (set! (selected-channel ind) 1)
+ (apply-controls ind apply-to-channel)
+ (if (> (abs (- (framples ind 1) (* 2 len))) 256)
+ (snd-display #__line__ ";apply srate .5 to chan 1: ~A ~A" (framples ind 1) (* 2 len)))
+ (if (not (= (framples ind 0) len))
+ (snd-display #__line__ ";apply srate .5 but chan 0: ~A ~A" (framples ind 0) len))
+ (set! (speed-control ind) .5)
+ (apply-controls ind apply-to-sound 1000)
+ (make-selection 2000 4000)
+ (set! (speed-control ind) .5)
+ (apply-controls ind apply-to-selection)
+ (set! (selected-channel ind) #f)
+ (if (selected-channel ind) (snd-display #__line__ ";selected-channel #f: ~A" (selected-channel ind)))
(close-sound ind))
- ;; ptree2
- (let ((ind (new-sound "test.snd")) ;4th
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
- (ptree-channel (lambda (y) (* y 0.5)))
- (if (not (vequal (channel->vct) (make-vct 11 0.5)))
- (snd-display #__line__ ";ptree2 0: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 2) "
- (ptree[0] 0 11) ; ptree-channel [2:2]:
- (at 0, cp->sounds[1][0:10, 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree2 3: ~A" (safe-display-edits ind 0 2)))
- (ptree-channel (lambda (y) (* y 1.5)))
- (if (not (vequal (channel->vct) (make-vct 11 0.75)))
- (snd-display #__line__ ";ptree2 1: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ptree[1] 0 11) ; ptree-channel [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree2 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (scale-by (vct 1.5))
- (if (not (vequal (channel->vct) (make-vct 11 0.75)))
- (snd-display #__line__ ";ptree2 5: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (scale 0 11) ; scale-channel 1.500 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.500, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree2 6: ~A" (safe-display-edits ind 0 3)))
- (ptree-channel (lambda (y) (* y 0.1)))
- (if (not (vequal (channel->vct) (make-vct 11 0.075)))
- (snd-display #__line__ ";ptree2 7: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ptree[1] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.500, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree2 8: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
- (scale-by '(0.5))
- (ptree-channel (lambda (y) (* y 1.5)))
- (scale-by 2.0)
- (ptree-channel (lambda (y) (* y 0.1)))
- (scale-by 3.0)
- (if (not (vequal (channel->vct) (make-vct 11 0.45)))
- (snd-display #__line__ ";ptree2 9: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 6) "
- (scale 0 11) ; scale-channel 3.000 0 #f [6:2]:
- (at 0, cp->sounds[1][0:10, 3.000, loc2: 1, pos2: 0, scl2: 2.000, loc: 0, pos: 0, scl: 0.500, code: (lambda (y) (* y 1.5))]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree2 10: ~A" (safe-display-edits ind 0 6)))
- (undo 2)
- (ptree-channel (lambda (y) (* y 0.1)) 2 4)
- (scale-by 3.0)
- (if (not (vequal (channel->vct) (vct 4.500 4.500 0.450 0.450 0.450 0.450 4.500 4.500 4.500 4.500 4.500)))
- (snd-display #__line__ ";ptree2 11: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 6) "
- (scale 0 11) ; scale-channel 3.000 0 #f [6:4]:
- (at 0, cp->sounds[1][0:1, 6.000, loc: 0, pos: 0, scl: 0.500, code: (lambda (y) (* y 1.5))]) [buf: 11]
- (at 2, cp->sounds[1][2:5, 3.000, loc2: 1, pos2: 0, scl2: 2.000, loc: 0, pos: 2, scl: 0.500, code: (lambda (y) (* y 1.5))]) [buf: 11]
- (at 6, cp->sounds[1][6:10, 6.000, loc: 0, pos: 6, scl: 0.500, code: (lambda (y) (* y 1.5))]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree2 12: ~A" (safe-display-edits ind 0 6)))
+ (let* ((ind1 (open-sound "oboe.snd"))
+ (mx1 (maxamp ind1 0))
+ (ind2 (open-sound "2.snd"))
+ (mx20 (maxamp ind2 0))
+ (mx21 (maxamp ind2 1)))
+ (select-sound ind1)
+ (scale-sound-by 2.0)
+ (let ((nmx (maxamp ind1 0)))
+ (if (fneq (* 2 mx1) nmx) (snd-display #__line__ ";scale-sound-by 2.0: ~A ~A?" mx1 nmx))
+ (if (not (equal? (edit-fragment 1 ind1 0) (list "scale-channel 2.000 0 #f" "scale" 0 50828)))
+ (snd-display #__line__ ";scale-sound-by: ~A?" (edit-fragment 1 ind1 0))))
+ (scale-sound-to 0.5)
+ (let ((nmx (maxamp ind1 0)))
+ (if (fneq nmx 0.5) (snd-display #__line__ ";scale-sound-to 0.5: ~A?" nmx))
+ (if (not (equal? (edit-fragment 2 ind1 0) (list "scale-channel 1.698 0 #f" "scale" 0 50828)))
+ (snd-display #__line__ ";scale-sound-to: ~A?" (edit-fragment 2 ind1 0))))
+ (scale-sound-by 0.0 0 1000 ind1 0)
+ (let ((nmx (maxamp ind1 0)))
+ (if (fneq 0.5 nmx) (snd-display #__line__ ";scale-sound-by 0.0: ~A ~A?" mx1 nmx))
+ (if (not (equal? (edit-fragment 3 ind1 0) (list "scale-channel 0.000 0 1000" "scale" 0 1000)))
+ (snd-display #__line__ ";scale-sound-by 0.0: ~A?" (edit-fragment 3 ind1 0))))
+ (let* ((v (channel->float-vector 0 1000 ind1 0))
+ (pk (float-vector-peak v)))
+ (if (fneq pk 0.0) (snd-display #__line__ ";scale-sound-by 0.0 [0:1000]: ~A?" pk)))
+ (revert-sound ind1)
+ (let ((oldv (channel->float-vector 12000 10 ind1 0)))
+ (scale-sound-by 2.0 12000 10 ind1 0)
+ (let ((newv (channel->float-vector 12000 10 ind1 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (* 2.0 (oldv i)) (newv i))
+ (snd-display #__line__ ";scale ~D: ~A ~A?" i (oldv i) (newv i)))))
+ (if (not (equal? (edit-fragment 1 ind1 0) (list "scale-channel 2.000 12000 10" "scale" 12000 10)))
+ (snd-display #__line__ ";scale-sound-by 2.0 [12000:10]: ~A?" (edit-fragment 1 ind1 0))))
+ (revert-sound ind1)
+ (select-sound ind2)
+ (scale-sound-by 2.0)
+ (let ((nmx (maxamp ind2 0)))
+ (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 scale-sound-by 2.0: ~A ~A?" mx20 nmx)))
+ (let ((nmx (maxamp ind2 1)))
+ (if (fneq (* 2 mx21) nmx) (snd-display #__line__ ";2:1 scale-sound-by 2.0: ~A ~A?" mx21 nmx)))
+ (scale-sound-to 0.5)
+ (let ((nmx (max (maxamp ind2 0) (maxamp ind2 1))))
+ (if (fneq nmx 0.5) (snd-display #__line__ ";2 scale-sound-to 0.5: ~A (~A)?" nmx (maxamp ind2))))
+ (scale-sound-by 0.0 0 1000 ind2 1)
+ (if (not (equal? (edit-fragment 3 ind2 1) (list "scale-channel 0.000 0 1000" "scale" 0 1000)))
+ (snd-display #__line__ ";2:1 scale-sound-by 0.0: ~A?" (edit-fragment 3 ind2 1)))
+ (let* ((v (channel->float-vector 0 1000 ind2 1))
+ (pk (float-vector-peak v)))
+ (if (fneq pk 0.0) (snd-display #__line__ ";2:1 scale-sound-by 0.0 [0:1000]: ~A?" pk)))
+ (revert-sound ind2)
+ (let ((oldv (channel->float-vector 12000 10 ind2 0)))
+ (scale-sound-by 2.0 12000 10 ind2 0)
+ (let ((newv (channel->float-vector 12000 10 ind2 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (* 2.0 (oldv i)) (newv i))
+ (snd-display #__line__ ";2 scale ~D: ~A ~A?" i (oldv i) (newv i))))))
+ (revert-sound ind2)
+ (set! (sync ind2) 3)
+ (set! (sync ind1) 3)
+ (scale-sound-by 2.0)
+ (let ((nmx (maxamp ind1 0)))
+ (if (fneq mx1 nmx) (snd-display #__line__ ";sync scale-sound-by 2.0: ~A ~A?" mx1 nmx)))
+ (let ((nmx (maxamp ind2 0)))
+ (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 sync scale-sound-by 2.0: ~A ~A?" mx20 nmx)))
+ (let ((nmx (maxamp ind2 1)))
+ (if (fneq (* 2 mx21) nmx) (snd-display #__line__ ";2:1 sync scale-sound-by 2.0: ~A ~A?" mx21 nmx)))
+ (scale-sound-to 1.0 20000 40000 ind2 1)
+ (let ((nmx (maxamp ind1 0)))
+ (if (fneq mx1 nmx) (snd-display #__line__ ";sync scale-sound-to 1.0: ~A ~A?" mx1 nmx)))
+ (let ((nmx (maxamp ind2 0)))
+ (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 sync scale-sound-to 1.0: ~A ~A?" mx20 nmx)))
+ (let ((nmx (maxamp ind2 1)))
+ (if (fneq nmx 1.0) (snd-display #__line__ ";2:1 sync scale-sound-to 1.0: ~A?" nmx)))
+
+ (close-sound ind1)
+ (close-sound ind2))
+
+ (let ((ind (open-sound "now.snd")))
+ (set! (amp-control ind) .5)
+ (if (ffneq (amp-control ind) .5) (snd-display #__line__ ";amp-control (.5): ~A?" (amp-control ind)))
+ (set! (amp-control ind 0) .25)
+ (if (ffneq (amp-control ind) .5) (snd-display #__line__ ";amp-control after local set (.5): ~A?" (amp-control ind)))
+ (if (ffneq (amp-control ind 0) .25) (snd-display #__line__ ";amp-control 0 (.25): ~A?" (amp-control ind 0)))
+ (set! (amp-control ind) 1.0)
+ (if (ffneq (amp-control ind) 1.0) (snd-display #__line__ ";amp-control (1.0): ~A?" (amp-control ind)))
+ (if (ffneq (amp-control ind 0) .25) (snd-display #__line__ ";amp-control 0 after set (.25): ~A?" (amp-control ind 0)))
+ (set! (transform-graph? ind 0) #t)
+ (set! (transform-graph-type ind 0) graph-as-sonogram)
+ (update-transform-graph ind 0)
+ (when with-motif
+ (let ((val (transform-framples ind 0)))
+ (if (or (not (list? val))
+ (fneq (car val) 1.0)
+ (not (= (caddr val) 256)))
+ (snd-display #__line__ ";transform-framples: ~A (~A)" val (transform-size ind 0)))))
+ (close-sound ind)
+ (set! ind (open-sound "4.aiff"))
+ (if (ffneq (amp-control ind) 1.0) (snd-display #__line__ ";amp-control upon open (1.0): ~A?" (amp-control ind)))
+ (if (ffneq (amp-control ind 2) 1.0) (snd-display #__line__ ";amp-control 2 upon open (1.0): ~A?" (amp-control ind 2)))
+ (set! (amp-control ind) .5)
+ (if (ffneq (amp-control ind 2) .5) (snd-display #__line__ ";amp-control 2 after global set (.5): ~A?" (amp-control ind 2)))
+ (set! (amp-control ind 2) .25)
+ (if (ffneq (amp-control ind 2) .25) (snd-display #__line__ ";amp-control 2 (.25): ~A?" (amp-control ind 2)))
+ (if (ffneq (amp-control ind 1) .5) (snd-display #__line__ ";amp-control 1 after local set (.5): ~A?" (amp-control ind 1)))
+ (let ((after-ran #f))
+ (set! (hook-functions after-apply-controls-hook) ())
+ (hook-push after-apply-controls-hook (lambda (hook) (set! after-ran (hook 'snd))))
+ (apply-controls ind)
+ (if (not (equal? ind after-ran)) (snd-display #__line__ ";after-apply-controls-hook: ~A?" after-ran))
+ (set! (hook-functions after-apply-controls-hook) ()))
+ (revert-sound ind)
+ (set! (sync ind) 1)
+ (scale-to (float-vector .1 .2))
+ (let ((mx (maxamp ind #t)))
+ (if (or (fneq (mx 0) .1)
+ (fneq (mx 1) .2)
+ (fneq (mx 2) .2)
+ (fneq (mx 3) .2))
+ (snd-display #__line__ ";scale to with vector: ~A" mx)))
+ (set! (filter-control-envelope ind) '(0 0 1 1))
+ (if (not (feql '(0.0 0.0 1.0 1.0) (filter-control-envelope ind)))
+ (snd-display #__line__ ";set filter-control-envelope: ~A?" (filter-control-envelope ind)))
+ (set! (filter-control-order ind) 20)
+ (if (not (vequal (filter-control-coeffs ind)
+ (float-vector -0.007 0.010 -0.025 0.029 -0.050 0.055 -0.096 0.109 -0.268 0.241
+ 0.241 -0.268 0.109 -0.096 0.055 -0.050 0.029 -0.025 0.010 -0.007)))
+ (snd-display #__line__ ";highpass coeffs: ~A" (filter-control-coeffs ind)))
+ (set! (filter-control-envelope ind) '(0 1 1 0))
+ (if (not (vequal (filter-control-coeffs ind)
+ (float-vector 0.003 0.002 0.004 0.002 0.007 0.003 0.014 0.012 0.059 0.394
+ 0.394 0.059 0.012 0.014 0.003 0.007 0.002 0.004 0.002 0.003)))
+ (snd-display #__line__ ";lowpass coeffs: ~A" (filter-control-coeffs ind)))
(close-sound ind))
- ;; ptree2-zero
- (let ((ind (new-sound "test.snd"))
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
- (scale-by 0.0)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (if (not (vequal (channel->vct) (make-vct 11 0.5)))
- (snd-display #__line__ ";ptree2-zero 0: ~A" (channel->vct)))
- (ptree-channel (lambda (y) (+ y 0.25)))
- (if (not (vequal (channel->vct) (make-vct 11 0.75)))
- (snd-display #__line__ ";ptree2-zero 1: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 4) (string-append "
- (ptree[1] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[0][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 0.000, code: (lambda (y) (+ y 0.5))]) [file: " (getcwd) "/test.snd[0]]
- (at 11, end_mark)
-")))
- (snd-display #__line__ ";ptree2-zero 2: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
- (scale-channel 0.0 2 4)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (+ y 0.25)))
- (if (not (vequal (channel->vct) (vct 1.750 1.750 0.750 0.750 0.750 0.750 1.750 1.750 1.750 1.750 1.750)))
- (snd-display #__line__ ";ptree2-zero 3: ~A" (channel->vct)))
+ (let* ((obind (open-sound "4.aiff"))
+ (amps (maxamp obind #t))
+ (times (maxamp-position obind #t)))
+ (if (not (equal? times (list 810071 810071 810071 810071)))
+ (snd-display #__line__ ";4.aiff times: ~A" times))
+ (if (< (window-width) 600)
+ (set! (window-width) 600))
+ (if (< (window-height) 600)
+ (set! (window-height) 600))
+ (set! (x-bounds obind 0) (list 0.0 0.1))
+ (set! (show-axes obind 0) show-x-axis)
+ (update-time-graph)
+ (set! (amp-control obind) 0.1)
+ (select-channel 2)
+ (if (eq? (without-errors (apply-controls obind 1)) 'no-such-sound) (snd-display #__line__ ";apply-controls can't find 4.aiff?"))
+ (let ((newamps (maxamp obind #t)))
+ (if (or (fneq (car amps) (car newamps))
+ (fneq (cadr amps) (cadr newamps))
+ (> (abs (- (* 0.1 (caddr amps)) (caddr newamps))) .05)
+ (fneq (cadddr amps) (cadddr newamps)))
+ (snd-display #__line__ ";apply amps:~% ~A ->~% ~A?" amps newamps))
+ (undo 1 obind 2)
+ (set! (amp-control obind) 0.1)
+ (make-region 0 (framples obind) obind 1)
+ (without-errors (apply-controls obind 2))
+ (set! newamps (maxamp obind #t))
+ (if (or (fneq (car amps) (car newamps))
+ (> (abs (- (* 0.1 (cadr amps)) (cadr newamps))) .05)
+ (fneq (caddr amps) (caddr newamps))
+ (fneq (cadddr amps) (cadddr newamps)))
+ (snd-display #__line__ ";apply selection amp:~% ~A ->~% ~A?" amps newamps))
+ (if with-gui
+ (let* ((axinfo (axis-info obind 0 time-graph))
+ (losamp (car axinfo))
+ (hisamp (cadr axinfo))
+ (x0 (axinfo 2))
+ (y0 (axinfo 3))
+ (x1 (axinfo 4))
+ (y1 (axinfo 5))
+ (xpos (+ x0 (* .5 (- x1 x0))))
+ (ypos (+ y0 (* .75 (- y1 y0)))))
+ (define (cp-x x) (floor (+ (axinfo 10)
+ (* (- x x0) (/ (- (axinfo 12) (axinfo 10))
+ (- x1 x0))))))
+ (define (cp-y y) (floor (+ (axinfo 13)
+ (* (- y1 y) (/ (- (axinfo 11) (axinfo 13))
+ (- y1 y0))))))
+ (select-channel 0)
+ (set! (cursor obind) 100)
+ (let ((xy (cursor-position obind)))
+ (if (fneq (position->x (car xy)) (/ (cursor obind) (srate obind)))
+ (snd-display #__line__ ";cursor-position: ~A ~A ~A?" (car xy) (position->x (car xy)) (/ (cursor obind) (srate obind)))))
+ (if (fneq (position->x (x->position xpos)) xpos)
+ (snd-display #__line__ ";x<->position: ~A ~A?" (position->x (x->position xpos)) xpos))
+ (if (> (abs (- (position->y (y->position ypos)) ypos)) .5)
+ (snd-display #__line__ ";y<->position: ~A ~A?" (position->y (y->position ypos)) ypos))
+ (if (not (= losamp (left-sample obind 0)))
+ (snd-display #__line__ ";axis-info[0 losamp]: ~A ~A?" losamp (left-sample obind 0)))
+ (if (not (= hisamp (right-sample obind 0)))
+ (snd-display #__line__ ";axis-info[1 hisamp]: ~A ~A?" hisamp (right-sample obind 0)))
+ (if (fneq (axinfo 6) 0.0)
+ (snd-display #__line__ ";axis-info[6 xmin]: ~A?" (axinfo 6)))
+ (if (fneq (axinfo 7) -1.0)
+ (snd-display #__line__ ";axis-info[7 ymin]: ~A?" (axinfo 7)))
+ (if (fneq (axinfo 9) 1.0)
+ (snd-display #__line__ ";axis-info[9 ymax]: ~A?" (axinfo 9)))
+ (if (> (abs (apply - (our-x->position obind x0))) 1)
+ (snd-display #__line__ ";x0->position: ~A?" (our-x->position obind x0)))
+ (if (> (abs (apply - (our-x->position obind x1))) 1)
+ (snd-display #__line__ ";x1->position: ~A?" (our-x->position obind x1)))
+ (if (> (abs (apply - (our-x->position obind (* 0.5 (+ x0 x1))))) 1)
+ (snd-display #__line__ ";xmid->position: ~A?" (our-x->position obind (* 0.5 (+ x0 x1)))))
+ (if (not full-test)
+ (begin
+ (if (> (abs (- (x->position xpos) (cp-x xpos))) 1)
+ (snd-display #__line__ ";cp-x .5: ~A ~A?" (x->position xpos) (cp-x xpos)))
+ (if (> (abs (- (y->position ypos) (cp-y ypos))) 1)
+ (snd-display #__line__ ";cp-y .75: ~A ~A?" (y->position ypos) (cp-y ypos)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (let ((xpos (+ x0 (random (- x1 x0))))
+ (ypos (+ y0 (random (- y1 y0)))))
+ (if (> (abs (- (x->position xpos) (cp-x xpos))) 1)
+ (snd-display #__line__ ";cp-x[~A] ~A: ~A ~A?" i xpos (x->position xpos) (cp-x xpos)))
+ (if (> (abs (- (y->position ypos) (cp-y ypos))) 1)
+ (snd-display #__line__ ";cp-y[~A] ~A: ~A ~A?" i ypos (y->position ypos) (cp-y ypos)))
+ (if (fneq (position->x (cp-x xpos)) xpos)
+ (snd-display #__line__ ";x->position cp-x ~A ~A" xpos (position->x (cp-x xpos))))
+ (if (fffneq (position->y (cp-y ypos)) ypos)
+ (snd-display #__line__ ";y->position cp-y ~A ~A" ypos (position->y (cp-y ypos))))))))
+ (set! (left-sample obind 0) 1234)
+ (if (not (= 1234 (car (axis-info obind 0))))
+ (snd-display #__line__ ";axis-info[0 losamp at 1234]: ~A ~A?" (car (axis-info obind 0)) (left-sample obind 0)))
+ (set! axinfo (axis-info obind 0))
+ (set! x0 (axinfo 2))
+ (set! x1 (axinfo 4))
+ (if (> (abs (apply - (our-x->position obind x0))) 1)
+ (snd-display #__line__ ";x0a->position: ~A?" (our-x->position obind x0)))
+ (if (> (abs (apply - (our-x->position obind x1))) 1)
+ (snd-display #__line__ ";x1a->position: ~A?" (our-x->position obind x1)))
+ (if (> (abs (apply - (our-x->position obind (* 0.5 (+ x0 x1))))) 1)
+ (snd-display #__line__ ";xmida->position: ~A?" (our-x->position obind (* 0.5 (+ x0 x1)))))
+ (set! (y-bounds obind 0) (list -2.0 3.0))
+ (if (fneq ((axis-info obind 0) 7) -2.0)
+ (snd-display #__line__ ";axis-info[7 ymin -2.0]: ~A?" ((axis-info obind 0) 7)))
+ (if (fneq ((axis-info obind 0) 9) 3.0)
+ (snd-display #__line__ ";axis-info[9 ymax 3.0]: ~A?" ((axis-info obind 0) 9)))
+
+ ))
+ (close-sound obind)))
+
+ (let ((ind1 (open-sound "oboe.snd")))
+ (test-orig (lambda (snd) (src-sound 2.0 1.0 ind1)) (lambda (snd) (src-sound 0.5 1.0 ind1)) 'src-sound ind1)
+ (test-orig (lambda (snd) (src-channel 2.0)) (lambda (snd) (src-channel 0.5)) 'src-channel ind1)
+ (test-orig (lambda (snd) (scale-by 2.0 ind1)) (lambda (snd) (scale-by 0.5 ind1)) 'scale-by ind1)
+ (test-orig (lambda (snd) (scale-channel 2.0)) (lambda (snd) (scale-channel 0.5)) 'scale-channel ind1)
+ (test-orig (lambda (snd) (reverse-sound ind1)) (lambda (snd) (reverse-sound ind1)) 'reverse-sound ind1)
+ (test-orig (lambda (snd) (reverse-channel)) (lambda (snd) (reverse-channel)) 'reverse-channel ind1)
+ (test-orig (lambda (snd) (env-sound '(0 1.0 1 2.0))) (lambda (snd) (env-sound '(0 1.0 1 0.5))) 'env-sound ind1)
+ (test-orig (lambda (snd) (env-sound '(0 1.0 1 2.0 2 1.0))) (lambda (snd) (env-sound '(0 1.0 1 0.5 2 1.0))) 'env-sound ind1)
+ (test-orig (lambda (snd) (env-channel (make-env :envelope '(0 1.0 1 2.0) :length (framples))))
+ (lambda (snd) (env-channel (make-env :envelope '((0 1.0) (1 0.5)) :length (framples)))) 'env-channel ind1)
+ (test-orig (lambda (snd) (env-channel '(0 1.0 1 2.0)))
+ (lambda (snd) (env-channel '(0 1.0 1 0.5))) 'env-channel ind1)
+ (test-orig (lambda (snd) (env-channel (make-env :envelope '(0 2 1 2 2 0.5 3 0.5) :base 0 :length (framples))))
+ (lambda (snd) (env-channel (make-env :envelope '(0 0.5 1 0.5 2 2 3 2) :base 0 :length (framples)))) 'env-channel ind1)
+ (test-orig (lambda (snd) (map-channel (lambda (n) (* n 2.0)))) (lambda (snd) (map-channel (lambda (n) (* n 0.5)))) 'map-channel ind1)
+ (test-orig (lambda (snd) (map-channel (lambda (n) (* n 2.0)) 1234)) (lambda (snd) (map-channel (lambda (n) (* n 0.5)) 1234)) 'map-channel ind1)
+ (test-orig (lambda (snd) (map-channel (lambda (n) (* n 2.0)) 12005 10)) (lambda (snd) (map-channel (lambda (n) (* n 0.5)) 12005 10)) 'map-channel ind1)
+ (test-orig (lambda (snd)
+ (define m1
+ (let ((vect (make-float-vector 2 0.0)))
+ (lambda (y)
+ (float-vector-set! vect 0 (float-vector-set! vect 1 (* y 2)))
+ vect)))
+ (map-channel m1))
+ (lambda (snd)
+ (define m2
+ (let ((outp #f))
+ (lambda (y)
+ (and (set! outp (not outp)) (* y 0.5)))))
+ (map-channel m2))
+ 'map-channel ind1)
+ (test-orig (lambda (snd) (map-channel (lambda (n) (* n 2.0)))) (lambda (snd) (map-channel (lambda (n) (* n 0.5)))) 'map-channel ind1)
+ (test-orig (lambda (snd) (pad-channel 1000 2000 ind1)) (lambda (snd) (delete-samples 1000 2000 ind1)) 'pad-channel ind1)
+ (test-orig (lambda (snd) (clm-channel (make-one-zero :a0 2.0 :a1 0.0)))
+ (lambda (snd) (clm-channel (make-one-zero :a0 0.5 :a1 0.0))) 'clm-channel ind1)
+ (test-orig (lambda (snd) (clm-channel (make-one-pole :a0 2.0 :b1 0.0)))
+ (lambda (snd) (clm-channel (make-one-pole :a0 0.5 :b1 0.0))) 'clm-channel ind1)
+ (test-orig (lambda (snd) (filter-sound (make-one-zero :a0 2.0 :a1 0.0) 2 ind1 0))
+ (lambda (snd) (filter-sound (make-one-zero :a0 0.5 :a1 0.0) 2 ind1 0)) 'filter-sound ind1)
+
+ (let ((var (catch #t (lambda () (src-sound '(0 0 1 1))) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";src-sound env at 0: ~A" var)))
+ (let ((var (catch #t (lambda () (src-sound '(0 1 1 -1))) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";src-sound env through 0: ~A" var)))
+
+ (scale-to 1.0 ind1)
+ (let ((v0 (make-float-vector 10))
+ (v1 (channel->float-vector 12000 10 ind1 0)))
+ (set! (v0 0) 1.0)
+ (array->file "fmv3.snd" v0 10 22050 1)
+ (copy-file "oboe.snd" "fmv4.snd")
+ (convolve-with "fmv3.snd" 1.0 ind1)
+ (convolve-files "fmv4.snd" "fmv3.snd" 1.0 "fmv5.snd")
+ (let ((v2 (channel->float-vector 12000 10 ind1 0)))
+ (if (not (vequal1 v1 v2))
+ (snd-display #__line__ ";~A (orig: 0) ~A ~A" 'convolve-with v1 v2))
+ (file->array "fmv5.snd" 0 12000 10 v2)
+ (if (not (vequal1 v1 v2))
+ (snd-display #__line__ ";convolve-files: (orig: 0) ~A ~A" v1 v2)))
+ (delete-file "fmv3.snd")
+ (delete-file "fmv5.snd"))
+ (convolve-files "2.snd" "oboe.snd" 0.5 "fmv5.snd")
+ (if (or (fneq (cadr (mus-sound-maxamp "fmv5.snd")) 0.25)
+ (fneq (cadddr (mus-sound-maxamp "fmv5.snd")) 0.5))
+ (snd-display #__line__ ";convolve-files stereo: ~A" (mus-sound-maxamp "fmv5.snd")))
+ (delete-file "fmv5.snd")
+ (scale-to .25 ind1)
+ (set! (y-bounds ind1) ())
+ (if (not (equal? (y-bounds ind1) (list -.25 .25)))
+ (snd-display #__line__ ";y-bounds (): ~A?" (y-bounds ind1)))
+ (revert-sound ind1)
- ;; ptree2-ramp
- (revert-sound)
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y .5)))
- (ptree-channel (lambda (y) (+ y .25)))
- (if (not (vequal (channel->vct) (vct 0.250 0.300 0.350 0.400 0.450 0.500 0.550 0.600 0.650 0.700 0.750)))
- (snd-display #__line__ ";ptree2-ramp 1: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ptree[1] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree2-ramp 2: ~A" (safe-display-edits ind 0 4)))
- (scale-by 0.5)
- (if (not (vequal (channel->vct) (vct 0.125 0.150 0.175 0.200 0.225 0.250 0.275 0.300 0.325 0.350 0.375)))
- (snd-display #__line__ ";ptree2-ramp 3: ~A" (channel->vct)))
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 0 11) ; scale-channel 0.500 0 #f [5:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* y 0.5))]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree2-ramp 4: ~A" (safe-display-edits ind 0 5)))
+ (scale-to 1.0 ind1)
+ (let ((v0 (make-float-vector 10))
+ (v1 (channel->float-vector 12000 10 ind1 0)))
+ (set! (v0 5) 1.0)
+ (array->file "fmv3.snd" v0 10 22050 1)
+ (convolve-with "fmv3.snd" 1.0 ind1)
+ (convolve-files "fmv4.snd" "fmv3.snd" 1.0 "fmv5.snd")
+ (let ((v2 (channel->float-vector 12005 10 ind1 0)))
+ (if (not (vequal1 v1 v2))
+ (snd-display #__line__ ";~A (orig: 2) ~A ~A" 'convolve-with v1 v2))
+ (file->array "fmv5.snd" 0 12005 10 v2)
+ (if (not (vequal1 v1 v2))
+ (snd-display #__line__ ";convolve-files: (orig: 2) ~A ~A" v1 v2)))
+ (delete-file "fmv3.snd")
+ (delete-file "fmv4.snd")
+ (delete-file "fmv5.snd"))
- ;; ptree+ramp3
- (revert-sound)
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y .5)))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (ptree[0] 0 11) ; ptree-channel [5:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp3: ~A" (safe-display-edits ind 0 5 #f)))
- (undo 1)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (ptree[0] 0 11) ; ptree-channel [5:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptreec-ramp3: ~A" (safe-display-edits ind 0 5 #f)))
- (undo 4)
- (xramp-channel 0.0 1.0 32.0)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp2: ~A" (safe-display-edits ind 0 4)))
+ (revert-sound ind1)
+ (let ((old-val *selection-creates-region*)
+ (old-regions (regions)))
+ (set! *selection-creates-region* #f)
+ (select-all ind1)
+ (set! *selection-creates-region* old-val)
+ (if (not (equal? old-regions (regions)))
+ (snd-display #__line__ ";selection-create-region: ~A -> ~A?" old-regions (regions))))
+ (convolve-selection-with "pistol.snd" (maxamp))
+ (let ((data (channel->float-vector 12000 10 ind1 0)))
+ (convolve-with "pistol.snd" (maxamp ind1 0 0) ind1 0 0)
+ (let ((new-data (channel->float-vector 12000 10 ind1 0)))
+ (if (not (vequal1 data new-data))
+ (snd-display #__line__ ";convolve-selection-with: ~A ~A?" data new-data))))
+ (revert-sound ind1)
+ (make-selection 1000 2000 ind1)
+ (let ((ma (maxamp ind1)))
+ (convolve-selection-with "pistol.snd" ma)
+ (if (fneq (maxamp ind1) ma) (snd-display #__line__ ";convolve-selection-with 1000: ~A ~A?" ma (maxamp ind1))))
+ (make-selection 1000 2000 ind1)
+ (let ((id (make-region)))
+ (if (not (region? id))
+ (snd-display #__line__ ";make-region argless: ~A" id))
+ (if (not (= (region-framples id 0) (selection-framples)))
+ (snd-display #__line__ ";region/selection-framples: ~A ~A (~A)?" (region-framples id 0) (selection-framples) (region-framples id)))
+ (if (fneq (region-sample id 0) (sample 1000 ind1))
+ (snd-display #__line__ ";region-sample from make-region: ~A ~A?" (region-sample id 0) (sample 1000 ind1))))
+ (close-sound ind1))
+ (let* ((ind (open-sound "2.snd"))
+ (reg (make-region 0 100 ind #t)))
+ (if (not (equal? (region-home reg) (list "2.snd" 0 100)))
+ (snd-display #__line__ ";make + region-home: ~A" (region-home reg)))
+ (if (not (= (region-chans reg) 2))
+ (snd-display #__line__ ";make-region chan #t: ~A" (region-chans reg)))
(close-sound ind))
- ;; ramp2
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 0: ~A" (safe-display-edits ind 0 3)))
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display #__line__ ";ramp2 (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 0 11) ; scale-channel 0.500 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 1: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 0 5) ; scale-channel 0.500 0 5 [4:3]:
- (at 0, cp->sounds[1][0:4, 0.500, [1]-0.000 -> 0.400, [2]-0.000 -> 0.400]) [buf: 11]
- (at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.500 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 2: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display #__line__ ";ramp2 (2): ~A" (channel->vct)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 2 4) ; scale-channel 0.500 2 4 [4:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.200 -> 0.500]) [buf: 11]
- (at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.600 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 3: ~A" (safe-display-edits ind 0 4)))
- (undo 2)
- (ramp-channel 0.75 0.25)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; ramp-channel 0.750 0.250 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]0.750 -> 0.250]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (ramp-channel .2 .6 2 6)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [3:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.700, [2]0.200 -> 0.600]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 0 5) ; scale-channel 0.500 0 5 [4:5]:
- (at 0, cp->sounds[1][0:1, 0.500, [1]-0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.400, [2]0.200 -> 0.360]) [buf: 11]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.500 -> 0.700, [2]0.440 -> 0.600]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 6: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (set 4 1) ; set-sample 4 0.5000 [4:6]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.300, [2]0.200 -> 0.280]) [buf: 11]
- (at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.500 -> 0.700, [2]0.440 -> 0.600]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 7: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
- (close-sound ind))
+ (let ((ind1 (open-sound "2.snd")))
+ (let ((v0 (channel->float-vector 12000 10 ind1 0))
+ (v1 (channel->float-vector 12000 10 ind1 1)))
+ (swap-channels ind1)
+ (let ((v2 (channel->float-vector 12000 10 ind1 0))
+ (v3 (channel->float-vector 12000 10 ind1 1)))
+ (if (or (vequal v0 v2)
+ (vequal v1 v3))
+ (snd-display #__line__ ";swap-channels 0: no change! ~A ~A ~A ~A" v0 v2 v1 v3)))
+ (swap-channels ind1)
+ (let ((v2 (channel->float-vector 12000 10 ind1 0))
+ (v3 (channel->float-vector 12000 10 ind1 1)))
+ (if (or (not (vequal v0 v2))
+ (not (vequal v1 v3)))
+ (snd-display #__line__ ";swap-channels 1: ~A ~A ~A ~A" v0 v2 v1 v3)))
+ ;; as long as we're here...
+ (set! (sync ind1) 0)
+ (set! (cursor ind1 0) 100)
+ (set! (cursor ind1 1) 200)
+ (if (or (not (= (cursor ind1 0) 100))
+ (not (= (cursor ind1 1) 200)))
+ (snd-display #__line__ ";cursor: ~A ~A?" (cursor ind1 0) (cursor ind1 1)))
+ (set! (sync ind1) 1)
+ (scale-by (list .5 .25) ind1)
+ (scale-by (float-vector 2.0 4.0) ind1)
+ (revert-sound ind1)
+ (let ((amps (maxamp ind1 #t)))
+ (swap-channels ind1 0 ind1)
+ (let ((newamps (maxamp ind1 #t)))
+ (if (or (fneq (car amps) (cadr newamps))
+ (fneq (cadr amps) (car newamps)))
+ (snd-display #__line__ ";swap-channels with cp def: ~A ~A" amps newamps)))
+ (swap-channels ind1 1)
+ (let ((newamps (maxamp ind1 #t)))
+ (if (or (fneq (car amps) (car newamps))
+ (fneq (cadr amps) (cadr newamps)))
+ (snd-display #__line__ ";swap-channels with cp def 0: ~A ~A" amps newamps))))
+ (close-sound ind1)))
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
+ (let ((ind1 (open-sound "oboe.snd"))
+ (ind2 (open-sound "2.snd")))
+ (let ((ups1 (count-matches (lambda (n) (> n .1)) 0 ind1 0))
+ (ups2 (let ((count 0)
+ (len (framples ind1))
+ (reader (make-sampler 0 ind1)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) count)
+ (if (> (next-sample reader) .1)
+ (set! count (+ count 1)))))))
+ (if (not (= ups1 ups2))
+ (snd-display #__line__ ";scan-chan: ~A ~A?" ups1 ups2))
+ (set! ups1 (count-matches (lambda (n) (> n .03)) 0 ind2 0))
+ (set! ups2 (count-matches (lambda (n) (> n .03)) 0 ind2 1))
+ (let ((ups3 (let ((count 0)
+ (len (framples ind2))
+ (reader (make-sampler 0 ind2 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) count)
+ (if (> (next-sample reader) .03)
+ (set! count (+ count 1))))))
+ (ups4 (let ((count 0)
+ (len (framples ind2))
+ (reader (make-sampler 0 ind2 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) count)
+ (if (> (next-sample reader) .03)
+ (set! count (+ count 1)))))))
+ (if (not (= ups1 ups3))
+ (snd-display #__line__ ";2[0] scan-chan: ~A ~A?" ups1 ups3))
+ (if (not (= ups2 ups4))
+ (snd-display #__line__ ";2[1] scan-chan: ~A ~A?" ups2 ups4))))
+ (close-sound ind1)
+ (close-sound ind2))
+
+ (let* ((ind1 (open-sound "oboe.snd"))
+ (len (framples ind1))
+ (ctr #f))
+ (map-channel (lambda (n)
+ (and (set! ctr (not ctr))
+ (* n 2.0))))
+ (if (> (framples ind1) (+ (/ len 2) 1))
+ (snd-display #__line__ ";map-channel cut: ~A ~A?" len (framples ind1)))
+ (revert-sound ind1)
+ (set! ctr 0)
+ (map-channel (lambda (n)
+ (or (> (set! ctr (+ ctr 1)) 3) n)))
+ (if (> ctr 4)
+ (snd-display #__line__ ";map-channel no-edit count: ~A?" ctr))
+ (revert-sound ind1)
+ (let ((v1 (make-float-vector 2)))
+ (map-channel (lambda (n)
+ (set! (v1 0) n)
+ (set! (v1 1) (* n 3))
+ v1)))
+ (if (> (abs (- (framples ind1) (* len 2))) 3)
+ (snd-display #__line__ ";map-channel double: ~A ~A?" len (framples ind1)))
+ (revert-sound ind1)
+ (let ((otime (maxamp-position ind1)))
+ (set! (sample 1234) .9)
+ (let ((ntime (maxamp-position ind1))
+ (nval (maxamp ind1))
+ (npos (edit-position ind1 0)))
+ (if (not (= ntime 1234)) (snd-display #__line__ ";maxamp-position 1234: ~A" ntime))
+ (let ((ootime (maxamp-position ind1 0 0)))
+ (if (not (= ootime otime)) (snd-display #__line__ ";maxamp-position edpos 0: ~A ~A" otime ootime)))
+ (let ((nntime (maxamp-position ind1 0 npos)))
+ (if (not (= nntime ntime)) (snd-display #__line__ ";maxamp-position edpos ~D: ~A ~A" npos ntime nntime)))
+ (if (fneq nval .9) (snd-display #__line__ ";maxamp .9: ~A" nval)))
+ (set! (sample 1234) 0.0)
+ (env-channel '(0 0 1 1))
+ (if (not (= (maxamp-position) 35062)) (snd-display #__line__ ";env-channel maxamp-position: ~A" (maxamp-position)))
+ (let ((ootime (maxamp-position ind1 0 0)))
+ (if (not (= ootime otime)) (snd-display #__line__ ";maxamp-position edpos 0(1): ~A ~A" otime ootime)))
+ (let ((nntime (maxamp-position ind1 0 1)))
+ (if (not (= nntime 1234)) (snd-display #__line__ ";maxamp-position edpos 1(1): ~A ~A" 1234 nntime)))
+ (let ((nntime (maxamp-position ind1 0 current-edit-position)))
+ (if (not (= nntime 35062)) (snd-display #__line__ ";maxamp-position edpos current: ~A ~A" 35062 nntime))))
+ (revert-sound ind1)
+ (make-selection 24000 25000)
+ (if (not (= (selection-maxamp-position) 971))
+ (snd-display #__line__ ";selection maxamp position: ~A" (selection-maxamp-position)))
+ (let ((reg (make-region 24000 25000)))
+ (if (not (= (region-maxamp-position reg) 971))
+ (snd-display #__line__ ";region maxamp position: ~A" (region-maxamp-position reg))))
+ (close-sound ind1))
+ (let ((ind1 (open-sound "oboe.snd")))
+ (test-edpos maxamp 'maxamp (lambda () (scale-by 2.0 ind1 0)) ind1)
+ (test-edpos framples 'framples (lambda () (src-sound 2.0 1.0 ind1 0)) ind1)
+ (test-edpos
+ (lambda* ((snd 0) (chn 0) (edpos current-edit-position)) (count-matches (lambda (n1) (> n1 .1)) 0 snd chn edpos))
+ 'count-matches
+ (lambda () (scale-by 2.0 ind1 0))
+ ind1)
+ (test-edpos
+ (lambda* ((snd 0) (chn 0) (edpos current-edit-position)) (scan-channel (lambda (n2) (> n2 .1)) 0 #f snd chn edpos))
+ 'find
+ (lambda () (delete-samples 0 100 ind1 0))
+ ind1)
+ (test-edpos
+ (lambda* ((snd 0) (chn 0) (edpos current-edit-position))
+ (let ((p (make-one-pole 1.0 -1.0)))
+ (scan-channel (lambda (n3)
+ (or (> n3 .1)
+ (not (one-pole p 1.0))))
+ 0 (framples snd chn) snd chn edpos)
+ (floor (one-pole p 0.0))))
+ 'scan-chan
+ (lambda () (delete-samples 0 100 ind1 0))
+ ind1)
+
+ (src-sound 2.0 1.0 ind1 0)
+ (undo 1 ind1 0)
+
+ (delete-samples 0 10000 ind1 0)
+ (save-sound-as "fmv.snd" ind1 :edit-position 0)
+ (save-sound-as "fmv1.snd" ind1 :edit-position 1)
+ (let ((var (catch #t (lambda () (save-sound-as "fmv2.snd" ind1 :channel 1234)) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-channel))
+ (snd-display #__line__ ";save-sound-as bad chan: ~A" var)))
+ (if (not (= (mus-sound-framples "fmv.snd") (framples ind1 0 0)))
+ (snd-display #__line__ ";save-sound-as (edpos): ~A ~A?" (mus-sound-framples "fmv.snd") (framples ind1 0 0)))
+ (if (not (= (mus-sound-framples "fmv1.snd") (framples ind1 0 1)))
+ (snd-display #__line__ ";save-sound-as (edpos 1): ~A ~A?" (mus-sound-framples "fmv.snd") (framples ind1 0 1)))
+ (if (= (mus-sound-framples "fmv.snd") (framples ind1 0 1))
+ (snd-display #__line__ ";save-sound-as (edpos 1)(2): ~A ~A?" (mus-sound-framples "fmv.snd") (framples ind1 0 1)))
+ (let ((ind2 (open-sound "fmv.snd"))
+ (ind3 (open-sound "fmv1.snd")))
+ (if (not (vequal (channel->float-vector 12000 10 ind1 0 0) (channel->float-vector 12000 10 ind2 0)))
+ (snd-display #__line__ ";save-sound-as (edpos 3): ~A ~A?" (channel->float-vector 12000 10 ind1 0 0) (channel->float-vector 12000 10 ind2 0)))
+ (if (not (vequal (channel->float-vector 12000 10 ind1 0 1) (channel->float-vector 12000 10 ind3 0)))
+ (snd-display #__line__ ";save-sound-as (edpos 4): ~A ~A?" (channel->float-vector 12000 10 ind1 0 1) (channel->float-vector 12000 10 ind3 0)))
+ (if (vequal (channel->float-vector 12000 10 ind2 0) (channel->float-vector 12000 10 ind3 0))
+ (snd-display #__line__ ";save-sound-as (edpos 5): ~A ~A?" (channel->float-vector 12000 10 ind2 0) (channel->float-vector 12000 10 ind3 0)))
+ (select-sound ind3)
+ (set! (comment) "hiho")
+ (if (not (string=? (comment) "hiho")) (snd-display #__line__ ";set! comment no index: ~A" (comment)))
+ (close-sound ind2)
+ (close-sound ind3))
+ (delete-file "fmv.snd")
+ (delete-file "fmv1.snd")
- ;; multi-ramp2
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0)
- (if (not (string-=? (safe-display-edits ind 0 13) "
- (ramp 0 100) ; ramp-channel 1.000 0.000 0 #f [13:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]1.000 -> 0.909]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.899 -> 0.808]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.202 -> 0.293, [2]0.798 -> 0.707]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.303 -> 0.394, [2]0.697 -> 0.606]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.404 -> 0.495, [2]0.596 -> 0.505]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.505 -> 0.596, [2]0.495 -> 0.404]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.606 -> 0.697, [2]0.394 -> 0.303]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.707 -> 0.798, [2]0.293 -> 0.202]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.808 -> 0.899, [2]0.192 -> 0.101]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]0.091 -> -0.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-ramp2 1: ~A" (safe-display-edits ind 0 13)))
- (undo 12)
- (ramp-channel 0.0 1.0 10 20)
- (ramp-channel 0.0 1.0 50 10)
- (ramp-channel 0.0 1.0 25 10)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 25 10) ; ramp-channel 0.000 1.000 25 10 [4:8]:
- (at 0, cp->sounds[1][0:9, 1.000]) [buf: 100]
- (at 10, cp->sounds[1][10:24, 1.000, [1]-0.000 -> 0.737]) [buf: 100]
- (at 25, cp->sounds[1][25:29, 1.000, [1]0.789 -> 1.000, [2]-0.000 -> 0.444]) [buf: 100]
- (at 30, cp->sounds[1][30:34, 1.000, [1]0.556 -> 1.000]) [buf: 100]
- (at 35, cp->sounds[1][35:49, 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]-0.000 -> 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:99, 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-ramp2 2: ~A" (safe-display-edits ind 0 4)))
+ (test-edpos-1 (lambda (snd pos) (reverse-sound snd 0 pos)) 'reverse-sound ind1)
+ (test-edpos-1 (lambda (snd pos) (env-sound '(0 0 1 1 2 0) 0 20000 1.0 snd 0 pos)) 'env-sound ind1)
+ (test-edpos-1 (lambda (snd pos) (src-sound 0.5 1.0 snd 0 pos)) 'src-sound ind1)
+ (test-edpos-1 (lambda (snd pos) (filter-sound (make-fir-filter 6 (float-vector .1 .2 .3 .3 .2 .1)) 6 snd 0 pos)) 'filter-sound ind1)
+ (test-edpos-1 (lambda (snd pos) (convolve-with "pistol.snd" .5 snd 0 pos)) 'convolve-with ind1)
+
+ (let ((ind (new-sound "fmv.snd"))
+ (v (make-float-vector 2000))
+ (e (make-env (list 0.0 0.0 1.0 (* 2000 0.2 pi)) :length 2001)))
+ (fill-float-vector v (sin (env e)))
+ (float-vector->channel v 0 2000 ind 0)
+ (filter-sound '(0 0 .09 0 .1 1 .11 0 1 0) 1024)
+ (if (> (maxamp) .025) (snd-display #__line__ ";filter-sound maxamp 1: ~A" (maxamp)))
+ (undo)
+ (filter-sound '(0 0 .19 0 .2 1 .21 0 1 0) 1024)
+ (if (< (maxamp) .9) (snd-display #__line__ ";filter-sound maxamp 2: ~A" (maxamp)))
+ (undo)
+ (filter-sound '(0 0 .29 0 .3 1 .31 0 1 0) 1024)
+ (if (> (maxamp) .02) (snd-display #__line__ ";filter-sound maxamp 3: ~A" (maxamp)))
+
+ (set! *show-sonogram-cursor* #t)
+ (set! *with-tracking-cursor* #t)
+ (if (not *with-tracking-cursor*) (snd-display #__line__ ";with-tracking-cursor set to #t: ~A" *with-tracking-cursor*))
+
+ (set! *transform-graph-type* graph-as-sonogram)
+ (play :wait #t)
+ (set! (transform-graph?) #t)
+
+ (close-sound ind))
+ (close-sound ind1))
+
+ (let ((ind (open-sound "1a.snd"))) ; from Anders Vinjar
+ (set! (with-tracking-cursor) :track-and-return)
+ (set! (cursor) 2000)
+ (let ((here (cursor)))
+ (play :start (cursor))
+ (if (or (not (= here 2000))
+ (not (= (cursor) 2000)))
+ (snd-display #__line__ ";with-tracking-cursor set to :track-and-return: start: ~A, end: ~A" here (cursor))))
+
+ (set! (zoom-focus-style) zoom-focus-middle)
+ (when with-motif
+ (set! (x-zoom-slider) .5)
+ (if (fneq (x-position-slider) 0.25) (snd-display #__line__ ";zoom focus middle .5: ~A" (x-position-slider)))
+ (set! (x-zoom-slider) .1)
+ (if (fneq (x-position-slider) 0.45) (snd-display #__line__ ";zoom focus middle .1: ~A" (x-position-slider)))
+ (set! (x-zoom-slider) .9)
+ (if (fneq (x-position-slider) 0.05) (snd-display #__line__ ";zoom focus middle .9: ~A" (x-position-slider)))
+ (set! (zoom-focus-style) zoom-focus-left)
+ (set! (x-zoom-slider) .1)
+ (if (fneq (x-position-slider) 0.05) (snd-display #__line__ ";zoom focus left .1: ~A" (x-position-slider))))
+
+ (close-sound ind))
+
+ (let* ((ind (open-sound "oboe.snd"))
+ (mx (maxamp ind 0))
+ (e0 (channel-amp-envs ind 0)))
+
+ (define (peak-env-equal? name index e diff)
+ (let ((reader (make-sampler 0 index 0))
+ (e-size (length (car e))))
+ (let ((samps-per-bin (ceiling (/ (framples index) e-size)))
+ (mins (car e))
+ (maxs (cadr e))
+ (happy #t)
+ (data #f))
+ (set! data (make-float-vector samps-per-bin))
+ (do ((e-bin 0 (+ e-bin 1)))
+ ((or (not happy)
+ (= e-bin e-size))
+ happy)
+ (do ((k 0 (+ k 1)))
+ ((= k samps-per-bin))
+ (float-vector-set! data k (next-sample reader)))
+
+ (let ((mx (float-vector-max data))
+ (mn (float-vector-min data)))
+ (let ((mxdiff (abs (- mx (maxs e-bin))))
+ (mndiff (abs (- mn (mins e-bin)))))
+ (if (or (> mxdiff diff)
+ (> mndiff diff))
+ (begin
+ (snd-display #__line__ ";~A: peak-env-equal? [bin ~D of ~D]: (~,4F to ~,4F), diff: ~,5F"
+ name
+ e-bin e-size
+ mn mx
+ (max mxdiff mndiff))
+ (set! happy #f)))))))))
+
+ (if (null? e0)
+ (snd-display #__line__ ";no amp env data")
+ (let ((mx1 (float-vector-peak (car e0)))
+ (mx2 (float-vector-peak (cadr e0))))
+ (if (fneq mx (max mx1 mx2))
+ (snd-display #__line__ ";amp env max: ~A ~A ~A" mx mx1 mx2))
+ (peak-env-equal? "straight peak" ind e0 .0001)
+ (scale-by 3.0)
+ (let* ((e1 (channel-amp-envs ind 0 1))
+ (mx3 (float-vector-peak (car e1)))
+ (mx4 (float-vector-peak (cadr e1))))
+ (if (or (fneq (* 3.0 mx1) mx3)
+ (fneq (* 3.0 mx2) mx4))
+ (snd-display #__line__ ";3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
+ (peak-env-equal? "scaled peak" ind e1 .0001))
+ (if (fneq (maxamp ind 0) (* 3 mx))
+ (snd-display #__line__ ";maxamp after scale: ~A ~A" mx (maxamp ind 0)))
+ (undo)
+ (set! (selection-member? #t) #f)
+ (set! (selection-member? ind 0) #t)
+ (set! (selection-position ind 0) 20000)
+ (set! (selection-framples ind 0) 12000)
+ (scale-selection-by 3.0)
+ (let* ((e1 (channel-amp-envs ind 0 1))
+ (mx3 (float-vector-peak (car e1)))
+ (mx4 (float-vector-peak (cadr e1))))
+ (if (or (fneq (* 3.0 mx1) mx3)
+ (fneq (* 3.0 mx2) mx4))
+ (snd-display #__line__ ";selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
+ (if (fneq (maxamp ind 0) (* 3 mx))
+ (snd-display #__line__ ";maxamp after selection scale: ~A ~A" mx (maxamp ind 0)))
+ (peak-env-equal? "selection peak" ind e1 .0001))
+ (map-channel abs)
+ (let* ((e1 (channel-amp-envs ind 0 2))
+ (mx3 (float-vector-peak (car e1)))
+ (mx4 (float-vector-peak (cadr e1))))
+ (if (fneq (* 3.0 mx2) mx4)
+ (snd-display #__line__ ";abs selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
+ (if (fneq (maxamp ind 0) (* 3 mx))
+ (snd-display #__line__ ";maxamp after abs selection scale: ~A ~A" mx (maxamp ind 0)))
+ (if (ffneq mx3 0.03)
+ (snd-display #__line__ ";abs max: ~A ~A" mx3 mx4))
+ (peak-env-equal? "map-channel peak" ind e1 .0001))
+ (delete-samples 10000 5000)
+ (let* ((e1 (channel-amp-envs ind 0))
+ (mx3 (float-vector-peak (car e1)))
+ (mx4 (float-vector-peak (cadr e1))))
+ (if (fneq (* 3.0 mx2) mx4)
+ (snd-display #__line__ ";abs selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
+ (if (fneq (maxamp ind 0) (* 3 mx))
+ (snd-display #__line__ ";maxamp after abs selection scale: ~A ~A" mx (maxamp ind 0)))
+ (if (ffneq mx3 0.03)
+ (snd-display #__line__ ";abs max: ~A ~A" mx3 mx4))
+ (peak-env-equal? "delete peak" ind e1 .0001))
+ (scale-selection-by -.333)
+ (let* ((e1 (channel-amp-envs ind 0 4))
+ (mx3 (float-vector-peak (car e1))))
+ (if (fneq (maxamp ind 0) mx)
+ (snd-display #__line__ ";maxamp after minus abs selection scale: ~A ~A" mx (maxamp ind 0)))
+ (if (fneq (maxamp ind 0) mx3)
+ (snd-display #__line__ ";mx3 maxamp after minus abs selection scale: ~A ~A" mx mx3))
+ (peak-env-equal? "scale-selection peak" ind e1 .0001))
+
+ (revert-sound ind)
+ (ramp-channel 0.0 1.0)
+ (peak-env-equal? "ramp-channel peak" ind (channel-amp-envs ind 0 1) .001)
+ (undo)
+ (env-channel '(0 0 1 1 2 0))
+ (peak-env-equal? "env-channel peak" ind (channel-amp-envs ind 0 1) .002)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 0) :scaler 0.5 :length (framples)))
+ (peak-env-equal? "scaled env-channel peak" ind (channel-amp-envs ind 0 1) .002)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 0) 0.5 :length (framples)))
+ (peak-env-equal? "scaled nokey env-channel peak" ind (channel-amp-envs ind 0 1) .001)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 0) :scaler 0.5 :offset 0.5 :length (framples)))
+ (peak-env-equal? "scaled and offset env-channel peak" ind (channel-amp-envs ind 0 1) .001)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 .5 3 0) :base 0.0 :length (framples)))
+ (peak-env-equal? "env-channel base 0.0 peak" ind (channel-amp-envs ind 0 1) .001)
+ (undo)
+ (xramp-channel 0.0 1.0 32.0)
+ (peak-env-equal? "xramp 32.0 peak" ind (channel-amp-envs ind 0 1) .008)
+ (undo)
+ (xramp-channel 0.0 1.0 .032)
+ (peak-env-equal? "xramp .032 peak" ind (channel-amp-envs ind 0 1) .004)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 .5 3 0) :base 10.0 :length (framples)))
+ (peak-env-equal? "env-channel base 10.0 peak" ind (channel-amp-envs ind 0 1) .003)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 0) :base .10 :length (framples)))
+ (peak-env-equal? "env-channel base .1 peak" ind (channel-amp-envs ind 0 1) .003)
+ (undo)
+ (revert-sound ind)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 1.0 0.0)
+ (peak-env-equal? "ramp2 peak" ind (channel-amp-envs ind 0 2) .002)
+
+ (revert-sound ind)
+ (env-channel '(0 0 1 1))
+ (env-channel '(0 0 1 1 2 0))
+ (peak-env-equal? "env ramp2 peak" ind (channel-amp-envs ind 0 2) .002)
+
+ (revert-sound ind)
+ (ramp-channel 0.0 1.0 12000 5000)
+ (peak-env-equal? "ramp-channel peak" ind (channel-amp-envs ind 0 1) .002)
+ (undo)
+ (env-channel '(0 0 1 1 2 0) 12000 5000)
+ (peak-env-equal? "env-channel peak" ind (channel-amp-envs ind 0 1) .003)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 5000) 12000 5000)
+ (peak-env-equal? "scaled env-channel peak" ind (channel-amp-envs ind 0 1) .004)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 0) 0.5 :length 5000) 12000 5000)
+ (peak-env-equal? "scaled nokey env-channel peak" ind (channel-amp-envs ind 0 1) .004)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 0) :scaler 0.5 :offset 0.5 :length 5000) 12000 5000)
+ (peak-env-equal? "scaled and offset env-channel peak" ind (channel-amp-envs ind 0 1) .002)
+ (undo)
+ (xramp-channel 0.0 1.0 32.0 2000 1000)
+ (peak-env-equal? "xramp 32.0 peak (1)" ind (channel-amp-envs ind 0 1) .009)
+ (undo)
+ (xramp-channel 0.0 1.0 .032 2000 1000)
+ (peak-env-equal? "xramp .032 peak (1)" ind (channel-amp-envs ind 0 1) .009)
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 .5 3 0) :base 10.0 :length 5000) 12000 5000)
+ (peak-env-equal? "env-channel base 10.0 peak" ind (channel-amp-envs ind 0 1) .1)
+ ;; this can be way off because the envelope is not very closely sampled in this case
+ (revert-sound ind)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 1.0 0.0 2000 1000)
+ (peak-env-equal? "ramp2 peak" ind (channel-amp-envs ind 0 2) .002)
+
+ (revert-sound ind)
+ (env-channel '(0 0 1 1))
+ (env-channel '(0 0 1 1 2 0) 2000 1000)
+ (peak-env-equal? "env ramp2 peak" ind (channel-amp-envs ind 0 2) .002)
+
+ (revert-sound ind)
+ (env-channel '(0 0 1 1))
+ (env-channel '(0 0 1 1 2 0))
+ (env-channel '(0 0 1 1) 12000 5000)
+ (peak-env-equal? "env ramp3 peak" ind (channel-amp-envs ind 0 3) .01)
+
+ (revert-sound ind)
+
+ ))
(close-sound ind))
(let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- ;; ramp ptree cases
+ (map-channel (lambda (y) 1.0) 0 50001)
+ (ramp-channel 0.5 1.0 1000 4000)
+ (let* ((peaks (channel-amp-envs ind 0))
+ (mx (cadr peaks))
+ (mn (car peaks)))
+ (call-with-current-continuation
+ (lambda (break)
+ (if (not (continuation? break)) (snd-display #__line__ ";not a continuation: ~A" break))
+ (let ((ln (- (length mn) 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i ln))
+ (if (< (mn i) 0.5) (begin (snd-display #__line__ ";peak min: ~A ~A" (mn i) i) (break #f)))
+ (if (< (mx i) 0.5) (begin (snd-display #__line__ ";peak max: ~A ~A" (mx i) i) (break #f))))))))
+ (undo 2)
+ (map-channel (lambda (y) -1.0) 0 50001)
+ (ramp-channel 0.5 1.0 1000 4000)
+ (let* ((peaks (channel-amp-envs ind 0))
+ (mx (cadr peaks))
+ (mn (car peaks))
+ (happy #t)
+ (ln (- (length mn) 4)))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy)
+ (= i ln)))
+ (if (> (mn i) -0.5) (begin (snd-display #__line__ ";1 peak min: ~A ~A" (mn i) i) (set! happy #f)))
+ (if (> (mx i) -0.5) (begin (snd-display #__line__ ";1 peak max: ~A ~A" (mx i) i) (set! happy #f)))))
+ (close-sound ind))
+
+ (let ((index (new-sound "fmv.snd" 2 22050 mus-ldouble mus-next "channel tests")))
+ (define (test-channel-func func val-func init-val)
+ (let ((len (framples index))
+ (chns (chans index))
+ (val #f))
+ (set! g-init-val init-val)
+ (do ((k 0 (+ k 1)))
+ ((= k 2))
+ (set! val (val-func len))
+ (set! (sync index) k)
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (map-channel (lambda (n) 0.0) 0 len index i)
+ (if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index i)
+ (snd-display #__line__ ";init scan: ~A?" (scan-channel (lambda (n) (> (abs n) 0.001))))))
+ ;; now it's cleared
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (map-channel (lambda (n) g-init-val) 0 len index i)
+ (func 0 len index i)
+ (do ((j 0 (+ j 1)))
+ ((= j chns))
+ (let ((vi (channel->float-vector 0 len index j)))
+ (if (= j i)
+ (if (not (vequal vi val))
+ (snd-display #__line__ ";chan func: ~A ~A" vi val))
+ (if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index j)
+ (snd-display #__line__ ";chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (map-channel (lambda (n) 0.0) 0 len index i))
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (map-channel (lambda (n) g-init-val) 0 len index i)
+ (let ((ed (edit-position index i)))
+ (map-channel (lambda (n) (+ g-init-val 1.0)) 0 len index i)
+ (func 0 len index i ed)
+ (do ((j 0 (+ j 1)))
+ ((= j chns))
+ (let ((vi (channel->float-vector 0 len index j)))
+ (if (= j i)
+ (if (not (vequal vi val))
+ (snd-display #__line__ ";ed chan func: ~A ~A" vi val))
+ (if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
+ (snd-display #__line__ ";ed chan func leaks? ~A ~A ~A: ~A" i j ed (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (map-channel (lambda (n) 0.0) 0 len index i)))
+ (let* ((beg (floor (/ len 3)))
+ (dur beg)
+ (nv (val-func dur)))
+ (fill! val 0.0)
+ (do ((i beg (+ i 1))
+ (j 0 (+ j 1)))
+ ((= j dur))
+ (set! (val i) (nv j)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (map-channel (lambda (n) g-init-val) beg dur index i)
+ (func beg dur index i)
+ (add-mark beg index i)
+ (do ((j 0 (+ j 1)))
+ ((= j chns))
+ (let ((vi (channel->float-vector 0 len index j)))
+ (if (= j i)
+ (if (not (vequal vi val))
+ (snd-display #__line__ ";chan func n: ~A ~A" vi val))
+ (if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
+ (snd-display #__line__ ";dur chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
+ (map-channel (lambda (n) 0.0) 0 len index i))))))
+
+ (insert-silence 0 10 index 0)
+ (insert-silence 0 10 index 1)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (clm-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos))
+ (lambda (dur)
+ (let ((e (make-env :envelope '(0 0 1 1) :length dur))
+ (v (make-float-vector dur)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (set! (v i) (env e)))
+ v))
+ 0.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (clm-channel (make-oscil :frequency 0.0 :initial-phase (/ pi 2)) beg dur index chan edpos))
+ (lambda (dur)
+ (let ((v (make-float-vector dur)))
+ (fill! v 1.0)
+ v))
+ 0.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (scale-channel 0.5 beg dur index chan edpos))
+ (lambda (dur)
+ (let ((v (make-float-vector dur)))
+ (fill! v 0.5)
+ v))
+ 1.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (env-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos))
+ (lambda (dur)
+ (let ((e (make-env :envelope '(0 0 1 1) :length dur))
+ (v (make-float-vector dur)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (set! (v i) (env e)))
+ v))
+ 1.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (env-channel '(0 0 1 1) beg dur index chan edpos))
+ (lambda (dur)
+ (let ((e (make-env :envelope '(0 0 1 1) :length dur))
+ (v (make-float-vector dur)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (set! (v i) (env e)))
+ v))
+ 1.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (let ((v (make-float-vector dur)))
+ (fill! v -1.0)
+ (float-vector->channel v beg dur index chan)))
+ (lambda (dur)
+ (let ((v (make-float-vector dur)))
+ (fill! v -1.0)
+ v))
+ 1.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (delete-samples beg dur index chan edpos)
+ (pad-channel beg dur index chan edpos))
+ make-float-vector
+ 1.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (let ((v (make-float-vector dur)))
+ (fill! v -1.0)
+ (delete-samples beg dur index chan edpos)
+ (insert-samples beg dur v index chan edpos)))
+ (lambda (dur)
+ (let ((v (make-float-vector dur)))
+ (fill! v -1.0)
+ v))
+ 1.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (let ((v (make-float-vector dur)))
+ (fill! v -1.0)
+ (set! (samples beg dur index chan #f "test-channel" 0 edpos) v)))
+ (lambda (dur)
+ (let ((v (make-float-vector dur)))
+ (fill! v -1.0)
+ v))
+ 1.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (env-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos)
+ (reverse-channel beg dur index chan))
+ (lambda (dur)
+ (let ((e (make-env :envelope '(0 1 1 0) :length dur))
+ (v (make-float-vector dur)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (set! (v i) (env e)))
+ v))
+ 1.0)
+
+ (test-channel-func (lambda* (beg dur index chan edpos)
+ (env-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos)
+ (set! (sample (+ beg dur) index chan) 1.0)
+ (smooth-channel beg dur index chan)
+ (if (not (= beg 0))
+ (set! (sample (+ beg dur) index chan) 0.0)))
+ (lambda (dur)
+ (let ((v (make-float-vector dur))
+ (ipi (/ pi dur)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (set! (v i) (+ 0.5 (* 0.5 (cos (+ pi (* ipi i)))))))
+ v))
+ 1.0)
+
+ (let ((old-max (maxamp index #t))
+ (regdata (map (lambda (n)
+ (catch #t
+ (lambda ()
+ (region->float-vector n 0 10))
+ (lambda args (float-vector))))
+ (regions)))
+ ;; (old-pos0 (edit-position index 0))
+ ;; (old-pos1 (edit-position index 1))
+ (old-reglen (map region-framples (regions)))
+ (s61-files ()))
+ (hook-push save-state-hook
+ (lambda (hook)
+ (set! s61-files (cons (hook 'name) s61-files))))
+ (if (file-exists? "s61.scm") (delete-file "s61.scm"))
+ (save-state "s61.scm")
+ (close-sound index)
+ (for-each forget-region (regions))
+ (load (string-append cwd "s61.scm"))
+ (if (not (equal? old-reglen (map region-framples (regions))))
+ (snd-display #__line__ ";region-framples after save: ~A ~A" old-reglen (map region-framples (regions))))
+ (catch #t
+ (lambda ()
+ (for-each (lambda (n data)
+ (if (not (vequal data (region->float-vector n 0 10)))
+ (snd-display #__line__ ";region after save ~A: ~A ~A" n data (region->float-vector n 0 10))))
+ (regions)
+ regdata))
+ (lambda args (snd-display #__line__ ";region->float-vector: ~A" args)))
+ (set! index (find-sound "fmv.snd"))
+ (if (not (equal? (maxamp index #t) old-max))
+ (snd-display #__line__ ";maxes: ~A ~A" (maxamp index #t) old-max))
+ (if (not (equal? (edits index) (list 275 0)))
+ (snd-display #__line__ ";saved channel edits: ~A" (edits index)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (let ((pos (random (car (edits index)))))
+ (scale-channel (random 2.0) (random 5) (random 5) index 0 pos)
+ (set! (edit-position index) (floor (* (car (edits index)) .7)))))
+
+ (close-sound index)
+ (for-each forget-region (regions))
+ (for-each
+ (lambda (file)
+ (if (file-exists? file)
+ (delete-file file)))
+ s61-files)
+ (delete-file "s61.scm")
+ (set! (hook-functions save-state-hook) ())
+ ))
+
+ (let ((index (new-sound "fmv.snd" 2 22050 mus-ldouble mus-next "channel tests"))
+ (v (make-float-vector 10))
+ (sw *sinc-width*))
+ (set! *sinc-width* 10)
+ (set! (v 0) 1.0)
+ (float-vector->channel v 0 10 index 0)
+ (src-channel 0.5 0 10 index 0)
+ (let ((v (make-float-vector 10))
+ (s (make-src :srate 0.5
+ :input (let ((val 1.0))
+ (lambda (dir)
+ (let ((rtn val))
+ (set! val 0.0)
+ rtn))))))
+ (set! (v 0) (src s))
+ (do ((i 1 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (src s)))
+ (if (not (vequal v (channel->float-vector 0 10 index 0)))
+ (snd-display #__line__ ";src-channel: ~A ~A" v (channel->float-vector 0 10 index 0)))
+ (if (not (vequal (make-float-vector 10) (channel->float-vector 0 10 index 1)))
+ (snd-display #__line__ ";src-channel leaks: ~A" (channel->float-vector 0 10 index 1))))
+ (let ((tag (catch #t (lambda () (src-channel 120000.0)) (lambda args args))))
+ (if (not (eq? (car tag) 'mus-error)) (snd-display #__line__ ";src-channel crazy srate: ~A" tag)))
+ (let ((tag (catch #t (lambda () (filter-sound (make-snd->sample))) (lambda args args))))
+ (if (not (eq? (car tag) 'mus-error)) (snd-display #__line__ ";filter-sound + un-run gen: ~A" tag)))
+ (revert-sound index)
+ (float-vector->channel v 0 10 index 1)
+ (float-vector->channel v 10 10 index 1)
+ (src-channel (make-env :envelope '(1 1 2 2) :length 21) 0 20 index 1)
+ (if (not (vequal (channel->float-vector 0 10 index 1) (float-vector 1.000 -0.000 -0.048 0.068 -0.059 0.022 0.030 -0.100 0.273 0.606)))
+ (snd-display #__line__ ";src-channel env: ~A" (channel->float-vector 0 10 index 1)))
+ (if (not (vequal (make-float-vector 10) (channel->float-vector 0 10 index 0)))
+ (snd-display #__line__ ";src-channel env leaks: ~A" (channel->float-vector 0 10 index 0)))
+ (revert-sound index)
+ (float-vector->channel v 0 10 index 1)
+ (float-vector->channel v 10 10 index 1)
+ (src-channel '(1 1 2 2) 0 20 index 1) ; end is off above -- should be 19 I think
+ (if (not (vequal (channel->float-vector 0 10 index 1) (float-vector 1.000 -0.000 -0.051 0.069 -0.056 0.015 0.042 -0.117 0.320 0.568)))
+ (snd-display #__line__ ";src-channel lst: ~A" (channel->float-vector 0 10 index 1)))
+ (if (not (vequal (make-float-vector 10) (channel->float-vector 0 10 index 0)))
+ (snd-display #__line__ ";src-channel lst leaks: ~A" (channel->float-vector 0 10 index 0)))
+ (set! *sinc-width* sw)
+ (close-sound index))
+
+ (let ((ind (new-sound :size 100)))
(for-each
- (lambda (func func-zero name)
- (func)
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 3 #f) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";~A 1: ~A" name (safe-display-edits ind 0 3 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450 0.500)))
- (snd-display #__line__ ";~A 1: ~A" name (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 4 #f) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";~A 2: ~A" name (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
- (snd-display #__line__ ";~A 2: ~A" name (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";~A 3: ~A" name (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.004 0.013 0.032 0.062 0.108 0.171 0.256 0.364 0.500)))
- (snd-display #__line__ ";~A 3: ~A" name (channel->vct)))
-
- (undo 4)
- (scale-by 0.0)
- (func-zero)
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 4 #f) (string-append "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
- (at 0, cp->sounds[0][0:10, 1.000, [1]-0.000 -> 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
- (at 11, end_mark)
-")))
- (snd-display #__line__ ";~A-zero 1: ~A" name (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450 0.500)))
- (snd-display #__line__ ";~A-zero 1: ~A" name (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) (string-append "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
- (at 0, cp->sounds[0][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
- (at 11, end_mark)
-")))
- (snd-display #__line__ ";~A-zero 2: ~A" name (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
- (snd-display #__line__ ";~A-zero 2: ~A" name (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 6 #f) (string-append "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [6:2]:
- (at 0, cp->sounds[0][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
- (at 11, end_mark)
-")))
- (snd-display #__line__ ";~A-zero 3: ~A" name (safe-display-edits ind 0 6 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.004 0.013 0.032 0.062 0.108 0.171 0.256 0.364 0.500)))
- (snd-display #__line__ ";~A-zero 3: ~A" name (channel->vct)))
- (undo 5)
- )
- (list
- (lambda () (ptree-channel (lambda (y) (* y 0.5))))
- (lambda () (ptree-channel
- (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
- (list
- (lambda () (ptree-channel (lambda (y) (+ y 0.5))))
- (lambda () (ptree-channel
- (lambda (y data forward)
- (+ y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
- (list "ramp-ptree" "ramp-ptreec"))
-
+ (lambda (sr)
+ (revert-sound ind)
+ (set! (sample 50) .5)
+ (set! (sample 51) -.5)
+ (src-channel sr)
+ (let ((v1 (channel->float-vector)))
+ (revert-sound ind)
+ (set! (sample 50) .5)
+ (set! (sample 51) -.5)
+ (src-channel (+ sr .00001))
+ (let ((v2 (channel->float-vector)))
+ (float-vector-abs! (float-vector-subtract! v1 v2))
+ (let ((sum 0.0)
+ (len (min (length v1) (length v2)))
+ (mx (float-vector-peak v1)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! sum (+ sum (float-vector-ref v1 i))))
+ (if (or (> sum .01) ; depends on sinc-width I think
+ (> mx .002))
+ (snd-display #__line__ ";src-channel ~A: diff: ~A ~A~%" sr sum mx))))))
+ (list 0.5 0.75 1.0 1.5 2.0))
(close-sound ind))
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
+ (if (< *max-regions* 8) (set! *max-regions* 8))
+ (let* ((ind (open-sound "oboe.snd"))
+ (rid0 (make-region 2000 2020 ind 0))
+ (rid0-data (region2float-vector rid0 0 20)))
+ (scale-sound-by 2.0)
+ (play rid0 :wait #t)
+ (let ((nv (region2float-vector rid0 0 20)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";deferred region after scaling:~% ~A~% ~A" rid0-data nv)))
+ (let ((nv (region-to-float-vector rid0 0 20)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";deferred region after scaling (rs):~% ~A~% ~A" rid0-data nv)))
+ (undo)
+ (scale-by 4.0)
+ (play rid0 :wait #t)
+ (let ((nv (region2float-vector rid0 0 20)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after scaling:~% ~A~% ~A" rid0-data nv)))
+ (let ((nv (region-to-float-vector rid0 0 20)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after scaling (rs):~% ~A~% ~A" rid0-data nv)))
+ (let* ((rid1 (make-region 2000 2020 ind 0))
+ (rid1-data (region2float-vector rid1 0 20)))
+ (scale-to .5)
+ (let ((nv (region2float-vector rid1 0 20)))
+ (if (not (vequal rid1-data nv)) (snd-display #__line__ ";deferred region after scale-to:~% ~A~% ~A" rid1-data nv)))
+ (close-sound ind)
+ (play rid0 :wait #t)
+ (play rid1 :wait #t)
+ (let ((nv (region2float-vector rid1 0 20)))
+ (if (not (vequal rid1-data nv)) (snd-display #__line__ ";deferred region after close:~% ~A~% ~A" rid1-data nv)))
+ (let ((nv (region2float-vector rid0 0 20)))
+ (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after close:~% ~A~% ~A" rid0-data nv))))
- ;; xramp ptree cases
(for-each
- (lambda (func func-zero name twice)
- (func)
- (xramp-channel 0 1 32)
- (if (not (vequal (channel->vct) (vct 0.000 0.007 0.016 0.029 0.048 0.075 0.113 0.166 0.242 0.349 0.500)))
- (snd-display #__line__ ";~A 1: ~A" name (channel->vct)))
- (if twice
- (begin
- (xramp-channel 0 1 32)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.001 0.002 0.005 0.011 0.025 0.055 0.117 0.243 0.500)))
- (snd-display #__line__ ";~A 2: ~A" name (channel->vct)))
- (undo 1)))
- (undo 2)
- (scale-by 0.0)
- (func-zero)
- (xramp-channel 0 1 32)
- (if (not (vequal (channel->vct) (vct 0.000 0.007 0.016 0.029 0.048 0.075 0.113 0.166 0.242 0.349 0.500)))
- (snd-display #__line__ ";~A-zero 1: ~A" name (channel->vct)))
- (if twice
- (begin
- (xramp-channel 0 1 32)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.001 0.002 0.005 0.011 0.025 0.055 0.117 0.243 0.500)))
- (snd-display #__line__ ";~A-zero 2: ~A" name (channel->vct)))
- (undo 1)))
- (undo 3))
- (list
- (lambda () (ptree-channel (lambda (y) (* y 0.5))))
- (lambda () (ptree-channel
- (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
- (list
- (lambda () (ptree-channel (lambda (y) (+ y 0.5))))
- (lambda () (ptree-channel
- (lambda (y data forward)
- (+ y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (p d) (vct 0.5)))))
- (list "xramp-ptree" "xramp-ptreec")
- (list #t #t))
-
+ (lambda (s1 l1 s2 l2)
+ (set! ind (open-sound "2.snd"))
+ (set! (selection-member? #t) #f)
+ (set! (selection-member? ind 0) #t)
+ (set! (selection-position ind 0) s1)
+ (set! (selection-framples ind 0) l1)
+ (set! (selection-member? ind 1) #t)
+ (set! (selection-position ind 1) s2)
+ (set! (selection-framples ind 1) l2)
+ (let* ((rid2 (make-region))
+ (rid20-data (region2float-vector rid2 0 l1))
+ (rid21-data (region2float-vector rid2 1 l2)))
+ (if (not (= (region-chans rid2) 2)) (snd-display #__line__ ";region-chans of sync'd sound: ~A?" (region-chans rid2)))
+ (swap-channels ind 0 ind 1)
+ (let ((nv (region2float-vector rid2 0 l1)))
+ (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20):~% ~A~% ~A" rid20-data nv)))
+ (let ((nv (region-to-float-vector rid2 0 l1)))
+ (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20 rs):~% ~A~% ~A" rid20-data nv)))
+ (let ((nv (region2float-vector rid2 1 l2)))
+ (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21):~% ~A~% ~A" rid21-data nv)))
+ (let ((nv (region-to-float-vector rid2 1 l2)))
+ (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21 rs):~% ~A~% ~A" rid21-data nv)))
+ (close-sound ind)
+ (let ((nv (region2float-vector rid2 0 l1)))
+ (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20):~% ~A~% ~A" rid20-data nv)))
+ (let ((nv (region-to-float-vector rid2 0 l1)))
+ (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20 rs):~% ~A~% ~A" rid20-data nv)))
+ (let ((nv (region2float-vector rid2 1 l2)))
+ (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21):~% ~A~% ~A" rid21-data nv)))
+ (let ((nv (region-to-float-vector rid2 1 l2)))
+ (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21 rs):~% ~A~% ~A" rid21-data nv)))
+ ))
+ (list 2000 2000 2000 0 2000 0 2000)
+ (list 20 10 20 20 20 10 20)
+ (list 2000 2000 2000 2000 0 2000 0)
+ (list 20 20 10 20 20 20 10)))
+
+ (let ((ind (open-sound "obtest.snd")))
+ (set! (read-only ind) #t)
+ (delete-samples 0 1000 ind 0)
+ (let ((val (catch #t
+ (lambda ()
+ (save-sound ind))
+ (lambda args args))))
+ (if (sound? val) (snd-display #__line__ ";save-sound read-only: ~A" val))
+ (if (not (equal? (edits ind) (list 1 0))) (snd-display #__line__ ";read-only ignored? ~A" (edits ind))))
+ (set! (read-only ind) #f)
+ (revert-sound ind)
+ (let ((tag (catch #t
+ (lambda () (save-sound ind))
+ (lambda args args))))
+ (if (not (sound? tag)) (snd-display #__line__ ";save-sound read-write: ~A" tag)))
+ (key (char->integer #\j) 4)
+ (key (char->integer #\-) 4)
+ (key (char->integer #\j) 4)
+ (key (char->integer #\j) 4)
+ (key (char->integer #\x) 4)
+ (key (char->integer #\c) 0)
+ (catch #t (lambda () (add-mark 123)) (lambda args #f))
+ (key (char->integer #\u) 4)
+ (key (char->integer #\6) 4)
+ (key (char->integer #\j) 4)
+ (key (char->integer #\u) 4)
+ (key (char->integer #\6) 4)
+ (key (char->integer #\x) 4)
+ (key (char->integer #\c) 0)
(close-sound ind))
- ;; ramp-xramp, xramp-ramp
- (let ((ind (new-sound "test.snd"))
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp 0: ~A" (safe-display-edits ind 0 3)))
- (set! case1 (channel->vct))
- (if (not (vequal case1 (vct 0.000 0.001 0.006 0.018 0.039 0.075 0.135 0.233 0.387 0.628 1.000)))
- (snd-display #__line__ ";ramp-xramp (1): ~A" case1))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 0 11) ; scale-channel 0.500 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp 1: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 0 5) ; scale-channel 0.500 0 5 [4:3]:
- (at 0, cp->sounds[1][0:4, 0.500, [1]0.000 -> 0.400, [2]0.000 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
- (at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.150 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp 2: ~A" (safe-display-edits ind 0 4)))
- (set! case2 (channel->vct))
- (if (not (vequal case2 (vct 0.000 0.001 0.003 0.009 0.019 0.075 0.135 0.233 0.387 0.628 1.000)))
- (snd-display #__line__ ";ramp-xramp (2): ~A" case2))
+ (let ((ns (new-sound))
+ (v (make-float-vector 1000)))
+ (unselect-all)
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x .001)))
+ ((= i 1000))
+ (set! (v i) x))
+ (float-vector->channel v 0 1000 ns 0)
+ (set! (selection-member? ns 0) #t)
+ (set! (selection-position ns 0) 200)
+ (set! (selection-framples ns 0) 300)
+ (delete-selection-and-smooth)
+ (if (not (= (framples ns 0) 700))
+ (snd-display #__line__ ";delete-selection-and-smooth framples: ~A" (framples ns 0)))
+ (if (fneq (sample 167 ns 0) 0.167)
+ (snd-display #__line__ ";delete-selection-and-smooth 167: ~A" (sample 167 ns 0)))
+ (if (fneq (sample 234 ns 0) 0.534)
+ (snd-display #__line__ ";delete-selection-and-smooth 234: ~A" (sample 234 ns 0)))
+ (if (fneq (sample 210 ns 0) 0.406)
+ (snd-display #__line__ ";delete-selection-and-smooth 210: ~A" (sample 210 ns 0)))
+ (let* ((v1 (channel->float-vector))
+ (maxdiff 0.0)
+ (mindiff 10.0)
+ (ls (v1 0)))
+ (do ((i 1 (+ i 1)))
+ ((= i 700))
+ (let ((diff (- (v1 i) ls)))
+ (set! ls (v1 i))
+ (if (> diff maxdiff) (set! maxdiff diff))
+ (if (< diff mindiff) (set! mindiff diff))))
+ (if (< mindiff .0009)
+ (snd-display #__line__ ";delete-selection-and-smooth min diff: ~A" mindiff))
+ (if (> maxdiff .007)
+ (snd-display #__line__ ";delete-selection-and-smooth max diff: ~A" maxdiff)))
+ (close-sound ns))
+
+ (let ((ns (new-sound))
+ (v (make-float-vector 1000)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x .001)))
+ ((= i 1000))
+ (set! (v i) x))
+ (float-vector->channel v 0 1000 ns 0)
+ (delete-samples-and-smooth 200 300 ns 0)
+ (if (not (= (framples ns 0) 700))
+ (snd-display #__line__ ";delete-samples-and-smooth framples: ~A" (framples ns 0)))
+ (if (fneq (sample 167 ns 0) 0.167)
+ (snd-display #__line__ ";delete-samples-and-smooth 167: ~A" (sample 167 ns 0)))
+ (if (fneq (sample 234 ns 0) 0.534)
+ (snd-display #__line__ ";delete-samples-and-smooth 234: ~A" (sample 234 ns 0)))
+ (if (fneq (sample 210 ns 0) 0.406)
+ (snd-display #__line__ ";delete-samples-and-smooth 210: ~A" (sample 210 ns 0)))
+ (let* ((v1 (channel->float-vector))
+ (maxdiff 0.0)
+ (mindiff 10.0)
+ (ls (v1 0)))
+ (do ((i 1 (+ i 1)))
+ ((= i 700))
+ (let ((diff (- (v1 i) ls)))
+ (set! ls (v1 i))
+ (if (> diff maxdiff) (set! maxdiff diff))
+ (if (< diff mindiff) (set! mindiff diff))))
+ (if (< mindiff .0009)
+ (snd-display #__line__ ";delete-samples-and-smooth min diff: ~A" mindiff))
+ (if (> maxdiff .007)
+ (snd-display #__line__ ";delete-samples-and-smooth max diff: ~A" maxdiff)))
+ (close-sound ns))
+
+ (let ((old-beg *initial-beg*)
+ (old-dur *initial-dur*)
+ (old-show *show-full-duration*)
+ (old-hook (hook-functions initial-graph-hook)))
+ (set! (hook-functions initial-graph-hook) ())
+ (set! *show-full-duration* #t)
+ (let ((ns (open-sound "1.snd")))
+ (let ((ls (left-sample ns 0))
+ (rs (right-sample ns 0))
+ (fr (framples ns 0)))
+ (when with-gui
+ (if (not (equal? (list fr ls rs) '(220501 0 220501)))
+ (snd-display #__line__ ";show-full-duration 1: ~A" (list fr ls rs))))
+ (close-sound ns)))
+ (set! *show-full-duration* #t)
+ (set! *initial-beg* 0.0)
+ (set! *initial-dur* 0.2)
+ (let ((ns (open-sound "1.snd")))
+ (let ((ls (left-sample ns 0))
+ (rs (right-sample ns 0))
+ (fr (framples ns 0)))
+ (when with-gui
+ (if (not (equal? (list fr ls rs) '(220501 0 220501)))
+ (snd-display #__line__ ";show-full-duration 2: ~A" (list fr ls rs))))
+ (close-sound ns)))
+ (set! *show-full-duration* #f)
+ (set! *initial-beg* 0.0)
+ (set! *initial-dur* 0.2)
+ (let ((ns (open-sound "1.snd")))
+ (let ((ls (left-sample ns 0))
+ (rs (right-sample ns 0))
+ (fr (framples ns 0)))
+ (if (not (equal? (list fr ls rs) '(220501 0 4410)))
+ (snd-display #__line__ ";show-full-duration 3: ~A" (list fr ls rs)))
+ (close-sound ns)))
+ (set! *initial-beg* 2.0)
+ (set! *initial-dur* 1.0)
+ (let ((ns (open-sound "1.snd")))
+ (let ((ls (left-sample ns 0))
+ (rs (right-sample ns 0))
+ (fr (framples ns 0)))
+ (if (not (equal? (list fr ls rs) '(220501 44100 66150)))
+ (snd-display #__line__ ";show-full-duration 4: ~A" (list fr ls rs)))
+ (close-sound ns)))
+ (set! *initial-beg* old-beg)
+ (set! *initial-dur* old-dur)
+ (set! *show-full-duration* old-show)
+ (set! (hook-functions initial-graph-hook) old-hook))
+
+ (set! *show-full-range* #t)
+ (let ((ns (open-sound "1a.snd")))
+ (if (or (fneq (car (y-bounds ns 0)) -1.0)
+ (fneq (cadr (y-bounds ns 0)) 1.0))
+ (snd-display #__line__ ";show-full-range 1a: ~A" (y-bounds ns 0)))
+ (close-sound ns))
+ (with-sound ("test.snd" :clipped #f :to-snd #f)
+ (fm-violin 0 1 440 3.5))
+ (let ((ns (open-sound "test.snd")))
+ (when with-gui
+ (if (or (fneq (car (y-bounds ns 0)) -3.5)
+ (fneq (cadr (y-bounds ns 0)) 3.5))
+ (snd-display #__line__ ";show-full-range 3.5 test: ~A" (y-bounds ns 0))))
+ (with-sound ("test.snd" :clipped #f :to-snd #f)
+ (fm-violin 0 1 440 1.5))
+ (update-sound ns)
+ (when with-gui
+ (if (or (fneq (car (y-bounds ns 0)) -1.5)
+ (fneq (cadr (y-bounds ns 0)) 1.5))
+ (snd-display #__line__ ";show-full-range 1.5 test: ~A" (y-bounds ns 0))))
+ (close-sound ns))
+ (set! *show-full-range* #f)
+
+ (let ((old-sync *sync-style*))
+ (set! *sync-style* sync-none)
+ (let ((ns (open-sound "2.snd")))
+ (if (not (= (sync ns) 0))
+ (snd-display #__line__ ";sync-none open: ~A" (sync ns)))
+ (set! (sync ns) 1)
+ (set! *sync-style* sync-by-sound)
+ (let ((ns1 (open-sound "1a.snd")))
+ (if (or ;(= (sync ns1) 0) ; this default changed 12.9
+ (= (sync ns1) 1)
+ (not (= (sync ns) 1)))
+ (snd-display #__line__ ";sync-by-sound open: ~A" (list (sync ns) (sync ns1))))
+ (close-sound ns1))
+ (close-sound ns))
+ (set! *sync-style* old-sync))
+
+ (let ((ind (view-sound "obtest.snd")))
+ (delete-samples 0 1000 ind 0)
+ (let ((tag (catch #t
+ (lambda () (save-sound ind))
+ (lambda args args))))
+ (if (integer? tag) (snd-display #__line__ ";save-viewed-sound: ~A" tag))
+ (if (not (equal? (edits ind) (list 1 0))) (snd-display #__line__ ";view read-only ignored? ~A" (edits ind))))
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next)))
+ (insert-silence 0 150000)
+ (map-channel (lambda (y) 0.5))
+ (env-sound '(0 0 1 1 2 0))
+ (fp 1.0 0.3 20)
+ (let ((old-curse *with-tracking-cursor*))
+ (set! *with-tracking-cursor* #t)
+ (play :wait #t)
+ (set! *with-tracking-cursor* old-curse))
+ (close-sound ind))
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next)))
+ (for-each
+ (lambda (dur)
+ (insert-silence 0 dur)
+ (map-channel (lambda (y) 1.0))
+ (env-sound '(0 0 1 1 2 0))
+ (let ((reader (make-sampler (- (framples) 1) ind 0 -1)))
+ (if (not (= (sampler-position reader) (- (framples) 1))) (snd-display #__line__ ";sampler-position: ~A" (sampler-position reader)))
+ (map-channel (lambda (y) (read-sample reader))))
+ (let ((e (make-env '(0 0 1 1 2 0) :length (+ 1 dur)))
+ (len (framples)))
+ (let ((v0 (make-float-vector len))
+ (v1 (samples 0 len ind 0)))
+ (outa->fv v0 (env e))
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ "~%;trouble in reverse read ~A ~A" v0 v1))))
+ (revert-sound))
+ (list 150 1500 150000))
+ (close-sound ind))
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next)))
+ (insert-silence 0 1000)
+ (map-channel (lambda (y) 1.0))
+ (env-sound '(0 0 1 1 2 0))
+ (scale-channel 0.0 100 200)
+ (let ((reader (make-sampler (- (framples) 1) ind 0 -1)))
+ (map-channel (lambda (y) (read-sample reader))))
+ (let ((e (make-env '(0 0 1 1 2 0) :length 1001))
+ (new-reader (make-sampler 0 ind 0))
+ (len (framples)))
+ (call-with-exit
+ (lambda (quit)
+ (do ((old (env e) (env e))
+ (new (read-sample new-reader) (read-sample new-reader))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (if (or (and (or (> i 900) (<= i 700))
+ (fneq old new))
+ (and (> i 700) (<= i 900)
+ (fneq new 0.0)))
+ (begin
+ (format #t "~%;trouble in reverse read 2 at ~D ~A ~A" i old new)
+ (quit)))))))
+ (close-sound ind))
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next)))
+ (insert-silence 0 150000)
+ (map-channel (lambda (y) 1.0))
+ (let ((edpos (edit-position)))
+ (do ((i 0 (+ i 1)))
+ ((= i 7))
+ (if (= i 5)
+ (scale-channel 0.5 1000 12345))
+ (env-sound '(0 0 1 1 2.5 0 3 1 4 0))
+ (if (= i 1)
+ (delete-samples 50 100)
+ (if (= i 2)
+ (insert-samples 300 100 (make-float-vector 100 0.5))
+ (if (= i 3)
+ (scale-channel 0.0 1000 1000)
+ (if (= i 4)
+ (float-vector->channel (make-float-vector 100 .5) 500 100)
+ (if (= i 6)
+ (env-sound '(0 1 1 0) 10000 2000))))))
+ (let ((reader (make-sampler (- (framples) 1) ind 0 -1)))
+ (map-channel (lambda (y) (read-sample reader))))
+ (let ((reader (make-sampler (- (framples) 1) ind 0 -1)))
+ (map-channel (lambda (y) (read-sample reader))))
+ (let ((len (framples)))
+ (let ((v0 (samples 0 len ind 0 (- (edit-position ind 0) 2)))
+ (v1 (samples 0 len ind 0)))
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ "~%;trouble in reverse read ~A ~A" v0 v1))))
+ (set! (edit-position ind 0) edpos)))
+ (close-sound ind))
+ (let ((reader #f)
+ (last-proc #f))
+ (define (scan-again)
+ (and (not (sampler-at-end? reader))
+ (let ((val (last-proc (reader))))
+ (if val
+ (list val (- (sampler-position reader) 1))
+ (scan-again)))))
+ (define* (my-scan-channel proc)
+ (if proc
+ (begin
+ (set! last-proc proc)
+ (set! reader (make-sampler 0))))
+ (scan-again))
+ (let ((ind (open-sound "oboe.snd"))
+ (val #f))
+ (let ((samp (sample 1000)))
+ (set! (cursor ind 0) 1000)
+ (if (fneq (sample) samp)
+ (snd-display #__line__ ";sample no args: ~A ~A" (sample) samp)))
+ (set! val (my-scan-channel (lambda (y) (> y .1))))
+ (if (not (equal? val (list #t 4423)))
+ (snd-display #__line__ ";my-scan-chan: ~A" val))
+ (set! val (scan-again))
+ (if (not (equal? val (list #t 4463)))
+ (snd-display #__line__ ";scan-again: ~A" val))
+ (set! (cursor) 1000)
+ (set! (sample) .5)
+ (if (fneq (sample 1000) .5)
+ (snd-display #__line__ ";set sample no arg: ~A ~A" (sample 1000) (sample 0)))
+ (close-sound ind)))
+
+ ;; edit-menu.scm tests
+ (if (defined? 'selection->new)
+ (let ((ind (view-sound "oboe.snd")))
+ (make-selection 1000 1999 ind 0)
+ (let ((newsnd (selection->new)))
+ (if (not (sound? newsnd)) (snd-display #__line__ ";selection->new -> ~A" newsnd))
+ (if (not (= (framples newsnd 0) 1000)) (snd-display #__line__ ";selection->new framples: ~A" (framples newsnd 0)))
+ (if (not (equal? (edits ind 0) (list 0 0))) (snd-display #__line__ ";selection->new edited original? ~A" (edits ind 0)))
+ (let ((newfile (file-name newsnd)))
+ (close-sound newsnd)
+ (delete-file newfile)
+ (mus-sound-forget newfile)))
+ (make-selection 1000 1999 ind 0)
+ (let ((newsnd (cut-selection->new)))
+ (if (not (sound? newsnd)) (snd-display #__line__ ";cut-selection->new -> ~A" newsnd))
+ (if (not (= (framples newsnd 0) 1000)) (snd-display #__line__ ";cut-selection->new framples: ~A" (framples newsnd 0)))
+ (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";cut-selection->new did not edit original? ~A" (edits ind 0)))
+ (if (not (= (framples ind 0) (- (framples ind 0 0) 1000)))
+ (snd-display #__line__ ";cut-selection->new cut: ~A ~A" (framples ind 0) (- (framples ind 0 0) 1000)))
+ (undo 1 ind 0)
+ (let ((newfile (file-name newsnd)))
+ (close-sound newsnd)
+ (delete-file newfile)
+ (mus-sound-forget newfile)))
+ (make-selection 1000 1999 ind 0)
+ (append-selection)
+ (if (not (= (framples ind 0) (+ (framples ind 0 0) 1000)))
+ (snd-display #__line__ ";append-selection: ~A ~A" (framples ind 0) (framples ind 0 0)))
+ (append-sound "oboe.snd")
+ (if (not (= (framples ind 0) (+ (* 2 (framples ind 0 0)) 1000)))
+ (snd-display #__line__ ";append-sound: ~A ~A" (framples ind 0) (framples ind 0 0)))
+ (revert-sound ind)
+ (let ((m1 (add-mark 1000))
+ (m2 (add-mark 12000)))
+ (trim-front)
+ (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";time-front did not edit original? ~A" (edits ind 0)))
+ (if (not (= (framples ind 0) (- (framples ind 0 0) 1000)))
+ (snd-display #__line__ ";trim-front: ~A ~A" (framples ind 0) (- (framples ind 0 0) 1000)))
+ (if (not (= (mark-sample m2) 11000)) (snd-display #__line__ ";trim-front m2: ~A" (mark-sample m2)))
+ (undo 1 ind 0)
+ (trim-back)
+ (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";time-back did not edit original? ~A" (edits ind 0)))
+ (if (not (= (framples ind 0) 12001)) (snd-display #__line__ ";trim-back: ~A" (framples ind 0)))
+ (if (not (= (mark-sample m1) 1000)) (snd-display #__line__ ";trim-back m1: ~A" (mark-sample m1)))
+ (undo 1 ind 0)
+ (add-mark 22000)
+ (crop)
+ (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";crop did not edit original? ~A" (edits ind 0)))
+ (if (not (= (framples ind 0) 21001)) (snd-display #__line__ ";crop: ~A" (framples ind 0)))
+ (undo 1 ind 0)
+ (close-sound ind))))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-channel (lambda (y) 1.0) 0 1001)
+ (env-channel (make-env '(0 1 1 1) :scaler .5 :length 1001))
+ (check-maxamp #__line__ ind .5 "simple scaler")
+ (check-env-vals "simple scaler" (make-env '(0 1 1 1) :scaler .5 :length 1001))
+ (if (= (edit-position) 2)
+ (undo)
+ (snd-display #__line__ ";env+scl was no-op"))
+ (env-channel (make-env '(0 1 1 1) :offset .5 :length 1001))
+ (check-maxamp #__line__ ind 1.5 "simple offset")
+ (check-env-vals "simple offset" (make-env '(0 1 1 1) :offset .5 :length 1001))
+ (if (= (edit-position) 2)
+ (undo)
+ (snd-display #__line__ ";env+offset was no-op"))
+ (env-channel (make-env '(0 0 1 1 2 0) :offset .5 :scaler 2.0 :length 1001))
+ (check-maxamp #__line__ ind 2.5 "off+scl")
+ (check-env-vals "off+scl" (make-env '(0 0 1 1 2 0) :offset .5 :scaler 2.0 :length 1001))
(undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 2 4) ; scale-channel 0.500 2 4 [4:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.032 -> 0.150, off: -0.032, scl: 0.032]) [buf: 11]
- (at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.226 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp 3: ~A" (safe-display-edits ind 0 4)))
- (undo 2)
- (xramp-channel 0.75 0.25 32.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; xramp-channel 0.750 0.250 32.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.750 -> 0.250, off: 0.234, scl: 0.016]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp 4: ~A" (safe-display-edits ind 0 3)))
+ (env-channel (make-env '(0 -0.5 1 0 2 -1) :offset .5 :scaler 2.0 :length 1001))
+ (check-maxamp #__line__ ind 1.5 "off+scl #2")
+ (let ((mx -12.0))
+ (scan-channel (lambda (y) (not (set! mx (max mx y)))))
+ (if (fneq mx 0.5) (snd-display #__line__ ";non abs max: ~A (correct: 0.5)" mx)))
+ (check-env-vals "off+scl #2" (make-env '(0 -0.5 1 0 2 -1) :offset .5 :scaler 2.0 :length 1001))
(undo)
- (xramp-channel .2 .6 3.0 2 6)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 2 6) ; xramp-channel 0.200 0.600 3.000 2 6 [3:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.700, [2]0.200 -> 0.600, off: -0.000, scl: 0.200]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 0 5) ; scale-channel 0.500 0 5 [4:5]:
- (at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.400, [2]0.200 -> 0.310, off: -0.000, scl: 0.200]) [buf: 11]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.500 -> 0.700, [2]0.387 -> 0.600, off: -0.000, scl: 0.200]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp 6: ~A" (safe-display-edits ind 0 4)))
+ (env-sound '(0 .5 1 .75 2 .25) 0 (framples) 32.0)
+ (check-maxamp #__line__ ind 0.75 "xramp")
+ (check-env-vals "xramp" (make-env '(0 .5 1 .75 2 .25) :base 32.0 :length 1001))
(undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (set 4 1) ; set-sample 4 0.5000 [4:6]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.300, [2]0.200 -> 0.249, off: -0.000, scl: 0.200]) [buf: 11]
- (at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.500 -> 0.700, [2]0.387 -> 0.600, off: -0.000, scl: 0.200]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp-xramp 7: ~A" (safe-display-edits ind 0 4)))
- (revert-sound)
- (map-chan (lambda (y) 1.0) 0 10)
-
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp-ramp 0: ~A" (safe-display-edits ind 0 3)))
- (if (not (vequal case1 (channel->vct)))
- (snd-display #__line__ ";xramp-ramp (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 0 11) ; scale-channel 0.500 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp-ramp 1: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 0 5) ; scale-channel 0.500 0 5 [4:3]:
- (at 0, cp->sounds[1][0:4, 0.500, [1]0.000 -> 0.400, [2]0.000 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
- (at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.150 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp-ramp 2: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal case2 (channel->vct)))
- (snd-display #__line__ ";xramp-ramp (2): ~A" (channel->vct)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (scale 2 4) ; scale-channel 0.500 2 4 [4:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.032 -> 0.150, off: -0.032, scl: 0.032]) [buf: 11]
- (at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.226 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp-ramp 3: ~A" (safe-display-edits ind 0 4)))
- (undo 2)
- (ramp-channel 0.75 0.25)
- (if (not (string=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; ramp-channel 0.750 0.250 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.750 -> 0.250, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp-ramp 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (ramp-channel .2 .6 2 6)
- (if (not (string=? (safe-display-edits ind 0 3) "
- (ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [3:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.600, [2]0.032 -> 0.333, off: -0.032, scl: 0.032]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp-ramp 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 0 5)
- (if (not (string=? (safe-display-edits ind 0 4) "
- (scale 0 5) ; scale-channel 0.500 0 5 [4:5]:
- (at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.360, [2]0.032 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.440 -> 0.600, [2]0.150 -> 0.333, off: -0.032, scl: 0.032]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp-ramp 6: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string=? (safe-display-edits ind 0 4) "
- (set 4 1) ; set-sample 4 0.5000 [4:6]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.280, [2]0.032 -> 0.059, off: -0.032, scl: 0.032]) [buf: 11]
- (at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.440 -> 0.600, [2]0.150 -> 0.333, off: -0.032, scl: 0.032]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp-ramp 7: ~A" (safe-display-edits ind 0 4)))
- (close-sound ind))
-
- ;; ramp2+xramp
- (let ((ind (new-sound "test.snd"))
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2+xramp 0: ~A" (safe-display-edits ind 0 4)))
- (set! case1 (channel->vct))
- (if (not (vequal case1 (vct 0.000 0.000 0.001 0.005 0.015 0.038 0.081 0.163 0.310 0.565 1.000)))
- (snd-display #__line__ ";ramp2+xramp (1): ~A" case1))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 0 11) ; scale-channel 0.500 0 #f [5:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2+xramp 1: ~A" (safe-display-edits ind 0 5)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 0 5) ; scale-channel 0.500 0 5 [5:3]:
- (at 0, cp->sounds[1][0:4, 0.500, [1]0.000 -> 0.400, [2]0.000 -> 0.400, [3]0.000 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
- (at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.500 -> 1.000, [3]0.150 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2+xramp 2: ~A" (safe-display-edits ind 0 5)))
- (set! case2 (channel->vct))
- (if (not (vequal case2 (vct 0.000 0.000 0.001 0.003 0.008 0.038 0.081 0.163 0.310 0.565 1.000)))
- (snd-display #__line__ ";ramp2+xramp (2): ~A" case2))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 2 4) ; scale-channel 0.500 2 4 [5:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.100, [3]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.200 -> 0.500, [3]0.032 -> 0.150, off: -0.032, scl: 0.032]) [buf: 11]
- (at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.600 -> 1.000, [3]0.226 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2+xramp 3: ~A" (safe-display-edits ind 0 5)))
- (undo 2)
- (ramp-channel 0.75 0.25)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; ramp-channel 0.750 0.250 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.750 -> 0.250, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2+xramp 4: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (ramp-channel .2 .6 2 6)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [4:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.700, [2]0.200 -> 0.600, [3]0.032 -> 0.333, off: -0.032, scl: 0.032]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2+xramp 5: ~A" (safe-display-edits ind 0 4)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 0 5) ; scale-channel 0.500 0 5 [5:5]:
- (at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.400, [2]0.200 -> 0.360, [3]0.032 -> 0.097, off: -0.032, scl: 0.032]) [buf: 11]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.500 -> 0.700, [2]0.440 -> 0.600, [3]0.150 -> 0.333, off: -0.032, scl: 0.032]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2+xramp 6: ~A" (safe-display-edits ind 0 5)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (set 4 1) ; set-sample 4 0.5000 [5:6]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.100, [2]0.000 -> 0.013, off: -0.032, scl: 0.032]) [buf: 11]
- (at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.300, [2]0.200 -> 0.280, [3]0.032 -> 0.059, off: -0.032, scl: 0.032]) [buf: 11]
- (at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.500 -> 0.700, [2]0.440 -> 0.600, [3]0.150 -> 0.333, off: -0.032, scl: 0.032]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.484 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2+xramp 7: ~A" (safe-display-edits ind 0 5)))
- (revert-sound)
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp+ramp2 0: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal case1 (channel->vct)))
- (snd-display #__line__ ";xramp+ramp2 (1): ~A" (channel->vct)))
-
- (revert-sound ind)
- (map-channel (lambda (y) 1.0) 0 100)
- (scale-channel 0.75)
- (ramp-channel .5 1)
- (ptree-channel (lambda (y) (* y (/ 1.0 0.75))))
- (scale-channel 2.0)
- (ramp-channel 1 .5)
- (ptree-channel (lambda (y) (* y .25)))
- (scale-channel 4.0)
- (ramp-channel 0 1)
- (if (fneq (maxamp) 1.0)
- (snd-display #__line__ ";rprpr max: ~A" (maxamp)))
+ (env-channel-with-base '(0 .5 1 .75 2 .25) 32.0)
+ (check-maxamp #__line__ ind 0.75 "xramp1")
+ (check-env-vals "xramp1" (make-env '(0 .5 1 .75 2 .25) :base 32.0 :length 1001))
(close-sound ind))
- (let ((ind (new-sound "test.snd"))
- (case3 #f))
- (map-channel (lambda (y) 1.0) 0 100)
- (scale-channel 0.5)
- (xramp-channel 1.0 0.0 32.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (set! case3 (channel->vct))
- (undo 4)
-
- ;; multi-ramp2+xramp
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (xramp-channel 1.0 0.0 32.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 14) "
- (ramp 0 100) ; ramp-channel 0.000 1.000 0 #f [14:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]0.000 -> 0.091, [3]1.000 -> 0.721, off: -0.032, scl: 0.032]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.101 -> 0.192, [3]0.695 -> 0.499, off: -0.032, scl: 0.032]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.202 -> 0.293, [2]0.202 -> 0.293, [3]0.480 -> 0.342, off: -0.032, scl: 0.032]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.303 -> 0.394, [2]0.303 -> 0.394, [3]0.329 -> 0.231, off: -0.032, scl: 0.032]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.404 -> 0.495, [2]0.404 -> 0.495, [3]0.222 -> 0.153, off: -0.032, scl: 0.032]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.505 -> 0.596, [2]0.505 -> 0.596, [3]0.147 -> 0.099, off: -0.032, scl: 0.032]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.606 -> 0.697, [2]0.606 -> 0.697, [3]0.094 -> 0.060, off: -0.032, scl: 0.032]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.707 -> 0.798, [2]0.707 -> 0.798, [3]0.057 -> 0.033, off: -0.032, scl: 0.032]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.808 -> 0.899, [2]0.808 -> 0.899, [3]0.030 -> 0.014, off: -0.032, scl: 0.032]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]0.909 -> 1.000, [3]0.012 -> 0.000, off: -0.032, scl: 0.032]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-ramp2+xramp 1: ~A" (safe-display-edits ind 0 14)))
- (if (not (vequal case3 (channel->vct)))
- (snd-display #__line__ ";multi-ramp2+xramp:~%; ~A~%; ~A"
- case3 (channel->vct)))
- (revert-sound)
- (map-channel (lambda (y) 1.0) 0 100)
- (xramp-channel 1.0 0.0 32.0)
-
- (ramp-channel 0.0 1.0 10 20)
- (ramp-channel 0.0 1.0 50 10)
- (ramp-channel 0.0 1.0 25 10)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (ramp 25 10) ; ramp-channel 0.000 1.000 25 10 [5:8]:
- (at 0, cp->sounds[1][0:9, 1.000, [1]1.000 -> 0.721, off: -0.032, scl: 0.032]) [buf: 100]
- (at 10, cp->sounds[1][10:24, 1.000, [1]0.000 -> 0.737, [2]0.695 -> 0.413, off: -0.032, scl: 0.032]) [buf: 100]
- (at 25, cp->sounds[1][25:29, 1.000, [1]0.789 -> 1.000, [2]0.000 -> 0.444, [3]0.398 -> 0.342, off: -0.032, scl: 0.032]) [buf: 100]
- (at 30, cp->sounds[1][30:34, 1.000, [1]0.556 -> 1.000, [2]0.329 -> 0.282, off: -0.032, scl: 0.032]) [buf: 100]
- (at 35, cp->sounds[1][35:49, 1.000, [1]0.271 -> 0.153, off: -0.032, scl: 0.032]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]0.000 -> 1.000, [2]0.147 -> 0.099, off: -0.032, scl: 0.032]) [buf: 100]
- (at 60, cp->sounds[1][60:99, 1.000, [1]0.094 -> 0.000, off: -0.032, scl: 0.032]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-ramp2+xramp 2: ~A" (safe-display-edits ind 0 5)))
- (close-sound ind))
+ (let ((hlb (make-hilbert-transform 8))
+ (data (make-float-vector 20)))
+ (do ((i 0 (+ i 1)))
+ ((= i 20))
+ (set! (data i) (hilbert-transform hlb (if (= i 0) 1.0 0.0))))
+ (if (not (vequal data (float-vector 0.0 -0.010 0.0 -0.046 0.0 -0.152 0.0 -0.614 0.0 0.614 0.0 0.152 0.0 0.046 0.0 0.010 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";hilbert-transform 8 impulse response: ~A" data)))
- (let ((ind (new-sound "test.snd"))
- (case3 #f))
- (map-channel (lambda (y) 1.0) 0 100)
- (scale-channel 0.5)
- (ramp-channel 0.0 1.0)
- (xramp-channel 1.0 0.0 32.0)
- (set! case3 (channel->vct))
- (undo 3)
-
- ;; multi-ramp-xramp
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (xramp-channel 1.0 0.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 13) "
- (ramp 0 100) ; xramp-channel 1.000 0.000 32.000 0 #f [13:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]1.000 -> 0.721, off: -0.032, scl: 0.032]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.695 -> 0.499, off: -0.032, scl: 0.032]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.202 -> 0.293, [2]0.480 -> 0.342, off: -0.032, scl: 0.032]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.303 -> 0.394, [2]0.329 -> 0.231, off: -0.032, scl: 0.032]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.404 -> 0.495, [2]0.222 -> 0.153, off: -0.032, scl: 0.032]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.505 -> 0.596, [2]0.147 -> 0.099, off: -0.032, scl: 0.032]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.606 -> 0.697, [2]0.094 -> 0.060, off: -0.032, scl: 0.032]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.707 -> 0.798, [2]0.057 -> 0.033, off: -0.032, scl: 0.032]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.808 -> 0.899, [2]0.030 -> 0.014, off: -0.032, scl: 0.032]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]0.012 -> 0.000, off: -0.032, scl: 0.032]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-ramp-xramp 1: ~A" (safe-display-edits ind 0 13)))
- (if (not (vequal case3 (channel->vct)))
- (snd-display #__line__ ";multi-ramp-xramp: ~A" (channel->vct)))
- (undo 12)
- (xramp-channel 0.0 1.0 3.0 10 20)
- (xramp-channel 0.0 1.0 3.0 50 10)
- (xramp-channel 0.0 1.0 3.0 25 10)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 25 10) ; xramp-channel 0.000 1.000 3.000 25 10 [4:8]:
- (at 0, cp->sounds[1][0:9, 1.000]) [buf: 100]
- (at 10, cp->sounds[1][10:24, 1.000, [1]0.000 -> 0.623, off: -0.500, scl: 0.500]) [buf: 100]
- (at 25, cp->sounds[1][25:29, 1.000, [1]0.690 -> 1.000, off: -0.500, scl: 0.500, [2]0.000 -> 0.315, off: -0.500, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:34, 1.000, [1]0.421 -> 1.000, off: -0.500, scl: 0.500]) [buf: 100]
- (at 35, cp->sounds[1][35:49, 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]0.000 -> 1.000, off: -0.500, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:99, 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-ramp-xramp 2: ~A" (safe-display-edits ind 0 4)))
- (revert-sound)
-
- (map-channel (lambda (y) 1.0) 0 100)
- ;; multi-xramp-ramp
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (xramp-channel 1.0 0.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 13) "
- (ramp 0 100) ; ramp-channel 0.000 1.000 0 #f [13:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]1.000 -> 0.721, off: -0.032, scl: 0.032]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.695 -> 0.499, off: -0.032, scl: 0.032]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.202 -> 0.293, [2]0.480 -> 0.342, off: -0.032, scl: 0.032]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.303 -> 0.394, [2]0.329 -> 0.231, off: -0.032, scl: 0.032]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.404 -> 0.495, [2]0.222 -> 0.153, off: -0.032, scl: 0.032]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.505 -> 0.596, [2]0.147 -> 0.099, off: -0.032, scl: 0.032]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.606 -> 0.697, [2]0.094 -> 0.060, off: -0.032, scl: 0.032]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.707 -> 0.798, [2]0.057 -> 0.033, off: -0.032, scl: 0.032]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.808 -> 0.899, [2]0.030 -> 0.014, off: -0.032, scl: 0.032]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]0.012 -> 0.000, off: -0.032, scl: 0.032]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-xramp-ramp 3: ~A" (safe-display-edits ind 0 13)))
- (if (not (vequal case3 (channel->vct)))
- (snd-display #__line__ ";case3 xramp-ramp 3: ~A" (channel->vct)))
- (undo 12)
- (ramp-channel 0.0 1.0 10 20)
- (ramp-channel 0.0 1.0 50 10)
- (ramp-channel 0.0 1.0 25 10)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 25 10) ; ramp-channel 0.000 1.000 25 10 [4:8]:
- (at 0, cp->sounds[1][0:9, 1.000]) [buf: 100]
- (at 10, cp->sounds[1][10:24, 1.000, [1]-0.000 -> 0.737]) [buf: 100]
- (at 25, cp->sounds[1][25:29, 1.000, [1]0.789 -> 1.000, [2]-0.000 -> 0.444]) [buf: 100]
- (at 30, cp->sounds[1][30:34, 1.000, [1]0.556 -> 1.000]) [buf: 100]
- (at 35, cp->sounds[1][35:49, 1.000]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]-0.000 -> 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:99, 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-xramp-ramp 2: ~A" (safe-display-edits ind 0 4)))
- (close-sound ind))
+ (let ((hlb (make-hilbert-transform 7))
+ (data (make-float-vector 20)))
+ (do ((i 0 (+ i 1)))
+ ((= i 20))
+ (set! (data i) (hilbert-transform hlb (if (= i 0) 1.0 0.0))))
+ (if (not (vequal data (float-vector -0.007 0.0 -0.032 0.0 -0.136 0.0 -0.608 0.0 0.608 0.0 0.136 0.0 0.032 0.0 0.007 0.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";hilbert-transform 7 impulse response: ~A" data)))
- ;; xramp2
(let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (xramp-channel 0.0 1.0 2.0)
- (xramp-channel 0.0 1.0 2.0)
- (if (not (string=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 2.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: -1.000, scl: 1.000, [2]0.000 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp2 0: ~A" (safe-display-edits ind 0 3)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.022 0.053 0.102 0.172 0.266 0.390 0.549 0.750 1.000)))
- (snd-display #__line__ ";xramp2 (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string=? (safe-display-edits ind 0 4) "
- (scale 0 11) ; scale-channel 0.500 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]0.000 -> 1.000, off: -1.000, scl: 1.000, [2]0.000 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp2 1: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string=? (safe-display-edits ind 0 4) "
- (scale 0 5) ; scale-channel 0.500 0 5 [4:3]:
- (at 0, cp->sounds[1][0:4, 0.500, [1]0.000 -> 0.320, off: -1.000, scl: 1.000, [2]0.000 -> 0.320, off: -1.000, scl: 1.000]) [buf: 11]
- (at 5, cp->sounds[1][5:10, 1.000, [1]0.414 -> 1.000, off: -1.000, scl: 1.000, [2]0.414 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp2 2: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal (channel->vct) (vct 0.000 0.003 0.011 0.027 0.051 0.172 0.266 0.390 0.549 0.750 1.000)))
- (snd-display #__line__ ";xramp2 (2): ~A" (channel->vct)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string=? (safe-display-edits ind 0 4) "
- (scale 2 4) ; scale-channel 0.500 2 4 [4:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.072, off: -1.000, scl: 1.000, [2]0.000 -> 0.072, off: -1.000, scl: 1.000]) [buf: 11]
- (at 2, cp->sounds[1][2:5, 0.500, [1]0.149 -> 0.414, off: -1.000, scl: 1.000, [2]0.149 -> 0.414, off: -1.000, scl: 1.000]) [buf: 11]
- (at 6, cp->sounds[1][6:10, 1.000, [1]0.516 -> 1.000, off: -1.000, scl: 1.000, [2]0.516 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp2 3: ~A" (safe-display-edits ind 0 4)))
+ (pad-channel 0 1000)
+ (set! (sample 100) 1.0)
+ (let ((h (make-hilbert-transform 100)))
+ (map-channel (lambda (y) (hilbert-transform h y)))
+ (map-channel (lambda (y) (hilbert-transform h y)))
+ (map-channel (lambda (y) (hilbert-transform h y)))
+ (map-channel (lambda (y) (hilbert-transform h y)))
+ ;; now ideally we'd be back to an impulse
+ (if (> (abs (- (sample 500) .98)) .01)
+ (snd-display #__line__ ";hilbert impulse: ~A" (sample 500)))
+ (set! (sample 500) 0.0)
+ (if (> (maxamp ind 0) .02)
+ (snd-display #__line__ ";hilbert sidelobes: ~A" (maxamp ind 0)))
+ (scale-channel 0.0)
+ (set! (sample 100) 1.0)
+ (set! h (make-hilbert-transform 101))
+ (map-channel (lambda (y) (hilbert-transform h y)))
+ (map-channel (lambda (y) (hilbert-transform h y)))
+ (map-channel (lambda (y) (hilbert-transform h y)))
+ (map-channel (lambda (y) (hilbert-transform h y)))
+ (if (> (abs (- (sample 504) .98)) .01)
+ (snd-display #__line__ ";hilbert 101 impulse: ~A: ~A" (sample 504) (channel->float-vector 498 10)))
+ (set! (sample 504) 0.0)
+ (if (> (maxamp ind 0) .02)
+ (snd-display #__line__ ";hilbert 101 sidelobes: ~A" (maxamp ind 0)))
+ (revert-sound))
+ (pad-channel 0 1000)
+ (set! (sample 100) 1.0)
+ (let ((lo (make-lowpass (* .1 pi) 20))
+ (hi (make-highpass (* .1 pi) 20)))
+ (map-channel (lambda (y) (+ (lowpass lo y) (highpass hi y))))
+ (if (fneq (sample 120) 1.0)
+ (snd-display #__line__ ";lowpass+highpass impulse: ~A" (sample 120)))
+ (set! (sample 120) 0.0)
+ (if (fneq (maxamp ind 0) 0.0)
+ (snd-display #__line__ ";lowpass+highpass sidelobes: ~A" (maxamp ind 0))))
(undo 2)
- (xramp-channel 0.75 0.25 0.3)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; xramp-channel 0.750 0.250 0.300 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: -1.000, scl: 1.000, [2]0.750 -> 0.250, off: 0.964, scl: -0.714]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp2 4: ~A" (safe-display-edits ind 0 3)))
- (undo)
- (xramp-channel .2 .6 32.0 2 6)
- (if (not (string=? (safe-display-edits ind 0 3) "
- (ramp 2 6) ; xramp-channel 0.200 0.600 32.000 2 6 [3:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.072, off: -1.000, scl: 1.000]) [buf: 11]
- (at 2, cp->sounds[1][2:7, 1.000, [1]0.149 -> 0.625, off: -1.000, scl: 1.000, [2]0.200 -> 0.600, off: 0.187, scl: 0.013]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.741 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp2 5: ~A" (safe-display-edits ind 0 3)))
- (scale-channel 0.5 0 5)
- (if (not (string=? (safe-display-edits ind 0 4) "
- (scale 0 5) ; scale-channel 0.500 0 5 [4:5]:
- (at 0, cp->sounds[1][0:1, 0.500, [1]0.000 -> 0.072, off: -1.000, scl: 1.000]) [buf: 11]
- (at 2, cp->sounds[1][2:4, 0.500, [1]0.149 -> 0.320, off: -1.000, scl: 1.000, [2]0.200 -> 0.239, off: 0.187, scl: 0.013]) [buf: 11]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.414 -> 0.625, off: -1.000, scl: 1.000, [2]0.290 -> 0.600, off: 0.187, scl: 0.013]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.741 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp2 6: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string=? (safe-display-edits ind 0 4) "
- (set 4 1) ; set-sample 4 0.5000 [4:6]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.072, off: -1.000, scl: 1.000]) [buf: 11]
- (at 2, cp->sounds[1][2:3, 1.000, [1]0.149 -> 0.231, off: -1.000, scl: 1.000, [2]0.200 -> 0.213, off: 0.187, scl: 0.013]) [buf: 11]
- (at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.414 -> 0.625, off: -1.000, scl: 1.000, [2]0.290 -> 0.600, off: 0.187, scl: 0.013]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.741 -> 1.000, off: -1.000, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp2 7: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
+ (let ((lo (make-bandpass (* .1 pi) (* .2 pi) 20))
+ (hi (make-bandstop (* .1 pi) (* .2 pi) 20)))
+ (map-channel (lambda (y) (+ (bandpass lo y) (bandstop hi y))))
+ (if (fneq (sample 120) 1.0)
+ (snd-display #__line__ ";bandpass+bandstop impulse: ~A" (sample 120)))
+ (set! (sample 120) 0.0)
+ (if (fneq (maxamp ind 0) 0.0)
+ (snd-display #__line__ ";bandpass+bandstop sidelobes: ~A" (maxamp ind 0))))
(close-sound ind))
(let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
-
- ;; multi-xramp2
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (xramp-channel 0.0 1.0 3.0)
- (xramp-channel 1.0 0.0 0.3)
- (if (not (string-=? (safe-display-edits ind 0 13) "
- (ramp 0 100) ; xramp-channel 1.000 0.000 0.300 0 #f [13:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.053, off: -0.500, scl: 0.500, [2]1.000 -> 0.950, off: 1.429, scl: -1.429]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.059 -> 0.117, off: -0.500, scl: 0.500, [2]0.945 -> 0.889, off: 1.429, scl: -1.429]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.124 -> 0.190, off: -0.500, scl: 0.500, [2]0.882 -> 0.819, off: 1.429, scl: -1.429]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.198 -> 0.271, off: -0.500, scl: 0.500, [2]0.811 -> 0.740, off: 1.429, scl: -1.429]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.279 -> 0.361, off: -0.500, scl: 0.500, [2]0.731 -> 0.651, off: 1.429, scl: -1.429]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.371 -> 0.462, off: -0.500, scl: 0.500, [2]0.641 -> 0.550, off: 1.429, scl: -1.429]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.473 -> 0.575, off: -0.500, scl: 0.500, [2]0.540 -> 0.437, off: 1.429, scl: -1.429]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.587 -> 0.701, off: -0.500, scl: 0.500, [2]0.425 -> 0.308, off: 1.429, scl: -1.429]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.715 -> 0.842, off: -0.500, scl: 0.500, [2]0.295 -> 0.164, off: 1.429, scl: -1.429]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.857 -> 1.000, off: -0.500, scl: 0.500, [2]0.148 -> 0.000, off: 1.429, scl: -1.429]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-xramp2 1: ~A" (safe-display-edits ind 0 13)))
+ (map-channel (lambda (y) (mus-random 1.0)) 0 10000)
+ (let ((f2 (make-bandpass-2 (* .12 pi) (* .15 pi) (* .22 pi) (* .25 pi) 100)))
+ (map-channel (lambda (y) (fir-filter f2 y)))
+ (let ((data (channel->float-vector)))
+ (undo)
+ (let ((f1 (make-bandpass (* .12 pi) (* .15 pi) 100))
+ (f2 (make-bandpass (* .22 pi) (* .25 pi) 100)))
+ (map-channel (lambda (y) (+ (fir-filter f1 y) (fir-filter f2 y))))
+ (let ((data1 (channel->float-vector)))
+ (float-vector-subtract! data data1)
+ (if (> (float-vector-peak data) .00001)
+ (snd-display #__line__ ";fir-filter 2: ~A" (float-vector-peak data))))
+ (undo))))
(close-sound ind))
- ;; ptree+ramp2
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 4 #f) "
- (ptree[0] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp2 0: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display #__line__ ";ptree-ramp2 (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (scale 0 11) ; scale-channel 0.500 0 #f [5:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp2 1: ~A" (safe-display-edits ind 0 5 #f)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (scale 0 5) ; scale-channel 0.500 0 5 [5:3]:
- (at 0, cp->sounds[1][0:4, 0.500, [1]-0.000 -> 0.400, [2]-0.000 -> 0.400, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.500 -> 1.000, loc: 0, pos: 5, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp2 2: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display #__line__ ";ptree-ramp2 (2): ~A" (channel->vct)))
- (undo 4)
-
- (scale-channel .5)
- (env-channel '(0 0 1 1 2 0))
- (ramp-channel 0 1 2 3)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (ptree[0] 0 11) ; ptree-channel [5:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]0.000 -> 0.200, loc: 0, pos: 0, scl: 0.500]) [buf: 11]
- (at 2, cp->sounds[1][2:4, 1.000, [1]0.400 -> 0.800, [2]0.000 -> 1.000, loc: 0, pos: 2, scl: 0.500]) [buf: 11]
- (at 5, cp->sounds[1][5:10, 1.000, [1]1.000 -> -0.000, loc: 0, pos: 5, scl: 0.500]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp2 4: ~A" (safe-display-edits ind 0 5 #f)))
-
- (undo 4)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (if (not (string-=? (safe-display-edits ind 0 4 #f) "
- (ptree[0] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp2 5: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.005 0.020 0.045 0.080 0.125 0.180 0.245 0.320 0.405 0.500)))
- (snd-display #__line__ ";ptree+closure+ramp2: ~A" (channel->vct)))
-
- (close-sound ind))
+ (reset-all-hooks)
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
-
- ;; multi-ramp2
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 14 #f) "
- (ptree[0] 0 100) ; ptree-channel [14:11]:
- (at 0, cp->sounds[1][0:9, 1.000, [1]0.000 -> 0.091, [2]1.000 -> 0.909, loc: 0, pos: 0, scl: 0.500]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, [1]0.101 -> 0.192, [2]0.899 -> 0.808, loc: 0, pos: 10, scl: 0.500]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, [1]0.202 -> 0.293, [2]0.798 -> 0.707, loc: 0, pos: 20, scl: 0.500]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 1.000, [1]0.303 -> 0.394, [2]0.697 -> 0.606, loc: 0, pos: 30, scl: 0.500]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, [1]0.404 -> 0.495, [2]0.596 -> 0.505, loc: 0, pos: 40, scl: 0.500]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]0.505 -> 0.596, [2]0.495 -> 0.404, loc: 0, pos: 50, scl: 0.500]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 1.000, [1]0.606 -> 0.697, [2]0.394 -> 0.303, loc: 0, pos: 60, scl: 0.500]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 1.000, [1]0.707 -> 0.798, [2]0.293 -> 0.202, loc: 0, pos: 70, scl: 0.500]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 1.000, [1]0.808 -> 0.899, [2]0.192 -> 0.101, loc: 0, pos: 80, scl: 0.500]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 1.000, [1]0.909 -> 1.000, [2]0.091 -> -0.000, loc: 0, pos: 90, scl: 0.500]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";ptree multi-ramp2 1: ~A" (safe-display-edits ind 0 14 #f)))
- (undo 12)
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "first ramp re-order tests" 100)))
+ (map-channel (lambda (y) 1.0))
+ (for-each
+ (lambda (lst)
+ (let ((name (car lst))
+ (try-scale (cadr lst))
+ (f1 (caddr lst))
+ (f2 (cadddr lst))
+ (edpos (edit-position ind 0)))
+ (f1)
+ (let ((v1 (channel->float-vector 0 100 ind 0)))
+ (set! (edit-position ind 0) edpos)
+ (f2)
+ (let ((v2 (channel->float-vector 0 100 ind 0)))
+ (if (not (vequal v1 v2))
+ (snd-display #__line__ ";env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
+ (set! (edit-position ind 0) edpos)))
+ (if try-scale
+ (begin
+ (scale-by 2.0)
+ (f1)
+ (let ((v1 (channel->float-vector 0 100 ind 0)))
+ (set! (edit-position ind 0) edpos)
+ (f2)
+ (scale-by 2.0)
+ (let ((v2 (channel->float-vector 0 100 ind 0)))
+ (if (not (vequal v1 v2))
+ (snd-display #__line__ ";scaled (2) env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
+ (set! (edit-position ind 0) edpos)))
+ (f1)
+ (scale-by .5)
+ (let ((v1 (channel->float-vector 0 100 ind 0)))
+ (set! (edit-position ind 0) edpos)
+ (scale-by .5)
+ (f2)
+ (let ((v2 (channel->float-vector 0 100 ind 0)))
+ (if (not (vequal v1 v2))
+ (snd-display #__line__ ";scaled (.5) env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
+ (set! (edit-position ind 0) edpos)))))))
+
+ (list (list "ramp-xramp" #t
+ (lambda ()
+ (env-sound '(0 0 1 1 2 0))
+ (env-sound '(0 0 1 1) 0 100 2.0))
+ (lambda ()
+ (env-sound '(0 0 1 1) 0 100 2.0)
+ (env-sound '(0 0 1 1 2 0))))
+ (list "ramp2-xramp (1)" #t
+ (lambda ()
+ (env-sound '(0 0 1 1 2 0))
+ (env-sound '(0 0 1 1 3 0))
+ (env-sound '(0 0 1 1) 0 100 2.0))
+ (lambda ()
+ (env-sound '(0 0 1 1 2 0))
+ (env-sound '(0 0 1 1) 0 100 2.0)
+ (env-sound '(0 0 1 1 3 0))))
+ (list "ramp2-xramp (2)" #t
+ (lambda ()
+ (env-sound '(0 0 1 1 2 0))
+ (env-sound '(0 0 1 1))
+ (env-sound '(0 0 1 1 3 0) 0 100 2.0))
+ (lambda ()
+ (env-sound '(0 0 1 1 3 0) 0 100 2.0)
+ (env-sound '(0 0 1 1 2 0))
+ (env-sound '(0 0 1 1))))
+ (list "xramp2-ramp (1)" #t
+ (lambda ()
+ (env-sound '(0 0 1 1 2 0) 0 100 2.0)
+ (env-sound '(0 0 1 1))
+ (env-sound '(0 0 1 1 3 0) 0 100 3.0))
+ (lambda ()
+ (env-sound '(0 0 1 1 2 0) 0 100 2.0)
+ (env-sound '(0 0 1 1 3 0) 0 100 3.0)
+ (env-sound '(0 0 1 1))))
+ (list "xramp2-ramp (2)" #t
+ (lambda ()
+ (env-sound '(0 0 1 1 2 0) 0 100 2.0)
+ (env-sound '(0 0 1 1 3 0))
+ (env-sound '(0 0 1 1) 0 100 3.0))
+ (lambda ()
+ (env-sound '(0 0 1 1 3 0))
+ (env-sound '(0 0 1 1 2 0) 0 100 2.0)
+ (env-sound '(0 0 1 1) 0 100 3.0)))
+ ))
(close-sound ind))
+ ))
+
+ (let ((ind (open-sound "oboe.snd")))
+ ;; simple cases
+
+ (as-one-edit
+ (lambda ()
+ (set! (sample 10) 1.0)))
+ (if (fneq (sample 10) 1.0) (snd-display #__line__ ";as-one-edit 1: ~A" (sample 10)))
+ (if (not (= (edit-position ind 0) 1))
+ (snd-display #__line__ ";as-one-edit 1 edpos: ~A" (edit-position ind 0))
+ (begin
+ (if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
+ (snd-display #__line__ ";as-one-edit 1 edlist: ~A" (edit-fragment 1 ind 0)))
+ (if (not (equal? (edit-fragment 0 ind 0) (list "" "init" 0 50828)))
+ (snd-display #__line__ ";as-one-edit 1 original edlist: ~A" (edit-fragment 0 ind 0)))))
+
+ (revert-sound ind)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 10) 1.0)
+ (map-channel (lambda (y) (* y 2.0)) 0 20 ind 0 #f "map-channel as-one-edit")
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 2 edpos internal: ~A" (edit-position ind 0))))
+ "as-one-edit test-2")
+ (if (fneq (sample 10) 2.0) (snd-display #__line__ ";as-one-edit 2: ~A" (sample 10)))
+ (if (not (= (edit-position ind 0) 1))
+ (snd-display #__line__ ";as-one-edit 2 edpos: ~A" (edit-position ind 0))
+ (if (not (equal? (edit-fragment 0 ind 0) (list "" "init" 0 50828)))
+ (snd-display #__line__ ";as-one-edit 2 original edlist: ~A" (edit-fragment 0 ind 0))))
+
+ (revert-sound ind)
+ (let ((ind2 (open-sound "2a.snd")))
+ (set! (sample 1 ind2 0) 1.0)
+ (set! (sample 2 ind2 1) 0.5)
+ (set! (selected-sound) ind)
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (+ y .1)))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (ptree[0] 0 11) ; ptree-channel [5:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp3 0: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.100 0.101 0.108 0.127 0.164 0.225 0.316 0.443 0.612 0.829 1.100)))
- (snd-display #__line__ ";ptree-ramp3 1: ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 6 #f) "
- (scale 0 11) ; scale-channel 0.500 0 #f [6:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp3 2: ~A" (safe-display-edits ind 0 6 #f)))
-
- (undo 5)
- (ramp-channel 0 1)
- (ramp-channel 0 1 5 5)
- (ramp-channel 0 1 7 3)
- (ptree-channel (lambda (y) (+ y .1)))
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (ptree[0] 0 11) ; ptree-channel [5:5]:
- (at 0, cp->sounds[1][0:4, 1.000, [1]-0.000 -> 0.400, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 5, cp->sounds[1][5:6, 1.000, [1]0.500 -> 0.600, [2]0.000 -> 0.250, loc: 0, pos: 5, scl: 1.000]) [buf: 11]
- (at 7, cp->sounds[1][7:9, 1.000, [1]0.700 -> 0.900, [2]0.500 -> 1.000, [3]0.000 -> 1.000, loc: 0, pos: 7, scl: 1.000]) [buf: 11]
- (at 10, cp->sounds[1][10:10, 1.000, [1]1.000 -> 1.000, loc: 0, pos: 10, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree-ramp3 3: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.100 0.200 0.300 0.400 0.500 0.100 0.250 0.100 0.400 1.000 1.100)))
- (snd-display #__line__ ";ptree-ramp3 4: ~A" (channel->vct)))
- (close-sound ind))
+ (as-one-edit
+ (lambda ()
+ (set! (sample 10 ind 0) 1.0)))
+ (if (fneq (sample 10 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 3: ~A" (sample 10 ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 3 edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind2 0) 1)) (snd-display #__line__ ";as-one-edit 3 2 edpos: ~A" (edit-position ind2 0)))
+ (if (not (= (edit-position ind2 1) 1)) (snd-display #__line__ ";as-one-edit 3 2 1 edpos: ~A" (edit-position ind2 1)))
+ (if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
+ (snd-display #__line__ ";as-one-edit 3 edlist: ~A" (edit-fragment 1 ind 0)))
+ (if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 1 1.0000" "set" 1 1)))
+ (snd-display #__line__ ";as-one-edit 3 2 edlist: ~A" (edit-fragment 1 ind2 0)))
+ (if (not (equal? (edit-fragment 1 ind2 1) (list "set-sample 2 0.5000" "set" 2 1)))
+ (snd-display #__line__ ";as-one-edit 3 2 1 edlist: ~A" (edit-fragment 1 ind2 1)))
- ;; ramp3
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3 0: ~A" (safe-display-edits ind 0 4)))
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
- (snd-display #__line__ ";ramp3 (1): ~A" (channel->vct)))
- (scale-channel 0.5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 0 11) ; scale-channel 0.500 0 #f [5:2]:
- (at 0, cp->sounds[1][0:10, 0.500, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3 1: ~A" (safe-display-edits ind 0 5)))
- (undo)
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 0 5) ; scale-channel 0.500 0 5 [5:3]:
- (at 0, cp->sounds[1][0:4, 0.500, [1]-0.000 -> 0.400, [2]-0.000 -> 0.400, [3]-0.000 -> 0.400]) [buf: 11]
- (at 5, cp->sounds[1][5:10, 1.000, [1]0.500 -> 1.000, [2]0.500 -> 1.000, [3]0.500 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3 2: ~A" (safe-display-edits ind 0 5)))
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.004 0.014 0.032 0.125 0.216 0.343 0.512 0.729 1.000)))
- (snd-display #__line__ ";ramp3 (2): ~A" (channel->vct)))
- (undo)
- (scale-channel 0.5 2 4)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 2 4) ; scale-channel 0.500 2 4 [5:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100, [3]-0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:5, 0.500, [1]0.200 -> 0.500, [2]0.200 -> 0.500, [3]0.200 -> 0.500]) [buf: 11]
- (at 6, cp->sounds[1][6:10, 1.000, [1]0.600 -> 1.000, [2]0.600 -> 1.000, [3]0.600 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3 3: ~A" (safe-display-edits ind 0 5)))
- (undo 2)
- (ramp-channel 0.75 0.25)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; ramp-channel 0.750 0.250 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]0.750 -> 0.250]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3 4: ~A" (safe-display-edits ind 0 4)))
- (undo)
- (ramp-channel .2 .6 2 6)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 2 6) ; ramp-channel 0.200 0.600 2 6 [4:4]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:7, 1.000, [1]0.200 -> 0.700, [2]0.200 -> 0.700, [3]0.200 -> 0.600]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3 5: ~A" (safe-display-edits ind 0 4)))
- (scale-channel 0.5 0 5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (scale 0 5) ; scale-channel 0.500 0 5 [5:5]:
- (at 0, cp->sounds[1][0:1, 0.500, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:4, 0.500, [1]0.200 -> 0.400, [2]0.200 -> 0.400, [3]0.200 -> 0.360]) [buf: 11]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.500 -> 0.700, [2]0.500 -> 0.700, [3]0.440 -> 0.600]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3 6: ~A" (safe-display-edits ind 0 5)))
- (undo)
- (set! (sample 4) .5)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (set 4 1) ; set-sample 4 0.5000 [5:6]:
- (at 0, cp->sounds[1][0:1, 1.000, [1]-0.000 -> 0.100, [2]-0.000 -> 0.100]) [buf: 11]
- (at 2, cp->sounds[1][2:3, 1.000, [1]0.200 -> 0.300, [2]0.200 -> 0.300, [3]0.200 -> 0.280]) [buf: 11]
- (at 4, cp->sounds[2][0:0, 1.000]) [buf: 1]
- (at 5, cp->sounds[1][5:7, 1.000, [1]0.500 -> 0.700, [2]0.500 -> 0.700, [3]0.440 -> 0.600]) [buf: 11]
- (at 8, cp->sounds[1][8:10, 1.000, [1]0.800 -> 1.000, [2]0.800 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3 7: ~A" (safe-display-edits ind 0 5)))
- (undo 3)
- (close-sound ind))
+ (revert-sound ind)
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) 1.0) 0 100)
-
- ;; multi-ramp3
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (scale-channel 0.5 (* i 10) 10))
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 -0.5)
- (ramp-channel -0.5 1.5)
- (if (not (string=? (safe-display-edits ind 0 14) "
- (ramp 0 100) ; ramp-channel -0.500 1.500 0 #f [14:11]:
- (at 0, cp->sounds[1][0:9, 0.500, [1]0.000 -> 0.091, [2]1.000 -> 0.864, [3]-0.500 -> -0.318]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 0.500, [1]0.101 -> 0.192, [2]0.848 -> 0.712, [3]-0.298 -> -0.116]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 0.500, [1]0.202 -> 0.293, [2]0.697 -> 0.561, [3]-0.096 -> 0.086]) [buf: 100]
- (at 30, cp->sounds[1][30:39, 0.500, [1]0.303 -> 0.394, [2]0.545 -> 0.409, [3]0.106 -> 0.288]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 0.500, [1]0.404 -> 0.495, [2]0.394 -> 0.258, [3]0.308 -> 0.490]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 0.500, [1]0.505 -> 0.596, [2]0.242 -> 0.106, [3]0.510 -> 0.692]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 0.500, [1]0.606 -> 0.697, [2]0.091 -> -0.045, [3]0.712 -> 0.894]) [buf: 100]
- (at 70, cp->sounds[1][70:79, 0.500, [1]0.707 -> 0.798, [2]-0.061 -> -0.197, [3]0.914 -> 1.096]) [buf: 100]
- (at 80, cp->sounds[1][80:89, 0.500, [1]0.808 -> 0.899, [2]-0.212 -> -0.348, [3]1.116 -> 1.298]) [buf: 100]
- (at 90, cp->sounds[1][90:99, 0.500, [1]0.909 -> 1.000, [2]-0.364 -> -0.500, [3]1.318 -> 1.500]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-ramp3 1: ~A" (safe-display-edits ind 0 14)))
- (undo 13)
- (ramp-channel 0.0 1.0 10 30)
- (ramp-channel 0.0 1.0 50 20)
- (ramp-channel 0.0 1.0 20 15)
- (ramp-channel 0.0 1.0 30 30)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (ramp 30 30) ; ramp-channel 0.000 1.000 30 30 [5:10]:
- (at 0, cp->sounds[1][0:9, 1.000]) [buf: 100]
- (at 10, cp->sounds[1][10:19, 1.000, [1]0.000 -> 0.310]) [buf: 100]
- (at 20, cp->sounds[1][20:29, 1.000, [1]0.345 -> 0.655, [2]-0.000 -> 0.643]) [buf: 100]
- (at 30, cp->sounds[1][30:34, 1.000, [1]0.690 -> 0.828, [2]0.714 -> 1.000, [3]0.000 -> 0.138]) [buf: 100]
- (at 35, cp->sounds[1][35:39, 1.000, [1]0.862 -> 1.000, [2]0.172 -> 0.310]) [buf: 100]
- (at 40, cp->sounds[1][40:49, 1.000, [1]0.345 -> 0.655]) [buf: 100]
- (at 50, cp->sounds[1][50:59, 1.000, [1]-0.000 -> 0.474, [2]0.690 -> 1.000]) [buf: 100]
- (at 60, cp->sounds[1][60:69, 1.000, [1]0.526 -> 1.000]) [buf: 100]
- (at 70, cp->sounds[1][70:99, 1.000]) [buf: 100]
- (at 100, end_mark)
-"))
- (snd-display #__line__ ";multi-ramp3 2: ~A" (safe-display-edits ind 0 5)))
-
- (let ((vals (channel->vct)))
- (undo 4)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0 10 30)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0 50 20)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0 20 15)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0 30 30)
- (if (not (vequal vals (channel->vct)))
- (snd-display #__line__ ";ramp3 opt vs unopt: ~A ~A" vals (channel->vct))))
-
- (close-sound ind))
+ (as-one-edit
+ (lambda ()
+ (set! (sample 10 ind 0) 1.0)
+ (map-channel (lambda (y) (* y 2.0)) 0 20 ind 0 #f "map-channel as-one-edit 2")
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 4 edpos internal: ~A" (edit-position ind 0))))
+ "as-one-edit test-4")
+ (if (fneq (sample 10) 2.0) (snd-display #__line__ ";as-one-edit 4: ~A" (sample 10 ind 0)))
+ (if (not (= (edit-position ind 0) 1))
+ (snd-display #__line__ ";as-one-edit 4 edpos: ~A" (edit-position ind 0)))
+ (if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 1 1.0000" "set" 1 1)))
+ (snd-display #__line__ ";as-one-edit 3 2 edlist: ~A" (edit-fragment 1 ind2 0)))
+ (if (not (equal? (edit-fragment 1 ind2 1) (list "set-sample 2 0.5000" "set" 2 1)))
+ (snd-display #__line__ ";as-one-edit 3 2 1 edlist: ~A" (edit-fragment 1 ind2 1)))
- ;; various cases not optimized, presumably
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- ;; ramp+xramp (now optimized)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp+xramp: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- ;; xramp+xramp -- this one now optimized
- (xramp-channel 0.0 1.0 0.32)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: 1.471, scl: -1.471, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp+xramp: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- ;; xramp+xramp+xramp
- (xramp-channel 0.0 1.0 0.32)
- (xramp-channel 0.0 1.0 32.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: 1.471, scl: -1.471, [2]0.000 -> 1.000, off: -0.032, scl: 0.032, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp+xramp+xramp (maxed): ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; xramp+xramp+ramp (now optimized)
- (xramp-channel 0.0 1.0 0.32)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: 1.471, scl: -1.471, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp+xramp+ramp: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; xramp+ramp (now optimized)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp+ramp: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- ;; ramp+ramp+xramp
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp+ramp+xramp: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; ramp+ramp+ramp+ramp
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, [4]-0.000 -> 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp+ramp+ramp+ramp: ~A" (safe-display-edits ind 0 5)))
- (undo 4)
-
- ;; ramp+ramp+ramp+xramp
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [5:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, [3]0.000 -> 1.000, [4]0.000 -> 1.000, off: -0.032, scl: 0.032]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp+ramp+ramp+xramp: ~A" (safe-display-edits ind 0 5)))
- (undo 4)
-
- ;; ptree+ramp (now optimized)
- (ptree-channel (lambda (y) y))
- (ramp-channel 0.0 1.0)
- (if (not (string-=? (safe-display-edits ind 0 3) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree+ramp: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
-
- ;; ramp+xramp+ptree (now optimized)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ptree[0] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp+xramp+ptree: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; xramp+ramp+ptree (now optimized)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 4) "
- (ptree[0] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, [2]0.000 -> 1.000, off: -0.032, scl: 0.032, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp+ramp+ptree: ~A" (safe-display-edits ind 0 4)))
- (undo 3)
-
- ;; ramp3+ptree (now optimized)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) y))
- (if (not (string-=? (safe-display-edits ind 0 5) "
- (ptree[0] 0 11) ; ptree-channel [5:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, [3]-0.000 -> 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp3+ptree: ~A" (safe-display-edits ind 0 5)))
- (undo 4)
-
- ;; ptree+ptree (now optimized)
- (ptree-channel (lambda (y) y))
- (ptree-channel (lambda (y) y))
- (if (not (string=? (safe-display-edits ind 0 3) "
- (ptree[1] 0 11) ; ptree-channel [3:2]:
- (at 0, cp->sounds[1][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) y)]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ptree+ptree: ~A" (safe-display-edits ind 0 3)))
- (undo 2)
- (close-sound ind))
+ (revert-sound ind)
+ (set! (sample 3 ind 0) 1.0)
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 10)
-
- ;; ramp ptree2 cases
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 4 #f) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp ptree2: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0)))
- (snd-display #__line__ ";ramp ptree2: ~A" (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]-0.000 -> 1.000, [2]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";ramp2 ptree2: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display #__line__ ";ramp2 ptree2: ~A" (channel->vct)))
- (undo 2)
- (xramp-channel 0 1 32)
- (if (not (string=? (safe-display-edits ind 0 4 #f) "
- (ramp 0 11) ; xramp-channel 0.000 1.000 32.000 0 #f [4:2]:
- (at 0, cp->sounds[1][0:10, 1.000, [1]0.000 -> 1.000, off: -0.032, scl: 0.032, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000]) [buf: 11]
- (at 11, end_mark)
-"))
- (snd-display #__line__ ";xramp ptree2: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.000)))
- (snd-display #__line__ ";xramp ptree2: ~A" (channel->vct)))
-
- (undo 3)
- (scale-channel 0.0)
-
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0 1)
- (if (not (string=? (safe-display-edits ind 0 4 #f) (string-append "
- (ptree[1] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[0][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
- (at 11, end_mark)
-")))
- (snd-display #__line__ ";ramp ptree2 zero: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0)))
- (snd-display #__line__ ";ramp ptree2 zero: ~A" (channel->vct)))
- (ramp-channel 0 1)
- (if (not (string-=? (safe-display-edits ind 0 5 #f) (string-append "
- (ramp 0 11) ; ramp-channel 0.000 1.000 0 #f [5:2]:
- (at 0, cp->sounds[0][0:10, 1.000, [1]-0.000 -> 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
- (at 11, end_mark)
-")))
- (snd-display #__line__ ";ramp2 ptree2 zero: ~A" (safe-display-edits ind 0 5 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display #__line__ ";ramp2 ptree2 zero: ~A" (channel->vct)))
- (undo 2)
- (xramp-channel 0 1 32)
- (if (not (string=? (safe-display-edits ind 0 4 #f) (string-append "
- (ptree[1] 0 11) ; ptree-channel [4:2]:
- (at 0, cp->sounds[0][0:10, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 0.000]) [file: " (getcwd) "/test.snd[0]]
- (at 11, end_mark)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 10 ind 0) 1.0)
+ (set! (sample 10 ind2 0) 0.5)
+ (set! (sample 10 ind2 1) 0.4)))
+ (if (fneq (sample 3 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 5 (3): ~A" (sample 3 ind 0)))
+ (if (fneq (sample 10 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 5 (10): ~A" (sample 10 ind 0)))
+ (if (fneq (sample 10 ind2 0) 0.5) (snd-display #__line__ ";as-one-edit 5 (2 10): ~A" (sample 10 ind2 0)))
+ (if (fneq (sample 10 ind2 1) 0.4) (snd-display #__line__ ";as-one-edit 5 (2 1 10): ~A" (sample 10 ind2 1)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 5 edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind2 0) 2)) (snd-display #__line__ ";as-one-edit 5 2 edpos: ~A" (edit-position ind2 0)))
+ (if (not (= (edit-position ind2 1) 2)) (snd-display #__line__ ";as-one-edit 5 2 1 edpos: ~A" (edit-position ind2 1)))
+
+ (if (not (equal? (edit-fragment 2 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 2: ~A" (edit-fragment 1 ind 0)))
+ (if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 3 1.0000" "set" 3 1)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 1: ~A" (edit-fragment 1 ind 0)))
+ (if (not (equal? (edit-fragment 0 ind 0) (list "" "init" 0 50828)))
+ (snd-display #__line__ ";as-one-edit 5 original edlist: ~A" (edit-fragment 0 ind 0)))
+ (if (not (equal? (edit-fragment 2 ind2 0) (list "set-sample 10 0.5000" "set" 10 1)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 2 1: ~A" (edit-fragment 1 ind2 0)))
+
+ (as-one-edit
+ (lambda ()
+ (map-channel (lambda (y) (* y 2.0)) 0 20 ind 0 #f "map-channel as-one-edit 6")
+ (map-channel (lambda (y) (* y 2.0)) 0 20 ind2 1 #f "map-channel as-one-edit 6 2 1"))
+ "as-one-edit test-6")
+
+
+ (if (fneq (sample 3 ind 0) 2.0) (snd-display #__line__ ";as-one-edit 6 (3): ~A" (sample 3 ind 0)))
+ (if (fneq (sample 10 ind 0) 2.0) (snd-display #__line__ ";as-one-edit 6 (10): ~A" (sample 10 ind 0)))
+ (if (fneq (sample 10 ind2 0) 0.5) (snd-display #__line__ ";as-one-edit 6 (2 10): ~A" (sample 10 ind2 0)))
+ (if (fneq (sample 10 ind2 1) 0.8) (snd-display #__line__ ";as-one-edit 6 (2 1 10): ~A" (sample 10 ind2 1)))
+ (if (not (= (edit-position ind 0) 3)) (snd-display #__line__ ";as-one-edit 6 edpos: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind2 0) 2)) (snd-display #__line__ ";as-one-edit 6 2 edpos: ~A" (edit-position ind2 0)))
+ (if (not (= (edit-position ind2 1) 3)) (snd-display #__line__ ";as-one-edit 6 2 1 edpos: ~A" (edit-position ind2 1)))
+
+ (if (not (equal? (edit-fragment 2 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 2: ~A" (edit-fragment 1 ind 0)))
+ (if (not (equal? (edit-fragment 2 ind2 0) (list "set-sample 10 0.5000" "set" 10 1)))
+ (snd-display #__line__ ";as-one-edit 5 edlist 2 1: ~A" (edit-fragment 1 ind2 0)))
+ (close-sound ind2))
+
+ ;; nested cases
+ (revert-sound ind)
+
+ (as-one-edit
+ (lambda ()
+ (set! (sample 100) .9)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 200) .8)
+ (set! (sample 300) .7)))
+ (set! (sample 300) .6)))
+ (if (or (fneq (sample 100) .9)
+ (fneq (sample 200) .8)
+ (fneq (sample 300) .6))
+ (snd-display #__line__ ";nested as-one-edit 7: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
+ (if (not (= (edit-position ind 0) 1))
+ (snd-display #__line__ ";nested as-one-edit 7 edpos: ~A" (edit-position ind 0)))
+ (if (squelch-update ind 0)
+ (begin
+ (snd-display #__line__ ";nested as-one-edit 7 squelch is on")
+ (set! (squelch-update) #f)))
+ (if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 300 0.6000" "set" 100 204)))
+ (snd-display #__line__ ";as-one-edit 7 edlist: ~A" (edit-fragment 1 ind 0)))
+
+ (revert-sound ind)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 100) .9)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 200) .8)
+ (set! (sample 300) .7)))
+ (set! (sample 300) .6))
+ "as-one-edit test-8")
+ (if (or (fneq (sample 100) .9)
+ (fneq (sample 200) .8)
+ (fneq (sample 300) .6))
+ (snd-display #__line__ ";nested as-one-edit 8: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
+ (if (not (= (edit-position ind 0) 1))
+ (snd-display #__line__ ";nested as-one-edit 8 edpos: ~A" (edit-position ind 0)))
+ (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-8" "set" 100 204)))
+ (snd-display #__line__ ";as-one-edit 8 edlist: ~A" (edit-fragment 1 ind 0)))
+
+ (revert-sound ind)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 100) .9)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 200) .8)
+ (set! (sample 300) .7))
+ "as-one-edit 9 internal")
+ (set! (sample 300) .6))
+ "as-one-edit test-9")
+ (if (or (fneq (sample 100) .9)
+ (fneq (sample 200) .8)
+ (fneq (sample 300) .6))
+ (snd-display #__line__ ";nested as-one-edit 9: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
+ (if (not (= (edit-position ind 0) 1))
+ (snd-display #__line__ ";nested as-one-edit 9 edpos: ~A" (edit-position ind 0)))
+ (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-9" "set" 100 204)))
+ (snd-display #__line__ ";as-one-edit 9 edlist: ~A" (edit-fragment 1 ind 0)))
+
+ (revert-sound ind)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 100) .9)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 200) .8)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 400) .3))
+ "not a name")
+ (set! (sample 300) .7))
+ "as-one-edit 10 internal")
+ (set! (sample 300) .6))
+ "as-one-edit test-10")
+ (if (or (fneq (sample 100) .9)
+ (fneq (sample 200) .8)
+ (fneq (sample 300) .6)
+ (fneq (sample 400) .3))
+ (snd-display #__line__ ";nested as-one-edit 10: ~A ~A ~A ~A" (sample 100) (sample 200) (sample 300) (sample 400)))
+ (if (not (= (edit-position ind 0) 1))
+ (snd-display #__line__ ";nested as-one-edit 10 edpos: ~A" (edit-position ind 0)))
+ (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-10" "set" 100 305)))
+ (snd-display #__line__ ";as-one-edit 10 edlist: ~A" (edit-fragment 1 ind 0)))
+
+ ;; try implicit as-one-edits nested
+ (revert-sound ind)
+ (env-channel-with-base '(0 0 1 1 2 .5 3 .25 4 0) 0.0 0 #f ind 0)
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 11 edpos: ~A" (edit-position ind 0)))
+ (if (not (equal? (edit-fragment 1 ind 0)
+ (list "env-channel-with-base '(0.000 0.000 1.000 1.000 2.000 0.500 3.000 0.250 4.000 0.000) 0.0000 0 #f" "scale" 0 50830)))
+ (snd-display #__line__ ";as-one-edit 11: ~A" (edit-fragment 1 ind 0)))
+
+ (revert-sound ind)
+ (as-one-edit
+ (lambda ()
+ (env-channel-with-base '(0 0 1 1 2 .5 3 .25 4 0) 0.0 0 #f ind 0))
+ "as-one-edit 12")
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 12 edpos: ~A" (edit-position ind 0)))
+ (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit 12" "scale" 0 50830)))
+ (snd-display #__line__ ";as-one-edit 12: ~A" (edit-fragment 1 ind 0)))
+
+ (revert-sound ind)
+ (let ((m1 #f)
+ (m2 #f)
+ (m3 #f)
+ (m4 #f))
+ (as-one-edit
+ (lambda ()
+ (set! m1 (add-mark 1234 ind 0))
+ (set! (sample 1236 ind 0) .6)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 123 ind 0) .3)
+ (set! m2 (add-mark 1235 ind 0)))
+ "as-one-edit inner 1")
+ (if (not (mark? m1)) (snd-display #__line__ ";as-one-edit stepped on m1: ~A" m1))
+ (if (not (mark? m2)) (snd-display #__line__ ";as-one-edit stepped on m2: ~A" m2))
+ (as-one-edit
+ (lambda ()
+ (set! m3 (add-mark 1238 ind 0))
+ (set! (sample 1238 ind 0) .8))
+ "as-one-edit inner 2")
+ (set! (sample 1239 ind 0) .9)
+ (set! m4 (add-mark 1237 ind 0)))
+ "outer as-one-edit")
+ (if (not (mark? m1)) (snd-display #__line__ ";second as-one-edit stepped on m1: ~A" m1))
+ (if (not (mark? m2)) (snd-display #__line__ ";second as-one-edit stepped on m2: ~A" m2))
+ (if (not (mark? m3)) (snd-display #__line__ ";second as-one-edit stepped on m3: ~A" m3))
+ (if (not (mark? m4)) (snd-display #__line__ ";second as-one-edit stepped on m4: ~A" m4))
+ (if (not (= (mark-sample m1) 1234)) (snd-display #__line__ ";as-one-edit m1 sample: ~A (1234)" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 1235)) (snd-display #__line__ ";as-one-edit m2 sample: ~A (1235)" (mark-sample m2)))
+ (if (not (= (mark-sample m3) 1238)) (snd-display #__line__ ";as-one-edit m3 sample: ~A (1238)" (mark-sample m3)))
+ (if (not (= (mark-sample m4) 1237)) (snd-display #__line__ ";as-one-edit m4 sample: ~A (1237)" (mark-sample m4)))
+ (if (not (string=? (display-edits ind 0) (string-append "
+EDITS: 1
+
+ (begin) [0:2]:
+ (at 0, cp->sounds[0][0:50827, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 50828, end_mark)
+
+ (set 123 1120) ; outer as-one-edit [1:9]:
+ (at 0, cp->sounds[0][0:122, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 123, cp->sounds[2][0:0, 1.000]) [buf: 1]
+ (at 124, cp->sounds[0][124:1235, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 1236, cp->sounds[1][0:0, 1.000]) [buf: 1]
+ (at 1237, cp->sounds[0][1237:1237, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 1238, cp->sounds[3][0:0, 1.000]) [buf: 1]
+ (at 1239, cp->sounds[4][0:0, 1.000]) [buf: 1]
+ (at 1240, cp->sounds[0][1240:50827, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 50828, end_mark)
")))
- (snd-display #__line__ ";xramp ptree2 zero: ~A" (safe-display-edits ind 0 4 #f)))
- (if (not (vequal (channel->vct) (vct 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.000)))
- (snd-display #__line__ ";xramp ptree2 zero: ~A" (channel->vct)))
-
- (close-sound ind))
+ (snd-display #__line__ ";as-one-edit edits: ~A" (display-edits ind 0)))
- ;; ptree3 + ramps
- (let ((ind (new-sound "test.snd"))
- (case1 #f)
- (case2 #f))
- (map-chan (lambda (y) 1.0) 0 10)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (make-vct 11 4.0)))
- (snd-display #__line__ ";ptree3 1: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 16)))
- (snd-display #__line__ ";ptree3 2: ~A" (edit-tree)))
-
- (scale-channel 0.25)
- (if (not (vequal (channel->vct) (make-vct 11 1.0)))
- (snd-display #__line__ ";ptree3 3: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.250 0.0 0.0 16)))
- (snd-display #__line__ ";ptree3 4: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000)))
- (snd-display #__line__ ";ptree3 5: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display #__line__ ";ptree3 6: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display #__line__ ";ptree3 7: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display #__line__ ";ptree3 8: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
- (snd-display #__line__ ";ptree3 9: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display #__line__ ";ptree3 10: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.008 0.026 0.062 0.130 0.240 0.410 0.656 1.000)))
- (snd-display #__line__ ";ptree3 11: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display #__line__ ";ptree3 12: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.25 0.0 0.1 26)))
- (snd-display #__line__ ";ptree3 13: ~A" (edit-tree)))
-
- ;; ptree3-zero + ramps
- (revert-sound ind)
- (map-chan (lambda (y) 1.0) 0 10)
- (scale-by 0.0)
-
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (make-vct 11 4.0)))
- (snd-display #__line__ ";ptree3 14: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 18)))
- (snd-display #__line__ ";ptree3 15: ~A" (edit-tree)))
-
- (scale-channel 0.25)
- (if (not (vequal (channel->vct) (make-vct 11 1.0)))
- (snd-display #__line__ ";ptree3 16: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.250 0.0 0.0 18)))
- (snd-display #__line__ ";ptree3 17: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000)))
- (snd-display #__line__ ";ptree3 18: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
- (snd-display #__line__ ";ptree3 19: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000)))
- (snd-display #__line__ ";ptree3 20: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
- (snd-display #__line__ ";ptree3 21: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000)))
- (snd-display #__line__ ";ptree3 22: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
- (snd-display #__line__ ";ptree3 23: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.008 0.026 0.062 0.130 0.240 0.410 0.656 1.000)))
- (snd-display #__line__ ";ptree3 24: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 0.25 0.0 0.1 28)))
- (snd-display #__line__ ";ptree3 25: ~A" (edit-tree)))
-
- (revert-sound ind)
-
- ;; ptree3 + various scalers
- (map-chan (lambda (y) 1.0) 0 10)
- (scale-channel 0.5)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (scale-channel 2.0)
- (ptree-channel (lambda (y) (+ y 1.5)))
- (scale-channel 0.25)
- (ptree-channel (lambda (y) (+ y 1.0)))
- (scale-channel 0.1)
- (if (not (vequal (channel->vct) (vct 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188 0.188)))
- (snd-display #__line__ ";ptree3 26: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 0.100000001490116 0.0 0.0 16)))
- (snd-display #__line__ ";ptree3 27: ~A" (edit-tree)))
- (revert-sound ind)
-
- ;; ramps + ptree3
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.100 3.200 3.300 3.400 3.500 3.600 3.700 3.800 3.900 4.000)))
- (snd-display #__line__ ";ptree3 28: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
- (snd-display #__line__ ";ptree3 29: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.010 3.040 3.090 3.160 3.250 3.360 3.490 3.640 3.810 4.000)))
- (snd-display #__line__ ";ptree3 30: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
- (snd-display #__line__ ";ptree3 31: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.001 3.008 3.027 3.064 3.125 3.216 3.343 3.512 3.729 4.000)))
- (snd-display #__line__ ";ptree3 32: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
- (snd-display #__line__ ";ptree3 33: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.000 3.002 3.008 3.026 3.062 3.130 3.240 3.410 3.656 4.000)))
- (snd-display #__line__ ";ptree3 34: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 20)))
- (snd-display #__line__ ";ptree3 35: ~A" (edit-tree)))
- (revert-sound ind)
-
-
- ;; xramps+ptree3 and vice-versa
- (map-chan (lambda (y) 1.0) 0 10)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (xramp-channel 0.0 1.0 10.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.115 0.260 0.442 0.672 0.961 1.325 1.783 2.360 3.086 4.000)))
- (snd-display #__line__ ";ptree3 36: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 30)))
- (snd-display #__line__ ";ptree3 37: ~A" (edit-tree)))
-
- (xramp-channel 0.0 1.0 10.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.003 0.017 0.049 0.113 0.231 0.439 0.795 1.392 2.381 4.000)))
- (snd-display #__line__ ";ptree3 38: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 30)))
- (snd-display #__line__ ";ptree3 39: ~A" (edit-tree)))
-
+ (revert-sound ind))
+
+ (let ((m1 #f)
+ (m2 #f)
+ (m3 #f)
+ (m4 #f))
+ (as-one-edit
+ (lambda ()
+ (set! m1 (mix-float-vector (float-vector .1 .2 .3) 1234 ind 0))
+ (set! (sample 1236 ind 0) .6)
+ (as-one-edit
+ (lambda ()
+ (set! (sample 123 ind 0) .3)
+ (set! m2 (mix-float-vector (float-vector .1 .2 .3) 1235 ind 0)))
+ "as-one-edit inner 1")
+ (if (not (mix? m1)) (snd-display #__line__ ";as-one-edit stepped on m1: ~A" m1))
+ (if (not (mix? m2)) (snd-display #__line__ ";as-one-edit stepped on m2: ~A" m2))
+ (as-one-edit
+ (lambda ()
+ (set! m3 (mix-float-vector (float-vector .1 .2 .3) 1238 ind 0))
+ (set! (sample 1238 ind 0) .8))
+ "as-one-edit inner 2")
+ (set! (sample 1239 ind 0) .9)
+ (set! m4 (mix-float-vector (float-vector .1 .2 .3) 1237 ind 0)))
+ "outer as-one-edit")
+ (if (not (mix? m1)) (snd-display #__line__ ";second as-one-edit stepped on mx1: ~A" m1))
+ (if (not (mix? m2)) (snd-display #__line__ ";second as-one-edit stepped on mx2: ~A" m2))
+ (if (not (mix? m3)) (snd-display #__line__ ";second as-one-edit stepped on mx3: ~A" m3))
+ (if (not (mix? m4)) (snd-display #__line__ ";second as-one-edit stepped on mx4: ~A" m4))
+ (revert-sound ind))
+
+ (let ((ind2 #f))
+ (as-one-edit
+ (lambda ()
+ (set! ind2 (open-sound "pistol.snd"))
+ (set! (sample 100 ind 0) .5)
+ (set! (sample 200 ind2 0) .6))
+ "as-one-edit+open")
+ (if (not (sound? ind2)) (snd-display #__line__ ";as-one-edit didn't open sound? ~A ~A" ind2 (sounds)))
+ (if (not (= (edit-position ind2 0) 1)) (snd-display #__line__ ";edpos as-one-edit opened sound: ~A" (edit-position ind2 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";edpos as-one-edit original sound: ~A" (edit-position ind 0)))
+ (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit+open" "set" 100 1)))
+ (snd-display #__line__ ";as-one-edit open sound edlist orig: ~A" (edit-fragment 1 ind 0)))
+ (if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 200 0.6000" "set" 200 1)))
+ (snd-display #__line__ ";as-one-edit open sound edlist new: ~A" (edit-fragment 1 ind2 0)))
+
+ (as-one-edit
+ (lambda ()
+ (set! (sample 200 ind 0) .7)
+ (close-sound ind2))
+ "as-one-edit+close")
+ (if (sound? ind2)
+ (begin
+ (snd-display #__line__ ";as-one-edit didn't close sound? ~A ~A" ind2 (sounds))
+ (close-sound ind2)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";edpos as-one-edit close original sound: ~A" (edit-position ind 0)))
+ (if (not (string=? (display-edits ind 0) (string-append "
+EDITS: 2
+
+ (begin) [0:2]:
+ (at 0, cp->sounds[0][0:50827, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 50828, end_mark)
+
+ (set 100 1) ; as-one-edit+open [1:4]:
+ (at 0, cp->sounds[0][0:99, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 100, cp->sounds[1][0:0, 1.000]) [buf: 1]
+ (at 101, cp->sounds[0][101:50827, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 50828, end_mark)
+
+ (set 200 1) ; as-one-edit+close [2:6]:
+ (at 0, cp->sounds[0][0:99, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 100, cp->sounds[1][0:0, 1.000]) [buf: 1]
+ (at 101, cp->sounds[0][101:199, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 200, cp->sounds[2][0:0, 1.000]) [buf: 1]
+ (at 201, cp->sounds[0][201:50827, 1.000]) [file: " cwd "oboe.snd[0]]
+ (at 50828, end_mark)
+")))
+ (snd-display #__line__ ";as-one-edit open+close: ~A" (display-edits ind 0))))
+
+ (close-sound ind))
+
+ (let ((ind1 (open-sound "oboe.snd"))
+ (ind2 #f))
+ (as-one-edit
+ (lambda ()
+ (set! (sample 100 ind1 0) .5)
+ (set! ind2 (open-sound "pistol.snd"))
+ (as-one-edit
+ (lambda ()
+ (set! (sample 200 ind2 0) .5)
+ (close-sound ind1))
+ "inner edit")
+ (set! (sample 300 ind2 0) .6))
+ "outer edit")
+ (if (sound? ind1) (snd-display #__line__ ";as-one-edit close inner: ~A ~A" ind1 (sounds)))
+ (if (not (sound? ind2)) (snd-display #__line__ ";as-one-edit open inner: ~A ~A" ind2 (sounds)))
+
+ (revert-sound ind2)
+ (as-one-edit
+ (lambda ()
+ (set! ind1 (open-sound "oboe.snd"))
+ (as-one-edit
+ (lambda ()
+ (set! (sample 200 ind1 0) .5))
+ "inner edit")
+ (set! (sample 100 ind2 0) .4))
+ "outer edit")
+ (close-sound ind1)
+ (close-sound ind2))
+
+ (let* ((ind (open-sound "oboe.snd"))
+ (mx (maxamp ind 0)))
+ (let ((tag (catch #t
+ (lambda () (as-one-edit (lambda (oops) #f)))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'bad-arity))
+ (snd-display #__line__ ";as-one-edit arg? ~A" tag)))
+ (let ((tag (catch #t
+ (lambda () (as-one-edit (lambda* (oops) #f)))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'bad-arity))
+ (snd-display #__line__ ";as-one-edit arg? ~A" tag)))
+ (close-sound ind))
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "more tests" 10)))
+ ;; offset-channel
+ (offset-channel .1)
+ (if (not (vequal (channel->float-vector 0 10) (make-float-vector 10 .1)))
+ (snd-display #__line__ ";offset-channel (.1): ~A" (channel->float-vector 0 10)))
+ (offset-channel -.2 5 5)
+ (if (not (vequal (channel->float-vector 0 10) (float-vector .1 .1 .1 .1 .1 -.1 -.1 -.1 -.1 -.1)))
+ (snd-display #__line__ ";offset-channel (-.1): ~A" (channel->float-vector 0 10)))
+ (undo)
+ (offset-channel .9 0 10 ind 0)
+ (if (not (vequal (channel->float-vector 0 10) (make-float-vector 10 1.0)))
+ (snd-display #__line__ ";offset-channel (1): ~A" (channel->float-vector 0 10)))
+ ;; sine-env and sine-ramp...
+ (revert-sound ind)
+ (map-channel (lambda (y) 1.0))
+ (sine-ramp 0.0 1.0)
+ (if (not (vequal (channel->float-vector) (float-vector 0.000 0.024 0.095 0.206 0.345 0.500 0.655 0.794 0.905 0.976)))
+ (snd-display #__line__ ";sine-ramp 0 1: ~A" (channel->float-vector)))
+ (revert-sound ind)
+ (offset-channel 1.0)
+ (sine-ramp 1.0 0.0)
+ (if (not (vequal (channel->float-vector) (float-vector 1.000 0.976 0.905 0.794 0.655 0.500 0.345 0.206 0.095 0.024)))
+ (snd-display #__line__ ";sine-ramp 1 0: ~A" (channel->float-vector)))
+ (close-sound ind)
+ (set! ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "sine-env tests" 100))
+ (map-channel (lambda (y) 1.0))
+ (sine-env-channel '(0 0 1 1 2 -.5 3 1))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit sine-env-channel: ~A" (edit-position ind 0)))
+ (revert-sound ind)
+ (offset-channel -1.0)
+ (sine-env-channel '(0 0 1 1 2 1 3 0) 40 20)
+ (if (or (not (vequal (channel->float-vector 40 20) (float-vector -0.000 -0.050 -0.188 -0.389 -0.611 -0.812 -0.950 -1.000 -1.000 -1.000
+ -1.000 -1.000 -1.000 -1.000 -1.000 -0.950 -0.812 -0.611 -0.389 -0.188)))
+ (not (vequal (channel->float-vector 30 10) (make-float-vector 10 -1.0))))
+ (snd-display #__line__ ";off+sine-env: ~A ~A" (channel->float-vector 40 20) (channel->float-vector 30 10)))
+ (revert-sound ind)
+ (scale-by 0.0)
+ (dither-channel)
+ (let ((mx (maxamp)))
+ (if (or (< mx .00003) (> mx .0001))
+ (snd-display #__line__ ";dithering: ~A" mx)))
+ (revert-sound ind)
+ (map-channel (ring-mod 10 (list 0 0 1 (hz->radians 100))))
+ (osc-formants .99 (float-vector 400.0 800.0 1200.0) (float-vector 400.0 800.0 1200.0) (float-vector 4.0 2.0 3.0))
+ (map-channel (zecho .5 .75 6 10.0))
+ (map-channel (flecho .5 .9))
+ (filtered-env '(0 0 1 1 2 0))
+ (map-channel (formant-filter .99 2400))
+ (map-channel (comb-filter .8 32))
+ (map-channel (zcomb .8 32 '(0 0 1 10)))
+ (map-channel (notch-filter .8 32))
+ (let ((ind1 (open-sound "now.snd")))
+ (select-sound ind1)
+ (if (fneq (maxamp) .309) (snd-display #__line__ ";squelch-vowels init: ~A" (maxamp)))
+ (squelch-vowels)
+ (if (fneq (maxamp) .047) (snd-display #__line__ ";squelch-vowels maxamp: ~A" (maxamp)))
+ (select-sound ind)
+ (map-channel (cross-synthesis ind1 .5 128 6.0))
+ (revert-sound ind1)
+ (fft-edit 40 8000)
+ (fft-squelch .1)
+ (close-sound ind)
+ (revert-sound ind1)
+ (scramble-channel .01)
+ (revert-sound ind1)
+ (close-sound ind1)))
+
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "special env tests" 100)))
+ (map-channel (lambda (y) 1.0))
+
+ (blackman4-ramp 0.0 1.0)
+ (let ((vals (channel->float-vector)))
+ (undo)
+ (blackman4-env-channel '(0 0 1 1))
+ (let ((new-vals (channel->float-vector)))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";blackman4-env-channel/ramp: ~A ~A" vals new-vals))
+ (undo)
+ (blackman4-ramp 0.0 1.0 0 50)
+ (set! vals (channel->float-vector))
+ (undo)
+ (blackman4-env-channel '(0 0 1 1 2 1))
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";blackman4-env-channel/ramp 1: ~A ~A" vals new-vals))
+ (undo)
+ (blackman4-env-channel '(0 0 1 1 2 -.5 3 0))
+ (if (not (vequal (channel->float-vector 60 10) (float-vector -0.109 -0.217 -0.313 -0.392 -0.451 -0.488 -0.499 -0.499 -0.499 -0.499)))
+ (snd-display #__line__ ";blackman4 to -.5: ~A" (channel->float-vector 60 10)))
(undo)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.012 0.052 0.133 0.269 0.481 0.795 1.248 1.888 2.777 4.000)))
- (snd-display #__line__ ";ptree3 40: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
- (snd-display #__line__ ";ptree3 41: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.010 0.040 0.108 0.240 0.477 0.874 1.510 2.500 4.000)))
- (snd-display #__line__ ";ptree3 42: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
- (snd-display #__line__ ";ptree3 43: ~A" (edit-tree)))
-
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.012 0.043 0.120 0.286 0.612 1.208 2.250 4.000)))
- (snd-display #__line__ ";ptree3 44: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 34)))
- (snd-display #__line__ ";ptree3 45: ~A" (edit-tree)))
-
- (revert-sound ind)
- (map-chan (lambda (y) 1.0) 0 10)
- (scale-channel 0.0)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (xramp-channel 0.0 1.0 10.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.115 0.260 0.442 0.672 0.961 1.325 1.783 2.360 3.086 4.000)))
- (snd-display #__line__ ";ptree3 46: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 32)))
- (snd-display #__line__ ";ptree3 47: ~A" (edit-tree)))
-
- (xramp-channel 0.0 1.0 10.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.003 0.017 0.049 0.113 0.231 0.439 0.795 1.392 2.381 4.000)))
- (snd-display #__line__ ";ptree3 48: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.0 32)))
- (snd-display #__line__ ";ptree3 49: ~A" (edit-tree)))
+ (ramp-squared 0.0 1.0)
+ (set! vals (channel->float-vector))
+ (undo)
+ (env-squared-channel '(0 0 1 1))
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";env-squared/ramp: ~A ~A" vals new-vals))
+ (undo)
+ (ramp-squared 0.0 1.0 #t 0 50)
+ (set! vals (channel->float-vector))
+ (undo)
+ (env-squared-channel '(0 0 1 1 2 1))
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";env-squared/ramp 1: ~A ~A" vals new-vals))
+ (undo)
+ (env-squared-channel '(0 0 1 1 2 -.5 3 0))
+ (if (not (vequal (channel->float-vector 60 10) (float-vector -0.450 -0.466 -0.478 -0.488 -0.494 -0.499 -0.500 -0.500 -0.498 -0.496)))
+ (snd-display #__line__ ";env-squared to -.5: ~A" (channel->float-vector 60 10)))
+ (undo)
+ (env-squared-channel '(0 0 1 1 2 -.5 3 0) #f)
+ (if (not (vequal (channel->float-vector 60 10) (float-vector -0.004 -0.080 -0.158 -0.240 -0.324 -0.410 -0.500 -0.500 -0.498 -0.496)))
+ (snd-display #__line__ ";env-squared unsymmetric to -.5: ~A" (channel->float-vector 60 10)))
+ (undo)
+ (ramp-squared 0.0 1.0)
+ (set! vals (channel->float-vector))
+ (undo)
+ (env-expt-channel '(0 0 1 1) 2)
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";env-expt2/ramp: ~A ~A" vals new-vals))
+ (undo)
+ (env-squared-channel '(0 0 1 1 2 -.5 3 0))
+ (set! vals (channel->float-vector))
+ (undo)
+ (env-expt-channel '(0 0 1 1 2 -.5 3 0) 2.0)
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";env-expt2/env-squared: ~A ~A" vals new-vals))
+ (undo)
+ (env-squared-channel '(0 0 1 1 2 -.5 3 0) #f)
+ (set! vals (channel->float-vector))
+ (undo)
+ (env-expt-channel '(0 0 1 1 2 -.5 3 0) 2.0 #f)
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";env-expt2/env-squared unsymmetric: ~A ~A" vals new-vals))
(undo)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.012 0.052 0.133 0.269 0.481 0.795 1.248 1.888 2.777 4.000)))
- (snd-display #__line__ ";ptree3 50: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
- (snd-display #__line__ ";ptree3 51: ~A" (edit-tree)))
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.001 0.010 0.040 0.108 0.240 0.477 0.874 1.510 2.500 4.000)))
- (snd-display #__line__ ";ptree3 52: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
- (snd-display #__line__ ";ptree3 53: ~A" (edit-tree)))
+ (ramp-expt 0.0 1.0 32.0)
+ (set! vals (channel->float-vector))
+ (undo)
+ (env-expt-channel '(0 0 1 1) 32.0)
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";env-expt/ramp 32: ~A ~A" vals new-vals))
+ (undo)
+ (ramp-expt 0.0 1.0 32.0 #f 0 50)
+ (set! vals (channel->float-vector))
+ (undo)
+ (env-expt-channel '(0 0 1 1 2 1) 32.0)
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";env-expt/ramp 1 32: ~A ~A" vals new-vals))
+ (undo)
+ (ramp-expt 0.0 1.0 .1)
+ (set! vals (channel->float-vector))
+ (undo)
+ (env-expt-channel '(0 0 1 1) .1)
+ (set! new-vals (channel->float-vector))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";env-expt/ramp .1: ~A ~A" vals new-vals))
+ (undo)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.000 0.002 0.012 0.043 0.120 0.286 0.612 1.208 2.250 4.000)))
- (snd-display #__line__ ";ptree3 54: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 0 0 10 1.0 0.0 0.1 36)))
- (snd-display #__line__ ";ptree3 55: ~A" (edit-tree)))
-
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.029 3.065 3.111 3.168 3.240 3.331 3.446 3.590 3.771 4.000)))
- (snd-display #__line__ ";ptree3 56: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 22)))
- (snd-display #__line__ ";ptree3 57: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.003 3.013 3.033 3.067 3.120 3.199 3.312 3.472 3.694 4.000)))
- (snd-display #__line__ ";ptree3 58: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 24)))
- (snd-display #__line__ ";ptree3 59: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (if (not (vequal (channel->vct) (vct 3.000 3.001 3.004 3.012 3.028 3.058 3.110 3.199 3.348 3.595 4.000)))
- (snd-display #__line__ ";ptree3 60: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 22)))
- (snd-display #__line__ ";ptree3 61: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.303 0.613 0.933 1.267 1.620 1.999 2.412 2.872 3.394 4.000)))
- (snd-display #__line__ ";ptree3 62: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
- (snd-display #__line__ ";ptree3 63: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.030 0.123 0.280 0.507 0.810 1.199 1.688 2.298 3.055 4.000)))
- (snd-display #__line__ ";ptree3 64: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
- (snd-display #__line__ ";ptree3 65: ~A" (edit-tree)))
- (revert-sound ind)
-
-
- (map-chan (lambda (y) 1.0) 0 10)
- (xramp-channel 0.0 1.0 10.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.003 0.025 0.084 0.203 0.405 0.720 1.182 1.838 2.749 4.000)))
- (snd-display #__line__ ";ptree3 66: ~A" (channel->vct)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.1 39)))
- (snd-display #__line__ ";ptree3 67: ~A" (edit-tree)))
- (revert-sound ind)
-
- (map-chan (lambda (y) 1.0) 0 10)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ptree-channel (lambda (y) (* y 0.1)))
- (if (not (vequal (channel->vct) (make-vct 11 0.4)))
- (snd-display #__line__ ";ptree4: ~A" (channel->vct)))
- (if (< (max-virtual-ptrees) 4)
- (if (not (feql (car (edit-tree)) (list 0 2 0 10 1.0 0.0 0.0 0)))
- (snd-display #__line__ ";ptree4: ~A" (edit-tree)))
- (if (not (feql (car (edit-tree)) (list 0 1 0 10 1.0 0.0 0.0 16)))
- (snd-display #__line__ ";ptree4 (maxed): ~A" (edit-tree))))
-
- (close-sound ind))
-
- (let ((old-pmax (max-virtual-ptrees)))
-
- (set! (max-virtual-ptrees) 10)
-
- (let ((ind (new-sound "test.snd" :size 20)))
- (vct->channel (make-vct 20 1.0))
-
- (env-channel '(0 0 1 1 2 1 3 0))
- (let ((ramp-to-1 (channel->vct)))
- (undo)
- (xramp-channel 0 1 8)
- (let ((xramp-to-1 (channel->vct)))
- (undo)
- (ptree-channel (lambda (y) (* y 2.5)))
- (let ((pdata (channel->vct)))
- (undo)
-
- ;; -------- ramp-ptree-ramp --------
-
- (set! (edit-position) 1)
- (env-channel '(0 0 1 1 2 1 3 0))
- (ptree-channel (lambda (y) (* y 2.5)))
- (env-channel '(0 0 1 1 2 1 3 0))
- (let ((rpr (channel->vct)))
- (let ((nrpr (vct-multiply!
- (vct-multiply!
- (vct-multiply! (make-vct 20 1.0) ramp-to-1)
- pdata)
- ramp-to-1)))
- (if (not (vequal rpr nrpr))
- (snd-display #__line__ ";simple rpr:~%; ~A~%; ~A" rpr nrpr))))
-
- (set! (edit-position) 1)
- (scale-by 3.0)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by -1.234)
- (let ((rpr (channel->vct)))
- (let ((nrpr (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply! (make-vct 20 3.0) ramp-to-1)
- 1.25)
- pdata)
- -0.8)
- ramp-to-1)
- -1.234)))
- (if (not (vequal rpr nrpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * rpr:~%; ~A~%; ~A" rpr nrpr))))
-
-
- ;; -------- ramp-ptree-xramp --------
-
- (set! (edit-position) 1)
- (xramp-channel 0 1 8)
- (ptree-channel (lambda (y) (* y 2.5)))
- (env-channel '(0 0 1 1 2 1 3 0))
- (let ((rpr (channel->vct)))
- (let ((nrpr (vct-multiply!
- (vct-multiply!
- (vct-multiply! (make-vct 20 1.0) xramp-to-1)
- pdata)
- ramp-to-1)))
- (if (not (vequal rpr nrpr))
- (snd-display #__line__ ";simple rpx:~%; ~A~%; ~A" rpr nrpr))))
-
- (set! (edit-position) 1)
- (scale-by 3.0)
- (xramp-channel 0 1 8)
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by -1.234)
- (let ((rpr (channel->vct)))
- (let ((nrpr (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply! (make-vct 20 3.0) xramp-to-1)
- 1.25)
- pdata)
- -0.8)
- ramp-to-1)
- -1.234)))
- (if (not (vequal rpr nrpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * rpx:~%; ~A~%; ~A" rpr nrpr))))
-
-
- ;; -------- ramp-ptree-xramp-ramp --------
-
- (set! (edit-position) 1)
- (xramp-channel 0 1 8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (ptree-channel (lambda (y) (* y 2.5)))
- (env-channel '(0 0 1 1 2 1 3 0))
- (let ((rpr (channel->vct)))
- (let ((nrpr (vct-multiply!
- (vct-multiply!
- (vct-multiply!
- (vct-multiply! (make-vct 20 1.0) ramp-to-1)
- xramp-to-1)
- pdata)
- ramp-to-1)))
- (if (not (vequal rpr nrpr))
- (snd-display #__line__ ";simple rpxr:~%; ~A~%; ~A" rpr nrpr))))
-
- (set! (edit-position) 1)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by 3.0)
- (xramp-channel 0 1 8)
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by -1.0)
- (let ((rpr (channel->vct)))
- (let ((nrpr (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-multiply! (make-vct 20 3.0) ramp-to-1)
- xramp-to-1)
- 1.25)
- pdata)
- -0.8)
- ramp-to-1)
- -1.0)))
- (if (not (vequal rpr nrpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * rpxr:~%; ~A~%; ~A" rpr nrpr))))
-
-
- ;; -------- xramp-ptree-ramp --------
-
- (set! (edit-position) 1)
- (env-channel '(0 0 1 1 2 1 3 0))
- (ptree-channel (lambda (y) (* y 2.5)))
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-multiply!
- (vct-multiply! (make-vct 20 1.0) ramp-to-1)
- pdata)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";simple xpr:~%; ~A~%; ~A" xpr nxpr))))
-
- (set! (edit-position) 1)
- (scale-by 3.0)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (xramp-channel 0 1 8)
- (scale-by -1.234)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply! (make-vct 20 3.0) ramp-to-1)
- 1.25)
- pdata)
- -0.8)
- xramp-to-1)
- -1.234)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xpr:~%; ~A~%; ~A" xpr nxpr))))
-
-
- ;; -------- xramp-ptree-xramp --------
-
- (set! (edit-position) 1)
- (xramp-channel 0 1 8)
- (ptree-channel (lambda (y) (* y 2.5)))
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-multiply!
- (vct-multiply! (make-vct 20 1.0) xramp-to-1)
- pdata)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";simple xpx:~%; ~A~%; ~A" xpr nxpr))))
-
- (set! (edit-position) 1)
- (scale-by 3.0)
- (xramp-channel 0 1 8)
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (xramp-channel 0 1 8)
- (scale-by -1.234)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply! (make-vct 20 3.0) xramp-to-1)
- 1.25)
- pdata)
- -0.8)
- xramp-to-1)
- -1.234)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xpx:~%; ~A~%; ~A" xpr nxpr))))
-
-
- ;; -------- xramp-ptree-xramp-ramp --------
-
- (set! (edit-position) 1)
- (env-channel '(0 0 1 1 2 1 3 0))
- (xramp-channel 0 1 8)
- (ptree-channel (lambda (y) (* y 2.5)))
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-multiply!
- (vct-multiply!
- (vct-multiply! (make-vct 20 1.0) ramp-to-1)
- xramp-to-1)
- pdata)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";simple xpxr:~%; ~A~%; ~A" xpr nxpr))))
-
- (set! (edit-position) 1)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by 3.0)
- (xramp-channel 0 1 8)
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (xramp-channel 0 1 8)
- (scale-by -1.234)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-multiply! (make-vct 20 3.0) ramp-to-1)
- xramp-to-1)
- 1.25)
- pdata)
- -0.8)
- xramp-to-1)
- -1.234)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xpxr:~%; ~A~%; ~A" xpr nxpr))))
-
-
- ;; -------- xramp-ramp-ptree-ramp --------
-
- (set! (edit-position) 1)
- (env-channel '(0 0 1 1 2 1 3 0))
- (ptree-channel (lambda (y) (* y 2.5)))
- (env-channel '(0 0 1 1 2 1 3 0))
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-multiply!
- (vct-multiply!
- (vct-multiply! (make-vct 20 1.0) ramp-to-1)
- pdata)
- ramp-to-1)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";simple xrpr:~%; ~A~%; ~A" xpr nxpr))))
-
- (set! (edit-position) 1)
- (scale-by 3.0)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by -1.234)
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply! (make-vct 20 3.0) ramp-to-1)
- 1.25)
- pdata)
- -0.8)
- ramp-to-1)
- -1.234)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xrpr:~%; ~A~%; ~A" xpr nxpr))))
-
- ;; -------- xramp-ramp-ptree-xramp --------
-
- (set! (edit-position) 1)
- (xramp-channel 0 1 8)
- (ptree-channel (lambda (y) (* y 2.5)))
- (env-channel '(0 0 1 1 2 1 3 0))
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-multiply!
- (vct-multiply!
- (vct-multiply! (make-vct 20 1.0) xramp-to-1)
- pdata)
- ramp-to-1)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";simple xrpx:~%; ~A~%; ~A" xpr nxpr))))
-
- (set! (edit-position) 1)
- (scale-by 3.0)
- (xramp-channel 0 1 8)
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by -1.234)
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply! (make-vct 20 3.0) xramp-to-1)
- 1.25)
- pdata)
- -0.8)
- ramp-to-1)
- -1.234)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xrpx:~%; ~A~%; ~A" xpr nxpr))))
-
-
-
- ;; -------- xramp-ramp-ptree-xramp-ramp --------
-
- (set! (edit-position) 1)
- (xramp-channel 0 1 8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (ptree-channel (lambda (y) (* y 2.5)))
- (env-channel '(0 0 1 1 2 1 3 0))
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-multiply!
- (vct-multiply!
- (vct-multiply! (vct-multiply! (make-vct 20 1.0) xramp-to-1) ramp-to-1)
- pdata)
- ramp-to-1)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";simple xrpxr:~%; ~A~%; ~A" xpr nxpr))))
-
- (set! (edit-position) 1)
- (scale-by 3.0)
- (xramp-channel 0 1 8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by 1.25)
- (ptree-channel (lambda (y) (* y 2.5)))
- (scale-by -0.8)
- (env-channel '(0 0 1 1 2 1 3 0))
- (scale-by -1.234)
- (xramp-channel 0 1 8)
- (let ((xpr (channel->vct)))
- (let ((nxpr (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply!
- (vct-scale!
- (vct-multiply! (vct-multiply! (make-vct 20 3.0) xramp-to-1) ramp-to-1)
- 1.25)
- pdata)
- -0.8)
- ramp-to-1)
- -1.234)
- xramp-to-1)))
- (if (not (vequal xpr nxpr))
- (snd-display #__line__ ";3.0 1.25 -0.8 -1.234 * xrpxr:~%; ~A~%; ~A" xpr nxpr))))
-
- (close-sound ind)))))
- (set! (max-virtual-ptrees) old-pmax))
-
- (let ((data (make-vct 101 1.0))
- (rto1-data (make-vct 101))
- (xto1-data (make-vct 101))
- (cos-data (make-vct 101))
- (ind (new-sound "test.snd")))
- ;; test-ops.scm for 7 and 8 cases (40 min per branch)
-
- (define (set-to-1) (map-chan (lambda (y) 1.0) 0 100))
- (define (cset-to-1 dat) (do ((i 0 (+ 1 i))) ((= i 101)) (vct-set! dat i 1.0)))
- (define (ramp-to-1) (ramp-channel 0.0 1.0))
- (define (cramp-to-1 dat) (vct-multiply! dat rto1-data))
- (define (scale-by-half) (scale-channel 0.5))
- (define (cscale-by-half dat) (vct-scale! dat 0.5000))
- (define (scale-by-two) (scale-channel 2.0 30 40))
- (define (cscale-by-two dat) (do ((i 30 (+ 1 i))) ((= i 70)) (vct-set! dat i (* (vct-ref dat i) 2.0))))
- (define (xramp-to-1) (xramp-channel 0.0 1.0 32.0))
- (define (cxramp-to-1 dat) (vct-multiply! dat xto1-data))
- (define (scale-mid) (scale-channel 0.125 30 30))
- (define (cscale-mid dat) (do ((i 30 (+ 1 i))) ((= i 60)) (vct-set! dat i (* (vct-ref dat i) 0.125))))
- (define (on-air) (scale-channel 0.0 10 30))
- (define (con-air dat) (do ((i 10 (+ 1 i))) ((= i 40)) (vct-set! dat i 0.0)))
- (define (ptree) (ptree-channel (lambda (y) (* y 0.75)) 20 20))
- (define (cptree dat) (do ((i 20 (+ 1 i))) ((= i 40)) (vct-set! dat i (* (vct-ref dat i) .75))))
- (define (ptreec) (cosine-channel-via-ptree))
- (define (cptreec dat) (vct-multiply! dat cos-data))
- (define (xen) (ptree-channel (lambda (y) (* y 0.25)) 0 (frames) ind 0))
- (define (cxen dat) (vct-scale! dat 0.25))
- (define (rev-channel->vct)
- (let* ((l (vct-length data))
- (r (make-sampler (- l 1) ind 0 -1))
- (d (make-vct l)))
- (do ((i (- l 1) (- i 1)))
- ((< i 0))
- (vct-set! d i (r)))
- d))
- (define (ptreec1)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 10 50 ind 0 #f #f
- (lambda (pos dur)
- (vct 0.625))))
- (define (cptreec1 dat) (do ((i 10 (+ 1 i))) ((= i 60)) (vct-set! dat i (* (vct-ref dat i) 0.625))))
-
- (let ((xe (make-env '(0 0 1 1) :length 101 :base 32.0)))
- (do ((i 0 (+ 1 i))
- (incr (/ pi 101.0))
- (ang (* -0.5 pi)))
- ((= i 101))
- (vct-set! rto1-data i (* i .01))
- (vct-set! xto1-data i (env xe))
- (vct-set! cos-data i (cos ang))
- (set! ang (+ ang incr))))
-
- (set! (squelch-update ind) #t)
-
- ;; 0 case
- (set-to-1)
- (if (not (vvequal data (channel->vct)))
- (snd-display #__line__ ";0 case! ~A" (channel->vct)))
- (if (not (vvequal data (rev-channel->vct)))
- (snd-display #__line__ ";0 case rev! ~A" (rev-channel->vct)))
-
- ;; 1 case
- (for-each
- (lambda (func check)
- (revert-sound)
- (set-to-1)
- (cset-to-1 data)
- (func)
- (check data)
- (if (not (vvequal data (channel->vct)))
- (snd-display #__line__ ";1 case: ~A ~A" (procedure-name func) (channel->vct)))
- (if (not (vvequal data (rev-channel->vct)))
- (snd-display #__line__ ";1 rev case: ~A ~A" (procedure-name func) (rev-channel->vct))))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen))
-
- ;; 2 case
- (for-each
- (lambda (func check)
- (for-each
- (lambda (func1 check1)
- (revert-sound)
- (set-to-1)
- (cset-to-1 data)
- (func)
- (check data)
- (func1)
- (check1 data)
- (if (not (vvequal data (channel->vct)))
- (snd-display #__line__ ";2 case: ~A(~A): ~A" (procedure-name func1) (procedure-name func) (channel->vct)))
- (if (not (vvequal data (rev-channel->vct)))
- (snd-display #__line__ ";2 rev case: ~A(~A): ~A" (procedure-name func1) (procedure-name func) (rev-channel->vct))))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen))
-
- (set! (print-length) 200)
-
- ;; 3 case
- (for-each
- (lambda (func check)
- (for-each
- (lambda (func1 check1)
- (for-each
- (lambda (func2 check2)
- (revert-sound)
- (set-to-1)
- (cset-to-1 data)
- (func)
- (check data)
- (func1)
- (check1 data)
- (func2)
- (check2 data)
- (if (not (vvequal data (channel->vct)))
- (snd-display #__line__ ";3 case: ~A(~A(~A)): off by ~A~%; calc: ~A~%; chan: ~A"
- (procedure-name func2) (procedure-name func1) (procedure-name func)
- (vmaxdiff data (channel->vct)) data (channel->vct)))
- (if (not (vvequal data (rev-channel->vct)))
- (snd-display #__line__ ";3 rev case: ~A(~A(~A)) off by ~A:~%; calc: ~A~%; chan: ~A"
- (procedure-name func2) (procedure-name func1) (procedure-name func)
- (vmaxdiff data (rev-channel->vct)) data (rev-channel->vct))))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen))
-
- (if all-args
- (begin
- ;; 4 case
- (for-each
- (lambda (func check)
- (for-each
- (lambda (func1 check1)
- (for-each
- (lambda (func2 check2)
- (for-each
- (lambda (func3 check3)
- (revert-sound)
- (set-to-1)
- (cset-to-1 data)
- (func)
- (check data)
- (func1)
- (check1 data)
- (func2)
- (check2 data)
- (func3)
- (check3 data)
- (if (not (vvequal data (channel->vct)))
- (snd-display #__line__ ";4 case: ~A(~A(~A(~A))): ~A"
- (procedure-name func3) (procedure-name func2) (procedure-name func1) (procedure-name func)
- (channel->vct)))
- (if (not (vvequal data (rev-channel->vct)))
- (snd-display #__line__ ";4 rev case: ~A(~A(~A(~A))): ~A"
- (procedure-name func3) (procedure-name func2) (procedure-name func1) (procedure-name func)
- (rev-channel->vct))))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen))
-
- ;; 5 case
- (for-each
- (lambda (func check)
- (for-each
- (lambda (func1 check1)
- (for-each
- (lambda (func2 check2)
- (for-each
- (lambda (func3 check3)
- (for-each
- (lambda (func4 check4)
- (revert-sound)
- (set-to-1)
- (cset-to-1 data)
- (func)
- (check data)
- (func1)
- (check1 data)
- (func2)
- (check2 data)
- (func3)
- (check3 data)
- (func4)
- (check4 data)
- (if (not (vvequal data (channel->vct)))
- (snd-display #__line__ ";5 case: ~A(~A(~A(~A(~A)))): ~A"
- (procedure-name func4) (procedure-name func3) (procedure-name func2)
- (procedure-name func1) (procedure-name func)
- (channel->vct))))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1))
-
- ;; 6 case
- (for-each
- (lambda (func check)
- (for-each
- (lambda (func1 check1)
- (for-each
- (lambda (func2 check2)
- (for-each
- (lambda (func3 check3)
- (for-each
- (lambda (func4 check4)
- (for-each
- (lambda (func5 check5)
- (revert-sound)
- (set-to-1)
- (cset-to-1 data)
- (func)
- (check data)
- (func1)
- (check1 data)
- (func2)
- (check2 data)
- (func3)
- (check3 data)
- (func4)
- (check4 data)
- (func5)
- (check5 data)
- (if (not (vvequal data (channel->vct)))
- (snd-display #__line__ ";6 case: ~A(~A(~A(~A(~A(~A))))): ~A"
- (procedure-name func5) (procedure-name func4) (procedure-name func3)
- (procedure-name func2) (procedure-name func1) (procedure-name func)
- (channel->vct))))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1 xen)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1 cxen)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air ptree ptreec ptreec1)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air cptree cptreec cptreec1)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air)))
- (list scale-by-two ramp-to-1 xramp-to-1 scale-by-half scale-mid on-air)
- (list cscale-by-two cramp-to-1 cxramp-to-1 cscale-by-half cscale-mid con-air))
- ))
- (close-sound ind))
-
- (set! (optimization) old-opt-val)
-
- (let ((ind (open-sound "oboe.snd")))
- (if (not (= (redo 1 ind 0) 0)) (snd-display #__line__ ";open redo with no ops: ~A" (redo)))
- (if (not (= (undo 1 ind 0) 0)) (snd-display #__line__ ";open undo with no ops: ~A" (undo)))
- (set! (cursor) 1000)
- (delete-sample 321)
- (if (not (= (cursor) 999)) (snd-display #__line__ ";delete-sample before cursor: ~A" (cursor)))
- (if (not (= (cursor ind 0 0) 1000)) (snd-display #__line__ ";delete-sample before cursor (0): ~A" (cursor ind 0 0)))
- (undo)
- (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-sample after cursor undo: ~A" (cursor)))
- (undo -1)
- (if (not (= (cursor) 999)) (snd-display #__line__ ";delete-sample before cursor redo: ~A" (cursor)))
- (redo -1)
- (delete-sample 1321)
- (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-sample after cursor: ~A" (cursor)))
- (undo)
- (delete-samples 0 100)
- (if (not (= (cursor) 900)) (snd-display #__line__ ";delete-samples before cursor: ~A" (cursor)))
- (undo)
- (delete-samples 1100 100)
- (if (not (= (cursor) 1000)) (snd-display #__line__ ";delete-samples after cursor: ~A" (cursor)))
- (undo)
- (insert-samples 100 100 (make-vct 100))
- (if (not (= (cursor) 1100)) (snd-display #__line__ ";insert-samples before cursor: ~A" (cursor)))
- (undo)
- (insert-samples 1100 100 (make-vct 100))
- (if (not (= (cursor) 1000)) (snd-display #__line__ ";insert-samples after cursor: ~A" (cursor)))
- (undo)
- (set! (samples 0 100) (make-vct 100))
- (if (not (= (cursor) 1000)) (snd-display #__line__ ";set-samples cursor: ~A" (cursor)))
- (set! (show-axes ind 0) show-x-axis-unlabelled)
- (update-time-graph)
- (set! (show-axes ind 0) show-all-axes-unlabelled)
- (update-time-graph)
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd" :size 100)))
- (vct->channel (make-vct 3 1.0) 10 8)
- (if (fneq (maxamp ind 0) 1.0)
- (snd-display #__line__ ";vct->channel size mismatch maxamp: ~A" (maxamp ind 0)))
- (if (not (vequal (channel->vct 0 20 ind 0)
- (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (snd-display #__line__ ";vct->channel size mismatch: ~A" (channel->vct 0 20 ind 0)))
- (revert-sound ind)
- (set! (samples 10 5) (make-vct 3 1.0))
- (if (fneq (maxamp ind 0) 1.0)
- (snd-display #__line__ ";set samples size mismatch maxamp: ~A" (maxamp ind 0)))
- (if (not (vequal (channel->vct 0 20 ind 0)
- (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (snd-display #__line__ ";set samples size mismatch: ~A" (channel->vct 0 20 ind 0)))
- (revert-sound ind)
- (insert-samples 10 8 (make-vct 3 1.0) ind 0)
- (if (fneq (maxamp ind 0) 1.0)
- (snd-display #__line__ ";insert samples size mismatch maxamp: ~A" (maxamp ind 0)))
- (if (not (vequal (channel->vct 0 20 ind 0)
- (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (snd-display #__line__ ";insert samples size mismatch: ~A" (channel->vct 0 20 ind 0)))
- (close-sound ind))
-
- (let* ((index (open-sound "oboe.snd"))
- (bnds (x-bounds index))
- (xp (x-position-slider))
- (yp (y-position-slider))
- (xz (x-zoom-slider))
- (yz (y-zoom-slider)))
- (if (not (string=? (snd-completion " open-so") " open-sound"))
- (snd-display #__line__ ";completion: ~A" (snd-completion " open-so")))
- ; (if (not (string=? (snd-completion " open-sound") " open-sound"))
- ; (snd-display #__line__ ";completion: ~A" (snd-completion " open-so")))
- (if (not (string=? (snd-completion " zoom-focus-r") " zoom-focus-right"))
- (snd-display #__line__ ";completion: ~A" (snd-completion " zoom-focus-r")))
- (play "oboe.snd" :wait #t)
- (play "oboe.snd" :start 12000 :wait #t)
- (play "oboe.snd" :start 12000 :end 15000 :wait #t)
- (play :edit-position (- (edit-position) 1) :wait #t)
- (let ((old-speed (speed-control index))
- (old-style (speed-control-style))
- (old-open (show-controls index)))
- (set! (show-controls index) #t)
- (set! (speed-control index) -2.0)
- (play index :start 12345 :wait #t)
- (set! (speed-control-style) speed-control-as-semitone)
- (set! (speed-control index) 0.5)
- (set! (speed-control-style) speed-control-as-ratio)
- (set! (speed-control index) 0.25)
- (set! (speed-control index) old-speed)
- (set! (speed-control-style) old-style)
- (set! (show-controls index) old-open))
- (bomb index #t)
- (let ((k (disk-kspace "oboe.snd")))
- (if (or (not (number? k))
- (<= k 0))
- (snd-display #__line__ ";disk-kspace = ~A" (disk-kspace "oboe.snd")))
- (set! k (disk-kspace "/baddy/hiho"))
- (if (not (= k -1))
- (snd-display #__line__ ";disk-kspace of bogus file = ~A" (disk-kspace "/baddy/hiho"))))
- (if (not (= (transform-frames) 0)) (snd-display #__line__ ";transform-frames ~A?" (transform-frames)))
- (set! (transform-size) 512)
-
- (set! (transform-graph?) #t)
- (let ((pk (fft-peak index 0 1.0)))
- (if (not pk) (snd-display #__line__ ";fft-peak? ")))
- (set! (time-graph?) #t)
-
- (if with-gui
- (catch #t
- (lambda ()
- (if (not (string=? (x-axis-label) "time"))
- (snd-display #__line__ ";def time x-axis-label: ~A" (x-axis-label)))
- (set! (x-axis-label index 0 time-graph) "no time")
- (if (not (string=? (x-axis-label) "no time"))
- (snd-display #__line__ ";time x-axis-label: ~A" (x-axis-label index 0 time-graph)))
-
- (update-transform-graph)
- (if (not (string=? (x-axis-label index 0 transform-graph) "frequency"))
- (snd-display #__line__ ";get fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
- (set! (x-axis-label index 0 transform-graph) "hiho")
- (update-transform-graph)
- (if (not (string=? (x-axis-label index 0 transform-graph) "hiho"))
- (snd-display #__line__ ";set set fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
- (set! (x-axis-label index 0 transform-graph) "frequency") ; for later test
-
- (graph '(0 0 1 1 2 0) "lisp")
- (update-lisp-graph)
- (if (not (string=? (x-axis-label index 0 lisp-graph) "lisp"))
- (snd-display #__line__ ";def lisp x-axis-label: ~A" (x-axis-label index 0 lisp-graph)))
- (set! (x-axis-label index 0 lisp-graph) "no lisp")
- (if (not (string=? (x-axis-label index 0 lisp-graph) "no lisp"))
- (snd-display #__line__ ";lisp x-axis-label: ~A" (x-axis-label index 0 lisp-graph)))
-
- (set! (y-axis-label index 0 time-graph) "no amp")
- (if (not (string=? (y-axis-label) "no amp"))
- (snd-display #__line__ ";time y-axis-label: ~A" (y-axis-label index 0 time-graph)))
- (set! (y-axis-label index 0 lisp-graph) "no lamp")
- (if (not (string=? (y-axis-label index 0 lisp-graph) "no lamp"))
- (snd-display #__line__ ";lisp y-axis-label: ~A" (y-axis-label index 0 lisp-graph)))
- (set! (y-axis-label) #f)
- (set! (y-axis-label index 0) "no amp")
- (if (not (string=? (y-axis-label) "no amp"))
- (snd-display #__line__ ";time y-axis-label (time): ~A" (y-axis-label index 0 time-graph)))
- (set! (y-axis-label index) #f))
- (lambda args (snd-display #__line__ ";axis label error: ~A" args))))
-
- (if with-gui
- (begin
- (let ((cr (make-cairo (car (channel-widgets index 0)))))
- (graph-data (make-vct 4) index 0 copy-context #f #f graph-lines cr)
- (free-cairo cr)
- (update-lisp-graph))
- (graph (vct 0 0 1 1 2 0))
- (do ((i 0 (+ 1 i)))
- ((= i 32))
- (graph (vct 0 1 2))
- (graph (list (vct 0 1 2) (vct 3 2 1) (vct 1 2 3)))
- (graph (list (vct 0 1 2) (vct 3 2 1))))
- (set! (x-bounds) (list 0.0 0.01))
- (let ((data (make-graph-data)))
- (if (vct? data)
- (let ((mid (round (* .5 (vct-length data)))))
- (if (not (= (vct-length data) (+ 1 (- (right-sample) (left-sample)))))
- (snd-display #__line__ ";make-graph-data bounds: ~A ~A -> ~A" (left-sample) (right-sample) (vct-length data)))
- (if (fneq (vct-ref data mid)
- (sample (+ (left-sample) mid)))
- (snd-display #__line__ ";make-graph-data[~D]: ~A ~A" mid (vct-ref data mid) (sample (+ (left-sample) mid)))))))
- (let ((data (make-graph-data index 0 0 100 199)))
- (if (vct? data)
- (begin
- (if (not (= (vct-length data) 100))
- (snd-display #__line__ ";make-graph-data 100:199: ~A" (vct-length data)))
- (if (fneq (vct-ref data 50) (sample 50))
- (snd-display #__line__ ";make-graph-data 50: ~A ~A" (vct-ref data 50) (sample 50))))))
- (set! (x-bounds) (list 0.0 0.1))
- (update-transform-graph)
- (catch 'no-such-axis
- (lambda ()
- (if (not (string=? (x-axis-label index 0 transform-graph) "frequency"))
- (snd-display #__line__ ";def fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
- (set! (x-axis-label index 0 transform-graph) "fourier")
- (if (not (string=? (x-axis-label index 0 transform-graph) "fourier"))
- (snd-display #__line__ ";fft x-axis-label: ~A" (x-axis-label index 0 transform-graph)))
- (set! (x-axis-label) "hiho")
-
- (set! (y-axis-label index 0 transform-graph) "spectra")
- (let ((val (y-axis-label index 0 transform-graph)))
- (if (or (not (string? val))
- (not (string=? val "spectra")))
- (snd-display #__line__ ";fft y-axis-label: ~A" val)))
- (set! (y-axis-label) "hiho"))
- (lambda args (snd-display #__line__ ";transform axis not displayed?")))
- ))
-
- (if (and (number? (transform-frames))
- (= (transform-frames) 0))
- (snd-display #__line__ ";transform-graph? transform-frames ~A?" (transform-frames)))
- (update-transform-graph)
- (let ((tag (catch #t (lambda () (peaks "/baddy/hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'cant-open-file)) (snd-display #__line__ ";peaks bad file: ~A" tag)))
- (peaks "tmp.peaks")
- (let ((p (open-input-file "tmp.peaks")))
- (if (not p)
- (snd-display #__line__ ";peaks->tmp.peaks failed?")
- (let ((line (read-line p)))
- (if (or (not (string? line))
- (not (string=? "Snd: fft peaks" (substring line 0 14))))
- (snd-display #__line__ ";peaks 1: ~A?" line))
- (set! line (read-line p))
- (set! line (read-line p))
- (if (or (not (string? line))
- (and (not (string=? "oboe.snd, fft 512 points beginning at sample 0 (0.000 secs), Blackman2" line))
- (not (string=? (string-append "oboe.snd, fft 512 points beginning at sample 0 (0.000 secs), Blackman2" (string #\newline)) line))))
- (snd-display #__line__ ";peaks 2: ~A?" line))
- (set! line (read-line p))
- (set! line (read-line p))
- (close-input-port p))))
- (delete-file "tmp.peaks")
- (peaks)
- (if (and (provided? 'xm)
- (or (not (list-ref (dialog-widgets) 20))
- (not (XtIsManaged (list-ref (dialog-widgets) 20)))))
- (snd-display #__line__ ";peaks but no help?"))
- (dismiss-all-dialogs)
- (let* ((num-transforms 6)
- (num-transform-graph-types 3))
- (set! (transform-graph? index 0) #t)
- (set! (transform-size index 0) 64)
- (do ((i 0 (+ 1 i)))
- ((= i num-transforms))
- (set! (transform-type) (integer->transform i))
- (if (not (transform? (integer->transform i))) (snd-display #__line__ ";transform? ~A?" i))
- (do ((j 0 (+ 1 j)))
- ((= j num-transform-graph-types))
- (set! (transform-graph-type index 0) j)
- (update-transform-graph index 0))))
- (set! (transform-type) fourier-transform)
- (if (not (transform? (transform-type))) (snd-display #__line__ ";transform? ~A ~A?" (transform-type) fourier-transform))
- (if (not (transform? autocorrelation)) (snd-display #__line__ ";transform? autocorrelation"))
-
- (if (read-only index) (snd-display #__line__ ";read-only open-sound: ~A?" (read-only index)))
- (set! (read-only index) #t)
- (if (not (read-only index)) (snd-display #__line__ ";set-read-only: ~A?" (read-only index)))
- (bind-key #\a 0 (lambda () (set! a-ctr 3)))
- (key (char->integer #\a) 0)
- (if (not (= a-ctr 3)) (snd-display #__line__ ";bind-key: ~A?" a-ctr))
- (let ((str (with-output-to-string (lambda () (display (procedure-source (key-binding (char->integer #\a) 0)))))))
- (if (not (string=? str "(lambda () (set! a-ctr 3))"))
- (snd-display #__line__ ";key-binding: ~A?" str)))
- (unbind-key (char->integer #\a) 0)
- (set! a-ctr 0)
- (key (char->integer #\a) 0)
- (do ((i 0 (+ 1 i)))
- ((= i 5))
- (let ((psf (eps-file)))
- (if (and psf (string? psf))
- (begin
- (if (file-exists? psf) (delete-file psf))
- (set! (graph-style) i)
- (graph->ps)
- (if (not (file-exists? psf))
- (snd-display #__line__ ";graph->ps: ~A?" psf)
- (delete-file psf))))))
- (let ((err (catch 'cannot-print
- (lambda ()
- (graph->ps "/bad/bad.eps"))
- (lambda args 12345))))
- (if (not (= err 12345)) (snd-display #__line__ ";graph->ps err: ~A?" err)))
- (let ((n2 (or (open-sound "2.snd") (open-sound "4.aiff"))))
- (set! (transform-graph? n2) #t)
- (set! (channel-style n2) channels-superimposed)
- (if (not (= (channel-style n2) channels-superimposed)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-superimposed (channel-style n2)))
- (graph->ps "aaa.eps")
- (set! (channel-style n2) channels-combined)
- (if (not (= (channel-style n2) channels-combined)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-combined (channel-style n2)))
- (graph->ps "aaa.eps")
- (set! (channel-style n2) channels-separate)
- (if (not (= (channel-style n2) channels-separate)) (snd-display #__line__ ";channel-style->~D: ~A?" channels-separate (channel-style n2)))
- (graph->ps "aaa.eps")
- (close-sound n2))
- (if (= (channels index) 1)
- (begin
- (set! (channel-style index) channels-superimposed)
- (if (not (= (channel-style index) channels-separate)) (snd-display #__line__ ";channel-style[0]->~D: ~A?" channels-separate (channel-style index)))))
- (set! (sync index) 32)
- (if (not (= (sync index) 32)) (snd-display #__line__ ";sync->32: ~A?" (sync index)))
- (if (not (>= (sync-max) 32)) (snd-display #__line__ ";sync-max 32: ~A" (sync-max)))
- (set! (sync index) 0)
- (set! (channel-sync index 0) 12)
- (if (not (= (channel-sync index 0) 12)) (snd-display #__line__ ";sync-chn->12: ~A?" (channel-sync index 0)))
- (set! (channel-sync index 0) 0)
- (if (not (= a-ctr 0)) (snd-display #__line__ ";unbind-key: ~A?" a-ctr))
- (if (fneq xp 0.0) (snd-display #__line__ ";x-position-slider: ~A?" xp))
- (if (fneq yp 0.0) (snd-display #__line__ ";y-position-slider: ~A?" yp))
- (if (and (fneq xz 0.04338) (fneq xz 1.0)) (snd-display #__line__ ";x-zoom-slider: ~A?" xz))
- (if (fneq yz 1.0) (snd-display #__line__ ";y-zoom-slider: ~A?" yz))
- (if (and (or (fneq (car bnds) 0.0) (fneq (cadr bnds) 0.1))
- (or (fneq (car bnds) 0.0) (fneq (cadr bnds) 2.305))) ; open-hook from ~/.snd*
- (snd-display #__line__ ";x-bounds: ~A?" bnds))
- (if (not (equal? (find-sound "oboe.snd") index)) (snd-display #__line__ ";oboe: index ~D is not ~D?" (find-sound "oboe.snd") index))
- (if (not (sound? index)) (snd-display #__line__ ";oboe: ~D not ok?" index))
- (if (not (= (chans index) 1)) (snd-display #__line__ ";oboe: chans ~D?" (chans index)))
- (if (not (= (channels index) 1)) (snd-display #__line__ ";oboe: channels ~D?" (channels index)))
- (if (not (= (frames index) 50828)) (snd-display #__line__ ";oboe: frames ~D?" (frames index)))
- (if (not (= (srate index) 22050)) (snd-display #__line__ ";oboe: srate ~D?" (srate index)))
- (if (not (= (data-location index) 28)) (snd-display #__line__ ";oboe: location ~D?" (data-location index)))
- (if (not (= (data-size index) (* 50828 2))) (snd-display #__line__ ";oboe: size ~D?" (data-size index)))
- (if (not (= (data-format index) mus-bshort)) (snd-display #__line__ ";oboe: format ~A?" (data-format index)))
- (if (fneq (maxamp index) .14724) (snd-display #__line__ ";oboe: maxamp ~F?" (maxamp index)))
- (if (not (= (maxamp-position index) 24971)) (snd-display #__line__ ";oboe: maxamp-position ~A?" (maxamp-position index)))
- (if (comment index) (snd-display #__line__ ";oboe: comment ~A?" (comment index)))
- (if (not (= (string-length "asdf") 4)) (snd-display #__line__ ";string-length: ~A?" (string-length "asdf")))
- (if (not (string=? (short-file-name index) "oboe.snd")) (snd-display #__line__ ";oboe short name: ~S?" (short-file-name index)))
- (let ((matches (count-matches (lambda (a) (> a .125)))))
- (if (not (= matches 1313)) (snd-display #__line__ ";count-matches: ~A?" matches)))
- (let ((matches (count-matches (lambda (y) (let ((a (list .1 .2))) (> y (car a))))))) ; force xen not ptree
- (if (not (= matches 2851)) (snd-display #__line__ ";unopt count-matches: ~A?" matches)))
- (let ((spot (find-channel (lambda (a) (> a .13)))))
- (if (or (not spot) (not (= spot 8862))) (snd-display #__line__ ";find: ~A?" spot)))
- (set! (right-sample) 3000)
- (let ((samp (right-sample)))
- (if (> (abs (- samp 3000)) 1) (snd-display #__line__ ";right-sample: ~A?" samp)))
- (set! (left-sample) 1000)
- (let ((samp (left-sample)))
- (if (> (abs (- samp 1000)) 1) (snd-display #__line__ ";left-sample: ~A?" samp)))
- (let ((eds (edits)))
- (if (or (not (= (car eds) 0)) (not (= (cadr eds) 0)))
- (snd-display #__line__ ";edits: ~A?" eds))
- (if (not (= (edit-position) (car eds)))
- (snd-display #__line__ ";edit-position: ~A ~A?" (edit-position) eds)))
- (play index :channel 0 :wait #t)
-
- (bomb index #f)
- (if (not (selection-creates-region)) (set! (selection-creates-region) #t))
- (select-all index 0)
- (let ((r0 (car (regions)))
- (sel (selection)))
- (if (not (selection?)) (snd-display #__line__ ";selection?"))
- (if (not (selection? sel)) (snd-display #__line__ ";selection? sel"))
- (if (not (region? r0)) (snd-display #__line__ ";region?"))
- (if (not (= (selection-chans) 1)) (snd-display #__line__ ";selection-chans(1): ~A" (selection-chans)))
- (if (not (= (channels sel) 1)) (snd-display #__line__ ";generic selection-chans(1): ~A" (channels sel)))
- (if (not (= (selection-srate) (srate index))) (snd-display #__line__ ";selection-srate: ~A ~A" (selection-srate) (srate index)))
- (if (not (= (srate sel) (srate index))) (snd-display #__line__ ";generic selection-srate: ~A ~A" (srate sel) (srate index)))
- (if (fneq (region-maxamp r0) (maxamp index)) (snd-display #__line__ ";region-maxamp (1): ~A?" (region-maxamp r0)))
- (if (not (= (region-maxamp-position r0) (maxamp-position index)))
- (snd-display #__line__ ";region-maxamp-position (1): ~A ~A?" (region-maxamp-position r0) (maxamp-position index)))
- (if (fneq (selection-maxamp index 0) (maxamp index)) (snd-display #__line__ ";selection-maxamp (1): ~A?" (selection-maxamp index 0)))
- (if (fneq (maxamp sel index 0) (maxamp index)) (snd-display #__line__ ";generic selection-maxamp (1): ~A?" (maxamp sel index 0)))
- (if (not (= (selection-maxamp-position index 0) (maxamp-position index)))
- (snd-display #__line__ ";selection-maxamp-position (1): ~A ~A?" (selection-maxamp-position index 0) (maxamp-position index)))
- (save-region r0 "temp.dat")
- (if (file-exists? "temp.dat")
- (delete-file "temp.dat")
- (snd-display #__line__ ";save-region file disappeared?"))
- (play r0 :wait #t) ;needs to be #t here or it never gets run
- (if (not (= (length (regions)) 1)) (snd-display #__line__ ";regions: ~A?" (regions)))
- (if (not (selection-member? index)) (snd-display #__line__ ";selection-member?: ~A" (selection-member? index)))
- (if (not (= (region-srate r0) 22050)) (snd-display #__line__ ";region-srate: ~A?" (region-srate r0)))
- (if (not (= (region-chans r0) 1)) (snd-display #__line__ ";region-chans: ~A?" (region-chans r0)))
- (if (not (equal? (region-home r0) (list "oboe.snd" 0 50827))) (snd-display #__line__ ";region-home: ~A" (region-home r0)))
- (if (not (= (region-frames r0) 50828)) (snd-display #__line__ ";region-frames: ~A?" (region-frames r0)))
- (if (not (= (selection-frames) 50828)) (snd-display #__line__ ";selection-frames: ~A?" (selection-frames 0)))
- (if (not (= (frames sel) 50828)) (snd-display #__line__ ";generic selection-frames: ~A?" (frames sel)))
- (if (not (= (length sel) 50828)) (snd-display #__line__ ";generic length selection-frames: ~A?" (length sel)))
- (if (not (= (selection-position) 0)) (snd-display #__line__ ";selection-position: ~A?" (selection-position)))
- (if (not (= (region-position r0 0) 0)) (snd-display #__line__ ";region-position: ~A?" (region-position r0 0)))
- (if (fneq (region-maxamp r0) (maxamp index)) (snd-display #__line__ ";region-maxamp: ~A?" (region-maxamp r0)))
- (if (fneq (selection-maxamp index 0) (maxamp index)) (snd-display #__line__ ";selection-maxamp: ~A?" (selection-maxamp index 0)))
- (let ((samps1 (channel->vct 0 50827 index 0))
- (samps2 (region->vct r0 0 50828 0))
- (vr (make-sampler 0 index 0 1)))
- (if (not (sampler? vr)) (snd-display #__line__ ";~A not sampler?" vr))
- (if (not (= (sampler-position vr) 0)) (snd-display #__line__ ";initial sampler-position: ~A" (sampler-position vr)))
- (if (not (equal? (sampler-home vr) (list index 0)))
- (snd-display #__line__ ";sampler-home: ~A ~A?" (sampler-home vr) (list index 0)))
- (if (sampler-at-end? vr) (snd-display #__line__ ";~A init at end?" vr))
- (let ((err (catch #t
- (lambda ()
- (region->vct r0 -1 1233))
- (lambda args (car args)))))
- (if (not (eq? err 'no-such-sample)) (snd-display #__line__ ";region->vct -1: ~A" err)))
- (let ((err (catch #t
- (lambda ()
- (region->vct r0 12345678 1))
- (lambda args (car args)))))
- ;; should this return 'no-such-sample?
- (if err (snd-display #__line__ ";region->vct 12345678: ~A" err)))
- (let ((reader-string (format #f "~A" vr)))
- (if (not (string=? reader-string "#<sampler: oboe.snd[0: 0] from 0, at 0, forward>"))
- (snd-display #__line__ ";sampler actually got: [~S]" reader-string)))
- (let ((evr vr))
- (if (not (equal? evr vr)) (snd-display #__line__ ";sampler equal? ~A ~A" vr evr)))
- (catch 'break
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 50827))
- (if (not (= (if (odd? i) (next-sample vr) (read-sample vr)) (vct-ref samps1 i) (vct-ref samps2 i)))
- (begin
- (snd-display #__line__ ";readers disagree at ~D" i)
- (throw 'break)))))
- (lambda args (car args)))
- (free-sampler vr)))
- (let ((var (catch #t (lambda () (make-sampler 0 index -1)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-channel))
- (snd-display #__line__ ";make-sampler bad chan (-1): ~A" var)))
- (let ((var (catch #t (lambda () (make-sampler 0 index 1)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-channel))
- (snd-display #__line__ ";make-sampler bad chan (1): ~A, ~A" var index)))
- (let ((fd (make-sampler 0)))
- (if (mix-sampler? fd) (snd-display #__line__ ";sampler: mix ~A" fd))
- (if (region-sampler? fd) (snd-display #__line__ ";sampler: region ~A" fd))
- (if (not (sampler? fd)) (snd-display #__line__ ";sampler: normal ~A" fd))
- (if (not (= (sampler-position fd) 0)) (snd-display #__line__ ";sampler: position: ~A" fd))
- (free-sampler fd)
- (let ((str (format #f "~A" fd)))
- (if (not (string=? (my-substring str (- (string-length str) 16)) "at eof or freed>"))
- (snd-display #__line__ ";freed sampler: ~A [~A]?" str (my-substring str (- (string-length str) 16))))))
- (let* ((reg (car (regions)))
- (chns (region-chans reg))
- (var (catch #t (lambda () (make-region-sampler reg 0 (+ chns 1))) (lambda args args))))
- (if (not (eq? (car var) 'no-such-channel))
- (snd-display #__line__ ";make-region-sampler bad chan (2): ~A ~A" var (regions)))
- (let ((tag (catch #t (lambda () (make-region-sampler reg 0 0 -2)) (lambda args args))))
- (if (not (eq? (car tag) 'no-such-direction))
- (snd-display #__line__ ";make-region-sampler bad dir (-2): ~A" tag))))
-
- (revert-sound index)
- (insert-sample 100 .5 index)
- (let ((var (catch #t (lambda () (insert-sound "oboe.snd" 0 1)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-channel))
- (snd-display #__line__ ";insert-sound bad chan (1): ~A" var)))
- (let ((var (catch #t (lambda () (insert-sample -12 1.0)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-sample))
- (snd-display #__line__ ";insert-sample bad pos: ~A" var)))
- (set! (show-axes index 0) show-no-axes)
- (update-transform-graph index)
- (update-time-graph index)
- (if (or (fneq (sample 100) .5)
- (not (= (frames index) 50829)))
- (snd-display #__line__ ";insert-sample: ~A ~A?" (sample 100) (frames index)))
- (let ((v0 (make-vector 3))
- (v1 (make-vct 3)))
- (vct-fill! v1 .75)
- (do ((i 0 (+ 1 i))) ((= i 3)) (vector-set! v0 i .25))
- (insert-samples 200 3 v0 index)
- (insert-samples 300 3 v1 index)
- (if (or (fneq (sample 201) .25)
- (fneq (sample 301) .75)
- (not (= (frames index) 50835)))
- (snd-display #__line__ ";insert-samples: ~A ~A ~A?" (sample 201) (sample 301) (frames index))))
- (save-sound-as "hiho.snd" index mus-next mus-bshort :srate 22050)
- (let ((nindex (view-sound "hiho.snd")))
- (if (fneq (sample 101 nindex) (sample 101 index))
- (snd-display #__line__ ";save-sound-as: ~A ~A?" (sample 101 nindex) (sample 101 index)))
- (if (not (read-only nindex)) (snd-display #__line__ ";read-only view-sound: ~A?" (read-only nindex)))
-
- (set! (speed-control-style nindex) speed-control-as-semitone)
- (if (not (= (speed-control-style nindex) speed-control-as-semitone))
- (snd-display #__line__ ";speed-control-style set semi: ~A" (speed-control-style nindex)))
- (set! (speed-control-tones nindex) -8)
- (if (not (= (speed-control-tones nindex) 12))
- (snd-display #__line__ ";speed-control-tones -8: ~A" (speed-control-tones nindex)))
- (set! (speed-control-tones nindex) 18)
- (if (not (= (speed-control-tones nindex) 18))
- (snd-display #__line__ ";speed-control-tones 18: ~A" (speed-control-tones nindex)))
- (graph->ps "aaa.eps")
- (close-sound nindex))
- (revert-sound index)
- (set! (sample 50 index) .5)
- (if (fneq (sample 50) .5) (snd-display #__line__ ";set-sample: ~A?" (sample 50)))
- (let ((v0 (make-vector 3)))
- (do ((i 0 (+ 1 i))) ((= i 3)) (vector-set! v0 i .25))
- (set! (samples 60 3 index) v0)
- (if (or (fneq (sample 60) .25) (fneq (sample 61) .25))
- (snd-display #__line__ ";set-samples: ~A ~A ~A?" (sample 60) (sample 61) (sample 62))))
- (set! (samples 10 3 index) (list 0.1 0.2 0.3))
- (if (not (vequal (channel->vct 10 3 index) (vct 0.1 0.2 0.3)))
- (snd-display #__line__ ";set-samples via list: ~A" (channel->vct 10 3 index)))
- (revert-sound index)
- (save-sound-as "temporary.snd" index)
- (set! (samples 100000 20000 index) "temporary.snd")
- (if (not (vequal (channel->vct 110000 10) (channel->vct 10000 10)))
- (snd-display #__line__ ";set samples to self: ~A ~A" (channel->vct 110000 10) (channel->vct 10000 10)))
- (revert-sound index)
- (delete-sample 100 index)
- (if (not (file-exists? "temporary.snd"))
- (snd-display #__line__ ";set-samples temp deleted?"))
- (delete-file "temporary.snd")
- (if (not (= (frames index) 50827)) (snd-display #__line__ ";delete-sample: ~A?" (frames index)))
- (delete-samples 0 100 index)
- (if (not (= (frames index) 50727)) (snd-display #__line__ ";delete-samples: ~A?" (frames index)))
- (revert-sound index)
- (let ((maxa (maxamp index)))
- (scale-to .5 index)
- (let ((newmaxa (maxamp index)))
- (if (fneq newmaxa .5) (snd-display #__line__ ";scale-to: ~A?" newmaxa))
- (undo 1 index)
- (scale-by 2.0 index)
- (set! newmaxa (maxamp index))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";scale-by: ~A?" newmaxa))
- (revert-sound index)
- (scale-by -1 index)
- (mix "oboe.snd")
- (if (fneq (maxamp index 0) 0.0) (snd-display #__line__ ";invert+mix->~A" (maxamp)))
- (revert-sound index)
- (select-all index)
- (if (not (= (length (regions)) 2)) (snd-display #__line__ ";regions(2): ~A?" (regions)))
- (scale-selection-to .5)
- (set! newmaxa (maxamp index))
- (if (fneq newmaxa .5) (snd-display #__line__ ";scale-selection-to: ~A?" newmaxa))
- (revert-sound index)
- (select-all index)
- (scale-selection-by 2.0)
- (set! newmaxa (maxamp index))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";scale-selection-by: ~A?" newmaxa))
- (revert-sound index)
- (with-temporary-selection (lambda () (scale-selection-by 2.0)) 0 (frames) index 0)
- (set! newmaxa (maxamp index))
- (if (fneq newmaxa (* 2.0 maxa)) (snd-display #__line__ ";with-temporary-selection: ~A?" newmaxa))
- (revert-sound index)
- (let ((samp999 (sample 999 index 0))
- (samp1001 (sample 1001 index 0)))
- (with-temporary-selection (lambda () (scale-selection-to 2.0)) 1000 1 index 0)
- (if (fneq (sample 1000 index 0) 2.0) (snd-display #__line__ ";with-temporary-selection 1000: ~A" (sample 1000 index 0)))
- (if (fneq (sample 999 index 0) samp999) (snd-display #__line__ ";with-temporary-selection 999: ~A from ~A" (sample 999 index 0) samp999))
- (if (fneq (sample 1001 index 0) samp1001) (snd-display #__line__ ";with-temporary-selection 1001: ~A from ~A" (sample 1001 index 0) samp1001)))
- (revert-sound index)
- (make-selection 100 199 index 0)
- (let ((old-start (selection-position index 0))
- (old-len (selection-frames index 0)))
- (with-temporary-selection (lambda () (scale-selection-to 2.0)) 1000 1 index 0)
- (if (not (selection?)) (snd-display #__line__ ";with-temporary-selection restore?"))
- (if (not (selection-member? index 0)) (snd-display #__line__ ";with-temporary-selection not member?"))
- (if (not (= (selection-position index 0) old-start)) (snd-display #__line__ ";with-temporary-selection start: ~A" (selection-position index 0)))
- (if (not (= (selection-frames index 0) old-len)) (snd-display #__line__ ";with-temporary-selection len: ~A" (selection-frames index 0))))
- (unselect-all)
- (if (selection-member? index 0) (snd-display #__line__ ";unselect all ~D 0?" index))
- (revert-sound index)
- (select-all index)
- (let ((rread (make-region-sampler (car (regions)) 0))
- (sread (make-sampler 0 index))
- (rvect (region->vct (car (regions)) 0 100))
- (svect (samples 0 100 index)))
- (if (fneq (vct-ref rvect 1) (region-sample (car (regions)) 1))
- (snd-display #__line__ ";region-sample: ~A ~A?" (region-sample (car (regions)) 1) (vct-ref rvect 1)))
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (let ((rval (next-sample rread))
- (sval (next-sample sread)))
- (if (fneq rval sval) (snd-display #__line__ ";sample-read: ~A ~A?" rval sval))
- (if (fneq rval (vct-ref rvect i)) (snd-display #__line__ ";region-samples: ~A ~A?" rval (vct-ref rvect i)))
- (if (fneq sval (vct-ref svect i)) (snd-display #__line__ ";samples: ~A ~A?" sval (vct-ref svect i)))))
- (free-sampler rread)
- (let ((val0 (next-sample sread)))
- (if (sampler-at-end? sread) (snd-display #__line__ ";premature end?"))
- (previous-sample sread)
- (let ((val1 (previous-sample sread)))
- (if (fneq val0 val1) (snd-display #__line__ ";previous-sample: ~A ~A?" val0 val1))))
- (free-sampler sread))))
- (revert-sound index)
- (let ((s100 (sample 100))
- (s40 (sample 40))
- (len (frames))
- (addlen (mus-sound-frames "fyow.snd")))
- (set! (cursor-style) cursor-line)
- (set! (cursor-size) 25)
- (set! (cursor index) 50)
- (if (not (= (cursor-style) cursor-line))
- (snd-display #__line__ ";cursor-style: ~A? " (cursor-style)))
- (if (not (= (cursor-size) 25))
- (snd-display #__line__ ";cursor-size: ~A? " (cursor-size)))
- (set! (cursor-style) cursor-cross)
- (set! (cursor-size) 15)
- (set! (cursor index 0) 30)
- (set! (cursor-style) cursor-line)
- (set! (cursor index 0) 20)
- (if with-gui
- (begin
- (set! (cursor-style index 0)
- (lambda (snd chn ax)
- (let* ((point (cursor-position))
- (x (car point))
- (y (cadr point))
- (size (floor (/ (cursor-size) 2)))
- (cr (make-cairo (car (channel-widgets snd chn)))))
- (draw-line (- x size) (- y size) (+ x size) (+ y size) snd chn cursor-context cr)
- (draw-line (- x size) (+ y size) (+ x size) (- y size) snd chn cursor-context cr)
- (free-cairo cr))))
- (if (not (procedure? (cursor-style index 0))) (snd-display #__line__ ";set cursor-style to proc: ~A" (cursor-style index 0)))))
- (set! (cursor index) 50)
- (insert-sound "fyow.snd" (cursor) 0 index 0)
- (if (or (fneq (sample 40) s40) (not (fneq (sample 100) s100)) (fneq (sample 100) 0.001831))
- (snd-display #__line__ ";insert-sound: ~A?" (sample 100)))
- (if (not (= (frames) (+ len addlen))) (snd-display #__line__ ";insert-sound len: ~A?" (frames)))
- (save-sound-as "not-temporary.snd")
- (insert-samples 0 100 "not-temporary.snd")
- (set! (cursor index 0 0) (- (frames index 0 0) 2))
- (revert-sound)
- (if (not (= (cursor index 0) (- (frames index 0) 2)))
- (snd-display #__line__ ";set edpos cursor: ~A ~A ~A" (cursor) (cursor index 0 0) (- (frames index 0 0) 2)))
- (if (not (file-exists? "not-temporary.snd"))
- (snd-display #__line__ ";insert-samples deleted its file?")
- (delete-file "not-temporary.snd"))
- (let ((id (make-region 0 99)))
- (insert-region id 60 index)
- (if (not (= (frames) (+ len 100))) (snd-display #__line__ ";insert-region len: ~A?" (frames)))
- (if (fneq (sample 100) s40) (snd-display #__line__ ";insert-region: ~A ~A?" (sample 100) s40))
- (let ((var (catch #t (lambda () (insert-region (integer->region (+ 1000 (apply max (map region->integer (regions))))) 0)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-region))
- (snd-display #__line__ ";insert-region bad id: ~A" var)))
- (save-region id "fmv.snd")
- (if (not (= (mus-sound-header-type "fmv.snd") mus-next))
- (snd-display #__line__ ";save-region header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-out-format))
- (snd-display #__line__ ";save-region format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
- (if (not (= (mus-sound-srate "fmv.snd") (region-srate id)))
- (snd-display #__line__ ";save-region srate: ~A (~A)" (mus-sound-srate "fmv.snd") (region-srate id)))
- (if (not (= (mus-sound-chans "fmv.snd") (region-chans id)))
- (snd-display #__line__ ";save-region chans: ~A (~A)" (mus-sound-chans "fmv.snd") (region-chans id)))
- (if (not (= (mus-sound-frames "fmv.snd") (region-frames id)))
- (snd-display #__line__ ";save-region length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
- (if (not (= (region-position id 0) 0))
- (snd-display #__line__ ";save-region position: ~A" (region-position id 0)))
- (delete-file "fmv.snd")
- (save-region id "fmv.snd" mus-riff mus-lshort "this is a comment")
- (if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display #__line__ ";save-region riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-lshort))
- (snd-display #__line__ ";save-region lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
- (if (not (= (mus-sound-frames "fmv.snd") (region-frames id)))
- (snd-display #__line__ ";save-region length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
- (if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display #__line__ ";save-region comment: ~A" (mus-sound-comment "fmv.snd")))
- (delete-file "fmv.snd")
- (save-region id :file "fmv.snd" :header-type mus-riff :data-format mus-lshort :comment "this is a comment")
- (if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display #__line__ ";save-region opt riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-lshort))
- (snd-display #__line__ ";save-region opt lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
- (if (not (= (mus-sound-frames "fmv.snd") (region-frames id)))
- (snd-display #__line__ ";save-region opt length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
- (if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display #__line__ ";save-region opt comment: ~A" (mus-sound-comment "fmv.snd")))
- (delete-file "fmv.snd")
- (save-region id :comment "this is a comment" :file "fmv.snd" :data-format mus-lshort :header-type mus-riff)
- (if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display #__line__ ";save-region opt1 riff header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-lshort))
- (snd-display #__line__ ";save-region opt1 lshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
- (if (not (= (mus-sound-frames "fmv.snd") (region-frames id)))
- (snd-display #__line__ ";save-region opt1 length: ~A (~A)" (mus-sound-frames "fmv.snd") (region-frames id)))
- (if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display #__line__ ";save-region opt1 comment: ~A" (mus-sound-comment "fmv.snd")))
- (delete-file "fmv.snd")
- (save-region id "fmv.snd" :data-format mus-bshort)
- (if (not (= (mus-sound-header-type "fmv.snd") mus-next))
- (snd-display #__line__ ";save-region opt2 next header: ~A?" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-bshort))
- (snd-display #__line__ ";save-region opt2 bshort format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
- (delete-file "fmv.snd")
- ))
- (close-sound index)
- (let ((var (catch #t (lambda () (new-sound "hi.snd" 0 1 100 0)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";new-sound bad chan: ~A" var)))
- (set! index (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "unequal lens"))
- (insert-silence 0 1000 index 1)
- (if (or (not (= (frames index 0) 1))
- (not (= (frames index 1) 1001)))
- (snd-display #__line__ ";silence 1: ~A ~A" (frames index 0) (frames index 1)))
- (save-sound index)
- (if (or (not (= (frames index 0) 1001))
- (not (= (frames index 1) 1001)))
- (snd-display #__line__ ";saved silence 1: ~A ~A" (frames index 0) (frames index 1)))
- (if (not (= (mus-sound-frames "fmv.snd") 1001))
- (snd-display #__line__ ";saved framers silence 1: ~A" (mus-sound-frames "fmv.snd")))
- (let ((v0 (channel->vct 0 1000 index 0))
- (v1 (channel->vct 0 1000 index 1)))
- (if (fneq (vct-peak v0) 0.0)
- (snd-display #__line__ ";auto-pad 0: ~A" (vct-peak v0)))
- (if (fneq (vct-peak v1) 0.0)
- (snd-display #__line__ ";silence 0: ~A" (vct-peak v1))))
- (close-sound index)
- (delete-file "fmv.snd")
-
- (set! index (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "unequal lens"))
- (pad-channel 0 1000 index 1)
- (if (or (not (= (frames index 0) 1))
- (not (= (frames index 1) 1001)))
- (snd-display #__line__ ";pad-channel 1: ~A ~A" (frames index 0) (frames index 1)))
- (let ((v0 (channel->vct 0 1000 index 0))
- (v1 (channel->vct 0 1000 index 1)))
- (if (fneq (vct-peak v0) 0.0)
- (snd-display #__line__ ";pad 0: ~A" (vct-peak v0)))
- (if (fneq (vct-peak v1) 0.0)
- (snd-display #__line__ ";pad 1: ~A" (vct-peak v1))))
- (map-channel (lambda (n) 1.0) 0 2 index 0)
- (map-channel (lambda (n) 1.0) 0 1002 index 1)
- (pad-channel 0 1000 index 0 1)
- (if (not (= (frames index 1) 1002))
- (snd-display #__line__ ";pad-channel ed 1: ~A ~A" (frames index 0) (frames index 1)))
- (close-sound index)
- (delete-file "fmv.snd")
-
- (let ((ind (open-sound "1a.snd")))
- (scale-to 1.0 ind 0)
- (make-selection 1000 2000 ind 0)
- (filter-selection-and-smooth .01 (vct .25 .5 .5 .5 .25))
- ; (if (fneq (sample 1500 ind 0) -0.0045776) (snd-display #__line__ ";filter-selection-and-smooth: ~A" (sample 1500 ind 0)))
- (revert-sound ind)
- (close-sound ind))
-
- (set! index (new-sound "fmv.snd" mus-ircam mus-bshort 22050 1 "this is a comment"))
- (let ((v0 (make-vct 128)))
- (vct-set! v0 64 .5)
- (vct-set! v0 127 .5)
- (vct->channel v0 0 128 index 0)
- (make-selection 0 126)
- (smooth-selection)
- (set! v0 (channel->vct 0 128 index 0))
- (if (or (fneq (sample 127) .5) (fneq (sample 120) .4962) (fneq (sample 32) 0.07431) (fneq (sample 64) 0.25308))
- (snd-display #__line__ ";smooth-selection: ~A?" v0))
- (revert-sound index)
- (vct-fill! v0 0.0)
- (vct-set! v0 10 .5)
-
- (vct->channel v0)
- (select-all)
- (set! (sinc-width) 40)
- (src-selection 0.5)
- (set! v0 (channel->vct 0 128 index 0))
- (if (or (fneq (sample 20) .5) (fneq (sample 30) 0.0) (fneq (sample 17) -.1057) )
- (snd-display #__line__ ";src-selection: ~A?" v0))
- (unselect-all)
- (if (selection-member?) (snd-display #__line__ ";unselect-all but still a selection?"))
- (unselect-all)
- (revert-sound index)
- (vct-fill! v0 0.0)
- (vct-set! v0 10 .5)
- (vct->channel v0 0)
- (select-all)
- (filter-selection '(0 0 .1 1 1 0) 40)
- (set! v0 (channel->vct 0 128 index 0))
- (if (or (fneq (sample 29) .1945) (fneq (sample 39) -.0137) (fneq (sample 24) -0.01986))
- (snd-display #__line__ ";filter-selection: ~A?" v0))
- (revert-sound index)
- (vct-fill! v0 1.0)
- (vct->channel v0 0 128 index 0)
- (select-all)
- (filter-selection (make-one-zero :a0 .5 :a1 0.0))
- (set! v0 (channel->vct 0 128 index 0))
- (if (or (fneq (sample 29) .5) (fneq (sample 39) .5) (fneq (sample 24) 0.5))
- (snd-display #__line__ ";filter-selection one-zero: ~A?" v0))
- (revert-sound index)
- (vct-fill! v0 1.0)
- (vct->channel v0 0 128 index 0)
- (if (file-exists? "fmv5.snd") (delete-file "fmv5.snd"))
- (select-all)
- (env-selection '(0 0 1 1 2 0) 1.0)
- (set! v0 (channel->vct 0 128 index 0))
- (if (or (fneq (sample 64) 1.0) (fneq (sample 20) .3125) (fneq (sample 119) 0.127))
- (snd-display #__line__ ";env-selection [len: ~A]: ~A ~A ~A ~A?" (selection-frames) (sample 64) (sample 20) (sample 119) v0))
- (save-selection "fmv5.snd" mus-next mus-bint 22050 "") ;1.0->-1.0 if short
- (revert-sound index)
- (let ((tag (catch #t (lambda () (file->array "/baddy/hiho" 0 0 128 v0)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";file->array w/o file: ~A" tag)))
- (let ((tag (catch #t (lambda () (file->array "fmv5.snd" 123 0 128 v0)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";file->array w/o channel: ~A" tag)))
- (file->array "fmv5.snd" 0 0 128 v0)
- (if (or (fneq (vct-ref v0 64) 1.0) (fneq (vct-ref v0 20) .3125) (fneq (vct-ref v0 119) 0.127))
- (snd-display #__line__ ";save-selection: ~A ~A ~A ~A?" (vct-ref v0 64) (vct-ref v0 20) (vct-ref v0 119) v0))
- (if (not (= (mus-sound-header-type "fmv5.snd") mus-next))
- (snd-display #__line__ ";save-selection type: ~A?" (mus-header-type-name (mus-sound-header-type "fmv5.snd"))))
- (if (not (= (mus-sound-data-format "fmv5.snd") mus-bint))
- (snd-display #__line__ ";save-selection format: ~A?" (mus-data-format-name (mus-sound-data-format "fmv5.snd"))))
- (if (not (= (mus-sound-srate "fmv5.snd") 22050))
- (snd-display #__line__ ";save-selection srate: ~A?" (mus-sound-srate "fmv5.snd")))
- (vct-fill! v0 0.0)
- (vct-set! v0 100 .5)
- (vct-set! v0 2 -.5)
- (vct->channel v0 0 128 index 0)
- (select-all)
- (without-errors (reverse-selection))
- (save-selection "fmv4.snd" mus-riff mus-lfloat 44100 "this is a comment")
- (set! v0 (channel->vct 0 128 index 0))
- (if (or (fneq (sample 27) 0.5) (fneq (sample 125) -.5))
- (snd-display #__line__ ";reverse-selection: ~A?" v0))
- (file->array "fmv4.snd" 0 0 128 v0)
- (if (or (fneq (sample 27) 0.5) (fneq (sample 125) -.5))
- (snd-display #__line__ ";save reverse-selection: ~A?" v0))
- (if (not (= (mus-sound-header-type "fmv4.snd") mus-riff))
- (snd-display #__line__ ";save-selection type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
- (if (not (= (mus-sound-data-format "fmv4.snd") mus-lfloat))
- (snd-display #__line__ ";save-selection format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
- (if (not (= (mus-sound-srate "fmv4.snd") 44100))
- (snd-display #__line__ ";save-selection srate 1: ~A?" (mus-sound-srate "fmv4.snd")))
- (if (not (string=? (mus-sound-comment "fmv4.snd") "this is a comment"))
- (snd-display #__line__ ";save-selection comment: ~A?" (mus-sound-comment "fmv4.snd")))
- (delete-file "fmv4.snd")
- (save-selection :file "fmv4.snd" :header-type mus-riff :data-format mus-lfloat :srate 44100 :comment "this is a comment")
- (if (not (= (mus-sound-header-type "fmv4.snd") mus-riff))
- (snd-display #__line__ ";save-selection opt type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
- (if (not (= (mus-sound-data-format "fmv4.snd") mus-lfloat))
- (snd-display #__line__ ";save-selection opt format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
- (if (not (= (mus-sound-srate "fmv4.snd") 44100))
- (snd-display #__line__ ";save-selection opt srate 1: ~A?" (mus-sound-srate "fmv4.snd")))
- (if (not (string=? (mus-sound-comment "fmv4.snd") "this is a comment"))
- (snd-display #__line__ ";save-selection opt comment: ~A?" (mus-sound-comment "fmv4.snd")))
- (delete-file "fmv4.snd")
- (save-selection :file "fmv4.snd" :data-format mus-bfloat :channel 0)
- (if (and (not (= (mus-sound-header-type "fmv4.snd") mus-next))
- (not (= (mus-sound-header-type "fmv4.snd") mus-ircam)))
- (snd-display #__line__ ";save-selection opt1 type 1: ~A?" (mus-header-type-name (mus-sound-header-type "fmv4.snd"))))
- (if (not (= (mus-sound-data-format "fmv4.snd") mus-bfloat))
- (snd-display #__line__ ";save-selection opt1 format 1: ~A?" (mus-data-format-name (mus-sound-data-format "fmv4.snd"))))
- (if (not (= (mus-sound-chans "fmv4.snd") 1))
- (snd-display #__line__ ";save-selection opt1 chans: ~A?" (mus-sound-chans "fmv4.snd")))
- (delete-file "fmv4.snd")
- (revert-sound index)
- (vct-fill! v0 0.0)
- (vct-set! v0 2 1.0)
- (let ((v1 (make-vct 256)))
- (do ((i 0 (+ 1 i)))
- ((= i 128))
- (vct-set! v1 i (vct-ref v0 i)))
- (vct->channel v1 0 128 index 0))
- (select-all)
- (if (mus-clipping) (set! (mus-clipping) #f))
- (if (clipping) (set! (clipping) #f))
- (convolve-selection-with "fmv5.snd" .5)
- (set! v0 (channel->vct 0 128 index 0))
- (if (fneq (sample 66) -.5) (snd-display #__line__ ";convolve-selection-with: ~A ~A ~A?" (vct-ref v0 66) (sample 66) v0))
- (close-sound index))
- (let* ((obind (open-sound "oboe.snd"))
- (vol (maxamp obind))
- (dur (frames)))
- (set! (amp-control obind) 2.0)
- (if (fffneq (amp-control obind) 2.0) (snd-display #__line__ ";set amp-control ~A" (amp-control obind)))
- (reset-controls obind)
- (if (ffneq (amp-control obind) 1.0) (snd-display #__line__ ";reset amp-control ~A" (amp-control obind)))
- (set! (amp-control-bounds obind) (list 0.0 4.0))
- (if (not (equal? (amp-control-bounds obind) (list 0.0 4.0))) (snd-display #__line__ ";amp-control-bounds: ~A" (amp-control-bounds)))
- (set! (amp-control obind) 2.0)
- (if (eq? (without-errors (apply-controls obind)) 'no-such-sound) (snd-display #__line__ ";apply-controls can't find oboe.snd?"))
- (let ((newamp (maxamp obind)))
- (if (> (abs (- (* 2.0 vol) newamp)) .05) (snd-display #__line__ ";apply amp: ~A -> ~A?" vol newamp))
- (set! (amp-control-bounds obind) (list 0.0 8.0))
- (set! (speed-control-bounds obind) (list 1.0 5.0))
- (if (not (equal? (speed-control-bounds obind) (list 1.0 5.0))) (snd-display #__line__ ";speed-control-bounds: ~A" (speed-control-bounds)))
- (set! (speed-control obind) 0.5)
- (set! (speed-control-bounds obind) (list .05 20.0))
- (add-mark 1234)
- (apply-controls obind)
- (let ((newdur (frames obind)))
- (set! (speed-control obind) 1.0)
- (if (not (< (- newdur (* 2.0 dur)) 256)) (snd-display #__line__ ";apply speed: ~A -> ~A?" dur newdur))
- ;; within 256 which is apply's buffer size (it always flushes full buffers)
- (set! (contrast-control? obind) #t)
- (set! (contrast-control-bounds obind) (list 0.5 2.5))
- (if (not (equal? (contrast-control-bounds obind) (list 0.5 2.5))) (snd-display #__line__ ";contrast-control-bounds: ~A" (contrast-control-bounds)))
- (set! (contrast-control obind) 1.0)
- (apply-controls obind)
- (set! (contrast-control-bounds obind) (list 0.0 10.0))
- (if (not (equal? (contrast-control-bounds obind) (list 0.0 10.0))) (snd-display #__line__ ";contrast-control-bounds (2): ~A" (contrast-control-bounds)))
- (let ((secamp (maxamp obind))
- (secdur (frames obind)))
- (if (fneq secamp .989) (snd-display #__line__ ";apply contrast: ~A?" secamp))
- (if (not (= secdur newdur)) (snd-display #__line__ ";apply contrast length: ~A -> ~A?" newdur secdur))
- (undo 3 obind)
- (set! (reverb-control? obind) #t)
- (set! (reverb-control-scale-bounds obind) (list 0.0 1.0))
- (if (not (equal? (reverb-control-scale-bounds obind) (list 0.0 1.0)))
- (snd-display #__line__ ";reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds)))
- (set! (reverb-control-length-bounds obind) (list 0.0 2.0))
- (if (not (equal? (reverb-control-length-bounds obind) (list 0.0 2.0)))
- (snd-display #__line__ ";reverb-control-length-bounds: ~A" (reverb-control-length-bounds)))
- (set! (reverb-control-scale obind) .2)
- (apply-controls obind)
- (let ((revamp (maxamp obind))
- (revdur (frames obind)))
- (if (ffneq revamp .214) (snd-display #__line__ ";apply reverb scale: ~A?" revamp))
- (if (not (< (- revdur (+ 50828 (round (* (reverb-control-decay) 22050)))) 256))
- (snd-display #__line__ ";apply reverb length: ~A?" revdur))
- (undo 1 obind)
- (set! (expand-control? obind) #t)
- (set! (expand-control-bounds obind) (list 1.0 3.0))
- (if (not (equal? (expand-control-bounds obind) (list 1.0 3.0))) (snd-display #__line__ ";expand-control-bounds: ~A" (expand-control-bounds)))
- (set! (expand-control obind) 1.5)
- (apply-controls obind)
- (let ((expamp (maxamp obind))
- (expdur (frames obind)))
- (if (> (abs (- expamp .152)) .05) (snd-display #__line__ ";apply expand-control scale: ~A?" expamp))
- (if (not (> expdur (* 1.25 50828))) (snd-display #__line__ ";apply expand-control length: ~A?" expdur))
- (set! (expand-control-bounds obind) (list 0.001 20.0))
- (undo 1 obind)
- (set! (filter-control? obind) #t)
- (set! (filter-control-order obind) 40)
- (set! (filter-control-envelope obind) '(0 0 1 .5 2 0))
- (apply-controls obind)
- (let ((fltamp (maxamp obind))
- (fltdur (frames obind)))
- (if (> (abs (- fltamp .02)) .005) (snd-display #__line__ ";apply filter scale: ~A?" fltamp))
- (if (> (- fltdur (+ 40 50828)) 256) (snd-display #__line__ ";apply filter length: ~A?" fltdur))
- (undo 1 obind)))))))
- (revert-sound obind)
- (make-selection 1000 1000)
- (scale-selection-to .1)
- (scale-selection-by 2.0)
- (make-selection 2000 2001)
- (scale-selection-by 2.0)
- (scale-selection-to .5)
- (make-selection 1000 2001)
- (scale-selection-to .5)
- (scale-selection-by .5)
- (make-selection 2000 2000)
- (scale-selection-by 2.0)
- (scale-selection-to .5)
- (make-selection 1000 1001)
- (scale-selection-to .1)
- (scale-selection-by 2.0)
- (make-selection 999 2002)
- (scale-selection-to 1.0)
- (scale-selection-by .5)
- (let ((tree (edit-tree))
- (true-tree '((0 0 0 998 1.0 0.0 0.0 0)
- (999 0 999 999 0.999969720840454 0.0 0.0 0)
- (1000 0 1000 1000 6.09052181243896 0.0 0.0 0)
- (1001 0 1001 1001 0.999969720840454 0.0 0.0 0)
- (1002 0 1002 1999 0.499984979629517 0.0 0.0 0)
- (2000 0 2000 2000 7.54652404785156 0.0 0.0 0)
- (2001 0 2001 2001 3.7732629776001 0.0 0.0 0)
- (2002 0 2002 2002 0.999969720840454 0.0 0.0 0)
- (2003 0 2003 50827 1.0 0.0 0.0 0)
- (50828 -2 0 0 0.0 0.0 0.0 0))))
- (if (not (= (length tree) (length true-tree)))
- (snd-display #__line__ ";edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
- (let ((len (length tree)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let ((branch (list-ref tree i))
- (true-branch (list-ref true-tree i)))
- (if (or (not (= (car branch) (car true-branch)))
- (not (= (cadr branch) (cadr true-branch)))
- (not (= (caddr branch) (caddr true-branch)))
- (not (= (cadddr branch) (cadddr true-branch)))
- (fneq (list-ref branch 4) (list-ref true-branch 4)))
- (snd-display #__line__ ";edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
- (insert-silence 1001 8)
- (insert-silence 900 50)
- (insert-silence 2005 1)
- (insert-silence 999 2)
- (let ((tree (edit-tree))
- (true-tree '((0 0 0 899 1.0 0.0 0.0 0)
- (900 -1 0 49 0.0 0.0 0.0 0)
- (950 0 900 948 1.0 0.0 0.0 0)
- (999 -1 0 1 0.0 0.0 0.0 0)
- (1001 0 949 998 1.0 0.0 0.0 0)
- (1051 0 999 999 0.999969720840454 0.0 0.0 0)
- (1052 0 1000 1000 6.09052181243896 0.0 0.0 0)
- (1053 -1 0 7 0.0 0.0 0.0 0)
- (1061 0 1001 1001 0.999969720840454 0.0 0.0 0)
- (1062 0 1002 1946 0.499984979629517 0.0 0.0 0)
- (2007 -1 0 0 0.0 0.0 0.0 0)
- (2008 0 1947 1999 0.499984979629517 0.0 0.0 0)
- (2061 0 2000 2000 7.54652404785156 0.0 0.0 0)
- (2062 0 2001 2001 3.7732629776001 0.0 0.0 0)
- (2063 0 2002 2002 0.999969720840454 0.0 0.0 0)
- (2064 0 2003 50827 1.0 0.0 0.0 0)
- (50889 -2 0 0 0.0 0.0 0.0 0))))
- (if (not (= (length tree) (length true-tree)))
- (snd-display #__line__ ";silenced edit trees are not same length: ~A ~A?" (length tree) (length true-tree))
- (let ((len (length tree)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let ((branch (list-ref tree i))
- (true-branch (list-ref true-tree i)))
- (if (or (not (= (car branch) (car true-branch)))
- (not (= (cadr branch) (cadr true-branch)))
- (not (= (caddr branch) (caddr true-branch)))
- (not (= (cadddr branch) (cadddr true-branch)))
- (fneq (list-ref branch 4) (list-ref true-branch 4)))
- (snd-display #__line__ ";silenced edit trees disagree at ~D: ~A ~A" i branch true-branch)))))))
- (if (or (fneq (sample 998) -.03)
- (fneq (sample 999) 0.0)
- (fneq (sample 1000) 0.0)
- (fneq (sample 1001) -.03))
- (snd-display #__line__ ";insert-silence [999 for 2]: ~A ~A ~A ~A?" (sample 998) (sample 999) (sample 1000) (sample 1001) ))
- (if (or (fneq (sample 2006) -.033)
- (fneq (sample 2007) 0.0)
- (fneq (sample 2008) -.033))
- (snd-display #__line__ ";insert-silence [2007 for 1]: ~A ~A ~A?" (sample 2006) (sample 2007) (sample 2008)))
- (revert-sound obind)
- (add-mark 1200 obind 0)
- (let ((mark-num (length (marks obind 0))))
- (scale-by 2.0 obind 0)
- (let ((mark-now (length (marks obind 0))))
- (if (not (= mark-num mark-now))
- (snd-display #__line__ ";mark lost after scaling?"))
- (set! (selection-position) 0)
- (set! (selection-frames) 100)
- (scale-selection-to .5)
- (set! mark-now (length (marks obind 0)))
- (if (not (= mark-num mark-now))
- (snd-display #__line__ ";mark lost after selection scaling?")))
- (let ((m1 (add-mark 1000)))
- (set! (cursor obind 0) 100)
- (key (char->integer #\u) 4 obind)
- (key (char->integer #\1) 0 obind)
- (key (char->integer #\0) 0 obind)
- (key (char->integer #\0) 0 obind)
- (key (char->integer #\o) 4 obind)
- (if (not (= (mark-sample m1) 1100))
- (snd-display #__line__ ";mark after zeros: ~D (1100)? " (mark-sample m1)))
- (set! (cursor obind) 0)
- (key (char->integer #\j) 4 obind)
- (if (not (= (cursor obind) 1100)) (snd-display #__line__ ";c-j to ~A" (cursor obind)))
- (add-mark 100)
- (set! (cursor obind) 0)
- (key (char->integer #\u) 4 obind)
- (key (char->integer #\2) 0 obind)
- (key (char->integer #\j) 4 obind)
- (if (not (= (cursor obind) 1100)) (snd-display #__line__ ";c-u 2 c-j ~A" (cursor obind)))
- (key (char->integer #\-) 4 obind)
- (key (char->integer #\j) 4 obind)
- (if (not (= (cursor obind) 100)) (snd-display #__line__ ";c-- c-j ~A" (cursor obind)))))
- (revert-sound obind)
- (let ((frs (frames obind)))
- (make-region 0 999 obind 0)
- (if (not (selection?)) (snd-display #__line__ ";make-region but no selection? ~A" (selection?)))
- (delete-selection)
- (if (not (= (frames obind) (- frs 1000)))
- (snd-display #__line__ ";delete-selection: ~A?" (frames obind)))
- (let ((val (sample 0 obind 0)))
- (undo)
- (if (fneq (sample 1000) val)
- (snd-display #__line__ ";delete-selection val: ~A ~A" val (sample 1000)))
- (insert-selection)
- (let ((var (catch #t (lambda () (insert-selection 0 obind 123)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-channel))
- (snd-display #__line__ ";insert-selection bad chan: ~A" var)))
- (let ((var (catch #t (lambda () (mix-selection 0 obind 123)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-channel))
- (snd-display #__line__ ";mix-selection bad chan: ~A" var)))
- (if (not (= (frames obind) (+ frs 1000)))
- (snd-display #__line__ ";insert-selection: ~A?" (frames obind)))
- (if (fneq (sample 2000) val)
- (snd-display #__line__ ";insert-selection val: ~A ~A" val (sample 2000)))
- (set! val (sample 900))
- (mix-selection)
- (if (fneq (sample 900) (* 2 val))
- (snd-display #__line__ ";mix-selection val: ~A ~A" (* 2 val) (sample 900)))
- (if (not (= (frames obind) (+ frs 1000)))
- (snd-display #__line__ ";mix-selection len: ~A?" (frames obind)))))
- (close-sound obind))
-
- (let* ((ind (open-sound "2.snd"))
- (apply-to-sound 0)
- (apply-to-channel 1)
- (apply-to-selection 2)
- (len (frames ind)))
- (set! (sync ind) 1)
- (set! (speed-control ind) .5)
- (apply-controls ind apply-to-sound) ; temp 1
- (if (> (abs (- (frames) (* 2 len))) 256)
- (snd-display #__line__ ";apply srate .5: ~A ~A" (frames) (* 2 len)))
- (make-selection 0 (frames))
- (set! (speed-control ind) .5)
- (apply-controls ind apply-to-selection) ; temp 2
- (if (> (abs (- (frames) (* 4 len))) 256)
- (snd-display #__line__ ";apply srate .5 to selection: ~A ~A" (frames) (* 4 len)))
- (env-sound '(0 0 1 1) 0 (frames) 32.0) ; temp 3
- (let ((reg (select-all))) ; make multi-channel region
- (insert-region reg 0) ; temp 4
- (insert-selection 0)) ; temp 5
- (revert-sound ind)
- (set! (speed-control) .5)
- (set! (sync ind) 0)
- (set! (selected-channel ind) 1)
- (apply-controls ind apply-to-channel)
- (if (> (abs (- (frames ind 1) (* 2 len))) 256)
- (snd-display #__line__ ";apply srate .5 to chan 1: ~A ~A" (frames ind 1) (* 2 len)))
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";apply srate .5 but chan 0: ~A ~A" (frames ind 0) len))
- (set! (speed-control ind) .5)
- (apply-controls ind apply-to-sound 1000)
- (make-selection 2000 4000)
- (set! (speed-control ind) .5)
- (apply-controls ind apply-to-selection)
- (set! (selected-channel ind) #f)
- (if (selected-channel ind) (snd-display #__line__ ";selected-channel #f: ~A" (selected-channel ind)))
- (close-sound ind))
-
- (let* ((ind1 (open-sound "oboe.snd"))
- (mx1 (maxamp ind1 0))
- (ind2 (open-sound "2.snd"))
- (mx20 (maxamp ind2 0))
- (mx21 (maxamp ind2 1)))
- (select-sound ind1)
- (scale-sound-by 2.0)
- (let ((nmx (maxamp ind1 0)))
- (if (fneq (* 2 mx1) nmx) (snd-display #__line__ ";scale-sound-by 2.0: ~A ~A?" mx1 nmx))
- (if (not (equal? (edit-fragment 1 ind1 0) (list "scale-channel 2.000 0 #f" "scale" 0 50828)))
- (snd-display #__line__ ";scale-sound-by: ~A?" (edit-fragment 1 ind1 0))))
- (scale-sound-to 0.5)
- (let ((nmx (maxamp ind1 0)))
- (if (fneq nmx 0.5) (snd-display #__line__ ";scale-sound-to 0.5: ~A?" nmx))
- (if (not (equal? (edit-fragment 2 ind1 0) (list "scale-channel 1.698 0 #f" "scale" 0 50828)))
- (snd-display #__line__ ";scale-sound-to: ~A?" (edit-fragment 2 ind1 0))))
- (scale-sound-by 0.0 0 1000 ind1 0)
- (let ((nmx (maxamp ind1 0)))
- (if (fneq 0.5 nmx) (snd-display #__line__ ";scale-sound-by 0.0: ~A ~A?" mx1 nmx))
- (if (not (equal? (edit-fragment 3 ind1 0) (list "scale-channel 0.000 0 1000" "scale" 0 1000)))
- (snd-display #__line__ ";scale-sound-by 0.0: ~A?" (edit-fragment 3 ind1 0))))
- (let* ((v (channel->vct 0 1000 ind1 0))
- (pk (vct-peak v)))
- (if (fneq pk 0.0) (snd-display #__line__ ";scale-sound-by 0.0 [0:1000]: ~A?" pk)))
- (revert-sound ind1)
- (let ((oldv (channel->vct 12000 10 ind1 0)))
- (scale-sound-by 2.0 12000 10 ind1 0)
- (let ((newv (channel->vct 12000 10 ind1 0)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (* 2.0 (vct-ref oldv i)) (vct-ref newv i))
- (snd-display #__line__ ";scale ~D: ~A ~A?" i (vct-ref oldv i) (vct-ref newv i)))))
- (if (not (equal? (edit-fragment 1 ind1 0) (list "scale-channel 2.000 12000 10" "scale" 12000 10)))
- (snd-display #__line__ ";scale-sound-by 2.0 [12000:10]: ~A?" (edit-fragment 1 ind1 0))))
- (revert-sound ind1)
- (select-sound ind2)
- (scale-sound-by 2.0)
- (let ((nmx (maxamp ind2 0)))
- (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 scale-sound-by 2.0: ~A ~A?" mx20 nmx)))
- (let ((nmx (maxamp ind2 1)))
- (if (fneq (* 2 mx21) nmx) (snd-display #__line__ ";2:1 scale-sound-by 2.0: ~A ~A?" mx21 nmx)))
- (scale-sound-to 0.5)
- (let ((nmx (max (maxamp ind2 0) (maxamp ind2 1))))
- (if (fneq nmx 0.5) (snd-display #__line__ ";2 scale-sound-to 0.5: ~A (~A)?" nmx (maxamp ind2))))
- (scale-sound-by 0.0 0 1000 ind2 1)
- (if (not (equal? (edit-fragment 3 ind2 1) (list "scale-channel 0.000 0 1000" "scale" 0 1000)))
- (snd-display #__line__ ";2:1 scale-sound-by 0.0: ~A?" (edit-fragment 3 ind2 1)))
- (let* ((v (channel->vct 0 1000 ind2 1))
- (pk (vct-peak v)))
- (if (fneq pk 0.0) (snd-display #__line__ ";2:1 scale-sound-by 0.0 [0:1000]: ~A?" pk)))
- (revert-sound ind2)
- (let ((oldv (channel->vct 12000 10 ind2 0)))
- (scale-sound-by 2.0 12000 10 ind2 0)
- (let ((newv (channel->vct 12000 10 ind2 0)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (* 2.0 (vct-ref oldv i)) (vct-ref newv i))
- (snd-display #__line__ ";2 scale ~D: ~A ~A?" i (vct-ref oldv i) (vct-ref newv i))))))
- (revert-sound ind2)
- (set! (sync ind2) 3)
- (set! (sync ind1) 3)
- (scale-sound-by 2.0)
- (let ((nmx (maxamp ind1 0)))
- (if (fneq mx1 nmx) (snd-display #__line__ ";sync scale-sound-by 2.0: ~A ~A?" mx1 nmx)))
- (let ((nmx (maxamp ind2 0)))
- (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 sync scale-sound-by 2.0: ~A ~A?" mx20 nmx)))
- (let ((nmx (maxamp ind2 1)))
- (if (fneq (* 2 mx21) nmx) (snd-display #__line__ ";2:1 sync scale-sound-by 2.0: ~A ~A?" mx21 nmx)))
- (scale-sound-to 1.0 20000 40000 ind2 1)
- (let ((nmx (maxamp ind1 0)))
- (if (fneq mx1 nmx) (snd-display #__line__ ";sync scale-sound-to 1.0: ~A ~A?" mx1 nmx)))
- (let ((nmx (maxamp ind2 0)))
- (if (fneq (* 2 mx20) nmx) (snd-display #__line__ ";2:0 sync scale-sound-to 1.0: ~A ~A?" mx20 nmx)))
- (let ((nmx (maxamp ind2 1)))
- (if (fneq nmx 1.0) (snd-display #__line__ ";2:1 sync scale-sound-to 1.0: ~A?" nmx)))
-
- (close-sound ind1)
- (close-sound ind2))
-
- (let* ((ind (open-sound "now.snd")))
- (set! (amp-control ind) .5)
- (if (ffneq (amp-control ind) .5) (snd-display #__line__ ";amp-control (.5): ~A?" (amp-control ind)))
- (set! (amp-control ind 0) .25)
- (if (ffneq (amp-control ind) .5) (snd-display #__line__ ";amp-control after local set (.5): ~A?" (amp-control ind)))
- (if (ffneq (amp-control ind 0) .25) (snd-display #__line__ ";amp-control 0 (.25): ~A?" (amp-control ind 0)))
- (set! (amp-control ind) 1.0)
- (if (ffneq (amp-control ind) 1.0) (snd-display #__line__ ";amp-control (1.0): ~A?" (amp-control ind)))
- (if (ffneq (amp-control ind 0) .25) (snd-display #__line__ ";amp-control 0 after set (.25): ~A?" (amp-control ind 0)))
- (set! (transform-graph? ind 0) #t)
- (set! (transform-graph-type ind 0) graph-as-sonogram)
- (update-transform-graph ind 0)
- (let ((val (transform-frames ind 0)))
- (if (or (not (list? val))
- (fneq (car val) 1.0)
- (not (= (caddr val) 256)))
- (snd-display #__line__ ";transform-frames: ~A (~A)" val (transform-size ind 0))))
- (close-sound ind)
- (set! ind (open-sound "4.aiff"))
- (if (ffneq (amp-control ind) 1.0) (snd-display #__line__ ";amp-control upon open (1.0): ~A?" (amp-control ind)))
- (if (ffneq (amp-control ind 2) 1.0) (snd-display #__line__ ";amp-control 2 upon open (1.0): ~A?" (amp-control ind 2)))
- (set! (amp-control ind) .5)
- (if (ffneq (amp-control ind 2) .5) (snd-display #__line__ ";amp-control 2 after global set (.5): ~A?" (amp-control ind 2)))
- (set! (amp-control ind 2) .25)
- (if (ffneq (amp-control ind 2) .25) (snd-display #__line__ ";amp-control 2 (.25): ~A?" (amp-control ind 2)))
- (if (ffneq (amp-control ind 1) .5) (snd-display #__line__ ";amp-control 1 after local set (.5): ~A?" (amp-control ind 1)))
- (let ((after-ran #f))
- (set! (hook-functions after-apply-controls-hook) '())
- (hook-push after-apply-controls-hook (lambda (snd) (set! after-ran snd)))
- (apply-controls ind)
- (if (not (equal? ind after-ran)) (snd-display #__line__ ";after-apply-controls-hook: ~A?" after-ran))
- (set! (hook-functions after-apply-controls-hook) '()))
- (revert-sound ind)
- (set! (sync ind) 1)
- (scale-to (vct .1 .2))
- (let ((mx (maxamp ind #t)))
- (if (or (fneq (list-ref mx 0) .1)
- (fneq (list-ref mx 1) .2)
- (fneq (list-ref mx 2) .2)
- (fneq (list-ref mx 3) .2))
- (snd-display #__line__ ";scale to with vector: ~A" mx)))
- (set! (filter-control-envelope ind) '(0 0 1 1))
- (if (not (feql '(0.0 0.0 1.0 1.0) (filter-control-envelope ind)))
- (snd-display #__line__ ";set filter-control-envelope: ~A?" (filter-control-envelope ind)))
- (set! (filter-control-order ind) 20)
- (if (not (vequal (filter-control-coeffs ind)
- (vct -0.007 0.010 -0.025 0.029 -0.050 0.055 -0.096 0.109 -0.268 0.241
- 0.241 -0.268 0.109 -0.096 0.055 -0.050 0.029 -0.025 0.010 -0.007)))
- (snd-display #__line__ ";highpass coeffs: ~A" (filter-control-coeffs ind)))
- (set! (filter-control-envelope ind) (filter-control-envelope ind))
- (if (not (feql '(0.0 0.0 1.0 1.0) (filter-control-envelope ind)))
- (snd-display #__line__ ";set filter-control-envelope to self: ~A?" (filter-control-envelope ind)))
- (set! (filter-control-envelope ind) '(0 1 1 0))
- (if (not (vequal (filter-control-coeffs ind)
- (vct 0.003 0.002 0.004 0.002 0.007 0.003 0.014 0.012 0.059 0.394
- 0.394 0.059 0.012 0.014 0.003 0.007 0.002 0.004 0.002 0.003)))
- (snd-display #__line__ ";lowpass coeffs: ~A" (filter-control-coeffs ind)))
- (close-sound ind))
-
- (let* ((obind (open-sound "4.aiff"))
- (amps (maxamp obind #t))
- (times (maxamp-position obind #t)))
- (if (not (equal? times (list 810071 810071 810071 810071)))
- (snd-display #__line__ ";4.aiff times: ~A" times))
- (if (< (window-width) 600)
- (set! (window-width) 600))
- (if (< (window-height) 600)
- (set! (window-height) 600))
- (set! (x-bounds obind 0) (list 0.0 0.1))
- (set! (show-axes obind 0) show-x-axis)
- (update-time-graph)
- (set! (amp-control obind) 0.1)
- (select-channel 2)
- (if (eq? (without-errors (apply-controls obind 1)) 'no-such-sound) (snd-display #__line__ ";apply-controls can't find 4.aiff?"))
- (let ((newamps (maxamp obind #t)))
- (if (or (fneq (car amps) (car newamps))
- (fneq (cadr amps) (cadr newamps))
- (> (abs (- (* 0.1 (caddr amps)) (caddr newamps))) .05)
- (fneq (cadddr amps) (cadddr newamps)))
- (snd-display #__line__ ";apply amps:~% ~A ->~% ~A?" amps newamps))
- (undo 1 obind 2)
- (set! (amp-control obind) 0.1)
- (make-region 0 (frames obind) obind 1)
- (without-errors (apply-controls obind 2))
- (set! newamps (maxamp obind #t))
- (if (or (fneq (car amps) (car newamps))
- (> (abs (- (* 0.1 (cadr amps)) (cadr newamps))) .05)
- (fneq (caddr amps) (caddr newamps))
- (fneq (cadddr amps) (cadddr newamps)))
- (snd-display #__line__ ";apply selection amp:~% ~A ->~% ~A?" amps newamps))
- (if with-gui
- (let* ((axinfo (axis-info obind 0 time-graph))
- (losamp (car axinfo))
- (hisamp (cadr axinfo))
- (x0 (list-ref axinfo 2))
- (y0 (list-ref axinfo 3))
- (x1 (list-ref axinfo 4))
- (y1 (list-ref axinfo 5))
- (xpos (+ x0 (* .5 (- x1 x0))))
- (ypos (+ y0 (* .75 (- y1 y0)))))
- (define (cp-x x) (floor (+ (list-ref axinfo 10)
- (* (- x x0) (/ (- (list-ref axinfo 12) (list-ref axinfo 10))
- (- x1 x0))))))
- (define (cp-y y) (floor (+ (list-ref axinfo 13)
- (* (- y1 y) (/ (- (list-ref axinfo 11) (list-ref axinfo 13))
- (- y1 y0))))))
- (select-channel 0)
- (set! (cursor obind) 100)
- (let ((xy (cursor-position obind)))
- (if (fneq (position->x (car xy)) (/ (cursor obind) (srate obind)))
- (snd-display #__line__ ";cursor-position: ~A ~A ~A?" (car xy) (position->x (car xy)) (/ (cursor obind) (srate obind)))))
- (if (fneq (position->x (x->position xpos)) xpos)
- (snd-display #__line__ ";x<->position: ~A ~A?" (position->x (x->position xpos)) xpos))
- (if (> (abs (- (position->y (y->position ypos)) ypos)) .5)
- (snd-display #__line__ ";y<->position: ~A ~A?" (position->y (y->position ypos)) ypos))
- (if (not (= losamp (left-sample obind 0)))
- (snd-display #__line__ ";axis-info[0 losamp]: ~A ~A?" losamp (left-sample obind 0)))
- (if (not (= hisamp (right-sample obind 0)))
- (snd-display #__line__ ";axis-info[1 hisamp]: ~A ~A?" hisamp (right-sample obind 0)))
- (if (fneq (list-ref axinfo 6) 0.0)
- (snd-display #__line__ ";axis-info[6 xmin]: ~A?" (list-ref axinfo 6)))
- (if (fneq (list-ref axinfo 7) -1.0)
- (snd-display #__line__ ";axis-info[7 ymin]: ~A?" (list-ref axinfo 7)))
- (if (fneq (list-ref axinfo 9) 1.0)
- (snd-display #__line__ ";axis-info[9 ymax]: ~A?" (list-ref axinfo 9)))
- (if (> (abs (apply - (our-x->position obind x0))) 1)
- (snd-display #__line__ ";x0->position: ~A?" (our-x->position obind x0)))
- (if (> (abs (apply - (our-x->position obind x1))) 1)
- (snd-display #__line__ ";x1->position: ~A?" (our-x->position obind x1)))
- (if (> (abs (apply - (our-x->position obind (* 0.5 (+ x0 x1))))) 1)
- (snd-display #__line__ ";xmid->position: ~A?" (our-x->position obind (* 0.5 (+ x0 x1)))))
- (if (not full-test)
- (begin
- (if (> (abs (- (x->position xpos) (cp-x xpos))) 1)
- (snd-display #__line__ ";cp-x .5: ~A ~A?" (x->position xpos) (cp-x xpos)))
- (if (> (abs (- (y->position ypos) (cp-y ypos))) 1)
- (snd-display #__line__ ";cp-y .75: ~A ~A?" (y->position ypos) (cp-y ypos)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (let ((xpos (+ x0 (random (- x1 x0))))
- (ypos (+ y0 (random (- y1 y0)))))
- (if (> (abs (- (x->position xpos) (cp-x xpos))) 1)
- (snd-display #__line__ ";cp-x[~A] ~A: ~A ~A?" i xpos (x->position xpos) (cp-x xpos)))
- (if (> (abs (- (y->position ypos) (cp-y ypos))) 1)
- (snd-display #__line__ ";cp-y[~A] ~A: ~A ~A?" i ypos (y->position ypos) (cp-y ypos)))
- (if (fneq (position->x (cp-x xpos)) xpos)
- (snd-display #__line__ ";x->position cp-x ~A ~A" xpos (position->x (cp-x xpos))))
- (if (fffneq (position->y (cp-y ypos)) ypos)
- (snd-display #__line__ ";y->position cp-y ~A ~A" ypos (position->y (cp-y ypos))))))))
- (set! (left-sample obind 0) 1234)
- (if (not (= 1234 (car (axis-info obind 0))))
- (snd-display #__line__ ";axis-info[0 losamp at 1234]: ~A ~A?" (car (axis-info obind 0)) (left-sample obind 0)))
- (set! axinfo (axis-info obind 0))
- (set! x0 (list-ref axinfo 2))
- (set! x1 (list-ref axinfo 4))
- (if (> (abs (apply - (our-x->position obind x0))) 1)
- (snd-display #__line__ ";x0a->position: ~A?" (our-x->position obind x0)))
- (if (> (abs (apply - (our-x->position obind x1))) 1)
- (snd-display #__line__ ";x1a->position: ~A?" (our-x->position obind x1)))
- (if (> (abs (apply - (our-x->position obind (* 0.5 (+ x0 x1))))) 1)
- (snd-display #__line__ ";xmida->position: ~A?" (our-x->position obind (* 0.5 (+ x0 x1)))))
- (set! (y-bounds obind 0) (list -2.0 3.0))
- (if (fneq (list-ref (axis-info obind 0) 7) -2.0)
- (snd-display #__line__ ";axis-info[7 ymin -2.0]: ~A?" (list-ref (axis-info obind 0) 7)))
- (if (fneq (list-ref (axis-info obind 0) 9) 3.0)
- (snd-display #__line__ ";axis-info[9 ymax 3.0]: ~A?" (list-ref (axis-info obind 0) 9)))
-
- ))
- (close-sound obind)))
-
- (let ((ind1 (open-sound "oboe.snd")))
- (test-orig (lambda (snd) (src-sound 2.0 1.0 ind1)) (lambda (snd) (src-sound 0.5 1.0 ind1)) 'src-sound ind1)
- (test-orig (lambda (snd) (src-channel 2.0)) (lambda (snd) (src-channel 0.5)) 'src-channel ind1)
- (test-orig (lambda (snd) (scale-by 2.0 ind1)) (lambda (snd) (scale-by 0.5 ind1)) 'scale-by ind1)
- (test-orig (lambda (snd) (scale-channel 2.0)) (lambda (snd) (scale-channel 0.5)) 'scale-channel ind1)
- (test-orig (lambda (snd) (reverse-sound ind1)) (lambda (snd) (reverse-sound ind1)) 'reverse-sound ind1)
- (test-orig (lambda (snd) (reverse-channel)) (lambda (snd) (reverse-channel)) 'reverse-channel ind1)
- (test-orig (lambda (snd) (env-sound '(0 1.0 1 2.0))) (lambda (snd) (env-sound '(0 1.0 1 0.5))) 'env-sound ind1)
- (test-orig (lambda (snd) (env-sound '(0 1.0 1 2.0 2 1.0))) (lambda (snd) (env-sound '(0 1.0 1 0.5 2 1.0))) 'env-sound ind1)
- (test-orig (lambda (snd) (env-channel (make-env :envelope '(0 1.0 1 2.0) :length (frames))))
- (lambda (snd) (env-channel (make-env :envelope '((0 1.0) (1 0.5)) :length (frames)))) 'env-channel ind1)
- (test-orig (lambda (snd) (env-channel '(0 1.0 1 2.0)))
- (lambda (snd) (env-channel '(0 1.0 1 0.5))) 'env-channel ind1)
- (test-orig (lambda (snd) (env-channel (make-env :envelope '(0 2 1 2 2 0.5 3 0.5) :base 0 :length (frames))))
- (lambda (snd) (env-channel (make-env :envelope '(0 0.5 1 0.5 2 2 3 2) :base 0 :length (frames)))) 'env-channel ind1)
- (test-orig (lambda (snd) (map-channel (lambda (n) (* n 2)))) (lambda (snd) (map-channel (lambda (n) (* n 0.5)))) 'map-channel ind1)
- (test-orig (lambda (snd) (map-channel (lambda (n) (* n 2)) 1234)) (lambda (snd) (map-channel (lambda (n) (* n 0.5)) 1234)) 'map-channel ind1)
- (test-orig (lambda (snd) (map-channel (lambda (n) (* n 2)) 12005 10)) (lambda (snd) (map-channel (lambda (n) (* n 0.5)) 12005 10)) 'map-channel ind1)
- (test-orig (lambda (snd) (map-channel
- (let ((vect (make-vct 2 0.0)))
- (lambda (y)
- (vct-set! vect 0 (* y 2))
- (vct-set! vect 1 (* y 2))
- vect))))
- (lambda (snd) (map-channel
- (let ((outp #f))
- (lambda (y)
- (if outp
- (set! outp #f)
- (set! outp (* y 0.5)))
- outp))))
- 'map-channel ind1)
- (test-orig (lambda (snd) (map-chan (lambda (n) (* n 2)))) (lambda (snd) (map-chan (lambda (n) (* n 0.5)))) 'map-chan ind1)
- (test-orig (lambda (snd) (pad-channel 1000 2000 ind1)) (lambda (snd) (delete-samples 1000 2000 ind1)) 'pad-channel ind1)
- (test-orig (lambda (snd) (clm-channel (make-one-zero :a0 2.0 :a1 0.0)))
- (lambda (snd) (clm-channel (make-one-zero :a0 0.5 :a1 0.0))) 'clm-channel ind1)
- (test-orig (lambda (snd) (clm-channel (make-one-pole :a0 2.0 :b1 0.0)))
- (lambda (snd) (clm-channel (make-one-pole :a0 0.5 :b1 0.0))) 'clm-channel ind1)
- (test-orig (lambda (snd) (filter-sound (make-one-zero :a0 2.0 :a1 0.0) 2 ind1 0))
- (lambda (snd) (filter-sound (make-one-zero :a0 0.5 :a1 0.0)) 2 ind1 0) 'filter-sound ind1)
-
- (let ((var (catch #t (lambda () (src-sound '(0 0 1 1))) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";src-sound env at 0: ~A" var)))
- (let ((var (catch #t (lambda () (src-sound '(0 1 1 -1))) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";src-sound env through 0: ~A" var)))
-
- (scale-to 1.0 ind1)
- (let ((v0 (make-vct 10))
- (v1 (channel->vct 12000 10 ind1 0)))
- (vct-set! v0 0 1.0)
- (array->file "fmv3.snd" v0 10 22050 1)
- (copy-file "oboe.snd" "fmv4.snd")
- (convolve-with "fmv3.snd" 1.0 ind1)
- (convolve-files "fmv4.snd" "fmv3.snd" 1.0 "fmv5.snd")
- (let ((v2 (channel->vct 12000 10 ind1 0)))
- (if (not (vfequal v1 v2))
- (snd-display #__line__ ";~A (orig: 0) ~A ~A" 'convolve-with v1 v2))
- (file->array "fmv5.snd" 0 12000 10 v2)
- (if (not (vfequal v1 v2))
- (snd-display #__line__ ";convolve-files: (orig: 0) ~A ~A" v1 v2)))
- (delete-file "fmv3.snd")
- (delete-file "fmv5.snd"))
- (convolve-files "2.snd" "oboe.snd" 0.5 "fmv5.snd")
- (if (or (fneq (cadr (mus-sound-maxamp "fmv5.snd")) 0.25)
- (fneq (cadddr (mus-sound-maxamp "fmv5.snd")) 0.5))
- (snd-display #__line__ ";convolve-files stereo: ~A" (mus-sound-maxamp "fmv5.snd")))
- (delete-file "fmv5.snd")
- (scale-to .25 ind1)
- (set! (y-bounds ind1) '())
- (if (not (equal? (y-bounds ind1) (list -.25 .25)))
- (snd-display #__line__ ";y-bounds '(): ~A?" (y-bounds ind1)))
- (revert-sound ind1)
-
- (scale-to 1.0 ind1)
- (let ((v0 (make-vct 10))
- (v1 (channel->vct 12000 10 ind1 0)))
- (vct-set! v0 5 1.0)
- (array->file "fmv3.snd" v0 10 22050 1)
- (convolve-with "fmv3.snd" 1.0 ind1)
- (convolve-files "fmv4.snd" "fmv3.snd" 1.0 "fmv5.snd")
- (let ((v2 (channel->vct 12005 10 ind1 0)))
- (if (not (vfequal v1 v2))
- (snd-display #__line__ ";~A (orig: 2) ~A ~A" 'convolve-with v1 v2))
- (file->array "fmv5.snd" 0 12005 10 v2)
- (if (not (vfequal v1 v2))
- (snd-display #__line__ ";convolve-files: (orig: 2) ~A ~A" v1 v2)))
- (delete-file "fmv3.snd")
- (delete-file "fmv4.snd")
- (delete-file "fmv5.snd"))
-
- (revert-sound ind1)
- (let ((old-val (selection-creates-region))
- (old-regions (regions)))
- (set! (selection-creates-region) #f)
- (select-all ind1)
- (set! (selection-creates-region) old-val)
- (if (not (equal? old-regions (regions)))
- (snd-display #__line__ ";selection-create-region: ~A -> ~A?" old-regions (regions))))
- (convolve-selection-with "pistol.snd" (maxamp))
- (let ((data (channel->vct 12000 10 ind1 0)))
- (convolve-with "pistol.snd" (maxamp ind1 0 0) ind1 0 0)
- (let ((new-data (channel->vct 12000 10 ind1 0)))
- (if (not (vfequal data new-data))
- (snd-display #__line__ ";convolve-selection-with: ~A ~A?" data new-data))))
- (revert-sound ind1)
- (make-selection 1000 2000 ind1)
- (let ((ma (maxamp ind1)))
- (convolve-selection-with "pistol.snd" ma)
- (if (fneq (maxamp ind1) ma) (snd-display #__line__ ";convolve-selection-with 1000: ~A ~A?" ma (maxamp ind1))))
- (make-selection 1000 2000 ind1)
- (let ((id (make-region)))
- (if (not (region? id))
- (snd-display #__line__ ";make-region argless: ~A" id))
- (if (not (= (region-frames id 0) (selection-frames)))
- (snd-display #__line__ ";region/selection-frames: ~A ~A (~A)?" (region-frames id 0) (selection-frames) (region-frames id)))
- (if (fneq (region-sample id 0) (sample 1000 ind1))
- (snd-display #__line__ ";region-sample from make-region: ~A ~A?" (region-sample id 0) (sample 1000 ind1))))
- (close-sound ind1))
- (let* ((ind (open-sound "2.snd"))
- (reg (make-region 0 100 ind #t)))
- (if (not (equal? (region-home reg) (list "2.snd" 0 100)))
- (snd-display #__line__ ";make + region-home: ~A" (region-home reg)))
- (if (not (= (region-chans reg) 2))
- (snd-display #__line__ ";make-region chan #t: ~A" (region-chans reg)))
- (close-sound ind))
-
- (let ((ind1 (open-sound "2.snd")))
- (let ((v0 (channel->vct 12000 10 ind1 0))
- (v1 (channel->vct 12000 10 ind1 1)))
- (swap-channels ind1)
- (let ((v2 (channel->vct 12000 10 ind1 0))
- (v3 (channel->vct 12000 10 ind1 1)))
- (if (or (vequal v0 v2)
- (vequal v1 v3))
- (snd-display #__line__ ";swap-channels 0: no change! ~A ~A ~A ~A" v0 v2 v1 v3)))
- (swap-channels ind1)
- (let ((v2 (channel->vct 12000 10 ind1 0))
- (v3 (channel->vct 12000 10 ind1 1)))
- (if (or (not (vequal v0 v2))
- (not (vequal v1 v3)))
- (snd-display #__line__ ";swap-channels 1: ~A ~A ~A ~A" v0 v2 v1 v3)))
- ;; as long as we're here...
- (set! (cursor ind1 0) 100)
- (set! (cursor ind1 1) 200)
- (if (or (not (= (cursor ind1 0) 100))
- (not (= (cursor ind1 1) 200)))
- (snd-display #__line__ ";cursor: ~A ~A?" (cursor ind1 0) (cursor ind1 1)))
- (set! (sync ind1) 1)
- (scale-by (list .5 .25) ind1)
- (scale-by (vct 2.0 4.0) ind1)
- (revert-sound ind1)
- (let ((amps (maxamp ind1 #t)))
- (swap-channels ind1 0 ind1)
- (let ((newamps (maxamp ind1 #t)))
- (if (or (fneq (car amps) (cadr newamps))
- (fneq (cadr amps) (car newamps)))
- (snd-display #__line__ ";swap-channels with cp def: ~A ~A" amps newamps)))
- (swap-channels ind1 1)
- (let ((newamps (maxamp ind1 #t)))
- (if (or (fneq (car amps) (car newamps))
- (fneq (cadr amps) (cadr newamps)))
- (snd-display #__line__ ";swap-channels with cp def 0: ~A ~A" amps newamps))))
- (close-sound ind1)))
-
- (let ((ind1 (open-sound "oboe.snd"))
- (ind2 (open-sound "2.snd")))
- (let ((ups1 (count-matches (lambda (n) (> n .1)) 0 ind1 0))
- (ups2 (let ((count 0))
- (scan-chan (lambda (n)
- (if (> n .1)
- (set! count (+ count 1)))
- #f)
- 0 (frames ind1) ind1 0)
- count)))
- (if (not (= ups1 ups2))
- (snd-display #__line__ ";scan-chan: ~A ~A?" ups1 ups2))
- (set! ups1 (count-matches (lambda (n) (> n .03)) 0 ind2 0))
- (set! ups2 (count-matches (lambda (n) (> n .03)) 0 ind2 1))
- (let ((ups3 (let ((count 0))
- (scan-chan (lambda (n)
- (if (> n .03)
- (set! count (+ count 1)))
- #f)
- 0 (frames ind2) ind2 0)
- count))
- (ups4 (let ((count 0))
- (scan-chan (lambda (n)
- (if (> n .03)
- (set! count (+ count 1)))
- #f)
- 0 (frames ind2) ind2 1)
- count)))
- (if (not (= ups1 ups3))
- (snd-display #__line__ ";2[0] scan-chan: ~A ~A?" ups1 ups3))
- (if (not (= ups2 ups4))
- (snd-display #__line__ ";2[1] scan-chan: ~A ~A?" ups2 ups4))))
- (close-sound ind1)
- (close-sound ind2))
-
- (let* ((ind1 (open-sound "oboe.snd"))
- (len (frames ind1))
- (ctr 0))
- (map-chan (lambda (n)
- (if (= ctr 1) (set! ctr 0) (set! ctr 1))
- (if (= ctr 0)
- (* n 2.0)
- #f))
- 0 (frames ind1) "ignore: cut 2" ind1 0)
- (if (> (frames ind1) (+ (* len 2) 1))
- (snd-display #__line__ ";map-chan cut: ~A ~A?" len (frames ind1)))
- (revert-sound ind1)
- (set! ctr 0)
- (map-chan (lambda (n)
- (set! ctr (+ 1 ctr))
- (if (> ctr 3)
- #t
- n))
- 0 (frames ind1) "ignore: cut none" ind1 0)
- (if (> ctr 4)
- (snd-display #__line__ ";map-chan no-edit count: ~A?" ctr))
- (revert-sound ind1)
- (let ((v1 (make-vct 2)))
- (map-chan (lambda (n)
- (vct-set! v1 0 n)
- (vct-set! v1 1 (* n 3))
- v1)
- 0 (frames ind1) "ignore: cut 2" ind1 0))
- (if (> (abs (- (frames ind1) (* len 2))) 3)
- (snd-display #__line__ ";map-chan double: ~A ~A?" len (frames ind1)))
- (revert-sound ind1)
- (let ((otime (maxamp-position ind1)))
- (set! (sample 1234) .9)
- (let* ((ntime (maxamp-position ind1))
- (nval (maxamp ind1))
- (npos (edit-position ind1 0)))
- (if (not (= ntime 1234)) (snd-display #__line__ ";maxamp-position 1234: ~A" ntime))
- (let ((ootime (maxamp-position ind1 0 0)))
- (if (not (= ootime otime)) (snd-display #__line__ ";maxamp-position edpos 0: ~A ~A" otime ootime)))
- (let ((nntime (maxamp-position ind1 0 npos)))
- (if (not (= nntime ntime)) (snd-display #__line__ ";maxamp-position edpos ~D: ~A ~A" npos ntime nntime)))
- (if (fneq nval .9) (snd-display #__line__ ";maxamp .9: ~A" nval)))
- (set! (sample 1234) 0.0)
- (env-channel '(0 0 1 1))
- (if (not (= (maxamp-position) 35062)) (snd-display #__line__ ";env-channel maxamp-position: ~A" (maxamp-position)))
- (let ((ootime (maxamp-position ind1 0 0)))
- (if (not (= ootime otime)) (snd-display #__line__ ";maxamp-position edpos 0(1): ~A ~A" otime ootime)))
- (let ((nntime (maxamp-position ind1 0 1)))
- (if (not (= nntime 1234)) (snd-display #__line__ ";maxamp-position edpos 1(1): ~A ~A" 1234 nntime)))
- (let ((nntime (maxamp-position ind1 0 current-edit-position)))
- (if (not (= nntime 35062)) (snd-display #__line__ ";maxamp-position edpos current: ~A ~A" 35062 nntime))))
- (revert-sound ind1)
- (make-selection 24000 25000)
- (if (not (= (selection-maxamp-position) 971))
- (snd-display #__line__ ";selection maxamp position: ~A" (selection-maxamp-position)))
- (let ((reg (make-region 24000 25000)))
- (if (not (= (region-maxamp-position reg) 971))
- (snd-display #__line__ ";region maxamp position: ~A" (region-maxamp-position))))
- (close-sound ind1))
- (let* ((ind1 (open-sound "oboe.snd")))
- (test-edpos maxamp 'maxamp (lambda () (scale-by 2.0 ind1 0)) ind1)
- (test-edpos frames 'frames (lambda () (src-sound 2.0 1.0 ind1 0)) ind1)
- (test-edpos
- (lambda* ((snd 0) (chn 0) (edpos current-edit-position)) (count-matches (lambda (n1) (> n1 .1)) 0 snd chn edpos))
- 'count-matches
- (lambda () (scale-by 2.0 ind1 0))
- ind1)
- (test-edpos
- (lambda* ((snd 0) (chn 0) (edpos current-edit-position)) (find-channel (lambda (n2) (> n2 .1)) 0 snd chn edpos))
- 'find
- (lambda () (delete-samples 0 100 ind1 0))
- ind1)
- (test-edpos
- (lambda* ((snd 0) (chn 0) (edpos current-edit-position))
- (let ((samp 0))
- (scan-chan (lambda (n3)
- (or (> n3 .1)
- (begin
- (set! samp (+ 1 samp))
- #f)))
- 0 (frames snd chn) snd chn edpos)
- samp))
- 'scan-chan
- (lambda () (delete-samples 0 100 ind1 0))
- ind1)
-
- (src-sound 2.0 1.0 ind1 0)
- (undo 1 ind1 0)
-
- (delete-samples 0 10000 ind1 0)
- (save-sound-as "fmv.snd" ind1 :edit-position 0)
- (save-sound-as "fmv1.snd" ind1 :edit-position (lambda (snd chn) 1))
- (let ((var (catch #t (lambda () (save-sound-as "fmv2.snd" ind1 :channel 1234)) (lambda args args))))
- (if (not (eq? (car var) 'no-such-channel))
- (snd-display #__line__ ";save-sound-as bad chan: ~A" var)))
- (if (not (= (mus-sound-frames "fmv.snd") (frames ind1 0 0)))
- (snd-display #__line__ ";save-sound-as (edpos): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 0)))
- (if (not (= (mus-sound-frames "fmv1.snd") (frames ind1 0 1)))
- (snd-display #__line__ ";save-sound-as (edpos 1): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 1)))
- (if (= (mus-sound-frames "fmv.snd") (frames ind1 0 1))
- (snd-display #__line__ ";save-sound-as (edpos 1)(2): ~A ~A?" (mus-sound-frames "fmv.snd") (frames ind1 0 1)))
- (let ((ind2 (open-sound "fmv.snd"))
- (ind3 (open-sound "fmv1.snd")))
- (if (not (vequal (channel->vct 12000 10 ind1 0 0) (channel->vct 12000 10 ind2 0)))
- (snd-display #__line__ ";save-sound-as (edpos 3): ~A ~A?" (channel->vct 12000 10 ind1 0 0) (channel->vct 12000 10 ind2 0)))
- (if (not (vequal (channel->vct 12000 10 ind1 0 1) (channel->vct 12000 10 ind3 0)))
- (snd-display #__line__ ";save-sound-as (edpos 4): ~A ~A?" (channel->vct 12000 10 ind1 0 1) (channel->vct 12000 10 ind3 0)))
- (if (vequal (channel->vct 12000 10 ind2 0) (channel->vct 12000 10 ind3 0))
- (snd-display #__line__ ";save-sound-as (edpos 5): ~A ~A?" (channel->vct 12000 10 ind2 0) (channel->vct 12000 10 ind3 0)))
- (select-sound ind3)
- (set! (comment) "hiho")
- (if (not (string=? (comment) "hiho")) (snd-display #__line__ ";set! comment no index: ~A" (comment)))
- (close-sound ind2)
- (close-sound ind3))
- (delete-file "fmv.snd")
- (delete-file "fmv1.snd")
-
- (test-edpos-1 (lambda (snd pos) (reverse-sound snd 0 pos)) 'reverse-sound ind1)
- (test-edpos-1 (lambda (snd pos) (env-sound '(0 0 1 1 2 0) 0 20000 1.0 snd 0 pos)) 'env-sound ind1)
- (test-edpos-1 (lambda (snd pos) (src-sound 0.5 1.0 snd 0 pos)) 'src-sound ind1)
- (test-edpos-1 (lambda (snd pos) (filter-sound (make-fir-filter 6 (list->vct '(.1 .2 .3 .3 .2 .1))) 6 snd 0 pos)) 'filter-sound ind1)
- (test-edpos-1 (lambda (snd pos) (convolve-with "pistol.snd" .5 snd 0 pos)) 'convolve-with ind1)
-
- (let ((ind (new-sound "fmv.snd"))
- (v (make-vct 2000))
- (ctr 0))
- (vct-map! v (lambda ()
- (let ((val (sin (* ctr 2.0 (/ pi 10.0)))))
- (set! ctr (+ 1 ctr))
- val)))
- (vct->channel v 0 2000 ind 0)
- (filter-sound '(0 0 .09 0 .1 1 .11 0 1 0) 1024)
- (if (> (maxamp) .025) (snd-display #__line__ ";filter-sound maxamp 1: ~A" (maxamp)))
- (undo)
- (filter-sound '(0 0 .19 0 .2 1 .21 0 1 0) 1024)
- (if (< (maxamp) .9) (snd-display #__line__ ";filter-sound maxamp 2: ~A" (maxamp)))
- (undo)
- (filter-sound '(0 0 .29 0 .3 1 .31 0 1 0) 1024)
- (if (> (maxamp) .02) (snd-display #__line__ ";filter-sound maxamp 3: ~A" (maxamp)))
-
- (set! (show-sonogram-cursor) #t)
- (set! (with-tracking-cursor) #t)
- (if (not (with-tracking-cursor)) (snd-display #__line__ ";with-tracking-cursor set to #t: ~A" (with-tracking-cursor)))
-
- (set! (transform-graph-type) graph-as-sonogram)
- (play :wait #t)
- (set! (transform-graph?) #t)
-
- (close-sound ind))
- (close-sound ind1))
-
- (let* ((ind (open-sound "oboe.snd"))
- (mx (maxamp ind 0))
- (e0 (channel-amp-envs ind 0)))
-
- (define (peak-env-equal? name index e diff)
- (let* ((reader (make-sampler 0 index 0))
- (e-size (vct-length (car e)))
- (samps-per-bin (ceiling (/ (frames index) e-size)))
- (mins (car e))
- (maxs (cadr e))
- (max-diff 0.0)
- (happy #t))
- (do ((e-bin 0)
- (samp 0 (+ 1 samp))
- (mx -10.0)
- (mn 10.0))
- ((or (not happy) (= e-bin e-size))
- happy)
- (if (>= samp (floor samps-per-bin))
- (let ((mxdiff (abs (- mx (vct-ref maxs e-bin))))
- (mndiff (abs (- mn (vct-ref mins e-bin)))))
- (if (> mxdiff max-diff)
- (set! max-diff mxdiff))
- (if (> mndiff max-diff)
- (set! max-diff mndiff))
- (if (or (> mxdiff diff)
- (> mndiff diff))
- (begin
- (snd-display #__line__ ";~A: peak-env-equal? [bin ~D of ~D]: (~,4F to ~,4F), diff: ~,5F"
- name
- e-bin e-size
- mn mx
- (max mxdiff mndiff))
- (set! happy #f)))
- (set! samp 0)
- (set! mx -10.0)
- (set! mn 10.0)
- (set! e-bin (+ e-bin 1))))
- (let ((val (next-sample reader)))
- (if (< val mn)
- (set! mn val))
- (if (> val mx)
- (set! mx val))))))
-
- (if (null? e0)
- (snd-display #__line__ ";no amp env data")
- (let ((mx1 (vct-peak (car e0)))
- (mx2 (vct-peak (cadr e0))))
- (if (fneq mx (max mx1 mx2))
- (snd-display #__line__ ";amp env max: ~A ~A ~A" mx mx1 mx2))
- (peak-env-equal? "straight peak" ind e0 .0001)
- (scale-by 3.0)
- (let* ((e1 (channel-amp-envs ind 0 1))
- (mx3 (vct-peak (car e1)))
- (mx4 (vct-peak (cadr e1))))
- (if (or (fneq (* 3.0 mx1) mx3)
- (fneq (* 3.0 mx2) mx4))
- (snd-display #__line__ ";3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
- (peak-env-equal? "scaled peak" ind e1 .0001))
- (if (fneq (maxamp ind 0) (* 3 mx))
- (snd-display #__line__ ";maxamp after scale: ~A ~A" mx (maxamp ind 0)))
- (undo)
- (set! (selection-member? #t) #f)
- (set! (selection-member? ind 0) #t)
- (set! (selection-position ind 0) 20000)
- (set! (selection-frames ind 0) 12000)
- (scale-selection-by 3.0)
- (let* ((e1 (channel-amp-envs ind 0 1))
- (mx3 (vct-peak (car e1)))
- (mx4 (vct-peak (cadr e1))))
- (if (or (fneq (* 3.0 mx1) mx3)
- (fneq (* 3.0 mx2) mx4))
- (snd-display #__line__ ";selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
- (if (fneq (maxamp ind 0) (* 3 mx))
- (snd-display #__line__ ";maxamp after selection scale: ~A ~A" mx (maxamp ind 0)))
- (peak-env-equal? "selection peak" ind e1 .0001))
- (map-chan abs 0 #f "test" ind 0)
- (let* ((e1 (channel-amp-envs ind 0 2))
- (mx3 (vct-peak (car e1)))
- (mx4 (vct-peak (cadr e1))))
- (if (fneq (* 3.0 mx2) mx4)
- (snd-display #__line__ ";abs selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
- (if (fneq (maxamp ind 0) (* 3 mx))
- (snd-display #__line__ ";maxamp after abs selection scale: ~A ~A" mx (maxamp ind 0)))
- (if (ffneq mx3 0.03)
- (snd-display #__line__ ";abs max: ~A ~A" mx3 mx4))
- (peak-env-equal? "map-chan peak" ind e1 .0001))
- (delete-samples 10000 5000)
- (let* ((e1 (channel-amp-envs ind 0))
- (mx3 (vct-peak (car e1)))
- (mx4 (vct-peak (cadr e1))))
- (if (fneq (* 3.0 mx2) mx4)
- (snd-display #__line__ ";abs selection 3.0 amp env max: ~A ~A ~A ~A" mx1 mx2 mx3 mx4))
- (if (fneq (maxamp ind 0) (* 3 mx))
- (snd-display #__line__ ";maxamp after abs selection scale: ~A ~A" mx (maxamp ind 0)))
- (if (ffneq mx3 0.03)
- (snd-display #__line__ ";abs max: ~A ~A" mx3 mx4))
- (peak-env-equal? "delete peak" ind e1 .0001))
- (scale-selection-by -.333)
- (let* ((e1 (channel-amp-envs ind 0 4))
- (mx3 (vct-peak (car e1))))
- (if (fneq (maxamp ind 0) mx)
- (snd-display #__line__ ";maxamp after minus abs selection scale: ~A ~A" mx (maxamp ind 0)))
- (if (fneq (maxamp ind 0) mx3)
- (snd-display #__line__ ";mx3 maxamp after minus abs selection scale: ~A ~A" mx mx3))
- (peak-env-equal? "scale-selection peak" ind e1 .0001))
-
- (revert-sound ind)
- (ramp-channel 0.0 1.0)
- (peak-env-equal? "ramp-channel peak" ind (channel-amp-envs ind 0 1) .001)
- (undo)
- (env-channel '(0 0 1 1 2 0))
- (peak-env-equal? "env-channel peak" ind (channel-amp-envs ind 0 1) .002)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 0) :scaler 0.5 :length (frames)))
- (peak-env-equal? "scaled env-channel peak" ind (channel-amp-envs ind 0 1) .002)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 0) 0.5 :length (frames)))
- (peak-env-equal? "scaled nokey env-channel peak" ind (channel-amp-envs ind 0 1) .001)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 0) :scaler 0.5 :offset 0.5 :length (frames)))
- (peak-env-equal? "scaled and offset env-channel peak" ind (channel-amp-envs ind 0 1) .001)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 .5 3 0) :base 0.0 :length (frames)))
- (peak-env-equal? "env-channel base 0.0 peak" ind (channel-amp-envs ind 0 1) .001)
- (undo)
- (xramp-channel 0.0 1.0 32.0)
- (peak-env-equal? "xramp 32.0 peak" ind (channel-amp-envs ind 0 1) .008)
- (undo)
- (xramp-channel 0.0 1.0 .032)
- (peak-env-equal? "xramp .032 peak" ind (channel-amp-envs ind 0 1) .004)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 .5 3 0) :base 10.0 :length (frames)))
- (peak-env-equal? "env-channel base 10.0 peak" ind (channel-amp-envs ind 0 1) .003)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 0) :base .10 :length (frames)))
- (peak-env-equal? "env-channel base .1 peak" ind (channel-amp-envs ind 0 1) .003)
- (undo)
- (ptree-channel (lambda (y) (* y 2)) 0 (frames) ind 0 #f #t)
- (peak-env-equal? "ptree-channel peak" ind (channel-amp-envs ind 0 1) .0001)
- (undo)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 2)) 0 (frames) ind 0 #f #t)
- (peak-env-equal? "ptree+ramp peak" ind (channel-amp-envs ind 0 2) .01)
- (undo 2)
- (xramp-channel 0.0 1.0 3.0)
- (ptree-channel (lambda (y) (* y 2)) 0 (frames) ind 0 #f #t)
- (peak-env-equal? "ptree+xramp peak" ind (channel-amp-envs ind 0 2) .004)
- (undo 2)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (peak-env-equal? "ptree+closure peak" ind (channel-amp-envs ind 0 1) .009)
- (undo)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (peak-env-equal? "ptree+ramp+closure peak" ind (channel-amp-envs ind 0 2) .01)
- (undo 2)
- (xramp-channel 0.0 1.0 3.0)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (peak-env-equal? "ptree+xramp+closure peak" ind (channel-amp-envs ind 0 2) .001)
- (undo 2)
- (insert-samples 1000 5000 (make-vct 5000 .5))
- (peak-env-equal? "insert-samples peak" ind (channel-amp-envs ind 0 1) .0001)
- (undo)
- (set! (samples 500 100) (make-vct 100 .1))
- (peak-env-equal? "set-samples peak" ind (channel-amp-envs ind 0) .0001)
- (undo)
-
- (revert-sound ind)
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0)
- (peak-env-equal? "ramp2 peak" ind (channel-amp-envs ind 0 2) .002)
-
- (revert-sound ind)
- (env-channel '(0 0 1 1))
- (env-channel '(0 0 1 1 2 0))
- (peak-env-equal? "env ramp2 peak" ind (channel-amp-envs ind 0 2) .002)
-
- (revert-sound ind)
- (env-channel '(0 0 1 1))
- (env-channel '(0 0 1 1 2 0))
- (ptree-channel (lambda (y) (* y 2.0)))
- (peak-env-equal? "ptree-ramp20 peak" ind (channel-amp-envs ind 0 3) .0001)
-
- (revert-sound ind)
- (ramp-channel 0.0 1.0 12000 5000)
- (peak-env-equal? "ramp-channel peak" ind (channel-amp-envs ind 0 1) .002)
- (undo)
- (env-channel '(0 0 1 1 2 0) 12000 5000)
- (peak-env-equal? "env-channel peak" ind (channel-amp-envs ind 0 1) .003)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 5000) 12000 5000)
- (peak-env-equal? "scaled env-channel peak" ind (channel-amp-envs ind 0 1) .004)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 0) 0.5 :length 5000) 12000 5000)
- (peak-env-equal? "scaled nokey env-channel peak" ind (channel-amp-envs ind 0 1) .004)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 0) :scaler 0.5 :offset 0.5 :length 5000) 12000 5000)
- (peak-env-equal? "scaled and offset env-channel peak" ind (channel-amp-envs ind 0 1) .002)
- (undo)
- (xramp-channel 0.0 1.0 32.0 2000 1000)
- (peak-env-equal? "xramp 32.0 peak (1)" ind (channel-amp-envs ind 0 1) .009)
- (undo)
- (xramp-channel 0.0 1.0 .032 2000 1000)
- (peak-env-equal? "xramp .032 peak (1)" ind (channel-amp-envs ind 0 1) .009)
- (undo)
- (env-channel (make-env '(0 0 1 1 2 .5 3 0) :base 10.0 :length 5000) 12000 5000)
- (peak-env-equal? "env-channel base 10.0 peak" ind (channel-amp-envs ind 0 1) .1)
- ;; this can be way off because the envelope is not very closely sampled in this case
- (undo)
- (ptree-channel (lambda (y) (* y 2)) 2000 1000 ind 0 #f #t)
- (peak-env-equal? "ptree-channel peak" ind (channel-amp-envs ind 0 1) .0001)
- (undo)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 2)) 2000 1000 ind 0 #f #t)
- (peak-env-equal? "ptree+ramp peak" ind (channel-amp-envs ind 0 2) .001)
- (undo 2)
- (xramp-channel 0.0 1.0 3.0)
- (ptree-channel (lambda (y) (* y 2)) 2000 1000 ind 0 #f #t)
- (peak-env-equal? "ptree+xramp peak" ind (channel-amp-envs ind 0 2) .001)
- (undo 2)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 2000 1000 ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (peak-env-equal? "ptree+closure peak" ind (channel-amp-envs ind 0 1) .0001)
- (undo)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 2000 1000 ind 0 #f #t
- (lambda (pos dur)
- (vct 0.5)))
- (peak-env-equal? "ptree+ramp+closure peak" ind (channel-amp-envs ind 0 2) .001)
-
- (revert-sound ind)
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0 2000 1000)
- (peak-env-equal? "ramp2 peak" ind (channel-amp-envs ind 0 2) .002)
-
- (revert-sound ind)
- (env-channel '(0 0 1 1))
- (env-channel '(0 0 1 1 2 0) 2000 1000)
- (peak-env-equal? "env ramp2 peak" ind (channel-amp-envs ind 0 2) .002)
-
- (revert-sound ind)
- (env-channel '(0 0 1 1))
- (env-channel '(0 0 1 1 2 0))
- (ptree-channel (lambda (y) (* y 2.0)) 2000 1000)
- (peak-env-equal? "ptree-ramp21 peak" ind (channel-amp-envs ind 0 3) .002)
-
- (revert-sound ind)
- (env-channel '(0 0 1 1))
- (env-channel '(0 0 1 1 2 0))
- (env-channel '(0 0 1 1) 12000 5000)
- (peak-env-equal? "ptree-ramp3 peak" ind (channel-amp-envs ind 0 3) .01)
-
- (revert-sound ind)
-
- ))
- (close-sound ind))
-
- ;; ptree-channel init-func state cases
- (let ((ind (new-sound "test.snd" :size 10 :comment "ptree-channel state tests")))
- (set! (sample 5) 1.0)
- (set! (sample 4) -0.5)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val float) (dir boolean))
- (* y val))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- 0.5)
- "ptree channel float arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.250 0.500 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with float state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val int) (dir boolean))
- (* y val))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- 3)
- "ptree channel int arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -1.500 3.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with int state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val boolean) (dir boolean))
- (if val y (* y 100)))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- #t)
- "ptree channel boolean arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with boolean state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val char) (dir boolean))
- (if (char=? val #\f) y (* 10 y)))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- #\f)
- "ptree channel char arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with char state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val string) (dir boolean))
- (if (string=? val "hiho") y (* 10 y)))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- "hiho")
- "ptree channel string arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with string state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val vct) (dir boolean))
- (* y (vct-ref val 0)))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- (make-vct 1 2.0))
- "ptree channel vct arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -1.000 2.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with vct state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val sound-data) (dir boolean))
- (* y (sound-data-ref val 0 0)))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- (let ((sd (make-sound-data 1 2)))
- (sound-data-set! sd 0 0 4.0)
- sd))
- "ptree channel sound-data arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -2.000 4.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with sound-data state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val symbol) (dir boolean))
- (if (eq? val 'hiho) y (* y 100)))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- 'hiho)
- "ptree channel symbol arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with symbol state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val keyword) (dir boolean))
- (if (eq? val :hiho) y (* y 100)))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- :hiho)
- "ptree channel keyword arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with keyword state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
- ;; this works, but can't currently be optimized:
- ;; (ptree-channel (lambda (y val dir)
- ;; (declare (y real) (val list) (dir boolean))
- ;; (* y (car val)))
- ;; 0 10 ind 0 -1 #t
- ;; (lambda (beg dur)
- ;; (list 2.0 100.0)))
- ;; (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -1.000 2.000 0.000 0.000 0.000 0.000)))
- ;; (snd-display #__line__ ";ptree-channel with list state: ~A" (channel->vct 0 10 ind 0)))
- ;; (undo)
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val sampler) (dir boolean))
- (let ((n (read-sample val)))
- (* y n)))
- 0 10 ind 0 -1 #f
- (lambda (beg dur)
- (make-sampler beg ind 0 1 2)) ; beg here is vital! as is "2" for edpos
- "ptree channel sampler arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.250 1.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with reader state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
-
- ;; this can't work because it needs access to previous samples (the generator has internal state)
- ; (ptree-channel (lambda (y val dir)
- ; (declare (y real) (val clm) (dir boolean))
- ; (one-zero val y))
- ; 0 10 ind 0 -1 #t
- ; (lambda (beg dur)
- ; (make-one-zero .5 .5))
- ; "ptree channel clm arg")
- ; (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.250 0.250 0.500 0.000 0.000 0.000)))
- ; (snd-display #__line__ ";ptree-channel with clm state: ~A from ~A"
- ; (channel->vct 0 10 ind 0)
- ; (channel->vct 0 10 ind 0 (- (edit-position ind 0) 1))))
- ; (undo)
- (let ((mx (mix-vct (vct .2 .3 .4) 2 ind 0 #t)))
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val mix-sampler) (dir boolean))
- (let ((n (read-mix-sample val)))
- (+ y n)))
- 0 10 ind 0 -1 #f
- (lambda (beg dur)
- (make-mix-sampler mx beg))
- "ptree channel mix-sampler arg"))
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.200 0.300 0.600 0.300 -0.100 1.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with mix reader state: ~A" (channel->vct 0 10 ind 0)))
- (set! (edit-position ind 0) 2)
-
- ;; now check error handling...
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val vct) (dir boolean))
- (* y 2.0))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- (make-vct 1 2.0))
- "ptree channel vct unrefd arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -1.000 2.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with unrefd vct state: ~A" (channel->vct 0 10 ind 0)))
- (undo)
-
- ;; this does print an error message, but trying to halt execution leads to a segfault
- ;; (let ((tag (catch #t
- ;; (lambda ()
- ;; (ptree-channel (lambda (y val dir)
- ;; (declare (y real) (val float-vector) (dir boolean))
- ;; (* y (vector-ref val 0)))
- ;; 0 10 ind 0 -1 #t
- ;; (lambda (beg dur)
- ;; (make-vector 1 2.0))
- ;; "ptree channel vector arg"))
- ;; (lambda args (car args)))))
- ;; (if (not (eq? tag 'snd-error))
- ;; (snd-display #__line__ ";ptree-channel vector arg: ~A" tag)))
-
- ;; now check 3 ptrees with different types
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val float) (dir boolean))
- (* y val))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- 0.5)
- "ptree channel float arg")
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val int) (dir boolean))
- (* y val))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- 2)
- "ptree channel int arg")
- (ptree-channel (lambda (y val dir)
- (declare (y real) (val boolean) (dir boolean))
- (if val y (* y 100)))
- 0 10 ind 0 -1 #t
- (lambda (beg dur)
- #t)
- "ptree channel boolean arg")
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.000 0.000 0.000 0.000 -0.500 1.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";ptree-channel with 3 states: ~A" (channel->vct 0 10 ind 0)))
-
- (close-sound ind)
- (if (file-exists? "test.snd") (delete-file "test.snd")))
-
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 50000)
- (ramp-channel 0.5 1.0 1000 4000)
- (let* ((peaks (channel-amp-envs ind 0))
- (mx (cadr peaks))
- (mn (car peaks)))
- (call-with-current-continuation
- (lambda (break)
- (if (not (continuation? break)) (snd-display #__line__ ";not a continuation: ~A" break))
- (if (continuation? abs) (snd-display #__line__ ";abs is a continuation?"))
- (if (continuation? open-sound) (snd-display #__line__ ";open-sound is a continuation?"))
- (if (continuation? 32) (snd-display #__line__ ";32 is a continuation?"))
- (if (continuation? (let ((hi 1)) (lambda () hi))) (snd-display #__line__ ";closure is a continuation?"))
- (do ((i 0 (+ 1 i)))
- ((= i (- (vct-length mn) 4)))
- (if (< (vct-ref mn i) 0.5) (begin (snd-display #__line__ ";peak min: ~A ~A" (vct-ref mn i) i) (break #f)))
- (if (< (vct-ref mx i) 0.5) (begin (snd-display #__line__ ";peak max: ~A ~A" (vct-ref mx i) i) (break #f)))))))
- (undo 2)
- (map-chan (lambda (y) -1.0) 0 50000)
- (ramp-channel 0.5 1.0 1000 4000)
- (let* ((peaks (channel-amp-envs ind 0))
- (mx (cadr peaks))
- (mn (car peaks))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy)
- (= i (- (vct-length mn) 4))))
- (if (> (vct-ref mn i) -0.5) (begin (snd-display #__line__ ";1 peak min: ~A ~A" (vct-ref mn i) i) (set! happy #f)))
- (if (> (vct-ref mx i) -0.5) (begin (snd-display #__line__ ";1 peak max: ~A ~A" (vct-ref mx i) i) (set! happy #f)))))
- (close-sound ind))
-
- (let ((index (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "channel tests")))
- (define (test-channel-func func val-func init-val)
- (let* ((len (frames index))
- (chns (chans index))
- (val #f))
- (set! g-init-val init-val)
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (set! val (val-func len))
- (set! (sync index) k)
- (do ((i 0 (+ 1 i)))
- ((= i chns))
- (map-channel (lambda (n) 0.0) 0 len index i)
- (if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index i)
- (snd-display #__line__ ";init scan: ~A?" (scan-channel (lambda (n) (> (abs n) 0.001))))))
- ;; now it's cleared
- (do ((i 0 (+ 1 i)))
- ((= i chns))
- (map-channel (lambda (n) g-init-val) 0 len index i)
- (func 0 len index i)
- (do ((j 0 (+ 1 j)))
- ((= j chns))
- (let ((vi (channel->vct 0 len index j)))
- (if (= j i)
- (if (not (vequal vi val))
- (snd-display #__line__ ";chan func: ~A ~A" vi val))
- (if (scan-channel (lambda (n) (> (abs n) .001)) 0 len index j)
- (snd-display #__line__ ";chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
- (map-channel (lambda (n) 0.0) 0 len index i))
- (do ((i 0 (+ 1 i)))
- ((= i chns))
- (map-channel (lambda (n) g-init-val) 0 len index i)
- (let ((ed (edit-position index i)))
- (map-channel (lambda (n) (+ g-init-val 1.0)) 0 len index i)
- (func 0 len index i ed)
- (do ((j 0 (+ 1 j)))
- ((= j chns))
- (let ((vi (channel->vct 0 len index j)))
- (if (= j i)
- (if (not (vequal vi val))
- (snd-display #__line__ ";ed chan func: ~A ~A" vi val))
- (if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
- (snd-display #__line__ ";ed chan func leaks? ~A ~A ~A: ~A" i j ed (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
- (map-channel (lambda (n) 0.0) 0 len index i)))
- (let* ((beg (floor (/ len 3)))
- (dur beg)
- (nv (val-func dur)))
- (vct-fill! val 0.0)
- (do ((i beg (+ 1 i))
- (j 0 (+ 1 j)))
- ((= j dur))
- (vct-set! val i (vct-ref nv j)))
- (do ((i 0 (+ 1 i)))
- ((= i chns))
- (map-channel (lambda (n) g-init-val) beg dur index i)
- (func beg dur index i)
- (add-mark beg index i)
- (do ((j 0 (+ 1 j)))
- ((= j chns))
- (let ((vi (channel->vct 0 len index j)))
- (if (= j i)
- (if (not (vequal vi val))
- (snd-display #__line__ ";chan func n: ~A ~A" vi val))
- (if (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j)
- (snd-display #__line__ ";dur chan func leaks? ~A ~A: ~A" i j (scan-channel (lambda (n) (> (abs n) 0.001)) 0 len index j))))))
- (map-channel (lambda (n) 0.0) 0 len index i))))))
-
- (insert-silence 0 10 index 0)
- (insert-silence 0 10 index 1)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (clm-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos))
- (lambda (dur)
- (let ((e (make-env :envelope '(0 0 1 1) :length dur))
- (v (make-vct dur)))
- (do ((i 0 (+ 1 i)))
- ((= i dur))
- (vct-set! v i (env e)))
- v))
- 0.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (clm-channel (make-oscil :frequency 0.0 :initial-phase (/ pi 2)) beg dur index chan edpos))
- (lambda (dur)
- (let ((v (make-vct dur)))
- (vct-fill! v 1.0)
- v))
- 0.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (scale-channel 0.5 beg dur index chan edpos))
- (lambda (dur)
- (let ((v (make-vct dur)))
- (vct-fill! v 0.5)
- v))
- 1.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (env-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos))
- (lambda (dur)
- (let ((e (make-env :envelope '(0 0 1 1) :length dur))
- (v (make-vct dur)))
- (do ((i 0 (+ 1 i)))
- ((= i dur))
- (vct-set! v i (env e)))
- v))
- 1.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (env-channel '(0 0 1 1) beg dur index chan edpos))
- (lambda (dur)
- (let ((e (make-env :envelope '(0 0 1 1) :length dur))
- (v (make-vct dur)))
- (do ((i 0 (+ 1 i)))
- ((= i dur))
- (vct-set! v i (env e)))
- v))
- 1.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (let ((v (make-vct dur)))
- (vct-fill! v -1.0)
- (vct->channel v beg dur index chan)))
- (lambda (dur)
- (let ((v (make-vct dur)))
- (vct-fill! v -1.0)
- v))
- 1.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (delete-samples beg dur index chan edpos)
- (pad-channel beg dur index chan edpos))
- (lambda (dur)
- (make-vct dur))
- 1.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (let ((v (make-vct dur)))
- (vct-fill! v -1.0)
- (delete-samples beg dur index chan edpos)
- (insert-samples beg dur v index chan edpos)))
- (lambda (dur)
- (let ((v (make-vct dur)))
- (vct-fill! v -1.0)
- v))
- 1.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (let ((v (make-vct dur)))
- (vct-fill! v -1.0)
- (set! (samples beg dur index chan #f "test-channel" 0 edpos) v)))
- (lambda (dur)
- (let ((v (make-vct dur)))
- (vct-fill! v -1.0)
- v))
- 1.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (env-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos)
- (reverse-channel beg dur index chan))
- (lambda (dur)
- (let ((e (make-env :envelope '(0 1 1 0) :length dur))
- (v (make-vct dur)))
- (do ((i 0 (+ 1 i)))
- ((= i dur))
- (vct-set! v i (env e)))
- v))
- 1.0)
-
- (test-channel-func (lambda* (beg dur index chan edpos)
- (env-channel (make-env :envelope '(0 0 1 1) :length dur) beg dur index chan edpos)
- (set! (sample (+ beg dur) index chan) 1.0)
- (smooth-channel beg dur index chan)
- (if (not (= beg 0))
- (set! (sample (+ beg dur) index chan) 0.0)))
- (lambda (dur)
- (let ((v (make-vct dur)))
- (do ((i 0 (+ 1 i)))
- ((= i dur))
- (vct-set! v i (+ 0.5 (* 0.5 (cos (+ pi (/ (* pi i) dur)))))))
- v))
- 1.0)
-
- (let ((old-max (maxamp index #t))
- (regdata (map (lambda (n)
- (region->vct n 0 10))
- (regions)))
- ;; (old-pos0 (edit-position index 0))
- ;; (old-pos1 (edit-position index 1))
- (old-reglen (map region-frames (regions)))
- (s61-files '()))
- (hook-push save-state-hook
- (lambda (file)
- (set! s61-files (cons file s61-files))
- #f))
- (if (file-exists? "s61.scm") (delete-file "s61.scm"))
- (save-state "s61.scm")
- (close-sound index)
- (for-each forget-region (regions))
- (load (string-append cwd "s61.scm"))
- (if (not (equal? old-reglen (map region-frames (regions))))
- (snd-display #__line__ ";region-frames after save: ~A ~A" old-reglen (map region-frames (regions))))
- (for-each (lambda (n data)
- (if (not (vequal data (region->vct n 0 10)))
- (snd-display #__line__ ";region after save ~A: ~A ~A" n data (region->vct n 0 10))))
- (regions)
- regdata)
- (set! index (find-sound "fmv.snd"))
- (if (not (equal? (maxamp index #t) old-max))
- (snd-display #__line__ ";maxes: ~A ~A" (maxamp index #t) old-max))
- (if (not (equal? (edits index) (list 275 0)))
- (snd-display #__line__ ";saved channel edits: ~A" (edits index)))
-
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (let ((pos (random (car (edits index)))))
- (scale-channel (random 2.0) (random 5) (random 5) index 0 pos)
- (set! (edit-position index) (floor (* (car (edits index)) .7)))))
-
- (close-sound index)
- (for-each
- (lambda (n)
- (forget-region n))
- (regions))
- (for-each
- (lambda (file)
- (if (file-exists? file)
- (delete-file file)))
- s61-files)
- (delete-file "s61.scm")
- (set! (hook-functions save-state-hook) '())
- ))
-
- (let ((index (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "channel tests"))
- (v (make-vct 10))
- (sw (sinc-width)))
- (set! (sinc-width) 10)
- (vct-set! v 0 1.0)
- (vct->channel v 0 10 index 0)
- (src-channel 0.5 0 10 index 0)
- (let ((v (make-vct 10))
- (s (make-src :srate 0.5
- :input (let ((val 1.0))
- (lambda (dir)
- (let ((rtn val))
- (set! val 0.0)
- rtn))))))
- (vct-set! v 0 (src s))
- (do ((i 1 (+ 1 i)))
- ((= i 10))
- (vct-set! v i (src s)))
- (if (not (vequal v (channel->vct 0 10 index 0)))
- (snd-display #__line__ ";src-channel: ~A ~A" v (channel->vct 0 10 index 0)))
- (if (not (vequal (make-vct 10) (channel->vct 0 10 index 1)))
- (snd-display #__line__ ";src-channel leaks: ~A" (channel->vct 0 10 index 1)))
- (let ((tag (catch #t (lambda () (src s 1.0 (lambda (a b) a))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity))
- (snd-display #__line__ ";src bad func: ~A" tag))))
- (let ((tag (catch #t (lambda () (src-channel 120000.0)) (lambda args args))))
- (if (not (eq? (car tag) 'mus-error)) (snd-display #__line__ ";src-channel crazy srate: ~A" tag)))
- (let ((tag (catch #t (lambda () (filter-sound (make-snd->sample))) (lambda args args))))
- (if (not (eq? (car tag) 'mus-error)) (snd-display #__line__ ";filter-sound + un-run gen: ~A" tag)))
- (revert-sound index)
- (vct->channel v 0 10 index 1)
- (vct->channel v 10 10 index 1)
- (src-channel (make-env :envelope '(1 1 2 2) :length 21) 0 20 index 1)
- (if (not (vequal (channel->vct 0 10 index 1) (vct 1.000 -0.000 -0.048 0.068 -0.059 0.022 0.030 -0.100 0.273 0.606)))
- (snd-display #__line__ ";src-channel env: ~A" (channel->vct 0 10 index 1)))
- (if (not (vequal (make-vct 10) (channel->vct 0 10 index 0)))
- (snd-display #__line__ ";src-channel env leaks: ~A" (channel->vct 0 10 index 0)))
- (revert-sound index)
- (vct->channel v 0 10 index 1)
- (vct->channel v 10 10 index 1)
- (src-channel '(1 1 2 2) 0 20 index 1) ; end is off above -- should be 19 I think
- (if (not (vequal (channel->vct 0 10 index 1) (vct 1.000 -0.000 -0.051 0.069 -0.056 0.015 0.042 -0.117 0.320 0.568)))
- (snd-display #__line__ ";src-channel lst: ~A" (channel->vct 0 10 index 1)))
- (if (not (vequal (make-vct 10) (channel->vct 0 10 index 0)))
- (snd-display #__line__ ";src-channel lst leaks: ~A" (channel->vct 0 10 index 0)))
- (set! (sinc-width) sw)
- (close-sound index))
-
- (if (< (max-regions) 8) (set! (max-regions) 8))
- (let* ((ind (open-sound "oboe.snd"))
- (rid0 (make-region 2000 2020 ind 0))
- (rid0-data (region2vct rid0 0 20)))
- (scale-sound-by 2.0)
- (play rid0 :wait #t)
- (let ((nv (region2vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display #__line__ ";deferred region after scaling:~% ~A~% ~A" rid0-data nv)))
- (let ((nv (region-to-vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display #__line__ ";deferred region after scaling (rs):~% ~A~% ~A" rid0-data nv)))
- (undo)
- (scale-by 4.0)
- (play rid0 :wait #t)
- (let ((nv (region2vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after scaling:~% ~A~% ~A" rid0-data nv)))
- (let ((nv (region-to-vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after scaling (rs):~% ~A~% ~A" rid0-data nv)))
- (let* ((rid1 (make-region 2000 2020 ind 0))
- (rid1-data (region2vct rid1 0 20)))
- (scale-to .5)
- (let ((nv (region2vct rid1 0 20)))
- (if (not (vequal rid1-data nv)) (snd-display #__line__ ";deferred region after scale-to:~% ~A~% ~A" rid1-data nv)))
- (close-sound ind)
- (play rid0 :wait #t)
- (play rid1 :wait #t)
- (let ((nv (region2vct rid1 0 20)))
- (if (not (vequal rid1-data nv)) (snd-display #__line__ ";deferred region after close:~% ~A~% ~A" rid1-data nv)))
- (let ((nv (region2vct rid0 0 20)))
- (if (not (vequal rid0-data nv)) (snd-display #__line__ ";file region after close:~% ~A~% ~A" rid0-data nv))))
-
- (for-each
- (lambda (s1 l1 s2 l2)
- (set! ind (open-sound "2.snd"))
- (set! (selection-member? #t) #f)
- (set! (selection-member? ind 0) #t)
- (set! (selection-position ind 0) s1)
- (set! (selection-frames ind 0) l1)
- (set! (selection-member? ind 1) #t)
- (set! (selection-position ind 1) s2)
- (set! (selection-frames ind 1) l2)
- (let* ((rid2 (make-region))
- (rid20-data (region2vct rid2 0 l1))
- (rid21-data (region2vct rid2 1 l2)))
- (if (not (= (region-chans rid2) 2)) (snd-display #__line__ ";region-chans of sync'd sound: ~A?" (region-chans rid2)))
- (swap-channels ind 0 ind 1)
- (let ((nv (region2vct rid2 0 l1)))
- (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20):~% ~A~% ~A" rid20-data nv)))
- (let ((nv (region-to-vct rid2 0 l1)))
- (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20 rs):~% ~A~% ~A" rid20-data nv)))
- (let ((nv (region2vct rid2 1 l2)))
- (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21):~% ~A~% ~A" rid21-data nv)))
- (let ((nv (region-to-vct rid2 1 l2)))
- (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21 rs):~% ~A~% ~A" rid21-data nv)))
- (close-sound ind)
- (let ((nv (region2vct rid2 0 l1)))
- (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20):~% ~A~% ~A" rid20-data nv)))
- (let ((nv (region-to-vct rid2 0 l1)))
- (if (not (vequal rid20-data nv)) (snd-display #__line__ ";deferred region after scaling (20 rs):~% ~A~% ~A" rid20-data nv)))
- (let ((nv (region2vct rid2 1 l2)))
- (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21):~% ~A~% ~A" rid21-data nv)))
- (let ((nv (region-to-vct rid2 1 l2)))
- (if (not (vequal rid21-data nv)) (snd-display #__line__ ";deferred region after scaling (21 rs):~% ~A~% ~A" rid21-data nv)))
- ))
- (list 2000 2000 2000 0 2000 0 2000)
- (list 20 10 20 20 20 10 20)
- (list 2000 2000 2000 2000 0 2000 0)
- (list 20 20 10 20 20 20 10)))
-
- (let ((ind (open-sound "obtest.snd")))
- (set! (read-only ind) #t)
- (delete-samples 0 1000 ind 0)
- (let ((val (catch #t
- (lambda ()
- (save-sound ind))
- (lambda args args))))
- (if (sound? val) (snd-display #__line__ ";save-sound read-only: ~A" val))
- (if (not (equal? (edits ind) (list 1 0))) (snd-display #__line__ ";read-only ignored? ~A" (edits ind))))
- (set! (read-only ind) #f)
- (revert-sound ind)
- (let ((tag (catch #t
- (lambda () (save-sound ind))
- (lambda args args))))
- (if (not (sound? tag)) (snd-display #__line__ ";save-sound read-write: ~A" tag)))
- (key (char->integer #\j) 4)
- (if with-gui
- (let ((str (widget-text (list-ref (sound-widgets ind) 3))))
- (if (and (not (string=? str "no marks"))
- (not (string=? str "no such mark")))
- (snd-display #__line__ ";C-j w/o marks: ~A?" str))))
- (key (char->integer #\-) 4)
- (key (char->integer #\j) 4)
- (key (char->integer #\j) 4)
- (key (char->integer #\x) 4)
- (key (char->integer #\c) 0)
- (if with-gui
- (let ((str (widget-text (list-ref (sound-widgets ind) 3))))
- (if (widget-text (cadr (main-widgets)))
- (snd-display #__line__ ";widget-text of non-text widget: ~A" (widget-text (cadr (main-widget)))))
- (set! (widget-text (list-ref (channel-widgets ind 0) 2)) "F")
- (if (not (string=? (widget-text (list-ref (channel-widgets ind 0) 2)) "F"))
- (snd-display #__line__ ";set button label to F: ~A" (widget-text (list-ref (channel-widgets ind 0) 2)) "F"))
- (if (and (not (string=? str "no marks"))
- (not (string=? str "no such mark")))
- (snd-display #__line__ ";C-x c w/o marks: ~A?" str))))
- (add-mark 123)
- (key (char->integer #\u) 4)
- (key (char->integer #\6) 4)
- (key (char->integer #\j) 4)
- (if with-gui
- (let ((str (widget-text (list-ref (sound-widgets ind) 3))))
- (if (not (string=? str "no such mark"))
- (snd-display #__line__ ";C-u 6 C-j: ~A?" str))))
- (key (char->integer #\u) 4)
- (key (char->integer #\6) 4)
- (key (char->integer #\x) 4)
- (key (char->integer #\c) 0)
- (if with-gui
- (let ((str (widget-text (list-ref (sound-widgets ind) 3))))
- (if (not (string=? str "no such mark"))
- (snd-display #__line__ ";C-u 6 C-x c: ~A?" str))))
- (close-sound ind))
-
- (let ((ns (new-sound))
- (v (make-vct 1000)))
- (unselect-all)
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (set! (v i) (* .001 i)))
- (vct->channel v 0 1000 ns 0)
- (set! (selection-member? ns 0) #t)
- (set! (selection-position ns 0) 200)
- (set! (selection-frames ns 0) 300)
- (delete-selection-and-smooth)
- (if (not (= (frames ns 0) 700))
- (snd-display #__line__ ";delete-selection-and-smooth frames: ~A" (frames ns 0)))
- (if (fneq (sample 167 ns 0) 0.167)
- (snd-display #__line__ ";delete-selection-and-smooth 167: ~A" (sample 167 ns 0)))
- (if (fneq (sample 234 ns 0) 0.534)
- (snd-display #__line__ ";delete-selection-and-smooth 234: ~A" (sample 234 ns 0)))
- (if (fneq (sample 210 ns 0) 0.406)
- (snd-display #__line__ ";delete-selection-and-smooth 210: ~A" (sample 210 ns 0)))
- (let* ((v1 (channel->vct))
- (maxdiff 0.0)
- (mindiff 10.0)
- (ls (v1 0)))
- (do ((i 1 (+ i 1)))
- ((= i 700))
- (let ((diff (- (v1 i) ls)))
- (set! ls (v1 i))
- (if (> diff maxdiff) (set! maxdiff diff))
- (if (< diff mindiff) (set! mindiff diff))))
- (if (< mindiff .0009)
- (snd-display #__line__ ";delete-selection-and-smooth min diff: ~A" mindiff))
- (if (> maxdiff .007)
- (snd-display #__line__ ";delete-selection-and-smooth max diff: ~A" maxdiff)))
- (close-sound ns))
-
- (let ((ns (new-sound))
- (v (make-vct 1000)))
- (do ((i 0 (+ i 1)))
- ((= i 1000))
- (set! (v i) (* .001 i)))
- (vct->channel v 0 1000 ns 0)
- (delete-samples-and-smooth 200 300 ns 0)
- (if (not (= (frames ns 0) 700))
- (snd-display #__line__ ";delete-samples-and-smooth frames: ~A" (frames ns 0)))
- (if (fneq (sample 167 ns 0) 0.167)
- (snd-display #__line__ ";delete-samples-and-smooth 167: ~A" (sample 167 ns 0)))
- (if (fneq (sample 234 ns 0) 0.534)
- (snd-display #__line__ ";delete-samples-and-smooth 234: ~A" (sample 234 ns 0)))
- (if (fneq (sample 210 ns 0) 0.406)
- (snd-display #__line__ ";delete-samples-and-smooth 210: ~A" (sample 210 ns 0)))
- (let* ((v1 (channel->vct))
- (maxdiff 0.0)
- (mindiff 10.0)
- (ls (v1 0)))
- (do ((i 1 (+ i 1)))
- ((= i 700))
- (let ((diff (- (v1 i) ls)))
- (set! ls (v1 i))
- (if (> diff maxdiff) (set! maxdiff diff))
- (if (< diff mindiff) (set! mindiff diff))))
- (if (< mindiff .0009)
- (snd-display #__line__ ";delete-samples-and-smooth min diff: ~A" mindiff))
- (if (> maxdiff .007)
- (snd-display #__line__ ";delete-samples-and-smooth max diff: ~A" maxdiff)))
- (close-sound ns))
-
- (let ((old-beg (initial-beg))
- (old-dur (initial-dur))
- (old-show (show-full-duration))
- (old-hook (hook-functions initial-graph-hook)))
- (set! (hook-functions initial-graph-hook) '())
- (set! (show-full-duration) #t)
- (let ((ns (open-sound "1.snd")))
- (let ((ls (left-sample ns 0))
- (rs (right-sample ns 0))
- (fr (frames ns 0)))
- (if (not (equal? (list fr ls rs) '(220501 0 220501)))
- (snd-display #__line__ ";show-full-duration 1: ~A" (list fr ls rs)))
- (close-sound ns)))
- (set! (show-full-duration) #t)
- (set! (initial-beg) 0.0)
- (set! (initial-dur) 0.2)
- (let ((ns (open-sound "1.snd")))
- (let ((ls (left-sample ns 0))
- (rs (right-sample ns 0))
- (fr (frames ns 0)))
- (if (not (equal? (list fr ls rs) '(220501 0 220501)))
- (snd-display #__line__ ";show-full-duration 2: ~A" (list fr ls rs)))
- (close-sound ns)))
- (set! (show-full-duration) #f)
- (set! (initial-beg) 0.0)
- (set! (initial-dur) 0.2)
- (let ((ns (open-sound "1.snd")))
- (let ((ls (left-sample ns 0))
- (rs (right-sample ns 0))
- (fr (frames ns 0)))
- (if (not (equal? (list fr ls rs) '(220501 0 4410)))
- (snd-display #__line__ ";show-full-duration 3: ~A" (list fr ls rs)))
- (close-sound ns)))
- (set! (initial-beg) 2.0)
- (set! (initial-dur) 1.0)
- (let ((ns (open-sound "1.snd")))
- (let ((ls (left-sample ns 0))
- (rs (right-sample ns 0))
- (fr (frames ns 0)))
- (if (not (equal? (list fr ls rs) '(220501 44100 66150)))
- (snd-display #__line__ ";show-full-duration 4: ~A" (list fr ls rs)))
- (close-sound ns)))
- (set! (initial-beg) old-beg)
- (set! (initial-dur) old-dur)
- (set! (show-full-duration) old-show)
- (set! (hook-functions initial-graph-hook) old-hook))
-
- (let ((old-sync (sync-style)))
- (set! (sync-style) sync-none)
- (let ((ns (open-sound "2.snd")))
- (if (not (= (sync ns) 0))
- (snd-display #__line__ ";sync-none open: ~A" (sync ns)))
- (set! (sync ns) 1)
- (set! (sync-style) sync-by-sound)
- (let ((ns1 (open-sound "1a.snd")))
- (if (or (= (sync ns1) 0)
- (= (sync ns1) 1)
- (not (= (sync ns) 1)))
- (snd-display #__line__ ";sync-by-sound open: ~A" (list (sync ns) (sync ns1))))
- (close-sound ns1))
- (close-sound ns))
- (set! (sync-style) sync-all)
- (let ((ns (open-sound "2.snd"))
- (ns1 (open-sound "1a.snd")))
- (if (or (not (= (sync ns) (sync ns1)))
- (= (sync ns) 0))
- (snd-display #__line__ ";sync-all open: ~A" (list (sync ns) (sync ns1))))
- (set! (sync-style) sync-none)
- (let ((ns2 (open-sound "oboe.snd")))
- (if (or (not (= (sync ns) (sync ns1)))
- (not (= (sync ns2) 0)))
- (snd-display #__line__ ";back to sync-none open: ~A" (list (sync ns) (sync ns1) (sync ns2))))
- (close-sound ns2))
- (close-sound ns1)
- (close-sound ns))
- (set! (sync-style) old-sync))
-
- (let ((ind (view-sound "obtest.snd")))
- (delete-samples 0 1000 ind 0)
- (let ((tag (catch #t
- (lambda () (save-sound ind))
- (lambda args args))))
- (if (integer? tag) (snd-display #__line__ ";save-viewed-sound: ~A" tag))
- (if (not (equal? (edits ind) (list 1 0))) (snd-display #__line__ ";view read-only ignored? ~A" (edits ind))))
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1)))
- (insert-silence 0 150000)
- (map-channel (lambda (y) 0.5))
- (env-sound '(0 0 1 1 2 0))
- (fp 1.0 0.3 20)
- (let ((old-curse (with-tracking-cursor)))
- (set! (with-tracking-cursor) #t)
- (play :wait #t)
- (set! (with-tracking-cursor) old-curse))
- (close-sound ind))
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1)))
- (for-each
- (lambda (dur)
- (insert-silence 0 dur)
- (map-channel (lambda (y) 1.0))
- (env-sound '(0 0 1 1 2 0))
- (let ((reader (make-sampler (- (frames) 1) ind 0 -1)))
- (if (not (= (sampler-position reader) (- (frames) 1))) (snd-display #__line__ ";sampler-position: ~A" (sampler-position reader)))
- (map-channel (lambda (y) (read-sample reader))))
- (scan-channel (let ((pos 0)
- (e (make-env '(0 0 1 1 2 0) :length (+ 1 dur))))
- (lambda (y)
- (let ((val (env e)))
- (if (fneq val y)
- (begin
- (display (format #f "~%;trouble in reverse read at ~D ~A ~A" pos val y))
- #t)
- (begin
- (set! pos (+ 1 pos))
- #f))))))
- (revert-sound))
- (list 150 1500 150000))
- (close-sound ind))
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1)))
- (insert-silence 0 1000)
- (map-channel (lambda (y) 1.0))
- (env-sound '(0 0 1 1 2 0))
- (scale-channel 0.0 100 200)
- (let ((reader (make-sampler (- (frames) 1) ind 0 -1)))
- (map-channel (lambda (y) (read-sample reader))))
- (scan-channel (let ((pos 0)
- (e (make-env '(0 0 1 1 2 0) :length 1001)))
- (lambda (y)
- (let ((val (env e)))
- (if (or (and (or (> pos 900) (<= pos 700))
- (fneq val y))
- (and (> pos 700) (<= pos 900)
- (fneq y 0.0)))
- (begin
- (display (format #f "~%;trouble in reverse read 2 at ~D ~A ~A" pos val y))
- #t)
- (begin
- (set! pos (+ 1 pos))
- #f))))))
- (close-sound ind))
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1)))
- (insert-silence 0 150000)
- (map-channel (lambda (y) 1.0))
- (let ((edpos (edit-position)))
- (do ((i 0 (+ 1 i)))
- ((= i 7))
- (if (= i 5)
- (scale-channel 0.5 1000 12345))
- (env-sound '(0 0 1 1 2.5 0 3 1 4 0))
- (if (= i 1)
- (delete-samples 50 100)
- (if (= i 2)
- (insert-samples 300 100 (vct-fill! (make-vct 100) 0.5))
- (if (= i 3)
- (scale-channel 0.0 1000 1000)
- (if (= i 4)
- (vct->channel (vct-fill! (make-vct 100) .5) 500 100)
- (if (= i 6)
- (env-sound '(0 1 1 0) 10000 2000))))))
- (let ((reader (make-sampler (- (frames) 1) ind 0 -1)))
- (map-channel (lambda (y) (read-sample reader))))
- (let ((reader (make-sampler (- (frames) 1) ind 0 -1)))
- (map-channel (lambda (y) (read-sample reader))))
- (scan-channel (let ((old-reader (make-sampler 0 ind 0 1 (- (edit-position ind 0) 2)))
- (pos 0))
- (lambda (y)
- (let ((val (read-sample old-reader)))
- (if (fneq y val)
- (begin
- (display (format #f "~%;trouble in reverse (~D) read at ~D ~A ~A" i pos val y))
- #t)
- (begin
- (set! pos (+ 1 pos))
- #f))))))
- (set! (edit-position ind 0) edpos)))
- (close-sound ind))
- (let ((reader #f)
- (last-proc #f))
- (define (scan-again)
- (if (sampler-at-end? reader)
- #f
- (let ((val (last-proc (reader))))
- (if val
- (list val (- (sampler-position reader) 1))
- (scan-again)))))
- (define* (my-scan-chan proc)
- (if proc
- (begin
- (set! last-proc proc)
- (set! reader (make-sampler 0))))
- (scan-again))
- (let ((ind (open-sound "oboe.snd"))
- (val #f))
- (let ((samp (sample 1000)))
- (set! (cursor ind 0) 1000)
- (if (fneq (sample) samp)
- (snd-display #__line__ ";sample no args: ~A ~A" (sample) samp)))
- (set! val (my-scan-chan (lambda (y) (> y .1))))
- (if (not (equal? val (list #t 4423)))
- (snd-display #__line__ ";my-scan-chan: ~A" val))
- (set! val (scan-again))
- (if (not (equal? val (list #t 4463)))
- (snd-display #__line__ ";scan-again: ~A" val))
- (set! (cursor) 1000)
- (set! (sample) .5)
- (if (fneq (sample 1000) .5)
- (snd-display #__line__ ";set sample no arg: ~A ~A" (sample 1000) (sample 0)))
- (close-sound ind)))
-
- ;; edit-menu.scm tests
- (if (defined? 'selection->new)
- (let ((ind (view-sound "oboe.snd")))
- (make-selection 1000 1999 ind 0)
- (let ((newsnd (selection->new)))
- (if (not (sound? newsnd)) (snd-display #__line__ ";selection->new -> ~A" newsnd))
- (if (not (= (frames newsnd 0) 1000)) (snd-display #__line__ ";selection->new frames: ~A" (frames newsnd 0)))
- (if (not (equal? (edits ind 0) (list 0 0))) (snd-display #__line__ ";selection->new edited original? ~A" (edits ind 0)))
- (let ((newfile (file-name newsnd)))
- (close-sound newsnd)
- (delete-file newfile)
- (mus-sound-forget newfile)))
- (make-selection 1000 1999 ind 0)
- (let ((newsnd (cut-selection->new)))
- (if (not (sound? newsnd)) (snd-display #__line__ ";cut-selection->new -> ~A" newsnd))
- (if (not (= (frames newsnd 0) 1000)) (snd-display #__line__ ";cut-selection->new frames: ~A" (frames newsnd 0)))
- (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";cut-selection->new did not edit original? ~A" (edits ind 0)))
- (if (not (= (frames ind 0) (- (frames ind 0 0) 1000)))
- (snd-display #__line__ ";cut-selection->new cut: ~A ~A" (frames ind 0) (- (frames ind 0 0) 1000)))
- (undo 1 ind 0)
- (let ((newfile (file-name newsnd)))
- (close-sound newsnd)
- (delete-file newfile)
- (mus-sound-forget newfile)))
- (make-selection 1000 1999 ind 0)
- (append-selection)
- (if (not (= (frames ind 0) (+ (frames ind 0 0) 1000)))
- (snd-display #__line__ ";append-selection: ~A ~A" (frames ind 0) (frames ind 0 0)))
- (append-sound "oboe.snd")
- (if (not (= (frames ind 0) (+ (* 2 (frames ind 0 0)) 1000)))
- (snd-display #__line__ ";append-sound: ~A ~A" (frames ind 0) (frames ind 0 0)))
- (revert-sound ind)
- (let ((m1 (add-mark 1000))
- (m2 (add-mark 12000)))
- (trim-front)
- (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";time-front did not edit original? ~A" (edits ind 0)))
- (if (not (= (frames ind 0) (- (frames ind 0 0) 1000)))
- (snd-display #__line__ ";trim-front: ~A ~A" (frames ind 0) (- (frames ind 0 0) 1000)))
- (if (not (= (mark-sample m2) 11000)) (snd-display #__line__ ";trim-front m2: ~A" (mark-sample m2)))
- (undo 1 ind 0)
- (trim-back)
- (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";time-back did not edit original? ~A" (edits ind 0)))
- (if (not (= (frames ind 0) 12001)) (snd-display #__line__ ";trim-back: ~A" (frames ind 0)))
- (if (not (= (mark-sample m1) 1000)) (snd-display #__line__ ";trim-back m1: ~A" (mark-sample m1)))
- (undo 1 ind 0)
- (add-mark 22000)
- (crop)
- (if (not (equal? (edits ind 0) (list 1 0))) (snd-display #__line__ ";crop did not edit original? ~A" (edits ind 0)))
- (if (not (= (frames ind 0) 21001)) (snd-display #__line__ ";crop: ~A" (frames ind 0)))
- (undo 1 ind 0)
- (close-sound ind))))
-
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 1000)
- (env-channel (make-env '(0 1 1 1) :scaler .5 :length 1001))
- (check-maxamp ind .5 "simple scaler")
- (check-env-vals "simple scaler" (make-env '(0 1 1 1) :scaler .5 :length 1001))
- (if (= (edit-position) 2)
- (undo)
- (snd-display #__line__ ";env+scl was no-op"))
- (env-channel (make-env '(0 1 1 1) :offset .5 :length 1001))
- (check-maxamp ind 1.5 "simple offset")
- (check-env-vals "simple offset" (make-env '(0 1 1 1) :offset .5 :length 1001))
- (if (= (edit-position) 2)
- (undo)
- (snd-display #__line__ ";env+offset was no-op"))
- (env-channel (make-env '(0 0 1 1 2 0) :offset .5 :scaler 2.0 :length 1001))
- (check-maxamp ind 2.5 "off+scl")
- (check-env-vals "off+scl" (make-env '(0 0 1 1 2 0) :offset .5 :scaler 2.0 :length 1001))
- (undo)
- (env-channel (make-env '(0 -0.5 1 0 2 -1) :offset .5 :scaler 2.0 :length 1001))
- (check-maxamp ind 1.5 "off+scl #2")
- (let ((mx -12.0))
- (scan-chan (lambda (y)
- (if (> y mx)
- (set! mx y))
- #f))
- (if (fneq mx 0.5) (snd-display #__line__ ";non abs max: ~A (correct: 0.5)" mx)))
- (check-env-vals "off+scl #2" (make-env '(0 -0.5 1 0 2 -1) :offset .5 :scaler 2.0 :length 1001))
- (undo)
- (env-sound '(0 .5 1 .75 2 .25) 0 (frames) 32.0)
- (check-maxamp ind 0.75 "xramp")
- (check-env-vals "xramp" (make-env '(0 .5 1 .75 2 .25) :base 32.0 :length 1001))
- (undo)
- (env-channel-with-base '(0 .5 1 .75 2 .25) 32.0)
- (check-maxamp ind 0.75 "xramp1")
- (check-env-vals "xramp1" (make-env '(0 .5 1 .75 2 .25) :base 32.0 :length 1001))
-
- (close-sound ind))
-
- (let ((hlb (make-hilbert-transform 8))
- (data (make-vct 20)))
- (do ((i 0 (+ 1 i)))
- ((= i 20))
- (vct-set! data i (hilbert-transform hlb (if (= i 0) 1.0 0.0))))
- (if (not (vequal data (vct 0.0 -0.010 0.0 -0.046 0.0 -0.152 0.0 -0.614 0.0 0.614 0.0 0.152 0.0 0.046 0.0 0.010 0.0 0.0 0.0 0.0)))
- (snd-display #__line__ ";hilbert-transform 8 impulse response: ~A" data)))
-
- (let ((hlb (make-hilbert-transform 7))
- (data (make-vct 20)))
- (do ((i 0 (+ 1 i)))
- ((= i 20))
- (vct-set! data i (hilbert-transform hlb (if (= i 0) 1.0 0.0))))
- (if (not (vequal data (vct -0.007 0.0 -0.032 0.0 -0.136 0.0 -0.608 0.0 0.608 0.0 0.136 0.0 0.032 0.0 0.007 0.0 0.0 0.0 0.0 0.0)))
- (snd-display #__line__ ";hilbert-transform 7 impulse response: ~A" data)))
-
- (let ((ind (new-sound "test.snd")))
- (pad-channel 0 1000)
- (set! (sample 100) 1.0)
- (let ((h (make-hilbert-transform 100)))
- (map-channel (lambda (y) (hilbert-transform h y)))
- (map-channel (lambda (y) (hilbert-transform h y)))
- (map-channel (lambda (y) (hilbert-transform h y)))
- (map-channel (lambda (y) (hilbert-transform h y)))
- ;; now ideally we'd be back to an impulse
- (if (> (abs (- (sample 500) .98)) .01)
- (snd-display #__line__ ";hilbert impulse: ~A" (sample 500)))
- (set! (sample 500) 0.0)
- (if (> (maxamp ind 0) .02)
- (snd-display #__line__ ";hilbert sidelobes: ~A" (maxamp ind 0)))
- (scale-channel 0.0)
- (set! (sample 100) 1.0)
- (set! h (make-hilbert-transform 101))
- (map-channel (lambda (y) (hilbert-transform h y)))
- (map-channel (lambda (y) (hilbert-transform h y)))
- (map-channel (lambda (y) (hilbert-transform h y)))
- (map-channel (lambda (y) (hilbert-transform h y)))
- (if (> (abs (- (sample 504) .98)) .01)
- (snd-display #__line__ ";hilbert 101 impulse: ~A: ~A" (sample 504) (channel->vct 498 10)))
- (set! (sample 504) 0.0)
- (if (> (maxamp ind 0) .02)
- (snd-display #__line__ ";hilbert 101 sidelobes: ~A" (maxamp ind 0)))
- (revert-sound))
- (pad-channel 0 1000)
- (set! (sample 100) 1.0)
- (let ((lo (make-lowpass (* .1 pi) 20))
- (hi (make-highpass (* .1 pi) 20)))
- (map-channel (lambda (y) (+ (lowpass lo y) (highpass hi y))))
- (if (fneq (sample 120) 1.0)
- (snd-display #__line__ ";lowpass+highpass impulse: ~A" (sample 120)))
- (set! (sample 120) 0.0)
- (if (fneq (maxamp ind 0) 0.0)
- (snd-display #__line__ ";lowpass+highpass sidelobes: ~A" (maxamp ind 0))))
- (undo 2)
- (let ((lo (make-bandpass (* .1 pi) (* .2 pi) 20))
- (hi (make-bandstop (* .1 pi) (* .2 pi) 20)))
- (map-channel (lambda (y) (+ (bandpass lo y) (bandstop hi y))))
- (if (fneq (sample 120) 1.0)
- (snd-display #__line__ ";bandpass+bandstop impulse: ~A" (sample 120)))
- (set! (sample 120) 0.0)
- (if (fneq (maxamp ind 0) 0.0)
- (snd-display #__line__ ";bandpass+bandstop sidelobes: ~A" (maxamp ind 0))))
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd")))
- (map-channel (lambda (y) (- 1.0 (random 2.0))) 0 10000)
- (let ((f2 (make-bandpass-2 (* .12 pi) (* .15 pi) (* .22 pi) (* .25 pi) 100)))
- (map-channel (lambda (y) (fir-filter f2 y)))
- (let ((data (channel->vct)))
- (undo)
- (let* ((f1 (make-bandpass (* .12 pi) (* .15 pi) 100))
- (f2 (make-bandpass (* .22 pi) (* .25 pi) 100)))
- (map-channel (lambda (y) (+ (fir-filter f1 y) (fir-filter f2 y))))
- (let ((data1 (channel->vct)))
- (vct-subtract! data data1)
- (if (> (vct-peak data) .00001)
- (snd-display #__line__ ";fir-filter 2: ~A" (vct-peak data))))
- (undo))))
- (close-sound ind))
-
- (reset-almost-all-hooks)
-
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "1st ramp re-order tests" 100)))
- (map-channel (lambda (y) 1.0))
- (for-each
- (lambda (lst)
- (let ((name (car lst))
- (try-scale (cadr lst))
- (f1 (caddr lst))
- (f2 (cadddr lst))
- (edpos (edit-position ind 0)))
- (f1)
- (let ((v1 (channel->vct 0 100 ind 0)))
- (set! (edit-position ind 0) edpos)
- (f2)
- (let ((v2 (channel->vct 0 100 ind 0)))
- (if (not (vequal v1 v2))
- (snd-display #__line__ ";env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
- (set! (edit-position ind 0) edpos)))
- (if try-scale
- (begin
- (scale-by 2.0)
- (f1)
- (let ((v1 (channel->vct 0 100 ind 0)))
- (set! (edit-position ind 0) edpos)
- (f2)
- (scale-by 2.0)
- (let ((v2 (channel->vct 0 100 ind 0)))
- (if (not (vequal v1 v2))
- (snd-display #__line__ ";scaled (2) env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
- (set! (edit-position ind 0) edpos)))
- (f1)
- (scale-by .5)
- (let ((v1 (channel->vct 0 100 ind 0)))
- (set! (edit-position ind 0) edpos)
- (scale-by .5)
- (f2)
- (let ((v2 (channel->vct 0 100 ind 0)))
- (if (not (vequal v1 v2))
- (snd-display #__line__ ";scaled (.5) env reordering test ~A:~%; ~A~%; ~A" name v1 v2))
- (set! (edit-position ind 0) edpos)))))))
-
- (list (list "ramp-xramp" #t
- (lambda ()
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1) 0 100 2.0))
- (lambda ()
- (env-sound '(0 0 1 1) 0 100 2.0)
- (env-sound '(0 0 1 1 2 0))))
- (list "ramp2-xramp (1)" #t
- (lambda ()
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1 3 0))
- (env-sound '(0 0 1 1) 0 100 2.0))
- (lambda ()
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1) 0 100 2.0)
- (env-sound '(0 0 1 1 3 0))))
- (list "ramp2-xramp (2)" #t
- (lambda ()
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 3 0) 0 100 2.0))
- (lambda ()
- (env-sound '(0 0 1 1 3 0) 0 100 2.0)
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1))))
- (list "xramp2-ramp (1)" #t
- (lambda ()
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 3 0) 0 100 3.0))
- (lambda ()
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (env-sound '(0 0 1 1 3 0) 0 100 3.0)
- (env-sound '(0 0 1 1))))
- (list "xramp2-ramp (2)" #t
- (lambda ()
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (env-sound '(0 0 1 1 3 0))
- (env-sound '(0 0 1 1) 0 100 3.0))
- (lambda ()
- (env-sound '(0 0 1 1 3 0))
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (env-sound '(0 0 1 1) 0 100 3.0)))
- (list "ptree-ramp" #t
- (lambda ()
- (env-sound '(0 0 1 1))
- (ptree-channel (lambda (y) (* y 2.0))))
- (lambda ()
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1))))
- (list "ptree-xramp" #t
- (lambda ()
- (env-sound '(0 0 1 1) 0 100 2.0)
- (ptree-channel (lambda (y) (* y 2.0))))
- (lambda ()
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1) 0 100 2.0)))
- (list "ptree-ramp2 (1)" #t
- (lambda ()
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0)))
- (lambda ()
- (env-sound '(0 0 1 1))
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1 2 0))))
- (list "ptree-ramp2 (2)" #t
- (lambda ()
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0)))
- (lambda ()
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0))
- (ptree-channel (lambda (y) (* y 2.0)))))
- (list "xramp-ptree-ramp (1)" #t
- (lambda ()
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1)))
- (lambda ()
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (env-sound '(0 0 1 1))))
- (list "xramp-ptree-ramp (2)" #t
- (lambda ()
- (env-sound '(0 0 1 1))
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1 2 0) 0 100 2.0))
- (lambda ()
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (env-sound '(0 0 1 1))
- (ptree-channel (lambda (y) (* y 2.0)))))
- (list "xramp-ptree-ramp (3)" #t
- (lambda ()
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0) 0 100 2.0))
- (lambda ()
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (ptree-channel (lambda (y) (* y 2.0)))))
- (list "xramp-ptree-ramp-zero" #f
- (lambda ()
- (scale-by 0.0)
- (ptree-channel (lambda (y) 1.0))
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0) 0 100 2.0))
- (lambda ()
- (scale-by 0.0)
- (ptree-channel (lambda (y) 1.0))
- (env-sound '(0 0 1 1 2 0) 0 100 2.0)
- (env-sound '(0 0 1 1))))
- (list "ptree-ramp3 (1)" #t
- (lambda ()
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1 3 0)))
- (lambda ()
- (env-sound '(0 0 1 1))
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1 3 0))))
- (list "ptree-ramp3 (2)" #t
- (lambda ()
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0))
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-sound '(0 0 1 1 3 0)))
- (lambda ()
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1 3 0))
- (ptree-channel (lambda (y) (* y 2.0)))))
- (list "ramp4" #t
- (lambda ()
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1 3 0))
- (env-sound '(0 0 1 1 4 0)))
- (lambda ()
- (env-sound '(0 0 1 1 4 0))
- (env-sound '(0 0 1 1 2 0))
- (env-sound '(0 0 1 1 3 0))
- (env-sound '(0 0 1 1))))
-
- ))
- (close-sound ind))
-
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "2nd ramp re-order tests" 100))
- (oldopt (optimization)))
-
- (define (reversed-channel->vct start dur snd chn)
- (let* ((data (make-vct dur))
- (sf (make-sampler (+ start dur -1) snd chn -1)))
- (do ((i (+ start dur -1) (- i 1)))
- ((< i start))
- (vct-set! data i (read-sample sf)))
- data))
-
- (if (and (provided? 'snd-motif)
- (provided? 'xm))
- (let* ((edhist (list-ref (channel-widgets ind 0) 7))
- (edp (XtParent edhist))
- (pmax (cadr (XtVaGetValues edp (list XmNpaneMaximum 0)))))
- (XtUnmanageChild edp)
- (XtVaSetValues edp (list XmNpaneMinimum 100))
- (XtManageChild edp)))
-
- (set! (squelch-update ind) #t)
-
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (revert-sound ind)
- (if (= k 0)
- (map-channel (lambda (y) 1.0))
- (begin
- (scale-by 0.0)
- (ptree-channel (lambda (y) 1.0))))
- (let* ((ramp1 (lambda () (env-sound '(0 0 1 1))))
- (ramp2 (lambda () (env-sound '(0 0 1 1 2 0))))
- (ramp3 (lambda () (env-sound '(0 1 1 0 2 0 3 1))))
- (ramp4 (lambda () (env-sound '(0 1 1 0 2 1))))
- (xramp1 (lambda () (env-sound '(0 0 1 1) 0 100 2.0)))
- (xramp2 (lambda () (env-sound '(0 1 1 0 2 0 3 1) 0 100 .6)))
- (ptree1 (lambda () (ptree-channel (lambda (y) (+ y .2)))))
- (ptree2 (lambda () (ptree-channel (lambda (y) (- y .1)))))
- (map1 (lambda () (map-channel (lambda (y) (+ y .2)))))
- (map2 (lambda () (map-channel (lambda (y) (- y .1)))))
- (ops (list ramp1 ramp2 ramp3 xramp1 xramp2 ptree1 ptree2 ramp4))
- (op-names (list "ramp1" "ramp2" "ramp3" "xramp1" "xramp2" "ptree1" "ptree2" "ramp4"))
- (op (lambda (which) ((list-ref ops which))))
- (op-name (lambda (which) (list-ref op-names which)))
- (vals1 #f)
- (vals2 #f)
- (scl 1.0)
- (scalers '())
- (saved-scalers '())
- (edpos (edit-position ind 0)))
-
- (let ((op1 (list 0 3 5))
- (op2 (list 1 4 6)))
- (for-each
- (lambda (first)
- (for-each
- (lambda (second)
- (if (and (not (= first second))
- (let ((val (+ k
- (if (> first 4) 1 0)
- (if (> second 4) 1 0))))
- (not (> val 2))))
- (begin
- (set! scalers '())
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op first)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op second)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (set! vals1 (channel->vct 0 100 ind 0))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals1))
- (snd-display #__line__ ";1 virtual op reversed tests: ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A"
- (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- scalers vals1 rvals
- (vct-peak (vct-subtract! (vct-copy vals1) rvals)))))
- (set! (edit-position ind 0) edpos)
- (set! (optimization) 0)
- (set! scalers (reverse scalers))
- (set! saved-scalers scalers)
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= first 5) (map1) (if (= first 6) (map2) (op first)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= second 5) (map1) (if (= second 6) (map2) (op second)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (set! (optimization) oldopt)
- (set! vals2 (channel->vct 0 100 ind 0))
- (if (not (vequal vals1 vals2))
- (snd-display #__line__ ";1 virtual op tests: ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A at ~A"
- (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- saved-scalers vals1 vals2
- (vct-peak (vct-subtract! (vct-copy vals1) vals2))
- (let* ((pks (vct-subtract! (vct-copy vals1) vals2))
- (pk (abs (vct-ref pks 0)))
- (loc 0))
- (do ((i 1 (+ 1 i)))
- ((= i 100) (list loc (vct-ref pks loc) (vct-ref vals1 loc) (vct-ref vals2 loc)))
- (if (> (abs (vct-ref pks i)) pk)
- (begin
- (set! loc i)
- (set! pk (abs (vct-ref pks i)))))))
- ))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals2))
- (snd-display #__line__ ";1 virtual op reversed tests (2): ~A(~A~A) * ~A:~%; ~A~%; ~A => ~A"
- (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- saved-scalers vals2 rvals
- (vct-peak (vct-subtract! (vct-copy vals2) rvals)))))
- (set! (edit-position ind 0) edpos))))
- op2))
- op1))
- (let ((op1 (list 0 3 5))
- (op2 (list 1 4 6))
- (op3 (list 2 3 4 5 6)))
- (for-each
- (lambda (first)
- (for-each
- (lambda (second)
- (if (not (= first second))
- (for-each
- (lambda (third)
- (if (and (not (= first third))
- (not (= second third))
- (let ((val (+ k
- (if (or (= first 5) (= first 6)) 1 0)
- (if (or (= second 5) (= second 6)) 1 0)
- (if (or (= third 5) (= third 6)) 1 0))))
- (not (> val 2))))
- (begin
- (set! scalers '())
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op first)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op second)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op third)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (set! vals1 (channel->vct 0 100 ind 0))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals1))
- (snd-display #__line__ ";2 virtual op reversed tests: ~A(~A(~A~A)) * ~A:~%; ~A~%; ~A => ~A"
- (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- scalers vals1 rvals
- (vct-peak (vct-subtract! (vct-copy vals1) rvals)))))
- (set! (edit-position ind 0) edpos)
- (set! (optimization) 0)
- (set! scalers (reverse scalers))
- (set! saved-scalers scalers)
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= first 5) (map1) (if (= first 6) (map2) (op first)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= second 5) (map1) (if (= second 6) (map2) (op second)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= third 5) (map1) (if (= third 6) (map2) (op third)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (set! (optimization) oldopt)
- (set! vals2 (channel->vct 0 100 ind 0))
- (if (not (vequal vals1 vals2))
- (snd-display #__line__ ";2 virtual op tests: ~A * ~A(~A(~A~A)): ~A ~A => ~A at ~A"
- saved-scalers (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- vals1 vals2
- (vct-peak (vct-subtract! (vct-copy vals1) vals2))
- (let* ((pks (vct-subtract! (vct-copy vals1) vals2))
- (pk (abs (vct-ref pks 0)))
- (loc 0))
- (do ((i 1 (+ 1 i)))
- ((= i 100) (list loc (vct-ref pks loc) (vct-ref vals1 loc) (vct-ref vals2 loc)))
- (if (> (abs (vct-ref pks i)) pk)
- (begin
- (set! loc i)
- (set! pk (abs (vct-ref pks i)))))))
- ))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals2))
- (snd-display #__line__ ";2 virtual op reversed tests (2): ~A(~A(~A~A)) * ~A:~%; ~A~%; ~A => ~A"
- (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- saved-scalers vals2 rvals
- (vct-peak (vct-subtract! (vct-copy vals2) rvals)))))
- (set! (edit-position ind 0) edpos))))
- op3)))
- op2))
- op1))
- (let ((op1 (list 0 3 5))
- (op2 (list 0 1 3 4 5 6))
- (op3 (list 0 1 2 3 4 5 6))
- (op4 (list 0 1 2 3 4 5 6)))
- (for-each
- (lambda (first)
- (for-each
- (lambda (second)
- (if (not (= first second))
- (for-each
- (lambda (third)
- (if (and (not (= first third))
- (not (= second third)))
- (for-each
- (lambda (fourth)
- (if (and (not (= first fourth))
- (not (= second fourth))
- (not (= third fourth))
- (let ((val (+ k
- (if (or (= first 5) (= first 6)) 1 0)
- (if (or (= second 5) (= second 6)) 1 0)
- (if (or (= third 5) (= third 6)) 1 0)
- (if (or (= fourth 5) (= fourth 6)) 1 0))))
- (not (> val 2))))
- (begin
- (set! scalers '())
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op first)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op second)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op third)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op fourth)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (set! vals1 (channel->vct 0 100 ind 0))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals1))
- (snd-display #__line__ ";3 virtual op reversed tests: ~A(~A(~A(~A~A))) * ~A:~%; ~A~%; ~A => ~A"
- (op-name fourth) (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- scalers vals1 rvals
- (vct-peak (vct-subtract! (vct-copy vals1) rvals)))))
- (set! (edit-position ind 0) edpos)
- (set! (optimization) 0)
- (set! scalers (reverse scalers))
- (set! saved-scalers scalers)
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= first 5) (map1) (if (= first 6) (map2) (op first)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= second 5) (map1) (if (= second 6) (map2) (op second)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= third 5) (map1) (if (= third 6) (map2) (op third)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= fourth 5) (map1) (if (= fourth 6) (map2) (op fourth)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (set! (optimization) oldopt)
- (set! vals2 (channel->vct 0 100 ind 0))
- (if (not (vequal vals1 vals2))
- (snd-display #__line__ ";3 virtual op tests: ~A * ~A(~A(~A(~A~A))):~% opt vals: ~A~% unopt vals: ~A~% => ~A at ~A"
- saved-scalers
- (op-name fourth) (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- vals1 vals2
- (vct-peak (vct-subtract! (vct-copy vals1) vals2))
- (let* ((pks (vct-subtract! (vct-copy vals1) vals2))
- (pk (abs (vct-ref pks 0)))
- (loc 0))
- (do ((i 1 (+ 1 i)))
- ((= i 100) (list loc (vct-ref pks loc) (vct-ref vals1 loc) (vct-ref vals2 loc)))
- (if (> (abs (vct-ref pks i)) pk)
- (begin
- (set! loc i)
- (set! pk (abs (vct-ref pks i)))))))
- ))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals2))
- (snd-display #__line__ ";3 virtual op reversed tests (2): ~A(~A(~A(~A~A))) * ~A: ~A ~A => ~A"
- (op-name fourth) (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- saved-scalers vals2 rvals
- (vct-peak (vct-subtract! (vct-copy vals2) rvals)))))
- (set! (edit-position ind 0) edpos))))
- op4)))
- op3)))
- op2))
- op1))
-
- (if all-args
- (let ((op1 (list 0 3 5))
- (op2 (list 0 1 3 4 5 6))
- (op3 (list 0 1 2 3 4 5 6))
- (op4 (list 0 1 2 3 4 5 6 7))
- (op5 (list 7 3 5)))
- (for-each
- (lambda (first)
- (for-each
- (lambda (second)
- (if (not (= first second))
- (for-each
- (lambda (third)
- (if (and (not (= first third))
- (not (= second third)))
- (for-each
- (lambda (fourth)
- (if (and (not (= first fourth))
- (not (= second fourth))
- (not (= third fourth)))
- (for-each
- (lambda (fifth)
- (if (and (not (= first fifth))
- (not (= second fifth))
- (not (= third fifth))
- (not (= fourth fifth))
- (let ((val (+ k
- (if (or (= first 5) (= first 6)) 1 0)
- (if (or (= second 5) (= second 6)) 1 0)
- (if (or (= third 5) (= third 6)) 1 0)
- (if (or (= fourth 5) (= fourth 6)) 1 0)
- (if (or (= fifth 5) (= fifth 6)) 1 0))))
- (not (> val 2))))
- (begin
- (set! scalers '())
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op first)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op second)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op third)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op fourth)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op fifth)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (set! vals1 (channel->vct 0 100 ind 0))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals1))
- (snd-display #__line__ ";4 virtual op reversed tests: ~A(~A(~A(~A(~A~A)))) * ~A: ~A ~A => ~A"
- (op-name fifth) (op-name fourth) (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- scalers vals1 rvals
- (vct-peak (vct-subtract! (vct-copy vals1) rvals)))))
- (set! (edit-position ind 0) edpos)
- (set! (optimization) 0)
- (set! scalers (reverse scalers))
- (set! saved-scalers scalers)
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= first 5) (map1) (if (= first 6) (map2) (op first)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= second 5) (map1) (if (= second 6) (map2) (op second)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= third 5) (map1) (if (= third 6) (map2) (op third)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= fourth 5) (map1) (if (= fourth 6) (map2) (op fourth)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= fifth 5) (map1) (if (= fifth 6) (map2) (op fifth)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (set! (optimization) oldopt)
- (set! vals2 (channel->vct 0 100 ind 0))
- (if (not (vequal vals1 vals2))
- (snd-display #__line__ ";4 virtual op tests: ~A * ~A(~A(~A(~A(~A~A)))): ~A ~A => ~A at ~A"
- saved-scalers
- (op-name fifth) (op-name fourth) (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- vals1 vals2
- (vct-peak (vct-subtract! (vct-copy vals1) vals2))
- (let* ((pks (vct-subtract! (vct-copy vals1) vals2))
- (pk (abs (vct-ref pks 0)))
- (loc 0))
- (do ((i 1 (+ 1 i)))
- ((= i 100) (list loc (vct-ref pks loc) (vct-ref vals1 loc) (vct-ref vals2 loc)))
- (if (> (abs (vct-ref pks i)) pk)
- (begin
- (set! loc i)
- (set! pk (abs (vct-ref pks i)))))))
- ))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals2))
- (snd-display #__line__ ";4 virtual op reversed tests (2): ~A(~A(~A(~A(~A~A)))) * ~A: ~A ~A => ~A"
- (op-name fifth) (op-name fourth) (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- saved-scalers vals2 rvals
- (vct-peak (vct-subtract! (vct-copy vals2) rvals)))))
- (set! (edit-position ind 0) edpos))))
- op5)))
- op4)))
- op3)))
- op2))
- op1)))
-
- (if all-args
- (let ((op1 (list 0 3 5))
- (op2 (list 0 1 3 4 5 6))
- (op3 (list 0 1 2 3 4 5 6))
- (op4 (list 0 1 2 3 4 5 6))
- (op5 (list 7 3 5))
- (op6 (list 0 1 2 3 4 5 6 7)))
- (for-each
- (lambda (first)
- (for-each
- (lambda (second)
- (if (not (= first second))
- (for-each
- (lambda (third)
- (if (and (not (= first third))
- (not (= second third)))
- (for-each
- (lambda (fourth)
- (if (and (not (= first fourth))
- (not (= second fourth))
- (not (= third fourth)))
- (for-each
- (lambda (fifth)
- (if (and (not (= first fifth))
- (not (= second fifth))
- (not (= third fifth))
- (not (= fourth fifth)))
- (for-each
- (lambda (sixth)
- (if (and (not (= first sixth))
- (not (= second sixth))
- (not (= third sixth))
- (not (= fourth sixth))
- (not (= fifth sixth))
- (let ((val (+ k
- (if (or (= first 5) (= first 6)) 1 0)
- (if (or (= second 5) (= second 6)) 1 0)
- (if (or (= third 5) (= third 6)) 1 0)
- (if (or (= fourth 5) (= fourth 6)) 1 0)
- (if (or (= fifth 5) (= fifth 6)) 1 0)
- (if (or (= sixth 5) (= sixth 6)) 1 0))))
- (not (> val 2)))
- (let ((val (+ (if (member first (list 0 1 2 3 4 7)) 1 0)
- (if (member second (list 0 1 2 3 4 7)) 1 0)
- (if (member third (list 0 1 2 3 4 7)) 1 0)
- (if (member fourth (list 0 1 2 3 4 7)) 1 0)
- (if (member fifth (list 0 1 2 3 4 7)) 1 0)
- (if (member sixth (list 0 1 2 3 4 7)) 1 0))))
- (not (> val 4))))
- (begin
- (set! scalers '())
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op first)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op second)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op third)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op fourth)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op fifth)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (op sixth)
- (set! scl (+ .5 (random 1.0)))
- (scale-by scl)
- (set! scalers (cons scl scalers))
- (set! vals1 (channel->vct 0 100 ind 0))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals1))
- (snd-display #__line__ ";5 virtual op reversed tests: ~A(~A(~A(~A(~A(~A~A))))) * ~A: ~A ~A => ~A"
- (op-name sixth) (op-name fifth) (op-name fourth)
- (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- scalers vals1 rvals
- (vct-peak (vct-subtract! (vct-copy vals1) rvals)))))
- (set! (edit-position ind 0) edpos)
- (set! (optimization) 0)
- (set! scalers (reverse scalers))
- (set! saved-scalers scalers)
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= first 5) (map1) (if (= first 6) (map2) (op first)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= second 5) (map1) (if (= second 6) (map2) (op second)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= third 5) (map1) (if (= third 6) (map2) (op third)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= fourth 5) (map1) (if (= fourth 6) (map2) (op fourth)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= fifth 5) (map1) (if (= fifth 6) (map2) (op fifth)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (if (= sixth 5) (map1) (if (= sixth 6) (map2) (op sixth)))
- (scale-by (car scalers)) (set! scalers (cdr scalers))
- (set! (optimization) oldopt)
- (set! vals2 (channel->vct 0 100 ind 0))
- (if (not (vequal vals1 vals2))
- (snd-display #__line__ ";5 virtual op tests: ~A * ~A(~A(~A(~A(~A(~A~A))))): ~A ~A => ~A at ~A"
- saved-scalers
- (op-name sixth) (op-name fifth) (op-name fourth)
- (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- vals1 vals2
- (vct-peak (vct-subtract! (vct-copy vals1) vals2))
- (let* ((pks (vct-subtract! (vct-copy vals1) vals2))
- (pk (abs (vct-ref pks 0)))
- (loc 0))
- (do ((i 1 (+ 1 i)))
- ((= i 100) (list loc (vct-ref pks loc) (vct-ref vals1 loc) (vct-ref vals2 loc)))
- (if (> (abs (vct-ref pks i)) pk)
- (begin
- (set! loc i)
- (set! pk (abs (vct-ref pks i)))))))
- ))
- (let ((rvals (reversed-channel->vct 0 100 ind 0)))
- (if (not (vequal rvals vals2))
- (snd-display #__line__ ";5 virtual op reversed tests (2): ~A(~A(~A(~A(~A(~A~A))))) * ~A: ~A ~A => ~A"
- (op-name sixth) (op-name fifth) (op-name fourth)
- (op-name third) (op-name second) (op-name first)
- (if (= k 1) "(ptree_zero)" "")
- saved-scalers vals2 rvals
- (vct-peak (vct-subtract! (vct-copy vals2) rvals)))))
- (set! (edit-position ind 0) edpos))))
- op6)))
- op5)))
- op4)))
- op3)))
- op2))
- op1)))))
- (close-sound ind))
-
- (if all-args ; include mix in cycling tests
- (let ((old-ptrees (max-virtual-ptrees)))
-
- (set! (max-virtual-ptrees) 10)
-
- (letrec ((local-vequal (lambda (v0 v1 n)
- (let ((old-fudge (mus-float-equal-fudge-factor)))
- (set! (mus-float-equal-fudge-factor) (* n .001))
- (let ((result (equal? v0 v1)))
- (set! (mus-float-equal-fudge-factor) old-fudge)
- result))))
-
- (add-1 (lambda (ind)
- (ptree-channel (lambda (y) (+ y 1.0)) 0 20 ind 0)
- (let ((data (channel->vct 0 20 ind 1)))
- (vct-offset! data 1.0)
- (vct->channel data 0 20 ind 1))))
-
- (ramp-1 (lambda (ind)
- (ramp-channel 0 1.0 0 21 ind 0)
- (let ((data (channel->vct 0 20 ind 1)))
- (do ((i 0 (+ 1 i))
- (val 0 (+ val .05)))
- ((= i 20))
- (vct-set! data i (* (vct-ref data i) val)))
- (vct->channel data 0 20 ind 1))))
-
- (mix-1 (lambda (ind)
- (let ((mdata (vct 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 -0.5)))
- (mix-vct mdata 5 ind 0 #t)
- (let ((data (channel->vct 5 10 ind 1)))
- (vct-add! data mdata)
- (vct->channel data 5 10 ind 1)))))
-
- (env-1 (lambda (ind)
- (env-channel '(0 0 1 1 2 1 3 0) 0 20 ind 0)
- (let ((e1 (vct 0.0 0.166667 0.333333 0.5 0.666667 0.833333 1.0 1.0 1.0 1.0
- 1.0 1.0 1.0 1.0 0.833333 0.666667 0.5 0.333333 0.166667 0.0))
- (data (channel->vct 0 20 ind 1)))
- (vct-multiply! data e1)
- (vct->channel data 0 20 ind 1))))
-
- (env-2 (lambda (ind)
- (env-channel-with-base '(0 0 1 1 2 1 3 0) 8.0 0 20 ind 0)
- (let ((e1 (vct 0.0 0.059173 0.142857 0.261204 0.428571 0.665265 1.0 1.0 1.0
- 1.0 1.0 1.0 1.0 1.0 0.665265 0.428571 0.261204 0.142857 0.059173 0.0))
- (data (channel->vct 0 20 ind 1)))
- (vct-multiply! data e1)
- (vct->channel data 0 20 ind 1))))
-
- (env-3 (lambda (ind)
- (env-channel '(0 1 1 0 2 0 3 1) 0 20 ind 0)
- (let ((e1 (vct 1.0 0.833333 0.666667 0.5 0.333333 0.166667 0.0 0.0 0.0 0.0
- 0.0 0.0 0.0 0.0 0.166667 0.333333 0.5 0.666667 0.833333 1.0))
- (data (channel->vct 0 20 ind 1)))
- (vct-multiply! data e1)
- (vct->channel data 0 20 ind 1))))
-
- (env-4 (lambda (ind)
- (env-channel-with-base '(0 1 1 0 2 0 3 1) 8.0 0 20 ind 0)
- (let ((e1 (vct 1.0 0.665265 0.428571 0.261204 0.142857 0.059173 0.0 0.0 0.0
- 0.0 0.0 0.0 0.0 0.0 0.059173 0.142857 0.261204 0.428571 0.665265 1.0))
- (data (channel->vct 0 20 ind 1)))
- (vct-multiply! data e1)
- (vct->channel data 0 20 ind 1))))
-
- (env-5 (lambda (ind)
- (env-channel '(0 1 1 .5 2 .5 3 1) 0 20 ind 0)
- (let ((e1 (vct 1.0 0.916667 0.833333 0.750000 0.666667 0.583333 0.5 0.5 0.5
- 0.5 0.5 0.5 0.5 0.5 0.583333 0.666667 0.750000 0.833333 0.916667 1.0))
- (data (channel->vct 0 20 ind 1)))
- (vct-multiply! data e1)
- (vct->channel data 0 20 ind 1))))
-
- (env-6 (lambda (ind)
- (env-channel-with-base '(0 1 1 .5 2 .5 3 1) 8.0 0 20 ind 0)
- (let ((e1 (vct 1.0 0.832632 0.714286 0.630602 0.571429 0.529587 0.5 0.5 0.5
- 0.5 0.5 0.5 0.5 0.5 0.529587 0.571429 0.630602 0.714286 0.832632 1.0))
- (data (channel->vct 0 20 ind 1)))
- (vct-multiply! data e1)
- (vct->channel data 0 20 ind 1))))
-
- (set-1 (lambda (ind)
- (set! (sample 10 ind 0) -0.5)
- (let ((data (channel->vct 0 20 ind 1)))
- (vct-set! data 10 -0.5)
- (vct->channel data 0 20 ind 1))))
-
- (scl-1 (lambda (ind)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 20 ind 0 #f #f
- (lambda (pos dur)
- (vct 0.625)))
- (scale-channel 0.625 0 20 ind 1)))
-
- (rvequal (lambda (ind name n)
- (let ((r1 (make-sampler 19 ind 0 -1))
- (r2 (make-sampler 19 ind 1 -1))
- (v1 (make-vct 20))
- (v2 (make-vct 20)))
- (do ((i 0 (+ 1 i)))
- ((= i 20))
- (vct-set! v1 i (r1))
- (vct-set! v2 i (r2)))
- (if (not (local-vequal v1 v2 n))
- (snd-display #__line__ ";!~A reversed: ~A ~A" name v1 v2))
- (free-sampler r1)
- (free-sampler r2)))))
-
- (let ((all-ops (list add-1 ramp-1 mix-1 env-1 env-2 env-3 env-4 env-5 env-6 set-1 scl-1))
- (all-op-names (list 'add-1 'ramp-1 'mix-1 'env-1 'env-2 'env-3 'env-4 'env-5 'env-6 'set-1 'scl-1))
- (two-ops (list add-1 ramp-1))
- (two-op-names (list 'add-1 'ramp-1)))
-
- (let ((ind (new-sound "test.snd" :size 20 :channels 2 :data-format mus-lfloat)))
-
- (set! (squelch-update ind 0) #t)
- (set! (squelch-update ind 1) #t)
-
- (for-each ; check that they are the same
- (lambda (op op-name)
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (if (= k 1)
- (vct->channel (make-vct 20 0.0) 0 20 ind 1)
- (begin
- (vct->channel (make-vct 20 1.0) 0 20 ind 0)
- (vct->channel (make-vct 20 1.0) 0 20 ind 1)))
- (op ind)
- (if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display #__line__ ";unequal: ~A by ~A (~A, ~A, ~A):~%; ~A~%; ~A~%; ~A~%; ~A"
- op-name
- (vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
- (mus-float-equal-fudge-factor) (mus-clipping) (mus-file-clipping ind)
- (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)
- (display-edits ind 0) (display-edits ind 1))
- (rvequal ind op-name 1))
- (revert-sound ind)))
- all-ops all-op-names)
-
- (close-sound ind)
- (set! ind (new-sound "test.snd" :size 20 :channels 2 :data-format mus-lfloat))
- (set! (squelch-update ind 0) #t)
- (set! (squelch-update ind 1) #t)
-
- ;; 2 ops
- (for-each
- (lambda (op2 op2-name)
- (for-each
- (lambda (op1 op1-name)
- (let ((op-name (format #f "~A(~A)" op2-name op1-name)))
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (if (= k 1)
- (vct->channel (make-vct 20 0.0) 0 20 ind 1)
- (begin
- (vct->channel (make-vct 20 1.0) 0 20 ind 0)
- (vct->channel (make-vct 20 1.0) 0 20 ind 1)))
- (op1 ind)
- (op2 ind)
- (if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display #__line__ ";unequal: ~A~A by ~A (~A):~%; ~A~%; ~A~%; ~A~%; ~A"
- op-name (if (= k 0) "[0]" "")
- (vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
- (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)
- (display-edits ind 0) (display-edits ind 1))
- (rvequal ind op-name 1))
- (revert-sound ind))))
- all-ops all-op-names))
- all-ops all-op-names)
-
- (close-sound ind)
- (set! ind (new-sound "test.snd" :size 20 :channels 2 :data-format mus-lfloat))
- (set! (squelch-update ind 0) #t)
- (set! (squelch-update ind 1) #t)
-
- ;; 3 ops
- (for-each
- (lambda (op3 op3-name)
- (for-each
- (lambda (op2 op2-name)
- (for-each
- (lambda (op1 op1-name)
- (let ((op-name (format #f "~A(~A(~A))" op3-name op2-name op1-name)))
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (if (= k 1)
- (vct->channel (make-vct 20 0.0) 0 20 ind 1)
- (begin
- (vct->channel (make-vct 20 1.0) 0 20 ind 0)
- (vct->channel (make-vct 20 1.0) 0 20 ind 1)))
- (op1 ind)
- (op2 ind)
- (op3 ind)
- (if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display #__line__ ";unequal: ~A by ~A (~A):~%; ~A~%; ~A~%; ~A~%; ~A"
- op-name
- (vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
- (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)
- (display-edits ind 0) (display-edits ind 1))
- (rvequal ind op-name 1))
- (revert-sound ind))))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names)
-
- (close-sound ind)
- (set! ind (new-sound "test.snd" :size 20 :channels 2 :data-format mus-lfloat))
- (set! (squelch-update ind 0) #t)
- (set! (squelch-update ind 1) #t)
-
- ;; 4 ops
- (for-each
- (lambda (op4 op4-name)
- (for-each
- (lambda (op3 op3-name)
- (for-each
- (lambda (op2 op2-name)
- (for-each
- (lambda (op1 op1-name)
- (let ((op-name (format #f "~A(~A(~A(~A)))" op4-name op3-name op2-name op1-name)))
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (if (= k 1)
- (vct->channel (make-vct 20 0.0) 0 20 ind 1)
- (begin
- (vct->channel (make-vct 20 1.0) 0 20 ind 0)
- (vct->channel (make-vct 20 1.0) 0 20 ind 1)))
- (op1 ind)
- (op2 ind)
- (op3 ind)
- (op4 ind)
- (if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display #__line__ ";unequal: ~A~A by ~A (~A):~%; ~A~%; ~A"
- op-name (if (= k 0) "[0]" "")
- (vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
- (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
- (rvequal ind op-name 1))
- (revert-sound ind))))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names)
-
- (close-sound ind)
- (set! ind (new-sound "test.snd" :size 20 :channels 2 :data-format mus-lfloat))
- (set! (squelch-update ind 0) #t)
- (set! (squelch-update ind 1) #t)
-
- ;; 5 ops
- (for-each
- (lambda (op5 op5-name)
- (for-each
- (lambda (op4 op4-name)
- (for-each
- (lambda (op3 op3-name)
- (for-each
- (lambda (op2 op2-name)
- (for-each
- (lambda (op1 op1-name)
- (let ((op-name (format #f "~A(~A(~A(~A(~A))))" op5-name op4-name op3-name op2-name op1-name)))
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (if (= k 1)
- (vct->channel (make-vct 20 0.0) 0 20 ind 1)
- (begin
- (vct->channel (make-vct 20 1.0) 0 20 ind 0)
- (vct->channel (make-vct 20 1.0) 0 20 ind 1)))
- (op1 ind)
- (op2 ind)
- (op3 ind)
- (op4 ind)
- (op5 ind)
- (if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display #__line__ ";unequal: ~A by ~A (~A), ~A in ~A:~%; ~A~%; ~A"
- op-name
- (vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
- (map (lambda (lst) (edit-fragment-type-name (list-ref lst 7))) (edit-tree ind 0))
- (edit-tree ind 0)
- (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
- (rvequal ind op-name 1))
- (revert-sound ind))))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names)
-
- (close-sound ind)
- (set! ind (new-sound "test.snd" :size 20 :channels 2 :data-format mus-lfloat))
- (set! (squelch-update ind 0) #t)
- (set! (squelch-update ind 1) #t)
-
- ;; 6 ops
- (for-each
- (lambda (op6 op6-name)
- (for-each
- (lambda (op5 op5-name)
- (for-each
- (lambda (op4 op4-name)
- (for-each
- (lambda (op3 op3-name)
- (for-each
- (lambda (op2 op2-name)
- (for-each
- (lambda (op1 op1-name)
- (let ((op-name (format #f "~A(~A(~A(~A(~A(~A)))))" op6-name op5-name op4-name op3-name op2-name op1-name)))
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (if (= k 1)
- (vct->channel (make-vct 20 0.0) 0 20 ind 1)
- (begin
- (vct->channel (make-vct 20 1.0) 0 20 ind 0)
- (vct->channel (make-vct 20 1.0) 0 20 ind 1)))
- (op1 ind)
- (op2 ind)
- (op3 ind)
- (op4 ind)
- (op5 ind)
- (op6 ind)
- (if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display #__line__ ";unequal: ~A by ~A (~A):~%; ~A~%; ~A"
- op-name
- (vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
- (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
- (rvequal ind op-name 1))
- (revert-sound ind))))
- two-ops two-op-names))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names))
- two-ops two-op-names)
-
- (close-sound ind)
- (set! ind (new-sound "test.snd" :size 20 :channels 2 :data-format mus-lfloat))
- (set! (squelch-update ind 0) #t)
- (set! (squelch-update ind 1) #t)
-
- ;; 7 ops
- (for-each
- (lambda (op7 op7-name)
- (for-each
- (lambda (op6 op6-name)
- (for-each
- (lambda (op5 op5-name)
- (for-each
- (lambda (op4 op4-name)
- (for-each
- (lambda (op3 op3-name)
- (for-each
- (lambda (op2 op2-name)
- (for-each
- (lambda (op1 op1-name)
- (let ((op-name (format #f "~A(~A(~A(~A(~A(~A(~A))))))" op7-name op6-name op5-name op4-name op3-name op2-name op1-name)))
- (do ((k 0 (+ 1 k)))
- ((= k 2))
- (if (= k 1)
- (vct->channel (make-vct 20 0.0) 0 20 ind 1)
- (begin
- (vct->channel (make-vct 20 1.0) 0 20 ind 0)
- (vct->channel (make-vct 20 1.0) 0 20 ind 1)))
- (op1 ind)
- (op2 ind)
- (op3 ind)
- (op4 ind)
- (op5 ind)
- (op6 ind)
- (op7 ind)
- (if (not (local-vequal (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1) 1))
- (snd-display #__line__ ";unequal: ~A by ~A (~A):~%; ~A~%; ~A"
- op-name
- (vmaxdiff (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1)) (mus-float-equal-fudge-factor)
- (channel->vct 0 20 ind 0) (channel->vct 0 20 ind 1))
- (rvequal ind op-name 1))
- (revert-sound ind))))
- two-ops two-op-names))
- all-ops all-op-names))
- all-ops all-op-names))
- all-ops all-op-names))
- two-ops two-op-names))
- two-ops two-op-names))
- two-ops two-op-names)
-
- (set! (squelch-update ind 0) #f)
- (set! (squelch-update ind 1) #f)
- (set! (max-virtual-ptrees) old-ptrees)
-
- (if (and (provided? 'snd-motif)
- (provided? 'xm))
- (let* ((edhist (list-ref (channel-widgets ind 0) 7))
- (edp (XtParent edhist)))
- (XtUnmanageChild edp)
- (XtVaSetValues edp (list XmNpaneMinimum 1)) ; not 0 here -- Xt warnings
- (XtManageChild edp)))
-
- (close-sound ind)))
- )))))
-
- (let ((ind (open-sound "oboe.snd")))
-
- ;; simple cases
-
- (as-one-edit
- (lambda ()
- (set! (sample 10) 1.0)))
- (if (fneq (sample 10) 1.0) (snd-display #__line__ ";as-one-edit 1: ~A" (sample 10)))
- (if (not (= (edit-position ind 0) 1))
- (snd-display #__line__ ";as-one-edit 1 edpos: ~A" (edit-position ind 0))
- (begin
- (if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
- (snd-display #__line__ ";as-one-edit 1 edlist: ~A" (edit-fragment 1 ind 0)))
- (if (not (equal? (edit-fragment 0 ind 0) (list #f "init" 0 50828)))
- (snd-display #__line__ ";as-one-edit 1 original edlist: ~A" (edit-fragment 0 ind 0)))))
-
- (revert-sound ind)
- (as-one-edit
- (lambda ()
- (set! (sample 10) 1.0)
- (map-channel (lambda (y) (* y 2.0)) 0 20 ind 0 #f "map-channel as-one-edit")
- (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 2 edpos internal: ~A" (edit-position ind 0))))
- "as-one-edit test-2")
- (if (fneq (sample 10) 2.0) (snd-display #__line__ ";as-one-edit 2: ~A" (sample 10)))
- (if (not (= (edit-position ind 0) 1))
- (snd-display #__line__ ";as-one-edit 2 edpos: ~A" (edit-position ind 0))
- (begin
- (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-2" "set" 0 21)))
- (snd-display #__line__ ";as-one-edit 2 edlist: ~A" (edit-fragment 1 ind 0)))
- (if (not (equal? (edit-fragment 0 ind 0) (list #f "init" 0 50828)))
- (snd-display #__line__ ";as-one-edit 2 original edlist: ~A" (edit-fragment 0 ind 0)))))
-
- (revert-sound ind)
- (let ((ind2 (open-sound "2a.snd")))
- (set! (sample 1 ind2 0) 1.0)
- (set! (sample 2 ind2 1) 0.5)
- (set! (selected-sound) ind)
-
- (as-one-edit
- (lambda ()
- (set! (sample 10 ind 0) 1.0)))
- (if (fneq (sample 10 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 3: ~A" (sample 10 ind 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 3 edpos: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind2 0) 1)) (snd-display #__line__ ";as-one-edit 3 2 edpos: ~A" (edit-position ind2 0)))
- (if (not (= (edit-position ind2 1) 1)) (snd-display #__line__ ";as-one-edit 3 2 1 edpos: ~A" (edit-position ind2 1)))
- (if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
- (snd-display #__line__ ";as-one-edit 3 edlist: ~A" (edit-fragment 1 ind 0)))
- (if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 1 1.0000" "set" 1 1)))
- (snd-display #__line__ ";as-one-edit 3 2 edlist: ~A" (edit-fragment 1 ind2 0)))
- (if (not (equal? (edit-fragment 1 ind2 1) (list "set-sample 2 0.5000" "set" 2 1)))
- (snd-display #__line__ ";as-one-edit 3 2 1 edlist: ~A" (edit-fragment 1 ind2 1)))
-
- (revert-sound ind)
-
- (as-one-edit
- (lambda ()
- (set! (sample 10 ind 0) 1.0)
- (map-channel (lambda (y) (* y 2.0)) 0 20 ind 0 #f "map-channel as-one-edit 2")
- (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 4 edpos internal: ~A" (edit-position ind 0))))
- "as-one-edit test-4")
- (if (fneq (sample 10) 2.0) (snd-display #__line__ ";as-one-edit 4: ~A" (sample 10 ind 0)))
- (if (not (= (edit-position ind 0) 1))
- (snd-display #__line__ ";as-one-edit 4 edpos: ~A" (edit-position ind 0))
- (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-4" "set" 0 21)))
- (snd-display #__line__ ";as-one-edit 4 edlist: ~A" (edit-fragment 1 ind 0))))
- (if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 1 1.0000" "set" 1 1)))
- (snd-display #__line__ ";as-one-edit 3 2 edlist: ~A" (edit-fragment 1 ind2 0)))
- (if (not (equal? (edit-fragment 1 ind2 1) (list "set-sample 2 0.5000" "set" 2 1)))
- (snd-display #__line__ ";as-one-edit 3 2 1 edlist: ~A" (edit-fragment 1 ind2 1)))
-
- (revert-sound ind)
- (set! (sample 3 ind 0) 1.0)
-
- (as-one-edit
- (lambda ()
- (set! (sample 10 ind 0) 1.0)
- (set! (sample 10 ind2 0) 0.5)
- (set! (sample 10 ind2 1) 0.4)))
- (if (fneq (sample 3 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 5 (3): ~A" (sample 3 ind 0)))
- (if (fneq (sample 10 ind 0) 1.0) (snd-display #__line__ ";as-one-edit 5 (10): ~A" (sample 10 ind 0)))
- (if (fneq (sample 10 ind2 0) 0.5) (snd-display #__line__ ";as-one-edit 5 (2 10): ~A" (sample 10 ind2 0)))
- (if (fneq (sample 10 ind2 1) 0.4) (snd-display #__line__ ";as-one-edit 5 (2 1 10): ~A" (sample 10 ind2 1)))
- (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit 5 edpos: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind2 0) 2)) (snd-display #__line__ ";as-one-edit 5 2 edpos: ~A" (edit-position ind2 0)))
- (if (not (= (edit-position ind2 1) 2)) (snd-display #__line__ ";as-one-edit 5 2 1 edpos: ~A" (edit-position ind2 1)))
-
- (if (not (equal? (edit-fragment 2 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
- (snd-display #__line__ ";as-one-edit 5 edlist 2: ~A" (edit-fragment 1 ind 0)))
- (if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 3 1.0000" "set" 3 1)))
- (snd-display #__line__ ";as-one-edit 5 edlist 1: ~A" (edit-fragment 1 ind 0)))
- (if (not (equal? (edit-fragment 0 ind 0) (list #f "init" 0 50828)))
- (snd-display #__line__ ";as-one-edit 5 original edlist: ~A" (edit-fragment 0 ind 0)))
- (if (not (equal? (edit-fragment 2 ind2 0) (list "set-sample 10 0.5000" "set" 10 1)))
- (snd-display #__line__ ";as-one-edit 5 edlist 2 1: ~A" (edit-fragment 1 ind2 0)))
-
- (as-one-edit
- (lambda ()
- (map-channel (lambda (y) (* y 2.0)) 0 20 ind 0 #f "map-channel as-one-edit 6")
- (map-channel (lambda (y) (* y 2.0)) 0 20 ind2 1 #f "map-channel as-one-edit 6 2 1"))
- "as-one-edit test-6")
-
-
- (if (fneq (sample 3 ind 0) 2.0) (snd-display #__line__ ";as-one-edit 6 (3): ~A" (sample 3 ind 0)))
- (if (fneq (sample 10 ind 0) 2.0) (snd-display #__line__ ";as-one-edit 6 (10): ~A" (sample 10 ind 0)))
- (if (fneq (sample 10 ind2 0) 0.5) (snd-display #__line__ ";as-one-edit 6 (2 10): ~A" (sample 10 ind2 0)))
- (if (fneq (sample 10 ind2 1) 0.8) (snd-display #__line__ ";as-one-edit 6 (2 1 10): ~A" (sample 10 ind2 1)))
- (if (not (= (edit-position ind 0) 3)) (snd-display #__line__ ";as-one-edit 6 edpos: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind2 0) 2)) (snd-display #__line__ ";as-one-edit 6 2 edpos: ~A" (edit-position ind2 0)))
- (if (not (= (edit-position ind2 1) 3)) (snd-display #__line__ ";as-one-edit 6 2 1 edpos: ~A" (edit-position ind2 1)))
-
- (if (not (equal? (edit-fragment 2 ind 0) (list "set-sample 10 1.0000" "set" 10 1)))
- (snd-display #__line__ ";as-one-edit 5 edlist 2: ~A" (edit-fragment 1 ind 0)))
- (if (not (equal? (edit-fragment 2 ind2 0) (list "set-sample 10 0.5000" "set" 10 1)))
- (snd-display #__line__ ";as-one-edit 5 edlist 2 1: ~A" (edit-fragment 1 ind2 0)))
- (if (not (equal? (edit-fragment 3 ind 0) (list "as-one-edit test-6" "set" 0 20)))
- (snd-display #__line__ ";as-one-edit 6 edlist: ~A" (edit-fragment 1 ind 0)))
- (if (not (equal? (edit-fragment 3 ind2 1) (list "as-one-edit test-6" "set" 0 20)))
- (snd-display #__line__ ";as-one-edit 6 edlist 2 1: ~A" (edit-fragment 1 ind2 1)))
- (close-sound ind2))
-
- ;; nested cases
- (revert-sound ind)
-
- (as-one-edit
- (lambda ()
- (set! (sample 100) .9)
- (as-one-edit
- (lambda ()
- (set! (sample 200) .8)
- (set! (sample 300) .7)))
- (set! (sample 300) .6)))
- (if (or (fneq (sample 100) .9)
- (fneq (sample 200) .8)
- (fneq (sample 300) .6))
- (snd-display #__line__ ";nested as-one-edit 7: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
- (if (not (= (edit-position ind 0) 1))
- (snd-display #__line__ ";nested as-one-edit 7 edpos: ~A" (edit-position ind 0)))
- (if (squelch-update ind 0)
- (begin
- (snd-display #__line__ ";nested as-one-edit 7 squelch is on")
- (set! (squelch-update) #f)))
- (if (not (equal? (edit-fragment 1 ind 0) (list "set-sample 300 0.6000" "set" 100 204)))
- (snd-display #__line__ ";as-one-edit 7 edlist: ~A" (edit-fragment 1 ind 0)))
-
- (revert-sound ind)
- (as-one-edit
- (lambda ()
- (set! (sample 100) .9)
- (as-one-edit
- (lambda ()
- (set! (sample 200) .8)
- (set! (sample 300) .7)))
- (set! (sample 300) .6))
- "as-one-edit test-8")
- (if (or (fneq (sample 100) .9)
- (fneq (sample 200) .8)
- (fneq (sample 300) .6))
- (snd-display #__line__ ";nested as-one-edit 8: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
- (if (not (= (edit-position ind 0) 1))
- (snd-display #__line__ ";nested as-one-edit 8 edpos: ~A" (edit-position ind 0)))
- (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-8" "set" 100 204)))
- (snd-display #__line__ ";as-one-edit 8 edlist: ~A" (edit-fragment 1 ind 0)))
-
- (revert-sound ind)
- (as-one-edit
- (lambda ()
- (set! (sample 100) .9)
- (as-one-edit
- (lambda ()
- (set! (sample 200) .8)
- (set! (sample 300) .7))
- "as-one-edit 9 internal")
- (set! (sample 300) .6))
- "as-one-edit test-9")
- (if (or (fneq (sample 100) .9)
- (fneq (sample 200) .8)
- (fneq (sample 300) .6))
- (snd-display #__line__ ";nested as-one-edit 9: ~A ~A ~A" (sample 100) (sample 200) (sample 300)))
- (if (not (= (edit-position ind 0) 1))
- (snd-display #__line__ ";nested as-one-edit 9 edpos: ~A" (edit-position ind 0)))
- (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-9" "set" 100 204)))
- (snd-display #__line__ ";as-one-edit 9 edlist: ~A" (edit-fragment 1 ind 0)))
-
- (revert-sound ind)
- (as-one-edit
- (lambda ()
- (set! (sample 100) .9)
- (as-one-edit
- (lambda ()
- (set! (sample 200) .8)
- (as-one-edit
- (lambda ()
- (set! (sample 400) .3))
- "not a name")
- (set! (sample 300) .7))
- "as-one-edit 10 internal")
- (set! (sample 300) .6))
- "as-one-edit test-10")
- (if (or (fneq (sample 100) .9)
- (fneq (sample 200) .8)
- (fneq (sample 300) .6)
- (fneq (sample 400) .3))
- (snd-display #__line__ ";nested as-one-edit 10: ~A ~A ~A ~A" (sample 100) (sample 200) (sample 300) (sample 400)))
- (if (not (= (edit-position ind 0) 1))
- (snd-display #__line__ ";nested as-one-edit 10 edpos: ~A" (edit-position ind 0)))
- (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit test-10" "set" 100 305)))
- (snd-display #__line__ ";as-one-edit 10 edlist: ~A" (edit-fragment 1 ind 0)))
-
- ;; try implicit as-one-edits nested
- (revert-sound ind)
- (env-channel-with-base '(0 0 1 1 2 .5 3 .25 4 0) 0.0 0 #f ind 0)
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 11 edpos: ~A" (edit-position ind 0)))
- (if (not (equal? (edit-fragment 1 ind 0)
- (list "env-channel-with-base '(0.000 0.000 1.000 1.000 2.000 0.500 3.000 0.250 4.000 0.000) 0.0000 0 #f" "scale" 0 50830)))
- (snd-display #__line__ ";as-one-edit 11: ~A" (edit-fragment 1 ind 0)))
-
- (revert-sound ind)
- (as-one-edit
- (lambda ()
- (env-channel-with-base '(0 0 1 1 2 .5 3 .25 4 0) 0.0 0 #f ind 0))
- "as-one-edit 12")
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit 12 edpos: ~A" (edit-position ind 0)))
- (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit 12" "scale" 0 50830)))
- (snd-display #__line__ ";as-one-edit 12: ~A" (edit-fragment 1 ind 0)))
-
- (revert-sound ind)
- (let ((m1 #f)
- (m2 #f)
- (m3 #f)
- (m4 #f))
- (as-one-edit
- (lambda ()
- (set! m1 (add-mark 1234 ind 0))
- (set! (sample 1236 ind 0) .6)
- (as-one-edit
- (lambda ()
- (set! (sample 123 ind 0) .3)
- (set! m2 (add-mark 1235 ind 0)))
- "as-one-edit inner 1")
- (if (not (mark? m1)) (snd-display #__line__ ";as-one-edit stepped on m1: ~A" m1))
- (if (not (mark? m2)) (snd-display #__line__ ";as-one-edit stepped on m2: ~A" m2))
- (as-one-edit
- (lambda ()
- (set! m3 (add-mark 1238 ind 0))
- (set! (sample 1238 ind 0) .8))
- "as-one-edit inner 2")
- (set! (sample 1239 ind 0) .9)
- (set! m4 (add-mark 1237 ind 0)))
- "outer as-one-edit")
- (if (not (mark? m1)) (snd-display #__line__ ";2nd as-one-edit stepped on m1: ~A" m1))
- (if (not (mark? m2)) (snd-display #__line__ ";2nd as-one-edit stepped on m2: ~A" m2))
- (if (not (mark? m3)) (snd-display #__line__ ";2nd as-one-edit stepped on m3: ~A" m3))
- (if (not (mark? m4)) (snd-display #__line__ ";2nd as-one-edit stepped on m4: ~A" m4))
- (if (not (= (mark-sample m1) 1234)) (snd-display #__line__ ";as-one-edit m1 sample: ~A (1234)" (mark-sample m1)))
- (if (not (= (mark-sample m2) 1235)) (snd-display #__line__ ";as-one-edit m2 sample: ~A (1235)" (mark-sample m2)))
- (if (not (= (mark-sample m3) 1238)) (snd-display #__line__ ";as-one-edit m3 sample: ~A (1238)" (mark-sample m3)))
- (if (not (= (mark-sample m4) 1237)) (snd-display #__line__ ";as-one-edit m4 sample: ~A (1237)" (mark-sample m4)))
- (if (not (string=? (display-edits ind 0) (string-append "
-EDITS: 1
-
- (begin) [0:2]:
- (at 0, cp->sounds[0][0:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (set 123 1120) ; outer as-one-edit [1:9]:
- (at 0, cp->sounds[0][0:122, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 123, cp->sounds[2][0:0, 1.000]) [buf: 1]
- (at 124, cp->sounds[0][124:1235, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 1236, cp->sounds[1][0:0, 1.000]) [buf: 1]
- (at 1237, cp->sounds[0][1237:1237, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 1238, cp->sounds[3][0:0, 1.000]) [buf: 1]
- (at 1239, cp->sounds[4][0:0, 1.000]) [buf: 1]
- (at 1240, cp->sounds[0][1240:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-")))
- (snd-display #__line__ ";as-one-edit edits: ~A" (display-edits ind 0)))
-
- (revert-sound ind))
-
- (let ((m1 #f)
- (m2 #f)
- (m3 #f)
- (m4 #f))
- (as-one-edit
- (lambda ()
- (set! m1 (mix-vct (vct .1 .2 .3) 1234 ind 0))
- (set! (sample 1236 ind 0) .6)
- (as-one-edit
- (lambda ()
- (set! (sample 123 ind 0) .3)
- (set! m2 (mix-vct (vct .1 .2 .3) 1235 ind 0)))
- "as-one-edit inner 1")
- (if (not (mix? m1)) (snd-display #__line__ ";as-one-edit stepped on m1: ~A" m1))
- (if (not (mix? m2)) (snd-display #__line__ ";as-one-edit stepped on m2: ~A" m2))
- (as-one-edit
- (lambda ()
- (set! m3 (mix-vct (vct .1 .2 .3) 1238 ind 0))
- (set! (sample 1238 ind 0) .8))
- "as-one-edit inner 2")
- (set! (sample 1239 ind 0) .9)
- (set! m4 (mix-vct (vct .1 .2 .3) 1237 ind 0)))
- "outer as-one-edit")
- (if (not (mix? m1)) (snd-display #__line__ ";2nd as-one-edit stepped on mx1: ~A" m1))
- (if (not (mix? m2)) (snd-display #__line__ ";2nd as-one-edit stepped on mx2: ~A" m2))
- (if (not (mix? m3)) (snd-display #__line__ ";2nd as-one-edit stepped on mx3: ~A" m3))
- (if (not (mix? m4)) (snd-display #__line__ ";2nd as-one-edit stepped on mx4: ~A" m4))
- (revert-sound ind))
-
- (let ((ind2 #f))
- (as-one-edit
- (lambda ()
- (set! ind2 (open-sound "pistol.snd"))
- (set! (sample 100 ind 0) .5)
- (set! (sample 200 ind2 0) .6))
- "as-one-edit+open")
- (if (not (sound? ind2)) (snd-display #__line__ ";as-one-edit didn't open sound? ~A ~A" ind2 (sounds)))
- (if (not (= (edit-position ind2 0) 1)) (snd-display #__line__ ";edpos as-one-edit opened sound: ~A" (edit-position ind2 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";edpos as-one-edit original sound: ~A" (edit-position ind 0)))
- (if (not (equal? (edit-fragment 1 ind 0) (list "as-one-edit+open" "set" 100 1)))
- (snd-display #__line__ ";as-one-edit open sound edlist orig: ~A" (edit-fragment 1 ind 0)))
- (if (not (equal? (edit-fragment 1 ind2 0) (list "set-sample 200 0.6000" "set" 200 1)))
- (snd-display #__line__ ";as-one-edit open sound edlist new: ~A" (edit-fragment 1 ind2 0)))
-
- (as-one-edit
- (lambda ()
- (set! (sample 200 ind 0) .7)
- (close-sound ind2))
- "as-one-edit+close")
- (if (sound? ind2)
- (begin
- (snd-display #__line__ ";as-one-edit didn't close sound? ~A ~A" ind2 (sounds))
- (close-sound ind2)))
- (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";edpos as-one-edit close original sound: ~A" (edit-position ind 0)))
- (if (not (string=? (display-edits ind 0) (string-append "
-EDITS: 2
-
- (begin) [0:2]:
- (at 0, cp->sounds[0][0:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (set 100 1) ; as-one-edit+open [1:4]:
- (at 0, cp->sounds[0][0:99, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 100, cp->sounds[1][0:0, 1.000]) [buf: 1]
- (at 101, cp->sounds[0][101:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (set 200 1) ; as-one-edit+close [2:6]:
- (at 0, cp->sounds[0][0:99, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 100, cp->sounds[1][0:0, 1.000]) [buf: 1]
- (at 101, cp->sounds[0][101:199, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 200, cp->sounds[2][0:0, 1.000]) [buf: 1]
- (at 201, cp->sounds[0][201:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-")))
- (snd-display #__line__ ";as-one-edit open+close: ~A" (display-edits ind 0))))
-
- (close-sound ind))
-
- (let ((ind1 (open-sound "oboe.snd"))
- (ind2 #f))
- (as-one-edit
- (lambda ()
- (set! (sample 100 ind1 0) .5)
- (set! ind2 (open-sound "pistol.snd"))
- (as-one-edit
- (lambda ()
- (set! (sample 200 ind2 0) .5)
- (close-sound ind1))
- "inner edit")
- (set! (sample 300 ind2 0) .6))
- "outer edit")
- (if (sound? ind1) (snd-display #__line__ ";as-one-edit close inner: ~A ~A" ind1 (sounds)))
- (if (not (sound? ind2)) (snd-display #__line__ ";as-one-edit open inner: ~A ~A" ind2 (sounds)))
-
- (revert-sound ind2)
- (as-one-edit
- (lambda ()
- (set! ind1 (open-sound "oboe.snd"))
- (as-one-edit
- (lambda ()
- (set! (sample 200 ind1 0) .5))
- "inner edit")
- (set! (sample 100 ind2 0) .4))
- "outer edit")
- (close-sound ind1)
- (close-sound ind2))
-
- (let* ((ind (open-sound "oboe.snd"))
- (mx (maxamp ind 0)))
- (as-one-edit
- (lambda ()
- (ptree-channel (lambda (y) (* y 2)))
- (env-sound '(0 0 1 1))))
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit env+ptree pos: ~A" (edit-position ind 0)))
- (if (fneq (maxamp ind 0) .1825) (snd-display #__line__ ";as-one-edit env+ptree max: ~A" (maxamp ind 0)))
- (undo)
- (let ((tag (catch #t
- (lambda () (as-one-edit (lambda (oops) #f)))
- (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity))
- (snd-display #__line__ ";as-one-edit arg? ~A" tag)))
- (let ((tag (catch #t
- (lambda () (as-one-edit (lambda* (oops) #f)))
- (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity))
- (snd-display #__line__ ";as-one-edit arg? ~A" tag)))
- (as-one-edit
- (lambda ()
- (ptree-channel (lambda (y) (* y 2)))
- (ptree-channel (lambda (y) (* y 2)))))
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";as-one-edit ptree+ptree pos: ~A" (edit-position ind 0)))
- (if (fneq (maxamp ind 0) (* 4 mx)) (snd-display #__line__ ";as-one-edit ptree+ptree max: ~A ~A" (maxamp ind 0) (* 4 mx)))
- (close-sound ind))
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "ptree tests" 10)))
- ;; offset-channel
- (offset-channel .1)
- (if (not (vequal (channel->vct 0 10) (make-vct 10 .1)))
- (snd-display #__line__ ";offset-channel (.1): ~A" (channel->vct 0 10)))
- (offset-channel -.2 5 5)
- (if (not (vequal (channel->vct 0 10) (vct .1 .1 .1 .1 .1 -.1 -.1 -.1 -.1 -.1)))
- (snd-display #__line__ ";offset-channel (-.1): ~A" (channel->vct 0 10)))
- (undo)
- (offset-channel .9 0 10 ind 0)
- (if (not (vequal (channel->vct 0 10) (make-vct 10 1.0)))
- (snd-display #__line__ ";offset-channel (1): ~A" (channel->vct 0 10)))
- ;; sine-env and sine-ramp...
- (revert-sound ind)
- (map-channel (lambda (y) 1.0))
- (sine-ramp 0.0 1.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.024 0.095 0.206 0.345 0.500 0.655 0.794 0.905 0.976)))
- (snd-display #__line__ ";sine-ramp 0 1: ~A" (channel->vct)))
- (revert-sound ind)
- (offset-channel 1.0)
- (sine-ramp 1.0 0.0)
- (if (not (vequal (channel->vct) (vct 1.000 0.976 0.905 0.794 0.655 0.500 0.345 0.206 0.095 0.024)))
- (snd-display #__line__ ";sine-ramp 1 0: ~A" (channel->vct)))
- (if (> (optimization) 0)
- (if (not (string=? (edit-fragment-type-name (list-ref (car (edit-tree)) 7)) "ed_ptree_zero"))
- (snd-display #__line__ ";sine-ramp tree op: ~A ~A" (edit-fragment-type-name (list-ref (car (edit-tree)) 7)) (edit-tree))))
- (close-sound ind)
- (set! ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "sine-env tests" 100))
- (map-channel (lambda (y) 1.0))
- (sine-env-channel '(0 0 1 1 2 -.5 3 1))
- (if (or (not (vequal (channel->vct 20 10) (vct 0.664 0.708 0.750 0.790 0.827 0.862 0.893 0.921 0.944 0.964)))
- (not (vequal (channel->vct 60 10) (vct -0.381 -0.417 -0.446 -0.470 -0.486 -0.497 -0.500 -0.497 -0.486 -0.470))))
- (snd-display #__line__ ";sine-env-channel 0: ~A ~A" (channel->vct 20 10) (channel->vct 60 10)))
- (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";as-one-edit sine-env-channel: ~A" (edit-position ind 0)))
- (revert-sound ind)
- (offset-channel -1.0)
- (sine-env-channel '(0 0 1 1 2 1 3 0) 40 20)
- (if (or (not (vequal (channel->vct 40 20) (vct -0.000 -0.050 -0.188 -0.389 -0.611 -0.812 -0.950 -1.000 -1.000 -1.000
- -1.000 -1.000 -1.000 -1.000 -1.000 -0.950 -0.812 -0.611 -0.389 -0.188)))
- (not (vequal (channel->vct 30 10) (make-vct 10 -1.0))))
- (snd-display #__line__ ";off+sine-env: ~A ~A" (channel->vct 40 20) (channel->vct 30 10)))
- (revert-sound ind)
- (ptree-channel (lambda (y d f) (* y 2)) 0 (frames) ind 0 #f #f (lambda (p d) (vct 1.0)))
- (revert-sound ind)
- (scale-by 0.0)
- (dither-channel)
- (let ((mx (maxamp)))
- (if (or (< mx .00003) (> mx .0001))
- (snd-display #__line__ ";dithering: ~A" mx)))
- (revert-sound ind)
- (map-channel (ring-mod 10 (list 0 0 1 (hz->radians 100))))
- (osc-formants .99 (vct 400.0 800.0 1200.0) (vct 400.0 800.0 1200.0) (vct 4.0 2.0 3.0))
- (map-channel (zecho .5 .75 6 10.0))
- (map-channel (flecho .5 .9))
- (filtered-env '(0 0 1 1 2 0))
- (map-channel (formant-filter .99 2400))
- (map-channel (comb-filter .8 32))
- (map-channel (zcomb .8 32 '(0 0 1 10)))
- (map-channel (notch-filter .8 32))
- (let ((ind1 (open-sound "now.snd")))
- (select-sound ind1)
- (if (fneq (maxamp) .309) (snd-display #__line__ ";squelch-vowels init: ~A" (maxamp)))
- (squelch-vowels)
- (if (fneq (maxamp) .047) (snd-display #__line__ ";squelch-vowels maxamp: ~A" (maxamp)))
- (select-sound ind)
- (map-channel (cross-synthesis ind1 .5 128 6.0))
- (revert-sound ind1)
- (fft-edit 40 8000)
- (fft-squelch .1)
- (close-sound ind)
- (revert-sound ind1)
- (scramble-channel .01)
- (revert-sound ind1)
- (close-sound ind1)))
-
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "special env tests" 100)))
- (map-channel (lambda (y) 1.0))
-
- (blackman4-ramp 0.0 1.0)
- (let ((vals (channel->vct)))
- (undo)
- (blackman4-env-channel '(0 0 1 1))
- (let ((new-vals (channel->vct)))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";blackman4-env-channel/ramp: ~A ~A" vals new-vals))
- (undo)
- (blackman4-ramp 0.0 1.0 0 50)
- (set! vals (channel->vct))
- (undo)
- (blackman4-env-channel '(0 0 1 1 2 1))
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";blackman4-env-channel/ramp 1: ~A ~A" vals new-vals))
- (undo)
- (blackman4-env-channel '(0 0 1 1 2 -.5 3 0))
- (if (not (vequal (channel->vct 60 10) (vct -0.109 -0.217 -0.313 -0.392 -0.451 -0.488 -0.499 -0.499 -0.499 -0.499)))
- (snd-display #__line__ ";blackman4 to -.5: ~A" (channel->vct 60 10)))
- (undo)
-
- (ramp-squared 0.0 1.0)
- (set! vals (channel->vct))
- (undo)
- (env-squared-channel '(0 0 1 1))
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";env-squared/ramp: ~A ~A" vals new-vals))
- (undo)
- (ramp-squared 0.0 1.0 #t 0 50)
- (set! vals (channel->vct))
- (undo)
- (env-squared-channel '(0 0 1 1 2 1))
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";env-squared/ramp 1: ~A ~A" vals new-vals))
- (undo)
- (env-squared-channel '(0 0 1 1 2 -.5 3 0))
- (if (not (vequal (channel->vct 60 10) (vct -0.450 -0.466 -0.478 -0.488 -0.494 -0.499 -0.500 -0.500 -0.498 -0.496)))
- (snd-display #__line__ ";env-squared to -.5: ~A" (channel->vct 60 10)))
- (undo)
- (env-squared-channel '(0 0 1 1 2 -.5 3 0) #f)
- (if (not (vequal (channel->vct 60 10) (vct -0.004 -0.080 -0.158 -0.240 -0.324 -0.410 -0.500 -0.500 -0.498 -0.496)))
- (snd-display #__line__ ";env-squared unsymmetric to -.5: ~A" (channel->vct 60 10)))
- (undo)
-
- (ramp-squared 0.0 1.0)
- (set! vals (channel->vct))
- (undo)
- (env-expt-channel '(0 0 1 1) 2)
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";env-expt2/ramp: ~A ~A" vals new-vals))
- (undo)
- (env-squared-channel '(0 0 1 1 2 -.5 3 0))
- (set! vals (channel->vct))
- (undo)
- (env-expt-channel '(0 0 1 1 2 -.5 3 0) 2.0)
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";env-expt2/env-squared: ~A ~A" vals new-vals))
- (undo)
- (env-squared-channel '(0 0 1 1 2 -.5 3 0) #f)
- (set! vals (channel->vct))
- (undo)
- (env-expt-channel '(0 0 1 1 2 -.5 3 0) 2.0 #f)
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";env-expt2/env-squared unsymmetric: ~A ~A" vals new-vals))
- (undo)
-
- (ramp-expt 0.0 1.0 32.0)
- (set! vals (channel->vct))
- (undo)
- (env-expt-channel '(0 0 1 1) 32.0)
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";env-expt/ramp 32: ~A ~A" vals new-vals))
- (undo)
- (ramp-expt 0.0 1.0 32.0 #f 0 50)
- (set! vals (channel->vct))
- (undo)
- (env-expt-channel '(0 0 1 1 2 1) 32.0)
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";env-expt/ramp 1 32: ~A ~A" vals new-vals))
- (undo)
- (ramp-expt 0.0 1.0 .1)
- (set! vals (channel->vct))
- (undo)
- (env-expt-channel '(0 0 1 1) .1)
- (set! new-vals (channel->vct))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";env-expt/ramp .1: ~A ~A" vals new-vals))
- (undo)
-
- (env-expt-channel '(0 0 1 1 2 -.5 3 0) 12.0)
- (if (not (vequal (channel->vct 30 10) (vct 0.319 0.472 0.691 1.000 0.537 0.208 -0.022 -0.182 -0.291 -0.365)))
- (snd-display #__line__ ";env-expt to -.5 12.0: ~A" (channel->vct 30 10)))
- (undo)
- (env-expt-channel '(0 0 1 1 2 -.5 3 0) 12.0 #f)
- (if (not (vequal (channel->vct 30 10) (vct 0.319 0.472 0.691 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
- (snd-display #__line__ ";env-expt to -.5 12.0 unsymmetric: ~A" (channel->vct 30 10)))
- (undo)
- (close-sound ind))))
-
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "3rd ramp re-order tests" 101)))
- (offset-channel 1.0)
- (env-sound '(0 0 1 1))
- (contrast-channel 1.0)
- (let ((reader (make-sampler 0))
- (happy #t))
- (do ((i 0 (+ 1 i))
- (val 0.0 (+ val .01)))
- ((or (not happy) (= i 100)))
- (let ((y (reader))
- (ny (sin (+ (* val 0.5 pi) (* 1.0 (sin (* val 2.0 pi)))))))
- (if (fneq y ny)
- (begin
- (snd-display #__line__ ";contrast-channel: ~A ~A ~A" val y ny)
- (set! happy #f))))))
- (undo)
- (compand-channel)
- (let ((reader (make-sampler 0))
- (happy #t))
- (do ((i 0 (+ 1 i))
- (val 0.0 (+ val .01)))
- ((or (not happy) (= i 100)))
- (let ((y (reader))
- (ny (array-interp compand-table (+ 8.0 (* 8.0 val)) 17)))
- (if (fneq y ny)
- (begin
- (snd-display #__line__ ";compand-channel: ~A ~A ~A" val y ny)
- (set! happy #f))))))
- (undo 2)
- (ring-modulate-channel 1000)
- (let ((reader (make-sampler 0))
- (incr (/ (* 2 pi 1000) (srate)))
- (happy #t))
- (do ((i 0 (+ 1 i))
- (val 0.0 (+ val incr)))
- ((or (not happy) (= i 100)))
- (let ((y (reader))
- (ny (sin val)))
- (if (fneq y ny)
- (begin
- (snd-display #__line__ ";ring-modulate-channel: ~A ~A ~A" val y ny)
- (set! happy #f))))))
- (undo)
- (env-sound '(0 0 1 1))
- (smooth-channel-via-ptree)
- (let ((reader (make-sampler 0))
- (incr (/ pi 101))
- (happy #t))
- (do ((i 0 (+ 1 i))
- (val pi (+ val incr)))
- ((or (not happy) (= i 100)))
- (let ((y (reader))
- (ny (+ 0.5 (* 0.5 (cos val)))))
- (if (fneq y ny)
- (begin
- (snd-display #__line__ ";smooth-channel-via-ptree: ~A ~A ~A" val y ny)
- (set! happy #f))))))
- (undo 2)
- (env-channel '(0 1 1 0 2 1) 10 11)
- (if (not (vequal (channel->vct 0 30) (vct 1 1 1 1 1 1 1 1 1 1 1.000 0.800 0.600 0.400 0.200 0.000 0.200 0.400 0.600 0.800 1 1 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";env+ptree: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
- (close-sound ind))
-
- (let ((ind0 (open-sound "oboe.snd"))
- (ind1 (open-sound "pistol.snd")))
-
- (let ((clip (channel-clipped? ind0 0)))
- (if clip (snd-display #__line__ ";channel-clipped? oboe.snd -> ~A" clip)))
- (scale-to 1.5 ind0 0)
- (let ((clip (channel-clipped? ind0 0)))
- (if (not (= clip 4503)) (snd-display #__line__ ";channel-clipped after scale: ~A" clip)))
- (revert-sound ind0)
-
- (ramp-channel 0.0 1.0 0 #f ind1 0)
- (ramp-channel 0.0 1.0 0 #f ind1 0)
- (ramp-channel 0.0 1.0 0 #f ind1 0)
- (ramp-channel 0.0 1.0 0 #f ind1 0)
- (make-selection 1000 2000 ind1 0)
- (set! (sync ind0) 1)
- (set! (selected-sound) ind0)
- (env-selection '(0 0 1 1))
- (if (or (not (= (edit-position ind0 0) 0))
- (not (= (edit-position ind1 0) 5)))
- (snd-display #__line__ ";selection override of sync field: ~A ~A" (edit-position ind0 0) (edit-position ind1 0)))
- (env-sound '(0 0 1 1 2 0))
- (if (or (not (= (edit-position ind0 0) 1))
- (not (= (edit-position ind1 0) 5)))
- (snd-display #__line__ ";sync field over selection: ~A ~A" (edit-position ind0 0) (edit-position ind1 0)))
-
- (close-sound ind1)
- (revert-sound ind0)
- (let ((val (sample 1990)))
- (delay-channel 10)
- (if (fneq (sample 2000) val) (snd-display #__line__ ";delay-channel: ~A ~A" val (sample 2000))))
- (close-sound ind0))
-
- (let ((ind (new-sound "test.snd" :size 20)))
-
- (vct->channel (make-vct 20 1.0))
- (ramp-channel 0 1)
- (env-sound '(0 1 1 .5 2 .5 3 1) 0 20 .6)
- (let ((data (channel->vct)))
- (if (not (vequal data (vct 0.000 0.049 0.091 0.123 0.146 0.158 0.158 0.184 0.211 0.237 0.263 0.289 0.316 0.342 0.444 0.549 0.658 0.770 0.884 1.000)))
- (snd-display #__line__ ";env-sound xramp with flat segment: ~A" data)))
- (ptree-channel (lambda (y) (+ y .5)))
- (xramp-channel .1 .2 32.0)
- (let ((data (channel->vct)))
- (if (not (vequal data (vct 0.050 0.055 0.060 0.064 0.067 0.069 0.070 0.074 0.079 0.084 0.089 0.095 0.102 0.111 0.130 0.154 0.181 0.214 0.253 0.300)))
- (snd-display #__line__ ";ramp->xramp->ptree->xramp: ~A" data)))
-
- (set! (edit-position) 1)
- (ramp-channel 0 1)
- (env-sound '(0 1 1 0.0 2 0.0 3 1) 0 20 .6)
- (ptree-channel (lambda (y) (+ y .5)))
- (xramp-channel .1 .2 32.0)
- (let ((data (channel->vct)))
- (if (not (vequal data (vct 0.050 0.055 0.058 0.060 0.060 0.058 0.053 0.054 0.055 0.057 0.058 0.060 0.063 0.066 0.090 0.119 0.153 0.193 0.241 0.300)))
- (snd-display #__line__ ";1 ramp->xramp->ptree->xramp: ~A" data)))
-
- (set! (edit-position) 1)
- (env-sound '(0 1 1 0.5 2 0.5 3 1) 0 20 .6)
- (env-sound '(0 1 1 0 2 0 3 1) 0 20)
- (ptree-channel (lambda (y) (+ y .5)))
- (xramp-channel .1 .2 32.0)
- (let ((data (channel->vct)))
- (if (not (vequal data (vct 0.150 0.129 0.109 0.091 0.076 0.063 0.053 0.054 0.055 0.057 0.058 0.060 0.063 0.066 0.083 0.107 0.139 0.181 0.234 0.300)))
- (snd-display #__line__ ";2 ramp->xramp->ptree->xramp: ~A" data)))
-
- (close-sound ind))
-
- (let ((s1 (open-sound "oboe.snd")))
- (let ((s2 (copy s1)))
- (if (not (sound? s2))
- (snd-display #__line__ ";copy sound oboe -> ~A" s2)
- (begin
- (if (not (= (srate s1) (srate s2))) (snd-display #__line__ ";copy sounds srates: ~A ~A" (srate s1) (srate s2)))
- (if (not (= (frames s1) (frames s2))) (snd-display #__line__ ";copy sounds frames: ~A ~A" (frames s1) (frames s2)))
- (if (not (= (chans s1) (chans s2) 1)) (snd-display #__line__ ";copy sounds chans: ~A ~A" (chans s1) (chans s2)))
- (let ((r1 (make-sampler 0 s1))
- (r2 (make-sampler 0 s2))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i (frames s1))))
- (let ((v1 (r1))
- (v2 (r2)))
- (if (> (abs (- v1 v2)) .0001)
- (begin
- (set! happy #f)
- (snd-display #__line__ ";copied sound not equal? pos: ~A, ~A ~A" i v1 v2))))))
- (close-sound s2))))
- (fill! s1 0.0)
- (if (fneq (maxamp s1) 0.0) (snd-display #__line__ ";fill 1 with 0: ~A" (maxamp s1)))
- (fill! s1 0.3)
- (if (fneq (maxamp s1) 0.3) (snd-display #__line__ ";fill 1 with 0.3: ~A" (maxamp s1)))
- (close-sound s1))
-
- (let ((s1 (open-sound "2a.snd")))
- (let ((s2 (copy s1)))
- (if (not (sound? s2))
- (snd-display #__line__ ";copy sound 2a -> ~A" s2)
- (begin
- (if (not (= (srate s1) (srate s2))) (snd-display #__line__ ";copy sounds srates 2: ~A ~A" (srate s1) (srate s2)))
- (if (not (= (frames s1) (frames s2))) (snd-display #__line__ ";copy sounds frames 2: ~A ~A" (frames s1) (frames s2)))
- (if (not (= (chans s1) (chans s2) 2)) (snd-display #__line__ ";copy sounds chans 2: ~A ~A" (chans s1) (chans s2)))
- (let ((r10 (make-sampler 0 s1 0))
- (r11 (make-sampler 0 s1 1))
- (r20 (make-sampler 0 s2 0))
- (r21 (make-sampler 0 s2 1))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i (frames s1))))
- (let ((v1 (r10))
- (v2 (r20)))
- (if (> (abs (- v1 v2)) .0001)
- (begin
- (set! happy #f)
- (snd-display #__line__ ";copied sound 2 (0) not equal? pos: ~A, ~A ~A" i v1 v2))))
- (let ((v1 (r11))
- (v2 (r21)))
- (if (> (abs (- v1 v2)) .0001)
- (begin
- (set! happy #f)
- (snd-display #__line__ ";copied sound 2 (1) not equal? pos: ~A, ~A ~A" i v1 v2))))))
- (close-sound s2))))
- (fill! s1 0.0)
- (if (fneq (maxamp s1) 0.0) (snd-display #__line__ ";fill 2 with 0: ~A" (maxamp s1)))
- (fill! s1 0.3)
- (if (fneq (maxamp s1) 0.3) (snd-display #__line__ ";fill 2 with 0.3: ~A" (maxamp s1)))
- (close-sound s1))
-
- (for-each close-sound (sounds))
- (unselect-all)
- (let ((snd (open-sound "oboe.snd")))
- (make-selection 1000 2000 snd 0)
- (if (not (selection?)) (snd-display #__line__ ";make-selection for copy failed?"))
- (copy (selection))
- (let* ((r1 (make-sampler 1000 snd 0))
- (snds (sounds))
- (sel (if (equal? (car snds) snd) (cadr snds) (car snds)))
- (r2 (make-sampler 0 sel 0))
- (happy #t))
- (if (equal? sel snd)
- (snd-display #__line__ ";very weird: ~A equal? ~A from ~A (~A ~A ~A)" sel snd snds (car snds) (cadr snds) (equal? (car snds) snd)))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1000)))
- (let ((v1 (r1))
- (v2 (r2)))
- (if (> (abs (- v1 v2)) .0001)
+ (env-expt-channel '(0 0 1 1 2 -.5 3 0) 12.0)
+ (if (not (vequal (channel->float-vector 30 10) (float-vector 0.319 0.472 0.691 1.000 0.537 0.208 -0.022 -0.182 -0.291 -0.365)))
+ (snd-display #__line__ ";env-expt to -.5 12.0: ~A" (channel->float-vector 30 10)))
+ (undo)
+ (env-expt-channel '(0 0 1 1 2 -.5 3 0) 12.0 #f)
+ (if (not (vequal (channel->float-vector 30 10) (float-vector 0.319 0.472 0.691 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
+ (snd-display #__line__ ";env-expt to -.5 12.0 unsymmetric: ~A" (channel->float-vector 30 10)))
+ (undo)
+ (close-sound ind))))
+
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "third ramp re-order tests" 101)))
+ (offset-channel 1.0)
+ (env-sound '(0 0 1 1))
+ (contrast-channel 1.0)
+ (let ((reader (make-sampler 0))
+ (happy #t))
+ (do ((i 0 (+ i 1))
+ (val 0.0 (+ val .01)))
+ ((or (not happy) (= i 100)))
+ (let ((y (reader))
+ (ny (sin (+ (* val 0.5 pi) (* 1.0 (sin (* val 2.0 pi)))))))
+ (if (fneq y ny)
+ (begin
+ (snd-display #__line__ ";contrast-channel: ~A ~A ~A" val y ny)
+ (set! happy #f))))))
+ (close-sound ind))
+
+ (let ((ind0 (open-sound "oboe.snd"))
+ (ind1 (open-sound "pistol.snd")))
+
+ (let ((clip (channel-clipped? ind0 0)))
+ (if clip (snd-display #__line__ ";channel-clipped? oboe.snd -> ~A" clip)))
+ (scale-to 1.5 ind0 0)
+ (let ((clip (channel-clipped? ind0 0)))
+ (if (not (member clip (list 4502 4503))) (snd-display #__line__ ";channel-clipped after scale: ~A" clip)))
+ (revert-sound ind0)
+
+ (ramp-channel 0.0 1.0 0 #f ind1 0)
+ (ramp-channel 0.0 1.0 0 #f ind1 0)
+ (ramp-channel 0.0 1.0 0 #f ind1 0)
+ (ramp-channel 0.0 1.0 0 #f ind1 0)
+ (make-selection 1000 2000 ind1 0)
+ (set! (sync ind0) 1)
+ (set! (selected-sound) ind0)
+ (env-selection '(0 0 1 1))
+ (if (or (not (= (edit-position ind0 0) 0))
+ (not (= (edit-position ind1 0) 5)))
+ (snd-display #__line__ ";selection override of sync field: ~A ~A" (edit-position ind0 0) (edit-position ind1 0)))
+ (env-sound '(0 0 1 1 2 0))
+ (if (or (not (= (edit-position ind0 0) 1))
+ (not (= (edit-position ind1 0) 5)))
+ (snd-display #__line__ ";sync field over selection: ~A ~A" (edit-position ind0 0) (edit-position ind1 0)))
+
+ (close-sound ind1)
+ (revert-sound ind0)
+ (close-sound ind0))
+
+ (let ((s1 (open-sound "oboe.snd")))
+ (let ((s2 (copy s1)))
+ (if (not (sound? s2))
+ (snd-display #__line__ ";copy sound oboe -> ~A" s2)
+ (begin
+ (if (not (= (srate s1) (srate s2))) (snd-display #__line__ ";copy sounds srates: ~A ~A" (srate s1) (srate s2)))
+ (if (not (= (framples s1) (framples s2))) (snd-display #__line__ ";copy sounds framples: ~A ~A" (framples s1) (framples s2)))
+ (if (not (= (chans s1) (chans s2) 1)) (snd-display #__line__ ";copy sounds chans: ~A ~A" (chans s1) (chans s2)))
+ (let ((d1 (channel->float-vector 0 #f s1))
+ (d2 (channel->float-vector 0 #f s2)))
+ (if (not (vequal d1 d2))
+ (snd-display #__line__ ";copied sound not equal? ~A?" (float-vector-peak (float-vector-subtract! d0 d1)))))
+ (close-sound s2))))
+ (fill! s1 0.0)
+ (if (fneq (maxamp s1) 0.0) (snd-display #__line__ ";fill 1 with 0: ~A" (maxamp s1)))
+ (fill! s1 0.3)
+ (if (fneq (maxamp s1) 0.3) (snd-display #__line__ ";fill 1 with 0.3: ~A" (maxamp s1)))
+ (close-sound s1))
+
+ (let ((s1 (open-sound "2a.snd")))
+ (let ((s2 (copy s1)))
+ (if (not (sound? s2))
+ (snd-display #__line__ ";copy sound 2a -> ~A" s2)
+ (begin
+ (if (not (= (srate s1) (srate s2))) (snd-display #__line__ ";copy sounds srates 2: ~A ~A" (srate s1) (srate s2)))
+ (if (not (= (framples s1) (framples s2))) (snd-display #__line__ ";copy sounds framples 2: ~A ~A" (framples s1) (framples s2)))
+ (if (not (= (chans s1) (chans s2) 2)) (snd-display #__line__ ";copy sounds chans 2: ~A ~A" (chans s1) (chans s2)))
+ (let ((d10 (channel->float-vector 0 #f s1 0))
+ (d11 (channel->float-vector 0 #f s1 1))
+ (d20 (channel->float-vector 0 #f s2 0))
+ (d21 (channel->float-vector 0 #f s2 1)))
+ (if (not (vequal d10 d20))
+ (snd-display #__line__ ";copied sound 2 (0) not equal? ~A?" (float-vector-peak (float-vector-subtract! d10 d20))))
+ (if (not (vequal d11 d21))
+ (snd-display #__line__ ";copied sound 2 (1) not equal? ~A?" (float-vector-peak (float-vector-subtract! d11 d21)))))
+ (close-sound s2))))
+ (fill! s1 0.0)
+ (if (fneq (maxamp s1) 0.0) (snd-display #__line__ ";fill 2 with 0: ~A" (maxamp s1)))
+ (fill! s1 0.3)
+ (if (fneq (maxamp s1) 0.3) (snd-display #__line__ ";fill 2 with 0.3: ~A" (maxamp s1)))
+ (close-sound s1))
+
+ (for-each close-sound (sounds))
+ (unselect-all)
+ (let ((snd (open-sound "oboe.snd")))
+ (make-selection 1000 2000 snd 0)
+ (if (not (selection?)) (snd-display #__line__ ";make-selection for copy failed?"))
+ (copy (selection))
+ (let* ((r1 (channel->float-vector 1000 1000 snd 0))
+ (snds (sounds))
+ (sel (if (equal? (car snds) snd) (cadr snds) (car snds)))
+ (r2 (channel->float-vector 0 1000 sel 0)))
+ (if (equal? sel snd)
+ (snd-display #__line__ ";very weird: ~A equal? ~A from ~A (~A ~A ~A)" sel snd snds (car snds) (cadr snds) (equal? (car snds) snd)))
+ (if (not (vequal r1 r2))
+ (snd-display #__line__ ";copied selection not equal? ~A?" (float-vector-peak (float-vector-subtract! r1 r2))))
+ (close-sound sel)
+ (if (not (selection?))
+ (snd-display #__line__ ";copy selection unselected? ~A" (sounds))
+ (begin
+ (fill! (selection) 0.0)
+ (let ((r1 (channel->float-vector 1000 1000 snd 0)))
+ (if (> (float-vector-peak r1) 0.0)
+ (snd-display #__line__ ";fill! selection not 0.0? ~A" (float-vector-peak r1))))
+ (revert-sound snd)
+ (if (not (selection?))
+ (snd-display #__line__ ";revert-sound selection unselected?")
(begin
- (set! happy #f)
- (snd-display #__line__ ";copied selection not equal? pos: ~A, ~A ~A (~A ~A from ~A)" i v1 v2 sel snd snds)))))
- (close-sound sel)
- (if (not (selection?))
- (snd-display #__line__ ";copy selection unselected? ~A" (sounds))
- (begin
- (fill! (selection) 0.0)
- (let ((r1 (make-sampler 1000 snd 0))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1000)))
- (let ((v1 (r1)))
- (if (not (= v1 0.0))
- (begin
- (set! happy #f)
- (snd-display #__line__ ";fill! selection not 0.0? pos: ~A, ~A" i v1))))))
- (revert-sound snd)
- (if (not (selection?))
- (snd-display #__line__ ";revert-sound selection unselected?")
- (begin
- (fill! (selection) 0.3)
- (let ((r1 (make-sampler 1000 snd 0))
- (happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1000)))
- (let ((v1 (r1)))
- (if (not (= v1 0.3))
- (begin
- (set! happy #f)
- (snd-display #__line__ ";fill! selection not 0.3? pos: ~A, ~A" i v1)))))))))))
- (for-each close-sound (sounds)))
-
- (let ((snd (open-sound "oboe.snd")))
- (make-selection 1000 2000 snd 0)
- (if (not (selection?))
- (snd-display #__line__ ";make-selection failed?")
- (let ((sel-max (maxamp (selection)))
- (sel-len (length (selection))))
- (let ((mx (car (selection->mix))))
- (if (not (mix? mx))
- (snd-display #__line__ ";selection->mix: ~A" mx)
- (let ((mx-rd (make-mix-sampler mx 0))
- (snd-rd (make-sampler 1000 snd 0))
- (orig-rd (make-sampler 1000 snd 0 1 0)))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1000)))
- (let ((mx-val (mx-rd))
- (snd-val (snd-rd))
- (orig-val (orig-rd)))
- (if (or (fneq mx-val snd-val)
- (fneq snd-val orig-val))
- (begin
- (set! happy #f)
- (snd-display #__line__ ";selection->mix at ~A: ~A ~A ~A" (+ i 1000) mx-val snd-val orig-val))))))
- (if (not (= (length mx) sel-len 1001)) (snd-display #__line__ ";selection->mix mix length: ~A (~A)" (length mx) sel-len))
- (if (fneq (maxamp mx) sel-max) (snd-display #__line__ ";selection->mix maxamps: ~A ~A" (maxamp mx) sel-max)))))))
- (for-each close-sound (sounds)))
-
- (let ((snd (open-sound "2.snd")))
- (set! (sync snd) 1)
- ;; make-selection claims it follows the sync field
- (make-selection 2000 3000 snd)
- (if (not (selection?))
- (snd-display #__line__ ";make-selection (2) failed?")
- (let ((sel-max (maxamp (selection)))
- (sel-len (length (selection)))
- (sel-chns (channels (selection))))
- (if (not (= sel-chns 2)) (snd-display #__line__ ";make-selection stereo syncd chans: ~A" sel-chns))
- (if (not (= sel-len 1001)) (snd-display #__line__ ";make-selection stereo length: ~A" sel-len))
- (let* ((mx-list (selection->mix))
- (mx0 (car mx-list))
- (mx1 (cadr mx-list)))
- (if (or (not (mix? mx0))
- (not (mix? mx1)))
- (snd-display #__line__ ";selection->mix stereo: ~A ~A" mx0 mx1)
- (let ((mx0-rd (make-mix-sampler mx0 0))
- (mx1-rd (make-mix-sampler mx1 0))
- (snd0-rd (make-sampler 2000 snd 0))
- (snd1-rd (make-sampler 2000 snd 1))
- (orig0-rd (make-sampler 2000 snd 0 1 0))
- (orig1-rd (make-sampler 2000 snd 1 1 0)))
- (let ((happy #t))
- (do ((i 0 (+ i 1)))
- ((or (not happy)
- (= i 1000)))
- (let ((mx0-val (mx0-rd))
- (mx1-val (mx1-rd))
- (snd0-val (snd0-rd))
- (snd1-val (snd1-rd))
- (orig0-val (orig0-rd))
- (orig1-val (orig1-rd)))
- (if (or (fneq mx0-val snd0-val)
- (fneq snd0-val orig0-val))
- (begin
- (set! happy #f)
- (snd-display #__line__ ";selection->mix stereo 0 at ~A: ~A ~A ~A" (+ i 2000) mx0-val snd0-val orig0-val)))
- (if (or (fneq mx1-val snd1-val)
- (fneq snd1-val orig1-val))
- (begin
- (set! happy #f)
- (snd-display #__line__ ";selection->mix stereo 1 at ~A: ~A ~A ~A" (+ i 2000) mx1-val snd1-val orig1-val))))))))
-
- (if (not (= (length mx0) (length mx1) sel-len 1001))
- (snd-display #__line__ ";selection->mix stereo mix length: ~A ~A (~A)" (length mx0) (length mx1) sel-len))
- (if (fneq (max (maxamp mx0) (maxamp mx1)) sel-max)
- (snd-display #__line__ ";selection->mix stereo maxamps: ~A ~A ~A" (maxamp mx0) (maxamp mx1) sel-max)))))
- (for-each close-sound (sounds)))
-
- (clear-save-state-files)))
+ (fill! (selection) 0.3)
+ (let ((r1 (channel->float-vector 1000 1000 snd 0)))
+ (if (or (not (= (float-vector-max r1) 0.3))
+ (not (= (float-vector-min r1) 0.3)))
+ (snd-display #__line__ ";fill! selection not 0.3? ~A ~A" (float-vector-min r1) (float-vector-max r1)))))))))
+ (for-each close-sound (sounds)))
+
+ (let ((snd (open-sound "oboe.snd")))
+ (make-selection 1000 2000 snd 0)
+ (if (not (selection?))
+ (snd-display #__line__ ";make-selection failed?")
+ (let ((sel-max (maxamp (selection)))
+ (sel-len (length (selection))))
+ (let ((mx (car (selection->mix))))
+ (if (not (mix? mx))
+ (snd-display #__line__ ";selection->mix: ~A" mx)
+ (let ((mx-rd (make-mix-sampler mx 0))
+ (snd-rd (make-sampler 1000 snd 0))
+ (orig-rd (make-sampler 1000 snd 0 1 0)))
+ (let ((happy #t))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy)
+ (= i 1000)))
+ (let ((mx-val (mx-rd))
+ (snd-val (snd-rd))
+ (orig-val (orig-rd)))
+ (if (or (fneq mx-val snd-val)
+ (fneq snd-val orig-val))
+ (begin
+ (set! happy #f)
+ (snd-display #__line__ ";selection->mix at ~A: ~A ~A ~A" (+ i 1000) mx-val snd-val orig-val))))))
+ (if (not (= (length mx) sel-len 1001)) (snd-display #__line__ ";selection->mix mix length: ~A (~A)" (length mx) sel-len))
+ (if (fneq (maxamp mx) sel-max) (snd-display #__line__ ";selection->mix maxamps: ~A ~A" (maxamp mx) sel-max)))))))
+ (for-each close-sound (sounds)))
+
+ (let ((snd (open-sound "2.snd")))
+ (set! (sync snd) 1)
+ ;; make-selection claims it follows the sync field
+ (make-selection 2000 3000 snd)
+ (if (not (selection?))
+ (snd-display #__line__ ";make-selection (2) failed?")
+ (let ((sel-max (maxamp (selection)))
+ (sel-len (length (selection)))
+ (sel-chns (channels (selection))))
+ (if (not (= sel-chns 2)) (snd-display #__line__ ";make-selection stereo syncd chans: ~A" sel-chns))
+ (if (not (= sel-len 1001)) (snd-display #__line__ ";make-selection stereo length: ~A" sel-len))
+ (let* ((mx-list (selection->mix))
+ (mx0 (car mx-list))
+ (mx1 (cadr mx-list)))
+ (if (or (not (mix? mx0))
+ (not (mix? mx1)))
+ (snd-display #__line__ ";selection->mix stereo: ~A ~A" mx0 mx1)
+ (let ((mx0-rd (make-mix-sampler mx0 0))
+ (mx1-rd (make-mix-sampler mx1 0))
+ (snd0-rd (make-sampler 2000 snd 0))
+ (snd1-rd (make-sampler 2000 snd 1))
+ (orig0-rd (make-sampler 2000 snd 0 1 0))
+ (orig1-rd (make-sampler 2000 snd 1 1 0)))
+ (let ((happy #t))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy)
+ (= i 1000)))
+ (let ((mx0-val (mx0-rd))
+ (mx1-val (mx1-rd))
+ (snd0-val (snd0-rd))
+ (snd1-val (snd1-rd))
+ (orig0-val (orig0-rd))
+ (orig1-val (orig1-rd)))
+ (if (or (fneq mx0-val snd0-val)
+ (fneq snd0-val orig0-val))
+ (begin
+ (set! happy #f)
+ (snd-display #__line__ ";selection->mix stereo 0 at ~A: ~A ~A ~A" (+ i 2000) mx0-val snd0-val orig0-val)))
+ (if (or (fneq mx1-val snd1-val)
+ (fneq snd1-val orig1-val))
+ (begin
+ (set! happy #f)
+ (snd-display #__line__ ";selection->mix stereo 1 at ~A: ~A ~A ~A" (+ i 2000) mx1-val snd1-val orig1-val))))))))
+
+ (if (not (= (length mx0) (length mx1) sel-len 1001))
+ (snd-display #__line__ ";selection->mix stereo mix length: ~A ~A (~A)" (length mx0) (length mx1) sel-len))
+ (if (fneq (max (maxamp mx0) (maxamp mx1)) sel-max)
+ (snd-display #__line__ ";selection->mix stereo maxamps: ~A ~A ~A" (maxamp mx0) (maxamp mx1) sel-max)))))
+ (for-each close-sound (sounds)))
+
+ (let ((ind (new-sound :size 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (sample i ind 0) (* .1 i)))
+ (let ((rd (make-sampler 3 ind 0)))
+ (let ((val (read-sample-with-direction rd 1)))
+ (if (fneq val .3) (snd-display #__line__ ";read-sample-with-direction 3: ~A" val))
+ (read-sample-with-direction rd -1)
+ (set! val (read-sample-with-direction rd -1))
+ (if (fneq val .2) (snd-display #__line__ ";read-sample-with-direction 2: ~A" val))
+ (set! val (read-sample-with-direction rd -1))
+ (if (fneq val .1) (snd-display #__line__ ";read-sample-with-direction 1: ~A" val))
+ (close-sound ind))))
+
+ (clear-save-state-files))
-;;; ---------------- test 6: vcts ----------------
+;;; ---------------- test 6: float-vectors ----------------
(define (snd_test_6)
- (begin
-
- (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
- (log-mem clmtest)
- (let ((v0 (make-vct 10))
- (v1 (make-vct 10))
- (vlst (make-vct 3)))
- (if (not (vct? v0)) (snd-display #__line__ ";v0 isn't a vct?!?"))
- (if (equal? v0 10) (snd-display #__line__ ";v0 is 10!?"))
- (if (vct? 10) (snd-display #__line__ ";10 is a vct?"))
- (if (not (= (vct-length v0) 10)) (snd-display #__line__ ";v0 length = ~D?" (vct-length v0)))
- (vct-fill! v0 1.0)
- (vct-fill! v1 0.5)
- (if (equal? v0 v1) (snd-display #__line__ ";vct equal? ~A ~A" v0 v1))
- (if (eq? v0 v1) (snd-display #__line__ ";vct eq? ~A ~A" v0 v1))
- (let ((v2 v1)
- (v3 (make-vct 10))
- (v4 (make-vct 3)))
- (if (not (eq? v1 v2)) (snd-display #__line__ ";vct not eq? ~A ~A" v1 v2))
- (vct-fill! v3 0.5)
- (if (not (equal? v3 v1)) (snd-display #__line__ ";vct not equal? ~A ~A" v3 v1))
- (if (equal? v4 v1) (snd-display #__line__ ";len diff vct equal? ~A ~A" v4 v1))
- (set! (vct-ref v3 0) 1.0)
- (if (fneq (vct-ref v3 0) 1.0) (snd-display #__line__ ";set! vct-ref: ~A" (vct-ref v3 0))))
- (vct-set! vlst 1 .1)
- (if (not (feql (vct->list vlst) (list 0.0 0.1 0.0))) (snd-display #__line__ ";vct->list: ~A?" (vct->list vlst)))
- (let* ((vect '#(0.0 1.0 2.0 3.0))
- (v123 (vct 0.0 1.0 2.0 3.0))
- (v2 (vector->vct vect))
- (v3 v2)
- (str (format #f "~A" v2))
- (str1 (format #f "~A" (make-vct 32))))
- (if (not (vct? (vector->vct (make-vector 0)))) (snd-display #__line__ ";vector->vct empty vect: ~A" (vector->vct (make-vector 0))))
- (if (not (string=? str "#<vct[len=4]: 0.000 1.000 2.000 3.000>"))
- (snd-display #__line__ ";vct print: ~% ~A~% ~A?" str v2))
- (if (and (= (print-length) 12)
- (not (string=? str1 "#<vct[len=32]: 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 ...>")))
- (snd-display #__line__ ";vct(32) print: ~% ~A~%" str1))
- (if (not (vequal v123 v2)) (snd-display #__line__ ";vector->vct: ~A" v2))
- (if (not (equal? (vct->vector v123) vect)) (snd-display #__line__ ";vct->vector: ~A ~A" vect (vct->vector v123)))
- (if (not (equal? v3 v2)) (snd-display #__line__ ";vct=? ~A ~A?" v2 v3))
- (if (not (= (vct-length v2) 4)) (snd-display #__line__ ";vector->vct length: ~A?" (vct-length v2)))
- (if (fneq (vct-ref v2 2) 2.0) (snd-display #__line__ ";vector->vct: ~A?" v2))
- (vct-move! v2 0 2)
- (if (fneq (vct-ref v2 0) 2.0) (snd-display #__line__ ";vct-move!: ~A?" v2)))
- (let ((v2 (make-vct 4)))
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (vct-set! v2 i i))
- (vct-move! v2 3 2 #t)
- (if (or (fneq (vct-ref v2 3) 2.0) (fneq (vct-ref v2 2) 1.0))
- (snd-display #__line__ ";vct-move! back: ~A?" v2)))
-
- (if (not (string=? (vct->string (vct 1.0 2.0)) "(vct 1.000 2.000)"))
- (snd-display #__line__ ";vct->string: ~A" (vct->string (vct 1.0 2.0))))
-
- (if (not (vequal (vct 4 3 2 1) (vct-reverse! (vct 1 2 3 4)))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3 4))))
- (if (not (vequal (vct 3 2 1) (vct-reverse! (vct 1 2 3)))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3))))
- (if (not (vequal (vct 2 1) (vct-reverse! (vct 1 2)))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2))))
- (if (not (vequal (vct 1) (vct-reverse! (vct 1)))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1))))
- (if (not (vequal (vct 4 3 2 1) (vct-reverse! (vct 1 2 3 4) 4))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3 4))))
- (if (not (vequal (vct 3 2 1) (vct-reverse! (vct 1 2 3) 3))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2 3))))
- (if (not (vequal (vct 2 1) (vct-reverse! (vct 1 2) 2))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1 2))))
- (if (not (vequal (vct 1) (vct-reverse! (vct 1) 1))) (snd-display #__line__ ";vct-reverse: ~A" (vct-reverse! (vct 1))))
-
- (if (not (vequal (vct 3 2 1) (reverse (vct 1 2 3)))) (snd-display #__line__ ";reverse(vct): ~A" (reverse (vct 1 2 3))))
- (let ((v (vct 3 2 1)))
- (let ((rv (reverse v)))
- (if (or (not (vequal v (vct 3 2 1)))
- (not (vequal rv (vct 1 2 3))))
- (snd-display #__line__ ";reverse(vct) -> ~A ~A" v rv))))
-
- (let ((v0 (make-vct 3)))
- (let ((var (catch #t (lambda () (vct-ref v0 10)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct-ref high index: ~A" var)))
- (let ((var (catch #t (lambda () (vct-ref v0 -1)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct-ref low index: ~A" var)))
- (let ((var (catch #t (lambda () (vct-set! v0 10 1.0)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct-set! high index: ~A" var)))
- (let ((var (catch #t (lambda () (vct-set! v0 -1 1.0)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct-set! low index: ~A" var)))
- (let ((var (catch #t (lambda () (vct-move! v0 10 0 #t)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct-move! high index: ~A" var)))
- (let ((var (catch #t (lambda () (vct-move! v0 0 10 #t)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct-move! high 2 index: ~A" var)))
- (let ((var (catch #t (lambda () (vct-move! v0 -10 0 #f)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct-move! back high index: ~A" var)))
- (let ((var (catch #t (lambda () (vct-move! v0 0 -10 #f)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";vct-move! back high 2 index: ~A" var))))
-
- (do ((i 0 (+ 1 i)))
+ (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
+ (log-mem clmtest)
+ (let ((v0 (make-float-vector 10))
+ (v1 (make-float-vector 10))
+ (vlst (make-float-vector 3)))
+ (if (not (float-vector? v0)) (snd-display #__line__ ";v0 isn't a float-vector?!?"))
+ (if (eqv? v0 10) (snd-display #__line__ ";v0 is 10!?"))
+ (if (float-vector? 10) (snd-display #__line__ ";10 is a float-vector?"))
+ (if (not (= (length v0) 10)) (snd-display #__line__ ";v0 length = ~D?" (length v0)))
+ (fill! v0 1.0)
+ (fill! v1 0.5)
+ (if (equal? v0 v1) (snd-display #__line__ ";float-vector equal? ~A ~A" v0 v1))
+ (if (eq? v0 v1) (snd-display #__line__ ";float-vector eq? ~A ~A" v0 v1))
+ (if (fneq (float-vector-max v0) 1.0) (snd-display #__line__ ";float-vector max ~A" (float-vector-max v0)))
+ (if (fneq (float-vector-min v0) 1.0) (snd-display #__line__ ";float-vector min ~A" (float-vector-max v0)))
+ (let ((v2 v1)
+ (v3 (make-float-vector 10))
+ (v4 (make-float-vector 3)))
+ (if (not (eq? v1 v2)) (snd-display #__line__ ";float-vector not eq? ~A ~A" v1 v2))
+ (fill! v3 0.5)
+ (if (not (equal? v3 v1)) (snd-display #__line__ ";float-vector not equal? ~A ~A" v3 v1))
+ (if (equal? v4 v1) (snd-display #__line__ ";len diff float-vector equal? ~A ~A" v4 v1))
+ (set! (v3 0) 1.0)
+ (if (fneq (v3 0) 1.0) (snd-display #__line__ ";set! float-vector-ref: ~A" (v3 0))))
+ (set! (vlst 1) .1)
+ (if (not (feql (map values vlst) (list 0.0 0.1 0.0))) (snd-display #__line__ ";vector->list: ~A?" (map values vlst)))
+ (let ((v2 (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (set! (v2 i) i))
+ (float-vector-move! v2 3 2 #t)
+ (if (or (fneq (v2 3) 2.0) (fneq (v2 2) 1.0))
+ (snd-display #__line__ ";float-vector-move! back: ~A?" v2)))
+
+ (if (not (string=? (float-vector->string (float-vector 1.0 2.0)) "(float-vector 1.000 2.000)"))
+ (snd-display #__line__ ";float-vector->string: ~A" (float-vector->string (float-vector 1.0 2.0))))
+
+ (if (not (vequal (float-vector 4 3 2 1) (reverse! (float-vector 1 2 3 4)))) (snd-display #__line__ ";float-vector-reverse: ~A" (reverse! (float-vector 1 2 3 4))))
+ (if (not (vequal (float-vector 3 2 1) (reverse! (float-vector 1 2 3)))) (snd-display #__line__ ";float-vector-reverse: ~A" (reverse! (float-vector 1 2 3))))
+ (if (not (vequal (float-vector 2 1) (reverse! (float-vector 1 2)))) (snd-display #__line__ ";float-vector-reverse: ~A" (reverse! (float-vector 1 2))))
+ (if (not (vequal (float-vector 1) (reverse! (float-vector 1)))) (snd-display #__line__ ";float-vector-reverse: ~A" (reverse! (float-vector 1))))
+ (if (not (vequal (float-vector 3 2 1) (reverse (float-vector 1 2 3)))) (snd-display #__line__ ";reverse(float-vector): ~A" (reverse (float-vector 1 2 3))))
+ (let ((v (float-vector 3 2 1)))
+ (let ((rv (reverse v)))
+ (if (not (vequal rv (float-vector 1 2 3)))
+ (snd-display #__line__ ";reverse(float-vector) -> ~A ~A" v rv))))
+
+ (let ((v0 (make-float-vector 3)))
+ (let ((var (catch #t (lambda () (v0 10)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";float-vector-ref high index: ~A" var)))
+ (let ((var (catch #t (lambda () (v0 -1)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";float-vector-ref low index: ~A" var)))
+ (let ((var (catch #t (lambda () (set! (v0 10) 1.0)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";float-vector-set! high index: ~A" var)))
+ (let ((var (catch #t (lambda () (set! (v0 -1) 1.0)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";float-vector-set! low index: ~A" var)))
+ (let ((var (catch #t (lambda () (float-vector-move! v0 10 0 #t)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";float-vector-move! high index: ~A" var)))
+ (let ((var (catch #t (lambda () (float-vector-move! v0 0 10 #t)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";float-vector-move! high 2 index: ~A" var)))
+ (let ((var (catch #t (lambda () (float-vector-move! v0 -10 0 #f)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";float-vector-move! back high index: ~A" var)))
+ (let ((var (catch #t (lambda () (float-vector-move! v0 0 -10 #f)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";float-vector-move! back high 2 index: ~A" var))))
+
+ (let ((v (float-vector 0.0 1.0 -2.0 -3.0)))
+ (if (not (vequal (float-vector-abs! v) (float-vector 0.0 1.0 2.0 3.0)))
+ (snd-display #__line__ ";float-vector-abs! ~A" v)))
+
+ ;; float-vector-add! + shared-vector:
+ (let ((fv (float-vector 1 2 3 4 5)))
+ (let ((sv (make-shared-vector fv '(4) 1)))
+ (float-vector-add! sv fv)
+ (if (not (vequal fv (float-vector 1.0 3.0 6.0 10.0 15.0)))
+ (snd-display #__line__ ";float-vector+shared-vector: ~A" fv))))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (v0 i) 1.0) (snd-display #__line__ ";fill v0[~D] = ~F?" i (v0 i)))
+ (if (fneq (v1 i) 0.5) (snd-display #__line__ ";preset v1[~D] = ~F?" i (v1 i))))
+ (float-vector-add! v0 v1)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (v0 i) 1.5) (snd-display #__line__ ";add v0[~D] = ~F?" i (v0 i))))
+ (float-vector-subtract! v0 v1)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (v0 i) 1.0) (snd-display #__line__ ";subtract v0[~D] = ~F?" i (v0 i))))
+ (let ((v2 (copy v0)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (if (fneq (vct-ref v0 i) 1.0) (snd-display #__line__ ";fill v0[~D] = ~F?" i (vct-ref v0 i)))
- (if (fneq (vct-ref v1 i) 0.5) (snd-display #__line__ ";preset v1[~D] = ~F?" i (vct-ref v1 i))))
- (vct-add! v0 v1)
- (do ((i 0 (+ 1 i)))
+ (if (fneq (v2 i) 1.0) (snd-display #__line__ ";copy v0[~D] = ~F?" i (v2 i))))
+ (float-vector-scale! v2 5.0)
+ (do ((i 0 (+ i 1)))
((= i 10))
- (if (fneq (vct-ref v0 i) 1.5) (snd-display #__line__ ";add v0[~D] = ~F?" i (vct-ref v0 i))))
- (vct-subtract! v0 v1)
- (do ((i 0 (+ 1 i)))
+ (if (fneq (v2 i) 5.0) (snd-display #__line__ ";scale v2[~D] = ~F?" i (v2 i))))
+ (float-vector-offset! v0 -1.0)
+ (do ((i 0 (+ i 1)))
((= i 10))
- (if (fneq (vct-ref v0 i) 1.0) (snd-display #__line__ ";subtract v0[~D] = ~F?" i (vct-ref v0 i))))
- (let ((v2 (vct-copy v0)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (vct-ref v2 i) 1.0) (snd-display #__line__ ";copy v0[~D] = ~F?" i (vct-ref v2 i))))
- (vct-scale! v2 5.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (vct-ref v2 i) 5.0) (snd-display #__line__ ";scale v2[~D] = ~F?" i (vct-ref v2 i))))
- (vct-offset! v0 -1.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (vct-ref v0 i) 0.0) (snd-display #__line__ ";offset v0[~D] = ~F?" i (vct-ref v0 i))))
- (vct-multiply! v2 v1)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (vct-ref v2 i) 2.5) (snd-display #__line__ ";multiply v2[~D] = ~F?" i (vct-ref v2 i))))
- (if (fneq (vct-peak v2) 2.5) (snd-display #__line__ ";v2's peak is ~F?" (vct-peak v2)))
- (vct-set! v2 5 123.0)
- (if (fneq (vct-peak v2) 123.0) (snd-display #__line__ ";v2's set peak is ~F?" (vct-peak v2)))
- (let ((vn (make-vct 32))
- (vb (make-vct 64))
- (vs (make-vct 3))
- (vss (make-vct 1)))
- (do ((i 0 (+ 1 i)))
- ((= i 32))
- (vct-set! vn i i))
- (let ((vnew (vct-subseq vn 3)))
- (if (fneq (vct-ref vnew 0) 3.0) (snd-display #__line__ ";vct-subseq[3:] ~A?" (vct-ref vnew 0)))
- (if (not (= (vct-length vnew) 29)) (snd-display #__line__ ";vct-subseq[3:] length: ~A?" (vct-length vnew))))
- (let ((vnew (vct-subseq vn 3 8)))
- (if (fneq (vct-ref vnew 0) 3.0) (snd-display #__line__ ";vct-subseq[3:8] ~A?" (vct-ref vnew 0)))
- (if (not (= (vct-length vnew) 6)) (snd-display #__line__ ";vct-subseq[3:8] length: ~A?" (vct-length vnew))))
- (vct-subseq vn 3 3 vs)
- (if (or (fneq (vct-ref vs 0) 3.0)
- (fneq (vct-ref vs 1) 0.0)
- (fneq (vct-ref vs 2) 0.0))
- (snd-display #__line__ ";vct-subseq[3:3->vs] ~A?" vs))
- (vct-subseq vn 0 32 vs)
- (if (not (= (vct-length vs) 3)) (snd-display #__line__ ";vct-subseq[0:32->vs] length: ~A?" (vct-length vs)))
- (vct-subseq vn 2 3 vss)
- (if (fneq (vct-ref vss 0) 2.0) (snd-display #__line__ ";vct-subseq[2:3->vss] ~A?" (vct-ref vss 0)))
- (vct-set! vb 8 123.0)
- (vct-subseq vn 1 8 vb)
- (if (fneq (vct-ref vb 0) 1.0) (snd-display #__line__ ";vct-subseq[1:8->vb] ~A?" (vct-ref vb 0)))
- (if (fneq (vct-ref vb 8) 123.0) (snd-display #__line__ ";vct-subseq[1:8->vb][8] ~A?" (vct-ref vb 8))))
-
- (let ((v1 (make-vct 3 .1))
- (v2 (make-vct 4 .2)))
- (let ((val (vct+ (vct-copy v1) v2)))
- (if (not (vequal val (vct .3 .3 .3))) (snd-display #__line__ ";vct+ .1 .2: ~A" val)))
- (vct-set! v1 1 .3)
- (let ((val (vct+ (vct-copy v1) v2)))
- (if (not (vequal val (vct .3 .5 .3))) (snd-display #__line__ ";vct+ .1 .2 (1): ~A" val)))
- (let ((val (vct+ (vct-copy v1) 2.0)))
- (if (not (vequal val (vct 2.1 2.3 2.1))) (snd-display #__line__ ";vct+ .1 2.0: ~A" val)))
- (let ((val (vct+ 2.0 (vct-copy v1))))
- (if (not (vequal val (vct 2.1 2.3 2.1))) (snd-display #__line__ ";vct+ .1 2.0 (1): ~A" val)))
- (let ((val (vct* 2.0 (vct-copy v1))))
- (if (not (vequal val (vct .2 .6 .2))) (snd-display #__line__ ";vct* 2.0: ~A" val)))
- (let ((val (vct* (vct-copy v1) 2.0)))
- (if (not (vequal val (vct .2 .6 .2))) (snd-display #__line__ ";vct* 2.0 (1): ~A" val)))
- (let ((val (vct* (vct-copy v1) v2)))
- (if (not (vequal val (vct .02 .06 .02))) (snd-display #__line__ ";vct* v1 v2: ~A" val))))
-
- (vct-map! v0 (lambda () 1.0))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (vct-ref v0 i) 1.0) (snd-display #__line__ ";map v0[~D] = ~F?" i (vct-ref v0 i)))))
-
- (if (fneq ((vct 1.0 2.0 3.0) 1) 2.0)
- (snd-display #__line__ ";(vct...) = ~A?" ((vct 1.0 2.0 3.0) 1)))
- (let ((v1 (vct 1 2 3 4)))
- (if (fneq (v1 1) 2.0)
- (snd-display #__line__ ";(v1 1) = ~A?" (v1 1))))
-
- (let ((ind (open-sound "oboe.snd"))
- (ctr 0))
+ (if (fneq (v0 i) 0.0) (snd-display #__line__ ";offset v0[~D] = ~F?" i (v0 i))))
+ (float-vector-multiply! v2 v1)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (v2 i) 2.5) (snd-display #__line__ ";multiply v2[~D] = ~F?" i (v2 i))))
+ (if (fneq (float-vector-peak v2) 2.5) (snd-display #__line__ ";v2's peak is ~F?" (float-vector-peak v2)))
+ (set! (v2 5) 123.0)
+ (if (fneq (float-vector-peak v2) 123.0) (snd-display #__line__ ";v2's set peak is ~F?" (float-vector-peak v2)))
+ (let ((vn (make-float-vector 32))
+ (vb (make-float-vector 64))
+ (vs (make-float-vector 3))
+ (vss (make-float-vector 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 32))
+ (set! (vn i) i))
+ (let ((vnew (float-vector-subseq vn 3)))
+ (if (fneq (vnew 0) 3.0) (snd-display #__line__ ";float-vector-subseq[3:] ~A?" (vnew 0)))
+ (if (not (= (length vnew) 29)) (snd-display #__line__ ";float-vector-subseq[3:] length: ~A?" (length vnew))))
+ (let ((vnew (float-vector-subseq vn 3 8)))
+ (if (fneq (vnew 0) 3.0) (snd-display #__line__ ";float-vector-subseq[3:8] ~A?" (vnew 0)))
+ (if (not (= (length vnew) 6)) (snd-display #__line__ ";float-vector-subseq[3:8] length: ~A?" (length vnew))))
+ (float-vector-subseq vn 3 3 vs)
+ (if (or (fneq (vs 0) 3.0)
+ (fneq (vs 1) 0.0)
+ (fneq (vs 2) 0.0))
+ (snd-display #__line__ ";float-vector-subseq[3:3->vs] ~A?" vs))
+ (float-vector-subseq vn 0 32 vs)
+ (if (not (= (length vs) 3)) (snd-display #__line__ ";float-vector-subseq[0:32->vs] length: ~A?" (length vs)))
+ (float-vector-subseq vn 2 3 vss)
+ (if (fneq (vss 0) 2.0) (snd-display #__line__ ";float-vector-subseq[2:3->vss] ~A?" (vss 0)))
+ (set! (vb 8) 123.0)
+ (float-vector-subseq vn 1 8 vb)
+ (if (fneq (vb 0) 1.0) (snd-display #__line__ ";float-vector-subseq[1:8->vb] ~A?" (vb 0)))
+ (if (fneq (vb 8) 123.0) (snd-display #__line__ ";float-vector-subseq[1:8->vb][8] ~A?" (vb 8))))
+
+ (let ((v (make-float-vector 20))
+ (mn 1.0)
+ (mx -1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 20))
+ (let ((val (mus-random 1.0)))
+ (set! (v i) val)
+ (if (< val mn) (set! mn val))
+ (if (> val mx) (set! mx val))))
+ (if (fneq (float-vector-min v) mn) (snd-display #__line__ ";float-vector-min ran: ~A ~A" (float-vector-min v) mn))
+ (if (fneq (float-vector-max v) mx) (snd-display #__line__ ";float-vector-max ran: ~A ~A" (float-vector-max v) mx))
+ (if (fneq (float-vector-peak v) (max (abs mn) (abs mx))) (snd-display #__line__ ";float-vector-peak ran: ~A ~A ~A" (float-vector-peak v) mn mx)))
+
+ (let ((v1 (make-float-vector 3 .1))
+ (v2 (make-float-vector 4 .2)))
+ (let ((val (float-vector+ (copy v1) v2)))
+ (if (not (vequal val (float-vector .3 .3 .3))) (snd-display #__line__ ";float-vector+ .1 .2: ~A" val)))
+ (set! (v1 1) .3)
+ (let ((val (float-vector+ (copy v1) v2)))
+ (if (not (vequal val (float-vector .3 .5 .3))) (snd-display #__line__ ";float-vector+ .1 .2 (1): ~A" val)))
+ (let ((val (float-vector+ (copy v1) 2.0)))
+ (if (not (vequal val (float-vector 2.1 2.3 2.1))) (snd-display #__line__ ";float-vector+ .1 2.0: ~A" val)))
+ (let ((val (float-vector+ 2.0 (copy v1))))
+ (if (not (vequal val (float-vector 2.1 2.3 2.1))) (snd-display #__line__ ";float-vector+ .1 2.0 (1): ~A" val)))
+ (let ((val (float-vector* 2.0 (copy v1))))
+ (if (not (vequal val (float-vector .2 .6 .2))) (snd-display #__line__ ";float-vector* 2.0: ~A" val)))
+ (let ((val (float-vector* (copy v1) 2.0)))
+ (if (not (vequal val (float-vector .2 .6 .2))) (snd-display #__line__ ";float-vector* 2.0 (1): ~A" val)))
+ (let ((val (float-vector* (copy v1) v2)))
+ (if (not (vequal val (float-vector .02 .06 .02))) (snd-display #__line__ ";float-vector* v1 v2: ~A" val))))
+
+ (fill! v0 1.0)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (v0 i) 1.0) (snd-display #__line__ ";map v0[~D] = ~F?" i (v0 i)))))
+
+ (if (fneq ((float-vector 1.0 2.0 3.0) 1) 2.0)
+ (snd-display #__line__ ";(float-vector...) = ~A?" ((float-vector 1.0 2.0 3.0) 1)))
+ (let ((v1 (float-vector 1 2 3 4)))
+ (if (fneq (v1 1) 2.0)
+ (snd-display #__line__ ";(v1 1) = ~A?" (v1 1))))
+
+ (when with-gui
+ (let ((ind (open-sound "oboe.snd")))
(set! (speed-control ind) .5)
(play :wait #t)
(apply-controls)
@@ -14456,259 +9434,101 @@ EDITS: 2
(set! (speed-control ind) -1.0)
(apply-controls)
(if (not (= (edit-position ind) 1))
- (snd-display #__line__ ";apply-controls with srate -1.0: ~A ~A" (edits ind) (edit-tree ind)))
- (if (> (abs (- (frames ind 0) (frames ind 0 0))) 2)
- (snd-display #__line__ ";apply-controls srate -1.0 lengths: ~A ~A" (frames ind 0) (frames ind 0 0)))
+ (snd-display #__line__ ";apply-controls with srate -1.0: ~A ~A ~A" (edit-position ind) (edits ind) (edit-tree ind)))
+ (if (> (abs (- (framples ind 0) (framples ind 0 0))) 2)
+ (snd-display #__line__ ";apply-controls srate -1.0 lengths: ~A ~A" (framples ind 0) (framples ind 0 0)))
(if (or (fneq (maxamp) .147)
(< (abs (sample 9327)) .01))
(snd-display #__line__ ";apply-controls srate -1.0 samples: ~A ~A" (maxamp) (sample 9327)))
(if (fneq (speed-control ind) 1.0) (snd-display #__line__ ";apply-controls -1.0 -> ~A?" (speed-control ind)))
- (hook-push dac-hook (lambda (data)
- (set! ctr (+ 1 ctr))
- (if (>= ctr 3) (set! (playing) #f))))
- (play :wait #t)
- (if (not (= ctr 3)) (snd-display #__line__ ";ctr after dac-hook: ~A" ctr))
- (set! ctr 0)
- (set! (speed-control) 1.5)
- (apply-controls)
- ; (if (fneq (sample 28245) 0.0) (snd-display #__line__ ";dac-hook stop apply-controls? ~A" (sample 28245)))
- (set! (hook-functions dac-hook) '())
- (revert-sound)
- (set! (speed-control) 1.5)
- (set! ctr 0)
- (hook-push dac-hook (lambda (data)
- (set! ctr (+ 1 ctr))
- (if (= ctr 3) (apply-controls))))
- (play :wait #t)
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";apply-controls from hook: ~A ~A" (edits ind) (edit-tree ind)))
- (revert-sound)
- (set! (hook-functions dac-hook) '())
- (set! (speed-control) 1.5)
- (stop-playing)
- (hook-push after-apply-controls-hook (lambda (s)
+ (hook-push after-apply-controls-hook (lambda (hook)
(let ((tag (catch #t
- (lambda () (apply-controls))
- (lambda args args))))
+ apply-controls
+ (lambda args args))))
(if (not (eq? (car tag) 'cannot-apply-controls))
(snd-display #__line__ ";after-apply-controls-hook: recursive attempt apply-controls: ~A" tag)))))
(apply-controls)
- (set! (hook-functions after-apply-controls-hook) '())
- (hook-push dac-hook (lambda (s)
- (let ((tag (catch #t
- (lambda () (apply-controls))
- (lambda args args))))
- (if (not (eq? (car tag) 'cannot-apply-controls))
- (snd-display #__line__ ";dac-hook: recursive attempt apply-controls: ~A" tag)))))
- (set! (hook-functions dac-hook) '())
-
+ (set! (hook-functions after-apply-controls-hook) ())
(revert-sound)
- (close-sound ind))
-
- (let ((v1 (make-vct 32)))
- (vct-map! v1
- (lambda ()
- (let ((v2 (make-vct 3)))
- (vct-map! v2 (lambda () .1))
- (vct-ref v2 0))))
- (if (fneq (vct-ref v1 12) .1) (snd-display #__line__ ";vct-map! twice: ~A" (vct-ref v1 12))))
- (let ((hi (make-vct 3)))
- (let ((tag (catch #t
- (lambda () (vct-subseq hi 1 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";vct-subseq 1 0: ~A" tag)))
- (if (not (vct? (vct))) (snd-display #__line__ ";(vct) -> ~A" (vct)))
- (let ((tag (catch #t (lambda () (make-vct 0)) (lambda args (car args)))))
- (if (not (vct? tag)) (snd-display #__line__ ";make-vct 0 -> ~A" tag)))
- (let ((ho (make-vct 3)))
- (vct-add! hi ho 4)))
- (let ((v0 (make-vct 5 .1))
- (v1 (make-vct 6 .2)))
- (vct-add! v0 v1 2)
- (if (not (vequal v0 (vct .1 .1 .3 .3 .3)))
- (snd-display #__line__ ";vct-add + offset: ~A" v0)))
-
- ;; test local var gc protection in vct.h vct_to_vector
- (let ((o (make-oscil 1)))
- (let ((v1 (vct-map!
- (make-vct 44100 0.0)
- (lambda () (o)))))
- (vct->vector v1)
- (vct->vector v1)
- (let ((vect (vct->vector v1)))
- (vector->vct vect)
- (vector->vct vect)
- (set! v1 (vector->vct vect)))))
-
- ;; check s7 stuff with vcts
- (let ((v (vct 1.0 2.0 3.0)))
- (if (not (string=? (format #f "~{~A~^-~}" v) "1.0-2.0-3.0"))
- (snd-display #__line__ ";vct in format {}: ~S" (format #f "~{~A~^-~}" v)))
- (if (not (= (length v) 3))
- (snd-display #__line__ ";vct s7 len: ~A" (length v)))
- (if (not (equal? v (copy v)))
- (snd-display #__line__ ";vct s7 copy is not equal? ~A ~A" v (copy v)))
- (let ((val (map (lambda (x) (floor x)) v)))
- (if (not (equal? val '(1 2 3)))
- (snd-display #__line__ ";vct s7 map: ~A" val)))
- (let ((val 0))
- (for-each
- (lambda (x)
- (set! val (+ val (floor x))))
- v)
- (if (not (equal? val 6))
- (snd-display #__line__ ";vct s7 for-each: ~A" val)))
- (set! v (reverse v))
- (if (not (vvequal v (vct 3.0 2.0 1.0)))
- (snd-display #__line__ ";vct s7 reverse: ~A" v))
- (fill! v 12.0)
- (if (not (vvequal v (vct 12.0 12.0 12.0)))
- (snd-display #__line__ ";vct s7 fill: ~A" (fill! v 12.0)))
- )
-
-#|
- ;; a test of big vcts (needs 16 Gbytes):
- (if (and (string? (getenv "HOSTNAME"))
- (string=? (getenv "HOSTNAME") "fatty8"))
- (let ((size (+ 2 (expt 2 31))))
- (if (not (= size 2147483650))
- (snd-display #__line__ ";big vct, size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
- (set! (mus-max-malloc) (expt 2 40))
- (if (not (= (mus-max-malloc) 1099511627776))
- (snd-display #__line__ ";big vct, mus-max-malloc: ~A" (mus-max-malloc)))
- (let ((hi (make-vct size)))
- (if (not (vct? hi))
- (snd-display #__line__ ";big vct, not a vct?? ~A" hi))
- (if (fneq (vct-ref hi (expt 2 31)) 0.0)
- (snd-display #__line__ ";big vct, created at end: ~A" (vct-ref hi (expt 2 31))))
- (vct+ hi .1)
- (if (fneq (vct-ref hi (expt 2 31)) 0.1)
- (snd-display #__line__ ";big vct, add .1 at end: ~A" (vct-ref hi (expt 2 31))))
- (let ((pk (vct-peak hi)))
- (if (fneq pk .1)
- (snd-display #__line__ ";big vct, vct-peak: ~A" pk)))
- (let ((len (vct-length hi)))
- (if (not (= len size))
- (snd-display #__line__ ";big vct, len: ~A" len)))
- (vct-scale! hi 2.0)
- (if (fneq (vct-ref hi (+ 1 (expt 2 31))) .2)
- (snd-display #__line__ ";big vct, scale: ~A ~A" (vct-ref hi (+ 1 (expt 2 31))) hi))
- (vct-set! hi (expt 2 31) 1.0)
- (if (fneq (vct-ref hi (expt 2 31)) 1.0)
- (snd-display #__line__ ";big vct, set at end: ~A" (vct-ref hi (expt 2 31))))
- (vct-offset! hi .2)
- (if (fneq (vct-ref hi (expt 2 31)) 1.2)
- (snd-display #__line__ ";big vct, offset: ~A" (vct-ref hi (expt 2 31))))
- (vct-subtract! hi hi)
- (let ((pk (vct-peak hi)))
- (if (fneq pk 0.0)
- (snd-display #__line__ ";big vct, subtract vct-peak: ~A ~A" pk hi)))
- (vct-fill! hi 1.0)
- (if (fneq (vct-ref hi (expt 2 31)) 1.0)
- (snd-display #__line__ ";big vct, fill: ~A ~A" (vct-ref hi (expt 2 31)) hi))
- (vct-set! hi (expt 2 31) 0.0)
- (let ((ho (vct-subseq hi (- (expt 2 31) 3) (+ (expt 2 31) 1))))
- (if (not (vequal ho (vct 1.0 1.0 1.0 0.0 1.0)))
- (snd-display #__line__ ";big vct, subseq: ~A" ho)))
- (vct-reverse! hi)
- (let ((ho (vct-subseq hi 0 5)))
- (if (not (vequal ho (vct 1.0 0.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";big vct, reverse: ~A" ho)))
- (vct-set! hi (expt 2 31) 10.0)
- (vct-move! hi (- (expt 2 31) 3) (expt 2 31))
- (let ((ho (vct-subseq hi (- (expt 2 31) 3) (+ (expt 2 31) 1))))
- (if (not (vequal ho (vct 10.0 1.0 1.0 10.0 1.0)))
- (snd-display #__line__ ";big vct, subseq: ~A" ho)))
- )
-
- ;; big vectors/hash-tables also
-
-
- (let ((size (+ 2 (expt 2 31))))
- (if (not (= size 2147483650))
- (snd-display #__line__ ";big vector size: ~A (~A ~A)" size 2147483650 (- 2147483650 size)))
- (let ((hi (make-vector size '())))
- (if (not (vector? hi))
- (snd-display #__line__ ";big vector not a vector?? ~A" hi))
- (if (not (null? (vector-ref hi (expt 2 31))))
- (snd-display #__line__ ";big vector created at end: ~A" (vector-ref hi (expt 2 31))))
- (set! (hi (expt 2 31)) 100)
- (if (not (= (vector-ref hi (expt 2 31)) 100))
- (snd-display #__line__ ";big vector set to 100 at end: ~A" (vector-ref hi (expt 2 31))))
- (let ((len (vector-length hi)))
- (if (not (= len size))
- (snd-display #__line__ ";big vector len: ~A" len)))
- (vector-fill! hi 2)
- (if (not (= (vector-ref hi (expt 2 31)) 2))
- (snd-display #__line__ ";big vector fill: ~A" (vector-ref hi (expt 2 31))))))
-
-
-
- (let ((hi (make-vector (list (+ 2 (expt 2 30)) 2) '())))
- (if (not (= (vector-length hi) (* 2 (+ 2 (expt 2 30)))))
- (snd-display #__line__ ";big vector 2dim size: ~A ~A" (vector-length hi) (* 2 (+ 2 (expt 2 30)))))
- (if (not (null? (vector-ref hi (expt 2 30) 0)))
- (snd-display #__line__ ";big vector 2dim created at end (0): ~A" (vector-ref hi (expt 2 30) 0)))
- (if (not (null? (vector-ref hi (expt 2 30) 1)))
- (snd-display #__line__ ";big vector 2dim created at end (1): ~A" (vector-ref hi (expt 2 30) 1)))
- (set! (hi (expt 2 30) 1) 100)
- (if (not (= (vector-ref hi (expt 2 30) 1) 100))
- (snd-display #__line__ ";big vector 2dim set to 100 at end: ~A" (vector-ref hi (expt 2 30) 1)))
- (vector-fill! hi 2)
- (if (not (= (vector-ref hi (expt 2 30) 0) 2))
- (snd-display #__line__ ";big vector 2dim fill: ~A" (vector-ref hi (expt 2 30) 0))))
-
-
-
- (let ((hi (make-hash-table (+ 2 (expt 2 31)))))
- (if (not (= (hash-table-size hi) (+ 2 (expt 2 31))))
- (snd-display #__line__ ";big hash size: ~A ~A" (hash-table-size hi) (+ 2 (expt 2 31))))
- (if (fneq (let () (hash-table-set! hi 'key 3.14) (hash-table-ref hi 'key)) 3.14)
- (snd-display #__line__ ";big hash 3.14: ~A" (hash-table-ref hi 'key)))
- (if (not (equal? (let () (hash-table-set! hi 123 "hiho") (hash-table-ref hi 123)) "hiho"))
- (snd-display #__line__ ";big hash 123: ~A" (hash-table-ref hi 123)))
- (if (not (equal? (let ()
- (hash-table-set! hi 'hiho-this-is-a-big-name-to-overflow-32-bits-I-hope "hiho")
- (hash-table-ref hi 'hiho-this-is-a-big-name-to-overflow-32-bits-I-hope))
- "hiho"))
- (snd-display #__line__ ";big hash big symbol: ~A" (hash-table-ref hi 'hiho-this-is-a-big-name-to-overflow-32-bits-I-hope)))
- (if (not (equal? (let ()
- (hash-table-set! hi 12345678912345 "hiho")
- (hash-table-ref hi 12345678912345))
- "hiho"))
- (snd-display #__line__ ";big hash big symbol: ~A" (hash-table-ref hi 12345678912345))))
-
-
- ))
-|#
-
- (let ((sum 0))
- (for-each (lambda (n) (set! sum (+ sum n))) (vct 1 2 3))
- (if (not (= sum 6.0))
- (snd-display #__line__ ";object for-each (vct): ~A" sum)))
-
- ))))
+ (close-sound ind)))
+
+ (let ((hi (make-float-vector 3)))
+ (let ((tag (catch #t
+ (lambda () (float-vector-subseq hi 1 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'out-of-range))
+ (snd-display #__line__ ";float-vector-subseq 1 0: ~A" tag))))
+ (let ((v0 (make-float-vector 5 .1))
+ (v1 (make-float-vector 6 .2)))
+ (float-vector-add! v0 v1 2)
+ (if (not (vequal v0 (float-vector .1 .1 .3 .3 .3)))
+ (snd-display #__line__ ";float-vector-add + offset: ~A" v0)))
+
+ ;; check s7 stuff with float-vectors
+ (let ((v (float-vector 1.0 2.0 3.0)))
+ (if (not (string=? (format #f "~{~A~^-~}" v) "1.0-2.0-3.0"))
+ (snd-display #__line__ ";float-vector in format {}: ~S" (format #f "~{~A~^-~}" v)))
+ (if (not (= (length v) 3))
+ (snd-display #__line__ ";float-vector s7 len: ~A" (length v)))
+ (if (not (equal? v (copy v)))
+ (snd-display #__line__ ";float-vector s7 copy is not equal? ~A ~A" v (copy v)))
+ (let ((val (map floor v)))
+ (if (not (equal? val '(1 2 3)))
+ (snd-display #__line__ ";float-vector s7 map: ~A" val)))
+ (let ((val 0))
+ (for-each
+ (lambda (x)
+ (set! val (+ val (floor x))))
+ v)
+ (if (not (eqv? val 6))
+ (snd-display #__line__ ";float-vector s7 for-each: ~A" val)))
+ (set! v (reverse v))
+ (if (not (vvequal v (float-vector 3.0 2.0 1.0)))
+ (snd-display #__line__ ";float-vector s7 reverse: ~A" v))
+ (fill! v 12.0)
+ (if (not (vvequal v (float-vector 12.0 12.0 12.0)))
+ (snd-display #__line__ ";float-vector s7 fill: ~A" (fill! v 12.0)))
+ )
+
+ (let ((sum 0))
+ (for-each (lambda (n) (set! sum (+ sum n))) (float-vector 1 2 3))
+ (if (not (= sum 6.0))
+ (snd-display #__line__ ";object for-each (float-vector): ~A" sum)))
+
+ (let ((x (float-vector 0.0))
+ (osc (make-oscil :frequency 440))
+ (e1 (make-env '(0 0 1 1 2 0) :length 100)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (float-vector-set! x 0 (* (env e1) (oscil osc (float-vector-ref x 0))))))
+
+ (if (fneq (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .1) .0909)
+ (snd-display #__line__ ";float-vector-equal? 0.0909: ~A" (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .1)))
+ (if (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .01)
+ (snd-display #__line__ ";float-vector-equal? #f: ~A" (float-vector-equal? (float-vector 1.0) (float-vector 1.1) .01)))
+
+ )))
;;; ---------------- test 7: colors ----------------
-(if (not (provided? 'snd-rgb.scm)) (load "rgb.scm"))
+(require snd-rgb.scm)
(define (snd_test_7)
(define colormap-error-max 0.0)
(define cfneq (lambda (a b) (> (abs (- a b)) colormap-error-max)))
- (define old-colormap-size (colormap-size))
+ (define old-colormap-size *colormap-size*)
(if (or (provided? 'snd-gtk)
(provided? 'snd-motif))
(letrec ((test-color
(lambda (lst)
- (if (not (null? lst))
- (let* ((name (list-ref (car lst) 0))
- (getfnc (list-ref (car lst) 1))
+ (if (pair? lst)
+ (let* ((name ((car lst) 0))
+ (getfnc ((car lst) 1))
(setfnc (lambda (val) (set! (getfnc) val)))
- (initval (list-ref (car lst) 2)))
+ (initval ((car lst) 2)))
(if (not (color? initval)) (snd-display #__line__ ";~A not color?" initval))
;; we'll get warnings here if the cell chosen didn't exactly match the one requested -- not a bug
;; (if (not (equal? (getfnc) initval))
@@ -14730,7 +9550,8 @@ EDITS: 2
(if (not (eq? c1 c2)) (snd-display #__line__ ";color not eq? ~A ~A?" c1 c2))
;(if (not (equal? c1 c3)) (snd-display #__line__ ";diff color not equal? ~A ~A?" c1 c3))
(if (eq? c1 c3) (snd-display #__line__ ";diff color eq? ~A ~A?" c1 c3))
- (if (not (equal? (color->list c1) (list 0.0 0.0 1.0)))
+ (if (and (not (equal? (color->list c1) (list 0.0 0.0 1.0)))
+ (not (equal? (color->list c1) (list 0.0 0.0 1.0 1.0))))
(snd-display #__line__ ";color->list: ~A ~A?" c1 (color->list c1))))
(if (not (provided? 'snd-motif))
@@ -14750,10 +9571,10 @@ EDITS: 2
(lambda args #f))))
(if (equal? c1 c4) (snd-display #__line__ ";alpha color equal? ~A ~A?" c1 c2)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((not (colormap? (integer->colormap i))))
(let ((val (colormap-ref (integer->colormap i) 0))
- (true-val (list-ref (list '(0.0 0.0 0.0) '(0.0 0.0 0.0) '(0.0 0.0 0.0) '(0.0 1.0 1.0)
+ (true-val ((list '(0.0 0.0 0.0) '(0.0 0.0 0.0) '(0.0 0.0 0.0) '(0.0 1.0 1.0)
'(0.0 0.0 7.01915007248035e-4) '(0.0 0.0 0.0) '(0.0 0.0 0.0)
'(0.0 0.0 0.49999) '(1.0 0.0 0.0) '(1.0 0.0 0.0) '(0.0 0.0 1.0)
'(1.0 0.0 1.0) '(0.0 0.500007629510948 0.4) '(1.0 0.0 0.0)
@@ -14786,9 +9607,9 @@ EDITS: 2
))
(let ((ind (open-sound "oboe.snd")))
- (set! (selected-data-color) light-green)
- (set! (data-color) blue)
- (set! (selected-graph-color) black)
+ (set! *selected-data-color* light-green)
+ (set! *data-color* blue)
+ (set! *selected-graph-color* black)
(let ((red (make-color-with-catch 1.0 0.0 0.0)))
(set! (foreground-color ind 0 cursor-context) red)
(let ((col (foreground-color ind 0 cursor-context)))
@@ -14806,22 +9627,22 @@ EDITS: 2
(let ((col (foreground-color ind)))
(if (not (feql (color->list col) (color->list black)))
(snd-display #__line__ ";set foreground-color with ind (black): ~A ~A" (color->list col) (color->list black)))))
- (set! (selected-graph-color) (make-color-with-catch 0.96 0.96 0.86))
- (set! (data-color) black)
- (set! (selected-data-color) blue)
- (set! (graph-color) white)
+ (set! *selected-graph-color* (make-color-with-catch 0.96 0.96 0.86))
+ (set! *data-color* black)
+ (set! *selected-data-color* blue)
+ (set! *graph-color* white)
(close-sound ind)))
(lambda args args))
- (if (not (= (length jet-colormap) (colormap-size)))
- (snd-display #__line__ ";jet-colormap length: ~A ~A" (length jet-colormap) (colormap-size)))
+ (if (not (= (length jet-colormap) *colormap-size*))
+ (snd-display #__line__ ";jet-colormap length: ~A ~A" (length jet-colormap) *colormap-size*))
(for-each
(lambda (n err)
- (set! (colormap-size) n)
+ (set! *colormap-size* n)
(set! colormap-error-max err)
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r (if (< x 3/4)
(* 7/8 x)
@@ -14836,12 +9657,12 @@ EDITS: 2
(+ (* 7/8 x) 1/8)))
(rgb (colormap-ref bone-colormap x))
(rgb1 (bone-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2))
- (r2 (list-ref rgb1 0))
- (g2 (list-ref rgb1 1))
- (b2 (list-ref rgb1 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2))
+ (r2 (rgb1 0))
+ (g2 (rgb1 1))
+ (b2 (rgb1 2)))
(if (and (< x (- 1.0 (/ 1.0 n)))
(or (cfneq r r1)
(cfneq g g1)
@@ -14852,7 +9673,7 @@ EDITS: 2
(snd-display #__line__ ";bone ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r (if (< x 4/5)
(* 5/4 x)
@@ -14860,53 +9681,53 @@ EDITS: 2
(g (* 4/5 x))
(b (* 1/2 x))
(rgb (colormap-ref copper-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";copper ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r 0.0)
(g x)
(b (- 1.0 (/ g 2.0)))
(rgb (colormap-ref winter-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";winter ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r 1.0)
(g x)
(b 0.0)
(rgb (colormap-ref autumn-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";autumn ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r x)
(g (- 1.0 r))
(b 1.0)
(rgb (colormap-ref cool-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";cool ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r (if (< x 3/8)
(* 8/3 x)
@@ -14920,14 +9741,14 @@ EDITS: 2
0.0
(- (* 4 x) 3)))
(rgb (colormap-ref hot-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";hot ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r (if (< x 3/8)
0.0
@@ -14953,15 +9774,15 @@ EDITS: 2
(+ (* -4 x) 5/2)
0.0))))
(rgb (colormap-ref jet-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";jet ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
(if (colormap? pink-colormap)
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r (if (< x 3/8)
(* 14/9 x)
@@ -14975,66 +9796,66 @@ EDITS: 2
(* 2/3 x)
(- (* 2 x) 1)))
(rgb (colormap-ref pink-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";pink ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1))))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r 1.0)
(g x)
(b (- 1.0 g))
(rgb (colormap-ref spring-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";spring ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r x)
(g x)
(b x)
(rgb (colormap-ref gray-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";gray ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r 0.0)
(g 0.0)
(b 0.0)
(rgb (colormap-ref black-and-white-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";black-and-white ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r x)
(g (+ 0.5 (/ r 2)))
(b 0.4)
(rgb (colormap-ref summer-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";summer ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(r (if (< x 2/5)
1.0
@@ -15056,14 +9877,14 @@ EDITS: 2
(- (* 5 x) 3)
1.0)))
(rgb (colormap-ref rainbow-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";rainbow ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(rgb (colormap-ref prism-colormap x)))
(if (and (< x (- 1.0 (/ 1.0 n)))
@@ -15075,7 +9896,7 @@ EDITS: 2
(not (feql rgb '(.6667 0 1))))
(snd-display #__line__ ";prism ~A" rgb))))
- (do ((i 0 (+ 1 i))) ((= i 10))
+ (do ((i 0 (+ i 1))) ((= i 10))
(let* ((x (random 1.0))
(rgb (colormap-ref flag-colormap x)))
(if (and (< x (- 1.0 (/ 1.0 n)))
@@ -15088,16 +9909,16 @@ EDITS: 2
(list 512 64)
(list 0.005 0.04))
- (let ((ind (add-colormap "white" (lambda (size) (list (make-vct size 1.0) (make-vct size 1.0) (make-vct size 1.0))))))
+ (let ((ind (add-colormap "white" (lambda (size) (list (make-float-vector size 1.0) (make-float-vector size 1.0) (make-float-vector size 1.0))))))
(if (not (colormap? ind))
(snd-display #__line__ ";add-colormap ~A: ~A" ind (colormap? ind)))
(if (not (feql (colormap-ref ind 0.5) '(1.0 1.0 1.0)))
(snd-display #__line__ ";white colormap: ~A" (colormap-ref ind 0.5)))
- (let ((tag (catch #t (lambda () (set! (colormap) ind)) (lambda args args))))
+ (let ((tag (catch #t (lambda () (set! *colormap* ind)) (lambda args args))))
(if (or (eq? tag 'no-such-colormap)
- (not (equal? (colormap) ind))
- (not (= (colormap->integer (colormap)) (colormap->integer ind))))
- (snd-display #__line__ ";colormap white: ~A ~A ~A" tag ind (colormap))))
+ (not (equal? *colormap* ind))
+ (not (= (colormap->integer *colormap*) (colormap->integer ind))))
+ (snd-display #__line__ ";colormap white: ~A ~A ~A" tag ind *colormap*)))
(if (not (string=? (colormap-name ind) "white"))
(snd-display #__line__ ";white colormap name: ~A" (colormap-name ind))))
@@ -15111,10 +9932,10 @@ EDITS: 2
(if (and (not (eq? tag 'no-such-colormap))
(not (eq? tag 'wrong-type-arg)))
(snd-display #__line__ ";colormap-ref -1: ~A" tag)))
- (let ((tag (catch #t (lambda () (set! (colormap) (integer->colormap 1234))) (lambda args (car args)))))
+ (let ((tag (catch #t (lambda () (set! *colormap* (integer->colormap 1234))) (lambda args (car args)))))
(if (not (eq? tag 'no-such-colormap))
(snd-display #__line__ "; set colormap 1234: ~A" tag)))
- (let ((tag (catch #t (lambda () (set! (colormap) (integer->colormap -1))) (lambda args (car args)))))
+ (let ((tag (catch #t (lambda () (set! *colormap* (integer->colormap -1))) (lambda args (car args)))))
(if (and (not (eq? tag 'no-such-colormap))
(not (eq? tag 'wrong-type-arg)))
(snd-display #__line__ "; set colormap -1: ~A" tag)))
@@ -15122,9 +9943,9 @@ EDITS: 2
(if (not (eq? tag 'out-of-range))
(snd-display #__line__ ";colormap-ref 2.0: ~A" tag)))
- (set! (colormap-size) old-colormap-size)
- (if (not (= (colormap-size) old-colormap-size))
- (snd-display #__line__ ";set colormap-size: ~A ~A" (colormap-size) old-colormap-size))
+ (set! *colormap-size* old-colormap-size)
+ (if (not (= *colormap-size* old-colormap-size))
+ (snd-display #__line__ ";set colormap-size: ~A ~A" *colormap-size* old-colormap-size))
(if (not (string=? (colormap-name black-and-white-colormap) "black-and-white"))
(snd-display #__line__ ";black-and-white: ~A" (colormap-name black-and-white-colormap)))
@@ -15133,130 +9954,320 @@ EDITS: 2
(if (not (string=? (colormap-name rainbow-colormap) "rainbow"))
(snd-display #__line__ ";rainbow: ~A" (colormap-name rainbow-colormap)))
- (let ((purple-cmap (add-colormap "purple"
- (lambda (size)
- (let ((r (make-vct size))
- (g (make-vct size))
- (b (make-vct size))
- (incr (exact->inexact (/ 256.0 size)))
- (er (list 0 60 60 116 128 252 192 252 256 60))
- (eg (list 0 0 64 0 128 252 192 252 256 0))
- (eb (list 0 80 128 252 192 0 256 80)))
- (do ((i 0 (+ 1 i))
- (x 0.0 (+ x incr)))
- ((= i size))
- (vct-set! r i (exact->inexact (/ (envelope-interp x er) 256.0)))
- (vct-set! g i (exact->inexact (/ (envelope-interp x eg) 256.0)))
- (vct-set! b i (exact->inexact (/ (envelope-interp x eb) 256.0))))
- (list r g b)))))
- (sin-cmap (add-colormap "sin"
- (lambda (size)
- (let ((r (make-vct size))
- (g (make-vct size))
- (b (make-vct size))
- (incr (exact->inexact (/ (* 2 pi) size))))
- (do ((i 0 (+ 1 i))
- (x 0.0 (+ x incr)))
- ((= i size))
- (vct-set! r i (abs (sin (* 1.5 x))))
- (vct-set! g i (abs (sin (* 3.5 x))))
- (vct-set! b i (abs (sin (* 2.5 x)))))
- (list r g b)))))
- (another-sin-cmap (add-colormap "another-sin"
- (lambda (size)
- (let ((r (make-vct size))
- (g (make-vct size))
- (b (make-vct size))
- (incr (exact->inexact (/ (* 2 pi) size))))
- (do ((i 0 (+ 1 i))
- (x 0.0 (+ x incr)))
- ((= i size))
- (vct-set! r i (abs (sin (* 2.5 x))))
- (vct-set! g i (abs (sin (* 3.5 x))))
- (vct-set! b i (abs (sin (* 4.5 x)))))
- (list r g b))))))
+ (let ()
+ (add-colormap "purple"
+ (lambda (size)
+ (let ((r (make-float-vector size))
+ (g (make-float-vector size))
+ (b (make-float-vector size))
+ (incr (/ 256.0 size))
+ (er (list 0 60 60 116 128 252 192 252 256 60))
+ (eg (list 0 0 64 0 128 252 192 252 256 0))
+ (eb (list 0 80 128 252 192 0 256 80)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x incr)))
+ ((= i size))
+ (set! (r i) (/ (envelope-interp x er) 256.0))
+ (set! (g i) (/ (envelope-interp x eg) 256.0))
+ (set! (b i) (/ (envelope-interp x eb) 256.0)))
+ (list r g b))))
+ (add-colormap "sin"
+ (lambda (size)
+ (let ((r (make-float-vector size))
+ (g (make-float-vector size))
+ (b (make-float-vector size))
+ (incr (/ (* 2 pi) size)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x incr)))
+ ((= i size))
+ (set! (r i) (abs (sin (* 1.5 x))))
+ (set! (g i) (abs (sin (* 3.5 x))))
+ (set! (b i) (abs (sin (* 2.5 x)))))
+ (list r g b))))
+ (add-colormap "another-sin"
+ (lambda (size)
+ (let ((r (make-float-vector size))
+ (g (make-float-vector size))
+ (b (make-float-vector size))
+ (incr (/ (* 2 pi) size)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x incr)))
+ ((= i size))
+ (set! (r i) (abs (sin (* 2.5 x))))
+ (set! (g i) (abs (sin (* 3.5 x))))
+ (set! (b i) (abs (sin (* 4.5 x)))))
+ (list r g b))))
+
(delete-colormap pink-colormap)
(if (colormap? pink-colormap)
(snd-display #__line__ ";delete-colormap ~A: ~A" pink-colormap (colormap? pink-colormap)))
- (let ((tag (catch #t (lambda () (set! (colormap) pink-colormap)) (lambda args args))))
+ (let ((tag (catch #t (lambda () (set! *colormap* pink-colormap)) (lambda args args))))
(if (or (not (eq? (car tag) 'no-such-colormap))
- (equal? (colormap) pink-colormap))
- (snd-display #__line__ ";delete pink colormap: ~A ~A ~A" tag pink-colormap (colormap))))
+ (equal? *colormap* pink-colormap))
+ (snd-display #__line__ ";delete pink colormap: ~A ~A ~A" tag pink-colormap *colormap*)))
(for-each
(lambda (n)
- (set! (colormap-size) n)
- (do ((i 0 (+ 1 i)))
+ (set! *colormap-size* n)
+ (do ((i 0 (+ i 1)))
((= i 10))
(let* ((x (random 1.0))
(r (if (< x 4/5) (* 5/4 x) 1.0))
(g (* 4/5 x))
(b (* 1/2 x))
(rgb (colormap-ref copper-colormap x))
- (r1 (list-ref rgb 0))
- (g1 (list-ref rgb 1))
- (b1 (list-ref rgb 2)))
+ (r1 (rgb 0))
+ (g1 (rgb 1))
+ (b1 (rgb 2)))
(if (and (> n 2) (< x (- 1.0 (/ 1.0 n))) (or (cfneq r r1) (cfneq g g1) (cfneq b b1)))
(snd-display #__line__ ";copper size reset ~A: ~,3F (~,3F): ~{~,3F ~} ~{~,3F ~}"
n x (max (abs (- r r1)) (abs (- g g1)) (abs (- b b1))) (list r g b) (list r1 g1 b1))))))
(list 1024 256 2 512))
- (set! (colormap-size) 512))
-
- (set! (hook-functions graph-hook) '())
- (clear-sincs)
+ (set! *colormap-size* 512))
+ (set! (hook-functions graph-hook) ())
)))
;;; ---------------- test 8: clm ----------------
-(if (not (provided? 'snd-moog.scm)) (load "moog.scm"))
-(if (not (provided? 'snd-mixer.scm)) (load "mixer.scm"))
-(if (not (provided? 'snd-frame.scm)) (load "frame.scm"))
-(if (not (provided? 'snd-poly.scm)) (load "poly.scm"))
-(if (not (provided? 'snd-analog-filter.scm)) (if (defined? 'gsl-roots) (load "analog-filter.scm")))
-(if (not (provided? 'snd-bird.scm)) (load "bird.scm"))
-(if (not (provided? 'snd-v.scm)) (load "v.scm"))
-(if (not (provided? 'snd-numerics.scm)) (load "numerics.scm"))
-(if (not (provided? 'snd-generators.scm)) (load "generators.scm"))
-
-(defgenerator sa1 (freq 0.0 :type float) (coscar #f :type clm) (sincar #f :type clm) (dly #f :type clm) (hlb #f :type clm))
+(require snd-moog.scm snd-poly.scm snd-bird.scm snd-v.scm snd-numerics.scm snd-generators.scm)
+(if (defined? 'gsl-roots) (require snd-analog-filter.scm))
+
+(defgenerator sa1 freq (coscar #f) (sincar #f) (dly #f) (hlb #f))
+
+(define (copy-test o)
+ (let ((p (copy o)))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";copy ~A != ~A~%" o p))
+ (mus-apply o 1.0)
+ (if (equal? o p)
+ (snd-display #__line__ ";copy/run ~A == ~A~%" o p))
+ (set! p (mus-copy o))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";mus-copy ~A != ~A~%" o p))))
+
+(define (osc-opt)
+ (let ((g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (g3 (make-oscil 1000))
+ (g4 (make-oscil 1000))
+ (g5 (make-oscil 1000))
+ (g6 (make-oscil 1000))
+ (x1 1.0)
+ (x2 (hz->radians 100.0))
+ (x4 (hz->radians 5.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 50))
+ (let ((o1 (oscil g1 x2))
+ (o2 (* 1.0 (oscil g2 x2)))
+ (o3 (oscil g3 (* x4 20.0)))
+ (o4 (oscil g4 (* 20.0 x4)))
+ (o5 (oscil g5 (* x1 x2)))
+ (o6 (* 1.0 (oscil g6 (* 20.0 x4)))))
+ (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
+ (snd-display #__line__ "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F" i o1 o2 o3 o4 o5 o6))))))
+
+(define (nrxysin-opt)
+ (let ((g1 (make-nrxysin 1000 :n 10 :r .9))
+ (g2 (make-nrxysin 1000 :n 10 :r .9))
+ (g3 (make-nrxysin 1000 :n 10 :r .9))
+ (g4 (make-nrxysin 1000 :n 10 :r .9))
+ (g5 (make-nrxysin 1000 :n 10 :r .9))
+ (g6 (make-nrxysin 1000 :n 10 :r .9))
+ (x1 1.0)
+ (x2 (hz->radians 100.0))
+ (x4 (hz->radians 5.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 50))
+ (let ((o1 (nrxysin g1 x2))
+ (o2 (* 1.0 (nrxysin g2 x2)))
+ (o3 (nrxysin g3 (* x4 20.0)))
+ (o4 (nrxysin g4 (* 20.0 x4)))
+ (o5 (nrxysin g5 (* x1 x2)))
+ (o6 (* 1.0 (nrxysin g6 (* 20.0 x4)))))
+ (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
+ (format #t "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F~%" i o1 o2 o3 o4 o5 o6))))))
+
+(define (polywave-opt)
+ (let ((g1 (make-polywave 1000 '(1 .5 2 .5)))
+ (g2 (make-polywave 1000 '(1 .5 2 .5)))
+ (g3 (make-polywave 1000 '(1 .5 2 .5)))
+ (g4 (make-polywave 1000 '(1 .5 2 .5)))
+ (g5 (make-polywave 1000 '(1 .5 2 .5)))
+ (g6 (make-polywave 1000 '(1 .5 2 .5)))
+ (x1 1.0)
+ (x2 (hz->radians 100.0))
+ (x4 (hz->radians 5.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 50))
+ (let ((o1 (polywave g1 x2))
+ (o2 (* 1.0 (polywave g2 x2)))
+ (o3 (polywave g3 (* x4 20.0)))
+ (o4 (polywave g4 (* 20.0 x4)))
+ (o5 (polywave g5 (* x1 x2)))
+ (o6 (* 1.0 (polywave g6 (* 20.0 x4)))))
+ (if (> (abs (- (+ o2 o3 o4 o5 o6) (* 5 o1))) 1e-6)
+ (format #t "~A: ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F ~1,4F~%" i o1 o2 o3 o4 o5 o6))))))
+
+(define (test-simple-polywave n offset kind)
+ (let ((p (make-polywave 400.0
+ (let ((h (if offset (list offset 0) (list))))
+ (do ((i 1 (+ i 1)))
+ ((> i n))
+ (set! h (cons (* i .1) (cons i h))))
+ (reverse h))
+ kind))
+ (vp (make-float-vector 200))
+ (vo (make-float-vector 200))
+ (ob (make-oscil-bank
+ (apply float-vector (let ((frqs (if offset (list 0.0) (list))))
+ (do ((i 1 (+ i 1)))
+ ((> i n))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs)))
+ (reverse frqs)))
+ (let ((phases (make-float-vector (+ n (if offset 1 0))
+ (if (= kind mus-chebyshev-second-kind) 0.0 (/ pi 2)))))
+ (if (and offset (= kind mus-chebyshev-second-kind))
+ (set! (phases 0) (/ pi 2)))
+ phases)
+ (apply float-vector (let ((amps (if offset (list offset) (list))))
+ (do ((i 1 (+ i 1)))
+ ((> i n))
+ (set! amps (cons (* i .1) amps)))
+ (reverse amps)))
+ #t)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vp i (polywave p)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vo i (oscil-bank ob)))
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple polywave ~A ~A ~A: ~A~% ~A~% ~A~%~A ~A~%"
+ n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob))
+
+ (let ((temp 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (set! temp (polywave p))
+ (vector-set! vp i temp)
+ (set! (vo i) (oscil-bank ob)))
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple polywave (temps) ~A ~A ~A: ~A~% ~A~% ~A~%~A ~A~%"
+ n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob)))
+
+ (let ((t1 (with-sound ("test.snd")
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (outa i (polywave p)))))
+ (t2 (with-sound ("tst.snd")
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (outa i (oscil-bank ob))))))
+ (set! vp (channel->float-vector 0 200 (find-sound t1) 0))
+ (set! vo (channel->float-vector 0 200 (find-sound t2) 0))
+
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple polywave (with-sound) n: ~A, offset: ~A, type: ~A (len: ~D ~D): dist: ~A~% ~A~% ~A~%~A ~A~%"
+ n offset (if (= kind mus-chebyshev-first-kind) 'first 'second)
+ (length vp) (length vo)
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob))
+ (close-sound (find-sound t1))
+ (close-sound (find-sound t2)))))
+
+(define (test-simple-nsin n)
+ (let ((p (make-nsin 400.0 n))
+ (vp (make-float-vector 200))
+ (vo (make-float-vector 200)))
+ (let ((ob (make-oscil-bank
+ (apply float-vector (let ((frqs ()))
+ (do ((i 1 (+ i 1)))
+ ((> i n))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs)))
+ (reverse frqs)))
+ (make-float-vector n 0.0)
+ (make-float-vector n (mus-scaler p))
+ #t)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vp i (nsin p)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vo i (oscil-bank ob)))
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple nsin ~A: ~A~% ~A~% ~A~%~A ~A~%"
+ n
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob)))))
+
+(define (test-simple-ncos n)
+ (let ((p (make-ncos 400.0 n))
+ (vp (make-float-vector 200))
+ (vo (make-float-vector 200)))
+ (let ((ob (make-oscil-bank
+ (apply float-vector (let ((frqs ()))
+ (do ((i 1 (+ i 1)))
+ ((> i n))
+ (set! frqs (cons (hz->radians (* i 400.0)) frqs)))
+ (reverse frqs)))
+ (make-float-vector n (/ pi 2.0))
+ (make-float-vector n (mus-scaler p))
+ #t)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vp i (ncos p)))
+ (do ((i 0 (+ i 1)))
+ ((= i 200))
+ (float-vector-set! vo i (oscil-bank ob)))
+ (if (not (mus-arrays-equal? vp vo))
+ (format *stderr* ";simple ncos ~A: ~A~% ~A~% ~A~%~A ~A~%"
+ n
+ (float-vector-peak (float-vector-subtract! (copy vp) vo))
+ vp vo
+ p ob)))))
(define (snd-test-jc-reverb decay-dur low-pass volume amp-env)
- "(jc-reverb decay-dur low-pass volume amp-env) is the old Chowning reverberator: (jc-reverb 2.0 #f .1 #f)"
- (let* ((allpass1 (make-all-pass -0.700 0.700 1051))
- (allpass2 (make-all-pass -0.700 0.700 337))
- (allpass3 (make-all-pass -0.700 0.700 113))
- (comb1 (make-comb 0.742 4799))
- (comb2 (make-comb 0.733 4999))
- (comb3 (make-comb 0.715 5399))
- (comb4 (make-comb 0.697 5801))
- (outdel1 (make-delay (round (* .013 (srate)))))
- (dur (+ decay-dur (/ (frames) (srate))))
- (envA (if amp-env (make-env :envelope amp-env :scaler volume :duration dur) #f)))
- (map-chan
- (let ((comb-sum 0.0)
- (comb-sum-1 0.0)
- (comb-sum-2 0.0)
- (all-sums 0.0))
- (lambda (inval)
- (let ((allpass-sum (all-pass allpass3 (all-pass allpass2 (all-pass allpass1 inval)))))
- (set! comb-sum-2 comb-sum-1)
- (set! comb-sum-1 comb-sum)
- (set! comb-sum
- (+ (comb comb1 allpass-sum)
- (comb comb2 allpass-sum)
- (comb comb3 allpass-sum)
- (comb comb4 allpass-sum)))
- (if low-pass
- (set! all-sums (+ (* .25 (+ comb-sum comb-sum-2)) (* .5 comb-sum-1)))
- (set! all-sums comb-sum))
- (+ inval
- (if envA
- (* (env envA) (delay outdel1 all-sums))
- (* volume (delay outdel1 all-sums)))))))
- 0 (round (* dur (srate))))))
+ (let ((allpass1 (make-all-pass -0.700 0.700 1051))
+ (allpass2 (make-all-pass -0.700 0.700 337))
+ (allpass3 (make-all-pass -0.700 0.700 113))
+ (comb1 (make-comb 0.742 4799))
+ (comb2 (make-comb 0.733 4999))
+ (comb3 (make-comb 0.715 5399))
+ (comb4 (make-comb 0.697 5801))
+ (dur (+ decay-dur (/ (framples) (srate))))
+ (outdel (make-delay (seconds->samples .013))))
+ (let ((combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
+ (allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
+ (if (or amp-env low-pass)
+ (let ((flt (and low-pass (make-fir-filter 3 (float-vector 0.25 0.5 0.25))))
+ (envA (make-env :envelope (or amp-env '(0 1 1 1)) :scaler volume :duration dur)))
+ (if low-pass
+ (map-channel
+ (lambda (inval)
+ (+ inval (delay outdel (* (env envA) (fir-filter flt (comb-bank combs (all-pass-bank allpasses inval)))))))
+ 0 (round (* dur (srate))))
+ (map-channel
+ (lambda (inval)
+ (+ inval (delay outdel (* (env envA) (comb-bank combs (all-pass-bank allpasses inval))))))
+ 0 (round (* dur (srate))))))
+ (map-channel
+ (lambda (inval)
+ (+ inval (delay outdel (* volume (comb-bank combs (all-pass-bank allpasses inval))))))
+ 0 (round (* dur (srate))))))))
+
+
+
;;; -------- scissor-tailed flycatcher
;;;
@@ -15264,13 +10275,14 @@ EDITS: 2
;;; see bird.scm for lots more birds
-(define (scissor begin-time) ; test 23 also
- "(scissor beg) is the scissor-tailed flycatcher"
- (let ((scissorf '(0 0 40 1 60 1 100 0)))
- (bigbird begin-time 0.05 1800 1800 .2
- scissorf
- '(0 0 25 1 75 1 100 0)
- '(1 .5 2 1 3 .5 4 .1 5 .01))))
+(define scissor
+ (let ((documentation "(scissor beg) is the scissor-tailed flycatcher"))
+ (lambda (begin-time) ; test 23 also
+ (let ((scissorf '(0 0 40 1 60 1 100 0)))
+ (bigbird begin-time 0.05 1800 1800 .2
+ scissorf
+ '(0 0 25 1 75 1 100 0)
+ '(1 .5 2 1 3 .5 4 .1 5 .01))))))
(define (snd_test_8)
@@ -15278,7 +10290,7 @@ EDITS: 2
;; ----------------
(define (bumpy)
(let* ((x 0.0)
- (xi (/ 1.0 (frames)))
+ (xi (/ 1.0 (framples)))
(start 0)
(end 1)
(scl (exp (/ 4.0 (- end start))))) ; normalize it
@@ -15296,18 +10308,18 @@ EDITS: 2
;; check out scanned-synthesis
(lambda (amp dur mass xspring damp)
(let* ((size 256)
- (x0 (make-vct size))
- (x1 (make-vct size))
- (x2 (make-vct size)))
- (do ((i 0 (+ 1 i)))
+ (x0 (make-float-vector size))
+ (x1 (make-float-vector size))
+ (x2 (make-float-vector size)))
+ (do ((i 0 (+ i 1)))
((= i 12))
(let ((val (sin (/ (* 2 pi i) 12.0))))
- (vct-set! x1 (+ i (- (/ size 4) 6)) val)))
- (let* ((gen1 (make-table-lookup 440.0 :wave x1))
- (gen2 (make-table-lookup 440.0 :wave x2))
- (recompute-samps 30) ;just a quick guess
- (data (make-vct dur)))
- (do ((i 0 (+ 1 i))
+ (set! (x1 (+ i (- (/ size 4) 6))) val)))
+ (let ((gen1 (make-table-lookup 440.0 :wave x1))
+ (gen2 (make-table-lookup 440.0 :wave x2))
+ (recompute-samps 30) ;just a quick guess
+ (data (make-float-vector dur)))
+ (do ((i 0 (+ i 1))
(k 0.0)
(kincr (/ 1.0 recompute-samps)))
((= i dur))
@@ -15318,367 +10330,331 @@ EDITS: 2
(set! k (+ k kincr)))
(let ((g1 (table-lookup gen1))
(g2 (table-lookup gen2)))
- (vct-set! data i (+ g2 (* k (- g1 g2))))))
- (let ((curamp (vct-peak data)))
- (vct-scale! data (/ amp curamp)))
- (vct->channel data 0 dur)))))
+ (set! (data i) (+ g2 (* k (- g1 g2))))))
+ (let ((curamp (float-vector-peak data)))
+ (float-vector-scale! data (/ amp curamp)))
+ (float-vector->channel data 0 dur)))))
;; (test-scanned-synthesis .1 10000 1.0 0.1 0.0)
;; ----------------
(define* (array-interp-sound-diff snd chn)
- (define (envelope->vct e len)
- (let ((v (make-vct len))
+ (define (envelope->float-vector e len)
+ (let ((v (make-float-vector len))
(e (make-env e :length len)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (vct-set! v i (env e)))
+ (set! (v i) (env e)))
v))
- (let ((tbl (envelope->vct (list 0.0 -1.0 1.0 1.0) 1001))
+ (let ((tbl (envelope->float-vector (list 0.0 -1.0 1.0 1.0) 1001))
(curpos (edit-position snd chn)))
(map-channel (lambda (y)
- (let ((pos (+ 500 (* 500 y))))
- (array-interp tbl pos 1000)))
+ (array-interp tbl (+ 500.0 (* y 500)) 1000))
0 #f snd chn)
(let ((r (make-sampler 0 snd chn 1 curpos))
(mx 0.0))
(scan-channel (lambda (y)
- (set! mx (max mx (abs (- y (r))))))
+ (set! mx (max mx (abs (- y (next-sample r))))))
0 #f snd chn)
mx)))
;; ----------------
- (define (make-papoulis-window n)
- "(make-papoulis-window size) returns a papoulis window os the given size"
- (let ((v (make-vct n))
- (n2 (/ n 2)))
- (do ((i (- n2) (+ i 1)))
- ((= i n2))
- (let* ((ratio (/ i n))
- (pratio (* 2 pi ratio)))
- (vct-set! v (+ i n2) (+ (/ (abs (sin pratio)) pi)
- (* (- 1.0 (* 2 (abs ratio)))
- (cos pratio))))))
- v))
-
- ;; ----------------
- (define (make-dpss-window n w)
- "(make-dpss-window size w) returns a prolate spheriodal (slepian) window of the given size"
- ;; from Verma, Bilbao, Meng, "The Digital Prolate Spheroidal Window"
- ;; output checked using Julius Smith's dpssw.m, although my "w" is different
- (let* ((mat (make-mixer! n))
- (cw (cos (* 2 pi w))))
- (do ((i 0 (+ i 1)))
- ((= i n))
- (let ((n2 (- (* 0.5 (- n 1)) i)))
- (mixer-set! mat i i (* cw n2 n2))
- (if (< i (- n 1))
- (mixer-set! mat i (+ i 1) (* 0.5 (+ i 1) (- n 1 i))))
- (if (> i 0)
- (mixer-set! mat i (- i 1) (* 0.5 i (- n i))))))
- (let ((v (vector->vct (vector-ref (cadr (gsl-eigenvectors mat)) 0)))
- (pk 0.0))
- ;; sign of eigenvalue is arbitrary, and eigenvector is scaled to sum to 1.0
- ;; but we want peak of 1.0 to serve as fft window
- (do ((i 0 (+ i 1)))
- ((= i n))
- (if (> (abs (vct-ref v i)) (abs pk))
- (set! pk (vct-ref v i))))
- (vct-scale! v (/ 1.0 pk)))))
-
+ (define make-papoulis-window
+ (let ((documentation "(make-papoulis-window size) returns a papoulis window os the given size"))
+ (lambda (n)
+ (let ((v (make-float-vector n))
+ (n2 (/ n 2)))
+ (do ((i (- n2) (+ i 1)))
+ ((= i n2))
+ (let* ((ratio (/ i n))
+ (pratio (* 2 pi ratio)))
+ (set! (v (+ i n2)) (+ (/ (abs (sin pratio)) pi)
+ (* (- 1.0 (* 2 (abs ratio)))
+ (cos pratio))))))
+ v))))
+
;; ----------------
-
- (define mus-a0
- (make-procedure-with-setter
- (lambda (gen)
- "obsolete way to access mus-xcoeff 0"
- (mus-xcoeff gen 0))
- (lambda (gen val)
- (set! (mus-xcoeff gen 0) val))))
-
- (define mus-a1
- (make-procedure-with-setter
- (lambda (gen)
- "obsolete way to access mus-xcoeff 1"
- (mus-xcoeff gen 1))
- (lambda (gen val)
- (set! (mus-xcoeff gen 1) val))))
-
- (define mus-a2
- (make-procedure-with-setter
- (lambda (gen)
- "obsolete way to access mus-xcoeff 2"
- (mus-xcoeff gen 2))
- (lambda (gen val)
- (set! (mus-xcoeff gen 2) val))))
-
- (define mus-b1
- (make-procedure-with-setter
- (lambda (gen)
- "obsolete way to access mus-ycoeff 1"
- (mus-ycoeff gen 1))
- (lambda (gen val)
- (set! (mus-ycoeff gen 1) val))))
-
- (define mus-b2
- (make-procedure-with-setter
- (lambda (gen)
- "obsolete way to access mus-ycoeff 2"
- (mus-ycoeff gen 2))
- (lambda (gen val)
- (set! (mus-ycoeff gen 2) val))))
+ (define make-dpss-window
+ (let ((documentation "(make-dpss-window size w) returns a prolate spheriodal (slepian) window of the given size"))
+ ;; from Verma, Bilbao, Meng, "The Digital Prolate Spheroidal Window"
+ ;; output checked using Julius Smith's dpssw.m, although my "w" is different
+ (lambda (n w)
+ (let ((mat (make-float-vector (list n n) 0.0))
+ (cw (cos (* 2 pi w))))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((n2 (- (* 0.5 (- n 1)) i)))
+ (set! (mat i i) (* cw n2 n2))
+ (if (< i (- n 1))
+ (set! (mat i (+ i 1)) (* 0.5 (+ i 1) (- n 1 i))))
+ (if (> i 0)
+ (set! (mat i (- i 1)) (* 0.5 i (- n i))))))
+ (let* ((vc (vector-ref (cadr (gsl-eigenvectors mat)) 0)) ; cadr->vector of fv-vectors
+ (v (copy vc (make-float-vector (length vc))))
+ (pk 0.0))
+ ;; sign of eigenvalue is arbitrary, and eigenvector is scaled to sum to 1.0
+ ;; but we want peak of 1.0 to serve as fft window
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (if (> (abs (v i)) (abs pk))
+ (set! pk (v i))))
+ (float-vector-scale! v (/ 1.0 pk)))))))
;; ----------------
(define (test-lpc)
(define (make-sine n)
- (let ((data (make-vct n 0.0)))
- (do ((i 0 (+ 1 i)))
+ (let ((data (make-float-vector n 0.0))
+ (incr (/ (* 2.0 pi) n)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x incr)))
((= i n) data)
- (vct-set! data i (sin (* 2 pi (/ i n)))))))
+ (set! (data i) (sin x)))))
(define (make-sines n)
- (let ((data (make-vct n 0.0)))
- (do ((i 0 (+ 1 i)))
+ (let ((data (make-float-vector n 0.0))
+ (incr (/ (* 2.0 pi) n)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x incr)))
((= i n) data)
- (vct-set! data i (+ (sin (* 2 pi (/ i n)))
- (* .25 (sin (* 4 pi (/ i n))))
- (* .125 (sin (* 8 pi (/ i n)))))))))
+ (set! (data i) (+ (sin x)
+ (* .25 (sin (* 2.0 x)))
+ (* .125 (sin (* 4.0 x))))))))
- (let ((vals (lpc-predict (vct 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (vct 0 1 2 3 4 5 6 7) 8 4) 4 2)))
- (if (not (vequal vals (vct 7.906 8.557)))
+ (let ((vals (lpc-predict (float-vector 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7) 8 4) 4 2)))
+ (if (not (vequal vals (float-vector 7.906 8.557)))
(snd-display #__line__ ";predict ramp: ~A" vals)))
- (let ((vals (lpc-predict (vct 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (vct 0 1 2 3 4 5 6 7) 8 7) 7 2)))
- (if (not (vequal vals (vct 7.971 8.816)))
+ (let ((vals (lpc-predict (float-vector 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7) 8 7) 7 2)))
+ (if (not (vequal vals (float-vector 7.971 8.816)))
(snd-display #__line__ ";predict ramp 1: ~A" vals)))
- (let ((vals (lpc-predict (vct 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
- (lpc-coeffs (vct 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 7) 7 5)))
- (if (not (vequal vals (vct 14.999 15.995 16.980 17.940 18.851)))
+ (let ((vals (lpc-predict (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
+ (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 7) 7 5)))
+ (if (not (vequal vals (float-vector 14.999 15.995 16.980 17.940 18.851)))
(snd-display #__line__ ";predict ramp 2: ~A" vals)))
- (let ((vals (lpc-predict (vct 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
- (lpc-coeffs (vct 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 14) 14 5)))
- (if (not (vequal vals (vct 15.000 16.000 16.998 17.991 18.971)))
+ (let ((vals (lpc-predict (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15
+ (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) 15 14) 14 5)))
+ (if (not (vequal vals (float-vector 15.000 16.000 16.998 17.991 18.971)))
(snd-display #__line__ ";predict ramp 3: ~A" vals)))
(let ((vals (lpc-predict (make-sine 16) 16 (lpc-coeffs (make-sine 16) 16 8) 8 2)))
- (if (not (vequal vals (vct 0.000 0.383)))
+ (if (not (vequal vals (float-vector 0.000 0.383)))
(snd-display #__line__ ";predict sine: ~A" vals)))
(let ((vals (lpc-predict (make-sine 16) 16 (lpc-coeffs (make-sine 16) 16 8) 8 8)))
- (if (not (vequal vals (vct 0.000 0.383 0.707 0.924 1.000 0.924 0.707 0.383)))
+ (if (not (vequal vals (float-vector 0.000 0.383 0.707 0.924 1.000 0.924 0.707 0.383)))
(snd-display #__line__ ";predict sine 1: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 8) 8 8)))
- (if (not (vequal vals (vct 0.000 0.379 0.686 0.880 0.970 1.001 1.022 1.053)))
+ (if (not (vequal vals (float-vector 0.000 0.379 0.686 0.880 0.970 1.001 1.022 1.053)))
(snd-display #__line__ ";predict sines: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 16) 16 8)))
- (if (and (not (vequal vals (vct 0.000 0.379 0.684 0.876 0.961 0.987 1.006 1.046)))
- (not (vequal vals (vct 0.000 0.379 0.685 0.876 0.961 0.985 0.998 1.029)))) ; if --with-doubles
+ (if (and (not (vequal vals (float-vector 0.000 0.379 0.684 0.876 0.961 0.987 1.006 1.046)))
+ (not (vequal vals (float-vector 0.000 0.379 0.685 0.876 0.961 0.985 0.998 1.029))))
(snd-display #__line__ ";predict sines 1: ~A" vals)))
(let ((vals (lpc-predict (make-sines 32) 32 (lpc-coeffs (make-sines 32) 32 30) 30 4)))
- (if (and (not (vequal vals (vct 0.000 0.379 0.685 0.878)))
- (not (vequal vals (vct 0.000 0.379 0.684 0.875)))) ; double vcts
+ (if (and (not (vequal vals (float-vector 0.000 0.379 0.685 0.878)))
+ (not (vequal vals (float-vector 0.000 0.379 0.684 0.875)))) ; double float-vectors
(snd-display #__line__ ";predict sines 2: ~A" vals)))
(let ((vals (lpc-predict (make-sines 64) 64 (lpc-coeffs (make-sines 64) 64 32) 32 8)))
- (if (not (vequal vals (vct 0.000 0.195 0.379 0.545 0.684 0.795 0.875 0.927)))
+ (if (not (vequal vals (float-vector 0.000 0.195 0.379 0.545 0.684 0.795 0.875 0.927)))
(snd-display #__line__ ";predict sines 3: ~A" vals))))
;; ----------------
(define (test-unclip-channel)
- (let ((ind (new-sound "test.snd" mus-next mus-lfloat 22050 2 "unclip-channel test" 1)))
+ (let ((ind (new-sound "test.snd" 2 22050 mus-lfloat mus-next "unclip-channel test" 1)))
(set! (sync ind) 1)
(mix "oboe.snd" 0 0 ind 0 #f)
(mix "oboe.snd" 0 0 ind 1 #f)
(let ((scl (/ 1.01 (maxamp ind 0)))
- (dur (frames ind 0)))
+ (dur (framples ind 0)))
(scale-channel scl 0 dur ind 0)
(scale-channel scl 0 dur ind 1))
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 20)) (snd-display #__line__ ";unclip-channel 0 oboe clips: ~A" clips))
(if (not (= lmax 1)) (snd-display #__line__ ";unclip-channel 0 oboe max len: ~A" lmax))
(if (fneq umax .999) (snd-display #__line__ ";unclip-channel 0 oboe maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-vct 100 0.0))
+ (let ((data (make-float-vector 100 0.0))
(e (make-env '(0 0 1 .8 1.5 1.0 2.0 1.0 2.5 .8 3.5 0) :length 101))
(o (make-oscil 1000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100) data)
- (vct-set! data i (* 1.05 (env e) (oscil o))))
- (vct->channel data 0 100 ind 0)
- (vct->channel data 0 100 ind 1))
+ (set! (data i) (* 1.05 (env e) (oscil o))))
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1))
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 1 sine clips: ~A" clips))
(if (not (= lmax 2)) (snd-display #__line__ ";unclip-channel 1 sine max len: ~A" lmax))
(if (fneq umax .999) (snd-display #__line__ ";unclip-channel 1 sine maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-vct 100 0.0))
+ (let ((data (make-float-vector 100 0.0))
(e (make-env '(0 0 1 .8 1.75 1.0 2.0 1.0 2.25 .8 3.5 0) :length 101))
(o (make-oscil 1000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100) data)
- (vct-set! data i (* 1.1 (env e) (oscil o))))
- (vct->channel data 0 100 ind 0)
- (vct->channel data 0 100 ind 1))
+ (set! (data i) (* 1.1 (env e) (oscil o))))
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1))
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 2 sine clips: ~A" clips))
(if (not (= lmax 3)) (snd-display #__line__ ";unclip-channel 2 sine max len: ~A" lmax))
(if (fneq umax .999) (snd-display #__line__ ";unclip-channel 2 sine maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-vct 100 0.0))
+ (let ((data (make-float-vector 100 0.0))
(e (make-env '(0 0 1 .8 1.85 1.0 2.0 1.0 2.15 .8 3.5 0) :length 101))
(o1 (make-oscil 1000))
(o2 (make-oscil 2000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100) data)
- (vct-set! data i (* 1.2 (env e) (+ (* .75 (oscil o1)) (* .25 (oscil o2))))))
- (vct->channel data 0 100 ind 0)
- (vct->channel data 0 100 ind 1))
+ (set! (data i) (* 1.2 (env e) (+ (* .75 (oscil o1)) (* .25 (oscil o2))))))
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1))
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 3 sine clips: ~A" clips))
(if (not (= lmax 1)) (snd-display #__line__ ";unclip-channel 3 sine max len: ~A" lmax))
(if (fneq umax .999) (snd-display #__line__ ";unclip-channel 3 sine maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-vct 100 0.0))
+ (let ((data (make-float-vector 100 0.0))
(e (make-env '(0 0 40 .75 45 1.0 50 1.25 55 1.0 60 .75 100 0.0) :length 101))
(o1 (make-oscil 1000))
(o2 (make-oscil 2000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100) data)
- (vct-set! data i (* 1.5 (env e) (+ (* .75 (oscil o1)) (* .25 (oscil o2))))))
- (vct->channel data 0 100 ind 0)
- (vct->channel data 0 100 ind 1))
+ (set! (data i) (* 1.5 (env e) (+ (* .75 (oscil o1)) (* .25 (oscil o2))))))
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1))
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 4 sine clips: ~A" clips))
(if (not (= lmax 4)) (snd-display #__line__ ";unclip-channel 4 sine max len: ~A" lmax))
(if (fneq umax .999) (snd-display #__line__ ";unclip-channel 4 sine maxamp: ~A" umax)))
(revert-sound ind)
- (let ((data (make-vct 100 0.0))
+ (let ((data (make-float-vector 100 0.0))
(o1 (make-oscil 1000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100) data)
- (vct-set! data i (* .25 (oscil o1))))
- (let ((true-max (vct-peak data)))
- (vct-set! data 50 (+ (vct-ref data 50) 1.25))
- (vct->channel data 0 100 ind 0)
- (vct->channel data 0 100 ind 1)
+ (set! (data i) (* .25 (oscil o1))))
+ (let ((true-max (float-vector-peak data)))
+ (set! (data 50) (+ (data 50) 1.25))
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1)
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 5 click clips: ~A" clips))
(if (not (= lmax 1)) (snd-display #__line__ ";unclip-channel 5 click max len: ~A" lmax))
(if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 5 click maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
- (let ((data (make-vct 100 0.0))
+ (let ((data (make-float-vector 100 0.0))
(o1 (make-oscil 1000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100) data)
- (vct-set! data i (* .25 (oscil o1))))
- (let ((true-max (vct-peak data)))
- (do ((i 49 (+ 1 i)))
+ (set! (data i) (* .25 (oscil o1))))
+ (let ((true-max (float-vector-peak data)))
+ (do ((i 49 (+ i 1)))
((= i 51))
- (vct-set! data i (+ (vct-ref data i) 1.25)))
- (vct->channel data 0 100 ind 0)
- (vct->channel data 0 100 ind 1)
+ (set! (data i) (+ (data i) 1.25)))
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1)
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 6 click clips: ~A" clips))
(if (not (= lmax 2)) (snd-display #__line__ ";unclip-channel 6 click max len: ~A" lmax))
(if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 6 click maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
- (let ((data (make-vct 100 0.0))
+ (let ((data (make-float-vector 100 0.0))
(o1 (make-oscil 1000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100) data)
- (vct-set! data i (* .25 (oscil o1))))
- (let ((true-max (vct-peak data)))
- (do ((i 45 (+ 1 i)))
+ (set! (data i) (* .25 (oscil o1))))
+ (let ((true-max (float-vector-peak data)))
+ (do ((i 45 (+ i 1)))
((= i 55))
- (vct-set! data i (+ (vct-ref data i) 1.25)))
- (vct->channel data 0 100 ind 0)
- (vct->channel data 0 100 ind 1)
+ (set! (data i) (+ (data i) 1.25)))
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1)
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 7 click clips: ~A" clips))
(if (not (= lmax 10)) (snd-display #__line__ ";unclip-channel 7 click max len: ~A" lmax))
(if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 7 click maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
- (let ((data (make-vct 100 0.0))
+ (let ((data (make-float-vector 100 0.0))
(o1 (make-oscil 1000))
(o2 (make-oscil 2000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100) data)
- (vct-set! data i (* .25 (+ (oscil o1) (oscil o2)))))
- (let ((true-max (vct-peak data)))
- (do ((i 45 (+ 1 i)))
+ (set! (data i) (* .25 (+ (oscil o1) (oscil o2)))))
+ (let ((true-max (float-vector-peak data)))
+ (do ((i 45 (+ i 1)))
((= i 55))
- (vct-set! data i (+ (vct-ref data i) 1.25)))
- (vct->channel data 0 100 ind 0)
- (vct->channel data 0 100 ind 1)
+ (set! (data i) (+ (data i) 1.25)))
+ (float-vector->channel data 0 100 ind 0)
+ (float-vector->channel data 0 100 ind 1)
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 1)) (snd-display #__line__ ";unclip-channel 8 click clips: ~A" clips))
(if (not (= lmax 10)) (snd-display #__line__ ";unclip-channel 8 click max len: ~A" lmax))
(if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 8 click maxamp: ~A ~A" umax true-max)))))
(revert-sound ind)
- (let ((data (make-vct 200 0.0))
+ (let ((data (make-float-vector 200 0.0))
(o1 (make-oscil 1000))
(o2 (make-oscil 2000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 200) data)
- (vct-set! data i (* .25 (+ (oscil o1) (oscil o2)))))
- (let ((true-max (vct-peak data)))
- (do ((i 45 (+ 1 i)))
+ (set! (data i) (* .25 (+ (oscil o1) (oscil o2)))))
+ (let ((true-max (float-vector-peak data)))
+ (do ((i 45 (+ i 1)))
((= i 55))
- (vct-set! data i (+ (vct-ref data i) 2.0)))
- (do ((i 75 (+ 1 i)))
+ (set! (data i) (+ (data i) 2.0)))
+ (do ((i 75 (+ i 1)))
((= i 85))
- (vct-set! data i (+ (vct-ref data i) 2.0)))
- (vct->channel data 0 200 ind 0)
- (vct->channel data 0 200 ind 1)
+ (set! (data i) (+ (data i) 2.0)))
+ (float-vector->channel data 0 200 ind 0)
+ (float-vector->channel data 0 200 ind 1)
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 2)) (snd-display #__line__ ";unclip-channel 9 collision clips: ~A" clips))
(if (not (= lmax 10)) (snd-display #__line__ ";unclip-channel 9 collision max len: ~A" lmax))
(if (fneq umax true-max) (snd-display #__line__ ";unclip-channel 9 collision maxamp: ~A ~A" umax true-max)))))
@@ -15686,15 +10662,12 @@ EDITS: 2
(revert-sound ind)
(mix "oboe.snd" 0 0 ind 0 #f)
(mix "oboe.snd" 0 0 ind 1 #f)
- (let ((scl (/ 1.01 (maxamp ind 0)))
- (dur (frames ind 0)))
- (do ((i 0 (+ 1 i))) ((= i 2))
- (map-channel (lambda (uy) (let ((y (* uy scl))) (if (> y 1.0) 1.0 (if (< y -1.0) -1.0 y)))) 0 dur ind i)))
+ (scale-sound (/ 1.01 (maxamp ind 0)))
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 20)) (snd-display #__line__ ";unclip-channel 10 oboe clips: ~A" clips))
(if (not (= lmax 1)) (snd-display #__line__ ";unclip-channel 10 oboe max len: ~A" lmax))
(if (fneq umax 0.999) (snd-display #__line__ ";unclip-channel 10 oboe maxamp: ~A" umax)))
@@ -15702,15 +10675,12 @@ EDITS: 2
(revert-sound ind)
(mix "oboe.snd" 0 0 ind 0 #f)
(mix "oboe.snd" 0 0 ind 1 #f)
- (let ((scl (/ 1.05 (maxamp ind 0)))
- (dur (frames ind 0)))
- (do ((i 0 (+ 1 i))) ((= i 2))
- (map-channel (lambda (uy) (let ((y (* uy scl))) (if (> y 1.0) 1.0 (if (< y -1.0) -1.0 y)))) 0 dur ind i)))
+ (scale-sound (/ 1.05 (maxamp ind 0)))
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 217)) (snd-display #__line__ ";unclip-channel 11 oboe clips: ~A" clips))
(if (not (= lmax 2)) (snd-display #__line__ ";unclip-channel 11 oboe max len: ~A" lmax))
(if (fneq umax 0.999) (snd-display #__line__ ";unclip-channel 11 oboe maxamp: ~A" umax)))
@@ -15718,16 +10688,13 @@ EDITS: 2
(revert-sound ind)
(mix "oboe.snd" 0 0 ind 0 #f)
(mix "oboe.snd" 0 0 ind 1 #f)
- (let* ((scl (/ 1.2 (maxamp ind 0)))
- (dur (frames ind 0)))
- (do ((i 0 (+ 1 i))) ((= i 2))
- (let ((e (make-env (list 0 0 .48 (/ scl 2) .5 scl .52 (/ scl 2) 1.0 0) :length dur)))
- (map-channel (lambda (uy) (let ((y (* uy (env e)))) (if (> y 1.0) 1.0 (if (< y -1.0) -1.0 y)))) 0 dur ind i))))
+ (let ((scl (/ 1.2 (maxamp ind 0))))
+ (env-sound (make-env (list 0 0 .48 (/ scl 2) .5 scl .52 (/ scl 2) 1.0 0) :length (framples ind 0))))
(let* ((vals (unclip-channel ind 1))
- (umax (list-ref vals 1))
- (clips (list-ref vals 3))
- (lmax (list-ref vals 5)))
+ (umax (vals 1))
+ (clips (vals 3))
+ (lmax (vals 5)))
(if (not (= clips 28)) (snd-display #__line__ ";unclip-channel 12 oboe clips: ~A" clips))
(if (not (= lmax 3)) (snd-display #__line__ ";unclip-channel 12 oboe max len: ~A" lmax))
(if (fneq umax 0.999) (snd-display #__line__ ";unclip-channel 12 oboe maxamp: ~A" umax)))
@@ -15737,36 +10704,29 @@ EDITS: 2
;; ----------------
(define (analog-filter-tests)
+ (define v (make-float-vector 1000))
+
(define (sweep->bins flt bins)
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 #f 22050)))
- (let ((phase 0.0)
- (freq 0.0)
- (incr (/ pi 22050)))
- (map-channel
- (lambda (y)
- (let ((val (sin phase)))
- (set! phase (+ phase freq))
- (set! freq (+ freq incr))
- (* .5 val)))))
- (map-channel flt)
- (let* ((mx (maxamp))
- (resp (make-vct bins))
- (size (round (/ 22050 bins))))
- (do ((i 0 (+ 1 i)))
+ (let ((ind (open-sound "sweep.snd")))
+ (if (mus-generator? flt)
+ (clm-channel flt)
+ (map-channel flt))
+ (let ((mx (maxamp))
+ (resp (make-float-vector bins))
+ (size (round (/ 22050 bins)))
+ (data (channel->float-vector)))
+ (do ((i 0 (+ i 1)))
((= i bins))
- (let ((data (channel->vct (* i size) size)))
- (vct-set! resp i (vct-peak data))))
+ (float-vector-set! resp i (float-vector-peak (make-shared-vector data (list size) (* i size)))))
(close-sound ind)
(list mx resp))))
(define (filter-response-max f1)
- (let ((mx 0.0)
- (signal 1.0))
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (set! mx (max mx (abs (f1 signal))))
- (set! signal 0.0))
- mx))
+ (set! (v 0) (f1 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 1000))
+ (set! (v i) (filter f1 0.0)))
+ (float-vector-peak v))
(define (filter-equal? f1 f2) ; equalp in clm2xen is too restrictive
(and (= (mus-order f1) (mus-order f2))
@@ -15775,21 +10735,21 @@ EDITS: 2
;; ---------------- butterworth tests ----------------
- (let ((poles (list (vct 1.000 1.414 1.000) ; numerous references provide these tables (y[0] is ignored)
- (vct 1.000 1.848 1.000 1.000 0.765 1.000)
- (vct 1.000 1.932 1.000 1.000 1.414 1.000 1.000 0.518 1.000)
- (vct 1.000 1.962 1.000 1.000 1.663 1.000 1.000 1.111 1.000 1.000 0.390 1.000)
- (vct 1.000 1.975 1.000 1.000 1.782 1.000 1.000 1.414 1.000 1.000 0.908 1.000 1.000 0.313 1.000))))
+ (let ((poles (list (float-vector 1.000 1.414 1.000) ; numerous references provide these tables (y[0] is ignored)
+ (float-vector 1.000 1.848 1.000 1.000 0.765 1.000)
+ (float-vector 1.000 1.932 1.000 1.000 1.414 1.000 1.000 0.518 1.000)
+ (float-vector 1.000 1.962 1.000 1.000 1.663 1.000 1.000 1.111 1.000 1.000 0.390 1.000)
+ (float-vector 1.000 1.975 1.000 1.000 1.782 1.000 1.000 1.414 1.000 1.000 0.908 1.000 1.000 0.313 1.000))))
(do ((i 2 (+ i 2))
- (k 0 (+ 1 k)))
+ (k 0 (+ k 1)))
((>= i 12))
(let ((vals (butterworth-prototype i)))
- (if (not (vequal (cadr vals) (list-ref poles k)))
- (snd-display #__line__ ";butterworth prototype poles ~A: ~A (~A)" i (cadr vals) (list-ref poles k)))
- (let ((zeros (make-vct (* (+ k 1) 3))))
+ (if (not (vequal (cadr vals) (poles k)))
+ (snd-display #__line__ ";butterworth prototype poles ~A: ~A (~A)" i (cadr vals) (poles k)))
+ (let ((zeros (make-float-vector (* (+ k 1) 3))))
(do ((j 2 (+ j 3)))
((>= j (* (+ k 1) 3)))
- (vct-set! zeros j 1.0))
+ (set! (zeros j) 1.0))
(if (not (vequal (car vals) zeros))
(snd-display #__line__ ";butterworth prototype zeros ~A: ~A (~A)" i (car vals) zeros)))))
(do ((cutoff .1 (+ cutoff .1))
@@ -15799,37 +10759,47 @@ EDITS: 2
(k 1 (+ k 1)))
((= i 16))
(let ((local (make-butterworth-lowpass i cutoff))
- (dsp (make-butter-lp k (* (mus-srate) cutoff))))
+ (dsp (make-butter-lp k (* *clm-srate* cutoff))))
(if (not (filter-equal? local dsp))
(snd-display #__line__ ";butterworth lowpass ~A ~A ~A" cutoff local dsp)))
(let ((local (make-butterworth-highpass i cutoff))
- (dsp (make-butter-hp k (* (mus-srate) cutoff))))
+ (dsp (make-butter-hp k (* *clm-srate* cutoff))))
(if (not (filter-equal? local dsp))
(snd-display #__line__ ";butterworth highpass ~A ~A ~A" cutoff local dsp)))))
(let ((ind (open-sound "oboe.snd")))
- (let ((hummer (make-eliminate-hum 550)))
- (map-channel (lambda (x) (eliminate-hum hummer x))))
+ (map-channel (make-eliminate-hum 550))
(let ((peaker (make-peaking-2 500 1000 1.0)))
(map-channel peaker))
(map-channel (chordalize))
(close-sound ind))
+
+ (let ((ind (new-sound "sweep.snd" 1 22050 mus-ldouble mus-next #f 22050)))
+ (let ((ph (make-one-pole 1.0 -1.0))
+ (fq (make-one-pole 1.0 -1.0))
+ (incr (/ pi 22050.0)))
+ (map-channel
+ (lambda (y)
+ (* .5 (sin (one-pole ph (one-pole fq incr)))))
+ 2)) ; make it look like the old form
+ (save-sound ind)
+ (close-sound ind))
(let* ((f1 (make-butterworth-lowpass 8 .1))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";butterworth lp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.359 0.014 0.001 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.359 0.014 0.001 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";butterworth lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-lowpass 12 .25))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";butterworth lp 12 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.499 0.358 0.010 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.499 0.358 0.010 0.000 0.000 0.000)))
(snd-display #__line__ ";butterworth lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-lowpass 10 .4))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";butterworth lp 10 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.361 0.001)))
- (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.360 0.002))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.361 0.001)))
+ (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.499 0.360 0.002))))
(snd-display #__line__ ";butterworth lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -15844,35 +10814,35 @@ EDITS: 2
(let* ((f1 (make-butterworth-highpass 8 .1))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";butterworth hp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.001 0.348 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.001 0.348 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500)))
(snd-display #__line__ ";butterworth hp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-highpass 12 .25))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";butterworth hp 12 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.011 0.348 0.500 0.500 0.500 0.500 0.500)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.011 0.348 0.500 0.500 0.500 0.500 0.500)))
(snd-display #__line__ ";butterworth hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-highpass 10 .4))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";butterworth hp 10 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.005 0.343 0.501 0.501)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.005 0.343 0.501 0.501)))
(snd-display #__line__ ";butterworth hp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandpass 4 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bp 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.028 0.350 0.481 0.479 0.346 0.132 0.038 0.009 0.002 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.028 0.350 0.481 0.479 0.346 0.132 0.038 0.009 0.002 0.000)))
(snd-display #__line__ ";butterworth bp 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandpass 12 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bp 12 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.006 0.317 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.012 0.319 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.000 0.323 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.006 0.317 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.012 0.319 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.323 0.501 0.500 0.358 0.009 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";butterworth bp 12 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandpass 8 .3 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.003 0.034 0.344 0.499 0.499 0.353 0.002)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.003 0.034 0.344 0.499 0.499 0.353 0.002)))
(snd-display #__line__ ";butterworth bp 8 .3 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -15887,19 +10857,19 @@ EDITS: 2
(let* ((f1 (make-butterworth-bandstop 4 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bs 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.347 0.339 0.481 0.499 0.500 0.500 0.500 0.500)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.347 0.339 0.481 0.499 0.500 0.500 0.500 0.500)))
(snd-display #__line__ ";butterworth bs 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandstop 12 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bs 12 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.503 0.503 0.364 0.334 0.500 0.500 0.500 0.500 0.500 0.500)))
- (not (vequal1 (cadr vals) (vct 0.502 0.503 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500)))
- (not (vequal1 (cadr vals) (vct 0.500 0.500 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.503 0.503 0.364 0.334 0.500 0.500 0.500 0.500 0.500 0.500)))
+ (not (vequal1 (cadr vals) (float-vector 0.502 0.503 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500)))
+ (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.365 0.334 0.500 0.500 0.500 0.500 0.500 0.500))))
(snd-display #__line__ ";butterworth bs 12 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-butterworth-bandstop 8 .3 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";butterworth bs 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.498 0.354 0.332 0.500 0.500)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.498 0.354 0.332 0.500 0.500)))
(snd-display #__line__ ";butterworth bs 8 .3 .4 spect: ~A" (cadr vals))))
@@ -15907,58 +10877,58 @@ EDITS: 2
;; ripple .01 .1 1 for 2..10 even
- (let ((poles-01 (list (vct 1.000 4.456 10.426)
- (vct 1.000 0.822 2.006 1.000 1.984 1.299)
- (vct 1.000 0.343 1.372 1.000 0.937 0.939 1.000 1.280 0.506)
- (vct 1.000 0.189 1.196 1.000 0.537 0.925 1.000 0.804 0.542 1.000 0.948 0.272)
- (vct 1.000 0.119 1.121 1.000 0.347 0.940 1.000 0.540 0.646 1.000 0.680 0.352 1.000 0.754 0.170)))
- (zeros (list (vct 0.000 0.000 1.000)
- (vct 0.000 0.000 0.250 0.000 0.000 1.000)
- (vct 0.000 0.000 0.062 0.000 0.000 1.000 0.000 0.000 1.000)
- (vct 0.000 0.000 0.016 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000)
- (vct 0.000 0.000 0.004 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000)))
- (poles-1 (list (vct 1.000 2.372 3.314)
- (vct 1.000 0.528 1.330 1.000 1.275 0.623)
- (vct 1.000 0.229 1.129 1.000 0.627 0.696 1.000 0.856 0.263)
- (vct 1.000 0.128 1.069 1.000 0.364 0.799 1.000 0.545 0.416 1.000 0.643 0.146)
- (vct 1.000 0.082 1.044 1.000 0.237 0.862 1.000 0.369 0.568 1.000 0.465 0.274 1.000 0.515 0.092)))
- (poles-10 (list (vct 1.000 1.098 1.103)
- (vct 1.000 0.279 0.987 1.000 0.674 0.279)
- (vct 1.000 0.124 0.991 1.000 0.340 0.558 1.000 0.464 0.125)
- (vct 1.000 0.070 0.994 1.000 0.199 0.724 1.000 0.298 0.341 1.000 0.352 0.070)
- (vct 1.000 0.045 0.996 1.000 0.130 0.814 1.000 0.203 0.521 1.000 0.255 0.227 1.000 0.283 0.045))))
+ (let ((poles-01 (list (float-vector 1.000 4.456 10.426)
+ (float-vector 1.000 0.822 2.006 1.000 1.984 1.299)
+ (float-vector 1.000 0.343 1.372 1.000 0.937 0.939 1.000 1.280 0.506)
+ (float-vector 1.000 0.189 1.196 1.000 0.537 0.925 1.000 0.804 0.542 1.000 0.948 0.272)
+ (float-vector 1.000 0.119 1.121 1.000 0.347 0.940 1.000 0.540 0.646 1.000 0.680 0.352 1.000 0.754 0.170)))
+ (zeros (list (float-vector 0.000 0.000 1.000)
+ (float-vector 0.000 0.000 0.250 0.000 0.000 1.000)
+ (float-vector 0.000 0.000 0.062 0.000 0.000 1.000 0.000 0.000 1.000)
+ (float-vector 0.000 0.000 0.016 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000)
+ (float-vector 0.000 0.000 0.004 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000 0.000 0.000 1.000)))
+ (poles-1 (list (float-vector 1.000 2.372 3.314)
+ (float-vector 1.000 0.528 1.330 1.000 1.275 0.623)
+ (float-vector 1.000 0.229 1.129 1.000 0.627 0.696 1.000 0.856 0.263)
+ (float-vector 1.000 0.128 1.069 1.000 0.364 0.799 1.000 0.545 0.416 1.000 0.643 0.146)
+ (float-vector 1.000 0.082 1.044 1.000 0.237 0.862 1.000 0.369 0.568 1.000 0.465 0.274 1.000 0.515 0.092)))
+ (poles-10 (list (float-vector 1.000 1.098 1.103)
+ (float-vector 1.000 0.279 0.987 1.000 0.674 0.279)
+ (float-vector 1.000 0.124 0.991 1.000 0.340 0.558 1.000 0.464 0.125)
+ (float-vector 1.000 0.070 0.994 1.000 0.199 0.724 1.000 0.298 0.341 1.000 0.352 0.070)
+ (float-vector 1.000 0.045 0.996 1.000 0.130 0.814 1.000 0.203 0.521 1.000 0.255 0.227 1.000 0.283 0.045))))
(do ((i 2 (+ i 2))
- (k 0 (+ 1 k)))
+ (k 0 (+ k 1)))
((>= i 12))
(let ((vals (chebyshev-prototype i .01)))
- (if (not (vequal1 (cadr vals) (list-ref poles-01 k)))
- (snd-display #__line__ ";chebyshev prototype .01 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-01 k))))
+ (if (not (vequal1 (cadr vals) (poles-01 k)))
+ (snd-display #__line__ ";chebyshev prototype .01 poles ~A: ~A (~A)" i (cadr vals) (poles-01 k))))
(let ((vals (chebyshev-prototype i .1)))
- (if (not (vequal1 (cadr vals) (list-ref poles-1 k)))
- (snd-display #__line__ ";chebyshev prototype .1 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-1 k))))
+ (if (not (vequal1 (cadr vals) (poles-1 k)))
+ (snd-display #__line__ ";chebyshev prototype .1 poles ~A: ~A (~A)" i (cadr vals) (poles-1 k))))
(let ((vals (chebyshev-prototype i)))
- (if (not (vequal1 (cadr vals) (list-ref poles-10 k)))
- (snd-display #__line__ ";chebyshev prototype 1 poles ~A: ~A (~A)" i (cadr vals) (list-ref poles-10 k)))
- (if (not (vequal (car vals) (list-ref zeros k)))
- (snd-display #__line__ ";chebyshev prototype .01 zeros ~A: ~A (~A)" i (car vals) (list-ref zeros k))))))
+ (if (not (vequal1 (cadr vals) (poles-10 k)))
+ (snd-display #__line__ ";chebyshev prototype 1 poles ~A: ~A (~A)" i (cadr vals) (poles-10 k)))
+ (if (not (vequal (car vals) (zeros k)))
+ (snd-display #__line__ ";chebyshev prototype .01 zeros ~A: ~A (~A)" i (car vals) (zeros k))))))
(let* ((f1 (make-chebyshev-lowpass 8 .1))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";chebyshev lp 8 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.508 0.512 0.468 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.507 0.512 0.467 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.508 0.513 0.469 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.509 0.508 0.465 0.001 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.508 0.512 0.468 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.507 0.512 0.467 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.508 0.513 0.469 0.001 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.509 0.508 0.465 0.001 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";chebyshev lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-lowpass 12 .25))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";chebyshev lp 12 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.509 0.500 0.508 0.508 0.507 0.413 0.000 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.509 0.500 0.508 0.508 0.507 0.413 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";chebyshev lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-lowpass 10 .4))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";chebyshev lp 10 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.465 0.493 0.509 0.508 0.477 0.507 0.508 0.507 0.431 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.465 0.493 0.509 0.508 0.477 0.507 0.508 0.507 0.431 0.000)))
(snd-display #__line__ ";chebyshev lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -15973,53 +10943,53 @@ EDITS: 2
(let* ((f1 (make-chebyshev-lowpass 8 .1 .01))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .49) (snd-display #__line__ ";chebyshev lp 8 .1 .01 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.492 0.491 0.483 0.006 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.492 0.491 0.483 0.006 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";chebyshev lp 8 .1 .01 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-lowpass 12 .25 .1))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .49) (snd-display #__line__ ";chebyshev lp 12 .1 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.488 0.488 0.488 0.488 0.487 0.403 0.000 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.488 0.488 0.488 0.488 0.487 0.403 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";chebyshev lp 12 .25 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-lowpass 10 .4 .001))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .49) (snd-display #__line__ ";chebyshev lp 10 .001 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.488 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.497 0.488 0.000)))
(snd-display #__line__ ";chebyshev lp 10 .4 .001 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 8 .1))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .55) (snd-display #__line__ ";chebyshev hp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.341 0.551 0.509 0.466 0.501 0.509 0.505 0.481 0.461)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.341 0.551 0.509 0.466 0.501 0.509 0.505 0.481 0.461)))
(snd-display #__line__ ";chebyshev hp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 12 .25))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .55) (snd-display #__line__ ";chebyshev hp 12 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.299 0.554 0.509 0.509 0.500 0.509)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.299 0.554 0.509 0.509 0.500 0.509)))
(snd-display #__line__ ";chebyshev hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 10 .4))
(vals (sweep->bins f1 10)))
- (if (and (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.297 0.786 0.677)))
- (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.301 0.788 0.660)))
- (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.322 0.861 0.724)))
- (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.262 0.571 0.509))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.297 0.786 0.677)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.301 0.788 0.660)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.322 0.861 0.724)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.262 0.571 0.509))))
(snd-display #__line__ ";chebyshev hp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 8 .1 .01))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .49) (snd-display #__line__ ";chebyshev hp 8 .1 .01 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.498 0.498 0.492 0.491 0.492 0.492 0.492 0.491 0.491)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.498 0.498 0.492 0.491 0.492 0.492 0.492 0.491 0.491)))
(snd-display #__line__ ";chebyshev hp 8 .1 .01 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 12 .25 .1))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";chebyshev hp 12 .1 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.453 0.516 0.489 0.489 0.488 0.488)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.453 0.516 0.489 0.489 0.488 0.488)))
(snd-display #__line__ ";chebyshev hp 12 .25 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-highpass 10 .4 .001))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .5) (snd-display #__line__ ";chebyshev hp 10 .001 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.501 0.504 0.504)))
- (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.505 0.504)))
- (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.501 0.497))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.501 0.504 0.504)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.505 0.504)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.002 0.503 0.501 0.497))))
(snd-display #__line__ ";chebyshev hp 10 .4 .001 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -16034,41 +11004,41 @@ EDITS: 2
(let* ((f1 (make-chebyshev-bandpass 4 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bp 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.009 0.449 0.509 0.505 0.442 0.065 0.013 0.003 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.009 0.449 0.509 0.505 0.442 0.065 0.013 0.003 0.000 0.000)))
(snd-display #__line__ ";chebyshev bp 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandpass 6 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bp 6 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.001 0.376 0.505 0.498 0.412 0.011 0.001 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.001 0.376 0.505 0.498 0.412 0.011 0.001 0.000 0.000 0.000)))
(snd-display #__line__ ";chebyshev bp 6 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandpass 8 .3 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.002 0.363 0.517 0.513 0.433 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.002 0.363 0.517 0.513 0.433 0.000)))
(snd-display #__line__ ";chebyshev bp 8 .3 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandpass 8 .2 .2 .01))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bp 10 .2 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.015 0.483 0.482 0.021 0.001 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.015 0.483 0.482 0.021 0.001 0.000 0.000 0.000)))
(snd-display #__line__ ";chebyshev bp 10 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandstop 4 .1 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bs 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.509 0.505 0.447 0.033 0.006 0.006 0.033 0.445 0.512 0.509)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.509 0.505 0.447 0.033 0.006 0.006 0.033 0.445 0.512 0.509)))
(snd-display #__line__ ";chebyshev bs 4 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandstop 8 .1 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .51)) .05) (snd-display #__line__ ";chebyshev bs 8 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.508 0.512 0.468 0.001 0.000 0.000 0.001 0.345 0.551 0.507)))
- (not (vequal1 (cadr vals) (vct 0.507 0.512 0.467 0.001 0.000 0.000 0.001 0.344 0.549 0.508)))
- (not (vequal1 (cadr vals) (vct 0.508 0.513 0.469 0.001 0.000 0.000 0.001 0.345 0.552 0.508)))
- (not (vequal1 (cadr vals) (vct 0.509 0.508 0.465 0.001 0.000 0.000 0.001 0.343 0.548 0.508))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.508 0.512 0.468 0.001 0.000 0.000 0.001 0.345 0.551 0.507)))
+ (not (vequal1 (cadr vals) (float-vector 0.507 0.512 0.467 0.001 0.000 0.000 0.001 0.344 0.549 0.508)))
+ (not (vequal1 (cadr vals) (float-vector 0.508 0.513 0.469 0.001 0.000 0.000 0.001 0.345 0.552 0.508)))
+ (not (vequal1 (cadr vals) (float-vector 0.509 0.508 0.465 0.001 0.000 0.000 0.001 0.343 0.548 0.508))))
(snd-display #__line__ ";chebyshev bs 8 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-chebyshev-bandstop 8 .1 .4 .01))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";chebyshev bs 8 .01 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.492 0.491 0.483 0.006 0.000 0.000 0.006 0.494 0.495 0.492)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.492 0.491 0.483 0.006 0.000 0.000 0.006 0.494 0.495 0.492)))
(snd-display #__line__ ";chebyshev bs 8 .1 .4 .01 spect: ~A" (cadr vals))))
@@ -16077,24 +11047,24 @@ EDITS: 2
(let* ((f1 (make-inverse-chebyshev-lowpass 8 .1))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev lp 8 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.501 0.496 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001)))
- (not (vequal1 (cadr vals) (vct 0.500 0.498 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.501 0.496 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001)))
+ (not (vequal1 (cadr vals) (float-vector 0.500 0.498 0.001 0.000 0.001 0.000 0.000 0.000 0.000 0.001))))
(snd-display #__line__ ";inverse-chebyshev lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-lowpass 12 .25))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev lp 12 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.496 0.001 0.001 0.001 0.001 0.001)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.496 0.001 0.001 0.001 0.001 0.001)))
(snd-display #__line__ ";inverse-chebyshev lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-lowpass 10 .4))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev lp 10 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.001 0.001)))
- (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.002 0.002))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.001 0.001)))
+ (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.497 0.002 0.002))))
(snd-display #__line__ ";inverse-chebyshev lp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-lowpass 10 .4 120))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev lp 10 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.501 0.501 0.501 0.501 0.501 0.500 0.345 0.007 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.501 0.501 0.501 0.501 0.501 0.500 0.345 0.007 0.000 0.000)))
(snd-display #__line__ ";inverse-chebyshev lp 10 .4 120 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -16109,24 +11079,24 @@ EDITS: 2
(let* ((f1 (make-inverse-chebyshev-highpass 8 .1))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev hp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.001 0.001 0.440 0.505 0.505 0.503 0.502 0.501 0.501 0.501)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.001 0.001 0.440 0.505 0.505 0.503 0.502 0.501 0.501 0.501)))
(snd-display #__line__ ";inverse-chebyshev hp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-highpass 12 .25))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev hp 12 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.001 0.001 0.001 0.001 0.001 0.505 0.506 0.503 0.501 0.501)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.001 0.001 0.001 0.001 0.001 0.505 0.506 0.503 0.501 0.501)))
(snd-display #__line__ ";inverse-chebyshev hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-highpass 10 .4))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev hp 10 .4 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.503 0.503)))
- (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.505 0.503)))
- (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.509 0.504))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.503 0.503)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.505 0.503)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.509 0.504))))
(snd-display #__line__ ";inverse-chebyshev hp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-highpass 10 .1 120))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .51) (snd-display #__line__ ";inverse-chebyshev hp 10 .1 120 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.007 0.328 0.502 0.502 0.502 0.501 0.501 0.501)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.007 0.328 0.502 0.502 0.502 0.501 0.501 0.501)))
(snd-display #__line__ ";inverse-chebyshev hp 10 .1 120 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -16141,44 +11111,44 @@ EDITS: 2
(let* ((f1 (make-inverse-chebyshev-bandpass 10 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bp 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.001 0.001 0.498 0.485 0.001 0.001 0.000 0.001 0.000 0.001)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.001 0.001 0.498 0.485 0.001 0.001 0.000 0.001 0.000 0.001)))
(snd-display #__line__ ";inverse-chebyshev bp 10 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandpass 10 .1 .2 30))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bp 6 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.026 0.025 0.509 0.505 0.020 0.016 0.012 0.016 0.011 0.016)))
- (not (vequal1 (cadr vals) (vct 0.030 0.042 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016)))
- (not (vequal1 (cadr vals) (vct 0.022 0.017 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.026 0.025 0.509 0.505 0.020 0.016 0.012 0.016 0.011 0.016)))
+ (not (vequal1 (cadr vals) (float-vector 0.030 0.042 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016)))
+ (not (vequal1 (cadr vals) (float-vector 0.022 0.017 0.511 0.505 0.020 0.016 0.012 0.016 0.011 0.016))))
(snd-display #__line__ ";inverse-chebyshev bp 10 .1 .2 30 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandpass 8 .1 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.001 0.001 0.440 0.506 0.505 0.503 0.502 0.434 0.001 0.001)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.001 0.001 0.440 0.506 0.505 0.503 0.502 0.434 0.001 0.001)))
(snd-display #__line__ ";inverse-chebyshev bp 8 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandpass 8 .3 .4 40))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bp 10 .2 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.002 0.005 0.007 0.007 0.005 0.005 0.503 0.505 0.006 0.005)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.002 0.005 0.007 0.007 0.005 0.005 0.503 0.505 0.006 0.005)))
(snd-display #__line__ ";inverse-chebyshev bp 10 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandstop 4 .1 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bs 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.054 0.001 0.001 0.000 0.000 0.000 0.001 0.055 0.503)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.054 0.001 0.001 0.000 0.000 0.000 0.001 0.055 0.503)))
(snd-display #__line__ ";inverse-chebyshev bs 4 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandstop 8 .1 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bs 8 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.501 0.496 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506)))
- (not (vequal1 (cadr vals) (vct 0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.511)))
- (not (vequal1 (cadr vals) (vct 0.500 0.498 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.501 0.496 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506)))
+ (not (vequal1 (cadr vals) (float-vector 0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.511)))
+ (not (vequal1 (cadr vals) (float-vector 0.500 0.498 0.001 0.001 0.000 0.000 0.000 0.001 0.507 0.506))))
(snd-display #__line__ ";inverse-chebyshev bs 8 .1 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-inverse-chebyshev-bandstop 8 .1 .4 90))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";inverse-chebyshev bs 8 90 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.505 0.325 0.000 0.000 0.000 0.000 0.000 0.000 0.270 0.506)))
- (not (vequal1 (cadr vals) (vct 0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.269 0.509)))
- (not (vequal1 (cadr vals) (vct 0.501 0.327 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.506))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.505 0.325 0.000 0.000 0.000 0.000 0.000 0.000 0.270 0.506)))
+ (not (vequal1 (cadr vals) (float-vector 0.506 0.328 0.000 0.000 0.000 0.000 0.000 0.000 0.269 0.509)))
+ (not (vequal1 (cadr vals) (float-vector 0.501 0.327 0.000 0.000 0.000 0.000 0.000 0.000 0.268 0.506))))
(snd-display #__line__ ";inverse-chebyshev bs 8 .1 .4 90 spect: ~A" (cadr vals))))
@@ -16191,24 +11161,24 @@ EDITS: 2
(let* ((f1 (make-bessel-lowpass 4 .1))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";bessel lp 4 .1 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.417 0.209 0.062 0.018 0.005 0.001 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.417 0.209 0.062 0.018 0.005 0.001 0.000 0.000 0.000)))
(snd-display #__line__ ";bessel lp 4 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-lowpass 8 .1))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";bessel lp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.499 0.365 0.116 0.010 0.001 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.499 0.365 0.116 0.010 0.001 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";bessel lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-lowpass 12 .25))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";bessel lp 12 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.477 0.410 0.309 0.185 0.063 0.006 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.477 0.410 0.309 0.185 0.063 0.006 0.000 0.000 0.000)))
(snd-display #__line__ ";bessel lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-lowpass 10 .4))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";bessel lp 10 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.001)))
- (not (vequal1 (cadr vals) (vct 0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.002))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.001)))
+ (not (vequal1 (cadr vals) (float-vector 0.500 0.498 0.491 0.479 0.458 0.423 0.364 0.259 0.086 0.002))))
(snd-display #__line__ ";bessel lp 10 .4 spect: ~A" (cadr vals))))
(do ((i 2 (+ i 2)))
@@ -16223,30 +11193,30 @@ EDITS: 2
(let* ((f1 (make-bessel-highpass 8 .1))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";bessel hp 8 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.001 0.115 0.290 0.386 0.435 0.465 0.483 0.493 0.498 0.500)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.001 0.115 0.290 0.386 0.435 0.465 0.483 0.493 0.498 0.500)))
(snd-display #__line__ ";bessel hp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-highpass 12 .25))
(vals (sweep->bins f1 10)))
(if (fneq (car vals) .5) (snd-display #__line__ ";bessel hp 12 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.006 0.063 0.181 0.309 0.410 0.477 0.500)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.006 0.063 0.181 0.309 0.410 0.477 0.500)))
(snd-display #__line__ ";bessel hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-highpass 10 .4))
(vals (sweep->bins f1 10)))
(if (ffneq (car vals) .5) (snd-display #__line__ ";bessel hp 10 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.004 0.084 0.343 0.499)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.004 0.084 0.343 0.499)))
(snd-display #__line__ ";bessel hp 10 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-bandpass 4 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .245)) .05) (snd-display #__line__ ";bessel bp 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.023 0.176 0.245 0.244 0.179 0.085 0.031 0.008 0.001 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.023 0.176 0.245 0.244 0.179 0.085 0.031 0.008 0.001 0.000)))
(snd-display #__line__ ";bessel bp 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-bessel-bandstop 12 .1 .2))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .05) (snd-display #__line__ ";bessel bs 12 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.498 0.325 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500)))
- (not (vequal1 (cadr vals) (vct 0.499 0.324 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.498 0.325 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500)))
+ (not (vequal1 (cadr vals) (float-vector 0.499 0.324 0.065 0.066 0.177 0.297 0.389 0.452 0.488 0.500))))
(snd-display #__line__ ";bessel bs 12 .1 .2 spect: ~A" (cadr vals))))
;; ---------------- elliptic ----------------
@@ -16254,150 +11224,124 @@ EDITS: 2
(let* ((f1 (make-elliptic-lowpass 8 .1))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 8 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.500 0.515 0.379 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.500 0.509 0.385 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.499 0.498 0.373 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.500 0.515 0.379 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.500 0.509 0.385 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.499 0.498 0.373 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";elliptic lp 8 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 12 .25))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 12 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.476 0.500 0.491 0.499 0.494 0.412 0.003 0.001 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.476 0.500 0.491 0.499 0.494 0.561 0.004 0.000 0.000 0.000)))
- (not (vequal1 (cadr vals) (vct 0.476 0.500 0.491 0.499 0.493 0.299 0.006 0.001 0.000 0.000))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.476 0.500 0.491 0.499 0.494 0.412 0.003 0.001 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.476 0.500 0.491 0.499 0.494 0.561 0.004 0.000 0.000 0.000)))
+ (not (vequal1 (cadr vals) (float-vector 0.476 0.500 0.491 0.499 0.493 0.299 0.006 0.001 0.000 0.000))))
(snd-display #__line__ ";elliptic lp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 4 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.447 0.453 0.462 0.477 0.494 0.500 0.497 0.496 0.445 0.003)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.447 0.453 0.462 0.477 0.494 0.500 0.497 0.496 0.445 0.003)))
(snd-display #__line__ ";elliptic lp 4 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 8 .1 .1))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 8 .1 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";elliptic lp 8 .1 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 8 .1 .1 90))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 8 .1 90 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.499 0.475 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";elliptic lp 8 .1 .1 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-lowpass 8 .25 .01 90))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic lp 8 .25 90 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.500 0.500 0.500 0.500 0.499 0.495 0.001 0.000 0.000 0.000)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.500 0.500 0.500 0.500 0.499 0.495 0.001 0.000 0.000 0.000)))
(snd-display #__line__ ";elliptic lp 8 .25 .1 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 4 .1))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.004 0.438 0.516 0.499 0.502 0.495 0.478 0.463 0.453 0.447)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.004 0.438 0.516 0.499 0.502 0.495 0.478 0.463 0.453 0.447)))
(snd-display #__line__ ";elliptic hp 4 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 12 .25))
(vals (sweep->bins f1 10)))
;(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 12 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.000 0.001 0.001 0.001 0.026 0.934 0.518 0.495 0.503 0.477)))
- (not (vequal1 (cadr vals) (vct 0.000 0.001 0.001 0.001 0.033 1.185 0.519 0.495 0.503 0.477)))
- (not (vequal1 (cadr vals) (vct 0.000 0.001 0.001 0.001 0.018 0.788 0.520 0.495 0.503 0.477))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.000 0.001 0.001 0.001 0.026 0.934 0.518 0.495 0.503 0.477)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.001 0.001 0.001 0.033 1.185 0.519 0.495 0.503 0.477)))
+ (not (vequal1 (cadr vals) (float-vector 0.000 0.001 0.001 0.001 0.018 0.788 0.520 0.495 0.503 0.477))))
(snd-display #__line__ ";elliptic hp 12 .25 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 12 .25 .01 90))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 12 90 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.000 0.499 0.517 0.503 0.501 0.500 0.500)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.000 0.499 0.517 0.503 0.501 0.500 0.500)))
(snd-display #__line__ ";elliptic hp 12 .25 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 4 .4))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.001 0.002 0.023 0.447 0.515 0.502)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.001 0.002 0.023 0.447 0.515 0.502)))
(snd-display #__line__ ";elliptic hp 4 .4 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 8 .1 .1))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 8 .1 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.478 0.553 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.478 0.553 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
(snd-display #__line__ ";elliptic hp 8 .1 .1 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 8 .1 .1 90))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 8 .1 90 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.478 0.554 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.478 0.554 0.506 0.499 0.501 0.501 0.499 0.497 0.495)))
(snd-display #__line__ ";elliptic hp 8 .1 .1 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-highpass 8 .25 .01 90))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic hp 8 .25 90 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.000 0.000 0.000 0.001 0.516 0.517 0.507 0.503 0.501 0.500)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.000 0.000 0.000 0.001 0.516 0.517 0.507 0.503 0.501 0.500)))
(snd-display #__line__ ";elliptic hp 8 .25 .1 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-bandpass 4 .1 .2 .1))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic bp 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.036 0.546 0.550 0.510 0.501 0.032 0.024 0.009 0.021 0.024)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.036 0.546 0.550 0.510 0.501 0.032 0.024 0.009 0.021 0.024)))
(snd-display #__line__ ";elliptic bp 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-bandpass 6 .1 .2 .1 90))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic bp 6 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.002 0.511 0.532 0.503 0.492 0.003 0.001 0.001 0.001 0.001)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.002 0.511 0.532 0.503 0.492 0.003 0.001 0.001 0.001 0.001)))
(snd-display #__line__ ";elliptic bp 6 .1 .2 90 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-bandstop 4 .1 .3 .1))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic bs 4 max: ~A" (car vals)))
- (if (not (vequal1 (cadr vals) (vct 0.499 0.502 0.498 0.037 0.050 0.540 0.544 0.527 0.526 0.521)))
+ (if (not (vequal1 (cadr vals) (float-vector 0.499 0.502 0.498 0.037 0.050 0.540 0.544 0.527 0.526 0.521)))
(snd-display #__line__ ";elliptic bs 4 .1 .2 spect: ~A" (cadr vals))))
(let* ((f1 (make-elliptic-bandstop 8 .1 .3 .1 120))
(vals (sweep->bins f1 10)))
(if (> (abs (- (car vals) .5)) .1) (snd-display #__line__ ";elliptic bs 8 max: ~A" (car vals)))
- (if (and (not (vequal1 (cadr vals) (vct 0.500 0.499 0.476 0.000 0.000 0.495 0.526 0.505 0.501 0.501)))
- (not (vequal1 (cadr vals) (vct 0.500 0.499 0.475 0.000 0.000 0.495 0.526 0.505 0.501 0.501))))
+ (if (and (not (vequal1 (cadr vals) (float-vector 0.500 0.499 0.476 0.000 0.000 0.495 0.526 0.505 0.501 0.501)))
+ (not (vequal1 (cadr vals) (float-vector 0.500 0.499 0.475 0.000 0.000 0.495 0.526 0.505 0.501 0.501))))
(snd-display #__line__ ";elliptic bs 8 .1 .2 spect: ~A" (cadr vals))))
))))
(define (test-polyoid n)
(let* ((res (with-sound (:channels 2 :clipped #f)
- (let ((angle 0.0)
- (incr (hz->radians 1.0))
- (cur-phases (make-vct (* 3 n))))
- (do ((i 0 (+ i 1))
- (j 0 (+ j 3)))
- ((= i n))
- (vct-set! cur-phases j (+ i 1))
- (vct-set! cur-phases (+ j 1) (/ 1.0 n))
- (vct-set! cur-phases (+ j 2) (random (* 2 pi))))
- (let ((gen (make-polyoid 1.0 cur-phases)))
- (do ((i 0 (+ 1 i)))
- ((= i 88200))
- (let ((poly-sum 0.0)
- (sin-sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! sin-sum (+ sin-sum (sin (+ (* (+ k 1) angle) (vct-ref cur-phases (+ (* 3 k) 2)))))))
- (set! poly-sum (polyoid gen 0.0))
- (set! angle (+ angle incr))
- (outa i (/ sin-sum n))
- (outb i poly-sum)))))))
- (snd (find-sound res)))
- (channel-distance snd 0 snd 1)))
-
- (define (test-polyoid-run n)
- (let* ((res (with-sound (:channels 2 :clipped #f)
- (let ((angle 0.0)
- (incr (hz->radians 1.0))
- (cur-phases (make-vct (* 3 n))))
- (do ((i 0 (+ i 1))
- (j 0 (+ j 3)))
- ((= i n))
- (vct-set! cur-phases j (+ i 1))
- (vct-set! cur-phases (+ j 1) (/ 1.0 n))
- (vct-set! cur-phases (+ j 2) (random (* 2 pi))))
- (let ((gen (make-polyoid 1.0 cur-phases)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 88200))
- (let ((poly-sum 0.0)
- (sin-sum 0.0))
- (do ((k 0 (+ 1 k)))
- ((= k n))
- (set! sin-sum (+ sin-sum (sin (+ (* (+ k 1) angle) (vct-ref cur-phases (+ (* 3 k) 2)))))))
- (set! poly-sum (polyoid gen 0.0))
- (set! angle (+ angle incr))
- (outa i (/ sin-sum n))
- (outb i poly-sum))))))))
+ (let ((freqs (make-float-vector n))
+ (phases (make-float-vector n)) ; for oscil-bank
+ (cur-phases (make-float-vector (* 3 n))) ; for polyoid
+ (amp (/ 1.0 n)))
+ (do ((i 0 (+ i 1))
+ (j 0 (+ j 3)))
+ ((= i n))
+ (set! (cur-phases j) (+ i 1))
+ (set! (cur-phases (+ j 1)) (/ 1.0 n))
+ (set! (cur-phases (+ j 2)) (random (* 2 pi)))
+
+ (set! (freqs i) (hz->radians (+ i 1.0)))
+ (set! (phases i) (cur-phases (+ j 2))))
+
+ (let ((gen (make-polyoid 1.0 cur-phases))
+ (obank (make-oscil-bank freqs phases (make-float-vector n 1.0) #t)))
+ (do ((i 0 (+ i 1)))
+ ((= i 88200))
+ (outa i (* amp (oscil-bank obank))))
+ (do ((i 0 (+ i 1)))
+ ((= i 88200))
+ (outb i (polyoid gen 0.0)))))))
(snd (find-sound res)))
(channel-distance snd 0 snd 1)))
@@ -16406,227 +11350,248 @@ EDITS: 2
(letrec ((ceql (lambda (a b)
(if (null? a)
(null? b)
- (if (null? b)
- #f
- (if (or (fneq (real-part (car a)) (real-part (car b)))
- (fneq (imag-part (car a)) (imag-part (car b))))
- #f
- (ceql (cdr a) (cdr b))))))))
+ (and (not (null? b))
+ (not (or (fneq (real-part (car a)) (real-part (car b)))
+ (fneq (imag-part (car a)) (imag-part (car b)))))
+ (ceql (cdr a) (cdr b)))))))
;; degree=0
- (let ((val (poly-roots (vct 0.0))))
- (if (not (null? val)) (snd-display #__line__ ";poly-roots 0.0: ~A" val)))
- (let ((val (poly-roots (vct 12.3))))
- (if (not (null? val)) (snd-display #__line__ ";poly-roots 12.3: ~A" val)))
+ (let ((val (poly-roots (float-vector 0.0))))
+ (if (pair? val) (snd-display #__line__ ";poly-roots 0.0: ~A" val)))
+ (let ((val (poly-roots (float-vector 12.3))))
+ (if (pair? val) (snd-display #__line__ ";poly-roots 12.3: ~A" val)))
;; degree 0 + x=0
- (let ((val (poly-roots (vct 0.0 1.0))))
+ (let ((val (poly-roots (float-vector 0.0 1.0))))
(if (not (ceql val (list 0.0))) (snd-display #__line__ ";poly-roots 0.0 1.0: ~A" val)))
- (let ((val (poly-roots (vct 0.0 0.0 0.0 121.0))))
+ (let ((val (poly-roots (float-vector 0.0 0.0 0.0 121.0))))
(if (not (ceql val (list 0.0 0.0 0.0))) (snd-display #__line__ ";poly-roots 0.0 0.0 0.0 121.0: ~A" val)))
;; degree=1
- (let ((val (poly-roots (vct -1.0 1.0))))
+ (let ((val (poly-roots (float-vector -1.0 1.0))))
(if (not (ceql val (list 1.0))) (snd-display #__line__ ";poly-roots -1.0 1.0: ~A" val)))
- (let ((val (poly-roots (vct -2.0 4.0))))
+ (let ((val (poly-roots (float-vector -2.0 4.0))))
(if (not (ceql val (list 0.5))) (snd-display #__line__ ";poly-roots -2.0 4.0: ~A" val)))
(let ((val (poly-as-vector-roots (vector 0.0-i 1))))
(if (not (ceql val (list -0.0+1.0i))) (snd-display #__line__ ";poly-roots: -i 1: ~A" val)))
;; linear x^n
- (let ((val (poly-roots (vct -1.0 0.0 0.0 0.0 1.0))))
+ (let ((val (poly-roots (float-vector -1.0 0.0 0.0 0.0 1.0))))
(if (and (not (ceql val (list 0.0-1.0i -1.0 0.0+1.0i 1.0)))
(not (ceql val (list 1.0 -1.0 0.0+1.0i -0.0-1.0i))))
(snd-display #__line__ ";poly-roots -1.0 0.0 0.0 0.0 1.0: ~A" val)))
- (let ((val (poly-roots (vct -16.0 0.0 0.0 0.0 1.0))))
+ (let ((val (poly-roots (float-vector -16.0 0.0 0.0 0.0 1.0))))
(if (and (not (ceql val (list 0.0-2.0i -2.0 0.0+2.0i 2.0)))
(not (ceql val (list 2.0 -2.0 0.0+2.0i -0.0-2.0i))))
(snd-display #__line__ ";poly-roots -16.0 0.0 0.0 0.0 1.0: ~A" val)))
- (let ((val (poly-roots (vct -32.0 0 0 0 0 0 0.5))))
+ (let ((val (poly-roots (float-vector -32.0 0 0 0 0 0 0.5))))
(if (not (ceql val (list 1.0-1.7320i -1.0-1.7320i -2.0 -1.0+1.7320i 1.0+1.7320i 2.0))) (snd-display #__line__ ";poly-roots 32 0 0 0 0 0 0.5: ~A" val)))
;; linear + x=0
- (let ((val (poly-roots (vct 0.0 -2.0 4.0))))
+ (let ((val (poly-roots (float-vector 0.0 -2.0 4.0))))
(if (not (ceql val (list 0.0 0.5))) (snd-display #__line__ ";poly-roots 0.0 -2.0 4.0: ~A" val)))
;; degree=2
- (let ((val (poly-roots (vct -1.0 0.0 1.0))))
+ (let ((val (poly-roots (float-vector -1.0 0.0 1.0))))
(if (not (ceql val (list 1.0 -1.0))) (snd-display #__line__ ";poly-roots -1.0 0.0 1.0: ~A" val)))
- (let ((val (poly-roots (vct 15.0 -8.0 1.0))))
+ (let ((val (poly-roots (float-vector 15.0 -8.0 1.0))))
(if (not (ceql val (list 5.0 3.0))) (snd-display #__line__ ";poly-roots 15.0 -8.0 1.0: ~A" val)))
- (let ((val (poly-roots (vct 1 -2 1))))
+ (let ((val (poly-roots (float-vector 1 -2 1))))
(if (not (ceql val (list 1.0 1.0))) (snd-display #__line__ ";poly-roots 1 -2 1: ~A" val)))
(let ((val (poly-as-vector-roots (vector -1 0.0+2i 1))))
(if (not (ceql val (list 0.0-1.0i 0.0-1.0i))) (snd-display #__line__ ";poly-roots -1 2i 1: ~A" val)))
- (let ((val (poly-roots (vct 1 1 5))))
+ (let ((val (poly-roots (float-vector 1 1 5))))
(if (not (ceql val (list -0.1+0.43589i -0.1-0.43589i))) (snd-display #__line__ ";poly-roots 1 1 5: ~A" val)))
;; 2 + x=0
- (let ((val (poly-roots (vct 0.0 0.0 -1.0 0.0 1.0))))
+ (let ((val (poly-roots (float-vector 0.0 0.0 -1.0 0.0 1.0))))
(if (not (ceql val (list 0.0 0.0 1.0 -1.0))) (snd-display #__line__ ";poly-roots 0.0 0.0 -1.0 0.0 1.0: ~A" val)))
;; quadratic in x^(n/2)
- (let ((vals (poly-roots (vct 1.0 0.0 -2.0 0.0 1.0))))
+ (let ((vals (poly-roots (float-vector 1.0 0.0 -2.0 0.0 1.0))))
(if (and (not (ceql vals (list -1.0 1.0 -1.0 1.0)))
(not (ceql vals (list 1.0 1.0 -1.0 -1.0))))
(snd-display #__line__ ";poly-roots 1 0 -2 0 1: ~A" vals)))
- (let ((vals (poly-roots (vct 64.0 0.0 0.0 -16.0 0.0 0.0 1.0))))
+ (let ((vals (poly-roots (float-vector 64.0 0.0 0.0 -16.0 0.0 0.0 1.0))))
(if (not (ceql vals (list -1.0-1.73205i -1.0+1.73205i 2.0 -1.0-1.73205i -1.0+1.73205i 2.0)))
(snd-display #__line__ ";poly-roots 64 0 0 -16 0 0 1: ~A" vals)))
;; degree=3
- (let ((val (poly-roots (vct -15.0 23.0 -9.0 1.0))))
+ (let ((val (poly-roots (float-vector -15.0 23.0 -9.0 1.0))))
(if (not (ceql val (list 5.0 1.0 3.0))) (snd-display #__line__ ";poly-roots 5 1 3: ~A" val)))
- (let ((val (poly-roots (vct -126 -15 0 1))))
+ (let ((val (poly-roots (float-vector -126 -15 0 1))))
(if (not (ceql val (list 6.0 -3.0+3.46410i -3.0-3.46410i))) (snd-display #__line__ ";poly-roots -126 -15 0 1: ~A" val)))
- (let ((val (poly-roots (vct -1 3 -3 1))))
+ (let ((val (poly-roots (float-vector -1 3 -3 1))))
(if (not (ceql val (list 1.0 1.0 1.0))) (snd-display #__line__ ";poly-roots -1 3 -3 1: ~A" val)))
- (let ((val (poly-roots (vct 1 -1 -1 1))))
+ (let ((val (poly-roots (float-vector 1 -1 -1 1))))
(if (and (not (ceql val (list 1.0 -1.0 1.0)))
(not (ceql val (list -1.0 1.0 1.0))))
(snd-display #__line__ ";poly-roots 1 -1 1: ~A" val)))
- (let ((val (poly-roots (vct 2 -2 -2 2))))
+ (let ((val (poly-roots (float-vector 2 -2 -2 2))))
(if (and (not (ceql val (list 1.0 -1.0 1.0)))
(not (ceql val (list -1.0 1.0 1.0))))
(snd-display #__line__ ";poly-roots 2 -2 -2 2: ~A" val)))
;; degree=4
- ; (let ((vals (poly-roots (vct -15 8 14 -8 1))))
+ ; (let ((vals (poly-roots (float-vector -15 8 14 -8 1))))
; (if (not (ceql vals (list 5.0 3.0 1.0 -1.0))) (snd-display #__line__ ";poly-roots -15 8 14 -8 1: ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 8 1) (vct -9 1)))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 8 1) (float-vector -9 1)))))))
; (if (not (ceql vals (list 9.0 3.0 -2.0 -8.0))) (snd-display #__line__ ";poly-roots 4(1): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct .2 1) (vct -3 1)) (poly* (vct .8 1) (vct -9 1)))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector .2 1) (float-vector -3 1)) (poly* (float-vector .8 1) (float-vector -9 1)))))))
; (if (not (ceql vals (list 9.0 3.0 -0.2 -0.8))) (snd-display #__line__ ";poly-roots 4(2): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (vct .02 1) (vct -32 1)) (poly* (vct .8 1) (vct -9 1)))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (poly* (float-vector .02 1) (float-vector -32 1)) (poly* (float-vector .8 1) (float-vector -9 1)))))))
; (if (not (ceql vals (list 32.0 9.0 -0.02 -0.8))) (snd-display #__line__ ";poly-roots 4(3): ~A" vals)))
;; degree>4
- ; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct -1 1) (vct -2 1))))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector -1 1) (float-vector -2 1))))))))
; (if (not (ceql vals (list 3.0 2.0 -1.0 -2.0 1.0)))
; (snd-display #__line__ ";poly-roots n(1): ~A from ~A ~A ~A"
; vals
- ; (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct -1 1) (vct -2 1)))))
- ; (mus-float-equal-fudge-factor)
+ ; (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector -1 1) (float-vector -2 1)))))
+ ; *mus-float-equal-fudge-factor*
; poly-roots-epsilon)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 8 1) (vct -9 1))))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 8 1) (float-vector -9 1))))))))
; (if (not (ceql vals (list 9.0 3.0 -2.0 -8.0 -1.0))) (snd-display #__line__ ";poly-roots n(2): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct 9 1) (vct -3 1)) (poly* (vct -10 1) (vct -2 1))))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector 9 1) (float-vector -3 1)) (poly* (float-vector -10 1) (float-vector -2 1))))))))
; (if (not (ceql vals (list 10.0 3.0 -1.0 -9.0 2.0 1.0))) (snd-display #__line__ ";poly-roots n(3): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct -4 0 1) (vct -3 1)) (poly* (vct -10 1) (vct -9 0 1))))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector -4 0 1) (float-vector -3 1)) (poly* (float-vector -10 1) (float-vector -9 0 1))))))))
; (if (not (ceql vals (list 10.0 3.0 -2.0 -3.0 -1.0 3.0 2.0 1.0))) (snd-display #__line__ ";poly-roots n(4): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (vct -1 0 1) (poly* (poly* (vct -4 0 1) (vct -16 0 1)) (poly* (vct -25 0 1) (vct -9 0 1))))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector -1 0 1) (poly* (poly* (float-vector -4 0 1) (float-vector -16 0 1)) (poly* (float-vector -25 0 1) (float-vector -9 0 1))))))))
; (if (not (ceql vals (list 5.0 -3.0 -4.0 -5.0 4.0 -2.0 3.0 -1.0 2.0 1.0))) (snd-display #__line__ ";poly-roots n(5): ~A" vals)))
- ; (let ((vals (poly-roots (poly-reduce (poly* (vct 1 1) (poly* (poly* (vct 2 1) (vct -3 1)) (poly* (vct 1 1) (vct -2 1))))))))
+ ; (let ((vals (poly-roots (poly-reduce (poly* (float-vector 1 1) (poly* (poly* (float-vector 2 1) (float-vector -3 1)) (poly* (float-vector 1 1) (float-vector -2 1))))))))
; (if (not (ceql vals (list 3.0 -1.0 -1.0 -2.0 2.0))) (snd-display #__line__ ";poly-roots n(6): ~A" vals)))
- (let ((vals (poly-roots (vct -64 0 0 0 0 0 1))))
+ (let ((vals (poly-roots (float-vector -64 0 0 0 0 0 1))))
(if (not (ceql vals (list 0.999999999999999-1.73205080756888i -1.0-1.73205080756888i -2.0 -1.0+1.73205080756888i 1.0+1.73205080756888i 2.0)))
(snd-display #__line__ ";poly-roots 64 6: ~A" vals)))
- (let ((vals (poly-roots (vct 64 0 0 -16 0 0 1))))
+ (let ((vals (poly-roots (float-vector 64 0 0 -16 0 0 1))))
(if (not (ceql vals (list -1.0-1.73205080756888i -1.0+1.73205080756888i 2.0 -1.0-1.73205080756888i -1.0+1.73205080756888i 2.0)))
(snd-display #__line__ ";poly-roots 64 16 6: ~A" vals)))
- (do ((i 0 (+ 1 i))) ((= i 10)) (poly-roots (vct (random 1.0) (random 1.0) (random 1.0))))
- (do ((i 0 (+ 1 i))) ((= i 10)) (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
+ (do ((i 0 (+ i 1))) ((= i 10)) (poly-roots (float-vector (random 1.0) (random 1.0) (random 1.0))))
+ (do ((i 0 (+ i 1))) ((= i 10)) (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
- (let ((vals1 (convolution (vct 1 2 3 0 0 0 0 0) (vct 1 2 3 0 0 0 0 0) 8))
- (vals2 (poly* (vct 1 2 3 0) (vct 1 2 3 0))))
+ (let ((vals1 (convolution (float-vector 1 2 3 0 0 0 0 0) (float-vector 1 2 3 0 0 0 0 0) 8))
+ (vals2 (poly* (float-vector 1 2 3 0) (float-vector 1 2 3 0))))
(if (not (vequal vals1 vals2))
(snd-display #__line__ ";poly* convolve: ~A ~A" vals1 vals2)))
- (do ((i 0 (+ 1 i))) ((= i 10))
- (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
- (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0)))))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0)))))
- (do ((i 0 (+ 1 i))) ((= i 10))
- (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
- (do ((i 0 (+ 1 i))) ((= i 10))
- (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0))
- (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0))
+ (complex (mus-random 1.0) (mus-random 1.0)))))
- ; (do ((i 0 (+ 1 i))) ((= i 10))
- ; (poly-roots (vct (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
+ ; (do ((i 0 (+ i 1))) ((= i 10))
+ ; (poly-roots (float-vector (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0) (mus-random 1.0))))
;
- ; (do ((i 0 (+ 1 i))) ((= i 10))
- ; (poly-as-vector-roots (vector (make-rectangular (mus-random 1.0) (mus-random 1.0))
- ; (make-rectangular (mus-random 1.0) (mus-random 1.0))
- ; (make-rectangular (mus-random 1.0) (mus-random 1.0))
- ; (make-rectangular (mus-random 1.0) (mus-random 1.0))
- ; (make-rectangular (mus-random 1.0) (mus-random 1.0)))))
-
- (do ((i 3 (+ 1 i))) ((= i 20))
- (let ((v (make-vct i 0.0)))
- (vct-set! v 0 (mus-random 1.0))
- (vct-set! v (- i 1) 1.0)
+ ; (do ((i 0 (+ i 1))) ((= i 10))
+ ; (poly-as-vector-roots (vector (complex (mus-random 1.0) (mus-random 1.0))
+ ; (complex (mus-random 1.0) (mus-random 1.0))
+ ; (complex (mus-random 1.0) (mus-random 1.0))
+ ; (complex (mus-random 1.0) (mus-random 1.0))
+ ; (complex (mus-random 1.0) (mus-random 1.0)))))
+
+ (do ((i 3 (+ i 1))) ((= i 20))
+ (let ((v (make-float-vector i 0.0)))
+ (set! (v 0) (mus-random 1.0))
+ (set! (v (- i 1)) 1.0)
(poly-roots v)))
(do ((i 3 (+ i 2))) ((= i 21))
- (let ((v (make-vct i 0.0)))
- (vct-set! v 0 (mus-random 1.0))
- (vct-set! v (- i 1) 1.0)
- (vct-set! v (/ (- i 1) 2) 1.0)
+ (let ((v (make-float-vector i 0.0)))
+ (set! (v 0) (mus-random 1.0))
+ (set! (v (- i 1)) 1.0)
+ (set! (v (/ (- i 1) 2)) 1.0)
(poly-roots v)))
- (let ((vals (poly-roots (vct 1 -1 -1 1))))
+ (let ((vals (poly-roots (float-vector 1 -1 -1 1))))
(if (and (not (ceql vals (list 1.0 -1.0 1.0)))
(not (ceql vals (list -1.0 1.0 1.0))))
(snd-display #__line__ ";poly-roots 1-1-11: ~A" vals)))
- (let ((vals (poly-roots (vct 2 -1 -2 1))))
+ (let ((vals (poly-roots (float-vector 2 -1 -2 1))))
(if (not (ceql vals (list 2.0 -1.0 1.0))) (snd-display #__line__ ";poly-roots 2-1-21: ~A" vals)))
- (let ((vals (poly-roots (vct -1 1 1 1))))
+ (let ((vals (poly-roots (float-vector -1 1 1 1))))
(if (not (ceql vals (list 0.543689012692076 -0.771844506346038+1.11514250803994i -0.771844506346038-1.11514250803994i)))
(snd-display #__line__ ";poly-roots -1111: ~A" vals)))
- (let ((vals (poly-roots (vct -1 3 -3 1))))
+ (let ((vals (poly-roots (float-vector -1 3 -3 1))))
(if (not (ceql vals (list 1.0 1.0 1.0))) (snd-display #__line__ ";poly-roots -13-31: ~A" vals)))
- ; (let ((vals (poly-roots (vct 1 -4 6 -4 1))))
+ ; (let ((vals (poly-roots (float-vector 1 -4 6 -4 1))))
; (if (not (ceql vals (list 1.0 1.0 1.0 1.0))) (snd-display #__line__ ";poly-roots 1-46-41: ~A" vals)))
- (let ((vals (poly-roots (vct 0.5 0 0 1.0))))
+ (let ((vals (poly-roots (float-vector 0.5 0 0 1.0))))
(if (and (not (ceql vals (list 0.396850262992049-0.687364818499302i -0.7937005259841 0.39685026299205+0.687364818499301i)))
(not (ceql vals (list 0.39685026299205+0.687364818499301i 0.39685026299205-0.687364818499301i -0.7937005259841)))
(not (ceql vals (list -7.9370052598409979172089E-1 3.968502629920498958E-1+6.873648184993013E-1i 3.96850262992049E-1-6.873648184993E-1i))))
(snd-display #__line__ ";poly-roots 0..5 3: ~A" vals)))
- (let ((vals (poly-roots (poly* (poly* (poly* (vct -1 1) (vct 1 1)) (poly* (vct -2 1) (vct 2 1))) (poly* (vct -3 1) (vct 3 1))))))
+ (let ((vals (poly-roots (poly* (poly* (poly* (float-vector -1 1) (float-vector 1 1)) (poly* (float-vector -2 1) (float-vector 2 1))) (poly* (float-vector -3 1) (float-vector 3 1))))))
(if (not (ceql vals (list -3.0 3.0 -1.0 1.0 -2.0 2.0)))
(snd-display #__line__ ";cube in 2: ~A" vals)))
))
+
+ ;; -----------------
+ (define (test-fm-components)
+ (if (and (provided? 'gsl)
+ (not (provided? 'gmp)))
+ (let ((str (with-output-to-string
+ (lambda ()
+ (fm-complex-component 1200 1000 100 1.0 4.0 0.0 #f)
+ (fm-cascade-component 2000 2000 500 1.5 50 1.0)))))
+ (if (not (string=? str ";fm-complex-component add -0.000-0.010i from J-3(1.0) = -0.020 and I5(4.0) = 0.505
+;fm-complex-component add 0.163 from J-2(1.0) = 0.115 and I4(4.0) = 1.416
+;fm-complex-component add -0.000+1.469i from J-1(1.0) = -0.440 and I3(4.0) = 3.337
+;fm-complex-component add -4.914 from J0(1.0) = 0.765 and I2(4.0) = 6.422
+;fm-complex-component add 0.000+4.295i from J1(1.0) = 0.440 and I1(4.0) = 9.759
+;fm-complex-component add 1.299 from J2(1.0) = 0.115 and I0(4.0) = 11.302
+;fm-complex-component add 0.000-0.191i from J3(1.0) = 0.020 and I-1(4.0) = 9.759
+;fm-complex-component add -0.016 from J4(1.0) = 0.002 and I-2(4.0) = 6.422
+;fm-cascade-component add 0.512 from J0(1.5) = 0.512 and J0(1.0) = 1.000
+"))
+ (snd-display #__line__ ";fm-components are unexpected:~%~S" str)))))
;; ----------------
- (define (fltit)
- "(fltit) returns a time-varying filter: (map-chan (fltit))"
- (let* ((coeffs (list .1 .2 .3 .4 .4 .3 .2 .1))
- (flt (make-fir-filter 8 (list->vct coeffs)))
- (es (make-vector 8)))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (vector-set! es i (make-env (list 0 (list-ref coeffs i) 1 0) :length 101)))
- (vector-set! es 5 (make-env '(0 .4 1 1) :duration 1.0))
- (lambda (x)
- (let ((val (fir-filter flt x))
- (xcof (mus-xcoeffs flt)))
- (do ((i 0 (+ 1 i)))
+ (define fltit
+ (let ((documentation "(fltit) returns a time-varying filter: (map-channel (fltit))"))
+ (lambda ()
+ (let* ((coeffs (float-vector .1 .2 .3 .4 .4 .3 .2 .1))
+ (flt (make-fir-filter 8 coeffs))
+ (xcof (mus-xcoeffs flt)) ; maybe a copy?
+ (es (make-float-vector 8)))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! xcof i (env (vector-ref es i))))
- val))))
+ (set! (es i) 0.9994)) ; something like (+ 1.0 (/ (log 1e-5) (* 0.5 *clm-srate*)))
+ (set! (es 5) 1.00002)
+ (lambda (x)
+ (float-vector-multiply! xcof es)
+ (fir-filter flt x))))))
+
+;;; (with-sound ("test.snd") (let ((p (make-pulse-train 1000))) (do ((i 0 (+ i 1))) ((= i 44100)) (outa i (* .5 (pulse-train p))))))
+;;; (map-channel (fltit))
+
;; ----------------
(define (freq-sweep dur)
- (let ((phase 0.0)
- (freq 0.0)
- (incr (/ pi (* dur 1.05 (mus-srate)))))
- (map-channel
- (lambda (y)
- (let ((val (sin phase)))
- (set! phase (+ phase freq))
- (set! freq (+ freq incr))
- (* .5 val))))))
+ (let ((ph (make-one-pole 1.0 -1.0))
+ (fq (make-one-pole 1.0 -1.0))
+ (incr (/ pi (* dur 1.05 *clm-srate*)))
+ (len (framples)))
+ (let ((data (make-float-vector len)))
+ (do ((i 2 (+ i 1)))
+ ((= i len))
+ (set! (data i) (sin (one-pole ph (one-pole fq incr)))))
+ (float-vector->channel (float-vector-scale! data 0.5)))))
+
;; ----------------
(define* (make-ssb-am-1 freq (order 40))
@@ -16640,31 +11605,33 @@ EDITS: 2
;; ----------------
(define* (ssb-am-1 gen y (fm-1 0.0))
(let* ((fm fm-1)
- (ccos (oscil (sa1-coscar gen) fm))
- (csin (oscil (sa1-sincar gen) fm))
- (yh (hilbert-transform (sa1-hlb gen) y))
- (yd (delay (sa1-dly gen) y)))
- (if (> (sa1-freq gen) 0.0)
+ (ccos (oscil (gen 'coscar) fm))
+ (csin (oscil (gen 'sincar) fm))
+ (yh (hilbert-transform (gen 'hlb) y))
+ (yd (delay (gen 'dly) y)))
+ (if (> (gen 'freq) 0.0)
(- (* ccos yd) ; shift up
(* csin yh))
(+ (* ccos yd) ; shift down
(* csin yh)))))
;; ----------------
+
(define (rough-spectrum ind)
- (let ((r (make-sampler 0 ind 0))
- (spect (make-vct 10))
- (mx 0.0))
- (do ((i 0 (+ 1 i)))
+ (let ((data (channel->float-vector 0 10000 ind 0))
+ (spect (make-float-vector 10))
+ (g (make-one-pole 1.0 -1.0)))
+ (float-vector-multiply! data data)
+ (do ((i 0 (+ i 1))
+ (beg 0 (+ beg 1000))
+ (end 999 (+ end 1000)))
((= i 10))
- (let ((sum 0.0))
- (do ((j 0 (+ 1 j)))
- ((= j 1000))
- (let ((val (r)))
- (set! sum (+ sum (* val val)))))
- (if (> sum mx) (set! mx sum))
- (vct-set! spect i sum)))
- (vct-scale! spect (/ 1.0 mx))))
+ (mus-reset g)
+ (do ((j beg (+ j 1)))
+ ((= j end))
+ (one-pole g (float-vector-ref data j)))
+ (float-vector-set! spect i (one-pole g (float-vector-ref data end))))
+ (float-vector-scale! spect (/ 1.0 (float-vector-peak spect)))))
;; ----------------
(define* (print-and-check gen name desc (desc1 "") (desc2 ""))
@@ -16683,29 +11650,32 @@ EDITS: 2
(define (test-gen-equal g0 g1 g2)
;; g0 = g1 at start != g2
- (let ((g3 g0)
- (gad (make-frame 2)))
+ (let ((g3 g0))
(if (not (eq? g0 g3))
- (snd-display #__line__ ";let ~A not eq? ~A ~A" (mus-name g0) g0 g3))
+ (snd-display #__line__ ";let ~A not eq?~% ~A~% ~A" (mus-name g0) g0 g3))
(if (eq? g0 g1)
- (snd-display #__line__ ";arg ~A eq? ~A ~A" (mus-name g0) g0 g1))
+ (snd-display #__line__ ";arg ~A eq?~% ~A~% ~A" (mus-name g0) g0 g1))
(if (not (equal? g0 g1))
- (snd-display #__line__ ";~A not equal? ~A ~A" (mus-name g0) g0 g1))
+ (snd-display #__line__ ";~A not equal?~% ~A~% ~A" (mus-name g0) g0 g1))
(if (equal? g0 g2)
- (snd-display #__line__ ";~A equal? ~A ~A" (mus-name g0) g0 g2))
- (if (equal? g0 gad)
- (snd-display #__line__ ";~A equal frame? ~A ~A" (mus-name g0) g0 gad))
+ (snd-display #__line__ ";~A equal?~% ~A~% ~A" (mus-name g0) g0 g2))
(g0)
(g3)
(g3)
(if (not (eq? g0 g3))
- (snd-display #__line__ ";run let ~A not eq? ~A ~A" (mus-name g0) g0 g3))
+ (snd-display #__line__ ";run let ~A not eq?~% ~A~% ~A" (mus-name g0) g0 g3))
(if (eq? g0 g1)
- (snd-display #__line__ ";arg ~A eq? ~A ~A" (mus-name g0) g0 g1))
+ (snd-display #__line__ ";arg ~A eq?~% ~A~% ~A" (mus-name g0) g0 g1))
(if (equal? g0 g1)
- (snd-display #__line__ ";run ~A equal? ~A ~A" (mus-name g0) g0 g1))
+ (snd-display #__line__ ";run ~A equal?~% ~A~% ~A" (mus-name g0) g0 g1))
(if (equal? g0 g2)
- (snd-display #__line__ ";run ~A equal? ~A ~A" (mus-name g0) g0 g2))))
+ (snd-display #__line__ ";run ~A equal?~% ~A~% ~A" (mus-name g0) g0 g2))
+ (let ((data (catch #t (lambda () (mus-data g0)) (lambda args #f))))
+ (when (float-vector? data)
+ (let ((g4 (copy g0)))
+ (let ((data4 (catch #t (lambda () (mus-data g4)) (lambda args #f))))
+ (if (not (float-vector? data4))
+ (snd-display #__line__ ";~A copy -> mus-data ~A?" (mus-name g0) data4))))))))
;; ----------------
(define (fm-test gen)
@@ -16726,7 +11696,7 @@ EDITS: 2
(if (fneq (mus-phase gen) 3.0) (snd-display #__line__ ";~A phase(1, 2): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
(gen 1.0)
(if (fneq (mus-phase gen) 6.0) (snd-display #__line__ ";~A phase(3, 2, 1): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
- (do ((i 0 (+ 1 i))) ((= i 10)) (gen 10.0))
+ (do ((i 0 (+ i 1))) ((= i 10)) (gen 10.0))
(if (fneq (mus-phase gen) (+ 26 (- 100 (* 2 pi 20)))) (snd-display #__line__ ";~A phase (over): ~A ~A" gen (mus-phase gen) (mus-frequency gen)))
(set! (mus-frequency gen) 0.0)
(set! (mus-phase gen) 0.0)
@@ -16737,28 +11707,7 @@ EDITS: 2
(gen -2.0)
(if (and (fneq (mus-phase gen) -2.0)
(fneq (mus-phase gen) (- (* 2 pi) 2.0)))
- (snd-display #__line__ ";phase: ~A freq: ~A" (mus-phase gen))))
-
- ;; ----------------
- ;; from mixer.scm (commented out)
- (define (frame-cross m1 m2)
- (if (or (not (= (mus-length m1) 3))
- (not (= (mus-length m2) 3)))
- (snd-print "cross product only in 3 dimensions")
- (make-frame 3
- (- (* (frame-ref m1 1) (frame-ref m2 2))
- (* (frame-ref m1 2) (frame-ref m2 1)))
- (- (* (frame-ref m1 2) (frame-ref m2 0))
- (* (frame-ref m1 0) (frame-ref m2 2)))
- (- (* (frame-ref m1 0) (frame-ref m2 1))
- (* (frame-ref m1 1) (frame-ref m2 0))))))
-
- ;; ----------------
- (define (frame-normalize f)
- (let ((mag (sqrt (dot-product (mus-data f) (mus-data f)))))
- (if (> mag 0.0)
- (frame* f (/ 1.0 mag))
- f)))
+ (snd-display #__line__ ";phase: ~A freq: ~A" (mus-phase gen) (mus-frequency gen))))
;; ----------------
(define* (agc (ramp-speed .001) (window-size 512))
@@ -16781,7 +11730,7 @@ EDITS: 2
0.45102681179626243254 0.00000000000000000000))
(args (vector -0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 12))
(let* ((nval (acos (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16794,7 +11743,7 @@ EDITS: 2
2.0634370688955605467 2.2924316695611776878 2.9932228461263808979 5.2982923656104845907 7.6009022095419886114))
(args (vector 1.0 1.01 1.1 1.2 1.3 1.4 1.5 2.0 3.0 3.1415926535897932385 4.0 5.0 10.0 100.0 1000.0))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 15))
(let* ((nval (acosh (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16807,7 +11756,7 @@ EDITS: 2
1.1197695149986341867 1.5707963267948966192))
(args (vector -0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 12))
(let* ((nval (asin (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16821,7 +11770,7 @@ EDITS: 2
2.0947125472611012942 2.3124383412727526203 2.9982229502979697388 5.2983423656105887574 7.6009027095419886115))
(args (vector -5.0 -1.0 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 2.0 3.0 4.0 5.0 10.0 100.0 1000.0))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(let* ((nval (asinh (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16834,7 +11783,7 @@ EDITS: 2
(args (vector 0.00000000000000000000 0.25000000000000000000 0.33333333333333333333 0.50000000000000000000 1.0000000000000000000
2.0000000000000000000 3.0000000000000000000 4.0000000000000000000 5.0000000000000000000 10.000000000000000000 20.000000000000000000))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
(let* ((nval (atan (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16847,7 +11796,7 @@ EDITS: 2
1.0986122886681096914 1.4722194895832202300 2.6466524123622461977 3.8002011672502000318 7.2543286192620472067))
(args (vector -0.5 0.0 0.001 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.99 0.999 0.999999))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 15))
(let* ((nval (atanh (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16864,7 +11813,7 @@ EDITS: 2
0.35E+01 0.40E+01 0.45E+01 0.50E+01 0.60E+01 0.80E+01
0.10E+02))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(let* ((nval (bes-i0 (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16880,7 +11829,7 @@ EDITS: 2
(args (vector -5.0E+00 -4.0E+00 -3.0E+00 -2.0E+00 -1.0E+00 0.0E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00
9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 21))
(let* ((nval (bes-j0 (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16896,7 +11845,7 @@ EDITS: 2
(args (vector -5.0E+00 -4.0E+00 -3.0E+00 -2.0E+00 -1.0E+00 0.0E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00
9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 21))
(let* ((nval (bes-j1 (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16913,7 +11862,7 @@ EDITS: 2
(args (vector 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00
50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(let* ((nval (bes-jn (vector-ref ns i) (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16927,7 +11876,7 @@ EDITS: 2
0.5567116728359939E-01 -0.1688473238920795E+00 -0.2252373126343614E+00 -0.7820786452787591E-01 0.1271925685821837E+00 0.2054642960389183E+00))
(args (vector 0.1E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 16))
(let* ((nval (bes-y0 (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16941,7 +11890,7 @@ EDITS: 2
0.2490154242069539E+00 0.1637055374149429E+00 -0.5709921826089652E-01 -0.2100814084206935E+00 -0.1666448418561723E+00 0.2107362803687351E-01))
(args (vector 0.1E+00 1.0E+00 2.0E+00 3.0E+00 4.0E+00 5.0E+00 6.0E+00 7.0E+00 8.0E+00 9.0E+00 10.0E+00 11.0E+00 12.0E+00 13.0E+00 14.0E+00 15.0E+00))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 16))
(let* ((nval (bes-y1 (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16961,7 +11910,7 @@ EDITS: 2
(args (vector 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00 1.0E+00 2.0E+00 5.0E+00 10.0E+00
50.0E+00 2.0E+00 5.0E+00 10.0E+00 50.0E+00))
(max-bad 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 19))
(let* ((nval (bes-yn (vector-ref ns i) (vector-ref args i)))
(diff (abs (- nval (vector-ref vals i)))))
@@ -16976,10 +11925,10 @@ EDITS: 2
(let ((ns (vector 1 6 6 6 15 15 15 15 15 15 15))
(ks (vector 0 1 3 5 1 3 5 7 9 11 13))
(vals (vector 1 6 20 6 15 455 3003 6435 5005 1365 105)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (let* ((nval (binomial-direct (vector-ref ns i) (vector-ref ks i)))
- (mval (n-choose-k (vector-ref ns i) (vector-ref ks i))))
+ (let ((nval (binomial-direct (vector-ref ns i) (vector-ref ks i)))
+ (mval (n-choose-k (vector-ref ns i) (vector-ref ks i))))
(if (or (not (= nval (vector-ref vals i)))
(not (= mval (vector-ref vals i))))
(snd-display #__line__ ";binomial(~A ~A): ~A ~A ~A" (vector-ref ns i) (vector-ref ks i) nval mval (vector-ref vals i))))))
@@ -16989,7 +11938,7 @@ EDITS: 2
(vals (vector 0.000000 0.500000 0.707107 1.000000 -0.866025 -0.125000 -1.29904 2.25000 -0.437500 -0.324759 5.62500 -9.74278
4.21875 -4.92187 12.7874 116.685 -1050.67 -2078.49 30086.2))
(xs (vector 0.0 0.5 0.7071067 1.0 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 19))
(let ((val (plgndr (vector-ref ls i) (vector-ref ms i) (vector-ref xs i))))
(if (or (not (real? val))
@@ -17002,13 +11951,13 @@ EDITS: 2
(ns (vector 0 1 2 3 4 5 6 7 8 9 10 11 12))
(xs (vector 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 13))
(let ((val (chebyshev (vector-ref ns i) (vector-ref xs i))))
(if (fneq val (vector-ref vals i))
(snd-display #__line__ ";chebyshev ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let* ((x (random 10.0))
(order (random 10))
@@ -17048,13 +11997,13 @@ EDITS: 2
24))
(* alpha x (+ (* alpha alpha) (* 3 alpha) 2))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 38))
(let ((val (gegenbauer (vector-ref ns i) (vector-ref xs i) (vector-ref as i))))
(if (fneq val (vector-ref vals i))
(snd-display #__line__ ";gegenbauer ~A ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) (vector-ref as i) val (vector-ref vals i)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let* ((x (random 10.0))
(alpha (random 3.0))
@@ -17063,7 +12012,7 @@ EDITS: 2
(if (fneq val1 val2)
(snd-display #__line__ ";gegenbauer 3 ~A ~A: ~A ~A" x alpha val1 val2))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let* ((x (random 10.0))
(alpha (random 3.0))
@@ -17078,7 +12027,7 @@ EDITS: 2
0.4962122235 -0.4455729167 0.8500000000 -3.1666666667 34.3333333333))
(ns (vector 0 1 2 3 4 5 6 7 8 9 10 11 12 5 5 5 5))
(xs (vector 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 0.5 3.0 5.0 10.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 17))
(let ((val (laguerre (vector-ref ns i) (vector-ref xs i))))
(if (fneq val (vector-ref vals i))
@@ -17090,14 +12039,14 @@ EDITS: 2
421271200 3275529760.0 24329873600.0 171237081280.0 41.0 -8.0 3816.0 3041200.0))
(ns (vector 0 1 2 3 4 5 6 7 8 9 10 11 12 5 5 5 5))
(xs (vector 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 5.0 0.5 1.0 3.0 10.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 13))
(let ((val (hermite (vector-ref ns i) (vector-ref xs i))))
(if (fneq val (vector-ref vals i))
(snd-display #__line__ ";hermite ~A ~A -> ~A ~A" (vector-ref ns i) (vector-ref xs i) val (vector-ref vals i)))))
)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((lv (legendre-polynomial (let ((v (make-vector 10 0.0)))
(vector-set! v i 1.0)
@@ -17136,17 +12085,17 @@ EDITS: 2
(list 2.0 0.5 0.1 -0.5 3.0 0.8)))
(let ((snd (with-sound (:scaled-to 0.5)
- (do ((i 0 (+ 1 i))
- (x 0.0 (+ x .02)))
- ((= i 100))
- (outa i (legendre 20 (cos x)))))))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x .02)))
+ ((= i 100))
+ (outa i (legendre 20 (cos x)))))))
(let ((index (find-sound snd)))
(if (fneq (sample 0 index 0) 0.5) (snd-display #__line__ ";legendre(cos(x)) 0: ~A" (sample 0 index 0)))
(if (fneq (sample 50 index 0) 0.062572978) (snd-display #__line__ ";legendre(cos(x)) 50: ~A" (sample 50 index 0)))
(close-sound index)))
- (let ((h0 (lambda (x) 1.0))
+ (let (;(h0 (lambda (x) 1.0))
(h1 (lambda (x) (* 2 x)))
(h2 (lambda (x) (- (* 4 x x) 2)))
(h3 (lambda (x) (- (* 8 x x x) (* 12 x))))
@@ -17154,7 +12103,7 @@ EDITS: 2
(h5 (lambda (x) (+ (* 32 x x x x x) (* -160 x x x) (* 120 x))))
(h6 (lambda (x) (+ (* 64 x x x x x x) (* -480 x x x x) (* 720 x x) -120))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(let ((x (random 10.0)))
(let ((v1 (h1 x))
@@ -17200,9 +12149,9 @@ EDITS: 2
(va33 (laguerre 3 x a)))
(if (fneq v1 v11) (snd-display #__line__ ";laguerre 1 ~A: ~A ~A" x v1 v11)
(if (fneq v2 v22) (snd-display #__line__ ";laguerre 2 ~A: ~A ~A" x v2 v22)
- (if (fneq va1 va11) (snd-display #__line__ ";laguerre 1a ~A ~A: ~A ~A" x alpha va1 va11)
- (if (fneq va2 va22) (snd-display #__line__ ";laguerre 2a ~A ~A: ~A ~A" x alpha va2 va22)
- (if (fneq va3 va33) (snd-display #__line__ ";laguerre 3a ~A ~A: ~A ~A" x alpha va3 va33)))))))))
+ (if (fneq va1 va11) (snd-display #__line__ ";laguerre 1a ~A ~A: ~A ~A" x a va1 va11)
+ (if (fneq va2 va22) (snd-display #__line__ ";laguerre 2a ~A ~A: ~A ~A" x a va2 va22)
+ (if (fneq va3 va33) (snd-display #__line__ ";laguerre 3a ~A ~A: ~A ~A" x a va3 va33)))))))))
)
;; ----------------
@@ -17216,55 +12165,95 @@ EDITS: 2
(if (mus-generator? 321) (snd-display #__line__ ";123 is a gen?"))
(if (mus-generator? (list 321)) (snd-display #__line__ ";(123) is a gen?"))
(if (mus-generator? (list 'hi 321)) (snd-display #__line__ ";(hi 123) is a gen?"))
- (set! (mus-srate) 22050)
+ (set! *clm-srate* 22050)
(let ((samps (seconds->samples 1.0))
(secs (samples->seconds 22050)))
(if (not (= samps 22050)) (snd-display #__line__ ";seconds->samples: ~A" samps))
(if (fneq secs 1.0) (snd-display #__line__ ";samples->seconds: ~A" secs)))
- (if (and (= clmtest 0)
- (not (= (mus-file-buffer-size) default-file-buffer-size)))
- (snd-display #__line__ ";mus-file-buffer-size: ~D?" (mus-file-buffer-size)))
- (let ((var (catch #t (lambda () (set! (mus-file-buffer-size) #f)) (lambda args args))))
+ (set! *clm-file-buffer-size* default-file-buffer-size)
+ (let ((var (catch #t (lambda () (set! *clm-file-buffer-size* #f)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
(snd-display #__line__ ";mus-file-buffer-size bad size: ~A" var)))
- (set! (mus-file-buffer-size) 128)
- (if (not (= (mus-file-buffer-size) 128)) (snd-display #__line__ ";mus-file-buffer-size: ~D?" (mus-file-buffer-size)))
- (set! (mus-file-buffer-size) default-file-buffer-size)
-
- (if (and (not (= (mus-array-print-length) 8))
- (not (= (mus-array-print-length) 32)))
- (snd-display #__line__ ";mus-array-print-length: ~D?" (mus-array-print-length)))
- (set! (mus-array-print-length) 32)
- (if (not (= (mus-array-print-length) 32)) (snd-display #__line__ ";set mus-array-print-length: ~D?" (mus-array-print-length)))
- (set! (mus-array-print-length) 8)
-
- (let ((fudge (mus-float-equal-fudge-factor)))
- (if (> (abs (- (mus-float-equal-fudge-factor) 0.0000001)) 0.00000001)
- (snd-display #__line__ ";mus-float-equal-fudge-factor: ~A?" (mus-float-equal-fudge-factor)))
- (set! (mus-float-equal-fudge-factor) .1)
- (if (fneq (mus-float-equal-fudge-factor) .1)
- (snd-display #__line__ ";set mus-float-equal-fudge-factor: ~A?" (mus-float-equal-fudge-factor)))
- (set! (mus-float-equal-fudge-factor) fudge))
-
- (if (fneq (mus-srate) 22050.0) (snd-display #__line__ ";mus-srate: ~F?" (mus-srate)))
+ (set! *clm-file-buffer-size* 128)
+ (if (not (= *clm-file-buffer-size* 128)) (snd-display #__line__ ";mus-file-buffer-size: ~D?" *clm-file-buffer-size*))
+ (set! *clm-file-buffer-size* default-file-buffer-size)
+
+ (if (and (not (= *mus-array-print-length* 8))
+ (not (= *mus-array-print-length* 12))
+ (not (= *mus-array-print-length* 32)))
+ (snd-display #__line__ ";mus-array-print-length: ~D?" *mus-array-print-length*))
+ (set! *mus-array-print-length* 32)
+ (if (not (= *mus-array-print-length* 32)) (snd-display #__line__ ";set mus-array-print-length: ~D?" *mus-array-print-length*))
+ (set! *mus-array-print-length* 8)
+
+ (let ((fudge *mus-float-equal-fudge-factor*))
+ (if (> (abs (- *mus-float-equal-fudge-factor* 0.0000001)) 0.00000001)
+ (snd-display #__line__ ";mus-float-equal-fudge-factor: ~A?" *mus-float-equal-fudge-factor*))
+ (set! *mus-float-equal-fudge-factor* .1)
+ (if (fneq *mus-float-equal-fudge-factor* .1)
+ (snd-display #__line__ ";set mus-float-equal-fudge-factor: ~A?" *mus-float-equal-fudge-factor*))
+ (set! *mus-float-equal-fudge-factor* fudge))
+
+ (if (fneq *clm-srate* 22050.0) (snd-display #__line__ ";mus-srate: ~F?" *clm-srate*))
(if (fneq (hz->radians 1.0) 2.84951704088598e-4) (snd-display #__line__ ";hz->radians: ~F?" (hz->radians 1.0)))
(if (fneq (radians->hz 2.84951704088598e-4) 1.0) (snd-display #__line__ ";radians->hz: ~F?" (radians->hz 2.84951704088598e-4)))
(if (fneq (radians->degrees 1.0) 57.2957801818848) (snd-display #__line__ ";radians->degrees: ~F?" (radians->degrees 1.0)))
(if (fneq (degrees->radians 57.2957801818848) 1.0) (snd-display #__line__ ";degrees->radians: ~F?" (degrees->radians 57.2957801818848)))
(if (fneq (linear->db .25) -12.0411996841431) (snd-display #__line__ ";linear->db: ~F?" (linear->db .25)))
(if (fneq (db->linear -12.0411996841431) .25) (snd-display #__line__ ";db->linear: ~F?" (db->linear -12.0411996841431)))
+
+ (if (fneq (odd-weight 0.0) 0.0) (snd-display #__line__ ";odd-weight 0.0: ~F?" (odd-weight 0.0)))
+ (if (fneq (odd-weight 2.0) 0.0) (snd-display #__line__ ";odd-weight 2.0: ~F?" (odd-weight 2.0)))
+ (if (fneq (odd-weight 1.0) 1.0) (snd-display #__line__ ";odd-weight 1.0: ~F?" (odd-weight 1.0)))
+ (if (fneq (odd-weight 1.5) 0.5) (snd-display #__line__ ";odd-weight 1.5: ~F?" (odd-weight 1.5)))
+ (if (fneq (odd-weight 2.5) 0.5) (snd-display #__line__ ";odd-weight 2.5: ~F?" (odd-weight 2.5)))
+ (if (fneq (odd-weight 2.1) 0.1) (snd-display #__line__ ";odd-weight 2.1: ~F?" (odd-weight 2.1)))
+ (if (fneq (odd-weight 2.9) 0.9) (snd-display #__line__ ";odd-weight 2.9: ~F?" (odd-weight 2.9)))
+ (if (fneq (odd-weight 1.1) 0.9) (snd-display #__line__ ";odd-weight 1.1: ~F?" (odd-weight 1.1)))
+ (if (fneq (odd-weight 1.9) 0.1) (snd-display #__line__ ";odd-weight 1.9: ~F?" (odd-weight 1.9)))
+
+ (if (fneq (even-weight 0.0) 1.0) (snd-display #__line__ ";even-weight 0.0: ~F?" (even-weight 0.0)))
+ (if (fneq (even-weight 2.0) 1.0) (snd-display #__line__ ";even-weight 2.0: ~F?" (even-weight 2.0)))
+ (if (fneq (even-weight 1.0) 0.0) (snd-display #__line__ ";even-weight 1.0: ~F?" (even-weight 1.0)))
+ (if (fneq (even-weight 1.5) 0.5) (snd-display #__line__ ";even-weight 1.5: ~F?" (even-weight 1.5)))
+ (if (fneq (even-weight 2.5) 0.5) (snd-display #__line__ ";even-weight 2.5: ~F?" (even-weight 2.5)))
+ (if (fneq (even-weight 2.1) 0.9) (snd-display #__line__ ";even-weight 2.1: ~F?" (even-weight 2.1)))
+ (if (fneq (even-weight 2.9) 0.1) (snd-display #__line__ ";even-weight 2.9: ~F?" (even-weight 2.9)))
+ (if (fneq (even-weight 1.1) 0.1) (snd-display #__line__ ";even-weight 1.1: ~F?" (even-weight 1.1)))
+ (if (fneq (even-weight 1.9) 0.9) (snd-display #__line__ ";even-weight 1.9: ~F?" (even-weight 1.9)))
+
+ (if (fneq (odd-multiple 0.0 2.0) 2.0) (snd-display #__line__ ";odd-multiple 0.0: ~F?" (odd-multiple 0.0 2.0)))
+ (if (fneq (odd-multiple 2.0 2.0) 6.0) (snd-display #__line__ ";odd-multiple 2.0: ~F?" (odd-multiple 2.0 2.0)))
+ (if (fneq (odd-multiple 1.0 2.0) 2.0) (snd-display #__line__ ";odd-multiple 1.0: ~F?" (odd-multiple 1.0 2.0)))
+ (if (fneq (odd-multiple 1.5 2.0) 2.0) (snd-display #__line__ ";odd-multiple 1.5: ~F?" (odd-multiple 1.5 2.0)))
+ (if (fneq (odd-multiple 2.5 2.0) 6.0) (snd-display #__line__ ";odd-multiple 2.5: ~F?" (odd-multiple 2.5 2.0)))
+ (if (fneq (odd-multiple 2.1 2.0) 6.0) (snd-display #__line__ ";odd-multiple 2.1: ~F?" (odd-multiple 2.1 2.0)))
+ (if (fneq (odd-multiple 2.9 2.0) 6.0) (snd-display #__line__ ";odd-multiple 2.9: ~F?" (odd-multiple 2.9 2.0)))
+ (if (fneq (odd-multiple 1.1 2.0) 2.0) (snd-display #__line__ ";odd-multiple 1.1: ~F?" (odd-multiple 1.1 2.0)))
+ (if (fneq (odd-multiple 1.9 2.0) 2.0) (snd-display #__line__ ";odd-multiple 1.9: ~F?" (odd-multiple 1.9 2.0)))
+
+ (if (fneq (even-multiple 0.0 2.0) 0.0) (snd-display #__line__ ";even-multiple 0.0: ~F?" (even-multiple 0.0 2.0)))
+ (if (fneq (even-multiple 2.0 2.0) 4.0) (snd-display #__line__ ";even-multiple 2.0: ~F?" (even-multiple 2.0 2.0)))
+ (if (fneq (even-multiple 1.0 2.0) 4.0) (snd-display #__line__ ";even-multiple 1.0: ~F?" (even-multiple 1.0 2.0)))
+ (if (fneq (even-multiple 1.5 2.0) 4.0) (snd-display #__line__ ";even-multiple 1.5: ~F?" (even-multiple 1.5 2.0)))
+ (if (fneq (even-multiple 2.5 2.0) 4.0) (snd-display #__line__ ";even-multiple 2.5: ~F?" (even-multiple 2.5 2.0)))
+ (if (fneq (even-multiple 2.1 2.0) 4.0) (snd-display #__line__ ";even-multiple 2.1: ~F?" (even-multiple 2.1 2.0)))
+ (if (fneq (even-multiple 2.9 2.0) 4.0) (snd-display #__line__ ";even-multiple 2.9: ~F?" (even-multiple 2.9 2.0)))
+ (if (fneq (even-multiple 1.1 2.0) 4.0) (snd-display #__line__ ";even-multiple 1.1: ~F?" (even-multiple 1.1 2.0)))
+ (if (fneq (even-multiple 1.9 2.0) 4.0) (snd-display #__line__ ";even-multiple 1.9: ~F?" (even-multiple 1.9 2.0)))
+
(if (fneq (ring-modulate .4 .5) .2) (snd-display #__line__ ";ring-modulate: ~F?" (ring-modulate .4 .5)))
(if (fneq (amplitude-modulate 1.0 .5 .4) .7) (snd-display #__line__ ";amplitude-modulate: ~F?" (amplitude-modulate 1.0 .5 .4)))
(if (fneq (contrast-enhancement 0.1 0.75) (sin (+ (* 0.1 (/ pi 2)) (* .75 (sin (* 0.1 2.0 pi))))))
(snd-display #__line__ ";contrast-enhancement: ~F (0.562925306221587)" (contrast-enhancement 0.1 0.75)))
(if (fneq (contrast-enhancement 1.0) 1.0) (snd-display #__line__ ";contrast-enhancement opt: ~A" (contrast-enhancement 1.0)))
- (let ((lv0 (partials->polynomial (vct 1 1 2 1) mus-chebyshev-first-kind))
+ (let ((lv0 (partials->polynomial (float-vector 1 1 2 1) mus-chebyshev-first-kind))
(lv1 (partials->polynomial '(1 1 2 1) mus-chebyshev-second-kind))
(lv2 (partials->polynomial '(1 1 2 1 3 1 5 1) mus-chebyshev-first-kind))
(lv3 (partials->polynomial '(1 1 2 1 3 1 5 1) mus-chebyshev-second-kind))
(lv4 (partials->polynomial '(1 1 2 .5 3 .1 6 .01) mus-chebyshev-first-kind))
(lv5 (partials->polynomial (list 1 1 2 .5 3 .1 6 .01) mus-chebyshev-second-kind))
- (lv6 (partials->polynomial (vct 1 9 2 3 3 5 4 7 5 1))) ; MLB
+ (lv6 (partials->polynomial (float-vector 1 9 2 3 3 5 4 7 5 1))) ; MLB
(lv7 (partials->polynomial '(7 1)))
(lv7a (partials->polynomial '(7 1) mus-chebyshev-first-kind))
(lv8 (partials->polynomial '(7 1) mus-chebyshev-second-kind))
@@ -17275,21 +12264,21 @@ EDITS: 2
(if (not (fveql lv3 '(1.000 2.000 -8.000 0.000 16.000 0.000) 0)) (snd-display #__line__ ";partials->polynomial(4): ~A?" lv3))
(if (not (fveql lv4 '(-0.510 0.700 1.180 0.400 -0.480 0.000 0.320) 0)) (snd-display #__line__ ";partials->polynomial(5): ~A?" lv4))
(if (not (fveql lv5 '(0.900 1.060 0.400 -0.320 0.000 0.320 0.000) 0)) (snd-display #__line__ ";partials->polynomial(6): ~A?" lv5))
- (if (not (vequal lv6 (vct 4.000 -1.000 -50.000 0.000 56.000 16.000))) (snd-display #__line__ ";partials->polynomial(7): ~A?" lv6))
- (if (not (vequal lv7 (vct 0.000 -7.000 0.000 56.000 0.000 -112.000 0.000 64.000))) (snd-display #__line__ ";partials->polynomial(8): ~A?" lv7))
- (if (not (vequal lv8 (vct -1.000 0.000 24.000 0.000 -80.000 0.000 64.000 0.000))) (snd-display #__line__ ";partials->polynomial(9): ~A?" lv8))
+ (if (not (vequal lv6 (float-vector 4.000 -1.000 -50.000 0.000 56.000 16.000))) (snd-display #__line__ ";partials->polynomial(7): ~A?" lv6))
+ (if (not (vequal lv7 (float-vector 0.000 -7.000 0.000 56.000 0.000 -112.000 0.000 64.000))) (snd-display #__line__ ";partials->polynomial(8): ~A?" lv7))
+ (if (not (vequal lv8 (float-vector -1.000 0.000 24.000 0.000 -80.000 0.000 64.000 0.000))) (snd-display #__line__ ";partials->polynomial(9): ~A?" lv8))
(if (not (vequal lv7 lv7a)) (snd-display #__line__ ";partials->polynomial kind=1? ~A ~A" lv7 lv7a))
- (if (not (vequal (normalize-partials (list 1 1 2 1)) (vct 1.000 0.500 2.000 0.500)))
+ (if (not (vequal (normalize-partials (list 1 1 2 1)) (float-vector 1.000 0.500 2.000 0.500)))
(snd-display #__line__ ";normalize-partials 1: ~A" (normalize-partials (list 1 1 2 1))))
- (if (not (vequal (normalize-partials (vct 1 1 2 1)) (vct 1.000 0.500 2.000 0.500)))
- (snd-display #__line__ ";normalize-partials 2: ~A" (normalize-partials (vct 1 1 2 1))))
- (if (not (vequal (normalize-partials (vct 1 1 2 -1)) (vct 1.000 0.500 2.000 -0.500)))
- (snd-display #__line__ ";normalize-partials 3: ~A" (normalize-partials (vct 1 1 2 -1))))
- (if (not (vequal (normalize-partials (vct 1 -.1 2 -.1)) (vct 1.000 -0.500 2.000 -0.500)))
- (snd-display #__line__ ";normalize-partials 4: ~A" (normalize-partials (vct 1 -.1 2 -.1))))
- (if (not (vequal (normalize-partials (vct 0 2 1 1 4 1)) (vct 0.000 0.500 1.000 0.250 4.000 0.250)))
- (snd-display #__line__ ";normalize-partials 4: ~A" (normalize-partials (vct 0 2 1 1 4 1))))
+ (if (not (vequal (normalize-partials (float-vector 1 1 2 1)) (float-vector 1.000 0.500 2.000 0.500)))
+ (snd-display #__line__ ";normalize-partials 2: ~A" (normalize-partials (float-vector 1 1 2 1))))
+ (if (not (vequal (normalize-partials (float-vector 1 1 2 -1)) (float-vector 1.000 0.500 2.000 -0.500)))
+ (snd-display #__line__ ";normalize-partials 3: ~A" (normalize-partials (float-vector 1 1 2 -1))))
+ (if (not (vequal (normalize-partials (float-vector 1 -.1 2 -.1)) (float-vector 1.000 -0.500 2.000 -0.500)))
+ (snd-display #__line__ ";normalize-partials 4: ~A" (normalize-partials (float-vector 1 -.1 2 -.1))))
+ (if (not (vequal (normalize-partials (float-vector 0 2 1 1 4 1)) (float-vector 0.000 0.500 1.000 0.250 4.000 0.250)))
+ (snd-display #__line__ ";normalize-partials 4: ~A" (normalize-partials (float-vector 0 2 1 1 4 1))))
(if (fneq (polynomial lv7 1.0) (cosh (* 7 (acosh 1.0))))
(snd-display #__line__ ";ccosh cheb 7 1.0: ~A ~A" (polynomial lv7 1.0) (cosh (* 7 (acosh 1.0)))))
@@ -17299,29 +12288,30 @@ EDITS: 2
(snd-display #__line__ ";acos cheb 7 1.0: ~A ~A" (polynomial lv8 0.5) (/ (sin (* 7 (acos 0.5))) (sin (acos 0.5)))))
;; G&R 8.943 p 984 uses n+1 where we use n in Un? (our numbering keeps harmonics aligned between Tn and Un)
- (do ((i 0 (+ 1 i)))
- ((+ i 10))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
(let ((val (mus-random 1.0)))
(if (fneq (polynomial lv7 val) (cosh (* 7 (acosh val))))
(snd-display #__line__ ";ccosh cheb 7 ~A: ~A ~A" val (polynomial lv7 val) (cosh (* 7 (acosh val)))))
(if (fneq (polynomial lv7 val) (cos (* 7 (acos val))))
- (snd-display #__line__ ";cos cheb 7 ~A: ~A ~A" (polynomial lv7 val) (cos (* 7 (acos val)))))
+ (snd-display #__line__ ";cos cheb 7 ~A: ~A ~A" val (polynomial lv7 val) (cos (* 7 (acos val)))))
(if (fneq (polynomial lv8 val) (/ (sin (* 7 (acos val))) (sin (acos val))))
(snd-display #__line__ ";acos cheb 7 ~A: ~A ~A" val (polynomial lv8 val) (/ (sin (* 7 (acos val))) (sin (acos val)))))))
)
;; check phase-quadrature cancellations
(let ((cos-coeffs (partials->polynomial '(1 1 2 1) mus-chebyshev-first-kind))
- (sin-coeffs (partials->polynomial (vct 1 1 2 1) mus-chebyshev-second-kind)))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 440.0) 22050.0))))
+ (sin-coeffs (partials->polynomial (float-vector 1 1 2 1) mus-chebyshev-second-kind))
+ (incr (/ (* 2 pi 440.0) 22050.0)))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((= i 1100))
(let* ((x (cos a))
(y (sin a))
(cax (polynomial cos-coeffs x))
(sax (polynomial sin-coeffs x))
- (upper (- (* (cos (* 2 a)) cax) (* (sin (* 2 a)) (* y sax))))
- (lower (+ (* (cos (* 2 a)) cax) (* (sin (* 2 a)) (* y sax))))
+ (upper (- (* (cos (* 2 a)) cax) (* (sin (* 2 a)) y sax)))
+ (lower (+ (* (cos (* 2 a)) cax) (* (sin (* 2 a)) y sax)))
(upper2 (+ (cos (* a 3)) (cos (* a 4))))
(lower2 (+ 1.0 (cos a))))
(if (or (fneq upper upper2)
@@ -17331,174 +12321,137 @@ EDITS: 2
(let ((tag (catch #t (lambda () (harmonicizer 550.0 (list .5 .3 .2) 10)) (lambda args (car args)))))
(if (not (eq? tag 'no-data)) (snd-display #__line__ ";odd length arg to partials->polynomial: ~A" tag)))
- (let* ((amps (list->vct '(1.0)))
- (phases (list->vct '(0.0)))
- (val (sine-bank amps phases)))
- (if (fneq val 0.0) (snd-display #__line__ ";sine-bank: ~A 0.0?" val))
- (vct-set! phases 0 (/ pi 2))
- (set! val (sine-bank amps phases))
- (if (fneq val 1.0) (snd-display #__line__ ";sine-bank: ~A 1.0?" val))
- (set! amps (list->vct '(0.5 0.25 1.0)))
- (set! phases (list->vct '(1.0 0.5 2.0)))
- (set! val (sine-bank amps phases))
- (if (fneq val 1.44989) (snd-display #__line__ ";sine-bank: ~A 1.449?" val))
- (set! val (sine-bank amps phases 3))
- (if (fneq val 1.44989) (snd-display #__line__ ";sine-bank (3): ~A 1.449?" val))
- (set! val (sine-bank amps phases 1))
- (if (fneq val 0.4207) (snd-display #__line__ ";sine-bank (1): ~A 1.449?" val)))
-
- (let ((rdat (make-vct 16))
- (idat (make-vct 16))
- (vdat (make-vct 16)))
- (vct-set! rdat 0 1.0)
- (vct-set! vdat 0 1.0)
+ (let ((rdat (make-float-vector 16))
+ (idat (make-float-vector 16))
+ (vdat (make-float-vector 16)))
+ (set! (rdat 0) 1.0)
+ (set! (vdat 0) 1.0)
(let ((v0 (spectrum rdat idat (make-fft-window rectangular-window 16) 1)) ;rectangular here to avoid clobbering 0-th data point
(v1 (snd-spectrum vdat rectangular-window 16 #t)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 8)) ;should all be 1.0 (impulse in)
- (if (fneq (vct-ref v0 i) (vct-ref v1 i))
+ (if (fneq (v0 i) (v1 i))
(snd-display #__line__ ";spectra not equal 1: ~A ~A" v0 v1))))
- (vct-scale! idat 0.0)
- (vct-scale! rdat 0.0)
- (vct-set! rdat 0 1.0)
+ (float-vector-scale! idat 0.0)
+ (float-vector-scale! rdat 0.0)
+ (set! (rdat 0) 1.0)
(let ((v0 (spectrum rdat idat (make-fft-window rectangular-window 17) 1)) ;rectangular here to avoid clobbering 0-th data point
(v1 (snd-spectrum vdat rectangular-window 16 #t)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 8)) ;should all be 1.0 (impulse in)
- (if (fneq (vct-ref v0 i) (vct-ref v1 i))
+ (if (fneq (v0 i) (v1 i))
(snd-display #__line__ ";spectra not equal 0: ~A ~A" v0 v1))))
(let ((var (catch #t (lambda () (spectrum rdat idat #f -1)) (lambda args args))))
- (if (or (vct? var)
+ (if (or (float-vector? var)
(not (eq? (car var) 'out-of-range)))
(snd-display #__line__ ";spectrum bad type: ~A" var))))
- (let ((rdat (make-vct 16))
- (idat (make-vct 16))
- (xdat (make-vct 16))
- (ydat (make-vct 16)))
- (vct-set! rdat 3 1.0)
- (vct-set! xdat 3 1.0)
+ (let ((rdat (make-float-vector 16))
+ (idat (make-float-vector 16))
+ (xdat (make-float-vector 16))
+ (ydat (make-float-vector 16)))
+ (set! (rdat 3) 1.0)
+ (set! (xdat 3) 1.0)
(fft rdat idat 1)
(mus-fft xdat ydat 16 1)
- (if (fneq (vct-ref rdat 0) (vct-ref xdat 0)) (snd-display #__line__ ";ffts: ~A ~A?" rdat xdat))
+ (if (fneq (rdat 0) (xdat 0)) (snd-display #__line__ ";ffts: ~A ~A?" rdat xdat))
(fft rdat idat -1)
(mus-fft xdat ydat 17 -1) ; mistake is deliberate
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 16))
- (if (or (and (= i 3) (or (fneq (vct-ref rdat i) 16.0) (fneq (vct-ref xdat i) 16.0)))
- (and (not (= i 3)) (or (fneq (vct-ref rdat i) 0.0) (fneq (vct-ref xdat i) 0.0))))
- (snd-display #__line__ ";fft real[~D]: ~A ~A?" i (vct-ref rdat i) (vct-ref xdat i)))
- (if (or (fneq (vct-ref idat i) 0.0) (fneq (vct-ref ydat i) 0.0))
- (snd-display #__line__ ";fft imag[~D]: ~A ~A?" i (vct-ref idat i) (vct-ref ydat i))))
+ (if (or (and (= i 3) (or (fneq (rdat i) 16.0) (fneq (xdat i) 16.0)))
+ (and (not (= i 3)) (or (fneq (rdat i) 0.0) (fneq (xdat i) 0.0))))
+ (snd-display #__line__ ";fft real[~D]: ~A ~A?" i (rdat i) (xdat i)))
+ (if (or (fneq (idat i) 0.0) (fneq (ydat i) 0.0))
+ (snd-display #__line__ ";fft imag[~D]: ~A ~A?" i (idat i) (ydat i))))
(let ((var (catch #t (lambda () (mus-fft xdat ydat -1 0)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
(snd-display #__line__ ";mus-fft bad len: ~A" var))))
- (let ((rdat (make-vct 20))
- (idat (make-vct 19)))
- (vct-set! rdat 3 1.0)
+ (let ((rdat (make-float-vector 20))
+ (idat (make-float-vector 19)))
+ (set! (rdat 3) 1.0)
(mus-fft rdat idat)
(convolution rdat idat)
(spectrum rdat idat #f))
- (let ((v0 (make-vct 10))
- (v1 (make-vct 10)))
- (vct-fill! v0 1.0)
- (multiply-arrays v0 v1 1)
- (if (not (vequal v0 (vct 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";multiply-arrays[0]: ~A?" v0))
- (multiply-arrays v0 v1 100)
- (if (fneq (vct-peak v0) 0.0)
- (snd-display #__line__ ";multiply-arrays[100]: ~A?" v0))
- (vct-fill! v0 1.0)
- (vct-fill! v1 0.5)
- (multiply-arrays v0 v1)
- (if (fneq (vct-ref v0 0) 0.5) (snd-display #__line__ ";multiple-arrays: ~F?" (vct-ref v0 0)))
+ (let ((v0 (make-float-vector 10))
+ (v1 (make-float-vector 10)))
+ (fill! v0 1.0)
+ (fill! v1 0.5)
+ (float-vector-multiply! v0 v1)
+ (if (fneq (v0 0) 0.5) (snd-display #__line__ ";multiple-arrays: ~F?" (v0 0)))
(let ((sum (dot-product v0 v1)))
(if (fneq sum 2.5) (snd-display #__line__ ";dot-product: ~F?" sum)))
(let ((sum (dot-product v0 v1 10)))
(if (fneq sum 2.5) (snd-display #__line__ ";dot-product (10): ~F?" sum)))
(let ((sum (dot-product v0 v1 3)))
(if (fneq sum 0.75) (snd-display #__line__ ";dot-product (3): ~F?" sum)))
- (clear-array v0)
- (if (fneq (vct-ref v0 3) 0.0) (snd-display #__line__ ";clear-array: ~A?" v0))
- (vct-fill! v0 1.0)
- (vct-fill! v1 0.5)
+ (fill! v0 0.0)
+ (if (fneq (v0 3) 0.0) (snd-display #__line__ ";fill!: ~A?" v0))
+ (fill! v0 1.0)
+ (fill! v1 0.5)
(let ((v2 (rectangular->polar v0 v1)))
- (if (fneq (vct-ref v2 0) 1.118) (snd-display #__line__ ";rectangular->polar: ~A?" v2)))
- (vct-set! v0 0 1.0)
- (vct-set! v1 0 1.0)
+ (if (fneq (v2 0) 1.118) (snd-display #__line__ ";rectangular->polar: ~A?" v2)))
+ (set! (v0 0) 1.0)
+ (set! (v1 0) 1.0)
(rectangular->polar v0 v1)
- (if (or (fneq (vct-ref v0 0) (sqrt 2.0))
- (fneq (vct-ref v1 0) (- (atan 1.0 1.0)))) ;(tan (atan 1.0 1.0)) -> 1.0
- (snd-display #__line__ ";rectangular->polar (~A ~A): ~A ~A?" (sqrt 2.0) (- (atan 1.0 1.0)) (vct-ref v0 0) (vct-ref v1 0)))
+ (if (or (fneq (v0 0) (sqrt 2.0))
+ (fneq (v1 0) (- (atan 1.0 1.0)))) ;(tan (atan 1.0 1.0)) -> 1.0
+ (snd-display #__line__ ";rectangular->polar (~A ~A): ~A ~A?" (sqrt 2.0) (- (atan 1.0 1.0)) (v0 0) (v1 0)))
(polar->rectangular v0 v1)
- (if (or (fneq (vct-ref v0 0) 1.0)
- (fneq (vct-ref v1 0) 1.0))
- (snd-display #__line__ ";polar->rectangular (1 1): ~A ~A?" (vct-ref v0 0) (vct-ref v1 0)))
-
- (let ((v0 (make-vct 1))
- (v1 (make-vct 1))
- (v (make-vct 1))
- (val .123))
- (vct-set! v0 0 1.0)
- (vct-set! v1 0 1.0)
- (vct-map! v (lambda ()
- (rectangular->polar v0 v1)
- (set! val (vct-ref v0 0))
- (polar->rectangular v0 v1)
- (vct-ref v1 0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run r->p not inverted: ~A" v))
- (if (fneq val (sqrt 2.0)) (snd-display #__line__ ";r->p: ~A" val)))
+ (if (or (fneq (v0 0) 1.0)
+ (fneq (v1 0) 1.0))
+ (snd-display #__line__ ";polar->rectangular (1 1): ~A ~A?" (v0 0) (v1 0)))
- (let* ((ind (open-sound "oboe.snd"))
- (rl (channel->vct 1200 512))
- (im (make-vct 512)))
+ (let ((ind (open-sound "oboe.snd"))
+ (rl (channel->float-vector 1200 512))
+ (im (make-float-vector 512)))
(fft rl im 512)
- (let ((rl-copy (vct-copy rl))
- (im-copy (vct-copy im)))
+ (let ((rl-copy (copy rl))
+ (im-copy (copy im)))
(rectangular->polar rl im)
(polar->rectangular rl im)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 512))
- (if (or (fneq (vct-ref rl i) (vct-ref rl-copy i))
- (fneq (vct-ref im i) (vct-ref im-copy i)))
+ (if (or (fneq (rl i) (rl-copy i))
+ (fneq (im i) (im-copy i)))
(snd-display #__line__ ";polar->rectangular[~D]: ~A ~A ~A ~A"
i
- (vct-ref rl i) (vct-ref rl-copy i)
- (vct-ref im i) (vct-ref im-copy i)))))
+ (rl i) (rl-copy i)
+ (im i) (im-copy i)))))
(close-sound ind)))
- (let ((v0 (make-vct 8))
- (v1 (make-vct 8)))
- (do ((i 0 (+ i 1))) ((= i 8)) (vct-set! v0 i i) (vct-set! v1 i (/ (+ i 1))))
+ (let ((v0 (make-float-vector 8))
+ (v1 (make-float-vector 8)))
+ (do ((i 0 (+ i 1))) ((= i 8)) (set! (v0 i) i) (set! (v1 i) (/ (+ i 1))))
(rectangular->magnitudes v0 v1)
- (if (not (vequal v0 (vct 1.000 1.118 2.028 3.010 4.005 5.003 6.002 7.001)))
+ (if (not (vequal v0 (float-vector 1.000 1.118 2.028 3.010 4.005 5.003 6.002 7.001)))
(snd-display #__line__ ";rectangular->magnitudes v0: ~A" v0)))
- (let ((v0 (make-vct 8))
- (v1 (make-vct 8))
- (v2 (make-vct 8))
- (v3 (make-vct 8)))
+ (let ((v0 (make-float-vector 8))
+ (v1 (make-float-vector 8))
+ (v2 (make-float-vector 8))
+ (v3 (make-float-vector 8)))
(do ((i 0 (+ i 1)))
((= i 8))
(let ((val1 (random 1.0))
(val2 (random 1.0)))
- (vct-set! v0 i val1)
- (vct-set! v2 i val1)
- (vct-set! v1 i val2)
- (vct-set! v3 i val2)))
+ (set! (v0 i) val1)
+ (float-vector-set! v2 i val1)
+ (float-vector-set! v1 i val2)
+ (float-vector-set! v3 i val2)))
(rectangular->magnitudes v0 v1)
(rectangular->polar v2 v3)
(if (not (vequal v0 v2))
(snd-display #__line__ ";rectangular->magnitudes|polar: ~A ~A" v0 v2)))
(if (defined? 'edot-product) ; needs complex numbers in C
- (let* ((vals (make-vct 1 1.0))
+ (let* ((vals (make-float-vector 1 1.0))
(v1 (edot-product 0.0 vals)))
(if (fneq v1 1.0) ; exp 0.0 * 1.0
(snd-display #__line__ ";edot a 1.0: ~A" v1))
- (vct-set! vals 0 0.0)
+ (set! (vals 0) 0.0)
(set! v1 (edot-product 0.0 vals))
(if (fneq v1 0.0) ; exp 0.0 * 0.0
(snd-display #__line__ ";edot b 0.0: ~A" v1))
@@ -17506,11 +12459,11 @@ EDITS: 2
(set! v1 (edot-product 0.0 vals))
(if (fneq v1 1.0) ; exp 0.0 * 1.0
(snd-display #__line__ ";edot c 1.0: ~A" v1))
- (vector-set! vals 0 0.0+i)
+ (set! (vals 0) 0.0+i)
(set! v1 (edot-product 0.0 vals))
(if (cneq v1 0.0+i)
(snd-display #__line__ ";edot i: ~A" v1))
- (set! vals (make-vct 4 1.0))
+ (set! vals (make-float-vector 4 1.0))
(set! v1 (edot-product (* 0.25 2 pi) vals))
(let ((v2 (+ (exp (* 0 2 pi))
(exp (* 0.25 2 pi))
@@ -17518,18 +12471,18 @@ EDITS: 2
(exp (* 0.75 2 pi)))))
(if (fneq v1 v2) (snd-display #__line__ ";edot 4: ~A ~A" v1 v2)))
(set! vals (make-vector 4 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 4))
- (vector-set! vals i (+ i 1.0)))
+ (set! (vals i) (+ i 1.0)))
(set! v1 (edot-product (* 0.25 2 pi 0.0-i) vals))
- (let ((v2 (+ (* 1 (exp (* 0 2 pi 0.0-i)))
+ (let ((v2 (+ (* (exp (* 0 2 pi 0.0-i)))
(* 2 (exp (* 0.25 2 pi 0.0-i)))
(* 3 (exp (* 0.5 2 pi 0.0-i)))
(* 4 (exp (* 0.75 2 pi 0.0-i))))))
(if (cneq v1 v2) (snd-display #__line__ ";edot 4 -i: ~A ~A" v1 v2)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 4))
- (vector-set! vals i (+ i 1.0+i)))
+ (set! (vals i) (+ i 1.0+i)))
(set! v1 (edot-product (* 0.25 2 pi 0.0-i) vals))
(let ((v2 (+ (* 1+i (exp (* 0 2 pi 0.0-i)))
(* 2+i (exp (* 0.25 2 pi 0.0-i)))
@@ -17537,10 +12490,10 @@ EDITS: 2
(* 4+i (exp (* 0.75 2 pi 0.0-i))))))
(if (cneq v1 v2) (snd-display #__line__ ";edot 4 -i * i: ~A ~A" v1 v2)))))
- (let ((v0 (make-vct 3)))
- (vct-set! v0 0 1.0)
- (vct-set! v0 1 0.5)
- (vct-set! v0 2 0.1)
+ (let ((v0 (make-float-vector 3)))
+ (set! (v0 0) 1.0)
+ (set! (v0 1) 0.5)
+ (set! (v0 2) 0.1)
(if (or (fneq (polynomial v0 0.0) 1.0)
(fneq (polynomial v0 1.0) 1.6)
(fneq (polynomial v0 2.0) 2.4))
@@ -17548,8 +12501,8 @@ EDITS: 2
(polynomial v0 0.0)
(polynomial v0 1.0)
(polynomial v0 2.0))))
- (if (fneq (polynomial (vct 0.0 2.0) 0.5) 1.0)
- (snd-display #__line__ ";polynomial 2.0 * 0.5: ~A" (polynomial (vct 2.0) 0.5)))
+ (if (fneq (polynomial (float-vector 0.0 2.0) 0.5) 1.0)
+ (snd-display #__line__ ";polynomial 2.0 * 0.5: ~A" (polynomial (float-vector 2.0) 0.5)))
(let ((var (catch #t (lambda () (polynomial #f 1.0)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
(snd-display #__line__ ";polynomial empty coeffs: ~A" var)))
@@ -17562,10 +12515,10 @@ EDITS: 2
(val2 (modulo arg1 arg2)))
(if (and (> (abs (- val1 val2)) 1e-8)
(> (abs (- (abs (- val1 val2)) (abs arg2))) 1e-8))
- (format #t "~A ~A: ~A ~A -> ~A~%" arg1 arg2 val1 val2 (abs (- val1 val2)))))))
+ (snd-display #__line__ ";poly ~A ~A: ~A ~A -> ~A~%" arg1 arg2 val1 val2 (abs (- val1 val2)))))))
(let ((err 0.0)
- (coeffs (vct 1.0 0.0 -.4999999963 0.0 .0416666418 0.0 -.0013888397 0.0 .0000247609 0.0 -.0000002605))
+ (coeffs (float-vector 1.0 0.0 -.4999999963 0.0 .0416666418 0.0 -.0013888397 0.0 .0000247609 0.0 -.0000002605))
(pi2 (* pi 0.5)))
(letrec ((new-cos
(lambda (x)
@@ -17580,7 +12533,7 @@ EDITS: 2
(if (< nxx (* 1.5 pi))
(- (polynomial coeffs (- nxx pi)))
(polynomial coeffs (- (* 2 pi) nxx)))))))))))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(x -10.0 (+ x .01)))
((= i 2000))
(let ((diff (abs (- (cos x) (new-cos x)))))
@@ -17588,109 +12541,109 @@ EDITS: 2
(set! err diff))))
(if (> err 1.1e-7) (snd-display #__line__ ";new-cos poly err: ~A" err))))
- (let ((val (poly+ (vct .1 .2 .3) (vct 0.0 1.0 2.0 3.0 4.0))))
- (if (not (vequal val (vct 0.100 1.200 2.300 3.000 4.000))) (snd-display #__line__ ";poly+ 1: ~A" val)))
-
- (let ((val (poly+ (vct .1 .2 .3) .5)))
- (if (not (vequal val (vct 0.600 0.200 0.300))) (snd-display #__line__ ";poly+ 2: ~A" val)))
- (let ((val (poly+ .5 (vct .1 .2 .3))))
- (if (not (vequal val (vct 0.600 0.200 0.300))) (snd-display #__line__ ";poly+ 3: ~A" val)))
-
- (let ((val (poly* (vct 1 1) (vct -1 1))))
- (if (not (vequal val (vct -1.000 0.000 1.000 0.000))) (snd-display #__line__ ";poly* 1: ~A" val)))
- (let ((val (poly* (vct -5 1) (vct 3 7 2))))
- (if (not (vequal val (vct -15.000 -32.000 -3.000 2.000 0.000))) (snd-display #__line__ ";poly* 2: ~A" val)))
- (let ((val (poly* (vct -30 -4 2) (vct 0.5 1))))
- (if (not (vequal val (vct -15.000 -32.000 -3.000 2.000 0.000))) (snd-display #__line__ ";poly* 3: ~A" val)))
- (let ((val (poly* (vct -30 -4 2) 0.5)))
- (if (not (vequal val (vct -15.000 -2.000 1.000))) (snd-display #__line__ ";poly* 4: ~A" val)))
- (let ((val (poly* 2.0 (vct -30 -4 2))))
- (if (not (vequal val (vct -60.000 -8.000 4.000))) (snd-display #__line__ ";poly* 5: ~A" val)))
-
- (let ((val (poly/ (vct -1.0 -0.0 1.0) (vct 1.0 1.0))))
- (if (or (not (vequal (car val) (vct -1.000 1.000 0.000)))
- (not (vequal (cadr val) (vct 0.000 0.000 0.000))))
+ (let ((val (poly+ (float-vector .1 .2 .3) (float-vector 0.0 1.0 2.0 3.0 4.0))))
+ (if (not (vequal val (float-vector 0.100 1.200 2.300 3.000 4.000))) (snd-display #__line__ ";poly+ 1: ~A" val)))
+
+ (let ((val (poly+ (float-vector .1 .2 .3) .5)))
+ (if (not (vequal val (float-vector 0.600 0.200 0.300))) (snd-display #__line__ ";poly+ 2: ~A" val)))
+ (let ((val (poly+ .5 (float-vector .1 .2 .3))))
+ (if (not (vequal val (float-vector 0.600 0.200 0.300))) (snd-display #__line__ ";poly+ 3: ~A" val)))
+
+ (let ((val (poly* (float-vector 1 1) (float-vector -1 1))))
+ (if (not (vequal val (float-vector -1.000 0.000 1.000 0.000))) (snd-display #__line__ ";poly* 1: ~A" val)))
+ (let ((val (poly* (float-vector -5 1) (float-vector 3 7 2))))
+ (if (not (vequal val (float-vector -15.000 -32.000 -3.000 2.000 0.000))) (snd-display #__line__ ";poly* 2: ~A" val)))
+ (let ((val (poly* (float-vector -30 -4 2) (float-vector 0.5 1))))
+ (if (not (vequal val (float-vector -15.000 -32.000 -3.000 2.000 0.000))) (snd-display #__line__ ";poly* 3: ~A" val)))
+ (let ((val (poly* (float-vector -30 -4 2) 0.5)))
+ (if (not (vequal val (float-vector -15.000 -2.000 1.000))) (snd-display #__line__ ";poly* 4: ~A" val)))
+ (let ((val (poly* 2.0 (float-vector -30 -4 2))))
+ (if (not (vequal val (float-vector -60.000 -8.000 4.000))) (snd-display #__line__ ";poly* 5: ~A" val)))
+
+ (let ((val (poly/ (float-vector -1.0 -0.0 1.0) (float-vector 1.0 1.0))))
+ (if (or (not (vequal (car val) (float-vector -1.000 1.000 0.000)))
+ (not (vequal (cadr val) (float-vector 0.000 0.000 0.000))))
(snd-display #__line__ ";poly/ 1: ~A" val)))
- (let ((val (poly/ (vct -15 -32 -3 2) (vct -5 1))))
- (if (or (not (vequal (car val) (vct 3.000 7.000 2.000 0.000)))
- (not (vequal (cadr val) (vct 0.000 0.000 0.000 0.000))))
+ (let ((val (poly/ (float-vector -15 -32 -3 2) (float-vector -5 1))))
+ (if (or (not (vequal (car val) (float-vector 3.000 7.000 2.000 0.000)))
+ (not (vequal (cadr val) (float-vector 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";poly/ 2: ~A" val)))
- (let ((val (poly/ (vct -15 -32 -3 2) (vct 3 1))))
- (if (or (not (vequal (car val) (vct -5.000 -9.000 2.000 0.000)))
- (not (vequal (cadr val) (vct 0.000 0.000 0.000 0.000))))
+ (let ((val (poly/ (float-vector -15 -32 -3 2) (float-vector 3 1))))
+ (if (or (not (vequal (car val) (float-vector -5.000 -9.000 2.000 0.000)))
+ (not (vequal (cadr val) (float-vector 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";poly/ 3: ~A" val)))
- (let ((val (poly/ (vct -15 -32 -3 2) (vct .5 1))))
- (if (or (not (vequal (car val) (vct -30.000 -4.000 2.000 0.000)))
- (not (vequal (cadr val) (vct 0.000 0.000 0.000 0.000))))
+ (let ((val (poly/ (float-vector -15 -32 -3 2) (float-vector .5 1))))
+ (if (or (not (vequal (car val) (float-vector -30.000 -4.000 2.000 0.000)))
+ (not (vequal (cadr val) (float-vector 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";poly/ 4: ~A" val)))
- (let ((val (poly/ (vct -15 -32 -3 2) (vct 3 7 2))))
- (if (or (not (vequal (car val) (vct -5.000 1.000 0.000 0.000)))
- (not (vequal (cadr val) (vct 0.000 0.000 0.000 0.000))))
+ (let ((val (poly/ (float-vector -15 -32 -3 2) (float-vector 3 7 2))))
+ (if (or (not (vequal (car val) (float-vector -5.000 1.000 0.000 0.000)))
+ (not (vequal (cadr val) (float-vector 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";poly/ 5: ~A" val)))
- (let ((val (poly/ (vct -15 -32 -3 2) 2.0)))
- (if (not (vequal (car val) (vct -7.500 -16.000 -1.500 1.000)))
+ (let ((val (poly/ (float-vector -15 -32 -3 2) 2.0)))
+ (if (not (vequal (car val) (float-vector -7.500 -16.000 -1.500 1.000)))
(snd-display #__line__ ";poly/ 6: ~A" val)))
- (let ((val (poly/ (vct -1.0 0.0 0.0 0.0 1.0) (vct 1.0 0.0 1.0))))
- (if (or (not (vequal (car val) (vct -1.0 0.0 1.0 0.0 0.0)))
- (not (vequal (cadr val) (make-vct 5))))
+ (let ((val (poly/ (float-vector -1.0 0.0 0.0 0.0 1.0) (float-vector 1.0 0.0 1.0))))
+ (if (or (not (vequal (car val) (float-vector -1.0 0.0 1.0 0.0 0.0)))
+ (not (vequal (cadr val) (make-float-vector 5))))
(snd-display #__line__ ";poly/ 7: ~A" val)))
- (let ((val (poly/ (vct -1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0) (vct 1.0 0.0 0.0 0.0 1.0))))
- (if (or (not (vequal (car val) (vct -1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0)))
- (not (vequal (cadr val) (make-vct 9))))
+ (let ((val (poly/ (float-vector -1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0) (float-vector 1.0 0.0 0.0 0.0 1.0))))
+ (if (or (not (vequal (car val) (float-vector -1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0)))
+ (not (vequal (cadr val) (make-float-vector 9))))
(snd-display #__line__ ";poly/ 8: ~A" val)))
- (let ((val (poly/ (vct -1.0 0.0 1.0) (vct -1.0 0.0 1.0))))
- (if (or (not (vequal (car val) (vct 1.0 0.0 0.0)))
- (not (vequal (cadr val) (make-vct 3))))
+ (let ((val (poly/ (float-vector -1.0 0.0 1.0) (float-vector -1.0 0.0 1.0))))
+ (if (or (not (vequal (car val) (float-vector 1.0 0.0 0.0)))
+ (not (vequal (cadr val) (make-float-vector 3))))
(snd-display #__line__ ";poly/ 9: ~A" val)))
- (let ((val (poly/ (vct -1.0 0.0 1.0) (vct 2.0 1.0))))
- (if (or (not (vequal (car val) (vct -2.000 1.000 0.000)))
- (not (vequal (cadr val) (vct 3.000 0.000 0.000))))
+ (let ((val (poly/ (float-vector -1.0 0.0 1.0) (float-vector 2.0 1.0))))
+ (if (or (not (vequal (car val) (float-vector -2.000 1.000 0.000)))
+ (not (vequal (cadr val) (float-vector 3.000 0.000 0.000))))
(snd-display #__line__ ";poly/ 10: ~A" val)))
- (let ((val (poly/ (vct 2 1) (vct -1.0 0.0 1.0))))
- (if (or (not (vequal (car val) (vct 0.0)))
- (not (vequal (cadr val) (vct -1.000 0.000 1.000))))
+ (let ((val (poly/ (float-vector 2 1) (float-vector -1.0 0.0 1.0))))
+ (if (or (not (vequal (car val) (float-vector 0.0)))
+ (not (vequal (cadr val) (float-vector -1.000 0.000 1.000))))
(snd-display #__line__ ";poly/ 11: ~A" val)))
- (let ((val (poly/ (vct 1 2 3 0 1) (vct 0 0 0 1))))
- (if (or (not (vequal (car val) (vct 0.000 1.000 0.000 0.000 0.000)))
- (not (vequal (cadr val) (vct 1.000 2.000 3.000 0.000 0.000))))
+ (let ((val (poly/ (float-vector 1 2 3 0 1) (float-vector 0 0 0 1))))
+ (if (or (not (vequal (car val) (float-vector 0.000 1.000 0.000 0.000 0.000)))
+ (not (vequal (cadr val) (float-vector 1.000 2.000 3.000 0.000 0.000))))
(snd-display #__line__ ";poly/ 12: ~A" val)))
(let ((ind (open-sound "1a.snd")))
- (let ((v1 (channel->vct 0 100 ind 0))
- (v2 (channel->vct 0 100 ind 0)))
+ (let ((v1 (channel->float-vector 0 100 ind 0))
+ (v2 (channel->float-vector 0 100 ind 0)))
(let ((vals (car (poly/ v1 v2)))
- (res (make-vct 100)))
- (vct-set! res 0 1.0)
+ (res (make-float-vector 100)))
+ (set! (res 0) 1.0)
(if (not (vequal vals res))
(snd-display #__line__ ";poly1 1a: ~A" vals))))
(close-sound ind))
- (let ((val (poly-derivative (vct 0.5 1.0 2.0 4.0))))
- (if (not (vequal val (vct 1.000 4.000 12.000))) (snd-display #__line__ ";poly-derivative: ~A" val)))
-
- (let ((val (poly-reduce (vct 1 2 3))))
- (if (not (vequal val (vct 1.000 2.000 3.000))) (snd-display #__line__ ";poly-reduce 1: ~A" val)))
- (let ((val (poly-reduce (vct 1 2 3 0 0 0))))
- (if (not (vequal val (vct 1.000 2.000 3.000))) (snd-display #__line__ ";poly-reduce 2: ~A" val)))
- (let ((val (poly-reduce (vct 0 0 0 0 1 0))))
- (if (not (vequal val (vct 0.000 0.000 0.000 0.000 1.000))) (snd-display #__line__ ";poly-reduce 3: ~A" val)))
-
- (let ((vals (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct 2 1))))
- (if (not (vequal vals (vct 2.000 1.000))) (snd-display #__line__ ";poly-gcd 1: ~A" vals)))
- (let ((vals (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct 3 1))))
- (if (not (vequal vals (vct 0.000))) (snd-display #__line__ ";poly-gcd 2: ~A" vals)))
- (let ((vals (poly-gcd (poly-reduce (poly* (vct 2 1) (vct -3 1))) (vct -3 1))))
- (if (not (vequal vals (vct -3.000 1.000))) (snd-display #__line__ ";poly-gcd 2: ~A" vals)))
- (let ((vals (poly-gcd (poly-reduce (poly* (vct 8 1) (poly* (vct 2 1) (vct -3 1)))) (vct -3 1))))
- (if (not (vequal vals (vct -3.000 1.000))) (snd-display #__line__ ";poly-gcd 3: ~A" vals)))
- (let ((vals (poly-gcd (poly-reduce (poly* (vct 8 1) (poly* (vct 2 1) (vct -3 1)))) (poly-reduce (poly* (vct 8 1) (vct -3 1))))))
- (if (not (vequal vals (vct -24.000 5.000 1.000))) (snd-display #__line__ ";poly-gcd 4: ~A" vals)))
- (let ((vals (poly-gcd (vct -1 0 1) (vct 2 -2 -1 1))))
- (if (not (vequal vals (vct 0.000))) (snd-display #__line__ ";poly-gcd 5: ~A" vals)))
- (let ((vals (poly-gcd (vct 2 -2 -1 1) (vct -1 0 1))))
- (if (not (vequal vals (vct 1.000 -1.000))) (snd-display #__line__ ";poly-gcd 6: ~A" vals)))
- (let ((vals (poly-gcd (vct 2 -2 -1 1) (vct -2.5 1))))
- (if (not (vequal vals (vct 0.000))) (snd-display #__line__ ";poly-gcd 7: ~A" vals)))
+ (let ((val (poly-derivative (float-vector 0.5 1.0 2.0 4.0))))
+ (if (not (vequal val (float-vector 1.000 4.000 12.000))) (snd-display #__line__ ";poly-derivative: ~A" val)))
+
+ (let ((val (poly-reduce (float-vector 1 2 3))))
+ (if (not (vequal val (float-vector 1.000 2.000 3.000))) (snd-display #__line__ ";poly-reduce 1: ~A" val)))
+ (let ((val (poly-reduce (float-vector 1 2 3 0 0 0))))
+ (if (not (vequal val (float-vector 1.000 2.000 3.000))) (snd-display #__line__ ";poly-reduce 2: ~A" val)))
+ (let ((val (poly-reduce (float-vector 0 0 0 0 1 0))))
+ (if (not (vequal val (float-vector 0.000 0.000 0.000 0.000 1.000))) (snd-display #__line__ ";poly-reduce 3: ~A" val)))
+
+ (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector 2 1))))
+ (if (not (vequal vals (float-vector 2.000 1.000))) (snd-display #__line__ ";poly-gcd 1: ~A" vals)))
+ (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector 3 1))))
+ (if (not (vequal vals (float-vector 0.000))) (snd-display #__line__ ";poly-gcd 2: ~A" vals)))
+ (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 2 1) (float-vector -3 1))) (float-vector -3 1))))
+ (if (not (vequal vals (float-vector -3.000 1.000))) (snd-display #__line__ ";poly-gcd 2: ~A" vals)))
+ (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 8 1) (poly* (float-vector 2 1) (float-vector -3 1)))) (float-vector -3 1))))
+ (if (not (vequal vals (float-vector -3.000 1.000))) (snd-display #__line__ ";poly-gcd 3: ~A" vals)))
+ (let ((vals (poly-gcd (poly-reduce (poly* (float-vector 8 1) (poly* (float-vector 2 1) (float-vector -3 1)))) (poly-reduce (poly* (float-vector 8 1) (float-vector -3 1))))))
+ (if (not (vequal vals (float-vector -24.000 5.000 1.000))) (snd-display #__line__ ";poly-gcd 4: ~A" vals)))
+ (let ((vals (poly-gcd (float-vector -1 0 1) (float-vector 2 -2 -1 1))))
+ (if (not (vequal vals (float-vector 0.000))) (snd-display #__line__ ";poly-gcd 5: ~A" vals)))
+ (let ((vals (poly-gcd (float-vector 2 -2 -1 1) (float-vector -1 0 1))))
+ (if (not (vequal vals (float-vector 1.000 -1.000))) (snd-display #__line__ ";poly-gcd 6: ~A" vals)))
+ (let ((vals (poly-gcd (float-vector 2 -2 -1 1) (float-vector -2.5 1))))
+ (if (not (vequal vals (float-vector 0.000))) (snd-display #__line__ ";poly-gcd 7: ~A" vals)))
(poly-roots-tests)
@@ -17702,26 +12655,26 @@ EDITS: 2
(if (fneq val 0.0) (snd-display #__line__ ";poly-resultant 2: ~A" val)))
(let ((val (poly-as-vector-resultant (vector -1 0 1) (vector 2 1))))
(if (fneq val 3.0) (snd-display #__line__ ";poly-resultant 3: ~A" val)))
- (let ((val (poly-resultant (vct -1 0 1) (vct 1 -2 1))))
+ (let ((val (poly-resultant (float-vector -1 0 1) (float-vector 1 -2 1))))
(if (fneq val 0.0) (snd-display #__line__ ";poly-resultant 0: ~A" val)))
(let ((val (poly-as-vector-discriminant (vector -1 0 1))))
(if (fneq val -4.0) (snd-display #__line__ ";poly-discriminant 0: ~A" val)))
(let ((val (poly-as-vector-discriminant (vector 1 -2 1))))
(if (fneq val 0.0) (snd-display #__line__ ";poly-discriminant 1: ~A" val)))
- (let ((val (poly-discriminant (poly-reduce (poly* (poly* (vct -1 1) (vct -1 1)) (vct 3 1))))))
+ (let ((val (poly-discriminant (poly-reduce (poly* (poly* (float-vector -1 1) (float-vector -1 1)) (float-vector 3 1))))))
(if (fneq val 0.0) (snd-display #__line__ ";poly-discriminant 2: ~A" val)))
- (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct -1 1) (vct -1 1)) (vct 3 1)) (vct 2 1))))))
+ (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector -1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 2 1))))))
(if (fneq val 0.0) (snd-display #__line__ ";poly-discriminant 3: ~A" val)))
- (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct 1 1) (vct -1 1)) (vct 3 1)) (vct 2 1))))))
+ (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector 1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 2 1))))))
(if (fneq val 2304.0) (snd-display #__line__ ";poly-discriminant 4: ~A" val)))
- (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (vct 1 1) (vct -1 1)) (vct 3 1)) (vct 3 1))))))
+ (let ((val (poly-discriminant (poly-reduce (poly* (poly* (poly* (float-vector 1 1) (float-vector -1 1)) (float-vector 3 1)) (float-vector 3 1))))))
(if (fneq val 0.0) (snd-display #__line__ ";poly-discriminant 5: ~A" val)))
- (let ((v0 (make-vct 10)))
- (do ((i 0 (+ 1 i))) ((= i 10))
- (vct-set! v0 i i))
+ (let ((v0 (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (set! (v0 i) i))
(if (fneq (array-interp v0 3.5) 3.5) (snd-display #__line__ ";array-interp: ~F?" (array-interp v0 3.5)))
(if (fneq (array-interp v0 13.5) 3.5) (snd-display #__line__ ";array-interp(13.5): ~F?" (array-interp v0 13.5)))
(if (fneq (array-interp v0 -6.5) 3.5) (snd-display #__line__ ";array-interp(-6.5): ~F?" (array-interp v0 -6.5)))
@@ -17743,9 +12696,9 @@ EDITS: 2
(if (> diff .00001) (snd-display #__line__ ";array-interp-sound-diff: ~A" diff)))
(close-sound ind))
- (let ((v0 (make-vct 10)))
- (do ((i 0 (+ 1 i))) ((= i 10))
- (vct-set! v0 i i))
+ (let ((v0 (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (set! (v0 i) i))
(let ((val (mus-interpolate mus-interp-linear 1.5 v0)))
(if (fneq val 1.5) (snd-display #__line__ ";mus-interpolate linear: ~A" val))
(set! val (mus-interpolate mus-interp-all-pass 1.5 v0))
@@ -17758,7 +12711,7 @@ EDITS: 2
(if (fneq val 1.5) (snd-display #__line__ ";mus-interpolate bezier: ~A" val))
(set! val (mus-interpolate mus-interp-lagrange 1.5 v0))
(if (fneq val 1.5) (snd-display #__line__ ";mus-interpolate lagrange: ~A" val))
- (do ((i 0 (+ 1 i))) ((= i 10)) (vct-set! v0 i (sin (* pi (/ i 5)))))
+ (do ((i 0 (+ i 1))) ((= i 10)) (set! (v0 i) (sin (* pi (/ i 5)))))
(set! val (mus-interpolate mus-interp-linear 1.5 v0))
(if (fneq val 0.7694) (snd-display #__line__ ";mus-interpolate linear sin: ~A" val))
(set! val (mus-interpolate mus-interp-all-pass 1.5 v0))
@@ -17772,30 +12725,30 @@ EDITS: 2
(set! val (mus-interpolate mus-interp-lagrange 1.5 v0))
(if (fneq val 0.7975) (snd-display #__line__ ";mus-interpolate lagrange sin: ~A" val))))
- (let ((tag (catch #t (lambda () (mus-interpolate 1234 1.0 (make-vct 3))) (lambda args (car args)))))
+ (let ((tag (catch #t (lambda () (mus-interpolate 1234 1.0 (make-float-vector 3))) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
(snd-display #__line__ ";mus-interpolate 1234: ~A" tag)))
- (let ((tag (catch #t (lambda () (mus-interpolate mus-interp-linear 1.0 (make-vct 3) -1)) (lambda args (car args)))))
+ (let ((tag (catch #t (lambda () (mus-interpolate mus-interp-linear 1.0 (make-float-vector 3) -1)) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
(snd-display #__line__ ";mus-interpolate size -1: ~A" tag)))
(let ((gen (make-delay 3))
(gen2 (make-delay 3))
(gen1 (make-delay 4 :initial-contents '(1.0 0.5 0.25 0.0)))
- (gen3 (make-delay 4 :initial-contents (vct 1.0 0.5 0.25 0.0)))
- (v0 (make-vct 10))
- (v1 (make-vct 10)))
+ (gen3 (make-delay 4 :initial-contents (float-vector 1.0 0.5 0.25 0.0)))
+ (v0 (make-float-vector 10))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"delay"
- "delay line[3, step]: [0.000 0.000 0.000]")
- (do ((i 0 (+ 1 i)))
+ "delay line[3, step]: [0 0 0]")
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (delay gen i)))
- (vct-map! v1 (let ((i 0)) (lambda () (let ((val (if (delay? gen2) (delay gen2 i) -1.0))) (set! i (+ 1 i)) val))))
+ (set! (v0 i) (delay gen i)))
+ (let ((k 0)) (fill-float-vector v1 (let ((val (if (delay? gen2) (delay gen2 k) -1.0))) (set! k (+ k 1)) val)))
(if (not (vequal v1 v0)) (snd-display #__line__ ";map delay: ~A ~A" v0 v1))
(if (not (delay? gen)) (snd-display #__line__ ";~A not delay?" gen))
(if (not (= (mus-length gen) 3)) (snd-display #__line__ ";delay length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.0) (fneq (vct-ref v0 4) 1.0) (fneq (vct-ref v0 8) 5.0))
+ (if (or (fneq (v0 1) 0.0) (fneq (v0 4) 1.0) (fneq (v0 8) 5.0))
(snd-display #__line__ ";delay output: ~A" v0))
(if (or (fneq (delay gen1) 1.0)
(fneq (delay gen1) 0.5)
@@ -17808,7 +12761,7 @@ EDITS: 2
(fneq (delay gen3) 0.25)
(fneq (delay gen3) 0.0)
(fneq (delay gen3) 0.0))
- (snd-display #__line__ ";delay with vct initial-contents confused"))
+ (snd-display #__line__ ";delay with float-vector initial-contents confused"))
(let ((var (catch #t (lambda () (make-delay :size #f)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
(snd-display #__line__ ";make-delay bad size #f: ~A" var)))
@@ -17831,14 +12784,14 @@ EDITS: 2
(delay gen 1.0)
(delay gen 0.0)
(delay gen 0.5)
- (let ((data (vct-copy (mus-data gen))))
- (vct-set! (mus-data gen) 0 0.3)
- (if (fneq (vct-ref (mus-data gen) 0) 0.3)
- (snd-display #__line__ ";delay data 0: ~A" (vct-ref (mus-data gen) 0)))
- (vct-set! data 0 .75)
+ (let ((data (copy (mus-data gen))))
+ (float-vector-set! (mus-data gen) 0 0.3)
+ (if (fneq ((mus-data gen) 0) 0.3)
+ (snd-display #__line__ ";delay data 0: ~A" ((mus-data gen) 0)))
+ (set! (data 0) .75)
(set! (mus-data gen) data)
- (if (fneq (vct-ref (mus-data gen) 0) 0.75)
- (snd-display #__line__ ";delay set data 0: ~A" (vct-ref (mus-data gen) 0)))
+ (if (fneq ((mus-data gen) 0) 0.75)
+ (snd-display #__line__ ";delay set data 0: ~A" ((mus-data gen) 0)))
(delay gen 0.0)
(delay gen 0.0)
(let ((val (delay gen 0.0)))
@@ -17847,18 +12800,18 @@ EDITS: 2
(if (mus-data (make-oscil))
(snd-display #__line__ ";mus-data osc: ~A" (mus-data (make-oscil)))))
- (let* ((del (make-delay 5 :max-size 8)))
+ (let ((del (make-delay 5 :max-size 8)))
(delay del 1.0)
- (do ((i 0 (+ 1 i))) ((= i 4)) (delay del 0.0))
- (let ((v0 (make-vct 5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1))) ((= i 4)) (delay del 0.0))
+ (let ((v0 (make-float-vector 5)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! v0 i (delay del 0.0 0.4)))
- (if (not (vequal v0 (vct 0.600 0.400 0.000 0.000 0.000)))
+ (set! (v0 i) (delay del 0.0 0.4)))
+ (if (not (vequal v0 (float-vector 0.600 0.400 0.000 0.000 0.000)))
(snd-display #__line__ ";zdelay: ~A" v0))
(delay del 1.0)
(delay del 0.0 0.4)
- (if (not (string=? (mus-describe del) "delay line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000]"))
+ (if (not (string=? (mus-describe del) "delay line[5,8, linear]: [0 0 1 0 0]"))
(snd-display #__line__ ";describe zdelay: ~A" (mus-describe del)))))
(let ((tag (catch #t (lambda ()
(let ((gen (make-oscil)))
@@ -17869,71 +12822,69 @@ EDITS: 2
(let ((dly (make-delay 3))
(flt (make-one-zero .5 .4))
- (v (make-vct 20))
+ (v (make-float-vector 20))
(inval 1.0))
- (vct-map! v (lambda ()
- (let ((res (delay dly (+ inval (* (one-zero flt (tap dly)) .6)))))
- (set! inval 0.0)
- res)))
- (if (not (vequal v (vct 0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
+ (fill-float-vector v (let ((res (delay dly (+ inval (* (one-zero flt (tap dly)) .6)))))
+ (set! inval 0.0)
+ res))
+ (if (not (vequal v (float-vector 0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
(snd-display #__line__ ";tap with low pass: ~A" v)))
(let ((dly (make-delay 3))
- (v (make-vct 20))
+ (v (make-float-vector 20))
(inval 1.0))
- (vct-map! v (lambda ()
- (let ((res (delay dly (+ inval (tap dly)))))
- (set! inval 0.0)
- res)))
- (if (not (vequal v (vct 0.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0)))
+ (fill-float-vector v (let ((res (delay dly (+ inval (tap dly)))))
+ (set! inval 0.0)
+ res))
+ (if (not (vequal v (float-vector 0.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 0.0)))
(snd-display #__line__ ";simple tap: ~A" v)))
(let ((dly (make-delay 6))
- (v (make-vct 20))
+ (v (make-float-vector 20))
(inval 1.0))
- (vct-map! v (lambda ()
- (let ((res (delay dly (+ inval (tap dly -2.0)))))
- (set! inval 0.0)
- res)))
- (set! (print-length) (max 20 (print-length)))
- (if (not (vequal v (vct 0.0 0.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0)))
+ (if (not (tap? dly)) (snd-display #__line__ ";tap?: ~A" (tap? dly)))
+ (fill-float-vector v (let ((res (delay dly (+ inval (tap dly -2.0)))))
+ (set! inval 0.0)
+ res))
+ (set! *print-length* (max 20 *print-length*))
+ (if (not (vequal v (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0)))
(snd-display #__line__ ";tap back 2: ~A" v)))
(let ((dly (make-delay 3))
(flt (make-one-zero .5 .4))
- (v (make-vct 20))
+ (v (make-float-vector 20))
(inval 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! v i (let ((res (delay dly (+ inval (* (one-zero flt (tap dly)) .6)))))
- (set! inval 0.0)
- res)))
- (if (not (vequal v (vct 0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
+ (set! (v i) (let ((res (delay dly (+ inval (* (one-zero flt (tap dly)) .6)))))
+ (set! inval 0.0)
+ res)))
+ (if (not (vequal v (float-vector 0.0 0.0 0.0 1.0 0.0 0.0 0.300 0.240 0.0 0.090 0.144 0.058 0.027 0.065 0.052 0.022 0.026 0.031 0.019 0.013)))
(snd-display #__line__ ";tap with low pass: ~A" v)))
(let ((dly (make-delay 3 :initial-element 32.0)))
- (if (not (vct? (mus-data dly)))
- (snd-display #__line__ ";delay data not vct?")
- (if (not (= (vct-length (mus-data dly)) 3))
- (snd-display #__line__ ";delay data len not 3: ~A (~A)" (vct-length (mus-data dly)) (mus-data dly))
- (if (fneq (vct-ref (mus-data dly) 1) 32.0) (snd-display #__line__ ";delay [1] 32: ~A" (vct-ref (mus-data dly) 1)))))
+ (if (not (float-vector? (mus-data dly)))
+ (snd-display #__line__ ";delay data not float-vector?")
+ (if (not (= (length (mus-data dly)) 3))
+ (snd-display #__line__ ";delay data len not 3: ~A (~A)" (length (mus-data dly)) (mus-data dly))
+ (if (fneq ((mus-data dly) 1) 32.0) (snd-display #__line__ ";delay [1] 32: ~A" ((mus-data dly) 1)))))
(let ((tag (catch #t (lambda () (set! (mus-length dly) -1)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";len to -1 -> ~A" tag)))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";len to -1 -> ~A" tag)))
(let ((tag (catch #t (lambda () (set! (mus-length dly) 0)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";len to 0 -> ~A" tag)))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";len to 0 -> ~A" tag)))
(let ((tag (catch #t (lambda () (set! (mus-length dly) 100)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";len to 100 -> ~A" tag)))
- (let ((tag (catch #t (lambda () (set! (vct-ref (mus-data dly) 100) .1)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";data 100 to .1 -> ~A" tag)))
- (let ((data (make-vct 32 1.0)))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";len to 100 -> ~A" tag)))
+ (let ((tag (catch #t (lambda () (set! ((mus-data dly) 100) .1)) (lambda args (car args)))))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";data 100 to .1 -> ~A" tag)))
+ (let ((data (make-float-vector 32 1.0)))
(set! (mus-data dly) data)
- (if (not (vct? (mus-data dly))) (snd-display #__line__ ";set delay data not vct?"))
- (if (fneq (vct-ref (mus-data dly) 1) 1.0) (snd-display #__line__ ";set delay [1] 1: ~A" (vct-ref (mus-data dly) 1)))
- (if (not (= (vct-length (mus-data dly)) 32)) (snd-display #__line__ ";set delay data len(32): ~A" (vct-length (mus-data dly))))
+ (if (not (float-vector? (mus-data dly))) (snd-display #__line__ ";set delay data not float-vector?"))
+ (if (fneq ((mus-data dly) 1) 1.0) (snd-display #__line__ ";set delay [1] 1: ~A" ((mus-data dly) 1)))
+ (if (not (= (length (mus-data dly)) 32)) (snd-display #__line__ ";set delay data len(32): ~A" (length (mus-data dly))))
(let ((tag (catch #t (lambda () (set! (mus-length dly) 100)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";set len to 100 -> ~A" tag)))
- (let ((tag (catch #t (lambda () (set! (vct-ref (mus-data dly) 100) .1)) (lambda args (car args)))))
- (if (not (equal? tag 'out-of-range)) (snd-display #__line__ ";set data 100 to .1 -> ~A" tag)))))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";set len to 100 -> ~A" tag)))
+ (let ((tag (catch #t (lambda () (set! ((mus-data dly) 100) .1)) (lambda args (car args)))))
+ (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";set data 100 to .1 -> ~A" tag)))))
(let ((d1 (make-delay 4))
(d2 (make-delay 4 :max-size 5 :type mus-interp-linear))
@@ -17942,13 +12893,13 @@ EDITS: 2
(d5 (make-delay 4 :max-size 4 :type mus-interp-lagrange))
(d6 (make-delay 4 :max-size 4 :type mus-interp-hermite))
(d7 (make-delay 4 :max-size 4 :type mus-interp-linear))
- (v1 (make-vct 20))
- (v2 (make-vct 20))
- (v3 (make-vct 20))
- (v4 (make-vct 20))
- (v5 (make-vct 20))
- (v6 (make-vct 20))
- (v7 (make-vct 20)))
+ (v1 (make-float-vector 20))
+ (v2 (make-float-vector 20))
+ (v3 (make-float-vector 20))
+ (v4 (make-float-vector 20))
+ (v5 (make-float-vector 20))
+ (v6 (make-float-vector 20))
+ (v7 (make-float-vector 20)))
(if (not (= (mus-interp-type d1) mus-interp-none)) (snd-display #__line__ ";d1 interp type: ~A" (mus-interp-type d1)))
(if (not (= (mus-interp-type d2) mus-interp-linear)) (snd-display #__line__ ";d2 interp type: ~A" (mus-interp-type d2)))
(if (not (= (mus-interp-type d3) mus-interp-all-pass)) (snd-display #__line__ ";d3 interp type: ~A" (mus-interp-type d3)))
@@ -17956,13 +12907,13 @@ EDITS: 2
(if (not (= (mus-interp-type d5) mus-interp-lagrange)) (snd-display #__line__ ";d5 interp type: ~A" (mus-interp-type d5)))
(if (not (= (mus-interp-type d6) mus-interp-hermite)) (snd-display #__line__ ";d6 interp type: ~A" (mus-interp-type d6)))
(if (not (= (mus-interp-type d7) mus-interp-linear)) (snd-display #__line__ ";d7 interp type: ~A" (mus-interp-type d7)))
- (vct-set! v1 0 (delay d1 1.0))
- (vct-set! v2 0 (delay d2 1.0))
- (vct-set! v3 0 (delay d3 1.0))
- (vct-set! v4 0 (delay d4 1.0))
- (vct-set! v5 0 (delay d5 1.0))
- (vct-set! v6 0 (delay d6 1.0))
- (vct-set! v7 0 (delay d7 1.0))
+ (set! (v1 0) (delay d1 1.0))
+ (set! (v2 0) (delay d2 1.0))
+ (set! (v3 0) (delay d3 1.0))
+ (set! (v4 0) (delay d4 1.0))
+ (set! (v5 0) (delay d5 1.0))
+ (set! (v6 0) (delay d6 1.0))
+ (set! (v7 0) (delay d7 1.0))
(delay-tick d1 0.0)
(delay-tick d2 0.0)
(delay-tick d3 0.0)
@@ -17970,69 +12921,69 @@ EDITS: 2
(delay-tick d5 0.0)
(delay-tick d6 0.0)
(delay-tick d7 0.0)
- (do ((i 1 (+ 1 i))
+ (do ((i 1 (+ i 1))
(j -0.2 (- j 0.2)))
((= i 20))
- (vct-set! v1 i (tap d1 j))
- (vct-set! v2 i (tap d2 j))
- (vct-set! v3 i (tap d3 j))
- (vct-set! v4 i (tap d4 j))
- (vct-set! v5 i (tap d5 j))
- (vct-set! v6 i (tap d6 j))
- (vct-set! v7 i (tap d7 j)))
- (set! (print-length) (max 20 (print-length)))
- (if (and (not (vequal v1 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0)))
- (not (vequal v1 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
+ (set! (v1 i) (tap d1 j))
+ (set! (v2 i) (tap d2 j))
+ (set! (v3 i) (tap d3 j))
+ (set! (v4 i) (tap d4 j))
+ (set! (v5 i) (tap d5 j))
+ (set! (v6 i) (tap d6 j))
+ (set! (v7 i) (tap d7 j)))
+ (set! *print-length* (max 20 *print-length*))
+ (if (and (not (vequal v1 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0)))
+ (not (vequal v1 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
(snd-display #__line__ ";delay interp none (1): ~A" v1))
- (if (not (vequal v2 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (vequal v2 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
(snd-display #__line__ ";delay interp linear (2): ~A" v2))
- (if (not (vequal v3 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.600 0.160 0.168 -0.168 0.334 0.199 0.520 0.696 -0.696 0.557 -0.334 0.134 -0.027)))
+ (if (not (vequal v3 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.600 0.160 0.168 -0.168 0.334 0.199 0.520 0.696 -0.696 0.557 -0.334 0.134 -0.027)))
(snd-display #__line__ ";delay interp all-pass (3): ~A" v3))
- (if (and (not (vequal v4 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0)))
- (not (vequal v4 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
+ (if (and (not (vequal v4 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0)))
+ (not (vequal v4 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 0.0))))
(snd-display #__line__ ";delay interp none (4): ~A" v4))
- (if (not (vequal v5 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360 0.000 -0.080 -0.120 -0.120 -0.080)))
+ (if (not (vequal v5 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360 0.000 -0.080 -0.120 -0.120 -0.080)))
(snd-display #__line__ ";delay interp lagrange (5): ~A" v5))
- (if (not (vequal v6 (vct 0.0 -0.016 -0.048 -0.072 -0.064 0.0 0.168 0.424 0.696 0.912 1.0 0.912 0.696 0.424 0.168 0.0 -0.064 -0.072 -0.048 -0.016)))
+ (if (not (vequal v6 (float-vector 0.0 -0.016 -0.048 -0.072 -0.064 0.0 0.168 0.424 0.696 0.912 1.0 0.912 0.696 0.424 0.168 0.0 -0.064 -0.072 -0.048 -0.016)))
(snd-display #__line__ ";delay interp hermite (6): ~A" v6))
- (if (not (vequal v7 (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
+ (if (not (vequal v7 (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.200 0.400 0.600 0.800 1.0 0.800 0.600 0.400 0.200 0.0 0.0 0.0 0.0 0.0)))
(snd-display #__line__ ";delay interp linear (7): ~A" v7)))
(let ((dly1 (make-delay :size 2 :max-size 3))
- (data (make-vct 5))
+ (data (make-float-vector 5))
(impulse 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! data i (delay dly1 impulse 0.4)) ; longer line
+ (set! (data i) (delay dly1 impulse 0.4)) ; longer line
(set! impulse 0.0))
- (if (not (vequal data (vct 0.0 0.0 0.6 0.4 0.0)))
+ (if (not (vequal data (float-vector 0.0 0.0 0.6 0.4 0.0)))
(snd-display #__line__ ";delay size 2, max 3, off 0.4: ~A" data))
(set! dly1 (make-delay :size 2 :max-size 3))
(set! impulse 1.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! data i (delay dly1 impulse -0.4)) ; shorter line
+ (set! (data i) (delay dly1 impulse -0.4)) ; shorter line
(set! impulse 0.0))
- (if (not (vequal data (vct 0.0 0.4 0.6 0.0 0.0)))
+ (if (not (vequal data (float-vector 0.0 0.4 0.6 0.0 0.0)))
(snd-display #__line__ ";delay size 2, max 3, off -0.4: ~A" data))
(set! dly1 (make-delay :size 1 :max-size 2))
(set! impulse 1.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! data i (delay dly1 impulse 0.4))
+ (set! (data i) (delay dly1 impulse 0.4))
(set! impulse 0.0))
- (if (not (vequal data (vct 0.0 0.6 0.4 0.0 0.0)))
+ (if (not (vequal data (float-vector 0.0 0.6 0.4 0.0 0.0)))
(snd-display #__line__ ";delay size 1, max 2, off 0.4: ~A" data))
(set! dly1 (make-delay :size 0 :max-size 1))
(set! impulse 1.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! data i (delay dly1 impulse 0.4))
+ (set! (data i) (delay dly1 impulse 0.4))
(set! impulse 0.0))
- (if (not (vequal data (vct 0.6 0.0 0.0 0.0 0.0)))
+ (if (not (vequal data (float-vector 0.6 0.4 0.0 0.0 0.0)))
(snd-display #__line__ ";delay size 0, max 1, off 0.4: ~A" data))
(set! dly1 (make-delay :size 0 :max-size 1))
@@ -18041,72 +12992,72 @@ EDITS: 2
(set! dly1 (make-delay :size 0 :max-size 1))
(set! impulse 1.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! data i (delay dly1 impulse -0.4)) ; shorter than 0? should this be an error?
+ (set! (data i) (delay dly1 impulse -0.4)) ; shorter than 0? should this be an error?
(set! impulse 0.0))
- (if (not (vequal data (vct 1.4 0.0 0.0 0.0 0.0))) ; hmmm -- they're asking for undefined values here
+ (if (not (vequal data (float-vector 1.4 -0.4 0.0 0.0 0.0))) ; hmmm -- they're asking for undefined values here
(snd-display #__line__ ";delay size 0, max 1, off -0.4: ~A" data))
(set! dly1 (make-delay 0))
(set! impulse 1.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! data i (delay dly1 impulse))
+ (set! (data i) (delay dly1 impulse))
(set! impulse 0.0))
- (if (not (vequal data (vct 1 0 0 0 0)))
+ (if (not (vequal data (float-vector 1 0 0 0 0)))
(snd-display #__line__ ";delay size 0: ~A" data))
-
- (if (fneq (delay dly1 0.5) 0.5)
- (snd-display #__line__ ";delay size 0 0.5: ~A" (delay dly 0.5)))
+ (let ((x (delay dly1 0.5)))
+ (if (fneq x 0.5)
+ (snd-display #__line__ ";delay size 0 0.5: ~A" x)))
)
(let ((gen (make-delay :size 0 :max-size 100))
- (v (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (delay gen 0.5 i)))
- (if (not (vequal v (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (set! (v i) (delay gen 0.5 i)))
+ (if (not (vequal v (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";delay 0 -> 100: ~A" v))
(do ((i 9 (- i 1)))
((< i 0))
- (vct-set! v i (delay gen 0.5 i)))
- (if (not (vequal v (vct 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.000)))
+ (set! (v i) (delay gen 0.5 i)))
+ (if (not (vequal v (float-vector 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500 0.500)))
(snd-display #__line__ ";delay 100 -> 0: ~A" v))
(mus-reset gen)
- (if (not (vequal (mus-data gen) (make-vct 100 0.0)))
- (snd-display #__line__ ";after reset mus-data delay peak: ~A" (vct-peak (mus-data gen))))
- (do ((i 0 (+ 1 i)))
+ (if (not (vequal (mus-data gen) (make-float-vector 100 0.0)))
+ (snd-display #__line__ ";after reset mus-data delay peak: ~A" (float-vector-peak (mus-data gen))))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (delay gen (if (odd? i) 1.0 0.0) (* i .1))))
- (if (not (vequal v (vct 0.000 0.900 0.000 0.700 0.000 0.500 0.000 0.300 0.000 0.100)))
+ (set! (v i) (delay gen (if (odd? i) 1.0 0.0) (* i .1))))
+ (if (not (vequal v (float-vector 0.000 0.900 0.000 0.700 0.000 0.500 0.000 0.300 0.000 0.100)))
(snd-display #__line__ ";delay 0 -> 100 .1: ~A (~A)" v gen))
(mus-reset gen)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (delay gen (if (odd? i) 1.0 0.0) (+ 1.0 (* i .1)))))
- (if (not (vequal v (vct 0.000 0.000 0.800 0.300 0.600 0.500 0.400 0.700 0.200 0.900)))
+ (set! (v i) (delay gen (if (odd? i) 1.0 0.0) (+ 1.0 (* i .1)))))
+ (if (not (vequal v (float-vector 0.000 0.000 0.800 0.300 0.600 0.500 0.400 0.700 0.200 0.900)))
(snd-display #__line__ ";delay 0 -> 100 1.1: ~A" v)))
(let ((gen (make-all-pass .4 .6 3))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-all-pass .4 .6 3))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"all-pass"
- "all-pass feedback: 0.400, feedforward: 0.600, line[3, step]:[0.000 0.000 0.000]")
- (do ((i 0 (+ 1 i)))
+ "all-pass feedback: 0.400, feedforward: 0.600, line[3, step]:[0 0 0]")
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (all-pass gen 1.0)))
- (vct-map! v1 (lambda () (if (all-pass? gen1) (all-pass gen1 1.0) -1.0)))
+ (set! (v0 i) (all-pass gen 1.0)))
+ (fill-float-vector v1 (if (all-pass? gen1) (all-pass gen1 1.0) -1.0))
(if (not (vequal v1 v0)) (snd-display #__line__ ";map all-pass: ~A ~A" v0 v1))
(if (not (all-pass? gen)) (snd-display #__line__ ";~A not all-pass?" gen))
(if (not (= (mus-length gen) 3)) (snd-display #__line__ ";all-pass length: ~D?" (mus-length gen)))
(if (not (= (mus-order gen) 3)) (snd-display #__line__ ";all-pass order: ~D?" (mus-order gen)))
(if (fneq (mus-feedback gen) .4) (snd-display #__line__ ";all-pass feedback: ~F?" (mus-feedback gen)))
(if (fneq (mus-feedforward gen) .6) (snd-display #__line__ ";all-pass feedforward: ~F?" (mus-feedforward gen)))
- (if (or (fneq (vct-ref v0 1) 0.6) (fneq (vct-ref v0 4) 1.84) (fneq (vct-ref v0 8) 2.336))
+ (if (or (fneq (v0 1) 0.6) (fneq (v0 4) 1.84) (fneq (v0 8) 2.336))
(snd-display #__line__ ";all-pass output: ~A" v0))
(set! (mus-feedback gen) 0.5)
(if (fneq (mus-feedback gen) .5) (snd-display #__line__ ";all-pass set-feedback: ~F?" (mus-feedback gen)))
@@ -18130,21 +13081,21 @@ EDITS: 2
(snd-display #__line__ ";make-all-pass bad size error message: ~A" err)))
(let ((gen (make-moving-average 4))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-moving-average 4))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"moving-average"
- "moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]")
- (do ((i 0 (+ 1 i)))
+ "moving-average 0.000, line[4]:[0 0 0 0]")
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (moving-average gen 1.0)))
- (vct-map! v1 (lambda () (if (moving-average? gen1) (moving-average gen1 1.0) -1.0)))
+ (set! (v0 i) (moving-average gen 1.0)))
+ (fill-float-vector v1 (if (moving-average? gen1) (moving-average gen1 1.0) -1.0))
(if (not (vequal v1 v0)) (snd-display #__line__ ";map average: ~A ~A" v0 v1))
(if (not (moving-average? gen)) (snd-display #__line__ ";~A not average?" gen))
(if (not (= (mus-length gen) 4)) (snd-display #__line__ ";average length: ~D?" (mus-length gen)))
(if (not (= (mus-order gen) 4)) (snd-display #__line__ ";average order: ~D?" (mus-order gen)))
- (if (or (fneq (vct-ref v0 1) 0.5) (fneq (vct-ref v0 4) 1.0) (fneq (vct-ref v0 8) 1.0))
+ (if (or (fneq (v0 1) 0.5) (fneq (v0 4) 1.0) (fneq (v0 8) 1.0))
(snd-display #__line__ ";average output: ~A" v0)))
(let* ((gen (make-moving-average 8))
@@ -18156,7 +13107,7 @@ EDITS: 2
(if (fneq val 0.25) (snd-display #__line__ ";average 2: ~A" val))
(set! val (moving-average gen 0.5))
(if (fneq val 0.3125) (snd-display #__line__ ";average 2: ~A" val))
- (do ((i 0 (+ 1 i))) ((= i 5)) (set! val (moving-average gen 0.0)))
+ (do ((i 0 (+ i 1))) ((= i 5)) (set! val (moving-average gen 0.0)))
(if (fneq val 0.3125) (snd-display #__line__ ";average 6: ~A" val))
(set! val (moving-average gen 0.0))
(if (fneq val 0.1875) (snd-display #__line__ ";average 7: ~A" val))
@@ -18173,7 +13124,7 @@ EDITS: 2
(if (fneq val 1.0) (snd-display #__line__ ";average initial-contents: ~A" val)))
(test-gen-equal (let ((d1 (make-moving-average 3 :initial-contents '(0.7 0.5 3)))) (moving-average d1 1.0) d1)
- (let ((d2 (make-moving-average 3 :initial-contents (vct 0.7 0.5 3)))) (moving-average d2 1.0) d2)
+ (let ((d2 (make-moving-average 3 :initial-contents (float-vector 0.7 0.5 3)))) (moving-average d2 1.0) d2)
(let ((d3 (make-moving-average 4 :initial-contents '(0.7 0.5 0.1 4)))) (moving-average d3 1.0) d3))
(test-gen-equal (make-moving-average 3 :initial-element 1.0)
(make-moving-average 3 :initial-element 1.0)
@@ -18187,24 +13138,144 @@ EDITS: 2
(let ((err (catch #t (lambda () (make-moving-average :size -1)) (lambda args args))))
(if (not (eq? (car err) 'out-of-range))
(snd-display #__line__ ";make-average bad size error message: ~A" err)))
-
+ (let ((err (catch #t (lambda () (make-moving-average :size 0)) (lambda args args))))
+ (if (not (eq? (car err) 'out-of-range))
+ (snd-display #__line__ ";make-average size==0 error message: ~A" err)))
+
+ (let ((gen (make-moving-max 4))
+ (v0 (make-float-vector 10))
+ (gen1 (make-moving-max 4))
+ (v1 (make-float-vector 10)))
+ (print-and-check gen
+ "moving-max"
+ "moving-max 0.000, line[4]:[0 0 0 0]")
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v0 i) (moving-max gen 1.0)))
+ (fill-float-vector v1 (if (moving-max? gen1) (moving-max gen1 1.0) -1.0))
+ (if (not (vequal v1 v0)) (snd-display #__line__ ";map max: ~A ~A" v0 v1))
+ (if (not (moving-max? gen)) (snd-display #__line__ ";~A not max?" gen))
+ (if (not (= (mus-length gen) 4)) (snd-display #__line__ ";max length: ~D?" (mus-length gen)))
+ (if (not (= (mus-order gen) 4)) (snd-display #__line__ ";max order: ~D?" (mus-order gen)))
+ (if (or (fneq (v0 1) 1.0) (fneq (v0 4) 1.0) (fneq (v0 8) 1.0))
+ (snd-display #__line__ ";max output: ~A" v0)))
+
+ (let* ((gen (make-moving-max 8))
+ (val (moving-max gen)))
+ (if (fneq val 0.0) (snd-display #__line__ ";empty max: ~A" val))
+ (set! val (moving-max gen 1.0))
+ (if (fneq val 1.0) (snd-display #__line__ ";max 1: ~A" val))
+ (set! val (moving-max gen -0.5))
+ (if (fneq val 1.0) (snd-display #__line__ ";max 2: ~A" val))
+ (set! val (moving-max gen -1.5))
+ (if (fneq val 1.5) (snd-display #__line__ ";max 2: ~A" val))
+ (do ((i 0 (+ i 1))) ((= i 5)) (set! val (moving-max gen 0.0)))
+ (if (fneq val 1.5) (snd-display #__line__ ";max 6: ~A" val))
+ (set! val (moving-max gen 0.0))
+ (if (fneq val 1.5) (snd-display #__line__ ";max 7: ~A" val))
+ (set! val (moving-max gen 0.0))
+ (if (fneq val 1.5) (snd-display #__line__ ";max 8: ~A" val))
+ (set! val (moving-max gen 0.0))
+ (if (fneq val 0.0) (snd-display #__line__ ";max 9: ~A" val))
+ )
+ (let* ((gen (make-moving-max 10 :initial-element .5))
+ (val (moving-max gen 0.5)))
+ (if (fneq val 0.5) (snd-display #__line__ ";max initial-element: ~A" val)))
+ (let* ((gen (make-moving-max 3 :initial-contents '(1.0 1.0 1.0)))
+ (val (moving-max gen 1.0)))
+ (if (fneq val 1.0) (snd-display #__line__ ";max initial-contents: ~A" val)))
+
+ (test-gen-equal (let ((d1 (make-moving-max 3 :initial-contents '(0.7 0.5 3)))) (moving-max d1 1.0) d1)
+ (let ((d2 (make-moving-max 3 :initial-contents (float-vector 0.7 0.5 3)))) (moving-max d2 1.0) d2)
+ (let ((d3 (make-moving-max 4 :initial-contents '(0.7 0.5 0.1 4)))) (moving-max d3 1.0) d3))
+ (test-gen-equal (make-moving-max 3 :initial-element 1.0)
+ (make-moving-max 3 :initial-element 1.0)
+ (make-moving-max 3 :initial-element 0.5))
+ (test-gen-equal (make-moving-max 3 :initial-element 1.0)
+ (make-moving-max 3 :initial-element 1.0)
+ (make-moving-max 4 :initial-element 1.0))
+ (test-gen-equal (make-moving-max 3 :initial-contents '(1.0 0.0 0.0))
+ (make-moving-max 3 :initial-contents '(1.0 0.0 0.0))
+ (make-moving-max 3 :initial-contents '(1.0 1.0 1.0)))
+ (let ((err (catch #t (lambda () (make-moving-max :size -1)) (lambda args args))))
+ (if (not (eq? (car err) 'out-of-range))
+ (snd-display #__line__ ";make-max bad size error message: ~A" err)))
+ (let ((err (catch #t (lambda () (make-moving-max :size 0)) (lambda args args))))
+ (if (not (eq? (car err) 'out-of-range))
+ (snd-display #__line__ ";make-max size==0 error message: ~A" err)))
+
+ (let ((gen (make-moving-norm 4))
+ (v0 (make-float-vector 10))
+ (gen1 (make-moving-norm 4))
+ (v1 (make-float-vector 10)))
+ (print-and-check gen
+ "moving-norm"
+ "moving-norm, max 0.000, y1 5.000, weight 0.800, line[4]:[0 0 0 0]")
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v0 i) (moving-norm gen 1.0)))
+ (fill-float-vector v1 (if (moving-norm? gen1) (moving-norm gen1 1.0) -1.0))
+ (if (not (vequal v1 v0)) (snd-display #__line__ ";map norm: ~A ~A" v0 v1))
+ (if (not (moving-norm? gen)) (snd-display #__line__ ";~A not norm?" gen))
+ (if (not (= (mus-length gen) 4)) (snd-display #__line__ ";norm length: ~D?" (mus-length gen)))
+ (if (not (= (mus-order gen) 4)) (snd-display #__line__ ";norm order: ~D?" (mus-order gen))))
+
+ (let* ((gen (make-moving-norm 8))
+ (val (moving-norm gen)))
+ (if (fneq val 1.1236) (snd-display #__line__ ";empty norm: ~A" val))
+ (set! val (moving-norm gen 1.0))
+ (if (fneq val 1.1084) (snd-display #__line__ ";norm 1: ~A" val))
+ (set! val (moving-norm gen -0.5))
+ (if (fneq val 1.0952) (snd-display #__line__ ";norm 2: ~A" val))
+ (set! val (moving-norm gen -1.5))
+ (if (fneq val 1.0222) (snd-display #__line__ ";norm 2: ~A" val))
+ (do ((i 0 (+ i 1))) ((= i 5)) (set! val (moving-norm gen 0.0)))
+ (if (fneq val 0.8261) (snd-display #__line__ ";norm 6: ~A" val))
+ (set! val (moving-norm gen 0.0))
+ (if (fneq val 0.8047) (snd-display #__line__ ";norm 7: ~A" val))
+ (set! val (moving-norm gen 0.0))
+ (if (fneq val 0.7866) (snd-display #__line__ ";norm 8: ~A" val))
+ (set! val (moving-norm gen 0.0))
+ (if (fneq val 0.8841) (snd-display #__line__ ";norm 9: ~A" val))
+ )
+ (let* ((gen (make-moving-norm 10 :initial-element .5))
+ (val (moving-norm gen 0.5)))
+ (if (fneq val 1.0476) (snd-display #__line__ ";norm initial-element: ~A" val)))
+ (let* ((gen (make-moving-norm 3 :initial-contents '(1.0 1.0 1.0)))
+ (val (moving-norm gen 1.0)))
+ (if (fneq val 1.0) (snd-display #__line__ ";norm initial-contents: ~A" val)))
+
+ (test-gen-equal (let ((d1 (make-moving-norm 3))) (moving-norm d1 1.0) d1)
+ (let ((d2 (make-moving-norm 3))) (moving-norm d2 1.0) d2)
+ (let ((d3 (make-moving-norm 4))) (moving-norm d3 1.0) d3))
+ (test-gen-equal (make-moving-norm 3 :scaler 1.0)
+ (make-moving-norm 3 :scaler 1.0)
+ (make-moving-norm 4 :scaler 1.0))
+ (let ((err (catch #t (lambda () (make-moving-norm :size -1)) (lambda args args))))
+ (if (not (eq? (car err) 'out-of-range))
+ (snd-display #__line__ ";make-norm bad size error message: ~A" err)))
+ (let ((err (catch #t (lambda () (make-moving-norm :size 0)) (lambda args args))))
+ (if (not (eq? (car err) 'out-of-range))
+ (snd-display #__line__ ";make-norm size==0 error message: ~A" err)))
+
+
(let ((gen (make-comb .4 3))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-comb .4 3))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"comb"
- "comb scaler: 0.400, line[3, step]: [0.000 0.000 0.000]")
- (do ((i 0 (+ 1 i)))
+ "comb scaler: 0.400, line[3, step]: [0 0 0]")
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (comb gen 1.0)))
- (vct-map! v1 (lambda () (if (comb? gen1) (comb gen1 1.0) -1.0)))
+ (set! (v0 i) (comb gen 1.0)))
+ (fill-float-vector v1 (if (comb? gen1) (comb gen1 1.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map comb: ~A ~A" v0 v1))
(if (not (comb? gen)) (snd-display #__line__ ";~A not comb?" gen))
(if (not (= (mus-length gen) 3)) (snd-display #__line__ ";comb length: ~D?" (mus-length gen)))
(if (not (= (mus-order gen) 3)) (snd-display #__line__ ";comb order: ~D?" (mus-order gen)))
(if (fneq (mus-feedback gen) .4) (snd-display #__line__ ";comb feedback: ~F?" (mus-feedback gen)))
- (if (or (fneq (vct-ref v0 1) 0.0) (fneq (vct-ref v0 4) 1.0) (fneq (vct-ref v0 8) 1.4))
+ (if (or (fneq (v0 1) 0.0) (fneq (v0 4) 1.0) (fneq (v0 8) 1.4))
(snd-display #__line__ ";comb output: ~A" v0)))
(test-gen-equal (let ((d1 (make-comb 0.7 3))) (comb d1 1.0) d1)
@@ -18220,18 +13291,18 @@ EDITS: 2
(make-comb 0.7 3 :initial-contents '(1.0 0.0 0.0))
(make-comb 0.7 3 :initial-contents '(1.0 1.0 1.0)))
- (let* ((del (make-comb 0.0 5 :max-size 8)))
+ (let ((del (make-comb 0.0 5 :max-size 8)))
(comb del 1.0)
- (do ((i 0 (+ 1 i))) ((= i 4)) (comb del 0.0))
- (let ((v0 (make-vct 5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1))) ((= i 4)) (comb del 0.0))
+ (let ((v0 (make-float-vector 5)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! v0 i (comb del 0.0 0.4)))
- (if (not (vequal v0 (vct 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
+ (set! (v0 i) (comb del 0.0 0.4)))
+ (if (not (vequal v0 (float-vector 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
(snd-display #__line__ ";zcomb: ~A" v0))
(comb del 1.0)
(comb del 0.0 0.4)
- (if (not (string=? (mus-describe del) "comb scaler: 0.000, line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000]"))
+ (if (not (string=? (mus-describe del) "comb scaler: 0.000, line[5,8, linear]: [0 0 1 0 0]"))
(snd-display #__line__ ";describe zcomb: ~A" (mus-describe del))))
(set! (mus-feedback del) 1.0)
(if (fneq (mus-feedback del) 1.0)
@@ -18239,16 +13310,16 @@ EDITS: 2
(let ((gen (make-filtered-comb .4 5 :filter (make-one-zero .3 .7)))
- (v0 (make-vct 20)))
+ (v0 (make-float-vector 20)))
(print-and-check gen
"filtered-comb"
- "filtered-comb scaler: 0.400, line[5, step]: [0.000 0.000 0.000 0.000 0.000], filter: [one-zero a0: 0.300, a1: 0.700, x1: 0.000]")
+ "filtered-comb scaler: 0.400, line[5, step]: [0 0 0 0 0], filter: [one-zero a0: 0.300, a1: 0.700, x1: 0.000]")
(let ((val 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! v0 i (filtered-comb gen val))
+ (set! (v0 i) (filtered-comb gen val))
(set! val 0.0)))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.120 0.280 0.000 0.000 0.000 0.014 0.067 0.078 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.120 0.280 0.000 0.000 0.000 0.014 0.067 0.078 0.000 0.000)))
(snd-display #__line__ ";filtered-comb: ~A" v0))
(if (not (filtered-comb? gen)) (snd-display #__line__ ";~A not filtered-comb?" gen))
(if (not (= (mus-length gen) 5)) (snd-display #__line__ ";filtered-comb length: ~D?" (mus-length gen)))
@@ -18256,29 +13327,29 @@ EDITS: 2
(if (fneq (mus-feedback gen) .4) (snd-display #__line__ ";filtered-comb feedback: ~F?" (mus-feedback gen))))
(let ((gen (make-filtered-comb .9 5 :filter (make-one-zero .5 .5)))
- (v0 (make-vct 20)))
+ (v0 (make-float-vector 20)))
(print-and-check gen
"filtered-comb"
- "filtered-comb scaler: 0.900, line[5, step]: [0.000 0.000 0.000 0.000 0.000], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]")
+ "filtered-comb scaler: 0.900, line[5, step]: [0 0 0 0 0], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]")
(let ((val 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! v0 i (filtered-comb gen val))
+ (set! (v0 i) (filtered-comb gen val))
(set! val 0.0)))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.450 0.450 0.000 0.000 0.000 0.202 0.405 0.202 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.450 0.450 0.000 0.000 0.000 0.202 0.405 0.202 0.000 0.000)))
(snd-display #__line__ ";filtered-comb .5 .5: ~A" v0)))
- (let ((gen (make-filtered-comb .9 5 :filter (make-fir-filter 5 (vct .1 .2 .3 .2 .1))))
- (v0 (make-vct 20)))
+ (let ((gen (make-filtered-comb .9 5 :filter (make-fir-filter 5 (float-vector .1 .2 .3 .2 .1))))
+ (v0 (make-float-vector 20)))
(print-and-check gen
"filtered-comb"
- "filtered-comb scaler: 0.900, line[5, step]: [0.000 0.000 0.000 0.000 0.000], filter: [fir-filter order: 5, xs: [0.100 0.200 0.300 0.200 0.100]]")
+ "filtered-comb scaler: 0.900, line[5, step]: [0 0 0 0 0], filter: [fir-filter order: 5, xs: [0.1 0.2 0.3 0.2 0.1]]")
(let ((val 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! v0 i (filtered-comb gen val))
+ (set! (v0 i) (filtered-comb gen val))
(set! val 0.0)))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.090 0.180 0.270 0.180 0.090 0.008 0.032 0.081 0.130 0.154)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.090 0.180 0.270 0.180 0.090 0.008 0.032 0.081 0.130 0.154)))
(snd-display #__line__ ";filtered-comb fir: ~A" v0)))
(test-gen-equal (let ((d1 (make-filtered-comb 0.7 3 :filter (make-one-pole .3 .7)))) (filtered-comb d1 1.0) d1)
@@ -18294,19 +13365,19 @@ EDITS: 2
(make-filtered-comb 0.7 3 :initial-contents '(1.0 0.0 0.0) :filter (make-one-zero .5 .5))
(make-filtered-comb 0.7 3 :initial-contents '(1.0 1.0 1.0) :filter (make-one-zero .5 .5)))
- (let* ((del (make-filtered-comb 0.0 5 :max-size 8 :filter (make-one-zero .5 .5))))
+ (let ((del (make-filtered-comb 0.0 5 :max-size 8 :filter (make-one-zero .5 .5))))
(filtered-comb del 1.0)
- (do ((i 0 (+ 1 i))) ((= i 4)) (filtered-comb del 0.0))
- (let ((v0 (make-vct 5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1))) ((= i 4)) (filtered-comb del 0.0))
+ (let ((v0 (make-float-vector 5)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (vct-set! v0 i (filtered-comb del 0.0 0.4)))
- (if (not (vequal v0 (vct 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
+ (set! (v0 i) (filtered-comb del 0.0 0.4)))
+ (if (not (vequal v0 (float-vector 0.600 0.400 0.000 0.000 0.000))) ; this is assuming interpolation in the delay...
(snd-display #__line__ ";zfiltered-comb: ~A" v0))
(filtered-comb del 1.0)
(filtered-comb del 0.0 0.4)
(if (not (string=? (mus-describe del)
- "filtered-comb scaler: 0.000, line[5,8, linear]: [0.000 0.000 1.000 0.000 0.000], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]"))
+ "filtered-comb scaler: 0.000, line[5,8, linear]: [0 0 1 0 0], filter: [one-zero a0: 0.500, a1: 0.500, x1: 0.000]"))
(snd-display #__line__ ";describe zfiltered-comb: ~A" (mus-describe del))))
(set! (mus-feedback del) 1.0)
(if (fneq (mus-feedback del) 1.0)
@@ -18314,22 +13385,22 @@ EDITS: 2
(let ((gen (make-notch .4 3))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-notch .4 3))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"notch"
- "notch scaler: 0.400, line[3, step]: [0.000 0.000 0.000]")
- (do ((i 0 (+ 1 i)))
+ "notch scaler: 0.400, line[3, step]: [0 0 0]")
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (notch gen 1.0)))
- (vct-map! v1 (lambda () (if (notch? gen1) (notch gen1 1.0) -1.0)))
+ (set! (v0 i) (notch gen 1.0)))
+ (fill-float-vector v1 (if (notch? gen1) (notch gen1 1.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map notch: ~A ~A" v0 v1))
(if (not (notch? gen)) (snd-display #__line__ ";~A not notch?" gen))
(if (not (= (mus-length gen) 3)) (snd-display #__line__ ";notch length: ~D?" (mus-length gen)))
(if (not (= (mus-order gen) 3)) (snd-display #__line__ ";notch order: ~D?" (mus-order gen)))
(if (fneq (mus-feedforward gen) .4) (snd-display #__line__ ";notch feedforward: ~F?" (mus-feedforward gen)))
- (if (or (fneq (vct-ref v0 1) 0.4) (fneq (vct-ref v0 4) 1.4) (fneq (vct-ref v0 8) 1.4))
+ (if (or (fneq (v0 1) 0.4) (fneq (v0 4) 1.4) (fneq (v0 8) 1.4))
(snd-display #__line__ ";notch output: ~A" v0))
(set! (mus-feedforward gen) 1.0)
(if (fneq (mus-feedforward gen) 1.0)
@@ -18351,385 +13422,408 @@ EDITS: 2
;; make sure all-pass is the same as comb/notch given the appropriate feedback/forward settings
(let ((gen (make-comb 0.5 5))
- (v0 (make-vct 11))
+ (v0 (make-float-vector 11))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (vct-set! v0 i (comb gen in1))
+ (set! (v0 i) (comb gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
(snd-display #__line__ ";comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5))
- (v0 (make-vct 11))
+ (v0 (make-float-vector 11))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (vct-set! v0 i (all-pass gen in1))
+ (set! (v0 i) (all-pass gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
(snd-display #__line__ ";all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5))
- (v0 (make-vct 11))
+ (v0 (make-float-vector 11))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (vct-set! v0 i (notch gen in1))
+ (set! (v0 i) (notch gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5))
- (v0 (make-vct 11))
+ (v0 (make-float-vector 11))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (vct-set! v0 i (all-pass gen in1))
+ (set! (v0 i) (all-pass gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";all-pass (5 .5 0): ~A" v0)))
;; make sure zall-pass is the same as zcomb/znotch given the appropriate feedback/forward and "pm" settings
(let ((gen (make-comb 0.5 5 :max-size 20))
- (v0 (make-vct 11))
+ (v0 (make-float-vector 11))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (vct-set! v0 i (comb gen in1))
+ (set! (v0 i) (comb gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
(snd-display #__line__ ";1comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
- (v0 (make-vct 11))
+ (v0 (make-float-vector 11))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (vct-set! v0 i (all-pass gen in1))
+ (set! (v0 i) (all-pass gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.500)))
(snd-display #__line__ ";1all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 20))
- (v0 (make-vct 11))
+ (v0 (make-float-vector 11))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (vct-set! v0 i (notch gen in1))
+ (set! (v0 i) (notch gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";1notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
- (v0 (make-vct 11))
+ (v0 (make-float-vector 11))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 11))
- (vct-set! v0 i (all-pass gen in1))
+ (set! (v0 i) (all-pass gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";1all-pass (5 .5 0): ~A" v0)))
;; now actually use the size difference
(let ((gen (make-comb 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
- (angle 0.0 (+ angle .2)))
+ (do ((i 0 (+ i 1))
+ (phase 0.0 (+ phase .2)))
((= i 20))
- (vct-set! v0 i (comb gen in1 angle))
+ (set! (v0 i) (comb gen in1 phase))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
(snd-display #__line__ ";2comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .2)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.160 0.360 0.200 0.040 0.000 0.000 0.000)))
(snd-display #__line__ ";2all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .2)))
((= i 20))
- (vct-set! v0 i (notch gen in1 angle))
+ (set! (v0 i) (notch gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";2notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .2)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";2all-pass (5 .5 0): ~A" v0)))
(let ((gen (make-comb 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .2)))
((= i 20))
- (vct-set! v0 i (comb gen in1 angle))
+ (set! (v0 i) (comb gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
(snd-display #__line__ ";3comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .2)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.160 0.160 0.000 0.080 0.064 0.016 0.035 0.013 0.018 0.007 0.007 0.003 0.002)))
(snd-display #__line__ ";3all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .2)))
((= i 20))
- (vct-set! v0 i (notch gen in1 angle))
+ (set! (v0 i) (notch gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";3notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .2)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";3all-pass (5 .5 0): ~A" v0)))
(let ((gen (make-comb 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .01)))
((= i 20))
- (vct-set! v0 i (comb gen in1 angle))
+ (set! (v0 i) (comb gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
(snd-display #__line__ ";4comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .01)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.428 0.079 0.004 0.000 0.000 0.182 0.067 0.008 0.000 0.000)))
(snd-display #__line__ ";4all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .01)))
((= i 20))
- (vct-set! v0 i (notch gen in1 angle))
+ (set! (v0 i) (notch gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";4notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 20))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .01)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";4all-pass (5 .5 0): ~A" v0)))
;; now run off either end of the delay line "by accident"
(let ((gen (make-comb 0.5 5 :max-size 10))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .5)))
((= i 20))
- (vct-set! v0 i (comb gen in1 angle))
+ (set! (v0 i) (comb gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
(snd-display #__line__ ";5comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 10))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .5)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.250 0.125 0.094 0.062 0.055 0.047 0.039 0.031 0.029)))
(snd-display #__line__ ";5all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 10))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .5)))
((= i 20))
- (vct-set! v0 i (notch gen in1 angle))
+ (set! (v0 i) (notch gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";5notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 10))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .5)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.500 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";5all-pass (5 .5 0): ~A" v0)))
(let ((gen (make-comb 0.5 5 :max-size 10))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .5)))
((= i 20))
- (vct-set! v0 i (comb gen in1 angle))
+ (set! (v0 i) (comb gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
(snd-display #__line__ ";6comb (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.5 0.0 5 :max-size 10))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .5)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.500 0.000 0.125 0.000 0.031 0.016 0.004 1.000 0.000 0.250 0.031 0.000 0.012 0.002 0.250 0.125 0.008)))
(snd-display #__line__ ";6all-pass (5 0 .5): ~A" v0)))
(let ((gen (make-notch 0.5 5 :max-size 10))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .5)))
((= i 20))
- (vct-set! v0 i (notch gen in1 angle))
+ (set! (v0 i) (notch gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";6notch (5 .5): ~A" v0)))
(let ((gen (make-all-pass 0.0 0.5 5 :max-size 10))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .5)))
((= i 20))
- (vct-set! v0 i (all-pass gen in1 angle))
+ (set! (v0 i) (all-pass gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.500 0.000 0.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";6all-pass (5 .5 0): ~A" v0)))
(let ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .5 .5)))
- (v0 (make-vct 21))
+ (v0 (make-float-vector 21))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 21))
- (vct-set! v0 i (filtered-comb gen in1))
+ (set! (v0 i) (filtered-comb gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.250 0.250
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.250 0.250
0.000 0.000 0.000 0.062 0.125 0.062 0.000 0.000 0.016)))
(snd-display #__line__ ";filtered-comb (5 .5): ~A" v0)))
- (let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .25 .75)))
- (v0 (make-vct 21))
+ (let ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .25 .75)))
+ (v0 (make-float-vector 21))
(in1 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 21))
- (vct-set! v0 i (filtered-comb gen in1))
+ (set! (v0 i) (filtered-comb gen in1))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
0.000 0.000 0.000 0.016 0.094 0.141 0.000 0.000 0.002)))
(snd-display #__line__ ";1filtered-comb (5 .5): ~A" v0)))
+ (let ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .25 .75)))
+ (v0 (make-float-vector 21))
+ (in1 1.0))
+ (define mus-filtered-comb filtered-comb)
+ (do ((i 0 (+ i 1)))
+ ((= i 21))
+ (set! (v0 i) (mus-filtered-comb gen in1))
+ (set! in1 0.0))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
+ 0.000 0.000 0.000 0.016 0.094 0.141 0.000 0.000 0.002)))
+ (snd-display #__line__ ";1mus-filtered-comb (5 .5): ~A" v0)))
+
+ (let ((gen (make-filtered-comb 0.5 5 :filter (make-one-zero .25 .75)))
+ (v0 (make-float-vector 21))
+ (in1 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 21))
+ (set! (v0 i) (filtered-comb gen in1))
+ (set! in1 0.0))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.125 0.375
+ 0.000 0.000 0.000 0.016 0.094 0.141 0.000 0.000 0.002)))
+ (snd-display #__line__ ";1run-filtered-comb (5 .5): ~A" v0)))
+
(let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .2)))
((= i 20))
- (vct-set! v0 i (filtered-comb gen in1 angle))
+ (set! (v0 i) (filtered-comb gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.080 0.220 0.300 0.140 0.040 0.000 0.000)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.800 0.400 0.000 0.000 0.000 0.000 0.000 0.080 0.220 0.300 0.140 0.040 0.000 0.000)))
(snd-display #__line__ ";2filtered-comb (5 .5): ~A" v0)))
(let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (- angle .2)))
((= i 20))
- (vct-set! v0 i (filtered-comb gen in1 angle))
+ (set! (v0 i) (filtered-comb gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.080 0.200 0.040 0.020 0.068 0.042 0.019 0.026 0.015 0.011 0.009 0.006 0.004)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.800 0.000 0.000 0.080 0.200 0.040 0.020 0.068 0.042 0.019 0.026 0.015 0.011 0.009 0.006 0.004)))
(snd-display #__line__ ";3filtered-comb (5 .5): ~A" v0)))
(let ((gen (make-filtered-comb 0.5 5 :max-size 20 :filter (make-one-zero .5 .5)))
- (v0 (make-vct 20))
+ (v0 (make-float-vector 20))
(in1 1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle .01)))
((= i 20))
- (vct-set! v0 i (filtered-comb gen in1 angle))
+ (set! (v0 i) (filtered-comb gen in1 angle))
(set! in1 0.0))
- (if (not (vequal v0 (vct 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.214 0.251 0.043 0.002 0.000 0.045 0.106 0.081 0.023 0.003)))
+ (if (not (vequal v0 (float-vector 0.000 0.000 0.000 0.000 0.000 0.950 0.060 0.000 0.000 0.000 0.214 0.251 0.043 0.002 0.000 0.045 0.106 0.081 0.023 0.003)))
(snd-display #__line__ ";4filtered-comb (5 .5): ~A" v0)))
(let ((gen (make-one-pole .4 .7))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-one-pole .4 .7))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"one-pole"
"one-pole a0: 0.400, b1: 0.700, y1: 0.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (one-pole gen 1.0)))
- (vct-map! v1 (lambda () (if (one-pole? gen) (one-pole gen1 1.0) -1.0)))
+ (set! (v0 i) (one-pole gen 1.0)))
+ (fill-float-vector v1 (if (one-pole? gen) (one-pole gen1 1.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map one-pole: ~A ~A" v0 v1))
(if (not (one-pole? gen)) (snd-display #__line__ ";~A not one-pole?" gen))
(if (not (= (mus-order gen) 1)) (snd-display #__line__ ";one-pole order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) .4) (snd-display #__line__ ";one-pole a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) .7) (snd-display #__line__ ";one-pole b1: ~F?" (mus-b1 gen)))
- (if (or (fneq (vct-ref v0 1) 0.120) (fneq (vct-ref v0 4) 0.275) (fneq (vct-ref v0 8) 0.245))
+ (if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";one-pole a0: ~F?" (mus-xcoeff gen 0)))
+ (if (fneq (mus-ycoeff gen 1) .7) (snd-display #__line__ ";one-pole b1: ~F?" (mus-ycoeff gen 1)))
+ (if (or (fneq (v0 1) 0.120) (fneq (v0 4) 0.275) (fneq (v0 8) 0.245))
(snd-display #__line__ ";one-pole output: ~A" v0))
(if (fneq (mus-ycoeff gen 1) .7) (snd-display #__line__ ";1p ycoeff 1 .7: ~A" gen))
(set! (mus-ycoeff gen 1) .1)
@@ -18740,44 +13834,44 @@ EDITS: 2
(let ((gen (make-one-zero .4 .7))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-one-zero .4 .7))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"one-zero"
"one-zero a0: 0.400, a1: 0.700, x1: 0.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (one-zero gen 1.0)))
- (vct-map! v1 (lambda () (if (one-zero? gen) (one-zero gen1 1.0) -1.0)))
+ (set! (v0 i) (one-zero gen 1.0)))
+ (fill-float-vector v1 (if (one-zero? gen) (one-zero gen1 1.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map one-zero: ~A ~A" v0 v1))
(if (not (one-zero? gen)) (snd-display #__line__ ";~A not one-zero?" gen))
(if (not (= (mus-order gen) 1)) (snd-display #__line__ ";one-zero order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) .4) (snd-display #__line__ ";one-zero a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) .7) (snd-display #__line__ ";one-zero a1: ~F?" (mus-a1 gen)))
- (if (fneq (vct-ref v0 1) 1.1) (snd-display #__line__ ";one-zero output: ~A" v0))
+ (if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";one-zero a0: ~F?" (mus-xcoeff gen 0)))
+ (if (fneq (mus-xcoeff gen 1) .7) (snd-display #__line__ ";one-zero a1: ~F?" (mus-xcoeff gen 1)))
+ (if (fneq (v0 1) 1.1) (snd-display #__line__ ";one-zero output: ~A" v0))
(if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";1z xcoeff 0 .4: ~A" gen))
(set! (mus-xcoeff gen 0) .1)
(if (fneq (mus-xcoeff gen 0) .1) (snd-display #__line__ ";1z set xcoeff 0 .1: ~A" gen)))
(let ((gen (make-two-zero .4 .7 .3))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-two-zero .4 .7 .3))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"two-zero"
"two-zero a0: 0.400, a1: 0.700, a2: 0.300, x1: 0.000, x2: 0.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (two-zero gen 1.0)))
- (vct-map! v1 (lambda () (if (two-zero? gen1) (two-zero gen1 1.0) -1.0)))
+ (set! (v0 i) (two-zero gen 1.0)))
+ (fill-float-vector v1 (if (two-zero? gen1) (two-zero gen1 1.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map two-zero: ~A ~A" v0 v1))
(if (not (two-zero? gen)) (snd-display #__line__ ";~A not two-zero?" gen))
(if (not (= (mus-order gen) 2)) (snd-display #__line__ ";two-zero order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) .4) (snd-display #__line__ ";two-zero a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) .7) (snd-display #__line__ ";two-zero a1: ~F?" (mus-a1 gen)))
- (if (fneq (mus-a2 gen) .3) (snd-display #__line__ ";two-zero a2: ~F?" (mus-a2 gen)))
- (if (or (fneq (vct-ref v0 1) 1.1) (fneq (vct-ref v0 8) 1.4)) (snd-display #__line__ ";two-zero output: ~A" v0))
+ (if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";two-zero a0: ~F?" (mus-xcoeff gen 0)))
+ (if (fneq (mus-xcoeff gen 1) .7) (snd-display #__line__ ";two-zero a1: ~F?" (mus-xcoeff gen 1)))
+ (if (fneq (mus-xcoeff gen 2) .3) (snd-display #__line__ ";two-zero a2: ~F?" (mus-xcoeff gen 2)))
+ (if (or (fneq (v0 1) 1.1) (fneq (v0 8) 1.4)) (snd-display #__line__ ";two-zero output: ~A" v0))
(if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";2z xcoeff 0 .4: ~A" gen))
(set! (mus-xcoeff gen 0) .1)
(if (fneq (mus-xcoeff gen 0) .1) (snd-display #__line__ ";2z set xcoeff 0 .1: ~A" gen))
@@ -18790,9 +13884,9 @@ EDITS: 2
(if (fneq (mus-scaler gen) .99) (snd-display #__line__ ";set mus-scaler two-zero: ~A" (mus-scaler gen)))
(if (ffneq (mus-frequency gen) 500.0) (snd-display #__line__ ";set mus-scaler hit freq two-zero: ~A" (mus-frequency gen)))
(let ((g3 (make-two-zero :radius .99 :frequency 500.0)))
- (if (or (fneq (mus-a0 gen) (mus-a0 g3))
- (fneq (mus-a1 gen) (mus-a1 g3))
- (fneq (mus-a2 gen) (mus-a2 g3)))
+ (if (or (fneq (mus-xcoeff gen 0) (mus-xcoeff g3 0))
+ (fneq (mus-xcoeff gen 1) (mus-xcoeff g3 1))
+ (fneq (mus-xcoeff gen 2) (mus-xcoeff g3 2)))
(snd-display #__line__ ";two-zero setters: ~A ~A" gen g3)))))
(let ((gen (make-two-zero .4 .7 .3)))
@@ -18804,23 +13898,23 @@ EDITS: 2
(if (fneq val 1.05) (snd-display #__line__ ";2zero->1.05: ~A" val))))
(let ((gen (make-two-pole .4 .7 .3))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-two-pole .4 .7 .3))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"two-pole"
"two-pole a0: 0.400, b1: 0.700, b2: 0.300, y1: 0.000, y2: 0.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (two-pole gen 1.0)))
- (vct-map! v1 (lambda () (if (two-pole? gen1) (two-pole gen1 1.0) -1.0)))
+ (set! (v0 i) (two-pole gen 1.0)))
+ (fill-float-vector v1 (if (two-pole? gen1) (two-pole gen1 1.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map two-pole: ~A ~A" v0 v1))
(if (not (two-pole? gen)) (snd-display #__line__ ";~A not two-pole?" gen))
(if (not (= (mus-order gen) 2)) (snd-display #__line__ ";two-pole order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) .4) (snd-display #__line__ ";two-pole a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) .7) (snd-display #__line__ ";two-pole b1: ~F?" (mus-b1 gen)))
- (if (fneq (mus-b2 gen) .3) (snd-display #__line__ ";two-pole b2: ~F?" (mus-b2 gen)))
- (if (or (fneq (vct-ref v0 1) 0.12) (fneq (vct-ref v0 8) 0.201)) (snd-display #__line__ ";two-pole output: ~A" v0))
+ (if (fneq (mus-xcoeff gen 0) .4) (snd-display #__line__ ";two-pole a0: ~F?" (mus-xcoeff gen 0)))
+ (if (fneq (mus-ycoeff gen 1) .7) (snd-display #__line__ ";two-pole b1: ~F?" (mus-ycoeff gen 1)))
+ (if (fneq (mus-ycoeff gen 2) .3) (snd-display #__line__ ";two-pole b2: ~F?" (mus-ycoeff gen 2)))
+ (if (or (fneq (v0 1) 0.12) (fneq (v0 8) 0.201)) (snd-display #__line__ ";two-pole output: ~A" v0))
(if (fneq (mus-ycoeff gen 1) .7) (snd-display #__line__ ";2p ycoeff 1 .7: ~A" gen))
(set! (mus-ycoeff gen 1) .1)
(if (fneq (mus-ycoeff gen 1) .1) (snd-display #__line__ ";2p set ycoeff 1 .1: ~A" gen))
@@ -18836,9 +13930,9 @@ EDITS: 2
(if (fneq (mus-scaler gen) .99) (snd-display #__line__ ";set mus-scaler two-pole: ~A" (mus-scaler gen)))
(if (ffneq (mus-frequency gen) 500.0) (snd-display #__line__ ";set mus-scaler hit freq two-pole: ~A" (mus-frequency gen)))
(let ((g3 (make-two-pole :radius .99 :frequency 500.0)))
- (if (or (fneq (mus-a0 gen) (mus-a0 g3))
- (fneq (mus-b1 gen) (mus-b1 g3))
- (fneq (mus-b2 gen) (mus-b2 g3)))
+ (if (or (fneq (mus-xcoeff gen 0) (mus-xcoeff g3 0))
+ (fneq (mus-ycoeff gen 1) (mus-ycoeff g3 1))
+ (fneq (mus-ycoeff gen 2) (mus-ycoeff g3 2)))
(snd-display #__line__ ";two-pole setters: ~A ~A" gen g3)))))
(let ((gen (make-two-pole .4 .7 .3)))
@@ -18849,54 +13943,85 @@ EDITS: 2
(set! val (gen 1.0))
(if (fneq val 0.336) (snd-display #__line__ ";a0->out 2pole (0.336): ~A" val))))
- (let ((var (catch #t (lambda () (make-two-pole :b1 3.0)) (lambda args args))))
- (if (not (eq? (car var) 'mus-error))
- (snd-display #__line__ ";make-two-pole bad b1: ~A" var)))
- (let ((var (catch #t (lambda () (make-two-pole :b2 2.0)) (lambda args args))))
- (if (not (eq? (car var) 'mus-error))
- (snd-display #__line__ ";make-two-pole bad b2: ~A" var)))
- (let ((var (catch #t (lambda () (make-two-pole :b2 2.0 :b1)) (lambda args args))))
- (if (not (eq? (car var) 'mus-error))
- (snd-display #__line__ ";make-two-pole bad keys: ~A" var)))
- (let ((var (catch #t (lambda () (make-two-pole :b2 2.0 3.0)) (lambda args args))))
- (if (not (eq? (car var) 'mus-error))
- (snd-display #__line__ ";make-two-pole bad args: ~A" var)))
-
(let ((gen (make-oscil 440.0))
(gen1 (make-oscil 440.0))
(gen2 (make-oscil 440.0))
- (v0 (make-vct 10))
- (v1 (make-vct 10))
- (v2 (make-vct 10)))
+ (v0 (make-float-vector 10))
+ (v1 (make-float-vector 10))
+ (v2 (make-float-vector 10)))
(print-and-check gen
"oscil"
"oscil freq: 440.000Hz, phase: 0.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (oscil gen 0.0))
- (vct-set! v1 i (mus-apply gen1 0.0 0.0)))
- (vct-map! v2 (lambda () (if (oscil? gen2) (oscil gen2 0.0) -1.0)))
+ (set! (v0 i) (oscil gen 0.0))
+ (set! (v1 i) (mus-apply gen1 0.0 0.0)))
+ (fill-float-vector v2 (if (oscil? gen2) (oscil gen2 0.0) -1.0))
(if (not (vequal v0 v2)) (snd-display #__line__ ";map oscil: ~A ~A" v0 v2))
(if (not (oscil? gen)) (snd-display #__line__ ";~A not oscil?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";oscil phase: ~F?" (mus-phase gen)))
(if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";oscil frequency: ~F?" (mus-frequency gen)))
(if (not (= (mus-length gen) 1)) (snd-display #__line__ ";oscil cosines: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.125) (fneq (vct-ref v0 8) 0.843)) (snd-display #__line__ ";oscil output: ~A" v0))
+ (if (or (fneq (v0 1) 0.125) (fneq (v0 8) 0.843)) (snd-display #__line__ ";oscil output: ~A" v0))
(set! (mus-phase gen) 0.0)
(if (fneq (mus-phase gen) 0.0) (snd-display #__line__ ";oscil set-phase: ~F?" (mus-phase gen)))
(set! (mus-frequency gen) 100.0)
(if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";oscil set-frequency: ~F?" (mus-frequency gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display #__line__ ";mus-apply oscil at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i))))
+ (if (fneq (v0 i) (v1 i))
+ (snd-display #__line__ ";mus-apply oscil at ~D: ~A ~A?" i (v0 i) (v1 i))))
(if (fneq (mus-apply) 0.0)
(snd-display #__line__ ";(mus-apply): ~A" (mus-apply))))
-
+
+ ;; we can't (or don't anyway) guarantee optimized arg order evaluation so:
+ (let ((o (make-oscil 1000.0))
+ (o1 (make-oscil 1000.0))
+ (v (make-float-vector 10))
+ (x 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! x (oscil o (oscil o1) (oscil o1)))
+ (set! (v i) x))
+ (let ((o4 (make-oscil 1000.0))
+ (o5 (make-oscil 1000.0))
+ (v2 (make-float-vector 10))
+ (x1 0.0)
+ (x2 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! x1 (oscil o5))
+ (set! x2 (oscil o5))
+ (set! (v2 i) (oscil o4 x2 x1)))
+ (let ()
+ (define (hi)
+ (let ((o2 (make-oscil 1000.0))
+ (o3 (make-oscil 1000.0))
+ (v1 (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) v1)
+ (float-vector-set! v1 i (oscil o2 (oscil o3) (oscil o3))))))
+ (hi)
+ (let ((v1 (hi)))
+
+ (if (and (not (mus-arrays-equal? v v1))
+ (not (mus-arrays-equal? v2 v1)))
+ (format *stderr* ":orig: ~A~%; v1: ~A~%; v2: ~A~%" v v1 v2))))))
+ (test-fm-components)
+ (osc-opt)
+ (nrxysin-opt)
+ (polywave-opt)
+ (do ((i 1 (+ i 1)))
+ ((= i 6))
+ (test-simple-polywave i #f mus-chebyshev-first-kind)
+ (test-simple-polywave i .1 mus-chebyshev-first-kind)
+ (test-simple-polywave i #f mus-chebyshev-second-kind)
+ (test-simple-polywave i .1 mus-chebyshev-second-kind))
+
(let ((gen1 (make-oscil 100.0))
(gen2 (make-oscil -100.0))
(mx 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
(if (fneq mx 0.0)
@@ -18905,12 +14030,30 @@ EDITS: 2
(let ((gen1 (make-oscil 100.0 (* pi 0.5)))
(gen2 (make-oscil -100.0 (* pi 0.5)))
(mx 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(set! mx (max mx (abs (- (gen1) (gen2))))))
(if (fneq mx 0.0)
(snd-display #__line__ ";cosil +-: ~A" mx)))
+ (let ((frqs (float-vector 0.0 0.0))
+ (amps (float-vector 0.0 0.0))
+ (phs (float-vector 0.0 0.0)))
+ (let ((ob (make-oscil-bank frqs phs amps)))
+ (if (not (oscil-bank? ob)) (snd-display #__line__ ";oscil-bank? ~A" ob))
+ (if (not (equal? (mus-data ob) phs)) (snd-display #__line__ ";oscil-bank data: ~A ~A" (mus-data ob) phs))
+ (let ((x (oscil-bank ob)))
+ (if (not (= x 0.0)) (snd-display #__line__ ";oscil-bank 0.0: ~A~%" x)))
+ (set! (amps 0) 0.5)
+ (set! (amps 1) 0.2)
+ (let ((x (oscil-bank ob)))
+ (if (not (= x 0.0)) (snd-display #__line__ ";oscil-bank 0.0 (amps): ~A~%" x)))
+ (set! (frqs 0) .1)
+ (set! (frqs 1) .2)
+ (oscil-bank ob)
+ (let ((x (oscil-bank ob)))
+ (if (not (morally-equal? x 0.08965057448242633)) (snd-display #__line__ ";oscil-bank 0.09: ~A~%" x)))))
+
(fm-test (make-oscil))
(fm-test (make-nrxysin))
(fm-test (make-nrxycos))
@@ -18925,7 +14068,7 @@ EDITS: 2
(let ((gen (make-oscil 440.0))
(gen1 (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((oval (oscil gen .1))
(mval (mus-run gen1 .1)))
@@ -18937,18 +14080,18 @@ EDITS: 2
(gen2 (make-oscil 440.0))
(gen3 (make-oscil 440.0))
(fm-index (hz->radians 440.0))
- (v0 (make-vct 10))
- (v1 (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (v0 (make-float-vector 10))
+ (v1 (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (oscil gen (* fm-index (oscil gen1 0.0))))
- (vct-set! v1 i (mus-apply gen2 (* fm-index (mus-apply gen3 0.0 0.0)) 0.0)))
- (if (or (fneq (vct-ref v0 1) 0.125) (fneq (vct-ref v0 6) 0.830) (fneq (vct-ref v0 8) 0.987))
+ (set! (v0 i) (oscil gen (* fm-index (oscil gen1 0.0))))
+ (set! (v1 i) (mus-apply gen2 (* fm-index (mus-apply gen3 0.0 0.0)) 0.0)))
+ (if (or (fneq (v0 1) 0.125) (fneq (v0 6) 0.830) (fneq (v0 8) 0.987))
(snd-display #__line__ ";oscil fm output: ~A" v0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display #__line__ ";mus-apply fm oscil at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i)))))
+ (if (fneq (v0 i) (v1 i))
+ (snd-display #__line__ ";mus-apply fm oscil at ~D: ~A ~A?" i (v0 i) (v1 i)))))
(test-gen-equal (make-oscil 440.0) (make-oscil 440.0) (make-oscil 100.0))
(test-gen-equal (make-oscil 440.0) (make-oscil 440.0) (make-oscil 440.0 1.0))
@@ -18956,53 +14099,117 @@ EDITS: 2
(let ((gen (make-oscil 440.0))
(gen1 (make-oscil 440.0))
(pm-index 2.0)
- (v0 (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (v0 (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (gen 0.0 (* pm-index (gen1 0.0)))))
- (if (or (fneq (vct-ref v0 1) 0.367) (fneq (vct-ref v0 6) 0.854) (fneq (vct-ref v0 8) 0.437))
+ (set! (v0 i) (gen 0.0 (* pm-index (gen1 0.0)))))
+ (if (or (fneq (v0 1) 0.367) (fneq (v0 6) 0.854) (fneq (v0 8) 0.437))
(snd-display #__line__ ";oscil pm output: ~A" v0)))
(let ((gen (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1100))
- (let* ((val1 (sin (mus-phase gen)))
+ (let ((val1 (sin (mus-phase gen)))
(val2 (gen 0.0)))
(if (fneq val1 val2)
(snd-display #__line__ ";oscil: ~A: ~A ~A" i val1 val2)))))
- (let ((gen (make-oscil 440.0 :initial-phase (* pi 0.5))))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 440.0) 22050.0))))
+ (let ((gen (make-oscil 440.0 :initial-phase (* pi 0.5)))
+ (incr (/ (* 2 pi 440.0) 22050.0)))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((= i 900))
- (let* ((val1 (cos a))
- (val2 (gen 0.0)))
+ (let ((val1 (cos a))
+ (val2 (gen 0.0)))
(if (fneq val1 val2)
(snd-display #__line__ ";oscil (cos): ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-oscil 0.0))
- (gen1 (make-oscil 40.0)))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 40.0) 22050.0))))
+ (gen1 (make-oscil 40.0))
+ (incr (/ (* 2 pi 40.0) 22050.0)))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((= i 1100))
- (let* ((val1 (sin (sin a)))
- (val2 (oscil gen 0.0 (oscil gen1 0.0))))
+ (let ((val1 (sin (sin a)))
+ (val2 (oscil gen 0.0 (oscil gen1 0.0))))
(if (fneq val1 val2)
(snd-display #__line__ ";oscil pm: ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-oscil 0.0))
(gen1 (make-oscil 40.0))
+ (incr (/ (* 2 pi 40.0) 22050.0))
(a1 0.0))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 40.0) 22050.0))))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((= i 100))
- (let* ((fm (sin a))
- (val1 (sin a1))
- (val2 (oscil gen (oscil gen1 0.0))))
+ (let ((fm (sin a))
+ (val1 (sin a1))
+ (val2 (oscil gen (oscil gen1 0.0))))
(set! a1 (+ a1 fm))
(if (fneq val1 val2)
(snd-display #__line__ ";oscil fm: ~A: ~A ~A" i val1 val2)))))
+ (let ()
+ (define (oscil-1-1)
+ (let ((osc (make-oscil 440.0)))
+ (let ((v1 (make-vector 10 0.0))
+ (v2 (make-vector 10 0.0)))
+ (set! (v1 0) (oscil osc))
+ (set! (v1 1) (oscil osc))
+ (let ((osc (make-oscil 440.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v2 i) (oscil osc))))
+ (do ((i 2 (+ i 1)))
+ ((= i 10))
+ (set! (v1 i) (oscil osc)))
+
+ (if (not (equal? v1 v2))
+ (snd-display #__line__ ";oscil-1 shadowing test1: ~A ~A" v1 v2)))))
+
+ (define (oscil-1-2)
+ (define (ho-1 osc v i)
+ (set! (v i) (oscil osc)))
+ (let ((o1 (make-oscil 440.0))
+ (o2 (make-oscil 440.0))
+ (v1 (make-vector 10 0.0))
+ (v2 (make-vector 10 0.0)))
+ (ho-1 o1 v1 0)
+ (ho-1 o1 v1 1)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (ho-1 o2 v2 i))
+ (do ((i 2 (+ i 1)))
+ ((= i 10))
+ (ho-1 o1 v1 i))
+ (if (not (equal? v1 v2))
+ (snd-display #__line__ ";oscil-1 shadowing test2: ~A ~A" v1 v2))))
+
+ (define (oscil-1-3)
+ (define (ho)
+ (let ((osc (make-oscil 440.0)))
+ (lambda ()
+ (oscil osc))))
+ (let ((o1 (ho))
+ (v1 (make-vector 10 0.0))
+ (v2 (make-vector 10 0.0)))
+ (set! (v1 0) (o1))
+ (set! (v1 1) (o1))
+ (let ((o2 (ho)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v2 i) (o2))))
+ (do ((i 2 (+ i 1)))
+ ((= i 10))
+ (set! (v1 i) (o1)))
+ (if (not (equal? v1 v2))
+ (snd-display #__line__ ";oscil-1 shadowing test3: ~A ~A" v1 v2))))
+
+ (oscil-1-1)
+ (oscil-1-2)
+ (oscil-1-3))
+
+
(let ((var (catch #t (lambda () (mus-location (make-oscil))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
(snd-display #__line__ ";mus-location bad gen: ~A" var)))
@@ -19030,7 +14237,7 @@ EDITS: 2
(define (test-pm beg end freq amp mc-ratio index)
(let ((pm (make-oscil (* freq mc-ratio)))
(carrier (make-oscil freq)))
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
(outa i (* amp (oscil carrier 0.0 (* index (oscil pm))))))))
@@ -19038,47 +14245,37 @@ EDITS: 2
(let ((fm (make-oscil (* freq mc-ratio) :initial-phase (/ pi 2.0)))
(carrier (make-oscil freq))
(fm-index (* (hz->radians freq) mc-ratio index)))
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
(outa i (* amp (oscil carrier (* fm-index (oscil fm))))))))
;; there's an initial-phase confusion here, so by making the srate high and freq low, we minimize uninteresting off-by-1 troubles
- (let ((v1 (with-sound (:output (make-vct size) :srate 441000) (test-pm 0 size 20 1 1 1)))
- (v2 (with-sound (:output (make-vct size) :srate 441000) (test-fm 0 size 20 1 1 1))))
+ (let ((v1 (with-sound ((make-float-vector size) :srate 441000) (test-pm 0 size 20 1 1 1)))
+ (v2 (with-sound ((make-float-vector size) :srate 441000) (test-fm 0 size 20 1 1 1))))
(if (not (vequal v1 v2))
- (snd-display #__line__ ";fm/pm peak diff (1 1): ~A" (vct-peak (vct-subtract! v1 v2)))))
-
- (let ((v (with-sound (:output (make-vector 8))
- (outa 0 .1)
- (outa 2 .2))))
- (let ((old-fudge (mus-float-equal-fudge-factor)))
- (set! (mus-float-equal-fudge-factor) .0001)
- (let ((result (equal? (vector->vct v) (vct 0.1 0.0 0.2 0.0 0.0 0.0 0.0 0.0))))
- (set! (mus-float-equal-fudge-factor) old-fudge)
- (if (not result)
- (snd-display #__line__ ";outa to vector: ~A" v)))))
-
- (do ((i 0 (+ 1 i)))
+ (snd-display #__line__ ";fm/pm peak diff (1 1): ~A" (float-vector-peak (float-vector-subtract! v1 v2)))))
+
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((ratio (+ 1 (random 4)))
(index (random 2.0)))
- (let ((v1 (with-sound (:output (make-vct size) :srate 441000) (test-pm 0 size 20 1 ratio index)))
- (v2 (with-sound (:output (make-vct size) :srate 441000) (test-fm 0 size 20 1 ratio index))))
+ (let ((v1 (with-sound ((make-float-vector size) :srate 441000) (test-pm 0 size 20 1 ratio index)))
+ (v2 (with-sound ((make-float-vector size) :srate 441000) (test-fm 0 size 20 1 ratio index))))
(if (not (vequal v1 v2))
- (snd-display #__line__ ";fm/pm peak diff ~A ~A: ~A" ratio index (vct-peak (vct-subtract! v1 v2))))))))
+ (snd-display #__line__ ";fm/pm peak diff ~A ~A: ~A" ratio index (float-vector-peak (float-vector-subtract! v1 v2))))))))
(let ((gen (make-ncos 440.0 10))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-ncos 440.0 10))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"ncos"
"ncos freq: 440.000Hz, phase: 0.000, n: 10")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (ncos gen 0.0)))
- (vct-map! v1 (lambda () (if (ncos? gen1) (ncos gen1 0.0) -1.0)))
+ (set! (v0 i) (ncos gen 0.0)))
+ (fill-float-vector v1 (if (ncos? gen1) (ncos gen1 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map ncos: ~A ~A" v0 v1))
(if (not (ncos? gen)) (snd-display #__line__ ";~A not ncos?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";ncos phase: ~F?" (mus-phase gen)))
@@ -19086,7 +14283,7 @@ EDITS: 2
(if (fneq (mus-scaler gen) .1) (snd-display #__line__ ";ncos scaler: ~F?" (mus-scaler gen)))
(if (not (= (mus-length gen) 10)) (snd-display #__line__ ";ncos n: ~D?" (mus-length gen)))
(if (not (= (mus-length gen) 10)) (snd-display #__line__ ";ncos length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.722) (fneq (vct-ref v0 8) -0.143)) (snd-display #__line__ ";ncos output: ~A" v0))
+ (if (or (fneq (v0 1) 0.722) (fneq (v0 8) -0.143)) (snd-display #__line__ ";ncos output: ~A" v0))
(set! (mus-scaler gen) .5) (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";ncos set-scaler: ~F?" (mus-scaler gen)))
(set! (mus-length gen) 5) (if (not (= (mus-length gen) 5)) (snd-display #__line__ ";set ncos n: ~D?" (mus-length gen)))
(if (fneq (mus-scaler gen) .2) (snd-display #__line__ ";set n->scaler: ~A" (mus-scaler gen))))
@@ -19095,7 +14292,7 @@ EDITS: 2
(test-gen-equal (make-ncos 440.0 3) (make-ncos 440.0 3) (make-ncos 400.0 3))
(let ((gen (make-ncos 440 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1100))
(let* ((den (sin (* (mus-phase gen) 0.5)))
(val1 (if (= 0.0 den)
@@ -19112,23 +14309,28 @@ EDITS: 2
(let ((gen1 (make-ncos 100.0 10))
(gen2 (make-ncos -100.0 10))
(mx 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(set! mx (max mx (abs (- (gen1) (gen2))))))
(if (fneq mx 0.0)
(snd-display #__line__ ";ncos +-: ~A" mx)))
+
+ (test-simple-ncos 1)
+ (test-simple-ncos 3)
+ (test-simple-ncos 10)
+
(let ((gen (make-nsin 440.0 10))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-nsin 440.0 10))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"nsin"
"nsin freq: 440.000Hz, phase: 0.000, n: 10")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (nsin gen 0.0)))
- (vct-map! v1 (lambda () (if (nsin? gen1) (nsin gen1 0.0) -1.0)))
+ (set! (v0 i) (nsin gen 0.0)))
+ (fill-float-vector v1 (if (nsin? gen1) (nsin gen1 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map nsin: ~A ~A" v0 v1))
(if (not (nsin? gen)) (snd-display #__line__ ";~A not nsin?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";nsin phase: ~F?" (mus-phase gen)))
@@ -19136,7 +14338,7 @@ EDITS: 2
(if (fneq (mus-scaler gen) .1315) (snd-display #__line__ ";nsin scaler: ~F?" (mus-scaler gen)))
(if (not (= (mus-length gen) 10)) (snd-display #__line__ ";nsin n: ~D?" (mus-length gen)))
(if (not (= (mus-length gen) 10)) (snd-display #__line__ ";nsin length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.784) (fneq (vct-ref v0 8) 0.181)) (snd-display #__line__ ";nsin output: ~A" v0))
+ (if (or (fneq (v0 1) 0.784) (fneq (v0 8) 0.181)) (snd-display #__line__ ";nsin output: ~A" v0))
(set! (mus-scaler gen) .5) (if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";nsin set-scaler: ~F?" (mus-scaler gen)))
(set! (mus-length gen) 5) (if (not (= (mus-length gen) 5)) (snd-display #__line__ ";set nsin n: ~D?" (mus-length gen)))
(if (fneq (mus-scaler gen) .2525) (snd-display #__line__ ";set sines->scaler: ~A" (mus-scaler gen))))
@@ -19144,35 +14346,31 @@ EDITS: 2
(test-gen-equal (make-nsin 440.0 3) (make-nsin 440.0 3) (make-nsin 440.0 5))
(test-gen-equal (make-nsin 440.0 3) (make-nsin 440.0 3) (make-nsin 400.0 3))
- (let ((gen (make-nsin 440 5)))
- (do ((i 0 (+ 1 i)))
- ((= i 1100))
- (let* ((val1 (* (sum-of-n-sines (mus-phase gen) 5) (mus-scaler gen)))
- (val2 (gen 0.0)))
- (if (fneq val1 val2)
- (snd-display #__line__ ";nsin: ~A ~A" val1 val2)))))
-
(let ((gen1 (make-nsin 100.0 10))
(gen2 (make-nsin -100.0 10))
(mx 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
(if (fneq mx 0.0)
(snd-display #__line__ ";nsin +-: ~A" mx)))
+ (test-simple-nsin 1)
+ (test-simple-nsin 3)
+ (test-simple-nsin 10)
+
(let ((gen (make-nrxysin 440.0))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-nrxysin 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"nrxysin"
"nrxysin frequency: 440.000, ratio: 1.000, phase: 0.000, n: 1, r: 0.500")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (nrxysin gen 0.0)))
- (vct-map! v1 (lambda () (if (nrxysin? gen1) (nrxysin gen1 0.0) -1.0)))
+ (set! (v0 i) (nrxysin gen 0.0)))
+ (fill-float-vector v1 (if (nrxysin? gen1) (nrxysin gen1 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map nrxysin: ~A ~A" v0 v1))
(if (not (nrxysin? gen)) (snd-display #__line__ ";~A not nrxysin?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";nrxysin phase: ~F?" (mus-phase gen)))
@@ -19187,27 +14385,27 @@ EDITS: 2
(test-gen-equal (make-nrxysin 440.0) (make-nrxysin 440.0) (make-nrxysin 440.0 1.5))
(test-gen-equal (make-nrxysin 440.0) (make-nrxysin 440.0) (make-nrxysin 440.0 :n 3))
- (let ((v1 (make-vct 10)))
- (with-sound (:output v1 :srate 44100)
- (let ((gen (make-nrxysin 1000 :n 10 :r .99)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (nrxysin gen)))))
- (if (not (vequal v1 (vct 0.000 0.671 0.637 0.186 0.017 0.169 0.202 0.048 0.007 0.105)))
+ (let ((v1 (make-float-vector 10)))
+ (with-sound (v1 :srate 44100)
+ (let ((gen (make-nrxysin 1000 :n 10 :r .99)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (outa i (nrxysin gen)))))
+ (if (not (vequal v1 (float-vector 0.000 0.671 0.637 0.186 0.017 0.169 0.202 0.048 0.007 0.105)))
(snd-display #__line__ ";ws nrxysin output: ~A" v1)))
(let ((gen (make-nrxycos 440.0))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-nrxycos 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"nrxycos"
"nrxycos frequency: 440.000, ratio: 1.000, phase: 0.000, n: 1, r: 0.500")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (nrxycos gen 0.0)))
- (vct-map! v1 (lambda () (if (nrxycos? gen1) (nrxycos gen1 0.0) -1.0)))
+ (set! (v0 i) (nrxycos gen 0.0)))
+ (fill-float-vector v1 (if (nrxycos? gen1) (nrxycos gen1 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map nrxycos: ~A ~A" v0 v1))
(if (not (nrxycos? gen)) (snd-display #__line__ ";~A not nrxycos?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";nrxycos phase: ~F?" (mus-phase gen)))
@@ -19222,169 +14420,25 @@ EDITS: 2
(test-gen-equal (make-nrxycos 440.0) (make-nrxycos 440.0) (make-nrxycos 440.0 1.5))
(test-gen-equal (make-nrxycos 440.0) (make-nrxycos 440.0) (make-nrxycos 440.0 :n 3))
- (let ((v1 (with-sound (:output (make-vct 10) :srate 44100)
+ (let ((v1 (with-sound ((make-float-vector 10) :srate 44100)
(let ((gen (make-nrxycos 1000 :n 10 :r .99)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(outa i (nrxycos gen)))))))
- (if (not (vequal v1 (vct 1.000 0.602 -0.067 -0.242 -0.007 0.071 -0.087 -0.128 -0.007 0.012)))
+ (if (not (vequal v1 (float-vector 1.000 0.602 -0.067 -0.242 -0.007 0.071 -0.087 -0.128 -0.007 0.012)))
(snd-display #__line__ ";ws nrxycos output: ~A" v1)))
-
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat)))
- (pad-channel 0 1000)
- (let ((gen (make-cosine-summation 100.0)))
- (map-channel (lambda (y) (* .2 (cosine-summation gen 0.5))))
- (let ((vals (channel->vct 280 10)))
- (if (not (vequal vals (vct 0.191 0.187 0.181 0.176 0.169 0.163 0.156 0.148 0.141 0.133)))
- (snd-display #__line__ ";cosine-summation: ~A" vals)))
- (undo))
-
- (let ((gen (make-kosine-summation 100.0)))
- (map-channel (lambda (y) (* .2 (kosine-summation gen 0.5 1.0))))
- (let ((vals (channel->vct 280 10)))
- (if (not (vequal vals (vct 0.194 0.191 0.188 0.184 0.180 0.175 0.170 0.166 0.160 0.155)))
- (snd-display #__line__ ";kosine-summation 1: ~A" vals)))
- (undo))
- (let ((gen (make-kosine-summation 100.0)))
- (map-channel (lambda (y) (* .2 (kosine-summation gen 0.5 3.0))))
- (let ((vals (channel->vct 280 10)))
- (if (not (vequal vals (vct 0.182 0.174 0.165 0.155 0.145 0.134 0.124 0.113 0.103 0.094)))
- (snd-display #__line__ ";kosine-summation 3: ~A" vals)))
- (undo))
-
- (let ((angle 0.0)
- (v (make-vct 20)))
- (do ((i 0 (+ 1 i)))
- ((= i 20))
- (vct-set! v i (fejer-sum angle 3))
- (set! angle (+ angle .1)))
- (if (not (vequal v (vct 1.000 0.988 0.951 0.892 0.815 0.723 0.622 0.516 0.412 0.313 0.225 0.150 0.089 0.045 0.017 0.003 0.000 0.007 0.020 0.035)))
- (snd-display #__line__ ";fejer-sum: ~A" v)))
-
- (for-each
- (lambda (n)
- (let ((mx 0.0)
- (angle 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 300))
- (set! mx (max mx (fejer-sum angle n)))
- (set! angle (+ angle .01)))
- (if (fneq mx 1.0) (snd-display #__line__ ";fejer-sum maxamp ~D: ~A" n mx))))
- (list 1 4 9 16 32 100))
-
- (let ((angle 0.0)
- (v (make-vct 20)))
- (do ((i 0 (+ 1 i)))
- ((= i 20))
- (vct-set! v i (poussin-sum angle 3))
- (set! angle (+ angle .1)))
- (if (not (vequal v (vct 1.000 0.910 0.663 0.323 -0.024 -0.301 -0.458 -0.486 -0.411 -0.281 -0.147 -0.046 0.008 0.021 0.013 0.003 0.000 0.006 0.012 0.009)))
- (snd-display #__line__ ";poussin-sum: ~A" v)))
-
- (for-each
- (lambda (n)
- (let ((mx 0.0)
- (angle 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 300))
- (set! mx (max mx (poussin-sum angle n)))
- (set! angle (+ angle .01)))
- (if (fneq mx 1.0) (snd-display #__line__ ";poussin-sum maxamp ~D: ~A" n mx))))
- (list 1 4 9 16 32 100))
-
- (let ((angle 0.0)
- (v (make-vct 20)))
- (do ((i 0 (+ 1 i)))
- ((= i 20))
- (vct-set! v i (jackson-sum angle 3))
- (set! angle (+ angle .1)))
- (if (not (vequal v (vct 1.000 0.975 0.904 0.796 0.664 0.523 0.386 0.266 0.170 0.098 0.051 0.022 0.008 0.002 0.000 0.000 0.000 0.000 0.000 0.001)))
- (snd-display #__line__ ";jackson-sum: ~A" v)))
-
- (for-each
- (lambda (n)
- (let ((mx 0.0)
- (angle 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 300))
- (set! mx (max mx (jackson-sum angle n)))
- (set! angle (+ angle .01)))
- (if (fneq mx 1.0) (snd-display #__line__ ";jackson-sum maxamp ~D: ~A" n mx))))
- (list 1 4 9 16 32 100))
-
- (let ((angle 0.0)
- (v (make-vct 20)))
- (do ((i 0 (+ 1 i)))
- ((= i 20))
- (vct-set! v i (legendre-sum angle 3))
- (set! angle (+ angle .1)))
- (if (not (vequal v (vct 1.000 0.961 0.850 0.688 0.502 0.323 0.174 0.071 0.015 0.000 0.011 0.032 0.049 0.054 0.047 0.032 0.016 0.004 0.000 0.004)))
- (snd-display #__line__ ";legendre-sum: ~A" v)))
-
- (for-each
- (lambda (n)
- (let ((mx 0.0)
- (angle 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 300))
- (set! mx (max mx (legendre-sum angle n)))
- (set! angle (+ angle .01)))
- (if (fneq mx 1.0) (snd-display #__line__ ";legendre-sum maxamp ~D: ~A" n mx))))
- (list 1 4 9 16 32 100))
-
-
- (let ((angle 0.0))
- (map-channel (lambda (y)
- (let ((val (band-limited-sawtooth angle 0.5 8 .2)))
- (set! angle (+ angle .2))
- val))))
- (let ((vals (channel->vct 10 10)))
- (if (not (vequal vals (vct -0.118 -0.073 -0.035 0.012 0.062 0.106 0.142 0.185 0.237 0.288)))
- (snd-display #__line__ ";band-limited-sawtooth: ~A" vals)))
- (undo)
-
- (let ((angle 0.0))
- (map-channel (lambda (y)
- (let ((val (band-limited-square-wave angle 10)))
- (set! angle (+ angle .2))
- val))))
- (let ((vals (channel->vct 10 10)))
- (if (not (vequal vals (vct 1.000 1.000 1.000 1.000 0.998 0.888 -0.525 -0.988 -1.000 -1.000)))
- (snd-display #__line__ ";band-limited-square-wave: ~A" vals)))
- (undo)
-
- (let ((angle 0.0))
- (map-channel (lambda (y) (let ((val (sum-of-n-sines angle 3))) (set! angle (+ angle .1)) (* .1 val))))
- (let ((vals (channel->vct 260 10)))
- (if (not (vequal vals (vct 0.226 0.200 0.166 0.129 0.091 0.056 0.025 0.001 -0.015 -0.023)))
- (snd-display #__line__ ";sum-of-n-sines: ~A" vals)))
- (undo))
- (let ((angle 0.0))
- (map-channel (lambda (y) (let ((val (sum-of-n-odd-sines angle 3))) (set! angle (+ angle .1)) (* .1 val))))
- (let ((vals (channel->vct 260 10)))
- (if (not (vequal vals (vct 0.035 0.007 0.000 0.014 0.039 0.069 0.091 0.100 0.092 0.070)))
- (snd-display #__line__ ";sum-of-n-odd-sines: ~A" vals)))
- (undo))
- (let ((angle 0.0))
- (map-channel (lambda (y) (let ((val (sum-of-n-odd-cosines angle 3))) (set! angle (+ angle .1)) (* .1 val))))
- (let ((vals (channel->vct 250 10)))
- (if (not (vequal vals (vct 0.270 0.298 0.292 0.253 0.189 0.112 0.037 -0.024 -0.061 -0.072)))
- (snd-display #__line__ ";sum-of-n-odd-cosines: ~A" vals)))
- (undo))
- (close-sound ind))
-
(let ((gen (make-asymmetric-fm 440.0))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-asymmetric-fm 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"asymmetric-fm"
"asymmetric-fm freq: 440.000Hz, phase: 0.000, ratio: 1.000, r: 1.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (asymmetric-fm gen 0.0)))
- (vct-map! v1 (lambda () (if (asymmetric-fm? gen1) (asymmetric-fm gen1 0.0) -1.0)))
+ (set! (v0 i) (asymmetric-fm gen 0.0)))
+ (fill-float-vector v1 (if (asymmetric-fm? gen1) (asymmetric-fm gen1 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map asymmetric-fm: ~A ~A" v0 v1))
(if (not (asymmetric-fm? gen)) (snd-display #__line__ ";~A not asymmetric-fm?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";asymmetric-fm phase: ~F?" (mus-phase gen)))
@@ -19393,7 +14447,7 @@ EDITS: 2
(if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";asymmetric-fm frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
(if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";set! asymmetric-fm frequency: ~F?" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 2) 0.969) (fneq (vct-ref v0 8) .538)) (snd-display #__line__ ";asymmetric-fm output: ~A" v0))
+ (if (or (fneq (v0 2) 0.969) (fneq (v0 8) .538)) (snd-display #__line__ ";asymmetric-fm output: ~A" v0))
(if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";mus-scaler (r) asymmetric-fm: ~A" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
(if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";mus-scaler (set r) asymmetric-fm: ~A" (mus-scaler gen)))
@@ -19406,9 +14460,9 @@ EDITS: 2
(let ((gen1 (make-asymmetric-fm 1000 0 1.0 0.1))
(gen2 (make-oscil 1000 :initial-phase (* 0.5 pi)))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 100)))
- (let ((ss (asymmetric-fm gen1 0.0 0.0))
+ (let ((ss (asymmetric-fm gen1 0.0))
(os (oscil gen2 0.0)))
(if (fneq ss os)
(begin
@@ -19419,123 +14473,329 @@ EDITS: 2
(lambda (index)
(for-each
(lambda (r)
- (let ((peak (vct-peak (with-sound (:clipped #f :output (make-vct 1000))
+ (let ((peak (float-vector-peak (with-sound (:clipped #f :output (make-float-vector 1000))
(let ((gen (make-asymmetric-fm 2000.0 :ratio .1 :r r)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (outa i (asymmetric-fm gen index)))))))))
+ (outa i (asymmetric-fm gen index))))))))
(if (> (abs (- peak 1.0)) .1)
(snd-display #__line__ ";asymmetric-fm peak: ~A, index: ~A, r: ~A" peak index r))))
(list -10.0 -1.5 -0.5 0.5 1.0 1.5 10.0)))
(list 1.0 3.0 10.0))
- (let ((vct0 (make-vct 2048))
- (vct1 (make-vct 2048))
+ (let ((float-vector0 (make-float-vector 2048))
+ (float-vector1 (make-float-vector 2048))
(gen3 (make-asymmetric-fm 1000 0 1.0 0.2))
(gen4 (make-oscil 1000 (* 0.5 pi)))
(gen5 (make-oscil 200))
(fm1 (hz->radians (* 1.0 .2 1000)))) ; make notions of "index" match
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 2048))
- (vct-set! vct0 i (asymmetric-fm gen3 1.0 0.0))
- (vct-set! vct1 i (oscil gen4 (* fm1 (oscil gen5)))))
- (let* ((spectr1 (snd-spectrum vct0 rectangular-window 2048 #t))
- (spectr2 (snd-spectrum vct1 rectangular-window 2048 #t))
- (happy #t))
- (do ((i 1 (+ 1 i)))
+ (set! (float-vector0 i) (asymmetric-fm gen3 1.0))
+ (set! (float-vector1 i) (oscil gen4 (* fm1 (oscil gen5)))))
+ (let ((spectr1 (snd-spectrum float-vector0 rectangular-window 2048 #t))
+ (spectr2 (snd-spectrum float-vector1 rectangular-window 2048 #t))
+ (happy #t))
+ (do ((i 1 (+ i 1)))
((or (not happy)
(= i 512)))
- (if (> (abs (- (vct-ref spectr1 i) (vct-ref spectr2 i))) .02)
+ (if (> (abs (- (spectr1 i) (spectr2 i))) .02)
(begin
- (snd-display #__line__ ";asymmetric-fm 2: ~A: ~A ~A" i (vct-ref spectr1 i) (vct-ref spectr2 i))
+ (snd-display #__line__ ";asymmetric-fm 2: ~A: ~A ~A" i (spectr1 i) (spectr2 i))
(set! happy #f))))))
(let ((gen (make-asymmetric-fm 40.0 0.0 1.0 0.1))
- (gen1 (make-asyfm :frequency 40.0 :ratio .1 :index 2.0)))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 40.0) (mus-srate))))) ;22050.0))))
- ((= i 1100))
- (let* ((val1 (asymmetric-fm gen 2.0)) ; 1.0=index
- (val3 (asyfm-J gen1 0.0))
- (r 1.0)
- (ratio 0.1)
- (index 2.0)
- ;; (freq (hz->radians 40.0))
- ;; (phase a)
- (cr (* 0.5 (- r (/ 1.0 r))))
- (sr (* 0.5 (+ r (/ 1.0 r))))
- (th a)
- (mth (* ratio th))
- (val2 (* (exp (* index cr (+ 1.0 (cos mth))))
- (cos (+ th (* index sr (sin mth)))))))
- (if (or (fneq val1 val2)
- (fneq val1 val3))
- (snd-display #__line__ ";asyfm by hand: ~A: ~A ~A ~A" i val1 val2 val3)))))
-
- (let ((vct0 (make-vct 2048))
- (vct1 (make-vct 2048))
+ (gen1 (make-asyfm :frequency 40.0 :ratio .1 :index 2.0))
+ (incr (/ (* 2 pi 40.0) *clm-srate*))
+ (r 1.0)
+ (ratio 0.1)
+ (index 2.0))
+ (let ((cr (* 0.5 (- r (/ 1.0 r))))
+ (sr (* 0.5 (+ r (/ 1.0 r)))))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
+ ((= i 1100))
+ (let ((val1 (asymmetric-fm gen 2.0)) ; 1.0=index
+ (val3 (asyfm-J gen1 0.0))
+ (mth (* ratio a)))
+ (let ((val2 (* (exp (* index cr (+ 1.0 (cos mth))))
+ (cos (+ a (* index sr (sin mth)))))))
+ (if (or (fneq val1 val2)
+ (fneq val1 val3))
+ (snd-display #__line__ ";asyfm by hand: ~A: ~A ~A ~A" i val1 val2 val3)))))))
+
+ (let ((float-vector0 (make-float-vector 2048))
+ (float-vector1 (make-float-vector 2048))
(gen3 (make-asymmetric-fm 1000 0 2.0 0.1))
(gen4 (make-asymmetric-fm 1000 0 0.5 0.1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 2048))
- (vct-set! vct0 i (asymmetric-fm gen3 2.0 0.0))
- (vct-set! vct1 i (asymmetric-fm gen4 2.0 0.0)))
- (let* ((spectr1 (snd-spectrum vct0 rectangular-window 2048 #t))
- (spectr2 (snd-spectrum vct1 rectangular-window 2048 #t))
- (s1-loc 0)
- (s2-loc 0))
- (do ((i 1 (+ 1 i)))
+ (set! (float-vector0 i) (asymmetric-fm gen3 2.0))
+ (set! (float-vector1 i) (asymmetric-fm gen4 2.0)))
+ (let ((spectr1 (snd-spectrum float-vector0 rectangular-window 2048 #t))
+ (spectr2 (snd-spectrum float-vector1 rectangular-window 2048 #t))
+ (s1-loc 0)
+ (s2-loc 0))
+ (do ((i 1 (+ i 1)))
((= i 256))
- (if (< (abs (- 1.0 (vct-ref spectr1 i))) .01) (set! s1-loc i))
- (if (< (abs (- 1.0 (vct-ref spectr2 i))) .01) (set! s2-loc i)))
+ (if (< (abs (- 1.0 (spectr1 i))) .01) (set! s1-loc i))
+ (if (< (abs (- 1.0 (spectr2 i))) .01) (set! s2-loc i)))
(if (> s2-loc s1-loc) (snd-display #__line__ ";asymmetric-fm peaks: ~A ~A" s1-loc s2-loc))
- (let ((center (* (/ 22050 2048) (* .5 (+ s1-loc s2-loc)))))
+ (let ((center (* (/ 22050 2048) .5 (+ s1-loc s2-loc))))
(if (> (abs (- 1000 center)) 60) (snd-display #__line__ ";asymmetric-fm center: ~A" center)))
(set! (mus-scaler gen3) 0.5)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 2048))
- (vct-set! vct0 i (asymmetric-fm gen3 2.0 0.0)))
- (set! spectr1 (snd-spectrum vct0 rectangular-window 2048 #t))
- (do ((i 1 (+ 1 i)))
+ (set! (float-vector0 i) (asymmetric-fm gen3 2.0)))
+ (set! spectr1 (snd-spectrum float-vector0 rectangular-window 2048 #t))
+ (do ((i 1 (+ i 1)))
((= i 256))
- (if (< (abs (- 1.0 (vct-ref spectr1 i))) .01) (set! s1-loc i)))
- (if (not (= s2-loc s1-loc)) (snd-print (format #f "asymmetric-fm set r peaks: ~A ~A" s1-loc s2-loc)))
- (do ((i 0 (+ 1 i)))
+ (if (< (abs (- 1.0 (spectr1 i))) .01) (set! s1-loc i)))
+ (if (not (= s2-loc s1-loc)) (snd-display #__line__ ";asymmetric-fm set r peaks: ~A ~A" s1-loc s2-loc))
+ (do ((i 0 (+ i 1)))
((= i 2048))
- (vct-set! vct0 i (asymmetric-fm gen3 2.0 0.0)))
- (snd-spectrum vct0 rectangular-window 2048 #t 0.0 #t)
- (do ((i 1 (+ 1 i)))
+ (set! (float-vector0 i) (asymmetric-fm gen3 2.0)))
+ (snd-spectrum float-vector0 rectangular-window 2048 #t 0.0 #t)
+ (do ((i 1 (+ i 1)))
((= i 256))
- (if (< (abs (- 1.0 (vct-ref vct0 i))) .01) (set! s1-loc i)))
- (if (not (= s2-loc s1-loc)) (snd-print (format #f "asymmetric-fm set r in place peaks: ~A ~A" s1-loc s2-loc)))))
+ (if (< (abs (- 1.0 (float-vector0 i))) .01) (set! s1-loc i)))
+ (if (not (= s2-loc s1-loc)) (snd-display #__line__ "asymmetric-fm set r in place peaks: ~A ~A" s1-loc s2-loc))))
(let ((gen (make-asyfm :frequency 2000 :ratio .1)))
(asyfm-I gen 0.0))
- (let ((gen (make-fir-filter 3 (list->vct '(.5 .25 .125))))
- (v0 (make-vct 10))
- (gen1 (make-fir-filter 3 (list->vct '(.5 .25 .125))))
- (v1 (make-vct 10)))
+ (do ((i 2 (+ i 1)))
+ ((= i 40))
+ (let ((v (make-float-vector i)))
+ (do ((k 0 (+ k 1)))
+ ((= k i))
+ (set! (v k) (expt 1.2 (- k))))
+ (let ((f (make-fir-filter i v)))
+ (do ((k 0 (+ k 1))
+ (x 1.0 0.0))
+ ((= k i))
+ (let ((val (fir-filter f x))
+ (exval (expt 1.2 (- k))))
+ (if (> (abs (- val exval)) 1e-12)
+ (format *stderr* ";for-filter ~D at ~D: ~A ~A~%" i k val exval)))))))
+
+ (let ((f (make-fir-filter 3 (float-vector 1.0 .5 .25)))
+ (v (make-float-vector 10)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 5))
+ (set! (v i) (f 0.0)))
+ (set! (v 5) (f 1.0))
+ (do ((i 6 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.0 0.5 .25 0.0 0.0 1.0 0.5 .25 0.0 0.0)))
+ (format *stderr* ";f3: ~A~%" v)))
+
+ (let ((f (make-fir-filter 7 (float-vector .7 .6 .5 .4 .3 .2 .1)))
+ (v (make-float-vector 10)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector .7 .6 .5 .4 .3 .2 .1 0.0 0.0 0.0)))
+ (format *stderr* ";f7: ~A~%" v)))
+
+
+ (let ((f (make-iir-filter 3 (float-vector 1.0 .5 .25)))
+ (v (make-float-vector 10)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 5))
+ (set! (v i) (f 0.0)))
+ (set! (v 5) (f 1.0))
+ (do ((i 6 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.0 -0.5 0.0 0.125 -0.0625 1.0 -0.484375 -0.0078125 0.125 -0.060546875)))
+ (format *stderr* ";i3: ~A~%" v)))
+
+
+ (let ((f (make-iir-filter 7 (float-vector .7 .6 .5 .4 .3 .2 .1)))
+ (v (make-float-vector 30)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 30))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.000000 -0.600000 -0.140000 -0.016000 0.019600 0.032240 0.039256 0.045286
+ -0.048376 -0.021312 -0.001324 0.006140 0.007033 0.004780 0.000657 -0.005043
+ -0.002420 0.000256 0.001217 0.001013 0.000350 -0.000292 -0.000579 -0.000219
+ 0.000109 0.000192 0.000115 0.000002 -0.000067 -0.000065)))
+ (begin
+ (format *stderr* ";i7: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%"))))
+
+ (let ((x (make-float-vector 3))
+ (y (make-float-vector 3)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (set! (x i) (expt 1.2 (- i)))
+ (set! (y i) (expt 1.5 (- i))))
+
+ (let ((f (make-filter 3 x y))
+ (v (make-float-vector 10)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.000000 0.166667 0.138889 -0.166667 0.049383 0.041152 -0.049383 0.014632 0.012193 -0.014632)))
+ (begin
+ (format *stderr* ";g3: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%")))))
+
+ (let ((x (make-float-vector 9))
+ (y (make-float-vector 9)))
+ (do ((i 0 (+ i 1)))
+ ((= i 9))
+ (set! (x i) (expt 1.2 (- i)))
+ (set! (y i) (expt 1.2 (- i))))
+
+ (let ((f (make-filter 9 x y))
+ (v (make-float-vector 30)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 30))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
+ 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (begin
+ (format *stderr* ";g9: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%")))))
+
+ (let ((x (make-float-vector 9))
+ (y (make-float-vector 9)))
+ (do ((i 0 (+ i 1)))
+ ((= i 9))
+ (set! (x i) (expt 1.2 (- i)))
+ (set! (y i) (expt 1.5 (- i))))
+
+ (let ((f (make-filter 9 x y))
+ (v (make-float-vector 30)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 30))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.000000 0.166667 0.138889 0.115741 0.096451 0.080376 0.066980 0.055816 0.046514
+ -0.129033 0.004335 0.003613 0.003011 0.002509 0.002091 0.001742 0.001452 0.001210
+ -0.003356 0.000113 0.000094 0.000078 0.000065 0.000054 0.000045 0.000038 0.000031
+ -0.000087 0.000003 0.000002)))
+ (begin
+ (format *stderr* ";g9e: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%")))))
+
+ (let ((x (make-float-vector 8))
+ (y (make-float-vector 8)))
+ (do ((i 0 (+ i 1)))
+ ((= i 8))
+ (set! (x i) (expt 1.5 (- i)))
+ (set! (y i) (expt 1.2 (- i))))
+
+ (let ((f (make-filter 8 x y))
+ (v (make-float-vector 30)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 30))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632
+ 0.183795 -0.038761 -0.025841 -0.017227 -0.011485 -0.007657 -0.005104 -0.003403
+ 0.042745 -0.009015 -0.006010 -0.004007 -0.002671 -0.001781 -0.001187 -0.000791
+ 0.009941 -0.002097 -0.001398 -0.000932 -0.000621 -0.000414)))
+ (begin
+ (format *stderr* ";g-8: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%")))))
+
+ (let ((x (make-float-vector 18))
+ (y (make-float-vector 18)))
+ (do ((i 0 (+ i 1)))
+ ((= i 18))
+ (set! (x i) (expt 1.5 (- i)))
+ (set! (y i) (expt 1.2 (- i))))
+
+ (let ((f (make-filter 18 x y))
+ (v (make-float-vector 30)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 30))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922 -0.021948 -0.014632 -0.009755
+ -0.006503 -0.004335 -0.002890 -0.001927 -0.001285 -0.000856 -0.000571 -0.000381 -0.000254
+ 0.036715 -0.006260 -0.004173 -0.002782 -0.001855 -0.001237 -0.000824 -0.000550 -0.000366
+ -0.000244 -0.000163 -0.000109)))
+ (begin
+ (format *stderr* ";g-18: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%")))))
+
+ (let ((x (make-float-vector 9))
+ (y (make-float-vector 9)))
+ (do ((i 0 (+ i 1)))
+ ((= i 9))
+ (set! (x i) (expt 1.5 (- i)))
+ (set! (y i) (expt 1.2 (- i))))
+
+ (let ((f (make-filter 9 x y))
+ (v (make-float-vector 30)))
+ (set! (v 0) (f 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i 30))
+ (set! (v i) (f 0.0)))
+ (if (not (mus-arrays-equal? v (float-vector 1.000000 -0.166667 -0.111111 -0.074074 -0.049383 -0.032922
+ -0.021948 -0.014632 -0.009755 0.161291 -0.032301 -0.021534
+ -0.014356 -0.009571 -0.006380 -0.004254 -0.002836 -0.001891
+ 0.031259 -0.006260 -0.004173 -0.002782 -0.001855 -0.001237
+ -0.000824 -0.000550 -0.000366 0.006058 -0.001213 -0.000809)))
+ (begin
+ (format *stderr* ";g-9: ")
+ (do ((i 0 (+ i 1)))
+ ((= i 30))
+ (format *stderr* "~,6f " (v i)))
+ (format *stderr* "~%")))))
+
+
+ (let ((gen (make-fir-filter 3 (float-vector .5 .25 .125)))
+ (v0 (make-float-vector 10))
+ (gen1 (make-fir-filter 3 (float-vector .5 .25 .125)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"fir-filter"
- "fir-filter order: 3, xs: [0.500 0.250 0.125]"
+ "fir-filter order: 3, xs: [0.5 0.25 0.125]"
)
- (vct-set! v0 0 (fir-filter gen 1.0))
- (do ((i 1 (+ 1 i)))
+ (set! (v0 0) (fir-filter gen 1.0))
+ (do ((i 1 (+ i 1)))
((= i 10))
- (vct-set! v0 i (fir-filter gen 0.0)))
- (vct-map! v1 (let ((inp 1.0))
- (lambda ()
- (let ((val (if (fir-filter? gen1) (fir-filter gen1 inp) -1.0)))
- (set! inp 0.0)
- val))))
+ (set! (v0 i) (fir-filter gen 0.0)))
+ (let ((inp 1.0))
+ (fill-float-vector v1 (let ((val (if (fir-filter? gen1) (fir-filter gen1 inp) -1.0)))
+ (set! inp 0.0)
+ val)))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map fir-filter: ~A ~A" v0 v1))
(if (not (fir-filter? gen)) (snd-display #__line__ ";~A not fir-filter?" gen))
(if (not (= (mus-length gen) 3)) (snd-display #__line__ ";fir-filter length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.25) (fneq (vct-ref v0 2) .125)) (snd-display #__line__ ";fir-filter output: ~A" v0))
+ (if (or (fneq (v0 1) 0.25) (fneq (v0 2) .125)) (snd-display #__line__ ";fir-filter output: ~A" v0))
(let ((data (mus-xcoeffs gen)))
- (if (fneq (vct-ref data 1) .25) (snd-display #__line__ ";fir-filter xcoeffs: ~A?" data)))
+ (if (fneq (data 1) .25) (snd-display #__line__ ";fir-filter xcoeffs: ~A?" data)))
(let ((tag (catch #t (lambda () (mus-xcoeff gen 123)) (lambda args (car args)))))
(if (not (eq? tag 'mus-error))
(snd-display #__line__ ";xcoeff 123: ~A" tag)))
@@ -19543,49 +14803,48 @@ EDITS: 2
(if (not (eq? tag 'mus-error))
(snd-display #__line__ ";fir ycoeff 123: ~A" tag))))
- (test-gen-equal (let ((f1 (make-fir-filter 3 (list->vct '(.5 .25 .125))) )) (fir-filter f1 1.0) f1)
- (let ((f2 (make-fir-filter 3 (list->vct '(.5 .25 .125))) )) (fir-filter f2 1.0) f2)
- (let ((f3 (make-fir-filter 3 (list->vct '(.75 .25 .125))))) (fir-filter f3 1.0) f3))
- (test-gen-equal (let ((f1 (make-fir-filter 3 (list->vct '(.5 .25 .125))) )) (fir-filter f1 1.0) f1)
- (let ((f2 (make-fir-filter 3 (list->vct '(.5 .25 .125))) )) (fir-filter f2 1.0) f2)
- (let ((f3 (make-fir-filter 2 (list->vct '(.5 .25))))) (fir-filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-fir-filter 3 (float-vector .5 .25 .125)) )) (fir-filter f1 1.0) f1)
+ (let ((f2 (make-fir-filter 3 (float-vector .5 .25 .125)) )) (fir-filter f2 1.0) f2)
+ (let ((f3 (make-fir-filter 3 (float-vector .75 .25 .125)))) (fir-filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-fir-filter 3 (float-vector .5 .25 .125)) )) (fir-filter f1 1.0) f1)
+ (let ((f2 (make-fir-filter 3 (float-vector .5 .25 .125)) )) (fir-filter f2 1.0) f2)
+ (let ((f3 (make-fir-filter 2 (float-vector .5 .25)))) (fir-filter f3 1.0) f3))
- (let* ((coeffs (list .1 .2 .3 .4 .4 .3 .2 .1))
- (flt (make-fir-filter 8 (list->vct coeffs)))
+ (let* ((coeffs (float-vector .1 .2 .3 .4 .4 .3 .2 .1))
+ (flt (make-fir-filter 8 coeffs))
+ (xcof (mus-xcoeffs flt))
(es (make-vector 8)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vector-set! es i (make-env (list 0 (list-ref coeffs i) 1 0) :length 102)))
- (vector-set! es 5 (make-env '(0 .4 1 1) :length 102))
- (let ((data (make-vct 100)))
- (do ((k 0 (+ 1 k)))
+ (set! (es i) (make-env (list 0 (coeffs i) 1 0) :length 102)))
+ (set! (es 5) (make-env '(0 .4 1 1) :length 102))
+ (let ((data (make-float-vector 100)))
+ (do ((k 0 (+ k 1)))
((= k 100))
- (let ((val (fir-filter flt (if (= (modulo k 12) 0) 1.0 0.0)))
- (xcof (mus-xcoeffs flt)))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (vct-set! xcof i (env (vector-ref es i))))
- (vct-set! data k val)))
- (if (or (fneq (vct-ref data 1) .2)
- (fneq (vct-ref data 10) 0.0)
- (fneq (vct-ref data 18) 0.166)
- (fneq (vct-ref data 89) 0.923))
+ (set! (data k) (fir-filter flt (if (= (modulo k 12) 0) 1.0 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 8))
+ (float-vector-set! xcof i (env (vector-ref es i)))))
+ (if (or (fneq (data 1) .2)
+ (fneq (data 10) 0.0)
+ (fneq (data 18) 0.166)
+ (fneq (data 89) 0.923))
(snd-display #__line__ ";filter xcoeffs: ~A?" data))))
(letrec ((make-f-filter (lambda (coeffs)
- (list coeffs (make-vct (vct-length coeffs)))))
+ (list coeffs (make-float-vector (length coeffs)))))
(f-filter (lambda (flt x)
(let* ((coeffs (car flt))
(xs (cadr flt))
- (xlen (vct-length xs)))
- (vct-move! xs (- xlen 1) (- xlen 2) #t)
- (vct-set! xs 0 x)
+ (xlen (length xs)))
+ (float-vector-move! xs (- xlen 1) (- xlen 2) #t)
+ (set! (xs 0) x)
(dot-product coeffs xs xlen)))))
- (let ((fir1 (make-fir-filter 3 (vct 1.0 0.4 0.1)))
- (fir2 (make-f-filter (vct 1.0 0.4 0.1)))
+ (let ((fir1 (make-fir-filter 3 (float-vector 1.0 0.4 0.1)))
+ (fir2 (make-f-filter (float-vector 1.0 0.4 0.1)))
(x 1.0)
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 10)))
(let ((val1 (fir-filter fir1 x))
(val2 (f-filter fir2 x)))
@@ -19600,47 +14859,46 @@ EDITS: 2
(snd-display #__line__ ";make-spencer-filter returns ~A?" gen)
(begin
(if (not (= (mus-order gen) 15)) (snd-display #__line__ ";make-spencer-filter order ~A?" (mus-order gen)))
- (if (not (vequal (mus-xcoeffs gen) (vct -0.009 -0.019 -0.016 0.009 0.066 0.144 0.209 0.231 0.209 0.144 0.066 0.009 -0.016 -0.019 -0.009)))
+ (if (not (vequal (mus-xcoeffs gen) (float-vector -0.009 -0.019 -0.016 0.009 0.066 0.144 0.209 0.231 0.209 0.144 0.066 0.009 -0.016 -0.019 -0.009)))
(snd-display #__line__ ";make-spencer-filter coeffs: ~A" (mus-xcoeffs gen))))))
(let ((flt (make-savitzky-golay-filter 5 2)))
- (if (not (vequal (mus-xcoeffs flt) (vct -0.086 0.343 0.486 0.343 -0.086)))
+ (if (not (vequal (mus-xcoeffs flt) (float-vector -0.086 0.343 0.486 0.343 -0.086)))
(snd-display #__line__ ";sg 5 2: ~A" (mus-xcoeffs flt))))
(let ((flt (make-savitzky-golay-filter 11 2)))
- (if (not (vequal (mus-xcoeffs flt) (vct -0.084 0.021 0.103 0.161 0.196 0.207 0.196 0.161 0.103 0.021 -0.084)))
+ (if (not (vequal (mus-xcoeffs flt) (float-vector -0.084 0.021 0.103 0.161 0.196 0.207 0.196 0.161 0.103 0.021 -0.084)))
(snd-display #__line__ ";sg 11 2: ~A" (mus-xcoeffs flt))))
(let ((flt (make-savitzky-golay-filter 11 4)))
- (if (not (vequal (mus-xcoeffs flt) (vct 0.042 -0.105 -0.023 0.140 0.280 0.333 0.280 0.140 -0.023 -0.105 0.042)))
+ (if (not (vequal (mus-xcoeffs flt) (float-vector 0.042 -0.105 -0.023 0.140 0.280 0.333 0.280 0.140 -0.023 -0.105 0.042)))
(snd-display #__line__ ";sg 11 4: ~A" (mus-xcoeffs flt))))
(let ((flt (make-savitzky-golay-filter 25 2)))
- (if (not (vequal (mus-xcoeffs flt) (vct -0.049 -0.027 -0.006 0.012 0.028 0.043 0.055 0.066 0.075 0.082 0.086
+ (if (not (vequal (mus-xcoeffs flt) (float-vector -0.049 -0.027 -0.006 0.012 0.028 0.043 0.055 0.066 0.075 0.082 0.086
0.089 0.090 0.089 0.086 0.082 0.075 0.066 0.055 0.043
0.028 0.012 -0.006 -0.027 -0.049)))
(snd-display #__line__ ";sg 25 2: ~A" (mus-xcoeffs flt))))
- (let ((gen (make-iir-filter 3 (list->vct '(.5 .25 .125))))
- (v0 (make-vct 10))
- (gen1 (make-iir-filter 3 (list->vct '(.5 .25 .125))))
- (v1 (make-vct 10)))
+ (let ((gen (make-iir-filter 3 (float-vector .5 .25 .125)))
+ (v0 (make-float-vector 10))
+ (gen1 (make-iir-filter 3 (float-vector .5 .25 .125)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"iir-filter"
- "iir-filter order: 3, ys: [0.500 0.250 0.125]"
+ "iir-filter order: 3, ys: [0.5 0.25 0.125]"
)
- (vct-set! v0 0 (iir-filter gen 1.0))
- (do ((i 1 (+ 1 i)))
+ (set! (v0 0) (iir-filter gen 1.0))
+ (do ((i 1 (+ i 1)))
((= i 10))
- (vct-set! v0 i (iir-filter gen 0.0)))
- (vct-map! v1 (let ((inp 1.0))
- (lambda ()
- (let ((val (if (iir-filter? gen1) (iir-filter gen1 inp) -1.0)))
- (set! inp 0.0)
- val))))
+ (set! (v0 i) (iir-filter gen 0.0)))
+ (let ((inp 1.0))
+ (fill-float-vector v1 (let ((val (if (iir-filter? gen1) (iir-filter gen1 inp) -1.0)))
+ (set! inp 0.0)
+ val)))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map iir-filter: ~A ~A" v0 v1))
(if (not (iir-filter? gen)) (snd-display #__line__ ";~A not iir-filter?" gen))
(if (not (= (mus-length gen) 3)) (snd-display #__line__ ";iir-filter length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) -0.25) (fneq (vct-ref v0 2) -.062)) (snd-display #__line__ ";iir-filter output: ~A" v0))
+ (if (or (fneq (v0 1) -0.25) (fneq (v0 2) -.062)) (snd-display #__line__ ";iir-filter output: ~A" v0))
(let ((data (mus-ycoeffs gen)))
- (if (fneq (vct-ref data 1) .25) (snd-display #__line__ ";iir-filter ycoeffs: ~A?" data)))
+ (if (fneq (data 1) .25) (snd-display #__line__ ";iir-filter ycoeffs: ~A?" data)))
(let ((tag (catch #t (lambda () (mus-ycoeff gen 123)) (lambda args (car args)))))
(if (not (eq? tag 'mus-error))
(snd-display #__line__ ";ycoeff 123: ~A" tag)))
@@ -19648,144 +14906,147 @@ EDITS: 2
(if (not (eq? tag 'mus-error))
(snd-display #__line__ ";iir xcoeff 123: ~A" tag))))
- (test-gen-equal (let ((f1 (make-iir-filter 3 (list->vct '(.5 .25 .125))))) (iir-filter f1 1.0) f1)
- (let ((f2 (make-iir-filter 3 (list->vct '(.5 .25 .125))) )) (iir-filter f2 1.0) f2)
- (let ((f3 (make-iir-filter 3 (list->vct '(.75 .25 .125))))) (iir-filter f3 1.0) f3))
- (test-gen-equal (let ((f1 (make-iir-filter 3 (list->vct '(.5 .25 .125))) )) (iir-filter f1 1.0) f1)
- (let ((f2 (make-iir-filter 3 (list->vct '(.5 .25 .125))) )) (iir-filter f2 1.0) f2)
- (let ((f3 (make-iir-filter 2 (list->vct '(.5 .25))))) (iir-filter f3 1.0) f3))
-
- (let ((gen (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .25 .125))))
- (v0 (make-vct 10))
- (gen1 (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .25 .125))))
- (v1 (make-vct 10))
+ (test-gen-equal (let ((f1 (make-iir-filter 3 (float-vector .5 .25 .125)))) (iir-filter f1 1.0) f1)
+ (let ((f2 (make-iir-filter 3 (float-vector .5 .25 .125)) )) (iir-filter f2 1.0) f2)
+ (let ((f3 (make-iir-filter 3 (float-vector .75 .25 .125)))) (iir-filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-iir-filter 3 (float-vector .5 .25 .125)) )) (iir-filter f1 1.0) f1)
+ (let ((f2 (make-iir-filter 3 (float-vector .5 .25 .125)) )) (iir-filter f2 1.0) f2)
+ (let ((f3 (make-iir-filter 2 (float-vector .5 .25)))) (iir-filter f3 1.0) f3))
+
+ (let ((gen (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))
+ (v0 (make-float-vector 10))
+ (gen1 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))
+ (v1 (make-float-vector 10))
(gen2 (make-biquad .1 .2 .3 .4 .5)))
(print-and-check gen
"filter"
- "filter order: 3, xs: [0.500 0.250 0.125], ys: [0.500 0.250 0.125]"
+ "filter order: 3, xs: [0.5 0.25 0.125], ys: [0.5 0.25 0.125]"
)
- (vct-set! v0 0 (filter gen 1.0))
- (do ((i 1 (+ 1 i)))
+ (set! (v0 0) (filter gen 1.0))
+ (do ((i 1 (+ i 1)))
((= i 10))
- (vct-set! v0 i (filter gen 0.0)))
- (vct-map! v1 (let ((inp 1.0))
- (lambda ()
- (let ((val (if (filter? gen1) (filter gen1 inp) -1.0)))
- (set! inp 0.0)
- val))))
+ (set! (v0 i) (filter gen 0.0)))
+ (let ((inp 1.0))
+ (fill-float-vector v1 (let ((val (if (filter? gen1) (filter gen1 inp) -1.0)))
+ (set! inp 0.0)
+ val)))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map filter: ~A ~A" v0 v1))
(if (not (filter? gen)) (snd-display #__line__ ";~A not filter?" gen))
(if (not (= (mus-length gen) 3)) (snd-display #__line__ ";filter length: ~D?" (mus-length gen)))
- (if (or (fneq (vct-ref v0 1) 0.125) (fneq (vct-ref v0 2) .031)) (snd-display #__line__ ";filter output: ~A" v0))
+ (if (or (fneq (v0 1) 0.125) (fneq (v0 2) .031)) (snd-display #__line__ ";filter output: ~A" v0))
(if (not (filter? gen2)) (snd-display #__line__ ";make-biquad: ~A" gen2))
(let ((xs (mus-xcoeffs gen))
(ys (mus-ycoeffs gen)))
- (if (or (not (equal? xs (list->vct '(.5 .25 .125))))
+ (if (or (not (equal? xs (float-vector .5 .25 .125)))
(not (equal? xs ys)))
(snd-display #__line__ ";mus-xcoeffs: ~A ~A?" xs ys))))
- (let ((var (catch #t (lambda () (make-filter :order 2 :xcoeffs (vct 1.0 0.5) :ycoeffs (vct 2.0 1.0 0.5))) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-filter :order 2 :xcoeffs (float-vector 1.0 0.5) :ycoeffs (float-vector 2.0 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
(snd-display #__line__ ";make-filter bad coeffs: ~A" var)))
- (let ((var (catch #t (lambda () (make-filter :order 0 :xcoeffs (vct 1.0 0.5))) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-filter :order 0 :xcoeffs (float-vector 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
(snd-display #__line__ ";make-filter bad order: ~A" var)))
- (let ((var (catch #t (lambda () (make-fir-filter :order 22 :xcoeffs (vct 1.0 0.5))) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-fir-filter :order 22 :xcoeffs (float-vector 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
(snd-display #__line__ ";make-fir-filter bad coeffs: ~A" var)))
- (let ((var (catch #t (lambda () (make-iir-filter :order 22 :ycoeffs (vct 1.0 0.5))) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-iir-filter :order 22 :ycoeffs (float-vector 1.0 0.5))) (lambda args args))))
(if (not (eq? (car var) 'mus-error))
(snd-display #__line__ ";make-iir-filter bad coeffs: ~A" var)))
(let ((var (catch #t (lambda () (make-fir-filter -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
(snd-display #__line__ ";make-fir-filter bad order: ~A" var)))
- (let ((var (make-filter :order 2 :ycoeffs (vct 1.0 0.5))))
+ (let ((var (make-filter :order 2 :ycoeffs (float-vector 1.0 0.5))))
(if (not (iir-filter? var))
(snd-display #__line__ ";make-filter with only y: ~A" var)))
- (test-gen-equal (let ((f1 (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .25 .125))))) (filter f1 1.0) f1)
- (let ((f2 (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .25 .125))))) (filter f2 1.0) f2)
- (let ((f3 (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .5 .5))))) (filter f3 1.0) f3))
- (test-gen-equal (let ((f1 (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .25 .125))))) (filter f1 1.0) f1)
- (let ((f2 (make-filter 3 (list->vct '(.5 .25 .125)) (list->vct '(.5 .25 .125))))) (filter f2 1.0) f2)
- (let ((f3 (make-filter 3 (list->vct '(.5 .5 .125)) (list->vct '(.5 .25 .0625))))) (filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f1 1.0) f1)
+ (let ((f2 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f2 1.0) f2)
+ (let ((f3 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .5 .5)))) (filter f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f1 1.0) f1)
+ (let ((f2 (make-filter 3 (float-vector .5 .25 .125) (float-vector .5 .25 .125)))) (filter f2 1.0) f2)
+ (let ((f3 (make-filter 3 (float-vector .5 .5 .125) (float-vector .5 .25 .0625)))) (filter f3 1.0) f3))
- (let ((fr (make-fir-filter 6 (vct 0 1 2 3 4 5))))
+ (let ((fr (make-fir-filter 6 (float-vector 0 1 2 3 4 5))))
(if (not (= (mus-length fr) 6)) (snd-display #__line__ ";filter-length: ~A" (mus-length fr))))
- (let ((val (cascade->canonical (list (vct 1.0 0.0 0.0) (vct 1.0 0.5 0.25)))))
- (if (not (vequal val (vct 1.000 0.500 0.250 0.000 0.000)))
+ (let ((val (cascade->canonical (list (float-vector 1.0 0.0 0.0) (float-vector 1.0 0.5 0.25)))))
+ (if (not (vequal val (float-vector 1.000 0.500 0.250 0.000 0.000)))
(snd-display #__line__ ";cas2can 0: ~A" val)))
- (let ((val (cascade->canonical (list (vct 1.0 1.0 0.0) (vct 1.0 0.5 0.25)))))
- (if (not (vequal val (vct 1.000 1.500 0.750 0.250 0.000)))
+ (let ((val (cascade->canonical (list (float-vector 1.0 1.0 0.0) (float-vector 1.0 0.5 0.25)))))
+ (if (not (vequal val (float-vector 1.000 1.500 0.750 0.250 0.000)))
(snd-display #__line__ ";cas2can 1: ~A" val)))
- (let ((val (cascade->canonical (list (vct 1 0.8 0) (vct 1 1.4 0.65) (vct 1 0 0)))))
- (if (not (vequal val (vct 1.000 2.200 1.770 0.520 0.000 0.000 0.000)))
+ (let ((val (cascade->canonical (list (float-vector 1 0.8 0) (float-vector 1 1.4 0.65) (float-vector 1 0 0)))))
+ (if (not (vequal val (float-vector 1.000 2.200 1.770 0.520 0.000 0.000 0.000)))
(snd-display #__line__ ";cascade->canonical: ~A" val)))
- (let ((val (cascade->canonical (list (vct 1 -0.9 0) (vct 1 1 0.74) (vct 1 -1.6 0.8)))))
- (if (not (vequal val (vct 1.000 -1.500 0.480 -0.330 0.938 -0.533 0.000)))
+ (let ((val (cascade->canonical (list (float-vector 1 -0.9 0) (float-vector 1 1 0.74) (float-vector 1 -1.6 0.8)))))
+ (if (not (vequal val (float-vector 1.000 -1.500 0.480 -0.330 0.938 -0.533 0.000)))
(snd-display #__line__ ";cascade->canonical 1: ~A" val)))
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050)))
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next)))
(pad-channel 0 10000)
(freq-sweep .45)
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 0.962 0.998 0.998 0.998 0.998 0.999 0.999 0.998 0.997 1.000)))
- (not (vequal sp (vct 0.963 0.999 0.999 0.999 0.999 0.999 1.000 1.000 0.998 0.997))))
+ (if (and (not (vequal sp (float-vector 0.962 0.998 0.998 0.998 0.998 0.999 0.999 0.998 0.997 1.000)))
+ (not (vequal sp (float-vector 0.963 0.999 0.999 0.999 0.999 0.999 1.000 1.000 0.998 0.997))))
(snd-display #__line__ ";initial rough spectrum: ~A" sp)))
(let ((b (make-butter-high-pass 440.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
(snd-display #__line__ ";butter high: ~A" v))
(set! b (make-butter-high-pass 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000)))
- (not (vequal sp (vct 0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
+ (if (and (not (vequal sp (float-vector 0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000)))
+ (not (vequal sp (float-vector 0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
(snd-display #__line__ ";hp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-low-pass 440.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
(snd-display #__line__ ";butter low: ~A" v))
(set! b (make-butter-low-pass 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (vequal sp (vct 1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal sp (float-vector 1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";lp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-band-pass 440.0 50.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.007 0.014 0.013 0.013 0.012 0.011 0.009 0.008 0.007 0.005)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.007 0.014 0.013 0.013 0.012 0.011 0.009 0.008 0.007 0.005)))
(snd-display #__line__ ";butter bandpass: ~A" v))
(set! b (make-butter-band-pass 1000.0 500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (vequal sp (vct 0.888 1.000 0.144 0.056 0.027 0.014 0.008 0.004 0.002 0.000)))
+ (if (not (vequal sp (float-vector 0.888 1.000 0.144 0.056 0.027 0.014 0.008 0.004 0.002 0.000)))
(snd-display #__line__ ";bp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-band-reject 440.0 50.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.993 -0.014 -0.013 -0.013 -0.012 -0.011 -0.009 -0.008 -0.007 -0.005)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.993 -0.014 -0.013 -0.013 -0.012 -0.011 -0.009 -0.008 -0.007 -0.005)))
(snd-display #__line__ ";butter bandstop: ~A" v))
(set! b (make-butter-band-reject 1000.0 500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 0.662 0.687 0.953 0.980 0.989 0.994 0.997 0.997 0.997 1.000)))
- (not (vequal sp (vct 0.664 0.689 0.955 0.982 0.992 0.996 0.999 1.000 0.999 0.998))))
+ (if (and (not (vequal sp (float-vector 0.662 0.687 0.953 0.980 0.989 0.994 0.997 0.997 0.997 1.000)))
+ (not (vequal sp (float-vector 0.664 0.689 0.955 0.982 0.992 0.996 0.999 1.000 0.999 0.998))))
(snd-display #__line__ ";bs rough spectrum: ~A" sp)))
(undo))
@@ -19793,18 +15054,18 @@ EDITS: 2
(test-lpc)
(test-unclip-channel)
- (let ((v (spectrum->coeffs 10 (vct 0 1.0 0 0 0 0 0 0 1.0 0)))
- (v1 (make-fir-coeffs 10 (vct 0 1.0 0 0 0 0 0 0 1.0 0))))
- (if (not (vequal v (vct -0.190 -0.118 0.000 0.118 0.190 0.190 0.118 0.000 -0.118 -0.190)))
+ (let ((v (spectrum->coeffs 10 (float-vector 0 1.0 0 0 0 0 0 0 1.0 0)))
+ (v1 (make-fir-coeffs 10 (float-vector 0 1.0 0 0 0 0 0 0 1.0 0))))
+ (if (not (vequal v (float-vector -0.190 -0.118 0.000 0.118 0.190 0.190 0.118 0.000 -0.118 -0.190)))
(snd-display #__line__ ";spectrum->coeffs: ~A" v))
(if (not (vequal v v1))
(snd-display #__line__ ";spectrum->coeffs v make-fir-coeffs: ~A ~A" v v1)))
- (let ((notched-spectr (make-vct 20)))
- (vct-set! notched-spectr 2 1.0)
+ (let ((notched-spectr (make-float-vector 20)))
+ (set! (notched-spectr 2) 1.0)
(let ((v (spectrum->coeffs 20 notched-spectr))
(v1 (make-fir-coeffs 20 notched-spectr)))
- (if (not (vequal v (vct 0.095 0.059 -0.000 -0.059 -0.095 -0.095 -0.059 0.000 0.059 0.095
+ (if (not (vequal v (float-vector 0.095 0.059 -0.000 -0.059 -0.095 -0.095 -0.059 0.000 0.059 0.095
0.095 0.059 0.000 -0.059 -0.095 -0.095 -0.059 -0.000 0.059 0.095)))
(snd-display #__line__ ";spectrum->coeffs (notch): ~A" v))
(if (not (vequal v v1))
@@ -19812,195 +15073,208 @@ EDITS: 2
(let ((flt (make-fir-filter 20 v)))
(map-channel (lambda (y) (fir-filter flt y)))))
(let ((sp (rough-spectrum ind)))
- (if (not (vequal sp (vct 0.007 0.493 1.000 0.068 0.030 0.019 0.014 0.011 0.009 0.009)))
+ (if (not (vequal sp (float-vector 0.007 0.493 1.000 0.068 0.030 0.019 0.014 0.011 0.009 0.009)))
(snd-display #__line__ ";sp->coeff rough spectrum: ~A" sp)))
(undo))
- (let ((rspect (make-vct 20)))
- (do ((i 0 (+ 1 i)))
+ (let ((rspect (make-float-vector 20)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! rspect i (random 1.0)))
+ (set! (rspect i) (random 1.0)))
(let ((v (spectrum->coeffs 20 rspect))
(v1 (make-fir-coeffs 20 rspect)))
(if (not (vequal v v1))
(snd-display #__line__ ";spectrum->coeffs v(3) make-fir-coeffs: ~A ~A" v v1))))
(let ((b (make-highpass (hz->radians 1000.0) 10))
- (v (make-vct 20))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct -0.001 -0.002 -0.005 -0.011 -0.021 -0.034 -0.049 -0.065 -0.078 -0.087
+ (v (make-float-vector 20))
+ (d (make-delay 1)))
+ (delay d (fir-filter b 1.0))
+ (fill-float-vector v (delay d (fir-filter b 0.0)))
+ (if (not (vequal v (float-vector -0.001 -0.002 -0.005 -0.011 -0.021 -0.034 -0.049 -0.065 -0.078 -0.087
0.909 -0.087 -0.078 -0.065 -0.049 -0.034 -0.021 -0.011 -0.005 -0.002)))
(snd-display #__line__ ";dsp.scm high: ~A" v))
(set! b (make-highpass (hz->radians 1000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 0.053 0.774 0.998 0.997 0.997 0.996 0.996 0.996 0.997 1.000)))
- (not (vequal sp (vct 0.053 0.776 1.000 0.998 0.998 0.998 0.998 0.998 0.998 1.000))))
+ (if (and (not (vequal sp (float-vector 0.053 0.774 0.998 0.997 0.997 0.996 0.996 0.996 0.997 1.000)))
+ (not (vequal sp (float-vector 0.053 0.776 1.000 0.998 0.998 0.998 0.998 0.998 0.998 1.000))))
(snd-display #__line__ ";dsp hp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-lowpass (hz->radians 1000.0) 10))
- (v (make-vct 20))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.001 0.002 0.005 0.011 0.021 0.034 0.049 0.065 0.078 0.087 0.091 0.087 0.078 0.065
+ (v (make-float-vector 20))
+ (d (make-delay 1)))
+ (delay d (fir-filter b 1.0))
+ (fill-float-vector v (delay d (fir-filter b 0.0)))
+ (if (not (vequal v (float-vector 0.001 0.002 0.005 0.011 0.021 0.034 0.049 0.065 0.078 0.087 0.091 0.087 0.078 0.065
0.049 0.034 0.021 0.011 0.005 0.002)))
(snd-display #__line__ ";dsp.scm low: ~A" v))
(set! b (make-lowpass (hz->radians 1000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (vequal sp (vct 1.000 0.054 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal sp (float-vector 1.000 0.054 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";dsp lp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-bandpass (hz->radians 1500.0) (hz->radians 2000.0) 10))
- (v (make-vct 20))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.001 -0.001 -0.005 -0.011 -0.017 -0.019 -0.013 0.003 0.022 0.039 0.045
+ (v (make-float-vector 20))
+ (d (make-delay 1)))
+ (delay d (fir-filter b 1.0))
+ (fill-float-vector v (delay d (fir-filter b 0.0)))
+ (if (not (vequal v (float-vector 0.001 -0.001 -0.005 -0.011 -0.017 -0.019 -0.013 0.003 0.022 0.039 0.045
0.039 0.022 0.003 -0.013 -0.019 -0.017 -0.011 -0.005 -0.001)))
(snd-display #__line__ ";dsp.scm bp: ~A" v))
(set! b (make-bandpass (hz->radians 1500.0) (hz->radians 2000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (vequal sp (vct 0.010 1.000 0.154 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal sp (float-vector 0.010 1.000 0.154 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";dsp bp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-bandstop (hz->radians 1500.0) (hz->radians 2000.0) 10))
- (v (make-vct 20))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct -0.001 0.001 0.005 0.011 0.017 0.019 0.013 -0.003 -0.022 -0.039 0.955
+ (v (make-float-vector 20))
+ (d (make-delay 1)))
+ (delay d (fir-filter b 1.0))
+ (fill-float-vector v (delay d (fir-filter b 0.0)))
+ (if (not (vequal v (float-vector -0.001 0.001 0.005 0.011 0.017 0.019 0.013 -0.003 -0.022 -0.039 0.955
-0.039 -0.022 -0.003 0.013 0.019 0.017 0.011 0.005 0.001)))
(snd-display #__line__ ";dsp.scm bs: ~A" v))
(set! b (make-bandstop (hz->radians 1500.0) (hz->radians 2000.0) 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 0.904 0.425 0.821 0.998 0.997 0.996 0.996 0.996 0.997 1.000)))
- (not (vequal sp (vct 0.906 0.425 0.822 1.000 0.999 0.998 0.998 0.998 0.998 1.000))))
+ (if (and (not (vequal sp (float-vector 0.904 0.425 0.821 0.998 0.997 0.996 0.996 0.996 0.997 1.000)))
+ (not (vequal sp (float-vector 0.906 0.425 0.822 1.000 0.999 0.998 0.998 0.998 0.998 1.000))))
(snd-display #__line__ ";dsp bs rough spectrum: ~A" sp)))
(undo))
(let ((b (make-differentiator 10))
- (v (make-vct 20))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (fir-filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct -0.008 0.011 -0.021 0.039 -0.066 0.108 -0.171 0.270 -0.456 0.977
+ (v (make-float-vector 20))
+ (d (make-delay 1)))
+ (delay d (fir-filter b 1.0))
+ (fill-float-vector v (delay d (fir-filter b 0.0)))
+ (if (not (vequal v (float-vector -0.008 0.011 -0.021 0.039 -0.066 0.108 -0.171 0.270 -0.456 0.977
0.000 -0.977 0.456 -0.270 0.171 -0.108 0.066 -0.039 0.021 -0.011)))
(snd-display #__line__ ";dsp.scm df: ~A" v))
(set! b (make-differentiator 20))
(map-channel (lambda (y) (fir-filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (vequal sp (vct 0.004 0.027 0.075 0.147 0.242 0.362 0.506 0.674 0.864 1.000)))
+ (if (not (vequal sp (float-vector 0.004 0.027 0.075 0.147 0.242 0.362 0.506 0.674 0.864 1.000)))
(snd-display #__line__ ";dsp df rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-high-pass-2 440.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.915 -0.162 -0.146 -0.131 -0.117 -0.103 -0.090 -0.078 -0.066 -0.056)))
(snd-display #__line__ ";iir-2 high: ~A" v))
(set! b (make-iir-high-pass-2 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000)))
- (not (vequal sp (vct 0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
+ (if (and (not (vequal sp (float-vector 0.150 0.833 0.980 0.994 0.997 0.998 0.999 0.998 0.997 1.000)))
+ (not (vequal sp (float-vector 0.150 0.833 0.981 0.995 0.998 0.999 1.000 1.000 0.998 0.997))))
(snd-display #__line__ ";iir-2 hp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-low-pass-2 440.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (butter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.004 0.014 0.026 0.035 0.043 0.049 0.053 0.055 0.057 0.057)))
(snd-display #__line__ ";iir-2 low: ~A" v))
(set! b (make-iir-low-pass-2 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (vequal sp (vct 1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal sp (float-vector 1.000 0.212 0.024 0.005 0.001 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";iir-2 lp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-band-pass-2 440.0 490.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.007 0.014 0.013 0.013 0.012 0.010 0.009 0.008 0.006 0.004)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.007 0.014 0.013 0.013 0.012 0.010 0.009 0.008 0.006 0.004)))
(snd-display #__line__ ";iir bp-2 bandpass: ~A" v))
(set! b (make-iir-band-pass-2 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (not (vequal sp (vct 0.239 1.000 0.117 0.041 0.019 0.010 0.005 0.003 0.001 0.000)))
+ (if (not (vequal sp (float-vector 0.239 1.000 0.117 0.041 0.019 0.010 0.005 0.003 0.001 0.000)))
(snd-display #__line__ ";iir bp-2 rough spectrum: ~A" sp)))
(undo))
(let ((b (make-iir-band-stop-2 440.0 500.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.992 -0.017 -0.016 -0.015 -0.014 -0.012 -0.011 -0.009 -0.007 -0.005)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.992 -0.017 -0.016 -0.015 -0.014 -0.012 -0.011 -0.009 -0.007 -0.005)))
(snd-display #__line__ ";iir-2 bandstop: ~A" v))
(set! b (make-iir-band-stop-2 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 0.836 0.525 0.943 0.979 0.989 0.994 0.997 0.997 0.997 1.000)))
- (not (vequal sp (vct 0.838 0.527 0.945 0.981 0.991 0.996 0.999 1.000 0.999 0.998))))
+ (if (and (not (vequal sp (float-vector 0.836 0.525 0.943 0.979 0.989 0.994 0.997 0.997 0.997 1.000)))
+ (not (vequal sp (float-vector 0.838 0.527 0.945 0.981 0.991 0.996 0.999 1.000 0.999 0.998))))
(snd-display #__line__ ";iir bs-2 rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-hp 4 440.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
- (if (and (not (vequal v (vct 0.725 -0.466 -0.315 -0.196 -0.104 -0.036 0.014 0.047 0.0685 0.0775)))
- (not (vequal v (vct 0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.015 0.049 0.070 0.081)))
- (not (vequal v (vct 0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.014 0.049 0.069 0.079))))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (and (not (vequal v (float-vector 0.725 -0.466 -0.315 -0.196 -0.104 -0.036 0.014 0.047 0.0685 0.0775)))
+ (not (vequal v (float-vector 0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.015 0.049 0.070 0.081)))
+ (not (vequal v (float-vector 0.725 -0.466 -0.315 -0.196 -0.104 -0.035 0.014 0.049 0.069 0.079))))
(snd-display #__line__ ";butter hp: ~A" v))
(set! b (make-butter-hp 4 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 0.0505 0.982 1.000 1.000 0.998 0.998 0.999 0.998 0.996 0.999)))
- (not (vequal sp (vct 0.051 0.982 1.000 1.000 0.998 0.998 0.998 0.999 0.997 0.995)))
- (not (vequal sp (vct 0.051 0.991 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995)))
- (not (vequal sp (vct 0.045 0.970 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995)))
- (not (vequal sp (vct 0.052 0.971 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))))
+ (if (and (not (vequal sp (float-vector 0.0505 0.982 1.000 1.000 0.998 0.998 0.999 0.998 0.996 0.999)))
+ (not (vequal sp (float-vector 0.051 0.982 1.000 1.000 0.998 0.998 0.998 0.999 0.997 0.995)))
+ (not (vequal sp (float-vector 0.051 0.991 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995)))
+ (not (vequal sp (float-vector 0.045 0.970 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995)))
+ (not (vequal sp (float-vector 0.052 0.971 1.000 1.000 0.998 0.998 0.999 0.999 0.997 0.995))))
(snd-display #__line__ ";bhp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-lp 4 440.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))) ;; ???
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))) ;; ???
(snd-display #__line__ ";butter lp: ~A" v))
(set! b (make-butter-lp 4 1000.0))
(map-channel (lambda (y) (filter b y)))
(let ((sp (rough-spectrum ind)))
- (if (and (not (vequal sp (vct 1.000 0.035 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal sp (vct 1.000 0.038 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (and (not (vequal sp (float-vector 1.000 0.035 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (not (vequal sp (float-vector 1.000 0.038 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";blp rough spectrum: ~A" sp)))
(undo))
(let ((b (make-butter-bp 4 440.0 500.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
- (if (not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (not (vequal v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";butter bp: ~A" v))
(set! b (make-butter-bp 4 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
(undo))
(let ((b (make-butter-bs 4 440.0 500.0))
- (v (make-vct 10))
- (inv 1.0))
- (vct-map! v (lambda () (let ((val (filter b inv))) (set! inv 0.0) val)))
- (if (and (not (vequal v (vct 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.026 -0.0225 -0.015 -0.0085)))
- (not (vequal v (vct 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.022 -0.017 -0.011)))
- (not (vequal v (vct 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.021 -0.014 -0.011))))
+ (v (make-float-vector 10))
+ (d (make-delay 1)))
+ (delay d (filter b 1.0))
+ (fill-float-vector v (delay d (filter b 0.0)))
+ (if (and (not (vequal v (float-vector 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.026 -0.0225 -0.015 -0.0085)))
+ (not (vequal v (float-vector 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.022 -0.017 -0.011)))
+ (not (vequal v (float-vector 0.978 -0.043 -0.041 -0.038 -0.035 -0.031 -0.027 -0.021 -0.014 -0.011))))
(snd-display #__line__ ";butter bs: ~A" v))
(set! b (make-butter-bs 4 1000.0 1500.0))
(map-channel (lambda (y) (filter b y)))
@@ -20012,16 +15286,16 @@ EDITS: 2
(close-sound ind))
(let ((gen (make-sawtooth-wave 440.0))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-sawtooth-wave 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"sawtooth-wave"
"sawtooth-wave freq: 440.000Hz, phase: 3.142, amp: 1.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (sawtooth-wave gen 0.0)))
- (vct-map! v1 (lambda () (if (sawtooth-wave? gen1) (sawtooth-wave gen1 0.0) -1.0)))
+ (set! (v0 i) (sawtooth-wave gen 0.0)))
+ (fill-float-vector v1 (if (sawtooth-wave? gen1) (sawtooth-wave gen1 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map sawtooth: ~A ~A" v0 v1))
(if (not (sawtooth-wave? gen)) (snd-display #__line__ ";~A not sawtooth-wave?" gen))
(if (fneq (mus-phase gen) 4.39538) (snd-display #__line__ ";sawtooth-wave phase: ~F?" (mus-phase gen))) ;starts at pi
@@ -20031,7 +15305,7 @@ EDITS: 2
(if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";sawtooth-wave scaler: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
(if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! sawtooth-wave scaler: ~F?" (mus-scaler gen)))
- (if (or (fneq (vct-ref v0 1) 0.04) (fneq (vct-ref v0 8) .319)) (snd-display #__line__ ";sawtooth-wave output: ~A" v0)))
+ (if (or (fneq (v0 1) 0.04) (fneq (v0 8) .319)) (snd-display #__line__ ";sawtooth-wave output: ~A" v0)))
(test-gen-equal (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0) (make-sawtooth-wave 120.0))
(test-gen-equal (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0) (make-sawtooth-wave 440.0 1.0 1.0))
@@ -20040,24 +15314,24 @@ EDITS: 2
(let ((gen1 (make-sawtooth-wave 100.0))
(gen2 (make-sawtooth-wave -100.0))
(mx 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
(if (fneq mx 0.0)
(snd-display #__line__ ";sawtooth +-: ~A" mx)))
(let ((gen (make-square-wave 440.0))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-square-wave 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"square-wave"
"square-wave freq: 440.000Hz, phase: 0.000, amp: 1.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (square-wave gen 0.0)))
+ (set! (v0 i) (square-wave gen 0.0)))
(let ((w 1.0))
- (vct-map! v1 (lambda ()
+ (fill-float-vector v1 (begin
(set! w (mus-width gen1))
(if (square-wave? gen1) (square-wave gen1 0.0) -1.0)))
(if (fneq w 0.5) (snd-display #__line__ ";mus-width opt: ~A" w)))
@@ -20071,35 +15345,35 @@ EDITS: 2
(if (fneq (mus-width gen) 0.5) (snd-display #__line__ ";square-wave width: ~A" (mus-width gen)))
(set! (mus-width gen) 0.75)
(if (fneq (mus-width gen) 0.75) (snd-display #__line__ ";set! square-wave width: ~A" (mus-width gen)))
- (if (or (fneq (vct-ref v0 1) 1.0) (fneq (vct-ref v0 8) 1.0)) (snd-display #__line__ ";square-wave output: ~A" v0)))
+ (if (or (fneq (v0 1) 1.0) (fneq (v0 8) 1.0)) (snd-display #__line__ ";square-wave output: ~A" v0)))
(test-gen-equal (make-square-wave 440.0) (make-square-wave 440.0) (make-square-wave 120.0))
(test-gen-equal (make-square-wave 440.0) (make-square-wave 440.0) (make-square-wave 440.0 1.0 1.0))
(test-gen-equal (make-square-wave 440.0) (make-square-wave 440.0) (make-square-wave 440.0 0.5))
- (let ((old-srate (mus-srate)))
- (set! (mus-srate) 500.0)
+ (let ((old-srate *clm-srate*))
+ (set! *clm-srate* 500.0)
(let ((gen (make-square-wave 100.0 -0.5 (* pi 0.5)))
- (v0 (make-vct 20)))
- (do ((i 0 (+ 1 i)))
+ (v0 (make-float-vector 20)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! v0 i (gen)))
- (if (not (vequal v0 (vct -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5)))
+ (set! (v0 i) (gen)))
+ (if (not (vequal v0 (float-vector -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5 -0.5 -0.5 0.0 0.0 -0.5)))
(snd-display #__line__ ";square-wave -.5: ~A " v0)))
- (set! (mus-srate) old-srate))
+ (set! *clm-srate* old-srate))
(let ((gen (make-triangle-wave 440.0))
(gen1 (make-triangle-wave 440.0 1.0 pi))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen2 (make-triangle-wave 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"triangle-wave"
"triangle-wave freq: 440.000Hz, phase: 0.000, amp: 1.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (triangle-wave gen 0.0)))
- (vct-map! v1 (lambda () (if (triangle-wave? gen2) (triangle-wave gen2 0.0) -1.0)))
+ (set! (v0 i) (triangle-wave gen 0.0)))
+ (fill-float-vector v1 (if (triangle-wave? gen2) (triangle-wave gen2 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map triangle-wave: ~A ~A" v0 v1))
(if (not (triangle-wave? gen)) (snd-display #__line__ ";~A not triangle-wave?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";triangle-wave phase: ~F?" (mus-phase gen)))
@@ -20108,12 +15382,12 @@ EDITS: 2
(if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";triangle-wave scaler: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
(if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! triangle-wave scaler: ~F?" (mus-scaler gen)))
- (if (or (fneq (vct-ref v0 1) 0.080) (fneq (vct-ref v0 8) 0.639)) (snd-display #__line__ ";triangle-wave output: ~A" v0)))
+ (if (or (fneq (v0 1) 0.080) (fneq (v0 8) 0.639)) (snd-display #__line__ ";triangle-wave output: ~A" v0)))
(let ((gen1 (make-triangle-wave 100.0))
(gen2 (make-triangle-wave -100.0))
(mx 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(set! mx (max mx (abs (+ (gen1) (gen2))))))
(if (fneq mx 0.0)
@@ -20124,16 +15398,16 @@ EDITS: 2
(test-gen-equal (make-triangle-wave 440.0) (make-triangle-wave 440.0) (make-triangle-wave 440.0 0.5))
(let ((gen (make-pulse-train 440.0))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-pulse-train 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"pulse-train"
"pulse-train freq: 440.000Hz, phase: 0.000, amp: 1.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (pulse-train gen 0.0)))
- (vct-map! v1 (lambda () (if (pulse-train? gen1) (pulse-train gen1 0.0) -1.0)))
+ (set! (v0 i) (pulse-train gen 0.0)))
+ (fill-float-vector v1 (if (pulse-train? gen1) (pulse-train gen1 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map pulse-train: ~A ~A" v0 v1))
(if (not (pulse-train? gen)) (snd-display #__line__ ";~A not pulse-train?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";pulse-train phase: ~F?" (mus-phase gen)))
@@ -20141,131 +15415,80 @@ EDITS: 2
(if (fneq (mus-scaler gen) 1.0) (snd-display #__line__ ";pulse-train scaler: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 0.5)
(if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! pulse-train scaler: ~F?" (mus-scaler gen)))
- (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 8) 0.0)) (snd-display #__line__ ";pulse-train output: ~A" v0)))
+ (if (or (fneq (v0 0) 1.0) (fneq (v0 8) 0.0)) (snd-display #__line__ ";pulse-train output: ~A" v0)))
(test-gen-equal (make-pulse-train 440.0) (make-pulse-train 440.0) (make-pulse-train 120.0))
(test-gen-equal (make-pulse-train 440.0) (make-pulse-train 440.0) (make-pulse-train 440.0 1.0 1.0))
(test-gen-equal (make-pulse-train 440.0) (make-pulse-train 440.0) (make-pulse-train 440.0 0.5))
- (let ((old-srate (mus-srate)))
- (set! (mus-srate) 500.0)
+ (let ((old-srate *clm-srate*))
+ (set! *clm-srate* 500.0)
(let ((gen (make-pulse-train 100.0 -0.5 (* pi 0.5)))
- (v0 (make-vct 20)))
- (do ((i 0 (+ 1 i)))
+ (v0 (make-float-vector 20)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! v0 i (gen)))
- (if (not (vequal v0 (vct 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5)))
+ (set! (v0 i) (gen)))
+ (if (not (vequal v0 (float-vector 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5 0.0 0.0 0.0 0.0 -0.5)))
(snd-display #__line__ ";pulse-train -.5: ~A " v0)))
- (set! (mus-srate) old-srate))
-
+ (set! *clm-srate* old-srate))
- (let ((gen (make-ppolar .1 1200.0))
- (v0 (make-vct 10)))
- (vct-set! v0 0 (two-pole gen 1.0))
- (do ((i 1 (+ 1 i)))
- ((= i 10))
- (vct-set! v0 i (two-pole gen 0.0)))
- (if (not (two-pole? gen)) (snd-display #__line__ ";~A not ppolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";ppolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";ppolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) -.188) (snd-display #__line__ ";ppolar b1: ~F?" (mus-b1 gen)))
- (if (fneq (mus-b2 gen) .01) (snd-display #__line__ ";ppolar b2: ~F?" (mus-b2 gen)))
- (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) .188)) (snd-display #__line__ ";ppolar output: ~A" v0))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq ppolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler ppolar: ~A" (mus-scaler gen))))
-
- (test-gen-equal (let ((z1 (make-ppolar .1 600.0))) (two-pole z1 1.0) z1)
- (let ((z2 (make-ppolar .1 600.0))) (two-pole z2 1.0) z2)
- (let ((z3 (make-ppolar .1 1200.0))) (two-pole z3 1.0) z3))
- (test-gen-equal (let ((z1 (make-ppolar :radius .1 :frequency 600.0))) (two-pole z1 1.0) z1)
- (let ((z2 (make-ppolar :radius .1 :frequency 600.0))) (two-pole z2 1.0) z2)
- (let ((z3 (make-ppolar :radius .2 :frequency 1200.0))) (two-pole z3 1.0) z3))
- (test-gen-equal (let ((z1 (make-ppolar .1 600.0))) (two-pole z1 1.0) z1)
- (let ((z2 (make-ppolar .1 600.0))) (two-pole z2 1.0) z2)
- (let ((z3 (make-ppolar .1 600.0))) (two-pole z3 0.5) z3))
(let ((gen (make-two-pole 1200.0 .1)))
- (if (not (two-pole? gen)) (snd-display #__line__ ";~A not 2ppolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";2ppolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";2ppolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) -.188) (snd-display #__line__ ";2ppolar b1: ~F?" (mus-b1 gen)))
- (if (fneq (mus-b2 gen) .01) (snd-display #__line__ ";2ppolar b2: ~F?" (mus-b2 gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq 2ppolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler 2ppolar: ~A" (mus-scaler gen))))
+ (if (not (two-pole? gen)) (snd-display #__line__ ";~A not 2-polar?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";2-polar order: ~D?" (mus-order gen)))
+ (if (fneq (mus-xcoeff gen 0) 1.0) (snd-display #__line__ ";2-polar a0: ~F?" (mus-xcoeff gen 0)))
+ (if (fneq (mus-ycoeff gen 1) -.188) (snd-display #__line__ ";2-polar b1: ~F?" (mus-ycoeff gen 1)))
+ (if (fneq (mus-ycoeff gen 2) .01) (snd-display #__line__ ";2-polar b2: ~F?" (mus-ycoeff gen 2)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq 2-polar: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler 2-polar: ~A" (mus-scaler gen))))
(let ((gen (make-two-pole :frequency 1200.0 :radius .1)))
- (if (not (two-pole? gen)) (snd-display #__line__ ";~A not f2ppolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";f2ppolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";f2ppolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-b1 gen) -.188) (snd-display #__line__ ";f2ppolar b1: ~F?" (mus-b1 gen)))
- (if (fneq (mus-b2 gen) .01) (snd-display #__line__ ";f2ppolar b2: ~F?" (mus-b2 gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq f2ppolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler f2ppolar: ~A" (mus-scaler gen))))
-
- (let ((gen (make-zpolar :radius .1 :frequency 1200.0))
- (v0 (make-vct 10)))
- (vct-set! v0 0 (two-zero gen 1.0))
- (do ((i 1 (+ 1 i)))
- ((= i 10))
- (vct-set! v0 i (two-zero gen 0.0)))
- (if (not (two-zero? gen)) (snd-display #__line__ ";~A not zpolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";zpolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";zpolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) -.188) (snd-display #__line__ ";zpolar a1: ~F?" (mus-a1 gen)))
- (if (fneq (mus-a2 gen) .01) (snd-display #__line__ ";zpolar a2: ~F?" (mus-a2 gen)))
- (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) -.188)) (snd-display #__line__ ";zpolar output: ~A" v0))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq zpolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler zpolar: ~A" (mus-scaler gen))))
+ (if (not (two-pole? gen)) (snd-display #__line__ ";~A not f2-polar?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";f2-polar order: ~D?" (mus-order gen)))
+ (if (fneq (mus-xcoeff gen 0) 1.0) (snd-display #__line__ ";f2-polar a0: ~F?" (mus-xcoeff gen 0)))
+ (if (fneq (mus-ycoeff gen 1) -.188) (snd-display #__line__ ";f2-polar b1: ~F?" (mus-ycoeff gen 1)))
+ (if (fneq (mus-ycoeff gen 2) .01) (snd-display #__line__ ";f2-polar b2: ~F?" (mus-ycoeff gen 2)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq f2-polar: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler f2-polar: ~A" (mus-scaler gen))))
(let ((gen (make-two-zero :radius .1 :frequency 1200.0)))
- (if (not (two-zero? gen)) (snd-display #__line__ ";~A not 2zpolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";2zpolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";2zpolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) -.188) (snd-display #__line__ ";2zpolar a1: ~F?" (mus-a1 gen)))
- (if (fneq (mus-a2 gen) .01) (snd-display #__line__ ";2zpolar a2: ~F?" (mus-a2 gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq 2zpolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler 2zpolar: ~A" (mus-scaler gen))))
+ (if (not (two-zero? gen)) (snd-display #__line__ ";~A not 2-zp?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";2-zp order: ~D?" (mus-order gen)))
+ (if (fneq (mus-xcoeff gen 0) 1.0) (snd-display #__line__ ";2-zp a0: ~F?" (mus-xcoeff gen 0)))
+ (if (fneq (mus-xcoeff gen 1) -.188) (snd-display #__line__ ";2-zp a1: ~F?" (mus-xcoeff gen 1)))
+ (if (fneq (mus-xcoeff gen 2) .01) (snd-display #__line__ ";2-zp a2: ~F?" (mus-xcoeff gen 2)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq 2-zp: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler 2-zp: ~A" (mus-scaler gen))))
(let ((gen (make-two-zero 1200.0 .1)))
- (if (not (two-zero? gen)) (snd-display #__line__ ";~A not f2zpolar?" gen))
- (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";f2zpolar order: ~D?" (mus-order gen)))
- (if (fneq (mus-a0 gen) 1.0) (snd-display #__line__ ";f2zpolar a0: ~F?" (mus-a0 gen)))
- (if (fneq (mus-a1 gen) -.188) (snd-display #__line__ ";f2zpolar a1: ~F?" (mus-a1 gen)))
- (if (fneq (mus-a2 gen) .01) (snd-display #__line__ ";f2zpolar a2: ~F?" (mus-a2 gen)))
- (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq f2zpolar: ~A" (mus-frequency gen)))
- (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler f2zpolar: ~A" (mus-scaler gen))))
-
- (test-gen-equal (let ((z1 (make-zpolar .1 600.0))) (two-zero z1 1.0) z1)
- (let ((z2 (make-zpolar .1 600.0))) (two-zero z2 1.0) z2)
- (let ((z3 (make-zpolar .1 1200.0))) (two-zero z3 1.0) z3))
- (test-gen-equal (let ((z1 (make-zpolar :radius .1 :frequency 600.0))) (two-zero z1 1.0) z1)
- (let ((z2 (make-zpolar :radius .1 :frequency 600.0))) (two-zero z2 1.0) z2)
- (let ((z3 (make-zpolar :radius .2 :frequency 1200.0))) (two-zero z3 1.0) z3))
- (test-gen-equal (let ((z1 (make-zpolar .1 600.0))) (two-zero z1 1.0) z1)
- (let ((z2 (make-zpolar .1 600.0))) (two-zero z2 1.0) z2)
- (let ((z3 (make-zpolar .1 600.0))) (two-zero z3 0.5) z3))
+ (if (not (two-zero? gen)) (snd-display #__line__ ";~A not f2-zp?" gen))
+ (if (not (= (mus-order gen) 2)) (snd-display #__line__ ";f2-zp order: ~D?" (mus-order gen)))
+ (if (fneq (mus-xcoeff gen 0) 1.0) (snd-display #__line__ ";f2-zp a0: ~F?" (mus-xcoeff gen 0)))
+ (if (fneq (mus-xcoeff gen 1) -.188) (snd-display #__line__ ";f2-zp a1: ~F?" (mus-xcoeff gen 1)))
+ (if (fneq (mus-xcoeff gen 2) .01) (snd-display #__line__ ";f2-zp a2: ~F?" (mus-xcoeff gen 2)))
+ (if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";freq f2-zp: ~A" (mus-frequency gen)))
+ (if (fneq (mus-scaler gen) 0.1) (snd-display #__line__ ";scaler f2-zp: ~A" (mus-scaler gen))))
(let ((gen (make-formant 1200.0 0.9))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-formant 1200.0 0.9))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"formant"
"formant frequency: 1200.000, radius: 0.900")
- (vct-set! v0 0 (formant gen 1.0))
- (do ((i 1 (+ 1 i)))
+ (set! (v0 0) (formant gen 1.0))
+ (do ((i 1 (+ i 1)))
((= i 10))
- (vct-set! v0 i (formant gen 0.0)))
- (vct-map! v1 (let ((inp 1.0))
- (lambda ()
- (let ((val (if (formant? gen1) (formant gen1 inp) -1.0)))
- (set! inp 0.0)
- val))))
+ (set! (v0 i) (formant gen 0.0)))
+ (let ((inp 1.0))
+ (fill-float-vector v1 (let ((val (if (formant? gen1) (formant gen1 inp) -1.0)))
+ (set! inp 0.0)
+ val)))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map formant: ~A ~A" v0 v1))
(if (not (formant? gen)) (snd-display #__line__ ";~A not formant?" gen))
(if (not (= (mus-order gen) 2)) (snd-display #__line__ ";formant order: ~D?" (mus-order gen)))
(if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";formant frequency: ~F?" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 0) .095) (fneq (vct-ref v0 1) .161)) (snd-display #__line__ ";formant output: ~A" v0))
+ (if (or (fneq (v0 0) .095) (fneq (v0 1) .161)) (snd-display #__line__ ";formant output: ~A" v0))
(if (fneq (mus-scaler gen) 0.9) (snd-display #__line__ ";formant gain: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) 2.0)
@@ -20284,75 +15507,68 @@ EDITS: 2
(let ((fs (make-vector 2))
(f0 (make-formant 1000.0 .1))
(f1 (make-formant 100.0 .2))
- (amps (make-vct 2 1.0))
+ (amps (make-float-vector 2 1.0))
(val 1.0)
- (v0 (make-vct 10))
- (v1 (make-vct 10)))
+ (v0 (make-float-vector 10))
+ (v1 (make-float-vector 10)))
(set! (fs 0) (make-formant 1000.0 .1))
(set! (fs 1) (make-formant 100.0 .2))
+ (set! fs (make-formant-bank fs amps))
(set! (amps 0) 0.5)
(set! (amps 1) 0.25)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(set! (v0 i) (+ (* 0.5 (formant f0 val)) (* 0.25 (formant f1 val))))
- (set! (v1 i) (formant-bank amps fs val))
+ (set! (v1 i) (formant-bank fs val))
(set! val 0.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";formant bank 1: ~A ~A" v0 v1)))
(let ((fs (make-vector 2))
- (amps (make-vct 2 1.0))
+ (amps (make-float-vector 2 1.0))
(val 1.0)
- (v (make-vct 5)))
+ (v (make-float-vector 5)))
(set! (fs 0) (make-formant 1000.0 .1))
(set! (fs 1) (make-formant 100.0 .2))
+ (set! fs (make-formant-bank fs amps))
(set! (amps 0) 0.5)
(set! (amps 1) 0.25)
- (vct-map! v (lambda () (let ((res (formant-bank amps fs val))) (set! val 0.0) res)))
- (if (not (vequal v (vct 0.368 0.095 -0.346 -0.091 -0.020))) (snd-display #__line__ ";run formant-bank: ~A" v)))
-
- (let ((fs (make-vector 1))
- (amps (make-vct 1 1.0)))
- (vector-set! fs 0 (make-oscil 440.0))
- (let ((tag (catch #t
- (lambda () (formant-bank amps fs 1.0))
- (lambda args (car args)))))
- (if (not (equal? tag 'wrong-type-arg)) (snd-display #__line__ ";formant-bank gets oscil: ~A" tag))))
+ (fill-float-vector v (let ((res (formant-bank fs val))) (set! val 0.0) res))
+ (if (not (vequal v (float-vector 0.368 0.095 -0.346 -0.091 -0.020))) (snd-display #__line__ ";run formant-bank: ~A" v)))
(let ((ob (open-sound "oboe.snd")))
(define (poltergeist frek amp R gain frek-env R-env)
;; test courtesy of Anders Vinjar
(let ((filt (make-formant frek R))
- (fe (make-env :envelope frek-env :length (frames) :offset frek))
- (re (make-env :envelope R-env :length (frames) :offset R)))
+ (fe (make-env :envelope frek-env :length (framples) :offset frek))
+ (re (make-env :envelope R-env :length (framples) :offset R)))
(lambda (y)
(let ((outval (* gain (formant filt (* amp y)))))
(mus-set-formant-radius-and-frequency filt (env re) (env fe))
outval))))
- (map-chan (poltergeist 300 0.1 0.0 30.0 '(0 100 1 4000.0) '(0 0.99 1 .9))) ;; should sound like "whyieee?"
+ (map-channel (poltergeist 300 0.1 0.0 30.0 '(0 100 1 4000.0) '(0 0.99 1 .9))) ;; should sound like "whyieee?"
(play ob :wait #t)
(close-sound ob))
(let ((gen (make-firmant 1200.0 0.9))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-firmant 1200.0 0.9))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"firmant"
"firmant frequency: 1200.000, radius: 0.900")
- (vct-set! v0 0 (firmant gen 1.0))
- (do ((i 1 (+ 1 i)))
+ (set! (v0 0) (firmant gen 1.0))
+ (do ((i 1 (+ i 1)))
((= i 10))
- (vct-set! v0 i (firmant gen 0.0)))
- (vct-map! v1 (let ((inp 1.0))
- (lambda ()
- (let ((val (if (firmant? gen1) (firmant gen1 inp) -1.0)))
- (set! inp 0.0)
- val))))
+ (set! (v0 i) (firmant gen 0.0)))
+ (let ((inp 1.0))
+ (fill-float-vector v1 (let ((val (if (firmant? gen1) (firmant gen1 inp) -1.0)))
+ (set! inp 0.0)
+ val)))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map firmant: ~A ~A" v0 v1))
(if (not (firmant? gen)) (snd-display #__line__ ";~A not firmant?" gen))
(if (not (= (mus-order gen) 2)) (snd-display #__line__ ";firmant order: ~D?" (mus-order gen)))
(if (fneq (mus-frequency gen) 1200.0) (snd-display #__line__ ";firmant frequency: ~F?" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 0) .058) (fneq (vct-ref v0 1) .099)) (snd-display #__line__ ";firmant output: ~A" v0))
+ (if (or (fneq (v0 0) .058) (fneq (v0 1) .099)) (snd-display #__line__ ";firmant output: ~A" v0))
(if (fneq (mus-scaler gen) 0.9) (snd-display #__line__ ";firmant gain: ~F?" (mus-scaler gen)))
(set! (mus-scaler gen) .20)
@@ -20363,766 +15579,96 @@ EDITS: 2
(let ((f3 (make-firmant 600.0 0.9))) (firmant f3 1.0) f3))
(test-gen-equal (let ((f1 (make-firmant 1200.0 0.9))) (firmant f1 1.0) f1)
(let ((f2 (make-firmant 1200.0 0.9))) (firmant f2 1.0) f2)
- (let ((f3 (make-firmant 1200.0 0.99))) (firmant f3 1.0) f3))
- (test-gen-equal (let ((f1 (make-firmant 1200.0 0.9))) (firmant f1 1.0) f1)
- (let ((f2 (make-firmant 1200.0 0.9))) (firmant f2 1.0) f2)
- (let ((f3 (make-firmant 1200.0 0.5))) (firmant f3 1.0) f3))
-
-
- (let ((gen (make-mixer 2 .5 .25 .125 1.0))
- (fr0 (make-frame 2 1.0 1.0))
- (fr1 (make-frame 2 0.0 0.0)))
- (print-and-check gen
- "mixer"
- "mixer chans: 2, [
- 0.500 0.250
- 0.125 1.000
-]")
-
- (let ((ap (mus-array-print-length))
- (mx (make-mixer 8)))
- (set! (mus-array-print-length) 4)
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (do ((j 0 (+ 1 j)))
- ((= j 8))
- (mixer-set! mx i j (+ j (* i 8)))))
- (print-and-check mx
- "mixer"
- "mixer chans: 8, [
- 0.000 1.000 2.000 3.000...
- 8.000 9.000 10.000 11.000...
- 16.000 17.000 18.000 19.000...
- 24.000 25.000 26.000 27.000...
-]")
- (set! (mus-array-print-length) 12)
- (print-and-check mx
- "mixer"
- "mixer chans: 8, [
- 0.000 1.000 2.000 3.000 4.000 5.000 6.000 7.000
- 8.000 9.000 10.000 11.000 12.000 13.000 14.000 15.000
- 16.000 17.000 18.000 19.000 20.000 21.000 22.000 23.000
- 24.000 25.000 26.000 27.000 28.000 29.000 30.000 31.000
- 32.000 33.000 34.000 35.000 36.000 37.000 38.000 39.000
- 40.000 41.000 42.000 43.000 44.000 45.000 46.000 47.000
- 48.000 49.000 50.000 51.000 52.000 53.000 54.000 55.000
- 56.000 57.000 58.000 59.000 60.000 61.000 62.000 63.000
-]")
- (set! (mus-array-print-length) ap))
- (print-and-check fr0
- "frame"
- "frame[2]: [1.000 1.000]")
- (if (not (frame? fr0)) (snd-display #__line__ ";~A not a frame?" fr0))
- (if (not (mixer? gen)) (snd-display #__line__ ";~A not a mixer?" gen))
- (if (equal? fr0 fr1) (snd-display #__line__ ";frame=? ~A ~A?" fr0 fr1))
- (if (not (= (mus-channels fr0) 2)) (snd-display #__line__ ";frame channels: ~D?" (mus-channels fr0)))
- (if (not (= (mus-length fr1) 2)) (snd-display #__line__ ";frame length: ~D?" (mus-length fr0)))
- (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";mixer channels: ~D?" (mus-channels gen)))
- (frame->frame fr0 gen fr1)
- (if (or (fneq (frame-ref fr0 0) 1.0)
- (fneq (frame-ref fr1 1) 1.25)
- (fneq (mixer-ref gen 0 0) .5))
- (snd-display #__line__ ";fr0: ~A" fr0))
- (frame-set! fr1 0 1.0)
- (let ((fr3 (frame+ fr0 fr1))
- (fr4 (frame* fr0 fr1))
- (fr5 (sample->frame fr1 .5)))
- (if (or (fneq (frame-ref fr3 0) 2.0)
- (fneq (frame-ref fr4 0) 1.0))
- (snd-display #__line__ ";fr+*: ~A ~A" fr3 fr4))
- (if (fneq (frame-ref fr5 0) .5)
- (snd-display #__line__ ";sample->frame: ~A?" (frame-ref fr5 0)))
- (sample->frame fr1 .5 fr5)
- (if (fneq (frame-ref fr5 0) .5)
- (snd-display #__line__ ";repeat sample->frame: ~A?" (frame-ref fr5 0))))
- (let ((fr3 (make-frame 2))
- (fr4 (make-frame 4)))
- (frame-set! fr3 0 1.0)
- (set! (frame-ref fr4 0) 0.5)
- (frame-set! fr4 2 1.0)
- (if (not (feql (frame->list (frame+ fr3 fr4)) (list 1.5 0.0)))
- (snd-display #__line__ ";frame+ unequal chans: ~A?" (frame+ fr3 fr4)))
- (mus-reset fr3)
- (if (fneq (frame-ref fr3 0) 0.0) (snd-display #__line__ ";reset frame: ~A" fr3)))
- (let ((fr3 (make-frame 2))
- (fr4 (make-frame 4)))
- (frame-set! fr3 0 1.0)
- (frame-set! fr4 0 0.5)
- (frame-set! fr4 2 1.0)
- (if (not (feql (frame->list (frame* fr3 fr4)) (list 0.5 0.0)))
- (snd-display #__line__ ";frame* unequal chans: ~A?" (frame* fr3 fr4))))
- (let* ((mx1 (make-mixer 2 1.0 0.0 0.0 1.0))
- (mx2 (mixer* gen mx1))
- (fr4 (make-frame 2 1.0 1.0))
- (fr5 (make-frame 2 1.0 1.0))
- (val (frame->sample mx1 fr1)))
- (if (fneq val 1.0) (snd-display #__line__ ";frame->sample: ~A?" val))
- (if (fneq (frame->sample fr5 fr4) 2.0) (snd-display #__line__ ";frame->sample ~A" (frame->sample fr5 fr4)))
- (if (not (equal? (frame->list fr1) (list 1.0 1.25))) (snd-display #__line__ ";frame->list: ~A?" (frame->list fr1)))
- (if (or (fneq (mixer-ref mx2 0 1) .25) (fneq (mixer-ref mx2 1 0) .125)) (snd-display #__line__ ";mixer*: ~A?" mx2))
- (if (not (equal? mx2 gen)) (snd-display #__line__ ";mixer=? ~A ~A?" gen mx2))
- (if (equal? mx2 mx1) (snd-display #__line__ ";mixeris not? ~A ~A?" mx1 mx2))
- ;; mus-data doesn't apply from scheme level here
- ;(if (not (vct? (mus-data fr4))) (snd-display #__line__ ";mus-data frame: ~A" (mus-data fr4)))
- ;(if (not (vct? (mus-data mx1))) (snd-display #__line__ ";mus-data mixer: ~A" (mus-data mx1)))
- (mixer-set! mx2 0 0 2.0)
- (if (fneq (mixer-ref mx2 0 0) 2.0) (snd-display #__line__ ";mixer-set: ~A?" mx2))
- (set! fr0 (sample->frame mx2 1.0))
- (if (or (fneq (frame-ref fr0 0) 2.0) (fneq (frame-ref fr0 1) .25)) (snd-display #__line__ ";sample->frame: ~A?" fr0))
- (let ((tag (catch #t (lambda () (mixer* fr4 fr5)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";mixer* of 2 frames: ~A" tag)))
- (let ((frout (make-frame 2)))
- (sample->frame mx2 1.0 frout)
- (if (not (equal? frout fr0)) (snd-display #__line__ ";sample->frame via frout: ~A ~A?" frout fr0)))))
-
- (let ((fr1 (make-frame 2 .1 .2)))
- (let ((val (frame+ fr1 1.0)))
- (if (or (fneq (frame-ref val 0) 1.1)
- (fneq (frame-ref val 1) 1.2))
- (snd-display #__line__ ";8 frame-offset: ~A" val)))
- (let ((val (frame+ 1.0 fr1)))
- (if (or (fneq (frame-ref val 0) 1.1)
- (fneq (frame-ref val 1) 1.2))
- (snd-display #__line__ ";8 frame-offset a: ~A" val)))
- (let ((val (frame* fr1 2.0)))
- (if (or (fneq (frame-ref val 0) 0.2)
- (fneq (frame-ref val 1) 0.4))
- (snd-display #__line__ ";8 frame-scale: ~A" val)))
- (let ((val (frame* 2.0 fr1)))
- (if (or (fneq (frame-ref val 0) 0.2)
- (fneq (frame-ref val 1) 0.4))
- (snd-display #__line__ ";8 frame-scale a: ~A" val)))
- (let ((val (frame-copy fr1)))
- (if (or (fneq (frame-ref val 0) 0.1)
- (fneq (frame-ref val 1) 0.2))
- (snd-display #__line__ ";8 frame-copy a: ~A" val))))
-
- (let ((fr (make-frame! 3))
- (fr1 (make-frame 3)))
- (if (not (equal? fr fr1)) (snd-display #__line__ ";make-frame!: ~A ~A" fr fr1)))
- (let ((fr (make-frame! 3 .1 .2 .3))
- (fr1 (make-frame 3 .1 .2 .3)))
- (if (not (equal? fr fr1)) (snd-display #__line__ ";make-frame! (args): ~A ~A" fr fr1)))
-
- (let ((fr (frame .1 .2 .3)))
- (let ((fr1 (copy fr)))
- (if (not (equal? fr fr1)) (snd-display #__line__ ";copy frame: ~A ~A" fr fr1)))
- (fill! fr 0.0)
- (if (not (equal? fr (frame 0.0 0.0 0.0)))
- (snd-display #__line__ ";fill! frame 0.0: ~A" fr)))
-
-
- (let* ((mx1 (make-mixer 2 1 2 3 4))
- (mx2 (mixer* mx1 2.0)))
- (if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display #__line__ ";8 mixer* 2: ~A" mx2))
- (set! mx2 (mixer* 2.0 mx1))
- (if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display #__line__ ";8 mixer* 2a: ~A" mx2))
- (set! mx2 (mixer+ 2.0 mx1))
- (if (not (equal? mx2 (make-mixer 2 3 4 5 6)))
- (snd-display #__line__ ";8 mixer-offset 2: ~A" mx2))
- (set! mx2 (mixer+ mx1 2.0))
- (if (not (equal? mx2 (make-mixer 2 3 4 5 6)))
- (snd-display #__line__ ";8 mixer-offset 2a: ~A" mx2)))
-
- (let ((mx1 (make-scalar-mixer 2 2.0))
- (mx2 (make-mixer 2 .1 .2 .3 .4)))
- (let ((nmx (mixer+ mx1 mx2)))
- (if (or (fneq (mixer-ref mx1 0 0) 2.0)
- (fneq (mixer-ref mx1 0 1) 0.0)
- (fneq (mixer-ref mx1 1 0) 0.0)
- (fneq (mixer-ref mx1 1 1) 2.0))
- (snd-display #__line__ ";make-scalar-mixer 2: ~A" mx1))
- (if (or (fneq (mixer-ref mx2 0 0) .1)
- (fneq (mixer-ref mx2 0 1) .2)
- (fneq (mixer-ref mx2 1 0) .3)
- (fneq (mixer-ref mx2 1 1) .4))
- (snd-display #__line__ ";make-mixer .1 .2 .3 .4: ~A" mx2))
- (if (or (fneq (mixer-ref nmx 0 0) 2.1)
- (fneq (mixer-ref nmx 0 1) 0.2)
- (fneq (mixer-ref nmx 1 0) 0.3)
- (fneq (mixer-ref nmx 1 1) 2.4))
- (snd-display #__line__ ";mixer add ~A ~A: ~A" mx1 mx2 nmx))
- (set! mx1 (mixer* mx1 .5))
- (if (or (fneq (mixer-ref mx1 0 0) 1.0)
- (fneq (mixer-ref mx1 0 1) 0.0)
- (fneq (mixer-ref mx1 1 0) 0.0)
- (fneq (mixer-ref mx1 1 1) 1.0))
- (snd-display #__line__ ";make-scale (identity): ~A" mx1)))
- (mus-reset mx1)
- (if (fneq (mixer-ref mx1 0 0) 0.0) (snd-display #__line__ ";reset mixer: ~A" mx1)))
-
- (let ((mx (mixer .1 .2 .3 .4)))
- (let ((mx1 (copy mx)))
- (if (not (equal? mx mx1)) (snd-display #__line__ ";mixer copy not equal? ~A ~A" mx mx1)))
- (fill! mx 0.1)
- (if (not (equal? mx (mixer .1 .1 .1 .1)))
- (snd-display #__line__ ";fill! mixer: ~A" mx)))
-
- (let ((var (catch #t (lambda () (make-mixer 2 0.0 0.0 0.0 0.0 0.0)) (lambda args args))))
- (if (not (eq? (car var) 'mus-error))
- (snd-display #__line__ ";make-mixer extra args: ~A" var)))
- (let ((var (catch #t (lambda () (let ((fr1 (make-frame 2 1.0 0.0))) (frame->sample (make-oscil) fr1))) (lambda args args))))
- (if (not (eq? (car var) 'mus-error))
- (snd-display #__line__ ";frame->sample bad arg: ~A" var)))
- (let* ((hi (make-mixer 1 1))
- (tag (catch #t (lambda () (mixer-set! hi 1 1 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";mixer-set! 1 1 of 0: ~A (~A)" tag hi)))
- (let* ((hi (make-mixer 1 1))
- (tag (catch #t (lambda () (set! (mixer-ref hi 1 1) 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";set! mixer-ref 1 1 of 0: ~A (~A)" tag hi)))
- (let* ((hi (make-mixer 1))
- (tag (catch #t (lambda () (mixer-set! hi 1 0 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";mixer-set! 1 0 of 0: ~A (~A)" tag hi)))
- (let* ((hi (make-mixer 1))
- (tag (catch #t (lambda () (mixer-set! hi 0 1 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";mixer-set! 0 1 of 0: ~A (~A)" tag hi)))
- (let* ((hi (make-frame 1))
- (tag (catch #t (lambda () (frame-set! hi 1 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";frame-set! 1 of 0: ~A (~A)" tag hi)))
- (let* ((hi (make-frame 1))
- (tag (catch #t (lambda () (set! (frame-ref hi 1) 1.0)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";set! frame-ref 1 of 0: ~A (~A)" tag hi)))
- (let* ((tag (catch #t (lambda () (make-frame 0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";make-frame 0: ~A" tag)))
- (let* ((tag (catch #t (lambda () (make-mixer 0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";make-mixer 0: ~A" tag)))
-
- (let ((fr1 (make-frame 1 1))
- (fr2 (make-frame 2 1 2))
- (fr4 (make-frame 4 1 2 3 4))
- (fr8 (make-frame 8 1 2 3 4 5 6 7 8))
- (mx1 (make-mixer 1 5))
- (mx1id (make-mixer 1 1))
- (mx2 (make-mixer 2 1 2 3 4))
- (mx2id (make-mixer 2 1 0 0 1))
- (mx4 (make-mixer 4))
- (mx4id (make-mixer 4))
- (mx8 (make-mixer 8))
- (mx8id (make-mixer 8)))
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (mixer-set! mx4id i i 1)
- (set! (mixer-ref mx4 0 i) 1))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (mixer-set! mx8id i i 1)
- (mixer-set! mx8 i 0 1))
- (if (not (equal? (frame->frame fr1 mx1id) (make-frame 1 1))) (snd-display #__line__ ";frame->frame 1 id: ~A?" (frame->frame fr1 mx1id)))
- (if (not (equal? (frame->frame fr1 mx1) (make-frame 1 5))) (snd-display #__line__ ";frame->frame 1: ~A?" (frame->frame fr1 mx1)))
- (if (not (equal? (frame->frame fr1 mx2id) (make-frame 2 1 0))) (snd-display #__line__ ";frame->frame 2 1 id: ~A?" (frame->frame fr1 mx2id)))
- (if (not (equal? (frame->frame fr1 mx2) (make-frame 2 1 2))) (snd-display #__line__ ";frame->frame 2 1: ~A?" (frame->frame fr1 mx2)))
- (if (not (equal? (frame->frame fr1 mx4) (make-frame 4 1 1 1 1))) (snd-display #__line__ ";frame->frame 4 1: ~A?" (frame->frame fr1 mx4)))
- (if (not (equal? (frame->frame fr1 mx8) (make-frame 8 1 0 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8 1: ~A?" (frame->frame fr1 mx8)))
- (if (not (equal? (frame->frame fr2 mx1) (make-frame 1 5))) (snd-display #__line__ ";frame->frame 1 2: ~A?" (frame->frame fr2 mx1)))
- (if (not (equal? (frame->frame fr2 mx2id) (make-frame 2 1 2))) (snd-display #__line__ ";frame->frame 2id 2: ~A?" (frame->frame fr2 mx2id)))
- (if (not (equal? (frame->frame fr2 mx2) (make-frame 2 7 10))) (snd-display #__line__ ";frame->frame 2 2: ~A?" (frame->frame fr2 mx2)))
- (if (not (equal? (frame->frame fr2 mx4id) (make-frame 4 1 2 0 0))) (snd-display #__line__ ";frame->frame 4id 2: ~A?" (frame->frame fr2 mx4id)))
- (if (not (equal? (frame->frame fr2 mx8id) (make-frame 8 1 2 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8id 2: ~A?" (frame->frame fr2 mx8id)))
- (if (not (equal? (frame->frame fr2 mx4) (make-frame 4 1 1 1 1))) (snd-display #__line__ ";frame->frame 4 2: ~A?" (frame->frame fr2 mx4)))
- (if (not (equal? (frame->frame fr2 mx8) (make-frame 8 3 0 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8 2: ~A?" (frame->frame fr2 mx8)))
- (if (not (equal? (frame->frame fr4 mx1) (make-frame 1 5))) (snd-display #__line__ ";frame->frame 1 4: ~A?" (frame->frame fr4 mx1)))
- (if (not (equal? (frame->frame fr8 mx1) (make-frame 1 5))) (snd-display #__line__ ";frame->frame 1 8: ~A?" (frame->frame fr8 mx1)))
- (if (not (equal? (frame->frame fr2 mx8id) (make-frame 8 1 2 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8id 2: ~A?" (frame->frame fr2 mx8id)))
- (if (not (equal? (frame->frame fr2 mx4id) (make-frame 4 1 2 0 0))) (snd-display #__line__ ";frame->frame 4id 2: ~A?" (frame->frame fr2 mx4id)))
- (if (not (equal? (frame->frame fr4 mx8) (make-frame 8 10 0 0 0 0 0 0 0))) (snd-display #__line__ ";frame->frame 8 4: ~A?" (frame->frame fr4 mx8)))
- (if (not (equal? (frame->frame fr4 mx4) (make-frame 4 1 1 1 1))) (snd-display #__line__ ";frame->frame 4 4: ~A?" (frame->frame fr4 mx4))))
-
- (let ((fr1 (make-frame 2))
- (fr2 (make-frame 2))
- (mx1 (make-mixer 2))
- (mx2 (make-mixer 2)))
- (frame-set! fr1 0 .1)
- (let ((fradd (frame+ fr1 fr1 fr2)))
- (if (not (equal? fr2 fradd)) (snd-display #__line__ ";frame+ with res frame: ~A ~A" fr2 fradd))
- (if (not (equal? fr2 (make-frame 2 0.2 0.0))) (snd-display #__line__ ";frame+ res: ~A" fr2))
- (set! fradd (frame* fr1 fr1 fr2))
- (if (not (equal? fr2 fradd)) (snd-display #__line__ ";frame* with res frame: ~A ~A" fr2 fradd))
- (if (or (fneq (frame-ref fr2 0) .01) (fneq (frame-ref fr2 1) 0.0)) (snd-display #__line__ ";frame* res: ~A" fr2)))
- (set! (mixer-ref mx1 0 0) .1)
- (let ((mxadd (mixer* mx1 mx1 mx2)))
- (if (not (equal? mx2 mxadd)) (snd-display #__line__ ";mixer* with res frame: ~A ~A" mx2 mxadd))
- (if (fneq (mixer-ref mx2 0 0) .01) (snd-display #__line__ ";mixer* res: ~A" mx2))))
-
-
- (let ((fr1 (frame .1 .2))
- (fr2 (make-frame 2 .1 .2)))
- (if (not (equal? fr1 fr2))
- (snd-display #__line__ ";frame...: ~A ~A" fr1 fr2)))
-
- (let ((fr1 (frame .1)))
- (if (fneq (fr1 0) .1) (snd-display #__line__ ";frame gen ref (.1): ~A" (fr1 0)))
- (set! (fr1 0) .2)
- (if (fneq (fr1 0) .2) (snd-display #__line__ ";frame gen ref (.2): ~A" (fr1 0)))
- (if (not (equal? fr1 (frame .2)))
- (snd-display #__line__ ";frame gen set! (.2): ~A" fr1)))
-
- (let ((fr1 (frame .1 .2 .3 .4)))
- (set! (fr1 2) (+ (fr1 1) (fr1 2)))
- (if (fneq (fr1 2) .5) (snd-display #__line__ ";frame gen ref/set (.5): ~A" (fr1 2))))
-
- (let ((fr1 (frame)))
- (if (or (not (frame? fr1))
- (not (equal? fr1 (make-frame 1 0.0))))
- (snd-display #__line__ ";frame no args: ~A" fr1))
- (set! (fr1 0) .5)
- (if (fneq (fr1 0) .5) (snd-display #__line__ ";frame ref/set no args: ~A" (fr1 0))))
-
- (let ((fr1 (make-frame 2 .1)))
- (if (not (equal? fr1 (frame .1 0.0)))
- (snd-display #__line__ ";make-frame missing arg: ~A" fr1)))
-
-
- (let ((mx (mixer .1 .2 .3 .4)))
- (if (fneq (mx 0 0) .1) (snd-display #__line__ ";mixer gen ref (.1): ~A" (mx 0 0)))
- (if (not (equal? mx (make-mixer 2 .1 .2 .3 .4))) (snd-display #__line__ ";mixer...: ~A" mx))
- (set! (mx 0 0) .5)
- (if (fneq (mx 0 0) .5) (snd-display #__line__ ";mixer gen set (.5): ~A" (mx 0 0)))
- (if (not (equal? mx (make-mixer 2 .5 .2 .3 .4))) (snd-display #__line__ ";mixer... (after set): ~A" mx))
- (if (fneq (mx 1 0) .3) (snd-display #__line__ ";mixer gen ref (.3): ~A" (mx 1 0)))
- (set! (mx 0 1) .5)
- (if (fneq (mx 0 1) .5) (snd-display #__line__ ";mixer (0 1) gen set (.5): ~A" (mx 0 1)))
- (if (not (equal? mx (make-mixer 2 .5 .5 .3 .4))) (snd-display #__line__ ";mixer... (after set 1): ~A" mx)))
-
- (let ((mx (mixer .1)))
- (if (not (equal? mx (make-mixer 1 .1))) (snd-display #__line__ ";mixer .1: ~A" mx))
- (if (fneq (mx 0 0) .1) (snd-display #__line__ ";mixer (1) gen ref (.1): ~A" (mx 0 0)))
- (set! (mx 0 0) .5)
- (if (fneq (mx 0 0) .5) (snd-display #__line__ ";mixer (1) gen set (.5): ~A" (mx 0 0))))
-
- (let ((mx (mixer .1 .2 .3)))
- (if (not (equal? mx (make-mixer 2 .1 .2 .3 0.0))) (snd-display #__line__ ";mixer .1 .2 .3: ~A" mx))
- (set! (mx 1 1) .5)
- (if (fneq (mx 1 1) .5) (snd-display #__line__ ";mixer (1 1) gen set (.5): ~A" (mx 1 1))))
-
- (let ((mx (mixer)))
- (if (not (equal? mx (make-mixer 1 0.0))) (snd-display #__line__ ";(mixer): ~A" mx)))
-
-
- (for-each
- (lambda (chans)
- (let ((m1 (make-mixer chans)))
- (if (or (not (= (mus-channels m1) chans))
- (not (= (mus-length m1) chans)))
- (snd-display #__line__ ";mixer ~A chans but: ~A ~A" chans (mus-channels m1) (mus-length m1)))
- (do ((i 0 (+ 1 i)))
- ((= i chans))
- (do ((j 0 (+ 1 j)))
- ((= j chans))
- (mixer-set! m1 i j (+ (* i .01) (* j .1)))))
- (do ((i 0 (+ 1 i)))
- ((= i chans))
- (do ((j 0 (+ 1 j)))
- ((= j chans))
- (if (fneq (mixer-ref m1 i j) (+ (* i .01) (* j .1)))
- (snd-display #__line__ ";mixer[~A ~A] = ~A (~A)?" i j (mixer-ref m1 i j) (+ (* i .01) (* j .1))))))
- (let ((mempty (make-mixer chans))
- (midentity (make-mixer chans))
- (mpick (make-mixer chans)))
- (do ((i 0 (+ 1 i)))
- ((= i chans))
- (mixer-set! midentity i i 1.0))
- (mixer-set! mpick (- chans 1) (- chans 1) 1.0)
- (let ((mzero (mixer* m1 mempty))
- (msame (mixer* m1 midentity))
- (mone (mixer* m1 mpick)))
- (do ((i 0 (+ 1 i)))
- ((= i chans))
- (do ((j 0 (+ 1 j)))
- ((= j chans))
- (if (fneq (mixer-ref mzero i j) 0.0) (snd-display #__line__ ";mzero ~A ~A = ~A?" i j (mixer-ref mzero i j)))
- (if (fneq (mixer-ref m1 i j) (mixer-ref msame i j)) (snd-display #__line__ ";msame ~A ~A?" (mixer-ref msame i j) (mixer-ref m1 i j)))
- (if (and (fneq (mixer-ref mone i j) 0.0)
- (not (= i (- chans 1)))
- (not (= j (- chans 1))))
- (snd-display #__line__ ";mone ~A ~A = ~A?" i j (mixer-ref mone i j)))))))))
- (list 1 2 4 8))
-
- (let ((mx (make-mixer 4 4)))
- (let ((tag (catch #t (lambda () (set! (mus-length mx) 2)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error)) (snd-display #__line__ ";set mixer-length: ~A ~A" tag (mus-length mx)))))
-
- (letrec ((mixer-equal? (lambda (m1 m2)
- ;; this is less demanding than the built-in function
- (let ((len (mus-length m1))
- (happy #t))
- (and (= len (mus-length m2))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i len))
- happy)
- (do ((j 0 (+ 1 j)))
- ((or (not happy) (= j len)))
- (if (> (abs (- (mat m1 i j) (mat m2 i j))) .001)
- (set! happy #f))))))))
- (mixer-normal? (lambda (mx)
- (mixer-equal? (mixer* mx (mixer-transpose mx)) ; conjugate transpose (hermitian) if complex
- (mixer* (mixer-transpose mx) mx))))
- (mixer-orthogonal? (lambda (mx)
- (mixer-equal? (mixer-transpose mx)
- (mixer-inverse mx))))
- (mixer-unitary? (lambda (mx) (mixer-orthogonal? mx))) ; reals
- (mixer-symmetric? (lambda (m1) (mixer-equal? m1 (mixer-transpose m1))))
- (mixer-hermitian? (lambda (mx) (mixer-symmetric? mx))) ; assuming reals
- (frame-equal? (lambda (f1 f2)
- (let ((len (mus-length f1))
- (happy #t))
- (and (= len (mus-length f2))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i len))
- happy)
- (if (> (abs (- (frame-ref f1 i) (frame-ref f2 i))) .001)
- (set! happy #f)))))))
- (slow-mixer-inverse (lambda (mx)
- (let ((n (mus-length mx))
- (det (mixer-determinant mx)))
- (if (not (= det 0.0))
- (let ((nmx (make-zero-mixer n)))
- (do ((i 0 (+ 1 i)))
- ((= i n))
- (do ((j 0 (+ 1 j)))
- ((= j n))
- (mixer-set! nmx j i (* (if (odd? (+ i j)) -1 1)
- (/ (mixer-determinant (sub-matrix mx i j))
- det)))))
- nmx)
- #f))))
- (slow-mixer-solve (lambda (A b) ; Ax=b where A is mixer and b is frame, returns frame
- (if (= (mus-length A) 1)
- (if (not (= (mixer-ref A 0 0) 0.0))
- (make-frame 1 (/ (frame-ref b 0) (mixer-ref A 0 0)))
- #f)
- (let ((imx (slow-mixer-inverse A)))
- (if (mixer? imx) ; else determinant = 0
- (frame->frame imx b)
- #f)))))
- (make-random-frame (lambda (size)
- (let ((fr (make-frame size)))
- (do ((i 0 (+ 1 i)))
- ((= i size))
- (frame-set! fr i (- 1.0 (random 2.0))))
- fr)))
- (make-random-mixer (lambda (size)
- (let ((mx (make-mixer size)))
- (do ((i 0 (+ 1 i)))
- ((= i size))
- (do ((j 0 (+ 1 j)))
- ((= j size))
- (mixer-set! mx i j (- 1.0 (random 2.0)))))
- mx)))
- )
- (if (fneq (mixer-determinant (make-mixer 2 1 2 3 4)) -2.0)
- (snd-display #__line__ ";mixer-determinant -2: ~A" (mixer-determinant (make-mixer 2 1 2 3 4))))
- (if (fneq (mixer-determinant (make-mixer 3 1 2 3 4 5 6 7 8 9)) 0.0)
- (snd-display #__line__ ";mixer-determinant 0: ~A" (mixer-determinant (make-mixer 3 1 2 3 4 5 6 7 8 9))))
- (if (fneq (mixer-determinant (make-mixer 4 1 2 3 4 8 7 6 5 1 8 2 7 3 6 4 5)) -144.0) ; Eves Elementary Matrix Theory
- (snd-display #__line__ ";mixer-determinant -144: ~A" (mixer-determinant (make-mixer 4 1 2 3 4 8 7 6 5 1 8 2 7 3 6 4 5))))
- (if (fneq (mixer-determinant (make-mixer 5 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)) -4656.0)
- (snd-display #__line__ ";mixer-determinant -4656: ~A" (mixer-determinant (make-mixer 5 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47
- 53 59 61 67 71 73 79 83 89 97))))
- (if (fneq (mixer-determinant (make-mixer 6 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89
- 97 101 103 107 109 113 127 131 137 139 149 151)) -14304.0)
- (snd-display #__line__ ";mixer-determinant -14304: ~A"
- (mixer-determinant (make-mixer 6 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89
- 97 101 103 107 109 113 127 131 137 139 149 151))))
- (if (not (mixer-equal? (mixer-transpose (make-mixer 2 1 2 3 4))
- (make-mixer 2 1.000 3.000 2.000 4.000)))
- (snd-display #__line__ ";mixer-transpose 1: ~A" (mixer-transpose (make-mixer 2 1 2 3 4))))
- (if (not (mixer-equal? (mixer-transpose (make-mixer 3 1 2 3 4 5 6 7 8 9))
- (make-mixer 3 1.000 4.000 7.000 2.000 5.000 8.000 3.000 6.000 9.000)))
- (snd-display #__line__ ";mixer-transpose 2: ~A" (mixer-transpose (make-mixer 3 1 2 3 4 5 6 7 8 9))))
- (if (not (mixer-equal? (mixer* (make-mixer 2 1 0 0 1) (make-mixer 2 2 0 0 2))
- (make-mixer 2 2.000 0.000 0.000 2.000)))
- (snd-display #__line__ ";mixer* 1: ~A" (mixer* (make-mixer 2 1 0 0 1) (make-mixer 2 2 0 0 2))))
- (if (not (mixer-equal? (mixer* (make-mixer 3 2 3 5 7 11 13 19 23 29) (make-mixer 3 41 43 47 53 59 61 67 71 73))
- (make-mixer 3 576.000 618.000 642.000 1741.000 1873.000 1949.000 3941.000 4233.000 4413.000)))
- (snd-display #__line__ ";mixer* 2: ~A" (mixer* (make-mixer 3 2 3 5 7 11 13 19 23 29) (make-mixer 3 41 43 47 53 59 61 67 71 73))))
- (if (not (mixer-equal? (slow-mixer-inverse (make-mixer 2 1 0 0 1))
- (make-mixer 2 1.000 0.000 0.000 1.000)))
- (snd-display #__line__ ";slow-mixer-inverse 1: ~A" (slow-mixer-inverse (make-mixer 2 1 0 0 1))))
- (if (not (mixer-equal? (slow-mixer-inverse (make-mixer 2 2 3 5 8))
- (make-mixer 2 8.000 -3.000 -5.000 2.000)))
- (snd-display #__line__ ";slow-mixer-inverse 2: ~A" (slow-mixer-inverse (make-mixer 2 2 3 5 8))))
- (if (not (mixer-equal? (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))
- (make-mixer 3 -0.077 -0.333 0.205 -0.769 0.500 -0.115 0.692 -0.167 -0.013)))
- (snd-display #__line__ ";slow-mixer-inverse 3: ~A" (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))))
- (if (not (mixer-equal? (slow-mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))
- (make-mixer 4 -7.000 4.708 -1.042 -0.333 9.000 -6.396 1.396 0.500
- -1.000 0.875 -0.042 -0.167 -1.000 0.771 -0.271 0.000)))
- (snd-display #__line__ ";slow-mixer-inverse 4: ~A" (slow-mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))))
- (if (not (mixer-equal? (slow-mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
- 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))
- (make-mixer 6 -1.355 0.020 -0.000 1.090 -1.153 0.333 0.092 -0.025 0.000 -0.042 0.070 -0.029
- 1.612 0.006 -0.250 -1.205 1.249 -0.264 0.079 0.002 0.250 -0.314 0.425 -0.241
- -0.551 -0.011 0.250 0.200 -0.476 0.188 0.068 0.009 -0.250 0.306 -0.145 0.028)))
- (snd-display #__line__ ";slow-mixer-inverse 5: ~A" (slow-mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
- 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))))
- (if (not (mixer-equal? (mixer* (make-mixer 2 2 3 5 8) (slow-mixer-inverse (make-mixer 2 2 3 5 8)))
- (make-scalar-mixer 2 1.0)))
- (snd-display #__line__ ";slow-mixer-inverse 6: ~A" (mixer* (make-mixer 2 2 3 5 8) (slow-mixer-inverse (make-mixer 2 2 3 5 8)))))
- (if (not (mixer-equal? (mixer* (make-mixer 3 2 3 5 7 11 13 17 19 23) (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23)))
- (make-scalar-mixer 3 1.0)))
- (snd-display #__line__ ";slow-mixer-inverse 7: ~A"
- (mixer* (make-mixer 3 2 3 5 7 11 13 17 19 23) (slow-mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23)))))
-
- (if (not (mixer-equal? (mixer-inverse (make-mixer 2 1 0 0 1))
- (make-mixer 2 1.000 0.000 0.000 1.000)))
- (snd-display #__line__ ";mixer-inverse 1: ~A" (mixer-inverse (make-mixer 2 1 0 0 1))))
- (if (not (mixer-equal? (mixer-inverse (make-mixer 2 2 3 5 8))
- (make-mixer 2 8.000 -3.000 -5.000 2.000)))
- (snd-display #__line__ ";mixer-inverse 2: ~A" (mixer-inverse (make-mixer 2 2 3 5 8))))
- (if (not (mixer-equal? (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))
- (make-mixer 3 -0.077 -0.333 0.205 -0.769 0.500 -0.115 0.692 -0.167 -0.013)))
- (snd-display #__line__ ";mixer-inverse 3: ~A" (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23))))
- (if (not (mixer-equal? (mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))
- (make-mixer 4 -7.000 4.708 -1.042 -0.333 9.000 -6.396 1.396 0.500
- -1.000 0.875 -0.042 -0.167 -1.000 0.771 -0.271 0.000)))
- (snd-display #__line__ ";mixer-inverse 4: ~A" (mixer-inverse (make-mixer 4 2 3 5 7 17 19 23 29 41 43 47 53 67 71 73 97))))
- (if (not (mixer-equal? (mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
- 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))
- (make-mixer 6 -1.355 0.020 -0.000 1.090 -1.153 0.333 0.092 -0.025 0.000 -0.042 0.070 -0.029
- 1.612 0.006 -0.250 -1.205 1.249 -0.264 0.079 0.002 0.250 -0.314 0.425 -0.241
- -0.551 -0.011 0.250 0.200 -0.476 0.188 0.068 0.009 -0.250 0.306 -0.145 0.028)))
- (snd-display #__line__ ";mixer-inverse 5: ~A" (mixer-inverse (make-mixer 6 2 3 5 7 11 13 17 -19 23 29 31 37 41 43 47 53 59 61
- 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151))))
- (if (not (mixer-equal? (mixer* (make-mixer 2 2 3 5 8) (mixer-inverse (make-mixer 2 2 3 5 8)))
- (make-scalar-mixer 2 1.0)))
- (snd-display #__line__ ";mixer-inverse 6: ~A" (mixer* (make-mixer 2 2 3 5 8) (mixer-inverse (make-mixer 2 2 3 5 8)))))
- (if (not (mixer-equal? (mixer* (make-mixer 3 2 3 5 7 11 13 17 19 23) (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23)))
- (make-scalar-mixer 3 1.0)))
- (snd-display #__line__ ";mixer-inverse 7: ~A"
- (mixer* (make-mixer 3 2 3 5 7 11 13 17 19 23) (mixer-inverse (make-mixer 3 2 3 5 7 11 13 17 19 23)))))
- (if (invert-matrix (make-mixer 3 1 2 3 4 5 6 7 8 9))
- (snd-display #__line__ ";invert-matrix missed singular case? ~A" (invert-matrix (make-mixer 3 1 2 3 4 5 6 7 8 9))))
- (if (fneq (mixer-trace (make-mixer 3 1 0 0 0 2 0 0 0 3)) 6.0)
- (snd-display #__line__ ";mixer-trace (6): ~A" (mixer-trace (make-mixer 3 1 0 0 0 2 0 0 0 3))))
-
- (if (not (mixer-diagonal? (make-scalar-mixer 2 2.0))) (snd-display #__line__ ";mixer-diagonal 1"))
- (if (not (mixer-diagonal? (make-mixer 3 1 0 0 0 1 0 0 0 1))) (snd-display #__line__ ";mixer-diagonal 2"))
- (if (mixer-diagonal? (make-mixer 3 1 0 0 0 1 1 0 0 1)) (snd-display #__line__ ";mixer-diagonal 3"))
- (if (not (mixer-diagonal? (make-mixer 3 0 0 0 0 1 0 0 0 1))) (snd-display #__line__ ";mixer-diagonal 4"))
- (if (not (mixer-symmetric? (make-mixer 3 0 0 0 0 1 0 0 0 1))) (snd-display #__line__ ";mixer-symmetric 1"))
- (if (not (mixer-symmetric? (make-mixer 3 1 2 0 2 1 0 0 0 1))) (snd-display #__line__ ";mixer-symmetric 2"))
- (if (mixer-symmetric? (make-mixer 3 1 2 0 2 1 0 0 2 1)) (snd-display #__line__ ";mixer-symmetric 3"))
- (if (not (mixer-equal? (make-scalar-mixer 2 2.0) (make-mixer 2 2.0 0 0 2.0))) (snd-display #__line__ ";mixer-equal 1"))
- (if (mixer-equal? (make-mixer 2 1 2 3 4) (make-mixer 3 1 2 3 4 5 6 7 8 9)) (snd-display #__line__ ";mixer-equal 2"))
- (if (mixer-equal? (make-mixer 2 1 2 3 4) (make-mixer 2 1 2 3 5)) (snd-display #__line__ ";mixer-equal 3"))
- (if (not (mixer-equal? (mixer-poly (make-mixer 2 1 0 0 1) 1.0 1.0) (make-mixer 2 2.0 0.0 0.0 2.0)))
- (snd-display #__line__ ";mixer-poly 1: ~A" (mixer-poly (make-mixer 2 1 0 0 1) 1.0 1.0)))
- (if (not (mixer-equal? (mixer-poly (make-mixer 1 1) 1) (make-mixer 1 1.0)))
- (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 1 1) 1)))
- (if (not (mixer-equal? (mixer-poly (make-mixer 2 1 0 0 1) 1 0 0) (make-mixer 2 1.0 0.0 0.0 1.0)))
- (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 0 0 1) 1 0 0)))
- (if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0) (make-mixer 2 9.0 8.0 16.0 17.0)))
- (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0)))
- (if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 1 0) (make-mixer 2 10.0 10.0 20.0 20.0)))
- (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 1 0)))
- (if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 1 2) (make-mixer 2 12.0 10.0 20.0 22.0)))
- (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 1 2)))
- (if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0 0) (make-mixer 2 41.0 42.0 84.0 83.0)))
- (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 0 0)))
- (if (not (mixer-equal? (mixer-poly (make-mixer 2 1 2 4 3) 1 0 1 0) (make-mixer 2 42.0 44.0 88.0 86.0)))
- (snd-display #__line__ ";mixer-poly 2: ~A" (mixer-poly (make-mixer 2 1 2 4 3) 1 0 1 0)))
-
- (let ((fr (slow-mixer-solve (make-mixer 2 1 0 0 2) (make-frame 2 2 3))))
- (if (not (frame-equal? fr (make-frame 2 2.000 1.500))) (snd-display #__line__ ";slow-mixer-solve 1: ~A" fr)))
- (let ((fr (slow-mixer-solve (make-mixer 2 1 1 0 1) (make-frame 2 2 3))))
- (if (not (frame-equal? fr (make-frame 2 -1.000 3.000))) (snd-display #__line__ ";slow-mixer-solve 2: ~A" fr)))
- (let ((fr (slow-mixer-solve (make-mixer 3 2 1 3 1 -1 0 1 1 2) (make-frame 3 1 1 1))))
- (if fr (snd-display #__line__ ";slow-mixer-solve 3 (#f): ~A" fr)))
- (let ((fr (slow-mixer-solve (make-mixer 3 2 1 3 1 -1 0 1 1 2) (make-frame 3 1 1 .333))))
- (if fr (snd-display #__line__ ";slow-mixer-solve 4 (#f): ~A" fr)))
- (let ((fr (slow-mixer-solve (make-mixer 3 2 1 3 1 -1 1 1 1 2) (make-frame 3 1 1 1))))
- (if (not (frame-equal? fr (make-frame 3 -2.000 -1.000 2.000))) (snd-display #__line__ ";slow-mixer-solve 5: ~A" fr)))
- (let ((fr (slow-mixer-solve (make-mixer 3 1 -1 -1 3 -3 2 2 -1 1) (make-frame 3 2 16 9))))
- (if (not (frame-equal? fr (make-frame 3 3.000 -1.000 2.000))) (snd-display #__line__ ";slow-mixer-solve 6: ~A" fr)))
- (let ((fr (slow-mixer-solve (make-mixer 3 1 1 1 2 3 1 1 -1 -2) (make-frame 3 3 5 -5))))
- (if (not (frame-equal? fr (make-frame 3 0.000 1.000 2.000))) (snd-display #__line__ ";slow-mixer-solve 7: ~A" fr)))
- (let ((fr (slow-mixer-solve (make-mixer 1 .5) (make-frame 1 2))))
- (if (not (frame-equal? fr (make-frame 1 4.000))) (snd-display #__line__ ";slow-mixer-solve 8: ~A" fr)))
- (let ((fr (slow-mixer-solve (make-mixer 4 2 0 0 0 0 3 0 0 0 0 4 0 0 0 0 5) (make-frame 4 1 1 1 1))))
- (if (not (frame-equal? fr (make-frame 4 0.500 0.333 0.250 0.200))) (snd-display #__line__ ";slow-mixer-solve 9: ~A" fr)))
-
- (let ((fr (mixer-solve (make-mixer 2 1 0 0 2) (make-frame 2 2 3))))
- (if (not (frame-equal? fr (make-frame 2 2.000 1.500))) (snd-display #__line__ ";mixer-solve 1: ~A" fr)))
- (let ((fr (mixer-solve (make-mixer 2 1 1 0 1) (make-frame 2 2 3))))
- (if (not (frame-equal? fr (make-frame 2 -1.000 3.000))) (snd-display #__line__ ";mixer-solve 2: ~A" fr)))
- (let ((fr (mixer-solve (make-mixer 3 2 1 3 1 -1 0 1 1 2) (make-frame 3 1 1 1))))
- (if fr (snd-display #__line__ ";mixer-solve 3 (#f): ~A" fr)))
- (let ((fr (mixer-solve (make-mixer 3 2 1 3 1 -1 0 1 1 2) (make-frame 3 1 1 .333))))
- (if fr (snd-display #__line__ ";mixer-solve 4 (#f): ~A" fr)))
- (let ((fr (mixer-solve (make-mixer 3 2 1 3 1 -1 1 1 1 2) (make-frame 3 1 1 1))))
- (if (not (frame-equal? fr (make-frame 3 -2.000 -1.000 2.000))) (snd-display #__line__ ";mixer-solve 5: ~A" fr)))
- (let ((fr (mixer-solve (make-mixer 3 1 -1 -1 3 -3 2 2 -1 1) (make-frame 3 2 16 9))))
- (if (not (frame-equal? fr (make-frame 3 3.000 -1.000 2.000))) (snd-display #__line__ ";mixer-solve 6: ~A" fr)))
- (let ((fr (mixer-solve (make-mixer 3 1 1 1 2 3 1 1 -1 -2) (make-frame 3 3 5 -5))))
- (if (not (frame-equal? fr (make-frame 3 0.000 1.000 2.000))) (snd-display #__line__ ";mixer-solve 7: ~A" fr)))
- (let ((fr (mixer-solve (make-mixer 1 .5) (make-frame 1 2))))
- (if (not (frame-equal? fr (make-frame 1 4.000))) (snd-display #__line__ ";mixer-solve 8: ~A" fr)))
- (let ((fr (mixer-solve (make-mixer 4 2 0 0 0 0 3 0 0 0 0 4 0 0 0 0 5) (make-frame 4 1 1 1 1))))
- (if (not (frame-equal? fr (make-frame 4 0.500 0.333 0.250 0.200))) (snd-display #__line__ ";mixer-solve 9: ~A" fr)))
-
- ;; try random input to mixer-inverse
- (do ((k 2 (+ 1 k)))
- ((= k 20))
- (let* ((mx (make-random-mixer k))
- (imx (mixer-inverse (mixer-copy mx)))
- (mmx (mixer* mx imx)))
- (if (not (mixer-equal? mmx (make-scalar-mixer k 1.0)))
- (snd-display #__line__ ";mixer-inverse r~D: ~A * ~A -> ~A" k mx imx mmx))))
-
- (let ((fr (frame-reverse! (make-frame 2 .5 2.0))))
- (if (not (frame-equal? fr (make-frame 2 2.0 0.5)))
- (snd-display #__line__ ";frame-reverse! 2: ~A" fr)))
- (let ((fr (frame-reverse! (make-frame 3 .5 1.0 2.0))))
- (if (not (frame-equal? fr (make-frame 3 2.0 1.0 0.5)))
- (snd-display #__line__ ";frame-reverse! 3: ~A" fr)))
-
- (let ((hi (make-mixer 3 10 5 1 1 20 5 1 3 7))
- (ho (make-mixer 3 10 5 2 1 3 2 1 3 2)))
- ;; these adapted from gsl linalg tests
- (let ((val (mixer* hi ho)))
- (if (not (mixer-equal? val (make-mixer 3 106.000 68.000 32.000 35.000 80.000 52.000 20.000 35.000 22.000)))
- (snd-display #__line__ ";mixer* 3x3 1: ~A" val)))
-
- (let ((val (mixer* hi (mixer-transpose ho))))
- (if (not (mixer-equal? val (make-mixer 3 127.000 27.000 27.000 120.000 71.000 71.000 39.000 24.000 24.000)))
- (snd-display #__line__ ";mixer* 3x3 2: ~A" val)))
-
- (let ((val (mixer* (mixer-transpose hi) (mixer-transpose ho))))
- (if (not (mixer-equal? val (make-mixer 3 107.000 15.000 15.000 156.000 71.000 71.000 49.000 30.000 30.000)))
- (snd-display #__line__ ";mixer* 3x3 2: ~A" val))))
-
- ;; from Golub and van Loan:
- (let ((val (mixer-solve (make-mixer 2 .001 1.0 1.0 2.0) (make-frame 2 1.0 3.0))))
- (if (not (frame-equal? val (make-frame 2 1.002 0.999)))
- (snd-display #__line__ ";mixer-solve G1: ~A" val)))
- (let ((val (mixer-solve (make-mixer 2 .0001 1.0 1.0 1.0) (make-frame 2 1.0 3.0))))
- (if (not (frame-equal? val (make-frame 2 2.000 1.000)))
- (snd-display #__line__ ";mixer-solve G2: ~A" val)))
- (let ((val (mixer-solve (make-mixer 2 .986 .579 .409 .237) (make-frame 2 .235 .107))))
- (if (not (frame-equal? val (make-frame 2 2.000 -3.000)))
- (snd-display #__line__ ";mixer-solve G3: ~A" val)))
- (let ((val (invert-matrix (make-mixer 3 2 -1 1 -1 1.0e-6 1.0e-6 1 1.0e-6 1.0e-6) (make-frame 3 (* 2 (+ 1 1.0e-6)) -1.0e-6 1.0e-6))))
- (if (or (not val)
- (not (frame-equal? (cadr val) (make-frame 3 0.000 -1.000 1.000))))
- (snd-display #__line__ ";mixer-solve G4: ~A" val)))
- (let ((val (invert-matrix (make-mixer 3 2 -1 1 -1 1.0e-7 1.0e-7 1 1.0e-7 1.0e-7) (make-frame 3 (* 2 (+ 1 1.0e-7)) -1.0e-7 1.0e-7))))
- (if (or (not val)
- (not (frame-equal? (cadr val) (make-frame 3 0.000 -1.000 1.000))))
- (snd-display #__line__ ";mixer-solve G5: ~A" val)))
- (let ((val (mixer-solve (make-mixer 3 1 4 7 2 5 8 3 6 10) (make-frame 3 1 1 1))))
- (if (not (frame-equal? val (make-frame 3 -0.333 0.333 -0.000)))
- (snd-display #__line__ ";mixer-solve G6: ~A" val)))
- (let ((val (mixer-solve (make-mixer 2 1 0 0 1.0e-6) (make-frame 2 1 1.0e-6))))
- (if (not (frame-equal? val (make-frame 2 1.000 1.000)))
- (snd-display #__line__ ";mixer-solve G7: ~A" val)))
- (let ((val (invert-matrix (make-mixer 2 1 0 0 1.0e-8) (make-frame 2 1 1.0e-8) 1.0e-10)))
- (if (or (not val)
- (not (frame-equal? (cadr val) (make-frame 2 1.000 1.000))))
- (snd-display #__line__ ";mixer-solve G8: ~A" val)))
- (let ((val (invert-matrix (make-mixer 2 1 0 0 1.0e-12) (make-frame 2 1 1.0e-12) 1.0e-14)))
- (if (or (not val)
- (not (frame-equal? (cadr val) (make-frame 2 1.000 1.000))))
- (snd-display #__line__ ";mixer-solve G9: ~A" val)))
- (let ((val (mixer-solve (make-mixer 2 10 100000 1 1) (make-frame 2 100000 2))))
- (if (not (frame-equal? val (make-frame 2 1.000 1.000)))
- (snd-display #__line__ ";mixer-solve G10: ~A" val)))
-
- (let ((val (frame-cross (make-frame 3 0 0 1) (make-frame 3 0 -1 0))))
- (if (not (frame-equal? val (make-frame 3 1.000 0.000 0.000)))
- (snd-display #__line__ ";frame-cross: ~A" val)))
-
- (let ((val (frame-normalize (make-frame 3 4 3 0))))
- (if (not (frame-equal? val (make-frame 3 0.800 0.600 0.000)))
- (snd-display #__line__ ";frame-normalize: ~A" val)))
- )
+ (let ((f3 (make-firmant 1200.0 0.99))) (firmant f3 1.0) f3))
+ (test-gen-equal (let ((f1 (make-firmant 1200.0 0.9))) (firmant f1 1.0) f1)
+ (let ((f2 (make-firmant 1200.0 0.9))) (firmant f2 1.0) f2)
+ (let ((f3 (make-firmant 1200.0 0.5))) (firmant f3 1.0) f3))
(let ((gen (make-fft-window hamming-window 16)))
- (if (not (vequal gen (vct 0.080 0.115 0.215 0.364 0.540 0.716 0.865 1.000 1.000 0.865 0.716 0.540 0.364 0.215 0.115 0.080)))
+ (if (not (vequal gen (float-vector 0.080 0.115 0.215 0.364 0.540 0.716 0.865 1.000 1.000 0.865 0.716 0.540 0.364 0.215 0.115 0.080)))
(snd-display #__line__ ";hamming window: ~A" gen)))
(let ((gen (make-fft-window rectangular-window 16)))
- (if (not (vequal gen (vct 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
+ (if (not (vequal gen (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
(snd-display #__line__ ";rectangular window: ~A" gen)))
(let ((gen (make-fft-window hann-window 16)))
- (if (not (vequal gen (vct 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
(snd-display #__line__ ";hann window: ~A" gen)))
(let ((gen (make-fft-window welch-window 16)))
- (if (not (vequal gen (vct 0.000 0.234 0.438 0.609 0.750 0.859 0.938 1.000 1.000 0.938 0.859 0.750 0.609 0.438 0.234 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.234 0.438 0.609 0.750 0.859 0.938 1.000 1.000 0.938 0.859 0.750 0.609 0.438 0.234 0.000)))
(snd-display #__line__ ";welch window: ~A" gen)))
(let ((gen (make-fft-window connes-window 16)))
- (if (not (vequal gen (vct 0.000 0.055 0.191 0.371 0.562 0.739 0.879 1.000 1.000 0.879 0.739 0.562 0.371 0.191 0.055 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.055 0.191 0.371 0.562 0.739 0.879 1.000 1.000 0.879 0.739 0.562 0.371 0.191 0.055 0.000)))
(snd-display #__line__ ";connes window: ~A" gen)))
(let ((gen (make-fft-window parzen-window 16)))
- (if (not (vequal gen (vct 0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
(snd-display #__line__ ";parzen window: ~A" gen)))
(let ((gen (make-fft-window bartlett-window 16)))
- (if (not (vequal gen (vct 0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.125 0.250 0.375 0.500 0.625 0.750 1.000 1.000 0.750 0.625 0.500 0.375 0.250 0.125 0.000)))
(snd-display #__line__ ";bartlett window: ~A" gen)))
(let ((gen (make-fft-window blackman2-window 16)))
- (if (not (vequal gen (vct 0.005 0.020 0.071 0.177 0.344 0.558 0.775 1.000 1.000 0.775 0.558 0.344 0.177 0.071 0.020 0.005)))
+ (if (not (vequal gen (float-vector 0.005 0.020 0.071 0.177 0.344 0.558 0.775 1.000 1.000 0.775 0.558 0.344 0.177 0.071 0.020 0.005)))
(snd-display #__line__ ";blackman2 window: ~A" gen)))
(let ((gen (make-fft-window blackman3-window 16)))
- (if (not (vequal gen (vct 0.000 0.003 0.022 0.083 0.217 0.435 0.696 1.000 1.000 0.696 0.435 0.217 0.083 0.022 0.003 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.003 0.022 0.083 0.217 0.435 0.696 1.000 1.000 0.696 0.435 0.217 0.083 0.022 0.003 0.000)))
(snd-display #__line__ ";blackman3 window: ~A" gen)))
(let ((gen (make-fft-window blackman4-window 16)))
- (if (not (vequal gen (vct 0.002 0.002 0.003 0.017 0.084 0.263 0.562 1.000 1.000 0.562 0.263 0.084 0.017 0.003 0.002 0.002)))
+ (if (not (vequal gen (float-vector 0.002 0.002 0.003 0.017 0.084 0.263 0.562 1.000 1.000 0.562 0.263 0.084 0.017 0.003 0.002 0.002)))
(snd-display #__line__ ";blackman4 window: ~A" gen)))
(let ((gen (make-fft-window blackman5-window 16)))
- (if (not (vequal gen (vct 0.000 0.000 0.003 0.022 0.097 0.280 0.574 1.000 1.000 0.574 0.280 0.097 0.022 0.003 0.000 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.000 0.003 0.022 0.097 0.280 0.574 1.000 1.000 0.574 0.280 0.097 0.022 0.003 0.000 0.000)))
(snd-display #__line__ ";blackman5 window: ~A" gen)))
(let ((gen (make-fft-window blackman6-window 16)))
- (if (not (vequal gen (vct 0.000 0.000 0.001 0.011 0.064 0.223 0.520 1.000 1.000 0.520 0.223 0.064 0.011 0.001 0.000 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.000 0.001 0.011 0.064 0.223 0.520 1.000 1.000 0.520 0.223 0.064 0.011 0.001 0.000 0.000)))
(snd-display #__line__ ";blackman6 window: ~A" gen)))
(let ((gen (make-fft-window blackman7-window 16)))
- (if (not (vequal gen (vct 0.000 0.000 0.000 0.006 0.042 0.177 0.471 1.000 1.000 0.471 0.177 0.042 0.006 0.000 0.000 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.000 0.000 0.006 0.042 0.177 0.471 1.000 1.000 0.471 0.177 0.042 0.006 0.000 0.000 0.000)))
(snd-display #__line__ ";blackman7 window: ~A" gen)))
(let ((gen (make-fft-window blackman8-window 16)))
- (if (not (vequal gen (vct 0.000 0.000 0.000 0.003 0.028 0.141 0.426 1.000 1.000 0.426 0.141 0.028 0.003 0.000 0.000 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.000 0.000 0.003 0.028 0.141 0.426 1.000 1.000 0.426 0.141 0.028 0.003 0.000 0.000 0.000)))
(snd-display #__line__ ";blackman8 window: ~A" gen)))
(let ((gen (make-fft-window blackman9-window 16)))
- (if (not (vequal gen (vct 0.000 0.000 0.000 0.001 0.018 0.112 0.385 1.000 1.000 0.385 0.112 0.018 0.001 0.000 0.000 -0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.000 0.000 0.001 0.018 0.112 0.385 1.000 1.000 0.385 0.112 0.018 0.001 0.000 0.000 -0.000)))
(snd-display #__line__ ";blackman9 window: ~A" gen)))
(let ((gen (make-fft-window blackman10-window 16)))
- (if (not (vequal gen (vct 0.000 0.000 0.000 0.001 0.012 0.089 0.349 1.000 1.000 0.349 0.089 0.012 0.001 0.000 0.000 -0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.000 0.000 0.001 0.012 0.089 0.349 1.000 1.000 0.349 0.089 0.012 0.001 0.000 0.000 -0.000)))
(snd-display #__line__ ";blackman10 window: ~A" gen)))
(let ((gen (make-fft-window rv2-window 16)))
- (if (not (vequal gen (vct 0.000 0.001 0.021 0.095 0.250 0.478 0.729 1.000 1.000 0.729 0.478 0.250 0.095 0.021 0.001 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.001 0.021 0.095 0.250 0.478 0.729 1.000 1.000 0.729 0.478 0.250 0.095 0.021 0.001 0.000)))
(snd-display #__line__ ";rv2 window: ~A" gen)))
(let ((gen (make-fft-window rv3-window 16)))
- (if (not (vequal gen (vct 0.000 0.000 0.003 0.029 0.125 0.330 0.622 1.000 1.000 0.622 0.330 0.125 0.029 0.003 0.000 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.000 0.003 0.029 0.125 0.330 0.622 1.000 1.000 0.622 0.330 0.125 0.029 0.003 0.000 0.000)))
(snd-display #__line__ ";rv3 window: ~A" gen)))
(let ((gen (make-fft-window rv4-window 16)))
- (if (not (vequal gen (vct 0.000 0.000 0.000 0.009 0.062 0.228 0.531 1.000 1.000 0.531 0.228 0.062 0.009 0.000 0.000 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.000 0.000 0.009 0.062 0.228 0.531 1.000 1.000 0.531 0.228 0.062 0.009 0.000 0.000 0.000)))
(snd-display #__line__ ";rv4 window: ~A" gen)))
(let ((gen (make-fft-window exponential-window 16)))
- (if (not (vequal gen (vct 0.000 0.087 0.181 0.283 0.394 0.515 0.646 0.944 0.944 0.646 0.515 0.394 0.283 0.181 0.087 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.087 0.181 0.283 0.394 0.515 0.646 0.944 0.944 0.646 0.515 0.394 0.283 0.181 0.087 0.000)))
(snd-display #__line__ ";exponential window: ~A" gen)))
(let ((gen (make-fft-window riemann-window 16)))
- (if (not (vequal gen (vct 0.000 0.139 0.300 0.471 0.637 0.784 0.900 1.000 1.000 0.900 0.784 0.637 0.471 0.300 0.139 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.139 0.300 0.471 0.637 0.784 0.900 1.000 1.000 0.900 0.784 0.637 0.471 0.300 0.139 0.000)))
(snd-display #__line__ ";riemann window: ~A" gen)))
(let ((gen (make-fft-window kaiser-window 16 2.5)))
- (if (not (vequal gen (vct 0.304 0.426 0.550 0.670 0.779 0.871 0.941 1.000 1.000 0.941 0.871 0.779 0.670 0.550 0.426 0.304)))
+ (if (not (vequal gen (float-vector 0.304 0.426 0.550 0.670 0.779 0.871 0.941 1.000 1.000 0.941 0.871 0.779 0.670 0.550 0.426 0.304)))
(snd-display #__line__ ";kaiser window: ~A" gen)))
(let ((gen (make-fft-window cauchy-window 16 2.5)))
- (if (not (vequal gen (vct 0.138 0.173 0.221 0.291 0.390 0.532 0.719 1.000 1.000 0.719 0.532 0.390 0.291 0.221 0.173 0.138)))
+ (if (not (vequal gen (float-vector 0.138 0.173 0.221 0.291 0.390 0.532 0.719 1.000 1.000 0.719 0.532 0.390 0.291 0.221 0.173 0.138)))
(snd-display #__line__ ";cauchy window: ~A" gen)))
(let ((gen (make-fft-window poisson-window 16 2.5)))
- (if (not (vequal gen (vct 0.082 0.112 0.153 0.210 0.287 0.392 0.535 1.000 1.000 0.535 0.392 0.287 0.210 0.153 0.112 0.082)))
+ (if (not (vequal gen (float-vector 0.082 0.112 0.153 0.210 0.287 0.392 0.535 1.000 1.000 0.535 0.392 0.287 0.210 0.153 0.112 0.082)))
(snd-display #__line__ ";poisson window: ~A" gen)))
(let ((gen (make-fft-window gaussian-window 16 1.0)))
- (if (not (vequal gen (vct 0.607 0.682 0.755 0.823 0.882 0.932 0.969 1.000 1.000 0.969 0.932 0.882 0.823 0.755 0.682 0.607)))
+ (if (not (vequal gen (float-vector 0.607 0.682 0.755 0.823 0.882 0.932 0.969 1.000 1.000 0.969 0.932 0.882 0.823 0.755 0.682 0.607)))
(snd-display #__line__ ";gaussian window: ~A" gen)))
(let ((gen (make-fft-window tukey-window 16)))
- (if (not (vequal gen (vct 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
(snd-display #__line__ ";tukey window: ~A" gen)))
(let ((gen (make-fft-window hann-poisson-window 16)))
- (if (not (vequal gen (vct 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.038 0.146 0.309 0.500 0.691 0.854 1.000 1.000 0.854 0.691 0.500 0.309 0.146 0.038 0.000)))
(snd-display #__line__ ";tukey window: ~A" gen)))
(let ((gen (make-fft-window bohman-window 16)))
- (if (not (vequal gen (vct 0.000 0.006 0.048 0.151 0.318 0.533 0.755 1.000 1.000 0.755 0.533 0.318 0.151 0.048 0.006 0.000)))
+ (if (not (vequal gen (float-vector 0.000 0.006 0.048 0.151 0.318 0.533 0.755 1.000 1.000 0.755 0.533 0.318 0.151 0.048 0.006 0.000)))
(snd-display #__line__ ";bohman window: ~A" gen)))
(for-each
@@ -21131,14 +15677,15 @@ EDITS: 2
(func (caddr window-data))
(name (cadr window-data)))
(let ((v1 (make-fft-window window 16))
- (v2 (make-vct 16)))
- (do ((i 0 (+ 1 i))
+ (v2 (make-float-vector 16))
+ (incr (/ (* 2 pi) 16.0)))
+ (do ((i 0 (+ i 1))
(j 15 (- j 1))
- (ang 0.0 (+ ang (/ (* 2 pi) 16.0))))
+ (ang 0.0 (+ ang incr)))
((> i 8)) ; yikes -- even size + smallness = questionable code...
(let ((val (func ang)))
- (vct-set! v2 i val)
- (vct-set! v2 j val)))
+ (set! (v2 i) val)
+ (set! (v2 j) val)))
(if (not (vequal v1 v2))
(snd-display #__line__ ";~A by hand:~%; mus: ~A~%; loc: ~A" name v1 v2)))))
@@ -21318,113 +15865,70 @@ EDITS: 2
(let ((win (make-fft-window bartlett-hann-window 32))
(unhappy #f))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or unhappy (= i 32)))
(let ((val (+ 0.62 (* -0.48 (abs (- (/ i 31) 0.5))) (* 0.38 (cos (* 2 pi (- (/ i 31) 0.5)))))))
- (if (> (abs (- val (vct-ref win i))) .03)
+ (if (> (abs (- val (win i))) .03)
(begin
(set! unhappy #t)
- (snd-display #__line__ ";bartlett-hann at ~D: ~A ~A" i val (vct-ref win i)))))))
+ (snd-display #__line__ ";bartlett-hann at ~D: ~A ~A" i val (win i)))))))
(let ((win (make-fft-window flat-top-window 32))
(unhappy #f))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or unhappy (= i 32)))
(let ((val (+ 0.2156
(* -0.4160 (cos (/ (* 2 pi i) 31)))
(* 0.2781 (cos (/ (* 4 pi i) 31)))
(* -0.0836 (cos (/ (* 6 pi i) 31)))
(* 0.0069 (cos (/ (* 8 pi i) 31))))))
- (if (> (abs (- val (vct-ref win i))) .1) ; error is much less, of course, in a bigger window
+ (if (> (abs (- val (win i))) .1) ; error is much less, of course, in a bigger window
(begin
(set! unhappy #t)
- (snd-display #__line__ ";flat-top at ~D: ~A ~A" i val (vct-ref win i)))))))
+ (snd-display #__line__ ";flat-top at ~D: ~A ~A" i val (win i)))))))
(catch #t
(lambda ()
(let ((gen (make-fft-window samaraki-window 16)))
- (if (not (vequal gen (vct 1.000 0.531 0.559 0.583 0.604 0.620 0.631 0.638 0.640 0.638 0.631 0.620 0.604 0.583 0.559 0.531)))
+ (if (not (vequal gen (float-vector 1.000 0.531 0.559 0.583 0.604 0.620 0.631 0.638 0.640 0.638 0.631 0.620 0.604 0.583 0.559 0.531)))
(snd-display #__line__ ";samaraki window: ~A" gen)))
(let ((gen (make-fft-window ultraspherical-window 16)))
- (if (not (vequal gen (vct 1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
+ (if (not (vequal gen (float-vector 1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
(snd-display #__line__ ";ultraspherical window: ~A" gen)))
(let ((gen (make-fft-window dolph-chebyshev-window 16)))
- (if (not (vequal gen (vct 1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
+ (if (not (vequal gen (float-vector 1.000 0.033 0.034 0.035 0.036 0.036 0.037 0.037 0.037 0.037 0.037 0.036 0.036 0.035 0.034 0.033)))
(snd-display #__line__ ";dolph-chebyshev window: ~A" gen)))
(without-errors
(let ((gen (make-fft-window dolph-chebyshev-window 16 1.0)))
- (if (not (vequal gen (vct 1.000 0.274 0.334 0.393 0.446 0.491 0.525 0.546 0.553 0.546 0.525 0.491 0.446 0.393 0.334 0.274)))
+ (if (not (vequal gen (float-vector 1.000 0.274 0.334 0.393 0.446 0.491 0.525 0.546 0.553 0.546 0.525 0.491 0.446 0.393 0.334 0.274)))
(snd-display #__line__ ";dolph-chebyshev window: ~A" gen))))
- (let ((multra (lambda (N gamma xmu)
- (let* ((alpha (cosh (/ (acosh (expt 10.0 gamma)) N)))
- (freq (/ pi N))
- (rl (make-vct N))
- (im (make-vct N)))
- (do ((i 0 (+ 1 i))
- (phase 0.0 (+ phase freq)))
- ((= i N))
- (let ((val (gsl-gegenbauer N xmu (* alpha (cos phase))))) ;(cos (* N (acos (* alpha (cos phase)))))
- (vct-set! rl i (real-part val))
- (vct-set! im i (imag-part val))))
- (fft rl im -1)
- (let ((pk (vct-peak rl)))
- (vct-scale! rl (/ 1.0 pk)))
- (do ((i 0 (+ 1 i))
- (j (/ N 2)))
- ((= i N))
- (vct-set! im i (vct-ref rl j))
- (set! j (+ j 1))
- (if (= j N) (set! j 0)))
- im))))
- (let ((val1 (make-fft-window ultraspherical-window 16 0.0 0.0))
- (val2 (make-fft-window dolph-chebyshev-window 16 0.0)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/dolph 0: ~A ~A" val1 val2)))
- (let ((val1 (make-fft-window ultraspherical-window 16 0.0 1.0))
- (val2 (make-fft-window samaraki-window 16 0.0)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 0: ~A ~A" val1 val2)))
- (let ((val1 (make-fft-window ultraspherical-window 16 0.5 0.0))
- (val2 (make-fft-window dolph-chebyshev-window 16 0.5)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/dolph 5: ~A ~A" val1 val2)))
- (let ((val1 (make-fft-window ultraspherical-window 16 0.5 1.0))
- (val2 (make-fft-window samaraki-window 16 0.5)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 5: ~A ~A" val1 val2)))
- (let ((val1 (dolph 16 1.0))
- (val2 (make-fft-window dolph-chebyshev-window 16 1.0)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";dolph/dolph 1: ~A ~A" val1 val2)))
- (let ((val1 (vector->vct (dolph-1 16 1.0)))
- (val2 (make-fft-window dolph-chebyshev-window 16 1.0)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";dolph-1/dolph 1: ~A ~A" val1 val2)))
- (if (and (provided? 'gsl)
- (defined? 'gsl-gegenbauer))
- (begin
- (let ((val1 (multra 16 1.0 1.0))
- (val2 (make-fft-window samaraki-window 16 1.0)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 0: ~A ~A" val1 val2)))
- (let ((val1 (multra 16 0.5 1.0))
- (val2 (make-fft-window samaraki-window 16 0.5)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 5: ~A ~A" val1 val2)))
- (let ((val1 (multra 16 0.5 0.5))
- (val2 (make-fft-window ultraspherical-window 16 0.5 0.5)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/ultra 5: ~A ~A" val1 val2)))
- (let ((val1 (multra 16 0.5 2.5))
- (val2 (make-fft-window ultraspherical-window 16 0.5 2.5)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/ultra 5: ~A ~A" val1 val2)))
- (let ((val1 (multra 16 2.5 2.5))
- (val2 (make-fft-window ultraspherical-window 16 2.5 2.5)))
- (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/ultra 5: ~A ~A" val1 val2)))
- ))))
+ (let ((val1 (make-fft-window ultraspherical-window 16 0.0 0.0))
+ (val2 (make-fft-window dolph-chebyshev-window 16 0.0)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/dolph 0: ~A ~A" val1 val2)))
+ (let ((val1 (make-fft-window ultraspherical-window 16 0.0 1.0))
+ (val2 (make-fft-window samaraki-window 16 0.0)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 0: ~A ~A" val1 val2)))
+ (let ((val1 (make-fft-window ultraspherical-window 16 0.5 0.0))
+ (val2 (make-fft-window dolph-chebyshev-window 16 0.5)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/dolph 5: ~A ~A" val1 val2)))
+ (let ((val1 (make-fft-window ultraspherical-window 16 0.5 1.0))
+ (val2 (make-fft-window samaraki-window 16 0.5)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";ultra/sam 5: ~A ~A" val1 val2)))
+ (let ((val1 (dolph 16 1.0))
+ (val2 (make-fft-window dolph-chebyshev-window 16 1.0)))
+ (if (not (vequal val1 val2)) (snd-display #__line__ ";dolph/dolph 1: ~A ~A" val1 val2))))
(lambda args (snd-display #__line__ ";new windows: ~A" args)))
(if (defined? 'gsl-eigenvectors)
(begin
(let ((win (make-dpss-window 16 .01)))
- (if (not (vequal win (vct 0.964 0.973 0.981 0.987 0.992 0.996 0.999 1.000 1.000 0.999 0.996 0.992 0.987 0.981 0.973 0.964)))
+ (if (not (vequal win (float-vector 0.964 0.973 0.981 0.987 0.992 0.996 0.999 1.000 1.000 0.999 0.996 0.992 0.987 0.981 0.973 0.964)))
(snd-display #__line__ ";make-dpss-window 16 .01: ~A" win)))
(let ((win (make-dpss-window 16 .1)))
- (if (not (vequal win (vct 0.090 0.193 0.332 0.494 0.664 0.818 0.936 1.000 1.000 0.936 0.818 0.664 0.494 0.332 0.193 0.090)))
+ (if (not (vequal win (float-vector 0.090 0.193 0.332 0.494 0.664 0.818 0.936 1.000 1.000 0.936 0.818 0.664 0.494 0.332 0.193 0.090)))
(snd-display #__line__ ";make-dpss-window 16 .1: ~A" win)))
(let ((win (make-dpss-window 32 .09)))
- (if (not (vequal win (vct 0.004 0.011 0.025 0.050 0.086 0.138 0.206 0.290 0.388 0.496 0.610 0.722 0.823 0.908 0.968 1.000
+ (if (not (vequal win (float-vector 0.004 0.011 0.025 0.050 0.086 0.138 0.206 0.290 0.388 0.496 0.610 0.722 0.823 0.908 0.968 1.000
1.000 0.968 0.908 0.823 0.722 0.610 0.496 0.388 0.290 0.206 0.138 0.086 0.050 0.025 0.011 0.004)))
(snd-display #__line__ ";make-dpss-window 32 .09: ~A" win)))
@@ -21440,7 +15944,7 @@ EDITS: 2
(list 16 32))))
(let ((win (make-papoulis-window 32)))
- (if (not (vequal win (vct 0.000 0.001 0.006 0.021 0.048 0.091 0.151 0.227 0.318 0.422 0.533 0.647 0.755 0.852 0.930 0.982
+ (if (not (vequal win (float-vector 0.000 0.001 0.006 0.021 0.048 0.091 0.151 0.227 0.318 0.422 0.533 0.647 0.755 0.852 0.930 0.982
1.000 0.982 0.930 0.852 0.755 0.647 0.533 0.422 0.318 0.227 0.151 0.091 0.048 0.021 0.006 0.001)))
(snd-display #__line__ ";make-papoulis-window 32: ~A" win)))
@@ -21453,53 +15957,53 @@ EDITS: 2
(list 32 64 256))
- (let ((v0 (make-vct 10))
+ (let ((v0 (make-float-vector 10))
(gen (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 11))
- (v1 (make-vct 10))
+ (v1 (make-float-vector 10))
(gen1 (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 11)))
(print-and-check gen
"env"
- "env linear, pass: 0 (dur: 11), index: 0, scaler: 0.5000, offset: 0.0000, data: [0.000 0.000 1.000 1.000 2.000 0.000]")
+ "env linear, pass: 0 (dur: 11), index: 0, scaler: 0.5000, offset: 0.0000, data: [0 0 1 1 2 0]")
(if (not (env? gen)) (snd-display #__line__ ";~A not env?" gen))
(if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";env scaler ~F?" (mus-scaler gen)))
(if (fneq (mus-increment gen) 1.0) (snd-display #__line__ ";env base (1.0): ~A?" (mus-increment gen)))
(if (not (= (mus-length gen) 11)) (snd-display #__line__ ";env length: ~A" (mus-length gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (env gen)))
+ (set! (v0 i) (env gen)))
(let ((off 123.0))
- (vct-map! v1 (lambda ()
+ (fill-float-vector v1 (begin
(set! off (mus-offset gen1))
(if (env? gen1) (env gen1) -1.0)))
(if (fneq off 0.0) (snd-display #__line__ ";mus-offset opt: ~A" off)))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map env: ~A ~A" v0 v1))
- (if (or (fneq (vct-ref v0 0) 0.0) (fneq (vct-ref v0 1) .1) (fneq (vct-ref v0 6) .4))
+ (if (or (fneq (v0 0) 0.0) (fneq (v0 1) .1) (fneq (v0 6) .4))
(snd-display #__line__ ";~A output: ~A" gen v0))
(if (fneq (env-interp 1.6 gen) 0.2) (snd-display #__line__ ";env-interp ~A at 1.6: ~F?" gen (env-interp 1.5 gen)))
(set! gen (make-env :envelope '(0 1 1 0) :base 32.0 :length 11))
(if (fneq (mus-increment gen) 32.0) (snd-display #__line__ ";env base (32.0): ~A?" (mus-increment gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (env gen)))
- (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) .698) (fneq (vct-ref v0 8) .032))
+ (set! (v0 i) (env gen)))
+ (if (or (fneq (v0 0) 1.0) (fneq (v0 1) .698) (fneq (v0 8) .032))
(snd-display #__line__ ";~A output: ~A" gen v0))
(set! gen (make-env :envelope '(0 1 1 0) :base .0325 :length 11))
(if (fneq (mus-increment gen) .0325) (snd-display #__line__ ";env base (.0325): ~A?" (mus-increment gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (env gen)))
- (if (or (fneq (vct-ref v0 0) 1.0) (fneq (vct-ref v0 1) .986) (fneq (vct-ref v0 8) .513))
+ (set! (v0 i) (env gen)))
+ (if (or (fneq (v0 0) 1.0) (fneq (v0 1) .986) (fneq (v0 8) .513))
(snd-display #__line__ ";~A output: ~A" gen v0))
(set! gen (make-env :envelope '(0 1 1 .5 2 0) :base 0.0 :length 11 :offset 1.0))
(if (fneq (mus-offset gen) 1.0) (snd-display #__line__ ";mus-offset: ~A" (mus-offset gen)))
(if (fneq (mus-increment gen) 0.0) (snd-display #__line__ ";env base (0.0): ~A?" (mus-increment gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (if (= i 3)
- (if (not (= (mus-location gen) 3))
- (snd-display #__line__ ";env location: ~A?" (mus-location gen))))
- (vct-set! v0 i (env gen)))
- (if (or (fneq (vct-ref v0 0) 2.0) (fneq (vct-ref v0 6) 1.5) (fneq (vct-ref v0 8) 1.5))
+ (if (and (= i 3)
+ (not (= (mus-location gen) 3)))
+ (snd-display #__line__ ";env location: ~A?" (mus-location gen)))
+ (set! (v0 i) (env gen)))
+ (if (or (fneq (v0 0) 2.0) (fneq (v0 6) 1.5) (fneq (v0 8) 1.5))
(snd-display #__line__ ";~A output: ~A" gen v0))
(if (fneq (env-interp 1.5 gen) 1.5) (snd-display #__line__ ";env-interp ~A at 1.5: ~F?" gen (env-interp 1.5 gen)))
(set! (mus-location gen) 6)
@@ -21510,84 +16014,176 @@ EDITS: 2
(let ((val (env gen)))
(if (fneq val 2.0) (snd-display #__line__ ";set! mus-location 0 -> ~A (2.0)?" val)))
(let ((gen (make-env '(0 0 1 -1 2 0) :length 11)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5))
(let ((val (env gen)))
(if (fneq val (/ i -5.0)) (snd-display #__line__ ";neg env: ~D ~A" i val))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5))
(let ((val (env gen)))
(if (fneq val (+ -1.0 (/ i 5.0))) (snd-display #__line__ ";neg env: ~D ~A" (+ i 5) val)))))
(let ((gen (make-env '(0 0 1 -1 2 0) :length 11 :base 0.5))
- (v (vct 0.0 -0.14869 -0.31950 -0.51571 -0.74110 -1.0 -0.74110 -0.51571 -0.31950 -0.14869)))
- (do ((i 0 (+ 1 i)))
+ (v (float-vector 0.0 -0.14869 -0.31950 -0.51571 -0.74110 -1.0 -0.74110 -0.51571 -0.31950 -0.14869)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((val (env gen)))
- (if (fneq val (vct-ref v i)) (snd-display #__line__ ";neg exp env: ~D ~A" i val))))
+ (if (fneq val (v i)) (snd-display #__line__ ";neg exp env: ~D ~A" i val))))
(mus-apply gen))
- (let ((v (make-vct 10)))
+ (let ((v (make-float-vector 10)))
(let ((e (make-env '(0 0 1 1) :length 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display #__line__ ";simple ramp: ~A" v)))
- (let ((v (make-vct 10)))
+ (let ((v (make-float-vector 10)))
(let ((e (make-env '(0 0 1 1) :base 0 :length 8)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
(snd-display #__line__ ";simple ramp, base 0: ~A" v))))
- (let ((v (make-vct 10)))
+ (let ((v (make-float-vector 10)))
(let ((e (make-env '(0 0 1 1 2 .5) :base 0 :length 8)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
(snd-display #__line__ ";two-step, base 0: ~A" v))))
(let ((e (make-env '((0 0) (1 1)) :length 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
(snd-display #__line__ ";simple ramp embedded: ~A" v)))
(let ((e (make-env '(0 1 1 0) :length 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
(snd-display #__line__ ";simple ramp down: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 0) :length 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display #__line__ ";simple pyr: ~A" v)))
(let ((e (make-env '((0 0) (1 1) (2 0)) :length 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display #__line__ ";simple pyr embedded: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 -.5) :length 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display #__line__ ";simple pyr -.5: ~A" v)))
(let ((e (make-env '((0 0) (1 1) (2 -.5)) :length 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display #__line__ ";simple pyr -.5 embedded: ~A" v)))
(let ((e (make-env '(0 0 1 1 2 -.5) :length 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (snd-display #__line__ ";simple pyr -.5: ~A" v))))
+
+ (let ((v (make-float-vector 10)))
+ (let ((e (make-env (float-vector 0 0 1 1) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
+ (snd-display #__line__ ";simple ramp: ~A" v)))
+ (let ((v (make-float-vector 10)))
+ (let ((e (make-env (float-vector 0 0 1 1) :base 0 :length 8)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
+ (snd-display #__line__ ";simple ramp, base 0: ~A" v))))
+ (let ((v (make-float-vector 10)))
+ (let ((e (make-env (float-vector 0 0 1 1 2 .5) :base 0 :length 8)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
+ (snd-display #__line__ ";two-step, base 0: ~A" v))))
+ (let ((e (make-env (float-vector 0 1 1 0) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
+ (snd-display #__line__ ";simple ramp down: ~A" v)))
+ (let ((e (make-env (float-vector 0 0 1 1 2 0) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (snd-display #__line__ ";simple pyr: ~A" v)))
+ (let ((e (make-env (float-vector 0 0 1 1 2 -.5) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (snd-display #__line__ ";simple pyr -.5: ~A" v)))
+ (let ((e (make-env (float-vector 0 0 1 1 2 -.5) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (snd-display #__line__ ";simple pyr -.5: ~A" v))))
+
+ (let ((v (make-float-vector 10)))
+ (let ((e (make-env (vector 0 0 1 1) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.000)))
+ (snd-display #__line__ ";simple ramp: ~A" v)))
+ (let ((v (make-float-vector 10)))
+ (let ((e (make-env (vector 0 0 1 1) :base 0 :length 8)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000)))
+ (snd-display #__line__ ";simple ramp, base 0: ~A" v))))
+ (let ((v (make-float-vector 10)))
+ (let ((e (make-env (vector 0 0 1 1 2 .5) :base 0 :length 8)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 0.500 0.500)))
+ (snd-display #__line__ ";two-step, base 0: ~A" v))))
+ (let ((e (make-env (vector 0 1 1 0) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 1.000 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.000)))
+ (snd-display #__line__ ";simple ramp down: ~A" v)))
+ (let ((e (make-env (vector 0 0 1 1 2 0) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (snd-display #__line__ ";simple pyr: ~A" v)))
+ (let ((e (make-env (vector 0 0 1 1 2 -.5) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (snd-display #__line__ ";simple pyr -.5: ~A" v)))
+ (let ((e (make-env (vector 0 0 1 1 2 -.5) :length 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.625 0.250 -0.125 -0.500)))
(snd-display #__line__ ";simple pyr -.5: ~A" v))))
(let ((e (make-env '(0 0 1 1) :length 10)))
@@ -21596,38 +16192,38 @@ EDITS: 2
(if (fneq (env-interp 0.0 e) 0.0) (snd-display #__line__ ";env-interp 0011 at 0: ~A" (env-interp 0.0 e)))
(if (fneq (env-interp 0.444 e) 0.444) (snd-display #__line__ ";env-interp 0011 at .444: ~A" (env-interp 0.45 e)))
(mus-reset e)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((val (env e)))
(if (fneq val (* i .111111)) (snd-display #__line__ ";ramp env over 10: ~A at ~A" val i)))))
(let ((e (make-env '(0 0 .5 .5 1 1) :base 32 :length 10))
- (v (vct 0.0 0.0243 0.0667 0.1412 0.2716 0.5000 0.5958 0.7090 0.8425 1.0)))
- (do ((i 0 (+ 1 i))
+ (v (float-vector 0.0 0.0243 0.0667 0.1412 0.2716 0.5000 0.5958 0.7090 0.8425 1.0)))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
- (if (fneq val (vct-ref v i)) (snd-display #__line__ ";(0 .5 1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
+ (if (fneq val (v i)) (snd-display #__line__ ";(0 .5 1) env-interp over 10: ~A at ~A (~A)" val i (v i))))))
(let ((e (make-env '(0 -1.0 1 1) :base 32 :length 10))
- (v (vct -1.0 -0.9697 -0.9252 -0.8597 -0.7635 -0.6221 -0.4142 -0.1088 0.34017 1.0)))
- (do ((i 0 (+ 1 i))
+ (v (float-vector -1.0 -0.9697 -0.9252 -0.8597 -0.7635 -0.6221 -0.4142 -0.1088 0.34017 1.0)))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
- (if (fneq val (vct-ref v i)) (snd-display #__line__ ";(-1 1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
+ (if (fneq val (v i)) (snd-display #__line__ ";(-1 1) env-interp over 10: ~A at ~A (~A)" val i (v i))))))
(let ((e (make-env '(0 -1.0 .5 .5 1 0) :base 32 :length 10))
- (v (vct -1.0 -0.952 -0.855 -0.661 -0.274 0.5 0.356 0.226 0.107 0.0)))
- (do ((i 0 (+ 1 i))
+ (v (float-vector -1.0 -0.952 -0.855 -0.661 -0.274 0.5 0.356 0.226 0.107 0.0)))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
- (if (fneq val (vct-ref v i)) (snd-display #__line__ ";(-1 .5 0) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
+ (if (fneq val (v i)) (snd-display #__line__ ";(-1 .5 0) env-interp over 10: ~A at ~A (~A)" val i (v i))))))
(let ((e (make-env '(0 0.0 .5 .5 1 -1.0) :base 32 :length 10))
- (v (vct 0.0 0.085 0.177 0.276 0.384 0.5 -0.397 -0.775 -0.933 -1.0)))
- (do ((i 0 (+ 1 i))
+ (v (float-vector 0.0 0.085 0.177 0.276 0.384 0.5 -0.397 -0.775 -0.933 -1.0)))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x 0.11111)))
((= i 10))
(let ((val (env-interp x e)))
- (if (fneq val (vct-ref v i)) (snd-display #__line__ ";(0 .5 -1) env-interp over 10: ~A at ~A (~A)" val i (vct-ref v i))))))
+ (if (fneq val (v i)) (snd-display #__line__ ";(0 .5 -1) env-interp over 10: ~A at ~A (~A)" val i (v i))))))
(let ((e (make-env '(0 0 1 1) :length 10 :base 4.0)))
(if (fneq (env-interp 1.0 e) 1.0) (snd-display #__line__ ";env-interp 0011 4 at 1: ~A" (env-interp 1.0 e)))
(if (fneq (env-interp 0.0 e) 0.0) (snd-display #__line__ ";env-interp 0011 4 at 0: ~A" (env-interp 0.0 e)))
@@ -21637,97 +16233,97 @@ EDITS: 2
(if (fneq (env-interp 0.0 e) 0.0) (snd-display #__line__ ";env-interp 0011 2 at 0: ~A" (env-interp 0.0 e)))
(if (fneq (env-interp 0.45 e) 0.6387) (snd-display #__line__ ";env-interp 0011 2 at .45: ~A" (env-interp 0.45 e))))
- (let ((val (let ((e (make-env '(0 0 1 1) :offset 2.0))) (set! (mus-offset e) 3.0) (mus-offset e))))
+ (let ((val (let ((e (make-env '(0 0 1 1) :length 10 :offset 2.0))) (set! (mus-offset e) 3.0) (mus-offset e))))
(if (fneq val 3.0) (snd-display #__line__ ";set mus-offset env: ~A" val)))
(let ((e (make-env '(0 0 1 1 2 0) :length 10))
- (v (make-vct 10 0.0)))
- (do ((i 0 (+ 1 i)))
+ (v (make-float-vector 10 0.0)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
(snd-display #__line__ ";e set off 0: ~A" v))
(if (not (= (mus-length e) 10)) (snd-display #__line__ ";e set off 0 len: ~A" (mus-length e)))
(if (fneq (mus-scaler e) 1.0) (snd-display #__line__ ";e set off 0 scl: ~A" (mus-scaler e)))
(if (fneq (mus-offset e) 0.0) (snd-display #__line__ ";e set off 0 off: ~A" (mus-offset e)))
(set! (mus-scaler e) 2.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.400 0.800 1.200 1.600 2.000 1.500 1.000 0.500 0.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.400 0.800 1.200 1.600 2.000 1.500 1.000 0.500 0.000)))
(snd-display #__line__ ";e set off 1: ~A" v))
(if (not (= (mus-length e) 10)) (snd-display #__line__ ";e set off 1 len: ~A" (mus-length e)))
(if (fneq (mus-scaler e) 2.0) (snd-display #__line__ ";e set off 1 scl: ~A" (mus-scaler e)))
(if (fneq (mus-offset e) 0.0) (snd-display #__line__ ";e set off 1 off: ~A" (mus-offset e)))
(set! (mus-offset e) 1.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 1.000 1.400 1.800 2.200 2.600 3.000 2.500 2.000 1.500 1.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 1.000 1.400 1.800 2.200 2.600 3.000 2.500 2.000 1.500 1.000)))
(snd-display #__line__ ";e set off 2: ~A" v))
(if (not (= (mus-length e) 10)) (snd-display #__line__ ";e set off 2 len: ~A" (mus-length e)))
(if (fneq (mus-scaler e) 2.0) (snd-display #__line__ ";e set off 2 scl: ~A" (mus-scaler e)))
(if (fneq (mus-offset e) 1.0) (snd-display #__line__ ";e set off 2 off: ~A" (mus-offset e)))
(set! (mus-length e) 19)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 1.000 1.222 1.444 1.667 1.889 2.111 2.333 2.556 2.778 3.000)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 1.000 1.222 1.444 1.667 1.889 2.111 2.333 2.556 2.778 3.000)))
(snd-display #__line__ ";e set off 3: ~A" v))
(if (not (= (mus-length e) 19)) (snd-display #__line__ ";e set off 3 len: ~A" (mus-length e)))
(if (fneq (mus-scaler e) 2.0) (snd-display #__line__ ";e set off 3 scl: ~A" (mus-scaler e)))
(if (fneq (mus-offset e) 1.0) (snd-display #__line__ ";e set off 3 off: ~A" (mus-offset e))))
- (let ((e (make-env (vct 0 0 1 1 2 0) :length 10))
- (v (make-vct 10 0.0)))
- (do ((i 0 (+ 1 i)))
+ (let ((e (make-env (float-vector 0 0 1 1 2 0) :length 10))
+ (v (make-float-vector 10 0.0)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (env e)))
- (if (not (vequal v (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display #__line__ ";e from vct: ~A" v)))
+ (set! (v i) (env e)))
+ (if (not (vequal v (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (snd-display #__line__ ";e from float-vector: ~A" v)))
(let ((e1 (make-env '(0 0 1 1) :base 32.0 :length 11))
- (v (vct 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.00)))
- (do ((i 0 (+ 1 i)))
+ (v (float-vector 0.000 0.013 0.032 0.059 0.097 0.150 0.226 0.333 0.484 0.698 1.00)))
+ (do ((i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
- (if (fneq val (vct-ref v i))
- (snd-display #__line__ ";exp env direct (32.0): ~A ~A" val (vct-ref v i))))))
+ (if (fneq val (v i))
+ (snd-display #__line__ ";exp env direct (32.0): ~A ~A" val (v i))))))
(let ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
- (v (vct 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
- (do ((i 0 (+ 1 i)))
+ (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
+ (do ((i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
- (if (fneq val (vct-ref v i))
- (snd-display #__line__ ";exp env direct (32.0) offset: ~A ~A" val (vct-ref v i))))))
+ (if (fneq val (v i))
+ (snd-display #__line__ ";exp env direct (32.0) offset: ~A ~A" val (v i))))))
(let ((e1 (make-env '((0 1) (1 2)) :base 32.0 :length 11))
- (v (vct 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
- (do ((i 0 (+ 1 i)))
+ (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
+ (do ((i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
- (if (fneq val (vct-ref v i))
- (snd-display #__line__ ";exp env direct (32.0) offset embedded: ~A ~A" val (vct-ref v i))))))
+ (if (fneq val (v i))
+ (snd-display #__line__ ";exp env direct (32.0) offset embedded: ~A ~A" val (v i))))))
(let ((e1 (make-env '(0 1 1 2) :base 32.0 :length 11))
- (v (vct 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
- (do ((i 0 (+ 1 i)))
+ (v (float-vector 1.000 1.013 1.032 1.059 1.097 1.150 1.226 1.333 1.484 1.698 2.00)))
+ (do ((i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
- (if (fneq val (vct-ref v i))
- (snd-display #__line__ ";exp env direct (32.0) offset (and dur): ~A ~A" val (vct-ref v i))))))
+ (if (fneq val (v i))
+ (snd-display #__line__ ";exp env direct (32.0) offset (and dur): ~A ~A" val (v i))))))
(let ((e1 (make-env '(0 0 1 1) :base 0.032 :length 11))
- (v (vct 0.000 0.301 0.514 0.665 0.772 0.848 0.902 0.940 0.967 0.986 1.0)))
- (do ((i 0 (+ 1 i)))
+ (v (float-vector 0.000 0.301 0.514 0.665 0.772 0.848 0.902 0.940 0.967 0.986 1.0)))
+ (do ((i 0 (+ i 1)))
((> i 10))
(let ((val (env e1)))
- (if (fneq val (vct-ref v i))
- (snd-display #__line__ ";exp env direct (.032): ~A ~A" val (vct-ref v i))))))
+ (if (fneq val (v i))
+ (snd-display #__line__ ";exp env direct (.032): ~A ~A" val (v i))))))
(let ((e1 (make-env '(0 0 1 1) :base .03125 :length 11))
(e2 (make-env '(0 0 1 1 2 0) :base 32.0 :length 11))
(e3 (make-env '(0 0 .1 1 2 0) :base 1.1 :length 101)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((lv1 (env-interp (* i .1) e1))
(lv2 (env e1))
@@ -21735,29 +16331,29 @@ EDITS: 2
(lv4 (env e2)))
(if (ffneq lv1 lv2) (snd-display #__line__ ";env-interp[rmp ~F]: ~A (~A)?" (* .1 i) lv1 lv2))
(if (ffneq lv3 lv4) (snd-display #__line__ ";env-interp[pyr ~F]: ~A (~A)?" (* .2 i) lv3 lv4))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(let ((lv5 (env-interp (* i .02) e3))
(lv6 (env e3)))
(if (ffneq lv5 lv6) (snd-display #__line__ ";env-interp[tri ~F]: ~A (~A)?" (* .02 i) lv5 lv6)))))
(let ((e1 (make-env '(0 0 1 1 2 0) :length 10))
- (lv1 (make-vct 11))
- (lv2 (make-vct 11))
- (lv3 (make-vct 11)))
- (do ((i 0 (+ 1 i))) ((= i 11)) (vct-set! lv1 i (env e1)))
- (do ((i 0 (+ 1 i))) ((= i 11)) (vct-set! lv2 i (env e1)))
+ (lv1 (make-float-vector 11))
+ (lv2 (make-float-vector 11))
+ (lv3 (make-float-vector 11)))
+ (do ((i 0 (+ i 1))) ((= i 11)) (set! (lv1 i) (env e1)))
+ (do ((i 0 (+ i 1))) ((= i 11)) (set! (lv2 i) (env e1)))
(mus-reset e1)
- (do ((i 0 (+ 1 i))) ((= i 11)) (vct-set! lv3 i (env e1)))
+ (do ((i 0 (+ i 1))) ((= i 11)) (set! (lv3 i) (env e1)))
(if (not (vequal lv1 lv3)) (snd-display #__line__ ";mus-reset: ~A ~A?" lv1 lv3))
- (if (not (vequal lv2 (make-vct 11))) (snd-display #__line__ ";mus-reset 1: ~A?" lv2)))
+ (if (not (vequal lv2 (make-float-vector 11))) (snd-display #__line__ ";mus-reset 1: ~A?" lv2)))
(set! gen (make-env '(0 0 1 1 2 0) :length 11))
- (do ((i 0 (+ 1 i))) ((= i 4)) (env gen))
+ (do ((i 0 (+ i 1))) ((= i 4)) (env gen))
(let ((val (env gen)))
(if (fneq val .8) (snd-display #__line__ ";env(5): ~A?" val))
(mus-reset gen)
- (do ((i 0 (+ 1 i))) ((= i 4)) (env gen))
+ (do ((i 0 (+ i 1))) ((= i 4)) (env gen))
(set! val (env gen))
(if (fneq val .8) (snd-display #__line__ ";mus-reset (via reset): ~A?" val))
(set! (mus-location gen) 6)
@@ -21780,7 +16376,7 @@ EDITS: 2
(test-gen-equal (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 10) (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 10) (make-env '(0 0 1 1 3 0) :scaler 0.5 :length 10))
(test-gen-equal (make-env '((0 0) (1 1) (2 0)) :scaler 0.5 :length 10) (make-env '(0 0 1 1 2 0) :scaler 0.5 :length 10) (make-env '((0 0) (1 1) (3 0)) :scaler 0.5 :length 10))
- (let ((var (catch #t (lambda () (make-env :envelope '())) (lambda args args))))
+ (let ((var (catch #t (lambda () (make-env :envelope ())) (lambda args args))))
(if (not (eq? (car var) 'no-data))
(snd-display #__line__ ";make-env null env: ~A" var)))
(let ((var (catch #t (lambda () (make-env :length 1)) (lambda args args))))
@@ -21815,10 +16411,10 @@ EDITS: 2
(let* ((env-any-1 (lambda (e func)
(let* ((pts (mus-data e))
(mus-position mus-channels)
- (pt (min (* 2 (mus-position e)) (- (vct-length pts) 4)))
+ (pt (min (* 2 (mus-position e)) (- (length pts) 4)))
(val (/ (- (env e) (mus-offset e)) (mus-scaler e)))
- (y0 (min (vct-ref pts (+ pt 1)) (vct-ref pts (+ pt 3))))
- (y1 (max (vct-ref pts (+ pt 1)) (vct-ref pts (+ pt 3))))
+ (y0 (min (pts (+ pt 1)) (pts (+ pt 3))))
+ (y1 (max (pts (+ pt 1)) (pts (+ pt 3))))
(new-val (func (/ (- val y0) (- y1 y0)))))
(+ (mus-offset e)
(* (mus-scaler e)
@@ -21839,29 +16435,28 @@ EDITS: 2
(multi-expt-env-1 (lambda (e expts)
(env-any-1 e (lambda (y)
- (let ((b (vct-ref expts (modulo (mus-channels e) (vct-length expts)))))
+ (let ((b (expts (modulo (mus-channels e) (length expts)))))
(/ (- (expt b y) 1.0) (- b 1.0))))))))
;; assume sine-env square-env blackman4-env and multi-exp-env are available from generators.scm (8)
- (let ((val1 (with-sound (:output (make-vct 20))
+ (let ((val1 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(outa i (sine-env e))))))
- (val2 (with-sound (:output (make-vct 20))
+ (val2 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (outa i (sine-env e)))))))
+ (outa i (sine-env e))))))
- (val3 (with-sound (:output (make-vct 20))
+ (val3 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(outa i (sine-env-1 e)))))))
(if (not (vequal val1 val2))
@@ -21870,22 +16465,21 @@ EDITS: 2
(snd-display #__line__ ";sine-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
- (let ((val1 (with-sound (:output (make-vct 20))
+ (let ((val1 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(outa i (square-env e))))))
- (val2 (with-sound (:output (make-vct 20))
+ (val2 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (outa i (square-env e)))))))
+ (outa i (square-env e))))))
- (val3 (with-sound (:output (make-vct 20))
+ (val3 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(outa i (square-env-1 e)))))))
(if (not (vequal val1 val2))
@@ -21893,50 +16487,39 @@ EDITS: 2
(if (not (vequal val1 val3))
(snd-display #__line__ ";square-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
- (let ((val1 (with-sound (:output (make-vct 20))
+ (let ((val1 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(outa i (blackman4-env e))))))
- (val2 (with-sound (:output (make-vct 20))
- (let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 20))
- (outa i (blackman4-env e))))))))
-
- (val3 (with-sound (:output (make-vct 20))
+ (val3 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(outa i (blackman4-env-1 e)))))))
- (if (not (vequal val1 val2))
- (snd-display #__line__ ";blackman4-env straight and run: ~%; ~A~%; ~A" val1 val2))
(if (not (vequal val1 val3))
(snd-display #__line__ ";blackman4-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
- (let ((val1 (with-sound (:output (make-vct 20))
+ (let ((val1 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20))
- (bases (vct 32.0 0.3 1.5)))
- (do ((i 0 (+ 1 i)))
+ (bases (float-vector 32.0 0.3 1.5)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(outa i (multi-expt-env e bases))))))
- (val2 (with-sound (:output (make-vct 20))
+ (val2 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20))
- (bases (vct 32.0 0.3 1.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (bases (float-vector 32.0 0.3 1.5)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (outa i (multi-expt-env e bases)))))))
+ (outa i (multi-expt-env e bases))))))
- (val3 (with-sound (:output (make-vct 20))
+ (val3 (with-sound ((make-float-vector 20))
(let ((e (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 20))
- (bases (vct 32.0 0.3 1.5)))
- (do ((i 0 (+ 1 i)))
+ (bases (float-vector 32.0 0.3 1.5)))
+ (do ((i 0 (+ i 1)))
((= i 20))
(outa i (multi-expt-env-1 e bases)))))))
(if (not (vequal val1 val2))
@@ -21944,30 +16527,26 @@ EDITS: 2
(if (not (vequal val1 val3))
(snd-display #__line__ ";multi-expt-env straight and scm: ~%; ~A~%; ~A" val1 val3)))
- (let ((val1 (with-sound (:output (make-vct 220))
+ (let ((val1 (with-sound ((make-float-vector 220))
(let ((e1 (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 220))
(e2 (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 220)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 220))
(outa i (env-any e1
(lambda (y1)
- (declare (y1 float))
(* y1 (env-any e2
(lambda (y2)
- (declare (y2 float))
y2))))))))))
- (val2 (with-sound (:output (make-vct 220))
+ (val2 (with-sound ((make-float-vector 220))
(let ((e1 (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 220))
(e2 (make-env '(0 0 1 1 2 .25 3 1 4 0) :length 220)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 220))
(outa i (env-any e1 ; try it with and without "declare"
(lambda (y1)
(* y1 (env-any e2
(lambda (y2)
- (declare (y2 float))
- y2))))))))))))
+ y2)))))))))))
(if (not (vequal val1 val2))
(snd-display #__line__ ";env-any recursive: ~%; ~A~%; ~A" val1 val2))))
@@ -21975,25 +16554,25 @@ EDITS: 2
(select-sound ind)
(map-channel (lambda (y) 1.0))
(bumpy)
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0.0 0.0 0.001 0.021 0.105 0.264 0.467 0.673 0.846 0.960 1.000 0.960 0.846 0.673 0.467 0.264 0.105 0.021 0.001 0.0)))
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0.0 0.0 0.001 0.021 0.105 0.264 0.467 0.673 0.846 0.960 1.000 0.960 0.846 0.673 0.467 0.264 0.105 0.021 0.001 0.0)))
(snd-display #__line__ ";bumpy: ~A" vals)))
(if (fneq (channel-lp-inf) 1.0) ; just a fancy name for maxamp
(snd-display #__line__ ";channel-lp-inf: ~A" (channel-lp-inf)))
(linear-src-channel 2.0)
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0.000 0.001 0.105 0.467 0.846 1.000 0.846 0.467 0.105 0.001)))
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0.000 0.001 0.105 0.467 0.846 1.000 0.846 0.467 0.105 0.001)))
(snd-display #__line__ ";linear-src-channel: ~A" vals)))
- (let ((old-clip (clipping)))
- (set! (clipping) #t)
+ (let ((old-clip *clipping*))
+ (set! *clipping* #t)
(save-sound-as "tst.snd")
- (let ((fvals (file->vct "tst.snd")) ; in frame.scm
- (vals (channel->vct)))
+ (let ((fvals (file->floats "tst.snd"))
+ (vals (channel->float-vector)))
(if (not (vequal vals fvals))
- (snd-display #__line__ ";file->vct: ~A ~A" vals fvals)))
+ (snd-display #__line__ ";file->floats: ~A ~A" vals fvals)))
(mus-sound-forget "tst.snd")
(delete-file "tst.snd")
- (set! (clipping) old-clip))
+ (set! *clipping* old-clip))
(let ((hp (make-differentiator)))
(map-channel (lambda (y)
(differentiator hp y))))
@@ -22006,9 +16585,9 @@ EDITS: 2
(set! val (window-rms))
(if (fneq val .218) (snd-display #__line__ ";window-rms 1: ~A" val))
(let ((vals (window-samples)))
- (if (or (not (vct? vals))
- (not (= (vct-length vals) 21))
- (fneq (vct-ref vals 10) 1.0))
+ (if (or (not (float-vector? vals))
+ (not (= (length vals) 21))
+ (fneq (vals 10) 1.0))
(snd-display #__line__ ";window-samples: ~A" vals))))
(revert-sound ind)
(let ((new-file-name (file-name ind)))
@@ -22016,48 +16595,48 @@ EDITS: 2
(if (file-exists? new-file-name) (delete-file new-file-name))))
(let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1))))
- (gen1 (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1) (make-vct 512))))
- (gen2 (partials->wave '(1 1 2 1 3 1 4 1) #f #t))
+ (gen1 (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1) (make-float-vector 512))))
+ ;;(gen2 (partials->wave '(1 1 2 1 3 1 4 1) #f #t))
(gen3 (make-table-lookup))
- (v0 (make-vct 10))
- (v1 (make-vct 10))
+ (v0 (make-float-vector 10))
+ (v1 (make-float-vector 10))
(gen4 (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1))))
- (v2 (make-vct 10)))
+ (v2 (make-float-vector 10)))
(print-and-check gen
"table-lookup"
"table-lookup freq: 440.000Hz, phase: 0.000, length: 512, interp: linear")
(if (not (= (mus-length gen) 512)) (snd-display #__line__ ";table-lookup length: ~A?" (mus-length gen)))
(if (not (= (mus-length gen3) 512)) (snd-display #__line__ ";default table-lookup length: ~A?" (mus-length gen3)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (table-lookup gen 0.0))
- (vct-set! v1 i (mus-apply gen1 0.0)))
- (vct-map! v2 (lambda () (if (table-lookup? gen4) (table-lookup gen4 0.0) -1.0)))
+ (set! (v0 i) (table-lookup gen 0.0))
+ (set! (v1 i) (mus-apply gen1 0.0)))
+ (fill-float-vector v2 (if (table-lookup? gen4) (table-lookup gen4 0.0) -1.0))
(if (not (vequal v0 v2)) (snd-display #__line__ ";map table-lookup: ~A ~A" v0 v2))
- (set! gen4 (make-table-lookup 440.0 :wave (partials->wave (vct 1 1 2 1))))
- (vct-map! v2 (lambda () (table-lookup gen4)))
+ (set! gen4 (make-table-lookup 440.0 :wave (partials->wave (float-vector 1 1 2 1))))
+ (fill-float-vector v2 (table-lookup gen4))
(if (not (vequal v0 v2)) (snd-display #__line__ ";map table-lookup (no fm): ~A ~A" v0 v2))
(if (not (table-lookup? gen)) (snd-display #__line__ ";~A not table-lookup?" gen))
- (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data table-lookup: ~A" (mus-data gen)))
+ (if (not (float-vector? (mus-data gen))) (snd-display #__line__ ";mus-data table-lookup: ~A" (mus-data gen)))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";table-lookup phase: ~F?" (mus-phase gen)))
(set! (mus-phase gen) 1.0)
(if (fneq (mus-phase gen) 1.0) (snd-display #__line__ ";set! table-lookup phase: ~F?" (mus-phase gen)))
(if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";table-lookup frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
(if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";set! table-lookup frequency: ~F?" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 1) 0.373) (fneq (vct-ref v0 8) 1.75)) (snd-display #__line__ ";table-lookup output: ~A" v0))
- (do ((i 0 (+ 1 i)))
+ (if (or (fneq (v0 1) 0.373) (fneq (v0 8) 1.75)) (snd-display #__line__ ";table-lookup output: ~A" v0))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display #__line__ ";mus-apply table-lookup at ~D: ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i))))
+ (if (fneq (v0 i) (v1 i))
+ (snd-display #__line__ ";mus-apply table-lookup at ~D: ~A ~A?" i (v0 i) (v1 i))))
(set! gen (make-table-lookup 440.0 :wave (phase-partials->wave (list 1 1 0 2 1 (* pi .5)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (table-lookup gen 0.0)))
- (if (or (fneq (vct-ref v0 1) 1.094) (fneq (vct-ref v0 8) .421)) (snd-display #__line__ ";table-lookup phase output: ~A" v0))
- (if (or (fneq (vct-peak (partials->wave '(1 1 2 1))) 1.76035475730896)
- (fneq (vct-peak (partials->wave '(1 1 2 1) #f #t)) 1.0)
- (fneq (vct-peak (partials->wave '(1 1 2 1 3 1 4 1) #f #t)) 1.0))
+ (set! (v0 i) (table-lookup gen 0.0)))
+ (if (or (fneq (v0 1) 1.094) (fneq (v0 8) .421)) (snd-display #__line__ ";table-lookup phase output: ~A" v0))
+ (if (or (fneq (float-vector-peak (partials->wave '(1 1 2 1))) 1.76035475730896)
+ (fneq (float-vector-peak (partials->wave '(1 1 2 1) #f #t)) 1.0)
+ (fneq (float-vector-peak (partials->wave '(1 1 2 1 3 1 4 1) #f #t)) 1.0))
(snd-display #__line__ ";normalized partials?"))
(set! (mus-data gen) (phase-partials->wave (list 1 1 0 2 1 (* pi .5)) #f #t)))
@@ -22068,33 +16647,33 @@ EDITS: 2
(let ((tag (catch #t (lambda () (phase-partials->wave (list))) (lambda args (car args)))))
(if (not (eq? tag 'no-data)) (snd-display #__line__ ";nil list to phase-partials->wave: ~A" tag)))
- (let ((vals (phase-partials->wave (list 1 1 0) (make-vct 16) #f)))
- (do ((i 0 (+ 1 i)))
+ (let ((vals (phase-partials->wave (list 1 1 0) (make-float-vector 16) #f)))
+ (do ((i 0 (+ i 1)))
((= i 16))
- (if (fneq (vct-ref vals i) (sin (/ (* 2 pi i) 16)))
- (snd-display #__line__ ";phase-partials->wave 1 1 0 at ~D: ~A ~A" i (vct-ref vals i) (sin (/ (* 2 pi i) 16))))))
+ (if (fneq (vals i) (sin (/ (* 2 pi i) 16)))
+ (snd-display #__line__ ";phase-partials->wave 1 1 0 at ~D: ~A ~A" i (vals i) (sin (/ (* 2 pi i) 16))))))
- (let ((vals (phase-partials->wave (list 1 1 (* .25 pi)) (make-vct 16) #f)))
- (do ((i 0 (+ 1 i)))
+ (let ((vals (phase-partials->wave (list 1 1 (* .25 pi)) (make-float-vector 16) #f)))
+ (do ((i 0 (+ i 1)))
((= i 16))
- (if (fneq (vct-ref vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16))))
- (snd-display #__line__ ";phase-partials->wave 1 1 .25 at ~D: ~A ~A" i (vct-ref vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16)))))))
+ (if (fneq (vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16))))
+ (snd-display #__line__ ";phase-partials->wave 1 1 .25 at ~D: ~A ~A" i (vals i) (sin (+ (* .25 pi) (/ (* 2 pi i) 16)))))))
- (let ((vals (phase-partials->wave (vct 1 1 0 2 1 0) (make-vct 16) #f)))
- (do ((i 0 (+ 1 i)))
+ (let ((vals (phase-partials->wave (float-vector 1 1 0 2 1 0) (make-float-vector 16) #f)))
+ (do ((i 0 (+ i 1)))
((= i 16))
- (if (fneq (vct-ref vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16))))
- (snd-display #__line__ ";phase-partials->wave 1 1 0 2 1 0 at ~D: ~A ~A" i (vct-ref vals i)
+ (if (fneq (vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16))))
+ (snd-display #__line__ ";phase-partials->wave 1 1 0 2 1 0 at ~D: ~A ~A" i (vals i)
(+ (sin (/ (* 2 pi i) 16)) (sin (/ (* 4 pi i) 16)))))))
- (let ((vals (phase-partials->wave (vct 1 1 0 2 1 (* .5 pi)) (make-vct 16) #f)))
- (do ((i 0 (+ 1 i)))
+ (let ((vals (phase-partials->wave (float-vector 1 1 0 2 1 (* .5 pi)) (make-float-vector 16) #f)))
+ (do ((i 0 (+ i 1)))
((= i 16))
- (if (fneq (vct-ref vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16)))))
- (snd-display #__line__ ";phase-partials->wave 1 1 0 2 1 .5 at ~D: ~A ~A" i (vct-ref vals i)
+ (if (fneq (vals i) (+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16)))))
+ (snd-display #__line__ ";phase-partials->wave 1 1 0 2 1 .5 at ~D: ~A ~A" i (vals i)
(+ (sin (/ (* 2 pi i) 16)) (sin (+ (* .5 pi) (/ (* 4 pi i) 16))))))))
- (test-gen-equal (make-table-lookup 440.0 :wave (partials->wave (vct 1 1 2 1)))
+ (test-gen-equal (make-table-lookup 440.0 :wave (partials->wave (float-vector 1 1 2 1)))
(make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1)))
(make-table-lookup 100.0 :wave (partials->wave '(1 1 2 1))))
(test-gen-equal (make-table-lookup 440.0 :wave (partials->wave '(1 1 2 1)))
@@ -22111,42 +16690,46 @@ EDITS: 2
(let ((tag (catch #t (lambda () (make-table-lookup :size 0)) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";table-lookup size 0: ~A" tag)))
- (let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 1)))))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 440.0) 22050.0))))
+ (let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 1))))
+ (incr (/ (* 2 pi 440.0) 22050.0)))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((= i 1100))
- (let* ((val1 (sin a))
- (val2 (gen 0.0)))
+ (let ((val1 (sin a))
+ (val2 (gen 0.0)))
(if (fneq val1 val2)
(snd-display #__line__ ";table lookup (1 1): ~A: ~A ~A" i val1 val2)))))
- (let ((gen (make-table-lookup 4.0 :wave (partials->wave '(1 1)))))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 4.0) 22050.0))))
+ (let ((gen (make-table-lookup 4.0 :wave (partials->wave '(1 1))))
+ (incr (/ (* 2 pi 4.0) 22050.0)))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((= i 1100))
- (let* ((val1 (sin a))
- (val2 (gen 0.0)))
+ (let ((val1 (sin a))
+ (val2 (gen 0.0)))
(if (fneq val1 val2)
(snd-display #__line__ ";table lookup (1 1) 4: ~A: ~A ~A" i val1 val2)))))
- (let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 .75 3 .25)))))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 440.0) 22050.0))))
+ (let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 .75 3 .25))))
+ (incr (/ (* 2 pi 440.0) 22050.0)))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((= i 1100))
- (let* ((val1 (+ (* .75 (sin a)) (* .25 (sin (* 3 a)))))
- (val2 (gen 0.0)))
+ (let ((val1 (+ (* .75 (sin a)) (* .25 (sin (* 3 a)))))
+ (val2 (gen 0.0)))
(if (fneq val1 val2)
(snd-display #__line__ ";table lookup (1 .75 3 .25): ~A: ~A ~A" i val1 val2)))))
(let ((gen (make-table-lookup 0.0 :wave (partials->wave '(1 1))))
(gen1 (make-table-lookup 40.0 :wave (partials->wave '(1 1))))
+ (incr (/ (* 2 pi 40.0) 22050.0))
(a1 0.0))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 40.0) 22050.0))))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((= i 100))
- (let* ((fm (sin a))
- (val1 (sin a1))
- (val2 (table-lookup gen (table-lookup gen1 0.0))))
+ (let ((fm (sin a))
+ (val1 (sin a1))
+ (val2 (table-lookup gen (table-lookup gen1 0.0))))
(set! a1 (+ a1 fm))
(if (fneq val1 val2)
(snd-display #__line__ ";lookup/lookup fm: ~A: ~A ~A" i val1 val2)))))
@@ -22155,84 +16738,85 @@ EDITS: 2
(lambda (args)
(let ((type (car args))
(vals (cadr args)))
- (let* ((tbl1 (make-table-lookup :frequency 0.0 :size 4 :type type)))
- (vct-set! (mus-data tbl1) 1 1.0)
- (let ((v (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (let ((tbl1 (make-table-lookup :frequency 0.0 :size 4 :type type)))
+ (float-vector-set! (mus-data tbl1) 1 1.0)
+ (let ((v (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (table-lookup tbl1 (/ (* 2 pi .2) 4))))
+ (set! (v i) (table-lookup tbl1 (* .1 pi))))
(if (and (not (vequal v vals))
(not (= type mus-interp-all-pass))
(or (not (= type mus-interp-none))
- (not (vequal v (vct 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000)))))
+ (not (vequal v (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000)))))
(snd-display #__line__ ";tbl interp ~A: ~A" type v))
(if (not (= (mus-interp-type tbl1) type)) (snd-display #__line__ ";tbl interp-type (~A): ~A" type (mus-interp-type tbl1)))))))
(list
- (list mus-interp-none (vct 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 1.000))
- (list mus-interp-linear (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200))
- (list mus-interp-lagrange (vct 0.000 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360))
- (list mus-interp-all-pass (vct 1.000 0.000 0.429 0.143 0.095 0.905 0.397 0.830 0.793 0.912))
- (list mus-interp-hermite (vct 0.000 0.168 0.424 0.696 0.912 1.000 0.912 0.696 0.424 0.168))))
+ (list mus-interp-none (float-vector 0.000 0.000 0.000 0.000 0.000 1.000 1.000 1.000 1.000 1.000))
+ (list mus-interp-linear (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200))
+ (list mus-interp-lagrange (float-vector 0.000 0.120 0.280 0.480 0.720 1.000 0.960 0.840 0.640 0.360))
+ (list mus-interp-all-pass (float-vector 1.000 0.000 0.429 0.143 0.095 0.905 0.397 0.830 0.793 0.912))
+ (list mus-interp-hermite (float-vector 0.000 0.168 0.424 0.696 0.912 1.000 0.912 0.696 0.424 0.168))))
;; this is different if doubles -- not sure whether it's a bug or not
(let ((size 1000)
(tbl-size 1024))
(define (test-tbl beg end freq amp mc-ratio index)
- (let* ((sine (let ((v (make-vct tbl-size)))
- (do ((i 0 (+ 1 i))
- (x 0.0 (+ x (/ (* 2 pi) tbl-size))))
+ (let* ((sine (let ((v (make-float-vector tbl-size))
+ (xp (/ (* 2 pi) tbl-size)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x xp)))
((= i tbl-size) v)
- (vct-set! v i (sin x)))))
+ (set! (v i) (sin x)))))
(fm (make-table-lookup (* mc-ratio freq) :wave sine))
(carrier (make-table-lookup freq :wave sine)))
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
(outa i (* amp (table-lookup carrier (* index (table-lookup fm))))))))
(define (test-fm1 beg end freq amp mc-ratio index)
(let ((fm (make-oscil (* mc-ratio freq)))
(carrier (make-oscil freq)))
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
(outa i (* amp (oscil carrier (* index (oscil fm))))))))
- (let ((v1 (with-sound (:output (make-vct size) :srate 44100) (test-tbl 0 size 200 1 1 1)))
- (v2 (with-sound (:output (make-vct size) :srate 44100) (test-fm1 0 size 200 1 1 1))))
+ (let ((v1 (with-sound ((make-float-vector size) :srate 44100) (test-tbl 0 size 200 1 1 1)))
+ (v2 (with-sound ((make-float-vector size) :srate 44100) (test-fm1 0 size 200 1 1 1))))
(if (and (not (vequal v1 v2))
- (> (vct-peak (vct-subtract! v1 v2)) .002))
- (snd-display #__line__ ";fm/tbl peak diff (1 1): ~A" (vct-peak (vct-subtract! v1 v2)))))
+ (> (float-vector-peak (float-vector-subtract! v1 v2)) .002))
+ (snd-display #__line__ ";fm/tbl peak diff (1 1): ~A" (float-vector-peak (float-vector-subtract! v1 v2)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((ratio (+ 1 (random 4)))
(index (random 0.1)))
- (let ((v1 (with-sound (:output (make-vct size) :srate 44100) (test-tbl 0 size 20 1 ratio index)))
- (v2 (with-sound (:output (make-vct size) :srate 44100) (test-fm1 0 size 20 1 ratio index))))
+ (let ((v1 (with-sound ((make-float-vector size) :srate 44100) (test-tbl 0 size 20 1 ratio index)))
+ (v2 (with-sound ((make-float-vector size) :srate 44100) (test-fm1 0 size 20 1 ratio index))))
(if (and (not (vequal v1 v2))
- (> (vct-peak (vct-subtract! v1 v2)) .002))
- (snd-display #__line__ ";fm/tbl peak diff ~A ~A: ~A" ratio index (vct-peak (vct-subtract! v1 v2))))))))
+ (> (float-vector-peak (float-vector-subtract! v1 v2)) .002))
+ (snd-display #__line__ ";fm/tbl peak diff ~A ~A: ~A" ratio index (float-vector-peak (float-vector-subtract! v1 v2))))))))
(let ((gen0 (make-polyshape 440.0 :coeffs (partials->polynomial '(1 1))))
(gen (make-polyshape 440.0 :partials '(1 1) :kind mus-chebyshev-first-kind))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-polyshape 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"polyshape"
- "polyshape freq: 440.000Hz, phase: 0.000, coeffs[2]: [0.000 1.000]")
+ "polyshape freq: 440.000Hz, phase: 0.000, coeffs[2]: [0 1]")
(if (not (= (mus-length gen) 2)) (snd-display #__line__ ";polyshape length: ~A?" (mus-length gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((val0 (polyshape gen0 1.0 0.0))
(val (polyshape gen 1.0 0.0)))
(if (fneq val val0) (snd-display #__line__ ";polyshape: ~A is not ~F?" val val0))
- (vct-set! v0 i val)))
- (vct-map! v1 (lambda () (if (polyshape? gen1) (polyshape gen1 1.0 0.0) -1.0)))
+ (set! (v0 i) val)))
+ (fill-float-vector v1 (if (polyshape? gen1) (polyshape gen1 1.0 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map polyshape: ~A ~A" v0 v1))
(set! gen1 (make-polyshape 440.0 :coeffs (partials->polynomial '(1 1))))
- (vct-map! v1 (lambda () (polyshape gen1 1.0)))
+ (fill-float-vector v1 (polyshape gen1 1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";1 map polyshape: ~A ~A" v0 v1))
(if (not (polyshape? gen)) (snd-display #__line__ ";~A not polyshape?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";polyshape phase: ~F?" (mus-phase gen)))
@@ -22241,9 +16825,9 @@ EDITS: 2
(if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";polyshape frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
(if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";polyshape frequency: ~F?" (mus-frequency gen)))
- (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data polyshape: ~A" (mus-data gen)))
- (if (or (fneq (vct-ref v0 1) 0.992) (fneq (vct-ref v0 8) 0.538)) (snd-display #__line__ ";polyshape output: ~A" v0))
- (set! (mus-data gen0) (make-vct 32))
+ (if (not (float-vector? (mus-data gen))) (snd-display #__line__ ";mus-data polyshape: ~A" (mus-data gen)))
+ (if (or (fneq (v0 1) 0.992) (fneq (v0 8) 0.538)) (snd-display #__line__ ";polyshape output: ~A" v0))
+ (set! (mus-data gen0) (make-float-vector 32))
(set! (mus-length gen0) 32)
(if (not (= (mus-length gen0) 32)) (snd-display #__line__ ";set mus-length polyshape: ~A" (mus-length gen0))))
@@ -22254,15 +16838,15 @@ EDITS: 2
(make-polyshape 440.0)
(make-polyshape 440.0 :partials '(1 1 2 .5)))
(test-gen-equal (make-polyshape 440.0 :partials '(1 1))
- (make-polyshape 440.0 :partials (vct 1 1))
+ (make-polyshape 440.0 :partials (float-vector 1 1))
(make-polyshape 440.0 :partials '(1 .5)))
(test-gen-equal (make-polyshape 440.0 :partials (list 1 .1 2 1 3 .5))
- (make-polyshape 440.0 :partials (vct 1 .1 2 1 3 .5))
+ (make-polyshape 440.0 :partials (float-vector 1 .1 2 1 3 .5))
(make-polyshape 440.0 :partials '(1 .1 2 .1 3 .5)))
(let ((gen (make-polyshape 440.0 :partials '(1 1)))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1100)))
(let* ((a (mus-phase gen))
(val1 (cos a))
@@ -22274,7 +16858,7 @@ EDITS: 2
(let ((gen (make-polyshape 440.0)) ; check default for partials: '(1 1)
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy)
(= i 1100)))
(let* ((a (mus-phase gen))
@@ -22285,9 +16869,9 @@ EDITS: 2
(snd-display #__line__ ";polyshaper default: '(1 1) ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
- (let ((gen (make-polyshape 440.0 :partials (vct 1 1)))
+ (let ((gen (make-polyshape 440.0 :partials (float-vector 1 1)))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1100)))
(let* ((a (mus-phase gen))
(val1 (* .5 (cos a)))
@@ -22304,11 +16888,12 @@ EDITS: 2
(let ((gen (make-polyshape 0.0 :coeffs (partials->polynomial '(1 1))))
(gen1 (make-polyshape 40.0 :coeffs (partials->polynomial '(1 1))))
(a1 0.0)
+ (incr (/ (* 2 pi 40.0) 22050.0))
(happy #t))
- (do ((i 0 (+ 1 i))
- (a 0.0 (+ a (/ (* 2 pi 40.0) 22050.0))))
+ (do ((i 0 (+ i 1))
+ (a 0.0 (+ a incr)))
((or (not happy) (= i 400)))
- (let* ((fm (cos a))
+ (let ((fm (cos a))
(val1 (cos a1))
(val2 (polyshape gen 1.0 (polyshape gen1 1.0))))
(set! a1 (+ a1 fm))
@@ -22319,124 +16904,145 @@ EDITS: 2
(for-each
(lambda (amps name)
- (let* ((n (vct-length amps))
- (angle 0.0)
- (incr (hz->radians 1.0))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 100)))
- (let ((sum (vct-ref amps 0))
- (cval (mus-chebyshev-t-sum angle amps)))
- (do ((k 1 (+ 1 k)))
- ((= k n))
- (set! sum (+ sum (* (vct-ref amps k) (cos (* k angle))))))
- (set! angle (+ angle incr))
- (if (fneq cval sum)
- (begin
- (snd-display #__line__ ";cheb-t-sum ~A: [~D] ~A ~A" name i cval sum)
- (set! happy #f)))))))
- (list (vct 0.0 1.0)
- (vct 0.0 0.5 0.25 0.25)
- (make-vct 100 0.01)
- (make-vct 1000 0.001))
+ (let ((data1 (make-float-vector 100))
+ (data2 (make-float-vector 100))
+ (data3 (make-float-vector 100))
+ (n (length amps))
+ (incr (hz->radians 1.0)))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle incr)))
+ ((= i 100))
+ (float-vector-set! data1 i (mus-chebyshev-t-sum angle amps)))
+
+ (do ((k 0 (+ k 1))
+ (kincr 0.0 (+ kincr incr)))
+ ((= k n))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle kincr)))
+ ((= i 100))
+ (float-vector-set! data3 i (cos angle)))
+ (float-vector-scale! data3 (float-vector-ref amps k))
+ (float-vector-add! data2 data3))
+
+ (let ((fudge *mus-float-equal-fudge-factor*))
+ (set! *mus-float-equal-fudge-factor* .0001)
+ (if (not (mus-arrays-equal? data1 data2))
+ (snd-display #__line__ "~A: ~A~%~A~%" name data1 data2))
+ (set! *mus-float-equal-fudge-factor* fudge))))
+
+ (list (float-vector 0.0 1.0)
+ (float-vector 0.0 0.5 0.25 0.25)
+ (make-float-vector 100 0.01)
+ (make-float-vector 1000 0.001))
(list 'one-cos
'three-cos
'hundred-cos
'thousand-cos))
-
+
(for-each
(lambda (amps name)
- (let* ((n (vct-length amps))
- (angle 0.0)
- (incr (hz->radians 1.0))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 100)))
- (let ((sum 0.0)
- (cval (mus-chebyshev-u-sum angle amps))) ; * sin is embedded in func
- (do ((k 1 (+ 1 k)))
- ((= k n))
- (set! sum (+ sum (* (vct-ref amps k) (sin (* k angle))))))
- (set! angle (+ angle incr))
- (if (fneq cval sum)
- (begin
- (snd-display #__line__ ";cheb-u-sum ~A: [~D] ~A ~A" name i cval sum)
- (set! happy #f)))))))
- (list (vct 0.0 1.0)
- (vct 0.0 0.5 0.25 0.25)
- (make-vct 100 0.01)
- (make-vct 1000 0.001))
- (list 'one-cos
- 'three-cos
- 'hundred-cos
- 'thousand-cos))
-
+ (let ((data1 (make-float-vector 100))
+ (data2 (make-float-vector 100))
+ (data3 (make-float-vector 100))
+ (n (length amps))
+ (incr (hz->radians 1.0)))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle incr)))
+ ((= i 100))
+ (float-vector-set! data1 i (mus-chebyshev-u-sum angle amps)))
+
+ (do ((k 0 (+ k 1))
+ (kincr 0.0 (+ kincr incr)))
+ ((= k n))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle kincr)))
+ ((= i 100))
+ (float-vector-set! data3 i (sin angle)))
+ (float-vector-scale! data3 (float-vector-ref amps k))
+ (float-vector-add! data2 data3))
+
+ (let ((fudge *mus-float-equal-fudge-factor*))
+ (set! *mus-float-equal-fudge-factor* .0001)
+ (if (not (mus-arrays-equal? data1 data2))
+ (snd-display #__line__ "~A: ~A~%~A~%" name data1 data2))
+ (set! *mus-float-equal-fudge-factor* fudge))))
+
+ (list (float-vector 0.0 1.0)
+ (float-vector 0.0 0.5 0.25 0.25)
+ (make-float-vector 100 0.01)
+ (make-float-vector 1000 0.001))
+ (list 'one-sin
+ 'three-sin
+ 'hundred-sin
+ 'thousand-sin))
+
(for-each
(lambda (camps samps name)
- (let* ((n (vct-length camps))
- (angle 0.0)
- (incr (hz->radians 1.0))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 100)))
- (let ((sum (vct-ref camps 0))
- (cval (mus-chebyshev-tu-sum angle camps samps)))
- (do ((k 1 (+ 1 k)))
- ((= k n))
- (set! sum (+ sum (+ (* (vct-ref samps k) (sin (* k angle)))
- (* (vct-ref camps k) (cos (* k angle)))))))
- (set! angle (+ angle incr))
- (if (fneq cval sum)
- (begin
- (snd-display #__line__ ";cheb-tu-sum ~A: [~D] ~A ~A" name i cval sum)
- (set! happy #f)))))))
- (list (vct 0.0 1.0)
- (vct 0.0 0.25 0.0 0.25)
- (make-vct 100 .004)
- (make-vct 1000 0.0005))
- (list (vct 0.0 0.0)
- (vct 0.0 0.25 0.25 0.0)
- (make-vct 100 .006)
- (make-vct 1000 0.0005))
+ (let ((data1 (make-float-vector 100))
+ (data2 (make-float-vector 100))
+ (data3 (make-float-vector 100))
+ (n (length camps))
+ (incr (hz->radians 1.0)))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle incr)))
+ ((= i 100))
+ (float-vector-set! data1 i (mus-chebyshev-tu-sum angle camps samps)))
+
+ (do ((k 0 (+ k 1))
+ (kincr 0.0 (+ kincr incr)))
+ ((= k n))
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle kincr)))
+ ((= i 100))
+ (float-vector-set! data3 i (sin angle)))
+ (float-vector-scale! data3 (float-vector-ref samps k))
+ (float-vector-add! data2 data3)
+ (do ((i 0 (+ i 1))
+ (angle 0.0 (+ angle kincr)))
+ ((= i 100))
+ (float-vector-set! data3 i (cos angle)))
+ (float-vector-scale! data3 (float-vector-ref camps k))
+ (float-vector-add! data2 data3))
+
+ (let ((fudge *mus-float-equal-fudge-factor*))
+ (set! *mus-float-equal-fudge-factor* .0001)
+ (if (not (mus-arrays-equal? data1 data2))
+ (snd-display "~A: ~A~%~A~%" name data1 data2))
+ (set! *mus-float-equal-fudge-factor* fudge))))
+
+ (list (float-vector 0.0 1.0)
+ (float-vector 0.0 0.25 0.0 0.25)
+ (make-float-vector 100 .004)
+ (make-float-vector 1000 0.0005))
+ (list (float-vector 0.0 0.0)
+ (float-vector 0.0 0.25 0.25 0.0)
+ (make-float-vector 100 .006)
+ (make-float-vector 1000 0.0005))
(list 'one-tu
'three-tu
'hundred-tu
'thousand-tu))
- (for-each
- (lambda (n)
- (let ((distance (test-polyoid n)))
- (if (fneq distance 0.0)
- (snd-display #__line__ ";test polyoid ~A ~A" n distance))))
- (list 1 3 10))
-
- (for-each
- (lambda (n)
- (let ((distance (test-polyoid-run n)))
- (if (fneq distance 0.0)
- (snd-display #__line__ ";test polyoid run ~A ~A" n distance))))
- (list 1 8 32 100))
-
;; polywave
(let ((gen0 (make-polywave 440.0 '(1 1)))
(gen (make-polywave 440.0 :partials '(1 1) :type mus-chebyshev-first-kind))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-polywave 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"polywave"
- "polywave freq: 440.000Hz, phase: 0.000, coeffs[2]: [0.000 1.000]")
+ "polywave freq: 440.000Hz, phase: 0.000, coeffs[2]: [0 1]")
(if (not (= (mus-length gen) 2)) (snd-display #__line__ ";polywave length: ~A?" (mus-length gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((val0 (polywave gen0 0.0))
(val (polywave gen 0.0)))
(if (fneq val val0) (snd-display #__line__ ";polywave: ~A is not ~F?" val val0))
- (vct-set! v0 i val)))
- (vct-map! v1 (lambda () (if (polywave? gen1) (polywave gen1 0.0) -1.0)))
+ (set! (v0 i) val)))
+ (fill-float-vector v1 (if (polywave? gen1) (polywave gen1 0.0) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map polywave: ~A ~A" v0 v1))
- (set! gen1 (make-polywave 440.0 (vct 1 1)))
- (vct-map! v1 (lambda () (polywave gen1)))
+ (set! gen1 (make-polywave 440.0 (float-vector 1 1)))
+ (fill-float-vector v1 (polywave gen1))
(if (not (vequal v0 v1)) (snd-display #__line__ ";1 map polywave: ~A ~A" v0 v1))
(if (not (polywave? gen)) (snd-display #__line__ ";~A not polywave?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";polywave phase: ~F?" (mus-phase gen)))
@@ -22445,8 +17051,8 @@ EDITS: 2
(if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";polywave frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
(if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";polywave frequency: ~F?" (mus-frequency gen)))
- (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data polywave: ~A" (mus-data gen)))
- (if (or (fneq (vct-ref v0 1) 0.992) (fneq (vct-ref v0 8) 0.538)) (snd-display #__line__ ";polywave output: ~A" v0)))
+ (if (not (float-vector? (mus-data gen))) (snd-display #__line__ ";mus-data polywave: ~A" (mus-data gen)))
+ (if (or (fneq (v0 1) 0.992) (fneq (v0 8) 0.538)) (snd-display #__line__ ";polywave output: ~A" v0)))
(test-gen-equal (make-polywave 440.0 :partials '(1 1))
(make-polywave 440.0)
@@ -22455,15 +17061,15 @@ EDITS: 2
(make-polywave 440.0)
(make-polywave 440.0 '(1 1 2 .5)))
(test-gen-equal (make-polywave 440.0 '(1 1))
- (make-polywave 440.0 (vct 1 1))
+ (make-polywave 440.0 (float-vector 1 1))
(make-polywave 440.0 '(1 .5)))
(test-gen-equal (make-polywave 440.0 (list 1 .1 2 1 3 .5))
- (make-polywave 440.0 (vct 1 .1 2 1 3 .5))
+ (make-polywave 440.0 (float-vector 1 .1 2 1 3 .5))
(make-polywave 440.0 '(1 .1 2 .1 3 .5)))
(let ((gen (make-polywave 440.0 '(1 1)))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1100)))
(let* ((a (mus-phase gen))
(val1 (cos a))
@@ -22475,7 +17081,7 @@ EDITS: 2
(let ((gen (make-polywave 440.0)) ; check default for partials: '(1 1)
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1100)))
(let* ((a (mus-phase gen))
(val1 (cos a))
@@ -22485,10 +17091,10 @@ EDITS: 2
(snd-display #__line__ ";polywaver default: '(1 1) ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
- (let ((gen (make-polywave 440.0 (vct 1 1)))
+ (let ((gen (make-polywave 440.0 (float-vector 1 1)))
(happy #t))
(set! (mus-scaler gen) 0.5)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1100)))
(let* ((a (mus-phase gen))
(val1 (* .5 (cos a)))
@@ -22498,28 +17104,26 @@ EDITS: 2
(snd-display #__line__ ";polywaver (1 1) .5 index ~A: ~A ~A" i val1 val2)
(set! happy #f))))))
- (let ((old-srate (mus-srate)))
- (set! (mus-srate) 44100)
+ (let ((old-srate *clm-srate*)
+ (v0 (make-float-vector 4410))
+ (v1 (make-float-vector 4410)))
+ (set! *clm-srate* 44100)
(for-each
(lambda (k)
- (let ((gen (make-polywave 100.0 (list 1 0.5 k 0.5))))
- (let ((err 0.0)
- (err-max 0.0)
- (err-max-loc -1))
- (do ((i 0 (+ 1 i)))
- ((>= i 44100))
- (let* ((ph (mus-phase gen))
- (gval (polywave gen))
- (sval (* 0.5 (+ (cos ph)
- (cos (* k ph)))))
- (err-local (abs (- sval gval))))
- (if (> err-local err-max)
- (begin
- (set! err-max-loc i)
- (set! err-max err-local)))
- (set! err (+ err err-local))))
- (if (> err-max 2.0e-3)
- (snd-display #__line__ ";polywave vs sin: ~D: ~A ~A ~A" k err err-max err-max-loc)))))
+ (let ((gen (make-polywave 100.0 (list 1 0.5 k 0.5)))
+ (incr (/ (* 2.0 pi 100.0) 44100))
+ (kincr (/ (* 2.0 k pi 100.0) 44100)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4410))
+ (set! (v0 i) (polywave gen)))
+ (do ((i 0 (+ i 1))
+ (ph 0.0 (+ ph incr))
+ (kph 0.0 (+ kph kincr)))
+ ((= i 4410))
+ (float-vector-set! v1 i (+ (cos ph) (cos kph))))
+ (float-vector-scale! v1 0.5)
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ ";polywave ~D vs cos: ~A" k (float-vector-peak-and-location (float-vector-subtract! v0 v1))))))
(list 2 19 20 29 30 39 40 60 100))
(for-each
@@ -22527,7 +17131,7 @@ EDITS: 2
(let ((gen1 (make-polywave 100.0 (list n 1.0)))
(gen2 (make-oscil (* n 100.0) (/ pi 2)))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1000)))
(let ((val1 (polywave gen1))
(val2 (oscil gen2)))
@@ -22542,14 +17146,14 @@ EDITS: 2
(let ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-second-kind))
(gen2 (make-oscil (* n 100.0)))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1000)))
(let ((val1 (polywave gen1))
(val2 (oscil gen2)))
(if (fneq val1 val2)
(begin
(set! happy #f)
- (snd-display #__line__ ";polywave 2nd ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (snd-display #__line__ ";polywave second ~A at ~A: ~A ~A" n i val1 val2)))))))
(list 1 8 50 128))
(for-each
@@ -22557,7 +17161,7 @@ EDITS: 2
(let ((gen1 (make-polyshape 100.0 :partials (list n 1.0)))
(gen2 (make-oscil (* n 100.0) (/ pi 2)))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1000)))
(let ((val1 (polyshape gen1))
(val2 (oscil gen2)))
@@ -22572,14 +17176,14 @@ EDITS: 2
(let ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-second-kind))
(gen2 (make-oscil (* n 100.0)))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1000)))
(let ((val1 (polyshape gen1))
(val2 (oscil gen2)))
(if (fneq val1 val2)
(begin
(set! happy #f)
- (snd-display #__line__ ";polyshape 2nd ~A at ~A: ~A ~A" n i val1 val2)))))))
+ (snd-display #__line__ ";polyshape second ~A at ~A: ~A ~A" n i val1 val2)))))))
(list 1 8 16))
(for-each
@@ -22587,14 +17191,13 @@ EDITS: 2
(let ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-first-kind))
(gen2 (make-oscil (* n 100.0) (/ pi 2)))
(max-dist 0.0))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(let ((val1 (polywave gen1))
(val2 (oscil gen2)))
- (set! max-dist (max max-dist (abs (- val1 val2)))))))
+ (set! max-dist (max max-dist (abs (- val1 val2))))))
(if (fneq max-dist 0.0)
- (snd-display #__line__ ";polywave run ~A: ~A ~A" n val1 val2))))
+ (snd-display #__line__ ";polywave run ~A: ~A" n max-dist))))
(list 1 3 30 200))
(for-each
@@ -22602,14 +17205,13 @@ EDITS: 2
(let ((gen1 (make-polywave 100.0 (list n 1.0) mus-chebyshev-second-kind))
(gen2 (make-oscil (* n 100.0)))
(max-dist 0.0))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(let ((val1 (polywave gen1))
(val2 (oscil gen2)))
- (set! max-dist (max max-dist (abs (- val1 val2)))))))
+ (set! max-dist (max max-dist (abs (- val1 val2))))))
(if (fneq max-dist 0.0)
- (snd-display #__line__ ";polywave 2nd run ~A: ~A ~A" n val1 val2))))
+ (snd-display #__line__ ";polywave second run ~A: ~A" n max-dist))))
(list 1 3 30 200))
(for-each
@@ -22617,14 +17219,13 @@ EDITS: 2
(let ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-first-kind))
(gen2 (make-oscil (* n 100.0) (/ pi 2)))
(max-dist 0.0))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(let ((val1 (polyshape gen1))
(val2 (oscil gen2)))
- (set! max-dist (max max-dist (abs (- val1 val2)))))))
+ (set! max-dist (max max-dist (abs (- val1 val2))))))
(if (fneq max-dist 0.0)
- (snd-display #__line__ ";polyshape run ~A: ~A ~A" n val1 val2))))
+ (snd-display #__line__ ";polyshape run ~A: ~A" n max-dist))))
(list 1 3 25))
(for-each
@@ -22632,28 +17233,27 @@ EDITS: 2
(let ((gen1 (make-polyshape 100.0 :partials (list n 1.0) :kind mus-chebyshev-second-kind))
(gen2 (make-oscil (* n 100.0)))
(max-dist 0.0))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(let ((val1 (polyshape gen1))
(val2 (oscil gen2)))
- (set! max-dist (max max-dist (abs (- val1 val2)))))))
+ (set! max-dist (max max-dist (abs (- val1 val2))))))
(if (fneq max-dist 0.0)
- (snd-display #__line__ ";polyshape 2nd run ~A: ~A ~A" n val1 val2))))
+ (snd-display #__line__ ";polyshape second run ~A: ~A" n max-dist))))
(list 1 3 25))
- (let ((gen (make-polywave 100.0 (list 1 .9 3 .1))))
+ (let ((gen (make-polywave 100.0 (list 1 .9 3 .1 4 0.0))))
(let ((vals (mus-data gen)))
- (if (or (not (vct? vals))
- (not (vequal vals (vct 0.000 0.900 0.000 0.100))))
+ (if (or (not (float-vector? vals))
+ (not (vequal vals (float-vector 0.000 0.900 0.000 0.100 0.00))))
(snd-display #__line__ ";polywave mus-data: ~A" vals)
(begin
- (vct-set! (mus-data gen) 2 .1)
- (vct-set! (mus-data gen) 3 0.0)
+ (float-vector-set! (mus-data gen) 2 .1)
+ (float-vector-set! (mus-data gen) 3 0.0)
(let ((happy #t)
(gen1 (make-oscil 100.0 (/ pi 2)))
(gen2 (make-oscil 200.0 (/ pi 2))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 1000)))
(let ((val1 (polywave gen))
(val2 (+ (* .9 (oscil gen1))
@@ -22662,29 +17262,52 @@ EDITS: 2
(begin
(set! happy #f)
(snd-display #__line__ ";polywave set mus-data at ~A: ~A ~A" i val1 val2))))))))))
- (set! (mus-srate) old-srate))
-
+ (set! *clm-srate* old-srate))
+
+ ;; check dc
+ (do ((i 2 (+ i 1)))
+ ((= i 7))
+ (let ((cfs (make-list (* 2 i) 0.1)))
+ (do ((k 0 (+ k 2)))
+ ((>= k (length cfs)))
+ (set! (cfs k) (/ k 2)))
+ (let ((p (make-polywave 100.0 cfs mus-chebyshev-second-kind)))
+ (let ((val (polywave p)))
+ (if (fneq val 0.1)
+ (snd-display #__line__ ";polywave ~D order second 0-coeff: ~A" i val))))))
+
+ (do ((i 2 (+ i 1)))
+ ((= i 7))
+ (let ((cfs (make-list (* 2 i) 0.1)))
+ (do ((k 0 (+ k 2)))
+ ((>= k (length cfs)))
+ (set! (cfs k) (/ k 2)))
+ (let ((p (make-polywave 100.0 cfs mus-chebyshev-first-kind)))
+ (let ((val (polywave p)))
+ (if (fneq val (* 0.1 i))
+ (snd-display #__line__ ";polywave ~D order first 0-coeff: ~A" i val))))))
+
(let ((var (catch #t (lambda () (make-polywave 440.0 3.14)) (lambda args args))))
(if (not (eq? (car var) 'wrong-type-arg))
(snd-display #__line__ ";make-polywave bad coeffs: ~A" var)))
- (let ((gen (make-wave-train 440.0 0.0 (make-vct 20)))
- (v0 (make-vct 10))
- (gen1 (make-wave-train 440.0 0.0 (make-vct 20)))
- (v1 (make-vct 10)))
+ (let ((gen (make-wave-train 440.0 0.0 (make-float-vector 20)))
+ (v0 (make-float-vector 10))
+ (gen1 (make-wave-train 440.0 0.0 (make-float-vector 20)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"wave-train"
"wave-train freq: 440.000Hz, phase: 0.000, size: 20, interp: linear")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! (mus-data gen) i (* i .5))
- (vct-set! (mus-data gen1) i (vct-ref (mus-data gen) i)))
- (if (not (= (vct-length (mus-data gen)) 20)) (snd-display #__line__ ";wave-train data length: ~A?" (vct-length (mus-data gen))))
+ (float-vector-set! (mus-data gen) i (* i .5))
+ (float-vector-set! (mus-data gen1) i ((mus-data gen) i)))
+ (if (not (= (length (mus-data gen)) 20)) (snd-display #__line__ ";wave-train data length: ~A?" (length (mus-data gen))))
(if (not (= (mus-length gen) 20)) (snd-display #__line__ ";wave-train length: ~A?" (mus-length gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (wave-train gen 0.0)))
- (vct-map! v1 (lambda () (if (wave-train? gen1) (wave-train gen1) -1.0)))
+ (set! (v0 i) (wave-train gen 0.0)))
+ (fill-float-vector v1 (if (wave-train? gen1) (wave-train gen1) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map wave-train: ~A ~A" v0 v1))
(if (not (wave-train? gen)) (snd-display #__line__ ";~A not wave-train?" gen))
(if (fneq (mus-phase gen) 0.0) (snd-display #__line__ ";wave-train phase: ~F?" (mus-phase gen)))
@@ -22693,17 +17316,16 @@ EDITS: 2
(if (fneq (mus-frequency gen) 440.0) (snd-display #__line__ ";wave-train frequency: ~F?" (mus-frequency gen)))
(set! (mus-frequency gen) 100.0)
(if (fneq (mus-frequency gen) 100.0) (snd-display #__line__ ";set wave-train freq: ~A" (mus-frequency gen)))
- (if (or (fneq (vct-ref v0 1) 0.5) (fneq (vct-ref v0 8) 4.0)) (snd-display #__line__ ";wave-train output: ~A" v0))
+ (if (or (fneq (v0 1) 0.5) (fneq (v0 8) 4.0)) (snd-display #__line__ ";wave-train output: ~A" v0))
(mus-reset gen)
(if (fneq (mus-phase gen) 0.0) (snd-display #__line__ ";wt reset phase: ~A" (mus-phase gen)))
(let ((val (wave-train gen 0.0)))
(if (fneq val 0.0) (snd-display #__line__ ";wt reset data: ~A" val)))
- (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data wave-train: ~A" (mus-data gen)))
- (set! (mus-data gen) (make-vct 3)))
- (set! (mus-data (make-oscil)) (make-vct 3))
+ (if (not (float-vector? (mus-data gen))) (snd-display #__line__ ";mus-data wave-train: ~A" (mus-data gen)))
+ (set! (mus-data gen) (make-float-vector 3)))
- (test-gen-equal (make-wave-train 440.0 0.0 (make-vct 20)) (make-wave-train 440.0 0.0 (make-vct 20)) (make-wave-train 100.0 0.0 (make-vct 20)))
- (test-gen-equal (make-wave-train 440.0 0.0 (make-vct 20)) (make-wave-train 440.0 0.0 (make-vct 20)) (make-wave-train 440.0 1.0 (make-vct 20)))
+ (test-gen-equal (make-wave-train 440.0 0.0 (make-float-vector 20)) (make-wave-train 440.0 0.0 (make-float-vector 20)) (make-wave-train 100.0 0.0 (make-float-vector 20)))
+ (test-gen-equal (make-wave-train 440.0 0.0 (make-float-vector 20)) (make-wave-train 440.0 0.0 (make-float-vector 20)) (make-wave-train 440.0 1.0 (make-float-vector 20)))
(test-gen-equal (make-wave-train-with-env 440.0 '(0 0 1 1))
(make-wave-train-with-env 440.0 (list 0 0 1 1))
@@ -22718,144 +17340,128 @@ EDITS: 2
(lambda (args)
(let ((type (car args))
(vals (cadr args)))
- (let* ((tbl1 (make-wave-train :frequency 3000.0 :initial-phase (/ (* 2.0 pi .2) 4) :size 4 :type type)))
- (vct-set! (mus-data tbl1) 1 1.0)
- (let ((v (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (let ((tbl1 (make-wave-train :frequency 3000.0 :initial-phase (/ (* 2.0 pi .2) 4) :size 4 :type type)))
+ (float-vector-set! (mus-data tbl1) 1 1.0)
+ (let ((v (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (wave-train tbl1 0.0))) ;(wave-train tbl1 (/ (* 2 pi .2) 4))))
+ (set! (v i) (wave-train tbl1 0.0))) ;(wave-train tbl1 (/ (* 2 pi .2) 4))))
(if (not (vequal v vals))
(snd-display #__line__ ";wt tbl interp ~A: ~A ~A" type v (mus-describe tbl1)))
(if (not (= (mus-interp-type tbl1) type)) (snd-display #__line__ ";wt tbl interp-type (~A): ~A" type (mus-interp-type tbl1)))))))
(list
- (list mus-interp-none (vct 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000))
- (list mus-interp-linear (vct 0.200 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.200 0.800))
- (list mus-interp-lagrange (vct 0.120 0.960 -0.080 0.000 0.000 0.000 0.000 0.000 0.120 0.960))
- (list mus-interp-hermite (vct 0.168 0.912 -0.064 -0.016 0.000 0.000 0.000 0.000 0.168 0.912))))
+ (list mus-interp-none (float-vector 0.000 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 1.000))
+ (list mus-interp-linear (float-vector 0.200 0.800 0.000 0.000 0.000 0.000 0.000 0.000 0.200 0.800))
+ (list mus-interp-lagrange (float-vector 0.120 0.960 -0.080 0.000 0.000 0.000 0.000 0.000 0.120 0.960))
+ (list mus-interp-hermite (float-vector 0.168 0.912 -0.064 -0.016 0.000 0.000 0.000 0.000 0.168 0.912))))
(let ((tag (catch #t (lambda () (make-wave-train :size 0)) (lambda args (car args)))))
(if (not (eq? tag 'out-of-range)) (snd-display #__line__ ";wave-train size 0: ~A" tag)))
(let ((ind (new-sound "fmv.snd" :size 10 :comment "line 20501")))
- (if (not (= (frames) 10)) (snd-display #__line__ ";new-sound size(10): ~A" (frames)))
+ (if (not (= (framples) 10)) (snd-display #__line__ ";new-sound size(10): ~A" (framples)))
(map-channel (lambda (y) 1.0) 7 8)
- (if (not (= (frames) 15)) (snd-display #__line__ ";map-channel 7 8: ~A" (frames)))
+ (if (not (= (framples) 15)) (snd-display #__line__ ";map-channel 7 8: ~A" (framples)))
(map-channel (lambda (y) 1.0))
- (if (not (= (frames) 15)) (snd-display #__line__ ";map-channel (no dur): ~A" (frames)))
+ (if (not (= (framples) 15)) (snd-display #__line__ ";map-channel (no dur): ~A" (framples)))
(revert-sound ind)
(map-channel (lambda (y) 1.0) 9 10)
- (if (not (= (frames) 19)) (snd-display #__line__ ";map-channel 9 10: ~A" (frames)))
+ (if (not (= (framples) 19)) (snd-display #__line__ ";map-channel 9 10: ~A" (framples)))
(if (> (edit-position ind 0) 2) (snd-display #__line__ ";map-channel pad edits: ~A" (edit-position ind 0)))
(revert-sound ind)
(map-channel (lambda (y) 1.0) 10 10)
- (if (not (= (frames) 20)) (snd-display #__line__ ";map-channel 10 10: ~A" (frames)))
+ (if (not (= (framples) 20)) (snd-display #__line__ ";map-channel 10 10: ~A" (framples)))
(if (> (edit-position ind 0) 2) (snd-display #__line__ ";map-channel pad edits (2): ~A" (edit-position ind 0)))
(revert-sound ind)
(map-channel (lambda (y) 1.0) 20 10)
- (if (not (= (frames) 30)) (snd-display #__line__ ";map-channel 20 10: ~A" (frames)))
+ (if (not (= (framples) 30)) (snd-display #__line__ ";map-channel 20 10: ~A" (framples)))
(if (> (edit-position ind 0) 2) (snd-display #__line__ ";map-channel pad edits (3): ~A" (edit-position ind 0)))
(revert-sound ind)
(if (scan-channel (lambda (y) #f) 30 10) (snd-display #__line__ ";scan-channel past end?"))
- (ptree-channel (lambda (y) 1.0) 7 8)
- (if (not (= (frames) 15)) (snd-display #__line__ ";ptree-channel 7 8: ~A" (frames)))
- (ptree-channel (lambda (y) 1.0))
- (if (not (= (frames) 15)) (snd-display #__line__ ";ptree-channel (no dur): ~A" (frames)))
- (revert-sound ind)
- (ptree-channel (lambda (y) 1.0) 9 10)
- (if (not (= (frames) 19)) (snd-display #__line__ ";ptree-channel 9 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display #__line__ ";ptree-channel pad edits: ~A" (edit-position ind 0)))
- (revert-sound ind)
- (ptree-channel (lambda (y) 1.0) 10 10)
- (if (not (= (frames) 20)) (snd-display #__line__ ";ptree-channel 10 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display #__line__ ";ptree-channel pad edits (2): ~A" (edit-position ind 0)))
- (revert-sound ind)
- (ptree-channel (lambda (y) 1.0) 20 10)
- (if (not (= (frames) 30)) (snd-display #__line__ ";ptree-channel 20 10: ~A" (frames)))
- (if (> (edit-position ind 0) 2) (snd-display #__line__ ";ptree-channel pad edits (3): ~A" (edit-position ind 0)))
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
(let ((ind (new-sound :size 1000)))
- (let* ((table (vct 0.0 .1 .2 .3 .4 .5 .6))
+ (let* ((table (float-vector 0.0 .1 .2 .3 .4 .5 .6))
(gen (make-wave-train 1000.0 :wave table)))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.6) (snd-display #__line__ ";wt 0 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.600)))
- (snd-display #__line__ ";wt 0 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 85 30)
- (vct 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000
+ (snd-display #__line__ ";wt 0 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 85 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300)))
- (snd-display #__line__ ";wt 0 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";wt 0 data 85: ~A" (channel->float-vector 85 30)))
(undo))
- (let* ((table (make-vct 10 .1))
+ (let* ((table (make-float-vector 10 .1))
(gen (make-wave-train 1000.0 :initial-phase pi :wave table))) ; initial-phase is confusing in this context!
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display #__line__ ";wt 1 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000)))
- (let ((op (print-length)))
- (set! (print-length) 32)
- (snd-display #__line__ ";wt 1 data: ~A" (channel->vct 0 30))
- (set! (print-length) op)))
+ (let ((op *print-length*))
+ (set! *print-length* 32)
+ (snd-display #__line__ ";wt 1 data: ~A" (channel->float-vector 0 30))
+ (set! *print-length* op)))
(undo))
- (let* ((table (make-vct 10 .1))
+ (let* ((table (make-float-vector 10 .1))
(gen (make-wave-train 2000.0 :wave table)))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display #__line__ ";wt 2 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100)))
- (snd-display #__line__ ";wt 2 data: ~A" (channel->vct 0 30)))
- (if (and (not (vequal (channel->vct 440 30)
- (vct 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100
+ (snd-display #__line__ ";wt 2 data: ~A" (channel->float-vector 0 30)))
+ (if (and (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100)))
;; if double, round off is just enough different to cause an off-by-1 problem here (and below)
- (not (vequal (channel->vct 440 30)
- (vct 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100
+ (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100 0.100 0.100 0.100 0.100 0.100))))
- (snd-display #__line__ ";wt 2 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";wt 2 data 440: ~A" (channel->float-vector 440 30)))
(undo))
- (let* ((table (make-vct 10 .1))
+ (let* ((table (make-float-vector 10 .1))
(gen (make-wave-train 3000.0 :wave table)))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.2) (snd-display #__line__ ";wt 3 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100 0.100
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100 0.100
0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100 0.100)))
- (snd-display #__line__ ";wt 3 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 440 30)
- (vct 0.100 0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100
+ (snd-display #__line__ ";wt 3 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.100 0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100
0.100 0.200 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.100 0.100 0.100 0.100)))
- (snd-display #__line__ ";wt 3 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";wt 3 data 440: ~A" (channel->float-vector 440 30)))
(undo))
- (let* ((table (make-vct 10 .1))
+ (let* ((table (make-float-vector 10 .1))
(gen (make-wave-train 5000.0 :wave table)))
(map-channel (lambda (y) (wave-train gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.3) (snd-display #__line__ ";wt 4 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300
0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200 0.200)))
- (snd-display #__line__ ";wt 4 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 440 30)
- (vct 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.300 0.200 0.200 0.200
+ (snd-display #__line__ ";wt 4 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.300 0.200 0.200 0.200
0.300 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.200 0.300 0.200 0.200 0.200 0.300 0.200)))
- (snd-display #__line__ ";wt 4 data 440: ~A" (channel->vct 440 30)))
+ (snd-display #__line__ ";wt 4 data 440: ~A" (channel->float-vector 440 30)))
(undo))
- (let* ((table (make-vct 10 .1))
+ (let* ((table (make-float-vector 10 .1))
(gen (make-wave-train 1000.0 :wave table))
(e (make-env '(0 1 1 2) :length 1001))
(base-freq (mus-frequency gen)))
@@ -22866,21 +17472,21 @@ EDITS: 2
result)))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display #__line__ ";wt 5 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100)))
- (snd-display #__line__ ";wt 5 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 440 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.100
+ (snd-display #__line__ ";wt 5 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.100)))
- (snd-display #__line__ ";wt 5 data 440: ~A" (channel->vct 440 30)))
- (if (not (vequal (channel->vct 900 30)
- (vct 0.100 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100
+ (snd-display #__line__ ";wt 5 data 440: ~A" (channel->float-vector 440 30)))
+ (if (not (vequal (channel->float-vector 900 30)
+ (float-vector 0.100 0.000 0.000 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.100 0.100 0.100 0.100)))
- (snd-display #__line__ ";wt 5 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";wt 5 data 900: ~A" (channel->float-vector 900 30)))
(undo))
- (let* ((table (make-vct 10 .1))
+ (let* ((table (make-float-vector 10 .1))
(gen (make-wave-train 500.0 :wave table))
(ctr 0))
(map-channel
@@ -22889,56 +17495,55 @@ EDITS: 2
(if (> ctr 22)
(begin
(set! ctr 0)
- (vct-scale! (mus-data gen) 1.05))
- (set! ctr (+ 1 ctr)))
+ (float-vector-scale! (mus-data gen) 1.05))
+ (set! ctr (+ ctr 1)))
result)))
(let ((mx (maxamp)))
(if (fneq mx 0.704) (snd-display #__line__ ";wt 6 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";wt 6 data: ~A" (channel->vct 0 30)))
- (if (and (not (vequal (channel->vct 440 30)
- (vct 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
+ (snd-display #__line__ ";wt 6 data: ~A" (channel->float-vector 0 30)))
+ (if (and (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal (channel->vct 440 30)
- (vct 0.000 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
+ (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.000 0.000 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.241 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
- (snd-display #__line__ ";wt 6 data 440: ~A" (channel->vct 440 30)))
- (if (not (vequal (channel->vct 900 30)
- (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ (snd-display #__line__ ";wt 6 data 440: ~A" (channel->float-vector 440 30)))
+ (if (not (vequal (channel->float-vector 900 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.639 0.639 0.639)))
- (snd-display #__line__ ";wt 6 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";wt 6 data 900: ~A" (channel->float-vector 900 30)))
(undo))
(let ((fname (file-name ind)))
(close-sound ind)
(delete-file fname)))
(let ((gen (make-readin "oboe.snd" 0 1490))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-readin "oboe.snd" 0 1490))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"readin"
"readin oboe.snd[chan 0], loc: 1490, dir: 1")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (readin gen)))
- (vct-map! v1 (lambda ()
- (if (readin? gen1)
+ (set! (v0 i) (readin gen)))
+ (fill-float-vector v1 (if (readin? gen1)
(if (= (mus-channel gen1) 0)
(readin gen1)
1.0)
(if (string=? (mus-file-name gen1) "oboe.snd")
-1.0
- -1.0))))
+ 1.0)))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map readin: ~A ~A" v0 v1))
(if (not (readin? gen)) (snd-display #__line__ ";~A not readin?" gen))
(if (not (mus-input? gen)) (snd-display #__line__ ";~A not input?" gen))
(if (not (= (mus-length gen) 50828)) (snd-display #__line__ ";readin length: ~A?" (mus-length gen)))
(if (not (= (mus-channel gen) 0)) (snd-display #__line__ ";readin chan: ~A?" (mus-channel gen)))
(if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display #__line__ ";readin mus-file-name: ~A" (mus-file-name gen)))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";readin output: ~A" v0))
+ (if (or (fneq (v0 1) -0.009) (fneq (v0 7) .029)) (snd-display #__line__ ";readin output: ~A" v0))
(set! (mus-location gen) 1000)
(if (not (= (mus-location gen) 1000)) (snd-display #__line__ ";set! mus-location: ~A?" (mus-location gen)))
(let ((val (readin gen)))
@@ -22955,32 +17560,32 @@ EDITS: 2
(test-gen-equal (make-readin "2.snd" 1) (make-readin "2.snd" 1) (make-readin "2.snd" 0))
(let ((gen (make-readin "2.snd" 1 :size 1024))
- (v0 (make-vct 10)))
+ (v0 (make-float-vector 10)))
(print-and-check gen
"readin"
"readin 2.snd[chan 1], loc: 0, dir: 1")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (readin gen)))
+ (set! (v0 i) (readin gen)))
(if (not (= (mus-channel gen) 1)) (snd-display #__line__ ";readin chan 1: ~A?" (mus-channel gen)))
- (if (or (fneq (vct-ref v0 1) 0.010) (fneq (vct-ref v0 7) -.006)) (snd-display #__line__ ";readin 1 output: ~A" v0))
+ (if (or (fneq (v0 1) 0.010) (fneq (v0 7) -.006)) (snd-display #__line__ ";readin 1 output: ~A" v0))
(print-and-check gen
"readin"
"readin 2.snd[chan 1], loc: 10, dir: 1"))
(let ((gen (make-file->sample "oboe.snd"))
- (v0 (make-vct 10)))
+ (v0 (make-float-vector 10)))
(print-and-check gen
"file->sample"
"file->sample oboe.snd")
(if (not (mus-input? gen)) (snd-display #__line__ ";~A not input?" gen))
(if (not (= (mus-length gen) 50828)) (snd-display #__line__ ";file->sample length: ~A?" (mus-length gen)))
(if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display #__line__ ";file->sample mus-file-name: ~A" (mus-file-name gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (file->sample gen (+ 1490 i))))
+ (set! (v0 i) (file->sample gen (+ 1490 i))))
(if (not (file->sample? gen)) (snd-display #__line__ ";~A not file->sample?" gen))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";file->sample output: ~A" v0))
+ (if (or (fneq (v0 1) -0.009) (fneq (v0 7) .029)) (snd-display #__line__ ";file->sample output: ~A" v0))
(if (fneq (mus-increment gen) 0.0) (snd-display #__line__ ";file->sample increment: ~A" (mus-increment gen)))
(set! (mus-increment gen) 1.0)
(if (fneq (mus-increment gen) 1.0) (snd-display #__line__ ";file->sample set increment: ~A" (mus-increment gen)))
@@ -22989,36 +17594,35 @@ EDITS: 2
(let* ((ind (open-sound "oboe.snd"))
(gen (make-snd->sample ind))
(gen1 (make-snd->sample ind))
- (v0 (make-vct 10)))
+ (v0 (make-float-vector 10)))
(print-and-check gen
"snd->sample"
"snd->sample reading oboe.snd (1 chan) at 0:[no readers]")
- (if (not (equal? gen gen)) (snd-display #__line__ ";snd->sample not eq? itself?"))
(if (equal? gen gen1) (snd-display #__line__ ";snd->sample eq? not itself?"))
(if (not (mus-input? gen)) (snd-display #__line__ ";snd->sample ~A not input?" gen))
- (if (not (= (frames ind) (mus-length gen))) (snd-display #__line__ ";snd->sample len: ~A ~A" (frames ind) (mus-length gen)))
+ (if (not (= (framples ind) (mus-length gen))) (snd-display #__line__ ";snd->sample len: ~A ~A" (framples ind) (mus-length gen)))
(if (not (string=? (mus-file-name gen) (string-append cwd "oboe.snd")))
(snd-display #__line__ ";snd->sample mus-file-name: ~A ~A" (mus-file-name gen) (string-append cwd "oboe.snd")))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (snd->sample gen (+ 1490 i))))
+ (set! (v0 i) (snd->sample gen (+ 1490 i))))
(if (not (snd->sample? gen)) (snd-display #__line__ ";~A not snd->sample?" gen))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";snd->sample output: ~A" v0))
+ (if (or (fneq (v0 1) -0.009) (fneq (v0 7) .029)) (snd-display #__line__ ";snd->sample output: ~A" v0))
(if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";snd->sample channels: ~A" (mus-channels gen)))
(if (not (= (mus-location gen) 1499)) (snd-display #__line__ ";snd->sample location: ~A" (mus-location gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (ina (+ 1490 i) gen)))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";snd->sample ina output: ~A" v0))
+ (set! (v0 i) (ina (+ 1490 i) gen)))
+ (if (or (fneq (v0 1) -0.009) (fneq (v0 7) .029)) (snd-display #__line__ ";snd->sample ina output: ~A" v0))
(close-sound ind))
(let* ((ind (open-sound "2.snd"))
(gen (make-snd->sample ind))
- (v0 (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (v0 (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (snd->sample gen (+ 1490 i) 0))
- (vct-set! v0 i (snd->sample gen (+ 1490 i) 1)))
+ (set! (v0 i) (snd->sample gen (+ 1490 i) 0))
+ (set! (v0 i) (snd->sample gen (+ 1490 i) 1)))
(print-and-check gen
"snd->sample"
"snd->sample reading 2.snd (2 chans) at 1499:[#<sampler: 2.snd[0: 0] from 1490, at 1500, forward>, #<sampler: 2.snd[1: 0] from 1490, at 1500, forward>]")
@@ -23030,19 +17634,21 @@ EDITS: 2
(if (not (= (mus-location gen) 1499)) (snd-display #__line__ ";snd->sample location (2): ~A" (mus-location gen)))
(close-sound ind))
- (let ((gen (make-file->frame "oboe.snd"))
- (v0 (make-vct 10)))
+ (let ((gen (make-file->frample "oboe.snd"))
+ (v0 (make-float-vector 10))
+ (g1 (float-vector 0.0)))
(print-and-check gen
- "file->frame"
- "file->frame oboe.snd")
+ "file->frample"
+ "file->frample oboe.snd"
+ "file->frample oboe.snd")
(if (not (mus-input? gen)) (snd-display #__line__ ";~A not input?" gen))
- (if (not (= (mus-length gen) 50828)) (snd-display #__line__ ";file->frame length: ~A?" (mus-length gen)))
- (if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display #__line__ ";file->frame mus-file-name: ~A" (mus-file-name gen)))
- (do ((i 0 (+ 1 i)))
+ (if (not (= (mus-length gen) 50828)) (snd-display #__line__ ";file->frample length: ~A?" (mus-length gen)))
+ (if (not (string=? (mus-file-name gen) "oboe.snd")) (snd-display #__line__ ";file->frample mus-file-name: ~A" (mus-file-name gen)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (frame-ref (file->frame gen (+ 1490 i)) 0)))
- (if (not (file->frame? gen)) (snd-display #__line__ ";~A not file->frame?" gen))
- (if (or (fneq (vct-ref v0 1) -0.009) (fneq (vct-ref v0 7) .029)) (snd-display #__line__ ";file->frame output: ~A" v0)))
+ (set! (v0 i) ((file->frample gen (+ 1490 i) g1) 0)))
+ (if (not (file->frample? gen)) (snd-display #__line__ ";~A not file->frample?" gen))
+ (if (or (fneq (v0 1) -0.009) (fneq (v0 7) .029)) (snd-display #__line__ ";file->frample output: ~A" v0)))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(if (file-exists? "fmv1.snd") (delete-file "fmv1.snd"))
@@ -23054,11 +17660,11 @@ EDITS: 2
"sample->file fmv.snd")
(if (not (mus-output? gen)) (snd-display #__line__ ";~A not output?" gen))
(if (not (sample->file? gen)) (snd-display #__line__ ";~A not sample->file?" gen))
- (if (not (= (mus-length gen) (mus-file-buffer-size))) (snd-display #__line__ ";sample->file length: ~A?" (mus-length gen)))
+ (if (not (= (mus-length gen) *clm-file-buffer-size*)) (snd-display #__line__ ";sample->file length: ~A?" (mus-length gen)))
(let ((genx gen))
(if (not (equal? genx gen)) (snd-display #__line__ ";sample->file equal? ~A ~A" genx gen)))
(if (not (string=? (mus-file-name gen) "fmv.snd")) (snd-display #__line__ ";sample->file mus-file-name: ~A" (mus-file-name gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(sample->file gen i 0 (* i .001))
(sample->file gen i 1 (* i .01)))
@@ -23089,36 +17695,36 @@ EDITS: 2
(if (or (fneq val6 .065) (fneq val7 .65)) (snd-display #__line__ ";outab: ~A ~A?" val6 val7))
(if (or (fneq val8 .075) (fneq val9 .75)) (snd-display #__line__ ";out-any: ~A ~A?" val8 val9)))
- (let ((gen (make-vct 10)))
- (do ((i 0 (+ 1 i))
+ (let ((gen (make-float-vector 10)))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x 0.1)))
((= i 10))
(outa i x gen))
- (if (not (vequal gen (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))
- (snd-display #__line__ ";outa->vct ramp: ~A" gen))
- (do ((i 0 (+ 1 i))
+ (if (not (vequal gen (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))
+ (snd-display #__line__ ";outa->float-vector ramp: ~A" gen))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x 0.1)))
((= i 10))
(outa i x gen))
- (if (not (vequal gen (vct-scale! (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9) 2.0)))
- (snd-display #__line__ ";outa->vct ramp 2: ~A" gen))
- (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";mus-channels vct: ~A" (mus-channels gen))))
+ (if (not (vequal gen (float-vector-scale! (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9) 2.0)))
+ (snd-display #__line__ ";outa->float-vector ramp 2: ~A" gen))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";mus-channels float-vector: ~A" (mus-channels gen))))
- (let ((gen (make-sound-data 4 100)))
- (do ((i 0 (+ 1 i)))
+ (let ((gen (make-float-vector (list 4 100) 0.0)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(outa i .1 gen)
(outb i .2 gen)
(outc i .3 gen)
(outd i .4 gen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(outa i .01 gen)
(outb i .02 gen)
(outc i .03 gen)
(outd i .04 gen))
(mus-close gen) ; should be a no-op
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(if (or (fneq (ina i gen) .11)
(fneq (inb i gen) .22)
@@ -23127,20 +17733,20 @@ EDITS: 2
(snd-display #__line__ ";4-chan sd out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen))))
(if (not (= (mus-channels gen) 4)) (snd-display #__line__ ";mus-channels sd 4: ~A" (mus-channels gen))))
- (let ((gen (make-sound-data 4 100)))
- (do ((i 0 (+ 1 i)))
+ (let ((gen (make-float-vector (list 4 100) 0.0)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(out-any i .1 0 gen)
(out-any i .2 1 gen)
(out-any i .3 2 gen)
(out-any i .4 3 gen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(out-any i .01 0 gen)
(out-any i .02 1 gen)
(out-any i .03 2 gen)
(out-any i .04 3 gen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(if (or (fneq (in-any i 0 gen) .11)
(fneq (in-any i 1 gen) .22)
@@ -23150,32 +17756,32 @@ EDITS: 2
(let ((gen (make-oscil 440.0)))
(let ((tag (catch #t (lambda () (outa 0 .1 gen)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";outa -> oscil: ~A" tag)))
- (let ((val (catch #t (lambda () (outa 0 .1 #f)) (lambda args (car args)))))
- (if (or (not (number? val)) (fneq val .1)) (snd-display #__line__ ";outa -> #f: ~A" val))))
+ (if (and (not (eq? tag 'wrong-type-arg))
+ (not (eq? tag 'mus-error)))
+ (snd-display #__line__ ";outa -> oscil: ~A" tag))))
(let ((gen (make-sample->file "fmv.snd" 4 mus-lshort mus-riff)))
(print-and-check gen
"sample->file"
"sample->file fmv.snd")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(outa i .1 gen)
(outb i .2 gen)
(outc i .3 gen)
(outd i .4 gen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(outa i .01 gen)
(outb i .02 gen)
(outc i .03 gen)
(outd i .04 gen))
(mus-close gen))
- (let* ((gen (make-file->sample "fmv.snd")))
+ (let ((gen (make-file->sample "fmv.snd")))
(print-and-check gen
"file->sample"
"file->sample fmv.snd")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(if (or (fneq (ina i gen) .11)
(fneq (inb i gen) .22)
@@ -23184,22 +17790,21 @@ EDITS: 2
(snd-display #__line__ ";4-chan out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen)))))
(let ((gen (make-sample->file "fmv.snd" 4 mus-lshort mus-riff)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(outa i .1 gen)
(outb i .2 gen)
(outc i .3 gen)
(outd i .4 gen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(outa i .01 gen)
(outb i .02 gen)
(outc i .03 gen)
- (outd i .04 gen)))
+ (outd i .04 gen))
(mus-close gen))
- (let* ((gen (make-file->sample "fmv.snd")))
- (do ((i 0 (+ 1 i)))
+ (let ((gen (make-file->sample "fmv.snd")))
+ (do ((i 0 (+ i 1)))
((= i 10))
(if (or (fneq (ina i gen) .11)
(fneq (inb i gen) .22)
@@ -23221,491 +17826,55 @@ EDITS: 2
(snd-display #__line__ ";make-sample->file bad type: ~A" var)))
(let ((v (vector 1.0 0.5 0.25 0.125 0.0))
- (v1 (make-vct 5 0.0)))
+ (v1 (make-float-vector 5 0.0)))
(do ((i 0 (+ i 1)))
((= i 5))
(set! (v1 i) (in-any i 0 v)))
- (if (not (vequal v1 (vct 1.0 0.5 0.25 0.125 0.0)))
+ (if (not (vequal v1 (float-vector 1.0 0.5 0.25 0.125 0.0)))
(snd-display #__line__ ";vector in-any -> ~A?" v1)))
- (let ((sum 0.0))
- (let ((result (with-sound (:output (make-vct 10))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (ina i (lambda (loc chn)
- (set! sum (+ sum (* loc 0.1)))
- sum)))))))
- (if (not (vequal result (vct 0.000 0.100 0.300 0.600 1.000 1.500 2.100 2.800 3.600 4.500)))
- (snd-display #__line__ ";ina function: ~A" result))))
-
- (let ((sum 0.0))
- (let ((result (with-sound (:output (make-vct 10))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (ina i (lambda (loc chn)
- (set! sum (+ sum (* loc 0.1)))
- sum))))))))
- (if (not (vequal result (vct 0.000 0.100 0.300 0.600 1.000 1.500 2.100 2.800 3.600 4.500)))
- (snd-display #__line__ ";run ina function: ~A" result))))
-
- (let ((invals (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (let ((invals (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! invals i (* i 0.1)))
- (let ((result (with-sound (:output (make-vct 10))
- (do ((i 0 (+ 1 i)))
+ (float-vector-set! invals i (* i 0.1)))
+ (let ((result (with-sound ((make-float-vector 10))
+ (do ((i 0 (+ i 1)))
((= i 10))
(outa i (ina i invals))))))
- (if (not (vequal result (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";ina from vct: ~A" result))))
+ (if (not (vequal result (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
+ (snd-display #__line__ ";ina from float-vector: ~A" result))))
- (let ((invals (make-vct 10)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! invals i (* i 0.1)))
- (let ((result (with-sound (:output (make-vct 10))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (ina i invals)))))))
- (if (not (vequal result (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run ina from vct: ~A" result))))
-
- (let ((old-buffer-size (mus-file-buffer-size))
- (old-clm-buffer-size *clm-file-buffer-size*))
- (set! (mus-file-buffer-size) 1024)
- (set! *clm-file-buffer-size* 1024)
-
- (let ((input (make-readin "oboe.snd" :start 1000)))
- (let ((result (with-sound (:output (make-vct 10))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (ina i (lambda (loc chn)
- (readin input))))))))
- (if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display #__line__ ";ina function readin: ~A" result)))
- (mus-close input))
-
- (let ((input (make-readin "oboe.snd" :start 1000)))
- (let ((result (with-sound (:output (make-vct 10))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (ina i (lambda (loc chn)
- (readin input)))))))))
- (if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display #__line__ ";run ina function readin: ~A" result)))
- (mus-close input))
-
- (let ((input (make-file->sample "oboe.snd")))
- (let ((result (with-sound (:output (make-vct 10))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (ina (+ i 1000) (lambda (loc chn)
- (in-any loc chn input))))))))
- (if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display #__line__ ";ina function in-any: ~A" result)))
- (mus-close input))
-
- (let ((input (make-file->sample "oboe.snd")))
- (let ((result (with-sound (:output (make-vct 10))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (ina (+ i 1000) (lambda (loc chn)
- (in-any loc chn input)))))))))
- (if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display #__line__ ";run ina function in-any: ~A" result)))
- (mus-close input))
-
- (set! *clm-file-buffer-size* old-clm-buffer-size)
- (set! (mus-file-buffer-size) old-buffer-size))
-
- (let ((invals (make-sound-data 2 10)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! invals 0 i (* i 0.1))
- (sound-data-set! invals 1 i (* i 0.2)))
- (let ((result (with-sound (:output (make-sound-data 2 10))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (inb i (lambda (loc chn)
- (sound-data-ref invals chn loc))))
- (outb i (ina i (lambda (loc chn)
- (sound-data-ref invals chn loc))))))))
- (if (not (vequal (sound-data->vct result 0) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";inb from sound-data function: ~A" (sound-data->vct result 0)))
- (if (not (vequal (sound-data->vct result 1) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";ina from sound-data function: ~A" (sound-data->vct result 1)))))
-
- (let ((invals (make-sound-data 2 10)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! invals 0 i (* i 0.1))
- (sound-data-set! invals 1 i (* i 0.2)))
- (let ((result (with-sound (:output (make-sound-data 2 10))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (inb i (lambda (loc chn)
- (sound-data-ref invals chn loc))))
- (outb i (ina i (lambda (loc chn)
- (sound-data-ref invals chn loc)))))))))
- (if (not (vequal (sound-data->vct result 0) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";run inb from sound-data function: ~A" (sound-data->vct result 0)))
- (if (not (vequal (sound-data->vct result 1) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run ina from sound-data function: ~A" (sound-data->vct result 1)))))
-
- (let ((invals (make-sound-data 2 10)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! invals 0 i (* i 0.1))
- (sound-data-set! invals 1 i (* i 0.2)))
- (let ((result (with-sound (:output (make-sound-data 2 10))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (in-any i 1 (lambda (loc chn)
- (in-any loc chn invals))))
- (outb i (in-any i 0 (lambda (loc chn)
- (in-any loc chn invals))))))))
- (if (not (vequal (sound-data->vct result 0) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";in-any 1 from sound-data function: ~A" (sound-data->vct result 0)))
- (if (not (vequal (sound-data->vct result 1) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";in-any 0 from sound-data function: ~A" (sound-data->vct result 1)))))
-
- (let ((invals (make-sound-data 2 10)))
- (do ((i 0 (+ 1 i)))
+ (let ((invals (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (sound-data-set! invals 0 i (* i 0.1))
- (sound-data-set! invals 1 i (* i 0.2)))
- (let ((result (with-sound (:output (make-sound-data 2 10))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (in-any i 1 (lambda (loc chn)
- (in-any loc chn invals))))
- (outb i (in-any i 0 (lambda (loc chn)
- (in-any loc chn invals)))))))))
- (if (not (vequal (sound-data->vct result 0) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";run in-any 1 from sound-data function: ~A" (sound-data->vct result 0)))
- (if (not (vequal (sound-data->vct result 1) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run in-any 0 from sound-data function: ~A" (sound-data->vct result 1)))))
-
- (let ((input (make-file->sample "oboe.snd")))
- (let ((result (with-sound (:output (make-vct 10))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (in-any (+ i 1000) 0 (lambda (loc chn)
- (in-any loc chn input))))))))
- (if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display #__line__ ";in-any file->sample in-any: ~A" result))))
-
- (let ((input (make-file->sample "oboe.snd")))
- (let ((result (with-sound (:output (make-vct 10))
- (run
- (do ((i 0 (+ 1 i)))
+ (float-vector-set! invals i (* i 0.1)))
+ (let ((result (with-sound ((make-float-vector 10))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (outa i (in-any (+ i 1000) 0 (lambda (loc chn)
- (in-any loc chn input)))))))))
- (if (not (vequal result (vct 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004)))
- (snd-display #__line__ ";run in-any file->sample in-any: ~A" result))))
-
-
- (let ((avg 0.0)
- (samps 0))
- (with-sound (:output (lambda (frame val chan)
- (set! avg (+ avg val))
- (set! samps (+ 1 samps))
- val))
- (do ((i 0 (+ 1 i)))
- ((> i 10))
- (outa i (* i .1))))
- (let ((result (/ avg samps)))
- (if (fneq result 0.5)
- (snd-display #__line__ ";output as avg: ~A" result))))
-
- (let ((avg 0.0)
- (samps 0))
- (with-sound (:output (lambda (frame val chan)
- (declare (frame integer) (val real) (chan integer))
- (set! avg (+ avg val))
- (set! samps (+ 1 samps))
- val))
- (run
- (do ((i 0 (+ 1 i)))
- ((> i 10))
- (outa i (* i .1)))))
- (let ((result (/ avg samps)))
- (if (fneq result 0.5)
- (snd-display #__line__ ";run output as avg: ~A" result))))
-
- (let ((outv (make-vct 10)))
- (with-sound ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1) (lambda (loc val chan)
- (vct-set! outv loc val)))))
- (if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";outa func vct: ~A" outv)))
-
- (let ((outv (make-vct 10)))
- (with-sound ()
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1) (lambda (loc val chan)
- (vct-set! outv loc val))))))
- (if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run outa func vct: ~A" outv)))
-
- (let ((outv (make-sound-data 4 10)))
- (with-sound (:channels 4)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outb i (* i .2) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outc i (* i .3) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outd i (* i .4) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))))
- (if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";outa 1 to sound-data function: ~A" (sound-data->vct outv 0)))
- (if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";outb 1 to sound-data function: ~A" (sound-data->vct outv 1)))
- (if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display #__line__ ";outc 1 to sound-data function: ~A" (sound-data->vct outv 2)))
- (if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display #__line__ ";outd 1 to sound-data function: ~A" (sound-data->vct outv 3))))
-
- (let ((outv (make-sound-data 4 10)))
- (with-sound (:channels 4)
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outb i (* i .2) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outc i (* i .3) (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (outd i (* i .4) (lambda (loc val chan)
- (sound-data-set! outv chan loc val))))))
- (if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run outa 1 to sound-data function: ~A" (sound-data->vct outv 0)))
- (if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";run outb 1 to sound-data function: ~A" (sound-data->vct outv 1)))
- (if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display #__line__ ";run outc 1 to sound-data function: ~A" (sound-data->vct outv 2)))
- (if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display #__line__ ";run outd 1 to sound-data function: ~A" (sound-data->vct outv 3))))
-
- (let ((outv (make-vct 10)))
- (with-sound ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (out-any i (* i .1) 0 (lambda (loc val chan)
- (vct-set! outv loc val)))))
- (if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";out-any func to vct: ~A" outv)))
-
- (let ((outv (make-vct 10)))
- (with-sound ()
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (out-any i (* i .1) 0 (lambda (loc val chan)
- (vct-set! outv loc val))))))
- (if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run out-any func to vct: ~A" outv)))
-
- (let ((outv (make-sound-data 4 10)))
- (with-sound (:channels 4)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (do ((k 0 (+ 1 k)))
- ((= k 4))
- (out-any i (* i .1 (+ 1 k)) k (lambda (loc val chan)
- (sound-data-set! outv chan loc val))))))
- (if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";out-any 0 to sound-data function: ~A" (sound-data->vct outv 0)))
- (if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";out-any 1 to sound-data function: ~A" (sound-data->vct outv 1)))
- (if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display #__line__ ";out-any 2 to sound-data function: ~A" (sound-data->vct outv 2)))
- (if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display #__line__ ";out-any 3 to sound-data function: ~A" (sound-data->vct outv 3))))
-
- (let ((outv (make-sound-data 4 10)))
- (with-sound (:channels 4)
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (do ((k 0 (+ 1 k)))
- ((= k 4))
- (out-any i (* i .1 (+ 1 k)) k (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))))))
- (if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run out-any 0 to sound-data function: ~A" (sound-data->vct outv 0)))
- (if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";run out-any 1 to sound-data function: ~A" (sound-data->vct outv 1)))
- (if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display #__line__ ";run out-any 2 to sound-data function: ~A" (sound-data->vct outv 2)))
- (if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display #__line__ ";run out-any 3 to sound-data function: ~A" (sound-data->vct outv 3))))
-
- (let ((outv (make-vct 10)))
- (with-sound (:output (lambda (loc val chan)
- (vct-set! outv loc val)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1))))
- (if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";outa output func to vct: ~A" outv)))
-
- (let ((outv (make-vct 10)))
- (with-sound (:output (lambda (loc val chan)
- (declare (loc integer) (val real) (chan integer))
- (vct-set! outv loc val)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1)))))
- (if (not (vequal outv (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run outa output func to vct: ~A" outv)))
-
- (let ((outv (make-sound-data 4 10)))
- (with-sound (:channels 4 :output (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1))
- (outb i (* i .2))
- (outc i (* i .3))
- (outd i (* i .4))))
- (if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";outa output to sound-data function: ~A" (sound-data->vct outv 0)))
- (if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";outb output to sound-data function: ~A" (sound-data->vct outv 1)))
- (if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display #__line__ ";outc output to sound-data function: ~A" (sound-data->vct outv 2)))
- (if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display #__line__ ";outd output to sound-data function: ~A" (sound-data->vct outv 3))))
-
- (let ((outv (make-sound-data 4 10)))
- (with-sound (:channels 4 :output (lambda (loc val chan)
- (declare (loc integer) (val real) (chan integer))
- (sound-data-set! outv chan loc val)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1))
- (outb i (* i .2))
- (outc i (* i .3))
- (outd i (* i .4)))))
- (if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run outa output to sound-data function: ~A" (sound-data->vct outv 0)))
- (if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";run outb output to sound-data function: ~A" (sound-data->vct outv 1)))
- (if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display #__line__ ";run outc output to sound-data function: ~A" (sound-data->vct outv 2)))
- (if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display #__line__ ";run outd output to sound-data function: ~A" (sound-data->vct outv 3))))
-
- (let ((outv (make-sound-data 4 10)))
- (with-sound (:channels 4 :output (lambda (loc val chan)
- (sound-data-set! outv chan loc val)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (do ((k 0 (+ 1 k)))
- ((= k 4))
- (out-any i (* i .1 (+ 1 k)) k))))
- (if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";out-any 0 output to sound-data function: ~A" (sound-data->vct outv 0)))
- (if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";out-any 1 output to sound-data function: ~A" (sound-data->vct outv 1)))
- (if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display #__line__ ";out-any 2 output to sound-data function: ~A" (sound-data->vct outv 2)))
- (if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display #__line__ ";out-any 3 output to sound-data function: ~A" (sound-data->vct outv 3))))
-
- (let ((outv (make-sound-data 4 10)))
- (with-sound (:channels 4 :output (lambda (loc val chan)
- (declare (loc integer) (val real) (chan integer))
- (sound-data-set! outv chan loc val)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (do ((k 0 (+ 1 k)))
- ((= k 4))
- (out-any i (* i .1 (+ 1 k)) k)))))
- (if (not (vequal (sound-data->vct outv 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
- (snd-display #__line__ ";run out-any 0 output to sound-data function: ~A" (sound-data->vct outv 0)))
- (if (not (vequal (sound-data->vct outv 1) (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800)))
- (snd-display #__line__ ";run out-any 1 output to sound-data function: ~A" (sound-data->vct outv 1)))
- (if (not (vequal (sound-data->vct outv 2) (vct 0.000 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700)))
- (snd-display #__line__ ";run out-any 2 output to sound-data function: ~A" (sound-data->vct outv 2)))
- (if (not (vequal (sound-data->vct outv 3) (vct 0.000 0.400 0.800 1.200 1.600 2.000 2.400 2.800 3.200 3.600)))
- (snd-display #__line__ ";run out-any 3 output to sound-data function: ~A" (sound-data->vct outv 3))))
+ (outa i (ina i invals))))))
+ (if (not (vequal result (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900)))
+ (snd-display #__line__ ";run ina from float-vector: ~A" result))))
(for-each close-sound (sounds))
- (let ((vals (with-sound (:output (make-vct 4410))
+ (let ((vals (with-sound ((make-float-vector 4410))
(fm-violin 0 .1 440 .1))))
- (if (fneq (vct-peak vals) .1)
- (snd-display #__line__ ";locsig to vct fm-violin peak: ~A" (vct-peak vals))))
+ (if (fneq (float-vector-peak vals) .1)
+ (snd-display #__line__ ";locsig to float-vector fm-violin peak: ~A" (float-vector-peak vals))))
- (let ((vals (with-sound (:output (make-sound-data 2 4410))
+ (let ((vals (with-sound ((make-float-vector (list 2 4410) 0.0))
(fm-violin 0 .1 440 .1 :degree 30))))
- (let ((mxs (sound-data-maxamp vals)))
- (if (or (fneq (car mxs) 0.0666)
- (fneq (cadr mxs) 0.0333))
+ (let ((mxs (maxamp vals)))
+ (if (fneq mxs 0.0666)
(snd-display #__line__ ";locsig to sound-data fm-violin peak: ~A" mxs))))
-
- (let ((data (make-vct 4410)))
- (with-sound (:output (lambda (loc val chan)
- (vct-set! data loc val)))
- (fm-violin 0 .1 440 .1))
- (if (fneq (vct-peak data) .1)
- (snd-display #__line__ ";locsig to func fm-violin peak: ~A" (vct-peak data))))
-
-
- (let ((gen (make-frame->file "fmv1.snd" 2 mus-bshort mus-next)))
- (print-and-check gen
- "frame->file"
- "frame->file fmv1.snd")
- (if (not (mus-output? gen)) (snd-display #__line__ ";~A not output?" gen))
- (if (not (frame->file? gen)) (snd-display #__line__ ";~A not frame->file?" gen))
- (if (not (= (mus-length gen) (mus-file-buffer-size))) (snd-display #__line__ ";frame->file length: ~A?" (mus-length gen)))
- (if (not (string=? (mus-file-name gen) "fmv1.snd")) (snd-display #__line__ ";frame->file mus-file-name: ~A" (mus-file-name gen)))
- (set! (mus-length gen) 4096)
- (if (not (= (mus-length gen) 4096)) (snd-display #__line__ ";frame->file length (1): ~A?" (mus-length gen)))
- (set! (mus-length gen) 8192)
- (let ((fr0 (make-frame 2 0.0 0.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (frame-set! fr0 0 (* i .001))
- (frame-set! fr0 1 (* i .01))
- (frame->file gen i fr0)))
- (mus-close gen))
- (let* ((gen (make-file->frame "fmv1.snd" 1024))
- (val4 (file->frame gen 40))
- (frout (make-frame 2)))
- (if (or (fneq (frame-ref val4 0) .04) (fneq (frame-ref val4 1) .4))
- (snd-display #__line__ ";frame->file output: ~A?" val4))
- (file->frame gen 40 frout)
- (if (not (equal? frout val4))
- (snd-display #__line__ ";frame->file output via frame: ~A ~A?" frout val4)))
-
+
(let ((gen (make-sample->file "fmv2.snd" 4 mus-bshort mus-aifc)))
(print-and-check gen
"sample->file"
"sample->file fmv2.snd")
(if (not (mus-output? gen)) (snd-display #__line__ ";~A not output?" gen))
(if (not (sample->file? gen)) (snd-display #__line__ ";~A not sample->file?" gen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(sample->file gen i 0 (* i .001))
(sample->file gen i 1 (* i .01))
@@ -23736,26 +17905,26 @@ EDITS: 2
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(mus-sound-forget "fmv.snd")
(let ((sf (make-sample->file "fmv.snd" 2 mus-bshort mus-next "this is a comment")))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(sample->file sf i 0 (* i .1))
(sample->file sf i 1 (* i .01)))
(mus-close sf)
(if (not (= (mus-sound-chans "fmv.snd") 2))
(snd-display #__line__ ";sample->file chans: ~A" (mus-sound-chans "fmv.snd")))
- (if (not (= (mus-sound-frames "fmv.snd") 10))
- (snd-display #__line__ ";sample->file frames: ~A" (mus-sound-frames "fmv.snd")))
+ (if (not (= (mus-sound-framples "fmv.snd") 10))
+ (snd-display #__line__ ";sample->file framples: ~A" (mus-sound-framples "fmv.snd")))
(if (not (= (mus-sound-samples "fmv.snd") 20))
(snd-display #__line__ ";sample->file samples: ~A" (mus-sound-samples "fmv.snd")))
(if (not (= (mus-sound-header-type "fmv.snd") mus-next))
(snd-display #__line__ ";sample->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-bshort))
- (snd-display #__line__ ";sample->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-bshort))
+ (snd-display #__line__ ";sample->file format: ~A" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
(snd-display #__line__ ";sample->file comment: ~A" (mus-sound-comment "fmv.snd")))
(let ((rd (make-file->sample "fmv.snd"))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 10)))
(let ((c0 (file->sample rd i 0))
(c1 (file->sample rd i 1)))
@@ -23766,7 +17935,7 @@ EDITS: 2
(set! happy #f)))))
(mus-close rd))
(set! sf (continue-sample->file "fmv.snd"))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(sample->file sf (+ i 5) 0 (* i -.02))
(sample->file sf (+ i 5) 1 (* i -.01)))
@@ -23774,97 +17943,112 @@ EDITS: 2
(mus-sound-forget "fmv.snd")
(if (not (= (mus-sound-chans "fmv.snd") 2))
(snd-display #__line__ ";continue-sample->file chans: ~A" (mus-sound-chans "fmv.snd")))
- (if (not (= (mus-sound-frames "fmv.snd") 15))
- (snd-display #__line__ ";continue-sample->file frames: ~A" (mus-sound-frames "fmv.snd")))
+ (if (not (= (mus-sound-framples "fmv.snd") 15))
+ (snd-display #__line__ ";continue-sample->file framples: ~A" (mus-sound-framples "fmv.snd")))
(if (not (= (mus-sound-samples "fmv.snd") 30))
(snd-display #__line__ ";continue-sample->file samples: ~A" (mus-sound-samples "fmv.snd")))
(if (not (= (mus-sound-header-type "fmv.snd") mus-next))
(snd-display #__line__ ";continue-sample->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-bshort))
- (snd-display #__line__ ";continue-sample->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-bshort))
+ (snd-display #__line__ ";continue-sample->file format: ~A" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
(snd-display #__line__ ";continue-sample->file comment: ~A" (mus-sound-comment "fmv.snd")))
(let ((ind (open-sound "fmv.snd")))
- (let ((c0 (channel->vct 0 15 ind 0))
- (c1 (channel->vct 0 15 ind 1)))
- (if (not (vequal c0 (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
+ (let ((c0 (channel->float-vector 0 15 ind 0))
+ (c1 (channel->float-vector 0 15 ind 1)))
+ (if (not (vequal c0 (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
(snd-display #__line__ ";continue-sample->file (0): ~A" c0))
- (if (not (vequal c1 (vct 0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
+ (if (not (vequal c1 (float-vector 0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
(snd-display #__line__ ";continue-sample->file (1): ~A" c1)))
(close-sound ind))
(delete-file "fmv.snd")
(mus-sound-forget "fmv.snd"))
- (let ((sf (make-frame->file "fmv.snd" 2 mus-lfloat mus-riff "this is a comment")))
- (do ((i 0 (+ 1 i)))
+ (let ((f1 (float-vector 1.0 1.0))
+ (f2 (float-vector 0.0 0.0))
+ (m1 (float-vector .5 .25 .125 1.0)))
+ (let ((result (frample->frample m1 f1 2 f2 2)))
+ (if (not (equal? result (float-vector 0.625 1.25)))
+ (snd-display #__line__ ";frample->frample: ~A" result))))
+
+ (let ((f1 (float-vector 1.0 2.0 3.0))
+ (f2 (float-vector 0.0 0.0 0.0))
+ (m1 (float-vector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0)))
+ (let ((result (frample->frample m1 f1 3 f2 3)))
+ (if (not (equal? result (float-vector 30.0 36.0 42.0)))
+ (snd-display #__line__ ";frample->frample 1: ~A" result))))
+
+ (let ((sf (make-frample->file "fmv.snd" 2 mus-lfloat mus-riff "this is a comment")))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (frame->file sf i (make-frame 2 (* i .1) (* i .01))))
+ (frample->file sf i (float-vector (* i .1) (* i .01))))
(mus-close sf)
(if (not (= (mus-sound-chans "fmv.snd") 2))
- (snd-display #__line__ ";frame->file chans: ~A" (mus-sound-chans "fmv.snd")))
- (if (not (= (mus-sound-frames "fmv.snd") 10))
- (snd-display #__line__ ";frame->file frames: ~A" (mus-sound-frames "fmv.snd")))
+ (snd-display #__line__ ";frample->file chans: ~A" (mus-sound-chans "fmv.snd")))
+ (if (not (= (mus-sound-framples "fmv.snd") 10))
+ (snd-display #__line__ ";frample->file framples: ~A" (mus-sound-framples "fmv.snd")))
(if (not (= (mus-sound-samples "fmv.snd") 20))
- (snd-display #__line__ ";frame->file samples: ~A" (mus-sound-samples "fmv.snd")))
+ (snd-display #__line__ ";frample->file samples: ~A" (mus-sound-samples "fmv.snd")))
(if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display #__line__ ";frame->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-lfloat))
- (snd-display #__line__ ";frame->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";frample->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-lfloat))
+ (snd-display #__line__ ";frample->file format: ~A" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display #__line__ ";frame->file comment: ~A" (mus-sound-comment "fmv.snd")))
- (let ((rd (make-file->frame "fmv.snd"))
+ (snd-display #__line__ ";frample->file comment: ~A" (mus-sound-comment "fmv.snd")))
+ (let ((rd (make-file->frample "fmv.snd"))
+ (f0 (float-vector 0.0 0.0))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 10)))
- (let ((f0 (file->frame rd i)))
- (if (or (not (= (mus-length f0) 2))
- (fneq (frame-ref f0 0) (* i .1))
- (fneq (frame-ref f0 1) (* i .01)))
- (begin
- (snd-display #__line__ ";frame->file->frame at ~A: ~A" i f0)
- (set! happy #f)))))
+ (file->frample rd i f0)
+ (if (or (not (= (mus-length f0) 2))
+ (fneq (f0 0) (* i .1))
+ (fneq (f0 1) (* i .01)))
+ (begin
+ (snd-display #__line__ ";frample->file->frample at ~A: ~A" i f0)
+ (set! happy #f))))
(mus-close rd))
- (set! sf (continue-frame->file "fmv.snd"))
- (do ((i 0 (+ 1 i)))
+ (set! sf (continue-frample->file "fmv.snd"))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (frame->file sf (+ i 5) (make-frame 2 (* i -.02) (* i -.01))))
+ (frample->file sf (+ i 5) (float-vector (* i -.02) (* i -.01))))
(mus-close sf)
(mus-sound-forget "fmv.snd")
(if (not (= (mus-sound-chans "fmv.snd") 2))
- (snd-display #__line__ ";continue-frame->file chans: ~A" (mus-sound-chans "fmv.snd")))
- (if (not (= (mus-sound-frames "fmv.snd") 15))
- (snd-display #__line__ ";continue-frame->file frames: ~A" (mus-sound-frames "fmv.snd")))
+ (snd-display #__line__ ";continue-frample->file chans: ~A" (mus-sound-chans "fmv.snd")))
+ (if (not (= (mus-sound-framples "fmv.snd") 15))
+ (snd-display #__line__ ";continue-frample->file framples: ~A" (mus-sound-framples "fmv.snd")))
(if (not (= (mus-sound-samples "fmv.snd") 30))
- (snd-display #__line__ ";continue-frame->file samples: ~A" (mus-sound-samples "fmv.snd")))
+ (snd-display #__line__ ";continue-frample->file samples: ~A" (mus-sound-samples "fmv.snd")))
(if (not (= (mus-sound-header-type "fmv.snd") mus-riff))
- (snd-display #__line__ ";continue-frame->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
- (if (not (= (mus-sound-data-format "fmv.snd") mus-lfloat))
- (snd-display #__line__ ";continue-frame->file format: ~A" (mus-data-format-name (mus-sound-data-format "fmv.snd"))))
+ (snd-display #__line__ ";continue-frample->file type: ~A" (mus-header-type-name (mus-sound-header-type "fmv.snd"))))
+ (if (not (= (mus-sound-sample-type "fmv.snd") mus-lfloat))
+ (snd-display #__line__ ";continue-frample->file format: ~A" (mus-sample-type-name (mus-sound-sample-type "fmv.snd"))))
(if (not (string=? (mus-sound-comment "fmv.snd") "this is a comment"))
- (snd-display #__line__ ";continue-frame->file comment: ~A" (mus-sound-comment "fmv.snd")))
+ (snd-display #__line__ ";continue-frample->file comment: ~A" (mus-sound-comment "fmv.snd")))
(let ((ind (open-sound "fmv.snd")))
- (let ((c0 (channel->vct 0 15 ind 0))
- (c1 (channel->vct 0 15 ind 1)))
- (if (not (vequal c0 (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
- (snd-display #__line__ ";continue-frame->file (0): ~A" c0))
- (if (not (vequal c1 (vct 0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
- (snd-display #__line__ ";continue-frame->file (1): ~A" c1)))
+ (let ((c0 (channel->float-vector 0 15 ind 0))
+ (c1 (channel->float-vector 0 15 ind 1)))
+ (if (not (vequal c0 (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.58 0.66 0.74 0.82 -0.1 -0.12 -0.14 -0.16 -0.18)))
+ (snd-display #__line__ ";continue-frample->file (0): ~A" c0))
+ (if (not (vequal c1 (float-vector 0.0 0.01 0.02 0.03 0.04 0.05 0.05 0.05 0.05 0.05 -0.05 -0.06 -0.07 -0.08 -0.09)))
+ (snd-display #__line__ ";continue-frample->file (1): ~A" c1)))
(close-sound ind))
(delete-file "fmv.snd")
(mus-sound-forget "fmv.snd"))
- (let ((v0 (make-vct 1000))
+ (let ((v0 (make-float-vector 1000))
(os (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (vct-set! v0 i (* .1 (oscil os))))
+ (set! (v0 i) (* .1 (oscil os))))
(array->file "fmv3.snd" v0 10000 22050 1) ; 10000 deliberate
- (let ((v1 (make-vct 1000)))
+ (let ((v1 (make-float-vector 1000)))
(file->array "fmv3.snd" 0 0 1000 v1)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (if (fneq (vct-ref v0 i) (vct-ref v1 i))
- (snd-display #__line__ ";array->file->array: ~A ~A ~A?" i (vct-ref v0 i) (vct-ref v1 i)))))
+ (if (fneq (v0 i) (v1 i))
+ (snd-display #__line__ ";array->file->array: ~A ~A ~A?" i (v0 i) (v1 i)))))
(let ((var (catch #t (lambda () (array->file "fmv3.snd" v0 -1 1000 1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
@@ -23877,33 +18061,33 @@ EDITS: 2
(snd-display #__line__ ";file->array bad samps: ~A" var))))
(let ((gen (make-rand 10000.0))
- (v0 (make-vct 10)))
+ (v0 (make-float-vector 10)))
(print-and-check gen
"rand"
"rand freq: 10000.000Hz, phase: 0.000, amp: 1.000")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (rand gen 0.0)))
+ (set! (v0 i) (rand gen)))
(if (not (rand? gen)) (snd-display #__line__ ";~A not rand?" gen))
(if (fneq (mus-phase gen) 3.3624296) (snd-display #__line__ ";rand phase: ~F?" (mus-phase gen)))
(if (fneq (mus-frequency gen) 10000.0) (snd-display #__line__ ";rand frequency: ~F?" (mus-frequency gen)))
(set! (mus-scaler gen) 0.5)
(if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! mus-scaler rand: ~A" (mus-scaler gen)))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";rand output: ~A" v0)))
+ (if (= (v0 1) (v0 8)) (snd-display #__line__ ";rand output: ~A" v0)))
(let ((gen (make-rand 10000.0 :envelope '(0 0 1 1)))
- (v0 (make-vct 10)))
+ (v0 (make-float-vector 10)))
(print-and-check gen
"rand"
"rand freq: 10000.000Hz, phase: 0.000, amp: 1.000, with distribution envelope")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (rand gen 0.0)))
+ (set! (v0 i) (rand gen)))
(if (not (rand? gen)) (snd-display #__line__ ";(dist) ~A not rand?" gen))
(if (fneq (mus-frequency gen) 10000.0) (snd-display #__line__ ";(dist) rand frequency: ~F?" (mus-frequency gen)))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";(dist) rand output: ~A" v0))
- (if (or (not (vct? (mus-data gen)))
- (not (= (mus-length gen) (vct-length (mus-data gen))))
+ (if (= (v0 1) (v0 8)) (snd-display #__line__ ";(dist) rand output: ~A" v0))
+ (if (or (not (float-vector? (mus-data gen)))
+ (not (= (mus-length gen) (length (mus-data gen))))
(not (= (mus-length gen) 512)))
(snd-display #__line__ ";(dist) rand data: ~A ~A" (mus-length gen) (mus-data gen))))
@@ -23915,7 +18099,7 @@ EDITS: 2
(up2 0)
(down2 0)
(bad2 0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(let ((val1 (rand gen1))
(val2 (rand gen2)))
@@ -23938,42 +18122,49 @@ EDITS: 2
; (test-gen-equal (make-rand 1000) (make-rand 1000) (make-rand 500))
; (test-gen-equal (make-rand 1000) (make-rand 1000) (make-rand 1000 0.5))
+ (let ((gen (make-rand-interp 100.0 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (let ((val (rand-interp gen)))
+ (if (not (zero? val))
+ (snd-display #__line__ ";rand-interp 0 amp: ~A" val)))))
+
(let ((gen (make-rand-interp 4000.0))
- (v0 (make-vct 10)))
+ (v0 (make-float-vector 10)))
(print-and-check gen
"rand-interp"
(mus-describe gen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (rand-interp gen 0.0)))
+ (set! (v0 i) (rand-interp gen 0.0)))
(if (not (rand-interp? gen)) (snd-display #__line__ ";~A not rand-interp?" gen))
(if (fneq (mus-phase gen) 5.114882) (snd-display #__line__ ";rand-interp phase: ~F?" (mus-phase gen)))
(if (fneq (mus-frequency gen) 4000.0) (snd-display #__line__ ";rand-interp frequency: ~F?" (mus-frequency gen)))
(set! (mus-scaler gen) 0.5)
(if (fneq (mus-scaler gen) 0.5) (snd-display #__line__ ";set! mus-scaler rand-interp: ~A" (mus-scaler gen)))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";rand-interp output: ~A" v0)))
+ (if (= (v0 1) (v0 8)) (snd-display #__line__ ";rand-interp output: ~A" v0)))
(let ((gen (make-rand-interp 4000.0 :envelope '(-1 1 0 0 1 1)))
- (v0 (make-vct 10)))
+ (v0 (make-float-vector 10)))
(print-and-check gen
"rand-interp"
(mus-describe gen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (rand-interp gen 0.0)))
+ (set! (v0 i) (rand-interp gen 0.0)))
(if (not (rand-interp? gen)) (snd-display #__line__ ";(dist) ~A not rand-interp?" gen))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";(dist) rand-interp output: ~A" v0))
- (if (or (not (vct? (mus-data gen)))
- (not (= (mus-length gen) (vct-length (mus-data gen))))
+ (if (= (v0 1) (v0 8)) (snd-display #__line__ ";(dist) rand-interp output: ~A" v0))
+ (if (or (not (float-vector? (mus-data gen)))
+ (not (= (mus-length gen) (length (mus-data gen))))
(not (= (mus-length gen) 512)))
(snd-display #__line__ ";(dist) rand-interp data: ~A ~A" (mus-length gen) (mus-data gen))))
(let ((gen (make-rand 10000.0 1.0))
(gen1 (make-rand-interp 10000.0 1.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (let* ((val1 (gen 0.0))
- (val2 (gen1 0.0)))
+ (let ((val1 (gen 0.0))
+ (val2 (gen1 0.0)))
(if (or (> val1 1.0)
(< val1 -1.0))
(snd-display #__line__ ";rand: ~A ~A" val1 gen))
@@ -23982,18 +18173,18 @@ EDITS: 2
(snd-display #__line__ ";rand-interp: ~A ~A" val2 gen1)))))
(let ((gen (make-rand 10000.0 :distribution (inverse-integrate '(0 0 1 1))))
- (v0 (make-vct 10)))
+ (v0 (make-float-vector 10)))
(print-and-check gen
"rand"
"rand freq: 10000.000Hz, phase: 0.000, amp: 1.000, with distribution envelope")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (rand gen 0.0)))
+ (set! (v0 i) (rand gen)))
(if (not (rand? gen)) (snd-display #__line__ ";(dist 2) ~A not rand?" gen))
(if (fneq (mus-frequency gen) 10000.0) (snd-display #__line__ ";(dist 2) rand frequency: ~F?" (mus-frequency gen)))
- (if (= (vct-ref v0 1) (vct-ref v0 8)) (snd-display #__line__ ";(dist 2) rand output: ~A" v0))
- (if (or (not (vct? (mus-data gen)))
- (not (= (mus-length gen) (vct-length (mus-data gen))))
+ (if (= (v0 1) (v0 8)) (snd-display #__line__ ";(dist 2) rand output: ~A" v0))
+ (if (or (not (float-vector? (mus-data gen)))
+ (not (= (mus-length gen) (length (mus-data gen))))
(not (= (mus-length gen) 512)))
(snd-display #__line__ ";(dist 2) rand data: ~A ~A" (mus-length gen) (mus-data gen))))
@@ -24005,7 +18196,7 @@ EDITS: 2
(up2 0)
(down2 0)
(bad2 0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(let ((val1 (rand gen1))
(val2 (rand gen2)))
@@ -24028,12 +18219,12 @@ EDITS: 2
(let ((ind (new-sound :size 100)))
(select-sound ind)
(map-channel (lambda (y) (any-random 1.0 '(0 1 1 1))))
- (let ((place (scan-channel (lambda (y) (or (< y 0.0) (> y 1.0))))))
+ (let ((place (scan-channel (lambda (y) (not (<= 0.0 y 1.0)))))) ; (or (< y 0.0) (> y 1.0))))))
(if place (snd-display #__line__ ";any-random 0 to 1: ~A" place)))
(if (< (maxamp) .5) (snd-display #__line__ ";any-random maxamp: ~A" (maxamp))) ; possible, but extremely unlikely
(let ((avg 0.0))
(scan-channel (lambda (y) (set! avg (+ avg y)) #f))
- (if (> (abs (- (/ avg (frames)) .5)) .2) (snd-display #__line__ ";any-random skewed?")))
+ (if (> (abs (- (/ avg (framples)) .5)) .2) (snd-display #__line__ ";any-random skewed?")))
(let ((g (gaussian-distribution 1.0)))
(map-channel (lambda (y) (any-random 1.0 g))))
(let ((g (pareto-distribution 1.0)))
@@ -24043,24 +18234,24 @@ EDITS: 2
(if (file-exists? new-file-name) (delete-file new-file-name))))
(let ((v1 (inverse-integrate '(-1 1 1 1))))
- (if (fneq (vct-ref v1 4) -0.984)
+ (if (fneq (v1 4) -0.984)
(snd-display #__line__ ";inverse-integrate -1 to 1 uniform: ~A" v1)))
(let ((v1 (inverse-integrate '(0 1 1 1))))
- (if (fneq (vct-ref v1 4) .008)
+ (if (fneq (v1 4) .008)
(snd-display #__line__ ";inverse-integrate 0 to 1 uniform: ~A" v1)))
(let ((v1 (inverse-integrate '(0 1 1 0))))
- (if (fneq (vct-ref v1 4) .004)
+ (if (fneq (v1 4) .004)
(snd-display #__line__ ";inverse-integrate 0 to 1 1 to 0: ~A" v1)))
(let ((v1 (inverse-integrate '(0 0 .5 1 1 0))))
- (if (fneq (vct-ref v1 4) .073)
+ (if (fneq (v1 4) .073)
(snd-display #__line__ ";inverse-integrate triangle: ~A" v1)))
(let ((v1 (inverse-integrate (gaussian-envelope 1.0))))
- (if (fneq (vct-ref v1 4) -0.593)
+ (if (fneq (v1 4) -0.593)
(snd-display #__line__ ";inverse-integrate gaussian: ~A" v1)))
(let ((minp 1.0)
(maxp -1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1100))
(let ((val1 (mus-random 1.0)))
(if (< val1 minp) (set! minp val1))
@@ -24073,7 +18264,7 @@ EDITS: 2
(snd-display #__line__ ";mus-random: ~A ~A" minp maxp))
(set! minp 12.0)
(set! maxp -12.0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1100))
(let ((val1 (mus-random 12.0)))
(if (< val1 minp) (set! minp val1))
@@ -24090,32 +18281,32 @@ EDITS: 2
(do ((i 0 (+ 1 i )))
((= i n))
(let ((y (floor (+ 5 (mus-random 5.0)))))
- (vector-set! hits y (+ 1 (vector-ref hits y)))))
+ (set! (hits y) (+ 1 (vector-ref hits y)))))
(let ((sum 0.0)
(p (/ n 10.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10) sum)
(let ((num (- (vector-ref hits i) p)))
(set! sum (+ sum (/ (* num num) p))))))))))
;;:(v 10000)
;;#(999 1017 1002 1024 1048 971 963 1000 980 996) 5.8
- ;; if less than 4 complain
+ ;; if less than 3 complain
(let ((vr (v 10000)))
- (if (< vr 4.0)
+ (if (< vr 3.0)
(snd-display #__line__ ";mus-random not so random? ~A (chi)" vr))))
(let ((v1 (lambda (n)
(let ((hits (make-vector 10 0))
- (gen (make-rand 22050.0)))
+ (gen (make-rand 22050.0 5)))
(do ((i 0 (+ 1 i )))
((= i n))
- (let ((y (floor (+ 5 (* 5 (rand gen 0.0))))))
- (vector-set! hits y (+ 1 (vector-ref hits y)))))
+ (let ((y (floor (+ 5 (rand gen)))))
+ (set! (hits y) (+ 1 (vector-ref hits y)))))
(let ((sum 0.0)
(p (/ n 10.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10) sum)
(let ((num (- (vector-ref hits i) p)))
(set! sum (+ sum (/ (* num num) p))))))))))
@@ -24124,35 +18315,36 @@ EDITS: 2
;;#(979 1015 977 1008 954 1049 997 1020 1015 986) 6.606
(let ((vr (v1 10000)))
- (if (< vr 4.0)
+ (if (< vr 3.5)
(snd-display #__line__ ";rand not so random? ~A (chi)" vr))))
- (let ((data (make-vct 65536)))
- (do ((i 0 (+ 1 i)))
+ (let ((data (make-float-vector 65536)))
+ (do ((i 0 (+ i 1)))
((= i 65536))
- (vct-set! data i (mus-random 1.0)))
+ (set! (data i) (mus-random 1.0)))
(let* ((ndat (snd-spectrum data rectangular-window 65536 #t 0.0 #f #f))
- (peak (vct-peak ndat))
+ (peak (float-vector-peak ndat))
(sum 0.0))
(if (> peak 1000.0)
(snd-display #__line__ ";mus-random spectral peak: ~A" peak))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 32768))
- (set! sum (+ sum (vct-ref ndat i))))
+ (set! sum (+ sum (float-vector-ref ndat i))))
(if (> (/ sum 32768.0) 200.0)
- (snd-display #__line__ ";random average: ~A ~A" (/ sum 32768.0) (vct-ref ndat 0)))
- (do ((i 0 (+ 1 i)))
+ (snd-display #__line__ ";random average: ~A ~A" (/ sum 32768.0) (ndat 0)))
+ (do ((i 0 (+ i 1)))
((= i 65536))
- (vct-set! data i (mus-random 1.0)))
+ (set! (data i) (mus-random 1.0)))
(autocorrelate data)
- (vct-set! data 0 0.0)
- (let ((pk (vct-peak data)))
+ (set! (data 0) 0.0)
+ (let ((pk (float-vector-peak data)))
(if (> pk 1000)
- (snd-display #__line__ ";random autocorrelate peak: ~A" (vct-peak data)))
+ (snd-display #__line__ ";random autocorrelate peak: ~A" (float-vector-peak data)))
(set! sum 0.0)
- (do ((i 0 (+ 1 i)))
+ (float-vector-abs! data)
+ (do ((i 0 (+ i 1)))
((= i 32768))
- (set! sum (+ sum (abs (vct-ref data i)))))
+ (set! sum (+ sum (float-vector-ref data i))))
(if (> (/ sum 32768.0) 200.0)
(snd-display #__line__ ";random autocorrelate average: ~A" (/ sum 32768.0))))))
@@ -24161,8 +18353,8 @@ EDITS: 2
(gen1 (make-locsig 60.0 :channels 2))
(gen2 (make-locsig 60.0 :channels 4))
(gen200 (make-locsig 200.0 :channels 4))
- (gen3 gen1)
- (fr0 (locsig gen 0 1.0)))
+ (gen3 gen1))
+ (locsig gen 0 1.0)
(print-and-check gen
"locsig"
"locsig chans 2, outn: [0.667 0.333], interp: linear")
@@ -24174,79 +18366,76 @@ EDITS: 2
(if (equal? gen gen2) (snd-display #__line__ ";locsig 3 equal? ~A ~A" gen gen2))
(if (or (fneq (locsig-ref gen 0) .667) (fneq (locsig-ref gen 1) .333))
(snd-display #__line__ ";locsig ref: ~F ~F?" (locsig-ref gen 0) (locsig-ref gen 1)))
- (if (not (vequal (mus-data gen) (vct 0.667 0.333)))
+ (if (not (vequal (mus-data gen) (float-vector 0.667 0.333)))
(snd-display #__line__ ";locsig gen outn: ~A" (mus-data gen)))
- (if (not (vequal (mus-data gen1) (vct 0.333 0.667)))
+ (if (not (vequal (mus-data gen1) (float-vector 0.333 0.667)))
(snd-display #__line__ ";locsig gen2 outn: ~A" (mus-data gen1)))
- (if (not (vequal (mus-data gen2) (vct 0.333 0.667 0.000 0.000)))
+ (if (not (vequal (mus-data gen2) (float-vector 0.333 0.667 0.000 0.000)))
(snd-display #__line__ ";locsig gen2 outn: ~A" (mus-data gen2)))
- (if (not (vequal (mus-data gen200) (vct 0.000 0.000 0.778 0.222)))
+ (if (not (vequal (mus-data gen200) (float-vector 0.000 0.000 0.778 0.222)))
(snd-display #__line__ ";locsig gen200 outn: ~A" (mus-data gen200)))
- (set! (locsig-ref gen 0) .25)
- (if (not (vequal (mus-data gen) (vct 0.250 0.333)))
+ (locsig-set! gen 0 .25)
+ (if (not (vequal (mus-data gen) (float-vector 0.250 0.333)))
(snd-display #__line__ ";locsig gen .25 outn: ~A" (mus-data gen)))
- (set! fr0 (locsig gen 0 1.0))
+ (locsig gen 0 1.0)
(locsig-set! gen 0 .5)
- (if (not (vequal (mus-data gen) (vct 0.500 0.333)))
+ (if (not (vequal (mus-data gen) (float-vector 0.500 0.333)))
(snd-display #__line__ ";locsig gen .5 outn: ~A" (mus-data gen)))
- (set! fr0 (locsig gen 0 1.0))
+ (locsig gen 0 1.0)
(set! gen (make-locsig 120.0 2.0 .1 :channels 4))
- (if (not (vequal (mus-data gen) (vct 0.000 0.333 0.167 0.000)))
+ (if (not (vequal (mus-data gen) (float-vector 0.000 0.333 0.167 0.000)))
(snd-display #__line__ ";locsig gen 120 outn: ~A" (mus-data gen)))
- (set! fr0 (locsig gen 0 1.0))
+ (locsig gen 0 1.0)
(set! gen (make-locsig 300.0 2.0 .1 :channels 4))
- (if (not (vequal (mus-data gen) (vct 0.167 0.000 0.000 0.333)))
+ (if (not (vequal (mus-data gen) (float-vector 0.167 0.000 0.000 0.333)))
(snd-display #__line__ ";locsig gen 300 outn: ~A" (mus-data gen)))
- (set! fr0 (locsig gen 0 1.0))
+ (locsig gen 0 1.0)
(move-locsig gen1 90.0 1.0)
- (if (not (vequal (mus-data gen1) (vct 0.000 1.000)))
+ (if (not (vequal (mus-data gen1) (float-vector 0.000 1.000)))
(snd-display #__line__ ";locsig gen1 90 outn: ~A" (mus-data gen1)))
(move-locsig gen1 0.0 1.0)
- (if (not (vequal (mus-data gen1) (vct 1.000 0.000)))
+ (if (not (vequal (mus-data gen1) (float-vector 1.000 0.000)))
(snd-display #__line__ ";locsig gen1 0 outn: ~A" (mus-data gen1)))
(move-locsig gen1 45.0 1.0)
- (if (not (vequal (mus-data gen1) (vct 0.500 0.500)))
+ (if (not (vequal (mus-data gen1) (float-vector 0.500 0.500)))
(snd-display #__line__ ";locsig gen1 45 outn: ~A" (mus-data gen1)))
(move-locsig gen1 135.0 2.0)
- (if (not (vequal (mus-data gen1) (vct 0.000 0.500)))
+ (if (not (vequal (mus-data gen1) (float-vector 0.000 0.500)))
(snd-display #__line__ ";locsig gen1 135 outn: ~A" (mus-data gen1)))
(move-locsig gen1 -270.0 3.0)
- (if (not (vequal (mus-data gen1) (vct 0.333 0.0)))
+ (if (not (vequal (mus-data gen1) (float-vector 0.333 0.0)))
(snd-display #__line__ ";locsig gen1 -270 outn: ~A" (mus-data gen1))))
- (do ((chans 1 (+ chans 1)))
- ((> chans 8))
- (let ((loc (make-locsig :channels chans))
- (last (make-vct chans 0.0)))
+ (for-each
+ (lambda (chans)
+ (let* ((loc (make-locsig :channels chans))
+ (last (make-float-vector chans))
+ (data (mus-data loc)))
;; do a full circle looking for jumps
(move-locsig loc -400.0 1.0)
- (do ((chan 0 (+ chan 1)))
- ((= chan chans))
- (set! (last chan) (vct-ref (mus-data loc) chan)))
- (run
- (do ((x -400.0 (+ x .01)))
- ((> x 400.0))
- (move-locsig loc x 1.0)
- (do ((chan 0 (+ chan 1)))
- ((= chan chans))
- (if (or (< (vct-ref (mus-data loc) chan) 0.0)
- (> (vct-ref (mus-data loc) chan) 1.0))
- (format #t ";locsig, chans: ~D, degree: ~F, chan ~D is ~F, ~A~%" chans x chan (vct-ref (mus-data loc) chan) (mus-data loc)))
- (let ((diff (abs (- (vct-ref (mus-data loc) chan) (vct-ref last chan)))))
- (set! (last chan) (vct-ref (mus-data loc) chan))
- (if (> diff .002)
- (format #t ";locsig, increment ~F in chan ~D with deg ~F~%" diff chan x))))))))
-
+ (copy data last)
+ (do ((x -400.0 (+ x 10.0)))
+ ((> x 400.0))
+ (move-locsig loc x 1.0)
+ (if (or (< (float-vector-min data) 0.0)
+ (> (float-vector-max data) 1.0))
+ (format #t ";locsig, chans: ~D, degree: ~F, ~A~%" chans x data))
+ (let ((diff (float-vector-peak (float-vector-subtract! last data))))
+ (copy data last)
+ (if (> diff .25)
+ (format #t ";locsig, increment ~F with deg ~F~%" diff x))))))
+ (list 1 2 4 5 8))
+
(for-each
(lambda (chans)
(let ((m1 (make-locsig :channels chans)))
(if (or (not (= (mus-channels m1) chans))
(not (= (mus-length m1) chans)))
(snd-display #__line__ ";locsig ~A chans but: ~A ~A" chans (mus-channels m1) (mus-length m1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i chans))
(locsig-set! m1 i (* i .1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i chans))
(if (fneq (locsig-ref m1 i) (* i .1))
(snd-display #__line__ ";locsig[~A] = ~A (~A)?" i (locsig-ref m1 i) (* i .1))))))
@@ -24289,38 +18478,38 @@ EDITS: 2
(let ((locs (make-locsig :channels 8 :degree 0)))
(move-locsig locs 180 1.0)
(if (fneq (locsig-ref locs 0) 0.0) (snd-display #__line__ ";move-locsig by jump: ~A" (mus-data locs)))
- (if (not (vequal (mus-data locs) (vct 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000)))
+ (if (not (vequal (mus-data locs) (float-vector 0.000 0.000 0.000 0.000 1.000 0.000 0.000 0.000)))
(snd-display #__line__ ";move-locsig by jump data: ~A" (mus-data locs)))
(move-locsig locs 120.0 1.0)
- (if (not (vequal (mus-data locs) (vct 0.000 0.000 0.333 0.667 0.000 0.000 0.000 0.000)))
+ (if (not (vequal (mus-data locs) (float-vector 0.000 0.000 0.333 0.667 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";move-locsig by jump 120 data: ~A" (mus-data locs)))
(move-locsig locs -20.0 1.0)
- (if (not (vequal (mus-data locs) (vct 0.556 0.000 0.000 0.000 0.000 0.000 0.000 0.444)))
+ (if (not (vequal (mus-data locs) (float-vector 0.556 0.000 0.000 0.000 0.000 0.000 0.000 0.444)))
(snd-display #__line__ ";move-locsig by jump -20 data: ~A" (mus-data locs))))
(let ((sf (make-sample->file "fmv4.snd" 8 mus-bshort mus-next "this is a comment"))
(sfrev (make-sample->file "fmv4.reverb" 8 mus-bshort mus-next "this is a comment")))
(let ((locs (make-locsig :channels 8 :degree 0 :distance 1.0 :reverb 0.1
:output sf :revout sfrev :type mus-interp-linear)))
- (if (not (vequal (mus-data locs) (vct 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal (mus-data locs) (float-vector 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";ws not move-locsig by jump data: ~A" (mus-data locs)))
- (if (not (vequal (mus-xcoeffs locs) (vct 0.100 0.000 0.000 0.000 0.0 0.0 0.0 0.0)))
+ (if (not (vequal (mus-xcoeffs locs) (float-vector 0.100 0.000 0.000 0.000 0.0 0.0 0.0 0.0)))
(snd-display #__line__ ";ws not move-locsig by jump rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs 180 2.0)
(if (fneq (locsig-ref locs 0) 0.0) (snd-display #__line__ ";ws move-locsig by jump: ~A" (mus-data locs)))
- (if (not (vequal (mus-data locs) (vct 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000)))
+ (if (not (vequal (mus-data locs) (float-vector 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000)))
(snd-display #__line__ ";ws move-locsig by jump data: ~A" (mus-data locs)))
- (if (not (vequal (mus-xcoeffs locs) (vct 0.000 0.000 0.000 0.000 0.071 0.000 0.000 0.000)))
+ (if (not (vequal (mus-xcoeffs locs) (float-vector 0.000 0.000 0.000 0.000 0.071 0.000 0.000 0.000)))
(snd-display #__line__ ";ws move-locsig by jump rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs 120.0 3.0)
- (if (not (vequal (mus-data locs) (vct 0.000 0.000 0.111 0.222 0.000 0.000 0.000 0.000)))
+ (if (not (vequal (mus-data locs) (float-vector 0.000 0.000 0.111 0.222 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";ws move-locsig by jump 120 data: ~A" (mus-data locs)))
- (if (not (vequal (mus-xcoeffs locs) (vct 0.000 0.000 0.019 0.038 0.000 0.000 0.000 0.000)))
+ (if (not (vequal (mus-xcoeffs locs) (float-vector 0.000 0.000 0.019 0.038 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";ws move-locsig by jump 120 rev data: ~A" (mus-xcoeffs locs)))
(move-locsig locs -20.0 4.0)
- (if (not (vequal (mus-data locs) (vct 0.139 0.000 0.000 0.000 0.000 0.000 0.000 0.111)))
+ (if (not (vequal (mus-data locs) (float-vector 0.139 0.000 0.000 0.000 0.000 0.000 0.000 0.111)))
(snd-display #__line__ ";ws move-locsig by jump -20 data: ~A" (mus-data locs)))
- (if (not (vequal (mus-xcoeffs locs) (vct 0.028 0.000 0.000 0.000 0.000 0.000 0.000 0.022)))
+ (if (not (vequal (mus-xcoeffs locs) (float-vector 0.028 0.000 0.000 0.000 0.000 0.000 0.000 0.022)))
(snd-display #__line__ ";ws move-locsig by jump -20 rev data: ~A" (mus-xcoeffs locs))))
(mus-close sf)
(mus-close sfrev))
@@ -24332,53 +18521,51 @@ EDITS: 2
(for-each
(lambda (ht)
(let ((ind (find-sound (with-sound (:channels 8)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 8))
(locsig (make-locsig :degree (* i 45) :output *output*) i 0.5))))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (let ((samps (channel->vct 0 8 ind i)))
- (do ((k 0 (+ 1 k)))
+ (let ((samps (channel->float-vector 0 8 ind i)))
+ (do ((k 0 (+ k 1)))
((= k 8))
- (if (and (= k i) (fneq (vct-ref samps k) 0.5))
- (snd-display #__line__ ";8 out ~A chan ~A samp ~A (0.5): ~A" (mus-header-type->string ht) i k (vct-ref samps k)))
- (if (and (not (= i k)) (fneq (vct-ref samps k) 0.0))
- (snd-display #__line__ ";8 out ~A chan ~A samp ~A (0.0): ~A" (mus-header-type->string ht) i k (vct-ref samps k))))))
+ (if (and (= k i) (fneq (samps k) 0.5))
+ (snd-display #__line__ ";8 out ~A chan ~A samp ~A (0.5): ~A" (mus-header-type->string ht) i k (samps k)))
+ (if (and (not (= i k)) (fneq (samps k) 0.0))
+ (snd-display #__line__ ";8 out ~A chan ~A samp ~A (0.0): ~A" (mus-header-type->string ht) i k (samps k))))))
(close-sound ind)))
(list mus-caff mus-aifc mus-next mus-riff mus-rf64))
- (let* ((gen (make-frame->file "fmv4.snd" 2 mus-bshort mus-next))
- (rev (make-frame->file "fmv4.reverb" 1 mus-bshort mus-next))
+ (let* ((gen (make-frample->file "fmv4.snd" 2 mus-bshort mus-next))
+ (rev (make-frample->file "fmv4.reverb" 1 mus-bshort mus-next))
(lc (make-locsig 60.0 :reverb .1 :channels 2 :output gen :revout rev)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(locsig lc i 1.0))
(if (fneq (locsig-reverb-ref lc 0) .1) (snd-display #__line__ ";locsig reverb ref: ~A?" (locsig-reverb-ref lc 0)))
- (set! (locsig-reverb-ref lc 0) .3)
- (if (fneq (locsig-reverb-ref lc 0) .3) (snd-display #__line__ ";set locsig reverb ref: ~A?" (locsig-reverb-ref lc 0)))
(locsig-reverb-set! lc 0 .2)
(if (fneq (locsig-reverb-ref lc 0) .2) (snd-display #__line__ ";locsig reverb set: ~A?" (locsig-reverb-ref lc 0)))
(mus-close gen)
(mus-close rev)
- (let ((v0 (make-vct 100))
- (v1 (make-vct 100))
- (v2 (make-vct 100)))
+ (let ((v0 (make-float-vector 100))
+ (v1 (make-float-vector 100))
+ (v2 (make-float-vector 100)))
(file->array "fmv4.snd" 0 0 100 v0)
(file->array "fmv4.snd" 1 0 100 v1)
(file->array "fmv4.reverb" 0 0 100 v2)
- (if (fneq (vct-ref v2 0) .1) (snd-display #__line__ ";locsig reverb: ~A?" v2))
- (if (fneq (* 2 (vct-ref v0 0)) (vct-ref v1 0)) (snd-display #__line__ ";locsig direct: ~A ~A?" (vct-ref v0 0) (vct-ref v1 0)))))
+ (if (fneq (v2 0) .1) (snd-display #__line__ ";locsig reverb: ~A?" v2))
+ (if (fneq (* 2 (v0 0)) (v1 0)) (snd-display #__line__ ";locsig direct: ~A ~A?" (v0 0) (v1 0)))))
- (let* ((gen (make-frame->file "fmv4.snd" 4 mus-bshort mus-next))
- (rev (make-frame->file "fmv4.reverb" 4 mus-bshort mus-next))
+ (let* ((gen (make-frample->file "fmv4.snd" 4 mus-bshort mus-next))
+ (rev (make-frample->file "fmv4.reverb" 4 mus-bshort mus-next))
(lc (make-locsig 60.0 :reverb .1 :channels 4 :distance 4.0 :output gen :revout rev)))
(print-and-check lc
"locsig"
"locsig chans 4, outn: [0.083 0.167 0.000 0.000], revn: [0.017 0.033 0.000 0.000], interp: linear")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100))
(locsig lc i 1.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 4))
(locsig-reverb-set! lc i (* i .1))
(if (fneq (locsig-reverb-ref lc i) (* i .1))
@@ -24386,11 +18573,11 @@ EDITS: 2
(print-and-check lc
"locsig"
"locsig chans 4, outn: [0.083 0.167 0.000 0.000], revn: [0.000 0.100 0.200 0.300], interp: linear")
- (if (not (vct? (mus-data lc))) (snd-display #__line__ ";out data locsig: ~A" (mus-data lc)))
- (if (not (vct? (mus-xcoeffs lc))) (snd-display #__line__ ";rev data locsig: ~A" (mus-xcoeffs lc)))
+ (if (not (float-vector? (mus-data lc))) (snd-display #__line__ ";out data locsig: ~A" (mus-data lc)))
+ (if (not (float-vector? (mus-xcoeffs lc))) (snd-display #__line__ ";rev data locsig: ~A" (mus-xcoeffs lc)))
(let ((xcs (mus-xcoeffs lc)))
- (if (fneq (mus-xcoeff lc 0) (vct-ref xcs 0)) (snd-display #__line__ ";locsig xcoeff: ~A ~A" (mus-xcoeff lc 0) (vct-ref xcs 0)))
- (if (fneq (mus-xcoeff lc 1) .1) (snd-display #__line__ ";locsig xcoeff 1: ~A ~A (.1)" (mus-xcoeff lc 0) (vct-ref xcs 0))))
+ (if (fneq (mus-xcoeff lc 0) (xcs 0)) (snd-display #__line__ ";locsig xcoeff: ~A ~A" (mus-xcoeff lc 0) (xcs 0)))
+ (if (fneq (mus-xcoeff lc 1) .1) (snd-display #__line__ ";locsig xcoeff 1: ~A ~A (.1)" (mus-xcoeff lc 0) (xcs 0))))
(mus-close gen)
(mus-close rev))
@@ -24415,52 +18602,52 @@ EDITS: 2
(print-and-check (make-locsig -40 :channels 2)
"locsig"
"locsig chans 2, outn: [1.000 0.000], interp: linear")
- (print-and-check (make-locsig 160 :channels 4 :output (make-sound-data 4 10))
+ (print-and-check (make-locsig 160 :channels 4 :output (make-float-vector (list 4 10) 0.0))
"locsig"
"locsig chans 4, outn: [0.000 0.222 0.778 0.000], interp: linear")
- (print-and-check (make-locsig 0 :channels 1 :output (make-vct 10))
+ (print-and-check (make-locsig 0 :channels 1 :output (make-float-vector 10))
"locsig"
"locsig chans 1, outn: [1.000], interp: linear")
(letrec ((locsig-data
(lambda (gen)
(let* ((chans (mus-channels gen))
- (dat (make-vct chans)))
- (do ((i 0 (+ 1 i)))
+ (dat (make-float-vector chans)))
+ (do ((i 0 (+ i 1)))
((= i chans))
- (vct-set! dat i (locsig-ref gen i)))
+ (set! (dat i) (locsig-ref gen i)))
dat))))
(let ((gen (make-locsig -.1 :channels 8)))
- (if (not (vequal (locsig-data gen) (vct 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
(snd-display #__line__ ";locsig -.1(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -359.9 :channels 8))
- (if (not (vequal (locsig-data gen) (vct 0.998 0.002 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.998 0.002 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";locsig -359.9(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -359.9 :channels 4))
- (if (not (vequal (locsig-data gen) (vct 0.999 0.001 0.000 0.000)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.999 0.001 0.000 0.000)))
(snd-display #__line__ ";locsig -359.9(4): ~A" (locsig-data gen)))
(set! gen (make-locsig -360.1 :channels 8))
- (if (not (vequal (locsig-data gen) (vct 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.998 0.000 0.000 0.000 0.000 0.000 0.000 0.002)))
(snd-display #__line__ ";locsig -360.1(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -700 :channels 8))
- (if (not (vequal (locsig-data gen) (vct 0.556 0.444 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.556 0.444 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";locsig -700(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -700 :channels 2))
- (if (not (vequal (locsig-data gen) (vct 1.000 0.000)))
+ (if (not (vequal (locsig-data gen) (float-vector 1.000 0.000)))
(snd-display #__line__ ";locsig -700(2): ~A" (locsig-data gen)))
(set! gen (make-locsig 20 :channels 2))
- (if (not (vequal (locsig-data gen) (vct 0.778 0.222)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.778 0.222)))
(snd-display #__line__ ";locsig 20(2): ~A" (locsig-data gen)))
(set! gen (make-locsig 123456.0 :channels 8))
- (if (not (vequal (locsig-data gen) (vct 0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
(snd-display #__line__ ";locsig 123456(8): ~A" (locsig-data gen)))
(set! gen (make-locsig 336.0 :channels 8))
- (if (not (vequal (locsig-data gen) (vct 0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.467 0.000 0.000 0.000 0.000 0.000 0.000 0.533)))
(snd-display #__line__ ";locsig 336(8): ~A" (locsig-data gen)))
(set! gen (make-locsig -123456.0 :channels 8))
- (if (not (vequal (locsig-data gen) (vct 0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";locsig -123456(8): ~A" (locsig-data gen)))
(set! gen (make-locsig 24.0 :channels 8))
- (if (not (vequal (locsig-data gen) (vct 0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal (locsig-data gen) (float-vector 0.467 0.533 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";locsig 24(8): ~A" (locsig-data gen)))))
(for-each
@@ -24471,7 +18658,7 @@ EDITS: 2
(let ((pos (floor (/ a b))))
(- a (* pos b))))
(if (= chans 1)
- (vct 1.0)
+ (float-vector 1.0)
(let* ((deg (if (= chans 2)
(max 0.0 (min 90.0 degree))
(xmodulo degree 360.0)))
@@ -24482,23 +18669,22 @@ EDITS: 2
(left (floor pos))
(right (xmodulo (+ left 1) chans))
(frac (- pos left))
- (v (make-vct chans)))
+ (v (make-float-vector chans)))
(if (= type mus-interp-linear)
(begin
- (vct-set! v left (- 1.0 frac))
- (vct-set! v right frac))
+ (set! (v left) (- 1.0 frac))
+ (set! (v right) frac))
(let* ((ldeg (* (/ pi 2) (- 0.5 frac)))
(norm (/ (sqrt 2.0) 2.0))
(c (cos ldeg))
(s (sin ldeg)))
- (vct-set! v left (* norm (+ c s)))
- (vct-set! v right (* norm (- c s)))))
+ (set! (v left) (* norm (+ c s)))
+ (set! (v right) (* norm (- c s)))))
v)))
(if (file-exists? "test.reverb") (delete-file "test.reverb"))
- (let ((revfile (if (> rev-chans 0)
- (make-frame->file "test.reverb" rev-chans mus-bshort mus-next)
- #f))
+ (let ((revfile (and (> rev-chans 0)
+ (make-frample->file "test.reverb" rev-chans mus-bshort mus-next)))
(happy #t))
(for-each
(lambda (type)
@@ -24516,14 +18702,14 @@ EDITS: 2
(if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";locsig ~A: ~A" deg gen))
(if (fneq (locsig-ref gen 0) 0.5) (snd-display #__line__ ";locsig scaler[~A] ~A: ~A" type deg (locsig-ref gen 0)))
(if revfile
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i rev-chans)))
- (if (fneq (locsig-reverb-ref gen i) (* (/ .1 (sqrt 2.0)) (vct-ref revs i)))
+ (if (fneq (locsig-reverb-ref gen i) (* (/ .1 (sqrt 2.0)) (revs i)))
(begin
(snd-display #__line__ ";mono locrev[~A] ~A at ~A: ~A ~A"
type gen deg
(locsig-reverb-ref gen i)
- (* (/ .1 (sqrt 2.0)) (vct-ref revs i)))
+ (* (/ .1 (sqrt 2.0)) (revs i)))
(set! happy #f)))))))
(list 0.0 45.0 90.0 1234.0))
@@ -24542,24 +18728,24 @@ EDITS: 2
(for-each
(lambda (deg)
(let ((gen (make-locsig deg :channels chans :revout revfile :reverb .1)))
- (if (not (= (mus-channels gen) chans)) (begin (snd-display #__line__ ";multi locsig ~A: ~A" deg gen)))
+ (if (not (= (mus-channels gen) chans)) (snd-display #__line__ ";multi locsig ~A: ~A" deg gen))
(let ((scalers (locsig-scalers chans deg type))
(revs (if revfile (locsig-scalers rev-chans deg type))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i chans)))
- (if (fneq (locsig-ref gen i) (vct-ref scalers i))
+ (if (fneq (locsig-ref gen i) (scalers i))
(begin
- (snd-display #__line__ ";locsig[~A] ~A at ~A: ~A ~A" type gen deg (locsig-ref gen i) (vct-ref scalers i))
+ (snd-display #__line__ ";locsig[~A] ~A at ~A: ~A ~A" type gen deg (locsig-ref gen i) (scalers i))
(set! happy #f))))
(if revfile
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i rev-chans)))
- (if (fneq (locsig-reverb-ref gen i) (* .1 (vct-ref revs i)))
+ (if (fneq (locsig-reverb-ref gen i) (* .1 (revs i)))
(begin
(snd-display #__line__ ";locrev[~A] ~A at ~A: ~A ~A"
type gen deg
(locsig-reverb-ref gen i)
- (* .1 (vct-ref revs i)))
+ (* .1 (revs i)))
(set! happy #f))))))))
(list 0.0 45.0 90.0 120.0 180.0 275.0 315.0 300.0 15.0 1234.0)))
(list 2 3 4 5 8 12 16 24))
@@ -24571,24 +18757,24 @@ EDITS: 2
(for-each
(lambda (deg)
(let ((gen (make-locsig deg :channels chans :type ltype :revout revfile :reverb .1)))
- (if (not (= (mus-channels gen) chans)) (begin (snd-display #__line__ ";stereo locsig ~A: ~A" deg gen)))
+ (if (not (= (mus-channels gen) chans)) (snd-display #__line__ ";stereo locsig ~A: ~A" deg gen))
(let ((scalers (locsig-scalers chans deg ltype))
(revs (if revfile (locsig-scalers rev-chans deg ltype))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i chans)))
- (if (fneq (locsig-ref gen i) (vct-ref scalers i))
+ (if (fneq (locsig-ref gen i) (scalers i))
(begin
- (snd-display #__line__ ";locsig[~A] ~A at ~A: ~A ~A" ltype gen deg (locsig-ref gen i) (vct-ref scalers i))
+ (snd-display #__line__ ";locsig[~A] ~A at ~A: ~A ~A" ltype gen deg (locsig-ref gen i) (scalers i))
(set! happy #f))))
(if revfile
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i rev-chans)))
- (if (fneq (locsig-reverb-ref gen i) (* .1 (vct-ref revs i)))
+ (if (fneq (locsig-reverb-ref gen i) (* .1 (revs i)))
(begin
(snd-display #__line__ ";locrev[~A] ~A at ~A: ~A ~A"
type gen deg
(locsig-reverb-ref gen i)
- (* .1 (vct-ref revs i)))
+ (* .1 (revs i)))
(set! happy #f))))))))
(list 0.0 45.0 90.0 120.0 180.0 275.0 315.0 300.0 15.0 1234.0)))
(list mus-interp-linear mus-interp-sinusoidal)))
@@ -24599,92 +18785,91 @@ EDITS: 2
(list 0 1 2 4))
(set! (locsig-type) mus-interp-linear)
- (let* ((outp (make-sound-data 1 10))
+ (let* ((outp (make-float-vector (list 1 10) 0.0))
(gen (make-locsig 0.0 :output outp)))
(if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";make-locsig->sd chans (1): ~A" (mus-channels gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 1.0))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 1.0)))
- (snd-display #__line__ ";locsig->sd chan 0: ~A" (sound-data->vct outp 0))))
+ (if (not (vequal (outp 0) (make-float-vector 10 1.0)))
+ (snd-display #__line__ ";locsig->sd chan 0: ~A" (outp 0))))
- (let* ((outp (make-sound-data 2 10))
+ (let* ((outp (make-float-vector (list 2 10) 0.0))
(gen (make-locsig 0.0 :output outp)))
(if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";make-locsig->sd chans: ~A" (mus-channels gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 1.0))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 1.0)))
- (snd-display #__line__ ";locsig->sd chan 0: ~A" (sound-data->vct outp 0)))
- (if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.0)))
- (snd-display #__line__ ";locsig->sd chan 1: ~A" (sound-data->vct outp 1))))
+ (if (not (vequal (outp 0) (make-float-vector 10 1.0)))
+ (snd-display #__line__ ";locsig->sd chan 0: ~A" (outp 0)))
+ (if (not (vequal (outp 1) (make-float-vector 10 0.0)))
+ (snd-display #__line__ ";locsig->sd chan 1: ~A" (outp 1))))
- (let* ((outp (make-sound-data 2 10))
+ (let* ((outp (make-float-vector (list 2 10) 0.0))
(gen (make-locsig 45.0 :output outp)))
(if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";make-locsig->sd chans: ~A" (mus-channels gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 1.0))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.5)))
- (snd-display #__line__ ";locsig->sd chan 0 (0.5): ~A (~A)" (sound-data->vct outp 0) gen))
- (if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.5)))
- (snd-display #__line__ ";locsig->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
- (do ((i 0 (+ 1 i)))
+ (if (not (vequal (outp 0) (make-float-vector 10 0.5)))
+ (snd-display #__line__ ";locsig->sd chan 0 (0.5): ~A (~A)" (outp 0) gen))
+ (if (not (vequal (outp 1) (make-float-vector 10 0.5)))
+ (snd-display #__line__ ";locsig->sd chan 1 (0.5): ~A" (outp 1)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 0.5))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.75)))
- (snd-display #__line__ ";locsig->sd chan 0 (0.75) (~A): ~A" (sound-data->vct outp 0) gen))
- (if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.75)))
- (snd-display #__line__ ";locsig->sd chan 1 (0.75): ~A" (sound-data->vct outp 1))))
+ (if (not (vequal (outp 0) (make-float-vector 10 0.75)))
+ (snd-display #__line__ ";locsig->sd chan 0 (0.75) (~A): ~A" (outp 0) gen))
+ (if (not (vequal (outp 1) (make-float-vector 10 0.75)))
+ (snd-display #__line__ ";locsig->sd chan 1 (0.75): ~A" (outp 1))))
- (let* ((outp (make-vct 10))
+ (let* ((outp (make-float-vector 10))
(gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";make-locsig->vct chans: ~A" (mus-channels gen)))
- (do ((i 0 (+ 1 i)))
+ (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";make-locsig->float-vector chans: ~A" (mus-channels gen)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 1.0))
- (if (not (vequal outp (make-vct 10 1.0)))
- (snd-display #__line__ ";locsig->vct chan 0: ~A" outp))
- (do ((i 0 (+ 1 i)))
+ (if (not (vequal outp (make-float-vector 10 1.0)))
+ (snd-display #__line__ ";locsig->float-vector chan 0: ~A" outp))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 0.5))
- (if (not (vequal outp (make-vct 10 1.5)))
- (snd-display #__line__ ";locsig->vct chan 0: ~A" outp)))
+ (if (not (vequal outp (make-float-vector 10 1.5)))
+ (snd-display #__line__ ";locsig->float-vector chan 0: ~A" outp)))
- (let* ((outp (make-vct 10))
+ (let* ((outp (make-float-vector 10))
(gen (make-locsig 45.0 :channels 2 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";make-locsig->vct chans (2): ~A" (mus-channels gen)))
- (do ((i 0 (+ 1 i)))
+ (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";make-locsig->float-vector chans (2): ~A" (mus-channels gen)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 1.0))
- (if (not (vequal outp (make-vct 10 0.5)))
- (snd-display #__line__ ";locsig(2)->vct chan 0: ~A" outp))
- (do ((i 0 (+ 1 i)))
+ (if (not (vequal outp (make-float-vector 10 0.5)))
+ (snd-display #__line__ ";locsig(2)->float-vector chan 0: ~A" outp))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 0.5))
- (if (not (vequal outp (make-vct 10 0.75)))
- (snd-display #__line__ ";locsig(2)->vct chan 0: ~A" outp)))
+ (if (not (vequal outp (make-float-vector 10 0.75)))
+ (snd-display #__line__ ";locsig(2)->float-vector chan 0: ~A" outp)))
- (let* ((outp (make-sound-data 4 10))
+ (let* ((outp (make-float-vector (list 4 10) 0.0))
(gen (make-locsig 135.0 :output outp)))
(if (not (= (mus-channels gen) 4)) (snd-display #__line__ ";make-locsig->sd chans (4): ~A" (mus-channels gen)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(locsig gen i 1.0))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.0)))
- (snd-display #__line__ ";locsig(4)->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
- (if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.5)))
- (snd-display #__line__ ";locsig(4)->sd chan 1 (0.5) (~A): ~A" (sound-data->vct outp 1) gen))
- (if (not (vequal (sound-data->vct outp 2) (make-vct 10 0.5)))
- (snd-display #__line__ ";locsig(4)->sd chan 2 (0.5): ~A" (sound-data->vct outp 2)))
- (if (not (vequal (sound-data->vct outp 3) (make-vct 10 0.0)))
- (snd-display #__line__ ";locsig(4)->sd chan 3 (0.5): ~A" (sound-data->vct outp 3))))
-
-
- (set! (mus-array-print-length) 8)
- (let* ((outf1 (make-frame->file "fmv.snd" 1 mus-bshort mus-next))
- (outf4 (make-frame->file "fmv1.snd" 4 mus-bshort mus-next))
- (revf (make-frame->file "fmv2.snd" 1 mus-bshort mus-next))
+ (if (not (vequal (outp 0) (make-float-vector 10 0.0)))
+ (snd-display #__line__ ";locsig(4)->sd chan 0 (0.5): ~A" (outp 0)))
+ (if (not (vequal (outp 1) (make-float-vector 10 0.5)))
+ (snd-display #__line__ ";locsig(4)->sd chan 1 (0.5) (~A): ~A" (outp 1) gen))
+ (if (not (vequal (outp 2) (make-float-vector 10 0.5)))
+ (snd-display #__line__ ";locsig(4)->sd chan 2 (0.5): ~A" (outp 2)))
+ (if (not (vequal (outp 3) (make-float-vector 10 0.0)))
+ (snd-display #__line__ ";locsig(4)->sd chan 3 (0.5): ~A" (outp 3))))
+
+ (set! *mus-array-print-length* 8)
+ (let* ((outf1 (make-frample->file "fmv.snd" 1 mus-ldouble mus-next))
+ (outf4 (make-frample->file "fmv1.snd" 4 mus-ldouble mus-next))
+ (revf (make-frample->file "fmv2.snd" 1 mus-ldouble mus-next))
(start 0)
(end 1000)
(dur 1.0)
@@ -24722,13 +18907,13 @@ EDITS: 2
(print-and-check gen1
"move-sound"
"move-sound start: 0, end: 1000, out chans 1, rev chans: 0
- doppler delay line[32, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
- doppler env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
- global reverb env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
+ doppler delay line[32, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
+ doppler env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
+ global reverb env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
out_delays[1]:
- [0]: delay line[32, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
+ [0]: delay line[32, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
out_envs[1]:
- [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
+ [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
rev_envs: nil
out_map[1]: (0)
free: arrays: true, gens: false
@@ -24737,8 +18922,8 @@ EDITS: 2
(print-and-check gen2
"move-sound"
"move-sound start: 0, end: 1000, out chans 4, rev chans: 0
- doppler delay line[12, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
- doppler env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 10.000 1.000]
+ doppler delay line[12, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
+ doppler env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 10 1]
global reverb null
out_delays[4]:
[0]: nil
@@ -24746,10 +18931,10 @@ EDITS: 2
[2]: nil
[3]: nil
out_envs[4]:
- [0]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000 2.000 0.000 3.000 0.000...(0: 0.000, 8: 4.000)]
- [1]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 0.000 2.000 1.000 3.000 0.000...(0: 0.000, 8: 4.000)]
- [2]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 0.000 2.000 0.000 3.000 1.000...(0: 0.000, 8: 4.000)]
- [3]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 0.000 2.000 0.000 3.000 0.000...(0: 0.000, 8: 4.000)]
+ [0]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1 2 0 3 0...(0: 0, 8: 4)]
+ [1]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 0 2 1 3 0...(0: 0, 8: 4)]
+ [2]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 0 2 0 3 1...(0: 0, 8: 4)]
+ [3]: env linear, pass: 0 (dur: 22050), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 0 2 0 3 0...(0: 0, 8: 4)]
rev_envs: nil
out_map[4]: (0 1 2 3)
free: arrays: true, gens: false
@@ -24758,15 +18943,15 @@ EDITS: 2
(print-and-check gen3
"move-sound"
"move-sound start: 0, end: 1000, out chans 1, rev chans: 1
- doppler delay line[32, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
- doppler env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
- global reverb env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
+ doppler delay line[32, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
+ doppler env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
+ global reverb env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
out_delays[1]:
- [0]: delay line[32, step]: [0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000...(0: 0.000, 0: 0.000)]
+ [0]: delay line[32, step]: [0 0 0 0 0 0 0 0...(0: 0, 0: 0)]
out_envs[1]:
- [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 0.000 1.000 1.000]
+ [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 0 1 1]
rev_envs[1]:
- [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0.000 1.000 1.000 1.000]
+ [0]: env linear, pass: 0 (dur: 1001), index: 0, scaler: 1.0000, offset: 0.0000, data: [0 1 1 1]
out_map[1]: (0)
free: arrays: true, gens: false
")
@@ -24777,13 +18962,13 @@ EDITS: 2
(if (not (= (mus-channels gen2) 4)) (snd-display #__line__ ";mus-channels move-sound (4): ~A" (mus-channels gen2)))
(mus-reset gen1) ; a no-op
- (let ((v (make-vct 10 0.0)))
- (do ((i 0 (+ 1 i)))
+ (let ((v (make-float-vector 10 0.0)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v i (+ (move-sound gen1 i 0.5)
+ (set! (v i) (+ (move-sound gen1 i 0.5)
(gen2 i 0.25)
(move-sound gen3 i 0.125))))
- (if (not (vequal v (make-vct 10 0.875)))
+ (if (not (vequal v (make-float-vector 10 0.875)))
(snd-display #__line__ ";move-sound output: ~A" v)))
(let ((var (catch #t (lambda () (make-move-sound (list 0 1000 1 0 (make-oscil 32) (make-env '(0 0 1 1) :length 1001)
@@ -24817,7 +19002,7 @@ EDITS: 2
(if (file-exists? "fmv2.snd") (delete-file "fmv2.snd"))
(mus-sound-prune))
- (let* ((vo (make-vct 1000))
+ (let* ((vo (make-float-vector 1000))
(gen1 (make-move-sound (list 0 1000 1 0
(make-delay 32)
(make-env '(0 0 1 1) :length 1001)
@@ -24828,18 +19013,18 @@ EDITS: 2
(vector 0 1))
vo))
(start -1))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(move-sound gen1 i 0.5)
(if (and (< start 0)
- (fneq (vct-ref vo i) 0.0))
+ (fneq (vo i) 0.0))
(set! start i)))
(if (not (= start 64))
- (snd-display #__line__ ";move-sound vct output start: ~A" start))
- (if (fneq (vct-peak vo) 0.484)
- (snd-display #__line__ ";move-sound vct output: ~A" (vct-peak vo))))
+ (snd-display #__line__ ";move-sound float-vector output start: ~A" start))
+ (if (fneq (float-vector-peak vo) 0.484)
+ (snd-display #__line__ ";move-sound float-vector output: ~A" (float-vector-peak vo))))
- (let* ((vo (make-sound-data 1 1000))
+ (let* ((vo (make-float-vector (list 1 1000) 0.0))
(gen1 (make-move-sound (list 0 1000 1 0
(make-delay 32)
(make-env '(0 0 1 1) :length 1001)
@@ -24850,20 +19035,18 @@ EDITS: 2
(vector 0 1))
vo))
(start -1))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(move-sound gen1 i 0.5)
(if (and (< start 0)
- (fneq (sound-data-ref vo 0 i) 0.0))
+ (fneq (vo 0 i) 0.0))
(set! start i)))
(if (not (= start 64))
(snd-display #__line__ ";move-sound sd output start: ~A" start))
- (if (fneq (sound-data-peak vo) 0.484)
- (snd-display #__line__ ";move-sound sd peak output: ~A" (sound-data-peak vo)))
- (if (fneq (apply max (sound-data-maxamp vo)) 0.484)
- (snd-display #__line__ ";move-sound sd output: ~A" (sound-data-maxamp vo))))
+ (if (fneq (maxamp vo) 0.484)
+ (snd-display #__line__ ";move-sound sd output: ~A" (maxamp vo))))
- (let* ((vo (make-vct 1000))
+ (let* ((vo (make-float-vector 1000))
(gen1 (make-move-sound (list 0 1000 1 0
(make-delay 32)
(make-env '(0 0 1 1) :length 1001)
@@ -24874,19 +19057,18 @@ EDITS: 2
(vector 0 1))
vo))
(start -1))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(move-sound gen1 i 0.5)
(if (and (< start 0)
- (> (abs (vct-ref vo i)) 0.001))
- (set! start i))))
+ (> (abs (vo i)) 0.001))
+ (set! start i)))
(if (not (= start 64))
- (snd-display #__line__ ";move-sound opt vct output start: ~A" start))
- (if (fneq (vct-peak vo) 0.484)
- (snd-display #__line__ ";move-sound opt vct output: ~A" (vct-peak vo))))
+ (snd-display #__line__ ";move-sound opt float-vector output start: ~A" start))
+ (if (fneq (float-vector-peak vo) 0.484)
+ (snd-display #__line__ ";move-sound opt float-vector output: ~A" (float-vector-peak vo))))
- (let* ((vo (make-sound-data 1 1000))
+ (let* ((vo (make-float-vector (list 1 1000) 0.0))
(gen1 (make-move-sound (list 0 1000 1 0
(make-delay 32)
(make-env '(0 0 1 1) :length 1001)
@@ -24897,44 +19079,16 @@ EDITS: 2
(vector 0 1))
vo))
(start -1))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(move-sound gen1 i 0.5)
(if (and (< start 0)
- (> (abs (sound-data-ref vo 0 i)) 0.001))
- (set! start i))))
+ (> (abs (vo 0 i)) 0.001))
+ (set! start i)))
(if (not (= start 64))
(snd-display #__line__ ";move-sound opt sd output start: ~A" start))
- (if (fneq (apply max (sound-data-maxamp vo)) 0.484)
- (snd-display #__line__ ";move-sound opt sd output: ~A" (sound-data-maxamp vo))))
-
-
- (let ((gen (make-src :srate 2.0))
- (v0 (make-vct 10))
- (rd (make-readin "oboe.snd" 0 2000))
- (gen1 (make-src :srate 2.0))
- (gen2 (make-src :srate 0.0)) ; make sure this is allowed
- (v1 (make-vct 10))
- (rd1a (make-readin "oboe.snd" 0 2000)))
- (print-and-check gen
- "src"
- "src width: 10, x: 0.000, incr: 2.000, sinc table len: 10000")
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v0 i (src gen 0.0 (lambda (dir) (readin rd)))))
- (vct-map! v1 (lambda () (if (src? gen1) (src gen1 0.0 (lambda (dir) (readin rd1a))))))
- (if (not (vequal v0 v1)) (snd-display #__line__ ";run src: ~A ~A" v0 v1))
- (if (not (src? gen)) (snd-display #__line__ ";~A not scr?" gen))
- (if (or (fneq (vct-ref v0 1) .001) (fneq (vct-ref v0 7) .021)) (snd-display #__line__ ";src output: ~A" v0))
- (if (fneq (mus-increment gen) 2.0) (snd-display #__line__ ";src increment: ~F?" (mus-increment gen)))
- (if (fneq (mus-increment gen2) 0.0) (snd-display #__line__ ";src 0.0 increment: ~F?" (mus-increment gen2)))
- (if (fneq (mus-increment rd) 1.0) (snd-display #__line__ ";readin increment: ~F?" (mus-increment rd)))
- (if (not (= (mus-length gen) 10)) (snd-display #__line__ ";src length: ~A" (mus-length gen)))
- (let ((gold gen))
- (set! gen (make-src (lambda (dir)
- 0.0)))
- (if (equal? gen gold) (snd-display #__line__ ";src eqaul? ~A ~A" gen gold))))
+ (if (fneq (maxamp vo) 0.484)
+ (snd-display #__line__ ";move-sound opt sd output: ~A" (maxamp vo))))
(let ((var (catch #t (lambda () (make-src :width -1)) (lambda args args))))
(if (not (eq? (car var) 'out-of-range))
@@ -24946,616 +19100,604 @@ EDITS: 2
(src s1 125.0)
(src s1 -25.0)
(src s1 -125.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(make-src (lambda (y) 1.0) 1.5 :width (+ 5 (* i 10))))
- (clear-sincs)
(let ((ctr 0.0))
- (let ((gen (make-src :srate 2.0 :input (lambda (dir) (let ((val ctr)) (set! ctr (+ 1 ctr)) val))))
- (v0 (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (let ((gen (make-src :srate 2.0 :input (lambda (dir) (let ((val ctr)) (set! ctr (+ ctr 1)) val))))
+ (v0 (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (src gen 0.0)))
+ (set! (v0 i) (src gen 0.0)))
(set! ctr 0.0) ; will be accessed within reset
(mus-reset gen)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (let ((old-val (vct-ref v0 i))
+ (let ((old-val (v0 i))
(new-val (src gen 0.0)))
(if (fneq old-val new-val)
(snd-display #__line__ ";reset src ~A ~A ~A" i old-val new-val))))))
- (let ((gen (make-granulate :expansion 2.0))
- (v0 (make-vct 1000))
- (rd (make-readin "oboe.snd" 0 4000 1 2048))
- (gen1 (make-granulate :expansion 2.0))
- (v1 (make-vct 1000))
- (rd1b (make-readin :file "oboe.snd" :channel 0 :start 4000 :direction 1 :size (mus-file-buffer-size))))
- (print-and-check gen
- "granulate"
- "granulate expansion: 2.000 (551/1102), scaler: 0.600, length: 0.150 secs (3308 samps), ramp: 0.060")
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (vct-set! v0 i (granulate gen (lambda (dir) (readin rd)))))
- (vct-map! v1 (lambda () (if (granulate? gen1) (granulate gen1 (lambda (dir) (readin rd1b))))))
- (let ((worst (abs (- (vct-peak v0) (vct-peak v1)))))
- (if (> worst .01) (snd-display #__line__ ";run granulate: ~A" worst)))
- (let ((genx gen1))
- (if (not (equal? genx gen1))
- (snd-display #__line__ ";granulate equal? ~A ~A ~A" genx gen1 (equal? genx gen1))))
- (if (equal? gen gen1) (snd-display #__line__ ";granulate equal? ~A ~A" gen gen1))
- (if (= (vct-peak v0) 0.0) (snd-display #__line__ ";granulate output peak: ~F?" (vct-peak v0)))
- (if (not (granulate? gen)) (snd-display #__line__ ";~A not granulate?" gen))
- (if (fneq (mus-increment gen) 2.0) (snd-display #__line__ ";granulate increment: ~F?" (mus-increment gen)))
- (if (fneq (mus-scaler gen) 0.6) (snd-display #__line__ ";granulate scaler: ~F?" (mus-scaler gen)))
- (if (ffneq (mus-frequency gen) 0.05) (snd-display #__line__ ";granulate frequency: ~F?" (mus-frequency gen)))
- (if (not (= (mus-ramp gen) 1323)) (snd-display #__line__ ";granulate ramp: ~F?" (mus-ramp gen)))
- (if (not (= (mus-length gen) 3308)) (snd-display #__line__ ";granulate length: ~A?" (mus-length gen)))
- (if (not (= (mus-hop gen) 1102)) (snd-display #__line__ ";granulate hop: ~A?" (mus-hop gen)))
- (set! (mus-hop gen) 1000) (if (not (= (mus-hop gen) 1000)) (snd-display #__line__ ";granulate set-hop: ~A?" (mus-hop gen)))
- (set! (mus-ramp gen) 1000) (if (not (= (mus-ramp gen) 1000)) (snd-display #__line__ ";granulate set-ramp: ~A?" (mus-ramp gen)))
- (set! (mus-length gen) 3000) (if (not (= (mus-length gen) 3000)) (snd-display #__line__ ";granulate set-length: ~A?" (mus-length gen)))
- (set! (mus-increment gen) 3.0)
- (if (> (abs (- (mus-increment gen) 3.0)) .01) (snd-display #__line__ ";granulate set-increment: ~F?" (mus-increment gen)))
- (set! (mus-increment gen) 0.0) ; should be a no-op
- (if (> (abs (- (mus-increment gen) 3.0)) .01) (snd-display #__line__ ";granulate set-increment 0.0: ~F?" (mus-increment gen)))
- (set! (mus-location gen) 1)
- (if (not (= (mus-location gen) 1)) (snd-display #__line__ ";mus-location grn: ~A" (mus-location gen)))
- (set! (mus-frequency gen) .1)
- (if (fneq (mus-frequency gen) .1) (snd-display #__line__ ";set granulate freq: ~A" (mus-frequency gen)))
- (let ((tag (catch #t (lambda () (granulate gen (lambda (a b) a))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity))
- (snd-display #__line__ ";granulate bad func: ~A" tag))))
- (let ((var (catch #t (lambda () (make-granulate :hop 35.0 :length 35.0)) (lambda args args))))
- (if (not (eq? (car var) 'out-of-range))
- (snd-display #__line__ ";make-granulate bad sizes: ~A" var)))
-
+ (let ()
+ (define (so1 s p)
+ (src s (env p)))
+
+ (let ((s1 (make-src :srate 2.0 :input (make-readin "oboe.snd" 0 10000)))
+ (s2 (make-src :srate 2.0 :input (make-readin "oboe.snd" 0 10000)))
+ (s3 (make-src :srate 2.0 :input (make-readin "oboe.snd" 0 10000)))
+ (e1 (make-env '(0 1 2 0.5) :duration 1000))
+ (e2 (make-env '(0 1 2 0.5) :duration 1000))
+ (e3 (make-env '(0 1 2 0.5) :duration 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((x1 (src s1 (env e1)))
+ (ex2 (env e2)))
+ (let ((x2 (src s2 ex2))
+ (x3 (so1 s3 e3)))
+ (if (not (= x1 x2 x3))
+ (format #t "~D ~A ~A ~A~%" i x1 x2 x3)))))))
+
+ (let ((gen (make-granulate :expansion 2.0 :input (make-readin "oboe.snd" 0 4000 1 2048)))
+ (v0 (make-float-vector 1000))
+ (v1 (make-float-vector 1000))
+ (rd1b (make-readin :file "oboe.snd" :channel 0 :start 4000 :direction 1 :size *clm-file-buffer-size*)))
+ (let ((gen1 (make-granulate :expansion 2.0
+ :input (lambda (dir) (readin rd1b)))))
+ (print-and-check gen
+ "granulate"
+ "granulate expansion: 2.000 (551/1102), scaler: 0.600, length: 0.150 secs (3308 samps), ramp: 0.060")
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (set! (v0 i) (granulate gen)))
+ (fill-float-vector v1 (if (granulate? gen1) (granulate gen1) -1.0))
+ (let ((worst (abs (- (float-vector-peak v0) (float-vector-peak v1)))))
+ (if (> worst .01) (snd-display #__line__ ";run granulate: ~A" worst)))
+ (let ((genx gen1))
+ (if (not (equal? genx gen1))
+ (snd-display #__line__ ";granulate equal? ~A ~A ~A" genx gen1 (equal? genx gen1))))
+ (if (equal? gen gen1) (snd-display #__line__ ";granulate equal? ~A ~A" gen gen1))
+ (if (= (float-vector-peak v0) 0.0) (snd-display #__line__ ";granulate output peak: ~F?" (float-vector-peak v0)))
+ (if (not (granulate? gen)) (snd-display #__line__ ";~A not granulate?" gen))
+ (if (fneq (mus-increment gen) 2.0) (snd-display #__line__ ";granulate increment: ~F?" (mus-increment gen)))
+ (if (fneq (mus-scaler gen) 0.6) (snd-display #__line__ ";granulate scaler: ~F?" (mus-scaler gen)))
+ (if (ffneq (mus-frequency gen) 0.05) (snd-display #__line__ ";granulate frequency: ~F?" (mus-frequency gen)))
+ (if (not (= (mus-ramp gen) 1323)) (snd-display #__line__ ";granulate ramp: ~F?" (mus-ramp gen)))
+ (if (not (= (mus-length gen) 3308)) (snd-display #__line__ ";granulate length: ~A?" (mus-length gen)))
+ (if (not (= (mus-hop gen) 1102)) (snd-display #__line__ ";granulate hop: ~A?" (mus-hop gen)))
+ (set! (mus-hop gen) 1000) (if (not (= (mus-hop gen) 1000)) (snd-display #__line__ ";granulate set-hop: ~A?" (mus-hop gen)))
+ (set! (mus-ramp gen) 1000) (if (not (= (mus-ramp gen) 1000)) (snd-display #__line__ ";granulate set-ramp: ~A?" (mus-ramp gen)))
+ (set! (mus-length gen) 3000) (if (not (= (mus-length gen) 3000)) (snd-display #__line__ ";granulate set-length: ~A?" (mus-length gen)))
+ (set! (mus-increment gen) 3.0)
+ (if (> (abs (- (mus-increment gen) 3.0)) .01) (snd-display #__line__ ";granulate set-increment: ~F?" (mus-increment gen)))
+ (set! (mus-increment gen) 0.0) ; should be a no-op
+ (if (> (abs (- (mus-increment gen) 3.0)) .01) (snd-display #__line__ ";granulate set-increment 0.0: ~F?" (mus-increment gen)))
+ (set! (mus-location gen) 1)
+ (if (not (= (mus-location gen) 1)) (snd-display #__line__ ";mus-location grn: ~A" (mus-location gen)))
+ (set! (mus-frequency gen) .1)
+ (if (fneq (mus-frequency gen) .1) (snd-display #__line__ ";set granulate freq: ~A" (mus-frequency gen))))
+ (let ((var (catch #t (lambda () (make-granulate :hop 35.0 :length 35.0)) (lambda args args))))
+ (if (not (eq? (car var) 'out-of-range))
+ (snd-display #__line__ ";make-granulate bad sizes: ~A" var))))
+
+ (let ((ind (new-sound :size 10)))
+ (set! (sample 2) .1)
+ (set! (sample 6) -.5)
+ (let ((rd (make-sampler)))
+ (let ((vals (map values rd)))
+ (if (not (morally-equal? vals '(0.0 0.0 0.1 0.0 0.0 0.0 -0.5 0.0 0.0 0.0)))
+ (snd-display #__line__ ";rd new: ~A" vals))))
+ (close-sound ind))
(let ((ind (open-sound "oboe.snd"))
(mx (maxamp)))
(let ((rd (make-sampler 0)))
+ (if (not (= (length rd) 50828))
+ (snd-display #__line__ ";sampler (oboe) length: ~A" (length rd)))
(let ((grn (make-granulate :expansion 2.0
- :input (lambda (dir) (rd))
+ :input (lambda (dir) (read-sample rd))
:edit (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (mus-length g))) ; current grain length
- (do ((i 0 (+ 1 i)))
- ((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 2 (vct-ref grain i))))
- 0)))))
+ (float-vector-scale! (mus-data g) 2.0)
+ 0))))
(map-channel (lambda (y) (granulate grn)))
(if (or (< (/ (maxamp) mx) 1.4) (> (/ mx (maxamp)) 2.5))
(snd-display #__line__ ";gran edit 2* (0): ~A ~A" mx (maxamp)))
(undo)))
(let ((rd (make-sampler 0)))
(let ((grn (make-granulate :expansion 2.0
- :input (lambda (dir) (rd))
+ :input (lambda (dir) (read-sample rd))
:edit (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (mus-length g))) ; current grain length
- (do ((i 0 (+ 1 i)))
- ((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 4 (vct-ref grain i))))
- 0)))))
+ (float-vector-scale! (mus-data g) 4.0)
+ 0))))
(map-channel (lambda (y) (granulate grn)))
(if (or (< (/ (maxamp) mx) 3.0) (> (/ mx (maxamp)) 6.0))
(snd-display #__line__ ";gran edit 4* (0): ~A ~A" mx (maxamp)))
(revert-sound ind)))
- (let ((grn (make-granulate :expansion 2.0
- :edit (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (mus-length g))) ; current grain length
- (do ((i 0 (+ 1 i)))
- ((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 2 (vct-ref grain i))))
- 0))))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
+ (let* ((rd (make-sampler 0))
+ (grn (make-granulate :expansion 2.0
+ :input (lambda (dir) (read-sample rd))
+ :edit (lambda (g)
+ (float-vector-scale! (mus-data g) 2.0)
+ 0))))
+ (map-channel (lambda (y) (granulate grn)))
(if (or (< (/ (maxamp) mx) 1.4) (> (/ mx (maxamp)) 2.5))
(snd-display #__line__ ";gran edit 2* (1): ~A ~A" mx (maxamp)))
(undo)
- (let ((grn (make-granulate :expansion 2.0
+ (let* ((rd (make-sampler 0))
+ (grn (make-granulate :expansion 2.0
:edit (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (mus-length g))) ; current grain length
- (do ((i 0 (+ 1 i)))
- ((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 4 (vct-ref grain i))))
- 0))))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
- (if (or (< (/ (maxamp) mx) 3.0) (> (/ mx (maxamp)) 6.0))
+ (float-vector-scale! (mus-data g) 4.0)
+ 0)
+ :input (lambda (dir) (read-sample rd)))))
+ (map-channel (lambda (y) (granulate grn)))
+ (if (or (< (/ (maxamp) mx) 2.9) (> (/ mx (maxamp)) 6.0))
(snd-display #__line__ ";gran edit 4* (1): ~A ~A" mx (maxamp)))
(revert-sound ind)))
- (let ((grn (make-granulate :expansion 2.0))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (granulate grn
- (lambda (dir)
- (rd))
- (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (mus-length g))) ; current grain length
- (do ((i 0 (+ 1 i)))
- ((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 2 (vct-ref grain i))))
- 0)))))
+ (let ((grn (make-granulate :expansion 2.0
+ :input (make-sampler 0)
+ :edit (lambda (g)
+ (float-vector-scale! (mus-data g) 2.0)
+ 0))))
+ (map-channel (lambda (y) (granulate grn)))
(if (or (< (/ (maxamp) mx) 1.4) (> (/ mx (maxamp)) 2.5))
(snd-display #__line__ ";gran edit 2* (2): ~A ~A" mx (maxamp)))
(undo)
- (let ((grn (make-granulate :expansion 2.0))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (granulate grn
- (lambda (dir)
- (rd))
- (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (mus-length g))) ; current grain length
- (do ((i 0 (+ 1 i)))
- ((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 4 (vct-ref grain i))))
- 0)))))
+ (let* ((rd (make-sampler 0))
+ (grn (make-granulate :expansion 2.0
+ :input (lambda (dir) (read-sample rd))
+ :edit (lambda (g) (float-vector-scale! (mus-data g) 4.0) 0))))
+ (map-channel (lambda (y) (granulate grn)))
(if (or (< (/ (maxamp) mx) 3.0) (> (/ mx (maxamp)) 6.0))
(snd-display #__line__ ";gran edit 4* (2): ~A ~A" mx (maxamp)))))
(close-sound ind))
(let ((ind (open-sound "oboe.snd")))
- (let ((grn (make-granulate :expansion 2.0 :length .01 :hop .05))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
+ (let* ((rd (make-sampler 0))
+ (grn (make-granulate :expansion 2.0 :length .01 :hop .05 :input (lambda (dir) (next-sample rd)))))
+ (map-channel (lambda (y) (granulate grn)))
(let ((mx (maxamp)))
(if (> mx .2) (snd-display #__line__ ";trouble in granulate len .01 hop .05: ~A" mx))
(undo)))
- (let ((grn (make-granulate :expansion 2.0 :length .04 :hop .05))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
+ (let* ((rd (make-sampler 0))
+ (grn (make-granulate :expansion 2.0 :length .04 :hop .05 :input (lambda (dir) (next-sample rd)))))
+ (map-channel (lambda (y) (granulate grn)))
(let ((mx (maxamp)))
(if (> mx .2) (snd-display #__line__ ";trouble in granulate len .04 hop .05: ~A" mx))
(undo)))
- (let ((grn (make-granulate :expansion 2.0 :length .01 :hop .25))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
+ (let* ((rd (make-sampler 0))
+ (grn (make-granulate :expansion 2.0 :length .01 :hop .25 :input (lambda (dir) (next-sample rd)))))
+ (map-channel (lambda (y) (granulate grn)))
(let ((mx (maxamp)))
(if (> mx .2) (snd-display #__line__ ";trouble in granulate len .01 hop .25: ~A" mx))
(undo)))
- (let ((grn (make-granulate :expansion 2.0 :length .4 :hop .5))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (granulate grn (lambda (dir) (rd)))))
+ (let* ((rd (make-sampler 0))
+ (grn (make-granulate :expansion 2.0 :length .4 :hop .5 :input (lambda (dir) (next-sample rd)))))
+ (map-channel (lambda (y) (granulate grn)))
(let ((mx (maxamp)))
(if (> mx .2) (snd-display #__line__ ";trouble in granulate len .4 hop .5: ~A" mx))
(undo)))
(close-sound ind))
(let ((ind (new-sound :size 1000)))
- (let ((gen (make-granulate :jitter 0.0 :hop .004 :length .001)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";gran 0 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 0 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 85 30)
- (vct 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060
+ (snd-display #__line__ ";gran 0 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 85 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060
0.060 0.060 0.053 0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 0 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 0 data 85: ~A" (channel->float-vector 85 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";gran 1 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060 0.060 0.060 0.060 0.053
0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 1 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 40 30)
- (vct 0.000 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060
+ (snd-display #__line__ ";gran 1 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 40 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.000 0.007 0.013 0.020 0.027 0.033 0.040 0.047 0.053 0.060 0.060 0.060
0.060 0.060 0.060 0.053 0.047 0.040 0.033 0.027 0.020 0.013 0.007 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 1 data 40: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 1 data 40: ~A" (channel->float-vector 85 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp .1)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp .1 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";gran 2 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.030 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 2 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 40 30)
- (vct 0.000 0.000 0.000 0.000 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (snd-display #__line__ ";gran 2 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 40 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.000 0.030 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.030 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 2 data 40: ~A" (channel->vct 40 30)))
+ (snd-display #__line__ ";gran 2 data 40: ~A" (channel->float-vector 40 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp .5)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp .5 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";gran 3 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 3 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 85 30)
- (vct 0.000 0.000 0.000 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
+ (snd-display #__line__ ";gran 3 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 85 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
0.055 0.049 0.044 0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 3 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 3 data 85: ~A" (channel->float-vector 85 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .001 :ramp .5)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .001 :ramp .5 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";gran 4 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060 0.055 0.049 0.044
0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022 0.027 0.033 0.038)))
- (snd-display #__line__ ";gran 4 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 85 30)
- (vct 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
+ (snd-display #__line__ ";gran 4 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 85 30)
+ (float-vector 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022 0.027 0.033 0.038 0.044 0.049 0.055 0.060 0.060
0.055 0.049 0.044 0.038 0.033 0.027 0.022 0.016 0.011 0.005 0.005 0.011 0.016 0.022)))
- (snd-display #__line__ ";gran 4 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 4 data 85: ~A" (channel->float-vector 85 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .001 :ramp .25 :scaler 1.0)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .001 :ramp .25 :scaler 1.0 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display #__line__ ";gran 5 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080 0.100 0.100 0.100)))
- (snd-display #__line__ ";gran 5 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 85 30)
- (vct 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
+ (snd-display #__line__ ";gran 5 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 85 30)
+ (float-vector 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.080 0.060 0.040 0.020 0.020 0.040 0.060 0.080)))
- (snd-display #__line__ ";gran 5 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 5 data 85: ~A" (channel->float-vector 85 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .002 :ramp .5 :scaler 1.0)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .002 :ramp .5 :scaler 1.0 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.105) (snd-display #__line__ ";gran 6 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.005 0.009 0.014 0.018 0.023 0.027 0.032 0.036 0.041 0.045 0.050 0.055 0.059 0.064 0.068
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.005 0.009 0.014 0.018 0.023 0.027 0.032 0.036 0.041 0.045 0.050 0.055 0.059 0.064 0.068
0.073 0.077 0.082 0.086 0.091 0.095 0.100 0.105 0.105 0.105 0.105 0.105 0.105 0.105)))
- (snd-display #__line__ ";gran 6 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 85 30)
- (vct 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105
+ (snd-display #__line__ ";gran 6 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 85 30)
+ (float-vector 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105
0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105 0.105)))
- (snd-display #__line__ ";gran 6 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 6 data 85: ~A" (channel->float-vector 85 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .005 :ramp .5 :scaler 1.0)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .005 :ramp .5 :scaler 1.0 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.264) (snd-display #__line__ ";gran 7 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
- (snd-display #__line__ ";gran 7 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 85 30)
- (vct 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
+ (snd-display #__line__ ";gran 7 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 85 30)
+ (float-vector 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
- (snd-display #__line__ ";gran 7 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 7 data 85: ~A" (channel->float-vector 85 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 2.0)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 2.0 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display #__line__ ";gran 8 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 8 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 220 30)
- (vct 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
+ (snd-display #__line__ ";gran 8 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 220 30)
+ (float-vector 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 8 data 220: ~A" (channel->vct 220 30)))
+ (snd-display #__line__ ";gran 8 data 220: ~A" (channel->float-vector 220 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display #__line__ ";gran 9 max: ~A" mx))) ; same as 8 because expansion hits the input counter
- (if (not (vequal (channel->vct 0 30)
- (vct 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 9 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 220 30)
- (vct 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
+ (snd-display #__line__ ";gran 9 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 220 30)
+ (float-vector 0.000 0.009 0.018 0.027 0.036 0.045 0.055 0.064 0.073 0.082 0.091 0.100 0.100 0.091 0.082 0.073
0.064 0.055 0.045 0.036 0.027 0.018 0.009 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 9 data 220: ~A" (channel->vct 220 30)))
+ (snd-display #__line__ ";gran 9 data 220: ~A" (channel->float-vector 220 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .005 :ramp .5 :scaler 1.0)))
- (map-channel (lambda (y) (granulate gen
- (lambda (dir) .1)
- (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (mus-length g))) ; current grain length
- (do ((i 0 (+ 1 i)))
- ((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 2 (vct-ref grain i)))))
- 0))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .001 :length .005 :ramp .5 :scaler 1.0
+ :input (lambda (dir) .1)
+ :edit (lambda (g)
+ (float-vector-scale! (mus-data g) 2.0)
+ 0))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx (* 2 0.264)) (snd-display #__line__ ";gran 10 max: ~A" mx)))
- (if (not (vequal (vct-scale! (channel->vct 0 30) 0.5)
- (vct 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
+ (if (not (vequal (float-vector-scale! (channel->float-vector 0 30) 0.5)
+ (float-vector 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
- (snd-display #__line__ ";gran 10 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (vct-scale! (channel->vct 85 30) 0.5)
- (vct 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
+ (snd-display #__line__ ";gran 10 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (float-vector-scale! (channel->float-vector 85 30) 0.5)
+ (float-vector 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
- (snd-display #__line__ ";gran 10 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 10 data 85: ~A" (channel->float-vector 85 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .005 :length .002 :ramp 0.0 :scaler 1.0))
- (forward #t)
+ (let ((forward #t)
(ctr -0.5)
(incr .001))
- (map-channel (lambda (y) (granulate gen
- (lambda (dir) (set! ctr (+ ctr incr)) ctr)
- (lambda (g)
- (let ((grain (mus-data g))
- (len (mus-length g)))
- (if forward ; no change to data
- (set! forward #f)
- (begin
- (set! forward #t)
- (vct-reverse! grain len))) ; should get ramps going up then down across overall rising ramp
- len)))))
+ (let ((f1 (lambda (dir)
+ (set! ctr (+ ctr incr))))
+ (f2 (lambda (g)
+ (if forward ; no change to data
+ (set! forward #f)
+ (let ((len (mus-length g)))
+ (let ((grain (make-shared-vector (mus-data g) (list len))))
+ (set! forward #t)
+ (reverse! grain)))) ; should get ramps going up then down across overall rising ramp
+ (mus-length g))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .005 :length .002 :ramp 0.0 :scaler 1.0 :input f1 :edit f2)))
+ (map-channel (lambda (y) (granulate gen)))))
(let ((mx (maxamp)))
(if (> mx 0.6) (snd-display #__line__ ";gran 11 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
- (snd-display #__line__ ";gran 11 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 100 30)
- (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
+ (snd-display #__line__ ";gran 11 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 100 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
-0.350 -0.351 -0.352 -0.353 -0.354 -0.355 -0.356 -0.357 -0.358 -0.359 -0.360 -0.361 -0.362 -0.363 -0.364)))
- (snd-display #__line__ ";gran 11 data 100: ~A" (channel->vct 100 30)))
+ (snd-display #__line__ ";gran 11 data 100: ~A" (channel->float-vector 100 30)))
(undo))
- (let* ((forward #t)
- (ctr -0.5)
+ (let* ((ctr -0.5)
(incr .001)
(gen (make-granulate :jitter 0.0 :hop .005 :length .002 :ramp 0.0 :scaler 1.0
- :input (lambda (dir) (set! ctr (+ ctr incr)) ctr))))
+ :input (lambda (dir) (set! ctr (+ ctr incr))))))
(map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (> mx 0.6) (snd-display #__line__ ";gran 12 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
- (snd-display #__line__ ";gran 12 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 100 30)
- (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.389 -0.388 -0.387 -0.386 -0.385
+ (snd-display #__line__ ";gran 12 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 100 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.389 -0.388 -0.387 -0.386 -0.385
-0.384 -0.383 -0.382 -0.381 -0.380 -0.379 -0.378 -0.377 -0.376 -0.375 -0.374 -0.373 -0.372 -0.371 -0.370)))
- (snd-display #__line__ ";gran 12 data 100: ~A" (channel->vct 100 30)))
+ (snd-display #__line__ ";gran 12 data 100: ~A" (channel->float-vector 100 30)))
(undo))
(let ((gen (make-granulate :jitter 0.0 :hop .001 :length .005 :ramp .5 :scaler 1.0
:input (lambda (dir) .1)
:edit (lambda (g)
- (let ((grain (mus-data g)) ; current grain
- (len (mus-length g))) ; current grain length
- (do ((i 0 (+ 1 i)))
- ((= i len) len) ; grain length unchanged in this case
- (vct-set! grain i (* 2 (vct-ref grain i)))))
+ (float-vector-scale! (mus-data g) 2.0)
0))))
(map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (> mx .6) (snd-display #__line__ ";gran 13 max: ~A" mx)))
- (if (not (vequal (vct-scale! (channel->vct 0 30) 0.5)
- (vct 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
+ (if (not (vequal (float-vector-scale! (channel->float-vector 0 30) 0.5)
+ (float-vector 0.000 0.002 0.004 0.005 0.007 0.009 0.011 0.013 0.015 0.016 0.018 0.020 0.022 0.024 0.025 0.027
0.029 0.031 0.033 0.035 0.036 0.038 0.040 0.044 0.047 0.051 0.055 0.058 0.062 0.065)))
- (snd-display #__line__ ";gran 13 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (vct-scale! (channel->vct 85 30) 0.5)
- (vct 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
+ (snd-display #__line__ ";gran 13 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (float-vector-scale! (channel->float-vector 85 30) 0.5)
+ (float-vector 0.244 0.244 0.244 0.244 0.245 0.247 0.249 0.251 0.253 0.255 0.256 0.258 0.260 0.262 0.264 0.264
0.262 0.260 0.258 0.256 0.255 0.253 0.251 0.249 0.247 0.245 0.245 0.247 0.249 0.251)))
- (snd-display #__line__ ";gran 13 data 85: ~A" (channel->vct 85 30)))
+ (snd-display #__line__ ";gran 13 data 85: ~A" (channel->float-vector 85 30)))
(undo))
(let* ((forward #t)
(ctr -0.5)
(incr .001)
(gen (make-granulate :jitter 0.0 :hop .005 :length .002 :ramp 0.0 :scaler 1.0
- :input (lambda (dir) (set! ctr (+ ctr incr)) ctr)
+ :input (lambda (dir) (set! ctr (+ ctr incr)))
:edit (lambda (g)
- (let ((grain (mus-data g))
- (len (mus-length g)))
- (if forward
- (set! forward #f)
- (begin
+ (if forward
+ (set! forward #f)
+ (let ((len (mus-length g)))
+ (let ((grain (make-shared-vector (mus-data g) (list len))))
(set! forward #t)
- (vct-reverse! grain len)))
- len)))))
+ (reverse! grain))))
+ (mus-length g)))))
(map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (> mx 0.6) (snd-display #__line__ ";gran 14 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector -0.499 -0.498 -0.497 -0.496 -0.495 -0.494 -0.493 -0.492 -0.491 -0.490 -0.489 -0.488 -0.487 -0.486
-0.485 -0.484 -0.483 -0.482 -0.481 -0.480 -0.479 -0.478 -0.477 -0.476 -0.475 -0.474 -0.473 -0.472 -0.471 -0.470)))
- (snd-display #__line__ ";gran 14 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 100 30)
- (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
+ (snd-display #__line__ ";gran 14 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 100 30)
+ (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 -0.345 -0.346 -0.347 -0.348 -0.349
-0.350 -0.351 -0.352 -0.353 -0.354 -0.355 -0.356 -0.357 -0.358 -0.359 -0.360 -0.361 -0.362 -0.363 -0.364)))
- (snd-display #__line__ ";gran 14 data 100: ~A" (channel->vct 100 30)))
+ (snd-display #__line__ ";gran 14 data 100: ~A" (channel->float-vector 100 30)))
(undo))
- (let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0))
+ (let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0 :input (lambda (dir) .1)))
(e (make-env '(0 0 1 .5) :length 1001))
(base-ramp-len (mus-length gen)))
(map-channel
(lambda (y)
- (let ((result (granulate gen (lambda (dir) .1))))
+ (let ((result (granulate gen)))
(set! (mus-ramp gen) (round (* base-ramp-len (env e))))
result)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";granf 0 max: ~A" mx)))
(if (> (abs (- (mus-ramp gen) (* .5 (mus-length gen)))) 1)
(snd-display #__line__ ";granf 0 ramp: ~A ~A" (mus-ramp gen) (mus-length gen)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 0 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 440 30)
- (vct 0.000 0.012 0.024 0.036 0.048 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (snd-display #__line__ ";granf 0 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.000 0.012 0.024 0.036 0.048 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.048 0.036 0.024 0.012 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 0 data 440: ~A" (channel->vct 440 30)))
- (if (not (vequal (channel->vct 880 30)
- (vct 0.000 0.006 0.012 0.018 0.024 0.030 0.036 0.042 0.048 0.054 0.060 0.060 0.060 0.060
+ (snd-display #__line__ ";granf 0 data 440: ~A" (channel->float-vector 440 30)))
+ (if (not (vequal (channel->float-vector 880 30)
+ (float-vector 0.000 0.006 0.012 0.018 0.024 0.030 0.036 0.042 0.048 0.054 0.060 0.060 0.060 0.060
0.054 0.048 0.042 0.036 0.030 0.024 0.018 0.012 0.006 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 0 data 880: ~A" (channel->vct 880 30)))
+ (snd-display #__line__ ";granf 0 data 880: ~A" (channel->float-vector 880 30)))
(undo))
- (let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0))
+ (let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0 :input (lambda (dir) .1)))
(e (make-env '(0 1 1 .25) :length 1001))
(base-hop-len (mus-hop gen)))
(map-channel
(lambda (y)
- (let ((result (granulate gen (lambda (dir) .1))))
+ (let ((result (granulate gen)))
(set! (mus-hop gen) (round (* base-hop-len (env e))))
result)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";granf 1 max: ~A" mx)))
- (if (> (abs (- (mus-hop gen) (* .001 (mus-srate)))) 1)
- (snd-display #__line__ ";granf 1 hop: ~A ~A, ~A ~A" (mus-hop gen) (abs (- (mus-hop gen) (* .001 (srate)))) (srate) (mus-srate)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (if (> (abs (- (mus-hop gen) (* .001 *clm-srate*))) 1)
+ (snd-display #__line__ ";granf 1 hop: ~A ~A, ~A ~A" (mus-hop gen) (abs (- (mus-hop gen) (* .001 (srate)))) (srate) *clm-srate*))
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 1 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 900 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
+ (snd-display #__line__ ";granf 1 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 900 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
0.000 0.000 0.000 0.000 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
- (snd-display #__line__ ";granf 1 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";granf 1 data 900: ~A" (channel->float-vector 900 30)))
(undo))
- (let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0))
+ (let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0 :input (lambda (dir) .1)))
(e (make-env '(0 1 1 .25) :length 1001))
(base-freq (mus-frequency gen)))
(map-channel
(lambda (y)
- (let ((result (granulate gen (lambda (dir) .1))))
+ (let ((result (granulate gen)))
(set! (mus-frequency gen) (* base-freq (env e)))
result)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";granf 2 max: ~A" mx)))
- (if (> (abs (- (mus-hop gen) (* .001 (mus-srate)))) 1)
+ (if (> (abs (- (mus-hop gen) (* .001 *clm-srate*))) 1)
(snd-display #__line__ ";granf 2 hop: ~A" (mus-hop gen)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 2 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 900 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.060 0.060 0.060
+ (snd-display #__line__ ";granf 2 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 900 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
- (snd-display #__line__ ";granf 2 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";granf 2 data 900: ~A" (channel->float-vector 900 30)))
(undo))
- (let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp 0.0 :scaler 1.0)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .002 :length .001 :ramp 0.0 :scaler 1.0 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display #__line__ ";granf 3 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";gran 3 data: ~A" (channel->vct 0 30)))
+ (snd-display #__line__ ";gran 3 data: ~A" (channel->float-vector 0 30)))
(undo))
- (let* ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0 :scaler 1.0))
- (e (make-env '(0 1 1 0.0) :length 1001)))
+ (let ((gen (make-granulate :jitter 0.0 :hop .004 :length .001 :ramp 0.0 :scaler 1.0 :input (lambda (dir) .1)))
+ (e (make-env '(0 1 1 0.0) :length 1001)))
(map-channel
(lambda (y)
- (let ((result (granulate gen (lambda (dir) .1))))
+ (let ((result (granulate gen)))
(set! (mus-scaler gen) (env e))
result)))
(let ((mx (maxamp)))
(if (fneq mx 0.1) (snd-display #__line__ ";granf 4 max: ~A" mx)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100
0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.100 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 4 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 440 30)
- (vct 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056
+ (snd-display #__line__ ";granf 4 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056
0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.056 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 4 data 440: ~A" (channel->vct 440 30)))
- (if (not (vequal (channel->vct 900 30)
- (vct 0.012 0.012 0.012 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ (snd-display #__line__ ";granf 4 data 440: ~A" (channel->float-vector 440 30)))
+ (if (not (vequal (channel->float-vector 900 30)
+ (float-vector 0.012 0.012 0.012 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 4 data 900: ~A" (channel->vct 900 30)))
+ (snd-display #__line__ ";granf 4 data 900: ~A" (channel->float-vector 900 30)))
(undo))
- (let* ((gen (make-granulate :jitter 0.0 :hop .006 :length .001 :ramp 0.0 :max-size 2200))
+ (let* ((gen (make-granulate :jitter 0.0 :hop .006 :length .001 :ramp 0.0 :max-size 2200 :input (lambda (dir) .1)))
(e (make-env '(0 1 1 5) :length 1001))
(base-len (mus-length gen)))
(map-channel
(lambda (y)
- (let ((result (granulate gen (lambda (dir) .1))))
+ (let ((result (granulate gen)))
(set! (mus-length gen) (round (* base-len (env e))))
result)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";granf 5 max: ~A" mx)))
(if (> (abs (- (mus-length gen) (* 5 base-len))) 10)
(snd-display #__line__ ";granf 5 length: ~A ~A" (mus-length gen) (* 5 base-len)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 5 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 440 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (snd-display #__line__ ";granf 5 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 440 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 5 data 440: ~A" (channel->vct 440 30)))
- (if (not (vequal (channel->vct 800 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (snd-display #__line__ ";granf 5 data 440: ~A" (channel->float-vector 440 30)))
+ (if (not (vequal (channel->float-vector 800 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
- (snd-display #__line__ ";granf 5 data 800: ~A" (channel->vct 800 30)))
+ (snd-display #__line__ ";granf 5 data 800: ~A" (channel->float-vector 800 30)))
(undo))
- (let* ((gen (make-granulate :jitter 0.0 :hop .006 :length .005 :ramp 0.0 :max-size 2200))
+ (let* ((gen (make-granulate :jitter 0.0 :hop .006 :length .005 :ramp 0.0 :max-size 2200 :input (lambda (dir) .1)))
(e (make-env '(0 1 1 .2) :length 1001))
(base-len (mus-length gen)))
(map-channel
(lambda (y)
- (let ((result (granulate gen (lambda (dir) .1))))
+ (let ((result (granulate gen)))
(set! (mus-length gen) (round (* base-len (env e))))
result)))
(let ((mx (maxamp)))
(if (fneq mx 0.06) (snd-display #__line__ ";granf 6 max: ~A" mx)))
(if (> (abs (- (mus-length gen) (* .2 base-len))) 4)
(snd-display #__line__ ";granf 6 length: ~A ~A" (mus-length gen) (* .2 base-len)))
- (if (not (vequal (channel->vct 0 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
+ (if (not (vequal (channel->float-vector 0 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060
0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060)))
- (snd-display #__line__ ";granf 6 data: ~A" (channel->vct 0 30)))
- (if (not (vequal (channel->vct 820 30)
- (vct 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
+ (snd-display #__line__ ";granf 6 data: ~A" (channel->float-vector 0 30)))
+ (if (not (vequal (channel->float-vector 820 30)
+ (float-vector 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.060 0.000 0.000
0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";granf 6 data 820: ~A" (channel->vct 820 30)))
+ (snd-display #__line__ ";granf 6 data 820: ~A" (channel->float-vector 820 30)))
(undo))
(let ((max-list (lambda ()
- (let ((pts '())
+ (let ((pts ())
(samp 0)
(lasty 0.0))
(scan-channel (lambda (y)
- (if (and (not (>= lasty 0.1))
+ (if (and (< lasty 0.1)
(>= y .1))
(set! pts (cons samp pts)))
(set! lasty y)
- (set! samp (+ 1 samp))
+ (set! samp (+ samp 1))
#f))
(reverse pts)))))
- (let ((gen (make-granulate :jitter 0.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((vals (max-list)))
(if (not (equal? vals (list 11 231 451 671 891)))
(snd-display #__line__ ";grn jitter 0 max: ~A" vals)))
(undo))
(let ((oldvals #f))
- (let ((gen (make-granulate :jitter 0.3 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.3 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
;; (11 232 490 736 982) or whatever
(let ((vals (max-list)))
(if (equal? vals (list 11 231 451 671 891))
@@ -25563,8 +19705,8 @@ EDITS: 2
(set! oldvals vals))
(undo))
- (let ((gen (make-granulate :jitter 0.3 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5)))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (let ((gen (make-granulate :jitter 0.3 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5 :input (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((vals (max-list)))
(if (equal? vals oldvals)
(snd-display #__line__ ";grn jitter 0.3 max: ~A ~A" vals oldvals)))
@@ -25572,15 +19714,15 @@ EDITS: 2
(let ((oldvals #f)
(seed 0))
- (let ((gen (make-granulate :jitter 1.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5)))
+ (let ((gen (make-granulate :jitter 1.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5 :input (lambda (dir) .1))))
(set! seed (mus-location gen))
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(set! oldvals (max-list))
(undo))
- (let ((gen (make-granulate :jitter 1.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5)))
+ (let ((gen (make-granulate :jitter 1.0 :hop .01 :length .001 :ramp .5 :scaler 1.0 :expansion 0.5 :input (lambda (dir) .1))))
(set! (mus-location gen) seed)
- (map-channel (lambda (y) (granulate gen (lambda (dir) .1))))
+ (map-channel (lambda (y) (granulate gen)))
(let ((vals (max-list)))
(if (not (equal? vals oldvals))
(snd-display #__line__ ";grn jitter 1.0 max with seed: ~A ~A" vals oldvals)))
@@ -25589,15 +19731,16 @@ EDITS: 2
(let ((fname (file-name ind)))
(close-sound ind)
(delete-file fname)
- (if (view-files-dialog #f)
+ (if (and with-motif
+ (view-files-dialog #f))
(begin
- (set! (view-files-files (view-files-dialog #f)) '())
- (if (not (null? (view-files-files (view-files-dialog #f))))
+ (set! (view-files-files (view-files-dialog #f)) ())
+ (if (pair? (view-files-files (view-files-dialog #f)))
(snd-display #__line__ ";set vf files list null: ~A" (view-files-files (view-files-dialog #f)))))))
)
;; granulate with jitter=0, small hop (comb filter effect)
- (let ((ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1 :size 10000)))
+ (let ((ind (new-sound "tmp.snd" 1 22050 mus-ldouble mus-next :size 10000)))
(let ((gen (make-granulate :expansion 20.0
:input (lambda (dir) .01)
:length .00995
@@ -25636,12 +19779,9 @@ EDITS: 2
(if minval (snd-display #__line__ ";granulate stable 3 min: ~A ~A" minval (sample (cadr minval)))))
(undo)
- (let ((ctr 0))
+ (let ((ctr -0.0001))
(set! gen (make-granulate :expansion 2.0
- :input (lambda (dir)
- (let ((val (* ctr .0001)))
- (set! ctr (+ 1 ctr))
- val))
+ :input (lambda (dir) (set! ctr (+ ctr .0001)))
:length .01
:hop .1
:ramp 0.0
@@ -25649,34 +19789,31 @@ EDITS: 2
:jitter 0.0))
(clm-channel gen)
(if (fneq (maxamp) .462) (snd-display #__line__ ";granulate ramped 4: ~A" (maxamp)))
- (let ((vals (count-matches (lambda (y) (not (= y 0.0))))))
+ (let ((vals (count-matches (lambda (y) (> (abs y) 0.0)))))
(if (> (abs (- vals 1104)) 10) (snd-display #__line__ ";granulate ramped 4 not 0.0: ~A" vals)))
- (if (or (not (vequal (channel->vct 2203 10)
- (vct 0.000 0.000 0.110 0.110 0.110 0.111 0.111 0.111 0.111 0.111)))
- (not (vequal (channel->vct 4523 10)
- (vct 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.233 0.233)))
- (not (vequal (channel->vct 8928 10)
- (vct 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452))))
+ (if (or (not (vequal (channel->float-vector 2203 10)
+ (float-vector 0.000 0.000 0.110 0.110 0.110 0.111 0.111 0.111 0.111 0.111)))
+ (not (vequal (channel->float-vector 4523 10)
+ (float-vector 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.232 0.233 0.233)))
+ (not (vequal (channel->float-vector 8928 10)
+ (float-vector 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452 0.452))))
(snd-display #__line__ ";granulate ramped 4 data off: ~A ~A ~A"
- (channel->vct 2203 10) (channel->vct 4523 10) (channel->vct 8928 10)))
+ (channel->float-vector 2203 10) (channel->float-vector 4523 10) (channel->float-vector 8928 10)))
(undo)
- (set! ctr 0)
- (set! gen (make-granulate :expansion 2.0
- :input (lambda (dir)
- (let ((val (* ctr .0001)))
- (set! ctr (+ 1 ctr))
- val))
- :length .00995
- :hop .01
- :ramp 0.0
- :scaler 1.0
- :jitter 0.0))
+ (let ((e (make-env '(0 0 1 1) :length 10000)))
+ (set! gen (make-granulate :expansion 2.0
+ :input (lambda (dir) (env e))
+ :length .00995
+ :hop .01
+ :ramp 0.0
+ :scaler 1.0
+ :jitter 0.0)))
(clm-channel gen)
(if (fneq (maxamp) .505) (snd-display #__line__ ";granulate ramped 5: ~A" (maxamp)))
(let* ((mxoff 0.0)
(mx (maxamp))
- (len (frames))
+ (len (framples))
(cur 0.0)
(incr (/ mx len)))
(scan-channel (lambda (y)
@@ -25687,64 +19824,55 @@ EDITS: 2
(if (> mxoff .02) (snd-display #__line__ ";granulate ramped 5 mxoff: ~A" mxoff))) ; .0108 actually
(undo)
- (set! ctr 0)
+ (let ((e (make-env '(0 0 1 1) :length 10000)))
(set! gen (make-granulate :expansion 2.0
- :input (lambda (dir)
- (let ((val (* ctr .0001)))
- (set! ctr (+ 1 ctr))
- val))
+ :input (lambda (dir) (env e))
:length .00995
:hop .01
:ramp 0.5
:scaler 1.0
- :jitter 0.0))
+ :jitter 0.0)))
(clm-channel gen)
(if (fneq (maxamp) .495) (snd-display #__line__ ";granulate ramped 6: ~A" (maxamp)))
- (if (or (not (vequal (channel->vct 2000 10)
- (vct 0.018 0.019 0.020 0.021 0.022 0.023 0.024 0.025 0.026 0.027)))
- (not (vequal (channel->vct 8000 10)
- (vct 0.294 0.298 0.301 0.305 0.309 0.313 0.316 0.320 0.324 0.328))))
+ (if (or (not (vequal (channel->float-vector 2000 10)
+ (float-vector 0.018 0.019 0.020 0.021 0.022 0.023 0.024 0.025 0.026 0.027)))
+ (not (vequal (channel->float-vector 8000 10)
+ (float-vector 0.294 0.298 0.301 0.305 0.309 0.313 0.316 0.320 0.324 0.328))))
(snd-display #__line__ ";granulate ramped 6 data: ~A ~A"
- (channel->vct 2000 10) (channel->vct 8000 10)))
+ (channel->float-vector 2000 10) (channel->float-vector 8000 10)))
(undo)
- (set! ctr 0)
+ (let ((e (make-env '(0 0 1 1) :length 10000)))
(set! gen (make-granulate :expansion 2.0
- :input (lambda (dir)
- (let ((val (* ctr .0001)))
- (set! ctr (+ 1 ctr))
- val))
+ :input (lambda (dir) (env e))
:length .00995
:hop .01
:ramp 0.25
:scaler 1.0
- :jitter 0.0))
+ :jitter 0.0)))
(clm-channel gen)
(if (fneq (maxamp) .505) (snd-display #__line__ ";granulate ramped 7: ~A" (maxamp)))
- (if (or (not (vequal (channel->vct 2000 10)
- (vct 0.037 0.039 0.040 0.042 0.044 0.046 0.048 0.050 0.052 0.054)))
- (not (vequal (channel->vct 8000 10)
- (vct 0.404 0.404 0.404 0.404 0.404 0.405 0.405 0.405 0.405 0.405))))
+ (if (or (not (vequal (channel->float-vector 2000 10)
+ (float-vector 0.037 0.039 0.040 0.042 0.044 0.046 0.048 0.050 0.052 0.054)))
+ (not (vequal (channel->float-vector 8000 10)
+ (float-vector 0.404 0.404 0.404 0.404 0.404 0.405 0.405 0.405 0.405 0.405))))
(snd-display #__line__ ";granulate ramped 7 data: ~A ~A"
- (channel->vct 2000 10) (channel->vct 8000 10)))
+ (channel->float-vector 2000 10) (channel->float-vector 8000 10)))
(undo)
- (set! ctr 0)
+ (let ((e (make-env '(0 0 1 1) :length 10000)))
(set! gen (make-granulate :expansion 2.0
- :input (lambda (dir)
- (let ((val (* ctr .0001)))
- (set! ctr (+ 1 ctr))
- val))
+ :input (lambda (dir) (env e))
:length .05
:hop .01
:ramp 0.25
:scaler 0.1
- :jitter 0.0))
+ :jitter 0.0)))
(clm-channel gen)
(if (fneq (maxamp) .201) (snd-display #__line__ ";granulate ramped 7: ~A" (maxamp)))
(let* ((mxoff 0.0)
(mx (maxamp))
- (len (frames))
+ (len (framples))
(cur 0.0)
(incr (/ mx len)))
(scan-channel (lambda (y)
@@ -25755,22 +19883,19 @@ EDITS: 2
(if (> mxoff .01) (snd-display #__line__ ";granulate ramped 7 mxoff: ~A" mxoff))) ; .0097 actually
(undo)
- (set! ctr 0)
+ (let ((e (make-env '(0 0 1 1) :length 10000)))
(set! gen (make-granulate :expansion 2.0
- :input (lambda (dir)
- (let ((val (* ctr .0001)))
- (set! ctr (+ 1 ctr))
- val))
+ :input (lambda (dir) (env e))
:length .1
:hop .01
:ramp 0.1
:scaler 0.1
- :jitter 0.0))
+ :jitter 0.0)))
(clm-channel gen)
(if (fneq (maxamp) .501) (snd-display #__line__ ";granulate ramped 8: ~A" (maxamp)))
(let* ((mxoff 0.0)
(mx (maxamp))
- (len (- (frames) 2000))
+ (len (- (framples) 2000))
(cur (sample 2000))
(incr (/ (- mx cur) len)))
(scan-channel (lambda (y)
@@ -25782,76 +19907,72 @@ EDITS: 2
(if (> mxoff .001) (snd-display #__line__ ";granulate ramped 8 mxoff: ~A" mxoff)))
(undo)
-
- (set! ctr 0)
+ (let ((e (make-env '(0 0 1 1) :length 10000)))
(set! gen (make-granulate :expansion 2.0
- :input (lambda (dir)
- (let ((val (* ctr .0001)))
- (set! ctr (+ 1 ctr))
- val))
+ :input (lambda (dir) (env e))
:length .4
:hop .01
:ramp 0.4
:scaler 0.025
- :jitter 0.0))
+ :jitter 0.0)))
(clm-channel gen)
(if (fneq (maxamp) .433) (snd-display #__line__ ";granulate ramped 9: ~A" (maxamp)))
(undo)
(close-sound ind))))
- (let* ((v0 (make-vct 32))
- (v1 (make-vct 256))
- (v2 (make-vct 256))
- (v01 (make-vct 32))
- (v11 (make-vct 256))
- (v21 (make-vct 256)))
- (do ((i 1 (+ 1 i)))
+ (let ((v0 (make-float-vector 32))
+ (v1 (make-float-vector 256))
+ (v2 (make-float-vector 256))
+ (v01 (make-float-vector 32))
+ (v11 (make-float-vector 256))
+ (v21 (make-float-vector 256)))
+ (do ((i 1 (+ i 1)))
((= i 16))
- (vct-set! v0 i (/ 1.0 i))
- (vct-set! v01 i (/ 1.0 i)))
- (vct-set! v1 0 1.0)
- (vct-set! v11 0 1.0)
- (let ((gen (make-convolve :filter v0))
- (n -1)
- (gen1 (make-convolve :filter v01))
+ (set! (v0 i) (/ 1.0 i))
+ (set! (v01 i) (/ 1.0 i)))
+ (set! (v1 0) 1.0)
+ (set! (v11 0) 1.0)
+ (let ((n -1)
(n1 -1))
- (print-and-check gen
- "convolve"
- "convolve size: 64")
- (if (not (convolve? gen)) (snd-display #__line__ ";~A not convolve?" gen))
- (let ((genx gen1))
- (if (not (equal? genx gen1)) (snd-display #__line__ ";convolve equal?: ~A ~A ~A" genx gen1 (equal? genx gen1))))
- (if (equal? gen gen1) (snd-display #__line__ ";convolve equal? ~A ~A" gen gen1))
- (if (not (= (mus-length gen) 64)) (snd-display #__line__ ";convolve fft len: ~D?" (mus-length gen)))
- (do ((i 0 (+ 1 i)))
- ((= i 128))
- (vct-set! v2 i (convolve gen (lambda (dir) (set! n (+ n 1)) (vct-ref v1 n)))))
- (vct-map! v21 (lambda () (if (convolve? gen1) (convolve gen1 (lambda (dir) (set! n1 (+ n1 1)) (vct-ref v11 n1))))))
- (if (not (vequal v2 v21)) (snd-display #__line__ ";run gran: ~A ~A" v2 v21))
- (if (or (fneq (vct-ref v2 0) 0.0)
- (fneq (vct-ref v2 1) 1.0)
- (fneq (vct-ref v2 4) 0.25)
- (fneq (vct-ref v2 7) 0.143))
- (snd-display #__line__ ";convolve output: ~A?" v2))
- (let ((tag (catch #t (lambda () (convolve gen (lambda (a b) a))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity))
- (snd-display #__line__ ";convolve bad func: ~A" tag))))
-
- (convolve-files "oboe.snd" "fyow.snd" .5 "fmv.snd")
- (if (fneq (cadr (mus-sound-maxamp "fmv.snd")) .5)
- (snd-display #__line__ ";convolve-files: ~A is not .5?" (cadr (mus-sound-maxamp "fmv.snd"))))
- (play-sound-1 "fmv.snd"))
-
- (let* ((fd (mus-sound-open-input "oboe.snd"))
- (chans (mus-sound-chans "oboe.snd"))
- (data (make-sound-data chans 2000)))
- (if (not (sound-data? data)) (snd-display #__line__ ";~A not sound-data?" data))
- (if (not (= (sound-data-chans data) 1)) (snd-display #__line__ ";sound-data chans: ~A?" (sound-data-chans data)))
- (if (not (= (sound-data-length data) 2000)) (snd-display #__line__ ";sound-data length: ~A?" (sound-data-length data)))
- (mus-sound-read fd 0 1999 chans data)
- (let ((val (sound-data-ref data 0 1497)))
- (mus-sound-close-input fd)
- (if (fneq val 0.02893066) (snd-display #__line__ ";mus-sound-read: ~F?" val))))
+ (let ((gen (make-convolve :filter v0 :input (lambda (dir) (set! n (+ n 1)) (v1 n))))
+ (gen1 (make-convolve :filter v01 :input (lambda (dir) (set! n1 (+ n1 1)) (v11 n1)))))
+ (print-and-check gen
+ "convolve"
+ "convolve size: 64")
+ (if (not (convolve? gen)) (snd-display #__line__ ";~A not convolve?" gen))
+ (let ((genx gen1))
+ (if (not (equal? genx gen1)) (snd-display #__line__ ";convolve equal?: ~A ~A ~A" genx gen1 (equal? genx gen1))))
+ (if (equal? gen gen1) (snd-display #__line__ ";convolve equal? ~A ~A" gen gen1))
+ (if (not (= (mus-length gen) 64)) (snd-display #__line__ ";convolve fft len: ~D?" (mus-length gen)))
+ (do ((i 0 (+ i 1)))
+ ((= i 128))
+ (set! (v2 i) (convolve gen)))
+ (fill-float-vector v21 (if (convolve? gen1) (convolve gen1) -1.0))
+ (if (not (vequal v2 v21)) (snd-display #__line__ ";run gran: ~A ~A" v2 v21))
+ (if (or (fneq (v2 0) 0.0)
+ (fneq (v2 1) 1.0)
+ (fneq (v2 4) 0.25)
+ (fneq (v2 7) 0.143))
+ (snd-display #__line__ ";convolve output: ~A?" v2)))
+
+ (convolve-files "oboe.snd" "fyow.snd" .5 "fmv.snd")
+ (if (fneq (cadr (mus-sound-maxamp "fmv.snd")) .5)
+ (snd-display #__line__ ";convolve-files: ~A is not .5?" (cadr (mus-sound-maxamp "fmv.snd"))))
+ ))
+
+ (let ((flt (float-vector 1.0 0.5 0.1 0.2 0.3 0.4 0.5 1.0))
+ (data (float-vector 0.0 1.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0))
+ (ctr -1))
+ (let ((res (make-float-vector 16))
+ (g (make-convolve :filter flt
+ :input (lambda (dir)
+ (set! ctr (+ ctr 1))
+ (data ctr)))))
+ (do ((i 0 (+ i 1)))
+ ((= i 16))
+ (set! (res i) (convolve g)))
+ (if (not (vequal res (float-vector 0.0 1.0 0.5 0.1 1.2 0.8 0.5 0.7 1.3 0.4 0.5 1.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";convolve: ~A~%" res))))
(let ((ind (new-sound "fmv.snd")))
(set! (sample 1) .1)
@@ -25860,12 +19981,12 @@ EDITS: 2
(snd-display #__line__ ";weird: edits not cleared after save-sound?: ~A" (edits ind 0)))
(close-sound ind)
(set! ind (open-sound "fmv.snd"))
- (if (not (= (frames ind 0) 2))
- (snd-display #__line__ ";save-sound 2 samps: ~A?" (frames ind 0)))
+ (if (not (= (framples ind 0) 2))
+ (snd-display #__line__ ";save-sound 2 samps: ~A?" (framples ind 0)))
(if (or (fneq (sample 0) 0.0)
(fneq (sample 1) 0.1))
(snd-display #__line__ ";save-sound: ~A ~A?" (sample 0) (sample 1)))
- (do ((i 3 (+ 1 i)))
+ (do ((i 3 (+ i 1)))
((= i 6))
(set! (sample i) (* i .1))
(save-sound ind)
@@ -25873,8 +19994,8 @@ EDITS: 2
(snd-display #__line__ ";weird: edits not cleared after save-sound ~A?: ~A" i (edits ind 0)))
(close-sound ind)
(set! ind (open-sound "fmv.snd"))
- (if (not (= (frames ind 0) (+ i 1)))
- (snd-display #__line__ ";save-sound ~A samps: ~A?" (+ i 1) (frames ind 0)))
+ (if (not (= (framples ind 0) (+ i 1)))
+ (snd-display #__line__ ";save-sound ~A samps: ~A?" (+ i 1) (framples ind 0)))
(if (or (fneq (sample 0) 0.0)
(fneq (sample 1) 0.1)
(fneq (sample i) (* i 0.1)))
@@ -25883,7 +20004,7 @@ EDITS: 2
(let ((ind (new-sound "test.snd" :srate 22050 :channels 1 :size 1000))
(gen (make-ssb-am 100.0)))
- (map-channel (lambda (y) (ssb-am gen 0.0)))
+ (map-channel (lambda (y) (ssb-am gen)))
(if (fneq (maxamp) 0.0) (snd-display #__line__ ";ssb-am 0.0: ~A" (maxamp)))
(let ((gen1 (make-oscil 220.0)))
(map-channel (lambda (y) (* 0.5 (oscil gen1))))
@@ -25895,25 +20016,18 @@ EDITS: 2
(if (> (maxamp) .004) (snd-display #__line__ ";ssb-am cancelled: ~A" (maxamp)))
(undo 3)
(set! gen (make-ssb-am 100.0 100))
- (map-channel (lambda (y) (ssb-am gen y (hz->radians 50.0))))
+ (let ((hx (hz->radians 50.0)))
+ (map-channel (lambda (y) (ssb-am gen y hx))))
(delete-samples 0 180)
(set! gen1 (make-oscil 370.0 :initial-phase (asin (* 2 (sample 0))))) ; depends on rising side
(map-channel (lambda (y) (- y (* 0.5 (oscil gen1)))))
(if (> (maxamp) .004) (snd-display #__line__ ";ssb-am fm cancelled: ~A" (maxamp)))
(close-sound ind)))
- (if (defined? 'mus-ssb-bank)
- (let ((bands (make-vector 3))
- (ssbs (make-vector 3)))
- (do ((i 0 (+ 1 i)))
- ((= i 3))
- (vector-set! ssbs i (make-ssb-am (+ 100.0 (random 400))))
- (vector-set! bands i (make-bandpass (hz->radians 500.0) (hz->radians 600.0) 10)))
- (mus-ssb-bank ssbs bands .1 3)))
-
- (let ((ind (new-sound "test.snd" :srate 22050 :channels 1 :size 1000))
- (ctr 0))
- (map-channel (lambda (y) (let ((val (sin (/ (* 2 pi ctr) 50)))) (set! ctr (+ ctr 1)) val)))
+ (let* ((ind (new-sound "test.snd" :srate 22050 :channels 1 :size 1000))
+ (scl (/ (* 2 pi) 50))
+ (x (- scl)))
+ (map-channel (lambda (y) (sin (set! x (+ x scl)))))
;; 441 Hz
(ssb-bank 441 882 1 100)
(delete-samples 0 217)
@@ -25924,11 +20038,11 @@ EDITS: 2
(if *output*
(begin
- (snd-display #__line__ ";*output* ~A")
+ (snd-display #__line__ ";*output* ~A" *output*)
(set! *output* #f)))
- (let ((nind (new-sound "fmv.snd" mus-aifc mus-bshort 22050 1 "this is a comment")))
- (time (mix-vct (with-temp-sound (:output (make-vct 22050)) (fm-violin 0 1 440 .1)) 0 nind 0))
+ (let ((nind (new-sound "fmv.snd" 1 22050 mus-bshort mus-aifc "this is a comment")))
+ (time (mix-float-vector (with-temp-sound (:output (make-float-vector 22050)) (fm-violin 0 1 440 .1)) 0 nind 0))
(play nind :wait #t)
(save-sound nind)
(if (not (sound? nind)) (snd-display #__line__ ";save sound clobbered ~A?" nind))
@@ -25943,36 +20057,36 @@ EDITS: 2
(play nind :wait #t)
(voiced->unvoiced 1.0 256 2.0 2.0)
(pulse-voice 80 20.0 1.0 1024 0.01)
- (map-chan (fltit))
+ (map-channel (fltit))
(close-sound oboe-index))
(if (not (sound? nind)) (snd-display #__line__ ";close sound clobbered ~A?" nind))
- (let ((fr (frames nind 0)))
- (do ((k 0 (+ 1 k)))
+ (let ((fr (framples nind 0)))
+ (do ((k 0 (+ k 1)))
((= k 10))
(delete-samples 10 100 nind 0)
(save-sound nind)) ;flush out memory leaks here
- (if (not (= (frames nind 0) (- fr 1000)))
- (snd-display #__line__ ";delete-samples: ~A ~A" fr (frames nind 0))))
+ (if (not (= (framples nind 0) (- fr 1000)))
+ (snd-display #__line__ ";delete-samples: ~A ~A" fr (framples nind 0))))
(revert-sound nind)
(close-sound nind))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(let ((nind (new-sound "fmv.snd")))
- (if (not (= (header-type nind) (default-output-header-type)))
+ (if (not (= (header-type nind) *default-output-header-type*))
(snd-display #__line__ ";new-sound default header-type: ~A ~A?"
(mus-header-type-name (header-type nind))
- (mus-header-type-name (default-output-header-type))))
- (if (not (= (data-format nind) (default-output-data-format)))
- (snd-display #__line__ ";new-sound default data-format: ~A ~A?"
- (mus-data-format-name (data-format nind))
- (mus-data-format-name (default-output-data-format))))
- (if (not (= (chans nind) (default-output-chans)))
- (snd-display #__line__ ";new-sound default chans: ~A ~A?" (chans nind) (default-output-chans)))
- (if (not (= (srate nind) (default-output-srate)))
- (snd-display #__line__ ";new-sound default srate: ~A ~A?" (srate nind) (default-output-srate)))
+ (mus-header-type-name *default-output-header-type*)))
+ (if (not (= (sample-type nind) *default-output-sample-type*))
+ (snd-display #__line__ ";new-sound default sample-type: ~A ~A?"
+ (mus-sample-type-name (sample-type nind))
+ (mus-sample-type-name *default-output-sample-type*)))
+ (if (not (= (chans nind) *default-output-chans*))
+ (snd-display #__line__ ";new-sound default chans: ~A ~A?" (chans nind) *default-output-chans*))
+ (if (not (= (srate nind) *default-output-srate*))
+ (snd-display #__line__ ";new-sound default srate: ~A ~A?" (srate nind) *default-output-srate*))
(close-sound nind)
(if (file-exists? "fmv.snd") (delete-file "fmv.snd")))
- (let ((nind (new-sound "fmv.snd" mus-nist mus-bshort 22050 1 "this is a comment")))
+ (let ((nind (new-sound "fmv.snd" 1 22050 mus-bshort mus-nist "this is a comment")))
(set! (sample 0 nind) 1.0)
(start-progress-report nind)
(convolve-with "oboe.snd")
@@ -25989,28 +20103,30 @@ EDITS: 2
(if (or (fneq (sample 50) .5) (fneq (sample 30) 0.20608) (fneq (sample 90) 0.9755))
(snd-display #__line__ ";smooth: ~A ~A ~A?" (sample 50) (sample 30) (sample 90)))
(undo)
- (set! (sinc-width) 40)
- (set! (sample 100) 0.5)
- (if (fneq (sample 100) 0.5) (snd-display #__line__ ";set-sample 100: ~A?" (sample 100)))
- (src-sound .1)
+ (let ((old-wid *sinc-width*))
+ (set! *sinc-width* 40)
+ (set! (sample 100) 0.5)
+ (if (fneq (sample 100) 0.5) (snd-display #__line__ ";set-sample 100: ~A?" (sample 100)))
+ (src-sound .1)
+ (set! *sinc-width* old-wid))
(if (or (fneq (sample 1000) 0.5) (fneq (sample 1024) 0.0625) (fneq (sample 1010) 0.0))
(snd-display #__line__ ";src-sound: ~A ~A ~A?" (sample 1000) (sample 1024) (sample 1010)))
(revert-sound)
(close-sound nind))
- (let ((nind (new-sound "fmv.snd" mus-riff mus-lshort 22050 1 "this is a comment" 22050)))
- (if (not (= (frames nind) 22050)) (snd-display #__line__ "; new-sound initial-length: ~A" (frames nind)))
+ (let ((nind (new-sound "fmv.snd" 1 22050 mus-lshort mus-riff "this is a comment" 22050)))
+ (if (not (= (framples nind) 22050)) (snd-display #__line__ "; new-sound initial-length: ~A" (framples nind)))
(mix "pistol.snd")
- (map-chan (expsrc 2.0 nind))
+ (map-channel (expsrc 2.0 nind))
(undo)
(let ((eds (edits)))
- (if (or (not (= (car eds) 1)) (not (= (cadr eds) 1)))
+ (if (not (= (car eds) 1 (cadr eds)))
(snd-display #__line__ ";undo edits: ~A?" eds))
(if (not (= (edit-position) (car eds)))
(snd-display #__line__ ";undo edit-position: ~A ~A?" (edit-position) eds)))
(expsnd '(0 1 2 .4))
- (map-chan (comb-chord .95 100 .3))
- (map-chan (formants .99 900 .02 1800 .01 2700))
- (map-chan (moving-formant .99 '(0 1200 1 2400)))
+ (map-channel (comb-chord .95 100 .3))
+ (map-channel (formants .99 900 .02 1800 .01 2700))
+ (map-channel (moving-formant .99 '(0 1200 1 2400)))
(scale-to .3)
(let ((eds (edits)))
(if (or (not (= (car eds) 6)) (not (= (cadr eds) 0)))
@@ -26025,8 +20141,8 @@ EDITS: 2
(snd-display #__line__ ";set edit-position(4): ~A?" (edit-position)))
(revert-sound nind)
(mix "pistol.snd")
- (map-chan (zecho .5 .75 6 10.0) 0 65000)
- (map-chan (am 440))
+ (map-channel (zecho .5 .75 6 10.0) 0 65000)
+ (map-channel (am 440))
(add-mark 1200)
(add-mark 2300)
(key (char->integer #\x) 4)
@@ -26046,10 +20162,12 @@ EDITS: 2
(close-sound nind))
(if (and all-args (defined? 'edot-product))
- (let* ((ind (open-sound "1a.snd"))
- (len (frames ind 0)))
+ (let ((ind (new-sound :size 100))
+ (len 100))
+ (set! (sample 10) 0.5)
+ (set! (sample 30) -0.8)
(stretch-sound-via-dft 2.0 ind 0)
- (let ((new-len (frames ind 0)))
+ (let ((new-len (framples ind 0)))
(if (> (abs (- (* 2 len) new-len)) 10)
(snd-display #__line__ ";stretch-sound-via-dft: ~A ~A" len new-len)))
(close-sound ind)))
@@ -26061,169 +20179,284 @@ EDITS: 2
(make-mix-input (lambda (name i)
(if (or (= i 0) (= i 2))
name
- (make-file->frame name)))))
- (define* (mus-mix-1 outf inf outloc frames inloc mixer envs)
- (if envs
- (mus-mix outf inf outloc frames inloc mixer envs)
- (if mixer
- (mus-mix outf inf outloc frames inloc mixer)
- (if inloc
- (mus-mix outf inf outloc frames inloc)
- (if frames
- (mus-mix outf inf outloc frames)
- (if outloc
- (mus-mix outf inf outloc)
- (mus-mix outf inf))))))
+ (make-file->frample name)))))
+ (define (mus-file-mix-1 outf . args)
+ (apply mus-file-mix outf args)
(if (not (string? outf))
(mus-close outf)))
-
- (do ((k 0 (+ 1 k)))
+
+ (do ((k 0 (+ k 1)))
((= k 4))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
(if (file-exists? "fmv1.snd") (delete-file "fmv1.snd"))
(if (file-exists? "fmv2.snd") (delete-file "fmv2.snd"))
(if (file-exists? "fmv3.snd") (delete-file "fmv3.snd"))
- (let ((v0 (make-vct 12)))
- (vct-fill! v0 0.1)
+ (let ((v0 (make-float-vector 12)))
+ (fill! v0 0.1)
(array->file "fmv1.snd" v0 12 22050 1)
- (vct-fill! v0 0.2)
- (array->file "fmv2.snd" v0 12 22050 2) ; who knows what this intends...
- (file->array "fmv2.snd" 0 0 12 v0) ; check deleted here because multichannel array->file is a mistake
- (vct-fill! v0 0.3)
+ (fill! v0 0.2)
+ (array->file "fmv2.snd" v0 12 22050 2)
+ (fill! v0 0.3)
(array->file "fmv3.snd" v0 12 22050 4)
- (do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! v0 i (* i .01)))
+
+ (do ((i 0 (+ i 1))) ((= i 12)) (set! (v0 i) (* i .01)))
(array->file "fmv.snd" v0 12 22050 1)
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv1.snd" k))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv1.snd" k))
(file->array "fmv.snd" 0 0 12 v0)
+
+ ;; v0: #(0.1 0.11 0.12 0.13 0.14 0.15 0.16 0.17 0.18 0.19 0.2 0.21)
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 12)))
- (if (fneq (vct-ref v0 i) (+ 0.1 (* i .01)))
+ (if (fneq (v0 i) (+ 0.1 (* i .01)))
(begin
- (snd-display #__line__ ";~D mus-mix(1->1): ~A?" k v0)
+ (snd-display #__line__ ";~D mus-file-mix(1->1): ~A?" k v0)
(set! happy #f)))))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 3 9 0 (make-mixer 2 0.3 0.0 0.7 0.0))
+
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 3 9 0 (float-vector 0.3 0.0 0.7 0.0))
(file->array "fmv.snd" 0 0 12 v0)
- (if (or (fneq (vct-ref v0 0) .1) (fneq (vct-ref v0 3) .33) (fneq (vct-ref v0 9) .19)) (snd-display #__line__ ";~D mus-mix(2->1): ~A?" k v0))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv3.snd" k))
+
+ ;; v0: #(0.1 0.11 0.12 0.33 0.34 0.35 0.36 0.37 0.38 0.19 0.2 0.21)
+ (if (or (fneq (v0 0) .1) (fneq (v0 3) .33) (fneq (v0 9) .19)) (snd-display #__line__ ";~D mus-file-mix(2->1): ~A?" k v0))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv3.snd" k))
(file->array "fmv.snd" 0 0 12 v0)
- (if (or (fneq (vct-ref v0 0) .4) (fneq (vct-ref v0 3) .33)) (snd-display #__line__ ";~D mus-mix(4->1): ~A?" k v0))
+
+ ;; ?? v0: #(0.4 0.41 0.42 0.33 0.34 0.35 0.36 0.37 0.38 0.19 0.2 0.21)
+ (if (or (fneq (v0 0) .4) (fneq (v0 3) .33)) (snd-display #__line__ ";~D mus-file-mix(4->1): ~A?" k v0))
(let ((e0 (make-env '(0 0 1 1) :length 11))
(vf (make-vector 1))
(vf1 (make-vector 1)))
- (vector-set! vf 0 vf1)
- (vector-set! vf1 0 e0)
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv1.snd" k) 0 12 0 (make-mixer 1 1.0) vf)
+ (set! (vf 0) vf1)
+ (set! (vf1 0) e0)
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv1.snd" k) 0 12 0 (float-vector 1.0) vf)
(file->array "fmv.snd" 0 0 12 v0)
- (if (or (fneq (vct-ref v0 0) .4) (fneq (vct-ref v0 3) .360) (fneq (vct-ref v0 9) .28)) (snd-display #__line__ ";~D mus-mix(env): ~A?" k v0))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (make-mixer 2 1.0 1.0 1.0 1.0) vf))
+
+ ;; ?? v0: #(0.4 0.42 0.4400000000000001 0.36 0.38 0.4 0.42 0.44 0.46 0.28 0.3 0.31)
+ (if (or (fneq (v0 0) .4) (fneq (v0 3) .360) (fneq (v0 9) .28)) (snd-display #__line__ ";~D mus-file-mix(env): ~A?" k v0))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (float-vector 1.0 1.0 1.0 1.0) vf))
;; clm2xen should protect us here
(let ((vf (make-vector 2))
(vf1 (make-vector 2))
(vf2 (make-vector 2)))
- (vector-set! vf 0 vf1)
- (vector-set! vf 1 vf2)
- (vector-set! vf1 0 (make-env '(0 0 1 1) :length 10))
- (vector-set! vf2 1 (make-env '(0 0 1 1) :length 10))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (make-mixer 2 1.0 1.0 1.0 1.0) vf)
+ (set! (vf 0) vf1)
+ (set! (vf 1) vf2)
+ (set! (vf1 0) (make-env '(0 0 1 1) :length 10))
+ (set! (vf2 1) (make-env '(0 0 1 1) :length 10))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (float-vector 1.0 1.0 1.0 1.0) vf)
(let ((tag (catch #t
- (lambda ()
- (vector-set! vf 0 (make-oscil))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (make-mixer 2 1.0 1.0 1.0 1.0) vf))
- (lambda args (car args)))))
+ (lambda ()
+ (set! (vf 0) (make-oscil))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (float-vector 1.0 1.0 1.0 1.0) vf))
+ (lambda args (car args)))))
(if (not (eq? tag 'bad-type))
(snd-display #__line__ ";~D mix w oscil-vect: ~A" k tag)))
- (vector-set! vf 0 vf1)
- (vector-set! vf 1 vf2)
+ (set! (vf 0) vf1)
+ (set! (vf 1) vf2)
(let ((tag (catch #t
- (lambda ()
- (vector-set! vf1 0 (make-oscil))
- (vector-set! vf2 1 (sqrt -1.0))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (make-mixer 2 1.0 1.0 1.0 1.0) vf))
- (lambda args (car args)))))
+ (lambda ()
+ (set! (vf1 0) (make-oscil))
+ (set! (vf2 1) 0+i)
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 12 0 (float-vector 1.0 1.0 1.0 1.0) vf))
+ (lambda args (car args)))))
(if (not (eq? tag 'bad-type))
(snd-display #__line__ ";~D mix w oscil-env: ~A" k tag))))
(delete-file "fmv.snd")
- (do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! v0 i (* i .01)))
+ (do ((i 0 (+ i 1))) ((= i 12)) (set! (v0 i) (* i .01)))
(array->file "fmv.snd" v0 12 22050 4)
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv1.snd" k))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv1.snd" k))
(file->array "fmv.snd" 0 0 3 v0) ; chan 0 start 0 len 3
- (if (or (fneq (vct-ref v0 0) .1) (fneq (vct-ref v0 2) .18)) (snd-display #__line__ ";~D mus-mix(1->4): ~A?" k v0))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 3 0 (make-mixer 2 0.3 0.0 0.7 0.0))
+
+ ;; v0: #(0.1 0.14 0.18 0.03 0.04 0.05 0.06 0.07000000000000001 0.08 0.09 0.1 0.11)
+ (if (or (fneq (v0 0) .1) (fneq (v0 2) .18)) (snd-display #__line__ ";~D mus-file-mix(1->4): ~A?" k v0))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv2.snd" k) 0 3 0 (float-vector 0.3 0.0 0.7 0.0))
(file->array "fmv.snd" 0 0 3 v0)
- (if (or (fneq (vct-ref v0 0) .3) (fneq (vct-ref v0 2) .38)) (snd-display #__line__ ";~D mus-mix(2->4): ~A?" k v0))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv3.snd" k) 0 2 0)
+
+ ;; v0: #(0.3 0.34 0.38 0.03 0.04 0.05 0.06 0.07000000000000001 0.08 0.09 0.1 0.11)
+ (if (or (fneq (v0 0) .3) (fneq (v0 2) .38)) (snd-display #__line__ ";~D mus-file-mix(2->4): ~A?" k v0))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "fmv3.snd" k) 0 2 0)
(file->array "fmv.snd" 0 0 3 v0)
- (if (or (fneq (vct-ref v0 0) .6) (fneq (vct-ref v0 2) .38)) (snd-display #__line__ ";~D mus-mix(4->4): ~A?" k v0)))
+
+ ;; v0: #(0.6000000000000001 0.6400000000000001 0.38 0.03 0.04 0.05 0.06 0.07000000000000001 0.08 0.09 0.1 0.11)
+ (if (or (fneq (v0 0) .6) (fneq (v0 2) .38)) (snd-display #__line__ ";~D mus-file-mix(4->4): ~A?" k v0)))
(if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
- (let ((v0 (make-vct 12))
- (len (mus-sound-frames "oboe.snd")))
+ (let ((v0 (make-float-vector 12))
+ (len (mus-sound-framples "oboe.snd")))
(array->file "fmv.snd" v0 12 22050 1)
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "oboe.snd" k))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "oboe.snd" k) 0 len 0 (make-mixer 1 0.5))
- (let* ((egen (make-vector 1))
- (outv (make-vector 1)))
- (vector-set! outv 0 egen)
- (vector-set! egen 0 (make-env :envelope '(0 0 1 1) :length len))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "oboe.snd" k) 0 len 0 #f outv)
- (vector-set! egen 0 (make-env :envelope '(0 1 1 0) :length len))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "oboe.snd" k) 0 len 0 (make-mixer 1 1.0) outv))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "oboe.snd" k))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "oboe.snd" k) 0 len 0 (float-vector 0.5))
+ (let ((egen (make-vector 1))
+ (outv (make-vector 1)))
+ (set! (outv 0) egen)
+ (set! (egen 0) (make-env :envelope '(0 0 1 1) :length len))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "oboe.snd" k) 0 len 0 #f outv)
+ (set! (egen 0) (make-env :envelope '(0 1 1 0) :length len))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "oboe.snd" k) 0 len 0 (float-vector 1.0) outv))
(let ((ind-oboe (open-sound "oboe.snd"))
(ind-mix (open-sound "fmv.snd")))
- (if (not (vequal (channel->vct 1000 10 ind-oboe)
- (vct-scale! (channel->vct 1000 10 ind-mix) (/ 1.0 2.5))))
- (snd-display #__line__ ";~D mus-mix 1 chan: ~A ~A" k
- (channel->vct 1000 10 ind-oboe)
- (channel->vct 1000 10 ind-mix)))
+ (if (not (vequal (channel->float-vector 1000 10 ind-oboe)
+ (float-vector-scale! (channel->float-vector 1000 10 ind-mix) (/ 1.0 2.5))))
+ (snd-display #__line__ ";~D mus-file-mix 1 chan: ~A ~A" k
+ (channel->float-vector 1000 10 ind-oboe)
+ (channel->float-vector 1000 10 ind-mix)))
(close-sound ind-oboe)
(close-sound ind-mix))
(delete-file "fmv.snd")
- (let ((v0 (make-vct 12))
- (len (mus-sound-frames "2.snd")))
+ (let ((v0 (make-float-vector 12))
+ (len (mus-sound-framples "2.snd")))
(array->file "fmv.snd" v0 12 22050 2)
(if (not (= (mus-sound-chans "fmv.snd") 2))
(snd-display #__line__ ";~D array->file chans? ~A" k (mus-sound-chans "fmv.snd")))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k) 0 len 0 (make-mixer 2 0.5 0.0 0.0 0.5))
- (let* ((egen0 (make-vector 2))
- (egen1 (make-vector 2))
- (outv (make-vector 2)))
- (vector-set! outv 0 egen0)
- (vector-set! outv 1 egen1)
- (vector-set! egen0 0 (make-env :envelope '(0 0 1 1) :length len))
- (vector-set! egen1 1 (make-env :envelope '(0 0 1 1) :length len))
- (mus-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k) 0 len 0 #f outv))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k) 0 len 0 (float-vector 0.5 0.0 0.0 0.5))
+ (let ((egen0 (make-vector 2))
+ (egen1 (make-vector 2))
+ (outv (make-vector 2)))
+ (set! (outv 0) egen0)
+ (set! (outv 1) egen1)
+ (set! (egen0 0) (make-env :envelope '(0 0 1 1) :length len))
+ (set! (egen1 1) (make-env :envelope '(0 0 1 1) :length len))
+ (mus-file-mix-1 (make-mix-output "fmv.snd" k) (make-mix-input "2.snd" k) 0 len 0 #f outv))
(let ((ind-mix (open-sound "fmv.snd")))
(if (not (= (channels ind-mix) 2))
(snd-display #__line__ ";~D fmv re-read chans? ~A ~A" k (mus-sound-chans "fmv.snd") (channels ind-mix)))
- (if (not (vequal (channel->vct 1000 10 ind-mix 0)
- (vct 0.003 0.010 0.012 0.011 0.008 0.004 0.002 0.002 0.007 0.017)))
- (snd-display #__line__ ";~D mus-mix 2 chan (2.snd written: ~A): ~A ~A" k
+ (if (not (vequal (channel->float-vector 1000 10 ind-mix 0)
+ (float-vector 0.003 0.010 0.012 0.011 0.008 0.004 0.002 0.002 0.007 0.017)))
+ (snd-display #__line__ ";~D mus-file-mix 2 chan (2.snd written: ~A): ~A ~A" k
(strftime "%d-%b %H:%M %Z" (localtime (mus-sound-write-date "2.snd")))
- (channel->vct 1000 10 ind-mix 0)
- (channel->vct 1000 10 ind-mix 1)))
+ (channel->float-vector 1000 10 ind-mix 0)
+ (channel->float-vector 1000 10 ind-mix 1)))
(close-sound ind-mix)
(delete-file "fmv.snd"))))
); end do loop
); end let
+
+ (let ()
+ ;; someday this should be expanded
+ (if (pair? (sounds))
+ (for-each close-sound (sounds)))
+
+ (catch #t (lambda () (mus-file-mix-with-envs rd 0 1000 (float-vector))) (lambda args 'error))
+
+ (with-sound ("flat.snd")
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (outa i 1.0)))
+
+ (with-sound ("mix.snd")
+ (let ((rd (vector (make-readin "flat.snd"))))
+ (mus-file-mix-with-envs rd 0 1000 (float-vector 0.5) #f #f #f #f)))
+
+ (let ((ind (find-sound "mix.snd")))
+ (if (sound? ind)
+ (if (fneq (sample 100 ind) 0.5)
+ (snd-display #__line__ ";mus-file-mix-with-envs 1: ~A" (sample 100 ind)))
+ (snd-display #__line__ ";mus-file-mix-with envs 1: no output? ~A" (map short-file-name (sounds)))))
+
+ (with-sound ("mix.snd")
+ (let ((rd (vector (make-readin "flat.snd")))
+ (es (vector (make-env '(0 0 1 1) :length 1000))))
+ (mus-file-mix-with-envs rd 0 1000 (float-vector 0.0) #f es #f #f)))
+
+ (let ((ind (find-sound "mix.snd")))
+ (if (sound? ind)
+ (if (fneq (sample 100 ind) 0.1)
+ (snd-display #__line__ ";mus-file-mix-with-envs 2: ~A" (sample 100 ind)))
+ (snd-display #__line__ ";mus-file-mix-with envs 2: no output? ~A" (map short-file-name (sounds)))))
+
+ (with-sound ("mix.snd" 2 :clipped #f)
+ (let ((rd (vector (make-readin "flat.snd")
+ (make-readin "flat.snd")))
+ (es (vector (make-env '(0 0 1 1) :length 1000 :scaler .1)
+ (make-env '(0 1 1 0) :length 1000 :scaler .1)
+ (make-env '(0 1 1 1) :length 1000 :scaler .5)
+ (make-env '(0 1 1 1) :length 1000 :scaler -.5))))
+ (mus-file-mix-with-envs rd 0 1000 (float-vector 0.0 0.0 0.0 0.0) #f es #f #f)))
+
+ (let ((ind (find-sound "mix.snd")))
+ (if (sound? ind)
+ (begin
+ (if (fneq (sample 100 ind 0) 0.51)
+ (snd-display #__line__ ";mus-file-mix-with-envs 3 chan 0: ~A" (sample 100 ind 0)))
+ (if (fneq (sample 100 ind 1) -0.41)
+ (snd-display #__line__ ";mus-file-mix-with-envs 3 chan 1: ~A" (sample 100 ind 1))))
+ (snd-display #__line__ ";mus-file-mix-with envs 3: no output? ~A" (map short-file-name (sounds)))))
+
+ (with-sound ("mix.snd" 2 :clipped #f)
+ (let ((rd (vector (make-readin "flat.snd")))
+ (es (vector (make-env '(0 0 1 1) :length 1000 :scaler .3)
+ (make-env '(0 1 1 0) :length 1000 :scaler .4))))
+ (mus-file-mix-with-envs rd 0 1000 (float-vector 0.0 0.0 0.0 0.0) #f es #f #f)))
+
+ (let ((ind (find-sound "mix.snd")))
+ (if (sound? ind)
+ (begin
+ (if (fneq (sample 100 ind 0) 0.03)
+ (snd-display #__line__ ";mus-file-mix-with-envs 4 chan 0: ~A" (sample 100 ind 0)))
+ (if (fneq (sample 100 ind 1) 0.36)
+ (snd-display #__line__ ";mus-file-mix-with-envs 4 chan 1: ~A" (sample 100 ind 1))))
+ (snd-display #__line__ ";mus-file-mix-with envs 4: no output? ~A" (map short-file-name (sounds)))))
+
+ (with-sound ("mix.snd" 1 :clipped #f)
+ (let ((rd (vector (make-readin "flat.snd")
+ (make-readin "flat.snd")))
+ (es (vector (make-env '(0 0 1 1) :length 1000 :scaler .3)
+ (make-env '(0 1 1 0) :length 1000 :scaler .4))))
+ (mus-file-mix-with-envs rd 0 1000 (float-vector 0.0 0.0 0.0 0.0) #f es #f #f)))
+
+ (let ((ind (find-sound "mix.snd")))
+ (if (sound? ind)
+ (if (fneq (sample 100 ind) 0.39)
+ (snd-display #__line__ ";mus-file-mix-with-envs 5: ~A" (sample 100 ind)))
+ (snd-display #__line__ ";mus-file-mix-with envs 5: no output? ~A" (map short-file-name (sounds)))))
+
+ (with-sound ("flat.snd")
+ (outa 99 0.5)
+ (outa 100 1.0)
+ (outa 101 0.5))
+
+ (require snd-jcrev.scm)
+
+ (with-sound ("mix.snd" :reverb jc-reverb)
+ (let ((rd (vector (make-readin "flat.snd"))))
+ (mus-file-mix-with-envs rd 0 1000 (float-vector 0.5) (float-vector 0.1) #f #f #f)))
+
+ (with-sound ("mix.snd" :reverb jc-reverb)
+ (let* ((rd (vector (make-readin "flat.snd")
+ (make-readin "flat.snd")))
+ (srcs (vector (make-src :input (vector-ref rd 0) :srate 2.0)
+ (make-src :input (vector-ref rd 1) :srate 0.5))))
+ (mus-file-mix-with-envs rd 0 1000 (float-vector 1.0 1.0 0.5 0.5) (float-vector 0.1) #f srcs #f)))
+
+ (let ((ind (find-sound "mix.snd")))
+ (if (sound? ind)
+ (if (fneq (sample 200 ind) 0.5)
+ (snd-display #__line__ ";mus-file-mix-with-envs 7: ~A" (sample 200 ind)))
+ (snd-display #__line__ ";mus-file-mix-with envs 7: no output? ~A" (map short-file-name (sounds)))))
+
+ (for-each close-sound (sounds))
+ (delete-file "flat.snd")
+ (delete-file "mix.snd")
+ )
+
+
(let* ((gen (make-phase-vocoder #f 512 4 256 1.0 #f #f #f))
(val (catch #t (lambda () (phase-vocoder gen)) (lambda args (car args)))))
(if (fneq val 0.0) (snd-display #__line__ ";simple no-in pv call: ~A" val))
(set! val (catch #t (lambda () (set! gen (make-phase-vocoder :fft-size 1234))) (lambda args (car args))))
- (if (not (equal? val 'out-of-range)) (snd-display #__line__ ";pv bad fft: ~A" val))
+ (if (not (eq? val 'out-of-range)) (snd-display #__line__ ";pv bad fft: ~A" val))
)
(let* ((ind (open-sound "oboe.snd"))
(pi2 (* 2.0 pi))
- (pv (make-phase-vocoder #f
+ (reader (make-sampler 0))
+ (pv (make-phase-vocoder (lambda (dir) (next-sample reader))
512 4 128 1.0
#f ;no change to analysis
#f ;no change to edits
#f ;no change to synthesis
- ))
- (reader (make-sampler 0)))
+ )))
(if (not (phase-vocoder? pv)) (snd-display #__line__ ";~A not phase-vocoder?" pv))
(print-and-check pv
"phase-vocoder"
@@ -26232,76 +20465,70 @@ EDITS: 2
(if (not (= val 120)) (snd-display #__line__ ";pv set outctr: ~A" val)))
(select-sound ind)
- (map-chan (lambda (val)
- (phase-vocoder pv (lambda (dir)
- (next-sample reader)))))
- (vct-set! (phase-vocoder-amp-increments pv) 0 .1)
- (if (fneq (vct-ref (phase-vocoder-amp-increments pv) 0) .1)
- (snd-display #__line__ ";set phase-vocoder-amp-increments: ~A?" (vct-ref (phase-vocoder-amp-increments pv) 0)))
- (vct-set! (phase-vocoder-amps pv) 0 .1)
- (if (fneq (vct-ref (phase-vocoder-amps pv) 0) .1)
- (snd-display #__line__ ";set phase-vocoder-amps: ~A?" (vct-ref (phase-vocoder-amps pv) 0)))
- (vct-set! (phase-vocoder-phases pv) 0 .1)
- (if (fneq (vct-ref (phase-vocoder-phases pv) 0) .1)
- (snd-display #__line__ ";set phase-vocoder-phases: ~A?" (vct-ref (phase-vocoder-phases pv) 0)))
- (vct-set! (phase-vocoder-phase-increments pv) 0 .1)
- (if (fneq (vct-ref (phase-vocoder-phase-increments pv) 0) .1)
- (snd-display #__line__ ";set phase-vocoder-phase-increments: ~A?" (vct-ref (phase-vocoder-phase-increments pv) 0)))
- (vct-set! (phase-vocoder-freqs pv) 0 .1)
- (if (fneq (vct-ref (phase-vocoder-freqs pv) 0) .1)
- (snd-display #__line__ ";set phase-vocoder-freqs: ~A?" (vct-ref (phase-vocoder-freqs pv) 0)))
+ (map-channel (lambda (val) (phase-vocoder pv)))
+ (float-vector-set! (phase-vocoder-amp-increments pv) 0 .1)
+ (if (fneq ((phase-vocoder-amp-increments pv) 0) .1)
+ (snd-display #__line__ ";set phase-vocoder-amp-increments: ~A?" ((phase-vocoder-amp-increments pv) 0)))
+ (float-vector-set! (phase-vocoder-amps pv) 0 .1)
+ (if (fneq ((phase-vocoder-amps pv) 0) .1)
+ (snd-display #__line__ ";set phase-vocoder-amps: ~A?" ((phase-vocoder-amps pv) 0)))
+ (float-vector-set! (phase-vocoder-phases pv) 0 .1)
+ (if (fneq ((phase-vocoder-phases pv) 0) .1)
+ (snd-display #__line__ ";set phase-vocoder-phases: ~A?" ((phase-vocoder-phases pv) 0)))
+ (float-vector-set! (phase-vocoder-phase-increments pv) 0 .1)
+ (if (fneq ((phase-vocoder-phase-increments pv) 0) .1)
+ (snd-display #__line__ ";set phase-vocoder-phase-increments: ~A?" ((phase-vocoder-phase-increments pv) 0)))
+ (float-vector-set! (phase-vocoder-freqs pv) 0 .1)
+ (if (fneq ((phase-vocoder-freqs pv) 0) .1)
+ (snd-display #__line__ ";set phase-vocoder-freqs: ~A?" ((phase-vocoder-freqs pv) 0)))
(undo 1)
(free-sampler reader)
- (let ((lastphases (make-vct 512)))
- (set! pv (make-phase-vocoder #f
+ (let ((lastphases (make-float-vector 512))
+ (diffs (make-float-vector 512)))
+ (define (efunc v)
+ ;; new editing func changes pitch
+ (let ((N (mus-length v)) ;mus-increment => interp, mus-data => in-data
+ (D (mus-hop v))
+ (freqs (phase-vocoder-freqs v)))
+ (copy freqs diffs)
+ (float-vector-subtract! diffs lastphases)
+ (copy freqs lastphases)
+ (let ((N2 (floor (/ N 2)))
+ (pscl (/ 1.0 D))
+ (kscl (/ pi2 N)))
+ (do ((k 0 (+ k 1))
+ (kx 0.0 (+ kx kscl)))
+ ((= k N2))
+ (float-vector-set! freqs k (* 0.5 (+ (* pscl (remainder (float-vector-ref diffs k) pi2)) kx)))))
+ #f))
+ (set! reader (make-sampler 0))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample reader))
512 4 128 1.0
#f ;no change to analysis
- (lambda (v)
- ; new editing func changes pitch
- (run
- (let* ((N (mus-length v)) ;mus-increment => interp, mus-data => in-data
- (D (mus-hop v))
- (freqs (phase-vocoder-freqs v)))
- (do ((k 0 (+ 1 k))
- (pscl (/ 1.0 D))
- (kscl (/ pi2 N)))
- ((= k (floor (/ N 2))))
- (let ((phasediff (- (vct-ref freqs k) (vct-ref lastphases k))))
- (vct-set! lastphases k (vct-ref freqs k))
- (if (> phasediff pi) (do () ((<= phasediff pi)) (set! phasediff (- phasediff pi2))))
- (if (< phasediff (- pi)) (do () ((>= phasediff (- pi))) (set! phasediff (+ phasediff pi2))))
- (vct-set! freqs k
- (* 0.5
- (+ (* pscl phasediff)
- (* k kscl))))))
- #f)))
+ efunc
#f ; no change to synthesis
))
- (set! reader (make-sampler 0))
- (map-chan (lambda (val)
- (phase-vocoder pv (lambda (dir)
- (next-sample reader))))))
+ (map-channel (lambda (val) (phase-vocoder pv))))
(undo 1)
(free-sampler reader)
- (set! pv (make-phase-vocoder #f
+ (set! reader (make-sampler 0))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample reader))
512 4 (* 128 2) 1.0
#f ;no change to analysis
#f ;no change to edits
#f ;no change to synthesis
))
- (set! reader (make-sampler 0))
- (let* ((len (* 2 (frames ind)))
- (data (make-vct len)))
- (vct-map! data
- (lambda ()
- (phase-vocoder pv (lambda (dir) (next-sample reader)))))
+ (let* ((len 1000)
+ (data (make-float-vector len)))
+ (fill-float-vector data (phase-vocoder pv))
(set! (samples 0 len) data))
(undo 1)
(free-sampler reader)
(let ((incalls 0)
(outcalls 0))
- (set! pv (make-phase-vocoder #f
+ (set! reader (make-sampler 0))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample reader))
512 4 (* 128 2) 1.0
(lambda (v infunc)
(set! incalls (+ incalls 1))
@@ -26311,33 +20538,26 @@ EDITS: 2
(set! outcalls (+ outcalls 1))
0.0)
))
- (set! reader (make-sampler 0))
- (let* ((len (* 2 (frames ind)))
- (data (make-vct len)))
- (vct-map! data
- (lambda ()
- (phase-vocoder pv (lambda (dir) (next-sample reader)))))
+ (let* ((len 1000)
+ (data (make-float-vector len)))
+ (fill-float-vector data (phase-vocoder pv))
(set! (samples 0 len) data))
(undo 1)
(free-sampler reader)
(if (or (= incalls 0)
(= outcalls 0))
- (snd-display #__line__ ";phase-vocoder incalls: ~A, outcalls: ~A" incalls outcalls))
- (set! (mus-location pv) (mus-location pv))
- (let ((tag (catch #t (lambda () (phase-vocoder pv (lambda (a b) a))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity))
- (snd-display #__line__ ";phase-vocoder bad func: ~A" tag))))
+ (snd-display #__line__ ";phase-vocoder incalls: ~A, outcalls: ~A" incalls outcalls)))
(let ((tag (catch #t
- (lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b c) #f) #f #f))
- (lambda args args))))
+ (lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b c) #f) #f #f))
+ (lambda args args))))
(if (not (eq? (car tag) 'bad-arity)) (snd-display #__line__ ";make-phase-vocoder bad analyze func: ~A" tag)))
(let ((tag (catch #t
- (lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b) 0.0) (lambda (a b c) #f) #f))
- (lambda args args))))
+ (lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b) 0.0) (lambda (a b c) #f) #f))
+ (lambda args args))))
(if (not (eq? (car tag) 'bad-arity)) (snd-display #__line__ ";make-phase-vocoder bad edit func: ~A" tag)))
(let ((tag (catch #t
- (lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b) 0.0) (lambda (a) #f) (lambda (a b) 0)))
- (lambda args args))))
+ (lambda () (make-phase-vocoder #f 512 4 256 1.0 (lambda (a b) 0.0) (lambda (a) #f) (lambda (a b) 0)))
+ (lambda args args))))
(if (not (eq? (car tag) 'bad-arity)) (snd-display #__line__ ";make-phase-vocoder bad synthesize func: ~A" tag)))
(let ((geno (make-phase-vocoder (lambda (dir) 0.0))))
(let ((genx (make-phase-vocoder :input (lambda (dir) 0.0))))
@@ -26356,36 +20576,180 @@ EDITS: 2
(if (not (equal? genx genxx)) (snd-display #__line__ ";phase-vocoder equal: ~A ~A" genxx genx)))))
(close-sound ind))
+ (let ((old-fudge *mus-float-equal-fudge-factor*) ; some phase-vocoder tests
+ (ind (new-sound :size 110))
+ (rd #f)
+ (pv #f))
+ (set! (sample 1) 1.0)
+ (set! rd (make-sampler))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample rd)) 128 4 32 1.0 #f #f #f))
+ (map-channel (lambda (y) (phase-vocoder pv)))
+
+ (set! *mus-float-equal-fudge-factor* 1e-5)
+
+ (let ((v (channel->float-vector 0 50))
+ (v0 (float-vector 0.00022 0.00130 0.00382 0.00810 0.01381 0.01960 0.02301 0.02143 0.01421 0.00481 0.00000 0.00396 0.01168 0.01231 0.00413 0.00018 0.00704 0.00984 0.00189 0.00197 0.00881 0.00290 0.00151 0.00781 0.00091 0.00404 0.00498 0.00047 0.00641 -0.00017 0.00590 0.00006 0.00492 0.00031 0.00380 0.00052 0.00290 0.00066 0.00219 0.00074 0.00164 0.00076 0.00123 0.00074 0.00092 0.00067 0.00069 0.00058 0.00052 0.00048)))
+ (if (and (not (mus-arrays-equal? v v0))
+ (not (mus-arrays-equal? (float-vector-scale! v -1.0) v0)))
+ (snd-display #__line__ ";pv 1 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
+
+ (undo)
+
+ (set! rd (make-sampler))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample rd)) 128 4 32 2.0 #f #f #f))
+ (map-channel (lambda (y) (phase-vocoder pv)))
+
+ (let ((v (channel->float-vector 0 50))
+ (v0 (float-vector 0.00044 0.00255 0.00705 0.01285 0.01595 0.01177 0.00281 0.00069 0.00782 0.00702 0.00001 0.00584 0.00385 0.00138 0.00547 0.00035 0.00494 0.00082 0.00305 0.00310 0.00003 0.00380 0.00245 -0.00019 0.00159 0.00348 0.00268 0.00087 -0.00020 -0.00036 -0.00010 0.00012 0.00036 0.00057 0.00075 0.00089 0.00099 0.00105 0.00108 0.00107 0.00104 0.00099 0.00094 0.00087 0.00080 0.00073 0.00066 0.00059 0.00053 0.00047)))
+ (if (not (mus-arrays-equal? v v0))
+ (snd-display #__line__ ";pv 2 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
+
+ (undo)
+
+ (set! rd (make-sampler))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample rd)) 128 4 32 0.5 #f #f #f))
+ (map-channel (lambda (y) (phase-vocoder pv)))
+
+ (let ((v (channel->float-vector 0 50))
+ (v0 (float-vector 0.00011 0.00065 0.00195 0.00428 0.00785 0.01266 0.01845 0.02456 0.02989 0.03305 0.03267 0.02803 0.01970 0.00993 0.00228 0.00009 0.00441 0.01250 0.01858 0.01759 0.00975 0.00160 0.00079 0.00795 0.01454 0.01201 0.00325 0.00024 0.00716 0.01261 0.00704 0.00003 0.00384 0.00962 0.00620 0.00027 0.00196 0.00655 0.00492 0.00040 0.00101 0.00448 0.00375 0.00041 0.00053 0.00305 0.00273 0.00033 0.00029 0.00204)))
+ (if (not (mus-arrays-equal? v v0))
+ (snd-display #__line__ ";pv 3 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
+
+ (undo)
+
+ (set! rd (make-sampler))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample rd)) 128 4 64 1.0 #f #f #f))
+ (map-channel (lambda (y) (phase-vocoder pv)))
+
+ (let ((v (channel->float-vector 0 100))
+ (v0 (float-vector 0.00005 0.00033 0.00098 0.00214 0.00392 0.00633 0.00923 0.01228 0.01495 0.01652 0.01633 0.01401 0.00985 0.00497 0.00114 0.00004 0.00221 0.00625 0.00929 0.00880 0.00488 0.00080 0.00040 0.00397 0.00727 0.00601 0.00162 0.00012 0.00358 0.00630 0.00352 0.00002 0.00217 0.00552 0.00300 -0.00008 0.00299 0.00479 0.00083 0.00098 0.00457 0.00175 0.00033 0.00412 0.00172 0.00039 0.00399 0.00087 0.00118 0.00356 -0.00016 0.00280 0.00169 0.00051 0.00326 -0.00030 0.00301 0.00040 0.00184 0.00144 0.00078 0.00213 0.00015 0.00242 -0.00017 0.00240 -0.00038 0.00230 -0.00049 0.00214 -0.00053 0.00194 -0.00051 0.00172 -0.00047 0.00150 -0.00040 0.00127 -0.00033 0.00106 -0.00025 0.00086 -0.00019 0.00068 -0.00013 0.00052 -0.00008 0.00039 -0.00005 0.00027 -0.00002 0.00017 -0.00001 0.00009 -0.00000 0.00003 -0.00000 -0.00002 -0.00001 -0.00006)))
+ (if (not (mus-arrays-equal? v v0))
+ (snd-display #__line__ ";pv 4 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
+
+ (undo)
+
+ (set! (sample 10) 1.0)
+ (set! (sample 23) 1.0)
+ (set! rd (make-sampler))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample rd)) 128 4 32 1.0 #f #f #f))
+ (map-channel (lambda (y) (phase-vocoder pv)))
+
+ (let ((v (channel->float-vector 0 100))
+ (v0 (float-vector 0.00100 0.00598 0.01756 0.03708 0.06286 0.08826 0.10172 0.09163 0.05680 0.01564 -0.00075 0.02124 0.05164 0.04457 0.00861 0.00529 0.03648 0.02747 -0.00875 0.00936 0.02402 -0.00553 -0.00090 -0.02262 -0.00221 0.06633 -0.03229 0.01861 0.05228 0.00672 0.00885 0.01442 -0.00484 -0.02293 -0.01893 -0.02256 -0.10229 -0.22474 0.31110 0.07597 0.07127 0.03670 0.02583 0.03173 0.02260 0.01550 0.01485 0.03212 -0.00966 0.00779 -0.00964 0.00698 0.01100 0.00468 0.00107 0.00517 0.00469 0.00131 0.00058 0.00530 0.00582 -0.00652 0.00011 0.00000 -0.00000 -0.00000 -0.00000 0.00000 -0.00000 0.00000 0.00000 -0.00000 -0.00000 -0.00000 -0.00000 -0.00000 -0.00000 0.00000 -0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 -0.00000 -0.00000 -0.00000 0.00000 0.00000 0.00000 -0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000)))
+ (if (not (mus-arrays-equal? v v0))
+ (snd-display #__line__ ";pv 5 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
+
+ (undo)
+
+ (set! (sample 40) 1.0)
+ (set! (sample 63) 1.0)
+ (set! rd (make-sampler))
+ (set! pv (make-phase-vocoder (lambda (dir) (next-sample rd)) 128 4 32 1.0 #f #f #f))
+ (map-channel (lambda (y) (phase-vocoder pv)))
+
+ (let ((v (channel->float-vector 0 100))
+ (v0 (float-vector 0.00332 0.01977 0.05805 0.12252 0.20738 0.29035 0.33291 0.29696 0.18017 0.04637 -0.00003 0.08250 0.18618 0.15495 0.02775 0.02252 0.13597 0.09767 -0.03116 0.05301 0.10256 -0.05005 0.01966 0.06176 -0.04418 0.04118 -0.11409 -0.04115 -0.05157 -0.11409 0.07815 -0.08155 -0.00536 0.02090 -0.18804 -0.10686 -0.11931 -0.42989 0.39009 0.03157 0.14253 0.05984 0.05439 0.00764 0.02636 -0.02799 -0.01346 -0.01011 -0.04925 -0.02896 -0.07812 -0.07880 -0.11338 -0.13133 -0.41421 0.38140 0.08676 0.07712 0.00983 0.03731 0.01585 0.00108 0.00101 0.00282 -0.01106 -0.00403 -0.02165 -0.02054 -0.02452 -0.02382 -0.03213 -0.02693 -0.03734 -0.03978 -0.04879 -0.07504 -0.09597 -0.31426 0.32995 0.13460 0.04120 0.05029 0.01900 0.02517 0.01163 0.01294 0.00827 0.00576 0.00640 0.00141 0.00489 -0.00057 0.00301 -0.00089 0.00099 -0.00000 0.00000 -0.00000 -0.00000 -0.00000)))
+ (if (not (mus-arrays-equal? v v0))
+ (snd-display #__line__ ";pv 6 diff: ~A" (float-vector-peak (float-vector-subtract! v v0)))))
+
+ (close-sound ind)
+ (set! *mus-float-equal-fudge-factor* old-fudge))
+
+ (let ()
+ (define (pvoc-d beg dur amp size)
+ (let ((N2 (floor (/ size 2))))
+ (let ((start (seconds->samples beg))
+ (end (seconds->samples (+ beg dur)))
+ (lastphases (make-float-vector N2))
+ (two-pi (* 2 pi))
+ (osc (make-oscil 1000.0))
+ (amps #f) (paincrs #f) (ppincrs #f) (phases #f) (freqs #f))
+
+ (define (ifunc dir)
+ (oscil osc))
+
+ (define (efunc c)
+ (let* ((D (floor (/ size 4))) ; overlap = 4
+ (pscl (/ 1.0 D))
+ (kscl (/ two-pi size)))
+ (do ((k 0 (+ k 1))
+ (ks 0.0 (+ ks kscl)))
+ ((= k N2))
+ (let* ((freq (freqs k))
+ (diff (- freq (lastphases k))))
+ (set! (lastphases k) freq)
+ (if (> diff pi) (set! diff (- diff two-pi)))
+ (if (< diff (- pi)) (set! diff (+ diff two-pi)))
+ (set! (freqs k) (+ (* diff pscl) ks))))
+ #f))
+
+ (define (sfunc c)
+ (float-vector-add! amps paincrs)
+ (float-vector-add! ppincrs freqs)
+ (float-vector-add! phases ppincrs)
+ (let ((sum 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i N2))
+ (if (> (amps i) .75)
+ (set! sum (+ sum (* (amps i) (if (> (modulo (phases i) two-pi) pi) 1.0 -1.0))))))
+ sum))
+
+ (let ((sr (make-phase-vocoder :fft-size size :interp (/ size 4) :overlap 4
+ :edit efunc
+ :synthesize sfunc
+ :input ifunc)))
+ (set! amps (phase-vocoder-amps sr))
+ (set! paincrs (phase-vocoder-amp-increments sr))
+ (set! ppincrs (phase-vocoder-phase-increments sr))
+ (set! phases (phase-vocoder-phases sr))
+ (set! freqs (phase-vocoder-freqs sr))
+
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (phase-vocoder sr))))))))
+
+ (let ((v (make-float-vector 200)))
+ (with-sound (v :srate 44100) (pvoc-d 0 .0025 .2 128))
+ (do ((i 55 (+ i 1)))
+ ((= i 65))
+ (if (> (abs (- (v i) .196)) .01)
+ (snd-display #__line__ ";pvoc-d at ~D: ~A~%" i (v i))))
+ (do ((i 75 (+ i 1)))
+ ((= i 85))
+ (if (> (abs (- (v i) -.196)) .01)
+ (snd-display #__line__ ";pvoc-d at ~D: ~A~%" i (v i)))))
+ )
+
(let ((ind (open-sound "oboe.snd")))
(let ((gen (make-moog-filter 500.0 .1)))
- (if (fneq 500.0 (moog-frequency gen)) (snd-display #__line__ ";moog freq: ~A" (moog-frequency gen)))
- (if (fneq .1 (moog-Q gen)) (snd-display #__line__ ";moog Q: ~A" (moog-Q gen)))
- (if (not (vct? (moog-s gen))) (snd-display #__line__ ";moog state: ~A" (moog-s gen)))
- (if (fneq 0.0 (moog-y gen)) (snd-display #__line__ ";moog A? ~A" (moog-y gen)))
- (if (fneq -0.861 (moog-fc gen)) (snd-display #__line__ ";moog freqtable: ~A" (moog-fc gen)))
- (let ((vals (make-vct 20)))
- (vct-set! vals 0 (moog-filter gen 1.0))
- (do ((i 1 (+ 1 i)))
+ (if (fneq 500.0 (moog-frequency gen)) (snd-display #__line__ ";moog freq: ~A" (moog-frequency gen))) ; moog-frequency is a separate function
+ (if (fneq .1 (gen 'Q)) (snd-display #__line__ ";moog Q: ~A" (gen 'Q)))
+; (if (not (float-vector? (gen 's))) (snd-display #__line__ ";moog state: ~A" (gen 's)))
+ (if (fneq 0.0 (gen 'y)) (snd-display #__line__ ";moog A? ~A" (gen 'y)))
+ (if (fneq -0.861 (gen 'fc)) (snd-display #__line__ ";moog freqtable: ~A" (gen 'fc)))
+ (let ((vals (make-float-vector 20)))
+ (set! (vals 0) (moog-filter gen 1.0))
+ (do ((i 1 (+ i 1)))
((= i 20))
- (vct-set! vals i (moog-filter gen 0.0)))
- (if (not (vequal vals (vct 0.0 0.0 0.0025 0.0062 0.0120 0.0198 0.0292 0.0398 0.0510 0.0625
+ (set! (vals i) (moog-filter gen 0.0)))
+ (if (not (vequal vals (float-vector 0.0 0.0 0.0025 0.0062 0.0120 0.0198 0.0292 0.0398 0.0510 0.0625
0.0739 0.0847 0.0946 0.1036 0.1113 0.1177 0.1228 0.1266 0.1290 0.1301)))
(snd-display #__line__ ";moog output: ~A" vals))))
(close-sound ind))
(let ((gen (make-ssb-am 440.0))
- (v0 (make-vct 10))
+ (v0 (make-float-vector 10))
(gen1 (make-ssb-am 440.0))
- (v1 (make-vct 10)))
+ (v1 (make-float-vector 10)))
(print-and-check gen
"ssb-am"
"ssb-am shift: up, sin/cos: 439.999975 Hz (0.000000 radians), order: 41"
"ssb-am shift: up, sin/cos: 440.000000 Hz (0.000000 radians), order: 41"
"ssb-am shift: up, sin/cos: 439.999969 Hz (0.000000 radians), order: 41")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! v0 i (ssb-am gen 0.0)))
- (vct-map! v1 (lambda () (if (ssb-am? gen1) (ssb-am gen1 0.0) -1.0)))
+ (set! (v0 i) (ssb-am gen)))
+ (fill-float-vector v1 (if (ssb-am? gen1) (ssb-am gen1) -1.0))
(if (not (vequal v0 v1)) (snd-display #__line__ ";map ssb-am: ~A ~A" v0 v1))
(if (not (ssb-am? gen)) (snd-display #__line__ ";~A not ssb-am?" gen))
(if (fneq (mus-phase gen) 1.253787) (snd-display #__line__ ";ssb-am phase: ~F?" (mus-phase gen)))
@@ -26395,8 +20759,8 @@ EDITS: 2
(if (not (= (mus-interp-type gen) mus-interp-none)) (snd-display #__line__ ";ssb-am interp type: ~D?" (mus-interp-type gen)))
(if (fneq (mus-xcoeff gen 0) -0.00124) (snd-display #__line__ ";ssb-am xcoeff 0: ~A" (mus-xcoeff gen 0)))
(if (fneq (mus-xcoeff gen 1) 0.0) (snd-display #__line__ ";ssb-am xcoeff 1: ~A" (mus-xcoeff gen 1)))
- ; (if (not (vct? (mus-data gen))) (snd-display #__line__ ";mus-data ssb-am: ~A" (mus-data gen)))
- ; (if (not (vct? (mus-xcoeffs gen))) (snd-display #__line__ ";mus-xcoeffs ssb-am: ~A" (mus-xcoeffs gen)))
+ ; (if (not (float-vector? (mus-data gen))) (snd-display #__line__ ";mus-data ssb-am: ~A" (mus-data gen)))
+ ; (if (not (float-vector? (mus-xcoeffs gen))) (snd-display #__line__ ";mus-xcoeffs ssb-am: ~A" (mus-xcoeffs gen)))
;; these apparently aren't handled in clm2xen
)
@@ -26405,7 +20769,7 @@ EDITS: 2
(let ((o1 (make-ssb-am 400.0))
(o2 (make-ssb-am-1 400.0))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 100)))
(let* ((inval (sin (* .1 i)))
(o1o (ssb-am o1 inval))
@@ -26418,7 +20782,7 @@ EDITS: 2
(let ((o1 (make-ssb-am 400.0))
(o2 (make-ssb-am-1 400.0))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 100)))
(let* ((inval (sin (* .1 i)))
(fmval (sin (* .2 i)))
@@ -26432,7 +20796,7 @@ EDITS: 2
(let ((o1 (make-ssb-am -100.0))
(o2 (make-ssb-am-1 -100.0))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 100)))
(let* ((inval (random 1.0))
(o1o (ssb-am o1 inval))
@@ -26445,7 +20809,7 @@ EDITS: 2
(let ((o1 (make-ssb-am 1000.0 100))
(o2 (make-ssb-am-1 1000.0 100))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 100)))
(let* ((inval (random 1.0))
(o1o (ssb-am o1 inval))
@@ -26456,7 +20820,7 @@ EDITS: 2
(set! happy #f))))))
(let ((index (open-sound "pistol.snd"))
- (data (channel->vct 0 100)))
+ (data (channel->float-vector 0 100)))
(convolve-with "oboe.snd" #f)
(let ((scl (maxamp)))
(convolve-with "oboe.snd" scl index 0 0)
@@ -26467,56 +20831,56 @@ EDITS: 2
(if (fneq (maxamp index 0) 1.29) (snd-display #__line__ ";agc: ~A" (maxamp index 0)))
(close-sound index)
(let ((reader (make-sampler 0 "pistol.snd")))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (if (fneq (vct-ref data i) (next-sample reader))
+ (if (fneq (data i) (next-sample reader))
(snd-display #__line__ ";external reader trouble")))
(free-sampler reader)))
(let ((make-procs (list
- make-all-pass make-asymmetric-fm make-moving-average
- make-comb (lambda () (make-convolve :filter (vct 0 1 2))) make-delay (lambda () (make-env '(0 1 1 0)))
- (lambda () (make-filter :xcoeffs (vct 0 1 2))) (lambda () (make-fir-filter :xcoeffs (vct 0 1 2)))
+ make-all-pass make-asymmetric-fm make-moving-average make-moving-max make-moving-norm
+ make-comb (lambda () (make-convolve :filter (float-vector 0 1 2))) make-delay (lambda () (make-env '(0 1 1 0) :length 10))
+ (lambda () (make-filter :xcoeffs (float-vector 0 1 2))) (lambda () (make-fir-filter :xcoeffs (float-vector 0 1 2)))
(lambda () (make-filtered-comb :filter (make-one-zero .5 .5)))
- make-formant (lambda () (make-frame 3)) make-granulate
- (lambda () (make-iir-filter :xcoeffs (vct 0 1 2))) make-locsig (lambda () (make-mixer 3 3))
- make-notch make-one-pole make-one-zero make-oscil make-ppolar
+ make-formant make-granulate
+ (lambda () (make-iir-filter :xcoeffs (float-vector 0 1 2))) make-locsig
+ make-notch make-one-pole (lambda () (make-one-pole-all-pass 1 .5)) make-one-zero make-oscil
make-pulse-train make-rand make-rand-interp make-sawtooth-wave
make-square-wave make-src make-table-lookup make-triangle-wave
- make-two-pole make-two-zero make-wave-train make-polyshape make-zpolar make-phase-vocoder make-ssb-am
- (lambda () (make-filter :ycoeffs (vct 0 1 2)))
- (lambda () (make-filter :xcoeffs (vct 1 2 3) :ycoeffs (vct 0 1 2)))))
- (run-procs (list all-pass asymmetric-fm moving-average
+ make-two-pole make-two-zero make-wave-train make-polyshape make-phase-vocoder make-ssb-am
+ (lambda () (make-filter :ycoeffs (float-vector 0 1 2)))
+ (lambda () (make-filter :xcoeffs (float-vector 1 2 3) :ycoeffs (float-vector 0 1 2)))))
+ (gen-procs (list all-pass asymmetric-fm moving-average moving-max moving-norm
comb convolve delay env
- filter fir-filter filtered-comb formant (lambda (gen ind) (frame-ref gen ind)) granulate
- iir-filter (lambda (gen a) (locsig gen 0 a)) (lambda (gen a) (mixer-ref gen a 0)) notch one-pole one-zero oscil two-pole
+ filter fir-filter filtered-comb formant granulate
+ iir-filter (lambda (gen a) (locsig gen 0 a)) notch one-pole one-pole-all-pass one-zero oscil
pulse-train rand rand-interp sawtooth-wave
square-wave (lambda (gen a) (src gen 0.0 a)) table-lookup triangle-wave
- two-pole two-zero wave-train polyshape two-zero phase-vocoder ssb-am
+ two-pole two-zero wave-train polyshape phase-vocoder ssb-am
filter filter))
- (ques-procs (list all-pass? asymmetric-fm? moving-average?
+ (ques-procs (list all-pass? asymmetric-fm? moving-average? moving-max? moving-norm?
comb? convolve? delay? env?
- filter? fir-filter? filtered-comb? formant? frame? granulate?
- iir-filter? locsig? mixer? notch? one-pole? one-zero? oscil? two-pole?
+ filter? fir-filter? filtered-comb? formant? granulate?
+ iir-filter? locsig? notch? one-pole? one-pole-all-pass? one-zero? oscil?
pulse-train? rand? rand-interp? sawtooth-wave?
square-wave? src? table-lookup? triangle-wave?
- two-pole? two-zero? wave-train? polyshape? two-zero? phase-vocoder? ssb-am?
+ two-pole? two-zero? wave-train? polyshape? phase-vocoder? ssb-am?
filter? filter?))
- (func-names (list 'all-pass 'asymmetric-fm 'moving-average
+ (func-names (list 'all-pass 'asymmetric-fm 'moving-average 'moving-max 'moving-norm
'comb 'convolve 'delay 'env
- 'filter-x 'fir-filter 'filtered-comb 'formant 'frame 'granulate
- 'iir-filter 'locsig 'mixer 'notch 'one-pole 'one-zero 'oscil 'two-pole
+ 'filter-x 'fir-filter 'filtered-comb 'formant 'granulate
+ 'iir-filter 'locsig 'notch 'one-pole 'one-pole-all-pass 'one-zero 'oscil
'pulse-train 'rand 'rand-interp 'sawtooth-wave
'square-wave 'src 'table-lookup 'triangle-wave
- 'two-pole 'two-zero 'wave-train 'polyshape 'two-zero 'phase-vocoder 'ssb-am
+ 'two-pole 'two-zero 'wave-train 'polyshape 'phase-vocoder 'ssb-am
'filter-y 'filter-xy))
- (gen-args (list 0.0 0.0 1.0
+ (gen-args (list 0.0 0.0 1.0 1.0 1.0
0.0 (lambda (dir) 0.0) 0.0 #f
- 0.0 0.0 0.0 0.0 0 (lambda (dir) 0.0)
- 0.0 0.0 0 0.0 0.0 0.0 0.0 0.0
+ 0.0 0.0 0.0 0.0 (lambda (dir) 0.0)
+ 0.0 0.0 0.0 0.0 0.0 0.0 0.0
0.0 0.0 0.0 0.0
0.0 (lambda (dir) 0.0) 0.0 0.0
- 0.0 0.0 0.0 0.0 0.0 (lambda (dir) 0.0) 0.0
+ 0.0 0.0 0.0 0.0 (lambda (dir) 0.0) 0.0
0.0 0.0))
(generic-procs (list mus-channel mus-channels mus-data
mus-feedback mus-feedforward mus-frequency mus-hop mus-increment mus-length
@@ -26529,8 +20893,8 @@ EDITS: 2
(let ((gen (make)))
(if (not (ques gen)) (snd-display #__line__ ";~A: ~A -> ~A?" name make gen))
(let ((tag (catch #t (lambda () (if arg (runp gen arg) (runp gen))) (lambda args args))))
- (if (and (not (number? tag))
- (not (frame? tag)))
+ (if (and (not (number? tag))
+ (not (float-vector? tag)))
(snd-display #__line__ ";~A: ~A ~A ~A: ~A" name runp gen arg tag)))
(for-each
(lambda (func genname)
@@ -26551,9 +20915,9 @@ EDITS: 2
(snd-display #__line__ ";generic ~A of delay: ~A" genname tag))))
(let ((tag (catch #t (lambda () (func gen)) (lambda args (car args)))))
(if (and (not (symbol? tag))
- (procedure-with-setter? func)
+ (dilambda? func)
(or (not (eq? genname 'mus-data))
- (vct? tag)))
+ (float-vector? tag)))
(let ((tag1 (catch #t (lambda () (set! (func gen) tag)) (lambda args (car args)))))
(if (and (symbol? tag1)
(not (eq? tag1 'mus-error))
@@ -26561,20 +20925,20 @@ EDITS: 2
(snd-display #__line__ ";~A set ~A ~A ~A -> ~A" name genname gen tag tag1))))))
generic-procs generic-names)
(mus-reset gen)))
- make-procs run-procs ques-procs gen-args func-names)
+ make-procs gen-procs ques-procs gen-args func-names)
(let ((make-procs (list
- make-all-pass make-asymmetric-fm make-moving-average
+ make-all-pass make-asymmetric-fm make-moving-average make-moving-max
make-comb
(lambda () (make-filtered-comb :filter (make-one-zero .5 .5)))
- (lambda () (make-convolve :filter (vct 0 1 2) :input (lambda (dir) 1.0)))
+ (lambda () (make-convolve :filter (float-vector 0 1 2) :input (lambda (dir) 1.0)))
make-delay
(lambda () (make-env :length 11 :envelope '(0 1 1 0)))
- (lambda () (make-filter :xcoeffs (vct 0 1 2)))
- (lambda () (make-fir-filter :xcoeffs (vct 0 1 2)))
+ (lambda () (make-filter :xcoeffs (float-vector 0 1 2)))
+ (lambda () (make-fir-filter :xcoeffs (float-vector 0 1 2)))
(lambda () (make-formant :radius .1 :frequency 440.0))
(lambda () (make-granulate (lambda (dir) 1.0)))
- (lambda () (make-iir-filter :xcoeffs (vct 0 1 2)))
+ (lambda () (make-iir-filter :xcoeffs (float-vector 0 1 2)))
make-locsig
make-notch
(lambda () (make-one-pole .3 .7))
@@ -26582,16 +20946,16 @@ EDITS: 2
make-oscil
make-pulse-train make-sawtooth-wave
make-square-wave
- (lambda () (make-table-lookup :wave (make-vct 128 .1)))
+ (lambda () (make-table-lookup :wave (make-float-vector 128 .1)))
make-triangle-wave
(lambda () (make-two-pole .1 .3 .6))
(lambda () (make-two-zero .1 .3 .5))
(lambda () (make-polyshape 440.0 :partials '(1 1)))
(lambda () (make-phase-vocoder (lambda (dir) 1.0)))
make-ssb-am
- (lambda () (make-filter :ycoeffs (vct 0 1 2)))
- (lambda () (make-filter :xcoeffs (vct 1 2 3) :ycoeffs (vct 0 1 2)))))
- (run-procs (list all-pass asymmetric-fm moving-average
+ (lambda () (make-filter :ycoeffs (float-vector 0 1 2)))
+ (lambda () (make-filter :xcoeffs (float-vector 1 2 3) :ycoeffs (float-vector 0 1 2)))))
+ (gen-procs (list all-pass asymmetric-fm moving-average moving-max
comb filtered-comb convolve delay
(lambda (gen ignored) (env gen))
filter fir-filter formant
@@ -26603,7 +20967,7 @@ EDITS: 2
square-wave table-lookup triangle-wave
two-pole two-zero polyshape phase-vocoder ssb-am
filter filter))
- (func-names (list 'all-pass 'asymmetric-fm 'moving-average
+ (func-names (list 'all-pass 'asymmetric-fm 'moving-average 'moving-max
'comb 'filtered-comb 'convolve 'delay 'env
'filter-x 'fir-filter 'formant 'granulate
'iir-filter 'locsig 'notch 'one-pole 'one-zero 'oscil
@@ -26614,24 +20978,24 @@ EDITS: 2
(for-each
(lambda (make runp name)
(let ((gen (make))
- (data (make-vct 10)))
- (vct-set! data 0 (runp gen 1.0))
- (do ((i 1 (+ 1 i)))
+ (data (make-float-vector 10)))
+ (set! (data 0) (runp gen 1.0))
+ (do ((i 1 (+ i 1)))
((= i 10))
- (vct-set! data i (runp gen 0.0)))
- (do ((k 0 (+ 1 k)))
+ (set! (data i) (runp gen 0.0)))
+ (do ((k 0 (+ k 1)))
((= k 2))
(mus-reset gen)
(if (and (not (eq? name 'env))
(not (eq? name 'locsig)))
(let ((not-zero #f))
(let ((first-val (if (= k 0) (runp gen 1.0) (mus-apply gen 1.0 0.0))))
- (if (not (= (vct-ref data 0) 0.0)) (set! not-zero #t))
- (if (fneq (vct-ref data 0) first-val)
- (snd-display #__line__ ";[~A] ~A: ~A ~A ~A" (if (= k 0) 'run 'apply) name 0 (vct-ref data 0) first-val)))
- (do ((i 1 (+ 1 i)))
+ (if (not (= (data 0) 0.0)) (set! not-zero #t))
+ (if (fneq (data 0) first-val)
+ (snd-display #__line__ ";[~A] ~A: ~A ~A ~A" (if (= k 0) 'run 'apply) name 0 (data 0) first-val)))
+ (do ((i 1 (+ i 1)))
((= i 10))
- (let ((old-val (vct-ref data i))
+ (let ((old-val (data i))
(new-val (if (= k 0) (runp gen 0.0) (mus-apply gen 0.0 0.0))))
(if (not (= old-val 0.0)) (set! not-zero #t))
(if (fneq old-val new-val)
@@ -26640,56 +21004,61 @@ EDITS: 2
(not (eq? name 'ssb-am))
(not not-zero))
(snd-display #__line__ ";~A not much of a reset test!" name)))))))
- make-procs run-procs func-names))
+ make-procs gen-procs func-names))
(if (and all-args (= clmtest 0))
(begin
(for-each
(lambda (make runp)
- (let ((gen (make)))
- ;; run args
- (for-each
- (lambda (arg1)
- (catch #t (lambda () (runp gen arg1)) (lambda args (car args)))
- (for-each
- (lambda (arg2)
- (catch #t (lambda () (runp gen arg1 arg2)) (lambda args (car args))))
- (list 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4 'mus-error (sqrt -1.0) (make-delay 32)
- (lambda () #t) (current-environment) (make-sound-data 2 3) :order 0 1 -1 (make-hook 2) #f #t #\c 0.0 1.0 -1.0
- '() '3 4 2 8 16 32 64 (make-vector 0) '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
- )))
- (list 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4 'mus-error (sqrt -1.0) (make-delay 32)
- (lambda () #t) (current-environment) (make-sound-data 2 3) :order 0 1 -1 (make-hook 2) #f #t #\c 0.0 1.0 -1.0
- '() '3 4 2 8 16 32 64 (make-vector 0) '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
- ))
- ;; generic args
- (for-each
- (lambda (func name)
- (catch #t
- (lambda ()
- (let ((default-value (func gen)))
- (for-each
- (lambda (arg1)
+ (catch #t
+ (lambda ()
+ (let ((gen (make)))
+ ;; run args
+ (for-each
+ (lambda (arg1)
+ ;; how did this ever work??
+ (catch #t (lambda () (runp gen arg1)) (lambda args (car args)))
+ (for-each
+ (lambda (arg2)
+ (catch #t (lambda () (runp gen arg1 arg2)) (lambda args (car args))))
+ (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4 'mus-error 0+i (make-delay 32)
+ (lambda () #t) (curlet) (make-float-vector (list 2 3) 0.0) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0
+ () 3 4 2 8 16 32 64 (make-vector 0) '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
+ )))
+ (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4 'mus-error 0+i (make-delay 32)
+ (lambda () #t) (curlet) (make-float-vector (list 2 3) 0.0) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0
+ () 3 4 2 8 16 32 64 (make-vector 0) '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
+ ))
+
+ ;; generic args
+ (for-each
+ (lambda (func name)
+ (catch #t
+ (lambda ()
+ (let ((default-value (func gen)))
+ (for-each
+ (lambda (arg1)
+ (catch #t
+ (lambda ()
+ (func gen)
+ (set! (func gen) arg1))
+ (lambda args #f)))
+ (list 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #(0 1) 3/4 'mus-error 0+i
+ (lambda () #t) (make-float-vector (list 2 3) 0.0) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0
+ () 3 4 64 -64 (make-vector 0) '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
+ (lambda (a) a)))
+ (if (not (equal? (func gen) default-value))
(catch #t
- (lambda ()
- (let ((old-val (func gen)))
- (set! (func gen) arg1)))
- (lambda args #f)))
- (list 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) '#(0 1) 3/4 'mus-error (sqrt -1.0)
- (lambda () #t) (make-sound-data 2 3) :order 0 1 -1 #f #t #\c 0.0 1.0 -1.0
- '() '3 4 64 -64 (make-vector 0) '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0)
- (lambda (a) a)))
- (if (not (equal? (func gen) default-value))
- (catch #t
- (lambda ()
- (set! (func gen) default-value))
- (lambda args #f)))))
- (lambda args #f)))
- generic-procs generic-names)
- (mus-reset gen)))
- make-procs run-procs)
+ (lambda ()
+ (set! (func gen) default-value))
+ (lambda args #f)))))
+ (lambda args #f)))
+ generic-procs generic-names)
+ (mus-reset gen)))
+ (lambda args (car args))))
+ make-procs gen-procs)
- (let ((new-wave (make-vct 1)))
+ (let ((new-wave (make-float-vector 1)))
(for-each
(lambda (g g1)
(let ((gen (g :wave new-wave)))
@@ -26697,17 +21066,15 @@ EDITS: 2
(list make-table-lookup)
(list table-lookup)))
- (let ((old-srate (mus-srate))
- (old-clm-srate *clm-srate*))
+ (let ((old-clm-srate *clm-srate*))
(for-each
(lambda (n)
- (set! (mus-srate) n)
(set! *clm-srate* n)
(for-each
(lambda (g name)
(let ((tag (catch #t (lambda () (g :frequency 440.0)) (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";srate ~A: ~A -> ~A" n name tag))))
+ (if (not (memq tag '(wrong-type-arg out-of-range)))
+ (snd-display #__line__ ";key-check ~A: ~A -> ~A" n name tag))))
(list make-oscil make-asymmetric-fm
make-triangle-wave make-square-wave make-pulse-train make-sawtooth-wave
make-rand make-rand-interp)
@@ -26715,23 +21082,22 @@ EDITS: 2
'triangle-wave 'square-wave 'pusle-train 'sawtooth-wave
'rand 'rand-interp)))
(list 100 1))
-
- (set! (mus-srate) old-srate)
(set! *clm-srate* old-clm-srate))
(let ((random-args (list
(expt 2.0 21.5) (expt 2.0 -18.0)
- 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .1 .2 .3) '#(0 1) 3/4 (sqrt -1.0) (make-delay 32)
- (lambda () 0.0) (lambda (dir) 1.0) (lambda (a b c) 1.0) 0 1 -1 #f #t #\c 0.0 1.0 -1.0 '() 32 '(1 . 2)
+ 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .1 .2 .3) #(0 1) 3/4 0+i (make-delay 32)
+ (lambda () 0.0) (lambda (dir) 1.0) (lambda (a b c) 1.0) 0 1 -1 #f #t #\c 0.0 1.0 -1.0 () 32 '(1 . 2)
))
- (gen-make-procs (list make-all-pass make-asymmetric-fm make-moving-average make-table-lookup make-triangle-wave
+ (gen-make-procs (list make-all-pass make-asymmetric-fm make-moving-average make-moving-max make-moving-norm
+ make-table-lookup make-triangle-wave
make-comb ;make-convolve
make-delay make-env make-fft-window
- make-filter make-filtered-comb make-fir-filter make-formant make-frame ;make-granulate
- make-iir-filter make-locsig make-mixer make-notch make-one-pole make-one-zero make-oscil make-ppolar
+ make-filter make-filtered-comb make-fir-filter make-formant
+ make-iir-filter make-locsig make-notch make-one-pole make-one-pole-all-pass make-one-zero make-oscil
make-pulse-train make-rand make-rand-interp make-sawtooth-wave make-polyshape make-polywave
make-square-wave ;make-src
- make-two-pole make-two-zero make-wave-train make-zpolar ;make-phase-vocoder
+ make-two-pole make-two-zero make-wave-train
make-ssb-am)))
(define (random-gen args)
@@ -26741,16 +21107,15 @@ EDITS: 2
(lambda () (apply n args))
(lambda args (car args)))))
(if (mus-generator? gen)
- (begin
- (for-each
- (lambda (arg)
- (catch #t
- (lambda () (gen arg))
- (lambda args (car args))))
- random-args)))))
+ (for-each
+ (lambda (arg)
+ (catch #t
+ (lambda () (gen arg))
+ (lambda args (car args))))
+ random-args))))
gen-make-procs))
- (random-gen '())
+ (random-gen ())
(for-each
(lambda (arg1)
(random-gen (list arg1))
@@ -26770,136 +21135,116 @@ EDITS: 2
(let ((gen (make-moving-max 4)))
- (let ((descr (mus-describe gen)))
- (if (and (not (string=? descr "moving-max n: 4, gen: #<delay line[4, step]: [0.000 0.000 0.000 0.000]>"))
- (not (string=? descr "moving-max n: 4, gen: delay line[4, step]: [0.000 0.000 0.000 0.000]")))
- (snd-display #__line__ ";moving-max mus-describe: ~A" descr))
- (if (not (string=? (mus-name gen) "moving-max")) (snd-display #__line__ ";moving-max mus-name: ~A" (mus-name gen))))
- (let ((ov (make-vct 10))
- (iv (vct .1 .05 -.2 .15 -1.5 0.1 0.01 0.001 0.0 0.0))
- (tv (vct .1 .1 .2 .2 1.5 1.5 1.5 1.5 0.1 0.01)))
- (do ((i 0 (+ 1 i)))
+ (let ((ov (make-float-vector 10))
+ (iv (float-vector .1 .05 -.2 .15 -1.5 0.1 0.01 0.001 0.0 0.0))
+ (tv (float-vector .1 .1 .2 .2 1.5 1.5 1.5 1.5 0.1 0.01)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! ov i (moving-max gen (vct-ref iv i))))
+ (set! (ov i) (moving-max gen (iv i))))
(if (not (vequal tv ov))
(snd-display #__line__ ";moving-max: ~A ~A" ov tv))))
(let ((g1 (make-moving-max 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(let ((val (moving-max g1 (random 1.0))))
- (let ((pk (vct-peak (mus-data g1))))
+ (let ((pk (float-vector-peak (mus-data g1))))
(if (not (= pk val))
(snd-display #__line__ ";moving-max ~A ~A" pk val))))))
- (let ((odata (make-vct 15 0.0))
- (data (vct 1.0 0.0 -1.1 1.1001 0.1 -1.1 1.0 1.0 0.5 -0.01 0.02 0.0 0.0 0.0 0.0))
+ (let ((odata (make-float-vector 15 0.0))
+ (data (float-vector 1.0 0.0 -1.1 1.1001 0.1 -1.1 1.0 1.0 0.5 -0.01 0.02 0.0 0.0 0.0 0.0))
(g (make-moving-max 3)))
- (do ((i 0 (+ 1 i))) ((= i 15)) (vct-set! odata i (moving-max g (vct-ref data i))))
- (if (not (vequal odata (vct 1.000 1.000 1.100 1.100 1.100 1.100 1.100 1.100 1.000 1.000 0.500 0.020 0.020 0.000 0.000)))
+ (do ((i 0 (+ i 1))) ((= i 15)) (set! (odata i) (moving-max g (data i))))
+ (if (not (vequal odata (float-vector 1.000 1.000 1.100 1.100 1.100 1.100 1.100 1.100 1.000 1.000 0.500 0.020 0.020 0.000 0.000)))
(snd-display #__line__ ";moving max odata: ~A" odata))
- (if (= (vct-ref odata 4) (vct-ref odata 7))
+ (if (= (odata 4) (odata 7))
(snd-display #__line__ ";moving-max .0001 offset?"))
- (set! odata (make-vct 15 0.0))
- (set! data (vct 0.1 -0.2 0.3 0.4 -0.5 0.6 0.7 0.8 -0.9 1.0 0.0 0.0))
+ (set! odata (make-float-vector 15 0.0))
+ (set! data (float-vector 0.1 -0.2 0.3 0.4 -0.5 0.6 0.7 0.8 -0.9 1.0 0.0 0.0))
(set! g (make-moving-sum 3))
- (do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-sum g (vct-ref data i))))
- (if (not (vequal odata (vct 0.100 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700 1.900 1.000 0.000 0.000 0.000)))
+ (do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-sum g (data i))))
+ (if (not (vequal odata (float-vector 0.100 0.300 0.600 0.900 1.200 1.500 1.800 2.100 2.400 2.700 1.900 1.000 0.000 0.000 0.000)))
(snd-display #__line__ ";moving-sum odata: ~A" odata))
- (set! odata (make-vct 15 0.0))
+ (set! odata (make-float-vector 15 0.0))
(set! g (make-moving-rms 4))
- (do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-rms g (vct-ref data i))))
- (if (not (vequal odata (vct 0.050 0.112 0.187 0.274 0.367 0.464 0.561 0.660 0.758 0.857 0.783 0.673 0.000 0.000 0.000)))
+ (do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-rms g (data i))))
+ (if (not (vequal odata (float-vector 0.050 0.112 0.187 0.274 0.367 0.464 0.561 0.660 0.758 0.857 0.783 0.673 0.000 0.000 0.000)))
(snd-display #__line__ ";moving-rms odata: ~A" odata))
- (set! odata (make-vct 15 0.0))
+ (set! odata (make-float-vector 15 0.0))
(set! g (make-moving-length 4))
- (do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-length g (vct-ref data i))))
- (if (not (vequal odata (vct 0.100 0.224 0.374 0.548 0.735 0.927 1.122 1.319 1.517 1.715 1.565 1.345 0.000 0.000 0.000)))
+ (do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-length g (data i))))
+ (if (not (vequal odata (float-vector 0.100 0.224 0.374 0.548 0.735 0.927 1.122 1.319 1.517 1.715 1.565 1.345 0.000 0.000 0.000)))
(snd-display #__line__ ";moving-length odata: ~A" odata))
(let ((ind (new-sound "test.snd" :size 20)))
(set! (sample 3) 1.0)
(let ((gen1 (make-weighted-moving-average 4))
- (gen2 (make-fir-filter 4 (vct 0.4 0.3 0.2 0.1))))
+ (gen2 (make-fir-filter 4 (float-vector 0.4 0.3 0.2 0.1))))
(map-channel (lambda (y) (weighted-moving-average gen1 y)))
- (let ((data1 (channel->vct)))
+ (let ((data1 (channel->float-vector)))
(undo)
(map-channel (lambda (y) (fir-filter gen2 y)))
- (let ((data2 (channel->vct)))
+ (let ((data2 (channel->float-vector)))
(if (not (vequal data1 data2))
(snd-display #__line__ ";weighted-moving-average and fir:~%; ~A~%: ~A" data1 data2)))
(undo)))
(close-sound ind))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (- 0.5 (random 1.0))))
+ (set! (data i) (mus-random 0.5)))
(set! g (make-moving-length 4))
- (let ((descr (mus-describe g)))
- (if (and (not (string=? descr "moving-length n: 4, gen: #<moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]>"))
- (not (string=? descr "moving-length n: 4, gen: moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]")))
- (snd-display #__line__ ";moving-length mus-describe: ~A" descr))
- (if (not (string=? (mus-name g) "moving-length")) (snd-display #__line__ ";moving-length mus-name: ~A" (mus-name g))))
- (do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-length g (vct-ref data i))))
- (do ((i -3 (+ 1 i))
- (k 0 (+ 1 k)))
+ (do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-length g (data i))))
+ (do ((i -3 (+ i 1))
+ (k 0 (+ k 1)))
((= i 8))
(let ((sum 0.0))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((= j 4))
(if (>= (+ i j) 0)
- (set! sum (+ sum (* (vct-ref data (+ i j)) (vct-ref data (+ i j)))))))
- (if (fneq (vct-ref odata k) (sqrt sum)) (snd-display #__line__ ";moving length ran: ~A ~A" (vct-ref odata k) (sqrt sum)))))
+ (set! sum (+ sum (* (data (+ i j)) (data (+ i j)))))))
+ (if (fneq (odata k) (sqrt sum)) (snd-display #__line__ ";moving length ran: ~A ~A" (odata k) (sqrt sum)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (- 0.5 (random 1.0))))
+ (set! (data i) (mus-random 0.5)))
(set! g (make-moving-sum 4))
- (let ((descr (mus-describe g)))
- (if (and (not (string=? descr "moving-sum n: 4, gen: #<moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]>"))
- (not (string=? descr "moving-sum n: 4, gen: moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]")))
- (snd-display #__line__ ";moving-sum mus-describe: ~A" descr))
- (if (not (string=? (mus-name g) "moving-sum")) (snd-display #__line__ ";moving-sum mus-name: ~A" (mus-name g))))
- (do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-sum g (vct-ref data i))))
- (do ((i -3 (+ 1 i))
- (k 0 (+ 1 k)))
+ (do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-sum g (data i))))
+ (do ((i -3 (+ i 1))
+ (k 0 (+ k 1)))
((= i 8))
(let ((sum 0.0))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((= j 4))
(if (>= (+ i j) 0)
- (set! sum (+ sum (abs (vct-ref data (+ i j)))))))
- (if (fneq (vct-ref odata k) sum) (snd-display #__line__ ";moving sum ran: ~A ~A" (vct-ref odata k) sum))))
+ (set! sum (+ sum (abs (data (+ i j)))))))
+ (if (fneq (odata k) sum) (snd-display #__line__ ";moving sum ran: ~A ~A" (odata k) sum))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (- 0.5 (random 1.0))))
+ (set! (data i) (mus-random 0.5)))
(set! g (make-moving-rms 4))
- (let ((descr (mus-describe g)))
- (if (and (not (string=? descr "moving-rms n: 4, gen: #<moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]>"))
- (not (string=? descr "moving-rms n: 4, gen: moving-average 0.000, line[4]:[0.000 0.000 0.000 0.000]")))
- (snd-display #__line__ ";moving-rms mus-describe: ~A" descr))
- (if (not (string=? (mus-name g) "moving-rms")) (snd-display #__line__ ";moving-rms mus-name: ~A" (mus-name g))))
- (do ((i 0 (+ 1 i))) ((= i 12)) (vct-set! odata i (moving-rms g (vct-ref data i))))
- (do ((i -3 (+ 1 i))
- (k 0 (+ 1 k)))
+ (do ((i 0 (+ i 1))) ((= i 12)) (set! (odata i) (moving-rms g (data i))))
+ (do ((i -3 (+ i 1))
+ (k 0 (+ k 1)))
((= i 8))
(let ((sum 0.0))
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((= j 4))
(if (>= (+ i j) 0)
- (set! sum (+ sum (* (vct-ref data (+ i j)) (vct-ref data (+ i j)))))))
- (if (fneq (vct-ref odata k) (sqrt (/ sum 4))) (snd-display #__line__ ";moving rms ran: ~A ~A" (vct-ref odata k) (sqrt (/ sum 4)))))))
+ (set! sum (+ sum (* (data (+ i j)) (data (+ i j)))))))
+ (if (fneq (odata k) (sqrt (/ sum 4))) (snd-display #__line__ ";moving rms ran: ~A ~A" (odata k) (sqrt (/ sum 4)))))))
(let ((ind (open-sound "oboe.snd")))
(harmonicizer 550.0 (list 1 .5 2 .3 3 .2) 10)
(close-sound ind))
- (let ((arglist '()))
- (do ((i 0 (+ 1 i)))
+ (let ((arglist ()))
+ (do ((i 0 (+ i 1)))
((= i 16))
(set! arglist (cons 440.0 (cons :frequency arglist))))
(set! arglist (reverse arglist))
@@ -26910,94 +21255,87 @@ EDITS: 2
(lambda args (car args)))))
(if (not (eq? tag 'mus-error))
(snd-display #__line__ ";long arglist to ~A: ~A" name tag))))
- (list make-wave-train make-polyshape make-delay make-moving-average make-comb make-filtered-comb make-notch
+ (list make-wave-train make-polyshape make-delay make-moving-average make-moving-max make-moving-norm make-comb make-filtered-comb make-notch
make-rand make-rand-interp make-table-lookup make-env
make-readin make-locsig make-granulate make-convolve make-phase-vocoder)
- (list 'make-wave-train 'make-polyshape 'make-delay 'make-moving-average 'make-comb 'make-filtered-comb 'make-notch
+ (list 'make-wave-train 'make-polyshape 'make-delay 'make-moving-average 'make-moving-max 'make-moving-norm 'make-comb 'make-filtered-comb 'make-notch
'make-rand 'make-rand-interp 'make-table-lookup 'make-env
'make-readin 'make-locsig 'make-granulate 'make-convolve 'make-phase-vocoder)))
- (let ((v1 (make-vct 10 .1)))
+ (let ((v1 (make-float-vector 10 .1)))
(let ((g1 (make-table-lookup :wave v1)))
(if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";table-lookup data not eq?: ~A ~A" v1 (mus-data g1)))
(if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";table-lookup data not eqv?: ~A ~A" v1 (mus-data g1)))
(if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";table-lookup data not equal?: ~A ~A" v1 (mus-data g1)))
- (vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";table-lookup vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
- (vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";table-lookup vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (set! (v1 1) .3)
+ (if (fneq ((mus-data g1) 1) .3) (snd-display #__line__ ";table-lookup float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
+ (float-vector-set! (mus-data g1) 1 .5)
+ (if (fneq (v1 1) .5) (snd-display #__line__ ";table-lookup float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
(let ((g1 (make-wave-train :wave v1)))
(if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";wave-train data not eq?: ~A ~A" v1 (mus-data g1)))
(if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";wave-train data not eqv?: ~A ~A" v1 (mus-data g1)))
(if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";wave-train data not equal?: ~A ~A" v1 (mus-data g1)))
- (vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";wave-train vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
- (vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";wave-train vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (set! (v1 1) .3)
+ (if (fneq ((mus-data g1) 1) .3) (snd-display #__line__ ";wave-train float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
+ (float-vector-set! (mus-data g1) 1 .5)
+ (if (fneq (v1 1) .5) (snd-display #__line__ ";wave-train float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
(let ((g1 (make-polyshape :coeffs v1)))
(if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";polyshape data not eq?: ~A ~A" v1 (mus-data g1)))
(if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";polyshape data not eqv?: ~A ~A" v1 (mus-data g1)))
(if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";polyshape data not equal?: ~A ~A" v1 (mus-data g1)))
- (vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";polyshape vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
- (vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";polyshape vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (set! (v1 1) .3)
+ (if (fneq ((mus-data g1) 1) .3) (snd-display #__line__ ";polyshape float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
+ (float-vector-set! (mus-data g1) 1 .5)
+ (if (fneq (v1 1) .5) (snd-display #__line__ ";polyshape float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
(let ((g1 (make-delay :initial-contents v1)))
(if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";delay data not eq?: ~A ~A" v1 (mus-data g1)))
(if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";delay data not eqv?: ~A ~A" v1 (mus-data g1)))
(if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";delay data not equal?: ~A ~A" v1 (mus-data g1)))
- (vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";delay vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
- (vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";delay vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (set! (v1 1) .3)
+ (if (fneq ((mus-data g1) 1) .3) (snd-display #__line__ ";delay float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
+ (float-vector-set! (mus-data g1) 1 .5)
+ (if (fneq (v1 1) .5) (snd-display #__line__ ";delay float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
(let ((g1 (make-filtered-comb :scaler .5 :initial-contents v1 :filter (make-one-zero .1 .2))))
(if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";filtered-comb data not eq?: ~A ~A" v1 (mus-data g1)))
(if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";filtered-comb data not eqv?: ~A ~A" v1 (mus-data g1)))
(if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";filtered-comb data not equal?: ~A ~A" v1 (mus-data g1)))
- (vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";filtered-comb vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
- (vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";filtered-comb vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (set! (v1 1) .3)
+ (if (fneq ((mus-data g1) 1) .3) (snd-display #__line__ ";filtered-comb float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
+ (float-vector-set! (mus-data g1) 1 .5)
+ (if (fneq (v1 1) .5) (snd-display #__line__ ";filtered-comb float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
(let ((g1 (make-rand :distribution v1)))
(if (not (eq? v1 (mus-data g1))) (snd-display #__line__ ";rand data not eq?: ~A ~A" v1 (mus-data g1)))
(if (not (eqv? v1 (mus-data g1))) (snd-display #__line__ ";rand data not eqv?: ~A ~A" v1 (mus-data g1)))
(if (not (equal? v1 (mus-data g1))) (snd-display #__line__ ";rand data not equal?: ~A ~A" v1 (mus-data g1)))
- (vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-data g1) 1) .3) (snd-display #__line__ ";rand vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1)))
- (vct-set! (mus-data g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";rand vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-data g1) 1))))
+ (set! (v1 1) .3)
+ (if (fneq ((mus-data g1) 1) .3) (snd-display #__line__ ";rand float-vectorset: ~A ~A" (v1 1) ((mus-data g1) 1)))
+ (float-vector-set! (mus-data g1) 1 .5)
+ (if (fneq (v1 1) .5) (snd-display #__line__ ";rand float-vectorref: ~A ~A" (v1 1) ((mus-data g1) 1))))
(let ((g1 (make-fir-filter :xcoeffs v1)))
(if (not (eq? v1 (mus-xcoeffs g1))) (snd-display #__line__ ";fir-filter xcoeffs not eq?: ~A ~A" v1 (mus-xcoeffs g1)))
(if (not (eqv? v1 (mus-xcoeffs g1))) (snd-display #__line__ ";fir-filter xcoeffs not eqv?: ~A ~A" v1 (mus-xcoeffs g1)))
(if (not (equal? v1 (mus-xcoeffs g1))) (snd-display #__line__ ";fir-filter xcoeffs not equal?: ~A ~A" v1 (mus-xcoeffs g1)))
- (vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-xcoeffs g1) 1) .3) (snd-display #__line__ ";fir-filter vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-xcoeffs g1) 1)))
- (vct-set! (mus-xcoeffs g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";fir-filter vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-xcoeffs g1) 1))))
+ (set! (v1 1) .3)
+ (if (fneq ((mus-xcoeffs g1) 1) .3) (snd-display #__line__ ";fir-filter float-vectorset: ~A ~A" (v1 1) ((mus-xcoeffs g1) 1)))
+ (float-vector-set! (mus-xcoeffs g1) 1 .5)
+ (if (fneq (v1 1) .5) (snd-display #__line__ ";fir-filter float-vectorref: ~A ~A" (v1 1) ((mus-xcoeffs g1) 1))))
(let ((g1 (make-iir-filter :ycoeffs v1)))
(if (not (eq? v1 (mus-ycoeffs g1))) (snd-display #__line__ ";iir-filter ycoeffs not eq?: ~A ~A" v1 (mus-ycoeffs g1)))
(if (not (eqv? v1 (mus-ycoeffs g1))) (snd-display #__line__ ";iir-filter ycoeffs not eqv?: ~A ~A" v1 (mus-ycoeffs g1)))
(if (not (equal? v1 (mus-ycoeffs g1))) (snd-display #__line__ ";iir-filter ycoeffs not equal?: ~A ~A" v1 (mus-ycoeffs g1)))
- (vct-set! v1 1 .3)
- (if (fneq (vct-ref (mus-ycoeffs g1) 1) .3) (snd-display #__line__ ";iir-filter vctset: ~A ~A" (vct-ref v1 1) (vct-ref (mus-ycoeffs g1) 1)))
- (vct-set! (mus-ycoeffs g1) 1 .5)
- (if (fneq (vct-ref v1 1) .5) (snd-display #__line__ ";iir-filter vctref: ~A ~A" (vct-ref v1 1) (vct-ref (mus-ycoeffs g1) 1))))
-
- (let ((f1 (make-frame 2 .1 .2))
- (f2 (make-frame 2 .3 .5))
- (f3 (make-frame 2 0 0)))
- (let ((f4 (frame+ f1 f2 f3)))
- (if (not (eq? f3 f4)) (snd-display #__line__ ";frame+ data not eq?: ~A ~A" f3 f4))
- (set! f4 (frame* f1 f2 f3))
- (if (not (eq? f3 f4)) (snd-display #__line__ ";frame* data not eq?: ~A ~A" f3 f4)))))
+ (set! (v1 1) .3)
+ (if (fneq ((mus-ycoeffs g1) 1) .3) (snd-display #__line__ ";iir-filter float-vectorset: ~A ~A" (v1 1) ((mus-ycoeffs g1) 1)))
+ (float-vector-set! (mus-ycoeffs g1) 1 .5)
+ (if (fneq (v1 1) .5) (snd-display #__line__ ";iir-filter float-vectorref: ~A ~A" (v1 1) ((mus-ycoeffs g1) 1))))
+ )
(let ((tanh-1 (lambda (x)
(+ x
@@ -27047,7 +21385,7 @@ EDITS: 2
(set! maxerr err)
(set! max-case (/ m n)))))))))
(if (> maxerr 1e-12)
- (format #t "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case))))
+ (snd-display #__line__ "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case))))
(let ((tag (catch #t
(lambda () (with-sound () (outa -1 .1)))
@@ -27056,18 +21394,20 @@ EDITS: 2
(snd-display #__line__ ";outa -1 -> ~A" tag)))
(let ((tag (catch #t
- (lambda () (let ((v (with-sound (:output (make-vct 10)) (outa -1 .1)))) v))
+ (lambda () (let ((v (with-sound ((make-float-vector 10)) (outa -1 .1)))) v))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";outa (vct) -1 -> ~A" tag)))
+ (snd-display #__line__ ";outa (float-vector) -1 -> ~A" tag)))
(let ((tag (catch #t
- (lambda () (let ((v (with-sound (:output (make-sound-data 1 10)) (outa -1 .1)))) v))
+ (lambda () (let ((v (with-sound ((make-float-vector (list 1 10) 0.0)) (outa -1 .1)))) v))
(lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";outa (sound-data) -1 -> ~A" tag)))
+ (snd-display #__line__ ";outa (vector 2) -1 -> ~A" tag)))
- (let ((v (with-sound () (run (outa -1 .1)))))
+ (let ((v (with-sound () (catch #t (lambda ()
+ (outa -1 .1))
+ (lambda args 'error)))))
(if (file-exists? v)
(begin
(if (> (cadr (mus-sound-maxamp v)) 0.0)
@@ -27076,14 +21416,706 @@ EDITS: 2
(snd-display #__line__ ";outa to file at -1 chans: ~A" (mus-sound-chans v)))
(if (find-sound v) (close-sound (find-sound v)))
(delete-file v))))
- (let ((v (with-sound (:output (make-vct 10)) (run (outa -1 .1)))))
- (if (> (vct-peak v) 0.0) (snd-display #__line__ ";outa to vct at -1: ~A" v)))
- (let ((v (with-sound (:output (make-sound-data 1 10)) (run (outa -1 .1)))))
- (if (> (sound-data-peak v) 0.0) (snd-display #__line__ ";outa to sound-data at -1: ~A" v)))
+ (let ((v (with-sound ((make-float-vector 10)) (catch #t (lambda ()
+ (outa -1 .1))
+ (lambda args 'error)))))
+ (if (> (float-vector-peak v) 0.0) (snd-display #__line__ ";outa to float-vector at -1: ~A" v)))
+ (let ((v (with-sound ((make-float-vector (list 1 10) 0.0)) (catch #t (lambda ()
+ (outa -1 .1))
+ (lambda args 'error)))))
+ (if (> (maxamp v) 0.0) (snd-display #__line__ ";outa to vector1 at -1: ~A" v)))
(if (not (= (signum 0) 0)) (snd-display #__line__ ";signum 0: ~A" (signum 0)))
(if (not (= (signum 10) 1)) (snd-display #__line__ ";signum 10: ~A" (signum 10)))
(if (not (= (signum -32) -1)) (snd-display #__line__ ";signum -32: ~A" (signum -32)))
+
+
+ (let ((c1 (make-comb .5 3))
+ (c2 (make-comb-bank (vector (make-comb .5 3)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 20))
+ (let ((x0 (comb c1 x))
+ (x1 (comb-bank c2 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(comb .5 3) ~A, comb: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-comb .5 3))
+ (c2 (make-comb .2 10))
+ (c3 (make-comb-bank (vector (make-comb .5 3)
+ (make-comb .2 10)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 30))
+ (let ((x0 (+ (comb c1 x) (comb c2 x)))
+ (x1 (comb-bank c3 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(comb .5 3) + (comb .2 10) ~A, comb: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-comb .5 3))
+ (c2 (make-comb .2 10))
+ (c3 (make-comb -.7 11))
+ (c4 (make-comb-bank (vector (make-comb .5 3)
+ (make-comb .2 10)
+ (make-comb -.7 11)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (comb c1 x) (comb c2 x) (comb c3 x)))
+ (x1 (comb-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(comb .5 3) + (comb .2 10) + (comb -.7 11) ~A, comb: ~A, bank: ~A" i x0 x1)))))
+
+
+ (let ((c1 (make-all-pass -.5 .5 3))
+ (c2 (make-all-pass-bank (vector (make-all-pass -.5 .5 3)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 20))
+ (let ((x0 (all-pass c1 x))
+ (x1 (all-pass-bank c2 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(all-pass -.5 .5 3) ~A, all-pass: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-all-pass -.5 .5 3))
+ (c2 (make-all-pass -.2 .2 10))
+ (c3 (make-all-pass-bank (vector (make-all-pass -.5 .5 3)
+ (make-all-pass -.2 .2 10)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 30))
+ (let ((x0 (all-pass c1 (all-pass c2 x)))
+ (x1 (all-pass-bank c3 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(all-pass -.5 .5 3) + (all-pass -.2 .2 10) ~A, all-pass: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-all-pass -.5 .5 3))
+ (c2 (make-all-pass -.2 .2 10))
+ (c3 (make-all-pass -.7 .1 11))
+ (c4 (make-all-pass-bank (vector (make-all-pass -.5 .5 3)
+ (make-all-pass -.2 .2 10)
+ (make-all-pass -.7 .1 11)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (all-pass c1 (all-pass c2 (all-pass c3 x))))
+ (x1 (all-pass-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(all-pass -.5 .5 3) + (all-pass -.2 .2 10) + (all-pass -.7 .1 11) ~A, all-pass: ~A, bank: ~A" i x0 x1)))))
+
+
+
+ (let ((c1 (make-filtered-comb .5 3))
+ (c2 (make-filtered-comb-bank (vector (make-filtered-comb .5 3)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 20))
+ (let ((x0 (filtered-comb c1 x))
+ (x1 (filtered-comb-bank c2 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(filtered-comb .5 3) ~A, filtered-comb: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-filtered-comb .5 3))
+ (c2 (make-filtered-comb .2 10))
+ (c3 (make-filtered-comb-bank (vector (make-filtered-comb .5 3)
+ (make-filtered-comb .2 10)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 30))
+ (let ((x0 (+ (filtered-comb c1 x) (filtered-comb c2 x)))
+ (x1 (filtered-comb-bank c3 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(filtered-comb .5 3) + (filtered-comb .2 10) ~A, filtered-comb: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-filtered-comb .5 3))
+ (c2 (make-filtered-comb .2 10))
+ (c3 (make-filtered-comb -.7 11))
+ (c4 (make-filtered-comb-bank (vector (make-filtered-comb .5 3)
+ (make-filtered-comb .2 10)
+ (make-filtered-comb -.7 11)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (filtered-comb c1 x) (filtered-comb c2 x) (filtered-comb c3 x)))
+ (x1 (filtered-comb-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(filtered-comb .5 3) + (filtered-comb .2 10) + (filtered-comb -.7 11) ~A, filtered-comb: ~A, bank: ~A" i x0 x1)))))
+
+
+ ;; make-formant-bank tests
+ (let ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant-bank (vector (make-formant 440.0 .5)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (formant c1 x))
+ (x1 (formant-bank c2 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(formant 440.0 .5) ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x)))
+ (x1 (formant-bank c3 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(formant 440.0 .5) + (formant 1000.0 .2) ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant 34.0 .1))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)
+ (make-formant 34.0 .1)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
+ (x1 (formant-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(formant 440.0 .5) + (formant 1000.0 .2) + (formant 34.0 .1) ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .75))
+ (c2 (make-formant 1000.0 .75))
+ (c3 (make-formant 34.0 .75))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .75)
+ (make-formant 1000.0 .75)
+ (make-formant 34.0 .75)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
+ (x1 (formant-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";(formant 440.0 .75) + (formant 1000.0 .75) + (formant 34.0 .75) ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant 34.0 .1))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)
+ (make-formant 34.0 .1))
+ (float-vector .5 .3 .4))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
+ (x1 (formant-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 3 with amps at ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .9))
+ (c2 (make-formant 1000.0 .9))
+ (c3 (make-formant 34.0 .9))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .9)
+ (make-formant 1000.0 .9)
+ (make-formant 34.0 .9))
+ (float-vector .5 .3 .4))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
+ (x1 (formant-bank c4 x)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 3 with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant 34.0 .1))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)
+ (make-formant 34.0 .1)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";many (formant 440.0 .5) + (formant 1000.0 .2) + (formant 34.0 .1) ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .75))
+ (c2 (make-formant 1000.0 .75))
+ (c3 (make-formant 34.0 .75))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .75)
+ (make-formant 1000.0 .75)
+ (make-formant 34.0 .75)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (formant c1 x) (formant c2 x) (formant c3 x)))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";many (formant 440.0 .75) + (formant 1000.0 .75) + (formant 34.0 .75) ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+
+ (let ((c1 (make-formant 440.0 .5))
+ (c2 (make-formant 1000.0 .2))
+ (c3 (make-formant 34.0 .1))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .5)
+ (make-formant 1000.0 .2)
+ (make-formant 34.0 .1))
+ (float-vector .5 .3 .4))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 3 with amps at ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .9))
+ (c2 (make-formant 1000.0 .9))
+ (c3 (make-formant 34.0 .9))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .9)
+ (make-formant 1000.0 .9)
+ (make-formant 34.0 .9))
+ (float-vector .5 .3 .4))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0))
+ ((= i 40))
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 x)) (* .4 (formant c3 x))))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 3 with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))))
+
+ (let ((c1 (make-formant 440.0 .9))
+ (c2 (make-formant 1000.0 .9))
+ (c3 (make-formant 34.0 .9))
+ (inputs (make-float-vector 3 1.0))
+ (c4 (make-formant-bank (vector (make-formant 440.0 .9)
+ (make-formant 1000.0 .9)
+ (make-formant 34.0 .9))
+ (float-vector .5 .3 .4))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0)
+ (y 1.0 0.0)
+ (z 1.0 0.0))
+ ((= i 40))
+ (if (< i 10)
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 y)) (* .4 (formant c3 z))))
+ (x1 (formant-bank c4 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 3(1) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))
+ (if (< i 20)
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 y)) (* .4 (formant c3 z))))
+ (x1 (formant-bank c4 0.0)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 3(2) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))
+ (if (< i 30)
+ (begin
+ (set! x 0.5)
+ (set! y 0.25)
+ (set! z 0.125)
+ (set! (inputs 0) x)
+ (set! (inputs 1) y)
+ (set! (inputs 2) z)
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 y)) (* .4 (formant c3 z))))
+ (x1 (formant-bank c4 inputs)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 3(3) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+ (begin
+ (set! x 0.25)
+ (set! y 0.25)
+ (set! z 0.25)
+ (let ((x0 (+ (* .5 (formant c1 x)) (* .3 (formant c2 y)) (* .4 (formant c3 z))))
+ (x1 (formant-bank c4 .25)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 3(4) with amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))))))))
+
+ (let ((c1 (make-formant 440.0 .9))
+ (c2 (make-formant 1000.0 .9))
+ (c3 (make-formant 34.0 .9))
+ (c4 (make-formant 340.0 .9))
+ (c5 (make-formant 2000.0 .9))
+ (inputs (make-float-vector 5 1.0))
+ (c6 (make-formant-bank (vector (make-formant 440.0 .9)
+ (make-formant 1000.0 .9)
+ (make-formant 34.0 .9)
+ (make-formant 340.0 .9)
+ (make-formant 2000.0 .9)))))
+ (do ((i 0 (+ i 1))
+ (x 1.0 0.0)
+ (y 1.0 0.0)
+ (z 1.0 0.0)
+ (a 1.0 0.0)
+ (b 1.0 0.0))
+ ((= i 40))
+ (if (< i 10)
+ (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
+ (x1 (formant-bank c6 inputs)))
+ (fill! inputs 0.0)
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 5(1) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))
+ (if (< i 20)
+ (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
+ (x1 (formant-bank c6 0.0)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 5(2) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))
+ (if (< i 30)
+ (begin
+ (set! x 0.5)
+ (set! y 0.25)
+ (set! z 0.125)
+ (set! a .1)
+ (set! b .3)
+ (set! (inputs 0) x)
+ (set! (inputs 1) y)
+ (set! (inputs 2) z)
+ (set! (inputs 3) a)
+ (set! (inputs 4) b)
+ (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
+ (x1 (formant-bank c6 inputs)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 5(3) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1))))
+ (begin
+ (set! x 0.25)
+ (set! y 0.25)
+ (set! z 0.25)
+ (set! a 0.25)
+ (set! b 0.25)
+ (let ((x0 (+ (formant c1 x) (formant c2 y) (formant c3 z) (formant c4 a) (formant c5 b)))
+ (x1 (formant-bank c6 .25)))
+ (if (not (morally-equal? x0 x1))
+ (snd-display #__line__ ";fb 5(4) no amps c1_c2 at ~A, formant: ~A, bank: ~A" i x0 x1)))))))))
+
+ (set! *clm-srate* 44100)
+ (if (file-exists? "jcrev-ip.snd")
+ (begin
+ (with-sound (:reverb jc-reverb) (outa 0 .1) (outa 0 .5 *reverb*))
+ (let ((s1 (find-sound "test.snd"))
+ (s2 (open-sound "jcrev-ip.snd")))
+ (if (not (= (channel-distance s1 0 s2 0) 0.0))
+ (snd-display #__line__ ";jcrev ip: ~A" (channel-distance s1 0 s2 0)))
+ (close-sound s1)
+ (close-sound s2))))
+
+ (if (file-exists? "nrev-ip.snd")
+ (begin
+ (with-sound (:reverb nrev) (outa 0 .1) (outa 0 .5 *reverb*))
+ (let ((s1 (find-sound "test.snd"))
+ (s2 (open-sound "nrev-ip.snd")))
+ (if (not (= (channel-distance s1 0 s2 0) 0.0))
+ (snd-display #__line__ ";nrev ip: ~A" (channel-distance s1 0 s2 0)))
+ (close-sound s1)
+ (close-sound s2))))
+
+ (if (file-exists? "freeverb-ip.snd")
+ (begin
+ (with-sound (:reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*))
+ (let ((s1 (find-sound "test.snd"))
+ (s2 (open-sound "freeverb-ip.snd")))
+ (if (not (= (channel-distance s1 0 s2 0) 0.0))
+ (snd-display #__line__ ";freeverb ip: ~A" (channel-distance s1 0 s2 0)))
+ (close-sound s1)
+ (close-sound s2))))
+
+ (let ()
+ (defgenerator (old-rxyk!sin
+ :make-wrapper (lambda (g)
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ g))
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm)
+
+ (define* (old-rxyk!sin gen (fm 0.0))
+ (set! (gen 'fm) fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio)))
+ (set! angle (+ x fm frequency))
+ (/ (* (exp (* r (cos y)))
+ (sin (+ x (* r (sin y)))))
+ (exp (abs r))))))
+
+ (defgenerator (old-rxyk!cos
+ :make-wrapper (lambda (g)
+ (set! (g 'frequency) (hz->radians (g 'frequency)))
+ (set! (g 'ar) (/ 1.0 (exp (abs (g 'r)))))
+ g))
+ (frequency *clm-default-frequency*) (ratio 1.0) (r 0.5) (angle 0.0) fm ar)
+
+ (define* (old-rxyk!cos gen (fm 0.0))
+ (set! (gen 'fm) fm)
+ (with-let gen
+ (let* ((x angle)
+ (y (* x ratio)))
+ (set! angle (+ x fm frequency))
+ (* (exp (* r (cos y)))
+ (cos (+ x (* r (sin y))))
+ ar))))
+
+ (define-macro (define-memoized name&arg . body)
+ (let ((arg (cadr name&arg))
+ (memo (gensym "memo")))
+ `(define ,(car name&arg)
+ (let ((,memo (make-hash-table)))
+ (lambda (,arg)
+ (or (,memo ,arg) ; check for saved value
+ (set! (,memo ,arg) (begin , at body)))))))) ; set! returns the new value
+
+ (define-memoized (kfactorial n)
+ (define (k n m)
+ (if (<= n m)
+ n
+ (* (k n (* 2 m))
+ (k (- n m) (* 2 m)))))
+ (if (zero? n)
+ 1
+ (k n 1)))
+
+ (define (rxyk!cos-direct x y a terms)
+ (let ((sum 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k terms) (/ sum (exp (abs a))))
+ (set! sum (+ sum (* (/ (expt a k) (kfactorial k))
+ (cos (+ x (* k y)))))))))
+
+ (define (rxyk!sin-direct x y a terms)
+ (let ((sum 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k terms) (/ sum (exp (abs a))))
+ (set! sum (+ sum (* (/ (expt a k) (kfactorial k))
+ (sin (+ x (* k y)))))))))
+
+
+ (let ((g1 (make-rxyk!cos 100.0))
+ (g2 (make-old-rxyk!cos 100.0))
+ (x3 (hz->radians 100.0)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x x3)))
+ ((= i 100))
+ (let ((v1 (rxyk!cos g1))
+ (v2 (old-rxyk!cos g2))
+ (v3 (rxyk!cos-direct x x 0.5 12)))
+ (if (or (> (abs (- v1 v2)) 1e-6)
+ (> (abs (- v1 v3)) 1e-6))
+ (format #t ";rxyk!cos ~A ~A: ~A ~A ~A -> ~A~%" i x v1 v2 v3 (max (abs (- v1 v2)) (abs (- v1 v3))))))))
+
+ (let ((g1 (make-rxyk!sin 100.0))
+ (g2 (make-old-rxyk!sin 100.0))
+ (x3 (hz->radians 100.0)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x x3)))
+ ((= i 100))
+ (let ((v1 (rxyk!sin g1))
+ (v2 (old-rxyk!sin g2))
+ (v3 (rxyk!sin-direct x x 0.5 12)))
+ (if (or (> (abs (- v1 v2)) 1e-6)
+ (> (abs (- v1 v3)) 1e-6))
+ (format #t ";rxyk!sin ~A ~A: ~A ~A ~A -> ~A~%" i x v1 v2 v3 (max (abs (- v1 v2)) (abs (- v1 v3))))))))
+
+ (let ((g1 (make-rxyk!cos 100.0 :ratio 2.0 :r 0.25))
+ (g2 (make-old-rxyk!cos 100.0 :ratio 2.0 :r 0.25)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((v1 (rxyk!cos g1))
+ (v2 (old-rxyk!cos g2)))
+ (if (> (abs (- v1 v2)) 1e-6)
+ (format #t ";rxyk!cos ratio:2: ~A: ~A ~A -> ~A~%" i v1 v2 (abs (- v1 v2)))))))
+
+ (let ((g1 (make-rxyk!sin 100.0 :ratio 2.0 :r 0.25))
+ (g2 (make-old-rxyk!sin 100.0 :ratio 2.0 :r 0.25)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((v1 (rxyk!sin g1))
+ (v2 (old-rxyk!sin g2)))
+ (if (> (abs (- v1 v2)) 1e-6)
+ (format #t ";rxyk!sin ratio:2: ~A: ~A ~A -> ~A~%" i v1 v2 (abs (- v1 v2)))))))
+
+ (let ((g1 (make-rxyk!cos 100.0 :ratio 2.0 :r 0.25))
+ (o1 (make-oscil 400.0))
+ (g2 (make-old-rxyk!cos 100.0 :ratio 2.0 :r 0.25))
+ (o2 (make-oscil 400.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((v1 (rxyk!cos g1 (oscil o1)))
+ (v2 (old-rxyk!cos g2 (oscil o2))))
+ (if (> (abs (- v1 v2)) 1e-6)
+ (format #t ";rxyk!cos fm ~A: ~A ~A -> ~A~%" i v1 v2 (abs (- v1 v2)))))))
+
+ (let ((g1 (make-rxyk!sin 100.0 :ratio 2.0 :r 0.25))
+ (o1 (make-oscil 400.0))
+ (g2 (make-old-rxyk!sin 100.0 :ratio 2.0 :r 0.25))
+ (o2 (make-oscil 400.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (let ((v1 (rxyk!sin g1 (oscil o1)))
+ (v2 (old-rxyk!sin g2 (oscil o2))))
+ (if (> (abs (- v1 v2)) 1e-6)
+ (format #t ";rxyk!sin fm ~A: ~A ~A -> ~A~%" i v1 v2 (abs (- v1 v2))))))))
+
+ (let ()
+ (defgenerator one-pole-allpass coeff input x1 y1)
+
+ (define (one-pole-allpass gen input)
+ (set! (gen 'input) input)
+ (with-let gen
+ (set! y1 (+ x1 (* coeff (- input y1))))
+ (set! x1 input)
+ y1))
+
+ (defgenerator one-pole-allpass-bank coeff input x1 y1 x2 y2 x3 y3 x4 y4 x5 y5 x6 y6 x7 y7 x8 y8)
+
+ (define (one-pole-allpass-bank gen input)
+ (set! (gen 'input) input)
+ (with-let gen
+ (set! y1 (+ x1 (* coeff (- input y1))))
+ (set! x1 input)
+
+ (set! y2 (+ x2 (* coeff (- y1 y2))))
+ (set! x2 y1)
+
+ (set! y3 (+ x3 (* coeff (- y2 y3))))
+ (set! x3 y2)
+
+ (set! y4 (+ x4 (* coeff (- y3 y4))))
+ (set! x4 y3)
+
+ (set! y5 (+ x5 (* coeff (- y4 y5))))
+ (set! x5 y4)
+
+ (set! y6 (+ x6 (* coeff (- y5 y6))))
+ (set! x6 y5)
+
+ (set! y7 (+ x7 (* coeff (- y6 y7))))
+ (set! x7 y6)
+
+ (set! y8 (+ x8 (* coeff (- y7 y8))))
+ (set! x8 y7)
+ y8))
+
+ (let ((o1 (make-one-pole-all-pass 1 .5))
+ (o2 (make-one-pole-allpass .5)))
+ (do ((i 0 (+ i 1))
+ (impulse 1.0 0.0))
+ ((= i 30))
+ (let ((v1 (one-pole-all-pass o1 impulse))
+ (v2 (one-pole-allpass o2 impulse)))
+ (if (> (abs (- v1 v2)) 1e-6)
+ (format #t ";one-pole-all-pass (1) ~A: ~A ~A -> ~A~%" i v1 v2 (abs (- v1 v2)))))))
+
+ (let ((o1 (make-one-pole-all-pass 8 .5))
+ (o2 (make-one-pole-allpass-bank .5)))
+ (do ((i 0 (+ i 1))
+ (impulse 1.0 0.0))
+ ((= i 30))
+ (let ((v1 (one-pole-all-pass o1 impulse))
+ (v2 (one-pole-allpass-bank o2 impulse)))
+ (if (> (abs (- v1 v2)) 1e-6)
+ (format #t ";one-pole-all-pass (1) ~A: ~A ~A -> ~A~%" i v1 v2 (abs (- v1 v2)))))))
+ )
+
+ (let ((old-srate *clm-srate*))
+ (set! *clm-srate* 44100)
+ (let ((pe (make-pulsed-env '(0 0 1 1 2 0) .0004 2205))
+ (v (make-float-vector 100)))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (set! (v i) (pulsed-env pe)))
+ (if (not (vequal v (float-vector 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
+ 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
+ 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
+ 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000
+ 0.000 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000 0.875 0.750 0.625 0.500 0.375 0.250 0.125 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";pulsed-env: ~A" v)))
+ (set! *clm-srate* old-srate))
+
+ (copy-test (make-oscil 330.0))
+ (copy-test (make-ncos 440.0 10))
+ (copy-test (make-nsin 440.0 10))
+ (copy-test (make-nrxycos 330.0 0.9 10))
+ (copy-test (make-nrxysin 330.0 0.9 10))
+ (copy-test (make-rxyk!cos 440.0))
+ (copy-test (make-rxyk!sin 440.0))
+ (copy-test (make-sawtooth-wave 100))
+ (copy-test (make-pulse-train 100))
+ (copy-test (make-triangle-wave 100))
+ (copy-test (make-square-wave 100))
+ (copy-test (make-one-zero .1 .2))
+ (copy-test (make-one-pole .1 .2))
+ (copy-test (make-two-zero .9 .1 .2))
+ (copy-test (make-two-pole .9 .1 .2))
+ (copy-test (make-polywave 440.0 '(1 .5 2 .5)))
+ (copy-test (make-polyshape 440.0 :coeffs (partials->polynomial '(1 1.0))))
+ (copy-test (make-oscil-bank (float-vector 100 200 300) (float-vector 0.0 1.0 2.0) (float-vector 0.5 0.25 0.125)))
+ (copy-test (make-delay 10))
+ (copy-test (make-comb .7 10))
+ (copy-test (make-notch .7 10))
+ (copy-test (make-all-pass .8 .7 10))
+ (copy-test (make-moving-average 10))
+ (copy-test (make-moving-norm 10))
+ (copy-test (make-moving-max 10))
+ (copy-test (make-comb-bank (vector (make-comb 0.742 99) (make-comb 0.733 49) (make-comb 0.715 53))))
+ (copy-test (make-all-pass-bank (vector (make-all-pass -0.700 0.700 51) (make-all-pass -0.700 0.700 33) (make-all-pass -0.700 0.700 11))))
+ (copy-test (make-filtered-comb .4 5 :filter (make-one-zero .3 .7)))
+ (copy-test (make-filtered-comb-bank (vector (make-filtered-comb .5 3) (make-filtered-comb .2 10) (make-filtered-comb -.7 11))))
+ (copy-test (make-formant 1200.0 0.9))
+ (copy-test (make-firmant 1200.0 0.9))
+ (copy-test (make-fir-filter 4 (float-vector 0.4 0.3 0.2 0.1)))
+ (copy-test (make-iir-filter 4 (float-vector 0.4 0.3 0.2 0.1)))
+ (copy-test (make-filter 4 (float-vector 0.4 0.3 0.2 0.1)))
+ (copy-test (make-one-pole-all-pass 8 .5))
+ (copy-test (make-readin "oboe.snd"))
+ (copy-test (make-env '(0 0 1 1) :length 10))
+ (copy-test (make-pulsed-env '(0 0 1 1) .001 1000))
+
+ ;; formant-bank isn't really testing equality yet
+
+ (let ((o (make-rand 100.0)))
+ (let ((p (copy o)))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";rand copy ~A != ~A~%" o p))))
+
+ (let ((o (make-rand-interp 100.0)))
+ (let ((p (copy o)))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";rand-interp copy ~A != ~A~%" o p))))
+
+ (let ((v1 (make-float-vector 10 .1)))
+ (let ((o (make-rand 100.0 :distribution v1)))
+ (let ((p (copy o)))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";rand+dist copy ~A != ~A~%" o p))))
+
+ (let ((o (make-rand-interp 100.0 :distribution v1)))
+ (let ((p (copy o)))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";rand-interp+dist copy ~A != ~A~%" o p)))))
+
+ (let ((o (make-nssb 440.0)))
+ (let ((p (copy o)))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";nssb copy ~A != ~A~%" o p))
+ (nssb o 1.0)
+ (if (equal? o p)
+ (snd-display #__line__ ";nssb copy/run ~A == ~A~%" o p))))
+
+ (let ((v1 (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9)))
+ (let ((o (make-wave-train 100 :wave v1)))
+ (let ((p (copy o)))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";wave-train copy ~A != ~A~%" o p)))))
+
+ (let ((v1 (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9)))
+ (let ((o (make-table-lookup 440.0 :wave v1)))
+ (let ((p (copy o)))
+ (if (not (equal? o p))
+ (snd-display #__line__ ";table-lookup copy ~A != ~A~%" o p))
+ (table-lookup o 1.0)
+ (if (equal? o p)
+ (snd-display #__line__ ";table-lookup run ~A == ~A~%" o p)))))
))
@@ -27161,24 +22193,23 @@ EDITS: 2
;; Columbia, Gem of the Ocean
(define (seg data) ; SEG functions expected data in (y x) pairs.
- (let ((unseg '())
+ (let ((unseg ())
(len (length data)))
(do ((i 0 (+ i 2)))
- ((>= i len))
- (let ((x (list-ref data (+ 1 i)))
- (y (list-ref data i)))
- (set! unseg (cons x unseg))
- (set! unseg (cons y unseg))))
- (reverse unseg)))
+ ((>= i len)
+ (reverse unseg))
+ (let ((x (data (+ i 1)))
+ (y (data i)))
+ (set! unseg (cons y (cons x unseg)))))))
(let ((oldie (find-sound "test.snd")))
(if (sound? oldie)
(close-sound oldie)))
- (let* ((soprano '())
- (alto '())
- (tenor '())
- (bass '())
+ (let ((soprano ())
+ (alto ())
+ (tenor ())
+ (bass ())
(ind (new-sound "test.snd" :channels 1))
@@ -27201,7 +22232,7 @@ EDITS: 2
)
(define (mix-fmsimp beg dur freq amp ampfunc freqfunc rat1 indx1 rat2 indx2 ignored)
- (let* ((freq1 (if (> freq (/ (mus-srate) 8)) (/ freq 8) freq))
+ (let ((freq1 (if (> freq (/ *clm-srate* 8)) (/ freq 8) freq))
(amp1 (* amp .175)))
(let ((id (car (mix (with-temp-sound ()
(fm-violin 0 dur freq1 amp1
@@ -27369,10 +22400,10 @@ EDITS: 2
((= test-ctr tests))
(let ((ind (new-sound "test.snd" :size 10)))
- (let ((v (vct .1 .2 .3)))
- (let ((id (mix-vct v 0)))
- (let ((nv (channel->vct)))
- (if (not (vequal nv (vct .1 .2 .3 0 0 0 0 0 0 0)))
+ (let ((v (float-vector .1 .2 .3)))
+ (let ((id (mix-float-vector v 0)))
+ (let ((nv (channel->float-vector)))
+ (if (not (vequal nv (float-vector .1 .2 .3 0 0 0 0 0 0 0)))
(snd-display #__line__ ";mix v at 0: ~A" nv)))
(let ((eds (edit-tree ind 0)))
(if (not (feql eds '((0 0 0 2 0.0 0.0 0.0 3) (3 0 3 9 0.0 0.0 0.0 2) (10 -2 0 0 0.0 0.0 0.0 0))))
@@ -27382,40 +22413,40 @@ EDITS: 2
(if (fneq (mix-amp id) 1.0) (snd-display #__line__ ";mix v at 0 amp: ~A" (mix-amp id)))
(if (fneq (mix-speed id) 1.0) (snd-display #__line__ ";mix v at 0 speed: ~A" (mix-speed id)))
(if (not (= (mix-sync id) 0)) (snd-display #__line__ ";mix v at 0 sync: ~A" (mix-sync id)))
- (if (not (equal? (mix-amp-env id) '())) (snd-display #__line__ ";mix v at 0 amp-env: ~A" (mix-amp-env id)))
+ (if (not (null? (mix-amp-env id))) (snd-display #__line__ ";mix v at 0 amp-env: ~A" (mix-amp-env id)))
(if (not (= (mix-position id) 0)) (snd-display #__line__ ";mix v at 0 beg: ~A" (mix-position id)))
(if (not (= (mix-length id) 3)) (snd-display #__line__ ";mix v at 0 length: ~A" (mix-length id)))
- (if (not (equal? (mix-name id) #f)) (snd-display #__line__ ";mix v at 0 name: ~A" (mix-name id)))
- (if (not (equal? (mix-properties id) '())) (snd-display #__line__ ";mix v at 0 properties: ~A" (mix-properties id)))
- (if (not (equal? (mix-color id) (mix-color))) (snd-display #__line__ ";mix v at 0 color: ~A" (mix-color id)))
+ (if (not (equal? (mix-name id) "")) (snd-display #__line__ ";mix v at 0 name: ~A" (mix-name id)))
+ (if (not (null? (mix-properties id))) (snd-display #__line__ ";mix v at 0 properties: ~A" (mix-properties id)))
+ (if (not (equal? (mix-color id) *mix-color*)) (snd-display #__line__ ";mix v at 0 color: ~A" (mix-color id)))
(if (not (= (mix-tag-y id) 0)) (snd-display #__line__ ";mix v at 0 tag-y: ~A" (mix-tag-y id)))
(let ((sf (make-mix-sampler id))
- (data (make-vct 10)))
- (do ((i 0 (+ 1 i)))
+ (data (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (read-mix-sample sf)))
- (if (not (vequal data (channel->vct)))
+ (set! (data i) (read-mix-sample sf)))
+ (if (not (vequal data (channel->float-vector)))
(snd-display #__line__ ";mix v at 0 read mix samples: ~A" data))
(if (not (sampler-at-end? sf)) (snd-display #__line__ ";mix v at 0 reader not at end?"))
(free-sampler sf))
(if (not (equal? (mixes ind 0) (list id))) (snd-display #__line__ ";mix v at 0 mixes: ~A" (mixes ind 0)))
(if (not (equal? (mix-home id) (list ind 0 #f 0))) (snd-display #__line__ ";mix v at 0 home: ~A" (mix-home id)))
(undo))
- (let ((id (mix-vct v 8)))
- (if (not (= (frames ind 0) 11)) (snd-display #__line__ ";mix v at 8 new len: ~A" (frames ind 0)))
- (let ((nv (channel->vct)))
- (if (not (vequal nv (vct 0 0 0 0 0 0 0 0 .1 .2 .3)))
- (snd-display #__line__ ";mix v at 8: ~A" nv)))
- (undo))
- (let ((id (mix-vct v 3)))
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";mix v at 3 new len: ~A" (frames ind 0)))
- (let ((nv (channel->vct)))
- (if (not (vequal nv (vct 0 0 0 .1 .2 .3 0 0 0 0)))
- (snd-display #__line__ ";mix v at 3: ~A" nv)))
- (undo)))
- (let ((v (make-vct 20 .5)))
- (let ((id (mix-vct v 0)))
- (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";mix v20 at 0 new len: ~A" (frames ind 0)))))
+ (mix-float-vector v 8)
+ (if (not (= (framples ind 0) 11)) (snd-display #__line__ ";mix v at 8 new len: ~A" (framples ind 0)))
+ (let ((nv (channel->float-vector)))
+ (if (not (vequal nv (float-vector 0 0 0 0 0 0 0 0 .1 .2 .3)))
+ (snd-display #__line__ ";mix v at 8: ~A" nv)))
+ (undo)
+ (mix-float-vector v 3)
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";mix v at 3 new len: ~A" (framples ind 0)))
+ (let ((nv (channel->float-vector)))
+ (if (not (vequal nv (float-vector 0 0 0 .1 .2 .3 0 0 0 0)))
+ (snd-display #__line__ ";mix v at 3: ~A" nv)))
+ (undo))
+ (let ((v (make-float-vector 20 .5)))
+ (mix-float-vector v 0)
+ (if (not (= (framples ind 0) 20)) (snd-display #__line__ ";mix v20 at 0 new len: ~A" (framples ind 0))))
(close-sound ind))
(let ((ind (new-sound "test.snd" :size 100000)))
@@ -27425,70 +22456,70 @@ EDITS: 2
(if (fneq (mix-amp id) 1.0) (snd-display #__line__ ";mix oboe at 0 amp: ~A" (mix-amp id)))
(if (fneq (mix-speed id) 1.0) (snd-display #__line__ ";mix oboe at 0 speed: ~A" (mix-speed id)))
(if (not (= (mix-sync id) 0)) (snd-display #__line__ ";mix oboe at 0 sync: ~A" (mix-sync id)))
- (if (not (equal? (mix-amp-env id) '())) (snd-display #__line__ ";mix oboe at 0 amp-env: ~A" (mix-amp-env id)))
+ (if (not (null? (mix-amp-env id))) (snd-display #__line__ ";mix oboe at 0 amp-env: ~A" (mix-amp-env id)))
(if (not (= (mix-position id) 0)) (snd-display #__line__ ";mix oboe at 0 beg: ~A" (mix-position id)))
(if (not (= (mix-length id) 50828)) (snd-display #__line__ ";mix oboe at 0 length: ~A" (mix-length id)))
- (if (not (equal? (mix-name id) #f)) (snd-display #__line__ ";mix oboe at 0 name: ~A" (mix-name id)))
- (if (not (equal? (mix-properties id) '())) (snd-display #__line__ ";mix oboe at 0 properties: ~A" (mix-properties id)))
- (if (not (equal? (mix-color id) (mix-color))) (snd-display #__line__ ";mix oboe at 0 color: ~A" (mix-color id)))
+ (if (not (equal? (mix-name id) "")) (snd-display #__line__ ";mix oboe at 0 name: ~A" (mix-name id)))
+ (if (not (null? (mix-properties id))) (snd-display #__line__ ";mix oboe at 0 properties: ~A" (mix-properties id)))
+ (if (not (equal? (mix-color id) *mix-color*)) (snd-display #__line__ ";mix oboe at 0 color: ~A" (mix-color id)))
(if (not (= (mix-tag-y id) 0)) (snd-display #__line__ ";mix oboe at 0 tag-y: ~A" (mix-tag-y id)))
(if (fneq (maxamp ind 0) .14724) (snd-display #__line__ ";mix oboe maxamp: ~A" (maxamp ind 0)))
(if (not (equal? (mixes ind 0) (list id))) (snd-display #__line__ ";mix oboe at 0 mixes: ~A" (mixes ind 0)))
(if (not (equal? (mix-home id) (list ind 0 "/home/bil/cl/oboe.snd" 0))) (snd-display #__line__ ";mix oboe at 0 home: ~A" (mix-home id))))
(undo)
- (let ((id (car (mix "oboe.snd" 70000))))
- (if (not (= (frames ind 0) (+ 70000 50828))) (snd-display #__line__ ";mix oboe at 70k frames: ~A" (frames ind 0))))
+ (mix "oboe.snd" 70000)
+ (if (not (= (framples ind 0) (+ 70000 50828))) (snd-display #__line__ ";mix oboe at 70k framples: ~A" (framples ind 0)))
(close-sound ind))
(let ((ind (new-sound "test.snd" :size 10)))
- (let ((v (vct .1 .2 .3)))
- (let ((id (mix-vct v 0)))
+ (let ((v (float-vector .1 .2 .3)))
+ (let ((id (mix-float-vector v 0)))
(scale-by 2.0)
(if (not (mix? id)) (snd-display #__line__ ";scaled (2) mix not active?"))
- (let ((nv (channel->vct)))
- (if (not (vequal nv (vct-scale! (vct .1 .2 .3 0 0 0 0 0 0 0) 2.0)))
+ (let ((nv (channel->float-vector)))
+ (if (not (vequal nv (float-vector-scale! (float-vector .1 .2 .3 0 0 0 0 0 0 0) 2.0)))
(snd-display #__line__ ";mix v at 0 scale-by 2: ~A" nv)))
(if (fneq (mix-amp id) 2.0) (snd-display #__line__ ";mix then scale mix amp: ~A" (mix-amp id)))
(undo)
(delete-sample 1)
(if (not (mix? id)) (snd-display #__line__ ";delete hit mix: ~A" (mix? id)))
- (let ((nv (channel->vct)))
- (if (not (vequal nv (vct .1 .3 0 0 0 0 0 0 0)))
+ (let ((nv (channel->float-vector)))
+ (if (not (vequal nv (float-vector .1 .3 0 0 0 0 0 0 0)))
(snd-display #__line__ ";mix v at 0 delete .2: ~A" nv)))
(revert-sound ind))
- (let ((id (mix-vct v 0)))
+ (let ((id (mix-float-vector v 0)))
(delete-sample 7)
(reverse-sound ind 0)
(if (not (mix? id)) (snd-display #__line__ ";reversed mix: ~A" (mix? id)))
- (let ((nv (channel->vct)))
- (if (not (vequal nv (vct-reverse! (vct .1 .2 .3 0 0 0 0 0 0))))
+ (let ((nv (channel->float-vector)))
+ (if (not (vequal nv (reverse! (float-vector .1 .2 .3 0 0 0 0 0 0))))
(snd-display #__line__ ";mix v at 0 reversed: ~A" nv)))
(undo)
(if (not (mix? id)) (snd-display #__line__ ";revert reverse mix: ~A" (mix? id)))
(map-channel (lambda (y) .1))
(if (not (mix? id)) (snd-display #__line__ ";clobbered mix: ~A" (mixes)))
(scale-by 2.0)
- (let ((id (mix-vct v 0)))
+ (let ((id (mix-float-vector v 0)))
(if (not (mix? id)) (snd-display #__line__ ";mix on scale (2) not active?"))
(scale-by 3.0)
(if (not (mix? id)) (snd-display #__line__ ";scaled (3) mix not active?"))
- (let ((nv (channel->vct)))
- (if (not (vequal nv (vct-scale! (vct-add! (make-vct 9 .2) (vct .1 .2 .3)) 3.0)))
+ (let ((nv (channel->float-vector)))
+ (if (not (vequal nv (float-vector-scale! (float-vector-add! (make-float-vector 9 .2) (float-vector .1 .2 .3)) 3.0)))
(snd-display #__line__ ";mix v at 0 scale-by 2 and 3: ~A" nv))))
(revert-sound ind)
(map-channel (lambda (y) 1.0))
(env-channel '(0 0 1 1 2 0) 0 11)
- (let ((v (vct .1 .2 .3)))
- (let ((id (mix-vct v 3)))
- (let ((nv (channel->vct)))
- (if (not (vequal nv (vct 0.000 0.200 0.400 0.700 1.000 1.300 0.800 0.600 0.400 0.200)))
- (snd-display #__line__ ";mix v at 3 after env: ~A" nv)))))
+ (let ((v (float-vector .1 .2 .3)))
+ (mix-float-vector v 3)
+ (let ((nv (channel->float-vector)))
+ (if (not (vequal nv (float-vector 0.000 0.200 0.400 0.700 1.000 1.300 0.800 0.600 0.400 0.200)))
+ (snd-display #__line__ ";mix v at 3 after env: ~A" nv))))
(close-sound ind))))
(let ((ind (new-sound "test.snd" :size 100)))
- (let ((v (vct .1 .2 .3)))
- (let ((id (mix-vct v 10)))
+ (let ((v (float-vector .1 .2 .3)))
+ (let ((id (mix-float-vector v 10)))
(pad-channel 0 10)
(if (not (mix? id)) (snd-display #__line__ ";padded mix not active?"))
(if (not (= (mix-position id) 20)) (snd-display #__line__ ";after pad mix pos: ~A" (mix-position id)))
@@ -27499,28 +22530,28 @@ EDITS: 2
(if (not (mix? id)) (snd-display #__line__ ";padded 50 mix not active?"))
(if (not (= (mix-position id) 20)) (snd-display #__line__ ";after pad 50 mix pos: ~A" (mix-position id)))
(undo 1)
- (let ((id1 (mix-vct v 22))
- (id2 (mix-vct v 21)))
- (let ((vals (channel->vct 18 10)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.300 0.600 0.500 0.300 0.000 0.000 0.000)))
+ (let ((id1 (mix-float-vector v 22))
+ (id2 (mix-float-vector v 21)))
+ (let ((vals (channel->float-vector 18 10)))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.100 0.300 0.600 0.500 0.300 0.000 0.000 0.000)))
(snd-display #__line__ ";mix 3 vs: ~A" vals))
(if (not (mix? id)) (snd-display #__line__ ";mix 3vs 1 not active?"))
(if (not (mix? id1)) (snd-display #__line__ ";mix 3vs 2 not active?"))
(if (not (mix? id2)) (snd-display #__line__ ";mix 3vs 3 not active?"))
(set! (mix-position id) 10)
- (set! vals (channel->vct 18 10))
- (if (not (vequal vals (vct 0.000 0.000 0.000 0.100 0.300 0.500 0.300 0.000 0.000 0.000)))
- (snd-display #__line__ ";mix 3 vs then move 1st: ~A" vals))
+ (set! vals (channel->float-vector 18 10))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.000 0.100 0.300 0.500 0.300 0.000 0.000 0.000)))
+ (snd-display #__line__ ";mix 3 vs then move first: ~A" vals))
(set! (mix-position id2) 30)
- (set! vals (channel->vct 18 10))
- (if (not (vequal vals (vct 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.000 0.000 0.000)))
+ (set! vals (channel->float-vector 18 10))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.000 0.000 0.000)))
(snd-display #__line__ ";mix 3 vs then move 2: ~A" vals))
(scale-by 2.0)
(if (not (mix? id)) (snd-display #__line__ ";mix 3vs 1 scl not active?"))
(if (not (mix? id1)) (snd-display #__line__ ";mix 3vs 2 scl not active?"))
(if (not (mix? id2)) (snd-display #__line__ ";mix 3vs 3 scl not active?"))
- (set! vals (channel->vct 18 10))
- (if (not (vequal vals (vct 0.000 0.000 0.000 0.000 0.200 0.400 0.600 0.000 0.000 0.000)))
+ (set! vals (channel->float-vector 18 10))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.000 0.000 0.200 0.400 0.600 0.000 0.000 0.000)))
(snd-display #__line__ ";mix 3 vs then move 2 scl: ~A" vals))
(delete-sample 15)
(if (not (mix? id)) (snd-display #__line__ ";mix 3vs 1 scl del not active?"))
@@ -27533,25 +22564,25 @@ EDITS: 2
(close-sound ind))
(let ((ind (new-sound "test.snd" :size 15)))
- (let ((id (mix-vct (make-vct 11 1.0) 2)))
+ (let ((id (mix-float-vector (make-float-vector 11 1.0) 2)))
(set! (mix-amp-env id) '(0 0 1 1))
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0 0 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 0 0)))
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0 0 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 0 0)))
(snd-display #__line__ ";ramp mix amp env: ~A" vals)))
(set! (mix-amp-env id) #f)
- (if (not (null? (mix-amp-env id))) (snd-display #__line__ ";set mix-amp-env to null: ~A" (mix-amp-env id)))
+ (if (pair? (mix-amp-env id)) (snd-display #__line__ ";set mix-amp-env to null: ~A" (mix-amp-env id)))
(set! (mix-speed id) 0.5)
- (if (not (= (frames) 24)) (snd-display #__line__ ";mix speed lengthens 24: ~A" (frames)))
+ (if (not (= (framples) 24)) (snd-display #__line__ ";mix speed lengthens 24: ~A" (framples)))
(set! (mix-speed id) 1.0)
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display #__line__ ";return to mix original index: ~A" vals)))
(set! (mix-amp-env id) '(0 0 1 1 2 1 3 0))
(set! (mix-speed id) 0.5)
(set! (mix-amp-env id) #f)
(set! (mix-speed id) 1.0)
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display #__line__ ";return again to mix original index: ~A" vals)))
(close-sound ind)))
@@ -27565,7 +22596,7 @@ EDITS: 2
(scale-by .5)
(undo)
(close-sound id)))
- (set! (print-length) 30)
+ (set! *print-length* 30)
(let* ((ind (open-sound "2.snd"))
(md (car (mix "1a.snd" 1000 0 ind 1 #t))))
@@ -27578,8 +22609,8 @@ EDITS: 2
(set! (mix-amp md) 0.5)
(if (fneq (maxamp ind 1) .116) (snd-display #__line__ ";maxamp after mix 0.5 into chan 2: ~A" (maxamp ind 1)))
(set! (mix-speed md) 2.0)
- (if (fneq (/ (mix-length md) (mus-sound-frames "1a.snd")) 0.5)
- (snd-display #__line__ ";mix srate chan 2: ~A ~A" (mix-length md) (mus-sound-frames "1a.snd")))
+ (if (fneq (/ (mix-length md) (mus-sound-framples "1a.snd")) 0.5)
+ (snd-display #__line__ ";mix srate chan 2: ~A ~A" (mix-length md) (mus-sound-framples "1a.snd")))
(update-time-graph)
(set! (mix-speed md) 0.5)
(update-time-graph)
@@ -27594,52 +22625,52 @@ EDITS: 2
(set! (sync ind) 1)
(let ((m0 (maxamp ind 0))
(m1 (maxamp ind 1))
- (len (frames ind 0)))
+ (len (framples ind 0)))
(set! md (mix "2.snd" 0 #t)) ; should double both chans, no len change
- (if (or (not (= (frames ind 0) len))
+ (if (or (not (= (framples ind 0) len))
(fneq (maxamp ind 0) (* 2 m0))
(fneq (maxamp ind 1) (* 2 m1)))
(snd-display #__line__ ";mix twice syncd: 0: ~A -> ~A, m1: ~A -> ~A, len: ~A -> ~A"
- m0 (maxamp ind 0) m1 (maxamp ind 1) len (frames ind 0)))
- (set! (hook-functions mix-release-hook) '())
+ m0 (maxamp ind 0) m1 (maxamp ind 1) len (framples ind 0)))
+ (set! (hook-functions mix-release-hook) ())
(close-sound ind)))
- (let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 1 "mix tests")))
+ (let ((ind (new-sound "fmv.snd" 1 22050 mus-ldouble mus-next "mix tests")))
(insert-silence 0 20 ind)
- (let ((indout (new-sound "test.snd" mus-next mus-bshort 22050 1 "mix tests")))
+ (let ((indout (new-sound "test.snd" 1 22050 mus-ldouble mus-next "mix tests")))
(insert-silence 0 10 indout)
(set! (sample 2 indout 0) .5)
(set! (sample 5 indout 0) .25)
(save-sound indout)
(close-sound indout))
(let ((tag (car (mix "test.snd"))))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .5)
- (vct-set! v 5 .25)
+ (let ((samps (channel->float-vector 0 20))
+ (v (make-float-vector 20 0.0)))
+ (set! (v 2) .5)
+ (set! (v 5) .25)
(if (not (vequal samps v))
(snd-display #__line__ ";mix 1->1: ~A ~A" samps v)))
(if (not (mix? tag)) (snd-display #__line__ ";mix 1->1 tag: ~A" tag))
(undo))
(let ((tag (car (mix "test.snd" 5))))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 7 .5)
- (vct-set! v 10 .25)
+ (let ((samps (channel->float-vector 0 20))
+ (v (make-float-vector 20 0.0)))
+ (set! (v 7) .5)
+ (set! (v 10) .25)
(if (not (vequal samps v))
(snd-display #__line__ ";mix 1->1 at 5: ~A ~A" samps v)))
(if (not (mix? tag)) (snd-display #__line__ ";mix 1->1 at 5 tag: ~A" tag))
(undo))
(let ((tag (mix "test.snd" 0 0 ind 0 #f)))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .5)
- (vct-set! v 5 .25)
+ (let ((samps (channel->float-vector 0 20))
+ (v (make-float-vector 20 0.0)))
+ (set! (v 2) .5)
+ (set! (v 5) .25)
(if (not (vequal samps v))
(snd-display #__line__ ";mix 1->1 at 0 #f: ~A ~A" samps v)))
(if (mix? tag) (snd-display #__line__ ";mix 1->1 at 5 #f tag: ~A" tag))
(undo))
- (let ((indout (new-sound "test.snd" mus-next mus-bshort 22050 2 "mix tests")))
+ (let ((indout (new-sound "test.snd" 2 22050 mus-ldouble mus-next "mix tests")))
(insert-silence 0 10 indout 0)
(insert-silence 0 10 indout 1)
(set! (sample 2 indout 0) .5)
@@ -27649,81 +22680,67 @@ EDITS: 2
(save-sound indout)
(close-sound indout))
(let ((tag (car (mix "test.snd" 0 1))))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .95)
- (vct-set! v 5 .125)
+ (let ((samps (channel->float-vector 0 20))
+ (v (make-float-vector 20 0.0)))
+ (set! (v 2) .95)
+ (set! (v 5) .125)
(if (not (vequal samps v))
(snd-display #__line__ ";mix 2->1: ~A ~A" samps v)))
(if (not (mix? tag)) (snd-display #__line__ ";mix 2->1 tag: ~A" tag))
(undo))
(let ((tag (car (mix "test.snd" 5 1))))
- (let ((samps (channel->vct 0 20))
- (v (make-vct 20 0.0)))
- (vct-set! v 7 .95)
- (vct-set! v 10 .125)
+ (let ((samps (channel->float-vector 0 20))
+ (v (make-float-vector 20 0.0)))
+ (set! (v 7) .95)
+ (set! (v 10) .125)
(if (not (vequal samps v))
(snd-display #__line__ ";mix 2->1 at 5: ~A ~A" samps v)))
(if (not (mix? tag)) (snd-display #__line__ ";mix 2->1 at 5 tag: ~A" tag))
(undo))
(close-sound ind)
- (set! ind (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "mix tests"))
+ (set! ind (new-sound "fmv.snd" 2 22050 mus-ldouble mus-next "mix tests"))
(insert-silence 0 20 ind 0)
(insert-silence 0 20 ind 1)
(let ((tag (car (mix "test.snd" 0 #t))))
- (let ((samps0 (channel->vct 0 20 ind 0))
- (samps1 (channel->vct 0 20 ind 1))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .95)
- (vct-set! v 5 .125)
+ (let ((samps0 (channel->float-vector 0 20 ind 0))
+ (samps1 (channel->float-vector 0 20 ind 1))
+ (v (make-float-vector 20 0.0)))
+ (set! (v 2) .95)
+ (set! (v 5) .125)
(if (not (vequal samps1 v))
(snd-display #__line__ ";mix 1->1 (2): ~A ~A" samps1 v))
- (vct-set! v 2 .5)
- (vct-set! v 5 .25)
+ (set! (v 2) .5)
+ (set! (v 5) .25)
(if (not (vequal samps0 v))
(snd-display #__line__ ";mix 1->1 (3): ~A ~A" samps0 v)))
(if (not (mix? tag)) (snd-display #__line__ ";mix 1->1 tag: ~A" tag))
(undo 1 ind 0)
(undo 1 ind 1))
(let ((tag (mix "test.snd" 0 1 ind 1 #f))) ; samp:0, in-chan: 1
- (let ((samps0 (channel->vct 0 20 ind 0))
- (samps1 (channel->vct 0 20 ind 1))
- (v (make-vct 20 0.0)))
+ (let ((samps0 (channel->float-vector 0 20 ind 0))
+ (samps1 (channel->float-vector 0 20 ind 1))
+ (v (make-float-vector 20 0.0)))
(if (not (vequal samps0 v))
(snd-display #__line__ ";mix 1->1 (4): ~A ~A" samps0 v))
- (vct-set! v 2 .95)
- (vct-set! v 5 .125)
+ (set! (v 2) .95)
+ (set! (v 5) .125)
(if (not (vequal samps1 v))
(snd-display #__line__ ";mix 1->1 (5): ~A ~A" samps1 v)))
(if (mix? tag) (snd-display #__line__ ";mix 1->1 tag (5): ~A" tag))
(undo 1 ind 1))
(set! (sync ind) 1)
- (let ((tag (car (mix "test.snd" 0 #t))))
- (let ((samps0 (channel->vct 0 20 ind 0))
- (samps1 (channel->vct 0 20 ind 1))
- (v (make-vct 20 0.0)))
- (vct-set! v 2 .5)
- (vct-set! v 5 .25)
- (if (not (vequal samps0 v))
- (snd-display #__line__ ";mix 1->1 (6): ~A ~A" samps0 v))
- (vct-set! v 2 .95)
- (vct-set! v 5 .125)
- (if (not (vequal samps1 v))
- (snd-display #__line__ ";mix 1->1 (7): ~A ~A" samps1 v)))
- (undo))
- (set! (cursor ind) 5)
- (let ((tag (car (mix "test.snd" (cursor) #t))))
- (let ((samps0 (channel->vct 0 20 ind 0))
- (samps1 (channel->vct 0 20 ind 1))
- (v (make-vct 20 0.0)))
- (vct-set! v 7 .5)
- (vct-set! v 10 .25)
- (if (not (vequal samps0 v))
- (snd-display #__line__ ";mix 1->1 (8): ~A ~A" samps0 v))
- (vct-set! v 7 .95)
- (vct-set! v 10 .125)
- (if (not (vequal samps1 v))
- (snd-display #__line__ ";mix 1->1 (9): ~A ~A" samps1 v)))
+ (mix "test.snd" 0 #t)
+ (let ((samps0 (channel->float-vector 0 20 ind 0))
+ (samps1 (channel->float-vector 0 20 ind 1))
+ (v (make-float-vector 20 0.0)))
+ (set! (v 2) .5)
+ (set! (v 5) .25)
+ (if (not (vequal samps0 v))
+ (snd-display #__line__ ";mix 1->1 (6): ~A ~A" samps0 v))
+ (set! (v 2) .95)
+ (set! (v 5) .125)
+ (if (not (vequal samps1 v))
+ (snd-display #__line__ ";mix 1->1 (7): ~A ~A" samps1 v))
(undo))
(close-sound ind))
(delete-file "test.snd")
@@ -27731,9 +22748,9 @@ EDITS: 2
;; check ripple_mixes
(let* ((ind (open-sound "oboe.snd"))
- (data (channel->vct 100 100))
- (m1 (mix-vct data 321 ind 0 #t))
- (m2 (mix-vct data 123 ind 0 #t)))
+ (data (channel->float-vector 100 100))
+ (m1 (mix-float-vector data 321 ind 0 #t))
+ (m2 (mix-float-vector data 123 ind 0 #t)))
(set! (mix-position m1) 500)
(if (not (= (mix-position m1) 500)) (snd-display #__line__ ";mix-position m1[0]: ~A" (mix-position m1)))
(if (not (= (mix-position m2) 123)) (snd-display #__line__ ";mix-position m2[0]: ~A" (mix-position m2)))
@@ -27757,10 +22774,6 @@ EDITS: 2
(undo)
(set! (mix-position m2) 500)
(undo)
- (ptree-channel (lambda (y) (* y 0.5)) 2000 100)
- (if (not (= (mix-position m2) 123)) (snd-display #__line__ ";mix-position m2[6]: ~A" (mix-position m2)))
- (if (not (= (mix-position m1) 321)) (snd-display #__line__ ";mix-position m1[6]: ~A" (mix-position m1)))
- (undo)
(set! (mix-position m2) 500)
(undo-edit)
(ramp-channel 0.0 1.0 3000 100)
@@ -27805,7 +22818,7 @@ EDITS: 2
(set! (sync ind) #t)
(let ((md (car (mix-selection 500 ind))))
(if (not (mix? (integer->mix (+ 1 (mix->integer md)))))
- (snd-display #__line__ ";where is 2nd mix? ~A ~A" md (mixes)))
+ (snd-display #__line__ ";where is second mix? ~A ~A" md (mixes)))
(if (not (= (edit-position ind 0) 1))
(snd-display #__line__ ";edit-position 0 after stereo mix selection: ~A" (edit-position ind 0)))
(if (not (= (edit-position ind 1) 1))
@@ -27820,15 +22833,15 @@ EDITS: 2
(close-sound ind)))
(let ((ind (new-sound "test.snd"))
- (v (make-vct 20)))
- (do ((i 0 (+ 1 i))) ((= i 20)) (vct-set! v i (* i .01)))
- (vct->channel v)
- (do ((i 0 (+ 1 i))) ((= i 20)) (vct-set! v i (* i -.01)))
- (let ((mx (mix-vct v 10)))
+ (v (make-float-vector 20)))
+ (do ((i 0 (+ i 1))) ((= i 20)) (set! (v i) (* i .01)))
+ (float-vector->channel v)
+ (do ((i 0 (+ i 1))) ((= i 20)) (set! (v i) (* i -.01)))
+ (let ((mx (mix-float-vector v 10)))
(let ((hi (make-mix-sampler mx))
(ho (make-mix-sampler mx 5))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 10)))
(let ((ho-val (ho))
(hi-val (hi)))
@@ -27841,15 +22854,15 @@ EDITS: 2
(snd-display #__line__ ";mix-reader at ~A from 5: ~A" i ho-val)
(set! happy #f)))))))
(revert-sound ind)
- (set! v (make-vct 21))
- (vct-fill! v 0.5)
- (vct->channel v)
- (let ((mx (mix-vct v 10)))
+ (set! v (make-float-vector 21))
+ (fill! v 0.5)
+ (float-vector->channel v)
+ (let ((mx (mix-float-vector v 10)))
(set! (mix-amp-env mx) '(0 0 1 1))
(let ((hi (make-mix-sampler mx 0))
(ho (make-mix-sampler mx 10))
(happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 10)))
(let ((ho-val (ho))
(hi-val (hi)))
@@ -27863,8 +22876,8 @@ EDITS: 2
(set! happy #f)))))))
(close-sound ind))
- (let* ((ind (open-sound "oboe.snd"))
- (id (mix-vct (make-vct 10 .1))))
+ (let ((ind (open-sound "oboe.snd"))
+ (id (mix-float-vector (make-float-vector 10 .1))))
(set! (mix-position id) 100)
(if (or (not (= (mix-position id) 100))
(not (= (edit-position ind 0) 2)))
@@ -27881,10 +22894,6 @@ EDITS: 2
(if (or (fneq (mix-amp id) 0.5)
(not (= (edit-position ind 0) 3)))
(snd-display #__line__ ";mix-amp .5: ~A ~A" (mix-amp id) (edit-position ind 0)))
- (set! (mix-amp id) (mix-amp id))
- (if (or (fneq (mix-amp id) 0.5)
- (not (= (edit-position ind 0) 3)))
- (snd-display #__line__ ";mix-amp no-op: ~A ~A" (mix-amp id) (edit-position ind 0)))
(set! (mix-speed id) 1.0)
(if (or (fneq (mix-speed id) 1.0)
(not (= (edit-position ind 0) 3)))
@@ -27893,10 +22902,6 @@ EDITS: 2
(if (or (fneq (mix-speed id) 0.5)
(not (= (edit-position ind 0) 4)))
(snd-display #__line__ ";mix-speed .5: ~A ~A" (mix-speed id) (edit-position ind 0)))
- (set! (mix-speed id) (mix-speed id))
- (if (or (fneq (mix-speed id) 0.5)
- (not (= (edit-position ind 0) 4)))
- (snd-display #__line__ ";mix-speed 2 no-op: ~A ~A" (mix-speed id) (edit-position ind 0)))
(set! (mix-amp-env id) '(0 0 1 1))
(if (not (= (edit-position ind 0) 5))
(snd-display #__line__ ";mix-amp-env init: ~A ~A" (mix-amp-env id) (edit-position ind 0)))
@@ -27905,26 +22910,36 @@ EDITS: 2
(snd-display #__line__ ";mix-amp-env no-op: ~A ~A" (mix-amp-env id) (edit-position ind 0)))
(close-sound ind))
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "color-mix tests" 300))
- (old-color (mix-color)))
- (set! (mix-color) (make-color-with-catch 1 1 0))
- (let ((mix1 (mix-vct (make-vct 10 .5) 10)))
- (if (or (not (equal? (color->list (mix-color)) (list 1.0 1.0 0.0)))
- (not (equal? (color->list (mix-color mix1)) (list 1.0 1.0 0.0))))
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "color-mix tests" 300))
+ (old-color *mix-color*))
+ (set! *mix-color* (make-color-with-catch 1 1 0))
+ (let ((mix1 (mix-float-vector (make-float-vector 10 .5) 10)))
+ (if (or (and (not (equal? (color->list *mix-color*) (list 1.0 1.0 0.0)))
+ (not (equal? (color->list *mix-color*) (list 1.0 1.0 0.0 1.0))))
+ (and (not (equal? (color->list (mix-color mix1)) (list 1.0 1.0 0.0)))
+ (not (equal? (color->list (mix-color mix1)) (list 1.0 1.0 0.0 1.0)))))
(snd-display #__line__ ";set mix-color: ~A ~A ~A ~A"
- (color->list (mix-color)) (color->list (mix-color mix1)) (list 1.0 1.0 0.0) (color->list old-color)))
- (set! (mix-color) old-color)
+ (color->list *mix-color*) (color->list (mix-color mix1)) (list 1.0 1.0 0.0) (color->list old-color)))
+ (set! *mix-color* old-color)
(save-mix mix1 "test1.snd")
(let ((ind1 (open-sound "test1.snd")))
- (if (not (= (frames ind1) (mix-length mix1))) (snd-display #__line__ ";save-mix frames: ~A ~A" (mix-length mix1) (frames ind1)))
- (if (not (vequal (channel->vct 0 10) (mix->vct mix1)))
- (snd-display #__line__ ";save-mix data: ~A ~A" (mix->vct mix1) (channel->vct 0 10 ind1)))
+ (if (not (= (framples ind1) (mix-length mix1))) (snd-display #__line__ ";save-mix framples: ~A ~A" (mix-length mix1) (framples ind1)))
+ (if (not (vequal (channel->float-vector 0 10) (mix->float-vector mix1)))
+ (snd-display #__line__ ";save-mix data: ~A ~A" (mix->float-vector mix1) (channel->float-vector 0 10 ind1)))
+
+ (define mix7 (integer->mix 71231))
+ (if (mix? mix7) (snd-display #__line__ ";mix? ~A~%" mix7))
+ (catch #t
+ (lambda ()
+ (save-mix mix7 "test.snd")
+ (snd-display #__line__ ";save-mix of a bad mix??"))
+ (lambda args #f))
(close-sound ind1)
(if (file-exists? "test1.snd") (delete-file "test1.snd"))))
(close-sound ind))
- (let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "lock mix tests" 300))
- (mix1 (mix-vct (make-vct 10 .5) 10)))
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "lock mix tests" 300))
+ (mix1 (mix-float-vector (make-float-vector 10 .5) 10)))
(set! (mix-amp mix1) 0.0)
(if (fneq (maxamp ind 0) 0.0) (snd-display #__line__ ";delete-mix maxamp: ~A" (maxamp ind 0)))
(undo-channel 1 ind 0)
@@ -27939,194 +22954,187 @@ EDITS: 2
(close-sound ind))
(let ((ind (new-sound "test.snd" :size 100)))
- (let ((id (mix-vct (make-vct 5 .5) 11)))
+ (let ((id (mix-float-vector (make-float-vector 5 .5) 11)))
;; pad-channel
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11: ~A" (channel->vct 10 10)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11: ~A" (channel->float-vector 10 10)))
(pad-channel 0 10)
(if (not (mix? id))
(snd-display #__line__ ";pad locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 21))
- (snd-display #__line__ ";vct .5 at 21 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 21: ~A" (channel->vct 20 10)))
- (if (not (vequal (channel->vct 10 10) (make-vct 10 0.0)))
- (snd-display #__line__ ";vct .5 at 21 at 10: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";float-vector .5 at 21 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 20 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 21: ~A" (channel->float-vector 20 10)))
+ (if (not (vequal (channel->float-vector 10 10) (make-float-vector 10 0.0)))
+ (snd-display #__line__ ";float-vector .5 at 21 at 10: ~A" (channel->float-vector 10 10)))
(pad-channel 30 10)
(if (not (mix? id))
(snd-display #__line__ ";pad 30 locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 21))
- (snd-display #__line__ ";vct .5 at 21 position 30: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 21 30: ~A" (channel->vct 20 10)))
+ (snd-display #__line__ ";float-vector .5 at 21 position 30: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 20 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 21 30: ~A" (channel->float-vector 20 10)))
(pad-channel 150 10)
(if (not (mix? id))
(snd-display #__line__ ";pad 150 locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 21))
- (snd-display #__line__ ";vct .5 at 21 position 150: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 20 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 21 150: ~A" (channel->vct 20 10)))
+ (snd-display #__line__ ";float-vector .5 at 21 position 150: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 20 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 21 150: ~A" (channel->float-vector 20 10)))
(pad-channel 20 10)
(if (not (mix? id))
(snd-display #__line__ ";pad 20 locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 31))
- (snd-display #__line__ ";vct .5 at 31 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 30 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 31: ~A" (channel->vct 30 10)))
+ (snd-display #__line__ ";float-vector .5 at 31 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 30 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 31: ~A" (channel->float-vector 30 10)))
(pad-channel 32 3)
; (if (mix? id) (snd-display #__line__ ";pad within mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display #__line__ ";pad within mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 30 10) (vct 0 .5 0 0 0 .5 .5 .5 .5 0)))
- (snd-display #__line__ ";vct .5 at 31 pad at 32: ~A" (channel->vct 30 10)))
+ (if (not (vequal (channel->float-vector 30 10) (float-vector 0 .5 0 0 0 .5 .5 .5 .5 0)))
+ (snd-display #__line__ ";float-vector .5 at 31 pad at 32: ~A" (channel->float-vector 30 10)))
(set! (edit-position) 1)
- (if (not (mix? id)) (snd-display #__line__ ";mix vct after reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 after reset edit: ~A" (channel->vct 10 10)))
+ (if (not (mix? id)) (snd-display #__line__ ";mix float-vector after reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix float-vector position after reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 after reset edit: ~A" (channel->float-vector 10 10)))
;; delete
(delete-samples 0 10)
(if (not (mix? id))
(snd-display #__line__ ";delete locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 1))
- (snd-display #__line__ ";vct .5 at 1 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 1: ~A" (channel->vct 0 10)))
+ (snd-display #__line__ ";float-vector .5 at 1 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 0 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 1: ~A" (channel->float-vector 0 10)))
(delete-samples 30 10)
(if (not (mix? id))
(snd-display #__line__ ";delete 30 locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 1))
- (snd-display #__line__ ";vct .5 at 1 position del 30: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 1 del 30: ~A" (channel->vct 0 10)))
+ (snd-display #__line__ ";float-vector .5 at 1 position del 30: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 0 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 1 del 30: ~A" (channel->float-vector 0 10)))
(delete-samples 3 3)
; (if (mix? id) (snd-display #__line__ ";delete within mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display #__line__ ";delete within mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 0 10) (vct 0 .5 .5 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 1 del at 3: ~A" (channel->vct 0 10)))
+ (if (not (vequal (channel->float-vector 0 10) (float-vector 0 .5 .5 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 1 del at 3: ~A" (channel->float-vector 0 10)))
(set! (edit-position) 1)
- (if (not (mix? id)) (snd-display #__line__ ";mix vct after del reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after del reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 after del reset edit: ~A" (channel->vct 10 10)))
+ (if (not (mix? id)) (snd-display #__line__ ";mix float-vector after del reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix float-vector position after del reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 after del reset edit: ~A" (channel->float-vector 10 10)))
;; change
- (set! (samples 0 5) (make-vct 5 .6))
+ (set! (samples 0 5) (make-float-vector 5 .6))
(if (not (mix? id))
(snd-display #__line__ ";set locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
- (snd-display #__line__ ";vct .5 at 11 set position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 set: ~A" (channel->vct 10 10)))
- (set! (samples 20 5) (make-vct 5 .7))
+ (snd-display #__line__ ";float-vector .5 at 11 set position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 set: ~A" (channel->float-vector 10 10)))
+ (set! (samples 20 5) (make-float-vector 5 .7))
(if (not (mix? id))
(snd-display #__line__ ";set 20 locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
- (snd-display #__line__ ";vct .5 at 11 set 20 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 set 20: ~A" (channel->vct 10 10)))
- (set! (samples 12 2) (vct -.5 .8))
+ (snd-display #__line__ ";float-vector .5 at 11 set 20 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 set 20: ~A" (channel->float-vector 10 10)))
+ (set! (samples 12 2) (float-vector -.5 .8))
; (if (mix? id) (snd-display #__line__ ";set within mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display #__line__ ";set within mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 -.5 .8 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 set at 12: ~A" (channel->vct 10 10)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 -.5 .8 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 set at 12: ~A" (channel->float-vector 10 10)))
(set! (edit-position) 1)
- (if (not (mix? id)) (snd-display #__line__ ";mix vct after set reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after set reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 after set reset edit: ~A" (channel->vct 10 10)))
+ (if (not (mix? id)) (snd-display #__line__ ";mix float-vector after set reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix float-vector position after set reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 after set reset edit: ~A" (channel->float-vector 10 10)))
;; scale
(scale-channel 2.0)
(if (not (mix? id))
(snd-display #__line__ ";scale locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
- (snd-display #__line__ ";vct .5 at 11 scale position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 1 1 1 1 1 0 0 0 0)))
- (snd-display #__line__ ";vct 1 at 11 scale: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";float-vector .5 at 11 scale position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 1 1 1 1 1 0 0 0 0)))
+ (snd-display #__line__ ";float-vector 1 at 11 scale: ~A" (channel->float-vector 10 10)))
(scale-channel 0.5)
(if (not (mix? id))
(snd-display #__line__ ";unscale locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
- (snd-display #__line__ ";vct .5 at 11 unscale position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct 1 at 11 unscale: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";float-vector .5 at 11 unscale position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector 1 at 11 unscale: ~A" (channel->float-vector 10 10)))
(scale-channel -1.0 0 5)
(if (not (mix? id))
(snd-display #__line__ ";scale at 0 locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
- (snd-display #__line__ ";vct .5 at 11 scale at 0 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct 1 at 11 scale at 0: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";float-vector .5 at 11 scale at 0 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector 1 at 11 scale at 0: ~A" (channel->float-vector 10 10)))
(scale-channel -1.0 22 10)
(if (not (mix? id))
(snd-display #__line__ ";scale at 22 locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
- (snd-display #__line__ ";vct .5 at 11 scale at 22 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct 1 at 11 scale at 22: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";float-vector .5 at 11 scale at 22 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector 1 at 11 scale at 22: ~A" (channel->float-vector 10 10)))
(scale-channel 2.0 12 2)
; (if (mix? id) (snd-display #__line__ ";scale within mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display #__line__ ";scale within mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 1 1 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 scale at 12: ~A" (channel->vct 10 10)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 1 1 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 scale at 12: ~A" (channel->float-vector 10 10)))
(set! (edit-position) 1)
- (if (not (mix? id)) (snd-display #__line__ ";mix vct after scale reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after scale reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 after scale reset edit: ~A" (channel->vct 10 10)))
+ (if (not (mix? id)) (snd-display #__line__ ";mix float-vector after scale reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix float-vector position after scale reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 after scale reset edit: ~A" (channel->float-vector 10 10)))
;; envelopes
(env-channel '(0 0 1 1) 0 8)
(if (not (mix? id))
(snd-display #__line__ ";env locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
- (snd-display #__line__ ";vct .5 at 11 env position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct 1 at 11 env: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";float-vector .5 at 11 env position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector 1 at 11 env: ~A" (channel->float-vector 10 10)))
(env-channel '(0 0 1 1) 17 10)
(if (not (mix? id))
(snd-display #__line__ ";env 17 locked mix? ~A" (mix? id)))
(if (not (= (mix-position id) 11))
- (snd-display #__line__ ";vct .5 at 11 env 17 position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct 1 at 11 env 17: ~A" (channel->vct 10 10)))
+ (snd-display #__line__ ";float-vector .5 at 11 env 17 position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector 1 at 11 env 17: ~A" (channel->float-vector 10 10)))
(env-channel '(0 0 1 1))
; (if (mix? id) (snd-display #__line__ ";env over mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display #__line__ ";env over mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0.000 0.056 0.061 0.066 0.071 0.076 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";vct .5 at 11 over env: ~A" (channel->vct 10 10)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0.000 0.056 0.061 0.066 0.071 0.076 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";float-vector .5 at 11 over env: ~A" (channel->float-vector 10 10)))
(set! (edit-position) 1)
- ; (if (not (mix? id)) (snd-display #__line__ ";mix vct after env reset edit position: ~A" (mix? id)))
- (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix vct position after env reset edit position: ~A" (mix-position id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 .5 .5 .5 .5 .5 0 0 0 0)))
- (snd-display #__line__ ";vct .5 at 11 after env reset edit: ~A" (channel->vct 10 10)))
-
- (ptree-channel (lambda (y) (* y 2)))
- ; (if (mix? id) (snd-display #__line__ ";ptree over mix but exists?: ~A" (mix? id)))
- (if (not (mix? id)) (snd-display #__line__ ";ptree over mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 1 1 1 1 1 0 0 0 0)))
- (snd-display #__line__ ";vct 1 at 11 after ptree: ~A" (channel->vct 10 10)))
- (undo)
+ ; (if (not (mix? id)) (snd-display #__line__ ";mix float-vector after env reset edit position: ~A" (mix? id)))
+ (if (not (= (mix-position id) 11)) (snd-display #__line__ ";mix float-vector position after env reset edit position: ~A" (mix-position id)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 .5 .5 .5 .5 .5 0 0 0 0)))
+ (snd-display #__line__ ";float-vector .5 at 11 after env reset edit: ~A" (channel->float-vector 10 10)))
+
(scale-by 0.0)
- ; (if (mix? id) (snd-display #__line__ ";zero mix but exists?: ~A" (mix? id)))
(if (not (mix? id)) (snd-display #__line__ ";zero mix but no mix?: ~A" (mix? id)))
- (if (not (vequal (channel->vct 10 10) (vct 0 0 0 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";vct 1 at 11 scale 0: ~A" (channel->vct 10 10)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0 0 0 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";float-vector 1 at 11 scale 0: ~A" (channel->float-vector 10 10)))
(undo 2)
- (let ((ids '()))
- (do ((i 0 (+ 1 i)))
+ (let ((ids ()))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (set! ids (cons (mix-vct (make-vct 5 .1) (+ i 10)) ids)))
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (set! ids (cons (mix-float-vector (make-float-vector 5 .1) (+ i 10)) ids)))
+ (let ((vals (channel->float-vector 8 14)))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
(snd-display #__line__ ";pile up mixes: ~A" vals)))
(let ((mx (mixes-maxamp ids)))
(if (fneq mx .1)
@@ -28140,34 +23148,34 @@ EDITS: 2
(for-each (lambda (m) (if (not (= (mix-sync m) 0)) (snd-display #__line__ ";re sync-all-mixes ~A: ~A" m (mix-sync m)))) ids)
(scale-mixes ids -2.0)
(for-each (lambda (m) (if (fneq (mix-amp m) -2.0) (snd-display #__line__ ";scale-mixes ~A: ~A" m (mix-amp m)))) ids)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 -0.200 -0.400 -0.600 -0.800 -1.000 -0.800 -0.600 -0.400 -0.200 0.000 0.000 0.000)))
+ (let ((vals (channel->float-vector 8 14)))
+ (if (not (vequal vals (float-vector 0.000 0.000 -0.200 -0.400 -0.600 -0.800 -1.000 -0.800 -0.600 -0.400 -0.200 0.000 0.000 0.000)))
(snd-display #__line__ ";scale piled up mixes: ~A" vals)))
(silence-mixes ids)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (make-vct 14 0.0)))
+ (let ((vals (channel->float-vector 8 14)))
+ (if (not (vequal vals (make-float-vector 14 0.0)))
(snd-display #__line__ ";silence piled up mixes: ~A" vals)))
(undo 2)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (let ((vals (channel->float-vector 8 14)))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
(snd-display #__line__ ";undo 2 to pile up mixes: ~A" vals)))
(play-mixes ids)
(set-mixes-tag-y ids 100)
(for-each (lambda (m) (if (not (= (mix-tag-y m) 100)) (snd-display #__line__ ";set-mixes-tag-y ~A: ~A" m (mix-tag-y m)))) ids)
(set-mixes-tag-y ids 0)
(move-mixes ids 10)
- (let ((vals (channel->vct 18 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (let ((vals (channel->float-vector 18 14)))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
(snd-display #__line__ ";move piled up mixes: ~A" vals)))
- (let ((vals (channel->vct 8 8)))
- (if (not (vequal vals (make-vct 8 0.0)))
+ (let ((vals (channel->float-vector 8 8)))
+ (if (not (vequal vals (make-float-vector 8 0.0)))
(snd-display #__line__ ";move piled up mixes original: ~A" vals)))
(move-mixes ids -10)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (let ((vals (channel->float-vector 8 14)))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
(snd-display #__line__ ";move piled up mixes -10: ~A" vals)))
- (let ((vals (channel->vct 23 8)))
- (if (not (vequal vals (make-vct 8 0.0)))
+ (let ((vals (channel->float-vector 23 8)))
+ (if (not (vequal vals (make-float-vector 8 0.0)))
(snd-display #__line__ ";move piled up mixes -10: ~A" vals)))
(for-each (lambda (m) (set! (mix-sync m) 24)) ids)
(let ((mxs (syncd-mixes 24)))
@@ -28175,88 +23183,67 @@ EDITS: 2
(snd-display #__line__ ";syncd-mixes: ~A ~A" mxs ids))
(for-each (lambda (m) (if (not (member m ids)) (snd-display #__line__ ";syncd-mixes: ~A not in ~A" m ids))) mxs))
(sync-all-mixes 0)
- (save-mixes ids "fmv.snd")
- (let ((ind1 (open-sound "fmv.snd")))
- (let ((data (channel->vct 0 #f ind1)))
- (if (not (vequal data (vct 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.0)))
- (snd-display #__line__ ";save-mixes: ~A" data)))
- (close-sound ind1)
- (mus-sound-forget "fmv.snd")
- (delete-file "fmv.snd"))
(env-mixes ids '(0 0 1 1 2 0))
- (let ((vals (channel->vct 10 10)))
- (if (not (vequal vals (vct 0.000 0.045 0.137 0.278 0.460 0.360 0.203 0.087 0.020 0.000)))
+ (let ((vals (channel->float-vector 10 10)))
+ (if (not (vequal vals (float-vector 0.000 0.045 0.137 0.278 0.460 0.360 0.203 0.087 0.020 0.000)))
(snd-display #__line__ ";env-mixes: ~A" vals)))
(undo 3)
- (let ((vals (channel->vct 8 14)))
- (if (not (vequal vals (vct 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (let ((vals (channel->float-vector 8 14)))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000 0.000 0.000)))
(snd-display #__line__ ";undo 3 mixes envd: ~A" vals)))
(color-mixes ids (make-color 0 1 0))
(scale-tempo ids 2.0)
(let ((begs (map mix-position ids)))
(if (not (equal? begs (list 18 16 14 12 10)))
(snd-display #__line__ ";scale-tempo by 2: ~A" begs)))
- (let ((vals (channel->vct 10 15)))
- (if (not (vequal vals (vct 0.100 0.100 0.200 0.200 0.300 0.200 0.300 0.200 0.300 0.200 0.200 0.100 0.100 0.000 0.000)))
+ (let ((vals (channel->float-vector 10 15)))
+ (if (not (vequal vals (float-vector 0.100 0.100 0.200 0.200 0.300 0.200 0.300 0.200 0.300 0.200 0.200 0.100 0.100 0.000 0.000)))
(snd-display #__line__ ";scale-tempo 2 vals: ~A" vals)))
(scale-tempo ids 0.5)
(let ((begs (map mix-position ids)))
(if (not (equal? begs (list 14 13 12 11 10)))
(snd-display #__line__ ";scale-tempo by 0.5: ~A" begs)))
- (let ((vals (channel->vct 10 10)))
- (if (not (vequal vals (vct 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000)))
+ (let ((vals (channel->float-vector 10 10)))
+ (if (not (vequal vals (float-vector 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000)))
(snd-display #__line__ ";scale-tempo back 0.5: ~A" vals)))
(scale-tempo ids -1.0)
(let ((begs (map mix-position ids)))
(if (not (equal? begs (list 6 7 8 9 10)))
(snd-display #__line__ ";scale-tempo by -1: ~A" begs)))
- (let ((vals (channel->vct 0 15)))
- (if (not (vequal vals (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100)))
+ (let ((vals (channel->float-vector 0 15)))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100)))
(snd-display #__line__ ";scale-tempo -1 vals: ~A" vals)))
(undo 3)
- (set! (sinc-width) 10)
+ (set! *sinc-width* 10)
(src-mixes ids 0.5)
(if (fneq (mix-speed (car ids)) 0.5)
(snd-display #__line__ ";src-mixes speed: ~A" (mix-speed (car ids))))
(if (not (= (mixes-length ids) 15))
(snd-display #__line__ ";src-mixes length: ~A" (mixes-length ids)))
- (let ((vals (channel->vct 10 15)))
- (if (not (vequal vals (vct 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
+ (let ((vals (channel->float-vector 10 15)))
+ (if (not (vequal vals (float-vector 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
(snd-display #__line__ ";src-mixes 0.5 vals: ~A" vals)))
- (if (not (vequal (mix->vct (car ids)) (mix->vct (cadr ids))))
- (snd-display #__line__ ";src-mixes vals don't match: ~A ~A" (mix->vct (car ids)) (mix->vct (cadr ids))))
+ (if (not (vequal (mix->float-vector (car ids)) (mix->float-vector (cadr ids))))
+ (snd-display #__line__ ";src-mixes vals don't match: ~A ~A" (mix->float-vector (car ids)) (mix->float-vector (cadr ids))))
(undo)
(transpose-mixes ids -12)
(if (fneq (mix-speed (car ids)) 0.5)
(snd-display #__line__ ";transpose-mixes speed: ~A" (mix-speed (car ids))))
(if (not (= (mixes-length ids) 15))
(snd-display #__line__ ";transpose-mixes length: ~A" (mixes-length ids)))
- (let ((vals (channel->vct 10 15)))
- (if (not (vequal vals (vct 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
+ (let ((vals (channel->float-vector 10 15)))
+ (if (not (vequal vals (float-vector 0.100 0.211 0.311 0.408 0.508 0.505 0.495 0.505 0.508 0.460 0.362 0.262 0.152 0.052 0.000)))
(snd-display #__line__ ";transpose-mixes 0.5 vals: ~A" vals)))
- (if (not (vequal (mix->vct (car ids)) (mix->vct (cadr ids))))
- (snd-display #__line__ ";transpose-mixes vals don't match: ~A ~A" (mix->vct (car ids)) (mix->vct (cadr ids))))
+ (if (not (vequal (mix->float-vector (car ids)) (mix->float-vector (cadr ids))))
+ (snd-display #__line__ ";transpose-mixes vals don't match: ~A ~A" (mix->float-vector (car ids)) (mix->float-vector (cadr ids))))
(revert-sound))
(close-sound ind)))
;; check locks
(let ((ind (new-sound "test.snd" :size 100)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
(if (not (mix? id))
(snd-display #__line__ ";mix lock 0: ~A ~A" id (mix? id)))
- (ptree-channel (lambda (y) .5) 0 20)
- (if (not (mix? id))
- (snd-display #__line__ ";mix lock 1: ~A ~A" id (mix? id)))
- (ptree-channel (lambda (y) .5) 0 20)
- (if (not (mix? id))
- (snd-display #__line__ ";mix lock 2: ~A ~A" id (mix? id)))
- (undo)
- (if (not (mix? id))
- (snd-display #__line__ ";mix lock 3: ~A ~A" id (mix? id)))
- (ptree-channel (lambda (y) .5) 25 20)
- (if (not (mix? id))
- (snd-display #__line__ ";mix lock 4: ~A ~A" id (mix? id)))
- (undo)
(ramp-channel 0.0 1.0 0 20)
(if (not (mix? id))
(snd-display #__line__ ";mix lock 5: ~A ~A" id (mix? id)))
@@ -28273,11 +23260,11 @@ EDITS: 2
(if (not (mix? id))
(snd-display #__line__ ";mix lock 8: ~A ~A" id (mix? id)))
(undo)
- (insert-samples 51 2 (vct .1 .2))
+ (insert-samples 51 2 (float-vector .1 .2))
(if (not (mix? id))
(snd-display #__line__ ";mix lock 9: ~A ~A" id (mix? id)))
(undo)
- (insert-samples 1 2 (vct .1 .2))
+ (insert-samples 1 2 (float-vector .1 .2))
(if (not (mix? id))
(snd-display #__line__ ";mix lock 10: ~A ~A" id (mix? id)))
(undo)
@@ -28297,159 +23284,159 @@ EDITS: 2
(snd-display #__line__ ";mix lock 14: ~A ~A" id (mix? id)))
(close-sound ind)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 2))
(let ((ind (new-sound "test.snd" :size 100))
- (tag (with-mix-tags)))
+ (tag *with-mix-tags*))
;; check various mix ops briefly
(map-channel (lambda (y) 1.0))
(env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576)))
(snd-display #__line__ ";mix on env: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on env: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 5)))
- (snd-display #__line__ ";mix on env edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 5)))
+ (snd-display #__line__ ";mix on env edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.485 0.495 0.605 0.715 0.825 0.535 0.545 0.556 0.566 0.576))))
(snd-display #__line__ ";read mix on env reversed: ~A" data)))
(undo))
(env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331)))
(snd-display #__line__ ";mix on env 1: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on env 1: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 7)))
- (snd-display #__line__ ";mix on env1 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 7)))
+ (snd-display #__line__ ";mix on env1 edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.235 0.245 0.355 0.465 0.576 0.287 0.298 0.309 0.320 0.331))))
(snd-display #__line__ ";read mix on env1 reversed: ~A" data)))
(undo))
(env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191)))
(snd-display #__line__ ";mix on env 2: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on env 2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
- (snd-display #__line__ ";mix on env2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 11)))
+ (snd-display #__line__ ";mix on env2 edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.114 0.121 0.229 0.337 0.445 0.153 0.162 0.171 0.181 0.191))))
(snd-display #__line__ ";read mix on env2 reversed: ~A" data)))
(undo))
(env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110)))
(snd-display #__line__ ";mix on env 3: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on env 3: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
- (snd-display #__line__ ";mix on env3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 11)))
+ (snd-display #__line__ ";mix on env3 edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.055 0.060 0.165 0.270 0.376 0.082 0.089 0.095 0.102 0.110))))
(snd-display #__line__ ";read mix on env3 reversed: ~A" data)))
(undo))
(env-channel '(0 0 1 1))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063)))
(snd-display #__line__ ";mix on env 4: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on env 4: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 11)))
- (snd-display #__line__ ";mix on env4 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 11)))
+ (snd-display #__line__ ";mix on env4 edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.027 0.030 0.133 0.236 0.340 0.044 0.048 0.053 0.058 0.063))))
(snd-display #__line__ ";read mix on env4 reversed: ~A" data)))
(undo))
(set! (edit-position ind 0) 1)
(xramp-channel 1 0 32.0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108)))
(snd-display #__line__ ";mix on xramp: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on xramp: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 9)))
- (snd-display #__line__ ";mix on xramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 9)))
+ (snd-display #__line__ ";mix on xramp edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.160 0.153 0.247 0.341 0.435 0.129 0.124 0.118 0.113 0.108))))
(snd-display #__line__ ";read mix on xramp reversed: ~A" data))))
(set! (edit-position ind 0) 1)
(xramp-channel 1 0 32.0)
(xramp-channel 1 0 32.0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012)))
(snd-display #__line__ ";mix on xramp2: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on xramp2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 13)))
- (snd-display #__line__ ";mix on xramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 13)))
+ (snd-display #__line__ ";mix on xramp2 edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.026 0.024 0.122 0.220 0.318 0.017 0.015 0.014 0.013 0.012))))
(snd-display #__line__ ";read mix on xramp2 reversed: ~A" data))))
(set! (edit-position ind 0) 1)
(xramp-channel 1 0 32.0)
(xramp-channel 1 0 32.0)
(ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005)))
(snd-display #__line__ ";mix on xramp2_ramp: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on xramp2_ramp: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display #__line__ ";mix on xramp2_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp2_ramp edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.013 0.012 0.111 0.210 0.309 0.008 0.007 0.006 0.006 0.005))))
(snd-display #__line__ ";read mix on xramp2_ramp reversed: ~A" data))))
(set! (edit-position ind 0) 1)
@@ -28457,59 +23444,59 @@ EDITS: 2
(xramp-channel 1 0 32.0)
(ramp-channel 1 0)
(ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002)))
(snd-display #__line__ ";mix on xramp2_ramp2: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on xramp2_ramp2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display #__line__ ";mix on xramp2_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp2_ramp2 edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.007 0.006 0.105 0.205 0.304 0.004 0.003 0.003 0.002 0.002))))
(snd-display #__line__ ";read mix on xramp2_ramp2 reversed: ~A" data))))
(set! (edit-position ind 0) 1)
(xramp-channel 1 0 32.0)
(ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046)))
(snd-display #__line__ ";mix on xramp_ramp: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on xramp_ramp: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display #__line__ ";mix on xramp_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp_ramp edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.082 0.077 0.173 0.268 0.364 0.060 0.056 0.053 0.049 0.046))))
(snd-display #__line__ ";read mix on xramp_ramp reversed: ~A" data))))
(set! (edit-position ind 0) 1)
(xramp-channel 1 0 32.0)
(ramp-channel 1 0)
(ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019)))
(snd-display #__line__ ";mix on xramp_ramp2: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on xramp_ramp2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display #__line__ ";mix on xramp_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp_ramp2 edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.042 0.039 0.136 0.233 0.330 0.028 0.026 0.023 0.021 0.019))))
(snd-display #__line__ ";read mix on xramp_ramp2 reversed: ~A" data))))
(set! (edit-position ind 0) 1)
@@ -28517,434 +23504,42 @@ EDITS: 2
(ramp-channel 1 0)
(ramp-channel 1 0)
(ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008)))
+ (let ((id (mix-float-vector (float-vector .1 .2 .3) 50)))
+ (let ((vals (channel->float-vector 48 10)))
+ (if (not (vequal vals (float-vector 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008)))
(snd-display #__line__ ";mix on xramp_ramp3: ~A" vals)))
(if (and tag (not (mix? id)))
(snd-display #__line__ ";mix on xramp_ramp3: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 15)))
- (snd-display #__line__ ";mix on xramp_ramp3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
+ (if (and tag (not (= ((cadr (edit-tree)) 7) 15)))
+ (snd-display #__line__ ";mix on xramp_ramp3 edit-tree: ~A" ((cadr (edit-tree)) 7)))
+ (let ((data (make-float-vector 10))
(reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008))))
+ (set! (data i) (read-sample reader)))
+ (if (not (vequal data (reverse! (float-vector 0.022 0.020 0.118 0.216 0.314 0.013 0.012 0.010 0.009 0.008))))
(snd-display #__line__ ";read mix on xramp_ramp3 reversed: ~A" data))))
- (set! (with-mix-tags) #t)
- (set! (optimization) 6)
- (set! (edit-position ind 0) 1)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.500 0.500 0.600 0.700 0.800 0.500 0.500 0.500 0.500 0.500)))
- (snd-display #__line__ ";mix on ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 17)))
- (snd-display #__line__ ";mix on ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.500 0.500 0.600 0.700 0.800 0.500 0.500 0.500 0.500 0.500))))
- (snd-display #__line__ ";read mix on ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
- (snd-display #__line__ ";mix on ptree_ramp: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ptree_ramp: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
- (snd-display #__line__ ";mix on ptree_ramp edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
- (snd-display #__line__ ";read mix on ptree_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
- (snd-display #__line__ ";mix on ptree_ramp2: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ptree_ramp2: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
- (snd-display #__line__ ";mix on ptree_ramp2 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
- (snd-display #__line__ ";read mix on ptree_ramp2 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display #__line__ ";mix on ptree_ramp3: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ptree_ramp3: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
- (snd-display #__line__ ";mix on ptree_ramp3 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display #__line__ ";read mix on ptree_ramp3 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display #__line__ ";mix on ptree_ramp4: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ptree_ramp4: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 21)))
- (snd-display #__line__ ";mix on ptree_ramp4 edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display #__line__ ";read mix on ptree_ramp4 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 0)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 1.0))
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 1.000 1.000 1.100 1.200 1.300 1.000 1.000 1.000 1.000 1.000)))
- (snd-display #__line__ ";mix on ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 19)))
- (snd-display #__line__ ";mix on ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 1.000 1.000 1.100 1.200 1.300 1.000 1.000 1.000 1.000 1.000))))
- (snd-display #__line__ ";read mix on ptree_zero reversed: ~A" data))))
-
- (revert-sound)
- (map-channel (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
- (snd-display #__line__ ";mix on ramp_ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ramp_ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
- (snd-display #__line__ ";mix on ramp_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
- (snd-display #__line__ ";read mix on ramp_ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
- (snd-display #__line__ ";mix on ramp2_ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ramp2_ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
- (snd-display #__line__ ";mix on ramp2_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
- (snd-display #__line__ ";read mix on ramp2_ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display #__line__ ";mix on ramp3_ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ramp3_ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
- (snd-display #__line__ ";mix on ramp3_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display #__line__ ";read mix on ramp3_ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display #__line__ ";mix on ramp4_ptree: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ramp4_ptree: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 27)))
- (snd-display #__line__ ";mix on ramp4_ptree edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display #__line__ ";read mix on ramp4_ptree reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 0.5))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212)))
- (snd-display #__line__ ";mix on ramp_ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ramp_ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
- (snd-display #__line__ ";mix on ramp_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.258 0.253 0.347 0.442 0.537 0.232 0.227 0.222 0.217 0.212))))
- (snd-display #__line__ ";read mix on ramp_ptree_zero reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 0.5))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
- (snd-display #__line__ ";mix on ramp2_ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ramp2_ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
- (snd-display #__line__ ";mix on ramp2_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
- (snd-display #__line__ ";read mix on ramp2_ptree_zero reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 0.5))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display #__line__ ";mix on ramp3_ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ramp3_ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
- (snd-display #__line__ ";mix on ramp3_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display #__line__ ";read mix on ramp3_ptree_zero reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (scale-by 0.0)
- (ptree-channel (lambda (y) 0.5))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display #__line__ ";mix on ramp4_ptree_zero: ~A" vals)))
- (if (and tag (not (mix? id)))
- (snd-display #__line__ ";mix on ramp4_ptree_zero: ~A ~A" id (mix? id)))
- (if (and tag (not (= (list-ref (cadr (edit-tree)) 7) 29)))
- (snd-display #__line__ ";mix on ramp4_ptree_zero edit-tree: ~A" (list-ref (cadr (edit-tree)) 7)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display #__line__ ";read mix on ramp4_ptree_zero reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090)))
- (snd-display #__line__ ";mix on ramp_ptree_ramp: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.133 0.128 0.222 0.318 0.413 0.108 0.103 0.099 0.094 0.090))))
- (snd-display #__line__ ";read mix on ramp_ptree_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display #__line__ ";mix on ramp_ptree_ramp2: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display #__line__ ";read mix on ramp_ptree_ramp2 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display #__line__ ";mix on ramp_ptree_ramp3: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display #__line__ ";read mix on ramp_ptree_ramp3 reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038)))
- (snd-display #__line__ ";mix on ramp2_ptree_ramp: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.068 0.064 0.161 0.257 0.354 0.050 0.047 0.044 0.041 0.038))))
- (snd-display #__line__ ";read mix on ramp2_ptree_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display #__line__ ";mix on ramp3_ptree_ramp: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display #__line__ ";read mix on ramp3_ptree_ramp reversed: ~A" data))))
-
- (set! (edit-position ind 0) 1)
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 1 0)
- (ramp-channel 1 0)
- (let ((id (mix-vct (vct .1 .2 .3) 50)))
- (let ((vals (channel->vct 48 10)))
- (if (not (vequal vals (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016)))
- (snd-display #__line__ ";mix on ramp2_ptree_ramp2: ~A" vals)))
- (let ((data (make-vct 10))
- (reader (make-sampler 57 ind 0 -1)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! data i (reader)))
- (if (not (vequal data (vct-reverse! (vct 0.035 0.033 0.130 0.228 0.325 0.023 0.021 0.020 0.018 0.016))))
- (snd-display #__line__ ";read mix on ramp2_ptree_ramp2 reversed: ~A" data))))
-
+ (set! *with-mix-tags* #t)
(revert-sound)
- (mix-vct (vct .1 .2 .3) 50)
+ (mix-float-vector (float-vector .1 .2 .3) 50)
(reverse-sound)
- (let ((vals (channel->vct 45 8)))
- (if (not (vequal vals (vct 0.000 0.000 0.300 0.200 0.100 0.000 0.000 0.000)))
+ (let ((vals (channel->float-vector 45 8)))
+ (if (not (vequal vals (float-vector 0.000 0.000 0.300 0.200 0.100 0.000 0.000 0.000)))
(snd-display #__line__ ";reversed mix vals: ~A" vals)))
(close-sound ind))
- (set! (with-mix-tags) #f))
- (set! (with-mix-tags) #t)
-
- (let ((ind (open-sound "oboe.snd"))
- (mx (mix-vct (make-vct 100 .1) 1000)))
+
+ (set! *with-mix-tags* #f))
+ (set! *with-mix-tags* #t)
+
+ (let ((ind (open-sound "oboe.snd")))
+ (mix-float-vector (make-float-vector 100 .1) 1000)
(for-each
(lambda (mtest)
(let ((func (car mtest))
- (beg (cadr mtest))
- (lock (caddr mtest))
- (name (cadddr mtest))
+ ;;(beg (cadr mtest))
+ ;;(lock (caddr mtest))
+ ;;(name (cadddr mtest))
(edpos (edit-position ind 0)))
(func)
(set! (edit-position ind 0) edpos)))
@@ -28959,15 +23554,15 @@ EDITS: 2
(list (lambda () (pad-channel 1110 100)) 1000 #f 'pad1110)
(list (lambda () (pad-channel 2000 100)) 1000 #f 'pad2000)
- (list (lambda () (insert-samples 0 100 (make-vct 100 .2))) 1100 #f 'insert0)
- (list (lambda () (insert-samples 800 100 (make-vct 100 .2))) 1100 #f 'insert800)
- (list (lambda () (insert-samples 990 100 (make-vct 100 .2))) 1100 #f 'insert990)
- (list (lambda () (insert-samples 1010 100 (make-vct 100 .2))) 1000 #t 'insert1010)
- (list (lambda () (insert-samples 1050 10 (make-vct 100 .2))) 1000 #t 'insert1050)
- (list (lambda () (insert-samples 1110 100 (make-vct 100 .2))) 1000 #f 'insert1110)
- (list (lambda () (insert-samples 2000 100 (make-vct 100 .2))) 1000 #f 'insert2000)
+ (list (lambda () (insert-samples 0 100 (make-float-vector 100 .2))) 1100 #f 'insert0)
+ (list (lambda () (insert-samples 800 100 (make-float-vector 100 .2))) 1100 #f 'insert800)
+ (list (lambda () (insert-samples 990 100 (make-float-vector 100 .2))) 1100 #f 'insert990)
+ (list (lambda () (insert-samples 1010 100 (make-float-vector 100 .2))) 1000 #t 'insert1010)
+ (list (lambda () (insert-samples 1050 10 (make-float-vector 100 .2))) 1000 #t 'insert1050)
+ (list (lambda () (insert-samples 1110 100 (make-float-vector 100 .2))) 1000 #f 'insert1110)
+ (list (lambda () (insert-samples 2000 100 (make-float-vector 100 .2))) 1000 #f 'insert2000)
- (let ((fr (mus-sound-frames "1a.snd")))
+ (let ((fr (mus-sound-framples "1a.snd")))
(list (lambda () (insert-sound "1a.snd" 0)) (+ fr 1000) #f 'inserts0)
(list (lambda () (insert-sound "1a.snd" 800)) (+ fr 1000) #f 'inserts800)
(list (lambda () (insert-sound "1a.snd" 990)) (+ fr 1000) #f 'inserts990)
@@ -28987,14 +23582,14 @@ EDITS: 2
(list (lambda () (delete-samples 1110 100)) 1000 #f 'delete1110)
(list (lambda () (delete-samples 2000 100)) 1000 #f 'delete2000)
- (list (lambda () (set! (samples 0 100) (make-vct 100 .2))) 1000 #f 'set0)
- (list (lambda () (set! (samples 0 2000) (make-vct 2000 .2))) 1000 #t 'set0)
- (list (lambda () (set! (samples 800 100) (make-vct 100 .2))) 1000 #f 'set800)
- (list (lambda () (set! (samples 990 100) (make-vct 100 .2))) 1000 #t 'set990)
- (list (lambda () (set! (samples 1010 100) (make-vct 100 .2))) 1000 #t 'set1010)
- (list (lambda () (set! (samples 1050 10) (make-vct 100 .2))) 1000 #t 'set1050)
- (list (lambda () (set! (samples 1110 100) (make-vct 100 .2))) 1000 #f 'set1110)
- (list (lambda () (set! (samples 2000 100) (make-vct 100 .2))) 1000 #f 'set2000)
+ (list (lambda () (set! (samples 0 100) (make-float-vector 100 .2))) 1000 #f 'set0)
+ (list (lambda () (set! (samples 0 2000) (make-float-vector 2000 .2))) 1000 #t 'set0)
+ (list (lambda () (set! (samples 800 100) (make-float-vector 100 .2))) 1000 #f 'set800)
+ (list (lambda () (set! (samples 990 100) (make-float-vector 100 .2))) 1000 #t 'set990)
+ (list (lambda () (set! (samples 1010 100) (make-float-vector 100 .2))) 1000 #t 'set1010)
+ (list (lambda () (set! (samples 1050 10) (make-float-vector 100 .2))) 1000 #t 'set1050)
+ (list (lambda () (set! (samples 1110 100) (make-float-vector 100 .2))) 1000 #f 'set1110)
+ (list (lambda () (set! (samples 2000 100) (make-float-vector 100 .2))) 1000 #f 'set2000)
(list (lambda () (scale-channel 2.0 0 100)) 1000 #f 'scale0)
(list (lambda () (scale-channel 2.0 0 2000)) 1000 #t 'scale20)
@@ -29018,21 +23613,9 @@ EDITS: 2
(list (lambda () (env-channel '(0 0 1 1) 1110 100)) 1000 #f 'env1110)
(list (lambda () (env-channel '(0 0 1 1) 2000 100)) 1000 #f 'env2000)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 0 100)) 1000 #f 'ptree0)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 0 2000)) 1000 #t 'ptree20)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 800 100)) 1000 #f 'ptree800)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 850 100)) 1000 #f 'ptree850)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 950 40)) 1000 #f 'ptree950)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 990 100)) 1000 #t 'ptree990)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1010 100)) 1000 #t 'ptree1010)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1050 10)) 1000 #t 'ptree1050)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 1110 100)) 1000 #f 'ptree1110)
- (list (lambda () (ptree-channel (lambda (y) (* y 2)) 2000 100)) 1000 #f 'ptree2000)))
-
+ ))
(close-sound ind))
- (set! (optimization) old-opt-val)
-
(let ((ind (open-sound "4.aiff"))
(selind (open-sound "oboe.snd")))
(make-selection 100 500 selind 0)
@@ -29068,7 +23651,7 @@ EDITS: 2
(close-sound selind))
- (let ((new-index (new-sound "hiho.wave" mus-next mus-bshort 22050 1)))
+ (let ((new-index (new-sound "hiho.wave" 1 22050 mus-ldouble mus-next)))
(log-mem test-ctr)
(select-sound new-index)
(if (find-mix 0 new-index 0) (snd-display #__line__ ";found non-existent mix? ~A" (find-mix 0 new-index 0)))
@@ -29093,9 +23676,9 @@ EDITS: 2
(let ((reader-string (format #f "~A" mr)))
(if (not (string=? (substring reader-string 0 16) "#<mix-sampler mi"))
(snd-display #__line__ ";mix sampler actually got: [~S]" (substring reader-string 0 16))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 99))
- (let ((mx (if (odd? i) (read-mix-sample mr) (read-mix-sample mr)))
+ (let ((mx (read-mix-sample mr))
(sx (sample (+ 100 i))))
(if (fneq mx sx) (snd-display #__line__ ";read-mix-sample: ~A ~A?" mx sx))))
(let ((mx (mr))
@@ -29108,7 +23691,7 @@ EDITS: 2
(if (not (= chn 0)) (snd-display #__line__ ";c mix-home: ~A?" chn))
(if (fneq amp 1.0) (snd-display #__line__ ";mix-amp: ~A?" amp))
(if (fneq spd 1.0) (snd-display #__line__ ";mix-speed: ~A?" spd))
- (if nam (snd-display #__line__ ";mix-name: ~A" nam))
+ (if (not (equal? nam "")) (snd-display #__line__ ";mix-name: ~A" nam))
(catch 'mus-error
(lambda () (play mix-id))
(lambda args (snd-display #__line__ ";can't play mix: ~A" args)))
@@ -29125,17 +23708,13 @@ EDITS: 2
(if (or (not (string? (mix-name mix-id)))
(not (string=? (mix-name mix-id) "test-mix-again")))
(snd-display #__line__ ";mix-name set again: ~A" (mix-name mix-id)))
- (set! (mix-name mix-id) #f)
- (if (mix-name mix-id) (snd-display #__line__ ";set mix-name #f: ~A" (mix-name mix-id)))
+ (set! (mix-name mix-id) "")
+ (if (not (equal? (mix-name mix-id) "")) (snd-display #__line__ ";set mix-name #f: ~A" (mix-name mix-id)))
(set! (mix-position mix-id) 200)
(set! (mix-amp mix-id) 0.5)
(set! (mix-speed mix-id) 2.0)
(set! (mix-amp-env mix-id) '(0.0 0.0 1.0 1.0))
- (let ((val (mix-amp-env mix-id)))
- (set! (mix-amp-env mix-id) (mix-amp-env mix-id))
- (if (not (feql (mix-amp-env mix-id) val))
- (snd-display #__line__ ";set mix-amp-env to self: ~A ~A" val (mix-amp-env mix-id))))
(set! (mix-tag-y mix-id) 20)
(let ((pos (mix-position mix-id))
(spd (mix-speed mix-id))
@@ -29147,7 +23726,7 @@ EDITS: 2
(if (fneq spd 2.0) (snd-display #__line__ ";set-mix-speed: ~A?" spd))
(if (not (equal? (mix-amp-env mix-id) '(0.0 0.0 1.0 1.0))) (snd-display #__line__ ";set-mix-amp-env: ~A?" (mix-amp-env mix-id))))
))
- (mix-vct (make-vct 3 .1) 100)
+ (mix-float-vector (make-float-vector 3 .1) 100)
(set! (cursor) 0)
(let ((nid (find-mix 100)))
(if (or (not (mix? nid))
@@ -29158,18 +23737,18 @@ EDITS: 2
(not (= (mix-position nid) 200)))
(snd-display #__line__ ";find-mix(200): ~A ~A?" nid (and (mix? nid) (mix-position nid)))))
(let ((mix-id (car (mix "oboe.snd" 100))))
- (set! (mix-waveform-height) 40)
+ (set! *mix-waveform-height* 40)
(set! (mix-property :hiho mix-id) 123)
(if (not (= (mix-property :hiho mix-id) 123)) (snd-display #__line__ ";mix-property: ~A" (mix-property :hiho mix-id)))
(if (mix-property :not-there mix-id) (snd-display #__line__ ";mix-not-property: ~A" (mix-property :not-there mix-id)))
(update-time-graph)
- (set! (mix-waveform-height) 20))
+ (set! *mix-waveform-height* 20))
(close-sound new-index))
)
(dismiss-all-dialogs)
;; pan-mix tests
- (let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 1 "pan-mix tests")))
+ (let ((ind (new-sound "fmv.snd" 1 22050 mus-ldouble mus-next "pan-mix tests")))
(let ((id0 (car (pan-mix "1a.snd" 10000 '(0 0 1 1)))))
(if (or (fneq (mix-amp id0) 1.0)
@@ -29192,7 +23771,7 @@ EDITS: 2
(revert-sound ind))
(close-sound ind))
- (let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 2 "pan-mix tests")))
+ (let ((ind (new-sound "fmv.snd" 2 22050 mus-ldouble mus-next "pan-mix tests")))
(let* ((ids (pan-mix "1a.snd" 100 '(0 0 1 1 2 0)))
(id0 (car ids))
(id1 (cadr ids)))
@@ -29231,20 +23810,20 @@ EDITS: 2
(revert-sound ind))
(close-sound ind))
- (let ((ind (new-sound "test.snd" mus-next mus-bshort 22050 2 "pan-mix-* tests" 1000)))
- (let* ((ids (pan-mix-vct (make-vct 100 .3) 100 '(0 0 1 1)))
+ (let ((ind (new-sound "test.snd" 2 22050 mus-ldouble mus-next "pan-mix-* tests" 1000)))
+ (let* ((ids (pan-mix-float-vector (make-float-vector 100 .3) 100 '(0 0 1 1)))
(id0 (car ids))
(id1 (cadr ids)))
(if (or (not (mix? id0)) (not (mix? id1)))
- (snd-display #__line__ ";pan-mix-vct 1->2: ~A ~A" id0 id1))
+ (snd-display #__line__ ";pan-mix-float-vector 1->2: ~A ~A" id0 id1))
(if (not (= (mix-position id0) (mix-position id1) 100))
- (snd-display #__line__ ";pan-mix-vct 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
+ (snd-display #__line__ ";pan-mix-float-vector 1->2 pos: ~A ~A" (mix-position id0) (mix-position id1)))
(if (or (fneq (mix-amp id0) 1.0) (fneq (mix-amp id1) 1.0))
- (snd-display #__line__ ";pan-mix-vct 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
+ (snd-display #__line__ ";pan-mix-float-vector 1->2 amps: ~A ~A" (mix-amp id0) (mix-amp id1)))
(if (not (feql (mix-amp-env id0) '(0 1 1 0)))
- (snd-display #__line__ ";pan-mix-vct 1->2 env 0: ~A" (mix-amp-env id0)))
+ (snd-display #__line__ ";pan-mix-float-vector 1->2 env 0: ~A" (mix-amp-env id0)))
(if (not (feql (mix-amp-env id1) '(0 0 1 1)))
- (snd-display #__line__ ";pan-mix-vct 1->2 env 1: ~A" (mix-amp-env id1)))
+ (snd-display #__line__ ";pan-mix-float-vector 1->2 env 1: ~A" (mix-amp-env id1)))
(revert-sound ind))
(let* ((reg (make-region 0 50 ind 0))
@@ -29282,11 +23861,11 @@ EDITS: 2
;; copy mix
(let ((snd (new-sound "test.snd")))
- (let ((v (make-vct 1000)))
+ (let ((v (make-float-vector 1000)))
(do ((i 0 (+ i 1)))
((= i 1000))
- (vct-set! v i (* i .001)))
- (let ((mx (mix-vct v 0 snd 0)))
+ (set! (v i) (* i .001)))
+ (let ((mx (mix-float-vector v 0 snd 0)))
(let ((mx-copy (copy mx)))
(if (not (= (length mx) (length mx-copy)))
(snd-display #__line__ ";copy mix lengths: ~A ~A" (length mx) (length mx-copy)))
@@ -29307,56 +23886,44 @@ EDITS: 2
(snd-display #__line__ ";copy mix at ~A: ~A ~A ~A" i x1 x2 (* i .001))))))))))
(close-sound snd))
- (let ((ind (make-waltz)))
- ;; mix.scm stuff...
- (close-sound ind))
+ (if all-args
+ (begin
+ (let ((ind (make-waltz)))
+ ;; mix.scm stuff...
+ (close-sound ind))
- (let ((ind (make-bagatelle)))
- (close-sound ind))
+ (let ((ind (make-bagatelle)))
+ (close-sound ind))))
)))
;;; ---------------- test 10: marks ----------------
-(if (not (provided? 'snd-marks.scm)) (load "marks.scm"))
+(require snd-marks.scm)
+
+(if (provided? 'snd-motif)
+ (define mark-sync-color (*motif* 'mark-sync-color)))
(define (snd_test_10)
(define maxval 0.0)
- (define data-max
- (lambda (beg end)
- (set! maxval 0.0)
- (apply for-each
- (lambda (snd chn)
- (scan-chan (lambda (n)
- (set! maxval (max maxval (abs n)))
- #f)
- 0 #f snd chn))
- (all-chans))
- maxval))
-
- (define data-max2
- (lambda (beg end snd)
- (set! maxval 0.0)
- (do ((i 0 (+ 1 i)))
- ((= i (chans snd)) maxval)
- (scan-chan (lambda (n)
- (set! maxval (max maxval (abs n)))
- #f)
- 0 #f snd i))))
-
- (define data-max1
- (lambda (beg end snd chn)
- (set! maxval 0.0)
- (scan-chan
- (lambda (data)
- (let ((curval (abs data)))
- (if (> curval maxval) (set! maxval curval))
- #f))
- beg end snd chn)
- maxval))
-
+ (define (data-max beg end)
+ (set! maxval 0.0)
+ (apply for-each
+ (lambda (snd chn)
+ (set! maxval (max maxval (float-vector-peak (samples beg (- end beg) snd chn)))))
+ (all-chans))
+ maxval)
+
+ (define (data-max2 beg end snd)
+ (set! maxval 0.0)
+ (do ((i 0 (+ i 1)))
+ ((= i (chans snd)) maxval)
+ (set! maxval (max maxval (float-vector-peak (samples beg (- end beg) snd i))))))
+
+ (define (data-max1 beg dur snd chn)
+ (float-vector-peak (samples beg dur snd chn)))
;; from marks.scm (commented out)
@@ -29368,7 +23935,7 @@ EDITS: 2
(lambda args #f))))
(define (marks->string sndf)
- (let ((str (format #f "(if (not (provided? 'snd-marks.scm)) (load \"marks.scm\"))~%(let ((m #f))~%"))
+ (let ((str (format #f "(require snd-marks.scm)~%(let ((m #f))~%"))
(chan 0))
(for-each
(lambda (chan-marks)
@@ -29380,12 +23947,11 @@ EDITS: 2
" (set! m (add-mark ~A #f ~D ~A ~D))~%"
(mark-sample m)
chan
- (if (and (string? (mark-name m))
- (> (string-length (mark-name m)) 0))
- (format #f "~S" (mark-name m))
- #f)
+ (and (string? (mark-name m))
+ (> (length (mark-name m)) 0)
+ (format #f "~S" (mark-name m)))
(mark-sync m))))
- (if (not (null? (mark-properties m)))
+ (if (pair? (mark-properties m))
(set! str
(string-append str
(format #f
@@ -29396,947 +23962,927 @@ EDITS: 2
(marks sndf))
(string-append str (format #f " m)~%"))))
-
- (begin
- (do ((test-ctr 0 (+ 1 test-ctr)))
- ((= test-ctr tests))
- (clear-sincs)
- (log-mem test-ctr)
+ (do ((test-ctr 0 (+ 1 test-ctr)))
+ ((= test-ctr tests))
+ (log-mem test-ctr)
+
+ (let ((ind0 (view-sound "oboe.snd"))
+ (ind1 (view-sound "pistol.snd"))
+ (v0 (make-float-vector 100))
+ (vc (make-vector 10)))
+ (fill! v0 .1)
+ (set! (vc 0) (mix-float-vector v0 0 ind0))
+ (set! (vc 1) (mix-float-vector v0 1000 ind0))
+ (set! (vc 2) (mix-float-vector v0 2000 ind0))
+ (set! (vc 3) (mix-float-vector v0 3000 ind0))
+ (set! (vc 4) (mix-float-vector v0 4000 ind0))
+ (set! (vc 5) (mix-float-vector v0 0 ind1))
+ (set! (vc 6) (mix-float-vector v0 1000 ind1))
+ (set! (vc 7) (mix-float-vector v0 2000 ind1))
+ (set! (vc 8) (mix-float-vector v0 3000 ind1))
+ (set! (vc 9) (mix-float-vector v0 4000 ind1))
+ (close-sound ind0)
+ (close-sound ind1)
+ (set! ind0 (new-sound "fmv.snd" 1 22050 mus-bshort mus-aifc "this is a comment"))
+ (let ((v0 (make-vector 10 1.0)))
+ (insert-samples 0 10 v0 ind0)
+ (time (env-sound '(0 0 1 1) 0 10 1.0 ind0))
+ (do ((i 0 (+ i 1))) ((= i 10)) (if (fneq (sample i) (* i .1111)) (snd-display #__line__ ";1 env-sound[~D]: ~A?" i (sample i))))
+ (undo)
+ (env-sound (make-env '(0 0 1 1) :length 10) 0 10 1.0 ind0)
+ (do ((i 0 (+ i 1))) ((= i 10)) (if (fneq (sample i) (* i .1111)) (snd-display #__line__ ";2 env-sound[~D]: ~A?" i (sample i))))
+ (undo)
+ (env-sound '(0 0 .5 1 1 1) 0 10 0.0 ind0)
+ (if (or (fneq (sample 3) 0.0) (fneq (sample 8) 1.0) )
+ (snd-display #__line__ ";env-sound stepped: ~A ~A?" (sample 3) (sample 8)))
+ (undo)
+ (env-sound '(0 0 1 1) 0 10 32.0 ind0)
+ (if (or (fneq (sample 3) 0.070) (fneq (sample 8) 0.67) )
+ (snd-display #__line__ ";env-sound exp: ~A ~A?" (sample 3) (sample 8)))
+ (undo)
+ (env-sound (make-env '(0 0 1 1) :base 32.0 :length 10) 0 10 32.0 ind0)
+ (if (or (fneq (sample 3) 0.070) (fneq (sample 8) 0.67) )
+ (snd-display #__line__ ";env-sound exp: ~A ~A?" (sample 3) (sample 8)))
+ (undo)
+ (env-sound '(0 2))
+ (do ((i 0 (+ i 1))) ((= i 10)) (if (fneq (sample i) 2.0) (snd-display #__line__ ";3 env-sound[~D]: ~A?" i (sample i))))
+ (undo)
+ (env-sound '(0 2) 2 4 1.0 ind0)
+ (if (or (fneq (sample 1) 1.0) (fneq (sample 2) 2.0) (fneq (sample 5) 2.0) (fneq (sample 8) 1.0))
+ (snd-display #__line__ ";3 env-sound exp: ~A ~A ~A ~A?" (sample 1) (sample 2) (sample 5) (sample 8)))
+ (undo)
+ (do ((i 1 (+ i 1))) ((= i 10)) (set! (sample i) 0.0))
+ (filter-sound '(0 1 1 0) 4)
+ (if (or (fneq (sample 1) 0.3678) (fneq (sample 2) .3678) (fneq (sample 3) .132) (fneq (sample 4) 0.0))
+ (snd-display #__line__ ";filter-sound env: ~A?" (samples 0 8)))
+ (undo)
+ (filter-sound '(0 1 1 0) 1024)
+ (undo)
+ (filter-sound (make-fir-filter 6 (float-vector .1 .2 .3 .3 .2 .1)))
+ (undo)
+ (filter-sound (make-delay 120))
+ (undo)
+ (filter-sound (make-formant 1200 .99))
+ (undo)
+ (let ((vc0 (make-float-vector 4)))
+ (set! (vc0 0) .125) (set! (vc0 1) .25) (set! (vc0 2) .25) (set! (vc0 3) .125)
+ (filter-sound vc0 4)
+ (if (or (fneq (sample 0) 0.125) (fneq (sample 1) .25) (fneq (sample 2) .25) (fneq (sample 5) 0.0))
+ (snd-display #__line__ ";filter-sound direct: ~A?" (samples 0 8)))
+ (revert-sound)))
+ (close-sound ind0)
- (let ((ind0 (view-sound "oboe.snd"))
- (ind1 (view-sound "pistol.snd"))
- (v0 (make-vct 100))
- (vc (make-vector 10)))
- (vct-fill! v0 .1)
- (vector-set! vc 0 (mix-vct v0 0 ind0))
- (vector-set! vc 1 (mix-vct v0 1000 ind0))
- (vector-set! vc 2 (mix-vct v0 2000 ind0))
- (vector-set! vc 3 (mix-vct v0 3000 ind0))
- (vector-set! vc 4 (mix-vct v0 4000 ind0))
- (vector-set! vc 5 (mix-vct v0 0 ind1))
- (vector-set! vc 6 (mix-vct v0 1000 ind1))
- (vector-set! vc 7 (mix-vct v0 2000 ind1))
- (vector-set! vc 8 (mix-vct v0 3000 ind1))
- (vector-set! vc 9 (mix-vct v0 4000 ind1))
- (close-sound ind0)
- (close-sound ind1)
- (set! ind0 (new-sound "fmv.snd" mus-aifc mus-bshort 22050 1 "this is a comment"))
- (let ((v0 (make-vector 10)))
- (do ((i 0 (+ 1 i))) ((= i 10)) (vector-set! v0 i 1.0))
- (insert-samples 0 10 v0 ind0)
- (time (env-sound '(0 0 1 1) 0 10 1.0 ind0))
- (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) (* i .1111)) (snd-display #__line__ ";1 env-sound[~D]: ~A?" i (sample i))))
- (undo)
- (env-sound (make-env '(0 0 1 1) :length 10) 0 10 1.0 ind0)
- (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) (* i .1111)) (snd-display #__line__ ";2 env-sound[~D]: ~A?" i (sample i))))
- (undo)
- (env-sound '(0 0 .5 1 1 1) 0 10 0.0 ind0)
- (if (or (fneq (sample 3) 0.0) (fneq (sample 8) 1.0) )
- (snd-display #__line__ ";env-sound stepped: ~A ~A?" (sample 3) (sample 8)))
- (undo)
- (env-sound '(0 0 1 1) 0 10 32.0 ind0)
- (if (or (fneq (sample 3) 0.070) (fneq (sample 8) 0.67) )
- (snd-display #__line__ ";env-sound exp: ~A ~A?" (sample 3) (sample 8)))
- (undo)
- (env-sound (make-env '(0 0 1 1) :base 32.0 :length 10) 0 10 32.0 ind0)
- (if (or (fneq (sample 3) 0.070) (fneq (sample 8) 0.67) )
- (snd-display #__line__ ";env-sound exp: ~A ~A?" (sample 3) (sample 8)))
- (undo)
- (env-sound '(0 2))
- (do ((i 0 (+ 1 i))) ((= i 10)) (if (fneq (sample i) 2.0) (snd-display #__line__ ";3 env-sound[~D]: ~A?" i (sample i))))
- (undo)
- (env-sound '(0 2) 2 4 1.0 ind0)
- (if (or (fneq (sample 1) 1.0) (fneq (sample 2) 2.0) (fneq (sample 5) 2.0) (fneq (sample 8) 1.0))
- (snd-display #__line__ ";3 env-sound exp: ~A ~A ~A ~A?" (sample 1) (sample 2) (sample 5) (sample 8)))
- (undo)
- (do ((i 1 (+ 1 i))) ((= i 10)) (set! (sample i) 0.0))
- (filter-sound '(0 1 1 0) 4)
- (if (or (fneq (sample 1) 0.3678) (fneq (sample 2) .3678) (fneq (sample 3) .132) (fneq (sample 4) 0.0))
- (snd-display #__line__ ";filter-sound env: ~A?" (samples 0 8)))
- (undo)
- (filter-sound '(0 1 1 0) 1024)
- (undo)
- (filter-sound (make-fir-filter 6 (list->vct '(.1 .2 .3 .3 .2 .1))))
- (undo)
- (filter-sound (make-delay 120))
- (undo)
- (filter-sound (make-formant 1200 .99))
- (undo)
- (let ((vc0 (make-vct 4)))
- (vct-set! vc0 0 .125) (vct-set! vc0 1 .25) (vct-set! vc0 2 .25) (vct-set! vc0 3 .125)
- (filter-sound vc0 4)
- (if (or (fneq (sample 0) 0.125) (fneq (sample 1) .25) (fneq (sample 2) .25) (fneq (sample 5) 0.0))
- (snd-display #__line__ ";filter-sound direct: ~A?" (samples 0 8)))
- (revert-sound)))
- (close-sound ind0)
-
- (set! ind0 (new-sound "fmv.snd" mus-aifc mus-bshort 22050 2 "this is a comment"))
- (let ((v0 (make-vector 10))
- (ind1 (new-sound "fmv1.snd" mus-aifc mus-bshort 22050 1 "this is a comment")))
- (set! (sync ind0) 123)
- (set! (sync ind1) 123)
- (do ((i 0 (+ 1 i))) ((= i 10)) (vector-set! v0 i 1.0))
- (insert-samples 0 10 v0 ind0 0)
- (insert-samples 0 10 v0 ind0 1)
- (insert-samples 0 10 v0 ind1 0)
- (env-sound '(0 0 1 1) 0 10 1.0 ind0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (sample i ind0 0) (* i .1111)) (snd-display #__line__ ";ind0:0 1 env-sound[~D]: ~A?" i (sample i ind0 0)))
- (if (fneq (sample i ind0 1) (* i .1111)) (snd-display #__line__ ";ind0:1 1 env-sound[~D]: ~A?" i (sample i ind0 1)))
- (if (fneq (sample i ind1 0) (* i .1111)) (snd-display #__line__ ";ind1:0 1 env-sound[~D]: ~A?" i (sample i ind1 0))))
- (undo)
- (env-sound (make-env '(0 0 1 1) :length 10) 0 10 1.0 ind0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (sample i ind0 0) (* i .1111)) (snd-display #__line__ ";ind0:0 2 env-sound[~D]: ~A?" i (sample i ind0 0)))
- (if (fneq (sample i ind0 1) (* i .1111)) (snd-display #__line__ ";ind0:1 2 env-sound[~D]: ~A?" i (sample i ind0 1)))
- (if (fneq (sample i ind1 0) (* i .1111)) (snd-display #__line__ ";ind1:0 2 env-sound[~D]: ~A?" i (sample i ind1 0))))
- (undo)
- (env-sound '(0 0 .5 1 1 1) 0 10 0.0 ind0)
- (if (or (fneq (sample 3 ind0 0) 0.0) (fneq (sample 8 ind0 0) 1.0) )
- (snd-display #__line__ ";ind0:0 env-sound stepped: ~A ~A?" (sample 3 ind0 0) (sample 8 ind0 0)))
- (if (or (fneq (sample 3 ind0 1) 0.0) (fneq (sample 8 ind0 1) 1.0) )
- (snd-display #__line__ ";ind0:1 env-sound stepped: ~A ~A?" (sample 3 ind0 1) (sample 8 ind0 1)))
- (if (or (fneq (sample 3 ind1 0) 0.0) (fneq (sample 8 ind1 0) 1.0) )
- (snd-display #__line__ ";ind1:0 env-sound stepped: ~A ~A?" (sample 3 ind1 0) (sample 8 ind1 0)))
- (undo)
- (revert-sound ind0)
- (revert-sound ind1)
- (insert-samples 0 10 v0 ind0 0)
- (insert-samples 0 10 v0 ind0 1)
- (insert-samples 0 10 v0 ind1 0)
- (filter-sound (make-one-zero :a0 0.5 :a1 0.0) 0 ind0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (fneq (sample i ind0 0) 0.5) (snd-display #__line__ ";ind0:0 1 filter-sound[~D]: ~A?" i (sample i ind0 0)))
- (if (fneq (sample i ind0 1) 0.5) (snd-display #__line__ ";ind0:1 1 filter-sound[~D]: ~A?" i (sample i ind0 1)))
- (if (fneq (sample i ind1 0) 0.5) (snd-display #__line__ ";ind1:0 1 filter-sound[~D]: ~A?" i (sample i ind1 0))))
-
- (close-sound ind1))
- (close-sound ind0)
-
- (set! ind0 (new-sound "fmv.snd" mus-aifc mus-bshort 22050 1 "this is a comment"))
- (let ((v0 (make-vct 10))
- (old5 (sample 5 ind0)))
- (vct-fill! v0 0.1)
- (insert-samples 10 10 v0 ind0)
- (env-sound '(0 0 1 2) 10 10 1.0 ind0)
- (do ((i 0 (+ 1 i))) ((= i 10))
- (if (fneq (sample (+ i 10) ind0) (* i .0222)) (snd-display #__line__ ";env-sound [~D]: ~A?" (+ i 10) (sample (+ i 10) ind0))))
- (if (fneq (sample 5 ind0) old5) (snd-display #__line__ ";env-sound 5: ~A ~A?" old5 (sample 5 ind0)))
- (undo)
- (env-sound '(0 0 1 2) 10 10 4.0 ind0)
- (set! v0 (channel->vct 10 10))
- (if (or (fneq (vct-ref v0 3) 0.039) (fneq (vct-ref v0 8) .162)) (snd-display #__line__ ";env-sound 4: ~A" v0))
- (undo)
- (env-sound '(0 0 1 2) 10 10 .05 ind0)
- (set! v0 (channel->vct 10 10))
- (if (or (fneq (vct-ref v0 3) 0.133) (fneq (vct-ref v0 8) .196)) (snd-display #__line__ ";env-sound 05: ~A" v0)))
-
- (close-sound ind0)
- (set! ind0 (new-sound "fmv.snd" mus-aifc mus-bshort 22050 2 "this is a comment"))
- (set! ind1 (new-sound "fmv1.snd" mus-next mus-bshort 22050 1 "this is a comment"))
- (let ((v0 (make-vector 10)))
- (do ((i 0 (+ 1 i))) ((= i 10)) (vector-set! v0 i 1.0))
- (insert-samples 0 10 v0 ind0 0)
- (do ((i 0 (+ 1 i))) ((= i 10)) (vector-set! v0 i 0.1))
- (insert-samples 0 10 v0 ind0 1)
- (do ((i 0 (+ 1 i))) ((= i 10)) (vector-set! v0 i 0.01))
- (insert-samples 0 10 v0 ind1 0)
- (let ((val (data-max1 0 9 ind0 0)))
- (if (fneq val 1.0) (snd-display #__line__ ";scan-chan[0,0]: ~A?" val)))
- (let ((val (data-max1 0 9 ind0 1)))
- (if (fneq val 0.1) (snd-display #__line__ ";scan-chan[0,1]: ~A?" val)))
- (let ((val (data-max1 0 9 ind1 0)))
- (if (fneq val 0.01) (snd-display #__line__ ";scan-chan[1,0]: ~A?" val)))
- (let ((val (data-max1 0 9 #f #f)))
- (if (fneq val 0.01) (snd-display #__line__ ";scan-chans: ~A?" val)))
- (let ((val (data-max 0 9)))
- (if (fneq val 1.0) (snd-display #__line__ ";scan-all-chans: ~A?" val)))
- (let ((val (data-max2 0 9 ind0)))
- (if (fneq val 1.0) (snd-display #__line__ ";scan-across-sound-chans: ~A?" val))))
- (close-sound ind0)
- (close-sound ind1)
+ (set! ind0 (new-sound "fmv.snd" 2 22050 mus-bshort mus-aifc "this is a comment"))
+ (let ((v0 (make-vector 10 1.0))
+ (ind1 (new-sound "fmv1.snd" 1 22050 mus-bshort mus-aifc "this is a comment")))
+ (set! (sync ind0) 123)
+ (set! (sync ind1) 123)
+ (insert-samples 0 10 v0 ind0 0)
+ (insert-samples 0 10 v0 ind0 1)
+ (insert-samples 0 10 v0 ind1 0)
+ (env-sound '(0 0 1 1) 0 10 1.0 ind0)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (sample i ind0 0) (* i .1111)) (snd-display #__line__ ";ind0:0 1 env-sound[~D]: ~A?" i (sample i ind0 0)))
+ (if (fneq (sample i ind0 1) (* i .1111)) (snd-display #__line__ ";ind0:1 1 env-sound[~D]: ~A?" i (sample i ind0 1)))
+ (if (fneq (sample i ind1 0) (* i .1111)) (snd-display #__line__ ";ind1:0 1 env-sound[~D]: ~A?" i (sample i ind1 0))))
+ (undo)
+ (env-sound (make-env '(0 0 1 1) :length 10) 0 10 1.0 ind0)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (sample i ind0 0) (* i .1111)) (snd-display #__line__ ";ind0:0 2 env-sound[~D]: ~A?" i (sample i ind0 0)))
+ (if (fneq (sample i ind0 1) (* i .1111)) (snd-display #__line__ ";ind0:1 2 env-sound[~D]: ~A?" i (sample i ind0 1)))
+ (if (fneq (sample i ind1 0) (* i .1111)) (snd-display #__line__ ";ind1:0 2 env-sound[~D]: ~A?" i (sample i ind1 0))))
+ (undo)
+ (env-sound '(0 0 .5 1 1 1) 0 10 0.0 ind0)
+ (if (or (fneq (sample 3 ind0 0) 0.0) (fneq (sample 8 ind0 0) 1.0) )
+ (snd-display #__line__ ";ind0:0 env-sound stepped: ~A ~A?" (sample 3 ind0 0) (sample 8 ind0 0)))
+ (if (or (fneq (sample 3 ind0 1) 0.0) (fneq (sample 8 ind0 1) 1.0) )
+ (snd-display #__line__ ";ind0:1 env-sound stepped: ~A ~A?" (sample 3 ind0 1) (sample 8 ind0 1)))
+ (if (or (fneq (sample 3 ind1 0) 0.0) (fneq (sample 8 ind1 0) 1.0) )
+ (snd-display #__line__ ";ind1:0 env-sound stepped: ~A ~A?" (sample 3 ind1 0) (sample 8 ind1 0)))
+ (undo)
+ (revert-sound ind0)
+ (revert-sound ind1)
+ (insert-samples 0 10 v0 ind0 0)
+ (insert-samples 0 10 v0 ind0 1)
+ (insert-samples 0 10 v0 ind1 0)
+ (filter-sound (make-one-zero :a0 0.5 :a1 0.0) 0 ind0)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (if (fneq (sample i ind0 0) 0.5) (snd-display #__line__ ";ind0:0 1 filter-sound[~D]: ~A?" i (sample i ind0 0)))
+ (if (fneq (sample i ind0 1) 0.5) (snd-display #__line__ ";ind0:1 1 filter-sound[~D]: ~A?" i (sample i ind0 1)))
+ (if (fneq (sample i ind1 0) 0.5) (snd-display #__line__ ";ind1:0 1 filter-sound[~D]: ~A?" i (sample i ind1 0))))
- (set! ind0 (new-sound "fmv.snd" mus-aifc mus-bshort 22050 2 "this is a comment"))
- (mix "oboe.snd")
- (let ((m1 (add-mark 100)))
+ (close-sound ind1))
+ (close-sound ind0)
+
+ (set! ind0 (new-sound "fmv.snd" 1 22050 mus-bshort mus-aifc "this is a comment"))
+ (let ((v0 (make-float-vector 10))
+ (old5 (sample 5 ind0)))
+ (fill! v0 0.1)
+ (insert-samples 10 10 v0 ind0)
+ (env-sound '(0 0 1 2) 10 10 1.0 ind0)
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (if (fneq (sample (+ i 10) ind0) (* i .0222)) (snd-display #__line__ ";env-sound [~D]: ~A?" (+ i 10) (sample (+ i 10) ind0))))
+ (if (fneq (sample 5 ind0) old5) (snd-display #__line__ ";env-sound 5: ~A ~A?" old5 (sample 5 ind0)))
+ (undo)
+ (env-sound '(0 0 1 2) 10 10 4.0 ind0)
+ (set! v0 (channel->float-vector 10 10))
+ (if (or (fneq (v0 3) 0.039) (fneq (v0 8) .162)) (snd-display #__line__ ";env-sound 4: ~A" v0))
+ (undo)
+ (env-sound '(0 0 1 2) 10 10 .05 ind0)
+ (set! v0 (channel->float-vector 10 10))
+ (if (or (fneq (v0 3) 0.133) (fneq (v0 8) .196)) (snd-display #__line__ ";env-sound 05: ~A" v0)))
+
+ (close-sound ind0)
+ (set! ind0 (new-sound "fmv.snd" 2 22050 mus-bshort mus-aifc "this is a comment"))
+ (set! ind1 (new-sound "fmv1.snd" 1 22050 mus-ldouble mus-next "this is a comment"))
+ (let ((v0 (make-vector 10 1.0)))
+ (insert-samples 0 10 v0 ind0 0)
+ (fill! v0 0.1)
+ (insert-samples 0 10 v0 ind0 1)
+ (fill! v0 0.01)
+ (insert-samples 0 10 v0 ind1 0)
+ (let ((val (data-max1 0 9 ind0 0)))
+ (if (fneq val 1.0) (snd-display #__line__ ";scan-chan[0,0]: ~A?" val)))
+ (let ((val (data-max1 0 9 ind0 1)))
+ (if (fneq val 0.1) (snd-display #__line__ ";scan-chan[0,1]: ~A?" val)))
+ (let ((val (data-max1 0 9 ind1 0)))
+ (if (fneq val 0.01) (snd-display #__line__ ";scan-chan[1,0]: ~A?" val)))
+ (let ((val (data-max1 0 9 #f #f)))
+ (if (fneq val 0.01) (snd-display #__line__ ";scan-chans: ~A?" val)))
+ (let ((val (data-max 0 9)))
+ (if (fneq val 1.0) (snd-display #__line__ ";scan-all-chans: ~A?" val)))
+ (let ((val (data-max2 0 9 ind0)))
+ (if (fneq val 1.0) (snd-display #__line__ ";scan-across-sound-chans: ~A?" val))))
+ (close-sound ind0)
+ (close-sound ind1)
+
+ (set! ind0 (new-sound "fmv.snd" 2 22050 mus-bshort mus-aifc "this is a comment"))
+ (mix "oboe.snd")
+ (let ((m1 (add-mark 100)))
+ (delete-sample 10)
+ (let ((m2 (add-mark 200)))
(delete-sample 10)
- (let ((m2 (add-mark 200)))
- (delete-sample 10)
- (let ((m3 (add-mark 300)))
- (undo)
- (save-sound)
- (if (not (= (length (marks ind0 0)) 2))
- (snd-display #__line__ ";marks after save: ~A" (marks ind0 0)))
- (if (or (not (mark? m1))
- (not (= (mark-sample m1) 99)))
- (snd-display #__line__ ";save-sound mark1: ~A" (mark-sample m1)))
- (if (or (not (mark? m2))
- (not (= (mark-sample m2) 200)))
- (snd-display #__line__ ";save-sound mark2: ~A" (mark-sample m2)))
- (if (mark? m3) (snd-display #__line__ ";save-sound mark3: ~A" m3)))))
- (close-sound ind0)
-
- (let ((fd (open-sound "oboe.snd"))
- (m1 (add-mark 123))
- (sync-val (+ 1 (mark-sync-max))))
- (if (not (mark? m1)) (snd-display #__line__ ";mark?"))
- (if (not (= (mark-sample m1) 123)) (snd-display #__line__ ";add-mark: ~A? " (mark-sample m1)))
- (set! (mark-property :hiho m1) 123)
- (if (not (= (mark-property :hiho m1) 123)) (snd-display #__line__ ";mark-property: ~A" (mark-property :hiho m1)))
- (if (mark-property :not-there m1) (snd-display #__line__ ";mark-not-property: ~A" (mark-property :not-there m1)))
- (if (not (eq? (without-errors (mark-sample (integer->mark 12345678))) 'no-such-mark))
- (snd-display #__line__ ";mark-sample err: ~A?" (without-errors (mark-sample 12345678))))
- (if (not (eq? (without-errors (add-mark 123 123)) 'no-such-sound))
- (snd-display #__line__ ";add-mark err: ~A?" (without-errors (add-mark 123 123))))
- (let ((m2 (without-errors (add-mark 12345 fd 0))))
- (if (eq? m2 'no-such-mark) (snd-display #__line__ ";add-mark failed?"))
- (if (not (= (mark-sample m2) 12345)) (snd-display #__line__ ";add-mark 0 0: ~A?" (mark-sample m2)))
- (if (not (= (mark-sync m2) 0)) (snd-display #__line__ ";init mark-sync: ~A?" (mark-sync m2)))
- (set! (mark-sync m2) sync-val)
- (if (not (= (mark-sync m2) sync-val)) (snd-display #__line__ ";set-mark-sync (~A): ~A?" sync-val (mark-sync m2)))
- (let* ((syncs (syncd-marks sync-val))
- (chans (marks fd 0))
- (samps (map mark-sample chans)))
- (if (not (equal? syncs (list m2))) (snd-display #__line__ ";syncd-marks: ~A?" syncs))
- (if (not (equal? chans (list m1 m2))) (snd-display #__line__ ";marks: ~A?" chans))
- (if (not (equal? samps (list (mark-sample m1) (mark-sample m2)))) (snd-display #__line__ ";map samps: ~A?" samps))
- (delete-samples 200 100 fd 0)
- (set! chans (marks fd))
- (set! samps (map mark-sample (car chans)))
- (if (not (equal? samps (list (mark-sample m1 0) (- (mark-sample m2 0) 100)))) (snd-display #__line__ ";map samps: ~A?" samps))
- (let ((descr (describe-mark m2)))
- (if (not (list? descr))
- (snd-display #__line__ ";describe-mark: ~A?" descr)))
- (set! (mark-sync m1) (mark-sync m2))
- (move-syncd-marks sync-val 100)
- (set! chans (marks fd))
- (set! samps (map mark-sample (car chans)))
- (if (not (equal? samps (list (+ (mark-sample m1 0) 100) (mark-sample m2 0)))) (snd-display #__line__ ";syncd move samps: ~A?" samps))
- (set! (cursor) 500)
- (set! (mark-sync m1) #t)
- (if (not (= (mark-sync m1) 1)) (snd-display #__line__ ";mark-sync via bool: ~A" (mark-sync m1)))
- (delete-mark m1)
- (set! chans (marks fd 0))
- (if (not (equal? chans (list m2))) (snd-display #__line__ ";delete-mark? ~A" chans))
- (undo)
- (set! chans (marks fd 0))
- (if (not (equal? chans (list m1 m2))) (snd-display #__line__ ";delete-mark then undo? ~A" chans))
- (redo)
- (if (not (string=? (mark-name m2) "")) (snd-display #__line__ ";init mark-name: ~A?" (mark-name m2)))
- (set! (mark-name m2) "hiho!")
- (if (not (string=? (mark-name m2) "hiho!")) (snd-display #__line__ ";set-mark-name: ~A?" (mark-name m2)))
- (undo)
- (if (not (string=? (mark-name m2) "")) (snd-display #__line__ ";undo mark-name: ~A?" (mark-name m2)))
- (redo)
- (if (not (string=? (mark-name m2) "hiho!")) (snd-display #__line__ ";redo mark-name: ~A?" (mark-name m2)))
- (let ((m3 (find-mark "hiho!"))
- (m4 (find-mark (mark-sample m2)))
- (m5 (find-mark "not-a-mark"))
- (m6 (find-mark 123456787))
- (m7 (mark-name->id "hiho!")))
- (if (or (not (equal? m2 m3)) (not (equal? m4 m7)) (not (equal? m2 m4))) (snd-display #__line__ ";find-mark: ~A ~A ~A ~A?" m2 m3 m4 m7))
- (if (or (not (equal? m5 m6)) (not (equal? m5 #f))) (snd-display #__line__ ";find-not-a-mark: ~A ~A?" m5 m6))
- (set! (mark-sample m2) 2000)
- (set! m1 (add-mark 1000))
- (set! m3 (add-mark 3000))
- (set! m4 (add-mark 4000))
- (insert-samples 2500 500 (make-vct 500) fd 0)
- (set! samps (map mark-sample (marks fd 0)))
- (if (not (equal? samps '(1000 2000 3500 4500))) (snd-display #__line__ ";insert ripple: ~A?" samps))
- (set! (mark-sample m3) 300)
- (set! (cursor) 500)
- (let ((sd (open-sound "4.aiff")))
- (set! m3 (add-mark 1000 sd 2))
- (set! m4 (add-mark 1000 sd 3))
- (if (not (equal? (mark-home m3) (list sd 2))) (snd-display #__line__ ";marks->sound 4: ~A?" (mark-home m3)))
- (close-sound sd))
- (let ((file (save-marks fd)))
- (if (or (not file)
- (not (string=? file (string-append cwd "oboe.marks"))))
- (snd-display #__line__ ";save-marks -> ~A?" file)))
- (let ((file (save-marks fd "hiho.marks")))
- (if (or (not file)
- (not (string=? file "hiho.marks")))
- (snd-display #__line__ ";save-marks with arg -> ~A?" file))
- (let ((val (system (format #f "diff hiho.marks ~A" (string-append cwd "oboe.marks")))))
- (if (not (= val 0))
- (snd-display #__line__ ";save marks differs"))))
- (close-sound fd)
- (let ((s1 (open-sound "oboe.snd"))
- (s2 (open-sound "oboe.snd")))
- (add-mark 123 s1 0)
- (add-mark 321 s2 0)
- (set! (with-verbose-cursor) #t)
- (if (file-exists? "s61.scm") (delete-file "s61.scm"))
- (save-state "s61.scm")
- (set! (with-verbose-cursor) #f)
- (close-sound s1)
- (close-sound s2))
- (load (string-append cwd "s61.scm"))
- (if (not (with-verbose-cursor)) (snd-display #__line__ ";save-state with-verbose-cursor?"))
- (let ((s1 (find-sound "oboe.snd" 0))
- (s2 (find-sound "oboe.snd" 1)))
- (if (or (not (sound? s1)) (not (sound? s2)))
- (snd-display #__line__ ";can't re-open sounds? ~A ~A" s1 s2)
- (let ((m1 (marks s1))
- (m2 (marks s2)))
- (if (or (not (= (length m1) 1))
- (not (= (length m2) 1))
- (not (= (length (car m1)) 1))
- (not (= (length (car m2)) 1)))
- (snd-display #__line__ ";save-marks via save-state to: ~A ~A" m1 m2)
- (let ((samp1 (mark-sample (caar m1)))
- (samp2 (mark-sample (caar m2))))
- (if (or (not (= samp1 123))
- (not (= samp2 321)))
- (snd-display #__line__ ";save-marks via save-state positions: ~A ~A" samp1 samp2))))))
- (if (sound? s1) (close-sound s1))
- (if (sound? s2) (close-sound s2)))
- (let ((fd (open-sound "pistol.snd")))
- (let ((file (save-marks)))
- (if file
- (snd-display #__line__ ";save-marks no marks -> ~A?" file)))
- (close-sound fd))
- (let ((fd (open-sound "oboe.snd")))
- (load (string-append cwd "oboe.marks"))
- (let ((mlst (marks fd 0)))
- (if (not (= (length mlst) 4))
- (snd-display #__line__ ";restore oboe.marks: ~A, marks: ~A" (file->string "oboe.marks") (marks fd 0))))
- (close-sound fd))
- (let ((fd (open-sound "oboe.snd")))
- (let ((m1 (add-mark 1000)))
- (let ((m2 (add-mark 2500)))
- (let ((m3 (add-mark (- (frames) 4000))))
- (let ((ms (marks fd 0)))
- (src-sound -.5)
- (if (not (equal? (marks fd 0) (reverse (marks fd 0 0))))
- (snd-display #__line__ ";src rev marks: ~A ~A" (marks fd 0) (reverse (marks fd 0 0))))
- (let ((ms1 (map mark-sample (marks fd 0))))
- (if (not (equal? ms1 (list 7998 96654 99654))) ; off-by-1 somewhere...
- (snd-display #__line__ ";src rev mark locs: ~A" ms1)))))))
- (close-sound fd))
- (let ((fd (open-sound "4.aiff")))
- (let ((m1 (add-mark 1000 fd 0))
- (m2 (add-mark 2000 fd 1))
- (m3 (add-mark 3000 fd 2))
- (m4 (add-mark 4000 fd 3)))
- (if (= (length (marks)) 0) (snd-display #__line__ ";marks (no args): ~A" (marks)))
- (save-marks fd)
- (close-sound fd)
- (set! fd (open-sound "4.aiff"))
- (load (string-append cwd "4.marks"))
- (delete-file "4.marks")
- (do ((i 0 (+ 1 i)))
- ((= i 4))
- (let ((mlst (marks fd i)))
- (if (not (= (length mlst) 1))
- (snd-display #__line__ ";save-marks[~A]: ~A?" i mlst))
- (if (not (= (mark-sample (car mlst)) (* (+ i 1) 1000)))
- (snd-display #__line__ ";save-marks[~A] at ~A?" i (mark-sample (car mlst))))))
- (close-sound fd)))
-
- ))))
-
- (let ((fd (open-sound "oboe.snd"))
- (m1 (add-mark 1234)))
- (set! (mark-name m1) "1234")
- (set! (mark-sync m1) 1234)
- (let ((m2 (copy m1)))
- (if (not (mark? m2))
- (snd-display #__line__ "; copy mark: ~A?" m2)
- (begin
- (if (not (= (mark-sample m1) (mark-sample m2) 1234))
- (snd-display #__line__ ";copy mark sample: ~A ~A" (mark-sample m1) (mark-sample m2)))
- (if (not (= (mark-sync m1) (mark-sync m2) 1234))
- (snd-display #__line__ ";copy mark sync: ~A ~A" (mark-sync m1) (mark-sync m2)))
- (if (not (string=? (mark-name m2) "1234"))
- (snd-display #__line__ ";copy mark name: ~A?" (mark-name m2))))))
- (close-sound fd))
-
- (let* ((ind (open-sound "pistol.snd"))
- (samp1 1834)
- (samp2 8345)
- (m1 (add-mark samp1 ind 0))
- (m2 (add-mark samp2)))
- (set! (mark-sync m1) 123)
- (set! (mark-sync m2) 100)
- (if (not (= (mark-sync-max) 1234)) (snd-display #__line__ ";mark-sync-max: ~A" (mark-sync-max)))
- (src-sound -1)
- (if (not (= (mark-sample m1) 39788))
- (snd-display #__line__ ";src -1 m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) 33277))
- (snd-display #__line__ ";src -1 m2 -> ~A" (mark-sample m2)))
- (undo)
- (src-sound .5)
- (if (not (= (mark-sample m1) (* 2 samp1)))
- (snd-display #__line__ ";src .5 m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) (* 2 samp2)))
- (snd-display #__line__ ";src .5 m2 -> ~A" (mark-sample m2)))
- (undo)
- (delete-samples 1000 100)
- (if (not (= (mark-sample m1) (- samp1 100)))
- (snd-display #__line__ ";delete 100 m1 -> ~A" (mark-sample m1)))
- (insert-silence 1000 100)
- (if (not (= (mark-sample m1) samp1))
- (snd-display #__line__ ";insert 100 m1 -> ~A" (mark-sample m1)))
- (revert-sound ind)
- (delete-samples 2000 100)
- (if (not (= (mark-sample m1) samp1))
- (snd-display #__line__ ";delete(2) 100 m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) (- samp2 100)))
- (snd-display #__line__ ";delete(2) 100 m2 -> ~A" (mark-sample m2)))
- (insert-silence 2000 100)
- (if (not (= (mark-sample m1) samp1))
- (snd-display #__line__ ";insert(2) 100 m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) samp2))
- (snd-display #__line__ ";insert(2) 100 m2 -> ~A" (mark-sample m2)))
- (revert-sound ind)
- (delete-samples 10000 100)
- (if (not (= (mark-sample m1) samp1))
- (snd-display #__line__ ";delete(3) 100 m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) samp2))
- (snd-display #__line__ ";delete(3) 100 m2 -> ~A" (mark-sample m2)))
- (insert-silence 10000 100)
- (if (not (= (mark-sample m1) samp1))
- (snd-display #__line__ ";insert(3) 100 m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) samp2))
- (snd-display #__line__ ";insert(3) 100 m2 -> ~A" (mark-sample m2)))
- (src-sound '(0 .5 1 .5 2 1))
- (if (not (= (mark-sample m1) (* 2 samp1)))
- (snd-display #__line__ ";src env .5 m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) (* 2 samp2)))
- (snd-display #__line__ ";src env .5 m2 -> ~A" (mark-sample m2)))
- (undo)
- (reverse-sound)
- (if (not (= (mark-sample m1) 39788))
- (snd-display #__line__ ";reverse-sound m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) 33277))
- (snd-display #__line__ ";reverse-sound m2 -> ~A" (mark-sample m2)))
- (undo)
- (src-sound '(0 -.5 1 -.5 2 -1))
- (if (not (= (mark-sample m1) 68598))
- (snd-display #__line__ ";src -env m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) 61160))
- (snd-display #__line__ ";src -env m2 -> ~A" (mark-sample m2)))
- (revert-sound ind)
- (src-channel (make-env '(0 .5 1 1) :length 8001) 2000 10000)
- (if (not (= (mark-sample m1) samp1))
- (snd-display #__line__ ";src-channel(1) m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) 11345))
- (snd-display #__line__ ";src-channel(1) m2 -> ~A" (mark-sample m2)))
- (undo)
- (src-channel (make-env '(0 .5 1 1) :length 8001) 0 8000)
- (if (not (= (mark-sample m1) 3303))
- (snd-display #__line__ ";src-channel(2) m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) samp2))
- (snd-display #__line__ ";src-channel(2) m2 -> ~A" (mark-sample m2)))
- (undo)
- (src-channel (make-env '(0 .5 1 1) :length 8001) 10000 8000)
- (if (not (= (mark-sample m1) samp1))
- (snd-display #__line__ ";src-channel(3) m1 -> ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) samp2))
- (snd-display #__line__ ";src-channel(3) m2 -> ~A" (mark-sample m2)))
- (close-sound ind)
- (set! ind (open-sound "2.snd"))
- (set! (sync ind) #t)
- (let ((m3 (add-mark 1000 ind 0))
- (m4 (add-mark 8000 ind 1)))
- (swap-channels)
- (if (or (not (equal? (mark-home m3) (list ind 1)))
- (not (equal? (mark-home m4) (list ind 0))))
- (snd-display #__line__ ";swapped mark homes: ~A ~A?" (mark-home m3) (mark-home m4)))
- (if (or (not (= (mark-sample m3) 1000))
- (not (= (mark-sample m4) 8000)))
- (snd-display #__line__ ";swapped mark samples: ~A ~A?" (mark-sample m3) (mark-sample m4)))
- (close-sound ind))
- (set! ind (open-sound "2.snd"))
- (set! (sync ind) #t)
- (let ((m3 (add-mark 1000 ind 0)))
- (delete-samples 1000 10 ind 1)
- (swap-channels)
- (if (not (equal? (mark-home m3) (list ind 1)))
- (snd-display #__line__ ";edited swapped mark home: ~A?" (mark-home m3)))
- (if (not (= (mark-sample m3) 1000))
- (snd-display #__line__ ";edited swapped mark sample: ~A" (mark-sample m3)))
- (delete-marks))
+ (let ((m3 (add-mark 300)))
+ (undo)
+ (save-sound)
+ (if (not (= (length (marks ind0 0)) 2))
+ (snd-display #__line__ ";marks after save: ~A" (marks ind0 0)))
+ (if (or (not (mark? m1))
+ (not (= (mark-sample m1) 99)))
+ (snd-display #__line__ ";save-sound mark1: ~A" (mark-sample m1)))
+ (if (or (not (mark? m2))
+ (not (= (mark-sample m2) 200)))
+ (snd-display #__line__ ";save-sound mark2: ~A" (mark-sample m2)))
+ (if (mark? m3) (snd-display #__line__ ";save-sound mark3: ~A" m3)))))
+ (close-sound ind0)
+
+ (let ((fd (open-sound "oboe.snd"))
+ (m1 (add-mark 123))
+ (sync-val (+ 1 (mark-sync-max))))
+ (if (not (mark? m1)) (snd-display #__line__ ";mark?"))
+ (if (not (= (mark-sample m1) 123)) (snd-display #__line__ ";add-mark: ~A? " (mark-sample m1)))
+ (set! (mark-property :hiho m1) 123)
+ (if (not (= (mark-property :hiho m1) 123)) (snd-display #__line__ ";mark-property: ~A" (mark-property :hiho m1)))
+ (if (mark-property :not-there m1) (snd-display #__line__ ";mark-not-property: ~A" (mark-property :not-there m1)))
+ (if (not (eq? (without-errors (mark-sample (integer->mark 12345678))) 'no-such-mark))
+ (snd-display #__line__ ";mark-sample err: ~A?" (without-errors (mark-sample 12345678))))
+ (if (not (eq? (without-errors (add-mark 123 123)) 'no-such-sound))
+ (snd-display #__line__ ";add-mark err: ~A?" (without-errors (add-mark 123 123))))
+ (let ((m2 (without-errors (add-mark 12345 fd 0))))
+ (if (eq? m2 'no-such-mark) (snd-display #__line__ ";add-mark failed?"))
+ (if (not (= (mark-sample m2) 12345)) (snd-display #__line__ ";add-mark 0 0: ~A?" (mark-sample m2)))
+ (if (not (= (mark-sync m2) 0)) (snd-display #__line__ ";init mark-sync: ~A?" (mark-sync m2)))
+ (set! (mark-sync m2) sync-val)
+ (if (not (= (mark-sync m2) sync-val)) (snd-display #__line__ ";set-mark-sync (~A): ~A?" sync-val (mark-sync m2)))
+ (let* ((syncs (syncd-marks sync-val))
+ (chans (marks fd 0))
+ (samps (map mark-sample chans)))
+ (if (not (equal? syncs (list m2))) (snd-display #__line__ ";syncd-marks: ~A?" syncs))
+ (if (not (equal? chans (list m1 m2))) (snd-display #__line__ ";marks: ~A?" chans))
+ (if (not (equal? samps (list (mark-sample m1) (mark-sample m2)))) (snd-display #__line__ ";map samps: ~A?" samps))
+ (delete-samples 200 100 fd 0)
+ (set! chans (marks fd))
+ (set! samps (map mark-sample (car chans)))
+ (if (not (equal? samps (list (mark-sample m1 0) (- (mark-sample m2 0) 100)))) (snd-display #__line__ ";map samps: ~A?" samps))
+ (let ((descr (describe-mark m2)))
+ (if (not (list? descr))
+ (snd-display #__line__ ";describe-mark: ~A?" descr)))
+ (set! (mark-sync m1) (mark-sync m2))
+ (move-syncd-marks sync-val 100)
+ (set! chans (marks fd))
+ (set! samps (map mark-sample (car chans)))
+ (if (not (equal? samps (list (+ (mark-sample m1 0) 100) (mark-sample m2 0)))) (snd-display #__line__ ";syncd move samps: ~A?" samps))
+ (set! (cursor) 500)
+ (set! (mark-sync m1) #t)
+ (if (not (= (mark-sync m1) 1)) (snd-display #__line__ ";mark-sync via bool: ~A" (mark-sync m1)))
+ (delete-mark m1)
+ (set! chans (marks fd 0))
+ (if (not (equal? chans (list m2))) (snd-display #__line__ ";delete-mark? ~A" chans))
+ (undo)
+ (set! chans (marks fd 0))
+ (if (not (equal? chans (list m1 m2))) (snd-display #__line__ ";delete-mark then undo? ~A" chans))
+ (redo)
+ (if (not (string=? (mark-name m2) "")) (snd-display #__line__ ";init mark-name: ~A?" (mark-name m2)))
+ (set! (mark-name m2) "hiho!")
+ (if (not (string=? (mark-name m2) "hiho!")) (snd-display #__line__ ";set-mark-name: ~A?" (mark-name m2)))
+ (undo)
+ (if (not (string=? (mark-name m2) "")) (snd-display #__line__ ";undo mark-name: ~A?" (mark-name m2)))
+ (redo)
+ (if (not (string=? (mark-name m2) "hiho!")) (snd-display #__line__ ";redo mark-name: ~A?" (mark-name m2)))
+ (let ((m3 (find-mark "hiho!"))
+ (m4 (find-mark (mark-sample m2)))
+ (m5 (find-mark "not-a-mark"))
+ (m6 (find-mark 123456787))
+ (m7 (mark-name->id "hiho!")))
+ (if (or (not (equal? m2 m3)) (not (equal? m4 m7)) (not (equal? m2 m4))) (snd-display #__line__ ";find-mark: ~A ~A ~A ~A?" m2 m3 m4 m7))
+ (if (or (not (equal? m5 m6)) m5) (snd-display #__line__ ";find-not-a-mark: ~A ~A?" m5 m6))
+ (set! (mark-sample m2) 2000)
+ (set! m1 (add-mark 1000))
+ (set! m3 (add-mark 3000))
+ (set! m4 (add-mark 4000))
+ (insert-samples 2500 500 (make-float-vector 500) fd 0)
+ (set! samps (map mark-sample (marks fd 0)))
+ (if (not (equal? samps '(1000 2000 3500 4500))) (snd-display #__line__ ";insert ripple: ~A?" samps))
+ (set! (mark-sample m3) 300)
+ (set! (cursor) 500)
+ (let ((sd (open-sound "4.aiff")))
+ (set! m3 (add-mark 1000 sd 2))
+ (set! m4 (add-mark 1000 sd 3))
+ (if (not (equal? (mark-home m3) (list sd 2))) (snd-display #__line__ ";marks->sound 4: ~A?" (mark-home m3)))
+ (close-sound sd))
+ (let ((file (save-marks fd)))
+ (if (or (not file)
+ (not (string=? file (string-append cwd "oboe.marks"))))
+ (snd-display #__line__ ";save-marks -> ~A?" file)))
+ (let ((file (save-marks fd "hiho.marks")))
+ (if (or (not file)
+ (not (string=? file "hiho.marks")))
+ (snd-display #__line__ ";save-marks with arg -> ~A?" file))
+ (let ((val (system (format #f "diff hiho.marks ~A" (string-append cwd "oboe.marks")))))
+ (if (not (= val 0))
+ (snd-display #__line__ ";save marks differs"))))
+ (close-sound fd)
+ (let ((s1 (open-sound "oboe.snd"))
+ (s2 (open-sound "oboe.snd")))
+ (add-mark 123 s1 0)
+ (add-mark 321 s2 0)
+ (set! *with-verbose-cursor* #t)
+ (if (file-exists? "s61.scm") (delete-file "s61.scm"))
+ (save-state "s61.scm")
+ (set! *with-verbose-cursor* #f)
+ (close-sound s1)
+ (close-sound s2))
+ (load (string-append cwd "s61.scm"))
+ (if (not *with-verbose-cursor*) (snd-display #__line__ ";save-state with-verbose-cursor?"))
+ (let ((s1 (find-sound "oboe.snd" 0))
+ (s2 (find-sound "oboe.snd" 1)))
+ (if (or (not (sound? s1)) (not (sound? s2)))
+ (snd-display #__line__ ";can't re-open sounds? ~A ~A" s1 s2)
+ (let ((m1 (marks s1))
+ (m2 (marks s2)))
+ (if (or (not (= (length m1) 1))
+ (not (= (length m2) 1))
+ (not (= (length (car m1)) 1))
+ (not (= (length (car m2)) 1)))
+ (snd-display #__line__ ";save-marks via save-state to: ~A ~A" m1 m2)
+ (let ((samp1 (mark-sample (caar m1)))
+ (samp2 (mark-sample (caar m2))))
+ (if (or (not (= samp1 123))
+ (not (= samp2 321)))
+ (snd-display #__line__ ";save-marks via save-state positions: ~A ~A" samp1 samp2))))))
+ (if (sound? s1) (close-sound s1))
+ (if (sound? s2) (close-sound s2)))
+ (let ((fd (open-sound "pistol.snd")))
+ (let ((file (save-marks)))
+ (if file
+ (snd-display #__line__ ";save-marks no marks -> ~A?" file)))
+ (close-sound fd))
+ (let ((fd (open-sound "oboe.snd")))
+ (load (string-append cwd "oboe.marks"))
+ (let ((mlst (marks fd 0)))
+ (if (not (= (length mlst) 4))
+ (snd-display #__line__ ";restore oboe.marks: ~A, marks: ~A" (file->string "oboe.marks") (marks fd 0))))
+ (close-sound fd))
+ (let ((fd (open-sound "oboe.snd")))
+ (add-mark 1000)
+ (add-mark 2500)
+ (add-mark (- (framples) 4000))
+ (let ((ms (marks fd 0)))
+ (src-sound -.5)
+ (if (not (equal? (marks fd 0) (reverse (marks fd 0 0))))
+ (snd-display #__line__ ";src rev marks: ~A ~A ~A" ms (marks fd 0) (reverse (marks fd 0 0))))
+ (let ((ms1 (map mark-sample (marks fd 0))))
+ (if (not (equal? ms1 (list 7998 96654 99654))) ; off-by-1 somewhere...
+ (snd-display #__line__ ";src rev mark locs: ~A" ms1))))
+ (close-sound fd))
+ (let ((fd (open-sound "4.aiff")))
+ (add-mark 1000 fd 0)
+ (add-mark 2000 fd 1)
+ (add-mark 3000 fd 2)
+ (add-mark 4000 fd 3)
+ (if (= (length (marks)) 0) (snd-display #__line__ ";marks (no args): ~A" (marks)))
+ (save-marks fd)
+ (close-sound fd)
+ (set! fd (open-sound "4.aiff"))
+ (load (string-append cwd "4.marks"))
+ (delete-file "4.marks")
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (let ((mlst (marks fd i)))
+ (if (not (= (length mlst) 1))
+ (snd-display #__line__ ";save-marks[~A]: ~A?" i mlst))
+ (if (not (= (mark-sample (car mlst)) (* (+ i 1) 1000)))
+ (snd-display #__line__ ";save-marks[~A] at ~A?" i (mark-sample (car mlst))))))
+ (close-sound fd))
+
+ ))))
+
+ (let ((fd (open-sound "oboe.snd"))
+ (m1 (add-mark 1234)))
+ (set! (mark-name m1) "1234")
+ (set! (mark-sync m1) 1234)
+ (let ((m2 (copy m1)))
+ (if (not (mark? m2))
+ (snd-display #__line__ "; copy mark: ~A?" m2)
+ (begin
+ (if (not (= (mark-sample m1) (mark-sample m2) 1234))
+ (snd-display #__line__ ";copy mark sample: ~A ~A" (mark-sample m1) (mark-sample m2)))
+ (if (not (= (mark-sync m1) (mark-sync m2) 1234))
+ (snd-display #__line__ ";copy mark sync: ~A ~A" (mark-sync m1) (mark-sync m2)))
+ (if (not (string=? (mark-name m2) "1234"))
+ (snd-display #__line__ ";copy mark name: ~A?" (mark-name m2))))))
+ (close-sound fd))
+
+ (let* ((ind (open-sound "pistol.snd"))
+ (samp1 1834)
+ (samp2 8345)
+ (m1 (add-mark samp1 ind 0))
+ (m2 (add-mark samp2)))
+ (set! (mark-sync m1) 123)
+ (set! (mark-sync m2) 100)
+ (if (not (= (mark-sync-max) 1234)) (snd-display #__line__ ";mark-sync-max: ~A" (mark-sync-max)))
+ (src-sound -1)
+ (if (not (= (mark-sample m1) 39788))
+ (snd-display #__line__ ";src -1 m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 33277))
+ (snd-display #__line__ ";src -1 m2 -> ~A" (mark-sample m2)))
+ (undo)
+ (src-sound .5)
+ (if (not (= (mark-sample m1) (* 2 samp1)))
+ (snd-display #__line__ ";src .5 m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) (* 2 samp2)))
+ (snd-display #__line__ ";src .5 m2 -> ~A" (mark-sample m2)))
+ (undo)
+ (delete-samples 1000 100)
+ (if (not (= (mark-sample m1) (- samp1 100)))
+ (snd-display #__line__ ";delete 100 m1 -> ~A" (mark-sample m1)))
+ (insert-silence 1000 100)
+ (if (not (= (mark-sample m1) samp1))
+ (snd-display #__line__ ";insert 100 m1 -> ~A" (mark-sample m1)))
+ (revert-sound ind)
+ (delete-samples 2000 100)
+ (if (not (= (mark-sample m1) samp1))
+ (snd-display #__line__ ";delete(2) 100 m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) (- samp2 100)))
+ (snd-display #__line__ ";delete(2) 100 m2 -> ~A" (mark-sample m2)))
+ (insert-silence 2000 100)
+ (if (not (= (mark-sample m1) samp1))
+ (snd-display #__line__ ";insert(2) 100 m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) samp2))
+ (snd-display #__line__ ";insert(2) 100 m2 -> ~A" (mark-sample m2)))
+ (revert-sound ind)
+ (delete-samples 10000 100)
+ (if (not (= (mark-sample m1) samp1))
+ (snd-display #__line__ ";delete(3) 100 m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) samp2))
+ (snd-display #__line__ ";delete(3) 100 m2 -> ~A" (mark-sample m2)))
+ (insert-silence 10000 100)
+ (if (not (= (mark-sample m1) samp1))
+ (snd-display #__line__ ";insert(3) 100 m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) samp2))
+ (snd-display #__line__ ";insert(3) 100 m2 -> ~A" (mark-sample m2)))
+ (src-sound '(0 .5 1 .5 2 1))
+ (if (not (= (mark-sample m1) (* 2 samp1)))
+ (snd-display #__line__ ";src env .5 m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) (* 2 samp2)))
+ (snd-display #__line__ ";src env .5 m2 -> ~A" (mark-sample m2)))
+ (undo)
+ (reverse-sound)
+ (if (not (= (mark-sample m1) 39788))
+ (snd-display #__line__ ";reverse-sound m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 33277))
+ (snd-display #__line__ ";reverse-sound m2 -> ~A" (mark-sample m2)))
+ (undo)
+ (src-sound '(0 -.5 1 -.5 2 -1))
+ (if (not (= (mark-sample m1) 68598))
+ (snd-display #__line__ ";src -env m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 61160))
+ (snd-display #__line__ ";src -env m2 -> ~A" (mark-sample m2)))
+ (revert-sound ind)
+ (src-channel (make-env '(0 .5 1 1) :length 8001) 2000 10000)
+ (if (not (= (mark-sample m1) samp1))
+ (snd-display #__line__ ";src-channel(1) m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 11345))
+ (snd-display #__line__ ";src-channel(1) m2 -> ~A" (mark-sample m2)))
+ (undo)
+ (src-channel (make-env '(0 .5 1 1) :length 8001) 0 8000)
+ (if (not (= (mark-sample m1) 3303))
+ (snd-display #__line__ ";src-channel(2) m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) samp2))
+ (snd-display #__line__ ";src-channel(2) m2 -> ~A" (mark-sample m2)))
+ (undo)
+ (src-channel (make-env '(0 .5 1 1) :length 8001) 10000 8000)
+ (if (not (= (mark-sample m1) samp1))
+ (snd-display #__line__ ";src-channel(3) m1 -> ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) samp2))
+ (snd-display #__line__ ";src-channel(3) m2 -> ~A" (mark-sample m2)))
+ (close-sound ind)
+ (set! ind (open-sound "2.snd"))
+ (set! (sync ind) #t)
+ (let ((m3 (add-mark 1000 ind 0))
+ (m4 (add-mark 8000 ind 1)))
+ (swap-channels)
+ (if (or (not (equal? (mark-home m3) (list ind 1)))
+ (not (equal? (mark-home m4) (list ind 0))))
+ (snd-display #__line__ ";swapped mark homes: ~A ~A?" (mark-home m3) (mark-home m4)))
+ (if (or (not (= (mark-sample m3) 1000))
+ (not (= (mark-sample m4) 8000)))
+ (snd-display #__line__ ";swapped mark samples: ~A ~A?" (mark-sample m3) (mark-sample m4)))
(close-sound ind))
+ (set! ind (open-sound "2.snd"))
+ (set! (sync ind) #t)
+ (let ((m3 (add-mark 1000 ind 0)))
+ (delete-samples 1000 10 ind 1)
+ (swap-channels)
+ (if (not (equal? (mark-home m3) (list ind 1)))
+ (snd-display #__line__ ";edited swapped mark home: ~A?" (mark-home m3)))
+ (if (not (= (mark-sample m3) 1000))
+ (snd-display #__line__ ";edited swapped mark sample: ~A" (mark-sample m3)))
+ (delete-marks))
+ (close-sound ind))
+
+ (let* ((ind (open-sound "oboe.snd"))
+ (m1 (add-mark 123 ind 0))
+ (m2 (add-mark 234 ind 0))
+ (sel #f))
+ (define-selection-via-marks m1 m2)
+ (set! sel (selection))
+ (if (or (not (selection?))
+ (not (selection? sel)))
+ (snd-display #__line__ ";define-selection-via-marks failed?")
+ (let ((mc (selection-members)))
+ (if (not (equal? mc (list (list ind 0)))) (snd-display #__line__ ";selection-members after mark definition: ~A (should be '((~A 0)))" mc ind))
+ (if (not (= (selection-position) 123)) (snd-display #__line__ ";selection-position 123: ~A" (selection-position)))
+ (if (not (= (selection-framples) 112)) (snd-display #__line__ ";selection-framples 112: ~A" (selection-framples)))))
+ (set! m1 (add-mark 1000 ind 0))
+ (set! m2 (add-mark 2000 ind 0))
+ (define-selection-via-marks m1 m2)
+ (if (not (selection?))
+ (snd-display #__line__ ";define-selection-via-marks repeat failed?")
+ (let ((mc (selection-members)))
+ (if (not (equal? mc (list (list ind 0)))) (snd-display #__line__ ";selection-members after second mark definition: ~A (should be '((~A 0)))" mc ind))
+ (if (not (= (selection-position) 1000)) (snd-display #__line__ ";selection-position 1000: ~A" (selection-position)))
+ (if (not (= (selection-framples) 1001)) (snd-display #__line__ ";selection-framples 1001: ~A" (selection-framples)))))
+ (set! (selection-member? #t) #f)
+ (if (selection?) (snd-display #__line__ ";can't clear selection via selection-member?"))
+ (if (selection) (snd-display #__line__ ";(inactive) selection returns: ~A" (selection)))
+ (set! (selection-member? ind 0) #t)
+ (set! (selection-position ind 0) 2000)
+ (set! (selection-framples ind 0) 1234)
+ (snap-marks)
+ (set! m1 (find-mark 2000 ind 0))
+ (if (not (mark? m1)) (snd-display #__line__ ";snap-marks start: ~A" (map mark-sample (marks ind 0))))
+ (set! m2 (find-mark (+ 2000 1234)))
+ (if (not (mark? m2)) (snd-display #__line__ ";snap-marks end: ~A" (map mark-sample (marks ind 0))))
+ (set! (selection-position ind 0) (+ (framples ind 0) 1123))
+ (if (not (= (selection-position ind 0) (- (framples ind) 1)))
+ (snd-display #__line__ ";selection position past eof: ~A ~A" (selection-position ind 0) (- (framples ind) 1)))
+ (revert-sound ind)
+ (src-sound '(0 .5 1 1.75665))
+ ;; trying to hit previous dur on the nose "by accident..."
- (let* ((ind (open-sound "oboe.snd"))
- (m1 (add-mark 123 ind 0))
- (m2 (add-mark 234 ind 0))
- (sel #f))
- (define-selection-via-marks m1 m2)
- (set! sel (selection))
- (if (or (not (selection?))
- (not (selection? sel)))
- (snd-display #__line__ ";define-selection-via-marks failed?")
- (let ((mc (selection-members)))
- (if (not (equal? mc (list (list ind 0)))) (snd-display #__line__ ";selection-members after mark definition: ~A (should be '((~A 0)))" mc ind))
- (if (not (= (selection-position) 123)) (snd-display #__line__ ";selection-position 123: ~A" (selection-position)))
- (if (not (= (selection-frames) 112)) (snd-display #__line__ ";selection-frames 112: ~A" (selection-frames)))))
- (set! m1 (add-mark 1000 ind 0))
- (set! m2 (add-mark 2000 ind 0))
- (define-selection-via-marks m1 m2)
- (if (not (selection?))
- (snd-display #__line__ ";define-selection-via-marks repeat failed?")
- (let ((mc (selection-members)))
- (if (not (equal? mc (list (list ind 0)))) (snd-display #__line__ ";selection-members after 2nd mark definition: ~A (should be '((~A 0)))" mc ind))
- (if (not (= (selection-position) 1000)) (snd-display #__line__ ";selection-position 1000: ~A" (selection-position)))
- (if (not (= (selection-frames) 1001)) (snd-display #__line__ ";selection-frames 1001: ~A" (selection-frames)))))
- (set! (selection-member? #t) #f)
- (if (selection?) (snd-display #__line__ ";can't clear selection via selection-member?"))
- (if (selection) (snd-display #__line__ ";(inactive) selection returns: ~A" (selection)))
- (if (selection? sel) (snd-display #__line__ ";(obsolete) selection returns: ~A" (selection? sel)))
- (set! (selection-member? ind 0) #t)
- (set! (selection-position ind 0) 2000)
- (set! (selection-frames ind 0) 1234)
- (snap-marks)
- (set! m1 (find-mark 2000 ind 0))
- (if (not (mark? m1)) (snd-display #__line__ ";snap-marks start: ~A" (map mark-sample (marks ind 0))))
- (set! m2 (find-mark (+ 2000 1234)))
- (if (not (mark? m2)) (snd-display #__line__ ";snap-marks end: ~A" (map mark-sample (marks ind 0))))
- (set! (selection-position ind 0) (+ (frames ind 0) 1123))
- (if (not (= (selection-position ind 0) (- (frames ind) 1)))
- (snd-display #__line__ ";selection position past eof: ~A ~A" (selection-position ind 0) (- (frames ind) 1)))
- (revert-sound ind)
- (src-sound '(0 .5 1 1.75665))
- ;; trying to hit previous dur on the nose "by accident..."
-
- ;; try to hit mark_size segfault
- (as-one-edit
- (lambda ()
- (add-mark 10)
- (mix "oboe.snd")
- (do ((i 0 (+ 1 i))) ((= i 20)) (scale-channel 1.2) (add-mark (* i 2)))))
- (scale-channel .5)
-
- (close-sound ind)
- )
-
- (let ((ind (open-sound "oboe.snd"))
- (mtests 100))
- (do ((i 0 (+ 1 i)))
- ((= i mtests))
- (let* ((current-marks (marks ind 0))
- (current-samples (map mark-sample current-marks)))
-
- (if (not (null? current-marks))
- (let ((id (list-ref current-marks (random (- (length current-marks) 1)))))
- (if (not (equal? id (find-mark (mark-sample id))))
- (snd-display #__line__ ";two marks at ~A? ~A" (mark-sample id) (map mark-sample current-marks)))
- (if (find-mark "not-a-name") (snd-display #__line__ ";find-bogus-mark: ~A" (find-mark "not-a-name")))))
-
- (case (random 15)
- ((0) (let* ((beg (random (frames)))
- (dur (max 1 (random 100)))
- ;; (end (+ beg dur))
- )
- (insert-silence beg dur)
- (if (not (null? current-marks))
- (for-each
- (lambda (id old-loc)
- (if (> old-loc beg)
- (begin
- (if (not (mark? id))
- (snd-display #__line__ ";insert clobbered mark: ~A" id)
- (if (not (= (mark-sample id) (+ old-loc dur)))
- (snd-display #__line__ ";insert, mark ~D ~D -> ~D (~D)" id old-loc (mark-sample id) dur))))))
- current-marks
- current-samples))))
- ((1) (if (> (car (edits ind 0)) 0) (undo)))
- ((2) (if (> (cadr (edits ind 0)) 0) (redo)))
- ((3) (if (> (maxamp ind 0) .1) (scale-channel .5) (scale-channel 2.0))
- (if (not (equal? (marks ind 0) current-marks))
- (snd-display #__line__ ";scaling changed marks: ~A ~A" (marks ind 0) current-marks))
- (if (not (equal? (map mark-sample (marks ind 0)) current-samples))
- (snd-display #__line__ ";scaling changed mark locations: ~A ~A" (map mark-sample (marks ind 0)) current-samples)))
- ((4) (set! (sample (random (- (frames) 1))) .5)
- (if (not (equal? (marks ind 0) current-marks))
- (snd-display #__line__ ";set-sample changed marks: ~A ~A" (marks ind 0) current-marks))
- (if (not (equal? (map mark-sample (marks ind 0)) current-samples))
- (snd-display #__line__ ";set-sample changed mark locations: ~A ~A" (map mark-sample (marks ind 0)) current-samples)))
- ((5) (let* ((beg (random (frames)))
- (dur (max 1 (random 100)))
- (end (+ beg dur)))
- (delete-samples beg dur)
- (if (not (null? current-marks))
- (for-each
- (lambda (id old-loc)
- (if (and (> old-loc beg)
- (< old-loc end)
- (mark? id))
- (snd-display #__line__ ";delete did not clobber mark: ~A ~A [~A ~A]" id old-loc beg end)
- (if (and (> old-loc end)
- (not (= (mark-sample id) (- old-loc dur))))
- (snd-display #__line__ ";delete ripple mark ~D ~D -> ~D (~D)" id old-loc (mark-sample id) dur)
- (if (and (< old-loc beg)
- (not (= (mark-sample id) old-loc)))
- (snd-display #__line__ ";delete but mark before: ~A ~A ~A ~A" id old-loc (mark-sample id) beg)))))
- current-marks
- current-samples))))
- ((6) (revert-sound))
- ((7) (if (and (not (null? current-marks))
- (> (length current-marks) 1))
- (let ((id (list-ref current-marks (random (- (length current-marks) 1)))))
- (delete-mark id)
- (if (mark? id)
- (snd-display #__line__ ";delete-mark failed? ~A" id))
- (if (not (= (length (marks ind 0)) (- (length current-marks) 1)))
- (snd-display #__line__ ";delete-mark list trouble: ~A ~A ~A" id current-marks (marks ind 0))))))
- ((8) (let ((rate (if (> (frames) 200000) 2.0 0.5)))
- (src-channel rate)
- (if (not (null? current-marks))
- (for-each
- (lambda (id old-loc)
- (if (not (mark? id))
- (snd-display #__line__ ";src-channel clobbered mark: ~A" id)
- (if (> (abs (- (/ old-loc rate) (mark-sample id))) 2)
- (snd-display #__line__ ";src moved mark: ~A ~A ~A (~A -> ~A)"
- id old-loc (mark-sample id) rate (- (/ old-loc rate) (mark-sample id))))))
- current-marks
- current-samples))))
- ((9) (reverse-channel)
- (if (not (null? current-marks))
+ ;; try to hit mark_size segfault
+ (as-one-edit
+ (lambda ()
+ (add-mark 10)
+ (mix "oboe.snd")
+ (do ((i 0 (+ i 1))) ((= i 20)) (scale-channel 1.2) (add-mark (* i 2)))))
+ (scale-channel .5)
+ (close-sound ind)
+ )
+
+ (let ((ind (open-sound "oboe.snd"))
+ (mtests 100))
+ (do ((i 0 (+ i 1)))
+ ((= i mtests))
+ (let* ((current-marks (marks ind 0))
+ (current-samples (map mark-sample current-marks)))
+
+ (if (pair? current-marks)
+ (let ((id (current-marks (random (- (length current-marks) 1)))))
+ (if (not (equal? id (find-mark (mark-sample id))))
+ (snd-display #__line__ ";~A: two marks at ~A? ~A" i (mark-sample id) (map mark-sample current-marks)))
+ (if (find-mark "not-a-name") (snd-display #__line__ ";find-bogus-mark: ~A" (find-mark "not-a-name")))))
+
+ (case (random 15)
+ ((0) (let ((beg (random (framples)))
+ (dur (max 1 (random 100))))
+ (insert-silence beg dur)
+ (for-each
+ (lambda (id old-loc)
+ (if (> old-loc beg)
+ (if (not (mark? id))
+ (snd-display #__line__ ";insert clobbered mark: ~A" id)
+ (if (not (= (mark-sample id) (+ old-loc dur)))
+ (snd-display #__line__ ";insert, mark ~D ~D -> ~D (~D)" id old-loc (mark-sample id) dur)))))
+ current-marks
+ current-samples)))
+ ((1) (if (> (car (edits ind 0)) 0) (undo)))
+ ((2) (if (> (cadr (edits ind 0)) 0) (redo)))
+ ((3) (if (> (maxamp ind 0) .1) (scale-channel .5) (scale-channel 2.0))
+ (if (not (equal? (marks ind 0) current-marks))
+ (snd-display #__line__ ";scaling changed marks: ~A ~A" (marks ind 0) current-marks))
+ (if (not (equal? (map mark-sample (marks ind 0)) current-samples))
+ (snd-display #__line__ ";scaling changed mark locations: ~A ~A" (map mark-sample (marks ind 0)) current-samples)))
+ ((4) (set! (sample (random (- (framples) 1))) .5)
+ (if (not (equal? (marks ind 0) current-marks))
+ (snd-display #__line__ ";set-sample changed marks: ~A ~A" (marks ind 0) current-marks))
+ (if (not (equal? (map mark-sample (marks ind 0)) current-samples))
+ (snd-display #__line__ ";set-sample changed mark locations: ~A ~A" (map mark-sample (marks ind 0)) current-samples)))
+ ((5) (let* ((beg (random (framples)))
+ (dur (max 1 (random 100)))
+ (end (+ beg dur)))
+ (delete-samples beg dur)
+ (for-each
+ (lambda (id old-loc)
+ (if (and (> old-loc beg)
+ (< old-loc end)
+ (mark? id))
+ (snd-display #__line__ ";delete did not clobber mark: ~A ~A [~A ~A]" id old-loc beg end)
+ (if (and (> old-loc end)
+ (not (= (mark-sample id) (- old-loc dur))))
+ (snd-display #__line__ ";delete ripple mark ~D ~D -> ~D (~D)" id old-loc (mark-sample id) dur)
+ (if (and (< old-loc beg)
+ (not (= (mark-sample id) old-loc)))
+ (snd-display #__line__ ";delete but mark before: ~A ~A ~A ~A" id old-loc (mark-sample id) beg)))))
+ current-marks
+ current-samples)))
+ ((6) (revert-sound))
+ ((7) (if (and (pair? current-marks)
+ (> (length current-marks) 1))
+ (let ((id (current-marks (random (- (length current-marks) 1)))))
+ (delete-mark id)
+ (if (mark? id)
+ (snd-display #__line__ ";delete-mark failed? ~A" id))
+ (if (not (= (length (marks ind 0)) (- (length current-marks) 1)))
+ (snd-display #__line__ ";delete-mark list trouble: ~A ~A ~A" id current-marks (marks ind 0))))))
+ ((8) (let ((rate (if (> (framples) 200000) 2.0 0.5)))
+ (src-channel rate)
(for-each
(lambda (id old-loc)
(if (not (mark? id))
- (snd-display #__line__ ";reverse-channel clobbered mark: ~A" id)
- (if (> (abs (- (- (frames) old-loc) (mark-sample id))) 2)
- (snd-display #__line__ ";reverse moved mark: ~A ~A ~A (~A)"
- id old-loc (- (frames) old-loc) (mark-sample id)))))
+ (snd-display #__line__ ";src-channel clobbered mark: ~A" id)
+ (if (> (abs (- (/ old-loc rate) (mark-sample id))) 2)
+ (snd-display #__line__ ";src moved mark: ~A ~A ~A (~A -> ~A)"
+ id old-loc (mark-sample id) rate (- (/ old-loc rate) (mark-sample id))))))
current-marks
current-samples)))
- (else (add-mark (random (- (frames) 1)))))))
- (close-sound ind))
-
- (if (and (provided? 'snd-motif) (provided? 'xm)) (mark-sync-color "blue"))
- (let ((ind (open-sound "oboe.snd")))
- (let ((m0 (add-mark 4321)))
- (delete-sample 100)
- (let ((m1 (add-mark 1234)))
- (let ((val0 (describe-mark m0))
- (val1 (describe-mark m1)))
- (if (or (not (equal? (list-ref (car val0) 0) m0))
- (not (equal? (list-ref (car val0) 2) ind))
- (not (= (list-ref (car val0) 5) 0))
- (not (= (list-ref val0 1) 4321))
- (not (= (list-ref val0 2) 4320)))
- (snd-display #__line__ ";describe-mark m0: ~A" val0))
- (if (or (not (equal? (list-ref (car val1) 0) m1))
- (not (equal? (list-ref (car val1) 2) ind))
- (not (= (list-ref (car val1) 5) 0))
- (not (eq? (list-ref val1 1) #f))
- (not (= (list-ref val1 2) 1234)))
- (snd-display #__line__ ";describe-mark m1: ~A" val1))
- (delete-mark m0)
- (delete-sample 5000)
- (set! val0 (describe-mark m0))
- (set! val1 (describe-mark m1))
- (if (or (not (equal? (list-ref (car val0) 0) m0))
- (not (equal? (list-ref (car val0) 2) ind))
- (not (= (list-ref (car val0) 5) 0))
- (not (= (list-ref val0 1) 4321))
- (not (eq? (list-ref val0 2) #f))
- (not (eq? (list-ref val0 3) #f)))
- (snd-display #__line__ ";describe-mark m0 [1]: ~A" val0))
- (if (or (not (equal? (list-ref (car val1) 0) m1))
- (not (equal? (list-ref (car val1) 2) ind))
- (not (= (list-ref (car val1) 5) 0))
- (not (eq? (list-ref val1 1) #f))
- (not (= (list-ref val1 2) 1234))
- (not (= (list-ref val1 3) 1234)))
- (snd-display #__line__ ";describe-mark m1 [1]: ~A" val1)))))
- (revert-sound ind)
- (hook-push draw-mark-hook (lambda (id) #t))
- (let ((m0 (add-mark 4321))
- (m1 (add-mark 1234))
- (dur (/ (frames ind) (srate ind))))
- (pad-marks (list m0 m1) .01)
- (if (fneq (/ (frames ind) (srate ind)) (+ dur .02))
- (snd-display #__line__ ";pad-marks: ~A ~A" dur (/ (frames ind) (srate ind))))
- (if (and (not (= (mark-sample m0) 4763))
- (not (= (mark-sample m0) 4761)))
- (snd-display #__line__ ";pad-marks m0 pos: ~A" (mark-sample m0)))
- (if (fneq (sample 1235) 0.0) (snd-display #__line__ ";pad-marks 1235: ~A" (sample 1235))))
- (close-sound ind))
- (set! (hook-functions draw-mark-hook) '())
- (let ((ind (open-sound "oboe.snd")))
- (if (find-mark 12345) (snd-display #__line__ ";find-mark when no marks: ~A" (find-mark 12345)))
- (let ((m0 (add-mark 123 ind 0)))
- (delete-sample 0)
- (let ((m1 (add-mark 23 ind 0)))
- (set! (mark-name m1) "23")
- (delete-sample 0)
- (let ((m00 (find-mark 123 ind 0 0))
- (m01 (find-mark "23"))
- (m02 (find-mark 121)))
- (if (not m00) (snd-display #__line__ ";can't find 00th mark"))
- (if (not m01) (snd-display #__line__ ";can't find 01th mark"))
- (if (not m02) (snd-display #__line__ ";can't find 02th mark"))
- (delete-mark (find-mark "23"))
- (scale-by 2.0)
- (set! m1 (add-mark 1234))
- (set! (mark-name m1) "23")
- (let ((m10 (find-mark "23"))
- (m11 (find-mark "23" ind 0 1))
- (m12 (find-mark "23" ind 0 2)))
- (if (not m10) (snd-display #__line__ ";can't find 10th mark")
- (if (not (= (mark-sample m10) 1234)) (snd-display #__line__ ";mark 10th: ~A" (mark-sample m10))))
- (if (not m11) (snd-display #__line__ ";can't find 11th mark")
- (if (not (= (mark-sample m11 1) 23)) (snd-display #__line__ ";mark 11th: ~A" (mark-sample m11 1))))
- (if (mark? m12) (snd-display #__line__ ";found 12th mark: ~A ~A ~A" m12 (mark-sample m12 2) (mark-name m12 2)))))
- (set! (mark-name m1) #f)))
- (close-sound ind))
- (if (string? sf-dir)
- (let ((ind (open-sound (string-append sf-dir "forest.aiff"))))
- (mark-loops)
- (let ((pos (map mark-sample (marks ind 0))))
- (if (not (equal? pos (list 24981 144332)))
- (snd-display #__line__ ";forest marked loops: ~A ~A" (marks ind 0) pos)))
- (close-sound ind)))
-
- ))
-
- (let ((ind (open-sound "oboe.snd")))
- (add-mark 123)
- (add-mark 234 ind 0 "hiho" 1)
- (add-mark 345 ind 0 #f 1)
- (add-mark 456 ind 0 "a mark" 2)
- (add-mark 567 ind 0 #f 1)
- (save-marks ind "oboe.marks")
- (close-sound ind)
- (set! ind (open-sound "oboe.snd"))
- (add-mark 1 ind 0 "new mark" 1)
- (load (string-append cwd "oboe.marks"))
- (let ((m (find-mark 123 ind 0)))
- (if (not (mark? m))
- (snd-display #__line__ ";save marks missed 123?")
- (begin
- (if (not (= (string-length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 123 name: ~A" (mark-name m)))
- (if (not (= (mark-sync m) 0)) (snd-display #__line__ ";saved mark 123 sync: ~A" (mark-sync m))))))
- (let ((m1-sync 0))
- (let ((m (find-mark 234 ind 0)))
- (if (not (mark? m))
- (snd-display #__line__ ";save marks missed 234?")
- (begin
- (if (not (string=? (mark-name m) "hiho")) (snd-display #__line__ ";saved mark 234 name: ~A" (mark-name m)))
- (if (or (= (mark-sync m) 0) (= (mark-sync m) 1)) (snd-display #__line__ ";saved mark 234 sync: ~A" (mark-sync m)))
- (set! m1-sync (mark-sync m)))))
- (let ((m (find-mark 345 ind 0)))
- (if (not (mark? m))
- (snd-display #__line__ ";save marks missed 345?")
- (begin
- (if (not (= (string-length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 345 name: ~A" (mark-name m)))
- (if (not (= (mark-sync m) m1-sync)) (snd-display #__line__ ";saved mark 345 sync: ~A ~A" (mark-sync m) m1-sync)))))
- (let ((m (find-mark 567 ind 0)))
- (if (not (mark? m))
- (snd-display #__line__ ";save marks missed 567?")
- (begin
- (if (not (= (string-length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 567 name: ~A" (mark-name m)))
- (if (not (= (mark-sync m) m1-sync)) (snd-display #__line__ ";saved mark 567 sync: ~A ~A" (mark-sync m) m1-sync)))))
- (let ((m (find-mark 456 ind 0)))
- (if (not (mark? m))
- (snd-display #__line__ ";save marks missed 456?")
- (begin
- (if (not (string=? (mark-name m) "a mark")) (snd-display #__line__ ";saved mark 456 name: ~A" (mark-name m)))
- (if (or (= (mark-sync m) m1-sync)
- (= (mark-sync m) 0)
- (= (mark-sync m) 1))
- (snd-display #__line__ ";saved mark 456 sync: ~A ~A" (mark-sync m) m1-sync)))))
- )
- (delete-file "oboe.marks")
-
- (let ((ind1 (open-sound "2a.snd")))
- (add-mark 1 ind1 0)
- (add-mark 2 ind1 1)
- (add-mark 3 ind1 0 "hi3")
- (add-mark 6 ind1 1 "hi6")
- (add-mark 4 ind1 0 #f 4)
- (add-mark 8 ind1 1 #f 5)
- (add-mark 5 ind1 0 #f 9)
- (add-mark 10 ind1 1 #f 9)
- (add-mark 20 ind1 0 #f 12)
- (add-mark 40 ind1 1 #f 12)
- (add-mark 60 ind1 1 #f 12)
- (save-marks ind1 "test.marks")
- (close-sound ind)
- (close-sound ind1))
+ ((9) (reverse-channel)
+ (for-each
+ (lambda (id old-loc)
+ (if (not (mark? id))
+ (snd-display #__line__ ";reverse-channel clobbered mark: ~A" id)
+ (if (> (abs (- (framples) old-loc (mark-sample id))) 2)
+ (snd-display #__line__ ";reverse moved mark: ~A ~A ~A (~A)"
+ id old-loc (- (framples) old-loc) (mark-sample id)))))
+ current-marks
+ current-samples))
+ (else (add-mark (random (- (framples) 1)))))))
+ (close-sound ind))
- (set! ind (open-sound "2a.snd"))
- (load (string-append cwd "test.marks"))
+ (if (and (provided? 'snd-motif) (provided? 'xm)) (mark-sync-color "blue"))
+ (let ((ind (open-sound "oboe.snd")))
+ (let ((m0 (add-mark 4321)))
+ (delete-sample 100)
+ (let ((m1 (add-mark 1234)))
+ (let ((val0 (describe-mark m0))
+ (val1 (describe-mark m1)))
+ (if (or (not (equal? ((car val0) 0) m0))
+ (not (equal? ((car val0) 2) ind))
+ (not (= ((car val0) 5) 0))
+ (not (= (val0 1) 4321))
+ (not (= (val0 2) 4320)))
+ (snd-display #__line__ ";describe-mark m0: ~A" val0))
+ (if (or (not (equal? ((car val1) 0) m1))
+ (not (equal? ((car val1) 2) ind))
+ (not (= ((car val1) 5) 0))
+ (val1 1)
+ (not (= (val1 2) 1234)))
+ (snd-display #__line__ ";describe-mark m1: ~A" val1))
+ (delete-mark m0)
+ (delete-sample 5000)
+ (set! val0 (describe-mark m0))
+ (set! val1 (describe-mark m1))
+ (if (or (not (equal? ((car val0) 0) m0))
+ (not (equal? ((car val0) 2) ind))
+ (not (= ((car val0) 5) 0))
+ (not (= (val0 1) 4321))
+ (val0 2)
+ (val0 3))
+ (snd-display #__line__ ";describe-mark m0 [1]: ~A" val0))
+ (if (or (not (equal? ((car val1) 0) m1))
+ (not (equal? ((car val1) 2) ind))
+ (not (= ((car val1) 5) 0))
+ (val1 1)
+ (not (= (val1 2) 1234))
+ (not (= (val1 3) 1234)))
+ (snd-display #__line__ ";describe-mark m1 [1]: ~A" val1)))))
+ (revert-sound ind)
+ (hook-push draw-mark-hook (lambda (hook) #t))
+ (let ((m0 (add-mark 4321))
+ (m1 (add-mark 1234))
+ (dur (/ (framples ind) (srate ind))))
+ (pad-marks (list m0 m1) .01)
+ (if (fneq (/ (framples ind) (srate ind)) (+ dur .02))
+ (snd-display #__line__ ";pad-marks: ~A ~A" dur (/ (framples ind) (srate ind))))
+ (if (and (not (= (mark-sample m0) 4763))
+ (not (= (mark-sample m0) 4761)))
+ (snd-display #__line__ ";pad-marks m0 pos: ~A" (mark-sample m0)))
+ (if (fneq (sample 1235) 0.0) (snd-display #__line__ ";pad-marks 1235: ~A" (sample 1235))))
+ (close-sound ind))
+ (set! (hook-functions draw-mark-hook) ())
+ (let ((ind (open-sound "oboe.snd")))
+ (if (find-mark 12345) (snd-display #__line__ ";find-mark when no marks: ~A" (find-mark 12345)))
+ (add-mark 123 ind 0)
+ (delete-sample 0)
+ (let ((m1 (add-mark 23 ind 0)))
+ (set! (mark-name m1) "23")
+ (delete-sample 0)
+ (let ((m00 (find-mark 123 ind 0 0))
+ (m01 (find-mark "23"))
+ (m02 (find-mark 121)))
+ (if (not m00) (snd-display #__line__ ";can't find 00th mark"))
+ (if (not m01) (snd-display #__line__ ";can't find 01th mark"))
+ (if (not m02) (snd-display #__line__ ";can't find 02th mark"))
+ (delete-mark (find-mark "23"))
+ (scale-by 2.0)
+ (set! m1 (add-mark 1234))
+ (set! (mark-name m1) "23")
+ (let ((m10 (find-mark "23"))
+ (m11 (find-mark "23" ind 0 1))
+ (m12 (find-mark "23" ind 0 2)))
+ (if (not m10) (snd-display #__line__ ";can't find 10th mark")
+ (if (not (= (mark-sample m10) 1234)) (snd-display #__line__ ";mark 10th: ~A" (mark-sample m10))))
+ (if (not m11) (snd-display #__line__ ";can't find 11th mark")
+ (if (not (= (mark-sample m11 1) 23)) (snd-display #__line__ ";mark 11th: ~A" (mark-sample m11 1))))
+ (if (mark? m12) (snd-display #__line__ ";found 12th mark: ~A ~A ~A" m12 (mark-sample m12 2) (mark-name m12))))
+ (set! (mark-name m1) #f)))
+ (close-sound ind))
+ (if (string? sf-dir)
+ (let ((ind (open-sound (string-append sf-dir "forest.aiff"))))
+ (mark-loops)
+ (let ((pos (map mark-sample (marks ind 0))))
+ (if (not (equal? pos (list 24981 144332)))
+ (snd-display #__line__ ";forest marked loops: ~A ~A" (marks ind 0) pos)))
+ (close-sound ind)))
- (let ((m1 (find-mark 1 ind 0))
- (m2 (find-mark 2 ind 1)))
- (if (or (not (mark? m1)) (not (mark? m2)))
- (snd-display #__line__ ";save-marks 2a 1,2: ~A ~A" m1 m2)
- (if (or (not (= (mark-sync m1) 0)) (not (= (mark-sync m2) 0)))
- (snd-display #__line__ ";save-marks 2a 1,2 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))))
- (let ((m1 (find-mark 5 ind 0))
- (m2 (find-mark 10 ind 1)))
- (if (or (not (mark? m1)) (not (mark? m2)))
- (snd-display #__line__ ";save-marks 2a 5,10: ~A ~A" m1 m2)
- (if (or (= (mark-sync m1) 0)
- (not (= (mark-sync m1) (mark-sync m2))))
- (snd-display #__line__ ";save-marks 2a 5,10 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))))
- (let ((m1 (find-mark 4 ind 0))
- (m2 (find-mark 8 ind 1))
- (m3 (find-mark 5 ind 0)))
- (if (or (not (mark? m1)) (not (mark? m2)))
- (snd-display #__line__ ";save-marks 2a 4,8: ~A ~A" m1 m2)
- (if (or (= (mark-sync m1) 0)
- (= (mark-sync m2) 0)
- (= (mark-sync m1) (mark-sync m2))
- (= (mark-sync m1) (mark-sync m3)))
- (snd-display #__line__ ";save-marks 2a 4,8 syncs: ~A ~A ~A" (mark-sync m1) (mark-sync m2) (mark-sync m3)))))
- (let ((m1 (find-mark 3 ind 0))
- (m2 (find-mark 6 ind 1)))
- (if (or (not (mark? m1)) (not (mark? m2)))
- (snd-display #__line__ ";save-marks 2a 3,6: ~A ~A" m1 m2)
+ ))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (add-mark 123)
+ (add-mark 234 ind 0 "hiho" 1)
+ (add-mark 345 ind 0 #f 1)
+ (add-mark 456 ind 0 "a mark" 2)
+ (add-mark 567 ind 0 #f 1)
+ (save-marks ind "oboe.marks")
+ (close-sound ind)
+ (set! ind (open-sound "oboe.snd"))
+ (add-mark 1 ind 0 "new mark" 1)
+ (load (string-append cwd "oboe.marks"))
+ (let ((m (find-mark 123 ind 0)))
+ (if (not (mark? m))
+ (snd-display #__line__ ";save marks missed 123?")
+ (begin
+ (if (not (= (length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 123 name: ~A" (mark-name m)))
+ (if (not (= (mark-sync m) 0)) (snd-display #__line__ ";saved mark 123 sync: ~A" (mark-sync m))))))
+ (let ((m1-sync 0))
+ (let ((m (find-mark 234 ind 0)))
+ (if (not (mark? m))
+ (snd-display #__line__ ";save marks missed 234?")
(begin
- (if (or (not (= (mark-sync m1) 0)) (not (= (mark-sync m2) 0)))
- (snd-display #__line__ ";save-marks 2a 3,6 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))
- (if (not (string=? (mark-name m1) "hi3")) (snd-display #__line__ ";save-marks 2a 3 name: ~A" (mark-name m1)))
- (if (not (string=? (mark-name m2) "hi6")) (snd-display #__line__ ";save-marks 2a 6 name: ~A" (mark-name m2))))))
- (let ((m1 (find-mark 4 ind 0))
- (m2 (find-mark 5 ind 0))
- (m3 (find-mark 20 ind 0))
- (m4 (find-mark 40 ind 1))
- (m5 (find-mark 60 ind 1)))
- (if (or (not (mark? m3)) (not (mark? m4)) (not (mark? m5)))
- (snd-display #__line__ ";save-marks 2a 20...: ~A ~A ~A" m3 m4 m5)
- (if (or (= (mark-sync m3) 0)
- (= (mark-sync m1) (mark-sync m3))
- (= (mark-sync m2) (mark-sync m3))
- (not (= (mark-sync m3) (mark-sync m4) (mark-sync m5))))
- (snd-display #__line__ ";save-marks 2a 10... syncs: ~A ~A ~A" (mark-sync m3) (mark-sync m4) (mark-sync m5)))))
- (delete-file "test.marks")
- (close-sound ind))
-
- (let ((ind (new-sound :size 1000)))
- (add-mark 123)
- (add-mark 234 ind 0 "hiho" 1)
- (add-mark 345 ind 0 #f 1)
- (add-mark 456 ind 0 "a mark" 2)
- (add-mark 567 ind 0 #f 1)
-
- (hook-push output-comment-hook (lambda (str) (marks->string (selected-sound))))
- (save-sound-as "tst.snd")
- (let ((new-file-name (file-name ind)))
- (close-sound ind)
- (if (file-exists? new-file-name) (delete-file new-file-name)))
- (set! ind (open-sound "tst.snd"))
- (set! (hook-functions output-comment-hook) '())
-
- (eval-header ind)
- (let ((ms (marks ind 0)))
- (if (not (= (length ms) 5)) (snd-display #__line__ ";eval-header + marks->string: ~A" ms))
- (let ((samps (map mark-sample ms)))
- (if (or (not (member 123 samps))
- (not (member 567 samps)))
- (snd-display #__line__ ";eval marked header samps: ~A" samps)))
- (if (not (find-mark 234)) (snd-display #__line__ ";eval mark header no mark at 234?"))
- (if (mark? (find-mark 456))
- (if (not (= (mark-sync (find-mark 456)) 2))
- (snd-display #__line__ ";eval mark header sync: ~A" (mark-sync (find-mark 456))))
- (snd-display #__line__ ";no mark at 456")))
-
+ (if (not (string=? (mark-name m) "hiho")) (snd-display #__line__ ";saved mark 234 name: ~A" (mark-name m)))
+ (if (or (= (mark-sync m) 0) (= (mark-sync m) 1)) (snd-display #__line__ ";saved mark 234 sync: ~A" (mark-sync m)))
+ (set! m1-sync (mark-sync m)))))
+ (let ((m (find-mark 345 ind 0)))
+ (if (not (mark? m))
+ (snd-display #__line__ ";save marks missed 345?")
+ (begin
+ (if (not (= (length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 345 name: ~A" (mark-name m)))
+ (if (not (= (mark-sync m) m1-sync)) (snd-display #__line__ ";saved mark 345 sync: ~A ~A" (mark-sync m) m1-sync)))))
+ (let ((m (find-mark 567 ind 0)))
+ (if (not (mark? m))
+ (snd-display #__line__ ";save marks missed 567?")
+ (begin
+ (if (not (= (length (mark-name m)) 0)) (snd-display #__line__ ";saved mark 567 name: ~A" (mark-name m)))
+ (if (not (= (mark-sync m) m1-sync)) (snd-display #__line__ ";saved mark 567 sync: ~A ~A" (mark-sync m) m1-sync)))))
+ (let ((m (find-mark 456 ind 0)))
+ (if (not (mark? m))
+ (snd-display #__line__ ";save marks missed 456?")
+ (begin
+ (if (not (string=? (mark-name m) "a mark")) (snd-display #__line__ ";saved mark 456 name: ~A" (mark-name m)))
+ (if (or (= (mark-sync m) m1-sync)
+ (= (mark-sync m) 0)
+ (= (mark-sync m) 1))
+ (snd-display #__line__ ";saved mark 456 sync: ~A ~A" (mark-sync m) m1-sync)))))
+ )
+ (delete-file "oboe.marks")
+
+ (let ((ind1 (open-sound "2a.snd")))
+ (add-mark 1 ind1 0)
+ (add-mark 2 ind1 1)
+ (add-mark 3 ind1 0 "hi3")
+ (add-mark 6 ind1 1 "hi6")
+ (add-mark 4 ind1 0 #f 4)
+ (add-mark 8 ind1 1 #f 5)
+ (add-mark 5 ind1 0 #f 9)
+ (add-mark 10 ind1 1 #f 9)
+ (add-mark 20 ind1 0 #f 12)
+ (add-mark 40 ind1 1 #f 12)
+ (add-mark 60 ind1 1 #f 12)
+ (save-marks ind1 "test.marks")
(close-sound ind)
- (mus-sound-forget "tst.snd")
- (delete-file "tst.snd"))
+ (close-sound ind1))
- ;; mark-explode
- (let ((ind (new-sound :size 31))
- (ctr -1))
- (map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (< ctr 10) .1 (if (< ctr 20) .4 .8))))
- (add-mark 10)
- (add-mark 20)
- (add-mark 30)
- (mark-explode)
- (if (file-exists? "mark-0.snd")
- (let ((ind1 (open-sound "mark-0.snd")))
- (if (not (= (frames ind1 0) 10)) (snd-display #__line__ ";mark-0 frames: ~A" (frames ind1 0)))
- (if (not (vequal (channel->vct) (make-vct 10 .1))) (snd-display #__line__ ";mark-0 vals: ~A" (channel->vct)))
- (close-sound ind1)
- (delete-file "mark-0.snd"))
- (snd-display #__line__ ";mark-explode did not write mark-0.snd?"))
- (if (file-exists? "mark-1.snd")
- (let ((ind1 (open-sound "mark-1.snd")))
- (if (not (= (frames ind1 0) 10)) (snd-display #__line__ ";mark-1 frames: ~A" (frames ind1 0)))
- (if (not (vequal (channel->vct) (make-vct 10 .4))) (snd-display #__line__ ";mark-1 vals: ~A" (channel->vct)))
- (close-sound ind1)
- (delete-file "mark-1.snd"))
- (snd-display #__line__ ";mark-explode did not write mark-1.snd?"))
- (if (file-exists? "mark-2.snd")
- (let ((ind1 (open-sound "mark-2.snd")))
- (if (not (= (frames ind1 0) 10)) (snd-display #__line__ ";mark-2 frames: ~A" (frames ind1 0)))
- (if (not (vequal (channel->vct) (make-vct 10 .8))) (snd-display #__line__ ";mark-2 vals: ~A" (channel->vct)))
- (close-sound ind1)
- (delete-file "mark-2.snd"))
- (snd-display #__line__ ";mark-explode did not write mark-2.snd?"))
- (if (file-exists? "mark-3.snd") (snd-display #__line__ ";mark-explode wrote too many files?"))
- (let ((name (file-name ind)))
- (close-sound ind)
- (if (file-exists? name) (delete-file name))))
+ (set! ind (open-sound "2a.snd"))
+ (load (string-append cwd "test.marks"))
+
+ (let ((m1 (find-mark 1 ind 0))
+ (m2 (find-mark 2 ind 1)))
+ (if (or (not (mark? m1)) (not (mark? m2)))
+ (snd-display #__line__ ";save-marks 2a 1,2: ~A ~A" m1 m2)
+ (if (or (not (= (mark-sync m1) 0)) (not (= (mark-sync m2) 0)))
+ (snd-display #__line__ ";save-marks 2a 1,2 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))))
+ (let ((m1 (find-mark 5 ind 0))
+ (m2 (find-mark 10 ind 1)))
+ (if (or (not (mark? m1)) (not (mark? m2)))
+ (snd-display #__line__ ";save-marks 2a 5,10: ~A ~A" m1 m2)
+ (if (or (= (mark-sync m1) 0)
+ (not (= (mark-sync m1) (mark-sync m2))))
+ (snd-display #__line__ ";save-marks 2a 5,10 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))))
+ (let ((m1 (find-mark 4 ind 0))
+ (m2 (find-mark 8 ind 1))
+ (m3 (find-mark 5 ind 0)))
+ (if (or (not (mark? m1)) (not (mark? m2)))
+ (snd-display #__line__ ";save-marks 2a 4,8: ~A ~A" m1 m2)
+ (if (or (= (mark-sync m1) 0)
+ (= (mark-sync m2) 0)
+ (= (mark-sync m1) (mark-sync m2))
+ (= (mark-sync m1) (mark-sync m3)))
+ (snd-display #__line__ ";save-marks 2a 4,8 syncs: ~A ~A ~A" (mark-sync m1) (mark-sync m2) (mark-sync m3)))))
+ (let ((m1 (find-mark 3 ind 0))
+ (m2 (find-mark 6 ind 1)))
+ (if (or (not (mark? m1)) (not (mark? m2)))
+ (snd-display #__line__ ";save-marks 2a 3,6: ~A ~A" m1 m2)
+ (begin
+ (if (or (not (= (mark-sync m1) 0)) (not (= (mark-sync m2) 0)))
+ (snd-display #__line__ ";save-marks 2a 3,6 syncs: ~A ~A" (mark-sync m1) (mark-sync m2)))
+ (if (not (string=? (mark-name m1) "hi3")) (snd-display #__line__ ";save-marks 2a 3 name: ~A" (mark-name m1)))
+ (if (not (string=? (mark-name m2) "hi6")) (snd-display #__line__ ";save-marks 2a 6 name: ~A" (mark-name m2))))))
+ (let ((m1 (find-mark 4 ind 0))
+ (m2 (find-mark 5 ind 0))
+ (m3 (find-mark 20 ind 0))
+ (m4 (find-mark 40 ind 1))
+ (m5 (find-mark 60 ind 1)))
+ (if (or (not (mark? m3)) (not (mark? m4)) (not (mark? m5)))
+ (snd-display #__line__ ";save-marks 2a 20...: ~A ~A ~A" m3 m4 m5)
+ (if (or (= (mark-sync m3) 0)
+ (= (mark-sync m1) (mark-sync m3))
+ (= (mark-sync m2) (mark-sync m3))
+ (not (= (mark-sync m3) (mark-sync m4) (mark-sync m5))))
+ (snd-display #__line__ ";save-marks 2a 10... syncs: ~A ~A ~A" (mark-sync m3) (mark-sync m4) (mark-sync m5)))))
+ (delete-file "test.marks")
+ (close-sound ind))
+
+ (let ((ind (new-sound :size 1000)))
+ (add-mark 123)
+ (add-mark 234 ind 0 "hiho" 1)
+ (add-mark 345 ind 0 #f 1)
+ (add-mark 456 ind 0 "a mark" 2)
+ (add-mark 567 ind 0 #f 1)
+
+ (hook-push output-comment-hook (lambda (hook) (set! (hook 'result) (marks->string (selected-sound)))))
+ (save-sound-as "tst.snd")
+ (let ((new-file-name (file-name ind)))
+ (close-sound ind)
+ (if (file-exists? new-file-name) (delete-file new-file-name)))
+ (set! ind (open-sound "tst.snd"))
+ (set! (hook-functions output-comment-hook) ())
+
+ (eval-header ind)
+ (let ((ms (marks ind 0)))
+ (if (not (= (length ms) 5)) (snd-display #__line__ ";eval-header + marks->string: ~A" ms))
+ (let ((samps (map mark-sample ms)))
+ (if (or (not (memv 123 samps))
+ (not (memv 567 samps)))
+ (snd-display #__line__ ";eval marked header samps: ~A" samps)))
+ (if (not (find-mark 234)) (snd-display #__line__ ";eval mark header no mark at 234?"))
+ (if (mark? (find-mark 456))
+ (if (not (= (mark-sync (find-mark 456)) 2))
+ (snd-display #__line__ ";eval mark header sync: ~A" (mark-sync (find-mark 456))))
+ (snd-display #__line__ ";no mark at 456")))
- ))
+ (close-sound ind)
+ (mus-sound-forget "tst.snd")
+ (delete-file "tst.snd"))
+
+ ;; mark-explode
+ (let ((ind (new-sound :size 31))
+ (ctr -1))
+ (map-channel (lambda (y) (set! ctr (+ ctr 1)) (if (< ctr 10) .1 (if (< ctr 20) .4 .8))))
+ (add-mark 10)
+ (add-mark 20)
+ (add-mark 30)
+ (mark-explode)
+ (if (file-exists? "mark-0.snd")
+ (let ((ind1 (open-sound "mark-0.snd")))
+ (if (not (= (framples ind1 0) 10)) (snd-display #__line__ ";mark-0 framples: ~A" (framples ind1 0)))
+ (if (not (vequal (channel->float-vector) (make-float-vector 10 .1))) (snd-display #__line__ ";mark-0 vals: ~A" (channel->float-vector)))
+ (close-sound ind1)
+ (delete-file "mark-0.snd"))
+ (snd-display #__line__ ";mark-explode did not write mark-0.snd?"))
+ (if (file-exists? "mark-1.snd")
+ (let ((ind1 (open-sound "mark-1.snd")))
+ (if (not (= (framples ind1 0) 10)) (snd-display #__line__ ";mark-1 framples: ~A" (framples ind1 0)))
+ (if (not (vequal (channel->float-vector) (make-float-vector 10 .4))) (snd-display #__line__ ";mark-1 vals: ~A" (channel->float-vector)))
+ (close-sound ind1)
+ (delete-file "mark-1.snd"))
+ (snd-display #__line__ ";mark-explode did not write mark-1.snd?"))
+ (if (file-exists? "mark-2.snd")
+ (let ((ind1 (open-sound "mark-2.snd")))
+ (if (not (= (framples ind1 0) 10)) (snd-display #__line__ ";mark-2 framples: ~A" (framples ind1 0)))
+ (if (not (vequal (channel->float-vector) (make-float-vector 10 .8))) (snd-display #__line__ ";mark-2 vals: ~A" (channel->float-vector)))
+ (close-sound ind1)
+ (delete-file "mark-2.snd"))
+ (snd-display #__line__ ";mark-explode did not write mark-2.snd?"))
+ (if (file-exists? "mark-3.snd") (snd-display #__line__ ";mark-explode wrote too many files?"))
+ (let ((name (file-name ind)))
+ (close-sound ind)
+ (if (file-exists? name) (delete-file name))))
+ )
;;; ---------------- test 11: dialogs ----------------
-(defvar env1 '(0 0 1 0))
-(defvar env2 '(0 0 1 1))
-(defvar ramp-up-env '(0 0 1 1))
+(define-envelope env1 '(0 0 1 0))
+(define-envelope env2 '(0 0 1 1))
+(define-envelope ramp-up-env '(0 0 1 1))
(define-envelope env4 '(0 1 1 0))
(define (snd_test_11)
+
(define (string-equal-ignoring-white-space s1 s2)
- (let ((len1 (string-length s2)))
- (define (white-space? str pos)
- (or (char=? (string-ref str pos) #\space)
- (char=? (string-ref str pos) #\newline)))
- (call-with-exit
- (lambda (return)
- (do ((i 0)
- (j 0))
- ((= i len1) (begin (while (and (< j len1) (white-space? s2 j)) (set! j (+ j 1))) (= j len1)))
- (if (char=? (string-ref s1 i) (string-ref s2 j))
- (begin
- (set! i (+ i 1))
- (set! j (+ j 1)))
- (begin
- (while (and (< i len1) (white-space? s1 i)) (set! i (+ i 1)))
- (while (and (< j len1) (white-space? s2 j)) (set! j (+ j 1)))
- (if (not (char=? (string-ref s1 i) (string-ref s2 j)))
- (return #f)))))))))
+ (or (string=? s1 s2)
+ (let ((len1 (length s1))
+ (len2 (length s2)))
+ (let loop ((i1 0) (i2 0))
+ (or (and (= i1 len1)
+ (= i2 len2))
+ (if (and (< i1 len1)
+ (char-whitespace? (s1 i1)))
+ (loop (+ i1 1) i2)
+ (if (and (< i2 len2)
+ (char-whitespace? (s2 i2)))
+ (loop i1 (+ i2 1))
+ (and (< i1 len1)
+ (< i2 len2)
+ (char=? (s1 i1) (s2 i2))
+ (loop (+ i1 1) (+ i2 1))))))))))
(if with-gui
-
(begin
-
(without-errors (peaks))
- (let ((envd (enved-dialog) ))
- (let ((cold (color-orientation-dialog))
- (trd (transform-dialog))
- (fild (view-files-dialog))
- (regd (view-regions-dialog))
- (pd (and (not (provided? 'snd-gtk)) (print-dialog)))
- (ehd (without-errors (edit-header-dialog))))
- (open-file-dialog #f)
- (mix-file-dialog #f)
- (insert-file-dialog #f)
- (help-dialog "Test" "snd-test here")
- (save-envelopes "hiho.env")
- (load (string-append cwd "hiho.env"))
- (if (not (equal? env4 (list 0.0 1.0 1.0 0.0))) (snd-display #__line__ ";save-envelopes: ~A?" env4))
- (delete-file "hiho.env")
- (help-dialog "test2" "this is the next test"
- (list "string 1{open-sound}" "{env-sound}string2" "string{close-sound}3")
- (list "extsnd.html#sndopen" "extsnd.html#sndenv" "extsnd.html#sndclose"))
- (dismiss-all-dialogs)
- ))
+ (enved-dialog)
+ (color-orientation-dialog)
+ (transform-dialog)
+ (if with-motif (view-files-dialog))
+ (view-regions-dialog)
+ (if (not (provided? 'snd-gtk)) (print-dialog))
+ (without-errors (edit-header-dialog))
+ (open-file-dialog #f)
+ (mix-file-dialog #f)
+ (insert-file-dialog #f)
+ (help-dialog "Test" "snd-test here")
+ (save-envelopes "hiho.env")
+ (load (string-append cwd "hiho.env"))
+ (if (not (equal? env4 (list 0.0 1.0 1.0 0.0))) (snd-display #__line__ ";save-envelopes: ~A?" env4))
+ (delete-file "hiho.env")
+ (help-dialog "test2" "this is the next test"
+ (list "string 1{open-sound}" "{env-sound}string2" "string{close-sound}3")
+ (list "extsnd.html#sndopen" "extsnd.html#sndenv" "extsnd.html#sndclose"))
+ (dismiss-all-dialogs)
(let ((ind (open-sound "oboe.snd")))
(edit-header-dialog ind)
@@ -30370,150 +24916,114 @@ EDITS: 2
(not (string-equal-ignoring-white-space str1 str2))
(not (string-equal-ignoring-white-space str1 "A raised cosine")))
(snd-display #__line__ ";snd-help hamming-window: ~A ~A" str1 str2)))
- (if (or (not (number? hamming-window))
- (not (= hamming-window old-val)))
- (snd-display #__line__ ";snd-help clobbered out-of-module variable: ~A ~A" old-value hamming-window)))
+ (if (not (= hamming-window old-val))
+ (snd-display #__line__ ";snd-help clobbered out-of-module variable: ~A ~A" old-val hamming-window)))
(let ((vals (snd-urls)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 25)) ; need to cycle the 8's
- (if (defined? (string->symbol (car (list-ref vals i))))
- (snd-help (car (list-ref vals i)) #f))))
+ (if (defined? (string->symbol (car (vals i))))
+ (snd-help (car (vals i)) #f))))
- (set! (show-indices) #t)
+ (set! *show-indices* #t)
(let ((ind (open-sound "oboe.snd")))
(if (< (length (sound-widgets ind)) 4)
(snd-display #__line__ ";sound-widgets: ~A?" (sound-widgets ind)))
- (report-in-minibuffer "hi there" ind)
- (if with-gui
- (let ((str (widget-text (list-ref (sound-widgets ind) 3))))
- (if (not (string=? str "hi there"))
- (snd-display #__line__ ";report-in-minibuffer: ~A?" str))))
- (if with-gui
- (let ((str (widget-text (list-ref (sound-widgets ind) 3))))
- (if (not (string=? str "hi there"))
- (snd-display #__line__ ";report-in-minibuffer 1: ~A?" str))
- (if (widget-text (cadr (main-widgets)))
- (snd-display #__line__ ";widget text should be #f: ~A" (widget-text (cadr (main-widgets)))))
- (let ((str (format #f "~A: ~A" (sound->integer ind) (short-file-name ind)))
- (txt (widget-text (cadr (sound-widgets ind)))))
- (if (or (not (string? txt))
- (not (string=? str txt)))
- (snd-display #__line__ ";name text: ~A ~A" str txt)))))
- (clear-minibuffer)
+ (status-report "hi there" ind)
+ (status-report "")
(close-sound ind))
- (if (file-exists? "link-oboe.snd")
- (let* ((ind (open-sound "link-oboe.snd"))
- (linked-str (format #f "~A: (~A)" (sound->integer ind) (short-file-name ind))))
- (if with-gui
- (if (not (string=? linked-str (widget-text (cadr (sound-widgets ind)))))
- (snd-display #__line__ ";linked name text: ~A ~A" linked-str (widget-text (cadr (sound-widgets ind))))))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (XtCallCallbacks (cadr (sound-widgets ind)) XmNactivateCallback (snd-sound-pointer ind)))
- (close-sound ind)))
- (set! (show-indices) #f)
- (if (file-exists? "link-oboe.snd")
- (let* ((ind (open-sound "link-oboe.snd"))
- (linked-str (format #f "(~A)" (short-file-name ind))))
- (if with-gui
- (if (not (string=? linked-str (widget-text (cadr (sound-widgets ind)))))
- (snd-display #__line__ ";linked name text (no index): ~A ~A" linked-str (widget-text (cadr (sound-widgets ind))))))
- (close-sound ind)))
+ (set! *show-indices* #f)
(define-envelope test-ramp '(0 0 1 1))
(if (not (equal? test-ramp '(0 0 1 1))) (snd-display #__line__ ";define-envelope test-ramp: ~A" test-ramp))
(define-envelope test-ramp '(0 1 1 0))
(if (not (equal? test-ramp '(0 1 1 0))) (snd-display #__line__ ";re-define-envelope test-ramp: ~A" test-ramp))
- (if (or (provided? 'xm) (provided? 'xg))
- (begin
- (load "oscope.scm")
- ;; oscope exists
- (if (not (sound-data? (cadr oscope))) (snd-display #__line__ ";oscope: ~A" oscope))
- (if (provided? 'snd-motif)
- (XtUnmanageChild oscope-dialog)
- (gtk_widget_hide oscope-dialog))))
-
- (let ((dialog (view-files-dialog #f)))
- (let ((vfamp (view-files-amp dialog))
- (vfs (view-files-speed dialog))
- (vfsort (view-files-sort))
- (vfsort1 (view-files-sort dialog))
- (vfe (view-files-amp-env dialog))
- (vffiles (view-files-files dialog))
- (vfsel (view-files-selected-files dialog))
- (selected-file #f))
- (if (fneq vfamp 1.0) (snd-display #__line__ ";vf amp: ~A" vfamp))
- (if (fneq vfs 1.0) (snd-display #__line__ ";vf spd: ~A" vfs))
- (if (not (= vfsort 0)) (snd-display #__line__ ";vf sort: ~A" vfsort))
- (if (not (= vfsort1 0)) (snd-display #__line__ ";vf sort(d): ~A" vfsort1))
- (if (not (feql vfe (list 0.0 1.0 1.0 1.0))) (snd-display #__line__ ";vf amp env: ~A" vfe))
- (if (not (list? vffiles)) (snd-display #__line__ ";vf files: ~A" vffiles))
- (if (not (list? vfsel)) (snd-display #__line__ ";vf selected files: ~A" vfsel))
- (if (not (= (view-files-speed-style dialog) (speed-control-style)))
- (snd-display #__line__ ";vf speed-style def: ~A ~A" (view-files-speed-style dialog) (speed-control-style)))
- (set! (view-files-amp dialog) 0.5)
- (if (fneq (view-files-amp dialog) 0.5) (snd-display #__line__ ";set vf amp: ~A" (view-files-amp dialog)))
- (set! (view-files-speed dialog) 0.5)
- (if (fneq (view-files-speed dialog) 0.5) (snd-display #__line__ ";set vf spd: ~A" (view-files-speed dialog)))
- (set! (view-files-speed-style dialog) speed-control-as-ratio)
- (if (not (= (view-files-speed-style dialog) speed-control-as-ratio))
- (snd-display #__line__ ";vf speed-style set: ~A" (view-files-speed-style dialog)))
- (set! (view-files-sort dialog) 2)
- (if (not (= (view-files-sort) 0)) (snd-display #__line__ ";vf global sort after local set: ~A" (view-files-sort)))
- (if (not (= (view-files-sort dialog) 2)) (snd-display #__line__ ";vf local sort after local set: ~A" (view-files-sort dialog)))
- (set! (view-files-sort) 4)
- (if (not (= (view-files-sort) 4)) (snd-display #__line__ ";vf global sort after global set: ~A" (view-files-sort)))
- (if (not (= (view-files-sort dialog) 2)) (snd-display #__line__ ";vf local sort after global set: ~A" (view-files-sort dialog)))
- (set! (view-files-files dialog) (list "oboe.snd" "1a.snd" "pistol.snd" "storm.snd"))
- (let ((vf-files (view-files-files dialog)))
- (if (or (and (not (member "1a.snd" vf-files))
- (not (member (string-append home-dir "/cl/1a.snd") vf-files))
- (not (member (string-append home-dir "/snd-12/1a.snd") vf-files)))
- (and (not (member "pistol.snd" vf-files))
- (not (member (string-append home-dir "/cl/pistol.snd") vf-files))
- (not (member (string-append home-dir "/snd-12/pistol.snd") vf-files)))
- (not (= (length vf-files) 4)))
- (snd-display #__line__ ";vf files set: ~A (~A, ~A)" vf-files (string-append home-dir "/cl/1a.snd") (length vf-files))))
- (set! (hook-functions view-files-select-hook) '())
- (hook-push view-files-select-hook (lambda (w file)
- (if (not (string? file))
- (snd-display #__line__ ";vf select hook arg: ~A" file))
- (if (not w) (snd-display #__line__ ";vf select hook dialog: ~A" w))
- (set! selected-file file)))
- (set! (view-files-selected-files dialog) (list "1a.snd"))
- (if (or (not (string? selected-file))
- (and (not (equal? selected-file "1a.snd"))
- (not (equal? selected-file (string-append home-dir "/cl/1a.snd")))
- (not (equal? selected-file (string-append home-dir "/snd-12/1a.snd")))))
- (snd-display #__line__ ";vf set selected select hook arg: ~A" selected-file))
- (if (and (not (equal? (view-files-selected-files dialog) (list "1a.snd")))
- (not (equal? (view-files-selected-files dialog) (list (string-append home-dir "/cl/1a.snd"))))
- (not (equal? (view-files-selected-files dialog) (list (string-append home-dir "/snd-12/1a.snd")))))
- (snd-display #__line__ ";vf selected files set: ~A" (view-files-selected-files dialog)))
- (hide-widget dialog)
- ))
-
+ (if with-motif
+ (let ((dialog (view-files-dialog #f)))
+ (let ((vfamp (view-files-amp dialog))
+ (vfs (view-files-speed dialog))
+ (vfsort (view-files-sort))
+ (vfsort1 (view-files-sort dialog))
+ (vfe (view-files-amp-env dialog))
+ (vffiles (view-files-files dialog))
+ (vfsel (view-files-selected-files dialog))
+ (selected-file #f))
+ (if (fneq vfamp 1.0) (snd-display #__line__ ";vf amp: ~A" vfamp))
+ (if (fneq vfs 1.0) (snd-display #__line__ ";vf spd: ~A" vfs))
+ (if (not (= vfsort 0)) (snd-display #__line__ ";vf sort: ~A" vfsort))
+ (if (not (= vfsort1 0)) (snd-display #__line__ ";vf sort(d): ~A" vfsort1))
+ (if (not (feql vfe (list 0.0 1.0 1.0 1.0))) (snd-display #__line__ ";vf amp env: ~A" vfe))
+ (if (not (list? vffiles)) (snd-display #__line__ ";vf files: ~A" vffiles))
+ (if (not (list? vfsel)) (snd-display #__line__ ";vf selected files: ~A" vfsel))
+ (if (not (= (view-files-speed-style dialog) *speed-control-style*))
+ (snd-display #__line__ ";vf speed-style def: ~A ~A" (view-files-speed-style dialog) *speed-control-style*))
+ (set! (view-files-amp dialog) 0.5)
+ (if (fneq (view-files-amp dialog) 0.5) (snd-display #__line__ ";set vf amp: ~A" (view-files-amp dialog)))
+ (set! (view-files-speed dialog) 0.5)
+ (if (fneq (view-files-speed dialog) 0.5) (snd-display #__line__ ";set vf spd: ~A" (view-files-speed dialog)))
+ (set! (view-files-speed-style dialog) speed-control-as-ratio)
+ (if (not (= (view-files-speed-style dialog) speed-control-as-ratio))
+ (snd-display #__line__ ";vf speed-style set: ~A" (view-files-speed-style dialog)))
+ (set! (view-files-sort dialog) 2)
+ (if (not (= (view-files-sort) 0)) (snd-display #__line__ ";vf global sort after local set: ~A" (view-files-sort)))
+ (if (not (= (view-files-sort dialog) 2)) (snd-display #__line__ ";vf local sort after local set: ~A" (view-files-sort dialog)))
+ (set! (view-files-sort) 4)
+ (if (not (= (view-files-sort) 4)) (snd-display #__line__ ";vf global sort after global set: ~A" (view-files-sort)))
+ (if (not (= (view-files-sort dialog) 2)) (snd-display #__line__ ";vf local sort after global set: ~A" (view-files-sort dialog)))
+ (set! (view-files-files dialog) (list "oboe.snd" "1a.snd" "pistol.snd" "storm.snd"))
+ (let ((vf-files (view-files-files dialog)))
+ (if (or (and (not (member "1a.snd" vf-files))
+ (not (member (string-append home-dir "/cl/1a.snd") vf-files))
+ (not (member (string-append home-dir "/snd-16/1a.snd") vf-files)))
+ (and (not (member "pistol.snd" vf-files))
+ (not (member (string-append home-dir "/cl/pistol.snd") vf-files))
+ (not (member (string-append home-dir "/snd-16/pistol.snd") vf-files)))
+ (not (= (length vf-files) 4)))
+ (snd-display #__line__ ";vf files set: ~A (~A, ~A)" vf-files (string-append home-dir "/cl/1a.snd") (length vf-files))))
+ (set! (hook-functions view-files-select-hook) ())
+ (hook-push view-files-select-hook (lambda (hook)
+ (if (not (string? (hook 'name)))
+ (snd-display #__line__ ";vf select hook arg: ~A" (hook 'name)))
+ (if (not (hook 'widget)) (snd-display #__line__ ";vf select hook dialog: ~A" (hook 'widget)))
+ (set! selected-file (hook 'name))))
+ (set! (view-files-selected-files dialog) (list "1a.snd"))
+ (if (or (not (string? selected-file))
+ (and (not (equal? selected-file "1a.snd"))
+ (not (equal? selected-file (string-append home-dir "/cl/1a.snd")))
+ (not (equal? selected-file (string-append home-dir "/snd-16/1a.snd")))))
+ (snd-display #__line__ ";vf set selected select hook arg: ~A" selected-file))
+ (if (and (not (equal? (view-files-selected-files dialog) (list "1a.snd")))
+ (not (equal? (view-files-selected-files dialog) (list (string-append home-dir "/cl/1a.snd"))))
+ (not (equal? (view-files-selected-files dialog) (list (string-append home-dir "/snd-16/1a.snd")))))
+ (snd-display #__line__ ";vf selected files set: ~A" (view-files-selected-files dialog)))
+ (hide-widget dialog)
+ )))
+ (dismiss-all-dialogs)
)))
+
+
+
;;; ---------------- test 12: extensions ----------------
(define (snd_test_12)
-
+
(define (spectral-difference snd1 snd2)
- (let* ((size (max (frames snd1) (frames snd2)))
- (pow2 (ceiling (/ (log size) (log 2))))
+ (let* ((size (max (framples snd1) (framples snd2)))
+ (pow2 (ceiling (log size 2)))
(fftlen (expt 2 pow2))
- (fdr1 (channel->vct 0 fftlen snd1 0))
- (fdr2 (channel->vct 0 fftlen snd2 0)))
+ (fdr1 (channel->float-vector 0 fftlen snd1 0))
+ (fdr2 (channel->float-vector 0 fftlen snd2 0)))
(let* ((spectr1 (snd-spectrum fdr1 blackman2-window fftlen #t))
(spectr2 (snd-spectrum fdr2 blackman2-window fftlen #t))
- (diff 0.0)
- (diffs (vct-subtract! spectr1 spectr2))
- (len (vct-length diffs)))
- (do ((i 0 (+ 1 i)))
- ((= i len) diff)
- (set! diff (+ diff (abs (vct-ref diffs i))))))))
-
+ (diffs (float-vector-subtract! spectr1 spectr2))
+ (len (length diffs))
+ (incr (make-one-pole 1.0 -1.0)))
+ (float-vector-abs! diffs)
+ (do ((i 0 (+ i 1)))
+ ((= i len) (one-pole incr 0.0))
+ (one-pole incr (float-vector-ref diffs i))))))
+
(define (test-spectral-difference snd1 snd2 maxok)
(let ((s1 (open-sound snd1))
(s2 (open-sound snd2)))
@@ -30526,9 +25036,8 @@ EDITS: 2
(if (> diff maxok)
(snd-display #__line__ ";translate spectral difference ~A ~A: ~A > ~A?" snd1 snd2 diff maxok)))))
-
(define (remove-if p l)
- (cond ((null? l) '())
+ (cond ((null? l) ())
((p (car l)) (remove-if p (cdr l)))
(else (cons (car l) (remove-if p (cdr l))))))
@@ -30537,243 +25046,238 @@ EDITS: 2
(set! (sound-file-extensions) original-sound-file-extensions))
(let* ((sf-dir-files
- (if (string? sf-dir)
- (let ((good-files '()))
+ (and (string? sf-dir)
+ (let ((good-files ()))
(for-each ; omit bad headers (test cases)
(lambda (file)
(catch 'mus-error
(lambda ()
(if (and (< (mus-sound-chans (string-append sf-dir file)) 256)
(> (mus-sound-chans (string-append sf-dir file)) 0)
- (>= (mus-sound-data-format (string-append sf-dir file)) 0)
+ (>= (mus-sound-sample-type (string-append sf-dir file)) 0)
(> (mus-sound-srate (string-append sf-dir file)) 0)
- (>= (mus-sound-frames (string-append sf-dir file)) 0))
+ (>= (mus-sound-framples (string-append sf-dir file)) 0))
(set! good-files (cons file good-files))))
(lambda args
(car args))))
(sound-files-in-directory sf-dir))
- good-files)
- #f))
-
+ good-files)))
(sf-dir-len (if sf-dir-files (length sf-dir-files) 0)))
- (if with-gui
- (if (> sf-dir-len 0)
- (let ((open-files '())
- (open-ctr 0))
-
- (add-sound-file-extension "wave")
- (let ((exts (sound-file-extensions)))
- (if (not (member "wave" exts))
- (snd-display #__line__ ";sound-file-extensions: ~A" exts))
- (set! (sound-file-extensions) (list))
- (if (not (null? (sound-file-extensions)))
- (snd-display #__line__ ";sound-file-extesions set to '(): ~A" (sound-file-extensions)))
- (set! (sound-file-extensions) exts)
- (if (not (member "wave" exts))
- (snd-display #__line__ ";sound-file-extensions reset: ~A" (sound-file-extensions))))
-
- (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
- (log-mem clmtest)
-
- (do ()
- ((= open-ctr 32))
- (let* ((len (length open-files))
- (open-chance (* (- 8 len) .125))
- (close-chance (* len .125)))
- (if (or (= len 0) (> (random 1.0) .5))
- (let* ((choice (floor (random sf-dir-len)))
- (name (string-append sf-dir (list-ref sf-dir-files choice)))
- (ht (catch #t (lambda () (mus-sound-header-type name)) (lambda args 0)))
- (df (catch #t (lambda () (mus-sound-data-format name)) (lambda args 0)))
- (fd (if (or (= ht mus-raw)
- (= ht mus-unsupported)
- (= df mus-unknown))
- -1
- (or (catch #t
- (lambda () (view-sound name))
- (lambda args
- (snd-display #__line__ ";~A ~A ~A" name ht df)
- -1))
- -1))))
- (if (not (equal? fd -1))
- (begin
- (set! open-ctr (+ open-ctr 1))
- (set! open-files (cons fd open-files)))))
- (if (and (> len 0) (> (random 1.0) 0.3))
- (let* ((choice (floor (random (exact->inexact (length open-files)))))
- (fd (list-ref open-files choice)))
- (close-sound fd)
- (set! open-files (remove-if (lambda (a) (equal? a fd)) open-files)))))))
- (if open-files (for-each close-sound open-files))
- (set! open-files '())
-
- (if (not (= (length (sounds)) 0)) (snd-display #__line__ ";active-sounds: ~A ~A?" (sounds) (map short-file-name (sounds))))
- (let ((fd (open-raw-sound :file (string-append sf-dir "addf8.nh") :channels 1 :srate 8012 :data-format mus-mulaw)))
- (if (not (= (data-format fd) mus-mulaw)) (snd-display #__line__ ";open-raw-sound: ~A?" (mus-data-format-name (data-format fd))))
- (close-sound fd))
-
- (set! (hook-functions bad-header-hook) '())
- (time (test-spectral-difference "oboe.snd" (string-append sf-dir "oboe.g723_24") 20.0))
- (test-spectral-difference "oboe.snd" (string-append sf-dir "oboe.g723_40") 3.0)
- (test-spectral-difference "oboe.snd" (string-append sf-dir "oboe.g721") 6.0)
- (test-spectral-difference (string-append sf-dir "o2.wave") (string-append sf-dir "o2_dvi.wave") 10.0)
- (test-spectral-difference (string-append sf-dir "wood.riff") (string-append sf-dir "wood.sds") 4.0)
- (test-spectral-difference (string-append sf-dir "nist-10.wav") (string-append sf-dir "nist-shortpack.wav") 1.0)
- (hook-push bad-header-hook (lambda (n) #t))
-
- ;; dangling readers (overall)
- (let ((ind (open-sound "oboe.snd")))
- (let ((hi (make-sampler 0 ind 0)))
- (close-sound ind)
- (if (not (sampler? hi)) (snd-display #__line__ ";dangling reader? ~A" hi))
- (let ((name (format #f "~A" hi)))
- (if (not (string? name)) (snd-display #__line__ ";dangling reader format: ~A" name)))
- (let* ((val (hi))
- (val1 (next-sample hi))
- (val2 (previous-sample hi))
- (val3 (read-sample hi)))
- (if (or (fneq val 0.0) (fneq val1 0.0) (fneq val2 0.0) (fneq val3 0.0))
- (snd-display #__line__ ";dangling read: ~A ~A ~A ~A" val val1 val2 val3))
- (if (sampler-home hi) (snd-display #__line__ ";dangling reader home: ~A" (sampler-home hi)))
- (if (not (= (sampler-position hi) 0)) (snd-display #__line__ ";dangling sampler-position: ~A" (sampler-position hi)))
- (if (not (sampler-at-end? hi)) (snd-display #__line__ ";dangling reader eof: ~A" (sampler-at-end? hi)))
- (free-sampler hi))))
- ;; same (pruned edit)
- (let ((ind (open-sound "oboe.snd")))
- (delete-samples 100 100)
- (let ((hi (make-sampler 0 ind 0)))
- (revert-sound)
- (delete-samples 100 100)
- (if (not (sampler? hi)) (snd-display #__line__ ";pruned dangling reader? ~A" hi))
- (let ((name (format #f "~A" hi)))
- (if (not (string? name)) (snd-display #__line__ ";pruned dangling reader format: ~A" name)))
- (let* ((val (hi))
- (val1 (next-sample hi))
- (val2 (previous-sample hi))
- (val3 (read-sample hi)))
- (if (or (fneq val 0.0) (fneq val1 0.0) (fneq val2 0.0) (fneq val3 0.0))
- (snd-display #__line__ ";pruned dangling read: ~A ~A ~A ~A" val val1 val2 val3))
- (if (not (equal? (sampler-home hi) (list ind 0))) (snd-display #__line__ ";pruned dangling reader home: ~A" (sampler-home hi)))
- (if (not (sampler-at-end? hi)) (snd-display #__line__ ";pruned dangling reader eof: ~A" (sampler-at-end? hi)))
- (free-sampler hi)))
- (close-sound ind))
+ (if (and with-gui
+ (> sf-dir-len 0))
+ (let ((open-files ())
+ (open-ctr 0))
+
+ (add-sound-file-extension "wave")
+ (let ((exts (sound-file-extensions)))
+ (if (not (member "wave" exts))
+ (snd-display #__line__ ";sound-file-extensions: ~A" exts))
+ (set! (sound-file-extensions) (list))
+ (if (pair? (sound-file-extensions))
+ (snd-display #__line__ ";sound-file-extesions set to (): ~A" (sound-file-extensions)))
+ (set! (sound-file-extensions) exts)
+ (if (not (member "wave" exts))
+ (snd-display #__line__ ";sound-file-extensions reset: ~A" (sound-file-extensions))))
+
+ (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
+ (log-mem clmtest)
+
+ (do ()
+ ((= open-ctr 32))
+ (let ((len (length open-files)))
+ (if (or (= len 0) (> (random 1.0) .5))
+ (let* ((choice (floor (random sf-dir-len)))
+ (name (string-append sf-dir (sf-dir-files choice)))
+ (ht (catch #t (lambda () (mus-sound-header-type name)) (lambda args 0)))
+ (df (catch #t (lambda () (mus-sound-sample-type name)) (lambda args 0)))
+ (fd (if (or (= ht mus-raw)
+ (= ht mus-unknown-header)
+ (= df mus-unknown-sample))
+ -1
+ (or (catch #t
+ (lambda () (view-sound name))
+ (lambda args
+ (snd-display #__line__ ";~A ~A ~A" name ht df)
+ -1))
+ -1))))
+ (if (not (eqv? fd -1))
+ (begin
+ (set! open-ctr (+ open-ctr 1))
+ (set! open-files (cons fd open-files)))))
+ (if (and (> len 0) (> (random 1.0) 0.3))
+ (let* ((choice (floor (random (* 1.0 (length open-files)))))
+ (fd (open-files choice)))
+ (close-sound fd)
+ (set! open-files (remove-if (lambda (a) (equal? a fd)) open-files)))))))
+ (if open-files (for-each close-sound open-files))
+ (set! open-files ())
+
+ (if (not (= (length (sounds)) 0)) (snd-display #__line__ ";active-sounds: ~A ~A?" (sounds) (map short-file-name (sounds))))
+ (let ((fd (open-raw-sound :file (string-append sf-dir "addf8.nh") :channels 1 :srate 8012 :sample-type mus-mulaw)))
+ (if (not (= (sample-type fd) mus-mulaw)) (snd-display #__line__ ";open-raw-sound: ~A?" (mus-sample-type-name (sample-type fd))))
+ (close-sound fd))
+
+ (set! (hook-functions bad-header-hook) ())
+ ; (time (test-spectral-difference "oboe.snd" (string-append sf-dir "oboe.g723_24") 20.0))
+ ; (test-spectral-difference "oboe.snd" (string-append sf-dir "oboe.g723_40") 3.0)
+ ; (test-spectral-difference "oboe.snd" (string-append sf-dir "oboe.g721") 6.0)
+ (test-spectral-difference (string-append sf-dir "o2.wave") (string-append sf-dir "o2_dvi.wave") 10.0)
+ (test-spectral-difference (string-append sf-dir "wood.riff") (string-append sf-dir "wood.sds") 4.0)
+ (test-spectral-difference (string-append sf-dir "nist-10.wav") (string-append sf-dir "nist-shortpack.wav") 1.0)
+ (hook-push bad-header-hook (lambda (hook) (set! (hook 'result) #t)))
+
+ ;; dangling readers (overall)
+ (let ((ind (open-sound "oboe.snd")))
+ (let ((hi (make-sampler 0 ind 0)))
+ (close-sound ind)
+ (if (not (sampler? hi)) (snd-display #__line__ ";dangling reader? ~A" hi))
+ (let ((name (format #f "~A" hi)))
+ (if (not (string? name)) (snd-display #__line__ ";dangling reader format: ~A" name)))
+ (let ((val (hi))
+ (val1 (next-sample hi))
+ (val2 (previous-sample hi))
+ (val3 (read-sample hi)))
+ (if (or (fneq val 0.0) (fneq val1 0.0) (fneq val2 0.0) (fneq val3 0.0))
+ (snd-display #__line__ ";dangling read: ~A ~A ~A ~A" val val1 val2 val3))
+ (if (sampler-home hi) (snd-display #__line__ ";dangling reader home: ~A" (sampler-home hi)))
+ (if (not (= (sampler-position hi) 0)) (snd-display #__line__ ";dangling sampler-position: ~A" (sampler-position hi)))
+ (if (not (sampler-at-end? hi)) (snd-display #__line__ ";dangling reader eof: ~A" (sampler-at-end? hi)))
+ (free-sampler hi))))
+ ;; same (pruned edit)
+ (let ((ind (open-sound "oboe.snd")))
+ (delete-samples 100 100)
+ (let ((hi (make-sampler 0 ind 0)))
+ (revert-sound)
+ (delete-samples 100 100)
+ (if (not (sampler? hi)) (snd-display #__line__ ";pruned dangling reader? ~A" hi))
+ (let ((name (format #f "~A" hi)))
+ (if (not (string? name)) (snd-display #__line__ ";pruned dangling reader format: ~A" name)))
+ (let ((val (hi))
+ (val1 (next-sample hi))
+ (val2 (previous-sample hi))
+ (val3 (read-sample hi)))
+ (if (or (fneq val 0.0) (fneq val1 0.0) (fneq val2 0.0) (fneq val3 0.0))
+ (snd-display #__line__ ";pruned dangling read: ~A ~A ~A ~A" val val1 val2 val3))
+ (if (not (equal? (sampler-home hi) (list ind 0))) (snd-display #__line__ ";pruned dangling reader home: ~A" (sampler-home hi)))
+ (if (not (sampler-at-end? hi)) (snd-display #__line__ ";pruned dangling reader eof: ~A" (sampler-at-end? hi)))
+ (free-sampler hi)))
+ (close-sound ind))
+
+ ;; region reader
+ (let ((ind (open-sound "2.snd")))
+ (set! (sync ind) 1)
+ (let ((reg (make-region 90 220 ind #t)))
+ (if (not (= (region-framples reg) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region framples: ~A" (region-framples reg)))
+ (if (not (= (region-chans reg) 2)) (snd-display #__line__ ";make-region chans: ~A" (region-chans reg)))
+ (if (not (= (region-framples reg 0) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region framples[0]: ~A" (region-framples reg 0)))
+ (if (not (= (region-framples reg 1) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region framples[1]: ~A" (region-framples reg 1)))
+ (if (not (= (region-position reg 0) 90)) (snd-display #__line__ ";make-region position[0]: ~A" (region-position reg 0)))
+ (if (not (= (region-position reg 1) 90)) (snd-display #__line__ ";make-region position[1]: ~A" (region-position reg 1)))
+ (if (not (= (region-position reg) 90)) (snd-display #__line__ ";make-region position[]: ~A" (region-position reg)))
- ;; region reader
- (let ((ind (open-sound "2.snd")))
- (set! (sync ind) 1)
- (let ((reg (make-region 90 220 ind #t)))
- (if (not (= (region-frames reg) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region frames: ~A" (region-frames reg)))
- (if (not (= (region-chans reg) 2)) (snd-display #__line__ ";make-region chans: ~A" (region-chans reg)))
- (if (not (= (region-frames reg 0) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region frames[0]: ~A" (region-frames reg 0)))
- (if (not (= (region-frames reg 1) (+ 1 (- 220 90)))) (snd-display #__line__ ";make-region frames[1]: ~A" (region-frames reg 1)))
- (if (not (= (region-position reg 0) 90)) (snd-display #__line__ ";make-region position[0]: ~A" (region-position reg 0)))
- (if (not (= (region-position reg 1) 90)) (snd-display #__line__ ";make-region position[1]: ~A" (region-position reg 1)))
- (if (not (= (region-position reg) 90)) (snd-display #__line__ ";make-region position[]: ~A" (region-position reg)))
-
- ;; beg = 0, chan 2 not highlighted
-
- (let ((rd1 (make-region-sampler reg 0 0))
- (rd2 (make-region-sampler reg 100 1)))
- (let ((rd11 (copy-sampler rd1))
- (rd22 (copy-sampler rd2)))
- (if (or (not (region-sampler? rd11)) (not (region-sampler? rd22)))
- (snd-display #__line__ ";copy-sampler (region): ~A ~A" rd11 rd22))
- (if (or (mix-sampler? rd11) (mix-sampler? rd22)
- (sampler? rd11) (sampler? rd22))
- (snd-display #__line__ ";copy (region) sampler-p trouble: ~A ~A ~A ~A ~A ~A"
- (mix-sampler? rd11) (mix-sampler? rd22)
- (sampler? rd11) (sampler? rd22)))
- (if (or (not (equal? (sampler-home rd11) (list reg 0)))
- (not (equal? (sampler-home rd22) (list reg 1))))
- (snd-display #__line__ ";copy region reader home: ~A ~A" (sampler-home rd11) (sampler-home rd22)))
- (if (or (sampler-at-end? rd11) (sampler-at-end? rd22))
- (snd-display #__line__ ";copy region reader end?: ~A ~A" (sampler-at-end? rd11) (sampler-at-end? rd22)))
- (if (or (not (= (sampler-position rd11) (sampler-position rd1) 0))
- (not (= (sampler-position rd22) (sampler-position rd2) 100)))
- (snd-display #__line__ ";copy region reader position: ~A ~A ~A ~A"
- (sampler-position rd11) (sampler-position rd1)
- (sampler-position rd22) (sampler-position rd2)))
- (free-sampler rd1)
- (free-sampler rd11))))
- (close-sound ind))
+ ;; beg = 0, chan 2 not highlighted
- (let* ((ind (open-sound "oboe.snd"))
- (reg (make-region 1000 2000 ind 0))
- (rd (make-region-sampler reg 0)))
- (if (mix-sampler? rd) (snd-display #__line__ ";region sampler: mix ~A" rd))
- (if (not (region-sampler? rd)) (snd-display #__line__ ";region sampler: region ~A" rd))
- (if (sampler? rd) (snd-display #__line__ ";region sampler: normal ~A" rd))
+ (let ((rd1 (make-region-sampler reg 0 0))
+ (rd2 (make-region-sampler reg 100 1)))
+ (let ((rd11 (copy-sampler rd1))
+ (rd22 (copy-sampler rd2)))
+ (if (or (not (region-sampler? rd11)) (not (region-sampler? rd22)))
+ (snd-display #__line__ ";copy-sampler (region): ~A ~A" rd11 rd22))
+ (if (or (mix-sampler? rd11) (mix-sampler? rd22)
+ (sampler? rd11) (sampler? rd22))
+ (snd-display #__line__ ";copy (region) sampler-p trouble: ~A ~A ~A ~A"
+ (mix-sampler? rd11) (mix-sampler? rd22)
+ (sampler? rd11) (sampler? rd22)))
+ (if (or (not (equal? (sampler-home rd11) (list reg 0)))
+ (not (equal? (sampler-home rd22) (list reg 1))))
+ (snd-display #__line__ ";copy region reader home: ~A ~A" (sampler-home rd11) (sampler-home rd22)))
+ (if (or (sampler-at-end? rd11) (sampler-at-end? rd22))
+ (snd-display #__line__ ";copy region reader end?: ~A ~A" (sampler-at-end? rd11) (sampler-at-end? rd22)))
+ (if (or (not (= (sampler-position rd11) (sampler-position rd1) 0))
+ (not (= (sampler-position rd22) (sampler-position rd2) 100)))
+ (snd-display #__line__ ";copy region reader position: ~A ~A ~A ~A"
+ (sampler-position rd11) (sampler-position rd1)
+ (sampler-position rd22) (sampler-position rd2)))
+ (free-sampler rd1)
+ (free-sampler rd11))))
+ (close-sound ind))
+
+ (let* ((ind (open-sound "oboe.snd"))
+ (reg (make-region 1000 2000 ind 0))
+ (rd (make-region-sampler reg 0)))
+ (if (mix-sampler? rd) (snd-display #__line__ ";region sampler: mix ~A" rd))
+ (if (not (region-sampler? rd)) (snd-display #__line__ ";region sampler: region ~A" rd))
+ (if (sampler? rd) (snd-display #__line__ ";region sampler: normal ~A" rd))
;(if (not (= (sampler-position rd) 0)) (snd-display #__line__ ";region sampler position: ~A" (sampler-position rd)))
- (if (not (equal? (sampler-home rd) (list reg 0))) (snd-display #__line__ ";region sampler home: ~A" (sampler-home rd)))
- (if (sampler-at-end? rd) (snd-display #__line__ ";region sampler at end?: ~A" (sampler-at-end? rd)))
- (let ((val (rd)))
- (if (fneq val .0328) (snd-display #__line__ ";region-sampler at start: ~A" val))
- (if (not (string? (format #f "~A" rd))) (snd-display #__line__ ";region-sampler: ~A" (format #f "~A" rd)))
- (close-sound ind)
- (forget-region reg)
- (set! val (read-sample rd))
- (if (fneq val 0.0) (snd-display #__line__ ";region-sampler at end: ~A" val))
- (if (not (sampler-at-end? rd)) (snd-display #__line__ ";region-sampler after deletion?"))
- (free-sampler rd)))
-
- ;; mix reader
- (let ((save-md 0))
- (mix-click-sets-amp)
- (let* ((ind (open-sound "oboe.snd"))
- (reg (make-region 1000 2000 ind 0))
- (md (car (mix-region reg 0 ind 0 0)))
- (rd (make-mix-sampler md)))
- (set! (mix-property :hi md) "hi")
- (set! save-md md)
- (if (not (string=? (mix-property :hi md) "hi")) (snd-display #__line__ ";mix(9)-property: ~A" (mix-property :hi md)))
- (let ((val (rd)))
- (if (fneq val .0328) (snd-display #__line__ ";mix-sampler at start: ~A" val))
- (if (not (string? (format #f "~A" rd))) (snd-display #__line__ ";mix-sampler: ~A" (format #f "~A" rd)))
- (close-sound ind)
- (let ((tag (catch #t
- (lambda () (mix-property :hi md))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-mix)) (snd-display #__line__ ";mix-property bad mix: ~A" tag)))
- (let ((str (format #f "~A" rd)))
- (if (not (string=? str "#<mix-sampler: inactive>")) (snd-display #__line__ ";mix-sampler released: ~A" str))
- (free-sampler rd)))))
- (set! (hook-functions mix-click-hook) '())
- (set! (hook-functions close-hook) '())
-
- (let ((sfiles '())
- (ffiles '()))
- (for-each-sound-file
- (lambda (file)
- (if (> (mus-sound-chans file) 16)
- (set! ffiles (cons file ffiles)))))
- (map-sound-files
- (lambda (file)
- (if (> (mus-sound-chans file) 16)
- (set! sfiles (cons file sfiles)))))
- (if (and (file-exists? "s24.snd")
- (or (not (equal? ffiles (list "s24.snd")))
- (not (equal? sfiles (list "s24.snd")))))
- (snd-display #__line__ ";map|for-each-sound-file(s): ~A ~A" ffiles sfiles)))
- )
+ (if (not (equal? (sampler-home rd) (list reg 0))) (snd-display #__line__ ";region sampler home: ~A" (sampler-home rd)))
+ (if (sampler-at-end? rd) (snd-display #__line__ ";region sampler at end?: ~A" (sampler-at-end? rd)))
+ (let ((val (rd)))
+ (if (fneq val .0328) (snd-display #__line__ ";region-sampler at start: ~A" val))
+ (if (not (string? (format #f "~A" rd))) (snd-display #__line__ ";region-sampler: ~A" (format #f "~A" rd)))
+ (close-sound ind)
+ (forget-region reg)
+ (set! val (read-sample rd))
+ (if (fneq val 0.0) (snd-display #__line__ ";region-sampler at end: ~A" val))
+ (if (not (sampler-at-end? rd)) (snd-display #__line__ ";region-sampler after deletion?"))
+ (free-sampler rd)))
+
+ ;; mix reader
+ (let ()
+ (mix-click-sets-amp)
+ (let* ((ind (open-sound "oboe.snd"))
+ (reg (make-region 1000 2000 ind 0))
+ (md (car (mix-region reg 0 ind 0 0)))
+ (rd (make-mix-sampler md)))
+ (set! (mix-property :hi md) "hi")
+ (if (not (string=? (mix-property :hi md) "hi")) (snd-display #__line__ ";mix(9)-property: ~A" (mix-property :hi md)))
+ (let ((val (rd)))
+ (if (fneq val .0328) (snd-display #__line__ ";mix-sampler at start: ~A" val))
+ (if (not (string? (format #f "~A" rd))) (snd-display #__line__ ";mix-sampler: ~A" (format #f "~A" rd)))
+ (close-sound ind)
+ (let ((tag (catch #t
+ (lambda () (mix-property :hi md))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-mix)) (snd-display #__line__ ";mix-property bad mix: ~A" tag)))
+ (let ((str (format #f "~A" rd)))
+ (if (not (string=? str "#<mix-sampler: inactive>")) (snd-display #__line__ ";mix-sampler released: ~A" str))
+ (free-sampler rd)))))
+ (set! (hook-functions mix-click-hook) ())
+ (set! (hook-functions close-hook) ())
+
+ (let ((sfiles ())
+ (ffiles ()))
+ (for-each-sound-file
+ (lambda (file)
+ (if (> (mus-sound-chans file) 16)
+ (set! ffiles (cons file ffiles)))))
+ (map-sound-files
+ (lambda (file)
+ (if (> (mus-sound-chans file) 16)
+ (set! sfiles (cons file sfiles)))))
+ (if (and (file-exists? "s24.snd")
+ (or (not (equal? ffiles (list "s24.snd")))
+ (not (equal? sfiles (list "s24.snd")))))
+ (snd-display #__line__ ";map|for-each-sound-file(s): ~A ~A" ffiles sfiles)))
+ )
; (if sf-dir-files
; (for-each (lambda (n) (mus-sound-forget (string-append sf-dir n))) sf-dir-files))
-
- )))))
+
+ ))))
;;; ---------------- test 13: menus, edit lists, hooks, etc ----------------
-(if (and (provided? 'snd-motif) (provided? 'xm)) (if (not (provided? 'snd-effects-utils.scm)) (load "effects-utils.scm")))
-(if (and (provided? 'snd-motif) (provided? 'xm)) (if (not (provided? 'snd-new-effects.scm)) (load "new-effects.scm")))
-(if (and (provided? 'snd-gtk) (provided? 'xg)) (if (not (provided? 'snd-gtk-effects.scm)) (load "gtk-effects.scm")))
+(if (and (provided? 'snd-motif) (provided? 'xm) (not (provided? 'snd-effects-utils.scm))) (load "effects-utils.scm"))
+(if (and (provided? 'snd-motif) (provided? 'xm) (not (provided? 'snd-new-effects.scm))) (load "new-effects.scm"))
+(if (and (provided? 'snd-gtk) (provided? 'xg) (not (provided? 'snd-gtk-effects.scm))) (load "gtk-effects.scm"))
(if (provided? 'snd-ladspa)
(define (analyze-ladspa library label)
(let* ((descriptor (ladspa-descriptor library label))
- (data '())
+ (data ())
(names (.PortNames descriptor))
(hints (.PortRangeHints descriptor))
(descriptors (.PortDescriptors descriptor))
@@ -30784,7 +25288,7 @@ EDITS: 2
(lambda (port ranges port-name)
(if (and (not (= (logand port LADSPA_PORT_CONTROL) 0))
(not (= (logand port LADSPA_PORT_INPUT) 0)))
- (let ((ldata '())
+ (let ((ldata ())
(hint (car ranges))
(lo (cadr ranges))
(hi (caddr ranges)))
@@ -30793,13 +25297,9 @@ EDITS: 2
(if (not (= (logand hint LADSPA_HINT_INTEGER) 0)) (set! ldata (cons "integer" ldata)))
(if (not (= (logand hint LADSPA_HINT_SAMPLE_RATE) 0)) (set! ldata (cons "sample_rate" ldata)))
(if (not (= (logand hint LADSPA_HINT_BOUNDED_ABOVE) 0))
- (begin
- (set! ldata (cons hi ldata))
- (set! ldata (cons "maximum" ldata))))
+ (set! ldata (cons "maximum" (cons hi ldata))))
(if (not (= (logand hint LADSPA_HINT_BOUNDED_BELOW) 0) )
- (begin
- (set! ldata (cons lo ldata))
- (set! ldata (cons "minimum" ldata))))
+ (set! ldata (cons "minimum" (cons lo ldata))))
(set! ldata (cons port-name ldata))
(set! data (cons ldata data)))))
descriptors hints names)
@@ -30812,11 +25312,9 @@ EDITS: 2
(let* ((descriptor (ladspa-descriptor library label))
(handle (ladspa-instantiate descriptor (srate)))
(block-size 256)
- (in-block (make-vct block-size))
- (out-block (make-vct block-size))
- (len (frames))
- (data (make-sound-data 1 block-size))
- (audio-port (mus-audio-open-output 0 (srate) 1 mus-lshort (* block-size 2)))
+ (in-block (make-float-vector block-size))
+ (out-block (make-float-vector block-size))
+ (len (framples))
(ra (ladspa-run-adding descriptor handle block-size)))
(if ra (snd-display #__line__ ";ladspa-run-adding: ~A" ra))
(ladspa-set-run-adding-gain descriptor handle block-size)
@@ -30826,7 +25324,7 @@ EDITS: 2
(for-each
(lambda (port)
(if (not (= (logand port LADSPA_PORT_CONTROL) 0))
- (let ((parameter (make-vct 1 (car plugin-parameters))))
+ (let ((parameter (make-float-vector 1 (car plugin-parameters))))
(set! plugin-parameters (cdr plugin-parameters))
(ladspa-connect-port descriptor handle count parameter))
(if (not (= (logand port LADSPA_PORT_INPUT) 0))
@@ -30840,149 +25338,52 @@ EDITS: 2
(lambda ()
(do ((i 0 (+ i block-size)))
((>= i len))
- (set! in-block (channel->vct i block-size))
+ (set! in-block (channel->float-vector i block-size))
(ladspa-run descriptor handle block-size)
- (vct->sound-data out-block data 0)
- (mus-audio-write audio-port data block-size)))
+ ;; here do something with the data
+ ))
(lambda args (snd-display #__line__ ";ladspa-it: ~A" args))))
(lambda ()
(ladspa-deactivate descriptor handle)
- (mus-audio-close audio-port)
(ladspa-cleanup descriptor handle))))))
-(defmacro carg0 (hook)
- `(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions ,hook)))))))
- (if (not (string=? str "((lambda () 32))"))
- (snd-display #__line__ ";~A: ~A?" ',hook str))))
-
-(defmacro carg1 (hook)
- `(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions ,hook)))))))
- (if (not (string=? str "((lambda (n) (if (number? n) (+ n 32) n)))"))
- (snd-display #__line__ ";~A: ~A?" ',hook str))))
-
-(defmacro carg2 (hook)
- `(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions ,hook)))))))
- (if (not (string=? str "((lambda (n m) (if (and (number? n) (number? m)) (+ n m 32) n)))"))
- (snd-display #__line__ ";~A: ~A?" ',hook str))))
-
-(defmacro carg3 (hook)
- `(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions ,hook)))))))
- (if (not (string=? str "((lambda (a b c) (if (and (number? a) (number? b) (number? c)) (+ a b c 32) a)))"))
- (snd-display #__line__ ";~A: ~A?" ',hook str))))
-
-(defmacro carg4 (hook)
- `(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions ,hook)))))))
- (if (not (string=? str "((lambda (a b c d) (if (and (number? a) (number? b) (number? c) (number? d)) (+ a b c 32) a)))"))
- (snd-display #__line__ ";~A: ~A?" ',hook str))))
-
-(defmacro carg5 (hook)
- `(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions ,hook)))))))
- (if (not (string=? str "((lambda (a b c d e) (list 0 0 1 1)))"))
- (snd-display #__line__ ";~A: ~A?" ',hook str))))
-
-(defmacro carg6 (hook)
- `(let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions ,hook)))))))
- (if (not (string=? str "((lambda (a b c d e f) (if (and (number? a) (number? b) (number? c) (number? d) (number? e)) (+ a b c d e f 32) a)))"))
- (snd-display #__line__ ";~A: ~A?" ',hook str))))
-
(define ladspa_inited #f)
(define clm_buffer_added #f)
(define (snd_test_13)
(define (test-hooks)
- (define (arg0) 32)
- (define (arg1 n) (if (number? n) (+ n 32) n))
- (define (arg2 n m) (if (and (number? n) (number? m)) (+ n m 32) n))
- (define (arg3 a b c) (if (and (number? a) (number? b) (number? c)) (+ a b c 32) a))
- (define (arg4 a b c d) (if (and (number? a) (number? b) (number? c) (number? d)) (+ a b c 32) a))
- (define (arg5 a b c d e) (list 0 0 1 1))
- (define (arg6 a b c d e f) (if (and (number? a) (number? b) (number? c) (number? d) (number? e)) (+ a b c d e f 32) a))
- (reset-almost-all-hooks)
-
- (hook-push after-graph-hook arg2) (carg2 after-graph-hook)
- (hook-push after-lisp-graph-hook arg2) (carg2 after-lisp-graph-hook)
- (hook-push lisp-graph-hook arg2) (carg2 lisp-graph-hook)
- (hook-push before-transform-hook arg2) (carg2 before-transform-hook)
- (hook-push mix-release-hook arg2) (carg2 mix-release-hook)
- (hook-push save-hook arg2) (carg2 save-hook)
- (hook-push mus-error-hook arg2) (carg2 mus-error-hook)
- (hook-push mouse-enter-graph-hook arg2) (carg2 mouse-enter-graph-hook)
- (hook-push mouse-leave-graph-hook arg2) (carg2 mouse-leave-graph-hook)
- (hook-push open-raw-sound-hook arg2) (carg2 open-raw-sound-hook)
- (hook-push select-channel-hook arg2) (carg2 select-channel-hook)
- (hook-push help-hook arg2) (carg2 help-hook)
- (hook-push view-files-select-hook arg2) (carg2 view-files-select-hook)
- (hook-push peak-env-hook arg2) (carg2 peak-env-hook)
-
- (hook-push save-state-hook arg1) (carg1 save-state-hook)
- (hook-push new-sound-hook arg1) (carg1 new-sound-hook)
- (hook-push after-open-hook arg1) (carg1 after-open-hook)
- (hook-push update-hook arg1) (carg1 update-hook)
- (hook-push close-hook arg1) (carg1 close-hook)
- (hook-push before-close-hook arg1) (carg1 before-close-hook)
- (hook-push clip-hook arg1) (carg1 clip-hook)
- (hook-push draw-mark-hook arg1) (carg1 draw-mark-hook)
- (hook-push drop-hook arg1) (carg1 drop-hook)
- (hook-push mark-click-hook arg1) (carg1 mark-click-hook)
- (hook-push listener-click-hook arg1) (carg1 listener-click-hook)
- (hook-push mix-click-hook arg1) (carg1 mix-click-hook)
- (hook-push after-save-state-hook arg1) (carg1 after-save-state-hook)
- (hook-push before-save-state-hook arg1) (carg1 before-save-state-hook)
- (hook-push mark-drag-hook arg1) (carg1 mark-drag-hook)
- (hook-push name-click-hook arg1) (carg1 name-click-hook)
- (hook-push after-apply-controls-hook arg1) (carg1 after-apply-controls-hook)
- (hook-push open-hook arg1) (carg1 open-hook)
- (hook-push output-comment-hook arg1) (carg1 output-comment-hook)
- (hook-push play-hook arg1) (carg1 play-hook)
- (hook-push dac-hook arg1) (carg1 dac-hook)
- (hook-push new-widget-hook arg1) (carg1 new-widget-hook)
- (hook-push snd-error-hook arg1) (carg1 snd-error-hook)
- (hook-push snd-warning-hook arg1) (carg1 snd-warning-hook)
- (hook-push start-hook arg1) (carg1 start-hook)
- (hook-push start-playing-hook arg1) (carg1 start-playing-hook)
- (hook-push stop-playing-hook arg1) (carg1 stop-playing-hook)
- (hook-push mouse-enter-listener-hook arg1) (carg1 mouse-enter-listener-hook)
- (hook-push mouse-leave-listener-hook arg1) (carg1 mouse-leave-listener-hook)
- (hook-push select-sound-hook arg1) (carg1 select-sound-hook)
- (hook-push print-hook arg1) (carg1 print-hook)
- (hook-push read-hook arg1) (carg1 read-hook)
- (hook-push bad-header-hook arg1) (carg1 bad-header-hook)
- (hook-push output-name-hook arg1) (carg1 output-name-hook)
-
- (hook-push before-exit-hook arg0) (carg0 before-exit-hook)
- (hook-push exit-hook arg0) (carg0 exit-hook)
- (hook-push stop-dac-hook arg0) (carg0 stop-dac-hook)
- (hook-push stop-playing-selection-hook arg0) (carg0 stop-playing-selection-hook)
- (hook-push color-hook arg0) (carg0 color-hook)
- (hook-push orientation-hook arg0) (carg0 orientation-hook)
- (hook-push start-playing-selection-hook arg0) (carg0 start-playing-selection-hook)
-
- (hook-push during-open-hook arg3) (carg3 during-open-hook)
- (hook-push after-transform-hook arg3) (carg3 after-transform-hook)
- (hook-push mouse-enter-label-hook arg3) (carg3 mouse-enter-label-hook)
- (hook-push mouse-leave-label-hook arg3) (carg3 mouse-leave-label-hook)
- (hook-push initial-graph-hook arg3) (carg3 initial-graph-hook)
- (hook-push after-save-as-hook arg3) (carg3 after-save-as-hook)
- (hook-push mix-drag-hook arg3) (carg3 mix-drag-hook)
-
- (hook-push graph-hook arg4) (carg4 graph-hook)
- (hook-push key-press-hook arg4) (carg4 key-press-hook)
- (hook-push mark-hook arg4) (carg4 mark-hook)
-
- (hook-push mouse-drag-hook arg6) (carg6 mouse-drag-hook)
- (hook-push mouse-press-hook arg6) (carg6 mouse-press-hook)
-
- (hook-push enved-hook arg5) (carg5 enved-hook)
- (hook-push draw-mix-hook arg5) (carg5 draw-mix-hook)
-
- (reset-almost-all-hooks)
+ (define (arg0 hook) (set! (hook 'result) 32))
+ (define (arg1 hook) (let ((n (hook (car (hook 'args))))) (set! (hook 'result) (if (number? n) (+ n 32) n))))
+ (define (arg2 hook) (let ((n (hook (car (hook 'args)))) (m (hook (cadr (hook 'args))))) (set! (hook 'result) (if (and (number? n) (number? m)) (+ n m 32) n))))
+ (define (arg3 hook)
+ (let ((a (hook (list-ref (hook 'args) 0)))
+ (b (hook (list-ref (hook 'args) 1)))
+ (c (hook (list-ref (hook 'args) 2))))
+ (set! (hook 'result) (if (and (number? a) (number? b) (number? c)) (+ a b c 32) a))))
+ (define (arg4 hook)
+ (let ((a (hook (list-ref (hook 'args) 0)))
+ (b (hook (list-ref (hook 'args) 1)))
+ (c (hook (list-ref (hook 'args) 2)))
+ (d (hook (list-ref (hook 'args) 3))))
+ (set! (hook 'result) (if (and (number? a) (number? b) (number? c) (number? d)) (+ a b c 32) a))))
+ (define (arg5 hook)
+ (set! (hook 'result) (list 0 0 1 1)))
+ (define (arg6 hook)
+ (let ((a (hook (list-ref (hook 'args) 0)))
+ (b (hook (list-ref (hook 'args) 1)))
+ (c (hook (list-ref (hook 'args) 2)))
+ (d (hook (list-ref (hook 'args) 3)))
+ (e (hook (list-ref (hook 'args) 4)))
+ (f (hook (list-ref (hook 'args) 5))))
+ (set! (hook 'result) (if (and (number? a) (number? b) (number? c) (number? d) (number? e)) (+ a b c d e f 32) a))))
+ (reset-all-hooks)
+
(for-each
(lambda (n)
- (if (and (not (null? (hook-functions n)))
- (not (eq? n optimization-hook)))
+ (if (pair? (hook-functions n))
(snd-display #__line__ ";~A not empty?" n)))
(snd-hooks))
@@ -30993,156 +25394,145 @@ EDITS: 2
(for-each-child
(car (menu-widgets))
(lambda (w)
- (if (not (XmIsRowColumn w))
- (let ((option-holder (cadr (XtGetValues w (list XmNsubMenuId 0)))))
+ (if (not ((*motif* 'XmIsRowColumn) w))
+ (let ((option-holder (cadr ((*motif* 'XtGetValues) w (list (*motif* 'XmNsubMenuId) 0)))))
(for-each-child
option-holder
(lambda (menu)
- (if (and (XmIsPushButton menu)
- (XtIsManaged menu)
- (XtIsSensitive menu)
- (not (member (XtName menu)
+ (if (and ((*motif* 'XmIsPushButton) menu)
+ ((*motif* 'XtIsManaged) menu)
+ ((*motif* 'XtIsSensitive) menu)
+ (not (member ((*motif* 'XtName) menu)
(list "Exit" "New"
"Save C-x C-s"
"Close C-x k"
"Close all"
- "Save options"
- "Record"
+ "Save current settings"
"Mixes" "clm" "fm-violin"))))
- (XtCallCallbacks menu XmNactivateCallback (snd-global-state)))))))))
- (for-each close-sound (sounds))
- (dismiss-all-dialogs)))
+ ((*motif* 'XtCallCallbacks) menu (*motif* 'XmNactivateCallback) (snd-global-state))))))))))
+ (for-each close-sound (sounds))
+ (dismiss-all-dialogs))
(define (mdt-test id x time drg) #f)
- (reset-almost-all-hooks)
-
+ (reset-all-hooks)
+
(let ((fd (view-sound "oboe.snd")))
- (let ((mb #f))
- (if (not clm_buffer_added)
- (set! mb (add-to-main-menu "clm")))
-
- (let ((var (catch #t (lambda () (add-to-menu -1 "fm-violin" (lambda () #f))) (lambda args args))))
- (if (not (eq? (car var) 'no-such-menu))
- (snd-display #__line__ ";add-to-menu bad menu: ~A" var)))
-
- (let ((tag (catch #t (lambda () (add-to-main-menu "oops" (make-delay 11)))
- (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity))
- (snd-display #__line__ ";add-to-main-menu non-thunk: ~A" tag)))
- (let ((tag (catch #t (lambda () (add-to-menu 3 "oops" (make-delay 12)))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'bad-arity))
- (not (eq? tag 'wrong-type-arg)))
- (snd-display #__line__ ";add-to-menu non-thunk: ~A" tag)))
-
- (set! (cursor fd) 2000)
- (set! (transform-graph-type) graph-once)
- (set! (transform-graph? fd) #t)
- (if (and with-gui
- (not clm_buffer_added))
- (begin
- (add-to-menu mb "not here" (lambda () (snd-display #__line__ ";oops")))
- (remove-from-menu mb "not here")
- (add-to-menu 3 "Denoise" (lambda () (report-in-minibuffer "denoise")))))
-
- (set! clm_buffer_added #t))
+ (if with-gui
+ (let ((mb #f))
+ (if (not clm_buffer_added)
+ (set! mb (add-to-main-menu "clm")))
+
+ (let ((var (catch #t (lambda () (add-to-menu -1 "fm-violin" (lambda () #f))) (lambda args args))))
+ (if (not (eq? (car var) 'no-such-menu))
+ (snd-display #__line__ ";add-to-menu bad menu: ~A" var)))
+ (set! (cursor fd) 2000)
+ (set! *transform-graph-type* graph-once)
+ (set! (transform-graph? fd) #t)
+ (if (not clm_buffer_added)
+ (begin
+ (add-to-menu mb "not here" (lambda () (snd-display #__line__ ";oops")))
+ (remove-from-menu mb "not here")
+ (add-to-menu 3 "Denoise" (lambda () (status-report "denoise")))))
+
+ (set! clm_buffer_added #t)))
- (set! (hook-functions help-hook) '())
+ (set! (hook-functions help-hook) ())
(let ((hi (snd-help 'cursor-position)))
- (hook-push help-hook (lambda (a b)
- (if (not (string=? a "cursor-position"))
- (snd-display #__line__ ";help-hook subject: ~A" a))
- (if (not (string=? b "(cursor-position :optional snd chn): current cursor position (x y in pixels) in snd's channel chn"))
- (snd-display #__line__ ";help-hook text: ~A" b))
- (string-append "hiho:" b)))
+ (hook-push help-hook (lambda (hook)
+ (let ((a (hook (list-ref (hook 'args) 0)))
+ (b (hook (list-ref (hook 'args) 1))))
+ (if (not (string=? a "cursor-position"))
+ (snd-display #__line__ ";help-hook subject: ~A" a))
+ (if (not (string=? b "(cursor-position :optional snd chn): current cursor position (x y in pixels) in snd's channel chn"))
+ (snd-display #__line__ ";help-hook text: ~A" b))
+ (set! (hook 'result) (string-append "hiho:" b)))))
(let ((ho (snd-help 'cursor-position)))
- (if (not (= (string-length ho) (+ 5 (string-length hi))))
+ (if (not (= (length ho) (+ 5 (length hi))))
(snd-display #__line__ ";help-hook ~A -> ~A" hi ho))
- (set! (hook-functions help-hook) '())
- (hook-push help-hook (lambda (a b) #f))
+ (set! (hook-functions help-hook) ())
+ (hook-push help-hook (lambda (hook) (set! (hook 'result) #f)))
(set! ho (snd-help 'cursor-position))
(if (not (string=? hi ho))
(snd-display #__line__ ";help-hook #f: ~A ~A" hi ho))
- (set! (hook-functions help-hook) '())))
+ (set! (hook-functions help-hook) ())))
(set! (transform-size fd 0) 256)
- (for-each
- (lambda (dpy-type fft-type)
- (set! (transform-graph-type fd 0) dpy-type)
- (set! (transform-type fd 0) fft-type)
- (update-transform-graph fd 0)
- (let ((vals (transform->vct fd 0)))
- (if (not vals)
- (snd-display #__line__ ";transform graph-type: ~A type: ~A -> data: ~A" dpy-type fft-type vals)
- (begin
- (if (fneq (transform-sample 0 0 fd 0) (vct-ref vals 0))
- (snd-display #__line__ ";transform-sample ~A ~A -> ~A ~A" dpy-type fft-type (vct-ref vals 0) (transform-sample 0 0 fd 0)))
- (if (not (>= (vct-length vals) 256))
- (snd-display #__line__ ";transform-> vct size: ~A" (vct-length vals)))))))
- (list graph-once graph-as-sonogram graph-as-spectrogram
- graph-once graph-as-sonogram graph-as-spectrogram)
- (list fourier-transform fourier-transform fourier-transform
- autocorrelation autocorrelation autocorrelation))
- (let ((tag (catch #t
- (lambda ()
- (transform-sample 5000 0 fd 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample))
- (snd-display #__line__ ";access invalid (bin) transform sample: ~A" tag)))
- (let ((tag (catch #t
- (lambda ()
- (transform-sample 0 5000 fd 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample))
- (snd-display #__line__ ";access invalid (slice) transform sample: ~A" tag)))
+ (when with-motif
+ (for-each
+ (lambda (dpy-type fft-type)
+ (set! (transform-graph-type fd 0) dpy-type)
+ (set! (transform-type fd 0) fft-type)
+ (update-transform-graph fd 0)
+ (let ((vals (transform->float-vector fd 0)))
+ (if (not vals)
+ (snd-display #__line__ ";transform graph-type: ~A type: ~A -> data: ~A" dpy-type fft-type vals)
+ (begin
+ (if (fneq (transform-sample 0 0 fd 0) (vals 0))
+ (snd-display #__line__ ";transform-sample ~A ~A -> ~A ~A" dpy-type fft-type (vals 0) (transform-sample 0 0 fd 0)))
+ (if (< (length vals) 256)
+ (snd-display #__line__ ";transform-> float-vector size: ~A" (length vals)))))))
+ (list graph-once graph-as-sonogram graph-as-spectrogram
+ graph-once graph-as-sonogram graph-as-spectrogram)
+ (list fourier-transform fourier-transform fourier-transform
+ autocorrelation autocorrelation autocorrelation)))
+ (when with-gui
+ (let ((tag (catch #t
+ (lambda ()
+ (transform-sample 5000 0 fd 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-sample))
+ (snd-display #__line__ ";access invalid (bin) transform sample: ~A" tag))))
(close-sound fd)
- (set! (transform-type) fourier-transform)
+ (set! *transform-type* fourier-transform)
(hook-push after-open-hook
- (lambda (snd)
- (set! (x-axis-style snd #t) x-axis-in-samples)))
+ (lambda (hook)
+ (set! (x-axis-style (hook 'snd) #t) x-axis-in-samples)))
(set! fd (open-sound "2.snd"))
(close-sound fd)
- (set! (hook-functions after-open-hook) '())
+ (set! (hook-functions after-open-hook) ())
(hook-push after-open-hook
- (lambda (snd)
- (set! (x-axis-style snd #t) x-axis-as-percentage)))
+ (lambda (hook)
+ (set! (x-axis-style (hook 'snd) #t) x-axis-as-percentage)))
(hook-push initial-graph-hook
- (lambda (snd chn dur)
- (if (mus-sound-maxamp-exists? (file-name snd))
- (let* ((amp-vals (mus-sound-maxamp (file-name snd)))
- (max-val (list-ref amp-vals (+ (* chn 2) 1))))
- (list 0.0 dur (- max-val) max-val))
- (list 0.0 dur -1.0 1.0))))
- (set! (hook-functions after-open-hook) '())
- (set! (hook-functions initial-graph-hook) '())
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn))
+ (dur (hook 'duration)))
+ (if (mus-sound-maxamp-exists? (file-name snd))
+ (let* ((amp-vals (mus-sound-maxamp (file-name snd)))
+ (max-val (amp-vals (+ (* chn 2) 1))))
+ (set! (hook 'result) (list 0.0 dur (- max-val) max-val)))
+ (set! (hook 'result) (list 0.0 dur -1.0 1.0))))))
+ (set! (hook-functions after-open-hook) ())
+ (set! (hook-functions initial-graph-hook) ())
(hook-push initial-graph-hook
- (lambda (snd chn dur)
- (list 0.0 dur -1.0 1.0 "a label" -4.0 4.0)))
+ (lambda (hook)
+ (set! (hook 'result) (list 0.0 (hook 'duration) -1.0 1.0 "a label" -4.0 4.0))))
(set! fd (open-sound "2.snd"))
(let ((ax (axis-info)))
(if (and (pair? ax)
- (or (fneq (list-ref ax 2) 0.0)
- (fneq (list-ref ax 3) -1.0)
- (fneq (list-ref ax 4) (mus-sound-duration "2.snd"))
- (fneq (list-ref ax 5) 1.0)
- (fneq (list-ref ax 6) 0.0)
- (fneq (list-ref ax 7) -4.0)
- (fneq (list-ref ax 8) (mus-sound-duration "2.snd"))
- (fneq (list-ref ax 9) 4.0)))
+ (or (fneq (ax 2) 0.0)
+ (fneq (ax 3) -1.0)
+ (fneq (ax 4) (mus-sound-duration "2.snd"))
+ (fneq (ax 5) 1.0)
+ (fneq (ax 6) 0.0)
+ (fneq (ax 7) -4.0)
+ (fneq (ax 8) (mus-sound-duration "2.snd"))
+ (fneq (ax 9) 4.0)))
(snd-display #__line__ ";initial-graph-hook with ymin/max: ~A" ax))
- (set! (hook-functions initial-graph-hook) '()))
+ (set! (hook-functions initial-graph-hook) ()))
(set! (selection-position fd 1) 1000)
- (set! (selection-frames fd 1) 10)
+ (set! (selection-framples fd 1) 10)
(set! (selection-member? fd 1) #t)
(if (selection-member? fd 0) (snd-display #__line__ ";chan 0 is selection-member?"))
- (do ((i 0 (+ 1 i))) ((= i 2))
+ (do ((i 0 (+ i 1))) ((= i 2))
(set! (selection-position fd i) 1000)
- (set! (selection-frames fd i) 10)
+ (set! (selection-framples fd i) 10)
(set! (selection-member? fd i) #t))
- (scale-selection-to (vct .5 .25))
+ (scale-selection-to (float-vector .5 .25))
(if (or (fneq (maxamp fd 0) .5)
(fneq (maxamp fd 1) .25))
(snd-display #__line__ ";scale-selection-to with vector: ~A" (maxamp fd #t)))
@@ -31150,354 +25540,341 @@ EDITS: 2
(set! fd (open-sound "obtest.snd"))
- (let ((ctr 0))
+ (let ()
(let ((added 0))
- (set! (hook-functions close-hook) '())
- (set! (with-background-processes) #t)
+ (set! (hook-functions close-hook) ())
+ (set! *with-background-processes* #t)
(hook-push new-widget-hook
- (lambda (w)
+ (lambda (hook)
(set! added (+ added 1))))
(if (provided? 'snd-motif)
(without-errors
(test-menus)))
(dismiss-all-dialogs)
- (set! (hook-functions close-hook) '())
+ (set! (hook-functions close-hook) ())
(for-each close-sound (sounds))
(if (sound? fd)
(begin
(snd-display #__line__ ";close all didn't? ~A ~A ~A ~A ~A" fd (sound? fd) (short-file-name fd) (hook-functions close-hook) (sounds))
(close-sound fd)))
(set! fd (open-sound "obtest.snd"))
- (set! (with-background-processes) #f)
- (if (and (provided? 'snd-motif)
- (= added 0))
- (snd-display #__line__ ";no widgets added?"))
- (set! (hook-functions new-widget-hook) '()))
+ (set! *with-background-processes* #f)
+ (set! (hook-functions new-widget-hook) ()))
(if (and (not ladspa_inited)
- (provided? 'snd-ladspa))
- (if (file-exists? "/home/bil/test/ladspa/ladspa_sdk/plugins")
- (begin
- (set! ladspa_inited #t)
- (set! (ladspa-dir) "/home/bil/test/ladspa/ladspa_sdk/plugins")
- (init-ladspa)
- (let* ((ptr (ladspa-descriptor "delay" "delay_5s"))
- (label (.Label ptr))
- (name (.Name ptr))
- (copy (.Copyright ptr))
- (maker (.Maker ptr))
- (props (.Properties ptr))
- (id (.UniqueID ptr))
- (names (.PortNames ptr))
- (hints (.PortRangeHints ptr))
- (count (.PortCount ptr))
- (descs (.PortDescriptors ptr)))
- (if (not (string=? label "delay_5s"))
- (snd-display #__line__ ";ladspa .Label: ~A" label))
- (if (not (string=? name "Simple Delay Line"))
- (snd-display #__line__ ";ladspa .Name: ~A" name))
- (if (not (string=? maker "Richard Furse (LADSPA example plugins)"))
- (snd-display #__line__ ";ladspa .Maker: ~A" maker))
- (if (not (string=? copy "None"))
- (snd-display #__line__ ";ladspa .Copyright: ~A" copy))
- (if (not (= id 1043)) (snd-display #__line__ ";ladspa .UniqueID: ~A" id))
- (if (not (= count 4)) (snd-display #__line__ ";ladspa .PortCount: ~A" count))
- (if (not (= props 4)) (snd-display #__line__ ";ladspa .Properties: ~A" prop))
- (if (not (equal? names (list "Delay (Seconds)" "Dry/Wet Balance" "Input" "Output")))
- (snd-display #__line__ ";ladspa .PortNames: ~A" names))
- (if (not (equal? hints (list (list 579 0.0 5.0) (list 195 0.0 1.0) (list 0 0.0 0.0) (list 0 0.0 0.0))))
- (snd-display #__line__ ";ladspa .PortRangeHints: ~A" hints))
- (if (not (equal? descs (list 5 5 9 10)))
- (snd-display #__line__ ";ladspa .PortDescriptors: ~A" descs))
- (if (not (= (logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT) 1))
- (snd-display #__line__ ";ladspa port hint: ~A" (logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT))))
- (apply-ladspa (make-sampler 0) (list "delay" "delay_5s" .3 .5) 1000 "delayed")
- (if (not (equal? (analyze-ladspa "delay" "delay_5s")
- (list "Simple Delay Line" "Richard Furse (LADSPA example plugins)" "None" (list "Dry/Wet Balance" "minimum" 0.0 "maximum" 1.0) (list "Delay (Seconds)" "minimum" 0.0 "maximum" 5.0))))
- (snd-display #__line__ ";analyze-ladspa: ~A" (analyze-ladspa "delay" "delay_5s")))
- (ladspa-it "delay" "delay_5s" .3 .5)
- (if (provided? 'xm)
- (let ((w (list-ref (menu-widgets) 5)))
- (if (list? w)
- (if (not (XmIsRowColumn w))
- (let ((option-holder (cadr (XtGetValues w (list XmNsubMenuId 0)))))
- (for-each-child
- option-holder
- (lambda (menu)
- (if (and (XmIsPushButton menu)
- (XtIsSensitive menu)
- (string=? (XtName menu) "Plugins"))
- (XtCallCallbacks menu XmNactivateCallback (snd-global-state))))))))))
- (dismiss-all-dialogs)
- (let ((tag (catch #t
- (lambda ()
- (apply-ladspa (make-sampler 0) (list "delay" "delay_4s" .3 .5) 1000 "delayed"))
- (lambda args args))))
- (if (not (eq? (car tag) 'no-such-plugin))
- (snd-display #__line__ ";apply-ladspa bad plugin: ~A" tag)))
- (let ((tag (catch #t
- (lambda ()
- (apply-ladspa (list (make-sampler 0) (make-sampler 0)) (list "delay" "delay_5s" .3 .5) 1000 "delayed"))
- (lambda args args))))
- (if (not (eq? (car tag) 'plugin-error))
- (snd-display #__line__ ";apply-ladspa reader mismatch: ~A" tag)))
- (let ((vals (list-ladspa)))
- (if (not (pair? vals))
- (snd-display #__line__ ";ladspa list: ~A" vals))
- (let ((descr (analyse-ladspa "delay" "delay_5s")))
- (if (or (not (pair? descr))
- (not (string? (car descr)))
- (not (string=? (car descr) "Simple Delay Line")))
- (snd-display #__line__ ";analyse-ladspa: ~A" descr))))
- (let ((tag (catch #t
- (lambda () (analyse-ladspa "delay" "delay_no_delay"))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-plugin)) (snd-display #__line__ ";analyse-ladspa tag: ~A" tag)))
- (let ((tag (catch #t
- (lambda ()
- (apply-ladspa (list (make-sampler 0) (make-sampler 0)) (list #f) 1000 "delayed"))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";apply-ladspa tag: ~A" tag)))
-
- (set! (ladspa-dir) "/home/bil/test/ladspa/vocoder-0.3")
- (init-ladspa)
- (if (not (equal? (list-ladspa) (list (list "vocoder" "vocoder"))))
- (snd-display #__line__ ";list-ladspa vocoder: ~A" (list-ladspa)))
- (if (not (list? (analyze-ladspa "vocoder" "vocoder")))
- (snd-display #__line__ ";analyze-ladspa vocoder: ~A" (analyze-ladspa "vocoder" "vocoder")))
- (let ((hi (ladspa-descriptor "vocoder" "vocoder")))
- (if (not (string=? (.Name hi) "Vocoder"))
- (snd-display #__line__ ";ladspa vocoder name: ~A" (.Name hi))))
-
- (let ((snd (open-sound "1a.snd")))
- (apply-ladspa (list (make-sampler 0) (make-sampler 0))
- (list "vocoder" "vocoder" 12 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5)
- (frames) "vocoder")
- (undo)
-
- (set! (ladspa-dir) "/home/bil/test/ladspa/lib/ladspa")
- (init-ladspa)
- (for-each (lambda (plug) (apply analyse-ladspa plug)) (list-ladspa))
-
- (if (not (list? (analyse-ladspa "amp_1181" "amp")))
- (snd-display #__line__ ";analyze-ladspa can't find amp_1181"))
-
- (apply-ladspa (make-sampler 0) (list "amp_1181" "amp" -6) (frames) "amp")
- (apply-ladspa (make-sampler 0) (list "amp_1181" "amp" 6) (frames) "amp")
- (close-sound snd))
-
- (let ((snd (open-sound "2a.snd")))
-
- (let ((tag
- (catch #t
- (lambda ()
- (apply-ladspa (list (make-sampler 0 snd 0) (make-sampler 0 snd 1))
- (list "amp_1181" "amp" 6 -6) (frames) "amp"))
- (lambda args (car args)))))
- (if (not (equal? tag 'plugin-error))
- (snd-display #__line__ ";apply-ladspa bad inputs: ~A" tag)))
-
- (apply-ladspa (list (make-sampler 0 snd 0) (make-sampler 0 snd 0))
- (list "ringmod_1188" "ringmod_2i1o" 1) (frames) "ringmod")
- (apply-ladspa #f (list "analogue_osc_1416" "analogueOsc" 2 440.0 0.1 0.0) (frames) "osc")
- (apply-ladspa #f (list "sin_cos_1881" "sinCos" 440.0 1.0) (frames) "sincos")
- (apply-ladspa (list (make-sampler 0 snd 0) (make-sampler 0 snd 1))
- (list "dj_eq_1901" "dj_eq" -6 0 6) (frames) "djeq")
- (close-sound snd)))
+ (provided? 'snd-ladspa)
+ (file-exists? "/home/bil/test/ladspa/ladspa_sdk/plugins"))
+ (begin
+ (set! ladspa_inited #t)
+ (set! *ladspa-dir* "/home/bil/test/ladspa/ladspa_sdk/plugins")
+ (init-ladspa)
+ (let* ((ptr (ladspa-descriptor "delay" "delay_5s"))
+ (label (.Label ptr))
+ (name (.Name ptr))
+ (copy (.Copyright ptr))
+ (maker (.Maker ptr))
+ (props (.Properties ptr))
+ (id (.UniqueID ptr))
+ (names (.PortNames ptr))
+ (hints (.PortRangeHints ptr))
+ (count (.PortCount ptr))
+ (descs (.PortDescriptors ptr)))
+ (if (not (string=? label "delay_5s"))
+ (snd-display #__line__ ";ladspa .Label: ~A" label))
+ (if (not (string=? name "Simple Delay Line"))
+ (snd-display #__line__ ";ladspa .Name: ~A" name))
+ (if (not (string=? maker "Richard Furse (LADSPA example plugins)"))
+ (snd-display #__line__ ";ladspa .Maker: ~A" maker))
+ (if (not (string=? copy "None"))
+ (snd-display #__line__ ";ladspa .Copyright: ~A" copy))
+ (if (not (= id 1043)) (snd-display #__line__ ";ladspa .UniqueID: ~A" id))
+ (if (not (= count 4)) (snd-display #__line__ ";ladspa .PortCount: ~A" count))
+ (if (not (= props 4)) (snd-display #__line__ ";ladspa .Properties: ~A" prop))
+ (if (not (equal? names (list "Delay (Seconds)" "Dry/Wet Balance" "Input" "Output")))
+ (snd-display #__line__ ";ladspa .PortNames: ~A" names))
+ (if (not (equal? hints (list (list 579 0.0 5.0) (list 195 0.0 1.0) (list 0 0.0 0.0) (list 0 0.0 0.0))))
+ (snd-display #__line__ ";ladspa .PortRangeHints: ~A" hints))
+ (if (not (equal? descs (list 5 5 9 10)))
+ (snd-display #__line__ ";ladspa .PortDescriptors: ~A" descs))
+ (if (not (= (logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT) 1))
+ (snd-display #__line__ ";ladspa port hint: ~A" (logand (cadr (.PortDescriptors ptr)) LADSPA_PORT_INPUT))))
+ (apply-ladspa (make-sampler 0) (list "delay" "delay_5s" .3 .5) 1000 "delayed")
+ (if (not (equal? (analyze-ladspa "delay" "delay_5s")
+ (list "Simple Delay Line" "Richard Furse (LADSPA example plugins)" "None" (list "Dry/Wet Balance" "minimum" 0.0 "maximum" 1.0) (list "Delay (Seconds)" "minimum" 0.0 "maximum" 5.0))))
+ (snd-display #__line__ ";analyze-ladspa: ~A" (analyze-ladspa "delay" "delay_5s")))
+ (ladspa-it "delay" "delay_5s" .3 .5)
+ (if (provided? 'xm)
+ (let ((w ((menu-widgets) 5)))
+ (if (and (list? w)
+ (not (XmIsRowColumn w)))
+ (let ((option-holder (cadr (XtGetValues w (list XmNsubMenuId 0)))))
+ (for-each-child
+ option-holder
+ (lambda (menu)
+ (if (and (XmIsPushButton menu)
+ (XtIsSensitive menu)
+ (string=? (XtName menu) "Plugins"))
+ (XtCallCallbacks menu XmNactivateCallback (snd-global-state)))))))))
+ (dismiss-all-dialogs)
+ (let ((tag (catch #t
+ (lambda ()
+ (apply-ladspa (make-sampler 0) (list "delay" "delay_4s" .3 .5) 1000 "delayed"))
+ (lambda args args))))
+ (if (not (eq? (car tag) 'no-such-plugin))
+ (snd-display #__line__ ";apply-ladspa bad plugin: ~A" tag)))
+ (let ((tag (catch #t
+ (lambda ()
+ (apply-ladspa (list (make-sampler 0) (make-sampler 0)) (list "delay" "delay_5s" .3 .5) 1000 "delayed"))
+ (lambda args args))))
+ (if (not (eq? (car tag) 'plugin-error))
+ (snd-display #__line__ ";apply-ladspa reader mismatch: ~A" tag)))
+ (let ((vals (list-ladspa)))
+ (if (not (pair? vals))
+ (snd-display #__line__ ";ladspa list: ~A" vals))
+ (let ((descr (analyse-ladspa "delay" "delay_5s")))
+ (if (or (not (pair? descr))
+ (not (string? (car descr)))
+ (not (string=? (car descr) "Simple Delay Line")))
+ (snd-display #__line__ ";analyse-ladspa: ~A" descr))))
+ (let ((tag (catch #t
+ (lambda () (analyse-ladspa "delay" "delay_no_delay"))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-plugin)) (snd-display #__line__ ";analyse-ladspa tag: ~A" tag)))
+ (let ((tag (catch #t
+ (lambda ()
+ (apply-ladspa (list (make-sampler 0) (make-sampler 0)) (list #f) 1000 "delayed"))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";apply-ladspa tag: ~A" tag)))
+
+ (set! *ladspa-dir* "/home/bil/test/ladspa/vocoder-0.3")
+ (init-ladspa)
+ (if (not (equal? (list-ladspa) (list (list "vocoder" "vocoder"))))
+ (snd-display #__line__ ";list-ladspa vocoder: ~A" (list-ladspa)))
+ (if (not (list? (analyze-ladspa "vocoder" "vocoder")))
+ (snd-display #__line__ ";analyze-ladspa vocoder: ~A" (analyze-ladspa "vocoder" "vocoder")))
+ (let ((hi (ladspa-descriptor "vocoder" "vocoder")))
+ (if (not (string=? (.Name hi) "Vocoder"))
+ (snd-display #__line__ ";ladspa vocoder name: ~A" (.Name hi))))
+
+ (let ((snd (open-sound "1a.snd")))
+ (apply-ladspa (list (make-sampler 0) (make-sampler 0))
+ (list "vocoder" "vocoder" 12 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5 .5)
+ (framples) "vocoder")
+ (undo)
+
+ (set! *ladspa-dir* "/home/bil/test/ladspa/lib/ladspa")
+ (init-ladspa)
+ (for-each (lambda (plug) (apply analyse-ladspa plug)) (list-ladspa))
+
+ (if (not (list? (analyse-ladspa "amp_1181" "amp")))
+ (snd-display #__line__ ";analyze-ladspa can't find amp_1181"))
- (snd-display #__line__ ";ladspa loaded but can't find plugin directory: ~A" (ladspa-dir)))))
+ (apply-ladspa (make-sampler 0) (list "amp_1181" "amp" -6) (framples) "amp")
+ (apply-ladspa (make-sampler 0) (list "amp_1181" "amp" 6) (framples) "amp")
+ (close-sound snd))
+
+ (let ((snd (open-sound "2a.snd")))
+
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (apply-ladspa (list (make-sampler 0 snd 0) (make-sampler 0 snd 1))
+ (list "amp_1181" "amp" 6 -6) (framples) "amp"))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'plugin-error))
+ (snd-display #__line__ ";apply-ladspa bad inputs: ~A" tag)))
+
+ (apply-ladspa (list (make-sampler 0 snd 0) (make-sampler 0 snd 0))
+ (list "ringmod_1188" "ringmod_2i1o" 1) (framples) "ringmod")
+ (apply-ladspa #f (list "analogue_osc_1416" "analogueOsc" 2 440.0 0.1 0.0) (framples) "osc")
+ (apply-ladspa #f (list "sin_cos_1881" "sinCos" 440.0 1.0) (framples) "sincos")
+ (apply-ladspa (list (make-sampler 0 snd 0) (make-sampler 0 snd 1))
+ (list "dj_eq_1901" "dj_eq" -6 0 6) (framples) "djeq")
+ (close-sound snd)))
+ ))
(revert-sound fd)
(close-sound fd)
(for-each close-sound (sounds))
(test-hooks)
- (hook-push bad-header-hook (lambda (n) #t))
- (let ((ind (open-sound "oboe.snd")))
- (set! (cursor) 2000)
- (key (char->integer #\u) 4 ind)
- (key (char->integer #\1) 0 ind)
- (key (char->integer #\0) 0 ind)
- (key (char->integer #\0) 0 ind)
- (key (char->integer #\x) 4 ind)
- (key (char->integer #\z) 4 ind)
- (if (not (equal? (edit-fragment) (list "smooth-channel 2000 100" "set" 2000 100)))
- (snd-display #__line__ ";C-x C-z fragment: ~A" (edit-fragment)))
- (if (not (vequal (channel->vct 2010 10) (vct 0.064 0.063 0.063 0.062 0.062 0.061 0.060 0.059 0.059 0.058)))
- (snd-display #__line__ ";C-x C-z samps: ~A" (channel->vct 2010 10)))
- (set! (cursor) 0)
- (select-all)
- (key (char->integer #\x) 4 ind)
- (key (char->integer #\o) 0 ind)
- (key (char->integer #\-) 4 ind)
- (key (char->integer #\x) 4 ind)
- (key (char->integer #\o) 0 ind)
- (key (char->integer #\x) 4 ind)
- (key (char->integer #\o) 0 ind)
- (key (char->integer #\x) 4 ind)
- (key (char->integer #\p) 0 ind)
- (set! (selection-member? #t) #f)
- (revert-sound ind)
- (set! (search-procedure ind) (lambda (n4) (> n4 .1)))
- (key (char->integer #\a) 4 ind 0)
- (if (not (= (cursor ind 0) 0))
- (snd-display #__line__ ";C-a cursor: ~D?" (cursor ind 0)))
- (key (char->integer #\s) 4 ind 0)
- (key (char->integer #\s) 4 ind 0)
- (if (not (= (cursor ind 0) 4423))
- (snd-display #__line__ ";search-procedure C-s C-s cursor: ~D?" (cursor ind 0)))
- (let ((str (with-output-to-string (lambda () (display (procedure-source (search-procedure ind)))))))
- (if (not (string=? str "(lambda (n4) (> n4 0.1))"))
- (snd-display #__line__ ";search-procedure: ~A?" str)))
-
- (set! (search-procedure ind) (lambda (n) (> n .2)))
- (set! (cursor ind 0) 0)
- (key (char->integer #\s) 4 ind 0)
- (key (char->integer #\s) 4 ind 0)
- (if (not (= (cursor ind 0) 0))
- (snd-display #__line__ ";search-procedure C-s C-s cursor failed: ~D?" (cursor ind 0)))
- (let ((str (with-output-to-string (lambda () (display (procedure-source (search-procedure ind)))))))
- (if (not (string=? str "(lambda (n) (> n 0.2))"))
- (snd-display #__line__ ";search-procedure (1): ~A?" str)))
-
- (set! (hook-functions (edit-hook ind 0)) '())
- (hook-push (edit-hook ind 0) (lambda () (+ snd chn)))
- (let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions (edit-hook ind 0))))))))
- (if (not (string=? str "((lambda () (+ snd chn)))"))
- (snd-display #__line__ ";edit-hook: ~A?" str)))
- (set! (hook-functions (edit-hook ind 0)) '())
- (set! (hook-functions (after-edit-hook ind 0)) '())
- (hook-push (after-edit-hook ind 0) (lambda () (+ snd chn)))
- (let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions (after-edit-hook ind 0))))))))
- (if (not (string=? str "((lambda () (+ snd chn)))"))
- (snd-display #__line__ ";after-edit-hook: ~A?" str)))
- (set! (hook-functions (after-edit-hook ind 0)) '())
- (set! (hook-functions (undo-hook ind 0)) '())
- (hook-push (undo-hook ind 0) (lambda () (+ snd chn)))
- (let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions (undo-hook ind 0))))))))
- (if (not (string=? str "((lambda () (+ snd chn)))"))
- (snd-display #__line__ ";undo-hook: ~A?" str)))
- (set! (hook-functions (undo-hook ind 0)) '())
- (let ((calls 0))
- (hook-push (undo-hook ind 0) (lambda () (set! calls (+ 1 calls))))
- (delete-sample 0 ind 0)
- (undo 1)
- (redo 1)
+ (hook-push bad-header-hook (lambda (hook) (set! (hook 'result) #t)))
+ (when with-gui
+ (let ((ind (open-sound "oboe.snd")))
+ (set! (cursor) 2000)
+ (key (char->integer #\u) 4 ind)
+ (key (char->integer #\1) 0 ind)
+ (key (char->integer #\0) 0 ind)
+ (key (char->integer #\0) 0 ind)
+ (key (char->integer #\x) 4 ind)
+ (key (char->integer #\z) 4 ind)
+ (if (not (equal? (edit-fragment) (list "smooth-channel 2000 100" "set" 2000 100)))
+ (snd-display #__line__ ";C-x C-z fragment: ~A" (edit-fragment)))
+ (if (not (vequal (channel->float-vector 2010 10) (float-vector 0.064 0.063 0.063 0.062 0.062 0.061 0.060 0.059 0.059 0.058)))
+ (snd-display #__line__ ";C-x C-z samps: ~A" (channel->float-vector 2010 10)))
+ (set! (cursor) 0)
+ (select-all)
+ (key (char->integer #\x) 4 ind)
+ (key (char->integer #\o) 0 ind)
+ (key (char->integer #\-) 4 ind)
+ (key (char->integer #\x) 4 ind)
+ (key (char->integer #\o) 0 ind)
+ (key (char->integer #\x) 4 ind)
+ (key (char->integer #\o) 0 ind)
+ (key (char->integer #\x) 4 ind)
+ (key (char->integer #\p) 0 ind)
+ (set! (selection-member? #t) #f)
(revert-sound ind)
- (if (not (= calls 3)) (snd-display #__line__ ";undo-hook called ~A times" calls)))
- (set! (hook-functions (undo-hook ind 0)) '())
-
- (let ((opt (optimization)))
- (set! (optimization) 0)
- (set! (search-procedure ind) (lambda (n4) (> n4 .1)))
+ (set! (search-procedure) (lambda (n4) (> n4 .1)))
(key (char->integer #\a) 4 ind 0)
+ (if (not (= (cursor ind 0) 0))
+ (snd-display #__line__ ";C-a cursor: ~D?" (cursor ind 0)))
(key (char->integer #\s) 4 ind 0)
(key (char->integer #\s) 4 ind 0)
(if (not (= (cursor ind 0) 4423))
- (snd-display #__line__ ";unopt search-procedure C-s C-s cursor: ~D?" (cursor ind 0)))
- (set! (search-procedure ind) (lambda (n) (> n .2)))
- (set! (cursor ind 0) (- (frames) 1))
- (key (char->integer #\r) 4 ind 0)
- (key (char->integer #\r) 4 ind 0)
- (set! (optimization) opt))
-
- (set! (search-procedure ind) #f)
- (close-sound ind)
- )
- (if (not (null? (hook-functions open-raw-sound-hook))) (set! (hook-functions open-raw-sound-hook) '()))
- (hook-push open-raw-sound-hook (lambda (file choices) (list 1 22050 mus-bshort)))
- (let* ((ind (open-sound "../sf1/addf8.nh")))
+ (snd-display #__line__ ";search-procedure C-s C-s cursor: ~D?" (cursor ind 0)))
+ (let ((str (with-output-to-string (lambda () (display (procedure-source (search-procedure)))))))
+ (if (not (string=? str "(lambda (n4) (> n4 0.1))"))
+ (snd-display #__line__ ";search-procedure: ~A?" str)))
+
+ (set! (search-procedure) (lambda (n) (> n .2)))
+ (set! (cursor ind 0) 0)
+ (key (char->integer #\s) 4 ind 0)
+ (key (char->integer #\s) 4 ind 0)
+ (if (not (= (cursor ind 0) 0))
+ (snd-display #__line__ ";search-procedure C-s C-s cursor failed: ~D?" (cursor ind 0)))
+ (let ((str (with-output-to-string (lambda () (display (procedure-source (search-procedure)))))))
+ (if (not (string=? str "(lambda (n) (> n 0.2))"))
+ (snd-display #__line__ ";search-procedure (1): ~A?" str)))
+
+ (set! (hook-functions (edit-hook ind 0)) ())
+ (hook-push (edit-hook ind 0) (lambda (hook) (set! (hook 'result) #f)))
+ (let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions (edit-hook ind 0))))))))
+ (if (not (string=? str "((lambda (hook) (set! (hook 'result) #f)))"))
+ (snd-display #__line__ ";edit-hook: ~A?" str)))
+ (set! (hook-functions (edit-hook ind 0)) ())
+ (set! (hook-functions (after-edit-hook ind 0)) ())
+ (hook-push (after-edit-hook ind 0) (lambda (hook) (set! (hook 'result) #f)))
+ (let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions (after-edit-hook ind 0))))))))
+ (if (not (string=? str "((lambda (hook) (set! (hook 'result) #f)))"))
+ (snd-display #__line__ ";after-edit-hook: ~A?" str)))
+ (set! (hook-functions (after-edit-hook ind 0)) ())
+ (set! (hook-functions (undo-hook ind 0)) ())
+ (hook-push (undo-hook ind 0) (lambda (hook) (set! (hook 'result) #f)))
+ (let ((str (with-output-to-string (lambda () (display (map procedure-source (hook-functions (undo-hook ind 0))))))))
+ (if (not (string=? str "((lambda (hook) (set! (hook 'result) #f)))"))
+ (snd-display #__line__ ";undo-hook: ~A?" str)))
+ (set! (hook-functions (undo-hook ind 0)) ())
+ (let ((calls 0))
+ (hook-push (undo-hook ind 0) (lambda (hook) (set! calls (+ 1 calls))))
+ (delete-sample 0 ind 0)
+ (undo 1)
+ (redo 1)
+ (revert-sound ind)
+ (if (not (= calls 3)) (snd-display #__line__ ";undo-hook called ~A times" calls)))
+ (set! (hook-functions (undo-hook ind 0)) ())
+ (set! (search-procedure) #f)
+ (close-sound ind)
+ ))
+ (if (pair? (hook-functions open-raw-sound-hook)) (set! (hook-functions open-raw-sound-hook) ()))
+ (hook-push open-raw-sound-hook (lambda (hook) (set! (hook 'result) (list 1 22050 mus-bshort))))
+ (let ((ind (open-sound "~/sf1/addf8.nh")))
(play ind :wait #t)
- (set! (hook-functions open-raw-sound-hook) '())
+ (set! (hook-functions open-raw-sound-hook) ())
(if (or (not (= (chans ind) 1))
(not (= (srate ind) 22050))
- (not (= (data-format ind) mus-bshort))
- (not (= (frames ind) 23808)))
+ (not (= (sample-type ind) mus-bshort))
+ (not (= (framples ind) 23808)))
(snd-display #__line__ ";open-raw: ~A ~A ~A ~A"
- (chans ind) (srate ind) (data-format ind) (frames ind)))
- (set! (search-procedure ind) (lambda (n) (> n .2)))
+ (chans ind) (srate ind) (sample-type ind) (framples ind)))
+ (set! (search-procedure) (lambda (n) (> n .2)))
(close-sound ind))
(let ((save-as-dialog #t)
(save-as-name "hiho")
(save-as-index #f))
- (set! (hook-functions after-save-as-hook) '())
+ (set! (hook-functions after-save-as-hook) ())
(hook-push after-save-as-hook
- (lambda (ind name dial)
- (set! save-as-index ind)
- (set! save-as-name name)
- (set! save-as-dialog dial)))
+ (lambda (hook)
+ (let ((ind (hook 'snd))
+ (name (hook 'name))
+ (dial (hook 'dialog)))
+ (set! save-as-index ind)
+ (set! save-as-name name)
+ (set! save-as-dialog dial))))
(let ((ind (open-sound "oboe.snd")))
- (save-sound-as "test.snd" ind mus-raw)
+ (save-sound-as "test.snd" ind :header-type mus-raw)
(close-sound ind)
- (set! (hook-functions open-raw-sound-hook) '())
- (set! (hook-functions after-save-as-hook) '())
+ (set! (hook-functions open-raw-sound-hook) ())
+ (set! (hook-functions after-save-as-hook) ())
(if save-as-dialog (snd-display #__line__ ";after-save-as-hook dialog: ~A" save-as-dialog))
(if (not (equal? ind save-as-index)) (snd-display #__line__ ";after-save-as-hook index: ~A ~A" ind save-as-index))
(if (and (not (string=? (string-append home-dir "/cl/test.snd") save-as-name))
- (not (string=? (string-append home-dir "/snd-12/test.snd") save-as-name)))
+ (not (string=? (string-append home-dir "/snd-16/test.snd") save-as-name)))
(snd-display #__line__ ";after-save-as-hook name: ~A (~A)" save-as-name (string-append home-dir "/cl/test.snd")))
(hook-push open-raw-sound-hook
- (lambda (file choice)
- (if (not (string=? (my-substring file (- (string-length file) 8)) "test.snd"))
- (snd-display #__line__ ";open-raw-sound-hook file: ~A?" (my-substring file (- (string-length file) 8))))
- (if (not (eq? choice #f))
- (snd-display #__line__ ";open-raw-sound-hook choice: ~A?" choice))
- (list 2 44100 mus-mulaw)))
+ (lambda (hook)
+ (let ((file (hook 'name))
+ (choice (hook 'state)))
+ (if (not (string=? (substring file (- (length file) 8)) "test.snd"))
+ (snd-display #__line__ ";open-raw-sound-hook file: ~A?" (substring file (- (length file) 8))))
+ (if choice
+ (snd-display #__line__ ";open-raw-sound-hook choice: ~A?" choice))
+ (set! (hook 'result) (list 2 44100 mus-mulaw)))))
(set! ind (open-sound "test.snd"))
(if (or (not (= (header-type ind) mus-raw))
- (not (= (data-format ind) mus-mulaw))
+ (not (= (sample-type ind) mus-mulaw))
(not (= (chans ind) 2))
(not (= (srate ind) 44100))
- (not (= (frames ind) 50828)))
+ (not (= (framples ind) 50828)))
(snd-display #__line__ ";open-raw-sound-hook 1: ~A ~A ~A ~A ~A"
- (header-type ind) (data-format ind) (chans ind) (srate ind) (frames ind)))
+ (header-type ind) (sample-type ind) (chans ind) (srate ind) (framples ind)))
(close-sound ind)
(hook-append open-raw-sound-hook
- (lambda (file choice)
- (if (not (equal? choice (list 2 44100 mus-mulaw)))
- (snd-display #__line__ ";open-raw-sound-hook 2: ~A" choice))
- (list 1 22050 mus-lint)))
+ (lambda (hook)
+ (if (not (equal? (hook 'name) "/home/bil/cl/test.snd"))
+ (snd-display #__line__ ";open-raw-sound-hook 2: ~A" (hook 'name)))
+ (set! (hook 'result) (list 1 22050 mus-lint))))
(set! ind (open-sound "test.snd"))
(if (or (not (= (header-type ind) mus-raw))
- (not (= (data-format ind) mus-lint))
+ (not (= (sample-type ind) mus-lint))
(not (= (chans ind) 1))
(not (= (srate ind) 22050))
- (not (= (frames ind) (/ 50828 2))))
+ (not (= (framples ind) (/ 50828 2))))
(snd-display #__line__ ";open-raw-sound-hook 3: ~A ~A ~A ~A ~A"
- (header-type ind) (data-format ind) (chans ind) (srate ind) (frames ind)))
+ (header-type ind) (sample-type ind) (chans ind) (srate ind) (framples ind)))
(close-sound ind)
- (set! (hook-functions open-raw-sound-hook) '())
+ (set! (hook-functions open-raw-sound-hook) ())
(hook-push open-raw-sound-hook
- (lambda (file choice)
- (list 2)))
+ (lambda (hook)
+ (set! (hook 'result) (list 2))))
(set! ind (open-sound "test.snd"))
(if (or (not (= (header-type ind) mus-raw))
- (not (= (data-format ind) mus-lint))
+ (not (= (sample-type ind) mus-lint))
(not (= (chans ind) 2))
(not (= (srate ind) 22050)))
(snd-display #__line__ ";open-raw-sound-hook 4: ~A ~A ~A ~A"
- (header-type ind) (data-format ind) (chans ind) (srate ind)))
+ (header-type ind) (sample-type ind) (chans ind) (srate ind)))
(close-sound ind)
- (set! (hook-functions open-raw-sound-hook) '())
+ (set! (hook-functions open-raw-sound-hook) ())
(hook-push open-raw-sound-hook
- (lambda (file choice)
- (list 1 22050 mus-bshort 120 320)))
+ (lambda (hook)
+ (set! (hook 'result) (list 1 22050 mus-bshort 120 320))))
(set! ind (open-sound "test.snd"))
(if (or (not (= (header-type ind) mus-raw))
- (not (= (data-format ind) mus-bshort))
+ (not (= (sample-type ind) mus-bshort))
(not (= (chans ind) 1))
(not (= (srate ind) 22050))
(not (= (data-location ind) 120))
(not (= (data-size ind) 320))
- (not (= (frames ind) 160)))
+ (not (= (framples ind) 160)))
(snd-display #__line__ ";open-raw-sound-hook 5: ~A ~A ~A ~A ~A ~A ~A"
- (header-type ind) (data-format ind) (chans ind) (srate ind)
- (data-location ind) (data-size ind) (/ (frames ind) 2)))
+ (header-type ind) (sample-type ind) (chans ind) (srate ind)
+ (data-location ind) (data-size ind) (/ (framples ind) 2)))
(close-sound ind)
- (set! (hook-functions open-raw-sound-hook) '())))
- (set! (hook-functions during-open-hook) '())
+ (set! (hook-functions open-raw-sound-hook) ())))
+ (set! (hook-functions during-open-hook) ())
(let ((ind #f)
(op #f)
@@ -31509,238 +25886,211 @@ EDITS: 2
(scl #f)
(other #f))
(hook-push open-hook
- (lambda (filename)
- (if (not (string=? filename (mus-expand-filename "oboe.snd")))
- (snd-display #__line__ ";open-hook: ~A?" filename))
- (set! op #t)
- #f))
+ (lambda (hook)
+ (let ((filename (hook 'name)))
+ (if (not (string=? filename (mus-expand-filename "oboe.snd")))
+ (snd-display #__line__ ";open-hook: ~A?" filename))
+ (set! op #t)
+ (set! (hook 'result) #f))))
(hook-push after-open-hook
- (lambda (snd)
- (set! aop snd)))
+ (lambda (hook)
+ (set! aop (hook 'snd))))
(hook-push during-open-hook
- (lambda (fd filename reason)
- (set! dop #t)
- (if (fneq (mus-file-prescaler fd) 1.0)
- (snd-display #__line__ ";mus-file-prescaler: ~A" (mus-file-prescaler fd)))
- (if (not (mus-file-clipping fd))
- (snd-display #__line__ ";mus-file-clipping: ~A" (mus-file-clipping fd)))
- (if (not (string=? filename (mus-expand-filename "oboe.snd")))
- (snd-display #__line__ ";during-open-hook filename: ~A?" filename))
- (if (not (= reason 1))
- (snd-display #__line__ ";during-open-hook reason: ~A?" reason))))
+ (lambda (hook)
+ (let ((filename (hook 'name))
+ (reason (hook 'reason)))
+ (set! dop #t)
+ (if (not (string=? filename (mus-expand-filename "oboe.snd")))
+ (snd-display #__line__ ";during-open-hook filename: ~A?" filename))
+ (if (not (= reason 1))
+ (snd-display #__line__ ";during-open-hook reason: ~A?" reason)))))
(hook-push initial-graph-hook
- (lambda (snd chn dur)
- (if (not (= chn 0))
- (snd-display #__line__ ";initial-graph-hook (channel): ~A not 0?" chn))
+ (lambda (hook)
+ (if (not (= (hook 'chn) 0))
+ (snd-display #__line__ ";initial-graph-hook (channel): ~A not 0?" (hook 'chn)))
(set! ig #t)
- #f))
+ (set! (hook 'result) #f)))
(set! ind (open-sound "oboe.snd"))
(if (not op) (snd-display #__line__ ";open-hook not called?"))
(if (not dop) (snd-display #__line__ ";during-open-hook not called?"))
- (if (not ig) (snd-display #__line__ ";initial-graph-hook not called?"))
+ (when with-gui (if (not ig) (snd-display #__line__ ";initial-graph-hook not called?")))
(if (not (sound? aop)) (snd-display #__line__ ";after-open-hook not called?"))
(if (not (equal? aop ind)) (snd-display #__line__ ";after-open-hook ~A but ind: ~A?" aop ind))
(select-all)
- (set! (hook-functions open-hook) '())
- (set! (hook-functions during-open-hook) '())
- (set! (hook-functions after-open-hook) '())
- (set! (hook-functions initial-graph-hook) '())
+ (set! (hook-functions open-hook) ())
+ (set! (hook-functions during-open-hook) ())
+ (set! (hook-functions after-open-hook) ())
+ (set! (hook-functions initial-graph-hook) ())
- (hook-push open-hook (lambda (filename) #t))
+ (hook-push open-hook (lambda (hook) (set! (hook 'result) #t)))
(let ((pistol (open-sound "pistol.snd")))
- (if (not (eq? pistol #f))
+ (if pistol
(begin
(snd-display #__line__ ";open-hook #t, but open-sound -> ~A" pistol)
(if (sound? pistol) (close-sound pistol)))))
- (set! (hook-functions open-hook) '())
+ (set! (hook-functions open-hook) ())
(let ((gr #f)
(agr #f)
(gbf #f)
(abf #f))
- (set! (hook-functions before-transform-hook) '())
- (set! (hook-functions after-transform-hook) '())
- (set! (hook-functions after-graph-hook) '())
- (set! (hook-functions graph-hook) '())
+ (set! (hook-functions before-transform-hook) ())
+ (set! (hook-functions after-transform-hook) ())
+ (set! (hook-functions after-graph-hook) ())
+ (set! (hook-functions graph-hook) ())
(hook-push graph-hook
- (lambda (snd chn y0 y1)
- (if (not (equal? snd ind))
- (snd-display #__line__ ";graph-hook: ~A not ~A?" snd ind))
- (if (not (= chn 0))
- (snd-display #__line__ ";graph-hook (channel): ~A not 0?" chn))
- (set! gr #t)
- #f))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (if (not (equal? snd ind))
+ (snd-display #__line__ ";graph-hook: ~A not ~A?" snd ind))
+ (if (not (= chn 0))
+ (snd-display #__line__ ";graph-hook (channel): ~A not 0?" chn))
+ (set! gr #t)
+ (set! (hook 'result) #f))))
(hook-push after-graph-hook
- (lambda (snd chn)
- (if (not (equal? snd ind))
- (snd-display #__line__ ";after-graph-hook: ~A not ~A?" snd ind))
- (if (not (= chn 0))
- (snd-display #__line__ ";after-graph-hook (channel): ~A not 0?" chn))
- (set! agr #t)))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (if (not (equal? snd ind))
+ (snd-display #__line__ ";after-graph-hook: ~A not ~A?" snd ind))
+ (if (not (= chn 0))
+ (snd-display #__line__ ";after-graph-hook (channel): ~A not 0?" chn))
+ (set! agr #t))))
(hook-push before-transform-hook
- (lambda (snd chn)
+ (lambda (hook)
(set! gbf #t)
- (cursor)))
+ (set! (hook 'result) (cursor))))
(hook-push after-transform-hook
- (lambda (snd chn scale)
- (set! abf #t)
- (if (and (transform-graph? snd chn)
- (= (transform-graph-type snd chn) graph-once))
- (report-in-minibuffer
- (number->string (/ (* 2.0 (vct-peak (transform->vct snd chn)))
- (transform-size snd chn)))
- snd)
- #f)))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (set! abf #t)
+ (if (and (transform-graph? snd chn)
+ (= (transform-graph-type snd chn) graph-once))
+ (status-report
+ (number->string (/ (* 2.0 (float-vector-peak (transform->float-vector snd chn)))
+ (transform-size snd chn)))
+ snd)
+ (set! (hook 'result) #f)))))
(set! (transform-graph? ind 0) #t)
(set! (time-graph? ind 0) #t)
(update-time-graph ind 0)
(update-transform-graph ind 0)
- (if (not gr)
- (if (and (provided? 'snd-motif) (provided? 'xm))
- (do ((i 0 (+ 1 i))
- (happy #f)
- (app (car (main-widgets))))
- ((or happy (= i 1000)))
- (let ((msk (XtAppPending app)))
- (if (= (logand msk (logior XtIMXEvent XtIMAlternateInput)) 0)
- (set! happy #t)
- (XtDispatchEvent (XtAppNextEvent app)))))))
-
- (if (not gr) (snd-display #__line__ ";graph-hook not called? ~A ~A ~A ~A" (time-graph? ind) (short-file-name ind) ind (sounds)))
- (if (not agr) (snd-display #__line__ ";after-graph-hook not called?"))
- (if (not gbf) (snd-display #__line__ ";before-transform-hook not called?"))
- (if (not abf) (snd-display #__line__ ";after-transform-hook not called?"))
- (set! (hook-functions before-transform-hook) '())
+ (if (and (not gr)
+ (provided? 'snd-motif)
+ (provided? 'xm))
+ (with-let (sublet *motif*)
+ (do ((i 0 (+ i 1))
+ (happy #f)
+ (app (car (main-widgets))))
+ ((or happy (= i 1000)))
+ (let ((msk (XtAppPending app)))
+ (if (= (logand msk (logior XtIMXEvent XtIMAlternateInput)) 0)
+ (set! happy #t)
+ (XtDispatchEvent (XtAppNextEvent app)))))))
+
+ (when with-gui
+ (if (and (not gr) (not (provided? 'snd-gtk)))
+ (snd-display #__line__ ";graph-hook not called? ~A ~A ~A ~A" (time-graph? ind) (short-file-name ind) ind (sounds)))
+ (if (and (not agr) (not (provided? 'snd-gtk)))
+ (snd-display #__line__ ";after-graph-hook not called?"))
+ (if (not gbf)
+ (snd-display #__line__ ";before-transform-hook not called?"))
+ (if (and (not abf) (not (provided? 'snd-gtk)))
+ (snd-display #__line__ ";after-transform-hook not called?")))
+ (set! (hook-functions before-transform-hook) ())
(set! (transform-graph? ind 0) #f)
- (set! (hook-functions graph-hook) '())
- (set! (hook-functions after-graph-hook) '()))
+ (set! (hook-functions graph-hook) ())
+ (set! (hook-functions after-graph-hook) ()))
(set! other (open-sound "pistol.snd"))
- (hook-push select-sound-hook
- (lambda (snd)
- (if (not (equal? snd ind))
- (snd-display #__line__ ";select-sound-hook: ~A not ~A?" snd ind))
+ (hook-push select-sound-hook
+ (lambda (hook)
+ (if (not (equal? (hook 'snd) ind))
+ (snd-display #__line__ ";select-sound-hook: ~A not ~A?" (hook 'snd) ind))
(set! sl #t)))
(hook-push select-channel-hook
- (lambda (snd chn)
- (if (not (equal? snd ind))
- (snd-display #__line__ ";select-channel-hook: ~A not ~A?" snd ind))
- (if (not (= chn 0))
- (snd-display #__line__ ";select-channel-hook (channel): ~A not 0?" chn))
- (set! scl #t)))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (if (not (equal? snd ind))
+ (snd-display #__line__ ";select-channel-hook: ~A not ~A?" snd ind))
+ (if (not (= chn 0))
+ (snd-display #__line__ ";select-channel-hook (channel): ~A not 0?" chn))
+ (set! scl #t))))
(select-sound ind)
(if (not sl) (snd-display #__line__ ";select-sound-hook not called?"))
(if (not scl) (snd-display #__line__ ";select-channel-hook not called?"))
- (set! (hook-functions select-sound-hook) '())
- (set! (hook-functions select-channel-hook) '())
+ (set! (hook-functions select-sound-hook) ())
+ (set! (hook-functions select-channel-hook) ())
(let ((spl #f)
(stl #f)
- (ph #f)
- (ph1 #f))
+ (ph #f))
(hook-push start-playing-hook
- (lambda (snd)
- (if (not (equal? snd ind))
- (snd-display #__line__ ";start-playing-hook: ~A not ~A?" snd ind))
+ (lambda (hook)
+ (if (not (equal? (hook 'snd) ind))
+ (snd-display #__line__ ";start-playing-hook: ~A not ~A?" (hook 'snd) ind))
(set! spl #t)
- #f))
+ (set! (hook 'result) #f)))
(hook-push stop-playing-hook
- (lambda (snd)
- (if (not (equal? snd ind))
- (snd-display #__line__ ";stop-playing-hook: ~A not ~A?" snd ind))
+ (lambda (hook)
+ (if (not (equal? (hook 'snd) ind))
+ (snd-display #__line__ ";stop-playing-hook: ~A not ~A?" (hook 'snd) ind))
(set! stl #t)))
(hook-push play-hook
- (lambda (n)
- (if (< n 128)
- (snd-display #__line__ ";play-hook samps: ~A?" n))
- (set! (expand-control-hop) (expand-control-hop))
- (set! (expand-control-length) (expand-control-length))
- (set! (expand-control-ramp) (expand-control-ramp))
- (set! (contrast-control-amp) (contrast-control-amp))
- (set! (reverb-control-lowpass) (reverb-control-lowpass))
- (set! (reverb-control-feedback) (reverb-control-feedback))
+ (lambda (hook)
+ (if (< (hook 'size) 128)
+ (snd-display #__line__ ";play-hook samps: ~A?" (hook 'size)))
(set! ph #t)))
- (hook-push dac-hook
- (lambda (n)
- (if (not (sound-data? n))
- (snd-display #__line__ ";dac-hook data: ~A?" n))
- (if (and (< (sound-data-length n) 128)
- (not (= (sound-data-length n) 64))) ; mac case
- (snd-display #__line__ ";dac-hook data length: ~A?" (sound-data-length n)))
- (set! ph1 #t)))
(set! (expand-control? ind) #t)
(set! (reverb-control? ind) #t)
- (play ind :wait #t)
+ (play ind :wait #t :end 1000)
(set! (reverb-control? ind) #f)
(set! (expand-control? ind) #f)
- (if (not spl) (snd-display #__line__ ";start-playing-hook not called?"))
- (if (not stl) (snd-display #__line__ ";stop-playing-hook not called?"))
- (if (not ph) (snd-display #__line__ ";play-hook not called?"))
- (if (not ph1) (snd-display #__line__ ";dac-hook not called?"))
- (set! (hook-functions start-playing-hook) '())
- (set! (hook-functions start-playing-selection-hook) '())
- (set! (hook-functions stop-playing-hook) '())
- (set! (hook-functions play-hook) '())
- (set! (hook-functions dac-hook) '())
+ (when with-gui
+ (if (not spl) (snd-display #__line__ ";start-playing-hook not called?"))
+ (if (not stl) (snd-display #__line__ ";stop-playing-hook not called?"))
+ (if (not ph) (snd-display #__line__ ";play-hook not called?")))
+ (set! (hook-functions start-playing-hook) ())
+ (set! (hook-functions start-playing-selection-hook) ())
+ (set! (hook-functions stop-playing-hook) ())
+ (set! (hook-functions play-hook) ())
(hook-push play-hook
- (lambda (n)
- (set! (expand-control-hop) .02)
- (set! (expand-control-length) .02)
- (set! (expand-control-ramp) .2)
- (set! (contrast-control-amp) 0.5)
- (set! (reverb-control-lowpass) .02)
- (set! (reverb-control-feedback) .02)))
-
- (play ind :wait #t)
- (set! (hook-functions play-hook) '())
-
- (hook-push start-playing-hook (lambda (sp) #t))
+ (lambda (hook)
+ (set! *expand-control-hop* .02)
+ (set! *expand-control-length* .02)
+ (set! *expand-control-ramp* .2)
+ (set! *contrast-control-amp* 0.5)
+ (set! *reverb-control-lowpass* .02)
+ (set! *reverb-control-feedback* .02)))
+
+ (play ind :wait #t :end 1000)
+ (set! (hook-functions play-hook) ())
+
+ (hook-push start-playing-hook (lambda (hook) (set! (hook 'result) #t)))
(play "4.aiff")
- (set! (hook-functions start-playing-hook) '())
+ (set! (hook-functions start-playing-hook) ())
(let ((ss #f)
- (old-reg (selection-creates-region)))
- (set! (selection-creates-region) #t)
- (hook-push stop-playing-selection-hook (lambda () (set! ss #t)))
+ (old-reg *selection-creates-region*))
+ (set! *selection-creates-region* #t)
+ (hook-push stop-playing-selection-hook (lambda (hook) (set! ss #t)))
(let ((reg (select-all)))
(play (selection) :wait #t)
(if (region? reg) (play reg :wait #t))
(if (not ss) (snd-display #__line__ ";stop-playing-selection-hook: ~A" ss)))
- (set! (hook-functions stop-playing-selection-hook) '())
- (set! (selection-creates-region) old-reg))
-
- (let ((ctr 0))
- (hook-push dac-hook
- (lambda (n)
- (set! ctr (+ 1 ctr))
- (stop-playing)))
- (play ind :wait #t)
- (if (> ctr 2) (snd-display #__line__ ";stop-playing: ~A" ctr))
- (set! (hook-functions dac-hook) '()))
-
- (let ((pl (make-player ind 0))
- (ctr 0))
- (if (not (player? pl)) (snd-display #__line__ ";make-player: ~A" pl))
- (if (= (length (players)) 0) (snd-display #__line__ ";players: ~A" (players)))
- (hook-push dac-hook
- (lambda (n)
- (set! ctr (+ 1 ctr))
- (if (player? pl)
- (stop-player pl)
- (if (= ctr 1)
- (snd-display #__line__ ";player messed up")))))
- (add-player pl)
- (start-playing 1 22050 #f)
- (if (> ctr 2) (snd-display #__line__ ";stop-player: ~A" ctr))
- (set! (hook-functions dac-hook) '()))
+ (set! (hook-functions stop-playing-selection-hook) ())
+ (set! *selection-creates-region* old-reg))
(let ((pl (make-player ind 0)))
(free-player pl)
@@ -31754,24 +26104,24 @@ EDITS: 2
(a0 #f)
(a1 #f))
(hook-push (edit-hook ind 0)
- (lambda ()
+ (lambda (hook)
(set! e0 #t)
- #t))
+ (set! (hook 'result) #t)))
(hook-push (edit-hook other 0)
- (lambda ()
+ (lambda (hook)
(set! e1 #t)
- #f))
+ (set! (hook 'result) #f)))
(hook-push (undo-hook ind 0)
- (lambda ()
+ (lambda (hook)
(set! u0 #t)))
(hook-push (undo-hook other 0)
- (lambda ()
+ (lambda (hook)
(set! u1 #t)))
(hook-push (after-edit-hook ind 0)
- (lambda ()
+ (lambda (hook)
(set! a0 #t)))
(hook-push (after-edit-hook other 0)
- (lambda ()
+ (lambda (hook)
(set! a1 #t)))
;; edit of ind should be disallowed, but not other
@@ -31791,28 +26141,28 @@ EDITS: 2
(undo 1 other 0)
(if (not u1) (snd-display #__line__ ";undo-hook not called?"))
- (set! (hook-functions (edit-hook ind 0)) '())
- (set! (hook-functions (edit-hook other 0)) '())
- (set! (hook-functions (after-edit-hook ind 0)) '())
- (set! (hook-functions (after-edit-hook other 0)) '())
- (set! (hook-functions (undo-hook ind 0)) '())
- (set! (hook-functions (undo-hook other 0)) '()))
+ (set! (hook-functions (edit-hook ind 0)) ())
+ (set! (hook-functions (edit-hook other 0)) ())
+ (set! (hook-functions (after-edit-hook ind 0)) ())
+ (set! (hook-functions (after-edit-hook other 0)) ())
+ (set! (hook-functions (undo-hook ind 0)) ())
+ (set! (hook-functions (undo-hook other 0)) ()))
(let ((se #f)
(sw #f)
(me #f))
(hook-push snd-error-hook
- (lambda (msg)
+ (lambda (hook)
(set! se #t)
- #t))
+ (set! (hook 'result) #t)))
(hook-push snd-warning-hook
- (lambda (msg)
+ (lambda (hook)
(set! sw #t)
- #t))
+ (set! (hook 'result) #t)))
(hook-push mus-error-hook
- (lambda (typ msg)
+ (lambda (hook)
(set! me #t)
- #t))
+ (set! (hook 'result) #t)))
(snd-error "uhoh")
(snd-warning "hiho")
@@ -31821,93 +26171,60 @@ EDITS: 2
(if (not se) (snd-display #__line__ ";snd-error-hook not called?"))
(if (not sw) (snd-display #__line__ ";snd-warning-hook not called?"))
(if (not me) (snd-display #__line__ ";mus-error-hook not called?"))
- (set! (hook-functions snd-error-hook) '())
- (set! (hook-functions snd-warning-hook) '())
- (set! (hook-functions mus-error-hook) '())
+ (set! (hook-functions snd-error-hook) ())
+ (set! (hook-functions snd-warning-hook) ())
+ (set! (hook-functions mus-error-hook) ())
(hook-push snd-error-hook
- (lambda (msg)
- (set! se msg)
- #t))
+ (lambda (hook)
+ (set! se (hook 'message))
+ (set! (hook 'result) #t)))
(snd-error "not an error")
(if (or (not (string? se))
(not (string=? se "not an error")))
(snd-display #__line__ ";snd-error-hook saw: ~A" se))
- (set! (hook-functions snd-error-hook) '()))
+ (set! (hook-functions snd-error-hook) ()))
- (hook-push before-exit-hook (lambda () #f))
- (hook-push before-exit-hook (lambda () #t))
- (hook-push exit-hook (lambda () #f))
+ (hook-push before-exit-hook (lambda (hook) (set! (hook 'result) #t)))
+ (hook-push exit-hook (lambda (hook) #f))
(exit)
- (set! (hook-functions exit-hook) '())
- (set! (hook-functions before-exit-hook) '())
+ (set! (hook-functions exit-hook) ())
+ (set! (hook-functions before-exit-hook) ())
(let ((sh #f))
(if (file-exists? "baddy.snd") (delete-file "baddy.snd"))
(hook-push save-hook
- (lambda (snd filename)
- (if (or (not (string? filename))
- (not (string=? filename (mus-expand-filename "baddy.snd"))))
- (snd-display #__line__ ";save-hook filename: ~A?" filename))
- (if (not (equal? snd ind))
- (snd-display #__line__ ";save-hook snd: ~A ~A?" snd ind))
- (set! sh #t)
- #t))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (filename (hook 'name)))
+ (if (or (not (string? filename))
+ (not (string=? filename (mus-expand-filename "baddy.snd"))))
+ (snd-display #__line__ ";save-hook filename: ~A?" filename))
+ (if (not (equal? snd ind))
+ (snd-display #__line__ ";save-hook snd: ~A ~A?" snd ind))
+ (set! sh #t)
+ (set! (hook 'result) #t))))
(save-sound-as "baddy.snd" ind)
(if (not sh) (snd-display #__line__ ";save-hook not called?"))
(if (file-exists? "baddy.snd")
(begin
(snd-display #__line__ ";save-hook didn't cancel save?")
(delete-file "baddy.snd")))
- (set! (hook-functions save-hook) '()))
+ (set! (hook-functions save-hook) ()))
;; after-transform-hooks require some way to force the fft to run to completion
;; property-changed hook is similar (seems to happen whenever it's good and ready)
(hook-push close-hook
- (lambda (snd)
- (if (not (equal? snd ind))
- (snd-display #__line__ ";close-hook: ~A not ~A?" snd ind))
+ (lambda (hook)
+ (if (not (equal? (hook 'snd) ind))
+ (snd-display #__line__ ";close-hook: ~A not ~A?" (hook 'snd) ind))
(set! cl #t)))
(close-sound ind)
(if (not cl) (snd-display #__line__ ";close-hook not called?"))
- (set! (hook-functions close-hook) '())
+ (set! (hook-functions close-hook) ())
(close-sound other))
- (hook-push print-hook (lambda (str)
- (if (and (char=? (string-ref str 0) #\#)
- (or (and (= (print-length) 30) ; test 9
- (not (string=? str "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...)")))
- (and (= (print-length) 12) ; just test 13
- (not (string=? str "#(0 0 0 0 0 0 0 0 0 0 0 0 ...)")))))
- (snd-display #__line__ ";vector abbreviation: ~A" str))
- #f))
- (let ((v (make-vector 128 0)))
- (snd-print v)
- (set! (hook-functions print-hook) '()))
-
- ; (let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 1 "auto-update test"))
- ; (ind1 (new-sound "fmv1.snd" mus-next mus-bshort 22050 1 "auto-update test"))
- ; (old-update (auto-update)))
- ; (pad-channel 0 1000 ind 0)
- ; (pad-channel 0 1000 ind1 0)
- ; (save-sound ind)
- ; (save-sound ind1)
- ; (set! (auto-update) #t)
- ; (sleep 1) ; make sure write dates differ(!)
- ; (system "cp oboe.snd fmv1.snd") ; ind1 needs auto-update now
- ; (set-sample 100 0.55 ind 0 #f)
- ; (if (fneq (sample 100 ind 0) 0.55) (snd-display #__line__ ";set-sample: ~A" (sample 100 ind 0)))
- ; (save-sound ind) ; this should cause auto-update scan of all files
- ; (set! ind1 (find-sound "fmv1.snd")) ; hmmm auto-update can change any file's index!
- ; (if (not (= (frames ind1) (mus-sound-frames "oboe.snd")))
- ; (snd-display #__line__ ";fmv1 after update: ~A" (frames ind1)))
- ; (set! (auto-update) old-update)
- ; (close-sound ind)
- ; (close-sound ind1)
- ; (delete-file "fmv.snd")
- ; (delete-file "fmv1.snd"))
-
(if (not (provided? 'alsa))
(let ((in1 (open-sound "oboe.snd"))
(in2 (open-sound "2.snd")))
@@ -31933,7 +26250,7 @@ EDITS: 2
(list 'convolve-with (lambda ()
(convolve-with "1a.snd" 0.5 ind 0)))
(list 'delete-mix (lambda ()
- (let ((mx (mix-vct (make-vct 3 .2) 123)))
+ (let ((mx (mix-float-vector (make-float-vector 3 .2) 123)))
(if (mix? mx) (set! (mix-amp mx) 0.0)))))
(list 'delete-sample (lambda ()
(delete-sample 123 ind 0)))
@@ -31964,7 +26281,7 @@ EDITS: 2
(list 'insert-sample (lambda ()
(insert-sample 123 .5 ind 0)))
(list 'insert-samples (lambda ()
- (insert-samples 123 3 (make-vct 3 1.0) ind 0)))
+ (insert-samples 123 3 (make-float-vector 3 1.0) ind 0)))
(list 'insert-selection (lambda ()
(let ((reg (select-all ind 0)))
(insert-selection 120 ind 0)
@@ -31973,23 +26290,23 @@ EDITS: 2
(insert-silence 123 456 ind 0)))
(list 'insert-sound (lambda ()
(insert-sound "1a.snd" 123)))
- (list 'map-chan (lambda ()
- (map-chan (lambda (y) (+ y .2)))))
+ (list 'map-channel (lambda ()
+ (map-channel (lambda (y) (+ y .2)))))
(list 'map-channel (lambda ()
(map-channel (lambda (y) (+ y .2)))))
(list 'mix (lambda ()
(mix "1a.snd" 123)))
(list 'mix-amp (lambda ()
- (let ((mx (mix-vct (make-vct 3 1.0) 123)))
+ (let ((mx (mix-float-vector (make-float-vector 3 1.0) 123)))
(if (mix? mx) (set! (mix-amp mx) .123)))))
(list 'mix-amp-env (lambda ()
- (let ((mx (mix-vct (make-vct 3 1.0) 123)))
+ (let ((mx (mix-float-vector (make-float-vector 3 1.0) 123)))
(if (mix? mx) (set! (mix-amp-env mx) '(0 0 1 1))))))
(list 'mix-position (lambda ()
- (let ((mx (mix-vct (make-vct 3 1.0) 123)))
+ (let ((mx (mix-float-vector (make-float-vector 3 1.0) 123)))
(if (mix? mx) (set! (mix-position mx) 123)))))
(list 'mix-speed (lambda ()
- (let ((mx (mix-vct (make-vct 3 1.0) 123)))
+ (let ((mx (mix-float-vector (make-float-vector 3 1.0) 123)))
(if (mix? mx) (set! (mix-speed mx) .123)))))
(list 'mix-region (lambda ()
(let ((reg (make-region 0 100 ind 0)))
@@ -31999,12 +26316,10 @@ EDITS: 2
(let ((reg (select-all ind 0)))
(mix-selection 1234 ind 0)
(if (region? reg) (forget-region reg)))))
- (list 'mix-vct (lambda ()
- (mix-vct (make-vct 10 .3) 123)))
+ (list 'mix-float-vector (lambda ()
+ (mix-float-vector (make-float-vector 10 .3) 123)))
(list 'pad-channel (lambda ()
(pad-channel 123 456 ind 0)))
- (list 'ptree-channel (lambda ()
- (ptree-channel (lambda (y) (+ y .2)))))
(list 'ramp-channel (lambda ()
(ramp-channel 0.0 0.5 123 456)))
(list 'reverse-channel (lambda ()
@@ -32051,28 +26366,27 @@ EDITS: 2
(let ((ind1 (open-sound "1a.snd")))
(swap-channels ind 0 ind1 0)
(close-sound ind1))))
- (list 'vct->channel (lambda ()
- (vct->channel (make-vct 3) 123 3 ind 0)))
+ (list 'float-vector->channel (lambda ()
+ (float-vector->channel (make-float-vector 3) 123 3 ind 0)))
(list 'xramp-channel (lambda ()
(xramp-channel .5 1.0 32.0 123 456 ind 0))))))
(if (and (provided? 'snd-motif)
(provided? 'xm))
- (let* ((edhist (list-ref (channel-widgets ind 0) 7))
- (edp (XtParent edhist))
- (pmax (cadr (XtVaGetValues edp (list XmNpaneMaximum 0)))))
- (XtUnmanageChild edp)
- (XtVaSetValues edp (list XmNpaneMinimum 100))
- (XtManageChild edp)))
+ (let* ((edhist ((channel-widgets ind 0) 7))
+ (edp ((*motif* 'XtParent) edhist)))
+ ((*motif* 'XtUnmanageChild) edp)
+ ((*motif* 'XtVaSetValues) edp (list (*motif* 'XmNpaneMinimum) 100))
+ ((*motif* 'XtManageChild) edp)))
(hook-push (edit-hook ind 0)
- (lambda ()
+ (lambda (hook)
(set! edit-hook-ctr (+ 1 edit-hook-ctr))
- #t))
+ (set! (hook 'result) #t)))
(hook-push (after-edit-hook ind 0)
- (lambda ()
+ (lambda (hook)
(set! after-edit-hook-ctr (+ 1 after-edit-hook-ctr))
- #t))
+ (set! (hook 'result) #t)))
(for-each
(lambda (func-and-name)
(let ((func (cadr func-and-name))
@@ -32082,29 +26396,29 @@ EDITS: 2
(if (not (= edit-hook-ctr 1)) (snd-display #__line__ ";~A: edit hook calls: ~A" name edit-hook-ctr))
(if (not (= after-edit-hook-ctr 0)) (snd-display #__line__ ";~A: after edit hook calls: ~A" name after-edit-hook-ctr))
(set! edit-hook-ctr 0)
- (if (not (equal? (mixes ind 0) '())) (snd-display #__line__ ";[27315] ~A: mixes: ~A" name (mixes ind 0)))))
+ (if (not (null? (mixes ind 0))) (snd-display #__line__ ";[27315] ~A: mixes: ~A" name (mixes ind 0)))))
all-tests)
(set! edit-hook-ctr 0)
(set! after-edit-hook-ctr 0)
- (set! (hook-functions (edit-hook ind 0)) '())
- (set! (hook-functions (after-edit-hook ind 0)) '())
+ (set! (hook-functions (edit-hook ind 0)) ())
+ (set! (hook-functions (after-edit-hook ind 0)) ())
(hook-push (edit-hook ind 0)
- (lambda ()
+ (lambda (hook)
(set! edit-hook-ctr (+ 1 edit-hook-ctr))
- #f))
+ (set! (hook 'result) #f)))
(hook-push (after-edit-hook ind 0)
- (lambda ()
+ (lambda (hook)
(set! after-edit-hook-ctr (+ 1 after-edit-hook-ctr))
- #t))
+ (set! (hook 'result) #t)))
(for-each
(lambda (func-and-name)
(let ((func (cadr func-and-name))
(name (car func-and-name)))
(func)
- (if (not (> (edit-position ind 0) 0)) (snd-display #__line__ ";~A: unblocked edit: ~A" name (edit-position ind 0)))
- (if (not (> edit-hook-ctr 0)) (snd-display #__line__ ";~A: unblocked edit hook calls: ~A" name edit-hook-ctr))
- (if (not (> after-edit-hook-ctr 0)) (snd-display #__line__ ";~A: unblocked after edit hook calls: ~A" name after-edit-hook-ctr))
+ (if (<= (edit-position ind 0) 0) (snd-display #__line__ ";~A: unblocked edit: ~A" name (edit-position ind 0)))
+ (if (<= edit-hook-ctr 0) (snd-display #__line__ ";~A: unblocked edit hook calls: ~A" name edit-hook-ctr))
+ (if (<= after-edit-hook-ctr 0) (snd-display #__line__ ";~A: unblocked after edit hook calls: ~A" name after-edit-hook-ctr))
(set! edit-hook-ctr 0)
(set! after-edit-hook-ctr 0)
(revert-sound ind)))
@@ -32112,81 +26426,86 @@ EDITS: 2
(if (and (provided? 'snd-motif)
(provided? 'xm))
- (let* ((edhist (list-ref (channel-widgets ind 0) 7))
- (edp (XtParent edhist)))
- (XtUnmanageChild edp)
- (XtVaSetValues edp (list XmNpaneMinimum 1)) ; not 0 here -- Xt warnings
- (XtManageChild edp)))
+ (let* ((edhist ((channel-widgets ind 0) 7))
+ (edp ((*motif* 'XtParent) edhist)))
+ ((*motif* 'XtUnmanageChild) edp)
+ ((*motif* 'XtVaSetValues) edp (list (*motif* 'XmNpaneMinimum) 1)) ; not 0 here -- Xt warnings
+ ((*motif* 'XtManageChild) edp)))
(close-sound ind))
(hook-push mouse-enter-text-hook
- (lambda (w)
- (focus-widget w)))
+ (lambda (hook)
+ (focus-widget (hook 'widget))))
(hook-push mouse-leave-text-hook
- (lambda (w)
- (focus-widget w)))
+ (lambda (hook)
+ (focus-widget (hook 'widget))))
(describe-hook mouse-enter-text-hook)
- (reset-almost-all-hooks)
+ (reset-all-hooks)
(let ((ind (open-sound "oboe.snd")))
(scale-by 2.0)
- (hook-push (edit-hook ind 0) (lambda () #t))
- (mix-vct (make-vct 10 .1) 0)
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";mix-vct: blocked edit: ~A" (edit-position ind 0)))
- (if (not (equal? (mixes ind 0) '())) (snd-display #__line__ ";mix-vct edit-hook: mixes: ~A" (mixes ind 0)))
+ (hook-push (edit-hook ind 0) (lambda (hook) (set! (hook 'result) #t)))
+ (mix-float-vector (make-float-vector 10 .1) 0)
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";mix-float-vector: blocked edit: ~A" (edit-position ind 0)))
+ (if (not (null? (mixes ind 0))) (snd-display #__line__ ";mix-float-vector edit-hook: mixes: ~A" (mixes ind 0)))
(mix "pistol.snd" 1000)
(if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";mix: blocked edit: ~A" (edit-position ind 0)))
- (if (not (equal? (mixes ind 0) '())) (snd-display #__line__ ";mix edit-hook: mixes: ~A" (mixes ind 0)))
- (set! (hook-functions (edit-hook ind 0)) '())
- (let ((mx (mix-vct (make-vct 10 .1) 1000)))
+ (if (not (null? (mixes ind 0))) (snd-display #__line__ ";mix edit-hook: mixes: ~A" (mixes ind 0)))
+ (set! (hook-functions (edit-hook ind 0)) ())
+ (let ((mx (mix-float-vector (make-float-vector 10 .1) 1000)))
(if (mix? mx) ; might be no-gui case
(begin
- (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix-vct: unblocked edit: ~A" (edit-position ind 0)))
- (if (not (equal? (mixes ind 0) (list mx))) (snd-display #__line__ ";mix-vct un edit-hook: mixes: ~A" (mixes ind 0)))
- (hook-push (edit-hook ind 0) (lambda () #t))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix-float-vector: unblocked edit: ~A" (edit-position ind 0)))
+ (if (not (equal? (mixes ind 0) (list mx))) (snd-display #__line__ ";mix-float-vector un edit-hook: mixes: ~A" (mixes ind 0)))
+ (hook-push (edit-hook ind 0) (lambda (hook) (set! (hook 'result) #t)))
(set! (mix-amp mx) 2.0)
(if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix amp: blocked edit: ~A" (edit-position ind 0)))
(if (fneq (mix-amp mx) 1.0) (snd-display #__line__ ";mix amp: blocked edit: ~A" (mix-amp mx)))
(set! (mix-amp-env mx) '(0 0 1 1 2 0))
(if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix amp env: blocked edit: ~A" (edit-position ind 0)))
- (if (not (null? (mix-amp-env mx))) (snd-display #__line__ ";mix amp env: blocked edit: ~A" (mix-amp-env mx)))
+ (if (pair? (mix-amp-env mx)) (snd-display #__line__ ";mix amp env: blocked edit: ~A" (mix-amp-env mx)))
(set! (mix-speed mx) 2.0)
(if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix speed: blocked edit: ~A" (edit-position ind 0)))
(if (fneq (mix-speed mx) 1.0) (snd-display #__line__ ";mix speed: blocked edit: ~A" (mix-speed mx)))
(set! (mix-position mx) 2000)
(if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix position: blocked edit: ~A" (edit-position ind 0)))
(if (not (= (mix-position mx) 1000)) (snd-display #__line__ ";mix position: blocked edit: ~A" (mix-position mx)))
- (mix-vct (make-vct 10 .2) 0)
- (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix-vct 1: blocked edit: ~A" (edit-position ind 0)))
- (if (not (equal? (mixes ind 0) (list mx))) (snd-display #__line__ ";mix-vct 1 edit-hook: mixes: ~A" (mixes ind 0)))
+ (mix-float-vector (make-float-vector 10 .2) 0)
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";mix-float-vector 1: blocked edit: ~A" (edit-position ind 0)))
+ (if (not (equal? (mixes ind 0) (list mx))) (snd-display #__line__ ";mix-float-vector 1 edit-hook: mixes: ~A" (mixes ind 0)))
)))
(close-sound ind))
(let ((ind (open-sound "oboe.snd")))
- (if (not (null? (hook-functions (edit-hook ind 0)))) (snd-display #__line__ ";edit-hook not cleared at close?"))
- (if (not (null? (hook-functions (after-edit-hook ind 0)))) (snd-display #__line__ ";after-edit-hook not cleared at close?"))
+ (if (pair? (hook-functions (edit-hook ind 0))) (snd-display #__line__ ";edit-hook not cleared at close?"))
+ (if (pair? (hook-functions (after-edit-hook ind 0))) (snd-display #__line__ ";after-edit-hook not cleared at close?"))
(close-sound ind))
- (reset-almost-all-hooks)
+ (reset-all-hooks)
;; before|after-save-as-hook
(let ((hook-called #f))
(hook-push before-save-as-hook ; from docs
- (lambda (index filename selection sr type format comment)
- (if (not (= sr (srate index)))
- (let ((chns (chans index)))
- (do ((i 0 (+ 1 i)))
- ((= i chns))
- (src-channel (exact->inexact (/ (srate index) sr)) 0 #f index i))
- (save-sound-as filename index :header-type type :data-format format :srate sr :comment comment)
- ;; hook won't be invoked recursively
- (do ((i 0 (+ 1 i)))
- ((= i chns))
- (undo 1 index i))
- (set! hook-called #t)
- #t)
- #f)))
+ (lambda (hook)
+ (let ((index (hook 'snd))
+ (filename (hook 'name))
+ (sr (hook 'sampling-rate))
+ (type (hook 'header-type))
+ (dformat (hook 'sample-type))
+ (comment (hook 'comment)))
+ (if (not (= sr (srate index)))
+ (let ((chns (chans index)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (src-channel (* 1.0 (/ (srate index) sr)) 0 #f index i))
+ (save-sound-as filename index :header-type type :sample-type dformat :srate sr :comment comment)
+ ;; hook won't be invoked recursively
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (undo 1 index i))
+ (set! hook-called #t)
+ (set! (hook 'result) #t))))))
(let ((ind (open-sound "2.snd")))
(save-sound-as "test.snd" :srate 44100)
(if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";before-save-as-hook undo: ~A" (edit-position ind 0)))
@@ -32195,19 +26514,26 @@ EDITS: 2
(set! ind (open-sound "test.snd"))
(if (not (= (srate ind) 44100)) (snd-display #__line__ ";before-save-as-hook src: ~A" (srate ind)))
(close-sound ind))
- (set! (hook-functions before-save-as-hook) '()))
+ (set! (hook-functions before-save-as-hook) ()))
(let ((need-save-as-undo #f))
(hook-push before-save-as-hook
- (lambda (index filename selection sr type format comment)
- (set! need-save-as-undo #f)
- (if (not (= sr (srate index)))
- (begin
- (src-sound (exact->inexact (/ (srate index) sr)) 1.0 index)
- (set! need-save-as-undo #t)))
- #f))
+ (lambda (hook)
+ (let ((index (hook 'snd))
+ ;(filename (hook 'name))
+ ;(selection (hook 'selection))
+ (sr (hook 'sampling-rate))
+ ;(type (hook 'header-type))
+ ;(dformat (hook 'sample-type))
+ ;(comment (hook 'comment))
+ )
+ (set! need-save-as-undo #f)
+ (if (not (= sr (srate index)))
+ (begin
+ (src-sound (* 1.0 (/ (srate index) sr)) 1.0 index)
+ (set! need-save-as-undo #t))))))
(hook-push after-save-as-hook
- (lambda (index filename dialog)
+ (lambda (hook)
(if need-save-as-undo (undo))))
(let ((ind (open-sound "oboe.snd")))
(save-sound-as "test.snd" :srate 44100)
@@ -32216,44 +26542,45 @@ EDITS: 2
(set! ind (open-sound "test.snd"))
(if (not (= (srate ind) 44100)) (snd-display #__line__ ";before|after-save-as-hook src: ~A" (srate ind)))
(close-sound ind))
- (set! (hook-functions before-save-as-hook) '())
- (set! (hook-functions after-save-as-hook) '()))
+ (set! (hook-functions before-save-as-hook) ())
+ (set! (hook-functions after-save-as-hook) ()))
- (let ((old-clip (clipping))
+ (let ((old-clip *clipping*)
(old-mus-clip (mus-clipping)))
- (set! (clipping) #t)
+ (set! *clipping* #t)
(set! (mus-clipping) #t)
- (set! (hook-functions clip-hook) '())
+ (set! (hook-functions clip-hook) ())
- (let ((index (new-sound "test.snd" mus-next mus-bshort 22050 1 "clip-hook test" 10)))
+ (let ((index (new-sound "test.snd" 1 22050 mus-ldouble mus-next "clip-hook test" 10)))
(map-channel (lambda (y) (mus-random 0.999))) ; -amp to amp
(set! (sample 2) 1.0001)
(set! (sample 4) -1.0)
(set! (sample 6) 1.5)
(set! (sample 8) -1.5)
(let ((hook-called 0)
- (vals (channel->vct 0 10 index)))
- (hook-push clip-hook (lambda (val)
- (if (and (fneq val 1.0)
- (fneq val 1.5)
- (fneq val -1.5))
- (snd-display #__line__ ";clip-hook called upon: ~A" val))
- (set! hook-called (+ 1 hook-called))
- 0.0))
+ (vals (channel->float-vector 0 10 index)))
+ (hook-push clip-hook (lambda (hook)
+ (let ((val (hook 'val)))
+ (if (and (fneq val 1.0)
+ (fneq val 1.5)
+ (fneq val -1.5))
+ (snd-display #__line__ ";clip-hook called upon: ~A" val))
+ (set! hook-called (+ 1 hook-called))
+ (set! (hook 'result) 0.0))))
(save-sound index)
- (set! (hook-functions clip-hook) '())
+ (set! (hook-functions clip-hook) ())
(if (not (= hook-called 3)) (snd-display #__line__ ";clip-hook called ~A times" hook-called))
(close-sound index)
(set! index (open-sound "test.snd"))
- (let ((new-vals (channel->vct 0 10 index))
- (fixed-vals (vct-copy vals)))
- (vct-set! fixed-vals 2 0.0)
- (vct-set! fixed-vals 6 0.0)
- (vct-set! fixed-vals 8 0.0)
+ (let ((new-vals (channel->float-vector 0 10 index))
+ (fixed-vals (copy vals)))
+ (set! (fixed-vals 2) 0.0)
+ (set! (fixed-vals 6) 0.0)
+ (set! (fixed-vals 8) 0.0)
(if (not (vequal fixed-vals new-vals))
(snd-display #__line__ ";clip-hook results:~% ~A~% ~A~% ~A" new-vals fixed-vals vals)))
(close-sound index)))
- (set! (clipping) old-clip)
+ (set! *clipping* old-clip)
(set! (mus-clipping) old-mus-clip))
))
@@ -32263,21 +26590,22 @@ EDITS: 2
(define sfile 0) ; used globally by save-state stuff (... is this a bug?)
-(define (safe-make-selection beg end snd) ; used in test_15 also
- "make-region with error checks"
- (let ((len (frames snd))
- (old-choice (selection-creates-region)))
- (set! (selection-creates-region) #t)
- (if (> len 1)
- (if (< end len)
- (make-selection beg end snd)
- (if (< beg len)
- (make-selection beg (- len 1) snd)
- (make-selection 0 (- len 1) snd))))
- (set! (selection-creates-region) old-choice)))
+(define safe-make-selection
+ (let ((documentation "make-region with error checks"))
+ (lambda (beg end snd) ; used in test_15 also
+ (let ((len (framples snd))
+ (old-choice *selection-creates-region*))
+ (set! *selection-creates-region* #t)
+ (if (> len 1)
+ (if (< end len)
+ (make-selection beg end snd)
+ (if (< beg len)
+ (make-selection beg (- len 1) snd)
+ (make-selection 0 (- len 1) snd))))
+ (set! *selection-creates-region* old-choice)))))
(define (flatten lst)
- (cond ((null? lst) '())
+ (cond ((null? lst) ())
((pair? lst)
(if (pair? (car lst))
(append (flatten (car lst)) (flatten (cdr lst)))
@@ -32293,8 +26621,8 @@ EDITS: 2
(snd-display #__line__ ";test-panel ~A: ~A ~A?" name (func #t) (map func (sounds)))))
(define (all-chans-reversed)
- (let ((sndlist '())
- (chnlist '()))
+ (let ((sndlist ())
+ (chnlist ()))
(for-each (lambda (snd)
(do ((i (- (channels snd) 1) (- i 1)))
((< i 0))
@@ -32310,7 +26638,7 @@ EDITS: 2
(define duration
(lambda (ind)
- (/ (frames ind) (srate ind))))
+ (/ (framples ind) (srate ind))))
(define outputs (make-vector 24))
(define delay-line #f)
@@ -32318,27 +26646,32 @@ EDITS: 2
(define rev-funcs-set #f)
(let* ((cur-dir-files (remove-if
- (lambda (file) (<= (catch #t
- (lambda ()
- (mus-sound-frames file))
- (lambda args 0))
- 0))
+ (lambda (file)
+ (<= (catch #t
+ (lambda ()
+ (let ((len (mus-sound-framples file))
+ (chns (mus-sound-chans file)))
+ (if (or (> len 80000)
+ (> chns 2))
+ -1 len)))
+ (lambda args 0))
+ 0))
(sound-files-in-directory ".")))
(cur-dir-len (length cur-dir-files))
- (stereo-files '())
- (quad-files '())
- (mono-files '())
- (octo-files '())
- (open-files '())
+ (stereo-files ())
+ (quad-files ())
+ (mono-files ())
+ (octo-files ())
+ (open-files ())
(s8-snd (if (file-exists? "s8.snd") "s8.snd" "oboe.snd"))
(open-ctr 0))
-
+
(define* (clone-sound-as new-name snd)
;; copies any edit-sounds to save-dir!
(let* ((tmpf (snd-tempnam))
- (scm (string-append (substring tmpf 0 (- (string-length tmpf) 3)) "scm"))
+ (scm (string-append (substring tmpf 0 (- (length tmpf) 3)) "scm"))
(oldsnd (or snd (selected-sound))))
- (if (not (string? (save-dir))) (set! (save-dir) "/tmp"))
+ (if (not (string? *save-dir*)) (set! *save-dir* "/tmp"))
(save-edit-history scm oldsnd)
(copy-file (file-name oldsnd) new-name)
(set! sfile (open-sound new-name))
@@ -32347,14 +26680,14 @@ EDITS: 2
sfile))
- (hook-push after-open-hook (lambda (snd)
- (make-player snd 0)))
- (do ((i 0 (+ 1 i)))
+ (hook-push after-open-hook (lambda (hook)
+ (set! (hook 'result) (make-player (hook 'snd) 0))))
+ (do ((i 0 (+ i 1)))
((= i cur-dir-len))
- (let* ((name (list-ref cur-dir-files i))
+ (let* ((name (cur-dir-files i))
(ht (mus-sound-header-type name))
- (df (mus-sound-data-format name))
- (len (mus-sound-frames name))
+ (df (mus-sound-sample-type name))
+ (len (mus-sound-framples name))
(chans (mus-sound-chans name)))
(if (and (not (= ht mus-raw))
(not (= len 0))
@@ -32368,24 +26701,19 @@ EDITS: 2
(if (= chans 8)
(set! octo-files (cons name octo-files)))))))))
- (if (not buffer-menu)
- (set! buffer-menu (add-to-main-menu "Buffers")))
- (hook-push open-hook open-buffer)
- (hook-push close-hook close-buffer)
-
(do ((test-ctr 0 (+ 1 test-ctr)))
((= test-ctr tests))
(if (> (length open-files) 8)
(begin
(for-each close-sound open-files)
- (set! open-files '()))
+ (set! open-files ()))
(if (> test-ctr 0)
(for-each
(lambda (snd)
(let ((mxpos (edit-position snd 0))
(chns (chans snd)))
(if (> chns 1)
- (do ((chn 1 (+ 1 chn)))
+ (do ((chn 1 (+ chn 1)))
((= chn chns))
(set! mxpos (+ mxpos (edit-position snd chn)))))
(if (or (> mxpos 100) (> chns 4))
@@ -32393,10 +26721,9 @@ EDITS: 2
(snd-display #__line__ ";revert ~A at ~A" (file-name snd) mxpos)
(revert-sound snd)))))
(sounds))))
- (clear-sincs)
(log-mem test-ctr)
- (if (and (> test-ctr 0) (< test-ctr 10)) ; this creates too many leftover save-state sound files
+ (if (> 10 test-ctr 0) ; this creates too many leftover save-state sound files
(let ((files (length (sounds))))
(if (file-exists? "s61.scm") (delete-file "s61.scm"))
(for-each
@@ -32417,13 +26744,11 @@ EDITS: 2
(snd-display #__line__ ";save state restart from ~A to ~A sounds?" files (length (sounds))))
(set! open-files (sounds))))
- (let* ((len (length open-files))
- (open-chance (max 0.0 (* (- 8 len) .125)))
- (close-chance (* len .125)))
+ (let ()
(let* ((choice (random cur-dir-len))
- (name (list-ref cur-dir-files choice))
+ (name (cur-dir-files choice))
(ht (mus-sound-header-type name))
- (df (mus-sound-data-format name))
+ (df (mus-sound-sample-type name))
(fd (if (or (= ht mus-raw) (= df -1)) -1 (view-sound name))))
(if (and (number? fd)
(not (= fd -1)))
@@ -32431,37 +26756,42 @@ EDITS: 2
(set! open-ctr (length open-files))
(if (= open-ctr 0)
- (let ((fd (view-sound "oboe.snd")))
+ (let ((fd (view-sound "1a.snd")))
(set! open-ctr 1)
(set! open-files (cons fd open-files))))
- (let ((choose-fd (lambda () (list-ref (sounds) (random (length (sounds)))))))
- (let* ((frame-list (map frames open-files))
+ (let ((choose-fd (lambda ()
+ (if (zero? test-ctr) ; I think randomness here is messing up my timing comparisons
+ (or (find-sound "1a.snd") (open-sound "1a.snd"))
+ ((sounds) (random (length (sounds))))))))
+ (let* (;(frame-list (map framples open-files))
(curfd (choose-fd))
- (curloc (max 0 (min 1200 (frames curfd 0))))
+ (curloc (max 0 (min 1200 (framples curfd 0))))
(old-marks (length (marks curfd 0))))
- (set! test14-file (short-file-name curfd))
+ ;(format *stderr* "~S (~A)~%" (file-name curfd) (duration curfd))
(if (> (duration curfd) 0.0)
(begin
(set! (x-bounds curfd) (list 0.0 (min (duration curfd) 1.0)))
- (let ((xb (x-bounds curfd)))
- (if (or (fneq (car xb) 0.0)
- (fneq (cadr xb) (min (duration curfd) 1.0)))
- (snd-display #__line__ ";x-bounds: ~A?" xb)))))
+ (when with-gui
+ (let ((xb (x-bounds curfd)))
+ (if (or (fneq (car xb) 0.0)
+ (fneq (cadr xb) (min (duration curfd) 1.0)))
+ (snd-display #__line__ ";x-bounds: ~A?" xb))))))
(set! (y-bounds curfd) (list -0.5 0.5))
(let ((yb (y-bounds curfd)))
- (if (or (fneq (car yb) -0.5) (fneq (cadr yb) 0.5)) (snd-display #__line__ ";y-bounds: ~A?" yb)))
+ (when with-gui
+ (if (or (fneq (car yb) -0.5) (fneq (cadr yb) 0.5)) (snd-display #__line__ ";y-bounds: ~A?" yb))))
(set! (cursor curfd 0) curloc)
(let ((cl (cursor curfd 0)))
(if (and (not (= cl curloc))
- (> (frames curfd 0) curloc))
+ (> (framples curfd 0) curloc))
(begin
- (snd-display #__line__ ";cursor ~A is not ~A (frames: ~A)?" cl curloc (frames curfd 0))
+ (snd-display #__line__ ";cursor ~A is not ~A (framples: ~A)?" cl curloc (framples curfd 0))
(set! curloc (cursor curfd 0)))))
- (if (>= curloc (frames curfd 0)) (set! curloc 0))
- (let* ((id (catch #t (lambda () (add-mark curloc curfd)) (lambda args -1))))
+ (if (>= curloc (framples curfd 0)) (set! curloc 0))
+ (let ((id (catch #t (lambda () (add-mark curloc curfd)) (lambda args -1))))
(if (and (number? id) (not (= id -1)))
- (let* ((cl (mark-sample id))
+ (let ((cl (mark-sample id))
(new-marks (length (marks curfd 0))))
(if (not (= cl curloc)) (snd-display #__line__ ";mark ~A is not ~A?" cl curloc))
(if (not (= new-marks (+ 1 old-marks))) (snd-display #__line__ ";marks ~A ~A?" new-marks old-marks))
@@ -32481,7 +26811,7 @@ EDITS: 2
(if (not (= cl (max 0 (- curloc 100)))) (snd-display #__line__ ";set mark ~A is not ~A?" cl curloc))
(delete-mark id)))
(if (> (duration curfd) 1.2) (set! (x-bounds curfd) '(1.0 1.1)))
- (if (> (frames curfd) 25)
+ (if (> (framples curfd) 25)
(begin
(add-mark 10 curfd)
(add-mark 20 curfd)
@@ -32498,32 +26828,28 @@ EDITS: 2
))
(revert-sound)
- (let ((old-setting (selection-creates-region)))
- (set! (selection-creates-region) #t)
+ (let ((old-setting *selection-creates-region*))
+ (set! *selection-creates-region* #t)
(let ((reg (select-all)))
(without-errors
(if (and (region? reg)
(selection?))
(let ((r1 (region-rms (car (regions))))
- (r2 (selection-rms))
- (r3 (selection-rms-1))
- (r4 (region-rms-1 (car (regions)))))
- (if (fneq r1 r4)
- (snd-display #__line__ ";region rms: ~A ~A?" r1 r4))
- (if (fneq r2 r3)
- (snd-display #__line__ ";selection rms: ~A ~A?" r2 r3))))))
- (set! (selection-creates-region) old-setting))
+ (r2 (selection-rms)))
+ (if (fneq r1 r2)
+ (snd-display #__line__ ";region rms: ~A?" r1))))))
+ (set! *selection-creates-region* old-setting))
(without-errors (if (region? (cadr (regions))) (play (cadr (regions)) :wait #t)))
(without-errors (mix-region (car (regions))))
- (if (< (frames) 100000) (play :wait #t))
+ (if (< (framples) 100000) (play :wait #t))
(scale-to .1 (choose-fd))
(scale-by 2.0 (choose-fd))
(save-controls)
(set! (amp-control) .5)
(test-panel amp-control 'amp-control)
(restore-controls)
- (report-in-minibuffer "hi")
+ (status-report "hi")
(without-errors
(begin
@@ -32548,13 +26874,13 @@ EDITS: 2
(scale-selection-to .5)
(reverse-selection)
(undo 2 cfd))
- (if (> (length (regions)) 2) (forget-region (list-ref (regions) 2)))))
+ (if (> (length (regions)) 2) (forget-region ((regions) 2)))))
(for-each revert-sound open-files)
(without-errors
(let ((cfd (car open-files)))
(set! (sync cfd) 1)
- (if (not (null? (cdr open-files))) (set! (sync (cadr open-files)) 1))
+ (if (pair? (cdr open-files)) (set! (sync (cadr open-files)) 1))
(safe-make-selection 1000 2000 cfd)
(src-selection .5)
(undo 1 cfd)
@@ -32585,20 +26911,20 @@ EDITS: 2
(src-selection '(0 .5 1 1))
(undo)
(revert-sound cfd)
- (if (not (null? (cdr open-files))) (revert-sound (cadr open-files)))))
+ (if (pair? (cdr open-files)) (revert-sound (cadr open-files)))))
- (if (and (> (frames) 1)
- (< (frames) 1000000))
+ (if (and (> (framples) 1)
+ (< (framples) 10000))
(begin
- (make-region 0 (frames))
+ (make-region 0 (framples))
(convolve-selection-with "fyow.snd" .5)
(play :wait #t)))
- (if (and (> (frames) 1)
- (< (frames) 1000000))
+ (if (and (> (framples) 1)
+ (< (framples) 10000))
(convolve-with "fyow.snd" .25))
(insert-sound "oboe.snd")
- (set! (hook-functions graph-hook) '())
- (set! (hook-functions after-transform-hook) '())
+ (set! (hook-functions graph-hook) ())
+ (set! (hook-functions after-transform-hook) ())
(for-each revert-sound open-files)
(let ((ind (choose-fd)))
@@ -32618,20 +26944,20 @@ EDITS: 2
(func1 0)
(revert-sound ind)))
(delete-samples 0 1000 ind 0)
- (func (* 2 (frames ind 0)))
+ (func (* 2 (framples ind 0)))
(delete-samples 0 10000 ind 0)
- (func1 (* 2 (frames ind 0)))
+ (func1 (* 2 (framples ind 0)))
(revert-sound ind)
(if (> (chans ind) 1)
(begin
(delete-samples 0 1000 ind 1)
- (func (* 2 (frames ind 1)))
+ (func (* 2 (framples ind 1)))
(delete-samples 0 10000 ind 1)
- (func1 (* 2 (frames ind 1)))
+ (func1 (* 2 (framples ind 1)))
(revert-sound ind))))
(list (lambda (beg) (insert-sound "2a.snd" beg))
(lambda (beg) (reverse-sound))
- (lambda (beg) (convolve-with "2a.snd" 0.5))
+ (lambda (beg) (if (< (framples ind) 10000) (convolve-with "2a.snd" 0.5) (scale-by 2.0)))
(lambda (beg) (env-sound '(0 0 1 1 2 0)))
(lambda (beg) (smooth-sound)))
(list (lambda (beg) (insert-sound "4a.snd" beg))
@@ -32641,9 +26967,9 @@ EDITS: 2
(lambda (beg) (insert-silence beg 100)))))
(let ((ind (open-sound "z.snd")))
- (if (not (= (frames ind) 0)) (snd-display #__line__ ";frames z.snd ~A" (frames ind)))
- (if (not (eq? (samples) #f)) (snd-display #__line__ ";samples of empty file (z): ~A" (samples)))
- (if (not (eq? (channel->vct) #f)) (snd-display #__line__ ";channel->vct of empty file (z): ~A" (channel->vct)))
+ (if (not (= (framples ind) 0)) (snd-display #__line__ ";framples z.snd ~A" (framples ind)))
+ (if (samples) (snd-display #__line__ ";samples of empty file (z): ~A" (samples)))
+ (if (channel->float-vector) (snd-display #__line__ ";channel->float-vector of empty file (z): ~A" (channel->float-vector)))
(if (fneq (maxamp ind) 0.0) (snd-display #__line__ ";maxamp z.snd ~A" (maxamp ind)))
(if (fneq (sample 100 ind) 0.0) (snd-display #__line__ ";sample 100 z.snd ~A" (sample 100 ind)))
(scale-by 2.0)
@@ -32667,10 +26993,9 @@ EDITS: 2
(lambda () (convolve-with "z.snd" 1.0))
(lambda args args))
(if (not (= (edit-position ind 0) 0)) (snd-display #__line__ ";convolve z: ~A" (edit-position ind 0)))
- (let ((tag (catch #t (lambda () (find-channel (lambda (y) *> y .1))) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample)) (snd-display #__line__ ";find z: ~A" tag)))
- (let ((tag (catch #t (lambda () (count-matches (lambda (y) *> y .1))) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample)) (snd-display #__line__ ";count z: ~A" tag)))
+ (let ((matches (count-matches (lambda (y) (> y .1)))))
+ (if (and matches (> matches 0))
+ (snd-display #__line__ ";count z: ~A" matches)))
(let* ((reader (make-sampler 0))
(val (next-sample reader))
(str (format #f "~A" reader)))
@@ -32697,15 +27022,15 @@ EDITS: 2
(let ((zz (view-sound "z.snd")))
(select-sound zz)
- (let ((md (mix "4.aiff")))
- (add-mark 0)
- (add-mark 1200)
- (delete-marks))
+ (mix "4.aiff")
+ (add-mark 0)
+ (add-mark 1200)
+ (delete-marks)
(revert-sound zz)
(let ((editctr (edit-position zz))
- (old-selection-choice (selection-creates-region)))
- (set! (selection-creates-region) #t)
+ (old-selection-choice *selection-creates-region*))
+ (set! *selection-creates-region* #t)
(if (not (= (edit-position) 0)) (snd-display #__line__ ";revert-sound edit-position: ~A" (edit-position)))
(as-one-edit
(lambda ()
@@ -32717,7 +27042,7 @@ EDITS: 2
(delete-selection)
(mix-region reg))))))
(if (not (= (edit-position) 1)) (snd-display #__line__ ";as-one-edit mix zz: ~A -> ~A" editctr (edit-position)))
- (set! (selection-creates-region) old-selection-choice))
+ (set! *selection-creates-region* old-selection-choice))
(close-sound zz))
(let ((s8 (view-sound s8-snd)))
(select-sound s8)
@@ -32750,19 +27075,21 @@ EDITS: 2
(let ((uval (random 3)))
(set! (channel-style cfd) uval)
(if (not (= uval (channel-style cfd))) (snd-display #__line__ ";channel-style: ~A ~A?" uval (channel-style cfd)))))
- (src-sound 2.5 1.0 cfd)
- (src-sound -2.5 1.0 cfd)
- (src-sound .5 1.0 cfd)
- (revert-sound cfd)
- (src-sound -.5 1.0 cfd)
- (src-sound '(0 .5 1 1.5) 1.0 cfd)
- (if (> (frames cfd) 0) (src-sound (make-env '(0 .5 1 1.5) :length (frames cfd)) 1.0 cfd))
- (revert-sound cfd)
- (filter-sound '(0 1 .2 0 .5 1 1 0) 20 cfd)
- (filter-sound '(0 0 .1 0 .11 1 .12 0 1 0) 2048 cfd)
- (env-sound '(0 0 .5 1 1 0) 0 (frames cfd) 1.0 cfd)
- (insert-sample 1200 .1 cfd)
- (if (fneq (sample 1200 cfd) .1) (snd-display #__line__ ";insert-sample(looped): ~A?" (sample 1200 cfd)))
+ (if (< (framples cfd) 200000)
+ (begin
+ (src-sound 2.5 1.0 cfd)
+ (src-sound -2.5 1.0 cfd)
+ (src-sound .5 1.0 cfd)
+ (revert-sound cfd)
+ (src-sound -.5 1.0 cfd)
+ (src-sound '(0 .5 1 1.5) 1.0 cfd)
+ (if (> (framples cfd) 0) (src-sound (make-env '(0 .5 1 1.5) :length (framples cfd)) 1.0 cfd))
+ (revert-sound cfd)
+ (filter-sound '(0 1 .2 0 .5 1 1 0) 20 cfd)
+ (filter-sound '(0 0 .1 0 .11 1 .12 0 1 0) 2048 cfd)
+ (env-sound '(0 0 .5 1 1 0) 0 (framples cfd) 1.0 cfd)
+ (insert-sample 1200 .1 cfd)
+ (if (fneq (sample 1200 cfd) .1) (snd-display #__line__ ";insert-sample(looped): ~A?" (sample 1200 cfd)))))
(revert-sound cfd))
(let ((cfd (open-sound "obtest.snd")))
@@ -32774,10 +27101,10 @@ EDITS: 2
(set! (speed-control) 2.0)
(test-panel speed-control 'speed-control)
(apply-controls)
- (if (< (frames) 100000) (play :wait #t))
+ (if (< (framples) 100000) (play :wait #t))
- (if (fneq (reverb-control-decay cfd) (reverb-control-decay))
- (snd-display #__line__ ";reverb-control-decay local: ~A, global: ~A" (reverb-control-decay cfd) (reverb-control-decay)))
+ (if (fneq (reverb-control-decay cfd) *reverb-control-decay*)
+ (snd-display #__line__ ";reverb-control-decay local: ~A, global: ~A" (reverb-control-decay cfd) *reverb-control-decay*))
(set! (reverb-control?) #t)
(set! (reverb-control-scale) .2)
(test-panel reverb-control-scale 'reverb-control-scale)
@@ -32785,13 +27112,13 @@ EDITS: 2
(test-panel reverb-control-lowpass 'reverb-control-lowpass)
(test-panel reverb-control-feedback 'reverb-control-feedback)
(apply-controls)
- (if (< (frames) 100000) (play :wait #t))
+ (if (< (framples) 100000) (play :wait #t))
(set! (contrast-control?) #t)
(set! (contrast-control) .5)
(test-panel contrast-control 'contrast-control)
(test-panel contrast-control-amp 'contrast-control-amp)
(apply-controls)
- (if (< (frames) 100000) (play :wait #t))
+; (if (< (framples) 100000) (play :wait #t))
(set! (expand-control?) #t)
(set! (expand-control) 2.5)
(test-panel expand-control 'expand-control)
@@ -32799,18 +27126,18 @@ EDITS: 2
(test-panel expand-control-hop 'expand-control-hop)
(test-panel expand-control-ramp 'expand-control-ramp)
(apply-controls)
- (if (< (frames) 100000) (play :wait #t))
+; (if (< (framples) 100000) (play :wait #t))
(set! (filter-control?) #t)
- (set! (filter-control-order) 40)
+ (set! *filter-control-order* 40)
(test-panel filter-control-order 'filter-control-order)
(set! (filter-control-envelope) '(0 0 .1 1 .2 0 1 0))
(filter-control-envelope)
(apply-controls)
- (if (< (frames) 100000) (play :wait #t))
+; (if (< (framples) 100000) (play :wait #t))
(set! (amp-control) 1.5)
(test-panel amp-control 'amp-control)
(apply-controls)
- (if (< (frames) 100000) (play :wait #t))
+; (if (< (framples) 100000) (play :wait #t))
(swap-channels cfd 0 cfd2 0)
(set! (amp-control #t) .75)
(test-panel amp-control 'amp-control)
@@ -32829,21 +27156,21 @@ EDITS: 2
(set! (expand-control-ramp #t) .025)
(if (fneq (expand-control-ramp cfd2) .025) (snd-display #__line__ ";set-expand-control-ramp .025 #t -> ~A?" (expand-control-ramp cfd2)))
(let ((clone (clone-sound-as "/tmp/cloned.snd" cfd2)))
- (if (not (= (frames cfd2) (frames clone)))
- (snd-display #__line__ ";clone frames: ~A ~A" (frames cfd2) (frames clone)))
+ (if (not (= (framples cfd2) (framples clone)))
+ (snd-display #__line__ ";clone framples: ~A ~A" (framples cfd2) (framples clone)))
(close-sound clone))
(delete-file "/tmp/cloned.snd")
(mus-sound-forget "/tmp/cloned.snd")
(close-sound cfd2)
(close-sound cfd)))
- (hook-push (edit-hook) (lambda () #f))
+ (hook-push (edit-hook) (lambda (hook) (set! (hook 'result) #f)))
(let ((editctr (edit-position)))
(as-one-edit (lambda () (set! (sample 200) .2) (set! (sample 300) .3)))
(if (not (= (edit-position) (+ 1 editctr))) (snd-display #__line__ ";as-one-edit: ~A -> ~A" editctr (edit-position)))
(as-one-edit (lambda () #f))
(if (not (= (edit-position) (+ 1 editctr))) (snd-display #__line__ ";as-one-edit nil: ~A -> ~A" editctr (edit-position))))
(delete-sample 250)
- (hook-push (undo-hook) (lambda () #f))
+ (hook-push (undo-hook) (lambda (hook) (set! (hook 'result) #f)))
(undo)
(delete-sample 250)
(undo)
@@ -32851,30 +27178,26 @@ EDITS: 2
(undo 1)
(as-one-edit (lambda () (set! (sample 2) .2) (as-one-edit (lambda () (set! (sample 3) .3)))))
(undo 2)
- (set! (hook-functions (undo-hook)) '())
- (set! (hook-functions (edit-hook)) '())
- ; (hook-push snd-error-hook
- ; (lambda (msg)
- ; (if (not (string=? msg "hiho")) (snd-display #__line__ ";snd-error-hook: ~A?" msg))
- ; #t))
- ; (snd-error "hiho")
+ (set! (hook-functions (undo-hook)) ())
+ (set! (hook-functions (edit-hook)) ())
(hook-push snd-warning-hook
- (lambda (msg)
- (if (not (string=? msg "hiho")) (snd-display #__line__ ";snd-warning-hook: ~A?" msg))
- #t))
+ (lambda (hook)
+ (let ((msg (hook 'message)))
+ (if (not (string=? msg "hiho")) (snd-display #__line__ ";snd-warning-hook: ~A?" msg))
+ (set! (hook 'result) #t))))
(snd-warning "hiho")
- (set! (hook-functions snd-error-hook) '())
- (set! (hook-functions snd-warning-hook) '())
+ (set! (hook-functions snd-error-hook) ())
+ (set! (hook-functions snd-warning-hook) ())
(hook-push name-click-hook
- (lambda (n)
- #t))
+ (lambda (hook)
+ (set! (hook 'result) #t)))
(redo 1)
- (set! (hook-functions name-click-hook) '())
+ (set! (hook-functions name-click-hook) ())
(set! (transform-graph?) #t)
(test-channel transform-graph? 'transform-graph?)
(test-channel time-graph? 'time-graph?)
(test-channel lisp-graph? 'lisp-graph?)
- (test-channel frames 'frames)
+ (test-channel framples 'framples)
(test-channel cursor 'cursor)
(test-channel cursor-size 'cursor-size)
(test-channel cursor-style 'cursor-style)
@@ -32892,26 +27215,23 @@ EDITS: 2
(test-channel after-edit-hook 'after-edit-hook)
(test-channel undo-hook 'undo-hook)
(if (<= tests 2)
- (set! (transform-type)
+ (set! *transform-type*
(add-transform "histogram" "bins" 0.0 1.0
(lambda (len fd)
- (let ((v (make-vct len))
+ (let ((v (make-float-vector len))
(steps (/ len 16))
(step (/ 1.0 len)))
- (vct-fill! v 0.0)
- (do ((i 0 (+ 1 i)))
+ (fill! v 0.0)
+ (do ((i 0 (+ i 1)))
((= i len) v)
- (let* ((val (abs (next-sample fd)))
- (bin (round (* val 16.0))))
+ (let ((bin (round (* 16.0 (abs (next-sample fd))))))
(if (< bin steps)
- (do ((j 0 (+ 1 j)))
- ((= j steps))
- (vct-set! v (+ j bin) (+ step (vct-ref v (+ j bin)))))))))))))
+ (float-vector-offset! (make-shared-vector v (list steps) bin) step)))))))))
(set! (x-bounds) '(.1 .2))
- (set! (transform-type) fourier-transform)
+ (set! *transform-type* fourier-transform)
(set! (x-bounds) '(.1 .2))
(hook-push lisp-graph-hook display-energy)
- (set! (hook-functions graph-hook) '())
+ (set! (hook-functions graph-hook) ())
(if (= (channels) 2)
(begin
(hook-push graph-hook display-correlation)
@@ -32919,50 +27239,44 @@ EDITS: 2
(set! (x-bounds) '(.1 .2))
(hook-remove graph-hook display-correlation)))
(set! (lisp-graph?) #f)
- (map-chan
- (let ((sum-of-squares 0.0)
- (buffer (make-vct 128 0.0))
- (position 0)
+ (map-channel
+ (let ((buffer (make-delay 128))
+ (gen (make-moving-average 128))
(current-sample 0)
- (chan-samples (frames)))
+ (chan-samples (framples)))
+ (set! (mus-feedback gen) 1.0)
(lambda (y)
- (let ((old-y (vct-ref buffer position)))
- (set! sum-of-squares (- (+ sum-of-squares (* y y)) (* old-y old-y)))
- (vct-set! buffer position y)
- (set! position (+ 1 position))
- (if (= position 128) (set! position 0))
+ (let ((old-y (delay buffer y)))
(set! current-sample (+ 1 current-sample))
- (if (> sum-of-squares .01)
+ (and (> (moving-average gen (* y y)) .01)
(if (= current-sample chan-samples)
;; at end return trailing samples as long as it looks like sound
- (let ((temp-buffer (make-vct 128 0.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 128) temp-buffer)
- (let ((final-y (vct-ref buffer position)))
- (vct-set! temp-buffer i (if (> sum-of-squares .01) final-y 0.0))
- (set! sum-of-squares (- sum-of-squares (* final-y final-y)))
- (set! position (+ 1 position))
- (if (= position 128) (set! position 0)))))
- old-y)
- #f)))))
+ (let ((temp-buffer (make-delay 128)))
+ (do ((i 0 (+ i 1))
+ (fy (delay buffer 0.0) (delay buffer 0.0)))
+ ((= i 128)
+ (mus-data temp-buffer))
+ (delay temp-buffer (if (> (moving-average gen 0.0) .01) fy 0.0))))
+ old-y)))))
+ 0 20)
(let ((maxval1 (+ (maxamp) .01)))
(if (not (every-sample? (lambda (y) (< y maxval1))))
- (let ((res (scan-chan (lambda (y) (>= y maxval1)))))
+ (let ((res (scan-channel (lambda (y) (>= y maxval1)))))
(snd-display #__line__ ";~A, every-sample: ~A ~A [~A: ~A]?" (short-file-name) maxval1 res (cursor) (sample (cursor)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (edit-position)))
(snd-display #__line__ ";~D: ~A ~A" i (maxamp #f 0 i) (edit-fragment i))))))
- (map-chan (echo .5 .75) 0 60000)
- (set! (hook-functions after-transform-hook) '())
- (set! (hook-functions lisp-graph-hook) '())
+ (map-channel (echo .5 .75) 0 60000)
+ (set! (hook-functions after-transform-hook) ())
+ (set! (hook-functions lisp-graph-hook) ())
(hook-push lisp-graph-hook
- (lambda (snd chn)
+ (lambda (hook)
(if (> (random 1.0) .5)
- (graph (vct 0 1 2))
- (graph (list (vct 0 1 2) (vct 3 2 0))))))
+ (graph (float-vector 0 1 2))
+ (graph (list (float-vector 0 1 2) (float-vector 3 2 0))))))
(for-each
(lambda (snd)
@@ -32970,12 +27284,12 @@ EDITS: 2
(update-lisp-graph snd))
(sounds))
(hook-push graph-hook superimpose-ffts)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(for-each
(lambda (snd)
- (if (> (frames snd) 0)
- (let* ((dur (floor (/ (frames snd) (srate snd))))
+ (if (> (framples snd) 0)
+ (let* ((dur (floor (/ (framples snd) (srate snd))))
(start (max 0.0 (min (- dur .1) (random dur)))))
(if (> dur 0.0)
(set! (x-bounds snd 0) (list start (min (+ start .1) dur))))))
@@ -32983,40 +27297,36 @@ EDITS: 2
(update-lisp-graph snd)
(update-transform-graph snd))
(sounds)))
- (set! (hook-functions graph-hook) '())
- (set! (hook-functions lisp-graph-hook) '())
+ (set! (hook-functions graph-hook) ())
+ (set! (hook-functions lisp-graph-hook) ())
;; new variable settings
(letrec ((reset-vars
(lambda (lst)
- (if (not (null? lst))
- (let* ((name (list-ref (car lst) 0))
- (index (if (list-ref (car lst) 2) (choose-fd) #f))
- (getfnc (list-ref (car lst) 1))
+ (if (pair? lst)
+ (let* ((name ((car lst) 0))
+ (index (and ((car lst) 2) (choose-fd)))
+ (getfnc ((car lst) 1))
(setfnc (lambda (val snd) (set! (getfnc snd) val)))
(setfnc-1 (lambda (val) (set! (getfnc) val)))
- (minval (list-ref (car lst) 3))
- (maxval (list-ref (car lst) 4)))
+ (minval ((car lst) 3))
+ (maxval ((car lst) 4)))
(if index
- (if (equal? minval #f)
+ (if (not minval)
(setfnc #t index)
(if (rational? minval)
- (if (equal? name #t)
- (setfnc (floor (expt 2 (min 31
- (ceiling (/ (log (+ minval (floor (* (- maxval minval) (random 1.0)))))
- (log 2))))))
- index)
- (setfnc (+ minval (floor (* (- maxval minval) (random 1.0)))) index))
- (setfnc (+ minval (* (- maxval minval) (random 1.0))) index)))
- (if (equal? minval #f)
+ (if (eq? name #t)
+ (setfnc (floor (expt 2 (min 31 (ceiling (log (+ minval (floor (random (- maxval minval)))) 2))))) index)
+ (setfnc (+ minval (floor (random (- maxval minval)))) index))
+ (setfnc (+ minval (random (- maxval minval))) index)))
+ (if (not minval)
(setfnc-1 #t)
(if (rational? minval)
- (if (equal? name #t)
- (setfnc-1 (floor (expt 2 (min 31 (ceiling (/ (log (+ minval (floor (* (- maxval minval) (random 1.0)))))
- (log 2)))))))
- (setfnc-1 (+ minval (floor (* (- maxval minval) (random 1.0))))))
- (setfnc-1 (+ minval (* (- maxval minval) (random 1.0)))))))
+ (if (eq? name #t)
+ (setfnc-1 (floor (expt 2 (min 31 (ceiling (log (+ minval (floor (random (- maxval minval)))) 2))))))
+ (setfnc-1 (+ minval (floor (random (- maxval minval))))))
+ (setfnc-1 (+ minval (random (- maxval minval)))))))
(reset-vars (cdr lst)))))))
(reset-vars
(list
@@ -33040,7 +27350,7 @@ EDITS: 2
(list 'tracking-cursor-style tracking-cursor-style #f cursor-line cursor-cross)
(list 'clipping clipping #f #f #t)
;(list 'default-output-chans default-output-chans #f 1 8)
- ;(list 'default-output-data-format default-output-data-format #f 1 12)
+ ;(list 'default-output-sample-type default-output-sample-type #f 1 12)
;(list 'default-output-srate default-output-srate #f 22050 44100)
;(list 'default-output-header-type default-output-header-type #f 0 2)
(list 'dot-size dot-size #f 1 10)
@@ -33081,7 +27391,6 @@ EDITS: 2
(list 'log-freq-start log-freq-start #f 50.0 5.0)
(list 'selection-creates-region selection-creates-region #f #f #t)
(list 'transform-normalization transform-normalization #f dont-normalize normalize-globally)
- (list 'view-files-sort view-files-sort #f 0 3)
(list 'play-arrow-size play-arrow-size #f 2 32)
(list 'print-length print-length #f 2 32)
(list 'region-graph-style region-graph-style #f graph-lines graph-lollipops)
@@ -33125,14 +27434,15 @@ EDITS: 2
(list 'zero-pad zero-pad #f 0 2)
(list 'zoom-focus-style zoom-focus-style #f 0 3))))
- (if (not (equal? (transform-type) fourier-transform))
+ (if (not (equal? *transform-type* fourier-transform))
(begin
(set! (transform-graph? #t #t) #f)
- (set! (transform-size) (min (transform-size) 128))))
+ (set! *transform-size* (min *transform-size* 128))))
)))
+ (set! *sinc-width* 10)
(if open-files (for-each close-sound open-files))
- (set! (sync-style) sync-none)
- (set! open-files '())
+ (set! *sync-style* sync-none)
+ (set! open-files ())
(set! (mus-rand-seed) 1234)
(if (not (= (mus-rand-seed) 1234)) (snd-display #__line__ ";mus-rand-seed: ~A (1234)!" (mus-rand-seed)))
(let ((val (mus-random 1.0))
@@ -33147,11 +27457,11 @@ EDITS: 2
(if (or (fneq val -0.7828)
(fneq val1 -0.8804))
(snd-display #__line__ ";mus-random repeated: ~A ~A?" val val1)))
- (set! (hook-functions after-open-hook) '())
- (set! (hook-functions close-hook) '())
- (set! (hook-functions open-hook) '())
+ (set! (hook-functions after-open-hook) ())
+ (set! (hook-functions close-hook) ())
+ (set! (hook-functions open-hook) ())
- (set! (clipping) #f)
+ (set! *clipping* #f)
(for-each close-sound (sounds))
)
)
@@ -33161,35 +27471,35 @@ EDITS: 2
;;; ---------------- test 15: chan-local vars ----------------
-(if (not (provided? 'snd-rubber.scm)) (load "rubber.scm"))
+(require snd-rubber.scm)
(define (snd_test_15)
(define (smoother y0 y1 num)
- (let ((v (make-vct (+ 1 num)))
+ (let ((v (make-float-vector (+ 1 num)))
(angle (if (> y1 y0) pi 0.0))
(off (* .5 (+ y0 y1)))
(incr (/ pi num))
(scale (* 0.5 (abs (- y1 y0)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i num) v)
- (vct-set! v i (+ off (* scale (cos (+ angle (* i incr)))))))))
+ (set! (v i) (+ off (* scale (cos (+ angle (* i incr)))))))))
(define prefix-it
(lambda (n id)
(let* ((ns (number->string n))
- (digits (string-length ns)))
+ (digits (length ns)))
(key (char->integer #\u) 0 id)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i digits))
- (key (char->integer (string-ref ns i)) 0 id)))))
+ (key (char->integer (ns i)) 0 id)))))
(define prefix-uit
(lambda (n id)
(let* ((ns (number->string n))
- (digits (string-length ns)))
- (do ((i 0 (+ 1 i)))
+ (digits (length ns)))
+ (do ((i 0 (+ i 1)))
((= i digits))
- (key (char->integer (string-ref ns i)) 0 id)))))
+ (key (char->integer (ns i)) 0 id)))))
(define funcs (list time-graph-type wavo-hop wavo-trace max-transform-peaks show-transform-peaks zero-pad transform-graph-type fft-window
with-verbose-cursor fft-log-frequency fft-log-magnitude fft-with-phases min-dB
@@ -33232,8 +27542,8 @@ EDITS: 2
(if (and (not (equal? (flatten (func #t #t)) (apply map func (all-chans))))
(not (equal? (flatten (func #t #t)) (apply map func (all-chans-reversed)))))
(snd-display #__line__ ";test-history-channel ~A[0]: ~A ~A?" name (flatten (func #t #t)) (apply map func (all-chans))))
- (let ((old-value (func))
- (old-chan-value (func snd1 0)))
+ (let ((old-value (func)))
+ (func snd1 0)
(set! (func snd1 0) new-value)
(let ((nv (func snd1 0)))
(if (not (test-equal nv new-value))
@@ -33261,56 +27571,55 @@ EDITS: 2
(define (freq-peak beg ind size)
(define (interpolated-peak-offset la ca ra)
(let* ((pk (+ .001 (max la ca ra)))
- (logla (/ (log (/ (max la .0000001) pk)) (log 10)))
- (logca (/ (log (/ (max ca .0000001) pk)) (log 10)))
- (logra (/ (log (/ (max ra .0000001) pk)) (log 10))))
+ (logla (log (/ (max la .0000001) pk) 10))
+ (logca (log (/ (max ca .0000001) pk) 10))
+ (logra (log (/ (max ra .0000001) pk) 10)))
(/ (* 0.5 (- logla logra))
(- (+ logla logra)
(* 2 logca)))))
- (let* ((data (channel->vct beg size ind 0))
- (spectr (snd-spectrum data blackman2-window size))
- (peak0 0.0)
- (pk0loc 0))
- (do ((i 0 (+ 1 i)))
- ((= i (/ size 2))
+ (let* ((data (channel->float-vector beg size ind 0))
+ (spectr (snd-spectrum data blackman2-window size)))
+ (let ((peak0 0.0)
+ (pk0loc 0)
+ (size2 (/ size 2)))
+ (do ((i 0 (+ i 1)))
+ ((= i size2)
(list (/ (* (+ pk0loc
(if (> pk0loc 0)
(interpolated-peak-offset
- (vct-ref spectr (- pk0loc 1))
- (vct-ref spectr pk0loc)
- (vct-ref spectr (+ 1 pk0loc)))
+ (spectr (- pk0loc 1))
+ (spectr pk0loc)
+ (spectr (+ 1 pk0loc)))
0.0))
(srate))
size)
peak0))
- (if (> (vct-ref spectr i) peak0)
+ (if (> (spectr i) peak0)
(begin
- (set! peak0 (vct-ref spectr i))
- (set! pk0loc i))))))
+ (set! peak0 (spectr i))
+ (set! pk0loc i)))))))
(define (test-selection ind beg len scaler)
(set! (selection-member? ind 0) #t)
(set! (selection-position) beg)
- (set! (selection-frames) len)
+ (set! (selection-framples) len)
(scale-selection-by scaler)
(let* ((diff 0.0)
(pos (edit-position ind 0))
(old-reader (make-sampler beg ind 0 1 (- pos 1)))
- (new-reader (make-sampler beg ind 0 1 pos)))
- (do ((i 0 (+ 1 i)))
+ (new-reader (make-sampler beg ind 0 1 pos))
+ (incr (make-one-pole 1.0 -1.0)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let* ((ov (* scaler (old-reader)))
- (nv (next-sample new-reader))
- (val (abs (- ov nv))))
- (set! diff (+ diff val))))
+ (one-pole incr (abs (- (* scaler (next-sample old-reader)) (next-sample new-reader)))))
+ (set! diff (one-pole incr 0.0))
(if (> diff 0.0) (snd-display #__line__ ";diff (~D ~D): ~A" beg len diff))
(set! diff 0.0)
- (do ((i 0 (+ 1 i)))
+ (set! incr (make-one-pole 1.0 -1.0))
+ (do ((i 0 (+ i 1)))
((= i 100))
- (let* ((ov (next-sample old-reader))
- (nv (next-sample new-reader))
- (val (abs (- ov nv))))
- (set! diff (+ diff val))))
+ (one-pole incr (abs (- (next-sample old-reader) (next-sample new-reader)))))
+ (set! diff (one-pole incr 0.0))
(if (> diff 0.0) (snd-display #__line__ ";zdiff (~D ~D): ~A" beg len diff))
(free-sampler old-reader)
(free-sampler new-reader)))
@@ -33318,17 +27627,11 @@ EDITS: 2
(define (test-selection-to ind beg len maxval)
(set! (selection-member? ind 0) #t)
(set! (selection-position) beg)
- (set! (selection-frames) len)
+ (set! (selection-framples) len)
(scale-selection-to maxval)
- (let* ((newmax 0.0)
- (new-reader (make-sampler beg ind 0)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let* ((nv (abs (next-sample new-reader))))
- (if (> nv newmax) (set! newmax nv))))
+ (let ((newmax (float-vector-peak (samples beg len ind 0))))
(if (fneq newmax maxval)
- (snd-display #__line__ ";scale-selection-to (~D ~D) ~A: ~A?" beg len maxval newmax))
- (free-sampler new-reader)))
+ (snd-display #__line__ ";scale-selection-to (~D ~D) ~A: ~A?" beg len maxval newmax))))
(define play-with-amps
(lambda (sound . amps)
@@ -33340,7 +27643,7 @@ EDITS: 2
(if (not (member player (players))) (snd-display #__line__ ";player: ~A, but players: ~A" player (players)))
(if (not (equal? (player-home player) (list sound chan)))
(snd-display #__line__ ";player-home ~A ~A?" (player-home player) (list sound chan)))
- (set! (amp-control player) (list-ref amps chan))
+ (set! (amp-control player) (amps chan))
(set! (speed-control player) .5)
(set! (expand-control? player) #t)
(set! (expand-control player) 2.0)
@@ -33353,14 +27656,14 @@ EDITS: 2
;; examp.scm (commented out)
(define (sound-via-sound snd1 snd2) ; "sound composition"??
- (let* ((intrp (make-sound-interp 0 snd1 0))
- (len (- (frames snd1 0) 1))
- (rd (make-sampler 0 snd2 0))
- (mx (maxamp snd2 0)))
+ (let ((intrp (make-sound-interp 0 snd1 0))
+ (len (- (framples snd1 0) 1))
+ (rd (make-sampler 0 snd2 0))
+ (mx (/ 1.0 (maxamp snd2 0))))
(map-channel (lambda (val)
- (sound-interp intrp (floor (* len (* 0.5 (+ 1.0 (/ (read-sample rd) mx))))))))))
+ (sound-interp intrp (floor (* len 0.5 (+ 1.0 (* mx (read-sample rd))))))))))
- (set! (transform-type) fourier-transform)
+ (set! *transform-type* fourier-transform)
(if with-gui
(begin
@@ -33390,10 +27693,10 @@ EDITS: 2
(hook-push graph-hook auto-dot)
(hook-push graph-hook superimpose-ffts)
(set! (transform-graph? obi 0) #t)
- (update-graphs)
+ ;(update-graphs)
(set! s2i (open-sound (car (match-sound-files (lambda (file) (= (mus-sound-chans file) 2))))))
(if (not (= (chans s2i) 2)) (snd-display #__line__ ";match 2 got ~A with ~A chans" (short-file-name s2i) (chans s2i)))
- (update-graphs)
+ ;(update-graphs)
(hook-remove graph-hook auto-dot)
(hook-remove graph-hook superimpose-ffts)
(set! (transform-graph? obi 0) #f)
@@ -33405,29 +27708,13 @@ EDITS: 2
(close-sound s2i)
(safe-make-selection 1000 2000 obi)
(delete-selection-and-smooth)
- (if (not (equal? (edit-fragment 0 obi 0) '(#f "init" 0 50828)))
+ (if (not (equal? (edit-fragment 0 obi 0) '("" "init" 0 50828)))
(snd-display #__line__ ";edit-fragment(0): ~S?" (edit-fragment 0 obi 0)))
(if (not (equal? (edit-fragment 1 obi 0) '("delete-samples 1000 1001" "delete" 1000 1001)))
(snd-display #__line__ ";edit-fragment(1): ~S?" (edit-fragment 1 obi 0)))
(if (not (equal? (edit-fragment 2 obi 0) '("delete-selection-and-smooth" "set" 968 64)))
(snd-display #__line__ ";edit-fragment(2): ~S?" (edit-fragment 2 obi 0)))
- (let ((samp100 (sample 1100 obi 0)))
- (select-sound obi)
- (safe-make-selection 1000 2000 obi)
- (eval-over-selection (lambda (val) (* 2.0 val)))
- (let ((nsamp100 (sample 1100 obi 0)))
- (if (fneq (* 2.0 samp100) nsamp100)
- (snd-display #__line__ ";eval-over-selection: ~A ~A [~A ~A]?"
- samp100 nsamp100 (selection-position) (selection-frames)))
- (let ((m2 (add-mark 1000 obi 0))
- (m3 (add-mark 2000 obi 0)))
- (if (not (equal? (marks obi 0) (list m2 m3))) (snd-display #__line__ ";add-mark: ~A ~A?" (marks obi 0) (list m2 m3)))
- (set! (left-sample obi 0) 950)
- (eval-between-marks (lambda (val) (* 2.0 val)))
- (let ((msamp100 (sample 1100 obi 0)))
- (if (fneq (* 2.0 nsamp100) msamp100) (snd-display #__line__ ";eval-between-marks: ~A ~A?" nsamp100 msamp100))
- (revert-sound obi)))))
(let ((maxa (maxamp obi)))
(normalized-mix "pistol.snd" 1000 0 obi 0)
(let ((nmaxa (maxamp obi)))
@@ -33436,12 +27723,12 @@ EDITS: 2
(set! s2i (open-sound (car (match-sound-files (lambda (file)
(and (= (mus-sound-chans file) 2)
(not (= (mus-sound-header-type file) mus-raw))
- (> (mus-sound-frames file) 1000)))))))
+ (> (mus-sound-framples file) 1000)))))))
(if (not (= (chans s2i) 2)) (snd-display #__line__ ";match 2+1000 got ~A with ~A chans" (short-file-name s2i) (chans s2i)))
(let ((o1 (sample 1000 obi 0))
(s1 (sample 1000 s2i 0))
(s2 (sample 1000 s2i 1)))
- (do-all-chans (lambda (val) (if val (* 2.0 val) #f)) "double all samples")
+ (do-all-chans (lambda (val) (* val 2.0)) "double all samples")
(let ((o11 (sample 1000 obi 0))
(s11 (sample 1000 s2i 0))
(s21 (sample 1000 s2i 1)))
@@ -33460,7 +27747,7 @@ EDITS: 2
(snd-display #__line__ ";map maxamp all-chans: ~A ~A ~A ~A?" m1 m2 m3 mc))
(set! (sync obi) 1)
(set! (sync s2i) 1)
- (do-chans (lambda (val) (if val (* 2.0 val) #f)) "*2")
+ (do-chans (lambda (val) (* val 2.0)) "*2")
(let ((mc1 (apply map maxamp (list (list obi s2i s2i) (list 0 0 1)))))
(if (or (fneq (* 2.0 m1) (car mc1))
(fneq (* 2.0 m2) (cadr mc1))
@@ -33469,7 +27756,7 @@ EDITS: 2
(set! (sync obi) 0)
(set! (sync s2i) 0)
(select-sound s2i)
- (do-sound-chans (lambda (val) (if val (* 0.5 val) #f)) "/2")
+ (do-sound-chans (lambda (val) (* val 0.5)) "/2")
(let ((mc2 (apply map maxamp (list (list obi s2i s2i) (list 0 0 1)))))
(if (or (fneq (* 2.0 m1) (car mc2))
(fneq m2 (cadr mc2))
@@ -33485,7 +27772,7 @@ EDITS: 2
(revert-sound obi)
(set! (sync obi) 3)
(set! (sync s2i) 3)
- (let* ((half-way (floor (* 0.5 (frames obi))))
+ (let* ((half-way (floor (* 0.5 (framples obi))))
(o1 (sample half-way obi 0))
(s1 (sample half-way s2i 0))
(s2 (sample half-way s2i 1)))
@@ -33523,7 +27810,7 @@ EDITS: 2
(snd-display #__line__ ";selection-chans(2): ~A?" (selection-chans))
(for-each
(lambda (snd)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (chans snd)))
(if (selection-member? snd i)
(snd-display #__line__ "; ~A[~A] at ~A" (short-file-name snd) i (selection-position snd i)))))
@@ -33541,14 +27828,14 @@ EDITS: 2
(set! obi (open-sound "oboe.snd"))
(select-all)
(for-each forget-region (regions))
- (if (not (equal? (regions) '())) (snd-display #__line__ ";no regions? ~A" (regions)))
+ (if (not (null? (regions))) (snd-display #__line__ ";no regions? ~A" (regions)))
(let ((id (make-region 100 200 obi 0)))
(if (not (equal? (regions) (list id))) (snd-display #__line__ ";make-region regions: ~A?" (regions))))
(revert-sound obi)
- (let ((oldlen (frames obi)))
+ (let ((oldlen (framples obi)))
(env-sound-interp '(0 0 1 1 2 0) 2.0 obi 0)
- (let ((newlen (frames obi)))
+ (let ((newlen (framples obi)))
(if (> (abs (- (* 2 oldlen) newlen)) 3)
(snd-display #__line__ ";env-sound-interp: ~A ~A?" oldlen newlen))))
@@ -33556,80 +27843,80 @@ EDITS: 2
(granulated-sound-interp '(0 0 1 .1 2 1) 1.0 0.2 '(0 0 1 1 2 0))
(if (not (= (edit-position obi 0) 1)) (snd-display #__line__ ";granulated-sound-interp no-op 1?"))
(if (< (maxamp obi 0) .15) (snd-display #__line__ ";granulated-sound-interp 1 maxamp: ~A" (maxamp obi 0)))
- (if (> (abs (- (frames obi 0) 50828)) 1000) (snd-display #__line__ ";granulated-sound-interp 1 frames: ~A" (frames obi 0)))
+ (if (> (abs (- (framples obi 0) 50828)) 1000) (snd-display #__line__ ";granulated-sound-interp 1 framples: ~A" (framples obi 0)))
(revert-sound obi)
(granulated-sound-interp '(0 0 1 1) 2.0)
(if (not (= (edit-position obi 0) 1)) (snd-display #__line__ ";granulated-sound-interp no-op 2?"))
- (if (< (maxamp obi 0) .15) (snd-display #__line__ ";granulated-sound-interp 2 maxamp: ~A" (maxamp obi 0)))
- (if (> (abs (- (frames obi 0) 101656)) 1000) (snd-display #__line__ ";granulated-sound-interp 2 frames: ~A" (frames obi 0)))
+ (if (< (maxamp obi 0) .145) (snd-display #__line__ ";granulated-sound-interp 2 maxamp: ~A" (maxamp obi 0)))
+ (if (> (abs (- (framples obi 0) 101656)) 1000) (snd-display #__line__ ";granulated-sound-interp 2 framples: ~A" (framples obi 0)))
(revert-sound obi)
(granulated-sound-interp '(0 0 1 .1 2 1) 1.0 0.2 '(0 0 1 1 2 0) 0.02)
(if (not (= (edit-position obi 0) 1)) (snd-display #__line__ ";granulated-sound-interp no-op 3?"))
(if (< (maxamp obi 0) .2) (snd-display #__line__ ";granulated-sound-interp 3 maxamp: ~A" (maxamp obi 0)))
- (if (> (abs (- (frames obi 0) 50828)) 1000) (snd-display #__line__ ";granulated-sound-interp 3 frames: ~A" (frames obi 0)))
+ (if (> (abs (- (framples obi 0) 50828)) 1000) (snd-display #__line__ ";granulated-sound-interp 3 framples: ~A" (framples obi 0)))
(close-sound obi)
)
- (let ((old-srate (mus-srate)))
- (set! (mus-srate) 22050)
+ (let ((old-srate *clm-srate*))
+ (set! *clm-srate* 22050)
(let ((ind (new-sound "test.snd" :size 20)))
- (if (< (print-length) 20) (set! (print-length) 20))
+ (if (< *print-length* 20) (set! *print-length* 20))
(offset-channel 1.0)
(env-sound '(0 0 1 1))
(let ((osc (make-oscil :frequency 1000.0 :initial-phase (+ pi (/ pi 2))))
(reader (make-sound-interp 0 ind 0))
- (len (- (frames ind 0) 1)))
+ (len (- (framples ind 0) 1)))
(map-channel (lambda (val)
(sound-interp reader (* len (+ 0.5 (* 0.5 (oscil osc)))))))
- (if (not (vequal (channel->vct) (vct 0.000 0.020 0.079 0.172 0.291 0.427 0.569 0.706 0.825 0.919
+ (if (not (vequal (channel->float-vector) (float-vector 0.000 0.020 0.079 0.172 0.291 0.427 0.569 0.706 0.825 0.919
0.979 1.000 0.981 0.923 0.831 0.712 0.576 0.434 0.298 0.177)))
- (snd-display #__line__ ";sound-interp: ~A" (channel->vct))))
+ (snd-display #__line__ ";sound-interp: ~A" (channel->float-vector))))
(undo)
(let ((osc (make-oscil :frequency 0.5 :initial-phase (+ pi (/ pi 2))))
(reader (make-sound-interp 0 ind 0))
- (len (- (frames ind 0) 1)))
+ (len (- (framples ind 0) 1)))
(map-channel (lambda (val)
(sound-interp reader (* len (+ 0.5 (* 0.5 (oscil osc))))))))
(undo)
(env-sound-interp '(0 0 1 1))
- (if (not (vequal (channel->vct) (vct 0.000 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474
+ (if (not (vequal (channel->float-vector) (float-vector 0.000 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474
0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
- (snd-display #__line__ ";env-sound-interp no change: ~A" (channel->vct)))
+ (snd-display #__line__ ";env-sound-interp no change: ~A" (channel->float-vector)))
(undo)
(env-sound-interp '(0 0 1 .95 2 0) 2.0)
- (if (not (vequal (channel->vct) (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450
+ (if (not (vequal (channel->float-vector) (float-vector 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450
0.500 0.550 0.600 0.650 0.700 0.750 0.800 0.850 0.900 0.950
1.000 0.950 0.900 0.850 0.800 0.750 0.700 0.650 0.600 0.550
0.500 0.450 0.400 0.350 0.300 0.250 0.200 0.150 0.100 0.050)))
- (snd-display #__line__ ";env-sound-interp twice len and back: ~A" (channel->vct)))
+ (snd-display #__line__ ";env-sound-interp twice len and back: ~A" (channel->float-vector)))
(revert-sound ind)
(set! (sample 10) .5)
(remove-clicks)
- (if (fneq (sample 10) 0.0) (snd-display #__line__ ";remove-clicks: ~A" (channel->vct)))
+ (if (fneq (sample 10) 0.0) (snd-display #__line__ ";remove-clicks: ~A" (channel->float-vector)))
(undo)
(let ((vals (scan-channel (search-for-click))))
(if (not (= vals 11))
(snd-display #__line__ ";search-for-click: ~A" vals)))
(close-sound ind))
- (set! (mus-srate) old-srate))
+ (set! *clm-srate* old-srate))
(let ((ind1 (new-sound :size 20 :comment "new-sound for sound-via-sound"))
- (ind2 (new-sound :size 20 :comment "2nd new-sound for sound-via-sound")))
- (let ((val -0.05)) (map-channel (lambda (y) (set! val (+ val .05)) val) 0 20 ind1))
- (let ((val 1.1)) (map-channel (lambda (y) (set! val (- val .1)) val) 0 20 ind2))
+ (ind2 (new-sound :size 20 :comment "second new-sound for sound-via-sound")))
+ (let ((val -0.05)) (map-channel (lambda (y) (set! val (+ val .05))) 0 20 ind1))
+ (let ((val 1.1)) (map-channel (lambda (y) (set! val (- val .1))) 0 20 ind2))
(select-sound ind1)
(sound-via-sound ind1 ind2)
- (let ((vals (channel->vct 0 20 ind1)))
- (if (not (vequal vals (vct 0.95 0.90 0.85 0.80 0.75 0.70 0.65 0.60 0.55 0.50 0.45 0.40 0.35 0.30 0.25 0.20 0.15 0.10 0.05 0.00)))
+ (let ((vals (channel->float-vector 0 20 ind1)))
+ (if (not (vequal vals (float-vector 0.95 0.90 0.85 0.80 0.75 0.70 0.65 0.60 0.55 0.50 0.45 0.40 0.35 0.30 0.25 0.20 0.15 0.10 0.05 0.00)))
(snd-display #__line__ ";sound-via-sound: ~A" vals)))
(let ((new-file-name (file-name ind2)))
(close-sound ind2)
(if (file-exists? new-file-name) (delete-file new-file-name)))
(revert-sound ind1)
- (let ((val -.5)) (map-channel (lambda (y) (set! val (+ val .05)) val)))
+ (let ((val -.5)) (map-channel (lambda (y) (set! val (+ val .05)))))
(let ((val (scan-channel (zero+))))
(if (or (not val)
(not (= val 10)))
@@ -33649,22 +27936,22 @@ EDITS: 2
(if (file-exists? new-file-name) (delete-file new-file-name))))
(let* ((id (open-sound "oboe.snd"))
- (fr (frames id 0))
+ (fr (framples id 0))
(mx (maxamp id 0)))
- (set! (frames id 0) 25000)
- (if (not (= (frames id 0) 25000)) (snd-display #__line__ ";set-frames 25000: ~A?" (frames id 0)))
- (if (not (= (edit-position id 0) 1)) (snd-display #__line__ ";set-frames 25000 edit: ~A?" (edit-position id 0)))
- (set! (frames id 0) 75000)
- (if (not (= (frames id 0) 75000)) (snd-display #__line__ ";set-frames 75000: ~A?" (frames id 0)))
- (if (not (= (edit-position id 0) 2)) (snd-display #__line__ ";set-frames 75000 edit: ~A?" (edit-position id 0)))
- (if (fneq (sample 30000 id 0) 0.0) (snd-display #__line__ ";set-frames 75000 zeros: ~A?" (sample 30000 id 0)))
- (set! (frames id 0) 0)
- (if (not (= (frames id 0) 0)) (snd-display #__line__ ";set-frames 0: ~A?" (frames id 0)))
- (set! (frames id 0) 100)
- (if (not (= (frames id 0) 100)) (snd-display #__line__ ";set-frames 100: ~A?" (frames id 0)))
+ (set! (framples id 0) 25000)
+ (if (not (= (framples id 0) 25000)) (snd-display #__line__ ";set-framples 25000: ~A?" (framples id 0)))
+ (if (not (= (edit-position id 0) 1)) (snd-display #__line__ ";set-framples 25000 edit: ~A?" (edit-position id 0)))
+ (set! (framples id 0) 75000)
+ (if (not (= (framples id 0) 75000)) (snd-display #__line__ ";set-framples 75000: ~A?" (framples id 0)))
+ (if (not (= (edit-position id 0) 2)) (snd-display #__line__ ";set-framples 75000 edit: ~A?" (edit-position id 0)))
+ (if (fneq (sample 30000 id 0) 0.0) (snd-display #__line__ ";set-framples 75000 zeros: ~A?" (sample 30000 id 0)))
+ (set! (framples id 0) 0)
+ (if (not (= (framples id 0) 0)) (snd-display #__line__ ";set-framples 0: ~A?" (framples id 0)))
+ (set! (framples id 0) 100)
+ (if (not (= (framples id 0) 100)) (snd-display #__line__ ";set-framples 100: ~A?" (framples id 0)))
(revert-sound)
- (if (fneq (sample 30000 id 0) -0.0844) (snd-display #__line__ ";revert from set-frames: ~A?" (sample 30000 id 0)))
- (if (not (= fr (frames id 0))) (snd-display #__line__ ";revert set-frames: ~A != ~A?" (frames id 0) fr))
+ (if (fneq (sample 30000 id 0) -0.0844) (snd-display #__line__ ";revert from set-framples: ~A?" (sample 30000 id 0)))
+ (if (not (= fr (framples id 0))) (snd-display #__line__ ";revert set-framples: ~A != ~A?" (framples id 0) fr))
(set! (maxamp id 0) .5)
(if (fneq (maxamp id 0) .5) (snd-display #__line__ ";set-maxamp: ~A?" (maxamp id 0)))
(if (not (= (edit-position id 0) 1)) (snd-display #__line__ ";set-maxamp edit: ~A?" (edit-position id 0)))
@@ -33683,15 +27970,17 @@ EDITS: 2
(left-sample id 0) (right-sample id 0)
(abs (- fr (* 2 (right-sample id 0) (left-sample id 0))))))
(set! (y-position-slider id 0) .1)
- (if (fneq (y-position-slider id 0) .1) (snd-display #__line__ ";set y-position-slider .1: ~A?" (y-position-slider id 0)))
+ (if (and (not (provided? 'snd-gtk)) (fneq (y-position-slider id 0) .1))
+ (snd-display #__line__ ";set y-position-slider .1: ~A?" (y-position-slider id 0)))
(set! (y-zoom-slider id 0) .5)
(if (fneq (y-zoom-slider id 0) .5) (snd-display #__line__ ";set y-zoom-slider: ~A?" (y-zoom-slider id 0)))
(let ((vals (channel-amp-envs "oboe.snd" 0 10)))
- (if (not (equal? vals
- (list (vct -4.8828125e-4 -0.104156494140625 -0.125213623046875 -0.1356201171875 -0.138916015625
- -0.14093017578125 -0.14093017578125 -0.131439208984375 -0.11248779296875 -0.080047607421875)
- (vct 0.0 0.10955810546875 0.130706787109375 0.14068603515625 0.141204833984375 0.147247314453125
- 0.145904541015625 0.140289306640625 0.126861572265625 0.08172607421875))))
+ (if (or (not (vequal (car vals)
+ (float-vector -4.8828125e-4 -0.104156494140625 -0.125213623046875 -0.1356201171875 -0.138916015625
+ -0.14093017578125 -0.14093017578125 -0.131439208984375 -0.11248779296875 -0.080047607421875)))
+ (not (vequal (cadr vals)
+ (float-vector 0.0 0.10955810546875 0.130706787109375 0.14068603515625 0.141204833984375 0.147247314453125
+ 0.145904541015625 0.140289306640625 0.126861572265625 0.08172607421875))))
(snd-display #__line__ ";channel-amp-envs: ~A?" vals)))
(let ((len (length (channel-properties id 0))))
@@ -33706,7 +27995,7 @@ EDITS: 2
(if (fneq (channel-property 'hi id 0) pi)
(snd-display #__line__ ";channel-property 'hi (pi): ~A?" (channel-property 'hi id 0)))
(if (not (= (channel-property 'hiho id 0) 123))
- (snd-display #__line__ ";channel-property '2nd hiho (123): ~A?" (channel-property 'hiho id 0)))
+ (snd-display #__line__ ";channel-property 'second hiho (123): ~A?" (channel-property 'hiho id 0)))
(if (not (= (length (channel-properties id 0)) (+ len 2)))
(snd-display #__line__ ";channel-properties: ~A?" (channel-properties id 0))))
@@ -33722,17 +28011,17 @@ EDITS: 2
(if (fneq (sound-property 'hi id) pi)
(snd-display #__line__ ";sound-property 'hi (pi): ~A?" (sound-property 'hi id)))
(if (not (= (sound-property 'hiho id) 123))
- (snd-display #__line__ ";sound-property '2nd hiho (123): ~A?" (sound-property 'hiho id)))
+ (snd-display #__line__ ";sound-property 'second hiho (123): ~A?" (sound-property 'hiho id)))
(if (not (= (length (sound-properties id)) (+ len 2)))
(snd-display #__line__ ";sound-properties: ~A?" (sound-properties id))))
(let ((tag (catch #t (lambda () (map-channel (lambda (y) "hiho"))) (lambda args args))))
- (if (not (eq? (car tag) 'bad-type)) (snd-display #__line__ ";map-channel bad val: ~A" tag)))
+ (if (not (eq? (car tag) 'wrong-type-arg)) (snd-display #__line__ ";map-channel bad val: ~A" tag)))
(close-sound id))
(let ((ind (open-sound "oboe.snd")))
- (if (not (equal? (edit-properties ind 0 0) '()))
+ (if (not (null? (edit-properties ind 0 0)))
(snd-display #__line__ ";initial edit-properties: ~A?" (edit-properties ind 0 0)))
(let ((tag (catch #t
(lambda () (edit-properties ind 0 123))
@@ -33757,7 +28046,7 @@ EDITS: 2
(not (= val 3210)))
(snd-display #__line__ ";edit-property look back to 0: ~A" val)))
(let ((val (edit-property 'test-key ind 0 1)))
- (if val (snd-display #__line__ ";edit-property current: ~A ~A?" val val1)))
+ (if val (snd-display #__line__ ";edit-property current: ~A?" val)))
(undo)
(let ((val (edit-property 'test-key ind 0 0)))
(if (or (not (number? val))
@@ -33772,7 +28061,7 @@ EDITS: 2
(undo)
(pad-channel 0 10 ind 0)
(let ((val (edit-property 'test-key ind 0 1)))
- (if val (snd-display #__line__ ";edit-property not erased upon re-edit: ~A ~A?" val val1)))
+ (if val (snd-display #__line__ ";edit-property not erased upon re-edit: ~A?" val)))
(close-sound ind))
(let ((id (open-sound "oboe.snd")))
@@ -33780,7 +28069,7 @@ EDITS: 2
(key (char->integer #\x) 4 id)
(key (char->integer #\b) 4 id)
(let ((left (left-sample id)))
- (if (not (= left 0)) (snd-display #__line__ ";u1000: ~A" left)))
+ (if (not (= left 1000)) (snd-display #__line__ ";u1000: ~A" left)))
(prefix-it 0 id)
(key (char->integer #\x) 4 id)
(key (char->integer #\b) 4 id)
@@ -33863,7 +28152,7 @@ EDITS: 2
(let ((id (open-sound (car (match-sound-files (lambda (file)
(and (>= (mus-sound-chans file) 2)
(not (= (mus-sound-header-type file) mus-raw))
- (> (mus-sound-frames file) 1000))))))))
+ (> (mus-sound-framples file) 1000))))))))
(set! (sync id) 1)
(select-sound id)
(make-region 200 500 id)
@@ -33886,7 +28175,7 @@ EDITS: 2
(snd3 (open-sound "4.aiff")))
(define tests-1
(lambda (f fn nv)
- (if (not (null? f))
+ (if (pair? f)
(begin
(test-history-channel (car f) (car fn) (car nv) snd1 snd2 snd3)
(tests-1 (cdr f) (cdr fn) (cdr nv))))))
@@ -33895,56 +28184,56 @@ EDITS: 2
(close-sound snd2)
(set! (time-graph-style snd3 #t) graph-filled)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-filled))
(snd-display #__line__ ";set time-graph-style ~A ~A: ~A" snd3 i (time-graph-style snd3 i))))
(set! (time-graph-style snd3 2) graph-lines)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (and (not (= i 2))
(not (= (time-graph-style snd3 i) graph-filled)))
(snd-display #__line__ ";set (2) time-graph-style ~A ~A: ~A" snd3 i (time-graph-style snd3 i))))
(if (not (= (time-graph-style snd3 2) graph-lines))
(snd-display #__line__ ";set time-graph-style (2): ~A" (time-graph-style snd3 2)))
(set! (time-graph-style snd3 #t) graph-dots)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-dots))
(snd-display #__line__ ";set time-graph-style (all): ~A" (time-graph-style snd3 i))))
- (set! (graph-style) graph-dots-and-lines)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (set! *graph-style* graph-dots-and-lines)
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-dots-and-lines))
(snd-display #__line__ ";set time-graph-style (dal): ~A" (time-graph-style snd3 i))))
(set! (lisp-graph-style snd3 #t) graph-filled)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (not (= (lisp-graph-style snd3 i) graph-filled))
(snd-display #__line__ ";set lisp-graph-style ~A ~A: ~A" snd3 i (lisp-graph-style snd3 i))))
(set! (lisp-graph-style snd3 2) graph-lines)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (and (not (= i 2))
(not (= (lisp-graph-style snd3 i) graph-filled)))
(snd-display #__line__ ";set (2) lisp-graph-style ~A ~A: ~A" snd3 i (lisp-graph-style snd3 i))))
(if (not (= (lisp-graph-style snd3 2) graph-lines))
(snd-display #__line__ ";set lisp-graph-style (2): ~A" (lisp-graph-style snd3 2)))
(set! (lisp-graph-style snd3 #t) graph-lines)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-dots-and-lines))
(snd-display #__line__ ";set lisp -> time-graph-style (dal): ~A" (time-graph-style snd3 i))))
(set! (transform-graph-style snd3 #t) graph-filled)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (not (= (transform-graph-style snd3 i) graph-filled))
(snd-display #__line__ ";set transform-graph-style ~A ~A: ~A" snd3 i (transform-graph-style snd3 i))))
(set! (transform-graph-style snd3 2) graph-lines)
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (and (not (= i 2))
(not (= (transform-graph-style snd3 i) graph-filled)))
(snd-display #__line__ ";set (2) transform-graph-style ~A ~A: ~A" snd3 i (transform-graph-style snd3 i))))
(if (not (= (transform-graph-style snd3 2) graph-lines))
(snd-display #__line__ ";set transform-graph-style (2): ~A" (transform-graph-style snd3 2)))
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (not (= (time-graph-style snd3 i) graph-dots-and-lines))
(snd-display #__line__ ";set fft and lisp -> time-graph-style (dal): ~A" (time-graph-style snd3 i))))
- (do ((i 0 (+ 1 i))) ((= i 4))
+ (do ((i 0 (+ i 1))) ((= i 4))
(if (not (= (lisp-graph-style snd3 i) graph-lines))
(snd-display #__line__ ";set fft and lisp -> lisp-graph-style (dal): ~A" (lisp-graph-style snd3 i))))
@@ -33955,28 +28244,28 @@ EDITS: 2
(play-with-amps snd2 0.2 0.1))
(close-sound snd2))
- (let ((old-bp (with-background-processes)))
- (set! (with-background-processes) #f)
+ (let ((old-bp *with-background-processes*))
+ (set! *with-background-processes* #f)
(let* ((ind (open-sound "1a.snd"))
(player (make-player ind 0))
- (len (frames ind 0))
- (incr (dac-size))
- (e (make-env '(0 0 1 1) :length (+ 1 (floor (exact->inexact (/ len incr))))))
+ (len (framples ind 0))
+ (incr *dac-size*)
+ (e (make-env '(0 0 1 1) :length (+ 1 (floor (* 1.0 (/ len incr))))))
(samp 0))
(add-player player 0 -1 -1
(lambda (reason)
- (set! (hook-functions play-hook) '())
+ (set! (hook-functions play-hook) ())
(close-sound ind)))
(hook-push play-hook
- (lambda (fr)
+ (lambda (hook)
(set! (amp-control player) (env e))
(if (fneq (amp-control ind) 1.0) (snd-display #__line__ ";amp-control snd: ~A" (amp-control ind)))
- (if (> (abs (- (amp-control player) (exact->inexact (/ samp len)))) 1.0)
- (snd-display #__line__ ";amp-control player: ~A ~A" (amp-control player) (exact->inexact (/ samp len))))
+ (if (> (abs (- (amp-control player) (* 1.0 (/ samp len)))) 1.0)
+ (snd-display #__line__ ";amp-control player: ~A ~A" (amp-control player) (* 1.0 (/ samp len))))
(set! samp (+ samp incr))))
(start-playing 1 (srate ind)))
(if (find-sound "1a.snd") (snd-display #__line__ ";stop proc didn't close?"))
- (set! (with-background-processes) old-bp))
+ (set! *with-background-processes* old-bp))
(let ((ind (open-sound "pistol.snd")))
(if (selection-member? ind 0)
@@ -33990,11 +28279,11 @@ EDITS: 2
(selection-member? ind 0)
(selection-member? ind)
(selection?)))
- (if (not (= (selection-frames) 1))
- (snd-display #__line__ ";initial selection-frames: ~A?" (selection-frames)))
- (set! (selection-frames) 1200)
- (if (not (= (selection-frames) 1200))
- (snd-display #__line__ ";selection-frames: 1200 ~A?" (selection-frames)))
+ (if (not (= (selection-framples) 1))
+ (snd-display #__line__ ";initial selection-framples: ~A?" (selection-framples)))
+ (set! (selection-framples) 1200)
+ (if (not (= (selection-framples) 1200))
+ (snd-display #__line__ ";selection-framples: 1200 ~A?" (selection-framples)))
(delete-selection)
(if (selection?) (snd-display #__line__ ";selection active after cut?"))
(undo)
@@ -34005,43 +28294,43 @@ EDITS: 2
(selection-member? ind 0)
(selection-member? ind)
(selection?)))
- (if (or (not (= (selection-frames) 1200))
+ (if (or (not (= (selection-framples) 1200))
(not (= (selection-position) 0)))
(snd-display #__line__ ";selection after undo: '(0 1200) '(~A ~A)?"
(selection-position)
- (selection-frames)))
+ (selection-framples)))
(set! (selection-position) 1000)
- (if (or (not (= (selection-frames) 200))
+ (if (or (not (= (selection-framples) 200))
(not (= (selection-position) 1000)))
(snd-display #__line__ ";selection after reposition: '(1000 200) '(~A ~A)?"
(selection-position)
- (selection-frames)))
+ (selection-framples)))
(reverse-selection)
- (if (or (not (= (selection-frames) 200))
+ (if (or (not (= (selection-framples) 200))
(not (= (selection-position) 1000)))
(snd-display #__line__ ";selection after reverse: '(1000 200) '(~A ~A)?"
(selection-position)
- (selection-frames)))
+ (selection-framples)))
- (let ((old-frames (frames ind)))
+ (let ((old-framples (framples ind)))
(src-selection .5)
- (if (or (> (abs (- (frames ind) (+ 200 old-frames))) 5)
- (> (abs (- (selection-frames) 400)) 5))
+ (if (or (> (abs (- (framples ind) (+ 200 old-framples))) 5)
+ (> (abs (- (selection-framples) 400)) 5))
(snd-display #__line__ ";selection after src .5: '(1000 400) '(~A ~A)?"
(selection-position)
- (selection-frames)))
+ (selection-framples)))
(undo)
(redo)
- (if (or (> (abs (- (frames ind) (+ 200 old-frames))) 5)
- (> (abs (- (selection-frames) 400)) 5))
+ (if (or (> (abs (- (framples ind) (+ 200 old-framples))) 5)
+ (> (abs (- (selection-framples) 400)) 5))
(snd-display #__line__ ";selection after src .5 with undo/redo: '(1000 400) '(~A ~A)?"
(selection-position)
- (selection-frames)))
+ (selection-framples)))
(undo 3))
(close-sound ind))
- (set! (mus-srate) 22050)
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "src-* tests" 10000))
+ (set! *clm-srate* 22050)
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "src-* tests" 10000))
(osc (make-oscil 500)))
(define f3neq (lambda (a b) (> (abs (- a b)) 10)))
@@ -34087,20 +28376,19 @@ EDITS: 2
(snd-display #__line__ ";src-fit-envelope 0.5: ~A" (src-duration (src-fit-envelope '(0 1 1 2) 0.5))))
- (if (fneq (fm-parallel-component 100 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t) 0.69287)
- (snd-display #__line__ ";fm-parallel-component 100: ~A" (fm-parallel-component 100 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t)))
- (if (fneq (fm-parallel-component 500 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t) 0.17047)
- (snd-display #__line__ ";fm-parallel-component 500: ~A" (fm-parallel-component 500 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) '() '() #t)))
-
- (if (fneq (cheby-hka 3 0.25 (vct 0 0 0 0 1.0 1.0)) -0.0732421875)
- (snd-display #__line__ ";cheby-hka 0: ~A" (cheby-hka 3 0.25 (vct 0 0 0 0 1.0 1.0))))
- (if (fneq (cheby-hka 2 0.25 (vct 0 0 0 0 1.0 1.0)) -0.234375)
- (snd-display #__line__ ";cheby-hka 1: ~A" (cheby-hka 2 0.25 (vct 0 0 0 0 1.0 1.0))))
- (if (fneq (cheby-hka 1 0.25 (vct 0 0 0 0 1.0 1.0)) 1.025390625)
- (snd-display #__line__ ";cheby-hka 2: ~A" (cheby-hka 1 0.25 (vct 0 0 0 0 1.0 1.0))))
- (if (fneq (cheby-hka 0 0.25 (vct 0 0 0 0 1.0 1.0)) 1.5234375)
- (snd-display #__line__ ";cheby-hka 3: ~A" (cheby-hka 0 0.25 (vct 0 0 0 0 1.0 1.0)) 1.5234375))
+ (if (fneq (fm-parallel-component 100 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) () () #t) 0.69287)
+ (snd-display #__line__ ";fm-parallel-component 100: ~A" (fm-parallel-component 100 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) () () #t)))
+ (if (fneq (fm-parallel-component 500 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) () () #t) 0.17047)
+ (snd-display #__line__ ";fm-parallel-component 500: ~A" (fm-parallel-component 500 100.0 (list 100.0 300.0 400.0) (list 1.0 0.5 0.25) () () #t)))
+ (if (fneq (cheby-hka 3 0.25 (float-vector 0 0 0 0 1.0 1.0)) -0.0732421875)
+ (snd-display #__line__ ";cheby-hka 0: ~A" (cheby-hka 3 0.25 (float-vector 0 0 0 0 1.0 1.0))))
+ (if (fneq (cheby-hka 2 0.25 (float-vector 0 0 0 0 1.0 1.0)) -0.234375)
+ (snd-display #__line__ ";cheby-hka 1: ~A" (cheby-hka 2 0.25 (float-vector 0 0 0 0 1.0 1.0))))
+ (if (fneq (cheby-hka 1 0.25 (float-vector 0 0 0 0 1.0 1.0)) 1.025390625)
+ (snd-display #__line__ ";cheby-hka 2: ~A" (cheby-hka 1 0.25 (float-vector 0 0 0 0 1.0 1.0))))
+ (if (fneq (cheby-hka 0 0.25 (float-vector 0 0 0 0 1.0 1.0)) 1.5234375)
+ (snd-display #__line__ ";cheby-hka 3: ~A" (cheby-hka 0 0.25 (float-vector 0 0 0 0 1.0 1.0))))
(map-channel (lambda (y) (* .5 (oscil osc))))
(let ((vals (freq-peak 0 ind 8192)))
@@ -34110,7 +28398,7 @@ EDITS: 2
(for-each
(lambda (sr dur)
(src-sound sr 1.0 ind 0)
- (if (fneq (/ (frames ind 0) 10000.0) dur) (snd-display #__line__ ";src-sound ~A: ~A (~A)" sr (/ (frames ind 0) 10000.0) dur))
+ (if (fneq (/ (framples ind 0) 10000.0) dur) (snd-display #__line__ ";src-sound ~A: ~A (~A)" sr (/ (framples ind 0) 10000.0) dur))
(let ((vals (freq-peak 0 ind 8192)))
(if (or (f4neq (car vals) (* 500 sr))
(fneq (cadr vals) 1.0))
@@ -34121,9 +28409,9 @@ EDITS: 2
(for-each
(lambda (e f0 f1)
(src-sound e 1.0 ind 0)
- (if (fneq (/ (frames ind 0) 10000.0) (src-duration e))
+ (if (fneq (/ (framples ind 0) 10000.0) (src-duration e))
(snd-display #__line__ ";src-sound (env) ~A: ~A (~A)"
- e (/ (frames ind 0) 10000.0) (src-duration e)))
+ e (/ (framples ind 0) 10000.0) (src-duration e)))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) f0)
(snd-display #__line__ ";src (env) 0 ~A freq: ~A" f0 vals)))
@@ -34136,10 +28424,10 @@ EDITS: 2
(list 1000.0 500.0 500.0 500.0 1000.0))
(for-each
(lambda (e f0 f1)
- (src-sound (make-env e :length (frames)) 1.0 ind 0)
- (if (fneq (/ (frames ind 0) 10000.0) (src-duration e))
+ (src-sound (make-env e :length (framples)) 1.0 ind 0)
+ (if (fneq (/ (framples ind 0) 10000.0) (src-duration e))
(snd-display #__line__ ";src-sound (make-env) ~A: ~A (~A)"
- e (/ (frames ind 0) 10000.0) (src-duration e)))
+ e (/ (framples ind 0) 10000.0) (src-duration e)))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) f0)
(snd-display #__line__ ";src (make-env) 0 ~A freq: ~A" f0 vals)))
@@ -34154,7 +28442,7 @@ EDITS: 2
(for-each
(lambda (sr dur)
(src-channel sr)
- (if (fneq (/ (frames ind 0) 10000.0) dur) (snd-display #__line__ ";src-channel ~A: ~A (~A)" sr (/ (frames ind 0) 10000.0) dur))
+ (if (fneq (/ (framples ind 0) 10000.0) dur) (snd-display #__line__ ";src-channel ~A: ~A (~A)" sr (/ (framples ind 0) 10000.0) dur))
(let ((vals (freq-peak 0 ind 8192)))
(if (or (f4neq (car vals) (* 500 sr))
(fneq (cadr vals) 1.0))
@@ -34165,9 +28453,9 @@ EDITS: 2
(for-each
(lambda (e f0 f1)
(src-channel e)
- (if (fneq (/ (frames ind 0) 10000.0) (src-duration e))
+ (if (fneq (/ (framples ind 0) 10000.0) (src-duration e))
(snd-display #__line__ ";src-channel (env) ~A: ~A (~A)"
- e (/ (frames ind 0) 10000.0) (src-duration e)))
+ e (/ (framples ind 0) 10000.0) (src-duration e)))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) f0)
(snd-display #__line__ ";src-channel (env f0) ~A: ~A" f0 vals)))
@@ -34182,8 +28470,8 @@ EDITS: 2
(for-each
(lambda (sr dur)
(src-channel sr 1000 2500)
- (if (f4neq (frames ind 0) (+ 7500 (* dur 2500)))
- (snd-display #__line__ ";src-channel section: ~A ~A" (frames) (+ 7500 (* dur 2500))))
+ (if (f4neq (framples ind 0) (+ 7500 (* dur 2500)))
+ (snd-display #__line__ ";src-channel section: ~A ~A" (framples) (+ 7500 (* dur 2500))))
(let ((vals (freq-peak 0 ind 512)))
(if (f5neq (car vals) 500.0)
(snd-display #__line__ ";src-channel section 0 ~A freq: ~A" sr vals)))
@@ -34200,9 +28488,9 @@ EDITS: 2
(for-each
(lambda (e)
(src-channel (make-env e :length 2500) 1000 2500)
- (if (f3neq (frames ind 0) (+ 7500 (* (src-duration e) 2500)))
+ (if (f3neq (framples ind 0) (+ 7500 (* (src-duration e) 2500)))
(snd-display #__line__ ";src-channel section (make-env duration) ~A: ~A (~A ~A)"
- e (src-duration e) (frames) (+ 7500 (* (src-duration e) 2500))))
+ e (src-duration e) (framples) (+ 7500 (* (src-duration e) 2500))))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) 500.0)
(snd-display #__line__ ";src-channel section (make-env e) ~A: ~A" e vals)))
@@ -34216,8 +28504,8 @@ EDITS: 2
(for-each
(lambda (sr dur)
(src-selection sr)
- (if (f3neq (frames ind 0) (+ 7500 (* dur 2500)))
- (snd-display #__line__ ";src-selection section: ~A ~A" (frames) (+ 7500 (* dur 2500))))
+ (if (f3neq (framples ind 0) (+ 7500 (* dur 2500)))
+ (snd-display #__line__ ";src-selection section: ~A ~A" (framples) (+ 7500 (* dur 2500))))
(let ((vals (freq-peak 0 ind 512)))
(if (f5neq (car vals) 500.0)
(snd-display #__line__ ";src-selection section 0 ~A freq: ~A" sr vals)))
@@ -34234,9 +28522,9 @@ EDITS: 2
(for-each
(lambda (e)
(src-selection (make-env e :length 2500))
- (if (f3neq (frames ind 0) (+ 7500 (* (src-duration e) 2500)))
+ (if (f3neq (framples ind 0) (+ 7500 (* (src-duration e) 2500)))
(snd-display #__line__ ";src-selection section (make-env duration) ~A: ~A (~A ~A)"
- e (src-duration e) (frames) (+ 7500 (* (src-duration e) 2500))))
+ e (src-duration e) (framples) (+ 7500 (* (src-duration e) 2500))))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) 500.0)
(snd-display #__line__ ";src-selection section (make-env e) ~A: ~A" e vals)))
@@ -34249,9 +28537,9 @@ EDITS: 2
(for-each
(lambda (e)
(src-selection e)
- (if (f3neq (frames ind 0) (+ 7500 (* (src-duration e) 2500)))
+ (if (f3neq (framples ind 0) (+ 7500 (* (src-duration e) 2500)))
(snd-display #__line__ ";src-selection section (env duration) ~A: ~A (~A ~A)"
- e (src-duration e) (frames) (+ 7500 (* (src-duration e) 2500))))
+ e (src-duration e) (framples) (+ 7500 (* (src-duration e) 2500))))
(let ((vals (freq-peak 0 ind 256)))
(if (f5neq (car vals) 500.0)
(snd-display #__line__ ";src-selection section (env e) ~A: ~A" e vals)))
@@ -34264,64 +28552,59 @@ EDITS: 2
(close-sound ind)
)
- (if (< (print-length) 12) (set! (print-length) 12))
+ (if (< *print-length* 12) (set! *print-length* 12))
(let ((ind (new-sound "hi.snd")))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(set! (sample i ind) (* i .1)))
(select-all ind)
(set! (sample 10 ind) 1.0)
(smooth-selection)
- (if (not (vequal (vct-subseq (channel->vct 0 11 ind) 0 9) (vct-subseq (smoother 0.0 1.0 10) 0 9)))
- (snd-display #__line__ ";smooth-selection: ~A ~A?" (channel->vct 0 11 ind) (smoother 0.0 1.0 10)))
+ (if (not (vequal (float-vector-subseq (channel->float-vector 0 11 ind) 0 9) (float-vector-subseq (smoother 0.0 1.0 10) 0 9)))
+ (snd-display #__line__ ";smooth-selection: ~A ~A?" (channel->float-vector 0 11 ind) (smoother 0.0 1.0 10)))
(revert-sound)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(set! (sample i ind) (- 1.0 (* i .1))))
(select-all ind)
(set! (sample 10 ind) 0.0)
(smooth-selection)
- (if (not (vequal (vct-subseq (channel->vct 0 11 ind) 0 9) (vct-subseq (smoother 1.0 0.0 10) 0 9)))
- (snd-display #__line__ ";smooth-selection back: ~A ~A?" (channel->vct 0 11 ind) (smoother 1.0 0.0 10)))
+ (if (not (vequal (float-vector-subseq (channel->float-vector 0 11 ind) 0 9) (float-vector-subseq (smoother 1.0 0.0 10) 0 9)))
+ (snd-display #__line__ ";smooth-selection back: ~A ~A?" (channel->float-vector 0 11 ind) (smoother 1.0 0.0 10)))
(close-sound ind))
(let ((ind (new-sound "hi.snd")))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(set! (sample i ind) (* i .1)))
(set! (sample 10 ind) 1.0)
(smooth-sound 0 10 ind)
- (if (not (vequal (vct-subseq (channel->vct 0 11 ind) 0 9) (vct-subseq (smoother 0.0 1.0 10) 0 9)))
- (snd-display #__line__ ";smooth-sound: ~A ~A?" (channel->vct 0 11 ind) (smoother 0.0 1.0 10)))
+ (if (not (vequal (float-vector-subseq (channel->float-vector 0 11 ind) 0 9) (float-vector-subseq (smoother 0.0 1.0 10) 0 9)))
+ (snd-display #__line__ ";smooth-sound: ~A ~A?" (channel->float-vector 0 11 ind) (smoother 0.0 1.0 10)))
(revert-sound)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(set! (sample i ind) (- 1.0 (* i .1))))
(set! (sample 10 ind) 0.0)
(smooth-sound 0 10 ind)
- (if (not (vequal (vct-subseq (channel->vct 0 11 ind) 0 9) (vct-subseq (smoother 1.0 0.0 10) 0 9)))
- (snd-display #__line__ ";smooth-sound back: ~A ~A?" (channel->vct 0 11 ind) (smoother 1.0 0.0 10)))
+ (if (not (vequal (float-vector-subseq (channel->float-vector 0 11 ind) 0 9) (float-vector-subseq (smoother 1.0 0.0 10) 0 9)))
+ (snd-display #__line__ ";smooth-sound back: ~A ~A?" (channel->float-vector 0 11 ind) (smoother 1.0 0.0 10)))
(close-sound ind))
(if (file-exists? "hi.snd") (delete-file "hi.snd"))
(let* ((ind (open-sound "oboe.snd"))
- (len (frames ind)))
+ (len (framples ind)))
(set! (cursor ind) 1200)
(key (char->integer #\u) 4 ind)
(key (char->integer #\1) 0 ind)
(key (char->integer #\0) 0 ind)
(key (char->integer #\0) 0 ind)
(key (char->integer #\o) 4 ind)
- (if (not (= (frames ind) (+ 100 len)))
- (snd-display #__line__ ";C-o len: ~A? " (frames)))
+ (if (not (= (framples ind) (+ 100 len)))
+ (snd-display #__line__ ";C-o len: ~A? " (framples)))
(if with-gui
- (let ((reader (make-sampler 1200 ind)))
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (let ((val (next-sample reader)))
- (if (fneq val 0.0) (snd-display #__line__ ";C-o[~D]: ~A?" i val))))
- (if (not (= (sampler-position reader) 1300)) (snd-display #__line__ ";reader pos: ~A" (sampler-position reader)))
- (free-sampler reader)))
+ (let ((data (channel->float-vector 1200 100 ind)))
+ (if (fneq (float-vector-peak data) 0.0) (snd-display #__line__ ";C-o: ~A?" (float-vector-peak data)))))
(revert-sound ind)
(set! (cursor ind) 1200)
(key (char->integer #\u) 4 ind)
@@ -34329,15 +28612,11 @@ EDITS: 2
(key (char->integer #\0) 0 ind)
(key (char->integer #\0) 0 ind)
(key (char->integer #\z) 4 ind)
- (if (not (= (frames ind) len))
- (snd-display #__line__ ";C-z len: ~A? " (frames)))
+ (if (not (= (framples ind) len))
+ (snd-display #__line__ ";C-z len: ~A? " (framples)))
(if with-gui
- (let ((reader (make-sampler 1200 ind)))
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (let ((val (next-sample reader)))
- (if (fneq val 0.0) (snd-display #__line__ ";C-z[~D]: ~A?" i val))))
- (free-sampler reader)))
+ (let ((data (channel->float-vector 1200 100 ind)))
+ (if (fneq (float-vector-peak data) 0.0) (snd-display #__line__ ";C-z: ~A?" (float-vector-peak data)))))
(set! (cursor ind) 0)
(key (char->integer #\u) 4 ind)
(key (char->integer #\3) 0 ind)
@@ -34352,15 +28631,11 @@ EDITS: 2
(key (char->integer #\.) 0 ind)
(key (char->integer #\0) 0 ind)
(key (char->integer #\o) 4 ind)
- (if (not (= (frames ind) (+ (srate ind) len)))
- (snd-display #__line__ ";C-o 1.0 len: ~A? " (frames)))
+ (if (not (= (framples ind) (+ (srate ind) len)))
+ (snd-display #__line__ ";C-o 1.0 len: ~A? " (framples)))
(if with-gui
- (let ((reader (make-sampler 1200 ind)))
- (do ((i 0 (+ 1 i)))
- ((= i (srate ind)))
- (let ((val (next-sample reader)))
- (if (fneq val 0.0) (snd-display #__line__ ";C-o 1.0[~D]: ~A?" i val))))
- (free-sampler reader)))
+ (let ((data (channel->float-vector 1200 (srate ind) ind)))
+ (if (fneq (float-vector-peak data) 0.0) (snd-display #__line__ ";C-o 1.0: ~A?" (float-vector-peak data)))))
(revert-sound ind)
(set! (cursor ind) 1200)
(key (char->integer #\u) 4 ind)
@@ -34368,15 +28643,11 @@ EDITS: 2
(key (char->integer #\.) 0 ind)
(key (char->integer #\0) 0 ind)
(key (char->integer #\z) 4 ind)
- (if (not (= (frames ind) len))
- (snd-display #__line__ ";C-z 1.0 len: ~A? " (frames)))
+ (if (not (= (framples ind) len))
+ (snd-display #__line__ ";C-z 1.0 len: ~A? " (framples)))
(if with-gui
- (let ((reader (make-sampler 1200 ind)))
- (do ((i 0 (+ 1 i)))
- ((= i (srate ind)))
- (let ((val (next-sample reader)))
- (if (fneq val 0.0) (snd-display #__line__ ";C-z 1.0[~D]: ~A?" i val))))
- (free-sampler reader)))
+ (let ((data (channel->float-vector 1200 (srate ind) ind)))
+ (if (fneq (float-vector-peak data) 0.0) (snd-display #__line__ ";C-z 1.0: ~A?" (float-vector-peak data)))))
(close-sound ind))
(let ((ind (open-sound "2.snd")))
@@ -34388,24 +28659,24 @@ EDITS: 2
(not (selection-member? ind 1))
(not (= (selection-position ind 0) 0))
(not (= (selection-position ind 1) 0))
- (not (= (selection-frames ind 0) (frames ind 0)))
- (not (= (selection-frames ind 1) (frames ind 1))))
+ (not (= (selection-framples ind 0) (framples ind 0)))
+ (not (= (selection-framples ind 1) (framples ind 1))))
(snd-display #__line__ ";sync selection via <-: ~A ~A ~A ~A ~A ~A"
(selection-member? ind 0) (selection-member? ind 1)
(selection-position ind 0) (selection-position ind 1)
- (selection-frames ind 0) (selection-frames ind 1)))
+ (selection-framples ind 0) (selection-framples ind 1)))
(key (char->integer #\space) 4)
(key (char->integer #\>) 4)
(if (or (not (selection-member? ind 0))
(not (selection-member? ind 1))
(not (= (selection-position ind 0) 0))
(not (= (selection-position ind 1) 0))
- (not (= (selection-frames ind 0) (frames ind 0)))
- (not (= (selection-frames ind 1) (frames ind 1))))
+ (not (= (selection-framples ind 0) (framples ind 0)))
+ (not (= (selection-framples ind 1) (framples ind 1))))
(snd-display #__line__ ";sync selection via ->: ~A ~A ~A ~A ~A ~A"
(selection-member? ind 0) (selection-member? ind 1)
(selection-position ind 0) (selection-position ind 1)
- (selection-frames ind 0) (selection-frames ind 1)))
+ (selection-framples ind 0) (selection-framples ind 1)))
(set! (cursor ind 1) 0)
(set! (cursor ind 0) 1000)
(if (not (= (cursor ind 1) 1000)) (snd-display #__line__ ";syncd cursors: ~A ~A" (cursor ind 0) (cursor ind 1)))
@@ -34415,52 +28686,52 @@ EDITS: 2
(let ((reg (make-region 100 200 ind #t)))
(if (not (= (region-chans reg) 2))
(snd-display #__line__ ";make-region #t for chan in 2a.snd: ~A chans" (region-chans reg)))
- (let ((id (mix-region reg 1000)))
- (if (or (not (= (edit-position ind 0) 1))
- (not (= (edit-position ind 1) 0)))
- (snd-display #__line__ ";mix-region default mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
- (undo)
- (set! (sync ind) 1)
- (set! id (mix-region reg 1000))
- (if (or (not (= (edit-position ind 0) 1))
- (not (= (edit-position ind 1) 1)))
- (snd-display #__line__ ";mix-region sync mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
- (undo)
- (set! (sync ind) 0)
- (set! id (mix-region reg 1000 ind 1))
- (if (or (not (= (edit-position ind 0) 0))
- (not (= (edit-position ind 1) 1)))
- (snd-display #__line__ ";mix-region mix -> chan 1: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
- (revert-sound ind)))
-
- (set! (selection-member? #t #t) #f)
- (set! (selection-member? ind 0) #t)
- (set! (selection-member? ind 1) #t)
- (set! (selection-position ind 0) 1000)
- (set! (selection-position ind 1) 1000)
- (set! (selection-frames ind 0) 100)
- (set! (selection-frames ind 1) 100)
- (if (not (= (selection-chans) 2))
- (snd-display #__line__ ";laboriously make 2 chan selection: ~A" (selection-chans)))
-
- (let ((id (mix-selection 100)))
+ (mix-region reg 1000)
(if (or (not (= (edit-position ind 0) 1))
(not (= (edit-position ind 1) 0)))
- (snd-display #__line__ ";mix-selection default mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (snd-display #__line__ ";mix-region default mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
(undo)
(set! (sync ind) 1)
- (set! id (mix-selection 100))
+ (mix-region reg 1000)
(if (or (not (= (edit-position ind 0) 1))
(not (= (edit-position ind 1) 1)))
- (snd-display #__line__ ";mix-selection sync mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (snd-display #__line__ ";mix-region sync mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
(undo)
(set! (sync ind) 0)
- (set! id (mix-selection 100 ind 1))
+ (mix-region reg 1000 ind 1)
(if (or (not (= (edit-position ind 0) 0))
(not (= (edit-position ind 1) 1)))
- (snd-display #__line__ ";mix-selection mix -> chan 1: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
-
- (close-sound ind)))
+ (snd-display #__line__ ";mix-region mix -> chan 1: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (revert-sound ind))
+
+ (set! (selection-member? #t #t) #f)
+ (set! (selection-member? ind 0) #t)
+ (set! (selection-member? ind 1) #t)
+ (set! (selection-position ind 0) 1000)
+ (set! (selection-position ind 1) 1000)
+ (set! (selection-framples ind 0) 100)
+ (set! (selection-framples ind 1) 100)
+ (if (not (= (selection-chans) 2))
+ (snd-display #__line__ ";laboriously make 2 chan selection: ~A" (selection-chans)))
+
+ (mix-selection 100)
+ (if (or (not (= (edit-position ind 0) 1))
+ (not (= (edit-position ind 1) 0)))
+ (snd-display #__line__ ";mix-selection default mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (undo)
+ (set! (sync ind) 1)
+ (mix-selection 100)
+ (if (or (not (= (edit-position ind 0) 1))
+ (not (= (edit-position ind 1) 1)))
+ (snd-display #__line__ ";mix-selection sync mix: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+ (undo)
+ (set! (sync ind) 0)
+ (mix-selection 100 ind 1)
+ (if (or (not (= (edit-position ind 0) 0))
+ (not (= (edit-position ind 1) 1)))
+ (snd-display #__line__ ";mix-selection mix -> chan 1: ~A ~A" (edit-position ind 0) (edit-position ind 1)))
+
+ (close-sound ind))
(let ((ind (open-sound "oboe.snd")))
(test-selection ind 1200 100 2.0)
@@ -34474,75 +28745,70 @@ EDITS: 2
(test-selection-to ind 0 100 0.5)
(test-selection-to ind 22500 (- 50827 22500) 2.0)
(test-selection-to ind 0 50828 0.5)
-
+
(revert-sound ind)
(make-selection 1200 1200)
(if (not (selection?)) (snd-display #__line__ ";no selection from 1 samp region?"))
- (if (not (= (selection-frames) 1)) (snd-display #__line__ ";1 samp selection: ~A samps?" (selection-frames)))
+ (if (not (= (selection-framples) 1)) (snd-display #__line__ ";1 samp selection: ~A samps?" (selection-framples)))
(scale-selection-to 1.0)
(if (fneq (sample 1200 ind 0) 1.0) (snd-display #__line__ ";scale 1 samp selection: ~A?" (sample 1200 ind 0)))
(revert-sound ind)
(let ((id (make-region 500 1000)))
(src-selection .5)
- (if (> (abs (- (region-frames id) 500)) 1) (snd-display #__line__ ";region-frames after src-selection: ~A?" (region-frames id)))
+ (if (> (abs (- (region-framples id) 500)) 1) (snd-display #__line__ ";region-framples after src-selection: ~A?" (region-framples id)))
(let ((reg-mix-id (car (mix-region id 1500 ind 0))))
- (if (not (= (mix-length reg-mix-id) (region-frames id)))
- (snd-display #__line__ ";mix-region: ~A != ~A?" (region-frames id) (mix-length reg-mix-id)))
+ (if (not (= (mix-length reg-mix-id) (region-framples id)))
+ (snd-display #__line__ ";mix-region: ~A != ~A?" (region-framples id) (mix-length reg-mix-id)))
(if (not (equal? (mix-home reg-mix-id) (list ind 0 #f 0)))
(snd-display #__line__ ";mix-region mix-home ~A (~A 0 #f 0)?" (mix-home reg-mix-id) ind))
(let ((sel-mix-id (car (mix-selection 2500 ind 0))))
- (if (not (= (selection-frames) (mix-length sel-mix-id)))
- (snd-display #__line__ ";mix-selection frames: ~A != ~A?" (selection-frames) (mix-length sel-mix-id)))
+ (if (not (= (selection-framples) (mix-length sel-mix-id)))
+ (snd-display #__line__ ";mix-selection framples: ~A != ~A?" (selection-framples) (mix-length sel-mix-id)))
(if (> (abs (- (* 2 (mix-length reg-mix-id)) (mix-length sel-mix-id))) 3)
(snd-display #__line__ ";mix selection and region: ~A ~A (~A ~A)?"
- (mix-length reg-mix-id) (mix-length sel-mix-id) (region-frames id) (selection-frames)))
+ (mix-length reg-mix-id) (mix-length sel-mix-id) (region-framples id) (selection-framples)))
(if (not (equal? (mix-home sel-mix-id) (list ind 0 #f 0)))
(snd-display #__line__ ";mix-selection mix-home: ~A (~A 0 #f 0)?" (mix-home sel-mix-id) ind))
(insert-selection 3000 ind 0)
(insert-selection 3000 ind)
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (begin
- (set! (cursor ind 0) 3000)
- (XtCallCallbacks (menu-option "Insert Selection") XmNactivateCallback (snd-global-state))))
(mix-selection 3000 ind)
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (begin
- (XtCallCallbacks (menu-option "Mix Selection") XmNactivateCallback (snd-global-state))
- (XtCallCallbacks (menu-option "Play Selection") XmNactivateCallback (snd-global-state))))
(delete-selection)
(revert-sound ind))))
(close-sound ind))
(if (file-exists? "storm.snd")
(let ((ind (open-sound "storm.snd")))
- (set! (sinc-width) 10)
+ (set! *sinc-width* 10)
(time (src-sound 1.3))
(time (env-sound '(0 0 1 1 2 0)))
(time (filter-sound '(0 1 .2 0 .5 1 1 0) 20)) ; FIR direct form
(time (filter-sound '(0 0 .1 0 .11 1 .12 0 1 0) 2048)) ; convolution
(revert-sound ind)
+
(let ((reg (make-region 0 123000 ind 0))) ; force copy branch to execute
- (region->vct reg 0 10 0 (make-vct 10)))
+ (region->float-vector reg 0 10 0 (make-float-vector 10)))
(ramp-channel 0.0 1.0)
(ramp-channel 0.0 1.0)
(ramp-channel 0.0 1.0)
(ramp-channel 0.0 1.0) ; force env
(close-sound ind)))
+
(if (file-exists? "1a.snd")
(let ((ind1 (open-sound "1a.snd")))
(time (rubber-sound 1.25))
(close-sound ind1)))
-
+ (gc)
(let* ((oboe (open-sound "oboe.snd"))
(a4 (open-sound "4.aiff"))
(sr (srate oboe))
- (fr (frames oboe 0))
- (typ (header-type oboe))
- (frm (data-format oboe))
- (loc (data-location oboe))
- (com (comment oboe)))
- (save-sound-as "test.aif" oboe mus-aifc)
+ ;(fr (framples oboe 0))
+ ;(typ (header-type oboe))
+ ;(frm (sample-type oboe))
+ ;(loc (data-location oboe))
+ ;(com (comment oboe))
+ )
+ (save-sound-as "test.aif" oboe :header-type mus-aifc)
(let ((oboe-aif (open-sound "test.aif")))
(if (not (= (header-type oboe-aif) mus-aifc)) (snd-display #__line__ ";oboe-aif header: ~A?" (mus-header-type-name (header-type oboe-aif))))
(set! (srate oboe-aif) (* sr 2.0))
@@ -34551,9 +28817,9 @@ EDITS: 2
(if (not (= (header-type oboe-aif) mus-next)) (snd-display #__line__ ";set! header: ~A?" (mus-header-type-name (header-type oboe-aif))))
(set! (data-location oboe-aif) 28)
(if (not (= (data-location oboe-aif) 28)) (snd-display #__line__ ";set! data-location: ~A?" (data-location oboe-aif)))
- (set! (data-format oboe-aif) mus-mulaw)
- (if (not (= (data-format oboe-aif) mus-mulaw)) (snd-display #__line__ ";set! format: ~A?" (mus-data-format-name (data-format oboe-aif))))
- (save-sound-as "test.aif" oboe-aif mus-aifc mus-bshort 22050 0)
+ (set! (sample-type oboe-aif) mus-mulaw)
+ (if (not (= (sample-type oboe-aif) mus-mulaw)) (snd-display #__line__ ";set! format: ~A?" (mus-sample-type-name (sample-type oboe-aif))))
+ (save-sound-as "test.aif" oboe-aif 22050 mus-bshort mus-aifc 0)
(close-sound oboe-aif)
(delete-file "test.aif")
(set! (selected-sound) a4)
@@ -34709,110 +28975,103 @@ EDITS: 2
(snd-display #__line__ ";envelope exp 2: ~A" val)))
(let ((ind (new-sound "fmv.snd"))
- (v (make-vct 20 1.0)))
- (vct->channel v)
+ (v (make-float-vector 20 1.0)))
+ (float-vector->channel v)
(if (selection?) (set! (selection-member? #t) #f))
(make-selection 5 9 ind 0)
(scale-selection-to 0.5)
(insert-selection 15 ind)
- (if (not (= (frames ind) 25)) (snd-display #__line__ ";insert-selection 5: ~A" (frames ind)))
- (if (not (vequal (channel->vct 0 25) (vct 1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5
+ (if (not (= (framples ind) 25)) (snd-display #__line__ ";insert-selection 5: ~A" (framples ind)))
+ (if (not (vequal (channel->float-vector 0 25) (float-vector 1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5
1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5
1.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";insert-selection: ~A" (channel->vct 0 25)))
+ (snd-display #__line__ ";insert-selection: ~A" (channel->float-vector 0 25)))
(mix-selection 1 ind 0) ; this is being confused by clipping settings
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 1.000 1.500 1.500 1.500 1.500 1.000 0.500 0.500 0.500 0.500)))
- (snd-display #__line__ ";mix-selection vals: ~A" (channel->vct 0 10 ind 0)))
+ (if (not (vequal (channel->float-vector 0 10 ind 0) (float-vector 1.000 1.500 1.500 1.500 1.500 1.000 0.500 0.500 0.500 0.500)))
+ (snd-display #__line__ ";mix-selection vals: ~A" (channel->float-vector 0 10 ind 0)))
(close-sound ind))
(let ((ind (new-sound "fmv.snd"))
- (v (make-vct 2000))
- (ctr 0)
- (old-size (transform-size))
- (old-type (transform-type))
- (old-norm (transform-normalization))
- (old-grf (transform-graph-type)))
- (vct-map! v (lambda ()
- (let ((val (sin (* ctr 2.0 (/ pi 10.0)))))
- (set! ctr (+ 1 ctr))
- val)))
- (vct->channel v 0 2000 ind 0)
- (set! (transform-size) 256)
- (set! (transform-type) fourier-transform)
- (set! (transform-normalization) normalize-by-channel)
- (set! (transform-graph-type) graph-once)
- (set! (zero-pad) 0)
+ (v (make-float-vector 2000))
+ (old-size *transform-size*)
+ (old-type *transform-type*)
+ (old-norm *transform-normalization*)
+ (old-grf *transform-graph-type*)
+ (e (make-env (list 0.0 0.0 1.0 (* 2000 0.2 pi)) :length 2001)))
+ (fill-float-vector v (sin (env e)))
+ (float-vector->channel v 0 2000 ind 0)
+ (set! *transform-size* 256)
+ (set! *transform-type* fourier-transform)
+ (set! *transform-normalization* normalize-by-channel)
+ (set! *transform-graph-type* graph-once)
+ (set! *zero-pad* 0)
(set! (transform-graph?) #t)
(make-selection 0 200)
- (set! (show-selection-transform) #t)
- (set! (selection-frames) 300)
+ (set! *show-selection-transform* #t)
+ (set! (selection-framples) 300)
(update-transform-graph)
- (let* ((data (transform->vct))
- (peak (vct-peak data))
+ (let* ((data (transform->float-vector))
+ (peak (float-vector-peak data))
(val (transform-sample 0)))
(if (= peak 0.0) (snd-display #__line__ ";transform selection peak: ~A" peak))
- (if (fneq val (vct-ref data 0)) (snd-display #__line__ ";transform-sample: ~A, data: ~A" val (vct-ref data 0)))
- (if (and (>= (vct-length data) 64)
- (> (* .5 peak) (vct-ref data 51)))
- (snd-display #__line__ ";transform selection at 51: ~A, peak: ~A" (vct-ref data 51) peak)))
+ (if (fneq val (data 0)) (snd-display #__line__ ";transform-sample: ~A, data: ~A" val (data 0)))
+ (if (and (>= (length data) 64)
+ (> (* .5 peak) (data 51)))
+ (snd-display #__line__ ";transform selection at 51: ~A, peak: ~A" (data 51) peak)))
(for-each
(lambda (pad)
- (set! (zero-pad) pad)
+ (set! *zero-pad* pad)
(update-transform-graph)
- (let* ((data (transform->vct))
- (peak (vct-peak data))
- (pval (vct-ref data (floor (* .1 (vct-length data))))))
+ (let* ((data (transform->float-vector))
+ (peak (float-vector-peak data))
+ (pval (data (floor (* .1 (length data))))))
(if (> (* .5 peak) pval)
(snd-display #__line__ ";transform selection padded ~D: ~A, peak: ~A" pad pval peak))))
(list 1 0 3 31))
- (set! (zero-pad) 100000)
- (if (> (zero-pad) 1000)
- (snd-display #__line__ ";zero-pad: ~A" (zero-pad)))
- (set! (zero-pad) 0)
- (set! (transform-size) old-size)
- (set! (transform-type) old-type)
- (set! (transform-normalization) old-norm)
- (set! (transform-graph-type) old-grf)
+ (set! *zero-pad* 100000)
+ (if (> *zero-pad* 1000)
+ (snd-display #__line__ ";zero-pad: ~A" *zero-pad*))
+ (set! *zero-pad* 0)
+ (set! *transform-size* old-size)
+ (set! *transform-type* (if (integer? old-type) (integer->transform old-type) old-type))
+ (set! *transform-normalization* old-norm)
+ (set! *transform-graph-type* old-grf)
(close-sound ind))
(let ((ind (open-sound "storm.snd"))
- (maxes (vct 0.8387 0.5169 0.3318 0.2564 0.1982 0.1532)))
- (do ((i 0 (+ 1 i)))
+ (maxes (float-vector 0.8387 0.5169 0.3318 0.2564 0.1982 0.1532)))
+ (do ((i 0 (+ i 1)))
((= i 5))
- (if (fneq (maxamp) (vct-ref maxes i)) (snd-display #__line__ ";enving storm ~D: ~A ~A" i (vct-ref maxes i) (maxamp)))
+ (if (fneq (maxamp) (maxes i)) (snd-display #__line__ ";enving storm ~D: ~A ~A" i (maxes i) (maxamp)))
(env-sound '(0 0 1 1 2 0))
- (if (fneq (maxamp) (vct-ref maxes (+ 1 i))) (snd-display #__line__ ";enving storm ~D: ~A ~A" (+ 1 i) (vct-ref maxes (+ 1 i)) (maxamp))))
+ (if (fneq (maxamp) (maxes (+ i 1))) (snd-display #__line__ ";enving storm ~D: ~A ~A" (+ i 1) (maxes (+ i 1)) (maxamp))))
(close-sound ind))
))
-
+
;; --------------------------------------------------------------------------------
;; length as generic function:
- ;; string-length vector-length hash-table-size vct-length
- ;; frames mus-length sound-data-length mix-length region-frames
+ ;; string-length vector-length hash-table-size length
+ ;; framples mus-length framples mix-length region-framples
(let ((snd (open-sound "oboe.snd"))
- (v (vct .1 .2 .3))
+ (v (float-vector .1 .2 .3))
(vc (vector .1 .2 .3 .4))
(lst (list 1 2 3 4 5))
(hsh (make-hash-table 100))
- (sd (make-sound-data 1 10))
- (str "123456")
- (fr (frame .1 .2))
- (mx (mixer .1 .2 .3 .4)))
- (let ((mxv (mix-vct v 1000))
+ (sd (make-float-vector (list 1 10) 0.0))
+ (str "123456"))
+ (let ((mxv (mix-float-vector v 1000))
(reg (make-region 0 100))
(dly (make-delay 32))
(ply (make-player snd 0))
)
(if (not (= (length snd) 50828)) (snd-display #__line__ ";length of sound: ~A" (length snd)))
- (if (not (= (length v) 3)) (snd-display #__line__ ";length of vct: ~A" (length v)))
+ (if (not (= (length v) 3)) (snd-display #__line__ ";length of float-vector: ~A" (length v)))
(if (not (= (length vc) 4)) (snd-display #__line__ ";length of vector: ~A" (length vc)))
(if (not (= (length lst) 5)) (snd-display #__line__ ";length of list: ~A" (length lst)))
(if (not (= (length str) 6)) (snd-display #__line__ ";length of string: ~A" (length str)))
- (if (not (= (length sd) 10)) (snd-display #__line__ ";length of sound-data: ~A" (length sd)))
- (if (not (>= (length hsh) 100)) (snd-display #__line__ ";length of hash-table: ~A" (length hsh)))
- (if (not (= (length fr) 2)) (snd-display #__line__ ";length of frame: ~A" (length fr)))
- (if (not (= (length mx) 2)) (snd-display #__line__ ";length of mixer: ~A" (length mx)))
+ (if (not (= (framples sd) 10)) (snd-display #__line__ ";length of vector2: ~A" (framples sd)))
+ (if (< (length hsh) 100) (snd-display #__line__ ";length of hash-table: ~A" (length hsh)))
(if (not (= (length mxv) 3)) (snd-display #__line__ ";length of mix: ~A" (length mxv)))
(if (not (= (length reg) 101)) (snd-display #__line__ ";length of region: ~A" (length reg)))
(if (not (= (length dly) 32)) (snd-display #__line__ ";length of delay: ~A" (length dly)))
@@ -34838,50 +29097,42 @@ EDITS: 2
;; channels as generic: mus-sound-chans region-chans chans mus-channels mix/etc
(let ((snd (open-sound "oboe.snd"))
- (v (vct .1 .2 .3))
- (sd (make-sound-data 2 10))
- (str "oboe.snd")
- (fr (frame .1 .2))
- (mx (mixer .1 .2 .3 .4)))
- (let ((mxv (mix-vct v 1000))
+ (v (float-vector .1 .2 .3))
+ (sd (make-float-vector (list 2 10) 0.0))
+ (str "oboe.snd"))
+ (let ((mxv (mix-float-vector v 1000))
(reg (make-region 0 100))
(ply (make-player snd 0))
)
(if (not (= (channels snd) 1)) (snd-display #__line__ ";channels of sound: ~A" (channels snd)))
- (if (not (= (channels v) 1)) (snd-display #__line__ ";channels of vct: ~A" (channels v)))
+ (if (not (= (channels v) 1)) (snd-display #__line__ ";channels of float-vector: ~A" (channels v)))
(if (not (= (channels str) 1)) (snd-display #__line__ ";channels of string: ~A" (channels str)))
- (if (not (= (channels sd) 2)) (snd-display #__line__ ";channels of sound-data: ~A" (channels sd)))
- (if (not (= (channels fr) 2)) (snd-display #__line__ ";channels of frame: ~A" (channels fr)))
- (if (not (= (channels mx) 2)) (snd-display #__line__ ";channels of mixer: ~A" (channels mx)))
+ (if (not (= (channels sd) 2)) (snd-display #__line__ ";channels of vector2: ~A" (channels sd)))
(if (not (= (channels mxv) 1)) (snd-display #__line__ ";channels of mix: ~A" (channels mxv)))
(if (not (= (channels reg) 1)) (snd-display #__line__ ";channels of region: ~A" (channels reg)))
(if (not (= (channels ply) 1)) (snd-display #__line__ ";channels of player: ~A" (channels ply)))
)
(close-sound snd))
- ;; frames as generic
+ ;; framples as generic
(let ((snd (open-sound "oboe.snd"))
- (v (vct .1 .2 .3))
- (sd (make-sound-data 1 10))
- (str "oboe.snd")
- (fr (frame .1 .2))
- (mx (mixer .1 .2 .3 .4)))
- (let ((mxv (mix-vct v 1000))
+ (v (float-vector .1 .2 .3))
+ (sd (make-float-vector (list 1 10) 0.0))
+ (str "oboe.snd"))
+ (let ((mxv (mix-float-vector v 1000))
(reg (make-region 0 100))
(dly (make-delay 32))
(ply (make-player snd 0))
)
- (if (not (= (frames snd) 50828)) (snd-display #__line__ ";frames of sound: ~A" (frames snd)))
- (if (not (= (frames v) 3)) (snd-display #__line__ ";frames of vct: ~A" (frames v)))
- (if (not (= (frames str) 50828)) (snd-display #__line__ ";frames of string: ~A" (frames str)))
- (if (not (= (frames sd) 10)) (snd-display #__line__ ";frames of sound-data: ~A" (frames sd)))
- (if (not (= (frames fr) 2)) (snd-display #__line__ ";frames of frame: ~A" (frames fr)))
- (if (not (= (frames mx) 2)) (snd-display #__line__ ";frames of mixer: ~A" (frames mx)))
- (if (not (= (frames mxv) 3)) (snd-display #__line__ ";frames of mix: ~A" (frames mxv)))
- (if (not (= (frames reg) 101)) (snd-display #__line__ ";frames of region: ~A" (frames reg)))
- (if (not (= (frames dly) 32)) (snd-display #__line__ ";frames of delay: ~A" (frames dly)))
- (if (not (= (frames ply) 50828)) (snd-display #__line__ ";frames of player: ~A" (frames ply)))
+ (if (not (= (framples snd) 50828)) (snd-display #__line__ ";framples of sound: ~A" (framples snd)))
+ (if (not (= (framples v) 3)) (snd-display #__line__ ";framples of float-vector: ~A" (framples v)))
+ (if (not (= (framples str) 50828)) (snd-display #__line__ ";framples of string: ~A" (framples str)))
+ (if (not (= (framples sd) 10)) (snd-display #__line__ ";framples of vector2: ~A" (framples sd)))
+ (if (not (= (framples mxv) 3)) (snd-display #__line__ ";framples of mix: ~A" (framples mxv)))
+ (if (not (= (framples reg) 101)) (snd-display #__line__ ";framples of region: ~A" (framples reg)))
+ (if (not (= (framples dly) 32)) (snd-display #__line__ ";framples of delay: ~A" (framples dly)))
+ (if (not (= (framples ply) 50828)) (snd-display #__line__ ";framples of player: ~A" (framples ply)))
)
(close-sound snd))
@@ -34909,7 +29160,7 @@ EDITS: 2
(let ((snd (open-sound "oboe.snd")))
(let ((mrk (add-mark 123))
- (mx (mix-vct (vct .1 .2 .3)))
+ (mx (mix-float-vector (float-vector .1 .2 .3)))
)
(if (not (= (sync snd) 0)) (snd-display #__line__ ";sync of sound (0): ~A" (sync snd)))
(if (not (= (sync mrk) 0)) (snd-display #__line__ ";sync of mark (0): ~A" (sync mrk)))
@@ -34928,13 +29179,11 @@ EDITS: 2
;; maxamp as generic
(let ((snd (open-sound "oboe.snd"))
- (v (vct .1 .2 .3))
+ (v (float-vector .1 .2 .3))
(vc (vector .1 .2 .3 .4))
- (lst (list 1 2 3 4 5))
- (sd (make-sound-data 1 10))
- (str "pistol.snd") ; can't use oboe.snd since we messed with mus-sound-maxamp above
- (fr (frame .1 .2)))
- (let ((mxv (mix-vct v 1000))
+ (sd (make-float-vector (list 1 10) 0.0))
+ (str "pistol.snd")) ; can't use oboe.snd since we messed with mus-sound-maxamp above
+ (let ((mxv (mix-float-vector v 1000))
(reg (make-region 0 900))
(dly (make-delay 32))
)
@@ -34945,12 +29194,10 @@ EDITS: 2
(if (fneq (maxamp snd) .334) (snd-display #__line__ ";maxamp of sound: ~A" (maxamp snd)))
(if (fneq (maxamp snd 0) .334) (snd-display #__line__ ";maxamp of sound (0): ~A" (maxamp snd)))
(if (fneq (maxamp snd 0 0) .14724) (snd-display #__line__ ";maxamp of sound (0 0): ~A" (maxamp snd)))
- (if (fneq (maxamp v) .3) (snd-display #__line__ ";maxamp of vct: ~A" (maxamp v)))
+ (if (fneq (maxamp v) .3) (snd-display #__line__ ";maxamp of float-vector: ~A" (maxamp v)))
(if (fneq (maxamp vc) .4) (snd-display #__line__ ";maxamp of vector: ~A" (maxamp vc)))
- (if (fneq (maxamp lst) 5.0) (snd-display #__line__ ";maxamp of list: ~A" (maxamp lst)))
(if (fneq (maxamp str) .49267) (snd-display #__line__ ";maxamp of string: ~A" (maxamp str)))
- (if (fneq (maxamp sd) 0.1) (snd-display #__line__ ";maxamp of sound-data: ~A" (maxamp sd)))
- (if (fneq (maxamp fr) .2) (snd-display #__line__ ";maxamp of frame: ~A" (maxamp fr)))
+ (if (fneq (maxamp sd) 0.1) (snd-display #__line__ ";maxamp of vector2: ~A" (maxamp sd)))
(if (fneq (maxamp mxv) .3) (snd-display #__line__ ";maxamp of mix: ~A" (maxamp mxv)))
(if (fneq (maxamp reg) .02139) (snd-display #__line__ ";maxamp of region: ~A" (maxamp reg)))
(if (fneq (maxamp dly) .2) (snd-display #__line__ ";maxamp of delay: ~A" (maxamp dly)))
@@ -34965,43 +29212,41 @@ EDITS: 2
(define (undo-env s c)
(let ((len (car (edits s c))))
- (if (> len 0)
+ (and (> len 0)
(let ((unhappy #f))
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((or unhappy (> i len))
unhappy)
(let ((ed (edit-fragment i s c)))
(if (and ed
- (or (string=? (cadr ed) "env")
- (string=? (cadr ed) "ptree")))
+ (string=? (cadr ed) "env"))
(begin
(set! (edit-position s c) (- i 1))
- (set! unhappy #t))))))
- #f)))
+ (set! unhappy #t)))))))))
(define (opt-test choice)
(let* ((snds (sounds))
- (cursnd (list-ref snds (random (length snds))))
+ (cursnd (snds (random (length snds))))
(curchn (random (chans cursnd)))
(chan-list (all-chans))
(cur-maxamps (apply map maxamp chan-list))
(cur-edits (apply map edit-position chan-list))
- (cur-frames (apply map frames chan-list))
+ (cur-framples (apply map framples chan-list))
(cur-amp (maxamp cursnd curchn))
(cur-edit (edit-position cursnd curchn))
- (cur-frame (frames cursnd curchn)))
-
+ (cur-frame (framples cursnd curchn)))
+
(case choice
;; scale-channel
((0) (let* ((scaler (if (< (maxamp cursnd curchn) 1.0) (+ 1.0 (random 1.0)) (+ 0.5 (random 0.5))))
(cur-loc (random cur-frame))
(cur-samp (sample cur-loc cursnd curchn)))
- (scale-channel scaler 0 (frames cursnd curchn) cursnd curchn)
+ (scale-channel scaler 0 (framples cursnd curchn) cursnd curchn)
(if (and (not (= (edit-position cursnd curchn) (+ 1 cur-edit)))
(not (= (edit-position cursnd curchn) cur-edit)))
(snd-display #__line__ ";scale-channel ~A[~A] edit pos: ~A ~A" (short-file-name cursnd) curchn (edit-position cursnd curchn) cur-edit))
- (if (not (= (frames cursnd curchn) cur-frame))
- (snd-display #__line__ ";scale-channel ~A[~A] frames: ~A ~A" (short-file-name cursnd) curchn (frames cursnd curchn) cur-frame))
+ (if (not (= (framples cursnd curchn) cur-frame))
+ (snd-display #__line__ ";scale-channel ~A[~A] framples: ~A ~A" (short-file-name cursnd) curchn (framples cursnd curchn) cur-frame))
(if (fneq (maxamp cursnd curchn) (* scaler cur-amp))
(snd-display #__line__ ";scale-channel ~A[~A] maxamp: ~A ~A (~A, scaler: ~A)"
(short-file-name cursnd) curchn (maxamp cursnd curchn) (* scaler cur-amp)
@@ -35016,3799 +29261,2704 @@ EDITS: 2
(begin
(if (not (= (edit-position s c) ed))
(snd-display #__line__ ";scale-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (frames s c) fr))
- (snd-display #__line__ ";scale-channel ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (if (not (= (framples s c) fr))
+ (snd-display #__line__ ";scale-channel ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
(if (fneq (maxamp s c) amp)
(snd-display #__line__ ";scale-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
(car chan-list)
(cadr chan-list)
cur-maxamps
cur-edits
- cur-frames)))
+ cur-framples)))
;; scale-by
((1) (let* ((maxscl (apply max cur-maxamps))
(scaler (if (< maxscl 1.0) (+ 1.0 (random 1.0)) (+ 0.5 (random 0.5)))))
- (scale-by scaler cursnd curchn)
- (for-each
- (lambda (s c amp ed fr)
- (if (or (and (= (sync cursnd) 0)
- (or (not (equal? s cursnd))
- (not (= c curchn))))
- (not (= (sync s) (sync cursnd))))
- (begin
- (if (not (= (edit-position s c) ed))
- (snd-display #__line__ ";scale-by ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (frames s c) fr))
- (snd-display #__line__ ";scale-by ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
- (if (fneq (maxamp s c) amp)
- (snd-display #__line__ ";scale-by ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
- (begin
- (if (and (not (= (edit-position s c) (+ 1 ed)))
- (not (= (edit-position s c) ed)))
- (snd-display #__line__ ";scale-by ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (frames s c) fr))
- (snd-display #__line__ ";scale-by ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr))
- (if (fneq (maxamp s c) (* scaler amp))
- (snd-display #__line__ ";scale-by ~A[~A] maxamp: ~A ~A" (short-file-name s) c (maxamp s c) (* scaler amp))))))
- (car chan-list)
- (cadr chan-list)
- cur-maxamps
- cur-edits
- cur-frames)))
-
- ;; scale-sound-by
- ((4) (let* ((maxscl (apply max cur-maxamps))
- (scaler (if (< maxscl 1.0) (+ 1.0 (random 1.0)) (+ 0.5 (random 0.5)))))
- (scale-sound-by scaler 1000 1000 cursnd)
- (for-each
- (lambda (s c amp ed fr)
- (if (not (equal? s cursnd))
- (begin
- (if (not (= (edit-position s c) ed))
- (snd-display #__line__ ";scale-sound-by ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (frames s c) fr))
- (snd-display #__line__ ";scale-sound-by ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
- (if (fneq (maxamp s c) amp)
- (snd-display #__line__ ";scale-sound-by ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
- (begin
- (if (and (not (= (edit-position s c) (+ 1 ed)))
- (not (= (edit-position s c) ed)))
- (snd-display #__line__ ";scale-sound-by ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (frames s c) fr))
- (snd-display #__line__ ";scale-sound-by ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr)))))
- (car chan-list)
- (cadr chan-list)
- cur-maxamps
- cur-edits
- cur-frames)))
-
- ((5) (let ((pos (edit-position cursnd curchn)))
- (if (> pos 0)
- (undo (random pos) cursnd curchn))))
-
- ((6) (let ((len (frames cursnd curchn)))
- (if (> len 10000)
- (let ((beg (random (floor (/ len 2)))))
- (delete-samples beg (+ 10 (random 100)) cursnd curchn)))))
-
- ((7) (let ((beg (random (+ (frames cursnd curchn) 100)))
- (dur (+ 10 (random 100))))
- (set! (samples beg dur cursnd curchn) (make-vct dur 1.0))))
-
- ((8) (let ((beg (random (+ (frames cursnd curchn) 100)))
- (dur (+ 10 (random 100))))
- (insert-samples beg dur (make-vct dur 1.0) cursnd curchn)))
-
- ((9) (add-mark (random (frames cursnd curchn)) cursnd curchn))
-
- ((10) (let ((beg (random (+ (frames cursnd curchn) 100))))
- (mix-vct (make-vct (+ 10 (random 100)) (random 1.0)) beg cursnd curchn)))
-
- ((11) (let ((beg (random (+ (frames cursnd curchn) 100))))
- (pad-channel beg (+ 10 (random 100)) cursnd curchn)))
-
- ((12) (let* ((beg (random (- (frames cursnd curchn) 210)))
- (dur (+ 10 (random 200)))
- (preader0 (make-sampler (+ beg dur -1) cursnd curchn -1))
- (reader0 (make-sampler beg cursnd curchn)))
- (ptree-channel (lambda (y) (* y 2.0)) beg dur cursnd curchn #f #t)
- (let* ((preader1 (make-sampler (+ beg dur -1) cursnd curchn -1))
- (reader1 (make-sampler beg cursnd curchn)))
- (do ((i 0 (+ 1 i)))
- ((= i dur))
- (let ((pval0 (preader0))
- (val0 (reader0))
- (pval1 (preader1))
- (val1 (reader1)))
- (if (or (fneq (* val0 2) val1)
- (fneq (* pval0 2) pval1))
- (begin
- (snd-display #__line__ ";read ptree at ~A: ~A ~A ~A ~A (~A ~A ~A ~A): ~A"
- i val0 val1 pval0 pval1
- reader0 reader1 preader0 preader1
- (safe-display-edits cursnd curchn))
- (throw 'mus-error))))))))
-
- ((13) (let ((beg (random (- (frames cursnd curchn) 100))))
- (scale-channel .5 beg (+ 10 (random 100)) cursnd curchn)))
-
- ((14) (let ((beg (random (- (frames cursnd curchn) 200))))
- (scale-channel .5 beg (+ 10 (random 100)) cursnd curchn)
- (scale-channel .5 (+ beg 10) (+ 10 (random 100)) cursnd curchn)))
-
- ((15) (let ((beg (random (- (frames cursnd curchn) 200))))
- (scale-channel .5 beg (+ 10 (random 100)) cursnd curchn)
- (scale-channel 2.0 beg (+ 10 (random 100)) cursnd curchn)))
-
- ((16) (let ((beg (random (- (frames cursnd curchn) 200))))
- (pad-channel beg (+ 10 (random 100)) cursnd curchn)
- (pad-channel (+ beg 10) (+ 10 (random 100)) cursnd curchn)))
-
- ((17) (let ((beg (random (- (frames cursnd curchn) 200))))
- (pad-channel beg (+ 10 (random 100)) cursnd curchn)
- (pad-channel beg (+ 10 (random 100)) cursnd curchn)))
-
- ((18) (let ((beg (random (- (frames cursnd curchn) 200))))
- (delete-sample beg cursnd curchn)
- (delete-sample (+ beg (random 100)) cursnd curchn)))
-
- ((19) (let ((beg (random (+ (frames cursnd curchn) 200))))
- (set! (sample beg cursnd curchn) .1)
- (set! (sample (+ beg (random 100)) cursnd curchn) .2)))
-
- ((20) (let ((beg (random (- (frames cursnd curchn) 200))))
- (ramp-channel (- (random 2.0) 1.0) (- (random 2.0) 1.0) beg (+ 10 (random 100)) cursnd curchn)))
-
- ((21) (let* ((pts (+ 1 (random 8)))
- (maxpt 0.0)
- (e (let ((e1 '())
- (x 0.0)
- (y 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i pts))
- (set! e1 (cons x e1))
- (if (> (random 3) 0)
- (set! y (- (random 2.0) 1.0)))
- (set! e1 (cons y e1))
- (if (> (abs y) maxpt) (set! maxpt (abs y)))
- (set! x (+ x (+ .01 (random 1.0)))))
- (reverse e1)))
- (beg (random (- (frames cursnd curchn) 300)))
- (dur (+ 80 (random 200)))
- (reader0 (make-sampler beg cursnd curchn)))
- (env-channel e beg dur cursnd curchn)
- (let* ((reader1 (make-sampler beg cursnd curchn))
- (en (make-env e :length dur)))
- (do ((i 0 (+ 1 i)))
- ((= i dur))
- (let* ((e0 (env en))
- (val00 (reader0))
- (val0 (* e0 val00))
- (val1 (reader1)))
- (if (> (abs (- val0 val1)) .005)
- (begin
- (if (file-exists? "baddy.scm") (delete-file "baddy.scm"))
- (save-state "baddy.scm")
- (snd-display #__line__ ";read env off by ~A: ~% (~A) at ~A: ~% ~A ~A (~A ~A) [~A ~A]:~% ~A"
- (abs (- val0 val1))
- e i val0 val1
- reader0 reader1 e0 val00
- (safe-display-edits cursnd curchn))
- (throw 'mus-error))))))))
-
- ;; env-channel
- ((2) (let* ((pts (+ 1 (random 6)))
- (maxpt 0.0)
- (e (let ((e1 '())
- (x 0.0)
- (y 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i pts))
- (set! e1 (cons x e1))
- (if (> (random 3) 0)
- (set! y (- (random 2.0) 1.0)))
- (set! e1 (cons y e1))
- (if (> (abs y) maxpt) (set! maxpt (abs y)))
- (set! x (+ x (+ .01 (random 1.0)))))
- (reverse e1))))
- (if (undo-env cursnd curchn)
- (begin
- (set! cur-maxamps (apply map maxamp chan-list))
- (set! cur-edits (apply map edit-position chan-list))
- (set! cur-frames (apply map frames chan-list))
- (set! cur-amp (maxamp cursnd curchn))
- (set! cur-edit (edit-position cursnd curchn))
- (set! cur-frame (frames cursnd curchn))))
- (env-channel e 0 (frames cursnd curchn) cursnd curchn) ; can be a no-op
- (if (and (not (= (edit-position cursnd curchn) (+ 1 cur-edit)))
- (not (= (edit-position cursnd curchn) cur-edit)))
- (snd-display #__line__ ";env-channel ~A[~A] edit pos: ~A ~A" (short-file-name cursnd) curchn (edit-position cursnd curchn) cur-edit))
- (if (not (= (frames cursnd curchn) cur-frame))
- (snd-display #__line__ ";env-channel ~A[~A] frames: ~A ~A" (short-file-name cursnd) curchn (frames cursnd curchn) cur-frame))
- (if (> (- (maxamp cursnd curchn) .01) (* maxpt cur-amp))
- (begin
- (snd-display #__line__ ";env-channel ~A[~A] maxamp: ~A ~A from ~A" (short-file-name cursnd) curchn (maxamp cursnd curchn) (* maxpt cur-amp) e)
- (throw 'mus-error)))
+ (scale-by scaler cursnd curchn)
(for-each
(lambda (s c amp ed fr)
- (if (not (and (equal? s cursnd)
- (= c curchn)))
+ (if (or (and (= (sync cursnd) 0)
+ (or (not (equal? s cursnd))
+ (not (= c curchn))))
+ (not (= (sync s) (sync cursnd))))
(begin
(if (not (= (edit-position s c) ed))
- (snd-display #__line__ ";env-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (frames s c) fr))
- (snd-display #__line__ ";env-channel ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (snd-display #__line__ ";scale-by ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display #__line__ ";scale-by ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
(if (fneq (maxamp s c) amp)
- (snd-display #__line__ ";env-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
+ (snd-display #__line__ ";scale-by ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
+ (begin
+ (if (and (not (= (edit-position s c) (+ 1 ed)))
+ (not (= (edit-position s c) ed)))
+ (snd-display #__line__ ";scale-by ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display #__line__ ";scale-by ~A[~A] framples: ~A ~A" (short-file-name s) c (framples s c) fr))
+ (if (fneq (maxamp s c) (* scaler amp))
+ (snd-display #__line__ ";scale-by ~A[~A] maxamp: ~A ~A" (short-file-name s) c (maxamp s c) (* scaler amp))))))
(car chan-list)
(cadr chan-list)
cur-maxamps
cur-edits
- cur-frames)))
+ cur-framples)))
- ;; env-sound
- ((3) (let* ((pts (+ 1 (random 6)))
- (maxpt 0.0)
- (recalc #f)
- (e (let ((e1 '())
- (x 0.0)
- (y 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i pts))
- (set! e1 (cons x e1))
- (if (> (random 3) 0)
- (set! y (- (random 2.0) 1.0)))
- (set! e1 (cons y e1))
- (if (> (abs y) maxpt) (set! maxpt (abs y)))
- (set! x (+ x (+ .01 (random 1.0)))))
- (reverse e1)))
- (end (apply min cur-frames)) ; env-sound can lengthen a shorter sound if syncd+multichannel
- (beg (random (floor (/ end 2)))))
- (for-each
- (lambda (s c)
- (if (not (or (and (= (sync cursnd) 0)
- (or (not (equal? s cursnd))
- (not (= c curchn))))
- (not (= (sync s) (sync cursnd)))))
- (let ((val (undo-env s c)))
- (set! recalc (or recalc val)))))
- (car chan-list)
- (cadr chan-list))
- (if recalc
- (begin
- (set! cur-maxamps (apply map maxamp chan-list))
- (set! cur-edits (apply map edit-position chan-list))
- (set! cur-frames (apply map frames chan-list))
- (set! cur-amp (maxamp cursnd curchn))
- (set! cur-edit (edit-position cursnd curchn))
- (set! cur-frame (frames cursnd curchn))))
- (env-sound e beg (max pts (- end beg)) 1.0 cursnd curchn) ; dur here, not end point
+ ;; scale-sound-by
+ ((4) (let* ((maxscl (apply max cur-maxamps))
+ (scaler (if (< maxscl 1.0) (+ 1.0 (random 1.0)) (+ 0.5 (random 0.5)))))
+ (scale-sound-by scaler 1000 1000 cursnd)
(for-each
(lambda (s c amp ed fr)
- (if (or (and (= (sync cursnd) 0)
- (or (not (equal? s cursnd))
- (not (= c curchn))))
- (not (= (sync s) (sync cursnd))))
+ (if (not (equal? s cursnd))
(begin
(if (not (= (edit-position s c) ed))
- (snd-display #__line__ ";env-sound ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (frames s c) fr))
- (snd-display #__line__ ";env-sound ~A[~A] wrong frames: ~A ~A" (short-file-name s) c (frames s c) fr))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
(if (fneq (maxamp s c) amp)
- (snd-display #__line__ ";env-sound ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
(begin
- (if (and (not (= (edit-position s c) (+ 1 ed)))
- (not (= (edit-position s c) ed)))
- (snd-display #__line__ ";env-sound ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
- (if (not (= (frames s c) fr))
- (snd-display #__line__ ";env-sound ~A[~A] frames: ~A ~A" (short-file-name s) c (frames s c) fr)))))
+ (if (and (not (= (edit-position s c) (+ 1 ed)))
+ (not (= (edit-position s c) ed)))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display #__line__ ";scale-sound-by ~A[~A] framples: ~A ~A" (short-file-name s) c (framples s c) fr)))))
(car chan-list)
(cadr chan-list)
cur-maxamps
cur-edits
- cur-frames)))
- )))
-
- (define (amp-envs-equal? snd chn pos0 pos1 df)
- (let* ((env0 (channel-amp-envs snd chn pos0))
- (len0 (and env0 (pair? env0) (= (length env0) 2) (vct-length (cadr env0))))
- (env1 (channel-amp-envs snd chn pos1))
- (len1 (and env1 (pair? env1) (= (length env1) 2) (vct-length (cadr env1))))
- (happy #t))
- (if (and len0 len1)
- (let* ((minlen (min len0 len1))
- (inc0 (/ len0 minlen))
- (inc1 (/ len1 minlen))
- (e0 (cadr env0))
- (e1 (cadr env1)))
- (if (and (integer? inc0)
- (integer? inc1))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i (- minlen 1)))
- happy)
- (let ((max0 -1.0)
- (max1 -1.0))
- (if (= inc0 1)
- (set! max0 (vct-ref e0 i))
- (do ((j 0 (+ 1 j)))
- ((= j inc0))
- (if (> (vct-ref e0 (+ j (* inc0 i))) max0)
- (set! max0 (vct-ref e0 (+ j (* inc0 i)))))))
- (if (= inc1 1)
- (set! max1 (vct-ref e1 i))
- (do ((j 0 (+ 1 j)))
- ((= j inc1))
- (if (> (vct-ref e1 (+ j (* inc1 i))) max1)
- (set! max1 (vct-ref e1 (+ j (* inc1 i)))))))
- (if (> (abs (- max0 max1)) df)
- (begin
- (snd-display #__line__ ";amp-env ~A: ~A ~A" i max0 max1)
- (set! happy #f)))
- (set! max0 -1.0)
- (set! max1 -1.0)))
- (begin
- (snd-display #__line__ ";lens: ~A ~A" len0 len1)
- #f)))
- #f)))
-
- (define* (edit-difference s1 c1 e1 e2 (offset 0))
- (let* ((r1 (make-sampler 0 s1 c1 1 e1))
- (r2 (make-sampler offset s1 c1 1 e2))
- (max-diff 0.0)
- (max-loc 0)
- (N (frames s1 c1 e1)))
- (do ((i 0 (+ 1 i)))
- ((= i N))
- (let ((diff (abs (- (r1) (r2)))))
- (if (> diff max-diff)
- (begin
- (set! max-diff diff)
- (set! max-loc i)))))
- (if (> max-diff 0.0)
- (list max-diff max-loc)
- #f)))
-
- (define* (edit-distance s1 c1 e1 e2 (offset 0))
- (let* ((r1 (make-sampler 0 s1 c1 1 e1))
- (r2 (make-sampler offset s1 c1 1 e2))
- (sum 0.0)
- (N (frames s1 c1 e1)))
- (do ((i 0 (+ 1 i)))
- ((= i N))
- (let ((f1 (r1))
- (f2 (r2)))
- (set! sum (+ sum (abs (- (* f1 f1) (* f2 f2)))))))
- (sqrt sum)))
-
-
- (define (check-edit-tree expected-tree expected-vals name)
- (define (vequal-at v0 v1)
- (call-with-exit
- (lambda (return)
- (let ((len (vct-length v0)))
- (do ((i 0 (+ 1 i)))
- ((= i len) #f)
- (if (> (abs (- (vct-ref v0 i) (vct-ref v1 i))) .001)
- (return (list i (vct-ref v0 i) (vct-ref v1 i)))))))))
- (define (edits-not-equal? tl0 tl1 pos)
- (if (null? tl0)
- (if (null? tl1)
- #f
- (list pos tl0 #f))
- (let ((t0 (car tl0))
- (t1 (car tl1)))
- (if (or (not (= (car t0) (car t1)))
- (not (= (cadr t0) (cadr t1)))
- (not (= (caddr t0) (caddr t1)))
- (not (= (cadddr t0) (cadddr t1)))
- (> (abs (- (list-ref t0 4) (list-ref t1 4))) .0001)
- (> (abs (- (list-ref t0 5) (list-ref t1 5))) .0001) ; rmp0
- (> (abs (- (list-ref t0 6) (list-ref t1 6))) .0001)) ; rmp1
- (list pos t0 t1)
- (edits-not-equal? (cdr tl0) (cdr tl1) (+ 1 pos))))))
- (let* ((current-vals (channel->vct))
- (len (vct-length current-vals)))
- (if (and expected-vals (not (= len (vct-length expected-vals))))
- (snd-display #__line__ ";~A: lengths differ: ~A ~A" name len (vct-length expected-vals))
- (if (and expected-vals (not (vequal current-vals expected-vals)))
- (let ((bad-data (vequal-at current-vals expected-vals)))
- (snd-display #__line__ ";checking ~A, vals disagree (loc cur expect): ~A" name bad-data))
- (let* ((tree (edit-tree))
- (bad-data (edits-not-equal? tree expected-tree 0)))
- (if bad-data
- (snd-display #__line__ ";checking ~A, trees disagree (loc cur expect): ~A~% in~%~A" name bad-data (edit-tree)))
- (if (> len 5)
- (let* ((split-loc (+ 2 (random (- len 3))))
- (fread (make-sampler split-loc))
- (bread (make-sampler (- split-loc 1) #f #f -1))
- (split-vals (make-vct len)))
- (do ((i split-loc (+ 1 i)))
- ((= i len))
- (vct-set! split-vals i (fread)))
- (do ((i (- split-loc 1) (- i 1)))
- ((< i 0))
- (vct-set! split-vals i (bread)))
- (if (and expected-vals (not (vequal split-vals expected-vals)))
- (let ((bad-data (vequal-at split-vals expected-vals)))
- (snd-display #__line__ ";checking ~A, split vals disagree (loc cur expect): ~A" name bad-data)
- (throw 'uhoh1)
- )))))))))
-
- (define (reversed-read snd chn)
- (let* ((len (frames snd chn))
- (data (make-vct len))
- (sf (make-sampler (- len 1) snd chn -1)))
- (do ((i (- len 1) (- i 1)))
- ((< i 0))
- (vct-set! data i (read-sample sf)))
- data))
-
- (define (zigzag-read snd chn)
- (let* ((len (frames snd chn))
- (data (make-vct len))
- (sf (make-sampler 3 snd chn 1)))
- (do ((i 3 (+ 1 i)))
- ((= i 6))
- (vct-set! data i (next-sample sf)))
- (do ((i 6 (- i 1)))
- ((= i 0))
- (vct-set! data i (previous-sample sf)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! data i (next-sample sf)))
- data))
-
- (define (zigzag-check name snd chn)
- (let* ((data (channel->vct))
- (sf (make-sampler 3 snd chn)))
- (do ((i 3 (+ 1 i)))
- ((= i 8))
- (let ((val (next-sample sf)))
- (if (fneq (vct-ref data i) val)
- (snd-display #__line__ ";~A: forward data[~D]: ~A ~A" name i val (vct-ref data i)))))
- (do ((i 7 (- i 1)))
- ((= i 0))
- (let ((val (previous-sample sf)))
- (if (fneq (vct-ref data i) val)
- (snd-display #__line__ ";~A: backward data[~D]: ~A ~A" name i val (vct-ref data i)))))))
-
- (define (init-sound val dur chans)
- (let ((ind (new-sound "test.snd" mus-next mus-bshort 22050 chans)))
- (do ((i 0 (+ 1 i)))
- ((= i chans))
- (insert-silence 0 dur ind i)
- (map-channel (lambda (y) val) 0 (frames) ind i))
- ind))
-
- (define (check-back-and-forth ind name v)
- (let ((happy #t))
- (if (not (vequal v (channel->vct 0 (frames) ind 0)))
- (begin
- (set! happy #f)
- (snd-display #__line__ ";~A forth:~% current: ~A~% expected: ~A" name (channel->vct 0 (frames) ind 0) v)))
- (if (not (vequal v (reversed-read ind 0)))
- (begin
- (set! happy #f)
- (snd-display #__line__ ";~A back: ~A ~A" name (reversed-read ind 0) v)))
- happy))
-
-
- (define (rampx-channel r0 r1)
- (xramp-channel r0 r1 3.0 0 (frames)))
-
- (define (check-both-chans ind name f0 f1)
- (let ((c0 (scan-channel f0 0 (frames) ind 0))
- (c1 (scan-channel f1 0 (frames) ind 1)))
- (if c0 (snd-display #__line__ ";~A swap c0: ~A" name c0))
- (if c1 (snd-display #__line__ ";~A swap c1: ~A" name c1))))
-
-
- (define (convolve-coeffs v1 v2)
- (let* ((v1-len (vct-length v1))
- (v2-len (vct-length v2))
- (res-len (+ v1-len v2-len -1))
- (vres (make-vct res-len)))
- (do ((i 0 (+ 1 i)))
- ((= i res-len))
- (let ((sum 0.0))
- (do ((j (max 0 (+ 1 (- i v2-len))) (+ 1 j)))
- ((> j (min i (- v1-len 1))))
- (set! sum (+ sum (* (vct-ref v1 j)
- (vct-ref v2 (- i j))))))
- (vct-set! vres i sum)))
- vres))
-
- (begin
-
- (do ((test-16 0 (+ 1 test-16)))
- ((= test-16 tests))
- (let ((oboe (open-sound "oboe.snd")))
- (log-mem test-16)
- (for-each
- (lambda (func name)
- (func)
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";dur:0 ~A? ~A ~A" name (edit-position oboe) (edit-fragment))))
- (list
- (lambda () (scale-channel 2.0 0 0 oboe))
- (lambda () (env-channel (make-env '(0 0 1 1) :length 124) 0 0 oboe))
- (lambda () (clm-channel (make-oscil) 0 0 oboe))
- (lambda () (vct->channel (make-vct 3) 0 0 oboe))
- (lambda () (smooth-channel 0 0 oboe))
- (lambda () (pad-channel 0 0 oboe))
- (lambda () (src-channel 2.0 0 0 oboe))
- (lambda () (mix-channel "pistol.snd" 0 0 oboe))
- (lambda () (insert-channel "pistol.snd" 0 0 oboe))
- (lambda () (reverse-channel 0 0 oboe))
- (lambda () (play oboe :start 0 :end 0))
- (lambda () (scale-sound-by 2.0 0 0 oboe))
- (lambda () (env-sound '(0 0 1 1) 0 0 oboe))
- (lambda () (set-samples 0 0 (make-vct 3) oboe))
- (lambda () (smooth-sound 0 0 oboe))
- (lambda () (insert-silence 0 0 oboe)))
- (list
- "scale-channel" "env-channel" "clm-channel" "vct->channel" "smooth-channel" "pad-channel" "src-channel"
- "mix-channel" "insert-channel" "reverse-channel" "play"
- "scale-sound-by" "env-sound" "set-samples" "smooth-sound" "insert-silence"))
+ cur-framples)))
- (for-each
- (lambda (func name)
- (let ((tag (catch #t
- func
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sample))
- (snd-display #__line__ ";~A beg -1->~A" name tag))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";beg:-1 ~A? ~A ~A" name (edit-position oboe) (edit-fragment)))))
- (list
- (lambda () (scale-channel 2.0 -1 123 oboe))
- (lambda () (env-channel (make-env '(0 0 1 1) :length 124) -1 123 oboe))
- (lambda () (clm-channel (make-oscil) -1 123 oboe))
- (lambda () (vct->channel (make-vct 3) -1 123 oboe))
- (lambda () (smooth-channel -1 123 oboe))
- (lambda () (pad-channel -1 123 oboe))
- (lambda () (src-channel 2.0 -1 123 oboe))
- (lambda () (mix-channel "pistol.snd" -1 123 oboe))
- (lambda () (insert-channel "pistol.snd" -1 123 oboe))
- (lambda () (reverse-channel -1 123 oboe))
- (lambda () (scale-sound-by 2.0 -1 123 oboe))
- (lambda () (env-sound '(0 0 1 1) -1 123 oboe))
- (lambda () (set-samples -1 123 (make-vct 3) oboe))
- (lambda () (smooth-sound -1 123 oboe))
- (lambda () (insert-silence -1 123 oboe))
- (lambda () (ptree-channel (lambda (y) (+ y .1)) -1 123 oboe)))
- (list
- "scale-channel" "env-channel" "clm-channel" "vct->channel" "smooth-channel" "pad-channel" "src-channel"
- "mix-channel" "insert-channel" "reverse-channel"
- "scale-sound-by" "env-sound" "set-samples" "smooth-sound" "insert-silence" "ptree-channel"))
-
- (scale-channel 2.0 12345678 123 oboe)
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";beg:12345678 scale-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (env-channel (make-env '(0 0 1 1) :length 124) 12345678 123 oboe)
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";beg:12345678 env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (smooth-channel 12345678 123 oboe)
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";beg:12345678 smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (src-channel 2.0 12345678 123 oboe)
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";beg:12345678 src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (reverse-channel 12345678 123 oboe)
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";beg:12345678 reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (play oboe :start 12345678 :end (+ 12345678 123))
-
- (scale-channel 2.0 0 123 oboe 0)
- (if (not (= (edit-position oboe) 1))
- (snd-display #__line__ ";oboe scale-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (env-channel (make-env '(0 0 1 1) :length 124) 0 123 oboe 0)
- (if (not (= (edit-position oboe) 2))
- (snd-display #__line__ ";oboe env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (clm-channel (make-oscil) 0 123 oboe 0)
- (if (not (= (edit-position oboe) 3))
- (snd-display #__line__ ";oboe clm-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (vct->channel (make-vct 3) 0 123 oboe 0)
- (if (not (= (edit-position oboe) 4))
- (snd-display #__line__ ";oboe vct->channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (smooth-channel 0 123 oboe 0)
- (if (not (= (edit-position oboe) 5))
- (snd-display #__line__ ";oboe smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (pad-channel 0 123 oboe 0)
- (if (not (= (edit-position oboe) 6))
- (snd-display #__line__ ";oboe pad-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (src-channel 2.0 0 123 oboe 0)
- (if (not (= (edit-position oboe) 7))
- (snd-display #__line__ ";oboe src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (mix-channel "pistol.snd" 0 123 oboe 0)
- (if (not (= (edit-position oboe) 8))
- (snd-display #__line__ ";oboe mix-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (insert-channel "pistol.snd" 0 123 oboe 0)
- (if (not (= (edit-position oboe) 9))
- (snd-display #__line__ ";oboe insert-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (reverse-channel 0 123 oboe 0)
- (if (not (= (edit-position oboe) 10))
- (snd-display #__line__ ";oboe reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
- (let* ((rd (make-sampler 0))
- (sr (make-src :srate 2.0 :input (lambda (dir) (rd)))))
- (clm-channel sr 0 12345 oboe 0)
- (if (not (= (edit-position oboe) 11))
- (snd-display #__line__ ";oboe clm-channel src? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let* ((rd (make-sampler 0))
- (sr (make-granulate :expansion 2.0 :input (lambda (dir) (rd)))))
- (clm-channel sr 0 12345 oboe 0)
- (if (not (= (edit-position oboe) 12))
- (snd-display #__line__ ";oboe clm-channel granulate? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let* ((rd (make-sampler 0))
- (flt (vct 1.0 0.0 0.0 0.0))
- (sr (make-convolve :input (lambda (dir) (rd)) :filter flt)))
- (clm-channel sr 0 12345 oboe 0)
- (if (not (= (edit-position oboe) 13))
- (snd-display #__line__ ";oboe clm-channel convolve? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let* ((rd (make-sampler 0))
- (sr (make-phase-vocoder :input (lambda (dir) (rd)))))
- (clm-channel sr 0 12345 oboe 0)
- (if (not (= (edit-position oboe) 14))
- (snd-display #__line__ ";oboe clm-channel phase-vocoder? ~A ~A" (edit-position oboe) (edit-fragment))))
- (revert-sound)
+ ((5) (let ((pos (edit-position cursnd curchn)))
+ (if (> pos 0)
+ (let ((r (random pos)))
+ (undo r cursnd curchn)))))
- (let ((tag (catch #t (lambda () (scale-channel 2.0 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity)) (snd-display #__line__ ";bad edpos scale-channel: ~A" tag))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func scale-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (env-channel (make-env '(0 0 1 1) :length 124) 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func env-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (clm-channel (make-oscil) 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func clm-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (vct->channel (make-vct 3) 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func vct->channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (smooth-channel 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (pad-channel 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func pad-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (src-channel 2.0 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func src-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (mix-channel "pistol.snd" 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func mix-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (insert-channel "pistol.snd" 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func insert-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (reverse-channel 0 123 oboe 0 (lambda (hi) #f))) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos:func reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
-
- (let ((tag (catch #t (lambda () (scale-channel 2.0 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-edit)) (snd-display #__line__ ";bad edpos scale-channel: ~A" tag))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 scale-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (env-channel (make-env '(0 0 1 1) :length 124) 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 env-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (clm-channel (make-oscil) 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 clm-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (vct->channel (make-vct 3) 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 vct->channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (smooth-channel 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (pad-channel 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 pad-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (src-channel 2.0 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 src-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (mix-channel "pistol.snd" 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 mix-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (insert-channel "pistol.snd" 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 insert-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (let ((tag (catch #t (lambda () (reverse-channel 0 123 oboe 0 123)) (lambda args (car args)))))
- (if (not (= (edit-position oboe) 0))
- (snd-display #__line__ ";edpos 123 reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment))))
- (revert-sound oboe)
+ ((6) (let ((len (framples cursnd curchn)))
+ (if (> len 10000)
+ (let ((beg (random (floor (/ len 2)))))
+ (delete-samples beg (+ 10 (random 100)) cursnd curchn)))))
- (let ((oldv (channel->vct 1000 10 oboe)))
- (mix-channel "oboe.snd" 0)
- (vct-scale! oldv 2.0)
- (if (not (vequal oldv (channel->vct 1000 10 oboe)))
- (snd-display #__line__ ";mix-channel at 0: ~A ~A" oldv (channel->vct 1000 10 oboe)))
- (revert-sound oboe)
- (vct-scale! oldv 0.5)
- (insert-channel "oboe.snd" 0)
- (if (not (vequal oldv (channel->vct 1000 10 oboe)))
- (snd-display #__line__ ";insert-channel at 0: ~A ~A" oldv (channel->vct 1000 10 oboe)))
- (if (not (= (frames oboe 0) (* 2 (frames oboe 0 0))))
- (snd-display #__line__ ";insert-channel frames: ~A ~A" (frames oboe 0) (frames oboe 0 0)))
- (revert-sound oboe))
- (close-sound oboe)
-
- (let* ((ind (new-sound "test.snd" :size 10 :channels 2)))
- (set! (sample 3 ind 0) .5)
- (set! (sample 2 ind 1) -.4)
- (save-sound-as "fmv.snd")
- (revert-sound ind)
- (let ((val (mix-channel "fmv.snd")))
- (if (mix? val)
- (snd-display #__line__ ";mix-channel returned a mix: ~A?" val)))
- (if (not (vequal (channel->vct 0 #f ind 1) (make-vct 10 0.0)))
- (snd-display #__line__ ";mix-channel mixed channel 1: A?" (channel->vct 0 #f ind 1)))
- (if (not (vequal (channel->vct 0 #f ind 0) (vct 0 0 0 .5 0 0 0 0 0 0)))
- (snd-display #__line__ ";mix-channel chan 0: ~A" (channel->vct 0 #f ind 0)))
- (revert-sound ind)
- (let ((val (mix-channel (list "fmv.snd" 2 1) 0 #f ind 0)))
- (if (mix? val)
- (snd-display #__line__ ";mix-channel 2 returned a mix: ~A?" val)))
- (if (not (vequal (channel->vct 0 #f ind 1) (make-vct 10 0.0)))
- (snd-display #__line__ ";mix-channel mixed channel 1a: A?" (channel->vct 0 #f ind 1)))
- (if (not (vequal (channel->vct 0 #f ind 0) (vct -.4 0 0 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";mix-channel chan 0a: ~A" (channel->vct 0 #f ind 0)))
- (revert-sound ind)
- (set! (sample 2 ind 1) -.4)
- (let ((val (mix-channel (list ind 2 1) 0 #f ind 0 -1 #t)))
- (if (not (mix? val))
- (snd-display #__line__ ";mix-channel with-tag: ~A" val)))
- (if (not (vequal (channel->vct 0 #f ind 1) (vct 0 0 -.4 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";mix-channel mixed channel 1b: A?" (channel->vct 0 #f ind 1)))
- (if (not (vequal (channel->vct 0 #f ind 0) (vct -.4 0 0 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";mix-channel chan 0b: ~A" (channel->vct 0 #f ind 0)))
- (revert-sound ind)
- (let ((val (car (mix-channel (list "fmv.snd" 2 1) 0 #f ind 0 -1 #t))))
- (if (not (mix? val))
- (snd-display #__line__ ";mix-channel file with-tag: ~A" val)))
- (if (not (vequal (channel->vct 0 #f ind 1) (make-vct 10 0.0)))
- (snd-display #__line__ ";mix-channel mixed channel 1c: A?" (channel->vct 0 #f ind 1)))
- (if (not (vequal (channel->vct 0 #f ind 0) (vct -.4 0 0 0 0 0 0 0 0 0)))
- (snd-display #__line__ ";mix-channel chan 0c: ~A" (channel->vct 0 #f ind 0)))
- (revert-sound ind)
- (let ((val (car (mix-channel (list "fmv.snd") 0 #f ind 1 -1 #t))))
- (if (not (mix? val))
- (snd-display #__line__ ";mix-channel file 1 with-tag: ~A" val)))
- (if (not (vequal (channel->vct 0 #f ind 0) (make-vct 10 0.0)))
- (snd-display #__line__ ";mix-channel mixed channel 0d: A?" (channel->vct 0 #f ind 1)))
- (if (not (vequal (channel->vct 0 #f ind 1) (vct 0 0 0 .5 0 0 0 0 0 0)))
- (snd-display #__line__ ";mix-channel chan 1d: ~A" (channel->vct 0 #f ind 1)))
- (revert-sound ind)
- (if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
- (close-sound ind))
+ ((7) (let ((beg (random (+ (framples cursnd curchn) 100)))
+ (dur (+ 10 (random 100))))
+ (set! (samples beg dur cursnd curchn) (make-float-vector dur 1.0))))
- (if (not (= (default-output-chans) 1)) (set! (default-output-chans) 1))
- (let ((ind (new-sound "fmv.snd"))
- (v0 (vct-fill! (make-vct 20) 1.0)))
- (vct->channel v0)
- (if (not (= (frames) 20)) (snd-display #__line__ ";vct->channel new 20: ~A" (frames)))
- (if (fneq (maxamp) 1.0) (snd-display #__line__ ";vct 1->new: ~A" (maxamp)))
-
- (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 20))
- (let ((v1 (channel->vct)))
- (if (not (vequal v1 (vct 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";env-channel step 1: ~A" v1)))
- (undo)
- (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 20) 8)
- (let ((v1 (channel->vct)))
- (if (not (vequal v1 (vct 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1)))
- (snd-display #__line__ ";env-channel step 1 at 8: ~A" v1)))
- (undo)
- (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12))
- (let ((v1 (channel->vct)))
- (if (not (vequal v1 (vct 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";env-channel step 1 at 0: ~A" v1)))
- (undo)
- (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12) 4)
- (let ((v1 (channel->vct)))
- (if (not (vequal v1 (vct 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";env-channel step 1 at 4: ~A" v1)))
- (undo)
- (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12) 4 3)
- (let ((v1 (channel->vct)))
- (if (not (vequal v1 (vct 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";env-channel step 1 at 4 by 3: ~A" v1)))
- (undo)
- (env-channel (make-env '(0 1 1 0 2 0) :base 0 :length 8) 0 12)
- (let ((v1 (channel->vct)))
- (if (not (vequal v1 (vct 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";env-channel step 1 at 0 for 7: ~A" v1)))
- (undo)
- (env-channel (make-env '(0 0 1 1 2 1 3 0 4 0) :base 0 :length 20))
- (let ((v1 (channel->vct)))
- (if (not (vequal v1 (vct 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0)))
- (snd-display #__line__ ";env-channel step 1: ~A" v1)))
- (env-channel (make-env '(0 0 1 .5 2 .25 3 0 4 0) :base 0 :length 21))
- (let ((v1 (channel->vct)))
- (if (not (vequal v1 (vct 0 0 0 0 0 0 .5 .5 .5 .5 .5 .25 .25 .25 .25 0 0 0 0 0)))
- (snd-display #__line__ ";env-channel step 1 (.5): ~A" v1)))
- (close-sound ind))
+ ((8) (let ((beg (random (+ (framples cursnd curchn) 100)))
+ (dur (+ 10 (random 100))))
+ (insert-samples beg dur (make-float-vector dur 1.0) cursnd curchn)))
- (set! (x-axis-style) x-axis-as-percentage)
- (let* ((ind (open-sound "2.snd"))
- (fr (frames))
- (m0 (maxamp ind 0))
- (m1 (maxamp ind 1)))
- (set! (sync ind) 64)
- (insert-sound "2.snd")
- (insert-sound "2.snd")
- (if (not (= (frames) (* 3 fr))) (snd-display #__line__ ";2.snd 3x = ~A ~A" fr (frames)))
- (if (not (= (frames ind 0) (frames ind 1))) (snd-display #__line__ ";insert sync'd: ~A ~A" (frames ind 0) (frames ind 1)))
- (swap-channels)
- (if (or (fneq m0 (maxamp ind 1)) (fneq m1 (maxamp ind 0)))
- (snd-display #__line__ ";swapped: ~A ~A -> ~A ~A" m0 m1 (maxamp ind 0) (maxamp ind 1)))
- (close-sound ind))
- (set! (x-axis-style) x-axis-in-seconds)
- (let ((new-snd (mono-files->stereo "test.snd" "oboe.snd" "pistol.snd")))
- (if (not (= (channels new-snd) 2)) (snd-display #__line__ ";mono-files->stereo not stereo? ~A" (channels new-snd)))
- (if (not (string=? (short-file-name new-snd) "test.snd")) (snd-display #__line__ ";mono-files->stereo filename: ~A" (short-file-name new-snd)))
- (if (not (= (frames new-snd) 50828)) (snd-display #__line__ ";mono-files->stereo frames: ~A" (frames new-snd)))
- (close-sound new-snd))
-
- (let ((oboe0 (open-sound "oboe.snd"))
- (oboe1 (open-sound "oboe.snd")))
-
- (define (funcs-equal? name func0 func1)
- (func0 #f #f oboe0)
- (func1 #f #f oboe1)
- (if (not (vequal (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (snd-display #__line__ ";~A via #f: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (revert-sound oboe0)
- (revert-sound oboe1)
- (select-sound oboe0)
- (func0)
- (select-sound oboe1)
- (func1)
- (if (not (vequal (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (snd-display #__line__ ";~A via none: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (revert-sound oboe0)
- (revert-sound oboe1)
- (func0 0 (frames oboe0) oboe0)
- (func1 0 (frames oboe1) oboe1)
- (if (not (vequal (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (snd-display #__line__ ";~A via frames: ~A ~A" name (channel->vct 1000 100 oboe0) (channel->vct 1000 100 oboe1)))
- (revert-sound oboe0)
- (revert-sound oboe1))
-
- (funcs-equal? "scale-sound-by"
- (lambda args (apply scale-sound-by (cons 2.0 args)))
- (lambda args (apply scale-channel (cons 2.0 args))))
- (funcs-equal? "scale-and-ramp"
- (lambda args (apply scale-sound-by (cons 0.0 args)))
- (lambda args (apply ramp-channel (cons 0.0 (cons 0.0 args)))))
- (funcs-equal? "scale-and-ramp"
- (lambda args (apply scale-sound-by (cons 2.0 args)))
- (lambda args (apply ramp-channel (cons 2.0 (cons 2.0 args)))))
- (funcs-equal? "smooth-sound"
- (lambda args (apply smooth-sound args))
- (lambda args (apply smooth-channel args)))
- (funcs-equal? "env-sound"
- (lambda args (apply env-sound (list (list 0 0 1 1)
- (if (> (length args) 0) (car args) 0)
- (if (and (> (length args) 1)
- (number? (cadr args)))
- (- (cadr args) 1)
- #f)
- 1.0
- (if (> (length args) 2)
- (caddr args)
- (selected-sound)))))
- (lambda args (apply env-channel
- (cons (make-env :envelope (list 0 0 1 1)
- :length (if (and (> (length args) 1)
- (number? (cadr args)))
- (cadr args)
- (frames (if (> (length args) 2)
- (caddr args)
- (selected-sound)))))
- args))))
- (funcs-equal? "map-chan"
- (lambda args (map-chan (lambda (n) (* n 2))
- (if (> (length args) 0) (car args) 0)
- (if (and (> (length args) 1)
- (number? (cadr args)))
- (- (cadr args) 1)
- #f)
- "testing..."
- (if (> (length args) 2)
- (caddr args)
- (selected-sound))))
- (lambda args (map-channel (lambda (n) (* n 2))
- (if (> (length args) 0) (car args) 0)
- (if (and (> (length args) 1)
- (number? (cadr args)))
- (- (cadr args) 1)
- #f)
- (if (> (length args) 2)
- (caddr args)
- (selected-sound)))))
-
- (funcs-equal? "src-sound"
- (lambda args (apply src-sound (list 2.0 1.0 (if (> (length args) 2) (caddr args) #f))))
- (lambda args (apply src-channel (cons 2.0 args))))
- (funcs-equal? "reverse-sound"
- (lambda args (apply reverse-sound (list (if (> (length args) 2) (caddr args) #f))))
- (lambda args (apply reverse-channel args)))
- (funcs-equal? "mix"
- (lambda args (apply mix (list "pistol.snd" 0 0 (if (> (length args) 2) (caddr args) #f))))
- (lambda args (apply mix-channel "pistol.snd" args)))
- (funcs-equal? "insert-sound"
- (lambda args (apply insert-sound (list "pistol.snd" 0 0 (if (> (length args) 2) (caddr args) #f))))
- (lambda args (apply insert-channel "pistol.snd" args)))
- (funcs-equal? "ptree-channel"
- (lambda args scale-channel (cons 2.0 args))
- (lambda args ptree-channel (cons (lambda (y) (* y 2.0)) args)))
- (funcs-equal? "ptree-channel"
- (lambda args map-channel (cons (lambda (n) (+ n .2)) args))
- (lambda args ptree-channel (cons (lambda (y) (+ y .2)) args)))
- (close-sound oboe0)
- (close-sound oboe1))
-
- (if (= test-16 0)
- (let ((ind (open-sound "oboe.snd")))
- (scale-by .5)
- (scale-by .25)
- (undo)
- (for-each
- (lambda (func name)
- (let ((tag (catch #t (lambda () (func ind)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-edit))
- (snd-display #__line__ ";~A upon about-to-be-clobbered data: ~A" name tag))))
- (list (lambda (n) (scale-channel .5 0 #f n 0 2))
- (lambda (n) (env-channel '(0 0 1 1 2 0) 0 #f n 0 2))
- (if (> (optimization) 0)
- (lambda (n) (ptree-channel (lambda (y1) y1) 0 #f n 0 2 #f))
- (lambda (n) (pad-channel 0 100 n 0 2)))
- ;;(lambda (n) (map-channel (lambda (y2) y2) 0 #f n 0 2)) ; actually will work
- (lambda (n) (pad-channel 100 100 n 0 2))
- (lambda (n) (delete-sample 100 n 0 2))
- (lambda (n) (set! (sample 100 n 0 2) .52))
- )
- (list "scale" "env" "ptree"
- ;;"map"
- "pad" "delete" "set"
- ))
- (close-sound ind)))
+ ((9) (add-mark (random (framples cursnd curchn)) cursnd curchn))
- (let ((ind (new-sound "test.snd")))
- (insert-silence 0 1000)
- (map-chan (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y .5)))
- (insert-silence 100 200)
- (if (fneq (sample 500) 0.5)
- (snd-display #__line__ ";trailing ptree rmp0 trouble: ~A" (sample 500)))
- (revert-sound ind)
-
- (insert-silence 0 1000)
- (map-chan (lambda (y) 1.0))
- (scale-by .5)
- (ptree-channel (lambda (y) (* y .5)))
- (insert-silence 100 200)
- (if (fneq (sample 500) 0.25)
- (snd-display #__line__ ";trailing ptree scaled rmp0 trouble: ~A" (sample 500)))
- (scale-by 2.0)
- (if (fneq (sample 500) 0.5)
- (snd-display #__line__ ";trailing ptree post scaled rmp0 trouble: ~A" (sample 500)))
- (revert-sound ind)
-
- (insert-silence 0 1000)
- (map-chan (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y .5)))
- (delete-samples 100 200)
- (if (fneq (sample 500) 0.5)
- (snd-display #__line__ ";trailing ptree post delete rmp0 trouble: ~A" (sample 500)))
- (if (fneq (sample 0) 0.5)
- (snd-display #__line__ ";trailing ptree pre delete rmp0 trouble: ~A" (sample 500)))
- (revert-sound ind)
-
- (insert-silence 0 1000)
- (map-chan (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y .5)))
- (set! (sample 100) .95)
- (if (fneq (sample 500) 0.5)
- (snd-display #__line__ ";trailing ptree post change rmp0 trouble: ~A" (sample 500)))
- (if (fneq (sample 0) 0.5)
- (snd-display #__line__ ";trailing ptree pre change rmp0 trouble: ~A" (sample 500)))
- (revert-sound ind)
-
- (insert-silence 0 1000)
- (map-chan (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y .1)))
- (delete-samples 100 200)
- (if (fneq (sample 500) 0.1)
- (snd-display #__line__ ";trailing ptree post delete(1) loc trouble: ~A" (sample 500)))
- (if (fneq (sample 0) 0.1)
- (snd-display #__line__ ";trailing ptree pre delete(1) loc trouble: ~A" (sample 500)))
-
- (insert-silence 0 1000)
- (map-chan (lambda (y) 1.0))
- (scale-by .5)
- (ptree-channel (lambda (y) (* y .5)))
- (scale-by .5)
- (if (fneq (sample 500) 0.125)
- (snd-display #__line__ ";scl-ptree-scl trouble: ~A" (sample 500)))
- (revert-sound ind)
-
- (insert-silence 0 1000)
- (map-chan (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y .5)))
- (env-sound '(0 0 1 1 2 0))
- (if (or (fneq (sample 0) 0.0)
- (fneq (sample 999) 0.0005)
- (fneq (sample 500) 0.5)
- (fneq (sample 250) 0.25)
- (fneq (sample 750) 0.25))
- (snd-display #__line__ ";ptree-env trouble: ~A"
- (map sample (list 0 999 500 250 750))))
-
- (insert-silence 0 1000)
- (map-chan (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y .5)))
- (make-selection 100 200)
- (scale-selection-by .5)
- (if (or (fneq (sample 500) 0.5)
- (fneq (sample 50) 0.5)
- (fneq (sample 150) 0.25))
- (snd-display #__line__ ";ptree-scl-selection trouble: ~A" (map sample (list 500 50 150))))
- (revert-sound ind)
- (close-sound ind))
+ ((10) (let ((beg (random (+ (framples cursnd curchn) 100))))
+ (mix-float-vector (make-float-vector (+ 10 (random 100)) (random 1.0)) beg cursnd curchn)))
- (let ((ind (open-sound "oboe.snd"))
- (ind1 (new-sound "test.snd"))
- (old-save-dir (save-dir)))
- (set! (save-dir) #f)
- (map-channel (lambda (y) 0.5) 0 100 ind1 0)
- (save-sound ind1)
- (close-sound ind1)
- (insert-sound "test.snd" 12345)
- (let ((vals (channel->vct (- 12345 50) 200 ind 0)))
- (if (file-exists? "hiho.scm") (delete-file "hiho.scm"))
- (save-state "hiho.scm")
- (close-sound ind)
- (for-each forget-region (regions))
- (load (string-append cwd "hiho.scm"))
- (set! ind (find-sound "oboe.snd"))
- (if (not (sound? ind))
- (snd-display #__line__ ";save hiho failed?")
- (let ((new-vals (channel->vct (- 12345 50) 200 ind 0)))
- (if (not (vequal vals new-vals))
- (snd-display #__line__ ";save state hiho vals: ~A ~A" vals new-vals))))
- (close-sound ind))
- (set! (save-dir) old-save-dir))
+ ((11) (let ((beg (random (+ (framples cursnd curchn) 100))))
+ (pad-channel beg (+ 10 (random 100)) cursnd curchn)))
- (let ((ind (open-sound "oboe.snd")))
- (for-each
- (lambda (func val name)
- (func ind)
- (if (file-exists? "s61.scm") (delete-file "s61.scm"))
- (save-state "s61.scm")
- (close-sound ind)
- (for-each forget-region (regions))
- (load (string-append cwd "s61.scm"))
- (set! ind (find-sound "oboe.snd"))
- (if (fneq (maxamp ind) val)
- (snd-display #__line__ ";saved ~A max: ~A ~A (at ~A of ~A)"
- name (maxamp ind) val (edit-position ind 0) (display-edits ind 0)))
- (revert-sound ind))
- (list (lambda (ind)
- (ptree-channel (lambda (y) (* y .5))))
- (lambda (ind)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 #f ind 0 #f #f
- (lambda (pos dur)
- (vct 0.5))))
- (lambda (ind)
- (scale-by 0.0)
- (pad-channel 0 10 ind 0 0))
- (lambda (ind)
- (scale-by 0.0)
- (scale-channel 0.5 0 #f ind 0 0))
- (lambda (ind)
- (scale-by 0.0)
- (env-channel '(0 0 1 .5 2 0) 0 #f ind 0 0))
- (lambda (ind)
- (scale-by 0.0)
- (set! (sample 0 ind 0 0) 0.9))
- (lambda (ind)
- (scale-by 0.0)
- (delete-samples 0 100 ind 0 0))
- (lambda (ind)
- (scale-by 0.0)
- (ptree-channel (lambda (y) (* y 0.5)) 0 #f ind 0 0 #f))
- (lambda (ind)
- (scale-by 0.0)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 #f ind 0 0 #f
- (lambda (pos dur)
- (vct 0.5))))
- (lambda (ind)
- (insert-samples 100 10 (make-vct 10 0.1) ind 0 0))
- )
- (list .0736 .0736 .147 .0736 .0736 0.9 .147 .0736 .0736 .147)
- (list "ptree" "ptree with init" "pad edpos" "scl edpos" "env edpos"
- "set edpos" "delete edpos" "ptree edpos" "init ptree edpos" "insert edpos"))
- (close-sound ind))
+ ((13) (let ((beg (random (- (framples cursnd curchn) 100))))
+ (scale-channel .5 beg (+ 10 (random 100)) cursnd curchn)))
+
+ ((14) (let ((beg (random (- (framples cursnd curchn) 200))))
+ (scale-channel .5 beg (+ 10 (random 100)) cursnd curchn)
+ (scale-channel .5 (+ beg 10) (+ 10 (random 100)) cursnd curchn)))
- (let ((ind-ptree (new-sound "test1.snd"))
- (ind-closure (new-sound "test2.snd"))
- (ind-map (new-sound "test3.snd")))
- (for-each
- (lambda (m)
- (insert-silence 0 9 m 0)
- (map-channel (lambda (y) 1.0) 0 #f m 0))
- (list ind-ptree ind-closure ind-map))
- (for-each
- (lambda (pt cl mp vc name)
- (let ((edpt (edit-position ind-ptree 0))
- (edcl (edit-position ind-closure 0))
- (edmp (edit-position ind-map 0)))
- (pt ind-ptree)
- (cl ind-closure)
- (mp ind-map)
- (let ((ptv (channel->vct 0 (frames ind-ptree) ind-ptree 0))
- (ptc (channel->vct 0 (frames ind-closure) ind-closure 0))
- (ptm (channel->vct 0 (frames ind-map) ind-map 0)))
- (if (not (vequal ptv vc)) (snd-display #__line__ ";~A ptree: ~A ~A" name ptv vc))
- (if (not (vequal ptc vc)) (snd-display #__line__ ";~A closure: ~A ~A" name ptc vc))
- (if (not (vequal ptm vc)) (snd-display #__line__ ";~A map: ~A ~A" name ptm vc)))
-
- (let ((ptv (reversed-read ind-ptree 0))
- (ptc (reversed-read ind-closure 0))
- (ptm (reversed-read ind-map 0)))
- (if (not (vequal ptv vc)) (snd-display #__line__ ";reversed ~A ptree: ~A ~A" name ptv vc))
- (if (not (vequal ptc vc)) (snd-display #__line__ ";reversed ~A closure: ~A ~A" name ptc vc))
- (if (not (vequal ptm vc)) (snd-display #__line__ ";reversed ~A map: ~A ~A" name ptm vc)))
-
- (let ((ptv (zigzag-read ind-ptree 0))
- (ptc (zigzag-read ind-closure 0))
- (ptm (zigzag-read ind-map 0)))
- (if (not (vequal ptv vc)) (snd-display #__line__ ";zigzag ~A ptree: ~A ~A" name ptv vc))
- (if (not (vequal ptc vc)) (snd-display #__line__ ";zigzag ~A closure: ~A ~A" name ptc vc))
- (if (not (vequal ptm vc)) (snd-display #__line__ ";zigzag ~A map: ~A ~A" name ptm vc)))
-
- (set! (edit-position ind-ptree 0) edpt)
- (set! (edit-position ind-closure 0) edcl)
- (set! (edit-position ind-map 0) edmp)))
-
- (list
- (lambda (ind)
- (ptree-channel (lambda (y) 1.0) 0 #f ind 0 #f #f))
- (lambda (ind)
- (scale-by 0.5 ind 0)
- (ptree-channel (lambda (y3) y3) 0 #f ind 0 #f #f))
- (lambda (ind)
- (ptree-channel (lambda (y4) y4) 0 #f ind 0 #f #f)
- (scale-by 0.5 ind 0))
- (lambda (ind)
- (ptree-channel (lambda (y) (* y 0.5)) 0 #f ind 0 #f #f)
- (delete-samples 2 3 ind 0))
- (lambda (ind)
- (ptree-channel (lambda (y) (* y 0.5)) 0 #f ind 0 #f #f)
- (set! (samples 2 3 ind 0) (make-vct 3)))
- (lambda (ind)
- (set! (samples 0 10 ind 0) (vct 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
- (ptree-channel (lambda (y) (* y 0.5)) 0 #f ind 0 #f #f)
- (delete-sample 2 ind 0)
- (delete-sample 6 ind 0))
-
- (lambda (ind)
- (ptree-channel (lambda (y) 1.0) 2 #f ind 0 #f #f))
- (lambda (ind)
- (scale-by 0.5 ind 0)
- (ptree-channel (lambda (y5) y5) 2 #f ind 0 #f #f))
- (lambda (ind)
- (ptree-channel (lambda (y6) y6) 2 #f ind 0 #f #f)
- (scale-by 0.5 ind 0))
- (lambda (ind)
- (ptree-channel (lambda (y) (* y 0.5)) 2 #f ind 0 #f #f)
- (delete-samples 2 3 ind 0))
- (lambda (ind)
- (ptree-channel (lambda (y) (* y 0.5)) 2 #f ind 0 #f #f)
- (set! (samples 2 3 ind 0) (make-vct 3)))
- (lambda (ind)
- (set! (samples 0 10 ind 0) (vct 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
- (ptree-channel (lambda (y) (* y 0.5)) 2 #f ind 0 #f #f)
- (delete-sample 2 ind 0)
- (delete-sample 6 ind 0))
-
- (lambda (ind)
- ;; forced-fallback
- (ptree-channel (let ((sym (list 1))) (lambda (y) (if (eq? (car sym) 1) (* y 0.5) y))) 2 3 ind 0 #f #f))
- (lambda (ind)
- ;; forced-fallback
- (ptree-channel (let ((sym (list 1))) (lambda (y) (if (eq? (car sym) 1) (* y 0.5) y))) 0 #f ind 0 #f #f))
-
- (lambda (ind)
- (scale-by 0.0)
- (ptree-channel (lambda (y7) y7) 0 #f ind 0 2 #f)
- (scale-by 0.5 ind 0))
-
- )
-
- (list
- (lambda (ind)
- (ptree-channel (lambda (y data dir)
- 1.0)
- 0 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.0))))
- (lambda (ind)
- (scale-by 0.5 ind 0)
- (ptree-channel (lambda (y data dir)
- y)
- 0 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.0))))
- (lambda (ind)
- (ptree-channel (lambda (y data dir)
- y)
- 0 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.0)))
- (scale-by 0.5 ind 0) )
- (lambda (ind)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.5)))
- (delete-samples 2 3 ind 0))
- (lambda (ind)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.5)))
- (set! (samples 2 3 ind 0) (make-vct 3)))
- (lambda (ind)
- (set! (samples 0 10 ind 0) (vct 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.5)))
- (delete-sample 2 ind 0)
- (delete-sample 6 ind 0))
-
- (lambda (ind)
- (ptree-channel (lambda (y data dir)
- 1.0)
- 2 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.0))))
- (lambda (ind)
- (scale-by 0.5 ind 0)
- (ptree-channel (lambda (y data dir)
- y)
- 2 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.0))))
- (lambda (ind)
- (ptree-channel (lambda (y data dir)
- y)
- 2 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.0)))
- (scale-by 0.5 ind 0) )
- (lambda (ind)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 2 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.5)))
- (delete-samples 2 3 ind 0))
- (lambda (ind)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 2 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.5)))
- (set! (samples 2 3 ind 0) (make-vct 3)))
- (lambda (ind)
- (set! (samples 0 10 ind 0) (vct 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 2 #f ind 0 #f #f
- (lambda (pos dur) (vct 0.5)))
- (delete-sample 2 ind 0)
- (delete-sample 6 ind 0))
-
- (lambda (ind)
- ;; forced-fallback
- (ptree-channel (let ((sym (list 1)))
- (lambda (y data dir)
- (if (eq? (car sym) 1) (* y 0.5) (* y (vct-ref data 0)))))
- 2 3 ind 0 #f #f
- (lambda (pos dur)
- (vct 1.0))))
- (lambda (ind)
- ;; forced-fallback
- (ptree-channel (let ((sym (list 1)))
- (lambda (y data dir)
- (if (eq? (car sym) 1) (* y 0.5) (* y (vct-ref data 0)))))
- 0 #f ind 0 #f #f
- (lambda (pos dur)
- (vct 1.0))))
- (lambda (ind)
- (scale-by 0.0)
- (ptree-channel (lambda (y data dir)
- y)
- 0 #f ind 0 2 #f
- (lambda (pos dur) (vct 0.0)))
- (scale-by 0.5 ind 0) )
-
- )
-
- (list
- (lambda (ind)
- (map-channel (lambda (y) 1.0) 0 #f ind 0))
- (lambda (ind)
- (scale-by 0.5 ind 0)
- (map-channel (lambda (y8) y8) 0 #f ind 0))
- (lambda (ind)
- (map-channel (lambda (y9) y9) 0 #f ind 0)
- (scale-by 0.5 ind 0))
- (lambda (ind)
- (map-channel (lambda (y) (* y 0.5)) 0 #f ind 0)
- (delete-samples 2 3 ind 0))
- (lambda (ind)
- (map-channel (lambda (y) (* y 0.5)) 0 #f ind 0)
- (set! (samples 2 3 ind 0) (make-vct 3)))
- (lambda (ind)
- (set! (samples 0 10 ind 0) (vct 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
- (map-channel (lambda (y) (* y 0.5)) 0 #f ind 0)
- (delete-sample 2 ind 0)
- (delete-sample 6 ind 0))
-
- (lambda (ind)
- (map-channel (lambda (y) 1.0) 2 #f ind 0))
- (lambda (ind)
- (scale-by 0.5 ind 0)
- (map-channel (lambda (y10) y10) 2 #f ind 0))
- (lambda (ind)
- (map-channel (lambda (y11a) y11a) 2 #f ind 0)
- (scale-by 0.5 ind 0))
- (lambda (ind)
- (map-channel (lambda (y) (* y 0.5)) 2 #f ind 0)
- (delete-samples 2 3 ind 0))
- (lambda (ind)
- (map-channel (lambda (y) (* y 0.5)) 2 #f ind 0)
- (set! (samples 2 3 ind 0) (make-vct 3)))
- (lambda (ind)
- (set! (samples 0 10 ind 0) (vct 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
- (map-channel (lambda (y) (* y 0.5)) 2 #f ind 0)
- (delete-sample 2 ind 0)
- (delete-sample 6 ind 0))
-
- (lambda (ind)
- ;; forced-fallback
- (map-channel (let ((sym (list 1))) (lambda (y) (if (eq? (car sym) 1) (* y 0.5) y))) 2 3 ind 0))
- (lambda (ind)
- ;; forced-fallback
- (map-channel (let ((sym (list 1))) (lambda (y) (if (eq? (car sym) 1) (* y 0.5) y))) 0 #f ind 0))
- (lambda (ind)
- (scale-by 0.0)
- (map-channel (lambda (y12a) y12a) 0 #f ind 0 2)
- (scale-by 0.5 ind 0))
-
- )
-
- (list
- (make-vct 10 1.0)
- (make-vct 10 0.5)
- (make-vct 10 0.5)
- (make-vct 7 0.5)
- (vct 0.5 0.5 0.0 0.0 0.0 0.5 0.5 0.5 0.5 0.5)
- (vct-scale! (vct 0.0 1.0 3.0 4.0 5.0 6.0 8.0 9.0) 0.5)
-
- (make-vct 10 1.0)
- (make-vct 10 0.5)
- (make-vct 10 0.5)
- (vct 1.0 1.0 0.5 0.5 0.5 0.5 0.5)
- (vct 1.0 1.0 0.0 0.0 0.0 0.5 0.5 0.5 0.5 0.5)
- (vct 0.0 1.0 1.5 2.0 2.5 3.0 4.0 4.5)
-
- (vct 1.0 1.0 0.5 0.5 0.5 1.0 1.0 1.0 1.0 1.0)
- (make-vct 10 0.5)
- (make-vct 10 0.5)
- )
-
- (list
- "identity"
- "half"
- "flah"
- "2:3 delete"
- "2:3 change"
- "step delete"
-
- "2 identity"
- "2 half"
- "2 flah"
- "2 2:3 delete"
- "2 2:3 change"
- "2 step delete"
-
- "fallback 1"
- "fallback 2"
- "edpos"
- )
- )
-
- (for-each
- (lambda (m)
- (close-sound m))
- (list ind-ptree ind-closure ind-map))
- )
+ ((15) (let ((beg (random (- (framples cursnd curchn) 200))))
+ (scale-channel .5 beg (+ 10 (random 100)) cursnd curchn)
+ (scale-channel 2.0 beg (+ 10 (random 100)) cursnd curchn)))
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) (random 1.0)) 0 10)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp" ind 0)
- (undo)
-
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree" ind 0)
- (undo)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (* y 1.5)))
- (zigzag-check "ptree2" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp-ptree2" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp2-ptree2" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp3-ptree2" ind 0)
- (undo 3)
- (xramp-channel 0.0 1.0 32.0)
- (zigzag-check "xramp-ptree2" ind 0)
- (undo 3)
-
- (scale-channel 0.0)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (zigzag-check "ptree-zero" ind 0)
- (undo)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (ptree-channel (lambda (y) (+ y 1.5)))
- (zigzag-check "ptree2-zero" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp-ptree2-zero" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp2-ptree2-zero" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp3-ptree2-zero" ind 0)
- (undo 3)
- (xramp-channel 0.0 1.0 32.0)
- (zigzag-check "xramp-ptree2-zero" ind 0)
- (undo 4)
-
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0)
- (zigzag-check "ramp2" ind 0)
- (undo 2)
- (xramp-channel 0.0 1.0 3.0)
- (xramp-channel 1.0 0.0 0.3)
- (zigzag-check "xramp2" ind 0)
- (undo 2)
- (xramp-channel 0.0 1.0 3.0)
- (xramp-channel 1.0 0.0 0.3)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp+xramp2" ind 0)
- (undo 3)
- (ramp-channel 0.0 1.0)
- (xramp-channel 1.0 0.0 0.3)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp+xramp+ramp" ind 0)
- (undo 3)
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0)
- (ramp-channel 0.1 0.8)
- (zigzag-check "ramp3" ind 0)
- (undo 3)
- (xramp-channel 0.0 1.0 32.0)
- (zigzag-check "xramp" ind 0)
- (undo)
- (scale-channel 0.5)
- (set! (sample 4) .5)
- (delete-sample 2)
- (insert-sample 1 .1)
- (zigzag-check "simple" ind 0)
- (undo 4)
- (ramp-channel 0.0 1.0)
- (xramp-channel 1.0 0.0 32.0)
- (zigzag-check "xramp+ramp" ind 0)
- (undo 2)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 1.0 0.0)
- (zigzag-check "ramp+xramp" ind 0)
- (undo 2)
- (xramp-channel 0.0 1.0 32.0)
- (ramp-channel 1.0 0.0)
- (ramp-channel 1.0 0.0)
- (zigzag-check "ramp2+xramp" ind 0)
- (undo 3)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree+ramp" ind 0)
- (undo 2)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree+ramp2" ind 0)
- (undo 3)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (+ y 0.5)))
- (zigzag-check "ptree+ramp3" ind 0)
- (undo 4)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree+xramp+ramp" ind 0)
- (undo 1)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree+ramp+xramp+ramp" ind 0)
- (undo 4)
-
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp+ptree+ramp" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp2+ptree+ramp" ind 0)
- (undo 2)
- (xramp-channel 0.0 1.0 .3)
- (zigzag-check "xramp+ptree+ramp" ind 0)
- (undo 3)
- (xramp-channel 0.0 1.0 .3)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp+ptree+xramp" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp2+ptree+xramp" ind 0)
- (undo 4)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp+ptree+ramp2" ind 0)
- (undo 4)
-
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f
- (lambda (pos dur)
- (vct 0.5)))
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp+ptreec+ramp" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp2+ptreec+ramp" ind 0)
- (undo 2)
- (xramp-channel 0.0 1.0 .3)
- (zigzag-check "xramp+ptreec+ramp" ind 0)
- (undo 3)
- (xramp-channel 0.0 1.0 .3)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f
- (lambda (pos dur)
- (vct 0.5)))
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp+ptreec+xramp" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp2+ptreec+xramp" ind 0)
- (undo 4)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f
- (lambda (pos dur)
- (vct 0.5)))
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp+ptreec+ramp2" ind 0)
- (undo 4)
-
- (pad-channel 2 3)
- (zigzag-check "zero" ind 0)
- (undo)
- (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f
- (lambda (pos dur)
- (vct 0.5)))
- (zigzag-check "ptree+closure" ind 0)
- (undo)
- (ramp-channel 0.0 1.0)
- (cosine-channel-via-ptree 0 (frames) ind 0 #f)
- (zigzag-check "ptree+ramp" ind 0)
- (undo 2)
- (xramp-channel 0.0 1.0 .3)
- (cosine-channel-via-ptree 0 (frames) ind 0 #f)
- (zigzag-check "ptree+xramp" ind 0)
- (undo 2)
- (ramp-channel 0.0 1.0)
- (ramp-channel 1.0 0.0)
- (cosine-channel-via-ptree 0 (frames) ind 0 #f)
- (zigzag-check "ptree+ramp2" ind 0)
- (undo 3)
- (cosine-channel-via-ptree 0 (frames) ind 0 #f)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree+ptreec" ind 0)
- (undo 2)
- (scale-channel 0.0 3 4)
- (cosine-channel-via-ptree 0 (frames) ind 0 #f)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree+ptreec+zero" ind 0)
- (undo 3)
-
- ;; zero checks
- (scale-channel 0.0 3 4)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree+zero" ind 0)
- (undo 2)
- (scale-channel 0.0 3 4)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y .1)))
- (zigzag-check "ptree2+zero" ind 0)
- (undo 3)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (+ y .1)))
- (zigzag-check "ptree2+ramp" ind 0)
- (undo 3)
- (pad-channel 2 4)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree+pad" ind 0)
- (undo 2)
- (scale-channel 0.0 3 4)
- (cosine-channel-via-ptree 0 (frames) ind 0 #f)
- (zigzag-check "ptree+closure+zero" ind 0)
- (undo 2)
- (ramp-channel 0.0 1.0)
- (scale-channel 0.0 2 4)
- (cosine-channel-via-ptree 0 (frames) ind 0 #f)
- (zigzag-check "ptree+ramp+zero" ind 0)
- (undo 3)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.25)))
- (zigzag-check "ptree+ramp+ptree" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ptree+ramp+ptree+ramp" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ptree+ramp+ptree+ramp2" ind 0)
- (undo 3)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.25)))
- (zigzag-check "ptree+ramp2+ptree" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ptree+ramp2+ptree+ramp" ind 0)
- (undo 2)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.25)))
- (zigzag-check "ptree+ramp3+ptree" ind 0)
- (undo 5)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.25)))
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree2+ramp2" ind 0)
- (undo 4)
- (xramp-channel 0.0 1.0 32)
- (ptree-channel (lambda (y) (* y 0.25)))
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "ptree2+xramp" ind 0)
- (undo)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "ramp2+ptree+xramp" ind 0)
- (undo 4)
- (xramp-channel 0.0 1.0 32)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.25)))
- (zigzag-check "prx" ind 0)
- (undo 3)
- (scale-channel 0.0)
- (ptree-channel (lambda (y) (* y 0.25)))
- (xramp-channel 0.0 1.0 32)
- (ramp-channel 0.0 1.0)
- (zigzag-check "rxpz" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "r2xpz" ind 0)
- (undo 3)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32)
- (zigzag-check "xrpz" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "rxrpz" ind 0)
- (undo 5)
- (ptree-channel (lambda (y) (* y 0.25)))
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32)
- (ramp-channel 0.0 1.0)
- (zigzag-check "rxrp" ind 0)
- (undo 4)
- (ptree-channel (lambda (y) (* y 0.25)))
- (xramp-channel 0.0 1.0 32)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "r2xp" ind 0)
- (undo 4)
- (scale-channel 0.0)
- (ptree-channel (lambda (y) (* y 0.25)))
- (xramp-channel 0.0 1.0 32)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "pxpz" ind 0)
- (undo 2)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "prpz" ind 0)
- (undo)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "pr2pz" ind 0)
- (undo)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "pr3pz" ind 0)
- (undo 6)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "p2r3" ind 0)
- (undo 4)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "prpr" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "rprpr" ind 0)
- (undo 2)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "pr2pr" ind 0)
- (undo 4)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "prpr2" ind 0)
- (undo 5)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "prpr" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check "rprpr" ind 0)
- (undo 5)
- (xramp-channel 0.0 1.0 32)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "pr2x" ind 0)
- (undo 4)
- (xramp-channel 0.0 1.0 32)
- (xramp-channel 0.0 1.0 32)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "px2" ind 0)
- (undo 3)
- (ptree-channel (lambda (y) (* y 0.5)))
- (xramp-channel 0.0 1.0 32)
- (ramp-channel 0.0 1.0)
- (zigzag-check "rxp" ind 0)
- (undo 2)
- (ramp-channel 0.0 1.0)
- (xramp-channel 0.0 1.0 32)
- (zigzag-check "xrp" ind 0)
- (undo 2)
- (xramp-channel 0.0 1.0 32)
- (ptree-channel (lambda (y) (* y 0.5)))
- (zigzag-check "pxp" ind 0)
- (undo 3)
-
- ;; ramp[n]-ptree[c][zero] or xen checks
- (revert-sound ind)
- (map-chan (lambda (y) (random 1.0)) 0 10)
- (for-each
- (lambda (func name twice)
- (func)
- (zigzag-check "first" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check name ind 0)
- (undo 2)
- (scale-channel 0.0)
- (func)
- (zigzag-check "first-zero" ind 0)
- (ramp-channel 0.0 1.0)
- (zigzag-check (string-append name "-zero") ind 0)
- (undo 3)
- (func)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (zigzag-check (string-append name "2") ind 0)
- (undo 3)
- (scale-channel 0.0)
- (func)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (zigzag-check (string-append name "2-zero") ind 0)
- (undo 4)
- (func)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (zigzag-check (string-append name "3") ind 0)
- (undo 4)
- (scale-channel 0.0)
- (func)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (zigzag-check (string-append name "4-zero") ind 0)
- (undo 5)
- (func)
- (xramp-channel 0.0 1.0 32.0)
- (zigzag-check (string-append name "x1") ind 0)
- (if twice
- (begin
- (xramp-channel 0.0 1.0 32.0)
- (zigzag-check (string-append name "x2") ind 0)
- (undo 1)))
- (undo 2)
- (scale-channel 0.0)
- (func)
- (xramp-channel 0.0 1.0 32)
- (zigzag-check (string-append name "x1-zero") ind 0)
- (if twice
- (begin
- (xramp-channel 0.0 1.0 32.0)
- (zigzag-check (string-append name "x2-zero") ind 0)
- (undo 1)))
- (undo 3)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (func)
- (zigzag-check (string-append name "-r3") ind 0)
- (undo 4))
- (list (lambda () (ptree-channel (lambda (y) (+ y 0.5))))
- (lambda () (ptree-channel (lambda (y data forward)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f
- (lambda (pos dur)
- (vct 0.5))))
- )
- (list "ramp-ptree" "ramp-ptreec")
- (list #t #t))
- (close-sound ind))
+ ((16) (let ((beg (random (- (framples cursnd curchn) 200))))
+ (pad-channel beg (+ 10 (random 100)) cursnd curchn)
+ (pad-channel (+ beg 10) (+ 10 (random 100)) cursnd curchn)))
- (let ((ind (new-sound "test.snd")))
- (insert-silence 0 100)
- (map-chan (lambda (y) 1.0))
- (cosine-channel-via-ptree)
- (delete-sample 10)
- (set! (sample 20) .5)
- (insert-silence 30 1)
- (if (or (fneq (sample 12) .393)
- (fneq (sample 0) 0.0)
- (fneq (sample 25) .723)
- (fneq (sample 30) 0.0)
- (fneq (sample 20) 0.5)
- (fneq (sample 21) .632)
- (fneq (sample 31) .822)
- (fneq (sample 50) 1.0))
- (snd-display #__line__ ";cosine-chan with edits: ~A"
- (map sample (list 12 0 25 30 20 21 31 50))))
- (close-sound ind))
+ ((17) (let ((beg (random (- (framples cursnd curchn) 200))))
+ (pad-channel beg (+ 10 (random 100)) cursnd curchn)
+ (pad-channel beg (+ 10 (random 100)) cursnd curchn)))
- (let ((ind (open-sound "oboe.snd")))
- (scale-by 0.0)
- (ptree-channel (lambda (y) (+ y .1)))
- (set! (sample 100) .05)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";scale+ptree+set -> ~A" mx)))
- (if (and (> (optimization) 0)
- (not (string=? (display-edits) (string-append "
-EDITS: 3
-
- (begin) [0:2]:
- (at 0, cp->sounds[0][0:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (scale 0 50828) ; scale-channel 0.000 0 #f [1:2]:
- (at 0, cp->sounds[0][0:50827, 0.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (ptree[0] 0 50828) ; ptree-channel [2:2]:
- (at 0, cp->sounds[0][0:50827, 1.000, loc: 0, pos: 0, scl: 0.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (set 100 1) ; set-sample 100 0.0500 [3:4]:
- (at 0, cp->sounds[0][0:99, 1.000, loc: 0, pos: 0, scl: 0.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
- (at 100, cp->sounds[1][0:0, 1.000]) [buf: 1]
- (at 101, cp->sounds[0][101:50827, 1.000, loc: 0, pos: 101, scl: 0.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-"))))
- (snd-display #__line__ ";ptree split: ~A" (display-edits)))
- (undo)
- (delete-sample 100)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";scale+ptree+delete -> ~A" mx)))
- (undo)
- (insert-samples 100 3 (make-vct 3 .01))
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";scale+ptree+insert -> ~A" mx)))
- (undo)
- (mix-vct (make-vct 3 .01) 100)
- (let ((mx (maxamp)))
- (if (fneq mx .11)
- (snd-display #__line__ ";scale+ptree+mix -> ~A" mx)))
- (undo)
- (ptree-channel (lambda (y) .01) 100 100)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";scale+ptree+ptree -> ~A" mx)))
- (undo)
- (env-channel '(0 0 1 1) 100 100)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";scale+ptree+env -> ~A" mx)))
- (revert-sound)
- (scale-by 0.01)
- (ptree-channel (lambda (y) .1))
- (set! (sample 100) .05)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(1)scale+ptree+set -> ~A" mx)))
- (undo)
- (delete-sample 100)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(1)scale+ptree+delete -> ~A" mx)))
- (undo)
- (insert-samples 100 3 (make-vct 3 .01))
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(1)scale+ptree+insert -> ~A" mx)))
- (undo)
- (mix-vct (make-vct 3 .01) 100)
- (let ((mx (maxamp)))
- (if (fneq mx .11)
- (snd-display #__line__ ";(1)scale+ptree+mix -> ~A" mx)))
- (revert-sound)
- (ptree-channel (lambda (y) .1))
- (set! (sample 100) .05)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(2)scale+ptree+set -> ~A" mx)))
- (undo)
- (delete-sample 100)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(2)scale+ptree+delete -> ~A" mx)))
- (undo)
- (insert-samples 100 3 (make-vct 3 .01))
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(2)scale+ptree+insert -> ~A" mx)))
- (undo)
- (mix-vct (make-vct 3 .01) 100)
- (let ((mx (maxamp)))
- (if (fneq mx .11)
- (snd-display #__line__ ";(2)scale+ptree+mix -> ~A" mx)))
- (revert-sound)
- (env-sound '(0 0 1 .01 2 0))
- (ptree-channel (lambda (y) .1))
- (set! (sample 100) .05)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(3)env+ptree+set -> ~A" mx)))
- (undo)
- (delete-sample 100)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(3)env+ptree+delete -> ~A" mx)))
- (undo)
- (insert-samples 100 3 (make-vct 3 .01))
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(3)env+ptree+insert -> ~A" mx)))
- (undo)
- (mix-vct (make-vct 3 .01) 100)
- (let ((mx (maxamp)))
- (if (fneq mx .11)
- (snd-display #__line__ ";(3)env+ptree+mix -> ~A" mx)))
- (revert-sound)
-
- (env-sound '(0 0 1 .679 2 0))
- (set! (sample 100) .05)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(1)env+set -> ~A" mx)))
- (undo)
- (delete-sample 100)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(1)env+delete -> ~A" mx)))
- (undo)
- (insert-samples 100 3 (make-vct 3 .01))
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(1)env+insert -> ~A" mx)))
- (undo)
- (mix-vct (make-vct 3 .01) 100)
- (let ((mx (maxamp)))
- (if (fneq mx .1)
- (snd-display #__line__ ";(1)env+mix -> ~A" mx)))
- (revert-sound)
-
- (close-sound ind))
+ ((18) (let ((beg (random (- (framples cursnd curchn) 200))))
+ (delete-sample beg cursnd curchn)
+ (delete-sample (+ beg (random 100)) cursnd curchn)))
- (let ((ind (new-sound "test.snd")))
- (map-chan (lambda (y) 1.0) 0 100)
- (ramp-channel 0.0 1.0)
- (smooth-channel 0 99)
- (let ((orig-data (channel->vct)))
- (undo)
- (smooth-channel-via-ptree 0 99)
- (let ((diff (vct-peak (vct-subtract! orig-data (channel->vct)))))
- (if (> diff .00001)
- (snd-display #__line__ ";smooth-channel-via-ptree diff: ~A" diff))))
- (close-sound ind))
+ ((19) (let ((beg (random (+ (framples cursnd curchn) 200))))
+ (set! (sample beg cursnd curchn) .1)
+ (set! (sample (+ beg (random 100)) cursnd curchn) .2)))
- (set! (x-axis-style) x-axis-in-beats)
- (let ((ind (open-sound "storm.snd")))
- (reverse-channel 500000 1000000)
- (set! (sample 0 ind 0 current-edit-position) .1)
- (if (fneq (sample 0 ind 0 current-edit-position) .1)
- (snd-display #__line__ ";set sample + edpos: ~A" (sample 0 ind 0 current-edit-position)))
- (close-sound ind))
- (set! (x-axis-style) x-axis-in-seconds)
+ ((20) (let ((beg (random (- (framples cursnd curchn) 200))))
+ (ramp-channel (- (random 2.0) 1.0) (- (random 2.0) 1.0) beg (+ 10 (random 100)) cursnd curchn)))
- (for-each
- (lambda (out-chans)
- (let ((ind (new-sound "new.snd" mus-next mus-bfloat 22050 out-chans "edpos testing"))
- (mx (apply max (map sync (sounds)))))
- (set! (sync ind) (+ mx 1))
- (for-each
- (lambda (in-sound)
- (for-each
- (lambda (func)
- (for-each
- (lambda (edpos)
- (func edpos)
- (revert-sound ind))
- (list (lambda () current-edit-position)
- (lambda () 0)
- (lambda () (lambda (s c) (- (edit-position s c) 1)))
- (lambda () (lambda (s c) (edit-position s c)))
- (lambda () (lambda (s c) current-edit-position))
- (lambda () (lambda (s c) 0)))))
- (list
- (lambda (posfunc)
- (let ((chn (min (random (+ 1 out-chans)) (- out-chans 1))))
- (if (not (vequal (channel->vct 0 (frames ind chn) ind chn 0) (vct 0.0)))
- (snd-display #__line__ ";start bad: ~A" (channel->vct 0 (frames ind chn) ind chn 0)))
- (set! (sample 0 ind chn) .1)
- (if (not (vequal (channel->vct 0 (frames ind chn) ind chn) (vct 0.1)))
- (snd-display #__line__ ";set bad: ~A" (channel->vct 0 (frames ind chn) ind chn)))
- (pad-channel 0 1 ind chn (posfunc))
- (let ((pos (posfunc))) (if (procedure? pos)
- (set! pos (pos ind chn)))
- (let ((data (channel->vct 0 (frames ind chn) ind chn)))
- (if (or (and (= pos 0)
- (not (vequal data (vct 0.0 0.0))))
- (and (or (= pos current-edit-position)
- (= pos (edit-position ind chn)))
- (not (vequal data (vct 0.0 0.1))))
- (and (= pos (- (edit-position ind chn) 1))
- (not (vequal data (vct 0.0 0.0)))))
- (snd-display #__line__ ";pos[~A]: edpos ~A of ~A, pad result[~A, ~A]: ~A"
- chn pos (edit-position ind chn) (frames ind chn pos) (frames ind chn) data))
- (if (> (chans ind) 1)
- (do ((i 0 (+ 1 i)))
- ((= i (chans ind)))
- (if (not (= i chn))
- (let ((data (channel->vct 0 (frames ind i) ind i)))
- (if (not (vequal data (vct 0.0)))
- (snd-display #__line__ ";pad[~A / ~A] empty: ~A" i chn data))))))))))
- (lambda (posfunc)
- (let ((chn (min (random (+ 1 out-chans)) (- out-chans 1))))
- (set! (sample 0 ind chn) .1)
- (set! (sample 0 ind chn (posfunc)) (* 2 (sample 0 ind chn (posfunc)))) ; not scale since it checks for zeros
- (let ((pos (posfunc)))
- (if (procedure? pos) (set! pos (pos ind chn)))
- (let ((data (channel->vct 0 (frames ind chn) ind chn)))
- (if (or (and (= pos 0)
- (not (vequal data (vct 0.0))))
- (and (or (= pos current-edit-position)
- (= pos (edit-position ind chn)))
- (not (vequal data (vct 0.2))))
- (and (= pos (- (edit-position ind chn) 1))
- (not (vequal data (vct 0.0)))))
- (snd-display #__line__ ";pos[~A]: edpos ~A of ~A, set *2 result[~A, ~A]: ~A"
- chn pos (edit-position ind chn) (frames ind chn pos) (frames ind chn) data))
- (if (> (chans ind) 1)
- (do ((i 0 (+ 1 i)))
- ((= i (chans ind)))
- (if (not (= i chn))
- (let ((data (channel->vct 0 (frames ind i) ind i)))
- (if (not (vequal data (vct 0.0)))
- (snd-display #__line__ ";scale[~A / ~A] empty: ~A" i chn data)))))))))))))
- (list "2a.snd" "1a.snd" "4a.snd"))
- (close-sound ind)))
- (list 1 2 4))
+ ((12) (let* ((pts (+ 1 (random 8)))
+ (e (let ((e1 ())
+ (x 0.0)
+ (y 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i pts))
+ (set! e1 (cons x e1))
+ (if (> (random 3) 0)
+ (set! y (mus-random 1.0)))
+ (set! e1 (cons y e1))
+ (set! x (+ x .01 (random 1.0))))
+ (reverse e1)))
+ (beg (random (- (framples cursnd curchn) 300)))
+ (dur (+ 80 (random 200)))
+ (reader0 (make-sampler beg cursnd curchn)))
+ (env-channel e beg dur cursnd curchn)
+ (let ((reader1 (make-sampler beg cursnd curchn))
+ (en (make-env e :length dur)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (let* ((e0 (env en))
+ (val00 (reader0))
+ (val0 (* e0 val00))
+ (val1 (reader1)))
+ (if (> (abs (- val0 val1)) .005)
+ (begin
+ (if (file-exists? "baddy.scm") (delete-file "baddy.scm"))
+ (save-state "baddy.scm")
+ (snd-display #__line__ ";read env off by ~A: ~% (~A) at ~A: ~% ~A ~A (~A ~A) [~A ~A]:~% ~A"
+ (abs (- val0 val1))
+ e i val0 val1
+ reader0 reader1 e0 val00
+ (safe-display-edits cursnd curchn))
+ (error 'mus-error))))))))
- (let ((ind (open-sound "oboe.snd")))
- (map-channel (lambda (y) #f))
- (if (not (= (frames ind) 0)) (snd-display #__line__ ";map-channel #f frames: ~A" (frames ind)))
- (if (equal? (edits ind) (list 0 0)) (snd-display #__line__ ";map-channel #f edits backed up"))
- (undo 1 ind)
- (if (= (frames ind) 0) (snd-display #__line__ ";map-channel #f frames after undo: ~A" (frames ind)))
- (let ((tag (catch #t (lambda () (map-channel (lambda (y) "hiho"))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-type)) (snd-display #__line__ ";map-channel bad-type: ~A" tag)))
- (let* ((ctr 0)
- (tag (catch #t (lambda () (scan-channel (lambda (y) (set! ctr (+ 1 ctr)) (asdf)))) (lambda args (car args)))))
- (if (not (= ctr 1)) (snd-display #__line__ ";scan-channel error exit: ~A" ctr))
- (if (and (not (eq? tag 'unbound-variable))
- (not (eq? tag 'syntax-error))
- (not (eq? tag 'error)))
- (snd-display #__line__ ";scan-channel unbound: ~A" tag)))
- (let ((val (scan-channel (lambda (y) #f)))) (if val (snd-display #__line__ ";scan-channel func #f: ~A" val)))
- (let ((val (scan-channel (lambda (y) #f) 1234))) (if val (snd-display #__line__ ";scan-channel func #f with beg: ~A" val)))
- (let ((val (scan-channel (lambda (y) #f) 1234 4321))) (if val (snd-display #__line__ ";scan-channel func #f with beg+dur: ~A" val)))
- (revert-sound ind)
- (let ((del (make-delay 1000))
- (len (frames)))
- (clm-channel del 0 (frames) ind 0 0 2000)
- (if (not (= (frames ind) (+ 2000 len)))
- (snd-display #__line__ ";clm-channel overlap length: ~A ~A" len (frames)))
- (if (not (equal? (edit-tree) '((0 1 0 52827 1.0 0.0 0.0 0) (52828 -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";clm-channel overlaps: ~A" (edit-tree)))
- (let ((reader (make-sampler 0))
- (preader (make-sampler 0 ind 0 1 0))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 1000)))
- (let ((val (reader)))
- (if (fneq val 0.0)
+ ;; env-channel
+ ((2) (let* ((pts (+ 1 (random 6)))
+ (e (let ((e1 ())
+ (x 0.0)
+ (y 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i pts))
+ (set! e1 (cons x e1))
+ (if (> (random 3) 0)
+ (set! y (mus-random 1.0)))
+ (set! e1 (cons y e1))
+ (set! x (+ x .01 (random 1.0))))
+ (reverse e1))))
+ (if (undo-env cursnd curchn)
+ (begin
+ (set! cur-maxamps (apply map maxamp chan-list))
+ (set! cur-edits (apply map edit-position chan-list))
+ (set! cur-framples (apply map framples chan-list))
+ (set! cur-amp (maxamp cursnd curchn))
+ (set! cur-edit (edit-position cursnd curchn))
+ (set! cur-frame (framples cursnd curchn))))
+ (env-channel e 0 (framples cursnd curchn) cursnd curchn) ; can be a no-op
+ (if (and (not (= (edit-position cursnd curchn) (+ 1 cur-edit)))
+ (not (= (edit-position cursnd curchn) cur-edit)))
+ (snd-display #__line__ ";env-channel ~A[~A] edit pos: ~A ~A" (short-file-name cursnd) curchn (edit-position cursnd curchn) cur-edit))
+ (if (not (= (framples cursnd curchn) cur-frame))
+ (snd-display #__line__ ";env-channel ~A[~A] framples: ~A ~A" (short-file-name cursnd) curchn (framples cursnd curchn) cur-frame))
+ (for-each
+ (lambda (s c amp ed fr)
+ (if (not (and (equal? s cursnd)
+ (= c curchn)))
+ (begin
+ (if (not (= (edit-position s c) ed))
+ (snd-display #__line__ ";env-channel ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display #__line__ ";env-channel ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
+ (if (fneq (maxamp s c) amp)
+ (snd-display #__line__ ";env-channel ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))))
+ (car chan-list)
+ (cadr chan-list)
+ cur-maxamps
+ cur-edits
+ cur-framples)))
+
+ ;; env-sound
+ ((3) (let* ((pts (+ 1 (random 6)))
+ (recalc #f)
+ (e (let ((e1 ())
+ (x 0.0)
+ (y 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i pts))
+ (set! e1 (cons x e1))
+ (if (> (random 3) 0)
+ (set! y (mus-random 1.0)))
+ (set! e1 (cons y e1))
+ (set! x (+ x .01 (random 1.0))))
+ (reverse e1)))
+ (end (apply min cur-framples)) ; env-sound can lengthen a shorter sound if syncd+multichannel
+ (beg (random (floor (/ end 2)))))
+ (for-each
+ (lambda (s c)
+ (if (not (or (and (= (sync cursnd) 0)
+ (or (not (equal? s cursnd))
+ (not (= c curchn))))
+ (not (= (sync s) (sync cursnd)))))
+ (let ((val (undo-env s c)))
+ (set! recalc (or recalc val)))))
+ (car chan-list)
+ (cadr chan-list))
+ (if recalc
+ (begin
+ (set! cur-maxamps (apply map maxamp chan-list))
+ (set! cur-edits (apply map edit-position chan-list))
+ (set! cur-framples (apply map framples chan-list))
+ (set! cur-amp (maxamp cursnd curchn))
+ (set! cur-edit (edit-position cursnd curchn))
+ (set! cur-frame (framples cursnd curchn))))
+ (env-sound e beg (max pts (- end beg)) 1.0 cursnd curchn) ; dur here, not end point
+ (for-each
+ (lambda (s c amp ed fr)
+ (if (or (and (= (sync cursnd) 0)
+ (or (not (equal? s cursnd))
+ (not (= c curchn))))
+ (not (= (sync s) (sync cursnd))))
(begin
- (snd-display #__line__ ";clm-channel overlap delayed: ~A: ~A" i val)
- (set! happy #f)))))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i len)))
- (let ((val0 (preader))
- (val1 (reader)))
- (if (fneq val0 val1)
+ (if (not (= (edit-position s c) ed))
+ (snd-display #__line__ ";env-sound ~A[~A] wrong edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display #__line__ ";env-sound ~A[~A] wrong framples: ~A ~A" (short-file-name s) c (framples s c) fr))
+ (if (fneq (maxamp s c) amp)
+ (snd-display #__line__ ";env-sound ~A[~A] wrong maxamp: ~A ~A" (short-file-name s) c (maxamp s c) amp)))
(begin
- (snd-display #__line__ ";clm-channel overlap main: ~A: ~A ~A" (+ i 1000) val0 val1)
- (set! happy #f)))))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 1000)))
- (if (fneq (reader) 0.0)
- (begin
- (snd-display #__line__ ";clm-channel overlap trailing garbage")
- (set! happy #f))))))
+ (if (and (not (= (edit-position s c) (+ 1 ed)))
+ (not (= (edit-position s c) ed)))
+ (snd-display #__line__ ";env-sound ~A[~A] edit pos: ~A ~A" (short-file-name s) c (edit-position s c) ed))
+ (if (not (= (framples s c) fr))
+ (snd-display #__line__ ";env-sound ~A[~A] framples: ~A ~A" (short-file-name s) c (framples s c) fr)))))
+ (car chan-list)
+ (cadr chan-list)
+ cur-maxamps
+ cur-edits
+ cur-framples)))
+ )))
+
+ (define (amp-envs-equal? snd chn pos0 pos1 df)
+ (let* ((env0 (channel-amp-envs snd chn pos0))
+ (len0 (and env0 (pair? env0) (= (length env0) 2) (length (cadr env0))))
+ (env1 (channel-amp-envs snd chn pos1))
+ (len1 (and env1 (pair? env1) (= (length env1) 2) (length (cadr env1))))
+ (happy #t))
+ (and len0 len1
+ (let* ((minlen (min len0 len1))
+ (minlen1 (- minlen 1))
+ (inc0 (/ len0 minlen))
+ (inc1 (/ len1 minlen))
+ (e0 (cadr env0))
+ (e1 (cadr env1)))
+ (if (and (integer? inc0)
+ (integer? inc1))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy) (= i minlen1))
+ happy)
+ (let ((max0 -1.0)
+ (max1 -1.0))
+ (if (= inc0 1)
+ (set! max0 (e0 i))
+ (do ((j 0 (+ j 1))
+ (j1 (* inc0 i) (+ j1 1)))
+ ((= j inc0))
+ (if (> (e0 j1) max0)
+ (set! max0 (e0 j1)))))
+ (if (= inc1 1)
+ (set! max1 (e1 i))
+ (do ((j 0 (+ j 1))
+ (j1 (* inc1 i) (+ j1 1)))
+ ((= j inc1))
+ (if (> (e1 j1) max1)
+ (set! max1 (e1 j1)))))
+ (if (> (abs (- max0 max1)) df)
+ (begin
+ (snd-display #__line__ ";amp-env ~A: ~A ~A" i max0 max1)
+ (set! happy #f)))))
+ (begin
+ (snd-display #__line__ ";lens: ~A ~A" len0 len1)
+ #f))))))
+
+ (define* (edit-difference s1 c1 e1 e2 (offset 0))
+ (let* ((N (framples s1 c1 e1))
+ (d1 (samples 0 N s1 c1 e1))
+ (d2 (samples 0 N s1 c1 e2)))
+ (float-vector-subtract! d1 d2)
+ (let ((diffs (float-vector-peak-and-location d1)))
+ (and (> (car diffs) 0.0)
+ diffs))))
+
+ (define* (edit-distance s1 c1 e1 e2 (offset 0))
+ (let* ((incr (make-one-pole 1.0 -1.0))
+ (N (framples s1 c1 e1))
+ (d1 (samples 0 N s1 c1 e1))
+ (d2 (samples 0 N s1 c1 e2)))
+ (float-vector-multiply! d1 d1)
+ (float-vector-multiply! d2 d2)
+ (float-vector-subtract! d1 d2)
+ (float-vector-abs! d1)
+ (do ((i 0 (+ i 1)))
+ ((= i N))
+ (one-pole incr (float-vector-ref d1 i)))
+ (sqrt (one-pole incr 0.0))))
+
+
+ (define (check-edit-tree expected-tree expected-vals name line)
+ (define (vequal-at v0 v1)
+ (call-with-exit
+ (lambda (return)
+ (let ((len (length v0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) #f)
+ (if (> (abs (- (v0 i) (v1 i))) .001)
+ (return (list i (v0 i) (v1 i)))))))))
+ (define (edits-not-equal? tl0 tl1 pos)
+ (if (null? tl0)
+ (and (not (null? tl1))
+ (list pos tl0 #f))
+ (let ((t0 (car tl0))
+ (t1 (car tl1)))
+ (if (or (not (= (car t0) (car t1)))
+ (not (= (cadr t0) (cadr t1)))
+ (not (= (caddr t0) (caddr t1)))
+ (not (= (cadddr t0) (cadddr t1)))
+ (> (abs (- (t0 4) (t1 4))) .0001)
+ (> (abs (- (t0 5) (t1 5))) .0001) ; rmp0
+ (> (abs (- (t0 6) (t1 6))) .0001)) ; rmp1
+ (list pos t0 t1)
+ (edits-not-equal? (cdr tl0) (cdr tl1) (+ 1 pos))))))
+ (let* ((current-vals (channel->float-vector))
+ (len (length current-vals)))
+ (if (and expected-vals (not (= len (length expected-vals))))
+ (snd-display #__line__ ";~A (from ~A): lengths differ: ~A ~A" name line len (length expected-vals))
+ (if (and expected-vals (not (vequal current-vals expected-vals)))
+ (let ((bad-data (vequal-at current-vals expected-vals)))
+ (snd-display #__line__ ";checking ~A (from ~A), vals disagree (loc cur expect): ~A" name line bad-data))
+ (let* ((tree (edit-tree))
+ (bad-data (edits-not-equal? tree expected-tree 0)))
+ (if bad-data
+ (snd-display #__line__ ";checking ~A (from ~A), trees disagree (loc cur expect): ~A~% in~%~A" name line bad-data (edit-tree)))
+ (if (> len 5)
+ (let* ((split-loc (+ 2 (random (- len 3))))
+ (fread (make-sampler split-loc))
+ (bread (make-sampler (- split-loc 1) #f #f -1))
+ (split-vals (make-float-vector len)))
+ (do ((i split-loc (+ i 1)))
+ ((= i len))
+ (float-vector-set! split-vals i (read-sample fread)))
+ (do ((i (- split-loc 1) (- i 1)))
+ ((< i 0))
+ (float-vector-set! split-vals i (read-sample bread)))
+ (if (and expected-vals (not (vequal split-vals expected-vals)))
+ (let ((bad-data (vequal-at split-vals expected-vals)))
+ (snd-display #__line__ ";checking ~A (from ~A), split vals disagree (loc cur expect): ~A" name line bad-data)
+ ; (error 'uhoh1)
+ )))))))))
+
+ (define (reversed-read snd chn)
+ (let* ((len (framples snd chn))
+ (data (make-float-vector len))
+ (sf (make-sampler (- len 1) snd chn -1)))
+ (do ((i (- len 1) (- i 1)))
+ ((< i 0))
+ (set! (data i) (read-sample sf)))
+ data))
+
+ (define (zigzag-read snd chn)
+ (let* ((len (framples snd chn))
+ (data (make-float-vector len))
+ (sf (make-sampler 3 snd chn 1)))
+ (do ((i 3 (+ i 1)))
+ ((= i 6))
+ (set! (data i) (next-sample sf)))
+ (do ((i 6 (- i 1)))
+ ((= i 0))
+ (set! (data i) (previous-sample sf)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (data i) (next-sample sf)))
+ data))
+
+ (define (zigzag-check name snd chn)
+ (let ((data (channel->float-vector))
+ (sf (make-sampler 3 snd chn)))
+ (do ((i 3 (+ i 1)))
+ ((= i 8))
+ (let ((val (next-sample sf)))
+ (if (fneq (data i) val)
+ (snd-display #__line__ ";~A: forward data[~D]: ~A ~A" name i val (data i)))))
+ (do ((i 7 (- i 1)))
+ ((= i 0))
+ (let ((val (previous-sample sf)))
+ (if (fneq (data i) val)
+ (snd-display #__line__ ";~A: backward data[~D]: ~A ~A" name i val (data i)))))))
+
+ (define (init-sound val dur chans)
+ (let ((ind (new-sound "test.snd" chans 22050 mus-ldouble mus-next)))
+ (do ((i 0 (+ i 1)))
+ ((= i chans))
+ (insert-silence 0 dur ind i)
+ (map-channel (lambda (y) val) 0 (framples) ind i))
+ ind))
+
+ (define (check-back-and-forth ind name v)
+ (let ((happy #t))
+ (if (not (vequal v (channel->float-vector 0 (framples) ind 0)))
+ (begin
+ (set! happy #f)
+ (snd-display #__line__ ";~A forth:~% current: ~A~% expected: ~A" name (channel->float-vector 0 (framples) ind 0) v)))
+ (if (not (vequal v (reversed-read ind 0)))
+ (begin
+ (set! happy #f)
+ (snd-display #__line__ ";~A back: ~A ~A" name (reversed-read ind 0) v)))
+ happy))
+
+
+ (define (rampx-channel r0 r1)
+ (xramp-channel r0 r1 3.0 0 (framples)))
+
+ (define (check-both-chans ind name f0 f1)
+ (let ((c0 (scan-channel f0 0 (framples) ind 0))
+ (c1 (scan-channel f1 0 (framples) ind 1)))
+ (if c0 (snd-display #__line__ ";~A swap c0: ~A" name c0))
+ (if c1 (snd-display #__line__ ";~A swap c1: ~A" name c1))))
+
+
+ (define (convolve-coeffs v1 v2)
+ (let* ((v1-len (length v1))
+ (v2-len (length v2))
+ (res-len (+ v1-len v2-len -1))
+ (vres (make-float-vector res-len)))
+ (do ((i 0 (+ i 1)))
+ ((= i res-len))
+ (let ((sum 0.0))
+ (do ((j (max 0 (+ 1 (- i v2-len))) (+ j 1)))
+ ((> j (min i (- v1-len 1))))
+ (set! sum (+ sum (* (v1 j)
+ (v2 (- i j))))))
+ (set! (vres i) sum)))
+ vres))
+
+ (do ((test-16 0 (+ 1 test-16)))
+ ((= test-16 tests))
+ (let ((oboe (open-sound "oboe.snd")))
+ (log-mem test-16)
+ (for-each
+ (lambda (func name)
+ (func)
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";dur:0 ~A? ~A ~A" name (edit-position oboe) (edit-fragment))))
+ (list
+ (lambda () (scale-channel 2.0 0 0 oboe))
+ (lambda () (env-channel (make-env '(0 0 1 1) :length 124) 0 0 oboe))
+ (lambda () (clm-channel (make-oscil) 0 0 oboe))
+ (lambda () (float-vector->channel (make-float-vector 3) 0 0 oboe))
+ (lambda () (smooth-channel 0 0 oboe))
+ (lambda () (pad-channel 0 0 oboe))
+ (lambda () (src-channel 2.0 0 0 oboe))
+ (lambda () (mix-channel "pistol.snd" 0 0 oboe))
+ (lambda () (insert-channel "pistol.snd" 0 0 oboe))
+ (lambda () (reverse-channel 0 0 oboe))
+ (lambda () (play oboe :start 0 :end 0))
+ (lambda () (scale-sound-by 2.0 0 0 oboe))
+ (lambda () (env-sound '(0 0 1 1) 0 0 oboe))
+ (lambda () (set-samples 0 0 (make-float-vector 3) oboe))
+ (lambda () (smooth-sound 0 0 oboe))
+ (lambda () (insert-silence 0 0 oboe)))
+ (list
+ "scale-channel" "env-channel" "clm-channel" "float-vector->channel" "smooth-channel" "pad-channel" "src-channel"
+ "mix-channel" "insert-channel" "reverse-channel" "play"
+ "scale-sound-by" "env-sound" "set-samples" "smooth-sound" "insert-silence"))
+
+ (for-each
+ (lambda (func name)
+ (let ((tag (catch #t
+ func
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-sample))
+ (snd-display #__line__ ";~A beg -1->~A" name tag))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";beg:-1 ~A? ~A ~A" name (edit-position oboe) (edit-fragment)))))
+ (list
+ (lambda () (scale-channel 2.0 -1 123 oboe))
+ (lambda () (env-channel (make-env '(0 0 1 1) :length 124) -1 123 oboe))
+ (lambda () (clm-channel (make-oscil) -1 123 oboe))
+ (lambda () (float-vector->channel (make-float-vector 3) -1 123 oboe))
+ (lambda () (smooth-channel -1 123 oboe))
+ (lambda () (pad-channel -1 123 oboe))
+ (lambda () (src-channel 2.0 -1 123 oboe))
+ (lambda () (mix-channel "pistol.snd" -1 123 oboe))
+ (lambda () (insert-channel "pistol.snd" -1 123 oboe))
+ (lambda () (reverse-channel -1 123 oboe))
+ (lambda () (scale-sound-by 2.0 -1 123 oboe))
+ (lambda () (env-sound '(0 0 1 1) -1 123 oboe))
+ (lambda () (set-samples -1 123 (make-float-vector 3) oboe))
+ (lambda () (smooth-sound -1 123 oboe))
+ (lambda () (insert-silence -1 123 oboe)))
+ (list
+ "scale-channel" "env-channel" "clm-channel" "float-vector->channel" "smooth-channel" "pad-channel" "src-channel"
+ "mix-channel" "insert-channel" "reverse-channel"
+ "scale-sound-by" "env-sound" "set-samples" "smooth-sound" "insert-silence"))
+
+ (scale-channel 2.0 12345678 123 oboe)
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";beg:12345678 scale-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (env-channel (make-env '(0 0 1 1) :length 124) 12345678 123 oboe)
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";beg:12345678 env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (smooth-channel 12345678 123 oboe)
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";beg:12345678 smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (src-channel 2.0 12345678 123 oboe)
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";beg:12345678 src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (reverse-channel 12345678 123 oboe)
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";beg:12345678 reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (play oboe :start 12345678 :end (+ 12345678 123))
+
+ (scale-channel 2.0 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 1))
+ (snd-display #__line__ ";oboe scale-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (env-channel (make-env '(0 0 1 1) :length 124) 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 2))
+ (snd-display #__line__ ";oboe env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (clm-channel (make-oscil) 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 3))
+ (snd-display #__line__ ";oboe clm-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (float-vector->channel (make-float-vector 3) 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 4))
+ (snd-display #__line__ ";oboe float-vector->channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (smooth-channel 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 5))
+ (snd-display #__line__ ";oboe smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (pad-channel 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 6))
+ (snd-display #__line__ ";oboe pad-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (src-channel 2.0 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 7))
+ (snd-display #__line__ ";oboe src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (mix-channel "pistol.snd" 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 8))
+ (snd-display #__line__ ";oboe mix-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (insert-channel "pistol.snd" 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 9))
+ (snd-display #__line__ ";oboe insert-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (reverse-channel 0 123 oboe 0)
+ (if (not (= (edit-position oboe) 10))
+ (snd-display #__line__ ";oboe reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (let* ((rd (make-sampler 0))
+ (sr (make-src :srate 2.0 :input (lambda (dir) (read-sample rd)))))
+ (clm-channel sr 0 12345 oboe 0)
+ (if (not (= (edit-position oboe) 11))
+ (snd-display #__line__ ";oboe clm-channel src? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (let* ((rd (make-sampler 0))
+ (sr (make-granulate :expansion 2.0 :input (lambda (dir) (read-sample rd)))))
+ (clm-channel sr 0 12345 oboe 0)
+ (if (not (= (edit-position oboe) 12))
+ (snd-display #__line__ ";oboe clm-channel granulate? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (let* ((rd (make-sampler 0))
+ (flt (float-vector 1.0 0.0 0.0 0.0))
+ (sr (make-convolve :input (lambda (dir) (read-sample rd)) :filter flt)))
+ (clm-channel sr 0 12345 oboe 0)
+ (if (not (= (edit-position oboe) 13))
+ (snd-display #__line__ ";oboe clm-channel convolve? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (let* ((rd (make-sampler 0))
+ (sr (make-phase-vocoder :input (lambda (dir) (read-sample rd)))))
+ (clm-channel sr 0 12345 oboe 0)
+ (if (not (= (edit-position oboe) 14))
+ (snd-display #__line__ ";oboe clm-channel phase-vocoder? ~A ~A" (edit-position oboe) (edit-fragment))))
+ (revert-sound)
+
+ (catch #t (lambda () (env-channel (make-env '(0 0 1 1) :length 124) 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 env-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (catch #t (lambda () (clm-channel (make-oscil) 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 clm-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (catch #t (lambda () (float-vector->channel (make-float-vector 3) 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 float-vector->channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (catch #t (lambda () (smooth-channel 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 smooth-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (catch #t (lambda () (pad-channel 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 pad-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (catch #t (lambda () (src-channel 2.0 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 src-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (catch #t (lambda () (mix-channel "pistol.snd" 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 mix-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (catch #t (lambda () (insert-channel "pistol.snd" 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 insert-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (catch #t (lambda () (reverse-channel 0 123 oboe 0 123)) (lambda args (car args)))
+ (if (not (= (edit-position oboe) 0))
+ (snd-display #__line__ ";edpos 123 reverse-channel? ~A ~A" (edit-position oboe) (edit-fragment)))
+ (revert-sound oboe)
+
+ (let ((oldv (channel->float-vector 1000 10 oboe)))
+ (mix-channel "oboe.snd" 0)
+ (float-vector-scale! oldv 2.0)
+ (if (not (vequal oldv (channel->float-vector 1000 10 oboe)))
+ (snd-display #__line__ ";mix-channel at 0: ~A ~A" oldv (channel->float-vector 1000 10 oboe)))
+ (revert-sound oboe)
+ (float-vector-scale! oldv 0.5)
+ (insert-channel "oboe.snd" 0)
+ (if (not (vequal oldv (channel->float-vector 1000 10 oboe)))
+ (snd-display #__line__ ";insert-channel at 0: ~A ~A" oldv (channel->float-vector 1000 10 oboe)))
+ (if (not (= (framples oboe 0) (* 2 (framples oboe 0 0))))
+ (snd-display #__line__ ";insert-channel framples: ~A ~A" (framples oboe 0) (framples oboe 0 0)))
+ (revert-sound oboe))
+ (close-sound oboe)
+
+ (let ((ind (new-sound "test.snd" :size 10 :channels 2)))
+ (set! (sample 3 ind 0) .5)
+ (set! (sample 2 ind 1) -.4)
+ (save-sound-as "fmv.snd")
+ (revert-sound ind)
+ (let ((val (mix-channel "fmv.snd")))
+ (if (mix? val)
+ (snd-display #__line__ ";mix-channel returned a mix: ~A?" val)))
+ (if (not (vequal (channel->float-vector 0 #f ind 1) (make-float-vector 10 0.0)))
+ (snd-display #__line__ ";mix-channel mixed channel 1: ~A?" (channel->float-vector 0 #f ind 1)))
+ (if (not (vequal (channel->float-vector 0 #f ind 0) (float-vector 0 0 0 .5 0 0 0 0 0 0)))
+ (snd-display #__line__ ";mix-channel chan 0: ~A" (channel->float-vector 0 #f ind 0)))
+ (revert-sound ind)
+ (let ((val (mix-channel (list "fmv.snd" 2 1) 0 #f ind 0)))
+ (if (mix? val)
+ (snd-display #__line__ ";mix-channel 2 returned a mix: ~A?" val)))
+ (if (not (vequal (channel->float-vector 0 #f ind 1) (make-float-vector 10 0.0)))
+ (snd-display #__line__ ";mix-channel mixed channel 1a: ~A?" (channel->float-vector 0 #f ind 1)))
+ (if (not (vequal (channel->float-vector 0 #f ind 0) (float-vector -.4 0 0 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";mix-channel chan 0a: ~A" (channel->float-vector 0 #f ind 0)))
+ (revert-sound ind)
+ (set! (sample 2 ind 1) -.4)
+ (let ((val (mix-channel (list ind 2 1) 0 #f ind 0 -1 #t)))
+ (if (not (mix? val))
+ (snd-display #__line__ ";mix-channel with-tag: ~A" val)))
+ (if (not (vequal (channel->float-vector 0 #f ind 1) (float-vector 0 0 -.4 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";mix-channel mixed channel 1b: ~A?" (channel->float-vector 0 #f ind 1)))
+ (if (not (vequal (channel->float-vector 0 #f ind 0) (float-vector -.4 0 0 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";mix-channel chan 0b: ~A" (channel->float-vector 0 #f ind 0)))
+ (revert-sound ind)
+ (let ((val (car (mix-channel (list "fmv.snd" 2 1) 0 #f ind 0 -1 #t))))
+ (if (not (mix? val))
+ (snd-display #__line__ ";mix-channel file with-tag: ~A" val)))
+ (if (not (vequal (channel->float-vector 0 #f ind 1) (make-float-vector 10 0.0)))
+ (snd-display #__line__ ";mix-channel mixed channel 1c: ~A?" (channel->float-vector 0 #f ind 1)))
+ (if (not (vequal (channel->float-vector 0 #f ind 0) (float-vector -.4 0 0 0 0 0 0 0 0 0)))
+ (snd-display #__line__ ";mix-channel chan 0c: ~A" (channel->float-vector 0 #f ind 0)))
+ (revert-sound ind)
+ (let ((val (car (mix-channel (list "fmv.snd") 0 #f ind 1 -1 #t))))
+ (if (not (mix? val))
+ (snd-display #__line__ ";mix-channel file 1 with-tag: ~A" val)))
+ (if (not (vequal (channel->float-vector 0 #f ind 0) (make-float-vector 10 0.0)))
+ (snd-display #__line__ ";mix-channel mixed channel 0d: ~A?" (channel->float-vector 0 #f ind 1)))
+ (if (not (vequal (channel->float-vector 0 #f ind 1) (float-vector 0 0 0 .5 0 0 0 0 0 0)))
+ (snd-display #__line__ ";mix-channel chan 1d: ~A" (channel->float-vector 0 #f ind 1)))
+ (revert-sound ind)
+ (if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
+ (close-sound ind))
+
+ (if (not (= *default-output-chans* 1)) (set! *default-output-chans* 1))
+ (let ((ind (new-sound "fmv.snd"))
+ (v0 (make-float-vector 20 1.0)))
+ (float-vector->channel v0)
+ (if (not (= (framples) 20)) (snd-display #__line__ ";float-vector->channel new 20: ~A" (framples)))
+ (if (fneq (maxamp) 1.0) (snd-display #__line__ ";float-vector 1->new: ~A" (maxamp)))
+
+ (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 20))
+ (let ((v1 (channel->float-vector)))
+ (if (not (vequal v1 (float-vector 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
+ (snd-display #__line__ ";env-channel step 1: ~A" v1)))
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 20) 8)
+ (let ((v1 (channel->float-vector)))
+ (if (not (vequal v1 (float-vector 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1)))
+ (snd-display #__line__ ";env-channel step 1 at 8: ~A" v1)))
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12))
+ (let ((v1 (channel->float-vector)))
+ (if (not (vequal v1 (float-vector 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))
+ (snd-display #__line__ ";env-channel step 1 at 0: ~A" v1)))
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12) 4)
+ (let ((v1 (channel->float-vector)))
+ (if (not (vequal v1 (float-vector 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1)))
+ (snd-display #__line__ ";env-channel step 1 at 4: ~A" v1)))
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 1) :base 0 :length 12) 4 3)
+ (let ((v1 (channel->float-vector)))
+ (if (not (vequal v1 (float-vector 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)))
+ (snd-display #__line__ ";env-channel step 1 at 4 by 3: ~A" v1)))
+ (undo)
+ (env-channel (make-env '(0 1 1 0 2 0) :base 0 :length 8) 0 12)
+ (let ((v1 (channel->float-vector)))
+ (if (not (vequal v1 (float-vector 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)))
+ (snd-display #__line__ ";env-channel step 1 at 0 for 7: ~A" v1)))
+ (undo)
+ (env-channel (make-env '(0 0 1 1 2 1 3 0 4 0) :base 0 :length 20))
+ (let ((v1 (channel->float-vector)))
+ (if (not (vequal v1 (float-vector 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0)))
+ (snd-display #__line__ ";env-channel step 1: ~A" v1)))
+ (env-channel (make-env '(0 0 1 .5 2 .25 3 0 4 0) :base 0 :length 21))
+ (let ((v1 (channel->float-vector)))
+ (if (not (vequal v1 (float-vector 0 0 0 0 0 0 .5 .5 .5 .5 .5 .25 .25 .25 .25 0 0 0 0 0)))
+ (snd-display #__line__ ";env-channel step 1 (.5): ~A" v1)))
+ (close-sound ind))
+
+ (set! *x-axis-style* x-axis-as-percentage)
+ (let* ((ind (open-sound "2.snd"))
+ (fr (framples))
+ (m0 (maxamp ind 0))
+ (m1 (maxamp ind 1)))
+ (set! (sync ind) 64)
+ (insert-sound "2.snd")
+ (insert-sound "2.snd")
+ (if (not (= (framples) (* 3 fr))) (snd-display #__line__ ";2.snd 3x = ~A ~A" fr (framples)))
+ (if (not (= (framples ind 0) (framples ind 1))) (snd-display #__line__ ";insert sync'd: ~A ~A" (framples ind 0) (framples ind 1)))
+ (swap-channels)
+ (if (or (fneq m0 (maxamp ind 1)) (fneq m1 (maxamp ind 0)))
+ (snd-display #__line__ ";swapped: ~A ~A -> ~A ~A" m0 m1 (maxamp ind 0) (maxamp ind 1)))
+ (close-sound ind))
+ (set! *x-axis-style* x-axis-in-seconds)
+ (let ((new-snd (mono-files->stereo "test.snd" "oboe.snd" "pistol.snd")))
+ (if (not (= (channels new-snd) 2)) (snd-display #__line__ ";mono-files->stereo not stereo? ~A" (channels new-snd)))
+ (if (not (string=? (short-file-name new-snd) "test.snd")) (snd-display #__line__ ";mono-files->stereo filename: ~A" (short-file-name new-snd)))
+ (if (not (= (framples new-snd) 50828)) (snd-display #__line__ ";mono-files->stereo framples: ~A" (framples new-snd)))
+ (close-sound new-snd))
+
+ (let ((oboe0 (open-sound "oboe.snd"))
+ (oboe1 (open-sound "oboe.snd")))
+
+ (define (funcs-equal? name func0 func1)
+ (func0 #f #f oboe0)
+ (func1 #f #f oboe1)
+ (if (not (vequal (channel->float-vector 1000 100 oboe0) (channel->float-vector 1000 100 oboe1)))
+ (snd-display #__line__ ";~A via #f: ~A ~A" name (channel->float-vector 1000 100 oboe0) (channel->float-vector 1000 100 oboe1)))
+ (revert-sound oboe0)
+ (revert-sound oboe1)
+ (select-sound oboe0)
+ (func0)
+ (select-sound oboe1)
+ (func1)
+ (if (not (vequal (channel->float-vector 1000 100 oboe0) (channel->float-vector 1000 100 oboe1)))
+ (snd-display #__line__ ";~A via none: ~A ~A" name (channel->float-vector 1000 100 oboe0) (channel->float-vector 1000 100 oboe1)))
+ (revert-sound oboe0)
+ (revert-sound oboe1)
+ (func0 0 (framples oboe0) oboe0)
+ (func1 0 (framples oboe1) oboe1)
+ (if (not (vequal (channel->float-vector 1000 100 oboe0) (channel->float-vector 1000 100 oboe1)))
+ (snd-display #__line__ ";~A via framples: ~A ~A" name (channel->float-vector 1000 100 oboe0) (channel->float-vector 1000 100 oboe1)))
+ (revert-sound oboe0)
+ (revert-sound oboe1))
+
+ (funcs-equal? "scale-sound-by"
+ (lambda args (apply scale-sound-by (cons 2.0 args)))
+ (lambda args (apply scale-channel (cons 2.0 args))))
+ (funcs-equal? "scale-and-ramp"
+ (lambda args (apply scale-sound-by (cons 0.0 args)))
+ (lambda args (apply ramp-channel (cons 0.0 (cons 0.0 args)))))
+ (funcs-equal? "scale-and-ramp"
+ (lambda args (apply scale-sound-by (cons 2.0 args)))
+ (lambda args (apply ramp-channel (cons 2.0 (cons 2.0 args)))))
+ (funcs-equal? "smooth-sound"
+ smooth-sound
+ smooth-channel)
+ (funcs-equal? "env-sound"
+ (lambda args (apply env-sound (list (list 0 0 1 1)
+ (if (> (length args) 0) (car args) 0)
+ (and (> (length args) 1)
+ (number? (cadr args))
+ (- (cadr args) 1))
+ 1.0
+ (if (> (length args) 2)
+ (caddr args)
+ (selected-sound)))))
+ (lambda args (apply env-channel
+ (cons (make-env :envelope (list 0 0 1 1)
+ :length (if (and (> (length args) 1)
+ (number? (cadr args)))
+ (cadr args)
+ (framples (if (> (length args) 2)
+ (caddr args)
+ (selected-sound)))))
+ args))))
+ (funcs-equal? "src-sound"
+ (lambda args (src-sound 2.0 1.0 (and (> (length args) 2) (caddr args))))
+ (lambda args (apply src-channel (cons 2.0 args))))
+ (funcs-equal? "reverse-sound"
+ (lambda args (reverse-sound (and (> (length args) 2) (caddr args))))
+ reverse-channel)
+ (funcs-equal? "mix"
+ (lambda args (mix "pistol.snd" 0 0 (and (> (length args) 2) (caddr args))))
+ (lambda args (apply mix-channel "pistol.snd" args)))
+ (funcs-equal? "insert-sound"
+ (lambda args (insert-sound "pistol.snd" 0 0 (and (> (length args) 2) (caddr args))))
+ (lambda args (apply insert-channel "pistol.snd" args)))
+ (close-sound oboe0)
+ (close-sound oboe1))
+
+ (let ((ind (open-sound "oboe.snd"))
+ (ind1 (new-sound "test.snd"))
+ (old-save-dir *save-dir*))
+ (set! *save-dir* #f)
+ (map-channel (lambda (y) 0.5) 0 100 ind1 0)
+ (save-sound ind1)
+ (close-sound ind1)
+ (insert-sound "test.snd" 12345)
+ (let ((vals (channel->float-vector (- 12345 50) 200 ind 0)))
+ (if (file-exists? "hiho.scm") (delete-file "hiho.scm"))
+ (save-state "hiho.scm")
+ (close-sound ind)
+ (for-each forget-region (regions))
+ (load (string-append cwd "hiho.scm"))
+ (set! ind (find-sound "oboe.snd"))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";save hiho failed?")
+ (let ((new-vals (channel->float-vector (- 12345 50) 200 ind 0)))
+ (if (not (vequal vals new-vals))
+ (snd-display #__line__ ";save state hiho vals: ~A ~A" vals new-vals))))
(close-sound ind))
-
- (let* ((ind (open-sound "oboe.snd"))
- (oldamp 0.0)
- (oldloc 0)
- (ctr 0))
+ (set! *save-dir* old-save-dir))
+
+ (let ((ind (new-sound "test.snd")))
+ (map-channel (lambda (y) (random 1.0)) 0 10)
+ (ramp-channel 0.0 1.0)
+ (zigzag-check "ramp" ind 0)
+ (undo)
+ (revert-sound ind)
+ (close-sound ind))
+
+ (set! *x-axis-style* x-axis-in-beats)
+ (let ((ind (open-sound "storm.snd")))
+ (reverse-channel 500000 1000000)
+ (set! (sample 0 ind 0 current-edit-position) .1)
+ (if (fneq (sample 0 ind 0 current-edit-position) .1)
+ (snd-display #__line__ ";set sample + edpos: ~A" (sample 0 ind 0 current-edit-position)))
+ (close-sound ind))
+ (set! *x-axis-style* x-axis-in-seconds)
+
+ (for-each
+ (lambda (out-chans)
+ (let ((ind (new-sound "new.snd" out-chans 22050 mus-ldouble mus-next "edpos testing"))
+ (mx (apply max (map sync (sounds)))))
+ (set! (sync ind) (+ mx 1))
+ (for-each
+ (lambda (in-sound)
+ (for-each
+ (lambda (func)
+ (for-each
+ (lambda (edpos)
+ (func edpos)
+ (revert-sound ind))
+ (list (lambda () current-edit-position)
+ (lambda () 0)
+ (lambda () (- (edit-position ind 0) 1))
+ (lambda () (edit-position ind 0)))))
+ (list
+ (lambda (posfunc)
+ (let ((chn (min (random (+ 1 out-chans)) (- out-chans 1))))
+ (if (not (vequal (channel->float-vector 0 (framples ind chn) ind chn 0) (float-vector 0.0)))
+ (snd-display #__line__ ";start bad: ~A" (channel->float-vector 0 (framples ind chn) ind chn 0)))
+ (set! (sample 0 ind chn) .1)
+ (if (not (vequal (channel->float-vector 0 (framples ind chn) ind chn) (float-vector 0.1)))
+ (snd-display #__line__ ";set bad: ~A" (channel->float-vector 0 (framples ind chn) ind chn)))
+ (pad-channel 0 1 ind chn (posfunc))
+ (let ((pos (posfunc)))
+ (if (procedure? pos)
+ (set! pos (pos ind chn)))
+ (let ((data (channel->float-vector 0 (framples ind chn) ind chn)))
+ (if (or (and (= pos 0)
+ (not (vequal data (float-vector 0.0 0.0))))
+ (and (or (= pos current-edit-position)
+ (= pos (edit-position ind chn)))
+ (not (vequal data (float-vector 0.0 0.1))))
+ (and (= pos (- (edit-position ind chn) 1))
+ (not (vequal data (float-vector 0.0 0.0)))))
+ (snd-display #__line__ ";pos[~A]: edpos ~A of ~A, pad result[~A, ~A]: ~A"
+ chn pos (edit-position ind chn) (framples ind chn pos) (framples ind chn) data))
+ (if (> (chans ind) 1)
+ (do ((i 0 (+ i 1)))
+ ((= i (chans ind)))
+ (if (not (= i chn))
+ (let ((data (channel->float-vector 0 (framples ind i) ind i)))
+ (if (not (vequal data (float-vector 0.0)))
+ (snd-display #__line__ ";pad[~A / ~A] empty: ~A" i chn data))))))))))
+ (lambda (posfunc)
+ (let ((chn (min (random (+ 1 out-chans)) (- out-chans 1))))
+ (set! (sample 0 ind chn) .1)
+ (set! (sample 0 ind chn (posfunc)) (* 2 (sample 0 ind chn (posfunc)))) ; not scale since it checks for zeros
+ (let ((pos (posfunc)))
+ (if (procedure? pos) (set! pos (pos ind chn)))
+ (let ((data (channel->float-vector 0 (framples ind chn) ind chn)))
+ (if (or (and (= pos 0)
+ (not (vequal data (float-vector 0.0))))
+ (and (or (= pos current-edit-position)
+ (= pos (edit-position ind chn)))
+ (not (vequal data (float-vector 0.2))))
+ (and (= pos (- (edit-position ind chn) 1))
+ (not (vequal data (float-vector 0.0)))))
+ (snd-display #__line__ ";pos[~A]: edpos ~A of ~A, set *2 result[~A, ~A]: ~A"
+ chn pos (edit-position ind chn) (framples ind chn pos) (framples ind chn) data))
+ (if (> (chans ind) 1)
+ (do ((i 0 (+ i 1)))
+ ((= i (chans ind)))
+ (if (not (= i chn))
+ (let ((data (channel->float-vector 0 (framples ind i) ind i)))
+ (if (not (vequal data (float-vector 0.0)))
+ (snd-display #__line__ ";scale[~A / ~A] empty: ~A" i chn data)))))))))))))
+ (list "2a.snd" "1a.snd" "4a.snd"))
+ (close-sound ind)))
+ (list 1 2 4))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (map-channel (lambda (y) #f))
+ (if (not (= (framples ind) 0)) (snd-display #__line__ ";map-channel #f framples: ~A" (framples ind)))
+ (if (equal? (edits ind) (list 0 0)) (snd-display #__line__ ";map-channel #f edits backed up"))
+ (undo 1 ind)
+ (if (= (framples ind) 0) (snd-display #__line__ ";map-channel #f framples after undo: ~A" (framples ind)))
+ (let ((tag (catch #t (lambda () (map-channel (lambda (y) "hiho"))) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";map-channel bad-type: ~A" tag)))
+ (let* ((ctr 0)
+ (tag (catch #t (lambda () (scan-channel (lambda (y) (set! ctr (+ ctr 1)) (asdf)))) (lambda args (car args)))))
+ (if (not (= ctr 1)) (snd-display #__line__ ";scan-channel error exit: ~A" ctr))
+ (if (and (not (eq? tag 'unbound-variable))
+ (not (eq? tag 'syntax-error))
+ (not (eq? tag 'error)))
+ (snd-display #__line__ ";scan-channel unbound: ~A" tag)))
+ (let ((val (scan-channel (lambda (y) #f)))) (if val (snd-display #__line__ ";scan-channel func #f: ~A" val)))
+ (let ((val (scan-channel (lambda (y) #f) 1234))) (if val (snd-display #__line__ ";scan-channel func #f with beg: ~A" val)))
+ (let ((val (scan-channel (lambda (y) #f) 1234 4321))) (if val (snd-display #__line__ ";scan-channel func #f with beg+dur: ~A" val)))
+ (revert-sound ind)
+ (let ((del (make-delay 1000))
+ (len (framples)))
+ (clm-channel del 0 (framples) ind 0 0 2000)
+ (if (not (= (framples ind) (+ 2000 len)))
+ (snd-display #__line__ ";clm-channel overlap length: ~A ~A" len (framples)))
+ (if (not (equal? (edit-tree) '((0 1 0 52827 1.0 0.0 0.0 0) (52828 -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";clm-channel overlaps: ~A" (edit-tree)))
+ (let ((reader (make-sampler 0))
+ (preader (make-sampler 0 ind 0 1 0))
+ (happy #t))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy) (= i 1000)))
+ (let ((val (reader)))
+ (if (fneq val 0.0)
+ (begin
+ (snd-display #__line__ ";clm-channel overlap delayed: ~A: ~A" i val)
+ (set! happy #f)))))
+ (let ((v0 (make-float-vector len))
+ (v1 (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v0 i) (read-sample preader)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! v1 i (read-sample reader)))
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ ";clm-channel overlap main: ~A ~A" v0 v1)))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy) (= i 1000)))
+ (if (fneq (reader) 0.0)
+ (begin
+ (snd-display #__line__ ";clm-channel overlap trailing garbage")
+ (set! happy #f))))))
+ (close-sound ind))
+
+ (let ((ind (open-sound "oboe.snd"))
+ (oldamp 0.0)
+ (oldloc 0)
+ (ctr 0))
+ (scan-channel (lambda (y)
+ (if (>= (abs y) oldamp)
+ (begin
+ (set! oldloc ctr)
+ (set! oldamp (abs y))))
+ (set! ctr (+ ctr 1))
+ #f))
+ (scale-by 10.0)
+ (scale-by 0.1)
+ (reverse-channel 0 #f ind 0 1)
+ (let ((amp 0.0)
+ (loc 0)
+ (ctr (- (framples) 1)))
(scan-channel (lambda (y)
- (if (>= (abs y) oldamp)
+ (if (> (abs y) amp)
(begin
- (set! oldloc ctr)
- (set! oldamp (abs y))))
- (set! ctr (+ 1 ctr))
+ (set! amp (abs y))
+ (set! loc ctr)))
+ (set! ctr (- ctr 1))
#f))
- (scale-by 10.0)
- (scale-by 0.1)
- (reverse-channel 0 #f ind 0 1)
- (let ((amp 0.0)
- (loc 0)
- (ctr (- (frames) 1)))
- (scan-channel (lambda (y)
- (if (> (abs y) amp)
- (begin
- (set! amp (abs y))
- (set! loc ctr)))
- (set! ctr (- ctr 1))
- #f))
- ;; can't use maxamp here because it may be set by scaling process
- (if (or (fneq oldamp (* .1 amp))
- (not (= loc oldloc)))
- (snd-display #__line__ ";reverse edpos screwup: ~A at ~A, ~A at ~A" oldamp oldloc amp loc)))
- (undo)
- (reverse-channel 0 #f ind 0 2)
- (let ((amp 0.0)
- (loc 0)
- (ctr (- (frames) 1)))
- (scan-channel (lambda (y)
- (if (> (abs y) amp)
- (begin
- (set! amp (abs y))
- (set! loc ctr)))
- (set! ctr (- ctr 1))
- #f))
- ;; can't use maxamp here because it may be set by scaling process
- (if (or (fneq oldamp amp)
- (not (= loc oldloc)))
- (snd-display #__line__ ";reverse unscaled edpos screwup: ~A at ~A, ~A at ~A" oldamp oldloc amp loc)))
-
- (close-sound ind))
+ ;; can't use maxamp here because it may be set by scaling process
+ (if (or (fneq oldamp (* .1 amp))
+ (not (= loc oldloc)))
+ (snd-display #__line__ ";reverse edpos screwup: ~A at ~A, ~A at ~A" oldamp oldloc amp loc)))
+ (undo)
+ (reverse-channel 0 #f ind 0 2)
+ (let ((amp 0.0)
+ (loc 0)
+ (ctr (- (framples) 1)))
+ (scan-channel (lambda (y)
+ (if (> (abs y) amp)
+ (begin
+ (set! amp (abs y))
+ (set! loc ctr)))
+ (set! ctr (- ctr 1))
+ #f))
+ ;; can't use maxamp here because it may be set by scaling process
+ (if (or (fneq oldamp amp)
+ (not (= loc oldloc)))
+ (snd-display #__line__ ";reverse unscaled edpos screwup: ~A at ~A, ~A at ~A" oldamp oldloc amp loc)))
- (if (mus-clipping) (set! (mus-clipping) #f))
- (if (clipping) (set! (clipping) #f))
- (let ((ind (new-sound "fmv.snd" mus-next mus-bfloat 22050 1 "edit trees"))
- (vals (make-vct 100)))
- (select-sound ind)
- (select-channel 0)
- (check-edit-tree '((0 0 0 0 0.0 0.0 0.0 1) (1 -2 0 0 0.0 0.0 0.0 0)) (make-vct 1) "initial new-sound")
- (vct-fill! vals 1.0)
- (set! (samples 0 100) vals)
- (check-edit-tree '((0 1 0 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0)) vals "set first samps to one")
- (scale-channel 0.5 10 20)
- (do ((i 10 (+ 1 i)))
- ((= i 30))
- (vct-set! vals i 0.5))
- (check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "scale-channel 0.5 10 20")
- (env-channel (make-env '(0 0 1 1) :length 11) 15 10)
- (let ((e (make-env '(0 0 1 1) :length 11)))
- (do ((i 15 (+ 1 i)))
- ((= i 25))
- (vct-set! vals i (* (vct-ref vals i) (env e)))))
- (check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 14 0.5 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
- (25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env-channel 15 10")
- (normalize-channel 1.0)
- (check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 14 0.5 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
- (25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env-channel 15 10 a")
- (select-all)
- (if (fneq (selection-maxamp) 1.0)
- (snd-display #__line__ ";selection-maxamp in checker: ~A" (selection-maxamp)))
- (scale-selection-to 1.0)
- (check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 14 0.5 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
- (25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env-channel 15 10 b")
- (set! (selection-position) 5)
- (set! (selection-frames) 10)
- (scale-selection-to .5)
- (do ((i 5 (+ 1 i)))
- ((= i 15))
- (vct-set! vals i (* (vct-ref vals i) 0.5)))
- (check-edit-tree '((0 1 0 4 1.0 0.0 0.0 0) (5 1 5 9 0.5 0.0 0.0 0) (10 1 10 14 0.25 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
- (25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "scale-selection-to .5")
- (set! (sample 20) .1)
- (vct-set! vals 20 .1)
- (check-edit-tree '((0 1 0 4 1.0 0.0 0.0 0) (5 1 5 9 0.5 0.0 0.0 0) (10 1 10 14 0.25 0.0 0.0 0)
- (15 1 15 19 0.5 0.0 0.1 1) (20 2 0 0 1.0 0.0 0.0 0)
- (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 29 0.5 0.0 0.0 0)
- (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "set 20 .1")
- (reverse-channel 5 10)
- (do ((i 5 (+ 1 i))
- (j 14 (- j 1)))
- ((= i 10))
- (let ((temp (vct-ref vals i)))
- (vct-set! vals i (vct-ref vals j))
- (vct-set! vals j temp)))
- (check-edit-tree '((0 1 0 4 1.0 0.0 0.0 0) (5 3 0 9 1.0 0.0 0.0 0)
- (15 1 15 19 0.5 0.0 0.1 1) (20 2 0 0 1.0 0.0 0.0 0)
- (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 29 0.5 0.0 0.0 0)
- (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "reverse-channel 5 10")
- (if (fneq (selection-maxamp) .5) (snd-display #__line__ ";selection-maxamp before: ~A" (selection-maxamp)))
- (let ((mixvals (make-vct 10))
- (old-sample4 (sample 4))
- (old-sample5 (sample 5)))
- (vct-fill! mixvals .1)
- (let ((id (mix-vct mixvals 4)))
- (do ((i 4 (+ 1 i))
- (j 0 (+ 1 j)))
- ((= i 14))
- (vct-set! vals i (+ (vct-ref vals i) (vct-ref mixvals j))))
- (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
- (15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
- (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 29 0.5 0.0 0.0 0)
- (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals (format #f "mix-vct (id: ~A (~A) [~A ~A] + .1 -> [~A ~A] [~A ~A]) 4 (.1)"
- id ind
- old-sample4 old-sample5
- (sample 4) (sample 5)
- (vct-ref vals 4) (vct-ref vals 5)))))
-
- ; (list global-position data-number local-position local-end scaler ramp0 ramp1 type)
-
- (delete-samples 28 12)
- (insert-silence 28 12)
- (do ((i 28 (+ 1 i)))
- ((= i 40))
- (vct-set! vals i 0.0))
- (let ((old-vals (vct-copy vals)))
- (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1)
- (14 3 9 9 1.0 0.0 0.0 0) (15 1 15 19 0.5 0.0 0.1 4)
- (20 2 0 0 1.0 0.0 0.0 0) (21 1 21 24 0.5 0.6 0.1 4)
- (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
- (40 1 40 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "delete/insert")
- (if (fneq (selection-maxamp) .6) (snd-display #__line__ ";selection-maxamp after: ~A" (selection-maxamp)))
- (set! (selection-position) 50)
- (set! (selection-frames) 10)
- (scale-selection-by .1)
- (if (fneq (selection-maxamp) .1) (snd-display #__line__ ";re-selection-maxamp: ~A" (selection-maxamp)))
- (do ((i 50 (+ 1 i)))
- ((= i 60))
- (vct-set! vals i .1))
- (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
- (15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
- (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
- (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.100000001490116 0.0 0.0 0) (60 1 60 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "scale-selection-by .1")
- (env-channel (make-env '(0 0 1 1 2 0 3 0) :length 31 :base 0) 50 30)
- (let ((e (make-env '(0 0 1 1 2 0 3 0) :length 31 :base 0)))
- (do ((i 50 (+ 1 i)))
- ((= i 80))
- (vct-set! vals i (* (vct-ref vals i) (env e)))))
+ (close-sound ind))
+
+ (if (mus-clipping) (set! (mus-clipping) #f))
+ (if *clipping* (set! *clipping* #f))
+ (let ((ind (new-sound "fmv.snd" 1 22050 mus-ldouble mus-next "edit trees"))
+ (vals (make-float-vector 100)))
+ (select-sound ind)
+ (select-channel 0)
+ (check-edit-tree '((0 0 0 0 0.0 0.0 0.0 1) (1 -2 0 0 0.0 0.0 0.0 0)) (make-float-vector 1) "initial new-sound" #__line__)
+ (fill! vals 1.0)
+ (set! (samples 0 100) vals)
+ (check-edit-tree '((0 1 0 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0)) vals "set first samps to one" #__line__)
+ (scale-channel 0.5 10 20)
+ (do ((i 10 (+ i 1)))
+ ((= i 30))
+ (set! (vals i) 0.5))
+ (check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "scale-channel 0.5 10 20" #__line__)
+ (env-channel (make-env '(0 0 1 1) :length 11) 15 10)
+ (let ((e (make-env '(0 0 1 1) :length 11)))
+ (do ((i 15 (+ i 1)))
+ ((= i 25))
+ (set! (vals i) (* (vals i) (env e)))))
+ (check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 14 0.5 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
+ (25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env-channel 15 10" #__line__)
+ (normalize-channel 1.0)
+ (check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 14 0.5 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
+ (25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env-channel 15 10 a" #__line__)
+ (select-all)
+ (if (fneq (selection-maxamp) 1.0)
+ (snd-display #__line__ ";selection-maxamp in checker: ~A" (selection-maxamp)))
+ (scale-selection-to 1.0)
+ (check-edit-tree '((0 1 0 9 1.0 0.0 0.0 0) (10 1 10 14 0.5 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
+ (25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env-channel 15 10 b" #__line__)
+ (set! (selection-position) 5)
+ (set! (selection-framples) 10)
+ (scale-selection-to .5)
+ (do ((i 5 (+ i 1)))
+ ((= i 15))
+ (set! (vals i) (* (vals i) 0.5)))
+ (check-edit-tree '((0 1 0 4 1.0 0.0 0.0 0) (5 1 5 9 0.5 0.0 0.0 0) (10 1 10 14 0.25 0.0 0.0 0) (15 1 15 24 0.5 0.0 0.1 1)
+ (25 1 25 29 0.5 0.0 0.0 0) (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "scale-selection-to .5" #__line__)
+ (set! (sample 20) .1)
+ (set! (vals 20) .1)
+ (check-edit-tree '((0 1 0 4 1.0 0.0 0.0 0) (5 1 5 9 0.5 0.0 0.0 0) (10 1 10 14 0.25 0.0 0.0 0)
+ (15 1 15 19 0.5 0.0 0.1 1) (20 2 0 0 1.0 0.0 0.0 0)
+ (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 29 0.5 0.0 0.0 0)
+ (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "set 20 .1" #__line__)
+ (reverse-channel 5 10)
+ (do ((i 5 (+ i 1))
+ (j 14 (- j 1)))
+ ((= i 10))
+ (let ((temp (vals i)))
+ (set! (vals i) (vals j))
+ (set! (vals j) temp)))
+ (check-edit-tree '((0 1 0 4 1.0 0.0 0.0 0) (5 3 0 9 1.0 0.0 0.0 0)
+ (15 1 15 19 0.5 0.0 0.1 1) (20 2 0 0 1.0 0.0 0.0 0)
+ (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 29 0.5 0.0 0.0 0)
+ (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "reverse-channel 5 10" #__line__)
+ (if (fneq (selection-maxamp) .5) (snd-display #__line__ ";selection-maxamp before: ~A" (selection-maxamp)))
+ (let ((mixvals (make-float-vector 10))
+ (old-sample4 (sample 4))
+ (old-sample5 (sample 5)))
+ (fill! mixvals .1)
+ (let ((id (mix-float-vector mixvals 4)))
+ (do ((i 4 (+ i 1))
+ (j 0 (+ j 1)))
+ ((= i 14))
+ (set! (vals i) (+ (vals i) (mixvals j))))
(check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
(15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
- (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
- (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
- (61 1 61 70 1.0 0.0 0.0 0) (71 1 71 79 0.0 0.0 0.0 2) (80 1 80 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "step env 30")
- (undo-channel 2)
- (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1)
- (14 3 9 9 1.0 0.0 0.0 0) (15 1 15 19 0.5 0.0 0.1 4)
- (20 2 0 0 1.0 0.0 0.0 0) (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0)
- (28 -1 0 11 0.0 0.0 0.0 2) (40 1 40 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- old-vals "undo to delete/insert (over step env)"))
- (redo-channel 2)
+ (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 29 0.5 0.0 0.0 0)
+ (30 1 30 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals (format #f "mix-float-vector (id: ~A (~A) [~A ~A] + .1 -> [~A ~A] [~A ~A]) 4 (.1)"
+ id ind
+ old-sample4 old-sample5
+ (sample 4) (sample 5)
+ (vals 4) (vals 5)) #__line__)))
+
+ ; (list global-position data-number local-position local-end scaler ramp0 ramp1 type)
+
+ (delete-samples 28 12)
+ (insert-silence 28 12)
+ (do ((i 28 (+ i 1)))
+ ((= i 40))
+ (set! (vals i) 0.0))
+ (let ((old-vals (copy vals)))
+ (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1)
+ (14 3 9 9 1.0 0.0 0.0 0) (15 1 15 19 0.5 0.0 0.1 4)
+ (20 2 0 0 1.0 0.0 0.0 0) (21 1 21 24 0.5 0.6 0.1 4)
+ (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
+ (40 1 40 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "delete/insert" #__line__)
+ (if (fneq (selection-maxamp) .6) (snd-display #__line__ ";selection-maxamp after: ~A" (selection-maxamp)))
+ (set! (selection-position) 50)
+ (set! (selection-framples) 10)
+ (scale-selection-by .1)
+ (if (fneq (selection-maxamp) .1) (snd-display #__line__ ";re-selection-maxamp: ~A" (selection-maxamp)))
+ (do ((i 50 (+ i 1)))
+ ((= i 60))
+ (set! (vals i) .1))
+ (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
+ (15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
+ (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
+ (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.100000001490116 0.0 0.0 0) (60 1 60 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "scale-selection-by .1" #__line__)
+ (env-channel (make-env '(0 0 1 1 2 0 3 0) :length 31 :base 0) 50 30)
+ (let ((e (make-env '(0 0 1 1 2 0 3 0) :length 31 :base 0)))
+ (do ((i 50 (+ i 1)))
+ ((= i 80))
+ (set! (vals i) (* (vals i) (env e)))))
(check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
(15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
(21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
- (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
+ (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
(61 1 61 70 1.0 0.0 0.0 0) (71 1 71 79 0.0 0.0 0.0 2) (80 1 80 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "redo past step env 30")
- (set! (sample 75) -.5)
- (vct-set! vals 75 -.5)
- (let ((flt (make-one-zero 0.5 0.5))
- (flt1 (make-one-zero 0.5 0.5)))
- (clm-channel flt 75 10)
- (do ((i 75 (+ 1 i)))
- ((= i 85))
- (vct-set! vals i (one-zero flt1 (vct-ref vals i))))
- (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
- (15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
- (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
- (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
- (61 1 61 70 1.0 0.0 0.0 0) (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 1.0 0.0 0.0 0) (85 1 85 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "clm-channel 75 10"))
- (map-channel (lambda (y) (* y .5)) 3 11)
- (do ((i 3 (+ 1 i)))
- ((= i 14))
- (vct-set! vals i (* .5 (vct-ref vals i))))
- (check-edit-tree '((0 1 0 2 1.0 0.0 0.0 0) (3 8 0 10 1.0 0.0 0.0 0) (14 7 10 11 1.0 0.0 0.0 0)
- (16 1 16 19 0.5 0.1 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
+ vals "step env 30" #__line__)
+ (undo-channel 2)
+ (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1)
+ (14 3 9 9 1.0 0.0 0.0 0) (15 1 15 19 0.5 0.0 0.1 4)
+ (20 2 0 0 1.0 0.0 0.0 0) (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0)
+ (28 -1 0 11 0.0 0.0 0.0 2) (40 1 40 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ old-vals "undo to delete/insert (over step env)" #__line__))
+ (redo-channel 2)
+ (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
+ (15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
+ (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
+ (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
+ (61 1 61 70 1.0 0.0 0.0 0) (71 1 71 79 0.0 0.0 0.0 2) (80 1 80 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "redo past step env 30" #__line__)
+ (set! (sample 75) -.5)
+ (set! (vals 75) -.5)
+ (let ((flt (make-one-zero 0.5 0.5))
+ (flt1 (make-one-zero 0.5 0.5)))
+ (clm-channel flt 75 10)
+ (do ((i 75 (+ i 1)))
+ ((= i 85))
+ (set! (vals i) (one-zero flt1 (vals i))))
+ (check-edit-tree '((0 1 0 3 1.0 0.0 0.0 0) (4 1 4 4 1.0 0.0 0.0 1) (5 3 0 8 1.0 0.0 0.0 1) (14 3 9 9 1.0 0.0 0.0 0)
+ (15 1 15 19 0.5 0.0 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
(21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
(40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
- (61 1 61 70 1.0 0.0 0.0 0) (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 1.0 0.0 0.0 0)
- (85 1 85 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "map-channel 3 14")
- (map-channel (let ((reader (make-sampler 50)))
- (lambda (y)
- (- y (reader))))
- 0 25)
- (do ((i 0 (+ 1 i))
- (j 50 (+ 1 j)))
- ((= i 25))
- (vct-set! vals i (- (vct-ref vals i) (vct-ref vals j))))
- (check-edit-tree '((0 9 0 24 1.0 0.0 0.0 0) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
- (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
- (61 1 61 70 1.0 0.0 0.0 0) (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 1.0 0.0 0.0 0)
- (85 1 85 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "back set via map-channel")
- (set! (selection-position) 20)
- (set! (selection-frames) 70)
- (env-selection '(0 0 1 1))
- (if (fneq (selection-maxamp ind 0) 1.0) (snd-display #__line__ ";selection-maxamp after env-selection: ~A" (selection-maxamp ind 0)))
- (do ((i 20 (+ 1 i))
- (x 0.0)
- (incr (/ 1.0 69.0)))
- ((= i 90))
- (vct-set! vals i (* (vct-ref vals i) x))
- (set! x (+ x incr)))
- (check-edit-tree '((0 9 0 19 1.0 0.0 0.0 0) (20 9 20 24 1.0 0.0 0.014492753893137 4)
- (25 1 25 27 0.5 0.0724637657403946 0.014492753893137 4) (28 -1 0 11 0.0 0.0 0.0 2)
- (40 1 40 49 1.0 0.289855062961578 0.014492753893137 4) (50 1 50 59 0.0 0.0 0.0 2)
- (60 1 60 60 0.0 0.0 0.0 2) (61 1 61 70 1.0 0.594202876091003 0.014492753893137 4)
- (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 1.0 0.797101438045502 0.014492753893137 4)
- (85 1 85 89 1.0 0.942028999328613 0.014492753893137 4) (90 1 90 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env-selection")
- (normalize-channel .5)
- (vct-scale! vals .5)
- (check-edit-tree '((0 9 0 19 0.5 0.0 0.0 0) (20 9 20 24 0.5 0.0 0.014492753893137 4)
- (25 1 25 27 0.25 0.0724637657403946 0.014492753893137 4) (28 -1 0 11 0.0 0.0 0.0 2)
- (40 1 40 49 0.5 0.289855062961578 0.014492753893137 4) (50 1 50 59 0.0 0.0 0.0 2)
- (60 1 60 60 0.0 0.0 0.0 2) (61 1 61 70 0.5 0.594202876091003 0.014492753893137 4)
- (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 0.5 0.797101438045502 0.014492753893137 4)
- (85 1 85 89 0.5 0.942028999328613 0.014492753893137 4) (90 1 90 99 0.5 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "scale-to")
- (if (fneq (selection-maxamp) .5) (snd-display #__line__ ";selection-maxamp after scale: ~A" (selection-maxamp)))
- (delete-samples 0 100)
- (insert-silence 0 100)
- (vct-fill! vals 0.0)
- (check-edit-tree '((0 -1 0 99 0.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "second set...")
-
- (set! (sample 50) .5)
- (vct-set! vals 50 .5)
- (check-edit-tree '((0 -1 0 49 0.0 0.0 0.0 2) (50 10 0 0 1.0 0.0 0.0 0) (51 -1 51 99 0.0 0.0 0.0 2) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "split silence")
- (map-channel (lambda (y) 1.0) 0 25)
- (do ((i 0 (+ 1 i)))
- ((= i 25))
- (vct-set! vals i 1.0))
- (check-edit-tree '((0 11 0 24 1.0 0.0 0.0 0) (25 -1 25 49 0.0 0.0 0.0 2) (50 10 0 0 1.0 0.0 0.0 0) (51 -1 51 99 0.0 0.0 0.0 2) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "clobber silence start")
- (map-channel (lambda (y) 1.0) 75 25)
- (do ((i 75 (+ 1 i)))
- ((= i 100))
- (vct-set! vals i 1.0))
- (check-edit-tree '((0 11 0 24 1.0 0.0 0.0 0) (25 -1 25 49 0.0 0.0 0.0 2) (50 10 0 0 1.0 0.0 0.0 0)
- (51 -1 51 74 0.0 0.0 0.0 2) (75 12 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "clobber silence end")
- (scale-channel 0.0 0 100)
- (vct-fill! vals 0.0)
- (check-edit-tree '((0 0 0 99 0.0 0.0 0.0 1) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "scale all to 0.0")
- (let ((e (make-env '(0 0 1 1) :length 101))
- (e1 (make-env '(0 0 1 1) :length 101)))
- (map-channel (lambda (y) (env e)))
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (vct-set! vals i (env e1))))
- (check-edit-tree '((0 13 0 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env start")
- (set! (sample 50) -.5)
- (vct-set! vals 50 -.5)
- (check-edit-tree '((0 13 0 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 0.0 0.0 0) (51 13 51 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "split env segment")
- (map-channel (lambda (y) 1.0) 0 25)
- (do ((i 0 (+ 1 i)))
- ((= i 25))
- (vct-set! vals i 1.0))
- (check-edit-tree '((0 15 0 24 1.0 0.0 0.0 0) (25 13 25 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 0.0 0.0 0) (51 13 51 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "clobber env start")
- (map-channel (lambda (y) 1.0) 75 25)
- (do ((i 75 (+ 1 i)))
+ (61 1 61 70 1.0 0.0 0.0 0) (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 1.0 0.0 0.0 0) (85 1 85 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "clm-channel 75 10" #__line__))
+ (map-channel (lambda (y) (* y 1 .5)) 3 11) ; extra "1" is needed for the tree expectation
+ (do ((i 3 (+ i 1)))
+ ((= i 14))
+ (set! (vals i) (* .5 (vals i))))
+ (check-edit-tree '((0 1 0 2 1.0 0.0 0.0 0) (3 8 0 10 1.0 0.0 0.0 0) (14 7 10 11 1.0 0.0 0.0 0)
+ (16 1 16 19 0.5 0.1 0.1 4) (20 2 0 0 1.0 0.0 0.0 0)
+ (21 1 21 24 0.5 0.6 0.1 4) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
+ (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
+ (61 1 61 70 1.0 0.0 0.0 0) (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 1.0 0.0 0.0 0)
+ (85 1 85 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "map-channel 3 14" #__line__)
+ (map-channel (let ((reader (make-sampler 50)))
+ (lambda (y)
+ (- y (next-sample reader))))
+ 0 25)
+ (do ((i 0 (+ i 1))
+ (j 50 (+ j 1)))
+ ((= i 25))
+ (set! (vals i) (- (vals i) (vals j))))
+ (check-edit-tree '((0 9 0 24 1.0 0.0 0.0 0) (25 1 25 27 0.5 0.0 0.0 0) (28 -1 0 11 0.0 0.0 0.0 2)
+ (40 1 40 49 1.0 0.0 0.0 0) (50 1 50 59 0.0 0.0 0.0 2) (60 1 60 60 0.0 0.0 0.0 2)
+ (61 1 61 70 1.0 0.0 0.0 0) (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 1.0 0.0 0.0 0)
+ (85 1 85 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "back set via map-channel" #__line__)
+ (set! (selection-position) 20)
+ (set! (selection-framples) 70)
+ (env-selection '(0 0 1 1))
+ (if (fneq (selection-maxamp ind 0) 1.0) (snd-display #__line__ ";selection-maxamp after env-selection: ~A" (selection-maxamp ind 0)))
+ (do ((i 20 (+ i 1))
+ (x 0.0)
+ (incr (/ 1.0 69.0)))
+ ((= i 90))
+ (set! (vals i) (* (vals i) x))
+ (set! x (+ x incr)))
+ (check-edit-tree '((0 9 0 19 1.0 0.0 0.0 0) (20 9 20 24 1.0 0.0 0.014492753893137 4)
+ (25 1 25 27 0.5 0.0724637657403946 0.014492753893137 4) (28 -1 0 11 0.0 0.0 0.0 2)
+ (40 1 40 49 1.0 0.289855062961578 0.014492753893137 4) (50 1 50 59 0.0 0.0 0.0 2)
+ (60 1 60 60 0.0 0.0 0.0 2) (61 1 61 70 1.0 0.594202876091003 0.014492753893137 4)
+ (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 1.0 0.797101438045502 0.014492753893137 4)
+ (85 1 85 89 1.0 0.942028999328613 0.014492753893137 4) (90 1 90 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env-selection" #__line__)
+ (normalize-channel .5)
+ (float-vector-scale! vals .5)
+ (check-edit-tree '((0 9 0 19 0.5 0.0 0.0 0) (20 9 20 24 0.5 0.0 0.014492753893137 4)
+ (25 1 25 27 0.25 0.0724637657403946 0.014492753893137 4) (28 -1 0 11 0.0 0.0 0.0 2)
+ (40 1 40 49 0.5 0.289855062961578 0.014492753893137 4) (50 1 50 59 0.0 0.0 0.0 2)
+ (60 1 60 60 0.0 0.0 0.0 2) (61 1 61 70 0.5 0.594202876091003 0.014492753893137 4)
+ (71 1 71 74 0.0 0.0 0.0 2) (75 6 0 9 0.5 0.797101438045502 0.014492753893137 4)
+ (85 1 85 89 0.5 0.942028999328613 0.014492753893137 4) (90 1 90 99 0.5 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "scale-to" #__line__)
+ (if (fneq (selection-maxamp) .5) (snd-display #__line__ ";selection-maxamp after scale: ~A" (selection-maxamp)))
+ (delete-samples 0 100)
+ (insert-silence 0 100)
+ (fill! vals 0.0)
+ (check-edit-tree '((0 -1 0 99 0.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "second set..." #__line__)
+
+ (set! (sample 50) .5)
+ (set! (vals 50) .5)
+ (check-edit-tree '((0 -1 0 49 0.0 0.0 0.0 2) (50 10 0 0 1.0 0.0 0.0 0) (51 -1 51 99 0.0 0.0 0.0 2) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "split silence" #__line__)
+ (map-channel (lambda (y) 1.0) 0 25)
+ (fill! vals 1.0 0 25)
+ (check-edit-tree '((0 11 0 24 1.0 0.0 0.0 0) (25 -1 25 49 0.0 0.0 0.0 2) (50 10 0 0 1.0 0.0 0.0 0) (51 -1 51 99 0.0 0.0 0.0 2) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "clobber silence start" #__line__)
+ (map-channel (lambda (y) 1.0) 75 25)
+ (fill! vals 1.0 75 100)
+ (check-edit-tree '((0 11 0 24 1.0 0.0 0.0 0) (25 -1 25 49 0.0 0.0 0.0 2) (50 10 0 0 1.0 0.0 0.0 0)
+ (51 -1 51 74 0.0 0.0 0.0 2) (75 12 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "clobber silence end" #__line__)
+ (scale-channel 0.0 0 100)
+ (fill! vals 0.0)
+ (check-edit-tree '((0 0 0 99 0.0 0.0 0.0 1) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "scale all to 0.0" #__line__)
+ (let ((e (make-env '(0 0 1 1) :length 101))
+ (e1 (make-env '(0 0 1 1) :length 101)))
+ (map-channel (lambda (y) (env e)))
+ (do ((i 0 (+ i 1)))
((= i 100))
- (vct-set! vals i 1.0))
- (check-edit-tree '((0 15 0 24 1.0 0.0 0.0 0) (25 13 25 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 0.0 0.0 0)
- (51 13 51 74 1.0 0.0 0.0 0) (75 16 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "clobber env end")
- ;; this can't be expected to work anymore -- internal backup can change edit tree bounds
+ (set! (vals i) (env e1))))
+ (check-edit-tree '((0 13 0 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env start" #__line__)
+ (set! (sample 50) -.5)
+ (set! (vals 50) -.5)
+ (check-edit-tree '((0 13 0 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 0.0 0.0 0) (51 13 51 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "split env segment" #__line__)
+ (map-channel (lambda (y) 1.0) 0 25)
+ (fill! vals 1.0 0 25)
+ (check-edit-tree '((0 15 0 24 1.0 0.0 0.0 0) (25 13 25 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 0.0 0.0 0) (51 13 51 99 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "clobber env start" #__line__)
+ (map-channel (lambda (y) 1.0) 75 25)
+ (fill! vals 1.0 75 100)
+ (check-edit-tree '((0 15 0 24 1.0 0.0 0.0 0) (25 13 25 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 0.0 0.0 0)
+ (51 13 51 74 1.0 0.0 0.0 0) (75 16 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "clobber env end" #__line__)
+ ;; this can't be expected to work anymore -- internal backup can change edit tree bounds
; (save-edit-history "hiho.scm")
; (revert-sound ind)
; (set! sfile ind)
; (load (string-append cwd "hiho.scm"))
; (check-edit-tree '((0 14 0 24 1.0 0.0 0.0 0) (25 12 25 49 1.0 0.0 0.0 0) (50 13 0 0 1.0 0.0 0.0 0) (51 12 51 74 1.0 0.0 0.0 0) (75 15 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- ; vals "reload edits")
+ ; vals "reload edits" #__line__)
; (if (not (equal? (edits) (list 27 0))) (snd-display #__line__ ";edits after reload: ~A" (edits)))
; (delete-file "hiho.scm")
-
- (env-channel (make-env '(0 1 1 0 2 1) :length 20) 50 20)
- (let ((e (make-env '(0 1 1 0 2 1) :length 20)))
- (do ((i 50 (+ 1 i)))
- ((= i 70))
- (vct-set! vals i (* (env e) (vct-ref vals i)))))
- (check-edit-tree '((0 15 0 24 1.0 0.0 0.0 0) (25 13 25 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 1.0 -0.100000001490116 4)
- (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 4) (60 13 60 69 1.0 0.0 0.111111111938953 4)
- (70 13 70 74 1.0 0.0 0.0 0) (75 16 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env on env")
- (env-channel (make-env '(0 1 1 0 2 1) :length 80) 10 80)
- (let ((e (make-env '(0 1 1 0 2 1) :length 80)))
- (do ((i 10 (+ 1 i)))
- ((= i 90))
- (vct-set! vals i (* (env e) (vct-ref vals i)))))
- (check-edit-tree '((0 15 0 9 1.0 0.0 0.0 0) (10 15 10 24 1.0 1.0 -0.025000000372529 4) (25 13 25 49 1.0 0.625 -0.025000000372529 4)
- (50 14 0 0 1.0 1.0 -0.100000001490116 6) (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 6)
- (60 13 60 69 1.0 0.0 0.111111111938953 6) (70 13 70 74 1.0 0.512820541858673 0.0256410259753466 4)
- (75 16 0 14 1.0 0.64102566242218 0.0256410259753466 4) (90 16 15 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env on env 2")
- (env-channel (make-env '(0 1 1 0 2 1) :length 20) 50 20)
- (let ((e (make-env '(0 1 1 0 2 1) :length 20)))
- (do ((i 50 (+ 1 i)))
- ((= i 70))
- (vct-set! vals i (* (env e) (vct-ref vals i)))))
- (check-edit-tree '((0 15 0 9 1.0 0.0 0.0 0) (10 15 10 24 1.0 1.0 -0.025000000372529 4) (25 13 25 49 1.0 0.625 -0.025000000372529 4)
- (50 14 0 0 1.0 1.0 -0.100000001490116 10) (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 10)
- (60 13 60 69 1.0 0.0 0.111111111938953 10) (70 13 70 74 1.0 0.512820541858673 0.0256410259753466 4)
- (75 16 0 14 1.0 0.64102566242218 0.0256410259753466 4) (90 16 15 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env on env 3")
- (delete-samples 10 20)
- (insert-silence 10 20)
- (do ((i 10 (+ 1 i)))
- ((= i 30))
- (vct-set! vals i 0.0))
- (check-edit-tree '((0 15 0 9 1.0 0.0 0.0 0) (10 -1 0 19 0.0 0.0 0.0 2) (30 13 30 49 1.0 0.5 -0.025000000372529 4)
- (50 14 0 0 1.0 1.0 -0.100000001490116 10) (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 10)
- (60 13 60 69 1.0 0.0 0.111111111938953 10) (70 13 70 74 1.0 0.512820541858673 0.0256410259753466 4)
- (75 16 0 14 1.0 0.64102566242218 0.0256410259753466 4) (90 16 15 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
- vals "env preclobbered")
- (close-sound ind))
- (for-each
- (lambda (dur)
- (let* ((i1 (new-sound))
- (v (vct-fill! (make-vct dur) 1.0)))
- (define (check-env name r e)
- (let ((happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i dur))
- happy)
- (let ((rv (r))
- (ev (e)))
- (if (fneq rv ev)
- (begin
- (snd-display #__line__ ";~A env check [~A]: ~A ~A" name i rv ev)
- (set! happy #f)))))))
- (vct->channel v)
- (env-sound '(0 0 1 1))
- (check-env 'ramp (make-sampler 0) (make-env '(0 0 1 1) :length dur))
+ (env-channel (make-env '(0 1 1 0 2 1) :length 20) 50 20)
+ (let ((e (make-env '(0 1 1 0 2 1) :length 20)))
+ (do ((i 50 (+ i 1)))
+ ((= i 70))
+ (set! (vals i) (* (env e) (vals i)))))
+ (check-edit-tree '((0 15 0 24 1.0 0.0 0.0 0) (25 13 25 49 1.0 0.0 0.0 0) (50 14 0 0 1.0 1.0 -0.100000001490116 4)
+ (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 4) (60 13 60 69 1.0 0.0 0.111111111938953 4)
+ (70 13 70 74 1.0 0.0 0.0 0) (75 16 0 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env on env" #__line__)
+ (env-channel (make-env '(0 1 1 0 2 1) :length 80) 10 80)
+ (let ((e (make-env '(0 1 1 0 2 1) :length 80)))
+ (do ((i 10 (+ i 1)))
+ ((= i 90))
+ (set! (vals i) (* (env e) (vals i)))))
+ (check-edit-tree '((0 15 0 9 1.0 0.0 0.0 0) (10 15 10 24 1.0 1.0 -0.025000000372529 4) (25 13 25 49 1.0 0.625 -0.025000000372529 4)
+ (50 14 0 0 1.0 1.0 -0.100000001490116 6) (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 6)
+ (60 13 60 69 1.0 0.0 0.111111111938953 6) (70 13 70 74 1.0 0.512820541858673 0.0256410259753466 4)
+ (75 16 0 14 1.0 0.64102566242218 0.0256410259753466 4) (90 16 15 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env on env 2" #__line__)
+ (env-channel (make-env '(0 1 1 0 2 1) :length 20) 50 20)
+ (let ((e (make-env '(0 1 1 0 2 1) :length 20)))
+ (do ((i 50 (+ i 1)))
+ ((= i 70))
+ (set! (vals i) (* (env e) (vals i)))))
+ (check-edit-tree '((0 15 0 9 1.0 0.0 0.0 0) (10 15 10 24 1.0 1.0 -0.025000000372529 4) (25 13 25 49 1.0 0.625 -0.025000000372529 4)
+ (50 14 0 0 1.0 1.0 -0.100000001490116 10) (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 10)
+ (60 13 60 69 1.0 0.0 0.111111111938953 10) (70 13 70 74 1.0 0.512820541858673 0.0256410259753466 4)
+ (75 16 0 14 1.0 0.64102566242218 0.0256410259753466 4) (90 16 15 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env on env 3" #__line__)
+ (delete-samples 10 20)
+ (insert-silence 10 20)
+ (fill! vals 0.0 10 30)
+ (check-edit-tree '((0 15 0 9 1.0 0.0 0.0 0) (10 -1 0 19 0.0 0.0 0.0 2) (30 13 30 49 1.0 0.5 -0.025000000372529 4)
+ (50 14 0 0 1.0 1.0 -0.100000001490116 10) (51 13 51 59 1.0 0.899999976158142 -0.100000001490116 10)
+ (60 13 60 69 1.0 0.0 0.111111111938953 10) (70 13 70 74 1.0 0.512820541858673 0.0256410259753466 4)
+ (75 16 0 14 1.0 0.64102566242218 0.0256410259753466 4) (90 16 15 24 1.0 0.0 0.0 0) (100 -2 0 0 0.0 0.0 0.0 0))
+ vals "env preclobbered" #__line__)
+ (close-sound ind))
+
+ (for-each
+ (lambda (dur)
+ (let ((i1 (new-sound))
+ (v (make-float-vector dur 1.0)))
+ (define (check-env name r e)
+ (let ((v0 (make-float-vector dur))
+ (v1 (make-float-vector dur)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (set! (v0 i) (read-sample r)))
+ (if (env? e)
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (float-vector-set! v1 i (env e)))
+ (if (sampler? e)
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (float-vector-set! v1 i (read-sample e)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (float-vector-set! v1 i (e)))))
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ ";~A env check [~A]: ~A ~A" name r rv ev))))
+
+ (float-vector->channel v)
+ (env-sound '(0 0 1 1))
+ (check-env 'ramp (make-sampler 0) (make-env '(0 0 1 1) :length dur))
+ (reverse-channel)
+ (check-env 'rev-ramp (make-sampler 0) (make-env '(0 1 1 0) :length dur))
+ (undo 2)
+ (env-sound '(0 0 1 1 2 0))
+ (check-env 'ramp (make-sampler 0) (make-env '(0 0 1 1 2 0) :length dur))
+ (let ((cur-read (make-sampler 0)))
(reverse-channel)
- (check-env 'rev-ramp (make-sampler 0) (make-env '(0 1 1 0) :length dur))
- (undo 2)
- (env-sound '(0 0 1 1 2 0))
- (check-env 'ramp (make-sampler 0) (make-env '(0 0 1 1 2 0) :length dur))
- (let ((cur-read (make-sampler 0)))
- (reverse-channel)
- (let ((rev-read (make-sampler (- dur 1) i1 0 -1)))
- (check-env 'rev-pyr cur-read rev-read)))
- (undo 2)
- (env-sound '(0 0 1 1 2 0 3 1))
- (check-env '3-ramp (make-sampler 0) (make-env '(0 0 1 1 2 0 3 1) :length dur))
- (let ((cur-read (make-sampler 0)))
- (reverse-channel)
- (let ((rev-read (make-sampler (- dur 1) i1 0 -1)))
- (check-env 'rev-pyr cur-read rev-read)))
- (undo 2)
- (env-sound '(0 0 1 1 2 1 3 0))
- (check-env 'sqoff (make-sampler 0) (make-env '(0 0 1 1 2 1 3 0) :length dur))
- (undo 1)
- (env-sound '(0 0 1 .5 2 .5 3 0))
- (check-env '5sqoff (make-sampler 0) (make-env '(0 0 1 .5 2 .5 3 0) :length dur))
- (undo 1)
- (scale-channel .5)
- (env-sound '(0 0 1 1))
- (check-env 'scl-ramp (make-sampler 0) (make-env '(0 0 1 1) :length dur :scaler .5))
+ (let ((rev-read (make-sampler (- dur 1) i1 0 -1)))
+ (check-env 'rev-pyr cur-read rev-read)))
+ (undo 2)
+ (env-sound '(0 0 1 1 2 0 3 1))
+ (check-env '3-ramp (make-sampler 0) (make-env '(0 0 1 1 2 0 3 1) :length dur))
+ (let ((cur-read (make-sampler 0)))
(reverse-channel)
- (check-env 'scl-rev-ramp (make-sampler 0) (make-env '(0 1 1 0) :length dur :scaler .5))
- (undo 2)
- (env-sound '(0 0 1 1 2 0))
- (check-env 'scl-3-ramp (make-sampler 0) (make-env '(0 0 1 1 2 0) :length dur :scaler .5))
- (let ((cur-read (make-sampler 0)))
- (reverse-channel)
- (let ((rev-read (make-sampler (- dur 1) i1 0 -1)))
- (check-env 'scl-rev-pyr cur-read rev-read)))
- (undo 3)
- (if (= dur 10000)
- (begin
- (for-each
- (lambda (beg local-dur)
- (env-sound '(0 0 1 1 2 0))
- (scale-channel .5 beg local-dur)
- (check-env 'env+scl
- (make-sampler 0)
- (let ((e (make-env '(0 0 1 1 2 0) :length dur))
- (ctr 0))
- (lambda ()
- (let ((val (env e)))
- (set! ctr (+ 1 ctr))
- (if (and (> ctr beg)
- (<= ctr (+ beg local-dur)))
- (* val .5)
- val)))))
- (undo 2))
- (list 0 0 1000 1000 4000 5000 6000 5000)
- (list 1000 6000 1000 4000 2000 1000 1000 5000))))
- (if (= dur 10000)
- (begin
- (for-each
- (lambda (env-beg env-dur scl-beg scl-dur)
- (env-channel '(0 0 1 1 2 1 3 0) env-beg env-dur)
- (scale-channel .5 scl-beg scl-dur)
- (check-env 'env+scl-partial
- (make-sampler 0)
- (let ((e (make-env '(0 0 1 1 2 1 3 0) :length env-dur))
- (ctr 0))
- (lambda ()
- (let ((val 1.0))
- (set! ctr (+ 1 ctr))
- (if (and (> ctr env-beg)
- (<= ctr (+ env-beg env-dur)))
- (set! val (* val (env e))))
- (if (and (> ctr scl-beg)
- (<= ctr (+ scl-beg scl-dur)))
- (set! val (* val 0.5)))
- val))))
- (undo 2))
- (list 0 0 1000 1000 4000 5000 6000 5000)
- (list 1000 6000 1000 4000 2000 1000 1000 5000)
- (list 500 0 0 2000 5000 4000 0 8000)
- (list 200 10000 1500 1000 500 2000 2000 2000))))
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1))
- (check-env 'unenv-ramp
- (make-sampler 0)
- (let ((e (make-env '(0 0 1 1) :length dur)))
- (lambda ()
- (let ((val (env e)))
- (* val val)))))
- (undo 2)
- (env-sound '(0 0 1 1))
- (let ((v1 (vct-fill! (make-vct 3) 1.0)))
- (vct->channel v1 3 3)
- (let ((vals (channel->vct 0 10)))
- (if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display #__line__ "; 1 vals: ~A" vals))))
- (undo 2)
- (env-sound '(0 0 1 1))
- (let ((v1 (vct-fill! (make-vct 3) 1.0)))
- (delete-samples 3 3)
- (insert-samples 3 3 v1)
- (let ((vals (channel->vct 0 10)))
- (if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display #__line__ "; 2 vals: ~A" vals))))
- (undo 3)
- (env-sound '(0 0 1 1))
- (let ((v1 (vct-fill! (make-vct 3) 1.0)))
- (insert-samples 3 3 v1)
- (delete-samples 3 3))
- (check-env '5-ramp (make-sampler 0) (make-env '(0 0 1 1) :length dur))
- (undo 3)
- (env-sound '(0 0 1 1 2 0))
- (let ((v1 (vct-fill! (make-vct 3) 1.0)))
- (if (= dur 10)
- (begin
- (vct->channel v1 3 3)
- (let ((vals (channel->vct 0 10)))
- (if (not (vequal vals (vct 0.0 .2 .4 1 1 1 .75 .5 .25 0)))
- (snd-display #__line__ "; 4 vals (~A): ~A" dur vals))))
- (begin
- (vct-fill! v1 0.0)
- (vct->channel v1 4998 3)
- (let ((vals (channel->vct 4995 10)))
- (if (not (vequal vals (vct 0.999 0.999 1.000 0.000 0.000 0.000 1.000 0.999 0.999 0.999)))
- (snd-display #__line__ "; 4 vals big: ~A" vals))))))
- (undo 2)
+ (let ((rev-read (make-sampler (- dur 1) i1 0 -1)))
+ (check-env 'rev-pyr cur-read rev-read)))
+ (undo 2)
+ (env-sound '(0 0 1 1 2 1 3 0))
+ (check-env 'sqoff (make-sampler 0) (make-env '(0 0 1 1 2 1 3 0) :length dur))
+ (undo 1)
+ (env-sound '(0 0 1 .5 2 .5 3 0))
+ (check-env '5sqoff (make-sampler 0) (make-env '(0 0 1 .5 2 .5 3 0) :length dur))
+ (undo 1)
+ (scale-channel .5)
+ (env-sound '(0 0 1 1))
+ (check-env 'scl-ramp (make-sampler 0) (make-env '(0 0 1 1) :length dur :scaler .5))
+ (reverse-channel)
+ (check-env 'scl-rev-ramp (make-sampler 0) (make-env '(0 1 1 0) :length dur :scaler .5))
+ (undo 2)
+ (env-sound '(0 0 1 1 2 0))
+ (check-env 'scl-3-ramp (make-sampler 0) (make-env '(0 0 1 1 2 0) :length dur :scaler .5))
+ (let ((cur-read (make-sampler 0)))
+ (reverse-channel)
+ (let ((rev-read (make-sampler (- dur 1) i1 0 -1)))
+ (check-env 'scl-rev-pyr cur-read rev-read)))
+ (undo 3)
+ (when (= dur 10000)
+ (for-each
+ (lambda (beg local-dur)
+ (let ((bend (+ beg local-dur 1)))
+ (env-sound '(0 0 1 1 2 0))
+ (scale-channel .5 beg local-dur)
+ (check-env 'env+scl
+ (make-sampler 0)
+ (let ((e (make-env '(0 0 1 1 2 0) :length dur))
+ (ctr 0))
+ (lambda ()
+ (let ((val (env e)))
+ (set! ctr (+ ctr 1))
+ (if (< beg ctr bend)
+ (* val .5)
+ val)))))
+ (undo 2)))
+ (list 0 0 1000 1000 4000 5000 6000 5000)
+ (list 1000 6000 1000 4000 2000 1000 1000 5000)))
+ (if (= dur 10000)
+ (for-each
+ (lambda (env-beg env-dur scl-beg scl-dur)
+ (let ((eend (+ env-beg env-dur 1))
+ (send (+ scl-beg scl-dur 1)))
+ (env-channel '(0 0 1 1 2 1 3 0) env-beg env-dur)
+ (scale-channel .5 scl-beg scl-dur)
+ (check-env 'env+scl-partial
+ (make-sampler 0)
+ (let ((e (make-env '(0 0 1 1 2 1 3 0) :length env-dur))
+ (ctr 0))
+ (lambda ()
+ (let ((val 1.0))
+ (set! ctr (+ ctr 1))
+ (if (< env-beg ctr eend)
+ (set! val (env e)))
+ (if (< scl-beg ctr send)
+ (set! val (* val 0.5)))
+ val))))
+ (undo 2)))
+ (list 0 0 1000 1000 4000 5000 6000 5000)
+ (list 1000 6000 1000 4000 2000 1000 1000 5000)
+ (list 500 0 0 2000 5000 4000 0 8000)
+ (list 200 10000 1500 1000 500 2000 2000 2000)))
+ (env-sound '(0 0 1 1))
+ (env-sound '(0 0 1 1))
+ (check-env 'unenv-ramp
+ (make-sampler 0)
+ (let ((e (make-env '(0 0 1 1) :length dur)))
+ (lambda ()
+ (let ((val (env e)))
+ (* val val)))))
+ (undo 2)
+ (env-sound '(0 0 1 1))
+ (let ((v1 (make-float-vector 3 1.0)))
+ (float-vector->channel v1 3 3)
+ (let ((vals (channel->float-vector 0 10)))
+ (if (not (vequal vals (float-vector 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
+ (snd-display #__line__ "; 1 vals: ~A" vals))))
+ (undo 2)
+ (env-sound '(0 0 1 1))
+ (let ((v1 (make-float-vector 3 1.0)))
+ (delete-samples 3 3)
+ (insert-samples 3 3 v1)
+ (let ((vals (channel->float-vector 0 10)))
+ (if (not (vequal vals (float-vector 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
+ (snd-display #__line__ "; 2 vals: ~A" vals))))
+ (undo 3)
+ (env-sound '(0 0 1 1))
+ (let ((v1 (make-float-vector 3 1.0)))
+ (insert-samples 3 3 v1)
+ (delete-samples 3 3))
+ (check-env '5-ramp (make-sampler 0) (make-env '(0 0 1 1) :length dur))
+ (undo 3)
+ (env-sound '(0 0 1 1 2 0))
+ (let ((v1 (make-float-vector 3 1.0)))
(if (= dur 10)
(begin
- (env-sound '(0 0 1 1 2 0))
- (let ((v1 (vct-fill! (make-vct 3) 1.0)))
- (delete-samples 3 3)
- (insert-samples 3 3 v1)
- (let ((vals (channel->vct 0 10)))
- (if (not (vequal vals (vct 0.0 .2 .4 1 1 1 .75 .5 .25 0)))
- (snd-display #__line__ "; 2 vals: ~A" vals))))
- (undo 3)
- (env-sound '(0 0 1 1 2 0))
- (let ((v1 (vct-fill! (make-vct 3) 1.0)))
- (vct->channel v1 0 3)
- (let ((vals (channel->vct 0 10)))
- (if (not (vequal vals (vct 1.000 1.000 1.000 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
- (snd-display #__line__ "; 4 vals: ~A" vals))))
- (undo 2)
- (env-sound '(0 0 1 1 2 0))
- (let ((v1 (vct-fill! (make-vct 3) 1.0)))
- (vct->channel v1 7 3)
- (let ((vals (channel->vct 0 10)))
- (if (not (vequal vals (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.750 1.000 1.000 1.000)))
- (snd-display #__line__ "; 5 vals: ~A" vals))))
- (undo 2)))
- (let ((file (file-name i1)))
- (close-sound i1)
- (if (file-exists? file) (delete-file file)))
- ))
- (list 10 10000))
-
- (let ((ind (new-sound "fmv.snd" mus-next mus-bfloat 22050 1 "envd edit trees"))
- (vals (make-vct 10000)))
- (select-sound ind)
- (select-channel 0)
- (check-edit-tree '((0 0 0 0 0.0 0.0 0.0 1) (1 -2 0 0 0.0 0.0 0.0 0)) (make-vct 1) "initial new-sound")
- (vct-fill! vals 1.0)
- (set! (samples 0 10000) vals)
- (check-edit-tree '((0 1 0 9999 1.0 0.0 0.0 0) (10000 -2 0 0 0.0 0.0 0.0 0)) vals "envd set first samps to one")
- (env-sound '(0 0 1 1))
- (let ((e (make-env '(0 0 1 1) :length 10000)))
- (vct-map! vals (lambda () (e))))
- (check-edit-tree '((0 1 0 9999 1.0 0.0 1.00010001915507e-4 4) (10000 -2 0 0 0.0 0.0 0.0 0))
- vals "env frag '(0 0 1 1)")
- (delete-samples 1000 1000)
- (let ((v1 (make-vct 9000)))
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (vct-set! v1 i (vct-ref vals i)))
- (do ((i 1000 (+ 1 i))
- (j 2000 (+ 1 j)))
- ((= i 9000))
- (vct-set! v1 i (vct-ref vals j)))
- (check-edit-tree '((0 1 0 999 1.0 0.0 1.00010001915507e-4 4) (1000 1 2000 9999 1.0 0.200020000338554 1.00010001915507e-4 4) (9000 -2 0 0 0.0 0.0 0.0 0))
- v1 "env frag del"))
- (undo 1)
- (delete-samples 9000 1000)
- (insert-samples 3000 1000 (make-vct 1000))
- (do ((i 9999 (- i 1)))
- ((< i 4000))
- (vct-set! vals i (vct-ref vals (- i 1000))))
- (do ((i 3000 (+ 1 i)))
- ((= i 4000))
- (vct-set! vals i 0.0))
- (check-edit-tree '((0 1 0 2999 1.0 0.0 1.00010001915507e-4 4) (3000 2 0 999 1.0 0.0 0.0 0)
- (4000 1 3000 8999 1.0 0.300029993057251 1.00010001915507e-4 4) (10000 -2 0 0 0.0 0.0 0.0 0))
- vals "envd ins/del")
- (delete-samples 0 1000)
- (insert-samples 0 1000 (make-vct 1000))
- (do ((i 0 (+ 1 i)))
+ (float-vector->channel v1 3 3)
+ (let ((vals (channel->float-vector 0 10)))
+ (if (not (vequal vals (float-vector 0.0 .2 .4 1 1 1 .75 .5 .25 0)))
+ (snd-display #__line__ "; 4 vals (~A): ~A" dur vals))))
+ (begin
+ (fill! v1 0.0)
+ (float-vector->channel v1 4998 3)
+ (let ((vals (channel->float-vector 4995 10)))
+ (if (not (vequal vals (float-vector 0.999 0.999 1.000 0.000 0.000 0.000 1.000 0.999 0.999 0.999)))
+ (snd-display #__line__ "; 4 vals big: ~A" vals))))))
+ (undo 2)
+ (if (= dur 10)
+ (begin
+ (env-sound '(0 0 1 1 2 0))
+ (let ((v1 (make-float-vector 3 1.0)))
+ (delete-samples 3 3)
+ (insert-samples 3 3 v1)
+ (let ((vals (channel->float-vector 0 10)))
+ (if (not (vequal vals (float-vector 0.0 .2 .4 1 1 1 .75 .5 .25 0)))
+ (snd-display #__line__ "; 2 vals: ~A" vals))))
+ (undo 3)
+ (env-sound '(0 0 1 1 2 0))
+ (let ((v1 (make-float-vector 3 1.0)))
+ (float-vector->channel v1 0 3)
+ (let ((vals (channel->float-vector 0 10)))
+ (if (not (vequal vals (float-vector 1.000 1.000 1.000 0.600 0.800 1.000 0.750 0.500 0.250 0.000)))
+ (snd-display #__line__ "; 4 vals: ~A" vals))))
+ (undo 2)
+ (env-sound '(0 0 1 1 2 0))
+ (let ((v1 (make-float-vector 3 1.0)))
+ (float-vector->channel v1 7 3)
+ (let ((vals (channel->float-vector 0 10)))
+ (if (not (vequal vals (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.750 1.000 1.000 1.000)))
+ (snd-display #__line__ "; 5 vals: ~A" vals))))
+ (undo 2)))
+ (let ((file (file-name i1)))
+ (close-sound i1)
+ (if (file-exists? file) (delete-file file)))
+ ))
+ (list 10 10000))
+
+ (let ((ind (new-sound "fmv.snd" 1 22050 mus-ldouble mus-next "envd edit trees"))
+ (vals (make-float-vector 10000)))
+ (select-sound ind)
+ (select-channel 0)
+ (check-edit-tree '((0 0 0 0 0.0 0.0 0.0 1) (1 -2 0 0 0.0 0.0 0.0 0)) (make-float-vector 1) "initial new-sound" #__line__)
+ (fill! vals 1.0)
+ (set! (samples 0 10000) vals)
+ (check-edit-tree '((0 1 0 9999 1.0 0.0 0.0 0) (10000 -2 0 0 0.0 0.0 0.0 0)) vals "envd set first samps to one" #__line__)
+ (env-sound '(0 0 1 1))
+ (let ((e (make-env '(0 0 1 1) :length 10000)))
+ (fill-float-vector vals (env e)))
+ (check-edit-tree '((0 1 0 9999 1.0 0.0 1.00010001915507e-4 4) (10000 -2 0 0 0.0 0.0 0.0 0))
+ vals "env frag '(0 0 1 1)" #__line__)
+ (delete-samples 1000 1000)
+ (let ((v1 (make-float-vector 9000)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (vct-set! vals i 0.0))
- (check-edit-tree '((0 3 0 999 1.0 0.0 0.0 0) (1000 1 1000 2999 1.0 0.100010000169277 1.00010001915507e-4 4)
- (3000 2 0 999 1.0 0.0 0.0 0) (4000 1 3000 8999 1.0 0.300029993057251 1.00010001915507e-4 4) (10000 -2 0 0 0.0 0.0 0.0 0))
- vals "envd predel")
- (scale-by 0.5)
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (vct-set! vals i (* (vct-ref vals i) 0.5)))
- (check-edit-tree '((0 3 0 999 0.5 0.0 0.0 0) (1000 1 1000 2999 0.5 0.100010000169277 1.00010001915507e-4 4)
- (3000 2 0 999 0.5 0.0 0.0 0) (4000 1 3000 8999 0.5 0.300029993057251 1.00010001915507e-4 4) (10000 -2 0 0 0.0 0.0 0.0 0))
- vals "envd scl")
- (reverse-channel)
- (do ((i 0 (+ 1 i))
- (j 9999 (- j 1)))
- ((= i 5000))
- (let ((temp (vct-ref vals i)))
- (vct-set! vals i (vct-ref vals j))
- (vct-set! vals j temp)))
- (check-edit-tree '((0 4 0 9999 1.0 0.0 0.0 0) (10000 -2 0 0 0.0 0.0 0.0 0))
- vals "envd rev")
-
- (revert-sound ind)
- (set! vals (make-vct 100000))
- (vct-fill! vals 1.0)
- (vct->channel vals 0 100000)
- (env-channel (make-env '(0 0 1 1 2 0) :length 10000) 30000 10000)
- (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
- (do ((i 30000 (+ 1 i)))
- ((= i 40000))
- (vct-set! vals i (env e))))
- (check-edit-tree '((0 1 0 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 4)
- (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 4) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
- vals "partial env")
- (scale-channel .5 10000 10000)
- (env-channel (make-env '(0 0 1 1 2 0) :length 10000) 30000 10000) ; env over env
- (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
- (do ((i 30000 (+ 1 i)))
- ((= i 40000))
- (vct-set! vals i (* (vct-ref vals i) (env e)))))
- (do ((i 10000 (+ 1 i)))
- ((= i 20000))
- (vct-set! vals i (* (vct-ref vals i) 0.5)))
- (check-edit-tree '((0 1 0 9999 1.0 0.0 0.0 0) (10000 1 10000 19999 0.5 0.0 0.0 0) (20000 1 20000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
- vals "env over env")
- (env-channel (make-env '(0 0 1 1 2 0) :length 10000) 5000 10000) ; env over scl
- (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
- (do ((i 5000 (+ 1 i)))
- ((= i 15000))
- (vct-set! vals i (* (vct-ref vals i) (env e)))))
- (check-edit-tree '((0 1 0 4999 1.0 0.0 0.0 0) (5000 1 5000 9999 1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 0.5 0.0 0.0 0) (20000 1 20000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
- vals "env over scl")
- (ramp-channel .5 -.5 25000 1000)
- (let ((e (make-env '(0 .5 1 -.5) :length 1000)))
- (do ((i 25000 (+ 1 i)))
- ((= i 26000))
- (vct-set! vals i (* (vct-ref vals i) (env e)))))
- (check-edit-tree '((0 1 0 4999 1.0 0.0 0.0 0) (5000 1 5000 9999 1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 0.5 0.0 0.0 0) (20000 1 20000 24999 1.0 0.0 0.0 0) (25000 1 25000 25999 1.0 0.5 -0.00100100098643452 4) (26000 1 26000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
- vals "ramp")
- (scale-by -1.0)
- (vct-scale! vals -1.0)
- (check-edit-tree '((0 1 0 4999 -1.0 0.0 0.0 0) (5000 1 5000 9999 -1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 -0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 -0.5 0.0 0.0 0) (20000 1 20000 24999 -1.0 0.0 0.0 0) (25000 1 25000 25999 -1.0 0.5 -0.00100100098643452 4) (26000 1 26000 29999 -1.0 0.0 0.0 0) (30000 1 30000 34999 -1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 -1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 -1.0 0.0 0.0 0) (100000 -2 0 0 -0.0 0.0 0.0 0))
- vals "invert")
- (let ((reader (make-sampler 0 ind 0 1 (- (edit-position) 1))))
- (map-channel (lambda (y)
- (+ (reader) y)))
- (check-edit-tree '((0 2 0 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
- (make-vct 100000) "invert and add")
- (if (fneq (maxamp) 0.0) (snd-display #__line__ ";invert-and-add maxamp: ~A" (maxamp))))
-
- (undo 1)
- (ramp-channel -1.0 1.0 50000 30000)
- (let ((e (make-env '(0 -1.0 1 1.0) :length 30000)))
- (do ((i 50000 (+ 1 i)))
- ((= i 80000))
- (vct-set! vals i (* (vct-ref vals i) (env e)))))
- (check-edit-tree '((0 1 0 4999 -1.0 0.0 0.0 0) (5000 1 5000 9999 -1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 -0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 -0.5 0.0 0.0 0) (20000 1 20000 24999 -1.0 0.0 0.0 0) (25000 1 25000 25999 -1.0 0.5 -0.00100100098643452 4) (26000 1 26000 29999 -1.0 0.0 0.0 0) (30000 1 30000 34999 -1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 -1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 49999 -1.0 0.0 0.0 0) (50000 1 50000 79999 -1.0 -1.0 6.66688865749165e-5 4) (80000 1 80000 99999 -1.0 0.0 0.0 0) (100000 -2 0 0 -0.0 0.0 0.0 0))
- vals "ramp")
- (env-sound '(0 0 1 1))
- (reverse-channel)
- (delete-samples 1 99999)
- (if (fneq (sample 0) -1.0) (snd-display #__line__ ";sample at end: ~A" (sample 0)))
- (if (not (= (frames) 1)) (snd-display #__line__ ";length at end: ~A" (frames)))
- (check-edit-tree '((0 2 0 0 1.0 0.0 0.0 0) (1 -2 0 0 0.0 0.0 0.0 0))
- (vct-fill! (make-vct 1) -1.0) "at end")
- (close-sound ind))
+ (set! (v1 i) (vals i)))
+ (do ((i 1000 (+ i 1))
+ (j 2000 (+ j 1)))
+ ((= i 9000))
+ (set! (v1 i) (vals j)))
+ (check-edit-tree '((0 1 0 999 1.0 0.0 1.00010001915507e-4 4) (1000 1 2000 9999 1.0 0.200020000338554 1.00010001915507e-4 4) (9000 -2 0 0 0.0 0.0 0.0 0))
+ v1 "env frag del" #__line__))
+ (undo 1)
+ (delete-samples 9000 1000)
+ (insert-samples 3000 1000 (make-float-vector 1000))
+ (do ((i 9999 (- i 1)))
+ ((< i 4000))
+ (set! (vals i) (vals (- i 1000))))
+ (fill! vals 0.0 3000 4000)
+ (check-edit-tree '((0 1 0 2999 1.0 0.0 1.00010001915507e-4 4) (3000 2 0 999 1.0 0.0 0.0 0)
+ (4000 1 3000 8999 1.0 0.300029993057251 1.00010001915507e-4 4) (10000 -2 0 0 0.0 0.0 0.0 0))
+ vals "envd ins/del" #__line__)
+ (delete-samples 0 1000)
+ (insert-samples 0 1000 (make-float-vector 1000))
+ (fill! vals 0.0 0 1000)
+ (check-edit-tree '((0 3 0 999 1.0 0.0 0.0 0) (1000 1 1000 2999 1.0 0.100010000169277 1.00010001915507e-4 4)
+ (3000 2 0 999 1.0 0.0 0.0 0) (4000 1 3000 8999 1.0 0.300029993057251 1.00010001915507e-4 4) (10000 -2 0 0 0.0 0.0 0.0 0))
+ vals "envd predel" #__line__)
+ (scale-by 0.5)
+ (float-vector-scale! vals 0.5)
+ (check-edit-tree '((0 3 0 999 0.5 0.0 0.0 0) (1000 1 1000 2999 0.5 0.100010000169277 1.00010001915507e-4 4)
+ (3000 2 0 999 0.5 0.0 0.0 0) (4000 1 3000 8999 0.5 0.300029993057251 1.00010001915507e-4 4) (10000 -2 0 0 0.0 0.0 0.0 0))
+ vals "envd scl" #__line__)
+ (reverse-channel)
+ (do ((i 0 (+ i 1))
+ (j 9999 (- j 1)))
+ ((= i 5000))
+ (let ((temp (vals i)))
+ (set! (vals i) (vals j))
+ (set! (vals j) temp)))
+ (check-edit-tree '((0 4 0 9999 1.0 0.0 0.0 0) (10000 -2 0 0 0.0 0.0 0.0 0))
+ vals "envd rev" #__line__)
- ;; a special case that catches the round-off problem
- (let ((ind (open-sound "oboe.snd")))
- (env-channel '(0.0 0.984011617147162 0.644050741979388 0.110976689002195 1.17272046995914 0.384709990674106
- 1.25650287720397 0.551452668245628 1.4389507801877 0.843827758574229 2.16614272265275 0.226832341237953))
- (let ((val (sample 50827)))
- (if (or (not (number? val))
- (fneq val 0.0))
- (snd-display #__line__ ";round-off env: ~A" val)))
- (check-edit-tree '((0 0 0 15111 1.0 0.984011590480804 -5.77709688514005e-5 4) (15112 0 15112 27516 1.0 0.110976688563824 2.20663678192068e-5 4) (27517 0 27517 29482 1.0 0.384709984064102 8.4813182184007e-5 4) (29483 0 29483 33763 1.0 0.551452696323395 6.82959798723459e-5 4) (33764 0 33764 50827 1.0 0.843827784061432 -3.61598467861768e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "round-off test")
- (revert-sound ind)
- (map-channel (lambda (y) 1.0))
- (env-channel '(0 0 1 1 2 0))
- (scale-channel .5 1000 1000)
- (let ((val (sample 800)))
- (if (fneq val .0314)
- (snd-display #__line__ ";scl on env trouble: ~A" val)))
- (check-edit-tree '((0 1 0 999 1.0 0.0 3.93483896914404e-5 4) (1000 1 1000 1999 0.5 0.0393483899533749 3.93483896914404e-5 4) (2000 1 2000 25413 1.0 0.0786967799067497 3.93483896914404e-5 4) (25414 1 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "scl on env")
- (revert-sound ind)
- (map-channel (lambda (y) 1.0))
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (let ((val (sample 20000)))
- (if (fneq val (expt (/ 20000.0 50828) 3))
- (snd-display #__line__ ";ramp-channels piled up: ~A" val)))
- (check-edit-tree '((0 1 0 50827 1.0 0.0 1.96745822904631e-5 10) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "ramp upon ramp")
- (revert-sound ind)
-
- (map-channel (lambda (y) 1.0))
- (ramp-channel 0.5 1.0) ; val = 0.5 + (20000/50828)*0.5
- (ramp-channel 0.0 0.5) ; val * (20000/50828)*0.5
- (ramp-channel 0.1 0.4) ; val * (0.1 + (20000/50828)*0.3)
- (let* ((val (sample 20000))
- (ratio (/ 20000.0 50828))
- (val1 (+ 0.5 (* 0.5 ratio)))
- (val2 (* val1 (* 0.5 ratio)))
- (val3 (* val2 (+ 0.1 (* ratio 0.3)))))
- (if (fneq val val3)
- (snd-display #__line__ ";ramp-channels piled up (2): ~A ~A" val val3)))
-
- (revert-sound ind)
- (env-channel '(0 0 1 1 2 0))
- (check-edit-tree '((0 0 0 25413 1.0 0.0 3.93483896914404e-5 4) (25414 0 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "env+scl 0")
- (scale-channel .5 0 1000)
- (check-edit-tree '((0 0 0 999 0.5 0.0 3.93483896914404e-5 4) (1000 0 1000 25413 1.0 0.0393483899533749 3.93483896914404e-5 4) (25414 0 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "env+scl 1")
- (undo)
- (scale-channel .5 1000 1000)
- (check-edit-tree '((0 0 0 999 1.0 0.0 3.93483896914404e-5 4) (1000 0 1000 1999 0.5 0.0393483899533749 3.93483896914404e-5 4) (2000 0 2000 25413 1.0 0.0786967799067497 3.93483896914404e-5 4) (25414 0 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "env+scl 2")
- (undo)
- (scale-channel .5 0 25415)
- (check-edit-tree '((0 0 0 25413 0.5 0.0 3.93483896914404e-5 4) (25414 0 25414 25414 0.5 1.0 -3.93499394704122e-5 4) (25415 0 25415 50827 1.0 0.999960660934448 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "env+scl 3")
- (undo)
- (scale-channel .5 20000 10000)
- (check-edit-tree '((0 0 0 19999 1.0 0.0 3.93483896914404e-5 4) (20000 0 20000 25413 0.5 0.786967813968658 3.93483896914404e-5 4) (25414 0 25414 29999 0.5 1.0 -3.93499394704122e-5 4) (30000 0 30000 50827 1.0 0.819541156291962 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "env+scl 4")
- (undo)
- (scale-channel .5 30000 1000)
- (check-edit-tree '((0 0 0 25413 1.0 0.0 3.93483896914404e-5 4) (25414 0 25414 29999 1.0 1.0 -3.93499394704122e-5 4) (30000 0 30000 30999 0.5 0.819541156291962 -3.93499394704122e-5 4) (31000 0 31000 50827 1.0 0.780191242694855 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "env+scl 5")
- (undo)
- (scale-channel .5 25415 1000)
- (check-edit-tree '((0 0 0 25413 1.0 0.0 3.93483896914404e-5 4) (25414 0 25414 25414 1.0 1.0 -3.93499394704122e-5 4) (25415 0 25415 26414 0.5 0.999960660934448 -3.93499394704122e-5 4) (26415 0 26415 50827 1.0 0.960610687732697 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "env+scl 6")
- (undo)
- (scale-channel .5 40000 10828)
- (check-edit-tree '((0 0 0 25413 1.0 0.0 3.93483896914404e-5 4) (25414 0 25414 39999 1.0 1.0 -3.93499394704122e-5 4) (40000 0 40000 50827 0.5 0.426041781902313 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "env+scl 7")
+ (revert-sound ind)
+ (set! vals (make-float-vector 100000))
+ (fill! vals 1.0)
+ (float-vector->channel vals 0 100000)
+ (env-channel (make-env '(0 0 1 1 2 0) :length 10000) 30000 10000)
+ (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
+ (do ((i 30000 (+ i 1)))
+ ((= i 40000))
+ (float-vector-set! vals i (env e))))
+ (check-edit-tree '((0 1 0 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 4)
+ (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 4) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
+ vals "partial env" #__line__)
+ (scale-channel .5 10000 10000)
+ (env-channel (make-env '(0 0 1 1 2 0) :length 10000) 30000 10000) ; env over env
+ (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
+ (do ((i 30000 (+ i 1)))
+ ((= i 40000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) (env e)))))
+ (do ((i 10000 (+ i 1)))
+ ((= i 20000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) 0.5)))
+ (check-edit-tree '((0 1 0 9999 1.0 0.0 0.0 0) (10000 1 10000 19999 0.5 0.0 0.0 0) (20000 1 20000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
+ vals "env over env" #__line__)
+ (env-channel (make-env '(0 0 1 1 2 0) :length 10000) 5000 10000) ; env over scl
+ (let ((e (make-env '(0 0 1 1 2 0) :length 10000)))
+ (do ((i 5000 (+ i 1)))
+ ((= i 15000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) (env e)))))
+ (check-edit-tree '((0 1 0 4999 1.0 0.0 0.0 0) (5000 1 5000 9999 1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 0.5 0.0 0.0 0) (20000 1 20000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
+ vals "env over scl" #__line__)
+ (ramp-channel .5 -.5 25000 1000)
+ (let ((e (make-env '(0 .5 1 -.5) :length 1000)))
+ (do ((i 25000 (+ i 1)))
+ ((= i 26000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) (env e)))))
+ (check-edit-tree '((0 1 0 4999 1.0 0.0 0.0 0) (5000 1 5000 9999 1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 0.5 0.0 0.0 0) (20000 1 20000 24999 1.0 0.0 0.0 0) (25000 1 25000 25999 1.0 0.5 -0.00100100098643452 4) (26000 1 26000 29999 1.0 0.0 0.0 0) (30000 1 30000 34999 1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
+ vals "ramp" #__line__)
+ (scale-by -1.0)
+ (float-vector-scale! vals -1.0)
+ (check-edit-tree '((0 1 0 4999 -1.0 0.0 0.0 0) (5000 1 5000 9999 -1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 -0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 -0.5 0.0 0.0 0) (20000 1 20000 24999 -1.0 0.0 0.0 0) (25000 1 25000 25999 -1.0 0.5 -0.00100100098643452 4) (26000 1 26000 29999 -1.0 0.0 0.0 0) (30000 1 30000 34999 -1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 -1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 99999 -1.0 0.0 0.0 0) (100000 -2 0 0 -0.0 0.0 0.0 0))
+ vals "invert" #__line__)
+ (let ((reader (make-sampler 0 ind 0 1 (- (edit-position) 1))))
+ (map-channel (lambda (y)
+ (+ (next-sample reader) y)))
+ (check-edit-tree '((0 2 0 99999 1.0 0.0 0.0 0) (100000 -2 0 0 0.0 0.0 0.0 0))
+ (make-float-vector 100000) "invert and add" #__line__)
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";invert-and-add maxamp: ~A" (maxamp))))
+
+ (undo 1)
+ (ramp-channel -1.0 1.0 50000 30000)
+ (let ((e (make-env '(0 -1.0 1 1.0) :length 30000)))
+ (do ((i 50000 (+ i 1)))
+ ((= i 80000))
+ (float-vector-set! vals i (* (float-vector-ref vals i) (env e)))))
+ (check-edit-tree '((0 1 0 4999 -1.0 0.0 0.0 0) (5000 1 5000 9999 -1.0 0.0 1.99999994947575e-4 4) (10000 1 10000 14999 -0.5 1.0 -2.00040012714453e-4 4) (15000 1 15000 19999 -0.5 0.0 0.0 0) (20000 1 20000 24999 -1.0 0.0 0.0 0) (25000 1 25000 25999 -1.0 0.5 -0.00100100098643452 4) (26000 1 26000 29999 -1.0 0.0 0.0 0) (30000 1 30000 34999 -1.0 0.0 1.99999994947575e-4 6) (35000 1 35000 39999 -1.0 1.0 -2.00040012714453e-4 6) (40000 1 40000 49999 -1.0 0.0 0.0 0) (50000 1 50000 79999 -1.0 -1.0 6.66688865749165e-5 4) (80000 1 80000 99999 -1.0 0.0 0.0 0) (100000 -2 0 0 -0.0 0.0 0.0 0))
+ vals "ramp" #__line__)
+ (env-sound '(0 0 1 1))
+ (reverse-channel)
+ (delete-samples 1 99999)
+ (if (fneq (sample 0) -1.0) (snd-display #__line__ ";sample at end: ~A" (sample 0)))
+ (if (not (= (framples) 1)) (snd-display #__line__ ";length at end: ~A" (framples)))
+ (check-edit-tree '((0 2 0 0 1.0 0.0 0.0 0) (1 -2 0 0 0.0 0.0 0.0 0))
+ (make-float-vector 1 -1.0) "at end" #__line__)
+ (close-sound ind))
+
+ ;; a special case that catches the round-off problem
+ (let ((ind (open-sound "oboe.snd")))
+ (env-channel '(0.0 0.984011617147162 0.644050741979388 0.110976689002195 1.17272046995914 0.384709990674106
+ 1.25650287720397 0.551452668245628 1.4389507801877 0.843827758574229 2.16614272265275 0.226832341237953))
+ (let ((val (sample 50827)))
+ (if (or (not (number? val))
+ (fneq val 0.0))
+ (snd-display #__line__ ";round-off env: ~A" val)))
+ (check-edit-tree '((0 0 0 15111 1.0 0.984011590480804 -5.77709688514005e-5 4) (15112 0 15112 27516 1.0 0.110976688563824 2.20663678192068e-5 4) (27517 0 27517 29482 1.0 0.384709984064102 8.4813182184007e-5 4) (29483 0 29483 33763 1.0 0.551452696323395 6.82959798723459e-5 4) (33764 0 33764 50827 1.0 0.843827784061432 -3.61598467861768e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "round-off test" #__line__)
+ (revert-sound ind)
+ (map-channel (lambda (y) 1.0))
+ (env-channel '(0 0 1 1 2 0))
+ (scale-channel .5 1000 1000)
+ (let ((val (sample 800)))
+ (if (fneq val .0314)
+ (snd-display #__line__ ";scl on env trouble: ~A" val)))
+ (check-edit-tree '((0 1 0 999 1.0 0.0 3.93483896914404e-5 4) (1000 1 1000 1999 0.5 0.0393483899533749 3.93483896914404e-5 4) (2000 1 2000 25413 1.0 0.0786967799067497 3.93483896914404e-5 4) (25414 1 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "scl on env" #__line__)
+ (revert-sound ind)
+ (map-channel (lambda (y) 1.0))
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (let ((val (sample 20000)))
+ (if (fneq val (expt (/ 20000.0 50828) 3))
+ (snd-display #__line__ ";ramp-channels piled up: ~A" val)))
+ (check-edit-tree '((0 1 0 50827 1.0 0.0 1.96745822904631e-5 10) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "ramp upon ramp" #__line__)
+ (revert-sound ind)
+
+ (map-channel (lambda (y) 1.0))
+ (ramp-channel 0.5 1.0) ; val = 0.5 + (20000/50828)*0.5
+ (ramp-channel 0.0 0.5) ; val * (20000/50828)*0.5
+ (ramp-channel 0.1 0.4) ; val * (0.1 + (20000/50828)*0.3)
+ (let* ((val (sample 20000))
+ (ratio (/ 20000.0 50828))
+ (val1 (+ 0.5 (* 0.5 ratio)))
+ (val2 (* val1 0.5 ratio))
+ (val3 (* val2 (+ 0.1 (* ratio 0.3)))))
+ (if (fneq val val3)
+ (snd-display #__line__ ";ramp-channels piled up (2): ~A ~A" val val3)))
+
+ (revert-sound ind)
+ (env-channel '(0 0 1 1 2 0))
+ (check-edit-tree '((0 0 0 25413 1.0 0.0 3.93483896914404e-5 4) (25414 0 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "env+scl 0" #__line__)
+ (scale-channel .5 0 1000)
+ (check-edit-tree '((0 0 0 999 0.5 0.0 3.93483896914404e-5 4) (1000 0 1000 25413 1.0 0.0393483899533749 3.93483896914404e-5 4) (25414 0 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "env+scl 1" #__line__)
+ (undo)
+ (scale-channel .5 1000 1000)
+ (check-edit-tree '((0 0 0 999 1.0 0.0 3.93483896914404e-5 4) (1000 0 1000 1999 0.5 0.0393483899533749 3.93483896914404e-5 4) (2000 0 2000 25413 1.0 0.0786967799067497 3.93483896914404e-5 4) (25414 0 25414 50827 1.0 1.0 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "env+scl 2" #__line__)
+ (undo)
+ (scale-channel .5 0 25415)
+ (check-edit-tree '((0 0 0 25413 0.5 0.0 3.93483896914404e-5 4) (25414 0 25414 25414 0.5 1.0 -3.93499394704122e-5 4) (25415 0 25415 50827 1.0 0.999960660934448 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "env+scl 3" #__line__)
+ (undo)
+ (scale-channel .5 20000 10000)
+ (check-edit-tree '((0 0 0 19999 1.0 0.0 3.93483896914404e-5 4) (20000 0 20000 25413 0.5 0.786967813968658 3.93483896914404e-5 4) (25414 0 25414 29999 0.5 1.0 -3.93499394704122e-5 4) (30000 0 30000 50827 1.0 0.819541156291962 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "env+scl 4" #__line__)
+ (undo)
+ (scale-channel .5 30000 1000)
+ (check-edit-tree '((0 0 0 25413 1.0 0.0 3.93483896914404e-5 4) (25414 0 25414 29999 1.0 1.0 -3.93499394704122e-5 4) (30000 0 30000 30999 0.5 0.819541156291962 -3.93499394704122e-5 4) (31000 0 31000 50827 1.0 0.780191242694855 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "env+scl 5" #__line__)
+ (undo)
+ (scale-channel .5 25415 1000)
+ (check-edit-tree '((0 0 0 25413 1.0 0.0 3.93483896914404e-5 4) (25414 0 25414 25414 1.0 1.0 -3.93499394704122e-5 4) (25415 0 25415 26414 0.5 0.999960660934448 -3.93499394704122e-5 4) (26415 0 26415 50827 1.0 0.960610687732697 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "env+scl 6" #__line__)
+ (undo)
+ (scale-channel .5 40000 10828)
+ (check-edit-tree '((0 0 0 25413 1.0 0.0 3.93483896914404e-5 4) (25414 0 25414 39999 1.0 1.0 -3.93499394704122e-5 4) (40000 0 40000 50827 0.5 0.426041781902313 -3.93499394704122e-5 4) (50828 -2 0 0 0.0 0.0 0.0 0))
+ #f "env+scl 7" #__line__)
+
+ (close-sound ind))
+
+ (for-each
+ (lambda (dur)
+ (let ((i1 (new-sound))
+ (i2 (new-sound "fmv1.snd" 2 44100 mus-ldouble mus-next))
+ (v (make-float-vector dur 1.0)))
+ (define (check-env name r e)
+ (let ((v0 (make-float-vector dur))
+ (v1 (make-float-vector dur)))
+ (if (env? e)
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (set! (v0 i) (env e)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (set! (v0 i) (e))))
+ (if (sampler? r)
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (float-vector-set! v1 i (read-sample r)))
+ (do ((i 0 (+ i 1)))
+ ((= i dur))
+ (float-vector-set! v1 i (r))))
+ (if (not (vequal v0 v1))
+ (snd-display #__line__ ";~A env check: ~A ~A" name v0 v1))))
+ (define (check-envs name r-maker e-maker)
+ (check-env (format #f "~A-1-0" name) (r-maker i1 0) (e-maker i1 0))
+ (check-env (format #f "~A-2-0" name) (r-maker i2 0) (e-maker i2 0))
+ (check-env (format #f "~A-2-1" name) (r-maker i2 1) (e-maker i2 1)))
+ (float-vector->channel v 0 dur i1)
+ (float-vector->channel v 0 dur i2 0)
+ (float-vector->channel v 0 dur i2 1)
+ (set! (sync i1) 1)
+ (set! (sync i2) 1)
+ (env-sound '(0 0 1 1))
+ (check-envs 'ramps (lambda (s c) (make-sampler 0 s c)) (lambda (s c) (make-env '(0 0 1 1) :length dur)))
+ (reverse-sound)
+ (check-envs 'rev-ramps (lambda (s c) (make-sampler 0 s c)) (lambda (s c) (make-env '(0 1 1 0) :length dur)))
+ (undo 2)
+ (env-sound '(0 0 1 1 2 0))
+ (check-envs 'ramps (lambda (s c) (make-sampler 0 s c)) (lambda (s c) (make-env '(0 0 1 1 2 0) :length dur)))
+ (undo 1)
+ (scale-by .5)
+ (env-sound '(0 0 1 1))
+ (check-envs 'scl-ramps (lambda (s c) (make-sampler 0 s c)) (lambda (s c) (make-env '(0 0 1 1) :length dur :scaler .5)))
+ (reverse-sound)
+ (check-envs 'scl-rev-ramps (lambda (s c) (make-sampler 0)) (lambda (s c) (make-env '(0 1 1 0) :length dur :scaler .5)))
+ (undo 3)
+ (env-sound '(0 0 1 1))
+ (env-sound '(0 0 1 1))
+ (check-envs 'unenv-ramps
+ (lambda (s c)
+ (make-sampler 0 s c))
+ (lambda (s c)
+ (let ((e (make-env '(0 0 1 1) :length dur)))
+ (lambda ()
+ (let ((val (env e)))
+ (* val val))))))
+ (undo 2)
+ (env-sound '(0 0 1 1))
+ (let ((v1 (make-float-vector 3 1.0)))
+ (float-vector->channel v1 3 3 i1)
+ (float-vector->channel v1 3 3 i2 0)
+ (float-vector->channel v1 3 3 i2 1)
+ (let ((vals (channel->float-vector 0 10 i1 0)))
+ (if (not (vequal vals (float-vector 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
+ (snd-display #__line__ "; 1 0 vals: ~A" vals))
+ (set! vals (channel->float-vector 0 10 i2 0))
+ (if (not (vequal vals (float-vector 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
+ (snd-display #__line__ "; 2 0 vals: ~A" vals))
+ (set! vals (channel->float-vector 0 10 i2 1))
+ (if (not (vequal vals (float-vector 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
+ (snd-display #__line__ "; 2 1 vals: ~A" vals))))
+ (let ((file (file-name i1)))
+ (close-sound i1)
+ (if (file-exists? file) (delete-file file)))
+ (close-sound i2)
+ ))
+ (list 10 10000))
+
+ (if (null? (hook-functions initial-graph-hook))
+ (begin
+ (set! (hook-functions update-hook) ())
+ (set! (hook-functions close-hook) ())
+ (set! (hook-functions exit-hook) ())))
+
+ (let ((data (map
+ (lambda (sound)
+ (if (file-exists? sound)
+ (let ((ind (view-sound sound)))
+ (set! (squelch-update ind) #t)
+
+ (let ((times (map
+ (lambda (function)
+ (let ((start (real-time)))
+ (function)
+ (revert-sound)
+ (- (real-time) start)))
+ (list (lambda () (scale-channel 2.0))
+ reverse-channel
+ (lambda () (env-channel '(0 0 1 1)))
+ (lambda () (map-channel (lambda (y) (* y 2.0))))
+ (lambda () (scan-channel (lambda (y) (> y 1.0))))
+ (lambda () (pad-channel 0 2000))
+ (lambda () (float-vector->channel (make-float-vector 1000 .1) 0 1000))
+ (lambda () (clm-channel (make-two-zero .5 .5)))
+ (lambda () (mix "pistol.snd" 12345))
+ (lambda () (src-channel 2.0))
+ (lambda () (delete-samples 10 200))
+ ))))
+ (close-sound ind)
+ times))))
+ (let ((away (string-append home-dir "/test/sound/away.snd")))
+ (if (file-exists? away)
+ (list "1a.snd" "oboe.snd" "storm.snd" away)
+ (list "1a.snd" "oboe.snd" "storm.snd" "lola.snd"))))))
+
+ (snd-display #__line__ "; scl rev env map scn pad wrt clm mix src del")
+ (snd-display #__line__ ";1a: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (car data)))
+ (snd-display #__line__ ";oboe: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (cdar data)))
+ (snd-display #__line__ ";storm:~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (caddr data)))
+ (if (pair? (cadddr data))
+ (snd-display #__line__ ";away: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (cadddr data))))
+ )
+
+ (if (and all-args with-big-file)
+ (let ((ind (view-sound big-file-name)))
+ (catch #t
+ (lambda ()
+ (set! (squelch-update ind) #t)
+ (set! *selection-creates-region* #f)
+ (let ((times (map
+ (lambda (function)
+ (let ((start (real-time)))
+ (function)
+ (update-time-graph)
+ (revert-sound)
+ (- (real-time) start)))
+ (list (lambda ()
+ (let ((ma (maxamp)))
+ (scale-channel 2.0)
+ (if (fneq (maxamp) (* 2 ma)) (snd-display #__line__ ";bigger scale max: ~A ~A" ma (maxamp)))))
+ (lambda ()
+ (let ((ma (maxamp)))
+ (env-channel '(0 0 1 1))
+ (if (fneq (maxamp) ma) (snd-display #__line__ ";bigger env max: ~A ~A" ma (maxamp)))))
+ (lambda () (pad-channel 0 2000))
+ (lambda () (pad-channel 1336909605 297671280))
+ (lambda () (insert-silence (+ (framples ind) 100) 100))
+ (lambda () (float-vector->channel (make-float-vector 1000 .1) 0 1000))
+ (lambda () (float-vector->channel (make-float-vector 1000 .1) (/ (framples ind) 2) 1000))
+ (lambda () (float-vector->channel (make-float-vector 1000 .1) (- (framples ind) 2000) 1000))
+ (lambda () (mix "pistol.snd" 12345))
+ (lambda () (delete-samples 10 200))
+ (lambda () (delete-samples 1336909605 297671280))
+ (lambda () (delete-samples (- (framples ind) 100) 10))
+ ))))
+ (set! (squelch-update ind) #f)
+ (snd-display #__line__ ";big: ~{~6,2F~}" times)
+ ))
+ (lambda args (set! (squelch-update) #f)))
+ (close-sound ind)))
+
+ (if with-big-file
+ (letrec ((fieql
+ (lambda (a b)
+ (if (null? a)
+ (null? b)
+ (and (not (null? b))
+ (if (and (integer? (car a))
+ (not (= (car a) (car b))))
+ #f
+ (if (and (number? (car a))
+ (fneq (car a) (car b)))
+ #f
+ (fieql (cdr a) (cdr b)))))))))
+
+ (set! (hook-functions after-graph-hook) ())
+ (set! (hook-functions mouse-click-hook) ())
+
+ (let ((ind (open-sound big-file-name))
+ (vals (make-float-vector 100))
+ (old-vals #f)
+ (new-vals #f)
+ (maxa 0.0))
+ (if (= big-file-framples 0)
+ (set! big-file-framples (framples ind)))
+ (select-sound ind)
+ (select-channel 0)
+ (set! (squelch-update) #t)
+ (if (not (fieql (edit-tree) (list (list 0 0 0 (- big-file-framples 1) 1.0 0.0 0.0 0) (list big-file-framples -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger initial tree: ~A" (edit-tree)))
+ (fill! vals 1.0)
+ (set! maxa (maxamp))
+ (scale-channel 0.5)
+ (set! old-vals (channel->float-vector (- (* (floor *clm-srate*) 50000) 50) 200))
+ (if (fneq (maxamp) (* 0.5 maxa)) (snd-display #__line__ ";bigger scale: ~A ~A" maxa (maxamp)))
+ (set! (samples (* (floor *clm-srate*) 50000) 100) vals)
+ (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 0.5 0.0 0.0 0)
+ (list 2205000000 1 0 99 1.0 0.0 0.0 0)
+ (list 2205000100 0 2205000100 (- big-file-framples 1) 0.5 0.0 0.0 0)
+ (list big-file-framples -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger set tree: ~A" (edit-tree)))
+ (set! new-vals (channel->float-vector (- (* (floor *clm-srate*) 50000) 50) 200))
+ (do ((i 50 (+ i 1))) ((= i 150)) (set! (old-vals i) 1.0))
+ (if (not (vequal new-vals old-vals)) (snd-display #__line__ ";bigger set ~A ~A" old-vals new-vals))
+ (env-channel (make-env '(0 0 1 1) :length (* (floor *clm-srate*) 60000)) 1000 (* (floor *clm-srate*) 60000))
+ (if (not (fieql (edit-tree) (list (list 0 0 0 999 0.5 0.0 0.0 0)
+ (list 1000 0 1000 2204999999 0.5 1.12130420080871e-17 0.83333295583725 1)
+ (list 2205000000 1 0 99 1.0 0.83333295583725 0.833333015441895 1)
+ (list 2205000100 0 2205000100 2646000999 0.5 0.833333015441895 1.0 1)
+ (list 2646001000 0 2646001000 (- big-file-framples 1) 0.5 0.0 0.0 0)
+ (list big-file-framples -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger with env: ~A" (edit-tree)))
+ (revert-sound ind)
+ (env-channel (make-env '(0 0 1 1 2 0) :length 101) (* (floor *clm-srate*) 50000) 100)
+ (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
+ (list 2205000000 0 2205000000 2205000050 1.0 4.47034825823422e-10 1.0 2)
+ (list 2205000051 0 2205000051 2205000099 1.0 0.979591846466064 -5.55111512312578e-17 2)
+ (list 2205000100 0 2205000100 (- big-file-framples 1) 1.0 0.0 0.0 0)
+ (list big-file-framples -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger short env: ~A" (edit-tree)))
+ (let ((r (make-sampler (+ 75 (* (floor *clm-srate*) 50000))))
+ (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (read-sample r)))
+ (if (not (vequal v (float-vector -0.021 -0.020 -0.020 -0.019 -0.018 -0.017 -0.016 -0.016 -0.015 -0.014)))
+ (snd-display #__line__ ";bigger short env vals: ~A" v)))
+ (revert-sound)
+
+ (let ((v (channel->float-vector (+ 75 (* (floor *clm-srate*) 50000)) 10)))
+ (if (not (vequal v (float-vector -0.042 -0.043 -0.044 -0.045 -0.045 -0.045 -0.045 -0.045 -0.045 -0.046)))
+ (snd-display #__line__ ";bigger no env vals: ~A" v)))
+ (scale-to 1.0)
+ (if (fneq (maxamp) 1.0) (snd-display #__line__ ";bigger scale-to 1.0 maxamp: ~A" (maxamp)))
+ (set! (sample (* (floor *clm-srate*) 51000)) 0.0)
+ (if (not (fieql (edit-tree) (list (list 0 0 0 2249099999 1.18574941158295 0.0 0.0 0)
+ (list 2249100000 1 0 0 1.0 0.0 0.0 0)
+ (list 2249100001 0 2249100001 (- big-file-framples 1) 1.18574941158295 0.0 0.0 0)
+ (list big-file-framples -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger set 0 samp: ~A" (edit-tree)))
+ (if (fneq (sample (* (floor *clm-srate*) 51000)) 0.0) (snd-display #__line__ ";bigger 0 samp: ~A" (sample (* (floor *clm-srate*) 51000))))
+ (delete-samples (* (floor *clm-srate*) 52000) 100)
+ (if (not (= (framples) (- big-file-framples 100)))
+ (snd-display #__line__ ";bigger deletion framples: ~A (~A)" (framples) (- big-file-framples 100)))
+ (if (not (= (framples ind 0 0) big-file-framples))
+ (snd-display #__line__ ";bigger edpos deletion framples: ~A (~A)" (framples ind 0 0) big-file-framples))
+ (if (not (= (framples ind 0 (edit-position)) (- big-file-framples 100)))
+ (snd-display #__line__ ";bigger ed deletion framples: ~A (~A)" (framples ind 0 (edit-position)) (- big-file-framples 100)))
+ (if (not (fieql (edit-tree) (list (list 0 0 0 2249099999 1.18574941158295 0.0 0.0 0)
+ (list 2249100000 1 0 0 1.0 0.0 0.0 0)
+ (list 2249100001 0 2249100001 2293199999 1.18574941158295 0.0 0.0 0)
+ (list 2293200000 0 2293200100 (- big-file-framples 1) 1.18574941158295 0.0 0.0 0)
+ (list (- big-file-framples 100) -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger deletion: ~A" (edit-tree)))
+ (delete-samples 954624868 67)
+ (revert-sound)
+
+ (delete-samples 1000 (* (floor *clm-srate*) 50000))
+ (if (not (= (framples) (- big-file-framples (* (floor *clm-srate*) 50000)))) (snd-display #__line__ ";bigger big deletion: ~A" (framples)))
+ (if (not (fieql (edit-tree) (list (list 0 0 0 999 1.0 0.0 0.0 0)
+ (list 1000 0 1085232704 (- big-file-framples 1) 1.0 0.0 0.0 0)
+ (list 970200000 -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger big delete: ~A" (edit-tree)))
+ (insert-silence 0 (* (floor *clm-srate*) 50000))
+ (if (not (= (framples) big-file-framples)) (snd-display #__line__ ";bigger silence: ~A (~A)" (framples) big-file-framples))
+ (if (not (fieql (edit-tree) (list (list 0 -1 0 2204999999 0.0 0.0 0.0 0)
+ (list 2205000000 0 0 999 1.0 0.0 0.0 0)
+ (list 2205001000 0 1085232704 (- big-file-framples 1) 1.0 0.0 0.0 0)
+ (list big-file-framples -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger pad: ~A" (edit-tree)))
+ (revert-sound)
+
+ (pad-channel (* (floor *clm-srate*) 50000) 100)
+ (if (fneq (sample (+ (* (floor *clm-srate*) 50000) 10)) 0.0)
+ (snd-display #__line__ ";bigger pad samp: ~A" (sample (+ (* (floor *clm-srate*) 50000) 10))))
+ (if (not (= (framples) (+ big-file-framples 100)))
+ (snd-display #__line__ ";bigger pad framples: ~A (~A)" (framples) (+ big-file-framples 100)))
+ (map-channel (lambda (y) (+ y .2)) (* (floor *clm-srate*) 50000) 10)
+ (if (fneq (sample (+ (* (floor *clm-srate*) 50000) 1)) 0.2) (snd-display #__line__ ";bigger map samp: ~A" (sample (+ (* (floor *clm-srate*) 50000) 1))))
+ (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
+ (list 2205000000 1 0 9 1.0 0.0 0.0 0)
+ (list 2205000010 -1 10 99 0.0 0.0 0.0 0)
+ (list 2205000100 0 2205000000 (- big-file-framples 1) 1.0 0.0 0.0 0)
+ (list (+ big-file-framples 100) -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger map: ~A" (edit-tree)))
+ (save-edit-history "hiho.scm")
+ (revert-sound)
+
+ (set! sfile ind)
+ (load (string-append cwd "hiho.scm"))
+ (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
+ (list 2205000000 1 0 9 1.0 0.0 0.0 0)
+ (list 2205000010 -1 10 99 0.0 0.0 0.0 0)
+ (list 2205000100 0 2205000000 (- big-file-framples 1) 1.0 0.0 0.0 0)
+ (list (+ big-file-framples 100) -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger reload: ~A" (edit-tree)))
+ (delete-file "hiho.scm")
+
+ (let ((flt (make-one-zero 0.5 0.5)))
+ (let ((lvals (channel->float-vector (+ 1000 (* (floor *clm-srate*) 65000)) 10 ind 0 0)))
+ (if (not (vequal lvals (float-vector -0.006 0.052 0.103 0.146 0.182 0.210 0.232 0.249 0.262 0.272)))
+ (snd-display #__line__ ";bigger (orig) vals: ~A" lvals))
+ (clm-channel flt (+ (* (floor *clm-srate*) 65000) 1000) 10)
+ (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
+ (list 2205000000 1 0 9 1.0 0.0 0.0 0)
+ (list 2205000010 -1 10 99 0.0 0.0 0.0 0)
+ (list 2205000100 0 2205000000 2866499899 1.0 0.0 0.0 0)
+ (list 2866500000 2 0 9 1.0 0.0 0.0 0)
+ (list 2866500010 0 2866499910 (- big-file-framples 1) 1.0 0.0 0.0 0)
+ (list (+ big-file-framples 100) -2 0 0 0.0 0.0 0.0 0))))
+ (snd-display #__line__ ";bigger clm: ~A" (edit-tree)))
+ (if (not (vequal (channel->float-vector (+ 1000 (* (floor *clm-srate*) 65000)) 10)
+ (float-vector -0.006 0.015 0.065 0.107 0.142 0.169 0.190 0.205 0.216 0.222)))
+ (snd-display #__line__ ";bigger clm vals: ~A" (channel->float-vector (+ 1000 (* (floor *clm-srate*) 65000)) 10)))
+
+ (let ((r (make-readin big-file-name :start (+ 1000 (* (floor *clm-srate*) 65000))))
+ (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (v i) (readin r)))
+ (if (not (vequal v lvals))
+ (snd-display #__line__ ";bigger (orig) readin vals: ~A (~A)" v lvals)))))
+ (revert-sound)
+ (let ((found (scan-channel (lambda (y) (> y .5)) (* (floor *clm-srate*) 50000))))
+ (if (not (equal? found (list #t 2205000925)))
+ (snd-display #__line__ ";bigger scan: ~A" found)))
+ (set! (squelch-update) #f)
+ (close-sound ind))))
+
+ (let ((ind (new-sound "fmv.snd" :header-type mus-next :sample-type mus-ldouble)))
+ (set! *sinc-width* 10)
+ (pad-channel 0 1000 ind)
+ (set! (sample 100) 0.5)
+ (if (fneq (sample 100 ind 0 2) 0.5) (snd-display #__line__ ";sample 100 (2): ~A" (sample 100 ind 0 2)))
+ (if (fneq (sample 100 ind 0 1) 0.0) (snd-display #__line__ ";sample 100 (1): ~A" (sample 100 ind 0 1)))
+ (src-channel 0.5)
+ (let ((mx (maxamp ind 0)))
+ (if (fneq mx 0.5) (snd-display #__line__ ";src-channel max .5: ~A" mx)))
+ (if (fneq (sample 200) 0.5) (snd-display #__line__ ";src-channel 0.5 200: ~A" (sample 200)))
+ (if (not (vequal (channel->float-vector 180 40 ind 0)
+ (float-vector 0.000 -0.000 0.000 0.001 -0.000 -0.003 0.000 0.007 -0.000 -0.012
+ 0.000 0.020 -0.000 -0.033 0.000 0.054 -0.000 -0.100 -0.000 0.316
+ 0.500 0.316 -0.000 -0.100 -0.000 0.054 0.000 -0.033 -0.000 0.020
+ 0.000 -0.012 -0.000 0.007 0.000 -0.003 -0.000 0.001 0.000 -0.000)))
+ (snd-display #__line__ ";src-channel 0.5 -> ~A" (channel->float-vector 180 40 ind 0)))
+ (undo 1 ind 0)
+ (src-channel 0.25)
+ (let ((mx (maxamp ind 0)))
+ (if (fneq mx 0.5) (snd-display #__line__ ";src-channel max .25: ~A" mx)))
+ (if (fneq (sample 400) 0.5) (snd-display #__line__ ";src-channel 0.25 400: ~A" (sample 400)))
+ (if (not (vequal (channel->float-vector 360 80 ind 0)
+ (float-vector 0.000 -0.000 -0.000 -0.000 0.000 0.000 0.001 0.001 -0.000 -0.002
+ -0.003 -0.003 0.000 0.004 0.007 0.006 -0.000 -0.008 -0.012 -0.010
+ 0.000 0.013 0.020 0.016 -0.000 -0.021 -0.033 -0.026 0.000 0.034
+ 0.054 0.044 -0.000 -0.060 -0.100 -0.087 -0.000 0.148 0.316 0.449
+ 0.500 0.449 0.316 0.148 -0.000 -0.087 -0.100 -0.060 -0.000 0.044
+ 0.054 0.034 0.000 -0.026 -0.033 -0.021 -0.000 0.016 0.020 0.013
+ 0.000 -0.010 -0.012 -0.008 -0.000 0.006 0.007 0.004 0.000 -0.003
+ -0.003 -0.002 -0.000 0.001 0.001 0.000 0.000 -0.000 -0.000 -0.000)))
+ (snd-display #__line__ ";src-channel 0.25 -> ~A" (channel->float-vector 360 80 ind 0)))
+ (undo 2 ind 0)
+ ;(map-channel (let ((i 0)) (lambda (y) (let ((val (sin (* i (/ pi 100))))) (set! i (+ i 1)) (* .5 val)))))
+ (let ((e (make-env (list 0.0 0.0 1.0 1.0) :scaler (* .01 pi (- (framples) 1.0)) :length (framples))))
+ (map-channel (lambda (y) (* .5 (sin (env e))))))
+ (for-each
+ (lambda (sr df)
+ (src-channel sr)
+ (if (> (abs (- (maxamp ind 0) .5)) df) (snd-display #__line__ ";src-channel sine ~A: ~A" sr (maxamp ind 0)))
+ (if (integer? sr)
+ (let ((r0 (make-sampler 0))
+ (r1 (make-sampler 0 ind 0 1 (- (edit-position) 1)))
+ (sri (floor sr)))
+ (do ((i 0 (+ i 1)))
+ ((= i 500))
+ (let ((diff (abs (- (r0) (r1)))))
+ (if (> diff df) (snd-display #__line__ ";src-channel ~A diff ~D: ~A" sr i diff))
+ (do ((j 1 (+ j 1)))
+ ((= j sri))
+ (r1))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 50))
+ (let ((s1 (sample i ind 0 (edit-position)))
+ (s2 (sample (round (* sr i)) ind 0 (- (edit-position) 1)))
+ (s3 (sample i ind 0 1)))
+ (if (> (abs (- s1 s2)) df) (snd-display #__line__ ";sample ~D src(~A): ~A ~A" i sr s1 s2))
+ (if (fneq s3 0.0) (snd-display #__line__ ";sample ~D (1): ~A" i s3))))
+ (undo 1 ind 0))
+ (list 2.0 1.5 3.0 3.14)
+ (list 0.008 0.01 0.015 0.025))
+ (close-sound ind)
+ (set! ind (open-sound "oboe.snd"))
+ (let ((orig-max (maxamp ind 0)))
+ (for-each
+ (lambda (sr df)
+ (src-channel sr)
+ (if (> (abs (- (maxamp ind 0) orig-max)) df) (snd-display #__line__ ";src-channel oboe ~A: ~A ~A" sr orig-max (maxamp ind 0)))
+ (if (integer? sr)
+ (let ((r0 (make-sampler 0))
+ (r1 (make-sampler 0 ind 0 1 (- (edit-position) 1)))
+ (sri (floor sr)))
+ (do ((i 0 (+ i 1)))
+ ((= i 5000))
+ (let ((diff (abs (- (r0) (r1)))))
+ (if (> diff df) (snd-display #__line__ ";src-channel oboe ~A diff ~D: ~A" sr i diff))
+ (do ((j 1 (+ j 1)))
+ ((= j sri))
+ (r1))))))
+ (undo 1 ind 0))
+ (list 2.0 1.5 3.0 3.14)
+ (list 0.008 0.01 0.015 0.025))
- (close-sound ind))
+ (for-each
+ (lambda (sr df)
+ (src-channel sr)
+ (if (> (abs (- (maxamp ind 0) orig-max)) df) (snd-display #__line__ ";src-channel oboe ~A: ~A ~A" sr orig-max (maxamp ind 0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 50))
+ (let* ((samp (* i 100))
+ (s1 (sample samp ind 0 (edit-position)))
+ (s2 (sample (floor (* sr samp)) ind 0 (- (edit-position) 1))))
+ (if (> (abs (- s1 s2)) df) (snd-display #__line__ ";sample ~D oboe src(~A): ~A ~A" i sr s1 s2))))
+ (undo 1 ind 0)
+ (amp-envs-equal? ind 0 (edit-position) (+ 1 (edit-position)) .01))
+ (list 0.5 0.25 0.9 0.1)
+ (list 0.001 0.001 0.001 0.001)))
+ (revert-sound ind)
+ (scale-by 2.0)
+ (scale-by 0.5)
+ (amp-envs-equal? ind 0 (edit-position) (- (edit-position) 2) .001)
+ (revert-sound ind)
+ (close-sound ind))
+
+ ;; recursion tests
+ (let ((ind (open-sound "oboe.snd")))
+ (for-each
+ (lambda (n)
+ (let ((val (scan-channel (lambda (y)
+ (let ((bigger (scan-channel (lambda (n5) (> n5 .1)))))
+ bigger)))))
+ (if (not (eqv? val 0))
+ (snd-display #__line__ ";scan-channel in scan-channel (opt ~A): ~A" n val)))
+ (let ((hi (make-float-vector 3))
+ (ho (make-float-vector 3)))
+ (fill-float-vector hi (if (scan-channel (lambda (y) (> y .1)))
+ 1.0 0.0))
+ (if (not (vequal hi (float-vector 1.0 1.0 1.0))) (snd-display #__line__ ";fill-float-vector with scan-channel (opt ~A): ~A" n hi)))
+ (let ((val (scan-channel (lambda (y) (scan-channel (lambda (n6) (> n6 .1)))))))
+ (if (not (= val 0)) (snd-display #__line__ ";find with find: ~A" val)))
+ (let ((val (scan-channel (lambda (y) (scan-channel (lambda (n7) (> n7 .1)))))))
+ (if (not (= val 0)) (snd-display #__line__ ";find with scan-channel: ~A" val)))
+ (let ((mx (maxamp ind 0))
+ (val (scan-channel (lambda (y) (map-channel (lambda (n) (* n 2.0))) #t))))
+ (if (not (eqv? val 0)) (snd-display #__line__ ";scan-channel with map-channel: ~A" val))
+ (if (fneq mx (/ (maxamp ind 0) 2)) (snd-display #__line__ ";scan+map max: ~A ~A" mx (maxamp ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";scan+map edit-pos: ~A" (edit-position ind 0)))
+ (revert-sound ind)
+ (map-channel (let ((ctr 0))
+ (lambda (y)
+ (if (= ctr 0) (map-channel (lambda (n) (* n 2.0))))
+ (set! ctr 1)
+ y))
+ 0 3)
+ (if (fneq mx (maxamp ind 0)) (snd-display #__line__ ";map+map max 2: ~A ~A" mx (maxamp ind 0)))
+ (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";map+map edit-pos: ~A" (edit-position ind 0)))
+ (if (fneq mx (/ (maxamp ind 0 1) 2)) (snd-display #__line__ ";map+map max 1: ~A ~A" mx (maxamp ind 0 1)))
+ (revert-sound ind))
+ )
+ (list 0 5))
+ (close-sound ind))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (for-each
+ (lambda (func beg dur len)
+ (let ((old-len (framples ind)))
+ (func beg dur)
+ (if (not (= (framples ind) len))
+ (snd-display #__line__ ";(~A ~A ~A) with ~A -> ~A (~A)?" func beg dur old-len (framples ind) len))))
+ (list (lambda (beg dur) (env-channel '(0 0 1 1) beg dur))
+ (lambda (beg dur) (map-channel (lambda (y) (* y .5)) beg dur))
+ reverse-channel
+ (lambda (beg dur) (scale-channel 2.0 beg dur))
+ (lambda (beg dur) (float-vector->channel (make-float-vector dur) beg dur))
+ smooth-channel
+ pad-channel
+ (lambda (beg dur) (src-channel 0.5 beg dur))
+ insert-silence)
+ (list 0 0 0 0 0 0 0 0 0)
+ (list 1000 1000 1000 1000 1000 1000 1000 1000 1000)
+ (list 50828 50828 50828 50828 50828 50828 51828 52829 53829))
+
+ (revert-sound ind)
(for-each
- (lambda (dur)
- (let* ((i1 (new-sound))
- (i2 (new-sound "fmv1.snd" mus-next mus-bfloat 44100 2))
- (v (vct-fill! (make-vct dur) 1.0)))
- (define (check-env name r e)
- (let ((happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i dur))
- happy)
- (let ((rv (r))
- (ev (e)))
- (if (fneq rv ev)
- (begin
- (snd-display #__line__ ";~A env check [~A]: ~A ~A" name i rv ev)
- (throw 'uhoh2)
- (set! happy #f)))))))
- (define (check-envs name r-maker e-maker)
- (check-env (format #f "~A-1-0" name) (r-maker i1 0) (e-maker i1 0))
- (check-env (format #f "~A-2-0" name) (r-maker i2 0) (e-maker i2 0))
- (check-env (format #f "~A-2-1" name) (r-maker i2 1) (e-maker i2 1)))
- (vct->channel v 0 dur i1)
- (vct->channel v 0 dur i2 0)
- (vct->channel v 0 dur i2 1)
- (set! (sync i1) 1)
- (set! (sync i2) 1)
- (env-sound '(0 0 1 1))
- (check-envs 'ramps (lambda (s c) (make-sampler 0 s c)) (lambda (s c) (make-env '(0 0 1 1) :length dur)))
- (reverse-sound)
- (check-envs 'rev-ramps (lambda (s c) (make-sampler 0 s c)) (lambda (s c) (make-env '(0 1 1 0) :length dur)))
- (undo 2)
- (env-sound '(0 0 1 1 2 0))
- (check-envs 'ramps (lambda (s c) (make-sampler 0 s c)) (lambda (s c) (make-env '(0 0 1 1 2 0) :length dur)))
- (undo 1)
- (scale-by .5)
- (env-sound '(0 0 1 1))
- (check-envs 'scl-ramps (lambda (s c) (make-sampler 0 s c)) (lambda (s c) (make-env '(0 0 1 1) :length dur :scaler .5)))
- (reverse-sound)
- (check-envs 'scl-rev-ramps (lambda (s c) (make-sampler 0)) (lambda (s c) (make-env '(0 1 1 0) :length dur :scaler .5)))
- (undo 3)
- (env-sound '(0 0 1 1))
- (env-sound '(0 0 1 1))
- (check-envs 'unenv-ramps
- (lambda (s c)
- (make-sampler 0 s c))
- (lambda (s c)
- (let ((e (make-env '(0 0 1 1) :length dur)))
- (lambda ()
- (let ((val (env e)))
- (* val val))))))
- (undo 2)
- (env-sound '(0 0 1 1))
- (let ((v1 (vct-fill! (make-vct 3) 1.0)))
- (vct->channel v1 3 3 i1)
- (vct->channel v1 3 3 i2 0)
- (vct->channel v1 3 3 i2 1)
- (let ((vals (channel->vct 0 10 i1 0)))
- (if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display #__line__ "; 1 0 vals: ~A" vals))
- (set! vals (channel->vct 0 10 i2 0))
- (if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display #__line__ "; 2 0 vals: ~A" vals))
- (set! vals (channel->vct 0 10 i2 1))
- (if (not (vequal vals (vct 0.0 (/ 1.111 dur) (/ 2.222 dur) 1 1 1 (/ 6.66 dur) (/ 7.77 dur) (/ 8.88 dur) (/ 10.0 dur))))
- (snd-display #__line__ "; 2 1 vals: ~A" vals))))
- (let ((file (file-name i1)))
- (close-sound i1)
- (if (file-exists? file) (delete-file file)))
- (close-sound i2)
- ))
- (list 10 10000))
+ (lambda (beg dur len)
+ (let ((old-len (framples ind)))
+ (pad-channel beg dur)
+ (if (not (= (framples ind) len))
+ (snd-display #__line__ ";(pad-channel ~A ~A) with ~A -> ~A (~A)?" beg dur old-len (framples ind) len))))
+ (list 1000 60000 0 62000 62000 62004)
+ (list 1000 1000 1000 1 2 1)
+ (list 51828 61000 62000 62001 62003 62005))
- (if (null? (hook-functions initial-graph-hook))
- (begin
- (set! (hook-functions update-hook) '())
- (set! (hook-functions close-hook) '())
- (set! (hook-functions exit-hook) '())))
-
- (let ((data (map
- (lambda (sound)
- (if (file-exists? sound)
- (let ((ind (view-sound sound))
- (old-opt (optimization)))
- (set! (squelch-update ind) #t)
- (set! (optimization) max-optimization)
-
- (let ((times (map
- (lambda (function)
- (let ((start (real-time)))
- (function)
- (revert-sound)
- (- (real-time) start)))
- (list (lambda () (scale-channel 2.0))
- (lambda () (reverse-channel))
- (lambda () (env-channel '(0 0 1 1)))
- (lambda () (map-channel (lambda (y) (* y 2))))
- (lambda () (ptree-channel (lambda (y) (+ y .2)) #f #f ind 0 #f #t))
- (lambda () (scan-channel (lambda (y) (> y 1.0))))
- (lambda () (pad-channel 0 2000))
- (lambda () (vct->channel (vct-fill! (make-vct 1000) .1) 0 1000))
- (lambda () (clm-channel (make-two-zero .5 .5)))
- (lambda () (mix "pistol.snd" 12345))
- (lambda () (src-channel 2.0))
- (lambda () (delete-samples 10 200))
- ))))
- (set! (optimization) old-opt)
- (close-sound ind)
- times))))
- (let ((away (string-append home-dir "/test/sound/away.snd")))
- (if (file-exists? away)
- (list "1a.snd" "oboe.snd" "storm.snd" away)
- (list "1a.snd" "oboe.snd" "storm.snd" "lola.snd"))))))
-
- (snd-display #__line__ "; scl rev env map ptree scn pad wrt clm mix src del")
- (snd-display #__line__ ";1a: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (car data)))
- (snd-display #__line__ ";oboe: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (cdar data)))
- (snd-display #__line__ ";storm:~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (caddr data)))
- (if (pair? (cadddr data))
- (snd-display #__line__ ";away: ~{~A ~}" (map (lambda (a) (if (< a .005) " 0.0" (format #f "~6,2F" a))) (cadddr data))))
- )
+ (revert-sound ind)
+
+ (for-each
+ (lambda (func dur len)
+ (let ((old-len (framples ind)))
+ (func (+ old-len 100) dur)
+ (if (not (= (framples ind) len))
+ (snd-display #__line__ ";(~A ~A) with ~A -> ~A (~A)?" func dur old-len (framples ind) len))))
+ (list (lambda (beg dur) (env-channel '(0 0 1 1) beg dur))
+ reverse-channel
+ (lambda (beg dur) (scale-channel 2.0 beg dur))
+ (lambda (beg dur) (scale-sound-by 2.0 beg dur))
+ (lambda (beg dur) (float-vector->channel (make-float-vector dur) beg dur))
+ smooth-channel
+ pad-channel
+ (lambda (beg dur) (src-channel 0.5 beg dur))
+ insert-silence
+ (lambda (beg dur) (env-sound '(0 0 1 1) beg dur))
+ )
+ (list 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000)
+ (list 50828 50828 50828 50828 51928 51928 53028 53028 54028 54028))
+
+ (revert-sound ind)
+
+ (let ((len (floor (* 1.25 (framples)))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (case (if (zero? test-16) 3 (floor (random 10)))
+ ((0) (pad-channel (random len) (random 1000)))
+ ((1) (env-channel '(0 0 1 1 2 0) (random len) (random 1000)))
+ ((2) (env-sound '(0 0 1 1 2 0) (random len) (random 1000)))
+ ((3) (scale-channel (random 1.0) (random len) (random 1000)))
+ ((4) (scale-sound-by (random 1.0) (random len) (random 1000)))
+ ((5) (src-channel (+ .9 (random .2)) (random len) (random 1000)))
+ ((6) (ramp-channel (random 1.0) (random 1.0) (random len) (random 1000)))
+ ((7) (reverse-channel (random len) (random 1000)))
+ ((8) (let ((dur (max 2 (floor (random 100))))) (float-vector->channel (make-float-vector dur) (random len) dur)))
+ ((9) (map-channel (lambda (y) (* y 2.0)) (random (floor (/ (framples) 2))) (random 1000))))))
+ (close-sound ind))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ ;; insert zeros
+ (pad-channel 0 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe pad 0 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 25071))
+ (snd-display #__line__ ";oboe pad 0 100 max pos: ~A (should be ~A)~%" (maxamp-position) 25071))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (pad-channel 25000 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe pad 25000 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe pad 25000 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (pad-channel 24971 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe pad 24971 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 25071))
+ (snd-display #__line__ ";oboe pad 24971 100 max pos: ~A (should be ~A)~%" (maxamp-position) 25071))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (pad-channel 24972 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe pad 24972 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe pad 24972 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (pad-channel 65000 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe pad 65000 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe pad 65000 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ ;; set sample
+ (revert-sound)
+ (set-sample 100 .1)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe set 100 .1 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe set 100 .1 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-sample 100 .2)
+ (if (fneq (maxamp) 0.2)
+ (snd-display #__line__ ";oboe set 100 .2 max: ~A (should be ~A)~%" (maxamp) 0.2))
+ (if (not (= (maxamp-position) 100))
+ (snd-display #__line__ ";oboe set 100 .2 max pos: ~A (should be ~A)~%" (maxamp-position) 100))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-sample 25000 .1)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe set 25000 .1 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe set 25000 .1 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-sample 25000 .2)
+ (if (fneq (maxamp) 0.2)
+ (snd-display #__line__ ";oboe set 25000 .2 max: ~A (should be ~A)~%" (maxamp) 0.2))
+ (if (not (= (maxamp-position) 25000))
+ (snd-display #__line__ ";oboe set 25000 .2 max pos: ~A (should be ~A)~%" (maxamp-position) 25000))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-sample 24971 .1)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe set 24971 .1 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 25368))
+ (snd-display #__line__ ";oboe set 24971 .1 max pos: ~A (should be ~A)~%" (maxamp-position) 25368))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-sample 24971 .2)
+ (if (fneq (maxamp) 0.2)
+ (snd-display #__line__ ";oboe set 24971 .2 max: ~A (should be ~A)~%" (maxamp) 0.2))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe set 24971 .2 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-sample 24971 -.2)
+ (if (fneq (maxamp) 0.2)
+ (snd-display #__line__ ";oboe set 24971 -.2 max: ~A (should be ~A)~%" (maxamp) 0.2))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe set 24971 .2 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ ;; delete-samples
+ (revert-sound)
+ (delete-samples 0 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe delete 0 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24871))
+ (snd-display #__line__ ";oboe delete 0 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24871))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (delete-samples 25000 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe delete 25000 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe delete 25000 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (delete-samples 24900 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe delete 24900 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 25268))
+ (snd-display #__line__ ";oboe delete 24900 100 max pos: ~A (should be ~A)~%" (maxamp-position) 25268))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ ;; insert samples
+ (revert-sound)
+ (insert-samples 0 100 (make-float-vector 100 0.1))
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe insert 0 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 25071))
+ (snd-display #__line__ ";oboe insert 0 100 max pos: ~A (should be ~A)~%" (maxamp-position) 25071))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (insert-samples 25000 100 (make-float-vector 100 0.1))
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe insert 25000 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe insert 25000 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (insert-samples 24971 100 (make-float-vector 100 0.1))
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe insert 24971 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 25071))
+ (snd-display #__line__ ";oboe insert 24971 100 max pos: ~A (should be ~A)~%" (maxamp-position) 25971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (insert-samples 0 100 (make-float-vector 100 0.2))
+ (if (fneq (maxamp) 0.2)
+ (snd-display #__line__ ";oboe insert 0 100 .2 max: ~A (should be ~A)~%" (maxamp) 0.2))
+ (if (not (= (maxamp-position) 0))
+ (snd-display #__line__ ";oboe insert 0 100 .2 max pos: ~A (should be ~A)~%" (maxamp-position) 0))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (insert-samples 25000 100 (make-float-vector 100 0.2))
+ (if (fneq (maxamp) 0.2)
+ (snd-display #__line__ ";oboe insert 25000 100 .2 max: ~A (should be ~A)~%" (maxamp) 0.2))
+ (if (not (= (maxamp-position) 25000))
+ (snd-display #__line__ ";oboe insert 25000 100 .2 max pos: ~A (should be ~A)~%" (maxamp-position) 25000))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ ;; set samples
+ (revert-sound)
+ (set-samples 0 100 (make-float-vector 100 0.1))
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe change 0 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe change 0 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-samples 25000 100 (make-float-vector 100 0.1))
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe change 25000 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe change 25000 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-samples 24900 100 (make-float-vector 100 0.1))
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe change 24900 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 25368))
+ (snd-display #__line__ ";oboe change 24900 100 max pos: ~A (should be ~A)~%" (maxamp-position) 25368))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-samples 0 100 (make-float-vector 100 0.2))
+ (if (fneq (maxamp) 0.2)
+ (snd-display #__line__ ";oboe change 0 100 .2 max: ~A (should be ~A)~%" (maxamp) 0.2))
+ (if (not (= (maxamp-position) 0))
+ (snd-display #__line__ ";oboe change 0 100 .2 max pos: ~A (should be ~A)~%" (maxamp-position) 0))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ (revert-sound)
+ (set-samples 25000 100 (make-float-vector 100 0.2))
+ (if (fneq (maxamp) 0.2)
+ (snd-display #__line__ ";oboe change 25000 100 .2 max: ~A (should be ~A)~%" (maxamp) 0.2))
+ (if (not (= (maxamp-position) 25000))
+ (snd-display #__line__ ";oboe change 25000 100 .2 max pos: ~A (should be ~A)~%" (maxamp-position) 25000))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ ;; scale samples
+ (revert-sound)
+ (scale-channel 2.0)
+ (if (fneq (maxamp) 0.29449462890625)
+ (snd-display #__line__ ";oboe scale 2 0 max: ~A (should be ~A)~%" (maxamp) 0.29449462890625))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe scale 2 0 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (if (and all-args with-big-file)
- (let ((ind (view-sound big-file-name))
- (old-opt (optimization)))
- (catch #t
- (lambda ()
- (set! (squelch-update ind) #t)
- (set! (optimization) max-optimization)
- (set! (selection-creates-region) #f)
- (let ((times (map
- (lambda (function)
- (let ((start (real-time)))
- (function)
- (update-time-graph)
- (revert-sound)
- (- (real-time) start)))
- (list (lambda ()
- (let ((ma (maxamp)))
- (scale-channel 2.0)
- (if (fneq (maxamp) (* 2 ma)) (snd-display #__line__ ";bigger scale max: ~A ~A" ma (maxamp)))))
- (lambda ()
- (let ((ma (maxamp)))
- (env-channel '(0 0 1 1))
- (if (fneq (maxamp) ma) (snd-display #__line__ ";bigger env max: ~A ~A" ma (maxamp)))))
- (lambda ()
- (let ((ma (maxamp)))
- (ptree-channel (lambda (y) (+ y .2)) #f #f ind 0 #f #t)
- (if (fneq (maxamp) (+ ma .2)) (snd-display #__line__ ";bigger ptree max: ~A ~A" ma (maxamp)))))
- (lambda () (pad-channel 0 2000))
- (lambda () (pad-channel 1336909605 297671280))
- (lambda () (insert-silence (+ (frames ind) 100) 100))
- (lambda () (vct->channel (vct-fill! (make-vct 1000) .1) 0 1000))
- (lambda () (vct->channel (vct-fill! (make-vct 1000) .1) (/ (frames ind) 2) 1000))
- (lambda () (vct->channel (vct-fill! (make-vct 1000) .1) (- (frames ind) 2000) 1000))
- (lambda () (mix "pistol.snd" 12345))
- (lambda () (delete-samples 10 200))
- (lambda () (delete-samples 1336909605 297671280))
- (lambda () (delete-samples (- (frames ind) 100) 10))
- ))))
- (set! (optimization) old-opt)
- (set! (squelch-update ind) #f)
- (snd-display #__line__ ";big: ~{~6,2F~}" times)
- ))
- (lambda args (set! (squelch-update) #f)))
- (close-sound ind)))
+ (revert-sound)
+ (scale-channel 0.0)
+ (if (fneq (maxamp) 0.0)
+ (snd-display #__line__ ";oboe scale 0 0 max: ~A (should be ~A)~%" (maxamp) 0.0))
+ (if (not (= (maxamp-position) 0))
+ (snd-display #__line__ ";oboe scale 0 0 max pos: ~A (should be ~A)~%" (maxamp-position) 0))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (if with-big-file
- (letrec ((fieql
- (lambda (a b)
- (if (null? a)
- (null? b)
- (if (null? b)
- #f
- (if (and (integer? (car a))
- (not (= (car a) (car b))))
- #f
- (if (and (number? (car a))
- (fneq (car a) (car b)))
- #f
- (fieql (cdr a) (cdr b)))))))))
-
- (set! (hook-functions after-graph-hook) '())
- (set! (hook-functions mouse-click-hook) '())
-
- (let ((ind (open-sound big-file-name))
- (vals (make-vct 100))
- (old-vals #f)
- (new-vals #f)
- (maxa 0.0))
- (if (= big-file-frames 0)
- (set! big-file-frames (frames ind)))
- (select-sound ind)
- (select-channel 0)
- (set! (squelch-update) #t)
- (if (not (fieql (edit-tree) (list (list 0 0 0 (- big-file-frames 1) 1.0 0.0 0.0 0) (list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger initial tree: ~A" (edit-tree)))
- (vct-fill! vals 1.0)
- (set! maxa (maxamp))
- (scale-channel 0.5)
- (set! old-vals (channel->vct (- (* 44100 50000) 50) 200))
- (if (fneq (maxamp) (* 0.5 maxa)) (snd-display #__line__ ";bigger scale: ~A ~A" maxa (maxamp)))
- (set! (samples (* 44100 50000) 100) vals)
- (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 0.5 0.0 0.0 0)
- (list 2205000000 1 0 99 1.0 0.0 0.0 0)
- (list 2205000100 0 2205000100 (- big-file-frames 1) 0.5 0.0 0.0 0)
- (list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger set tree: ~A" (edit-tree)))
- (set! new-vals (channel->vct (- (* 44100 50000) 50) 200))
- (do ((i 50 (+ 1 i))) ((= i 150)) (vct-set! old-vals i 1.0))
- (if (not (vequal new-vals old-vals)) (snd-display #__line__ ";bigger set ~A ~A" old-vals new-vals))
- (env-channel (make-env '(0 0 1 1) :length (* 44100 60000)) 1000 (* 44100 60000))
- (if (not (fieql (edit-tree) (list (list 0 0 0 999 0.5 0.0 0.0 0)
- (list 1000 0 1000 2204999999 0.5 1.12130420080871e-17 0.83333295583725 1)
- (list 2205000000 1 0 99 1.0 0.83333295583725 0.833333015441895 1)
- (list 2205000100 0 2205000100 2646000999 0.5 0.833333015441895 1.0 1)
- (list 2646001000 0 2646001000 (- big-file-frames 1) 0.5 0.0 0.0 0)
- (list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger with env: ~A" (edit-tree)))
- (revert-sound ind)
- (env-channel (make-env '(0 0 1 1 2 0) :length 101) (* 44100 50000) 100)
- (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
- (list 2205000000 0 2205000000 2205000050 1.0 4.47034825823422e-10 1.0 2)
- (list 2205000051 0 2205000051 2205000099 1.0 0.979591846466064 -5.55111512312578e-17 2)
- (list 2205000100 0 2205000100 (- big-file-frames 1) 1.0 0.0 0.0 0)
- (list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger short env: ~A" (edit-tree)))
- (let ((r (make-sampler (+ 75 (* 44100 50000))))
- (v (make-vct 10)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v i (read-sample r)))
- (if (not (vequal v (vct -0.021 -0.020 -0.020 -0.019 -0.018 -0.017 -0.016 -0.016 -0.015 -0.014)))
- (snd-display #__line__ ";bigger short env vals: ~A" v)))
- (revert-sound)
-
- (let ((v (channel->vct (+ 75 (* 44100 50000)) 10)))
- (if (not (vequal v (vct -0.042 -0.043 -0.044 -0.045 -0.045 -0.045 -0.045 -0.045 -0.045 -0.046)))
- (snd-display #__line__ ";bigger no env vals: ~A" v)))
- (scale-to 1.0)
- (if (fneq (maxamp) 1.0) (snd-display #__line__ ";bigger scale-to 1.0 maxamp: ~A" (maxamp)))
- (set! (sample (* 44100 51000)) 0.0)
- (if (not (fieql (edit-tree) (list (list 0 0 0 2249099999 1.18574941158295 0.0 0.0 0)
- (list 2249100000 1 0 0 1.0 0.0 0.0 0)
- (list 2249100001 0 2249100001 (- big-file-frames 1) 1.18574941158295 0.0 0.0 0)
- (list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger set 0 samp: ~A" (edit-tree)))
- (if (fneq (sample (* 44100 51000)) 0.0) (snd-display #__line__ ";bigger 0 samp: ~A" (sample (* 44100 51000))))
- (delete-samples (* 44100 52000) 100)
- (if (not (= (frames) (- big-file-frames 100)))
- (snd-display #__line__ ";bigger deletion frames: ~A (~A)" (frames) (- big-file-frames 100)))
- (if (not (= (frames ind 0 0) big-file-frames))
- (snd-display #__line__ ";bigger edpos deletion frames: ~A (~A)" (frames ind 0 0) big-file-frames))
- (if (not (= (frames ind 0 (edit-position)) (- big-file-frames 100)))
- (snd-display #__line__ ";bigger ed deletion frames: ~A (~A)" (frames ind 0 (edit-position)) (- big-file-frames 100)))
- (if (not (fieql (edit-tree) (list (list 0 0 0 2249099999 1.18574941158295 0.0 0.0 0)
- (list 2249100000 1 0 0 1.0 0.0 0.0 0)
- (list 2249100001 0 2249100001 2293199999 1.18574941158295 0.0 0.0 0)
- (list 2293200000 0 2293200100 (- big-file-frames 1) 1.18574941158295 0.0 0.0 0)
- (list (- big-file-frames 100) -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger deletion: ~A" (edit-tree)))
- (delete-samples 954624868 67)
- (revert-sound)
-
- (delete-samples 1000 (* 44100 50000))
- (if (not (= (frames) (- big-file-frames (* 44100 50000)))) (snd-display #__line__ ";bigger big deletion: ~A" (frames)))
- (if (not (fieql (edit-tree) (list (list 0 0 0 999 1.0 0.0 0.0 0)
- (list 1000 0 1085232704 (- big-file-frames 1) 1.0 0.0 0.0 0)
- (list 970200000 -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger big delete: ~A" (edit-tree)))
- (insert-silence 0 (* 44100 50000))
- (if (not (= (frames) big-file-frames)) (snd-display #__line__ ";bigger silence: ~A (~A)" (frames) big-file-frames))
- (if (not (fieql (edit-tree) (list (list 0 -1 0 2204999999 0.0 0.0 0.0 0)
- (list 2205000000 0 0 999 1.0 0.0 0.0 0)
- (list 2205001000 0 1085232704 (- big-file-frames 1) 1.0 0.0 0.0 0)
- (list big-file-frames -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger pad: ~A" (edit-tree)))
- (revert-sound)
-
- (pad-channel (* 44100 50000) 100)
- (if (fneq (sample (+ (* 44100 50000) 10)) 0.0)
- (snd-display #__line__ ";bigger pad samp: ~A" (sample (+ (* 44100 50000) 10))))
- (if (not (= (frames) (+ big-file-frames 100)))
- (snd-display #__line__ ";bigger pad frames: ~A (~A)" (frames) (+ big-file-frames 100)))
- (map-channel (lambda (y) (+ y .2)) (* 44100 50000) 10)
- (if (fneq (sample (+ (* 44100 50000) 1)) 0.2) (snd-display #__line__ ";bigger map samp: ~A" (sample (+ (* 44100 50000) 1))))
- (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
- (list 2205000000 1 0 9 1.0 0.0 0.0 0)
- (list 2205000010 -1 10 99 0.0 0.0 0.0 0)
- (list 2205000100 0 2205000000 (- big-file-frames 1) 1.0 0.0 0.0 0)
- (list (+ big-file-frames 100) -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger map: ~A" (edit-tree)))
- (save-edit-history "hiho.scm")
- (revert-sound)
-
- (set! sfile ind)
- (load (string-append cwd "hiho.scm"))
- (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
- (list 2205000000 1 0 9 1.0 0.0 0.0 0)
- (list 2205000010 -1 10 99 0.0 0.0 0.0 0)
- (list 2205000100 0 2205000000 (- big-file-frames 1) 1.0 0.0 0.0 0)
- (list (+ big-file-frames 100) -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger reload: ~A" (edit-tree)))
- (delete-file "hiho.scm")
-
- (let ((flt (make-one-zero 0.5 0.5))
- (flt1 (make-one-zero 0.5 0.5)))
- (let ((lvals (channel->vct (+ 1000 (* 44100 65000)) 10 ind 0 0)))
- (if (not (vequal lvals (vct -0.006 0.052 0.103 0.146 0.182 0.210 0.232 0.249 0.262 0.272)))
- (snd-display #__line__ ";bigger (orig) vals: ~A" lvals))
- (clm-channel flt (+ (* 44100 65000) 1000) 10)
- (if (not (fieql (edit-tree) (list (list 0 0 0 2204999999 1.0 0.0 0.0 0)
- (list 2205000000 1 0 9 1.0 0.0 0.0 0)
- (list 2205000010 -1 10 99 0.0 0.0 0.0 0)
- (list 2205000100 0 2205000000 2866499899 1.0 0.0 0.0 0)
- (list 2866500000 2 0 9 1.0 0.0 0.0 0)
- (list 2866500010 0 2866499910 (- big-file-frames 1) 1.0 0.0 0.0 0)
- (list (+ big-file-frames 100) -2 0 0 0.0 0.0 0.0 0))))
- (snd-display #__line__ ";bigger clm: ~A" (edit-tree)))
- (if (not (vequal (channel->vct (+ 1000 (* 44100 65000)) 10)
- (vct -0.006 0.015 0.065 0.107 0.142 0.169 0.190 0.205 0.216 0.222)))
- (snd-display #__line__ ";bigger clm vals: ~A" (channel->vct (+ 1000 (* 44100 65000)) 10)))
-
- (let ((r (make-readin big-file-name :start (+ 1000 (* 44100 65000))))
- (v (make-vct 10)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v i (readin r)))
- (if (not (vequal v lvals))
- (snd-display #__line__ ";bigger (orig) readin vals: ~A (~A)" v lvals)))))
- (revert-sound)
- (let ((found (scan-channel (lambda (y) (> y .5)) (* 44100 50000))))
- (if (not (equal? found (list #t 2205000925)))
- (snd-display #__line__ ";bigger scan: ~A" found)))
- (set! (squelch-update) #f)
- (close-sound ind))))
+ (revert-sound)
+ (scale-channel 0.1 0 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe scale .1 0 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe scale .1 0 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (let ((ind-map (view-sound "oboe.snd"))
- (ind-ptree (view-sound "oboe.snd")))
- (map-channel (lambda (y) (+ y .1)) #f #f ind-map)
- (ptree-channel (lambda (y) (+ y .1)) #f #f ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree + .1 differs"))
- (undo 1 ind-map)
- (undo 1 ind-ptree)
- (scale-by 2.0 ind-map)
- (scale-by 2.0 ind-ptree)
- (map-channel (lambda (y) (+ y .1)) #f #f ind-map)
- (ptree-channel (lambda (y) (+ y .1)) #f #f ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree + .1 differs"))
- (scale-by 2.0 ind-map)
- (scale-by 2.0 ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree + .1 differs"))
- (if (and (> (optimization) 0)
- (not (string=? (safe-display-edits ind-ptree) (string-append "
-EDITS: 3
-
- (begin) [0:2]:
- (at 0, cp->sounds[0][0:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (scale 0 50828) ; scale-channel 2.000 0 #f [1:2]:
- (at 0, cp->sounds[0][0:50827, 2.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (ptree[0] 0 50828) ; ptree-channel [2:2]:
- (at 0, cp->sounds[0][0:50827, 1.000, loc: 0, pos: 0, scl: 2.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (scale 0 50828) ; scale-channel 2.000 0 #f [3:2]:
- (at 0, cp->sounds[0][0:50827, 2.000, loc: 0, pos: 0, scl: 2.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-"))))
- (snd-display #__line__ ";ptree display edits: ~A" (safe-display-edits ind-ptree)))
- (revert-sound ind-map)
- (revert-sound ind-ptree)
-
- (map-channel (lambda (y) (* 2.0 (sin y))) #f #f ind-map)
- (ptree-channel (lambda (y) (* 2.0 (sin y))) #f #f ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree sin differs"))
- (map-channel (lambda (y) (* 2.0 (sin y))) #f #f ind-map)
- (ptree-channel (lambda (y) (* 2.0 (sin y))) #f #f ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree sin (2) differs"))
- (if (and (> (optimization) 0)
- (not (string=? (safe-display-edits ind-ptree) (string-append "
-EDITS: 2
-
- (begin) [0:2]:
- (at 0, cp->sounds[0][0:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (ptree[0] 0 50828) ; ptree-channel [1:2]:
- (at 0, cp->sounds[0][0:50827, 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* 2.0 (sin y)))]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (ptree[1] 0 50828) ; ptree-channel [2:2]:
- (at 0, cp->sounds[0][0:50827, 1.000, loc2: 1, pos2: 0, scl2: 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (* 2.0 (sin y)))]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-"))))
- (snd-display #__line__ ";ptree display: ~A" (safe-display-edits ind-ptree)))
-
- (revert-sound ind-map)
- (revert-sound ind-ptree)
- (env-channel '(0 0 1 1 2 0) #f #f ind-map)
- (env-channel '(0 0 1 1 2 0) #f #f ind-ptree)
- (map-channel (lambda (y) (* y y)) #f #f ind-map)
- (ptree-channel (lambda (y) (* y y)) #f #f ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree y*y differs"))
-
- (revert-sound ind-map)
- (revert-sound ind-ptree)
- (map-channel (lambda (y) (* y y)) #f #f ind-map)
- (ptree-channel (lambda (y) (* y y)) #f #f ind-ptree)
- (env-channel '(0 0 1 1 2 0) #f #f ind-map)
- (env-channel '(0 0 1 1 2 0) #f #f ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree y*y differs"))
-
- (revert-sound ind-map)
- (revert-sound ind-ptree)
- (map-channel (lambda (y) (+ y .1)) 100 100 ind-map)
- (ptree-channel (lambda (y) (+ y .1)) 100 100 ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree[100] + .1 differs"))
- (scale-by 2.0 ind-map)
- (scale-by 2.0 ind-ptree)
- (map-channel (lambda (y) (+ y .2)) 1000 100 ind-map)
- (ptree-channel (lambda (y) (+ y .2)) 1000 100 ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree[1000] + .2 differs"))
- (if (and (> (optimization) 0)
- (not (string=? (safe-display-edits ind-ptree) (string-append "
-EDITS: 3
-
- (begin) [0:2]:
- (at 0, cp->sounds[0][0:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (ptree[0] 100 100) ; ptree-channel [1:4]:
- (at 0, cp->sounds[0][0:99, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 100, cp->sounds[0][100:199, 1.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
- (at 200, cp->sounds[0][200:50827, 1.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (scale 0 50828) ; scale-channel 2.000 0 #f [2:4]:
- (at 0, cp->sounds[0][0:99, 2.000]) [file: " cwd "oboe.snd[0]]
- (at 100, cp->sounds[0][100:199, 2.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
- (at 200, cp->sounds[0][200:50827, 2.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-
- (ptree[1] 1000 100) ; ptree-channel [3:6]:
- (at 0, cp->sounds[0][0:99, 2.000]) [file: " cwd "oboe.snd[0]]
- (at 100, cp->sounds[0][100:199, 2.000, loc: 0, pos: 0, scl: 1.000, code: (lambda (y) (+ y 0.1))]) [file: " cwd "oboe.snd[0]]
- (at 200, cp->sounds[0][200:999, 2.000]) [file: " cwd "oboe.snd[0]]
- (at 1000, cp->sounds[0][1000:1099, 1.000, loc: 1, pos: 0, scl: 2.000, code: (lambda (y) (+ y 0.2))]) [file: " cwd "oboe.snd[0]]
- (at 1100, cp->sounds[0][1100:50827, 2.000]) [file: " cwd "oboe.snd[0]]
- (at 50828, end_mark)
-"))))
- (snd-display #__line__ ";ptree[1000] display: ~A" (safe-display-edits ind-ptree)))
-
- (env-channel '(0 0 1 1 2 0) 2000 1000 ind-map)
- (env-channel '(0 0 1 1 2 0) 2000 1000 ind-ptree)
- (map-channel (lambda (y) (+ y .3)) 4000 100 ind-map)
- (ptree-channel (lambda (y) (+ y .3)) 4000 100 ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree[2000] + .2 differs"))
- (map-channel (lambda (y) (+ y .1)) 0 3200 ind-map)
- (ptree-channel (lambda (y) (+ y .1)) 0 3200 ind-ptree)
- (if (not (vequal (channel->vct 0 (frames ind-map) ind-map) (channel->vct 0 (frames ind-ptree) ind-ptree)))
- (snd-display #__line__ ";ptree[3200] + .2 differs"))
- (undo 1 ind-ptree)
- (let ((reader (make-sampler (- (frames) 1) ind-ptree 0 -1)))
- (map-channel (lambda (y) (read-sample reader)) 0 (frames) ind-ptree))
- (let ((reader (make-sampler (- (frames) 1) ind-ptree 0 -1)))
- (map-channel (lambda (y) (read-sample reader)) 0 (frames) ind-ptree))
- (scan-channel (let ((old-reader (make-sampler 0 ind-ptree 0 1 (- (edit-position ind-ptree 0) 2)))
- (pos 0))
- (lambda (y)
- (let ((val (read-sample old-reader)))
- (if (fneq y val)
- (begin
- (display (format #f "~%;trouble in reverse ptree read at ~D ~A ~A" pos val y))
- #t)
- (begin
- (set! pos (+ 1 pos))
- #f))))))
- (close-sound ind-map)
- (close-sound ind-ptree))
-
- (let ((ind (new-sound "fmv.snd" mus-next mus-bfloat)))
- (set! (sinc-width) 10)
- (pad-channel 0 1000 ind)
- (set! (sample 100) 0.5)
- (if (fneq (sample 100 ind 0 2) 0.5) (snd-display #__line__ ";sample 100 (2): ~A" (sample 100 ind 0 2)))
- (if (fneq (sample 100 ind 0 1) 0.0) (snd-display #__line__ ";sample 100 (1): ~A" (sample 100 ind 0 1)))
- (src-channel 0.5)
- (let ((mx (maxamp ind 0)))
- (if (fneq mx 0.5) (snd-display #__line__ ";src-channel max .5: ~A" mx)))
- (if (fneq (sample 200) 0.5) (snd-display #__line__ ";src-channel 0.5 200: ~A" (sample 200)))
- (if (not (vequal (channel->vct 180 40 ind 0)
- (vct 0.000 -0.000 0.000 0.001 -0.000 -0.003 0.000 0.007 -0.000 -0.012
- 0.000 0.020 -0.000 -0.033 0.000 0.054 -0.000 -0.100 -0.000 0.316
- 0.500 0.316 -0.000 -0.100 -0.000 0.054 0.000 -0.033 -0.000 0.020
- 0.000 -0.012 -0.000 0.007 0.000 -0.003 -0.000 0.001 0.000 -0.000)))
- (snd-display #__line__ ";scr-channel 0.5 -> ~A" (channel->vct 180 40 ind 0)))
- (undo 1 ind 0)
- (src-channel 0.25)
- (let ((mx (maxamp ind 0)))
- (if (fneq mx 0.5) (snd-display #__line__ ";src-channel max .25: ~A" mx)))
- (if (fneq (sample 400) 0.5) (snd-display #__line__ ";src-channel 0.25 400: ~A" (sample 400)))
- (if (not (vequal (channel->vct 360 80 ind 0)
- (vct 0.000 -0.000 -0.000 -0.000 0.000 0.000 0.001 0.001 -0.000 -0.002
- -0.003 -0.003 0.000 0.004 0.007 0.006 -0.000 -0.008 -0.012 -0.010
- 0.000 0.013 0.020 0.016 -0.000 -0.021 -0.033 -0.026 0.000 0.034
- 0.054 0.044 -0.000 -0.060 -0.100 -0.087 -0.000 0.148 0.316 0.449
- 0.500 0.449 0.316 0.148 -0.000 -0.087 -0.100 -0.060 -0.000 0.044
- 0.054 0.034 0.000 -0.026 -0.033 -0.021 -0.000 0.016 0.020 0.013
- 0.000 -0.010 -0.012 -0.008 -0.000 0.006 0.007 0.004 0.000 -0.003
- -0.003 -0.002 -0.000 0.001 0.001 0.000 0.000 -0.000 -0.000 -0.000)))
- (snd-display #__line__ ";scr-channel 0.25 -> ~A" (channel->vct 360 80 ind 0)))
- (undo 2 ind 0)
- (map-channel (let ((i 0)) (lambda (y) (let ((val (sin (* i (/ pi 100))))) (set! i (+ 1 i)) (* .5 val)))))
- (for-each
- (lambda (sr df)
- (src-channel sr)
- (if (> (abs (- (maxamp ind 0) .5)) df) (snd-display #__line__ ";src-channel sine ~A: ~A" sr (maxamp ind 0)))
- (if (integer? sr)
- (let ((r0 (make-sampler 0))
- (r1 (make-sampler 0 ind 0 1 (- (edit-position) 1)))
- (sri (floor sr)))
- (do ((i 0 (+ 1 i)))
- ((= i 500))
- (let ((diff (abs (- (r0) (r1)))))
- (if (> diff df) (snd-display #__line__ ";src-channel ~A diff ~D: ~A" sr i diff))
- (do ((j 1 (+ 1 j)))
- ((= j sri))
- (r1))))))
- (do ((i 0 (+ 1 i)))
- ((= i 50))
- (let ((s1 (sample i ind 0 (edit-position)))
- (s2 (sample (round (* sr i)) ind 0 (- (edit-position) 1)))
- (s3 (sample i ind 0 1)))
- (if (> (abs (- s1 s2)) df) (snd-display #__line__ ";sample ~D src(~A): ~A ~A" i sr s1 s2))
- (if (fneq s3 0.0) (snd-display #__line__ ";sample ~D (1): ~A" i s3))))
- (undo 1 ind 0))
- (list 2.0 1.5 3.0 3.14)
- (list 0.008 0.01 0.015 0.025))
- (close-sound ind)
- (set! ind (open-sound "oboe.snd"))
- (let ((orig-max (maxamp ind 0)))
- (for-each
- (lambda (sr df)
- (src-channel sr)
- (if (> (abs (- (maxamp ind 0) orig-max)) df) (snd-display #__line__ ";src-channel oboe ~A: ~A ~A" sr orig-max (maxamp ind 0)))
- (if (integer? sr)
- (let ((r0 (make-sampler 0))
- (r1 (make-sampler 0 ind 0 1 (- (edit-position) 1)))
- (sri (floor sr)))
- (do ((i 0 (+ 1 i)))
- ((= i 5000))
- (let ((diff (abs (- (r0) (r1)))))
- (if (> diff df) (snd-display #__line__ ";src-channel oboe ~A diff ~D: ~A" sr i diff))
- (do ((j 1 (+ 1 j)))
- ((= j sri))
- (r1))))))
- (undo 1 ind 0))
- (list 2.0 1.5 3.0 3.14)
- (list 0.008 0.01 0.015 0.025))
-
- (for-each
- (lambda (sr df)
- (src-channel sr)
- (if (> (abs (- (maxamp ind 0) orig-max)) df) (snd-display #__line__ ";src-channel oboe ~A: ~A ~A" sr orig-max (maxamp ind 0)))
- (do ((i 0 (+ 1 i)))
- ((= i 50))
- (let* ((samp (* i 100))
- (s1 (sample samp ind 0 (edit-position)))
- (s2 (sample (floor (* sr samp)) ind 0 (- (edit-position) 1))))
- (if (> (abs (- s1 s2)) df) (snd-display #__line__ ";sample ~D oboe src(~A): ~A ~A" i sr s1 s2))))
- (undo 1 ind 0)
- (amp-envs-equal? ind 0 (edit-position) (+ 1 (edit-position)) .01))
- (list 0.5 0.25 0.9 0.1)
- (list 0.001 0.001 0.001 0.001)))
- (revert-sound ind)
- (scale-by 2.0)
- (scale-by 0.5)
- (amp-envs-equal? ind 0 (edit-position) (- (edit-position) 2) .001)
- (revert-sound ind)
- (ptree-channel (lambda (y) y) #f #f ind 0 0 #t)
- (amp-envs-equal? ind 0 (edit-position) (- (edit-position) 1) .001)
- (close-sound ind))
- (let ((ind (open-sound "storm.snd")))
- (ptree-channel (lambda (y) (* y .5)) 1000 123000 ind 0 0 #t) ; get the amp-env code too
- (pad-channel 0 10000)
- (ptree-channel (lambda (y) .1))
- (let ((reader (make-sampler 1000 ind 0 -1))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 10)))
- (let ((val (reader)))
- (if (fneq val .1)
- (begin
- (snd-display #__line__ ";ptree previous: ~A ~A" i val)
- (set! happy #f))))))
- (close-sound ind))
+ (revert-sound)
+ (scale-channel -0.9 0 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe scale -.9 0 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe scale -.9 0 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- ;; recursion tests
- (let ((old-opt (optimization))
- (ind (open-sound "oboe.snd")))
- (for-each
- (lambda (n)
- (set! (optimization) n)
- (let ((val (scan-channel (lambda (y)
- (let ((bigger (scan-channel (lambda (n5)
- (> n5 .1)))))
- bigger)))))
- (if (not (equal? val 0))
- (snd-display #__line__ ";scan-channel in scan-channel (~A): ~A" n val)))
- (let ((hi (make-vct 3))
- (ho (make-vct 3)))
- (vct-map! hi (lambda ()
- (if (scan-channel (lambda (y)
- (> y .1)))
- 1.0 0.0)))
- (if (not (vequal hi (vct 1.0 1.0 1.0))) (snd-display #__line__ ";vct-map! with scan-channel (~A): ~A" n hi))
- (vct-fill! ho .1)
- (vct-map! hi (lambda ()
- (vct-map! ho (lambda ()
- (+ (vct-ref ho 0) .1)))
- (vct-ref ho 0)))
- (if (not (vequal hi (vct .2 .3 .4))) (snd-display #__line__ ";vct-map! with vct-map! (~A): ~A ~A" n hi ho)))
- (let ((val (find-channel (lambda (y) (if (find-channel (lambda (n6) (> n6 .1))) #t #f)))))
- (if (not (= val 0)) (snd-display #__line__ ";find with find: ~A" val)))
- (let ((val (find-channel (lambda (y) (if (scan-channel (lambda (n7) (> n7 .1))) #t #f)))))
- (if (not (= val 0)) (snd-display #__line__ ";find with scan-channel: ~A" val)))
- (let ((mx (maxamp ind 0))
- (val (scan-channel (lambda (y) (map-channel (lambda (n) (* n 2))) #t))))
- (if (not (equal? val 0)) (snd-display #__line__ ";scan-channel with map-channel: ~A" val))
- (if (fneq mx (/ (maxamp ind 0) 2)) (snd-display #__line__ ";scan+map max: ~A ~A" mx (maxamp ind 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";scan+map edit-pos: ~A" (edit-position ind 0)))
- (revert-sound ind)
- (map-channel (let ((ctr 0))
- (lambda (y)
- (if (= ctr 0) (map-channel (lambda (n)
- (* n 2))))
- (set! ctr 1)
- y)))
- (if (fneq mx (maxamp ind 0)) (snd-display #__line__ ";map+map max 2: ~A ~A" mx (maxamp ind 0)))
- (if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";map+map edit-pos: ~A" (edit-position ind 0)))
- (if (fneq mx (/ (maxamp ind 0 1) 2)) (snd-display #__line__ ";map+map max 1: ~A ~A" mx (maxamp ind 0 1)))
- (revert-sound ind))
-
-
- )
- (list 0 5))
- (close-sound ind)
- (set! (optimization) old-opt))
+ (revert-sound)
+ (scale-channel 0.1 25000 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe scale .1 25000 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe scale .1 25000 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (let ((ind (open-sound "oboe.snd")))
- (for-each
- (lambda (func beg dur len)
- (let ((old-len (frames ind)))
- (func beg dur)
- (if (not (= (frames ind) len))
- (snd-display #__line__ ";(~A ~A ~A) with ~A -> ~A (~A)?" func beg dur old-len (frames ind) len))))
- (list (lambda (beg dur) (env-channel '(0 0 1 1) beg dur))
- (lambda (beg dur) (map-channel (lambda (y) (* y .5)) beg dur))
- (lambda (beg dur) (reverse-channel beg dur))
- (lambda (beg dur) (scale-channel 2.0 beg dur))
- (lambda (beg dur) (vct->channel (make-vct dur) beg dur))
- (lambda (beg dur) (smooth-channel beg dur))
- (lambda (beg dur) (pad-channel beg dur))
- (lambda (beg dur) (src-channel 0.5 beg dur))
- (lambda (beg dur) (insert-silence beg dur)))
- (list 0 0 0 0 0 0 0 0 0)
- (list 1000 1000 1000 1000 1000 1000 1000 1000 1000)
- (list 50828 50828 50828 50828 50828 50828 51828 52829 53829))
-
- (revert-sound ind)
-
- (for-each
- (lambda (beg dur len)
- (let ((old-len (frames ind)))
- (pad-channel beg dur)
- (if (not (= (frames ind) len))
- (snd-display #__line__ ";(pad-channel ~A ~A) with ~A -> ~A (~A)?" beg dur old-len (frames ind) len))))
- (list 1000 60000 0 62000 62000 62004)
- (list 1000 1000 1000 1 2 1)
- (list 51828 61000 62000 62001 62003 62005))
-
- (revert-sound ind)
-
- (for-each
- (lambda (func dur len)
- (let ((old-len (frames ind)))
- (func (+ old-len 100) dur)
- (if (not (= (frames ind) len))
- (snd-display #__line__ ";(~A ~A) with ~A -> ~A (~A)?" func dur old-len (frames ind) len))))
- (list (lambda (beg dur) (env-channel '(0 0 1 1) beg dur))
- (lambda (beg dur) (reverse-channel beg dur))
- (lambda (beg dur) (scale-channel 2.0 beg dur))
- (lambda (beg dur) (scale-sound-by 2.0 beg dur))
- (lambda (beg dur) (vct->channel (make-vct dur) beg dur))
- (lambda (beg dur) (smooth-channel beg dur))
- (lambda (beg dur) (pad-channel beg dur))
- (lambda (beg dur) (src-channel 0.5 beg dur))
- (lambda (beg dur) (insert-silence beg dur)) ; diff from pad-channel
- (lambda (beg dur) (env-sound '(0 0 1 1) beg dur))
- )
- (list 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000)
- (list 50828 50828 50828 50828 51928 51928 53028 53028 54028 54028))
-
- (revert-sound ind)
-
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (case (floor (random 10))
- ((0) (pad-channel (random (* 1.25 (frames))) (random 1000)))
- ((1) (env-channel '(0 0 1 1 2 0) (random (* 1.25 (frames))) (random 1000)))
- ((2) (env-sound '(0 0 1 1 2 0) (random (* 1.25 (frames))) (random 1000)))
- ((3) (scale-channel (random 1.0) (random (* 1.25 (frames))) (random 1000)))
- ((4) (scale-sound-by (random 1.0) (random (* 1.25 (frames))) (random 1000)))
- ((5) (src-channel (+ .9 (random .2)) (random (* 1.25 (frames))) (random 1000)))
- ((6) (ramp-channel (random 1.0) (random 1.0) (random (* 1.25 (frames))) (random 1000)))
- ((7) (reverse-channel (random (* 1.25 (frames))) (random 1000)))
- ((8) (let ((dur (max 2 (floor (random 100))))) (vct->channel (make-vct dur) (random (* 1.25 (frames))) dur)))
- ((9) (map-channel (lambda (y) (* y 2)) (random (* .5 (frames))) (random 1000)))))
-
- (close-sound ind))
+ (revert-sound)
+ (scale-channel -2.0 24900 100)
+ (if (fneq (maxamp) 0.29449462890625)
+ (snd-display #__line__ ";oboe scale -2 24900 100 max: ~A (should be ~A)~%" (maxamp) 0.29449462890625))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe scale -2 24900 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (let ((ind (new-sound "test.snd")))
- (pad-channel 0 100000) ; force tempfile in fallback
- (ptree-channel (lambda (y) (if (current-input-port) 1.0 0.0)))
- (if (fneq (maxamp ind) 1.0)
- (snd-display #__line__ ";ptree fallback: ~A" (maxamp ind)))
- (undo)
- (ptree-channel (lambda (y data dir)
- (if (current-input-port) (* y 0.5) (* y (vct-ref data 0))))
- 0 #f ind 0 #f #f
- (lambda (pos dur)
- (vct 1.0)))
- (close-sound ind))
+ (revert-sound)
+ (scale-channel 0.1 24900 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe scale 0.1 24900 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 25368))
+ (snd-display #__line__ ";oboe scale 0.1 24900 100 max pos: ~A (should be ~A)~%" (maxamp-position) 25368))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
+
+ ;; ramp/xramp samples
+ (revert-sound)
+ (ramp-channel 0.0 1.0)
+ (if (fneq (maxamp) 0.091239139496063)
+ (snd-display #__line__ ";oboe ramp 0 1 max: ~A (should be ~A)~%" (maxamp) 0.091239139496063))
+ (if (not (= (maxamp-position) 35062))
+ (snd-display #__line__ ";oboe ramp 0 1 max pos: ~A (should be ~A)~%" (maxamp-position) 35062))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (let ((ind0 (open-sound "oboe.snd"))
- (ind1 (open-sound "2.snd"))
- (ind2 (open-sound "4.aiff")))
- (set! (squelch-update ind0 #t) #t)
- (set! (squelch-update ind1 #t) #t)
- (set! (squelch-update ind2 #t) #t)
- (catch 'mus-error
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 500))
- (set! (sync ind0) (random 3))
- (set! (sync ind1) (random 3))
- (set! (sync ind2) (random 3))
- (opt-test (random 22))))
- (lambda args
- (snd-display #__line__ ";caught mus-error")
- #f))
- (set! (squelch-update ind0 #t) #f)
- (set! (squelch-update ind1 #t) #f)
- (set! (squelch-update ind2 #t) #f)
- (close-sound ind0)
- (close-sound ind1)
- (close-sound ind2))
+ (revert-sound)
+ (xramp-channel 0.0 1.0 3.0)
+ (if (fneq (maxamp) 0.074973157321056)
+ (snd-display #__line__ ";oboe xramp 0 1 max: ~A (should be ~A)~%" (maxamp) 0.074973157321056))
+ (if (not (= (maxamp-position) 35062))
+ (snd-display #__line__ ";oboe xramp 0 1 max pos: ~A (should be ~A)~%" (maxamp-position) 35062))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (let ((ind (open-sound "oboe.snd")))
- (env-channel '(0 0 1 1 2 0) 1000 10000)
- (ptree-channel (lambda (y) (* y 2)) 20000 10000)
- (ramp-channel .2 .6 40000 10000)
- (scale-channel .5 0 500)
- (if (> (optimization) 0)
- (check-edit-tree '((0 0 0 499 0.5 0.0 0.0 0) (500 0 500 999 1.0 0.0 0.0 0) (1000 0 1000 5999 1.0 0.0 1.99999994947575e-4 4) (6000 0 6000 10999 1.0 1.0 -2.00040012714453e-4 4) (11000 0 11000 19999 1.0 0.0 0.0 0) (20000 0 20000 29999 1.0 0.0 0.0 16) (30000 0 30000 39999 1.0 0.0 0.0 0) (40000 0 40000 49999 1.0 0.200000002980232 4.00040007662028e-5 4) (50000 0 50000 50827 1.0 0.0 0.0 0) (50828 -2 0 0 0.0 0.0 0.0 0))
- #f "no-overlaps"))
- (revert-sound ind)
- (pad-channel 0 1000)
- (ptree-channel (lambda (y) (+ y .1)) 0 2000)
- (let ((val (sample 100)))
- (if (fneq val .1)
- (snd-display #__line__ ";pad+ptree: ~A" val)))
- (undo 2)
- (pad-channel 0 2000)
- (ptree-channel (lambda (y) (+ y .1)) 1000 200)
- (let ((val (sample 1100)))
- (if (fneq val .1)
- (snd-display #__line__ ";pad+ptree(2): ~A" val)))
- (undo 2)
- (pad-channel 1000 1000)
- (ptree-channel (lambda (y) (+ y .1)) 0 1500)
- (let ((val (sample 1100)))
- (if (fneq val .1)
- (snd-display #__line__ ";pad+ptree(3): ~A" val)))
- (undo 2)
- (close-sound ind))
+ (revert-sound)
+ (ramp-channel 0.0 -1.0 0 100)
+ (if (fneq (maxamp) 0.14724731445312)
+ (snd-display #__line__ ";oboe ramp 0 -1 0 100 max: ~A (should be ~A)~%" (maxamp) 0.14724731445312))
+ (if (not (= (maxamp-position) 24971))
+ (snd-display #__line__ ";oboe ramp 0 -1 0 100 max pos: ~A (should be ~A)~%" (maxamp-position) 24971))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (catch #t
- (lambda ()
- (let* ((ind (open-sound (string-append home-dir "/test/sound/away.snd")))
- (start (real-time))
- (mxs (maxamp ind #t)))
- (swap-channels)
- (update-time-graph)
- (let ((tm (- (real-time) start)))
- (if (> tm .1) (snd-display #__line__ ";swap-channels not optimized? ~A" tm)))
- (let ((new-mxs (maxamp ind #t)))
- (if (or (fneq (car mxs) (cadr new-mxs))
- (fneq (cadr mxs) (car new-mxs)))
- (snd-display #__line__ ";swap-channels amps: ~A -> ~A" mxs new-mxs)))
- (revert-sound ind)
- (close-sound ind)))
- (lambda args args)) ; away.snd may not exist
+ (revert-sound)
+ (ramp-channel 1.0 9.0 10000 100)
+ (if (fneq (maxamp) 1.057239571003)
+ (snd-display #__line__ ";oboe ramp 1 9 10000 100 max: ~A (should be ~A)~%" (maxamp) 1.057239571003))
+ (if (not (= (maxamp-position) 10089))
+ (snd-display #__line__ ";oboe ramp 1 9 10000 100 max pos: ~A (should be ~A)~%" (maxamp-position) 10089))
+ (if (fneq (abs (sample (maxamp-position))) (maxamp))
+ (snd-display #__line__ ";oboe maxes: ~A ~A~%" (maxamp) (abs (sample (maxamp-position)))))
- (let ((ind (init-sound 0.5 10 2)))
- (save-sound ind)
- (scale-channel 2.0 0 (frames) ind 1)
- (swap-channels)
- (check-both-chans ind "1" (lambda (y) (fneq y 1.0)) (lambda (y) (fneq y 0.5)))
- (undo 1 ind 0)
- (undo 2 ind 1)
- (scale-channel 0.5 0 (frames) ind 0)
- (scale-channel 2.0 0 (frames) ind 1)
- (swap-channels)
- (check-both-chans ind "2" (lambda (y) (fneq y 1.0)) (lambda (y) (fneq y 0.25)))
- (undo 2 ind 0)
- (undo 2 ind 1)
- (delete-samples 2 3 ind 0)
- (env-channel '(0 0 1 1 2 0) 0 (frames ind 1) ind 1)
- (swap-channels)
- (if (not (= (frames ind 1) 11)) (snd-display #__line__ ";frames swapped: ~A" (frames ind 1)))
- (if (not (vequal (channel->vct 0 (frames ind 0) ind 0) (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000)))
- (snd-display #__line__ ";swapped env: ~A" (channel->vct 0 (frames ind 0) ind 0)))
- (undo 2 ind 0)
- (undo 2 ind 1)
- (delete-samples 2 7 ind 0)
- (swap-channels ind 0 ind 1 5 4)
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0.500 0.500 0.500 0.500 0.000 0.500 0.500 0.500 0.500 0.000)))
- (snd-display #__line__ ";partial swap 1: ~A" (channel->vct 0 10 ind 0)))
- (if (not (vequal (channel->vct 0 10 ind 1) (vct 0.500 0.500 0.500 0.500 0.500 0.000 0.000 0.000 0.000 0.500)))
- (snd-display #__line__ ";partial swap 2: ~A" (channel->vct 0 10 ind 1)))
- (revert-sound ind)
- (let ((m0 (add-mark 3 ind 0))
- (m1 (add-mark 4 ind 1))
- (m2 (add-mark 5 ind 1)))
- (scale-channel 0.5)
+ (close-sound ind))
+
+ (let ((ind0 (open-sound "oboe.snd"))
+ (ind1 (open-sound "2.snd"))
+ (ind2 (open-sound "4.aiff")))
+ (set! (squelch-update ind0 #t) #t)
+ (set! (squelch-update ind1 #t) #t)
+ (set! (squelch-update ind2 #t) #t)
+ (catch 'mus-error
+ (lambda ()
+ (do ((i 0 (+ i 1)))
+ ((= i 500))
+ (set! (sync ind0) (random 3))
+ (set! (sync ind1) (random 3))
+ (set! (sync ind2) (random 3))
+ (opt-test (random 22))))
+ (lambda args
+ (snd-display #__line__ ";caught mus-error")
+ #f))
+ (set! (squelch-update ind0 #t) #f)
+ (set! (squelch-update ind1 #t) #f)
+ (set! (squelch-update ind2 #t) #f)
+ (close-sound ind0)
+ (close-sound ind1)
+ (close-sound ind2))
+
+ (catch #t
+ (lambda ()
+ (let* ((ind (open-sound (string-append home-dir "/test/sound/away.snd")))
+ (start (real-time))
+ (mxs (maxamp ind #t)))
(swap-channels)
- (if (not (= (mark-sample m0) 3)) (snd-display #__line__ ";swapped m0: ~A" (mark-sample m0)))
- (if (not (= (mark-sample m1) 4)) (snd-display #__line__ ";swapped m1: ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) 5)) (snd-display #__line__ ";swapped m2: ~A" (mark-sample m2)))
- (if (not (equal? (mark-home m0) (list ind 1))) (snd-display #__line__ ";mark-home m0: ~A" (mark-home m0)))
- (if (not (equal? (mark-home m1) (list ind 0))) (snd-display #__line__ ";mark-home m1: ~A" (mark-home m1)))
- (if (not (equal? (mark-home m2) (list ind 0))) (snd-display #__line__ ";mark-home m2: ~A" (mark-home m2)))
- (undo 1 ind 0)
- (undo 1 ind 1)
- (if (not (= (mark-sample m0) 3)) (snd-display #__line__ ";swapped m0 2: ~A" (mark-sample m0)))
- (if (not (= (mark-sample m1) 4)) (snd-display #__line__ ";swapped m1 2: ~A" (mark-sample m1)))
- (if (not (= (mark-sample m2) 5)) (snd-display #__line__ ";swapped m2 2: ~A" (mark-sample m2)))
- (if (not (equal? (mark-home m0) (list ind 0))) (snd-display #__line__ ";mark-home m0 2: ~A" (mark-home m0)))
- (if (not (equal? (mark-home m1) (list ind 1))) (snd-display #__line__ ";mark-home m1 2: ~A" (mark-home m1)))
- (if (not (equal? (mark-home m2) (list ind 1))) (snd-display #__line__ ";mark-home m2 2: ~A" (mark-home m2))))
- (close-sound ind)
- (delete-file "test.snd"))
-
- (let ((ind (init-sound 0.5 10 4)))
- (scale-channel 0.5 0 (frames) ind 1)
- (scale-channel 0.25 0 (frames) ind 2)
- (scale-channel 0.125 0 (frames) ind 3)
- (swap-channels ind 1 ind 2)
- (let ((maxs (maxamp ind #t)))
- (if (or (fneq (list-ref maxs 0) 0.5) (fneq (list-ref maxs 1) 0.125) (fneq (list-ref maxs 2) 0.25) (fneq (list-ref maxs 3) 0.0625))
- (snd-display #__line__ ";swap midchans: ~A" maxs))
+ (update-time-graph)
+ (let ((tm (- (real-time) start)))
+ (if (> tm .1) (snd-display #__line__ ";swap-channels not optimized? ~A" tm)))
+ (let ((new-mxs (maxamp ind #t)))
+ (if (or (fneq (car mxs) (cadr new-mxs))
+ (fneq (cadr mxs) (car new-mxs)))
+ (snd-display #__line__ ";swap-channels amps: ~A -> ~A" mxs new-mxs)))
+ (revert-sound ind)
(close-sound ind)))
-
- (let* ((ind0 (open-sound "oboe.snd"))
- (ind1 (open-sound "pistol.snd"))
- (mx0 (maxamp ind0 0))
- (mx1 (maxamp ind1 0)))
- (swap-channels ind0 0 ind1 0)
- (if (fneq (maxamp ind0 0) mx1) (snd-display #__line__ ";maxamp cross swap 0: ~A" (maxamp ind0 0)))
- (if (fneq (maxamp ind1 0) mx0) (snd-display #__line__ ";maxamp cross swap 1: ~A" (maxamp ind1 0)))
- (close-sound ind1)
- (if (and (> (optimization) 0)
- (not (string=? (display-edits) (string-append "
+ (lambda args args)) ; away.snd may not exist
+
+ (let ((ind (init-sound 0.5 10 2)))
+ (save-sound ind)
+ (scale-channel 2.0 0 (framples) ind 1)
+ (swap-channels)
+ (check-both-chans ind "1" (lambda (y) (fneq y 1.0)) (lambda (y) (fneq y 0.5)))
+ (undo 1 ind 0)
+ (undo 2 ind 1)
+ (scale-channel 0.5 0 (framples) ind 0)
+ (scale-channel 2.0 0 (framples) ind 1)
+ (swap-channels)
+ (check-both-chans ind "2" (lambda (y) (fneq y 1.0)) (lambda (y) (fneq y 0.25)))
+ (undo 2 ind 0)
+ (undo 2 ind 1)
+ (delete-samples 2 3 ind 0)
+ (env-channel '(0 0 1 1 2 0) 0 (framples ind 1) ind 1)
+ (swap-channels)
+ (undo 2 ind 0)
+ (undo 2 ind 1)
+ (delete-samples 2 7 ind 0)
+ (swap-channels ind 0 ind 1 5 4)
+ (revert-sound ind)
+ (let ((m0 (add-mark 3 ind 0))
+ (m1 (add-mark 4 ind 1))
+ (m2 (add-mark 5 ind 1)))
+ (scale-channel 0.5)
+ (swap-channels)
+ (if (not (= (mark-sample m0) 3)) (snd-display #__line__ ";swapped m0: ~A" (mark-sample m0)))
+ (if (not (= (mark-sample m1) 4)) (snd-display #__line__ ";swapped m1: ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 5)) (snd-display #__line__ ";swapped m2: ~A" (mark-sample m2)))
+ (if (not (equal? (mark-home m0) (list ind 1))) (snd-display #__line__ ";mark-home m0: ~A" (mark-home m0)))
+ (if (not (equal? (mark-home m1) (list ind 0))) (snd-display #__line__ ";mark-home m1: ~A" (mark-home m1)))
+ (if (not (equal? (mark-home m2) (list ind 0))) (snd-display #__line__ ";mark-home m2: ~A" (mark-home m2)))
+ (undo 1 ind 0)
+ (undo 1 ind 1)
+ (if (not (= (mark-sample m0) 3)) (snd-display #__line__ ";swapped m0 2: ~A" (mark-sample m0)))
+ (if (not (= (mark-sample m1) 4)) (snd-display #__line__ ";swapped m1 2: ~A" (mark-sample m1)))
+ (if (not (= (mark-sample m2) 5)) (snd-display #__line__ ";swapped m2 2: ~A" (mark-sample m2)))
+ (if (not (equal? (mark-home m0) (list ind 0))) (snd-display #__line__ ";mark-home m0 2: ~A" (mark-home m0)))
+ (if (not (equal? (mark-home m1) (list ind 1))) (snd-display #__line__ ";mark-home m1 2: ~A" (mark-home m1)))
+ (if (not (equal? (mark-home m2) (list ind 1))) (snd-display #__line__ ";mark-home m2 2: ~A" (mark-home m2))))
+ (close-sound ind)
+ (delete-file "test.snd"))
+
+ (let ((ind (init-sound 0.5 10 4)))
+ (scale-channel 0.5 0 (framples) ind 1)
+ (scale-channel 0.25 0 (framples) ind 2)
+ (scale-channel 0.125 0 (framples) ind 3)
+ (swap-channels ind 1 ind 2)
+ (let ((maxs (maxamp ind #t)))
+ (if (or (fneq (maxs 0) 0.5) (fneq (maxs 1) 0.125) (fneq (maxs 2) 0.25) (fneq (maxs 3) 0.0625))
+ (snd-display #__line__ ";swap midchans: ~A" maxs))
+ (close-sound ind)))
+
+ (let* ((ind0 (open-sound "oboe.snd"))
+ (ind1 (open-sound "pistol.snd"))
+ (mx0 (maxamp ind0 0))
+ (mx1 (maxamp ind1 0)))
+ (swap-channels ind0 0 ind1 0)
+ (if (fneq (maxamp ind0 0) mx1) (snd-display #__line__ ";maxamp cross swap 0: ~A" (maxamp ind0 0)))
+ (if (fneq (maxamp ind1 0) mx0) (snd-display #__line__ ";maxamp cross swap 1: ~A" (maxamp ind1 0)))
+ (close-sound ind1)
+ (if (not (string=? (display-edits) (string-append "
EDITS: 1
(begin) [0:2]:
@@ -38818,1142 +31968,1035 @@ EDITS: 1
(set 0 41623) ; swap-channels [1:2]:
(at 0, cp->sounds[1][0:41622, 1.000]) [file: " cwd "pistol.snd[0]]
(at 41623, end_mark)
-"))))
- (snd-display #__line__ ";cross swap state: ~A" (display-edits)))
- (close-sound ind0))
+")))
+ (snd-display #__line__ ";cross swap state: ~A" (display-edits)))
+ (close-sound ind0))
+
+ (let ((ind (init-sound 1.0 10 1)))
- (let ((ind (init-sound 1.0 10 1)))
-
- ;; -------- ramp+ramp
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 1" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 2" (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000))
- (undo)
- (ramp-channel 1.0 0.0)
- (check-back-and-forth ind "ramp 3" (vct 0.000 0.090 0.160 0.210 0.240 0.250 0.240 0.210 0.160 0.090 0.000))
- (undo)
- (env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ramp 4" (vct 0.000 0.020 0.080 0.180 0.320 0.500 0.480 0.420 0.320 0.180 0.000))
- (undo 2)
- (env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ramp 5" (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200 0.000))
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 6" (vct 0.000 0.020 0.080 0.180 0.320 0.500 0.480 0.420 0.320 0.180 0.000))
- (scale-channel 0.5)
- (check-back-and-forth ind "ramp 7" (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.240 0.210 0.160 0.090 0.000))
- (undo 3)
- (scale-channel 0.5)
- (env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ramp 8" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000))
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 9" (vct 0.000 0.010 0.040 0.090 0.160 0.250 0.240 0.210 0.160 0.090 0.000))
- (undo 3)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ramp 10" (vct 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000))
- (undo 3)
-
-
- ;; -------- ramp+ptree
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "ramp+ptree 1" (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800 2.000))
- (scale-channel .5)
- (check-back-and-forth ind "ramp+ptree 2" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (ptree-channel (lambda (y) (+ y .5)))
- (check-back-and-forth ind "ramp+ptree 3" (vct 0.500 0.600 0.700 0.800 0.900 1.000 1.100 1.200 1.300 1.400 1.500))
- (undo 4)
- (env-channel '(0 0 1 1 2 0))
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "ramp+ptree 4" (vct 0.000 0.400 0.800 1.200 1.600 2.000 1.600 1.200 0.800 0.400 0.000))
- (undo 2)
- (scale-channel .5)
- (env-channel '(0 0 1 1 2 0))
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "ramp+ptree 5" (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200 0.000))
- (scale-by .5)
- (check-back-and-forth ind "ramp+ptree 6" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000))
- (undo 4)
- (ramp-channel 0.0 1.0)
- (scale-channel 0.5)
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "ramp+ptree 7" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (scale-channel 0.5)
- (check-back-and-forth ind "ramp+ptree 8" (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450 0.500))
- (undo 4)
- (ramp-channel 0.0 1.0 0 5)
- (ptree-channel (lambda (y) (* y 2.0)) 3 3)
- (check-back-and-forth ind "ramp+ptree 9" (vct 0.000 0.250 0.500 1.500 2.000 2.000 1.000 1.000 1.000 1.000 1.000))
- (undo 2)
- (ramp-channel 0.0 1.0 0 5)
- (ptree-channel (lambda (y) (* y 2.0)) 0 3)
- (check-back-and-forth ind "ramp+ptree 10" (vct 0.000 0.500 1.000 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (undo 2)
- (ramp-channel 1.0 0.0 5 5)
- (ptree-channel (lambda (y) (* y 2.0)) 3 4)
- (check-back-and-forth ind "ramp+ptree 11" (vct 1.000 1.000 1.000 2.000 2.000 2.000 1.500 0.500 0.250 0.000 1.000))
- (undo 2)
-
- ;; ramp+scl (checking split loc)
- (ramp-channel 0.0 1.0 0 5)
- (scale-channel 0.5 3 3)
- (check-back-and-forth ind "ramp+scl 12" (vct 0.000 0.250 0.500 0.375 0.500 0.500 1.000 1.000 1.000 1.000 1.000))
- (undo 2)
- (ramp-channel 1.0 0.0 5 5)
- (scale-channel 0.5 4 3)
- (check-back-and-forth ind "ramp+scl 13" (vct 1.000 1.000 1.000 1.000 0.500 0.500 0.375 0.500 0.250 0.000 1.000))
- (undo 2)
-
- ;; ramp+scl (checking split loc)
-
- (let ((start-pos (edit-position ind 0)))
- (for-each
- (lambda (func)
- (ramp-channel 0.0 1.0 0 5)
- (let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl setup" (vct 0.000 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
- ((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (vct 0.000 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! v (+ start i) (* (vct-ref v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
- (set! (edit-position ind 0) start-pos)
-
- (ramp-channel 1.0 0.0 5 5)
- (let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl 2 setup" (vct 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
- ((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (vct 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! v (+ start i) (* (vct-ref v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
- (set! (edit-position ind 0) start-pos)
-
- (ramp-channel 0.0 1.0 0 5)
- (ramp-channel 1.0 0.0 5 5)
- (let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl 3 setup" (vct 0.000 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.000 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
+ ;; -------- ramp+ramp
+ (ramp-channel 0.0 1.0)
+ (check-back-and-forth ind "ramp 1" (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
+ (ramp-channel 0.0 1.0)
+ (check-back-and-forth ind "ramp 2" (float-vector 0.000 0.010 0.040 0.090 0.160 0.250 0.360 0.490 0.640 0.810 1.000))
+ (undo)
+ (ramp-channel 1.0 0.0)
+ (check-back-and-forth ind "ramp 3" (float-vector 0.000 0.090 0.160 0.210 0.240 0.250 0.240 0.210 0.160 0.090 0.000))
+ (undo)
+ (env-channel '(0 0 1 1 2 0))
+ (check-back-and-forth ind "ramp 4" (float-vector 0.000 0.020 0.080 0.180 0.320 0.500 0.480 0.420 0.320 0.180 0.000))
+ (undo 2)
+ (env-channel '(0 0 1 1 2 0))
+ (check-back-and-forth ind "ramp 5" (float-vector 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200 0.000))
+ (ramp-channel 0.0 1.0)
+ (check-back-and-forth ind "ramp 6" (float-vector 0.000 0.020 0.080 0.180 0.320 0.500 0.480 0.420 0.320 0.180 0.000))
+ (scale-channel 0.5)
+ (check-back-and-forth ind "ramp 7" (float-vector 0.000 0.010 0.040 0.090 0.160 0.250 0.240 0.210 0.160 0.090 0.000))
+ (undo 3)
+ (scale-channel 0.5)
+ (env-channel '(0 0 1 1 2 0))
+ (check-back-and-forth ind "ramp 8" (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000))
+ (ramp-channel 0.0 1.0)
+ (check-back-and-forth ind "ramp 9" (float-vector 0.000 0.010 0.040 0.090 0.160 0.250 0.240 0.210 0.160 0.090 0.000))
+ (undo 3)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (ramp-channel 0.0 1.0)
+ (check-back-and-forth ind "ramp 10" (float-vector 0.000 0.001 0.008 0.027 0.064 0.125 0.216 0.343 0.512 0.729 1.000))
+ (undo 3)
+
+
+ ;; ramp+scl (checking split loc)
+
+ (let ((start-pos (edit-position ind 0)))
+ (for-each
+ (lambda (func)
+ (ramp-channel 0.0 1.0 0 5)
+ (let ((edpos (edit-position ind 0)))
+ (check-back-and-forth ind "ramp+scl setup" (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
+ (let ((happy #t))
+ (do ((start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (vct 0.000 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.000 1.000)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! v (+ start i) (* (vct-ref v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
- (set! (edit-position ind 0) start-pos)
-
- (ramp-channel 1.0 0.0 3 5)
- (let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl 4 setup" (vct 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000 1.000 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
+ (= (+ start len) 11)))
+ (let ((v (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)
+ )))))
+ (set! (edit-position ind 0) start-pos)
+
+ (ramp-channel 1.0 0.0 5 5)
+ (let ((edpos (edit-position ind 0)))
+ (check-back-and-forth ind "ramp+scl 2 setup" (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000))
+ (let ((happy #t))
+ (do ((start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (vct 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000 1.000 1.000)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! v (+ start i) (* (vct-ref v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl mid 1-0 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
- (set! (edit-position ind 0) start-pos)
-
- (env-channel '(0 1 1 0 2 0 3 1))
- (let ((edpos (edit-position ind 0)))
- (check-back-and-forth ind "ramp+scl setup" (vct 1.000 0.667 0.333 0.000 0.000 0.000 0.000 0.000 0.333 0.667 1.000))
- (let ((happy #t))
- (do ((start 0 (+ 1 start)))
+ (= (+ start len) 11)))
+ (let ((v (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)
+ )))))
+ (set! (edit-position ind 0) start-pos)
+
+ (ramp-channel 0.0 1.0 0 5)
+ (ramp-channel 1.0 0.0 5 5)
+ (let ((edpos (edit-position ind 0)))
+ (check-back-and-forth ind "ramp+scl 3 setup" (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.000 1.000))
+ (let ((happy #t))
+ (do ((start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
((or (not happy)
- (= start 10)))
- (do ((len 1 (+ 1 len)))
- ((or (not happy)
- (= (+ start len) 11)))
- (let ((v (vct 1.000 0.667 0.333 0.000 0.000 0.000 0.000 0.000 0.333 0.667 1.000)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (vct-set! v (+ start i) (* (vct-ref v (+ start i)) 0.5)))
- (func 0.5 start len)
- (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-0-1 [~A ~A] with ~A" start len func) v))
- (set! (edit-position ind 0) edpos)
- )))))
- (set! (edit-position ind 0) start-pos))
+ (= (+ start len) 11)))
+ (let ((v (float-vector 0.000 0.250 0.500 0.750 1.000 1.000 0.750 0.500 0.250 0.000 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)
+ )))))
+ (set! (edit-position ind 0) start-pos)
- (list
- (lambda (scl beg dur)
- (scale-channel scl beg dur))
- (lambda (scl beg dur)
- (ptree-channel (lambda (y) (* y scl)) beg dur))
- (lambda (scl beg dur)
- (map-channel (lambda (y) (* y scl)) beg dur))
- (lambda (scl beg dur)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- beg dur ind 0 #f #f (lambda (pos dur) (vct scl)))))))
-
- ;; -------- ramp+ptree-closure
- (ramp-channel 0.0 1.0)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "ramp+ptreec 1" (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800 2.000))
- (scale-channel .5)
- (check-back-and-forth ind "ramp+ptreec 2" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (ptree-channel (lambda (y data dir)
- (+ y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 0.5)))
- (check-back-and-forth ind "ramp+ptreec 3" (vct 0.500 0.600 0.700 0.800 0.900 1.000 1.100 1.200 1.300 1.400 1.500))
- (undo 4)
- (env-channel '(0 0 1 1 2 0))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "ramp+ptreec 4" (vct 0.000 0.400 0.800 1.200 1.600 2.000 1.600 1.200 0.800 0.400 0.000))
- (undo 2)
- (scale-channel .5)
- (env-channel '(0 0 1 1 2 0))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "ramp+ptreec 5" (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200 0.000))
- (scale-by .5)
- (check-back-and-forth ind "ramp+ptreec 6" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000))
- (undo 4)
- (ramp-channel 0.0 1.0)
- (scale-channel 0.5)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "ramp+ptreec 7" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (scale-channel 0.5)
- (check-back-and-forth ind "ramp+ptreec 8" (vct 0.000 0.050 0.100 0.150 0.200 0.250 0.300 0.350 0.400 0.450 0.500))
- (undo 4)
-
-
- ;; -------- xramp+ptree+closure
- (xramp-channel 0.0 1.0 .0325)
- (check-back-and-forth ind "xramp(+ptree+closure) 0" (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "xramp+ptree-closure 1" (vct-scale! (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000) 2.0))
- (scale-channel .5)
- (check-back-and-forth ind "xramp+ptree-closure 2" (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000))
- (ptree-channel (lambda (y data dir)
- (+ y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 0.5)))
- (check-back-and-forth ind "xramp+ptree-closure 3" (vct-offset! (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000) 0.5))
- (undo 4)
- (env-sound '(0 0 1 1 2 0) 0 11 .0325)
- (check-back-and-forth ind "xramp(+ptree-closure) 4" (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "xramp+ptree-closure 4" (vct-scale! (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000) 2.0))
- (undo 2)
- (scale-channel .5)
- (env-sound '(0 0 1 1 2 0) 0 11 .0325)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "xramp+ptree-closure 5" (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000))
- (scale-by .5)
- (check-back-and-forth ind "ramp+ptree-closure 6" (vct-scale! (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000) 0.5))
- (undo 4)
- (xramp-channel 0.0 1.0 .0325)
- (scale-channel 0.5)
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 (frames) ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "xramp+ptree-closure 7" (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000))
- (scale-channel 0.5)
- (check-back-and-forth ind "ramp+ptree-closure 8" (vct-scale! (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000) 0.5))
- (undo 4)
- (xramp-channel 0.0 1.0 .0325 0 5)
- (check-back-and-forth ind "xramp(+ptree-closure) 9" (vct 0.000 0.595 0.847 0.954 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 3 3 ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "xramp+ptree-closure 9" (vct 0.000 0.595 0.847 1.909 2.000 2.000 1.000 1.000 1.000 1.000 1.000))
- (undo 2)
- (xramp-channel 0.0 1.0 .0325 0 5)
- (check-back-and-forth ind "xramp(+ptree-closure) 10" (vct 0.000 0.595 0.847 0.954 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 0 3 ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "xramp+ptree-closure 10" (vct 0.000 1.189 1.695 0.954 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (undo 2)
- (xramp-channel 1.0 0.0 .0325 5 5)
- (check-back-and-forth ind "xramp(+ptree-closure) 11" (vct 1.000 1.000 1.000 1.000 1.000 1.000 0.954 0.847 0.595 0.000 1.000))
- (ptree-channel (lambda (y data dir)
- (* y (vct-ref data 0)))
- 3 4 ind 0 #f #f (lambda (pos dur) (vct 2.0)))
- (check-back-and-forth ind "xramp+ptree-closure 11" (vct 1.000 1.000 1.000 2.000 2.000 2.000 1.909 0.847 0.595 0.000 1.000))
- (undo 2)
-
- ;; -------- ptree+ramp
- (ptree-channel (lambda (y) (* y 2.0)))
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ptree+ramp 1" (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800 2.000))
- (scale-channel .5)
- (check-back-and-forth ind "ptree+ramp 2" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (undo 3)
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ptree+ramp 3" (vct 0.000 0.400 0.800 1.200 1.600 2.000 1.600 1.200 0.800 0.400 0.000))
- (undo 2)
- (scale-channel .5)
- (ptree-channel (lambda (y) (* y 2.0)))
- (env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ptree+ramp 4" (vct 0.000 0.200 0.400 0.600 0.800 1.000 0.800 0.600 0.400 0.200 0.000))
- (scale-by .5)
- (check-back-and-forth ind "ptree+ramp 5" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.400 0.300 0.200 0.100 0.000))
- (undo 4)
- (ptree-channel (lambda (y) (* y 2.0)))
- (scale-channel 0.5)
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ptree+ramp 6" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (undo 3)
- ;; try on-air cases
- (undo 1)
- (ptree-channel (lambda (y) 2.0))
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ptree+ramp air 1" (vct 0.000 0.200 0.400 0.600 0.800 1.000 1.200 1.400 1.600 1.800 2.000))
- (scale-channel .5)
- (check-back-and-forth ind "ptree+ramp air 2" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (undo 3)
- (ptree-channel (lambda (y) 2.0))
- (env-channel '(0 0 1 1 2 0))
- (check-back-and-forth ind "ptree+ramp air 3" (vct 0.000 0.400 0.800 1.200 1.600 2.000 1.600 1.200 0.800 0.400 0.000))
- (undo 2)
- (ptree-channel (lambda (y) 2.0))
- (scale-channel 0.5)
- (ramp-channel 0.0 1.0)
- (check-back-and-forth ind "ptree+ramp air 4" (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000))
- (undo 3)
+ (ramp-channel 1.0 0.0 3 5)
+ (let ((edpos (edit-position ind 0)))
+ (check-back-and-forth ind "ramp+scl 4 setup" (float-vector 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000 1.000 1.000))
+ (let ((happy #t))
+ (do ((start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
+ ((or (not happy)
+ (= (+ start len) 11)))
+ (let ((v (float-vector 1.000 1.000 1.000 1.000 0.750 0.500 0.250 0.000 1.000 1.000 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl mid 1-0 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)
+ )))))
+ (set! (edit-position ind 0) start-pos)
+
+ (env-channel '(0 1 1 0 2 0 3 1))
+ (let ((edpos (edit-position ind 0)))
+ (check-back-and-forth ind "ramp+scl setup" (float-vector 1.000 0.667 0.333 0.000 0.000 0.000 0.000 0.000 0.333 0.667 1.000))
+ (let ((happy #t))
+ (do ((start 0 (+ 1 start)))
+ ((or (not happy)
+ (= start 10)))
+ (do ((len 1 (+ 1 len)))
+ ((or (not happy)
+ (= (+ start len) 11)))
+ (let ((v (float-vector 1.000 0.667 0.333 0.000 0.000 0.000 0.000 0.000 0.333 0.667 1.000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (v (+ start i)) (* (v (+ start i)) 0.5)))
+ (func 0.5 start len)
+ (set! happy (check-back-and-forth ind (format #f "ramp+scl 0-1-0-1 [~A ~A] with ~A" start len func) v))
+ (set! (edit-position ind 0) edpos)
+ )))))
+ (set! (edit-position ind 0) start-pos))
+
+ (list
+ scale-channel
+ (lambda (scl beg dur)
+ (map-channel (lambda (y) (* y scl)) beg dur)))))
+ (close-sound ind)
+ )
+
+ (if (and all-args (= test-16 0))
+ (let ((tries 256))
+ (snd-display #__line__ ";framples: ~,2F ~,2F"
+ (* 1.0 (/ (mus-sound-framples "1.snd") (mus-sound-framples "oboe.snd")))
+ (* 1.0 (/ (mus-sound-framples "1.snd") (mus-sound-framples "1a.snd"))))
+ (snd-display #__line__ ";~12T~A~28T~A~44T~A~56T(1/oboe, 1/1a)" "1.snd" "oboe.snd" "1a.snd")
+ (for-each
+ (lambda (name func)
+ (let ((ind (open-sound "1.snd"))
+ (start-time-1 (real-time)))
+ (set! (squelch-update ind 0) #t)
+ (do ((i 0 (+ i 1)))
+ ((= i tries))
+ (if (= (modulo i 10) 0) (revert-sound ind))
+ (func ind i))
+ (let ((mid-time-1 (real-time)))
+ (revert-sound ind)
+ (set! (squelch-update ind 0) #f)
+ (close-sound ind)
+ (let ((end-time-1 (real-time)))
+ (let ((ind (open-sound "oboe.snd"))
+ (start-time-2 (real-time)))
+ (set! (squelch-update ind 0) #t)
+ (do ((i 0 (+ i 1)))
+ ((= i tries))
+ (if (= (modulo i 10) 0) (revert-sound ind))
+ (func ind i))
+ (let ((mid-time-2 (real-time)))
+ (revert-sound ind)
+ (set! (squelch-update ind 0) #f)
+ (close-sound ind)
+ (let ((end-time-2 (real-time)))
+ (let ((ind (open-sound "1a.snd"))
+ (start-time (real-time)))
+ (set! (squelch-update ind 0) #t)
+ (do ((i 0 (+ i 1)))
+ ((= i tries))
+ (if (= (modulo i 10) 0) (revert-sound ind))
+ (func ind i))
+ (let ((mid-time (real-time)))
+ (revert-sound ind)
+ (set! (squelch-update ind 0) #f)
+ (close-sound ind)
+ (let ((end-time (real-time)))
+ (snd-display #__line__ ";~A:~12T~A~18T~A~28T~A~34T~A~44T~A~50T~A~56T(~,2F, ~,2F)"
+ name
+
+ (hundred (- mid-time-1 start-time-1)) (hundred (- end-time-1 mid-time-1))
+ (hundred (- mid-time-2 start-time-2)) (hundred (- end-time-2 mid-time-2))
+ (hundred (- mid-time start-time)) (hundred (- end-time mid-time))
+
+ (* 1.0 (/ (+ (hundred (- mid-time-1 start-time-1)) (hundred (- end-time-1 mid-time-1)))
+ (max 1 (+ (hundred (- mid-time-2 start-time-2)) (hundred (- end-time-2 mid-time-2))))))
+ (* 1.0 (/ (+ (hundred (- mid-time-1 start-time-1)) (hundred (- end-time-1 mid-time-1)))
+ (max 1 (+ (hundred (- mid-time start-time)) (hundred (- end-time mid-time)))))))))))))))))
+
+ (list "scale" "set!" "env" "env-exp" "env-step" "delete" "insert" "pad"
+ "mix-no-tag" "mix-tag" "mix-amp" "mix-scale" "src-2" "src"
+ "filter" "filter-sym" "f10" "f10sym" "clm"
+ "reverse"
+ )
+ (list
+ (lambda (snd i)
+ (scale-channel (* i .01)))
+ (lambda (snd i)
+ (set! (sample i) .5))
+ (lambda (snd i)
+ (env-channel '(0 0 1 1)))
+ (lambda (snd i)
+ (env-channel-with-base '(0 0 1 1) 32.0))
+ (lambda (snd i)
+ (env-channel-with-base '(0 0 1 1) 0.0))
+ (lambda (snd i)
+ (delete-sample (* 10 i)))
+ (lambda (snd i)
+ (insert-sample (* 10 i) .5))
+ (lambda (snd i)
+ (pad-channel (* 10 i) (* 10 i)))
+ (lambda (snd i)
+ (mix "pistol.snd" (* i 10) 0 snd 0 #f))
+ (lambda (snd i)
+ (mix "pistol.snd" (* i 10) 0 snd 0 #t))
+ (lambda (snd i)
+ (let ((mx (car (mix "pistol.snd" (* i 100)))))
+ (set! (mix-amp mx) .01)))
+ (lambda (snd i)
+ (mix "pistol.snd" (* i 100))
+ (scale-by .5)) ; scale-to before but that forces channel-maxamp which forces a full read which skews everything
+ (lambda (snd i)
+ (src-sound 2.0)
+ (undo))
+ (lambda (snd i)
+ (src-sound 2.01)
+ (undo))
+ (lambda (snd i)
+ (filter-channel (float-vector .25 .5 .25 .1) 4))
+ (lambda (snd i)
+ (filter-channel (float-vector .25 .5 .5 .25) 4))
+ (lambda (snd i)
+ (filter-channel (float-vector .1 .2 .1 .1 .1 .1 .1 .2 .1 .1) 10))
+ (lambda (snd i)
+ (filter-channel (float-vector .1 .1 .1 .1 .1 .1 .1 .1 .1 .1) 10))
+ (lambda (snd i)
+ (clm-channel (make-two-zero .5 .5)))
+ (lambda (snd i)
+ (reverse-channel (* i 10) (* i 100)))
+ ))))
+
+ (let ((ind (new-sound "fmv.snd" :size 50)))
+ (set! *sinc-width* 10)
+ (set! (sample 20 ind 0) 0.5)
+ (let ((edpos (edit-position ind 0)))
+
+ ;; -------- no-ops
+ (src-channel 1)
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (src-sound 1)
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-sound 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (select-all)
+ (src-selection 1)
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+
+ (filter-channel (float-vector 1.0))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";filter-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+
+ (env-channel '(0 1 1 1))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (env-sound '(0 1 1 1))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-sound 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (env-selection '(0 1 1 1))
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+
+ (scale-channel 1)
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (scale-by 1)
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-by 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (scale-selection-by 1)
+ (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+
+ ;; -------- other special cases
+ (src-channel -1)
+ (reverse-channel)
+ (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
+ (if diff (snd-display #__line__ ";src -1 and reverse diff: ~A" diff)))
+
+ (set! (edit-position ind 0) edpos)
+ (scale-by 2)
+ (filter-channel (float-vector 2) 1 0 #f ind 0 edpos)
+ (let ((diff (edit-difference ind 0 (+ 1 edpos) (+ edpos 2))))
+ (if diff (snd-display #__line__ ";scale and filter 2 diff: ~A" diff)))
+
+ ;; -------- not no-ops!
+ (scale-channel 1.0 0 #f ind 0 edpos)
+ (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
+ (if diff (snd-display #__line__ ";edpos scale 1 diff: ~A" diff)))
+ (if (fneq (maxamp ind 0) 0.5) (snd-display #__line__ ";scale 1 of original: ~A" (maxamp ind 0)))
+ (if (= (edit-position ind 0) (+ edpos 2))
+ (snd-display #__line__ ";edpos scl copy opted out?")
+ (undo))
- ;; -------- xramp+ptree
- (map-chan (lambda (y) 1.0))
+ (filter-channel (float-vector 1) 1 0 #f ind 0 edpos)
+ (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
+ (if diff (snd-display #__line__ ";edpos flt 1 diff: ~A" diff)))
+ (if (= (edit-position ind 0) (+ edpos 2))
+ (snd-display #__line__ ";edpos flt copy opted out?")
+ (undo))
- (ptree-channel (lambda (y) y))
- (xramp-channel 0.0 1.0 .0325)
- (let ((orig-data (channel->vct)))
- (undo 2)
- (xramp-channel 0.0 1.0 .0325)
- (if (not (vequal orig-data (channel->vct)))
- (snd-display #__line__ ";xramp cases: ~A ~A" orig-data (channel->vct)))
- (check-back-and-forth ind "xramp(+ptree) 0" (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000))
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "xramp+ptree 1" (vct-scale! (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000) 2.0))
- (scale-channel .5)
- (check-back-and-forth ind "xramp+ptree 2" (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000))
- (ptree-channel (lambda (y) (+ y .5)))
- (check-back-and-forth ind "xramp+ptree 3" (vct-offset! (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000) 0.5))
- (undo 4)
- (ptree-channel (lambda (y) y))
- (env-sound '(0 0 1 1 2 0) 0 11 .0325)
- (set! orig-data (channel->vct))
- (undo 2)
- (env-sound '(0 0 1 1 2 0) 0 11 .0325)
- (if (not (vequal orig-data (channel->vct)))
- (snd-display #__line__ ";xramp cases 1: ~A ~A" orig-data (channel->vct)))
- (check-back-and-forth ind "xramp(+ptree) 4" (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000))
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "xramp+ptree 4" (vct-scale! (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000) 2.0))
- (undo 2)
- (scale-channel .5)
- (env-sound '(0 0 1 1 2 0) 0 11 .0325)
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "xramp+ptree 5" (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000))
- (scale-by .5)
- (check-back-and-forth ind "ramp+ptree 6" (vct-scale! (vct 0.000 0.513 0.771 0.901 0.967 1.000 0.967 0.901 0.771 0.513 0.000) 0.5))
- (undo 4)
- (xramp-channel 0.0 1.0 .0325)
- (scale-channel 0.5)
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "xramp+ptree 7" (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000))
- (scale-channel 0.5)
- (check-back-and-forth ind "ramp+ptree 8" (vct-scale! (vct 0.000 0.300 0.513 0.664 0.771 0.847 0.901 0.940 0.967 0.986 1.000) 0.5))
- (undo 4)
- (xramp-channel 0.0 1.0 .0325 0 5)
- (check-back-and-forth ind "xramp(+ptree) 9" (vct 0.000 0.595 0.847 0.954 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (ptree-channel (lambda (y) (* y 2.0)) 3 3)
- (check-back-and-forth ind "xramp+ptree 9" (vct 0.000 0.595 0.847 1.909 2.000 2.000 1.000 1.000 1.000 1.000 1.000))
- (undo 2)
- (xramp-channel 0.0 1.0 .0325 0 5)
- (check-back-and-forth ind "xramp(+ptree) 10" (vct 0.000 0.595 0.847 0.954 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (ptree-channel (lambda (y) (* y 2.0)) 0 3)
- (check-back-and-forth ind "xramp+ptree 10" (vct 0.000 1.189 1.695 0.954 1.000 1.000 1.000 1.000 1.000 1.000 1.000))
- (undo 2)
- (xramp-channel 1.0 0.0 .0325 5 5)
- (check-back-and-forth ind "xramp(+ptree) 11" (vct 1.000 1.000 1.000 1.000 1.000 1.000 0.954 0.847 0.595 0.000 1.000))
- (ptree-channel (lambda (y) (* y 2.0)) 3 4)
- (check-back-and-forth ind "xramp+ptree 11" (vct 1.000 1.000 1.000 2.000 2.000 2.000 1.909 0.847 0.595 0.000 1.000))
- (undo 2))
+ (env-channel '(0 1 1 1) 0 #f ind 0 edpos)
+ (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
+ (if diff (snd-display #__line__ ";edpos env 1 diff: ~A" diff)))
+ (if (= (edit-position ind 0) (+ edpos 2))
+ (snd-display #__line__ ";edpos env copy opted out?")
+ (undo))
- ;; -------- ptree chains
- (map-chan (lambda (y) 1.0))
- (ptree-channel (lambda (y) (* y 2.0)))
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "ptree+ptree 1" (vct 4.000 4.000 4.000 4.000 4.000 4.000 4.000 4.000 4.000 4.000 4.000))
- (undo)
- (ptree-channel (lambda (y) (let ((a (* y .5))) (+ y a))))
- (check-back-and-forth ind "ptree+ptree 2" (vct 3.000 3.000 3.000 3.000 3.000 3.000 3.000 3.000 3.000 3.000 3.000))
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "ptree+ptree 3" (vct 6.000 6.000 6.000 6.000 6.000 6.000 6.000 6.000 6.000 6.000 6.000))
- (undo 3)
- (scale-channel 2.0)
- (ptree-channel (lambda (y) (* y 2.0)))
- (scale-channel 0.5)
- (ptree-channel (lambda (y) (* y 2.0)))
- (check-back-and-forth ind "ptree+ptree 4" (vct 4.000 4.000 4.000 4.000 4.000 4.000 4.000 4.000 4.000 4.000 4.000))
- (scale-channel 0.5)
- (check-back-and-forth ind "ptree+ptree 4" (vct 2.000 2.000 2.000 2.000 2.000 2.000 2.000 2.000 2.000 2.000 2.000))
- (undo 5)
+ (src-channel 1.0 0 #f ind 0 edpos)
+ (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
+ (if (and diff (> (car diff) .0001)) (snd-display #__line__ ";edpos src 1 diff: ~A" diff)))
+ (if (= (edit-position ind 0) (+ edpos 2))
+ (snd-display #__line__ ";edpos src copy opted out?")
+ (undo))
- (close-sound ind)
- )
-
- (if (and all-args (= test-16 0))
- (let ((old-opt (optimization))
- (tries 256))
- (set! (optimization) 6)
- (snd-display #__line__ ";frames: ~,2F ~,2F"
- (exact->inexact (/ (mus-sound-frames "1.snd") (mus-sound-frames "oboe.snd")))
- (exact->inexact (/ (mus-sound-frames "1.snd") (mus-sound-frames "1a.snd"))))
- (snd-display #__line__ ";~12T~A~28T~A~44T~A~56T(1/oboe, 1/1a)" "1.snd" "oboe.snd" "1a.snd")
- (for-each
- (lambda (name func)
- (let* ((ind (open-sound "1.snd"))
- (start-time-1 (real-time)))
- (set! (squelch-update ind 0) #t)
- (do ((i 0 (+ 1 i)))
- ((= i tries))
- (if (= (modulo i 10) 0) (revert-sound ind))
- (func ind i))
- (let ((mid-time-1 (real-time)))
- (revert-sound ind)
- (set! (squelch-update ind 0) #f)
- (close-sound ind)
- (let ((end-time-1 (real-time)))
- (let* ((ind (open-sound "oboe.snd"))
- (start-time-2 (real-time)))
- (set! (squelch-update ind 0) #t)
- (do ((i 0 (+ 1 i)))
- ((= i tries))
- (if (= (modulo i 10) 0) (revert-sound ind))
- (func ind i))
- (let ((mid-time-2 (real-time)))
- (revert-sound ind)
- (set! (squelch-update ind 0) #f)
- (close-sound ind)
- (let ((end-time-2 (real-time)))
- (let* ((ind (open-sound "1a.snd"))
- (start-time (real-time)))
- (set! (squelch-update ind 0) #t)
- (do ((i 0 (+ 1 i)))
- ((= i tries))
- (if (= (modulo i 10) 0) (revert-sound ind))
- (func ind i))
- (let ((mid-time (real-time)))
- (revert-sound ind)
- (set! (squelch-update ind 0) #f)
- (close-sound ind)
- (let ((end-time (real-time)))
- (snd-display #__line__ ";~A:~12T~A~18T~A~28T~A~34T~A~44T~A~50T~A~56T(~,2F, ~,2F)"
- name
-
- (hundred (- mid-time-1 start-time-1)) (hundred (- end-time-1 mid-time-1))
- (hundred (- mid-time-2 start-time-2)) (hundred (- end-time-2 mid-time-2))
- (hundred (- mid-time start-time)) (hundred (- end-time mid-time))
-
- (exact->inexact (/ (+ (hundred (- mid-time-1 start-time-1)) (hundred (- end-time-1 mid-time-1)))
- (max 1 (+ (hundred (- mid-time-2 start-time-2)) (hundred (- end-time-2 mid-time-2))))))
- (exact->inexact (/ (+ (hundred (- mid-time-1 start-time-1)) (hundred (- end-time-1 mid-time-1)))
- (max 1 (+ (hundred (- mid-time start-time)) (hundred (- end-time mid-time)))))))))))))))))
-
- (list "scale" "set!" "env" "env-exp" "env-step" "delete" "insert" "ptree" "pad"
- "mix-no-tag" "mix-tag" "mix-amp" "mix-scale" "src-2" "src"
- "filter" "filter-sym" "f10" "f10sym" "clm"
- "reverse"
- )
- (list
- (lambda (snd i)
- (scale-channel (* i .01)))
- (lambda (snd i)
- (set! (sample i) .5))
- (lambda (snd i)
- (env-channel '(0 0 1 1)))
- (lambda (snd i)
- (env-channel-with-base '(0 0 1 1) 32.0))
- (lambda (snd i)
- (env-channel-with-base '(0 0 1 1) 0.0))
- (lambda (snd i)
- (delete-sample (* 10 i)))
- (lambda (snd i)
- (insert-sample (* 10 i) .5))
- (lambda (snd i)
- (ptree-channel (lambda (y) (* y .999))))
- (lambda (snd i)
- (pad-channel (* 10 i) (* 10 i)))
- (lambda (snd i)
- (mix "pistol.snd" (* i 10) 0 snd 0 #f))
- (lambda (snd i)
- (mix "pistol.snd" (* i 10) 0 snd 0 #t))
- (lambda (snd i)
- (let ((mx (car (mix "pistol.snd" (* i 100)))))
- (set! (mix-amp mx) .01)))
- (lambda (snd i)
- (let ((mx (mix "pistol.snd" (* i 100))))
- (scale-by .5))) ; scale-to before but that forces channel-maxamp which forces a full read which skews everything
- (lambda (snd i)
- (src-sound 2.0)
- (undo))
- (lambda (snd i)
- (src-sound 2.01)
- (undo))
- (lambda (snd i)
- (filter-channel (vct .25 .5 .25 .1) 4))
- (lambda (snd i)
- (filter-channel (vct .25 .5 .5 .25) 4))
- (lambda (snd i)
- (filter-channel (vct .1 .2 .1 .1 .1 .1 .1 .2 .1 .1) 10))
- (lambda (snd i)
- (filter-channel (vct .1 .1 .1 .1 .1 .1 .1 .1 .1 .1) 10))
- (lambda (snd i)
- (clm-channel (make-two-zero .5 .5)))
- (lambda (snd i)
- (reverse-channel (* i 10) (* i 100)))
- ))
- (set! (optimization) old-opt)))
-
- (let ((ind (new-sound "fmv.snd" :size 50))
- (sw (sinc-width)))
- (set! (sinc-width) 10)
- (set! (sample 20 ind 0) 0.5)
- (let ((edpos (edit-position ind 0)))
-
- ;; -------- no-ops
- (src-channel 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
- (src-sound 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-sound 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
- (select-all)
- (src-selection 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";src-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
-
- (filter-channel (vct 1.0))
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";filter-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
+ (set! edpos (edit-position ind 0))
+ (let ((len (framples ind 0)))
+ (src-channel 0.5)
- (env-channel '(0 1 1 1))
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
- (env-sound '(0 1 1 1))
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-sound 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
- (env-selection '(0 1 1 1))
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";env-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
-
- (scale-channel 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-channel 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
- (scale-by 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-by 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
- (scale-selection-by 1)
- (if (not (= (edit-position ind 0) edpos)) (snd-display #__line__ ";scale-selection 1 as no-op: ~A ~A" edpos (edit-position ind 0)))
-
- ;; -------- other special cases
- (src-channel -1)
- (reverse-channel)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";src -1 and reverse diff: ~A" diff)))
-
- (set! (edit-position ind 0) edpos)
- (scale-by 2)
- (filter-channel (vct 2) 1 0 #f ind 0 edpos)
- (let ((diff (edit-difference ind 0 (+ 1 edpos) (+ edpos 2))))
- (if diff (snd-display #__line__ ";scale and filter 2 diff: ~A" diff)))
-
- ;; -------- not no-ops!
(scale-channel 1.0 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";edpos scale 1 diff: ~A" diff)))
- (if (fneq (maxamp ind 0) 0.5) (snd-display #__line__ ";scale 1 of original: ~A" (maxamp ind 0)))
- (if (= (edit-position ind 0) (+ edpos 2))
- (snd-display #__line__ ";edpos scl copy opted out?")
- (undo))
+ (if diff (snd-display #__line__ ";1 edpos scale 1 diff: ~A" diff)))
+ (if (not (= (framples ind 0) len))
+ (snd-display #__line__ ";scl len edpos: ~A ~A" len (framples ind 0)))
+ (undo)
- (filter-channel (vct 1) 1 0 #f ind 0 edpos)
+ (filter-channel (float-vector 1) 1 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";edpos flt 1 diff: ~A" diff)))
- (if (= (edit-position ind 0) (+ edpos 2))
- (snd-display #__line__ ";edpos flt copy opted out?")
- (undo))
+ (if diff (snd-display #__line__ ";1 edpos flt 1 diff: ~A" diff)))
+ (if (not (= (framples ind 0) len))
+ (snd-display #__line__ ";flt len edpos: ~A ~A" len (framples ind 0)))
+ (undo)
(env-channel '(0 1 1 1) 0 #f ind 0 edpos)
(let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";edpos env 1 diff: ~A" diff)))
- (if (= (edit-position ind 0) (+ edpos 2))
- (snd-display #__line__ ";edpos env copy opted out?")
- (undo))
-
- (src-channel 1.0 0 #f ind 0 edpos)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if (and diff (> (car diff) .0001)) (snd-display #__line__ ";edpos src 1 diff: ~A" diff)))
- (if (= (edit-position ind 0) (+ edpos 2))
- (snd-display #__line__ ";edpos src copy opted out?")
- (undo))
-
- (set! edpos (edit-position ind 0))
- (let ((len (frames ind 0)))
- (src-channel 0.5)
-
- (scale-channel 1.0 0 #f ind 0 edpos)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";1 edpos scale 1 diff: ~A" diff)))
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";scl len edpos: ~A ~A" len (frames ind 0)))
- (undo)
-
- (filter-channel (vct 1) 1 0 #f ind 0 edpos)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";1 edpos flt 1 diff: ~A" diff)))
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";flt len edpos: ~A ~A" len (frames ind 0)))
- (undo)
-
- (env-channel '(0 1 1 1) 0 #f ind 0 edpos)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";1 edpos env 1 diff: ~A" diff)))
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";env len edpos: ~A ~A" len (frames ind 0)))
- (undo)
-
- (reverse-channel 0 #f ind 0 edpos)
- (reverse-channel 0 #f ind 0)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";1 edpos rev 1 diff: ~A" diff)))
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";rev len edpos: ~A ~A" len (frames ind 0)))
- (undo 2)
-
- (src-channel 1.0 0 #f ind 0 edpos)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if (and diff (> (car diff) .0001)) (snd-display #__line__ ";1 edpos src 1 diff: ~A" diff)))
- (if (> (abs (- (frames ind 0) len)) 2)
- (snd-display #__line__ ";src len edpos: ~A ~A" len (frames ind 0)))
- (undo)
-
- (let ((opt (optimization)))
- (set! (optimization) 0)
- (map-channel (lambda (y) y) 0 #f ind 0 edpos)
- (set! (optimization) opt))
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";1 edpos map 1 diff: ~A" diff)))
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";map len edpos: ~A ~A" len (frames ind 0)))
- (undo)
-
- (ptree-channel (lambda (y) y) 0 #f ind 0 edpos)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";1 edpos ptree 1 diff: ~A" diff)))
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";ptree len edpos: ~A ~A" len (frames ind 0)))
- (undo)
-
- (smooth-channel 0 len ind 0 edpos)
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";smooth len edpos: ~A ~A" len (frames ind 0)))
- (undo)
-
- (clm-channel (make-one-zero 1.0 0.0) 0 #f ind 0 edpos)
- (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
- (if diff (snd-display #__line__ ";1 edpos clm 1 diff: ~A" diff)))
- (if (not (= (frames ind 0) len))
- (snd-display #__line__ ";clm len edpos: ~A ~A" len (frames ind 0)))
- (undo))
-
- ;; dur of 0 is ignored no matter what -- else I have a million special cases
- ;; -> insert 0 at other edpos, delete 0, change 0 (x|ramp-channel) (map? etc)
-
- (revert-sound ind)
- (close-sound ind)
-
- ;; -------- reach back with partial edit
- (set! ind (new-sound "fmv.snd" :size 10))
- (as-one-edit
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (set! (sample i) (* i .01)))))
- (set! edpos (edit-position ind 0))
-
- (pad-channel 0 10 ind 0)
- (pad-channel 20 10 ind 0)
- (set! (samples 0 10 ind 0) (make-vct 10 .5))
- (set! (samples 20 10 ind 0) (make-vct 10 -.75))
-
- (pad-channel 0 10 ind 0 edpos)
- (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";pad edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";pad edpos max: ~A" (maxamp ind 0)))
- (undo)
-
- (delete-samples 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 5)) (snd-display #__line__ ";del edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";del edpos max: ~A" (maxamp ind 0)))
- (undo)
-
- (set! (samples 5 5 ind 0 #f "set" 0 edpos) (make-vct 5 0.0))
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";set edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .04) (snd-display #__line__ ";set edpos max: ~A" (maxamp ind 0)))
- (undo)
-
- (ramp-channel 0.0 1.0 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";rmp edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";rmp edpos max: ~A" (maxamp ind 0)))
- (undo)
-
- (xramp-channel 0.0 1.0 32.0 5 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";xrmp edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";xrmp edpos max: ~A" (maxamp ind 0)))
- (undo)
-
- (env-channel '(0 0 1 1) 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";env edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";env edpos max: ~A" (maxamp ind 0)))
- (undo)
-
- (ptree-channel (lambda (y) y) 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";ptree edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";ptree edpos max: ~A" (maxamp ind 0)))
- (undo)
-
- (smooth-channel 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";smooth edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";smooth edpos max: ~A" (maxamp ind 0)))
+ (if diff (snd-display #__line__ ";1 edpos env 1 diff: ~A" diff)))
+ (if (not (= (framples ind 0) len))
+ (snd-display #__line__ ";env len edpos: ~A ~A" len (framples ind 0)))
(undo)
- (src-channel 0.5 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 16)) (snd-display #__line__ ";src edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";src edpos max: ~A" (maxamp ind 0)))
- (undo)
-
- (reverse-channel 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";rev edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";rev edpos max: ~A" (maxamp ind 0)))
- (undo)
+ (reverse-channel 0 #f ind 0 edpos)
+ (reverse-channel 0 #f ind 0)
+ (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
+ (if diff (snd-display #__line__ ";1 edpos rev 1 diff: ~A" diff)))
+ (if (not (= (framples ind 0) len))
+ (snd-display #__line__ ";rev len edpos: ~A ~A" len (framples ind 0)))
+ (undo 2)
- (filter-channel (vct .1 .2 .1) 3 0 5 ind 0 edpos #t) ; truncate
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";flt edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";flt edpos max: ~A" (maxamp ind 0)))
+ (src-channel 1.0 0 #f ind 0 edpos)
+ (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
+ (if (and diff (> (car diff) .0001)) (snd-display #__line__ ";1 edpos src 1 diff: ~A" diff)))
+ (if (> (abs (- (framples ind 0) len)) 2)
+ (snd-display #__line__ ";src len edpos: ~A ~A" len (framples ind 0)))
(undo)
- (scale-channel 1.5 0 5 ind 0 edpos)
- (if (not (= (frames ind 0) 10)) (snd-display #__line__ ";scl edpos len: ~A" (frames ind 0)))
- (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";scl edpos max: ~A" (maxamp ind 0)))
+ (smooth-channel 0 len ind 0 edpos)
+ (if (not (= (framples ind 0) len))
+ (snd-display #__line__ ";smooth len edpos: ~A ~A" len (framples ind 0)))
(undo)
- (close-sound ind)))
-
- (let ((ind (new-sound "fmv.snd" :size 20)))
- (map-channel (lambda (y) 1.0))
- (let ((edpos (edit-position ind 0)))
- (delete-samples 5 10)
- (delete-samples 15 5 ind 0 edpos)
- (if (not (= (frames ind 0) 15)) (snd-display #__line__ ";delete-samples edpos len: ~A" (frames ind 0)))
- (undo)
- (vct->channel (make-vct 5 0.5) 15 5 ind 0 edpos)
- (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";delete-samples edpos len: ~A" (frames ind 0)))
- (if (not (vequal (channel->vct 10 10) (vct 1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5)))
- (snd-display #__line__ ";set samples edpos: ~A" (channel->vct 10 10)))
- (undo)
- (env-channel '(0 0 1 1) 0 #f ind 0 edpos)
- (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";env edpos len: ~A" (frames ind 0)))
- (if (not (vequal (channel->vct 0 20) (vct 0.000 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474 0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
- (snd-display #__line__ ";env edpos: ~A" (channel->vct 0 20)))
- (undo)
- (ptree-channel (lambda (y) 0.5) 0 #f ind 0 edpos)
- (if (not (= (frames ind 0) 20)) (snd-display #__line__ ";ptree edpos len: ~A" (frames ind 0)))
- (if (not (vequal (channel->vct 0 20) (make-vct 20 0.5))) (snd-display #__line__ ";ptree edpos: ~A" (channel->vct 0 20)))
- (undo)
- (close-sound ind)))
-
- ;; virtual filter as ptree
- (let ((ind (new-sound "fmv.snd" :size 20)))
- (set! (sample 5) 1.0)
-
- ;; forward all
- (filter-channel (vct 1.0 0.5 0.25))
- (let ((data (channel->vct 0 20 ind 0)))
- (undo)
- (virtual-filter-channel (vct 1.0 0.5 0.25) 0 #f ind 0 1)
- (let ((vdata (channel->vct 0 20 ind 0)))
- (undo)
- (if (not (vequal data vdata))
- (snd-display #__line__ ";virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (clm-channel (make-one-zero 1.0 0.0) 0 #f ind 0 edpos)
+ (let ((diff (edit-difference ind 0 edpos (edit-position ind 0))))
+ (if diff (snd-display #__line__ ";1 edpos clm 1 diff: ~A" diff)))
+ (if (not (= (framples ind 0) len))
+ (snd-display #__line__ ";clm len edpos: ~A ~A" len (framples ind 0)))
+ (undo))
- ;; reverse all
- (filter-channel (vct 0.25 0.5 1.0))
- (reverse-sound)
- (let ((data (channel->vct 3 20))) ; filter-channel assumes ring
- (undo 2)
- (virtual-filter-channel (vct 0.25 0.5 1.0) 0 #f ind 0 1)
- (reverse-sound)
- (let ((vdata (channel->vct 0 20)))
- (undo 2)
- (if (not (vequal data vdata))
- (snd-display #__line__ ";reverse virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ ;; dur of 0 is ignored no matter what -- else I have a million special cases
+ ;; -> insert 0 at other edpos, delete 0, change 0 (x|ramp-channel) (map? etc)
- ;; insert block
- (filter-channel (vct 0.25 0.5 1.0 0.9 0.6 0.3))
- (pad-channel 8 5)
- (let ((data (channel->vct 0 20)))
- (undo 2)
- (virtual-filter-channel (vct 0.25 0.5 1.0 0.9 0.6 0.3) 0 #f ind 0 1)
- (pad-channel 8 5)
- (let ((vdata (channel->vct 0 20)))
- (undo 2)
- (if (not (vequal data vdata))
- (snd-display #__line__ ";pad virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (revert-sound ind)
+ (close-sound ind)
- ;; delete block
- (filter-channel (vct 0.25 0.5 1.0 0.9 0.6 0.3))
- (delete-samples 7 2)
- (let ((data (channel->vct 0 20)))
- (undo 2)
- (virtual-filter-channel (vct 0.25 0.5 1.0 0.9 0.6 0.3) 0 #f ind 0 1)
- (delete-samples 7 2)
- (let ((vdata (channel->vct 0 20)))
- (undo 2)
- (if (not (vequal data vdata))
- (snd-display #__line__ ";delete virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ ;; -------- reach back with partial edit
+ (set! ind (new-sound "fmv.snd" :size 10))
+ (as-one-edit
+ (lambda ()
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (set! (sample i) (* i .01)))))
+ (set! edpos (edit-position ind 0))
- ;; forward partial
- (filter-channel (vct 1.0 0.5 0.25) 3 3 10) ; 3=order! + pre-ring?? -- this is too clever
- (let ((data (channel->vct 0 20)))
- (undo)
- (virtual-filter-channel (vct 1.0 0.5 0.25) 3 10 ind 0 1)
- (let ((vdata (channel->vct 2 20)))
- (undo)
- (if (not (vequal data vdata))
- (snd-display #__line__ ";partial virtual filter: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (pad-channel 0 10 ind 0)
+ (pad-channel 20 10 ind 0)
+ (set! (samples 0 10 ind 0) (make-float-vector 10 .5))
+ (set! (samples 20 10 ind 0) (make-float-vector 10 -.75))
- ;; forward partial reversed
- (filter-channel (vct 1.0 0.5 0.25 .6 .3) 5 2 10)
- (reverse-sound)
- (let ((data (channel->vct 2 20)))
- (undo 2)
- (virtual-filter-channel (vct 1.0 0.5 0.25 .6 .3) 2 10 ind 0 1)
- (reverse-sound)
- (let ((vdata (channel->vct 0 20)))
- (undo)
- (if (not (vequal data vdata))
- (snd-display #__line__ ";partial virtual filter reversed: ~% standard: ~A~% virtual: ~A~%" data vdata))))
+ (pad-channel 0 10 ind 0 edpos)
+ (if (not (= (framples ind 0) 20)) (snd-display #__line__ ";pad edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";pad edpos max: ~A" (maxamp ind 0)))
+ (undo)
- (close-sound ind))
-
- (let ((ind (new-sound "fmv.snd" :size 20)))
- (set! (sample 5) 1.0)
- (filter-channel (vct 1.0 0.5))
- (filter-channel (vct 1.0 0.5))
- (let ((data (channel->vct 0 20)))
- (undo 2)
- (let ((v (convolve-coeffs (vct 1.0 0.5) (vct 1.0 0.5))))
- (filter-channel v)
- (let ((vdata (channel->vct 0 20)))
- (if (not (vequal data vdata))
- (snd-display #__line__ ";filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
- (undo)))
- (let ((v1 (make-vct 8))
- (v2 (make-vct 5)))
- (do ((i 0 (+ 1 i))) ((= i 8)) (vct-set! v1 i (random 1.0)))
- (do ((i 0 (+ 1 i))) ((= i 5)) (vct-set! v2 i (random 1.0)))
- (filter-channel v1)
- (filter-channel v2)
- (let ((data (channel->vct 0 20)))
- (undo 2)
- (let ((v (convolve-coeffs v1 v2)))
- (filter-channel v)
- (let ((vdata (channel->vct 0 20)))
- (if (not (vequal data vdata))
- (snd-display #__line__ ";random filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
- (undo))))
- (let ((v1 (make-vct 18))
- (v2 (make-vct 15)))
- (do ((i 0 (+ 1 i))) ((= i 18)) (vct-set! v1 i (random 1.0)))
- (do ((i 0 (+ 1 i))) ((= i 15)) (vct-set! v2 i (random 1.0)))
- (filter-channel v1)
- (filter-channel v2)
- (let ((data (channel->vct 0 20)))
- (undo 2)
- (let ((v (convolve-coeffs v1 v2)))
- (filter-channel v)
- (let ((vdata (channel->vct 0 20)))
- (if (not (vequal data vdata))
- (snd-display #__line__ ";big random filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
- (undo))))
- (close-sound ind))
-
- (let ((ind (new-sound "fmv.snd" :size 100)))
- (set! (sample 5) .5)
- (set! (sample 85) .5)
+ (delete-samples 0 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 5)) (snd-display #__line__ ";del edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";del edpos max: ~A" (maxamp ind 0)))
+ (undo)
- (src-channel -1.001) ; avoid optimization
- (src-channel '(0 -1.0 1 -1.0) 0 #f ind 0 2)
- (let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display #__line__ ";src-channel -1, distance: ~A" dis)))
- (undo 2)
+ (set! (samples 5 5 ind 0 #f "set" 0 edpos) (make-float-vector 5 0.0))
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";set edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .04) (snd-display #__line__ ";set edpos max: ~A" (maxamp ind 0)))
+ (undo)
- (src-channel 1.001) ; avoid optimization
- (src-channel '(0 1.0 1 1.0) 0 #f ind 0 2)
- (let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display #__line__ ";src-channel 1, distance: ~A" dis)))
- (undo 2)
+ (ramp-channel 0.0 1.0 0 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";rmp edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";rmp edpos max: ~A" (maxamp ind 0)))
+ (undo)
- (for-each
- (lambda (rate)
- (src-channel rate)
- (src-channel (list 0 rate 1 rate) 0 #f ind 0 2)
- (let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display #__line__ ";src-channel ~A, distance: ~A" rate dis)))
- (undo 2))
- (list 2.0 -2.0 0.5 -0.5 1.5 -1.5 3.0 -3.0 0.2 -0.2))
+ (xramp-channel 0.0 1.0 32.0 5 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";xrmp edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";xrmp edpos max: ~A" (maxamp ind 0)))
+ (undo)
+ (env-channel '(0 0 1 1) 0 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";env edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";env edpos max: ~A" (maxamp ind 0)))
+ (undo)
- (src-sound -1.001) ; avoid optimization
- (src-sound '(0 -1.0 1 -1.0) 1.0 ind 0 2)
- (let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display #__line__ ";src-sound -1, distance: ~A" dis)))
- (undo 2)
+ (smooth-channel 0 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";smooth edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";smooth edpos max: ~A" (maxamp ind 0)))
+ (undo)
- (src-sound 1.001) ; avoid optimization
- (src-sound '(0 1.0 1 1.0) 1.0 ind 0 2)
- (let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display #__line__ ";src-sound 1, distance: ~A" dis)))
- (undo 2)
+ (src-channel 0.5 0 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 16)) (snd-display #__line__ ";src edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";src edpos max: ~A" (maxamp ind 0)))
+ (undo)
- (for-each
- (lambda (rate)
- (src-sound rate)
- (src-sound (list 0 rate 1 rate) 1.0 ind 0 2)
- (let ((dis (edit-distance ind 0 3 4)))
- (if (> dis .2) (snd-display #__line__ ";src-sound ~A, distance: ~A" rate dis)))
- (undo 2))
- (list 2.0 -2.0 0.5 -0.5 1.5 -1.5 3.0 -3.0 0.2 -0.2))
+ (reverse-channel 0 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";rev edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";rev edpos max: ~A" (maxamp ind 0)))
+ (undo)
- (close-sound ind))
-
-
- ;; additional coverage tests
-
- (let ((ind (new-sound "test.snd" :size 10)))
- (vct->channel (make-vct 10 .4))
- (make-selection 3 7) ; beg end just for confusion
- (env-selection '(0 0.5 1 0.5))
- (let ((data (channel->vct)))
- (if (not (vequal data (vct .4 .4 .4 .2 .2 .2 .2 .2 .4 .4)))
- (snd-display #__line__ ";env-selection constant: ~A" data)))
+ (filter-channel (float-vector .1 .2 .1) 3 0 5 ind 0 edpos #t) ; truncate
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";flt edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";flt edpos max: ~A" (maxamp ind 0)))
(undo)
- (let ((edpos (edit-position ind 0)))
- (smooth-channel 10 10 ind 0)
- (if (not (= (edit-position ind 0) edpos))
- (snd-display #__line__ ";smooth past end: ~A ~A" (edit-position ind 0) edpos))
-
- (let ((ctr 0))
- (map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (> ctr 3) #t (* y 2)))))
- (if (not (= (frames ind 0) 3))
- (snd-display #__line__ ";map-channel -> #t at 3: ~A" (frames ind 0))
- (if (not (vequal (channel->vct) (vct 0.8 0.8 0.8)))
- (snd-display #__line__ ";map-channel #t result: ~A" (channel->vct))))
-
- (undo)
- (let ((ctr 0))
- (map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (= ctr 3) (make-vct 5 .1) (* y .5)))))
- (if (not (= (frames ind 0) 14))
- (snd-display #__line__ ";map-channel -> vct at 3: ~A" (frames ind 0))
- (if (not (vequal (channel->vct) (vct 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.200 0.200 0.200)))
- (snd-display #__line__ ";map-channel vct result: ~A" (channel->vct))))
-
- (undo)
- (let ((data (make-vct 2 0.0)))
- (map-channel (lambda (y) (vct-set! data 0 y) data)))
- (if (not (= (frames ind 0) 20))
- (snd-display #__line__ ";map-channel -> vct ptree: ~A" (frames ind 0))
- (if (not (vequal (channel->vct) (vct 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000)))
- (snd-display #__line__ ";map-channel vct ptree result: ~A" (channel->vct))))
-
- (undo))
- (set! (amp-control ind) 2.0)
- (apply-controls ind 1 0)
- (if (> (abs (- (maxamp ind 0) .8)) .01) (snd-display #__line__ ";apply-controls 10: ~A" (channel->vct)))
+ (scale-channel 1.5 0 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 10)) (snd-display #__line__ ";scl edpos len: ~A" (framples ind 0)))
+ (if (fneq (maxamp ind 0) .09) (snd-display #__line__ ";scl edpos max: ~A" (maxamp ind 0)))
(undo)
- (set! (amp-control ind) 2.0)
- (apply-controls ind 1 5)
- (if (not (vequal (channel->vct 0 5) (vct 0.4 0.4 0.4 0.4 0.4)))
- (snd-display #__line__ ";apply controls from 5: ~A" (channel->vct)))
- (if (ffneq (sample 5) .8) (snd-display #__line__ ";apply-controls at 5: ~A" (sample 5)))
- (let ((tag (catch 'no-such-edit
- (lambda ()
- (save-sound-as "nope.snd" :edit-position 21))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-edit)) (snd-display #__line__ ";save-sound-as at bad edpos: ~A" tag)))
- (let ((tag (catch 'no-such-file
- (lambda ()
- (channel-amp-envs "/baddy/hiho"))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";channel-amp-envs bad file: ~A" tag)))
- (close-sound ind))
+ (close-sound ind)))
+
+ (let ((ind (new-sound "fmv.snd" :size 20)))
+ (map-channel (lambda (y) 1.0))
+ (let ((edpos (edit-position ind 0)))
+ (delete-samples 5 10)
+ (delete-samples 15 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 15)) (snd-display #__line__ ";delete-samples edpos len: ~A" (framples ind 0)))
+ (undo)
+ (float-vector->channel (make-float-vector 5 0.5) 15 5 ind 0 edpos)
+ (if (not (= (framples ind 0) 20)) (snd-display #__line__ ";delete-samples edpos len: ~A" (framples ind 0)))
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 1.0 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5 0.5)))
+ (snd-display #__line__ ";set samples edpos: ~A" (channel->float-vector 10 10)))
+ (undo)
+ (env-channel '(0 0 1 1) 0 #f ind 0 edpos)
+ (if (not (= (framples ind 0) 20)) (snd-display #__line__ ";env edpos len: ~A" (framples ind 0)))
+ (if (not (vequal (channel->float-vector 0 20) (float-vector 0.000 0.053 0.105 0.158 0.211 0.263 0.316 0.368 0.421 0.474 0.526 0.579 0.632 0.684 0.737 0.789 0.842 0.895 0.947 1.000)))
+ (snd-display #__line__ ";env edpos: ~A" (channel->float-vector 0 20)))
+ (undo)
+ (close-sound ind)))
+
+
+ (let ((ind (new-sound "fmv.snd" :size 20)))
+ (set! (sample 5) 1.0)
+ (filter-channel (float-vector 1.0 0.5))
+ (filter-channel (float-vector 1.0 0.5))
+ (let ((data (channel->float-vector 0 20)))
+ (undo 2)
+ (let ((v (convolve-coeffs (float-vector 1.0 0.5) (float-vector 1.0 0.5))))
+ (filter-channel v)
+ (let ((vdata (channel->float-vector 0 20)))
+ (if (not (vequal data vdata))
+ (snd-display #__line__ ";filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
+ (undo)))
+ (let ((v1 (make-float-vector 8))
+ (v2 (make-float-vector 5)))
+ (do ((i 0 (+ i 1))) ((= i 8)) (float-vector-set! v1 i (random 1.0)))
+ (do ((i 0 (+ i 1))) ((= i 5)) (float-vector-set! v2 i (random 1.0)))
+ (filter-channel v1)
+ (filter-channel v2)
+ (let ((data (channel->float-vector 0 20)))
+ (undo 2)
+ (let ((v (convolve-coeffs v1 v2)))
+ (filter-channel v)
+ (let ((vdata (channel->float-vector 0 20)))
+ (if (not (vequal data vdata))
+ (snd-display #__line__ ";random filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
+ (undo))))
+ (let ((v1 (make-float-vector 18))
+ (v2 (make-float-vector 15)))
+ (do ((i 0 (+ i 1))) ((= i 18)) (float-vector-set! v1 i (random 1.0)))
+ (do ((i 0 (+ i 1))) ((= i 15)) (float-vector-set! v2 i (random 1.0)))
+ (filter-channel v1)
+ (filter-channel v2)
+ (let ((data (channel->float-vector 0 20)))
+ (undo 2)
+ (let ((v (convolve-coeffs v1 v2)))
+ (filter-channel v)
+ (let ((vdata (channel->float-vector 0 20)))
+ (if (not (vequal data vdata))
+ (snd-display #__line__ ";big random filter convolved: ~% standard: ~A~% virtual: ~A~%" data vdata)))
+ (undo))))
+ (close-sound ind))
+
+ (let ((ind (new-sound "fmv.snd" :size 100)))
+ (set! (sample 5) .5)
+ (set! (sample 85) .5)
+
+ (src-channel -1.001)
+ (src-channel '(0 -1.0 1 -1.0) 0 #f ind 0 2)
+ (let ((dis (edit-distance ind 0 3 4)))
+ (if (> dis .2) (snd-display #__line__ ";src-channel -1, distance: ~A" dis)))
+ (undo 2)
+ (src-channel 1.001)
+ (src-channel '(0 1.0 1 1.0) 0 #f ind 0 2)
+ (let ((dis (edit-distance ind 0 3 4)))
+ (if (> dis .2) (snd-display #__line__ ";src-channel 1, distance: ~A" dis)))
+ (undo 2)
- (let ((ind (open-sound "oboe.snd")))
+ (for-each
+ (lambda (rate)
+ (src-channel rate)
+ (src-channel (list 0 rate 1 rate) 0 #f ind 0 2)
+ (let ((dis (edit-distance ind 0 3 4)))
+ (if (> dis .2) (snd-display #__line__ ";src-channel ~A, distance: ~A" rate dis)))
+ (undo 2))
+ (list 2.0 -2.0 0.5 -0.5 1.5 -1.5 3.0 -3.0 0.2 -0.2))
+
+
+ (src-sound -1.001)
+ (src-sound '(0 -1.0 1 -1.0) 1.0 ind 0 2)
+ (let ((dis (edit-distance ind 0 3 4)))
+ (if (> dis .2) (snd-display #__line__ ";src-sound -1, distance: ~A" dis)))
+ (undo 2)
+
+ (src-sound 1.001)
+ (src-sound '(0 1.0 1 1.0) 1.0 ind 0 2)
+ (let ((dis (edit-distance ind 0 3 4)))
+ (if (> dis .2) (snd-display #__line__ ";src-sound 1, distance: ~A" dis)))
+ (undo 2)
+
+ (for-each
+ (lambda (rate)
+ (src-sound rate)
+ (src-sound (list 0 rate 1 rate) 1.0 ind 0 2)
+ (let ((dis (edit-distance ind 0 3 4)))
+ (if (> dis .2) (snd-display #__line__ ";src-sound ~A, distance: ~A" rate dis)))
+ (undo 2))
+ (list 2.0 -2.0 0.5 -0.5 1.5 -1.5 3.0 -3.0 0.2 -0.2))
+
+ (close-sound ind))
+
+
+ ;; additional coverage tests
+
+ (let ((ind (new-sound "test.snd" :size 10)))
+ (float-vector->channel (make-float-vector 10 .4))
+ (make-selection 3 7) ; beg end just for confusion
+ (env-selection '(0 0.5 1 0.5))
+ (let ((data (channel->float-vector)))
+ (if (not (vequal data (float-vector .4 .4 .4 .2 .2 .2 .2 .2 .4 .4)))
+ (snd-display #__line__ ";env-selection constant: ~A" data)))
+ (undo)
+ (let ((edpos (edit-position ind 0)))
+ (smooth-channel 10 10 ind 0)
+ (if (not (= (edit-position ind 0) edpos))
+ (snd-display #__line__ ";smooth past end: ~A ~A" (edit-position ind 0) edpos))
+
(let ((ctr 0))
- (map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (> ctr 3) #t (* y 2)))))
- (if (not (= (frames ind 0) 3))
- (snd-display #__line__ ";map-channel oboe -> #t at 3: ~A" (frames ind 0))
- (if (not (vequal (channel->vct) (vct 0.0 -.001 -.001)))
- (snd-display #__line__ ";map-channel #t oboe result: ~A" (channel->vct))))
+ (map-channel (lambda (y) (set! ctr (+ ctr 1)) (or (> ctr 3) (* y 2)))))
+ (if (not (= (framples ind 0) 3))
+ (snd-display #__line__ ";map-channel -> #t at 3: ~A" (framples ind 0))
+ (if (not (vequal (channel->float-vector) (float-vector 0.8 0.8 0.8)))
+ (snd-display #__line__ ";map-channel #t result: ~A" (channel->float-vector))))
(undo)
(let ((ctr 0))
- (map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (= ctr 3) (make-vct 5 .1) (* y .5)))))
- (if (not (= (frames ind 0) (+ 50828 4)))
- (snd-display #__line__ ";map-channel oboe -> vct at 3: ~A" (frames ind 0))
- (if (not (vequal (channel->vct 0 10) (vct 0.000 -0.000 0.100 0.100 0.100 0.100 0.100 -0.000 -0.000 -0.000)))
- (snd-display #__line__ ";map-channel vct result: ~A" (channel->vct 0 10))))
+ (map-channel (lambda (y) (set! ctr (+ ctr 1)) (if (= ctr 3) (make-float-vector 5 .1) (* y .5)))))
+ (if (not (= (framples ind 0) 14))
+ (snd-display #__line__ ";map-channel -> float-vector at 3: ~A" (framples ind 0))
+ (if (not (vequal (channel->float-vector) (float-vector 0.200 0.200 0.100 0.100 0.100 0.100 0.100 0.200 0.200 0.200 0.200 0.200 0.200 0.200)))
+ (snd-display #__line__ ";map-channel float-vector result: ~A" (channel->float-vector))))
(undo)
- (let ((data (make-vct 2 0.0)))
- (map-channel (lambda (y) (vct-set! data 0 y) data)))
- (if (not (= (frames ind 0) (* 2 50828)))
- (snd-display #__line__ ";map-channel oboe -> vct ptree: ~A" (frames ind 0))
- (if (not (vequal (channel->vct 0 10) (vct 0.000 0.000 -0.000 0.000 -0.000 0.000 -0.000 0.000 -0.000 0.0)))
- (snd-display #__line__ ";map-channel vct ptree result: ~A" (channel->vct 0 10))))
- (revert-sound)
- (close-sound ind))
+ (let ((data (make-float-vector 2 0.0)))
+ (map-channel (lambda (y) (float-vector-set! data 0 y) data)))
+ (if (not (= (framples ind 0) 20))
+ (snd-display #__line__ ";map-channel -> float-vector: ~A" (framples ind 0))
+ (if (not (vequal (channel->float-vector) (float-vector 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000 0.400 0.000)))
+ (snd-display #__line__ ";map-channel float-vector result: ~A" (channel->float-vector))))
+
+ (undo))
- (let ((ind (open-sound "2.snd")))
- (ramp-channel 0.9 1.0)
- (ramp-channel 0.9 1.0)
- (xramp-channel 0.9 1.0 32.0)
- (xramp-channel 0.9 1.0 32.0)
- (mix-vct (vct .01 .02) 10000 ind 0 #t)
- (set! (sync ind) 1)
- (let ((mxs (maxamp ind #t)))
- (env-sound '(0 .25 1 0.5))
- (let ((mxs1 (maxamp ind #t)))
- (if (or (fneq (car mxs) (* 2.0 (car mxs1)))
- (fneq (cadr mxs) (* 2.0 (cadr mxs1))))
- (snd-display #__line__ ";env-sound sync'd maxes: ~A -> ~A" mxs mxs1)))
- (undo 1))
- (close-sound ind))
+ (set! (amp-control ind) 2.0)
+ (apply-controls ind 1 0)
+ (if (> (abs (- (maxamp ind 0) .8)) .01) (snd-display #__line__ ";apply-controls 10: ~A" (channel->float-vector)))
+ (undo)
+ (set! (amp-control ind) 2.0)
+ (apply-controls ind 1 5)
+ (if (not (vequal (channel->float-vector 0 5) (float-vector 0.4 0.4 0.4 0.4 0.4)))
+ (snd-display #__line__ ";apply controls from 5: ~A" (channel->float-vector)))
+ (if (ffneq (sample 5) .8) (snd-display #__line__ ";apply-controls at 5: ~A" (sample 5)))
+ (let ((tag (catch 'no-such-edit
+ (lambda ()
+ (save-sound-as "nope.snd" :edit-position 21))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-edit)) (snd-display #__line__ ";save-sound-as at bad edpos: ~A" tag)))
+ (let ((tag (catch 'no-such-file
+ (lambda ()
+ (channel-amp-envs "/baddy/hiho"))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-file)) (snd-display #__line__ ";channel-amp-envs bad file: ~A" tag)))
+
+ (close-sound ind))
+
+
+ (let ((ind (open-sound "oboe.snd")))
+ (let ((ctr 0))
+ (map-channel (lambda (y) (or (> (set! ctr (+ ctr 1)) 3) (* y 2)))))
+ (if (not (= (framples ind 0) 3))
+ (snd-display #__line__ ";map-channel oboe -> #t at 3: ~A" (framples ind 0))
+ (if (not (vequal (channel->float-vector) (float-vector 0.0 -.001 -.001)))
+ (snd-display #__line__ ";map-channel #t oboe result: ~A" (channel->float-vector))))
+
+ (undo)
+ (let ((ctr 0))
+ (map-channel (lambda (y) (if (= (set! ctr (+ ctr 1)) 3) (make-float-vector 5 .1) (* y .5)))))
+ (if (not (= (framples ind 0) (+ 50828 4)))
+ (snd-display #__line__ ";map-channel oboe -> float-vector at 3: ~A" (framples ind 0))
+ (if (not (vequal (channel->float-vector 0 10) (float-vector 0.000 -0.000 0.100 0.100 0.100 0.100 0.100 -0.000 -0.000 -0.000)))
+ (snd-display #__line__ ";map-channel float-vector result: ~A" (channel->float-vector 0 10))))
+
+ (undo)
+ (let ((data (make-float-vector 2 0.0)))
+ (map-channel (lambda (y) (set! (data 0) y) data)))
+ (if (not (= (framples ind 0) (* 2 50828)))
+ (snd-display #__line__ ";map-channel oboe -> float-vector: ~A" (framples ind 0))
+ (if (not (vequal (channel->float-vector 0 10) (float-vector 0.000 0.000 -0.000 0.000 -0.000 0.000 -0.000 0.000 -0.000 0.0)))
+ (snd-display #__line__ ";map-channel float-vector result: ~A" (channel->float-vector 0 10))))
+ (revert-sound)
+ (close-sound ind))
+
+ (let ((ind (open-sound "2.snd")))
+ (ramp-channel 0.9 1.0)
+ (ramp-channel 0.9 1.0)
+ (xramp-channel 0.9 1.0 32.0)
+ (xramp-channel 0.9 1.0 32.0)
+ (mix-float-vector (float-vector .01 .02) 10000 ind 0 #t)
+ (set! (sync ind) 1)
+ (let ((mxs (maxamp ind #t)))
+ (env-sound '(0 .25 1 0.5))
+ (let ((mxs1 (maxamp ind #t)))
+ (if (or (fneq (car mxs) (* 2.0 (car mxs1)))
+ (fneq (cadr mxs) (* 2.0 (cadr mxs1))))
+ (snd-display #__line__ ";env-sound sync'd maxes: ~A -> ~A" mxs mxs1)))
+ (undo 1))
+ (close-sound ind))
+
+
+ (let ((ind (new-sound :channels 2 :size 10 :comment "new-sound for ramp2-xramp2")))
+ (map-channel (lambda (y) 1.0))
+ (ramp-channel 0.9 1.0)
+ (ramp-channel 0.9 1.0)
+ (xramp-channel 0.9 1.0 32.0)
+ (xramp-channel 0.9 1.0 32.0)
+ (mix-float-vector (float-vector .1 .2) 1 ind 0 #t)
+ (set! (sync ind) 1)
+ (let ((mxs (maxamp ind #t)))
+ (env-sound '(0 .25 1 0.5))
+ (let ((mxs1 (maxamp ind #t)))
+ (if (or (fneq (car mxs) (* 2.0 (car mxs1)))
+ (fneq (cadr mxs) (* 2.0 (cadr mxs1))))
+ (snd-display #__line__ ";env-sound sync'd maxes buf: ~A -> ~A" mxs mxs1)))
+ (undo 1))
+ (let ((name (file-name ind)))
+ (if (not (= (srate ind) *default-output-srate*))
+ (snd-display #__line__ ";new-sound default srate: ~A ~A" (srate ind) *default-output-srate*))
+ (close-sound ind)
+ (if (not (file-exists? name))
+ (snd-display #__line__ ";new-sound temp? ~A" name)
+ (delete-file name))))
+
+ (let ((ind (new-sound "test.snd" :size 40000)))
+ (let ((gen (make-triangle-wave 10.0 0.5)))
+ (clm-channel gen)
+ (src-channel 2))
+
+ (let ((ind1 (new-sound "test.snd" :size 40000)))
+ (let ((gen (make-triangle-wave 10.0 0.5)))
+ (clm-channel gen)
+ (src-channel 2.00001))
+
+ (let ((dist (channel-distance ind 0 ind1 0)))
+ (if (> dist 0.5)
+ (snd-display #__line__ ";src 2/2.0001: ~A" dist)))
+
+ (close-sound ind)
+ (close-sound ind1)))
+
+ (let ((old-width *sinc-width*))
+ (set! *sinc-width* 10)
+
+ (let ((res (new-sound :size 10)))
+ (set! (sample 3) .5)
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector -0.05016523320247118 0.1581800948824515 0.1581800948824515
+ -0.05016523320247118 0.02716944826115516 -0.01652926966015632)))
+ (snd-display #__line__ ";src 2, 10 3 10: ~A" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 10)))
+ (set! (sample 2) .5)
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.0 0.25 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";src 2, 10 2 10: ~A" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 10)))
+ (set! (sample 0) .5)
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.25 0.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";src 2, 10 0 10: ~A" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 11)))
+ (set! (sample 3) .5)
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector -0.05016523320247118 0.1581800948824515 0.1581800948824515
+ -0.05016523320247118 0.02716944826115516 -0.01652926966015632 0.01022512563738671)))
+ (snd-display #__line__ ";src 2, 11 3 10: ~A" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 11)))
+ (set! (sample 2) .5)
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.0 0.25 0.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";src 2, 11 2 10: ~A" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 11)))
+ (set! (sample 0) .5)
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.25 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";src 2, 11 0 10: ~A" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 40)))
+ (do ((i 0 (+ i 1)))
+ ((= i 20))
+ (set! (sample i) (* i .05))
+ (set! (sample (- 39 i)) (* i .05)))
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.01198528796961999 0.1035793306415383 0.2059748594814547 0.3060708098272395 0.4072307780331241
+ 0.5077603318367317 0.6062448605128621 0.7086656575233007 0.8045885470214085 0.9128440616541418
+ 0.9536620711423869 0.8562080426776515 0.7579855746854125 0.6566287955350736 0.5575138524566664
+ 0.4569842986530586 0.3574772574131896 0.2546643622412894 0.1572853567216201 0.04987330456145658 -0.0009027286222166014)))
+ (format *stderr* "src 2, 40 0 10: ~A~%" v)))
+ (close-sound res))
+
+ (set! *sinc-width* 11)
+
+ (let ((res (new-sound :size 15)))
+ (set! (sample 3) .5)
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector -0.05103248958541851 0.1584755057631961 0.1584755057631961
+ -0.05103248958541851 0.02854464095499105 -0.01828991864619797 0.01222560572178551 -0.008180460967128276 0.0)))
+ (snd-display #__line__ ";src 2, 15 3 11: ~A" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 15)))
+ (set! (sample 0) .5)
+ (src-channel 2.0)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.25 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (snd-display #__line__ ";src 2, 15 0 11: ~A" v)))
+ (close-sound res))
+
+ (set! *sinc-width* old-width))
+
+
+ (let ((old-width *sinc-width*))
+ (set! *sinc-width* 10)
+
+ (let ((res (new-sound :size 10)))
+ (set! (sample 3) .5)
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.0 0.05433889652231032 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5
+ 0.316360189764903 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265 0.0
+ 0.02045025127477342 0.0 -0.01220523861007159 0.0 0.006688908032246622 0.0)))
+ (format *stderr* "src 1/2, 10 3 10: ~A~%" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 10)))
+ (set! (sample 2) .5)
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903 0.0 -0.1003304664049424
+ 0.0 0.05433889652231032 0.0 -0.03305853932031265 0.0 0.02045025127477342 0.0
+ -0.01220523861007159 0.0 0.006688908032246622 0.0 -0.003110640428161881 0.0)))
+ (format *stderr* "src 1/2, 10 2 10: ~A~%" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 10)))
+ (set! (sample 0) .5)
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.5 0.316360189764903 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265
+ 0.0 0.02045025127477342 0.0 -0.01220523861007159 0.0 0.006688908032246622 0.0
+ -0.003110640428161881 0.0 0.001022072692939124 0.0 -0.000103644775079492 0.0)))
+ (format *stderr* "src 1/2, 10 0 10: ~A~%" v)))
+ (close-sound res))
+
+
+ (let ((res (new-sound :size 11)))
+ (set! (sample 3) .5)
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.0 0.05433889652231032 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903
+ 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265 0.0 0.02045025127477342
+ 0.0 -0.01220523861007159 0.0 0.006688908032246622 0.0 -0.003110640428161881 0.0)))
+ (format *stderr* "src 1/2, 11 3 10: ~A~%" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 11)))
+ (set! (sample 2) .5)
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.0 -0.1003304664049424 0.0 0.316360189764903 0.5 0.316360189764903 0.0 -0.1003304664049424
+ 0.0 0.05433889652231032 0.0 -0.03305853932031265 0.0 0.02045025127477342 0.0 -0.01220523861007159
+ 0.0 0.006688908032246622 0.0 -0.003110640428161881 0.0 0.001022072692939124 0.0)))
+ (format *stderr* "src 1/2, 11 2 10: ~A~%" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 11)))
+ (set! (sample 0) .5)
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.5 0.316360189764903 0.0 -0.1003304664049424 0.0 0.05433889652231032 0.0 -0.03305853932031265
+ 0.0 0.02045025127477342 0.0 -0.01220523861007159 0.0 0.006688908032246622 0.0
+ -0.003110640428161881 0.0 0.001022072692939124 0.0 -0.000103644775079492 0.0 0.0 0.0)))
+ (format *stderr* "src 1/2, 11 0 10: ~A~%" v)))
+ (close-sound res))
- (let ((ind (new-sound :channels 2 :size 10 :comment "new-sound for ramp2-xramp2")))
- (map-channel (lambda (y) 1.0))
- (ramp-channel 0.9 1.0)
- (ramp-channel 0.9 1.0)
- (xramp-channel 0.9 1.0 32.0)
- (xramp-channel 0.9 1.0 32.0)
- (mix-vct (vct .1 .2) 1 ind 0 #t)
- (set! (sync ind) 1)
- (let ((mxs (maxamp ind #t)))
- (env-sound '(0 .25 1 0.5))
- (let ((mxs1 (maxamp ind #t)))
- (if (or (fneq (car mxs) (* 2.0 (car mxs1)))
- (fneq (cadr mxs) (* 2.0 (cadr mxs1))))
- (snd-display #__line__ ";env-sound sync'd maxes buf: ~A -> ~A" mxs mxs1)))
- (undo 1))
- (let ((name (file-name ind)))
- (if (not (= (srate ind) (default-output-srate)))
- (snd-display #__line__ ";new-sound default srate: ~A ~A" (srate ind) (default-output-srate)))
- (close-sound ind)
- (if (not (file-exists? name))
- (snd-display #__line__ ";new-sound temp? ~A" name)
- (delete-file name))))
+ (let ((res (new-sound :size 40)))
+ (do ((i 0 (+ i 1)))
+ ((= i 20))
+ (set! (sample i) (* i .05))
+ (set! (sample (- 39 i)) (* i .05)))
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.0 0.02056010532402247 0.05 0.07720130317537323 0.1 0.1238094543862298 0.15 0.1758514952493174
+ 0.2 0.2245876821803736 0.25 0.2753688942389073 0.3 0.3249295824364337 0.35 0.3751591614371849
+ 0.4 0.4250776763951197 0.45 0.4750983986223486 0.5 0.5251191208495776 0.55 0.5750480002850203
+ 0.6000000000000001 0.6251857364939857 0.65 0.6749656459425423 0.7000000000000001 0.7252971884488815
+ 0.75 0.7748042296887507 0.8 0.8255720997331736 0.8500000000000001 0.8742119340573964 0.9
+ 0.9274509253698831 0.9500000000000001 0.9590869443463733 0.9500000000000001 0.9274509253698828
+ 0.9 0.8742119340573966 0.8500000000000001 0.8255720997331734 0.8 0.7748042296887506 0.75
+ 0.7252971884488812 0.7000000000000001 0.6749656459425423 0.65 0.6251857364939858
+ 0.6000000000000001 0.5750480002850203 0.55 0.5251191208495776 0.5 0.4750983986223486
+ 0.45 0.4250776763951198 0.4 0.3751591614371849 0.35 0.3249295824364337 0.3
+ 0.2753688942389073 0.25 0.2245876821803736 0.2 0.1758514952493173 0.15 0.1238094543862298
+ 0.1 0.07720130317537324 0.05 0.02056010532402247 0.0 -0.004445073550837984 0.0)))
+ (format *stderr* "src 1/2, 40 0 10: ~A~%" v)))
+ (close-sound res))
+
+ (set! *sinc-width* 11)
+
+ (let ((res (new-sound :size 15)))
+ (set! (sample 3) .5)
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.0 0.05588873297652781 0.0 -0.1013169884822853 0.0 0.3166955736757819 0.5 0.3166955736757819
+ 0.0 -0.1013169884822853 0.0 0.05588873297652781 0.0 -0.03503207135776369 0.0 0.02267085373675465
+ 0.0 -0.01446863119016991 0.0 0.008794782253203336 0.0 -0.004875864375201019 0.0 0.002288656235197179
+ 0.0 -0.0007570986863940245 0.0 7.729542250127452e-05 0.0 0.0 0.0)))
+ (format *stderr* "src 1/2, 15 3 11: ~A~%" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 15)))
+ (set! (sample 0) .5)
+ (src-channel 0.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 0.5 0.3166955736757819 0.0 -0.1013169884822853 0.0 0.05588873297652781 0.0 -0.03503207135776369 0.0
+ 0.02267085373675465 0.0 -0.01446863119016991 0.0 0.008794782253203336 0.0 -0.004875864375201019 0.0
+ 0.002288656235197179 0.0 -0.0007570986863940245 0.0 7.729542250127452e-05 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
+ (format *stderr* "src 1/2, 15 0 11: ~A~%" v)))
+ (close-sound res))
+
+ (set! *sinc-width* 10)
+
+ (let ((res (new-sound :size 10)))
+ (set! (sample 2) .5)
+ (src-channel 1.5)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector -0.0659173000292574 0.2750218141864232 0.1361775290259087 -0.05140008051946586 0.02873817799080515
+ -0.01761592377597271 0.01086818222156537 -0.006418849681280971)))
+ (format *stderr* "src 1.5, 10 0 10: ~A~%" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 10)))
+ (set! (sample 2) .5)
+ (src-channel 0.3)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector -2.309626927862667e-14 -0.07046687722856798 -0.1029821798386912 -0.04339187529883121
+ 0.1151049838606023 0.316360189764903 0.4672831482919799 0.4916944808321784 0.3769307110649516
+ 0.1817344234767786 1.953289539319582e-14 -0.09498013189693179 -0.08875244041152466
+ -0.0236470298331755 0.03764309466867966 0.05433889652231032 0.02735343920407904
+ -0.01239124709348501 -0.03298325840652785 -0.02431019463203471 4.869902458307762e-14
+ 0.01823801988763548 0.01851483195191724 0.005176164589977362 -0.008430282938941011
+ -0.01220523861007159 -0.006058987580643592 0.002667220356124145 0.006794601943645224
+ 0.004720812682785585 -3.100277189828097e-14 -0.002989527299513507 -0.002701674743876624
+ -0.0006539461337230524 0.0008891857488267552)))
+ (format *stderr* "src 0.3, 10 0 10: ~A~%" v)))
+ (close-sound res))
+
+ (let ((res (new-sound :size 10))
+ (e (make-env '(0 1 1 2) :length 11)))
+ (set! (sample 1) .5)
+ (set! (sample 8) .5)
+ (src-channel e)
+ (let ((v (channel->float-vector)))
+ (if (not (vvequal v (float-vector 3.511360236100833e-14 0.499999999999969 0.03245693012152732 -0.04426423670248926
+ 0.05693627592759216 -0.06869987735399859 0.1364034106143399 0.2654607053632132 -0.04771168369895742)))
+ (format *stderr* "src e, 10 0 10: ~A~%" v)))
+ (close-sound res))
+
+ (set! *sinc-width* old-width))
+
+
+ (let ((ind (new-sound "test.snd" :size 40000)))
+ (let ((gen (make-triangle-wave 10.0 0.5)))
+ (clm-channel gen)
+ (src-channel 0.5))
- ))
- ))
+ (let ((ind1 (new-sound "test.snd" :size 40000)))
+ (let ((gen (make-triangle-wave 10.0 0.5)))
+ (clm-channel gen)
+ (src-channel 0.50001))
+
+ (let ((dist (channel-distance ind 0 ind1 0)))
+ (if (> dist 0.5)
+ (snd-display #__line__ ";src 0.5/0.5001: ~A" dist)))
+
+ (close-sound ind)
+ (close-sound ind1)))
+ ))
+ )
;;; ---------------- test 17: dialogs and graphics ----------------
-(if (not (provided? 'snd-draw.scm)) (load "draw.scm")) ; needed also in test_21 (color-samples)
-(if with-gui
- (if (not (provided? 'snd-musglyphs.scm)) (load "musglyphs.scm")))
+(require snd-draw.scm)
+(if with-gui (require snd-musglyphs.scm))
+(require snd-enved.scm)
(define (snd_test_17)
- (define (-> x0 y0 size snd chn cr)
- "draw an arrow pointing (from the left) at the point (x0 y0)"
- (let ((points (make-vector 8)))
- (define (point i x y)
- (vector-set! points (* i 2) x)
- (vector-set! points (+ (* i 2) 1) y))
- (define (arrow-head x y)
- (point 0 x y)
- (point 1 (- x (* 2 size)) (- y size))
- (point 2 (- x (* 2 size)) (+ y size))
- (point 3 x y)
- (fill-polygon points snd chn time-graph cr))
- (arrow-head x0 y0)
- (fill-rectangle (- x0 (* 4 size))
- (floor (- y0 (* .4 size)))
- (* 2 size)
- (floor (* .8 size))
- snd chn time-graph #f cr)))
-
+ (define ->
+ (let ((documentation "draw an arrow pointing (from the left) at the point (x0 y0)"))
+ (lambda (x0 y0 size snd chn cr)
+ (let ((points (make-vector 8)))
+ (define (point i x y)
+ (set! (points (* i 2)) x)
+ (set! (points (+ (* i 2) 1)) y))
+ (define (arrow-head x y)
+ (point 0 x y)
+ (point 1 (- x (* 2 size)) (- y size))
+ (point 2 (- x (* 2 size)) (+ y size))
+ (point 3 x y)
+ (fill-polygon points snd chn time-graph cr))
+ (arrow-head x0 y0)
+ (fill-rectangle (- x0 (* 4 size))
+ (floor (- y0 (* .4 size)))
+ (* 2 size)
+ (floor (* .8 size))
+ snd chn time-graph #f cr)))))
(if with-gui
(begin
- (if (not (provided? 'snd-musglyphs.scm)) (load "musglyphs.scm"))
- (hook-push after-graph-hook display-previous-edits)
+ (require snd-musglyphs.scm)
+ (hook-push after-graph-hook (lambda (hook) (display-previous-edits (hook 'snd) (hook 'chn))))
(hook-push lisp-graph-hook
- (lambda (snd chn)
- (lambda ()
- (let ((cr (make-cairo (car (channel-widgets snd chn)))))
- (draw-string "hi"
- (x->position .5 snd chn lisp-graph)
- (y->position .5 snd chn lisp-graph)
- snd chn lisp-graph cr)
- (free-cairo cr)))))
- (let* ((ind (open-sound "oboe.snd"))
- (wids (channel-widgets))
- (wids1 (channel-widgets (selected-sound)))
- (wids2 (channel-widgets (selected-sound) (selected-channel))))
- (do ((i 1 (+ 1 i)))
+ (lambda (hook)
+ (let ((snd (hook 'snd))
+ (chn (hook 'chn)))
+ (set! (hook 'result)
+ (lambda ()
+ (let ((cr (make-cairo (car (channel-widgets snd chn)))))
+ (draw-string "hi"
+ (x->position .5 snd chn lisp-graph)
+ (y->position .5 snd chn lisp-graph)
+ snd chn lisp-graph cr)
+ (free-cairo cr)))))))
+ (let ((ind (open-sound "oboe.snd"))
+ (wids (channel-widgets))
+ (wids1 (channel-widgets (selected-sound)))
+ (wids2 (channel-widgets (selected-sound) (selected-channel))))
+ (do ((i 1 (+ i 1)))
((= i 4))
(scale-by 0.5)
(set! (x-bounds) (list 0 (* i .3))))
@@ -39965,26 +33008,26 @@ EDITS: 1
(draw-line 100 100 200 200 ind 0 time-graph cr)
(draw-dot 300 300 10 ind 0 time-graph cr)
(draw-string "hiho" 20 20 ind 0 time-graph cr)
- (draw-dots '#(25 25 50 50 100 100) 10 ind 0 time-graph cr)
+ (draw-dots #(25 25 50 50 100 100) 10 ind 0 time-graph cr)
(-> 100 50 10 ind 0 cr)
(fill-rectangle 20 20 100 100 ind 0 time-graph #f cr)
(free-cairo cr))
(make-bezier 0 0 20 20 40 30 60 10 10)
(update-time-graph ind 0)
;(fill-rectangle 20 20 100 100 ind 0 time-graph #t)
- (set! (hook-functions after-graph-hook) '())
- (set! (hook-functions lisp-graph-hook) '())
+ (set! (hook-functions after-graph-hook) ())
+ (set! (hook-functions lisp-graph-hook) ())
- (set! (hook-functions lisp-graph-hook) '())
+ (set! (hook-functions lisp-graph-hook) ())
(let ((ind (open-sound "oboe.snd")))
(set! (time-graph? ind 0) #f)
- (graph (list (vct 0 1 2) (vct 3 2 1) (vct 1 2 3) (vct 1 1 1) (vct 0 1 0) (vct 3 1 2)))
+ (graph (list (float-vector 0 1 2) (float-vector 3 2 1) (float-vector 1 2 3) (float-vector 1 1 1) (float-vector 0 1 0) (float-vector 3 1 2)))
(update-lisp-graph)
- (hook-push lisp-graph-hook (lambda (snd chn)
- (list (basic-color) (zoom-color) (data-color) (selected-data-color) (mix-color))))
- (graph (list (vct 0 1 2) (vct 3 2 1) (vct 1 2 3) (vct 1 1 1) (vct 0 1 0) (vct 3 1 2)))
+ (hook-push lisp-graph-hook (lambda (hook)
+ (set! (hook 'result) (list *basic-color* *zoom-color* *data-color* *selected-data-color* *mix-color*))))
+ (graph (list (float-vector 0 1 2) (float-vector 3 2 1) (float-vector 1 2 3) (float-vector 1 1 1) (float-vector 0 1 0) (float-vector 3 1 2)))
(update-lisp-graph)
- (set! (hook-functions lisp-graph-hook) '())
+ (set! (hook-functions lisp-graph-hook) ())
(close-sound ind))
(let* ((ind1 (open-sound "2.snd"))
@@ -39993,22 +33036,13 @@ EDITS: 1
(if (or (not (pair? wids))
(not (pair? wids3))
(and (provided? 'snd-motif)
- (or (not (= (length wids1) 11))
- (not (= (length wids2) 11)))))
+ (not (= (length wids1) 11 (length wids2)))))
(snd-display #__line__ ";channel-widgets confused: ~A ~A ~A ~A ~A" wids wids1 wids2 wids3 wids4))
(hide-widget (car (channel-widgets)))
(show-widget (car (channel-widgets)))
(close-sound ind1))
- (close-sound ind))
+ (close-sound ind))))
- )))
-
-
-;;; ---------------- test 18: enved ----------------
-
-(if (not (provided? 'snd-enved.scm)) (load "enved.scm"))
-
-(define (snd_test_18)
(if with-gui
(begin
(start-enveloping)
@@ -40020,79 +33054,81 @@ EDITS: 1
(snd-display #__line__ ";set channel-envelope: ~A?" (channel-envelope nind 0)))
(close-sound nind)
(stop-enveloping))
- )))
-
+ ))
+ (reset-all-hooks)
+ )
-;;; ---------------- test 19: save and restore ----------------
-(if (not (provided? 'snd-fade.scm)) (load "fade.scm"))
+;;; ---------------- test 18: save and restore ----------------
-(define after-save-state-hook-var 0) ; global for load save-state stuff
+(require snd-fade.scm)
(define* (clm-channel-test snd chn) ; edit-list->function wants this to be global??
(clm-channel (make-two-zero 1 -1) 0 #f snd chn #f #f "clm-channel-test"))
(define* (make-v-mix snd chn)
- (mix-vct (vct .1 .2 .3) 100 snd chn #t "mix-vct (vct .1 .2 .3)"))
+ (mix-float-vector (float-vector .1 .2 .3) 100 snd chn #t "mix-float-vector (float-vector .1 .2 .3)"))
-(define (snd_test_19)
+(define* (insert-float-vector v (beg 0) dur snd chn edpos)
+ (if (not (float-vector? v))
+ (error 'wrong-type-arg "insert-float-vector: ~A" v)
+ (let ((len (or dur (length v))))
+ (insert-samples beg len v snd chn edpos #f (format #f "insert-float-vector ~A ~A ~A" (float-vector->string v) beg dur)))))
+
+(define (snd_test_18)
- (define* (hilbert-transform-via-fft snd chn)
- "same as FIR version but use FFT and change phases by hand"
- (let* ((size (frames snd chn))
- (len (expt 2 (ceiling (/ (log size) (log 2.0)))))
- (rl (make-vct len))
- (im (make-vct len))
- (rd (make-sampler 0 snd chn)))
- (do ((i 0 (+ 1 i)))
- ((= i size))
- (vct-set! rl i (rd)))
- (mus-fft rl im len)
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let* ((c (make-rectangular (vct-ref rl i) (vct-ref im i)))
- (ph (angle c))
- (mag (magnitude c)))
- (if (< i (/ len 2))
- (set! ph (+ ph (* 0.5 pi)))
- (set! ph (- ph (* 0.5 pi))))
- (set! c (make-polar mag ph))
- (vct-set! rl i (real-part c))
- (vct-set! im i (imag-part c))))
- (mus-fft rl im len -1)
- (vct-scale! rl (/ 1.0 len))
- (vct->channel rl 0 len snd chn #f "hilbert-transform-via-fft")))
+ (define hilbert-transform-via-fft
+ (let ((documentation "same as FIR version but use FFT and change phases by hand"))
+ (lambda* (snd chn)
+ (let* ((size (framples snd chn))
+ (len (expt 2 (ceiling (log size 2.0))))
+ (rl (make-float-vector len))
+ (im (make-float-vector len))
+ (rd (make-sampler 0 snd chn))
+ (pi2 (* 0.5 pi)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! (rl i) (rd)))
+ (mus-fft rl im len)
+ (rectangular->polar rl im)
+ (float-vector-offset! im (- pi2))
+ (do ((i (/ len 2) (+ i 1)))
+ ((= i len))
+ (float-vector-set! im i (+ (float-vector-ref im i) pi)))
+ (polar->rectangular rl im)
+ (mus-fft rl im len -1)
+ (float-vector-scale! rl (/ 1.0 len))
+ (float-vector->channel rl 0 len snd chn #f "hilbert-transform-via-fft")))))
;; echoes with each echo at a new pitch via ssb-am etc
+#|
+ ;; old form
(define* (make-ssb-transposer old-freq new-freq pairs (order 40) (bw 50.0))
- (let* ((ssbs (make-vector pairs))
- (bands (make-vector pairs))
- (factor (/ (- new-freq old-freq) old-freq)))
- (do ((i 1 (+ 1 i)))
+ (let ((ssbs (make-vector pairs))
+ (bands (make-vector pairs))
+ (factor (/ (- new-freq old-freq) old-freq)))
+ (do ((i 1 (+ i 1)))
((> i pairs))
- (let* ((aff (* i old-freq))
- (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
- (vector-set! ssbs (- i 1) (make-ssb-am (* i factor old-freq)))
- (vector-set! bands (- i 1) (make-bandpass (hz->radians (- aff bwf))
- (hz->radians (+ aff bwf))
- order))))
+ (let ((aff (* i old-freq))
+ (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
+ (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
+ (set! (bands (- i 1)) (make-bandpass (hz->radians (- aff bwf))
+ (hz->radians (+ aff bwf))
+ order))))
(list ssbs bands)))
(define (ssb-transpose transposer input)
(let* ((sum 0.0)
(ssbs (car transposer))
(bands (cadr transposer))
- (pairs (vector-length ssbs)))
- (do ((i 0 (+ 1 i)))
+ (pairs (length ssbs)))
+ (do ((i 0 (+ i 1)))
((= i pairs) sum)
(set! sum (+ sum (ssb-am (vector-ref ssbs i)
(bandpass (vector-ref bands i)
input)))))))
- (define (fdelay gen input)
- (gen input))
-
(define (make-fdelay len pitch scaler)
(let ((dly (make-delay len))
(ssb (make-ssb-transposer 440.0 (* 440.0 pitch) 10)))
@@ -40100,9 +33136,40 @@ EDITS: 1
(delay dly (+ input (* scaler (ssb-transpose ssb (tap dly))))))))
(define (transposed-echo pitch scaler secs)
- (let ((del (make-fdelay (round (* secs (srate))) pitch scaler)))
- (map-channel (lambda (y) (fdelay del y)))))
+ (map-channel (make-fdelay (round (* secs (srate))) pitch scaler)))
+|#
+ (define-macro (make-fdelay len pitch scaler)
+ `(let ((body ())
+ (closure (list (list 'dly (list 'make-delay ,len))))
+ (old-freq 440.0)
+ (new-freq (* 440.0 ,pitch))
+ (pairs 10)
+ (order 40)
+ (bw 50.0))
+ (let ((factor (/ (- new-freq old-freq) old-freq)))
+ (do ((i 1 (+ i 4)))
+ ((> i pairs))
+ (let ((inner-body ())
+ (n (+ 1 (min 3 (- pairs i)))))
+ (do ((k 0 (+ k 1))) ; the inner loop is dividing up large sums for the optimizer's benefit (it can handle 4 at a time currently)
+ ((= k n))
+ (let ((aff (* (+ i k) old-freq))
+ (bwf (* bw (+ 1.0 (/ (+ i k) (* 2 pairs)))))
+ (ssb (string->symbol (format #f "s~D" (+ i k))))
+ (flt (string->symbol (format #f "g~D" (+ i k)))))
+ (set! closure (cons (list ssb (list 'make-ssb-am (* (+ i k) old-freq factor)))
+ (cons (list flt (list 'make-bandpass (hz->radians (- aff bw)) (hz->radians (+ aff bw)) order))
+ closure)))
+ (set! inner-body (cons (list 'ssb-am ssb (list 'bandpass flt 'y)) inner-body))))
+ (set! body (cons (append (list '+) inner-body) body))))
+ (apply let closure
+ `((lambda (y)
+ (+ y (delay dly (* ,,scaler (+ , at body))))))))))
+
+ (define (transposed-echo pitch scaler secs)
+ (map-channel (make-fdelay (round (* secs (srate))) pitch scaler)))
+
(define (local-eq? a b)
(if (number? a)
(if (rational? a)
@@ -40115,7 +33182,7 @@ EDITS: 1
(ssb-bank old-freq new-freq 10))
(define (retime-sound new-time)
- (let* ((old-time (/ (frames) (srate)))
+ (let* ((old-time (/ (framples) (srate)))
(factor (/ new-time old-time)))
(ssb-bank 557 (* 557 factor) 10)
(src-sound (/ 1.0 factor))))
@@ -40125,35 +33192,35 @@ EDITS: 1
(delete-sample 12)
(set! (x-bounds) (list .2 .4))
(let ((old-bounds (x-bounds)))
- (set! (show-axes) show-all-axes)
- (set! (transform-graph-type) graph-as-sonogram)
- (set! (speed-control-style) speed-control-as-ratio)
- (set! (channel-style) channels-superimposed)
- (set! (enved-target) enved-srate)
+ (set! *show-axes* show-all-axes)
+ (set! *transform-graph-type* graph-as-sonogram)
+ (set! *speed-control-style* speed-control-as-ratio)
+ (set! *channel-style* channels-superimposed)
+ (set! *enved-target* enved-srate)
(set! (sound-property :hi nind) "hi")
(set! (sound-property 'ho nind) 1234)
(set! (channel-property :ha nind 0) 3.14)
- (set! (hook-functions after-save-state-hook) '())
+ (set! (hook-functions after-save-state-hook) ())
(hook-push before-save-state-hook
- (lambda (name)
- (with-output-to-file name
+ (lambda (hook)
+ (with-output-to-file (hook 'name)
(lambda ()
- (display (format #f ";this comment will be at the top of the saved state file.~%~%"))
- #t))))
- (if (file-exists? (save-state-file)) (delete-file (save-state-file)))
- (save-state (save-state-file))
+ (format #t ";this comment will be at the top of the saved state file.~%~%")
+ (set! (hook 'result) #t)))))
+ (if (file-exists? *save-state-file*) (delete-file *save-state-file*))
+ (save-state *save-state-file*)
(close-sound nind)
(for-each forget-region (regions))
- (load (string-append cwd (save-state-file)))
+ (load (string-append cwd *save-state-file*))
(let ((ind (find-sound "oboe.snd")))
(if (not (sound? ind))
- (snd-display #__line__ ";can't restore oboe.snd from ~A?" (save-state-file))
+ (snd-display #__line__ ";can't restore oboe.snd from ~A?" *save-state-file*)
(begin
(if (or (> (abs (- (car old-bounds) (car (x-bounds ind 0)))) .05)
(> (abs (- (cadr old-bounds) (cadr (x-bounds ind 0)))) .05))
(snd-display #__line__ ";save bounds: ~A" (x-bounds ind 0)))
(if (not (= (length (marks ind 0)) 1))
- (snd-display #__line__ ";save marks: ~A (~A)?" (marks ind 0) (save-state-file))
+ (snd-display #__line__ ";save marks: ~A (~A)?" (marks ind 0) *save-state-file*)
(begin
(if (not (= (mark-sample (car (marks ind 0))) 122))
(snd-display #__line__ ";save mark: ~A?" (mark-sample (car (marks ind 0)))))
@@ -40174,21 +33241,19 @@ EDITS: 1
(fneq (channel-property :ha ind 0) 3.14))
(snd-display #__line__ ";channel-property saved: 3.14 -> ~A" (channel-property :ha ind 0)))
(close-sound ind)))
- (if (not (= after-save-state-hook-var 1234))
- (snd-display #__line__ ";after-save-state-hook: ~A" after-save-state-hook-var))
- (set! (hook-functions after-save-state-hook) '())
- (set! (hook-functions before-save-state-hook) '())
+ (set! (hook-functions after-save-state-hook) ())
+ (set! (hook-functions before-save-state-hook) ())
(let ((err (catch 'cannot-save
- (lambda ()
- (save-state "/bad/bad.save"))
- (lambda args 12345))))
+ (lambda ()
+ (save-state "/bad/bad.save"))
+ (lambda args 12345))))
(if (not (= err 12345)) (snd-display #__line__ ";save-state err: ~A?" err)))
(let ((err (catch 'cannot-save
- (lambda ()
- (save-listener "/bad/bad.save"))
- (lambda args 12345))))
+ (lambda ()
+ (save-listener "/bad/bad.save"))
+ (lambda args 12345))))
(if (not (= err 12345)) (snd-display #__line__ ";save-listener err: ~A?" err)))
))
(set! nind (open-sound "oboe.snd"))
@@ -40207,14 +33272,14 @@ EDITS: 1
(if (not (equal? (edit-fragment 4) '("scale-channel 2.000 0 #f" "scale" 0 50828))) (snd-display #__line__ ";save-edit-history 4: ~A?" (edit-fragment 4)))
(if (not (equal? (edit-fragment 5) '("pad-channel" "zero" 100 20))) (snd-display #__line__ ";save-edit-history 5: ~A?" (edit-fragment 5)))
(save-edit-history "hiho.scm" nind 0)
- (scale-sound-to 1.0 0 (frames nind 0) nind 0)
+ (scale-sound-to 1.0 0 (framples nind 0) nind 0)
(let ((eds (edit-position nind 0))
(val (insert-sound "zero.snd")))
(if (or (not (= 0 val))
(not (= eds (edit-position nind 0))))
(snd-display #__line__ ";insert-sound zero.snd was an edit? ~A ~A ~A" val eds (edit-position nind 0))))
(revert-sound nind)
- (scale-sound-to 0.5 0 (frames nind 0) nind 0)
+ (scale-sound-to 0.5 0 (framples nind 0) nind 0)
(if (fneq (maxamp nind 0) 0.5) (snd-display #__line__ ";scale-sound-to 0.5: ~A" (maxamp nind)))
(close-sound nind)
@@ -40235,60 +33300,8 @@ EDITS: 1
(xramp-channel 0.000 1.000 32.000 0 #f sfile 0 #f)
"))
(snd-display #__line__ ";file->string: ~A" str)))
- (let ((old-opt (optimization)))
- (set! (optimization) 5)
- (ptree-channel (lambda (y) (* y 2)))
- (save-edit-history "hiho.scm")
- (revert-sound nind)
- (set! sfile nind)
- (load (string-append cwd "hiho.scm"))
- (set! (optimization) old-opt))
- (if (not (equal? (edit-fragment 1) '("ptree-channel" "ptree" 0 50828)))
- (snd-display #__line__ ";save-edit-history ptree 1: ~A?" (edit-fragment 1)))
(close-sound nind))
- (let ((ind (open-sound "oboe.snd")))
- (set! (speed-control ind) 2/3)
- (set! (filter-control-envelope ind) (list 0.0 0.0 1.0 1.0))
- (set! (sound-property :hi ind) 12345)
- (insert-samples 0 100 (make-vct 100 .1) ind 0) ; need data to force save-state-hook to be called
- (set! (hook-functions save-state-hook) '())
- (hook-push save-state-hook (lambda (filename) "savehook.snd"))
- (save-state "s61.scm")
- (close-sound ind)
- (if (not (file-exists? "savehook.snd"))
- (snd-display #__line__ ";save-state-hook redirect failed? ~A" (hook-functions save-state-hook))
- (begin
- (load (string-append cwd "s61.scm"))
- (set! ind (find-sound "oboe.snd"))
- (if (not (sound? ind))
- (snd-display #__line__ ";save-state after hook restored but no sound?")
- (begin
- (if (fneq (speed-control ind) .6667) (snd-display #__line__ ";save-state w/hook speed: ~A" (speed-control ind)))
- (if (or (not (number? (sound-property :hi ind)))
- (not (= (sound-property :hi ind) 12345)))
- (snd-display #__line__ ";save-state w/hook hi: ~A" (sound-property :hi ind)))
- (if (not (feql (filter-control-envelope ind) (list 0.0 0.0 1.0 1.0)))
- (snd-display #__line__ ";save-state w/hook filter env: ~A" (filter-control-envelope ind)))
- ;; now check that save-state-hook is not called by other funcs
- (set! (hook-functions save-state-hook) '())
- (hook-push save-state-hook (lambda (file) (snd-display #__line__ ";bogus save-state-hook call!") "edit-list-to-function-saved.snd"))
- (let ((func (edit-list->function ind 0)))
- (if (file-exists? "edit-list-to-function-saved.snd")
- (begin
- (snd-display #__line__ ";edit-list->function called save-state-hook")
- (delete-file "edit-list-to-function-saved.snd"))))
- (save-edit-history "save-edit-history-saved.scm" ind 0)
- (if (file-exists? "edit-list-to-function-saved.snd")
- (begin
- (snd-display #__line__ ";save-edit-history called save-state-hook")
- (delete-file "edit-list-to-function-saved.snd")))
- (delete-file "save-edit-history-saved.scm")
- (delete-file "savehook.snd")
- (close-sound ind)))))
- (delete-file "s61.scm")
- (set! (hook-functions save-state-hook) '()))
-
(add-sound-file-extension "ogg")
(add-sound-file-extension "OGG")
(add-sound-file-extension "sf")
@@ -40316,7 +33329,8 @@ EDITS: 1
(set! (sample 10) .1)
(save-sound ind)
(set! (sample 1) .1)
- (let ((eds (safe-display-edits ind)))
+ (let ()
+ (safe-display-edits ind)
(if (file-exists? "t1.scm") (delete-file "t1.scm"))
(save-state "t1.scm")
(close-sound ind)
@@ -40325,10 +33339,10 @@ EDITS: 1
(set! ind (find-sound "fmv.snd"))
(if (not (sound? ind))
(snd-display #__line__ ";save-state restored but no sound?"))
- (do ((i 3 (+ 1 i)))
+ (do ((i 3 (+ i 1)))
((= i 6))
(set! (sample i) (* i .1))
- (set! eds (safe-display-edits ind))
+ (safe-display-edits ind)
(if (file-exists? "t1.scm") (delete-file "t1.scm"))
(save-state "t1.scm")
(close-sound ind)
@@ -40340,8 +33354,8 @@ EDITS: 1
(close-sound ind)
(delete-file "t1.scm"))
- (let ((ind (new-sound "fmv.snd" mus-next mus-bshort 22050 8 "this is an 8-channel save-state test"))
- (ind1 (new-sound "fmv1.snd" mus-next mus-bshort 22050 2 "this is a 2-channel save-state test")))
+ (let ((ind (new-sound "fmv.snd" 8 22050 mus-ldouble mus-next "this is an 8-channel save-state test"))
+ (ind1 (new-sound "fmv1.snd" 2 22050 mus-ldouble mus-next "this is a 2-channel save-state test")))
(set! (sample 10 ind 0) .1)
(set! (sample 10 ind 1) .2)
(set! (sample 10 ind 2) .3)
@@ -40356,32 +33370,32 @@ EDITS: 1
(set! (sample 1 ind 3) .4)
(set! (sample 1 ind1 0) -.1)
(set! (sample 1 ind1 1) -.2)
- (let ((eds (safe-display-edits ind))
- (eds1 (safe-display-edits ind1)))
- (if (file-exists? "t1.scm") (delete-file "t1.scm"))
- (save-state "t1.scm")
- (close-sound ind)
- (close-sound ind1)
- (for-each forget-region (regions))
- (load (string-append cwd "t1.scm"))
- (set! ind (find-sound "fmv.snd"))
- (set! ind1 (find-sound "fmv1.snd"))
- (if (or (not (sound? ind))
- (not (sound? ind1)))
- (snd-display #__line__ ";save-state(2) restored but no sound? ~A ~A" ind ind1)))
+ (safe-display-edits ind)
+ (safe-display-edits ind1)
+ (if (file-exists? "t1.scm") (delete-file "t1.scm"))
+ (save-state "t1.scm")
+ (close-sound ind)
+ (close-sound ind1)
+ (for-each forget-region (regions))
+ (load (string-append cwd "t1.scm"))
+ (set! ind (find-sound "fmv.snd"))
+ (set! ind1 (find-sound "fmv1.snd"))
+ (if (or (not (sound? ind))
+ (not (sound? ind1)))
+ (snd-display #__line__ ";save-state(2) restored but no sound? ~A ~A" ind ind1))
(close-sound ind)
(close-sound ind1)
(delete-file "t1.scm"))
(let ((ind (open-sound "oboe.snd"))
- (old-save-dir (save-dir))
- (old-eps-file (eps-file)))
- (set! (save-dir) #f)
- (let ((v (make-vct 32 1.0)))
+ (old-save-dir *save-dir*)
+ (old-eps-file *eps-file*))
+ (set! *save-dir* #f)
+ (let ((v (make-float-vector 32 1.0)))
(set! (samples 100 32) v))
(map-channel (lambda (y) (+ y .1)) 1000 10000)
(set! (show-axes ind 0) show-no-axes)
- (set! (zoom-focus-style) zoom-focus-middle)
+ (set! *zoom-focus-style* zoom-focus-middle)
(set! (transform-normalization ind 0) dont-normalize)
(set! (graph-style ind 0) graph-filled)
(set! (transform-graph-type ind 0) graph-as-spectrogram)
@@ -40389,7 +33403,7 @@ EDITS: 1
(set! (x-axis-style ind 0) x-axis-as-percentage)
(set! (speed-control-style ind) speed-control-as-semitone)
(set! (cursor ind 0) 1234)
- (set! (eps-file) "hiho.eps")
+ (set! *eps-file* "hiho.eps")
(set! (amp-control-bounds ind) (list 0.0 2.5))
(set! (speed-control-bounds ind) (list 1.0 2.5))
(set! (reverb-control-scale-bounds ind) (list 0.0 2.5))
@@ -40397,31 +33411,31 @@ EDITS: 1
(set! (contrast-control-bounds ind) (list 0.0 2.5))
(set! (x-axis-label ind 0 time-graph) "time-x")
(set! (y-axis-label ind 0 time-graph) "amp-y")
- (let ((old-srate (mus-srate))
- (old-file-buffer-size (mus-file-buffer-size))
- (old-array-print-length (mus-array-print-length))
- (old-clm-table-size (clm-table-size)))
- (set! (mus-srate) 48000)
- (set! (mus-array-print-length) 24)
- (set! (mus-file-buffer-size) 4096)
- (set! (clm-table-size) 256)
+ (let ((old-srate *clm-srate*)
+ (old-file-buffer-size *clm-file-buffer-size*)
+ (old-array-print-length *mus-array-print-length*)
+ (old-clm-table-size *clm-table-size*))
+ (set! *clm-srate* 48000)
+ (set! *mus-array-print-length* 24)
+ (set! *clm-file-buffer-size* 4096)
+ (set! *clm-table-size* 256)
(if (file-exists? "s61.scm") (delete-file "s61.scm"))
(save-state "s61.scm")
(close-sound ind)
(for-each forget-region (regions))
(load (string-append cwd "s61.scm"))
- (if (fneq (mus-srate) 48000.0) (snd-display #__line__ ";save/restore mus-srate: ~A" (mus-srate)))
- (if (not (= (mus-file-buffer-size) 4096)) (snd-display #__line__ ";save/restore mus-file-buffer-size: ~A" (mus-file-buffer-size)))
- (if (not (= (mus-array-print-length) 24)) (snd-display #__line__ ";save/restore mus-array-print-length: ~A" (mus-array-print-length)))
- (if (not (= (clm-table-size) 256)) (snd-display #__line__ ";save/restore clm-table-size: ~A" (clm-table-size)))
- (set! (mus-srate) old-srate)
- (set! (mus-array-print-length) old-array-print-length)
- (set! (mus-file-buffer-size) old-file-buffer-size)
- (set! (clm-table-size) old-clm-table-size))
- (set! (save-dir) old-save-dir)
+ (if (fneq *clm-srate* 48000.0) (snd-display #__line__ ";save/restore mus-srate: ~A" *clm-srate*))
+ (if (not (= *clm-file-buffer-size* 4096)) (snd-display #__line__ ";save/restore mus-file-buffer-size: ~A" *clm-file-buffer-size*))
+ (if (not (= *mus-array-print-length* 24)) (snd-display #__line__ ";save/restore mus-array-print-length: ~A" *mus-array-print-length*))
+ (if (not (= *clm-table-size* 256)) (snd-display #__line__ ";save/restore clm-table-size: ~A" *clm-table-size*))
+ (set! *clm-srate* old-srate)
+ (set! *mus-array-print-length* old-array-print-length)
+ (set! *clm-file-buffer-size* old-file-buffer-size)
+ (set! *clm-table-size* old-clm-table-size))
+ (set! *save-dir* old-save-dir)
(set! ind (find-sound "oboe.snd"))
(if (not (= (show-axes ind 0) show-no-axes)) (snd-display #__line__ ";save show-no-axes: ~A" (show-axes ind 0)))
- (if (not (= (zoom-focus-style) zoom-focus-middle)) (snd-display #__line__ ";save zoom-focus-middle: ~A" (zoom-focus-style)))
+ (if (not (= *zoom-focus-style* zoom-focus-middle)) (snd-display #__line__ ";save zoom-focus-middle: ~A" *zoom-focus-style*))
(if (not (= (transform-normalization ind 0) dont-normalize)) (snd-display #__line__ ";save dont-normalize: ~A" (transform-normalization ind 0)))
(if (not (= (graph-style ind 0) graph-filled)) (snd-display #__line__ ";save graph-filled: ~A" (graph-style ind 0)))
(if (not (= (transform-graph-type ind 0) graph-as-spectrogram)) (snd-display #__line__ ";save graph-as-spectrogram: ~A" (transform-graph-type ind 0)))
@@ -40429,11 +33443,12 @@ EDITS: 1
(if (not (= (x-axis-style ind 0) x-axis-as-percentage)) (snd-display #__line__ ";save x-axis-as-percentage: ~A" (x-axis-style ind 0)))
(if (not (= (speed-control-style ind) speed-control-as-semitone)) (snd-display #__line__ ";save speed-control-style: ~A" (speed-control-style ind)))
(if (not (= (cursor ind 0) 1234)) (snd-display #__line__ ";save cursor 1234: ~A" (cursor ind 0)))
- (if (not (string=? (eps-file) "hiho.eps")) (snd-display #__line__ ";save eps-file: ~A" (eps-file)))
- (if (not (string=? (x-axis-label ind 0 time-graph) "time-x"))
- (snd-display #__line__ ";save x-axis-label: ~A" (x-axis-label ind 0 time-graph)))
- (if (not (string=? (y-axis-label ind 0 time-graph) "amp-y"))
- (snd-display #__line__ ";save y-axis-label: ~A" (y-axis-label ind 0 time-graph)))
+ (if (not (string=? *eps-file* "hiho.eps")) (snd-display #__line__ ";save eps-file: ~A" *eps-file*))
+ (when with-gui
+ (if (not (string=? (x-axis-label ind 0 time-graph) "time-x"))
+ (snd-display #__line__ ";save x-axis-label: ~A" (x-axis-label ind 0 time-graph)))
+ (if (not (string=? (y-axis-label ind 0 time-graph) "amp-y"))
+ (snd-display #__line__ ";save y-axis-label: ~A" (y-axis-label ind 0 time-graph))))
(if (not (feql (amp-control-bounds ind) (list 0 2.5)))
(snd-display #__line__ ";save amp-control-bounds: ~A" (amp-control-bounds ind)))
(if (not (feql (speed-control-bounds ind) (list 1.0 2.5)))
@@ -40444,22 +33459,22 @@ EDITS: 1
(snd-display #__line__ ";save reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds ind)))
(if (not (feql (reverb-control-length-bounds ind) (list 0 2.5)))
(snd-display #__line__ ";save reverb-control-length-bounds: ~A" (reverb-control-length-bounds ind)))
- (set! (eps-file) old-eps-file)
+ (set! *eps-file* old-eps-file)
(delete-file "s61.scm")
(close-sound ind))
(let ((ind (open-sound "oboe.snd"))
- (old-tiny-font (tiny-font))
- (old-peaks-font (peaks-font))
- (old-bold-peaks-font (bold-peaks-font))
+ (old-tiny-font *tiny-font*)
+ (old-peaks-font *peaks-font*)
+ (old-bold-peaks-font *bold-peaks-font*)
(old-amp (amp-control-bounds))
(old-speed (speed-control-bounds))
(old-contrast (contrast-control-bounds))
(old-revlen (reverb-control-length-bounds))
(old-revscl (reverb-control-scale-bounds)))
- (set! (tiny-font) "8x13")
- (set! (peaks-font) "8x13")
- (set! (bold-peaks-font) "8x13")
+ (set! *tiny-font* "8x13")
+ (set! *peaks-font* "8x13")
+ (set! *bold-peaks-font* "8x13")
(set! (amp-control-bounds) (list 0.0 2.5))
(set! (speed-control-bounds) (list 1.0 2.5))
(set! (reverb-control-scale-bounds) (list 0.0 2.5))
@@ -40469,9 +33484,9 @@ EDITS: 1
(close-sound ind)
(for-each forget-region (regions))
(load (string-append cwd "s61.scm"))
- (if (not (string=? (tiny-font) "8x13")) (snd-display #__line__ ";save tiny-font: ~A" (tiny-font)))
- (if (not (string=? (peaks-font) "8x13")) (snd-display #__line__ ";save peaks-font: ~A" (peaks-font)))
- (if (not (string=? (bold-peaks-font) "8x13")) (snd-display #__line__ ";save bold-peaks-font: ~A" (bold-peaks-font)))
+ (if (not (string=? *tiny-font* "8x13")) (snd-display #__line__ ";save tiny-font: ~A" *tiny-font*))
+ (if (not (string=? *peaks-font* "8x13")) (snd-display #__line__ ";save peaks-font: ~A" *peaks-font*))
+ (if (not (string=? *bold-peaks-font* "8x13")) (snd-display #__line__ ";save bold-peaks-font: ~A" *bold-peaks-font*))
(if (not (feql (amp-control-bounds) (list 0 2.5)))
(snd-display #__line__ ";save amp-control-bounds: ~A" (amp-control-bounds)))
(if (not (feql (speed-control-bounds) (list 1.0 2.5)))
@@ -40482,9 +33497,9 @@ EDITS: 1
(snd-display #__line__ ";save reverb-control-scale-bounds: ~A" (reverb-control-scale-bounds)))
(if (not (feql (reverb-control-length-bounds) (list 0 2.5)))
(snd-display #__line__ ";save reverb-control-length-bounds: ~A" (reverb-control-length-bounds)))
- (set! (tiny-font) old-tiny-font)
- (set! (peaks-font) old-peaks-font)
- (set! (bold-peaks-font) old-bold-peaks-font)
+ (set! *tiny-font* old-tiny-font)
+ (set! *peaks-font* old-peaks-font)
+ (set! *bold-peaks-font* old-bold-peaks-font)
(set! (amp-control-bounds) old-amp)
(set! (speed-control-bounds) old-speed)
(set! (contrast-control-bounds) old-contrast)
@@ -40513,8 +33528,8 @@ EDITS: 1
(set! (func) global)
(set! (func ind 0) local))
funcs func-names new-globals new-locals)
- (set! (zoom-focus-style) zoom-focus-right)
- (set! (channel-style) channels-combined)
+ (set! *zoom-focus-style* zoom-focus-right)
+ (set! *channel-style* channels-combined)
(set! (channel-style ind) channels-separate)
(if (file-exists? "s61.scm") (delete-file "s61.scm"))
(save-state "s61.scm")
@@ -40522,26 +33537,27 @@ EDITS: 1
(for-each forget-region (regions))
(load (string-append cwd "s61.scm"))
(set! ind (find-sound "oboe.snd"))
- (for-each (lambda (func func-name global local)
- (if (or (not (local-eq? (func) global))
- (not (local-eq? (func ind 0) local)))
- (snd-display #__line__ "; save ~A reversed: ~A [~A] ~A [~A]"
- func-name (func) global (func ind 0) local)))
- funcs func-names new-globals new-locals)
+ (when with-gui
+ (for-each (lambda (func func-name global local)
+ (if (or (not (local-eq? (func) global))
+ (not (local-eq? (func ind 0) local)))
+ (snd-display #__line__ "; save ~A reversed: ~A [~A] ~A [~A]"
+ func-name (func) global (func ind 0) local)))
+ funcs func-names new-globals new-locals))
(if (not (= (channel-style ind) channels-separate))
- (snd-display #__line__ ";save channel-style reversed: ~A ~A" (channel-style) (channel-style ind)))
+ (snd-display #__line__ ";save channel-style reversed: ~A ~A" *channel-style* (channel-style ind)))
(for-each (lambda (func val) (set! (func) val)) funcs old-globals)
(close-sound ind)
- (set! (zoom-focus-style) zoom-focus-active)
- (set! (channel-style) channels-separate)
+ (set! *zoom-focus-style* zoom-focus-active)
+ (set! *channel-style* channels-separate)
(delete-file "s61.scm"))
- (let* ((ind0 (open-sound "oboe.snd"))
- (ind1 (open-sound "oboe.snd")))
- (if (not (equal? (find-sound "oboe.snd" 0) ind0))
- (snd-display #__line__ ";find-sound 0: ~A ~A" ind0 (find-sound "oboe.snd" 0)))
- (if (not (equal? (find-sound "oboe.snd" 1) ind1))
- (snd-display #__line__ ";find-sound 1: ~A ~A" ind1 (find-sound "oboe.snd" 1)))
+ (let ((ind0 (open-sound "oboe.snd"))
+ (ind1 (open-sound "oboe.snd")))
+ (if (not (member (find-sound "oboe.snd" 0) (list ind0 ind1)))
+ (snd-display #__line__ ";find-sound 0: ~A ~A" (list ind0 ind1) (find-sound "oboe.snd" 0)))
+ (if (not (member (find-sound "oboe.snd" 1) (list ind0 ind1)))
+ (snd-display #__line__ ";find-sound 1: ~A ~A" (list ind0 ind1) (find-sound "oboe.snd" 1)))
(add-mark 123 ind0)
(add-mark 321 ind1)
(if (file-exists? "s61.scm") (delete-file "s61.scm"))
@@ -40562,7 +33578,7 @@ EDITS: 1
(let ((ctr 1))
(for-each
(lambda (func test)
- (let ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "mono save-state tests" 100)))
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "mono save-state tests" 100)))
(func ind)
(if (file-exists? "s61.scm") (delete-file "s61.scm"))
(save-state "s61.scm")
@@ -40574,7 +33590,7 @@ EDITS: 1
(begin
(test ind)
(close-sound ind)))
- (set! ctr (+ 1 ctr))))
+ (set! ctr (+ ctr 1))))
(list
@@ -40583,35 +33599,35 @@ EDITS: 1
(lambda (ind) (delete-sample 10 ind 0))
(lambda (ind) (set! (sample 10 ind 0) .5))
(lambda (ind) (set! (sample 10 ind 0) .5) (scale-channel .5))
- (lambda (ind) (vct->channel (make-vct 10 .5) 10 5 ind 0) (pad-channel 12 5 ind 0))
+ (lambda (ind) (float-vector->channel (make-float-vector 10 .5) 10 5 ind 0) (pad-channel 12 5 ind 0))
(lambda (ind) (map-channel (lambda (y) 1.0)) (env-channel '(0 0 1 1) 0 11 ind 0))
- (lambda (ind) (ptree-channel (lambda (y) (+ y .1))))
+ (lambda (ind) (map-channel (lambda (y) (+ y .1))))
;; map-channel as backup
(lambda (ind)
- (let ((ctr 0))
- (map-channel (lambda (y) (set! ctr (+ 1 ctr)) (if (even? ctr) .1 #f)))))
+ (let ((p (make-one-pole 1.0 -1.0)))
+ (map-channel (lambda (y) (and (even? (floor (one-pole p 1.0))) .1)))))
;; as-one-edit
(lambda (ind)
;; change
(as-one-edit
(lambda ()
- (vct->channel (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
- (vct->channel (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 20 10 ind 0))))
+ (float-vector->channel (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
+ (float-vector->channel (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 20 10 ind 0))))
(lambda (ind)
;; scale
(as-one-edit
(lambda ()
- (vct->channel (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
+ (float-vector->channel (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
(scale-by .5))))
(lambda (ind)
;; delete
(as-one-edit
(lambda ()
- (vct->channel (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
+ (float-vector->channel (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) 0 10 ind 0)
(delete-samples 5 5))))
(lambda (ind)
@@ -40619,78 +33635,78 @@ EDITS: 1
(as-one-edit
(lambda ()
(delete-samples 5 5)
- (insert-samples 5 2 (vct .1 .2)))))
+ (insert-samples 5 2 (float-vector .1 .2)))))
)
(list
;; basic cases
(lambda (ind)
- (if (fneq (sample 10) .5) (snd-display #__line__ ";insert-sample save-state: ~A" (channel->vct 5 10 ind 0)))
- (if (not (= (frames ind 0) 101)) (snd-display #__line__ ";insert-sample save-state len: ~A" (frames ind 0))))
+ (if (fneq (sample 10) .5) (snd-display #__line__ ";insert-sample save-state: ~A" (channel->float-vector 5 10 ind 0)))
+ (if (not (= (framples ind 0) 101)) (snd-display #__line__ ";insert-sample save-state len: ~A" (framples ind 0))))
(lambda (ind)
- (if (fneq (sample 10) 0.0) (snd-display #__line__ ";delete-sample save-state: ~A" (channel->vct 5 10 ind 0)))
- (if (not (= (frames ind 0) 99)) (snd-display #__line__ ";delete-sample save-state len: ~A" (frames ind 0))))
+ (if (fneq (sample 10) 0.0) (snd-display #__line__ ";delete-sample save-state: ~A" (channel->float-vector 5 10 ind 0)))
+ (if (not (= (framples ind 0) 99)) (snd-display #__line__ ";delete-sample save-state len: ~A" (framples ind 0))))
(lambda (ind)
- (if (fneq (sample 10) .5) (snd-display #__line__ ";set sample save-state: ~A" (channel->vct 5 10 ind 0)))
- (if (not (= (frames ind 0) 100)) (snd-display #__line__ ";set sample save-state len: ~A" (frames ind 0))))
+ (if (fneq (sample 10) .5) (snd-display #__line__ ";set sample save-state: ~A" (channel->float-vector 5 10 ind 0)))
+ (if (not (= (framples ind 0) 100)) (snd-display #__line__ ";set sample save-state len: ~A" (framples ind 0))))
(lambda (ind)
- (if (fneq (sample 10) .25) (snd-display #__line__ ";scl sample save-state: ~A" (channel->vct 5 10 ind 0)))
- (if (not (= (frames ind 0) 100)) (snd-display #__line__ ";scl sample save-state len: ~A" (frames ind 0)))
+ (if (fneq (sample 10) .25) (snd-display #__line__ ";scl sample save-state: ~A" (channel->float-vector 5 10 ind 0)))
+ (if (not (= (framples ind 0) 100)) (snd-display #__line__ ";scl sample save-state len: ~A" (framples ind 0)))
(if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";scl sample save-state edpos: ~A" (edit-position ind 0))))
(lambda (ind)
- (if (not (= (frames ind 0) 105)) (snd-display #__line__ ";pad sample save-state len: ~A" (frames ind 0)))
+ (if (not (= (framples ind 0) 105)) (snd-display #__line__ ";pad sample save-state len: ~A" (framples ind 0)))
(if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";pad sample save-state edpos: ~A" (edit-position ind 0)))
- (if (not (vequal (vct .5 .5 0 0 0 0 0 .5 .5 .5) (channel->vct 10 10 ind 0)))
- (snd-display #__line__ ";pad sample save-state: ~A" (channel->vct 10 10 ind 0))))
+ (if (not (vequal (float-vector .5 .5 0 0 0 0 0 .5 .5 .5) (channel->float-vector 10 10 ind 0)))
+ (snd-display #__line__ ";pad sample save-state: ~A" (channel->float-vector 10 10 ind 0))))
(lambda (ind)
- (if (not (= (frames ind 0) 100)) (snd-display #__line__ ";env sample save-state len: ~A" (frames ind 0)))
+ (if (not (= (framples ind 0) 100)) (snd-display #__line__ ";env sample save-state len: ~A" (framples ind 0)))
(if (not (= (edit-position ind 0) 2)) (snd-display #__line__ ";env sample save-state edpos: ~A" (edit-position ind 0)))
- (if (not (vequal (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 1.0 1.0 1.0 1.0) (channel->vct 0 15 ind 0)))
- (snd-display #__line__ ";env sample save-state: ~A" (channel->vct 0 15 ind 0))))
+ (if (not (vequal (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0 1.0 1.0 1.0 1.0) (channel->float-vector 0 15 ind 0)))
+ (snd-display #__line__ ";env sample save-state: ~A" (channel->float-vector 0 15 ind 0))))
(lambda (ind)
- (if (not (= (frames ind 0) 100)) (snd-display #__line__ ";ptree sample save-state len: ~A" (frames ind 0)))
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";ptree sample save-state edpos: ~A" (edit-position ind 0)))
- (if (fneq (maxamp ind 0) .1) (snd-display #__line__ ";ptree save-state max: ~A" (maxamp ind 0)))
- (if (not (vequal (make-vct 10 .1) (channel->vct 0 10))) (snd-display #__line__ ";ptree save-state vals: ~A" (channel->vct 0 10 ind 0))))
+ (if (not (= (framples ind 0) 100)) (snd-display #__line__ "; sample save-state len: ~A" (framples ind 0)))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ "; sample save-state edpos: ~A" (edit-position ind 0)))
+ (if (fneq (maxamp ind 0) .1) (snd-display #__line__ "; save-state max: ~A" (maxamp ind 0)))
+ (if (not (vequal (make-float-vector 10 .1) (channel->float-vector 0 10))) (snd-display #__line__ "; save-state vals: ~A" (channel->float-vector 0 10 ind 0))))
;; map-channel as backup
(lambda (ind)
- (if (not (= (frames ind 0) 50)) (snd-display #__line__ ";map #f save-state len: ~A" (frames ind 0)))
+ (if (not (= (framples ind 0) 50)) (snd-display #__line__ ";map #f save-state len: ~A" (framples ind 0)))
(if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";map #f save-state edpos: ~A" (edit-position ind 0)))
(if (fneq (maxamp ind 0) .1) (snd-display #__line__ ";map #f save-state max: ~A" (maxamp ind 0)))
- (if (not (vequal (make-vct 10 .1) (channel->vct 0 10))) (snd-display #__line__ ";map #f save-state vals: ~A" (channel->vct 0 10 ind 0))))
+ (if (not (vequal (make-float-vector 10 .1) (channel->float-vector 0 10))) (snd-display #__line__ ";map #f save-state vals: ~A" (channel->float-vector 0 10 ind 0))))
;; as-one-edit
(lambda (ind)
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup 2 vcts edpos: ~A" (edit-position ind 0)))
- (if (not (vequal (channel->vct 0 10 ind 0) (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
- (snd-display #__line__ ";as-one-edit save-state 1: ~A" (channel->vct 0 10 ind 0)))
- (if (not (vequal (channel->vct 20 10 ind 0) (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
- (snd-display #__line__ ";as-one-edit save-state 2: ~A" (channel->vct 0 10 ind 0))))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup 2 float-vectors edpos: ~A" (edit-position ind 0)))
+ (if (not (vequal (channel->float-vector 0 10 ind 0) (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
+ (snd-display #__line__ ";as-one-edit save-state 1: ~A" (channel->float-vector 0 10 ind 0)))
+ (if (not (vequal (channel->float-vector 20 10 ind 0) (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0)))
+ (snd-display #__line__ ";as-one-edit save-state 2: ~A" (channel->float-vector 0 10 ind 0))))
(lambda (ind)
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup vct+scl edpos: ~A" (edit-position ind 0)))
- (if (not (vequal (channel->vct 0 10 ind 0) (vct-scale! (vct .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) .5)))
- (snd-display #__line__ ";as-one-edit save-state 3: ~A" (channel->vct 0 10 ind 0))))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup float-vector+scl edpos: ~A" (edit-position ind 0)))
+ (if (not (vequal (channel->float-vector 0 10 ind 0) (float-vector-scale! (float-vector .1 .2 .3 .4 .5 .6 .7 .8 .9 1.0) .5)))
+ (snd-display #__line__ ";as-one-edit save-state 3: ~A" (channel->float-vector 0 10 ind 0))))
(lambda (ind)
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup vct+del edpos: ~A" (edit-position ind 0)))
- (if (not (vequal (channel->vct 0 10 ind 0) (vct .1 .2 .3 .4 .5 0 0 0 0 0)))
- (snd-display #__line__ ";as-one-edit save-state 4: ~A" (channel->vct 0 10 ind 0))))
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup float-vector+del edpos: ~A" (edit-position ind 0)))
+ (if (not (vequal (channel->float-vector 0 10 ind 0) (float-vector .1 .2 .3 .4 .5 0 0 0 0 0)))
+ (snd-display #__line__ ";as-one-edit save-state 4: ~A" (channel->float-vector 0 10 ind 0))))
(lambda (ind)
(if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";save-state backup del+insert edpos: ~A" (edit-position ind 0)))
- (if (not (vequal (channel->vct 0 10 ind 0) (vct 0 0 0 0 0 .1 .2 0 0 0)))
- (snd-display #__line__ ";as-one-edit save-state 5: ~A" (channel->vct 0 10 ind 0)))
- (if (not (= (frames ind 0) 97)) (snd-display #__line__ ";save-state backup del+insert len: ~A" (frames ind 0))))
+ (if (not (vequal (channel->float-vector 0 10 ind 0) (float-vector 0 0 0 0 0 .1 .2 0 0 0)))
+ (snd-display #__line__ ";as-one-edit save-state 5: ~A" (channel->float-vector 0 10 ind 0)))
+ (if (not (= (framples ind 0) 97)) (snd-display #__line__ ";save-state backup del+insert len: ~A" (framples ind 0))))
)))
-
+
;; ---------------- edit-list->function ----------------
(let ((ind (open-sound "oboe.snd")))
(let ((mx0 (maxamp))
- (frs (frames)))
+ (frs (framples)))
;; ---- simple scale
(scale-channel 2.0)
@@ -40698,8 +33714,8 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 1: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 1: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 1: ~A" (procedure-source func)))
(func ind 0)
(let ((mx (maxamp)))
(if (fneq (* 4 mx0) mx) (snd-display #__line__ ";edit-list->function called (1): ~A ~A" mx mx0))))
@@ -40709,63 +33725,63 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 1a: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 1a: ~A" (object->string (procedure-source func)))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 1a: ~A" (procedure-source func))))
(revert-sound ind)
(normalize-channel 1.0)
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 1c: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (normalize-channel 1.0 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 1c: ~A" (object->string (procedure-source func)))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (normalize-channel 1.0 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 1c: ~A" (procedure-source func))))
(revert-sound ind)
;; ---- simple delete
(delete-samples 10 100)
- (if (not (= (frames) (- frs 100))) (snd-display #__line__ ";edit-list->function delete: ~A ~A" frs (frames)))
+ (if (not (= (framples) (- frs 100))) (snd-display #__line__ ";edit-list->function delete: ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 2: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (delete-samples 10 100 snd chn))"))
- (snd-display #__line__ ";edit-list->function 2: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (delete-samples 10 100 snd chn))))
+ (snd-display #__line__ ";edit-list->function 2: ~A" (procedure-source func)))
(func ind 0)
- (if (not (= (frames) (- frs 200))) (snd-display #__line__ ";edit-list->function called (2): ~A ~A" frs (frames))))
+ (if (not (= (framples) (- frs 200))) (snd-display #__line__ ";edit-list->function called (2): ~A ~A" frs (framples))))
(revert-sound ind)
;; ---- simple delete (a)
(delete-sample 100)
- (if (not (= (frames) (- frs 1))) (snd-display #__line__ ";edit-list->function delete (2a): ~A ~A" frs (frames)))
+ (if (not (= (framples) (- frs 1))) (snd-display #__line__ ";edit-list->function delete (2a): ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 2a: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (delete-samples 100 1 snd chn))"))
- (snd-display #__line__ ";edit-list->function 2a: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (delete-samples 100 1 snd chn))))
+ (snd-display #__line__ ";edit-list->function 2a: ~A" (procedure-source func)))
(func ind 0)
- (if (not (= (frames) (- frs 2))) (snd-display #__line__ ";edit-list->function called (2a): ~A ~A" frs (frames))))
+ (if (not (= (framples) (- frs 2))) (snd-display #__line__ ";edit-list->function called (2a): ~A ~A" frs (framples))))
(revert-sound ind)
;; ---- simple zero pad
(pad-channel 10 100)
- (if (not (= (frames) (+ frs 100))) (snd-display #__line__ ";edit-list->function pad: ~A ~A" frs (frames)))
+ (if (not (= (framples) (+ frs 100))) (snd-display #__line__ ";edit-list->function pad: ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 3: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (pad-channel 10 100 snd chn))"))
- (snd-display #__line__ ";edit-list->function 3: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (pad-channel 10 100 snd chn))))
+ (snd-display #__line__ ";edit-list->function 3: ~A" (procedure-source func)))
(func ind 0)
- (if (not (= (frames) (+ frs 200))) (snd-display #__line__ ";edit-list->function called (3): ~A ~A" frs (frames))))
+ (if (not (= (framples) (+ frs 200))) (snd-display #__line__ ";edit-list->function called (3): ~A ~A" frs (framples))))
(revert-sound ind)
;; ---- simple zero pad (a)
(insert-silence 10 100)
- (if (not (= (frames) (+ frs 100))) (snd-display #__line__ ";edit-list->function pad (3a): ~A ~A" frs (frames)))
+ (if (not (= (framples) (+ frs 100))) (snd-display #__line__ ";edit-list->function pad (3a): ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 3a: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (pad-channel 10 100 snd chn))"))
- (snd-display #__line__ ";edit-list->function 3a: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (pad-channel 10 100 snd chn))))
+ (snd-display #__line__ ";edit-list->function 3a: ~A" (procedure-source func)))
(func ind 0)
- (if (not (= (frames) (+ frs 200))) (snd-display #__line__ ";edit-list->function called (3a): ~A ~A" frs (frames))))
+ (if (not (= (framples) (+ frs 200))) (snd-display #__line__ ";edit-list->function called (3a): ~A ~A" frs (framples))))
(revert-sound ind)
;; --- simple ramp
@@ -40774,8 +33790,8 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 4: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (ramp-channel 0.2 0.9 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 4: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (ramp-channel 0.2 0.9 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 4: ~A" (procedure-source func)))
(func ind 0)
(let ((mx (maxamp)))
(if (fneq mx 0.061) (snd-display #__line__ ";edit-list->function called (4): ~A" mx))))
@@ -40787,22 +33803,23 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 5: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (xramp-channel 0.2 0.9 32.0 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 5: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (xramp-channel 0.2 0.9 32.0 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 5: ~A" (procedure-source func)))
(func ind 0)
(let ((mx (maxamp)))
(if (fneq mx 0.0266) (snd-display #__line__ ";edit-list->function called (5): ~A" mx))))
(revert-sound ind)
+
;; ---- simple env
(env-sound '(0 0 1 1))
(if (fneq (maxamp) 0.0906) (snd-display #__line__ ";edit-list env: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 6: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel '(0.0 0.0 1.0 1.0) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 6: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel '(0.0 0.0 1.0 1.0) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 6: ~A" (procedure-source func)))
(func ind 0)
(let ((mx (maxamp)))
(if (fneq mx 0.0634) (snd-display #__line__ ";edit-list->function called (6): ~A" mx))))
@@ -40814,9 +33831,9 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 7: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 7: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 7: ~A" (procedure-source func)))
(func ind 0)
(let ((mx (maxamp)))
(if (fneq mx 0.0857) (snd-display #__line__ ";edit-list->function called (7): ~A" mx))))
@@ -40826,20 +33843,18 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 7a: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 7a: ~A" (object->string (procedure-source func)))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 7a: ~A" (procedure-source func))))
(revert-sound ind)
(env-channel '(0 0 1 .3 2 .8 3 0) 1000 2000)
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 7b: ~A" func))
- (if (and (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :base 1.0 :end 1999) 1000 2000 snd chn))"))
- (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :base 1.0 :end 1999) 1000 2000 snd chn))")))
- (snd-display #__line__ ";edit-list->function 7b: ~A" (object->string (procedure-source func)))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :base 1.0 :end 1999) 1000 2000 snd chn))))
+ (snd-display #__line__ ";edit-list->function 7b: ~A" (procedure-source func))))
(revert-sound ind)
(env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :base 32.0 :length 2000) 1000 2000)
@@ -40847,11 +33862,9 @@ EDITS: 1
(mxenv0 (maxamp)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 7c: ~A" func))
- (if (and (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :base 32.0 :end 1999) 1000 2000 snd chn))"))
- (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :base 32.0 :end 1999) 1000 2000 snd chn))")))
- (snd-display #__line__ ";edit-list->function 7c: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :base 32.0 :end 1999) 1000 2000 snd chn))))
+ (snd-display #__line__ ";edit-list->function 7c: ~A" (procedure-source func)))
(revert-sound ind)
(env-channel (make-env '(0.0 0.0 1.0 0.3 2.0 0.8 3.0 0.0) :length 2000 :offset 2.0 :scaler 3.0) 1000 2000)
@@ -40859,162 +33872,143 @@ EDITS: 1
(mxenv1 (maxamp)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 7d: ~A" func))
- (if (and (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel (make-env '(0.0 2.0 1.0 2.9 2.0 4.4 3.0 2.0) :base 1.0 :end 1999) 1000 2000 snd chn))"))
- (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel (make-env '(0.0 2.0 1.0 2.9 2.0 4.4 3.0 2.0) :base 1.0 :end 1999) 1000 2000 snd chn))")))
- (snd-display #__line__ ";edit-list->function 7d: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel (make-env '(0.0 2.0 1.0 2.9 2.0 4.4 3.0 2.0) :base 1.0 :end 1999) 1000 2000 snd chn))))
+ (snd-display #__line__ ";edit-list->function 7d: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(let ((nmx (maxamp)))
(if (fneq nmx mxenv1) (snd-display #__line__ ";edit-list->function 7d max: ~A ~A ~A" nmx mxenv1 mxenv0)))))
(revert-sound ind)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 5)) ; get to unrampable case
(env-channel '(0 0 1 1 2 0)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 7e: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 7e: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn) (env-channel '(0.0 0.0 1.0 1.0 2.0 0.0) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 7e: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(if (fneq (maxamp) 0.1459) (snd-display #__line__ ";edit-list->function 7e max: ~A" (maxamp)))
(if (not (= (edit-position) 5)) (snd-display #__line__ ";edit-list->function 7e edpos: ~A" (edit-position))))
(revert-sound ind)
- (env-sound '(0 0 1 1 2 0) 0 (frames) 32.0)
+ (env-sound '(0 0 1 1 2 0) 0 (framples) 32.0)
(if (fneq (maxamp) 0.146) (snd-display #__line__ ";edit-list env 7f: ~A" (maxamp)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 7f: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel-with-base '(0.0 0.0 1.0 1.0 2.0 0.0) 32.0 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 7f: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel-with-base '(0.0 0.0 1.0 1.0 2.0 0.0) 32.0 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 7f: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(let ((mx (maxamp)))
(if (fneq mx 0.146) (snd-display #__line__ ";edit-list->function called (7f): ~A" mx))))
(revert-sound ind)
- (env-sound '(0 0 1 1 2 1 3 0) 0 (frames) 0.0)
+ (env-sound '(0 0 1 1 2 1 3 0) 0 (framples) 0.0)
(if (fneq (sample 4000) 0.0) (snd-display #__line__ ";edit-list env 7g: ~A" (sample 4000)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 7g: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel-with-base '(0.0 0.0 1.0 1.0 2.0 1.0 3.0 0.0) 0.0 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 7g: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel-with-base '(0.0 0.0 1.0 1.0 2.0 1.0 3.0 0.0) 0.0 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 7g: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(if (fneq (sample 4000) 0.0) (snd-display #__line__ ";edit-list function 7g: ~A" (sample 4000))))
(revert-sound ind)
- ;; ---- simple ptree
-
- (let ((old-opt (optimization)))
- (set! (optimization) 6)
- (ptree-channel (lambda (y) (+ y .1)))
- (if (fneq (maxamp) 0.247) (snd-display #__line__ ";edit-list ptree: ~A" (maxamp)))
- (let ((func (edit-list->function)))
- (if (not (procedure? func))
- (snd-display #__line__ ";edit-list->function 8: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (ptree-channel (lambda (y) (+ y 0.1)) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 8: ~A" (object->string (procedure-source func))))
- (func ind 0)
- (let ((mx (maxamp)))
- (if (fneq mx 0.347) (snd-display #__line__ ";edit-list->function called (8): ~A" mx))))
- (revert-sound ind)
- (set! (optimization) old-opt))
-
;; ---- simple 1 sample insert
(insert-sample 100 .1)
- (if (not (= (frames) (+ frs 1))) (snd-display #__line__ ";edit-list->function insert-sample: ~A ~A" frs (frames)))
+ (if (not (= (framples) (+ frs 1))) (snd-display #__line__ ";edit-list->function insert-sample: ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 9: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (insert-sample 100 0.1 snd chn))"))
- (snd-display #__line__ ";edit-list->function 9: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (insert-sample 100 0.1 snd chn))))
+ (snd-display #__line__ ";edit-list->function 9: ~A" (procedure-source func)))
(func ind 0)
- (if (not (vequal (channel->vct 99 4) (vct 0.0 0.1 0.1 0.0)))
- (snd-display #__line__ ";edit-list->function func 9: ~A" (channel->vct 99 4)))
- (if (not (= (frames) (+ frs 2))) (snd-display #__line__ ";edit-list->function called (9): ~A ~A" frs (frames))))
+ (if (not (vequal (channel->float-vector 99 4) (float-vector 0.0 0.1 0.1 0.0)))
+ (snd-display #__line__ ";edit-list->function func 9: ~A" (channel->float-vector 99 4)))
+ (if (not (= (framples) (+ frs 2))) (snd-display #__line__ ";edit-list->function called (9): ~A ~A" frs (framples))))
(revert-sound ind)
;; ---- insert-samples with data
- (insert-samples 0 100 (make-vct 100 .1))
- (if (not (= (frames) (+ frs 100))) (snd-display #__line__ ";edit-list->function insert-samples (100): ~A ~A" frs (frames)))
+ (insert-samples 0 100 (make-float-vector 100 .1))
+ (if (not (= (framples) (+ frs 100))) (snd-display #__line__ ";edit-list->function insert-samples (100): ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 9a: ~A" func))
(func ind 0)
- (if (not (= (frames) (+ frs 200))) (snd-display #__line__ ";edit-list->function insert-samples (200): ~A ~A" frs (frames)))
- (if (not (vequal (channel->vct 0 5) (vct 0.1 0.1 0.1 0.1 0.1)))
- (snd-display #__line__ ";edit-list->function func 9a: ~A" (channel->vct 0 5))))
+ (if (not (= (framples) (+ frs 200))) (snd-display #__line__ ";edit-list->function insert-samples (200): ~A ~A" frs (framples)))
+ (if (not (vequal (channel->float-vector 0 5) (float-vector 0.1 0.1 0.1 0.1 0.1)))
+ (snd-display #__line__ ";edit-list->function func 9a: ~A" (channel->float-vector 0 5))))
(revert-sound ind)
;; ---- set-samples with data
- (set! (samples 0 100) (make-vct 100 .1))
- (if (not (= (frames) frs)) (snd-display #__line__ ";edit-list->function set-samples (1): ~A ~A" frs (frames)))
+ (set! (samples 0 100) (make-float-vector 100 .1))
+ (if (not (= (framples) frs)) (snd-display #__line__ ";edit-list->function set-samples (1): ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 9b: ~A" func))
(func ind 0)
- (if (not (= (frames) frs)) (snd-display #__line__ ";edit-list->function set-samples (2): ~A ~A" frs (frames)))
- (if (not (vequal (channel->vct 0 5) (vct 0.1 0.1 0.1 0.1 0.1)))
- (snd-display #__line__ ";edit-list->function func 9b: ~A" (channel->vct 0 5))))
+ (if (not (= (framples) frs)) (snd-display #__line__ ";edit-list->function set-samples (2): ~A ~A" frs (framples)))
+ (if (not (vequal (channel->float-vector 0 5) (float-vector 0.1 0.1 0.1 0.1 0.1)))
+ (snd-display #__line__ ";edit-list->function func 9b: ~A" (channel->float-vector 0 5))))
(revert-sound ind)
;; ---- simple 1 sample set
(let ((val (sample 100)))
(set! (sample 100) .1)
- (if (not (= (frames) frs)) (snd-display #__line__ ";edit-list->function set-sample frames: ~A ~A" frs (frames)))
+ (if (not (= (framples) frs)) (snd-display #__line__ ";edit-list->function set-sample framples: ~A ~A" frs (framples)))
(if (fneq (sample 100) .1) (snd-display #__line__ ";edit-list->function set-sample val: ~A ~A" val (sample 100)))
(let ((func (edit-list->function)))
(revert-sound)
(if (fneq val (sample 100)) (snd-display #__line__ ";edit-list->function unset-sample val: ~A ~A" val (sample 100)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 10: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (set-sample 100 0.1 snd chn))"))
- (snd-display #__line__ ";edit-list->function 10: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (set-sample 100 0.1 snd chn))))
+ (snd-display #__line__ ";edit-list->function 10: ~A" (procedure-source func)))
(func ind 0)
- (if (not (vequal (channel->vct 99 4) (vct 0.0 0.1 0.0 0.0)))
- (snd-display #__line__ ";edit-list->function func 10: ~A" (channel->vct 99 4)))))
+ (if (not (vequal (channel->float-vector 99 4) (float-vector 0.0 0.1 0.0 0.0)))
+ (snd-display #__line__ ";edit-list->function func 10: ~A" (channel->float-vector 99 4)))))
(revert-sound ind)
- (let ((pfrs (mus-sound-frames "pistol.snd")))
+
+ (let ((pfrs (mus-sound-framples "pistol.snd")))
(insert-sound "pistol.snd" 1000)
- (if (not (= (frames) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function insert-sound: ~A ~A" frs (frames)))
+ (if (not (= (framples) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function insert-sound: ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 10a: ~A" func))
- (if (and (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (insert-sound \"/home/bil/cl/pistol.snd\" 1000 0 snd chn))"))
- (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (insert-sound \"/home/bil/snd-12/pistol.snd\" 1000 0 snd chn))")))
- (snd-display #__line__ ";edit-list->function 10a: ~A" (object->string (procedure-source func))))
+ (if (and (not (equal? (procedure-source func)
+ '(lambda (snd chn) (insert-sound "/home/bil/cl/pistol.snd" 1000 0 snd chn))))
+ (not (equal? (procedure-source func)
+ '(lambda (snd chn) (insert-sound "/home/bil/snd-16/pistol.snd" 1000 0 snd chn)))))
+ (snd-display #__line__ ";edit-list->function 10a: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
- (if (not (= (frames) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function called (10): ~A ~A" frs (frames)))))
+ (if (not (= (framples) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function called (10): ~A ~A" frs (framples)))))
(revert-sound ind)
- (let ((pfrs (mus-sound-frames "pistol.snd")))
+ (let ((pfrs (mus-sound-framples "pistol.snd")))
(insert-samples 1000 pfrs "pistol.snd")
- (if (not (= (frames) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function insert-samples: ~A ~A" frs (frames)))
+ (if (not (= (framples) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function insert-samples: ~A ~A" frs (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 11: ~A" func))
- (if (and (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (insert-samples 1000 41623 \"/home/bil/cl/pistol.snd\" snd chn))"))
- (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (insert-samples 1000 41623 \"/home/bil/snd-12/pistol.snd\" snd chn))")))
- (snd-display #__line__ ";edit-list->function 11: ~A" (object->string (procedure-source func))))
+ (if (and (not (equal? (procedure-source func)
+ '(lambda (snd chn) (insert-samples 1000 41623 "/home/bil/cl/pistol.snd" snd chn))))
+ (not (equal? (procedure-source func)
+ '(lambda (snd chn) (insert-samples 1000 41623 "/home/bil/snd-16/pistol.snd" snd chn)))))
+ (snd-display #__line__ ";edit-list->function 11: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
- (if (not (= (frames) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function called (11): ~A ~A" frs (frames)))))
+ (if (not (= (framples) (+ frs pfrs))) (snd-display #__line__ ";edit-list->function called (11): ~A ~A" frs (framples)))))
(revert-sound ind)
(smooth-channel 1000 100)
@@ -41022,8 +34016,8 @@ EDITS: 1
(val (sample 1050)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 12: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (smooth-channel 1000 100 snd chn))"))
- (snd-display #__line__ ";edit-list->function 12: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (smooth-channel 1000 100 snd chn))))
+ (snd-display #__line__ ";edit-list->function 12: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(if (fneq (sample 1050) val) (snd-display #__line__ ";edit-list->function 12: ~A ~A" (sample 1050) val)))
@@ -41033,19 +34027,18 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 12a: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (smooth-channel 1000 100 snd chn))"))
- (snd-display #__line__ ";edit-list->function 12a: ~A" (object->string (procedure-source func)))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (smooth-channel 1000 100 snd chn))))
+ (snd-display #__line__ ";edit-list->function 12a: ~A" (procedure-source func))))
(revert-sound ind)
-
;; ---- selection stuff
(make-selection 1000 11000)
(scale-selection-by 2.0)
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 13: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (scale-channel 2.0 1000 10001 snd chn))"))
- (snd-display #__line__ ";edit-list->function 13: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (scale-channel 2.0 1000 10001 snd chn))))
+ (snd-display #__line__ ";edit-list->function 13: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(let ((mx (maxamp)))
@@ -41056,9 +34049,9 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 13a: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (normalize-channel 1.0 1000 10001 snd chn))"))
- (snd-display #__line__ ";edit-list->function 13a: ~A" (object->string (procedure-source func)))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (normalize-channel 1.0 1000 10001 snd chn))))
+ (snd-display #__line__ ";edit-list->function 13a: ~A" (procedure-source func))))
(revert-sound ind)
(env-selection '(0 0 1 1 2 0))
@@ -41066,11 +34059,9 @@ EDITS: 1
(if (fneq (sample 4000) 0.0173) (snd-display #__line__ ";edit-list->function 14 samp: ~A" (sample 4000)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 14: ~A" func))
- (if (and (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 1.0 2.0 0.0) :base 1.0 :end 10000) 1000 10001 snd chn))"))
- (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 1.0 2.0 0.0) :base 1.0 :end 10000) 1000 10001 snd chn))")))
- (snd-display #__line__ ";edit-list->function 14: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (env-channel (make-env '(0.0 0.0 1.0 1.0 2.0 0.0) :base 1.0 :end 10000) 1000 10001 snd chn))))
+ (snd-display #__line__ ";edit-list->function 14: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(if (fneq (sample 4000) 0.0173) (snd-display #__line__ ";edit-list->function 14 re-samp: ~A" (sample 4000))))
@@ -41082,8 +34073,8 @@ EDITS: 1
(val (sample 1050)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 14a: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (smooth-channel 1000 101 snd chn))"))
- (snd-display #__line__ ";edit-list->function 14a: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (smooth-channel 1000 101 snd chn))))
+ (snd-display #__line__ ";edit-list->function 14a: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(if (fneq (sample 1050) val) (snd-display #__line__ ";edit-list->function 14a: ~A ~A" (sample 1050) val)))
@@ -41093,8 +34084,8 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 14b: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (reverse-channel 1000 101 snd chn))"))
- (snd-display #__line__ ";edit-list->function 14b: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (reverse-channel 1000 101 snd chn))))
+ (snd-display #__line__ ";edit-list->function 14b: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0))
(revert-sound ind)
@@ -41103,22 +34094,21 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 14c: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (delete-samples 1000 101 snd chn))"))
- (snd-display #__line__ ";edit-list->function 14c: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (delete-samples 1000 101 snd chn))))
+ (snd-display #__line__ ";edit-list->function 14c: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0))
(revert-sound ind)
-
-
+
;; ---- simple reapply
(env-channel '(0 0 1 1 2 0))
(let ((func (edit-list->function)))
(close-sound ind)
- (set! ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1 :size 20 :comment #f))
+ (set! ind (new-sound "tmp.snd" 1 22050 mus-ldouble mus-next :size 20 :comment #f))
(map-channel (lambda (y) 1.0))
(func ind 0)
- (let ((data (channel->vct)))
- (if (not (vequal data (vct 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.0)))
+ (let ((data (channel->float-vector)))
+ (if (not (vequal data (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 0.889 0.778 0.667 0.556 0.444 0.333 0.222 0.111 0.0)))
(snd-display #__line__ ";edit-list->function env reapply: ~A" data)))
(close-sound ind)
(set! ind (open-sound "oboe.snd")))
@@ -41130,9 +34120,6 @@ EDITS: 1
(val (sample 2050)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 16: ~A" func))
- ; (if (not (string=? (object->string (procedure-source func))
- ; (string-append "(lambda (snd chn) (insert-region (integer->region " (number->string (region->integer reg)) " 2000 snd chn))")))
- ; (snd-display #__line__ ";edit-list->function 16: ~A" (object->string (procedure-source func))))
(revert-sound ind)
(func ind 0)
(if (fneq (sample 2050) val) (snd-display #__line__ ";edit-list->function 16: ~A ~A" (sample 2050) val))))
@@ -41144,8 +34131,8 @@ EDITS: 1
(val (sample 2000)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 17: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (reverse-channel 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 17: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (reverse-channel 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 17: ~A" (procedure-source func)))
(if (fneq val -.002) (snd-display #__line__ ";edit-list->function val: ~A" val))
(revert-sound ind)
(func ind 0)
@@ -41157,8 +34144,8 @@ EDITS: 1
(val (sample 2000)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 17a: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (reverse-channel 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 17a: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (reverse-channel 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 17a: ~A" (procedure-source func)))
(if (fneq val -.002) (snd-display #__line__ ";edit-list->function 17a val: ~A" val)))
(revert-sound ind)
@@ -41166,77 +34153,77 @@ EDITS: 1
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 17b: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (reverse-channel 1000 500 snd chn))"))
- (snd-display #__line__ ";edit-list->function 17b: ~A" (object->string (procedure-source func)))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (reverse-channel 1000 500 snd chn))))
+ (snd-display #__line__ ";edit-list->function 17b: ~A" (procedure-source func))))
(revert-sound ind)
;; ---- src
(src-sound 2.0)
- (if (> (abs (- (frames) 25415)) 2) (snd-display #__line__ ";edit-list->function 18 len: ~A" (frames)))
+ (if (> (abs (- (framples) 25415)) 2) (snd-display #__line__ ";edit-list->function 18 len: ~A" (framples)))
(let ((func (edit-list->function)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 18: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (src-channel 2.0 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 18: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (src-channel 2.0 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 18: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
- (if (> (abs (- (frames) 25415)) 2) (snd-display #__line__ ";edit-list->function 18 re-len: ~A" (frames))))
+ (if (> (abs (- (framples) 25415)) 2) (snd-display #__line__ ";edit-list->function 18 re-len: ~A" (framples))))
(revert-sound ind)
-
+
(src-channel 2.0 1000 500)
(let ((func (edit-list->function))
- (frs (frames)))
+ (frs (framples)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 18a: ~A" func))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (src-channel 2.0 1000 500 snd chn))"))
- (snd-display #__line__ ";edit-list->function 18a: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (src-channel 2.0 1000 500 snd chn))))
+ (snd-display #__line__ ";edit-list->function 18a: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
- (if (not (= frs (frames))) (snd-display #__line__ ";edit-list->function 18a re-len: ~A ~A" frs (frames))))
+ (if (not (= frs (framples))) (snd-display #__line__ ";edit-list->function 18a re-len: ~A ~A" frs (framples))))
(revert-sound)
(src-sound '(0 1 1 2 2 1))
(let ((func (edit-list->function))
- (frs (frames)))
+ (frs (framples)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 18b: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (src-channel '(0.0 1.0 1.0 2.0 2.0 1.0) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 18b: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (src-channel '(0.0 1.0 1.0 2.0 2.0 1.0) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 18b: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
- (if (not (= frs (frames))) (snd-display #__line__ ";edit-list->function 18b re-len: ~A ~A" frs (frames))))
+ (if (not (= frs (framples))) (snd-display #__line__ ";edit-list->function 18b re-len: ~A ~A" frs (framples))))
(revert-sound)
(src-channel '(0 1 1 2) 1000 500)
(let ((func (edit-list->function))
- (frs (frames)))
+ (frs (framples)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 18c: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (src-channel '(0.0 1.0 1.0 2.0) 1000 500 snd chn))"))
- (snd-display #__line__ ";edit-list->function 18c: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (src-channel '(0.0 1.0 1.0 2.0) 1000 500 snd chn))))
+ (snd-display #__line__ ";edit-list->function 18c: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
- (if (not (= frs (frames))) (snd-display #__line__ ";edit-list->function 18c re-len: ~A ~A" frs (frames))))
+ (if (not (= frs (framples))) (snd-display #__line__ ";edit-list->function 18c re-len: ~A ~A" frs (framples))))
(revert-sound)
-
+
;; ---- filter-channel
(filter-channel '(0 1 1 0) 10)
(let ((func (edit-list->function))
(mx (maxamp)))
(if (not (procedure? func))
(snd-display #__line__ ";edit-list->function 19: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (filter-channel '(0.0 1.0 1.0 0.0) 10 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function 19: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (filter-channel '(0.0 1.0 1.0 0.0) 10 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function 19: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(if (fneq mx (maxamp)) (snd-display #__line__ ";edit-list->function 19 re-filter: ~A ~A" mx (maxamp))))
(revert-sound)
(let ((op (make-one-zero .5 .5))) (filter-fft op))
- (vct->channel (fft-smoother .1 (cursor) 400) (cursor) 400)
+ (float-vector->channel (fft-smoother .1 (cursor) 400) (cursor) 400)
(revert-sound)
(let ((ind (new-sound :size 32)))
@@ -41247,23 +34234,24 @@ EDITS: 1
(set! ang (+ ang (/ (* 2 pi) 16.0)))
val))))
(let ((vals (fft-env-data '(0 0 .3 0 .4 1 1 1))))
- (vct->channel vals)
- (if (not (vequal vals (vct -0.000 0.500 0.000 -0.500 0.000 0.500 0.000 -0.500 0.000 0.500 -0.000
+ (float-vector->channel vals)
+ (if (not (vequal vals (float-vector -0.000 0.500 0.000 -0.500 0.000 0.500 0.000 -0.500 0.000 0.500 -0.000
-0.500 -0.000 0.500 -0.000 -0.500 -0.000 0.500 0.000 -0.500 0.000 0.500
0.000 -0.500 0.000 0.500 -0.000 -0.500 -0.000 0.500 -0.000 -0.500)))
(snd-display #__line__ ";fft-env-data: ~A" vals)))
(hilbert-transform-via-fft)
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct -0.500 -0.000 0.500 -0.000 -0.500 0.000 0.500 0.000 -0.500 0.000 0.500
+ (let ((vals (channel->float-vector)))
+ (let ((nvals (float-vector -0.500 -0.000 0.500 -0.000 -0.500 0.000 0.500 0.000 -0.500 0.000 0.500
0.000 -0.500 -0.000 0.500 -0.000 -0.500 -0.000 0.500 -0.000 -0.500 0.000
0.500 0.000 -0.500 0.000 0.500 0.000 -0.500 -0.000 0.500 -0.000)))
- (snd-display #__line__ ";hilbert via dft: ~A" vals)))
+ (if (not (vequal vals nvals))
+ (snd-display #__line__ ";hilbert via dft: ~A" vals))))
(revert-sound ind)
(map-channel (lambda (y) 1.0))
-
+
(powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0.000 0.107 0.206 0.298 0.384 0.463 0.536 0.605 0.668 0.727 0.781 0.832 0.879
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0.000 0.107 0.206 0.298 0.384 0.463 0.536 0.605 0.668 0.727 0.781 0.832 0.879
0.922 0.963 1.000 1.000 0.787 0.618 0.484 0.377 0.293 0.226 0.173 0.130 0.097
0.070 0.049 0.032 0.019 0.008 0.000)))
(snd-display #__line__ ";powenv-channel: ~A" vals)))
@@ -41277,56 +34265,60 @@ EDITS: 1
(snd-display #__line__ ";make-selection failed??")
(begin
(replace-with-selection)
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.000 0.032 0.065
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.000 0.032 0.065
0.097 0.129 0.161 0.194 0.226 0.581 0.613 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
(snd-display #__line__ ";replace-with-selection: ~A" vals)))))
(set! (cursor ind 0) 2)
(replace-with-selection)
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0.000 0.032 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.000 0.032 0.065
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0.000 0.032 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.000 0.032 0.065
0.097 0.129 0.161 0.194 0.226 0.581 0.613 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
(snd-display #__line__ ";replace-with-selection (at 2): ~A" vals)))
(revert-sound ind)
(map-channel (lambda (y) 1.0))
(env-sound '(0 0 1 1))
+
(let ((m1 (add-mark 10))
(m2 (add-mark 20)))
(make-selection 0 9)
(fit-selection-between-marks m1 m2)
- (let ((vals (channel->vct)))
- (if (not (vequal vals (vct 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.323 0.387 0.452
+ (let ((vals (channel->float-vector)))
+ (if (not (vequal vals (float-vector 0.000 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290 0.323 0.387 0.452
0.516 0.581 0.645 0.710 0.774 0.839 0.903 0.645 0.677 0.710 0.742 0.774 0.806
0.839 0.871 0.903 0.935 0.968 1.000)))
(snd-display #__line__ ";fit-selection-between-marks: ~A" vals))))
+
(revert-sound ind)
(map-channel (lambda (y) 1.0))
+
(let ((ramper (make-ramp 10)))
(map-channel (lambda (y) (ramp ramper y)))
- (let ((vals (channel->vct 0 20)))
- (if (not (vequal vals (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000
+ (let ((vals (channel->float-vector 0 20)))
+ (if (not (vequal vals (float-vector 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000 1.0
1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
(snd-display #__line__ ";make-ramp: ~A" vals))))
(revert-sound ind)
- (vct->channel (with-sound (:output (make-vct 44100)) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2)))
+ (float-vector->channel (with-sound ((make-float-vector 44100)) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2)))
(if (and (ffneq (maxamp) .142) (ffneq (maxamp) .155)) (snd-display #__line__ ";cross fade maxamp: ~A" (maxamp)))
(revert-sound)
- (vct->channel (with-sound (:output (make-vct 44100)) (dissolve-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 512 2 2 #f)))
+ (float-vector->channel (with-sound ((make-float-vector 44100)) (dissolve-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 512 2 2 #f)))
+
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
-
- (let ((vals (apply vct (rms-envelope "oboe.snd" :rfreq 4))))
- (if (not (vequal vals (vct 0.0 0.0430 0.25 0.0642 0.5 0.0695 0.75 0.0722 1.0 0.0738 1.25 0.0713
- 1.5 0.065 1.75 0.0439 2.0 0.01275 2.25 0.0)))
+
+ (let ((vals (apply float-vector (rms-envelope "oboe.snd" :rfreq 4))))
+ (if (not (vequal vals (float-vector 0.0 0.0430 0.25 0.0642 0.5 0.0695 0.75 0.0722 1.0 0.0738 1.25 0.0713
+ 1.5 0.065 1.75 0.0439 2.0 0.01275 2.25 0.007)))
(snd-display #__line__ ";rms-envelope: ~A" vals)))
-
+
(let ((ind (open-sound "2a.snd")))
(hook-push graph-hook display-correlation)
(update-time-graph)
- (set! (hook-functions graph-hook) '())
+ (set! (hook-functions graph-hook) ())
(stereo->mono ind "hi1.snd" "hi2.snd")
(let ((hi1 (find-sound "hi1.snd"))
(hi2 (find-sound "hi2.snd")))
@@ -41348,17 +34340,18 @@ EDITS: 1
(close-sound hi1)
(close-sound hi2))
(close-sound ind))
+
(if (file-exists? "hi1.snd") (delete-file "hi1.snd"))
(if (file-exists? "hi2.snd") (delete-file "hi2.snd"))
(if (file-exists? "ho2.snd") (delete-file "ho2.snd"))
-
+
(let ((ind (new-sound :size 1000)))
(map-channel (lambda (y) 0.5))
(map-channel (vibro 1000.0 .5))
- (let ((vals (channel->vct 0 20)))
- (if (and (not (vequal vals (vct 0.375 0.410 0.442 0.469 0.489 0.499 0.499 0.489 0.470 0.443 0.411 0.376
+ (let ((vals (channel->float-vector 0 20)))
+ (if (and (not (vequal vals (float-vector 0.375 0.410 0.442 0.469 0.489 0.499 0.499 0.489 0.470 0.443 0.411 0.376
0.341 0.308 0.281 0.262 0.251 0.251 0.261 0.280)))
- (not (vequal vals (vct 0.375 0.393 0.410 0.427 0.442 0.457 0.469 0.480 0.489 0.495 0.499 0.500
+ (not (vequal vals (float-vector 0.375 0.393 0.410 0.427 0.442 0.457 0.469 0.480 0.489 0.495 0.499 0.500
0.499 0.495 0.489 0.480 0.470 0.457 0.443 0.428))))
(snd-display #__line__ ";no vibro? ~A" vals)))
(let ((new-file-name (file-name ind)))
@@ -41368,7 +34361,7 @@ EDITS: 1
(let ((ind (open-sound "pistol.snd")))
(transposed-echo 1.1 .95 .25)
(play :wait #t)
- (set! (channel-property 'colored-samples ind 0) (list (list (cursor-color) 0 100)))
+ (set! (channel-property 'colored-samples ind 0) (list (list *cursor-color* 0 100)))
(hook-push after-graph-hook display-samples-in-color)
(update-time-graph)
(repitch-sound 220.0 440.0)
@@ -41394,7 +34387,7 @@ EDITS: 1
(snd-display #__line__ ";scramble-channels: ~A ~A ~A ~A (~A ~A ~A ~A)"
(sample 0 ind 2) (sample 10 ind 3) (sample 20 ind 1) (sample 30 ind 2)
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 2) (sample 30 ind 3)))
- (do ((i 0 (+ 1 i))) ((= i 4)) (set! (edit-position ind i) 1))
+ (do ((i 0 (+ i 1))) ((= i 4)) (set! (edit-position ind i) 1))
(scramble-channels 3 0 1 2)
(if (or (fneq (sample 0 ind 1) .5)
(fneq (sample 10 ind 2) .25)
@@ -41403,7 +34396,7 @@ EDITS: 1
(snd-display #__line__ ";scramble-channels (1): ~A ~A ~A ~A (~A ~A ~A ~A)"
(sample 0 ind 1) (sample 10 ind 2) (sample 20 ind 3) (sample 30 ind 0)
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 2) (sample 30 ind 3)))
- (do ((i 0 (+ 1 i))) ((= i 4)) (set! (edit-position ind i) 1))
+ (do ((i 0 (+ i 1))) ((= i 4)) (set! (edit-position ind i) 1))
(scramble-channels 0 1 3 2)
(if (or (fneq (sample 0 ind 0) .5)
(fneq (sample 10 ind 1) .25)
@@ -41412,7 +34405,7 @@ EDITS: 1
(snd-display #__line__ ";scramble-channels (2): ~A ~A ~A ~A (~A ~A ~A ~A)"
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 3) (sample 30 ind 2)
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 2) (sample 30 ind 3)))
- (do ((i 0 (+ 1 i))) ((= i 4)) (set! (edit-position ind i) 1))
+ (do ((i 0 (+ i 1))) ((= i 4)) (set! (edit-position ind i) 1))
(scramble-channels 1 2 3 0)
(if (or (fneq (sample 0 ind 3) .5)
(fneq (sample 10 ind 0) .25)
@@ -41421,13 +34414,13 @@ EDITS: 1
(snd-display #__line__ ";scramble-channels (3): ~A ~A ~A ~A (~A ~A ~A ~A)"
(sample 0 ind 3) (sample 10 ind 0) (sample 20 ind 1) (sample 30 ind 2)
(sample 0 ind 0) (sample 10 ind 1) (sample 20 ind 2) (sample 30 ind 3)))
- (do ((i 0 (+ 1 i))) ((= i 4)) (set! (edit-position ind i) 1))
+ (do ((i 0 (+ i 1))) ((= i 4)) (set! (edit-position ind i) 1))
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
(let ((ind (new-sound :channels 8 :size 10 :comment "new-sound for scramble-channels")))
- (do ((i 0 (+ 1 i))) ((= i 8)) (set! (sample i ind i) .5))
+ (do ((i 0 (+ i 1))) ((= i 8)) (set! (sample i ind i) .5))
(scramble-channels 1 2 3 4 7 6 5 0)
(if (or (fneq (sample 1 ind 0) .5)
(fneq (sample 2 ind 1) .5)
@@ -41443,192 +34436,177 @@ EDITS: 1
(let ((new-file-name (file-name ind)))
(close-sound ind)
(if (file-exists? new-file-name) (delete-file new-file-name))))
-
-
+
;; ---- *.scm
- (if (defined? 'effects-squelch-channel)
- (begin
- (if (or (provided? 'xm) (provided? 'xg))
- (let ((ctr 1))
- (for-each
- (lambda (func1 descr)
- (func1)
- (let ((func (edit-list->function)))
- ;(display (format #f "~A: ~A~%" ctr (procedure-source func)))
- (if (not (string=? (object->string (procedure-source func)) descr))
- (snd-display #__line__ ";edit-list->function 20[~D]:~%; [~A]~%; [~A]" ctr descr (object->string (procedure-source func))))
- (revert-sound ind)
- (func ind 0))
- (set! ctr (+ 1 ctr))
- (revert-sound ind))
- (list
- (lambda () (insert-vct (vct 1.0 0.5) 0 2))
- (lambda () (clm-channel-test))
-
- ;; examp.scm
- (lambda () (fft-edit 1000 3000))
- (lambda () (fft-squelch .01))
- (lambda () (fft-cancel 1000 3000))
- (lambda () (squelch-vowels))
- (lambda () (fft-env-edit '(0 0 1 1 2 0)))
- (lambda () (fft-env-interp '(0 0 1 1 2 0) '(0 1 1 0 2 0) '(0 0 1 1)))
- (lambda () (hello-dentist 10.0 .1))
- (lambda () (fp 1.0 0.3 20.0))
- (lambda () (expsnd '(0 1 1 2)))
- (lambda () (env-sound-interp '(0 0 1 1 2 0) 2.0))
- (lambda () (add-notes '(("1a.snd") ("pistol.snd" 1.0 2.0))))
- (lambda () (compand-channel))
- (lambda () (smooth-channel-via-ptree))
- (lambda () (ring-modulate-channel 300))
- (lambda () (filtered-env '(0 0 1 1 2 0)))
- (lambda () (reverse-by-blocks .1))
- (lambda () (reverse-within-blocks .1))
-
- ;; extensions.scm
- (lambda () (mix-channel "1a.snd" 1200))
- (lambda () (insert-channel "1a.snd" 1200))
- (lambda () (sine-ramp 0.5 0.9))
- (lambda () (sine-env-channel '(0 0 1 1 2 -0.5 3 1)))
- (lambda () (blackman4-ramp 0.0 1.0))
- (lambda () (blackman4-env-channel '(0 0 1 1 2 -0.5 3 1)))
- (lambda () (ramp-squared 0.2 0.8 #t))
- (lambda () (env-squared-channel '(0.0 0.0 1.0 1.0) #t))
- (lambda () (ramp-expt 0.2 0.8 32.0 #t))
- (lambda () (env-expt-channel '(0.0 0.0 1.0 1.0) 32.0 #t))
- (lambda () (offset-channel .1))
- (lambda () (dither-channel .1))
- (lambda () (contrast-channel .1))
-
- ;; dsp.scm
- (lambda () (ssb-bank 550 600 10))
- (lambda () (ssb-bank-env 550 600 '(0 1 1 2) 10))
- (lambda () (down-oct 1))
- (lambda () (freqdiv 8))
- (lambda () (adsat 8))
- (lambda () (spike))
- (lambda () (zero-phase))
- (lambda () (rotate-phase (lambda (x) (random pi))))
- (lambda () (brighten-slightly .5))
- (lambda () (shift-channel-pitch 100))
- (lambda () (channel-polynomial (vct 0.0 0.5)))
- (lambda () (spectral-polynomial (vct 0.0 1.0)))
- (lambda () (notch-channel (list 60.0 120.0 240.0) #f #f #f))
-
- ;; ---- new-effects.scm
- (lambda () (effects-squelch-channel .1 128))
- (lambda () (effects-echo #f 0.5 0.1 0 #f))
- (lambda () (effects-flecho-1 0.5 0.1 #f 0 #f))
- (lambda () (effects-zecho-1 0.75 0.75 6.0 10.0 #f 0 #f))
- ;; (lambda () (effects-comb-filter 0.1 50 0 #f))
- (lambda () (effects-moog 10000 0.5 0 #f))
- (lambda () (effects-remove-dc))
- (lambda () (effects-compand))
- (lambda () (effects-am 100.0 #f))
- (lambda () (effects-rm 100.0 #f))
- (lambda () (effects-bbp 1000.0 100.0 0 #f))
- (lambda () (effects-bbr 1000.0 100.0 0 #f))
- (lambda () (effects-bhp 1000.0 0 #f))
- (lambda () (effects-blp 1000.0 0 #f))
- (lambda () (effects-hello-dentist 50.0 0.5 0 #f))
- (lambda () (effects-fp 1.0 0.3 20.0 0 #f))
- (lambda () (effects-flange 5.0 2.0 0.001 0 #f))
- (lambda () (effects-jc-reverb-1 0.1 0 #f))
-
- )
- (list
- "(lambda (snd chn) (insert-vct (vct 1.0 0.5) 0 2 snd chn))"
- "(lambda (snd chn) (clm-channel-test snd chn))"
-
- "(lambda (snd chn) (fft-edit 1000 3000 snd chn))"
- "(lambda (snd chn) (fft-squelch 0.01 snd chn))"
- "(lambda (snd chn) (fft-cancel 1000 3000 snd chn))"
- "(lambda (snd chn) (squelch-vowels snd chn))"
- "(lambda (snd chn) (fft-env-edit '(0 0 1 1 2 0) snd chn))"
- "(lambda (snd chn) (fft-env-interp '(0 0 1 1 2 0) '(0 1 1 0 2 0) '(0 0 1 1) snd chn))"
- "(lambda (snd chn) (hello-dentist 10.0 0.1 snd chn))"
- "(lambda (snd chn) (fp 1.0 0.3 20.0 snd chn))"
- "(lambda (snd chn) (expsnd '(0 1 1 2) snd chn))"
- "(lambda (snd chn) (env-sound-interp '(0 0 1 1 2 0) 2.0 snd chn))"
- "(lambda (snd chn) (add-notes '((\"1a.snd\") (\"pistol.snd\" 1.0 2.0)) snd chn))"
- "(lambda (snd chn) (compand-channel 0 #f snd chn))"
- "(lambda (snd chn) (smooth-channel-via-ptree 0 #f snd chn))"
- "(lambda (snd chn) (ring-modulate-channel 300 0 #f snd chn))"
- "(lambda (snd chn) (filtered-env '(0 0 1 1 2 0) snd chn))"
- "(lambda (snd chn) (reverse-by-blocks 0.1 snd chn))"
- "(lambda (snd chn) (reverse-within-blocks 0.1 snd chn))"
-
- "(lambda (snd chn) (mix-channel \"1a.snd\" 1200 #f snd chn))"
- "(lambda (snd chn) (insert-channel \"1a.snd\" 1200 #f snd chn))"
- "(lambda (snd chn) (sine-ramp 0.5 0.9 0 #f snd chn))"
- "(lambda (snd chn) (sine-env-channel '(0 0 1 1 2 -0.5 3 1) 0 #f snd chn))"
- "(lambda (snd chn) (blackman4-ramp 0.0 1.0 0 #f snd chn))"
- "(lambda (snd chn) (blackman4-env-channel '(0 0 1 1 2 -0.5 3 1) 0 #f snd chn))"
- "(lambda (snd chn) (ramp-squared 0.2 0.8 #t 0 #f snd chn))"
- "(lambda (snd chn) (env-squared-channel '(0.0 0.0 1.0 1.0) #t 0 #f snd chn))"
- "(lambda (snd chn) (ramp-expt 0.2 0.8 32.0 #t 0 #f snd chn))"
- "(lambda (snd chn) (env-expt-channel '(0.0 0.0 1.0 1.0) 32.0 #t 0 #f snd chn))"
- "(lambda (snd chn) (offset-channel 0.1 0 #f snd chn))"
- "(lambda (snd chn) (dither-channel 0.1 0 #f snd chn))"
- "(lambda (snd chn) (contrast-channel 0.1 0 #f snd chn))"
-
- "(lambda (snd chn) (ssb-bank 550 600 10 40 50.0 0 #f snd chn))"
- "(lambda (snd chn) (ssb-bank-env 550 600 '(0 1 1 2) 10 40 50.0 0 #f snd chn))"
- "(lambda (snd chn) (down-oct 1 snd chn))"
- "(lambda (snd chn) (freqdiv 8 snd chn))"
- "(lambda (snd chn) (adsat 8 #f #f snd chn))"
- "(lambda (snd chn) (spike snd chn))"
- "(lambda (snd chn) (zero-phase snd chn))"
- "(lambda (snd chn) (rotate-phase (lambda (x) (random pi)) snd chn))"
- "(lambda (snd chn) (brighten-slightly 0.5 snd chn))"
- "(lambda (snd chn) (shift-channel-pitch 100 40 0 #f snd chn))"
- "(lambda (snd chn) (channel-polynomial (vct 0.0 0.5) snd chn))"
- "(lambda (snd chn) (spectral-polynomial (vct 0.0 1.0) snd chn))"
- "(lambda (snd chn) (notch-channel '(60.0 120.0 240.0) #f #f #f snd chn))"
-
- "(lambda (snd chn) (effects-squelch-channel 0.1 128 snd chn))"
- "(lambda (snd chn) (effects-echo #f 0.5 0.1 0 #f snd chn))"
- "(lambda (snd chn) (effects-flecho-1 0.5 0.1 #f 0 #f snd chn))"
- "(lambda (snd chn) (effects-zecho-1 0.75 0.75 6.0 10.0 #f 0 #f snd chn))"
- ;; "(lambda (snd chn) (effects-comb-filter 0.1 50 0 #f snd chn))"
- "(lambda (snd chn) (effects-moog 10000 0.5 0 #f snd chn))"
- "(lambda (snd chn) (effects-remove-dc snd chn))"
- "(lambda (snd chn) (effects-compand snd chn))"
- "(lambda (snd chn) (effects-am 100.0 #f #f #f snd chn))"
- "(lambda (snd chn) (effects-rm 100.0 #f #f #f snd chn))"
- "(lambda (snd chn) (effects-bbp 1000.0 100.0 0 #f snd chn))"
- "(lambda (snd chn) (effects-bbr 1000.0 100.0 0 #f snd chn))"
- "(lambda (snd chn) (effects-bhp 1000.0 0 #f snd chn))"
- "(lambda (snd chn) (effects-blp 1000.0 0 #f snd chn))"
- "(lambda (snd chn) (effects-hello-dentist 50.0 0.5 0 #f snd chn))"
- "(lambda (snd chn) (effects-fp 1.0 0.3 20.0 0 #f snd chn))"
- "(lambda (snd chn) (effects-flange 5.0 2.0 0.001 0 #f snd chn))"
- "(lambda (snd chn) (effects-jc-reverb-1 0.1 0 #f snd chn))"
-
- )
- )))))
-
+ (if (and (defined? 'effects-squelch-channel)
+ (or (provided? 'xm) (provided? 'xg)))
+ (let ((ctr 1))
+ (for-each
+ (lambda (func1 descr)
+ (func1)
+ (let ((func (edit-list->function)))
+ (if (not (equal? (procedure-source func) descr))
+ (snd-display #__line__ ";edit-list->function 20[~D]:~%; [~A]~%; [~A]" ctr descr (procedure-source func)))
+ (revert-sound ind)
+ (func ind 0))
+ (set! ctr (+ ctr 1))
+ (revert-sound ind))
+ (list
+ (lambda () (insert-float-vector (float-vector 1.0 0.5) 0 2))
+ clm-channel-test
+
+ ;; examp.scm
+ (lambda () (fft-edit 1000 3000))
+ (lambda () (fft-squelch .01))
+ (lambda () (fft-cancel 1000 3000))
+ squelch-vowels
+ (lambda () (fft-env-edit '(0 0 1 1 2 0)))
+ (lambda () (fft-env-interp '(0 0 1 1 2 0) '(0 1 1 0 2 0) '(0 0 1 1)))
+ (lambda () (hello-dentist 10.0 .1))
+ (lambda () (fp 1.0 0.3 20.0))
+ (lambda () (expsnd '(0 1 1 2)))
+ (lambda () (env-sound-interp '(0 0 1 1 2 0) 2.0))
+ (lambda () (add-notes '(("1a.snd") ("pistol.snd" 1.0 2.0))))
+ (lambda () (filtered-env '(0 0 1 1 2 0)))
+ (lambda () (reverse-by-blocks .1))
+ (lambda () (reverse-within-blocks .1))
+
+ ;; extensions.scm
+ (lambda () (mix-channel "1a.snd" 1200))
+ (lambda () (insert-channel "1a.snd" 1200))
+ (lambda () (sine-ramp 0.5 0.9))
+ (lambda () (sine-env-channel '(0 0 1 1 2 -0.5 3 1)))
+ (lambda () (blackman4-ramp 0.0 1.0))
+ (lambda () (blackman4-env-channel '(0 0 1 1 2 -0.5 3 1)))
+ (lambda () (ramp-squared 0.2 0.8 #t))
+ (lambda () (env-squared-channel '(0.0 0.0 1.0 1.0) #t))
+ (lambda () (ramp-expt 0.2 0.8 32.0 #t))
+ (lambda () (env-expt-channel '(0.0 0.0 1.0 1.0) 32.0 #t))
+ (lambda () (offset-channel .1))
+ (lambda () (dither-channel .1))
+ (lambda () (contrast-channel .1))
+
+ ;; dsp.scm
+ (lambda () (ssb-bank 550 600 10))
+ (lambda () (ssb-bank-env 550 600 '(0 1 1 2) 10))
+ (lambda () (down-oct 1))
+ spike
+ zero-phase
+ (lambda () (rotate-phase (lambda (x) (random pi))))
+ (lambda () (brighten-slightly .5))
+ (lambda () (shift-channel-pitch 100))
+ (lambda () (channel-polynomial (float-vector 0.0 0.5)))
+ (lambda () (spectral-polynomial (float-vector 0.0 1.0)))
+ (lambda () (notch-channel (list 60.0 120.0 240.0) #f #f #f))
+
+ ;; ---- new-effects.scm
+ (lambda () (effects-squelch-channel .1 128))
+ (lambda () (effects-echo #f 0.5 0.1 0 #f))
+ (lambda () (effects-flecho-1 0.5 0.1 #f 0 #f))
+ (lambda () (effects-zecho-1 0.75 0.75 6.0 10.0 #f 0 #f))
+ ;; (lambda () (effects-comb-filter 0.1 50 0 #f))
+ (lambda () (effects-moog 10000 0.5 0 #f))
+ effects-remove-dc
+ effects-compand
+ (lambda () (effects-am 100.0 #f))
+ (lambda () (effects-rm 100.0 #f))
+ (lambda () (effects-bbp 1000.0 100.0 0 #f))
+ (lambda () (effects-bbr 1000.0 100.0 0 #f))
+ (lambda () (effects-bhp 1000.0 0 #f))
+ (lambda () (effects-blp 1000.0 0 #f))
+ (lambda () (effects-hello-dentist 50.0 0.5 0 #f))
+ (lambda () (effects-fp 1.0 0.3 20.0 0 #f))
+ (lambda () (effects-flange 5.0 2.0 0.001 0 #f))
+ (lambda () (effects-jc-reverb-1 0.1 0 #f))
+
+ )
+ (list
+ '(lambda (snd chn) (insert-float-vector (float-vector 1.0 0.5) 0 2 snd chn))
+ '(lambda (snd chn) (clm-channel-test snd chn))
+
+ '(lambda (snd chn) (fft-edit 1000 3000 snd chn))
+ '(lambda (snd chn) (fft-squelch 0.01 snd chn))
+ '(lambda (snd chn) (fft-cancel 1000 3000 snd chn))
+ '(lambda (snd chn) (squelch-vowels snd chn))
+ '(lambda (snd chn) (fft-env-edit '(0 0 1 1 2 0) snd chn))
+ '(lambda (snd chn) (fft-env-interp '(0 0 1 1 2 0) '(0 1 1 0 2 0) '(0 0 1 1) snd chn))
+ '(lambda (snd chn) (hello-dentist 10.0 0.1 snd chn))
+ '(lambda (snd chn) (fp 1.0 0.3 20.0 snd chn))
+ '(lambda (snd chn) (expsnd '(0 1 1 2) snd chn))
+ '(lambda (snd chn) (env-sound-interp '(0 0 1 1 2 0) 2.0 snd chn))
+ '(lambda (snd chn) (add-notes '(("1a.snd") ("pistol.snd" 1.0 2.0)) snd chn))
+ '(lambda (snd chn) (filtered-env '(0 0 1 1 2 0) snd chn))
+ '(lambda (snd chn) (reverse-by-blocks 0.1 snd chn))
+ '(lambda (snd chn) (reverse-within-blocks 0.1 snd chn))
+
+ '(lambda (snd chn) (mix-channel "1a.snd" 1200 #f snd chn))
+ '(lambda (snd chn) (insert-channel "1a.snd" 1200 #f snd chn))
+ '(lambda (snd chn) (sine-ramp 0.5 0.9 0 #f snd chn))
+ '(lambda (snd chn) (sine-env-channel '(0 0 1 1 2 -0.5 3 1) 0 #f snd chn))
+ '(lambda (snd chn) (blackman4-ramp 0.0 1.0 0 #f snd chn))
+ '(lambda (snd chn) (blackman4-env-channel '(0 0 1 1 2 -0.5 3 1) 0 #f snd chn))
+ '(lambda (snd chn) (ramp-squared 0.2 0.8 #t 0 #f snd chn))
+ '(lambda (snd chn) (env-squared-channel '(0.0 0.0 1.0 1.0) #t 0 #f snd chn))
+ '(lambda (snd chn) (ramp-expt 0.2 0.8 32.0 #t 0 #f snd chn))
+ '(lambda (snd chn) (env-expt-channel '(0.0 0.0 1.0 1.0) 32.0 #t 0 #f snd chn))
+ '(lambda (snd chn) (offset-channel 0.1 0 #f snd chn))
+ '(lambda (snd chn) (dither-channel 0.1 0 #f snd chn))
+ '(lambda (snd chn) (contrast-channel 0.1 0 #f snd chn))
+
+ '(lambda (snd chn) (ssb-bank 550 600 10 40 50.0 0 #f snd chn))
+ '(lambda (snd chn) (ssb-bank-env 550 600 '(0 1 1 2) 10 40 50.0 0 #f snd chn))
+ '(lambda (snd chn) (down-oct 1 snd chn))
+ '(lambda (snd chn) (spike snd chn))
+ '(lambda (snd chn) (zero-phase snd chn))
+ '(lambda (snd chn) (rotate-phase (lambda (x) (random pi)) snd chn))
+ '(lambda (snd chn) (brighten-slightly 0.5 snd chn))
+ '(lambda (snd chn) (shift-channel-pitch 100 40 0 #f snd chn))
+ '(lambda (snd chn) (channel-polynomial (float-vector 0.0 0.5) snd chn))
+ '(lambda (snd chn) (spectral-polynomial (float-vector 0.0 1.0) snd chn))
+ '(lambda (snd chn) (notch-channel '(60.0 120.0 240.0) #f #f #f snd chn))
+
+ '(lambda (snd chn) (effects-squelch-channel 0.1 128 snd chn))
+ '(lambda (snd chn) (effects-echo #f 0.5 0.1 0 #f snd chn))
+ '(lambda (snd chn) (effects-flecho-1 0.5 0.1 #f 0 #f snd chn))
+ '(lambda (snd chn) (effects-zecho-1 0.75 0.75 6.0 10.0 #f 0 #f snd chn))
+ ;; '(lambda (snd chn) (effects-comb-filter 0.1 50 0 #f snd chn))
+ '(lambda (snd chn) (effects-moog 10000 0.5 0 #f snd chn))
+ '(lambda (snd chn) (effects-remove-dc snd chn))
+ '(lambda (snd chn) (effects-compand snd chn))
+ '(lambda (snd chn) (effects-am 100.0 #f #f #f snd chn))
+ '(lambda (snd chn) (effects-rm 100.0 #f #f #f snd chn))
+ '(lambda (snd chn) (effects-bbp 1000.0 100.0 0 #f snd chn))
+ '(lambda (snd chn) (effects-bbr 1000.0 100.0 0 #f snd chn))
+ '(lambda (snd chn) (effects-bhp 1000.0 0 #f snd chn))
+ '(lambda (snd chn) (effects-blp 1000.0 0 #f snd chn))
+ '(lambda (snd chn) (effects-hello-dentist 50.0 0.5 0 #f snd chn))
+ '(lambda (snd chn) (effects-fp 1.0 0.3 20.0 0 #f snd chn))
+ '(lambda (snd chn) (effects-flange 5.0 2.0 0.001 0 #f snd chn))
+ '(lambda (snd chn) (effects-jc-reverb-1 0.1 0 #f snd chn))
+ ))))
(close-sound ind)
))
+
;; ---- apply controls edit lists
- (let* ((ind (open-sound "oboe.snd"))
- (original-maxamp (maxamp)))
+ (let ((ind (open-sound "oboe.snd"))
+ (original-maxamp (maxamp)))
(reset-controls)
(controls->channel (list 2.0))
(if (fneq (amp-control ind) 1.0) (snd-display #__line__ ";controls->channel amp: ~A" (amp-control ind)))
(if (fneq (maxamp) (* 2 original-maxamp)) (snd-display #__line__ ";controls->channel maxamp: ~A" (maxamp)))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 1: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (scale-channel 2.0 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 1: ~A" (procedure-source func)))
(func ind 0)
(revert-sound ind))
(controls->channel (list #f 2.0))
- (let ((pk (vct-peak (channel->vct 22000 22100))))
+ (let ((pk (float-vector-peak (channel->float-vector 22000 22100))))
(if (fneq pk 0.0479) (snd-display #__line__ ";dp->end screwed up again!?!: ~A" pk)))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel '(#f 2.0) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 2: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (controls->channel '(#f 2.0) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 2: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
@@ -41636,8 +34614,8 @@ EDITS: 1
(controls->channel (list #f #f (list 0.5)))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel '(#f #f (0.5)) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 3: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (controls->channel '(#f #f (0.5)) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 3: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
@@ -41645,8 +34623,8 @@ EDITS: 1
(controls->channel (list #f #f (list 0.5 2.0)))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel '(#f #f (0.5 2.0)) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 3a: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (controls->channel '(#f #f (0.5 2.0)) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 3a: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
@@ -41654,8 +34632,8 @@ EDITS: 1
(controls->channel (list #f #f #f (list 0.5)))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel '(#f #f #f (0.5)) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 4: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (controls->channel '(#f #f #f (0.5)) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 4: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
@@ -41663,9 +34641,9 @@ EDITS: 1
(controls->channel (list #f #f #f (list 0.5 .1 .2 .06 0.0)))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (controls->channel '(#f #f #f (0.5 0.1 0.2 0.06 0.0)) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 4a: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (controls->channel '(#f #f #f (0.5 0.1 0.2 0.06 0.0)) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 4a: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
@@ -41673,8 +34651,8 @@ EDITS: 1
(controls->channel (list #f #f #f #f (list 0.1)))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func)) "(lambda (snd chn) (controls->channel '(#f #f #f #f (0.1)) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 5: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func) '(lambda (snd chn) (controls->channel '(#f #f #f #f (0.1)) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 5: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
@@ -41682,9 +34660,9 @@ EDITS: 1
(controls->channel (list #f #f #f #f (list 0.1 1.2 0.9 0.9 2.0)))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (controls->channel '(#f #f #f #f (0.1 1.2 0.9 0.9 2.0)) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 5a: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (controls->channel '(#f #f #f #f (0.1 1.2 0.9 0.9 2.0)) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 5a: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
@@ -41693,70 +34671,14 @@ EDITS: 1
(let ((order (filter-control-order ind)))
(controls->channel (list #f #f #f #f #f (list 10 '(0 0 1 1))))
(let ((func (edit-list->function)))
- (if (not (string=? (object->string (procedure-source func))
- "(lambda (snd chn) (controls->channel '(#f #f #f #f #f (10 (0 0 1 1))) 0 #f snd chn))"))
- (snd-display #__line__ ";edit-list->function controls->channel 6: ~A" (object->string (procedure-source func))))
+ (if (not (equal? (procedure-source func)
+ '(lambda (snd chn) (controls->channel '(#f #f #f #f #f (10 (0 0 1 1))) 0 #f snd chn))))
+ (snd-display #__line__ ";edit-list->function controls->channel 6: ~A" (procedure-source func)))
(revert-sound ind)
(func ind 0)
(revert-sound ind)
(if (not (= (filter-control-order ind) order)) (snd-display #__line__ ";controls->channel filter: ~A" (filter-control-order ind)))))
-
- (if (not (provided? 'snd-nogui))
- ;; ---- mix stuff
- (let ((id (make-v-mix ind 0)))
- ;; ---- mix-position
- (if (mix? id)
- (begin
- (set! (mix-position id) 200)
- (if (not (= (mix-position id) 200)) (snd-display #__line__ ";edit-list->function mix off to a bad start: ~A" (mix-position id)))
- (let ((func (edit-list->function)))
- (if (not (procedure? func))
- (snd-display #__line__ ";edit-list->function mix 1: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- (format #f "(lambda (snd chn) (let ((-mix-~D #f)) (set! -mix-~D (mix-vct (vct 0.1 0.2 0.3) 100 snd chn)) (set! (mix-position -mix-~D) 200)))"
- (mix->integer id) (mix->integer id) (mix->integer id))))
- (snd-display #__line__ ";edit-list->function mix 1: ~A" (object->string (procedure-source func))))
- (revert-sound ind)
- (func ind 0)
- (if (or (null? (mixes ind 0))
- (not (member 200 (map (lambda (m) (and (mix? m) (mix-position m))) (mixes ind 0)))))
- (snd-display #__line__ ";edit-list->function mix 1 repos: ~A ~A"
- (mixes ind 0) (map (lambda (m) (and (mix? m) (mix-position m))) (mixes ind 0)))))))
- (revert-sound ind)
-
- ;; ---- mix-amp
- (set! id (make-v-mix ind 0))
- (if (mix? id)
- (begin
- (set! (mix-amp id) 0.5)
- (let ((func (edit-list->function)))
- (if (not (procedure? func))
- (snd-display #__line__ ";edit-list->function mix 4: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- (format #f "(lambda (snd chn) (let ((-mix-~D #f)) (set! -mix-~D (mix-vct (vct 0.1 0.2 0.3) 100 snd chn)) (set! (mix-amp -mix-~D) 0.5)))"
- (mix->integer id) (mix->integer id) (mix->integer id))))
- (snd-display #__line__ ";edit-list->function mix 4: ~A" (object->string (procedure-source func))))
- (revert-sound ind)
- (func ind 0))))
- (revert-sound ind)
-
- ;; ---- mix-speed
- (if (mix? id)
- (begin
- (set! id (make-v-mix ind 0))
- (set! (mix-speed id) 0.5)
- (let ((func (edit-list->function)))
- (if (not (procedure? func))
- (snd-display #__line__ ";edit-list->function mix 5: ~A" func))
- (if (not (string=? (object->string (procedure-source func))
- (format #f "(lambda (snd chn) (let ((-mix-~D #f)) (set! -mix-~D (mix-vct (vct 0.1 0.2 0.3) 100 snd chn)) (set! (mix-speed -mix-~D) 0.5)))"
- (mix->integer id) (mix->integer id) (mix->integer id))))
- (snd-display #__line__ ";edit-list->function mix 5: ~A" (object->string (procedure-source func))))
- (revert-sound ind)
- (func ind 0))))
- (revert-sound ind)))
-
(close-sound ind))
(let ((ind (open-sound "2.snd")))
@@ -41765,7 +34687,7 @@ EDITS: 1
(close-sound ind)
(set! ind (open-sound "test.snd"))
(if (not (= (chans ind) 2)) (snd-display #__line__ ";src-sound/save-sound-as-> ~D chans" (chans ind)))
- (let ((tag (scan-channel (lambda (y) (not (= y 0.0))) 8000 #f)))
+ (let ((tag (scan-channel (lambda (y) (> (abs y) 0.0)) 8000 #f)))
(if tag (snd-display #__line__ ";src-sound/save-sound-as not zeros: ~A ~A" tag (sample (cadr tag) ind 0))))
(close-sound ind))
@@ -41784,13 +34706,13 @@ EDITS: 1
(if (not (string=? (comment ind) "this is a comment"))
(snd-display #__line__ ";save-sound-as with comment: ~A" (comment ind)))
(close-sound ind))
-
+
(mus-sound-prune)
))
-;;; ---------------- test 20: transforms ----------------
-(define (snd_test_20)
+;;; ---------------- test 19: transforms ----------------
+(define (snd_test_19)
(define (bes-j0-1 x) ;returns J0(x) for any real x
(if (< (abs x) 8.0) ;direct rational function fit
@@ -41822,7 +34744,7 @@ EDITS: 1
(* y (+ 0.7621095161e-6
(* y -0.934945152e-7))))))))))
(* (sqrt (/ 0.636619772 ax))
- (- (* (cos xx) ans1)
+ (- (* ans1 (cos xx))
(* z (sin xx) ans2))))))
(define (test-j0)
@@ -41831,7 +34753,7 @@ EDITS: 1
(if (fneq (bes-j0 x) (bes-j0-1 x))
(snd-display #__line__ ";(bes-j0 ~A) -> ~A ~A" x (bes-j0 x) (bes-j0-1 x))))
(list 0.0 0.5 1.0 2.0 20.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-j0 x) (bes-j0-1 x))
@@ -41871,7 +34793,7 @@ EDITS: 1
(* y 0.105787412e-6))))))))))
(* (signum x)
(sqrt (/ 0.636619772 ax))
- (- (* (cos xx) ans1)
+ (- (* ans1 (cos xx))
(* z (sin xx) ans2))))))
(define (test-j1)
@@ -41880,7 +34802,7 @@ EDITS: 1
(if (fneq (bes-j1 x) (bes-j1-1 x))
(snd-display #__line__ ";(bes-j1 ~A) -> ~A ~A" x (bes-j1 x) (bes-j1-1 x))))
(list 0.0 0.5 1.0 2.0 20.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-j1 x) (bes-j1-1 x))
@@ -41938,9 +34860,9 @@ EDITS: 1
besn)))
(define (test-jn)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 10))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-jn k x) (bes-jn-1 k x))
@@ -41975,7 +34897,7 @@ EDITS: 1
(* y (+ -0.6911147651e-5
(* y (+ 0.7621095161e-6
(* y -0.934945152e-7)))))))))
- (ans (+ (* (sin xx) ans1) (* z (cos xx) ans2))))
+ (ans (+ (* ans1 (sin xx)) (* z (cos xx) ans2))))
(* (sqrt (/ 0.636619772 x)) ans))))
(define (test-y0)
@@ -41984,7 +34906,7 @@ EDITS: 1
(if (fneq (bes-y0 x) (bes-y0-1 x))
(snd-display #__line__ ";(bes-y0 ~A) -> ~A ~A" x (bes-y0 x) (bes-y0-1 x))))
(list 0.5 1.0 2.0 20.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-y0 x) (bes-y0-1 x))
@@ -41992,7 +34914,7 @@ EDITS: 1
(define (bes-y1-1 x) ;Bessel function Y1(x)
(if (= x 0.0)
- -inf.0
+ (real-part (log 0.0)) ; -inf.0
(if (< x 8.0)
(let* ((y (* x x))
(ans1 (* x (+ -0.4900604943e13
@@ -42021,7 +34943,7 @@ EDITS: 1
(* y (+ 0.8449199096e-5
(* y (+ -0.88228987e-6
(* y 0.105787412e-6))))))))))
- (* (sqrt (/ 0.636619772 x)) (+ (* (sin xx) ans1) (* z (cos xx) ans2)))))))
+ (* (sqrt (/ 0.636619772 x)) (+ (* ans1 (sin xx)) (* z (cos xx) ans2)))))))
(define (test-y1)
(for-each
@@ -42029,7 +34951,7 @@ EDITS: 1
(if (fneq (bes-y1 x) (bes-y1-1 x))
(snd-display #__line__ ";(bes-y1 ~A) -> ~A ~A" x (bes-y1 x) (bes-y1-1 x))))
(list 0.01 0.5 1.0 2.0 20.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (bes-y1 x) (bes-y1-1 x))
@@ -42051,9 +34973,9 @@ EDITS: 1
(set! by byp)))))
(define (test-yn)
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 10))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (/ (bes-yn k x) (bes-yn-1 k x)) 1.0)
@@ -42062,7 +34984,7 @@ EDITS: 1
(define (bes-i0-1 x) ;I0(x)
(if (< (abs x) 3.75)
- (let* ((y (expt (/ x 3.75) 2)))
+ (let ((y (expt (/ x 3.75) 2)))
(+ 1.0
(* y (+ 3.5156229
(* y (+ 3.0899424
@@ -42089,7 +35011,7 @@ EDITS: 1
(if (fneq (bes-i0 x) (bes-i0-1 x))
(snd-display #__line__ ";(bes-i0 ~A) -> ~A ~A" x (bes-i0 x) (bes-i0-1 x))))
(list 0.0 0.5 1.0 2.0 0.01))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 1.0)))
(if (fneq (bes-i0 x) (bes-i0-1 x))
@@ -42097,7 +35019,7 @@ EDITS: 1
(define (bes-i1 x) ;I1(x)
(if (< (abs x) 3.75)
- (let* ((y (expt (/ x 3.75) 2)))
+ (let ((y (expt (/ x 3.75) 2)))
(* x (+ 0.5
(* y (+ 0.87890594
(* y (+ 0.51498869
@@ -42176,7 +35098,7 @@ EDITS: 1
(define (bes-k0 x) ;K0(x)
(if (<= x 2.0)
- (let* ((y (* x (/ x 4.0))))
+ (let ((y (* x (/ x 4.0))))
(+ (* (- (log (/ x 2.0))) (bes-i0 x)) -0.57721566
(* y (+ 0.42278420
(* y (+ 0.23069756
@@ -42184,7 +35106,7 @@ EDITS: 1
(* y (+ 0.262698e-2
(* y (+ 0.10750e-3
(* y 0.74e-5)))))))))))))
- (let* ((y (/ 2.0 x)))
+ (let ((y (/ 2.0 x)))
(* (/ (exp (- x)) (sqrt x))
(+ 1.25331414
(* y (+ -0.7832358e-1
@@ -42201,7 +35123,7 @@ EDITS: 1
(define (bes-k1 x) ;K1(x)
(if (<= x 2.0)
- (let* ((y (* x (/ x 4.0))))
+ (let ((y (* x (/ x 4.0))))
(+ (* (log (/ x 2)) (bes-i1 x))
(* (/ 1.0 x)
(+ 1.0
@@ -42211,7 +35133,7 @@ EDITS: 1
(* y (+ -0.1919402e-1
(* y (+ -0.110404e-2
(* y -0.4686e-4)))))))))))))))
- (let* ((y (/ 2.0 x)))
+ (let ((y (/ 2.0 x)))
(* (/ (exp (- x)) (sqrt x))
(+ 1.25331414
(* y (+ 0.23498619
@@ -42274,7 +35196,7 @@ EDITS: 1
(- (log (/ (* stp ser) x)) tmp1)))
(define (test-lgamma)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((x (random 100.0)))
(if (fneq (lgamma x) (gammln x))
@@ -42284,7 +35206,7 @@ EDITS: 1
(if (fneq (erf 0.0) 0.0) (snd-display #__line__ ";erf 0.0: ~A" (erf 0.0)))
(if (fneq (erf 0.5) 0.5204998) (snd-display #__line__ ";erf 0.5: ~A" (erf 0.5)))
(if (fneq (erf 1.0) 0.8427007) (snd-display #__line__ ";erf 0.0: ~A" (erf 1.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
(let ((val (random 2.0)))
(if (fneq (+ (erf val) (erfc val)) 1.0)
@@ -42294,35 +35216,35 @@ EDITS: 1
(erfc val))))))
(define (inverse-haar f)
- (let* ((n (vct-length f))
- (g (make-vct n))
+ (let* ((n (length f))
+ (g (make-float-vector n))
(s2 (sqrt 2.0))
(v (/ 1.0 (sqrt n))))
- (vct-set! f 0 (* (vct-ref f 0) v))
+ (set! (f 0) (* (f 0) v))
(do ((m 2 (* m 2)))
((> m n))
(let ((mh (/ m 2)))
(do ((j 0 (+ j 2))
(k 0 (+ k 1)))
((= j m))
- (let ((x (vct-ref f k))
- (y (* (vct-ref f (+ mh k)) v)))
- (vct-set! g j (+ x y))
- (vct-set! g (+ j 1) (- x y))))
+ (let ((x (f k))
+ (y (* (f (+ mh k)) v)))
+ (set! (g j) (+ x y))
+ (set! (g (+ j 1)) (- x y))))
(do ((i (- m 1) (- i 1)))
((< i 0))
- (vct-set! f i (vct-ref g i)))
+ (set! (f i) (g i)))
(set! v (* v s2))))
f))
(define (wavelet data n isign wf cc)
- (let* ((cc-size (vct-length cc))
- (ccr (make-vct cc-size))
+ (let* ((cc-size (length cc))
+ (ccr (make-float-vector cc-size))
(sig -1.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(j (- cc-size 1) (- j 1)))
((= i cc-size))
- (vct-set! ccr j (* sig (vct-ref cc i)))
+ (set! (ccr j) (* sig (cc i)))
(set! sig (- sig)))
(if (>= n 4)
(if (>= isign 0)
@@ -42334,9 +35256,9 @@ EDITS: 1
(wf data nn isign cc ccr))))))
(define (pwt data n isign cc cr)
- (let* ((data1 (make-vct n))
+ (let* ((data1 (make-float-vector n))
(n1 (- n 1))
- (ncof (vct-length cc))
+ (ncof (length cc))
(nmod (* ncof n))
(nh (floor (/ n 2)))
(joff (- (floor (/ ncof 2))))
@@ -42346,198 +35268,189 @@ EDITS: 1
(i 1 (+ i 2)))
((> i n))
(let ((ni (+ i nmod ioff))
- (nj (+ i nmod joff)))
- (do ((k 1 (+ 1 k)))
+ (nj (+ i nmod joff))
+ (ii+nh (+ ii nh)))
+ (do ((k 1 (+ k 1)))
((> k ncof))
(let ((jf (logand n1 (+ ni k))) ;gad wotta kludge...
(jr (logand n1 (+ nj k))))
- (vct-set! data1 ii (+ (vct-ref data1 ii)
- (* (vct-ref cc (- k 1))
- (vct-ref data jf))))
- (vct-set! data1 (+ ii nh) (+ (vct-ref data1 (+ ii nh))
- (* (vct-ref cr (- k 1))
- (vct-ref data jr))))))))
+ (set! (data1 ii) (+ (data1 ii)
+ (* (cc (- k 1))
+ (data jf))))
+ (set! (data1 ii+nh) (+ (data1 ii+nh)
+ (* (cr (- k 1))
+ (data jr))))))))
(do ((ii 0 (+ 1 ii))
(i 1 (+ i 2)))
((> i n))
- (let ((ai (vct-ref data ii))
- (ai1 (vct-ref data (+ ii nh)))
+ (let ((ai (data ii))
+ (ai1 (data (+ ii nh)))
(ni (+ i nmod ioff))
(nj (+ i nmod joff)))
- (do ((k 1 (+ 1 k)))
+ (do ((k 1 (+ k 1)))
((> k ncof))
(let ((jf (logand n1 (+ ni k)))
(jr (logand n1 (+ nj k))))
- (vct-set! data1 jf (+ (vct-ref data1 jf)
- (* ai (vct-ref cc (- k 1)))))
- (vct-set! data1 jr (+ (vct-ref data1 jr)
- (* ai1 (vct-ref cr (- k 1))))))))))
- (do ((i 0 (+ 1 i)))
- ((= i n))
- (vct-set! data i (vct-ref data1 i)))
+ (set! (data1 jf) (+ (data1 jf)
+ (* ai (cc (- k 1)))))
+ (set! (data1 jr) (+ (data1 jr)
+ (* ai1 (cr (- k 1))))))))))
+ (copy data1 data)
data))
(define (corr x y N M)
;; correlation from Orfanidis
- (let ((R (make-vct (+ 1 M))))
- (do ((k 0 (+ 1 k)))
+ (let ((R (make-float-vector (+ 1 M))))
+ (do ((k 0 (+ k 1)))
((> k M))
- (vct-set! R k 0.0)
+ (set! (R k) 0.0)
(do ((n 0 (+ 1 n)))
((= n (- N k)))
- (vct-set! R k (+ (vct-ref R k) (* (vct-ref x (+ n k)) (vct-ref y n))))))
+ (set! (R k) (+ (R k) (* (x (+ n k)) (y n))))))
R))
- ;; this returns the same results as the fft-based version below, modulo vct lengths
+ ;; this returns the same results as the fft-based version below, modulo float-vector lengths
(define (cross-correlate-1 snd0 chn0 snd1 chn1)
- (let* ((len0 (frames snd0 chn0))
- (len1 (frames snd1 chn1))
+ (let* ((len0 (framples snd0 chn0))
+ (len1 (framples snd1 chn1))
(clen (min len0 len1))
(dlen (max len0 len1))
- (corr (make-vct clen))
- (data0 (channel->vct 0 dlen snd0 chn0))
- (data1 (channel->vct 0 dlen snd1 chn1)))
+ (corr (make-float-vector clen))
+ (data0 (channel->float-vector 0 dlen snd0 chn0))
+ (data1 (channel->float-vector 0 dlen snd1 chn1)))
(do ((lag 0 (+ 1 lag)))
((= lag clen) corr)
- (let ((mdata (vct-multiply! (vct-copy data0) data1))
- (sum 0.0))
- (do ((i 0 (+ 1 i)))
+ (let ((mdata (float-vector-multiply! (copy data0) data1))
+ (sum (make-one-pole 1.0 -1.0)))
+ (do ((i 0 (+ i 1)))
((= i dlen))
- (set! sum (+ sum (vct-ref mdata i))))
- (vct-set! corr lag sum)
- (let ((orig (vct-ref data0 0)))
- (vct-move! data0 0 1)
- (vct-set! data0 (- dlen 1) orig))))))
+ (one-pole sum (float-vector-ref mdata i)))
+ (set! (corr lag) (one-pole sum 0.0))
+ (let ((orig (data0 0)))
+ (float-vector-move! data0 0 1)
+ (set! (data0 (- dlen 1)) orig))))))
(define (cross-correlate-2 snd0 chn0 snd1 chn1)
- (let* ((len0 (frames snd0 chn0))
- (len1 (frames snd1 chn1))
+ (let* ((len0 (framples snd0 chn0))
+ (len1 (framples snd1 chn1))
(ilen (max len0 len1))
- (pow2 (ceiling (/ (log ilen) (log 2))))
+ (pow2 (ceiling (log ilen 2)))
(fftlen (expt 2 pow2))
- (fftlen2 (/ fftlen 2))
(fftscale (/ 1.0 fftlen))
- (rl1 (channel->vct 0 fftlen snd1 chn1))
- (rl2 (channel->vct 0 fftlen snd0 chn0))
- (im1 (make-vct fftlen))
- (im2 (make-vct fftlen)))
+ (rl1 (channel->float-vector 0 fftlen snd1 chn1))
+ (rl2 (channel->float-vector 0 fftlen snd0 chn0))
+ (im1 (make-float-vector fftlen))
+ (im2 (make-float-vector fftlen)))
(fft rl1 im1 1)
(fft rl2 im2 1)
- (let* ((tmprl (vct-copy rl1))
- (tmpim (vct-copy im1))
- (data3 (make-vct fftlen)))
- (vct-multiply! tmprl rl2) ; (* tempr1 tempr2)
- (vct-multiply! tmpim im2) ; (* tempi1 tempi2)
- (vct-multiply! im2 rl1) ; (* tempr1 tempi2)
- (vct-multiply! rl2 im1) ; (* tempr2 tempi1)
- (vct-add! tmprl tmpim) ; add the first two
- (vct-subtract! im2 rl2) ; subtract the 4th from the 3rd
- (vct-scale! (fft tmprl im2 -1) fftscale))))
+ (let ((tmprl (copy rl1))
+ (tmpim (copy im1)))
+ (float-vector-multiply! tmprl rl2) ; (* tempr1 tempr2)
+ (float-vector-multiply! tmpim im2) ; (* tempi1 tempi2)
+ (float-vector-multiply! im2 rl1) ; (* tempr1 tempi2)
+ (float-vector-multiply! rl2 im1) ; (* tempr2 tempi1)
+ (float-vector-add! tmprl tmpim) ; add the first two
+ (float-vector-subtract! im2 rl2) ; subtract the fourth from the third
+ (float-vector-scale! (fft tmprl im2 -1) fftscale))))
(define (cross-correlate-3 rl1 rl2 fftlen)
- (let* ((fftlen2 (/ fftlen 2))
- (fftscale (/ 1.0 fftlen))
- (im1 (make-vct fftlen))
- (im2 (make-vct fftlen)))
+ (let ((fftscale (/ 1.0 fftlen))
+ (im1 (make-float-vector fftlen))
+ (im2 (make-float-vector fftlen)))
(fft rl1 im1 1)
(fft rl2 im2 1)
- (let* ((tmprl (vct-copy rl1))
- (tmpim (vct-copy im1))
- (data3 (make-vct fftlen)))
- (vct-multiply! tmprl rl2) ; (* tempr1 tempr2)
- (vct-multiply! tmpim im2) ; (* tempi1 tempi2)
- (vct-multiply! im2 rl1) ; (* tempr1 tempi2)
- (vct-multiply! rl2 im1) ; (* tempr2 tempi1)
- (vct-add! tmprl tmpim) ; add the first two
- (vct-subtract! im2 rl2) ; subtract the 4th from the 3rd
- (vct-scale! (fft tmprl im2 -1) fftscale))))
+ (let ((tmprl (copy rl1))
+ (tmpim (copy im1)))
+ (float-vector-multiply! tmprl rl2) ; (* tempr1 tempr2)
+ (float-vector-multiply! tmpim im2) ; (* tempi1 tempi2)
+ (float-vector-multiply! im2 rl1) ; (* tempr1 tempi2)
+ (float-vector-multiply! rl2 im1) ; (* tempr2 tempi1)
+ (float-vector-add! tmprl tmpim) ; add the first two
+ (float-vector-subtract! im2 rl2) ; subtract the fourth from the third
+ (float-vector-scale! (fft tmprl im2 -1) fftscale))))
(define* (automorph a b c d snd chn)
- (let* ((len (frames snd chn))
- (pow2 (ceiling (/ (log len) (log 2))))
+ (let* ((len (framples snd chn))
+ (pow2 (ceiling (log len 2)))
(fftlen (expt 2 pow2))
+ (fftlen2 (/ fftlen 2))
(fftscale (/ 1.0 fftlen))
- (rl (channel->vct 0 fftlen snd chn))
- (im (make-vct fftlen)))
+ (rl (channel->float-vector 0 fftlen snd chn))
+ (im (make-float-vector fftlen))
+ (c1 #f))
(fft rl im 1)
- (vct-scale! rl fftscale)
- (vct-scale! im fftscale)
+ (float-vector-scale! rl fftscale)
+ (float-vector-scale! im fftscale)
;; handle 0 case by itself
- (let* ((c1 (make-rectangular (vct-ref rl 0) (vct-ref im 0)))
- (val (/ (+ (* a c1) b)
- (+ (* c c1) d)))
- (rval (real-part val))
- (ival (imag-part val)))
- (vct-set! rl 0 rval)
- (vct-set! im 0 ival))
+ (set! c1 (complex (rl 0) (im 0)))
+ (set! c1 (/ (+ (* a c1) b) (+ (* c c1) d)))
+ (set! (rl 0) (real-part c1))
+ (set! (im 0) (imag-part c1))
+
(do ((i 1 (+ i 1))
(k (- fftlen 1) (- k 1)))
- ((= i (/ fftlen 2)))
- (let* ((c1 (make-rectangular (vct-ref rl i) (vct-ref im i)))
- (val (/ (+ (* a c1) b) ; (az + b) / (cz + d)
- (+ (* c c1) d)))
- (rval (real-part val))
- (ival (imag-part val)))
- (vct-set! rl i rval)
- (vct-set! im i ival)
- (vct-set! rl k rval)
- (vct-set! im k (- ival))))
+ ((= i fftlen2))
+ (set! c1 (complex (float-vector-ref rl i) (float-vector-ref im i)))
+ (set! c1 (/ (+ (* a c1) b) (+ (* c c1) d)))
+ (float-vector-set! rl k (float-vector-set! rl i (real-part c1)))
+ (float-vector-set! im k (- (float-vector-set! im i (imag-part c1)))))
+
(fft rl im -1)
- (vct->channel rl 0 len snd chn #f (format #f "automorph ~A ~A ~A ~A" a b c d))))
+ (float-vector->channel rl 0 len snd chn #f (format #f "automorph ~A ~A ~A ~A" a b c d))))
- (let* ((daub4 (vct 0.4829629131445341 0.8365163037378079 0.2241438680420134 -0.1294095225512604))
- (daub6 (vct 0.332670552950 0.806891509311 0.459877502118 -0.135011020010 -0.085441273882 0.035226291886))
- (daub8 (vct 0.230377813309 0.714846570553 0.630880767930 -0.027983769417 -0.187034811719 0.030841381836
+ (let* ((daub4 (float-vector 0.4829629131445341 0.8365163037378079 0.2241438680420134 -0.1294095225512604))
+ (daub6 (float-vector 0.332670552950 0.806891509311 0.459877502118 -0.135011020010 -0.085441273882 0.035226291886))
+ (daub8 (float-vector 0.230377813309 0.714846570553 0.630880767930 -0.027983769417 -0.187034811719 0.030841381836
0.032883011667 -0.010597401785))
- (daub10 (vct 0.160102397974 0.603829269797 0.724308528438 0.138428145901 -0.242294887066 -0.032244869585
+ (daub10 (float-vector 0.160102397974 0.603829269797 0.724308528438 0.138428145901 -0.242294887066 -0.032244869585
0.077571493840 -0.006241490213 -0.012580751999 0.003335725285))
- (daub12 (vct 0.111540743350 0.494623890398 0.751133908021 0.315250351709 -0.226264693965 -0.129766867567
+ (daub12 (float-vector 0.111540743350 0.494623890398 0.751133908021 0.315250351709 -0.226264693965 -0.129766867567
0.097501605587 0.027522865530 -0.031582039317 0.000553842201 0.004777257511 -0.001077301085))
- (daub14 (vct 0.077852054085 0.396539319482 0.729132090846 0.469782287405 -0.143906003929 -0.224036184994
+ (daub14 (float-vector 0.077852054085 0.396539319482 0.729132090846 0.469782287405 -0.143906003929 -0.224036184994
0.071309219267 0.080612609151 -0.038029936935 -0.016574541631 0.012550998556 0.000429577973
-0.001801640704 0.000353713800))
- (daub16 (vct 0.054415842243 0.312871590914 0.675630736297 0.585354683654 -0.015829105256 -0.284015542962
+ (daub16 (float-vector 0.054415842243 0.312871590914 0.675630736297 0.585354683654 -0.015829105256 -0.284015542962
0.000472484574 0.128747426620 -0.017369301002 -0.044088253931 0.013981027917 0.008746094047
-0.004870352993 -0.000391740373 0.000675449406 -0.000117476784))
- (daub18 (vct 0.038077947364 0.243834674613 0.604823123690 0.657288078051 0.133197385825 -0.293273783279
+ (daub18 (float-vector 0.038077947364 0.243834674613 0.604823123690 0.657288078051 0.133197385825 -0.293273783279
-0.096840783223 0.148540749338 0.030725681479 -0.067632829061 0.000250947115 0.022361662124
-0.004723204758 -0.004281503682 0.001847646883 0.000230385764 -0.000251963189 0.000039347320))
- (daub20 (vct 0.026670057901 0.188176800077 0.527201188931 0.688459039453 0.281172343661 -0.249846424327
+ (daub20 (float-vector 0.026670057901 0.188176800077 0.527201188931 0.688459039453 0.281172343661 -0.249846424327
-0.195946274377 0.127369340336 0.093057364604 -0.071394147166 -0.029457536822 0.033212674059
0.003606553567 -0.010733175483 0.001395351747 0.001992405295 -0.000685856695 -0.000116466855
0.000093588670 -0.000013264203))
(SQRT2 1.41421356237309504880168872420969808)
- (Battle-Lemarie (vct (* SQRT2 -0.002) (* SQRT2 -0.003) (* SQRT2 0.006) (* SQRT2 0.006) (* SQRT2 -0.013)
+ (Battle-Lemarie (float-vector (* SQRT2 -0.002) (* SQRT2 -0.003) (* SQRT2 0.006) (* SQRT2 0.006) (* SQRT2 -0.013)
(* SQRT2 -0.012) (* SQRT2 0.030) (* SQRT2 0.023) (* SQRT2 -0.078) (* SQRT2 -0.035)
(* SQRT2 0.307) (* SQRT2 0.542) (* SQRT2 0.307) (* SQRT2 -0.035) (* SQRT2 -0.078)
(* SQRT2 0.023) (* SQRT2 0.030) (* SQRT2 -0.012) (* SQRT2 -0.013) (* SQRT2 0.006)
(* SQRT2 0.006) (* SQRT2 -0.003) (* SQRT2 -0.002) 0.0))
- (Burt-Adelson (vct (* SQRT2 (/ -1.0 20.0)) (* SQRT2 (/ 5.0 20.0)) (* SQRT2 (/ 12.0 20.0))
+ (Burt-Adelson (float-vector (* SQRT2 (/ -1.0 20.0)) (* SQRT2 (/ 5.0 20.0)) (* SQRT2 (/ 12.0 20.0))
(* SQRT2 (/ 5.0 20.0)) (* SQRT2 (/ -1.0 20.0)) 0.0))
- (Beylkin (vct 0.099305765374353 0.424215360812961 0.699825214056600 0.449718251149468
+ (Beylkin (float-vector 0.099305765374353 0.424215360812961 0.699825214056600 0.449718251149468
-.110927598348234 -.264497231446384 0.026900308803690 0.155538731877093
-.017520746266529 -.088543630622924 0.019679866044322 0.042916387274192
-.017460408696028 -.014365807968852 0.010040411844631 .0014842347824723
-.002736031626258 .0006404853285212))
(SQRT15 3.87298334620741688517927)
- (coif2 (vct (/ (* SQRT2 (- SQRT15 3)) 32.0) (/ (* SQRT2 (- 1 SQRT15)) 32.0) (/ (* SQRT2 (- 6 (* 2 SQRT15))) 32.0)
+ (coif2 (float-vector (/ (* SQRT2 (- SQRT15 3)) 32.0) (/ (* SQRT2 (- 1 SQRT15)) 32.0) (/ (* SQRT2 (- 6 (* 2 SQRT15))) 32.0)
(/ (* SQRT2 (+ (* 2 SQRT15) 6)) 32.0) (/ (* SQRT2 (+ SQRT15 13)) 32.0) (/ (* SQRT2 (- 9 SQRT15)) 32.0)))
- (coif4 (vct 0.0011945726958388 -0.01284557955324 0.024804330519353 0.050023519962135 -0.15535722285996
+ (coif4 (float-vector 0.0011945726958388 -0.01284557955324 0.024804330519353 0.050023519962135 -0.15535722285996
-0.071638282295294 0.57046500145033 0.75033630585287 0.28061165190244 -0.0074103835186718
-0.014611552521451 -0.0013587990591632))
- (coif6 (vct -0.0016918510194918 -0.00348787621998426 0.019191160680044 0.021671094636352 -0.098507213321468
+ (coif6 (float-vector -0.0016918510194918 -0.00348787621998426 0.019191160680044 0.021671094636352 -0.098507213321468
-0.056997424478478 0.45678712217269 0.78931940900416 0.38055713085151 -0.070438748794943
-0.056514193868065 0.036409962612716 0.0087601307091635 -0.011194759273835 -0.0019213354141368
0.0020413809772660 0.00044583039753204 -0.00021625727664696))
- (sym2 (vct (* SQRT2 -0.125) (* SQRT2 0.25) (* SQRT2 0.75) (* SQRT2 0.25) (* SQRT2 -0.125)))
- (sym3 (vct (/ (* SQRT2 1.0) 8.0) (/ (* SQRT2 3.0) 8.0) (/ (* SQRT2 3.0) 8.0) (/ (* SQRT2 1.0) 8.0)))
- (sym4 (vct (/ (* SQRT2 3.0) 128.0) (/ (* SQRT2 -6.0) 128.0) (/ (* SQRT2 -16.0) 128.0)
+ (sym2 (float-vector (* SQRT2 -0.125) (* SQRT2 0.25) (* SQRT2 0.75) (* SQRT2 0.25) (* SQRT2 -0.125)))
+ (sym3 (float-vector (/ (* SQRT2 1.0) 8.0) (/ (* SQRT2 3.0) 8.0) (/ (* SQRT2 3.0) 8.0) (/ (* SQRT2 1.0) 8.0)))
+ (sym4 (float-vector (/ (* SQRT2 3.0) 128.0) (/ (* SQRT2 -6.0) 128.0) (/ (* SQRT2 -16.0) 128.0)
(/ (* SQRT2 38.0) 128.0) (/ (* SQRT2 90.0) 128.0) (/ (* SQRT2 38.0) 128.0)
(/ (* SQRT2 -16.0) 128.0) (/ (* SQRT2 -6.0) 128.0) (/ (* SQRT2 3.0) 128.0) 0.0))
- (sym5 (vct (/ (* SQRT2 3.0) 64.0) (/ (* SQRT2 -9.0) 64.0) (/ (* SQRT2 -7.0) 64.0) (/ (* SQRT2 45.0) 64.0)
+ (sym5 (float-vector (/ (* SQRT2 3.0) 64.0) (/ (* SQRT2 -9.0) 64.0) (/ (* SQRT2 -7.0) 64.0) (/ (* SQRT2 45.0) 64.0)
(/ (* SQRT2 45.0) 64.0) (/ (* SQRT2 -7.0) 64.0) (/ (* SQRT2 -9.0) 64.0) (/ (* SQRT2 3.0) 64.0)))
- (sym6 (vct (/ (* SQRT2 -35.0) 16384.0) (/ (* SQRT2 -105.0) 16384.0) (/ (* SQRT2 -195.0) 16384.0)
+ (sym6 (float-vector (/ (* SQRT2 -35.0) 16384.0) (/ (* SQRT2 -105.0) 16384.0) (/ (* SQRT2 -195.0) 16384.0)
(/ (* SQRT2 865.0) 16384.0) (/ (* SQRT2 363.0) 16384.0) (/ (* SQRT2 -3489.0) 16384.0)
(/ (* SQRT2 -307.0) 16384.0) (/ (* SQRT2 11025.0) 16384.0) (/ (* SQRT2 11025.0) 16384.0)
(/ (* SQRT2 -307.0) 16384.0) (/ (* SQRT2 -3489.0) 16384.0) (/ (* SQRT2 363.0) 16384.0)
@@ -42575,12 +35488,12 @@ EDITS: 1
(set! (transform-graph?) #t)
(for-each
(lambda (transform)
- (set! (transform-type) transform)
+ (set! *transform-type* transform)
(for-each
(lambda (size)
(catch #t
(lambda ()
- (set! (transform-size) size)
+ (set! *transform-size* size)
(update-transform-graph))
(lambda args args)))
(list 8 7 -7 4 3 2 1 0)))
@@ -42589,120 +35502,120 @@ EDITS: 1
;; -------- fft
- (set! d0 (make-vct 16))
- (vct-set! d0 0 1.0)
+ (set! d0 (make-float-vector 16))
+ (set! (d0 0) 1.0)
(snd-transform fourier-transform d0 0)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 16))
- (if (fneq (vct-ref d0 i) 1.0)
- (snd-display #__line__ ";fourier (1.0) [~D]: ~A?" i (vct-ref d0 i))))
+ (if (fneq (d0 i) 1.0)
+ (snd-display #__line__ ";fourier (1.0) [~D]: ~A?" i (d0 i))))
- (set! d0 (make-vct 19))
- (vct-set! d0 0 1.0)
+ (set! d0 (make-float-vector 19))
+ (set! (d0 0) 1.0)
(snd-transform fourier-transform d0 0)
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 16)))
- (if (fneq (vct-ref d0 i) 1.0)
+ (if (fneq (d0 i) 1.0)
(begin
- (snd-display #__line__ ";fourier (1.0) [~D]: ~A?" i (vct-ref d0 i))
+ (snd-display #__line__ ";fourier (1.0) [~D]: ~A?" i (d0 i))
(set! happy #f)))))
(snd-transform fourier-transform d0 0)
- (if (and (fneq (vct-ref d0 0) 256.0)
- (fneq (vct-ref d0 0) 361.0)) ; fftw funny length
- (snd-display #__line__ ";fourier (256.0): ~A?" (vct-ref d0 0)))
+ (if (and (fneq (d0 0) 256.0)
+ (fneq (d0 0) 361.0)) ; fftw funny length
+ (snd-display #__line__ ";fourier (256.0): ~A?" (d0 0)))
(let ((happy #t))
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((or (not happy) (= i 16)))
- (if (fneq (vct-ref d0 i) 0.0)
+ (if (fneq (d0 i) 0.0)
(begin
- (snd-display #__line__ ";fourier (0.0) [~D]: ~A?" i (vct-ref d0 i))
+ (snd-display #__line__ ";fourier (0.0) [~D]: ~A?" i (d0 i))
(set! happy #f)))))
- (let ((r0 (make-vct 8))
- (i0 (make-vct 8))
- (r1 (make-vct 8))
- (i1 (make-vct 8))
- (r2 (make-vct 8))
- (i2 (make-vct 8)))
- (vct-set! r0 1 .5)
- (vct-set! r1 3 .75)
- (vct-set! r2 1 .25) ; 1/2
- (vct-set! r2 3 .25) ; 1/3
+ (let ((r0 (make-float-vector 8))
+ (i0 (make-float-vector 8))
+ (r1 (make-float-vector 8))
+ (i1 (make-float-vector 8))
+ (r2 (make-float-vector 8))
+ (i2 (make-float-vector 8)))
+ (set! (r0 1) .5)
+ (set! (r1 3) .75)
+ (set! (r2 1) .25) ; 1/2
+ (set! (r2 3) .25) ; 1/3
(mus-fft r0 i0)
(mus-fft r1 i1)
(mus-fft r2 i2)
- (vct-scale! r0 .5)
- (vct-scale! i0 .5)
- (vct-scale! r1 .3333)
- (vct-scale! i1 .3333)
- (vct-add! r0 r1)
- (vct-add! i0 i1)
+ (float-vector-scale! r0 .5)
+ (float-vector-scale! i0 .5)
+ (float-vector-scale! r1 .3333)
+ (float-vector-scale! i1 .3333)
+ (float-vector-add! r0 r1)
+ (float-vector-add! i0 i1)
(if (or (not (vequal r0 r2))
(not (vequal i0 i2)))
(snd-display #__line__ ";fft additions/scaling: ~A ~A: ~A ~A" r2 i2 r0 i0)))
- (set! d0 (make-vct 8))
- (set! d1 (make-vct 8))
- (vct-set! d0 2 1.0)
+ (set! d0 (make-float-vector 8))
+ (set! d1 (make-float-vector 8))
+ (set! (d0 2) 1.0)
(mus-fft d0 d1 8 1)
- (if (or (not (vequal d0 (vct 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000 0.000)))
- (not (vequal d1 (vct 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
+ (if (or (not (vequal d0 (float-vector 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000 0.000)))
+ (not (vequal d1 (float-vector 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
(snd-display #__line__ ";mus-fft 1: ~A ~A?" d0 d1))
(mus-fft d0 d1 8 -1)
- (if (or (not (vequal d0 (vct 0.000 0.000 8.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal d1 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (or (not (vequal d0 (float-vector 0.000 0.000 8.000 0.000 0.000 0.000 0.000 0.000)))
+ (not (vequal d1 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";mus-fft -1: ~A ~A?" d0 d1))
- (vct-fill! d0 1.0)
- (vct-fill! d1 0.0)
+ (fill! d0 1.0)
+ (fill! d1 0.0)
(mus-fft d0 d1 8)
- (if (or (not (vequal d0 (vct 8.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (not (vequal d1 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (or (not (vequal d0 (float-vector 8.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (not (vequal d1 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";mus-fft 2: ~A ~A?" d0 d1))
(mus-fft d0 d1 8 -1)
- (if (or (not (vequal d0 (vct 8.000 8.000 8.000 8.000 8.000 8.000 8.000 8.000)))
- (not (vequal d1 (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
+ (if (or (not (vequal d0 (float-vector 8.000 8.000 8.000 8.000 8.000 8.000 8.000 8.000)))
+ (not (vequal d1 (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000))))
(snd-display #__line__ ";mus-fft -2: ~A ~A?" d0 d1))
- (vct-fill! d1 0.0)
- (vct-map! d0 (lambda () (random 1.0)))
- (set! fn (vct-copy d0))
+ (fill! d1 0.0)
+ (fill-float-vector d0 (random 1.0))
+ (set! fn (copy d0))
(mus-fft d0 d1 8)
(mus-fft d0 d1 8 -1)
- (vct-scale! d0 (/ 1.0 8.0))
+ (float-vector-scale! d0 (/ 1.0 8.0))
(if (not (vequal d0 fn))
(snd-display #__line__ ";mus-fft 3: ~A ~A?" d0 fn))
- (let ((d0 (make-vct 8))
- (d1 (make-vct 8)))
- (do ((i 0 (+ 1 i)))
+ (let ((d0 (make-float-vector 8))
+ (d1 (make-float-vector 8)))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! d0 i (- 1.0 (random 2.0)))
- (vct-set! d1 i (- 1.0 (random 2.0))))
- (let ((save-d0 (vct-copy d0))
- (save-d1 (vct-copy d1))
- (reversed-d0 (make-vct 8))
- (reversed-d1 (make-vct 8)))
- (do ((i 0 (+ 1 i)))
+ (set! (d0 i) (- 1.0 (random 2.0)))
+ (set! (d1 i) (- 1.0 (random 2.0))))
+ (let ((save-d0 (copy d0))
+ (save-d1 (copy d1))
+ (reversed-d0 (make-float-vector 8))
+ (reversed-d1 (make-float-vector 8)))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! reversed-d0 i (vct-ref d0 (- 7 i)))
- (vct-set! reversed-d1 i (vct-ref d1 (- 7 i))))
+ (set! (reversed-d0 i) (d0 (- 7 i)))
+ (set! (reversed-d1 i) (d1 (- 7 i))))
(mus-fft d0 d1 8)
(mus-fft d0 d1 8)
- (vct-scale! d0 .125)
- (vct-scale! d1 .125)
- (do ((i 0 (+ 1 i))) ; one sample rotation here
+ (float-vector-scale! d0 .125)
+ (float-vector-scale! d1 .125)
+ (do ((i 0 (+ i 1))) ; one sample rotation here
((= i 7))
- (if (fneq (vct-ref d0 (+ 1 i)) (vct-ref reversed-d0 i))
+ (if (fneq (d0 (+ i 1)) (reversed-d0 i))
(snd-display #__line__ ";mus-fft d0 reversed: ~A ~A" d0 reversed-d0))
- (if (fneq (vct-ref d1 (+ 1 i)) (vct-ref reversed-d1 i))
+ (if (fneq (d1 (+ i 1)) (reversed-d1 i))
(snd-display #__line__ ";mus-fft d1 reversed: ~A ~A" d1 reversed-d1)))
(mus-fft d0 d1 8)
(mus-fft d0 d1 8)
- (vct-scale! d0 .125)
- (vct-scale! d1 .125)
+ (float-vector-scale! d0 .125)
+ (float-vector-scale! d1 .125)
(if (not (vequal d0 save-d0))
(snd-display #__line__ ";mus-fft d0 saved: ~A ~A" d0 save-d0))
(if (not (vequal d1 save-d1))
@@ -42711,111 +35624,111 @@ EDITS: 1
(for-each
(lambda (size)
(let ((dcopy #f))
- (set! d0 (make-vct size))
- (vct-set! d0 0 1.0)
- (set! dcopy (vct-copy d0))
+ (set! d0 (make-float-vector size))
+ (set! (d0 0) 1.0)
+ (set! dcopy (copy d0))
(set! d1 (snd-spectrum d0 rectangular-window size))
(if (not (vequal d0 dcopy)) (snd-display #__line__ ";snd-spectrum not in-place? ~A ~A" d0 dcopy)))
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i (/ size 2))))
- (if (fneq (vct-ref d1 i) 1.0)
+ (if (fneq (d1 i) 1.0)
(begin
- (snd-display #__line__ ";snd-spectrum (1.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum (1.0) [~D: ~D]: ~A?" i size (d1 i))
(set! happy #f)))))
- (set! d0 (make-vct size 1.0))
+ (set! d0 (make-float-vector size 1.0))
(set! d1 (snd-spectrum d0 rectangular-window))
- (if (fneq (vct-ref d1 0) 1.0)
- (snd-display #__line__ ";snd-spectrum back (1.0 ~D): ~A?" size (vct-ref d1 0)))
+ (if (fneq (d1 0) 1.0)
+ (snd-display #__line__ ";snd-spectrum back (1.0 ~D): ~A?" size (d1 0)))
(let ((happy #t))
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((or (not happy) (= i (/ size 2))))
- (if (fneq (vct-ref d1 i) 0.0)
+ (if (fneq (d1 i) 0.0)
(begin
- (snd-display #__line__ ";snd-spectrum (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum (0.0) [~D: ~D]: ~A?" i size (d1 i))
(set! happy #f)))))
- (set! d0 (make-vct size))
- (vct-set! d0 0 1.0)
+ (set! d0 (make-float-vector size))
+ (set! (d0 0) 1.0)
(set! d1 (snd-spectrum d0 rectangular-window size #f)) ; dB (0.0 = max)
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i (/ size 2))))
- (if (fneq (vct-ref d1 i) 0.0)
+ (if (fneq (d1 i) 0.0)
(begin
- (snd-display #__line__ ";snd-spectrum dB (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum dB (0.0) [~D: ~D]: ~A?" i size (d1 i))
(set! happy #f)))))
- (set! d0 (make-vct size 1.0))
+ (set! d0 (make-float-vector size 1.0))
(set! d1 (snd-spectrum d0 rectangular-window size #f))
- (if (fneq (vct-ref d1 0) 0.0)
- (snd-display #__line__ ";snd-spectrum dB back (0.0 ~D): ~A?" size (vct-ref d1 0)))
+ (if (fneq (d1 0) 0.0)
+ (snd-display #__line__ ";snd-spectrum dB back (0.0 ~D): ~A?" size (d1 0)))
(let ((happy #t))
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((or (not happy) (= i (/ size 2))))
- (if (fneq (vct-ref d1 i) -90.0) ; currently ignores min-dB (snd-sig.c 5023)
+ (if (fneq (d1 i) -90.0) ; currently ignores min-dB (snd-sig.c 5023)
(begin
- (snd-display #__line__ ";snd-spectrum dB (1.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum dB (1.0) [~D: ~D]: ~A?" i size (d1 i))
(set! happy #f)))))
(let ((dcopy #f))
- (set! d0 (make-vct size))
- (vct-set! d0 0 1.0)
- (set! dcopy (vct-copy d0))
+ (set! d0 (make-float-vector size))
+ (set! (d0 0) 1.0)
+ (set! dcopy (copy d0))
(set! d1 (snd-spectrum d0 rectangular-window size #t 1.0 #t)) ; in-place
(if (vequal d0 dcopy) (snd-display #__line__ ";snd-spectrum in-place? ~A ~A" d0 dcopy))
(if (not (vequal d0 d1)) (snd-display #__line__ ";snd-spectrum returns in-place? ~A ~A" d0 d1)))
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i (/ size 2))))
- (if (fneq (vct-ref d1 i) 1.0)
+ (if (fneq (d1 i) 1.0)
(begin
- (snd-display #__line__ ";snd-spectrum (1.0 #t) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum (1.0 #t) [~D: ~D]: ~A?" i size (d1 i))
(set! happy #f)))))
(let ((dcopy #f))
- (set! d0 (make-vct size))
- (vct-set! d0 0 1.0)
- (set! dcopy (vct-copy d0))
+ (set! d0 (make-float-vector size))
+ (set! (d0 0) 1.0)
+ (set! dcopy (copy d0))
(set! d1 (snd-spectrum d0 rectangular-window size #f 1.0 #t)) ; in-place dB
(if (vequal d0 dcopy) (snd-display #__line__ ";snd-spectrum dB in-place? ~A ~A" d0 dcopy))
(if (not (vequal d0 d1)) (snd-display #__line__ ";snd-spectrum dB returns in-place? ~A ~A" d0 d1)))
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i (/ size 2))))
- (if (fneq (vct-ref d1 i) 0.0)
+ (if (fneq (d1 i) 0.0)
(begin
- (snd-display #__line__ ";snd-spectrum dB (1.0 #t) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum dB (1.0 #t) [~D: ~D]: ~A?" i size (d1 i))
(set! happy #f)))))
- (set! d0 (make-vct size 1.0))
+ (set! d0 (make-float-vector size 1.0))
(set! d1 (snd-spectrum d0 rectangular-window size #t 0.0 #f #f)) ; linear (in-place) not normalized
- (if (fneq (vct-ref d1 0) size) (snd-display #__line__ ";snd-spectrum no norm 0: ~A" d1))
+ (if (fneq (d1 0) size) (snd-display #__line__ ";snd-spectrum no norm 0: ~A" d1))
(let ((happy #t))
- (do ((i 1 (+ 1 i)))
+ (do ((i 1 (+ i 1)))
((or (not happy) (= i (/ size 2))))
- (if (fneq (vct-ref d1 i) 0.0)
+ (if (fneq (d1 i) 0.0)
(begin
- (snd-display #__line__ ";snd-spectrum no norm (0.0) [~D: ~D]: ~A?" i size (vct-ref d1 i))
+ (snd-display #__line__ ";snd-spectrum no norm (0.0) [~D: ~D]: ~A?" i size (d1 i))
(set! happy #f)))))
- (set! d0 (make-vct size 1.0))
+ (set! d0 (make-float-vector size 1.0))
(set! d1 (snd-spectrum d0 blackman2-window size))
- (if (and (not (vequal d1 (vct 1.000 0.721 0.293 0.091)))
- (not (vequal d1 (vct 1.000 0.647 0.173 0.037 0.024 0.016 0.011 0.005))))
+ (if (and (not (vequal d1 (float-vector 1.000 0.721 0.293 0.091)))
+ (not (vequal d1 (float-vector 1.000 0.647 0.173 0.037 0.024 0.016 0.011 0.005))))
(snd-display #__line__ ";blackman2 snd-spectrum: ~A~%" d1))
- (set! d0 (make-vct size 1.0))
+ (set! d0 (make-float-vector size 1.0))
(set! d1 (snd-spectrum d0 gaussian-window size #t 0.5))
- (if (and (not (vequal d1 (vct 1.000 0.900 0.646 0.328)))
- (not (vequal d1 (vct 1.000 0.870 0.585 0.329 0.177 0.101 0.059 0.028))))
+ (if (and (not (vequal d1 (float-vector 1.000 0.900 0.646 0.328)))
+ (not (vequal d1 (float-vector 1.000 0.870 0.585 0.329 0.177 0.101 0.059 0.028))))
(snd-display #__line__ ";gaussian 0.5 snd-spectrum: ~A~%" d1))
- (set! d0 (make-vct size 1.0))
+ (set! d0 (make-float-vector size 1.0))
(set! d1 (snd-spectrum d0 gaussian-window size #t 0.85))
- (if (and (not (vequal d1 (vct 1.000 0.924 0.707 0.383)))
- (not (vequal d1 (vct 1.000 0.964 0.865 0.725 0.566 0.409 0.263 0.128))))
+ (if (and (not (vequal d1 (float-vector 1.000 0.924 0.707 0.383)))
+ (not (vequal d1 (float-vector 1.000 0.964 0.865 0.725 0.566 0.409 0.263 0.128))))
(snd-display #__line__ ";gaussian 0.85 snd-spectrum: ~A~%" d1))
)
@@ -42824,130 +35737,117 @@ EDITS: 1
(for-each
(lambda (len)
- (let ((rl (make-vct len))
- (xrl (make-vct len))
+ (let ((rl (make-float-vector len))
+ (xrl (make-float-vector len))
(len2 (/ len 2)))
- (vct-fill! rl 1.0)
- (vct-fill! xrl 1.0)
+ (fill! rl 1.0)
+ (fill! xrl 1.0)
(snd-transform fourier-transform rl)
(snd-transform fourier-transform xrl #t)
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i len2)))
- (if (fneq (vct-ref rl i) (vct-ref xrl i))
+ (if (fneq (rl i) (xrl i))
(begin
- (snd-display #__line__ ";flat fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";flat fft: ~A at ~A: ~A ~A" len i (rl i) (xrl i))
(set! happy #f)))))
- (if (fneq (vct-ref rl 0) (* len len)) (snd-display #__line__ ";snd-transform ~A at 0: ~A" len (vct-ref rl 0)))
- (vct-set! rl 0 0.0)
- (if (> (vct-peak rl) .001) (snd-display #__line__ ";snd-transform ~A impulse: ~A" len (vct-peak rl)))))
+ (if (fneq (rl 0) (* len len)) (snd-display #__line__ ";snd-transform ~A at 0: ~A" len (rl 0)))
+ (set! (rl 0) 0.0)
+ (if (> (float-vector-peak rl) .001) (snd-display #__line__ ";snd-transform ~A impulse: ~A" len (float-vector-peak rl)))))
(list 16 128 512 1024))
(for-each
(lambda (len)
- (let ((rl (make-vct len))
- (xrl (make-vct len))
+ (let ((rl (make-float-vector len))
+ (xrl (make-float-vector len))
(len2 (/ len 2)))
- (vct-set! rl len2 1.0)
- (vct-set! xrl len2 1.0)
+ (set! (rl len2) 1.0)
+ (set! (xrl len2) 1.0)
(snd-transform fourier-transform rl)
(snd-transform fourier-transform xrl #t)
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i len2)))
- (if (fneq (vct-ref rl i) (vct-ref xrl i))
+ (if (fneq (rl i) (xrl i))
(begin
- (snd-display #__line__ ";impulse fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";impulse fft: ~A at ~A: ~A ~A" len i (rl i) (xrl i))
(set! happy #f)))))
- (if (fneq (vct-ref rl 0) 1.0) (snd-display #__line__ ";flat ~A at 0: ~A" len (vct-ref rl 0)))))
+ (if (fneq (rl 0) 1.0) (snd-display #__line__ ";flat ~A at 0: ~A" len (rl 0)))))
(list 16 128 512 1024))
(for-each
(lambda (len)
- (let ((rl (make-vct len))
- (xrl (make-vct len))
- (len2 (/ len 2)))
- (do ((i 0 (+ 1 i)))
+ (let ((rl (make-float-vector len))
+ (xrl (make-float-vector len)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((val (random 1.0)))
- (vct-set! rl i val)
- (vct-set! xrl i val)))
+ (float-vector-set! rl i (random 1.0)))
+ (copy rl xrl)
(snd-transform fourier-transform rl)
- (vct-scale! rl (/ 1.0 len))
+ (float-vector-scale! rl (/ 1.0 len))
(snd-transform fourier-transform xrl #t)
- (vct-scale! xrl (/ 1.0 len))
- (let ((happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i len2)))
- (if (fneq (vct-ref rl i) (vct-ref xrl i))
- (begin
- (snd-display #__line__ ";random fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
- (set! happy #f)))))))
+ (float-vector-scale! xrl (/ 1.0 len))
+ (if (not (vequal rl xrl))
+ (snd-display #__line__ ";random fft: ~A: ~A ~A" len rl xrl))))
(list 16 128 512 1024 4096))
(for-each
(lambda (len)
- (let ((rl (make-vct len))
- (xrl (make-vct len))
- (len2 (/ len 2)))
- (do ((i 0 (+ 1 i)))
+ (let ((rl (make-float-vector len))
+ (xrl (make-float-vector len))
+ (g (make-oscil (/ 220500.0 len))))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((val (sin (/ (* 2.0 10 pi i) len))))
- (vct-set! rl i val)
- (vct-set! xrl i val)))
+ (float-vector-set! rl i (oscil g)))
+ (copy rl xrl)
(snd-transform fourier-transform rl)
- (vct-scale! rl (/ 1.0 len))
+ (float-vector-scale! rl (/ 1.0 len))
(snd-transform fourier-transform xrl #t)
- (vct-scale! xrl (/ 1.0 len))
- (let ((happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i len2)))
- (if (fneq (vct-ref rl i) (vct-ref xrl i))
- (begin
- (snd-display #__line__ ";random fft: ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
- (set! happy #f)))))))
+ (float-vector-scale! xrl (/ 1.0 len))
+ (if (not (vequal rl xrl))
+ (snd-display #__line__ ";random fft: ~A: ~A ~A" len rl xrl))))
(list 16 128 512 1024 4096))
;; -------- autocorrelation
- (let ((rl (make-vct 16 0.0)))
- (vct-set! rl 0 1.0)
+ (let ((rl (make-float-vector 16 0.0)))
+ (set! (rl 0) 1.0)
(autocorrelate rl)
- (if (not (vequal rl (vct 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (vequal rl (float-vector 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display #__line__ ";autocorrelate 1: ~A" rl)))
- (let ((rl (make-vct 16 0.0)))
- (vct-set! rl 0 1.0)
- (vct-set! rl 1 -1.0)
+ (let ((rl (make-float-vector 16 0.0)))
+ (set! (rl 0) 1.0)
+ (set! (rl 1) -1.0)
(autocorrelate rl)
- (if (not (vequal rl (vct 2 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (vequal rl (float-vector 2 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display #__line__ ";autocorrelate 1 -1: ~A" rl)))
- (let ((rl (make-vct 16 0.0)))
- (vct-set! rl 0 1.0)
- (vct-set! rl 4 -1.0)
+ (let ((rl (make-float-vector 16 0.0)))
+ (set! (rl 0) 1.0)
+ (set! (rl 4) -1.0)
(autocorrelate rl)
- (if (not (vequal rl (vct 2 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0)))
+ (if (not (vequal rl (float-vector 2 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0)))
(snd-display #__line__ ";autocorrelate 1 0 0 0 -1: ~A" rl)))
- (let ((rl (make-vct 16))
- (rl1 (make-vct 16)))
- (do ((i 0 (+ 1 i)))
+ (let ((rl (make-float-vector 16))
+ (rl1 (make-float-vector 16)))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! rl i (- 8.0 i))
- (vct-set! rl1 i (vct-ref rl i)))
- (let ((nr (vct-subseq (corr rl rl 16 16) 0 15)))
+ (set! (rl i) (- 8.0 i)))
+ (copy rl rl1)
+ (let ((nr (float-vector-subseq (corr rl rl 16 16) 0 15)))
(autocorrelate rl1)
(if (not (vequal rl1 nr))
(snd-display #__line__ ";autocorrelate/corr (ramp):~%; ~A~%; ~A" rl1 nr))))
- (let ((rl (make-vct 16))
- (rl1 (make-vct 16)))
- (do ((i 0 (+ 1 i)))
+ (let ((rl (make-float-vector 16))
+ (rl1 (make-float-vector 16)))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! rl i (- 1.0 (random 2.0)))
- (vct-set! rl1 i (vct-ref rl i)))
- (let ((nr (vct-subseq (corr rl rl 16 16) 0 15)))
+ (set! (rl i) (- 1.0 (random 2.0))))
+ (copy rl rl1)
+ (let ((nr (float-vector-subseq (corr rl rl 16 16) 0 15)))
(autocorrelate rl1)
(if (not (vequal rl1 nr))
(snd-display #__line__ ";autocorrelate/corr:~%; ~A~%; ~A" rl1 nr))))
@@ -42969,283 +35869,273 @@ EDITS: 1
(close-sound ind0)
(close-sound ind1))
- (let ((v1 (make-vct 16))
- (v2 (make-vct 16))
- (v3 (make-vct 16))
- (v4 (make-vct 16)))
- (vct-set! v1 0 1.0)
- (vct-set! v2 3 1.0)
- (vct-set! v3 0 1.0)
- (vct-set! v4 3 1.0)
+ (let ((v1 (make-float-vector 16))
+ (v2 (make-float-vector 16))
+ (v3 (make-float-vector 16))
+ (v4 (make-float-vector 16)))
+ (set! (v1 0) 1.0)
+ (set! (v2 3) 1.0)
+ (set! (v3 0) 1.0)
+ (set! (v4 3) 1.0)
(set! v1 (cross-correlate-3 v1 v2 16))
(set! v3 (correlate v3 v4))
(if (not (vequal v1 v3))
(snd-display #__line__ ";correlate 16:~%; ~A~%; ~A" v1 v3)))
- (let ((v1 (make-vct 128))
- (v2 (make-vct 128))
- (v3 (make-vct 128))
- (v4 (make-vct 128)))
- (vct-set! v1 0 1.0)
- (vct-set! v2 32 1.0)
- (vct-set! v3 0 1.0)
- (vct-set! v4 32 1.0)
+ (let ((v1 (make-float-vector 128))
+ (v2 (make-float-vector 128))
+ (v3 (make-float-vector 128))
+ (v4 (make-float-vector 128)))
+ (set! (v1 0) 1.0)
+ (set! (v2 32) 1.0)
+ (set! (v3 0) 1.0)
+ (set! (v4 32) 1.0)
(set! v1 (cross-correlate-3 v1 v2 128))
(set! v3 (correlate v3 v4))
(if (not (vequal v1 v3))
(snd-display #__line__ ";correlate 128:~%; ~A~%; ~A" v1 v3)))
- (let ((v1 (make-vct 128))
- (v2 (make-vct 128))
+ (let ((v1 (make-float-vector 128))
+ (v2 (make-float-vector 128))
(v3 #f)
(v4 #f))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 128))
- (vct-set! v1 i (- 5.0 (random 10.0)))
- (vct-set! v2 i (- 0.5 (random 1.0))))
- (set! v3 (vct-copy v1))
- (set! v4 (vct-copy v2))
+ (float-vector-set! v1 i (mus-random 5.0))
+ (float-vector-set! v2 i (mus-random 0.5)))
+ (set! v3 (copy v1))
+ (set! v4 (copy v2))
(set! v1 (cross-correlate-3 v1 v2 128))
(set! v3 (correlate v3 v4))
(if (not (vequal v1 v3))
(snd-display #__line__ ";correlate 128 at random:~%; ~A~%; ~A" v1 v3)))
- (let ((v1 (make-vct 16))
- (v2 (make-vct 16)))
- (vct-set! v1 3 1.0)
- (vct-set! v2 3 1.0)
- (set! v1 (correlate v1 (vct-copy v1)))
+ (let ((v1 (make-float-vector 16))
+ (v2 (make-float-vector 16)))
+ (set! (v1 3) 1.0)
+ (set! (v2 3) 1.0)
+ (set! v1 (correlate v1 (copy v1)))
(set! v2 (autocorrelate v2))
(if (not (vequal v1 v2))
(snd-display #__line__ ";auto/correlate 16:~%; ~A~%; ~A" v1 v2)))
(for-each
(lambda (len)
- (let ((rl (make-vct len))
- (rla (make-vct len))
- (xim (make-vct len))
- (xrl (make-vct len))
+ (let ((rl (make-float-vector len))
+ (rla (make-float-vector len))
+ (xim (make-float-vector len))
+ (xrl (make-float-vector len))
(len2 (/ len 2)))
- (vct-set! rl 0 1.0)
- (vct-set! rl 4 1.0)
+ (set! (rl 0) 1.0)
+ (set! (rl 4) 1.0)
(snd-transform autocorrelation rl 0) ; this is exactly the same as (autocorrelate rl)
- (if (fneq (vct-ref rl 0) 2.0) (snd-display #__line__ ";autocorrelation ~A 0: ~A" len (vct-ref rl 0)))
- (if (fneq (vct-ref rl 4) 1.0) (snd-display #__line__ ";autocorrelation ~A 4: ~A" len (vct-ref rl 4)))
+ (if (fneq (rl 0) 2.0) (snd-display #__line__ ";autocorrelation ~A 0: ~A" len (rl 0)))
+ (if (fneq (rl 4) 1.0) (snd-display #__line__ ";autocorrelation ~A 4: ~A" len (rl 4)))
- (vct-set! rla 0 1.0)
- (vct-set! rla 4 1.0)
+ (set! (rla 0) 1.0)
+ (set! (rla 4) 1.0)
(autocorrelate rla)
- (if (fneq (vct-ref rla 0) 2.0) (snd-display #__line__ ";autocorrelate ~A 0: ~A" len (vct-ref rla 0)))
- (if (fneq (vct-ref rla 4) 1.0) (snd-display #__line__ ";autocorrelate ~A 4: ~A" len (vct-ref rla 4)))
+ (if (fneq (rla 0) 2.0) (snd-display #__line__ ";autocorrelate ~A 0: ~A" len (rla 0)))
+ (if (fneq (rla 4) 1.0) (snd-display #__line__ ";autocorrelate ~A 4: ~A" len (rla 4)))
- (vct-set! xrl 0 1.0)
- (vct-set! xrl 4 1.0)
+ (set! (xrl 0) 1.0)
+ (set! (xrl 4) 1.0)
(mus-fft xrl xim len 1)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (vct-set! xrl i (+ (* (vct-ref xrl i) (vct-ref xrl i)) (* (vct-ref xim i) (vct-ref xim i)))))
- (vct-scale! xim 0.0)
+ (set! (xrl i) (+ (* (xrl i) (xrl i)) (* (xim i) (xim i)))))
+ (float-vector-scale! xim 0.0)
(mus-fft xrl xim len -1)
- (vct-scale! xrl (/ 1.0 len))
+ (float-vector-scale! xrl (/ 1.0 len))
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i len2)))
- (if (fneq (vct-ref rl i) (vct-ref xrl i))
+ (if (fneq (rl i) (xrl i))
(begin
- (snd-display #__line__ ";mus-fft? ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";mus-fft? ~A at ~A: ~A ~A" len i (rl i) (xrl i))
(set! happy #f)))))
- (vct-set! rl 0 0.0)
- (vct-set! rl 4 0.0)
- (do ((i (/ len 2) (+ 1 i)))
- ((= i len))
- (vct-set! rl i 0.0))
- (if (> (vct-peak rl) .001) (snd-display #__line__ ";autocorrelate peak: ~A" (vct-peak rl)))))
+ (set! (rl 0) 0.0)
+ (set! (rl 4) 0.0)
+ (fill! rl 0.0 (/ len 2) len)
+ (if (> (float-vector-peak rl) .001) (snd-display #__line__ ";autocorrelate peak: ~A" (float-vector-peak rl)))))
(list 16 64 256 512))
(for-each
(lambda (len)
- (let* ((rl (make-vct len))
- (xim (make-vct len))
- (xrl (make-vct len))
+ (let* ((rl (make-float-vector len))
+ (xim (make-float-vector len))
+ (xrl (make-float-vector len))
(len2 (/ len 2))
(ones (max 2 (random len2))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i ones))
(let ((val (random 1.0))
(ind (random len)))
- (vct-set! rl ind val)
- (vct-set! xrl ind val)))
+ (set! (rl ind) val)
+ (set! (xrl ind) val)))
(snd-transform autocorrelation rl 0)
(mus-fft xrl xim len 1)
- (vct-set! xrl 0 (* (vct-ref xrl 0) (vct-ref xrl 0)))
- (vct-set! xrl len2 (* (vct-ref xrl len2) (vct-ref xrl len2)))
- (do ((i 1 (+ 1 i))
+ (set! (xrl 0) (* (xrl 0) (xrl 0)))
+ (set! (xrl len2) (* (xrl len2) (xrl len2)))
+ (do ((i 1 (+ i 1))
(j (- len 1) (- j 1)))
((= i len2))
- (vct-set! xrl i (+ (* (vct-ref xrl i) (vct-ref xrl i)) (* (vct-ref xim j) (vct-ref xim j))))
- (vct-set! xrl j (vct-ref xrl i)))
- (vct-scale! xim 0.0)
+ (set! (xrl i) (+ (* (xrl i) (xrl i)) (* (xim j) (xim j))))
+ (set! (xrl j) (xrl i)))
+ (float-vector-scale! xim 0.0)
(mus-fft xrl xim len -1)
- (vct-scale! xrl (/ 1.0 len))
+ (float-vector-scale! xrl (/ 1.0 len))
(let ((happy #t))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i len2)))
- (if (fneq (vct-ref rl i) (vct-ref xrl i))
+ (if (fneq (rl i) (xrl i))
(begin
- (snd-display #__line__ ";random ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
+ (snd-display #__line__ ";random ~A at ~A: ~A ~A" len i (rl i) (xrl i))
(set! happy #f)))))))
(list 16 64 256 512))
;; -------- cepstrum
;; these values from Octave real(ifft(log(abs(fft(x)))))
- (let ((rl (make-vct 16))
+ (let ((rl (make-float-vector 16))
(lst '( 0.423618 0.259318 -0.048365 1.140571 -0.811856 -0.994098 -0.998613 -2.453642
-0.438549 -1.520463 -0.312065 -0.724707 1.154010 1.466936 0.110463 -1.520854)))
- (do ((i 0 (+ 1 i))) ((= i 16)) (vct-set! rl i (list-ref lst i)))
- (let ((nrl (vct-scale! (snd-transform cepstrum rl 0) 1.399)))
- (if (not (vequal nrl (vct 1.3994950 0.1416877 0.0952407 0.0052814 -0.0613192 0.0082986 -0.0233993
+ (do ((i 0 (+ i 1))) ((= i 16)) (set! (rl i) (lst i)))
+ (let ((nrl (float-vector-scale! (snd-transform cepstrum rl 0) 1.399)))
+ (if (not (vequal nrl (float-vector 1.3994950 0.1416877 0.0952407 0.0052814 -0.0613192 0.0082986 -0.0233993
-0.0476585 0.0259498 -0.0476585 -0.0233993 0.0082986 -0.0613192 0.0052814
0.0952407 0.1416877)))
(snd-display #__line__ ";cepstrum 16: ~A" nrl))))
- (let ((rl (make-vct 16)))
- (do ((i 0 (+ 1 i))) ((= i 16)) (vct-set! rl i i))
- (let ((nrl (vct-scale! (snd-transform cepstrum rl 0) 2.72)))
- (if (not (vequal nrl (vct 2.720 0.452 0.203 0.122 0.082 0.061 0.048 0.041 0.039 0.041 0.048 0.061 0.082 0.122 0.203 0.452)))
+ (let ((rl (make-float-vector 16)))
+ (do ((i 0 (+ i 1))) ((= i 16)) (set! (rl i) i))
+ (let ((nrl (float-vector-scale! (snd-transform cepstrum rl 0) 2.72)))
+ (if (not (vequal nrl (float-vector 2.720 0.452 0.203 0.122 0.082 0.061 0.048 0.041 0.039 0.041 0.048 0.061 0.082 0.122 0.203 0.452)))
(snd-display #__line__ ";cepstrum 16 by ones: ~A" nrl))))
(for-each
(lambda (len)
- (let ((rl (make-vct len))
- (xim (make-vct len))
- (xrl (make-vct len)))
- (vct-set! rl 0 1.0)
- (vct-set! rl 4 1.0)
+ (let ((rl (make-float-vector len))
+ (xim (make-float-vector len))
+ (xrl (make-float-vector len)))
+ (set! (rl 0) 1.0)
+ (set! (rl 4) 1.0)
(snd-transform cepstrum rl 0)
- (vct-set! xrl 0 1.0)
- (vct-set! xrl 4 1.0)
+ (set! (xrl 0) 1.0)
+ (set! (xrl 4) 1.0)
(mus-fft xrl xim len 1)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((val (+ (* (vct-ref xrl i) (vct-ref xrl i)) (* (vct-ref xim i) (vct-ref xim i)))))
+ (let ((val (+ (* (xrl i) (xrl i)) (* (xim i) (xim i)))))
(if (> val .0000001)
(set! val (log (sqrt val)))
(set! val -10.0))
- (vct-set! xrl i val)))
- (vct-scale! xim 0.0)
+ (set! (xrl i) val)))
+ (float-vector-scale! xim 0.0)
(mus-fft xrl xim len -1)
- (let ((fscl 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (set! fscl (max fscl (abs (vct-ref xrl i)))))
- (vct-scale! xrl (/ 1.0 fscl)))
- (let ((happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i len)))
- (if (fneq (vct-ref rl i) (vct-ref xrl i))
- (begin
- (snd-display #__line__ ";mus-fft?? ~A at ~A: ~A ~A" len i (vct-ref rl i) (vct-ref xrl i))
- (set! happy #f)))))))
+ (let ((fscl (float-vector-peak xrl)))
+ (float-vector-scale! xrl (/ 1.0 fscl)))
+ (if (not (vequal rl xrl))
+ (snd-display #__line__ ";mus-fft?? ~A: ~A ~A" len rl xrl))))
(list 16 64 256 512))
;; -------- walsh
- (set! d0 (make-vct 8))
- (vct-set! d0 0 1.0)
+ (set! d0 (make-float-vector 8))
+ (set! (d0 0) 1.0)
(snd-transform walsh-transform d0)
- (if (not (vequal d0 (vct 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
+ (if (not (vequal d0 (float-vector 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000)))
(snd-display #__line__ ";walsh 1: ~A" d0))
(snd-transform walsh-transform d0)
- (if (not (vequal d0 (vct 8.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal d0 (float-vector 8.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";walsh -1: ~A" d0))
- (set! d0 (make-vct 8))
- (vct-set! d0 1 1.0)
+ (set! d0 (make-float-vector 8))
+ (set! (d0 1) 1.0)
(snd-transform walsh-transform d0)
- (if (not (vequal d0 (vct 1.000 -1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
+ (if (not (vequal d0 (float-vector 1.000 -1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000)))
(snd-display #__line__ ";walsh 2: ~A" d0))
(snd-transform walsh-transform d0)
- (if (not (vequal d0 (vct 0.000 8.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal d0 (float-vector 0.000 8.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";walsh -2: ~A" d0))
- (set! d0 (make-vct 8))
- (vct-set! d0 1 1.0)
- (vct-set! d0 0 0.5)
+ (set! d0 (make-float-vector 8))
+ (set! (d0 1) 1.0)
+ (set! (d0 0) 0.5)
(snd-transform walsh-transform d0)
- (if (not (vequal d0 (vct 1.500 -0.500 1.500 -0.500 1.500 -0.500 1.500 -0.500)))
+ (if (not (vequal d0 (float-vector 1.500 -0.500 1.500 -0.500 1.500 -0.500 1.500 -0.500)))
(snd-display #__line__ ";walsh 3: ~A" d0))
(snd-transform walsh-transform d0)
- (if (not (vequal d0 (vct 4.000 8.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal d0 (float-vector 4.000 8.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";walsh -3: ~A" d0))
- (set! d0 (make-vct 8))
- (vct-map! d0 (lambda () (random 1.0)))
- (set! d1 (vct-copy d0))
+ (set! d0 (make-float-vector 8))
+ (fill-float-vector d0 (random 1.0))
+ (set! d1 (copy d0))
(snd-transform walsh-transform d0)
(snd-transform walsh-transform d0)
- (vct-scale! d0 (/ 1.0 8.0))
+ (float-vector-scale! d0 (/ 1.0 8.0))
(if (not (vequal d0 d1))
(snd-display #__line__ ";walsh 4: ~A ~A" d0 d1))
- (set! d0 (vct 1 1 1 -1 1 1 1 -1 1 1 1 -1 -1 -1 -1 1))
+ (set! d0 (float-vector 1 1 1 -1 1 1 1 -1 1 1 1 -1 -1 -1 -1 1))
(set! d1 (snd-transform walsh-transform d0))
- (if (not (vequal d1 (vct 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 -4.00 -4.00 -4.00 4.00)))
+ (if (not (vequal d1 (float-vector 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 4.00 4.00 4.00 -4.00 -4.00 -4.00 -4.00 4.00)))
(snd-display #__line__ ";walsh 5: ~A" d1))
- (set! d0 (vct 1 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0))
+ (set! d0 (float-vector 1 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0))
(set! d1 (snd-transform walsh-transform d0))
- (if (not (vequal d1 (vct 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000)))
+ (if (not (vequal d1 (float-vector 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000 0.000 2.000 2.000 0.000)))
(snd-display #__line__ ";walsh 6: ~A" d1))
- (set! d0 (vct 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612 0.006 -0.613 0.334 -0.111 -0.821 0.130 0.030 -0.229 0.170))
+ (set! d0 (float-vector 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612 0.006 -0.613 0.334 -0.111 -0.821 0.130 0.030 -0.229 0.170))
(set! d1 (snd-transform walsh-transform d0))
- (if (not (vequal d1 (vct -3.122 -0.434 2.940 -0.468 -3.580 2.716 -0.178 -1.386 -0.902 0.638 1.196 1.848 -0.956 2.592 -1.046 2.926)))
+ (if (not (vequal d1 (float-vector -3.122 -0.434 2.940 -0.468 -3.580 2.716 -0.178 -1.386 -0.902 0.638 1.196 1.848 -0.956 2.592 -1.046 2.926)))
(snd-display #__line__ ";walsh 7: ~A" d1))
;; -------- haar
- (set! d0 (make-vct 8))
- (vct-set! d0 2 1.0)
+ (set! d0 (make-float-vector 8))
+ (set! (d0 2) 1.0)
(snd-transform haar-transform d0)
- (if (not (vequal d0 (vct 0.354 0.354 -0.500 0.000 0.000 0.707 0.000 0.000)))
+ (if (not (vequal d0 (float-vector 0.354 0.354 -0.500 0.000 0.000 0.707 0.000 0.000)))
(snd-display #__line__ ";haar 1: ~A" d0))
(inverse-haar d0)
- (if (not (vequal d0 (vct 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal d0 (float-vector 0.000 0.000 1.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";inverse haar 1: ~A" d0))
- (set! d0 (make-vct 8))
- (vct-set! d0 0 1.0)
+ (set! d0 (make-float-vector 8))
+ (set! (d0 0) 1.0)
(snd-transform haar-transform d0)
- (if (not (vequal d0 (vct 0.354 0.354 0.500 0.000 0.707 0.000 0.000 0.000)))
+ (if (not (vequal d0 (float-vector 0.354 0.354 0.500 0.000 0.707 0.000 0.000 0.000)))
(snd-display #__line__ ";haar 2: ~A" d0))
(inverse-haar d0)
- (if (not (vequal d0 (vct 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal d0 (float-vector 1.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";inverse haar 2: ~A" d0))
- (set! d0 (snd-transform haar-transform (vct -0.483 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612)))
- (if (not (vequal d0 (vct -0.884 -0.349 0.563 -0.462 -0.465 -0.230 -0.648 0.925)))
+ (set! d0 (snd-transform haar-transform (float-vector -0.483 0.174 -0.880 -0.555 -0.879 0.038 0.696 -0.612)))
+ (if (not (vequal d0 (float-vector -0.884 -0.349 0.563 -0.462 -0.465 -0.230 -0.648 0.925)))
(snd-display #__line__ ";haar 3: ~A" d0))
;; from "A Primer on Wavelets"
(let ((sq2 (sqrt 2.0)))
- (set! d0 (snd-transform haar-transform (vct 4 6 10 12 8 6 5 5)))
- (if (not (vequal d0 (vct (* 14 sq2) (* 2 sq2) -6 2 (- sq2) (- sq2) sq2 0)))
+ (set! d0 (snd-transform haar-transform (float-vector 4 6 10 12 8 6 5 5)))
+ (if (not (vequal d0 (float-vector (* 14 sq2) (* 2 sq2) -6 2 (- sq2) (- sq2) sq2 0)))
(snd-display #__line__ ";haar 4: ~A" d0))
- (set! d0 (snd-transform haar-transform (vct 2 4 6 8 10 12 14 16)))
- (if (not (vequal d0 (vct (* 18 sq2) (* -8 sq2) -4 -4 (- sq2) (- sq2) (- sq2) (- sq2))))
+ (set! d0 (snd-transform haar-transform (float-vector 2 4 6 8 10 12 14 16)))
+ (if (not (vequal d0 (float-vector (* 18 sq2) (* -8 sq2) -4 -4 (- sq2) (- sq2) (- sq2) (- sq2))))
(snd-display #__line__ ";haar 5: ~A" d0)))
- (set! d0 (make-vct 8))
- (set! d1 (make-vct 8))
- (do ((i 0 (+ 1 i)))
+ (set! d0 (make-float-vector 8))
+ (set! d1 (make-float-vector 8))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! d0 i (random 1.0))
- (vct-set! d1 i (vct-ref d0 i)))
+ (float-vector-set! d0 i (random 1.0)))
+ (copy d0 d1)
(snd-transform haar-transform d0)
(inverse-haar d0)
(if (not (vequal d0 d1))
@@ -43255,63 +36145,61 @@ EDITS: 1
;; --------- wavelet
;; test against fxt output
- (set! d0 (snd-transform wavelet-transform (vct 1 1 0 0 0 0 0 0) 0)) ;"daub4"
- (if (not (vequal d0 (vct 0.625 0.375 -0.217 1.083 -0.354 0.000 0.000 0.354)))
+ (set! d0 (snd-transform wavelet-transform (float-vector 1 1 0 0 0 0 0 0) 0)) ;"daub4"
+ (if (not (vequal d0 (float-vector 0.625 0.375 -0.217 1.083 -0.354 0.000 0.000 0.354)))
(snd-display #__line__ ";fxt wavelet 1: ~A" d0))
(for-each
(lambda (size)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (let ((d1 (make-vct size))
- (d2 (make-vct size)))
- (vct-set! d1 2 1.0)
- (vct-set! d2 2 1.0)
- (wavelet d1 size 0 pwt (list-ref wts i))
+ (let ((d1 (make-float-vector size))
+ (d2 (make-float-vector size)))
+ (set! (d1 2) 1.0)
+ (set! (d2 2) 1.0)
+ (wavelet d1 size 0 pwt (wts i))
(snd-transform wavelet-transform d2 i)
(if (not (vequal d1 d2))
(snd-display #__line__ ";wavelet ~D: ~A ~A" i d1 d2))
- (wavelet d2 size -1 pwt (list-ref wts i))
- (vct-fill! d1 0.0)
- (vct-set! d1 2 1.0)
+ (wavelet d2 size -1 pwt (wts i))
+ (fill! d1 0.0)
+ (set! (d1 2) 1.0)
(if (not (vequal d1 d2))
(if (or (= i 9) (= i 10))
(begin
- (vct-set! d2 2 0.0)
- (if (> (vct-peak d2) .1)
+ (set! (d2 2) 0.0)
+ (if (> (float-vector-peak d2) .1)
(snd-display #__line__ ";inverse wavelet ~D: ~A ~A" i d1 d2)))
(if (> i 14)
- (let ((pk (vct-ref d2 2)))
- (vct-set! d2 2 0.0)
- (if (> (vct-peak d2) pk)
+ (let ((pk (d2 2)))
+ (set! (d2 2) 0.0)
+ (if (> (float-vector-peak d2) pk)
(snd-display #__line__ ";inverse wavelet ~D: ~A ~A" i d1 d2)))
(snd-display #__line__ ";inverse wavelet ~D: ~A ~A" i d1 d2))))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 9))
(let ((d1 #f)
- (d2 (make-vct size)))
- (vct-map! d2 (lambda () (random 1.0)))
- (set! d1 (vct-copy d2))
+ (d2 (make-float-vector size)))
+ (fill-float-vector d2 (random 1.0))
+ (set! d1 (copy d2))
(snd-transform wavelet-transform d2 i)
- (wavelet d2 size -1 pwt (list-ref wts i))
+ (wavelet d2 size -1 pwt (wts i))
(if (not (vequal d1 d2))
(snd-display #__line__ ";random wavelet ~D: ~A ~A" i d1 d2)))))
(list 16 64))
- (set! (max-transform-peaks) 100)
+ (set! *max-transform-peaks* 100)
(let ((ind (open-sound "oboe.snd"))
(ftype (add-transform "low-pass" "filtered" 0.0 1.0
(lambda (len fd)
(let ((flt (make-fir-filter :order 8
- :xcoeffs (let ((v1 (make-vct 8)))
- (vct-fill! v1 .0125)
- v1))))
- (vct-map!
- (make-vct len)
- (lambda ()
- (fir-filter flt (read-sample fd)))))))))
+ :xcoeffs (let ((v1 (make-float-vector 8)))
+ (fill! v1 .0125)
+ v1)))
+ (v (make-float-vector len)))
+ (fill-float-vector v (fir-filter flt (read-sample fd))))))))
(if (not (transform? ftype)) (snd-display #__line__ ";transform added: ~A?" ftype))
- (set! (transform-normalization) dont-normalize)
+ (set! *transform-normalization* dont-normalize)
(set! (transform-type ind 0) ftype)
(set! (transform-size ind 0) 16)
(set! (transform-graph-type ind 0) graph-once)
@@ -43325,24 +36213,22 @@ EDITS: 1
(let ((ind (open-sound "oboe.snd"))
(ftype (add-transform "abs-it" "absit" 0.0 1.0
(lambda (len fd)
- (vct-map!
- (make-vct len)
- (lambda ()
- (read-sample fd)))))))
- (set! (transform-normalization) dont-normalize)
+ (let ((v (make-float-vector len)))
+ (fill-float-vector v (read-sample fd)))))))
+ (set! *transform-normalization* dont-normalize)
(set! (transform-type ind 0) ftype)
(set! (transform-size ind 0) 256)
(set! (transform-graph-type ind 0) graph-once)
(set! (transform-graph? ind 0) #t)
(set! (cursor ind 0) 12000)
- (let* ((samps (transform->vct ind 0))
- (orig (channel->vct (left-sample ind 0) 256))
- (happy #t))
- (do ((i 0 (+ 1 i)))
+ (let ((samps (transform->float-vector ind 0))
+ (orig (channel->float-vector (left-sample ind 0) 256))
+ (happy #t))
+ (do ((i 0 (+ i 1)))
((or (not happy) (= i 256)))
- (if (fneq (vct-ref samps i) (vct-ref orig i))
+ (if (fneq (samps i) (orig i))
(begin
- (snd-display #__line__ ";add-transform same (~A): ~D ~A ~A" ftype i (vct-ref samps i) (vct-ref orig i))
+ (snd-display #__line__ ";add-transform same (~A): ~D ~A ~A" ftype i (samps i) (orig i))
(set! happy #f)))))
(set! (dot-size ind 0) 60)
(set! (graph-style ind 0) graph-lollipops)
@@ -43356,18 +36242,16 @@ EDITS: 1
(snd-display #__line__ ";after delete-transform ~A -> ~A" ftype (transform-type ind 0)))
(close-sound ind))
-
(if (defined? 'bignum-fft)
(let ()
(define* (vectors-equal? v1 v2 (error 1e-30))
- (let ((len (vector-length v1)))
- (if (= (vector-length v2) len)
+ (let ((len (length v1)))
+ (and (= (length v2) len)
(let ((happy #t))
(do ((i 0 (+ i 1)))
((or (= i len) (not happy)) happy)
- (set! happy (< (magnitude (- (vector-ref v1 i) (vector-ref v2 i))) error))))
- #f)))
+ (set! happy (< (magnitude (- (vector-ref v1 i) (vector-ref v2 i))) error)))))))
(define* (bignum-vector :rest args)
(let* ((len (length args))
@@ -43378,74 +36262,75 @@ EDITS: 1
(if (bignum? (car arg))
(vector-set! v i (car arg))
(vector-set! v i (bignum (number->string (car arg))))))))
-
+
;; -------- -1 -1 at 1
(let ((rl (make-vector 8))
(im (make-vector 8)))
(do ((i 0 (+ i 1)))
((= i 8))
- (vector-set! rl i (bignum "0.0"))
- (vector-set! im i (bignum "0.0")))
- (vector-set! rl 1 (bignum "-1.0"))
- (vector-set! im 1 (bignum "-1.0"))
- (bignum-fft rl im 8) ; 3rd arg is size
+ (set! (rl i) (bignum "0.0"))
+ (set! (im i) (bignum "0.0")))
+ (set! (rl 1) (bignum "-1.0"))
+ (set! (im 1) (bignum "-1.0"))
+ (bignum-fft rl im 8) ; third arg is size
(let ((crl (bignum-vector -1.000 0.000 1.000 (sqrt (bignum "2")) 1.000 0.000 -1.000 (- (sqrt (bignum "2")))))
(cim (bignum-vector -1.000 (- (sqrt (bignum "2"))) -1.000 0.000 1.000 (sqrt (bignum "2")) 1.000 0.000)))
(if (or (not (vectors-equal? rl crl))
(not (vectors-equal? im cim)))
- (format #t "big-fft -1 -1 at 1:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim)))
+ (snd-display #__line__ ";big-fft -1 -1 at 1:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim)))
(bignum-fft rl im 8 -1)
(let ((crl (bignum-vector 0.0 -8.0 0.0 0.0 0.0 0.0 0.0 0.0))
(cim (bignum-vector 0.0 -8.0 0.0 0.0 0.0 0.0 0.0 0.0)))
(if (or (not (vectors-equal? rl crl))
(not (vectors-equal? im cim)))
- (format #t "big-fft -1 -1 at 1 inverse:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))
- (vector-set! rl 1 (bignum "-1.0"))
- (vector-set! im 1 (bignum "-1.0"))
+ (snd-display #__line__ ";big-fft -1 -1 at 1 inverse:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))
+ (set! (rl 1) (bignum "-1.0"))
+ (set! (im 1) (bignum "-1.0"))
(do ((i 0 (+ i 1)))
((= i 4))
(bignum-fft rl im 8))
- (vector-set! crl 1 (bignum "-64.0"))
- (vector-set! cim 1 (bignum "-64.0"))
+ (set! (crl 1) (bignum "-64.0"))
+ (set! (cim 1) (bignum "-64.0"))
(if (or (not (vectors-equal? rl crl))
(not (vectors-equal? im cim)))
- (format #t "big-fft -1 -1 at 1 rotate:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
+ (snd-display #__line__ ";big-fft -1 -1 at 1 rotate:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
;; -------- -1 1 at 3
(let ((rl (make-vector 8))
(im (make-vector 8)))
(do ((i 0 (+ i 1)))
((= i 8))
- (vector-set! rl i (bignum "0.0"))
- (vector-set! im i (bignum "0.0")))
- (vector-set! rl 3 (bignum "-1.0"))
- (vector-set! im 3 (bignum "1.0"))
+ (set! (rl i) (bignum "0.0"))
+ (set! (im i) (bignum "0.0")))
+ (set! (rl 3) (bignum "-1.0"))
+ (set! (im 3) (bignum "1.0"))
(bignum-fft rl im 8)
(let ((crl (bignum-vector -1.000 0.000 1.000 (- (sqrt (bignum "2"))) 1.000 0.000 -1.000 (sqrt (bignum "2"))))
(cim (bignum-vector 1.000 (- (sqrt (bignum "2"))) 1.000 0.000 -1.000 (sqrt (bignum "2")) -1.000 0.000)))
(if (or (not (vectors-equal? rl crl))
(not (vectors-equal? im cim)))
- (format #t "big-fft -1 1 at 3:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
+ (snd-display #__line__ ";big-fft -1 1 at 3:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
;; -------- 1 0 at 0 with bignum arg to make-vector (so it should copy)
(let ((rl (make-vector 8 (bignum "0.0")))
(im (make-vector 8 (bignum "0.0"))))
- (vector-set! rl 0 (bignum "1.0"))
+ (set! (rl 0) (bignum "1.0"))
(bignum-fft rl im 8)
(let ((crl (bignum-vector 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0))
(cim (bignum-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
(if (or (not (vectors-equal? rl crl))
(not (vectors-equal? im cim)))
- (format #t "big-fft 1 0 at 0 (and copied fill):~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
+ (snd-display #__line__ ";big-fft 1 0 at 0 (and copied fill):~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
;; -------- cos/sin
(let ((rl (make-vector 64))
(im (make-vector 64)))
(do ((i 0 (+ i 1)))
((= i 64))
- (vector-set! rl i (bignum "0.0"))
- (vector-set! im i (bignum "0.0")))
- (vector-set! rl 1 (bignum "1.0"))
+ (set! (rl i) (bignum "0.0"))
+ (set! (im i) (bignum "0.0")))
+ (set! (rl 1) (bignum "1.0"))
+
(bignum-fft rl im 64 -1)
(let ((happy #t))
(do ((i 0 (+ i 1)))
@@ -43455,7 +36340,7 @@ EDITS: 1
(set! happy (and (< cerr 1e-30)
(< serr 1e-30)))
(if (not happy)
- (format #t "big fft 1 at 0 (sin/cos) differs by ~A in ~A at ~A (~A ~A)~%"
+ (snd-display #__line__ ";big fft 1 at 0 (sin/cos) differs by ~A in ~A at ~A (~A ~A)~%"
(max cerr serr)
(if (> cerr serr) "cos" "sin")
i
@@ -43465,116 +36350,70 @@ EDITS: 1
(if (> cerr serr)
(vector-ref rl i)
(vector-ref im i)))))))
+
(bignum-fft rl im 64)
(let ((crl (make-vector 64 (bignum "0.0")))
(cim (make-vector 64 (bignum "0.0"))))
- (vector-set! crl 1 (bignum "64"))
+ (set! (crl 1) (bignum "64"))
(if (or (not (vectors-equal? rl crl))
(not (vectors-equal? im cim)))
- (format #t "big-fft 1 at 0 fill cos/sin inverse:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
+ (snd-display #__line__ ";big-fft 1 at 0 fill cos/sin inverse:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))))
;; -------- random
(let ((rl (make-vector 64))
(im (make-vector 64))
(crl (make-vector 64))
(cim (make-vector 64))
- (rs (make-random-state (bignum "12345678"))))
+ (rs (random-state (bignum "12345678"))))
(do ((i 0 (+ i 1)))
((= i 64))
- (vector-set! rl i (random (bignum "1.0") rs))
- (vector-set! crl i (+ (vector-ref rl i) 0.0)) ; try to force a copy
- (vector-set! im i (random (bignum "1.0") rs))
- (vector-set! cim i (+ (vector-ref im i) 0.0)))
+ (set! (rl i) (random (bignum "1.0") rs))
+ (set! (crl i) (+ (vector-ref rl i) 0.0)) ; try to force a copy
+ (set! (im i) (random (bignum "1.0") rs))
+ (set! (cim i) (+ (vector-ref im i) 0.0)))
+
(bignum-fft rl im 64 1)
(if (or (vectors-equal? rl crl)
(vectors-equal? im cim))
- (format #t "big-fft random not copied?:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))
+ (snd-display #__line__ ";big-fft random not copied?:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim))
+
(bignum-fft rl im 64 -1)
(do ((i 0 (+ i 1)))
((= i 64))
- (vector-set! rl i (/ (vector-ref rl i) 64.0))
- (vector-set! im i (/ (vector-ref im i) 64.0)))
+ (set! (rl i) (/ (vector-ref rl i) 64.0))
+ (set! (im i) (/ (vector-ref im i) 64.0)))
(if (or (not (vectors-equal? rl crl))
(not (vectors-equal? im cim)))
- (format #t "big-fft random:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim)))
+ (snd-display #__line__ ";big-fft random:~%rl: ~A~% ~A~%im: ~A~% ~A~%" rl crl im cim)))
))
- (if (defined? 'gsl-dht)
- (begin
- (add-transform "Hankel" "Hankel" 0.0 1.0
- (lambda (n rd)
- (let ((v (make-vct n)))
- (do ((i 0 (+ 1 i))) ((= i n)) (vct-set! v i (rd)))
- (gsl-dht n v 1.0 1.0)
- v)))
- (let* ((n 16)
- (v (make-vct n)))
- (do ((i 0 (+ 1 i))) ((= i n)) (vct-set! v i 1.0))
- (gsl-dht n v 1.0 1.0))
- (let ((tag (catch #t (lambda () (gsl-dht -1 (make-vct 3) 1.0 1.0)) (lambda args args))))
- (if (not (eq? (car tag) 'out-of-range)) (snd-display #__line__ ";gsl-dht bad size: ~A" tag)))))
-
- (if (defined? 'gsl-eigenvectors)
- (let ((vals (gsl-eigenvectors (make-mixer 4 -1.0 1.0 -1.0 1.0
- -8.0 4.0 -2.0 1.0
- 27.0 9.0 3.0 1.0
- 64.0 16.0 4.0 1.0))))
- (if (not (vequal (vector->vct (car vals)) (vct -6.41391102627093 5.54555349890946 5.54555349890946 2.32280402845201)))
- (snd-display #__line__ ";gsl-eigenvalues: ~A" (car vals)))
- (if (or (not (= (vector-length (cadr vals)) 4))
- (not (vequal (vector->vct (vector-ref (cadr vals) 0)) (vct -0.0998821746683654 -0.111251309674367 0.292500673281302 0.94450518972065)))
- (not (vequal (vector->vct (vector-ref (cadr vals) 1)) (vct -0.0434869537653505 0.0642376994169207 -0.515252756143484 -0.840592191366022)))
- (not (vequal (vector->vct (vector-ref (cadr vals) 2)) (vct -0.0434869537653505 0.0642376994169207 -0.515252756143484 -0.840592191366022)))
- (not (vequal (vector->vct (vector-ref (cadr vals) 3)) (vct -0.144932944248023 0.356601443087312 0.91936884368837 0.0811836295983152))))
- (snd-display #__line__ ";gsl eigenvectors: ~A" (cadr vals)))))
-
(let ((ind1 (open-sound "oboe.snd")))
(set! (time-graph-style ind1 0) graph-lollipops)
(graph->ps "aaa.eps")
(set! (transform-graph? ind1 0) #t)
(set! (transform-graph-type ind1 0) graph-as-sonogram)
- (set! (transform-size) 256)
+ (set! *transform-size* 256)
(update-transform-graph)
- (let ((size (transform-frames ind1 0)))
- (if (or (number? size)
- (not (= (length size) 3)))
- (snd-display #__line__ ";transform-frames of sonogram: ~A" size)))
+ (when with-gui
+ (let ((size (transform-framples ind1 0)))
+ (if (or (number? size)
+ (not (= (length size) 3)))
+ (snd-display #__line__ ";transform-framples of sonogram: ~A" size))))
(graph->ps "aaa.eps")
- (catch #t
- (lambda ()
- (let ((ax (axis-info ind1 0 transform-graph)))
- (if (not ax) (snd-display #__line__ ";axis-info transform-graph?"))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (let ((cwid (car (channel-widgets ind1 0))))
- (focus-widget cwid)
- (click-event cwid 0 0
- (floor (* .5 (+ (list-ref ax 10) (list-ref ax 12))))
- (floor (* .5 (+ (list-ref ax 11) (list-ref ax 13)))))
- (force-event)))))
- (lambda args args))
- (let ((old-colormap (colormap)))
- (set! (colormap) black-and-white-colormap)
+ (let ((old-colormap *colormap*))
+ (if (and (defined? 'integer->colormap)
+ (integer? old-colormap))
+ (set! old-colormap (integer->colormap old-colormap)))
+ (set! *colormap* black-and-white-colormap)
(update-transform-graph)
(set! (transform-graph-type ind1 0) graph-as-spectrogram)
(update-transform-graph)
(graph->ps "aaa.eps")
- (catch #t
- (lambda ()
- (let ((ax (axis-info ind1 0 transform-graph)))
- (if (not ax) (snd-display #__line__ ";axis-info transform-graph?"))
- (if (and (provided? 'xm) (provided? 'snd-debug))
- (let ((cwid (car (channel-widgets ind1 0))))
- (focus-widget cwid)
- (click-event cwid 0 0
- (floor (* .5 (+ (list-ref ax 10) (list-ref ax 12))))
- (floor (* .5 (+ (list-ref ax 11) (list-ref ax 13)))))
- (force-event)))))
- (lambda args args))
- (set! (colormap) old-colormap))
+ (set! *colormap* old-colormap))
(close-sound ind1))
- (let* ((ind (new-sound "test.snd" mus-next mus-bfloat)))
+ (let ((ind (new-sound "test.snd" :header-type mus-next :sample-type mus-ldouble)))
(pad-channel 0 1000)
(set! (transform-graph-type ind 0) graph-once)
(set! (show-transform-peaks ind 0) #t)
@@ -43588,7 +36427,7 @@ EDITS: 1
(let* ((ind (open-sound "oboe.snd"))
(size 8192)
- (v (channel->vct 1000 size ind 0)))
+ (v (channel->float-vector 1000 size ind 0)))
(set! (show-listener) #f)
(set! (window-height) 800)
(set! (lisp-graph? ind 0) #t)
@@ -43612,7 +36451,7 @@ EDITS: 1
(set! (fft-log-magnitude ind 0) #f)
(update-transform-graph)
(graph->ps "aaa.eps")
- (set! (with-gl) #f)
+ (set! *with-gl* #f)
(set! (spectrum-end ind 0) .2)
(set! (transform-graph-type ind 0) graph-as-spectrogram)
(update-transform-graph)
@@ -43622,22 +36461,22 @@ EDITS: 1
(close-sound ind))
(let ((v (dolph 16 2.5)))
- (if (not (vequal v (vct 0.097 0.113 0.221 0.366 0.536 0.709 0.860 0.963 1.000 0.963 0.860 0.709 0.536 0.366 0.221 0.113)))
+ (if (not (vequal v (float-vector 0.097 0.113 0.221 0.366 0.536 0.709 0.860 0.963 1.000 0.963 0.860 0.709 0.536 0.366 0.221 0.113)))
(snd-display #__line__ ";dolph 16 2.5 (dsp.scm): ~A" v)))
- (let ((v (make-vct 8))
- (v0 (make-vct 8)))
- (do ((i 0 (+ 1 i)))
+ (let ((v (make-float-vector 8))
+ (v0 (make-float-vector 8)))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! v i (- (random 2.0) 1.0))
- (vct-set! v0 i (vct-ref v i)))
- (set! v (vct-scale! (dht (dht v)) (/ 1.0 8.0)))
+ (set! (v i) (mus-random 1.0))
+ (set! (v0 i) (float-vector-ref v i)))
+ (set! v (float-vector-scale! (dht (dht v)) (/ 1.0 8.0)))
(if (not (vvequal v v0))
(snd-display #__line__ ";dht twice: ~A ~A" v v0))
- (vct-fill! v 0.0)
- (vct-set! v 1 1.0)
+ (fill! v 0.0)
+ (set! (v 1) 1.0)
(set! v (dht v))
- (if (not (vequal v (vct 1.000 1.414 1.000 0.000 -1.000 -1.414 -1.000 0.000)))
+ (if (not (vequal v (float-vector 1.000 1.414 1.000 0.000 -1.000 -1.414 -1.000 0.000)))
(snd-display #__line__ ";dht of pulse: ~A" v)))
(let* ((ind (open-sound "oboe.snd"))
@@ -43664,168 +36503,166 @@ EDITS: 1
(undo)
(spike)
(close-sound ind))
- (let ((old-opt (optimization)))
- (set! (optimization) 0)
+
(let* ((ind (open-sound "1a.snd"))
- (valf (car (find-sine 440.0 0 (frames) ind)))
- (valg (* 2 (/ (goertzel 440.0 0 (frames) ind) (frames))))
- (valf1 (car (find-sine 100.0 0 (frames) ind)))
- (valg1 (* 2 (/ (goertzel 100.0 0 (frames) ind) (frames))))
- (valf2 (car (find-sine 440.0 0 (frames) ind)))
- (valg2 (* 2 (/ (goertzel 440.0 0 (frames) ind) (frames))))
- (valf3 (car (find-sine 437.0 0 (frames) ind)))
- (valg3 (* 2 (/ (goertzel 437.0 0 (frames) ind) (frames)))))
+ (valf (car (find-sine 440.0 0 (framples) ind)))
+ (valg (* 2 (/ (goertzel 440.0 0 (framples) ind) (framples))))
+ (valf1 (car (find-sine 100.0 0 (framples) ind)))
+ (valg1 (* 2 (/ (goertzel 100.0 0 (framples) ind) (framples))))
+ (valf2 (car (find-sine 440.0 0 (framples) ind)))
+ (valg2 (* 2 (/ (goertzel 440.0 0 (framples) ind) (framples))))
+ (valf3 (car (find-sine 437.0 0 (framples) ind)))
+ (valg3 (* 2 (/ (goertzel 437.0 0 (framples) ind) (framples)))))
(if (fneq valf valg) (snd-display #__line__ ";goertzel 0: ~A ~A" valf valg))
(if (fneq valf1 valg1) (snd-display #__line__ ";goertzel 1: ~A ~A" valf1 valg1))
(if (fneq valf2 valg2) (snd-display #__line__ ";goertzel 2: ~A ~A" valf2 valg2))
(if (fneq valf3 valg3) (snd-display #__line__ ";goertzel 3: ~A ~A" valf3 valg3))
(close-sound ind))
- (set! (optimization) old-opt))
-
- (let ((v (vct-polynomial (vct 0.0 2.0) (vct 1.0 2.0))))
- (if (not (vequal v (vct 1.0 5.0)))
- (snd-display #__line__ ";vct-polynomial 0: ~A" v)))
- (let ((v (vct-polynomial (vct 0 1 2) (vct 0 2 1))))
- (if (not (vequal v (vct 0.000 3.000 8.000)))
- (snd-display #__line__ ";vct-polynomial 1: ~A" v)))
- (let ((v (vct-polynomial (vct 0 1 2) (vct 0 2 1 .5))))
- (if (not (vequal v (vct 0.000 3.500 12.000)))
- (snd-display #__line__ ";vct-polynomial 2: ~A" v)))
- (let ((v (vct-polynomial (vct 0 1 2) (vct 1))))
- (if (not (vequal v (vct 1 1 1)))
- (snd-display #__line__ ";vct-polynomial 3: ~A" v)))
+
+ (let ((v (float-vector-polynomial (float-vector 0.0 2.0) (float-vector 1.0 2.0))))
+ (if (not (vequal v (float-vector 1.0 5.0)))
+ (snd-display #__line__ ";float-vector-polynomial 0: ~A" v)))
+ (let ((v (float-vector-polynomial (float-vector 0 1 2) (float-vector 0 2 1))))
+ (if (not (vequal v (float-vector 0.000 3.000 8.000)))
+ (snd-display #__line__ ";float-vector-polynomial 1: ~A" v)))
+ (let ((v (float-vector-polynomial (float-vector 0 1 2) (float-vector 0 2 1 .5))))
+ (if (not (vequal v (float-vector 0.000 3.500 12.000)))
+ (snd-display #__line__ ";float-vector-polynomial 2: ~A" v)))
+ (let ((v (float-vector-polynomial (float-vector 0 1 2) (float-vector 1))))
+ (if (not (vequal v (float-vector 1 1 1)))
+ (snd-display #__line__ ";float-vector-polynomial 3: ~A" v)))
(let* ((ind (open-sound "pistol.snd"))
(mx (maxamp ind 0)))
- (channel-polynomial (vct 0.0 2.0) ind 0)
+ (channel-polynomial (float-vector 0.0 2.0) ind 0)
(if (fneq (maxamp) (* mx 2))
(snd-display #__line__ ";channel-polynomial 2: ~A" (maxamp)))
(undo)
- (channel-polynomial (vct 0.0 0.5 0.25 0.25) ind 0)
+ (channel-polynomial (float-vector 0.0 0.5 0.25 0.25) ind 0)
(if (fneq (maxamp) .222)
(snd-display #__line__ ";channel-polynomial 3: ~A" (maxamp)))
(undo)
- (channel-polynomial (vct 0.0 0.0 1.0) ind 0)
+ (channel-polynomial (float-vector 0.0 0.0 1.0) ind 0)
(let ((pos (scan-channel (lambda (y) (< y 0.0)))))
(if pos
(snd-display #__line__ ";channel-polynomial squares: ~A" pos)))
(undo)
- (channel-polynomial (vct 0.5 1.0) ind 0)
+ (channel-polynomial (float-vector 0.5 1.0) ind 0)
(let ((pos (scan-channel (lambda (y) (< y 0.0)))))
(if pos
(snd-display #__line__ ";channel-polynomial offset: ~A" pos)))
(if (fneq (maxamp) .8575)
(snd-display #__line__ ";channel-polynomial off mx: ~A" (maxamp)))
(undo)
- (spectral-polynomial (vct 0.0 1.0) ind 0)
+ (spectral-polynomial (float-vector 0.0 1.0) ind 0)
(if (fneq (maxamp) .493)
(snd-display #__line__ ";spectral-polynomial 0 mx: ~A" (maxamp)))
- (if (not (= (frames ind 0) 41623))
- (snd-display #__line__ ";spectral-polynomial 0 len: ~A" (frames)))
+ (if (not (= (framples ind 0) 41623))
+ (snd-display #__line__ ";spectral-polynomial 0 len: ~A" (framples)))
(undo)
- (spectral-polynomial (vct 0.0 0.5 0.5) ind 0)
+ (spectral-polynomial (float-vector 0.0 0.5 0.5) ind 0)
(if (fneq (maxamp) .493)
(snd-display #__line__ ";spectral-polynomial 1: ~A" (maxamp)))
- (if (not (= (frames ind 0) (* 2 41623)))
- (snd-display #__line__ ";spectral-polynomial 1 len: ~A" (frames)))
+ (if (not (= (framples ind 0) (* 2 41623)))
+ (snd-display #__line__ ";spectral-polynomial 1 len: ~A" (framples)))
(undo)
- (spectral-polynomial (vct 0.0 0.0 0.0 1.0) ind 0)
+ (spectral-polynomial (float-vector 0.0 0.0 0.0 1.0) ind 0)
(if (fneq (maxamp) .493)
(snd-display #__line__ ";spectral-polynomial 2: ~A" (maxamp)))
- (if (not (= (frames ind 0) (* 3 41623)))
- (snd-display #__line__ ";spectral-polynomial 1 len: ~A" (frames)))
+ (if (not (= (framples ind 0) (* 3 41623)))
+ (snd-display #__line__ ";spectral-polynomial 1 len: ~A" (framples)))
(close-sound ind))
(let ((vals (scentroid "oboe.snd")))
- (if (or (fneq (vct-ref vals 0) 1876.085) (fneq (vct-ref vals 1) 1447.004))
+ (if (or (fneq (vals 0) 1876.085) (fneq (vals 1) 1447.004))
(snd-display #__line__ ";scentroid: ~A" vals)))
- (let ((flt (make-fir-filter 3 (vct 0.5 0.25 0.125)))
- (data (make-vct 10))
- (undata (make-vct 10)))
- (vct-set! data 0 1.0)
- (do ((i 0 (+ 1 i)))
+ (let ((flt (make-fir-filter 3 (float-vector 0.5 0.25 0.125)))
+ (data (make-float-vector 10))
+ (undata (make-float-vector 10)))
+ (set! (data 0) 1.0)
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! undata i (fir-filter flt (vct-ref data i))))
- (let ((fdata (invert-filter (vct 0.5 0.25 0.125))))
- (set! flt (make-fir-filter (vct-length fdata) fdata))
- (do ((i 0 (+ 1 i)))
+ (set! (undata i) (fir-filter flt (data i))))
+ (let ((fdata (invert-filter (float-vector 0.5 0.25 0.125))))
+ (set! flt (make-fir-filter (length fdata) fdata))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! undata i (fir-filter flt (vct-ref undata i))))
+ (set! (undata i) (fir-filter flt (undata i))))
(if (not (vequal undata data))
(snd-display #__line__ ";invert-filter: ~A" undata))))
- (let ((coeffs (make-vct 6)))
- (do ((i 0 (+ 1 i))
+ (let ((coeffs (make-float-vector 6)))
+ (do ((i 0 (+ i 1))
(top .8 (- top .1)))
((= i 6))
- (vct-set! coeffs i (+ top (random .2))))
+ (set! (coeffs i) (+ top (random .2))))
(let ((flt (make-fir-filter 6 coeffs))
- (data (make-vct 20))
- (undata (make-vct 20)))
- (vct-set! data 0 1.0)
- (do ((i 0 (+ 1 i)))
+ (data (make-float-vector 20))
+ (undata (make-float-vector 20)))
+ (set! (data 0) 1.0)
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! undata i (fir-filter flt (vct-ref data i))))
+ (set! (undata i) (fir-filter flt (data i))))
(let ((fdata (invert-filter coeffs)))
- (set! flt (make-fir-filter (vct-length fdata) fdata))
- (do ((i 0 (+ 1 i)))
+ (set! flt (make-fir-filter (length fdata) fdata))
+ (do ((i 0 (+ i 1)))
((= i 20))
- (vct-set! undata i (fir-filter flt (vct-ref undata i))))
+ (set! (undata i) (fir-filter flt (undata i))))
(if (not (vequal undata data))
(snd-display #__line__ ";invert-filter (6): ~A" undata)))))
- (let ((flt (make-volterra-filter (vct 1.0 .4) (vct .3 .2 .1)))
- (data (make-vct 10))
+ (let ((flt (make-volterra-filter (float-vector 1.0 .4) (float-vector .3 .2 .1)))
+ (data (make-float-vector 10))
(x 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10))
- (vct-set! data i (volterra-filter flt x))
+ (set! (data i) (volterra-filter flt x))
(if (= i 0) (set! x 0.5) (set! x 0.0)))
- (if (not (vequal data (vct 0.000 0.575 0.250 0.025 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (if (not (vequal data (float-vector 0.000 0.575 0.250 0.025 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";volterra-filter: ~A" data)))
- (let ((flt (make-volterra-filter (vct 1.0) (vct 1.0)))
- (data (make-vct 10)))
- (do ((i 0 (+ 1 i))
+ (let ((flt (make-volterra-filter (float-vector 1.0) (float-vector 1.0)))
+ (data (make-float-vector 10)))
+ (do ((i 0 (+ i 1))
(x 1.0 0.0))
((= i 10))
- (vct-set! data i (volterra-filter flt x)))
- (if (not (vequal data (vct 2.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (set! (data i) (volterra-filter flt x)))
+ (if (not (vequal data (float-vector 2.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";volterra-filter x + x^2: ~A" data)))
- (let ((flt (make-volterra-filter (vct 1.0) (vct 1.0)))
- (data (make-vct 10)))
- (do ((i 0 (+ 1 i))
+ (let ((flt (make-volterra-filter (float-vector 1.0) (float-vector 1.0)))
+ (data (make-float-vector 10)))
+ (do ((i 0 (+ i 1))
(x 1.0 (- x 0.1)))
((= i 10))
- (vct-set! data i (volterra-filter flt x)))
- (if (not (vequal data (vct 2.000 1.710 1.440 1.190 0.960 0.750 0.560 0.390 0.240 0.110)))
+ (set! (data i) (volterra-filter flt x)))
+ (if (not (vequal data (float-vector 2.000 1.710 1.440 1.190 0.960 0.750 0.560 0.390 0.240 0.110)))
(snd-display #__line__ ";volterra-filter x + x^2 by -0.1: ~A" data)))
- (let ((flt (make-volterra-filter (vct 1.0 0.5) (vct 1.0)))
- (data (make-vct 10)))
- (do ((i 0 (+ 1 i))
+ (let ((flt (make-volterra-filter (float-vector 1.0 0.5) (float-vector 1.0)))
+ (data (make-float-vector 10)))
+ (do ((i 0 (+ i 1))
(x 1.0 0.0))
((= i 10))
- (vct-set! data i (volterra-filter flt x)))
- (if (not (vequal data (vct 2.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (set! (data i) (volterra-filter flt x)))
+ (if (not (vequal data (float-vector 2.000 0.500 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";volterra-filter x + .5x(n-1) + x^2: ~A" data)))
- (let ((flt (make-volterra-filter (vct 1.0 0.5) (vct 1.0 0.6)))
- (data (make-vct 10)))
- (do ((i 0 (+ 1 i))
+ (let ((flt (make-volterra-filter (float-vector 1.0 0.5) (float-vector 1.0 0.6)))
+ (data (make-float-vector 10)))
+ (do ((i 0 (+ i 1))
(x 0.9 0.0))
((= i 10))
- (vct-set! data i (volterra-filter flt x)))
- (if (not (vequal data (vct 1.710 0.936 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (set! (data i) (volterra-filter flt x)))
+ (if (not (vequal data (float-vector 1.710 0.936 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
(snd-display #__line__ ";volterra-filter x + .5x(n-1) + x^2 + 0.6: ~A" data)))
(let ((ind (new-sound "test.snd" :size 100))
(gen (make-oscil 440.0)))
- (map-chan (lambda (y) (oscil gen)))
+ (map-channel (lambda (y) (oscil gen)))
(down-oct 2)
- (if (not (= (frames) 200)) (snd-display #__line__ ";down-oct new len: ~A" (frames)))
+ (if (not (= (framples) 200)) (snd-display #__line__ ";down-oct new len: ~A" (framples)))
(let ((r1 (make-sampler 0 ind 0 1 1))
(r2 (make-sampler 0 ind 0 1 2)))
(do ((i 0 (+ i 2)))
@@ -43841,57 +36678,56 @@ EDITS: 1
(close-sound ind))
- (let* ((d0 (make-vct 8))
- (d1 (make-vct 8)))
- (vct-set! d0 2 1.0)
+ (let ((d0 (make-float-vector 8))
+ (d1 (make-float-vector 8)))
+ (set! (d0 2) 1.0)
(let ((vals (fractional-fourier-transform d0 d1 8 1.0)))
- (if (or (not (vequal (car vals) (vct 1.000 0.000 -1.000 -0.000 1.000 0.000 -1.000 -0.000)))
- (not (vequal (cadr vals) (vct 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
+ (if (or (not (vequal (car vals) (float-vector 1.000 0.000 -1.000 -0.000 1.000 0.000 -1.000 -0.000)))
+ (not (vequal (cadr vals) (float-vector 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
(snd-display #__line__ ";fractional-fft: ~A?" vals))))
- (let* ((d0 (make-vct 8))
- (d1 (make-vct 8)))
- (vct-set! d0 2 1.0)
- (let ((val (z-transform d0 8 (exp (make-rectangular 0.0 (* .25 pi))))))
- (do ((i 0 (+ 1 i)))
+ (let ((d0 (make-float-vector 8))
+ (d1 (make-float-vector 8)))
+ (let ((val (z-transform (vector 0 0 1.0 0 0 0 0 0) 8 (exp (complex 0.0 (* .25 pi))))))
+ (do ((i 0 (+ i 1)))
((= i 8))
- (vct-set! d0 i (real-part (vector-ref val i)))
- (vct-set! d1 i (imag-part (vector-ref val i))))
- (if (or (not (vequal d0 (vct 1.000 0.000 -1.000 -0.000 1.000 0.000 -1.000 -0.000)))
- (not (vequal d1 (vct 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
+ (set! (d0 i) (real-part (vector-ref val i)))
+ (set! (d1 i) (imag-part (vector-ref val i))))
+ (if (or (not (vequal d0 (float-vector 1.000 0.000 -1.000 -0.000 1.000 0.000 -1.000 -0.000)))
+ (not (vequal d1 (float-vector 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000))))
(snd-display #__line__ ";z-transform: ~A ~A?" d0 d1))))
- (let ((v1 (make-vct 16)))
- (vct-set! v1 0 1.0)
- (let ((res (vector->vct (z-transform v1 16 0.5))))
- (if (not (vequal res (make-vct 16 1.0)))
+ (let ((v1 (make-float-vector 16)))
+ (set! (v1 0) 1.0)
+ (let ((res (z-transform v1 16 0.5)))
+ (if (not (vequal res (make-float-vector 16 1.0)))
(snd-display #__line__ ";z 0.5 0=1: ~A" res)))
- (let ((res (vector->vct (z-transform v1 16 -1.0))))
- (if (not (vequal res (make-vct 16 1.0)))
+ (let ((res (z-transform v1 16 -1.0)))
+ (if (not (vequal res (make-float-vector 16 1.0)))
(snd-display #__line__ ";z -1.0 0=1: ~A" res)))
- (vct-set! v1 0 0.0)
- (vct-set! v1 1 1.0)
- (let ((res (vector->vct (z-transform v1 16 0.5))))
- (if (not (vequal res (vct 1.000 0.500 0.250 0.125 0.062 0.031 0.016 0.008 0.004 0.002 0.001 0.0 0.0 0.0 0.0 0.0)))
+ (set! (v1 0) 0.0)
+ (set! (v1 1) 1.0)
+ (let ((res (z-transform v1 16 0.5)))
+ (if (not (vequal res (float-vector 1.000 0.500 0.250 0.125 0.062 0.031 0.016 0.008 0.004 0.002 0.001 0.0 0.0 0.0 0.0 0.0)))
(snd-display #__line__ ";z 0.5 1=1: ~A" res)))
- (let ((res (vector->vct (z-transform v1 16 2.0))))
- (if (not (vequal res (vct 1.0 2.0 4.0 8.0 16.0 32.0 64.0 128.0 256.0 512.0 1024.0
+ (let ((res (z-transform v1 16 2.0)))
+ (if (not (vequal res (float-vector 1.0 2.0 4.0 8.0 16.0 32.0 64.0 128.0 256.0 512.0 1024.0
2048.0 4096.0 8192.0 16384.0 32768.0)))
(snd-display #__line__ ";z 2.0 1=1: ~A" res)))
- (vct-set! v1 2 1.0)
- (let ((res (vector->vct (z-transform v1 16 0.5))))
- (if (not (vequal res (vct 2.0 0.75 0.3125 0.140 0.0664 0.0322 0.0158 0.00787 0.0039 0.0019 0 0 0 0 0 0)))
+ (set! (v1 2) 1.0)
+ (let ((res (z-transform v1 16 0.5)))
+ (if (not (vequal res (float-vector 2.0 0.75 0.3125 0.140 0.0664 0.0322 0.0158 0.00787 0.0039 0.0019 0 0 0 0 0 0)))
(snd-display #__line__ ";z 0.5 1=1 2=1: ~A" res)))
- (let ((res (vector->vct (z-transform v1 16 2.0))))
- (if (not (vequal res (vct 2.0 6.0 20.0 72.0 272.0 1056.0 4160.0 16512.0 65792.0
+ (let ((res (z-transform v1 16 2.0)))
+ (if (not (vequal res (float-vector 2.0 6.0 20.0 72.0 272.0 1056.0 4160.0 16512.0 65792.0
262656.0 1049600.0 4196352.0 16781312.0 67117056.0 268451840.0 1073774592.0)))
(snd-display #__line__ ";z 2.0 1=1 2=1: ~A" res)))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(j 1.0 (* j 0.4)))
((= i 16))
- (vct-set! v1 i j))
- (let ((res (vector->vct (z-transform v1 16 1.0))))
- (if (not (vequal res (make-vct 16 (/ 1.0 (- 1.0 0.4))))) ; this is confusing
+ (float-vector-set! v1 i j))
+ (let ((res (z-transform v1 16 1.0)))
+ (if (not (vequal res (make-float-vector 16 (/ 1.0 (- 1.0 0.4))))) ; this is confusing
(snd-display #__line__ ";z 1 0.4g: ~A" res))))
(let ((ind (open-sound "oboe.snd")))
@@ -43899,14 +36735,7 @@ EDITS: 1
(automorph 0.0+1.0i 0 0 1)
(automorph 0.0+1.0i 0 0 1)
(automorph 0.0+1.0i 0 0 1)
- (let ((mxdiff 0.0)
- (rd1 (make-sampler 0 ind 0))
- (rd2 (make-sampler 0 ind 0 1 0)))
- (scan-channel (lambda (y)
- (let ((diff (abs (- (rd1) (rd2)))))
- (if (> diff mxdiff)
- (set! mxdiff diff))
- #f)))
+ (let ((mxdiff (float-vector-peak (float-vector-subtract! (channel->float-vector 0 #f ind 0 0) (channel->float-vector 0 #f ind 0) ))))
(if (> mxdiff .003) (snd-display #__line__ ";automorph rotation: ~A" mxdiff)))
(revert-sound ind)
@@ -43918,18 +36747,18 @@ EDITS: 1
(do ((i 0 (+ i 1)))
((= i 10))
(let* ((len (expt 2 (+ 2 (random 8))))
- (v0 (make-vct len))
- (v1 (make-vct len))
+ (v0 (make-float-vector len))
+ (v1 (make-float-vector len))
(v2 (make-vector len)))
(do ((k 0 (+ k 1)))
((= k len))
- (set! (v0 k) (- (random 1.0) 0.5))
- (set! (v1 k) (- (random 1.0) 0.5))
- (set! (v2 k) (make-rectangular (v0 k) (v1 k))))
- (let ((res1 (mus-fft v0 v1 len 1))
- (res2 (cfft! v2 len 1))
- (sum 0.0)
+ (float-vector-set! v0 k (mus-random 0.5))
+ (float-vector-set! v1 k (mus-random 0.5))
+ (vector-set! v2 k (complex (v0 k) (v1 k))))
+ (let ((sum 0.0)
(mx 0.0))
+ (mus-fft v0 v1 len 1)
+ (cfft! v2 len 1)
(do ((m 0 (+ m 1)))
((= m len))
(let ((diffr (abs (- (v0 m) (real-part (v2 m)))))
@@ -43939,73 +36768,75 @@ EDITS: 1
(set! mx (max diffr diffi)))))
(if (or (> mx 1e-6)
(> sum 1e-6))
- (format #t ";cfft! ~A: ~A ~A~%" len mx sum)))))
+ (snd-display #__line__ ";cfft! ~A: ~A ~A~%" len mx sum)))))
(let ((val (cfft! (cfft! (cfft! (cfft! (vector 0.0 1+i 0.0 0.0)))))))
- (if (not (equal? val '#(0.0 16+16i 0.0 0.0)))
+ (if (or (> (magnitude (val 0)) 1e-12)
+ (> (magnitude (val 2)) 1e-12)
+ (> (magnitude (val 3)) 1e-12)
+ (fneq 16.0 (real-part (val 1)))
+ (fneq 16.0 (imag-part (val 1))))
(snd-display #__line__ ";cfft! 4x: ~A" val)))
(do ((i 0 (+ i 1)))
((= i 10))
(let* ((len (expt 2 (+ 2 (random 8))))
- (v0 (make-vct len))
- (v1 (make-vct len))
- (v2 (make-vct len))
- (v3 (make-vct len)))
+ (v0 (make-float-vector len))
+ (v1 (make-float-vector len))
+ (v2 (make-float-vector len))
+ (v3 (make-float-vector len)))
(do ((k 0 (+ k 1)))
((= k len))
- (set! (v0 k) (- (random 1.0) 0.5))
- (set! (v1 k) (- (random 1.0) 0.5))
+ (float-vector-set! v0 k (mus-random 0.5))
+ (float-vector-set! v1 k (mus-random 0.5))
(set! (v2 k) (v0 k))
(set! (v3 k) (v1 k)))
- (let ((res1 (mus-fft v0 v1 len 1))
- (res2 (fft! v2 v3 len 1))
- (sum 0.0)
- (mx 0.0))
- (do ((m 0 (+ m 1)))
- ((= m len))
- (let ((diffr (abs (- (v0 m) (v2 m))))
- (diffi (abs (- (v1 m) (v3 m)))))
- (set! sum (+ sum diffr diffi))
- (if (> (max diffr diffi) mx)
- (set! mx (max diffr diffi)))))
- (if (or (> mx 1e-6)
- (> sum 1e-6))
- (format #t ";fft! ~A: ~A ~A~%" len mx sum)))))
+ (let ()
+ (mus-fft v0 v1 len 1)
+ (fft! v2 v3 len 1)
+ (let ((sum 0.0)
+ (mx 0.0))
+ (do ((m 0 (+ m 1)))
+ ((= m len))
+ (let ((diffr (abs (- (v0 m) (v2 m))))
+ (diffi (abs (- (v1 m) (v3 m)))))
+ (set! sum (+ sum diffr diffi))
+ (if (> (max diffr diffi) mx)
+ (set! mx (max diffr diffi)))))
+ (if (or (> mx 1e-6)
+ (> sum 1e-6))
+ (snd-display #__line__ ";fft! ~A: ~A ~A~%" len mx sum))))))
))
-;;; ---------------- test 21: new stuff ----------------
+;;; ---------------- test 20: new stuff ----------------
(if (not (defined? 'load-font))
(define (load-font name) #f))
-(if (not (provided? 'snd-clean.scm)) (load "clean.scm"))
-(if (not (provided? 'snd-snddiff.scm)) (load "snddiff.scm"))
-
+(require snd-clean.scm snd-snddiff.scm)
-(define (snd_test_21)
+(define (snd_test_20)
(define* (add-comment sample comment snd1 chn1)
(let* ((snd (or snd1 (selected-sound)))
(chn (or chn1 (selected-channel)))
- (old-comments (or (channel-property 'comments snd chn) '())))
+ (old-comments (or (channel-property 'comments snd chn) ())))
(set! (channel-property 'comments snd chn)
(cons (list sample comment)
old-comments))))
(define (show-comments snd chn)
- (let ((comments (or (channel-property 'comments snd chn) '())))
+ (let ((comments (or (channel-property 'comments snd chn) ())))
(for-each
(lambda (comment)
(let* ((samp (car comment))
(text (cadr comment))
- (text-width (* 6 (string-length text)))
+ (text-width (* 6 (length text)))
(ls (left-sample snd chn))
(rs (right-sample snd chn)))
- (if (and (< ls samp)
- (> rs samp))
+ (if (< ls samp rs)
(let ((xpos (x->position (/ samp (srate))))
(ypos (y->position (sample samp))))
(catch #t
@@ -44018,55 +36849,55 @@ EDITS: 1
(snd-display #__line__ ";draw error: ~A" args)))))))
comments)))
- (define (display-samps-in-red snd chn)
- "display samples 1000 to 2000 in red whenever they're in the current view"
- (catch #t
- (lambda ()
- (let ((left (left-sample snd chn))
- (right (right-sample snd chn))
- (old-color (foreground-color snd chn))
- (red (make-color-with-catch 1 0 0)))
- (if (and (< left 2000)
- (> right 1000))
- (let* ((data (make-graph-data snd chn)))
- (if data
- (if (vct? data) ;the simple, one-sided graph case
- (let* ((samps (- (min right 2000)
- (max left 1000)))
- (offset (max 0 (- 1000 left)))
- (new-data (vct-subseq data offset (+ offset samps)))
- (cr (make-cairo (car (channel-widgets snd chn)))))
- (set! (foreground-color snd chn) red)
- (graph-data new-data snd chn copy-context (max 1000 left) (min 2000 right) graph-lines cr)
- (free-cairo cr)
- (set! (foreground-color snd chn) old-color))
- (let* ((low-data (car data)) ;the two-sided envelope graph case
- (high-data (cadr data))
- ;; we need to place the red portion correctly in the current graph
- ;; so the following is getting the "bin" numbers associated with
- ;; samples 1000 and 2000
- (size (vct-length low-data))
- (samps (- right left))
- (left-offset (max 0 (- 1000 left)))
- (left-bin (round (/ (* size left-offset) samps)))
- (right-offset (- (min 2000 right) left))
- (right-bin (round (/ (* size right-offset) samps)))
- (new-low-data (vct-subseq low-data left-bin right-bin))
- (new-high-data (vct-subseq high-data left-bin right-bin))
- (cr (make-cairo (car (channel-widgets snd chn)))))
- (set! (foreground-color snd chn) red)
- (graph-data
- (list new-low-data new-high-data) snd chn copy-context left-bin right-bin graph-lines cr)
- (free-cairo cr)
- (set! (foreground-color snd chn) old-color))))))))
- (lambda args
- (snd-display #__line__ ";draw error: ~A" args))))
+ (define display-samps-in-red
+ (let ((documentation "display samples 1000 to 2000 in red whenever they're in the current view"))
+ (lambda (snd chn)
+ (catch #t
+ (lambda ()
+ (let ((left (left-sample snd chn))
+ (right (right-sample snd chn))
+ (old-color (foreground-color snd chn))
+ (red (make-color-with-catch 1 0 0)))
+ (if (and (< left 2000)
+ (> right 1000))
+ (let ((data (make-graph-data snd chn)))
+ (if data
+ (if (float-vector? data) ;the simple, one-sided graph case
+ (let* ((samps (- (min right 2000)
+ (max left 1000)))
+ (offset (max 0 (- 1000 left)))
+ (new-data (float-vector-subseq data offset (+ offset samps)))
+ (cr (make-cairo (car (channel-widgets snd chn)))))
+ (set! (foreground-color snd chn) red)
+ (graph-data new-data snd chn copy-context (max 1000 left) (min 2000 right) graph-lines cr)
+ (free-cairo cr)
+ (set! (foreground-color snd chn) old-color))
+ (let* ((low-data (car data)) ;the two-sided envelope graph case
+ (high-data (cadr data))
+ ;; we need to place the red portion correctly in the current graph
+ ;; so the following is getting the "bin" numbers associated with
+ ;; samples 1000 and 2000
+ (size (length low-data))
+ (samps (- right left))
+ (left-offset (max 0 (- 1000 left)))
+ (left-bin (round (/ (* size left-offset) samps)))
+ (right-offset (- (min 2000 right) left))
+ (right-bin (round (/ (* size right-offset) samps)))
+ (new-low-data (float-vector-subseq low-data left-bin right-bin))
+ (new-high-data (float-vector-subseq high-data left-bin right-bin))
+ (cr (make-cairo (car (channel-widgets snd chn)))))
+ (set! (foreground-color snd chn) red)
+ (graph-data
+ (list new-low-data new-high-data) snd chn copy-context left-bin right-bin graph-lines cr)
+ (free-cairo cr)
+ (set! (foreground-color snd chn) old-color))))))))
+ (lambda args
+ (snd-display #__line__ ";draw error: ~A" args))))))
(define* (show-greeting (snd 0) (chn 0))
(let ((ls (left-sample snd chn))
(rs (right-sample snd chn)))
- (if (and (< ls 1000)
- (> rs 1000))
+ (if (< ls 1000 rs)
(let ((pos (x->position (/ 1000.0 (srate))))
(old-color (foreground-color))
(cr (make-cairo (car (channel-widgets snd chn)))))
@@ -44077,332 +36908,331 @@ EDITS: 1
(set! (foreground-color) old-color)
(free-cairo cr)))))
- (begin
-
- (do ((test-ctr 0 (+ 1 test-ctr))) ((= test-ctr tests))
- (log-mem test-ctr)
-
- (if (not (sound-file? "oboe.snd")) (snd-display #__line__ ";oboe.snd not a sound file?"))
- (if (not (sound-file? "4.aiff")) (snd-display #__line__ ";4.aiff not a sound file?"))
- (if (sound-file? "snd.h") (snd-display #__line__ ";snd.h is a sound-file?"))
-
- (let ((ind1 (open-sound "oboe.snd")))
- (save-sound-as "test.snd" ind1)
- (let ((ind2 (open-sound "test.snd")))
- (if (not (channels-equal? ind1 0 ind2 0))
- (snd-display #__line__ ";channels-equal? of copy"))
- (if (not (channels=? ind1 0 ind2 0))
- (snd-display #__line__ ";channels=? of copy"))
- (pad-channel (frames ind2 0) 100)
- (if (channels-equal? ind1 0 ind2 0)
- (snd-display #__line__ ";channels-equal? of pad"))
- (if (not (channels=? ind1 0 ind2 0))
- (snd-display #__line__ ";channels=? of pad"))
- (set! (sample 50900 ind2 0) .1)
- (if (channels-equal? ind1 0 ind2 0)
- (snd-display #__line__ ";channels-equal? of pad+set"))
- (if (channels=? ind1 0 ind2 0)
- (snd-display #__line__ ";channels=? of pad+set 0 err"))
- (if (not (channels=? ind1 0 ind2 0 .2))
- (snd-display #__line__ ";channels=? of pad+set .2 err"))
- (if with-gui
- (begin
- (add-comment 1234 "sample 1234" ind1 0)
- (let ((comments (show-comments ind1 0)))
- (update-time-graph)
- (if (null? comments) (snd-display #__line__ ";add-comment failed?")))
- (display-db ind1 0)
- (display-samps-in-red ind1 0)
- (update-time-graph)
- (catch #t (lambda () (show-greeting ind1 0)) (lambda args args))
- (update-time-graph)
- (color-samples (highlight-color) 0 100 ind1 0)
- (update-time-graph)
- (power-env-channel (make-power-env '(0 0 .325 1 1 32.0 2 0 32.0) :duration 2.0))
- (update-time-graph)
- (if (provided? 'xm) (show-disk-space ind1))
- (update-time-graph)
- (revert-sound ind1)
- (make-selection 10000 20000 ind1 0)
- (if (not (selection?))
- (snd-display #__line__ ";make-selection for show failed?")
- (begin
- (show-selection)
- (let ((vals (x-bounds ind1 0)))
- (if (pair? vals)
- (if (or (fneq (car vals) (/ 10000.0 (srate ind1)))
- (fneq (cadr vals) (/ 20000.0 (srate ind1))))
- (snd-display #__line__ ";show-selection: ~A (~A)" vals (list (/ 10000.0 (srate ind1)) (/ 20000.0 (srate ind1)))))))))
- (hook-push graph-hook zoom-spectrum)
- (set! (transform-graph? ind1 0) #t)
- (let ((ind3 (open-sound "pistol.snd")))
- (overlay-sounds ind2 ind1 ind3)
- (update-time-graph ind2 0)
- (set! (hook-functions after-graph-hook) '())
- (close-sound ind3))
- (samples-via-colormap ind1 0)))
- (close-sound ind1)
- (hook-remove graph-hook zoom-spectrum)
- (close-sound ind2)))
-
- (let ((ns (open-sound "1.snd")))
- (set! (sync ns) 0)
+ (do ((test-ctr 0 (+ 1 test-ctr))) ((= test-ctr tests))
+ (log-mem test-ctr)
+
+ (if (not (sound-file? "oboe.snd")) (snd-display #__line__ ";oboe.snd not a sound file?"))
+ (if (not (sound-file? "4.aiff")) (snd-display #__line__ ";4.aiff not a sound file?"))
+ (if (sound-file? "snd.h") (snd-display #__line__ ";snd.h is a sound-file?"))
+
+ (let ((ind1 (open-sound "oboe.snd")))
+ (save-sound-as "test.snd" ind1)
+ (let ((ind2 (open-sound "test.snd")))
+ (if (not (channels-equal? ind1 0 ind2 0))
+ (snd-display #__line__ ";channels-equal? of copy"))
+ (if (not (channels=? ind1 0 ind2 0))
+ (snd-display #__line__ ";channels=? of copy"))
+ (pad-channel (framples ind2 0) 100)
+ (if (channels-equal? ind1 0 ind2 0)
+ (snd-display #__line__ ";channels-equal? of pad"))
+ (if (not (channels=? ind1 0 ind2 0))
+ (snd-display #__line__ ";channels=? of pad"))
+ (set! (sample 50900 ind2 0) .1)
+ (if (channels-equal? ind1 0 ind2 0)
+ (snd-display #__line__ ";channels-equal? of pad+set"))
+ (if (channels=? ind1 0 ind2 0)
+ (snd-display #__line__ ";channels=? of pad+set 0 err"))
+ (if (not (channels=? ind1 0 ind2 0 .2))
+ (snd-display #__line__ ";channels=? of pad+set .2 err"))
+ (if with-gui
+ (begin
+ (add-comment 1234 "sample 1234" ind1 0)
+ (let ((comments (show-comments ind1 0)))
+ (update-time-graph)
+ (if (null? comments) (snd-display #__line__ ";add-comment failed?")))
+ (display-samps-in-red ind1 0)
+ (update-time-graph)
+ (catch #t (lambda () (show-greeting ind1 0)) (lambda args args))
+ (update-time-graph)
+ (color-samples *highlight-color* 0 100 ind1 0)
+ (update-time-graph)
+ (power-env-channel (make-power-env '(0 0 .325 1 1 32.0 2 0 32.0) :duration 2.0))
+ (update-time-graph)
+ (revert-sound ind1)
+ (make-selection 10000 20000 ind1 0)
+ (if (not (selection?))
+ (snd-display #__line__ ";make-selection for show failed?")
+ (begin
+ (show-selection)
+ (let ((vals (x-bounds ind1 0)))
+ (if (and (pair? vals)
+ (or (fneq (car vals) (/ 10000.0 (srate ind1)))
+ (fneq (cadr vals) (/ 20000.0 (srate ind1)))))
+ (snd-display #__line__ ";show-selection: ~A (~A)" vals (list (/ 10000.0 (srate ind1)) (/ 20000.0 (srate ind1))))))))
+ (hook-push graph-hook zoom-spectrum)
+ (set! (transform-graph? ind1 0) #t)
+ (let ((ind3 (open-sound "pistol.snd")))
+ (overlay-sounds ind2 ind1 ind3)
+ (update-time-graph ind2 0)
+ (set! (hook-functions after-graph-hook) ())
+ (close-sound ind3))
+ (samples-via-colormap ind1 0)))
+ (close-sound ind1)
+ (hook-remove graph-hook zoom-spectrum)
+ (close-sound ind2)))
+
+ (let ((ns (open-sound "1.snd")))
+ (set! (sync ns) 0)
+ (set! (selection-member? ns 0) #t)
+ (set! (selection-position ns 0) 1000)
+ (set! (selection-framples ns 0) 3000)
+ (show-selection)
+ (if (not (equal? (list (left-sample ns 0) (right-sample ns 0)) '(1000 3999)))
+ (snd-display #__line__ ";show-selection 1.snd: ~A ~A" (left-sample ns 0) (right-sample ns 0)))
+ (unselect-all)
+ (let ((ns1 (open-sound "1234.snd")))
+ (set! (sync ns1) 0)
(set! (selection-member? ns 0) #t)
- (set! (selection-position ns 0) 1000)
- (set! (selection-frames ns 0) 3000)
+ (set! (selection-position ns 0) 10000)
+ (set! (selection-framples ns 0) 30000)
+ (set! (selection-member? ns1 0) #t)
+ (set! (selection-position ns1 0) 10000)
+ (set! (selection-framples ns1 0) 30000)
+ (set! (selection-member? ns1 1) #t)
+ (set! (selection-position ns1 1) 10000)
+ (set! (selection-framples ns1 1) 30000)
(show-selection)
- (if (not (equal? (list (left-sample ns 0) (right-sample ns 0)) '(1000 3999)))
- (snd-display #__line__ ";show-selection 1.snd: ~A ~A" (left-sample ns 0) (right-sample ns 0)))
- (unselect-all)
- (let ((ns1 (open-sound "1234.snd")))
- (set! (sync ns1) 0)
- (set! (selection-member? ns 0) #t)
- (set! (selection-position ns 0) 10000)
- (set! (selection-frames ns 0) 30000)
- (set! (selection-member? ns1 0) #t)
- (set! (selection-position ns1 0) 10000)
- (set! (selection-frames ns1 0) 30000)
- (set! (selection-member? ns1 1) #t)
- (set! (selection-position ns1 1) 10000)
- (set! (selection-frames ns1 1) 30000)
- (show-selection)
- (if (not (equal? (list (left-sample ns 0) (right-sample ns 0)
- (left-sample ns1 0) (right-sample ns1 0)
- (left-sample ns1 1) (right-sample ns1 1))
- '(10000 39999 10000 39999 10000 39999)))
- (snd-display #__line__ ";show-selection 1234.snd: ~A" (list (left-sample ns 0) (right-sample ns 0)
- (left-sample ns1 0) (right-sample ns1 0)
- (left-sample ns1 1) (right-sample ns1 1))))
- (close-sound ns1)
- (close-sound ns)))
-
- (let ((pe (make-power-env '(0 0 32.0 1 1 32.0 2 0 0.0) :duration .1)))
- (if (not (penv? pe)) (snd-display #__line__ ";penv? ~A" pe))
- (if (not (pair? (penv-methods))) (snd-display #__line__ ";(penv-methods) -> ~A" (penv-methods)))
- (let ((x (power-env pe))) (if (fneq x 0.0) (snd-display #__line__ ";power-env start: ~A" x)))
- (if (> (abs (- (penv-current-pass pe) 2203)) 2) (snd-display #__line__ ";power-env pass: ~A" (penv-current-pass pe))) ; 4410/2 - 1 because x1=2
- (if (not (= (penv-current-env pe) 0)) (snd-display #__line__ ";power-env seg: ~A" (penv-current-env pe)))
- )
-
- (let ((old-srate (mus-srate)))
- (set! (print-length) (max (print-length) 48))
- (set! (mus-srate) 22050)
- (let ((ind (new-sound :size 33 :srate 22050)))
- (map-channel (lambda (y) 1.0))
- (let ((pe (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1) :duration (/ 34.0 22050.0))))
- (map-channel (lambda (y) (* y (power-env pe))))
- (if (and (not (vequal1 (channel->vct)
- (vct 0.000 0.008 0.017 0.030 0.044 0.063 0.086 0.115 0.150 0.194 0.249
- 0.317 0.402 0.507 0.637 0.799 1.000 0.992 0.983 0.971 0.956 0.937
- 0.914 0.885 0.850 0.806 0.751 0.683 0.598 0.493 0.363 0.201 0.000)))
- (not (vequal1 (channel->vct)
- (vct 0.000 0.008 0.019 0.032 0.049 0.070 0.097 0.130 0.173 0.226 0.293
- 0.377 0.484 0.618 0.787 1.000 0.992 0.981 0.968 0.951 0.930 0.903
- 0.870 0.828 0.774 0.707 0.623 0.516 0.382 0.213 0.000 0.000 0.000))))
- (snd-display #__line__ ";power-env: ~A" (channel->vct))))
- (map-channel (lambda (y) 1.0))
- (let ((pe (make-power-env '(0 0 1.0 1 1 0.0 2 0 1 3 0 1) :duration (/ 34.0 22050.0))))
- (map-channel (lambda (y) (* y (power-env pe))))
- (if (not (vequal1 (channel->vct)
- (vct 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000
- 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 0.000 0.000
- 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";power-env 0 and 1: ~A" (channel->vct))))
- (map-channel (lambda (y) 1.0))
- (let ((pe (make-power-env '(0 0 .01 1 1 1) :duration (/ 34.0 22050.0))))
- (map-channel (lambda (y) (* y (power-env pe))))
- (if (and (not (vequal1 (channel->vct)
- (vct 0.000 0.132 0.246 0.346 0.432 0.507 0.573 0.630 0.679 0.722 0.760
- 0.792 0.821 0.845 0.867 0.886 0.902 0.916 0.928 0.939 0.948 0.956
- 0.963 0.969 0.975 0.979 0.983 0.987 0.990 0.992 0.995 0.997 0.998)))
- (not (vequal1 (channel->vct)
- (vct 0.000 0.135 0.253 0.354 0.442 0.518 0.584 0.641 0.691 0.733 0.771
- 0.803 0.830 0.855 0.875 0.893 0.909 0.923 0.934 0.945 0.953 0.961
- 0.968 0.973 0.978 0.982 0.986 0.987 0.990 0.992 0.995 0.997 0.998))))
- (snd-display #__line__ ";power-env .01: ~A" (channel->vct))))
- (let ((name (file-name ind)))
- (close-sound ind)
- (if (file-exists? name) (delete-file name))))
- (set! (mus-srate) old-srate))
-
- (let ((ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1 :size 50)))
- (set! (sample 3) 1.0)
- (filter-channel (vct .5 1.0 .5) 3)
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 0.000 0.000 0.500 1.000 0.500 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";filter (sym 3): ~A" data)))
- (undo)
- (filter-channel (vct .5 1.0 .25) 3)
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 0.000 0.000 0.500 1.000 0.250 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";filter (3): ~A" data)))
- (undo)
- (filter-channel (vct .5 1.0 1.0 .5) 4)
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 0.000 0.000 0.500 1.000 1.000 0.500 0.000 0.000 0.000)))
- (snd-display #__line__ ";filter (sym 4): ~A" data)))
- (undo)
- (filter-channel (vct .5 1.0 1.0 .25) 4)
- (let ((data (channel->vct 0 10)))
- (if (not (vequal data (vct 0.000 0.000 0.000 0.500 1.000 1.000 0.250 0.000 0.000 0.000)))
- (snd-display #__line__ ";filter (4): ~A" data)))
- (undo)
- (close-sound ind))
-
- (let ((ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1 #f 100)))
- (set! (sample 10) 0.5)
- (filter-sound (vct 1.0 0.0 1.0) 3)
- (if (not (vequal (channel->vct 5 10) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display #__line__ ";filter-sound 1 0 1: ~A" (channel->vct 5 10)))
- (undo)
- (filter-channel (vct 1.0 0.0 1.0) 3)
- (if (not (vequal (channel->vct 5 10) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display #__line__ ";filter-channel (v) 1 0 1: ~A" (channel->vct 5 10)))
- (undo)
- (filter-sound '(0 1 1 1) 100)
- (let ((coeffs (make-fir-coeffs 100 (make-vct 100 0.5)))
- (data (channel->vct 10 100))
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((or (not happy) (= i 100)))
- (if (fneq (vct-ref data i) (vct-ref coeffs i))
- (begin
- (snd-display #__line__ ";coeffs '(0 1 1 1): ~A ~A ~A" i (vct-ref coeffs i) (vct-ref data i))
- (set! happy #f)))))
- (undo)
- (filter-sound '(0 1 1 1) 1000)
- (if (not (vequal (channel->vct 5 10) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";filter-sound 1 (1000): ~A" (channel->vct 5 10)))
- (undo)
- (make-selection 5 15)
- (filter-selection '(0 1 1 1) 100)
- (if (and (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 11)))
- (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 111))))
- (snd-display #__line__ ";filter-selection truncated: ~S" (edit-fragment 2)))
- (undo)
- (filter-selection '(0 1 1 1) 100 #f)
- (if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 111)))
- (snd-display #__line__ ";filter-selection not truncated: ~S" (edit-fragment 2)))
- (if (not (vequal (channel->vct 50 10) (vct -0.016 0.018 -0.021 0.024 -0.029 0.035 -0.045 0.064 -0.106 0.318)))
- (snd-display #__line__ ";filter-selection no trunc: ~A" (channel->vct 50 10)))
- (undo)
- (filter-selection '(0 1 1 1) 1000 #t)
- (if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 1000" "set" 5 11)))
- (snd-display #__line__ ";filter-selection truncated (1000): ~S" (edit-fragment 2)))
- (if (fneq (maxamp) 0.0) (snd-display #__line__ ";filter-selection 1000 untrunc? ~A" (maxamp)))
- (undo)
- (filter-selection '(0 1 1 1) 1000 #f)
- (if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 1000" "set" 5 1011)))
- (snd-display #__line__ ";filter-selection not truncated (1000): ~S" (edit-fragment 2)))
- (if (fneq (maxamp) 0.318) (snd-display #__line__ ";filter-selection 1000 no trunc? ~A" (maxamp)))
- (if (not (vequal (channel->vct 505 10) (vct 0.035 -0.045 0.064 -0.106 0.318 0.318 -0.106 0.064 -0.045 0.035)))
- (snd-display #__line__ ";filter-selection 1000 no trunc: ~A" (channel->vct 505 10)))
-
- (undo)
- (filter-channel '(0 1 1 1) 10)
- (if (not (vequal (channel->vct 10 10) (vct 0.008 -0.025 0.050 -0.098 0.316 0.316 -0.098 0.050 -0.025 0.008)))
- (snd-display #__line__ ";filter-channel 10: ~A" (channel->vct 10 10)))
- (undo)
- (filter-channel '(0 1 1 1) 1000)
- (if (not (vequal (channel->vct 5 10) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";filter-channel 1 (1000): ~A" (channel->vct 5 10)))
- (undo)
- (filter-channel '(0 1 1 0) 10)
- (if (not (vequal (channel->vct 0 30) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
- 0.005 0.010 0.006 0.038 0.192 0.192 0.038 0.006 0.010 0.005
- 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";filter-channel lp: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
- (undo)
- (filter-channel '(0 1 1 0) 10 0 20 #f #f #f #f)
- (if (not (vequal (channel->vct 0 30) (vct 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
- 0.005 0.010 0.006 0.038 0.192 0.192 0.038 0.006 0.010 0.005
- 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";filter-channel lp no trunc: ~A ~A ~A" (channel->vct 0 10) (channel->vct 10 10) (channel->vct 20 10)))
- (undo)
- (close-sound))
-
- (let ((ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 2 #f 100)))
- (set! (sample 10) 0.5)
- (set! (sample 5 ind 1) -0.5)
- (set! (sync ind) 1)
- (filter-sound (vct 1.0 0.0 1.0) 3)
- (if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-sound 1 0 1: ~A" (channel->vct 5 10)))
- (if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-sound 1 0 2: ~A" (channel->vct 0 10 ind 1)))
- (undo)
- (filter-sound '(0 1 1 1) 1000)
- (if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-sound 1 (1000): ~A" (channel->vct 5 10)))
- (if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-sound 2 (1000): ~A" (channel->vct 0 10)))
- (undo)
- (make-selection 0 20)
- (filter-selection (vct 1.0 0.0 1.0) 3)
- (if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-selection 1 0 1: ~A" (channel->vct 5 10)))
- (if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-selection 1 0 2: ~A" (channel->vct 0 10 ind 1)))
- (undo)
- (set! (sync ind) 0)
- (filter-selection (vct 1.0 0.0 1.0) 3)
- (if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-selection 1 0 1 (no sync): ~A" (channel->vct 5 10)))
- (if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-selection 1 0 2 (no sync): ~A" (channel->vct 0 10 ind 1)))
- (undo 1 ind 0)
- (undo 1 ind 1)
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";edpos filter-sel undo: ~A" (edit-position ind 0)))
- (if (not (= (edit-position ind 1) 1)) (snd-display #__line__ ";edpos filter-sel undo 1: ~A" (edit-position ind 1)))
- (filter-sound (vct 1.0 0.0 1.0) 3)
- (if (not (vequal (channel->vct 5 10 ind 0) (vct 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-sound 1 0 1 no sync: ~A" (channel->vct 5 10)))
- (if (not (vequal (channel->vct 0 10 ind 1) (vct 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 0.000 0.000 0.000)))
- (snd-display #__line__ ";(2) filter-sound 1 0 2 no sync: ~A" (channel->vct 0 10 ind 1)))
- (undo 1 ind 0)
- (filter-channel '(0 1 1 0) 10 #f #f ind 1)
- (if (not (vequal (channel->vct 0 30 ind 1) (vct 0.000 0.000 0.000 0.000 0.000; 0.000 0.000 0.000 0.000 0.000
- -0.005 -0.010 -0.006 -0.038 -0.192 -0.192 -0.038 -0.006 -0.010 -0.005
- 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
- 0 0 0 0 0)))
- (snd-display #__line__ ";filter-channel lp: ~A ~A ~A" (channel->vct 0 10 ind 1) (channel->vct 10 10 ind 1) (channel->vct 20 10 ind 1)))
- (undo 1 ind 1)
- (close-sound ind))
-
- (let ((ind (new-sound "tmp.snd" mus-next mus-bshort 22050 1 :size 100)))
- (set! (sample 10) 0.5)
- (set! (sample 20) -0.5)
- (scale-to 1.0)
- (if (fneq (sample 10) .999) (snd-display #__line__ ";scale-to 1.0 short (10): ~A" (sample 10)))
- (if (fneq (sample 20) -.999) (snd-display #__line__ ";scale-to 1.0 short (20): ~A" (sample 10)))
- (close-sound ind))
- (let ((ind (new-sound "tmp.snd" mus-next mus-byte 22050 1 :size 100)))
- (set! (sample 10) 0.5)
- (set! (sample 20) -0.5)
- (scale-to 1.0)
- (if (fneq (sample 10) .992) (snd-display #__line__ ";scale-to 1.0 byte (10): ~A" (sample 10)))
- (if (fneq (sample 20) -.992) (snd-display #__line__ ";scale-to 1.0 byte (20): ~A" (sample 10)))
- (close-sound ind))
+ (if (or (not (eqv? (left-sample ns 0) 10000))
+ (not (member (right-sample ns 0) '(39999 39998)))
+ (not (eqv? (left-sample ns1 0) 10000))
+ (not (member (right-sample ns1 0) '(39999 39998)))
+ (not (eqv? (left-sample ns1 1) 10000))
+ (not (member (right-sample ns1 1) '(39999 39998))))
+ (snd-display #__line__ ";show-selection 1234.snd: ~A" (list (left-sample ns 0) (right-sample ns 0)
+ (left-sample ns1 0) (right-sample ns1 0)
+ (left-sample ns1 1) (right-sample ns1 1))))
+ (close-sound ns1)
+ (close-sound ns)))
+
+ (let ((pe (make-power-env '(0 0 32.0 1 1 32.0 2 0 0.0) :duration .1)))
+ (if (not (penv? pe)) (snd-display #__line__ ";penv? ~A" pe))
+ (let ((x (power-env pe))) (if (fneq x 0.0) (snd-display #__line__ ";power-env start: ~A" x)))
+ (if (> (abs (- (pe 'current-pass) 2203)) 2) (snd-display #__line__ ";power-env pass: ~A" (pe 'current-pass))) ; 4410/2 - 1 because x1=2
+ (if (not (= (pe 'current-env) 0)) (snd-display #__line__ ";power-env seg: ~A" (pe 'current-env)))
+ )
+
+ (let ((old-srate *clm-srate*))
+ (set! *print-length* (max *print-length* 48))
+ (set! *clm-srate* 22050)
+ (let ((ind (new-sound :size 33 :srate 22050)))
+ (map-channel (lambda (y) 1.0))
+ (let ((pe (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1) :duration (/ 34.0 22050.0))))
+ (map-channel (lambda (y) (* y (power-env pe))))
+ (if (and (not (vequal1 (channel->float-vector)
+ (float-vector 0.000 0.008 0.017 0.030 0.044 0.063 0.086 0.115 0.150 0.194 0.249
+ 0.317 0.402 0.507 0.637 0.799 1.000 0.992 0.983 0.971 0.956 0.937
+ 0.914 0.885 0.850 0.806 0.751 0.683 0.598 0.493 0.363 0.201 0.000)))
+ (not (vequal1 (channel->float-vector)
+ (float-vector 0.000 0.008 0.019 0.032 0.049 0.070 0.097 0.130 0.173 0.226 0.293
+ 0.377 0.484 0.618 0.787 1.000 0.992 0.981 0.968 0.951 0.930 0.903
+ 0.870 0.828 0.774 0.707 0.623 0.516 0.382 0.213 0.000 0.000 0.000))))
+ (snd-display #__line__ ";power-env: ~A" (channel->float-vector))))
+ (map-channel (lambda (y) 1.0))
+ (let ((pe (make-power-env '(0 0 1.0 1 1 0.0 2 0 1 3 0 1) :duration (/ 34.0 22050.0))))
+ (map-channel (lambda (y) (* y (power-env pe))))
+ (if (not (vequal1 (channel->float-vector)
+ (float-vector 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 1.000
+ 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 0.000 0.000
+ 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";power-env 0 and 1: ~A" (channel->float-vector))))
+ (map-channel (lambda (y) 1.0))
+ (let ((pe (make-power-env '(0 0 .01 1 1 1) :duration (/ 34.0 22050.0))))
+ (map-channel (lambda (y) (* y (power-env pe))))
+ (if (and (not (vequal1 (channel->float-vector)
+ (float-vector 0.000 0.132 0.246 0.346 0.432 0.507 0.573 0.630 0.679 0.722 0.760
+ 0.792 0.821 0.845 0.867 0.886 0.902 0.916 0.928 0.939 0.948 0.956
+ 0.963 0.969 0.975 0.979 0.983 0.987 0.990 0.992 0.995 0.997 0.998)))
+ (not (vequal1 (channel->float-vector)
+ (float-vector 0.000 0.135 0.253 0.354 0.442 0.518 0.584 0.641 0.691 0.733 0.771
+ 0.803 0.830 0.855 0.875 0.893 0.909 0.923 0.934 0.945 0.953 0.961
+ 0.968 0.973 0.978 0.982 0.986 0.987 0.990 0.992 0.995 0.997 0.998))))
+ (snd-display #__line__ ";power-env .01: ~A" (channel->float-vector))))
+ (let ((name (file-name ind)))
+ (close-sound ind)
+ (if (file-exists? name) (delete-file name))))
+ (set! *clm-srate* old-srate))
+
+ (let ((ind (new-sound "tmp.snd" 1 22050 mus-ldouble mus-next :size 50)))
+ (set! (sample 3) 1.0)
+ (filter-channel (float-vector .5 1.0 .5) 3)
+ (let ((data (channel->float-vector 0 10)))
+ (if (not (vequal data (float-vector 0.000 0.000 0.000 0.500 1.000 0.500 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";filter (sym 3): ~A" data)))
+ (undo)
+ (filter-channel (float-vector .5 1.0 .25) 3)
+ (let ((data (channel->float-vector 0 10)))
+ (if (not (vequal data (float-vector 0.000 0.000 0.000 0.500 1.000 0.250 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";filter (3): ~A" data)))
+ (undo)
+ (filter-channel (float-vector .5 1.0 1.0 .5) 4)
+ (let ((data (channel->float-vector 0 10)))
+ (if (not (vequal data (float-vector 0.000 0.000 0.000 0.500 1.000 1.000 0.500 0.000 0.000 0.000)))
+ (snd-display #__line__ ";filter (sym 4): ~A" data)))
+ (undo)
+ (filter-channel (float-vector .5 1.0 1.0 .25) 4)
+ (let ((data (channel->float-vector 0 10)))
+ (if (not (vequal data (float-vector 0.000 0.000 0.000 0.500 1.000 1.000 0.250 0.000 0.000 0.000)))
+ (snd-display #__line__ ";filter (4): ~A" data)))
+ (undo)
+ (close-sound ind))
+
+ (let ()
+ (new-sound "tmp.snd" 1 22050 mus-ldouble mus-next #f 100)
+ (set! (sample 10) 0.5)
+ (filter-sound (float-vector 1.0 0.0 1.0) 3)
+ (if (not (vequal (channel->float-vector 5 10) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
+ (snd-display #__line__ ";filter-sound 1 0 1: ~A" (channel->float-vector 5 10)))
+ (undo)
+ (filter-channel (float-vector 1.0 0.0 1.0) 3)
+ (if (not (vequal (channel->float-vector 5 10) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
+ (snd-display #__line__ ";filter-channel (v) 1 0 1: ~A" (channel->float-vector 5 10)))
+ (undo)
+ (filter-sound '(0 1 1 1) 100)
+ (let ((coeffs (make-fir-coeffs 100 (make-float-vector 100 0.5)))
+ (data (channel->float-vector 10 100))
+ (happy #t))
+ (do ((i 0 (+ i 1)))
+ ((or (not happy) (= i 100)))
+ (if (fneq (data i) (coeffs i))
+ (begin
+ (snd-display #__line__ ";coeffs '(0 1 1 1): ~A ~A ~A" i (coeffs i) (data i))
+ (set! happy #f)))))
+ (undo)
+ (filter-sound '(0 1 1 1) 1000)
+ (if (not (vequal (channel->float-vector 5 10) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";filter-sound 1 (1000): ~A" (channel->float-vector 5 10)))
+ (undo)
+ (make-selection 5 15)
+ (filter-selection '(0 1 1 1) 100)
+ (if (and (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 11)))
+ (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 111))))
+ (snd-display #__line__ ";filter-selection truncated: ~S" (edit-fragment 2)))
+ (undo)
+ (filter-selection '(0 1 1 1) 100 #f)
+ (if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 100" "set" 5 111)))
+ (snd-display #__line__ ";filter-selection not truncated: ~S" (edit-fragment 2)))
+ (if (not (vequal (channel->float-vector 50 10) (float-vector -0.016 0.018 -0.021 0.024 -0.029 0.035 -0.045 0.064 -0.106 0.318)))
+ (snd-display #__line__ ";filter-selection no trunc: ~A" (channel->float-vector 50 10)))
+ (undo)
+ (filter-selection '(0 1 1 1) 1024 #t)
+ (if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 1024" "set" 5 11)))
+ (snd-display #__line__ ";filter-selection truncated (1000): ~S" (edit-fragment 2)))
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";filter-selection 1000 untrunc? ~A" (maxamp)))
+ (undo)
+ (filter-selection '(0 1 1 1) 1024 #f)
+ (if (not (equal? (edit-fragment 2) (list "filter-selection '(0.000 1.000 1.000 1.000) 1024" "set" 5 1035)))
+ (snd-display #__line__ ";filter-selection not truncated (1000): ~S" (edit-fragment 2)))
+ (if (fneq (maxamp) 0.318) (snd-display #__line__ ";filter-selection 1000 no trunc? ~A" (maxamp)))
+ (if (not (vequal (channel->float-vector 517 10) (float-vector 0.035 -0.045 0.064 -0.106 0.318 0.318 -0.106 0.064 -0.045 0.035)))
+ (snd-display #__line__ ";filter-selection 1000 no trunc: ~A" (channel->float-vector 505 10)))
- (set! (transform-graph-type) graph-once)
- (set! (fft-window) 6)
- (set! (show-y-zero) #f)
- (set! (show-transform-peaks) #f)
- (set! (fft-log-frequency) #f)
- (set! (fft-log-magnitude) #f)
- (set! (with-verbose-cursor) #f)
- (set! (show-grid) #f)
- (set! (show-sonogram-cursor) #f)
- (set! (with-tracking-cursor) #f)
- (set! (show-controls) #f)
- (set! (speed-control-tones) 12)
- (set! (wavelet-type) 0)
- (set! (spectrum-start) 0.0)
- (set! (spectro-hop) 4)
- (set! (fft-window-alpha) 0.0)
- (set! (fft-window-beta) 0.0)
- (set! (min-dB) -60.0)
- (set! (reverb-control-decay) 1.0)
+ (undo)
+ (filter-channel '(0 1 1 1) 10)
+ (if (not (vequal (channel->float-vector 10 10) (float-vector 0.008 -0.025 0.050 -0.098 0.316 0.316 -0.098 0.050 -0.025 0.008)))
+ (snd-display #__line__ ";filter-channel 10: ~A" (channel->float-vector 10 10)))
+ (undo)
+ (filter-channel '(0 1 1 1) 1000)
+ (if (not (vequal (channel->float-vector 5 10) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";filter-channel 1 (1000): ~A" (channel->float-vector 5 10)))
+ (undo)
+ (filter-channel '(0 1 1 0) 10)
+ (if (not (vequal (channel->float-vector 0 30) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ 0.005 0.010 0.006 0.038 0.192 0.192 0.038 0.006 0.010 0.005
+ 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";filter-channel lp: ~A ~A ~A" (channel->float-vector 0 10) (channel->float-vector 10 10) (channel->float-vector 20 10)))
+ (undo)
+ (filter-channel '(0 1 1 0) 10 0 20 #f #f #f #f)
+ (if (not (vequal (channel->float-vector 0 30) (float-vector 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ 0.005 0.010 0.006 0.038 0.192 0.192 0.038 0.006 0.010 0.005
+ 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";filter-channel lp no trunc: ~A ~A ~A" (channel->float-vector 0 10) (channel->float-vector 10 10) (channel->float-vector 20 10)))
+ (undo)
+ (close-sound))
+
+ (let ((ind (new-sound "tmp.snd" 2 22050 mus-ldouble mus-next #f 100)))
+ (set! (sample 10) 0.5)
+ (set! (sample 5 ind 1) -0.5)
+ (set! (sync ind) 1)
+ (filter-sound (float-vector 1.0 0.0 1.0) 3)
+ (if (not (vequal (channel->float-vector 5 10 ind 0) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-sound 1 0 1: ~A" (channel->float-vector 5 10)))
+ (if (not (vequal (channel->float-vector 0 10 ind 1) (float-vector 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-sound 1 0 2: ~A" (channel->float-vector 0 10 ind 1)))
+ (undo)
+ (filter-sound '(0 1 1 1) 1000)
+ (if (not (vequal (channel->float-vector 5 10 ind 0) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-sound 1 (1000): ~A" (channel->float-vector 5 10)))
+ (if (not (vequal (channel->float-vector 0 10 ind 1) (float-vector 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-sound 2 (1000): ~A" (channel->float-vector 0 10)))
+ (undo)
+ (make-selection 0 20)
+ (filter-selection (float-vector 1.0 0.0 1.0) 3)
+ (if (not (vequal (channel->float-vector 5 10 ind 0) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-selection 1 0 1: ~A" (channel->float-vector 5 10)))
+ (if (not (vequal (channel->float-vector 0 10 ind 1) (float-vector 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-selection 1 0 2: ~A" (channel->float-vector 0 10 ind 1)))
+ (undo)
+ (set! (sync ind) 0)
+ (filter-selection (float-vector 1.0 0.0 1.0) 3)
+ (if (not (vequal (channel->float-vector 5 10 ind 0) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-selection 1 0 1 (no sync): ~A" (channel->float-vector 5 10)))
+ (if (not (vequal (channel->float-vector 0 10 ind 1) (float-vector 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 -0.500 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-selection 1 0 2 (no sync): ~A" (channel->float-vector 0 10 ind 1)))
+ (undo 1 ind 0)
+ (undo 1 ind 1)
+ (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";edpos filter-sel undo: ~A" (edit-position ind 0)))
+ (if (not (= (edit-position ind 1) 1)) (snd-display #__line__ ";edpos filter-sel undo 1: ~A" (edit-position ind 1)))
+ (filter-sound (float-vector 1.0 0.0 1.0) 3)
+ (if (not (vequal (channel->float-vector 5 10 ind 0) (float-vector 0.000 0.000 0.000 0.000 0.000 0.500 0.000 0.500 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-sound 1 0 1 no sync: ~A" (channel->float-vector 5 10)))
+ (if (not (vequal (channel->float-vector 0 10 ind 1) (float-vector 0.000 0.000 0.000 0.000 0.000 -0.500 0.000 0.000 0.000 0.000)))
+ (snd-display #__line__ ";(2) filter-sound 1 0 2 no sync: ~A" (channel->float-vector 0 10 ind 1)))
+ (undo 1 ind 0)
+ (filter-channel '(0 1 1 0) 10 #f #f ind 1)
+ (if (not (vequal (channel->float-vector 0 30 ind 1) (float-vector 0.000 0.000 0.000 0.000 0.000; 0.000 0.000 0.000 0.000 0.000
+ -0.005 -0.010 -0.006 -0.038 -0.192 -0.192 -0.038 -0.006 -0.010 -0.005
+ 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000
+ 0 0 0 0 0)))
+ (snd-display #__line__ ";filter-channel lp: ~A ~A ~A" (channel->float-vector 0 10 ind 1) (channel->float-vector 10 10 ind 1) (channel->float-vector 20 10 ind 1)))
+ (undo 1 ind 1)
+ (close-sound ind))
+
+ (let ((ind (new-sound "tmp.snd" 1 22050 mus-bshort mus-next :size 100))) ; short out needed here
+ (set! (sample 10) 0.5)
+ (set! (sample 20) -0.5)
+ (scale-to 1.0)
+ (if (fneq (sample 10) .999) (snd-display #__line__ ";scale-to 1.0 short (10): ~A" (sample 10)))
+ (if (fneq (sample 20) -.999) (snd-display #__line__ ";scale-to 1.0 short (20): ~A" (sample 10)))
+ (close-sound ind))
+ (let ((ind (new-sound "tmp.snd" 1 22050 mus-byte mus-next :size 100)))
+ (set! (sample 10) 0.5)
+ (set! (sample 20) -0.5)
+ (scale-to 1.0)
+ (if (fneq (sample 10) .992) (snd-display #__line__ ";scale-to 1.0 byte (10): ~A" (sample 10)))
+ (if (fneq (sample 20) -.992) (snd-display #__line__ ";scale-to 1.0 byte (20): ~A" (sample 10)))
+ (close-sound ind))
+
+ (when with-gui
+
+ (set! *transform-graph-type* graph-once)
+ (set! *fft-window* 6)
+ (set! *show-y-zero* #f)
+ (set! *show-transform-peaks* #f)
+ (set! *fft-log-frequency* #f)
+ (set! *fft-log-magnitude* #f)
+ (set! *with-verbose-cursor* #f)
+ (set! *show-grid* #f)
+ (set! *show-sonogram-cursor* #f)
+ (set! *with-tracking-cursor* #f)
+ (set! *show-controls* #f)
+ (set! *speed-control-tones* 12)
+ (set! *wavelet-type* 0)
+ (set! *spectrum-start* 0.0)
+ (set! *spectro-hop* 4)
+ (set! *fft-window-alpha* 0.0)
+ (set! *fft-window-beta* 0.0)
+ (set! *min-dB* -60.0)
+ (set! *reverb-control-decay* 1.0)
(letrec ((test-sound-func-1
(lambda (func name ind-1 ind-2 new-val eq-func leq-func settable channel global)
@@ -44458,36 +37288,37 @@ EDITS: 1
(test-sound-func (lambda (func name ind-1 ind-2 new-val eq-func leq-func settable)
(test-sound-func-1 func name ind-1 ind-2 new-val eq-func leq-func settable #f #f))))
- (let ((ind-1 (new-sound "test-1.snd" mus-next mus-bfloat 22050 1 "mono testing" 100))
- (ind-2 (new-sound "test-2.snd" mus-aifc mus-bshort 44100 2 "stereo testing" 300)))
+ (let ((ind-1 (new-sound "test-1.snd" 1 22050 mus-lfloat mus-next "mono testing" 100))
+ (ind-2 (new-sound "test-2.snd" 2 44100 mus-bshort mus-aifc "stereo testing" 300)))
(for-each
(lambda (data)
(apply test-sound-func data))
(list
(list srate 'srate ind-1 ind-2 48000 = equal? #t)
- (list data-format 'data-format ind-1 ind-2 mus-byte = equal? #t)
+ (list sample-type 'sample-type ind-1 ind-2 mus-byte = equal? #t)
(list data-location 'data-location ind-1 ind-2 123 = equal? #t)
(list data-size 'data-size ind-1 ind-2 12348 = equal? #t)
- (list frames 'frames ind-1 ind-2 12348 = equal? #t)
+ (list framples 'framples ind-1 ind-2 12348 = equal? #t)
(list sync 'sync ind-1 ind-2 2 = equal? #t)
- (list data-format 'data-format ind-1 ind-2 mus-byte = equal? #t)
+ (list sample-type 'sample-type ind-1 ind-2 mus-byte = equal? #t)
(list channels 'channels ind-1 ind-2 0 = equal? #f)
(list chans 'chans ind-1 ind-2 0 = equal? #f)
(list header-type 'header-type ind-1 ind-2 0 = equal? #f)
- (list amp-control 'amp-control ind-1 ind-2 .5 (lambda (a b) (< (abs (- a b)) .01)) feql #t)
- (list contrast-control 'contrast-control ind-1 ind-2 .5 (lambda (a b) (< (abs (- a b)) .01)) feql #t)
- (list expand-control 'expand-control ind-1 ind-2 .5 (lambda (a b) (< (abs (- a b)) .01)) ffeql #t)
- (list speed-control 'speed-control ind-1 ind-2 .5 (lambda (a b) (< (abs (- a b)) .01)) feql #t)
- (list reverb-control-length 'reverb-control-length ind-1 ind-2 .5 (lambda (a b) (< (abs (- a b)) .01)) feql #t)
- (list reverb-control-scale 'reverb-control-scale ind-1 ind-2 .5 (lambda (a b) (< (abs (- a b)) .01)) feql #t)
-
- (list contrast-control? 'contrast-control? ind-1 ind-2 #t equal? equal? #t)
- (list expand-control? 'expand-control? ind-1 ind-2 #t equal? equal? #t)
- (list filter-control? 'filter-control? ind-1 ind-2 #t equal? equal? #t)
- (list reverb-control? 'reverb-control? ind-1 ind-2 #t equal? equal? #t)
- (list read-only 'read-only ind-1 ind-2 #t equal? equal? #t)
+ (reader-cond (with-gui
+ (list amp-control 'amp-control ind-1 ind-2 .5 within-.01? feql #t)
+ (list contrast-control 'contrast-control ind-1 ind-2 .5 within-.01? feql #t)
+ (list expand-control 'expand-control ind-1 ind-2 .5 within-.01? ffeql #t)
+ (list speed-control 'speed-control ind-1 ind-2 .5 within-.01? feql #t)
+ (list reverb-control-length 'reverb-control-length ind-1 ind-2 .5 within-.01? feql #t)
+ (list reverb-control-scale 'reverb-control-scale ind-1 ind-2 .5 within-.01? feql #t)
+
+ (list contrast-control? 'contrast-control? ind-1 ind-2 #t equal? equal? #t)
+ (list expand-control? 'expand-control? ind-1 ind-2 #t equal? equal? #t)
+ (list filter-control? 'filter-control? ind-1 ind-2 #t equal? equal? #t)
+ (list reverb-control? 'reverb-control? ind-1 ind-2 #t equal? equal? #t)
+ (list read-only 'read-only ind-1 ind-2 #t equal? equal? #t)))
(list file-name 'file-name ind-1 ind-2 #f string=? equal? #f)
(list short-file-name 'short-file-name ind-1 ind-2 #f string=? equal? #f)
@@ -44497,7 +37328,7 @@ EDITS: 1
(restore-controls #t)
(reset-controls #t)
(close-sound #t)
- (if (not (equal? (sounds) '())) (snd-display #__line__ ";sounds after close-sound #t: ~A" (sounds)))
+ (if (not (null? (sounds))) (snd-display #__line__ ";sounds after close-sound #t: ~A" (sounds)))
;; snd chn cases
(letrec ((test-channel-func-1
@@ -44507,7 +37338,6 @@ EDITS: 1
(old-2-1 (func ind-2 1))
(old-1-all (func ind-1 #t))
(old-2-all (func ind-2 #t))
- (old-all-0 (func #t 0))
(old-all-all (func #t #t)))
(if (not (eq-func old-1-0 (car old-1-all))) (snd-display #__line__ ";~A channel-func old 1/#t: ~A ~A" name old-1-0 old-1-all))
(if (not (eq-func old-2-0 (car old-2-all))) (snd-display #__line__ ";~A channel-func old 2/#t: ~A ~A" name old-2-0 old-2-all))
@@ -44540,8 +37370,9 @@ EDITS: 1
(lambda (func name ind-1 ind-2 new-val eq-func leq-func settable global)
(test-sound-func-1 func name ind-1 ind-2 new-val eq-func leq-func settable #t global)
(test-channel-func-1 func name ind-1 ind-2 new-val eq-func leq-func settable global))))
- (let ((ind-1 (new-sound "test-1.snd" mus-next mus-bfloat 22050 1 "mono testing" 100))
- (ind-2 (new-sound "test-2.snd" mus-aifc mus-bshort 44100 2 "stereo testing" 300)))
+
+ (let ((ind-1 (new-sound "test-1.snd" 1 22050 mus-ldouble mus-next "mono testing" 100))
+ (ind-2 (new-sound "test-2.snd" 2 44100 mus-bshort mus-aifc "stereo testing" 300)))
(set! (sample 1 ind-1 0) .1)
(set! (sample 2 ind-2 0) .2)
(set! (sample 3 ind-2 1) .3)
@@ -44549,44 +37380,28 @@ EDITS: 1
(lambda (data)
(apply test-channel-func data))
(list
- (list min-dB 'min-dB ind-1 ind-2 -100.0 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list x-position-slider 'x-position-slider ind-1 ind-2 .1 (lambda (a b) (< (abs (- a b)) .01)) feql #t #f)
+ (list min-dB 'min-dB ind-1 ind-2 -100.0 within-.01? feql #t #t)
- (list y-position-slider 'y-position-slider ind-1 ind-2 0.5 (lambda (a b) (< (abs (- a b)) .01)) feql #t #f)
- (list x-zoom-slider 'x-zoom-slider ind-1 ind-2 0.2 (lambda (a b) (< (abs (- a b)) .01)) feql #t #f)
- (list y-zoom-slider 'y-zoom-slider ind-1 ind-2 0.2 (lambda (a b) (< (abs (- a b)) .01)) feql #t #f)
+ (list x-position-slider 'x-position-slider ind-1 ind-2 .1 within-.01? feql #t #f)
+ ;; (list y-position-slider 'y-position-slider ind-1 ind-2 0.5 within-.01? feql #t #f)
+ (list x-zoom-slider 'x-zoom-slider ind-1 ind-2 0.2 within-.01? feql #t #f)
+ (list y-zoom-slider 'y-zoom-slider ind-1 ind-2 0.2 within-.01? feql #t #f)
(list fft-window-alpha 'fft-window-alpha ind-1 ind-2 0.5 (lambda (a b) (< (abs (- a b)) .02)) feql #t #t)
(list fft-window-beta 'fft-window-beta ind-1 ind-2 0.5 (lambda (a b) (< (abs (- a b)) .02)) feql #t #t)
- (list spectrum-end 'spectrum-end ind-1 ind-2 0.2 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list spectrum-start 'spectrum-start ind-1 ind-2 0.1 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list spectro-x-angle 'spectro-x-angle ind-1 ind-2 10.0 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list spectro-x-scale 'spectro-x-scale ind-1 ind-2 0.2 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list spectro-y-angle 'spectro-y-angle ind-1 ind-2 10.0 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list spectro-y-scale 'spectro-y-scale ind-1 ind-2 0.1 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list spectro-z-angle 'spectro-z-angle ind-1 ind-2 10.0 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list spectro-z-scale 'spectro-z-scale ind-1 ind-2 0.3 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
- (list beats-per-minute 'beats-per-minute ind-1 ind-2 100.0 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
+ (list spectrum-end 'spectrum-end ind-1 ind-2 0.2 within-.01? feql #t #t)
+ (list spectrum-start 'spectrum-start ind-1 ind-2 0.1 within-.01? feql #t #t)
+ (list spectro-x-angle 'spectro-x-angle ind-1 ind-2 10.0 within-.01? feql #t #t)
+ (list spectro-x-scale 'spectro-x-scale ind-1 ind-2 0.2 within-.01? feql #t #t)
+ (list spectro-y-angle 'spectro-y-angle ind-1 ind-2 10.0 within-.01? feql #t #t)
+ (list spectro-y-scale 'spectro-y-scale ind-1 ind-2 0.1 within-.01? feql #t #t)
+ (list spectro-z-angle 'spectro-z-angle ind-1 ind-2 10.0 within-.01? feql #t #t)
+ (list spectro-z-scale 'spectro-z-scale ind-1 ind-2 0.3 within-.01? feql #t #t)
+ (list beats-per-minute 'beats-per-minute ind-1 ind-2 100.0 within-.01? feql #t #t)
- (list spectro-hop 'spectro-hop ind-1 ind-2 10 = equal? #t #t)
- (list cursor 'cursor ind-1 ind-2 50 = equal? #t #f)
- (list cursor-style 'cursor-style ind-1 ind-2 1 = equal? #t #t)
- (list cursor-size 'cursor-size ind-1 ind-2 10 = equal? #t #t)
- (list frames 'frames ind-1 ind-2 50 = equal? #t #f)
- (list zero-pad 'zero-pad ind-1 ind-2 1 = equal? #t #t)
- (list wavelet-type 'wavelet-type ind-1 ind-2 1 = equal? #t #t)
- (list time-graph-type 'time-graph-type ind-1 ind-2 graph-as-wavogram = equal? #t #t)
- (list wavo-hop 'wavo-hop ind-1 ind-2 10 = equal? #t #t)
- (list wavo-trace 'wavo-trace ind-1 ind-2 10 = equal? #t #t)
- (list transform-size 'transform-size ind-1 ind-2 64 = equal? #t #t)
- (list transform-graph-type 'transform-graph-type ind-1 ind-2 1 = equal? #t #t)
- (list fft-window 'fft-window ind-1 ind-2 1 = equal? #t #t)
- ; (list transform-type 'transform-type ind-1 ind-2 1 equal? equal? #t #t)
- (list transform-normalization 'transform-normalization ind-1 ind-2 2 = equal? #t #t)
- (list max-transform-peaks 'max-transform-peaks ind-1 ind-2 10 = equal? #t #t)
(list dot-size 'dot-size ind-1 ind-2 10 = equal? #t #t)
(list x-axis-style 'x-axis-style ind-1 ind-2 1 = equal? #t #t)
- ; (list left-sample 'left-sample ind-1 ind-2 1 (lambda (a b) (< (abs (- a b)) 2)) equal? #t #f)
- ; (list right-sample 'right-sample ind-1 ind-2 50 (lambda (a b) (< (abs (- a b)) 2)) equal? #t #f)
+ ;; (list left-sample 'left-sample ind-1 ind-2 1 (lambda (a b) (< (abs (- a b)) 2)) equal? #t #f)
+ ;; (list right-sample 'right-sample ind-1 ind-2 50 (lambda (a b) (< (abs (- a b)) 2)) equal? #t #f)
(list show-axes 'show-axes ind-1 ind-2 2 = equal? #t #t)
(list transform-graph? 'transform-graph? ind-1 ind-2 #t equal? equal? #t #f)
@@ -44595,7 +37410,7 @@ EDITS: 1
(list squelch-update 'squelch-update ind-1 ind-2 #t equal? equal? #t #f)
(list show-y-zero 'show-y-zero ind-1 ind-2 #t equal? equal? #t #t)
(list show-grid 'show-grid ind-1 ind-2 #t equal? equal? #t #t)
- (list grid-density 'grid-density ind-1 ind-2 0.5 (lambda (a b) (< (abs (- a b)) .01)) feql #t #t)
+ (list grid-density 'grid-density ind-1 ind-2 0.5 within-.01? feql #t #t)
(list show-sonogram-cursor 'show-sonogram-cursor ind-1 ind-2 #t equal? equal? #t #t)
(list show-marks 'show-marks ind-1 ind-2 #f equal? equal? #t #t)
(list show-transform-peaks 'show-transform-peaks ind-1 ind-2 #t equal? equal? #t #t)
@@ -44603,8502 +37418,3359 @@ EDITS: 1
(list fft-log-magnitude 'fft-log-magnitude ind-1 ind-2 #t equal? equal? #t #t)
(list show-mix-waveforms 'show-mix-waveforms ind-1 ind-2 #f equal? equal? #t #t)
(list with-verbose-cursor 'with-verbose-cursor ind-1 ind-2 #t equal? equal? #t #t)
+ (list max-transform-peaks 'max-transform-peaks ind-1 ind-2 10 = equal? #t #t)
+ (list wavelet-type 'wavelet-type ind-1 ind-2 1 = equal? #t #t)
+ (list transform-size 'transform-size ind-1 ind-2 64 = equal? #t #t)
+ (list transform-graph-type 'transform-graph-type ind-1 ind-2 1 = equal? #t #t)
+ (list transform-normalization 'transform-normalization ind-1 ind-2 2 = equal? #t #t)
- )))
- (update-time-graph #t #t)
- (update-transform-graph #t #t)
- (update-lisp-graph #t #t)
-
- (close-sound #f)
- (close-sound #f)
- (if (not (equal? (sounds) '())) (snd-display #__line__ ";sounds after close-sound #t: ~A" (sounds))))))
-
- (letrec ((test-sound-func-2
- (lambda (func name ind-1 ind-2 new-val eq-func leq-func)
- (let* ((old-global-val (func))
- (old-vals (func #t))
- (old-1 (func ind-1))
- (old-2 (func ind-2))
- (sel-snd (selected-sound))
- (unsel-snd (if (equal? sel-snd ind-1) ind-2 ind-1)))
- (if (not (or (leq-func old-vals (list old-1 old-2))
- (leq-func old-vals (list old-2 old-1))))
- (snd-display #__line__ ";~A sound-func #t: ~A, sep: ~A" name old-vals (list old-1 old-2)))
- (set! (func) new-val)
- (if (not (eq-func (func) new-val))
- (snd-display #__line__ ";~A global set no arg: ~A ~A" name (func) new-val))
- (if (not (eq-func (func) (func sel-snd)))
- (snd-display #__line__ ";~A global set no arg sel: ~A ~A" name (func) (func sel-snd)))
- (if (not (eq-func (func) (func unsel-snd)))
- (snd-display #__line__ ";~A set global no arg unsel: ~A ~A (sel: ~A)" name (func) (func unsel-snd) (func sel-snd)))
- (if (not (or (leq-func (func #t) (list (func sel-snd) (func unsel-snd)))
- (leq-func (func #t) (list (func unsel-snd) (func sel-snd)))))
- (snd-display #__line__ ";~A func #t set: ~A, sep: ~A" name (func #t) (list (func sel-snd) (func unsel-snd))))
- (set! (func) old-global-val)
- (set! (func ind-1) new-val)
- (if (not (eq-func (func ind-1) new-val))
- (snd-display #__line__ ";~A set arg: ~A ~A" name (func ind-1) new-val))
- (if (eq-func (func ind-2) new-val)
- (snd-display #__line__ ";~A set arg (2): ~A ~A" name (func ind-2) new-val))
- (if (not (or (leq-func (func #t) (list (func ind-1) (func ind-2)))
- (leq-func (func #t) (list (func ind-2) (func ind-1)))))
- (snd-display #__line__ ";~A func arg set: ~A, sep: ~A" name (func #t) (list (func ind-1) (func ind-2))))
- (set! (func ind-1) old-1)
- (set! (func #t) new-val)
- (if (not (leq-func (func #t) (list new-val new-val)))
- (snd-display #__line__ ";~A func arg set #t: ~A, sep: ~A" name (func #t) (list new-val new-val)))
- (if (not (eq-func (func ind-1) new-val))
- (snd-display #__line__ ";~A set arg #t: ~A ~A" name (func ind-1) new-val))
- (if (not (eq-func (func ind-2) new-val))
- (snd-display #__line__ ";~A set arg #t (2): ~A ~A" name (func ind-2) new-val))
- (if (eq-func (func) new-val)
- (snd-display #__line__ ";~A overwrote global: ~A ~A" name (func) new-val))
- (set! (func ind-1) old-1)
- (set! (func ind-2) old-2)
- (if (not (eq-func (func ind-1) old-1))
- (snd-display #__line__ ";~A set arg #t old: ~A ~A" name (func ind-1) old-1))
- (if (not (eq-func (func ind-2) old-2))
- (snd-display #__line__ ";~A set arg #t (2): ~A ~A" name (func ind-2) old-2))))))
-
- (let ((ind-1 (new-sound "test-1.snd" mus-next mus-bfloat 22050 1 "mono testing" 100))
- (ind-2 (new-sound "test-2.snd" mus-aifc mus-bshort 44100 2 "stereo testing" 300)))
-
- (for-each
- (lambda (data)
- (apply test-sound-func-2 data))
- (list
- (list filter-control-in-dB 'filter-control-in-dB ind-1 ind-2 #t eq? equal?)
- (list filter-control-in-hz 'filter-control-in-hz ind-1 ind-2 #t eq? equal?)
- (list show-controls 'show-controls ind-1 ind-2 #t eq? equal?)
-
- (list speed-control-tones 'speed-control-tones ind-1 ind-2 14 = equal?)
- (list speed-control-style 'speed-control-style ind-1 ind-2 speed-control-as-semitone = equal?)
- (list filter-control-order 'filter-control-order ind-1 ind-2 14 = equal?)
-
- (list expand-control-length 'expand-control-length ind-1 ind-2 .25 (lambda (a b) (< (abs (- a b)) .01)) feql)
- (list expand-control-ramp 'expand-control-ramp ind-1 ind-2 .25 (lambda (a b) (< (abs (- a b)) .01)) feql)
- (list expand-control-hop 'expand-control-hop ind-1 ind-2 .25 (lambda (a b) (< (abs (- a b)) .01)) feql)
- (list expand-control-jitter 'expand-control-jitter ind-1 ind-2 .25 (lambda (a b) (< (abs (- a b)) .01)) feql)
- (list contrast-control-amp 'contrast-control-amp ind-1 ind-2 .25 (lambda (a b) (< (abs (- a b)) .01)) feql)
- (list reverb-control-feedback 'reverb-control-feedback ind-1 ind-2 .25 (lambda (a b) (< (abs (- a b)) .01)) feql)
- (list reverb-control-lowpass 'reverb-control-lowpass ind-1 ind-2 .25 (lambda (a b) (< (abs (- a b)) .01)) feql)
- (list reverb-control-decay 'reverb-control-decay ind-1 ind-2 .25 (lambda (a b) (< (abs (- a b)) .01)) feql)
-
- (list amp-control-bounds 'amp-control-bounds ind-1 ind-2 (list 0.0 2.0) feql
- (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
- (list contrast-control-bounds 'contrast-control-bounds ind-1 ind-2 (list 0.0 2.0) feql
- (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
- (list expand-control-bounds 'expand-control-bounds ind-1 ind-2 (list 0.1 2.0) feql
- (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
- (list speed-control-bounds 'speed-control-bounds ind-1 ind-2 (list 0.1 2.0) feql
- (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
- (list reverb-control-length-bounds 'reverb-control-length-bounds ind-1 ind-2 (list 0.0 2.0) feql
- (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
- (list reverb-control-scale-bounds 'reverb-control-scale-bounds ind-1 ind-2 (list 0.0 2.0) feql
- (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))))
- (close-sound ind-1)
- (close-sound ind-2)))
-
- (if (and all-args (defined? 'snd-simulate-keystroke))
- (begin
- ;; monkeys pound on keyboard...
- (copy-file (string-append (getcwd) "/2a.snd") (string-append (getcwd) "/test.snd"))
- (let ((ind (open-sound "test.snd"))
- (last-time (+ (real-time) 300))
- (tests 2500))
- (do ((i 0 (+ 1 i)))
- ((or (> (real-time) last-time)
- (= i tests)))
- (let ((k (+ 1 (random 200)))
- (s (let ((v (random 5)))
- (if (= v 1) 4
- (if (= v 2) 8
- (if (= v 3) 12
- 0))))))
- (if (> k 127) (begin (set! k (char->integer #\x)) (set! s 4)))
- (if (> (random 1.0) .99) (clear-listener))
- (if (or (= k (char->integer #\e))
- (= k (char->integer #\E)))
- (snd-simulate-keystroke ind 0 (char->integer #\g) 0))
- (snd-simulate-keystroke ind (random (channels ind)) k s)
- (if (and (sound? ind) (> (frames ind 0) 1000000))
- (begin
- (close-sound ind)
- (copy-file (string-append (getcwd) "/2a.snd") (string-append (getcwd) "/test.snd"))))
- (if (not (sound? ind))
- (set! ind (open-sound "test.snd")))))
- (close-sound ind))))
-
- (set! (remember-sound-state) #t)
- (let ((ind (open-sound "oboe.snd")))
- (set! (transform-graph? ind 0) #t)
- (set! (show-transform-peaks ind 0) #t)
- (set! (show-y-zero ind 0) #t)
- (close-sound ind))
- (let ((ind (open-sound "oboe.snd")))
- (if (or (not (transform-graph? ind 0))
- (not (show-transform-peaks ind 0))
- (not (show-y-zero ind 0)))
- (snd-display #__line__ ";remember-sound-state: ~A ~A ~A" (transform-graph? ind 0) (show-transform-peaks ind 0) (show-y-zero ind 0)))
- (close-sound ind))
- (reset-almost-all-hooks)
- (set! (remember-sound-state) #f)
- (if (file-exists? "remembered-oboe.snd.scm")
- (delete-file "remembered-oboe.snd.scm"))
-
- (map-sound-files (lambda (n) (if (> (mus-sound-duration n) 1000.0) (snd-display #__line__ ";~A is pretty long! ~A" n (mus-sound-duration n)))))
- (if (string? sf-dir)
- (map-sound-files
- (lambda (n)
- (catch #t
- (lambda ()
- (if (> (mus-sound-duration (string-append sf-dir n)) 1000.0)
- (snd-display #__line__ ";~A is pretty long! ~A"
- n
- (mus-sound-duration (string-append sf-dir n)))))
- (lambda args #f))
- (mus-sound-forget (string-append sf-dir n)))
- sf-dir))
-
- (let ((snd (new-sound "test.snd")))
- (pad-channel 0 20)
- (map-channel (lambda (y) 1.0))
- (env-channel-with-base '(0 0 1 1) 1.0)
- (let ((data (channel->vct 0 20)))
- (if (not (vequal data (vct 0.0 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95)))
- (snd-display #__line__ ";env-chan 1.0: ~A" data)))
- (undo)
- (env-channel-with-base '(0 0 1 1 2 1 3 0) 0.0)
- (let ((data (channel->vct 0 20)))
- (if (not (vequal data (vct 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";env-chan 0.0: ~A" data)))
- (undo)
- (env-channel-with-base '(0 0 1 1) 100.0)
- (let ((data (channel->vct 0 20)))
- (if (not (vequal data (vct 0.0 0.003 0.006 0.010 0.015 0.022 0.030 0.041 0.054 0.070 0.091 0.117 0.150 0.191 0.244 0.309 0.392 0.496 0.627 0.792)))
- (snd-display #__line__ ";env-chan 100.0: ~A" data)))
- (undo)
- (env-channel-with-base '(0 0 1 1) 0.01)
- (let ((data (channel->vct 0 20)))
- (if (not (vequal data (vct 0.0 0.208 0.373 0.504 0.608 0.691 0.756 0.809 0.850 0.883 0.909 0.930 0.946 0.959 0.970 0.978 0.985 0.990 0.994 0.997)))
- (snd-display #__line__ ";env-chan 0.01: ~A" data)))
- (undo)
-
- (env-channel-with-base '(0 0 1 1) 1.0 5 10)
- (let ((data (channel->vct 0 20)))
- (if (not (vequal data (vct 1.0 1.0 1.0 1.0 1.0 0.0 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";env-chan 1.0 seg: ~A" data)))
- (undo)
- (env-channel-with-base '(0 0 1 1 2 1 3 0) 0.0 5 10)
- (let ((data (channel->vct 0 20)))
- (if (not (vequal data (vct 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";env-chan 0.0 seg: ~A" data)))
- (undo)
- (env-channel-with-base '(0 0 1 1) 100.0 5 10)
- (let ((data (channel->vct 0 20)))
- (if (not (vequal data (vct 1.0 1.0 1.0 1.0 1.0 0.0 0.007 0.018 0.037 0.068 0.120 0.208 0.353 0.595 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";env-chan 100.0 seg: ~A" data)))
- (undo)
- (env-channel-with-base '(0 0 1 1) 0.01 5 10)
- (let ((data (channel->vct 0 20)))
- (if (not (vequal data (vct 1.0 1.0 1.0 1.0 1.0 0.0 0.405 0.647 0.792 0.880 0.932 0.963 0.982 0.993 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";env-chan 0.01 seg: ~A" data)))
- (undo)
- (close-sound snd))
-
- (let ((ind1 (open-sound "now.snd"))
- (ind2 (open-sound "oboe.snd")))
- (let ((val (channel-mean ind1 0)))
- (if (fneq val 5.02560673308833e-5) (snd-display #__line__ ";channel-mean: ~A" val)))
- (let ((val (channel-total-energy ind1 0)))
- (if (fneq val 50.7153476262465) (snd-display #__line__ ";channel-total-energy: ~A" val)))
- (let ((val (channel-average-power ind1 0)))
- (if (fneq val 0.00155078578803922) (snd-display #__line__ ";channel-average-power: ~A" val)))
- (let ((val (channel-rms ind1 0)))
- (if (fneq val 0.039380017623653) (snd-display #__line__ ";channel-rms: ~A" val)))
- (let ((val (channel-norm ind1 0)))
- (if (fneq val 7.12147088923675) (snd-display #__line__ ";channel-norm: ~A" val)))
- (let ((val (channel-variance ind1 0)))
- (if (fneq val 50.7153476237207) (snd-display #__line__ ";channel-variance: ~A" val)))
- (let ((val (channel-lp 2 ind1 0)))
- (if (fneq val 7.12147088923675) (snd-display #__line__ ";channel-lp 2: ~A" val)))
- (let ((val (channel-lp 1 ind1 0)))
- (if (fneq val 775.966033935547) (snd-display #__line__ ";channel-lp 1: ~A" val)))
- (let ((val (channel2-inner-product ind1 0 ind2 0)))
- (if (fneq val 1.52892031334341) (snd-display #__line__ ";channel2-inner-product: ~A" val)))
- (let ((val (channel2-angle ind1 0 ind2 0)))
- (if (fneq val 1.55485084385627) (snd-display #__line__ ";channel2-angle: ~A" val)))
- (let ((val (channel2-orthogonal? ind1 0 ind2 0)))
- (if val (snd-display #__line__ ";channel2-orthogonal: ~A" val)))
- (let ((val (channel2-coefficient-of-projection ind1 0 ind2 0)))
- (if (fneq val 0.0301470932351876) (snd-display #__line__ ";channel2-coefficient-of-projection: ~A" val)))
- (close-sound ind1)
- (set! ind1 (open-sound "oboe.snd"))
- (scale-by .99 ind1 0)
- (let ((dist (channel-distance ind1 0 ind2 0)))
- (if (fneq dist .1346) (snd-display #__line__ ";channel-distance: ~A" dist)))
-
- (close-sound ind1)
- (close-sound ind2))
-
- (let ((loboe (string-append (getcwd) "/oboe.snd"))
- (ltest (string-append (getcwd) "/test.snd")))
- (copy-file loboe ltest)
- (mus-sound-forget ltest)
- (let* ((ind (open-sound ltest))
- (mx (maxamp ind 0))
- (chns (chans ind))
- (sr (srate ind))
- (fr (frames ind 0)))
- (if (or (not (= (chans ind) (mus-sound-chans loboe)))
- (not (= (srate ind) (mus-sound-srate loboe)))
- (not (= (frames ind) (mus-sound-frames loboe))))
- (snd-display #__line__ ";copy oboe -> test seems to have failed? ~A ~A ~A"
- (chans ind) (srate ind) (frames ind))
- (with-local-hook
- update-hook
- (list (lambda (orig-ind)
- (lambda (new-ind)
- (set! ind new-ind))))
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (let ((v (channel->vct)))
- (if (not (vct? v))
- (snd-display #__line__ ";channel->vct of oboe copy is null??")
- (array->file ltest v fr sr chns))
- (update-sound ind)
- (let ((mx1 (maxamp ind 0)))
- (if (fneq mx mx1)
- (snd-display #__line__ ";update-sound looped maxamp: ~A ~A ~A ~A ~A (~A)" i ind (frames ind) mx1 mx (/ mx1 mx))))
- (if (not (= (chans ind) chns)) (snd-display #__line__ ";update-sound looped chans: ~A ~A" chns (chans ind)))
- (if (not (= (srate ind) sr)) (snd-display #__line__ ";update-sound looped srate: ~A ~A" sr (srate ind)))
- (if (not (= (frames ind) fr)) (snd-display #__line__ ";update-sound looped frames: ~A ~A" fr (frames ind 0)))))
- (let* ((old-ind (open-sound "oboe.snd"))
- (diff 0.0)
- (rd (make-sampler 0 ind 0))
- (home (sampler-home rd)))
- (scan-channel (lambda (y)
- (let ((cd (abs (- y (rd)))))
- (if (> cd diff) (set! diff cd))
- #f))
- 0 fr old-ind 0)
- (if (fneq diff 0.0)
- (snd-display #__line__ ";update-sound looped overall max diff: ~A, sounds: ~A, ind: ~A, old-ind: ~A, rd: ~A" diff (sounds) ind old-ind home))
- (close-sound old-ind)))))
- (close-sound ind)))
-
- (if (file-exists? "test.snd") (delete-file "test.snd"))
- (let* ((ind (open-sound "oboe.snd"))
- (data (channel->vct)))
- (do ((i 0 (+ 1 i)))
- ((= i 5))
- (array->file "test.snd" data (frames ind) 22050 1)
- (file->array "test.snd" 0 0 (frames) data)
- (let ((diff 0.0)
- (ctr 0))
- (scan-channel (lambda (y)
- (let ((cd (abs (- y (vct-ref data ctr)))))
- (if (> cd diff) (set! diff cd))
- (set! ctr (+ 1 ctr))
- #f)))
- (if (fneq diff 0.0) (snd-display #__line__ ";arr->file->array overall max diff: ~A" diff))))
-
- ;; now clear sono bins if possible
- (set! (colormap-size) 16)
- (set! (transform-size ind 0) 8)
- (set! (transform-graph-type ind 0) graph-as-sonogram)
- (set! (transform-graph? ind 0) #t)
- (update-transform-graph)
- (set! (x-bounds) (list 0.0 .04))
- (update-time-graph)
- (update-transform-graph)
- (set! (zoom-focus-style) (lambda (s c z x0 x1 range)
- 0))
- (if (not (procedure? (zoom-focus-style)))
- (snd-display #__line__ ";zoom-focus-style as func: ~A" (zoom-focus-style)))
- (set! (zoom-focus-style) zoom-focus-right)
- (if (not (= (zoom-focus-style) zoom-focus-right))
- (snd-display #__line__ ";unset zoom-focus-style as func: ~A" (zoom-focus-style)))
- (close-sound ind))
-
- (if (file-exists? "test.snd") (delete-file "test.snd"))
- (if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
- (let* ((rdin #f)
- (rdout #f)
- (len (mus-sound-frames "oboe.snd"))
- (types (list mus-riff mus-aifc mus-next mus-nist mus-ircam))
- (forms (list mus-lshort mus-bshort mus-b24int mus-l24int mus-bint)))
- (system "cp oboe.snd fmv.snd")
- (do ((i 0 (+ 1 i)))
- ((= i 5))
- (set! rdin (make-readin :file "fmv.snd"))
- (set! rdout (make-sample->file "test.snd" 1 (list-ref forms i) (list-ref types i)))
- (do ((k 0 (+ 1 k)))
- ((= k len))
- (sample->file rdout k 0 (readin rdin)))
- (mus-close rdout)
- (mus-close rdin)
- (system "mv test.snd fmv.snd")
- (mus-sound-forget "test.snd")
- (mus-sound-forget "fmv.snd"))
- (let ((diff 0.0)
- (ctr 0)
- (ind1 (open-sound "oboe.snd"))
- (ind2 (make-file->sample "fmv.snd")))
- (scan-channel (lambda (y)
- (let* ((yy (file->sample ind2 ctr 0))
- (cd (abs (- y yy))))
- (if (> cd diff) (begin (set! diff cd) (display (format #f ";~A: ~A ~A ~A" ctr diff y yy))))
- (set! ctr (+ 1 ctr))
- #f)))
- (if (fneq diff 0.0) (snd-display #__line__ ";file->sample->file overall max diff: ~A" diff))
- (close-sound ind1)))
-
- (let* ((ind (open-sound "1a.snd"))
- (mx (maxamp)))
- ;; jokes from extsnd.html (make sure they run)
- (for-each
- (lambda (name-and-func)
- (let ((name (car name-and-func)))
- ((cadr name-and-func))
- (if (fneq (/ (maxamp) mx) 2.0)
- (if (and (not (eq? name 'set-samples))
- (not (eq? name 'coroutines)))
- (snd-display #__line__ ";silly scalers: ~A ~A" name (/ (maxamp) mx))))
- (revert-sound)))
- (list
- (list 'scale-by (lambda () (scale-by 2.0)))
- (list 'scale-channel (lambda () (scale-channel 2.0)))
- (list 'map-channel (lambda () (map-channel (lambda (val) (* val 2.0)))))
- (list 'set-max (lambda () (set! (maxamp) (* 2 (maxamp)))))
- (list 'env-sound (lambda () (env-sound '(0 2 1 2))))
- (list 'env-channel (lambda () (env-channel (make-env '(0 1 1 1) :scaler 2.0 :length (frames)))))
- (list 'clm-channel (lambda () (clm-channel (make-one-zero :a0 2.0 :a1 0.0))))
- (list 'filter-channel (lambda () (filter-channel (vct 2.0) 1)))
- (list 'vct->channel (lambda () (vct->channel (vct-scale! (channel->vct) 2.0) 0)))
- (list 'mix-selection (lambda () (begin (select-all) (mix-selection 0))))
- (list 'scale-selection (lambda () (begin (select-all) (scale-selection-by 2.0))))
- (list 'mix (lambda () (begin (save-sound-as "temp.snd") (mix "temp.snd" 0) (delete-file "temp.snd"))))
- (list 'sound-data (lambda ()
- (let ((sd (vct->sound-data (channel->vct))))
- (do ((i 0 (+ 1 i)))
- ((= i (frames)))
- (sound-data-set! sd 0 i (* 2.0 (sound-data-ref sd 0 i))))
- (set! (samples 0 (frames)) (sound-data->vct sd)))))
- (list 'convolve (lambda ()
- (let ((flt (make-vct 8)))
- (vct-set! flt 0 2.0)
- (let ((cnv (make-convolve :filter flt))
- (sf (make-sampler 0)))
- (map-channel
- (lambda (val)
- (convolve cnv (lambda (dir)
- (read-sample sf)))))))))
- (list 'fft (lambda ()
- (let* ((len (frames))
- (fsize (expt 2 (ceiling (/ (log len) (log 2)))))
- (rl (channel->vct 0 fsize))
- (im (make-vct fsize)))
- (mus-fft rl im fsize)
- (mus-fft rl im fsize)
- (mus-fft rl im fsize)
- (mus-fft rl im fsize)
- (vct->channel (vct-scale! rl (/ 2.0 (* fsize fsize))) 0 len))))
- (list 'set-samples (lambda () ; too slow for some reason, so cut it short at 100
- (set! (squelch-update) #t)
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (set! (sample i) (* 2 (sample i))))
- (set! (squelch-update) #f)))
- (list 'coroutines (lambda ()
- (set! (squelch-update) #t)
- (let ((make-scaler
- (lambda (start end)
- (letrec ((ctr start)
- (us (lambda (them)
- (set! (sample ctr) (* 2.0 (sample ctr)))
- (set! ctr (+ ctr 2))
- (if (<= ctr end)
- (them us)))))
- us))))
- ((make-scaler 0 100)
- (make-scaler 1 100)))
- (set! (squelch-update) #f)
- ))
- ))
- (close-sound ind))
-
- ;; frame.scm functions
-
- (let ((tag (catch #t (lambda () (frame-reverse! 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame-reverse! bad arg: ~A" tag)))
- (let ((tag (catch #t (lambda () (frame-copy 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame-copy bad arg: ~A" tag)))
-
- (let ((fr1 (make-frame 3 .1 .2 .3)))
- (let ((val (frame-copy fr1)))
- (if (or (fneq (frame-ref val 0) 0.1)
- (fneq (frame-ref val 1) 0.2)
- (fneq (frame-ref val 2) 0.3))
- (snd-display #__line__ ";frame-copy: ~A" val))
- (if (not (equal? val fr1)) (snd-display #__line__ ";frames not equal after copy?"))
- (frame-set! val 0 0.0)
- (if (or (fneq (frame-ref val 0) 0.0)
- (fneq (frame-ref fr1 0) 0.1))
- (snd-display #__line__ ";set of copied frame: ~A ~A" fr1 val))
- (frame-reverse! val)
- (if (or (fneq (frame-ref val 0) 0.3)
- (fneq (frame-ref val 1) 0.2)
- (fneq (frame-ref val 2) 0.0))
- (snd-display #__line__ ";frame-reverse: ~A" val))
- (if (equal? fr1 val) (snd-display #__line__ ";these frames are equal??: ~A ~A" fr1 val))))
-
-
- (let ((tag (catch #t (lambda () (vct->frame 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";vct->frame bad arg: ~A" tag)))
- (let ((tag (catch #t (lambda () (frame->vct 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame->vct bad arg: ~A" tag)))
-
- (let ((fr1 (make-frame 4 .1 .2 .3 .4))
- (vc1 (vct .1 .2 .3 .4)))
- (let ((fr2 (vct->frame vc1))
- (vc2 (frame->vct fr1)))
- (if (not (equal? vc1 vc2)) (snd-display #__line__ ";frame->vct: ~A ~A" vc1 vc2))
- (if (not (equal? fr1 fr2)) (snd-display #__line__ ";vct->frame: ~A ~A" fr1 fr2))
- (vct-set! vc2 0 0.0)
- (frame-set! fr2 0 0.0)
- (if (equal? vc1 vc2) (snd-display #__line__ ";frame->vct + change: ~A ~A" vc1 vc2))
- (if (equal? fr1 fr2) (snd-display #__line__ ";vct->frame + change: ~A ~A" fr1 fr2))
- (let ((vc3 (make-vct 10))
- (fr3 (make-frame 10)))
- (let ((vc4 (frame->vct fr1 vc3))
- (fr4 (vct->frame vc1 fr3)))
- (if (not (equal? vc3 vc4)) (snd-display #__line__ ";frame->vct + v: ~A ~A" vc3 vc4))
- (if (not (equal? fr3 fr4)) (snd-display #__line__ ";vct->frame + fr: ~A ~A" fr3 fr4))
- (if (not (vequal vc3 (vct .1 .2 .3 .4 0 0 0 0 0 0)))
- (snd-display #__line__ ";frame->vct results: ~A -> ~A" fr1 vc3))
- (if (not (equal? fr3 (make-frame 10 .1 .2 .3 .4 0 0 0 0 0 0)))
- (snd-display #__line__ ";vct->frame results: ~A -> ~A" vc1 fr3))))))
-
- (let ((fr1 (make-frame 2 .1 .2))
- (sd1 (make-sound-data 2 5)))
- (frame->sound-data fr1 sd1 3)
- (let ((vc1 (sound-data->vct sd1 0))
- (vc2 (sound-data->vct sd1 1)))
- (if (or (not (vequal vc1 (vct 0 0 0 .1 0)))
- (not (vequal vc2 (vct 0 0 0 .2 0))))
- (snd-display #__line__ ";frame->sound-data: ~A ~A ~A)" sd1 vc1 vc2)))
- (let ((fr2 (make-frame 2)))
- (sound-data->frame sd1 3 fr2)
- (if (not (equal? fr1 fr2)) (snd-display #__line__ ";sound-data->frame: ~A ~A" fr1 fr2))
-
- (let ((tag (catch #t (lambda () (sound-data->frame sd1 0 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";sound-data->frame bad frame arg: ~A" tag)))
- (let ((tag (catch #t (lambda () (sound-data->frame 32 0 fr1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";sound-data->frame bad sound-data arg: ~A" tag)))
- (let ((tag (catch #t (lambda () (frame->sound-data fr1 32 0)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame->sound-data bad sound-data arg: ~A" tag)))
- (let ((tag (catch #t (lambda () (frame->sound-data 32 sd1 0)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";frame->sound-data bad frame arg: ~A" tag)))))
-
- (let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 2 "frame->sound test" 100)))
- (set! (sample 4 index 0) 0.5)
- (set! (sample 4 index 1) 0.25)
- (set! (sample 6 index 1) 1.0)
- (let ((fr1 (sound->frame 1))
- (fr4 (sound->frame 4 index))
- (fr6 (sound->frame 6 index)))
- (if (not (equal? fr1 (make-frame 2 0.0 0.0))) (snd-display #__line__ ";sound->frame 1: ~A" fr1))
- (if (not (equal? fr4 (make-frame 2 0.5 0.25))) (snd-display #__line__ ";sound->frame 4: ~A" fr4))
- (if (not (equal? fr6 (make-frame 2 0.0 1.0))) (snd-display #__line__ ";sound->frame 6: ~A" fr6))
- (frame->sound fr4 8 index)
- (frame->sound fr1 4)
- (frame->sound fr6 0 index)
- (let ((fr0 (sound->frame 0))
- (fr41 (sound->frame 4 index))
- (fr8 (sound->frame 8 index)))
- (if (not (equal? fr0 fr6)) (snd-display #__line__ ";sound->frame 0: ~A" fr0))
- (if (not (equal? fr41 fr1)) (snd-display #__line__ ";sound->frame 41: ~A" fr41))
- (if (not (equal? fr8 fr4)) (snd-display #__line__ ";sound->frame 8: ~A" fr8))))
- (set! (sample 40 index 0) 0.5)
- (set! (sample 40 index 1) 0.3)
- (set! (sample 41 index 0) 0.7)
- (let ((reg (make-region 40 50 index #t)))
- (let ((fr0 (region->frame reg 0))
- (fr1 (region->frame reg 1))
- (fr4 (region->frame reg 4)))
- (if (not (equal? fr0 (make-frame 2 0.5 0.3))) (snd-display #__line__ ";region->frame 0: ~A" fr0))
- (if (not (equal? fr1 (make-frame 2 0.7 0.0))) (snd-display #__line__ ";region->frame 1: ~A" fr1))
- (if (not (equal? fr4 (make-frame 2 0.0 0.0))) (snd-display #__line__ ";region->frame 4: ~A" fr4))))
- (close-sound index))
-
- (let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 1 "frame->sound test" 100)))
- (set! (sample 4 index 0) 0.5)
- (let ((fr1 (sound->frame 1))
- (fr4 (sound->frame 4 index)))
- (if (not (equal? fr1 (make-frame 1 0.0))) (snd-display #__line__ ";sound->frame 1 1: ~A" fr1))
- (if (not (equal? fr4 (make-frame 1 0.5))) (snd-display #__line__ ";sound->frame 1 4: ~A" fr4))
- (frame->sound (make-frame 4 .1 .2 .3 .4) 8 index)
- (let ((fr8 (sound->frame 8 index)))
- (if (not (equal? fr8 (make-frame 1 .1))) (snd-display #__line__ ";sound->frame 1 8: ~A" fr8))))
- (close-sound index))
-
- (let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 1 "frame->sound test" 10)))
- (set! (sample 4 index 0) 0.5)
- (let ((sd1 (sound->sound-data 0 10 index))
- (sd2 (sound->sound-data 10 2)))
- (if (not (equal? sd2 (make-sound-data 1 2))) (snd-display #__line__ ";sound->sound-data 2: ~A" sd2))
- (if (not (vequal (sound-data->vct sd1 0) (vct 0 0 0 0 0.5 0 0 0 0 0)))
- (snd-display #__line__ ";sound->sound-data 10: ~A" sd1))
- (sound-data-set! sd1 0 0 0.7)
- (sound-data->sound sd1 0 10 index)
- (if (not (vequal (channel->vct 0 10 index 0) (vct 0.7 0 0 0 0.5 0 0 0 0 0)))
- (snd-display #__line__ ";sound-data->sound 1: ~A" sd1))
- (let ((tag (catch #t (lambda () (sound-data->sound 32 0)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";sound-data->sound bad sound-data arg: ~A" tag)))
- (let ((tag (catch #t (lambda () (sound-data->sound sd1 0 10 -1)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sound)) (snd-display #__line__ ";sound-data->sound bad sound arg: ~A" tag)))
- (close-sound index)))
-
- (let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 4 "frame->sound test" 10)))
- (set! (sample 4 index 0) 0.5)
- (set! (sample 4 index 1) 0.4)
- (set! (sample 4 index 2) 0.3)
- (set! (sample 4 index 3) 0.2)
- (let ((sd1 (sound->sound-data 0 10 index))
- (sd2 (sound->sound-data 10 2)))
- (if (not (equal? sd2 (make-sound-data 4 2))) (snd-display #__line__ ";sound->sound-data 4 2: ~A" sd2))
- (if (not (vequal (sound-data->vct sd1 0) (vct 0 0 0 0 0.5 0 0 0 0 0)))
- (snd-display #__line__ ";sound->sound-data 4a 10: ~A" (sound-data->vct sd1 0)))
- (if (not (vequal (sound-data->vct sd1 1) (vct 0 0 0 0 0.4 0 0 0 0 0)))
- (snd-display #__line__ ";sound->sound-data 4b 10: ~A" (sound-data->vct sd1 1)))
- (if (not (vequal (sound-data->vct sd1 2) (vct 0 0 0 0 0.3 0 0 0 0 0)))
- (snd-display #__line__ ";sound->sound-data 4c 10: ~A" (sound-data->vct sd1 2)))
- (if (not (vequal (sound-data->vct sd1 3) (vct 0 0 0 0 0.2 0 0 0 0 0)))
- (snd-display #__line__ ";sound->sound-data 4d 10: ~A" (sound-data->vct sd1 3)))
- (sound-data-set! sd1 0 0 0.7)
- (sound-data-set! sd1 1 0 0.8)
- (sound-data-set! sd1 2 0 0.9)
- (sound-data-set! sd1 3 0 0.6)
- (sound-data->sound sd1 0)
- (if (not (vequal (channel->vct 0 10 index 0) (vct 0.7 0 0 0 0.5 0 0 0 0 0)))
- (snd-display #__line__ ";sound-data->sound 1 4a: ~A" (sound-data->vct sd1 0)))
- (if (not (vequal (channel->vct 0 10 index 1) (vct 0.8 0 0 0 0.4 0 0 0 0 0)))
- (snd-display #__line__ ";sound-data->sound 1 4b: ~A" (sound-data->vct sd1 1)))
- (if (not (vequal (channel->vct 0 10 index 2) (vct 0.9 0 0 0 0.3 0 0 0 0 0)))
- (snd-display #__line__ ";sound-data->sound 1 4c: ~A" (sound-data->vct sd1 2)))
- (if (not (vequal (channel->vct 0 10 index 3) (vct 0.6 0 0 0 0.2 0 0 0 0 0)))
- (snd-display #__line__ ";sound-data->sound 1 4d: ~A" (sound-data->vct sd1 3)))
- (close-sound index)))
-
- (for-each
- (lambda (file)
- (let ((index (open-sound file)))
- (let ((fd (make-frame-reader 10000)))
- (if (not (frame-reader? fd)) (snd-display #__line__ ";~A: frame-reader?: ~A" file fd))
- (if (> (frames index) 10000)
- (begin
- (if (frame-reader-at-end? fd) (snd-display #__line__ ";~A: frame-reader-at-end?: ~A" file fd))
- (if (not (= (frame-reader-position fd) 10000))
- (snd-display #__line__ ";~A: frame-reader: position: ~A ~A" fd (frame-reader-position fd) file)))
- (begin
- (if (not (frame-reader-at-end? fd)) (snd-display #__line__ ";~A: not frame-reader-at-end?: ~A" file fd))
- (if (= (frame-reader-position fd) 10000)
- (snd-display #__line__ ";~A: frame-reader: position but frames: ~A ~A ~A" file fd (frame-reader-position fd) (frames index)))))
- (if (not (equal? (frame-reader-home fd) index))
- (snd-display #__line__ ";~A: frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
- (if (not (= (frame-reader-chans fd) (chans index)))
- (snd-display #__line__ ";frame-reader-chans: ~A ~A" (frame-reader-chans fd) (chans index)))
- (let ((fr0 (frame-copy (read-frame fd)))
- (fr1 (frame-copy (next-frame fd)))
- (fr2 (frame-copy (previous-frame fd))))
- (if (not (equal? fr0 (sound->frame 10000 index)))
- (snd-display #__line__ ";~A: frame reader 10000: ~A ~A" file fr0 (sound->frame 10000 index)))
- (if (not (equal? fr1 (sound->frame 10001 index)))
- (snd-display #__line__ ";~A: frame reader 10001: ~A ~A" file fr1 (sound->frame 10001 index)))
- (if (not (equal? fr2 (sound->frame 10001 index)))
- (snd-display #__line__ ";~A: frame reader 10001 prev: ~A ~A" file fr2 (sound->frame 10001 index))))
- (free-frame-reader fd))
- (close-sound index)))
- (list "oboe.snd" "4.aiff" "2.snd" "2a.snd")) ; 2a=eof
-
- (for-each
- (lambda (file)
- (let ((index (open-sound file)))
- (let ((fd (make-sampler 10000)))
- (if (not (sampler? fd)) (snd-display #__line__ ";~A: sampler?: ~A" file fd))
- (if (> (frames index) 10000)
- (begin
- (if (sampler-at-end? fd) (snd-display #__line__ ";~A: sampler-at-end?: ~A" file fd))
- (if (not (= (sampler-position fd) 10000))
- (snd-display #__line__ ";~A: sampler: position: ~A ~A" fd (sampler-position file fd))))
- (begin
- (if (not (sampler-at-end? fd)) (snd-display #__line__ ";~A: not sampler-at-end?: ~A" file fd))
- (if (= (sampler-position fd) 10000)
- (snd-display #__line__ ";~A: sampler: position but samples: ~A ~A ~A" file fd (sampler-position fd) (frames index)))))
- (if (not (equal? (sampler-home fd) (list index 0)))
- (snd-display #__line__ ";~A: sampler: home: ~A ~A ~A" file fd (sampler-home fd) index))
- (let ((fr0 (read-sample fd))
- (fr1 (next-sample fd))
- (fr2 (previous-sample fd)))
- (if (fneq fr0 (sample 10000 index))
- (snd-display #__line__ ";~A: sample reader 10000: ~A ~A" file fr0 (sample 10000 index)))
- (if (fneq fr1 (sample 10001 index))
- (snd-display #__line__ ";~A: sample reader 10001: ~A ~A" file fr1 (sample 10001 index)))
- (if (fneq fr2 (sample 10001 index))
- (snd-display #__line__ ";~A: sample reader 10001 prev: ~A ~A" file fr2 (sample 10001 index))))
- (free-sampler fd))
- (close-sound index)))
- (list "oboe.snd" "4.aiff" "2.snd" "2a.snd" "z.snd")) ; 2a=eof
-
- (let ((old-create (selection-creates-region)))
- (set! (selection-creates-region) #t)
- (for-each
- (lambda (file)
- (let ((index (open-sound file)))
- (set! (selected-sound) index)
- (set! (sync index) 1) ; select-all follows sync field
- (let* ((reg (select-all))
- (fd (make-region-frame-reader reg 10000)))
- (if (not (frame-reader? fd)) (snd-display #__line__ ";~A: region frame-reader?: ~A" file fd))
- (if (> (frames index) 10000)
- (begin
- (if (frame-reader-at-end? fd) (snd-display #__line__ ";~A: region frame-reader-at-end?: ~A" file fd))
- (if (not (= (frame-reader-position fd) 10000))
- (snd-display #__line__ ";~A: region frame-reader: position: ~A ~A" fd (frame-reader-position fd) file)))
- (begin
- (if (not (frame-reader-at-end? fd)) (snd-display #__line__ ";~A: not region frame-reader-at-end?: ~A" file fd))
- (if (= (frame-reader-position fd) 10000)
- (snd-display #__line__ ";~A: region frame-reader: position but frames: ~A ~A ~A" file fd (frame-reader-position fd) (frames index)))))
- (if (not (equal? (frame-reader-home fd) reg))
- (snd-display #__line__ ";~A: region frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) reg))
- (if (not (= (frame-reader-chans fd) (region-chans reg)))
- (snd-display #__line__ ";region frame-reader-chans: ~A ~A" (frame-reader-chans fd) (region-chans reg)))
- (let ((fr0 (frame-copy (read-frame fd)))
- (fr1 (frame-copy (next-frame fd)))
- (fr2 (frame-copy (previous-frame fd))))
- (if (not (equal? fr0 (sound->frame 10000 index)))
- (snd-display #__line__ ";~A: region frame reader 10000: ~A ~A" file fr0 (sound->frame 10000 index)))
- (if (not (equal? fr1 (sound->frame 10001 index)))
- (snd-display #__line__ ";~A: region frame reader 10001: ~A ~A" file fr1 (sound->frame 10001 index)))
- (if (not (equal? fr2 (sound->frame 10001 index)))
- (snd-display #__line__ ";~A: region frame reader 10001 prev: ~A ~A" file fr2 (sound->frame 10001 index))))
- (free-frame-reader fd))
- (close-sound index)))
- (list "oboe.snd" "4.aiff" "2.snd" "2a.snd")) ; 2a=eof
- (set! (selection-creates-region) old-create))
-
- (let ((ind1 (open-sound "1a.snd"))
- (data1 (file->vct "1a.snd"))
- (ind2 (open-sound "2a.snd"))
- (data2 (file->vct "2a.snd")))
- (if (not (equal? data1 (channel->vct 0 #f ind1 0)))
- (snd-display #__line__ ";file->vct 1a.snd"))
- (if (not (equal? data2 (channel->vct 0 #f ind2 0)))
- (snd-display #__line__ ";file->vct 2a.snd"))
- (vct->file data1 "tmp.snd")
- (let ((ind3 (open-sound "tmp.snd")))
- (if (not (equal? data1 (channel->vct 0 #f ind3 0)))
- (snd-display #__line__ ";vct->file 1a"))
- (close-sound ind3))
- (mus-sound-forget "tmp.snd")
- (vct->file data2 "tmp.snd" 44100 "this is a comment")
- (let ((ind3 (open-sound "tmp.snd")))
- (if (not (string=? (comment ind3) "this is a comment"))
- (snd-display #__line__ ";vct->file comment: ~A" (comment ind3)))
- (if (not (= (srate ind3) 44100))
- (snd-display #__line__ ";vct->file srate: ~A" (srate ind3)))
- (close-sound ind3))
- (mus-sound-forget "tmp.snd")
- (let ((tag (catch #t (lambda () (vct->file 32 "tmp.snd")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";vct->file bad arg: ~A" tag)))
-
- (let ((sdata1 (file->sound-data "1a.snd"))
- (sdata2 (file->sound-data "2a.snd")))
- (if (not (equal? sdata1 (sound->sound-data 0 #f ind1)))
- (snd-display #__line__ ";sfile->sound-data 1a.snd"))
- (if (not (equal? sdata2 (sound->sound-data 0 #f ind2)))
- (snd-display #__line__ ";file->sound-data 2a.snd"))
- (sound-data->file sdata1 "tmp.snd")
- (let ((ind3 (open-sound "tmp.snd")))
- (if (not (equal? sdata1 (sound->sound-data 0 #f ind3)))
- (snd-display #__line__ ";sound-data->file 1a"))
- (close-sound ind3))
- (mus-sound-forget "tmp.snd")
- (sound-data->file sdata2 "tmp.snd" 44100 "another comment")
- (let ((ind3 (open-sound "tmp.snd")))
- (if (not (string=? (comment ind3) "another comment"))
- (snd-display #__line__ ";sound-data->file comment: ~A" (comment ind3)))
- (if (not (= (srate ind3) 44100))
- (snd-display #__line__ ";sound-data->file srate: ~A" (srate ind3)))
- (close-sound ind3))
- (mus-sound-forget "tmp.snd")
- (let ((tag (catch #t (lambda () (sound-data->file 32 "tmp.snd")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";sound-data->file bad arg: ~A" tag))))
- (close-sound ind1)
- (close-sound ind2))
-
- (let ((old-create (selection-creates-region)))
- (set! (selection-creates-region) #t)
- (for-each
- (lambda (file)
- (let ((index (open-sound file)))
- (set! (selected-sound) index)
- (set! (sync index) 1) ; select-all follows sync field
- (let* ((reg (select-all))
- (reg-sd (region->sound-data reg))
- (len (region-frames reg))
- (reg-v (region->vct reg 0 len 0)))
- (if (not (vequal reg-v (sound-data->vct reg-sd 0)))
- (snd-display #__line__ ";region->sound-data ~A 0 differs" file))
- (if (not (vequal reg-v (channel->vct 0 len index 0)))
- (snd-display #__line__ ";region->sound-data ~A original 0 differs" file))
- (if (> (chans index) 1)
- (begin
- (set! reg-v (region->vct reg 0 len 1 reg-v))
- (if (not (vequal reg-v (sound-data->vct reg-sd 1)))
- (snd-display #__line__ ";region->sound-data ~A 1 differs" file))
- (if (not (vequal reg-v (channel->vct 0 len index 1)))
- (snd-display #__line__ ";region->sound-data ~A original 1 differs" file)))))
- (close-sound index)))
- (list "oboe.snd" "1a.snd" "2a.snd"))
- (set! (selection-creates-region) old-create))
-
- (set! (sync-style) sync-none)
- (let ((total-chans 0)
- (previous-syncs '()))
- (for-each
- (lambda (file)
- (let ((index (open-sound file)))
- (set! (selected-sound) index)
- (if (not (= (sync index) 0)) (snd-display #__line__ ";~A sync before sync-everything: ~A" file (sync index)))
- (sync-everything)
- (for-each
- (lambda (snd)
- (if (not (sync snd))
- (snd-display #__line__ ";sync-everything did not set ~A's sync" file)
- (if (member (sync index) previous-syncs)
- (snd-display #__line__ ";sync-everything not new? ~A ~A" (sync index) previous-syncs))))
- (sounds))
- (let ((current-syncs (map sync (sounds))))
- (if (and (> (length current-syncs) 1)
- (not (apply = current-syncs)))
- (snd-display #__line__ ";sync-everything not the same? ~A" current-syncs))
- (set! previous-syncs (cons (sync index) previous-syncs)))
- (set! total-chans (+ total-chans (chans index)))
- (let* ((fd (make-sync-frame-reader 10000)))
- (if (not (frame-reader? fd)) (snd-display #__line__ ";~A: sync frame-reader?: ~A" file fd))
- (if (frame-reader-at-end? fd) (snd-display #__line__ ";~A: sync frame-reader-at-end?: ~A" file fd))
- (if (not (= (frame-reader-position fd) 10000))
- (snd-display #__line__ ";~A: sync frame-reader: position: ~A ~A" fd (frame-reader-position fd) file))
- (if (not (equal? (frame-reader-home fd) index))
- (snd-display #__line__ ";~A: sync frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
- (if (not (= (frame-reader-chans fd) total-chans))
- (snd-display #__line__ ";sync frame-reader-chans: ~A ~A" (frame-reader-chans fd) total-chans))
- (let ((fr0 (frame-copy (read-frame fd)))
- (fr1 (frame-copy (next-frame fd)))
- (fr2 (frame-copy (previous-frame fd))))
- (for-each
- (lambda (snd)
- (do ((i 0 (+ 1 i)))
- ((= i (chans snd)))
- (let ((val0 (sample 10000 snd i))
- (val1 (sample 10001 snd i))
- (got0 #f)
- (got1 #f)
- (got2 #f))
- (do ((j 0 (+ 1 j)))
- ((or got0
- (= j (mus-length fr0))))
- (if (< (abs (- (frame-ref fr0 j) val0)) .001)
- (begin
- (frame-set! fr0 j -100.0)
- (set! got0 #t))))
- (if (not got0) (snd-display #__line__ ";sync fr0 missed for ~A (~A) ~A" snd (short-file-name snd) i))
- (do ((j 0 (+ 1 j)))
- ((or got1
- (= j (mus-length fr1))))
- (if (< (abs (- (frame-ref fr1 j) val1)) .001)
- (begin
- (frame-set! fr1 j -100.0)
- (set! got1 #t))))
- (if (not got1) (snd-display #__line__ ";sync fr1 missed for ~A (~A) ~A" snd (short-file-name snd) i))
- (do ((j 0 (+ 1 j)))
- ((or got2
- (= j (mus-length fr2))))
- (if (< (abs (- (frame-ref fr2 j) val1)) .001)
- (begin
- (frame-set! fr2 j -100.0)
- (set! got2 #t))))
- (if (not got2) (snd-display #__line__ ";sync fr2 missed for ~A (~A) ~A" snd (short-file-name snd) i)))))
- (sounds)))
- (free-frame-reader fd))
- (select-all)
-
- (let* ((fd (make-selection-frame-reader 10000)))
- (if (not (frame-reader? fd)) (snd-display #__line__ ";~A: selection frame-reader?: ~A" file fd))
- (if (frame-reader-at-end? fd) (snd-display #__line__ ";~A: selection frame-reader-at-end?: ~A" file fd))
- (if (not (= (frame-reader-position fd) 10000))
- (snd-display #__line__ ";~A: selection frame-reader: position: ~A ~A" fd (frame-reader-position fd) file))
- (if (not (= (frame-reader-home fd) -1))
- (snd-display #__line__ ";~A: selection frame-reader: home: ~A ~A ~A" file fd (frame-reader-home fd) index))
- (if (not (= (frame-reader-chans fd) total-chans))
- (snd-display #__line__ ";selection frame-reader-chans: ~A ~A" (frame-reader-chans fd) total-chans))
- (let ((fr0 (frame-copy (read-frame fd)))
- (fr1 (frame-copy (next-frame fd)))
- (fr2 (frame-copy (previous-frame fd))))
- (for-each
- (lambda (snd)
- (do ((i 0 (+ 1 i)))
- ((= i (chans snd)))
- (let ((val0 (sample 10000 snd i))
- (val1 (sample 10001 snd i))
- (got0 #f)
- (got1 #f)
- (got2 #f))
- (do ((j 0 (+ 1 j)))
- ((or got0
- (= j (mus-length fr0))))
- (if (< (abs (- (frame-ref fr0 j) val0)) .001)
- (begin
- (frame-set! fr0 j -100.0)
- (set! got0 #t))))
- (if (not got0) (snd-display #__line__ ";selection fr0 missed for ~A (~A) ~A" snd (short-file-name snd) i))
- (do ((j 0 (+ 1 j)))
- ((or got1
- (= j (mus-length fr1))))
- (if (< (abs (- (frame-ref fr1 j) val1)) .001)
- (begin
- (frame-set! fr1 j -100.0)
- (set! got1 #t))))
- (if (not got1) (snd-display #__line__ ";selection fr1 missed for ~A (~A) ~A" snd (short-file-name snd) i))
- (do ((j 0 (+ 1 j)))
- ((or got2
- (= j (mus-length fr2))))
- (if (< (abs (- (frame-ref fr2 j) val1)) .001)
- (begin
- (frame-set! fr2 j -100.0)
- (set! got2 #t))))
- (if (not got2) (snd-display #__line__ ";selection fr2 missed for ~A (~A) ~A" snd (short-file-name snd) i)))))
- (sounds)))
- (free-frame-reader fd))))
- (list "oboe.snd" "4.aiff" "2.snd"))
- (map close-sound (sounds)))
-
- (let ((index0 (open-sound "oboe.snd"))
- (index1 (open-sound "2.snd")))
- (sync-everything)
- (make-selection 10000 (+ 10000 9))
- (if (not (selection?))
- (snd-display #__line__ ";make-selection failed?")
- (begin
- (if (not (= (selection-frames) 10))
- (snd-display #__line__ ";sync-everything + make-selection length: ~A" (selection-frames)))
- (if (not (= (selection-chans) 3))
- (snd-display #__line__ ";sync-everything + make-selection chans: ~A" (selection-chans)))
- (let ((val0 (selection->sound-data)))
- (if (not (sound-data? val0))
- (snd-display #__line__ ";selection->sound-data 0 result: ~A" val0)
- (begin
- (if (not (= (sound-data-chans val0) 3))
- (snd-display #__line__ ";selection->sound-data 0 chans: ~A" (sound-data-chans val0)))
- (if (not (= (sound-data-length val0) 10))
- (snd-display #__line__ ";selection->sound-data 0 length: ~A" (sound-data-length val0)))
- (let ((o0 (channel->vct 10000 10 index0))
- (t0 (channel->vct 10000 10 index1 0))
- (t1 (channel->vct 10000 10 index1 1))
- (s0 (sound-data->vct val0 0))
- (s1 (sound-data->vct val0 1))
- (s2 (sound-data->vct val0 2)))
- (if (and (not (vequal o0 s0)) (not (vequal o0 s1)) (not (vequal o0 s2)))
- (snd-display #__line__ ";selection->sound-data lost oboe: ~A ~A" o0 val0))
- (if (and (not (vequal t0 s0)) (not (vequal t0 s1)) (not (vequal t0 s2)))
- (snd-display #__line__ ";selection->sound-data lost 2 0: ~A ~A" t0 val0))
- (if (and (not (vequal t1 s0)) (not (vequal t1 s1)) (not (vequal t1 s2)))
- (snd-display #__line__ ";selection->sound-data lost 2 1: ~A ~A" t1 val0))))))
- (let ((val1 (selection->sound-data 5)))
- (if (not (sound-data? val1))
- (snd-display #__line__ ";selection->sound-data 1 result: ~A" val1)
- (begin
- (if (not (= (sound-data-chans val1) 3))
- (snd-display #__line__ ";selection->sound-data 1 chans: ~A" (sound-data-chans val1)))
- (if (not (= (sound-data-length val1) 5))
- (snd-display #__line__ ";selection->sound-data 1 length: ~A" (sound-data-length val1)))
- (let ((o0 (channel->vct 10005 5 index0))
- (t0 (channel->vct 10005 5 index1 0))
- (t1 (channel->vct 10005 5 index1 1))
- (s0 (sound-data->vct val1 0))
- (s1 (sound-data->vct val1 1))
- (s2 (sound-data->vct val1 2)))
- (if (and (not (vequal o0 s0)) (not (vequal o0 s1)) (not (vequal o0 s2)))
- (snd-display #__line__ ";selection->sound-data 1 lost oboe: ~A ~A" o0 val1))
- (if (and (not (vequal t0 s0)) (not (vequal t0 s1)) (not (vequal t0 s2)))
- (snd-display #__line__ ";selection->sound-data 1 lost 2 0: ~A ~A" t0 val1))
- (if (and (not (vequal t1 s0)) (not (vequal t1 s1)) (not (vequal t1 s2)))
- (snd-display #__line__ ";selection->sound-data 1 lost 2 1: ~A ~A" t1 val1))))))))
- (let ((val (scan-sound
- (lambda (fr)
- (if (not (= (mus-length fr) 3)) (snd-display #__line__ ";with-sync scan-sound chans: ~A" (mus-length fr)))
- (and (> (frame-ref fr 0) .01) (> (frame-ref fr 1) .01) (> (frame-ref fr 2) .01)))
- 0 #f #f #t)))
- (if (not (equal? val (list #t 960)))
- (snd-display #__line__ ";scan-sound with-sync; ~A" val)))
- (close-sound index0)
- (close-sound index1))
-
- (let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "insert-* tests" 10)))
- (map-channel (lambda (y) 1.0) 0 10 ind 0)
- (insert-vct (make-vct 5 .1) 2)
- (if (not (= (frames ind) 15)) (snd-display #__line__ ";insert-vct len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";insert-vct vals: ~A" vals)))
-
- (let ((tag (catch #t (lambda () (insert-vct 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";insert-vct bad arg: ~A" tag)))
-
- (insert-vct (make-vct 1 1.5) 0 1 ind 0)
- (if (not (= (frames ind) 16)) (snd-display #__line__ ";insert-vct 1 len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct 1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";insert-vct 1 vals: ~A" vals)))
-
- (let ((tag (catch #t (lambda () (insert-frame 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";insert-frame bad arg: ~A" tag)))
-
- (insert-frame (make-frame 1 .3))
- (if (not (= (frames ind) 17)) (snd-display #__line__ ";insert-frame len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct .3 1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";insert-frame vals: ~A" vals)))
-
- (insert-frame (make-frame 1 .4) 20 ind)
- (if (not (= (frames ind) 21)) (snd-display #__line__ ";insert-frame 1 len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct .3 1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1 0 0 0 .4)))
- (snd-display #__line__ ";insert-frame 1 vals: ~A" vals)))
-
- (insert-frame (make-frame 1 .2) 10)
- (if (not (= (frames ind) 22)) (snd-display #__line__ ";insert-frame 2 len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct .3 1.5 1 1 .1 .1 .1 .1 .1 1 .2 1 1 1 1 1 1 1 0 0 0 .4)))
- (snd-display #__line__ ";insert-frame 2 vals: ~A" vals)))
-
- (let ((tag (catch #t (lambda () (insert-sound-data 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";insert-sound-data bad arg: ~A" tag)))
-
- (let ((sd (make-sound-data 1 3)))
- (sound-data-set! sd 0 0 .23)
- (sound-data-set! sd 0 1 .24)
- (sound-data-set! sd 0 2 .25)
- (insert-sound-data sd 10)
- (if (not (= (frames ind) 25)) (snd-display #__line__ ";insert-sound-data len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct .3 1.5 1 1 .1 .1 .1 .1 .1 1 .23 .24 .25 .2 1 1 1 1 1 1 1 0 0 0 .4)))
- (snd-display #__line__ ";insert-sound-data vals: ~A" vals)))
-
- (insert-sound-data sd)
- (if (not (= (frames ind) 28)) (snd-display #__line__ ";insert-sound-data 1 len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct .23 .24 .25 .3 1.5 1 1 .1 .1 .1 .1 .1 1 .23 .24 .25 .2 1 1 1 1 1 1 1 0 0 0 .4)))
- (snd-display #__line__ ";insert-sound-data 1 vals: ~A" vals)))
-
- (insert-sound-data sd 30 2 ind)
- (if (not (= (frames ind) 32)) (snd-display #__line__ ";insert-sound-data 2 len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct .23 .24 .25 .3 1.5 1 1 .1 .1 .1 .1 .1 1 .23 .24 .25 .2 1 1 1 1 1 1 1 0 0 0 .4 0 0 .23 .24)))
- (snd-display #__line__ ";insert-sound-data 2 vals: ~A" vals))))
- (close-sound ind))
-
- (let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 4 "insert-* tests" 5)))
- (map-channel (lambda (y) 0.4) 0 5 ind 0)
- (map-channel (lambda (y) 0.5) 0 5 ind 1)
- (map-channel (lambda (y) 0.6) 0 5 ind 2)
- (map-channel (lambda (y) 0.7) 0 5 ind 3)
-
- (insert-vct (make-vct 20 .1) 2 2 ind 2)
- (if (not (= (frames ind 0) 5)) (snd-display #__line__ ";4chn insert-vct (0) len: ~A" (frames ind 0)))
- (if (not (= (frames ind 2) 7)) (snd-display #__line__ ";4chn insert-vct (2) len: ~A" (frames ind 2)))
- (if (not (vequal (channel->vct 0 7 ind 0) (vct .4 .4 .4 .4 .4 0 0)))
- (snd-display #__line__ ";4chn insert-vct 0: ~A" (channel->vct 0 7 ind 0)))
- (if (not (vequal (channel->vct 0 7 ind 1) (vct .5 .5 .5 .5 .5 0 0)))
- (snd-display #__line__ ";4chn insert-vct 1: ~A" (channel->vct 0 7 ind 1)))
- (if (not (vequal (channel->vct 0 7 ind 2) (vct .6 .6 .1 .1 .6 .6 .6)))
- (snd-display #__line__ ";4chn insert-vct 2: ~A" (channel->vct 0 7 ind 2)))
- (if (not (vequal (channel->vct 0 7 ind 3) (vct .7 .7 .7 .7 .7 0 0)))
- (snd-display #__line__ ";4chn insert-vct 3: ~A" (channel->vct 0 7 ind 3)))
-
- (insert-vct (make-vct 20 .2) 0 2 ind 0)
- (if (not (= (frames ind 0) 7)) (snd-display #__line__ ";4chn insert-vct (0 0) len: ~A" (frames ind 0)))
- (if (not (= (frames ind 1) 5)) (snd-display #__line__ ";4chn insert-vct (0 1) len: ~A" (frames ind 1)))
- (if (not (= (frames ind 2) 7)) (snd-display #__line__ ";4chn insert-vct (2 2) len: ~A" (frames ind 2)))
- (if (not (vequal (channel->vct 0 7 ind 0) (vct .2 .2 .4 .4 .4 .4 .4)))
- (snd-display #__line__ ";4chn insert-vct 1 0: ~A" (channel->vct 0 7 ind 0)))
- (if (not (vequal (channel->vct 0 7 ind 1) (vct .5 .5 .5 .5 .5 0 0)))
- (snd-display #__line__ ";4chn insert-vct 1 1: ~A" (channel->vct 0 7 ind 1)))
- (if (not (vequal (channel->vct 0 7 ind 2) (vct .6 .6 .1 .1 .6 .6 .6)))
- (snd-display #__line__ ";4chn insert-vct 1 2: ~A" (channel->vct 0 7 ind 2)))
- (if (not (vequal (channel->vct 0 7 ind 3) (vct .7 .7 .7 .7 .7 0 0)))
- (snd-display #__line__ ";4chn insert-vct 1 3: ~A" (channel->vct 0 7 ind 3)))
-
- (insert-frame (make-frame 4 1.5 1.6 1.7 1.8))
- (if (not (= (frames ind 0) 8)) (snd-display #__line__ ";4chn insert-frame (0) len: ~A" (frames ind 0)))
- (if (not (= (frames ind 1) 6)) (snd-display #__line__ ";4chn insert-frame (1) len: ~A" (frames ind 1)))
- (if (not (= (frames ind 2) 8)) (snd-display #__line__ ";4chn insert-frame (2) len: ~A" (frames ind 2)))
- (if (not (vequal (channel->vct 0 8 ind 0) (vct 1.5 .2 .2 .4 .4 .4 .4 .4)))
- (snd-display #__line__ ";4chn insert-frame 0: ~A" (channel->vct 0 8 ind 0)))
- (if (not (vequal (channel->vct 0 8 ind 1) (vct 1.6 .5 .5 .5 .5 .5 0 0)))
- (snd-display #__line__ ";4chn insert-frame 1: ~A" (channel->vct 0 8 ind 1)))
- (if (not (vequal (channel->vct 0 8 ind 2) (vct 1.7 .6 .6 .1 .1 .6 .6 .6)))
- (snd-display #__line__ ";4chn insert-frame 2: ~A" (channel->vct 0 8 ind 2)))
- (if (not (vequal (channel->vct 0 8 ind 3) (vct 1.8 .7 .7 .7 .7 .7 0 0)))
- (snd-display #__line__ ";4chn insert-frame 3: ~A" (channel->vct 0 8 ind 3)))
-
- (insert-frame (make-frame 4 1.5 1.6 1.7 1.8) 10 ind)
- (if (not (= (frames ind 0) 11)) (snd-display #__line__ ";4chn insert-frame (0 0) len: ~A" (frames ind 0)))
- (if (not (= (frames ind 1) 11)) (snd-display #__line__ ";4chn insert-frame (0 1) len: ~A" (frames ind 1)))
- (if (not (= (frames ind 2) 11)) (snd-display #__line__ ";4chn insert-frame (0 2) len: ~A" (frames ind 2)))
- (if (not (vequal (channel->vct 0 11 ind 0) (vct 1.5 .2 .2 .4 .4 .4 .4 .4 0 0 1.5)))
- (snd-display #__line__ ";4chn insert-frame 0 0: ~A" (channel->vct 0 11 ind 0)))
- (if (not (vequal (channel->vct 0 11 ind 1) (vct 1.6 .5 .5 .5 .5 .5 0 0 0 0 1.6)))
- (snd-display #__line__ ";4chn insert-frame 0 1: ~A" (channel->vct 0 11 ind 1)))
- (if (not (vequal (channel->vct 0 11 ind 2) (vct 1.7 .6 .6 .1 .1 .6 .6 .6 0 0 1.7)))
- (snd-display #__line__ ";4chn insert-frame 0 2: ~A" (channel->vct 0 11 ind 2)))
- (if (not (vequal (channel->vct 0 11 ind 3) (vct 1.8 .7 .7 .7 .7 .7 0 0 0 0 1.8)))
- (snd-display #__line__ ";4chn insert-frame 0 3: ~A" (channel->vct 0 11 ind 3)))
-
- (revert-sound ind)
- (map-channel (lambda (y) 0.4) 0 5 ind 0)
- (map-channel (lambda (y) 0.5) 0 5 ind 1)
- (map-channel (lambda (y) 0.6) 0 5 ind 2)
- (map-channel (lambda (y) 0.7) 0 5 ind 3)
-
- (let ((sd (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))))
- (insert-sound-data sd 1 2)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (if (not (= (frames ind chn) 7)) (snd-display #__line__ ";4chn ~A insert-sound-data len: ~A" chn (frames ind chn)))
- (let ((vals (channel->vct 0 #f ind chn))
- (base-val (list-ref (list .4 .5 .6 .7) chn)))
- (if (not (vequal vals (vct base-val
- (+ 0 (* chn 10)) (+ 1 (* chn 10)) ; insert starts at 0 in sd
- base-val base-val base-val base-val)))
- (snd-display #__line__ ";4chn ~A insert-sound-data vals: ~A" chn vals)))))
- (close-sound ind))
-
- (let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 1 "mix-frame tests" 5)))
- (map-channel (lambda (y) 1.0) 0 5 ind 0)
-
- (let ((tag (catch #t (lambda () (mix-frame 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";mix-frame bad arg: ~A" tag)))
-
- (mix-frame (make-frame 1 .3))
- (if (not (= (frames ind) 5)) (snd-display #__line__ ";mix-frame len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct 1.3 1 1 1 1)))
- (snd-display #__line__ ";mix-frame vals: ~A" vals)))
-
- (mix-frame (make-frame 1 .4) 8 ind)
- (if (not (= (frames ind) 9)) (snd-display #__line__ ";mix-frame 1 len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct 1.3 1 1 1 1 0 0 0 .4)))
- (snd-display #__line__ ";mix-frame 1 vals: ~A" vals)))
-
- (let ((tag (catch #t (lambda () (mix-sound-data 32)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";mix-sound-data bad arg: ~A" tag)))
-
- (let ((sd (make-sound-data 1 3)))
- (sound-data-set! sd 0 0 .23)
- (sound-data-set! sd 0 1 .24)
- (sound-data-set! sd 0 2 .25)
- (mix-sound-data sd)
- (if (not (= (frames ind) 9)) (snd-display #__line__ ";mix-sound-data len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct 1.53 1.24 1.25 1 1 0 0 0 .4)))
- (snd-display #__line__ ";mix-sound-data vals: ~A" vals)))
-
- (mix-sound-data sd 7 3)
- (if (not (= (frames ind) 10)) (snd-display #__line__ ";mix-sound-data 1 len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct 1.53 1.24 1.25 1 1 0 0 .23 .64 .25)))
- (snd-display #__line__ ";mix-sound-data 1 vals: ~A" vals)))
-
- (let ((mix-id (mix-sound-data sd 0 #f ind #t)))
- (if (not (= (frames ind) 10)) (snd-display #__line__ ";mix-sound-data 2 len: ~A" (frames ind)))
- (let ((vals (channel->vct 0 #f ind 0)))
- (if (not (vequal vals (vct (+ .23 1.53) (+ .24 1.24) (+ .25 1.25) 1 1 0 0 .23 .64 .25)))
- (snd-display #__line__ ";mix-sound-data 2 vals: ~A" vals)))
- (if (not (mix? mix-id)) (snd-display #__line__ ";mix-sound-data tagged: ~A" mix-id)))
-
- )
- (close-sound ind))
+ (list time-graph-type 'time-graph-type ind-1 ind-2 graph-as-wavogram = equal? #t #t)
+ (list wavo-hop 'wavo-hop ind-1 ind-2 10 = equal? #t #t)
+ (list wavo-trace 'wavo-trace ind-1 ind-2 10 = equal? #t #t)
+ (list spectro-hop 'spectro-hop ind-1 ind-2 10 = equal? #t #t)
+ (list cursor 'cursor ind-1 ind-2 50 = equal? #t #f)
+ (list cursor-style 'cursor-style ind-1 ind-2 1 = equal? #t #t)
+ (list cursor-size 'cursor-size ind-1 ind-2 10 = equal? #t #t)
+
+ (list framples 'framples ind-1 ind-2 50 = equal? #t #f)
+ (list zero-pad 'zero-pad ind-1 ind-2 1 = equal? #t #t)
+ (list fft-window 'fft-window ind-1 ind-2 1 = equal? #t #t)
+ ; (list transform-type 'transform-type ind-1 ind-2 1 equal? equal? #t #t)
+ )))
+ (update-time-graph #t #t)
+ (update-transform-graph #t #t)
+ (update-lisp-graph #t #t)
+
+ (close-sound #f)
+ (close-sound #f)
+ (if (not (null? (sounds))) (snd-display #__line__ ";sounds after close-sound #t: ~A" (sounds)))))
+
+ (letrec ((test-sound-func-2
+ (lambda (func name ind-1 ind-2 new-val eq-func leq-func)
+ (let* ((old-global-val (func))
+ (old-vals (func #t))
+ (old-1 (func ind-1))
+ (old-2 (func ind-2))
+ (sel-snd (selected-sound))
+ (unsel-snd (if (equal? sel-snd ind-1) ind-2 ind-1)))
+ (if (not (or (leq-func old-vals (list old-1 old-2))
+ (leq-func old-vals (list old-2 old-1))))
+ (snd-display #__line__ ";~A sound-func #t: ~A, sep: ~A" name old-vals (list old-1 old-2)))
+ (set! (func) new-val)
+ (if (not (eq-func (func) new-val))
+ (snd-display #__line__ ";~A global set no arg: ~A ~A" name (func) new-val))
+ (if (not (eq-func (func) (func sel-snd)))
+ (snd-display #__line__ ";~A global set no arg sel: ~A ~A" name (func) (func sel-snd)))
+ (if (not (eq-func (func) (func unsel-snd)))
+ (snd-display #__line__ ";~A set global no arg unsel: ~A ~A (sel: ~A)" name (func) (func unsel-snd) (func sel-snd)))
+ (if (not (or (leq-func (func #t) (list (func sel-snd) (func unsel-snd)))
+ (leq-func (func #t) (list (func unsel-snd) (func sel-snd)))))
+ (snd-display #__line__ ";~A func #t set: ~A, sep: ~A" name (func #t) (list (func sel-snd) (func unsel-snd))))
+ (set! (func) old-global-val)
+ (set! (func ind-1) new-val)
+ (if (not (eq-func (func ind-1) new-val))
+ (snd-display #__line__ ";~A set arg: ~A ~A" name (func ind-1) new-val))
+ (if (eq-func (func ind-2) new-val)
+ (snd-display #__line__ ";~A set arg (2): ~A ~A" name (func ind-2) new-val))
+ (if (not (or (leq-func (func #t) (list (func ind-1) (func ind-2)))
+ (leq-func (func #t) (list (func ind-2) (func ind-1)))))
+ (snd-display #__line__ ";~A func arg set: ~A, sep: ~A" name (func #t) (list (func ind-1) (func ind-2))))
+ (set! (func ind-1) old-1)
+ (set! (func #t) new-val)
+ (if (not (leq-func (func #t) (list new-val new-val)))
+ (snd-display #__line__ ";~A func arg set #t: ~A, sep: ~A" name (func #t) (list new-val new-val)))
+ (if (not (eq-func (func ind-1) new-val))
+ (snd-display #__line__ ";~A set arg #t: ~A ~A" name (func ind-1) new-val))
+ (if (not (eq-func (func ind-2) new-val))
+ (snd-display #__line__ ";~A set arg #t (2): ~A ~A" name (func ind-2) new-val))
+ (if (eq-func (func) new-val)
+ (snd-display #__line__ ";~A overwrote global: ~A ~A" name (func) new-val))
+ (set! (func ind-1) old-1)
+ (set! (func ind-2) old-2)
+ (if (not (eq-func (func ind-1) old-1))
+ (snd-display #__line__ ";~A set arg #t old: ~A ~A" name (func ind-1) old-1))
+ (if (not (eq-func (func ind-2) old-2))
+ (snd-display #__line__ ";~A set arg #t (2): ~A ~A" name (func ind-2) old-2))))))
+
+ (let ((ind-1 (new-sound "test-1.snd" 1 22050 mus-ldouble mus-next "mono testing" 100))
+ (ind-2 (new-sound "test-2.snd" 2 44100 mus-bshort mus-aifc "stereo testing" 300)))
+
+ (for-each
+ (lambda (data)
+ (apply test-sound-func-2 data))
+ (list
+ (list filter-control-in-dB 'filter-control-in-dB ind-1 ind-2 #t eq? equal?)
+ (list filter-control-in-hz 'filter-control-in-hz ind-1 ind-2 #t eq? equal?)
+ (list show-controls 'show-controls ind-1 ind-2 #t eq? equal?)
+
+ (list speed-control-tones 'speed-control-tones ind-1 ind-2 14 = equal?)
+ (list speed-control-style 'speed-control-style ind-1 ind-2 speed-control-as-semitone = equal?)
+ (list filter-control-order 'filter-control-order ind-1 ind-2 14 = equal?)
+
+ (list expand-control-length 'expand-control-length ind-1 ind-2 .25 within-.01? feql)
+ (list expand-control-ramp 'expand-control-ramp ind-1 ind-2 .25 within-.01? feql)
+ (list expand-control-hop 'expand-control-hop ind-1 ind-2 .25 within-.01? feql)
+ (list expand-control-jitter 'expand-control-jitter ind-1 ind-2 .25 within-.01? feql)
+ (list contrast-control-amp 'contrast-control-amp ind-1 ind-2 .25 within-.01? feql)
+ (list reverb-control-feedback 'reverb-control-feedback ind-1 ind-2 .25 within-.01? feql)
+ (list reverb-control-lowpass 'reverb-control-lowpass ind-1 ind-2 .25 within-.01? feql)
+ (list reverb-control-decay 'reverb-control-decay ind-1 ind-2 .25 within-.01? feql)
+
+ (list amp-control-bounds 'amp-control-bounds ind-1 ind-2 (list 0.0 2.0) feql
+ (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
+ (list contrast-control-bounds 'contrast-control-bounds ind-1 ind-2 (list 0.0 2.0) feql
+ (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
+ (list expand-control-bounds 'expand-control-bounds ind-1 ind-2 (list 0.1 2.0) feql
+ (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
+ (list speed-control-bounds 'speed-control-bounds ind-1 ind-2 (list 0.1 2.0) feql
+ (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
+ (list reverb-control-length-bounds 'reverb-control-length-bounds ind-1 ind-2 (list 0.0 2.0) feql
+ (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))
+ (list reverb-control-scale-bounds 'reverb-control-scale-bounds ind-1 ind-2 (list 0.0 2.0) feql
+ (lambda (a b) (and (feql (car a) (car b)) (feql (cadr a) (cadr b)))))))
+ (close-sound ind-1)
+ (close-sound ind-2)))))
+
+ (set! *remember-sound-state* #t)
+ (let ((ind (open-sound "oboe.snd")))
+ (set! (transform-graph? ind 0) #t)
+ (set! (show-transform-peaks ind 0) #t)
+ (set! (show-y-zero ind 0) #t)
+ (close-sound ind))
+ (let ((ind (open-sound "oboe.snd")))
+ (if (or (not (transform-graph? ind 0))
+ (not (show-transform-peaks ind 0))
+ (not (show-y-zero ind 0)))
+ (snd-display #__line__ ";remember-sound-state: ~A ~A ~A" (transform-graph? ind 0) (show-transform-peaks ind 0) (show-y-zero ind 0)))
+ (close-sound ind))
+ (reset-all-hooks)
+ (set! *remember-sound-state* #f)
+ (if (file-exists? "remembered-oboe.snd.scm")
+ (delete-file "remembered-oboe.snd.scm"))
+
+ (map-sound-files (lambda (n) (if (> (mus-sound-duration n) 1000.0) (snd-display #__line__ ";~A is pretty long! ~A" n (mus-sound-duration n)))))
+ (if (string? sf-dir)
+ (map-sound-files
+ (lambda (n)
+ (catch #t
+ (lambda ()
+ (if (> (mus-sound-duration (string-append sf-dir n)) 1000.0)
+ (snd-display #__line__ ";~A is pretty long! ~A"
+ n
+ (mus-sound-duration (string-append sf-dir n)))))
+ (lambda args #f))
+ (mus-sound-forget (string-append sf-dir n)))
+ sf-dir))
+
+ (let ((snd (new-sound "test.snd")))
+ (pad-channel 0 20)
+ (map-channel (lambda (y) 1.0))
+ (env-channel-with-base '(0 0 1 1) 1.0)
+ (let ((data (channel->float-vector 0 20)))
+ (if (not (vequal data (float-vector 0.0 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95)))
+ (snd-display #__line__ ";env-chan 1.0: ~A" data)))
+ (undo)
+ (env-channel-with-base '(0 0 1 1 2 1 3 0) 0.0)
+ (let ((data (channel->float-vector 0 20)))
+ (if (not (vequal data (float-vector 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (snd-display #__line__ ";env-chan 0.0: ~A" data)))
+ (undo)
+ (env-channel-with-base '(0 0 1 1) 100.0)
+ (let ((data (channel->float-vector 0 20)))
+ (if (not (vequal data (float-vector 0.0 0.003 0.006 0.010 0.015 0.022 0.030 0.041 0.054 0.070 0.091 0.117 0.150 0.191 0.244 0.309 0.392 0.496 0.627 0.792)))
+ (snd-display #__line__ ";env-chan 100.0: ~A" data)))
+ (undo)
+ (env-channel-with-base '(0 0 1 1) 0.01)
+ (let ((data (channel->float-vector 0 20)))
+ (if (not (vequal data (float-vector 0.0 0.208 0.373 0.504 0.608 0.691 0.756 0.809 0.850 0.883 0.909 0.930 0.946 0.959 0.970 0.978 0.985 0.990 0.994 0.997)))
+ (snd-display #__line__ ";env-chan 0.01: ~A" data)))
+ (undo)
- (let* ((ind (new-sound "test.snd" mus-next mus-bfloat 22050 4 "mix-* tests" 5)))
- (map-channel (lambda (y) 0.4) 0 5 ind 0)
- (map-channel (lambda (y) 0.5) 0 5 ind 1)
- (map-channel (lambda (y) 0.6) 0 5 ind 2)
- (map-channel (lambda (y) 0.7) 0 5 ind 3)
-
- (mix-frame (make-frame 4 1 2 3 4))
- (if (not (vequal (channel->vct 0 #f ind 0) (vct 1.4 .4 .4 .4 .4)))
- (snd-display #__line__ ";4chn mix-frame 0: ~A" (channel->vct 0 #f ind 0)))
- (if (not (vequal (channel->vct 0 #f ind 1) (vct 2.5 .5 .5 .5 .5)))
- (snd-display #__line__ ";4chn mix-frame 1: ~A" (channel->vct 0 #f ind 1)))
- (if (not (vequal (channel->vct 0 #f ind 2) (vct 3.6 .6 .6 .6 .6)))
- (snd-display #__line__ ";4chn mix-frame 2: ~A" (channel->vct 0 #f ind 2)))
- (if (not (vequal (channel->vct 0 #f ind 3) (vct 4.7 .7 .7 .7 .7)))
- (snd-display #__line__ ";4chn mix-frame 3: ~A" (channel->vct 0 #f ind 3)))
-
- (mix-frame (make-frame 4 1 2 3 4) 8)
-
- (if (not (vequal (channel->vct 0 #f ind 0) (vct 1.4 .4 .4 .4 .4 0 0 0 1)))
- (snd-display #__line__ ";4chn mix-frame 0 0: ~A" (channel->vct 0 #f ind 0)))
- (if (not (vequal (channel->vct 0 #f ind 1) (vct 2.5 .5 .5 .5 .5 0 0 0 2)))
- (snd-display #__line__ ";4chn mix-frame 0 1: ~A" (channel->vct 0 #f ind 1)))
- (if (not (vequal (channel->vct 0 #f ind 2) (vct 3.6 .6 .6 .6 .6 0 0 0 3)))
- (snd-display #__line__ ";4chn mix-frame 0 2: ~A" (channel->vct 0 #f ind 2)))
- (if (not (vequal (channel->vct 0 #f ind 3) (vct 4.7 .7 .7 .7 .7 0 0 0 4)))
- (snd-display #__line__ ";4chn mix-frame 0 3: ~A" (channel->vct 0 #f ind 3)))
-
- (revert-sound ind)
- (map-channel (lambda (y) 0.4) 0 5 ind 0)
- (map-channel (lambda (y) 0.5) 0 5 ind 1)
- (map-channel (lambda (y) 0.6) 0 5 ind 2)
- (map-channel (lambda (y) 0.7) 0 5 ind 3)
-
- (let ((sd (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))))
- (mix-sound-data sd 1 2)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (let ((vals (channel->vct 0 #f ind chn))
- (base-val (list-ref (list .4 .5 .6 .7) chn)))
- (if (not (vequal vals (vct base-val
- (+ base-val (* chn 10)) (+ 1 base-val (* chn 10))
- base-val base-val)))
- (snd-display #__line__ ";4chn ~A mix-sound-data vals: ~A" chn vals))))
-
- (let ((mix-id (mix-sound-data sd 8 2 ind #t)))
- (if (not (mix? mix-id)) (snd-display #__line__ ";4chn mix-sound-data 2nd mix: ~A" mix-id))
- (if (not (mix? (integer->mix (+ 1 (mix->integer mix-id))))) (snd-display #__line__ ";4chn mix-sound-data 2nd mix 1: ~A" mix-id))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (let ((vals (channel->vct 0 #f ind chn))
- (base-val (list-ref (list .4 .5 .6 .7) chn)))
- (if (not (vequal vals (vct base-val
- (+ base-val (* chn 10)) (+ 1 base-val (* chn 10))
- base-val base-val 0 0 0
- (+ 0 (* chn 10)) (+ 1 (* chn 10)))))
- (snd-display #__line__ ";4chn ~A mix-sound-data 8 vals: ~A" chn vals))))))
-
- (close-sound ind))
+ (env-channel-with-base '(0 0 1 1) 1.0 5 10)
+ (let ((data (channel->float-vector 0 20)))
+ (if (not (vequal data (float-vector 1.0 1.0 1.0 1.0 1.0 0.0 0.111 0.222 0.333 0.444 0.556 0.667 0.778 0.889 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (snd-display #__line__ ";env-chan 1.0 seg: ~A" data)))
+ (undo)
+ (env-channel-with-base '(0 0 1 1 2 1 3 0) 0.0 5 10)
+ (let ((data (channel->float-vector 0 20)))
+ (if (not (vequal data (float-vector 1.0 1.0 1.0 1.0 1.0 0.0 0.0 0.0 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (snd-display #__line__ ";env-chan 0.0 seg: ~A" data)))
+ (undo)
+ (env-channel-with-base '(0 0 1 1) 100.0 5 10)
+ (let ((data (channel->float-vector 0 20)))
+ (if (not (vequal data (float-vector 1.0 1.0 1.0 1.0 1.0 0.0 0.007 0.018 0.037 0.068 0.120 0.208 0.353 0.595 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (snd-display #__line__ ";env-chan 100.0 seg: ~A" data)))
+ (undo)
+ (env-channel-with-base '(0 0 1 1) 0.01 5 10)
+ (let ((data (channel->float-vector 0 20)))
+ (if (not (vequal data (float-vector 1.0 1.0 1.0 1.0 1.0 0.0 0.405 0.647 0.792 0.880 0.932 0.963 0.982 0.993 1.0 1.0 1.0 1.0 1.0 1.0)))
+ (snd-display #__line__ ";env-chan 0.01 seg: ~A" data)))
+ (undo)
+ (close-sound snd))
+
+ (let ((ind1 (open-sound "now.snd"))
+ (ind2 (open-sound "oboe.snd")))
+ (let ((val (channel-mean ind1 0)))
+ (if (fneq val 5.02560673308833e-5) (snd-display #__line__ ";channel-mean: ~A" val)))
+ (let ((val (channel-total-energy ind1 0)))
+ (if (fneq val 50.7153476262465) (snd-display #__line__ ";channel-total-energy: ~A" val)))
+ (let ((val (channel-average-power ind1 0)))
+ (if (fneq val 0.00155078578803922) (snd-display #__line__ ";channel-average-power: ~A" val)))
+ (let ((val (channel-rms ind1 0)))
+ (if (fneq val 0.039380017623653) (snd-display #__line__ ";channel-rms: ~A" val)))
+ (let ((val (channel-norm ind1 0)))
+ (if (fneq val 7.12147088923675) (snd-display #__line__ ";channel-norm: ~A" val)))
+ (let ((val (channel-variance ind1 0)))
+ (if (fneq val 50.7153476237207) (snd-display #__line__ ";channel-variance: ~A" val)))
+ (let ((val (channel-lp 2 ind1 0)))
+ (if (fneq val 7.12147088923675) (snd-display #__line__ ";channel-lp 2: ~A" val)))
+ (let ((val (channel-lp 1 ind1 0)))
+ (if (fneq val 775.966033935547) (snd-display #__line__ ";channel-lp 1: ~A" val)))
+ (let ((val (channel2-inner-product ind1 0 ind2 0)))
+ (if (fneq val 1.52892031334341) (snd-display #__line__ ";channel2-inner-product: ~A" val)))
+ (let ((val (channel2-angle ind1 0 ind2 0)))
+ (if (fneq val 1.55485084385627) (snd-display #__line__ ";channel2-angle: ~A" val)))
+ (let ((val (channel2-orthogonal? ind1 0 ind2 0)))
+ (if val (snd-display #__line__ ";channel2-orthogonal: ~A" val)))
+ (let ((val (channel2-coefficient-of-projection ind1 0 ind2 0)))
+ (if (fneq val 0.0301470932351876) (snd-display #__line__ ";channel2-coefficient-of-projection: ~A" val)))
+ (close-sound ind1)
+ (set! ind1 (open-sound "oboe.snd"))
+ (scale-by .99 ind1 0)
+ (let ((dist (channel-distance ind1 0 ind2 0)))
+ (if (fneq dist .1346) (snd-display #__line__ ";channel-distance: ~A" dist)))
- (mus-sound-forget "oboe.snd")
- (let ((ind (open-sound "oboe.snd"))
- (len 0))
- (let ((val (scan-sound
- (lambda (fr)
- (set! len (mus-length fr))
- (> (frame-ref fr 0) .1)))))
- (if (not (equal? val (list #t 4423)))
- (snd-display #__line__ ";scan-sound oboe: ~A" val))
- (if (not (= len 1)) (snd-display #__line__ ";scan-sound frame len: ~A" len)))
-
- (set! len 0)
- (let ((mx (maxamp)))
- (map-sound
- (lambda (fr)
- (set! len (mus-length fr))
- (frame* fr 2.0)))
- (if (fneq (maxamp) (* 2 mx)) (snd-display #__line__ ";map-sound max: ~A ~A" mx (maxamp)))
- (if (not (= (edit-position ind 0) 1)) (snd-display #__line__ ";map-sound edpos: ~A" (edit-position ind 0)))
- (if (not (= len 1)) (snd-display #__line__ ";map-sound frame len: ~A" len)))
- (close-sound ind))
+ (close-sound ind1)
+ (close-sound ind2))
+
+ (let ((loboe (string-append (getcwd) "/oboe.snd"))
+ (ltest (string-append (getcwd) "/test.snd")))
+ (copy-file loboe ltest)
+ (mus-sound-forget ltest)
+ (let* ((ind (open-sound ltest))
+ (mx (maxamp ind 0))
+ (chns (chans ind))
+ (sr (srate ind))
+ (fr (framples ind 0)))
+ (if (or (not (= (chans ind) (mus-sound-chans loboe)))
+ (not (= (srate ind) (mus-sound-srate loboe)))
+ (not (= (framples ind) (mus-sound-framples loboe))))
+ (snd-display #__line__ ";copy oboe -> test seems to have failed? ~A ~A ~A"
+ (chans ind) (srate ind) (framples ind))
+ (with-local-hook
+ update-hook
+ (list (lambda (orig-ind)
+ (lambda (new-ind)
+ (set! ind new-ind))))
+ (lambda ()
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (let ((v (channel->float-vector)))
+ (if (not (float-vector? v))
+ (snd-display #__line__ ";channel->float-vector of oboe copy is null??")
+ (array->file ltest v fr sr chns))
+ (update-sound ind)
+ (let ((mx1 (maxamp ind 0)))
+ (if (fneq mx mx1)
+ (snd-display #__line__ ";update-sound looped maxamp: ~A ~A ~A ~A ~A (~A)" i ind (framples ind) mx1 mx (/ mx1 mx))))
+ (if (not (= (chans ind) chns)) (snd-display #__line__ ";update-sound looped chans: ~A ~A" chns (chans ind)))
+ (if (not (= (srate ind) sr)) (snd-display #__line__ ";update-sound looped srate: ~A ~A" sr (srate ind)))
+ (if (not (= (framples ind) fr)) (snd-display #__line__ ";update-sound looped framples: ~A ~A" fr (framples ind 0)))))
+ (let ((old-ind (open-sound "oboe.snd")))
+ (let ((mxdiff (float-vector-peak (float-vector-subtract! (channel->float-vector 0 #f ind 0 0) (channel->float-vector 0 #f old-ind 0)))))
+ (if (fneq mxdiff 0.0)
+ (snd-display #__line__ ";update-sound looped overall max diff: ~A, sounds: ~A, ind: ~A, old-ind: ~A, rd: ~A"
+ mxdiff (sounds) ind old-ind home)))
+ (close-sound old-ind)))))
+ (close-sound ind)))
+
+ (if (file-exists? "test.snd") (delete-file "test.snd"))
+ (let* ((ind (open-sound "oboe.snd"))
+ (data (channel->float-vector))
+ (len (framples ind)))
+ (do ((i 0 (+ i 1)))
+ ((= i 5))
+ (array->file "test.snd" data len 22050 1)
+ (file->array "test.snd" 0 0 len data)
+ (let ((d2 (samples 0 len ind 0)))
+ (float-vector-subtract! d2 data)
+ (let ((diff (float-vector-peak d2)))
+ (if (fneq diff 0.0) (snd-display #__line__ ";arr->file->array overall max diff: ~A" diff)))))
+
+ ;; now clear sono bins if possible
+ (set! *colormap-size* 16)
+ (set! (transform-size ind 0) 8)
+ (set! (transform-graph-type ind 0) graph-as-sonogram)
+ (set! (transform-graph? ind 0) #t)
+ (update-transform-graph)
+ (set! (x-bounds) (list 0.0 .04))
+ (update-time-graph)
+ (update-transform-graph)
+ (set! *zoom-focus-style* (lambda (s c z x0 x1 range)
+ 0))
+ (if (not (procedure? *zoom-focus-style*))
+ (snd-display #__line__ ";zoom-focus-style as func: ~A" *zoom-focus-style*))
+ (set! *zoom-focus-style* zoom-focus-right)
+ (if (not (= *zoom-focus-style* zoom-focus-right))
+ (snd-display #__line__ ";unset zoom-focus-style as func: ~A" *zoom-focus-style*))
+ (close-sound ind))
+
+ (if (file-exists? "test.snd") (delete-file "test.snd"))
+ (if (file-exists? "fmv.snd") (delete-file "fmv.snd"))
+ (mus-sound-forget "fmv.snd")
+ (mus-sound-forget "test.snd")
+ (let ((rdin #f)
+ (rdout #f)
+ (len (mus-sound-framples "oboe.snd"))
+ (types (list mus-riff mus-aifc mus-next mus-nist mus-ircam))
+ (forms (list mus-lshort mus-bshort mus-b24int mus-l24int mus-bint)))
+ (system "cp oboe.snd fmv.snd")
+ (do ((i 0 (+ i 1)))
+ ((= i 5))
+ (set! rdin (make-readin :file "fmv.snd"))
+ (set! rdout (make-sample->file "test.snd" 1 (forms i) (types i)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (sample->file rdout k 0 (readin rdin)))
+ (mus-close rdout)
+ (mus-close rdin)
+ (system "mv test.snd fmv.snd")
+ (mus-sound-forget "test.snd")
+ (mus-sound-forget "fmv.snd"))
+ (let ((diff 0.0) (ctr 0)
+ (ind1 (open-sound "oboe.snd"))
+ (ind2 (make-file->sample "fmv.snd")))
+ (scan-channel (lambda (y)
+ (set! diff (max diff (abs (- y (file->sample ind2 ctr 0)))))
+ (set! ctr (+ ctr 1))
+ ;; if this happens it is almost certainly a problem with mus-sound-forget above
+ #f))
+ (if (fneq diff 0.0) (snd-display #__line__ ";file->sample->file overall max diff: ~A" diff))
+ (close-sound ind1)))
+
+ (let ((ind (open-sound "1a.snd"))
+ (mx (maxamp)))
+ ;; jokes from extsnd.html (make sure they run)
+ (for-each
+ (lambda (name-and-func)
+ (let ((name (car name-and-func)))
+ ((cadr name-and-func))
+ (if (and (fneq (/ (maxamp) mx) 2.0)
+ (not (eq? name 'set-samples))
+ (not (eq? name 'coroutines)))
+ (snd-display #__line__ ";silly scalers: ~A ~A" name (/ (maxamp) mx)))
+ (revert-sound)))
+ (list
+ (list 'scale-by (lambda () (scale-by 2.0)))
+ (list 'scale-channel (lambda () (scale-channel 2.0)))
+ (list 'map-channel (lambda () (map-channel (lambda (val) (* val 2.0)))))
+ (list 'set-max (lambda () (set! (maxamp) (* 2 (maxamp)))))
+ (list 'env-sound (lambda () (env-sound '(0 2 1 2))))
+ (list 'env-channel (lambda () (env-channel (make-env '(0 1 1 1) :scaler 2.0 :length (framples)))))
+ (list 'clm-channel (lambda () (clm-channel (make-one-zero :a0 2.0 :a1 0.0))))
+ (list 'filter-channel (lambda () (filter-channel (float-vector 2.0) 1)))
+ (list 'float-vector->channel (lambda () (float-vector->channel (float-vector-scale! (channel->float-vector) 2.0) 0)))
+ (list 'mix-selection (lambda () (select-all) (mix-selection 0)))
+ (list 'scale-selection (lambda () (select-all) (scale-selection-by 2.0)))
+ (list 'mix (lambda () (save-sound-as "temp.snd") (mix "temp.snd" 0) (delete-file "temp.snd")))
+ (list 'vector2 (lambda ()
+ (let ((sd (make-shared-vector (channel->float-vector) (list 1 (framples)))))
+ (float-vector-scale! (sd 0) 2.0)
+ (float-vector->channel (sd 0)))))
+ (list 'convolve (lambda ()
+ (let ((flt (make-float-vector 8))
+ (sf (make-sampler 0)))
+ (set! (flt 0) 2.0)
+ (let ((cnv (make-convolve :filter flt :input (lambda (dir) (read-sample sf)))))
+ (map-channel
+ (lambda (val) (convolve cnv)))))))
+ (list 'fft (lambda ()
+ (let* ((len (framples))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (rl (channel->float-vector 0 fsize))
+ (im (make-float-vector fsize)))
+ (mus-fft rl im fsize)
+ (mus-fft rl im fsize)
+ (mus-fft rl im fsize)
+ (mus-fft rl im fsize)
+ (float-vector->channel (float-vector-scale! rl (/ 2.0 (* fsize fsize))) 0 len))))
+ (list 'set-samples (lambda () ; too slow for some reason, so cut it short at 100
+ (set! (squelch-update) #t)
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (set! (sample i) (* 2 (sample i))))
+ (set! (squelch-update) #f)))
+ (list 'coroutines (lambda ()
+ (set! (squelch-update) #t)
+ (let ((make-scaler
+ (lambda (start end)
+ (letrec ((ctr start)
+ (us (lambda (them)
+ (set! (sample ctr) (* 2.0 (sample ctr)))
+ (set! ctr (+ ctr 2))
+ (if (<= ctr end)
+ (them us)))))
+ us))))
+ ((make-scaler 0 100)
+ (make-scaler 1 100)))
+ (set! (squelch-update) #f)
+ ))
+ ))
+ (close-sound ind))
+
+ (let ((ind1 (open-sound "1a.snd"))
+ (data1 (file->floats "1a.snd"))
+ (ind2 (open-sound "2a.snd"))
+ (data2 (file->floats "2a.snd")))
+ (if (not (equal? data1 (channel->float-vector 0 #f ind1 0)))
+ (snd-display #__line__ ";file->floats 1a.snd"))
+ (if (not (equal? data2 (channel->float-vector 0 #f ind2 0)))
+ (snd-display #__line__ ";file->floats 2a.snd"))
+ (floats->file data1 "tmp.snd")
+ (let ((ind3 (open-sound "tmp.snd")))
+ (if (not (equal? data1 (channel->float-vector 0 #f ind3 0)))
+ (snd-display #__line__ ";floats->file 1a"))
+ (close-sound ind3))
+ (mus-sound-forget "tmp.snd")
+ (floats->file data2 "tmp.snd" 44100 "this is a comment")
+ (let ((ind3 (open-sound "tmp.snd")))
+ (if (not (= (srate ind3) 44100))
+ (snd-display #__line__ ";floats->file srate: ~A" (srate ind3)))
+ (close-sound ind3))
+ (mus-sound-forget "tmp.snd")
+ (let ((tag (catch #t (lambda () (floats->file 32 "tmp.snd")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";floats->file bad arg: ~A" tag))))
+
+ (for-each close-sound (sounds))
+
+ (let ((ind (new-sound "test.snd" 1 22050 mus-ldouble mus-next "insert-* tests" 10)))
+ (map-channel (lambda (y) 1.0) 0 10 ind 0)
+ (insert-float-vector (make-float-vector 5 .1) 2)
+ (if (not (= (framples ind) 15)) (snd-display #__line__ ";insert-float-vector len: ~A" (framples ind)))
+ (let ((vals (channel->float-vector 0 #f ind 0)))
+ (if (not (vequal vals (float-vector 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
+ (snd-display #__line__ ";insert-float-vector vals: ~A" vals)))
+
+ (let ((tag (catch #t (lambda () (insert-float-vector 32)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";insert-float-vector bad arg: ~A" tag)))
+
+ (insert-float-vector (make-float-vector 1 1.5) 0 1 ind 0)
+ (if (not (= (framples ind) 16)) (snd-display #__line__ ";insert-float-vector 1 len: ~A" (framples ind)))
+ (let ((vals (channel->float-vector 0 #f ind 0)))
+ (if (not (vequal vals (float-vector 1.5 1 1 .1 .1 .1 .1 .1 1 1 1 1 1 1 1 1)))
+ (snd-display #__line__ ";insert-float-vector 1 vals: ~A" vals)))
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd" 4 22050 mus-ldouble mus-next "insert-* tests" 5)))
+ (map-channel (lambda (y) 0.4) 0 5 ind 0)
+ (map-channel (lambda (y) 0.5) 0 5 ind 1)
+ (map-channel (lambda (y) 0.6) 0 5 ind 2)
+ (map-channel (lambda (y) 0.7) 0 5 ind 3)
+
+ (insert-float-vector (make-float-vector 20 .1) 2 2 ind 2)
+ (if (not (= (framples ind 0) 5)) (snd-display #__line__ ";4chn insert-float-vector (0) len: ~A" (framples ind 0)))
+ (if (not (= (framples ind 2) 7)) (snd-display #__line__ ";4chn insert-float-vector (2) len: ~A" (framples ind 2)))
+ (if (not (vequal (channel->float-vector 0 7 ind 0) (float-vector .4 .4 .4 .4 .4 0 0)))
+ (snd-display #__line__ ";4chn insert-float-vector 0: ~A" (channel->float-vector 0 7 ind 0)))
+ (if (not (vequal (channel->float-vector 0 7 ind 1) (float-vector .5 .5 .5 .5 .5 0 0)))
+ (snd-display #__line__ ";4chn insert-float-vector 1: ~A" (channel->float-vector 0 7 ind 1)))
+ (if (not (vequal (channel->float-vector 0 7 ind 2) (float-vector .6 .6 .1 .1 .6 .6 .6)))
+ (snd-display #__line__ ";4chn insert-float-vector 2: ~A" (channel->float-vector 0 7 ind 2)))
+ (if (not (vequal (channel->float-vector 0 7 ind 3) (float-vector .7 .7 .7 .7 .7 0 0)))
+ (snd-display #__line__ ";4chn insert-float-vector 3: ~A" (channel->float-vector 0 7 ind 3)))
+
+ (insert-float-vector (make-float-vector 20 .2) 0 2 ind 0)
+ (if (not (= (framples ind 0) 7)) (snd-display #__line__ ";4chn insert-float-vector (0 0) len: ~A" (framples ind 0)))
+ (if (not (= (framples ind 1) 5)) (snd-display #__line__ ";4chn insert-float-vector (0 1) len: ~A" (framples ind 1)))
+ (if (not (= (framples ind 2) 7)) (snd-display #__line__ ";4chn insert-float-vector (2 2) len: ~A" (framples ind 2)))
+ (if (not (vequal (channel->float-vector 0 7 ind 0) (float-vector .2 .2 .4 .4 .4 .4 .4)))
+ (snd-display #__line__ ";4chn insert-float-vector 1 0: ~A" (channel->float-vector 0 7 ind 0)))
+ (if (not (vequal (channel->float-vector 0 7 ind 1) (float-vector .5 .5 .5 .5 .5 0 0)))
+ (snd-display #__line__ ";4chn insert-float-vector 1 1: ~A" (channel->float-vector 0 7 ind 1)))
+ (if (not (vequal (channel->float-vector 0 7 ind 2) (float-vector .6 .6 .1 .1 .6 .6 .6)))
+ (snd-display #__line__ ";4chn insert-float-vector 1 2: ~A" (channel->float-vector 0 7 ind 2)))
+ (if (not (vequal (channel->float-vector 0 7 ind 3) (float-vector .7 .7 .7 .7 .7 0 0)))
+ (snd-display #__line__ ";4chn insert-float-vector 1 3: ~A" (channel->float-vector 0 7 ind 3)))
- (mus-sound-forget "4.aiff")
- (let ((ind (open-sound "4.aiff"))
- (len 0))
- (if (not (= (chans ind) 4)) (snd-display #__line__ ";chans 4.aiff: ~A" (chans ind)))
- (let ((val (scan-sound
- (lambda (fr)
- (set! len (mus-length fr))
- (> (frame-ref fr 3) .1)))))
- (if (not (equal? val (list #t 21244)))
- (snd-display #__line__ ";4 scan-sound: ~A" val))
- (if (not (= len 4)) (snd-display #__line__ ";4 scan-sound frame len: ~A" len)))
-
- (set! len 0)
- (let ((mx (maxamp ind #t)))
- (map-sound
- (lambda (fr)
- (set! len (mus-length fr))
- (frame* fr 2.0))
- 800000 #f ind)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (if (fneq (maxamp ind chn) (* 2 (list-ref mx chn)))
- (snd-display #__line__ ";4:~D map-sound max: ~A ~A" chn mx (maxamp ind chn)))
- (if (not (= (edit-position ind chn) 1))
- (snd-display #__line__ ";4:~D map-sound edpos: ~A" chn (edit-position ind chn))))
- (if (not (= len 4)) (snd-display #__line__ ";4 map-sound frame len: ~A" len)))
- (close-sound ind))
+ (revert-sound ind)
+ (map-channel (lambda (y) 0.4) 0 5 ind 0)
+ (map-channel (lambda (y) 0.5) 0 5 ind 1)
+ (map-channel (lambda (y) 0.6) 0 5 ind 2)
+ (map-channel (lambda (y) 0.7) 0 5 ind 3)
- (let ((sd (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))))
- (let ((sd1 (sound-data-copy sd)))
- (if (not (equal? sd sd1))
- (snd-display #__line__ ";sound-data-copy not equal? ~A ~A" sd sd1))
- (sound-data-scale! sd1 2.0)
- (let ((sd2 (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd2 chn i (* 2 (+ i (* chn 10))))))
- (if (not (equal? sd2 sd1)) (snd-display #__line__ ";sound-data-scale! not equal? ~% ~A~% ~A" sd1 sd2))
- (if (equal? sd2 sd) (snd-display #__line__ ";sound-data-scale! crosstalk??")))
- (sound-data-multiply! sd sd)
- (let ((sd2 (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd2 chn i (* (+ i (* chn 10)) (+ i (* chn 10))))))
- (if (not (equal? sd2 sd)) (snd-display #__line__ ";sound-data-multiply! not equal? ~% ~A~% ~A" sd sd2)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))))
- (sound-data-offset! sd 1.0)
- (let ((sd2 (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd2 chn i (+ 1 i (* chn 10)))))
- (if (not (equal? sd2 sd)) (snd-display #__line__ ";sound-data-offset! not equal? ~% ~A~% ~A" sd sd2)))
- (let ((sd3 (sound-data-reverse! (sound-data-copy sd))))
- (let ((sd2 (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd2 chn i (+ 1 (- 9 i) (* chn 10)))))
- (if (not (equal? sd2 sd3)) (snd-display #__line__ ";sound-data-reverse! not equal? ~% ~A~% ~A" sd3 sd2)))
- (sound-data-add! sd sd3)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd1 chn i (+ 1 10 (* chn 20)))))
- (if (not (equal? sd1 sd)) (snd-display #__line__ ";sound-data-add! not equal? ~% ~A~% ~A" sd sd1)))
-
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))
- (sound-data-set! sd1 chn i 1)))
- (let ((sd2 (sound-data-copy sd)))
- (sound-data+ sd 1)
- (sound-data-add! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ sd 1: ~% ~A~% ~A" sd sd2))
- (sound-data+ 1 sd)
- (sound-data-add! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ 1 sd: ~% ~A~% ~A" sd sd2))
- (sound-data+ sd sd1)
- (sound-data-add! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ sd sd: ~% ~A~% ~A" sd sd2)))
-
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))
- (sound-data-set! sd1 chn i 2)))
- (let ((sd2 (sound-data-copy sd)))
- (if (fneq (sound-data-peak sd) (apply max (sound-data-maxamp sd)))
- (snd-display #__line__ ";sound-data-peak: ~A ~A" (sound-data-peak sd) (apply max (sound-data-maxamp sd))))
- (sound-data* sd 2)
- (sound-data-multiply! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* sd 1: ~% ~A~% ~A" sd sd2))
- (sound-data* 2 sd)
- (sound-data-multiply! sd2 sd1)
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* 1 sd: ~% ~A~% ~A" sd sd2))
- (sound-data* sd sd1)
- (sound-data-add! sd2 sd2)
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* sd sd: ~% ~A~% ~A" sd sd2)))))
-
- ;; tests from clean.scm
- (test-remove-single-clicks)
- (test-remove-pops)
- (test-notch-hum)
- (test-remove-DC)
-
- ;; check 0 cases
- (let ((ind (open-sound "oboe.snd")))
- (scale-by 0.0)
- (if (fneq (maxamp) 0.0) (snd-display #__line__ ";scale-by 0 amp: ~A" (maxamp)))
- (scale-by 3.0)
- (if (not (= (edit-position) 1)) (snd-display #__line__ ";scale-by over 0: ~A" (edit-position)))
- (scale-to 1.0)
- (if (not (= (edit-position) 1)) (snd-display #__line__ ";scale-to 1.0 over 0: ~A" (edit-position)))
- (if (fneq (maxamp) 0.0) (snd-display #__line__ ";scale-to 1.0 over 0 amp: ~A" (maxamp)))
- (ramp-channel 0 1)
- (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
- (env-channel '(0 0 1 1 2 0))
- (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
- (if (not (string=? (car (edit-fragment 1)) "scale-channel 0.000 0 #f"))
- (snd-display #__line__ ";ramp over 0 clobbered origin: ~A" (edit-fragment 1)))
- (xramp-channel 0 1 32.0)
- (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
- (env-channel-with-base '(0 0 1 1 2 0 3 1) 0.0)
- (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
- (close-sound ind))
+ (close-sound ind))
+
+ (let ((ind (new-sound "test.snd" 4 22050 mus-ldouble mus-next "mix-* tests" 5)))
+ (map-channel (lambda (y) 0.4) 0 5 ind 0)
+ (map-channel (lambda (y) 0.5) 0 5 ind 1)
+ (map-channel (lambda (y) 0.6) 0 5 ind 2)
+ (map-channel (lambda (y) 0.7) 0 5 ind 3)
- ;; snddiff.scm
- (let ((ind0 (open-sound "oboe.snd"))
- (ind1 (open-sound "oboe.snd")))
- (let ((diff (snddiff ind0 0 ind1 0)))
- (if (not (equal? diff 'no-difference))
- (snd-display #__line__ ";snddiff of same sound: ~A" diff)))
- (scale-channel 2.0 0 #f ind1)
- (let ((diff (snddiff ind0 0 ind1 0)))
- (if (or (not (eq? (car diff) 'scale))
- (fneq (cadr diff) 2.0))
- (snd-display #__line__ ";snddiff scale by 2: ~A" diff)))
- (revert-sound ind1)
- (set! (sample 100 ind0 0) 1.0)
- (let* ((diff (snddiff ind0 0 ind1 0))
- (info (and diff (list? diff) (= (length diff) 2) (= (length (car (cadr diff))) 3) (car (cadr diff)))))
- (if (or (not (eq? (car diff) 'differences))
- (not info)
- (not (= (car info) 100))
- (fneq (cadr info) 1.0)
- (fneq (caddr info) -3.051e-4))
- (snd-display #__line__ ";snddiff change sample 100: ~A" diff)))
- (revert-sound ind0)
- (pad-channel 0 100 ind0 0)
- (let ((diff (snddiff ind0 0 ind1 0)))
- (if (or (not (eq? (list-ref diff 0) 'lag))
- (not (= (list-ref diff 1) 100))
- (not (eq? (list-ref diff 2) 'no-difference))
- (fneq (list-ref diff 3) 0.0)
- (not (eq? (list-ref diff 4) #f))
- (not (eq? (list-ref diff 5) #f))
- (not (eq? (list-ref diff 6) #f)))
- (snd-display #__line__ ";snddiff + lag: ~A" diff)))
- (revert-sound ind0)
- (filter-channel (vct 1.0 0.5 0.25) 3 0 #f ind1 0)
- (let* ((diff (snddiff ind0 0 ind1 0))
- (info (and (cadr diff) (= (length (cadr diff)) 3) (cadr diff))))
- (if (or (not (list? info))
- (not (list? diff))
- (not (eq? (car diff) 'filter))
- (fneq (car (car info)) 1.0)
- (fneq (car (cadr info)) 0.5)
- (fneq (car (caddr info)) 0.25)
- (not (= (cadr (car info)) 0))
- (not (= (cadr (cadr info)) 1))
- (not (= (cadr (caddr info)) 1)))
- (snd-display #__line__ ";snddiff filter: ~A" diff)))
- (revert-sound ind1)
-
- (close-sound ind0)
- (close-sound ind1))
+ (revert-sound ind)
+ (map-channel (lambda (y) 0.4) 0 5 ind 0)
+ (map-channel (lambda (y) 0.5) 0 5 ind 1)
+ (map-channel (lambda (y) 0.6) 0 5 ind 2)
+ (map-channel (lambda (y) 0.7) 0 5 ind 3)
- (let ((ind (open-sound "oboe.snd")))
- (let ((g550 (goertzel-channel 550.0))
- (g1700 (goertzel-channel 1700.0)))
- (if (> (* 1000 g1700) g550) (snd-display #__line__ ";goertzel-channel oboe: ~A ~A" g550 g1700))
- (close-sound ind)))
+ (close-sound ind))
+
+ ;; tests from clean.scm
+ (test-remove-single-clicks)
+ (test-remove-pops)
+ (test-notch-hum)
+ (test-remove-DC)
+
+ ;; check 0 cases
+ (let ((ind (open-sound "oboe.snd")))
+ (scale-by 0.0)
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";scale-by 0 amp: ~A" (maxamp)))
+ (scale-by 3.0)
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";scale-by over 0: ~A" (edit-position)))
+ (scale-to 1.0)
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";scale-to 1.0 over 0: ~A" (edit-position)))
+ (if (fneq (maxamp) 0.0) (snd-display #__line__ ";scale-to 1.0 over 0 amp: ~A" (maxamp)))
+ (ramp-channel 0 1)
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
+ (env-channel '(0 0 1 1 2 0))
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
+ (if (not (string=? (car (edit-fragment 1)) "scale-channel 0.000 0 #f"))
+ (snd-display #__line__ ";ramp over 0 clobbered origin: ~A" (edit-fragment 1)))
+ (xramp-channel 0 1 32.0)
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
+ (env-channel-with-base '(0 0 1 1 2 0 3 1) 0.0)
+ (if (not (= (edit-position) 1)) (snd-display #__line__ ";ramp over 0: ~A" (edit-position)))
+ (close-sound ind))
+
+ ;; snddiff.scm
+ (let ((ind0 (open-sound "oboe.snd"))
+ (ind1 (open-sound "oboe.snd")))
+ (let ((diff (snddiff ind0 0 ind1 0)))
+ (if (not (eq? diff 'no-difference))
+ (snd-display #__line__ ";snddiff of same sound: ~A" diff)))
+ (scale-channel 2.0 0 #f ind1)
+ (let ((diff (snddiff ind0 0 ind1 0)))
+ (if (or (not (eq? (car diff) 'scale))
+ (fneq (cadr diff) 2.0))
+ (snd-display #__line__ ";snddiff scale by 2: ~A" diff)))
+ (revert-sound ind1)
+ (set! (sample 100 ind0 0) 1.0)
+ (let* ((diff (snddiff ind0 0 ind1 0))
+ (info (and diff (list? diff) (= (length diff) 2) (= (length (car (cadr diff))) 3) (car (cadr diff)))))
+ (if (or (not (eq? (car diff) 'differences))
+ (not info)
+ (not (= (car info) 100))
+ (fneq (cadr info) 1.0)
+ (fneq (caddr info) -3.051e-4))
+ (snd-display #__line__ ";snddiff change sample 100: ~A" diff)))
+ (revert-sound ind0)
+ (pad-channel 0 100 ind0 0)
+ (let ((diff (snddiff ind0 0 ind1 0)))
+ (if (or (not (eq? (diff 0) 'lag))
+ (not (= (diff 1) 100))
+ (not (eq? (diff 2) 'no-difference))
+ (fneq (diff 3) 0.0)
+ (diff 4)
+ (diff 5)
+ (diff 6))
+ (snd-display #__line__ ";snddiff + lag: ~A" diff)))
+ (revert-sound ind0)
+ (filter-channel (float-vector 1.0 0.5 0.25) 3 0 #f ind1 0)
+ (let* ((diff (snddiff ind0 0 ind1 0))
+ (info (and (cadr diff) (= (length (cadr diff)) 3) (cadr diff))))
+ (if (or (not (list? info))
+ (not (list? diff))
+ (not (eq? (car diff) 'filter))
+ (fneq (caar info) 1.0)
+ (fneq (caadr info) 0.5)
+ (fneq (caaddr info) 0.25)
+ (not (= (cadar info) 0))
+ (not (= (cadadr info) 1))
+ (not (= (cadr (caddr info)) 1)))
+ (snd-display #__line__ ";snddiff filter: ~A ~A" diff info)))
+ (revert-sound ind1)
- )))
+ (close-sound ind0)
+ (close-sound ind1))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (let ((g550 (goertzel-channel 550.0))
+ (g1700 (goertzel-channel 1700.0)))
+ (if (> (* 1000 g1700) g550) (snd-display #__line__ ";goertzel-channel oboe: ~A ~A" g550 g1700))
+ (close-sound ind)))
+
+ ))
-;;; ---------------- test 22: run ----------------
+;;; ---------------- test 21: optimizer ----------------
-(defmacro fxtst (form result)
- `(let ((val ,form))
- (if (fneq val ,result)
- (snd-display #__line__ ";~A -> ~A (~A)" ',form val ,result))))
+(define (snd_test_21)
-(defmacro ixtst (form result)
- `(let ((val ,form))
- (if (not (= val ,result))
- (snd-display #__line__ ";~A -> ~A (~A)" ',form val ,result))))
+ (let ()
+ (define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below
+ "(for-each-permutation func vals) applies func to every permutation of vals"
+ ;; (for-each-permutation (lambda args (format-logged #t "~{~A~^ ~}~%" args)) '(1 2 3))
+ (define (pinner cur nvals len)
+ (if (= len 1)
+ (apply func (cons (car nvals) cur))
+ (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish
+ ((= i len))
+ (let ((start nvals))
+ (set! nvals (cdr nvals))
+ (let ((cur1 (cons (car nvals) cur))) ; add (car nvals) to our arg list
+ (set! (cdr start) (cdr nvals)) ; splice out that element and
+ (pinner cur1 (cdr start) (- len 1)) ; pass a smaller circle on down
+ (set! (cdr start) nvals)))))) ; restore original circle
+ (let ((len (length vals)))
+ (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle
+ (pinner () vals len)
+ (set-cdr! (list-tail vals (- len 1)) ()))) ; restore its original shape
+
+ (define (for-each-subset func args)
+ (define (subset source dest len)
+ (if (null? source)
+ (if (aritable? func len)
+ (apply func dest))
+ (begin
+ (subset (cdr source) (cons (car source) dest) (+ len 1))
+ (subset (cdr source) dest len))))
+ (subset args () 0))
+
+ (define-macro (test tst expected)
+ `(let ((val ,tst))
+ (if (not (morally-equal? val ,expected))
+ (format *stderr* "~S: ~S but expected ~S~%" ',tst val ,expected))))
+
+ (define (fv0)
+ (let ((fv (make-float-vector 3))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) fv)
+ (float-vector-set! fv i (oscil g)))))
+ (test (fv0) (float-vector 0.0 0.1419943179576268 0.2811111133316549))
+
+ (define (fv00)
+ (let ((fv (make-float-vector 3))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3) fv)
+ (set! (fv i) (oscil g)))))
+ (test (fv00) (float-vector 0.0 0.1419943179576268 0.2811111133316549))
-(defmacro bxtst (form result)
- `(let ((val ,form))
- (if (not (eq? val ,result))
- (snd-display #__line__ ";~A -> ~A (~A)" ',form val ,result))))
+ (define (fv01)
+ (let ((fv (make-float-vector 3))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 5) fv)
+ (float-vector-set! fv i (oscil g)))))
+
+ (test (catch #t
+ fv01
+ (lambda args
+ (apply format #f (cadr args)))) ; float-vector-set! argument 2, 3, is out of range (it is too large)
+ "float-vector-set! argument 2, 3, is out of range (it is too large)")
+
+ (define (fv02)
+ (let ((fv (make-float-vector 3))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1/2)))
+ ((= i 2) fv)
+ (float-vector-set! fv i (oscil g)))))
+
+ (test (catch #t
+ (lambda ()
+ (display (fv02)) (newline))
+ (lambda args
+ (apply format #f (cadr args)))) ; float-vector-set! argument 2, 1/2, is a ratio but should be an integer
+ "float-vector-set! argument 2, 1/2, is a ratio but should be an integer")
+
+ ;; (+ (* s1 s2) (* (- 1.0 s1) s3))
+
+ (define (fv1 s1 s2 s3)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (* s1 s2) (* (- 1.0 s1) s3))))))
+
+ (test (fv1 1 2 3) (float-vector 2.0 2.0 2.0 2.0))
+ (test (fv1 2 3 4) (float-vector 2.0 2.0 2.0 2.0))
+ (test (fv1 1.0 2.0 3.0) (float-vector 2.0 2.0 2.0 2.0))
+ (test (fv1 2.0 3.0 4.0) (float-vector 2.0 2.0 2.0 2.0))
+ (test (fv1 1/2 5/4 3/4) (float-vector 1.0 1.0 1.0 1.0))
+
+ (test
+ (catch #t
+ (lambda ()
+ (fv1 1+i 2+2i 3+3i)) ; 'error? -- 3+i
+ (lambda args
+ (apply format #f (cadr args)))) ; float-vector-set! argument 3, 3+1i, is a complex number but should be a real
+ "float-vector-set! argument 3, 3+1i, is a complex number but should be a real")
+
+ (define (fv2 s1 s2 s3)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 1.0 (+ x 0+i)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (* x s2) (* (- 1.0 x) s3))))))
+ (test
+ (catch #t
+ (lambda ()
+ (fv2 1 2 3)) ; 'error again #(2.0 2-1i 2-2i 2-3i)
+ (lambda args (car args))) 'wrong-type-arg)
+
+ (set! (*s7* 'print-length) 123)
+ (define (fv3)
+ (let ((gens (vector (make-oscil 100) (make-oscil 200 1.7) (make-oscil 300 5.0))))
+ (let ((fv (make-float-vector 3))
+ (iter (make-iterator gens)))
+ (do ((i 0 (+ i 1))
+ (g (iterate iter) (iterate iter)))
+ ((= i 3) fv)
+ (float-vector-set! fv i (oscil g))))))
+
+ (test (fv3) (float-vector 0.0 0.9916648104524686 -0.9589242746631385))
+
+ (define (fv4)
+ (let ((fv-a (make-float-vector 4))
+ (fv-b (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) (list fv-a fv-b))
+ (float-vector-set! fv-a i (float-vector-set! fv-b i (oscil g))))))
+
+ (test (fv4) (list (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)
+ (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)))
+
+ (define (fv5)
+ (let ((fv-a (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv-a)
+ (float-vector-set! fv-a i (oscil g1 (oscil g2))))))
+
+ (test (fv5) (float-vector 0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
+
+ (define (fv6)
+ (let ((g1 (make-oscil 1000))
+ (g2 (make-oscil 1000)))
+ (list (oscil g1 (oscil g2)) (oscil g1 (oscil g2)) (oscil g1 (oscil g2)) (oscil g1 (oscil g2)))))
+
+ (test (fv6) '(0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
+
+ (define (fv7)
+ (let ((g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (x 0.1))
+ (let ((fv (make-float-vector 6)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (float-vector-set! fv i (oscil g0 0.1)))
+ (do ((i 3 (+ i 1)))
+ ((= i 6))
+ (float-vector-set! fv i (oscil g1 x)))
+ fv)))
+
+ (test (fv7) (float-vector 0.0 0.2401067896488338 0.4661656420314379 0.0 0.2401067896488338 0.4661656420314379))
+
+ (define (fv8)
+ (let ((g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (oscil g))
+ (oscil g)))
+
+ (test (morally-equal? (fv8) 0.5395507431861811) #t)
+
+ (define (fv9)
+ (let ((g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4))
+ (oscil g 0.1))
+ (oscil g 0.1)))
+
+ (test (morally-equal? (fv9) 0.8248311180769614) #t)
+
+ (define (fv10)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* i i)))))
+ (test (fv10) (float-vector 0.0 1.0 4.0 9.0))
+
+ (define (fv11)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* (oscil g0) (oscil g1))))))
+ (test (fv11) (float-vector 0.0 0.02016238633225161 0.07902345803856255 0.1718360964482408))
+
+ (define (fv12)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* 2.0 (oscil g0))))))
+ (test (fv12) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
+
+ (define (fv13)
+ (let ((fv (make-float-vector 4))
+ (x 2.0)
+ (g0 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* (oscil g0) x)))))
+ (test (fv13) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
+
+ (define (fv14)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (s0 2.0)
+ (s1 3.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* s0 (oscil g0 (* s1 (oscil g1))))))))
+ (test (fv14) (float-vector 0.0 0.2839886359152535 1.305084606281564 1.984158175327229))
+
+ (define (fv15)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ i i)))))
+ (test (fv15) (float-vector 0.0 2.0 4.0 6.0))
+
+ (define (fv16)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) (oscil g1))))))
+ (test (fv16) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
+
+ (define (fv17)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ 2.0 (oscil g0))))))
+ (test (fv17) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
+
+ (define (fv18)
+ (let ((fv (make-float-vector 4))
+ (x 2.0)
+ (g0 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) x)))))
+ (test (fv18) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
+
+ (define (fv19)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (s0 2.0)
+ (s1 3.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s0 (oscil g0 (* s1 (oscil g1))))))))
+ (test (fv19) (float-vector 2.0 2.141994317957627 2.652542303140782 2.992079087663615))
+
+ (define (fv20)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) (oscil g1) (oscil g2))))))
+ (test (fv20) (float-vector 0.0 0.4259829538728803 0.8433333399949648 1.243593530070886))
+
+ (define (fv21)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (s1 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) (oscil g1) s1)))))
+ (test (fv21) (float-vector 1.0 1.283988635915253 1.56222222666331 1.829062353380591))
+
+ (define (fv22)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) 1.0 (oscil g1))))))
+ (test (fv22) (float-vector 1.0 1.283988635915253 1.56222222666331 1.829062353380591))
+
+ (define (fv23)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (s1 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s1 1.0 (oscil g0))))))
+ (test (fv23) (float-vector 2.0 2.141994317957627 2.281111113331655 2.414531176690295))
+
+ (define (fv24)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (s1 1.0)
+ (s2 2.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s1 (oscil g0) s2)))))
+ (test (fv24) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
+
+ (define (fv25)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (s1 1.0)
+ (s2 2.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s1 s2 (oscil g0))))))
+ (test (fv25) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
+
+ (define (fv26)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (s1 1.0)
+ (s2 2.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) s1 s2)))))
+ (test (fv26) (float-vector 3.0 3.141994317957627 3.281111113331655 3.414531176690295))
+
+ (define (fv27)
+ (let ((fv (make-float-vector 4))
+ (s3 4.0)
+ (s1 1.0)
+ (s2 2.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s3 s1 s2)))))
+ (test (fv27) (float-vector 7.0 7.0 7.0 7.0))
+
+ (define (fv28)
+ (let ((fv (make-float-vector 4))
+ (s1 1.0)
+ (s2 2.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ 4.0 s1 s2)))))
+ (test (fv28) (float-vector 7.0 7.0 7.0 7.0))
+
+ (define (fv29)
+ (let ((fv (make-float-vector 4))
+ (s1 1.0)
+ (s2 2.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ s1 s2 4.0)))))
+ (test (fv29) (float-vector 7.0 7.0 7.0 7.0))
+
+ (define (fv30)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* (oscil g0) (oscil g1) (oscil g2))))))
+ (test (fv30) (float-vector 0.0 0.002862944295646243 0.02221437226853764 0.07123141925855635))
+
+ (define (fv31)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000 4.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (abs (oscil g0))))))
+ (test (fv31) (float-vector 0.7568024953079282 0.8419478535558946 0.9100310927158114 0.9596725022396432))
+
+ (define (fv32)
+ (let ((fv (make-float-vector 4))
+ (s0 -1.5))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (abs s0)))))
+ (test (fv32) (float-vector 1.5 1.5 1.5 1.5))
+
+ (define (fv31a)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((x (oscil g0)))
+ (float-vector-set! fv i (oscil g1 x))))))
+ (test (fv31a) (float-vector 0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
+
+ (define (fv32a)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((x (oscil g0)))
+ (float-vector-set! fv i (oscil g1 x))))))
+ (test (fv32a) (float-vector 0.0 0.1419943179576268 0.4140929109323406 0.7516320715399403))
+
+ (define (fv33)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((x (oscil g0))
+ (y (oscil g0)))
+ (float-vector-set! fv i (* y (oscil g1 x)))))))
+ (test (fv33) (float-vector 0.0 0.05886107170631096 0.3505537450231597 0.7966641560805439))
+
+ (define (fv34)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let* ((x (oscil g0))
+ (y (oscil g0)))
+ (float-vector-set! fv i (* y (oscil g1 x)))))))
+ (test (fv34) (float-vector 0.0 0.05886107170631096 0.3505537450231597 0.7966641560805439))
+
+ (define (fv35)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let* ((x (oscil g0))
+ (y x))
+ (float-vector-set! fv i (+ y (oscil g1)))))))
+ (test (fv35) (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906))
+
+ (define (fv36)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (x 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((x (oscil g0))
+ (y x))
+ (float-vector-set! fv i (+ y (oscil g1)))))))
+ (test (fv36) (float-vector 1.0 1.141994317957627 1.281111113331655 1.414531176690295))
+
+ (define (fv37)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (x0 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (odd-weight (+ x0 (oscil g0)))))))
+ (test (fv37) (float-vector 1.0 0.8580056820423732 0.7188888866683452 0.5854688233097047))
+
+ (define (fv38)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (x0 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (even-weight (+ x0 (oscil g0)))))))
+ (test (fv38) (float-vector 0.0 0.1419943179576268 0.2811111133316548 0.4145311766902953))
+
+ (define (fv39)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (max (oscil g0) 0.25)))))
+ (test (fv39) (float-vector 0.25 0.25 0.2811111133316549 0.4145311766902953))
+
+ (define (fv40)
+ (let ((g0 (make-file->sample "oboe.snd"))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (ina i g0)))))
+ (test (fv40) (float-vector 0.0 -0.00030517578125 -0.00030517578125 -0.000274658203125))
+
+ (define (fv41)
+ (let ((g0 (make-float-vector 3 0.5))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (ina i g0)))))
+ (test (fv41) (float-vector 0.5 0.5 0.5 0.0))
+
+ (define (fv42)
+ (let ((g0 (make-float-vector 3 0.5))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (- (ina i g0))))))
+ (test (fv42) (float-vector -0.5 -0.5 -0.5 0.0))
+
+ (define (fv43)
+ (let ((g0 (make-float-vector 3 0.5))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (- i)))))
+ (test (fv43) (float-vector 0 -1 -2 -3))
+
+ (define (permute op . args)
+ (let ((body (copy `(let ()
+ (define (t1)
+ (let ((x 1.5) (y 3.5) (g0 (make-oscil 1000)) (g1 (make-oscil 2000)) (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (,op , at args)))))
+ (define (t2)
+ (let ((x 1.5) (y 3.5) (g0 (make-oscil 1000)) (g1 (make-oscil 2000)) (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (,op , at args)))))
+ (let ((v1 (t1))
+ (v2 (copy (t2) (make-float-vector 4))))
+ (if (not (morally-equal? v1 v2))
+ (format *stderr* "~D: ~A -> ~A ~A~%" #__line__ args v1 v2))))
+ :readable)))
+ (eval body)))
+
+ (set! (*s7* 'morally-equal-float-epsilon) 1e-12)
+ (for-each
+ (lambda (op)
+ (for-each-subset
+ (lambda s-args
+ (if (pair? s-args)
+ (for-each-permutation (lambda args (apply permute op args)) s-args)))
+ (list 'x '(oscil g0) 2.0 '(oscil g1) 'y)))
+ (list '+ '* '-))
+
+ (for-each-subset
+ (lambda s-args
+ (if (pair? s-args)
+ (for-each-permutation (lambda args (apply permute '/ args)) s-args)))
+ (list 'x '(+ .01 (oscil g0)) 2.0 '(+ .01 (oscil g1)) 'y))
+
+ (define (fv44)
+ (let ((g0 (make-float-vector 3 1.0))
+ (fv (make-float-vector 4))
+ (x 2.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (polynomial g0 x)))))
+ (test (fv44) (float-vector 7.0 7.0 7.0 7.0))
+
+ (define (fv45)
+ (let ((g0 (make-float-vector 3 1.0))
+ (fv (make-float-vector 4))
+ (x (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (polynomial g0 (* 2.0 (oscil x)))))))
+ (test (fv45) (float-vector 1.0 1.36463818124426 1.87831605881756 2.516406739173554))
+
+ (define (fv46)
+ (let ((g0 (make-float-vector 4 1.0))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (float-vector-ref g0 i)))))
+ (test (fv46) (float-vector 1.0 1.0 1.0 1.0))
+
+ (define (fv47)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (x 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (amplitude-modulate 1.0 x (oscil g0))))))
+ (test (fv47) (float-vector 1.0 1.141994317957627 1.281111113331655 1.414531176690295))
+
+ (define (fv48)
+ (let ((g0 (make-oscil 1000))
+ (fv (make-float-vector 4))
+ (x 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (remainder (* 10 (oscil g0)) 1.0)))))
+ (test (fv48) (float-vector 0.0 0.4199431795762676 0.8111111333165493 0.1453117669029531))
-(defmacro time-it (a)
- `(let ((start (real-time)))
- ,a
- (- (real-time) start)))
-
-(define unique-float 3.0)
-(define unique-int 3)
-(define unique-char #\c)
-(define unique-string "hiho")
-(define unique-float-vector (make-vector 3 1.0))
-(define unique-int-vector (make-vector 3 1))
-(define unique-generator (make-oscil))
-(define unique-list (list 1 (make-oscil)))
-(define unique-symbol 'hiho)
-(define unique-keyword :hiho)
-(define unique-clm-vector (make-vector 3 #f))
-(define unique-boolean #t)
-(define unique-vct-vector (make-vector 3 #f))
-(define int-var 32)
-(define dbl-var 3.14)
-(define bool-var #t)
-(define lst-var '(0 1 2))
-(define biggie (expt 2 31))
-(define str-var "hi")
-(define cont1 #f)
-(define cont2 #f)
-(define gv 1)
-(define global-v (make-vct 3 1.0))
-(define global-v1 (make-vct 3 1.0))
-(define c-var #\a)
-(define list-var (list 2 3 4 5))
-(define l0111 (list 0 1 1 1))
-(define v-var (make-vct 8))
-(define ivect (make-vector 3 1))
-
-(define lfunc
- (let ((ho 3))
- (lambda ()
- ho)))
+ (define (fv49)
+ (let ((g0 (float-vector 1 2 3 4 5 6))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (float-vector-ref g0 (+ i 2))))))
+ (test (fv49) (float-vector 3 4 5 6))
+
+ (define (fv49)
+ (let ((fv (make-float-vector 4))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (g3 (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g0) (oscil g1) (oscil g2) (oscil g3))))))
+ (test (fv49) (float-vector 0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
-(defgenerator st3 one two)
-(define svar (make-st3 :one 1.0 :two 2.0))
-(define svar1 #f)
-(define bst3 #f)
-(defgenerator st4 (one 1) (two 2.0))
-(define bst4 #f)
-(defgenerator hiho1 i x (s "hiho") (ii 3 :type int) (xx 1.0 :type float))
-(defgenerator hiho2 (i 0 :type int) (x 0.0 :type float) (v #f :type vct) (s "hiho") (ii 3 :type int) (xx 1.0 :type float))
-(define g-gen (make-oscil 440))
+ (define (fv50)
+ (let ((iv (int-vector 0 1 2 3 4 5 6))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv (vector-ref iv i) 1.0))))
+ (test (fv50) (float-vector 1.0 1.0 1.0 1.0))
-(define clm_vector (make-vector 2))
-(define vct_vector (make-vector 2))
+ (define (fv51)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((> i 4) fv)
+ (float-vector-set! fv i (oscil g)))))
+ (test (catch #t fv51 (lambda args (car args))) 'out-of-range)
+
+ (define (fv52)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1.1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (oscil g)))))
+ (test (catch #t fv52 (lambda args (car args))) 'wrong-type-arg)
+
+ (define (fv53)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 2)))
+ ((= i 3) fv)
+ (float-vector-set! fv i (oscil g)))))
+ (test (catch #t fv53 (lambda args (car args))) 'out-of-range)
+
+
+ (define (fv54)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((> i 4) fv)
+ (float-vector-set! fv i (oscil g)))))
+ (test (catch #t fv54 (lambda args (car args))) 'out-of-range)
+
+ (define (fv55)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1.1))
+ (x 0.0 (+ x 0.1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (oscil g)))))
+ (test (catch #t fv55 (lambda args (car args))) 'wrong-type-arg)
+
+ (define (fv56)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 2))
+ (x 0.0 (+ x 0.1)))
+ ((= i 3) fv)
+ (float-vector-set! fv i (oscil g)))))
+ (test (catch #t fv56 (lambda args (car args))) 'out-of-range)
+
+ (define (fv57)
+ (let ((g (make-oscil 1000))
+ (e (make-env '(0 0 1 1) :length 5))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (* (env e) (oscil g))))))
+ (test (fv57) (float-vector 0.0 0.03549857948940669 0.1405555566658275 0.3108983825177215))
+
+ (define (fv58)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((j i)) ; no rf here
+ (float-vector-set! fv j (oscil g))))))
+
+ (test (fv58) (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953))
+
+ (define (fv59)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((j (abs i))) ; j is not an integer! so is_fv_set_rf rejects it -- yow
+ (float-vector-set! fv j (oscil g))))))
+
+ (test (fv59) (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953))
-(define hi1 (make-hiho1))
-(define hif2 (make-hiho1 :xx 3.14))
-(define hi2 (make-hiho2 :v (make-vct 3 .1)))
+ (define (fv60)
+ (let ((xv (float-vector 0 1 2 3 4))
+ (fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (len 5))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (array-interp xv (* 4 (abs (oscil g))) len)))))
+ (test (fv60) (float-vector 0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
-(define (efunc-1 arg) (+ arg 1))
-(define (efunc-2 arg) (not arg))
-(define (efunc-3 arg1 arg2 arg3) (if arg1 (+ arg2 arg3) 0))
-(define (efunc-4 arg) (string-append arg "!"))
-(define (efunc-5 arg) (+ 1 (string-length arg)))
-(define (efunc-6 arg) (oscil arg))
-(define efunc-gen (make-oscil 440.0))
-(define (efunc-7 arg) arg)
+ (define (fv60a)
+ (let ((xv (float-vector 0 1 2 3 4))
+ (fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (len 5))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (array-interp xv (* 4 (abs (oscil g))) len)))))
+
+ (test (fv60a) (float-vector 0.0 0.5679772718305071 1.12444445332662 1.658124706761181))
-(defgenerator hi308 freq phase)
+ (define (fv61)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g) (oscil g))))))
+
+ (test (fv61) (float-vector 0.1419943179576268 0.6956422900219503 1.193187027684375 1.594501774071586))
+
+ (define (fv62)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (x .1))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g) (oscil g x))))))
+
+ (test (fv62) (float-vector 0.1419943179576268 0.8788265473477139 1.4870276868047 1.877577239959861))
+
+ (define (fv63)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000))
+ (x .1))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (+ (oscil g x) (oscil g))))))
+
+ (test (fv63) (float-vector 0.2401067896488338 0.962578603769539 1.544160801705073 1.899729018207357))
-(define (call-hi308 hi308-gen)
- (declare (hi308-gen hi308))
- (hi308-freq hi308-gen))
+ (define (fv64)
+ (set! (mus-rand-seed) 1234)
+ (let ((fv (make-float-vector 10))
+ (e (make-env '(0 0 1 1) :length 10))
+ (r (make-rand-interp 1000 .1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) fv)
+ (float-vector-set! fv i (+ (env e) (rand-interp r))))))
+
+ (test (fv64) (float-vector -0.001775140394296145 0.1075608303225188 0.2168968010393338 0.3262327717561487 0.4355687424729637 0.5449047131897787 0.6542406839065937 0.7635766546234087 0.8729126253402237 0.9822485960570387))
+
+ (define (fv65)
+ (set! (mus-rand-seed) 1234)
+ (let ((fv (make-float-vector 10))
+ (e (make-triangle-wave 1000 .5))
+ (r (make-rand-interp 1000 .1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) fv)
+ (float-vector-set! fv i (+ (triangle-wave e) (rand-interp r))))))
+
+ (test (fv65) (float-vector -0.001775140394296145 0.0418011931343102 0.08537752666291655 0.1289538601915229 0.1725301937201293 0.2161065272487356 0.2596828607773419 0.3032591943059482 0.3468355278345545 0.3904118613631609))
+
+ (define (fv66)
+ (let ((fv (make-float-vector 8))
+ (gv (make-vector 8))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000)))
+ (do ((i 0 (+ i 2)))
+ ((= i 8))
+ (set! (gv i) g0)
+ (set! (gv (+ i 1)) g1))
+ (do ((i 0 (+ i 1)))
+ ((= i 8) fv)
+ (float-vector-set! fv i (oscil (vector-ref gv i))))))
+
+ (test (fv66) (float-vector 0.0 0.0 0.1419943179576268 0.1419943179576268 0.2811111133316549 0.2811111133316549 0.4145311766902953 0.4145311766902953))
+
+ (define (fv67)
+ (let ((fv (make-float-vector 8))
+ (g (make-oscil 1000))
+ (v (make-vector 8)))
+ (fill! v g)
+ (do ((i 0 (+ i 1)))
+ ((= i 8) fv)
+ (float-vector-set! fv i (oscil (vector-ref v i))))))
+
+ (test (fv67) (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953 0.5395507431861811 0.6536362844981936 0.7544758509208143 0.8400259231507713))
+
+ (define (fv68)
+ (let ((fv (make-float-vector 8))
+ (gv (make-vector 8))
+ (g0 (make-oscil 1000))
+ (g1 (make-oscil 1000))
+ (x .1))
+ (do ((i 0 (+ i 2)))
+ ((= i 8))
+ (set! (gv i) g0)
+ (set! (gv (+ i 1)) g1))
+ (do ((i 0 (+ i 1)))
+ ((= i 8) fv)
+ (float-vector-set! fv i (oscil (vector-ref gv i) x)))))
+
+ (test (fv68) (float-vector 0.0 0.0 0.2401067896488338 0.2401067896488338 0.4661656420314379 0.4661656420314379 0.6649505230927522 0.6649505230927522))
+
+ (define (fv69)
+ (let ((fv (make-float-vector 4))
+ (g (make-formant 440 .9))
+ (e (make-env '(0 440 1 880) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (mus-set-formant-frequency g (env e))))))
+
+ (test (fv69) (float-vector 440.0 488.8888888888889 537.7777777777778 586.6666666666667))
-(define (set-hi308 hi308-gen)
- (declare (hi308-gen hi308))
- (set! (hi308-freq hi308-gen) (* 3.5 (hi308-freq hi308-gen))))
+ (define (fv70)
+ (let ((fv1 (make-float-vector 4))
+ (fv2 (make-float-vector 4))
+ (g1 (make-oscil 1000))
+ (g2 (make-oscil 1000))
+ (e (make-env '(0 2.0 1 2.0) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) (list fv1 fv2))
+ (let ((x (env e)))
+ (float-vector-set! fv1 i (oscil g1))
+ (float-vector-set! fv2 i (* x (oscil g2)))))))
+
+ (test (fv70) (list (float-vector 0.0 0.1419943179576268 0.2811111133316549 0.4145311766902953)
+ (float-vector 0.0 0.2839886359152535 0.5622222266633099 0.8290623533805906)))
+
+ (define (fv71)
+ (let ((fv (make-float-vector 8))
+ (gv (make-vector 8))
+ (g0 (make-env '(0 0 1 1) :length 5))
+ (g1 (make-env '(0 0 1 1) :length 5)))
+ (do ((i 0 (+ i 2)))
+ ((= i 8))
+ (set! (gv i) g0)
+ (set! (gv (+ i 1)) g1))
+ (do ((i 0 (+ i 1)))
+ ((= i 8) fv)
+ (float-vector-set! fv i (env (vector-ref gv i))))))
+
+ (test (fv71) (float-vector 0.0 0.0 0.25 0.25 0.5 0.5 0.75 0.75))
-(defgenerator hiho309 (i 0 :type int) (x 0.0 :type float) (v #f :type vct))
+ (define (fv72)
+ (let ((fv (make-float-vector 10))
+ (ls (make-list 10))
+ (g (make-square-wave 2205))
+ (x 0.0))
+ (let ((g (make-square-wave 2205)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (float-vector-set! fv i (+ (square-wave g) (square-wave g x)))))
+ (let ((g (make-square-wave 2205)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (list-set! ls i (+ (square-wave g) (square-wave g x)))))
+ (list fv ls)))
+
+ (test (fv72) (list (float-vector 2.0 2.0 2.0 2.0 2.0 0.0 0.0 0.0 0.0 0.0)
+ (list 2.0 2.0 2.0 2.0 2.0 0.0 0.0 0.0 0.0 0.0)))
+
+ (define (fv73)
+ (let ((fv (make-float-vector 10))
+ (ls (make-list 10))
+ (g (make-square-wave 2205))
+ (x 0.5))
+ (let ((g (make-square-wave 2205)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (float-vector-set! fv i (+ (square-wave g) (square-wave g x)))))
+ (newline *stderr*)
+ (let ((g (make-square-wave 2205)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (list-set! ls i (+ (square-wave g) (square-wave g x)))))
+ (list fv ls)))
+
+ (test (fv73) (list (float-vector 2.0 2.0 2.0 0.0 0.0 0.0 2.0 2.0 2.0 0.0)
+ (list 2.0 2.0 2.0 0.0 0.0 0.0 2.0 2.0 2.0 0.0)))
+
+ (define (fv74)
+ (let ((fv (make-float-vector 4))
+ (g (make-r2k!cos 1000 :r 0.5 :k 3.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (r2k!cos g)))))
+ (test (fv74) (float-vector 0.008 0.01148666785741709 0.01717900881454179 0.02679348967895129))
+
+ (define (fv75)
+ (let ((fv (make-float-vector 4))
+ (g (make-r2k!cos 1000 :r 0.5 :k 3.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (r2k!cos g .1)))))
+ (test (fv75) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
+
+ (define (fv76)
+ (let ((fv (make-float-vector 4))
+ (g (make-r2k!cos 1000 :r 0.5 :k 3.0))
+ (x .1))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (r2k!cos g x)))))
+ (test (fv76) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
+
+ (define (fv77)
+ (let ((fv (make-float-vector 4))
+ (g (make-r2k!cos 1000 :r 0.5 :k 3.0))
+ (x (make-env '(0 .1 1 .1) :length 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (r2k!cos g (env x))))))
+ (test (fv77) (float-vector 0.008 0.01517028252035849 0.03244495213443228 0.07802652038780451))
+
+ (define (fv80) (let ((x 0.0)) (do ((i 0 (+ i 1))) ((= i 4) x) (set! x .1)))) (test (fv80) .1)
+ (define (fv81) (let ((x 0.0)) (do ((i 0 (+ i 1)) (y .1 .1)) ((= i 4) x) (set! x y)))) (test (fv81) .1)
+ (define (fv82) (let ((x 0.0) (y 0.1)) (do ((i 0 (+ i 1))) ((= i 4) x) (set! x y)))) (test (fv82) .1)
+ (define (fv83) (let ((x 0.0) (y 0.1)) (do ((i 0 (+ i 1))) ((= i 4) x) (set! x (+ x y))))) (test (fv83) .4)
+ (define (fv84) (let ((x 1.0)) (do ((i 0 (+ i 1))) ((= i 10) x) (set! x (+ x (* i 2.0)))))) (test (fv84) 91.0)
+
+ (define (fv85)
+ (let ((fv1 (make-float-vector 4 1.5))
+ (fv2 (make-float-vector 4 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) fv2)
+ (float-vector-add! fv2 fv1))))
+ (test (fv85) (make-float-vector 4 15.0))
-(defgenerator hiho310 (v #f :type string))
+ (define (fv86)
+ (let ((g0 (make-float-vector 4 1.0))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (set! (fv i) (g0 i)))))
+ (test (fv86) (float-vector 1.0 1.0 1.0 1.0))
+
+ (define (fv87)
+ (let ((fv1 (make-float-vector 4 1.5))
+ (fv2 (make-float-vector 4 0.0)))
+ (do ((i 0 (+ i 1))
+ (j 0 (+ j 1)))
+ ((= i 4) fv2)
+ (float-vector-add! fv2 fv1)
+ (float-vector-set! fv1 j 2.5))))
+ (test (fv87) (float-vector 9 8 7 6))
+
+ (define (fv88)
+ (let ((fv (make-float-vector 4))
+ (ifv (make-float-vector 1))
+ (g (make-file->frample "oboe.snd")))
+ (do ((i 0 (+ i 1))
+ (j 1000 (+ j 1)))
+ ((= i 4) fv)
+ (file->frample g j ifv)
+ (float-vector-set! fv i (ifv 0)))))
+ (test (fv88) (float-vector 0.0328369140625 0.0347900390625 0.0340576171875 0.031036376953125))
+
+ (define (fv89)
+ (let ((fv0 (make-float-vector 4))
+ (fv1 (make-float-vector 4))
+ (ifv (make-float-vector 2))
+ (g (make-file->frample "2.snd")))
+ (do ((i 0 (+ i 1))
+ (j 1000 (+ j 1)))
+ ((= i 4) (list fv0 fv1))
+ (file->frample g j ifv)
+ (float-vector-set! fv0 i (ifv 0))
+ (float-vector-set! fv1 i (ifv 1)))))
+ (test (fv89) (list (float-vector 0.002227783203125 0.00634765625 0.00787353515625 0.007293701171875)
+ (float-vector 0.004425048828125 0.012664794921875 0.015777587890625 0.014556884765625)))
+
+ (define (fv90)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 1.0 (+ x 0.5)))
+ ((= i 4) fv)
+ (set! (fv i) x))))
+ (test (fv90) (float-vector 1.0 1.5 2.0 2.5))
+
+ (define (fv91)
+ (let ((f1 (float-vector 1.0 2.0 3.0))
+ (f2 (float-vector 0.0 0.0 0.0))
+ (m1 (float-vector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0))
+ (f1-len 3)
+ (f2-len 3))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 2))) ; currently needed to trigger optimizer
+ ((= i 1) f2)
+ (frample->frample m1 f1 f1-len f2 f2-len))))
+ (test (fv91) (float-vector 30.0 36.0 42.0))
+
+ (define (fv92)
+ (let ((sf (make-frample->file "fmv.snd" 2 mus-lfloat mus-riff "this is a comment"))
+ (fv (float-vector .1 .2))
+ (fv1 (make-float-vector 4))
+ (fv2 (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 2)))
+ ((= i 4))
+ (frample->file sf i fv))
+ (mus-close sf)
+ (list (file->array "fmv.snd" 0 0 4 fv1)
+ (file->array "fmv.snd" 1 0 4 fv2))))
+ (let ((old-fudge (*s7* 'morally-equal-float-epsilon)))
+ (set! (*s7* 'morally-equal-float-epsilon) 1e-5)
+ (test (fv92) (list (make-float-vector 4 .1) (make-float-vector 4 .2)))
+ (set! (*s7* 'morally-equal-float-epsilon) old-fudge))
+
+ (define (fv93)
+ (let ((sf (make-frample->file "fmv.snd" 2 mus-lfloat mus-riff "this is a comment"))
+ (fv (float-vector .01 .02))
+ (fv1 (make-float-vector 4))
+ (fv2 (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 2)))
+ ((= i 4))
+ (frample->file sf i (float-vector-add! fv fv)))
+ (mus-close sf)
+ (list (file->array "fmv.snd" 0 0 4 fv1)
+ (file->array "fmv.snd" 1 0 4 fv2))))
+ (let ((old-fudge (*s7* 'morally-equal-float-epsilon)))
+ (set! (*s7* 'morally-equal-float-epsilon) 1e-5)
+ (test (fv93) (list (float-vector .02 .04 .08 .16)
+ (float-vector .04 .08 .16 .32)))
+ (set! (*s7* 'morally-equal-float-epsilon) old-fudge))
+
+ (define (fv94)
+ (let ((fv0 (float-vector 0 1 2 3 4 5))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0.4 (+ x 0.7)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (float-vector-ref fv0 (floor x))))))
+ (test (fv94) (float-vector 0.0 1.0 1.0 2.0))
+
+ (define (fv94a)
+ (let ((fv0 (float-vector 0 1 2 3 4 5))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0.4 (+ x 0.7)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (float-vector-ref fv0 (ceiling x))))))
+ (test (fv94a) (float-vector 1.0 2.0 2.0 3.0))
+
+ (define (fv95)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (even? i)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv95) (float-vector 10.0 -9.0 12.0 -7.0))
+
+ (define (fv95a)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (odd? i)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv95a) (float-vector -10.0 11.0 -8.0 13.0))
+
+ (define (fv95b)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (not (odd? i))
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv95b) (float-vector 10.0 -9.0 12.0 -7.0))
+
+ (define (fv96)
+ (let ((fv (make-float-vector 4))
+ (fv1 (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) (list fv fv1))
+ (float-vector-set! fv1 i 3.0)
+ (if (even? i)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0)))
+ (float-vector-set! fv1 i (+ (float-vector-ref fv1 i) 1.0)))))
+ (test (fv96) (list (float-vector 10.0 -9.0 12.0 -7.0)
+ (float-vector 4.0 4.0 4.0 4.0)))
+
+ (define (fv97)
+ (let ((fv (make-float-vector 4))
+ (j 0))
+ (do ((i 0 (+ i 1))
+ (x 0.4 (+ x 0.7)))
+ ((= i 4) fv)
+ (set! j (floor x))
+ (float-vector-set! fv i (* j 2.0)))))
+ (test (fv97) (float-vector 0.0 2.0 2.0 4.0))
+
+ (define (fv98)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((not (= i 0)) fv)
+ (set! i (* i 0.5))
+ (set! (fv i) x))))
+ (test (catch #t
+ fv98
+ (lambda args
+ (apply format #f (cadr args)))) "vector-set!: index must be an integer: ((fv i) x)")
+
+ (define (fv99)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (zero? i)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv99) (float-vector 10.0 -9.0 -8.0 -7.0))
+
+ (define (fv100)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (zero? (modulo i 2))
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv100) (float-vector 10.0 -9.0 12.0 -7.0))
+
+ (define (fv101)
+ (let ((fv (make-float-vector 4))
+ (ctr 0))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) ctr)
+ (if (zero? (modulo i 2))
+ (set! ctr (+ ctr 1))))))
+ (test (fv101) 2)
+
+ (define (fv103)
+ (let ((fv (make-float-vector 100))
+ (n 100))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (do ((j 0 (+ j 1))
+ (k i (+ k 1)))
+ ((= j n))
+ (float-vector-set! fv i (+ (float-vector-ref fv i) 1.0))))))
+ (fv103) ; just run without overflow
+
+ (define (fv104)
+ (let ((fv (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) fv)
+ (do ((j 0 (+ j 1))) ((= j i))
+ (float-vector-set! fv i (+ (float-vector-ref fv j) 1.0))))))
+ (test (fv104) (float-vector 0 1 2 3 4 5 6 7 8 9))
+
+ (define (fv104)
+ (let ((fv (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) fv)
+ (do ((j 0 (+ j 1))) ((= j i))
+ (float-vector-set! fv i (+ (float-vector-ref fv j) 1.0))))))
+ (test (fv104) (float-vector 0 1 2 3 4 5 6 7 8 9))
+
+ (when all-args
+ (define (do-permute init step end)
+ (let ((body (copy `(let ()
+ (define (t1)
+ (let ((fv (make-float-vector 4)))
+ (if (<= ,step 0) (error 'out-of-range "step > 0"))
+ (do ((i ,init (+ i ,step))
+ (x 1.0 (+ x 1.0)))
+ ((>= i ,end) fv)
+ (float-vector-set! fv i x))))
+ (define (t2)
+ (let ((fv (make-float-vector 4)))
+ (if (<= ,step 0) (error 'out-of-range "step > 0"))
+ (do ((i ,init (+ i ,step))
+ (x 1.0 (+ x 1.0)))
+ ((>= i ,end) fv)
+ (float-vector-set! fv i x))))
+ (let ((v1 (catch #t t1 (lambda args 'error)))
+ (v2 (catch #t (lambda () (copy (t2) (make-float-vector 4))) (lambda args 'error))))
+ (if (not (morally-equal? v1 v2))
+ (format *stderr* "~D: permute ~A, ~A -> ~A ~A, ~A~%" #__line__ op args v1 v2 (float-vector-peak (float-vector-subtract! v1 v2))))))
+ :readable)))
+ (eval body)))
+
+ (set! (*s7* 'morally-equal-float-epsilon) 1e-12)
+
+ (for-each-subset
+ (lambda (a b c)
+ (for-each-permutation
+ do-permute
+ (list a b c)))
+ (list 0 4 1 2 0.0 4.0 1.0 2.0 1/2 1+i 2/3 #\a "hi" #f)))
+
+ (define (fv107)
+ (let ((g0 (make-hash-table)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 10.0)))
+ ((= i 4) g0)
+ (hash-table-set! g0 i x))))
+ (test (fv107) (hash-table* 0 0.0 1 10.0 2 20.0 3 30.0))
+
+ (define (fv108)
+ (let ((fv (make-float-vector 10)))
+ (let ((locs (make-locsig :output fv))
+ (k 0))
+ (do ((i 0 (- i 1)))
+ ((= i -10) fv)
+ (set! k (abs i))
+ (locsig locs k (* .1 i))))))
+ (test (fv108) (float-vector 0 -.1 -.2 -.3 -.4 -.5 -.6 -.7 -.8 -.9))
+
+ (define (fv109)
+ (let ((fv (make-float-vector 10)))
+ (let ((locs (make-locsig :output fv))
+ (k 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) fv)
+ (locsig locs k (* .1 i))
+ (set! k (+ k 1))))))
+ (test (fv109) (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
+
+ (define (fv110)
+ (let ((fv (make-float-vector 10))
+ (k 0))
+ (set! *output* fv)
+ (do ((i 0 (+ i 1)))
+ ((= i 10) fv)
+ (outa k (* .1 i))
+ (set! k (+ k 1)))))
+ (test (fv110) (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
+
+ (define (fv111)
+ (let ((fv (make-float-vector 10))
+ (k 0))
+ (set! *output* fv)
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((= i 10) fv)
+ (outa k x)
+ (set! k (+ k 1)))))
+ (test (fv111) (float-vector 0 .1 .2 .3 .4 .5 .6 .7 .8 .9))
+
+ (define (fv112)
+ (let ((fv (make-float-vector 10))
+ (k 0))
+ (set! *output* fv)
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((= i 10) fv)
+ (outa k x)
+ (set! k (+ k 1.2)))))
+ (test (catch #t fv112 (lambda args 'error)) 'error)
+
+ (define (fv113)
+ (let ((fv (make-float-vector 10)))
+ (let ((locs (make-locsig :output fv))
+ (k 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) fv)
+ (locsig locs k (* .1 i))
+ (set! k (+ k 1.2))))))
+ (test (catch #t fv113 (lambda args 'error)) 'error)
+
+ (define (fv114)
+ (let ((fv (make-float-vector 10000))
+ (k 0)
+ (x 1.2))
+ (set! *output* fv)
+ (do ((i 0 (+ i 1)))
+ ((= i 10000) fv)
+ (outa k (* .001 i))
+ (set! k (+ k x)))))
+ (test (catch #t fv114 (lambda args 'error)) 'error)
+
+ (define (fv115)
+ (let ((g0 (make-float-vector 4 1.0))
+ (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((x (g0 i)))
+ (set! (fv i) x)))))
+ (test (fv115) (float-vector 1.0 1.0 1.0 1.0))
+
+ (define (fv116)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 100)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (oscil? g)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv116) (float-vector 10.0 11.0 12.0 13.0))
+
+ (define (fv117)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (even? (round i))
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv117) (float-vector 10.0 -9.0 12.0 -7.0))
+
+ (define (fv118)
+ (let ((fv (make-float-vector 4))
+ (lst '(1 2 3)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (even? (car lst))
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv118) (float-vector -10.0 -9.0 -8.0 -7.0))
+
+ (define (fv119)
+ (let ((fv (make-float-vector 4))
+ (lst '(1 2 3)))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (eqv? i (car lst))
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv119) (float-vector -10.0 11.0 -8.0 -7.0))
+
+ (define (fv120)
+ (let ((fv (make-float-vector 4))
+ (j 2))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (= i j)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv120) (float-vector -10.0 -9.0 12.0 -7.0))
+
+ (define (fv121)
+ (let ((fv (make-float-vector 4))
+ (j 2))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (< i j)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv121) (float-vector 10.0 11.0 -8.0 -7.0))
+
+ (define (fv122)
+ (let ((fv (make-float-vector 4))
+ (j 2))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (<= i j)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv122) (float-vector 10.0 11.0 12.0 -7.0))
+
+ (define (fv123)
+ (let ((fv (make-float-vector 4))
+ (j 2))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (>= i j)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv123) (float-vector -10.0 -9.0 12.0 13.0))
+
+ (define (fv124)
+ (let ((fv (make-float-vector 4))
+ (j 2))
+ (do ((i 0 (+ i 1))
+ (x 0 (+ x 1)))
+ ((= i 4) fv)
+ (if (> i j)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv124) (float-vector -10.0 -9.0 -8.0 13.0))
+
+ (define (fv125)
+ (let ((gen (make-delay 5)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (float-vector-set! (mus-data gen) i 0.3))
+ (let ((fv (make-float-vector 5)))
+ (do ((i 0 (+ i 1)))
+ ((= i 5) fv)
+ (float-vector-set! fv i (float-vector-ref (mus-data gen) i))))))
+ (test (fv125) (float-vector 0.3 0.3 0.3 0.0 0.0))
+
+ (define (fv126)
+ (let ((d0 (float-vector 1 0 -1 0 1 0 -1 0))
+ (d1 (float-vector 0 1 0 -1 0 1 0 -1))
+ (e0 (float-vector 0 0 8 0 0 0 0 0))
+ (e1 (float-vector 0 0 0 0 0 0 0 0))
+ (rl (make-float-vector 8))
+ (im (make-float-vector 8)))
+ (set! (rl 2) 1.0)
+ (mus-fft rl im 8 1)
+ (if (or (not (morally-equal? d0 rl))
+ (not (morally-equal? d1 im)))
+ (format *stderr* ";fv126 mus-fft 0: ~A ~A~%" rl im))
+ (mus-fft rl im 8 -1)
+ (if (or (not (morally-equal? e0 rl))
+ (not (morally-equal? e1 im)))
+ (format *stderr* ";fv126 mus-fft 1: ~A ~A~%" rl im))
+ (set! (rl 2) 1.0)
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (mus-fft rl im))
+ (if (or (not (morally-equal? d0 rl))
+ (not (morally-equal? d1 im)))
+ (format *stderr* ";fv126 mus-fft 2: ~A ~A~%" rl im))
+ (let ((loc 2)
+ (val 1.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 1))
+ (mus-fft rl im 8 -1)
+ (float-vector-set! rl loc val)
+ (mus-fft rl im 8))
+ (if (or (not (morally-equal? d0 rl))
+ (not (morally-equal? d1 im)))
+ (format *stderr* ";fv126 mus-fft 2: ~A ~A~%" rl im)))))
+ (fv126)
+
+ (define (fv127)
+ (let ((fv (make-float-vector 4))
+ (j 2))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (if (or (> i j)
+ (= i 3))
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv127) (float-vector -10.0 -9.0 -8.0 13.0))
+
+ (define (fv128)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (if (or (= i 1)
+ (= i 3))
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv128) (float-vector -10.0 11.0 -8.0 13.0))
+
+ (define (fv129)
+ (let ((fv (make-float-vector 4))
+ (j 2))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (if (and (= i j)
+ (< i 3))
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv129) (float-vector -10.0 -9.0 12.0 -7.0))
+
+ (define (fv130)
+ (let ((fv (make-float-vector 4))
+ (j #\a))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (if (char=? j #\a)
+ (float-vector-set! fv i (+ i 10.0))
+ (float-vector-set! fv i (- i 10.0))))))
+ (test (fv130) (float-vector 10.0 11.0 12.0 13.0))
+
+ (define (char-permute op . args)
+ (let ((body (copy `(let ()
+ (define (t1)
+ (let ((x #\a) (y #\A) (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x1 1.0 (+ x1 1.0)))
+ ((= i 4) fv)
+ (if (,op , at args)
+ (float-vector-set! fv i x1)
+ (float-vector-set! fv i 0.0)))))
+ (define (t2)
+ (let ((x #\a) (y #\A) (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x1 1.0 (+ x1 1.0)))
+ ((= i 4) fv)
+ (if (apply ,op (list , at args))
+ (float-vector-set! fv i x1)
+ (float-vector-set! fv i 0.0)))))
+ (let ((v1 (t1))
+ (v2 (t2)))
+ (if (not (morally-equal? v1 v2))
+ (format *stderr* "char-permute ~A, ~A -> ~A ~A~%" op args v1 v2))))
+ :readable)))
+ (eval body)))
+
+ (for-each
+ (lambda (op)
+ (for-each-subset
+ (lambda s-args
+ (if (= (length s-args) 2)
+ (for-each-permutation
+ (lambda args
+ (apply char-permute op args))
+ s-args)))
+ (list 'x 'y #\b #\newline)))
+ (if (provided? 'pure-s7)
+ (list 'char=? 'char<? 'char<=? 'char>? 'char>=?)
+ (list 'char=? 'char<? 'char<=? 'char>? 'char>=? 'char-ci=? 'char-ci<? 'char-ci<=? 'char-ci>? 'char-ci>=?)))
+
+ (define (string-permute op . args)
+ (let ((body (copy `(let ()
+ (define (t1)
+ (let ((x "a") (y "A") (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x1 1.0 (+ x1 1.0)))
+ ((= i 4) fv)
+ (if (,op , at args)
+ (float-vector-set! fv i x1)
+ (float-vector-set! fv i 0.0)))))
+ (define (t2)
+ (let ((x "a") (y "A") (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x1 1.0 (+ x1 1.0)))
+ ((= i 4) fv)
+ (if (apply ,op (list , at args))
+ (float-vector-set! fv i x1)
+ (float-vector-set! fv i 0.0)))))
+ (let ((v1 (t1))
+ (v2 (t2)))
+ (if (not (morally-equal? v1 v2))
+ (format *stderr* "string-permute ~A, ~A -> ~A ~A~%" op args v1 v2))))
+ :readable)))
+ (eval body)))
+
+ (for-each
+ (lambda (op)
+ (for-each-subset
+ (lambda s-args
+ (if (= (length s-args) 2)
+ (for-each-permutation
+ (lambda args
+ (apply string-permute op args))
+ s-args)))
+ (list 'x 'y "ab" "b")))
+ (if (provided? 'pure-s7)
+ (list 'string=? 'string<? 'string<=? 'string>? 'string>=?)
+ (list 'string=? 'string<? 'string<=? 'string>? 'string>=? 'string-ci=? 'string-ci<? 'string-ci<=? 'string-ci>? 'string-ci>=?)))
+
+ (unless (provided? 'pure-s7)
+ (define (fv131)
+ (let ((fv1 (make-float-vector 10))
+ (fv2 #f)
+ (coeffs (float-vector 0.0 0.5 0.25 0.125)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((= i 10))
+ (float-vector-set! fv1 i (mus-chebyshev-t-sum x coeffs)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1))
+ (lst ()))
+ ((= i 10)
+ (set! fv2 (list->vector (reverse lst))))
+ (set! lst (cons (mus-chebyshev-t-sum x coeffs) lst)))
+ (if (not (morally-equal? fv1 fv2))
+ (format *stderr* ";t-sum: ~A ~A~%" fv1 fv2))))
+ (fv131)
+
+ (define (fv132)
+ (let ((fv1 (make-float-vector 10))
+ (fv2 #f)
+ (t-coeffs (float-vector 0.0 0.5 0.25 0.125))
+ (u-coeffs (float-vector 0.0 0.2 0.1 0.05)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1)))
+ ((= i 10))
+ (float-vector-set! fv1 i (mus-chebyshev-tu-sum x t-coeffs u-coeffs)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.1))
+ (lst ()))
+ ((= i 10)
+ (set! fv2 (list->vector (reverse lst))))
+ (set! lst (cons (mus-chebyshev-tu-sum x t-coeffs u-coeffs) lst)))
+ (if (not (morally-equal? fv1 fv2))
+ (format *stderr* ";tu-sum: ~A ~A~%" fv1 fv2))))
+ (fv132))
+
+ (define (fv132a)
+ (let ((fv (make-float-vector 10)))
+ (let ((o1 (make-oscil 1000))
+ (o2 (make-oscil 1000))
+ (s1 (make-sawtooth-wave 1000))
+ (s2 (make-sawtooth-wave 1000))
+ (s3 (make-sawtooth-wave 1000))
+ (s4 (make-sawtooth-wave 1000))
+ (t1 (make-triangle-wave 1000))
+ (t2 (make-triangle-wave 1000))
+ (p1 (make-polywave 1000 '(1 .4 2 .6)))
+ (p2 (make-polywave 1000 '(1 .4 2 .6)))
+ (p3 (make-polywave 1000 '(1 .4 2 .6)))
+ (p4 (make-polywave 1000 '(1 .4 2 .6))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10) fv)
+ (set! (fv i)
+ (if (even? i)
+ (+ (oscil o1)
+ (* (triangle-wave t1)
+ (if (zero? (modulo i 2))
+ (polywave p1)
+ (polywave p2)))
+ (if (odd? i)
+ (sawtooth-wave s1)
+ (sawtooth-wave s2)))
+ (+ (oscil o2)
+ (* (triangle-wave t2)
+ (if (zero? (modulo i 2))
+ (polywave p3)
+ (polywave p4)))
+ (if (odd? i)
+ (sawtooth-wave s3)
+ (sawtooth-wave s4)))))))))
+
+ (test (fv132a) (float-vector 0.0 0.0 0.2754865742400099 0.2754865742400099 0.5330915108442034 0.5330915108442034
+ 0.7567925994733748 0.7567925994733748 0.9340879688376413 0.9340879688376413))
+
+ (define (fv133)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ ((lambda ()
+ (set! (fv i) i))))))
+ (test (fv133) (float-vector 0.0 1.0 2.0 3.0))
+
+ (define (fv134)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (let ((y 1.0))
+ ((lambda ()
+ (set! (fv i) i)))))))
+ (test (fv134) (float-vector 0.0 1.0 2.0 3.0))
+
+ (define (fv135)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 1.0)))
+ ((= i 4) fv)
+ ((lambda ()
+ (set! (fv i) i))))))
+ (test (fv135) (float-vector 0.0 1.0 2.0 3.0))
+
+ (define (fv136)
+ (let ((fv (make-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 1.0)))
+ ((= i 4) fv)
+ (vector-set! fv i (cons i x)))))
+ (test (fv136) (vector '(0 . 0.0) '(1 . 1.0) '(2 . 2.0) '(3 . 3.0)))
+
+ (define (fv137)
+ (let ((fv (make-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.6)))
+ ((= i 4) fv)
+ (vector-set! fv i (asin x)))))
+ (test (fv137) (vector (asin 0.0) (asin 0.6) (asin 1.2) (asin 1.8)))
+
+ (define (fv138)
+ (let ((fv (make-vector 4))
+ (fv1 (vector 0.0 0.6 1.2 1.8)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.6)))
+ ((= i 4) fv)
+ (vector-set! fv i (asin (vector-ref fv1 i))))))
+ (test (fv138) (vector (asin 0.0) (asin 0.6) (asin 1.2) (asin 1.8)))
+
+ (define (fv138a)
+ (let ((fv (make-vector 4))
+ (fv1 (vector 0.0 0.6 1.2 1.8)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.6)))
+ ((= i 4) fv)
+ (vector-set! fv i (asin (floor i))))))
+ (test (fv138a) (vector (asin 0) (asin 1) (asin 2) (asin 3)))
+
+ (define (fv138b)
+ (let ((fv (make-vector 4))
+ (fv1 (vector 0.0 0.6 1.2 1.8)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.6)))
+ ((= i 4) fv)
+ (vector-set! fv i (asin (complex x i))))))
+ (test (fv138b) (vector (asin 0.0) (asin 0.6+i) (asin 1.2+2i) (asin 1.8+3i)))
+
+ (define (fv139)
+ (with-output-to-string
+ (lambda ()
+ (do ((i 80 (+ i 1)))
+ ((= i 84))
+ (write-char (integer->char i))))))
+ (test (fv139) "PQRS")
+
+ (define (fv140)
+ (with-output-to-string
+ (lambda ()
+ (do ((i 80 (+ i 1)))
+ ((= i 84))
+ (write-byte i)))))
+ (test (fv140) "PQRS")
+
+ (define (fv141)
+ (let ((g0 (make-hash-table))
+ (v (vector 0 1 2 3 4 5)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 10.0)))
+ ((= i 4) g0)
+ (hash-table-set! g0 (vector-ref v i) x))))
+ (test (fv141) (hash-table* 0 0.0 1 10.0 2 20.0 3 30.0))
+
+ (define (fv142)
+ (let ((g0 (make-hash-table)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 10.0)))
+ ((= i 4) g0)
+ (hash-table-set! g0 i (list x)))))
+ (test (fv142) (hash-table* 0 '(0.0) 1 '(10.0) 2 '(20.0) 3 '(30.0)))
+
+ (define (fv143)
+ (let ((g0 (make-hash-table))
+ (v (vector 0 1 2 3 4 5)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 10.0)))
+ ((= i 4) g0)
+ (hash-table-set! g0 (vector-ref v i) (list x)))))
+ (test (fv143) (hash-table* 0 '(0.0) 1 '(10.0) 2 '(20.0) 3 '(30.0)))
+
+ (define (fv144)
+ (let ((g0 (make-iterator (list 0 1 2 3 4)))
+ (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (iterate g0)))))
+ (test (fv144) (vector 0 1 2 3))
+
+ (define (fv145)
+ (let ((g0 (list (make-iterator (list 0 1 2 3 4))))
+ (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (iterate (car g0))))))
+ (test (fv145) (vector 0 1 2 3))
-(defgenerator hiho311 (v #f :type sound-data))
+ (define (fv146)
+ (let ((x 0))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) x)
+ (do ((k 0 (+ k 1)))
+ ((= k 4))
+ (set! x (+ x k))))))
+ (test (fv146) 24)
+
+ (define (fv147a)
+ (let ((x 0)
+ (lst '(1 2 3)))
+ (for-each
+ (lambda (y)
+ (if (= x y) (display "fv147 oops")))
+ lst)))
+ (test (fv147a) #<unspecified>)
+
+ (define (fv147b)
+ (let ((s "012345")
+ (lst '(1 2 3)))
+ (map
+ (lambda (y)
+ (string-ref s y))
+ lst)))
+ (test (fv147b) '(#\1 #\2 #\3))
-(defgenerator abc232 (x 0.0))
-(defgenerator abd232 (x 1.0))
+ (define (fv147c)
+ (let ((lst '(1 2 3)))
+ (map
+ (lambda (y)
+ (* y 2.0))
+ lst)))
+ (test (fv147c) '(2.0 4.0 6.0))
-(define (abc232-func gen)
- (declare (gen abc232))
- (abc232-x gen))
+ (define (fv148)
+ (let ((g0 (list 0 1 2 3 4))
+ (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 i)))))
+ (test (fv148) (vector 0 1 2 3))
+
+ (define (fv149)
+ (let ((g0 "012345")
+ (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 i)))))
+ (test (fv149) (vector #\0 #\1 #\2 #\3))
+
+ (define (fv150)
+ (let ((g0 (int-vector 0 1 2 3 4))
+ (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 i)))))
+ (test (fv150) (vector 0 1 2 3))
+
+ (define (fv151)
+ (let ((g0 (float-vector 0 1 2 3 4))
+ (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 i)))))
+ (test (fv151) (vector 0 1 2 3))
+
+ (define (fv152)
+ (let ((g0 (inlet 'a 0 'b 1 'c 2 'd 3))
+ (syms (vector 'a 'b 'c 'd))
+ (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (g0 (syms i))))))
+ (test (fv152) (vector 0 1 2 3))
-(define (abd232-func gen)
- (declare (gen abd232))
- (abd232-x gen))
+ (define (fv153)
+ (let ((g0 (list 0 1 2 3 4))
+ (v (make-list 4 #f)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v i) (g0 i)))))
+ (test (fv153) (list 0 1 2 3))
+
+ (define (fv154)
+ (let ((g0 "012345")
+ (v (make-string 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v i) (g0 i)))))
+ (test (fv154) "0123")
+
+ (define (fv155)
+ (let ((g0 (int-vector 0 1 2 3 4))
+ (v (make-int-vector 4 -1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v i) (g0 i)))))
+ (test (fv155) (int-vector 0 1 2 3))
+
+ (define (fv156)
+ (let ((g0 (float-vector 0 1 2 3 4))
+ (v (make-float-vector 4 pi)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v i) (g0 i)))))
+ (test (fv156) (float-vector 0 1 2 3))
+
+ (define (fv157)
+ (let ((g0 (inlet 'a 0 'b 1 'c 2 'd 3))
+ (syms (vector 'a 'b 'c 'd))
+ (v (inlet 'a -1 'b -1 'c -1 'd -1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v (syms i)) (g0 (syms i))))))
+ (test (fv157) (inlet 'a 0 'b 1 'c 2 'd 3))
+
+ (define (fv158)
+ (let ((g0 (hash-table* 'a 0 'b 1 'c 2 'd 3))
+ (syms (vector 'a 'b 'c 'd))
+ (v (hash-table* 'a -1 'b -1 'c -1 'd -1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (set! (v (syms i)) (g0 (syms i))))))
+ (test (fv158) (hash-table* 'a 0 'b 1 'c 2 'd 3))
+
+ (define (fv159)
+ (let ((o (make-oscil 1000))
+ (oscs (vector (make-oscil 400) (make-oscil 500) (make-oscil 600)))
+ (v1 (make-float-vector 10))
+ (v2 (make-float-vector 10))
+ (v3 (float-vector 0.1419943179576268 1.008255926858552 -0.3982998307862416 -0.4953385977530639
+ 1.122094083214508 0.6986797544826313 -0.5752063448650614 0.5489621715396582
+ 1.499234145268148 0.1194943083560847))
+ (k 1))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (let ((x (oscil o)))
+ (set! (v1 i) (+ (oscil (vector-ref oscs k)) (oscil o 1.5)))))
+ (set! o (make-oscil 1000))
+ (set! oscs (vector (make-oscil 400) (make-oscil 500) (make-oscil 600)))
+ (set! (v2 0) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 1) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 2) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 3) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 4) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 5) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 6) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 7) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 8) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (set! (v2 9) ((lambda () (let ((x (oscil o))) (+ (oscil (vector-ref oscs k)) (oscil o 1.5))))))
+ (if (or (not (morally-equal? v1 v2))
+ (not (morally-equal? v1 v3)))
+ (format *stderr* "~A~%~A~%~A~%" v1 v2 v3))))
+ (fv159)
+
+ (define (fv160)
+ (let ((fv (make-float-vector 4))
+ (g (make-oscil 1000)))
+ (do ((i 0 (+ i 1))
+ (x 0.1 0.0))
+ ((= i 4) fv)
+ (float-vector-set! fv i (oscil g x)))))
+
+ (test (fv160) (let ((g (make-oscil 1000))) (float-vector (oscil g 0.1) (oscil g) (oscil g) (oscil g))))
+#|
+ (define (fv161)
+ (let ((log2 (*libm* 'log2)))
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (set! (fv i) (log2 2.5))))))
+ (test (fv161) (float-vector (log 2.5 2) (log 2.5 2) (log 2.5 2) (log 2.5 2)))
+|#
+ (define (fv162)
+ (let ((fv (make-int-vector 4))
+ (iter (make-iterator (list 1 2 3 4))))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (int-vector-set! fv i (iterate iter)))))
+ (test (fv162) (int-vector 1 2 3 4))
+ (define (fv163)
+ (let ((fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x 0.25)))
+ ((= i 4) fv)
+ (set! (fv i) (sin x)))))
+ (test (fv163) (float-vector (sin 0.0) (sin 0.25) (sin 0.5) (sin 0.75)))
-(define (snd_test_22)
-
- (define (test-run-protection-release)
- (let ((this-oscil-protected-by-run (make-oscil 1234.567))
- (this-window-protected-by-run (make-fft-window rectangular-window 16)))
- (* (vct-ref this-window-protected-by-run 8)
- (oscil this-oscil-protected-by-run))))
-
- (define (make-osc frq)
- (run
- (make-oscil frq)))
-
- (define (make-fc scl size)
- (run
- (make-filtered-comb scl size :filter (make-one-zero .4 .6))))
-
- (definstrument (test-set-gens)
- (let ((cs (make-ncos 440.0 5))
- (ss (make-nsin 440.0 5))
- (sq (make-square-wave 44.0))
- (en (make-env '(0 0 1 1) :base .3 :length 11))
- (fl (make-fir-filter 4 (vct .5 .5 .5 .5)))
- (dl (make-delay 32))
- (ap (make-all-pass .4 .6 32))
- (av (make-moving-average 4))
- (sr (make-src :srate .5))
- (gr (make-granulate :expansion 2.0))
- (sb (make-ssb-am 440.0))
- )
- (run
- (set! (mus-length cs) 3)
- (if (not (= (mus-length cs) 3)) (display ";cosines messed up"))
- (set! (mus-length cs) 32)
- (if (not (= (mus-length cs) 32)) (display ";length messed up"))
- (set! (mus-frequency cs) 100.0)
- (if (fneq (mus-frequency cs) 100.0) (display ";frequency messed up"))
- (set! (mus-phase cs) 2.0)
- (if (fneq (mus-phase cs) 2.0) (display ";phase messed up"))
- (set! (mus-scaler cs) .5)
- (if (fneq (mus-scaler cs) .5) (display ";scaler messed up"))
- (set! (mus-width sq) .123)
- (if (fneq (mus-width sq) .123) (display ";width messed up"))
- (set! (mus-location en) 3)
- (if (not (= (mus-location en) 3)) (display ";location messed up"))
- (set! (mus-length dl) 24)
- (if (not (= (mus-length dl) 24)) (display ";dl length messed up"))
- (set! (mus-feedback ap) .5)
- (if (fneq (mus-feedback ap) .5) (display ";feedback messed up"))
- (set! (mus-feedforward ap) .5)
- (if (fneq (mus-feedforward ap) .5) (display ";feedforward messed up"))
- (set! (mus-increment sr) .3)
- (if (fneq (mus-increment sr) .3) (display ";sr increment messed up"))
- (set! (mus-frequency gr) .05)
- (if (fneq (mus-frequency gr) .05) (display ";gr frequency messed up"))
- (set! (mus-scaler gr) .05)
- (if (fneq (mus-scaler gr) .05) (display ";gr scaler messed up"))
- (set! (mus-increment gr) .5)
- (if (fneq (mus-increment gr) .5) (display ";gr increment messed up"))
- (set! (mus-ramp gr) 1234)
- (if (not (= (mus-ramp gr) 1234)) (display ";gr ramp messed up"))
- (set! (mus-hop gr) 1234)
- (if (not (= (mus-hop gr) 1234)) (display ";gr hop messed up"))
- (set! (mus-length gr) 1234)
- (if (not (= (mus-length gr) 1234)) (display ";gr length messed up"))
- (if (fneq (mus-frequency sb) 440.0) (display ";sb freq?"))
- (set! (mus-frequency sb) 220.0)
- (if (fneq (mus-frequency sb) 220.0) (display ";sb freq messed up"))
- )))
-
- (define (make-linear-src sr)
- (vct 0.0 sr 0.0 0.0)) ; position sr last next
-
- (define (linear-src gen input)
- (let ((pos (vct-ref gen 0)))
- (if (>= pos 1.0)
- (begin
- (if (< pos 2.0)
- (begin
- (vct-set! gen 2 (vct-ref gen 3))
- (vct-set! gen 3 (input))
- (set! pos (- 1.0 (vct-ref gen 0))))
- (let ((num (floor pos)))
- (do ((i 0 (+ 1 i)))
- ((= i num))
- (vct-set! gen 2 (vct-ref gen 3))
- (vct-set! gen 3 (input)))
- (set! pos (- pos num))))
- (vct-set! gen 0 pos)))
- (vct-set! gen 0 (+ pos (vct-ref gen 1)))
- (let ((lo (vct-ref gen 2)))
- (+ lo (* pos (- (vct-ref gen 3) lo))))))
-
-
- (define (itst form result)
- (let ((val (run-eval form)))
- (if (not (eqv? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (itsta form arg result)
- (let ((val (run-eval form arg)))
- (if (not (eqv? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (fitst form result)
- (let ((val (run-eval form)))
- (if (not (= val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (fitsta form arg result)
- (let ((val (run-eval form arg)))
- (if (not (= val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (btst form result)
- (let ((val (run-eval form)))
- (if (not (eq? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (btsta form arg result)
- (let ((val (run-eval form arg)))
- (if (not (eq? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (ftst form result)
- (let ((val (run-eval form)))
- (if (fneq val result) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (ftsta form arg result)
- (let ((val (run-eval form arg)))
- (if (fneq val result) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (etst form)
- (let ((tag (catch #t (lambda () (run-eval form)) (lambda args args))))
- (if (or (not (pair? tag))
- (not (eq? (car tag) 'cannot-parse)))
- (snd-display #__line__ ";~A -> ~A?" form tag))))
-
- (define (etsta form arg)
- (let ((tag (catch #t (lambda () (run-eval form arg)) (lambda args args))))
- (if (or (not (pair? tag))
- (and (not (eq? (car tag) 'cannot-parse))
- (not (eq? (car tag) 'wrong-type-arg))))
- (snd-display #__line__ ";~A -> ~A?" form tag))))
-
- (define (ctst form result)
- (let ((val (run-eval form)))
- (if (not (char=? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (ctsta form arg result)
- (let ((val (run-eval form arg)))
- (if (not (char=? val result)) (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (stst form result)
- (catch 'cannot-parse
- (lambda ()
- (let ((val (run-eval form)))
- (if (or (not (string? val))
- (not (string=? val result)))
- (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
- (lambda args
- (snd-display #__line__ ";stst ~A: unparsable" form))))
-
- (define (ststa form arg result)
- (let ((val (run-eval form arg)))
- (if (or (not (string? val))
- (not (string=? val result)))
- (snd-display #__line__ ";~A -> ~A (~A)" form val result))))
-
- (define (t22-i->i arg) (+ arg 32))
- (define (t22-i->b arg) (= arg 3))
- (define (t22-i->f arg) (* arg 2.0))
- (define (t22-i->s arg) (if (= arg 3) "yes" "no"))
- (define (t22-i->c arg) (integer->char (+ arg 70)))
- (define (t22-i->k arg) (if (= arg 3) :yes :no))
- (define (t22-i->sym arg) (if (= arg 3) 'yes 'no))
- (define (t22-i->clm arg) (make-oscil arg))
- (define (t22-i2->i arg) (+ arg (t22-i->i arg)))
- (define (t22-i-f->f arg1 arg2) (+ arg1 arg2))
- (define (t22-iv-i-i->iv arg1 arg2 arg3) (vector-set! arg1 arg2 arg3) arg1)
- (define (t22-fv-i-f->fv arg1 arg2 arg3) (vector-set! arg1 arg2 arg3) arg1)
- (define (t22-s->c arg) (string-ref arg 1))
- (define (t22-sd->f arg) (sound-data-ref arg 1 1))
- (define (t22-sd->sd arg) (sound-data-set! arg 1 1 44.0) arg)
- (define (t22-clm->i arg) (mus-order arg))
- (define (t22-vct->vct arg) (vct-set! arg 1 44.0) arg)
- (define (t22-cv->f arg) (mus-frequency (vector-ref arg 1)))
-
-
- (set! (optimization) 6)
-
- (do ((run-test 0 (+ 1 run-test))) ((= run-test tests))
-
- (log-mem run-test)
-
- (set! unique-float 3.0)
- (set! unique-int 3)
- (set! unique-char #\c)
- (set! unique-string "hiho")
- (set! unique-float-vector (make-vector 3 1.0))
- (set! unique-int-vector (make-vector 3 1))
- (set! unique-generator (make-oscil))
- (set! unique-list (list 1 (make-oscil)))
- (set! unique-symbol 'hiho)
- (set! unique-keyword :hiho)
- (set! unique-clm-vector (make-vector 3 #f))
- (set! unique-boolean #t)
- (set! unique-vct-vector (make-vector 3 #f))
- (set! int-var 32)
- (set! dbl-var 3.14)
- (set! bool-var #t)
- (set! lst-var '(0 1 2))
- (set! biggie (expt 2 31))
- (set! str-var "hi")
- (set! cont1 #f)
- (set! cont2 #f)
- (set! gv 1)
- (set! global-v (make-vct 3 1.0))
- (set! global-v1 (make-vct 3 1.0))
- (set! c-var #\a)
- (set! list-var (list 2 3 4 5))
- (set! l0111 (list 0 1 1 1))
- (set! v-var (make-vct 8))
- (set! ivect (make-vector 3 1))
- (set! svar (make-st3 :one 1.0 :two 2.0))
- (set! svar1 #f)
- (set! bst3 #f)
- (set! bst4 #f)
- (set! g-gen (make-oscil 440))
- (set! clm_vector (make-vector 2))
- (set! vct_vector (make-vector 2))
- (set! hi1 (make-hiho1))
- (set! hif2 (make-hiho1 :xx 3.14))
- (set! hi2 (make-hiho2 :v (make-vct 3 .1)))
-
-
- (ftsta '(lambda (y) (set! dbl-var 32.0) dbl-var) 0.0 32.0)
- (if (fneq dbl-var 32.0) (snd-display #__line__ ";set! 1 dbl-var: ~A" dbl-var))
- (ftsta '(lambda (y) (set! dbl-var y) dbl-var) 0.5 0.5)
- (if (fneq dbl-var 0.5) (snd-display #__line__ ";set! 2 dbl-var: ~A" dbl-var))
-
- (itsta '(lambda (y) (set! int-var 3) int-var) 0 3)
- (if (not (= int-var 3)) (snd-display #__line__ ";set! 1 int-var: ~A" int-var))
- (itsta '(lambda (y) (set! int-var (inexact->exact y)) int-var) -2 -2)
- (if (not (= int-var -2)) (snd-display #__line__ ";set! 2 int-var: ~A" int-var))
-
- (btsta '(lambda (y) (set! bool-var #f) bool-var) 0.0 #f)
- (if (not (eq? bool-var #f)) (snd-display #__line__ ";set! 1 bool-var: ~A" bool-var))
- (btsta '(lambda (y) (set! bool-var (odd? y)) bool-var) 1 #t)
- (if (not (eq? bool-var #t)) (snd-display #__line__ ";set! 2 bool-var: ~A" bool-var))
-
- (set! int-var 32)
- (set! dbl-var 3.14)
- (set! bool-var #t)
-
- (etst '(set!))
- (etst '(set! int-var))
- (etst '(set! int-var 3 dbl-var 2.0))
- (etst '(let))
- (etst '(let*))
- (etst '(let ()))
- (etst '(let* ()))
- (etst '(let* * *))
- (etst '(let ((a 1))))
- (etst '(let* ((a 1))))
- (etst '(do))
- (etst '(do ()))
- (etst '(do () ()))
- (etst '(if))
- (etst '(if #t))
- (etst '(if #f #f #f #f))
- (etst '(cond))
- (etst '(case))
- (etst '(case 1))
- (etst '(call-with-current-continuation))
- (etst '(call-with-current-continuation #f #f))
- (etst '(lambda))
- (etst '(quote))
- (etst '(quote 1 2 4))
- (etst '(* + -))
-
- (itst '(* 2 3) 6)
- (itst '(* 2) 2)
- (itst '(* 2 0) 0)
- (itst '(* int-var 2) 64)
- (ftst '(* 2.0 2.5) 5.0)
- (ftst '(* -2.0 1.5 2.0) -6.0)
- (ftst '(* dbl-var 2.0) 6.28)
- (ftst '(* dbl-var int-var) (* 32 3.14))
- (ftsta '(lambda (y) y) 4.0 4.0)
- (ftsta '(lambda (y) (* 2 y)) 4.0 8.0)
- (ftsta '(lambda (y) (* 2.5 y)) 4.0 10.0)
- (ftsta '(lambda (y) (* y y)) 4.0 16.0)
- (ftsta '(lambda (y) (* y y 2)) 2.0 8.0)
- (ftsta '(lambda (y) (* y y 2 y)) 2.0 16.0)
- (ftsta '(lambda (y) (* y 2.0 y 0.5 y y)) 2.0 16.0)
- (ftsta '(lambda (y) (* y 1)) 4.0 4.0)
- (ftsta '(lambda (y) (* y 1.0)) 4.0 4.0)
- (itsta '(lambda (y) (* 2 (inexact->exact y))) 3.0 6)
- (itsta '(lambda (y) (* 2 (inexact->exact y) (inexact->exact (* 2 y)))) 3.0 36)
- (itsta '(lambda (y) (* 2 (inexact->exact y) (inexact->exact (* 2 y)) (inexact->exact y))) 2.0 32)
- (itst '(* 2 (* 3 (* 4))) 24)
- (ftsta '(lambda (y) (* y 3 2)) 1.5 9.0)
- (ftsta '(lambda (y) (* y y y y y y)) 2.0 64.0)
- (etst '(* #f))
- (etst '(* 2.0 "a string"))
- (etst '(* 2.0 1+2i))
- (itsta '(lambda (y) (* (inexact->exact y)
- (inexact->exact (+ y 1))
- (inexact->exact y)
- (inexact->exact (+ y 2))
- (inexact->exact (* y 2) )))
- 1 12)
- (itsta '(lambda (y) (+ (inexact->exact y)
- (inexact->exact (+ y 1))
- (inexact->exact y)
- (inexact->exact (+ y 2))
- (inexact->exact (* y 2) )))
- 1 9)
-
- (itst '(+ 2 3) 5)
- (itst '(+ 2) 2)
- (itst '(+ 2 0) 2)
- (ftst '(+ 3.4) 3.4)
- (ftst '(+ 2.0 2.5) 4.5)
- (ftst '(+ -2.0 1.5 2.0) 1.5)
- (ftsta '(lambda (y) (+ 2 y)) 4.0 6.0)
- (ftsta '(lambda (y) (+ 2.5 y)) 4.0 6.5)
- (ftsta '(lambda (y) (+ y y)) 4.0 8.0)
- (ftsta '(lambda (y) (+ y y 2)) 2.0 6.0)
- (ftsta '(lambda (y) (+ y y 2 y)) 2.0 8.0)
- (ftsta '(lambda (y) (+ y 2.0 y 0.5 y y)) 2.0 10.5)
- (ftsta '(lambda (y) (+ y 1)) 4.0 5.0)
- (ftsta '(lambda (y) (+ y 1.0)) 4.0 5.0)
- (itsta '(lambda (y) (+ 2 (inexact->exact y))) 3.0 5)
- (itsta '(lambda (y) (+ 2 (inexact->exact y) (inexact->exact (+ 2 y)))) 3.0 10)
- (itsta '(lambda (y) (+ 2 (inexact->exact y) (inexact->exact (+ 2 y)) (inexact->exact y))) 2.0 10)
- (itst '(+ 2 (+ 3 (+ 4))) 9)
- (ftsta '(lambda (y) (+ y 3 2)) 1.5 6.5)
- (ftsta '(lambda (y) (+ y y y y y y)) 2.0 12.0)
- (ftst '(+ dbl-var 2) (+ dbl-var 2))
- (itst '(+ int-var 2) (+ int-var 2))
- (etst '(+ #t))
- (etst '(+ 2 "oops"))
- (itst '(let ((res 1)) (do ((i 2 (+ 1 i))) ((= i 21)) (set! res (* res i))) res) 2432902008176640000)
- (itst '(+ 2432902008176640000 1) 2432902008176640001)
-
- (itst '(* (+ 1 2) (+ 3 4)) 21)
- (itst '(+ (* 2 3) (* 4 5)) 26)
- (etst '(+ 1.0 0.1+i))
- (etst '(abs 0+i))
- (ftst '(abs 1+0i) 1.0)
- ; (etsta '(lambda (y) (+ 1 y)) (sqrt -1.0))
- ; this now returns #f and optimization hook sends a warning
-
- (itst '(- 2 3) -1)
- (itst '(- 2) -2)
- (itst '(- 2 0) 2)
- (ftst '(- 2 2.5) -.5)
- (ftst '(- 2 0.5 2) -.5)
- (ftst '(- 2.0 0.5 2) -.5)
- (ftst '(- 2.0 2.5) -.5)
- (ftst '(- 2.5 2) .5)
- (ftst '(- -2.0 1.5 2.0) -5.5)
- (ftst '(- 2.0) -2.0)
- (itst '(- 0 0) 0)
- (itst '(- 1 0) 1)
- (itst '(- 0 1) -1)
- (ftsta '(lambda (y) (- 2 y)) 4.0 -2.0)
- (ftsta '(lambda (y) (- 2.5 y)) 4.0 -1.5)
- (ftsta '(lambda (y) (- y y)) 4.0 0.0)
- (ftsta '(lambda (y) (- y y 2)) 2.0 -2.0)
- (ftsta '(lambda (y) (- y y 2 y)) 2.0 -4.0)
- (ftsta '(lambda (y) (- y 2.0 y 0.5 y y)) 2.0 -6.5)
- (ftsta '(lambda (y) (- y 1)) 4.0 3.0)
- (ftsta '(lambda (y) (- y 1.0)) 4.0 3.0)
- (itsta '(lambda (y) (- 2 (inexact->exact y))) 3.0 -1)
- (itsta '(lambda (y) (- (inexact->exact y))) 1.0 -1)
- (itsta '(lambda (y) (- 2 (inexact->exact y) (inexact->exact (- 2 y)))) 3.0 0)
- (itsta '(lambda (y) (- 2 (inexact->exact y) (inexact->exact (- 2 y)) (inexact->exact y))) 2.0 -2)
- (itst '(- 2 (- 3 (- 4))) -5)
- (ftsta '(lambda (y) (- y 3 2)) 1.5 -3.5)
- (ftsta '(lambda (y) (- y 0)) 1.0 1.0)
- (ftsta '(lambda (y) (- y 0 1)) 1.0 0.0)
- (ftsta '(lambda (y) (- 0 y)) 1.0 -1.0)
- (ftsta '(lambda (y) (- 0.0 y)) 1.0 -1.0)
- (ftsta '(lambda (y) (- 0.0 y 1)) 1.0 -2.0)
- (ftsta '(lambda (y) (- y y y y y y)) 2.0 -8.0)
- (etst '(- "hi"))
- (etst '(- *))
-
- (ftst '(/ 2.0) 0.5)
- (ftst '(/ 2) 0.5)
- (ftst '(/ 2.0 0.5) 4.0)
- (ftst '(/ 2.0 0.5 2.0) 2.0)
- (ftst '(/ 1.0) 1.0)
- (ftst '(/ 1) 1.0)
- (ftst '(/ 1.0 2) 0.5)
- (ftst '(/ 1 2) 0.5)
- (ftst '(/ 2 2) 1.0)
- (ftst '(/ 2 1 2 5) .2)
- (ftst '(/ 2 1.0 2.0 5) .2)
- (ftsta '(lambda (y) (/ 2 y)) 4.0 0.5)
- (ftsta '(lambda (y) (/ 2.0 y)) 4.0 0.5)
- (ftsta '(lambda (y) (/ y y)) 4.0 1.0)
- (ftsta '(lambda (y) (/ y)) 4.0 0.25)
- (itsta '(lambda (y) (inexact->exact (/ y))) 0.25 4)
- (itsta '(lambda (y) (inexact->exact (/ y 2.0))) 4.0 2)
- (ftsta '(lambda (y) (/ y (* 2 y))) 2.0 0.5)
- (ftsta '(lambda (y) (/ y (* 2 y) y)) 2.0 0.25)
- (ftsta '(lambda (y) (/ y (* 2 y) 2 y)) 2.0 0.125)
- (ftsta '(lambda (y) (/ y (* 2 y) (+ y y) y 2)) 2.0 0.03125)
- (itst '(inexact->exact (/ 0.5)) 2)
- (itst '(inexact->exact (/ 0.5 0.5)) 1)
- (itst '(inexact->exact (/ 3)) 0)
- (itst '(inexact->exact (/ 3 1.5 2)) 1)
- (etst '(/ #f))
- (etst '(/ 1.0 2 "oops" 2))
- (ftst '(/ 2.0 1.0) 2.0)
- (ftst '(let ((a 3.0)) (/ a 1.0)) 3.0)
- (ftst '(let ((a 3.0)) (/ a 0.5)) 6.0)
- (ftst '(let ((a 3.0)) (/ a (* 2 0.5))) 3.0)
- (ftst '(/ int-var 2) 16.0)
- (ftst '(/ 32 int-var) 1.0)
- (ftst '(/ int-var 2.0) 16.0)
- (ftst '(/ 32.0 int-var) 1.0)
- (ftst '(/ int-var int-var) 1.0)
- (ftst '(/ dbl-var int-var) (/ dbl-var int-var))
- (ftst '(/ int-var dbl-var) (/ int-var dbl-var))
-
- (btst '(exact? 1) #t)
- (btst '(exact? 2.01) #f)
- (btst '(exact? #i77) #f)
- (btst '(exact? #x77) #t)
- (btst '(exact? #b11) #t)
- (btst '(inexact? 1) #f)
- (btst '(inexact? 2.01) #t)
- (btst '(inexact? #i77) #t)
- (btst '(inexact? #x77) #f)
- (btst '(inexact? #b11) #f)
- (btst '(exact? (/ 3.0 2.0)) #f)
- (btst '(inexact? (/ 3.0 2.0)) #t)
- (btst '(exact? #f) #f)
- (btst '(inexact? #f) #f)
- (btsta '(lambda (y) (inexact? y)) 1.5 #t)
- (btsta '(lambda (y) (inexact? (inexact->exact y))) 1.5 #f)
- (btsta '(lambda (y) (exact? y)) 1.5 #f)
- (btsta '(lambda (y) (exact? (inexact->exact y))) 1.5 #t)
-
- (btst '(= 7 7) #t)
- (btst '(= 7 9) #f)
- (btst '(= 1.0 1.0) #t)
- (btst '(= 1.0 2.0) #f)
- (btst '(= 2.0 (+ 1.0 1.0) (* 1.0 2.0)) #t)
- (btst '(= 7 (+ 6 1) (- 9 2)) #t)
- (btst '(= 1.0 1.0 2.0 1.0) #f)
- (btst '(= 7 (+ 6 1) (- 9 2) (- 9 4)) #f)
- (etst '(= 1.0 #f))
- (btsta '(lambda (y) (= (inexact->exact y) int-var)) 32.0 #t)
- (btsta '(lambda (y) (= (inexact->exact y) 1)) 2.0 #f)
- (btsta '(lambda (y) (= y 1.0)) 1.0 #t)
- (btsta '(lambda (y) (= y y y 1.0)) 1.0 #t)
- (btsta '(lambda (y) (= (inexact->exact y) (inexact->exact (* y 1)) (inexact->exact (- y 0)) 1)) 1.0 #t)
-
- (btst '(< 1 2 3) #t)
- (btst '(< 1 2.0 3) #t)
- (btst '(< 1 2 3 2) #f)
- (btst '(< 1 2) #t)
- (btst '(< 1) #t)
- (btst '(< 1.0 2.0) #t)
- (btst '(< 1.0 2) #t)
- (btst '(< 1.0 2.0 1.0) #f)
- (btst '(< 1.0 1) #f)
- (btsta '(lambda (y) (< y 2.0)) 3.0 #f)
- (btsta '(lambda (y) (< y 2.0)) 1.0 #t)
- (btsta '(lambda (y) (< y 2.0)) 2.0 #f)
- (btsta '(lambda (y) (< y 2.0 3.0 1.0)) 0.0 #f)
- (btsta '(lambda (y) (< y 2.0 3.0 4.0)) 0.0 #t)
- (btsta '(lambda (y) (< y (- y 2.0))) 3.0 #f)
- (btsta '(lambda (y) (< y 2.0 3)) 1.0 #t)
- (btsta '(lambda (y) (< 0.0 y 3)) 1.0 #t)
- (btsta '(lambda (y) (< 0.0 2 y)) 3.0 #t)
- (btsta '(lambda (y) (< 0.0 2 y 1.0)) 3.0 #f)
- (btsta '(lambda (y) (< (- y 1.0) 2.0)) 2.0 #t)
- (btsta '(lambda (y) (< 0 2 (inexact->exact y))) 3.0 #t)
- (btsta '(lambda (y) (< 0 2 (inexact->exact y) 4)) 3.0 #t)
- (btsta '(lambda (y) (< 0 2 (inexact->exact y) 4 1)) 3.0 #f)
- (btsta '(lambda (y) (< 0 2 y 4)) 3.0 #t)
- (btsta '(lambda (y) (< 0 2 y 4 1.5)) 3.0 #f)
- (btsta '(lambda (y) (< (- y 2) y (+ y 1))) 0.0 #t)
- (btsta '(lambda (y) (< (+ y 1) y (- y 0))) 0.0 #f)
- (etst '(< 1 #f))
- (etst '(< > 0))
-
- (btst '(>= 1 2 3) #f)
- (btst '(>= 3 2 1) #t)
- (btst '(>= 1 2.0 3) #f)
- (btst '(>= 1 2 3 2) #f)
- (btst '(>= 3 2 2 1 1) #t)
- (btst '(>= 1 2) #f)
- (btst '(>= 1) #t)
- (btst '(>= 1.0) #t)
- (btst '(>= 1.0 2.0) #f)
- (btst '(>= 2.0 1.0) #t)
- (btst '(>= 1.0 2) #f)
- (btst '(>= 1.0 2.0 1.0) #f)
- (btst '(>= 2.0 2.0 1.0) #t)
- (btst '(>= 1.0 1) #t)
- (btsta '(lambda (y) (>= y 2.0)) 3.0 #t)
- (btsta '(lambda (y) (>= y 2.0)) 1.0 #f)
- (btsta '(lambda (y) (>= y 2.0)) 2.0 #t)
- (btsta '(lambda (y) (>= y 2.0 3.0 1.0)) 0.0 #f)
- (btsta '(lambda (y) (>= y 2.0 3.0 4.0)) 0.0 #f)
- (btsta '(lambda (y) (>= y (- y 2.0))) 3.0 #t)
- (btsta '(lambda (y) (>= y 2.0 3)) 1.0 #f)
- (btsta '(lambda (y) (>= 0.0 y 3)) 1.0 #f)
- (btsta '(lambda (y) (>= 0.0 2 y)) 3.0 #f)
- (btsta '(lambda (y) (>= 4.0 y 3 3 2)) 3.0 #t)
- (btsta '(lambda (y) (>= 0.0 2 y 1.0)) 3.0 #f)
- (btsta '(lambda (y) (>= (- y 1.0) 2.0)) 2.0 #f)
- (btsta '(lambda (y) (>= 0 2 (inexact->exact y))) 3.0 #f)
- (btsta '(lambda (y) (>= 0 2 (inexact->exact y) 4)) 3.0 #f)
- (btsta '(lambda (y) (>= 0 2 (inexact->exact y) 4 1)) 3.0 #f)
- (btsta '(lambda (y) (>= 0 2 y 4)) 3.0 #f)
- (btsta '(lambda (y) (>= 0 2 y 4 1.5)) 3.0 #f)
- (btsta '(lambda (y) (>= (- y 2) y (+ y 1))) 0.0 #f)
- (btsta '(lambda (y) (>= (+ y 1) y (- y 0))) 0.0 #t)
- (etst '(>= 1 #f))
- (etst '(>= > 0))
-
- (btst '(> 1 2 3) #f)
- (btst '(> 3 2 1) #t)
- (btst '(> 1 2.0 3) #f)
- (btst '(> 1 2 3 2) #f)
- (btst '(> 3 2 2 1 1) #f)
- (btst '(> 1 2) #f)
- (btst '(> 3 2) #t)
- (btst '(> 1) #t)
- (btst '(> 1.0) #t)
- (btst '(> 1.0 2.0) #f)
- (btst '(> 2.0 1.0) #t)
- (btst '(> 1.0 2) #f)
- (btst '(> 1.0 2.0 1.0) #f)
- (btst '(> 2.0 2.0 1.0) #f)
- (btst '(> 1.0 1) #f)
- (btsta '(lambda (y) (> y 2.0)) 3.0 #t)
- (btsta '(lambda (y) (> y 2.0)) 1.0 #f)
- (btsta '(lambda (y) (> y 2.0)) 2.0 #f)
- (btsta '(lambda (y) (> y 2.0 3.0 1.0)) 0.0 #f)
- (btsta '(lambda (y) (> y 2.0 3.0 4.0)) 0.0 #f)
- (btsta '(lambda (y) (> y (- y 2.0))) 3.0 #t)
- (btsta '(lambda (y) (> y 2.0 3)) 1.0 #f)
- (btsta '(lambda (y) (> 0.0 y 3)) 1.0 #f)
- (btsta '(lambda (y) (> 0.0 2 y)) 3.0 #f)
- (btsta '(lambda (y) (> 4.0 y 3 3 2)) 3.0 #f)
- (btsta '(lambda (y) (> 0.0 2 y 1.0)) 3.0 #f)
- (btsta '(lambda (y) (> (- y 1.0) 2.0)) 2.0 #f)
- (btsta '(lambda (y) (> 0 2 (inexact->exact y))) 3.0 #f)
- (btsta '(lambda (y) (> 0 2 (inexact->exact y) 4)) 3.0 #f)
- (btsta '(lambda (y) (> 0 2 (inexact->exact y) 4 1)) 3.0 #f)
- (btsta '(lambda (y) (> 0 2 y 4)) 3.0 #f)
- (btsta '(lambda (y) (> 0 2 y 4 1.5)) 3.0 #f)
- (btsta '(lambda (y) (> (- y 2) y (+ y 1))) 0.0 #f)
- (btsta '(lambda (y) (> (+ y 1) y (- y 0))) 0.0 #f)
- (etst '(> 1 #f))
- (etst '(> > 0))
-
- (btst '(<= 1 2 3) #t)
- (btst '(<= 1 2.0 3) #t)
- (btst '(<= 1 2 3 2) #f)
- (btst '(<= 1 2) #t)
- (btst '(<= 1) #t)
- (btst '(<= 1.0 2.0) #t)
- (btst '(<= 1.0 2) #t)
- (btst '(<= 1.0 2.0 1.0) #f)
- (btst '(<= 1.0 2.0 2.0) #t)
- (btst '(<= 1.0 1) #t)
- (btsta '(lambda (y) (<= y 2.0)) 3.0 #f)
- (btsta '(lambda (y) (<= y 2.0)) 1.0 #t)
- (btsta '(lambda (y) (<= y 2.0)) 2.0 #t)
- (btsta '(lambda (y) (<= y 2.0 3.0 1.0)) 0.0 #f)
- (btsta '(lambda (y) (<= y 2.0 3.0 4.0)) 0.0 #t)
- (btsta '(lambda (y) (<= y (- y 2.0))) 3.0 #f)
- (btsta '(lambda (y) (<= y 2.0 3)) 1.0 #t)
- (btsta '(lambda (y) (<= 0.0 y 3)) 1.0 #t)
- (btsta '(lambda (y) (<= 0.0 2 y)) 3.0 #t)
- (btsta '(lambda (y) (<= 0.0 2 y 1.0)) 3.0 #f)
- (btsta '(lambda (y) (<= (- y 1.0) 2.0)) 2.0 #t)
- (btsta '(lambda (y) (<= 0 2 (inexact->exact y))) 3.0 #t)
- (btsta '(lambda (y) (<= 0 2 (inexact->exact y) 4)) 3.0 #t)
- (btsta '(lambda (y) (<= 0 2 (inexact->exact y) 4 1)) 3.0 #f)
- (btsta '(lambda (y) (<= 0 2 y 4)) 3.0 #t)
- (btsta '(lambda (y) (<= 0 2 y 4 1.5)) 3.0 #f)
- (btsta '(lambda (y) (<= (- y 2) y (+ y 1))) 0.0 #t)
- (btsta '(lambda (y) (<= (+ y 1) y (- y 0))) 0.0 #f)
- (etst '(<= 1 #f))
- (etst '(<= > 0))
-
- (itst '(+) (+))
- (itst '(*) (*))
- (etst '(/))
- (etst '(-))
- (btst '(>) #t)
- (btst '(>=) #t)
- (btst '(<) #t)
- (btst '(<=) #t)
-
- (btst '(zero? 0) #t)
- (btst '(zero? 0.0) #t)
- (btst '(zero? 1) #f)
- (etst '(zero?))
- (etst '(zero? #f))
- (etst '(zero? 1 2 3))
- (btsta '(lambda (y) (zero? y)) 0.0 #t)
- (btsta '(lambda (y) (zero? (inexact->exact y))) 32 #f)
-
- (btst '(positive? 0) #f)
- (btst '(positive? -1) #f)
- (btst '(positive? 0.0) #f)
- (btst '(positive? 1) #t)
- (etst '(positive?))
- (etst '(positive? #f))
- (etst '(positive? 3 2))
- (etst '(positive? bool-var))
- (btsta '(lambda (y) (positive? y)) 0.0 #f)
- (btsta '(lambda (y) (positive? y)) 1.0 #t)
- (btsta '(lambda (y) (positive? (inexact->exact y))) 1.0 #t)
-
- (btst '(negative? 0) #f)
- (btst '(negative? -1) #t)
- (btst '(negative? 0.0) #f)
- (btst '(negative? 1) #f)
- (etst '(negative?))
- (etst '(negative? 'hi))
- (etst '(negative? 3.1 2))
- (btsta '(lambda (y) (negative? y)) 0.0 #f)
- (btsta '(lambda (y) (negative? y)) -1.0 #t)
- (btsta '(lambda (y) (negative? y)) 1.0 #f)
- (btsta '(lambda (y) (negative? (inexact->exact y))) -1.0 #t)
-
- (btst '(even? 2) #t)
- (btst '(even? 2.0) #t)
- (btst '(even? -2) #t)
- (btst '(even? 1) #f)
- (btst '(even? 3.0) #f)
- (btst '(even? 0) #t)
- (etst '(even?))
- (etst '(even? #t))
- (etst '(even? 3 2.1))
- (btsta '(lambda (y) (even? y)) 1 #f)
- (btsta '(lambda (y) (even? y)) -1 #f)
- (btsta '(lambda (y) (even? y)) 2 #t)
- (btsta '(lambda (y) (even? y)) 4.0 #t)
-
- (btst '(odd? 2) #f)
- (btst '(odd? 2.0) #f)
- (btst '(odd? -2) #f)
- (btst '(odd? 1) #t)
- (btst '(odd? 3.0) #t)
- (btst '(odd? 0) #f)
- (btst '(odd? -3) #t)
- (etst '(odd?))
- (etst '(odd? (list 1 2)))
- (etst '(odd? 2 1))
- (btsta '(lambda (y) (odd? y)) 1 #t)
- (btsta '(lambda (y) (odd? y)) -1 #t)
- (btsta '(lambda (y) (odd? y)) 2 #f)
- (btsta '(lambda (y) (odd? y)) 4.0 #f)
-
- (itst '(quotient 45 6) 7)
- (ftst '(quotient 6.0 2.0) 3.0)
- (itst '(quotient 6.0 2.0) 3)
- (itst '(quotient 3 -2) -1)
- (itsta '(lambda (y) (quotient y 6)) 45.0 7)
- (ftsta '(lambda (y) (quotient 6.0 y)) 2.0 3.0)
- (itsta '(lambda (y) (quotient y 2.0)) 6.0 3)
- (itsta '(lambda (y) (quotient y int-var)) 64 2)
- (etst '(quotient))
- (etst '(quotient 1))
- (etst '(quotient "hiho" 2))
- (etst '(quotient 1 2 3))
-
- (itst '(remainder 13 4) 1)
- (itst '(remainder -13 4) -1)
- (itst '(remainder 13 -4) 1)
- (itst '(remainder -13 -4) -1)
- (ftst '(remainder -13 -4.0) -1.0)
- (itst '(remainder 16 4) 0)
- (itst '(remainder 5 2) 1)
- (itst '(remainder -45.0 7) -3)
- (itst '(remainder -17 -9) -8)
- (itsta '(lambda (y) (remainder y 4)) 16.0 0)
- (itsta '(lambda (y) (remainder 5 y)) 2.0 1)
- (itsta '(lambda (y) (remainder y 7)) -45.0 -3)
- (itsta '(lambda (y) (remainder y -9)) -17.0 -8)
- (etst '(remainder))
- (etst '(remainder 1))
- (etst '(remainder #f 2))
- (etst '(remainder 1 2 3))
-
- (itst '(modulo 13 4) 1)
- (itst '(modulo -13 4) 3)
- (itst '(modulo 13 -4) -3)
- (itst '(modulo -13 -4) -1)
- (itst '(modulo 16 4) 0)
- (itst '(modulo 5 2) 1)
- (itst '(modulo -45.0 7) 4.0)
- (itst '(modulo 10 -3.0) -2.0)
- (itst '(modulo -17 -9) -8)
- (itsta '(lambda (y) (modulo 5 y)) 2.0 1.0)
- (itsta '(lambda (y) (modulo y 7)) -45.0 4.0)
- (itsta '(lambda (y) (modulo 10 y)) -3.0 -2.0)
- (itsta '(lambda (y) (modulo -17 y)) -9.0 -8.0)
- (etst '(modulo))
- (etst '(modulo 1))
- (etst '(modulo 11 #f))
- (etst '(modulo 1 2 3))
-
- (ftst '(truncate -4.3) -4.0)
- (ftst '(truncate 3.5) 3.0)
- (itst '(truncate 19) 19)
- (ftst '(truncate .6) 0)
- (ftst '(truncate -8.5) -8)
- (ftst '(truncate 17.3) 17.0)
- (ftsta '(lambda (y) (truncate y)) 4.3 4.0)
- (ftsta '(lambda (y) (truncate y)) 3.5 3.0)
- (ftsta '(lambda (y) (truncate y)) .6 0)
- (ftsta '(lambda (y) (truncate y)) -8.5 -8)
- (ftsta '(lambda (y) (truncate y)) 17.3 17.0)
- (etst '(truncate))
- (etst '(truncate #f))
- (etst '(truncate 3 2 1))
- (ftsta '(lambda (y) (truncate (inexact->exact y))) 1.0 1.0)
- (itsta '(lambda (y) (inexact->exact (truncate (inexact->exact y)))) 1.0 1)
- (itsta '(lambda (y) (inexact->exact (round (inexact->exact y)))) 1.0 1)
- (itsta '(lambda (y) (inexact->exact (ceiling (inexact->exact y)))) 1.0 1)
- (itst '(inexact->exact (truncate -4.3)) -4)
- (itsta '(lambda (y) (inexact->exact (truncate y))) -4.3 -4)
- (itst '(inexact->exact (round 4.3)) 4)
- (itsta '(lambda (y) (inexact->exact (round y))) 4.3 4)
- (itst '(inexact->exact (ceiling 1.5)) 2)
- (itsta '(lambda (y) (inexact->exact (ceiling y))) 1.5 2)
-
- (let* ((g0 (make-oscil 440)) (g1 g0) (v (make-vct 1)))
- (vct-map! v (lambda () (if (eq? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run clm eq?: ~A" v)))
- (let* ((g0 (make-oscil 440)) (g1 (make-oscil 330.0)) (v (make-vct 1)))
- (vct-map! v (lambda () (if (eq? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";run clm neq?: ~A" v)))
-
- (let* ((g0 (make-oscil 440)) (g1 g0) (v (make-vct 1)))
- (vct-map! v (lambda () (if (eqv? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run clm eqv?: ~A" v)))
- (let* ((g0 (make-oscil 440)) (g1 (make-oscil 330.0)) (v (make-vct 1)))
- (vct-map! v (lambda () (if (eqv? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";run clm neqv?: ~A" v)))
-
- (let* ((g0 (make-oscil 440)) (g1 g0) (v (make-vct 1)))
- (vct-map! v (lambda () (if (equal? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run clm equal?: ~A" v)))
- (let* ((g0 (make-oscil 440)) (g1 (make-oscil 330.0)) (v (make-vct 1)))
- (vct-map! v (lambda () (if (equal? g0 g1) 1.0 2.0)))
- (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";run clm nequal?: ~A" v)))
-
- (fitst '(floor -4.3) -5.0)
- (fitst '(floor 3.5) 3.0)
- (itst '(floor 3) 3)
- (ftst '(floor .6) 0)
- (ftst '(floor -.6) -1.0)
- (ftst '(floor 17.3) 17.0)
- (ftst '(floor -8.5) -9.0)
- (fitsta '(lambda (y) (floor y)) -4.3 -5.0)
- (fitsta '(lambda (y) (floor y)) 3.5 3.0)
- (ftsta '(lambda (y) (floor y)) .6 0)
- (ftsta '(lambda (y) (floor y)) -.6 -1.0)
- (ftsta '(lambda (y) (floor y)) 17.3 17.0)
- (ftsta '(lambda (y) (floor y)) -8.5 -9.0)
- (etst '(floor))
- (etst '(floor "HI"))
- (etst '(floor 1.7 2))
- (itst '(inexact->exact (floor 2.5)) 2)
- (ftsta '(lambda (y) (floor (inexact->exact y))) 1.0 1.0)
- (itsta '(lambda (y) (inexact->exact (floor y))) 1.0 1)
-
- (fitst '(ceiling -4.3) -4.0)
- (fitst '(ceiling 3.5) 4.0)
- (itst '(ceiling 3) 3)
- (ftst '(ceiling .6) 1.0)
- (ftst '(ceiling -.6) 0)
- (ftst '(ceiling 17.3) 18.0)
- (ftst '(ceiling -8.5) -8.0)
- (etst '(ceiling))
- (etst '(ceiling #t))
- (etst '(ceiling 3.2 1))
- (itst '(inexact->exact (ceiling 2.5)) 3)
- (ftsta '(lambda (y) (ceiling y)) .6 1.0)
- (ftsta '(lambda (y) (ceiling y)) -.6 0)
- (ftsta '(lambda (y) (ceiling y)) 17.3 18.0)
- (ftsta '(lambda (y) (ceiling y)) -8.5 -8.0)
- (ftsta '(lambda (y) (ceiling (inexact->exact y))) 1.0 1.0)
-
- (fitst '(round -4.3) -4.0)
- (ftst '(round 3.5) 4.0)
- (itst '(round 7) 7)
- (ftst '(round .6) 1.0)
- (ftst '(round -.6) -1.0)
- (ftst '(round 17.3) 17.0)
- (ftst '(round -8.5) -8.0)
- (ftst '(round 2.5) 2.0)
- (ftst '(round 3.5) 4.0)
- (ftst '(round -2.5) -2.0)
- (etst '(round))
- (etst '(round 3.2 4))
- (etst '(round "test"))
- (ftsta '(lambda (y) (round y)) .6 1.0)
- (ftsta '(lambda (y) (round y)) -.6 -1.0)
- (ftsta '(lambda (y) (round y)) 17.3 17.0)
- (ftsta '(lambda (y) (round y)) -8.5 -8.0)
- (ftsta '(lambda (y) (round y)) 2.5 2.0)
- (ftsta '(lambda (y) (round y)) 3.5 4.0)
- (ftsta '(lambda (y) (round (inexact->exact y))) 1.0 1.0)
- (itst '(inexact->exact (round .6)) 1)
-
- (itst '(abs 3) 3)
- (itst '(abs -3) 3)
- (itst '(abs 0) 0)
- (ftst '(abs 3.0) 3.0)
- (ftst '(abs -3.1) 3.1)
- (etst '(abs))
- (etst '(abs 3.2 -1))
- (etst '(abs '(hiho)))
- (ftsta '(lambda (y) (abs y)) 3.0 3.0)
- (ftsta '(lambda (y) (abs y)) -3.1 3.1)
- (itsta '(lambda (y) (abs (inexact->exact y))) 3 3)
- (itsta '(lambda (y) (abs (inexact->exact y))) -3 3)
-
- (itst '(max 1) 1)
- (itst '(max 1 2) 2)
- (itst '(max 1 2 4 2 5) 5)
- (itst '(max 1 2 4 2 5 1) 5)
- (itst '(max 2 1) 2)
- (itst '(max 3 2 1) 3)
- (itst '(max 1 2 3) 3)
- (itst '(max 1 2 -4 2 -5) 2)
- (ftst '(max 1.0) 1.0)
- (ftst '(max 1 2.0) 2.0)
- (ftst '(max 1.0 2 4 2 5) 5.0)
- (ftst '(max 1 2 4.0 2.0 5 1) 5.0)
- (ftst '(max 1 -4.0 2.0 -5) 2.0)
- (ftst '(max 2.0 1.0) 2.0)
- (ftst '(max 2.0 1.0 0.0) 2.0)
- (ftst '(max 0.0 1.0 2.0) 2.0)
- (etst '(max))
- (etst '(max 1 #f 3))
- (ftsta '(lambda (y) (max y 2.0)) 1.0 2.0)
- (ftsta '(lambda (y) (max y)) 1.0 1.0)
- (ftsta '(lambda (y) (max 1.0 y 4 int-var 5)) 1.0 32.0)
- (ftsta '(lambda (y) (max 1 2 4.0 2.0 y 1)) 5.0 5.0)
- (ftsta '(lambda (y) (max 1 y 2.0 -5)) -4.0 2.0)
- (ftsta '(lambda (y) (max 2.0 y)) 1.0 2.0)
- (itsta '(lambda (y) (max 1 (inexact->exact y))) 2.0 2)
- (itsta '(lambda (y) (max (inexact->exact y) 1)) 2.0 2)
- (itsta '(lambda (y) (max 1 (inexact->exact y) 3)) 2.0 3)
- (itsta '(lambda (y) (max (inexact->exact y) 3 1 2)) 4.0 4)
-
- (itst '(min 1) 1)
- (itst '(min 1 2) 1)
- (itst '(min 1 2 4 2 5) 1)
- (itst '(min 1 2 4 2 5 1) 1)
- (itst '(min 2 1) 1)
- (itst '(min 3 2 1) 1)
- (itst '(min 1 2 3) 1)
- (itst '(min 1 2 -4 2 -5) -5)
- (itst '(min 1 2 -1 3) -1)
- (ftst '(min 1.0) 1.0)
- (ftst '(min 1 2.0) 1.0)
- (ftst '(min 1.0 2 4 2 5) 1.0)
- (ftst '(min 1 2 4.0 2.0 5 1) 1.0)
- (ftst '(min 1 -4.0 2.0 -5) -5.0)
- (ftst '(min 2.0 1.0) 1.0)
- (ftst '(min 2.0 1.0 0.0) 0.0)
- (ftst '(min 0.0 1.0 2.0) 0.0)
- (etst '(min))
- (etst '(min #f))
- (ftsta '(lambda (y) (min y 2.0)) 1.0 1.0)
- (ftsta '(lambda (y) (min y)) 1.0 1.0)
- (ftsta '(lambda (y) (min 1.0 2 y 2 5)) 4.0 1.0)
- (ftsta '(lambda (y) (min 1 2 y int-var 2.0 5 1)) 4.0 1.0)
- (ftsta '(lambda (y) (min 1 y 2.0 -5)) -4.0 -5.0)
- (ftsta '(lambda (y) (min 2.0 y)) 1.0 1.0)
- (itsta '(lambda (y) (min 1 (inexact->exact y))) 2.0 1)
- (itsta '(lambda (y) (min (inexact->exact y) 1)) 2.0 1)
- (itsta '(lambda (y) (min 1 (inexact->exact y) 3)) 2.0 1)
- (itsta '(lambda (y) (min (inexact->exact y) 3 1 2)) 4.0 1)
-
- (itst '(gcd 32 -36) 4)
- (itst '(gcd) 0)
- (itst '(gcd 34) 34)
- (itst '(gcd 33.0 15.0) 3)
- (itst '(gcd 70 -42 28) 14)
- (itst '(gcd 70 42.0 28 56) 14)
- (itsta '(lambda (y) (gcd y)) 34 34)
- (itsta '(lambda (y) (gcd y 15.0)) 33.0 3)
- (itsta '(lambda (y) (gcd 70 (inexact->exact y) 28)) -42.0 14)
- (itsta '(lambda (y) (gcd 70 y 28 56)) 42.0 14)
- (etst '(gcd #f))
-
- (itst '(lcm) 1)
- (itst '(lcm 32 -36) 288)
- (itst '(lcm 34) 34)
- (itst '(lcm 33.0 15.0) 165)
- (itst '(lcm 17 0) 0)
- (itst '(lcm 70 -42 28) 420)
- (etst '(lcm "hi"))
- (itsta '(lambda (y) (lcm y -36)) 32.0 288)
- (itsta '(lambda (y) (lcm y)) 34 34)
- (itsta '(lambda (y) (lcm 33.0 y)) 15.0 165)
- (itsta '(lambda (y) (lcm 70 (inexact->exact (* 3 y)) (inexact->exact (* -2 y)))) 14.0 420)
-
- (ftst '(expt 2 10) 1024.0)
- (ftst '(expt 2 -1) 0.5)
- (ftst '(expt -0.5 5) -.03125)
- (ftst '(expt 0 0) 1)
- (ftst '(expt 0.0 1) 0.0)
- (ftst '(expt 3.0 3.0) 27.0)
- (etst '(expt))
- (etst '(expt -1))
- (etst '(expt 2 #f))
- (ftsta '(lambda (y) (expt 2 y)) 10 1024.0)
- (ftsta '(lambda (y) (expt y -1)) 2.0 0.5)
- (ftsta '(lambda (y) (expt -0.5 y)) 5.0 -.03125)
- (ftsta '(lambda (y) (expt y 0)) 0.0 1)
- (ftsta '(lambda (y) (expt 0.0 y)) 1.0 0.0)
- (ftsta '(lambda (y) (expt y 3.0)) 3.0 27.0)
-
- (ftst '(exact->inexact 3) 3.0)
- (ftst '(exact->inexact 3.0) 3.0)
- (etst '(exact->inexact))
- (etst '(exact->inexact 1.0 2.0))
- (ftsta '(lambda (y) (exact->inexact (inexact->exact y))) 3.0 3.0)
-
- (itst '(inexact->exact 3.0) 3)
- (itst '(inexact->exact 3) 3)
- (etst '(inexact->exact))
- (etst '(inexact->exact #f))
- (etst '(inexact->exact 2.3 8.1))
- (itsta '(lambda (y) (inexact->exact y)) 3.0 3)
-
- (ftst '(sqrt 16.0) 4.0)
- (ftsta '(lambda (y) (sqrt y)) 4.84 2.2)
- (etst '(sqrt))
- (etst '(sqrt 1 2 3))
- (etst '(sqrt 'hi))
- (ftst '(sqrt 4) 2.0)
-
- (ftst '(exp 1) 2.71828)
- (ftst '(exp 0) 1.0)
- (ftst '(exp -.5) 0.60653)
- (etst '(exp))
- (etst '(exp 2.0 1.0))
- (ftsta '(lambda (y) (exp y)) 1.0 2.71828)
- (ftsta '(lambda (y) (exp y)) 0.0 1.0)
- (ftsta '(lambda (y) (exp y)) -0.5 0.60653)
-
- (ftst '(log 1.0) 0.0)
- (ftst '(log 2.71828) 1.0)
- (ftst '(/ (log 8.0) (log 2.0)) 3.0)
- (etst '(log))
- (etst '(log #t))
- (etst '(log 1 2 3))
- (ftsta '(lambda (y) (log y)) 1.0 0.0)
- (ftsta '(lambda (y) (log y)) 2.71828 1.0)
- (ftsta '(lambda (y) (/ (log y) (log 2.0))) 8.0 3.0)
- (ftst '(log 2) 0.6931)
-
- (itst '(* 2 2147483648) (* biggie 2))
- (itsta '(lambda (y) (declare (y integer)) (* y 2)) 2147483648 (* biggie 2))
- (itst '(+ 1 2147483648) 2147483649)
- (itsta '(lambda (y) (declare (y integer)) (+ 1 y)) 2147483648 2147483649)
- (btst '(eqv? 536870912 536870912) #t)
- (fitst '(/ 2147483648 536870912) 4.0)
- (fitsta '(lambda (y) (declare (y integer)) (/ 2147483648 y)) 536870912 4.0)
- (itst '(abs -536870912) 536870912)
- (itst '(abs -2147483647) 2147483647)
- (itsta '(lambda (y) (declare (y integer)) (abs y)) -2147483647 2147483647)
- (itst '(abs -2147483648) 2147483648)
- (itsta '(lambda (y) (declare (y integer)) (abs y)) -2147483648 2147483648)
- (itst '(abs (* -4 2147483647)) 8589934588)
- (itsta '(lambda (y) (declare (y integer)) (abs (* -4 y))) 2147483647 8589934588)
- (itsta '(lambda (y) (declare (y integer)) (gcd (* y 3) 536870912)) 536870912 536870912)
- (itst '(gcd (* 3 536870912) 536870912) 536870912)
- (itst '(gcd (* 3 536870912 4) (* 4 536870912)) 2147483648)
- (itst '(lcm (* 3 536870912) 536870912) 1610612736)
- (itsta '(lambda (y) (declare (y integer)) (lcm (* 3 536870912) y)) 536870912 1610612736)
- (itst '(+ 1 (* 4 2147483648)) 8589934593)
- (itsta '(lambda (y) (declare (y integer)) (+ 1 (* 4 y))) 2147483648 8589934593)
- (itsta '(lambda (y) (declare (y integer)) (+ 1 (* y 2147483648))) 4 8589934593)
- (itst '(+ 1 (* 2147483648 536870912)) 1152921504606846977)
- (itsta '(lambda (y) (declare (y integer)) (+ 1 (* 2147483648 y))) 536870912 1152921504606846977)
- (itst '(let ((i 0)) (set! i (inexact->exact (* 1.5 2147483648.0))) i) 3221225472)
- (itsta '(lambda (y) (let ((i 0)) (set! i (inexact->exact (* 1.5 y))) i)) 2147483648.0 3221225472)
- (itst '(- 2147483649) -2147483649)
- (itsta '(lambda (y) (declare (y integer)) (- y)) 2147483649 -2147483649)
- (itst '(- 2147483649 2147483648) 1)
- (itsta '(lambda (y) (declare (y integer)) (- 2147483649 y)) 2147483648 1)
- (itst '(- 536870912 2147483648) -1610612736)
- (itsta '(lambda (y) (declare (y integer)) (- y 2147483648)) 536870912 -1610612736)
- (itst '(inexact->exact (/ 2.3283064365386e-10)) 4294967296)
- (itsta '(lambda (y) (inexact->exact (/ y))) 2.3283064365386e-10 4294967296)
- (itst '(max 2147483648 2147483649) 2147483649)
- (itsta '(lambda (y) (declare (y integer)) (max 2147483648 y)) 2147483649 2147483649)
- (itst '(max 2147483648 8589934593 2147483649 -115292150460684697) 8589934593)
- (itsta '(lambda (y) (declare (y integer)) (max 2147483648 8589934593 2147483649 y)) -115292150460684697 8589934593)
- (itst '(min 2147483648 2147483649) 2147483648)
- (itsta '(lambda (y) (declare (y integer)) (min 2147483648 y)) 2147483649 2147483648)
- (itst '(min 2147483648 8589934593 2147483649 -115292150460684697) -115292150460684697)
- (itsta '(lambda (y) (declare (y integer)) (min 2147483648 8589934593 2147483649 y)) -115292150460684697 -115292150460684697)
- (fitst '(round 2147483649.55) 2147483650.0)
- (fitsta '(lambda (y) (round y)) 2147483649.55 2147483650.0)
- (fitst '(ceiling 2147483649.55) 2147483650.0)
- (fitsta '(lambda (y) (ceiling y)) 2147483649.55 2147483650.0)
- (fitst '(truncate 2147483649.55) 2147483649.0)
- (fitsta '(lambda (y) (truncate y)) 2147483649.55 2147483649.0)
- (fitst '(floor 2147483649.55) 2147483649.0)
- (fitsta '(lambda (y) (floor y)) 2147483649.55 2147483649.0)
- (fitst '(ceiling 2147483649.55) 2147483650.0)
- (fitsta '(lambda (y) (ceiling y)) 2147483649.55 2147483650.0)
- (fitst '(ceiling -2147483649.55) -2147483649.0)
- (fitsta '(lambda (y) (ceiling y)) -2147483649.55 -2147483649.0)
- (fitst '(round -2147483649.55) -2147483650.0)
- (fitsta '(lambda (y) (round y)) -2147483649.55 -2147483650.0)
- (fitst '(truncate -2147483649.55) -2147483649.0)
- (fitsta '(lambda (y) (truncate y)) -2147483649.55 -2147483649.0)
- (fitst '(floor -2147483649.55) -2147483650.0)
- (fitsta '(lambda (y) (floor y)) -2147483649.55 -2147483650.0)
- (itst '(inexact->exact 2147483649.55) 2147483650)
- (itsta '(lambda (y) (inexact->exact y)) 2147483649.55 2147483650)
- (itst '(inexact->exact -2147483649.55) -2147483650)
- (itsta '(lambda (y) (inexact->exact y)) -2147483649.55 -2147483650)
- (itst '(modulo 2147483648 3) 2)
- (itsta '(lambda (y) (declare (y integer)) (modulo y 3)) 2147483648 2)
- (itst '(modulo 2147483648 2) 0)
- (itsta '(lambda (y) (declare (y integer)) (modulo 2147483648 y)) 2 0)
- (itst '(modulo 2147483648 2147483649) 2147483648)
- (itsta '(lambda (y) (declare (y integer)) (modulo 2147483648 y)) 2147483649 2147483648)
- (itst '(ash 1 34) 17179869184)
- (itsta '(lambda (y) (declare (y integer)) (ash 1 y)) 34 17179869184)
- (stst '(number->string (ash 1 34)) "17179869184")
- (ststa '(lambda (y) (declare (y integer)) (number->string (ash 1 y))) 34 "17179869184")
- (stst '(number->string 2147483649) "2147483649")
- (ststa '(lambda (y) (declare (y integer)) (number->string y)) 2147483649 "2147483649")
- (stst '(number->string -2147483649) "-2147483649")
- (ststa '(lambda (y) (declare (y integer)) (number->string y)) -2147483649 "-2147483649")
-
- (btst '(number? 2) #t)
- (btst '(number? 2.1) #t)
- (btst '(number? #f) #f)
- (btst '(number? "hi") #f)
- (etst '(number?))
- (etst '(number? 1 2 3))
- (btsta '(lambda (y) (number? y)) 2.0 #t)
-
- (btst '(real? 2) #t)
- (btst '(real? 2.1) #t)
- (btst '(real? #f) #f)
- (btst '(real? "hi") #f)
- (etst '(real?))
- (etst '(real? 1 2 3))
- (btsta '(lambda (y) (real? y)) 2.0 #t)
-
- (btst '(integer? 2) #t)
- (btst '(integer? 2.1) #f)
- (btst '(integer? #f) #f)
- (btst '(integer? "hi") #f)
- (etst '(integer?))
- (etst '(integer? 1 2 3))
- (btsta '(lambda (y) (integer? y)) 2.1 #f)
- (btsta '(lambda (y) (declare (y integer)) (let ((x y)) (integer? x))) 1 #t)
-
- (btst '(exact? 2) #t)
- (btst '(exact? 2.1) #f)
- (btst '(exact? 2.0) #f)
- (btst '(exact? "hi") #f)
- (etst '(exact?))
- (etst '(exact? 1 2 3))
- (btsta '(lambda (y) (exact? y)) 2.1 #f)
-
- (btst '(inexact? 2) #f)
- (btst '(inexact? 2.1) #t)
- (btst '(inexact? 2.0) #t)
- (btst '(inexact? "hi") #f)
- (etst '(inexact?))
- (etst '(inexact? 1 2 3))
- (btsta '(lambda (y) (inexact? y)) 2.1 #t)
-
- (btst '(boolean? 2) #f)
- (btst '(boolean? 2.1) #f)
- (btst '(boolean? #f) #t)
- (btst '(boolean? "hi") #f)
- (etst '(boolean?))
- (etst '(boolean? 1 2 3))
- (btsta '(lambda (y) (boolean? (odd? y))) 2.0 #t)
-
- (btst '(symbol? 'a) #t)
- (btst '(symbol? 1) #f)
- (btst '(symbol? :a) #f)
- (btst '(symbol? "a") #f)
-
- (stst '(symbol->string 'asdf) "asdf")
-
- (btst '(keyword? :asdf) #t)
- (btst '(keyword? 32) #f)
- (etst '(null? :asdf))
- (etst '(* 1 2 :asdf))
- (btst '(keyword? (quote :asdf)) #t)
- (btst '(keyword? 'a) #f)
-
- (ftst '(sin 0.0) 0.0)
- (ftst '(sin 0) 0.0)
- (ftst '(sin (/ pi 2)) 1.0)
- (etst '(sin))
- (etst '(sin #f))
- (etst '(sin 1 2 3))
- (ftsta '(lambda (y) (sin y)) 0.0 0.0)
- (ftsta '(lambda (y) (sin (/ pi y))) 2.0 1.0)
-
- (ftst '(cos 0.0) 1.0)
- (ftst '(cos 0) 1.0)
- (ftst '(cos (/ pi 2)) 0.0)
- (etst '(cos))
- (etst '(cos #f))
- (etst '(cos 1 2 3))
- (ftsta '(lambda (y) (cos y)) 0.0 1.0)
- (ftsta '(lambda (y) (cos (/ pi y))) 2.0 0.0)
-
- (ftst '(asin 0.0) 0.0)
- (ftst '(asin 0) 0.0)
- (ftst '(asin 1.0) (/ pi 2))
- (ftst '(asin 1) (/ pi 2))
- (etst '(asin))
- (etst '(asin #f))
- (etst '(asin 1 2 3))
- (ftsta '(lambda (y) (asin y)) 0.0 0.0)
- (ftsta '(lambda (y) (asin y)) 1.0 (/ pi 2.0))
-
- (ftst '(acos 1.0) 0.0)
- (ftst '(acos 1) 0.0)
- (ftst '(acos 0.0) (/ pi 2))
- (ftst '(acos 0) (/ pi 2))
- (etst '(acos))
- (etst '(acos #f))
- (etst '(acos 1 2 3))
- (ftsta '(lambda (y) (acos y)) 1.0 0.0)
- (ftsta '(lambda (y) (acos y)) 0.0 (/ pi 2.0))
-
- (ftst '(tan 0.0) 0.0)
- (ftst '(tan 0) 0.0)
- (ftst '(tan (/ pi 4)) 1.0)
- (etst '(tan))
- (etst '(tan 'hi))
- (etst '(tan 1.0 2.0))
- (ftsta '(lambda (y) (tan y)) 0.0 0.0)
- (ftsta '(lambda (y) (tan y)) (/ pi 4) 1.0)
-
- (ftst '(atan 0.0) 0.0)
- (ftst '(atan 0) 0.0)
- (ftst '(atan 1.0) (/ pi 4))
- (ftst '(atan 1) (/ pi 4))
- (ftsta '(lambda (y) (atan y)) 0.0 0.0)
- (ftsta '(lambda (y) (atan y)) 1.0 (/ pi 4))
- (etst '(atan))
- (etst '(atan 'hi))
- (etst '(atan 1.0 2.0 3.0))
- (ftsta '(lambda (y) (atan y)) 0.0 0.0)
- (ftsta '(lambda (y) (atan y)) 1.0 (/ pi 4))
- (ftst '(atan 0.0 1.0) 0.0)
- (ftst '(atan 0 1) 0.0)
- (ftst '(atan 0.5 0.5) (atan 1.0))
- (ftst '(atan 0.5 1.0) (atan 0.5))
- (ftst '(atan 0.5 1) (atan 0.5))
- (ftsta '(lambda (y) (atan 0.5 y)) 0.5 (atan 1.0))
- (ftsta '(lambda (y) (atan y 1.0)) 0.5 (atan 0.5))
-
- (btst '(not #t) #f)
- (btst '(not #f) #t)
- (btst '(not (odd? 2)) #t)
- (etst '(not))
- (btst '(not 1) #f)
- (btst '(not 3.14) #f)
- (btsta '(lambda (y) (not y)) 3.1 #f)
- (btsta '(lambda (y) (set! bool-var (not (odd? y))) (not bool-var)) 3 #t)
-
- (btsta '(lambda (y) (or)) 0 #f)
- (btsta '(lambda (y) (or #f)) 0 #f)
- (btsta '(lambda (y) (or #t #f)) 0 #t)
- (btsta '(lambda (y) (or #f #t)) 0 #t)
- (btsta '(lambda (y) (or (odd? 3))) 0.0 #t)
- (btsta '(lambda (y) (or (odd? 3) #f)) 0.0 #t)
- (btsta '(lambda (y) (or #f (odd? 4))) 0.0 #f)
- (btsta '(lambda (y) (or (odd? y) (begin (set! int-var 123) #f))) 3 #t)
- (if (= int-var 123) (snd-display #__line__ ";or not short-circuited"))
- (etst '(or (hiho 3)))
-
- (btsta '(lambda (y) (and)) 0 #t)
- (btsta '(lambda (y) (and #f)) 0 #f)
- (btsta '(lambda (y) (and #t #f)) 0 #f)
- (btsta '(lambda (y) (and #f #t)) 0 #f)
- (btsta '(lambda (y) (and (odd? 3))) 0.0 #t)
- (btsta '(lambda (y) (and (odd? 3) #f)) 0.0 #f)
- (btsta '(lambda (y) (and #f (odd? 4))) 0.0 #f)
- (btsta '(lambda (y) (and (odd? y) (begin (set! int-var 123) #t))) 3 #t)
- (if (not (= int-var 123)) (snd-display #__line__ ";and quit early?"))
- (btsta '(lambda (y) (and (odd? y) (begin (set! int-var 321) #t))) 2 #f)
- (if (= int-var 321) (snd-display #__line__ ";and not short-circuited"))
- (etst '(and (hiho 3)))
-
- (btst '(eq? 1 1) #t)
- (btst '(eq? 1 2) #f)
- (btst '(eq? #f #f) #t)
- (btst '(eq? unique-boolean unique-boolean) #t)
- (btst '(eq? #f 1) #f)
- (btst '(eq? 1.0 1.0) #f)
- (btst '(eq? #t 1) #f)
- (btst '(eq? 1 1.0) #f)
- (etst '(eq?))
- (etst '(eq? 1))
- (btsta '(lambda (y) (eq? 1 1)) 1.0 #t)
- (btsta '(lambda (y) (eq? #f #f)) 0.0 #t)
- (btsta '(lambda (y) (eq? #f 1)) 0.0 #f)
- (btsta '(lambda (y) (eq? y 1.0)) 1.0 #f)
- (btsta '(lambda (y) (eq? #t y)) 1.0 #f)
- (btsta '(lambda (y) (eq? 1 y)) 1.0 #f)
- (btst '(let ((a 1) (b 1)) (eq? a b)) #t)
- (btsta '(lambda (y) (let ((a (inexact->exact y)) (b 1)) (eq? a b))) 1.0 #t)
- (btst '(eq? :a :a) #t)
- (btst '(eq? :a :b) #f)
- (btst '(eq? 'a 'a) #t)
- (btst '(eq? 'a 'b) #f)
- (btst '(eq? int-var int-var) #t)
- (btst '(eq? int-var 123) #t)
- (btst '(eq? dbl-var dbl-var) #t)
- (btst '(eq? bool-var bool-var) #t)
-
- (btst '(eqv? 1 1) #t)
- (btst '(eqv? 1 2) #f)
- (btst '(eqv? #f #f) #t)
- (btst '(eqv? #f 1) #f)
- (btst '(eqv? 1.0 1.0) #t)
- (btst '(eqv? #t 1) #f)
- (btst '(eqv? 1 1.0) #f)
- (etst '(eqv?))
- (etst '(eqv? 1))
- (btsta '(lambda (y) (eqv? 1 1)) 1.0 #t)
- (btsta '(lambda (y) (eqv? #f #f)) 0.0 #t)
- (btsta '(lambda (y) (eqv? #f 1)) 0.0 #f)
- (btsta '(lambda (y) (eqv? y 1.0)) 1.0 #t)
- (btsta '(lambda (y) (eqv? #t y)) 1.0 #f)
- (btsta '(lambda (y) (eqv? 1 y)) 1.0 #f)
- (btsta '(lambda (y) (eqv? 1 (inexact->exact y))) 1 #t)
- (btst '(eqv? :a :a) #t)
- (btst '(eqv? :a :b) #f)
- (btst '(eqv? 'a 'a) #t)
- (btst '(eqv? 'a 'b) #f)
- (btst '(eqv? int-var int-var) #t)
- (btst '(eqv? int-var 123) #t)
- (btst '(eqv? dbl-var dbl-var) #t)
- (btst '(eqv? bool-var bool-var) #t)
-
- (btst '(equal? 1 1) #t)
- (btst '(equal? 1 2) #f)
- (btst '(equal? #f #f) #t)
- (btst '(equal? #f 1) #f)
- (btst '(equal? 1.0 1.0) #t)
- (btst '(equal? 1.0 2.0) #f)
- (btst '(equal? #t 1) #f)
- (btst '(equal? 1 1.0) #f)
- (etst '(equal?))
- (etst '(equal? 1))
- (btsta '(lambda (y) (equal? 1 1)) 1.0 #t)
- (btsta '(lambda (y) (equal? #f #f)) 0.0 #t)
- (btsta '(lambda (y) (equal? #f 1)) 0.0 #f)
- (btsta '(lambda (y) (equal? y 1.0)) 1.0 #t)
- (btsta '(lambda (y) (equal? #t y)) 1.0 #f)
- (btsta '(lambda (y) (equal? 1 y)) 1.0 #f)
- (btst '(equal? :a :a) #t)
- (btst '(equal? :a :b) #f)
- (btst '(equal? 'a 'a) #t)
- (btst '(equal? 'a 'b) #f)
- (btst '(equal? int-var int-var) #t)
- (btst '(equal? int-var 123) #t)
- (btst '(equal? dbl-var dbl-var) #t)
- (btst '(equal? bool-var bool-var) #t)
-
- (btst '(eq? #\a #\a) #t)
- (btst '(eqv? #\a #\a) #t)
- (btst '(equal? #\a #\a) #t)
- (btst '(eq? #\a #\A) #f)
- (btst '(eqv? #\a #\A) #f)
- (btst '(equal? #\a #\A) #f)
- (btst '(eq? #\a 97) #f)
- (btst '(eqv? #\a 97) #f)
- (btst '(equal? #\a 97) #f)
-
- (itst '(if #t 3 2) 3)
- (itst '(if #f 3 2) 2)
- (btst '(if (odd? 3) #f #t) #f)
- (btst '(if (even? 3) #f #t) #t)
- (ftst '(if (odd? 3) 1.5 2.5) 1.5)
- (ftst '(if (odd? 4) 1.5 2.5) 2.5)
- (itst '(if #t 3) 3)
- (btst '(if (odd? 3) #f) #f)
- (ftst '(if (odd? 3) 1.5) 1.5)
- (itsta '(lambda (y) (if (odd? (inexact->exact y)) 3 2)) 3.0 3)
- (itsta '(lambda (y) (if (odd? (inexact->exact y)) 3)) 3.0 3)
- (ftsta '(lambda (y) (if (odd? (inexact->exact y)) (+ y 1) (* y 2))) 3.0 4.0)
- (ftsta '(lambda (y) (if (odd? (inexact->exact y)) (+ y 1) (* y 2))) 4.0 8.0)
- (ftsta '(lambda (y) (if (odd? (inexact->exact (* y 2))) (+ y 1) (* y 2))) 3.0 6.0)
- (ftsta '(lambda (y) (if (even? (inexact->exact (* y 2))) (+ y 1) (* y 2))) 3.0 4.0)
- (itsta '(lambda (y) (if (number? y) 32)) 1.0 32)
- (itsta '(lambda (y) (if (not (number? y)) 32 31)) 1.0 31)
- (itsta '(lambda (y) (if (not (number? y)) (set! int-var 456) (set! int-var 654)) int-var) 1.0 654)
-
- (itst '(ash 2 3) 16)
- (itst '(ash 16 -3) 2)
- (etst '(ash))
- (etst '(ash 2))
- (itsta '(lambda (y) (ash 2 (inexact->exact y))) 3.0 16)
- (itsta '(lambda (y) (ash (inexact->exact y) -3)) 16.0 2)
-
- (itst '(logand 8 1) 0)
- (itst '(logand 7 1) 1)
- (itst '(logand 7 6) 6)
- (itst '(logand 2 6) 2)
- (itst '(logand 1 6) 0)
- (etst '(logand))
- (etst '(logand 1))
- (itsta '(lambda (y) (logand (inexact->exact y) 1)) 8.0 0)
- (itsta '(lambda (y) (logand 7 (inexact->exact y))) 1.0 1)
- (itsta '(lambda (y) (logand (inexact->exact y) 6)) 7.0 6)
- (itsta '(lambda (y) (logand 2 (inexact->exact y))) 6.0 2)
-
- (itst '(logior 8 1) 9)
- (itst '(logior 7 1) 7)
- (itst '(logior 7 6) 7)
- (itst '(logior 2 6) 6)
- (itst '(logior 1 6) 7)
- (etst '(logior))
- (etst '(logior 1))
- (itsta '(lambda (y) (logior (inexact->exact y) 1)) 8.0 9)
- (itsta '(lambda (y) (logior 7 (inexact->exact y))) 1.0 7)
- (itsta '(lambda (y) (logior (inexact->exact y) 6)) 7.0 7)
- (itsta '(lambda (y) (logior 2 (inexact->exact y))) 6.0 6)
-
- (itst '(logxor 8 1) (logxor 8 1))
- (itst '(logxor 7 1) (logxor 7 1))
- (itst '(logxor 7 6) (logxor 7 6))
- (itst '(logxor 2 6) (logxor 2 6))
- (itst '(logxor 1 6) (logxor 1 6))
- (etst '(logxor))
- (etst '(logxor 1))
- (itsta '(lambda (y) (logxor (inexact->exact y) 1)) 8.0 (logxor 8 1))
- (itsta '(lambda (y) (logxor 7 (inexact->exact y))) 1.0 (logxor 7 1))
- (itsta '(lambda (y) (logxor (inexact->exact y) 6)) 7.0 (logxor 7 6))
- (itsta '(lambda (y) (logxor 2 (inexact->exact y))) 6.0 (logxor 2 6))
-
- (itst '(lognot 1) (lognot 1))
- (itst '(lognot -1) (lognot -1))
- (etst '(lognot))
- (etst '(lognot 1 2 3))
- (itsta '(lambda (y) (lognot (inexact->exact y))) 1.0 (lognot 1))
- (itsta '(lambda (y) (lognot (inexact->exact y))) -1.0 (lognot -1))
- (etst '(logxor 1.5 0))
- (etst '(logxor 0 1.5))
- (etst '(logior 1.5 0))
- (etst '(logior 0 1.5))
- (etst '(logand 1.5 0))
- (etst '(logand 0 1.5))
- (etst '(lognot 1.5))
- (etst '(ash 1.5 1))
- (etst '(ash 1 1.5))
-
- (itst '(begin (set! int-var 1) (if (> int-var 1) (set! int-var 0)) int-var) 1)
- (itst '(begin (set! int-var 1) (if (> int-var 1) (set! int-var 0) 1)) 1)
- (itst '(begin (if (> int-var 1) (set! int-var 0)) int-var) 1)
- (ftst '(begin 1.0) 1.0)
- (ftst '(begin (* int-var 3) (cos 0)) 1.0)
- (itst '(begin (set! int-var 4) (if (odd? int-var) (begin (set! int-var 3) (+ int-var 2)) (begin 2))) 2)
- (btst '(begin #f) #f)
-
- (etst '(set! int-var 1.5))
- (etst '(set! int-var #f))
- (etst '(set! dbl-var #f))
- (etst '(set! dbl-var 1))
- (etst '(set! bool-var 1))
- (etst '(let ((a 1)) (set! a 3.14)))
- (etst '(set! (hiho) 3))
- (etst '(set! (sample 0 0 0) .1))
- ; (let ((hiho '(1 2))) (etst '(set! hiho 3)))
- (etst '(set! lst-var 3))
-
- (itst '(+ 1 1) 2)
- (itst '(+ 1 0) 1)
- (itst '(+ 1 -1) 0)
- (ftst '(+ 1 2.5) 3.5)
- (ftsta '(lambda (y) (+ 1 y)) 2.1 3.1)
- (itsta '(lambda (y) (+ 1 (inexact->exact y))) 2.0 3)
- (etst '(+ 1 #f))
- (etst '(1+))
-
- (itst '(1- 1) 0)
- (itst '(1- 0) -1)
- (itst '(1- -1) -2)
- (ftst '(1- 2.5) 1.5)
- (ftsta '(lambda (y) (1- y)) 2.1 1.1)
- (itsta '(lambda (y) (1- (inexact->exact y))) 2.0 1)
- (etst '(1- #f))
- (etst '(1-))
- (etst '(1- 1 2 3))
-
- (btst '(integer? (random 32)) #t)
- (btst '(real? (random 32.0)) #t)
- (btst '(exact? (random 32.0)) #f)
-
- (set! dbl-var 32.0)
- (set! int-var 32)
- (set! bool-var #t)
-
- (itst '(let ((a 1)) a) 1)
- (itst '(let ((a 1) (b 2)) (+ a b)) 3)
- (itst '(let ((int-var 2)) int-var) 2) (if (not (= int-var 32)) (snd-display #__line__ ";let local trouble: ~A" int-var))
- (itst '(let ((a 1) (b (let ((a 32)) a))) (+ a b)) 33)
- (ftst '(let ((a 1.0)) a) 1.0)
- (ftst '(let ((a 1.5) (b 2.5)) (+ a b)) 4.0)
- (ftst '(let ((dbl-var 2.5)) (+ int-var dbl-var)) 34.5) (if (not (= dbl-var 32.0)) (snd-display #__line__ ";let flt local trouble: ~A" dbl-var))
- (ftst '(let ((a 1.0) (b (let ((a 32.5)) (set! a 3.5) (+ a 1.0)))) (if (< a 2.0) (+ a b) 0.0)) 5.5)
- (ftst '(let ((dbl-var 2.5)) (set! dbl-var 1.5) dbl-var) 1.5) (if (not (= dbl-var 32.0)) (snd-display #__line__ ";let flt local trouble: ~A" dbl-var))
- (btst '(let ((a #f)) (not a)) #t)
- (btst '(let ((a #f) (b #t)) (and a b)) #f)
- (btst '(let ((bool-var (not bool-var))) bool-var) #f) (if (not bool-var) (snd-display #__line__ ";let b local trouble: ~A" bool-var))
- (btst '(let ((a bool-var) (bool-var (let ((a (not bool-var))) a))) bool-var) #f)
- (itst '(let ((a ( + int-var 1))) a) (+ int-var 1))
- (ftsta '(let ((a 1)) (lambda (y) (+ y a))) 2.5 3.5)
- (itsta '(let ((a 1)) (lambda (y) (+ (inexact->exact y) a))) 2.0 3)
-
- (itst '(let* ((a 1)) a) 1)
- (itst '(let* ((a 1) (b (* 2 a))) (+ a b)) 3)
- (itst '(let* ((int-var 2)) int-var) 2) (if (not (= int-var 32)) (snd-display #__line__ ";let* local trouble: ~A" int-var))
- (itst '(let* ((a 1) (b (let* ((xx 32) (a xx)) a))) (+ a b)) 33)
- (ftst '(let* ((a 1.0)) a) 1.0)
- (ftst '(let* ((a 1.5) (b (* a 2))) (+ a b)) 4.5)
- (ftst '(let* ((dbl-var 2.5)) (+ int-var dbl-var)) 34.5) (if (not (= dbl-var 32.0)) (snd-display #__line__ ";let* flt local trouble: ~A" dbl-var))
- (ftst '(let* ((a 1.0) (b (let* ((a 32.5)) (set! a 3.5) (+ a 1.0)))) (if (< a 2.0) (+ a b) 0.0)) 5.5)
- (btst '(let* ((a #f) (b (not a))) (or b a)) #t)
- (btst '(let* ((a #f) (b #t)) (and a b)) #f)
- (ftsta '(let* ((a 1) (b a)) (lambda (y) (+ y a b))) 2.5 4.5)
- (itsta '(let* ((a 1) (b a)) (lambda (y) (+ (inexact->exact y) b))) 2.0 3)
- (itsta '(let ((a 32)) (let* ((a 1) (b a)) (lambda (y) (+ (inexact->exact y) b)))) 2.0 3)
- (itsta '(let ((a 32)) (let ((a 1) (b a)) (lambda (y) (+ (inexact->exact y) b)))) 2.0 34)
-
- (itst '(let* ((a 1)) (define b 2) (+ a b)) 3)
- (itst '(let* ((a 1)) (define b 2) (define c 3) (+ a b c)) 6)
- (itst '(let* ((a 1) (b 3)) (begin (define b 2) (set! a b)) (+ a b)) 5)
- (itst '(begin (define b 2) (let ((a 1)) (+ a b))) 3)
- (itst '(begin (define b 2) (let ((a 1)) (define b 12) (+ a b))) 13)
- (ftsta '(lambda (y) (define a 3) (+ y a)) 1.0 4.0)
- (ftsta '(lambda (y) (define (a d) (define (b c) (+ c 1)) (+ d (b 3))) (+ y (a 1))) 1.0 6.0)
- (ftsta '(lambda (y) (define (a d) (define b 3) (+ d b)) (+ y (a 1))) 1.0 5.0)
- (ftsta '(lambda (y) (define a (lambda () 3)) (+ y (a))) 1.0 4.0)
- (ftsta '(lambda (y) (define a (lambda () 3)) (+ y (a))) 1.0 4.0)
- (ftsta '(lambda (y) (define a (lambda (b) (+ b 3))) (+ y (a 1))) 1.0 5.0)
- (ftsta '(lambda (y) (define a (lambda (b c) (+ b c))) (+ y (a 1 3))) 1.0 5.0)
- (ftsta '(lambda (y) (define a (lambda (b c) (declare (b real)) (+ b c))) (+ y (a 1.5 3))) 1.0 5.5)
- (ftsta '(lambda (y) (define a (lambda (b c) (declare (b real) (c int)) (+ b c))) (+ y (a 1.5 3))) 1.0 5.5)
- (ftsta '(lambda (y) (define a (lambda (b c) (declare (b int)) (+ b c))) (+ y (a 1 3))) 1.0 5.0)
- (ftsta '(lambda (y) (define a (lambda (b) (declare (b string)) (+ (string-length b) 3))) (+ y (a "hi"))) 1.0 6.0)
- (ftsta '(lambda (y) (define a (lambda (b) (declare (b string)) b)) (+ y (string-length (a "hi")))) 1.0 3.0)
- (ftsta '(lambda (y) (define a (lambda (b) (declare (b string)) b)) (+ y (string-length (a "hi")))) 1.0 3.0)
- (itsta '(lambda (y) (declare (y integer)) (+ y 1)) 1 2)
- (itsta '(lambda (y) (declare (y string)) (string-length y)) "hi" 2)
- (ftsta '(lambda (y) (define (a) 3) (+ y (a))) 1.0 4.0)
- (ftsta '(lambda (y) (define (a b) (+ b 3)) (+ y (a 1))) 1.0 5.0)
- (ftsta '(lambda (y) (define (a b c) (+ b c)) (+ y (a 1 3))) 1.0 5.0)
- (ftsta '(lambda (y) (define (a b c) (declare (b real)) (+ b c)) (+ y (a 1.5 3))) 1.0 5.5)
- (ftsta '(lambda (y) (define (a b c) (declare (b real) (c int)) (+ b c)) (+ y (a 1.5 3))) 1.0 5.5)
- (ftsta '(lambda (y) (define (a b c) (declare (b int)) (+ b c)) (+ y (a 1 3))) 1.0 5.0)
- (ftsta '(lambda (y) (define (a b) (declare (b string)) (+ (string-length b) 3)) (+ y (a "hi"))) 1.0 6.0)
- (ftsta '(lambda (y) (define (a b) (declare (b string)) b) (+ y (string-length (a "hi")))) 1.0 3.0)
- (ftsta '(lambda (y) (define (a b) (declare (b string)) b) (+ y (string-length (a "hi")))) 1.0 3.0)
-
- (itst '(let ((a 0)) (do ((i 0 (+ 1 i))) ((= i 3) a) (set! a (+ 1 a)))) 3)
- (itst '(let ((a 0)) (do ((i 0 (+ 1 i)) (j 1 (* j 2))) ((= i 3) a) (set! a j))) 4)
- (itst '(let ((a 0)) (do ((i 0 (+ 1 i)) (j 1 (* j 2))) ((= i 3) (+ a 1)))) 1)
- (itst '(let ((a 0)) (do ((i 0 (+ 1 i)) (j 1 (* j 2))) ((= i 3) (+ j 1)))) 9)
- (itst '(let ((a 0)) (do () ((= a 3) a) (set! a (+ 1 a)))) 3)
- (itst '(let ((a 0)) (do () ((= a 3) a) (set! a (+ 1 a))) (set! a -1) a) -1)
- (itst '(let ((a 0) (b 3)) (do ((i 0 (+ 1 i))) ((= i (1- b))) (set! a (+ 1 a))) (set! a -1) a) -1)
-
- (itst '(let ((k 123)) (do ((i 0 (+ 1 i)) (j 0 (+ 1 j))) ((= i 3) k) (set! k j))) 2)
- (itst '(let ((k 123)) (do ((j 0 (+ 1 j)) (i 0 (+ 1 i))) ((= i 3) k) (set! k j))) 2)
- (itst '(let ((k 123)) (do ((i 0 (+ 1 i)) (j 0 i)) ((= i 3) k) (set! k j))) 1) ; the "i" ref is to the previous value
- (itst '(let ((k 123)) (do ((i 0 (+ 1 i)) (j 0)) ((= i 3) k) (set! k j))) 0)
-
- (itst '(let ((a 0) (b 3)) (if (> b 2) (set! a 2) (set! b 2)) (set! a -1) a) -1)
- (itst '(let ((a 0) (b 3)) (if (< b 2) (set! a 2) (set! b 2)) (set! a -1) a) -1)
- (itst '(let ((a 0) (b 3)) (cond ((> b 2) (set! a 2)) (else (set! b 2))) (set! a -1) a) -1)
- (itst '(let ((a 0) (b 3))
- (call-with-current-continuation
- (lambda (break)
- (set! b 3)))
- (set! a -1) a) -1)
- (itst '(let ((a 0) (b 3))
- (call-with-current-continuation
- (lambda (bbreak)
- (if (> b 2) (bbreak))
- (set! b 3)))
- (set! a -1) a) -1)
- (itst '(let ((a 0)) a) 0)
- (btst '(do ((i 0 (+ 1 i))) ((= i 3))) #f)
- (btst '(let ((a 0)) (do ((i 0 (+ 1 i)) (j 3)) ((= i 3)) (set! a (+ 1 a)))) #f)
- (btst '(let ((a 0)) (do ((i 0 (+ 1 i)) (j 3)) ((= i 3)) (set! a (+ 1 a)))) #f)
- (itst '(let ((a 0)) (do ((i 0 (+ 1 i)) (j 3)) ((= i 3) j) (set! a (+ 1 a)))) 3)
-
- (let ((j 1))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (set! j i)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 1 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((i 0 (+ i 1))
- (k 1 (+ k 2)))
- ((= i 3))
- (set! j i)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 2 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((i 0 (+ i 1)))
- ((= 3 i))
- (set! j i)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 2 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((i 0 (+ 1 i)))
- ((= 3 i))
- (set! j i)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 3 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((i 0 (+ 1 i)))
- ((>= i 3))
- (set! j i)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 4 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((i 0 (+ 1 i)))
- ((= j 2))
- (set! j i)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 5 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((i 0 (+ i 2)))
- ((= i 4))
- (set! j i)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 6 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((k 1 (+ k 2))
- (i 0 (+ i 1)))
- ((= i 3))
- (set! j i)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 7 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((k 0 (+ k 1))
- (i 6 (- i 1)))
- ((= i 3))
- (set! j k)))
- (if (not (= j 2)) (snd-display #__line__ ";loop 8 j=~A" j)))
-
- (let ((j 1))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (set! j i))
- (set! j (+ j 1)))
- (if (not (= j 3)) (snd-display #__line__ ";loop 9 j=~A" j)))
+ (define (fv164) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1.0 2.0 3.0)))))
+ (test (fv164) (float-vector 6.0 6.0 6.0 6.0))
- (let ((j 1))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 3))
- (do ((k 0 (+ k 1)))
- ((= k 3))
- (set! j (+ i k)))))
- (if (not (= j 4)) (format #t ";loop 10 j=~A" j)))
-
-
- (etst '(do ((i 0 (+ i 0.5)) (j 0 (+ 1 j))) ((>= j 3)) (display i)))
-
- (itst '(let ((a 32)) (let ((a 3)) (set! a 4)) a) 32)
-
- (set! int-var 32)
- (itst '(call-with-current-continuation
- (lambda (return)
- (let ((a 1))
- (if (even? a) (return a))
- 12)))
- 12)
- (itst '(call-with-current-continuation
- (lambda (return)
- (let ((a 1))
- (if (odd? a) (return a))
- (set! int-var 12)
- 12)))
- 1)
- (if (not (= int-var 32)) (snd-display #__line__ ";call/cc didn't exit? ~A" int-var))
- (itst '(call-with-current-continuation
- (lambda (return)
- (let ((a 1))
- (return a)
- (set! int-var 12)
- 12)))
- 1)
- (if (not (= int-var 32)) (snd-display #__line__ ";call/cc 1 didn't exit? ~A" int-var))
-
- (set! dbl-var 32.0)
- (ftst '(call-with-current-continuation
- (lambda (return)
- (let ((a 1.0))
- (if (> a 2) (return a))
- 12.0)))
- 12.0)
- (ftst '(call-with-current-continuation
- (lambda (return)
- (let ((a 1.0))
- (if (not (= a 0.0)) (return a))
- (set! dbl-var 12.0)
- 12.0)))
- 1.0)
- (if (not (= dbl-var 32.0)) (snd-display #__line__ ";call/cc dbl didn't exit? ~A" dbl-var))
- (ftst '(call-with-current-continuation
- (lambda (return)
- (let ((a 1.0))
- (return a)
- (set! dbl-var 12.0)
- 12.0)))
- 1.0)
- (if (not (= dbl-var 32.0)) (snd-display #__line__ ";call/cc dbl 1 didn't exit? ~A" dbl-var))
- (ftsta '(lambda (y)
- (if (> y 0.0)
- (call-with-current-continuation
- (lambda (return)
- (let ((a 1.0))
- (if (> y 0.0)
- (+ y a)
- (begin
- (return a)
- (set! dbl-var 12.0)
- 12.0)))))))
- 1.0
- 2.0)
- (if (not (= dbl-var 32.0)) (snd-display #__line__ ";call/cc dbl 1 didn't exit? ~A" dbl-var))
- (ftsta '(lambda (y)
- (call-with-current-continuation
- (lambda (return)
- (let ((a 1.0))
- (if (> y 0.0)
- (+ y a)
- (begin
- (return a)
- (set! dbl-var 12.0)
- 12.0))))))
- -1.0
- 1.0)
- (if (not (= dbl-var 32.0)) (snd-display #__line__ ";call/cc dbl 1 didn't exit? ~A" dbl-var))
-
- (set! str-var "")
- (btst '(let ((a 1)
- (b 1))
- (let ((cont1 #f)
- (cont2 #f))
- (call-with-current-continuation
- (lambda (x) (set! cont1 x)))
- (set! a (+ a 2))
- (set! str-var (string-append str-var "a"))
- (if cont2
- (cont2)
- (begin
- (call-with-current-continuation
- (lambda (x)
- (set! cont2 x)
- (set! b (+ b 1))
- (set! str-var (string-append str-var "b"))))
- (set! b (+ b 2))
- (set! str-var (string-append str-var "!"))
- (if (< b 6) (cont1) #f)))))
- #f)
- (if (not (string=? str-var "ab!a!")) (snd-display #__line__ ";two continuations: ~A" str-var))
-
- (set! str-var "")
- (run-eval
- '(let ((a 1))
- (call-with-current-continuation
- (lambda (x) (set! cont1 x)))
- (set! a (+ a 1))
- (set! str-var (string-append str-var (number->string gv)))
- (set! gv (+ gv 2))
- (set! str-var (string-append str-var " "))
- (if (and cont2
- (< a 10))
- (cont2))
- (let ((b 1))
- (call-with-current-continuation
- (lambda (x) (set! cont2 x)))
- (set! b (+ b 1))
- (set! str-var (string-append str-var (number->string b)))
- (if (and cont1
- (< b 6))
- (cont1)))))
- (if (not (string=? str-var "1 23 35 47 59 6")) (snd-display #__line__ ";cont2 trouble: ~A" str-var))
- (set! str-var "hi")
- (if (not (keyword? (run-eval '(if (even? 2) :hi :ho))))
- (snd-display #__line__ ";run -> key: ~A" (run-eval '(if (even? 2) :hi :ho))))
- (if (not (vct? (run-eval '(if (odd? 2) (make-vct 3) (make-vct 2)))))
- (snd-display #__line__ ";run -> vct ~A" (run-eval '(if (odd? 2) (make-vct 3) (make-vct 2)))))
-
- (itst '(* 1 1 1) 1)
- (itst '(+ 0 0 0) 0)
- (itst '(+ 2 '3) 5)
- (ftst '(+ 2.0 '3.1) 5.1)
- (btst '(and #t '#t) #t)
- (itst '(+ 2 (quote 3)) 5)
- (etst '(+ 2 '(+ 1 2)))
- (etst '(* '#f))
- (etst '(* '"hihi"))
- (ftsta '(lambda (y) (+ y '3.1)) 1.2 4.3)
- (ctst '(quote #\a) #\a)
- (ctst '#\a #\a)
- (itst '3 3)
- (ftst '3.0 3.0)
- (btst '#f #f)
-
- (btst '(vct? global-v) #t)
- (btst '(vct? 1) #f)
- (btst '(eq? global-v global-v) #t)
- (btst '(eqv? global-v global-v) #t)
- (btst '(equal? global-v global-v) #t)
- (btst '(eq? global-v global-v1) #f)
- (btst '(eqv? global-v global-v1) #t)
- (btst '(equal? global-v global-v1) #t)
- (vct-set! global-v1 2 2.0)
- (btst '(eq? global-v global-v1) #f)
- (btst '(eqv? global-v global-v1) #f)
- (btst '(equal? global-v global-v1) #f)
-
- (let ((val (run-eval '(let ((a (make-vct 3))) (vct-set! a 0 (/ .3 .2)) (vct-ref a 0)))))
- (if (fneq val 1.5) (snd-display #__line__ ";run-eval of trailing non-int in vct-set! (1): ~A" val)))
- (let ((val (run-eval '(let ((a (make-vct 3)) (b .3)) (vct-set! a 0 (/ b 2)) (vct-ref a 0)))))
- (if (fneq val .15) (snd-display #__line__ ";run-eval of trailing non-int in vct-set! (2): ~A" val)))
- (let ((val (run-eval '(let ((a (make-frame 3)) (b .3)) (frame-set! a 0 (/ b .2)) (frame-ref a 0)))))
- (if (fneq val 1.5) (snd-display #__line__ ";run-eval of trailing non-int in frame-set! (1): ~A" val)))
-
- (btst '(char? #\a) #t)
- (btst '(char? 3) #f)
- (btst '(char? "hiho") #f)
- (btst '(char? (integer->char 97)) #t)
- (btst '(char? #t) #f)
- (btsta '(lambda (y) (char? (integer->char (inexact->exact y)))) 97 #t)
-
- (btst '(char>? #\a #\b) #f)
- (btst '(char>? c-var #\b) #f)
- (btst '(char>? #\b #\b) #f)
- (btst '(char>? #\b #\a) #t)
- (btst '(char>? #\b c-var) #t)
- (btst '(char>? #\c #\b #\a) #t)
- (btst '(char>? #\c #\b c-var) #t)
- (btsta '(lambda (y) (char>? (integer->char (inexact->exact y)) #\b)) 97 #f)
- (btsta '(lambda (y) (char>? (integer->char (inexact->exact y)) #\b)) (char->integer #\c) #t)
-
- (btst '(char>=? #\a #\b) #f)
- (btst '(char>=? c-var #\b) #f)
- (btst '(char>=? #\b #\b) #t)
- (btst '(char>=? #\b #\a) #t)
- (btst '(char>=? #\b c-var) #t)
- (btst '(char>=? #\c #\b #\a) #t)
- (btst '(char>=? #\c #\b #\b) #t)
- (btst '(char>=? #\c #\b c-var) #t)
- (btst '(char>=? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char>=? (integer->char (inexact->exact y)) #\b)) 97 #f)
- (btsta '(lambda (y) (char>=? (integer->char (inexact->exact y)) #\b)) (char->integer #\c) #t)
-
- (btst '(char=? #\a #\b) #f)
- (btst '(char=? c-var #\b) #f)
- (btst '(char=? #\b #\b) #t)
- (btst '(char=? #\b #\a) #f)
- (btst '(char=? #\b c-var) #f)
- (btst '(char=? #\c #\b #\a) #f)
- (btst '(char=? #\c #\b #\b) #f)
- (btst '(char=? #\c #\b c-var) #f)
- (btst '(char=? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char=? (integer->char (inexact->exact y)) #\a)) 97 #t)
- (btsta '(lambda (y) (char=? (integer->char (inexact->exact y)) #\b)) (char->integer #\c) #f)
- (btst '(char=? #\+ #\+) #t)
- (btst '(char=? #\space #\space) #t)
- (btst '(char=? #\newline #\+) #f)
-
- (btst '(char<=? #\a #\b) #t)
- (btst '(char<=? c-var #\b) #t)
- (btst '(char<=? #\b #\b) #t)
- (btst '(char<=? #\b #\a) #f)
- (btst '(char<=? #\b c-var) #f)
- (btst '(char<=? #\c #\b #\a) #f)
- (btst '(char<=? #\c #\b #\b) #f)
- (btst '(char<=? #\c #\b c-var) #f)
- (btst '(char<=? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char<=? (integer->char (inexact->exact y)) #\b)) 97 #t)
- (btsta '(lambda (y) (char<=? (integer->char (inexact->exact y)) #\b)) (char->integer #\c) #f)
-
- (btst '(char<? #\a #\b) #t)
- (btst '(char<? c-var #\b) #t)
- (btst '(char<? #\b #\b) #f)
- (btst '(char<? #\b #\a) #f)
- (btst '(char<? #\b c-var) #f)
- (btst '(char<? #\c #\b #\a) #f)
- (btst '(char<? #\c #\b #\b) #f)
- (btst '(char<? #\c #\b c-var) #f)
- (btst '(char<? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char<? (integer->char (inexact->exact y)) #\b)) 97 #t)
- (btsta '(lambda (y) (char<? (integer->char (inexact->exact y)) #\b)) (char->integer #\c) #f)
- (btst '(char<? #\a #\b #\c) #t)
-
- (etst '(char=? #f))
- (etst '(char=? 1.0))
- (etst '(char=? 1.0 2.0))
- (etst '(char=? '(asd) #\c))
-
- (btst '(char-ci<? #\a #\B) #t)
- (btst '(char-ci<? c-var #\b) #t)
- (btst '(char-ci<? #\B #\b) #f)
- (btst '(char-ci<? #\b #\A) #f)
- (btst '(char-ci<? #\B c-var) #f)
- (btst '(char-ci<? #\c #\B #\a) #f)
- (btst '(char-ci<? #\c #\b #\b) #f)
- (btst '(char-ci<? #\C #\b c-var) #f)
- (btst '(char-ci<? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char-ci<? (integer->char (inexact->exact y)) #\B)) 97 #t)
- (btsta '(lambda (y) (char-ci<? (integer->char (inexact->exact y)) #\B)) (char->integer #\c) #f)
- (btst '(char-ci<? #\a #\B #\c) #t)
-
- (btst '(char-ci<=? #\a #\B) #t)
- (btst '(char-ci<=? c-var #\b) #t)
- (btst '(char-ci<=? #\B #\b) #t)
- (btst '(char-ci<=? #\c #\B #\a) #f)
- (btst '(char-ci<=? #\C #\b c-var) #f)
- (btst '(char-ci<=? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char-ci<=? (integer->char (inexact->exact y)) #\B)) 97 #t)
- (btsta '(lambda (y) (char-ci<=? (integer->char (inexact->exact y)) #\B)) (char->integer #\c) #f)
-
- (btst '(char-ci>=? #\a #\B) #f)
- (btst '(char-ci>=? c-var #\b) #f)
- (btst '(char-ci>=? #\B #\b) #t)
- (btst '(char-ci>=? #\c #\B #\a) #t)
- (btst '(char-ci>=? #\C #\b c-var) #t)
- (btst '(char-ci>=? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char-ci>=? (integer->char (inexact->exact y)) #\B)) 97 #f)
- (btsta '(lambda (y) (char-ci>=? (integer->char (inexact->exact y)) #\B)) (char->integer #\c) #t)
-
- (btst '(char-ci>? #\a #\B) #f)
- (btst '(char-ci>? c-var #\b) #f)
- (btst '(char-ci>? #\B #\b) #f)
- (btst '(char-ci>? #\c #\B #\a) #t)
- (btst '(char-ci>? #\C #\b c-var) #t)
- (btst '(char-ci>? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char-ci>? (integer->char (inexact->exact y)) #\B)) 97 #f)
- (btsta '(lambda (y) (char-ci>? (integer->char (inexact->exact y)) #\B)) (char->integer #\c) #t)
-
- (btst '(char-ci=? #\a #\B) #f)
- (btst '(char-ci=? c-var #\b) #f)
- (btst '(char-ci=? #\B #\b) #t)
- (btst '(char-ci=? #\c #\B #\a) #f)
- (btst '(char-ci=? #\C #\b c-var) #f)
- (btst '(char-ci=? #\c #\b c-var #\b) #f)
- (btsta '(lambda (y) (char-ci=? (integer->char (inexact->exact y)) #\B)) 97 #f)
- (btsta '(lambda (y) (char-ci=? (integer->char (inexact->exact y)) #\B)) (char->integer #\c) #f)
-
- (btst '(char-alphabetic? #\a) #t)
- (btst '(char-alphabetic? #\T) #t)
- (btst '(char-alphabetic? #\+) #f)
- (btst '(char-alphabetic? #\8) #f)
- (btsta '(lambda (y) (char-alphabetic? (integer->char (inexact->exact y)))) (exact->inexact (char->integer #\8)) #f)
-
- (btst '(char-numeric? #\a) #f)
- (btst '(char-numeric? #\T) #f)
- (btst '(char-numeric? #\+) #f)
- (btst '(char-numeric? #\8) #t)
- (btsta '(lambda (y) (char-numeric? (integer->char (inexact->exact y)))) (exact->inexact (char->integer #\8)) #t)
-
- (btst '(char-lower-case? #\a) #t)
- (btst '(char-lower-case? #\T) #f)
- (btst '(char-lower-case? #\+) #f)
- (btst '(char-lower-case? #\8) #f)
- (btsta '(lambda (y) (char-lower-case? (integer->char (inexact->exact y)))) (exact->inexact (char->integer #\B)) #f)
-
- (btst '(char-upper-case? #\a) #f)
- (btst '(char-upper-case? #\T) #t)
- (btst '(char-upper-case? #\+) #f)
- (btst '(char-upper-case? #\8) #f)
- (btsta '(lambda (y) (char-upper-case? (integer->char (inexact->exact y)))) (exact->inexact (char->integer #\B)) #t)
-
- (btst '(char-whitespace? #\a) #f)
- (btst '(char-whitespace? #\T) #f)
- (btst '(char-whitespace? #\space) #t)
- (btst '(char-whitespace? #\8) #f)
- (btsta '(lambda (y) (char-whitespace? (integer->char (inexact->exact y)))) (exact->inexact (char->integer #\B)) #f)
-
- (ctst '(char-upcase #\a) #\A)
- (ctsta '(lambda (y) (char-upcase (integer->char (inexact->exact y)))) 97.0 #\A)
- (ctst '(char-downcase #\A) #\a)
- (ctsta '(lambda (y) (char-downcase (integer->char (inexact->exact y)))) 65.0 #\a)
- (ctst '(integer->char 65) #\A)
- (itst '(char->integer #\A) 65)
- (itst '(char->integer #\newline) 10)
- (ctst '(integer->char 48) #\0)
-
- (ctst '(let ((cv #\a)) (set! cv #\b) cv) #\b)
- (ctst '(let ((cv #\a)) (set! c-var #\b) cv) #\a)
- (if (not (char=? c-var #\b)) (snd-display #__line__ ";set c-var: ~A" c-var))
- (ctsta '(lambda (y) (let ((cv (integer->char (inexact->exact y)))) (set! cv #\b) cv)) 97 #\b)
- (ctsta '(lambda (y) (let ((cv (integer->char (inexact->exact y)))) (set! c-var cv) cv)) 97 #\a)
- (if (not (char=? c-var #\a)) (snd-display #__line__ ";set c-var: ~A" c-var))
-
- (btst '(string? "hi") #t)
- (btst '(string? 3) #f)
- (btst '(string? #\a) #f)
- (btst '(string? str-var) #t)
- (btsta '(lambda (y) (string? "hiho")) 1 #t)
-
- (stst '(string #\a #\b) "ab")
- (stst '(string #\a #\b (integer->char 65)) "abA")
- (stst '(string) "")
- (stst '(string #\a) "a")
- (ststa '(lambda (y) (string #\a #\!)) 1 "a!")
- (etst '(string 1))
- (etst '(string "hi"))
- (stst '(if #t "hi" "ho") "hi")
- (stst '(if #f "hi" "ho") "ho")
- (ststa '(lambda (y) (if (> y 1.0) "hi" "ho")) 0.0 "ho")
- (itst '(if #t 3 2) 3)
- (itst '(if #f 3 2) 2)
- (itsta '(lambda (y) (if (> y 1.0) 3 2)) 0.0 2)
- (ftst '(if #t 1.5 2.5) 1.5)
- (ftst '(if #f 1.5 2.5) 2.5)
- (ftsta '(lambda (y) (if (> y 1.0) 3.1 2.1)) 0.0 2.1)
- (btst '(if #f #f #t) #t)
- (btst '(let ((v (make-vct 3))) (vct? (if #t v))) #t)
- (btst '(let ((v (make-vector 3 1.0))) (vector? (if #t v))) #t)
- (btst '(let ((v (make-vector 3 1))) (vector? (if #t v))) #t)
- (btst '(let ((v (make-vector 3))) (vector? (if #t v))) #t)
- (etst '(let ((v (make-vector 3 (make-vct 3)))) (vector? (if #t v))))
- (btsta '(lambda (y) (let ((v (make-vct 3))) (vct? (if (> y 1.0) v)))) 2.0 #t)
-
- (itst '(string-length "abc") 3)
- (itst '(string-length str-var) 2)
- (itsta '(lambda (y) (string-length (string #\a (integer->char (inexact->exact y))))) 65 2)
-
- (stst '(string-copy "hi") "hi")
- (stst '(string-copy (string #\a #\b)) "ab")
- (stst '(string-copy str-var) "hi")
- (ststa '(lambda (y) (string-copy (string (integer->char (inexact->exact y)) #\!))) 65 "A!")
- (etst '(string-copy #\a))
- (etst '(string-copy))
- (etst '(string-copy 123))
-
- (stst '(let ((str "asdfg")) (string-fill! str #\x) str) "xxxxx")
- (stst '(let ((str "asdf")) (string-set! str 1 #\x) str) "axdf")
- (ctst '(string-ref "asdf" 2) #\d)
- (etst '(string-ref 123))
- (etst '(string-ref "hi" "ho"))
- (etst '(string-set! "hi" 1 "c"))
- (etst '(string-set! "hi" 1 #\b))
- (etst '(string-fill! "hi" "ho"))
- (etst '(string-fill! "hi" #\b))
- (stst '(make-string 3) " ")
- (stst '(make-string 3 #\a) "aaa")
-
- (set! str-var "a")
- (btst '(string>? "a" "b") #f)
- (btst '(string>? str-var "b") #f)
- (btst '(string>? "b" "b") #f)
- (btst '(string>? "b" "a") #t)
- (btst '(string>? "b" str-var) #t)
- (btst '(string>? "c" "b" "a") #t)
- (btst '(string>? "c" "b" str-var) #t)
- (btsta '(lambda (y) (string>? (string (integer->char (inexact->exact y))) "b")) 97 #f)
- (btsta '(lambda (y) (string>? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #t)
-
- (btst '(string>=? "a" "b") #f)
- (btst '(string>=? str-var "b") #f)
- (btst '(string>=? "b" "b") #t)
- (btst '(string>=? "b" "a") #t)
- (btst '(string>=? "b" str-var) #t)
- (btst '(string>=? "c" "b" "a") #t)
- (btst '(string>=? "c" "b" "b") #t)
- (btst '(string>=? "c" "b" str-var) #t)
- (btst '(string>=? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string>=? (string (integer->char (inexact->exact y))) "b")) 97 #f)
- (btsta '(lambda (y) (string>=? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #t)
-
- (btst '(string=? "a" "b") #f)
- (btst '(string=? str-var "b") #f)
- (btst '(string=? "b" "b") #t)
- (btst '(string=? "b" "a") #f)
- (btst '(string=? "b" str-var) #f)
- (btst '(string=? "c" "b" "a") #f)
- (btst '(string=? "c" "b" "b") #f)
- (btst '(string=? "c" "b" str-var) #f)
- (btst '(string=? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string=? (string (integer->char (inexact->exact y))) "a")) 97 #t)
- (btsta '(lambda (y) (string=? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #f)
- (btst '(string=? "+" "+") #t)
-
- (btst '(string<=? "a" "b") #t)
- (btst '(string<=? str-var "b") #t)
- (btst '(string<=? "b" "b") #t)
- (btst '(string<=? "b" "a") #f)
- (btst '(string<=? "b" str-var) #f)
- (btst '(string<=? "c" "b" "a") #f)
- (btst '(string<=? "c" "b" "b") #f)
- (btst '(string<=? "c" "b" str-var) #f)
- (btst '(string<=? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string<=? (string (integer->char (inexact->exact y))) "b")) 97 #t)
- (btsta '(lambda (y) (string<=? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #f)
-
- (btst '(string<? "a" "b") #t)
- (btst '(string<? str-var "b") #t)
- (btst '(string<? "b" "b") #f)
- (btst '(string<? "b" "a") #f)
- (btst '(string<? "b" str-var) #f)
- (btst '(string<? "c" "b" "a") #f)
- (btst '(string<? "c" "b" "b") #f)
- (btst '(string<? "c" "b" str-var) #f)
- (btst '(string<? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string<? (string (integer->char (inexact->exact y))) "b")) 97 #t)
- (btsta '(lambda (y) (string<? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #f)
- (btst '(string<? "a" "b" "c") #t)
-
- (etst '(string=? #f))
- (etst '(string=? 1.0))
- (etst '(string=? 1.0 2.0))
-
- (btst '(string-ci<? "a" "b") #t)
- (btst '(string-ci<? str-var "b") #t)
- (btst '(string-ci<? "b" "b") #f)
- (btst '(string-ci<? "b" "a") #f)
- (btst '(string-ci<? "b" str-var) #f)
- (btst '(string-ci<? "c" "b" "a") #f)
- (btst '(string-ci<? "c" "b" "b") #f)
- (btst '(string-ci<? "c" "b" str-var) #f)
- (btst '(string-ci<? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string-ci<? (string (integer->char (inexact->exact y))) "b")) 97 #t)
- (btsta '(lambda (y) (string-ci<? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #f)
- (btst '(string-ci<? "a" "b" "c") #t)
-
- (btst '(string-ci<=? "a" "b") #t)
- (btst '(string-ci<=? str-var "b") #t)
- (btst '(string-ci<=? "b" "b") #t)
- (btst '(string-ci<=? "c" "b" "a") #f)
- (btst '(string-ci<=? "c" "b" str-var) #f)
- (btst '(string-ci<=? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string-ci<=? (string (integer->char (inexact->exact y))) "b")) 97 #t)
- (btsta '(lambda (y) (string-ci<=? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #f)
-
- (btst '(string-ci>=? "a" "b") #f)
- (btst '(string-ci>=? str-var "b") #f)
- (btst '(string-ci>=? "b" "b") #t)
- (btst '(string-ci>=? "c" "b" "a") #t)
- (btst '(string-ci>=? "c" "b" str-var) #t)
- (btst '(string-ci>=? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string-ci>=? (string (integer->char (inexact->exact y))) "b")) 97 #f)
- (btsta '(lambda (y) (string-ci>=? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #t)
-
- (btst '(string-ci>? "a" "b") #f)
- (btst '(string-ci>? str-var "b") #f)
- (btst '(string-ci>? "b" "b") #f)
- (btst '(string-ci>? "c" "b" "a") #t)
- (btst '(string-ci>? "c" "b" str-var) #t)
- (btst '(string-ci>? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string-ci>? (string (integer->char (inexact->exact y))) "b")) 97 #f)
- (btsta '(lambda (y) (string-ci>? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #t)
-
- (btst '(string-ci=? "a" "b") #f)
- (btst '(string-ci=? str-var "b") #f)
- (btst '(string-ci=? "b" "b") #t)
- (btst '(string-ci=? "c" "b" "a") #f)
- (btst '(string-ci=? "c" "b" str-var) #f)
- (btst '(string-ci=? "c" "b" str-var "b") #f)
- (btsta '(lambda (y) (string-ci=? (string (integer->char (inexact->exact y))) "b")) 97 #f)
- (btsta '(lambda (y) (string-ci=? (string (integer->char (inexact->exact y))) "b")) (char->integer #\c) #f)
- (set! str-var "hi")
-
- (stst '(let ((str "asdfg")) (string-fill! str #\x) str) "xxxxx")
- (stst '(begin (set! str-var "ho") str-var) "ho")
- (if (not (string=? str-var "ho")) (snd-display #__line__ ";global str not reset upon exit? ~A" str-var))
- (ststa '(lambda (y) (begin (set! str-var (string #\c #\b #\a)) str-var)) 0 "cba")
- (if (not (string=? str-var "cba")) (snd-display #__line__ ";global str not reset upon lambda exit? ~A" str-var))
- (stst '(let ((str (make-string 4 #\a))) str) "aaaa")
- (stst '(let ((str (make-string 4 #\a))) (string-set! str 0 #\b) str) "baaa")
- (itst '(let ((str (make-string 4 #\a))) (string-set! str 0 #\b) (string-length str)) 4)
- (itsta '(lambda (y) (let ((str (make-string 4 #\a))) (string-set! str 0 #\b) (string-length str))) 0 4)
- (stst '(let ((str (make-string 4 #\a))) (string-set! str 0 #\b) (set! str-var "a") (set! str (string (string-ref str-var 0))) str) "a")
-
- (stst '(substring "012345" 0 1) "0")
- (stst '(substring "012345" 0 0) "")
- (stst '(substring "012345" 1 4) "123")
- (set! str-var "012345")
- (stst '(substring str-var 1 4) "123")
- (etst '(substring "asdfg"))
- (etst '(substring "asdfg" "hi"))
- (etst '(substring "asdfg" 0 3 123))
- (etst '(substring "hi" 3 4))
- (etst '(substring "hi" 3 2))
- (ststa '(lambda (y) (substring "012345" 1 (inexact->exact y))) 4 "123")
- (ststa '(lambda (y) (substring "012345" (inexact->exact y) 1)) 1 "")
- (ststa '(lambda (y) (substring "hi" 2 (inexact->exact y))) 4 "") ; should send error
- (ststa '(lambda (y) (substring (make-string 6 (integer->char (inexact->exact y))) 2 4)) 65 "AA")
- (ststa '(lambda (y) (let ((str (make-string 6 (integer->char (inexact->exact y))))) (string-set! str 0 #\b) (substring str 0 2))) 65 "bA")
- (stst '(string-append "a" "bc") "abc")
- (stst '(string-append "hi") "hi")
- (stst '(string-append "01" "2" "345") "012345")
- (set! str-var "01")
- (stst '(string-append str-var "2" "345") "012345")
- (btst '(string? (string-append)) #t)
- (stst '(string-append str-var) str-var)
- (ststa '(lambda (y) (string-append str-var (string (integer->char (inexact->exact y)) #\1 #\2) "345")) 48 "01012345")
- (etst '(make-string "hi"))
- (etst '(make-string 3 3.14))
-
- (stst '(number->string 1) "1")
- (stst '(number->string 3 2) "11")
- (stst '(number->string 1.5) "1.5")
- (stst '(number->string 1.5 10) "1.5") ; actually radix is ignored here by scheme
- (ststa '(lambda (y) (number->string y)) 1.5 "1.5")
- (ststa '(lambda (y) (number->string (inexact->exact y))) 1.0 "1")
- (ststa '(lambda (y) (number->string y 10)) 1.0 "1.0")
- (ststa '(lambda (y) (number->string (inexact->exact y) 2)) 1.0 "1")
- (ststa '(lambda (y) (number->string 3 (inexact->exact y))) 2.0 "11")
-
- (etst '(snd-print #f))
- (etst '(snd-warning #f))
- (etst '(string-ref #f 1))
- (etst '(string-fill! #f #\c))
- (etst '(string-set! #f 1 #\c))
-
- (stst '(format #f "hiho: ~D" 43) "hiho: 43")
- (stst '(format #f "~A: ~A" "hiho" '(3 4)) "hiho: (3 4)")
- (stst '(format #f "~A: ~A" (> 2 3) (make-vct 2 .1)) "#f: #<vct[len=2]: 0.100 0.100>")
-; (stst '(format #f "hi~16Tho") "hi ho")
- (stst '(format #f "~{~D ~}" '(1 2 3)) "1 2 3 ")
- (stst '(clm-print "hiho: ~D" 43) "hiho: 43")
-
- (btst '(sampler? "hi") #f)
- (btst '(sampler? #t) #f)
-
- (ftst '(let ((v (make-vct 3))) (vct-set! v 1 32.1) (vct-ref v 1)) 32.1)
- (ftst '(let ((v (make-vct 3))) (vct-set! v 1 32) (vct-ref v 1)) 32.0)
- (ftst '(let ((v (make-vector 3 0.0))) (vector-set! v 1 32.1) (vector-ref v 1)) 32.1)
- (ftst '(let ((v (make-vct 3))) (vct-set! v 1 3.0) (vct-scale! v 2.0) (vct-ref v 1)) 6.0)
- (btst '(let ((v (make-vct 3))) (vct? (vct-scale! v 2.0))) #t)
- (ftst '(let ((v (make-vct 3))) (set! int-var 2) (vct-set! v 1 3.0) (vct-scale! v int-var) (vct-ref v 1)) 6.0)
- (ftst '(let ((v (make-vct 3))) (vct-set! v 1 3.0) (vct-add! v v) (vct-ref v 1)) 6.0)
- (ftst '(let ((v (make-vct 3))) (vct-set! v 1 3.0) (vct+ v v) (vct-ref v 1)) 6.0)
- (btst '(let ((v (make-vct 3))) (vct? (vct-add! v v))) #t)
- (ftst '(let ((v (make-vct 3))) (vct-set! v 1 3.0) (vct-multiply! v v) (vct-ref v 1)) 9.0)
- (ftst '(let ((v (make-vct 3))) (vct-set! v 1 3.0) (vct* v v) (vct-ref v 1)) 9.0)
- (btst '(let ((v (make-vct 3))) (vct? (vct-multiply! v v))) #t)
- (ftst '(let ((v (make-vct 3))) (vct-set! v 1 3.0) (vct-subtract! v v) (vct-ref v 1)) 0.0)
- (btst '(let ((v (make-vct 3))) (vct? (vct-subtract! v v))) #t)
- (ftst '(let ((v (make-vct 3))) (set! (vct-ref v 2) 3.0) (vct-offset! v 17) (vct-ref v 2)) 20.0)
- (ftst '(let ((v (make-vct 3))) (set! (vct-ref v 2) 3.0) (vct+ v 17) (vct-ref v 2)) 20.0)
- (ftst '(let ((v (make-vct 3))) (set! (vct-ref v 2) 3.0) (vct+ 17 v) (vct-ref v 2)) 20.0)
- (btst '(let ((v (make-vct 3))) (vct? (vct-offset! v 17))) #t)
- (ftst '(let ((v (make-vct 3))) (set! (vct-ref v 0) 3.0) (vct-fill! v 7) (vct-ref v 0)) 7.0)
- (btst '(let ((v (make-vct 3))) (vct? (vct-fill! v 7))) #t)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 3.14) (let ((v1 (vct-copy v))) (vct-ref v1 2))) 3.14)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-ref (vct-scale! v 2.0) 1)) 2.0)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-ref (vct* v 2.0) 1)) 2.0)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-ref (vct* 2.0 v) 1)) 2.0)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-ref (vct-scale! (vct-add! v v) 2.0) 1)) 4.0)
- (ftst '(let ((v (make-vct 3))) (set! (vct-ref v 1) 1.0) (vct-ref v 1)) 1.0)
- (ftst '(let ((v (make-vct 3)) (ind 0)) (set! (vct-ref v ind) 2.0) (vct-ref v ind)) 2.0)
- (ftst '(vct-ref (vct .1 .2) 0) .1)
- (ftst '(vct-ref (vct .1 .2 .3 .4) 2) .3)
- (btst '(let ((v0 (make-vct 4)) (v1 (make-vct 4))) (vct? (mus-fft v0 v1))) #t)
- (btst '(let ((v0 (make-vct 4)) (v1 (make-vct 4))) (vct? (mus-fft v0 v1 4))) #t)
- (btst '(let ((v0 (make-vct 4)) (v1 (make-vct 4))) (vct? (mus-fft v0 v1 4 1))) #t)
- (btst '(let ((v0 (make-vct 4)) (v1 (make-vct 4))) (vct? (fft v0 v1))) #t)
- (btst '(let ((v0 (make-vct 4)) (v1 (make-vct 4))) (vct? (fft v0 v1 1))) #t)
- (btst '(let ((v0 (make-vct 4))) (vct? (clear-array v0))) #t)
-
- (let ((x 0.0))
- (run (set! x (vct-ref (vct 0 1 2 3) 2)))
- (if (fneq x 2.0) (snd-display #__line__ ";vct with ints in run: ~A" x)))
-
- (let ((v1 (make-vct 32 1.0)))
- (run
- (lambda ()
- (if (> (vct-ref v1 0) 2.0)
- (vct-scale! v1 0.5)))))
- (let ((g1 (make-oscil)))
- (run
- (lambda ()
- (if (square-wave? g1)
- g1))))
-
- (let ((v (vct 1.0 2.0 3.0)))
- (let ((val (run (v 1))))
- (if (fneq val 2.0) (snd-display #__line__ ";run (v 1): ~A" val))))
- (let ((v (vector 1.0 2.0 3.0)))
- (let ((val (run (v 1))))
- (if (fneq val 2.0) (snd-display #__line__ ";run (v 1) as vector: ~A" val))))
- (let ((v (vct 1.0 2.0 3.0)))
- (run (set! (v 1) 0.5))
- (if (fneq (vct-ref v 1) 0.5) (snd-display #__line__ ";run set (v 1): ~A" (vct-ref v 1))))
- (let ((v (vector 1.0 2.0 3.0)))
- (let ((val (run (set! (v 1) 0.5) (vector-ref v 1))))
- (if (fneq val 0.5) (snd-display #__line__ ";run vector-set (v 1): ~A" val))))
-
- (btst '(let ((sd (make-sound-data 2 2))) (sound-data? sd)) #t)
- (btst '(sound-data? "hi") #f)
- (btst '(sound-data? (make-vct 3)) #f)
- (ftst '(let ((sd (make-sound-data 2 2))) (sound-data-set! sd 0 1 .3) (sound-data-ref sd 0 1)) .3)
- (ftst '(let ((sd (make-sound-data 2 2))) (sound-data-set! sd 0 1 3) (sound-data-ref sd 0 1)) 3.0)
- (ftst '(let ((sd (make-sound-data 2 2))) (set! (sound-data-ref sd 0 1) .3) (sound-data-ref sd 0 1)) .3)
- (itst '(let ((sd (make-sound-data 2 3))) (sound-data-chans sd)) 2)
- (itst '(let ((sd (make-sound-data 2 3))) (sound-data-length sd)) 3)
- (btst '(let ((sd (make-sound-data 2 3))) (equal? sd sd)) #t)
- (btst '(let ((sd (make-sound-data 2 3))) (eq? sd sd)) #t)
- (btst '(let ((sd (make-sound-data 2 3)) (sd1 (make-sound-data 2 3))) (equal? sd sd1)) #t)
- (btst '(let ((sd (make-sound-data 2 3)) (sd1 (make-sound-data 2 3))) (sound-data-set! sd 0 0 .1) (equal? sd sd1)) #f)
- (btst '(let ((sd (make-sound-data 2 3)) (sd1 (make-sound-data 2 4))) (equal? sd sd1)) #f)
- (btst '(let ((sd (make-sound-data 2 3)) (sd1 (make-sound-data 2 3))) (eq? sd sd1)) #f)
-
- (catch 'cannot-parse
- (lambda ()
- (let ((val (run-eval '(lambda ()
- (let ((our-val 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 32) our-val)
- (let ((v (make-vct 3))
- (sd (make-sound-data 1 4))
- (str (make-string 3 #\c)))
- (if (not (string=? str "ccc"))
- (snd-print (format #f ";make-string: ~A" str)))
- (vct-set! v 0 .1)
- (sound-data-set! sd 0 1 .2)
- (set! our-val (+ our-val (vct-ref v 0) (sound-data-ref sd 0 1))))))))))
- (if (or (not (number? val))
- (fneq val 9.6))
- (snd-display #__line__ ";make-all val: ~A" val))))
- (lambda args
- (snd-display #__line__ ";can't parse sound-data example (format)")))
-
- (itst '(case 1 ((1) 4) ((2 3) 5)) 4)
- (stst '(case 2 ((1) "hi") ((2 3) "ho")) "ho")
- (itsta '(lambda (y) (declare (y integer)) (case y ((1) (let ((a y)) (+ a 1))) ((2 3 4) (* y 2)))) 1 2)
- (itsta '(lambda (y) (declare (y integer)) (case y ((1) (let ((a y)) (+ a 1))) ((2 3 4) (* y 2)))) 3 6)
- (itst '(case 1 ((1) 4) ((2 3) 5) (else 123)) 4)
- (itst '(case 3 ((1) 4) ((2 3) 5) (else 123)) 5)
- (itst '(case 10 ((1) 4) ((2 3) 5) (else 123)) 123)
- (etst '(case 10 ((1) 4) ((2 3) .5) (else 123)))
- (etst '(case 10 ((1) 4) ((2 1.3) 5) (else 123)))
-
- (etst '(let ((a 1)) (if (> a 0) 2 (list 1 2))))
- (etst '(let ((a 1)) (if (> a 0) 2 "hi")))
- (btst '(let ((a 1)) (cond ((> a 0)))) #t)
- (etst '(let ((a 1)) (cond ((> a 0) (list 1 2)))))
- (etst '(let ((a 1)) (cond ((> a 1) 2) ((> a 0) "hi"))))
- (etst '(do ((i 0 (+ 1 i))) ("hi" 3)))
- (etst '(do ((i 0 (+ 1 i))) ((= i 3) (list 1 2)) (+ 1 2)))
- (etst '(do ((i 0 (+ 1 i)) (j 0 (+ 1 i))) ((= i 3)) (hiho 3)))
- (etst '(do ((i 0 (+ 1 i)) (j 0 (+ 1 i)) (k 0 (hiho k))) ((= i 3)) 0))
- (etst '(call/cc (lambda (bbreak) (let ((a 1)) (if (> a 0) (bbreak 3) (bbreak "hi"))))))
- (etst '(call/cc (lambda (bbreak) (let ((a 1)) (if (> a 0) (bbreak 3)) (bbreak "hi")))))
- (btst '(let ((a 1)) (or (> a 1) "hi")) #t)
- (btst '(let ((a 1)) (and (> a 1) "hi")) #f)
- (etst '(let ((v0 (make-vct 1)) (v1 (make-vct 1))) (set! v0 v1)))
-
- (itst '(cond ((> 1 0) 1)) 1)
- (itst '(cond ((> 1 0) 1) ((< 0 1) 2)) 1)
- (itst '(cond ((< 1 0) 1) ((< 0 1) 2)) 2)
- (itst '(cond ((< 1 0) 1) ((> 0 1) 2) (else 3)) 3)
- (itst '(cond ((< 1 0) 1) ((< 0 1) (* 3 2) 2) (else 3)) 2)
- (ftsta '(lambda (y) (cond ((> y 0.0) y) ((< y 0.0) (abs y)) (else (- y 100.0)))) 1.0 1.0)
- (ftsta '(lambda (y) (cond ((> y 0.0) y) ((< y 0.0) (abs y)) (else (- y 100.0)))) -1.0 1.0)
- (ftsta '(lambda (y) (cond ((> y 0.0) y) ((< y 0.0) (abs y)) (else (- y 100.0)))) 0.0 -100.0)
- (ftsta '(lambda (y) (cond ((> y 0.0) y) ((< y 0.0) (abs y)) (else (- y 100.0)))) 1.0 1.0)
- (set! dbl-var 0.0)
- (ftsta '(lambda (y) (cond ((> y 0.0) (let ((a (+ y 2))) (* a 2)))
- ((< y 0.0) (abs y))
- (else (set! dbl-var 1.0)
- (if (> dbl-var 0.0)
- (+ y (* dbl-var 2))
- (- y 100.0)))))
- 1.0 6.0)
- (if (fneq dbl-var 0.0) (snd-display #__line__ ";cond mid dbl (0.0): ~A" dbl-var))
- (ftsta '(lambda (y) (cond ((> y 0.0) (let ((a (+ y 2))) (* a 2)))
- ((< y 0.0) (abs y))
- (else (set! dbl-var 1.0)
- (if (> dbl-var 0.0)
- (+ y (* dbl-var 2))
- (- y 100.0)))))
- -1.0 1.0)
- (if (fneq dbl-var 0.0) (snd-display #__line__ ";cond dbl (0.0): ~A" dbl-var))
- (ftsta '(lambda (y) (cond ((> y 0.0) (let ((a (+ y 2))) (* a 2)))
- ((< y 0.0) (abs y))
- (else (set! dbl-var 1.0)
- (if (> dbl-var 0.0)
- (+ y (* dbl-var 2))
- (- y 100.0)))))
- 0.0 2.0)
- (if (fneq dbl-var 1.0) (snd-display #__line__ ";cond dbl (1.0): ~A" dbl-var))
- (ststa '(lambda (y) (cond ((> y 0.0) "hi") ((< y 0.0) "ho") (else "ha"))) 1.0 "hi")
- (ststa '(lambda (y) (cond ((> y 0.0) "hi") ((< y 0.0) "ho") (else "ha"))) 0.0 "ha")
- (ststa '(lambda (y) (cond ((> y 0.0) "hi") ((< y 0.0) "ho") (else "ha"))) -1.0 "ho")
-
- (let ((pv (list 123 321))) (run (set! int-var (car pv))))
- (if (not (= int-var 123)) (snd-display #__line__ ";car local pv: ~A" int-var))
-
- (btst '(list? list-var) #t)
- (btst '(list? int-var) #f)
- (btsta '(lambda (y) (list? list-var)) 0.0 #t)
- (btsta '(lambda (y) (list? dbl-var)) 0.0 #f)
- (run (set! int-var (car list-var)))
- (if (not (= int-var 2)) (snd-display #__line__ ";car run lst: ~A" int-var))
- (itsta '(lambda (y) (car list-var)) 0.0 2)
- (itsta '(lambda (y) (cadr list-var)) 0.0 3)
- (itsta '(lambda (y) (caddr list-var)) 0.0 4)
- (itsta '(lambda (y) (cadddr list-var)) 0.0 5)
- (itst '(car list-var) 2)
- (itst '(cadr list-var) 3)
- (itst '(caddr list-var) 4)
- (itst '(cadddr list-var) 5)
- (itst '(list-ref list-var 1) 3)
- (let ((lv (list 321 123))) (run (set! int-var (car lv))))
- (if (not (= int-var 321)) (snd-display #__line__ ";car run local lst: ~A" int-var))
- (let ((lv (list 321 123))) (run (set! int-var (cadr lv))))
- (if (not (= int-var 123)) (snd-display #__line__ ";cadr run local lst: ~A" int-var))
- (let ((lv (list 321 123))) (run (set! int-var (list-ref lv 0))))
- (if (not (= int-var 321)) (snd-display #__line__ ";list-ref 0 run local lst: ~A" int-var))
- (btst '(null? list-var) #f)
- (let ((lv '())) (run (set! int-var (if (null? lv) 1 0))))
- (if (not (= int-var 1)) (snd-display #__line__ ";null? run local lst: ~A" int-var))
- (itst '(length list-var) 4)
- (let ((lv (list 321 123))) (run (set! int-var (length lv))))
- (if (not (= int-var 2)) (snd-display #__line__ ";length run local lst: ~A" int-var))
-
- (itst '(cadr '(3 4)) 4)
- (btst '(null? '()) #t)
- (btst '(null? '(1)) #f)
- (itst '(vector-ref '#(0 1 2) 2) 2)
- (ftst '(vector-ref '#(0.1 1.1 2.1) 1) 1.1)
-
- (let ((val (run-eval '(lambda (v) (declare (v char)) (char->integer v)) #\b)))
- (if (not (= val 98)) (snd-display #__line__ ";char as arg to run: ~A" val)))
- (let ((val (run-eval '(lambda (v) (declare (v integer)) (+ 1 v)) 32)))
- (if (not (= val 33)) (snd-display #__line__ ";integer as arg to run: ~A" val)))
- (let ((val (run-eval '(lambda (v) (declare (v real)) (* v 2)) 1.3)))
- (if (fneq val 2.6) (snd-display #__line__ ";real as arg to run: ~A" val)))
- (let ((val (run-eval '(lambda (v) (declare (v string)) (string-length v)) "hiho")))
- (if (not (= val 4)) (snd-display #__line__ ";string as arg to run: ~A" val)))
- (let ((val (run-eval '(lambda (v) (declare (v boolean)) (not v)) #t)))
- (if val (snd-display #__line__ ";boolean as arg to run: ~A" val)))
- (let ((val (run-eval '(lambda (gen) (declare (gen clm)) (mus-frequency gen)) (make-oscil 440))))
- (if (fneq val 440.0) (snd-display #__line__ ";clm gen as arg to run: ~A" val)))
- (let ((val (run-eval '(lambda (v) (declare (v vct)) (vct-ref v 0)) (make-vct 3 1.5))))
- (if (fneq val 1.5) (snd-display #__line__ ";vct as arg to run: ~A" val)))
-
- (let* ((gen (make-oscil))
- (val (run (lambda () (mus-generator? gen)))))
- (if (not val) (snd-display #__line__ ";run mus-generator? oscil")))
- (let* ((gen (make-nssb))
- (val (run (mus-generator? gen))))
- (if (not val) (snd-display #__line__ ";run mus-generator? nssb")))
- (let* ((gen 123)
- (val (run (lambda () (mus-generator? gen)))))
- (if val (snd-display #__line__ ";run mus-generator? 123")))
-
- (let ((val (run-eval '(lambda (y) (let ((ge (make-env '(0 1 1 1) :length 11))) (env ge))) 0.0)))
- (if (fneq val 1.0) (snd-display #__line__ ";make-env in run: ~A" val)))
-
- (let ((val (run-eval '(lambda (y) (let ((ge (make-env l0111 :length 11))) (env ge))) 0.0)))
- (if (fneq val 1.0) (snd-display #__line__ ";make-env in run with var list: ~A" val)))
-#|
- (let ()
- (define-macro (run-hi a) `(+ 1 ,a))
- (let ((val (run (+ 1 (run-hi 2)))))
- (if (not (= val 4))
- (snd-display #__line__ ";run + macro: ~A" val))))
-|#
- (let ((x 0.0))
- (run
- (lambda ()
- (let ((e (make-env '(0 0 1 1) :length 11)))
- (env e)
- (set! x (env e))
- x)))
- (if (fneq x .1) (snd-display #__line__ ";make-env in run 0: ~A" x)))
-
- (let ((x 0.0)
- (samps 11)
- (data (vct 0 0 1 1)))
- (run
- (lambda ()
- (let ((e (make-env data :length samps)))
- (env e)
- (set! x (env e))
- x)))
- (if (fneq x .1) (snd-display #__line__ ";make-env in run 1: ~A" x)))
-
- (let ((x 0.0))
- (run
- (lambda ()
- (let* ((samps 11)
- (data (vct 0 0 1 1))
- (e (make-env data :length samps)))
- (env e)
- (set! x (env e))
- x)))
- (if (fneq x .1) (snd-display #__line__ ";make-env in run 2: ~A" x)))
-
- (let ((x 0.0))
- (run
- (lambda ()
- (let* ((samps 1)
- (data (vct 0 0 1 1))
- (e (make-env data :length (+ 10 samps))))
- (env e)
- (set! x (env e))
- x)))
- (if (fneq x .1) (snd-display #__line__ ";make-env in run 3: ~A" x)))
-
- (let ((x 0.0))
- (run
- (lambda ()
- (let* ((samps 1)
- (e (make-env (vct 0 0 1 1) :length (+ 10 samps) :scaler (hz->radians (/ (mus-srate) (* 2 pi))))))
- (env e)
- (set! x (env e))
- x)))
- (if (fneq x .1) (snd-display #__line__ ";make-env in run 4: ~A" x)))
-
- (btst '(let ((gen (make-all-pass))) (all-pass? gen)) #t)
- (btst '(let ((gen (make-all-pass))) (if gen #t #f)) #t)
- (btst '(let ((gen (make-moving-average))) (moving-average? gen)) #t)
- (btst '(let ((gen (make-moving-average))) (if gen #t #f)) #t)
- (btst '(let ((gen (make-asymmetric-fm))) (asymmetric-fm? gen)) #t)
- (btst '(let ((gen (make-comb))) (comb? gen)) #t)
- (btst '(let ((gen (make-filtered-comb))) (or (comb? gen) (filtered-comb? gen))) #t)
- (btst '(let ((gen (make-convolve :filter v-var))) (convolve? gen)) #t)
- (btst '(let ((gen (make-delay))) (delay? gen)) #t)
- (btst '(let ((gen (make-env '(0 0 1 1)))) (env? gen)) #t)
- (btst '(let ((gen (make-file->frame "oboe.snd"))) (file->frame? gen)) #t)
- (btst '(let ((gen (make-file->sample "oboe.snd"))) (file->sample? gen)) #t)
- (btst '(let ((gen (make-filter 8 v-var v-var))) (filter? gen)) #t)
- (btst '(let ((gen (make-fir-filter 8 v-var))) (fir-filter? gen)) #t)
- (btst '(let ((gen (make-firmant))) (firmant? gen)) #t)
- (btst '(let ((gen (make-formant))) (formant? gen)) #t)
- (btst '(let ((gen (make-frame 2))) (frame? gen)) #t)
- ;;(btst '(let ((gen (make-frame->file))) (frame->file? gen)) #t)
- (btst '(let ((gen (make-granulate))) (granulate? gen)) #t)
- (btst '(let ((gen (make-iir-filter 8 v-var))) (iir-filter? gen)) #t)
- (btst '(let ((gen (make-locsig))) (locsig? gen)) #t)
- (btst '(let ((gen (make-mixer 2))) (mixer? gen)) #t)
- (btst '(let ((gen (make-notch))) (notch? gen)) #t)
- (btst '(let ((gen (make-one-pole))) (one-pole? gen)) #t)
- (btst '(let ((gen (make-one-zero))) (one-zero? gen)) #t)
- (btst '(let ((gen (make-oscil 440.0))) (oscil? gen)) #t)
- (btst '(let ((gen (make-phase-vocoder))) (phase-vocoder? gen)) #t)
- (btst '(let ((gen (make-pulse-train))) (pulse-train? gen)) #t)
- (btst '(let ((gen (make-rand))) (rand? gen)) #t)
- (btst '(let ((gen (make-rand-interp))) (rand-interp? gen)) #t)
- (btst '(let ((gen (make-readin "oboe.snd"))) (readin? gen)) #t)
- ;;(btst '(let ((gen (make-sample->file))) (sample->file? gen)) #t)
- (btst '(let ((gen (make-sawtooth-wave))) (sawtooth-wave? gen)) #t)
- (btst '(let ((gen (make-nrxysin))) (nrxysin? gen)) #t)
- (btst '(let ((gen (make-nrxycos))) (nrxycos? gen)) #t)
- (btst '(let ((gen (make-square-wave))) (square-wave? gen)) #t)
- (btst '(let ((gen (make-src))) (src? gen)) #t)
- (btst '(let ((gen (make-ncos))) (ncos? gen)) #t)
- (btst '(let ((gen (make-nsin))) (nsin? gen)) #t)
- (btst '(let ((gen (make-ssb-am))) (ssb-am? gen)) #t)
- (btst '(let ((gen (make-table-lookup))) (table-lookup? gen)) #t)
- (btst '(let ((gen (make-triangle-wave))) (triangle-wave? gen)) #t)
- (btst '(let ((gen (make-two-pole))) (two-pole? gen)) #t)
- (btst '(let ((gen (make-two-zero))) (two-zero? gen)) #t)
- (btst '(let ((gen (make-wave-train))) (wave-train? gen)) #t)
- (btst '(let ((gen (make-polyshape))) (polyshape? gen)) #t)
- (btst '(let ((gen (make-polywave))) (polywave? gen)) #t)
-
- (btst '(let ((win (make-fft-window hamming-window 8))) (vct? win)) #t)
- (btst '(if #f (oscil #f) #t) #t)
- (btst '(if #f (mus-frequency #f) #t) #t)
- (btst '(if #f (set! (mus-frequency #f) 100.0) #t) #t)
-
- (ftst '(let ((gen (make-all-pass))) (all-pass gen)) 0.0)
- (ftst '(let ((gen (make-all-pass))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-all-pass))) (gen 0) (gen 0 0) (gen 0.0 0) (gen 0 0.0)) 0.0)
- (ftst '(let ((gen (make-moving-average))) (moving-average gen)) 0.0)
- (ftst '(let ((gen (make-moving-average))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-moving-average))) (gen 0) (gen 0 0) (gen 0.0 0) (gen 0 0.0)) 0.0)
- (ftst '(let ((gen (make-asymmetric-fm))) (asymmetric-fm gen 1.0)) 1.0)
- (ftst '(let ((gen (make-asymmetric-fm))) (gen)) 1.0)
- (ftst '(let ((gen (make-comb))) (comb gen)) 0.0)
- (ftst '(let ((gen (make-comb))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-filtered-comb :filter (make-one-zero .5 .5)))) (filtered-comb gen)) 0.0)
- (ftst '(let ((gen (make-filtered-comb :filter (make-one-zero .5 .5)))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-convolve :filter v-var))) (convolve gen)) 0.0)
- (ftst '(let ((gen (make-convolve :filter v-var))) (gen)) 0.0)
- (ftst '(let ((gen (make-delay))) (delay gen)) 0.0)
- (ftst '(let ((gen (make-delay))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-env '(0 0 1 1)))) (env gen)) 0.0)
- (ftst '(let ((gen (make-env '(0 0 1 1)))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-file->frame "oboe.snd"))) (frame-ref (file->frame gen 0) 0)) 0.0)
- (ftst '(let ((gen (make-file->sample "oboe.snd"))) (file->sample gen 0)) 0.0)
- (ftst '(let ((gen (make-file->sample "oboe.snd"))) (gen 0)) 0.0)
- (ftst '(let ((gen (make-filter 8 v-var v-var))) (filter gen)) 0.0)
- (ftst '(let ((gen (make-filter 8 v-var v-var))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-fir-filter 8 v-var))) (fir-filter gen)) 0.0)
- (ftst '(let ((gen (make-fir-filter 8 v-var))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-firmant))) (firmant gen)) 0.0)
- (ftst '(let ((gen (make-firmant))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-formant))) (formant gen)) 0.0)
- (ftst '(let ((gen (make-formant))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-frame 2))) (frame-ref gen 0)) 0.0)
- (ftst '(let ((gen (make-frame 2))) (gen 0) (gen 0.0) (gen 0.0 0.0)) 0.0)
- ;;(ftst '(let ((gen (make-frame->file))) (frame->file gen)) 0.0)
- (ftst '(let ((gen (make-granulate))) (granulate gen)) 0.0)
- (ftst '(let ((gen (make-granulate))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-iir-filter 8 v-var))) (iir-filter gen)) 0.0)
- (ftst '(let ((gen (make-iir-filter 8 v-var))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-locsig))) (locsig gen 0 0)) 0.0)
- (ftst '(let ((gen (make-locsig))) (gen 0.0)) 0.0)
- (ftst '(let ((gen (make-mixer 2))) (mixer-ref gen 0 0)) 0.0)
- (ftst '(let ((gen (make-mixer 2))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-mixer 2))) (gen 0.0 0) (gen 0 0) (gen 0) (gen 0 0.0)) 0.0)
- (ftst '(let ((gen (make-notch))) (notch gen)) 0.0)
- (ftst '(let ((gen (make-notch))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-one-pole))) (one-pole gen)) 0.0)
- (ftst '(let ((gen (make-one-pole))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-one-zero))) (one-zero gen)) 0.0)
- (ftst '(let ((gen (make-one-zero))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-oscil 440.0))) (oscil gen)) 0.0)
- (ftst '(let ((gen (make-oscil 440.0))) (gen)) 0.0)
- (ftst '(let ((gen (make-phase-vocoder))) (phase-vocoder gen)) 0.0)
- (ftst '(let ((gen (make-phase-vocoder))) (gen)) 0.0)
- (ftst '(let ((gen (make-pulse-train))) (pulse-train gen)) 1.0)
- (ftst '(let ((gen (make-pulse-train))) (gen)) 1.0)
- (btst '(let ((gen (make-rand))) (< (rand gen) 1.0)) #t)
- (btst '(let ((gen (make-rand))) (< (gen) 1.0)) #t)
- (btst '(let ((gen (make-rand-interp))) (< (rand-interp gen) 1.0)) #t)
- (btst '(let ((gen (make-rand-interp))) (< (gen) 1.0)) #t)
- (ftst '(let ((gen (make-readin "oboe.snd"))) (readin gen)) 0.0)
- (ftst '(let ((gen (make-readin "oboe.snd"))) (gen)) 0.0)
- ;;(ftst '(let ((gen (make-sample->file))) (sample->file gen)) 0.0)
- (ftst '(let ((gen (make-sawtooth-wave))) (sawtooth-wave gen)) 0.0)
- (ftst '(let ((gen (make-sawtooth-wave))) (gen)) 0.0)
- (ftst '(let ((gen (make-nrxysin))) (nrxysin gen)) 0.0)
- (ftst '(let ((gen (make-nrxysin))) (gen)) 0.0)
- (ftst '(let ((gen (make-nrxycos))) (nrxycos gen)) 1.0)
- (ftst '(let ((gen (make-nrxycos))) (gen)) 1.0)
- (ftst '(let ((gen (make-square-wave))) (square-wave gen)) 1.0)
- (ftst '(let ((gen (make-square-wave))) (gen)) 1.0)
- (ftst '(let ((gen (make-src))) (src gen)) 0.0)
- (ftst '(let ((gen (make-src))) (gen)) 0.0)
- (ftst '(let ((gen (make-ncos))) (ncos gen)) 1.0)
- (ftst '(let ((gen (make-ncos))) (gen)) 1.0)
- (ftst '(let ((gen (make-nsin))) (nsin gen)) 0.0)
- (ftst '(let ((gen (make-nsin))) (gen)) 0.0)
- (ftst '(let ((gen (make-ssb-am))) (ssb-am gen)) 0.0)
- (ftst '(let ((gen (make-ssb-am))) (gen)) 0.0)
- (ftst '(let ((gen (make-table-lookup))) (table-lookup gen)) 0.0)
- (ftst '(let ((gen (make-table-lookup))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-triangle-wave))) (triangle-wave gen)) 0.0)
- (ftst '(let ((gen (make-triangle-wave))) (gen)) 0.0)
- (ftst '(let ((gen (make-two-pole))) (two-pole gen)) 0.0)
- (ftst '(let ((gen (make-two-pole))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-two-zero))) (two-zero gen)) 0.0)
- (ftst '(let ((gen (make-two-zero))) (gen) (gen 0.0) (gen 0.0 0.0)) 0.0)
- (ftst '(let ((gen (make-wave-train))) (wave-train gen)) 0.0)
- (ftst '(let ((gen (make-wave-train))) (gen)) 0.0)
- (ftst '(let ((gen (make-polyshape))) (polyshape gen)) 1.0)
- (ftst '(let ((gen (make-polyshape))) (gen 1.0)) 1.0) ;; 1.0 needed for index in this case (filled in by hand in the previous case)
- (ftst '(let ((gen (make-polywave))) (polywave gen)) 1.0)
- (ftst '(let ((gen (make-polywave))) (gen)) 1.0)
-
- (ftst '(let ((win (make-fft-window hamming-window 8))) (vct-ref win 0)) 0.08)
-
- (ftst '(let ((gen (make-delay 3 :initial-contents '(0.5 1.0 1.0)))) (if (delay? gen) (delay gen) 0.0)) 0.5)
- (ftst '(let ((gen (make-delay 3 :initial-element .1))) (if (delay? gen) (delay gen) 0.0)) 0.1)
- (ftst '(let ((gen1 (make-delay 3 :initial-element .3))
- (gen2 (make-delay 3 :initial-contents '(.1 .2 .3))))
- (if (and (delay? gen1)
- (delay? gen2))
- (+ (delay gen1) (delay gen2))
- 0.0))
- 0.4)
-
- (let ((tst 0.0))
- (run (set! tst (st3-one svar)))
- (if (not (= tst 1)) (snd-display #__line__ ";run st3-one: ~A ~A" tst (st3-one svar)))
- (run (set! bst3 (st3? svar)))
- (if (not bst3) (snd-display #__line__ ";st3? ~A" (st3? svar))))
-
- (set! svar (make-st4))
- (let ((tst 0))
- (run (set! tst (st4-one svar)))
- (if (not (= tst 1)) (snd-display #__line__ ";run st4-one: ~A ~A" tst (st4-one svar)))
- (ftst '(st4-two svar) 2.0)
- (run (set! bst4 (st4? svar)))
- (if (not bst4) (snd-display #__line__ ";st4? ~A ~A" svar (st4? svar))))
-
- (set! svar (make-st3 :one 1.0 :two 2.0))
- (set! svar1 (make-st3 :one 2.0 :two 3.0))
- (let ((tst 0.0)
- (tst1 0.0)
- (tst2 0.0)
- (tst3 0.0))
- (run
- (set! tst1 (st3-two svar1)) ;3
- (set! (st3-two svar) (st3-two svar1))
- (set! tst2 (st3-two svar)) ;3
- (set! (st3-one svar1) 123.0)
- (set! tst3 (st3-one svar1))) ;123
- (if (fneq tst 2) (snd-display #__line__ ";run st3-two (2): ~A ~A" tst (st3-two svar)))
- (if (fneq tst1 3) (snd-display #__line__ ";run st3-two (3): ~A ~A" tst (st3-two svar1)))
- (if (fneq tst2 3) (snd-display #__line__ ";run st3-two (2->3): ~A ~A" tst (st3-two svar)))
- (if (fneq tst3 123) (snd-display #__line__ ";run st3-one (123): ~A ~A" tst (st3-one svar1))))
-
- ;; restore tests
- (if (fneq (st3-one svar) 1.0) (snd-display #__line__ ";restore st3-one (1): ~A" (st3-one svar)))
- (if (fneq (st3-one svar1) 123.0) (snd-display #__line__ ";restore st3-one (123): ~A" (st3-one svar1)))
- (if (fneq (st3-two svar) 3.0) (snd-display #__line__ ";restore st3-two (2->3): ~A" (st3-two svar)))
- (if (fneq (st3-two svar1) 3.0) (snd-display #__line__ ";restore st3-two (3): ~A" (st3-two svar1)))
-
- (let ((val (run-eval '(lambda (y) (declare (y hiho1)) (hiho1-ii y)) hi1)))
- (if (not (= val 3)) (snd-display #__line__ ";typed hiho1-ii: ~A" val)))
- (let ((val (run-eval '(lambda (y) (declare (y hiho1)) (hiho1-xx y)) hif2)))
- (if (or (not (number? val)) (fneq val 3.14)) (snd-display #__line__ ";typed hiho1-xx: ~A" val)))
- (let ((val (run-eval '(lambda (x y) (declare (x hiho1) (y hiho1)) (+ (hiho1-xx y) (hiho1-xx x))) hi1 hif2)))
- (if (or (not (number? val)) (fneq val 4.14)) (snd-display #__line__ ";typed hiho1-xx+xx: ~A" val)))
- (let ((val (run-eval '(lambda (y) (declare (y hiho1)) y) hi1)))
- (if (not (hiho1? val)) (snd-display #__line__ ";clm-struct return: ~A" val)))
- (let ((tag (catch 'cannot-parse
- (lambda () (run-eval '(set! (hiho1-ii hi1) "ho")))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse))
- (snd-display #__line__ ";set defgenerator type check? ~A" tag)))
- (let ((tag (catch 'cannot-parse
- (lambda () (run-eval '(let ((r (make-sampler))) (format #f "~A" r))))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse))
- (snd-display #__line__ ";format arg type check? ~A" tag)))
-
- ;; this is testing a missing quote??
- (let ((tag (catch #t (lambda () (run-eval (lambda () (eq? .3 .2)))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";cannot parse case: ~A" tag)))
-
- (let ((val (run-eval '(lambda (y) (declare (y hiho2)) (vct-ref (hiho2-v y) 1)) hi2)))
- (if (fneq val .1) (snd-display #__line__ ";typed hiho2-v: ~A" val))
- (run-eval '(lambda (y) (declare (y hiho2)) (vct-set! (hiho2-v y) 2 3.14)) hi2)
- (if (fneq (vct-ref (hiho2-v hi2) 2) 3.14)
- (snd-display #__line__ ";vct-set hiho2-v: ~A" (vct-ref (hiho2-v hi2) 2))))
- (let ((val (run-eval '(lambda (y) (declare (y hiho2)) (hiho2-i y)) hi2)))
- (if (not (= val 0)) (snd-display #__line__ ";typed hiho2-i: ~A" val))
- (set! val (run-eval '(lambda (y) (declare (y hiho2)) (set! (hiho2-i y) 2) (hiho2-i y)) hi2))
- (if (not (= val 2)) (snd-display #__line__ ";inner set hiho2-i: ~A" val)))
- (let ((val (run-eval '(lambda (y) (declare (y hiho2)) (hiho2-x y)) hi2)))
- (if (fneq val 0.0) (snd-display #__line__ ";hiho2-x: ~A" val))
- (set! val (run-eval '(lambda (y) (declare (y hiho2)) (set! (hiho2-x y) 3.14) (hiho2-x y)) hi2))
- (if (fneq val 3.14) (snd-display #__line__ ";inner set hiho2-x: ~A" val)))
-
- ;; this tests the fallback process
- (let ((lst (list 1 2 (vct-fill! (make-vct 4) 3.14) 3))
- (k 123.0))
- (run (set! k (vct-ref (list-ref lst 2) 1)))
- (if (fneq k 3.14) (snd-display #__line__ ";list-ref ->vct: ~A" k)))
-
- (itst '(mus-sound-samples "oboe.snd") 50828)
- (itst '(mus-sound-length "oboe.snd") 101684)
- (itst '(mus-sound-frames "oboe.snd") 50828)
- (itst '(mus-sound-data-location "oboe.snd") 28)
- (itst '(mus-sound-chans "oboe.snd") 1)
- (itst '(mus-sound-srate "oboe.snd") 22050)
- (itst '(mus-sound-header-type "oboe.snd") mus-next)
- (itst '(mus-sound-data-format "oboe.snd") mus-bshort)
- (ftst '(mus-sound-duration "oboe.snd") 2.305)
- (stst '(mus-sound-comment "4.aiff") ";Written Tue 26-Nov-96 14:55 PST by bil at bill (Silicon Graphics Iris 4D) using Allegro CL, clm of 21-Nov-96")
- (itst '(mus-sound-datum-size "oboe.snd") 2)
- (itst '(mus-sound-length "oboe.snd") (+ 28 (* 2 50828)))
- (itst '(mus-sound-header-type "oboe.snd") mus-next)
- (itst '(mus-sound-data-format "oboe.snd") mus-bshort)
- (stst '(mus-data-format-name mus-bshort) "big endian short (16 bits)")
- (etst '(mus-data-format-name 3.14))
- (stst '(mus-header-type-name mus-aifc) "AIFC")
- (stst '(mus-header-type-name (mus-sound-header-type "oboe.snd")) "Sun/Next")
- (etst '(mus-header-type-name "hiho"))
- (itst '(mus-bytes-per-sample mus-bshort) 2)
- (etst '(make-vct 3 "hi"))
- (btst '(let* ((file "oboe.snd")
- (str (string-append file ": chans: "
- (number->string (mus-sound-chans file))
- ", srate: "
- (number->string (mus-sound-srate file))
- ", "
- (mus-header-type-name (mus-sound-header-type file))
- ", "
- (mus-data-format-name (mus-sound-data-format file))
- ", len: "
- (number->string
- (exact->inexact (/ (mus-sound-samples file)
- (* (mus-sound-chans file) (mus-sound-srate file))))))))
- (or (string=? str "oboe.snd: chans: 1, srate: 22050, Sun/Next, big endian short (16 bits), len: 2.30512475967407")
- (string=? str "oboe.snd: chans: 1, srate: 22050, Sun/Next, big endian short (16 bits), len: 2.30512471655329")
- (string=? str "oboe.snd: chans: 1, srate: 22050, Sun/Next, big endian short (16 bits), len: 2.305124716553287989")))
- #t)
-
- (let ((old-srate (mus-srate)))
- (set! (mus-srate) 22050)
- (ftst '(mus-sound-duration "oboe.snd") 2.30512)
- (stst '(mus-sound-comment "1.snd") ";Written Tue 2-Jul-102 at 12:09 MDT by bil at goggle (Linux/X86) using Allegro CL, clm of 3-July-02")
- (ftst '(radians->hz 2.84951704088598e-4) 1.0)
- (ftst '(radians->degrees 1.0) 57.2957801818848)
- (ftst '(degrees->radians 57.2957801818848) 1.0)
- (ftst '(linear->db .25) -12.0411996841431)
- (ftst '(db->linear -12.0411996841431) .25)
- (ftsta '(lambda (y) (radians->hz y)) 2.84951704088598e-4 1.0)
- (ftsta '(lambda (y) (radians->degrees y)) 1.0 57.2957801818848)
- (ftsta '(lambda (y) (degrees->radians y)) 57.2957801818848 1.0)
- (ftsta '(lambda (y) (linear->db y)) .25 -12.0411996841431)
- (ftsta '(lambda (y) (db->linear y)) -12.0411996841431 .25)
- (ftst '(ring-modulate .4 .5) .2)
- (ftst '(amplitude-modulate 1.0 .5 .4) .7)
- (ftst '(contrast-enhancement 0.1 0.75) (sin (+ (* 0.1 (/ pi 2)) (* .75 (sin (* 0.1 2.0 pi))))))
- (itst '(seconds->samples 1.0) 22050)
- (itst '(seconds->samples 1) 22050)
-
- (etst '(mus-sound-samples 1))
- (etst '(mus-sound-length 3.14))
- (etst '(mus-sound-frames #\c))
- (etst '(mus-sound-data-location 1))
- (etst '(mus-sound-chans 1))
- (etst '(mus-sound-srate 3.14))
- (etst '(mus-sound-header-type #\v))
- (etst '(mus-sound-data-format 1))
- (etst '(mus-sound-duration 1))
- (etst '(mus-sound-comment 3.14))
- (etst '(mus-sound-datum-size #\c))
- (etst '(mus-sound-length 1))
- (etst '(frames 0 1 2 3))
- (etst '(edit-position 0 1 2))
- (etst '(cursor 0 1 2))
- (etst '(report-in-minibuffer "hi" 0 1 2))
- (etst '(vct-ref (make-vct 2) 3.14))
- (etst '(make-vct 2 3 4))
- (etst '(make-vct 2 1))
-
- (set! g-gen (make-oscil 440.0))
- (ftst '(mus-frequency g-gen) 440.0)
- (ftst '(mus-phase g-gen) 0.0)
- (ftst '(oscil g-gen) 0.0)
- (ftst '(mus-phase g-gen) 0.125)
- (run-eval '(set! (mus-frequency g-gen) 100.0))
- (ftst '(mus-frequency g-gen) 100.0)
- (ftst '(g-gen) .125)
- (ftst '(g-gen 1.0) 0.153)
- (ftst '(g-gen 0.0 0.0) 0.925)
- (ftst '(g-gen 0.0 1.0) 0.802)
- (etst '(oscil g-gen 1.0 2.0 3.0))
-
- (ftst '(mus-srate) 22050.0)
- ;(ftst '(set! (mus-srate) 44100.0) 44100.0)
- ;(ftst '(set! (mus-srate) 22050) 22050.0)
- ;(etst '(mus-srate 0.0))
- ;(etst '(set! (mus-srate) "hi"))
- (btst '(< (mus-random 1.0) 2.0) #t)
- (btst '(>= (mus-random 1.0) -1.0) #t)
- (set! (mus-srate) old-srate))
-
- (let ((mx 0.0)
- (mn 0.0))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (let ((val (mus-random 1.0)))
- (if (or (= i 0) (< val mn)) (set! mn val))
- (if (or (= i 0) (> val mx)) (set! mx val)))))
- (if (= mx mn)
- (snd-display #__line__ ";optimized mus-random is a constant: ~A" mx)
- (begin
- (if (< (- mx mn) 1.0) (snd-display #__line__ ";optimized mus-random range: ~A ~A" mn mx))
- (if (or (>= mn 0.0) (<= mx 0.0)) (snd-display #__line__ ";optimized mus-random range odd: ~A ~A" mn mx)))))
-
- (let ((mx 0.0)
- (mn 0.0))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (let ((val (random 1.0)))
- (if (or (= i 0) (< val mn)) (set! mn val))
- (if (or (= i 0) (> val mx)) (set! mx val)))))
- (if (= mx mn)
- (snd-display #__line__ ";optimized random is a constant: ~A" mx)
- (begin
- (if (< (- mx mn) 0.5) (snd-display #__line__ ";optimized random range: ~A ~A" mn mx))
- (if (or (< mn 0.0) (> mx 1.0)) (snd-display #__line__ ";optimized random range odd: ~A ~A" mn mx)))))
+ (define (fv165) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 4.5 3/2)))))
+ (test (fv165) (float-vector 6.0 6.0 6.0 6.0))
- (if with-gui
- (let* ((ind (sound->integer (open-sound "oboe.snd")))
- (reg (make-region 0 10))
- (mrk (add-mark 123))
- (reg-val -100.0))
- (set! (mark-sync mrk) 1234)
- (btst '(sampler? (make-sampler)) #t)
- (btst '(let ((a (make-sampler))) (and (eq? a a) (eqv? a a) (equal? a a))) #t)
- (btst '(let ((a (make-sampler)) (b (make-sampler))) (or (eq? a b) (eqv? a b) (equal? a b))) #f)
- (let ((ok #f))
- (run (set! ok (sound? ind)))
- (if (not ok) (snd-display #__line__ ";run sound?")))
- (let ((ok #f))
- (run (set! ok (sound? (+ 1 ind))))
- (if ok (snd-display #__line__ ";run not sound?")))
- (let ((val (run (sample 1000))))
- (if (fneq val .0328) (snd-display #__line__ ";run 1 sample 1000: ~A" val)))
- (let ((val (run (sample 1000 ind 0))))
- (if (fneq val .0328) (snd-display #__line__ ";run 2 sample 1000: ~A" val)))
- (let ((val (run (sample 1000 ind 0 -1))))
- (if (fneq val .0328) (snd-display #__line__ ";run 3 sample 1000: ~A" val)))
- (let ((val (run (sample 1000 ind 0 0))))
- (if (fneq val .0328) (snd-display #__line__ ";run 4 sample 1000: ~A" val)))
- (if (string? (temp-dir))
- (let ((str "hiho")
- (str1 (temp-dir)))
- (run (set! str (temp-dir)))
- (if (not (string=? str str1)) (snd-display #__line__ ";run temp-dir: ~A ~A" str str1))))
- (if (string? (save-dir))
- (let ((str "hiho")
- (str1 (save-dir)))
- (run (set! str (save-dir)))
- (if (not (string=? str str1)) (snd-display #__line__ ";run save-dir: ~A ~A" str str1))))
- (let ((mx (selection-chans))
- (mx1 -1))
- (run (set! mx1 (selection-chans)))
- (if (not (= mx mx1)) (snd-display #__line__ ";run selection-chans: ~A ~A" mx mx1)))
- (close-sound ind)))
+ (define (fv166) (let ((x 1/2) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1 x)))))
+ (test (fv166) (float-vector 1.5 1.5 1.5 1.5))
- (let* ((ind (open-sound "oboe.snd"))
- (gen (make-snd->sample ind))
- (v0 (make-vct 10))
- (v1 (channel->vct 1490 10 ind 0)))
- (run
- (if (snd->sample? gen)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v0 i (snd->sample gen (+ 1490 i))))))
- (if (not (vequal v0 v1))
- (snd-display #__line__ ";snd->sample: ~A ~A" v0 v1))
- (close-sound ind)
- (set! ind (open-sound "2.snd"))
- (set! v1 (channel->vct 10 10 ind 1))
- (set! gen (make-snd->sample ind))
- (run
- (if (snd->sample? gen)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (vct-set! v0 i (snd->sample gen (+ 10 i) 1)))))
- (if (not (vequal v0 v1))
- (snd-display #__line__ ";snd->sample chn 1: ~A ~A" v0 v1))
- (close-sound ind))
+ (define (fv167) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 6.0)))))
+ (test (fv167) (float-vector 6.0 6.0 6.0 6.0))
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-ref v 1)) 1.0)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-scale! v 2.0) (vct-ref v 1)) 2.0)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-offset! v 2.0) (vct-ref v 1)) 3.0)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-offset! v 2.0) (vct-peak v)) 3.0)
- (ftst '(let ((v (make-vct 3))) (vct-fill! v 1.0) (vct-ref (vct-copy v) 1)) 1.0)
- (itst '(let ((v (make-vct 3))) (vct-length v)) 3)
- (btst '(let ((v (make-vct 3))) (vct? v)) #t)
- (ftst '(let ((v0 (make-vct 3)) (v1 (make-vct 3))) (vct-fill! v0 1.0) (vct-fill! v1 2.0) (vct-ref (vct-multiply! v0 v1) 1)) 2.0)
- (ftst '(let ((v0 (make-vct 3)) (v1 (make-vct 3))) (vct-fill! v0 1.0) (vct-fill! v1 2.0) (vct-ref (vct-add! v0 v1) 1)) 3.0)
- (ftst '(let ((v0 (make-vct 3)) (v1 (make-vct 3))) (vct-fill! v0 1.0) (vct-fill! v1 2.0) (vct-ref (vct-subtract! v0 v1) 1)) -1.0)
- (ftsta '(lambda (y) (declare (y vct)) (vct-ref y 1)) global-v 1.0)
-
- (let ((a 0) (v (make-vct 1)))
- (vct-map! v (lambda () (do ((i 0 (+ 1 i))) ((= i 3) a) (set! a (+ 1 a)))))
- (if (not (= a 3)) (snd-display #__line__ ";i a: ~A" a)))
- (let ((a 0.0) (v (make-vct 1)))
- (vct-map! v (lambda () (do ((i 0 (+ 1 i))) ((= i 3) a) (set! a (+ a 0.5)))))
- (if (not (= a 1.5)) (snd-display #__line__ ";f a: ~A" a)))
- (let ((a "hi") (v (make-vct 1)))
- (vct-map! v (lambda () (do ((i 0 (+ 1 i))) ((= i 3) 0.0) (set! a "ho"))))
- (if (not (string=? a "ho")) (snd-display #__line__ ";s a: ~A" a)))
- (itst '(do ((i 0 (+ 1 i))) ((= i 3) 0) (vct-scale! (make-vct 3) 1.0)) 0)
- (let ((v (make-vct 8)))
- (vct-set! v 4 1.0)
- (run (vct-move! v 0 1))
- (if (not (vequal v (vct 0 0 0 1 0 0 0 0)))
- (snd-display #__line__ ";vct-move! in run: ~A" v)))
-
- (let ((vect (make-vector 2 1.5))
- (v (make-vct 2)))
- (vct-map! v (lambda () (vector-ref vect 0)))
- (if (fneq (vct-ref v 0) 1.5) (snd-display #__line__ ";f1.5 vector-ref: ~A" v)))
-
- (let ((vect (make-vector 2 1))
- (v (make-vct 2))
- (i 0))
- (vct-map! v (lambda () (set! i (vector-ref vect 0)) 0.0))
- (if (not (= i 1)) (snd-display #__line__ ";i1 vector-ref: ~A" i)))
-
- (let ((vect (make-vector 2))
- (v (make-vct 2))
- (i 0))
- (vector-set! vect 0 (make-vct 2 3.0))
- (vector-set! vect 1 (make-vct 2 4.0))
- (vct-map! v (lambda () (vct-ref (vector-ref vect 0) 0)))
- (if (fneq (vct-ref v 0) 3.0) (snd-display #__line__ ";v3.0 vector-ref: ~A" v)))
-
- (let ((vect (make-vector 2 1.5))
- (v (make-vct 2)))
- (vct-map! v (lambda () (vector-fill! vect 2.0) (vector-ref vect 0)))
- (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";f2.0 vector-fill: ~A" v)))
-
- (let ((vect (make-vector 2 1))
- (v (make-vct 2))
- (i 0))
- (vct-map! v (lambda () (vector-fill! vect 32) (set! i (vector-ref vect 0)) 0.0))
- (if (not (= i 32)) (snd-display #__line__ ";i32 vector-fill: ~A" i)))
-
- (let ((vect (make-vector 2 1.5))
- (v (make-vct 2)))
- (vct-map! v (lambda () (exact->inexact (vector-length vect))))
- (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";f2.0 vector-length: ~A" v)))
-
- (let ((vect (make-vector 2 1))
- (v (make-vct 2))
- (i 0))
- (vct-map! v (lambda () (set! i (vector-length vect)) 0.0))
- (if (not (= i 2)) (snd-display #__line__ ";i2 vector-length: ~A" i)))
-
- (let ((vect (make-vector 2))
- (v (make-vct 2))
- (i 0))
- (vector-set! vect 0 (make-vct 2 3.0))
- (vector-set! vect 1 (make-vct 2 4.0))
- (vct-map! v (lambda () (inexact->exact (vector-length vect))))
- (if (fneq (vct-ref v 0) 2.0) (snd-display #__line__ ";v2.0 vector-length: ~A" v)))
-
- (let ((vect (make-vector 2 1.5))
- (v (make-vct 2)))
- (vct-map! v (lambda () (vector-set! vect 0 32.0) (vector-ref vect 0)))
- (if (fneq (vct-ref v 0) 32.0) (snd-display #__line__ ";f32.0 vector-set: ~A" v)))
-
- (let ((vect (make-vector 2 1))
- (v (make-vct 2))
- (i 0))
- (vct-map! v (lambda () (vector-set! vect 0 123) (set! i (vector-ref vect 0)) 0.0))
- (if (not (= i 123)) (snd-display #__line__ ";i123 vector-set: ~A" i)))
-
- (let ((vect (make-vector 3 32))
- (v (make-vct 3)))
- (vct-map! v (lambda () (vector-set! vect 0 123) 0.0))
- (if (not (= (vector-ref vect 0) 123)) (snd-display #__line__ ";i vect set: ~A" vect)))
-
- (let ((vect (make-vector 3 32.0))
- (v (make-vct 3)))
- (vct-map! v (lambda () (vector-set! vect 0 123.0) 0.0))
- (if (fneq (vector-ref vect 0) 123.0) (snd-display #__line__ ";f vect set: ~A" vect)))
-
- (let ((vect (make-vector 3))
- (v (make-vct 3))
- (zero 0.0)
- (gen (make-oscil 440)))
- (vector-set! vect 0 (make-oscil 440))
- (vector-set! vect 1 (make-oscil 440))
- (vector-set! vect 2 (make-oscil 440))
- (vct-map! v (lambda ()
- (let ((val (vector-ref vect 0)))
- (oscil val 0.0))))
- (if (and (not (vequal v (vct 0.0 0.125 0.248)))
- (not (vequal v (vct 0.0 0.063 0.125))))
- (snd-display #__line__ ";vect gen vct-map 1.0: ~A" v))
- (vct-map! v (lambda ()
- (let ((val (vector-ref vect 0)))
- (oscil val zero))))
- (if (and (not (vequal v (vct 0.367 0.481 0.587)))
- (not (vequal v (vct 0.187 0.248 0.308))))
- (snd-display #__line__ ";vect gen vct-map 1.0 (phase): ~A" v)))
-
- (vector-set! clm_vector 0 (make-oscil))
- (vector-set! clm_vector 1 (make-two-pole .1 .1))
- (btsta '(lambda (y) (declare (y clm-vector)) (oscil? (vector-ref y 0))) clm_vector #t)
- (btsta '(lambda (y) (declare (y clm-vector)) (oscil? (vector-ref y 1))) clm_vector #f)
- (itsta '(lambda (y) (declare (y clm-vector)) (vector-length y)) clm_vector 2)
-
- (vector-set! vct_vector 0 (make-vct 2))
- (vector-set! vct_vector 1 (make-vct 3))
- (btsta '(lambda (y) (declare (y vct-vector)) (= (vct-length (vector-ref y 0)) 2)) vct_vector #t)
- (itsta '(lambda (y) (declare (y vct-vector)) (vector-length y)) vct_vector 2)
-
- (let ((tag (catch #t
- (lambda ()
- (run-eval '(lambda (y) (declare (y vct)) (vct-ref y 1))))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-number-of-args)) (snd-display #__line__ ";wrong num args to run-eval: ~A" tag)))
-
- (let ((vect (make-vector 3))
- (v (make-vct 3))
- (gen (make-oscil 440)))
- (vector-set! vect 0 (make-oscil 440))
- (vector-set! vect 1 (make-oscil 440))
- (vector-set! vect 2 (make-oscil 440))
- (vct-map! v (lambda ()
- (let ((val (vector-ref vect 0)))
- (vector-set! vect 0 gen)
- (vector-fill! vect gen)
- (oscil val 0.0))))
- (if (and (not (vequal v (vct 0.0 0.0 0.125)))
- (not (vequal v (vct 0.000 0.000 0.063))))
- (snd-display #__line__ ";vect gen set vct-map 1.0: ~A" v)))
-
- (let ((vect (make-vector 1))
- (v (make-vct 3))
- (gen (make-oscil 440)))
- (vector-set! vect 0 gen)
- (vct-map! v (lambda ()
- (oscil (vector-ref vect 0) 0.0)))
- (if (and (not (vequal v (vct 0.0 0.125 0.248)))
- (not (vequal v (vct 0.000 0.063 0.125))))
- (snd-display #__line__ ";vect[0] gen set vct-map 1.0: ~A" v)))
-
- (let ((vect (make-vector 1))
- (v (make-vct 3))
- (gen (make-oscil 440)))
- (vector-set! vect 0 gen)
- (vct-map! v (lambda ()
- ((vector-ref vect 0) 0.0)))
- (if (and (not (vequal v (vct 0.0 0.125 0.248)))
- (not (vequal v (vct 0.000 0.063 0.125))))
- (snd-display #__line__ ";[vect] gen set vct-map 1.0: ~A" v)))
-
- (let ((vect (make-vector 3))
- (v (make-vct 3))
- (v1 (make-vct 3)))
- (vector-set! vect 0 (make-vct 3 0.25))
- (vector-set! vect 1 (make-vct 3 0.5))
- (vector-set! vect 2 (make-vct 3 1.0))
- (vct-map! v (lambda ()
- (let ((val (vector-ref vect 0)))
- (vct-ref val 0))))
- (if (not (vequal v (vct 0.25 0.25 0.25))) (snd-display #__line__ ";vect vct vct-map 1.0: ~A" v)))
-
- (let ((vect (make-vector 3))
- (v (make-vct 3))
- (v1 (make-vct 3 2.0)))
- (vector-set! vect 0 (make-vct 3 0.25))
- (vector-set! vect 1 (make-vct 3 0.5))
- (vector-set! vect 2 (make-vct 3 1.0))
- (vct-map! v (lambda ()
- (let ((val (vector-ref vect 0)))
- (vector-set! vect 0 v1)
- (vector-fill! vect v1)
- (vct-ref val 0))))
- (if (not (vequal v (vct 0.25 2.0 2.0))) (snd-display #__line__ ";vect vct set vct-map 1.0: ~A" v)))
-
- (if (not (string=? (mus-describe (make-frame)) "frame[1]: [0.000]")) (snd-display #__line__ ";make-frame 0 args: ~A" (mus-describe (make-frame))))
-
- (let ((v1 (make-vector 3 1.5))
- (v2 (make-vector 3 32))
- (v3 (make-vct 3))
- (vp #f))
- (vct-map! v3
- (lambda ()
- (vector-set! v2 0 1)
- (vector-set! v1 0 3.14)
- (set! vp (vector? v2))
- (+ (vector-ref v2 0) (vector-ref v1 0))))
- (if (or (not (vequal v3 (vct 4.14 4.14 4.14)))
- (not (= (vector-ref v2 0) 1))
- (not (= (vector-ref v2 1) 32))
- (fneq (vector-ref v1 0) 3.14)
- (fneq (vector-ref v1 1) 1.5)
- (not vp))
- (snd-display #__line__ ";run vector-set: ~A ~A ~A ~A" v1 v2 v3 vp)))
-
- (let ((oscs (vector (make-oscil 440.))))
- (let ((val (run (outa 0 (oscil (oscs 0)))
- (outa 0 (oscil (oscs 0))))))
- (if (fneq val 0.06265)
- (snd-display #__line__ ";run clm vector: ~A" val))))
-
- (let ((v (vector 1 2 3 4)))
- (let ((val (run (outa 0 (* .1 (v 1))))))
- (if (fneq val 0.2)
- (snd-display #__line__ ";run int vector: ~A" val))))
-
- (let ((v (vector (vct .1 .2 .3))))
- (let ((val (run (outa 0 (* .1 ((v 0) 1))))))
- (if (fneq val 0.02)
- (snd-display #__line__ ";run vct vector: ~A" val))))
-
- (let ((v (vector 1 2 3)))
- (let ((val (run (set! (v 1) 32) (v 1))))
- (if (not (= val 32))
- (snd-display #__line__ ";run set int vector: ~A" val))))
-
- (let ((v1 (vector (vct 1 2 3))))
- (let ((val (run ((v1 0) 1))))
- (if (fneq val 2.0)
- (snd-display #__line__ ";run vct + vector: ~A" val))))
-
-
- (let ((rdat (make-vct 16))
- (idat (make-vct 16))
- (v (make-vct 1)))
- (do ((i 0 (+ 1 i)))
- ((= i 16))
- (vct-set! rdat i 0.0)
- (vct-set! idat i 0.0))
- (vct-set! rdat 3 1.0)
- (vct-map! v (lambda ()
- (mus-fft rdat idat)
- (mus-fft rdat idat 16 -1)
- 0.0))
- (if (or (fneq (vct-ref rdat 3) 16.0)
- (fneq (vct-ref rdat 4) 0.0))
- (snd-display #__line__ ";run vct fft real[3 or 4]: ~A ~A?" (vct-ref rdat 3) (vct-ref rdat 4)))
- (vct-fill! rdat 0.0)
- (vct-fill! idat 0.0)
- (vct-set! rdat 3 1.0)
- (vct-map! v (lambda ()
- (mus-fft rdat idat 16)
- (mus-fft rdat idat 16 -1)
- 0.0))
- (if (or (fneq (vct-ref rdat 3) 16.0)
- (fneq (vct-ref rdat 4) 0.0))
- (snd-display #__line__ ";run vct fft (2) real[3 or 4]: ~A ~A?" (vct-ref rdat 3) (vct-ref rdat 4)))
- (catch #t (lambda () (vct-map! v (lambda () (mus-fft rdat idat 16 1.5)))) (lambda args args)))
-
- (etst '(let ((v0 (make-vct 3))) (polynomial v0 0.0 123)))
- (etst '(let ((v0 (make-vct 3))) (vct-ref v0 "hiho")))
- (etst '(let ((v0 (make-vct 3))) (vct-set! v0 "hiho" 3.1)))
-
- (let ((v0 (make-vct 10))
- (v1 (make-vct 10))
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (vct-fill! v0 1.0)
- (multiply-arrays v0 v1 1)
- 0.0))
- (if (not (vequal v0 (vct 0.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0)))
- (snd-display #__line__ ";run multiply-arrays[0]: ~A?" v0)))
-
- (let ((v (make-vct 3 1.5))
- (v1 (make-vct 1)))
- (vct-map! v1 (lambda ()
- (clear-array v)
- 1.0))
- (if (not (vequal v (vct 0.0 0.0 0.0)))
- (snd-display #__line__ ";run clear-array: ~A" v)))
-
- (let ((osc (make-oscil 440.0))
- (v (make-vct 1))
- (frq 0.0)
- (phs 1234.0)
- (cs 0))
- (vct-map! v
- (lambda ()
- (set! frq (mus-frequency osc))
- (set! phs (mus-phase osc))
- (set! cs (mus-length osc))
- (set! (mus-frequency osc) 123.0)
- (set! (mus-phase osc) 1.0)
- 0.0))
- (if (fneq frq 440.0) (snd-display #__line__ ";run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display #__line__ ";run phs: ~A" phs))
- (if (not (= cs 1)) (snd-display #__line__ ";run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";run mus-phase: ~A" (mus-phase osc))))
-
- (let ((v (make-vct 10))
- (gen1 (make-oscil 440))
- (gen2 (make-oscil 440)))
- (vct-map! v (lambda () (+ (gen1) (gen2))))
- (if (and (not (vequal v (vct 0.000 0.250 0.496 0.735 0.962 1.173 1.367 1.538 1.686 1.807)))
- (not (vequal v (vct 0.000 0.125 0.250 0.374 0.496 0.617 0.735 0.850 0.962 1.069))))
- (snd-display #__line__ ";gen+gen vct-map: ~A" v)))
-
- (let ((v (make-vct 10))
- (gen1 (make-oscil 440))
- (gen2 (make-oscil 440 :initial-phase pi)))
- (vct-map! v (lambda () (+ (gen1) (gen2))))
- (if (fneq (vct-peak v) 0.0) (snd-display #__line__ ";gen+gen-pi vct-map: ~A" v)))
-
- (let ((v (make-vct 10))
- (gen1 (make-oscil 440))
- (gen2 (make-oscil 440))
- (gen3 (make-oscil 440 :initial-phase 0.0)))
- (vct-map! v (lambda () (+ (gen1) (gen2) (gen3))))
- (if (and (not (vequal v (vct 0.000 0.375 0.744 1.102 1.442 1.760 2.050 2.308 2.529 2.711)))
- (not (vequal v (vct 0.000 0.188 0.375 0.561 0.744 0.925 1.102 1.275 1.442 1.604))))
- (snd-display #__line__ ";gen+gen+gen vct-map: ~A" v)))
-
- (let ((v (make-vct 1000))
- (gen1 (make-oscil 1.0))
- (gen2 (make-oscil 1.0 :initial-phase pi)))
- (vct-map! v (lambda () (+ (gen1) (gen2))))
- (if (fneq (vct-peak v) 0.0) (snd-display #__line__ ";gen+gen-pi 1.0: ~A" v)))
-
- (let ((v (make-vct 1000))
- (gen1 (make-oscil 1.0))
- (gen2 (make-oscil 1.0 :initial-phase (* 1023 pi))))
- (vct-map! v (lambda () (+ (gen1) (gen2))))
- (if (fneq (vct-peak v) 0.0) (snd-display #__line__ ";gen+gen-pi 1.0: ~A ~A" (vct-peak v) v)))
-
- (let ((v (make-vct 1000))
- (gen1 (make-oscil 1.0))
- (gen2 (make-oscil 1.0 :initial-phase (* (+ 1 (* 1024 1024)) pi))))
- (vct-map! v (lambda () (+ (gen1) (gen2))))
- ;; assume initial offset because phase is truncated to float in clm2xen
- (let ((off (vct-ref v 0)))
- (vct-offset! v (- off))
- (if (> (vct-peak v) 0.002) (snd-display #__line__ ";gen+gen-pi 1.0(2): ~A ~A" (vct-peak v) v))))
-
- (let ((v (make-vct 1000))
- (gen1 (make-oscil 1.0))
- (gen2 (make-oscil 1.0 :initial-phase pi)))
- (vct-map! v (lambda () (+ (gen1 0.0) (gen2 0.0 0.0))))
- (if (fneq (vct-peak v) 0.0) (snd-display #__line__ ";gen+gen-pi+args 1.0: ~A" v)))
-
- (let ((v1 (make-vct 10))
- (v2 (make-vct 10))
- (gen1 (make-oscil 100.0))
- (gen2 (make-oscil 100.0))
- (gen3 (make-oscil 100.0))
- (gen4 (make-oscil 100.0))
- (vr (make-vct 10)))
- (do ((i 0 (+ 1 i))) ((= i 10)) (vct-set! vr i (random 1.0)))
- (let ((i 0))
- (vct-map! v1 (lambda () (let ((val (+ (gen1 (vct-ref vr i)) (gen2 (vct-ref vr i) (vct-ref vr i))))) (set! i (+ 1 i)) val))))
- (let ((i 0))
- (vct-map! v2 (lambda () (let ((val (+ (oscil gen3 (vct-ref vr i)) (oscil gen4 (vct-ref vr i) (vct-ref vr i))))) (set! i (+ 1 i)) val))))
- (if (not (vequal v1 v2)) (snd-display #__line__ ";gen+gen+vr args: ~A ~A" v1 v2)))
-
- (let ((osc (make-ncos 440.0 3))
- (v (make-vct 1))
- (frq 0.0)
- (phs 1234.0)
- (cs 0))
- (vct-map! v
- (lambda ()
- (set! frq (mus-frequency osc))
- (set! phs (mus-phase osc))
- (set! cs (mus-length osc))
- (set! (mus-frequency osc) 123.0)
- (set! (mus-phase osc) 1.0)
- (set! (mus-length osc) 10)
- 0.0))
- (if (fneq frq 440.0) (snd-display #__line__ ";cs run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display #__line__ ";cs run phs: ~A" phs))
- (if (not (= cs 3)) (snd-display #__line__ ";cs run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";cs run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";cs run mus-phase: ~A" (mus-phase osc)))
- (if (not (= (mus-length osc) 10)) (snd-display #__line__ ";cs run set cs: ~A" (mus-length osc))))
-
- (let ((osc (make-nsin 440.0 3))
- (v (make-vct 1))
- (frq 0.0)
- (phs 1234.0)
- (cs 0))
- (vct-map! v
- (lambda ()
- (set! frq (mus-frequency osc))
- (set! phs (mus-phase osc))
- (set! cs (mus-length osc))
- (set! (mus-frequency osc) 123.0)
- (set! (mus-phase osc) 1.0)
- (set! (mus-length osc) 10)
- 0.0))
- (if (fneq frq 440.0) (snd-display #__line__ ";scs run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display #__line__ ";scs run phs: ~A" phs))
- (if (not (= cs 3)) (snd-display #__line__ ";scs run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";scs run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";scs run mus-phase: ~A" (mus-phase osc)))
- (if (not (= (mus-length osc) 10)) (snd-display #__line__ ";scs run set cs: ~A" (mus-length osc))))
-
- (let ((osc (make-ncos 440.0 3))
- (v (make-vct 1))
- (frq 0.0)
- (phs 1234.0)
- (cs 0))
- (vct-map! v
- (lambda ()
- (set! frq (mus-frequency osc))
- (set! phs (mus-phase osc))
- (set! cs (mus-length osc))
- (set! (mus-frequency osc) 123.0)
- (set! (mus-phase osc) 1.0)
- (set! (mus-length osc) 10)
- 0.0))
- (if (fneq frq 440.0) (snd-display #__line__ ";cs run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display #__line__ ";cs run phs: ~A" phs))
- (if (not (= cs 3)) (snd-display #__line__ ";cs run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";cs run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";cs run mus-phase: ~A" (mus-phase osc)))
- (if (not (= (mus-length osc) 10)) (snd-display #__line__ ";cs run set cs: ~A" (mus-length osc))))
-
- (let ((osc (make-nsin 440.0 3))
- (v (make-vct 1))
- (frq 0.0)
- (phs 1234.0)
- (cs 0))
- (vct-map! v
- (lambda ()
- (set! frq (mus-frequency osc))
- (set! phs (mus-phase osc))
- (set! cs (mus-length osc))
- (set! (mus-frequency osc) 123.0)
- (set! (mus-phase osc) 1.0)
- (set! (mus-length osc) 10)
- 0.0))
- (if (fneq frq 440.0) (snd-display #__line__ ";scs run frq: ~A" frq))
- (if (fneq phs 0.0) (snd-display #__line__ ";scs run phs: ~A" phs))
- (if (not (= cs 3)) (snd-display #__line__ ";scs run cs: ~A" cs))
- (if (fneq (mus-frequency osc) 123.0) (snd-display #__line__ ";scs run mus-frequency: ~A" (mus-frequency osc)))
- (if (fneq (mus-phase osc) 1.0) (snd-display #__line__ ";scs run mus-phase: ~A" (mus-phase osc)))
- (if (not (= (mus-length osc) 10)) (snd-display #__line__ ";scs run set cs: ~A" (mus-length osc))))
-
- (let ((zf (make-two-zero .4 .7 .3))
- (pf (make-two-pole .4 .7 .3))
- (z1 0.0) (z2 0.0) (z3 0.0)
- (p1 0.0) (p2 0.0) (p3 0.0)
- (v (make-vct 1)))
- (vct-map! v
- (lambda ()
- (set! z1 (two-zero zf 1.0))
- (set! z2 (two-zero zf 0.5))
- (set! z3 (two-zero zf 1.0))
- (set! p1 (two-pole pf 1.0))
- (set! p2 (two-pole pf 0.5))
- (set! p3 (two-pole pf 1.0))
- 0.0))
- (if (fneq z1 .4) (snd-display #__line__ ";run 2zero->0.4: ~A" z1))
- (if (fneq z2 .9) (snd-display #__line__ ";run 2zero->0.9: ~A" z2))
- (if (fneq z3 1.05) (snd-display #__line__ ";run 2zero->1.05: ~A" z3))
- (if (fneq p1 .4) (snd-display #__line__ ";run a0->out 2pole: ~A" p1))
- (if (fneq p2 -.08) (snd-display #__line__ ";run a0->out 2pole (-0.08): ~A" p2))
- (if (fneq p3 0.336) (snd-display #__line__ ";run a0->out 2pole (0.336): ~A" p3)))
+ (define (fv168) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 5.0)))))
+ (test (fv168) (float-vector 6.0 6.0 6.0 6.0))
- (let ((ind (open-sound "oboe.snd")))
- ;; ycoeff is after old end, so there's some small hope this could catch incomplete class declarations
- (for-each
- (lambda (n)
- (let ((tag (catch #t
- (lambda ()
- (mus-ycoeff (n) 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'mus-error))
- (snd-display #__line__ ";~A ~A" n tag))))
- (list make-all-pass make-asymmetric-fm make-snd->sample make-moving-average make-comb make-filtered-comb make-delay make-frame make-granulate
- make-locsig make-mixer make-notch make-oscil make-pulse-train make-rand make-rand-interp make-sawtooth-wave
- make-nrxysin make-nrxycos make-square-wave make-src make-ncos
- make-nsin make-table-lookup make-triangle-wave
- make-wave-train make-phase-vocoder make-ssb-am make-polyshape make-polywave))
- (close-sound ind))
+ (define (fv169) (let ((x 1.0) (y 5.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y)))))
+ (test (fv169) (float-vector 6.0 6.0 6.0 6.0))
- (let ((frm (make-formant 440.0 .1))
- (v (make-vct 3)))
- (vct-map! v (lambda ()
- (mus-set-formant-radius-and-frequency frm 2.0 100.0)))
- (if (fneq (mus-scaler frm) 2.0) (snd-display #__line__ ";run set-radius-etc: ~A" (mus-scaler frm)))
- (if (fneq (mus-frequency frm) 100.0) (snd-display #__line__ ";run set-radius-etc (frq): ~A" (mus-frequency frm))))
-
- (let ((v (make-vct 3)))
- (vct-map! v (let ((i 0))
- (lambda ()
- (let ((v0 (make-vct 3 .1)))
- (vct-set! v0 1 2)
- (let ((res (vct-ref v0 i)))
- (set! i (+ 1 i))
- res)))))
- (if (not (vequal v (vct .1 2.0 .1))) (snd-display #__line__ ";run make-vct: ~A" v)))
-
- (let ((val (run-eval '(let ((fr (make-frame 2 0.0 0.0)))
- (frame-set! fr 0 1)
- (frame-set! fr 1 2)
- fr))))
- (if (or (fneq (frame-ref val 0) 1.0)
- (fneq (frame-ref val 1) 2.0))
- (snd-display #__line__ ";frame-set int opt: ~A" val)))
-
- (let ((val (run-eval '(let ((fr (make-frame 2 0.0 0.0)))
- (frame-set! fr 0 (floor 1.4))
- (frame-set! fr 1 3/4)
- fr))))
- (if (or (fneq (frame-ref val 0) 1.0)
- (fneq (frame-ref val 1) 0.75))
- (snd-display #__line__ ";frame-set int opt 1: ~A" val)))
-
- (let ((val (run-eval '(let ((mx (make-mixer 2 1 0 0 1)))
- (mixer-set! mx 0 0 2)
- (mixer-set! mx 1 0 3/4)
- (mixer-set! mx 1 1 (floor 3.14))
- (mixer-set! mx 0 1 (+ 32 1))
- mx))))
- (if (or (fneq (mixer-ref val 0 0) 2.0)
- (fneq (mixer-ref val 1 0) 0.75)
- (fneq (mixer-ref val 0 1) 33.0)
- (fneq (mixer-ref val 1 1) 3))
- (snd-display #__line__ ";mixer-set int opt: ~A" val)))
-
- (let ((fr1 (run (frame .1 .2)))
- (fr2 (make-frame 2 .1 .2)))
- (if (not (equal? fr1 fr2))
- (snd-display #__line__ ";frame...: ~A ~A" fr1 fr2)))
-
- (let ((fr1 (frame .1)))
- (if (fneq (run (fr1 0)) .1) (snd-display #__line__ ";frame gen ref (.1): ~A" (fr1 0)))
- (run (set! (fr1 0) .2))
- (if (fneq (fr1 0) .2) (snd-display #__line__ ";frame gen ref (.2): ~A" (fr1 0)))
- (if (not (equal? fr1 (frame .2)))
- (snd-display #__line__ ";frame gen set! (.2): ~A" fr1)))
-
- (let ((fr1 (frame .1 .2 .3 .4)))
- (run (set! (fr1 2) (+ (fr1 1) (fr1 2))))
- (if (fneq (fr1 2) .5) (snd-display #__line__ ";frame gen ref/set (.5): ~A" (fr1 2))))
-
-
- (let ((mx (run (lambda () (mixer .1 .2 .3 .4)))))
- (if (fneq (mx 0 0) .1) (snd-display #__line__ ";mixer gen ref (.1): ~A" (mx 0 0)))
- (if (not (equal? mx (make-mixer 2 .1 .2 .3 .4))) (snd-display #__line__ ";mixer...: ~A" mx))
- (run (lambda () (set! (mx 0 0) .5)))
- (if (fneq (mx 0 0) .5) (snd-display #__line__ ";mixer gen set (.5): ~A" (mx 0 0)))
- (if (not (equal? mx (make-mixer 2 .5 .2 .3 .4))) (snd-display #__line__ ";mixer... (after set): ~A" mx))
- (if (fneq (mx 1 0) .3) (snd-display #__line__ ";mixer gen ref (.3): ~A" (mx 1 0)))
- (run (lambda () (set! (mx 0 1) .5)))
- (if (fneq (mx 0 1) .5) (snd-display #__line__ ";mixer (0 1) gen set (.5): ~A" (mx 0 1)))
- (if (not (equal? mx (make-mixer 2 .5 .5 .3 .4))) (snd-display #__line__ ";mixer... (after set 1): ~A" mx)))
-
- (let ((mx (mixer .1)))
- (if (not (equal? mx (make-mixer 1 .1))) (snd-display #__line__ ";mixer .1: ~A" mx))
- (if (fneq (run (lambda () (mx 0 0))) .1) (snd-display #__line__ ";mixer (1) gen ref (.1): ~A" (mx 0 0)))
- (run (lambda () (set! (mx 0 0) .5)))
- (if (fneq (run (lambda () (mx 0 0))) .5) (snd-display #__line__ ";mixer (1) gen set (.5): ~A" (mx 0 0))))
-
- (let ((mx (run (lambda () (mixer .1 .2 .3)))))
- (if (not (equal? mx (make-mixer 2 .1 .2 .3 0.0))) (snd-display #__line__ ";mixer .1 .2 .3: ~A" mx))
- (run (lambda () (set! (mx 1 1) .5)))
- (if (fneq (run (lambda () (mx 1 1))) .5) (snd-display #__line__ ";mixer (1 1) gen set (.5): ~A" (mx 1 1))))
-
-
- (let ((sd (make-sound-data 1 1)))
- (if (fneq (run (lambda () (sd 0 0))) 0.0) (snd-display #__line__ ";sound-data ref: ~A" (sd 0 0)))
- (run (lambda () (set! (sd 0 0) 1.0)))
- (if (fneq (sd 0 0) 1.0) (snd-display #__line__ ";sound-data set: ~A" (sd 0 0)))
- (if (not (equal? sd (let ((sd1 (make-sound-data 1 1))) (sound-data-set! sd1 0 0 1.0) sd1)))
- (snd-display #__line__ ";sound-data set not equal: ~A" sd)))
-
- (let ((sd (make-sound-data 2 3)))
- (if (fneq (sd 0 0) 0.0) (snd-display #__line__ ";sound-data ref (1): ~A" (sd 0 0)))
- (run (lambda () (set! (sd 1 0) 1.0)))
- (if (fneq (run (lambda () (sd 1 0))) 1.0) (snd-display #__line__ ";sound-data set (1 0): ~A" (sd 1 0)))
- (run (lambda () (set! (sd 1 2) 2.0)))
- (if (fneq (run (lambda () (sd 1 2))) 2.0) (snd-display #__line__ ";sound-data set (1 2): ~A" (sd 1 2)))
- (if (not (equal? sd (let ((sd1 (make-sound-data 2 3)))
- (sound-data-set! sd1 1 0 1.0)
- (sound-data-set! sd1 1 2 2.0)
- sd1)))
- (snd-display #__line__ ";sound-data set (3) not equal: ~A" sd)))
-
- (let ((val (run-eval '(let ((loc (make-locsig :channels 2)))
- (locsig-set! loc 0 32)
- (locsig-set! loc 1 3/4)
- (+ (locsig-ref loc 0)
- (locsig-ref loc 1))))))
- (if (fneq val 32.75) (snd-display #__line__ ";locsig-set int opt: ~A" val)))
+ (define (fv170) (let ((x 1.0) (y 6.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y -1.0)))))
+ (test (fv170) (float-vector 6.0 6.0 6.0 6.0))
- (set! (locsig-type) mus-interp-linear)
- (let* ((rev (make-frame->file "fmv4.reverb" 1 mus-bshort mus-next))
- (loc (make-locsig 30.0 :channels 2 :reverb .1 :revout rev))
- (d0 123.0)
- (d1 123.0)
- (dr 123.0)
- (d01 123.0)
- (d11 123.0)
- (dr1 123.0)
- (cs 0)
- (isloc #f)
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (set! d0 (locsig-ref loc 0))
- (set! d1 (locsig-ref loc 1))
- (set! dr (locsig-reverb-ref loc 0))
- (set! cs (mus-channels loc))
- (set! isloc (locsig? loc))
- (move-locsig loc 60.0 2.0)
- (set! d01 (locsig-ref loc 0))
- (set! d11 (locsig-ref loc 1))
- (set! dr1 (locsig-reverb-ref loc 0))
- (locsig-set! loc 0 .123)
- (set! (locsig-ref loc 1) .23)
- (locsig-reverb-set! loc 0 .23)
- (set! (locsig-reverb-ref loc 0) .123)
- 0.0))
- (if (fneq d0 .667) (snd-display #__line__ ";run locsig ref 0: ~A" d0))
- (if (fneq d1 .333) (snd-display #__line__ ";run locsig ref 1: ~A" d1))
- (if (fneq dr .1) (snd-display #__line__ ";run locsig reverb ref 0: ~A" dr))
- (if (not (= cs 2)) (snd-display #__line__ ";run mus-channels: ~A" cs))
- (if (fneq d01 .167) (snd-display #__line__ ";run locsig ref 01: ~A" d01))
- (if (fneq d11 .333) (snd-display #__line__ ";run locsig ref 11: ~A" d11))
- (if (fneq dr1 .0707) (snd-display #__line__ ";run locsig reverb ref 01: ~A" dr1))
- (if (fneq (locsig-ref loc 0) .123) (snd-display #__line__ ";run set loc 0: ~A" (locsig-ref loc 0)))
- (if (fneq (locsig-ref loc 1) .23) (snd-display #__line__ ";run set loc 1: ~A" (locsig-ref loc 1)))
- (if (fneq (locsig-reverb-ref loc 0) .123) (snd-display #__line__ ";run set loc rev 0: ~A" (locsig-reverb-ref loc 0)))
- (mus-close rev))
+ (define (fv171) (let ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y z)))))
+ (test (fv171) (float-vector 6.0 6.0 6.0 6.0))
- (let* ((outp (make-sound-data 1 10))
- (gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";(opt)make-locsig->sd chans (1): ~A" (mus-channels gen)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 1.0))))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 1.0)))
- (snd-display #__line__ ";(opt)locsig->sd chan 0: ~A" (sound-data->vct outp 0))))
+ (define (fv172) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x -1.0 6.0)))))
+ (test (fv172) (float-vector 6.0 6.0 6.0 6.0))
- (let* ((outp (make-sound-data 2 10))
- (gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";(opt)make-locsig->sd chans: ~A" (mus-channels gen)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 1.0))))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 1.0)))
- (snd-display #__line__ ";(opt)locsig->sd chan 0: ~A" (sound-data->vct outp 0)))
- (if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.0)))
- (snd-display #__line__ ";(opt)locsig->sd chan 1: ~A" (sound-data->vct outp 1))))
-
- (let* ((outp (make-sound-data 2 10))
- (gen (make-locsig 45.0 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";(opt)make-locsig->sd chans: ~A" (mus-channels gen)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 1.0))))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.5)))
- (snd-display #__line__ ";(opt)locsig->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
- (if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.5)))
- (snd-display #__line__ ";(opt)locsig->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 0.5))))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.75)))
- (snd-display #__line__ ";(opt)locsig->sd chan 0 (0.75): ~A" (sound-data->vct outp 0)))
- (if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.75)))
- (snd-display #__line__ ";(opt)locsig->sd chan 1 (0.75): ~A" (sound-data->vct outp 1))))
-
- (let* ((outp (make-vct 10))
- (gen (make-locsig 0.0 :output outp)))
- (if (not (= (mus-channels gen) 1)) (snd-display #__line__ ";(opt)make-locsig->vct chans: ~A" (mus-channels gen)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 1.0))))
- (if (not (vequal outp (make-vct 10 1.0)))
- (snd-display #__line__ ";(opt)locsig->vct chan 0: ~A" outp))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 0.5))))
- (if (not (vequal outp (make-vct 10 1.5)))
- (snd-display #__line__ ";(opt)locsig->vct chan 0: ~A" outp)))
+ (define (fv173) (let ((x 3.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x (abs x))))))
+ (test (fv173) (float-vector 6.0 6.0 6.0 6.0))
- (let* ((outp (make-vct 10))
- (gen (make-locsig 45.0 :channels 2 :output outp)))
- (if (not (= (mus-channels gen) 2)) (snd-display #__line__ ";(opt)make-locsig->vct chans (2): ~A" (mus-channels gen)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 1.0))))
- (if (not (vequal outp (make-vct 10 0.5)))
- (snd-display #__line__ ";(opt)locsig(2)->vct chan 0: ~A" outp))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 0.5))))
- (if (not (vequal outp (make-vct 10 0.75)))
- (snd-display #__line__ ";(opt)locsig(2)->vct chan 0: ~A" outp)))
+ (define (fv174) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 2 (abs x))))))
+ (test (fv174) (float-vector 6.0 6.0 6.0 6.0))
- (let* ((outp (make-sound-data 4 10))
- (gen (make-locsig 135.0 :output outp)))
- (if (not (= (mus-channels gen) 4)) (snd-display #__line__ ";(opt)make-locsig->sd chans (4): ~A" (mus-channels gen)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (locsig gen i 1.0))))
- (if (not (vequal (sound-data->vct outp 0) (make-vct 10 0.0)))
- (snd-display #__line__ ";(opt)locsig(4)->sd chan 0 (0.5): ~A" (sound-data->vct outp 0)))
- (if (not (vequal (sound-data->vct outp 1) (make-vct 10 0.5)))
- (snd-display #__line__ ";(opt)locsig(4)->sd chan 1 (0.5): ~A" (sound-data->vct outp 1)))
- (if (not (vequal (sound-data->vct outp 2) (make-vct 10 0.5)))
- (snd-display #__line__ ";(opt)locsig(4)->sd chan 2 (0.5): ~A" (sound-data->vct outp 2)))
- (if (not (vequal (sound-data->vct outp 3) (make-vct 10 0.0)))
- (snd-display #__line__ ";(opt)locsig(4)->sd chan 3 (0.5): ~A" (sound-data->vct outp 3))))
-
-
- (let ((fr (make-frame 2 1.5 0.5))
- (mx (make-mixer 2 0.1 0.2 0.3 0.4))
- (vs (make-vct 6))
- (v (make-vct 1))
- (fq #f)
- (mq #f))
- (vct-map! v (lambda ()
- (vct-set! vs 0 (frame-ref fr 0))
- (vct-set! vs 1 (frame-ref fr 1))
- (vct-set! vs 2 (mixer-ref mx 0 0))
- (vct-set! vs 3 (mixer-ref mx 0 1))
- (vct-set! vs 4 (mixer-ref mx 1 0))
- (vct-set! vs 5 (mixer-ref mx 1 1))
- (frame-set! fr 0 .123)
- (mixer-set! mx 0 1 .123)
- (set! fq (frame? fr))
- (set! mq (mixer? mx))
- 0.0))
- (if (not (vequal vs (vct 1.5 0.5 0.1 0.2 0.3 0.4))) (snd-display #__line__ ";run frame-set: ~A" vs))
- (if (not fq) (snd-display #__line__ ";run frame?"))
- (if (not mq) (snd-display #__line__ ";run mixer?"))
- (if (fneq (frame-ref fr 0) .123) (snd-display #__line__ ";run frame-ref: ~A" (frame-ref fr 0)))
- (if (fneq (mixer-ref mx 0 1) .123) (snd-display #__line__ ";run mixer-ref: ~A" (mixer-ref mx 0 1))))
-
- (let ((cmb (make-comb .1 12))
- (fb .123)
- (len 123)
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (set! fb (mus-feedback cmb))
- (set! len (mus-length cmb))
- (set! (mus-feedback cmb) .123)
- 0.0))
- (if (fneq fb .1) (snd-display #__line__ ";run feedback: ~A" fb))
- (if (not (= len 12)) (snd-display #__line__ ";run mus-length: ~A" len))
- (if (fneq (mus-feedback cmb) .123) (snd-display #__line__ ";run set feedback: ~A" (mus-feedback cmb))))
-
- (let ((cmb (make-filtered-comb .1 12 :filter (make-one-zero .5 .5)))
- (fb .123)
- (len 123)
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (set! fb (mus-feedback cmb))
- (set! len (mus-length cmb))
- (set! (mus-feedback cmb) .123)
- 0.0))
- (if (fneq fb .1) (snd-display #__line__ ";run feedback: ~A" fb))
- (if (not (= len 12)) (snd-display #__line__ ";run mus-length: ~A" len))
- (if (fneq (mus-feedback cmb) .123) (snd-display #__line__ ";run set feedback: ~A" (mus-feedback cmb))))
-
- (let ((cmb (make-notch .1 12))
- (ff .123)
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (set! ff (mus-feedforward cmb))
- (set! (mus-feedforward cmb) .321)
- 0.0))
- (if (fneq ff .1) (snd-display #__line__ ";run feedforward: ~A" ff))
- (if (fneq (mus-feedforward cmb) .321) (snd-display #__line__ ";run set feedforward: ~A" (mus-feedforward cmb))))
-
- (let ((gen (make-oscil 440))
- (res 0)
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (if (not (string=? (mus-name gen) "oscil")) (set! res 1))
- (if (not (string=? (mus-describe gen) "oscil freq: 440.000Hz, phase: 0.000")) (set! res (+ res 10)))
- 0.0))
- (if (not (= res 0)) (snd-display #__line__ ";run mus-name etc: ~A" res)))
-
- (let ((r1 (make-rand 100))
- (r2 (make-rand-interp 100 .1))
- (v (make-vct 1))
- (r1q #f)
- (r2q #f))
- (vct-map! v (lambda ()
- (set! r1q (rand? r1))
- (set! r2q (rand-interp? r2))
- (if (or (not (= (rand r1) (rand r1)))
- (= (rand-interp r2) (rand-interp r2)))
- 1.0
- 0.0)))
- (if (fneq (vct-ref v 0) 0.0) (snd-display #__line__ ";run rand/interp?"))
- (if (not r1q) (snd-display #__line__ ";run rand?"))
- (if (not r2q) (snd-display #__line__ ";run rand-interp?"))
- (catch #t (lambda () (vct-map! v (lambda () (rand r1 0.0 1.0 2.0)))) (lambda args args))
- (catch #t (lambda () (vct-map! v (lambda () (rand-interp r2 1.0 2.0 3.0)))) (lambda args args)))
-
- (let ((v0 (make-vct 10))
- (v (make-vct 1)))
- (do ((i 0 (+ 1 i))) ((= i 10))
- (vct-set! v0 i i))
- (vct-map! v (lambda () (array-interp v0 3.5)))
- (if (fneq (vct-ref v 0) 3.5) (snd-display #__line__ ";run array-interp: ~F?" (vct-ref v 0)))
- (vct-map! v (lambda () (array-interp v0 3.5 10)))
- (if (fneq (vct-ref v 0) 3.5) (snd-display #__line__ ";run array-interp sized: ~F?" (vct-ref v 0)))
- (catch #t (lambda () (vct-map! v (lambda () (array-interp v0)))) (lambda args args))
- (catch #t (lambda () (vct-map! v (lambda () (array-interp v0 3.5 10 123)))) (lambda args args))
-
- (do ((i 0 (+ 1 i))) ((= i 10))
- (vct-set! v0 i i))
- (let ((val (run (lambda () (mus-interpolate mus-interp-linear 1.5 v0)))))
- (if (fneq val 1.5) (snd-display #__line__ ";opt mus-interpolate linear: ~A" val))
- (set! val (run (mus-interpolate mus-interp-all-pass 1.5 v0 10)))
- (if (fneq val 1.5) (snd-display #__line__ ";opt mus-interpolate all-pass: ~A" val))
- (set! val (run (lambda () (mus-interpolate mus-interp-none 1.5 v0 10 0.0))))
- (if (fneq val 1.0) (snd-display #__line__ ";opt mus-interpolate none: ~A" val))
- (set! val (run (lambda () (mus-interpolate mus-interp-hermite 1.5 v0))))
- (if (fneq val 1.5) (snd-display #__line__ ";opt mus-interpolate hermite: ~A" val))
- (set! val (run (lambda () (mus-interpolate mus-interp-lagrange 1.5 v0))))
- (if (fneq val 1.5) (snd-display #__line__ ";opt mus-interpolate lagrange: ~A" val))))
-
- (let ((e (make-env '(0 0 1 1) :length 11))
- (v (make-vct 1))
- (b 123.0)
- (enq #f)
- (cs 123)
- (ep -123)
- (val8 123.0)
- (val0 123.0))
- (env e) (env e)
- (vct-map! v (lambda ()
- (set! b (mus-increment e))
- (set! cs (mus-location e))
- (set! (mus-location e) 8)
- (set! enq (env? e))
- (set! val8 (env e))
- (set! ep (mus-channels e))
- (mus-reset e)
- (set! val0 (env e))
- (env-interp .5 e)))
- (if (not enq) (snd-display #__line__ ";run env?"))
- (if (not (= cs 2)) (snd-display #__line__ ";run mus-location: ~A" cs))
- (if (not (= ep 0)) (snd-display #__line__ ";run mus-channels: ~A" ep))
- (if (fneq b 1.0) (snd-display #__line__ ";run mus-increment: ~A" b))
- (if (fneq val8 0.8) (snd-display #__line__ ";run set location: ~A" val8))
- (if (fneq val0 0.0) (snd-display #__line__ ";run mus-reset: ~A" val0))
- (if (fneq (vct-ref v 0) .5) (snd-display #__line__ ";run env-interp: ~A" (vct-ref v 0)))
- (catch #t (lambda () (vct-map! v (lambda () (env e 1.0)))) (lambda args args))
- (catch #t (lambda () (vct-map! v (lambda () (env-interp e)))) (lambda args args)))
-
- (test-set-gens)
-
- (let ((flt (make-filter 3 (vct .1 .2 .3) (vct .4 .5 .6)))
- (v (make-vct 1))
- (d1 -1.0)
- (x1 -1.0)
- (y1 -1.0))
- (vct-map! v (lambda ()
- (filter flt 1.0)
- (set! d1 (vct-ref (mus-data flt) 1))
- (set! x1 (vct-ref (mus-xcoeffs flt) 1))
- (set! y1 (vct-ref (mus-ycoeffs flt) 1))
- 0.0))
- (if (fneq d1 1.0) (snd-display #__line__ ";run mus-data: ~A ~A" d1 (mus-data flt)))
- (if (fneq x1 .2) (snd-display #__line__ ";run mus-xcoeffs: ~A ~A" x1 (mus-xcoeffs flt)))
- (if (fneq y1 .5) (snd-display #__line__ ";run mus-ycoeffs: ~A ~A" y1 (mus-ycoeffs flt))))
-
- (let ((grn (make-granulate :expansion 2.0))
- (v (make-vct 1))
- (gr 123)
- (gs .123)
- (ge .123)
- (gh 123))
- (vct-map! v (lambda ()
- (set! gr (mus-ramp grn))
- (set! gs (mus-scaler grn))
- (set! ge (mus-increment grn))
- (set! gh (mus-hop grn))
- (set! (mus-ramp grn) 321)
- (set! (mus-scaler grn) .321)
- (set! (mus-hop grn) 1234)
- 0.0))
- (if (and (not (= gr 1323)) (not (= gr 2646))) (snd-display #__line__ ";run ramp: ~A" gr))
- (if (and (not (= gh 1102)) (not (= gh 2205))) (snd-display #__line__ ";run hop: ~A" gh))
- (if (fneq gs 0.6) (snd-display #__line__ ";run scaler: ~A" gs))
- (if (fneq ge 2.0) (snd-display #__line__ ";run gran exp: ~A" ge))
- (if (fneq (mus-scaler grn) .321) (snd-display #__line__ ";run set scl: ~A" (mus-scaler grn)))
- (if (not (= (mus-hop grn) 1234)) (snd-display #__line__ ";run set hop: ~A" (mus-hop grn)))
- (if (not (= (mus-ramp grn) 321)) (snd-display #__line__ ";run set ramp: ~A" (mus-ramp grn))))
-
- (let ((v0 (make-vct 1))
- (v1 (make-vct 1))
- (v (make-vct 1))
- (val .123))
- (vct-set! v0 0 1.0)
- (vct-set! v1 0 1.0)
- (vct-map! v (lambda ()
- (rectangular->polar v0 v1)
- (set! val (vct-ref v0 0))
- (polar->rectangular v0 v1)
- (vct-ref v1 0)))
- (if (fneq (vct-ref v 0) 1.0) (snd-display #__line__ ";run r->p not inverted: ~A" v))
- (if (fneq val (sqrt 2.0)) (snd-display #__line__ ";r->p: ~A" val)))
-
- (let ((v (make-vct 1))
- (v0 (vct 1.0 2.0))
- (v1 (vct 0.5 1.0)))
- (vct-map! v (lambda ()
- (dot-product v0 v1)))
- (if (fneq (vct-ref v 0) 2.5) (snd-display #__line__ ";run dot-product: ~A" (vct-ref v 0))))
-
- (let ((v (make-vct 1))
- (v0 (vct 1.0 2.0))
- (v1 (vct 0.5 1.0)))
- (vct-map! v (lambda ()
- (dot-product v0 v1 2)))
- (if (fneq (vct-ref v 0) 2.5) (snd-display #__line__ ";run dot-product (2): ~A" (vct-ref v 0))))
-
- (let ((fr1 (make-frame 2 .1 .2))
- (fr2 (make-frame 2 .3 .4))
- (fr3 (make-frame 2 0.0 0.0))
- (fr4 (make-frame 2 0.0 0.0))
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (frame* fr1 fr2 fr3)
- (frame+ fr1 fr2 fr4)
- (frame->sample fr1 fr2)))
- (if (fneq (frame-ref fr3 0) .03) (snd-display #__line__ ";run frame* 0: ~A" (frame-ref fr3 0)))
- (if (fneq (frame-ref fr3 1) .08) (snd-display #__line__ ";run frame* 1: ~A" (frame-ref fr3 1)))
- (if (fneq (frame-ref fr4 0) .4) (snd-display #__line__ ";run frame+ 0: ~A" (frame-ref fr4 0)))
- (if (fneq (frame-ref fr4 1) .6) (snd-display #__line__ ";run frame+ 1: ~A" (frame-ref fr4 1)))
- (if (fneq (vct-ref v 0) .11) (snd-display #__line__ ";run frame->sample: ~A" (vct-ref v 0)))
- (let ((val (run (lambda () (frame+ fr1 1.0)))))
- (if (or (fneq (frame-ref val 0) 1.1)
- (fneq (frame-ref val 1) 1.2))
- (snd-display #__line__ ";frame-offset: ~A" val)))
- (let ((val (run (lambda () (frame+ 1.0 fr1)))))
- (if (or (fneq (frame-ref val 0) 1.1)
- (fneq (frame-ref val 1) 1.2))
- (snd-display #__line__ ";frame-offset a: ~A" val)))
- (let ((val (run (lambda () (frame* fr1 2.0)))))
- (if (or (fneq (frame-ref val 0) 0.2)
- (fneq (frame-ref val 1) 0.4))
- (snd-display #__line__ ";frame-scale: ~A" val)))
- (let ((val (run (lambda () (frame* 2.0 fr1)))))
- (if (or (fneq (frame-ref val 0) 0.2)
- (fneq (frame-ref val 1) 0.4))
- (snd-display #__line__ ";frame-scale a: ~A" val))))
- (let ((v0 (make-vct 4))
- (v1 (make-vct 4))
- (v (make-vct 1)))
- (vct-set! v0 0 1.0)
- (vct-set! v1 2 1.0)
- (vct-map! v (lambda () (convolution v0 v1) 0.0))
- (if (or (not (vequal v0 (vct 0.0 0.0 1.0 0.0)))
- (not (vequal v1 (vct 0.0 0.0 0.0 0.0))))
- (snd-display #__line__ ";run convolution: ~A ~A" v0 v1)))
+ (define (fv175) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2.0 2 (abs x))))))
+ (test (fv175) (float-vector 6.0 6.0 6.0 6.0))
- (if all-args
- (let ((v (make-vct 1))
- (amps (list->vct '(0.5 0.25 1.0)))
- (phases (list->vct '(1.0 0.5 2.0))))
- (vct-map! v (lambda () (sine-bank amps phases)))
- (if (fneq (vct-ref v 0) 1.44989) (snd-display #__line__ ";run sine-bank: ~A?" (vct-ref v 0)))))
- (if all-args
- (let ((v (make-vct 1))
- (amps (list->vct '(0.5 0.25 1.0)))
- (phases (list->vct '(1.0 0.5 2.0))))
- (vct-map! v (lambda () (sine-bank amps phases 3)))
- (if (fneq (vct-ref v 0) 1.44989) (snd-display #__line__ ";run sine-bank (1): ~A?" (vct-ref v 0)))))
-
- (let ((fr0 (make-frame 2 1.0 1.0))
- (fr1 (make-frame 2 0.0 0.0))
- (gen (make-mixer 2 .5 .25 .125 1.0))
- (v (make-vct 1)))
- (vct-map! v (lambda () (frame->frame fr0 gen fr1) (frame-ref fr1 1)))
- (if (fneq (frame-ref fr1 1) 1.25) (snd-display #__line__ ";run frame->frame right: ~A" fr1)))
-
- (let ((fr0 (make-frame 2 1.0 1.0))
- (fr1 (make-frame 2 0.0 0.0))
- (gen (make-mixer 2 .5 .25 .125 1.0))
- (v (make-vct 1)))
- (vct-map! v (lambda () (frame->frame gen fr0 fr1) (frame-ref fr1 1)))
- (if (fneq (frame-ref fr1 1) 1.125) (snd-display #__line__ ";run frame->frame left: ~A" fr1)))
-
- (let ((rdat (make-vct 16))
- (idat (make-vct 16))
- (win (make-fft-window rectangular-window 16))
- (v (make-vct 1)))
- (vct-set! rdat 0 1.0)
- (vct-map! v (lambda ()
- (spectrum rdat idat win 1)
- 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (if (fneq (vct-ref rdat i) 1.0)
- (snd-display #__line__ ";run impulse->flat? ~A" rdat)))
- (catch #t (lambda () (vct-map! v (lambda () (spectrum rdat idat win 17.3)))) (lambda args args)))
-
- (let ((rdat (make-vct 16))
- (idat (make-vct 16))
- (win (make-fft-window rectangular-window 16))
- (v (make-vct 1)))
- (vct-set! rdat 0 1.0)
- (vct-map! v (lambda ()
- (spectrum rdat idat win)
- 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (if (fneq (vct-ref rdat i) 1.0)
- (snd-display #__line__ ";run impulse->flat (1)? ~A" rdat))))
-
- (let ((rdat (make-vct 16))
- (idat (make-vct 16))
- (win (make-fft-window rectangular-window 16))
- (v (make-vct 1)))
- (vct-set! rdat 0 1.0)
- (vct-map! v (lambda ()
- (spectrum rdat idat win)
- 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (if (fneq (vct-ref rdat i) 1.0)
- (snd-display #__line__ ";run impulse->flat (2)? ~A" rdat))))
-
- (let ((mx1 (make-mixer 2))
- (mx2 (make-mixer 2))
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (mixer-set! mx1 0 0 .1)
- (mixer* mx1 mx1 mx2)
- 0.0))
- (if (fneq (mixer-ref mx2 0 0) .01) (snd-display #__line__ ";run mixer* res: ~A" mx2)))
-
- (let ((mx1 (make-mixer 2 1 2 3 4))
- (mx2 (make-mixer 2 0 0 0 0)))
- (run (lambda () (mixer* mx1 2.0 mx2)))
- (if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display #__line__ ";run mixer* 1: ~A" mx2)))
-
- (let* ((mx1 (make-mixer 2 1 2 3 4))
- (mx2 (run (lambda () (mixer* mx1 2.0)))))
- (if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display #__line__ ";run mixer* 2: ~A" mx2))
- (set! mx2 (run (lambda () (mixer* 2.0 mx1))))
- (if (not (equal? mx2 (make-mixer 2 2 4 6 8)))
- (snd-display #__line__ ";run mixer* 2a: ~A" mx2))
- (set! mx2 (run (lambda () (mixer+ 2.0 mx1))))
- (if (not (equal? mx2 (make-mixer 2 3 4 5 6)))
- (snd-display #__line__ ";run mixer-offset 2: ~A" mx2))
- (set! mx2 (run (lambda () (mixer+ mx1 2.0))))
- (if (not (equal? mx2 (make-mixer 2 3 4 5 6)))
- (snd-display #__line__ ";run mixer-offset 2a: ~A" mx2)))
-
- (let ((mx1 (make-mixer 2))
- (mx2 (make-mixer 2))
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (set! (mixer-ref mx1 0 0) .1)
- (mixer* mx1 mx1 mx2)
- 0.0))
- (if (fneq (mixer-ref mx2 0 0) .01) (snd-display #__line__ ";run mixer* res (set): ~A" mx2)))
-
- (let ((gen (make-sample->file "fmv.snd" 2 mus-lshort mus-riff))
- (v (make-vct 1))
- (oq #f)
- (sq #f))
- (vct-map! v (lambda ()
- (set! oq (mus-output? gen))
- (set! sq (sample->file? gen))
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (sample->file gen i 0 (* i .001))
- (sample->file gen i 1 (* i .01)))
- (outa 50 .015 gen)
- (outb 50 .15 gen)
- (out-any 60 .015 0 gen)
- (out-any 60 .15 1 gen)
- 0.0))
- (mus-close gen)
- (if (not oq) (snd-display #__line__ ";run mus-output?"))
- (if (not sq) (snd-display #__line__ ";run mus-output?"))
- (catch #t (lambda () (vct-map! v (lambda () (sample->file gen)))) (lambda args args))
- (catch #t (lambda () (vct-map! v (lambda () (sample->file gen 0 0 .1 .2)))) (lambda args args)))
-
- (let ((gen (make-vct 10))
- (chans 0))
- (run
- (lambda ()
- (set! chans (mus-channels gen))
- (do ((i 0 (+ 1 i))
- (x 0.0 (+ x 0.1)))
- ((= i 10))
- (outa i x gen))))
- (if (not (vequal gen (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))
- (snd-display #__line__ ";outa->vct opt ramp: ~A" gen))
- (if (not (= chans 1)) (snd-display #__line__ ";mus-channels vct opt: ~A" chans))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i))
- (x 0.0 (+ x 0.1)))
- ((= i 10))
- (outa i x gen))))
- (if (not (vequal gen (vct-scale! (vct 0 .1 .2 .3 .4 .5 .6 .7 .8 .9) 2.0)))
- (snd-display #__line__ ";outa->vct opt ramp 2: ~A" gen)))
-
- (let ((gen (make-sound-data 4 100))
- (chans 0))
- (run
- (lambda ()
- (set! chans (mus-channels gen))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i .1 gen)
- (outb i .2 gen)
- (outc i .3 gen)
- (outd i .4 gen))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i .01 gen)
- (outb i .02 gen)
- (outc i .03 gen)
- (outd i .04 gen))
- (mus-close gen)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (or (fneq (ina i gen) .11)
- (fneq (inb i gen) .22)
- (fneq (in-any i 2 gen) .33)
- (fneq (in-any i 3 gen) .44))
- (snd-display #__line__ ";4-chan sd opt out/in[~A]: ~A ~A ~A ~A?" i (ina i gen) (inb i gen) (in-any i 2 gen) (in-any i 3 gen))))
- (if (not (= chans 4)) (snd-display #__line__ ";mus-channels sd 4 opt: ~A" chans)))
+ (define (fv176) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2.0 (abs x) (abs x))))))
+ (test (fv176) (float-vector 6.0 6.0 6.0 6.0))
- (let ((gen (make-sound-data 4 100)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (out-any i .1 0 gen)
- (out-any i .2 1 gen)
- (out-any i .3 2 gen)
- (out-any i .4 3 gen))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (out-any i .01 0 gen)
- (out-any i .02 1 gen)
- (out-any i .03 2 gen)
- (out-any i .04 3 gen))))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (if (or (fneq (in-any i 0 gen) .11)
- (fneq (in-any i 1 gen) .22)
- (fneq (in-any i 2 gen) .33)
- (fneq (in-any i 3 gen) .44))
- (snd-display #__line__ ";4-chan sd out/in-any[~A]: ~A ~A ~A ~A?" i (in-any i 0 gen) (in-any i 1 gen) (in-any i 2 gen) (in-any i 3 gen)))))
+ (define (fv177) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) (abs x) (abs x))))))
+ (test (fv177) (float-vector 6.0 6.0 6.0 6.0))
- (let* ((gen (make-file->sample "fmv.snd"))
- (vals (make-vct 10))
- (iq #f)
- (fq #f)
- (v (make-vct 1)))
- (vct-map! v (lambda ()
- (vct-set! vals 0 (in-any 20 0 gen))
- (vct-set! vals 1 (in-any 20 1 gen))
- (vct-set! vals 2 (ina 30 gen))
- (vct-set! vals 3 (inb 30 gen))
- (vct-set! vals 4 (file->sample gen 40 0))
- (vct-set! vals 5 (file->sample gen 40 1))
- (vct-set! vals 6 (in-any 50 0 gen))
- (vct-set! vals 7 (in-any 50 1 gen))
- (vct-set! vals 8 (in-any 60 0 gen))
- (vct-set! vals 9 (in-any 60 1 gen))
- (set! iq (mus-input? gen))
- (set! fq (file->sample? gen))
- 0.0))
- (if (not iq) (snd-display #__line__ ";run mus-input?"))
- (if (not fq) (snd-display #__line__ ";run file->sample?"))
- (if (not (vequal vals (vct .02 .2 .03 .3 .04 .4 .065 .65 .075 .75))) (snd-display #__line__ ";run i/o: ~A" vals)))
- (delete-file "fmv.snd")
-
- (let ((gen (make-frame->file "fmv.snd" 2 mus-bshort mus-next))
- (v (make-vct 1))
- (fq #f)
- (fr0 (make-frame 2 0.0 0.0)))
- (vct-map! v (lambda ()
- (set! fq (frame->file? gen))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (frame-set! fr0 0 (* i .001))
- (frame-set! fr0 1 (* i .01))
- (frame->file gen i fr0))
- 0.0))
- (mus-close gen)
- (if (not fq) (snd-display #__line__ ";run frame->file?")))
-
- (let* ((gen (make-file->frame "fmv.snd"))
- (frout (make-frame 2))
- (v (make-vct 1))
- (fq #f))
- (vct-map! v (lambda ()
- (file->frame gen 4 frout)
- (set! fq (file->frame? gen))
- (frame-ref frout 0)))
- (if (not fq) (snd-display #__line__ ";run file->frame?"))
- (if (fneq (vct-ref v 0) .004) (snd-display #__line__ ";run frame i/o: ~A" frout)))
- (delete-file "fmv.snd")
-
- (let ((hi (make-power-env '(0 0 32.0 1 1 .0312 2 0 1) :duration 1.0)))
- (itsta '(lambda (y) (declare (y penv)) (+ 1 2)) hi 3)
- ;(itsta '(lambda () (penv-total-envs hi)) 0 2)
- )
+ (define (fv178) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x (abs x))))))
+ (test (fv178) (float-vector 6.0 6.0 6.0 6.0))
- (let ((ind (open-sound "oboe.snd")))
- (let ((r (make-sampler 2000))
- (v (make-vct 2)))
- (itst '(srate) 22050)
- (itst '(channels) 1)
- (itst '(frames) 50828)
- (if (not (= (run (lambda () (srate ind))) 22050))
- (snd-display #__line__ ";run srate ind: ~A" (run (lambda () (srate ind)))))
- (if (not (= (run (lambda () (channels ind))) 1))
- (snd-display #__line__ ";run channels ind: ~A" (run (lambda () (channels ind)))))
- (if (not (= (run (lambda () (frames ind 0))) 50828))
- (snd-display #__line__ ";run frames ind: ~A" (run (lambda () (frames ind 0)))))
- (vct-map! v (lambda () (next-sample r)))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample ftst: ~A" v))
- (vct-map! v (lambda () (previous-sample r)))
- (if (or (fneq (vct-ref v 0) .0551) (fneq (vct-ref v 1) .0662)) (snd-display #__line__ ";previous-sample ftst: ~A" v))
- (previous-sample r)
- (next-sample r)
- (vct-map! v (lambda () (read-sample r)))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";read-sample ftst: ~A" v))
- (vct-map! v (lambda () (r)))
- (if (or (fneq (vct-ref v 0) .039) (fneq (vct-ref v 1) .024)) (snd-display #__line__ ";read-sample apply ftst: ~A" v))
- (etst '(set! (sample 100) 0.0))
- )
- (close-sound ind))
+ (define (fv178) (let ((x 2.0) (y 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x y)))))
+ (test (fv178) (float-vector 6.0 6.0 6.0 6.0))
- (let ((ind (open-sound "oboe.snd")))
- (let ((val (run (lambda () (let ((ho (make-sampler 12345.0))) (read-sample ho))))))
- (if (fneq val 0.0549)
- (snd-display #__line__ ";run make-sampler with float sample arg: ~A" val)))
- (let ((v (make-vct 2)))
- (ftst '(let ((r (make-sampler 1200.0))) (next-sample r)) 0.04898)
- (vct-map! v (let ((r (make-sampler 2000)))
- (lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let ftst: ~A" v))
- (vct-map! v (let ((r (make-sampler 2000 #f)))
- (lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let ftst #f: ~A" v))
- (vct-map! v (let ((r (make-sampler 2000 #f #f)))
- (lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let ftst #f #f: ~A" v))
- (vct-map! v (let ((r (make-sampler 2000 #f #f 1 current-edit-position)))
- (lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let ftst #f #f 1 -1: ~A" v))
- (vct-map! v (let ((r (make-sampler 2000 ind)))
- (lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let snd ftst: ~A" v))
- (vct-map! v (let ((r (make-sampler 2000 ind 0)))
- (lambda () (next-sample r))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let chn ftst: ~A" v))
- (vct-map! v (let ((r (make-sampler 2000 ind 0 1 (edit-position ind 0))))
- (lambda ()
- (if (or (not (= (edit-position ind 0) 0))
- (not (= (edit-position ind) 0))
- (not (= (edit-position) 0)))
- (begin
- (report-in-minibuffer "oops")
- (report-in-minibuffer "oops again" ind)
- -123.0)
- (next-sample r)))))
- (if (or (fneq (vct-ref v 0) .0662) (fneq (vct-ref v 1) .0551)) (snd-display #__line__ ";next-sample let edit ftst: ~A" v))
- (itst '(frames) 50828)
- (itst (list 'frames ind) 50828)
- (itst (list 'frames ind 0) 50828)
- (itst (list 'frames ind 0 0) 50828)
- (itst (list 'frames #f 0) 50828)
- (itst (list 'frames #f #f) 50828)
- (itst (list 'frames #f #f current-edit-position) 50828)
- (itst (list 'cursor ind) 0)
- (itst (list 'cursor) 0)
- (itst (list 'cursor ind 0) 0)
- (ftst (list 'maxamp ind 0) .1472)
- (ftst (list 'maxamp ind 0 -1) .1472)
- (ftst (list 'maxamp ind 0 0) .1472)
- (ftst (list 'maxamp) .1472)
- (set! (cursor ind 0) 100)
- (itst (list 'cursor ind) 100)
- (itst (list 'cursor) 100)
- (itst (list 'cursor ind 0) 100)
- (etst '(edit-position ind 0 0))
- (close-sound ind)))
- (let ((ind0 (new-sound "fmv0.snd" mus-next mus-bfloat 22050 1 "map tests"))
- (ind1 (new-sound "fmv1.snd" mus-next mus-bfloat 22050 1 "map tests"))
- (ones (make-vct 1000000))
- (t0 0)
- (t1 0)
- (ts '()))
- (vct-map! ones (lambda () (- 1.0 (* 2 (random 1.0)))))
- (vct->channel ones 0 1000000 ind0)
- (vct->channel ones 0 1000000 ind1)
- (set! (optimization) 0)
- (set! t0 (time-it (map-channel (lambda (y) (* y 2)) 0 1000000 ind0)))
- (set! (optimization) max-optimization)
- (set! t1 (time-it (map-channel (lambda (y) (* y 2)) 0 1000000 ind1)))
- (if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display #__line__ ";y * 2 run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "*2 " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
- (set! (optimization) 0)
- (set! t0 (time-it (map-channel (lambda (y) (- y 1.0)) 0 1000000 ind0)))
- (set! (optimization) max-optimization)
- (set! t1 (time-it (map-channel (lambda (y) (- y 1.0)) 0 1000000 ind1)))
- (if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display #__line__ ";y - 1 run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "-1 " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
- (set! (optimization) 0)
- (set! t0 (time-it (map-channel (lambda (y) (abs (sin y))) 0 1000000 ind0)))
- (set! (optimization) max-optimization)
- (set! t1 (time-it (map-channel (lambda (y) (abs (sin y))) 0 1000000 ind1)))
- (if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display #__line__ ";abs sin run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "abs sin" (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
- (set! (optimization) 0)
- (set! t0 (time-it (map-channel (lambda (y) (let ((a (* y 2))) (if (> y 1.0) 1.0 y))) 0 1000000 ind0)))
- (set! (optimization) max-optimization)
- (set! t1 (time-it (map-channel (lambda (y) (let ((a (* y 2))) (if (> y 1.0) 1.0 y))) 0 1000000 ind1)))
- (if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display #__line__ ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "let if " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
- (set! (optimization) 0)
- (set! t0 (time-it (map-channel (let ((v (make-vct 3))) (lambda (y) (vct-set! v 1 .5) (* y (vct-ref v 1)))) 0 1000000 ind0)))
- (set! (optimization) max-optimization)
- (set! t1 (time-it (map-channel (let ((v (make-vct 3))) (lambda (y) (vct-set! v 1 .5) (* y (vct-ref v 1)))) 0 1000000 ind1)))
- (if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display #__line__ ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "vct-ref" (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
-
- (set! (optimization) 0)
- (set! t0 (time-it (let ((osc (make-oscil :frequency 440))
- (e1 (make-env '(0 0 1 1 2 0) :length 1000000)))
- (map-channel (lambda (y) (* (env e1) (oscil osc y))) 0 1000000 ind0))))
- (set! (optimization) max-optimization)
- (set! t1 (time-it (let ((osc (make-oscil :frequency 440))
- (e1 (make-env '(0 0 1 1 2 0) :length 1000000)))
- (map-channel (lambda (y) (* (env e1) (oscil osc y))) 0 1000000 ind1))))
- (if (not (vequal (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (snd-display #__line__ ";let y run: ~A ~A" (channel->vct 0 1000000 ind0) (channel->vct 0 1000000 ind1)))
- (set! ts (cons (list "osc+env" (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
-
- (close-sound ind0)
- (close-sound ind1)
- (snd-display #__line__ ";timings:~{~%~20T~A~}" ts))
-
- (let ((v0 (make-vct 10))
- (v1 (make-vct 10)))
- (set! (optimization) 0) (vct-map! v0 (lambda () .1))
- (set! (optimization) max-optimization) (vct-map! v1 (lambda () .1))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .1)) (snd-display #__line__ ";vct-map .1: ~A ~A" v0 v1))
- (set! dbl-var .1)
- (set! (optimization) 0) (vct-map! v0 (lambda () dbl-var))
- (set! (optimization) max-optimization) (vct-map! v1 (lambda () dbl-var))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .1)) (snd-display #__line__ ";vct-map dbl-var .1: ~A ~A" v0 v1))
- (let ((dbl-var .3))
- (set! (optimization) 0) (vct-map! v0 (lambda () dbl-var))
- (set! (optimization) max-optimization) (vct-map! v1 (lambda () dbl-var))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .3)) (snd-display #__line__ ";vct-map dbl-var .3: ~A ~A" v0 v1)))
- (let ((dbl-var .3))
- (let ((dbl-var .5))
- (set! (optimization) 0) (vct-map! v0 (lambda () dbl-var))
- (set! (optimization) max-optimization) (vct-map! v1 (lambda () dbl-var))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .5)) (snd-display #__line__ ";vct-map dbl-var .5: ~A ~A" v0 v1))))
- (let ((dbl-var .3))
- (let ((dbl-var .5))
- (set! (optimization) 0) (vct-map! v0 (let ((dbl-var .9)) (lambda () dbl-var)))
- (set! (optimization) max-optimization) (vct-map! v1 (let ((dbl-var .9)) (lambda () dbl-var)))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .9)) (snd-display #__line__ ";vct-map dbl-var .9: ~A ~A" v0 v1))))
- (let ((dbl-var .3))
- (let ((dbl-var .5))
- (set! (optimization) 0) (vct-map! v0 (let ((dbl-var .9)) (lambda () (let ((dbl-var .01)) dbl-var))))
- (set! (optimization) max-optimization) (vct-map! v1 (let ((dbl-var .9)) (lambda () (let ((dbl-var .01)) dbl-var))))
- (if (or (not (vequal v0 v1)) (fneq (vct-ref v1 0) .01)) (snd-display #__line__ ";vct-map dbl-var .01: ~A ~A" v0 v1))))
- )
+ (define (fv179) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 1.0 2.0 3.0)))))
+ (test (fv179) (float-vector 6.0 6.0 6.0 6.0))
- (let ((t0 0)
- (t1 0)
- (ts '()))
- (set! (optimization) 0)
- (set! t0 (time-it (with-temp-sound (:srate 44100 :output (make-vct (round (* 5 (mus-srate))))) (fm-violin 0 5 440 .1))))
- (set! (optimization) max-optimization)
- (set! t1 (time-it (with-temp-sound (:srate 44100 :output (make-vct (round (* 5 (mus-srate))))) (fm-violin 0 5 440 .1))))
- (set! ts (cons (list "fm vln " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
-
- (let ((ind (open-sound "1.snd"))
- (v0 #f)
- (v1 #f))
- (set! (optimization) 0)
- (set! t0 (time-it (expsnd '(0 1 2 .4))))
- (set! v0 (channel->vct 1000 100))
- (undo 1 ind)
- (set! (optimization) max-optimization)
- (set! t1 (time-it (expsnd '(0 1 2 .4))))
- (set! v1 (channel->vct 1000 100))
- (if (not (vequal v0 v1)) (snd-display #__line__ ";expsnd: opt: ~A ~A" v0 v1))
- (set! ts (cons (list "expsnd " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
- (undo 1 ind)
- (set! (optimization) 0)
- (set! t0 (time-it (snd-test-jc-reverb 1.0 #f 1.0 #f)))
- (set! v0 (channel->vct 1000 100))
- (undo 1 ind)
- (set! (optimization) max-optimization)
- (set! t1 (time-it (snd-test-jc-reverb 1.0 #f 1.0 #f)))
- (set! v1 (channel->vct 1000 100))
- (if (not (vequal v0 v1)) (snd-display #__line__ ";jcrev: opt: ~A ~A" v0 v1))
- (set! ts (cons (list "jcrev " (hundred t0) (hundred t1) (round (safe-divide t0 t1))) ts))
- (close-sound ind))
- (snd-display #__line__ "~{~%~20T~A~}~%" ts))
- (if with-gui
- (let* ((osc (make-oscil 440))
- (vi (make-vector 2 1))
- (vf (make-vector 2 .1))
- (v (make-vct 2 3.14))
- (vv (make-vector 2 v))
- (vc (make-vector 2 osc))
- (vc1 (make-vector 12 osc))
- (vi1 (make-vector 12 1))
- (vv1 (make-vector 12 v))
- (ind (open-sound "oboe.snd"))
- (sm (make-sampler 0 ind))
- (mx (mix-vct (make-vct 10 .1) 100))
- (sd (make-sound-data 2 3))
- (mxr (make-mix-sampler mx)))
-
- (run (lambda ()
- (define (hi a) (+ a 1))
- (display "---------------------------------------------------------------") (display #\newline)
- (display 3) (display .14) (display "15") (display #\1) (display #f)
- (display osc) (display vi) (display vf) (display v) (display vv) (display vc) (display sm)
- (display mxr) (display sd) (display vi1) (display vv1) (display vc1)
- (snd-print "snd-print test...")
- (snd-warning "snd-warning test...")
- (report-in-minibuffer "report-in-minibuffer test..." ind)
- (display hi) (display '(1 2)) (display :hiho) (display 'asdf)
- (call/cc (lambda (hiho) (if #f (hiho) (display hiho))))
- (call-with-current-continuation (lambda (hiho) (if #f (hiho) (display hiho))))
- (display svar)
- (display #\newline) (display "---------------------------------------------------------------") (display #\newline)
- ))
- (close-sound ind)))
+ (define (fv180) (let ((x 1.0) (y 6.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y -1.0)))))
+ (test (fv180) (float-vector -6.0 -6.0 -6.0 -6.0))
- (let ((val (run-eval '(lambda () (fneq .1 .1)))))
- (if val (snd-display #__line__ ";embedded func 0: ~A" val)))
- (let ((val (run-eval '(lambda () (fneq .1 .2)))))
- (if (not val) (snd-display #__line__ ";embedded func 1: ~A" val)))
- (let ((val (run-eval '(lambda () (fneq .1 .1001)))))
- (if val (snd-display #__line__ ";embedded func 2: ~A" val)))
-
- (let ((val (run-eval '(fneq .1 .1))))
- (if val (snd-display #__line__ ";embedded func 3: ~A" val)))
- (let ((val (run-eval '(fneq .1 .2))))
- (if (not val) (snd-display #__line__ ";embedded func 4: ~A" val)))
- (let ((val (run-eval '(fneq .1 .1001))))
- (if val (snd-display #__line__ ";embedded func 5: ~A" val)))
-
- (let ((val (run-eval '(efunc-1 1.5))))
- (if (fneq val 2.5) (snd-display #__line__ ";embedded func 6: ~A" val)))
- (let ((val (run-eval '(+ 1.0 (efunc-1 1.5)))))
- (if (fneq val 3.5) (snd-display #__line__ ";embedded func 7: ~A" val)))
- (let ((val (run-eval '(efunc-1 1))))
- (if (not (= val 2)) (snd-display #__line__ ";embedded func 8: ~A" val)))
- (let ((val (run-eval '(* 2 (efunc-1 1)))))
- (if (not (= val 4)) (snd-display #__line__ ";embedded func 9: ~A" val)))
-
- (let ((val (run-eval '(if (fneq .1 .2) (* 2 (efunc-1 1)) -1))))
- (if (not (= val 4)) (snd-display #__line__ ";embedded func 10: ~A" val)))
-
- (let ((val (run-eval '(efunc-2 #f))))
- (if (not val) (snd-display #__line__ ";embedded func 11: ~A" val)))
- (let ((val (run-eval '(if (efunc-2 (fneq .1 .1)) 0 1))))
- (if (not (= val 0)) (snd-display #__line__ ";embedded func 12: ~A" val)))
- (let ((val (run-eval '(if (efunc-2 (fneq .1 (efunc-1 .2))) 0 1))))
- (if (not (= val 1)) (snd-display #__line__ ";embedded func 13: ~A" val)))
-
- (let ((val (run-eval '(efunc-3 (fneq .1 .2) 32 12))))
- (if (not (= val 44)) (snd-display #__line__ ";embedded func 14: ~A" val)))
-
- (let ((val (run-eval '(efunc-4 "hi"))))
- (if (not (string=? val "hi!")) (snd-display #__line__ ";embedded func 15: ~A" val)))
- (let ((val (run-eval '(efunc-5 "hi"))))
- (if (not (= val 3)) (snd-display #__line__ ";embedded func 16: ~A" val)))
-
- (oscil efunc-gen)
- (let ((val (run-eval '(efunc-6 efunc-gen))))
- (if (and (fneq val .125) (fneq val .0626))
- (snd-display #__line__ ";embedded func 17: ~A" val)))
- (let ((val (run-eval '(oscil (efunc-7 efunc-gen)))))
- (if (and (fneq val .248)
- (fneq val .125))
- (snd-display #__line__ ";embedded func 18: ~A" val)))
- (mus-reset efunc-gen)
-
- (let ((v (vct 1.0 2.0)))
- (run (set! (v 1) 32))
- (if (fneq (v 1) 32.0)
- (snd-display #__line__ ";vct set i 32: ~A" v)))
-
- (let* ((arg 3)
- (val (run (lambda () (t22-i->i arg)))))
- (if (not (equal? val 35)) (snd-display #__line__ ";run func i->i: ~A (35)" val)))
- (let* ((arg 3)
- (val (run (lambda () (t22-i2->i arg)))))
- (if (not (equal? val 38)) (snd-display #__line__ ";run func i2->i: ~A (38)" val)))
- (let* ((arg1 3)
- (val (run (lambda () (t22-i->i (t22-i->i arg1))))))
- (if (not (equal? val 67)) (snd-display #__line__ ";run func i->i (2): ~A (67)" val)))
- (let* ((arg1 3)
- (arg2 2)
- (val (run (lambda () (t22-i->i (* arg2 (t22-i->i arg1)))))))
- (if (not (equal? val 102)) (snd-display #__line__ ";run func i->i (3): ~A (102)" val)))
- (let* ((arg 3)
- (val (run (lambda () (t22-i->f arg)))))
- (if (not (equal? val 6.0)) (snd-display #__line__ ";run func i->f: ~A (6.0)" val)))
- (let* ((arg 3)
- (val (run (lambda () (t22-i->s arg)))))
- (if (not (equal? val "yes")) (snd-display #__line__ ";run func i->s: ~A (\"yes\")" val)))
- (let* ((arg 3)
- (val (run (lambda () (t22-i->b arg)))))
- (if (not (equal? val #t)) (snd-display #__line__ ";run func i->b: ~A (#t)" val)))
- (let* ((arg 3)
- (val (run (lambda () (t22-i->c arg)))))
- (if (not (equal? val #\I)) (snd-display #__line__ ";run func i->c: ~A (#\\I)" val)))
- (let* ((arg 3)
- (val (run (lambda () (t22-i->k arg)))))
- (if (not (equal? val :yes)) (snd-display #__line__ ";run func i->k: ~A (:yes)" val)))
- (let* ((arg 3)
- (val (run (lambda () (t22-i->sym arg)))))
- (if (not (equal? val 'yes)) (snd-display #__line__ ";run func i->sym: ~A ('yes)" val)))
- (let* ((arg 440)
- (val (run (lambda () (t22-i->clm arg)))))
- (if (not (equal? val (make-oscil 440))) (snd-display #__line__ ";run func i->clm: ~A (oscil at 440)" val)))
- (let* ((arg1 11)
- (arg2 44.0)
- (val (run (lambda () (t22-i-f->f arg1 arg2)))))
- (if (not (equal? val 55.0)) (snd-display #__line__ ";run func i-f->f: ~A (55.0)" val)))
- (let* ((arg2 1)
- (arg3 44)
- (arg1 (make-vector 3 0))
- (val (run (lambda () (t22-iv-i-i->iv arg1 arg2 arg3)))))
- (if (not (equal? val '#(0 44 0))) (snd-display #__line__ ";run func iv-i-i->iv: ~A (#(0 44 0))" val)))
- (let* ((arg2 1)
- (arg3 44.0)
- (arg1 (make-vector 3 0.0))
- (val (run (lambda () (t22-fv-i-f->fv arg1 arg2 arg3)))))
- (if (not (vequal val (vct 0.0 44.0 0.0))) (snd-display #__line__ ";run func iv-i-f->iv: ~A (#(0.0 44.0 0.0))" val)))
- (let ((val (run (lambda () (t22-s->c "abcdef")))))
- (if (not (equal? val #\b)) (snd-display #__line__ ";run func s->c: ~A (#\\b)" val)))
- (let ((sd (make-sound-data 2 2)))
- (sound-data-set! sd 1 1 3.0)
- (let ((val (t22-sd->f sd)))
- (if (fneq val 3.0) (snd-display #__line__ ";run func sd->f: ~A (3.0)" val))))
- (let ((sd (make-sound-data 2 2)))
- (sound-data-set! sd 1 1 3.0)
- (let ((val (t22-sd->sd sd)))
- (if (fneq (sound-data-ref val 1 1) 44.0) (snd-display #__line__ ";run func sd->sd: ~A (44.0)" val))))
- (let ((gen (make-fir-filter 12 (make-vct 12 .1))))
- (let ((val (t22-clm->i gen)))
- (if (not (equal? val 12)) (snd-display #__line__ ";run func clm->i: ~A (12)" val))))
- (let* ((arg (vct 1.0 2.0 3.0 4.0))
- (val (t22-vct->vct arg)))
- (if (not (vequal val (vct 1.0 44.0 3.0 4.0))) (snd-display #__line__ ";run func vct->vct: ~A (<1 2 3 4>)" val)))
- (let* ((arg (vector (make-oscil 330.0) (make-oscil 440.0) (make-oscil 550.0)))
- (val (t22-cv->f arg)))
- (if (fneq val 440.0) (snd-display #__line__ ";run func clm-vect->f: ~A (440.0)" val)))
-
- (let* ((arg1 3.0)
- (val (run (lambda () (+ 1.0 (* arg1 2))))))
- (if (fneq val 7.0) (snd-display #__line__ ";mfa run opt: ~A (7.0)" val)))
- (let* ((arg1 3.0)
- (arg2 5)
- (arg3 4)
- (val (run (lambda () (+ (* arg2 arg1) (* arg1 arg3))))))
- (if (fneq val 27.0) (snd-display #__line__ ";mfi run opt: ~A (27.0)" val)))
- (let* ((arg1 2.0)
- (val (run (lambda () (* (sin (/ pi 2)) arg1)))))
- (if (fneq val 2.0) (snd-display #__line__ ";sin and pi run opt: ~A (2.0)" val)))
- (let* ((arg1 2.0)
- (arg2 pi)
- (val (run (lambda () (* (sin (/ arg2 2)) arg1)))))
- (if (fneq val 2.0) (snd-display #__line__ ";sin run opt: ~A (2.0)" val)))
-
- (let ((val
- (let ((xx 3)
- (yy 0))
- (run
- (lambda ()
- (let ((x (+ xx 1)))
- (do ((i x (+ i 1)))
- ((= i 10))
- (set! yy x)))))
- yy)))
- (if (not (= val 4)) (snd-display #__line__ ";run do: ~A (4)" val)))
-
- (let ((val
- (let ((xx 3)
- (yy 0))
- (run
- (lambda ()
- (let* ((x (+ xx 1)))
- (let ((i x))
- (set! i 10)
- (set! yy x)))))
- yy)))
- (if (not (= val 4)) (snd-display #__line__ ";run do 1: ~A (4)" val)))
-
- (let ((val
- (let ((x 0))
- (define (x+ a) (set! x a) (+ a 1))
- (run
- (lambda ()
- (do ((i 0 (x+ i)))
- ((= i 4)))))
- x)))
- (if (not (= val 3)) (snd-display #__line__ ";run do 2: ~A (3)" val)))
-
- (let ((val
- (let ((x 0))
- (define (x+ a) (set! x a) (+ a 1))
- (do ((i 0 (x+ i)))
- ((= i 4)))
- x)))
- (if (not (= val 3)) (snd-display #__line__ ";run do 3: ~A (3)" val)))
-
- (let ((val
- (run
- (lambda ()
- (let ((xx 0))
- (do ((i xx (+ i 1)))
- ((= i 4) xx)
- (set! xx i)))))))
- (if (not (= val 3)) (snd-display #__line__ ";run do 4: ~A (3)" val)))
-
- (let ((val
- (let ((xx 0))
- (run
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i 3) xx)
- (set! xx i)))))))
- (if (not (= val 2)) (snd-display #__line__ ";run do 5: ~A (2)" val)))
-
- (let ((val
- (let ((k 2)
- (x 3.1))
- (run
- (lambda ()
- (* k x))))))
- (if (fneq val 6.2) (snd-display #__line__ ";run do 6: ~A (6.2)" val)))
+ (define (fv181) (let ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y z)))))
+ (test (fv181) (float-vector -6.0 -6.0 -6.0 -6.0))
- (let ((val
- (let ((k 2)
- (x 3.1))
- (run
- (lambda ()
- (* x k))))))
- (if (fneq val 6.2) (snd-display #__line__ ";run do 7: ~A (6.2)" val)))
+ (define (fv182) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x -1.0 6.0)))))
+ (test (fv182) (float-vector -6.0 -6.0 -6.0 -6.0))
- (let ((val
- (let ((k 2)
- (x 3.1))
- (run
- (lambda ()
- (+ k x))))))
- (if (fneq val 5.1) (snd-display #__line__ ";run do 8: ~A (5.1)" val)))
+ (define (fv183) (let ((x 3.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x (abs x))))))
+ (test (fv183) (float-vector 9.0 9.0 9.0 9.0))
- (let ((val
- (let ((k 2)
- (x 3.1))
- (run
- (lambda ()
- (+ x k))))))
- (if (fneq val 5.1) (snd-display #__line__ ";run do 9: ~A (5.1)" val)))
+ (define (fv184) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 2 (abs x))))))
+ (test (fv184) (float-vector 8.0 8.0 8.0 8.0))
- (let ((val
- (let ((k 2)
- (x 3.1))
- (run
- (lambda ()
- (- k x))))))
- (if (fneq val -1.1) (snd-display #__line__ ";run do 10: ~A (-1.1)" val)))
+ (define (fv185) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2.0 2 (abs x))))))
+ (test (fv185) (float-vector 8.0 8.0 8.0 8.0))
- (let ((val
- (let ((k 2)
- (x 3.1))
- (run
- (lambda ()
- (- x k))))))
- (if (fneq val 1.1) (snd-display #__line__ ";run do 11: ~A (1.1)" val)))
+ (define (fv186) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2.0 (abs x) (abs x))))))
+ (test (fv186) (float-vector 8.0 8.0 8.0 8.0))
- (let ((val
- (let ((k 2)
- (x 3.1))
- (run
- (lambda ()
- (/ k x))))))
- (if (fneq val 0.64516129) (snd-display #__line__ ";run do 12: ~A (0.64516129)" val)))
+ (define (fv187) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) (abs x) (abs x))))))
+ (test (fv187) (float-vector 8.0 8.0 8.0 8.0))
- (let ((val
- (let ((k 2)
- (x 3.1))
- (run
- (lambda ()
- (/ x k))))))
- (if (fneq val 1.55) (snd-display #__line__ ";run do 12: ~A (1.55)" val)))
-
- (let ((val
- (let ((v (vct 1 2 3 4 5)))
- (run
- (lambda ()
- (vct-ref v 3))))))
- (if (fneq val 4.0) (snd-display #__line__ ";run do 13: ~A (4.0)" val)))
-
- (let ((val
- (let ((v (vct 1 2 3 4 5)))
- (run
- (lambda ()
- (vct-ref v 4))))))
- (if (fneq val 5.0) (snd-display #__line__ ";run do 14: ~A (5.0)" val)))
-
- (let ((val
- (let ((v (vct 1 2 3 4 5)))
- (run
- (lambda ()
- (vct-set! v 3 32.0)
- (vct-ref v 3))))))
- (if (fneq val 32.0) (snd-display #__line__ ";run do 15: ~A (21.0)" val)))
-
- (let ((val
- (let ((v (vct 1 2 3 4 5)))
- (run
- (lambda ()
- (set! (vct-ref v 3) 32.0) ; bug here!
- (vct-ref v 3))))))
- (if (fneq val 32.0) (snd-display #__line__ ";run do 16: ~A (21.0)" val)))
-
- (let ((data1 (make-vct 10))
- (data2 (make-vct 10))
- (gen1 (make-oscil 100.0))
- (gen2 (make-oscil 100.0))
- (e1 (make-env '(0 0 1 1) :end 10))
- (e2 (make-env '(0 0 1 1) :end 10))
- (x1 0.1)
- (y1 0.2)
- (x2 0.1)
- (y2 0.2))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (vct-set! data1 i (* (env e1) (oscil gen1 (+ x1 y1)))))
- (run
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (vct-set! data2 i (* (env e2) (oscil gen2 (+ x2 y2)))))))
- (if (not (vequal data1 data2)) (snd-display #__line__ ";run opt oscil_1f_2_env: ~A ~A" data1 data2)))
-
- (let ((data1 (make-vct 10))
- (data2 (make-vct 10))
- (gen1 (make-polyshape 100.0 0.0 (vct 1 .5 2 .5)))
- (gen2 (make-polyshape 100.0 0.0 (vct 1 .5 2 .5)))
- (e1 (make-env '(0 0 1 1) :end 10))
- (e2 (make-env '(0 0 1 1) :end 10))
- (x1 0.1)
- (x2 0.1))
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (vct-set! data1 i (* (env e1) (polyshape gen1 1.0 x1))))
- (run
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i 10))
- (vct-set! data2 i (* (env e2) (polyshape gen2 1.0 x2))))))
- (if (not (vequal data1 data2)) (snd-display #__line__ ";run opt polyshape_1fn_env: ~A ~A" data1 data2)))
+ (define (fv188) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x (abs x))))))
+ (test (fv188) (float-vector 8.0 8.0 8.0 8.0))
- (let ((val (catch 'oops
- (lambda ()
- (run (lambda ()
- (let ((inner 0))
- (do ((i 0 (+ 1 i)))
- ((= i 10) inner)
- (if (= inner 3)
- (throw 'oops))
- (set! inner i))))))
- (lambda args (car args)))))
- (if (not (eq? val 'oops)) (snd-display #__line__ ";run throw: ~A" val)))
+ (define (fv188) (let ((x 2.0) (y 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x y)))))
+ (test (fv188) (float-vector 8.0 8.0 8.0 8.0))
- (let ((outer 0))
- (let ((val (catch 'oops
- (lambda ()
- (run (lambda ()
- (let ((inner 0))
- (do ((i 0 (+ 1 i)))
- ((= i 10) inner)
- (set! outer i)
- (if (= inner 3)
- (throw 'oops))
- (set! inner i))))))
- (lambda args (car args)))))
- (if (not (eq? val 'oops)) (snd-display #__line__ ";run throw: ~A" val))
- (if (not (= outer 4)) (snd-display #__line__ ";run throw reset outer: ~A" outer))))
-
- (let ((val (run (lambda () (let ((v (make-vct 2 .1))) (define (ho xv) (declare (xv vct)) (vct-ref xv 1)) (ho v))))))
- (if (fneq val 0.1) (snd-display #__line__ ";run embedded lambda arg vct: ~A" val)))
- (let ((val (run (lambda () (let ((v (make-vct 2 .1))) (define (ho) (make-vct 3 .5)) (vct-ref (ho) 0))))))
- (if (fneq val 0.5) (snd-display #__line__ ";run embedded lambda rtn vct: ~A" val)))
- (let ((val (run (lambda () (let ((v (make-sound-data 2 3))) (define (ho xv) (declare (xv sound-data)) (sound-data-chans xv)) (ho v))))))
- (if (not (= val 2)) (snd-display #__line__ ";run embedded lambda arg sound-data: ~A" val)))
- (let ((val (run (lambda () (let ((v (make-sound-data 2 3))) (define (ho) (make-sound-data 3 5)) (sound-data-length (ho)))))))
- (if (not (= val 5)) (snd-display #__line__ ";run embedded lambda rtn sound-data: ~A" val)))
- (if with-gui
- (let ((ind (open-sound "oboe.snd")))
- (let ((val (run (lambda ()
- (let ((r (make-sampler 1000 ind 0)))
- (define (ho rd) (declare (rd sampler)) (next-sample rd))
- (ho r))))))
- (if (fneq val (sample 1000)) (snd-display #__line__ ";run embedded lambda arg sampler: ~A ~A" (sample 1000) val)))
- (let ((val (run (lambda ()
- (define (ho) (make-sampler 1000 ind 0))
- (read-sample (ho))))))
- (if (fneq val (sample 1000)) (snd-display #__line__ ";run embedded lambda rtn sampler: ~A ~A" (sample 1000) val)))
- (close-sound ind)))
+ (define (fv189) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 4.5 3/2)))))
+ (test (fv189) (float-vector 6.75 6.75 6.75 6.75))
- (let ((ind (open-sound "oboe.snd")))
- ;; check that sequestering works with init-func/ptree-channel
- (ring-modulate-channel 100)
- (make-region 0 10000)
- (close-sound ind))
+ (define (fv190) (let ((x 1/2) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 1 x)))))
+ (test (fv190) (float-vector 0.5 0.5 0.5 0.5))
- (let ((lrla (make-vct 16))
- (lvok #f))
- (let ((val (run (lambda ()
- (vct-set! lrla 0 1.0)
- (vct-set! lrla 4 1.0)
- (let ((v (autocorrelate lrla)))
- (set! lvok (vct? v)))
- lrla))))
- (if (not lvok) (snd-display #__line__ ";run autocorrelate vct return?"))
- (if (not (vct? lrla)) (snd-display #__line__ ";run lambda vct return: ~A?" lrla))
- (if (fneq (vct-ref val 0) 2.0) (snd-display #__line__ ";run autocorrelate 0: ~A" (vct-ref lrla 0)))
- (if (fneq (vct-ref val 4) 1.0) (snd-display #__line__ ";run autocorrelate 4: ~A" (vct-ref lrla 4)))))
-
- (if (not (vequal (vct -0.5 1 1)
- (run (lambda () (partials->polynomial (vct 1 1 2 .5))))))
- (snd-display #__line__ ";run partials->polynomial no kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5))))))
- (if (not (vequal (vct -0.5 1 1)
- (run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-first-kind)))))
- (snd-display #__line__ ";run partials->polynomial 1st kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-first-kind)))))
- (if (not (vequal (vct 1 1 0)
- (run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-second-kind)))))
- (snd-display #__line__ ";run partials->polynomial 2nd kind: ~A" (run (lambda () (partials->polynomial (vct 1 1 2 .5) mus-chebyshev-second-kind)))))
-
- (let ((vals (vct 1 1 3 1)))
- (let ((nvals (run (lambda () (normalize-partials vals)))))
- (if (not (vequal nvals (vct 1.000 0.500 3.000 0.500)))
- (snd-display #__line__ ";run normalize-partials: ~A" nvals))))
-
- (let ((ho 123))
- (let ((val (run-eval '(lambda () (lfunc)))))
- (if (not (= val 3)) (snd-display #__line__ ";opt 6 case broken!: ~A" val))))
-
- (let ((old-opt (optimization)))
- (set! (optimization) 4) ; below global-set level
- (run-eval '(set! int-var 4321))
- (if (not (= int-var 4321)) (snd-display #__line__ ";no global set, int: ~A" int-var))
- (run-eval '(set! dbl-var 4321.5))
- (if (fneq dbl-var 4321.5) (snd-display #__line__ ";no global set, dbl: ~A" dbl-var))
- (run-eval '(set! c-var #\f))
- (if (not (char=? c-var #\f)) (snd-display #__line__ ";no global set, char: ~A" c-var))
- (run-eval '(set! bool-var #t))
- (if (not bool-var) (snd-display #__line__ ";no global set, bool: ~A" bool-var))
- (run-eval '(set! str-var "hiha"))
- (if (not (string=? str-var "hiha")) (snd-display #__line__ ";no global set, str: ~A" str-var))
- (run-eval '(vector-set! ivect 1 2))
- (if (not (= (vector-ref ivect 1) 2)) (snd-display #__line__ ";no global set, ivect: ~A" (vector-ref ivect 1)))
- (set! (optimization) old-opt))
-
- (let ((old-opt (optimization)))
- (for-each
- (lambda (n)
- (set! (optimization) n)
- (run (lambda ()
- (set! unique-float 1.5)
- (set! unique-int 5)
- (set! unique-char #\z)
- (set! unique-string "a new string")
- (set! unique-boolean #f)
- (vector-set! unique-float-vector 1 3.0)
- (vector-set! unique-int-vector 1 6)))
- (if (not (= unique-int 5)) (snd-display #__line__ ";unique-int (~A): ~A" n unique-int))
- (if (fneq unique-float 1.5) (snd-display #__line__ ";unique-float (~A): ~A" n unique-float))
- (if (not (char=? unique-char #\z)) (snd-display #__line__ ";unique-char (~A): ~A" n unique-char))
- (if (not (string=? unique-string "a new string")) (snd-display #__line__ ";unique-string (~A): ~A" n unique-string))
- (if (not (= (vector-ref unique-int-vector 1) 6)) (snd-display #__line__ ";unique-int-vector (~A): ~A" n unique-int-vector))
- (if (fneq (vector-ref unique-float-vector 1) 3.0) (snd-display #__line__ ";unique-float-vector (~A): ~A" n unique-float-vector))
- (if unique-boolean (snd-display #__line__ ";unique-boolean?"))
- (set! unique-float 3.0)
- (set! unique-int 3)
- (set! unique-char #\c)
- (set! unique-string "hiho")
- (set! unique-boolean #t)
- (vector-set! unique-float-vector 1 1.0)
- (vector-set! unique-int-vector 1 1))
- (list 3 6))
- (set! (optimization) old-opt))
-
- (let ((val (run-eval '(format #f "~A" 'hiho))))
- (if (or (not (string? val))
- (not (string=? val "hiho")))
- (snd-display #__line__ ";run format 'hiho: ~A" val)))
- (let ((val (run (lambda () (oscil (make-oscil :frequency 100 :initial-phase 0.0))))))
- (if (fneq val 0.0) (snd-display #__line__ ";run oscil make-oscil: ~A" val)))
- (let ((val (run-eval '(format #f "~A ~A ~A ~A ~A" 'a 'b 'c 'd 'e))))
- (if (not (string=? val "a b c d e"))
- (snd-display #__line__ ";run format abcde: ~A" val)))
-
- (let ((val (run-eval '(let ((str1 (format #f "~A~A" 'a 'a))
- (str2 (format #f "~A" 'a))
- (str3 (format #f "~A~A~A" 'a 'a 'a))
- (str4 (format #f "~A" 'a))
- (str5 (format #f "~A" 'a))
- (str6 (format #f "~A" 'b)))
- (string-append str1 str2 str3 str4 str5 str6)))))
- (if (not (string=? val "aaaaaaaab"))
- (snd-display #__line__ ";run format aaaaaaaab: ~A" val)))
-
- (let ((tag (catch #t (lambda () (mus-close 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";mus-close 1: ~A" tag)))
-
- (if (file-exists? "test.snd")
- (delete-file "test.snd"))
- (run (lambda ()
- (let ((v (make-sample->file "test.snd" 2 mus-lshort mus-riff)))
- (sample->file v 0 0 0.7)
- (mus-close v))))
- (if (not (file-exists? "test.snd"))
- (snd-display #__line__ ";run sample->file no file")
- (let ((ind (open-sound "test.snd")))
- (if (not (= (data-format ind) mus-lshort)) (snd-display #__line__ ";run sample->file data format: ~A" (mus-data-format-name (data-format ind))))
- (if (not (= (header-type ind) mus-riff)) (snd-display #__line__ ";run sample->file header type: ~A" (mus-header-type-name (header-type ind))))
- (if (not (= (frames ind) 1)) (snd-display #__line__ ";run sample->file frames: ~A" (frames ind)))
- (if (not (= (channels ind) 2)) (snd-display #__line__ ";run sample->file chans: ~A" (channels ind)))
- (if (fneq (sample 0 ind) 0.7) (snd-display #__line__ ";run sample->file sample: ~A" (sample 0 ind)))
- (close-sound ind)))
+ (define (fv191) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 6.0)))))
+ (test (fv191) (float-vector 6.0 6.0 6.0 6.0))
- (if (file-exists? "test.snd")
- (delete-file "test.snd"))
- (run (lambda ()
- (let ((v (make-frame->file "test.snd" 4 mus-bfloat mus-aifc)))
- (frame->file v 0 (make-frame 4 0.7 0.3 0.1 0.2))
- (mus-close v))))
- (if (not (file-exists? "test.snd"))
- (snd-display #__line__ ";run frame->file no file")
- (let ((ind (open-sound "test.snd")))
- (if (not (= (data-format ind) mus-bfloat)) (snd-display #__line__ ";run frame->file data format: ~A" (mus-data-format-name (data-format ind))))
- (if (not (= (header-type ind) mus-aifc)) (snd-display #__line__ ";run frame->file header type: ~A" (mus-header-type-name (header-type ind))))
- (if (not (= (frames ind) 1)) (snd-display #__line__ ";run frame->file frames: ~A" (frames ind)))
- (if (not (= (channels ind) 4)) (snd-display #__line__ ";run frame->file chans: ~A" (channels ind)))
- (if (fneq (sample 0 ind 0) 0.7) (snd-display #__line__ ";run frame->file sample 0: ~A" (sample 0 ind 0)))
- (if (fneq (sample 0 ind 1) 0.3) (snd-display #__line__ ";run frame->file sample 1: ~A" (sample 0 ind 1)))
- (if (fneq (sample 0 ind 2) 0.1) (snd-display #__line__ ";run frame->file sample 2: ~A" (sample 0 ind 2)))
- (if (fneq (sample 0 ind 3) 0.2) (snd-display #__line__ ";run frame->file sample 3: ~A" (sample 0 ind 3)))
- (close-sound ind)))
+ (define (fv192) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 5.0)))))
+ (test (fv192) (float-vector 5.0 5.0 5.0 5.0))
- (let ((tag (catch #t (lambda () (make-frame 2 .1 .2 .3)) (lambda args (car args)))))
- (if (not (eq? tag 'mus-error))
- (snd-display #__line__ ";frame too many args: ~A" tag)))
+ (define (fv193) (let ((x 1.0) (y 5.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y)))))
+ (test (fv193) (float-vector 5.0 5.0 5.0 5.0))
+
+ (define (fvi164) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1 2 3)))))
+ (test (fvi164) (int-vector 6 6 6 6))
+ (define (fvi165) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 4.5 3/2)))))
+ (test (catch #t fvi165 (lambda args 'error)) 'error)
- (let ((val (run-eval '(lambda (a) (declare (a sound-data)) (sound-data-ref a 0 0)) (make-sound-data 1 1))))
- (if (fneq val 0.0) (snd-display #__line__ ";run sound-data arg: ~A" val)))
+ (define (fvi166) (let ((x 1/2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1 x)))))
+ (test (catch #t fvi166 (lambda args 'error))'error)
- (let ((rdat (make-vct 16))
- (idat (make-vct 16))
- (v (make-vct 1)))
- (vct-set! rdat 0 1.0)
- (vct-map! v (lambda ()
- (spectrum rdat idat #f 1)
- 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (if (fneq (vct-ref rdat i) 1.0)
- (snd-display #__line__ ";run impulse->flat? ~A" rdat))))
+ (define (fvi167) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 6)))))
+ (test (fvi167) (int-vector 6 6 6 6))
- (let ((val (run-eval '(frame-ref (sample->frame (make-mixer 1 1.0) .5) 0))))
- (if (fneq val 0.5) (snd-display #__line__ ";run sample->frame no frame: ~A" val)))
+ (define (fvi168) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 5)))))
+ (test (fvi168) (int-vector 6 6 6 6))
- (run (lambda () (oscil unique-generator))) ; needed below
+ (define (fvi169) (let ((x 1) (y 5) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y)))))
+ (test (fvi169) (int-vector 6 6 6 6))
- (let ((tag (catch #t (lambda ()
- (run-eval '(lambda (a) (declare (sound-data a)) (sound-data-ref a 0 0))
- (make-sound-data 1 1)))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run declare backwards sound-data: ~A" tag)))
-
-
- (let ((val (run-eval '(format #f "~A ~A" (+ 1 2) (* 3 4)))))
- (if (not (string=? val "3 12")) (snd-display #__line__ ";run format 3 12: ~A" val)))
- (let ((val (run-eval '(format #f "~A ~A" (make-vct 3 1.0) (make-vector 3 2.0)))))
- (if (not (string=? val "#<vct[len=3]: 1.000 1.000 1.000> #<vct[len=3]: 2.000 2.000 2.000>"))
- (snd-display #__line__ ";run format vcts: ~A" val)))
- (let ((val (run-eval '(format #f "~A ~A" (string-append "a" "b") (number? "c")))))
- (if (not (string=? val "ab #f")) (snd-display #__line__ ";run format ab #f: ~A" val)))
- (let ((old-opt (optimization)))
- (set! (optimization) 6)
- (let ((val (run (lambda () (format #f "~A ~A" (make-vct 3 1.0) (make-vector 3 2.0))))))
- (if (not (string=? val "#<vct[len=3]: 1.000 1.000 1.000> #<vct[len=3]: 2.000 2.000 2.000>"))
- (if (string=? val "#<vct[len=3]: 1.000 1.000 1.000> #(2.0 2.0 2.0)")
- (snd-display #__line__ ";run format vector instead of vct: ~A (opt: ~A, max: ~A)" val (optimization) max-optimization)
- (snd-display #__line__ ";run format vcts l: ~A" val))))
- (let ((val (run (lambda () (format #f "~A ~A" (string-append "a" "b") (number? "c"))))))
- (if (not (string=? val "ab #f")) (snd-display #__line__ ";run format ab #f l: ~A" val)))
- (let ((val (run (lambda () (format #f "~A ~A" (make-sound-data 1 1) (make-oscil))))))
- (if (and (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)> #<oscil freq: 0.000Hz, phase: 0.000>"))
- (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)> oscil freq: 0.000Hz, phase: 0.000")))
- (snd-display #__line__ ";run format sd osc: ~A" val)))
- (let ((val (run (lambda () (format #f "~A ~A" (+ 1 2) (* 3 4))))))
- (if (not (string=? val "3 12")) (snd-display #__line__ ";run format 3 12 l: ~A" val)))
- (set! (optimization) old-opt))
-
- (let ((hi (vector 1 2 3)))
- (let ((ho (run (lambda () (vector-set! hi 2 4) hi))))
- (if (not (vector? ho))
- (snd-display #__line__ ";run rtns int vect: ~A" ho)
- (if (not (= (vector-ref ho 2) 4))
- (snd-display #__line__ ";run sets int vect: ~A" (vector-ref ho 2))))))
-
- (let ((hi (run (lambda () (let ((v (make-vector 3 0))) (vector-set! v 1 2) v)))))
- (if (not (vector? hi))
- (snd-display #__line__ ";run rtns make int vect: ~A" hi)
- (if (not (= (vector-ref hi 1) 2))
- (snd-display #__line__ ";run sets make int vect: ~A" (vector-ref hi 1)))))
+ (define (fvi170) (let ((x 1) (y 6) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y -1)))))
+ (test (fvi170) (int-vector 6 6 6 6))
- (let ((tag (catch #t (lambda ()
- (run-eval '(lambda (x)
- (declare (x boolean))
- (let ((val (if x 123 "hi")))
- val))
- #t))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run branches ~A" tag)))
- (let ((tag (catch #t (lambda ()
- (run-eval '(lambda (x)
- (declare (x float))
- (let ((val (if x 123 "hi")))
- val))
- #t))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run selector ~A" tag)))
- (let ((tag (catch #t (lambda ()
- (run-eval '(lambda (x)
- (declare (x int))
- (let ((val (case x ((0) 0) (hi 3))))
- val))
- 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run case key ~A" tag)))
-
- (let ((val (run (lambda () (let ((val (if (> 3 2) 123 "hi"))) val)))))
- (if (not (= val 123)) (snd-display #__line__ ";run opt-if 123: ~A" val)))
- (let ((val (run-eval '(if (< 3 2) 123 "hi"))))
- (if (not (string=? val "hi")) (snd-display #__line__ ";run opt-if-not 123: ~A" val)))
- (let ((sd (make-sound-data 1 1)))
- (let ((val (run (lambda () (format #f "~A" sd)))))
- (if (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)>"))
- (snd-display #__line__ ";run format sound-data 0: ~A" val))))
- (let ((val (run-eval '(format #f "~A" (make-sound-data 1 1)))))
- (if (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)>"))
- (snd-display #__line__ ";run format sound-data 1: ~A" val)))
- (let ((val (run-eval '(lambda (arg)
- (declare (arg sound-data))
- (format #f "~A" arg))
- (make-sound-data 1 1))))
- (if (not (string=? val "#<sound-data[chans=1, length=1]:\n (0.000)>"))
- (snd-display #__line__ ";run format sound-data 2: ~A" val)))
-
- (let ((val (run-eval '(format #f "~A" (make-oscil)))))
- (if (and (not (string=? val "#<oscil freq: 0.000Hz, phase: 0.000>"))
- (not (string=? val "oscil freq: 0.000Hz, phase: 0.000")))
- (snd-display #__line__ ";run format gen 0: ~A" val)))
- (let ((val (run (lambda () (format #f "~A" unique-generator)))))
- (if (and (not (string=? val "#<oscil freq: 0.000Hz, phase: 0.000>"))
- (not (string=? val "oscil freq: 0.000Hz, phase: 0.000")))
- (snd-display #__line__ ";run format gen phase 1: ~A" val)))
- (let ((val (run-eval '(format #f "~A" unique-generator))))
- (if (and (not (string=? val "#<oscil freq: 0.000Hz, phase: 0.000>"))
- (not (string=? val "oscil freq: 0.000Hz, phase: 0.000")))
- (snd-display #__line__ ";run format gen phase 2: ~A" val)))
+ (define (fvi171) (let ((x 1) (y 6) (z -1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y z)))))
+ (test (fvi171) (int-vector 6 6 6 6))
- (let ((make-procs (list
- make-all-pass make-asymmetric-fm make-moving-average
- make-comb make-filtered-comb (lambda () (make-convolve :filter (vct 0.0 .1 .2)))
- make-delay (lambda () (make-env '(0 1 1 0)))
- (lambda () (make-filter :xcoeffs (vct 0.0 .1 .2))) (lambda () (make-fir-filter :xcoeffs (vct 0.0 .1 .2)))
- make-formant (lambda () (make-frame 3 .1 .2 .3)) make-granulate
- (lambda () (make-iir-filter :xcoeffs (vct 0.0 .1 .2))) make-locsig (lambda () (make-mixer 3 3))
- make-notch make-one-pole make-one-zero make-oscil
- make-pulse-train make-rand make-rand-interp make-sawtooth-wave
- make-nrxysin make-nrxycos make-square-wave make-src make-ncos
- make-nsin make-table-lookup make-triangle-wave
- make-two-pole make-two-zero make-wave-train make-phase-vocoder make-ssb-am make-polyshape make-polywave
- (lambda () (make-filter :ycoeffs (vct 0.0 .1 .2)))
- (lambda () (make-filter :xcoeffs (vct 1.0 2.0 3.0) :ycoeffs (vct 0.0 1.0 2.0))))))
- (for-each
- (lambda (n)
- (let* ((gen (n))
- (val1 (format #f "~A" gen))
- (val2 (run (lambda () (format #f "~A" gen)))))
-
- (if (not (string=? val1 val2))
- (snd-display #__line__ ";run format gen: format: ~A, run format: ~A (~A)" val1 val2 gen))))
- make-procs))
-
- (let ((val1 (run-eval '(format #f "~A" (make-all-pass))))
- (val2 (run (lambda () (let ((gen (make-all-pass))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-all-pass))))
-
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
-
- (let ((val1 (run-eval '(format #f "~A" (make-asymmetric-fm ))))
- (val2 (run (lambda () (let ((gen (make-asymmetric-fm ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-asymmetric-fm ))))
-
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-moving-average))))
- (val2 (run (lambda () (let ((gen (make-moving-average))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-moving-average))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-comb ))))
- (val2 (run (lambda () (let ((gen (make-comb ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-comb ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-filtered-comb :filter (make-one-zero .5 .5)))))
- (val2 (run (lambda () (let ((gen (make-filtered-comb :filter (make-one-zero .5 .5)))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-filtered-comb :filter (make-one-zero .5 .5)))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-delay ))))
- (val2 (run (lambda () (let ((gen (make-delay ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-delay ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-firmant ))))
- (val2 (run (lambda () (let ((gen (make-firmant ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-firmant ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-formant ))))
- (val2 (run (lambda () (let ((gen (make-formant ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-formant ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-granulate))))
- (val2 (run (lambda () (let ((gen (make-granulate))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-granulate))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-locsig ))))
- (val2 (run (lambda () (let ((gen (make-locsig ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-locsig ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-notch ))))
- (val2 (run (lambda () (let ((gen (make-notch ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-notch ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-one-pole ))))
- (val2 (run (lambda () (let ((gen (make-one-pole ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-one-pole ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-one-zero ))))
- (val2 (run (lambda () (let ((gen (make-one-zero ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-one-zero ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-oscil ))))
- (val2 (run (lambda () (let ((gen (make-oscil ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-oscil ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-pulse-train ))))
- (val2 (run (lambda () (let ((gen (make-pulse-train ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-pulse-train ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-rand ))))
- (val2 (run (lambda () (let ((gen (make-rand ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-rand ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-sawtooth-wave))))
- (val2 (run (lambda () (let ((gen (make-sawtooth-wave))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-sawtooth-wave))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-nrxysin ))))
- (val2 (run (lambda () (let ((gen (make-nrxysin ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-nrxysin ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-nrxycos ))))
- (val2 (run (lambda () (let ((gen (make-nrxycos ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-nrxycos ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-square-wave ))))
- (val2 (run (lambda () (let ((gen (make-square-wave ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-square-wave ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-src ))))
- (val2 (run (lambda () (let ((gen (make-src ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-src ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-ncos ))))
- (val2 (run (lambda () (let ((gen (make-ncos ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-ncos ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-nsin ))))
- (val2 (run (lambda () (let ((gen (make-nsin ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-nsin ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-table-lookup ))))
- (val2 (run (lambda () (let ((gen (make-table-lookup ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-table-lookup ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-triangle-wave))))
- (val2 (run (lambda () (let ((gen (make-triangle-wave))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-triangle-wave))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-two-pole ))))
- (val2 (run (lambda () (let ((gen (make-two-pole ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-two-pole ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-two-zero ))))
- (val2 (run (lambda () (let ((gen (make-two-zero ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-two-zero ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-wave-train ))))
- (val2 (run (lambda () (let ((gen (make-wave-train ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-wave-train ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-polyshape ))))
- (val2 (run (lambda () (let ((gen (make-polyshape ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-polyshape ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-polywave ))))
- (val2 (run (lambda () (let ((gen (make-polywave ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-polywave ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-phase-vocoder ))))
- (val2 (run (lambda () (let ((gen (make-phase-vocoder ))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-phase-vocoder ))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((val1 (run-eval '(format #f "~A" (make-ssb-am))))
- (val2 (run (lambda () (let ((gen (make-ssb-am))) (format #f "~A" gen)))))
- (val3 (format #f "~A" (make-ssb-am))))
- (if (or (not (string=? val1 val2))
- (not (string=? val2 val3)))
- (snd-display #__line__ ";run-eval format: ~A ~A ~A" val1 val2 val3)))
-
- (let ((v (run
- (lambda ()
- (let ((x 2.0)
- (y 3.0))
- (let ((p (make-polyshape 440 :partials (vct 1 x 2 y))))
- (mus-data p)))))))
- (if (not (vequal v (vct -3 2 6))) (snd-display #__line__ ";run make-polyshape vct x y: ~A" v)))
+ (define (fvi172) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x -1 6)))))
+ (test (fvi172) (int-vector 6 6 6 6))
- (let ((v (run
- (lambda ()
- (let ((x 2.0)
- (y 3.0))
- (let ((p (make-polyshape 440 :partials (vct 1 (+ x y) 2 (- y x)))))
- (mus-data p)))))))
- (if (not (vequal v (vct -1 5 2))) (snd-display #__line__ ";run make-polyshape vct x+y: ~A" v)))
-
- (let ((val (run-eval '(format #f "~A" unique-symbol))))
- (if (not (string=? val "hiho")) (snd-display #__line__ ";run format symbol: ~A" val)))
- (let ((val (run-eval '(symbol? unique-symbol))))
- (if (not val) (snd-display #__line__ ";run-eval symbol? global?")))
- (let ((val (run (lambda () (symbol? unique-symbol)))))
- (if (not val) (snd-display #__line__ ";run symbol? global?")))
- (let ((val (run (lambda () (eq? unique-symbol :hiho)))))
- (if val (snd-display #__line__ ";run :hiho is a symbol?")))
- (let ((val (run (lambda () (eq? unique-symbol 'hiho)))))
- (if (not val) (snd-display #__line__ ";run eq? symbol 'hiho?")))
- (let ((val (run-eval '(symbol? unique-keyword))))
- (if val (snd-display #__line__ ";run symbol? of keyword")))
- (let ((val (run-eval '(keyword? unique-keyword))))
- (if (not val) (snd-display #__line__ ";run keyword? of keyword?")))
- (let ((val (run (lambda () (eq? unique-keyword :hiho)))))
- (if (not val) (snd-display #__line__ ";run eq? of :hiho?")))
- (let ((val (run (lambda () (eq? unique-keyword 0)))))
- (if val (snd-display #__line__ ";run eq? key 0?")))
- (let ((val (run-eval '(cond ((= 1 2) 3) ((+ 2 3) 4)))))
- (if (not (= val 4)) (snd-display #__line__ ";run bad cond: ~A" val)))
- (let ((tag (catch #t (lambda () (run-eval '(let ((a 3)) (set! a (current-environment))))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad set!: ~A" tag)))
- (let ((tag (catch #t (lambda () (run-eval '(let ((a 2)) (define "hi" 3) a))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad define: ~A" tag)))
-
- (vector-set! unique-float-vector 1 "hi")
- (let ((tag (catch #t (lambda () (run (lambda () (vector-ref unique-float-vector 1)))) (lambda args (car args)))))
- (if (not (equal? tag "hi")) (snd-display #__line__ ";run bad float vector: ~A" tag)))
- (vector-set! unique-float-vector 1 1.0)
-
- (vector-set! unique-int-vector 2 "hi")
- (let ((tag (catch #t (lambda () (run (lambda () (vector-ref unique-int-vector 1)))) (lambda args (car args)))))
- (if (not (equal? tag 1)) (snd-display #__line__ ";run bad int vector: ~A" tag)))
- (vector-set! unique-int-vector 2 2)
-
- (do ((i 0 (+ 1 i))) ((= i 2)) (vector-set! unique-clm-vector i (make-oscil)))
- (vector-set! unique-clm-vector 2 "hi")
- (let ((tag (catch #t (lambda () (run (lambda () (vector-ref unique-clm-vector 1)))) (lambda args (car args)))))
- (if (not (oscil? tag)) (snd-display #__line__ ";run bad clm vector: ~A" tag)))
- (vector-set! unique-clm-vector 2 (make-oscil))
-
- (let ((tag (catch #t (lambda () (run-eval '(let ((a 1)) (set! c a)))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad set var: ~A" tag)))
-
- (do ((i 0 (+ 1 i))) ((= i 2)) (vector-set! unique-vct-vector i (make-vct 3)))
- (vector-set! unique-vct-vector 2 "hi")
- (let ((tag (catch #t (lambda () (run (lambda () (vector-ref unique-vct-vector 1)))) (lambda args (car args)))))
- (if (not (vct? tag)) (snd-display #__line__ ";run bad vct vector: ~A" tag)))
- (vector-set! unique-vct-vector 2 (make-vct 3))
-
- (let ((val (run-eval '(let* ((a 1) (b (if (odd? a) :hi :ho))) (keyword? b)))))
- (if (not val) (snd-display #__line__ ";run local return key")))
- (let ((val (run-eval '(let* ((a 1) (b (if (odd? a) :hi :ho))) b))))
- (if (not (equal? val :hi)) (snd-display #__line__ ";run local return key: ~A" val)))
- (let ((val (run-eval '(let* ((a 1) (b (if (even? a) 'hi 'ho))) (symbol? b)))))
- (if (not val) (snd-display #__line__ ";run local return symbol")))
- (let ((val (run-eval '(let* ((a 1) (b (if (even? a) 'hi 'ho))) b))))
- (if (not (equal? val 'ho)) (snd-display #__line__ ";run local return symbol: ~A" val)))
-
- (let ((val (run (lambda () (let* ((a 1) (b (if (odd? a) :hi :ho))) (equal? b :hi))))))
- (if (not (equal? val #t)) (snd-display #__line__ ";run b2 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1) (b :hi)) (equal? b :hi))))))
- (if (not (equal? val #t)) (snd-display #__line__ ";run b3 ~A:" val)))
- (let ((val (run-eval '(let* ((a 1) (b :hi)) b))))
- (if (not (equal? val :hi)) (snd-display #__line__ ";run b4 ~A:" val)))
- (let ((val (run-eval '(let* ((a 1) (b 'ho)) b))))
- (if (not (equal? val 'ho)) (snd-display #__line__ ";run b5 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (if (odd? a) :hi :ho))))))
- (if (not (equal? val :hi)) (snd-display #__line__ ";run b6 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (if (odd? a) 'hi 'ho))))))
- (if (not (equal? val 'hi)) (snd-display #__line__ ";run b7 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (case a ((0) :hi) ((1) :ho) (else :ha)))))))
- (if (not (equal? val :ho)) (snd-display #__line__ ";run b8 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (begin :hi))))))
- (if (not (equal? val :hi)) (snd-display #__line__ ";run b9 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (cond ((= a 0) :hi) ((= a 1) :ho) (else :ha)))))))
- (if (not (equal? val :ho)) (snd-display #__line__ ";run b10 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (cond ((= a 0) :hi) ((= a 1) :ho)))))))
- (if (not (equal? val :ho)) (snd-display #__line__ ";run b11 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (or (= a 0) :hi))))))
- (if (not val) (snd-display #__line__ ";run b12 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (and (= a 1) 'hi))))))
- (if (not val) (snd-display #__line__ ";run b13 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (cond ((= a 0) 1) ((= a 1) 2) (else 3)))))))
- (if (not (equal? val 2)) (snd-display #__line__ ";run b14 ~A:" val)))
- (let ((val (run (lambda () (let* ((a 1)) (cond ((= a 0) "hi") ((= a 1) "ho") (else "ha")))))))
- (if (not (equal? val "ho")) (snd-display #__line__ ";run b15 ~A:" val)))
- (let ((val (run-eval '(if #t :hi))))
- (if (not (equal? val :hi)) (snd-display #__line__ ";run b16 ~A:" val)))
- (let ((val (run-eval '(if #f :hi :ho))))
- (if (not (equal? val :ho)) (snd-display #__line__ ";run b17 ~A:" val)))
- (let ((val (run-eval '(let ((a (let ((b :hi)) b))) a))))
- (if (not (equal? val :hi)) (snd-display #__line__ ";run b18 ~A:" val)))
- (let ((val (run-eval '(let ((a 1) (b :hi)) (if (odd? a) b :ho)))))
- (if (not (equal? val :hi)) (snd-display #__line__ ";run b19 ~A:" val)))
- (let ((val (run-eval '(let ((a 1) (b :hi)) (if #t b :ho)))))
- (if (not (equal? val :hi)) (snd-display #__line__ ";run b20 ~A:" val)))
- (let ((val (run-eval '(let ((a #\a)) (if (char? a) a)))))
- (if (not (equal? val #\a)) (snd-display #__line__ ";run b21 ~A:" val)))
- (let ((val (run-eval '(let ((a #\a)) (if (number? a) a)))))
- (if (not (equal? val #f)) (snd-display #__line__ ";run b22 ~A:" val)))
- (let ((val (run-eval '(let ((a #\a)) (if (char? a) '(1 2))))))
- (if (not (equal? val '(1 2))) (snd-display #__line__ ";run b24 ~A:" val)))
-
- (let ((val (run (lambda () (let* ((a 1) (b :hi)) (if (odd? a) (set! b :ho)) b)))))
- (if (not (equal? val :ho)) (snd-display #__line__ ";run b25 ~A" val)))
- (let ((tag (catch #t (lambda () (run-eval '(let* ((a 1) (b (case (a) ((0) -1) ((1) a) else -2)))))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad case selector: ~A" tag)))
- (let ((tag (catch #t (lambda () (run-eval '(let* ((a 1) (b (case a ((0) -1) ((1) a) else -2))) b))) (lambda args (car args)))))
- (if (not (eq? tag 'cannot-parse)) (snd-display #__line__ ";run bad case else: ~A" tag)))
- (let ((val (run-eval '(let* ((a 1) (b (case 0 ((0) -1) ((1) a)))) b))))
- (if (not (= val -1)) (snd-display #__line__ ";run b26 ~A" val)))
- (let ((val (run-eval '(let* ((a 1) (b (case a ((0) -1) ((1) a)))) b))))
- (if (not (= val 1)) (snd-display #__line__ ";run b27 ~A" val)))
- (let ((val (run-eval '(let* ((a 1) (b (case 0 ((0) -1) ((1) a) (else -2)))) b))))
- (if (not (= val -1)) (snd-display #__line__ ";ru b28 ~A" val)))
- (let ((val (run-eval '(let* ((a 1) (b (case 3 ((0) -1) ((1) a) (else -2)))) b))))
- (if (not (= val -2)) (snd-display #__line__ ";run b29 ~A" val)))
- (let ((val (run-eval '(let* ((a 1) (b (case a ((0) -1) ((1) a) (else -2)))) b))))
- (if (not (= val 1)) (snd-display #__line__ ";run b30 ~A" val)))
- (let ((val (run-eval '(begin (case 0 ((0) -1) ((1) 0) (else -2)) 2))))
- (if (not (= val 2)) (snd-display #__line__ ";run b31 ~A" val)))
-
- (let ((val (run (lambda () (let ((a :ho)) (define (hi b) (declare (b keyword)) b) (hi a))))))
- (if (not (equal? val :ho)) (snd-display #__line__ ";run b32 ~A" val)))
- (let ((val (run (lambda () (let ((a 'ho)) (define (hi b) (declare (b symbol)) b) (hi a))))))
- (if (not (equal? val 'ho)) (snd-display #__line__ ";run b33 ~A" val)))
- (let ((val (run (lambda () (let ((a "ho")) (define (hi b) (declare (b string)) b) (hi a))))))
- (if (not (equal? val "ho")) (snd-display #__line__ ";run b34 ~A" val)))
- (let ((val (run (lambda () (let ((a unique-int-vector)) (define (hi b) (declare (b int-vector)) b) (vector-ref (hi a) 0))))))
- (if (not (= val 1)) (snd-display #__line__ ";run b35 ~A" val)))
- (set! unique-generator (make-delay 3))
- (let ((val (run-eval '(vct-ref (mus-data unique-generator) 0)))) ; if oscil here, segfault
- (if (fneq val 0.0) (snd-display #__line__ ";run b36 ~A" val)))
-
- (let ((val (run-eval '(make-oscil 440.0))))
- (if (not (oscil? val)) (snd-display #__line__ ";run -> gen: ~A" val)))
- (let ((val (run-eval '(let ((a 1)) (if (odd? a) (make-oscil))))))
- (if (not (oscil? val)) (snd-display #__line__ ";run if -> gen: ~A" val)))
- (let ((val (run-eval '(let ((a :hoi) (b :ha)) (do ((i 0 (+ 1 i))) ((= i 3) a) (set! b a))))))
- (if (not (equal? val :hoi)) (snd-display #__line__ ";run b37 ~A" val)))
- (let ((val (run-eval '(let ((a "hio") (b "ha")) (do ((i 0 (+ 1 i))) ((= i 3) a) (set! b a))))))
- (if (not (equal? val "hio")) (snd-display #__line__ ";run b38 ~A" val)))
- (let ((val (run-eval '(let ((a (make-oscil)) (b 0)) (do ((i 0 (+ 1 i))) ((= i 3) a) (set! b i))))))
- (if (not (oscil? val)) (snd-display #__line__ ";run b39 ~A" val)))
- (let ((osc (make-oscil)))
- (let ((val (run (lambda () (oscil osc) (mus-reset osc) (oscil osc)))))
- (if (fneq val 0.0) (snd-display #__line__ ";run reset oscil: ~A ~A" val osc))))
- (let ((gen (make-oscil 440.0)))
- (let ((val (run (lambda () (let ((g1 gen)) (oscil g1) (oscil g1))))))
- (if (and (fneq val 0.1250)
- (fneq val 0.0626))
- (snd-display #__line__ ";let osc g1: ~A" val))))
- (let ((gen (make-oscil 440.0)))
- (let ((val (run (lambda () (let ((g1 gen)) (oscil g1 1.0) (oscil g1 0.5))))))
- (if (and (fneq val 0.9024)
- (fneq val 0.8736))
- (snd-display #__line__ ";let osc g1 1: ~A" val))))
- (let ((gen (make-oscil 440.0)))
- (let ((val (run (lambda () (let ((g1 gen)) (oscil g1 0.0 1.0) (oscil g1 0.0 0.5))))))
- (if (and (fneq val 0.585)
- (fneq val 0.5334))
- (snd-display #__line__ ";let osc g1 0 1: ~A" val))))
-
- (let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (> hi 2) 2 3)) a))))
- (if (not (= val 2)) (snd-display #__line__ ";set let: ~A" val)))
- (let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (> hi 123) 2 3)) a))))
- (if (not (= val 3)) (snd-display #__line__ ";set let 2: ~A" val)))
- (let ((val (run-eval '(let ((a 0)) (set! a (do ((i 0 (+ 1 i))) ((= i 3) (+ i 1)) (set! a (* i 3))))))))
- (if (not (= val 4)) (snd-display #__line__ ";set do ~A" val)))
- (let ((val (run-eval '(let ((a 0)) (set! a (cond ((= a 0) 1) ((= a 1) 2))) a))))
- (if (not (= val 1)) (snd-display #__line__ ";set cond ~A" val)))
- (let ((val (run-eval '(let ((a 1)) (set! a (cond ((= a 0) 1) ((= a 1) 2))) a))))
- (if (not (= val 2)) (snd-display #__line__ ";set cond 2 ~A" val)))
- (let ((val (run-eval '(let ((a 1)) (set! a (case a ((0) 1) ((1) 2))) a))))
- (if (not (= val 2)) (snd-display #__line__ ";set case ~A" val)))
- (let ((val (run-eval '(let ((a 1)) (set! a (begin (set! a 2) (+ a 1)))))))
- (if (not (= val 3)) (snd-display #__line__ ";set begin ~A" val)))
- (let ((val (run-eval '(let ((a 1)) (set! a (let ((b 2)) (set! b (* b 2)) b))))))
- (if (not (= val 4)) (snd-display #__line__ ";set let 3 ~A" val)))
- (let ((val (run-eval '(let* ((a 3) (b a)) (set! a (let ((c 2)) (set! c (* b c 2)) c))))))
- (if (not (= val 12)) (snd-display #__line__ ";set let 4 ~A" val)))
-
- (let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (> hi 2) (if (> a 1) 2 3) 4)) a))))
- (if (not (= val 3)) (snd-display #__line__ ";set let 6: ~A" val)))
- (let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (< hi 2) (if (> a 1) 2 3) 4)) a))))
- (if (not (= val 4)) (snd-display #__line__ ";set let 7: ~A" val)))
- (let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (< hi 2) (if (< a 1) 2 3) 4)) a))))
- (if (not (= val 4)) (snd-display #__line__ ";set let 8: ~A" val)))
- (let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (> hi 2) (if (< a 1) 2 3) 4)) a))))
- (if (not (= val 2)) (snd-display #__line__ ";set let 9: ~A" val)))
- (let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (< hi 2) (if (< a 1) 2 3) (if (> a 1) 4 5))) a))))
- (if (not (= val 5)) (snd-display #__line__ ";set let 10: ~A" val)))
- (let ((val (run-eval '(let ((a 0) (hi 3)) (set! a (if (< hi 2) (if (< a 1) 2 3) (if (< a 1) 4 5))) a))))
- (if (not (= val 4)) (snd-display #__line__ ";set let 10: ~A" val)))
- (let ((val (run-eval '(or 1 2))))
- (if (not (= val 1)) (snd-display #__line__ ";or 1 2: ~A" val)))
- (let ((val (run-eval '(or #f 2))))
- (if (not val) (snd-display #__line__ ";or #f 2: ~A" val)))
- (let ((val (run-eval '(and #f 2))))
- (if (not (eq? val #f)) (snd-display #__line__ ";and #f 2: ~A" val)))
- (let ((a 0))
- (let ((val (run (lambda () (and (let ((b 32)) (if (< a 0) (set! a b) (set! a (+ 1 b))) #t) #f)))))
- (if val (snd-display #__line__ ";run side-effect and result: ~A" val))
- (if (not (= a 33)) (snd-display #__line__ ";run side-effect and a: ~A" a))))
- (let ((a 0))
- (let ((val (run (lambda () (or (let ((b 32)) (if (< a 0) (set! a b) (set! a (+ 1 b))) #f) #t)))))
- (if (not val) (snd-display #__line__ ";run side-effect or result: ~A" val))
- (if (not (= a 33)) (snd-display #__line__ ";run side-effect or a: ~A" a))))
-
- (let ((tag (catch #t (lambda () (run-eval '(let ((a 0)) (set! a (and 1 3)) a))) (lambda args (car args)))))
- (if (not (equal? tag 'cannot-parse)) (snd-display #__line__ ";set and not bool: ~A" tag)))
- (let ((val (run-eval '(if 1 2 3))))
- (if (not (= val 2)) (snd-display #__line__ ";if not bool: ~A" val)))
-
- (let ((val (run-eval '(let* ((sine (make-vct 32 1.0))
- (sr (make-table-lookup :wave sine)))
- (let ((b (mus-data sr)))
- (vct-ref b 2))))))
- (if (fneq val 1.0) (snd-display #__line__ ";mus-data -> vct opt: ~A" val)))
-
- (let ((diff
- (run (lambda ()
- (let ((x 1.0))
- (let ((val1 (bes-j0 x))
- (val2 (if (< (abs x) 8.0) ;direct rational function fit
- (let* ((y (* x x))
- (ans1 (+ 57568490574.0
- (* y (+ -13362590354.0
- (* y (+ 651619640.7
- (* y (+ -11214424.18
- (* y (+ 77392.33017
- (* y -184.9052456)))))))))))
- (ans2 (+ 57568490411.0
- (* y (+ 1029532985.0
- (* y (+ 9494680.718
- (* y (+ 59272.64853
- (* y (+ 267.8532712 y)))))))))))
- (/ ans1 ans2))
- (let* ((ax (abs x))
- (z (/ 8.0 ax))
- (y (* z z))
- (xx (- ax 0.785398164))
- (ans1 (+ 1.0
- (* y (+ -0.1098628627e-2
- (* y (+ 0.2734510407e-4
- (* y (+ -0.2073370639e-5
- (* y 0.2093887211e-6)))))))))
- (ans2 (+ -0.1562499995e-1
- (* y (+ 0.1430488765e-3
- (* y (+ -0.6911147651e-5
- (* y (+ 0.7621095161e-6
- (* y -0.934945152e-7))))))))))
- (* (sqrt (/ 0.636619772 ax))
- (- (* (cos xx) ans1)
- (* z (sin xx) ans2)))))))
- (abs (- val1 val2))))))))
- (if (> diff .001) (snd-print (format #f ";opt exploded j0 ~A ~A?" val1 val2))))
- (ftst '(bes-j0 1.0) 0.7651976865)
- (ftst '(bes-j1 1.0) 0.4400505857)
- (ftst '(bes-jn 2 1.0) 0.11490348)
- (ftst '(bes-y0 1.0) 0.0882569642)
- (ftst '(bes-y1 1.0) -0.78121282)
- (ftst '(bes-yn 2 1.0) -1.65068260)
- (ftst '(erf 0.5) 0.52049987)
- (ftst '(+ (erf .1) (erfc .1)) 1.0)
- (ftst '(lgamma 20.0) 39.33988)
- (ftst '(sinh 1.0) 1.1752011)
- (ftst '(cosh 1.0) 1.54308063)
- (ftst '(tanh 1.0) 0.76159415)
- (ftst '(asinh 1.1752011) 1.0)
- (ftst '(acosh 1.54308063) 1.0)
- (ftst '(atanh 0.76159415) 1.0)
- (ftst '(bes-i0 1.0) 1.2660659)
-
- (ftst '(let ((val1 1.0)) (bes-j0 val1)) 0.7651976865)
- (ftst '(let ((val1 1.0)) (bes-j1 val1)) 0.4400505857)
- (ftst '(let ((val1 1.0) (two 2)) (bes-jn two val1)) 0.11490348)
- (ftst '(let ((val1 1.0)) (bes-y0 val1)) 0.0882569642)
- (ftst '(let ((val1 1.0)) (bes-y1 val1)) -0.78121282)
- (ftst '(let ((val1 1.0) (two 2)) (bes-yn two val1)) -1.65068260)
- (ftst '(let ((val5 0.5)) (erf val5)) 0.52049987)
- (ftst '(let ((val1 0.1)) (+ (erf val1) (erfc val1))) 1.0)
- (ftst '(let ((val20 20.0)) (lgamma val20)) 39.33988)
- (ftst '(let ((val1 1.0)) (sinh val1)) 1.1752011)
- (ftst '(let ((val1 1.0)) (cosh val1)) 1.54308063)
- (ftst '(let ((val1 1.0)) (tanh val1)) 0.76159415)
- (ftst '(let ((val 1.1752011)) (asinh val)) 1.0)
- (ftst '(let ((val 1.54308063)) (acosh val)) 1.0)
- (ftst '(let ((val 0.76159415)) (atanh val)) 1.0)
- (ftst '(let ((val1 1.0)) (bes-i0 val1)) 1.2660659)
-
- (let ((val (run-eval '(let ((osc (make-oscil 440.0)))
- (or (not osc)
- (not (oscil? osc)))))))
- (if val (snd-display #__line__ ";not osc: ~A" val)))
-
- (let ((val (run-eval '(let ((osc1 (make-oscil 440.0))
- (osc2 (make-oscil 880.0)))
- (not (or osc1 osc2))))))
- (if val (snd-display #__line__ ";not osc1: ~A" val)))
-
- (let ((val (run-eval '(let ((osc1 (make-oscil 440.0))
- (osc2 #f))
- (declare (osc2 clm))
- (and osc1 (not osc2))))))
- (if (not val) (snd-display #__line__ ";not osc2: ~A" val)))
-
- (let ((val (run-eval '(let ((v1 (make-vct 3))
- (v2 (make-vct 3)))
- (or (not v1)
- (and v1 v2))))))
- (if (not val) (snd-display #__line__ ";not v1: ~A" val)))
-
- (let ((v1 (make-vector 3 1))
- (v2 (make-vector 3 2)))
- (let ((val (run (lambda ()
- (and v1 v2
- (vector? v1))))))
- (if (not val) (snd-display #__line__ ";outer not vi1: ~A" val))))
-
- (let ((val (run-eval '(let ((v1 (make-vector 3))
- (v2 (make-vector 3)))
- (and v1 v2
- (vector? v1))))))
- (if (not val) (snd-display #__line__ ";not vi1: ~A" val)))
-
- (let ((val (run-eval '(let ((v1 (make-vector 3 1.0))
- (v2 (make-vector 3 2.0)))
- (and v1 v2
- (vector? v1))))))
- (if (not val) (snd-display #__line__ ";not vect1: ~A" val)))
-
- (let ((snd (open-sound "oboe.snd")))
- (let ((r1 (make-sampler 0))
- (r2 (make-sampler 1000)))
- (let ((val (run (lambda ()
- (and r1 r2
- (or r1 r2)
- (sampler? r1))))))
- (if (not val) (snd-display #__line__ ";outer or rd: ~A" val))))
-
- (close-sound snd))
+ (define (fvi173) (let ((x 3) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x (abs x))))))
+ (test (fvi173) (int-vector 6 6 6 6))
+
+ (define (fvi174) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x 2 (abs x))))))
+ (test (fvi174) (int-vector 6 6 6 6))
+
+ (define (fvi175) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2 2 (abs x))))))
+ (test (fvi175) (int-vector 6 6 6 6))
+
+ (define (fvi176) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 2 (abs x) (abs x))))))
+ (test (fvi176) (int-vector 6 6 6 6))
+
+ (define (fvi177) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) (abs x) (abs x))))))
+ (test (fvi177) (int-vector 6 6 6 6))
+
+ (define (fvi178) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x (abs x))))))
+ (test (fvi178) (int-vector 6 6 6 6))
+
+ (define (fvi178) (let ((x 2) (y 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ (abs x) x y)))))
+ (test (fvi178) (int-vector 6 6 6 6))
- (let ((val (run-eval '(let ((str1 "hiho")
- (str2 "ho"))
- (and str1 str2)))))
- (if (not val) (snd-display #__line__ ";or str: ~A" val)))
- (let ((osc #f))
- (let ((val (run (lambda ()
- (declare (osc vct))
- (not osc)))))
- (if (not val) (snd-display #__line__ ";not v osc: ~A" val))))
+ (define (fvi179) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 1 2 3)))))
+ (test (fvi179) (int-vector 6 6 6 6))
- (let ((osc #f))
- (let ((val (run (lambda ()
- (declare (osc vct))
- osc))))
- (if val (snd-display #__line__ ";v osc: ~A" val))))
+ (define (fvi180) (let ((x 1) (y 6) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y -1)))))
+ (test (fvi180) (int-vector -6 -6 -6 -6))
- (let ((ind (open-sound "oboe.snd")))
- (let ((s "hi")
- (v (make-vct 3 3.0))
- (vi (make-vector 3 32))
- (vf (make-vector 3 3.14))
- (sd (make-sound-data 2 4))
- (g (make-oscil 440.0))
- (rd (make-sampler 0))
- (lst (list 1 2))
- ; (pr (cons 1 2)) ; dotted lists aren't currently supported in any way in run
- (ch #\c)
- (ch2 #\null)
- (i 0)
- (i1 32)
- (f 0.0)
- (f1 3.14)
- (ok 0))
- (run (lambda ()
- (let ((v1 (make-vct 3 3.0))
- (vf1 (make-vector 3 3.14))
- (sd1 (make-sound-data 2 4))
- (g1 (make-oscil 440.0))
- (rd1 (make-sampler 0)))
- (if s (set! ok (+ 1 ok)) (clm-print ";if direct s"))
- (if v (set! ok (+ 1 ok)) (clm-print ";if direct v"))
- (if v1 (set! ok (+ 1 ok)) (clm-print ";if direct v1"))
- (if vi (set! ok (+ 1 ok)) (clm-print ";if direct vi"))
- (if vf (set! ok (+ 1 ok)) (clm-print ";if direct vf"))
- (if vf1 (set! ok (+ 1 ok)) (clm-print ";if direct vf1"))
- (if sd (set! ok (+ 1 ok)) (clm-print ";if direct sd"))
- (if sd1 (set! ok (+ 1 ok)) (clm-print ";if direct sd1"))
- (if g (set! ok (+ 1 ok)) (clm-print ";if direct g"))
- (if g1 (set! ok (+ 1 ok)) (clm-print ";if direct g1"))
- (if rd (set! ok (+ 1 ok)) (clm-print ";if direct rd"))
- (if rd1 (set! ok (+ 1 ok)) (clm-print ";if direct rd1"))
- (if lst (set! ok (+ 1 ok)) (clm-print ";if direct lst"))
- ; (if pr (set! ok (+ 1 ok)) (clm-print ";if direct pr"))
- (if ch (set! ok (+ 1 ok)) (clm-print ";if direct ch"))
- (if 0 (set! ok (+ 1 ok)) (clm-print ";if direct 0"))
- (if i (set! ok (+ 1 ok)) (clm-print ";if direct i"))
- (if i1 (set! ok (+ 1 ok)) (clm-print ";if direct i1"))
- (if 0.0 (set! ok (+ 1 ok)) (clm-print ";if direct 0.0"))
- (if f (set! ok (+ 1 ok)) (clm-print ";if direct f"))
- (if f1 (set! ok (+ 1 ok)) (clm-print ";if direct f1"))
- (if ch2 (set! ok (+ 1 ok)) (clm-print ";if direct ch2"))
- (if #\null (set! ok (+ 1 ok)) (clm-print ";if direct null"))
-
- (if (or s v v1 vi vf g rd lst i f) (set! ok (+ 1 ok)) (clm-print ";if direct or"))
- (if (and s v v1 vi vf g rd lst i f) (set! ok (+ 1 ok)) (clm-print ";if direct and"))
-
- (cond ((not s) (clm-print ";cond direct s"))
- ((not v) (clm-print ";cond direct v"))
- ((not v1) (clm-print ";cond direct v1"))
- ((not vi) (clm-print ";cond direct vi"))
- ((not vf) (clm-print ";cond direct vf"))
- ((not vf1) (clm-print ";cond direct vf1"))
- ((not sd) (clm-print ";cond direct sd"))
- ((not sd1) (clm-print ";cond direct sd1"))
- ((not g) (clm-print ";cond direct g"))
- ((not g1) (clm-print ";cond direct g1"))
- ((not rd) (clm-print ";cond direct rd"))
- ((not rd1) (clm-print ";cond direct rd1"))
- ((not lst) (clm-print ";cond direct lst"))
- ; ((not pr) (clm-print ";cond direct pr"))
- ((not ch) (clm-print ";cond direct ch"))
- ((not i) (clm-print ";cond direct i"))
- ((not i1) (clm-print ";cond direct i1"))
- ((not f) (clm-print ";cond direct f"))
- ((not f1) (clm-print ";cond direct f1"))
- ((not ch2) (clm-print ";cond direct ch2")))
-
- )))
-
- (let ((gen (make-linear-src .5))
- (rd (make-sampler 0)))
- (map-channel (lambda (y) (linear-src gen (lambda () (rd))))))
-
- (close-sound ind)
- (if (not (= ok 24)) (clm-print ";ok: ~A" ok))))
-
- (run-eval '(lambda (g) (declare (g clm)) (if g (clm-print ";lambda clm #f arg"))) #f)
- (run-eval '(lambda (g g1) (declare (g clm) (g1 clm)) (if (or g g1) (clm-print ";lambda clm #f args 1"))) #f #f)
- (run-eval '(lambda (g g1) (declare (g clm) (g1 clm)) (if (not (or g g1)) (clm-print ";lambda clm #f args 2"))) #f (make-oscil 344.0))
- (run-eval '(lambda (g g1) (declare (g clm) (g1 clm)) (if (and g g1) (clm-print ";lambda clm #f args 3"))) #f (make-oscil 344.0))
- (run-eval '(lambda (g g1) (declare (g clm) (g1 clm)) (if (not g1) (clm-print ";lambda clm #f args 4"))) #f (make-oscil 344.0))
-
- (run-eval '(lambda (g) (declare (g vct)) (if g (clm-print ";lambda vct #f arg"))) #f)
- (run-eval '(lambda (g g1) (declare (g vct) (g1 vct)) (if (or g g1) (clm-print ";lambda vct #f args 1"))) #f #f)
- (run-eval '(lambda (g g1) (declare (g vct) (g1 vct)) (if (not (or g g1)) (clm-print ";lambda vct #f args 2"))) #f (make-vct 3))
- (run-eval '(lambda (g g1) (declare (g vct) (g1 vct)) (if (and g g1) (clm-print ";lambda vct #f args 3"))) #f (make-vct 3))
- (run-eval '(lambda (g g1) (declare (g vct) (g1 vct)) (if (not g1) (clm-print ";lambda vct #f args 4"))) #f (make-vct 3))
-
- (run-eval '(lambda (g) (declare (g sound-data)) (if g (clm-print ";lambda sound-data #f arg"))) #f)
- (run-eval '(lambda (g g1) (declare (g sound-data) (g1 sound-data)) (if (or g g1) (clm-print ";lambda sound-data #f args 1"))) #f #f)
- (run-eval '(lambda (g g1)
- (declare (g sound-data) (g1 sound-data))
- (if (not (or g g1)) (clm-print ";lambda sound-data #f args 2")))
- #f (make-sound-data 3 3))
- (run-eval '(lambda (g g1)
- (declare (g sound-data) (g1 sound-data))
- (if (and g g1) (clm-print ";lambda sound-data #f args 3")))
- #f (make-sound-data 3 3))
- (run-eval '(lambda (g g1)
- (declare (g sound-data) (g1 sound-data))
- (if (not g1) (clm-print ";lambda sound-data #f args 4")))
- #f (make-sound-data 3 3))
-
- (let ((sd (make-sound-data 2 10)))
- (vct->sound-data (make-vct 10 .25) sd 0)
- (vct->sound-data (make-vct 10 .5) sd 1)
- (run
- (lambda ()
- (sound-data-scale! sd 2.0)))
- (if (not (vequal (sound-data->vct sd 0) (make-vct 10 .5)))
- (snd-display #__line__ ";opt sound-data-scale! chan 0: ~A" (sound-data->vct sd 0)))
- (if (not (vequal (sound-data->vct sd 1) (make-vct 10 1.0)))
- (snd-display #__line__ ";opt sound-data-scale! chan 1: ~A" (sound-data->vct sd 1))))
-
- (let ((sd (make-sound-data 2 10)))
- (run
- (lambda ()
- (sound-data-fill! sd 2.0)))
- (if (not (vequal (sound-data->vct sd 0) (make-vct 10 2.0)))
- (snd-display #__line__ ";opt sound-data-fill! chan 0: ~A" (sound-data->vct sd 0)))
- (if (not (vequal (sound-data->vct sd 1) (make-vct 10 2.0)))
- (snd-display #__line__ ";opt sound-data-fill! chan 1: ~A" (sound-data->vct sd 1))))
+ (define (fvi181) (let ((x 1) (y 6) (z -1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y z)))))
+ (test (fvi181) (int-vector -6 -6 -6 -6))
- (run (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (test-run-protection-release))))
+ (define (fvi182) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x -1 6)))))
+ (test (fvi182) (int-vector -6 -6 -6 -6))
- (let ((o (make-osc 440)))
-
- (oscil o))
+ (define (fvi183) (let ((x 3) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x (abs x))))))
+ (test (fvi183) (int-vector 9 9 9 9))
- (let ((o (make-fc .8 128)))
-
- (filtered-comb o (random 1.0)))
+ (define (fvi184) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 2 (abs x))))))
+ (test (fvi184) (int-vector 8 8 8 8))
- (let ((sd (make-sound-data 4 10)))
- (run (lambda ()
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))))))
- (let ((sd1 (run (lambda () (sound-data-copy sd)))))
- (if (not (equal? sd sd1))
- (snd-display #__line__ ";sound-data-copy not equal? ~A ~A" sd sd1))
- (run (lambda () (sound-data-scale! sd1 2.0)))
- (let ((sd2 (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd2 chn i (* 2 (+ i (* chn 10))))))
- (if (not (equal? sd2 sd1)) (snd-display #__line__ ";sound-data-scale! not equal? ~% ~A~% ~A" sd1 sd2))
- (if (equal? sd2 sd) (snd-display #__line__ ";sound-data-scale! crosstalk??")))
- (run (lambda () (sound-data-multiply! sd sd)))
- (let ((sd2 (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd2 chn i (* (+ i (* chn 10)) (+ i (* chn 10))))))
- (if (not (equal? sd2 sd)) (snd-display #__line__ ";sound-data-multiply! not equal? ~% ~A~% ~A" sd sd2)))
- (run (lambda ()
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))))
- (sound-data-offset! sd 1.0)))
- (let ((sd2 (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd2 chn i (+ 1 i (* chn 10)))))
- (if (not (equal? sd2 sd)) (snd-display #__line__ ";sound-data-offset! not equal? ~% ~A~% ~A" sd sd2)))
- (let ((sd3 (run (lambda () (sound-data-reverse! (sound-data-copy sd))))))
- (let ((sd2 (make-sound-data 4 10)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd2 chn i (+ 1 (- 9 i) (* chn 10)))))
- (if (not (equal? sd2 sd3)) (snd-display #__line__ ";sound-data-reverse! not equal? ~% ~A~% ~A" sd3 sd2)))
- (run (lambda () (sound-data-add! sd sd3)))
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd1 chn i (+ 1 10 (* chn 20)))))
- (if (not (equal? sd1 sd)) (snd-display #__line__ ";sound-data-add! not equal? ~% ~A~% ~A" sd sd1)))
-
- (run (lambda ()
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))
- (sound-data-set! sd1 chn i 1)))))
- (let ((sd2 (sound-data-copy sd)))
- (run (lambda ()
- (sound-data+ sd 1)
- (sound-data-add! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ sd 1: ~% ~A~% ~A" sd sd2))
- (run (lambda ()
- (sound-data+ 1 sd)
- (sound-data-add! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ 1 sd: ~% ~A~% ~A" sd sd2))
- (run (lambda ()
- (sound-data+ sd sd1)
- (sound-data-add! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data+ sd sd: ~% ~A~% ~A" sd sd2)))
-
- (run (lambda ()
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (sound-data-set! sd chn i (+ i (* chn 10)))
- (sound-data-set! sd1 chn i 2)))))
- (let ((sd2 (sound-data-copy sd)))
- (run (lambda ()
- (sound-data* sd 2)
- (sound-data-multiply! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* sd 1: ~% ~A~% ~A" sd sd2))
- (run (lambda ()
- (sound-data* 2 sd)
- (sound-data-multiply! sd2 sd1)))
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* 1 sd: ~% ~A~% ~A" sd sd2))
- (run (lambda ()
- (sound-data* sd sd1)
- (sound-data-add! sd2 sd2)))
- (if (not (equal? sd sd2)) (snd-display #__line__ ";sound-data* sd sd: ~% ~A~% ~A" sd sd2)))))
-
- (let ((index (new-sound "test.snd" mus-next mus-bfloat 22050 4 "*-sound tests" 10)))
- (offset-sound 1.0)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (if (not (vequal (channel->vct 0 10 index chn) (make-vct 10 1.0)))
- (snd-display #__line__ ";offset-sound chan ~A: ~A" chn (channel->vct 0 10 index chn))))
- (scale-sound 0.5)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (if (not (vequal (channel->vct 0 10 index chn) (make-vct 10 0.5)))
- (snd-display #__line__ ";scale-sound chan ~A: ~A" chn (channel->vct 0 10 index chn))))
- (offset-sound 0.5 2 4)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (if (not (vequal (channel->vct 0 10 index chn) (vct 0.5 0.5 1.0 1.0 1.0 1.0 0.5 0.5 0.5 0.5)))
- (snd-display #__line__ ";offset-sound chan [2:4] ~A: ~A" chn (channel->vct 0 10 index chn))))
- (scale-sound 0.5 1 7)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (if (not (vequal (channel->vct 0 10 index chn) (vct 0.5 0.25 0.5 0.5 0.5 0.5 0.25 0.25 0.5 0.5)))
- (snd-display #__line__ ";scale-sound chan [1:7] ~A: ~A" chn (channel->vct 0 10 index chn))))
- (scale-channel 2.0 0 10 index 2)
- (scale-channel 4.0 0 10 index 3)
- (normalize-sound 1.0) ; should be across full sound, so only chan 4 hits 1
- (if (not (vequal (channel->vct 0 10 index 3)
- (vct-scale! (vct 0.5 0.25 0.5 0.5 0.5 0.5 0.25 0.25 0.5 0.5) 2.0)))
- (snd-display #__line__ ";normalize-sound 3: ~A" (channel->vct 0 10 index 3)))
- (if (not (vequal (channel->vct 0 10 index 2)
- (vct 0.5 0.25 0.5 0.5 0.5 0.5 0.25 0.25 0.5 0.5)))
- (snd-display #__line__ ";normalize-sound 2: ~A" (channel->vct 0 10 index 2)))
- (if (not (vequal (channel->vct 0 10 index 1)
- (vct-scale! (vct 0.5 0.25 0.5 0.5 0.5 0.5 0.25 0.25 0.5 0.5) 0.5)))
- (snd-display #__line__ ";normalize-sound 1: ~A" (channel->vct 0 10 index 1)))
- (normalize-sound 2.0 2 4 index)
- (if (not (vequal (channel->vct 0 10 index 3)
- (vct-scale! (vct 0.5 0.25 1.0 1.0 1.0 1.0 0.25 0.25 0.5 0.5) 2.0)))
- (snd-display #__line__ ";normalize-sound 3 [2:4]: ~A" (channel->vct 0 10 index 3)))
- (if (not (vequal (channel->vct 0 10 index 2)
- (vct 0.5 0.25 1.0 1.0 1.0 1.0 0.25 0.25 0.5 0.5)))
- (snd-display #__line__ ";normalize-sound 2 [2:4]: ~A" (channel->vct 0 10 index 2)))
- (revert-sound index)
- (offset-sound 1.0)
- (pad-sound 2 4)
- (do ((chn 0 (+ 1 chn)))
- ((= chn 4))
- (if (not (vequal (channel->vct 0 14 index chn) (vct 1 1 0 0 0 0 1 1 1 1 1 1 1 1)))
- (snd-display #__line__ ";pad-sound chan ~A: ~A" chn (channel->vct 0 14 index chn))))
- (revert-sound)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (set! (sample i index 2) (+ -1.0 (* i .2))))
- (compand-sound)
- (if (not (vequal (channel->vct 0 10 index 2)
- (vct -1.000 -0.924 -0.800 -0.624 -0.370 0.000 0.370 0.624 0.800 0.924)))
- (snd-display #__line__ ";compand-sound 2: ~A" (channel->vct 0 10 index 2)))
- (revert-sound index)
- (offset-sound 0.5)
- (dither-sound 0.1)
- (contrast-sound 2.0)
- (close-sound index))
+ (define (fvi185) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2 2 (abs x))))))
+ (test (fvi185) (int-vector 8 8 8 8))
- (let ((ind (open-sound "2.snd")))
- (let ((val (simultaneous-zero-crossing)))
- (if (not (equal? val (list #t 6))) (snd-display #__line__ ";simultaneous-zero-crossing 0: ~A" val))
- (set! val (simultaneous-zero-crossing 9))
- (if (not (equal? val (list #t 17))) (snd-display #__line__ ";simultaneous-zero-crossing 2: ~A" val)))
- (close-sound ind))
+ (define (fvi186) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 2 (abs x) (abs x))))))
+ (test (fvi186) (int-vector 8 8 8 8))
- (let ((v (make-vct 10 .1))
- (sd (make-sound-data 2 10))
- (v0 (make-vct 10 0.0))
- (v1 (make-vct 10 0.0)))
- (run
- (lambda ()
- (vct->sound-data v sd 0)
- (vct-scale! v 2.0)
- (vct->sound-data v sd 1)
- (sound-data->vct sd 0 v0)
- (sound-data->vct sd 1 v1)))
- (if (not (equal? v0 (make-vct 10 .1))) (snd-display #__line__ ";vct<->sound-data 0: ~A" v0))
- (if (not (equal? v1 (make-vct 10 .2))) (snd-display #__line__ ";vct<->sound-data 1: ~A" v1)))
-
- (let ((val (list 1 2 3)))
- (if (not (= (run (lambda () (list-ref val 1))) 2))
- (snd-display #__line__ ";list-ref 2: ~A" (run (lambda () (list-ref val 1))))))
-
- (let ((val (list 1.0 2.0 3.0)))
- (if (fneq (run (lambda () (list-ref val 1))) 2.0)
- (snd-display #__line__ ";list-ref 2.0: ~A" (run (lambda () (list-ref val 1))))))
-
- (let ((val (list 1 2 3)))
- (if (not (run (lambda () (list? val))))
- (snd-display #__line__ ";list? -> ~A" (run (lambda () (list? val))))))
-
- (let ((val (list 1 2 3 4)))
- (if (not (= (run (lambda () (car val))) 1))
- (snd-display #__line__ ";car 1: ~A" (run (lambda () (car val))))))
-
- (let ((val (list 1 2 3 4)))
- (if (not (= (run (lambda () (cadr val))) 2))
- (snd-display #__line__ ";cadr 2: ~A" (run (lambda () (cadr val))))))
-
- (let ((val (list 1 2 3 4)))
- (if (not (= (run (lambda () (caddr val))) 3))
- (snd-display #__line__ ";caddr 3: ~A" (run (lambda () (caddr val))))))
-
- (let ((val (list 1 2 3 4)))
- (if (not (= (run (lambda () (cadddr val))) 4))
- (snd-display #__line__ ";cadddr 4: ~A" (run (lambda () (cadddr val))))))
-
- (let ((val (list 1 2 3 4)))
- (if (not (= (run (lambda () (+ (car val) (cadddr val)))) 5))
- (snd-display #__line__ ";car + cadddr 5: ~A" (run (lambda () (+ (car val) (cadddr val)))))))
-
- (let ((val (list 1 2 3)))
- (run (lambda () (list-set! val 1 123)))
- (if (not (= (list-ref val 1) 123))
- (snd-display #__line__ ";list-set 123: ~A" val)))
-
- (let ((val (list 1 2 3)))
- (run (lambda () (set-car! val 123)))
- (if (not (= (car val) 123))
- (snd-display #__line__ ";set-car 123: ~A" val)))
-
- (let ((val (list 1.0 2.0 3.0 4.0)))
- (if (fneq (run (lambda () (car val))) 1.0)
- (snd-display #__line__ ";car 1.0: ~A" (run (lambda () (car val))))))
-
- (let ((val (list 1.0 2.0 3.0)))
- (run (lambda () (list-set! val 1 123.0)))
- (if (fneq (list-ref val 1) 123.0)
- (snd-display #__line__ ";list-set 123.0: ~A" val)))
-
- (let ((val (list 1.0 2.0 3.0)))
- (run (lambda () (set-car! val 123.0)))
- (if (fneq (car val) 123.0)
- (snd-display #__line__ ";set-car 123.0: ~A" val)))
-
- (let* ((val (list 1.0 2.0 3.0))
- (locs (list 1 2 3))
- (lv (run (lambda () (list-ref val (list-ref locs 1))))))
- (if (fneq lv 3.0)
- (snd-display #__line__ ";list-ref(list-ref) 3.0: ~A" lv)))
-
- (let* ((val (list 1.0 2.0 3.0))
- (locs (list 1 2 3))
- (lv (run (lambda () (list-ref val (list-ref locs (car locs)))))))
- (if (fneq lv 3.0)
- (snd-display #__line__ ";list-ref(list-ref(car)) 3.0: ~A" lv)))
-
- (let ((val (list "hi" "ho" "ha")))
- (if (not (string=? (run (lambda () (list-ref val 1))) "ho"))
- (snd-display #__line__ ";list-ref strings: ~A" (run (lambda () (list-ref val 1))))))
-
- (let ((val (list "hi" "ho" "ha")))
- (run (lambda () (list-set! val 1 "hiho")))
- (if (not (string=? (list-ref val 1) "hiho"))
- (snd-display #__line__ ";list-set string: ~A" val)))
-
- (let ((val (list (make-oscil 100) (make-oscil 200) (make-oscil 300))))
- (let ((clm (run (lambda () (list-ref val 1)))))
- (if (or (not (oscil? clm))
- (fneq (mus-frequency clm) 200))
- (snd-display #__line__ ";list-ref clm: ~A" clm))))
-
- (let ((val (list (make-vct 10) (make-vct 20) (make-vct 30))))
- (let ((v (run (lambda () (list-ref val 2)))))
- (if (or (not (vct? v))
- (not (= (vct-length v) 30)))
- (snd-display #__line__ ";list-ref vct: ~A" v))))
-
- (let ((val (list 1 2 3)))
- (if (not (= (run (lambda () (length val))) 3))
- (snd-display #__line__ ";length 3: ~A" (run (lambda () (length val))))))
-
- (let ((val '()))
- (if (not (= (run (lambda () (length val))) 0))
- (snd-display #__line__ ";length 0: ~A" (run (lambda () (length val))))))
-
- (let ((gen (make-polyoid 100.0 (vct 1 1 0.0))))
- (let ((val (run (lambda () (mus-ycoeffs gen)))))
- (if (not (vct? val))
- (snd-display #__line__ ";run mus-ycoeffs: ~A" val))))
-
- (let ((val (list 1 2 3)))
- (if (run (lambda () (null? val)))
- (snd-display #__line__ ";null? : ~A" (run (lambda () (null? val))))))
-
- (let ((val '()))
- (if (run (lambda () (not (null? val))))
- (snd-display #__line__ ";not null? : ~A" (run (lambda () (not (null? val)))))))
-
- (let ((val (list #f #t #t)))
- (if (run (lambda () (not (list-ref val 1))))
- (snd-display #__line__ ";list-ref bools (not #t): ~A" (run (lambda () (not (list-ref val 1)))))))
-
- (let ((val (list #f #t #t)))
- (run (lambda () (list-set! val 1 #f)))
- (if (list-ref val 1)
- (snd-display #__line__ ";list-set bools (not #t): ~A" val)))
-
- (let ((val (list #\f #\t #\c)))
- (if (not (char=? (run (lambda () (list-ref val 1))) #\t))
- (snd-display #__line__ ";list-ref chars #\\t): ~A" (run (lambda () (list-ref val 1))))))
-
- (let ((val (list #\f #\t #\c)))
- (run (lambda () (list-set! val 2 #\d)))
- (if (not (char=? (list-ref val 2) #\d))
- (snd-display #__line__ ";list-set char: ~A" val)))
-
- (let ((val (list (vector .1 .2 .3) (vector 1.0 2.0 3.0))))
- (let ((x (run (lambda () (vector-ref (list-ref val 1) 1)))))
- (if (fneq x 2.0) (snd-display #__line__ ";list-ref -> float vector: ~A" x))))
-
- (let ((val (list (vector 1 2 3) (vector 3 4 5))))
- (let ((x (run (lambda () (vector-ref (list-ref val 1) 1)))))
- (if (not (= x 4)) (snd-display #__line__ ";list-ref -> int vector: ~A" x))))
-
- (let ((val (list (vector (make-oscil 100) (make-oscil 200)) (vector (make-oscil 300) (make-oscil 400)))))
- (let ((x (run (lambda () (vector-ref (list-ref val 1) 1)))))
- (if (or (not (oscil? x))
- (fneq (mus-frequency x) 400.0))
- (snd-display #__line__ ";list-ref clm-vector: ~A" x))))
-
- (let ((val (list (vector (make-vct 1) (make-vct 2)) (vector (make-vct 3) (make-vct 4)))))
- (let ((x (run (lambda () (vector-ref (list-ref val 0) 1)))))
- (if (or (not (vct? x))
- (not (= (vct-length x) 2)))
- (snd-display #__line__ ";list-ref vct-vector: ~A" x))))
-
- (let ((val (list (make-sound-data 1 1) (make-sound-data 2 2))))
- (let ((x (run (lambda () (list-ref val 1)))))
- (if (or (not (sound-data? x))
- (not (= (sound-data-chans x) 2)))
- (snd-display #__line__ ";list-ref sound-data: ~A" x))))
-
- (let ((val (list 'a 'b 'c)))
- (let ((sym (run (lambda () (list-ref val 0)))))
- (if (or (not (symbol? sym))
- (not (eq? sym 'a)))
- (snd-display #__line__ ";list-ref sym: ~A" x))))
-
- (let ((val (list 'a 'b 'c)))
- (run (lambda () (list-set! val 1 'd)))
- (if (not (eq? (list-ref val 1) 'd))
- (snd-display #__line__ ";list-set sym: ~A" val)))
-
- (let ((val (list :a :b :c)))
- (let ((sym (run (lambda () (list-ref val 0)))))
- (if (or (not (keyword? sym))
- (not (eq? sym :a)))
- (snd-display #__line__ ";list-ref key: ~A" x))))
-
- (let ((val (list :a :b :c)))
- (run (lambda () (list-set! val 1 :d)))
- (if (not (eq? (list-ref val 1) :d))
- (snd-display #__line__ ";list-set key: ~A" val)))
-
- (let ((val (list (make-sampler 0 "oboe.snd"))))
- (let ((x (run (lambda () (read-sample (list-ref val 0))))))
- (if (fneq x 0.0)
- (snd-display #__line__ ";list-ref sampler: ~A" x))
- (free-sampler (list-ref val 0))))
+ (define (fvi187) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) (abs x) (abs x))))))
+ (test (fvi187) (int-vector 8 8 8 8))
+ (define (fvi188) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x (abs x))))))
+ (test (fvi188) (int-vector 8 8 8 8))
+ (define (fvi188) (let ((x 2) (y 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* (abs x) x y)))))
+ (test (fvi188) (int-vector 8 8 8 8))
- (let ((val (run (lambda () (+ '3 '4)))))
- (if (not (= val 7)) (snd-display #__line__ ";quote '3+'4: ~A" val)))
-
- (let ((val (run (lambda () (+ '3.5 '4.5)))))
- (if (fneq val 8.0) (snd-display #__line__ ";quote '3.5+'4.5: ~A" val)))
+ (define (fvi191) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* 6)))))
+ (test (fvi191) (int-vector 6 6 6 6))
- (let ((val (run (lambda () (list-ref '(1 2 3) 1)))))
- (if (not (= val 2)) (snd-display #__line__ ";quote: '(1 2 3): ~A" val)))
+ (define (fvi192) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x 5)))))
+ (test (fvi192) (int-vector 5 5 5 5))
- (let ((val (run (lambda () (list? '(0 1 2))))))
- (if (not val) (snd-display #__line__ ";(list? '()) #f?")))
+ (define (fvi193) (let ((x 1) (y 5) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (* x y)))))
+ (test (fvi193) (int-vector 5 5 5 5))
+ (define (fv194) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1.0 2.0 3.0 4.0)))))
+ (test (fv194) (float-vector 10.0 10.0 10.0 10.0))
- (let ((ho (make-hi308 1.0 2.0)))
- (if (not (run (lambda () (hi308? ho))))
- (snd-display #__line__ ";hi308? ho: ~A" (run (lambda () (hi308? ho))))))
-
- (let ((ho (make-hi308 1.0 2.0)))
- (if (fneq (run (lambda () (hi308-freq ho))) 1.0)
- (snd-display #__line__ ";hi308-freq 1.0: ~A" (run (lambda () (hi308-freq ho))) 1.0)))
+ (define (fv195) (let ((x 1.0) (y 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ x y (+ x 2.0) 4.0)))))
+ (test (fv195) (float-vector 10.0 10.0 10.0 10.0))
- (let ((ho (make-hi308 1.0 2.0)))
- (run (lambda () (set! (hi308-phase ho) 123.0)))
- (if (fneq (hi308-phase ho) 123.0)
- (snd-display #__line__ ";set hi308-phase 123.0: ~A" ho)))
+ (define (fv196) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1.0 2.0 3.0 4.0 5.0)))))
+ (test (fv196) (float-vector 15.0 15.0 15.0 15.0))
- (let ((ho (make-hi308 1.0 2.0)))
- (if (fneq (run (lambda () (set! (hi308-phase ho) 123.0) (hi308-phase ho))) 123.0)
- (snd-display #__line__ ";set hi308-phase and rtn 123.0: ~A ~A" ho (run (lambda () (set! (hi308-phase ho) 123.0) (hi308-phase ho))) 123.0)))
-
- (let ((ho (make-hi308 :freq 1.0 :phase 2.0)))
- (if (fneq (run (lambda () (call-hi308 ho))) 1.0)
- (snd-display #__line__ ";funcall gen 1.0: ~A" (run (lambda () (call-hi308 ho))))))
+ (define (fv197) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ 1.0 2.0 3.0 4.0 5.0 6.0)))))
+ (test (fv197) (float-vector 21.0 21.0 21.0 21.0))
- (let ((ho (make-hi308 :freq 1.0 :phase 2.0)))
- (run (lambda () (set-hi308 ho)))
- (if (fneq (hi308-freq ho) 3.5) (snd-display #__line__ ";set in outer func: ~A" ho)))
+ (define (fv198) (let ((fv (make-float-vector 4))
+ (a 1.0) (b 2.0) (c 4.0))
+ (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (+ a b 3.0 c (+ a c) (+ b c) (+ a b c) (+ a b c a b c a b c) a b c)))))
+ (test (fv198) (float-vector 56.0 56.0 56.0 56.0))
- (let ((ho (make-hi308 1.0 2.0)))
- (let ((ha (run (lambda () ho))))
- (if (not (hi308? ha))
- (snd-display #__line__ ";run hi308: ~A" ha))))
+
+ (define (fv164) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1.0 2.0 3.0)))))
+ (test (fv164) (float-vector -4.0 -4.0 -4.0 -4.0))
- (let* ((ho (make-hi308 3.0 2.0))
- (val (run-eval '(lambda (y) (declare (y hi308)) y) ho)))
- (if (not (hi308? val))
- (snd-display #__line__ ";run clm-struct prog arg: ~A" val)))
+ (define (fv165) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 4.5 3/2)))))
+ (test (fv165) (float-vector 3.0 3.0 3.0 3.0))
- (let ((val (run-eval '(lambda (y) (declare (y hi308)) y) (make-hi308 3.0 2.0))))
- (if (or (not (hi308? val))
- (fneq (hi308-freq val) 3.0))
- (snd-display #__line__ ";run clm-struct prog arg with make: ~A" val)))
+ (define (fv166) (let ((x 1/2) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1 x)))))
+ (test (fv166) (float-vector .5 .5 .5 .5))
- (let ((val (run-eval '(lambda (y) (declare (y list)) y) (list 1.0 2.0 3.0))))
- (if (or (not (list? val))
- (fneq (list-ref val 1) 2.0))
- (snd-display #__line__ ";run list as arg: ~A" val)))
+ (define (fv167) (let ((fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 6.0)))))
+ (test (fv167) (float-vector -6.0 -6.0 -6.0 -6.0))
+ (define (fv168) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 5.0)))))
+ (test (fv168) (float-vector -4.0 -4.0 -4.0 -4.0))
+ (define (fv169) (let ((x 1.0) (y 5.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y)))))
+ (test (fv169) (float-vector -4.0 -4.0 -4.0 -4.0))
- (let ((val (run (lambda () (make-oscil 200)))))
- (if (or (not (oscil? val))
- (fneq (mus-frequency val) 200))
- (snd-display #__line__ ";run make-oscil: ~A" val)))
+ (define (fv170) (let ((x 1.0) (y 6.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y -1.0)))))
+ (test (fv170) (float-vector -4.0 -4.0 -4.0 -4.0))
- (let ((val (run (lambda () (make-oscil :frequency 200)))))
- (if (or (not (oscil? val))
- (fneq (mus-frequency val) 200))
- (snd-display #__line__ ";run make-oscil: ~A" val)))
+ (define (fv171) (let ((x 1.0) (y 6.0) (z -1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y z)))))
+ (test (fv171) (float-vector -4.0 -4.0 -4.0 -4.0))
- (let ((val (run (lambda () (let ((gen (make-oscil 200))) (mus-frequency gen))))))
- (if (fneq val 200.0) (snd-display #__line__ ";run make-oscil freq: ~A" val)))
+ (define (fv172) (let ((x 1.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x -1.0 6.0)))))
+ (test (fv172) (float-vector -4.0 -4.0 -4.0 -4.0))
- (let ((ex (list 0.0 0.0 1.0 1.0)))
- (let ((val (run (lambda () (make-env ex :length 101)))))
- (if (not (env? val)) (snd-display #__line__ ";make-env run: ~A" val))))
+ (define (fv173) (let ((x 3.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x (abs x))))))
+ (test (fv173) (float-vector 0.0 0.0 0.0 0.0))
+ (define (fv174) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 2 (abs x))))))
+ (test (fv174) (float-vector -2.0 -2.0 -2.0 -2.0))
- (let ((val (vector (make-hi308 1.0 2.0) (make-hi308 3.0 4.0))))
- (let ((x (run (lambda () (vector-ref val 1)))))
- (if (or (not (hi308? x))
- (fneq (hi308-phase x) 4.0))
- (snd-display #__line__ ";run pass list vector as arg: ~A" x))))
+ (define (fv175) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 2.0 2 (abs x))))))
+ (test (fv175) (float-vector -2.0 -2.0 -2.0 -2.0))
- ;; 309
- (let ((val (list 1 2 3)) (val1 (list 1 2 3)))
- (let ((x (run (lambda () (eq? val val1)))))
- (if x (snd-display #__line__ ";run list eq 1: ~A" x))))
+ (define (fv176) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 2.0 (abs x) (abs x))))))
+ (test (fv176) (float-vector -2.0 -2.0 -2.0 -2.0))
- (let ((val (list 1 2 3)) (val1 (list 1 2 3)))
- (let ((x (run (lambda () (eq? val val)))))
- (if (not x) (snd-display #__line__ ";run list eq 2: ~A" x))))
+ (define (fv177) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) (abs x) (abs x))))))
+ (test (fv177) (float-vector -2.0 -2.0 -2.0 -2.0))
- (let ((val (list 1 2 3)) (val1 (list 1 2 3)))
- (let ((x (run (lambda () (equal? val val)))))
- (if (not x) (snd-display #__line__ ";run list equal 3: ~A" x))))
+ (define (fv178) (let ((x 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x (abs x))))))
+ (test (fv178) (float-vector -2.0 -2.0 -2.0 -2.0))
- (let ((val (list 1 2 3)) (val1 (list 1 2 3)))
- (let ((x (run (lambda () (equal? val1 val))))) ; this one doesn't work in run
- (if (not x) (snd-display #__line__ ";run list equal 4: ~A" x))))
+ (define (fv178) (let ((x 2.0) (y 2.0) (fv (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x y)))))
+ (test (fv178) (float-vector -2.0 -2.0 -2.0 -2.0))
- (let ((val (list 1 2 3)) (val1 (list 1.0 2.0 3.0)))
- (let ((x (run (lambda () (equal? val1 val)))))
- (if x (snd-display #__line__ ";run list equal 5: ~A" x))))
+ (define (fvi164) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1 2 3)))))
+ (test (fvi164) (int-vector -4 -4 -4 -4))
- (let ((val1 (list "hi" "hi"))
- (val2 (list "hi" "hi")))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if (not x) (snd-display #__line__ ";run list equal? strs: ~A" x))))
+ (define (fvi165) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 4.5 3/2)))))
+ (test (catch #t fvi165 (lambda args 'error)) 'error)
- (let ((val1 (list "hi" "hi"))
- (val2 (list "hi" "hi" "hi")))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display #__line__ ";run list equal? strs 1: ~A" x))))
-
- (let ((val1 (list "hi" "hi"))
- (val2 (list "hi" "ho")))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display #__line__ ";run list equal? strs 2: ~A" x))))
-
-
- (let ((val1 (list 'hi 'hi))
- (val2 (list 'hi 'hi)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if (not x) (snd-display #__line__ ";run list equal? syms: ~A" x))))
-
- (let ((val1 (list 'hi 'hi))
- (val2 (list 'hi 'hi 'hi)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display #__line__ ";run list equal? syms 1: ~A" x))))
-
- (let ((val1 (list 'hi 'hi))
- (val2 (list 'hi 'ho)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display #__line__ ";run list equal? syms 2: ~A" x))))
-
-
- (let ((val1 (list :hi :hi))
- (val2 (list :hi :hi)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if (not x) (snd-display #__line__ ";run list equal? keys: ~A" x))))
-
- (let ((val1 (list :hi :hi))
- (val2 (list :hi :hi :hi)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display #__line__ ";run list equal? keys 1: ~A" x))))
-
- (let ((val1 (list :hi :hi))
- (val2 (list :hi :ho)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display #__line__ ";run list equal? keys 2: ~A" x))))
-
- (let ((val1 (list 1))
- (val2 (list)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display #__line__ ";run list equal? nil 2: ~A" x))))
+ (define (fvi166) (let ((x 1/2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 1 x)))))
+ (test (catch #t fvi166 (lambda args 'error))'error)
- (let ((val1 (list)) ; (equal? (list) (list)) -> #t in Scheme
- (val2 (list)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if (not x) (snd-display #__line__ ";run list equal? nil both: ~A" x))))
-
- (let ((val1 (list 1))
- (val2 (list 1.0)))
- (let ((x (run (lambda () (equal? val1 val2)))))
- (if x (snd-display #__line__ ";run list equal? int/dbl 2: ~A" x))))
-
-
- (let ((val (vector (make-hi308 1.0 2.0) (make-hi308 3.0 4.0))))
- (let ((x (run (lambda () (vector-ref val 1)))))
- (if (or (not (hi308? x))
- (fneq (hi308-phase x) 4.0))
- (snd-display #__line__ ";run pass list vector as arg: ~A" x))))
-
-
- (let ((val (vector (make-hi308 1.0 2.0) (make-hi308 3.0 4.0))))
- (let ((x (run (lambda () (call-hi308 (vector-ref val 1))))))
- (if (fneq x 3.0) (snd-display #__line__ ";run list-vector call-hi: ~A" x))))
-
- (let ((val (vector (make-hi308 1.0 2.0) (make-hi308 3.0 4.0))))
- (let ((x (run (lambda () (set-hi308 (vector-ref val 1)) (call-hi308 (vector-ref val 1))))))
- (if (fneq x (* 3.5 3.0)) (snd-display #__line__ ";run list-vector set-hi+call-hi: ~A" val))))
-
-
- (let ((val (make-hiho309)))
- (run (lambda () (set! (hiho309-i val) 321)))
- (if (not (= (hiho309-i val) 321)) (snd-display #__line__ ";set hiho309-i: ~A" val)))
-
- (let ((val (make-hiho309)))
- (let ((x (run (lambda () (set! (hiho309-v val) (make-vct 32 .1)) (vct-ref (hiho309-v val) 2)))))
- (if (or (fneq x .1)
- (not (vct? (hiho309-v val)))
- (fneq (vct-ref (hiho309-v val) 2) .1))
- (snd-display #__line__ ";set hiho309 vct: ~A" val))))
-
-
- (let ((val (make-hiho310)))
- (let ((x (run (lambda () (set! (hiho310-v val) "hiho") (hiho310-v val)))))
- (if (or (not (string? (hiho310-v val)))
- (not (string=? (hiho310-v val) "hiho")))
- (snd-display #__line__ ";set hiho310 string: ~A" val))
- (if (or (not (string? x))
- (not (string=? x "hiho")))
- (snd-display #__line__ ";set hiho310 string and return: ~A ~A" x val))))
-
-
- (let ((val (make-hiho311)))
- (run (lambda () (set! (hiho311-v val) (make-sound-data 2 3))))
- (if (or (not (sound-data? (hiho311-v val)))
- (not (= (sound-data-chans (hiho311-v val)) 2)))
- (snd-display #__line__ ";set hiho311 sound-data: ~A" val)))
-
- (let ((val (make-hiho311)))
- (run (lambda () (set! (hiho311-v val) (make-sound-data 2 3)) (sound-data-set! (hiho311-v val) 1 1 1.0)))
- (if (or (not (sound-data? (hiho311-v val)))
- (not (= (sound-data-chans (hiho311-v val)) 2))
- (fneq (sound-data-ref (hiho311-v val) 1 1) 1.0)
- (fneq (sound-data-ref (hiho311-v val) 0 0) 0.0))
- (snd-display #__line__ ";set hiho311 sound-data and return: ~A" val)))
-
- (let ((abc232g (make-abc232))
- (abd232g (make-abd232)))
- (let ((result (run
- (lambda ()
- (+ (abc232-x abc232g)
- (abd232-x abd232g))))))
- (if (fneq result 1.0) (snd-display #__line__ ";two structs: ~A" result))))
+ (define (fvi167) (let ((fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 6)))))
+ (test (fvi167) (int-vector -6 -6 -6 -6))
- (let ((abc232g (make-abc232))
- (abd232g (make-abd232)))
- (let ((result (run
- (lambda ()
- (+ (abc232-func abc232g)
- (abd232-func abd232g))))))
- (if (fneq result 1.0) (snd-display #__line__ ";two structs via func: ~A" result))))
-
- (with-sound (:output "test.snd" :channels 4)
- (let* ((dur 100)
- (samps (seconds->samples dur))
- (flta (make-formant 100 .999))
- (fltb (make-formant 5000 .1))
- (fltc (make-firmant 100 .999))
- (fltd (make-firmant 5000 .1))
- (ampf (make-env '(0 0 1 1 100 1 101 0) :duration dur))
- (frqf (make-env '(0 100 1 10000) :scaler (hz->radians 1.0) :duration dur))
- (rf (make-env '(0 .6 1 .999) :base .01 :duration dur)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (let* ((frq (env frqf))
- (r (env rf))
- (amp (env ampf))
- (pulse (- (random 2.0) 1.0)))
- (outa i (* amp (formant flta pulse frq)))
- (set! (mus-scaler fltb) r)
- (outc i (* amp (formant fltb pulse)))
- (outb i (* amp (firmant fltc pulse frq)))
- (outd i (* amp (firmant fltd pulse)))
- (set! (mus-scaler fltd) r)
- ))))))
- (let ((ind (find-sound "test.snd")))
- (if (sound? ind)
- (close-sound ind)))
+ (define (fvi168) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 5)))))
+ (test (fvi168) (int-vector -4 -4 -4 -4))
- (let ((hie (lambda* ((a 0.0)) (declare (a float)) (+ a 1.0))))
- (if (fneq (run (lambda () (hie 1.0))) 2.0) (snd-display #__line__ ";run opt args 0"))
- (if (fneq (run (lambda () (hie))) 1.0) (snd-display #__line__ ";run opt args 1"))
- (if (fneq (run (lambda () (+ (hie) (hie 1.0)))) 3.0) (snd-display #__line__ ";run opt args 2")))
-
- (let ((hi (lambda* ((a 0.0) (b 0.0)) (declare (a float) (b float)) (+ a b))))
- (if (fneq (run (lambda () (hi 1.0))) 1.0) (snd-display #__line__ ";run opt args 3"))
- (if (fneq (run (lambda () (hi 1.0 2.0))) 3.0) (snd-display #__line__ ";run opt args 4"))
- (if (fneq (run (lambda () (hi))) 0.0) (snd-display #__line__ ";run opt args 5"))
- (if (fneq (run (lambda () (+ (hi) (hi 1.0) (hi 1.0 2.0)))) 4.0) (snd-display #__line__ ";run opt args 6"))
- (if (fneq (run (lambda () (+ (hi 1.0) (hi) (hi 1.0 2.0)))) 4.0) (snd-display #__line__ ";run opt args 7"))
- (if (fneq (run (lambda () (+ (hi 1.0) (hi 1.0 2.0) (hi)))) 4.0) (snd-display #__line__ ";run opt args 8"))
- (if (fneq (run (lambda () (+ (hi 1.0 2.0) (hi) (hi 1.0)))) 4.0) (snd-display #__line__ ";run opt args 9")))
-
- ;; optimizer tests
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (= x y) (+ x y) (- x y))))) -1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (not (= x y 1)) 3 2)))) 3)
- (ixtst (let ((x 1)) (run (lambda () (if (or (= x 2) (not (= x 3))) 3 2)))) 3)
- (ixtst (let ((x 0) (y 1)) (run (lambda () (if (not (= x 1)) (if (not (= y 1)) 3 2) 1)))) 2)
- (ixtst (let ((x 1) (y 2) (z #t)) (run (lambda () (= x y) (if z 1 0)))) 1)
- (ixtst (let ((x 1)) (run (lambda () (if (and (= x 1) (not (< x 0))) 3 2)))) 3)
- (ixtst (let ((x 1)) (run (lambda () (if (or (= x 1) (not (< x 0))) 3 2)))) 3)
- (ixtst (let ((x 1)) (run (lambda () (cond ((= x 0) 1) ((= x 1) 2) ((= x 3) 3))))) 2)
-
- (ixtst (let ((x 1)) (run (lambda () (if (= x 1) 1 2)))) 1)
- (ixtst (let ((x 1)) (run (lambda () (if (> x 1) 1 2)))) 2)
- (ixtst (let ((x 1)) (run (lambda () (if (< x 1) 1 2)))) 2)
- (ixtst (let ((x 1)) (run (lambda () (if (>= x 1) 1 2)))) 1)
- (ixtst (let ((x 1)) (run (lambda () (if (<= x 1) 1 2)))) 1)
-
- (ixtst (let ((x 1)) (run (lambda () (if (not (= x 1)) 1 2)))) 2)
- (ixtst (let ((x 1)) (run (lambda () (if (not (> x 1)) 1 2)))) 1)
- (ixtst (let ((x 1)) (run (lambda () (if (not (< x 1)) 1 2)))) 1)
- (ixtst (let ((x 1)) (run (lambda () (if (not (>= x 1)) 1 2)))) 2)
- (ixtst (let ((x 1)) (run (lambda () (if (not (<= x 1)) 1 2)))) 2)
-
- (fxtst (let ((x 1.0)) (run (lambda () (if (= x 1.0) 1 2)))) 1)
- (fxtst (let ((x 1.0)) (run (lambda () (if (> x 1.0) 1 2)))) 2)
- (fxtst (let ((x 1.0)) (run (lambda () (if (< x 1.0) 1 2)))) 2)
- (fxtst (let ((x 1.0)) (run (lambda () (if (>= x 1.0) 1 2)))) 1)
- (fxtst (let ((x 1.0)) (run (lambda () (if (<= x 1.0) 1 2)))) 1)
-
- (fxtst (let ((x 1.0)) (run (lambda () (if (not (= x 1.0)) 1 2)))) 2)
- (fxtst (let ((x 1.0)) (run (lambda () (if (not (> x 1.0)) 1 2)))) 1)
- (fxtst (let ((x 1.0)) (run (lambda () (if (not (< x 1.0)) 1 2)))) 1)
- (fxtst (let ((x 1.0)) (run (lambda () (if (not (>= x 1.0)) 1 2)))) 2)
- (fxtst (let ((x 1.0)) (run (lambda () (if (not (<= x 1.0)) 1 2)))) 2)
-
-
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (= y x 1) 1 2)))) 2)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (> y x 1) 1 2)))) 2)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (< y x 1) 1 2)))) 2)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (>= y x 1) 1 2)))) 1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (<= y x 1) 1 2)))) 2)
-
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (not (= y x 1)) 1 2)))) 1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (not (> y x 1)) 1 2)))) 1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (not (< y x 1)) 1 2)))) 1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (not (>= y x 1)) 1 2)))) 2)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (if (not (<= y x 1)) 1 2)))) 1)
-
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (= y x 1.0) 1 2)))) 2)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (> y x 1.0) 1 2)))) 2)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (< y x 1.0) 1 2)))) 2)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (>= y x 1.0) 1 2)))) 1)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (<= y x 1.0) 1 2)))) 2)
-
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (not (= y x 1.0)) 1 2)))) 1)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (not (> y x 1.0)) 1 2)))) 1)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (not (< y x 1.0)) 1 2)))) 1)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (not (>= y x 1.0)) 1 2)))) 2)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (if (not (<= y x 1.0)) 1 2)))) 1)
-
- (ixtst (let ((x 3)) (run (lambda () (if (odd? x) 1 2)))) 1)
- (ixtst (let ((x 3)) (run (lambda () (if (even? x) 1 2)))) 2)
- (ixtst (let ((x 3)) (run (lambda () (if (not (odd? x)) 1 2)))) 2)
- (ixtst (let ((x 3)) (run (lambda () (if (not (even? x)) 1 2)))) 1)
-
- (ixtst (let ((x -4)) (run (lambda () (if (odd? x) 1 2)))) 2)
- (ixtst (let ((x -4)) (run (lambda () (if (even? x) 1 2)))) 1)
- (ixtst (let ((x -4)) (run (lambda () (if (not (odd? x)) 1 2)))) 1)
- (ixtst (let ((x -4)) (run (lambda () (if (not (even? x)) 1 2)))) 2)
-
- (ixtst (let ((x 2)) (run (lambda () (if (zero? x) 1 2)))) 2)
- (ixtst (let ((x 2)) (run (lambda () (if (negative? x) 1 2)))) 2)
- (ixtst (let ((x 2)) (run (lambda () (if (positive? x) 1 2)))) 1)
- (ixtst (let ((x 2)) (run (lambda () (if (not (zero? x)) 1 2)))) 1)
- (ixtst (let ((x 2)) (run (lambda () (if (not (negative? x)) 1 2)))) 1)
- (ixtst (let ((x 2)) (run (lambda () (if (not (positive? x)) 1 2)))) 2)
-
- (fxtst (let ((x 2.0)) (run (lambda () (if (zero? x) 1 2)))) 2)
- (fxtst (let ((x 2.0)) (run (lambda () (if (negative? x) 1 2)))) 2)
- (fxtst (let ((x 2.0)) (run (lambda () (if (positive? x) 1 2)))) 1)
- (fxtst (let ((x 2.0)) (run (lambda () (if (not (zero? x)) 1 2)))) 1)
- (fxtst (let ((x 2.0)) (run (lambda () (if (not (negative? x)) 1 2)))) 1)
- (fxtst (let ((x 2.0)) (run (lambda () (if (not (positive? x)) 1 2)))) 2)
-
-
- (ixtst (let ((x 1)) (run (lambda () (cond ((= x 1) 1) (#t 2))))) 1)
- (ixtst (let ((x 1)) (run (lambda () (cond ((> x 1) 1) (#t 2))))) 2)
- (ixtst (let ((x 1)) (run (lambda () (cond ((< x 1) 1) (#t 2))))) 2)
- (ixtst (let ((x 1)) (run (lambda () (cond ((>= x 1) 1) (#t 2))))) 1)
- (ixtst (let ((x 1)) (run (lambda () (cond ((<= x 1) 1) (#t 2))))) 1)
-
- (ixtst (let ((x 1)) (run (lambda () (cond ((not (= x 1)) 1) (#t 2))))) 2)
- (ixtst (let ((x 1)) (run (lambda () (cond ((not (> x 1)) 1) (#t 2))))) 1)
- (ixtst (let ((x 1)) (run (lambda () (cond ((not (< x 1)) 1) (#t 2))))) 1)
- (ixtst (let ((x 1)) (run (lambda () (cond ((not (>= x 1)) 1) (#t 2))))) 2)
- (ixtst (let ((x 1)) (run (lambda () (cond ((not (<= x 1)) 1) (#t 2))))) 2)
-
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((= x 1.0) 1) (#t 2))))) 1)
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((> x 1.0) 1) (#t 2))))) 2)
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((< x 1.0) 1) (#t 2))))) 2)
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((>= x 1.0) 1) (#t 2))))) 1)
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((<= x 1.0) 1) (#t 2))))) 1)
-
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((not (= x 1.0)) 1) (#t 2))))) 2)
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((not (> x 1.0)) 1) (#t 2))))) 1)
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((not (< x 1.0)) 1) (#t 2))))) 1)
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((not (>= x 1.0)) 1) (#t 2))))) 2)
- (fxtst (let ((x 1.0)) (run (lambda () (cond ((not (<= x 1.0)) 1) (#t 2))))) 2)
-
-
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((= y x 1) 1) (#t 2))))) 2)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((> y x 1) 1) (#t 2))))) 2)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((< y x 1) 1) (#t 2))))) 2)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((>= y x 1) 1) (#t 2))))) 1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((<= y x 1) 1) (#t 2))))) 2)
-
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((not (= y x 1)) 1) (#t 2))))) 1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((not (> y x 1)) 1) (#t 2))))) 1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((not (< y x 1)) 1) (#t 2))))) 1)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((not (>= y x 1)) 1) (#t 2))))) 2)
- (ixtst (let ((x 1) (y 2)) (run (lambda () (cond ((not (<= y x 1)) 1) (#t 2))))) 1)
-
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((= y x 1.0) 1) (#t 2))))) 2)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((> y x 1.0) 1) (#t 2))))) 2)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((< y x 1.0) 1) (#t 2))))) 2)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((>= y x 1.0) 1) (#t 2))))) 1)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((<= y x 1.0) 1) (#t 2))))) 2)
-
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((not (= y x 1.0)) 1) (#t 2))))) 1)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((not (> y x 1.0)) 1) (#t 2))))) 1)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((not (< y x 1.0)) 1) (#t 2))))) 1)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((not (>= y x 1.0)) 1) (#t 2))))) 2)
- (fxtst (let ((x 1.0) (y 2.0)) (run (lambda () (cond ((not (<= y x 1.0)) 1) (#t 2))))) 1)
-
- (ixtst (let ((x 3)) (run (lambda () (cond ((odd? x) 1) (#t 2))))) 1)
- (ixtst (let ((x 3)) (run (lambda () (cond ((even? x) 1) (#t 2))))) 2)
- (ixtst (let ((x 3)) (run (lambda () (cond ((not (odd? x)) 1) (#t 2))))) 2)
- (ixtst (let ((x 3)) (run (lambda () (cond ((not (even? x)) 1) (#t 2))))) 1)
-
- (ixtst (let ((x -4)) (run (lambda () (cond ((odd? x) 1) (#t 2))))) 2)
- (ixtst (let ((x -4)) (run (lambda () (cond ((even? x) 1) (#t 2))))) 1)
- (ixtst (let ((x -4)) (run (lambda () (cond ((not (odd? x)) 1) (#t 2))))) 1)
- (ixtst (let ((x -4)) (run (lambda () (cond ((not (even? x)) 1) (#t 2))))) 2)
-
- (ixtst (let ((x 2)) (run (lambda () (cond ((zero? x) 1) (#t 2))))) 2)
- (ixtst (let ((x 2)) (run (lambda () (cond ((negative? x) 1) (#t 2))))) 2)
- (ixtst (let ((x 2)) (run (lambda () (cond ((positive? x) 1) (#t 2))))) 1)
- (ixtst (let ((x 2)) (run (lambda () (cond ((not (zero? x)) 1) (#t 2))))) 1)
- (ixtst (let ((x 2)) (run (lambda () (cond ((not (negative? x)) 1) (#t 2))))) 1)
- (ixtst (let ((x 2)) (run (lambda () (cond ((not (positive? x)) 1) (#t 2))))) 2)
-
- (fxtst (let ((x 2.0)) (run (lambda () (cond ((zero? x) 1) (#t 2))))) 2)
- (fxtst (let ((x 2.0)) (run (lambda () (cond ((negative? x) 1) (#t 2))))) 2)
- (fxtst (let ((x 2.0)) (run (lambda () (cond ((positive? x) 1) (#t 2))))) 1)
- (fxtst (let ((x 2.0)) (run (lambda () (cond ((not (zero? x)) 1) (#t 2))))) 1)
- (fxtst (let ((x 2.0)) (run (lambda () (cond ((not (negative? x)) 1) (#t 2))))) 1)
- (fxtst (let ((x 2.0)) (run (lambda () (cond ((not (positive? x)) 1) (#t 2))))) 2)
-
- (ixtst (let ((x 1)) (run (lambda () (cond ((= x 0) 1) ((> x 1) 2) ((< x 3) 3))))) 3)
- (ixtst (run (lambda () (let ((x 1)) (= 1 (let ((y 2)) (set! x y) x)) (+ x 1)))) 3)
- (ixtst (let ((x 1)) (let ((xx (lambda (a) (set! x a) a))) (run (lambda () (= 1 (xx 2)) (+ x 1))))) 3)
- (ixtst (run (lambda () (let ((x 1) (xx 1.0)) (+ (cond ((= x 2) (cond ((> xx 2.0) 1) (#t 2))) ((= x 1) (cond ((> xx 0.0) 3) (#t 4)))) 32)))) 35)
- (ixtst (run (lambda () (let ((x 1) (xx 1.0)) (+ (cond ((= x 2) (cond ((> xx 2.0) 1) (#t 2))) ((= x 1) (cond ((> xx 2.0) 3) (#t 4)))) 32)))) 36)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (cond ((= x 2) (not z)) ((= y 2) (= x 1)))))) #t)
-
- (bxtst (run (lambda () (let ((x 1) (y 2)) (and (= x 1) (> y 2))))) #f)
- (bxtst (run (lambda () (let ((x 1) (y 2)) (and (< x 1) (not (= y 2)))))) #f)
- (bxtst (run (lambda () (let ((x 1) (y 2)) (and (not (= x 2)) (not (> y 2)))))) #t)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (and (= x 1) (not z) (> y 2))))) #f)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (and (>= x 1) (not z) (<= y 2))))) #t)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (and (odd? x) z (even? y))))) #f)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (and (odd? x) (not (not (not z))) (even? y))))) #t)
-
- (bxtst (run (lambda () (let ((x 1) (y 2)) (or (= x 1) (> y 2))))) #t)
- (bxtst (run (lambda () (let ((x 1) (y 2)) (or (< x 1) (not (= y 2)))))) #f)
- (bxtst (run (lambda () (let ((x 1) (y 2)) (or (not (= x 2)) (not (> y 2)))))) #t)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (or (= x 1) (not z) (> y 2))))) #t)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (or (>= x 1) (not z) (<= y 2))))) #t)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (or (odd? x) z (even? y))))) #t)
- (bxtst (run (lambda () (let ((x 1) (y 2) (z #f)) (or (negative? x) (not (not z)) (zero? y))))) #f)
-
- (bxtst (run (lambda () (cond (#t 'a) (#t 'b)))) 'a)
- (bxtst (run (lambda () (cond ((> 3 2) 'greater) ((< 3 2) 'less)))) 'greater)
- (bxtst (run (lambda () (cond ((> 3 3) 'greater) ((< 3 3) 'less) (else 'equal)))) 'equal)
- (ixtst (run (lambda () (cond (#f 2) (else 5)))) 5)
- (ixtst (run (lambda () (cond (1 2) (else 5)))) 2)
- (ixtst (run (lambda () (cond ((+ 1 2))))) 3)
- (ixtst (run (lambda () (cond ((zero? 1) 123) ((= 1 1) 321)))) 321)
- (ixtst (run (lambda () (cond (1 2 3)))) 3)
- (ixtst (run (lambda () (cond ((= 1 2) 3) ((+ 3 4))))) 7)
- (ixtst (run (lambda () (cond ((= 1 1) (abs -1) (+ 2 3) (* 10 2)) (else 123)))) 20)
- (ixtst (run (lambda () (let ((a 1)) (cond ((= a 1) (set! a 2) (+ a 3)))))) 5)
- (ixtst (run (lambda () (let ((a 1)) (cond ((= a 2) (+ a 2)) (else (set! a 3) (+ a 3)))))) 6)
- (bxtst (run (lambda () (cond ((= 1 1))))) #t)
- (bxtst (run (lambda () (cond ((= 1 2) #f) (#t)))) #t)
- (ixtst (run (lambda () (cond ((+ 1 2))))) 3)
-
- (bxtst (run (lambda () (and (= 2 2) (> 2 1)))) #t)
- (bxtst (run (lambda () (and (= 2 2) (< 2 1)))) #f)
- (bxtst (run (lambda () (and))) #t)
- (bxtst (run (lambda () (and 3 (zero? 1) (/ 1 0) (display "or is about to exit!") (exit)))) #f)
- (bxtst (run (lambda () (and (or (and (> 3 2) (> 3 4)) (> 2 3)) 4))) #f)
- (bxtst (run (lambda () (let ((a 1)) (and (let () (set! a 2) #t) (= a 1) (let () (set! a 3) #f) (and (= a 3) a) (let () (set! a 4) #f) a)))) #f)
-
-
- (ixtst (run (lambda () (lcm -1))) 1)
- (ixtst (run (lambda () (gcd -1))) 1)
- (bxtst (run (lambda () (eq? "asd" "asd"))) #f)
- (bxtst (run (lambda () (eqv? "asd" "asd"))) #f)
- (bxtst (run (lambda () (equal? "asd" "asd"))) #t)
- (bxtst (run (lambda () (equal? "asd" "dsa"))) #f)
-
- (let ((len (let ((v (make-vct 32))) (run (lambda () (length v))))))
- (if (not (= len 32)) (snd-display #__line__ ";run length vct: ~A" len)))
- (let ((len (let ((v (make-vector 32 1.0))) (run (lambda () (length v))))))
- (if (not (= len 32)) (snd-display #__line__ ";run length vector 1.0: ~A" len)))
- (let ((len (let ((v (make-vector 32 1))) (run (lambda () (length v))))))
- (if (not (= len 32)) (snd-display #__line__ ";run length vector 1: ~A" len)))
- (let ((len (let ((s (string #\h #\i))) (run (lambda () (length s))))))
- (if (not (= len 2)) (snd-display #__line__ ";run length string: ~A" len)))
- (let ((len (let ((l (list 1 2 3))) (run (lambda () (length l))))))
- (if (not (= len 3)) (snd-display #__line__ ";run length list: ~A" len)))
- (let ((len (let ((f (make-frame 3))) (run (lambda () (length f))))))
- (if (not (= len 3)) (snd-display #__line__ ";run length frame: ~A" len)))
- (let ((len (let ((f (make-mixer 3))) (run (lambda () (length f))))))
- (if (not (= len 3)) (snd-display #__line__ ";run length mixer: ~A" len)))
- (let ((len (let ((f (make-delay 32))) (run (lambda () (length f))))))
- (if (not (= len 32)) (snd-display #__line__ ";run length delay: ~A" len)))
-
-
- ;; length as generic function:
- ;; string-length vector-length hash-table-size vct-length
- ;; frames mus-length sound-data-length mix-length region-frames
-
- (let ((snd (open-sound "oboe.snd"))
- (v (vct .1 .2 .3))
- (vc (vector .1 .2 .3 .4))
- (lst (list 1 2 3 4 5))
- (sd (make-sound-data 1 10))
- (str "123456")
- (fr (frame .1 .2))
- (mx (mixer .1 .2 .3 .4)))
- (let ((mxv (mix-vct v 1000))
- (reg (make-region 0 100))
- (dly (make-delay 32))
- )
- (if (not (= (run (lambda () (length snd))) 50828)) (snd-display #__line__ ";length of sound: ~A" (length snd)))
- (if (not (= (run (lambda () (length v))) 3)) (snd-display #__line__ ";length of vct: ~A" (length v)))
- (if (not (= (run (lambda () (length vc))) 4)) (snd-display #__line__ ";length of vector: ~A" (length vc)))
- (if (not (= (run (lambda () (length lst))) 5)) (snd-display #__line__ ";length of list: ~A" (length lst)))
- (if (not (= (run (lambda () (length str))) 6)) (snd-display #__line__ ";length of string: ~A" (length str)))
- (if (not (= (run (lambda () (length sd))) 10)) (snd-display #__line__ ";length of sound-data: ~A" (length sd)))
- (if (not (= (run (lambda () (length fr))) 2)) (snd-display #__line__ ";length of frame: ~A" (length fr)))
- (if (not (= (run (lambda () (length mx))) 2)) (snd-display #__line__ ";length of mixer: ~A" (length mx)))
- (if (and (mix? mxv) (not (= (run (lambda () (length mxv))) 3))) (snd-display #__line__ ";length of mix: ~A" (length mxv)))
- (if (not (= (run (lambda () (length reg))) 101)) (snd-display #__line__ ";length of region: ~A" (length reg)))
- (if (not (= (run (lambda () (length dly))) 32)) (snd-display #__line__ ";length of delay: ~A" (length dly)))
- )
- (close-sound snd))
+ (define (fvi169) (let ((x 1) (y 5) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y)))))
+ (test (fvi169) (int-vector -4 -4 -4 -4))
- ;; srate as generic: mus-sound-srate region-srate srate
+ (define (fvi170) (let ((x 1) (y 6) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y -1)))))
+ (test (fvi170) (int-vector -4 -4 -4 -4))
- (let ((snd (open-sound "oboe.snd"))
- (str "oboe.snd"))
- (let ((reg (make-region 0 100))
- )
- (if (not (= (run (lambda () (srate snd))) 22050)) (snd-display #__line__ ";srate of sound: ~A" (srate snd)))
- (if (not (= (run (lambda () (srate str))) 22050)) (snd-display #__line__ ";srate of string: ~A" (srate str)))
- (if (not (= (run (lambda () (srate reg))) 22050)) (snd-display #__line__ ";srate of region: ~A" (srate reg)))
- )
- (close-sound snd))
+ (define (fvi171) (let ((x 1) (y 6) (z -1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x y z)))))
+ (test (fvi171) (int-vector -4 -4 -4 -4))
- ;; channels as generic: mus-sound-chans region-chans chans mus-channels mix/etc
+ (define (fvi172) (let ((x 1) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x -1 6)))))
+ (test (fvi172) (int-vector -4 -4 -4 -4))
- (let ((snd (open-sound "oboe.snd"))
- (v (vct .1 .2 .3))
- (sd (make-sound-data 2 10))
- (str "oboe.snd")
- (fr (frame .1 .2))
- (mx (mixer .1 .2 .3 .4)))
- (let ((mxv (mix-vct v 1000))
- (reg (make-region 0 100))
- )
- (if (not (= (run (lambda () (channels snd))) 1)) (snd-display #__line__ ";channels of sound: ~A" (channels snd)))
- (if (not (= (run (lambda () (channels v))) 1)) (snd-display #__line__ ";channels of vct: ~A" (channels v)))
- (if (not (= (run (lambda () (channels str))) 1)) (snd-display #__line__ ";channels of string: ~A" (channels str)))
- (if (not (= (run (lambda () (channels sd))) 2)) (snd-display #__line__ ";channels of sound-data: ~A" (channels sd)))
- (if (not (= (run (lambda () (channels fr))) 2)) (snd-display #__line__ ";channels of frame: ~A" (channels fr)))
- (if (not (= (run (lambda () (channels mx))) 2)) (snd-display #__line__ ";channels of mixer: ~A" (channels mx)))
- (if (not (= (run (lambda () (channels mxv))) 1)) (snd-display #__line__ ";channels of mix: ~A" (channels mxv)))
- (if (not (= (run (lambda () (channels reg))) 1)) (snd-display #__line__ ";channels of region: ~A" (channels reg)))
- )
- (close-sound snd))
+ (define (fvi173) (let ((x 3) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x (abs x))))))
+ (test (fvi173) (int-vector 0 0 0 0))
- ;; frames as generic
-
- (let ((snd (open-sound "oboe.snd"))
- (v (vct .1 .2 .3))
- (sd (make-sound-data 1 10))
- (str "oboe.snd")
- (fr (frame .1 .2))
- (mx (mixer .1 .2 .3 .4)))
- (let ((mxv (mix-vct v 1000))
- (reg (make-region 0 100))
- (dly (make-delay 32))
- )
- (if (not (= (run (lambda () (frames snd))) 50828)) (snd-display #__line__ ";frames of sound: ~A" (frames snd)))
- (if (not (= (run (lambda () (frames v))) 3)) (snd-display #__line__ ";frames of vct: ~A" (frames v)))
- (if (not (= (run (lambda () (frames str))) 50828)) (snd-display #__line__ ";frames of string: ~A" (frames str)))
- (if (not (= (run (lambda () (frames sd))) 10)) (snd-display #__line__ ";frames of sound-data: ~A" (frames sd)))
- (if (not (= (run (lambda () (frames fr))) 2)) (snd-display #__line__ ";frames of frame: ~A" (frames fr)))
- (if (not (= (run (lambda () (frames mx))) 2)) (snd-display #__line__ ";frames of mixer: ~A" (frames mx)))
- (if (not (= (run (lambda () (frames mxv))) 3)) (snd-display #__line__ ";frames of mix: ~A" (frames mxv)))
- (if (not (= (run (lambda () (frames reg))) 101)) (snd-display #__line__ ";frames of region: ~A" (frames reg)))
- (if (not (= (run (lambda () (frames dly))) 32)) (snd-display #__line__ ";frames of delay: ~A" (frames dly)))
- )
- (close-sound snd))
+ (define (fvi174) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- x 2 (abs x))))))
+ (test (fvi174) (int-vector -2 -2 -2 -2))
- ;; file-name as generic
+ (define (fvi175) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 2 2 (abs x))))))
+ (test (fvi175) (int-vector -2 -2 -2 -2))
- (let ((snd (open-sound "oboe.snd"))
- (str "oboe.snd")
- (frm (make-file->sample "oboe.snd")))
- (let ((mxv (let ((mx (mix "pistol.snd" 1000)))
- (and (pair? mx)
- (car mx))))
- (reg (make-region 0 100))
- )
- (if (not (string=? (run (lambda () (file-name snd))) (string-append (getcwd) "/oboe.snd"))) (snd-display #__line__ ";file-name of sound: ~A" (file-name snd)))
- (if (not (string=? (run (lambda () (file-name str))) (string-append (getcwd) "/oboe.snd"))) (snd-display #__line__ ";file-name of string: ~A" (file-name str)))
- (if (not (string=? (run (lambda () (file-name frm))) "oboe.snd")) (snd-display #__line__ ";file-name of file->sample: ~A" (file-name frm)))
- (if (not (string=? (run (lambda () (file-name mxv))) (string-append (getcwd) "/pistol.snd"))) (snd-display #__line__ ";file-name of mix: ~A" (file-name mxv)))
- (if (not (string=? (run (lambda () (file-name reg))) "oboe.snd")) (snd-display #__line__ ";file-name of region: ~A" (file-name reg)))
- )
- (mus-close frm)
- (close-sound snd))
+ (define (fvi176) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- 2 (abs x) (abs x))))))
+ (test (fvi176) (int-vector -2 -2 -2 -2))
- ;; maxamp as generic
+ (define (fvi177) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) (abs x) (abs x))))))
+ (test (fvi177) (int-vector -2 -2 -2 -2))
- (let ((snd (open-sound "oboe.snd"))
- (v (vct .1 .2 .3))
- (vc (vector .1 .2 .3 .4)))
- (let ((mxv (mix-vct v 1000))
- (reg (make-region 0 900))
- )
- (if (fneq (run (lambda () (maxamp snd))) .334) (snd-display #__line__ ";maxamp of sound: ~A" (maxamp snd)))
- (if (fneq (run (lambda () (maxamp snd 0))) .334) (snd-display #__line__ ";maxamp of sound (0): ~A" (maxamp snd)))
- (if (fneq (run (lambda () (maxamp snd 0 0))) .14724) (snd-display #__line__ ";maxamp of sound (0 0): ~A" (maxamp snd)))
- (if (fneq (run (lambda () (maxamp v))) .3) (snd-display #__line__ ";maxamp of vct: ~A" (maxamp v)))
- (if (fneq (run (lambda () (maxamp vc))) .4) (snd-display #__line__ ";maxamp of vector: ~A" (run (lambda () (maxamp vc)))))
- (if (fneq (run (lambda () (maxamp mxv))) .3) (snd-display #__line__ ";maxamp of mix: ~A" (maxamp mxv)))
- (if (fneq (run (lambda () (maxamp reg))) .02139) (snd-display #__line__ ";maxamp of region: ~A" (maxamp reg)))
- )
- (close-sound snd))
-
- (let* ((size (* 128 1024))
- (v1 (make-vector size 0.0))
- (v2 (make-vector size 0.0))
- (sum 0.0))
- (run
- (do ((i 0 (+ i 1)))
- ((= i size))
- (set! (v1 i) (- (random 2.0) 1.0))
- (set! (v2 i) (- (random 2.0) 1.0)))
- (do ((i 0 (+ i 1)))
- ((= i size) sum)
- (set! sum (+ sum (* (v1 i) (v2 i))))))
- (if (= sum 0.0)
- (snd-display #__line__ ";run -> sum vectors: ~A" sum)))
+ (define (fvi178) (let ((x 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x (abs x))))))
+ (test (fvi178) (int-vector -2 -2 -2 -2))
- ))
-
-
-;; (set! *clm-notehook* (lambda args (display (format #f "~A~%" args))))
+ (define (fvi178) (let ((x 2) (y 2) (fv (make-int-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) fv) (set! (fv i) (- (abs x) x y)))))
+ (test (fvi178) (int-vector -2 -2 -2 -2))
+ )
+
+ (if all-args
+ (let ((old-size *clm-file-buffer-size*))
+ (set! *clm-file-buffer-size* 100)
+ (set! *mus-float-equal-fudge-factor* 1e-4)
+ (define v-1 (make-float-vector 100 .25))
+ (do ((i 0 (+ i 1)) (x 0.0 (+ x .01))) ((= i 100)) (float-vector-set! v-1 i x))
+ (define v0 (make-float-vector 10))
+
+ (define args1 (list 1.5 '(oscil o1) '(env e1) 'x 'i '(oscil o) '(- 1.0 x) '(oscil (vector-ref oscs k))))
+ (define args2 (list 1.5 '(oscil o2) '(env e2) 'y 'i '(float-vector-ref v-1 i)))
+ (define args3 (list 1.5 '(oscil o3) '(env e3) 'z 'i '(cos x)))
+ ;(define args4 (list 1.5 '(oscil o4) '(env e4) 'x 'i))
+
+ (define (try str)
+ (eval-string
+ (call-with-output-string
+ (lambda (p)
+ (format p "(let ()~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (i 0)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (set! (v0 0) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 1) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 2) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 3) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 4) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 5) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 6) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 7) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 8) ~A) (set! i (+ i 1))~%" str)
+ (format p " (set! (v0 9) ~A))~%" str)
+ (format p "(define (tester-1)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (set! (v i) ~A))))~%~%" str)
+ (format p "(define (tester-2)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (with-sound (v :clipped #f :to-snd #f)~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (outa i ~A)))~%" str)
+ (format p " v))~%~%")
+ (format p "(define (tester-3)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (with-sound (v :clipped #f :to-snd #f)~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (outa i ~A)))~%" str)
+ (format p " ;(file->array \"try-test.snd\" 0 0 10 v)~%")
+ (format p " v))~%~%")
+ (format p "(define (tester-4)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (v (make-float-vector 10))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (k 1)~%")
+ (format p " (z 0.1))~%")
+ (format p " (do ((i 0 (+ i 1))~%")
+ (format p " (lst (make-list 10)))~%")
+ (format p " ((= i 10) (apply float-vector lst))~%")
+ (format p " (set! (lst i) ~A))))~%~%" str)
+ (format p "(define (tester-5)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (y -0.5)~%")
+ (format p " (k 1)~%")
+ (format p " (z 0.1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (with-sound (v :clipped #f :to-snd #f)~%")
+ (format p " (do ((i 0 (+ i 1))~%")
+ (format p " (x 0.0 (+ x 0.1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (outa i ~A)))~%" str)
+ (format p " ;(file->array \"try-test.snd\" 0 0 10 v)~%")
+ (format p " v))~%~%")
+ (format p "(define (tester-6)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (do ((i 0 (+ i 1))~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (x 0.0 (+ x 0.1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (set! (v i) ~A))))~%~%" str)
+
+ (format p "(define (tester-7)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (k 1)~%")
+ (format p " (z 0.1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (let ((zz ~A))~%" str)
+ (format p " (set! (v i) (oscil o zz))))))~%")
+ (format p "(define (tester-8)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (with-sound (v :clipped #f :to-snd #f)~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (let ((zz ~A))~%" str)
+ (format p " (outa i (oscil o zz)))))~%")
+ (format p " v))~%~%")
+
+ (format p "(define (tester-9)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (let ((zz ~A))~%" str)
+ (format p " (set! (v i) (* (env e1) (oscil o zz)))))))~%")
+ (format p "(define (tester-10)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (x 3.14)~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (with-sound (v :clipped #f :to-snd #f)~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (let ((zz ~A))~%" str)
+ (format p " (outa i (* (env e1) (oscil o zz))))))~%")
+ (format p " v))~%~%")
+
+ (format p "(define (tester-11)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (let ((x (oscil o)))~%")
+ (format p " (set! (v i) ~A)))))~%" str)
+ (format p "(define (tester-12)~%")
+ (format p " (let ((o (make-oscil 1000.0))~%")
+ (format p " (o1 (make-oscil 1000.0))~%")
+ (format p " (o2 (make-oscil 1000.0))~%")
+ (format p " (o3 (make-oscil 1000.0))~%")
+ (format p " (o4 (make-oscil 1000.0))~%")
+ (format p " (oscs (vector (make-oscil 400.0) (make-oscil 500.0) (make-oscil 600.0)))~%")
+ (format p " (e1 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e2 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e3 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (e4 (make-env '(0 .1 1 1) :length 100))~%")
+ (format p " (y -0.5)~%")
+ (format p " (z 0.1)~%")
+ (format p " (k 1)~%")
+ (format p " (v (make-float-vector 10)))~%")
+ (format p " (with-sound (v :clipped #f :to-snd #f)~%")
+ (format p " (do ((i 0 (+ i 1)))~%")
+ (format p " ((= i 10) v)~%")
+ (format p " (let ((x (oscil o)))~%")
+ (format p " (outa i ~A))))~%" str)
+ (format p " v))~%~%")
+
+ (format p "(let ((v1 (tester-1))~%")
+ (format p " (v2 (tester-2))~%")
+ (format p " (v3 (tester-3))~%")
+ (format p " (v4 (tester-4))~%")
+ (format p " (v5 (tester-5))~%")
+ (format p " (v6 (tester-6))~%")
+ (format p " (v7 (tester-7))~%")
+ (format p " (v8 (tester-8))~%")
+ (format p " (v9 (tester-9))~%")
+ (format p " (v10 (tester-10))~%")
+ (format p " (v11 (tester-11))~%")
+ (format p " (v12 (tester-12)))~%")
+ (format p " (if (or (not (vequal v0 v1)) (not (vequal v1 v2)) (not (vequal v1 v3)) (not (vequal v1 v4)))~%")
+ (format p " (format *stderr* \"~A:~~% no do: ~~A~~% float-vector-set: ~~A~~% outa->v:~~A~~% outa: ~~A~~% list: ~~A~~%\" v0 v1 v2 v3 v4))~%" str)
+ (format p " (if (not (vequal v5 v6))~%")
+ (format p " (format *stderr* \"dox ~A:~~% float-vector-set: ~~A~~% outa->v:~~A~~%\" v5 v6))~%" str)
+ (format p " (if (not (vequal v7 v8))~%")
+ (format p " (format *stderr* \"let ~A:~~% ~~A~~% ~~A~~%\" v7 v8))~%" str)
+ (format p " (if (not (vequal v9 v10))~%")
+ (format p " (format *stderr* \"env let ~A:~~% ~~A~~% ~~A~~%\" v9 v10))~%~%" str)
+ (format p " (if (not (vequal v11 v12))~%")
+ (format p " (format *stderr* \"letx ~A:~~% ~~A~~% ~~A~~%\" v11 v12))))~%~%" str)))))
+
+ (define (out-args)
+
+ (for-each
+ (lambda (a)
+ (try (format #f "~A" a))
+ (try (format #f "(oscil o ~A)" a))
+ (try (format #f "(abs (oscil o ~A))" a))
+ )
+ args1)
+
+ (for-each
+ (lambda (a)
+ (for-each
+ (lambda (b)
+ (try (format #f "(+ ~A ~A)" a b))
+ (try (format #f "(- ~A ~A)" a b))
+ (try (format #f "(* ~A ~A)" a b))
+ (try (format #f "(cos (+ ~A ~A))" a b))
+ (try (format #f "(sin (* ~A ~A))" a b))
+ (try (format #f "(abs (* ~A ~A))" a b))
+ (try (format #f "(* ~A (abs ~A))" a b))
+ (try (format #f "(oscil o (+ ~A ~A))" a b))
+ (try (format #f "(oscil o (* ~A ~A))" a b))
+ (try (format #f "(+ ~A (oscil o ~A))" a b))
+ (try (format #f "(* ~A (oscil o ~A))" a b))
+ (try (format #f "(+ (oscil o ~A) ~A)" a b))
+ (try (format #f "(* (oscil o ~A) ~A)" a b))
+ (try (format #f "(oscil o ~A ~A)" a b))
+ (try (format #f "(abs (oscil o ~A ~A))" a b))
+ (try (format #f "(* (abs (oscil o ~A)) ~A)" a b))
+ )
+ args2))
+ args1)
+
+ (for-each
+ (lambda (c)
+ (for-each
+ (lambda (b)
+ (for-each
+ (lambda (a)
+ (try (format #f "(+ ~A ~A ~A)" a b c))
+ (try (format #f "(+ (* ~A ~A) ~A)" a b c))
+ (try (format #f "(+ ~A (* ~A ~A))" a b c))
+ (try (format #f "(* ~A ~A ~A)" a b c))
+ (try (format #f "(* ~A (+ ~A ~A))" a b c))
+ (try (format #f "(* (+ ~A ~A) ~A)" a b c))
+ (try (format #f "(oscil o (+ ~A ~A ~A))" a b c))
+ (try (format #f "(oscil o (* ~A ~A ~A))" a b c))
+ (try (format #f "(oscil o (* ~A (+ ~A ~A)))" a b c))
+ (try (format #f "(oscil o (+ ~A (* ~A ~A)))" a b c))
+ (try (format #f "(oscil o (* (+ ~A ~A) ~A))" a b c))
+ (try (format #f "(oscil o (+ (* ~A ~A) ~A))" a b c))
+ (try (format #f "(+ ~A (oscil o (+ ~A ~A)))" a b c))
+ (try (format #f "(+ ~A (oscil o (* ~A ~A)))" a b c))
+ (try (format #f "(* ~A (oscil o (+ ~A ~A)))" a b c))
+ (try (format #f "(* ~A (oscil o (* ~A ~A)))" a b c))
+
+ (try (format #f "(+ ~A ~A (oscil o ~A))" a b c))
+ (try (format #f "(* ~A ~A (oscil o ~A))" a b c))
+ (try (format #f "(+ (* ~A ~A) (oscil o ~A))" a b c))
+ (try (format #f "(* (+ ~A ~A) (oscil o ~A))" a b c))
+ (try (format #f "(+ ~A (* ~A (oscil o ~A)))" a b c))
+ (try (format #f "(* ~A (+ ~A (oscil o ~A)))" a b c))
+
+ (try (format #f "(+ ~A (oscil o ~A) ~A)" a b c))
+ (try (format #f "(* ~A (oscil o ~A) ~A)" a b c))
+ (try (format #f "(+ (* ~A (oscil o ~A)) ~A)" a b c))
+ (try (format #f "(* (+ ~A (oscil o ~A)) ~A)" a b c))
+ (try (format #f "(+ ~A (* (oscil o ~A) ~A))" a b c))
+ (try (format #f "(* ~A (+ (oscil o ~A) ~A))" a b c))
+
+ (try (format #f "(+ (oscil o ~A) ~A ~A)" a b c))
+ (try (format #f "(+ (oscil o ~A) (* ~A ~A))" a b c))
+ (try (format #f "(* (oscil o ~A) (+ ~A ~A))" a b c))
+ (try (format #f "(* (oscil o ~A) ~A ~A)" a b c))
+
+ (try (format #f "(+ ~A (abs ~A) ~A)" a b c))
+ (try (format #f "(+ ~A (sin ~A) ~A)" a b c))
+ (try (format #f "(+ ~A (cos ~A) ~A)" a b c))
+ (try (format #f "(* (cos ~A) (oscil o ~A ~A))" a b c))
+ (try (format #f "(+ (oscil o ~A ~A) ~A)" a b c))
+ (try (format #f "(+ (abs (oscil o ~A ~A)) ~A)" a b c))
+ (try (format #f "(+ (cos (oscil o ~A ~A)) ~A)" a b c))
+ (try (format #f "(+ (sin (oscil o ~A ~A)) ~A)" a b c))
+ )
+ args3))
+ args2))
+ args1))
+ (out-args)
+ (set! *clm-file-buffer-size* old-size)
+ )))
-;;; ---------------- test 23: with-sound ----------------
-(if (not (provided? 'snd-prc95.scm)) (load "prc95.scm"))
-(if (not (provided? 'snd-jcrev.scm)) (load "jcrev.scm"))
-(if (not (provided? 'snd-maraca.scm)) (load "maraca.scm"))
-(if (not (provided? 'snd-singer.scm)) (load "singer.scm"))
-(if (not (provided? 'snd-strad.scm)) (load "strad.scm"))
-(if (not (provided? 'snd-noise.scm)) (load "noise.scm"))
-(if (not (provided? 'snd-clm-ins.scm)) (load "clm-ins.scm"))
-(if (not (provided? 'snd-jcvoi.scm)) (load "jcvoi.scm"))
-(if (not (provided? 'snd-piano.scm)) (load "piano.scm"))
-(if (not (provided? 'snd-play.scm)) (load "play.scm"))
-(if (not (provided? 'snd-zip.scm)) (load "zip.scm"))
-(if (not (provided? 'snd-clm23.scm)) (load "clm23.scm"))
-(if (not (provided? 'snd-freeverb.scm)) (load "freeverb.scm"))
-(if (not (provided? 'snd-grani.scm)) (load "grani.scm"))
-(if (not (provided? 'snd-animals.scm)) (load "animals.scm"))
-(if (not (provided? 'snd-big-gens.scm)) (load "big-gens.scm"))
-(if (not (provided? 'snd-dlocsig.scm)) (load "dlocsig.scm"))
-(if (not (provided? 'snd-sndwarp.scm)) (load "sndwarp.scm"))
+;;; ---------------- test 22: with-sound ----------------
-(define old-opt-23 (optimization))
+(require snd-prc95.scm snd-jcrev.scm snd-maraca.scm snd-singer.scm snd-strad.scm snd-noise.scm snd-clm-ins.scm snd-jcvoi.scm)
+(require snd-piano.scm snd-play.scm snd-zip.scm snd-clm23.scm snd-freeverb.scm snd-grani.scm snd-animals.scm snd-big-gens.scm)
+(require snd-dlocsig.scm snd-sndwarp.scm)
(defgenerator st1 one two)
(defgenerator st2 (one 11) (two 22))
(defgenerator grab-bag
- (flt 0.0 :type float)
+ (flt 0.0)
(flt1 1.0)
- (i 0 :type int)
+ (i 0)
(i1 123)
- (bool #f :type boolean)
+ (bool #f)
(bool1 #t)
- (ch #\c :type char)
+ (ch #\c)
(ch1 #\c)
- (str "hi" :type string)
+ (str "hi")
(str1 "hi1")
- (lst '() :type list)
- (sym 'hi :type symbol)
- (v #f :type vct)
- (rd #f :type sampler)
- (mxrd #f :type mix-sampler)
- (sd #f :type sound-data)
- (gen #f :type clm)
- (fvect #f :type float-vector)
- (ivect #f :type int-vector)
- (vvect #f :type vct-vector)
- (cvect #f :type clm-vector))
-
-(defgenerator (osc329 :make-wrapper (lambda (gen)
- (set! (osc329-freq gen) (hz->radians (osc329-freq gen)))
- gen)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (radians->hz (osc329-freq g)))
- (lambda (g val) (set! (osc329-freq g) (hz->radians val))))
-
- (list 'mus-phase
- (lambda (g) (osc329-phase g))
- (lambda (g val) (set! (osc329-phase g) val)))
-
- (list 'mus-increment
- (make-procedure-with-setter
- (lambda (g) (osc329-incr g))
- (lambda (g val) (set! (osc329-incr g) val))))
-
- (list 'mus-name
- (lambda (g) "osc329"))
-
- (list 'mus-length
- (lambda (g) (osc329-n g))
- (lambda (g val) (set! (osc329-n g) val)))
-
- (list 'mus-hop
- (make-procedure-with-setter
- (lambda (g) (osc329-n g))
- (lambda (g val) (set! (osc329-n g) val))))
-
- (list 'mus-describe
- (lambda (g) (format #f "osc329 freq: ~A, phase: ~A"
- (mus-frequency g)
- (mus-phase g))))))
- freq phase (n 1 :type int)
- (incr 1.0))
-
-(define (osc329 gen fm)
- (declare (gen osc329) (fm float))
- (let ((result (sin (osc329-phase gen))))
- (set! (osc329-phase gen) (+ (osc329-phase gen) (osc329-freq gen) fm))
- result))
-
+ (lst ())
+ (sym 'hi)
+ (v #f)
+ (rd #f)
+ (mxrd #f)
+ (sd #f)
+ (gen #f)
+ (fvect #f)
+ (ivect #f)
+ (vvect #f)
+ (cvect #f))
-(define (snd_test_23)
+(define (snd_test_22)
(definstrument (green3 start dur freq amp amp-env noise-freq noise-width noise-max-step)
;; brownian noise on amp env
- (let* ((grn (make-green-noise-interp :frequency noise-freq :amplitude noise-max-step :high (* 0.5 noise-width) :low (* -0.5 noise-width)))
- (osc (make-oscil freq))
- (e (make-env amp-env :scaler amp :duration dur))
- (beg (floor (* start (mus-srate))))
- (end (+ beg (floor (* dur (mus-srate))))))
- (run
- (lambda ()
- (do ((i beg (+ 1 i)))
- ((= i end))
- (outa i (* (env e)
- (+ 1.0 (green-noise-interp grn 0.0))
- (oscil osc))))))))
+ (let ((grn (make-green-noise-interp :frequency noise-freq :amplitude noise-max-step :high (* 0.5 noise-width) :low (* -0.5 noise-width)))
+ (osc (make-oscil freq))
+ (e (make-env amp-env :scaler amp :duration dur))
+ (beg (floor (* start *clm-srate*)))
+ (end (floor (* (+ start dur) *clm-srate*))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* (env e)
+ (+ 1.0 (green-noise-interp grn 0.0))
+ (oscil osc))))))
;(with-sound () (green3 0 2.0 440 .5 '(0 0 1 1 2 1 3 0) 100 .2 .02))
(definstrument (green4 start dur freq amp freq-env gliss noise-freq noise-width noise-max-step)
;; same but on freq env
- (let* ((grn (make-green-noise-interp :frequency noise-freq :amplitude noise-max-step :high (* 0.5 noise-width) :low (* -0.5 noise-width)))
- (osc (make-oscil freq))
- (e (make-env freq-env :scaler gliss :duration dur))
- (beg (floor (* start (mus-srate))))
- (end (+ beg (floor (* dur (mus-srate))))))
- (run
- (lambda ()
- (do ((i beg (+ 1 i)))
- ((= i end))
- (outa i (* amp (oscil osc (hz->radians (+ (env e) (green-noise-interp grn 0.0)))))))))))
- ;(with-sound () (green4 0 2.0 440 .5 '(0 0 1 1 2 1 3 0) 440 100 100 10))
+ (let ((grn (make-green-noise-interp :frequency noise-freq
+ :amplitude (hz->radians noise-max-step)
+ :high (hz->radians (* 0.5 noise-width))
+ :low (hz->radians (* -0.5 noise-width))))
+ (osc (make-oscil freq))
+ (e (make-env freq-env :scaler (hz->radians gliss) :duration dur))
+ (beg (seconds->samples start))
+ (end (seconds->samples (+ start dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (* amp (oscil osc (+ (env e) (green-noise-interp grn 0.0))))))))
(define (ws-sine freq)
(let ((o (make-oscil freq)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 100))
- (outa i (oscil o))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 100))
+ (outa i (oscil o)))))
(define (step-src)
(let* ((rd (make-sampler 0))
(o (make-oscil 2205.0))
- (s (make-src :srate 0.0))
+ (s (make-src :srate 0.0 :input rd))
(incr (+ 2.0 (oscil o)))
- (tempfile (with-sound (:output (snd-tempnam) :srate (srate) :to-snd #f :comment "step-src")
- (run
- (do ((samp 0 (+ 1 samp)))
- ((sampler-at-end? rd))
- (out-any samp
- (src s incr (lambda (dir) (read-sample rd)))
- 0)
- (if (= (modulo samp 2205) 0)
- (set! incr (+ 2.0 (oscil o))))))))
- (len (mus-sound-frames tempfile)))
+ (tempfile (with-sound ((snd-tempnam) :srate (srate) :to-snd #f :comment "step-src")
+ (do ((samp 0 (+ samp 1)))
+ ((sampler-at-end? rd))
+ (outa samp (src s incr))
+ (if (= (modulo samp 2205) 0)
+ (set! incr (+ 2.0 (oscil o)))))))
+ (len (mus-sound-framples tempfile)))
(set-samples 0 (- len 1) tempfile #f #f #t "step-src" 0 #f #t)))
- (define* (clm-reverb-sound reverb-amount reverb (reverb-data '()) snd)
+ (define* (clm-reverb-sound reverb-amount reverb (reverb-data ()) snd)
(let ((output (snd-tempnam))
(revout (snd-tempnam))
- (len (+ (frames snd) (srate snd))))
+ (len (+ (framples snd) (srate snd))))
(scale-by (- 1.0 reverb-amount) snd)
(save-sound-as output snd)
(undo 1 snd)
@@ -53108,7 +40780,7 @@ EDITS: 1
(dynamic-wind
(lambda ()
(set! *output* (continue-sample->file output))
- (set! (mus-srate) (srate snd))
+ (set! *clm-srate* (srate snd))
(set! *reverb* (make-file->sample revout)))
(lambda ()
(apply reverb reverb-data))
@@ -53126,15 +40798,14 @@ EDITS: 1
(define* (optkey-4 (a 1) (b 2) (c 3) d) (list a b c d))
(define (fir+comb beg dur freq amp size)
- (let* ((start (floor (* (mus-srate) beg)))
- (end (+ start (floor (* (mus-srate) dur))))
- (dly (make-comb :scaler .9 :size size))
- (flt (make-fir-filter :order size :xcoeffs (mus-data dly)))
- (r (make-rand freq)))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (outa i (* amp (fir-filter flt (comb dly (rand r)))))))))
+ (let ((dly (make-comb :scaler .9 :size size)))
+ (let ((start (floor (* *clm-srate* beg)))
+ (end (floor (* *clm-srate* (+ beg dur))))
+ (flt (make-fir-filter :order size :xcoeffs (mus-data dly)))
+ (r (make-rand freq)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (* amp (fir-filter flt (comb dly (rand r)))))))))
(definstrument (dloc-sinewave start-time duration freq amp
(amp-env '(0 1 1 1))
@@ -53145,19 +40816,17 @@ EDITS: 1
(dloc (car vals))
(beg (cadr vals))
(end (caddr vals)))
- (let* ((osc (make-oscil :frequency freq))
- (aenv (make-env :envelope amp-env :scaler amp :duration duration)))
- (run
- (lambda ()
- (do ((i beg (+ 1 i)))
+ (let ((osc (make-oscil :frequency freq))
+ (aenv (make-env :envelope amp-env :scaler amp :duration duration)))
+ (do ((i beg (+ i 1)))
((= i end))
- (dlocsig dloc i (* (env aenv) (oscil osc)))))))))
+ (dlocsig dloc i (* (env aenv) (oscil osc)))))))
(definstrument (dlocsig-sinewave-1 start-time duration freq amp
(amp-env '(0 1 1 1))
(path (make-path :path '(-10 10 0 5 10 10)))
(decode amplitude-panning)
- (initdly #f))
+ initdly)
(let* ((vals (make-dlocsig :start-time start-time
:duration duration
:render-using decode
@@ -53166,18 +40835,16 @@ EDITS: 1
(dloc (car vals))
(beg (cadr vals))
(end (caddr vals)))
- (let* ((osc (make-oscil :frequency freq))
- (aenv (make-env :envelope amp-env :scaler amp :duration duration)))
- (run
- (lambda ()
- (do ((i beg (+ 1 i)))
+ (let ((osc (make-oscil :frequency freq))
+ (aenv (make-env :envelope amp-env :scaler amp :duration duration)))
+ (do ((i beg (+ i 1)))
((= i end))
- (dlocsig dloc i (* (env aenv) (oscil osc)))))))))
+ (dlocsig dloc i (* (env aenv) (oscil osc)))))))
(define (mix-move-sound start-time file path)
(let* ((duration (mus-sound-duration file))
(rd (make-sampler 0 file))
- (start (round (* (mus-srate) start-time)))
+ (start (round (* *clm-srate* start-time)))
(tmp-sound (with-temp-sound (:channels 4 :srate (mus-sound-srate file))
(let* ((vals (make-dlocsig :start-time 0
:duration duration
@@ -53185,131 +40852,69 @@ EDITS: 1
(dloc (car vals))
(beg (cadr vals))
(end (caddr vals)))
- (run
- (lambda ()
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
- (dlocsig dloc i (read-sample rd)))))))))
- (mix tmp-sound start #t #f #f (with-mix-tags) #t)))
-
- (define (check-segments vals snd chn name)
- (let* ((rd (make-sampler 0 snd chn))
- (len (frames snd chn))
- (seglen (round (/ len 50)))
- (segctr 0)
- (segmax 0.0)
- (valctr 0)
- (unhappiest 0.0)
- (unhappiestseg 0)
- (unhappy 0)
- (alldone #f))
- (do ((i 0 (+ 1 i)))
- ((or alldone (= i len)))
- (let ((samp (abs (rd))))
- (if (> samp segmax) (set! segmax samp))
- (set! segctr (+ 1 segctr))
- (if (>= segctr seglen)
- (begin
- (set! segctr 0)
- (if (> (abs (- segmax (vector-ref vals valctr))) .003)
- (begin
- ;(if (< unhappy 2)
- (snd-print (format #f "~A: seg ~D differs: ~A ~A~%" name valctr segmax (vector-ref vals valctr)));)
- (let ((hdiff (abs (- segmax (vector-ref vals valctr)))))
- (if (> hdiff unhappiest)
- (begin
- (set! unhappiestseg valctr)
- (set! unhappiest hdiff))))
- (set! unhappy (+ 1 unhappy))))
- (set! valctr (+ 1 valctr))
- (if (>= valctr (vector-length vals)) (set! alldone #t))
- (set! segmax 0.0)))))
- (if (> unhappy 0)
- (snd-print (format #f "~A: unhappiest: ~A ~A~%" name unhappiestseg unhappiest)))))
+ (dlocsig dloc i (read-sample rd)))))))
+ (mix tmp-sound start #t #f #f *with-mix-tags* #t)))
(definstrument (defopt-simp beg dur (frequency 440.0) (amplitude 0.1))
- (let* ((os (make-oscil frequency)))
- (run
- (do ((i 0 (+ 1 i))) ((= i dur))
- (outa (+ i beg) (* amplitude (oscil os)))))))
-
+ (let ((os (make-oscil frequency))
+ (end (+ beg dur)))
+ (do ((i beg (+ i 1))) ((= i end))
+ (outa i (* amplitude (oscil os))))))
(definstrument (jcrev2)
- (let* (
- (allpass11 (make-all-pass -0.700 0.700 1051))
- (allpass21 (make-all-pass -0.700 0.700 337))
- (allpass31 (make-all-pass -0.700 0.700 113))
- (comb11 (make-comb 0.742 4799))
- (comb21 (make-comb 0.733 4999))
- (comb31 (make-comb 0.715 5399))
- (comb41 (make-comb 0.697 5801))
- (outdel11 (make-delay (seconds->samples .01)))
-
- (allpass12 (make-all-pass -0.700 0.700 1051))
- (allpass22 (make-all-pass -0.700 0.700 337))
- (allpass32 (make-all-pass -0.700 0.700 113))
- (comb12 (make-comb 0.742 4799))
- (comb22 (make-comb 0.733 4999))
- (comb32 (make-comb 0.715 5399))
- (comb42 (make-comb 0.697 5801))
- (outdel12 (make-delay (seconds->samples .01)))
-
- (file-dur (frames *reverb*))
- (decay-dur (mus-srate))
- (len (floor (+ decay-dur file-dur))))
-
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i len))
-
- (let* ((allpass-sum (all-pass allpass31
- (all-pass allpass21
- (all-pass allpass11
- (ina i *reverb*)))))
- (comb-sum (+ (comb comb11 allpass-sum)
- (comb comb21 allpass-sum)
- (comb comb31 allpass-sum)
- (comb comb41 allpass-sum))))
- (outa i (delay outdel11 comb-sum)))
-
- (let* ((allpass-sum (all-pass allpass32
- (all-pass allpass22
- (all-pass allpass12
- (inb i *reverb*)))))
- (comb-sum (+ (comb comb12 allpass-sum)
- (comb comb22 allpass-sum)
- (comb comb32 allpass-sum)
- (comb comb42 allpass-sum))))
- (outb i (delay outdel12 comb-sum)))
- )))))
+ (let ((allpass11 (make-all-pass -0.700 0.700 1051))
+ (allpass21 (make-all-pass -0.700 0.700 337))
+ (allpass31 (make-all-pass -0.700 0.700 113))
+ (comb11 (make-comb 0.742 4799))
+ (comb21 (make-comb 0.733 4999))
+ (comb31 (make-comb 0.715 5399))
+ (comb41 (make-comb 0.697 5801))
+ (outdel11 (make-delay (seconds->samples .01)))
+
+ (allpass12 (make-all-pass -0.700 0.700 1051))
+ (allpass22 (make-all-pass -0.700 0.700 337))
+ (allpass32 (make-all-pass -0.700 0.700 113))
+ (comb12 (make-comb 0.742 4799))
+ (comb22 (make-comb 0.733 4999))
+ (comb32 (make-comb 0.715 5399))
+ (comb42 (make-comb 0.697 5801))
+ (outdel12 (make-delay (seconds->samples .01)))
+ (len (floor (+ (framples *reverb*) *clm-srate*))))
+
+ (let ((combs1 (make-comb-bank (vector comb11 comb21 comb31 comb41)))
+ (combs2 (make-comb-bank (vector comb12 comb22 comb32 comb42)))
+ (allpasses1 (make-all-pass-bank (vector allpass11 allpass21 allpass31)))
+ (allpasses2 (make-all-pass-bank (vector allpass12 allpass22 allpass32))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (outa i (delay outdel11 (comb-bank combs1 (all-pass-bank allpasses1 (ina i *reverb*))))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (outb i (delay outdel12 (comb-bank combs2 (all-pass-bank allpasses2 (inb i *reverb*)))))))))
(definstrument (floc-simp beg dur (amp 0.5) (freq 440.0) (ramp 2.0) (rfreq 1.0) offset)
- (let* ((os (make-pulse-train freq))
+ (let ((os (make-pulse-train freq amp))
(floc (make-flocsig :reverb-amount 0.1
:frequency rfreq
:amplitude ramp
:offset offset))
(start (seconds->samples beg))
- (end (+ start (seconds->samples dur))))
- (run
- (lambda ()
+ (end (seconds->samples (+ beg dur))))
(do ((i start (+ i 1)))
((= i end))
- (flocsig floc i (* amp (pulse-train os))))))))
+ (flocsig floc i (pulse-train os)))))
(define (test-ws-errors)
;; since we only catch 'mus-error and 'with-sound-interrupt above, any other error
- ;; closes *output* and returns to the top-level -- are there languishing threads?
- ;; Need a way outside with-sound to see what threads are out there.
+ ;; closes *output* and returns to the top-level
(define (bad-ins start)
(set! (playing) #f))
- (set! *clm-threads* 4)
-
(let ((prev (find-sound "test.snd")))
(if (sound? prev)
(close-sound prev)))
@@ -53325,7 +40930,7 @@ EDITS: 1
(let ((tag (catch #t
(lambda ()
- (with-sound (:output "test.snd")
+ (with-sound ("test.snd")
(fm-violin 0 1 440 .1)
(fm-violin .1 1 660 .1)
(fm-violin .2 1 880 .1)
@@ -53344,102 +40949,7 @@ EDITS: 1
(if (sound? prev)
(begin
(snd-display #__line__ ";ws error -220 opened test.snd?")
- (close-sound prev))))
- (if *ws-finish*
- (snd-display #__line__ ";ws error -220 caught interrupt? ~A" *ws-finish*)))
-
- (if (defined? 'all-threads)
- (let ((current-threads (all-threads)))
- (if (not (equal? current-threads (list (current-thread))))
- (snd-display #__line__ ";ws error threaded start threads: ~A, current:~A" current-threads (current-thread)))
-
- (let ((tag (catch #t
- (lambda ()
- (with-threaded-sound (:output "test.snd")
- (fm-violin 0 1 440 .1)
- (fm-violin .1 1 660 .1)
- (fm-violin .2 1 880 .1)
- (fm-violin .3 1 -220 .1)))
- (lambda args args))))
-
- (if (or (not (list? tag))
- (not (eq? (car tag) 'wrong-type-arg)))
- (snd-display #__line__ ";ws-error threaded -220: ~A" tag))
- (if (mus-output? *output*)
- (begin
- (snd-display #__line__ ";ws-error threaded -220: *output*: ~A" *output*)
- (mus-close *output*)
- (set! *output* #f)))
- (let ((prev (find-sound "test.snd")))
- (if (sound? prev)
- (begin
- (snd-display #__line__ ";ws error threaded -220 opened test.snd?")
- (close-sound prev))))
- (if *ws-finish*
- (snd-display #__line__ ";ws error threaded -220 caught interrupt? ~A" *ws-finish*))
-
- (if (not (equal? current-threads (all-threads)))
- (snd-display #__line__ ";ws error threaded -220 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
-
- (let ((tag (catch #t
- (lambda ()
- (with-threaded-sound (:output "test.snd")
- (fm-violin .3 1 44220 .1)))
- (lambda args args))))
-
- (if (or (not (list? tag))
- (not (eq? (car tag) 'out-of-range)))
- (snd-display #__line__ ";ws-error threaded -220 1: ~A" tag))
- (if (mus-output? *output*)
- (begin
- (snd-display #__line__ ";ws-error threaded -220 1: *output*: ~A" *output*)
- (mus-close *output*)
- (set! *output* #f)))
- (let ((prev (find-sound "test.snd")))
- (if (sound? prev)
- (begin
- (snd-display #__line__ ";ws error threaded -220 1 opened test.snd?")
- (close-sound prev))))
- (if *ws-finish*
- (snd-display #__line__ ";ws error threaded -220 1 caught interrupt? ~A" *ws-finish*))
-
- (if (not (equal? current-threads (all-threads)))
- (snd-display #__line__ ";ws error threaded -220 1 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
-
- (let ((tag (catch #t
- (lambda ()
- (with-threaded-sound (:output "test.snd" :reverb jc-reverb)
- (fm-violin 0 1 440 .1)
- (fm-violin .1 1 660 .1)
- (fm-violin .2 1 880 .1)
- (fm-violin .2 1 880 .1)
- (fm-violin .3 -1 220 .1)))
- (lambda args args))))
-
- (if (or (not (list? tag))
- (not (eq? (car tag) 'out-of-range)))
- (snd-display #__line__ ";ws-error threaded -220 2: ~A" tag))
- (if (mus-output? *output*)
- (begin
- (snd-display #__line__ ";ws-error threaded -220 2: *output*: ~A" *output*)
- (mus-close *output*)
- (set! *output* #f)))
- (if (mus-output? *reverb*)
- (begin
- (snd-display #__line__ ";ws-error threaded -220 2: *reverb*: ~A" *reverb*)
- (mus-close *reverb*)
- (set! *reverb* #f)))
- (let ((prev (find-sound "test.snd")))
- (if (sound? prev)
- (begin
- (snd-display #__line__ ";ws error threaded -220 2 opened test.snd?")
- (close-sound prev))))
- (if *ws-finish*
- (snd-display #__line__ ";ws error threaded -220 2 caught interrupt? ~A" *ws-finish*))
-
- (if (not (equal? current-threads (all-threads)))
- (snd-display #__line__ ";ws error threaded -220 2 threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads))))
- ))
+ (close-sound prev)))))
;; ---------------- catch 'mus-error (handled by with-sound, but no continuation -- appears to exit after cleaning up) ----------------
@@ -53448,7 +40958,7 @@ EDITS: 1
(let ((tag (catch #t
(lambda ()
- (with-sound (:output "test.snd")
+ (with-sound ("test.snd")
(fm-violin 0 1 440 .1)
(fm-violin .1 1 660 .1)
(fm-violin .2 1 880 .1)
@@ -53466,331 +40976,42 @@ EDITS: 1
(let ((prev (find-sound "test.snd")))
(if (not (sound? prev))
(snd-display #__line__ ";ws error bad env did not open test.snd?")
- (close-sound prev)))
- (if *ws-finish*
- (snd-display #__line__ ";ws error bad env caught interrupt? ~A" *ws-finish*)))
-
- (if (defined? 'all-threads)
- (let ((current-threads (all-threads)))
- (if (not (equal? current-threads (list (current-thread))))
- (snd-display #__line__ ";ws error threaded start 1 threads: ~A, current:~A" current-threads (current-thread)))
-
- (let ((tag (catch #t
- (lambda ()
- (with-threaded-sound (:output "test.snd")
- (fm-violin 0 1 440 .1)
- (fm-violin .1 1 660 .1)
- (fm-violin .2 1 880 .1)
- (fm-violin .3 1 220 .1 :amp-env '(0 0 1 1 .5 1 0 0))))
- (lambda args args))))
-
- (if (or (not (string? tag))
- (not (string=? tag "test.snd")))
- (snd-display #__line__ ";ws-error threaded bad env: ~A" tag))
- (if (mus-output? *output*)
- (begin
- (snd-display #__line__ ";ws-error threaded bad env: *output*: ~A" *output*)
- (mus-close *output*)
- (set! *output* #f)))
- (let ((prev (find-sound "test.snd")))
- (if (not (sound? prev))
- (snd-display #__line__ ";ws error threaded bad env did not open test.snd?")
- (close-sound prev)))
- (if *ws-finish*
- (snd-display #__line__ ";ws error threaded bad env caught interrupt? ~A" *ws-finish*)))
-
- (if (not (equal? current-threads (all-threads)))
- (snd-display #__line__ ";ws error threaded bad env threads: ~A, current:~A, all: ~A" current-threads (current-thread) (all-threads)))))
-
-
- ;; ---------------- interrupt with-sound ----------------
+ (close-sound prev))))
- (let ((tag (catch #t
- (lambda ()
- (with-sound (:output "test.snd")
- (fm-violin 0 1 440 .1)
- (bad-ins 1)
- (fm-violin 2 1 220 .1)))
- (lambda args args))))
-
- (ws-quit!)
- (if (mus-output? *output*)
- (begin
- (snd-display #__line__ ";ws-error interrupt quit: *output*: ~A" *output*)
- (mus-close *output*)
- (set! *output* #f)))
- (let ((prev (find-sound "test.snd")))
- (if (not (sound? prev))
- (snd-display #__line__ ";ws error interrupt quit did not open test.snd?")
- (close-sound prev)))
- (if *ws-finish*
- (snd-display #__line__ ";ws error interrupt not complete? ~A" *ws-finish*)))
-
- (let ((tag (catch #t
- (lambda ()
- (with-threaded-sound (:output "test.snd")
- (fm-violin 0 1 440 .1)
- (bad-ins 1)
- (fm-violin 2 1 220 .1)))
- (lambda args args))))
-
- (ws-quit!)
- (if (mus-output? *output*)
- (begin
- (snd-display #__line__ ";ws-error threaded interrupt quit: *output*: ~A" *output*)
- (mus-close *output*)
- (set! *output* #f)))
- (let ((prev (find-sound "test.snd")))
- (if (not (sound? prev))
- (snd-display #__line__ ";ws error threaded interrupt quit did not open test.snd?")
- (close-sound prev)))
- (if *ws-finish*
- (snd-display #__line__ ";ws error threaded interrupt not complete? ~A" *ws-finish*)))
-
-
- (snd-display #__line__ ";end error printout.")
-
- (let ((tag (with-sound (:output "test.snd" :srate 44100) (fm-violin 0 1 440 .1))))
- (if (or (not (string? tag))
- (not (string=? tag "test.snd")))
- (snd-display #__line__ ";ws-error all done: ~A" tag))
- (if (not (= (mus-sound-frames "test.snd") 44100))
- (snd-display #__line__ ";ws-error all done frames: ~A" (mus-sound-frames "test.snd"))))
-
- (let ((tag (with-threaded-sound (:output "test.snd" :srate 44100) (fm-violin 0 1 440 .1))))
- (if (or (not (string? tag))
- (not (string=? tag "test.snd")))
- (snd-display #__line__ ";ws-error threaded all done: ~A" tag))
- (if (not (= (mus-sound-frames "test.snd") 44100))
- (snd-display #__line__ ";ws-error threaded all done frames: ~A" (mus-sound-frames "test.snd"))))
-
- (close-sound (find-sound "test.snd"))
+ (if (sound? (find-sound "test.snd"))
+ (close-sound (find-sound "test.snd")))
(delete-file "test.snd")
)
- (catch #t
- (lambda ()
- (vector-synthesis (let ((ctr 0) (file 0))
- (lambda (files bufsize)
- (if (> ctr 4)
- (begin
- (set! file (+ 1 file))
- (set! ctr 0)
- (if (>= file files)
- (set! file 0)))
- (set! ctr (+ 1 ctr)))
- file))
- (list "oboe.snd" "pistol.snd") #t))
- (lambda args (display args)))
-
- (if (provided? 'snd-threads)
- (begin
-
- ;; 1-chan
- (let* ((snd (open-sound "oboe.snd"))
- (len (frames snd)))
- (with-threaded-channels snd (lambda (snd chn) (src-channel 2.0 0 #f snd chn)))
- (if (> (abs (- (* 2 (frames snd)) len)) 5)
- (snd-display #__line__ ";with-threaded-sound oboe src: ~A ~A" (frames) len))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (filter-channel '(0 1 .1 0 1 0) 120 0 #f snd chn)))
- (if (> (maxamp snd 0) .1)
- (snd-display #__line__ ";with-threaded-channels oboe filter: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (map-channel (lambda (y) (* y 2)) 0 #f snd chn)))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels oboe map: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn)))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels oboe ptree: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn #f #t)))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels oboe ptree peak: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y data forward) (* y (vct-ref data 0))) 0 #f snd chn #f #f (lambda (beg dur) (vct 2.0)))))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels oboe ptree vct: ~A ~A" (maxamp snd 0) (maxamp snd 0 0)))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (reverse-channel 0 #f snd chn)))
- (if (not (= (frames snd 0) (frames snd 0 0)))
- (snd-display #__line__ ";with-threaded-channels oboe reverse: ~A ~A" (frames snd 0) (frames snd 0 0)))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (src-channel 0.5 0 #f snd chn)))
- (if (> (abs (- (* .5 (frames snd)) len)) 5)
- (snd-display #__line__ ";with-threaded-sound oboe src 5: ~A ~A" (frames) len))
- (revert-sound snd)
- (close-sound snd))
-
- ;; 4-chans
- (let* ((snd (open-sound "4.aiff"))
- (len (frames snd)))
- (with-threaded-channels snd (lambda (snd chn) (src-channel 2.0 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (if (> (abs (- (* 2 (frames snd i)) len)) 5)
- (snd-display #__line__ ";with-threaded-sound 4 src ~D: ~A ~A" i (frames) len)))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (filter-channel '(0 1 .1 0 1 0) 120 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (if (> (maxamp snd 0) .1)
- (snd-display #__line__ ";with-threaded-channels 4.aiff filter ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (map-channel (lambda (y) (* y 2)) 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels 4.aiff map~D : ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels 4.aiff ptree ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn #f #t)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels 4.aiff ptree peak ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y data forward) (* y (vct-ref data 0))) 0 #f snd chn #f #f (lambda (beg dur) (vct 2.0)))))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels 4.aiff ptree vct ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (reverse-channel 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (if (not (= (frames snd 0) (frames snd 0 0)))
- (snd-display #__line__ ";with-threaded-channels 4.aiff reverse ~D: ~A ~A" i (frames snd 0) (frames snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (src-channel 0.5 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 4))
- (if (> (abs (- (* .5 (frames snd)) len)) 5)
- (snd-display #__line__ ";with-threaded-sound 4.aiff src 5 ~D: ~A ~A" i (frames) len)))
- (revert-sound snd)
- (close-sound snd))
-
- ;; 8-chans
- (let* ((snd (find-sound (with-sound (:channels 8)
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (fm-violin 0 1 (* (+ 1 i) 100.0) .3 :degree (* i (/ 360 8)))))))
- (len (frames snd)))
- (with-threaded-channels snd (lambda (snd chn) (src-channel 2.0 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (if (> (abs (- (* 2 (frames snd i)) len)) 5)
- (snd-display #__line__ ";with-threaded-sound 4 src ~D: ~A ~A" i (frames) len)))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (filter-channel '(0 1 .1 0 1 0) 120 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (if (or (> (maxamp snd 0) .35) ; the other two cases involve higher sounds
- (< (maxamp snd 0) .25))
- (snd-display #__line__ ";with-threaded-channels 8 chan filter ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (map-channel (lambda (y) (* y 2)) 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels 8 chan map ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels 8 chan ptree ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y) (* y 2)) 0 #f snd chn #f #t)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels 8 chan ptree peak ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (ptree-channel (lambda (y data forward) (* y (vct-ref data 0))) 0 #f snd chn #f #f (lambda (beg dur) (vct 2.0)))))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (if (< (maxamp snd 0) .25)
- (snd-display #__line__ ";with-threaded-channels 8 chan ptree vct ~D: ~A ~A" i (maxamp snd 0) (maxamp snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (reverse-channel 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (if (not (= (frames snd 0) (frames snd 0 0)))
- (snd-display #__line__ ";with-threaded-channels 8 chan reverse ~D: ~A ~A" i (frames snd 0) (frames snd 0 0))))
- (revert-sound snd)
- (with-threaded-channels snd (lambda (snd chn) (src-channel 0.5 0 #f snd chn)))
- (do ((i 0 (+ i 1)))
- ((= i 8))
- (if (> (abs (- (* .5 (frames snd)) len)) 5)
- (snd-display #__line__ ";with-threaded-sound 8 chan src 5 ~D: ~A ~A" i (frames) len)))
- (revert-sound snd)
- (close-sound snd))
- ))
-
- (set! (optimization) max-optimization)
(dismiss-all-dialogs)
(do ((clmtest 0 (+ 1 clmtest))) ((= clmtest tests))
(log-mem clmtest)
-
- (set! (mus-srate) 22050)
- (set! (default-output-srate) 22050)
-
+
+; (set! *clm-notehook* (lambda args (display args) (newline)))
+
;; check clm output for bad zero case
(for-each
(lambda (type)
(let ((ind (find-sound
- (with-sound (:data-format type)
+ (with-sound (:sample-type type :srate 22050)
(fm-violin 0 .1 440 .1)
(fm-violin 10 .1 440 .1)
(fm-violin 100 .1 440 .1)
- (fm-violin 1000 .1 440 .1)))))
+ (fm-violin 250 .1 440 .1)))))
(let ((mx (maxamp ind)))
(if (ffneq mx .1) ; mus-byte -> 0.093
- (snd-display #__line__ ";max: ~A, format: ~A" mx (mus-data-format->string type))))))
+ (snd-display #__line__ ";max: ~A, format: ~A" mx (mus-sample-type->string type))))))
(list mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte
mus-lfloat mus-bint mus-lint mus-b24int mus-l24int
mus-ubshort mus-ulshort mus-ubyte mus-bfloat mus-bdouble
mus-ldouble))
- (let ((old-opt (optimization)))
- (do ((opt 0 (+ 1 opt)))
- ((> opt max-optimization))
- (set! (optimization) opt)
- (with-sound (:srate 22050) (fm-violin 0 .1 (* 110 (+ 1 opt)) .1))
- (let ((ind (find-sound "test.snd")))
- (if (not ind) (snd-display #__line__ ";with-sound: ~A" (map file-name (sounds))))
- (let ((mx (maxamp)))
- (if (fneq mx .1) (snd-display #__line__ ";with-sound max: ~A" (maxamp)))
- (if (not (= (srate ind) 22050)) (snd-display #__line__ ";with-sound srate: ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test.snd")))
- (if (not (= (frames ind) 2205)) (snd-display #__line__ ";with-sound frames: ~A" (frames ind))))
- (play ind :wait #t)))
- (set! (optimization) old-opt))
-
- (with-sound (:continue-old-file #t) (fm-violin .2 .1 440 .25))
- (let ((ind (find-sound "test.snd")))
- (if (not ind) (snd-display #__line__ ";with-sound continued: ~A" (map file-name (sounds))))
- (if (not (= (length (sounds)) 1)) (snd-display #__line__ ";with-sound continued: ~{~A ~}" (map short-file-name (sounds))))
- (let ((mx (maxamp)))
- (if (fneq mx .25) (snd-display #__line__ ";with-sound continued max: ~A" (maxamp)))
- (if (not (= (srate ind) 22050)) (snd-display #__line__ ";with-sound continued srate: ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test.snd")))
- (if (not (= (frames ind) (* 3 2205))) (snd-display #__line__ ";with-sound continued frames: ~A (~A)" (frames ind) (srate ind))))
- (close-sound ind))
-
(with-sound () (fm-violin 0 .1 440 .1))
(with-sound (:continue-old-file #t) (fm-violin .2 .1 660 .04))
(let ((ind (find-sound "test.snd")))
(if (fneq (maxamp ind 0) .1) (snd-display #__line__ ";maxamp after continued sound: ~A" (maxamp ind 0)))
- (if (fneq (/ (frames ind) (srate ind)) .3) (snd-display #__line__ ";duration after continued sound: ~A" (/ (frames ind) (srate ind))))
+ (if (fneq (/ (framples ind) (srate ind)) .3) (snd-display #__line__ ";duration after continued sound: ~A" (/ (framples ind) (srate ind))))
(close-sound ind))
(with-sound (:srate 22050 :channels 2 :output "test1.snd") (fm-violin 0 .1 440 .1 :degree 45.0))
@@ -53800,39 +41021,41 @@ EDITS: 1
(if (fneq mx .05) (snd-display #__line__ ";with-sound max (1): ~A" (maxamp)))
(if (or (not (= (srate ind) 22050))
(not (= (mus-sound-srate "test1.snd") 22050)))
- (snd-display #__line__ ";with-sound srate (1): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
- (if (not (= (frames ind) 2205)) (snd-display #__line__ ";with-sound frames (1): ~A" (frames ind)))
+ (snd-display #__line__ ";with-sound srate (1): ~A (~A, ~A)" (srate ind) *clm-srate* (mus-sound-srate "test1.snd")))
+ (if (and (not (= (framples ind) 2205))
+ (not (= (framples ind) 2206)))
+ (snd-display #__line__ ";with-sound framples (1): ~A" (framples ind)))
(if (or (not (= (chans ind) 2))
(not (= (mus-sound-chans "test1.snd") 2)))
(snd-display #__line__ ";with-sound chans (1): ~A" (chans ind))))
(close-sound ind)
(delete-file "test1.snd"))
- (with-sound (:srate 48000 :channels 2 :header-type mus-riff :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (with-sound (:srate 48000 :channels 2 :header-type mus-riff :sample-type mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
(let ((ind (find-sound "test1.snd")))
(if (or (not (= (srate ind) 48000))
(not (= (mus-sound-srate "test1.snd") 48000)))
- (snd-display #__line__ ";with-sound srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (snd-display #__line__ ";with-sound srate (48000, r): ~A (~A, ~A)" (srate ind) *clm-srate* (mus-sound-srate "test1.snd")))
(if (not (= (header-type ind) mus-riff)) (snd-display #__line__ ";with-sound type (~A, r): ~A" mus-riff (header-type ind)))
(if (not (= (chans ind) 2)) (snd-display #__line__ ";with-sound chans (2, r): ~A" (chans ind)))
(close-sound ind)
(delete-file "test1.snd"))
- (with-sound (:srate 48000 :channels 2 :header-type mus-rf64 :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (with-sound (:srate 48000 :channels 2 :header-type mus-rf64 :sample-type mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
(let ((ind (find-sound "test1.snd")))
(if (or (not (= (srate ind) 48000))
(not (= (mus-sound-srate "test1.snd") 48000)))
- (snd-display #__line__ ";with-sound srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (snd-display #__line__ ";with-sound srate (48000, r): ~A (~A, ~A)" (srate ind) *clm-srate* (mus-sound-srate "test1.snd")))
(if (not (= (header-type ind) mus-rf64)) (snd-display #__line__ ";with-sound type (~A, r): ~A" mus-rf64 (header-type ind)))
(if (not (= (chans ind) 2)) (snd-display #__line__ ";with-sound chans (2, r): ~A" (chans ind)))
(close-sound ind)
(delete-file "test1.snd"))
- (with-sound (:srate 48000 :channels 2 :header-type mus-caff :data-format mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
+ (with-sound (:srate 48000 :channels 2 :header-type mus-caff :sample-type mus-lshort :output "test1.snd") (fm-violin 0 .1 440 .1))
(let ((ind (find-sound "test1.snd")))
(if (or (not (= (srate ind) 48000))
(not (= (mus-sound-srate "test1.snd") 48000)))
- (snd-display #__line__ ";with-sound mus-caff srate (48000, r): ~A (~A, ~A)" (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (snd-display #__line__ ";with-sound mus-caff srate (48000, r): ~A (~A, ~A)" (srate ind) *clm-srate* (mus-sound-srate "test1.snd")))
(if (not (= (header-type ind) mus-caff)) (snd-display #__line__ ";with-sound type (~A, r): ~A" mus-caff (header-type ind)))
(if (not (= (chans ind) 2)) (snd-display #__line__ ";with-sound mus-caff chans (2, r): ~A" (chans ind)))
(close-sound ind)
@@ -53841,7 +41064,7 @@ EDITS: 1
(with-sound (:srate 8000 :channels 3 :header-type mus-next :output "test1.snd") (fm-violin 0 .1 440 .1))
(let ((ind (find-sound "test1.snd")))
(if (not (= (srate ind) 8000)) (snd-display #__line__ ";with-sound srate (8000, s): ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (srate ind) *clm-srate* (mus-sound-srate "test1.snd")))
(if (not (= (header-type ind) mus-next)) (snd-display #__line__ ";with-sound type (~A, s): ~A" mus-next (header-type ind)))
(if (not (= (chans ind) 3)) (snd-display #__line__ ";with-sound chans (3, s): ~A" (chans ind)))
(close-sound ind)
@@ -53850,7 +41073,7 @@ EDITS: 1
(with-sound (:srate 96000 :channels 4 :header-type mus-aifc :output "test1.snd") (fm-violin 0 .1 440 .1))
(let ((ind (find-sound "test1.snd")))
(if (not (= (srate ind) 96000)) (snd-display #__line__ ";with-sound srate (96000, t): ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (srate ind) *clm-srate* (mus-sound-srate "test1.snd")))
(if (not (= (header-type ind) mus-aifc)) (snd-display #__line__ ";with-sound type (~A, t): ~A" mus-aifc (header-type ind)))
(if (not (= (chans ind) 4)) (snd-display #__line__ ";with-sound chans (4, t): ~A" (chans ind)))
(close-sound ind)
@@ -53859,7 +41082,7 @@ EDITS: 1
(with-sound (:srate 22050 :channels 1 :header-type mus-raw :output "test1.snd") (fm-violin 0 .1 440 .1))
(let ((ind (find-sound "test1.snd")))
(if (not (= (srate ind) 22050)) (snd-display #__line__ ";with-sound srate (22050, u): ~A (~A, ~A)"
- (srate ind) (mus-srate) (mus-sound-srate "test1.snd")))
+ (srate ind) *clm-srate* (mus-sound-srate "test1.snd")))
(if (not (= (header-type ind) mus-raw)) (snd-display #__line__ ";with-sound type (~A, u): ~A" mus-raw (header-type ind)))
(if (not (= (chans ind) 1)) (snd-display #__line__ ";with-sound chans (1, u): ~A" (chans ind)))
(close-sound ind)
@@ -53872,23 +41095,10 @@ EDITS: 1
(snd-display #__line__ ";srate file *reverb*: ~A" (mus-sound-srate (mus-file-name *reverb*))))
(fm-violin 0 .1 440 .1 :degree 45.0))
(let ((ind (find-sound "test1.snd")))
- (if (not ind) (snd-display #__line__ ";with-sound (2): ~A" (map file-name (sounds))))
- (if (not (= (frames ind) (+ 22050 2205))) (snd-display #__line__ ";with-sound reverbed frames (2): ~A" (frames ind)))
+ (if (not ind) (snd-display #__line__ ";with-sound (2): ~A" (map file-name (sounds)))
+ (if (> (- (framples ind) (+ 22050 2205)) 1) (snd-display #__line__ ";with-sound reverbed framples (2): ~A" (framples ind))))
(close-sound ind))
- (let ((old-opt (optimization)))
- (do ((opt 0 (+ 1 opt)))
- ((> opt max-optimization))
- (set! (optimization) opt)
- (with-sound (:srate 22050 :output "test1.snd" :reverb jc-reverb) (fm-violin 0 .1 440 .1))
- (set! (optimization) old-opt)))
-
- (let ((ind (find-sound "test1.snd")))
- (if (not ind) (snd-display #__line__ ";with-sound (3): ~A" (map file-name (sounds))))
- (if (not (= (frames ind) (+ 22050 2205))) (snd-display #__line__ ";with-sound reverbed frames (3): ~A" (frames ind)))
- (close-sound ind)
- (delete-file "test1.snd"))
-
(with-sound (:srate 22050 :comment "Snd+Run!" :scaled-to .5) (fm-violin 0 .1 440 .1))
(let ((ind (find-sound "test.snd")))
(if (not ind) (snd-display #__line__ ";with-sound: ~A" (map file-name (sounds))))
@@ -53896,60 +41106,87 @@ EDITS: 1
(if (fneq mx .5) (snd-display #__line__ ";with-sound scaled-to: ~A" (maxamp)))
(if (not (string=? (comment ind) "Snd+Run!")) (snd-display #__line__ ";with-sound comment: ~A (~A)" (comment ind) (mus-sound-comment "test.snd"))))
(close-sound ind))
+
+ (with-sound (:scaled-to .9 :channels 2) (fm-violin 0 .1 440 1.5 :degree 90))
+ (let ((ind (find-sound "test.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound: ~A" (map file-name (sounds))))
+ (let ((mx0 (maxamp ind 0))
+ (mx1 (maxamp ind 1)))
+ (if (> (max mx0 mx1) .9)
+ (snd-display #__line__ ";with-sound scaled-to: ~A" (maxamp))))
+ (close-sound ind))
+
+ (with-sound (:scaled-to .9 :channels 2) (fm-violin 0 .1 440 1.5 :degree 0))
+ (let ((ind (find-sound "test.snd")))
+ (if (not ind) (snd-display #__line__ ";with-sound: ~A" (map file-name (sounds))))
+ (let ((mx0 (maxamp ind 0))
+ (mx1 (maxamp ind 1)))
+ (if (> (max mx0 mx1) .9)
+ (snd-display #__line__ ";with-sound scaled-to: ~A" (maxamp))))
+ (close-sound ind))
- (with-sound (:srate 22050 :scaled-by .5 :header-type mus-aifc :data-format mus-bfloat) (fm-violin 0 .1 440 .1))
+ (with-sound (:srate 22050 :scaled-by .5 :header-type mus-aifc :sample-type mus-bfloat) (fm-violin 0 .1 440 .1))
(let ((ind (find-sound "test.snd")))
(if (not ind) (snd-display #__line__ ";with-sound: ~A" (map file-name (sounds))))
(let ((mx (maxamp)))
(if (fneq mx .05) (snd-display #__line__ ";with-sound scaled-by: ~A" (maxamp)))
(if (not (= (header-type ind) mus-aifc)) (snd-display #__line__ ";with-sound type: ~A (~A)" (header-type ind) (mus-header-type-name (header-type ind))))
- (if (not (= (data-format ind) mus-bfloat)) (snd-display #__line__ ";with-sound format: ~A (~A)" (data-format ind) (mus-data-format-name (data-format ind)))))
+ (if (not (= (sample-type ind) mus-bfloat)) (snd-display #__line__ ";with-sound format: ~A (~A)" (sample-type ind) (mus-sample-type-name (sample-type ind)))))
(close-sound ind))
- (hook-push open-raw-sound-hook (lambda (file choice) (list 1 22050 mus-bshort)))
+ (hook-push open-raw-sound-hook (lambda (hook) (set! (hook 'result) (list 1 22050 mus-bshort))))
(with-sound (:header-type mus-raw) (fm-violin 0 1 440 .1))
- (set! (hook-functions open-raw-sound-hook) '())
+ (set! (hook-functions open-raw-sound-hook) ())
(let ((ind (find-sound "test.snd")))
(if (not ind) (snd-display #__line__ ";with-sound (raw out): ~A" (map file-name (sounds))))
(if (not (= (header-type ind) mus-raw))
(snd-display #__line__ ";with-sound type raw: ~A (~A)" (header-type ind) (mus-header-type-name (header-type ind))))
- (if (and (not (= (data-format ind) mus-bshort))
- (not (= (data-format ind) mus-bfloat))
- (not (= (data-format ind) mus-lfloat)))
- (snd-display #__line__ ";with-sound format raw: ~A (~A)" (data-format ind) (mus-data-format-name (data-format ind))))
+ (if (and (not (= (sample-type ind) mus-bshort))
+ (not (= (sample-type ind) mus-bfloat))
+ (not (= (sample-type ind) mus-lfloat)))
+ (snd-display #__line__ ";with-sound format raw: ~A (~A)" (sample-type ind) (mus-sample-type-name (sample-type ind))))
(close-sound ind))
(with-sound (:srate 44100 :statistics #t) (ws-sine 1000))
(let ((ind (find-sound "test.snd")))
(let ((i -1))
(scan-channel (lambda (y)
- (set! i (+ 1 i))
- (if (fneq y (sin (* 2 pi i (/ 1000.0 44100.0))))
- (begin
- (display (format #f "~%;with-sound sine: ~D ~A ~A" i y (sin (* 2 pi i (/ 1000.0 44100.0)))))
- #t)
- #f))))
+ (set! i (+ i 1))
+ (and (< i 100)
+ (fneq y (sin (* 2 pi i (/ 1000.0 44100.0))))
+ (begin
+ (format #t "~%;with-sound sine: ~D ~A ~A" i y (sin (* 2 pi i (/ 1000.0 44100.0))))
+ #t)))))
(close-sound ind))
- (set! *opt* #t)
(with-sound ()
- (run
(do ((i 0 (+ i 1)))
((= i 3))
(let ((gen (make-oscil 440.0))
- (e (make-env (vct 0.0 0.0 1.0 1.0 2.0 0.0) 0.1 1.0)))
- (do ((k 0 (+ k 1)))
- ((= k 44100))
- (outa (+ k (* i 50000)) (* (env e) (oscil gen))))))))
- (if (not *opt*)
- (snd-display #__line__ ";with-sound make-oscil in run loop optimization failed?"))
+ (e (make-env (float-vector 0.0 0.0 1.0 1.0 2.0 0.0) 0.1 1.0))
+ (beg (* i 50000))
+ (end (+ 44100 (* i 50000))))
+ (do ((k beg (+ k 1)))
+ ((= k end))
+ (outa k (* (env e) (oscil gen)))))))
+
(let ((ind (find-sound "test.snd")))
- (if (not (= (frames ind) 144100))
- (snd-display #__line__ ";with-sound make-oscil in run frames: ~A" (frames)))
+ (if (> (abs (- (framples ind) 144100)) 2)
+ (snd-display #__line__ ";with-sound make-oscil framples: ~A" (framples)))
(if (fneq (maxamp ind) .1)
- (snd-display #__line__ ";with-sound make-oscil in run maxamp: ~A" (maxamp ind)))
+ (snd-display #__line__ ";with-sound make-oscil maxamp: ~A" (maxamp ind)))
(close-sound ind))
+ (let ((old-srate *clm-srate*))
+ (with-sound ()
+ (if (not (= old-srate *clm-srate*))
+ (format #t ";srates: ~A ~A~%" old-srate, *clm-srate*))
+ (with-sound (:srate 12345)
+ (if (not (= *clm-srate* 12345))
+ (format #t ";clm-srate: ~A (12345)~%" *clm-srate*)))
+ (if (not (= old-srate *clm-srate*))
+ (format #t ";returned srates: ~A ~A~%" old-srate, *clm-srate*))))
+ (for-each close-sound (sounds))
(if (file-exists? "ii.scm")
(begin
@@ -53959,85 +41196,90 @@ EDITS: 1
(delete-file "test.rev")))
(let ((var (make-st1 :one 1 :two 2)))
- (if (not (= (st1-one var) 1)) (snd-display #__line__ ";st1-one: ~A" (st1-one var)))
- (if (not (= (st1-two var) 2)) (snd-display #__line__ ";st1-two: ~A" (st1-two var)))
+ (if (not (= (var 'one) 1)) (snd-display #__line__ ";st1-one: ~A" (var 'one)))
+ (if (not (= (var 'two) 2)) (snd-display #__line__ ";st1-two: ~A" (var 'two)))
(if (not (st1? var)) (snd-display #__line__ ";st1? ~A (~A)" (st1? var) var))
- (set! (st1-one var) 321)
- (set! (st1-two var) "hiho")
- (if (not (= (st1-one var) 321)) (snd-display #__line__ ";st1-one (321): ~A" (st1-one var)))
- (if (not (string=? (st1-two var) "hiho")) (snd-display #__line__ ";st1-two (hiho): ~A" (st1-two var)))
+ (set! (var 'one) 321)
+ (set! (var 'two) "hiho")
+ (if (not (= (var 'one) 321)) (snd-display #__line__ ";st1-one (321): ~A" (var 'one)))
+ (if (not (string=? (var 'two) "hiho")) (snd-display #__line__ ";st1-two (hiho): ~A" (var 'two)))
(set! var (make-st1))
- (if (fneq (st1-one var) 0.0) (snd-display #__line__ ";st1-one #f: ~A" (st1-one var)))
- (if (fneq (st1-two var) 0.0) (snd-display #__line__ ";st1-two #f: ~A" (st1-two var)))
+ (if (fneq (var 'one) 0.0) (snd-display #__line__ ";st1-one #f: ~A" (var 'one)))
+ (if (fneq (var 'two) 0.0) (snd-display #__line__ ";st1-two #f: ~A" (var 'two)))
(set! var (make-st1 :two 3))
- (if (fneq (st1-one var) 0.0) (snd-display #__line__ ";st1-one #f (def): ~A" (st1-one var)))
- (if (not (= (st1-two var) 3)) (snd-display #__line__ ";st1-two (3): ~A" (st1-two var))))
+ (if (fneq (var 'one) 0.0) (snd-display #__line__ ";st1-one #f (def): ~A" (var 'one)))
+ (if (not (= (var 'two) 3)) (snd-display #__line__ ";st1-two (3): ~A" (var 'two))))
(let ((var (make-st2 :one 1 :two 2)))
- (if (not (= (st2-one var) 1)) (snd-display #__line__ ";st2-one: ~A" (st2-one var)))
- (if (not (= (st2-two var) 2)) (snd-display #__line__ ";st2-two: ~A" (st2-two var)))
+ (if (not (= (var 'one) 1)) (snd-display #__line__ ";st2-one: ~A" (var 'one)))
+ (if (not (= (var 'two) 2)) (snd-display #__line__ ";st2-two: ~A" (var 'two)))
(if (not (st2? var)) (snd-display #__line__ ";st2? ~A (~A)" (st1? var) var))
(if (st1? var) (snd-display #__line__ ";st1? (not ~A): ~A" (st1? var) var))
- (set! (st2-one var) 321)
- (set! (st2-two var) "hiho")
- (if (not (= (st2-one var) 321)) (snd-display #__line__ ";st2-one (321): ~A" (st2-one var)))
- (if (not (string=? (st2-two var) "hiho")) (snd-display #__line__ ";st2-two (hiho): ~A" (st2-two var)))
+ (set! (var 'one) 321)
+ (set! (var 'two) "hiho")
+ (if (not (= (var 'one) 321)) (snd-display #__line__ ";st2-one (321): ~A" (var 'one)))
+ (if (not (string=? (var 'two) "hiho")) (snd-display #__line__ ";st2-two (hiho): ~A" (var 'two)))
(set! var (make-st2))
- (if (not (= (st2-one var) 11)) (snd-display #__line__ ";st2-one 11: ~A" (st2-one var)))
- (if (not (= (st2-two var) 22)) (snd-display #__line__ ";st2-two 22: ~A" (st2-two var)))
+ (if (not (= (var 'one) 11)) (snd-display #__line__ ";st2-one 11: ~A" (var 'one)))
+ (if (not (= (var 'two) 22)) (snd-display #__line__ ";st2-two 22: ~A" (var 'two)))
(set! var (make-st2 :two 3))
- (if (not (= (st2-one var) 11)) (snd-display #__line__ ";st2-one 11 (def): ~A" (st2-one var)))
- (if (not (= (st2-two var) 3)) (snd-display #__line__ ";st2-two (3): ~A" (st2-two var))))
+ (if (not (= (var 'one) 11)) (snd-display #__line__ ";st2-one 11 (def): ~A" (var 'one)))
+ (if (not (= (var 'two) 3)) (snd-display #__line__ ";st2-two (3): ~A" (var 'two))))
(let ((gad (make-grab-bag)))
- (if (not (= (grab-bag-i gad) 0))
- (snd-display #__line__ ";grab-bag-i: ~A" (grab-bag-i gad)))
- (set! (grab-bag-flt gad) 123.0)
- (set! (grab-bag-v gad) (vct .1 .2 .3))
- (set! (grab-bag-fvect gad) (vector .1 .2 .3))
- (set! (grab-bag-ivect gad) (make-vector 3 1))
- (set! (grab-bag-cvect gad) (make-vector 3 #f))
- (do ((i 0 (+ 1 i)))
+ (if (not (= (gad 'i) 0))
+ (snd-display #__line__ ";grab-bag-i: ~A" (gad 'i)))
+ (set! (gad 'flt) 123.0)
+ (set! (gad 'v) (float-vector .1 .2 .3))
+ (set! (gad 'fvect) (vector .1 .2 .3))
+ (set! (gad 'ivect) (make-vector 3 1))
+ (set! (gad 'cvect) (make-vector 3 #f))
+ (do ((i 0 (+ i 1)))
((= i 3))
- (vector-set! (grab-bag-cvect gad) i (make-oscil 440.0)))
- (set! (grab-bag-gen gad) (make-oscil 440.0))
+ (vector-set! (gad 'cvect) i (make-oscil 440.0)))
+ (set! (gad 'gen) (make-oscil 440.0))
(let ((val 0.0))
- (run
- (lambda ()
- (set! val (grab-bag-flt gad))))
- (if (fneq val 123.0) (snd-display #__line__ ";defgenerator flt: ~A ~A" val (grab-bag-flt gad))))
- (if (fneq (grab-bag-flt1 gad) 1.0) (snd-display #__line__ ";defgenerator flt1: ~A" (grab-bag-flt1 gad)))
- (if (not (= (grab-bag-i gad) 0)) (snd-display #__line__ ";defgenerator i: ~A" (grab-bag-i gad)))
- (if (not (= (grab-bag-i1 gad) 123)) (snd-display #__line__ ";defgenerator i1: ~A" (grab-bag-i1 gad))))
-
+ (set! val (gad 'flt))
+ (if (fneq val 123.0) (snd-display #__line__ ";defgenerator flt: ~A ~A" val (gad 'flt))))
+ (if (fneq (gad 'flt1) 1.0) (snd-display #__line__ ";defgenerator flt1: ~A" (gad 'flt1)))
+ (if (not (= (gad 'i) 0)) (snd-display #__line__ ";defgenerator i: ~A" (gad 'i)))
+ (if (not (= (gad 'i1) 123)) (snd-display #__line__ ";defgenerator i1: ~A" (gad 'i1))))
+
+ (let ()
+ (defgenerator (g1 :methods (list (cons 'g1-method (lambda (g) 440)))))
+ (let ((g (make-g1)))
+ (if (not (g1? g))
+ (format #t ";not g1: ~A~%" (reverse (map values g))))
+ (if (not (= ((g 'g1-method) g) 440))
+ (format #t ";g1-method: ~A~%" ((g 'g1-method) g)))))
+
(if (file-exists? "test.snd") (delete-file "test.snd"))
- (set! (mus-srate) 22050)
(set! *clm-srate* 22050)
- (set! (default-output-srate) 22050)
+ (set! *default-output-srate* 22050)
(let ((outer (with-sound ()
(sound-let ((a () (fm-violin 0 .1 440 .1)))
- (mus-mix *output* a)))))
+ (mus-file-mix *output* a)))))
(if (not (string=? outer "test.snd"))
(snd-display #__line__ ";with-sound returns: ~A" outer))
(let ((ind (find-sound outer)))
(if (or (not (sound? ind))
- (not (= (frames ind) (floor (* (mus-srate) .1)))))
- (snd-display #__line__ ";sound-let: ~A ~A" (frames ind) (floor (* (mus-srate) .1))))
+ (> (- (framples ind) (floor (* *clm-srate* .1))) 1))
+ (snd-display #__line__ ";sound-let: ~A ~A" (framples ind) (floor (* *clm-srate* .1))))
(close-sound ind)))
(if (file-exists? "test.snd") (delete-file "test.snd"))
(let ((outer (with-sound ()
(sound-let ((a () (fm-violin 0 .1 440 .1))
(b 100))
- (mus-mix *output* a b)
+ (mus-file-mix *output* a b)
(sound-let ((c (:channels 1 :output "temp.snd") (fm-violin 0 .1 110.0 .1)))
- (mus-mix *output* c))))))
+ (mus-file-mix *output* c))))))
(if (not (string=? outer "test.snd"))
(snd-display #__line__ ";with-sound (2) returns: ~A" outer))
(let ((ind (find-sound outer)))
(if (or (not (sound? ind))
- (not (= (frames ind) (+ 100 (floor (* (mus-srate) .1))))))
- (snd-display #__line__ ";sound-let (2): ~A ~A" (frames ind) (+ 100 (floor (* (mus-srate) .1)))))
+ (> (- (framples ind) (+ 100 (floor (* *clm-srate* .1)))) 1))
+ (snd-display #__line__ ";sound-let (2): ~A ~A" (framples ind) (+ 100 (floor (* *clm-srate* .1)))))
(if (file-exists? "temp.snd")
(snd-display #__line__ ";sound-let explicit output exists?"))
(close-sound ind)))
@@ -54070,22 +41312,22 @@ EDITS: 1
(snd-display #__line__ ";init-with-sound type: ~A ~A" (header-type ind) w))
(close-sound ind))))))
- (with-sound (:output "test1.snd" :reverb freeverb :reverb-data '(:output-gain 3.0)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
+ (with-sound ("test1.snd" :reverb freeverb :reverb-data '(:output-gain 3.0)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
(let ((ind (find-sound "test1.snd")))
(if (not ind) (snd-display #__line__ ";with-sound (freeverb): ~A" (map file-name (sounds))))
- (if (not (> (maxamp ind) .1)) (snd-display #__line__ ";freeverb 3.0: ~A" (maxamp ind)))
+ (if (<= (maxamp ind) .1) (snd-display #__line__ ";freeverb 3.0: ~A" (maxamp ind)))
(close-sound ind)
(delete-file "test1.snd"))
- (with-sound (:output "test1.snd" :reverb freeverb :reverb-data '(:output-gain 3.0 :global 0.5)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
+ (with-sound ("test1.snd" :reverb freeverb :reverb-data '(:output-gain 3.0 :global 0.5)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
(let ((ind (find-sound "test1.snd")))
(if (not ind) (snd-display #__line__ ";with-sound (freeverb): ~A" (map file-name (sounds))))
- (if (not (> (maxamp ind) .16)) (snd-display #__line__ ";freeverb 3.0 global 0.5: ~A" (maxamp ind)))
+ (if (<= (maxamp ind) .16) (snd-display #__line__ ";freeverb 3.0 global 0.5: ~A" (maxamp ind)))
(close-sound ind)
(delete-file "test1.snd"))
-
- (set! (mus-srate) 22050)
- (set! (default-output-srate) 22050)
+
+ (set! *clm-srate* 22050)
+ (set! *default-output-srate* 22050)
(let ((fmt1 '(0 1200 100 1000))
(fmt2 '(0 2250 100 1800))
@@ -54103,26 +41345,15 @@ EDITS: 1
(ampf '(0 0 25 1 75 1 100 0))
(ranf '(0 .5 100 .5))
(index '(0 1 100 1))
- (zero_fun '(0 0 100 0))
- (atskew '(0 -1 15 .3 22 -.1 25 0 75 0 100 -.2))
- (vibfun '(0 0 .3 .3 15 .6 25 1 100 1))
- (slopefun '(0 1 75 1 100 0))
- (trap '(0 0 25 1 75 1 100 0))
- (ramp '(0 0 25 0 75 1 100 1))
(solid '(0 0 5 1 95 1 100 0))
- (sfz '(0 0 25 1 30 .6 50 .5 75 .2 100 0))
- (mound '(0 0 10 .4 25 .8 40 1 60 1 75 .8 90 .4 100 0))
- (vio '(0 0 7 .2 25 .5 40 .6 60 .6 75 .5 90 .2 100 0))
(bassdr2 '(.5 .06 1 .62 1.5 .07 2.0 .6 2.5 .08 3.0 .56 4.0 .24
5 .98 6 .53 7 .16 8 .33 9 .62 10 .12 12 .14 14 .86
16 .12 23 .14 24 .17))
- (bassdrstr '(.5 .06 1.0 .63 1.5 .07 2.01 .6 2.5 .08 3.02 .56
- 4.04 .24 5.05 .98 6.06 .53 7.07 .16 8.08 .33 9.09 .62
- 10.1 .12 12.12 .14 13.13 .37 14.14 .86 16.16 .12 23.23 .14 24.24 .17))
- (tenordr '(.3 .04 1 .81 2 .27 3 .2 4 .21 5 .18 6 .35 7 .03 8 .07 9 .02 10 .025 11 .035))
- (tenordrstr '(.3 .04 1.03 .81 2.03 .27 3.03 .20 4.03 .21 5.03 .18
- 6.03 .35 7.03 .03 8.03 .07 9.03 .02 10.03 .03 11.03 .04)))
- (with-sound (:reverb nrev)
+ (tenordr '(.3 .04 1 .81 2 .27 3 .2 4 .21 5 .18 6 .35 7 .03 8 .07 9 .02 10 .025 11 .035)))
+ ;; a partial of .3 makes a click (or a buzz in this case) -- can this be right?
+ ;; we currently get away with it because it is normalized out of existence
+ ;; the .5 business in the bassdr2 works because it is like adding abs(sin)
+ (with-sound (:reverb nrev :play #f)
(drone .000 4.000 115.000 (* .25 .500) solid bassdr2 .100 .500
.030 45.000 1 .010 10)
(drone .000 4.000 229.000 (* .25 .500) solid tenordr .100 .500
@@ -54178,10 +41409,6 @@ EDITS: 1
.050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2
ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 )))
- (let ((ind (find-sound "test.snd")))
- (play ind :wait #t)
- (close-sound ind))
-
(with-sound (:srate 22050 :play #f)
(fm-violin 0 .01 440 .1 :noise-amount 0.0)
(pluck 0.05 .01 330 .1 .95 .95)
@@ -54252,11 +41479,11 @@ EDITS: 1
'(0 0 25 1 75 1 100 0) .75 1.0 0 0 0 0 1 0 0 220
'(0 0 25 1 75 1 100 0) 0 0 0 0
'(0 0 100 0) 0 0 0 0 '(0 0 100 0))
- (clm-expsrc 14.75 4 "oboe.snd" 2.0 1.0 1.0)
+ (clm-expsrc 14.75 2.5 "oboe.snd" 2.0 1.0 1.0)
(scratch 15.0 "now.snd" 1.5 '(0.0 .5 .25 1.0))
(two-tab 15 1 440 .1)
- (exp-snd "fyow.snd" 15 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05)
- (exp-snd "oboe.snd" 16 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.2)
+ (exp-snd "fyow.snd" 15 1.5 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05)
+ (exp-snd "oboe.snd" 16 1 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.2)
(gran-synth 15.5 1 300 .0189 .03 .4)
(spectra 16 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1) '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0))
(lbj-piano 16.5 1 440.0 .2)
@@ -54274,14 +41501,15 @@ EDITS: 1
(sndwarp 28 1.0 "pistol.snd")
(expandn 29 .5 "oboe.snd" .2)
+ (expandn 30 2 "2.snd" 1.0 '(0.0 1.0 1.0 4.0 2.0 1.0))
(let ((ampf '(0 0 1 1 2 1 3 0)))
- (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 1 .01 0 ampf .01))
+ (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 1 .01 ampf .01))
(graphEq "oboe.snd")
)
- (let ((ind (find-sound "test.snd")))
- (play ind :wait #t)
- (close-sound ind))
+ (with-sound (:channels 4) (expandn 0 .1 "4.aiff" 1 :expand 4))
+ (with-sound (:channels 4 :reverb jc-reverb) (expandn 0 .1 "4.aiff" 1 :expand 4))
+ (with-sound (:channels 2 :reverb freeverb :reverb-channels 2) (expandn 0 .1 "4.aiff" 1 :expand 4))
(with-sound (:play #f) (defopt-simp 0 10000) (defopt-simp 10000 10000 550.0 0.1) (defopt-simp 20000 10000 :amplitude .2))
(with-sound (:channels 2 :reverb-channels 2 :reverb jcrev2 :play #f) (floc-simp 0 1))
@@ -54295,7 +41523,7 @@ EDITS: 1
(with-sound (:channels 2)
(fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (1.0 0.0) (0.0 1.0))))
(let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.664947509765625) (snd-display #__line__ ";4->2(0) fullmix: ~A" (maxamp)))
+ (if (fneq (maxamp) 0.8865) (snd-display #__line__ ";4->2(0) fullmix: ~A" (maxamp)))
(close-sound ind))
(with-sound (:channels 1)
@@ -54359,7 +41587,7 @@ EDITS: 1
(with-sound (:channels 2)
(fullmix "4.aiff" 0.0 0.1 36.4 '((0.0 0.0) (0.0 0.0) (1.0 0.0) (0.0 1.0))))
(let ((ind (find-sound "test.snd")))
- (if (fneq (maxamp) 0.664947509765625) (snd-display #__line__ ";4->2(0) fullmix.scm: ~A" (maxamp)))
+ (if (fneq (maxamp) 0.8865) (snd-display #__line__ ";4->2(0) fullmix.scm: ~A" (maxamp)))
(close-sound ind))
(with-sound (:channels 1)
@@ -54378,55 +41606,43 @@ EDITS: 1
(sound-let ((temp-1 () (fm-violin 0 1 440 .1))
(temp-2 () (fm-violin 0 2 660 .1 :base 32.0)
(fm-violin .125 .5 880 .1)))
- (mus-mix *output* temp-1 0)
- (mus-mix *output* temp-2 22050)))
+ (mus-file-mix *output* temp-1 0)
+ (mus-file-mix *output* temp-2 22050)))
(let ((ind (find-sound "test.snd")))
(if (not (sound? ind)) (snd-display #__line__ ";with-sound+sound-lets init: no test.snd?"))
(if (or (> (maxamp ind) .2) (< (maxamp ind) .15)) (snd-display #__line__ ";with-mix+sound-lets maxamp: ~A" (maxamp ind)))
- (if (fneq 3.0 (/ (frames ind) (srate ind))) (snd-display #__line__ ";with-sound+sound-lets dur: ~A" (/ (frames ind) (srate ind))))
+ (if (fneq 3.0 (/ (framples ind) (srate ind))) (snd-display #__line__ ";with-sound+sound-lets dur: ~A" (/ (framples ind) (srate ind))))
(close-sound ind))
(with-sound (:srate 44100 :play #f) (bigbird 0 2 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
(let ((ind (or (find-sound "test.snd") (open-sound "oboe.snd"))))
(let ((mx (maxamp)))
- (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)))
+ (notch-sound (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)))
(if (or (fneq mx .5)
(ffneq (maxamp) .027))
(snd-display #__line__ ";notch 60 Hz: ~A to ~A" mx (maxamp)))
(undo)
- (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
- (if (ffneq (maxamp) .004)
+ (notch-sound (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
+ (if (ffneq (maxamp) .011)
(snd-display #__line__ ";notch-sound 60 hz 2: ~A" (maxamp)))
(undo)
- (notch-channel (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f #f #f ind 0 #f #f 10)
+ (notch-channel (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f #f #f ind 0 #f #f 10)
(if (ffneq (maxamp) .004)
(snd-display #__line__ ";notch-channel 60 hz 2: ~A" (maxamp)))
(undo)
; (select-all)
(make-selection 10000 11000)
- (notch-selection (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f)
+ (notch-selection (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f 10)
; (if (ffneq (maxamp) .066)
; (snd-display #__line__ ";notch-selection 60 hz 2: ~A" (maxamp)))
-#|
- ;; this can cause mus-audio-write to hang
- (play-sound
- (lambda (data)
- (let ((len (sound-data-length data)))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (sound-data-set! data 0 i (* 2.0 (sound-data-ref data 0 i)))))))))
-|#
(close-sound ind)))
- (with-sound (:srate 44100 :play #f) (bigbird 0 60 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
+ (with-sound (:srate 44100 :play #f) (bigbird 0 30 60 0 .5 '(0 0 1 1) '(0 0 1 1 2 1 3 0) '(1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9 1 10 1)))
(let ((ind (find-sound "test.snd")))
- (let ((mx (maxamp)))
- (notch-sound (let ((freqs '())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
- (if (ffneq (maxamp) .036)
- (snd-display #__line__ ";notch-sound 60 hz 2 60: ~A" (maxamp))))
+ (notch-sound (let ((freqs ())) (do ((i 60 (+ i 60))) ((= i 3000)) (set! freqs (cons i freqs))) (reverse freqs)) #f ind 0 10)
+ (if (ffneq (maxamp) .011)
+ (snd-display #__line__ ";notch-sound 60 hz 2 60: ~A" (maxamp)))
(close-sound ind))
(play-sine 440 .1)
@@ -54435,79 +41651,77 @@ EDITS: 1
(with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1 :statistics #t)
(grani 0 1 .5 "oboe.snd" :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0))
(grani 0 4 1 "oboe.snd")
- (if (> (optimization) 4)
- (begin
- (grani 0 4 1 "oboe.snd" :grains 10)
- (grani 0 4 1 "oboe.snd"
- :grain-start 0.11
- :amp-envelope '(0 1 1 1) :grain-density 8
- :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)
- :grain-envelope-end '(0 0 0.01 1 0.99 1 1 0)
- :grain-envelope-transition '(0 0 0.4 1 0.8 0 1 0))
- (grani 0 3 1 "oboe.snd"
- :grain-start 0.1
- :amp-envelope '(0 1 1 1) :grain-density 20
- :grain-duration '(0 0.003 0.2 0.01 1 0.3))
- (grani 0 3 1 "oboe.snd"
- :grain-start 0.1
- :amp-envelope '(0 1 1 1) :grain-density 20
- :grain-duration '(0 0.003 0.2 0.01 1 0.3)
- :grain-duration-limit 0.02)
- (grani 0 2 1 "oboe.snd"
- :amp-envelope '(0 1 1 1) :grain-density 40
- :grain-start '(0 0.1 0.3 0.1 1 0.6))
- (grani 0 2 1 "oboe.snd"
- :amp-envelope '(0 1 1 1) :grain-density 40
- :grain-start '(0 0.1 0.3 0.1 1 0.6)
- :grain-start-spread 0.01)
- (grani 0 2.6 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :srate '(0 0 0.2 0 0.6 5 1 5))
- (grani 0 2.6 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :srate-base 2
- :srate '(0 0 0.2 0 0.6 -1 1 -1))
- (grani 0 2.6 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :srate-linear #t
- :srate (list 0 1 0.2 1 0.6 (expt 2 (/ 5 12)) 1 (expt 2 (/ 5 12))))
- (grani 0 2 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :grain-duration '(0 0.02 1 0.1)
- :grain-duration-spread '(0 0 0.5 0.1 1 0)
- :where-to grani-to-grain-duration
- :where-bins (vct 0 0.05 1))
- (grani 0 2 1 "oboe.snd"
- :grain-start 0.1 :grain-start-spread 0.01
- :amp-envelope '(0 1 1 1) :grain-density 40
- :grain-degree '(0 0 1 90)
- :grain-degree-spread 10)
- )))
+
+ (grani 0 4 1 "oboe.snd" :grains 10)
+ (grani 0 4 1 "oboe.snd"
+ :grain-start 0.11
+ :amp-envelope '(0 1 1 1) :grain-density 8
+ :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)
+ :grain-envelope-end '(0 0 0.01 1 0.99 1 1 0)
+ :grain-envelope-transition '(0 0 0.4 1 0.8 0 1 0))
+ (grani 0 3 1 "oboe.snd"
+ :grain-start 0.1
+ :amp-envelope '(0 1 1 1) :grain-density 20
+ :grain-duration '(0 0.003 0.2 0.01 1 0.3))
+ (grani 0 3 1 "oboe.snd"
+ :grain-start 0.1
+ :amp-envelope '(0 1 1 1) :grain-density 20
+ :grain-duration '(0 0.003 0.2 0.01 1 0.3)
+ :grain-duration-limit 0.02)
+ (grani 0 2 1 "oboe.snd"
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-start '(0 0.1 0.3 0.1 1 0.6))
+ (grani 0 2 1 "oboe.snd"
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-start '(0 0.1 0.3 0.1 1 0.6)
+ :grain-start-spread 0.01)
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate '(0 0 0.2 0 0.6 5 1 5))
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate-base 2
+ :srate '(0 0 0.2 0 0.6 -1 1 -1))
+ (grani 0 2.6 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :srate-linear #t
+ :srate (list 0 1 0.2 1 0.6 (expt 2 5/12) 1 (expt 2 5/12)))
+ (grani 0 2 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-duration '(0 0.02 1 0.1)
+ :grain-duration-spread '(0 0 0.5 0.1 1 0)
+ :where-to grani-to-grain-duration ; from grani.scm
+ :where-bins (float-vector 0 0.05 1))
+ (grani 0 2 1 "oboe.snd"
+ :grain-start 0.1 :grain-start-spread 0.01
+ :amp-envelope '(0 1 1 1) :grain-density 40
+ :grain-degree '(0 0 1 90)
+ :grain-degree-spread 10))
(let ((ind (open-sound "oboe.snd")))
- (with-sound (:output "test1.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (with-sound ("test1.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
(set-samples 0 2205 "test1.snd" ind 0 #f "set-samples auto-delete test" 0 #f #t)
(if (not (file-exists? "test1.snd")) (snd-display #__line__ ";oops: auto-delete test1.snd?"))
(undo 1 ind)
- (with-sound (:output "test2.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (with-sound ("test2.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
(insert-sound "test2.snd" 0 0 ind 0 #f #t)
(if (file-exists? "test1.snd") (snd-display #__line__ ";auto-delete set-samples?"))
(undo 1 ind)
- (with-sound (:output "test3.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (with-sound ("test3.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
(insert-samples 0 2205 "test3.snd" ind 0 #f #t)
(if (file-exists? "test2.snd") (snd-display #__line__ ";auto-delete insert-sound?"))
(undo 1 ind)
- (with-sound (:output "test4.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (with-sound ("test4.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
(mix "test4.snd" 0 0 ind 0 #f #t)
(if (file-exists? "test3.snd") (snd-display #__line__ ";auto-delete insert-samples?"))
(undo 1 ind)
(delete-sample 100)
(if (file-exists? "test4.snd") (snd-display #__line__ ";auto-delete mix?"))
- (with-sound (:output "test5.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
+ (with-sound ("test5.snd" :to-snd #f) (fm-violin 0 .1 440 .1))
(mix "test5.snd" 0 0 ind 0 #t #t)
(revert-sound ind)
(close-sound ind)
@@ -54515,11 +41729,11 @@ EDITS: 1
)
(let ((o2 (optkey-1 1)))
- (if (not (equal? o2 1)) (snd-display #__line__ ";optkey-1: ~A" o2)))
+ (if (not (eqv? o2 1)) (snd-display #__line__ ";optkey-1: ~A" o2)))
(let ((o2 (optkey-1 :a 1)))
- (if (not (equal? o2 1)) (snd-display #__line__ ";optkey-1 1: ~A" o2)))
+ (if (not (eqv? o2 1)) (snd-display #__line__ ";optkey-1 1: ~A" o2)))
(let ((o2 (optkey-1)))
- (if (not (equal? o2 #f)) (snd-display #__line__ ";optkey-1 2: ~A" o2)))
+ (if o2 (snd-display #__line__ ";optkey-1 2: ~A" o2)))
(let ((o2 (optkey-2 1 2)))
(if (not (equal? o2 (list 1 2))) (snd-display #__line__ ";optkey-2: ~A" o2)))
(let ((o2 (optkey-2 :a 1 :b 2)))
@@ -54544,85 +41758,86 @@ EDITS: 1
(if (not (equal? o2 (list 1 3 4 5))) (snd-display #__line__ ";optkey-4 3: ~A 2" o2)))
(if (and (or (provided? 'snd-motif)
- (provided? 'snd-gtk))
+ (and (provided? 'snd-gtk) (defined? 'gtk_box_new)))
(defined? 'variable-display))
(let ((wid1 (make-variable-display "do-loop" "i*1" 'text))
(wid2 (make-variable-display "do-loop" "i*2" 'scale '(-1.0 1.0)))
(wid3 (make-variable-display "do-loop" "i3" 'spectrum))
(wid4 (make-variable-display "do-loop" "i4" 'graph)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(variable-display (variable-display (* (variable-display (sin (* (variable-display i wid1) .1)) wid3) .5) wid2) wid4))
(let ((tag (catch #t (lambda () (set! (sample 0 (car wid3) 0) .5)) (lambda args (car args)))))
(if (> (edit-position (car wid3) 0) 0) (snd-display #__line__ ";edited variable graph? ~A ~A" tag (edit-position (car wid3) 0))))
(if (provided? 'snd-motif)
- (XtUnmanageChild variables-dialog)
- (gtk_widget_hide variables-dialog))
+ ((*motif* 'XtUnmanageChild) variables-dialog)
+ ((*gtk* 'gtk_widget_hide) variables-dialog))
(close-sound (car wid3))
(close-sound (car wid4))
))
- (if (not (= *clm-srate* (default-output-srate))) (snd-display #__line__ ";*clm-srate*: ~A ~A" *clm-srate* (default-output-srate)))
- (if (not (= *clm-channels* (default-output-chans))) (snd-display #__line__ ";*clm-channels*: ~A ~A" *clm-channels* (default-output-chans)))
- (if (not (= *clm-header-type* (default-output-header-type))) (snd-display #__line__ ";*clm-header-type*: ~A ~A" *clm-header-type* (default-output-header-type)))
- ; (if (not (= *clm-data-format* (default-output-data-format))) (snd-display #__line__ ";*clm-data-format*: ~A ~A" *clm-data-format* (default-output-data-format)))
- (if (not (= *clm-reverb-channels* 1)) (snd-display #__line__ ";*clm-reverb-channels*: ~A ~A" *clm-reverb-channels*))
+ (if (not (= *clm-srate* *default-output-srate*)) (snd-display #__line__ ";*clm-srate*: ~A ~A" *clm-srate* *default-output-srate*))
+ (if (not (= *clm-channels* *default-output-chans*)) (snd-display #__line__ ";*clm-channels*: ~A ~A" *clm-channels* *default-output-chans*))
+ (if (not (= *clm-header-type* *default-output-header-type*)) (snd-display #__line__ ";*clm-header-type*: ~A ~A" *clm-header-type* *default-output-header-type*))
+ ; (if (not (= *clm-sample-type* *default-output-sample-type*)) (snd-display #__line__ ";*clm-sample-type*: ~A ~A" *clm-sample-type* *default-output-sample-type*))
+ (if (not (= *clm-reverb-channels* 1)) (snd-display #__line__ ";*clm-reverb-channels*: ~A" *clm-reverb-channels*))
(if (not (string=? *clm-file-name* "test.snd")) (snd-display #__line__ ";*clm-file-name*: ~A" *clm-file-name*))
(if *clm-play* (snd-display #__line__ ";*clm-play*: ~A" *clm-play*))
(if *clm-verbose* (snd-display #__line__ ";*clm-verbose*: ~A" *clm-verbose*))
(if *clm-statistics* (snd-display #__line__ ";*clm-statistics*: ~A" *clm-statistics*))
(if *clm-reverb* (snd-display #__line__ ";*clm-reverb*: ~A" *clm-reverb*))
- (if (not (null? *clm-reverb-data*)) (snd-display #__line__ ";*clm-reverb-data*: ~A?" *clm-reverb-data*))
+ (if (pair? *clm-reverb-data*) (snd-display #__line__ ";*clm-reverb-data*: ~A?" *clm-reverb-data*))
(if *clm-delete-reverb* (snd-display #__line__ ";*clm-delete-reverb*: ~A" *clm-delete-reverb*))
- (set! *clm-channels* 2)
- (set! *clm-srate* 44100)
- (set! *clm-file-name* "test.wav")
- (set! *clm-verbose* #t)
- (set! *clm-statistics* #t)
- (set! *clm-play* #t)
- (set! *clm-data-format* mus-mulaw)
- (set! *clm-header-type* mus-riff)
- (set! *clm-delete-reverb* #t)
- (set! *clm-reverb* jc-reverb)
- (set! *clm-reverb-data* (list #t 2.0 (list 0 1 3.0 1 4.0 0)))
-
- (with-sound () (fm-violin 0 1 440 .1 :reverb-amount .1))
-
- (let ((ind (find-sound "test.wav")))
- (if (not (sound? ind))
- (snd-display #__line__ ";default output in ws: ~A" (map file-name (sounds)))
- (begin
- (if (not (= (srate ind) 44100)) (snd-display #__line__ ";default srate in ws: ~A ~A" (srate ind) *clm-srate*))
- (if (not (= (channels ind) 2)) (snd-display #__line__ ";default chans in ws: ~A ~A" (channels ind) *clm-channels*))
- (if (not (= (data-format ind) mus-mulaw)) (snd-display #__line__ ";default format in ws: ~A ~A" (data-format ind) *clm-data-format*))
- (if (not (= (header-type ind) mus-riff)) (snd-display #__line__ ";default type in ws: ~A ~A" (header-type ind) *clm-header-type*))
- (if (not (= (frames ind) 88200)) (snd-display #__line__ ";reverb+1 sec out in ws: ~A" (frames ind)))
- (if (file-exists? "test.rev") (snd-display #__line__ ";perhaps reverb not deleted in ws?"))
- (close-sound ind))))
-
- (let ((val 0)
- (old-hook *clm-notehook*))
- (set! *clm-notehook* (lambda args (set! val 1)))
- (with-sound () (fm-violin 0 .1 440 .1))
- (if (not (= val 1)) (snd-display #__line__ ";*clm-notehook*: ~A ~A" val *clm-notehook*))
- (with-sound (:notehook (lambda args (set! val 2))) (fm-violin 0 .1 440 .1))
- (if (not (= val 2)) (snd-display #__line__ ";:notehook: ~A" val))
- (with-sound () (fm-violin 0 .1 440 .1))
- (if (not (= val 1)) (snd-display #__line__ ";*clm-notehook* (1): ~A ~A" val *clm-notehook*))
- (set! *clm-notehook* old-hook))
-
- (set! *clm-channels* 1)
- (set! *clm-srate* 22050)
- (set! *clm-file-name* "test.snd")
- (set! *clm-verbose* #f)
- (set! *clm-statistics* #f)
- (set! *clm-play* #f)
- (set! *clm-data-format* mus-bshort)
- (set! *clm-header-type* mus-next)
- (set! *clm-delete-reverb* #f)
- (set! *clm-reverb* #f)
- (set! *clm-reverb-data* '())
+ (let ((old-stats *clm-statistics*))
+ (set! *clm-channels* 2)
+ (set! *clm-srate* 44100)
+ (set! *clm-file-name* "test.wav")
+ (set! *clm-verbose* #t)
+ (set! *clm-statistics* #t)
+ (set! *clm-play* #t)
+ (set! *clm-sample-type* mus-mulaw)
+ (set! *clm-header-type* mus-riff)
+ (set! *clm-delete-reverb* #t)
+ (set! *clm-reverb* jc-reverb)
+ (set! *clm-reverb-data* (list #t 2.0 (list 0 1 3.0 1 4.0 0)))
+
+ (with-sound () (fm-violin 0 1 440 .1 :reverb-amount .1))
+
+ (let ((ind (find-sound "test.wav")))
+ (if (not (sound? ind))
+ (snd-display #__line__ ";default output in ws: ~A" (map file-name (sounds)))
+ (begin
+ (if (not (= (srate ind) 44100)) (snd-display #__line__ ";default srate in ws: ~A ~A" (srate ind) *clm-srate*))
+ (if (not (= (channels ind) 2)) (snd-display #__line__ ";default chans in ws: ~A ~A" (channels ind) *clm-channels*))
+ (if (not (= (sample-type ind) mus-mulaw)) (snd-display #__line__ ";default format in ws: ~A ~A" (sample-type ind) *clm-sample-type*))
+ (if (not (= (header-type ind) mus-riff)) (snd-display #__line__ ";default type in ws: ~A ~A" (header-type ind) *clm-header-type*))
+ (if (> (abs (- (framples ind) 88200)) 1) (snd-display #__line__ ";reverb+1 sec out in ws: ~A" (framples ind)))
+ (if (file-exists? "test.rev") (snd-display #__line__ ";perhaps reverb not deleted in ws?"))
+ (close-sound ind))))
+
+ (let ((val 0)
+ (old-hook *clm-notehook*))
+ (set! *clm-notehook* (lambda args (set! val 1)))
+ (with-sound () (fm-violin 0 .1 440 .1))
+ (if (not (= val 1)) (snd-display #__line__ ";*clm-notehook*: ~A ~A" val *clm-notehook*))
+ (with-sound (:notehook (lambda args (set! val 2))) (fm-violin 0 .1 440 .1))
+ (if (not (= val 2)) (snd-display #__line__ ";:notehook: ~A" val))
+ (with-sound () (fm-violin 0 .1 440 .1))
+ (if (not (= val 1)) (snd-display #__line__ ";*clm-notehook* (1): ~A ~A" val *clm-notehook*))
+ (set! *clm-notehook* old-hook))
+
+ (set! *clm-channels* 1)
+ (set! *clm-srate* 22050)
+ (set! *clm-file-name* "test.snd")
+ (set! *clm-verbose* #f)
+ (set! *clm-statistics* old-stats)
+ (set! *clm-play* #f)
+ (set! *clm-sample-type* mus-ldouble)
+ (set! *clm-header-type* mus-next)
+ (set! *clm-delete-reverb* #f)
+ (set! *clm-reverb* #f)
+ (set! *clm-reverb-data* ()))
(with-sound (:reverb jl-reverb)
(attract 0 1 0.1 2.0)
@@ -54633,10 +41848,10 @@ EDITS: 1
(ind1 (open-sound "now.snd"))
(zp (make-zipper (make-env '(0 0 1 1) :length 22050)
0.05
- (make-env (list 0 (* (mus-srate) 0.05)) :length 22050)))
+ (make-env (list 0 (* *clm-srate* 0.05)) :length 22050)))
(reader0 (make-sampler 0 ind 0))
(reader1 (make-sampler 0 ind1 0)))
- (run (lambda () (do ((i 0 (+ 1 i))) ((= i 22050)) (outa i (zipper zp reader0 reader1)))))
+ (do ((i 0 (+ i 1))) ((= i 22050)) (outa i (zipper zp reader0 reader1)))
(close-sound ind)
(close-sound ind1)))
@@ -54644,9 +41859,9 @@ EDITS: 1
(zip-sound 2 3 "mb.snd" "fyow.snd" '(0 0 1.0 0 1.5 1.0 3.0 1.0) .025)
(if all-args
- (let* ((ind (open-sound "oboe.snd"))
- (pv (make-pvocoder 256 4 64))
- (rd (make-sampler 0)))
+ (let ((ind (open-sound "oboe.snd"))
+ (pv (make-pvocoder 256 4 64))
+ (rd (make-sampler 0)))
(map-channel (lambda (y) (pvocoder pv rd)))
(clm-reverb-sound .1 jc-reverb)
(close-sound ind)))
@@ -54658,7 +41873,7 @@ EDITS: 1
(for-each close-sound (sounds))
- (with-sound (:play #f)
+ (with-sound (:play #f :srate 22050)
(simple-ssb 0 .2 440 .1)
(simple-nsin .6 .2 .1)
(simple-ncos 0.7 .2 440 .1)
@@ -54670,7 +41885,6 @@ EDITS: 1
(simple-tri 1.75 .2 .1)
(simple-pul 2.0 .2 .1)
(simple-sqr 2.25 .2 .1)
- (if all-args (simple-sib 2.5 .2 440.0 .1))
(simple-oz 2.75 .2 440.0 .1)
(simple-op 3.0 .2 440.0 .1)
(simple-tz 3.25 .2 440.0 .1)
@@ -54690,7 +41904,6 @@ EDITS: 1
(simple-flt 6.25 .2 440.0 .1)
(simple-fir 6.5 .2 440.0 .1)
(simple-iir 6.5 .2 440.0 .3)
- (simple-f 6.75 .2 440.0 .1)
(simple-ran 7.0 .2 440.0 .1)
(simple-ri 7.25 .2 440.0 .1)
(simple-env 7.5 .2 440.0 .1)
@@ -54737,9 +41950,9 @@ EDITS: 1
(simple-multiarr 23.5 .5 440 .1))
- (with-sound (:channels 4 :play #f) (simple-dloc-4 0 2 440 .5))
+ (with-sound (:channels 4 :play #f :srate 22050) (simple-dloc-4 0 2 440 .5))
- (with-sound (:play #f)
+ (with-sound (:play #f :srate 22050)
(or1) (or2) (or3) (or4)
(sample-desc 0 .2 440 .1)
(sample-mdat .25 .2 440 .1)
@@ -54756,10 +41969,8 @@ EDITS: 1
(sample-pvoc1 3.5 .45 1 512 "oboe.snd")
(sample-pvoc2 4.0 .45 1 512 "oboe.snd")
(sample-pvoc3 4.5 .001 1 512 "oboe.snd")
- (sample-mxf 5 .2 440 .1)
(sample-osc 5.25 .2 440 .1)
(if all-args (sample-ardcl 5.5 .2 440 .1))
- (sample-strs 5.75 .2 440 .1)
(sample-flt 6 .2 440 .1)
(sample-arrintp 6.25 .2 440 .1)
(sample-if 6.5 .2 440 .1)
@@ -54767,33 +41978,27 @@ EDITS: 1
(sample-pvoc5 7.25 .2 .1 256 "oboe.snd" 440.0)
)
- (if all-args
- (let* ((outfile (with-sound () (pvoc-a 0 2.3 1 256 "oboe.snd") (pvoc-e 0 2.3 -1 256 "oboe.snd")))
- (mx (mus-sound-maxamp outfile)))
- (if (fneq (cadr mx) 0.0)
- (snd-display #__line__ ";pvoc a-e: ~A" mx))))
-
- (let* ((file (with-sound (:clipped #f :data-format mus-bfloat :header-type mus-next)
+ (let* ((file (with-sound (:clipped #f :sample-type mus-lfloat :header-type mus-next)
(fm-violin 0 .1 440 pi)))
(ind (find-sound file))
(mx (maxamp ind)))
(if (fneq mx pi) (snd-display #__line__ ";clipped #f: ~A" mx))
(close-sound ind)
- (set! file (with-sound (:clipped #t :data-format mus-bfloat :header-type mus-next)
+ (set! file (with-sound (:clipped #t :sample-type mus-lfloat :header-type mus-next)
(fm-violin 0 .1 440 pi)))
(set! ind (find-sound file))
(set! mx (maxamp ind))
(if (fneq mx 1.0) (snd-display #__line__ ";clipped #t: ~A" mx))
(close-sound ind)
- (set! file (with-sound (:data-format mus-bfloat :header-type mus-next :scaled-by .1 :clipped #f)
+ (set! file (with-sound (:sample-type mus-lfloat :header-type mus-next :scaled-by .1 :clipped #f)
(fm-violin 0 .1 440 pi)))
(set! ind (find-sound file))
(set! mx (maxamp ind))
(if (fneq mx .314159) (snd-display #__line__ ";scaled-by ~A" mx))
(close-sound ind)
- (set! file (with-sound (:data-format mus-bfloat :header-type mus-next :scaled-to .1 :clipped #f)
+ (set! file (with-sound (:sample-type mus-lfloat :header-type mus-next :scaled-to .1 :clipped #f)
(fm-violin 0 .1 440 pi)))
(set! ind (find-sound file))
(set! mx (maxamp ind))
@@ -54808,10 +42013,10 @@ EDITS: 1
(set! *clm-array-print-length* 123)
(let ((tsize 0)
(arrp 0))
- (set! file (with-sound (:data-format mus-bfloat :header-type mus-next)
- (set! mx (mus-file-buffer-size))
- (set! tsize (clm-table-size))
- (set! arrp (mus-array-print-length))
+ (set! file (with-sound (:sample-type mus-lfloat :header-type mus-next)
+ (set! mx *clm-file-buffer-size*)
+ (set! tsize *clm-table-size*)
+ (set! arrp *mus-array-print-length*)
(fm-violin 0 .1 440 .1)))
(set! ind (find-sound file))
(if (not (= mx (* 1024 1024))) (snd-display #__line__ ";*clm-file-buffer-size*: ~A" mx))
@@ -54841,12 +42046,12 @@ EDITS: 1
(set! mx (maxamp ind))
(set! file (with-sound (:reverb jc-reverb :reverb-data '(#f 12.0 (0 0 1 1 20 1 21 0))) (fm-violin 0 .1 440 .1 :reverb-amount .1)))
(set! ind (find-sound file))
- (if (not (> (maxamp ind) mx)) (snd-display #__line__ ";reverb-data: ~A ~A" mx (maxamp ind)))
+ (if (<= (maxamp ind) mx) (snd-display #__line__ ";reverb-data: ~A ~A" mx (maxamp ind)))
(close-sound ind))
(let ((ind (open-sound "oboe.snd")))
(step-src)
- (if (> (abs (- (frames) 24602)) 100) (snd-display #__line__ ";step-src frames: ~A (~A)" (frames) (edits)))
+ (if (> (abs (- (framples) 24602)) 100) (snd-display #__line__ ";step-src framples: ~A (~A)" (framples) (edits)))
(close-sound ind))
(let ((file (with-sound (:channels 3)
@@ -54857,64 +42062,26 @@ EDITS: 1
(e1 (make-env '(0 0 1 1) :length 10000))
(e2 (make-env '(0 0 1 1 2 0 10 0) :length 10000))
(o (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
(let ((sig (env e)))
(outa i (balance rg sig (env e2)))
(outb i (balance rg1 sig (env e1)))
(outc i (balance rg2 (* .1 (oscil o)) (env e2)))))
(if (fneq (gain-avg rg) 0.98402) (snd-display #__line__ ";rmsgain gain-avg: ~A" (gain-avg rg)))
- (if (not (= (rmsg-avgc rg2) 10000)) (snd-display #__line__ ";rmsgain count: ~A" (rmsg-avgc rg2)))))))
+ (if (not (= (rg2 'avgc) 10000)) (snd-display #__line__ ";rmsgain count: ~A" (rg2 'avgc)))))))
(let ((ind (find-sound file)))
(if (not (sound? ind))
(snd-display #__line__ ";with-sound balance?")
(close-sound ind))))
- (let* ((mg (make-oscil 100.0))
- (gen (make-ssb-fm 1000))
- (ind (new-sound "tmp.snd" mus-next mus-bfloat 22050 1)))
+ (let ((mg (make-oscil 100.0))
+ (gen (make-ssb-fm 1000))
+ (ind (new-sound "tmp.snd" 1 22050 mus-ldouble mus-next)))
(pad-channel 0 1000 ind 0)
(catch #t (lambda () (map-channel (lambda (y) (ssb-fm gen (* .02 (oscil mg)))))) (lambda arg (display arg) arg))
(close-sound ind))
- (let ((file (with-sound ()
- (let ((rd (make-sampler 0 "oboe.snd"))
- (m (make-mfilter :decay .99 :frequency 1000))
- (e (make-env '(0 100 1 2000) :length 10000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (mfilter-1 m (* .1 (rd)) 0.0))
- (set! (mflt-eps m) (* 2.0 (sin (/ (* pi (env e)) (mus-srate)))))))))))
- (let ((ind (find-sound file)))
- (if (not (sound? ind))
- (snd-display #__line__ ";with-sound mfilter?")
- (close-sound ind))))
-
- (let ((m1 (make-mfilter .9 1000.0))
- (m2 (make-firmant 1000.0 .9))
- (gain (- 1.0 (* .9 .9))))
- (firmant m2 1.0)
- (mfilter-1 m1 1.0 0.0)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (let ((v1 (* gain (mfilter-1 m1 0.0 0.0)))
- (v2 (firmant m2 0.0)))
- (if (fneq v1 v2)
- (snd-display #__line__ ";~D mfilter/firmant: ~A ~A" i v1 v2)))))
-
- (let ((m1 (make-mfilter .9 1000.0))
- (m2 (make-firmant 1000.0 .9))
- (gain (- 1.0 (* .9 .9))))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (let* ((y (- (random 2.0 )1.0))
- (v1 (* gain (mfilter-1 m1 y 0.0)))
- (v2 (firmant m2 y)))
- (if (fneq v1 v2)
- (snd-display #__line__ ";rand case mfilter/firmant: ~A ~A" i v1 v2)))))
-
-
;; dlocsig tests
(if (not (provided? 'snd-dlocsig.scm))
(catch #t
@@ -54925,573 +42092,57 @@ EDITS: 1
(if (provided? 'snd-dlocsig.scm) "" "not "))
(begin
- (let ((file (new-sound "tmp.snd" mus-next mus-bfloat 22050 4)))
+ (let ((file (new-sound "tmp.snd" 4 22050 mus-ldouble mus-next)))
(mix-move-sound 0 "oboe.snd" (make-spiral-path :turns 3))
(close-sound file))
(let ((ind 0))
(with-sound (:channels 2) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .010 .011 .012 .013 .014 .015 .017 .018
- .020 .023 .025 .029 .033 .039 .046 .055 .068 .088 .122
- .182 .301 .486 .477 .402 .160 .000 .000 .000 .000 .000
- .000 .000 .000 .001 .001 .002 .002 .002 .002 .002 .003
- .003 .003 .003 .003 .003)
- ind 0 "dlocsig 0 0")
-
- (check-segments (vector .000 .000 .000 .003 .003 .003 .003 .003 .003 .003 .003
- .003 .003 .003 .003 .003 .003 .003 .003 .002 .002 .002
- .007 .036 .168 .386 .487 .497 .000 .000 .000 .000 .000
- .000 .000 .015 .033 .031 .027 .024 .021 .019 .018 .016
- .015 .014 .013 .012 .011)
- ind 1 "dlocsig 0 1")
-
(with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .011 .011 .012 .013 .014 .015 .017 .018
- .020 .023 .025 .029 .033 .038 .045 .054 .066 .086 .118
- .178 .300 .499 .497 .399 .079 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000)
- ind 0 "dlocsig 1 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .052 .376 .499 .496 .339 .184 .122 .087 .068
- .055 .046 .039 .034 .030 .026 .023 .021 .019 .018 .016
- .015 .014 .013 .012 .011)
- ind 1 "dlocsig 1 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .036 .160 .166 .122 .111 .078 .054 .037 .027
- .020 .015 .012 .009 .007 .006 .005 .004 .003 .002 .002
- .001 .001 .001 .001 .000)
- ind 2 "dlocsig 1 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .001 .001 .001 .001 .002 .002
- .002 .003 .004 .005 .006 .007 .009 .012 .016 .022 .030
- .041 .048 .045 .160 .166 .079 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000)
- ind 3 "dlocsig 1 3")
-
-
(with-sound (:channels 8) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .007 .007 .008 .008 .008 .009 .009
- .010 .010 .011 .011 .012 .012 .013 .014 .015 .017
- .021 .028 .050 .128 .382 .495 .389 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 0 "dlocsig 2 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .356 .497 .322 .042 .000
- .000 .001 .003 .005 .006 .007 .007 .008 .008 .008
- .008 .008 .008 .008 .008 .008 .007 .007 .007)
- ind 1 "dlocsig 2 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .397 .480 .353 .197
- .133 .095 .073 .058 .048 .040 .034 .030 .026 .023
- .020 .018 .016 .014 .013 .011 .010 .009 .009)
- ind 2 "dlocsig 2 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .169 .078 .003 .005
- .004 .001 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 2 3")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 4 "dlocsig 2 4")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 5 "dlocsig 2 5")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .163 .169 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 6 "dlocsig 2 6")
-
- (check-segments (vector .000 .000 .000 .008 .009 .010 .010 .012 .013 .014
- .016 .018 .020 .023 .027 .031 .036 .044 .053 .066
- .086 .118 .175 .273 .377 .315 .169 .078 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 7 "dlocsig 2 7")
-
-
(with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #t)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .011 .011 .012 .013 .014 .015 .017
- .018 .020 .023 .025 .029 .033 .038 .045 .054 .066
- .086 .118 .178 .300 .499 .497 .399 .079 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 0 "dlocsig 3 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .052 .376 .499 .496 .339 .184
- .122 .087 .068 .055 .046 .039 .034 .030 .026 .023
- .021 .019 .018 .016 .015 .014 .013 .012 .011)
- ind 1 "dlocsig 3 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .036 .160 .166 .122 .111 .078
- .054 .037 .027 .020 .015 .012 .009 .007 .006 .005
- .004 .003 .002 .002 .001 .001 .001 .001 .000)
- ind 2 "dlocsig 3 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .001 .001 .001 .001 .002
- .002 .002 .003 .004 .005 .006 .007 .009 .012 .016
- .022 .030 .041 .048 .045 .160 .166 .079 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 3 3")
-
-
(with-sound (:channels 4 :reverb jc-reverb) (dloc-sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :error .001 :3d #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .011 .012 .014 .017 .020 .025 .036 .046 .070
- .114 .261 .505 .453 .006 .006 .008 .007 .012 .034
- .035 .027 .022 .022 .018 .040 .041 .032 .050 .044
- .049 .037 .037 .040 .040 .033 .027 .028 .032 .029
- .017 .020 .018 .015 .013 .011 .011 .017 .018 .015)
- ind 0 "dlocsig 4 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .004 .006 .008
- .008 .007 .316 .503 .373 .130 .073 .052 .040 .050
- .034 .026 .023 .022 .030 .040 .041 .032 .050 .044
- .049 .037 .037 .040 .040 .033 .027 .028 .032 .029
- .017 .020 .018 .015 .013 .011 .011 .017 .018 .015)
- ind 1 "dlocsig 4 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .150 .173 .120 .058 .029 .017 .010 .006
- .004 .003 .002 .001 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 4 2")
-
- (check-segments (vector .000 .000 .000 .001 .001 .002 .004 .006 .009 .015
- .028 .049 .150 .173 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 4 3")
-
-
(with-sound (:channels 2) (dloc-sinewave 0 1.0 440 .5 :path (make-path :path '((-10 10 0 1) (0 5 0 0) (10 10 10 1)) :3d #t)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .116 .125 .136 .148 .161 .175 .190 .206
- .223 .241 .260 .278 .296 .313 .329 .342 .353 .361
- .367 .370 .371 .370 .368 .367 .365 .362 .360 .358
- .353 .354 .333 .288 .240 .196 .158 .127 .104 .085
- .071 .060 .051 .045 .039 .035 .031 .028 .025)
- ind 0 "dlocsig 5 0")
-
- (check-segments (vector .000 .000 .031 .035 .039 .044 .049 .056 .064 .074
- .085 .097 .113 .129 .148 .168 .190 .212 .233 .254
- .272 .290 .304 .316 .328 .333 .336 .340 .344 .346
- .350 .363 .370 .367 .352 .326 .295 .265 .237 .212
- .191 .171 .155 .141 .128 .117 .108 .100 .092)
- ind 1 "dlocsig 5 1")
-
-
(with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :total-angle 360)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .351 .304 .256 .200 .145 .084 .024 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .057 .115 .174 .232 .282 .331 .373 .411
- .443 .467 .485 .496 .499 .499 .494 .482 .462 .436)
- ind 0 "dlocsig 6 0")
-
- (check-segments (vector .393 .426 .455 .476 .491 .498 .500 .497 .489 .474
- .451 .421 .386 .343 .298 .246 .189 .134 .073 .014
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .006 .068 .126 .185 .239 .292)
- ind 1 "dlocsig 6 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .034 .096 .153 .211
- .266 .314 .360 .398 .432 .460 .480 .493 .499 .500
- .496 .486 .470 .445 .416 .378 .335 .289 .236 .182
- .123 .061 .002 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 6 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .045
- .107 .164 .221 .272 .323 .368 .405 .438 .463 .483
- .495 .499 .499 .495 .485 .466 .440 .409 .371 .328
- .279 .225 .171 .111 .053 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 6 3")
-
-
(with-sound (:channels 8) (dloc-sinewave 0 3.0 440 .5 :path (make-spiral-path :turns 3)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .350 .010 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .099 .429 .500 .493 .280 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .168 .465 .500 .480 .214 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .235 .486 .499)
- ind 0 "dlocsig 7 0")
-
- (check-segments (vector .499 .500 .378 .042 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .069 .408 .500 .497 .320
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .129 .447 .499 .488 .248 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .201)
- ind 1 "dlocsig 7 1")
-
- (check-segments (vector .000 .319 .497 .500 .408 .070 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .036 .377 .500
- .499 .351 .015 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .097 .429 .500 .493 .289 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 7 2")
-
- (check-segments (vector .000 .000 .000 .279 .493 .500 .430 .101 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .009
- .348 .498 .500 .385 .043 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .068 .402 .500 .497
- .321 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 7 3")
-
- (check-segments (vector .000 .000 .000 .000 .000 .245 .487 .499 .452 .138
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .311 .496 .500 .409 .071 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .034 .376
- .500 .499 .352 .018 .000 .000 .000 .000 .000 .000)
- ind 4 "dlocsig 7 4")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .204 .478 .500
- .467 .171 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .278 .493 .500 .431 .108 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .008 .347 .498 .500 .386 .044 .000 .000 .000 .000)
- ind 5 "dlocsig 7 5")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .170
- .466 .500 .478 .212 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .243 .486 .499 .453
- .139 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .309 .496 .500 .411 .074 .000 .000)
- ind 6 "dlocsig 7 6")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .137 .448 .499 .488 .246 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .202 .477
- .500 .467 .173 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .276 .493 .500 .436 .109)
- ind 7 "dlocsig 7 7")
-
-
(with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-literal-path '((-10 10) (10 10)) :polar #f)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .308 .318 .327 .336 .344 .354 .362 .370 .378
- .386 .392 .398 .403 .408 .410 .412 .412 .412 .411
- .408 .403 .396 .388 .378 .346 .352 .328 .324 .307
- .289 .272 .253 .235 .216 .199 .180 .163 .146 .131
- .116 .101 .087 .075 .064 .052 .042 .033 .025)
- ind 0 "dlocsig 8 0")
-
- (check-segments (vector .000 .009 .016 .023 .032 .041 .050 .062 .073 .085
- .099 .113 .128 .143 .161 .178 .195 .213 .232 .250
- .268 .286 .304 .321 .329 .344 .353 .375 .386 .394
- .402 .407 .410 .412 .413 .412 .411 .409 .404 .399
- .394 .387 .380 .372 .363 .355 .346 .337 .329)
- ind 1 "dlocsig 8 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 8 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 8 3")
-
-
(with-sound (:channels 3) (dloc-sinewave 0 1.0 440 .5 :path (make-literal-path '((-10 10) (10 10)) :polar #t)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .004 .004 .004 .004 .005 .005 .006 .006
- .007 .007 .008 .009 .011 .012 .014 .017 .020 .025
- .033 .044 .066 .102 .215 .406 .490 .443 .345 .281
- .180 .121 .090 .069 .056 .046 .039 .034 .029 .026
- .023 .021 .019 .017 .015 .014 .013 .012 .011 .011)
- ind 0 "dlocsig 9 0")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .002 .141 .383 .495 .475 .434 .401
- .257 .173 .129 .098 .080 .066 .055 .048 .042 .037
- .033 .029 .027 .024 .022 .020 .019 .017 .016 .015)
- ind 1 "dlocsig 9 1")
-
- (check-segments (vector .000 .000 .017 .018 .019 .021 .023 .024 .026 .029
- .032 .035 .039 .044 .050 .058 .066 .079 .096 .118
- .155 .208 .310 .482 .491 .497 .499 .372 .137 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 9 2")
-
-
(with-sound (:channels 4) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :total-angle 360 :distance '(0 10 1 30 2 10))))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .348 .227 .134 .065 .013 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .010 .024 .041 .058 .077 .097
- .120 .144 .168 .195 .222 .251 .280 .306 .331)
- ind 0 "dlocsig 10 0")
-
- (check-segments (vector .353 .347 .329 .306 .280 .253 .226 .198 .174 .148
- .126 .104 .083 .064 .046 .031 .016 .003 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .013 .067 .141)
- ind 1 "dlocsig 10 1")
-
- (check-segments (vector .000 .000 .000 .000 .025 .056 .082 .100 .114 .124
- .131 .135 .137 .137 .136 .135 .131 .127 .122 .116
- .110 .104 .097 .089 .082 .074 .067 .063 .057 .051
- .044 .035 .025 .015 .003 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 10 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .009 .020 .030
- .039 .046 .053 .059 .064 .069 .077 .084 .092 .099
- .106 .113 .119 .125 .130 .133 .136 .137 .137 .136
- .132 .126 .116 .103 .085 .060 .026 .000 .000)
- ind 3 "dlocsig 10 3")
-
-
+
(set-speaker-configuration (arrange-speakers :speakers '(-45 45 90 135 225)
:delays '(.010 .020 .030 .040 .050)
:channel-map '(0 1 3 2 4)))
-
(with-sound (:channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .350 .297 .187 .058 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .056 .178 .296 .387 .457
- .493 .499 .496 .465 .400 .313 .198 .077 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .036
- .167 .280 .379 .449 .491 .500 .498 .469 .411 .000)
- ind 0 "dlocsig 11 0")
-
- (check-segments (vector .355 .432 .483 .499 .499 .434 .220 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .115 .240 .342 .426 .478 .499 .500 .454
- .245 .017 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .103 .223 .289 .000)
- ind 1 "dlocsig 11 1")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .011 .237 .450
- .500 .500 .479 .428 .350 .243 .126 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .212 .429 .499 .499 .484 .438 .358 .260
- .137 .013 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 11 2")
-
- (check-segments (vector .000 .000 .000 .000 .111 .359 .489 .500 .486 .339
- .097 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .088 .330
- .480 .500 .490 .371 .119 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 11 3")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .072 .194 .309 .398 .464 .496 .500 .494 .459
- .391 .299 .189 .060 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .053 .183 .294 .390 .456
- .494 .500 .496 .464 .402 .314 .200 .079 .000 .000)
- ind 4 "dlocsig 11 4")
-
-
- (with-sound (:channels 5 :reverb freeverb :reverb-channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .350 .194 .013 .028 .020 .011 .012 .006 .246 .427
- .502 .504 .450 .281 .064 .041 .021 .011 .012 .009
- .169 .377 .489 .502 .480 .052 .058 .043 .015 .015
- .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
- .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
- ind 0 "dlocsig 12 0")
-
- (check-segments (vector .428 .499 .500 .244 .015 .018 .018 .007 .009 .007
- .012 .151 .355 .479 .499 .417 .044 .046 .042 .025
- .012 .012 .016 .071 .273 .036 .030 .035 .051 .049
- .031 .020 .014 .011 .011 .010 .009 .005 .002 .003
- .003 .002 .002 .001 .001 .001 .001 .001 .000 .000)
- ind 1 "dlocsig 12 1")
-
- (check-segments (vector .000 .009 .013 .028 .411 .502 .484 .374 .175 .007
- .006 .023 .043 .050 .049 .041 .252 .488 .488 .421
- .252 .015 .003 .012 .031 .052 .058 .043 .015 .015
- .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
- .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
- ind 2 "dlocsig 12 2")
-
- (check-segments (vector .000 .011 .331 .493 .487 .149 .018 .007 .009 .007
- .012 .026 .036 .036 .137 .473 .480 .315 .042 .025
- .012 .012 .016 .024 .034 .036 .030 .035 .051 .049
- .031 .020 .014 .011 .011 .010 .009 .005 .002 .003
- .003 .002 .002 .001 .001 .001 .001 .001 .000 .000)
- ind 3 "dlocsig 12 3")
-
- (check-segments (vector .000 .009 .013 .028 .020 .032 .277 .443 .502 .502
- .430 .244 .043 .050 .049 .041 .021 .011 .198 .397
- .492 .496 .464 .318 .082 .052 .058 .043 .015 .015
- .013 .009 .005 .010 .010 .006 .005 .005 .003 .002
- .002 .002 .001 .001 .001 .000 .001 .001 .000 .000)
- ind 4 "dlocsig 12 4")
-
+ (with-sound (:channels 5 :reverb freeverb :reverb-channels 5 :reverb-data '(:decay-time .9))
+ (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
(set-speaker-configuration (arrange-speakers :speakers '(-45 45 90 135 225)
:delays '(.010 .020 .030 .040 .050)
:channel-map '(4 3 2 1 0)))
- (with-sound (:channels 5 :reverb freeverb :reverb-channels 5) (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .000 .000 .035 .279 .442 .483 .480
- .393 .207 .040 .018 .012 .012 .009 .003 .187 .393
- .482 .484 .441 .284 .061 .029 .011 .012 .011 .005
- .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
- .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
- ind 0 "dlocsig 13 0")
-
- (check-segments (vector .000 .000 .000 .000 .409 .500 .490 .380 .173 .035
- .035 .025 .030 .045 .046 .041 .243 .497 .497 .440
- .264 .035 .036 .031 .024 .039 .045 .043 .030 .014
- .008 .011 .011 .010 .007 .003 .002 .003 .003 .002
- .002 .001 .001 .001 .001 .001 .000 .000 .000 .000)
- ind 1 "dlocsig 13 1")
-
- (check-segments (vector .000 .000 .327 .500 .494 .148 .004 .005 .022 .043
- .051 .050 .041 .018 .164 .501 .505 .323 .004 .002
- .013 .033 .048 .048 .045 .029 .011 .012 .011 .005
- .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
- .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
- ind 2 "dlocsig 13 2")
-
- (check-segments (vector .428 .499 .499 .249 .000 .000 .004 .011 .024 .035
- .035 .181 .406 .525 .534 .439 .023 .011 .012 .016
- .025 .035 .036 .088 .311 .039 .045 .043 .030 .014
- .008 .011 .011 .010 .007 .003 .002 .003 .003 .002
- .002 .001 .001 .001 .001 .001 .000 .000 .000 .000)
- ind 3 "dlocsig 13 3")
-
- (check-segments (vector .350 .194 .000 .000 .000 .000 .004 .008 .256 .436
- .511 .511 .453 .277 .035 .012 .009 .003 .004 .002
- .171 .380 .497 .511 .489 .029 .011 .012 .011 .005
- .005 .006 .006 .003 .004 .004 .002 .002 .002 .001
- .001 .001 .001 .000 .000 .000 .000 .000 .000 .000)
- ind 4 "dlocsig 13 4")
-
-
+ (with-sound (:channels 5 :reverb freeverb :reverb-channels 5)
+ (dloc-sinewave 0 1.0 440 .5 :path (make-spiral-path :turns 2)))
(with-sound (:channels 4)
(dlocsig-sinewave-1 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f) :decode b-format-ambisonics))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .008 .008 .009 .009 .010 .011 .012
- .013 .014 .016 .018 .020 .023 .027 .032 .039 .048
- .063 .086 .129 .215 .374 .437 .440 .398 .252 .141
- .094 .067 .052 .041 .034 .029 .025 .022 .019 .017
- .015 .014 .013 .011 .011 .010 .009 .008 .008)
- ind 0 "dlocsig 14 0")
-
- (check-segments (vector .000 .000 .000 .007 .008 .008 .009 .009 .010 .011
- .012 .013 .014 .015 .017 .019 .022 .025 .029 .036
- .045 .062 .097 .180 .342 .337 .326 .275 .160 .075
- .048 .035 .029 .025 .021 .019 .017 .016 .014 .013
- .012 .011 .011 .010 .009 .009 .008 .008 .008)
- ind 1 "dlocsig 14 1")
-
- (check-segments (vector .000 .000 .000 .008 .008 .009 .010 .011 .012 .013
- .014 .016 .018 .021 .023 .027 .032 .038 .047 .058
- .076 .105 .155 .244 .362 .301 .301 .424 .317 .185
- .124 .088 .067 .053 .043 .036 .030 .026 .023 .020
- .018 .016 .014 .013 .012 .010 .010 .009 .008)
- ind 2 "dlocsig 14 2")
-
- (check-segments (vector .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000 .000
- .000 .000 .000 .000 .000 .000 .000 .000 .000)
- ind 3 "dlocsig 14 3")
-
-
(with-sound (:channels 4)
(dlocsig-sinewave-1 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f) :decode decoded-ambisonics))
- (set! ind (find-sound "test.snd"))
-
- (check-segments (vector .000 .000 .000 .011 .012 .013 .014 .015 .016 .018 .020
- .022 .024 .027 .030 .035 .041 .048 .058 .071 .092 .126
- .190 .319 .529 .509 .385 .179 .047 .015 .009 .007 .007
- .006 .006 .006 .006 .006 .005 .005 .005 .005 .005 .004
- .004 .004 .004 .004 .004)
- ind 0 "dlocsig 15 0")
-
- (check-segments (vector .000 .000 .000 .004 .004 .004 .004 .004 .005 .005 .005
- .006 .006 .006 .007 .008 .008 .009 .011 .013 .016 .022
- .036 .075 .199 .372 .491 .516 .365 .200 .133 .095 .074
- .059 .049 .042 .036 .032 .028 .025 .022 .021 .019 .017
- .016 .015 .014 .013 .012)
- ind 1 "dlocsig 15 1")
-
- (check-segments (vector .000 .000 .000 .004 .004 .004 .005 .005 .005 .006 .006
- .007 .008 .009 .010 .011 .013 .015 .019 .023 .029 .040
- .061 .105 .175 .130 .214 .258 .204 .126 .085 .060 .045
- .035 .028 .023 .019 .016 .014 .012 .010 .009 .008 .007
- .006 .006 .005 .005 .004)
- ind 2 "dlocsig 15 2")
-
- (check-segments (vector .000 .000 .000 .004 .004 .005 .005 .006 .006 .007 .008
- .009 .010 .012 .013 .016 .019 .023 .028 .036 .047 .064
- .093 .139 .187 .172 .087 .165 .113 .059 .039 .028 .022
- .018 .015 .013 .011 .010 .009 .008 .007 .007 .006 .006
- .005 .005 .004 .004 .004)
- ind 3 "dlocsig 15 3")
- ))); end dlocsig tests
+ )))
+ (let ((f (with-sound (:channels 5 :reverb freeverb :reverb-channels 5 :srate 44100 :reverb-data '(:decay-time .1))
+ (frample->file *reverb* 0 (float-vector .2 .1 .05 .025 .0125)))))
+ (define (frample n)
+ (let ((ind (selected-sound)))
+ (let ((c (channels ind)))
+ (let ((v (make-float-vector c)))
+ (do ((i 0 (+ i 1)))
+ ((= i c) v)
+ (set! (v i) (sample n ind i)))))))
+ (if (not (vvequal (frample 2438) (make-float-vector 5)))
+ (snd-display #__line__ ";freeverb 2438: ~A" (frample 2438)))
+ (if (not (vvequal (frample 2439) (float-vector 0.04276562482118607 -0.0009843750158324838 0.00995312537997961 -0.0009843750158324838 0.001750000054016709)))
+ (format *stderr* ";freeverb 2439: ~A" (frample 2439)))
+ (if (not (vvequal (frample 4305) (float-vector 0.03010422177612782 -0.00203015236184001 0.007028832100331783 -0.001004761666990817 0.00125998433213681)))
+ (format *stderr* ";freeverb 4305: ~A" (frample 4305)))
+ (close-sound))
(let ((a4 (->frequency 'a4))
(a440 (->frequency 440.0))
@@ -55506,8 +42157,8 @@ EDITS: 1
(if (fneq c1 32.703) (snd-display #__line__ ";c1->frequency: ~A" c1))
(if (fneq b8 7902.132) (snd-display #__line__ ";b8->frequency: ~A" b8)))
- (let ((violins (make-sample->file "violins.snd" 1 mus-lfloat mus-next))
- (cellos (make-sample->file "cellos.snd" 1 mus-lfloat mus-next)))
+ (let ((violins (make-sample->file "violins.snd" 1 mus-ldouble mus-next))
+ (cellos (make-sample->file "cellos.snd" 1 mus-ldouble mus-next)))
(define (violin beg dur freq amp)
(with-temp-sound (:continue-old-file #t :output "violins.snd")
@@ -55534,7 +42185,7 @@ EDITS: 1
(csr (make-mix-sampler cs))
(fsr (make-sampler 0 index)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
(let ((v (vsr))
(c (csr))
@@ -55550,109 +42201,94 @@ EDITS: 1
(if (file-exists? "violins.snd") (delete-file "violins.snd"))
(if (file-exists? "cellos.snd") (delete-file "cellos.snd"))))
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-vct 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-peak v1) .1) (snd-display #__line__ ";with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-vct 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-peak v2) .1) (snd-display #__line__ ";with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
- (if (not (vequal v1 v2)) (snd-display #__line__ ";with-sound -> vct v1 v2 not equal?"))
- (set! (optimization) 6)
+ (let ((v1 (with-sound ((make-float-vector 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (float-vector-peak v1) .1) (snd-display #__line__ ";with-sound -> float-vector fm-violin maxamp (opt): ~A" (float-vector-peak v1)))
+ (let ((v2 (with-sound ((make-float-vector 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (float-vector-peak v2) .1) (snd-display #__line__ ";with-sound -> float-vector fm-violin maxamp: ~A" (float-vector-peak v2)))
+ (if (not (vequal v1 v2)) (snd-display #__line__ ";with-sound -> float-vector v1 v2 not equal?"))
(sound-let ((tmp () (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)))
- (let ((v3 (make-vct 2210)))
+ (let ((v3 (make-float-vector 2210)))
(file->array tmp 0 0 2205 v3)
- (if (not (vequal v1 v3)) (snd-display #__line__ ";with-sound -> vct v1 v3 not equal?"))))
- (with-sound (:output v1)
+ (if (not (vequal v1 v3)) (snd-display #__line__ ";with-sound -> float-vector v1 v3 not equal?"))))
+ (with-sound (v1)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (if (fneq (vct-peak v1) .2) (snd-display #__line__ ";with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 1 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v1)) .1) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 2210)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v2)) .1) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
- (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound -> sound-data v1 v2 not equal?"))
- (set! (optimization) 6)
- (with-sound (:output v1)
+ (if (fneq (float-vector-peak v1) .2) (snd-display #__line__ ";with-sound -> float-vector fm-violin maxamp (opt 2): ~A" (float-vector-peak v1)))))
+
+ (let ((v1 (with-sound ((make-float-vector (list 1 2210) 0.0)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (maxamp v1) .1) (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (opt): ~A" (maxamp v1)))
+ (let ((v2 (with-sound ((make-float-vector (list 1 2210) 0.0)) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (maxamp v2) .1) (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp: ~A" (maxamp v2)))
+ (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound -> vector2 v1 v2 not equal?"))
+ (with-sound (v1)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (if (fneq (car (sound-data-maxamp v1)) .2) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+ (if (fneq (maxamp v1) .2) (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (opt 2): ~A" (maxamp v1)))))
- (let ((oldopt (optimization)))
(set! (locsig-type) mus-interp-linear)
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 2 2210))
+ (let ((v1 (with-sound ((make-float-vector (list 2 2210) 0.0))
(if (not (= (mus-channels *output*) 2)) (snd-display #__line__ ";with-sound *output* chans: ~A" (mus-channels *output*)))
(fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v1)) .05) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
- (if (fneq (cadr (sound-data-maxamp v1)) .05) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 2 2210))
+ (if (fneq (maxamp v1) .05) (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (1 opt): ~A" (maxamp v1)))
+ (if (fneq (maxamp v1) .05) (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (2 opt): ~A" (maxamp v1)))
+ (let ((v2 (with-sound ((make-float-vector (list 2 2210) 0.0))
(fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v2)) .05) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
- (if (fneq (cadr (sound-data-maxamp v2)) .05) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
- (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound (2 chans) -> sound-data v1 v2 not equal?"))
- (set! (optimization) 6)
- (with-sound (:output v1)
+ (if (fneq (maxamp v2) .05) (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (2): ~A" (maxamp v2)))
+ (if (fneq (maxamp v2) .05) (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (2 2): ~A" (maxamp v2)))
+ (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound (2 chans) -> vector2 v1 v2 not equal?"))
+ (with-sound (v1)
(fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0))
- (if (fneq (car (sound-data-maxamp v1)) .2) (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-vct 2210) :scaled-to .3) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-peak v1) .3)
- (snd-display #__line__ ";with-sound -> vct fm-violin maxamp (opt, scaled-to): ~A" (vct-peak v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-vct 2210) :scaled-to .3) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-peak v2) .3)
- (snd-display #__line__ ";with-sound -> vct fm-violin maxamp scaled-to: ~A" (vct-peak v2)))
- (if (not (vequal v1 v2)) (snd-display #__line__ ";with-sound (scaled-to) -> vct v1 v2 not equal?"))
- (set! (optimization) 6)
- (with-sound (:output v1 :scaled-by 2.0)
+ (if (fneq (maxamp v1) .2) (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (opt 2): ~A" (maxamp v1)))))
+
+ (let ((v1 (with-sound ((make-float-vector 2210) :scaled-to .3) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (float-vector-peak v1) .3)
+ (snd-display #__line__ ";with-sound -> float-vector fm-violin maxamp (opt, scaled-to): ~A" (float-vector-peak v1)))
+ (let ((v2 (with-sound ((make-float-vector 2210) :scaled-to .3) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (float-vector-peak v2) .3)
+ (snd-display #__line__ ";with-sound -> float-vector fm-violin maxamp scaled-to: ~A" (float-vector-peak v2)))
+ (if (not (vequal v1 v2)) (snd-display #__line__ ";with-sound (scaled-to) -> float-vector v1 v2 not equal?"))
+ (with-sound (v1 :scaled-by 2.0)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (if (fneq (vct-peak v1) .4) (snd-display #__line__ ";with-sound -> vct fm-violin maxamp (opt 2 scaled-by): ~A" (vct-peak v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v1)) .5)
- (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt, scaled-to): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (car (sound-data-maxamp v2)) .5)
- (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp scaled-to: ~A" (sound-data-maxamp v2)))
- (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound scaled-to -> sound-data v1 v2 not equal?"))
- (set! (optimization) 6)
- (with-sound (:output v1 :scaled-by 0.5)
+ (if (fneq (float-vector-peak v1) .4) (snd-display #__line__ ";with-sound -> float-vector fm-violin maxamp (opt 2 scaled-by): ~A" (float-vector-peak v1)))))
+
+ (let ((v1 (with-sound ((make-float-vector (list 1 2210) 0.0) :scaled-to .5) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (maxamp v1) .5)
+ (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (opt, scaled-to): ~A" (maxamp v1)))
+ (let ((v2 (with-sound ((make-float-vector (list 1 2210) 0.0) :scaled-to .5) (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
+ (if (fneq (maxamp v2) .5)
+ (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp scaled-to: ~A" (maxamp v2)))
+ (if (not (sd-equal v1 v2)) (snd-display #__line__ ";with-sound scaled-to -> vector2 v1 v2 not equal?"))
+ (with-sound (v1 :scaled-by 0.5)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (if (fneq (car (sound-data-maxamp v1)) .1)
- (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt 2 scaled-by): ~A" (sound-data-maxamp v1))))))
+ (if (fneq (maxamp v1) .1)
+ (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (opt 2 scaled-by): ~A" (maxamp v1)))))
(let ((stats-string ""))
- (let ((v1 (with-sound (:output (make-vct 2210) :statistics (lambda (str) (set! stats-string str)))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (and (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.000\n"))
- (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.001\n"))
- (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.002\n"))
- (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.010\n"))
- (not (string=? stats-string "\n;vct:\n maxamp: 0.1000\n compute time: 0.180\n")))
- (snd-display #__line__ ";with-sound to vct stats: [~A]" stats-string)))
- (let ((v1 (with-sound (:output (make-sound-data 1 2210) :scaled-to .5 :statistics (lambda (str) (set! stats-string str)))
- (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (and (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.000\n"))
- (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.001\n"))
- (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.002\n"))
- (not (string=? stats-string "\n;sound-data:\n maxamp (before scaling): 0.1000\n compute time: 0.010\n")))
- (snd-display #__line__ ";with-sound to sound-data stats: [~A]" stats-string)))
-
- (with-sound (:output (make-sound-data 4 2210) :channels 4 :statistics (lambda (str) (set! stats-string str)))
+ (with-sound ((make-float-vector 2210) :statistics (lambda (str) (set! stats-string str)))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
+ (if (and (not (string=? stats-string "\n;vector:\n maxamp: 0.1000\n compute time: 0.000\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp: 0.1000\n compute time: 0.001\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp: 0.1000\n compute time: 0.002\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp: 0.1000\n compute time: 0.010\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp: 0.09999998\n compute time: 0.001\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp: 0.09999998\n compute time: 0.000\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp: 0.1000\n compute time: 0.180\n")))
+ (snd-display #__line__ ";with-sound to float-vector stats: [~A]" stats-string))
+ (with-sound ((make-float-vector (list 1 2210) 0.0) :scaled-to .5 :statistics (lambda (str) (set! stats-string str)))
+ (fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
+ (if (and (not (string=? stats-string "\n;vector:\n maxamp (before scaling): 0.1000\n compute time: 0.000\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp (before scaling): 0.1000\n compute time: 0.001\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp (before scaling): 0.1000\n compute time: 0.002\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp (before scaling): 0.1000\n compute time: 0.010\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp (before scaling): 0.09999998\n compute time: 0.001\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp (before scaling): 0.09999998\n compute time: 0.000\n"))
+ (not (string=? stats-string "\n;vector:\n maxamp (before scaling): 0.1000\n compute time: 0.009\n")))
+ (snd-display #__line__ ";with-sound to float-vector stats: [~A]" stats-string))
+
+ (with-sound ((make-float-vector (list 4 2210) 0.0) :channels 4 :statistics (lambda (str) (set! stats-string str)))
(fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
@@ -55661,305 +42297,271 @@ EDITS: 1
(for-each
(lambda (n)
- (set! (optimization) n)
;; testing overwrites here -- just hope we don't crash...
- (let ((v1 (with-sound (:output (make-vct 20) :channels 1)
+ (let ((v1 (with-sound ((make-float-vector 20) :channels 1)
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-ref v1 0) 0.0) (snd-display #__line__ ";overwrite vct with-sound: ~A (~A)" (vct-ref v1 0) (vct-peak v1))))
+ (if (fneq (v1 0) 0.0) (snd-display #__line__ ";overwrite float-vector with-sound: ~A (~A)" (v1 0) (float-vector-peak v1))))
- (let ((v1 (with-sound (:output (make-vct 20) :channels 4)
+ (let ((v1 (with-sound ((make-float-vector 20) 4)
(fm-violin 0 .1 440 .1 :degree 45 :random-vibrato-amplitude 0.0))))
- (if (fneq (vct-ref v1 0) 0.0) (snd-display #__line__ ";overwrite vct with-sound (4): ~A (~A)" (vct-ref v1 0) (vct-peak v1))))
+ (if (fneq (v1 0) 0.0) (snd-display #__line__ ";overwrite float-vector with-sound (4): ~A (~A)" (v1 0) (float-vector-peak v1))))
- (let ((v1 (with-sound (:output (make-sound-data 4 20) :channels 4)
+ (let ((v1 (with-sound ((make-float-vector (list 4 20) 0.0) :channels 4)
(fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
- (do ((i 0 (+ 1 i))) ((= i 4))
- (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
+ (do ((i 0 (+ i 1))) ((= i 4))
+ (if (fneq (v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd ~D with-sound: ~A" i (v1 i 0)))))
- (let ((v1 (with-sound (:output (make-sound-data 2 20) :channels 4)
+ (let ((v1 (with-sound ((make-float-vector (list 2 20) 0.0) 4)
(fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
- (do ((i 0 (+ 1 i))) ((= i 2))
- (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd (2) ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
+ (do ((i 0 (+ i 1))) ((= i 2))
+ (if (fneq (v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd (2) ~D with-sound: ~A" i (v1 i 0)))))
- (let ((v1 (with-sound (:output (make-sound-data 4 20) :channels 1)
+ (let ((v1 (with-sound ((make-float-vector (list 4 20) 0.0) :channels 1)
(fm-violin 0 .1 440 .1 :degree 0 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .2 :degree 90 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .3 :degree 180 :random-vibrato-amplitude 0.0)
(fm-violin 0 .1 440 .4 :degree 270 :random-vibrato-amplitude 0.0))))
- (do ((i 0 (+ 1 i))) ((= i 4))
- (if (fneq (sound-data-ref v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd (4) ~D with-sound: ~A" i (sound-data-ref v1 i 0)))))
+ (do ((i 0 (+ i 1))) ((= i 4))
+ (if (fneq (v1 i 0) 0.0) (snd-display #__line__ ";overwrite sd (4) ~D with-sound: ~A" i (v1 i 0)))))
)
(list 0 3 6))
;; reverb cases parallel to above
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-vct 44100) :reverb jc-reverb)
- (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length vct: ~A" (mus-length *output*)))
+ (let ((v1 (with-sound ((make-float-vector 44100) :reverb jc-reverb)
+ (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length float-vector: ~A" (mus-length *output*)))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0 :reverb-amount 0.9)))
- (v4 (with-sound (:output (make-vct 44100))
+ (v4 (with-sound ((make-float-vector 44100))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (vequal v1 v4) (snd-display #__line__ ";reverb output not written to vct?"))
- (if (< (vct-peak v1) .29)
- (snd-display #__line__ ";rev with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-vct 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (vct-peak v2) .29)
- (snd-display #__line__ ";rev with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :channels 1 :reverb jc-reverb)
+ (if (vequal v1 v4) (snd-display #__line__ ";reverb output not written to float-vector?"))
+ (if (< (float-vector-peak v1) .28)
+ (snd-display #__line__ ";rev with-sound -> float-vector fm-violin maxamp (opt): ~A" (float-vector-peak v1)))
+ (let ((v2 (with-sound ((make-float-vector 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
+ (if (< (float-vector-peak v2) .28)
+ (snd-display #__line__ ";rev with-sound -> float-vector fm-violin maxamp: ~A" (float-vector-peak v2)))
+ (with-sound (v1 :channels 1 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (vct-peak v1) .29)
- (snd-display #__line__ ";rev with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
+ (if (< (float-vector-peak v1) .28)
+ (snd-display #__line__ ";rev with-sound -> float-vector fm-violin maxamp (opt 2): ~A" (float-vector-peak v1)))))
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 1 44100) :reverb jc-reverb)
+ (let ((v1 (with-sound ((make-float-vector (list 1 44100) 0.0) :reverb jc-reverb)
(if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length sd: ~A" (mus-length *output*)))
(fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
- (v4 (with-sound (:output (make-sound-data 1 44100))
+ (v4 (with-sound ((make-float-vector (list 1 44100) 0.0))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
(if (sd-equal v1 v4) (snd-display #__line__ ";reverb output not written to sd?"))
- (if (< (car (sound-data-maxamp v1)) .23)
- (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 44100) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .23)
- (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :reverb jc-reverb)
+ (if (< (maxamp v1) .23)
+ (snd-display #__line__ ";rev with-sound -> vector2 fm-violin maxamp (opt): ~A" (maxamp v1)))
+ (let ((v2 (with-sound ((make-float-vector (list 1 44100) 0.0) :reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
+ (if (< (maxamp v2) .23)
+ (snd-display #__line__ ";rev with-sound -> vector2 fm-violin maxamp: ~A" (maxamp v2)))
+ (with-sound (v1 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .55)
- (snd-display #__line__ ";with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+ (if (< (maxamp v1) .52)
+ (snd-display #__line__ ";with-sound -> vector2 fm-violin maxamp (opt 2): ~A" (maxamp v1)))))
- (let ((oldopt (optimization)))
(set! (locsig-type) mus-interp-linear)
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 2 44100) :reverb jc-reverb)
+ (let ((v1 (with-sound ((make-float-vector (list 2 44100) 0.0) :reverb jc-reverb)
(if (not (= (mus-channels *output*) 2))
(snd-display #__line__ ";rev with-sound *output* chans: ~A" (mus-channels *output*)))
(fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v1)) .23)
- (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
- (if (< (cadr (sound-data-maxamp v1)) .23)
- (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 2 44100) :reverb jc-reverb)
+ (if (< (maxamp v1) .23)
+ (snd-display #__line__ ";rev with-sound -> vector2 fm-violin maxamp (1 opt): ~A" (maxamp v1)))
+ (if (< (maxamp v1) .23)
+ (snd-display #__line__ ";rev with-sound -> vector2 fm-violin maxamp (2 opt): ~A" (maxamp v1)))
+ (let ((v2 (with-sound ((make-float-vector (list 2 44100) 0.0) :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .23)
- (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
- (if (< (cadr (sound-data-maxamp v2)) .23)
- (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :reverb jc-reverb)
+ (if (< (maxamp v2) .23)
+ (snd-display #__line__ ";rev with-sound -> vector2 fm-violin maxamp (2): ~A" (maxamp v2)))
+ (if (< (maxamp v2) .23)
+ (snd-display #__line__ ";rev with-sound -> vector2 fm-violin maxamp (2 2): ~A" (maxamp v2)))
+ (with-sound (v1 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .56)
- (snd-display #__line__ ";rev with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
+ (if (< (maxamp v1) .5)
+ (snd-display #__line__ ";rev with-sound -> vector2 fm-violin maxamp (opt 2): ~A" (maxamp v1)))))
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-vct 44100) :revfile (make-vct 44100) :reverb jc-reverb)
- (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";1 ws mus-length vct: ~A" (mus-length *output*)))
- (if (not (= (mus-length *reverb*) 44100)) (snd-display #__line__ ";1 ws mus-length vct rev: ~A" (mus-length *reverb*)))
+ (let ((v1 (with-sound ((make-float-vector 44100) :revfile (make-float-vector 44100) :reverb jc-reverb)
+ (if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";1 ws mus-length float-vector: ~A" (mus-length *output*)))
+ (if (not (= (mus-length *reverb*) 44100)) (snd-display #__line__ ";1 ws mus-length float-vector rev: ~A" (mus-length *reverb*)))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0 :reverb-amount 0.9)))
- (v4 (with-sound (:output (make-vct 44100))
+ (v4 (with-sound ((make-float-vector 44100))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
- (if (vequal v1 v4) (snd-display #__line__ ";1 reverb output not written to vct?"))
- (if (< (vct-peak v1) .28)
- (snd-display #__line__ ";1 rev with-sound -> vct fm-violin maxamp (opt): ~A" (vct-peak v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-vct 44100) :revfile (make-vct 44100) :reverb jc-reverb)
+ (if (vequal v1 v4) (snd-display #__line__ ";1 reverb output not written to float-vector?"))
+ (if (< (float-vector-peak v1) .28)
+ (snd-display #__line__ ";1 rev with-sound -> float-vector fm-violin maxamp (opt): ~A" (float-vector-peak v1)))
+ (let ((v2 (with-sound ((make-float-vector 44100) :revfile (make-float-vector 44100) :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (vct-peak v2) .28)
- (snd-display #__line__ ";1 rev with-sound -> vct fm-violin maxamp: ~A" (vct-peak v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :revfile v2 :channels 1 :reverb jc-reverb)
+ (if (< (float-vector-peak v2) .28)
+ (snd-display #__line__ ";1 rev with-sound -> float-vector fm-violin maxamp: ~A" (float-vector-peak v2)))
+ (with-sound (v1 :revfile v2 :channels 1 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (vct-peak v1) .28)
- (snd-display #__line__ ";1 rev with-sound -> vct fm-violin maxamp (opt 2): ~A" (vct-peak v1))))))
+ (if (< (float-vector-peak v1) .28)
+ (snd-display #__line__ ";1 rev with-sound -> float-vector fm-violin maxamp (opt 2): ~A" (float-vector-peak v1)))))
- (let ((oldopt (optimization)))
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (let ((v1 (with-sound ((make-float-vector (list 1 44100) 0.0) :revfile (make-float-vector (list 1 44100) 0.0) :reverb jc-reverb)
(if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length sd: ~A" (mus-length *output*)))
(fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
- (v4 (with-sound (:output (make-sound-data 1 44100))
+ (v4 (with-sound ((make-float-vector (list 1 44100) 0.0))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
(if (sd-equal v1 v4) (snd-display #__line__ ";2 reverb output not written to sd?"))
- (if (< (car (sound-data-maxamp v1)) .28)
- (snd-display #__line__ ";2 rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (if (< (maxamp v1) .28)
+ (snd-display #__line__ ";2 rev with-sound -> vector2 fm-violin maxamp (opt): ~A" (maxamp v1)))
+ (let ((v2 (with-sound ((make-float-vector (list 1 44100) 0.0) :revfile (make-float-vector (list 1 44100) 0.0) :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .28)
- (snd-display #__line__ ";2 rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
+ (if (< (maxamp v2) .28)
+ (snd-display #__line__ ";2 rev with-sound -> vector2 fm-violin maxamp: ~A" (maxamp v2)))
+ (with-sound (v1 :revfile v2 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .54)
- (snd-display #__line__ ";2 with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
-
- (let ((oldopt (optimization)))
- (set! (optimization) 0)
- (let ((v1 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (if (< (maxamp v1) .5)
+ (snd-display #__line__ ";2 with-sound -> vector2 fm-violin maxamp (opt 2): ~A" (maxamp v1)))))
+
+ (let ((v1 (with-sound ((make-float-vector (list 1 44100) 0.0) :revfile (make-float-vector (list 1 44100) 0.0) :reverb jc-reverb)
(if (not (= (mus-length *output*) 44100)) (snd-display #__line__ ";ws mus-length sd: ~A" (mus-length *output*)))
(fm-violin 0 .1 440 .1 :reverb-amount 0.9 :random-vibrato-amplitude 0.0)))
- (v4 (with-sound (:output (make-sound-data 1 44100))
+ (v4 (with-sound ((make-float-vector (list 1 44100) 0.0))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))))
(if (sd-equal v1 v4) (snd-display #__line__ ";2 reverb output not written to sd?"))
- (if (< (car (sound-data-maxamp v1)) .28)
- (snd-display #__line__ ";2 rev with-sound -> sound-data fm-violin maxamp (opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 1 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (if (< (maxamp v1) .28)
+ (snd-display #__line__ ";2 rev with-sound -> vector2 fm-violin maxamp (opt): ~A" (maxamp v1)))
+ (let ((v2 (with-sound ((make-float-vector (list 1 44100) 0.0) :revfile (make-float-vector (list 1 44100) 0.0) :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .28)
- (snd-display #__line__ ";2 rev with-sound -> sound-data fm-violin maxamp: ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
+ (if (< (maxamp v2) .28)
+ (snd-display #__line__ ";2 rev with-sound -> vector2 fm-violin maxamp: ~A" (maxamp v2)))
+ (with-sound (v1 :revfile v2 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .5)
- (snd-display #__line__ ";2 with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+ (if (< (maxamp v1) .5)
+ (snd-display #__line__ ";2 with-sound -> vector2 fm-violin maxamp (opt 2): ~A" (maxamp v1)))))
- (let ((oldopt (optimization)))
(set! (locsig-type) mus-interp-linear)
- (set! (optimization) 6)
- (let ((v1 (with-sound (:output (make-sound-data 2 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (let ((v1 (with-sound ((make-float-vector (list 2 44100) 0.0) :revfile (make-float-vector (list 1 44100) 0.0) :reverb jc-reverb)
(if (not (= (mus-channels *output*) 2))
(snd-display #__line__ ";3 rev with-sound *output* chans: ~A" (mus-channels *output*)))
(fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v1)) .23)
- (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (1 opt): ~A" (sound-data-maxamp v1)))
- (if (< (cadr (sound-data-maxamp v1)) .23)
- (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (2 opt): ~A" (sound-data-maxamp v1)))
- (set! (optimization) 0)
- (let ((v2 (with-sound (:output (make-sound-data 2 44100) :revfile (make-sound-data 1 44100) :reverb jc-reverb)
+ (if (< (maxamp v1) .23)
+ (snd-display #__line__ ";3 rev with-sound -> vector2 fm-violin maxamp (1 opt): ~A" (maxamp v1)))
+ (if (< (maxamp v1) .23)
+ (snd-display #__line__ ";3 rev with-sound -> vector2 fm-violin maxamp (2 opt): ~A" (maxamp v1)))
+ (let ((v2 (with-sound ((make-float-vector (list 2 44100) 0.0) :revfile (make-float-vector (list 1 44100) 0.0) :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :degree 45 :reverb-amount 0.9))))
- (if (< (car (sound-data-maxamp v2)) .23)
- (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (2): ~A" (sound-data-maxamp v2)))
- (if (< (cadr (sound-data-maxamp v2)) .23)
- (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (2 2): ~A" (sound-data-maxamp v2)))
- (set! (optimization) 6)
- (with-sound (:output v1 :revfile v2 :reverb jc-reverb)
+ (if (< (maxamp v2) .23)
+ (snd-display #__line__ ";3 rev with-sound -> vector2 fm-violin maxamp (2): ~A" (maxamp v2)))
+ (if (< (maxamp v2) .23)
+ (snd-display #__line__ ";3 rev with-sound -> vector2 fm-violin maxamp (2 2): ~A" (maxamp v2)))
+ (with-sound (v1 :revfile v2 :reverb jc-reverb)
(fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9)
(fm-violin 0 .1 440 .1 :degree 0 :reverb-amount 0.9))
- (if (< (car (sound-data-maxamp v1)) .56)
- (snd-display #__line__ ";3 rev with-sound -> sound-data fm-violin maxamp (opt 2): ~A" (sound-data-maxamp v1))))))
+ (if (< (maxamp v1) .55)
+ (snd-display #__line__ ";3 rev with-sound -> vector2 fm-violin maxamp (opt 2): ~A" (maxamp v1)))))
-
- (let ((oldopt (optimization)))
(for-each
(lambda (n)
- (set! (optimization) n)
- (let ((v1 (with-sound (:output (make-vct 44100))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
- (v2 (with-sound (:output (make-vct 400))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
- (v3 (with-sound (:output (make-vct 400))
- (simple-outn 0 .1 440 0.0 .5 0.0 0.0 0.0 0.0)))
- (v4 (with-sound (:output (make-vct 44100) :reverb jc-reverb)
- (simple-outn 0 .1 440 0.2 0.0 0.0 0.0 0.05 0.0)))
- (v5 (with-sound (:output (make-vct 44100) :reverb simple-in-rev :reverb-data '(0.0 1.0 1.0 0.0))
- (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.0)))
- (v6 (with-sound (:output (make-vct 400))
- (simple-outn 0 .1 440 0.5 0.0 0.0 0.0 0.0 0.0)
- (simple-outn 0 .1 440 0.2 0.0 0.0 0.0 0.0 0.0)))
- (sd1 (with-sound (:output (make-sound-data 1 44100))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
- (sd2 (with-sound (:output (make-sound-data 4 44100))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)))
- (sd3 (with-sound (:output (make-sound-data 2 44100))
- (simple-outn 0 .1 440 0.0 0.0 .3 .4 0.0 0.0)))
- (sd4 (with-sound (:output (make-sound-data 4 44100) :reverb simple-in-rev :reverb-channels 2 :reverb-data '(0.0 1.0 1.0 1.0))
- (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.25)))
- (sd5 (with-sound (:output (make-sound-data 4 44100) :reverb simple-in-rev :reverb-channels 1 :reverb-data '(0.0 1.0 1.0 1.0))
- (simple-outn 0 .1 440 0.0 0.0 0.0 0.0 0.5 0.25)))
- (sd6 (with-sound (:output (make-sound-data 4 44100))
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0)
- (simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))))
- (if (fneq (vct-peak v1) 0.1) (snd-display #__line__ ";outa tests 1 ~A: ~A" n (vct-peak v1)))
- (if (fneq (vct-peak v2) 0.1) (snd-display #__line__ ";outa tests 2 ~A: ~A" n (vct-peak v2)))
- (if (fneq (vct-peak v3) 0.0) (snd-display #__line__ ";outa tests 3 ~A: ~A" n (vct-peak v3)))
- (if (< (vct-peak v4) 0.2) (snd-display #__line__ ";outa tests 4 ~A: ~A" n (vct-peak v4)))
- (if (fneq (vct-peak v5) 0.5) (snd-display #__line__ ";outa tests 5 ~A: ~A" n (vct-peak v5)))
- (if (fneq (vct-peak v6) 0.7) (snd-display #__line__ ";outa tests 11 ~A: ~A" n (vct-peak v6)))
+ (let ((v1 (with-sound ((make-float-vector 4410))
+ (simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0)))
+ (v2 (with-sound ((make-float-vector 400))
+ (simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0)))
+ (v3 (with-sound ((make-float-vector 400))
+ (simple-outn 0 .01 440 0.0 .5 0.0 0.0 0.0 0.0)))
+ (v4 (with-sound ((make-float-vector 4410) :reverb jc-reverb)
+ (simple-outn 0 .01 440 0.2 0.0 0.0 0.0 0.05 0.0)))
+ (v5 (with-sound ((make-float-vector 4410) :reverb simple-in-rev :reverb-data '(0.0 1.0 1.0 0.0))
+ (simple-outn 0 .01 440 0.0 0.0 0.0 0.0 0.5 0.0)))
+ (v6 (with-sound ((make-float-vector 400))
+ (simple-outn 0 .01 440 0.5 0.0 0.0 0.0 0.0 0.0)
+ (simple-outn 0 .01 440 0.2 0.0 0.0 0.0 0.0 0.0)))
+ (sd1 (with-sound ((make-float-vector (list 1 4410) 0.0))
+ (simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0)))
+ (sd2 (with-sound ((make-float-vector (list 4 4410) 0.0))
+ (simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0)))
+ (sd3 (with-sound ((make-float-vector (list 2 4410) 0.0))
+ (simple-outn 0 .01 440 0.0 0.0 .3 .4 0.0 0.0)))
+ (sd4 (with-sound ((make-float-vector (list 4 4410) 0.0) :reverb simple-in-rev :reverb-channels 2 :reverb-data '(0.0 1.0 1.0 1.0))
+ (simple-outn 0 .01 440 0.0 0.0 0.0 0.0 0.5 0.25)))
+ (sd5 (with-sound ((make-float-vector (list 4 4410) 0.0) :reverb simple-in-rev :reverb-channels 1 :reverb-data '(0.0 1.0 1.0 1.0))
+ (simple-outn 0 .01 440 0.0 0.0 0.0 0.0 0.5 0.25)))
+ (sd6 (with-sound ((make-float-vector (list 4 4410) 0.0))
+ (simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0)
+ (simple-outn 0 .01 440 .1 .2 .3 .4 0.0 0.0))))
+ (if (fneq (float-vector-peak v1) 0.1) (snd-display #__line__ ";outa tests 1 ~A: ~A" n (float-vector-peak v1)))
+ (if (fneq (float-vector-peak v2) 0.1) (snd-display #__line__ ";outa tests 2 ~A: ~A" n (float-vector-peak v2)))
+ (if (fneq (float-vector-peak v3) 0.0) (snd-display #__line__ ";outa tests 3 ~A: ~A" n (float-vector-peak v3)))
+ (if (fneq (float-vector-peak v4) 0.2) (snd-display #__line__ ";outa tests 4 ~A: ~A" n (float-vector-peak v4)))
+ (if (fneq (float-vector-peak v5) 0.5) (snd-display #__line__ ";outa tests 5 ~A: ~A" n (float-vector-peak v5)))
+ (if (fneq (float-vector-peak v6) 0.7) (snd-display #__line__ ";outa tests 11 ~A: ~A" n (float-vector-peak v6)))
- (let ((mx1 (sound-data-maxamp sd1)))
- (if (not (feql mx1 (list .1))) (snd-display #__line__ ";outa tests 6 ~A: ~A" n mx1)))
- (let ((mx2 (sound-data-maxamp sd2)))
- (if (not (feql mx2 (list .1 .2 .3 .4))) (snd-display #__line__ ";outa tests 7 ~A: ~A" n mx2)))
- (let ((mx3 (sound-data-maxamp sd3)))
- (if (not (feql mx3 (list 0.0 0.0))) (snd-display #__line__ ";outa tests 8 ~A: ~A" n mx3)))
- (let ((mx4 (sound-data-maxamp sd4)))
- (if (not (feql mx4 (list 0.5 0.25 0.0 0.0))) (snd-display #__line__ ";outa tests 9 ~A: ~A" n mx4)))
- (let ((mx5 (sound-data-maxamp sd5)))
- (if (not (feql mx5 (list 0.5 0.0 0.0 0.0))) (snd-display #__line__ ";outa tests 10 ~A: ~A" n mx5)))
- (let ((mx6 (sound-data-maxamp sd6)))
- (if (not (feql mx6 (list .2 .4 .6 .8))) (snd-display #__line__ ";outa tests 12 ~A: ~A" n mx6)))
+ (let ((mx1 (maxamp sd1)))
+ (if (fneq mx1 .1) (snd-display #__line__ ";outa tests 6 ~A: ~A" n mx1)))
+ (let ((mx2 (maxamp sd2)))
+ (if (fneq mx2 .4) (snd-display #__line__ ";outa tests 7 ~A: ~A" n mx2)))
+ (let ((mx3 (maxamp sd3)))
+ (if (fneq mx3 0.0) (snd-display #__line__ ";outa tests 8 ~A: ~A" n mx3)))
+ (let ((mx4 (maxamp sd4)))
+ (if (fneq mx4 0.5) (snd-display #__line__ ";outa tests 9 ~A: ~A" n mx4)))
+ (let ((mx5 (maxamp sd5)))
+ (if (fneq mx5 0.5) (snd-display #__line__ ";outa tests 10 ~A: ~A" n mx5)))
+ (let ((mx6 (maxamp sd6)))
+ (if (fneq mx6 .8) (snd-display #__line__ ";outa tests 12 ~A: ~A" n mx6)))
- (with-sound (:output v1 :continue-old-file #t)
+ (with-sound (v1 :continue-old-file #t)
(simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))
- (if (fneq (vct-peak v1) 0.2) (snd-display #__line__ ";outa tests 13 ~A: ~A" n (vct-peak v1)))
+ (if (fneq (float-vector-peak v1) 0.2) (snd-display #__line__ ";outa tests 13 ~A: ~A" n (float-vector-peak v1)))
- (with-sound (:output sd2 :continue-old-file #t)
+ (with-sound (sd2 :continue-old-file #t)
(simple-outn 0 .1 440 .1 .2 .3 .4 0.0 0.0))
- (let ((mx7 (sound-data-maxamp sd2)))
- (if (not (feql mx7 (list .2 .4 .6 .8))) (snd-display #__line__ ";outa tests 14 ~A: ~A" n mx7)))))
+ (let ((mx7 (maxamp sd2)))
+ (if (fneq mx7 .8) (snd-display #__line__ ";outa tests 14 ~A: ~A" n mx7)))))
(list 0 6))
- (set! (optimization) oldopt))
(let* ((file (with-sound ()
(fm-violin 0 .1 880 .1 :random-vibrato-amplitude 0.0)
- (let ((v1 (with-temp-sound (:output (make-vct 2210))
+ (let ((v1 (with-temp-sound (:output (make-float-vector 2210))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0)))
- (sd1 (with-temp-sound (:output (make-sound-data 1 2210))
+ (sd1 (with-temp-sound (:output (make-float-vector (list 1 2210) 0.0))
(fm-violin 0 .1 660 .1 :random-vibrato-amplitude 0.0))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 2205))
- (outa i (+ (vct-ref v1 i) (sound-data-ref sd1 0 i)))))
+ (outa i (+ (v1 i) (sd1 0 i)))))
(fm-violin 0 .1 220.0 .1 :random-vibrato-amplitude 0.0)))
(ind (find-sound file)))
(if (not (sound? ind))
(snd-display #__line__ ";can't find mixed with-sound output")
(let ((mx (maxamp ind 0)))
(if (< mx .35) (snd-display #__line__ ";mixed with-sound max: ~A" mx))
- (if (not (vequal (channel->vct 1000 10) (vct 0.255 0.275 0.316 0.364 0.391 0.379 0.337 0.283 0.228 0.170)))
- (snd-display #__line__ ";mixed with-sound: ~A" (channel->vct 1000 10)))
+ (if (not (vequal (channel->float-vector 1000 10) (float-vector 0.255 0.275 0.316 0.364 0.391 0.379 0.337 0.283 0.228 0.170)))
+ (snd-display #__line__ ";mixed with-sound: ~A" (channel->float-vector 1000 10)))
(close-sound ind))))
(let* ((file (with-sound ()
(fm-violin 0 .1 880 .1 :random-vibrato-amplitude 0.0)
- (sound-let ((v1 (:output (make-vct 2210))
+ (sound-let ((v1 (:output (make-float-vector 2210))
(fm-violin 0 .1 440 .1 :random-vibrato-amplitude 0.0))
- (sd1 (:output (make-sound-data 1 2210))
+ (sd1 (:output (make-float-vector (list 1 2210) 0.0))
(fm-violin 0 .1 660 .1 :random-vibrato-amplitude 0.0))
(fs1 ()
(fm-violin 0 .1 110 .1 :random-vibrato-amplitude 0.0)))
- (mus-mix *output* fs1)
- (do ((i 0 (+ 1 i)))
+ (mus-file-mix *output* fs1)
+ (do ((i 0 (+ i 1)))
((= i 2205))
- (outa i (+ (vct-ref v1 i) (sound-data-ref sd1 0 i)))))
+ (outa i (+ (v1 i) (sd1 0 i)))))
(fm-violin 0 .1 220.0 .1 :random-vibrato-amplitude 0.0)))
(ind (find-sound file)))
(if (not (sound? ind))
(snd-display #__line__ ";can't find mixed with-sound sound-let output")
(let ((mx (maxamp ind 0)))
(if (< mx .375) (snd-display #__line__ ";mixed with-sound max: ~A" mx))
- (if (not (vequal (channel->vct 1000 10) (vct 0.349 0.370 0.412 0.461 0.489 0.478 0.436 0.383 0.328 0.270)))
- (snd-display #__line__ ";mixed with-sound via sound-let: ~A" (channel->vct 1000 10)))
+ (if (not (vequal (channel->float-vector 1000 10) (float-vector 0.349 0.370 0.412 0.461 0.489 0.478 0.436 0.383 0.328 0.270)))
+ (snd-display #__line__ ";mixed with-sound via sound-let: ~A" (channel->float-vector 1000 10)))
(close-sound ind))))
@@ -55970,10 +42572,10 @@ EDITS: 1
(info (sound-property 'with-mixed-sound-info snd)))
(if (not (list? mxs))
(snd-display #__line__ ";with-mixed-sound (1) mixes: ~A" mxs))
- (if (or (not (equal? (car (list-ref info 0)) (car mxs)))
- (not (= (cadr (list-ref info 0)) 0))
- (not (= (caddr (list-ref info 0)) 1)))
- (snd-display #__line__ ";with-mixed-sound info (1) 0: ~A" (list-ref info 0)))
+ (if (or (not (equal? (car (info 0)) (car mxs)))
+ (not (= (cadr (info 0)) 0))
+ (not (= (caddr (info 0)) 1)))
+ (snd-display #__line__ ";with-mixed-sound info (1) 0: ~A" (info 0)))
(if (ffneq (maxamp snd) .1)
(snd-display #__line__ ";with-mixed-sound (1) 0: ~A" (maxamp snd)))
(close-sound snd)))
@@ -55988,17 +42590,18 @@ EDITS: 1
(if (or (not (list? mxs))
(not (= (length mxs) 2)))
(snd-display #__line__ ";with-mixed-sound mixes (2): ~A" mxs))
- (if (or (not (equal? (car (list-ref info 0)) (car mxs)))
- (not (= (cadr (list-ref info 0)) 0))
- (not (= (caddr (list-ref info 0)) 1)))
- (snd-display #__line__ ";with-mixed-sound info (2) 0: ~A" (list-ref info 0)))
- (if (or (not (equal? (car (list-ref info 1)) (cadr mxs)))
- (not (= (cadr (list-ref info 1)) 44100))
- (not (= (caddr (list-ref info 1)) 1)))
- (snd-display #__line__ ";with-mixed-sound info (2) 1: ~A" (list-ref info 1)))
- (if (or (not (= (frames snd) 48510))
+ (if (or (not (equal? (car (info 0)) (car mxs)))
+ (not (= (cadr (info 0)) 0))
+ (not (= (caddr (info 0)) 1)))
+ (snd-display #__line__ ";with-mixed-sound info (2) 0: ~A" (info 0)))
+ (if (or (not (equal? (car (info 1)) (cadr mxs)))
+ (not (= (cadr (info 1)) 44100))
+ (not (= (caddr (info 1)) 1)))
+ (snd-display #__line__ ";with-mixed-sound info (2) 1: ~A" (info 1)))
+ (if (or (and (not (= (framples snd) 48510))
+ (not (= (framples snd) 48511)))
(fneq (maxamp snd) .1))
- (snd-display #__line__ ";with-mixed-sound 0 (2): ~A ~A" (frames snd) (maxamp snd)))
+ (snd-display #__line__ ";with-mixed-sound 0 (2): ~A ~A" (framples snd) (maxamp snd)))
(close-sound snd)))
(let* ((res (with-mixed-sound (:channels 2 :srate 44100)
@@ -56020,92 +42623,90 @@ EDITS: 1
(snd (find-sound res))
(mxs (marks snd 0)))
(if (not (= (length mxs) 2))
- (snd-display #__line__ ";with-marked-sound marks: ~A " mxs))
- (if (not (string=? (mark-name (car mxs)) "fm-violin 0 0.1"))
- (snd-display #__line__ ";with-marked-sound name: ~A" (mark-name (car mxs))))
- (if (fneq (maxamp snd) .1)
- (snd-display #__line__ ";with-marked-sound maxamp: ~A" (maxamp snd)))
+ (snd-display #__line__ ";with-marked-sound marks: ~A " mxs)
+ (begin
+ (if (not (string=? (mark-name (car mxs)) "fm-violin 0 0.1"))
+ (snd-display #__line__ ";with-marked-sound name: ~A" (mark-name (car mxs))))
+ (if (fneq (maxamp snd) .1)
+ (snd-display #__line__ ";with-marked-sound maxamp: ~A" (maxamp snd)))))
(close-sound snd))
- (set! (hook-functions mark-click-hook) '())
- (set! (hook-functions mix-click-hook) '())
- (set! (hook-functions mix-drag-hook) '())
+ (set! (hook-functions mark-click-hook) ())
+ (set! (hook-functions mix-click-hook) ())
+ (set! (hook-functions mix-drag-hook) ())
;; generators.scm
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-ercos 100 :r 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (ercos gen)))))))
+ (outa i (ercos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";ercos: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";ercos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
- (let ((gen (make-ercos 100 :r 0.1))
- (t-env (make-env '(0 .1 1 2) :length 20000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (set! (ercos-r gen) (env t-env))
- (set! (ercos-cosh-t gen) (cosh (ercos-r gen)))
- (let ((exp-t (exp (- (ercos-r gen)))))
- (set! (ercos-offset gen) (/ (- 1.0 exp-t) (* 2.0 exp-t)))
- (set! (ercos-scaler gen) (* (sinh (ercos-r gen)) (ercos-offset gen))))
- (outa i (ercos gen)))))))
+ (let ((gen (make-ercos 100 :r 0.1)))
+ (with-let gen
+ (let ((g (curlet))
+ (t-env (make-env '(0 .1 1 2) :length 20000))
+ (poly-coeffs (mus-data osc)))
+ (do ((i 0 (+ i 1)))
+ ((= i 20000))
+ (set! r (env t-env))
+ (set! cosh-t (cosh r))
+ (float-vector-set! poly-coeffs 0 cosh-t)
+ (let ((exp-t (exp (- r))))
+ (set! offset (/ (- 1.0 exp-t) (* 2.0 exp-t)))
+ (set! scaler (* (sinh r) offset)))
+ (outa i (ercos g))))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";ercos 1: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";ercos 1 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-erssb 1000.0 0.1 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (erssb gen)))))))
+ (outa i (erssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";erssb: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";erssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-noddsin 100 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (noddsin gen)))))))
+ (outa i (noddsin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";noddsin: ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";noddsin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-noddcos 100 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (noddcos gen)))))))
+ (outa i (noddcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";noddcos: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";noddcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-noddssb 1000.0 0.1 5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (noddssb gen)))))))
+ (outa i (noddssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";noddssb: ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";noddssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-asyfm 2000.0 :ratio .1)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (outa i (asyfm-J gen)))))))
+ (outa i (asyfm-J gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";asyfm-J ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";asyfm-J max: ~A" (maxamp snd))))
@@ -56113,31 +42714,28 @@ EDITS: 1
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-asyfm 2000.0 :ratio .1 :index 1))
(r-env (make-env '(0 -4 1 -1) :length 20000)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (set! (asyfm-r gen) (env r-env))
- (outa i (asyfm-J gen)))))))
+ (set! (gen 'r) (env r-env))
+ (outa i (asyfm-J gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";asyfm-J1 ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";asyfm-J1 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-asyfm 2000.0 :ratio .1)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (outa i (asyfm-I gen)))))))
+ (outa i (asyfm-I gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";asyfm-I ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";asyfm-I max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f :statistics #t)
(let ((gen (make-nrcos 400.0 :n 5 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (nrcos gen)))))))
+ (outa i (nrcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrcos max: ~A" (maxamp snd))))
@@ -56145,7 +42743,7 @@ EDITS: 1
(let* ((res (with-sound (:clipped #f)
(let ((samps 44100)
(gen (make-noid 100.0 3 'min-peak)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(outa i (noid gen))))))
(snd (find-sound res)))
@@ -56155,7 +42753,7 @@ EDITS: 1
(let* ((res (with-sound (:clipped #f)
(let ((samps 44100)
(gen (make-noid 100.0 3 'max-peak)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(outa i (noid gen))))))
(snd (find-sound res)))
@@ -56165,71 +42763,67 @@ EDITS: 1
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nrcos 100 :n 15 :r 0.5))
(indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999)))
- (run
- (do ((i 0 (+ 1 i)))
+ (let ((set-nrcos-scaler (procedure-setter (gen 'mus-scaler))))
+ (do ((i 0 (+ i 1)))
((= i 40000))
- (set! (mus-scaler gen) (env indr))
+ (set-nrcos-scaler gen (env indr))
(outa i (nrcos gen)))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nrcos with scaler ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrcos with scaler max: ~A" (maxamp snd))))
+ ;(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrcos with scaler max: ~A" (maxamp snd)))
+ ;; this is not a new problem -- was the scaler supposed to fix maxamp?
+ )
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-ncos2 100.0 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (ncos2 gen)))))))
+ (outa i (ncos2 gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";ncos2 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";ncos2 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-ncos4 100.0 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (ncos4 gen)))))))
+ (outa i (ncos4 gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";ncos4 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";ncos4 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-npcos 100.0 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (npcos gen)))))))
+ (outa i (npcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";npcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";npcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-n1cos 100.0 :n 10)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (n1cos gen)))))))
+ (outa i (n1cos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";n1cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";n1cos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rcos 100.0 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (rcos gen)))))))
+ (outa i (rcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-bess 100.0 :n 0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (outa i (bess gen)))))))
+ (outa i (bess gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";bess ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";bess max: ~A" (maxamp snd))))
@@ -56238,10 +42832,9 @@ EDITS: 1
(let ((gen1 (make-bess 400.0 :n 1))
(gen2 (make-bess 400.0 :n 1))
(vol (make-env '(0 0 1 1 9 1 10 0) :scaler 2.0 :length 20000)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (bess gen1 (* (env vol) (bess gen2 0.0)))))))))
+ (outa i (bess gen1 (* (env vol) (bess gen2 0.0))))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";bess 1 ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";bess 1 max: ~A" (maxamp snd))))
@@ -56250,20 +42843,18 @@ EDITS: 1
(let ((gen1 (make-bess 400.0 :n 1))
(gen2 (make-oscil 400.0))
(vol (make-env '(0 1 1 0) :scaler 1.0 :length 20000)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (bess gen1 (* (env vol) (oscil gen2 0.0)))))))))
+ (outa i (bess gen1 (* (env vol) (oscil gen2 0.0))))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";bess 2 ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";bess 2 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-eoddcos 400.0 :r 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (eoddcos gen)))))))
+ (outa i (eoddcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";eoddcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";eoddcos max: ~A" (maxamp snd))))
@@ -56271,11 +42862,10 @@ EDITS: 1
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-eoddcos 400.0 :r 0.0))
(a-env (make-env '(0 0 1 1) :length 10000)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (set! (eoddcos-r gen) (env a-env))
- (outa i (eoddcos gen)))))))
+ (set! (gen 'r) (env a-env))
+ (outa i (eoddcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";eoddcos 1 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";eoddcos 1 max: ~A" (maxamp snd))))
@@ -56284,133 +42874,152 @@ EDITS: 1
(let ((gen1 (make-eoddcos 400.0 :r 0.0))
(gen2 (make-oscil 400.0))
(a-env (make-env '(0 0 1 1) :length 10000)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (set! (eoddcos-r gen1) (env a-env))
- (outa i (eoddcos gen1 (* .1 (oscil gen2)))))))))
+ (set! (gen1 'r) (env a-env))
+ (outa i (eoddcos gen1 (* .1 (oscil gen2))))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";eoddcos 2 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";eoddcos 2 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nssb 2000.0 0.05 3)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (* .3 (nssb gen))))))))
+ (outa i (* .3 (nssb gen)))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nssb ~A" snd))
(if (fneq (maxamp snd) 0.3) (snd-display #__line__ ";nssb max: ~A" (maxamp snd))))
+ (let ()
+ (define (test-nssb-0)
+ (let ((g1 (make-nssb 10.0 1.0 10))
+ (g2 (make-nssb 10.0 1.0 10)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (let ((v1 (nssb g1 1.0))
+ (v2 (nssb g2 1.0)))
+ (if (> (abs (- v1 v2)) 1e-6)
+ (snd-display #__line__ ";nssb ~D (0): ~A ~A" i v1 v2)))
+ (let ((v1 (nssb g1 0.0))
+ (v2 (nssb g2)))
+ (if (> (abs (- v1 v2)) 1e-6)
+ (snd-display #__line__ ";nssb ~D (1): ~A ~A" i v1 v2))))))
+
+ (test-nssb-0)
+ (test-nssb-0)
+
+ (define (test-nssb-1)
+ (let ((g1 (make-nssb 10.0 1.0 1.0)))
+ (nssb g1 1.0)
+ (if (not (= (g1 'fm) 1.0)) (snd-display #__line__ ";nssb 1: ~A" (g1 'fm)))
+ (nssb g1 0.0)
+ (if (not (= (g1 'fm) 0.0)) (snd-display #__line__ ";nssb 2: ~A" (g1 'fm)))
+ (nssb g1 1.0)
+ (if (not (= (g1 'fm) 1.0)) (snd-display #__line__ ";nssb 3: ~A" (g1 'fm)))
+ (nssb g1)
+ (if (not (= (g1 'fm) 0.0)) (snd-display #__line__ ";nssb 4: ~A" (g1 'fm)))
+ ))
+
+ (test-nssb-1)
+ (test-nssb-1))
+
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nrssb 2000.0 0.05 3 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (nrssb gen)))))))
+ (outa i (nrssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nrssb ~A" snd))
(if (fneq (maxamp snd) 0.777) (snd-display #__line__ ";nrssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rkcos 440.0 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rkcos gen)))))))
+ (outa i (rkcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rkcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rkcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rk!cos 440.0 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rk!cos gen)))))))
+ (outa i (rk!cos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rk!cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rk!cos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-r2k!cos 440.0 :r 0.5 :k 3.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (r2k!cos gen)))))))
+ (outa i (r2k!cos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";r2k!cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";r2k!cos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-k2sin 440.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (k2sin gen)))))))
+ (outa i (k2sin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";k2sin ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";k2sin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-k2cos 440.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (k2cos gen)))))))
+ (outa i (k2cos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";k2cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";k2cos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-k2ssb 1000.0 0.1)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (k2ssb gen)))))))
+ (outa i (k2ssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";k2ssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";k2ssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rssb 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rssb gen)))))))
+ (outa i (rssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-dblsum 100 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (dblsum gen)))))))
+ (outa i (* .47 (dblsum gen))))))) ; k starts at 0, so maxamp would be 2 except something else is wrong
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";dblsum ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";dblsum max: ~A" (maxamp snd))))
+ (if (> (maxamp snd) 1.0) (snd-display #__line__ ";dblsum max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nkssb 1000.0 0.1 5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (nkssb gen)))))))
+ (outa i (nkssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nkssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nkssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nkssb 1000.0 0.1 5))
- (vib (make-oscil 5.0))
- (vibamp (hz->radians 50.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (vib (make-polywave 5.0 (list 1 (hz->radians 50.0)) mus-chebyshev-second-kind)))
+ (do ((i 0 (+ i 1)))
((= i 30000))
- (outa i (nkssb gen (* vibamp (oscil vib)))))))))
+ (outa i (nkssb gen (polywave vib)))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nkssb 1 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nkssb 1 max: ~A" (maxamp snd))))
@@ -56418,190 +43027,170 @@ EDITS: 1
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nkssb 1000.0 0.1 5))
(move (make-env '(0 1 1 -1) :length 30000))
- (vib (make-oscil 5.0))
- (vibamp (hz->radians 50.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (vib (make-polywave 5.0 (list 1 (hz->radians 50.0)) mus-chebyshev-second-kind)))
+ (do ((i 0 (+ i 1)))
((= i 30000))
- (outa i (nkssb-interp gen (* vibamp (oscil vib)) (env move))))))))
+ (outa i (nkssb-interp gen (polywave vib) (env move)))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nkssb 2 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nkssb 2 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rkoddssb 1000.0 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rkoddssb gen)))))))
+ (outa i (rkoddssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rkoddssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rkoddssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-krksin 440.0 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (krksin gen)))))))
+ (outa i (krksin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";krksin ~A" snd)))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-abcos 100.0 0.5 0.25)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (abcos gen)))))))
+ (outa i (abcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";abcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";abcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f :statistics #t)
(let ((gen (make-absin 100.0 0.5 0.25)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (absin gen)))))))
+ (outa i (absin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";absin ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";absin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-r2k2cos 100.0 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (r2k2cos gen)))))))
+ (outa i (r2k2cos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";r2k2cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";r2k2cos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-jjcos 100.0 :a 1.0 :r 1.0 :k 1)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (jjcos gen)))))))
+ (outa i (jjcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";jjcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";jjcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-j0evencos 100.0 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (j0evencos gen)))))))
+ (outa i (j0evencos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";j0evencos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";j0evencos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rksin 100.0 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rksin gen)))))))
+ (outa i (rksin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rksin ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rksin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rkssb 1000.0 0.1 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rkssb gen)))))))
+ (outa i (rkssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rkssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rkssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rk!ssb 1000.0 0.1 :r 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rk!ssb gen)))))))
+ (outa i (rk!ssb gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rk!ssb ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rk!ssb max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-jpcos 100.0 :a 1.0 :r 0.99 :k 1)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 210000))
- (outa i (jpcos gen)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (outa i (jpcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";jpcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";jpcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-j2cos 100.0 :r 1.0 :n 0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (j2cos gen)))))))
+ (outa i (j2cos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";j2cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";j2cos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nxysin 300 1/3 3)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (nxysin gen)))))))
+ (outa i (nxysin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nxysin ~A" snd)))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nxycos 300 1/3 3)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (nxycos gen)))))))
+ (outa i (nxycos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nxycos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nxycos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nxy1cos 300 1/3 3)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (nxy1cos gen)))))))
+ (outa i (nxy1cos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nxy1cos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nxy1cos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nxy1sin 300 1/3 3)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (nxy1sin gen)))))))
+ (outa i (nxy1sin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nxy1sin ~A" snd))
(if (fneq (maxamp snd) 0.951) (snd-display #__line__ ";nxy1sin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f :statistics #t)
(let ((gen (make-nrxysin 1000 0.1 5 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 2000))
- (outa i (nrxysin gen)))))))
+ (outa i (nrxysin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nrxysin ~A" snd))
(if (fneq (maxamp snd) 0.985) (snd-display #__line__ ";nrxysin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nrxycos 1000 0.1 5 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 2000))
- (outa i (nrxycos gen)))))))
+ (outa i (nrxycos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nrxycos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrxycos max: ~A" (maxamp snd))))
@@ -56609,81 +43198,73 @@ EDITS: 1
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-nrxycos 1000 0.1 15 0.5))
(indr (make-env '(0 -1 1 1) :length 40000 :scaler 0.9999)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 40000))
(set! (mus-scaler gen) (env indr))
- (outa i (nrxycos gen)))))))
+ (outa i (nrxycos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nrxycos with scaler ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nrxycos with scaler max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((black4 (make-blackman 440.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (blackman black4 0.0)))))))
+ (outa i (blackman black4 0.0))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";blackman ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";blackman max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((black4 (make-sinc-train 440.0 10)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (sinc-train black4 0.0)))))))
+ (outa i (sinc-train black4 0.0))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";sinc-train ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";sinc-train max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-k3sin 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (k3sin gen)))))))
+ (outa i (k3sin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";k3sin ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";k3sin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f :statistics #t)
(let ((gen (make-izcos 100.0 1.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 30000))
- (outa i (izcos gen)))))))
+ (outa i (izcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";izcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";izcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rxysin 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rxysin gen)))))))
+ (outa i (* .5 (rxysin gen)))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rxysin ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rxysin max: ~A" (maxamp snd))))
+ (if (> (maxamp snd) 1.0) (snd-display #__line__ ";rxysin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rxycos 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rxycos gen)))))))
+ (outa i (rxycos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rxycos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rxycos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f :srate 44100)
(let ((gen (make-safe-rxycos 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (safe-rxycos gen)))))))
+ (outa i (safe-rxycos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";safe-rxycos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";safe-rxycos max: ~A" (maxamp snd))))
@@ -56694,15 +43275,15 @@ EDITS: 1
(let ((gen1 (make-safe-rxycos 1000 1 0.99))
(gen2 (make-safe-rxycos 1000 1 0.99))
(frqf (make-env '(0 0 1 1) :length 10000 :scaler (hz->radians 1000))))
- (set! base-r (safe-rxycos-r gen1))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (let ((fm (env frqf)))
- (set! (mus-frequency gen2) (+ 1000 (radians->hz fm)))
- (outa i (safe-rxycos gen1 fm))
- (outb i (safe-rxycos gen2 0.0))
- (set! end-r (clamp-rxycos-r gen2 0.0))))))))
+ (let ((set-freq (procedure-setter (gen2 'mus-frequency))))
+ (set! base-r (gen1 'r))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (let ((fm (env frqf)))
+ (set-freq gen2 (+ 1000 (radians->hz fm)))
+ (outa i (safe-rxycos gen1 fm))
+ (outb i (safe-rxycos gen2 0.0))
+ (set! end-r (clamp-rxycos-r gen2 0.0))))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";safe-rxycos 1 ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";safe-rxycos 1 max: ~A" (maxamp snd)))
@@ -56715,12 +43296,12 @@ EDITS: 1
(let ((gen1 (make-safe-rxycos 1000 .1 0.99))
(gen2 (make-safe-rxycos 1000 .1 0.99))
(frqf (make-env '(0 0 1 1) :length 10000 :scaler (hz->radians 1000))))
- (set! base-r (safe-rxycos-r gen1))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (let ((fm (env frqf)))
- (set! (mus-frequency gen2) (+ 1000 (radians->hz fm)))
+ (let ((set-freq (procedure-setter (gen2 'mus-frequency))))
+ (set! base-r (gen1 'r))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (let ((fm (env frqf)))
+ (set-freq gen2 (+ 1000 (radians->hz fm)))
(outa i (safe-rxycos gen1 fm))
(outb i (safe-rxycos gen2 0.0))
(set! end-r (clamp-rxycos-r gen2 0.0))))))))
@@ -56732,137 +43313,123 @@ EDITS: 1
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rxyk!sin 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rxyk!sin gen)))))))
+ (outa i (rxyk!sin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rxyk!sin ~A" snd))
- (if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";rxyk!sin max: ~A" (maxamp snd))))
+ (if (fneq (maxamp snd) 0.992) (snd-display #__line__ ";rxyk!sin max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-rxyk!cos 1000 0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (rxyk!cos gen)))))))
+ (outa i (rxyk!cos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";rxyk!cos ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";rxyk!cos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f :statistics #t :play #f)
(let ((gen (make-nsincos 100.0 3)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (outa i (nsincos gen)))))))
+ (outa i (nsincos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nsincos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";nsincos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f :play #f)
(let ((gen (make-nchoosekcos 2000.0 0.05 10)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 30000))
- (outa i (nchoosekcos gen)))))))
+ (outa i (nchoosekcos gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";nchoosekcos ~A" snd))
(if (ffneq (maxamp snd) 1.0) (snd-display #__line__ ";nchoosekcos max: ~A" (maxamp snd))))
(let* ((res (with-sound ()
(let ((gen (make-adjustable-square-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 200))
- (outa i (adjustable-square-wave gen)))))))
+ (outa i (adjustable-square-wave gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";adj sq ~A" snd))
(if (fneq (maxamp snd) 0.5) (snd-display #__line__ ";adj sq max: ~A" (maxamp snd))))
(let* ((res (with-sound ()
(let ((gen (make-adjustable-triangle-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 22050))
- (outa i (adjustable-triangle-wave gen)))))))
+ (outa i (adjustable-triangle-wave gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";adj tri ~A" snd))
(if (ffneq (maxamp snd) 0.5) (snd-display #__line__ ";adj tri max: ~A" (maxamp snd))))
(let* ((res (with-sound ()
(let ((gen (make-adjustable-sawtooth-wave 100 .2 .5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 22050))
- (outa i (adjustable-sawtooth-wave gen)))))))
+ (outa i (adjustable-sawtooth-wave gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";adj saw ~A" snd))
(if (ffneq (maxamp snd) 0.5) (snd-display #__line__ ";adj saw max: ~A" (maxamp snd))))
(with-sound (:clipped #f) ; at least run the thing -- not sure how to test this automatically
- (let* ((gen (make-pink-noise 12)))
- (run (lambda ()
- (do ((i 0 (+ 1 i)))
+ (let ((gen (make-pink-noise 12)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (pink-noise gen)))))))
+ (outa i (pink-noise gen)))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-brown-noise 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (brown-noise gen)))))))
+ (outa i (brown-noise gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";brown-noise ~A" snd))
(if (< (maxamp snd) 0.01) (snd-display #__line__ ";brown-noise max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-green-noise 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (green-noise gen)))))))
+ (outa i (green-noise gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";green-noise ~A" snd))
(if (or (< (maxamp snd) 0.01) (> (maxamp snd) 1.0)) (snd-display #__line__ ";green-noise max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-green-noise 100.0 0.1 -0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (green-noise gen)))))))
+ (outa i (green-noise gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";green-noise .5 ~A" snd))
(if (or (< (maxamp snd) 0.01) (> (maxamp snd) 0.5)) (snd-display #__line__ ";green-noise .5 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-green-noise-interp 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (green-noise-interp gen)))))))
+ (outa i (green-noise-interp gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";green-noise-interp ~A" snd))
(if (or (< (maxamp snd) 0.01) (> (maxamp snd) 1.0)) (snd-display #__line__ ";green-noise-interp max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-green-noise-interp 100.0 0.1 -0.1 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (green-noise-interp gen)))))))
+ (outa i (green-noise-interp gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";green-noise-interp .5 ~A" snd))
(if (or (< (maxamp snd) 0.01) (> (maxamp snd) 0.5)) (snd-display #__line__ ";green-noise-interp .5 max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen (make-tanhsin 440.0 2.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (outa i (tanhsin gen)))))))
+ (outa i (tanhsin gen))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";tanhsin ~A" snd))
(if (> (abs (- 1.0 (maxamp snd))) 0.1) (snd-display #__line__ ";tanhsin max: ~A" (maxamp snd))))
@@ -56871,121 +43438,104 @@ EDITS: 1
(let* ((snd (new-sound))
(rd (make-readin "oboe.snd"))
(ft (make-moving-fft rd))
- (data (make-vct 256)))
+ (data (make-float-vector 256)))
(set! (lisp-graph?) #t)
(do ((i 0 (+ i 1)))
((= i 10000))
- (moving-fft ft)
- (vct-subseq (mus-xcoeffs ft) 0 255 data)
- (graph data "fft" 0.0 11025.0 0.0 0.1 snd 0 #t))
+ (if (moving-fft ft)
+ (begin
+ (float-vector-subseq (mus-xcoeffs ft) 0 255 data)
+ (graph data "fft" 0.0 11025.0 0.0 0.1 snd 0 #t))))
(close-sound snd)))
(test-sv)
- (let* ((rd (make-readin "1a.snd"))
- (cur-srate (mus-sound-srate "1a.snd"))
- (old-srate (mus-srate)))
- (set! (mus-srate) cur-srate)
+ (let ((rd (make-readin "1a.snd"))
+ (cur-srate (mus-sound-srate "1a.snd"))
+ (old-srate *clm-srate*))
+ (set! *clm-srate* cur-srate)
(let* ((scn (make-moving-pitch rd))
(pitch (moving-pitch scn)))
(if (or (> pitch 443.0)
(< pitch 439.0))
(snd-display #__line__ ";moving-pitch 1a: ~A" pitch)))
- (set! (mus-srate) old-srate))
+ (set! *clm-srate* old-srate))
(let ((val (make-vector 3))
(frq 0.0))
- (vector-set! val 0 (make-nrcos 100))
- (vector-set! val 1 (make-nrcos 200))
- (vector-set! val 2 (make-nrcos 300))
- (run
- (lambda ()
- (set! frq (mus-frequency (vector-ref val 1)))))
+ (set! (val 0) (make-nrcos 100))
+ (set! (val 1) (make-nrcos 200))
+ (set! (val 2) (make-nrcos 300))
+ (set! frq (mus-frequency (vector-ref val 1)))
(if (fneq frq 200.0) (snd-display #__line__ ";defgen vect freq: ~A" frq)))
(let ((val (make-vector 3))
(frq 0.0))
- (vector-set! val 0 (make-nrcos 100))
- (vector-set! val 1 (make-nrcos 200))
- (vector-set! val 2 (make-nrcos 300))
- (run
- (lambda ()
- (set! frq (+ (mus-frequency (vector-ref val 0))
- (mus-frequency (vector-ref val 1))
- (mus-frequency (vector-ref val 2))))))
+ (set! (val 0) (make-nrcos 100))
+ (set! (val 1) (make-nrcos 200))
+ (set! (val 2) (make-nrcos 300))
+ (set! frq (+ (mus-frequency (vector-ref val 0))
+ (mus-frequency (vector-ref val 1))
+ (mus-frequency (vector-ref val 2))))
(if (fneq frq 600.0) (snd-display #__line__ ";defgen vect freq 1: ~A" frq)))
(let ((val (make-vector 3))
(frq 0.0))
- (vector-set! val 0 (make-nrcos 100))
- (vector-set! val 1 (make-nrcos 200))
- (vector-set! val 2 (make-nrcos 300))
- (run
- (lambda ()
- (set! (mus-frequency (vector-ref val 1)) 500.0)
- (set! frq (mus-frequency (vector-ref val 1)))))
+ (set! (val 0) (make-nrcos 100))
+ (set! (val 1) (make-nrcos 200))
+ (set! (val 2) (make-nrcos 300))
+ (set! (mus-frequency (vector-ref val 1)) 500.0)
+ (set! frq (mus-frequency (vector-ref val 1)))
(if (fneq frq 500.0) (snd-display #__line__ ";defgen set freq: ~A ~A" frq (mus-frequency (vector-ref val 1)))))
-
(let* ((res (with-sound (:clipped #f)
(let ((v (make-vector 2 #f)))
- (vector-set! v 0 (make-nrcos 440 10 .5))
- (vector-set! v 1 (make-nrcos 440 10 .5))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 1000))
- (outa i (nrcos (vector-ref v 0) 0.0))))))))
+ (set! (v 0) (make-nrcos 440 10 .5))
+ (set! (v 1) (make-nrcos 440 10 .5))
+ (do ((i 0 (+ i 1)))
+ ((= i 1000))
+ (outa i (nrcos (vector-ref v 0) 0.0))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";vect nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";vect nrcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
- (let ((val (make-vector 2))
- (frq 0.0))
- (vector-set! val 0 (make-nrcos 100 1 .1))
- (vector-set! val 1 (make-nrcos 200 1 .1))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 2000))
- (outa i (* .5 (+ (nrcos (vector-ref val 0) 0.0)
- (nrcos (vector-ref val 1) 0.0))))))))))
+ (let ((val (make-vector 2)))
+ (set! (val 0) (make-nrcos 100 1 .1))
+ (set! (val 1) (make-nrcos 200 1 .1))
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (outa i (* .5 (+ (nrcos (vector-ref val 0) 0.0)
+ (nrcos (vector-ref val 1) 0.0))))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";vect 2 nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";vect 2 nrcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((gen1 (make-nrcos 100 1 .1))
- (gen2 (make-nrcos 200 1 .1))
- (frq 0.0))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
+ (gen2 (make-nrcos 200 1 .1)))
+ (do ((i 0 (+ i 1)))
((= i 2000))
(outa i (* .5 (+ (nrcos gen1 0.0)
- (nrcos gen2 0.0))))))))))
+ (nrcos gen2 0.0))))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";no vect 2 nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";no vect 2 nrcos max: ~A" (maxamp snd))))
(let* ((res (with-sound (:clipped #f)
(let ((v (make-vector 2 #f)))
- (vector-set! v 0 (make-nrcos 440 10 .5))
- (vector-set! v 1 (make-nrcos 440 10 .5))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i 2000))
- (let ((gen (vector-ref v 0)))
- (outa i (nrcos gen)))))))))
+ (set! (v 0) (make-nrcos 440 10 .5))
+ (set! (v 1) (make-nrcos 440 10 .5))
+ (do ((i 0 (+ i 1)))
+ ((= i 2000))
+ (let ((gen (vector-ref v 0)))
+ (outa i (nrcos gen)))))))
(snd (find-sound res)))
(if (not (sound? snd)) (snd-display #__line__ ";vect let nrcos ~A" snd))
(if (fneq (maxamp snd) 1.0) (snd-display #__line__ ";vect let nrcos max: ~A" (maxamp snd))))
(with-sound (:play #t)
(let* ((exp-amt 8.0)
- (gran (make-granulate :expansion exp-amt))
(dur 2.0)
(samps (seconds->samples dur))
(ampf (make-env '(0.000 0.000 0.011 0.147 0.023 0.131 0.028 0.034 0.059 0.000 0.063 0.153 0.067 0.113
@@ -57005,4176 +43555,3783 @@ EDITS: 1
:duration 0.25 :scaler (hz->radians (* 0.5 0.205 22050.0))))
(gen1 (make-polywave :partials (list 2 .35 3 .1 4 .8 5 .01 6 .03 8 .005)))
(rnd (make-rand-interp 600 (hz->radians 50))))
- (run
- (lambda ()
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (outa i (granulate gran
- (lambda (dir)
- (* (env ampf)
- (polywave gen1 (+ (env frqf)
- (rand-interp rnd))))))))))))
-
- (let ((g (make-osc329 440.0)) (f 10.0))
- (run (lambda () (set! f (osc329 g 0.0))))
- (if (fneq f 0.0) (snd-display #__line__ ";run osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f #t))
- (run (lambda () (set! f (oscil? g))))
- (if f (snd-display #__line__ ";oscil? osc329: ~A" f)))
- (let ((g (+ 3 2)) (f #t))
- (run (lambda () (set! f (oscil? g))))
- (if f (snd-display #__line__ ";oscil? 5: ~A" f)))
- (let ((g (make-osc329 440.0)) (f #t))
- (run (lambda () (set! f (osc329? g))))
- (if (not f) (snd-display #__line__ ";osc329? osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 0.0))
- (run (lambda () (set! f (mus-frequency g))))
- (if (fneq f 440.0) (snd-display #__line__ ";mus-frequency osc329: ~A" f)))
- (let ((g123 (make-osc329 440.0)) (f 0.0))
- (run (lambda () (set! f (mus-frequency g123))))
- (if (or (not (number? f)) (fneq f 440.0)) (snd-display #__line__ ";(name) mus-frequency osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 32)) (set! f (mus-length g))
- (if (not (= f 1)) (snd-display #__line__ ";osc329 (no run) mus-length: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 32))
- (run (lambda () (set! f (mus-length g))))
- (if (not (= f 1)) (snd-display #__line__ ";osc329 mus-length: ~A" f)))
- (let ((g (make-osc329 440.0)) (f "hiho"))
- (run (lambda () (set! f (mus-name g))))
- (if (not (string=? f "osc329")) (snd-display #__line__ ";osc329 mus-name: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 1.0))
- (run (lambda () (set! f (mus-phase g))))
- (if (fneq f 0.0) (snd-display #__line__ ";mus-phase osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 1.0))
- (run (lambda () (set! (mus-phase g) f)))
- (if (fneq (mus-phase g) 1.0) (snd-display #__line__ ";set mus-phase osc329: ~A" (mus-phase g))))
- (let ((g (make-osc329 440.0)) (f "hiho"))
- (run (lambda () (set! f (mus-describe g))))
- (if (not (string? f)) (snd-display #__line__ ";osc329 mus-describe: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 0.0))
- (run (lambda () (set! f (mus-increment g))))
- (if (fneq f 1.0) (snd-display #__line__ ";mus-increment osc329: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 32))
- (run (lambda () (set! (mus-length g) f)))
- (if (not (= (mus-length g) 32)) (snd-display #__line__ ";osc329 set mus-length: ~A" (mus-length g))))
- (let ((g (make-osc329 440.0)) (f 440.0))
- (run (lambda () (set! (mus-frequency g) 100.0) (set! f (mus-frequency g))))
- (if (fneq f 100.0) (snd-display #__line__ ";osc329 set mus-frequency: ~A" (mus-frequency g))))
- (let ((g (make-osc329 440.0)) (f 440.0))
- (run (lambda () (set! (mus-increment g) 100.0) (set! f (mus-increment g))))
- (if (fneq f 100.0) (snd-display #__line__ ";osc329 set mus-increment: ~A" (mus-increment g))))
- (let ((g (make-osc329 440.0)) (f 32))
- (run (lambda () (set! f (mus-hop g))))
- (if (not (= f 1)) (snd-display #__line__ ";osc329 mus-hop: ~A" f)))
- (let ((g (make-osc329 440.0)) (f 32))
- (run (lambda () (set! (mus-hop g) f)))
- (if (not (= (mus-hop g) 32)) (snd-display #__line__ ";osc329 set mus-hop: ~A" (mus-hop g))))
-
- (if (not (provided? 'gmp))
- (set! nearly-zero 1.0e-8)) ; in case floats
- (let ((test-zero-stability
- (lambda (make-func run-func zero)
- (let ((gen (make-func)))
- (set! (mus-phase gen) zero)
- (let ((zero-val (run-func gen zero)))
- (for-each
- (lambda (val)
- (set! gen (make-func)) ; remake else carrier drifts away in ssb cases
- (set! (mus-phase gen) (+ zero val))
- (let ((new-val (run-func gen 0.0)))
- (if (> (abs (- new-val zero-val)) .01)
- (snd-display #__line__ ";~A:~%; zero check at (+ ~A ~A): ~A ~A~%" gen zero val zero-val new-val))))
- (list 1.0e-11 1.0e-10 1.0e-9 1.0e-8 1.0e-7 1.0e-6
- -1.0e-11 -1.0e-10 -1.0e-9 -1.0e-8 -1.0e-7 -1.0e-6)))))))
-
- (for-each
- (lambda (zero)
- (test-zero-stability (lambda () (make-oscil 0.0)) oscil zero)
-
- (for-each
- (lambda (n)
- (test-zero-stability (lambda () (make-nsin 0.0 n)) nsin zero)
- (test-zero-stability (lambda () (make-ncos 0.0 n)) ncos zero)
-
- (test-zero-stability (lambda () (make-nrxysin :n n)) nrxysin zero)
- (test-zero-stability (lambda () (make-nrxycos :n n)) nrxycos zero)
- (test-zero-stability (lambda () (make-nrxysin :n n :r .999999)) nrxysin zero)
- (test-zero-stability (lambda () (make-nrxycos :n n :r .999999)) nrxycos zero)
-
- (test-zero-stability (lambda () (make-nssb 0.0 1.0 n)) nssb zero)
- (test-zero-stability (lambda () (make-noddssb 0.0 1.0 n)) noddssb zero)
- (test-zero-stability (lambda () (make-nrssb 0.0 1.0 n)) nrssb zero)
- (test-zero-stability (lambda () (make-nxycos 0.0 1.0 :n n)) nxycos zero)
- (test-zero-stability (lambda () (make-nxy1cos 0.0 1.0 :n n)) nxy1cos zero)
- (test-zero-stability (lambda () (make-nxysin 0.0 1.0 :n n)) nxysin zero)
-
- (test-zero-stability (lambda () (make-nssb 0.0 1.0 n)) nssb zero)
- (test-zero-stability (lambda () (make-noddssb 0.0 1.0 n)) noddssb zero)
- (test-zero-stability (lambda () (make-nrssb 0.0 1.0 n)) nrssb zero)
- (test-zero-stability (lambda () (make-nxycos 0.0 1.0 :n n)) nxycos zero)
- (test-zero-stability (lambda () (make-nxy1cos 0.0 1.0 :n n)) nxy1cos zero)
- (test-zero-stability (lambda () (make-nxysin 0.0 1.0 :n n)) nxysin zero)
-
- (test-zero-stability (lambda () (make-nkssb 0.0 1.0 n)) nkssb zero)
- (test-zero-stability (lambda () (make-nkssb 0.0 1.0 n)) nkssb zero)
-
- (test-zero-stability (lambda () (make-noddsin :n n)) noddsin zero)
- (test-zero-stability (lambda () (make-noddcos :n n)) noddcos zero)
- (test-zero-stability (lambda () (make-ncos2 :n n)) ncos2 zero)
- (test-zero-stability (lambda () (make-npcos :n n)) npcos zero)
- (test-zero-stability (lambda () (make-n1cos :n n)) n1cos zero)
- (test-zero-stability (lambda () (make-nrcos :n n)) nrcos zero))
- (list 1 10 3 30))
-
- (test-zero-stability (lambda () (make-krksin :r 0.1)) krksin zero)
- (test-zero-stability (lambda () (make-k2sin)) k2sin zero)
- (test-zero-stability (lambda () (make-k2cos)) k2cos zero)
- (test-zero-stability (lambda () (make-k2ssb 0.0 1.0)) k2ssb zero)
- (test-zero-stability (lambda () (make-abcos :a 1.0 :b 0.5)) abcos zero)
- (test-zero-stability (lambda () (make-absin :a 1.0 :b 0.5)) absin zero)
-
- (for-each
- (lambda (r)
- (test-zero-stability (lambda () (make-rcos :r r)) rcos zero)
- (test-zero-stability (lambda () (make-ercos :r r)) ercos zero)
- ;(test-zero-stability (lambda () (make-r2sin :r r)) r2sin zero)
- ;(test-zero-stability (lambda () (make-r2cos :r r)) r2cos zero)
- (test-zero-stability (lambda () (make-eoddcos :r r)) eoddcos zero)
- (test-zero-stability (lambda () (make-rkcos :r r)) rkcos zero)
- (test-zero-stability (lambda () (make-rksin :r r)) rksin zero)
- (test-zero-stability (lambda () (make-rk!cos :r r)) rk!cos zero)
- (test-zero-stability (lambda () (make-r2k!cos :r r)) r2k!cos zero)
- (test-zero-stability (lambda () (make-r2k2cos :r r)) r2k2cos zero)
-
- (test-zero-stability (lambda () (make-nrxysin :n 3 :r r)) nrxysin zero)
- (test-zero-stability (lambda () (make-nrxycos :n 3 :r r)) nrxycos zero)
-
- (test-zero-stability (lambda () (make-rssb 0.0 1.0 :r r)) rssb zero)
- (test-zero-stability (lambda () (make-erssb 0.0 1.0 :r r)) erssb zero)
- (test-zero-stability (lambda () (make-rkssb 0.0 1.0 :r r)) rkssb zero)
- (test-zero-stability (lambda () (make-rk!ssb 0.0 1.0 :r r)) rk!ssb zero)
- (test-zero-stability (lambda () (make-rkoddssb 0.0 1.0 :r r)) rkoddssb zero)
- ;(test-zero-stability (lambda () (make-r2ssb 0.0 1.0 :r r)) r2ssb zero)
-
- (test-zero-stability (lambda () (make-rssb 0.0 1.0 :r r)) rssb zero)
- (test-zero-stability (lambda () (make-erssb 0.0 1.0 :r r)) erssb zero)
- (test-zero-stability (lambda () (make-rkssb 0.0 1.0 :r r)) rkssb zero)
- (test-zero-stability (lambda () (make-rk!ssb 0.0 1.0 :r r)) rk!ssb zero)
- (test-zero-stability (lambda () (make-rkoddssb 0.0 1.0 :r r)) rkoddssb zero)
- ;(test-zero-stability (lambda () (make-r2ssb 0.0 1.0 :r r)) r2ssb zero)
- )
- (list 0.1 0.5 .99 .999)))
- (list 0.0 (* 0.5 pi) pi (* 2.0 pi) (* -0.5 pi) (- pi) (* -2.0 pi) (* 1.5 pi) (* -1.5 pi))))
-
+ (define (ifunc dir)
+ (* (env ampf)
+ (polywave gen1 (+ (env frqf)
+ (rand-interp rnd)))))
+ (let ((gran (make-granulate :expansion exp-amt :input ifunc)))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (granulate gran))))))
+
(calling-all-animals)
(calling-all-generators)
- (let ((funcs (list nssb nxysin nxycos nxy1cos nxy1sin noddsin noddcos noddssb ncos2 npcos
- nrsin nrcos nrssb nkssb nsincos rcos rssb rxysin rxycos
- rxyk!sin rxyk!cos ercos erssb eoddcos rkcos rksin rkssb
- rk!cos rk!ssb r2k!cos k2sin k2cos k2ssb dblsum rkoddssb krksin
- abcos absin r2k2cos bess jjcos j0evencos j2cos jpcos jncos
- j0j1cos jycos blackman fmssb k3sin izcos
- adjustable-square-wave adjustable-triangle-wave adjustable-sawtooth-wave adjustable-oscil
- round-interp))
- (make-funcs (list make-nssb make-nxysin make-nxycos make-nxy1cos make-nxy1sin make-noddsin make-noddcos make-noddssb make-ncos2 make-npcos
- make-nrsin make-nrcos make-nrssb make-nkssb make-nsincos make-rcos make-rssb make-rxysin make-rxycos
- make-rxyk!sin make-rxyk!cos make-ercos make-erssb make-eoddcos make-rkcos make-rksin make-rkssb
- make-rk!cos make-rk!ssb make-r2k!cos make-k2sin make-k2cos make-k2ssb make-dblsum make-rkoddssb make-krksin
- make-abcos make-absin make-r2k2cos make-bess make-jjcos make-j0evencos make-j2cos make-jpcos make-jncos
- make-j0j1cos make-jycos make-blackman make-fmssb make-k3sin make-izcos
- make-adjustable-square-wave make-adjustable-triangle-wave make-adjustable-sawtooth-wave make-adjustable-oscil
- make-round-interp))
- (pfuncs (list nssb? nxysin? nxycos? nxy1cos? nxy1sin? noddsin? noddcos? noddssb? ncos2? npcos?
- nrsin? nrcos? nrssb? nkssb? nsincos? rcos? rssb? rxysin? rxycos?
- rxyk!sin? rxyk!cos? ercos? erssb? eoddcos? rkcos? rksin? rkssb?
- rk!cos? rk!ssb? r2k!cos? k2sin? k2cos? k2ssb? dblsum? rkoddssb? krksin?
- abcos? absin? r2k2cos? bess? jjcos? j0evencos? j2cos? jpcos? jncos?
- j0j1cos? jycos? blackman? fmssb? k3sin? izcos?
- adjustable-square-wave? adjustable-triangle-wave? adjustable-sawtooth-wave? adjustable-oscil?
- round-interp?))
- (names (list 'nssb 'nxysin 'nxycos 'nxy1cos 'nxy1sin 'noddsin 'noddcos 'noddssb 'ncos2 'npcos
- 'nrsin 'nrcos 'nrssb 'nkssb 'nsincos 'rcos 'rssb 'rxysin 'rxycos
- 'rxyk!sin 'rxyk!cos 'ercos 'erssb 'eoddcos 'rkcos 'rksin 'rkssb
- 'rk!cos 'rk!ssb 'r2k!cos 'k2sin 'k2cos 'k2ssb 'dblsum 'rkoddssb 'krksin
- 'abcos 'absin 'r2k2cos 'bess 'jjcos 'j0evencos 'j2cos 'jpcos 'jncos
- 'j0j1cos 'jycos 'blackman 'fmssb 'k3sin 'izcos
- 'adjustable-square-wave 'adjustable-triangle-wave 'adjustable-sawtooth-wave 'adjustable-oscil
- 'round-interp))
- (methods (list nssb-methods nxysin-methods nxycos-methods nxy1cos-methods nxy1sin-methods
- noddsin-methods noddcos-methods noddssb-methods ncos2-methods npcos-methods
- nrsin-methods nrcos-methods nrssb-methods nkssb-methods nsincos-methods
- rcos-methods rssb-methods rxysin-methods rxycos-methods
- rxyk!sin-methods rxyk!cos-methods ercos-methods erssb-methods
- eoddcos-methods rkcos-methods rksin-methods rkssb-methods
- rk!cos-methods rk!ssb-methods r2k!cos-methods k2sin-methods k2cos-methods k2ssb-methods
- dblsum-methods rkoddssb-methods krksin-methods
- abcos-methods absin-methods r2k2cos-methods bess-methods
- jjcos-methods j0evencos-methods j2cos-methods jpcos-methods jncos-methods
- j0j1cos-methods jycos-methods blackman-methods fmssb-methods k3sin-methods izcos-methods
- adjustable-square-wave-methods adjustable-triangle-wave-methods
- adjustable-sawtooth-wave-methods adjustable-oscil-methods
- round-interp-methods))
- )
-
-
+ (let ()
+ (define gen-list (list make-nssb make-nxysin make-nxycos make-nxy1cos make-nxy1sin make-noddsin make-noddcos make-noddssb make-ncos2 make-npcos
+ make-nrsin make-nrcos make-nrssb make-nkssb make-nsincos make-rcos make-rssb make-rxysin make-rxycos
+ make-rxyk!sin make-rxyk!cos make-ercos make-erssb make-eoddcos make-rkcos make-rksin make-rkssb
+ make-rk!cos make-rk!ssb make-r2k!cos make-k2sin make-k2cos make-k2ssb make-dblsum make-rkoddssb make-krksin
+ make-abcos make-absin make-r2k2cos make-bess make-jjcos make-j0evencos make-j2cos make-jpcos make-jncos
+ make-j0j1cos make-jycos make-blackman make-fmssb make-k3sin make-izcos make-nchoosekcos make-n1cos
+ make-adjustable-square-wave make-adjustable-triangle-wave make-adjustable-sawtooth-wave make-adjustable-oscil
+ make-round-interp make-sinc-train make-pink-noise make-green-noise make-brown-noise make-green-noise-interp
+ make-moving-max make-moving-norm make-moving-sum make-moving-rms make-moving-length
+ make-weighted-moving-average make-exponentially-weighted-moving-average
+ make-tanhsin
+ (lambda args
+ (make-moving-fft (make-readin "oboe.snd")))
+ make-moving-scentroid
+ (lambda args
+ (make-moving-autocorrelation (make-readin "oboe.snd")))
+ (lambda args
+ (make-moving-pitch (make-readin "oboe.snd")))))
(for-each
- (lambda (mf rf pf name mth)
- (let ((gen (mf)))
- (if (not (pf gen))
- (snd-display #__line__ ";make-* generators ~A: ~A" name gen))
- (if (not (mus-generator? gen))
- (snd-display #__line__ ";make-* generators mus-generator? ~A" gen))
- (rf gen 0.0)
- (mus-run gen 0.0 0.0)
- (mus-reset gen)
- (if (not (string=? (mus-name gen) (symbol->string name)))
- (snd-display #__line__ ";mus-name generators: ~A ~A" (mus-name gen) (symbol->string name)))
- (let* ((has-freq (assoc 'mus-frequency (mth)))
- (has-n (and (assoc 'mus-order (mth))
- (pf (catch #t (lambda () (mf :n 3)) (lambda args (car args))))))
- (has-r (and (assoc 'mus-scaler (mth))
- (pf (catch #t (lambda () (mf :r 0.75)) (lambda args (car args)))))))
- (if has-freq
- (begin
- (set! gen (mf :frequency 440.0))
- (if (fneq (mus-frequency gen) 440.0)
- (snd-display #__line__ ";mus-frequency from make-~A: ~A" name (mus-frequency gen)))))
- (if has-n
- (begin
- (set! gen (mf :n 3))
- (if (not (= (mus-order gen) 3))
- (snd-display #__line__ ";mus-order from make-~A: ~A" name (mus-order gen)))))
- (if has-r
- (begin
- (set! gen (mf :r 0.75))
- (if (fneq (mus-scaler gen) 0.75)
- (snd-display #__line__ ";mus-scaler from make-~A: ~A" name (mus-scaler gen))))))))
+ (lambda (name maker isit run)
+ (let ((gen (maker)))
+ (if (not (isit gen))
+ (format *stderr* ";~A is not a ~A?" gen name))
+ (run gen)
+ (run gen)))
- make-funcs funcs pfuncs names methods))
-
-
- (for-each
- (lambda (name maker methods isit)
- (let ((gen (maker)))
- (if (not (isit gen))
- (format #t "~A is not a ~A?" gen name)
- (let* ((funcs (methods)))
- (if (null? funcs)
- (format #t "A has no methods?" name)
- (for-each
- (lambda (method)
- (let ((method-name (car method)))
- (catch #t
- (lambda ()
- (let ((curval (if (not (eq? method-name 'mus-run)) ((cadr method) gen) #f)))
- (if (not (null? (cddr method)))
- (begin
- (if (eq? method-name 'mus-name)
- (set! (mus-name gen) "hiho")
- (if (eq? method-name 'mus-n)
- (set! (mus-n gen) 1)
- ((caddr method) gen 10.0)))))))
- (lambda args
- (format #t "error in ~A~%" (car method))
- #f))))
- funcs))))))
-
- (list 'nssb 'nxysin 'nxycos 'nxy1cos 'nxy1sin 'noddsin 'noddcos 'noddssb 'ncos2 'npcos
- nrsin 'nrcos 'nrssb 'nkssb 'nsincos 'rcos 'rssb 'rxysin 'rxycos
- rxyk!sin 'rxyk!cos 'ercos 'erssb 'eoddcos 'rkcos 'rksin 'rkssb
- rk!cos 'rk!ssb 'r2k!cos 'k2sin 'k2cos 'k2ssb 'dblsum 'rkoddssb 'krksin
- abcos 'absin 'r2k2cos 'bess 'jjcos 'j0evencos 'j2cos 'jpcos 'jncos
- j0j1cos 'jycos 'blackman 'fmssb 'k3sin 'izcos 'nchoosekcos 'n1cos
- adjustable-square-wave 'adjustable-triangle-wave 'adjustable-sawtooth-wave 'adjustable-oscil
- round-interp 'sinc-train 'pink-noise 'green-noise 'brown-noise 'green-noise-interp
- moving-max 'moving-sum 'moving-rms 'moving-length 'weighted-moving-average 'exponentially-weighted-moving-average
- tanhsin 'moving-fft 'moving-scentroid 'moving-autocorrelation 'moving-pitch)
-
- (list make-nssb make-nxysin make-nxycos make-nxy1cos make-nxy1sin make-noddsin make-noddcos make-noddssb make-ncos2 make-npcos
- make-nrsin make-nrcos make-nrssb make-nkssb make-nsincos make-rcos make-rssb make-rxysin make-rxycos
- make-rxyk!sin make-rxyk!cos make-ercos make-erssb make-eoddcos make-rkcos make-rksin make-rkssb
- make-rk!cos make-rk!ssb make-r2k!cos make-k2sin make-k2cos make-k2ssb make-dblsum make-rkoddssb make-krksin
- make-abcos make-absin make-r2k2cos make-bess make-jjcos make-j0evencos make-j2cos make-jpcos make-jncos
- make-j0j1cos make-jycos make-blackman make-fmssb make-k3sin make-izcos make-nchoosekcos make-n1cos
- make-adjustable-square-wave make-adjustable-triangle-wave make-adjustable-sawtooth-wave make-adjustable-oscil
- make-round-interp make-sinc-train make-pink-noise make-green-noise make-brown-noise make-green-noise-interp
- make-moving-max make-moving-sum make-moving-rms make-moving-length make-weighted-moving-average make-exponentially-weighted-moving-average
- make-tanhsin make-moving-fft make-moving-scentroid make-moving-autocorrelation make-moving-pitch)
-
- (list nssb-methods nxysin-methods nxycos-methods nxy1cos-methods nxy1sin-methods noddsin-methods noddcos-methods noddssb-methods ncos2-methods npcos-methods
- nrsin-methods nrcos-methods nrssb-methods nkssb-methods nsincos-methods rcos-methods rssb-methods rxysin-methods rxycos-methods
- rxyk!sin-methods rxyk!cos-methods ercos-methods erssb-methods eoddcos-methods rkcos-methods rksin-methods rkssb-methods
- rk!cos-methods rk!ssb-methods r2k!cos-methods k2sin-methods k2cos-methods k2ssb-methods dblsum-methods rkoddssb-methods krksin-methods
- abcos-methods absin-methods r2k2cos-methods bess-methods jjcos-methods j0evencos-methods j2cos-methods jpcos-methods jncos-methods
- j0j1cos-methods jycos-methods blackman-methods fmssb-methods k3sin-methods izcos-methods nchoosekcos-methods n1cos-methods
- adjustable-square-wave-methods adjustable-triangle-wave-methods adjustable-sawtooth-wave-methods adjustable-oscil-methods
- round-interp-methods sinc-train-methods pink-noise-methods green-noise-methods brown-noise-methods green-noise-interp-methods
- moving-max-methods moving-sum-methods moving-rms-methods moving-length-methods weighted-moving-average-methods exponentially-weighted-moving-average-methods
- tanhsin-methods moving-fft-methods moving-scentroid-methods moving-autocorrelation-methods moving-pitch-methods)
-
- (list nssb? nxysin? nxycos? nxy1cos? nxy1sin? noddsin? noddcos? noddssb? ncos2? npcos?
- nrsin? nrcos? nrssb? nkssb? nsincos? rcos? rssb? rxysin? rxycos?
- rxyk!sin? rxyk!cos? ercos? erssb? eoddcos? rkcos? rksin? rkssb?
- rk!cos? rk!ssb? r2k!cos? k2sin? k2cos? k2ssb? dblsum? rkoddssb? krksin?
- abcos? absin? r2k2cos? bess? jjcos? j0evencos? j2cos? jpcos? jncos?
- j0j1cos? jycos? blackman? fmssb? k3sin? izcos? nchoosekcos? n1cos?
- adjustable-square-wave? adjustable-triangle-wave? adjustable-sawtooth-wave? adjustable-oscil?
- round-interp? sinc-train? pink-noise? green-noise? brown-noise? green-noise-interp?
- moving-max? moving-sum? moving-rms? moving-length? weighted-moving-average? exponentially-weighted-moving-average?
- tanhsin? moving-fft? moving-scentroid? moving-autocorrelation? moving-pitch? )
- )
-
+ (list 'nssb 'nxysin 'nxycos 'nxy1cos 'nxy1sin 'noddsin 'noddcos 'noddssb 'ncos2 'npcos
+ 'nrsin 'nrcos 'nrssb 'nkssb 'nsincos 'rcos 'rssb 'rxysin 'rxycos
+ 'rxyk!sin 'rxyk!cos 'ercos 'erssb 'eoddcos 'rkcos 'rksin 'rkssb
+ 'rk!cos 'rk!ssb 'r2k!cos 'k2sin 'k2cos 'k2ssb 'dblsum 'rkoddssb 'krksin
+ 'abcos 'absin 'r2k2cos 'bess 'jjcos 'j0evencos 'j2cos 'jpcos 'jncos
+ 'j0j1cos 'jycos 'blackman 'fmssb 'k3sin 'izcos 'nchoosekcos 'n1cos
+ 'adjustable-square-wave 'adjustable-triangle-wave 'adjustable-sawtooth-wave 'adjustable-oscil
+ 'round-interp 'sinc-train 'pink-noise 'green-noise 'brown-noise 'green-noise-interp
+ 'moving-max 'moving-norm 'moving-sum 'moving-rms 'moving-length 'weighted-moving-average 'exponentially-weighted-moving-average
+ 'tanhsin 'moving-fft 'moving-scentroid 'moving-autocorrelation 'moving-pitch
+ )
+ gen-list
+
+ (list nssb? nxysin? nxycos? nxy1cos? nxy1sin? noddsin? noddcos? noddssb? ncos2? npcos?
+ nrsin? nrcos? nrssb? nkssb? nsincos? rcos? rssb? rxysin? rxycos?
+ rxyk!sin? rxyk!cos? ercos? erssb? eoddcos? rkcos? rksin? rkssb?
+ rk!cos? rk!ssb? r2k!cos? k2sin? k2cos? k2ssb? dblsum? rkoddssb? krksin?
+ abcos? absin? r2k2cos? bess? jjcos? j0evencos? j2cos? jpcos? jncos?
+ j0j1cos? jycos? blackman? fmssb? k3sin? izcos? nchoosekcos? n1cos?
+ adjustable-square-wave? adjustable-triangle-wave? adjustable-sawtooth-wave? adjustable-oscil?
+ round-interp? sinc-train? pink-noise? green-noise? brown-noise? green-noise-interp?
+ moving-max? moving-norm? moving-sum? moving-rms? moving-length? weighted-moving-average? exponentially-weighted-moving-average?
+ tanhsin? moving-fft? moving-scentroid? moving-autocorrelation? moving-pitch? )
+
+ (list nssb nxysin nxycos nxy1cos nxy1sin noddsin noddcos noddssb ncos2 npcos
+ nrsin nrcos nrssb nkssb nsincos rcos rssb rxysin rxycos
+ rxyk!sin rxyk!cos ercos erssb eoddcos rkcos rksin rkssb
+ rk!cos rk!ssb r2k!cos k2sin k2cos k2ssb dblsum rkoddssb krksin
+ abcos absin r2k2cos bess jjcos j0evencos j2cos jpcos jncos
+ j0j1cos jycos blackman fmssb k3sin izcos nchoosekcos n1cos
+ adjustable-square-wave adjustable-triangle-wave adjustable-sawtooth-wave adjustable-oscil
+ round-interp sinc-train pink-noise green-noise brown-noise green-noise-interp
+ moving-max moving-norm
+ (lambda (g)
+ (moving-sum g 0.0))
+ (lambda (g)
+ (moving-rms g 0.0))
+ (lambda (g)
+ (moving-length g 0.0))
+ (lambda (g)
+ (weighted-moving-average g 0.0))
+ exponentially-weighted-moving-average
+ tanhsin moving-fft moving-scentroid moving-autocorrelation moving-pitch
+ )))
(let ((gen1 (make-oscil 440.0))
(gen2 (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (let* ((pm (- 1.0 (random 2.0)))
+ (let* ((pm (mus-random 1.0))
(val1 (oscil gen1 0.0 pm))
- (val2 (run-with-fm-and-pm gen2 0.0 pm)))
+ (val2 (run-with-fm-and-pm gen2 0.0 pm))) ; generators.scm
(if (fneq val1 val2)
(snd-display #__line__ ";run-with-fm-and-pm: ~A ~A" val1 val2)))))
(let ((gen1 (make-oscil 440.0))
(gen2 (make-oscil 440.0))
(happy #t))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((or (not happy)
(= i 1000)))
- (let* ((pm (- 1.0 (random 2.0)))
+ (let* ((pm (mus-random 1.0))
(val1 (oscil gen1 0.0 pm))
(val2 (run-with-fm-and-pm gen2 0.0 pm)))
(if (fneq val1 val2)
- (set! happy #f)))))
+ (set! happy #f))))
(if (not happy)
(snd-display #__line__ ";run-with-fm-and-pm unhappy")))
- (set! (mus-srate) 44100)
- (let ((gen (make-nssb 440.0 :n 3))
- (order 0)
- (frequency 0.0)
- (val 0.0)
- (name "hiho"))
- (run
- (lambda ()
- (set! order (mus-order gen))
- (set! frequency (mus-frequency gen))
- (nssb gen 1.0)
- (set! val (mus-run gen 0.0 0.0))
- (set! name (mus-name gen))
- ))
- (if (not (string=? name "nssb")) (snd-display #__line__ ";run mus-name nssb: ~A" name))
- (if (not (= order 3)) (snd-display #__line__ ";run mus-order nssb: ~A" order))
- (if (fneq frequency 440.0) (snd-display #__line__ ";run mus-frequency nssb: ~A" frequency))
- (if (fneq val 0.371) (snd-display #__line__ ";run mus-run nssb: ~A" val)))
-
- ;; mus-reset and mus-describe in this case have an embedded for-each, so not optimizable
-
- (let ((gen (make-oscil 123.0)))
- (set! (mus-name gen) "oscil123")
- (if (not (string=? (mus-name gen) "oscil123")) (snd-display #__line__ ";set mus-name oscil123: ~A" (mus-name gen)))
- (set! (mus-name gen) "another-name")
- (if (not (string=? (mus-name gen) "another-name")) (snd-display #__line__ ";set mus-name again: ~A" (mus-name gen)))
- (let ((descr (mus-describe gen)))
- (if (not (string=? descr "another-name freq: 123.000Hz, phase: 0.000"))
- (snd-display #__line__ ";set mus-name describe: ~A" descr))))
-
- (let ((gen (make-nssb 123.0)))
- (set! (mus-name gen) "nssb123")
- (if (not (string=? (mus-name gen) "nssb123")) (snd-display #__line__ ";set mus-name nssb123: ~A" (mus-name gen)))
- (set! (mus-name gen) "another-name")
- (if (not (string=? (mus-name gen) "another-name")) (snd-display #__line__ ";set mus-name nssb again: ~A" (mus-name gen)))
- (set! (mus-frequency gen) 0.0)
- (let ((descr (mus-describe gen)))
- (if (not (string=? descr "another-name frequency: 0.0, ratio: 1.0, n: 1, angle: 0.0"))
- (snd-display #__line__ ";set mus-name nssb describe: ~A" descr))))
-
- (let ((gen (make-oscil 123.0))
- (gen1 (make-oscil 440.0)))
- (set! (mus-name gen) "oscil123")
- (set! (mus-name gen1) "440")
- (if (not (string=? (mus-name gen) "oscil123")) (snd-display #__line__ ";set mus-name oscil123 1: ~A" (mus-name gen)))
- (if (not (string=? (mus-name gen1) "440")) (snd-display #__line__ ";set mus-name oscil 440 1: ~A" (mus-name gen)))
- (set! (mus-name gen1) "another-name")
- (if (not (string=? (mus-name gen1) "another-name")) (snd-display #__line__ ";set mus-name again 1: ~A" (mus-name gen)))
- (if (not (string=? (mus-name gen) "oscil123")) (snd-display #__line__ ";set mus-name oscil123 2: ~A" (mus-name gen)))
- (let ((descr (mus-describe gen1)))
- (if (not (string=? descr "another-name freq: 440.000Hz, phase: 0.000"))
- (snd-display #__line__ ";set mus-name describe 1: ~A" descr))))
-
- (let ((gen (make-nssb 123.0))
- (gen1 (make-nssb 440.0)))
- (set! (mus-name gen) "nssb123")
- (set! (mus-name gen1) "440")
- (if (not (string=? (mus-name gen) "nssb123")) (snd-display #__line__ ";set mus-name nssb123 1: ~A" (mus-name gen)))
- (if (not (string=? (mus-name gen1) "440")) (snd-display #__line__ ";set mus-name nssb 440 1: ~A" (mus-name gen)))
- (set! (mus-name gen) "another-name")
- (if (not (string=? (mus-name gen) "another-name")) (snd-display #__line__ ";set mus-name nssb again 1: ~A" (mus-name gen)))
- (set! (mus-frequency gen) 0.0)
- (let ((descr (mus-describe gen)))
- (if (not (string=? descr "another-name frequency: 0.0, ratio: 1.0, n: 1, angle: 0.0"))
- (snd-display #__line__ ";set mus-name nssb describe 1: ~A" descr))))
-
-
- (if (not (null? (sounds))) (for-each close-sound (sounds)))
- (set! (optimization) old-opt-23)
+ (if (pair? (sounds)) (for-each close-sound (sounds)))
(test-documentation-instruments) ; clm23.scm
-
- (if #f
- (let ((outfile "/home/bil/test/sound/big3.snd"))
- (if (file-exists? outfile)
- (delete-file outfile))
- (for-each
- (lambda (ht)
- (with-sound (:output outfile :srate 44100 :channels 2 :header-type ht)
- (do ((i 0 (+ i 1)))
- ((= i 30000))
- (fm-violin i .1 440 (+ .1 (* (/ i 30000.0) .9)))))
- (if (not (file-exists? outfile))
- (snd-display #__line__ ";big3 ~A not written?" (mus-header-type-to-string ht))
- (let ((snd (find-sound outfile)))
- (if (> (abs (- (frames snd 0) (* 30000 44100))) 44100)
- (snd-display #__line__ ";big3 frames: ~A, should be ~A (~A)" (frames snd 0) (* 30000 44100) (- (frames snd 0) (* 30000 44100))))
- (if (< (maxamp snd ) .97)
- (snd-display #__line__ ";big3 max: ~A" (maxamp snd)))
- (if (and (= ht mus-riff)
- (not (= (header-type snd) mus-rf64)))
- (snd-display #__line__ ";big3 auto convert? ~A -> ~A" (mus-header-type-to-string ht) (mus-header-type-to-string (header-type snd))))
- (close-sound snd))))
- (list mus-next mus-caff))
-
- (if (file-exists? outfile)
- (delete-file outfile))))
-
)
-(define (snd_test_24)
- #f
- )
-
+;;; ---------------- test 23: X/Xt/Xm --------------------
+(define (snd_test_23)
-;;; ---------------- test 25: X/Xt/Xm --------------------
-(define (snd_test_25)
- (define (x->snd-color color-name)
- "(x->snd-color color-name) returns a Snd color object corresponding to the X11 color name 'color-name'"
- (let* ((col (XColor))
- (dpy (XtDisplay (cadr (main-widgets))))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr)))
- (if (= (XAllocNamedColor dpy cmap color-name col col) 0)
- (snd-error (format #f "can't allocate ~A" color-name))
- (make-color-with-catch (/ (.red col) 65535.0)
- (/ (.green col) 65535.0)
- (/ (.blue col) 65535.0)))))
-
- (define (snd-test-clean-string str)
- ;; full file name should be unique, so I think we need only fix it up to look like a flat name
- (let* ((len (string-length str))
- (new-str (make-string len #\.)))
- (do ((i 0 (+ 1 i)))
- ((= i len) new-str)
- (let ((c (string-ref str i)))
- (if (or (char=? c #\\)
- (char=? c #\/))
- (string-set! new-str i #\_)
- (string-set! new-str i c))))))
-
- (define (tagged-p val sym) (or (eq? val #f) (and (list? val) (not (null? val)) (eq? (car val) sym))))
- (define (array-p val type) (and (list? val) (or (null? val) (type (car val)))))
- (define (XM_INT val) (integer? val))
- (define (XM_ULONG val) (and (integer? val) (>= val 0)))
- (define (XM_UCHAR val) (or (char? val) (and (integer? val) (>= val 0) (< val 65536))))
- (define (XM_FLOAT val) (real? val))
- (define (XM_STRING val) (or (eq? val #f) (string? val) (and (number? val) (= val 0))))
- (define (XM_XMSTRING val) (or (tagged-p val 'XmString) (and (number? val) (= val 0))))
- (define (XM_STRING_TABLE val) (or (array-p val (lambda (n) (eq? (car n) 'XmString))) (and (number? val) (= val 0))))
- (define (XM_INT_TABLE val) (or (array-p val integer?) (and (number? val) (= val 0))))
- (define (XM_BOOLEAN val) (or (boolean? val) (and (number? val) (= val 0))))
- (define (XM_RENDER_TABLE val) (or (tagged-p val 'XmRenderTable) (and (number? val) (= val 0))))
- (define (XM_TRANSFER_ENTRY_LIST val) (or (list? val) (and (number? val) (= val 0))))
- (define (XM_RECTANGLE_LIST val) (or (array-p val (lambda (n) (eq? (car n) 'XRectangle))) (and (number? val) (= val 0))))
- (define (XM_TAB_LIST val) (or (tagged-p val 'XmTabList) (and (number? val) (= val 0))))
- (define (XM_WIDGET_LIST val) (or (array-p val (lambda (n) (eq? (car n) 'Widget))) (and (number? val) (= val 0))))
- (define (XM_ATOM_LIST val) (or (eq? val #f) (array-p val (lambda (n) (eq? (car n) 'Atom))) (and (number? val) (= val 0))))
- (define (XM_STRING_LIST val) (or (array-p val (lambda (n) (eq? (car n) 'XmString))) (and (number? val) (= val 0))))
- (define (XM_CHARSET_TABLE val) (or (array-p val (lambda (n) (eq? (car n) 'CharSet))) (and (number? val) (= val 0))))
- (define (XM_KEYSYM_TABLE val) (or (array-p val (lambda (n) (eq? (car n) 'KeySym))) (and (number? val) (= val 0))))
- (define (XM_WIDGET val) (or (tagged-p val 'Widget) (and (number? val) (= val 0))))
- (define (XM_PIXEL val) (or (tagged-p val 'Pixel) (and (number? val) (= val 0))))
- (define (XM_PIXMAP val) (or (tagged-p val 'Pixmap) (and (number? val) (= val 0))))
- (define (XM_XFONTSTRUCT val) (or (tagged-p val 'XFontStruct) (and (number? val) (= val 0))))
- (define (XM_DIMENSION val) (and (integer? val) (>= val 0) (< val 65536)))
- (define (XM_ATOM val) (or (tagged-p val 'Atom) (and (number? val) (= val 0))))
- (define (XM_TEXT_SOURCE val) (or (tagged-p val 'XmTextSource) (and (number? val) (= val 0))))
- (define (XM_FONTLIST val) (or (tagged-p val 'FontList) (and (number? val) (= val 0))))
- (define (XM_COLORMAP val) (or (tagged-p val 'Colormap) (and (number? val) (= val 0))))
- (define (XM_KEYSYM val) (or (tagged-p val 'KeySym) (and (number? val) (= val 0))))
- (define (XM_SCREEN val) (or (tagged-p val 'Screen) (and (number? val) (= val 0))))
- (define (XM_WINDOW val) (or (tagged-p val 'Window) (and (number? val) (= val 0))))
- (define (XM_VISUAL val) (or (tagged-p val 'Visual) (and (number? val) (= val 0))))
- (define (XM_WIDGET_CLASS val) (or (tagged-p val 'WidgetClass) (and (number? val) (= val 0))))
- (define (XM_STRING_OR_INT val) (or (string? val) (integer? val) (eq? val #f)))
- (define (XM_STRING_OR_XMSTRING val) (or (string? val) (eq? val #f) (and (list? val) (not (null? val)) (eq? (car val) 'XmString)) (and (number? val) (= val 0))))
- (define (XM_BOOLEAN_OR_INT val) (or (boolean? val) (integer? val)))
- (define (XM_POSITION val) (and (integer? val) (< (abs val) 65536)))
- (define (XM_SHORT val) (and (integer? val) (< (abs val) 65536)))
- (define (XM_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_TRANSFER_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val) (and (list? val) (not (null? val)) (procedure? (car val)))))
- (define (XM_CONVERT_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val) (and (list? val) (not (null? val)) (procedure? (car val)))))
- (define (XM_SEARCH_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_ORDER_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_QUALIFY_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_ALLOC_COLOR_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_POPUP_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_SCREEN_COLOR_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_DROP_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_DRAG_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
- (define (XM_PARSE_CALLBACK val) (or (procedure? val) (eq? val #f) (integer? val)))
-
-
- (if (and (provided? 'snd-motif)
- (provided? 'xm))
- (begin
+ (when (and (provided? 'snd-motif)
+ (provided? 'xm))
+ (with-let (sublet *motif*)
- (do ((clmtest 0 (+ 1 clmtest))) ((= clmtest (min 2 tests)))
- (log-mem clmtest)
-
- ;; check some resource stuff first
- (let ((hgt (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNheight 0))))
- (wid (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNwidth 0)))))
- (if (or (<= wid 0) (<= hgt 0) (> wid 65535) (> hgt 65535))
- (snd-display #__line__ ";Dimension miscast: ~A ~A" wid hgt)))
-
- ;; ---------------- X tests ----------------
- (let ((scr (current-screen))
- (dpy (XtDisplay (cadr (main-widgets)))))
- (if (and (not (= (.height scr) 1200))
- (not (= (.height scr) 1600)))
- (snd-display #__line__ ";screen height: ~A" (.height scr)))
- (if (and (not (= (.width scr) 1600))
- (not (= (.width scr) 2560)))
- (snd-display #__line__ ";screen width: ~A" (.width scr)))
- (if (not (= (.ndepths scr) 7))
- (snd-display #__line__ ";screen ndepths: ~A" (.ndepths scr)))
- (let ((dps (.depths scr)))
- (if (or (not (= (length dps) (.ndepths scr)))
- (not (Depth? (car dps))))
- (snd-display #__line__ ";depths: ~A" (.depths scr)))
- (if (not (= (.depth (car dps)) 24)) (snd-display #__line__ ";.depths val: ~A" (map .depth dps)))
- (if (not (null? (.visuals (car dps))))
- (if (not (Visual? (car (.visuals (car dps)))))
- (snd-display #__line__ ";visuals: ~A" (map .visuals dps))
- (if (not (= (.bits_per_rgb (car (.visuals (car dps)))) 8))
- (snd-display #__line__ ";bits/visuals: ~A" (map .bits_per_rgb (.visuals (car dps))))))
- (if (and (cadr dps)
- (not (null? (.visuals (cadr dps)))))
- (if (not (Visual? (car (.visuals (cadr dps)))))
- (snd-display #__line__ ";visuals: ~A" (map .visuals dps))
- (if (not (= (.bits_per_rgb (car (.visuals (cadr dps)))) 8))
- (snd-display #__line__ ";bits/visuals: ~A" (map .bits_per_rgb (.visuals (cadr dps)))))))))
- (if (not (= (cadr (.white_pixel scr)) 16777215))
- (snd-display #__line__ ";screen white_pixel: ~A" (.white_pixel scr)))
- (if (not (= (cadr (.black_pixel scr)) 0))
- (snd-display #__line__ ";screen black_pixel: ~A" (.black_pixel scr)))
- (if (not (eq? (.backing_store scr) #f))
- (snd-display #__line__ ";screen backing_store: ~A" (.backing_store scr)))
- (if (not (= (.min_maps scr) 1))
- (snd-display #__line__ ";screen min_maps: ~A" (.min_maps scr)))
- (if (not (= (.max_maps scr) 1))
- (snd-display #__line__ ";screen max_maps: ~A" (.max_maps scr)))
- (if (not (eq? (.save_unders scr) #f))
- (snd-display #__line__ ";screen save_unders: ~A" (.save_unders scr)))
- (if (not (GC? (.default_gc scr)))
- (snd-display #__line__ ";screen default_gc: ~A" (.default_gc scr)))
- (if (not (Window? (.root scr)))
- (snd-display #__line__ ";screen root: ~A" (.root scr)))
- (if (not (Colormap? (.cmap scr)))
- (snd-display #__line__ ";screen colormap: ~A" (.cmap scr)))
-
- (if (not (equal? (DisplayOfScreen scr) (.display scr)))
- (snd-display #__line__ ";DisplayOfScreen: ~A ~A" (DisplayOfScreen scr) (.display scr)))
- (if (not (equal? (RootWindowOfScreen scr) (.root scr)))
- (snd-display #__line__ ";RootWindowOfScreen: ~A ~A" (RootWindowOfScreen scr) (.root scr)))
- (if (not (equal? (BlackPixelOfScreen scr) (.black_pixel scr)))
- (snd-display #__line__ ";BlackPixelOfScreen: ~A ~A" (BlackPixelOfScreen scr) (.black_pixel scr)))
- (if (not (equal? (WhitePixelOfScreen scr) (.white_pixel scr)))
- (snd-display #__line__ ";WhitePixelOfScreen: ~A ~A" (WhitePixelOfScreen scr) (.white_pixel scr)))
- (if (not (equal? (DefaultColormapOfScreen scr) (.cmap scr)))
- (snd-display #__line__ ";DefaultColormapOfScreen: ~A ~A" (DefaultColormapOfScreen scr) (.cmap scr)))
- (if (not (equal? (DefaultDepthOfScreen scr) (.root_depth scr)))
- (snd-display #__line__ ";DefaultDepthOfScreen: ~A ~A" (DefaultDepthOfScreen scr) (.root_depth scr)))
- (if (not (equal? (DefaultGCOfScreen scr) (.default_gc scr)))
- (snd-display #__line__ ";DefaultGCOfScreen: ~A ~A" (DefaultGCOfScreen scr) (.default_gc scr)))
- (if (not (equal? (DefaultVisualOfScreen scr) (.root_visual scr)))
- (snd-display #__line__ ";DefaultVisualOfScreen: ~A ~A" (DefaultVisualOfScreen scr) (.root_visual scr)))
- (if (not (equal? (WidthOfScreen scr) (.width scr)))
- (snd-display #__line__ ";WidthOfScreen: ~A ~A" (WidthOfScreen scr) (.width scr)))
- (if (not (equal? (HeightOfScreen scr) (.height scr)))
- (snd-display #__line__ ";HeightOfScreen: ~A ~A" (HeightOfScreen scr) (.height scr)))
- (if (not (equal? (WidthMMOfScreen scr) (.mwidth scr)))
- (snd-display #__line__ ";WidthMMOfScreen: ~A ~A" (WidthMMOfScreen scr) (.mwidth scr)))
- (if (not (equal? (HeightMMOfScreen scr) (.mheight scr)))
- (snd-display #__line__ ";HeightMMOfScreen: ~A ~A" (HeightMMOfScreen scr) (.mheight scr)))
- (if (not (equal? (PlanesOfScreen scr) (.root_depth scr)))
- (snd-display #__line__ ";PlanesOfScreen: ~A ~A" (PlanesOfScreen scr) (.root_depth scr)))
- (if (not (equal? (MinCmapsOfScreen scr) (.min_maps scr)))
- (snd-display #__line__ ";MinCmapsOfScreen: ~A ~A" (MinCmapsOfScreen scr) (.min_maps scr)))
- (if (not (equal? (MaxCmapsOfScreen scr) (.max_maps scr)))
- (snd-display #__line__ ";MaxCmapsOfScreen: ~A ~A" (MaxCmapsOfScreen scr) (.max_maps scr)))
- (if (not (equal? (DoesSaveUnders scr) (.save_unders scr)))
- (snd-display #__line__ ";DoesSaveUnders: ~A ~A" (DoesSaveUnders scr) (.save_unders scr)))
- (if (not (equal? (DoesBackingStore scr) (.backing_store scr)))
- (snd-display #__line__ ";DoesBackingStore: ~A ~A" (DoesBackingStore scr) (.backing_store scr)))
- (if (not (equal? (EventMaskOfScreen scr) (.root_input_mask scr)))
- (snd-display #__line__ ";EventMaskOfScreen: ~A ~A" (EventMaskOfScreen scr) (.root_input_mask scr)))
-
- (if (not (equal? (XDisplayOfScreen scr) (.display scr)))
- (snd-display #__line__ ";XDisplayOfScreen: ~A ~A" (XDisplayOfScreen scr) (.display scr)))
- (if (not (equal? (XDisplayOfScreen (XScreenOfDisplay dpy 0)) dpy))
- (snd-display #__line__ ";XScreenOfDisplay ~A ~A" (XDisplayOfScreen (XScreenOfDisplay dpy 0)) dpy))
- (if (not (equal? (XDefaultScreenOfDisplay dpy) scr))
- (snd-display #__line__ ";XDefaultScreenOfDisplay ~A ~A" (XDefaultScreenOfDisplay dpy) scr))
- (if (not (equal? (XRootWindowOfScreen scr) (.root scr)))
- (snd-display #__line__ ";XRootWindowOfScreen: ~A ~A" (XRootWindowOfScreen scr) (.root scr)))
- (if (not (equal? (XBlackPixelOfScreen scr) (.black_pixel scr)))
- (snd-display #__line__ ";XBlackPixelOfScreen: ~A ~A" (XBlackPixelOfScreen scr) (.black_pixel scr)))
- (if (not (equal? (XWhitePixelOfScreen scr) (.white_pixel scr)))
- (snd-display #__line__ ";XWhitePixelOfScreen: ~A ~A" (XWhitePixelOfScreen scr) (.white_pixel scr)))
- (if (not (equal? (XDefaultColormapOfScreen scr) (.cmap scr)))
- (snd-display #__line__ ";XDefaultColormapOfScreen: ~A ~A" (XDefaultColormapOfScreen scr) (.cmap scr)))
- (if (not (equal? (XDefaultDepthOfScreen scr) (.root_depth scr)))
- (snd-display #__line__ ";XDefaultDepthOfScreen: ~A ~A" (XDefaultDepthOfScreen scr) (.root_depth scr)))
- (if (not (equal? (XDefaultGCOfScreen scr) (.default_gc scr)))
- (snd-display #__line__ ";XDefaultGCOfScreen: ~A ~A" (XDefaultGCOfScreen scr) (.default_gc scr)))
- (if (not (equal? (XDefaultVisualOfScreen scr) (.root_visual scr)))
- (snd-display #__line__ ";XDefaultVisualOfScreen: ~A ~A" (XDefaultVisualOfScreen scr) (.root_visual scr)))
- (if (not (equal? (XWidthOfScreen scr) (.width scr)))
- (snd-display #__line__ ";XWidthOfScreen: ~A ~A" (XWidthOfScreen scr) (.width scr)))
- (if (not (equal? (XHeightOfScreen scr) (.height scr)))
- (snd-display #__line__ ";XHeightOfScreen: ~A ~A" (XHeightOfScreen scr) (.height scr)))
- (if (not (equal? (XWidthMMOfScreen scr) (.mwidth scr)))
- (snd-display #__line__ ";XWidthMMOfScreen: ~A ~A" (XWidthMMOfScreen scr) (.mwidth scr)))
- (if (not (equal? (XHeightMMOfScreen scr) (.mheight scr)))
- (snd-display #__line__ ";XHeightMMOfScreen: ~A ~A" (XHeightMMOfScreen scr) (.mheight scr)))
- (if (not (equal? (XPlanesOfScreen scr) (.root_depth scr)))
- (snd-display #__line__ ";XPlanesOfScreen: ~A ~A" (XPlanesOfScreen scr) (.root_depth scr)))
- (if (not (equal? (XMinCmapsOfScreen scr) (.min_maps scr)))
- (snd-display #__line__ ";XMinCmapsOfScreen: ~A ~A" (XMinCmapsOfScreen scr) (.min_maps scr)))
- (if (not (equal? (XMaxCmapsOfScreen scr) (.max_maps scr)))
- (snd-display #__line__ ";XMaxCmapsOfScreen: ~A ~A" (XMaxCmapsOfScreen scr) (.max_maps scr)))
- (if (not (equal? (XDoesSaveUnders scr) (.save_unders scr)))
- (snd-display #__line__ ";XDoesSaveUnders: ~A ~A" (XDoesSaveUnders scr) (.save_unders scr)))
- (if (not (equal? (XDoesBackingStore scr) (.backing_store scr)))
- (snd-display #__line__ ";XDoesBackingStore: ~A ~A" (XDoesBackingStore scr) (.backing_store scr)))
- (if (not (equal? (XEventMaskOfScreen scr) (.root_input_mask scr)))
- (snd-display #__line__ ";XEventMaskOfScreen: ~A ~A" (XEventMaskOfScreen scr) (.root_input_mask scr)))
- )
-
- (let* ((scr (current-screen))
- (scrn (XScreenNumberOfScreen scr))
- (dpy (XtDisplay (cadr (main-widgets))))
- (vis (DefaultVisual dpy scrn))
- (win (XtWindow (cadr (main-widgets)))))
-
- (if (not (equal? (RootWindow dpy scrn) (.root scr)))
- (snd-display #__line__ ";RootWindow: ~A ~A" (RootWindow dpy scrn) (.root scr)))
- (if (not (equal? (DefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
- (snd-display #__line__ ";DefaultRootWindow: ~A ~A" (DefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
- (if (not (equal? (DefaultVisual dpy scrn) (.root_visual scr)))
- (snd-display #__line__ ";DefaultVisual: ~A ~A" (DefaultVisual dpy scrn) (.root_visual scr)))
- (if (not (equal? (DefaultGC dpy scrn) (.default_gc scr)))
- (snd-display #__line__ ";DefaultGC: ~A ~A" (DefaultGC dpy scrn) (.default_gc scr)))
- (if (not (equal? (BlackPixel dpy scrn) (.black_pixel scr)))
- (snd-display #__line__ ";BlackPixel: ~A ~A" (BlackPixel dpy scrn) (.black_pixel scr)))
- (if (not (equal? (WhitePixel dpy scrn) (.white_pixel scr)))
- (snd-display #__line__ ";WhitePixel ~A ~A" (WhitePixel dpy scrn) (.white_pixel scr)))
- (if (not (equal? (DisplayWidth dpy scrn) (.width scr)))
- (snd-display #__line__ ";DisplayWidth: ~A ~A" (DisplayWidth dpy scrn) (.width scr)))
- (if (not (equal? (DisplayHeight dpy scrn) (.height scr)))
- (snd-display #__line__ ";DisplayHeight: ~A ~A" (DisplayHeight dpy scrn) (.height scr)))
- (if (not (equal? (DisplayWidthMM dpy scrn) (.mwidth scr)))
- (snd-display #__line__ ";DisplayWidthMM: ~A ~A" (DisplayWidthMM dpy scrn) (.mwidth scr)))
- (if (not (equal? (DisplayHeightMM dpy scrn) (.mheight scr)))
- (snd-display #__line__ ";DisplayHeightMM: ~A ~A" (DisplayHeightMM dpy scrn) (.mheight scr)))
- (if (not (equal? (DisplayPlanes dpy scrn) (.root_depth scr)))
- (snd-display #__line__ ";DisplayPlanes: ~A ~A" (DisplayPlanes dpy scrn) (.root_depth scr)))
- (if (not (equal? (DefaultDepth dpy scrn) (.root_depth scr)))
- (snd-display #__line__ ";DefaultDepth: ~A ~A" (DefaultDepth dpy scrn) (.root_depth scr)))
- (if (not (equal? (DefaultColormap dpy scrn) (.cmap scr)))
- (snd-display #__line__ ";DefaultColormap: ~A ~A" (DefaultColormap dpy scrn) (.cmap scr)))
-
- (if (not (equal? (XRootWindow dpy scrn) (.root scr)))
- (snd-display #__line__ ";XRootWindow: ~A ~A" (XRootWindow dpy scrn) (.root scr)))
- (if (not (equal? (XDefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
- (snd-display #__line__ ";XDefaultRootWindow: ~A ~A" (XDefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
- (if (not (equal? (XDefaultVisual dpy scrn) (.root_visual scr)))
- (snd-display #__line__ ";XDefaultVisual: ~A ~A" (XDefaultVisual dpy scrn) (.root_visual scr)))
- (if (not (equal? (XDefaultGC dpy scrn) (.default_gc scr)))
- (snd-display #__line__ ";XDefaultGC: ~A ~A" (XDefaultGC dpy scrn) (.default_gc scr)))
- (if (not (equal? (XBlackPixel dpy scrn) (.black_pixel scr)))
- (snd-display #__line__ ";XBlackPixel: ~A ~A" (XBlackPixel dpy scrn) (.black_pixel scr)))
- (if (not (equal? (XWhitePixel dpy scrn) (.white_pixel scr)))
- (snd-display #__line__ ";XWhitePixel ~A ~A" (XWhitePixel dpy scrn) (.white_pixel scr)))
- (if (not (equal? (XDisplayWidth dpy scrn) (.width scr)))
- (snd-display #__line__ ";XDisplayWidth: ~A ~A" (XDisplayWidth dpy scrn) (.width scr)))
- (if (not (equal? (XDisplayHeight dpy scrn) (.height scr)))
- (snd-display #__line__ ";XDisplayHeight: ~A ~A" (XDisplayHeight dpy scrn) (.height scr)))
- (if (not (equal? (XDisplayWidthMM dpy scrn) (.mwidth scr)))
- (snd-display #__line__ ";XDisplayWidthMM: ~A ~A" (XDisplayWidthMM dpy scrn) (.mwidth scr)))
- (if (not (equal? (XDisplayHeightMM dpy scrn) (.mheight scr)))
- (snd-display #__line__ ";XDisplayHeightMM: ~A ~A" (XDisplayHeightMM dpy scrn) (.mheight scr)))
- (if (not (equal? (XDisplayPlanes dpy scrn) (.root_depth scr)))
- (snd-display #__line__ ";XDisplayPlanes: ~A ~A" (XDisplayPlanes dpy scrn) (.root_depth scr)))
- (if (not (equal? (XDefaultDepth dpy scrn) (.root_depth scr)))
- (snd-display #__line__ ";XDefaultDepth: ~A ~A" (XDefaultDepth dpy scrn) (.root_depth scr)))
- (if (not (equal? (XDefaultColormap dpy scrn) (.cmap scr)))
- (snd-display #__line__ ";XDefaultColormap: ~A ~A" (XDefaultColormap dpy scrn) (.cmap scr)))
-
- (if (not (equal? (XDefaultVisual dpy scrn) vis))
- (snd-display #__line__ ";XDefaultVisual: ~A ~A" (XDefaultVisual dpy scrn) vis))
- (if (not (equal? (DisplayCells dpy scrn) (.map_entries vis)))
- (snd-display #__line__ ";DisplayCells: ~A ~A" (DisplayCells dpy scrn) (.map_entries vis)))
- (if (not (equal? (CellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
- (snd-display #__line__ ";CellsOfScreen: ~A ~A" (CellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
- (if (not (equal? (XDisplayCells dpy scrn) (.map_entries vis)))
- (snd-display #__line__ ";XDisplayCells: ~A ~A" (XDisplayCells dpy scrn) (.map_entries vis)))
- (if (not (equal? (XCellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
- (snd-display #__line__ ";XCellsOfScreen: ~A ~A" (XCellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
- (if (< (XNextRequest dpy) (XLastKnownRequestProcessed dpy))
- (snd-display #__line__ ";XRequests: ~A ~A" (XNextRequest dpy) (XLastKnownRequestProcessed dpy)))
- (if (< (NextRequest dpy) (LastKnownRequestProcessed dpy))
- (snd-display #__line__ ";Requests: ~A ~A" (NextRequest dpy) (LastKnownRequestProcessed dpy)))
- (if (not (= (XDisplayMotionBufferSize dpy) 256))
- (snd-display #__line__ ";XDisplayMotionBufferSize: ~A" (XDisplayMotionBufferSize dpy)))
- (XGetMotionEvents dpy win (list 'Time 100) (list 'Time CurrentTime))
-
- (let ((lmapk (XNewModifiermap 2))
- (kcd (list 'KeyCode 50)))
- (if (not (XModifierKeymap? lmapk))
- (snd-display #__line__ ";xNewModifiermap: ~A" lmapk)
- (begin
- (set! lmapk (XInsertModifiermapEntry lmapk kcd ShiftMapIndex))
- (set! lmapk (XDeleteModifiermapEntry lmapk kcd ShiftMapIndex))
- ; (XFreeModifiermap lmapk) ;prone to segfault in X
- )))
-
- (if (not (= (XExtendedMaxRequestSize dpy) 4194303))
- (snd-display #__line__ ";XExtendedMaxRequestSize ~A" (XExtendedMaxRequestSize dpy)))
- (if (not (= (XMaxRequestSize dpy) 65535))
- (snd-display #__line__ ";XMaxRequestSize ~A" (XMaxRequestSize dpy)))
- (if (not (member (list 'Atom 40) (XListProperties dpy win)))
- (snd-display #__line__ ";XListProperties: ~A" (XListProperties dpy win)))
- (if (not (member "SHAPE" (XListExtensions dpy)))
- (snd-display #__line__ ";XListExtensions: ~A" (XListExtensions dpy)))
- (let ((val (XListInstalledColormaps dpy win)))
- (if (or (not val)
- (null? val)
- (not (Colormap? (car val))))
- (snd-display #__line__ ";XListInstalledColormaps: ~A" (XListInstalledColormaps dpy win))))
- (if (not (string=? (XKeysymToString (list 'KeySym 80)) "P"))
- (snd-display #__line__ ";XKeysymToString: ~A" (XKeysymToString (list 'KeySym 80))))
- (if (not (string=? (XGetAtomName dpy (list 'Atom 40)) "WM_NORMAL_HINTS"))
- (snd-display #__line__ ";XGetAtomName: ~A" (XGetAtomName dpy (list 'Atom 40))))
-
- (if (not (= (.bits_per_rgb vis) 8)) (snd-display #__line__ ";bits_per_rgb: ~A" (.bits_per_rgb vis)))
- (if (not (= (.blue_mask vis) 255)) (snd-display #__line__ ";blue_mask: ~A" (.blue_mask vis)))
- (if (not (= (.green_mask vis) 65280)) (snd-display #__line__ ";green_mask: ~A" (.green_mask vis)))
- (if (not (= (.red_mask vis) 16711680)) (snd-display #__line__ ";red_mask: ~A" (.red_mask vis)))
- (if (not (= AllPlanes 4294967295)) (snd-display #__line__ ";AllPlanes: ~A" AllPlanes))
-
- (if (< (QLength dpy) 0) (snd-display #__line__ ";QLength: ~A" (QLength dpy)))
- (if (not (= (ScreenCount dpy) 1)) (snd-display #__line__ ";ScreenCount: ~A" (ScreenCount dpy)))
- (if (not (string=? (ServerVendor dpy) "The X.Org Foundation")) (snd-display #__line__ ";ServerVendor: ~A" (ServerVendor dpy)))
- (if (not (= (ProtocolRevision dpy) 0)) (snd-display #__line__ ";ProtocolRevision: ~A" (ProtocolRevision dpy)))
- (if (not (= (ProtocolVersion dpy) 11)) (snd-display #__line__ ";ProtocolVersion: ~A" (ProtocolVersion dpy)))
- (if (not (number? (VendorRelease dpy))) (snd-display #__line__ ";VendorRelease: ~A" (VendorRelease dpy)))
- (if (not (string=? (DisplayString dpy) ":0.0")) (snd-display #__line__ ";DisplayString: ~A" (DisplayString dpy)))
- (if (not (= (BitmapUnit dpy) 32)) (snd-display #__line__ ";BitmapUnit: ~A" (BitmapUnit dpy)))
- (if (not (= (BitmapPad dpy) 32)) (snd-display #__line__ ";BitmapPad: ~A" (BitmapPad dpy)))
- (if (not (= (BitmapBitOrder dpy) 0)) (snd-display #__line__ ";BitmapBitOrder: ~A" (BitmapBitOrder dpy)))
- (if (not (= (ImageByteOrder dpy) 0)) (snd-display #__line__ ";ImageByteOrder: ~A" (ImageByteOrder dpy)))
- (if (not (= (DefaultScreen dpy) 0)) (snd-display #__line__ ";DefaultScreen: ~A" (DefaultScreen dpy)))
-
+ (define x->snd-color
+ (let ((documentation "(x->snd-color color-name) returns a Snd color object corresponding to the X11 color name 'color-name'"))
+ (lambda (color-name)
(let* ((col (XColor))
- (col1 (XColor))
(dpy (XtDisplay (cadr (main-widgets))))
(scr (DefaultScreen dpy))
(cmap (DefaultColormap dpy scr)))
- (if (= (XAllocNamedColor dpy cmap "blue" col col) 0) (snd-display #__line__ ";XAllocNamedColor blue ~A?" col))
- (if (not (= (.red col) 0)) (snd-display #__line__ ";XAllocNamedColor: ~A" (.red col)))
- (if (= (XAllocColor dpy cmap col) 0) (snd-display #__line__ ";XAllocColor?"))
- (if (not (= (.red col) 0)) (snd-display #__line__ ";XAllocColor: ~A" (.red col)))
- (if (= (XParseColor dpy cmap "blue" col) 0) (snd-display #__line__ ";XParseColor?"))
- (if (not (= (.red col) 0)) (snd-display #__line__ ";XParseColor: ~A" (.red col)))
- (if (= (XAllocNamedColor dpy cmap "green" col1 col1) 0) (snd-display #__line__ ";XAllocNamedColor green ~A?" col1))
- (XQueryColor dpy cmap col)
- (XQueryColors dpy cmap (list col col1)))
-
- (XSetAfterFunction dpy (lambda (n) 0))
- (XSetAfterFunction dpy #f)
- (if (not (equal? (XDisplayKeycodes dpy) (list 1 8 255)))
- (snd-display #__line__ ";XDisplayKeycodes: ~A" (XDisplayKeycodes dpy)))
- (let ((str (XFetchName dpy win)))
- (if (not (string=? (substring str 0 3) "snd"))
- (snd-display #__line__ ";XFetchName: ~A" str)))
- (XStoreName dpy win "hiho")
- (let ((str (XFetchName dpy win)))
- (if (not (string=? str "hiho"))
- (snd-display #__line__ ";XStoreName: ~A" str)))
- (XStoreName dpy win "snd")
- (let ((str (XGetIconName dpy win)))
- (if (not (string=? str "snd"))
- (snd-display #__line__ ";XGetIconName: ~A" str)))
- (XSetIconName dpy win "hiho")
- (let ((str (XGetIconName dpy win)))
- (if (not (string=? str "hiho"))
- (snd-display #__line__ ";XSetIconName: ~A" str)))
- (let ((geo (XGetGeometry dpy win)))
- (if (or (not (= (window-width) (list-ref geo 4)))
- (not (= (window-height) (list-ref geo 5))))
- (snd-display #__line__ ";XGetGeometry: ~A (~A ~A)" geo (window-width) (window-height))))
- (let ((focus (XGetInputFocus dpy)))
- (if (or (not (= (car focus) 1))
- (not (Window? (cadr focus))))
- (snd-display #__line__ ";XGetInputFocus: ~A" focus)))
- (let ((vals (XGetPointerControl dpy)))
- (if (not (equal? vals (list 1 2 1 4))) (snd-display #__line__ ";pointer state: ~A" vals))
- (XChangePointerControl dpy #f #t 2 1 8)
- (set! vals (XGetPointerControl dpy))
- (if (not (equal? vals (list 1 2 1 8))) (snd-display #__line__ ";set pointer state: ~A" vals))
- (XChangePointerControl dpy #f #t 2 1 4))
- (XAutoRepeatOff dpy)
- (if (not (= (list-ref (XGetKeyboardControl dpy) 5) 0)) (snd-display #__line__ ";AutoRepeatOff?"))
- (XAutoRepeatOn dpy)
- (if (not (= (list-ref (XGetKeyboardControl dpy) 5) 1)) (snd-display #__line__ ";AutoRepeatOn?"))
- (let ((vals (XGetPointerMapping dpy 0 3)))
- (if (not (equal? vals (list 1 2 3))) (snd-display #__line__ ";XGetPointerMapping: ~A" vals)))
- (XGetScreenSaver dpy)
- (XMoveWindow dpy win 100 10)
- (XSync dpy #f)
- (XResizeWindow dpy win 400 400)
- (XSync dpy #f)
- (XMoveResizeWindow dpy win 120 20 500 500)
- (XSync dpy #f)
- (let ((attr (XGetWindowAttributes dpy win)))
- (if (> (abs (- (.x attr) 120)) 200) (snd-display #__line__ ";XMoveWindow x etc: ~A" (.x attr)))
- (if (> (abs (- (.y attr) 20)) 200) (snd-display #__line__ ";XMoveWindow y etc: ~A" (.y attr)))
- (if (> (abs (- (.width attr) 500)) 20) (snd-display #__line__ ";XMoveWindow width etc: ~A" (.width attr)))
- (if (> (abs (- (.height attr) 500)) 20) (snd-display #__line__ ";XMoveWindow height etc: ~A" (.height attr)))
- (if (not (= (.border_width attr) 0)) (snd-display #__line__ ";XGetWindowAttributes border_width: ~A" (.border_width attr)))
- (if (not (= (.depth attr) 24)) (snd-display #__line__ ";XGetWindowAttributes depth: ~A" (.depth attr)))
- (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";XGetWindowAttributes bit_gravity: ~A" (.bit_gravity attr)))
- (if (not (= (.win_gravity attr) 1)) (snd-display #__line__ ";XGetWindowAttributes win_gravity: ~A" (.win_gravity attr)))
- (if (.backing_store attr) (snd-display #__line__ ";XGetWindowAttributes backing_store: ~A" (.backing_store attr)))
- (if (.override_redirect attr) (snd-display #__line__ ";XGetWindowAttributes override_redirect: ~A" (.override_redirect attr)))
- (if (.save_under attr) (snd-display #__line__ ";XGetWindowAttributes save_under: ~A" (.save_under attr)))
- ; (if (.map_installed attr) (snd-display #__line__ ";XGetWindowAttributes map_installed: ~A" (.map_installed attr)))
- (if (not (equal? (.backing_pixel attr) (list 'Pixel 0))) (snd-display #__line__ ";XGetWindowAttributes backing_pixel: ~A" (.backing_pixel attr)))
- (if (not (= (.map_state attr) 2)) (snd-display #__line__ ";XGetWindowAttributes map_state: ~A" (.map_state attr)))
- (if (not (= (.your_event_mask attr) #x628033)) (snd-display #__line__ ";your_event_mask: ~X" (.your_event_mask attr)))
- (if (and (not (= (.all_event_masks attr) #x628033))
- (not (= (.all_event_masks attr) #xe28033))
- (not (= (.all_event_masks attr) #xea8033)))
- (snd-display #__line__ ";all_event_masks: ~X" (.all_event_masks attr)))
- (if (not (Screen? (.screen attr))) (snd-display #__line__ ";XGetWindowAttributes screen: ~A" (.screen attr)))
- (if (and (not (= (.do_not_propagate_mask attr) 0))
- (not (= (.do_not_propagate_mask attr) 8204)))
- (snd-display #__line__ ";XGetWindowAttributes do_not_propagate_mask: ~A" (.do_not_propagate_mask attr)))
- (if (not (= (.backing_planes attr) AllPlanes)) (snd-display #__line__ ";XGetWindowAttributes backing_planes: ~A" (.backing_planes attr)))
- (if (not (= (.win_gravity attr) 1)) (snd-display #__line__ ";XGetWindowAttributes win_gravity: ~A" (.win_gravity attr)))
- (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";XGetWindowAttributes bit_gravity: ~A" (.bit_gravity attr)))
- ;(segfault) (XFree (cadr attr))
- )
- (XResetScreenSaver dpy)
- (if (< (XPending dpy) 0) (snd-display #__line__ ";XPending: ~A" (XPending dpy)))
- (XNoOp dpy)
- (XQueryBestStipple dpy win 100 100)
- (XQueryBestTile dpy win 100 100)
- (XQueryBestSize dpy 0 win 100 100)
- (let ((ext (XQueryExtension dpy "SHAPE")))
- (if (not (eq? (car ext) #t))
- (snd-display #__line__ ";XQueryExtension: ~A" ext)))
- (XQueryKeymap dpy)
- (let ((tree (XQueryTree dpy win)))
- (if (or (not (= (car tree) 1))
- (not (equal? (XRootWindow dpy 0) (cadr tree))))
- (snd-display #__line__ ";XQueryTree: ~A (~A)" tree (XRootWindow dpy 0))))
-
- (if (< (XQLength dpy) 0) (snd-display #__line__ ";XQLength: ~A" (XQLength dpy)))
- (if (not (= (XScreenCount dpy) 1)) (snd-display #__line__ ";XScreenCount: ~A" (XScreenCount dpy)))
- (if (not (string=? (XServerVendor dpy) "The X.Org Foundation")) (snd-display #__line__ ";XServerVendor: ~A" (XServerVendor dpy)))
- (if (not (= (XProtocolRevision dpy) 0)) (snd-display #__line__ ";XProtocolRevision: ~A" (XProtocolRevision dpy)))
- (if (not (= (XProtocolVersion dpy) 11)) (snd-display #__line__ ";XProtocolVersion: ~A" (XProtocolVersion dpy)))
- (if (not (number? (XVendorRelease dpy))) (snd-display #__line__ ";XVendorRelease: ~A" (XVendorRelease dpy)))
- (if (not (string=? (XDisplayString dpy) ":0.0")) (snd-display #__line__ ";XDisplayString: ~A" (XDisplayString dpy)))
- (if (not (= (XBitmapUnit dpy) 32)) (snd-display #__line__ ";XBitmapUnit: ~A" (XBitmapUnit dpy)))
- (if (not (= (XBitmapPad dpy) 32)) (snd-display #__line__ ";XBitmapPad: ~A" (XBitmapPad dpy)))
- (if (not (= (XBitmapBitOrder dpy) 0)) (snd-display #__line__ ";XBitmapBitOrder: ~A" (XBitmapBitOrder dpy)))
- (if (not (= (XImageByteOrder dpy) 0)) (snd-display #__line__ ";XImageByteOrder: ~A" (XImageByteOrder dpy)))
- (if (not (= (XDefaultScreen dpy) 0)) (snd-display #__line__ ";XDefaultScreen: ~A" (XDefaultScreen dpy)))
- (if (XGetIconSizes dpy win) (snd-display #__line__ ";XGetIconSizes: ~A" (XGetIconSizes dpy win)))
- (if (XGetRGBColormaps dpy win XA_RGB_DEFAULT_MAP)
- (snd-display #__line__ ";XGetRGBColormaps: ~A!" (XGetRGBColormaps dpy win XA_RGB_DEFAULT_MAP)))
- (let ((cmap (XAllocStandardColormap)))
- (for-each
- (lambda (func name)
- (if (not (= (func cmap) 0)) (snd-display #__line__ ";standardcolormap ~A: ~A" name (func cmap))))
- (list .visualid .red_max .red_mult .green_max .green_mult .blue_max .blue_mult)
- (list 'visualid 'red_max 'red_mult 'green_max 'green_mult 'blue_max 'blue_mult))
- (if (.colormap cmap) (snd-display #__line__ ";colormap: ~A" (.colormap cmap)))
- (XtFree (cadr cmap))
- )
- (let ((icon (XAllocIconSize)))
- (for-each
- (lambda (func name)
- (if (not (= (func icon) 0)) (snd-display #__line__ ";iconsize ~A: ~A" name (func icon))))
- (list .min_width .min_height .max_width .max_height .width_inc .height_inc)
- (list 'min_width 'min_height 'max_width 'max_height 'width_inc 'height_inc))
- (XFree icon))
-
- (let ((fs (XCreateFontSet dpy "*-*-*-*-Normal-*-*-*-*-*-*")))
- (if (or (not (XFontSet? fs))
- (= (cadr fs) 0))
- (snd-display #__line__ ";XCreateFontSet: ~A" fs)
- (let* ((fnts (XFontsOfFontSet fs))
- (fnt (caar fnts)))
- (if (not (XFontStruct? fnt))
- (snd-display #__line__ ";XFontsOfFontSet: ~A" fnts))
- (if (XContextualDrawing fs)
- (snd-display #__line__ ";XContextualDrawing: ~A" (XContextualDrawing fs)))
- (if (XContextDependentDrawing fs)
- (snd-display #__line__ ";XContextDependentDrawing: ~A" (XContextDependentDrawing fs)))
- (if (XDirectionalDependentDrawing fs)
- (snd-display #__line__ ";XDirectionalDependentDrawing: ~A" (XDirectionalDependentDrawing fs)))
- (if (not (string=? (XLocaleOfFontSet fs) "en_US"))
- (snd-display #__line__ ";XLocaleOfFontSet: ~A" (XLocaleOfFontSet fs)))
- (if (not (string=? (XBaseFontNameListOfFontSet fs) "*-*-*-*-Normal-*-*-*-*-*-*"))
- (snd-display #__line__ ";XBaseFontNameListOfFontSet: ~A" (XBaseFontNameListOfFontSet fs)))
- (if fnt
- (let ((wgt (XGetFontProperty fnt XA_WEIGHT))
- (siz (XGetFontProperty fnt XA_POINT_SIZE)))
- (if (or (not (= (cadr wgt) 10))
- (not (= (cadr siz) 120)))
- (snd-display #__line__ ";XGetFontProperty: ~A ~A" wgt siz))
- (if (not (= (.descent fnt) 2)) (snd-display #__line__ ";descent: ~A" (.descent fnt)))
- (if (not (= (.ascent fnt) 11)) (snd-display #__line__ ";ascent: ~A" (.ascent fnt)))
- (if (not (XCharStruct? (.per_char fnt))) (snd-display #__line__ ";per_char: ~A" (.per_char fnt)))
- (if (not (XCharStruct? (.max_bounds fnt))) (snd-display #__line__ ";max_bounds: ~A" (.max_bounds fnt)))
- (if (not (XCharStruct? (.min_bounds fnt))) (snd-display #__line__ ";min_bounds: ~A" (.min_bounds fnt)))
- (if (not (XFontProp? (car (.properties fnt)))) (snd-display #__line__ ";properties ~A" (.properties fnt)))
- (if (not (= (.card32 (car (.properties fnt))) 7)) (snd-display #__line__ ";card32: ~A" (.card32 (car (.properties fnt)))))))
- (XFreeFontSet dpy fs))))
- (XBell dpy 10)
- (let ((cmd (XGetCommand dpy win)))
- (if (or (not (> (length cmd) 0))
- (not (string=? (my-substring (car cmd) (- (string-length (car cmd)) 3)) "snd")))
- (snd-display #__line__ ";XGetCommand: ~A" cmd)))
- (XSetCommand dpy win (list "hiho" "away") 2)
- (if (not (equal? (XGetCommand dpy win) (list "hiho" "away")))
- (snd-display #__line__ ";XSetCommand: ~A" (XGetCommand dpy win)))
- (let ((wmp (map (lambda (w) (XGetAtomName dpy w)) (XGetWMProtocols dpy win))))
- (if (not (equal? wmp (list "_MOTIF_WM_MESSAGES" "WM_DELETE_WINDOW")))
- (snd-display #__line__ ";XGetWMProtocols: ~A" wmp)))
- (if (not (equal? (XListDepths dpy 0) (list 24 1 4 8 15 16 32)))
- (snd-display #__line__ ";XListDepths: ~A" (XListDepths dpy 0)))
- (if (not (equal? (XListPixmapFormats dpy) '((1 1 32) (4 8 32) (8 8 32) (15 16 32) (16 16 32) (24 32 32) (32 32 32))))
- (snd-display #__line__ ";XListPixmapFormats: ~A" (XListPixmapFormats dpy)))
-
- (XWarpPointer dpy (list 'Window None) (list 'Window None) 0 0 10 10 100 100)
- (let ((cs (XQueryBestCursor dpy win 10 10)))
- (if (not (equal? cs (list 1 10 10))) (snd-display #__line__ ";XQueryBestCursor: ~A" cs)))
- (let ((pt (XQueryPointer dpy win)))
- (if (not (Window? (cadr pt))) (snd-display #__line__ ";XQueryPointer: ~A" pt)))
- (XRaiseWindow dpy win)
- (XRotateBuffers dpy 1)
- (XSetWindowBorderWidth dpy win 10)
- (XSetWindowBorder dpy win (black-pixel))
- (XSetWindowBackground dpy win (basic-color))
- (let* ((vis (XGetVisualInfo dpy 0 (list 'XVisualInfo 0)))
- (depth (.depth (car vis))))
- (XSetWindowBorderPixmap dpy win (XCreatePixmap dpy win 10 10 depth))
- (XSetWindowBackgroundPixmap dpy win (XCreatePixmap dpy win 10 10 depth))
- (XSetWindowBorderPixmap dpy win CopyFromParent)
- (XSetWindowBackgroundPixmap dpy win ParentRelative)
- ;(segfault) (XFree (cadr vis))
- )
- (let ((hints (XGetWMHints dpy win)))
- (if (or (not hints) (not (XWMHints? hints))) (snd-display #__line__ ";XGetWMHints?"))
- (if (not (= (.flags hints) 7)) (snd-display #__line__ ";flags wmhints: ~A" (.flags hints)))
- (if (not (= (.initial_state hints) 1)) (snd-display #__line__ ";initial_state wmhints: ~A" (.initial_state hints)))
- (if (not (.input hints)) (snd-display #__line__ ";input wmhints: ~A" (.input hints)))
- (if (not (Pixmap? (.icon_pixmap hints))) (snd-display #__line__ ";icon_pixmap wmhints: ~A" (.icon_pixmap hints)))
- (if (.icon_window hints) (snd-display #__line__ ";icon_window: ~A" (.icon_window hints)))
- (if (not (equal? (.icon_mask hints) (list 'Pixmap 0))) (snd-display #__line__ ";icon_mask: ~A" (.icon_mask hints)))
- (if (not (number? (.window_group hints))) (snd-display #__line__ ";window_group: ~A" (.window_group hints)))
- (XtFree (cadr hints))
- (let ((st (XAllocWMHints)))
- (if (not (XWMHints? st)) (snd-display #__line__ ";XAllocWMHints: ~A" st))
- (XFree st))))
-
- (if (not (IsKeypadKey (list 'KeySym XK_KP_Space))) (snd-display #__line__ ";IsKeypadKey kp-space"))
- (if (IsKeypadKey (list 'KeySym XK_A)) (snd-display #__line__ ";IsKeypadKey A"))
- (if (IsPrivateKeypadKey (list 'KeySym XK_A)) (snd-display #__line__ ";IsPrivateKeypadKey A"))
- (if (not (IsCursorKey (list 'KeySym XK_Home))) (snd-display #__line__ ";IsCursorKey Home"))
- (if (IsCursorKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsCursorKey S"))
- (if (not (IsPFKey (list 'KeySym XK_KP_F1))) (snd-display #__line__ ";IsPFKey F1"))
- (if (IsPFKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsPFKey S"))
- (if (not (IsFunctionKey (list 'KeySym XK_F1))) (snd-display #__line__ ";IsFunctionKey F1"))
- (if (IsFunctionKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsFunctionKey S"))
- (if (not (IsMiscFunctionKey (list 'KeySym XK_Select))) (snd-display #__line__ ";IsMiscFunctionKey Select"))
- (if (IsMiscFunctionKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsMiscFunctionKey S"))
- (if (not (IsModifierKey (list 'KeySym XK_Shift_L))) (snd-display #__line__ ";IsModifierKey Shift"))
- (if (IsModifierKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsModifierKey S"))
-
- (let* ((scr (current-screen))
- (scrn (XScreenNumberOfScreen scr))
- (dpy (XtDisplay (cadr (main-widgets))))
- (val (XGCValues))
- (wn (XtWindow (cadr (main-widgets)))))
- (set! (.function val) GXclear)
- (if (not (equal? (.function val) GXclear))
- (snd-display #__line__ ";function: ~A ~A" (.function val) GXclear))
- (set! (.line_width val) 10)
- (if (not (equal? (.line_width val) 10))
- (snd-display #__line__ ";line_width: ~A ~A" (.line_width val) 10))
- (set! (.line_style val) LineSolid)
- (if (not (equal? (.line_style val) LineSolid))
- (snd-display #__line__ ";line_style: ~A ~A" (.line_style val) LineSolid))
- (set! (.background val) (WhitePixelOfScreen (current-screen)))
- (if (not (equal? (.background val) (WhitePixelOfScreen (current-screen))))
- (snd-display #__line__ ";background: ~A ~A" (.background val) (WhitePixelOfScreen (current-screen))))
- (set! (.foreground val) (BlackPixelOfScreen (current-screen)))
- (if (not (equal? (.foreground val) (BlackPixelOfScreen (current-screen))))
- (snd-display #__line__ ";foreground: ~A ~A" (.foreground val) (BlackPixelOfScreen (current-screen))))
- ;; plane_mask?
- (set! (.cap_style val) CapRound)
- (if (not (equal? (.cap_style val) CapRound))
- (snd-display #__line__ ";cap_style: ~A ~A" (.cap_style val) CapRound))
- (set! (.join_style val) JoinMiter)
- (if (not (equal? (.join_style val) JoinMiter))
- (snd-display #__line__ ";join_style: ~A ~A" (.join_style val) JoinMiter))
- (set! (.fill_style val) FillSolid)
- (if (not (equal? (.fill_style val) FillSolid))
- (snd-display #__line__ ";fill_style: ~A ~A" (.fill_style val) FillSolid))
- (set! (.fill_rule val) EvenOddRule)
- (if (not (equal? (.fill_rule val) EvenOddRule))
- (snd-display #__line__ ";fill_rule: ~A ~A" (.fill_rule val) EvenOddRule))
- (set! (.arc_mode val) ArcChord)
- (if (not (equal? (.arc_mode val) ArcChord))
- (snd-display #__line__ ";arc_mode: ~A ~A" (.arc_mode val) ArcChord))
- ;; tile stipple clip_mask are Pixmaps
- (set! (.ts_x_origin val) 1)
- (if (not (equal? (.ts_x_origin val) 1))
- (snd-display #__line__ ";ts_x_origin: ~A ~A" (.ts_x_origin val) 1))
- (set! (.ts_y_origin val) 1)
- (if (not (equal? (.ts_y_origin val) 1))
- (snd-display #__line__ ";ts_y_origin: ~A ~A" (.ts_y_origin val) 1))
- ;; font is Font
- (set! (.subwindow_mode val) ClipByChildren)
- (if (not (equal? (.subwindow_mode val) ClipByChildren))
- (snd-display #__line__ ";subwindow_mode: ~A ~A" (.subwindow_mode val) ClipByChildren))
- (set! (.graphics_exposures val) #f)
- (if (not (equal? (.graphics_exposures val) #f))
- (snd-display #__line__ ";graphics_exposures: ~A ~A" (.graphics_exposures val) #f))
- (set! (.clip_x_origin val) 0)
- (if (not (equal? (.clip_x_origin val) 0))
- (snd-display #__line__ ";clip_x_origin: ~A ~A" (.clip_x_origin val) 0))
- (set! (.clip_y_origin val) 0)
- (if (not (equal? (.clip_y_origin val) 0))
- (snd-display #__line__ ";clip_y_origin: ~A ~A" (.clip_y_origin val) 0))
- (set! (.dash_offset val) 1)
- (if (not (equal? (.dash_offset val) 1))
- (snd-display #__line__ ";dash_offset: ~A ~A" (.dash_offset val) 1))
- (if (not (number? (XConnectionNumber dpy)))
- (snd-display #__line__ ";XConnectionNumber: ~A" (XConnectionNumber dpy)))
-
- (let ((sgc (XCreateGC dpy wn (+ GCFunction GCForeground GCBackground GCLineWidth GCLineStyle
- GCCapStyle GCJoinStyle GCFillStyle GCFillRule GCTileStipXOrigin
- GCTileStipYOrigin GCSubwindowMode GCGraphicsExposures GCClipXOrigin
- GCClipYOrigin GCDashOffset GCArcMode)
- val)))
-
- (if (not (GC? sgc)) (snd-display #__line__ ";XCreateGC returned ~A" sgc))
- (XSetArcMode dpy sgc ArcPieSlice)
- (XSetFunction dpy sgc GXcopy)
- (XSetLineAttributes dpy sgc 3 LineDoubleDash CapButt JoinMiter)
- (XSetClipOrigin dpy sgc 1 1)
- (XSetTSOrigin dpy sgc 0 0)
- (XSetFillRule dpy sgc WindingRule)
- (XSetFillStyle dpy sgc FillStippled)
- (XSetForeground dpy sgc (WhitePixelOfScreen (current-screen)))
- (XSetBackground dpy sgc (BlackPixelOfScreen (current-screen)))
- (XSetGraphicsExposures dpy sgc #t)
- (XSetSubwindowMode dpy sgc IncludeInferiors)
- (let ((owner (XGetSelectionOwner dpy XA_PRIMARY)))
- (if (and owner (not (Window? owner)))
- (snd-display #__line__ ";XGetSelectionOwner: ~A" owner)))
- (let ((mods (XGetModifierMapping dpy)))
- (if (not (XModifierKeymap? mods))
- (snd-display #__line__ ";XGetModifierMapping: ~A" mods)))
- (let ((vis (XGetVisualInfo dpy 0 (list 'XVisualInfo 0))))
- (if (or (not vis)
- (not (XVisualInfo? (car vis))))
- (snd-display #__line__ ";XGetVisualInfo: ~A" vis))
- (if (not (= (.depth (car vis)) 24)) (snd-display #__line__ ";depth vis: ~A" (.depth (car vis))))
- (if (not (= (.screen (car vis)) 0)) (snd-display #__line__ ";screen vis: ~A" (.screen (car vis))))
- (catch #t ; in c++ no class field
- (lambda ()
- (if (not (= (.class (car vis)) TrueColor)) (snd-display #__line__ ";class vis: ~A (~A)" (.class (car vis)) TrueColor)))
- (lambda args args))
- (if (not (= (.colormap_size (car vis)) 256)) (snd-display #__line__ ";colormap_size vis: ~A" (.colormap_size (car vis))))
- (if (and (not (XVisualInfo? (XMatchVisualInfo dpy 0 24 TrueColor)))
- (not (XVisualInfo? (XMatchVisualInfo dpy 0 16 TrueColor))))
- (snd-display #__line__ ";XMatchVisualInfo: ~A" (XMatchVisualInfo dpy 0 24 TrueColor))))
- (XCheckMaskEvent dpy KeyPressMask)
-
- (let* ((vals (XGetGCValues dpy sgc (+ GCFunction GCForeground GCBackground GCLineWidth GCLineStyle
- GCCapStyle GCJoinStyle GCFillStyle GCFillRule GCTileStipXOrigin
- GCTileStipYOrigin GCSubwindowMode GCGraphicsExposures GCClipXOrigin
- GCClipYOrigin GCDashOffset GCArcMode)))
- (val1 (cadr vals)))
- (if (= (car vals) 0)
- (snd-display #__line__ ";XGetGCValues failed"))
-
- (if (not (equal? (.function val1) GXcopy))
- (snd-display #__line__ ";function: ~A ~A" (.function val1) GXcopy))
- (if (not (equal? (.line_width val1) 3))
- (snd-display #__line__ ";line_width: ~A ~A" (.line_width val1) 3))
- (if (not (equal? (.line_style val1) LineDoubleDash))
- (snd-display #__line__ ";line_style: ~A ~A" (.line_style val1) LineDoubleDash))
- (if (not (equal? (.background val1) (BlackPixelOfScreen (current-screen))))
- (snd-display #__line__ ";background: ~A ~A" (.background val1) (BlackPixelOfScreen (current-screen))))
- (if (not (equal? (.foreground val1) (WhitePixelOfScreen (current-screen))))
- (snd-display #__line__ ";foreground: ~A ~A" (.foreground val1) (WhitePixelOfScreen (current-screen))))
- (if (not (equal? (.cap_style val1) CapButt))
- (snd-display #__line__ ";cap_style: ~A ~A" (.cap_style val1) CapButt))
- (if (not (equal? (.join_style val1) JoinMiter))
- (snd-display #__line__ ";join_style: ~A ~A" (.join_style val1) JoinMiter))
- (if (not (equal? (.fill_style val1) FillStippled))
- (snd-display #__line__ ";fill_style: ~A ~A" (.fill_style val1) FillStippled))
- (if (not (equal? (.fill_rule val1) WindingRule))
- (snd-display #__line__ ";fill_rule: ~A ~A" (.fill_rule val1) WindingRule))
- (if (not (equal? (.arc_mode val1) ArcPieSlice))
- (snd-display #__line__ ";arc_mode: ~A ~A" (.arc_mode val1) ArcPieSlice))
- (if (not (equal? (.ts_x_origin val1) 0))
- (snd-display #__line__ ";ts_x_origin: ~A ~A" (.ts_x_origin val1) 0))
- (if (not (equal? (.ts_y_origin val1) 0))
- (snd-display #__line__ ";ts_y_origin: ~A ~A" (.ts_y_origin val1) 0))
- (if (not (equal? (.subwindow_mode val1) IncludeInferiors))
- (snd-display #__line__ ";subwindow_mode: ~A ~A" (.subwindow_mode val1) IncludeInferiors))
- (if (not (equal? (.graphics_exposures val1) #t))
- (snd-display #__line__ ";graphics_exposures: ~A ~A" (.graphics_exposures val1) #t))
- (if (not (equal? (.clip_x_origin val1) 1))
- (snd-display #__line__ ";clip_x_origin: ~A ~A" (.clip_x_origin val1) 1))
- (if (not (equal? (.clip_y_origin val1) 1))
- (snd-display #__line__ ";clip_y_origin: ~A ~A" (.clip_y_origin val1) 1))
- (if (not (equal? (.dash_offset val1) 1))
- (snd-display #__line__ ";dash_offset: ~A ~A" (.dash_offset val1) 1))
-
- (set! (.plane_mask val) 0)
- (if (not (equal? (.plane_mask val) 0))
- (snd-display #__line__ ";plane_mask: ~A ~A" (.plane_mask val) 0))
- (set! (.tile val) (list 'Pixmap 0))
- (if (not (equal? (.tile val) (list 'Pixmap 0)))
- (snd-display #__line__ ";tile: ~A" (.tile val)))
- (set! (.stipple val) (list 'Pixmap 0))
- (if (not (equal? (.stipple val) (list 'Pixmap 0)))
- (snd-display #__line__ ";stipple: ~A" (.stipple val)))
-
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets))))
- (attr (XSetWindowAttributes #f (basic-color) #f (highlight-color)))
- (newwin (XCreateWindow dpy win 10 10 100 100 3
- CopyFromParent InputOutput (list 'Visual CopyFromParent)
- (logior CWBackPixel CWBorderPixel)
- attr)))
- (if (not (= (.do_not_propagate_mask attr) 0)) (snd-display #__line__ ";do_not_propagate_mask: ~A" (.do_not_propagate_mask attr)))
- (if (not (= (.event_mask attr) 0)) (snd-display #__line__ ";event_mask: ~A" (.event_mask attr)))
- (if (not (Pixel? (.backing_pixel attr))) (snd-display #__line__ ";backing_pixel: ~A" (.backing_pixel attr)))
- (if (not (Pixel? (.border_pixel attr))) (snd-display #__line__ ";border_pixel: ~A" (.border_pixel attr)))
- (if (not (= (cadr (.border_pixmap attr)) 0)) (snd-display #__line__ ";border_pixmap: ~A" (.border_pixmap attr)))
- (if (not (Pixel? (.background_pixel attr))) (snd-display #__line__ ";background_pixel: ~A" (.background_pixel attr)))
- (if (not (= (cadr (.background_pixmap attr)) 0)) (snd-display #__line__ ";background_pixmap: ~A" (.background_pixmap attr)))
- (if (not (= (.backing_planes attr) 0)) (snd-display #__line__ ";backing_planes: ~A" (.backing_planes attr)))
- (if (.save_under attr) (snd-display #__line__ ";save_under: ~A" (.save_under attr)))
- (if (not (= (cadr (.cursor attr)) 0)) (snd-display #__line__ ";cursor: ~A" (.cursor attr)))
- (if (not (Window? newwin)) (snd-display #__line__ ";XCreateWindow: ~A" newwin))
- (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";bit_gravity: ~A" (.bit_gravity attr)))
- (XChangeWindowAttributes dpy newwin CWBackPixel (XSetWindowAttributes #f (basic-color)))
- (XDestroyWindow dpy newwin)
- (set! newwin (XCreateSimpleWindow dpy win 10 10 100 100 3 (basic-color) (highlight-color)))
- (XDestroyWindow dpy newwin))
-
- (XSetRegion dpy sgc (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule))
- (let ((pix (make-pixmap (cadr (main-widgets)) arrow-strs)))
- (if (not (Pixmap? pix))
- (snd-display #__line__ ";make-pixmap?")
- (begin
- (XSetTile dpy sgc pix)
- (XSetStipple dpy sgc (XCreateBitmapFromData dpy wn right-arrow 16 12))
- (XSetClipMask dpy sgc None)
- (XSetState dpy sgc (basic-color) (mark-color) GXcopy 0)
- (XSetPlaneMask dpy sgc 0)
- (XSetDashes dpy sgc 0 '(3 4 3 1))
- (XSetClipRectangles dpy sgc 0 0 (list (XRectangle 0 0 10 10) (XRectangle 10 10 100 100)) 2 Unsorted)
- (let ((err (XWriteBitmapFile dpy "testx.data" pix 16 12 -1 -1)))
- (if (not (= BitmapSuccess err)) (snd-display #__line__ ";XWriteBitmapFile: ~A" err)))
- ;(let ((vals (XReadBitmapFile dpy (XtWindow (cadr (main-widgets))) "testx.data")))
- ; (if (not (= (car vals BitmapSuccess))) (snd-display #__line__ ";XReadBitmapFile: ~A" vals)))
- ;(let ((vals (XReadBitmapFileData "testx.data")))
- ; (if (not (= (car vals BitmapSuccess))) (snd-display #__line__ ";XReadBitmapFileData: ~A" vals)))
-
- (let* ((fid (XLoadFont dpy "cursor"))
- (col (XColor))
- (col1 (XColor))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr)))
- (XAllocNamedColor dpy cmap "blue" col col)
- (XAllocNamedColor dpy cmap "green" col1 col1)
- (let ((vals (XCreateGlyphCursor dpy fid None XC_dot 0 col col1)))
- (if (not (Cursor? vals)) (snd-display #__line__ ";XCreateGlyphCursor: ~A" vals)))
- (let ((vals (XCreatePixmapCursor dpy pix None col col1 5 5)))
- (if (not (Cursor? vals)) (snd-display #__line__ ";XCreatePixmapCursor: ~A" vals))
- (XRecolorCursor dpy vals col1 col))
- (XAllocColorPlanes dpy cmap #f 2 1 1 1)
- (XAllocColorCells dpy cmap #f 1 1))
-
-
- )))
- (let* ((fid (XLoadFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
- (fnt (XLoadQueryFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
- (chs (XQueryTextExtents dpy fid "hiho"))
- (struct (list-ref chs 4))
- (fnt1 (XQueryFont dpy fid)))
- (if (not (Font? fid)) (snd-display #__line__ ";XLoadFont: ~A" fid))
- (if (not (XFontStruct? fnt)) (snd-display #__line__ ";XLoadQueryFont: ~A" fnt))
- (if (not (XFontStruct? fnt1)) (snd-display #__line__ ";XQueryFont: ~A" fnt1))
- (if (not (XCharStruct? struct)) (snd-display #__line__ ";XQueryTextExtents: ~A" chs))
- (if (not (= (list-ref chs 2) 12)) (snd-display #__line__ ";XQueryTextExtents max ascent: ~A" (list-ref chs 2)))
- (if (not (= (list-ref chs 3) 3)) (snd-display #__line__ ";XQueryTextExtents max descent: ~A" (list-ref chs 3)))
- (if (not (= (.lbearing struct) 0)) (snd-display #__line__ ";lbearing: ~A" (.lbearing struct)))
- (if (not (= (.rbearing struct) 23)) (snd-display #__line__ ";rbearing: ~A" (.rbearing struct)))
- (if (not (= (.width struct) 24)) (snd-display #__line__ ";width: ~A" (.width struct)))
- (if (not (= (.ascent struct) 10)) (snd-display #__line__ ";ascent: ~A" (.ascent struct)))
- (if (not (= (.descent struct) 0)) (snd-display #__line__ ";descent: ~A" (.descent struct)))
- (if (not (= (.attributes struct) 0)) (snd-display #__line__ ";attributes: ~A" (.attributes struct)))
- (let ((fid (load-font "-*-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*")))
- (if (not (Font? fid)) (snd-display #__line__ ";load-font -> ~A" fid)))
- )
- (XFreeGC (XtDisplay (cadr (main-widgets))) sgc)
+ (if (= (XAllocNamedColor dpy cmap color-name col col) 0)
+ (snd-error (format #f "can't allocate ~A" color-name))
+ (make-color-with-catch (/ (.red col) 65535.0)
+ (/ (.green col) 65535.0)
+ (/ (.blue col) 65535.0)))))))
+
+ (define (snd-test-clean-string str)
+ ;; full file name should be unique, so I think we need only fix it up to look like a flat name
+ (let* ((len (length str))
+ (new-str (make-string len #\.)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) new-str)
+ (let ((c (str i)))
+ (if (memv c '(#\\ #\/))
+ (string-set! new-str i #\_)
+ (string-set! new-str i c))))))
+
+ (define (tagged-p val sym) (or (not val) (and (list? val) (pair? val) (eq? (car val) sym))))
+ (define (array-p val type) (and (list? val) (or (null? val) (type (car val)))))
+ (define XM_INT integer?)
+ (define (XM_ULONG val) (and (integer? val) (>= val 0)))
+ (define (XM_UCHAR val) (or (char? val) (and (integer? val) (>= val 0) (< val 65536))))
+ (define XM_FLOAT real?)
+ (define (XM_STRING val) (or (not val) (string? val) (and (number? val) (= val 0))))
+ (define (XM_XMSTRING val) (or (tagged-p val 'XmString) (and (number? val) (= val 0))))
+ (define (XM_STRING_TABLE val) (or (array-p val (lambda (n) (eq? (car n) 'XmString))) (and (number? val) (= val 0))))
+ (define (XM_INT_TABLE val) (or (array-p val integer?) (and (number? val) (= val 0))))
+ (define (XM_BOOLEAN val) (or (boolean? val) (and (number? val) (= val 0))))
+ (define (XM_RENDER_TABLE val) (or (tagged-p val 'XmRenderTable) (and (number? val) (= val 0))))
+ (define (XM_TRANSFER_ENTRY_LIST val) (or (list? val) (and (number? val) (= val 0))))
+ (define (XM_RECTANGLE_LIST val) (or (array-p val (lambda (n) (eq? (car n) 'XRectangle))) (and (number? val) (= val 0))))
+ (define (XM_TAB_LIST val) (or (tagged-p val 'XmTabList) (and (number? val) (= val 0))))
+ (define (XM_WIDGET_LIST val) (or (array-p val (lambda (n) (eq? (car n) 'Widget))) (and (number? val) (= val 0))))
+ (define (XM_ATOM_LIST val) (or (not val) (array-p val (lambda (n) (eq? (car n) 'Atom))) (and (number? val) (= val 0))))
+ (define (XM_STRING_LIST val) (or (array-p val (lambda (n) (eq? (car n) 'XmString))) (and (number? val) (= val 0))))
+ (define (XM_CHARSET_TABLE val) (or (array-p val (lambda (n) (eq? (car n) 'CharSet))) (and (number? val) (= val 0))))
+ (define (XM_KEYSYM_TABLE val) (or (array-p val (lambda (n) (eq? (car n) 'KeySym))) (and (number? val) (= val 0))))
+ (define (XM_WIDGET val) (or (tagged-p val 'Widget) (and (number? val) (= val 0))))
+ (define (XM_PIXEL val) (or (tagged-p val 'Pixel) (and (number? val) (= val 0))))
+ (define (XM_PIXMAP val) (or (tagged-p val 'Pixmap) (and (number? val) (= val 0))))
+ (define (XM_XFONTSTRUCT val) (or (tagged-p val 'XFontStruct) (and (number? val) (= val 0))))
+ (define (XM_DIMENSION val) (and (integer? val) (>= val 0) (< val 65536)))
+ (define (XM_ATOM val) (or (tagged-p val 'Atom) (and (number? val) (= val 0))))
+ (define (XM_TEXT_SOURCE val) (or (tagged-p val 'XmTextSource) (and (number? val) (= val 0))))
+ (define (XM_COLORMAP val) (or (tagged-p val 'Colormap) (and (number? val) (= val 0))))
+ (define (XM_KEYSYM val) (or (tagged-p val 'KeySym) (and (number? val) (= val 0))))
+ (define (XM_SCREEN val) (or (tagged-p val 'Screen) (and (number? val) (= val 0))))
+ (define (XM_WINDOW val) (or (tagged-p val 'Window) (and (number? val) (= val 0))))
+ (define (XM_VISUAL val) (or (tagged-p val 'Visual) (and (number? val) (= val 0))))
+ (define (XM_WIDGET_CLASS val) (or (tagged-p val 'WidgetClass) (and (number? val) (= val 0))))
+ (define (XM_STRING_OR_INT val) (or (string? val) (integer? val) (not val)))
+ (define (XM_STRING_OR_XMSTRING val) (or (string? val) (not val) (and (list? val) (pair? val) (eq? (car val) 'XmString)) (and (number? val) (= val 0))))
+ (define (XM_POSITION val) (and (integer? val) (< (abs val) 65536)))
+ (define (XM_SHORT val) (and (integer? val) (< (abs val) 65536)))
+ (define (XM_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+ (define (XM_TRANSFER_CALLBACK val) (or (procedure? val) (not val) (integer? val) (and (list? val) (pair? val) (procedure? (car val)))))
+ (define (XM_CONVERT_CALLBACK val) (or (procedure? val) (not val) (integer? val) (and (list? val) (pair? val) (procedure? (car val)))))
+ (define (XM_SEARCH_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+ (define (XM_ORDER_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+ (define (XM_QUALIFY_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+ (define (XM_ALLOC_COLOR_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+ (define (XM_POPUP_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+ (define (XM_SCREEN_COLOR_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+ (define (XM_DROP_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+ (define (XM_PARSE_CALLBACK val) (or (procedure? val) (not val) (integer? val)))
+
+ ;; check some resource stuff first
+ (let ((hgt (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNheight 0))))
+ (wid (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNwidth 0)))))
+ (if (or (<= wid 0) (<= hgt 0) (> wid 65535) (> hgt 65535))
+ (snd-display #__line__ ";Dimension miscast: ~A ~A" wid hgt)))
+
+ ;; ---------------- X tests ----------------
+ (let ((scr (current-screen))
+ (dpy (XtDisplay (cadr (main-widgets)))))
+ (if (and (not (= (.height scr) 1200))
+ (not (= (.height scr) 1600)))
+ (snd-display #__line__ ";screen height: ~A" (.height scr)))
+ (if (and (not (= (.width scr) 1600))
+ (not (= (.width scr) 2560)))
+ (snd-display #__line__ ";screen width: ~A" (.width scr)))
+ (if (not (= (.ndepths scr) 7))
+ (snd-display #__line__ ";screen ndepths: ~A" (.ndepths scr)))
+ (let ((dps (.depths scr)))
+ (if (or (not (= (length dps) (.ndepths scr)))
+ (not (Depth? (car dps))))
+ (snd-display #__line__ ";depths: ~A" (.depths scr)))
+ (if (not (= (.depth (car dps)) 24)) (snd-display #__line__ ";.depths val: ~A" (map .depth dps)))
+ (if (pair? (.visuals (car dps)))
+ (if (not (Visual? (car (.visuals (car dps)))))
+ (snd-display #__line__ ";visuals: ~A" (map .visuals dps))
+ (if (not (= (.bits_per_rgb (car (.visuals (car dps)))) 8))
+ (snd-display #__line__ ";bits/visuals: ~A" (map .bits_per_rgb (.visuals (car dps))))))
+ (if (and (cadr dps)
+ (pair? (.visuals (cadr dps))))
+ (if (not (Visual? (car (.visuals (cadr dps)))))
+ (snd-display #__line__ ";visuals: ~A" (map .visuals dps))
+ (if (not (= (.bits_per_rgb (car (.visuals (cadr dps)))) 8))
+ (snd-display #__line__ ";bits/visuals: ~A" (map .bits_per_rgb (.visuals (cadr dps)))))))))
+ (if (not (= (cadr (.white_pixel scr)) 16777215))
+ (snd-display #__line__ ";screen white_pixel: ~A" (.white_pixel scr)))
+ (if (not (= (cadr (.black_pixel scr)) 0))
+ (snd-display #__line__ ";screen black_pixel: ~A" (.black_pixel scr)))
+ (if (.backing_store scr)
+ (snd-display #__line__ ";screen backing_store: ~A" (.backing_store scr)))
+ (if (not (= (.min_maps scr) 1))
+ (snd-display #__line__ ";screen min_maps: ~A" (.min_maps scr)))
+ (if (not (= (.max_maps scr) 1))
+ (snd-display #__line__ ";screen max_maps: ~A" (.max_maps scr)))
+ (if (.save_unders scr)
+ (snd-display #__line__ ";screen save_unders: ~A" (.save_unders scr)))
+ (if (not (GC? (.default_gc scr)))
+ (snd-display #__line__ ";screen default_gc: ~A" (.default_gc scr)))
+ (if (not (Window? (.root scr)))
+ (snd-display #__line__ ";screen root: ~A" (.root scr)))
+ (if (not (Colormap? (.cmap scr)))
+ (snd-display #__line__ ";screen colormap: ~A" (.cmap scr)))
+
+ (if (not (equal? (DisplayOfScreen scr) (.display scr)))
+ (snd-display #__line__ ";DisplayOfScreen: ~A ~A" (DisplayOfScreen scr) (.display scr)))
+ (if (not (equal? (RootWindowOfScreen scr) (.root scr)))
+ (snd-display #__line__ ";RootWindowOfScreen: ~A ~A" (RootWindowOfScreen scr) (.root scr)))
+ (if (not (equal? (BlackPixelOfScreen scr) (.black_pixel scr)))
+ (snd-display #__line__ ";BlackPixelOfScreen: ~A ~A" (BlackPixelOfScreen scr) (.black_pixel scr)))
+ (if (not (equal? (WhitePixelOfScreen scr) (.white_pixel scr)))
+ (snd-display #__line__ ";WhitePixelOfScreen: ~A ~A" (WhitePixelOfScreen scr) (.white_pixel scr)))
+ (if (not (equal? (DefaultColormapOfScreen scr) (.cmap scr)))
+ (snd-display #__line__ ";DefaultColormapOfScreen: ~A ~A" (DefaultColormapOfScreen scr) (.cmap scr)))
+ (if (not (equal? (DefaultDepthOfScreen scr) (.root_depth scr)))
+ (snd-display #__line__ ";DefaultDepthOfScreen: ~A ~A" (DefaultDepthOfScreen scr) (.root_depth scr)))
+ (if (not (equal? (DefaultGCOfScreen scr) (.default_gc scr)))
+ (snd-display #__line__ ";DefaultGCOfScreen: ~A ~A" (DefaultGCOfScreen scr) (.default_gc scr)))
+ (if (not (equal? (DefaultVisualOfScreen scr) (.root_visual scr)))
+ (snd-display #__line__ ";DefaultVisualOfScreen: ~A ~A" (DefaultVisualOfScreen scr) (.root_visual scr)))
+ (if (not (equal? (WidthOfScreen scr) (.width scr)))
+ (snd-display #__line__ ";WidthOfScreen: ~A ~A" (WidthOfScreen scr) (.width scr)))
+ (if (not (equal? (HeightOfScreen scr) (.height scr)))
+ (snd-display #__line__ ";HeightOfScreen: ~A ~A" (HeightOfScreen scr) (.height scr)))
+ (if (not (equal? (WidthMMOfScreen scr) (.mwidth scr)))
+ (snd-display #__line__ ";WidthMMOfScreen: ~A ~A" (WidthMMOfScreen scr) (.mwidth scr)))
+ (if (not (equal? (HeightMMOfScreen scr) (.mheight scr)))
+ (snd-display #__line__ ";HeightMMOfScreen: ~A ~A" (HeightMMOfScreen scr) (.mheight scr)))
+ (if (not (equal? (PlanesOfScreen scr) (.root_depth scr)))
+ (snd-display #__line__ ";PlanesOfScreen: ~A ~A" (PlanesOfScreen scr) (.root_depth scr)))
+ (if (not (equal? (MinCmapsOfScreen scr) (.min_maps scr)))
+ (snd-display #__line__ ";MinCmapsOfScreen: ~A ~A" (MinCmapsOfScreen scr) (.min_maps scr)))
+ (if (not (equal? (MaxCmapsOfScreen scr) (.max_maps scr)))
+ (snd-display #__line__ ";MaxCmapsOfScreen: ~A ~A" (MaxCmapsOfScreen scr) (.max_maps scr)))
+ (if (not (equal? (DoesSaveUnders scr) (.save_unders scr)))
+ (snd-display #__line__ ";DoesSaveUnders: ~A ~A" (DoesSaveUnders scr) (.save_unders scr)))
+ (if (not (equal? (DoesBackingStore scr) (.backing_store scr)))
+ (snd-display #__line__ ";DoesBackingStore: ~A ~A" (DoesBackingStore scr) (.backing_store scr)))
+ (if (not (equal? (EventMaskOfScreen scr) (.root_input_mask scr)))
+ (snd-display #__line__ ";EventMaskOfScreen: ~A ~A" (EventMaskOfScreen scr) (.root_input_mask scr)))
+
+ (if (not (equal? (XDisplayOfScreen scr) (.display scr)))
+ (snd-display #__line__ ";XDisplayOfScreen: ~A ~A" (XDisplayOfScreen scr) (.display scr)))
+ (if (not (equal? (XDisplayOfScreen (XScreenOfDisplay dpy 0)) dpy))
+ (snd-display #__line__ ";XScreenOfDisplay ~A ~A" (XDisplayOfScreen (XScreenOfDisplay dpy 0)) dpy))
+ (if (not (equal? (XDefaultScreenOfDisplay dpy) scr))
+ (snd-display #__line__ ";XDefaultScreenOfDisplay ~A ~A" (XDefaultScreenOfDisplay dpy) scr))
+ (if (not (equal? (XRootWindowOfScreen scr) (.root scr)))
+ (snd-display #__line__ ";XRootWindowOfScreen: ~A ~A" (XRootWindowOfScreen scr) (.root scr)))
+ (if (not (equal? (XBlackPixelOfScreen scr) (.black_pixel scr)))
+ (snd-display #__line__ ";XBlackPixelOfScreen: ~A ~A" (XBlackPixelOfScreen scr) (.black_pixel scr)))
+ (if (not (equal? (XWhitePixelOfScreen scr) (.white_pixel scr)))
+ (snd-display #__line__ ";XWhitePixelOfScreen: ~A ~A" (XWhitePixelOfScreen scr) (.white_pixel scr)))
+ (if (not (equal? (XDefaultColormapOfScreen scr) (.cmap scr)))
+ (snd-display #__line__ ";XDefaultColormapOfScreen: ~A ~A" (XDefaultColormapOfScreen scr) (.cmap scr)))
+ (if (not (equal? (XDefaultDepthOfScreen scr) (.root_depth scr)))
+ (snd-display #__line__ ";XDefaultDepthOfScreen: ~A ~A" (XDefaultDepthOfScreen scr) (.root_depth scr)))
+ (if (not (equal? (XDefaultGCOfScreen scr) (.default_gc scr)))
+ (snd-display #__line__ ";XDefaultGCOfScreen: ~A ~A" (XDefaultGCOfScreen scr) (.default_gc scr)))
+ (if (not (equal? (XDefaultVisualOfScreen scr) (.root_visual scr)))
+ (snd-display #__line__ ";XDefaultVisualOfScreen: ~A ~A" (XDefaultVisualOfScreen scr) (.root_visual scr)))
+ (if (not (equal? (XWidthOfScreen scr) (.width scr)))
+ (snd-display #__line__ ";XWidthOfScreen: ~A ~A" (XWidthOfScreen scr) (.width scr)))
+ (if (not (equal? (XHeightOfScreen scr) (.height scr)))
+ (snd-display #__line__ ";XHeightOfScreen: ~A ~A" (XHeightOfScreen scr) (.height scr)))
+ (if (not (equal? (XWidthMMOfScreen scr) (.mwidth scr)))
+ (snd-display #__line__ ";XWidthMMOfScreen: ~A ~A" (XWidthMMOfScreen scr) (.mwidth scr)))
+ (if (not (equal? (XHeightMMOfScreen scr) (.mheight scr)))
+ (snd-display #__line__ ";XHeightMMOfScreen: ~A ~A" (XHeightMMOfScreen scr) (.mheight scr)))
+ (if (not (equal? (XPlanesOfScreen scr) (.root_depth scr)))
+ (snd-display #__line__ ";XPlanesOfScreen: ~A ~A" (XPlanesOfScreen scr) (.root_depth scr)))
+ (if (not (equal? (XMinCmapsOfScreen scr) (.min_maps scr)))
+ (snd-display #__line__ ";XMinCmapsOfScreen: ~A ~A" (XMinCmapsOfScreen scr) (.min_maps scr)))
+ (if (not (equal? (XMaxCmapsOfScreen scr) (.max_maps scr)))
+ (snd-display #__line__ ";XMaxCmapsOfScreen: ~A ~A" (XMaxCmapsOfScreen scr) (.max_maps scr)))
+ (if (not (equal? (XDoesSaveUnders scr) (.save_unders scr)))
+ (snd-display #__line__ ";XDoesSaveUnders: ~A ~A" (XDoesSaveUnders scr) (.save_unders scr)))
+ (if (not (equal? (XDoesBackingStore scr) (.backing_store scr)))
+ (snd-display #__line__ ";XDoesBackingStore: ~A ~A" (XDoesBackingStore scr) (.backing_store scr)))
+ (if (not (equal? (XEventMaskOfScreen scr) (.root_input_mask scr)))
+ (snd-display #__line__ ";XEventMaskOfScreen: ~A ~A" (XEventMaskOfScreen scr) (.root_input_mask scr)))
+ )
+
+ (let* ((scr (current-screen))
+ (scrn (XScreenNumberOfScreen scr))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (vis (DefaultVisual dpy scrn))
+ (win (XtWindow (cadr (main-widgets)))))
+
+ (if (not (equal? (RootWindow dpy scrn) (.root scr)))
+ (snd-display #__line__ ";RootWindow: ~A ~A" (RootWindow dpy scrn) (.root scr)))
+ (if (not (equal? (DefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
+ (snd-display #__line__ ";DefaultRootWindow: ~A ~A" (DefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
+ (if (not (equal? (DefaultVisual dpy scrn) (.root_visual scr)))
+ (snd-display #__line__ ";DefaultVisual: ~A ~A" (DefaultVisual dpy scrn) (.root_visual scr)))
+ (if (not (equal? (DefaultGC dpy scrn) (.default_gc scr)))
+ (snd-display #__line__ ";DefaultGC: ~A ~A" (DefaultGC dpy scrn) (.default_gc scr)))
+ (if (not (equal? (BlackPixel dpy scrn) (.black_pixel scr)))
+ (snd-display #__line__ ";BlackPixel: ~A ~A" (BlackPixel dpy scrn) (.black_pixel scr)))
+ (if (not (equal? (WhitePixel dpy scrn) (.white_pixel scr)))
+ (snd-display #__line__ ";WhitePixel ~A ~A" (WhitePixel dpy scrn) (.white_pixel scr)))
+ (if (not (equal? (DisplayWidth dpy scrn) (.width scr)))
+ (snd-display #__line__ ";DisplayWidth: ~A ~A" (DisplayWidth dpy scrn) (.width scr)))
+ (if (not (equal? (DisplayHeight dpy scrn) (.height scr)))
+ (snd-display #__line__ ";DisplayHeight: ~A ~A" (DisplayHeight dpy scrn) (.height scr)))
+ (if (not (equal? (DisplayWidthMM dpy scrn) (.mwidth scr)))
+ (snd-display #__line__ ";DisplayWidthMM: ~A ~A" (DisplayWidthMM dpy scrn) (.mwidth scr)))
+ (if (not (equal? (DisplayHeightMM dpy scrn) (.mheight scr)))
+ (snd-display #__line__ ";DisplayHeightMM: ~A ~A" (DisplayHeightMM dpy scrn) (.mheight scr)))
+ (if (not (equal? (DisplayPlanes dpy scrn) (.root_depth scr)))
+ (snd-display #__line__ ";DisplayPlanes: ~A ~A" (DisplayPlanes dpy scrn) (.root_depth scr)))
+ (if (not (equal? (DefaultDepth dpy scrn) (.root_depth scr)))
+ (snd-display #__line__ ";DefaultDepth: ~A ~A" (DefaultDepth dpy scrn) (.root_depth scr)))
+ (if (not (equal? (DefaultColormap dpy scrn) (.cmap scr)))
+ (snd-display #__line__ ";DefaultColormap: ~A ~A" (DefaultColormap dpy scrn) (.cmap scr)))
+
+ (if (not (equal? (XRootWindow dpy scrn) (.root scr)))
+ (snd-display #__line__ ";XRootWindow: ~A ~A" (XRootWindow dpy scrn) (.root scr)))
+ (if (not (equal? (XDefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
+ (snd-display #__line__ ";XDefaultRootWindow: ~A ~A" (XDefaultRootWindow dpy) (.root (ScreenOfDisplay dpy (DefaultScreen dpy)))))
+ (if (not (equal? (XDefaultVisual dpy scrn) (.root_visual scr)))
+ (snd-display #__line__ ";XDefaultVisual: ~A ~A" (XDefaultVisual dpy scrn) (.root_visual scr)))
+ (if (not (equal? (XDefaultGC dpy scrn) (.default_gc scr)))
+ (snd-display #__line__ ";XDefaultGC: ~A ~A" (XDefaultGC dpy scrn) (.default_gc scr)))
+ (if (not (equal? (XBlackPixel dpy scrn) (.black_pixel scr)))
+ (snd-display #__line__ ";XBlackPixel: ~A ~A" (XBlackPixel dpy scrn) (.black_pixel scr)))
+ (if (not (equal? (XWhitePixel dpy scrn) (.white_pixel scr)))
+ (snd-display #__line__ ";XWhitePixel ~A ~A" (XWhitePixel dpy scrn) (.white_pixel scr)))
+ (if (not (equal? (XDisplayWidth dpy scrn) (.width scr)))
+ (snd-display #__line__ ";XDisplayWidth: ~A ~A" (XDisplayWidth dpy scrn) (.width scr)))
+ (if (not (equal? (XDisplayHeight dpy scrn) (.height scr)))
+ (snd-display #__line__ ";XDisplayHeight: ~A ~A" (XDisplayHeight dpy scrn) (.height scr)))
+ (if (not (equal? (XDisplayWidthMM dpy scrn) (.mwidth scr)))
+ (snd-display #__line__ ";XDisplayWidthMM: ~A ~A" (XDisplayWidthMM dpy scrn) (.mwidth scr)))
+ (if (not (equal? (XDisplayHeightMM dpy scrn) (.mheight scr)))
+ (snd-display #__line__ ";XDisplayHeightMM: ~A ~A" (XDisplayHeightMM dpy scrn) (.mheight scr)))
+ (if (not (equal? (XDisplayPlanes dpy scrn) (.root_depth scr)))
+ (snd-display #__line__ ";XDisplayPlanes: ~A ~A" (XDisplayPlanes dpy scrn) (.root_depth scr)))
+ (if (not (equal? (XDefaultDepth dpy scrn) (.root_depth scr)))
+ (snd-display #__line__ ";XDefaultDepth: ~A ~A" (XDefaultDepth dpy scrn) (.root_depth scr)))
+ (if (not (equal? (XDefaultColormap dpy scrn) (.cmap scr)))
+ (snd-display #__line__ ";XDefaultColormap: ~A ~A" (XDefaultColormap dpy scrn) (.cmap scr)))
+
+ (if (not (equal? (XDefaultVisual dpy scrn) vis))
+ (snd-display #__line__ ";XDefaultVisual: ~A ~A" (XDefaultVisual dpy scrn) vis))
+ (if (not (equal? (DisplayCells dpy scrn) (.map_entries vis)))
+ (snd-display #__line__ ";DisplayCells: ~A ~A" (DisplayCells dpy scrn) (.map_entries vis)))
+ (if (not (equal? (CellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
+ (snd-display #__line__ ";CellsOfScreen: ~A ~A" (CellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
+ (if (not (equal? (XDisplayCells dpy scrn) (.map_entries vis)))
+ (snd-display #__line__ ";XDisplayCells: ~A ~A" (XDisplayCells dpy scrn) (.map_entries vis)))
+ (if (not (equal? (XCellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
+ (snd-display #__line__ ";XCellsOfScreen: ~A ~A" (XCellsOfScreen scr) (.map_entries (DefaultVisualOfScreen scr))))
+ (if (< (XNextRequest dpy) (XLastKnownRequestProcessed dpy))
+ (snd-display #__line__ ";XRequests: ~A ~A" (XNextRequest dpy) (XLastKnownRequestProcessed dpy)))
+ (if (< (NextRequest dpy) (LastKnownRequestProcessed dpy))
+ (snd-display #__line__ ";Requests: ~A ~A" (NextRequest dpy) (LastKnownRequestProcessed dpy)))
+ (if (not (= (XDisplayMotionBufferSize dpy) 256))
+ (snd-display #__line__ ";XDisplayMotionBufferSize: ~A" (XDisplayMotionBufferSize dpy)))
+ (XGetMotionEvents dpy win (list 'Time 100) (list 'Time CurrentTime))
+
+ (let ((lmapk (XNewModifiermap 2))
+ (kcd (list 'KeyCode 50)))
+ (if (not (XModifierKeymap? lmapk))
+ (snd-display #__line__ ";xNewModifiermap: ~A" lmapk)
+ (begin
+ (set! lmapk (XInsertModifiermapEntry lmapk kcd ShiftMapIndex))
+ (set! lmapk (XDeleteModifiermapEntry lmapk kcd ShiftMapIndex))
+ ; (XFreeModifiermap lmapk) ;prone to segfault in X
)))
+
+ (if (not (= (XExtendedMaxRequestSize dpy) 4194303))
+ (snd-display #__line__ ";XExtendedMaxRequestSize ~A" (XExtendedMaxRequestSize dpy)))
+ (if (not (= (XMaxRequestSize dpy) 65535))
+ (snd-display #__line__ ";XMaxRequestSize ~A" (XMaxRequestSize dpy)))
+ (if (not (member (list 'Atom 40) (XListProperties dpy win)))
+ (snd-display #__line__ ";XListProperties: ~A" (XListProperties dpy win)))
+ (if (not (member "SHAPE" (XListExtensions dpy)))
+ (snd-display #__line__ ";XListExtensions: ~A" (XListExtensions dpy)))
+ (let ((val (XListInstalledColormaps dpy win)))
+ (if (or (not val)
+ (null? val)
+ (not (Colormap? (car val))))
+ (snd-display #__line__ ";XListInstalledColormaps: ~A" (XListInstalledColormaps dpy win))))
+ (if (not (string=? (XKeysymToString (list 'KeySym 80)) "P"))
+ (snd-display #__line__ ";XKeysymToString: ~A" (XKeysymToString (list 'KeySym 80))))
+ (if (not (string=? (XGetAtomName dpy (list 'Atom 40)) "WM_NORMAL_HINTS"))
+ (snd-display #__line__ ";XGetAtomName: ~A" (XGetAtomName dpy (list 'Atom 40))))
+
+ (if (not (= (.bits_per_rgb vis) 8)) (snd-display #__line__ ";bits_per_rgb: ~A" (.bits_per_rgb vis)))
+ (if (not (= (.blue_mask vis) 255)) (snd-display #__line__ ";blue_mask: ~A" (.blue_mask vis)))
+ (if (not (= (.green_mask vis) 65280)) (snd-display #__line__ ";green_mask: ~A" (.green_mask vis)))
+ (if (not (= (.red_mask vis) 16711680)) (snd-display #__line__ ";red_mask: ~A" (.red_mask vis)))
+ (if (not (= AllPlanes 4294967295)) (snd-display #__line__ ";AllPlanes: ~A" AllPlanes))
+
+ (if (< (QLength dpy) 0) (snd-display #__line__ ";QLength: ~A" (QLength dpy)))
+ (if (not (= (ScreenCount dpy) 1)) (snd-display #__line__ ";ScreenCount: ~A" (ScreenCount dpy)))
+ (if (not (string=? (ServerVendor dpy) "The X.Org Foundation")) (snd-display #__line__ ";ServerVendor: ~A" (ServerVendor dpy)))
+ (if (not (= (ProtocolRevision dpy) 0)) (snd-display #__line__ ";ProtocolRevision: ~A" (ProtocolRevision dpy)))
+ (if (not (= (ProtocolVersion dpy) 11)) (snd-display #__line__ ";ProtocolVersion: ~A" (ProtocolVersion dpy)))
+ (if (not (number? (VendorRelease dpy))) (snd-display #__line__ ";VendorRelease: ~A" (VendorRelease dpy)))
+ (if (not (string=? (DisplayString dpy) ":0.0")) (snd-display #__line__ ";DisplayString: ~A" (DisplayString dpy)))
+ (if (not (= (BitmapUnit dpy) 32)) (snd-display #__line__ ";BitmapUnit: ~A" (BitmapUnit dpy)))
+ (if (not (= (BitmapPad dpy) 32)) (snd-display #__line__ ";BitmapPad: ~A" (BitmapPad dpy)))
+ (if (not (= (BitmapBitOrder dpy) 0)) (snd-display #__line__ ";BitmapBitOrder: ~A" (BitmapBitOrder dpy)))
+ (if (not (= (ImageByteOrder dpy) 0)) (snd-display #__line__ ";ImageByteOrder: ~A" (ImageByteOrder dpy)))
+ (if (not (= (DefaultScreen dpy) 0)) (snd-display #__line__ ";DefaultScreen: ~A" (DefaultScreen dpy)))
+
+ (let* ((col (XColor))
+ (col1 (XColor))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr)))
+ (if (= (XAllocNamedColor dpy cmap "blue" col col) 0) (snd-display #__line__ ";XAllocNamedColor blue ~A?" col))
+ (if (not (= (.red col) 0)) (snd-display #__line__ ";XAllocNamedColor: ~A" (.red col)))
+ (if (= (XAllocColor dpy cmap col) 0) (snd-display #__line__ ";XAllocColor?"))
+ (if (not (= (.red col) 0)) (snd-display #__line__ ";XAllocColor: ~A" (.red col)))
+ (if (= (XParseColor dpy cmap "blue" col) 0) (snd-display #__line__ ";XParseColor?"))
+ (if (not (= (.red col) 0)) (snd-display #__line__ ";XParseColor: ~A" (.red col)))
+ (if (= (XAllocNamedColor dpy cmap "green" col1 col1) 0) (snd-display #__line__ ";XAllocNamedColor green ~A?" col1))
+ (XQueryColor dpy cmap col)
+ (XQueryColors dpy cmap (list col col1)))
+
+ (XSetAfterFunction dpy (lambda (n) 0))
+ (XSetAfterFunction dpy #f)
+ (if (not (equal? (XDisplayKeycodes dpy) (list 1 8 255)))
+ (snd-display #__line__ ";XDisplayKeycodes: ~A" (XDisplayKeycodes dpy)))
+ (let ((str (XFetchName dpy win)))
+ (if (not (string=? (substring str 0 3) "snd"))
+ (snd-display #__line__ ";XFetchName: ~A" str)))
+ (XStoreName dpy win "hiho")
+ (let ((str (XFetchName dpy win)))
+ (if (not (string=? str "hiho"))
+ (snd-display #__line__ ";XStoreName: ~A" str)))
+ (XStoreName dpy win "snd")
+ (let ((str (XGetIconName dpy win)))
+ (if (not (string=? str "snd"))
+ (snd-display #__line__ ";XGetIconName: ~A" str)))
+ (XSetIconName dpy win "hiho")
+ (let ((str (XGetIconName dpy win)))
+ (if (not (string=? str "hiho"))
+ (snd-display #__line__ ";XSetIconName: ~A" str)))
+ (let ((geo (XGetGeometry dpy win)))
+ (if (or (not (= (window-width) (geo 4)))
+ (not (= (window-height) (geo 5))))
+ (snd-display #__line__ ";XGetGeometry: ~A (~A ~A)" geo (window-width) (window-height))))
+ (let ((focus (XGetInputFocus dpy)))
+ (if (or (not (= (car focus) 1))
+ (not (Window? (cadr focus))))
+ (snd-display #__line__ ";XGetInputFocus: ~A" focus)))
+ (let ((vals (XGetPointerControl dpy)))
+ (if (not (equal? vals (list 1 2 1 4))) (snd-display #__line__ ";pointer state: ~A" vals))
+ (XChangePointerControl dpy #f #t 2 1 8)
+ (set! vals (XGetPointerControl dpy))
+ (if (not (equal? vals (list 1 2 1 8))) (snd-display #__line__ ";set pointer state: ~A" vals))
+ (XChangePointerControl dpy #f #t 2 1 4))
+ (XAutoRepeatOff dpy)
+ (if (not (= ((XGetKeyboardControl dpy) 5) 0)) (snd-display #__line__ ";AutoRepeatOff?"))
+ (XAutoRepeatOn dpy)
+ (if (not (= ((XGetKeyboardControl dpy) 5) 1)) (snd-display #__line__ ";AutoRepeatOn?"))
+ (let ((vals (XGetPointerMapping dpy 0 3)))
+ (if (not (equal? vals (list 1 2 3))) (snd-display #__line__ ";XGetPointerMapping: ~A" vals)))
+ (XGetScreenSaver dpy)
+ (XMoveWindow dpy win 100 10)
+ (XSync dpy #f)
+ (XResizeWindow dpy win 400 400)
+ (XSync dpy #f)
+ (XMoveResizeWindow dpy win 120 20 500 500)
+ (XSync dpy #f)
+ (let ((attr (XGetWindowAttributes dpy win)))
+ (if (> (abs (- (.x attr) 120)) 200) (snd-display #__line__ ";XMoveWindow x etc: ~A" (.x attr)))
+ (if (> (abs (- (.y attr) 20)) 200) (snd-display #__line__ ";XMoveWindow y etc: ~A" (.y attr)))
+ (if (> (abs (- (.width attr) 500)) 20) (snd-display #__line__ ";XMoveWindow width etc: ~A" (.width attr)))
+ (if (> (abs (- (.height attr) 500)) 20) (snd-display #__line__ ";XMoveWindow height etc: ~A" (.height attr)))
+ (if (not (= (.border_width attr) 0)) (snd-display #__line__ ";XGetWindowAttributes border_width: ~A" (.border_width attr)))
+ (if (not (= (.depth attr) 24)) (snd-display #__line__ ";XGetWindowAttributes depth: ~A" (.depth attr)))
+ (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";XGetWindowAttributes bit_gravity: ~A" (.bit_gravity attr)))
+ (if (not (= (.win_gravity attr) 1)) (snd-display #__line__ ";XGetWindowAttributes win_gravity: ~A" (.win_gravity attr)))
+ (if (.backing_store attr) (snd-display #__line__ ";XGetWindowAttributes backing_store: ~A" (.backing_store attr)))
+ (if (.override_redirect attr) (snd-display #__line__ ";XGetWindowAttributes override_redirect: ~A" (.override_redirect attr)))
+ (if (.save_under attr) (snd-display #__line__ ";XGetWindowAttributes save_under: ~A" (.save_under attr)))
+ ; (if (.map_installed attr) (snd-display #__line__ ";XGetWindowAttributes map_installed: ~A" (.map_installed attr)))
+ (if (not (equal? (.backing_pixel attr) (list 'Pixel 0))) (snd-display #__line__ ";XGetWindowAttributes backing_pixel: ~A" (.backing_pixel attr)))
+ (if (not (= (.map_state attr) 2)) (snd-display #__line__ ";XGetWindowAttributes map_state: ~A" (.map_state attr)))
+ (if (not (= (.your_event_mask attr) #x628033)) (snd-display #__line__ ";your_event_mask: ~X" (.your_event_mask attr)))
+ (if (and (not (= (.all_event_masks attr) #x628033))
+ (not (= (.all_event_masks attr) #xe28033))
+ (not (= (.all_event_masks attr) #xea8033)))
+ (snd-display #__line__ ";all_event_masks: ~X" (.all_event_masks attr)))
+ (if (not (Screen? (.screen attr))) (snd-display #__line__ ";XGetWindowAttributes screen: ~A" (.screen attr)))
+ (if (and (not (= (.do_not_propagate_mask attr) 0))
+ (not (= (.do_not_propagate_mask attr) 8204)))
+ (snd-display #__line__ ";XGetWindowAttributes do_not_propagate_mask: ~A" (.do_not_propagate_mask attr)))
+ (if (not (= (.backing_planes attr) AllPlanes)) (snd-display #__line__ ";XGetWindowAttributes backing_planes: ~A" (.backing_planes attr)))
+ (if (not (= (.win_gravity attr) 1)) (snd-display #__line__ ";XGetWindowAttributes win_gravity: ~A" (.win_gravity attr)))
+ (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";XGetWindowAttributes bit_gravity: ~A" (.bit_gravity attr)))
+ ;(segfault) (XFree (cadr attr))
+ )
+ (XResetScreenSaver dpy)
+ (if (< (XPending dpy) 0) (snd-display #__line__ ";XPending: ~A" (XPending dpy)))
+ (XNoOp dpy)
+ (XQueryBestStipple dpy win 100 100)
+ (XQueryBestTile dpy win 100 100)
+ (XQueryBestSize dpy 0 win 100 100)
+ (let ((ext (XQueryExtension dpy "SHAPE")))
+ (if (not (eq? (car ext) #t))
+ (snd-display #__line__ ";XQueryExtension: ~A" ext)))
+ (XQueryKeymap dpy)
+ (let ((tree (XQueryTree dpy win)))
+ (if (or (not (= (car tree) 1))
+ (not (equal? (XRootWindow dpy 0) (cadr tree))))
+ (snd-display #__line__ ";XQueryTree: ~A (~A)" tree (XRootWindow dpy 0))))
+
+ (if (< (XQLength dpy) 0) (snd-display #__line__ ";XQLength: ~A" (XQLength dpy)))
+ (if (not (= (XScreenCount dpy) 1)) (snd-display #__line__ ";XScreenCount: ~A" (XScreenCount dpy)))
+ (if (not (string=? (XServerVendor dpy) "The X.Org Foundation")) (snd-display #__line__ ";XServerVendor: ~A" (XServerVendor dpy)))
+ (if (not (= (XProtocolRevision dpy) 0)) (snd-display #__line__ ";XProtocolRevision: ~A" (XProtocolRevision dpy)))
+ (if (not (= (XProtocolVersion dpy) 11)) (snd-display #__line__ ";XProtocolVersion: ~A" (XProtocolVersion dpy)))
+ (if (not (number? (XVendorRelease dpy))) (snd-display #__line__ ";XVendorRelease: ~A" (XVendorRelease dpy)))
+ (if (not (string=? (XDisplayString dpy) ":0.0")) (snd-display #__line__ ";XDisplayString: ~A" (XDisplayString dpy)))
+ (if (not (= (XBitmapUnit dpy) 32)) (snd-display #__line__ ";XBitmapUnit: ~A" (XBitmapUnit dpy)))
+ (if (not (= (XBitmapPad dpy) 32)) (snd-display #__line__ ";XBitmapPad: ~A" (XBitmapPad dpy)))
+ (if (not (= (XBitmapBitOrder dpy) 0)) (snd-display #__line__ ";XBitmapBitOrder: ~A" (XBitmapBitOrder dpy)))
+ (if (not (= (XImageByteOrder dpy) 0)) (snd-display #__line__ ";XImageByteOrder: ~A" (XImageByteOrder dpy)))
+ (if (not (= (XDefaultScreen dpy) 0)) (snd-display #__line__ ";XDefaultScreen: ~A" (XDefaultScreen dpy)))
+ (if (XGetIconSizes dpy win) (snd-display #__line__ ";XGetIconSizes: ~A" (XGetIconSizes dpy win)))
+ (if (XGetRGBColormaps dpy win XA_RGB_DEFAULT_MAP)
+ (snd-display #__line__ ";XGetRGBColormaps: ~A!" (XGetRGBColormaps dpy win XA_RGB_DEFAULT_MAP)))
+ (let ((cmap (XAllocStandardColormap)))
+ (for-each
+ (lambda (func name)
+ (if (not (= (func cmap) 0)) (snd-display #__line__ ";standardcolormap ~A: ~A" name (func cmap))))
+ (list .visualid .red_max .red_mult .green_max .green_mult .blue_max .blue_mult)
+ (list 'visualid 'red_max 'red_mult 'green_max 'green_mult 'blue_max 'blue_mult))
+ (if (.colormap cmap) (snd-display #__line__ ";colormap: ~A" (.colormap cmap)))
+ (XtFree (cadr cmap))
+ )
+ (let ((icon (XAllocIconSize)))
+ (for-each
+ (lambda (func name)
+ (if (not (= (func icon) 0)) (snd-display #__line__ ";iconsize ~A: ~A" name (func icon))))
+ (list .min_width .min_height .max_width .max_height .width_inc .height_inc)
+ (list 'min_width 'min_height 'max_width 'max_height 'width_inc 'height_inc))
+ (XFree icon))
+
+ (let ((fs (XCreateFontSet dpy "*-*-*-*-Normal-*-*-*-*-*-*")))
+ (if (or (not (XFontSet? fs))
+ (= (cadr fs) 0))
+ (snd-display #__line__ ";XCreateFontSet: ~A" fs)
+ (let* ((fnts (XFontsOfFontSet fs))
+ (fnt (caar fnts)))
+ (if (not (XFontStruct? fnt))
+ (snd-display #__line__ ";XFontsOfFontSet: ~A" fnts))
+ (if (XContextualDrawing fs)
+ (snd-display #__line__ ";XContextualDrawing: ~A" (XContextualDrawing fs)))
+ (if (XContextDependentDrawing fs)
+ (snd-display #__line__ ";XContextDependentDrawing: ~A" (XContextDependentDrawing fs)))
+ (if (XDirectionalDependentDrawing fs)
+ (snd-display #__line__ ";XDirectionalDependentDrawing: ~A" (XDirectionalDependentDrawing fs)))
+ (if (not (string=? (XLocaleOfFontSet fs) "en_US"))
+ (snd-display #__line__ ";XLocaleOfFontSet: ~A" (XLocaleOfFontSet fs)))
+ (if (not (string=? (XBaseFontNameListOfFontSet fs) "*-*-*-*-Normal-*-*-*-*-*-*"))
+ (snd-display #__line__ ";XBaseFontNameListOfFontSet: ~A" (XBaseFontNameListOfFontSet fs)))
+ (if fnt
+ (let ((wgt (XGetFontProperty fnt XA_WEIGHT))
+ (siz (XGetFontProperty fnt XA_POINT_SIZE)))
+ (if (or (not (= (cadr wgt) 10))
+ (not (= (cadr siz) 120)))
+ (snd-display #__line__ ";XGetFontProperty: ~A ~A" wgt siz))
+ (if (not (= (.descent fnt) 2)) (snd-display #__line__ ";descent: ~A" (.descent fnt)))
+ (if (not (= (.ascent fnt) 11)) (snd-display #__line__ ";ascent: ~A" (.ascent fnt)))
+ (if (not (XCharStruct? (.per_char fnt))) (snd-display #__line__ ";per_char: ~A" (.per_char fnt)))
+ (if (not (XCharStruct? (.max_bounds fnt))) (snd-display #__line__ ";max_bounds: ~A" (.max_bounds fnt)))
+ (if (not (XCharStruct? (.min_bounds fnt))) (snd-display #__line__ ";min_bounds: ~A" (.min_bounds fnt)))
+ (if (not (XFontProp? (car (.properties fnt)))) (snd-display #__line__ ";properties ~A" (.properties fnt)))
+ (if (not (= (.card32 (car (.properties fnt))) 7)) (snd-display #__line__ ";card32: ~A" (.card32 (car (.properties fnt)))))))
+ (XFreeFontSet dpy fs))))
+ (XBell dpy 10)
+ (let ((cmd (XGetCommand dpy win)))
+ (if (or (<= (length cmd) 0)
+ (not (string=? (substring (car cmd) (- (length (car cmd)) 3)) "snd")))
+ (snd-display #__line__ ";XGetCommand: ~A" cmd)))
+ (XSetCommand dpy win (list "hiho" "away") 2)
+ (if (not (equal? (XGetCommand dpy win) (list "hiho" "away")))
+ (snd-display #__line__ ";XSetCommand: ~A" (XGetCommand dpy win)))
+ (let ((wmp (map (lambda (w) (XGetAtomName dpy w)) (XGetWMProtocols dpy win))))
+ (if (not (equal? wmp (list "_MOTIF_WM_MESSAGES" "WM_DELETE_WINDOW")))
+ (snd-display #__line__ ";XGetWMProtocols: ~A" wmp)))
+ (if (not (equal? (XListDepths dpy 0) (list 24 1 4 8 15 16 32)))
+ (snd-display #__line__ ";XListDepths: ~A" (XListDepths dpy 0)))
+ (if (not (equal? (XListPixmapFormats dpy) '((1 1 32) (4 8 32) (8 8 32) (15 16 32) (16 16 32) (24 32 32) (32 32 32))))
+ (snd-display #__line__ ";XListPixmapFormats: ~A" (XListPixmapFormats dpy)))
+
+ (XWarpPointer dpy (list 'Window None) (list 'Window None) 0 0 10 10 100 100)
+ (let ((cs (XQueryBestCursor dpy win 10 10)))
+ (if (not (equal? cs (list 1 10 10))) (snd-display #__line__ ";XQueryBestCursor: ~A" cs)))
+ (let ((pt (XQueryPointer dpy win)))
+ (if (not (Window? (cadr pt))) (snd-display #__line__ ";XQueryPointer: ~A" pt)))
+ (XRaiseWindow dpy win)
+ (XRotateBuffers dpy 1)
+ (XSetWindowBorderWidth dpy win 10)
+ (XSetWindowBorder dpy win (black-pixel))
+ (XSetWindowBackground dpy win *basic-color*)
+ (let* ((vis (XGetVisualInfo dpy 0 (list 'XVisualInfo 0)))
+ (depth (.depth (car vis))))
+ (XSetWindowBorderPixmap dpy win (XCreatePixmap dpy win 10 10 depth))
+ (XSetWindowBackgroundPixmap dpy win (XCreatePixmap dpy win 10 10 depth))
+ (XSetWindowBorderPixmap dpy win CopyFromParent)
+ (XSetWindowBackgroundPixmap dpy win ParentRelative)
+ ;(segfault) (XFree (cadr vis))
+ )
+ (let ((hints (XGetWMHints dpy win)))
+ (if (or (not hints) (not (XWMHints? hints))) (snd-display #__line__ ";XGetWMHints?"))
+ (if (not (= (.flags hints) 7)) (snd-display #__line__ ";flags wmhints: ~A" (.flags hints)))
+ (if (not (= (.initial_state hints) 1)) (snd-display #__line__ ";initial_state wmhints: ~A" (.initial_state hints)))
+ (if (not (.input hints)) (snd-display #__line__ ";input wmhints: ~A" (.input hints)))
+ (if (not (Pixmap? (.icon_pixmap hints))) (snd-display #__line__ ";icon_pixmap wmhints: ~A" (.icon_pixmap hints)))
+ (if (.icon_window hints) (snd-display #__line__ ";icon_window: ~A" (.icon_window hints)))
+ (if (not (equal? (.icon_mask hints) (list 'Pixmap 0))) (snd-display #__line__ ";icon_mask: ~A" (.icon_mask hints)))
+ (if (not (number? (.window_group hints))) (snd-display #__line__ ";window_group: ~A" (.window_group hints)))
+ (XtFree (cadr hints))
+ (let ((st (XAllocWMHints)))
+ (if (not (XWMHints? st)) (snd-display #__line__ ";XAllocWMHints: ~A" st))
+ (XFree st))))
+
+ (if (not (IsKeypadKey (list 'KeySym XK_KP_Space))) (snd-display #__line__ ";IsKeypadKey kp-space"))
+ (if (IsKeypadKey (list 'KeySym XK_A)) (snd-display #__line__ ";IsKeypadKey A"))
+ (if (IsPrivateKeypadKey (list 'KeySym XK_A)) (snd-display #__line__ ";IsPrivateKeypadKey A"))
+ (if (not (IsCursorKey (list 'KeySym XK_Home))) (snd-display #__line__ ";IsCursorKey Home"))
+ (if (IsCursorKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsCursorKey S"))
+ (if (not (IsPFKey (list 'KeySym XK_KP_F1))) (snd-display #__line__ ";IsPFKey F1"))
+ (if (IsPFKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsPFKey S"))
+ (if (not (IsFunctionKey (list 'KeySym XK_F1))) (snd-display #__line__ ";IsFunctionKey F1"))
+ (if (IsFunctionKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsFunctionKey S"))
+ (if (not (IsMiscFunctionKey (list 'KeySym XK_Select))) (snd-display #__line__ ";IsMiscFunctionKey Select"))
+ (if (IsMiscFunctionKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsMiscFunctionKey S"))
+ (if (not (IsModifierKey (list 'KeySym XK_Shift_L))) (snd-display #__line__ ";IsModifierKey Shift"))
+ (if (IsModifierKey (list 'KeySym XK_S)) (snd-display #__line__ ";IsModifierKey S"))
+
+ (let (;(scr (current-screen))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (val (XGCValues))
+ (wn (XtWindow (cadr (main-widgets)))))
+ (set! (.function val) GXclear)
+ (if (not (equal? (.function val) GXclear))
+ (snd-display #__line__ ";function: ~A ~A" (.function val) GXclear))
+ (set! (.line_width val) 10)
+ (if (not (eqv? (.line_width val) 10))
+ (snd-display #__line__ ";line_width: ~A ~A" (.line_width val) 10))
+ (set! (.line_style val) LineSolid)
+ (if (not (equal? (.line_style val) LineSolid))
+ (snd-display #__line__ ";line_style: ~A ~A" (.line_style val) LineSolid))
+ (set! (.background val) (WhitePixelOfScreen (current-screen)))
+ (if (not (equal? (.background val) (WhitePixelOfScreen (current-screen))))
+ (snd-display #__line__ ";background: ~A ~A" (.background val) (WhitePixelOfScreen (current-screen))))
+ (set! (.foreground val) (BlackPixelOfScreen (current-screen)))
+ (if (not (equal? (.foreground val) (BlackPixelOfScreen (current-screen))))
+ (snd-display #__line__ ";foreground: ~A ~A" (.foreground val) (BlackPixelOfScreen (current-screen))))
+ ;; plane_mask?
+ (set! (.cap_style val) CapRound)
+ (if (not (equal? (.cap_style val) CapRound))
+ (snd-display #__line__ ";cap_style: ~A ~A" (.cap_style val) CapRound))
+ (set! (.join_style val) JoinMiter)
+ (if (not (equal? (.join_style val) JoinMiter))
+ (snd-display #__line__ ";join_style: ~A ~A" (.join_style val) JoinMiter))
+ (set! (.fill_style val) FillSolid)
+ (if (not (equal? (.fill_style val) FillSolid))
+ (snd-display #__line__ ";fill_style: ~A ~A" (.fill_style val) FillSolid))
+ (set! (.fill_rule val) EvenOddRule)
+ (if (not (equal? (.fill_rule val) EvenOddRule))
+ (snd-display #__line__ ";fill_rule: ~A ~A" (.fill_rule val) EvenOddRule))
+ (set! (.arc_mode val) ArcChord)
+ (if (not (equal? (.arc_mode val) ArcChord))
+ (snd-display #__line__ ";arc_mode: ~A ~A" (.arc_mode val) ArcChord))
+ ;; tile stipple clip_mask are Pixmaps
+ (set! (.ts_x_origin val) 1)
+ (if (not (eqv? (.ts_x_origin val) 1))
+ (snd-display #__line__ ";ts_x_origin: ~A ~A" (.ts_x_origin val) 1))
+ (set! (.ts_y_origin val) 1)
+ (if (not (eqv? (.ts_y_origin val) 1))
+ (snd-display #__line__ ";ts_y_origin: ~A ~A" (.ts_y_origin val) 1))
+ ;; font is Font
+ (set! (.subwindow_mode val) ClipByChildren)
+ (if (not (equal? (.subwindow_mode val) ClipByChildren))
+ (snd-display #__line__ ";subwindow_mode: ~A ~A" (.subwindow_mode val) ClipByChildren))
+ (set! (.graphics_exposures val) #f)
+ (if (.graphics_exposures val)
+ (snd-display #__line__ ";graphics_exposures: ~A ~A" (.graphics_exposures val) #f))
+ (set! (.clip_x_origin val) 0)
+ (if (not (eqv? (.clip_x_origin val) 0))
+ (snd-display #__line__ ";clip_x_origin: ~A ~A" (.clip_x_origin val) 0))
+ (set! (.clip_y_origin val) 0)
+ (if (not (eqv? (.clip_y_origin val) 0))
+ (snd-display #__line__ ";clip_y_origin: ~A ~A" (.clip_y_origin val) 0))
+ (set! (.dash_offset val) 1)
+ (if (not (eqv? (.dash_offset val) 1))
+ (snd-display #__line__ ";dash_offset: ~A ~A" (.dash_offset val) 1))
+ (if (not (number? (XConnectionNumber dpy)))
+ (snd-display #__line__ ";XConnectionNumber: ~A" (XConnectionNumber dpy)))
+
+ (let ((sgc (XCreateGC dpy wn (+ GCFunction GCForeground GCBackground GCLineWidth GCLineStyle
+ GCCapStyle GCJoinStyle GCFillStyle GCFillRule GCTileStipXOrigin
+ GCTileStipYOrigin GCSubwindowMode GCGraphicsExposures GCClipXOrigin
+ GCClipYOrigin GCDashOffset GCArcMode)
+ val)))
- (let ((atoms (list XA_PRIMARY XA_SECONDARY XA_ARC XA_ATOM XA_BITMAP XA_CARDINAL XA_COLORMAP XA_CURSOR XA_CUT_BUFFER0
- XA_CUT_BUFFER1 XA_CUT_BUFFER2 XA_CUT_BUFFER3 XA_CUT_BUFFER4 XA_CUT_BUFFER5 XA_CUT_BUFFER6
- XA_CUT_BUFFER7 XA_DRAWABLE XA_FONT XA_INTEGER XA_PIXMAP XA_POINT XA_RECTANGLE XA_RESOURCE_MANAGER
- XA_RGB_COLOR_MAP XA_RGB_BEST_MAP XA_RGB_BLUE_MAP XA_RGB_DEFAULT_MAP XA_RGB_GRAY_MAP XA_RGB_GREEN_MAP
- XA_RGB_RED_MAP XA_STRING XA_VISUALID XA_WINDOW XA_WM_COMMAND XA_WM_HINTS XA_WM_CLIENT_MACHINE
- XA_WM_ICON_NAME XA_WM_ICON_SIZE XA_WM_NAME XA_WM_NORMAL_HINTS XA_WM_SIZE_HINTS XA_WM_ZOOM_HINTS
- XA_MIN_SPACE XA_NORM_SPACE XA_MAX_SPACE XA_END_SPACE XA_SUPERSCRIPT_X XA_SUPERSCRIPT_Y
- XA_SUBSCRIPT_X XA_SUBSCRIPT_Y XA_UNDERLINE_POSITION XA_UNDERLINE_THICKNESS XA_STRIKEOUT_ASCENT
- XA_STRIKEOUT_DESCENT XA_ITALIC_ANGLE XA_X_HEIGHT XA_QUAD_WIDTH XA_WEIGHT XA_POINT_SIZE
- XA_RESOLUTION XA_COPYRIGHT XA_NOTICE XA_FONT_NAME XA_FAMILY_NAME XA_FULL_NAME XA_CAP_HEIGHT
- XA_WM_CLASS XA_WM_TRANSIENT_FOR))
- (atom-names (list 'XA_PRIMARY 'XA_SECONDARY 'XA_ARC 'XA_ATOM 'XA_BITMAP 'XA_CARDINAL 'XA_COLORMAP 'XA_CURSOR 'XA_CUT_BUFFER0
- 'XA_CUT_BUFFER1 'XA_CUT_BUFFER2 'XA_CUT_BUFFER3 'XA_CUT_BUFFER4 'XA_CUT_BUFFER5 'XA_CUT_BUFFER6
- 'XA_CUT_BUFFER7 'XA_DRAWABLE 'XA_FONT 'XA_INTEGER 'XA_PIXMAP 'XA_POINT 'XA_RECTANGLE 'XA_RESOURCE_MANAGER
- 'XA_RGB_COLOR_MAP 'XA_RGB_BEST_MAP 'XA_RGB_BLUE_MAP 'XA_RGB_DEFAULT_MAP 'XA_RGB_GRAY_MAP 'XA_RGB_GREEN_MAP
- 'XA_RGB_RED_MAP 'XA_STRING 'XA_VISUALID 'XA_WINDOW 'XA_WM_COMMAND 'XA_WM_HINTS 'XA_WM_CLIENT_MACHINE
- 'XA_WM_ICON_NAME 'XA_WM_ICON_SIZE 'XA_WM_NAME 'XA_WM_NORMAL_HINTS 'XA_WM_SIZE_HINTS 'XA_WM_ZOOM_HINTS
- 'XA_MIN_SPACE 'XA_NORM_SPACE 'XA_MAX_SPACE 'XA_END_SPACE 'XA_SUPERSCRIPT_X 'XA_SUPERSCRIPT_Y
- 'XA_SUBSCRIPT_X 'XA_SUBSCRIPT_Y 'XA_UNDERLINE_POSITION 'XA_UNDERLINE_THICKNESS 'XA_STRIKEOUT_ASCENT
- 'XA_STRIKEOUT_DESCENT 'XA_ITALIC_ANGLE 'XA_X_HEIGHT 'XA_QUAD_WIDTH 'XA_WEIGHT 'XA_POINT_SIZE
- 'XA_RESOLUTION 'XA_COPYRIGHT 'XA_NOTICE 'XA_FONT_NAME 'XA_FAMILY_NAME 'XA_FULL_NAME 'XA_CAP_HEIGHT
- 'XA_WM_CLASS 'XA_WM_TRANSIENT_FOR)))
- (for-each
- (lambda (n name)
- (if (not (Atom? n))
- (snd-display #__line__ ";Atom: ~A -> ~A" name (Atom? n))))
- atoms
- atom-names))
-
- (let ((r (XRectangle 10 20 100 110)))
- (if (not (= (.width r) 100))
- (snd-display #__line__ ";XRectangle width: ~A" (.width r)))
- (if (not (= (.height r) 110))
- (snd-display #__line__ ";XRectangle height: ~A" (.height r)))
- (if (not (= (.x r) 10))
- (snd-display #__line__ ";XRectangle x: ~A" (.x r)))
- (if (not (= (.y r) 20))
- (snd-display #__line__ ";XRectangle y: ~A" (.y r)))
- (set! (.width r) 10)
- (if (not (= (.width r) 10))
- (snd-display #__line__ ";set XRectangle width: ~A" (.width r)))
- (set! (.height r) 11)
- (if (not (= (.height r) 11))
- (snd-display #__line__ ";set XRectangle height: ~A" (.height r)))
- (set! (.x r) 1)
- (if (not (= (.x r) 1))
- (snd-display #__line__ ";set XRectangle x: ~A" (.x r)))
- (set! (.y r) 2)
- (if (not (= (.y r) 2))
- (snd-display #__line__ ";XRectangle y: ~A" (.y r))))
-
- (let ((r (XArc 10 20 100 110 0 235)))
- (if (not (= (.width r) 100))
- (snd-display #__line__ ";XArc width: ~A" (.width r)))
- (if (not (= (.height r) 110))
- (snd-display #__line__ ";XArc height: ~A" (.height r)))
- (if (not (= (.x r) 10))
- (snd-display #__line__ ";XArc x: ~A" (.x r)))
- (if (not (= (.y r) 20))
- (snd-display #__line__ ";XArc y: ~A" (.y r)))
- (if (not (= (.angle1 r) 0))
- (snd-display #__line__ ";XArc angle1: ~A" (.angle1 r)))
- (if (not (= (.angle2 r) 235))
- (snd-display #__line__ ";XArc angle2: ~A" (.angle2 r)))
- (set! (.width r) 10)
- (if (not (= (.width r) 10))
- (snd-display #__line__ ";set XArc width: ~A" (.width r)))
- (set! (.height r) 11)
- (if (not (= (.height r) 11))
- (snd-display #__line__ ";set XArc height: ~A" (.height r)))
- (set! (.x r) 1)
- (if (not (= (.x r) 1))
- (snd-display #__line__ ";set XArc x: ~A" (.x r)))
- (set! (.y r) 2)
- (if (not (= (.y r) 2))
- (snd-display #__line__ ";set XArc y: ~A" (.y r)))
- (set! (.angle1 r) 123)
- (if (not (= (.angle1 r) 123))
- (snd-display #__line__ ";set XArc angle1: ~A" (.angle1 r)))
- (set! (.angle2 r) 321)
- (if (not (= (.angle2 r) 321))
- (snd-display #__line__ ";set XArc angle2: ~A" (.angle2 r))))
-
- (let ((r (XPoint 10 20)))
- (if (not (= (.x r) 10))
- (snd-display #__line__ ";XPoint x: ~A" (.x r)))
- (if (not (= (.y r) 20))
- (snd-display #__line__ ";XPoint y: ~A" (.y r)))
- (set! (.x r) 1)
- (if (not (= (.x r) 1))
- (snd-display #__line__ ";set XPoint x: ~A" (.x r)))
- (set! (.y r) 2)
- (if (not (= (.y r) 2))
- (snd-display #__line__ ";set XPoint y: ~A" (.y r))))
-
- (let ((r (XSegment 10 20 100 110)))
- (if (not (= (.x1 r) 10))
- (snd-display #__line__ ";XSegment x1: ~A" (.x1 r)))
- (if (not (= (.y1 r) 20))
- (snd-display #__line__ ";XSegment y1: ~A" (.y1 r)))
- (if (not (= (.x2 r) 100))
- (snd-display #__line__ ";XSegment x2: ~A" (.x2 r)))
- (if (not (= (.y2 r) 110))
- (snd-display #__line__ ";XSegment y2: ~A" (.y2 r)))
- (set! (.x1 r) 1)
- (if (not (= (.x1 r) 1))
- (snd-display #__line__ ";set XSegment x1: ~A" (.x1 r)))
- (set! (.y1 r) 2)
- (if (not (= (.y1 r) 2))
- (snd-display #__line__ ";set XSegment y1: ~A" (.y1 r)))
- (set! (.x2 r) 10)
- (if (not (= (.x2 r) 10))
- (snd-display #__line__ ";set XSegment x2: ~A" (.x2 r)))
- (set! (.y2 r) 11)
- (if (not (= (.y2 r) 11))
- (snd-display #__line__ ";set XSegment y2: ~A" (.y2 r))))
-
- (let ((c (XColor)))
- (set! (.red c) 1)
- (if (not (= (.red c) 1)) (snd-display #__line__ ";Xcolor red: ~A" (.red c)))
- (set! (.green c) 1)
- (if (not (= (.green c) 1)) (snd-display #__line__ ";Xcolor green: ~A" (.green c)))
- (set! (.blue c) 1)
- (if (not (= (.blue c) 1)) (snd-display #__line__ ";Xcolor blue: ~A" (.blue c)))
- (set! (.flags c) DoRed)
- (if (not (= (.flags c) DoRed)) (snd-display #__line__ ";Xcolor flags: ~A" (.flags c)))
- (if (not (= (.pad c) 0)) (snd-display #__line__ ";pad: ~A" (.pad c)))
- (set! (.pixel c) (basic-color))
- (if (not (equal? (.pixel c) (basic-color))) (snd-display #__line__ ";Xcolor pixel: ~A" (.pixel c))))
-
- (let ((obj (XTextItem "hiho" 4 3 (list 'Font 1))))
- (if (not (XTextItem? obj)) (snd-display #__line__ ";XTextItem -> ~A" obj))
- (if (not (equal? (.font obj) (list 'Font 1))) (snd-display #__line__ ";font ~A" (.font obj)))
- (set! (.font obj) (list 'Font 2))
- (if (not (equal? (.font obj) (list 'Font 2))) (snd-display #__line__ ";set font ~A" (.font obj)))
- (if (not (string=? (.chars obj) "hiho")) (snd-display #__line__ ";chars: ~A" (.chars obj)))
- (if (not (= (.nchars obj) 4)) (snd-display #__line__ ";chars: ~A" (.nchars obj)))
- (set! (.chars obj) "away!")
- (set! (.nchars obj) 5)
- (if (not (string=? (.chars obj) "away!")) (snd-display #__line__ ";set chars: ~A" (.chars obj)))
- (if (not (= (.nchars obj) 5)) (snd-display #__line__ ";set chars: ~A" (.nchars obj)))
- (if (not (= (.delta obj) 3)) (snd-display #__line__ ";delta ~A" (.delta obj)))
- (set! (.delta obj) 4)
- (if (not (= (.delta obj) 4)) (snd-display #__line__ ";set delta ~A" (.delta obj)))
- )
-
- (let ((reg (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule)))
- (if (not (XPointInRegion reg 4 4)) (snd-display #__line__ ";XPointInRegion"))
- (XShrinkRegion reg 1 2)
- (if (not (XPointInRegion reg 4 7)) (snd-display #__line__ ";t XShrinkRegion"))
- (if (XPointInRegion reg 4 9) (snd-display #__line__ ";f XShrinkRegion"))
- (XOffsetRegion reg 1 2)
- (if (not (XPointInRegion reg 4 9)) (snd-display #__line__ ";t XOffsetRegion"))
- (if (XPointInRegion reg 1 9) (snd-display #__line__ ";f XOffsetRegion"))
- (let ((reg2 (XCreateRegion))
- (reg1 (XPolygonRegion (list (XPoint 2 2) (XPoint 10 2) (XPoint 10 10) (XPoint 2 10)) 4 WindingRule)))
- (if (XEqualRegion reg reg1) (snd-display #__line__ ";f XEqualRegion"))
- (if (XEmptyRegion reg) (snd-display #__line__ ";f XEmptyRegion"))
- (XXorRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 2))
- (not (= (.y (cadr box)) 2))
- (not (= (.width (cadr box)) 8))
- (not (= (.height (cadr box)) 2)))
- (snd-display #__line__ ";XXorRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XUnionRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 2))
- (not (= (.y (cadr box)) 2))
- (not (= (.width (cadr box)) 8))
- (not (= (.height (cadr box)) 8)))
- (snd-display #__line__ ";XUnionRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XSubtractRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 0))
- (not (= (.y (cadr box)) 0))
- (not (= (.width (cadr box)) 0))
- (not (= (.height (cadr box)) 0)))
- (snd-display #__line__ ";XSubtractRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XIntersectRegion reg reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 2))
- (not (= (.y (cadr box)) 4))
- (not (= (.width (cadr box)) 8))
- (not (= (.height (cadr box)) 6)))
- (snd-display #__line__ ";XIntersectRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XUnionRectWithRegion (XRectangle 1 3 100 100) reg1 reg2)
- (let ((box (XClipBox reg2)))
- (if (or (not (= (.x (cadr box)) 1))
- (not (= (.y (cadr box)) 2))
- (not (= (.width (cadr box)) 100))
- (not (= (.height (cadr box)) 101)))
- (snd-display #__line__ ";XUnionRectWithRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XRectInRegion reg 0 0 100 100)
- (let ((box (XClipBox reg1)))
- (if (or (not (= (.x (cadr box)) 2))
- (not (= (.y (cadr box)) 2))
- (not (= (.width (cadr box)) 8))
- (not (= (.height (cadr box)) 8)))
- (snd-display #__line__ ";XClipBox: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
- (XDestroyRegion reg1)
- ))
-
- (let ((xid (XUniqueContext))
- (dpy (XtDisplay (cadr (main-widgets)))))
- (if (not (eq? (car xid) 'XContext))
- (snd-display #__line__ ";XUniqueContext: ~A" xid))
- (XSaveContext dpy 123 xid "hiho")
- (let ((val (XFindContext dpy 123 xid)))
- (if (or (not (= 0 (car val)))
- (not (string=? (cadr val) "hiho")))
- (snd-display #__line__ ";XFindContext: ~A" val)))
- (XDeleteContext dpy 123 xid)
- (XStoreBytes dpy "hiho" 4)
- (if (not (string=? (XFetchBytes dpy) "hiho")) (snd-display #__line__ ";XStoreBytes: ~A" (XFetchBytes dpy)))
- (XStoreBuffer dpy "hiho" 4 1)
- (if (not (string=? (XFetchBuffer dpy 1) "hiho")) (snd-display #__line__ ";XStoreBuffer: ~A" (XFetchBuffer dpy)))
- )
-
-
- ;; ---------------- Xt tests ----------------
- (let ((name (XtGetApplicationNameAndClass (XtDisplay (cadr (main-widgets))))))
- (if (not (equal? name (list "snd" "Snd")))
- (snd-display #__line__ ";XtGetApplicationNameAndClass: ~A?" name)))
- (let ((dpys (XtGetDisplays (car (main-widgets)))))
- (if (not (Display? (car dpys)))
- (snd-display #__line__ ";XtGetDisplays: ~A?" dpys)))
- (let ((app (XtDisplayToApplicationContext (XtDisplay (cadr (main-widgets)))))
- (orig (car (main-widgets)))
- (wid (XtWidgetToApplicationContext (cadr (main-widgets)))))
- (if (not (equal? app orig))
- (snd-display #__line__ ";XtDisplayToApplicationContext: ~A ~A?" app orig))
- (if (not (equal? app wid))
- (snd-display #__line__ ";XtWidgetToApplicationContext: ~A ~A?" app wid)))
- (if (not (string=? (XtName (caddr (main-widgets))) "mainpane"))
- (snd-display #__line__ ";XtName main pane: ~A" (XtName (caddr (main-widgets)))))
- (if (not (= (XtGetMultiClickTime (XtDisplay (cadr (main-widgets)))) 200))
- (snd-display #__line__ ";XtGetMultiClickTime: ~A" (XtGetMultiClickTime (XtDisplay (cadr (main-widgets))))))
- (XtSetMultiClickTime (XtDisplay (cadr (main-widgets))) 250)
- (if (not (= (XtGetMultiClickTime (XtDisplay (cadr (main-widgets)))) 250))
- (snd-display #__line__ ";XtSetMultiClickTime: ~A" (XtGetMultiClickTime (XtDisplay (cadr (main-widgets))))))
- (XtGetResourceList xmListWidgetClass)
- (let ((wid1 (XtCreateWidget "wid1" xmPushButtonWidgetClass (cadr (main-widgets)) '())))
- (XtDestroyWidget wid1))
-
- (let ((hook-id (XtAppAddActionHook
- (car (main-widgets))
- (lambda (w data name e p)
- (display (format #f "~A ~A ~A ~A ~A~%" w data name e p)))
- #f)))
- (XtRemoveActionHook hook-id))
-
- (let* ((shell (cadr (main-widgets)))
- (wid (XtCreateWidget "wid" xmFormWidgetClass shell '()))
- (wid1 (XtCreateWidget "wid1" xmPushButtonWidgetClass wid '()))
- (wid2 (XtVaCreateWidget "wid" xmFormWidgetClass shell '())))
- (if (XtIsApplicationShell wid) (snd-display #__line__ ";XtIsApplicationShell"))
- (if (not (XtIsApplicationShell shell)) (snd-display #__line__ ";XtIsApplicationShell of appshell"))
- (if (not (XtIsComposite wid)) (snd-display #__line__ ";XtIsComposite"))
- (if (not (XtIsConstraint wid)) (snd-display #__line__ ";XtIsConstraint"))
- (if (XtIsManaged wid) (snd-display #__line__ ";XtIsManaged"))
- (if (not (XtIsObject wid)) (snd-display #__line__ ";XtIsObject"))
- (if (XtIsOverrideShell wid) (snd-display #__line__ ";XtIsOverrideShell"))
- (if (XtIsRealized wid) (snd-display #__line__ ";XtIsRealized"))
- (if (not (XtIsRealized shell)) (snd-display #__line__ ";XtIsRealized main shell"))
- (if (not (XtIsRectObj wid)) (snd-display #__line__ ";XtIsRectObj"))
- (if (not (XtIsSensitive wid)) (snd-display #__line__ ";XtIsSensitive"))
- (if (not (XtIsSensitive shell)) (snd-display #__line__ ";XtIsSensitive of main shell"))
- (XtSetSensitive wid1 #t)
- (if (not (XtIsSensitive wid1)) (snd-display #__line__ ";XtIsSensitive of button"))
- (if (XtIsSessionShell wid) (snd-display #__line__ ";XtIsSessionShell"))
- (if (XtIsShell wid) (snd-display #__line__ ";XtIsShell"))
- (if (not (XtIsShell shell)) (snd-display #__line__ ";XtIsShell of main shell"))
- (if (XtIsTopLevelShell wid) (snd-display #__line__ ";XtIsTopLevelShell"))
- (if (not (XtIsTopLevelShell shell)) (snd-display #__line__ ";XtIsTopLevelShell of main shell"))
- (if (XtIsTransientShell wid) (snd-display #__line__ ";XtIsTransientShell"))
- (if (XtIsVendorShell wid) (snd-display #__line__ ";XtIsVendorShell"))
- (if (not (XtIsVendorShell shell)) (snd-display #__line__ ";XtIsVendorShell of main shell"))
- (if (XtIsWMShell wid) (snd-display #__line__ ";XtIsWMShell"))
- (if (not (XtIsWidget wid)) (snd-display #__line__ ";XtIsWidget"))
- (XtRealizeWidget wid)
- (if (not (XtIsRealized wid)) (snd-display #__line__ ";XtRealizeWidget?"))
- (XtAddGrab shell #f #f)
- (XtRemoveGrab shell)
- (XtMakeResizeRequest wid 200 200)
- (XtMapWidget wid)
- (XtUnmapWidget wid)
- (XtUnrealizeWidget wid)
- ;(XtDestroyWidget wid1)
- )
- ; (XtFree 0) (XtCalloc 0 0) (XtMalloc 0) (XtRealloc 0 0)
- (XtSetLanguageProc
- (car (main-widgets))
- (lambda (dpy str data)
- (snd-display #__line__ ";YOW: language proc: got ~A ~A" str data))
- "who called us?")
- (XtSetLanguageProc (car (main-widgets)) #f "oops")
- (XtSetLanguageProc #f #f "oops")
- (XtMergeArgLists (list 1 2) 2 (list 1) 1)
-
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell)))
- (if (not (equal? (XtClass shell) applicationShellWidgetClass))
- (snd-display #__line__ ";XtClass shell: ~A" (XtClass shell)))
- (if (not (equal? (XtSuperclass shell) topLevelShellWidgetClass))
- (snd-display #__line__ ";XtSuperclass shell: ~A" (XtClass shell)))
- (if (not (string=? (XtName shell) "snd"))
- (snd-display #__line__ ";XtName: ~A" (XtName shell)))
- (if (not (equal? (XtWindow shell) (XtWindowOfObject shell)))
- (snd-display #__line__ ";XtWindow: ~A ~A" (XtWindow shell) (XtWindowOfObject shell)))
- (if (not (equal? (XtScreen shell) (XtScreenOfObject shell)))
- (snd-display #__line__ ";XtScreen: ~A ~A" (XtScreen shell) (XtScreenOfObject shell)))
- (if (not (equal? (XtDisplay shell) (XtDisplayOfObject shell)))
- (snd-display #__line__ ";XtDisplay: ~A ~A" (XtDisplay shell) (XtDisplayOfObject shell)))
- (if (not (Time? (XtLastTimestampProcessed dpy)))
- (snd-display #__line__ ";XtLastTimestampProcessed: ~A" (XtLastTimestampProcessed dpy)))
- (if (not (XEvent? (XtLastEventProcessed dpy)))
- (snd-display #__line__ ";XtLastEventProcessed: ~A" (XtLastEventProcessed dpy)))
- (XtBuildEventMask shell)
- (let ((k (XtConvertCase dpy (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0)))
- (x (XConvertCase (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0))))
- (if (not (KeySym? (car k)))
- (snd-display #__line__ ";XtConvertCase: ~A" k))
- (if (not (equal? k x))
- (snd-display #__line__ ";X(t)ConvertCase: ~A ~A" k x)))
- (let ((val 0))
- (XtRegisterCaseConverter
- dpy
- (lambda (dp key)
- (set! val 123)
- (list (list 'KeySym 65)
- (list 'KeySym 97)))
- (list 'KeySym 65)
- (list 'KeySym 65))
- (XtConvertCase dpy (list 'KeySym 65))
- (if (not (= val 123)) (snd-display #__line__ ";XtRegisterCaseConverter: ~A" val)))
- (XtRegisterGrabAction (lambda (a b c) #f) #f ColormapChangeMask GrabModeSync GrabModeAsync)
- (let ((vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
- (if (or (not (= (car vals) 0))
- (not (KeySym? (cadr vals))))
- (snd-display #__line__ ";XtTranslateKeycode: ~A" vals))
- (if (not (equal? vals (XtTranslateKey dpy (list 'KeyCode XK_B) 0)))
- (snd-display #__line__ ";XtTranslateKey: ~A ~A" vals (XtTranslateKey dpy (list 'KeyCode XK_B) 0)))
- (XtSetKeyTranslator dpy #f)
- (if (not (equal? vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
- (snd-display #__line__ ";XtSetKeyTranslator #f: ~A ~A" vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
- (XtSetKeyTranslator dpy (lambda (d k m)
- (if (not (equal? d dpy)) (snd-display #__line__ ";d in keyproc: ~A ~A" d dpy))
- (XtTranslateKey d k m)))
- (let ((newvals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
- (if (not (equal? vals newvals)) (snd-display #__line__ ";XtSetKeyTranslator: ~A ~A" vals newvals)))
- (XtSetKeyTranslator dpy #f))
- (if (not (KeySym? (cadr (XmTranslateKey dpy (list 'KeyCode XK_B) 0))))
- (snd-display #__line__ ";XmTranslateKey: ~A" (XmTranslateKey dpy XK_B 0)))
- (let ((kv (XtKeysymToKeycodeList dpy (list 'KeySym 65509))))
- (if (not (equal? (car kv) (list 'KeyCode 66)))
- (snd-display #__line__ ";XtKeysymToKeycodeList: ~A ~A" kv (XtKeysymToKeycodeList dpy (list 'KeySym 65509)))))
- (XtInstallAllAccelerators (cadr (main-widgets)) (caddr (main-widgets)))
- (XtInstallAccelerators (cadr (main-widgets)) (caddr (main-widgets)))
- (if (not (equal? (list 0 1 2) (XtSetArg 0 1 2))) (snd-display #__line__ ";XtSetArg: ~A" (XtSetArg 0 1 2)))
- (if (not (Widget? (XtGetKeyboardFocusWidget (cadr (main-widgets)))))
- (snd-display #__line__ ";XtGetKeyboardFocusWidget: ~A" (XtGetKeyboardFocusWidget (cadr (main-widgets)))))
- (let ((id (XtAppAddInput (car (main-widgets)) 1 XtInputReadMask (lambda (a b c) #f) #f)))
- (XtRemoveInput id))
-
- (let ((id (XtAppAddWorkProc (car (main-widgets)) (lambda (me) #f) #f)))
- (XtRemoveWorkProc id))
- (if (not (equal? (caddr (main-widgets)) (XtNameToWidget (cadr (main-widgets)) "mainpane")))
- (snd-display #__line__ ";XtNameToWidget: ~A ~A" (caddr (main-widgets)) (XtNameToWidget (cadr (main-widgets)) "mainpane")))
- (XtVaCreatePopupShell "hiho" vendorShellWidgetClass (cadr (main-widgets)) '())
- (XtResolvePathname (XtDisplay (cadr (main-widgets))) "app-defaults" #f #f #f #f 0 #f)
- (XtFindFile ".snd" #f 0 #f)
-
- (XtAppLock (car (main-widgets)))
- (XtAppUnlock (car (main-widgets)))
- (let ((acts (XtGetActionList xmLabelWidgetClass)))
- (if (or (not (= (length acts) 4))
- (not (string=? (caar acts) "Enter")))
- (snd-display #__line__ ";XtGetActionList: ~A" acts)))
- )
-
- (let ((pop (XtCreatePopupShell "hiho" xmGrabShellWidgetClass (cadr (main-widgets))
- (list XmNiconNameEncoding XA_STRING))))
- (XtPopup pop XtGrabNone)
- (XtPopdown pop))
- (XtAppSetWarningHandler (car (main-widgets))
- (lambda (n)
- (if (not (string=? n "hiho"))
- (snd-display #__line__ ";XtWarning: ~A" n))))
- (XtAppSetWarningMsgHandler (car (main-widgets))
- (lambda (name type klass def pars num)
- (snd-print (format #f ";ignore: ~A ~A ~A~%" name def pars))))
-
- (let ((listener (list-ref (main-widgets) 4)))
- (XtCallActionProc listener "text-transpose" (XEvent) #f 0)
- (XtCallActionProc listener "begin-of-line" (XEvent) #f 0)
- (XtCallActionProc listener "kill-line" (XEvent) #f 0)
- (XtCallActionProc listener "yank" (XEvent) #f 0)
- (XtCallActionProc listener "name-completion" (XEvent) #f 0)
- (XtCallActionProc listener "listener-completion" (XEvent) #f 0)
- (XtCallActionProc listener "no-op" (XEvent) #f 0)
- (XtCallActionProc listener "delete-region" (XEvent) #f 0)
- (XtCallActionProc listener "listener-g" (XEvent) #f 0)
- (XtCallActionProc listener "listener-clear" (XEvent) #f 0)
- (XtCallActionProc listener "b1-press" (XEvent) #f 0)
- (XtCallActionProc listener "delete-to-previous-command" (XEvent) #f 0)
- (let ((BEvent (XEvent ButtonPress)))
- (set! (.x BEvent) 10)
- (set! (.y BEvent) 10)
- (XtCallActionProc listener "b1-press" BEvent #f 0)
- (XtCallActionProc listener "b1-release" BEvent #f 0))
- (XtCallActionProc listener "word-upper" (XEvent) (list "u") 1))
-
- (let ((ind (open-sound "oboe.snd")))
- (set! (show-controls ind) #t)
- (let* ((swids (sound-widgets ind))
- (spane (car swids))
- (sctrls (list-ref swids 2))
- (cmain (find-child spane "chn-main-window"))
- (wh (widget-size sctrls)))
- (XtUnmanageChild sctrls)
- (set! (widget-size sctrls) (list (car wh) (* (cadr wh) 3)))
- (XtManageChild sctrls)
-
- (let ((tag (catch #t (lambda () (XtVaGetValues (car (sound-widgets)) (list "XmNpaneMaximum" 0)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-resource))
- (snd-display #__line__ ";XtVaGetValues of incorrectly quoted resource name: ~A" tag)))
- )
+ (if (not (GC? sgc)) (snd-display #__line__ ";XCreateGC returned ~A" sgc))
+ (XSetArcMode dpy sgc ArcPieSlice)
+ (XSetFunction dpy sgc GXcopy)
+ (XSetLineAttributes dpy sgc 3 LineDoubleDash CapButt JoinMiter)
+ (XSetClipOrigin dpy sgc 1 1)
+ (XSetTSOrigin dpy sgc 0 0)
+ (XSetFillRule dpy sgc WindingRule)
+ (XSetFillStyle dpy sgc FillStippled)
+ (XSetForeground dpy sgc (WhitePixelOfScreen (current-screen)))
+ (XSetBackground dpy sgc (BlackPixelOfScreen (current-screen)))
+ (XSetGraphicsExposures dpy sgc #t)
+ (XSetSubwindowMode dpy sgc IncludeInferiors)
+ (let ((owner (XGetSelectionOwner dpy XA_PRIMARY)))
+ (if (and owner (not (Window? owner)))
+ (snd-display #__line__ ";XGetSelectionOwner: ~A" owner)))
+ (let ((mods (XGetModifierMapping dpy)))
+ (if (not (XModifierKeymap? mods))
+ (snd-display #__line__ ";XGetModifierMapping: ~A" mods)))
+ (let ((vis (XGetVisualInfo dpy 0 (list 'XVisualInfo 0))))
+ (if (or (not vis)
+ (not (XVisualInfo? (car vis))))
+ (snd-display #__line__ ";XGetVisualInfo: ~A" vis))
+ (if (not (= (.depth (car vis)) 24)) (snd-display #__line__ ";depth vis: ~A" (.depth (car vis))))
+ (if (not (= (.screen (car vis)) 0)) (snd-display #__line__ ";screen vis: ~A" (.screen (car vis))))
+ (catch #t ; in c++ no class field
+ (lambda ()
+ (if (not (= (.class (car vis)) TrueColor)) (snd-display #__line__ ";class vis: ~A (~A)" (.class (car vis)) TrueColor)))
+ (lambda args args))
+ (if (not (= (.colormap_size (car vis)) 256)) (snd-display #__line__ ";colormap_size vis: ~A" (.colormap_size (car vis))))
+ (if (and (not (XVisualInfo? (XMatchVisualInfo dpy 0 24 TrueColor)))
+ (not (XVisualInfo? (XMatchVisualInfo dpy 0 16 TrueColor))))
+ (snd-display #__line__ ";XMatchVisualInfo: ~A" (XMatchVisualInfo dpy 0 24 TrueColor))))
+ (XCheckMaskEvent dpy KeyPressMask)
+
+ (let* ((vals (XGetGCValues dpy sgc (+ GCFunction GCForeground GCBackground GCLineWidth GCLineStyle
+ GCCapStyle GCJoinStyle GCFillStyle GCFillRule GCTileStipXOrigin
+ GCTileStipYOrigin GCSubwindowMode GCGraphicsExposures GCClipXOrigin
+ GCClipYOrigin GCDashOffset GCArcMode)))
+ (val1 (cadr vals)))
+ (if (= (car vals) 0)
+ (snd-display #__line__ ";XGetGCValues failed"))
- (close-sound ind))
-
-
- ;; ---------------- XM tests ----------------
- (let* ((label-render-table (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNlabelRenderTable 0))))
- (renditions (and label-render-table
- (XmRenderTableGetRenditions label-render-table (XmRenderTableGetTags label-render-table))))
- (default-font-name (and renditions
- (cadr (XmRenditionRetrieve (car renditions) (list XmNfontName 0)))))
- (default-font-info (and renditions
- (XmRenditionRetrieve (car renditions) (list XmNfont 0 XmNfontType 0)))))
- (if (not (string=? default-font-name "fixed")) (snd-display #__line__ ";XmRenderTableGetRenditions name: ~A" default-font-name))
- (if (not (XFontStruct? (list-ref default-font-info 1))) (snd-display #__line__ ";XmRenderTableGetRenditions font struct: ~A" default-font-info))
- (if (not (= (list-ref default-font-info 3) XmFONT_IS_FONT)) (snd-display #__line__ ";XmRenderTableGetRenditions font type: ~A" default-font-info)))
-
-
- (let* ((button-render-table (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNbuttonRenderTable 0))))
- (default-rendition (and button-render-table
- (XmRenderTableGetRendition button-render-table XmFONTLIST_DEFAULT_TAG)))
- (default-font-info (and default-rendition
- (XmRenditionRetrieve default-rendition (list XmNfont 0 XmNfontType 0)))))
- (if (and default-font-info
- (= (list-ref default-font-info 3) XmFONT_IS_FONT))
- (let* ((font (cadr default-font-info))
- (dpy (XtDisplay (cadr (main-widgets))))
- (data '()))
- (for-each (lambda (name atom?)
- (let ((val (XGetFontProperty font name)))
- (if (car val)
- (set! data (cons (list (XGetAtomName (XtDisplay (cadr (main-widgets))) name)
- (if atom?
- (XGetAtomName (XtDisplay (cadr (main-widgets))) (list 'Atom (cadr val)))
- (cadr val)))
- data)))))
- (list XA_POINT_SIZE XA_FONT XA_FULL_NAME
- (XInternAtom dpy "XA_SLANT" #f)
- (XInternAtom dpy "XA_WEIGHT_NAME" #f)
- XA_FAMILY_NAME
- (XInternAtom dpy "XA_FOUNDRY" #f)
- XA_CAP_HEIGHT)
- (list #f #t #t #t #t #t #t #f))
- (if (not (string=? "Fixed" (cadr (list-ref data 1)))) (snd-display #__line__ ";XmRenderTableGetRendition: ~A" data)))))
-
- (let* ((tabs (let ((ctr 0))
- (map
- (lambda (n)
- (set! ctr (+ ctr 1))
- (XmTabCreate n XmINCHES (if (= ctr 1) XmABSOLUTE XmRELATIVE) XmALIGNMENT_BEGINNING "."))
- (list 1.5 1.5 1.5 1.5))))
- (tablist (XmTabListInsertTabs #f tabs (length tabs) 0)))
- (if (not (= (XmTabListTabCount tablist) (length tabs)))
- (snd-display #__line__ ";tablist len: ~A ~A~%" (XmTabListTabCount tablist) (length tabs)))
- (if (not (equal? (XmTabGetValues (XmTabListGetTab tablist 0)) (list 1.5 5 0 0 ".")))
- (snd-display #__line__ ";XmTabs 0: ~A" (XmTabGetValues (XmTabListGetTab tablist 0))))
- (if (not (equal? (XmTabGetValues (XmTabListGetTab tablist 2)) (list 1.5 5 1 0 ".")))
- (snd-display #__line__ ";XmTabs 2: ~A" (XmTabGetValues (XmTabListGetTab tablist 2))))
- (let ((copytab (XmTabListCopy tablist 0 0)))
- (if (not (equal? (XmTabGetValues (XmTabListGetTab copytab 0)) (list 1.5 5 0 0 ".")))
- (snd-display #__line__ ";XmTabListCopy 0: ~A" (XmTabGetValues (XmTabListGetTab copytab 0))))
- (let ((another (XmTabListRemoveTabs copytab (list 0 1)))
- (atab (XmTabCreate 3.0 XmINCHES XmABSOLUTE XmALIGNMENT_BEGINNING ".")))
- (if (not (equal? (XmTabGetValues (XmTabListGetTab another 0)) (list 1.5 5 1 0 ".")))
- (snd-display #__line__ ";XmTabListRemoveTabs: ~A" (XmTabGetValues (XmTabListGetTab another 0))))
- (XmTabListReplacePositions (XmTabListCopy tablist 0 0) (list 1) (list atab))
- ;; this (replacepositions) is very prone to segfaults -- *very* poorly implemented!
- (XmTabSetValue atab 6.0)
- (XmTabFree atab)
- (XmTabListFree another))
- (let ((tabl (XmStringTableProposeTablist
- (list (XmStringCreateLocalized "a-string") (XmStringCreateLocalized "another")) 2
- (cadr (main-widgets))
- 1.0
- XmABSOLUTE)))
- (if (not (XmTabList? tabl)) (snd-display #__line__ ";XmStringTableProposeTabList: ~A" tabl))
- (XmTabListFree tabl)))
+ (if (not (equal? (.function val1) GXcopy))
+ (snd-display #__line__ ";function: ~A ~A" (.function val1) GXcopy))
+ (if (not (eqv? (.line_width val1) 3))
+ (snd-display #__line__ ";line_width: ~A ~A" (.line_width val1) 3))
+ (if (not (equal? (.line_style val1) LineDoubleDash))
+ (snd-display #__line__ ";line_style: ~A ~A" (.line_style val1) LineDoubleDash))
+ (if (not (equal? (.background val1) (BlackPixelOfScreen (current-screen))))
+ (snd-display #__line__ ";background: ~A ~A" (.background val1) (BlackPixelOfScreen (current-screen))))
+ (if (not (equal? (.foreground val1) (WhitePixelOfScreen (current-screen))))
+ (snd-display #__line__ ";foreground: ~A ~A" (.foreground val1) (WhitePixelOfScreen (current-screen))))
+ (if (not (equal? (.cap_style val1) CapButt))
+ (snd-display #__line__ ";cap_style: ~A ~A" (.cap_style val1) CapButt))
+ (if (not (equal? (.join_style val1) JoinMiter))
+ (snd-display #__line__ ";join_style: ~A ~A" (.join_style val1) JoinMiter))
+ (if (not (equal? (.fill_style val1) FillStippled))
+ (snd-display #__line__ ";fill_style: ~A ~A" (.fill_style val1) FillStippled))
+ (if (not (equal? (.fill_rule val1) WindingRule))
+ (snd-display #__line__ ";fill_rule: ~A ~A" (.fill_rule val1) WindingRule))
+ (if (not (equal? (.arc_mode val1) ArcPieSlice))
+ (snd-display #__line__ ";arc_mode: ~A ~A" (.arc_mode val1) ArcPieSlice))
+ (if (not (eqv? (.ts_x_origin val1) 0))
+ (snd-display #__line__ ";ts_x_origin: ~A ~A" (.ts_x_origin val1) 0))
+ (if (not (eqv? (.ts_y_origin val1) 0))
+ (snd-display #__line__ ";ts_y_origin: ~A ~A" (.ts_y_origin val1) 0))
+ (if (not (equal? (.subwindow_mode val1) IncludeInferiors))
+ (snd-display #__line__ ";subwindow_mode: ~A ~A" (.subwindow_mode val1) IncludeInferiors))
+ (if (not (.graphics_exposures val1))
+ (snd-display #__line__ ";graphics_exposures: ~A ~A" (.graphics_exposures val1) #t))
+ (if (not (eqv? (.clip_x_origin val1) 1))
+ (snd-display #__line__ ";clip_x_origin: ~A ~A" (.clip_x_origin val1) 1))
+ (if (not (eqv? (.clip_y_origin val1) 1))
+ (snd-display #__line__ ";clip_y_origin: ~A ~A" (.clip_y_origin val1) 1))
+ (if (not (eqv? (.dash_offset val1) 1))
+ (snd-display #__line__ ";dash_offset: ~A ~A" (.dash_offset val1) 1))
- (let ((hname (host-name))) ; from snd-motif.scm
- (if (not (equal? hname (getenv "HOSTNAME")))
- (snd-display #__line__ ";host name appears to be ~A or maybe ~A" hname (getenv "HOSTNAME"))))
- (let ((blu (x->snd-color "blue")))
- (if (not (Pixel? blu)) (snd-display #__line__ ";x->snd-color can't find blue! ~A" blu))
- (if (not (equal? (color->list blu) (list 0.0 0.0 1.0)))
- (snd-display #__line__ ";x->snd-color blue: ~A" (color->list blu))))
+ (set! (.plane_mask val) 0)
+ (if (not (eqv? (.plane_mask val) 0))
+ (snd-display #__line__ ";plane_mask: ~A ~A" (.plane_mask val) 0))
+ (set! (.tile val) (list 'Pixmap 0))
+ (if (not (equal? (.tile val) (list 'Pixmap 0)))
+ (snd-display #__line__ ";tile: ~A" (.tile val)))
+ (set! (.stipple val) (list 'Pixmap 0))
+ (if (not (equal? (.stipple val) (list 'Pixmap 0)))
+ (snd-display #__line__ ";stipple: ~A" (.stipple val)))
- (let* ((tmp (XmStringCreateLocalized "h"))
- (pm (XmParseMappingCreate (list XmNincludeStatus XmINSERT
- XmNsubstitute tmp
- XmNpattern "i"
- XmNpatternType XmCHARSET_TEXT))))
- (XmStringFree tmp)
- (XmParseMappingFree pm)
- (set! pm (XmParseMappingCreate (list XmNinvokeParseProc
- (lambda (txt end type tag entry pattern str call)
- #f))))
- (XmParseMappingFree pm)
- (let ((tag (catch #t (lambda ()
- (set! pm (XmParseMappingCreate (list XmNinvokeParseProc
- (lambda (txt end type tag entry pattern)
- #f)))))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmNinvokeParseProc wrong arity: ~A" tag))))
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets))))
+ (attr (XSetWindowAttributes #f *basic-color* #f *highlight-color*))
+ (newwin (XCreateWindow dpy win 10 10 100 100 3
+ CopyFromParent InputOutput (list 'Visual CopyFromParent)
+ (logior CWBackPixel CWBorderPixel)
+ attr)))
+ (if (not (= (.do_not_propagate_mask attr) 0)) (snd-display #__line__ ";do_not_propagate_mask: ~A" (.do_not_propagate_mask attr)))
+ (if (not (= (.event_mask attr) 0)) (snd-display #__line__ ";event_mask: ~A" (.event_mask attr)))
+ (if (not (Pixel? (.backing_pixel attr))) (snd-display #__line__ ";backing_pixel: ~A" (.backing_pixel attr)))
+ (if (not (Pixel? (.border_pixel attr))) (snd-display #__line__ ";border_pixel: ~A" (.border_pixel attr)))
+ (if (not (= (cadr (.border_pixmap attr)) 0)) (snd-display #__line__ ";border_pixmap: ~A" (.border_pixmap attr)))
+ (if (not (Pixel? (.background_pixel attr))) (snd-display #__line__ ";background_pixel: ~A" (.background_pixel attr)))
+ (if (not (= (cadr (.background_pixmap attr)) 0)) (snd-display #__line__ ";background_pixmap: ~A" (.background_pixmap attr)))
+ (if (not (= (.backing_planes attr) 0)) (snd-display #__line__ ";backing_planes: ~A" (.backing_planes attr)))
+ (if (.save_under attr) (snd-display #__line__ ";save_under: ~A" (.save_under attr)))
+ (if (not (= (cadr (.cursor attr)) 0)) (snd-display #__line__ ";cursor: ~A" (.cursor attr)))
+ (if (not (Window? newwin)) (snd-display #__line__ ";XCreateWindow: ~A" newwin))
+ (if (not (= (.bit_gravity attr) 0)) (snd-display #__line__ ";bit_gravity: ~A" (.bit_gravity attr)))
+ (XChangeWindowAttributes dpy newwin CWBackPixel (XSetWindowAttributes #f *basic-color*))
+ (XDestroyWindow dpy newwin)
+ (set! newwin (XCreateSimpleWindow dpy win 10 10 100 100 3 *basic-color* *highlight-color*))
+ (XDestroyWindow dpy newwin))
- (let* ((fonts (list "fixed"
- "-*-times-bold-r-*-*-14-*-*-*-*-*-*-*"
- "-*-*-medium-i-*-*-18-*-*-*-*-*-*-*"
- "-*-helvetica-*-*-*-*-18-*-*-*-*-*-*-*"))
- (tags (list "one" "two" "three" "four"))
- (colors (list "red" "green" "blue" "orange"))
- (pixels
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (XSetRegion dpy sgc (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule))
+ (let ((pix (make-pixmap (cadr (main-widgets)) arrow-strs)))
+ (if (not (Pixmap? pix))
+ (snd-display #__line__ ";make-pixmap?")
+ (begin
+ (XSetTile dpy sgc pix)
+ (XSetStipple dpy sgc (XCreateBitmapFromData dpy wn right-arrow 16 12))
+ (XSetClipMask dpy sgc None)
+ (XSetState dpy sgc *basic-color* *mark-color* GXcopy 0)
+ (XSetPlaneMask dpy sgc 0)
+ (XSetDashes dpy sgc 0 '(3 4 3 1))
+ (XSetClipRectangles dpy sgc 0 0 (list (XRectangle 0 0 10 10) (XRectangle 10 10 100 100)) 2 Unsorted)
+ (let ((err (XWriteBitmapFile dpy "testx.data" pix 16 12 -1 -1)))
+ (if (not (= BitmapSuccess err)) (snd-display #__line__ ";XWriteBitmapFile: ~A" err)))
+ ;(let ((vals (XReadBitmapFile dpy (XtWindow (cadr (main-widgets))) "testx.data")))
+ ; (if (not (= (car vals BitmapSuccess))) (snd-display #__line__ ";XReadBitmapFile: ~A" vals)))
+ ;(let ((vals (XReadBitmapFileData "testx.data")))
+ ; (if (not (= (car vals BitmapSuccess))) (snd-display #__line__ ";XReadBitmapFileData: ~A" vals)))
+
+ (let* ((fid (XLoadFont dpy "cursor"))
+ (col (XColor))
+ (col1 (XColor))
(scr (DefaultScreen dpy))
(cmap (DefaultColormap dpy scr)))
- (let ((col (XColor)))
- (XParseColor dpy cmap "blue" col)
- (if (or (not (= (.red col) 0))
- (not (= (.green col) 0))
- (not (= (.blue col) 65535)))
- (snd-display #__line__ ";XParseColor: ~A ~A ~A ~A" col (.red col) (.blue col) (.green col)))
- (XLookupColor dpy cmap "red" col (XColor))
- (if (or (not (= (.red col) 65535))
- (not (= (.green col) 0))
- (not (= (.blue col) 0)))
- (snd-display #__line__ ";XLookupColor: ~A ~A ~A ~A" col (.red col) (.blue col) (.green col))))
- (map
- (lambda (color)
- (let ((col (XColor)))
- (if (= (XAllocNamedColor dpy cmap color col col) 0)
- (snd-error (format #f "can't allocate ~A" color))
- (.pixel col))))
- colors)))
- (rendertable (XmRenderTableAddRenditions #f
- (let ((ctr 0))
- (map (lambda (r)
- (set! ctr (+ ctr 1))
- (XmRenditionCreate (cadr (main-widgets))
- r
- (append
- (if (= ctr 1)
- (list XmNtabList tablist)
- '())
- (list XmNrenditionForeground (list-ref pixels (- ctr 1))
- XmNfontName (list-ref fonts (- ctr 1))
- XmNfontType XmFONT_IS_FONT))))
- tags))
- (length tags)
- XmMERGE_NEW)))
-
- (if (file-exists? "hiho") (delete-file "hiho"))
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (scr (DefaultScreenOfDisplay dpy))
- (p1 (XmGetPixmap scr "hiho" (car pixels) (cadr pixels))))
- (if (not (Pixmap? p1)) (snd-display #__line__ ";XmGetPixmap: ~A" p1))
- (set! p1 (XmGetPixmapByDepth scr "hoho" (car pixels) (cadr pixels) (XDefaultDepth dpy (XScreenNumberOfScreen scr))))
- (if (not (Pixmap? p1)) (snd-display #__line__ ";XmGetPixmapByDepth: ~A" p1))
- (XmDestroyPixmap scr p1))
-
- (let ((tabl (XmStringTableParseStringArray (list "hi" "ho") 2 "hiho" XmCHARSET_TEXT #f 0 #f)))
- (if (not (XmString? (car tabl))) (snd-display #__line__ ";XmStringTableParseStringArray: ~A" tabl))
- (let ((strs (XmStringTableUnparse tabl 2 "hiho" XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
- (if (not (equal? strs (list "hi" "ho"))) (snd-display #__line__ ";XmStringTableUnparse: ~A" strs)))
- (let ((str (XmStringTableToXmString tabl 2 #f)))
- (if (not (XmString? str)) (snd-display #__line__ ";XmStringTableToXmString: ~A" str))
- (XmStringToXmStringTable str #f)
- (let ((val (XmStringUnparse str "hiho" XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
- (if (not (string=? val "hiho")) (snd-display #__line__ ";XmStringUnparse: ~A" val))
- (set! val (XmStringUnparse (XmStringCreateLocalized "hi") #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
- (if (not (string=? val "hi")) (snd-display #__line__ ";XmStringUnparse null tag: ~A" val)))
- ;; XmCvtXmStringToByteStream test deleted because it seems to be buggy in memory handling
- (let* ((ind (open-sound "oboe.snd"))
- (grf1 (car (channel-widgets)))
- (dpy (XtDisplay grf1))
- (win (XtWindow grf1))
- (scr (DefaultScreenOfDisplay dpy))
- (scrn (XScreenNumberOfScreen scr))
- (gv (XGCValues)))
- (if (not (Font? (current-font ind))) (snd-display #__line__ ";current-font: ~A" (current-font ind)))
- (let ((old-font (current-font))
- (a-font (load-font "6x12")))
- (set! (current-font) a-font)
- (if (not (equal? a-font (current-font)))
- (snd-display #__line__ ";set current-font: ~A ~A" a-font (current-font)))
- (set! (current-font ind) old-font)
- (if (not (equal? old-font (current-font ind)))
- (snd-display #__line__ ";set current-font with ind: ~A ~A" old-font (current-font ind)))
- (set! (current-font) a-font)
- (set! (current-font ind 0) old-font)
- (if (not (equal? old-font (current-font ind 0)))
- (snd-display #__line__ ";set current-font with ind/0: ~A ~A" old-font (current-font ind 0)))
- (set! (current-font) old-font))
+ (XAllocNamedColor dpy cmap "blue" col col)
+ (XAllocNamedColor dpy cmap "green" col1 col1)
+ (let ((vals (XCreateGlyphCursor dpy fid None XC_dot 0 col col1)))
+ (if (not (Cursor? vals)) (snd-display #__line__ ";XCreateGlyphCursor: ~A" vals)))
+ (let ((vals (XCreatePixmapCursor dpy pix None col col1 5 5)))
+ (if (not (Cursor? vals)) (snd-display #__line__ ";XCreatePixmapCursor: ~A" vals))
+ (XRecolorCursor dpy vals col1 col))
+ (XAllocColorPlanes dpy cmap #f 2 1 1 1)
+ (XAllocColorCells dpy cmap #f 1 1))
- (set! (.foreground gv) (data-color))
- (set! (.background gv) (basic-color))
- (set! (.function gv) GXcopy)
- (let* ((sgc (XtAllocateGC grf1
- (XDefaultDepth dpy scrn)
- (logior GCForeground GCBackground GCFunction)
- gv
- (logior GCFont GCDashList)
- 0))
- (str2 (XmStringCreateLocalized "hiho")))
- (XmStringDraw dpy win rendertable str2 sgc 10 10 100
- XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100))
- (XmStringDrawImage dpy win rendertable str2 sgc 10 10 100
- XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100))
- (XmStringDrawUnderline dpy win rendertable str2 sgc 10 10 100
- XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100) str2)
- (XtGetGC (cadr (main-widgets)) GCForeground gv)
- (XCopyGC dpy sgc GCFunction sgc)
- (XCopyArea dpy win win sgc 0 0 100 100 0 0)
- (XCopyPlane dpy win win sgc 0 0 100 100 0 0 1)
- (XtReleaseGC grf1 sgc))
- (close-sound ind))
- (let ((lc (XmStringLineCount (XmStringCreateLocalized "hiho"))))
- (if (not (= lc 1)) (snd-display #__line__ ";XmStringLineCount: ~A" lc)))
- (if (not (XmStringHasSubstring str (XmStringCreateLocalized "hi"))) (snd-display #__line__ ";XmStringHasSubstring?"))))
-
-
- (if (not (equal? (XmRenderTableGetTags rendertable) (list "one" "two" "three" "four")))
- (snd-display #__line__ ";tags: ~A~%" (XmRenderTableGetTags rendertable)))
- (let* ((rend (XmRenderTableGetRendition rendertable "one"))
- (r (and rend (XmRenditionRetrieve rend
- (list XmNrenditionForeground 0
- XmNfontName 0
- XmNfontType 0
- XmNtag 0)))))
- (if (and rend r)
- (begin
- (if (or (not (string=? (list-ref r 7) "one"))
- (not (string=? (list-ref r 3) "fixed")))
- (snd-display #__line__ ";rendertable: ~A" r))
- (XmRenditionUpdate rend (list XmNstrikethruType XmSINGLE_LINE))
- (if (not (= (cadr (XmRenditionRetrieve rend (list XmNstrikethruType 0))) XmSINGLE_LINE))
- (snd-display #__line__ ";XmRenditionUpdate: ~A ~A" (cadr (XtGetValues rend (list XmNstrikethruType 0))) XmSINGLE_LINE)))
- (snd-display #__line__ ";r and rend: ~A ~A~%" r rend)))
- (let ((r1 (XmRenditionCreate (cadr (main-widgets)) "r1" (list XmNfontName "fixed"))))
- (XmRenditionFree r1))
-
- (if (not (equal? (XmDropSiteQueryStackingOrder (list-ref (main-widgets) 4)) (list #f)))
- (snd-display #__line__ ";XmDropSiteQueryStackingOrder: ~A" (XmDropSiteQueryStackingOrder (list-ref (main-widgets) 4)) (list #f)))
- (let ((tab (XmStringComponentCreate XmSTRING_COMPONENT_TAB 0 #f))
- (row #f)
- (table '())
- (our-tags tags))
- (for-each
- (lambda (word)
- (let ((entry (XmStringGenerate word
- #f
- XmCHARSET_TEXT
- (car our-tags))))
- (if (XmStringIsVoid entry) (snd-display #__line__ ";~A is void?" entry))
- (if (XmStringEmpty entry) (snd-display #__line__ ";~A is empty?" entry))
-
- (if row
- (let ((tmp (XmStringConcat row tab)))
- (XmStringFree row)
- (set! row (XmStringConcatAndFree tmp entry)))
- (set! row entry))
- (set! our-tags (cdr our-tags))
- (if (null? our-tags)
- (begin
- (set! our-tags tags)
- (set! table (cons row table))
- (set! row #f)))))
- (list "this" "is" "a" "test" "of" "the" "renditions" "and" "rendertables"
- "perhaps" "all" "will" "go" "well" "and" "then" "again" "perhaps" "not"))
- (let* ((n (car table))
- (c (XmStringInitContext n))
- (ctr 0)
- (happy #t))
- (do ((i 0 (+ 1 i)))
- ((not happy))
- (let ((type (XmStringGetNextTriple (cadr c))))
- (if (= (car type) XmSTRING_COMPONENT_TEXT)
- (if (or (not (= (cadr type) (list-ref (list 0 0 2 0 0 0 4 0 0 0 3 0 0 0 4) i)))
- (not (string=? (caddr type)
- (list-ref (list "o" "o" "go" "o" "o" "o" "well" "o" "o" "o" "and" "o" "o" "o" "then") i))))
- (snd-display #__line__ ";component ~A -> ~A" i (cdr type)))
- (if (not (= (car type) XmSTRING_COMPONENT_TAB))
- (if (= (car type) XmSTRING_COMPONENT_END)
- (set! happy #f))))))
- (XmStringFreeContext (cadr c))))))
-
- (XtAppAddActions (car (main-widgets))
- (list (list "try1" (lambda (w e strs)
- (snd-display #__line__ ";try1: ~A~%" strs)))
- (list "try2" (lambda (w e strs)
- (snd-display #__line__ ";try2: ~A~%" strs)))))
- (let* ((tab (XtParseTranslationTable
- (format #f "Ctrl <Key>osfLeft: try1()~%Ctrl <Key>osfRight: try2()~%Ctrl <Key>osfUp: try1(hiho)~%Ctrl <Key>osfDown: try2(down, up)~%")))
- (pane (add-main-pane "hiho" xmTextWidgetClass '())))
- (XtOverrideTranslations pane tab))
- (if (defined? 'XtAddActions)
- (XtAddActions (list (list "try3" (lambda (w e strs)
- (snd-display #__line__ ";try3: ~A~%" strs)))
- (list "try4" (lambda (w e strs)
- (snd-display #__line__ ";try4: ~A~%" strs))))))
-
- (let ((XmNhiho (add-resource "hiho" 0)))
- (if (not (string=? XmNhiho "hiho")) (snd-display #__line__ ";add-resource XmNhiho: ~A" XmNhiho)))
-
- (open-sound "cardinal.snd")
- (let* ((mouse_width 32)
- (mouse_height 32)
- (mouse_bits (list
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
- #x80 #xff #xff #x01 #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01
- #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01
- #x80 #x00 #x01 #x01 #x80 #xff #xff #x01 #x80 #x00 #x00 #x01
- #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01
- #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01
- #x80 #x00 #x00 #x01 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00
- #x00 #x06 #x60 #x00 #x00 #xf8 #x1f #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
- #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00))
- (rb (list
- #x00 #x04 #x10 #x08 #x00 #x10 #x04 #x20 #x00 #x40 #xa5 #xbf
- #x00 #x40 #x04 #x20 #x00 #x10 #x10 #x08 #x00 #x04 #x00 #x00))
- (iconw (list-ref (sound-widgets) 8))
- (dpy (XtDisplay iconw))
- (win (XtWindow iconw)))
- (XCreateBitmapFromData dpy win rb 16 12)
- (XCreateBitmapFromData dpy win mouse_bits mouse_width mouse_height)
- (XCreatePixmapFromBitmapData dpy win mouse_bits 32 32 (white-pixel) (black-pixel) 8))
-
- (let* ((grf1 (car (channel-widgets)))
- (dpy (XtDisplay grf1))
- (win (XtWindow grf1))
- (sgc (car (snd-gcs)))
- (shell (cadr (main-widgets)))
- (scr (DefaultScreen dpy))
- (vis (DefaultVisual dpy scr))
- (depth (cadr (XtGetValues grf1 (list XmNdepth 0))))
- (pix (XCreatePixmap dpy win 10 10 depth))
- (rotpix (XCreatePixmap dpy win 10 10 depth)))
-
- (XDrawText dpy win sgc 50 50 (list (XTextItem "hi" 2 2 '(Font 0))
- (XTextItem "ho" 2 3 '(Font 0))))
-
- (let ((cmap (XCreateColormap dpy win vis AllocNone)))
- (set! cmap (XCopyColormapAndFree dpy cmap))
- (XFreeColormap dpy cmap)
- (if (XCheckTypedWindowEvent dpy win ExposureMask)
- (snd-display #__line__ ";XCheckTypedWindowEvent: ~A" (XCheckTypedWindowEvent dpy win ExposureMask)))
- (if (XCheckTypedEvent dpy ExposureMask)
- (snd-display #__line__ ";XCheckTypedEvent: ~A" (XCheckTypedEvent dpy ExposureMask)))
- (XCheckWindowEvent dpy win ExposureMask)
+
+ )))
+ (let* ((fid (XLoadFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
+ (fnt (XLoadQueryFont dpy "-*-times-medium-r-*-*-14-*-*-*-*-*-*-*"))
+ (chs (XQueryTextExtents dpy fid "hiho"))
+ (struct (chs 4))
+ (fnt1 (XQueryFont dpy fid)))
+ (if (not (Font? fid)) (snd-display #__line__ ";XLoadFont: ~A" fid))
+ (if (not (XFontStruct? fnt)) (snd-display #__line__ ";XLoadQueryFont: ~A" fnt))
+ (if (not (XFontStruct? fnt1)) (snd-display #__line__ ";XQueryFont: ~A" fnt1))
+ (if (not (XCharStruct? struct)) (snd-display #__line__ ";XQueryTextExtents: ~A" chs))
+ (if (not (= (chs 2) 12)) (snd-display #__line__ ";XQueryTextExtents max ascent: ~A" (chs 2)))
+ (if (not (= (chs 3) 3)) (snd-display #__line__ ";XQueryTextExtents max descent: ~A" (chs 3)))
+ (if (not (= (.lbearing struct) 0)) (snd-display #__line__ ";lbearing: ~A" (.lbearing struct)))
+ (if (not (= (.rbearing struct) 23)) (snd-display #__line__ ";rbearing: ~A" (.rbearing struct)))
+ (if (not (= (.width struct) 24)) (snd-display #__line__ ";width: ~A" (.width struct)))
+ (if (not (= (.ascent struct) 10)) (snd-display #__line__ ";ascent: ~A" (.ascent struct)))
+ (if (not (= (.descent struct) 0)) (snd-display #__line__ ";descent: ~A" (.descent struct)))
+ (if (not (= (.attributes struct) 0)) (snd-display #__line__ ";attributes: ~A" (.attributes struct)))
+ (let ((fid (load-font "-*-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*")))
+ (if (not (Font? fid)) (snd-display #__line__ ";load-font -> ~A" fid)))
+ )
+ (XFreeGC (XtDisplay (cadr (main-widgets))) sgc)
+ )))
+
+ (let ((atoms (list XA_PRIMARY XA_SECONDARY XA_ARC XA_ATOM XA_BITMAP XA_CARDINAL XA_COLORMAP XA_CURSOR XA_CUT_BUFFER0
+ XA_CUT_BUFFER1 XA_CUT_BUFFER2 XA_CUT_BUFFER3 XA_CUT_BUFFER4 XA_CUT_BUFFER5 XA_CUT_BUFFER6
+ XA_CUT_BUFFER7 XA_DRAWABLE XA_FONT XA_INTEGER XA_PIXMAP XA_POINT XA_RECTANGLE XA_RESOURCE_MANAGER
+ XA_RGB_COLOR_MAP XA_RGB_BEST_MAP XA_RGB_BLUE_MAP XA_RGB_DEFAULT_MAP XA_RGB_GRAY_MAP XA_RGB_GREEN_MAP
+ XA_RGB_RED_MAP XA_STRING XA_VISUALID XA_WINDOW XA_WM_COMMAND XA_WM_HINTS XA_WM_CLIENT_MACHINE
+ XA_WM_ICON_NAME XA_WM_ICON_SIZE XA_WM_NAME XA_WM_NORMAL_HINTS XA_WM_SIZE_HINTS XA_WM_ZOOM_HINTS
+ XA_MIN_SPACE XA_NORM_SPACE XA_MAX_SPACE XA_END_SPACE XA_SUPERSCRIPT_X XA_SUPERSCRIPT_Y
+ XA_SUBSCRIPT_X XA_SUBSCRIPT_Y XA_UNDERLINE_POSITION XA_UNDERLINE_THICKNESS XA_STRIKEOUT_ASCENT
+ XA_STRIKEOUT_DESCENT XA_ITALIC_ANGLE XA_X_HEIGHT XA_QUAD_WIDTH XA_WEIGHT XA_POINT_SIZE
+ XA_RESOLUTION XA_COPYRIGHT XA_NOTICE XA_FONT_NAME XA_FAMILY_NAME XA_FULL_NAME XA_CAP_HEIGHT
+ XA_WM_CLASS XA_WM_TRANSIENT_FOR))
+ (atom-names (list 'XA_PRIMARY 'XA_SECONDARY 'XA_ARC 'XA_ATOM 'XA_BITMAP 'XA_CARDINAL 'XA_COLORMAP 'XA_CURSOR 'XA_CUT_BUFFER0
+ 'XA_CUT_BUFFER1 'XA_CUT_BUFFER2 'XA_CUT_BUFFER3 'XA_CUT_BUFFER4 'XA_CUT_BUFFER5 'XA_CUT_BUFFER6
+ 'XA_CUT_BUFFER7 'XA_DRAWABLE 'XA_FONT 'XA_INTEGER 'XA_PIXMAP 'XA_POINT 'XA_RECTANGLE 'XA_RESOURCE_MANAGER
+ 'XA_RGB_COLOR_MAP 'XA_RGB_BEST_MAP 'XA_RGB_BLUE_MAP 'XA_RGB_DEFAULT_MAP 'XA_RGB_GRAY_MAP 'XA_RGB_GREEN_MAP
+ 'XA_RGB_RED_MAP 'XA_STRING 'XA_VISUALID 'XA_WINDOW 'XA_WM_COMMAND 'XA_WM_HINTS 'XA_WM_CLIENT_MACHINE
+ 'XA_WM_ICON_NAME 'XA_WM_ICON_SIZE 'XA_WM_NAME 'XA_WM_NORMAL_HINTS 'XA_WM_SIZE_HINTS 'XA_WM_ZOOM_HINTS
+ 'XA_MIN_SPACE 'XA_NORM_SPACE 'XA_MAX_SPACE 'XA_END_SPACE 'XA_SUPERSCRIPT_X 'XA_SUPERSCRIPT_Y
+ 'XA_SUBSCRIPT_X 'XA_SUBSCRIPT_Y 'XA_UNDERLINE_POSITION 'XA_UNDERLINE_THICKNESS 'XA_STRIKEOUT_ASCENT
+ 'XA_STRIKEOUT_DESCENT 'XA_ITALIC_ANGLE 'XA_X_HEIGHT 'XA_QUAD_WIDTH 'XA_WEIGHT 'XA_POINT_SIZE
+ 'XA_RESOLUTION 'XA_COPYRIGHT 'XA_NOTICE 'XA_FONT_NAME 'XA_FAMILY_NAME 'XA_FULL_NAME 'XA_CAP_HEIGHT
+ 'XA_WM_CLASS 'XA_WM_TRANSIENT_FOR)))
+ (for-each
+ (lambda (n name)
+ (if (not (Atom? n))
+ (snd-display #__line__ ";Atom: ~A -> ~A" name (Atom? n))))
+ atoms
+ atom-names))
+
+ (let ((r (XRectangle 10 20 100 110)))
+ (if (not (= (.width r) 100))
+ (snd-display #__line__ ";XRectangle width: ~A" (.width r)))
+ (if (not (= (.height r) 110))
+ (snd-display #__line__ ";XRectangle height: ~A" (.height r)))
+ (if (not (= (.x r) 10))
+ (snd-display #__line__ ";XRectangle x: ~A" (.x r)))
+ (if (not (= (.y r) 20))
+ (snd-display #__line__ ";XRectangle y: ~A" (.y r)))
+ (set! (.width r) 10)
+ (if (not (= (.width r) 10))
+ (snd-display #__line__ ";set XRectangle width: ~A" (.width r)))
+ (set! (.height r) 11)
+ (if (not (= (.height r) 11))
+ (snd-display #__line__ ";set XRectangle height: ~A" (.height r)))
+ (set! (.x r) 1)
+ (if (not (= (.x r) 1))
+ (snd-display #__line__ ";set XRectangle x: ~A" (.x r)))
+ (set! (.y r) 2)
+ (if (not (= (.y r) 2))
+ (snd-display #__line__ ";XRectangle y: ~A" (.y r))))
+
+ (let ((r (XArc 10 20 100 110 0 235)))
+ (if (not (= (.width r) 100))
+ (snd-display #__line__ ";XArc width: ~A" (.width r)))
+ (if (not (= (.height r) 110))
+ (snd-display #__line__ ";XArc height: ~A" (.height r)))
+ (if (not (= (.x r) 10))
+ (snd-display #__line__ ";XArc x: ~A" (.x r)))
+ (if (not (= (.y r) 20))
+ (snd-display #__line__ ";XArc y: ~A" (.y r)))
+ (if (not (= (.angle1 r) 0))
+ (snd-display #__line__ ";XArc angle1: ~A" (.angle1 r)))
+ (if (not (= (.angle2 r) 235))
+ (snd-display #__line__ ";XArc angle2: ~A" (.angle2 r)))
+ (set! (.width r) 10)
+ (if (not (= (.width r) 10))
+ (snd-display #__line__ ";set XArc width: ~A" (.width r)))
+ (set! (.height r) 11)
+ (if (not (= (.height r) 11))
+ (snd-display #__line__ ";set XArc height: ~A" (.height r)))
+ (set! (.x r) 1)
+ (if (not (= (.x r) 1))
+ (snd-display #__line__ ";set XArc x: ~A" (.x r)))
+ (set! (.y r) 2)
+ (if (not (= (.y r) 2))
+ (snd-display #__line__ ";set XArc y: ~A" (.y r)))
+ (set! (.angle1 r) 123)
+ (if (not (= (.angle1 r) 123))
+ (snd-display #__line__ ";set XArc angle1: ~A" (.angle1 r)))
+ (set! (.angle2 r) 321)
+ (if (not (= (.angle2 r) 321))
+ (snd-display #__line__ ";set XArc angle2: ~A" (.angle2 r))))
+
+ (let ((r (XPoint 10 20)))
+ (if (not (= (.x r) 10))
+ (snd-display #__line__ ";XPoint x: ~A" (.x r)))
+ (if (not (= (.y r) 20))
+ (snd-display #__line__ ";XPoint y: ~A" (.y r)))
+ (set! (.x r) 1)
+ (if (not (= (.x r) 1))
+ (snd-display #__line__ ";set XPoint x: ~A" (.x r)))
+ (set! (.y r) 2)
+ (if (not (= (.y r) 2))
+ (snd-display #__line__ ";set XPoint y: ~A" (.y r))))
+
+ (let ((r (XSegment 10 20 100 110)))
+ (if (not (= (.x1 r) 10))
+ (snd-display #__line__ ";XSegment x1: ~A" (.x1 r)))
+ (if (not (= (.y1 r) 20))
+ (snd-display #__line__ ";XSegment y1: ~A" (.y1 r)))
+ (if (not (= (.x2 r) 100))
+ (snd-display #__line__ ";XSegment x2: ~A" (.x2 r)))
+ (if (not (= (.y2 r) 110))
+ (snd-display #__line__ ";XSegment y2: ~A" (.y2 r)))
+ (set! (.x1 r) 1)
+ (if (not (= (.x1 r) 1))
+ (snd-display #__line__ ";set XSegment x1: ~A" (.x1 r)))
+ (set! (.y1 r) 2)
+ (if (not (= (.y1 r) 2))
+ (snd-display #__line__ ";set XSegment y1: ~A" (.y1 r)))
+ (set! (.x2 r) 10)
+ (if (not (= (.x2 r) 10))
+ (snd-display #__line__ ";set XSegment x2: ~A" (.x2 r)))
+ (set! (.y2 r) 11)
+ (if (not (= (.y2 r) 11))
+ (snd-display #__line__ ";set XSegment y2: ~A" (.y2 r))))
+
+ (let ((c (XColor)))
+ (set! (.red c) 1)
+ (if (not (= (.red c) 1)) (snd-display #__line__ ";Xcolor red: ~A" (.red c)))
+ (set! (.green c) 1)
+ (if (not (= (.green c) 1)) (snd-display #__line__ ";Xcolor green: ~A" (.green c)))
+ (set! (.blue c) 1)
+ (if (not (= (.blue c) 1)) (snd-display #__line__ ";Xcolor blue: ~A" (.blue c)))
+ (set! (.flags c) DoRed)
+ (if (not (= (.flags c) DoRed)) (snd-display #__line__ ";Xcolor flags: ~A" (.flags c)))
+ (if (not (= (.pad c) 0)) (snd-display #__line__ ";pad: ~A" (.pad c)))
+ (set! (.pixel c) *basic-color*)
+ (if (not (equal? (.pixel c) *basic-color*)) (snd-display #__line__ ";Xcolor pixel: ~A" (.pixel c))))
+
+ (let ((obj (XTextItem "hiho" 4 3 (list 'Font 1))))
+ (if (not (XTextItem? obj)) (snd-display #__line__ ";XTextItem -> ~A" obj))
+ (if (not (equal? (.font obj) (list 'Font 1))) (snd-display #__line__ ";font ~A" (.font obj)))
+ (set! (.font obj) (list 'Font 2))
+ (if (not (equal? (.font obj) (list 'Font 2))) (snd-display #__line__ ";set font ~A" (.font obj)))
+ (if (not (string=? (.chars obj) "hiho")) (snd-display #__line__ ";chars: ~A" (.chars obj)))
+ (if (not (= (.nchars obj) 4)) (snd-display #__line__ ";chars: ~A" (.nchars obj)))
+ (set! (.chars obj) "away!")
+ (set! (.nchars obj) 5)
+ (if (not (string=? (.chars obj) "away!")) (snd-display #__line__ ";set chars: ~A" (.chars obj)))
+ (if (not (= (.nchars obj) 5)) (snd-display #__line__ ";set chars: ~A" (.nchars obj)))
+ (if (not (= (.delta obj) 3)) (snd-display #__line__ ";delta ~A" (.delta obj)))
+ (set! (.delta obj) 4)
+ (if (not (= (.delta obj) 4)) (snd-display #__line__ ";set delta ~A" (.delta obj)))
+ )
+
+ (let ((reg (XPolygonRegion (list (XPoint 0 0) (XPoint 10 0) (XPoint 10 10) (XPoint 0 10)) 4 WindingRule)))
+ (if (not (XPointInRegion reg 4 4)) (snd-display #__line__ ";XPointInRegion"))
+ (XShrinkRegion reg 1 2)
+ (if (not (XPointInRegion reg 4 7)) (snd-display #__line__ ";t XShrinkRegion"))
+ (if (XPointInRegion reg 4 9) (snd-display #__line__ ";f XShrinkRegion"))
+ (XOffsetRegion reg 1 2)
+ (if (not (XPointInRegion reg 4 9)) (snd-display #__line__ ";t XOffsetRegion"))
+ (if (XPointInRegion reg 1 9) (snd-display #__line__ ";f XOffsetRegion"))
+ (let ((reg2 (XCreateRegion))
+ (reg1 (XPolygonRegion (list (XPoint 2 2) (XPoint 10 2) (XPoint 10 10) (XPoint 2 10)) 4 WindingRule)))
+ (if (XEqualRegion reg reg1) (snd-display #__line__ ";f XEqualRegion"))
+ (if (XEmptyRegion reg) (snd-display #__line__ ";f XEmptyRegion"))
+ (XXorRegion reg reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 2))
+ (not (= (.y (cadr box)) 2))
+ (not (= (.width (cadr box)) 8))
+ (not (= (.height (cadr box)) 2)))
+ (snd-display #__line__ ";XXorRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XUnionRegion reg reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 2))
+ (not (= (.y (cadr box)) 2))
+ (not (= (.width (cadr box)) 8))
+ (not (= (.height (cadr box)) 8)))
+ (snd-display #__line__ ";XUnionRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XSubtractRegion reg reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 0))
+ (not (= (.y (cadr box)) 0))
+ (not (= (.width (cadr box)) 0))
+ (not (= (.height (cadr box)) 0)))
+ (snd-display #__line__ ";XSubtractRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XIntersectRegion reg reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 2))
+ (not (= (.y (cadr box)) 4))
+ (not (= (.width (cadr box)) 8))
+ (not (= (.height (cadr box)) 6)))
+ (snd-display #__line__ ";XIntersectRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XUnionRectWithRegion (XRectangle 1 3 100 100) reg1 reg2)
+ (let ((box (XClipBox reg2)))
+ (if (or (not (= (.x (cadr box)) 1))
+ (not (= (.y (cadr box)) 2))
+ (not (= (.width (cadr box)) 100))
+ (not (= (.height (cadr box)) 101)))
+ (snd-display #__line__ ";XUnionRectWithRegion: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XRectInRegion reg 0 0 100 100)
+ (let ((box (XClipBox reg1)))
+ (if (or (not (= (.x (cadr box)) 2))
+ (not (= (.y (cadr box)) 2))
+ (not (= (.width (cadr box)) 8))
+ (not (= (.height (cadr box)) 8)))
+ (snd-display #__line__ ";XClipBox: ~A ~A ~A ~A" (.x (cadr box)) (.y (cadr box)) (.width (cadr box)) (.height (cadr box)))))
+ (XDestroyRegion reg1)
+ ))
+
+ (let ((xid (XUniqueContext))
+ (dpy (XtDisplay (cadr (main-widgets)))))
+ (if (not (eq? (car xid) 'XContext))
+ (snd-display #__line__ ";XUniqueContext: ~A" xid))
+ (XSaveContext dpy 123 xid "hiho")
+ (let ((val (XFindContext dpy 123 xid)))
+ (if (or (not (= 0 (car val)))
+ (not (string=? (cadr val) "hiho")))
+ (snd-display #__line__ ";XFindContext: ~A" val)))
+ (XDeleteContext dpy 123 xid)
+ (XStoreBytes dpy "hiho" 4)
+ (if (not (string=? (XFetchBytes dpy) "hiho")) (snd-display #__line__ ";XStoreBytes: ~A" (XFetchBytes dpy)))
+ (XStoreBuffer dpy "hiho" 4 1)
+ (if (not (string=? (XFetchBuffer dpy 1) "hiho")) (snd-display #__line__ ";XStoreBuffer: ~A" (XFetchBuffer dpy 1)))
+ )
+
+
+ ;; ---------------- Xt tests ----------------
+ (let ((name (XtGetApplicationNameAndClass (XtDisplay (cadr (main-widgets))))))
+ (if (not (equal? name (list "snd" "Snd")))
+ (snd-display #__line__ ";XtGetApplicationNameAndClass: ~A?" name)))
+ (let ((dpys (XtGetDisplays (car (main-widgets)))))
+ (if (not (Display? (car dpys)))
+ (snd-display #__line__ ";XtGetDisplays: ~A?" dpys)))
+ (let ((app (XtDisplayToApplicationContext (XtDisplay (cadr (main-widgets)))))
+ (orig (car (main-widgets)))
+ (wid (XtWidgetToApplicationContext (cadr (main-widgets)))))
+ (if (not (equal? app orig))
+ (snd-display #__line__ ";XtDisplayToApplicationContext: ~A ~A?" app orig))
+ (if (not (equal? app wid))
+ (snd-display #__line__ ";XtWidgetToApplicationContext: ~A ~A?" app wid)))
+ (if (not (string=? (XtName (caddr (main-widgets))) "mainpane"))
+ (snd-display #__line__ ";XtName main pane: ~A" (XtName (caddr (main-widgets)))))
+ (if (not (= (XtGetMultiClickTime (XtDisplay (cadr (main-widgets)))) 200))
+ (snd-display #__line__ ";XtGetMultiClickTime: ~A" (XtGetMultiClickTime (XtDisplay (cadr (main-widgets))))))
+ (XtSetMultiClickTime (XtDisplay (cadr (main-widgets))) 250)
+ (if (not (= (XtGetMultiClickTime (XtDisplay (cadr (main-widgets)))) 250))
+ (snd-display #__line__ ";XtSetMultiClickTime: ~A" (XtGetMultiClickTime (XtDisplay (cadr (main-widgets))))))
+ (XtGetResourceList xmListWidgetClass)
+ (let ((wid1 (XtCreateWidget "wid1" xmPushButtonWidgetClass (cadr (main-widgets)) ())))
+ (XtDestroyWidget wid1))
+
+ (let ((hook-id (XtAppAddActionHook
+ (car (main-widgets))
+ (lambda (w data name e p)
+ (format #t "~A ~A ~A ~A ~A~%" w data name e p))
+ #f)))
+ (XtRemoveActionHook hook-id))
+
+ (let* ((shell (cadr (main-widgets)))
+ (wid (XtCreateWidget "wid" xmFormWidgetClass shell ()))
+ (wid1 (XtCreateWidget "wid1" xmPushButtonWidgetClass wid ()))
+ (wid2 (XtVaCreateWidget "wid" xmFormWidgetClass shell ())))
+ (if (XtIsApplicationShell wid) (snd-display #__line__ ";XtIsApplicationShell"))
+ (if (not (XtIsApplicationShell shell)) (snd-display #__line__ ";XtIsApplicationShell of appshell"))
+ (if (not (XtIsComposite wid)) (snd-display #__line__ ";XtIsComposite"))
+ (if (not (XtIsConstraint wid)) (snd-display #__line__ ";XtIsConstraint"))
+ (if (XtIsManaged wid) (snd-display #__line__ ";XtIsManaged"))
+ (if (not (XtIsObject wid)) (snd-display #__line__ ";XtIsObject"))
+ (if (XtIsOverrideShell wid) (snd-display #__line__ ";XtIsOverrideShell"))
+ (if (XtIsRealized wid) (snd-display #__line__ ";XtIsRealized"))
+ (if (not (XtIsRealized shell)) (snd-display #__line__ ";XtIsRealized main shell"))
+ (if (not (XtIsRectObj wid)) (snd-display #__line__ ";XtIsRectObj"))
+ (if (not (XtIsSensitive wid)) (snd-display #__line__ ";XtIsSensitive"))
+ (if (not (XtIsSensitive shell)) (snd-display #__line__ ";XtIsSensitive of main shell"))
+ (XtSetSensitive wid1 #t)
+ (if (not (XtIsSensitive wid1)) (snd-display #__line__ ";XtIsSensitive of button"))
+ (if (XtIsSessionShell wid) (snd-display #__line__ ";XtIsSessionShell"))
+ (if (XtIsShell wid) (snd-display #__line__ ";XtIsShell"))
+ (if (not (XtIsShell shell)) (snd-display #__line__ ";XtIsShell of main shell"))
+ (if (XtIsTopLevelShell wid) (snd-display #__line__ ";XtIsTopLevelShell"))
+ (if (not (XtIsTopLevelShell shell)) (snd-display #__line__ ";XtIsTopLevelShell of main shell"))
+ (if (XtIsTransientShell wid) (snd-display #__line__ ";XtIsTransientShell"))
+ (if (XtIsVendorShell wid) (snd-display #__line__ ";XtIsVendorShell"))
+ (if (not (XtIsVendorShell shell)) (snd-display #__line__ ";XtIsVendorShell of main shell"))
+ (if (XtIsWMShell wid) (snd-display #__line__ ";XtIsWMShell"))
+ (if (not (XtIsWidget wid)) (snd-display #__line__ ";XtIsWidget"))
+ (if (not (XtIsWidget wid2)) (snd-display #__line__ ";XtIsWidget 2"))
+ (XtRealizeWidget wid)
+ (if (not (XtIsRealized wid)) (snd-display #__line__ ";XtRealizeWidget?"))
+ (XtAddGrab shell #f #f)
+ (XtRemoveGrab shell)
+ (XtMakeResizeRequest wid 200 200)
+ (XtMapWidget wid)
+ (XtUnmapWidget wid)
+ (XtUnrealizeWidget wid)
+ ;(XtDestroyWidget wid1)
+ )
+ ; (XtFree 0) (XtCalloc 0 0) (XtMalloc 0) (XtRealloc 0 0)
+ (XtSetLanguageProc
+ (car (main-widgets))
+ (lambda (dpy str data)
+ (snd-display #__line__ ";YOW: language proc: got ~A ~A" str data))
+ "who called us?")
+ (XtSetLanguageProc (car (main-widgets)) #f "oops")
+ (XtSetLanguageProc #f #f "oops")
+ (XtMergeArgLists (list 1 2) 2 (list 1) 1)
+
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell)))
+ (if (not (equal? (XtClass shell) applicationShellWidgetClass))
+ (snd-display #__line__ ";XtClass shell: ~A" (XtClass shell)))
+ (if (not (equal? (XtSuperclass shell) topLevelShellWidgetClass))
+ (snd-display #__line__ ";XtSuperclass shell: ~A" (XtClass shell)))
+ (if (not (string=? (XtName shell) "snd"))
+ (snd-display #__line__ ";XtName: ~A" (XtName shell)))
+ (if (not (equal? (XtWindow shell) (XtWindowOfObject shell)))
+ (snd-display #__line__ ";XtWindow: ~A ~A" (XtWindow shell) (XtWindowOfObject shell)))
+ (if (not (equal? (XtScreen shell) (XtScreenOfObject shell)))
+ (snd-display #__line__ ";XtScreen: ~A ~A" (XtScreen shell) (XtScreenOfObject shell)))
+ (if (not (equal? (XtDisplay shell) (XtDisplayOfObject shell)))
+ (snd-display #__line__ ";XtDisplay: ~A ~A" (XtDisplay shell) (XtDisplayOfObject shell)))
+ (if (not (Time? (XtLastTimestampProcessed dpy)))
+ (snd-display #__line__ ";XtLastTimestampProcessed: ~A" (XtLastTimestampProcessed dpy)))
+ (if (not (XEvent? (XtLastEventProcessed dpy)))
+ (snd-display #__line__ ";XtLastEventProcessed: ~A" (XtLastEventProcessed dpy)))
+ (XtBuildEventMask shell)
+ (let ((val 0))
+ (XtRegisterCaseConverter
+ dpy
+ (lambda (dp key)
+ (set! val 123)
+ (list (list 'KeySym 65)
+ (list 'KeySym 97)))
+ (list 'KeySym 65)
+ (list 'KeySym 65))
+ (XtConvertCase dpy (list 'KeySym 65))
+ (if (not (= val 123)) (snd-display #__line__ ";XtRegisterCaseConverter: ~A" val)))
+ (XtRegisterGrabAction (lambda (a b c) #f) #f ColormapChangeMask GrabModeSync GrabModeAsync)
+ (let ((vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
+ (if (or (not (= (car vals) 0))
+ (not (KeySym? (cadr vals))))
+ (snd-display #__line__ ";XtTranslateKeycode: ~A" vals))
+ (if (not (equal? vals (XtTranslateKey dpy (list 'KeyCode XK_B) 0)))
+ (snd-display #__line__ ";XtTranslateKey: ~A ~A" vals (XtTranslateKey dpy (list 'KeyCode XK_B) 0)))
+ (XtSetKeyTranslator dpy #f)
+ (if (not (equal? vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
+ (snd-display #__line__ ";XtSetKeyTranslator #f: ~A ~A" vals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
+ (XtSetKeyTranslator dpy (lambda (d k m)
+ (if (not (equal? d dpy)) (snd-display #__line__ ";d in keyproc: ~A ~A" d dpy))
+ (XtTranslateKey d k m)))
+ (let ((newvals (XtTranslateKeycode dpy (list 'KeyCode XK_B) 0)))
+ (if (not (equal? vals newvals)) (snd-display #__line__ ";XtSetKeyTranslator: ~A ~A" vals newvals)))
+ (XtSetKeyTranslator dpy #f))
+ (if (not (KeySym? (cadr (XmTranslateKey dpy (list 'KeyCode XK_B) 0))))
+ (snd-display #__line__ ";XmTranslateKey: ~A" (XmTranslateKey dpy XK_B 0)))
+ (let ((kv (XtKeysymToKeycodeList dpy (list 'KeySym 65509))))
+ (if (not (equal? (car kv) (list 'KeyCode 66)))
+ (snd-display #__line__ ";XtKeysymToKeycodeList: ~A ~A" kv (XtKeysymToKeycodeList dpy (list 'KeySym 65509)))))
+ (XtInstallAllAccelerators (cadr (main-widgets)) (caddr (main-widgets)))
+ (XtInstallAccelerators (cadr (main-widgets)) (caddr (main-widgets)))
+ (if (not (equal? (list 0 1 2) (XtSetArg 0 1 2))) (snd-display #__line__ ";XtSetArg: ~A" (XtSetArg 0 1 2)))
+ (if (not (Widget? (XtGetKeyboardFocusWidget (cadr (main-widgets)))))
+ (snd-display #__line__ ";XtGetKeyboardFocusWidget: ~A" (XtGetKeyboardFocusWidget (cadr (main-widgets)))))
+ (let ((id (XtAppAddInput (car (main-widgets)) 1 XtInputReadMask (lambda (a b c) #f) #f)))
+ (XtRemoveInput id))
+
+ (let ((id (XtAppAddWorkProc (car (main-widgets)) (lambda (me) #f) #f)))
+ (XtRemoveWorkProc id))
+ (if (not (equal? (caddr (main-widgets)) (XtNameToWidget (cadr (main-widgets)) "mainpane")))
+ (snd-display #__line__ ";XtNameToWidget: ~A ~A" (caddr (main-widgets)) (XtNameToWidget (cadr (main-widgets)) "mainpane")))
+ (XtVaCreatePopupShell "hiho" vendorShellWidgetClass (cadr (main-widgets)) ())
+ (XtResolvePathname (XtDisplay (cadr (main-widgets))) "app-defaults" #f #f #f #f 0 #f)
+ (XtFindFile ".snd" #f 0 #f)
+
+ (XtAppLock (car (main-widgets)))
+ (XtAppUnlock (car (main-widgets)))
+ (let ((acts (XtGetActionList xmLabelWidgetClass)))
+ (if (or (not (= (length acts) 4))
+ (not (string=? (caar acts) "Enter")))
+ (snd-display #__line__ ";XtGetActionList: ~A" acts)))
+ )
+
+ (let ((pop (XtCreatePopupShell "hiho" xmGrabShellWidgetClass (cadr (main-widgets))
+ (list XmNiconNameEncoding XA_STRING))))
+ (XtPopup pop XtGrabNone)
+ (XtPopdown pop))
+ (XtAppSetWarningHandler (car (main-widgets))
+ (lambda (n)
+ (if (not (string=? n "hiho"))
+ (snd-display #__line__ ";XtWarning: ~A" n))))
+ (XtAppSetWarningMsgHandler (car (main-widgets))
+ (lambda (name type klass def pars num)
+ (snd-display #__line__ ";ignore: ~A ~A ~A~%" name def pars)))
+
+ (let ((listener ((main-widgets) 4)))
+ (XtCallActionProc listener "text-transpose" (XEvent) #f 0)
+ (XtCallActionProc listener "begin-of-line" (XEvent) #f 0)
+ (XtCallActionProc listener "kill-line" (XEvent) #f 0)
+ (XtCallActionProc listener "yank" (XEvent) #f 0)
+ (XtCallActionProc listener "name-completion" (XEvent) #f 0)
+ (XtCallActionProc listener "listener-completion" (XEvent) #f 0)
+ (XtCallActionProc listener "no-op" (XEvent) #f 0)
+ (XtCallActionProc listener "delete-region" (XEvent) #f 0)
+ (XtCallActionProc listener "listener-g" (XEvent) #f 0)
+ (XtCallActionProc listener "listener-clear" (XEvent) #f 0)
+ (XtCallActionProc listener "b1-press" (XEvent) #f 0)
+ (XtCallActionProc listener "delete-to-previous-command" (XEvent) #f 0)
+ (let ((BEvent (XEvent ButtonPress)))
+ (set! (.x BEvent) 10)
+ (set! (.y BEvent) 10)
+ (XtCallActionProc listener "b1-press" BEvent #f 0)
+ (XtCallActionProc listener "b1-release" BEvent #f 0))
+ (XtCallActionProc listener "word-upper" (XEvent) (list "u") 1))
+
+ (let ((ind (open-sound "oboe.snd")))
+ (set! (show-controls ind) #t)
+ (let* ((swids (sound-widgets ind))
+ (sctrls (swids 2))
+ (wh (widget-size sctrls)))
+ (XtUnmanageChild sctrls)
+ (set! (widget-size sctrls) (list (car wh) (* (cadr wh) 3)))
+ (XtManageChild sctrls)
+
+ (let ((tag (catch #t (lambda () (XtVaGetValues (car (sound-widgets)) (list "XmNpaneMaximum" 0)))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-resource))
+ (snd-display #__line__ ";XtVaGetValues of incorrectly quoted resource name: ~A" tag)))
+ )
+
+ (close-sound ind))
+
+
+ ;; ---------------- XM tests ----------------
+ (let* ((label-render-table (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNlabelRenderTable 0))))
+ (renditions (and label-render-table
+ (XmRenderTableGetRenditions label-render-table (XmRenderTableGetTags label-render-table))))
+ (default-font-name (and renditions
+ (cadr (XmRenditionRetrieve (car renditions) (list XmNfontName 0)))))
+ (default-font-info (and renditions
+ (XmRenditionRetrieve (car renditions) (list XmNfont 0 XmNfontType 0)))))
+ (if (not (string=? default-font-name "fixed")) (snd-display #__line__ ";XmRenderTableGetRenditions name: ~A" default-font-name))
+ (if (not (XFontStruct? (default-font-info 1))) (snd-display #__line__ ";XmRenderTableGetRenditions font struct: ~A" default-font-info))
+ (if (not (= (default-font-info 3) XmFONT_IS_FONT)) (snd-display #__line__ ";XmRenderTableGetRenditions font type: ~A" default-font-info)))
+
+
+ (let* ((button-render-table (cadr (XtVaGetValues (cadr (main-widgets)) (list XmNbuttonRenderTable 0))))
+ (default-rendition (and button-render-table
+ (XmRenderTableGetRendition button-render-table XmFONTLIST_DEFAULT_TAG)))
+ (default-font-info (and default-rendition
+ (XmRenditionRetrieve default-rendition (list XmNfont 0 XmNfontType 0)))))
+ (if (and default-font-info
+ (= (default-font-info 3) XmFONT_IS_FONT))
+ (let ((font (cadr default-font-info))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (data ()))
+ (for-each (lambda (name atom?)
+ (let ((val (XGetFontProperty font name)))
+ (if (car val)
+ (set! data (cons (list (XGetAtomName (XtDisplay (cadr (main-widgets))) name)
+ (if atom?
+ (XGetAtomName (XtDisplay (cadr (main-widgets))) (list 'Atom (cadr val)))
+ (cadr val)))
+ data)))))
+ (list XA_POINT_SIZE XA_FONT XA_FULL_NAME
+ (XInternAtom dpy "XA_SLANT" #f)
+ (XInternAtom dpy "XA_WEIGHT_NAME" #f)
+ XA_FAMILY_NAME
+ (XInternAtom dpy "XA_FOUNDRY" #f)
+ XA_CAP_HEIGHT)
+ (list #f #t #t #t #t #t #t #f))
+ (if (not (string=? "Fixed" (cadr (data 1)))) (snd-display #__line__ ";XmRenderTableGetRendition: ~A" data)))))
+
+ (let* ((tabs (let ((ctr 0))
+ (map
+ (lambda (n)
+ (set! ctr (+ ctr 1))
+ (XmTabCreate n XmINCHES (if (= ctr 1) XmABSOLUTE XmRELATIVE) XmALIGNMENT_BEGINNING "."))
+ (list 1.5 1.5 1.5 1.5))))
+ (tablist (XmTabListInsertTabs #f tabs (length tabs) 0)))
+ (if (not (= (XmTabListTabCount tablist) (length tabs)))
+ (snd-display #__line__ ";tablist len: ~A ~A~%" (XmTabListTabCount tablist) (length tabs)))
+ (if (not (equal? (XmTabGetValues (XmTabListGetTab tablist 0)) (list 1.5 5 0 0 ".")))
+ (snd-display #__line__ ";XmTabs 0: ~A" (XmTabGetValues (XmTabListGetTab tablist 0))))
+ (if (not (equal? (XmTabGetValues (XmTabListGetTab tablist 2)) (list 1.5 5 1 0 ".")))
+ (snd-display #__line__ ";XmTabs 2: ~A" (XmTabGetValues (XmTabListGetTab tablist 2))))
+ (let ((copytab (XmTabListCopy tablist 0 0)))
+ (if (not (equal? (XmTabGetValues (XmTabListGetTab copytab 0)) (list 1.5 5 0 0 ".")))
+ (snd-display #__line__ ";XmTabListCopy 0: ~A" (XmTabGetValues (XmTabListGetTab copytab 0))))
+ (let ((another (XmTabListRemoveTabs copytab (list 0 1)))
+ (atab (XmTabCreate 3.0 XmINCHES XmABSOLUTE XmALIGNMENT_BEGINNING ".")))
+ (if (not (equal? (XmTabGetValues (XmTabListGetTab another 0)) (list 1.5 5 1 0 ".")))
+ (snd-display #__line__ ";XmTabListRemoveTabs: ~A" (XmTabGetValues (XmTabListGetTab another 0))))
+ (XmTabListReplacePositions (XmTabListCopy tablist 0 0) (list 1) (list atab))
+ ;; this (replacepositions) is very prone to segfaults -- *very* poorly implemented!
+ (XmTabSetValue atab 6.0)
+ (XmTabFree atab)
+ (XmTabListFree another))
+ (let ((tabl (XmStringTableProposeTablist
+ (list (XmStringCreateLocalized "a-string") (XmStringCreateLocalized "another")) 2
+ (cadr (main-widgets))
+ 1.0
+ XmABSOLUTE)))
+ (if (not (XmTabList? tabl)) (snd-display #__line__ ";XmStringTableProposeTabList: ~A" tabl))
+ (XmTabListFree tabl)))
+
+ (let ((hname (host-name))) ; from snd-motif.scm
+ (if (not (equal? hname (getenv "HOSTNAME")))
+ (snd-display #__line__ ";host name appears to be ~A or maybe ~A" hname (getenv "HOSTNAME"))))
+ (let ((blu (x->snd-color "blue")))
+ (if (not (Pixel? blu)) (snd-display #__line__ ";x->snd-color can't find blue! ~A" blu))
+ (if (not (equal? (color->list blu) (list 0.0 0.0 1.0)))
+ (snd-display #__line__ ";x->snd-color blue: ~A" (color->list blu))))
+
+ (let* ((tmp (XmStringCreateLocalized "h"))
+ (pm (XmParseMappingCreate (list XmNincludeStatus XmINSERT
+ XmNsubstitute tmp
+ XmNpattern "i"
+ XmNpatternType XmCHARSET_TEXT))))
+ (XmStringFree tmp)
+ (XmParseMappingFree pm)
+ (set! pm (XmParseMappingCreate (list XmNinvokeParseProc
+ (lambda (txt end type tag entry pattern str call)
+ #f))))
+ (XmParseMappingFree pm)
+ (let ((tag (catch #t (lambda ()
+ (set! pm (XmParseMappingCreate (list XmNinvokeParseProc
+ (lambda (txt end type tag entry pattern)
+ #f)))))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmNinvokeParseProc wrong arity: ~A" tag))))
+
+ (let* ((fonts (list "fixed"
+ "-*-times-bold-r-*-*-14-*-*-*-*-*-*-*"
+ "-*-*-medium-i-*-*-18-*-*-*-*-*-*-*"
+ "-*-helvetica-*-*-*-*-18-*-*-*-*-*-*-*"))
+ (tags (list "one" "two" "three" "four"))
+ (colors (list "red" "green" "blue" "orange"))
+ (pixels
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (scr (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr)))
+ (let ((col (XColor)))
+ (XParseColor dpy cmap "blue" col)
+ (if (or (not (= (.red col) 0))
+ (not (= (.green col) 0))
+ (not (= (.blue col) 65535)))
+ (snd-display #__line__ ";XParseColor: ~A ~A ~A ~A" col (.red col) (.blue col) (.green col)))
+ (XLookupColor dpy cmap "red" col (XColor))
+ (if (or (not (= (.red col) 65535))
+ (not (= (.green col) 0))
+ (not (= (.blue col) 0)))
+ (snd-display #__line__ ";XLookupColor: ~A ~A ~A ~A" col (.red col) (.blue col) (.green col))))
+ (map
+ (lambda (color)
+ (let ((col (XColor)))
+ (if (= (XAllocNamedColor dpy cmap color col col) 0)
+ (snd-error (format #f "can't allocate ~A" color))
+ (.pixel col))))
+ colors)))
+ (rendertable (XmRenderTableAddRenditions #f
+ (let ((ctr 0))
+ (map (lambda (r)
+ (set! ctr (+ ctr 1))
+ (XmRenditionCreate (cadr (main-widgets))
+ r
+ (append
+ (if (= ctr 1)
+ (list XmNtabList tablist)
+ ())
+ (list XmNrenditionForeground (pixels (- ctr 1))
+ XmNfontName (fonts (- ctr 1))
+ XmNfontType XmFONT_IS_FONT))))
+ tags))
+ (length tags)
+ XmMERGE_NEW)))
+
+ (if (file-exists? "hiho") (delete-file "hiho"))
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (scr (DefaultScreenOfDisplay dpy))
+ (p1 (XmGetPixmap scr "hiho" (car pixels) (cadr pixels))))
+ (if (not (Pixmap? p1)) (snd-display #__line__ ";XmGetPixmap: ~A" p1))
+ (set! p1 (XmGetPixmapByDepth scr "hoho" (car pixels) (cadr pixels) (XDefaultDepth dpy (XScreenNumberOfScreen scr))))
+ (if (not (Pixmap? p1)) (snd-display #__line__ ";XmGetPixmapByDepth: ~A" p1))
+ (XmDestroyPixmap scr p1))
+
+ (let ((tabl (XmStringTableParseStringArray (list "hi" "ho") 2 "hiho" XmCHARSET_TEXT #f 0 #f)))
+ (if (not (XmString? (car tabl))) (snd-display #__line__ ";XmStringTableParseStringArray: ~A" tabl))
+ (let ((strs (XmStringTableUnparse tabl 2 "hiho" XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
+ (if (not (equal? strs (list "hi" "ho"))) (snd-display #__line__ ";XmStringTableUnparse: ~A" strs)))
+ (let ((str (XmStringTableToXmString tabl 2 #f)))
+ (if (not (XmString? str)) (snd-display #__line__ ";XmStringTableToXmString: ~A" str))
+ (XmStringToXmStringTable str #f)
+ (let ((val (XmStringUnparse str "hiho" XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL)))
+ (if (not (string=? val "hiho")) (snd-display #__line__ ";XmStringUnparse: ~A" val))
+ (set! val (XmStringUnparse (XmStringCreateLocalized "hi") #f XmCHARSET_TEXT XmCHARSET_TEXT #f 0 XmOUTPUT_ALL))
+ (if (not (string=? val "hi")) (snd-display #__line__ ";XmStringUnparse null tag: ~A" val)))
+ ;; XmCvtXmStringToByteStream test deleted because it seems to be buggy in memory handling
+ (let* ((ind (open-sound "oboe.snd"))
+ (grf1 (car (channel-widgets)))
+ (dpy (XtDisplay grf1))
+ (win (XtWindow grf1))
+ (scr (DefaultScreenOfDisplay dpy))
+ (scrn (XScreenNumberOfScreen scr))
+ (gv (XGCValues)))
+ (if (not (Font? (current-font ind))) (snd-display #__line__ ";current-font: ~A" (current-font ind)))
+ (let ((old-font (current-font))
+ (a-font (load-font "6x12")))
+ (set! (current-font) a-font)
+ (if (not (equal? a-font (current-font)))
+ (snd-display #__line__ ";set current-font: ~A ~A" a-font (current-font)))
+ (set! (current-font ind) old-font)
+ (if (not (equal? old-font (current-font ind)))
+ (snd-display #__line__ ";set current-font with ind: ~A ~A" old-font (current-font ind)))
+ (set! (current-font) a-font)
+ (set! (current-font ind 0) old-font)
+ (if (not (equal? old-font (current-font ind 0)))
+ (snd-display #__line__ ";set current-font with ind/0: ~A ~A" old-font (current-font ind 0)))
+ (set! (current-font) old-font))
+
+ (set! (.foreground gv) *data-color*)
+ (set! (.background gv) *basic-color*)
+ (set! (.function gv) GXcopy)
+ (let ((sgc (XtAllocateGC grf1
+ (XDefaultDepth dpy scrn)
+ (logior GCForeground GCBackground GCFunction)
+ gv
+ (logior GCFont GCDashList)
+ 0))
+ (str2 (XmStringCreateLocalized "hiho")))
+ (XmStringDraw dpy win rendertable str2 sgc 10 10 100
+ XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100))
+ (XmStringDrawImage dpy win rendertable str2 sgc 10 10 100
+ XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100))
+ (XmStringDrawUnderline dpy win rendertable str2 sgc 10 10 100
+ XmALIGNMENT_END XmSTRING_DIRECTION_L_TO_R (XRectangle 0 0 100 100) str2)
+ (XtGetGC (cadr (main-widgets)) GCForeground gv)
+ (XCopyGC dpy sgc GCFunction sgc)
+ (XCopyArea dpy win win sgc 0 0 100 100 0 0)
+ (XCopyPlane dpy win win sgc 0 0 100 100 0 0 1)
+ (XtReleaseGC grf1 sgc))
+ (close-sound ind))
+ (let ((lc (XmStringLineCount (XmStringCreateLocalized "hiho"))))
+ (if (not (= lc 1)) (snd-display #__line__ ";XmStringLineCount: ~A" lc)))
+ (if (not (XmStringHasSubstring str (XmStringCreateLocalized "hi"))) (snd-display #__line__ ";XmStringHasSubstring?"))))
+
+
+ (if (not (equal? (XmRenderTableGetTags rendertable) (list "one" "two" "three" "four")))
+ (snd-display #__line__ ";tags: ~A~%" (XmRenderTableGetTags rendertable)))
+ (let* ((rend (XmRenderTableGetRendition rendertable "one"))
+ (r (and rend (XmRenditionRetrieve rend
+ (list XmNrenditionForeground 0
+ XmNfontName 0
+ XmNfontType 0
+ XmNtag 0)))))
+ (if (and rend r)
+ (begin
+ (if (or (not (string=? (r 7) "one"))
+ (not (string=? (r 3) "fixed")))
+ (snd-display #__line__ ";rendertable: ~A" r))
+ (XmRenditionUpdate rend (list XmNstrikethruType XmSINGLE_LINE))
+ (if (not (= (cadr (XmRenditionRetrieve rend (list XmNstrikethruType 0))) XmSINGLE_LINE))
+ (snd-display #__line__ ";XmRenditionUpdate: ~A ~A" (cadr (XtGetValues rend (list XmNstrikethruType 0))) XmSINGLE_LINE)))
+ (snd-display #__line__ ";r and rend: ~A ~A~%" r rend)))
+ (let ((r1 (XmRenditionCreate (cadr (main-widgets)) "r1" (list XmNfontName "fixed"))))
+ (XmRenditionFree r1))
+
+ (if (not (equal? (XmDropSiteQueryStackingOrder ((main-widgets) 4)) (list #f)))
+ (snd-display #__line__ ";XmDropSiteQueryStackingOrder: ~A" (XmDropSiteQueryStackingOrder ((main-widgets) 4))))
+ (let ((tab (XmStringComponentCreate XmSTRING_COMPONENT_TAB 0 #f))
+ (row #f)
+ (table ())
+ (our-tags tags))
+ (for-each
+ (lambda (word)
+ (let ((entry (XmStringGenerate word
+ #f
+ XmCHARSET_TEXT
+ (car our-tags))))
+ (if (XmStringIsVoid entry) (snd-display #__line__ ";~A is void?" entry))
+ (if (XmStringEmpty entry) (snd-display #__line__ ";~A is empty?" entry))
+
+ (if row
+ (let ((tmp (XmStringConcat row tab)))
+ (XmStringFree row)
+ (set! row (XmStringConcatAndFree tmp entry)))
+ (set! row entry))
+ (set! our-tags (cdr our-tags))
+ (if (null? our-tags)
+ (begin
+ (set! our-tags tags)
+ (set! table (cons row table))
+ (set! row #f)))))
+ (list "this" "is" "a" "test" "of" "the" "renditions" "and" "rendertables"
+ "perhaps" "all" "will" "go" "well" "and" "then" "again" "perhaps" "not"))
+ (let* ((n (car table))
+ (c (XmStringInitContext n))
+ (happy #t))
+ (do ((i 0 (+ i 1)))
+ ((not happy))
+ (let ((type (XmStringGetNextTriple (cadr c))))
+ (if (= (car type) XmSTRING_COMPONENT_TEXT)
+ (if (or (not (= (cadr type) ((list 0 0 2 0 0 0 4 0 0 0 3 0 0 0 4) i)))
+ (not (string=? (caddr type)
+ ((list "o" "o" "go" "o" "o" "o" "well" "o" "o" "o" "and" "o" "o" "o" "then") i))))
+ (snd-display #__line__ ";component ~A -> ~A" i (cdr type)))
+ (if (and (not (= (car type) XmSTRING_COMPONENT_TAB))
+ (= (car type) XmSTRING_COMPONENT_END))
+ (set! happy #f)))))
+ (XmStringFreeContext (cadr c))))))
+
+ (XtAppAddActions (car (main-widgets))
+ (list (list "try1" (lambda (w e strs)
+ (snd-display #__line__ ";try1: ~A~%" strs)))
+ (list "try2" (lambda (w e strs)
+ (snd-display #__line__ ";try2: ~A~%" strs)))))
+ (let ((tab (XtParseTranslationTable
+ (format #f "Ctrl <Key>osfLeft: try1()~%Ctrl <Key>osfRight: try2()~%Ctrl <Key>osfUp: try1(hiho)~%Ctrl <Key>osfDown: try2(down, up)~%")))
+ (pane (add-main-pane "hiho" xmTextWidgetClass ())))
+ (XtOverrideTranslations pane tab))
+
+ (let ((XmNhiho (add-resource "hiho" 0)))
+ (if (not (string=? XmNhiho "hiho")) (snd-display #__line__ ";add-resource XmNhiho: ~A" XmNhiho)))
+
+ (open-sound "cardinal.snd")
+ (let* ((mouse_width 32)
+ (mouse_height 32)
+ (mouse_bits (list
+ #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
+ #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
+ #x80 #xff #xff #x01 #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01
+ #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01 #x80 #x00 #x01 #x01
+ #x80 #x00 #x01 #x01 #x80 #xff #xff #x01 #x80 #x00 #x00 #x01
+ #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01
+ #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00 #x00 #x01
+ #x80 #x00 #x00 #x01 #x00 #x01 #x80 #x00 #x00 #x01 #x80 #x00
+ #x00 #x06 #x60 #x00 #x00 #xf8 #x1f #x00 #x00 #x00 #x00 #x00
+ #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
+ #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00))
+ (rb (list
+ #x00 #x04 #x10 #x08 #x00 #x10 #x04 #x20 #x00 #x40 #xa5 #xbf
+ #x00 #x40 #x04 #x20 #x00 #x10 #x10 #x08 #x00 #x04 #x00 #x00))
+ (iconw ((sound-widgets) 8))
+ (dpy (XtDisplay iconw))
+ (win (XtWindow iconw)))
+ (XCreateBitmapFromData dpy win rb 16 12)
+ (XCreateBitmapFromData dpy win mouse_bits mouse_width mouse_height)
+ (XCreatePixmapFromBitmapData dpy win mouse_bits 32 32 (white-pixel) (black-pixel) 8))
+
+ (let* ((grf1 (car (channel-widgets)))
+ (dpy (XtDisplay grf1))
+ (win (XtWindow grf1))
+ (sgc (car (snd-gcs)))
+ (shell (cadr (main-widgets)))
+ (scr (DefaultScreen dpy))
+ (vis (DefaultVisual dpy scr))
+ (depth (cadr (XtGetValues grf1 (list XmNdepth 0))))
+ (pix (XCreatePixmap dpy win 10 10 depth))
+ (rotpix (XCreatePixmap dpy win 10 10 depth)))
+
+ (XDrawText dpy win sgc 50 50 (list (XTextItem "hi" 2 2 '(Font 0))
+ (XTextItem "ho" 2 3 '(Font 0))))
+
+ (let ((cmap (XCreateColormap dpy win vis AllocNone)))
+ (set! cmap (XCopyColormapAndFree dpy cmap))
+ (XFreeColormap dpy cmap)
+ (if (XCheckTypedWindowEvent dpy win ExposureMask)
+ (snd-display #__line__ ";XCheckTypedWindowEvent: ~A" (XCheckTypedWindowEvent dpy win ExposureMask)))
+ (if (XCheckTypedEvent dpy ExposureMask)
+ (snd-display #__line__ ";XCheckTypedEvent: ~A" (XCheckTypedEvent dpy ExposureMask)))
+ (XCheckWindowEvent dpy win ExposureMask)
; (if (XCheckIfEvent dpy (lambda (d e data) #f) #f)
; (snd-display #__line__ ";XCheckIfEvent: ~A" (XCheckIfEvent dpy (lambda (d e data) #f) #f)))
- (XCirculateSubwindows dpy win RaiseLowest)
- (XCirculateSubwindowsUp dpy win)
- (XCirculateSubwindowsDown dpy win)
- (let ((wc (XWindowChanges 10 10 100 100 10 win 0)))
- (if (not (= (.stack_mode wc) 0)) (snd-display #__line__ ";stack_mode wc: ~A" (.stack_mode wc)))
- (if (not (equal? (.sibling wc) win)) (snd-display #__line__ ";sibling wc: ~A" (.sibling wc)))
- (if (not (= (.x wc) 10)) (snd-display #__line__ ";x wc: ~A" (.x wc)))
- (if (not (= (.y wc) 10)) (snd-display #__line__ ";y wc: ~A" (.y wc)))
- (if (not (= (.width wc) 100)) (snd-display #__line__ ";width wc: ~A" (.width wc)))
- (if (not (= (.height wc) 100)) (snd-display #__line__ ";height wc: ~A" (.height wc)))
- (if (not (= (.border_width wc) 10)) (snd-display #__line__ ";border_width wc: ~A" (.border_width wc))))
- (if (defined? 'XpmImage)
- (let ((xp (XpmImage 10 10 0 1 0)))
- (if (not (= (.cpp xp) 0)) (snd-display #__line__ ";cpp xp: ~A" (.cpp xp)))
- (if (not (= (.ncolors xp) 1)) (snd-display #__line__ ";ncolors xp: ~A" (.ncolors xp)))))
- )
- (XmObjectAtPoint shell 100 100)
- (if (not (string=? (XmGetAtomName dpy XA_STRING) "STRING")) (snd-display #__line__ ";XmGetAtomName: ~A" (XmGetAtomName dpy XA_STRING)))
- (if (not (XmTargetsAreCompatible dpy (list XA_STRING) 1 (list XA_STRING) 1)) (snd-display #__line__ ";XmTargetsAreCompatible"))
- (XmUpdateDisplay grf1)
- (let ((lines (XmWidgetGetBaselines (list-ref (main-widgets) 4))))
- (if (not lines) (snd-display #__line__ ";XmWidgetGetBaselines?"))
- (if (< (length lines) 4) (snd-display #__line__ ";no listener text?? ~A" lines)))
- (let ((r (XmWidgetGetDisplayRect (list-ref (sound-widgets) 8))))
- (if (not (XRectangle? r)) (snd-display #__line__ ";XmWidgetGetDisplayRect: ~A" r)))
- (XDrawImageString dpy (list 'Window (cadr pix)) sgc 0 10 "hiho" 4)
- (let* ((data (XtCalloc (* 11 11 depth) 1))
- (before (XCreateImage dpy vis depth XYPixmap 0 data 10 10 8 0))
- (newimage (XGetSubImage dpy (list 'Window (cadr pix)) 0 0 10 10 AllPlanes XYPixmap before 0 0)))
- (XSubImage newimage 0 0 3 3)
- (if (not (= (.bytes_per_line newimage) 2)) (snd-display #__line__ ";bytes_per_line: ~A" (.bytes_per_line newimage)))
- (if (not (= (.byte_order newimage) 0)) (snd-display #__line__ ";byte_order: ~A" (.byte_order newimage)))
- (if (not (= (.bitmap_pad newimage) 8)) (snd-display #__line__ ";bitmap_pad: ~A" (.bitmap_pad newimage)))
- (if (not (= (.bitmap_bit_order newimage) 0)) (snd-display #__line__ ";bitmap_bit_order: ~A" (.bitmap_bit_order newimage)))
- (if (not (= (.bitmap_unit newimage) 32)) (snd-display #__line__ ";bitmap_unit: ~A" (.bitmap_unit newimage)))
+ (XCirculateSubwindows dpy win RaiseLowest)
+ (XCirculateSubwindowsUp dpy win)
+ (XCirculateSubwindowsDown dpy win)
+ (let ((wc (XWindowChanges 10 10 100 100 10 win 0)))
+ (if (not (= (.stack_mode wc) 0)) (snd-display #__line__ ";stack_mode wc: ~A" (.stack_mode wc)))
+ (if (not (equal? (.sibling wc) win)) (snd-display #__line__ ";sibling wc: ~A" (.sibling wc)))
+ (if (not (= (.x wc) 10)) (snd-display #__line__ ";x wc: ~A" (.x wc)))
+ (if (not (= (.y wc) 10)) (snd-display #__line__ ";y wc: ~A" (.y wc)))
+ (if (not (= (.width wc) 100)) (snd-display #__line__ ";width wc: ~A" (.width wc)))
+ (if (not (= (.height wc) 100)) (snd-display #__line__ ";height wc: ~A" (.height wc)))
+ (if (not (= (.border_width wc) 10)) (snd-display #__line__ ";border_width wc: ~A" (.border_width wc))))
+ (if (defined? 'XpmImage)
+ (let ((xp (XpmImage 10 10 0 1 0)))
+ (if (not (= (.cpp xp) 0)) (snd-display #__line__ ";cpp xp: ~A" (.cpp xp)))
+ (if (not (= (.ncolors xp) 1)) (snd-display #__line__ ";ncolors xp: ~A" (.ncolors xp)))))
+ )
+ (XmObjectAtPoint shell 100 100)
+ (if (not (string=? (XmGetAtomName dpy XA_STRING) "STRING")) (snd-display #__line__ ";XmGetAtomName: ~A" (XmGetAtomName dpy XA_STRING)))
+ (if (not (XmTargetsAreCompatible dpy (list XA_STRING) 1 (list XA_STRING) 1)) (snd-display #__line__ ";XmTargetsAreCompatible"))
+ (XmUpdateDisplay grf1)
+ (let ((lines (XmWidgetGetBaselines ((main-widgets) 4))))
+ (if (not lines) (snd-display #__line__ ";XmWidgetGetBaselines?"))
+ (if (< (length lines) 4) (snd-display #__line__ ";no listener text?? ~A" lines)))
+ (let ((r (XmWidgetGetDisplayRect ((sound-widgets) 8))))
+ (if (not (XRectangle? r)) (snd-display #__line__ ";XmWidgetGetDisplayRect: ~A" r)))
+ (XDrawImageString dpy (list 'Window (cadr pix)) sgc 0 10 "hiho" 4)
+ (let* ((data (XtCalloc (* 11 11 depth) 1))
+ (before (XCreateImage dpy vis depth XYPixmap 0 data 10 10 8 0))
+ (newimage (XGetSubImage dpy (list 'Window (cadr pix)) 0 0 10 10 AllPlanes XYPixmap before 0 0)))
+ (XSubImage newimage 0 0 3 3)
+ (if (not (= (.bytes_per_line newimage) 2)) (snd-display #__line__ ";bytes_per_line: ~A" (.bytes_per_line newimage)))
+ (if (not (= (.byte_order newimage) 0)) (snd-display #__line__ ";byte_order: ~A" (.byte_order newimage)))
+ (if (not (= (.bitmap_pad newimage) 8)) (snd-display #__line__ ";bitmap_pad: ~A" (.bitmap_pad newimage)))
+ (if (not (= (.bitmap_bit_order newimage) 0)) (snd-display #__line__ ";bitmap_bit_order: ~A" (.bitmap_bit_order newimage)))
+ (if (not (= (.bitmap_unit newimage) 32)) (snd-display #__line__ ";bitmap_unit: ~A" (.bitmap_unit newimage)))
; (if (not (= (.obdata newimage) 0)) (snd-display #__line__ ";obdata: ~A" (.obdata newimage)))
- (if (not (= (.xoffset newimage) 0)) (snd-display #__line__ ";xoffset: ~A" (.xoffset newimage)))
- (XPutPixel before 1 1 (basic-color))
- (XGetPixel before 1 1)
- (XPutImage dpy (list 'Window (cadr rotpix)) sgc before 0 0 0 0 10 10)
- (XAddPixel before 1)
- (if (> (.bits_per_pixel before) 123) (snd-display #__line__ ";bits_per_pixel: ~A" (.bits_per_pixel before)))
- (XmInstallImage before "before_image")
- (XmUninstallImage before)
- (if (defined? 'XpmAttributes)
- (let ((i11 (XGetImage dpy (list 'Window (cadr pix)) 0 0 10 10 AllPlanes XYPixmap))
- (attr (XpmAttributes))
- (vals (XtGetValues (cadr (main-widgets)) (list XmNcolormap 0 XmNdepth 0)))
- (sym (XpmColorSymbol "basiccolor" #f (basic-color))))
- (if (not (string=? (.name sym) "basiccolor")) (snd-display #__line__ ";.name colorsymbol: ~A" (.name sym)))
- (set! (.name sym) "hiho")
- (if (not (string=? (.name sym) "hiho")) (snd-display #__line__ ";set .name colorsymbol: ~A" (.name sym)))
- (set! (.visual attr) vis)
- (if (not (equal? vis (.visual attr))) (snd-display #__line__ ";visual xpm attr: ~A" (.visual attr)))
- (if (not (list? (.colorsymbols attr))) (snd-display #__line__ ";.colorsymbols attr: ~A" (.colorsymbols attr)))
- (set! (.colorsymbols attr) (list sym))
- (set! (.pixel sym) (basic-color))
- (set! (.numsymbols attr) 1)
- (if (not (equal? 1 (.numsymbols attr))) (snd-display #__line__ ";numsymbols xpm attr: ~A" (.numsymbols attr)))
- (set! (.depth attr) (list-ref vals 3))
- (if (not (equal? (list-ref vals 3) (.depth attr))) (snd-display #__line__ ";depth xpm attr: ~A" (.depth attr)))
- (set! (.colormap attr) (list-ref vals 1))
- (if (not (equal? (list-ref vals 1) (.colormap attr))) (snd-display #__line__ ";colormap xpm attr: ~A" (.colormap attr)))
- (set! (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual))
- (if (not (= (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual)))
- (snd-display #__line__ ";valuemask: ~A" (.valuemask attr)))
- (if (not (= (.x_hotspot attr) 0)) (snd-display #__line__ ";x_hotspot: ~A" (.x_hotspot attr)))
- (if (not (= (.y_hotspot attr) 0)) (snd-display #__line__ ";y_hotspot: ~A" (.y_hotspot attr)))
- (if (not (= (.npixels attr) 0)) (snd-display #__line__ ";npixels: ~A" (.npixels attr)))
- (let ((err (XpmCreatePixmapFromData dpy win
- (list "16 14 6 1"
- " c None s None"
- ". c gray50"
- "X c black"
- "o c white"
- "O c yellow"
- "- c ivory2 s basiccolor"
- "------.XXX.-----"
- "-----X.ooo.X----"
- "----..oXXXo..---"
- "----XoX...XoX---"
- "----XoX.--XoX.--"
- "----XoX.--XoX.--"
- "---XXXXXXXXXXX--"
- "---XOOOOOOOOOX.-"
- "---XO.......OX.-"
- "---XOOOOOOOOOX.-"
- "---XO.......OX.-"
- "---XOOOOOOOOOX.-"
- "---XXXXXXXXXXX.-"
- "----...........-")
- attr)))
- (if (or (not (= (car err) XpmSuccess))
- (not (Pixmap? (cadr err))))
- (snd-display #__line__ ";XpmCreatePixmapFromData: ~A" err)))
-
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (button (XmCreatePushButton shell "button" '()))
- (status-and-whatnot (XpmReadFileToPixmap dpy (XRootWindowOfScreen (XtScreen shell)) "bullet.xpm" #f))
- (status (car status-and-whatnot))
- (pixmap (cadr status-and-whatnot))
- (pixmap1 (caddr status-and-whatnot)))
- (if (not (string=? (XpmGetErrorString XpmSuccess) "XpmSuccess"))
- (snd-display #__line__ ";XpmGetErrorString: ~A" (XpmGetErrorString XpmSuccess)))
- (if (not (= status XpmSuccess))
- (snd-display #__line__ "; XpmError ReadFileToPixmap: ~A" (XpmGetErrorString status)))
- (XtVaSetValues button (list XmNlabelType XmPIXMAP
- XmNlabelPixmap pixmap))
- (XpmWriteFileFromPixmap dpy "test.xpm" pixmap pixmap1 #f)
- (XpmCreateDataFromPixmap dpy pixmap pixmap1 #f)
- (let* ((status (XpmReadFileToXpmImage "bullet.xpm"))
- (symb (XpmColorSymbol "Foreground" "green" (basic-color)))
- (attr (XpmAttributes)))
- (if (not (XpmImage? status))
- (snd-display #__line__ "; XpmError ReadFileToXpmImage: ~A" (XpmGetErrorString status)))
- (set! (.valuemask attr) XpmColorSymbols)
- (XpmCreatePixmapFromXpmImage dpy (XRootWindowOfScreen (XtScreen shell)) status attr)
- (XpmCreateXpmImageFromPixmap dpy pixmap pixmap1 attr)
- (for-each
- (lambda (func val name)
- (set! (func attr) val)
- (if (not (equal? (func attr) val)) (snd-display #__line__ ";attr ~A ~A" name (func attr))))
- (list .valuemask .depth .width .x_hotspot .y_hotspot .cpp .npixels .ncolors)
- (list 0 0 0 0 0 0 0 0)
- (list 'valuemask 'depth 'width 'x_hotspot 'y_hotspot 'cpp 'npixels 'ncolors)))
- )
- (XDestroyImage i11)))
-
- (XDestroyImage before)
- (XFreePixmap dpy pix)
- (XVisualIDFromVisual vis)
- (XGrabServer dpy)
- (XUngrabServer dpy)
- (XGrabPointer dpy win #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None) (list 'Time CurrentTime))
- (XUngrabPointer dpy (list 'Time CurrentTime))
- (XGrabKeyboard dpy win #t GrabModeSync GrabModeSync (list 'Time CurrentTime))
- (XUngrabKeyboard dpy (list 'Time CurrentTime))
- (XGrabKey dpy AnyKey AnyModifier win #t GrabModeSync GrabModeSync)
- (XUngrabKey dpy AnyKey AnyModifier win)
- (XGrabButton dpy AnyButton AnyModifier win #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None))
- (XUngrabButton dpy AnyButton AnyModifier win)
- (XtGrabPointer shell #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None) (list 'Time CurrentTime))
- (XtUngrabPointer shell (list 'Time CurrentTime))
- (XtGrabKeyboard shell #t GrabModeSync GrabModeSync (list 'Time CurrentTime))
- (XtUngrabKeyboard shell (list 'Time CurrentTime))
- (XtGrabKey shell (list 'KeyCode AnyKey) AnyModifier #t GrabModeSync GrabModeSync)
- (XtUngrabKey shell (list 'KeyCode AnyKey) AnyModifier)
- (XtGrabButton shell AnyButton AnyModifier #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None))
- (XtUngrabButton shell AnyButton AnyModifier)
- ))
-
- (let* ((sgc (car (snd-gcs)))
- (grf1 (car (channel-widgets)))
- (dpy (XtDisplay grf1))
- (win (XtWindow grf1))
- (shl (cadr (main-widgets))))
- (let ((wid (XtWindowToWidget dpy win)))
- (if (not (equal? wid grf1))
- (snd-display #__line__ ";XtWindowToWidget: ~A ~A" grf1 win)))
+ (if (not (= (.xoffset newimage) 0)) (snd-display #__line__ ";xoffset: ~A" (.xoffset newimage)))
+ (XPutPixel before 1 1 *basic-color*)
+ (XGetPixel before 1 1)
+ (XPutImage dpy (list 'Window (cadr rotpix)) sgc before 0 0 0 0 10 10)
+ (XAddPixel before 1)
+ (if (> (.bits_per_pixel before) 123) (snd-display #__line__ ";bits_per_pixel: ~A" (.bits_per_pixel before)))
+ (XmInstallImage before "before_image")
+ (XmUninstallImage before)
+ (if (defined? 'XpmAttributes)
+ (let ((i11 (XGetImage dpy (list 'Window (cadr pix)) 0 0 10 10 AllPlanes XYPixmap))
+ (attr (XpmAttributes))
+ (vals (XtGetValues (cadr (main-widgets)) (list XmNcolormap 0 XmNdepth 0)))
+ (sym (XpmColorSymbol "basiccolor" #f *basic-color*)))
+ (if (not (string=? (.name sym) "basiccolor")) (snd-display #__line__ ";.name colorsymbol: ~A" (.name sym)))
+ (set! (.name sym) "hiho")
+ (if (not (string=? (.name sym) "hiho")) (snd-display #__line__ ";set .name colorsymbol: ~A" (.name sym)))
+ (set! (.visual attr) vis)
+ (if (not (equal? vis (.visual attr))) (snd-display #__line__ ";visual xpm attr: ~A" (.visual attr)))
+ (if (not (list? (.colorsymbols attr))) (snd-display #__line__ ";.colorsymbols attr: ~A" (.colorsymbols attr)))
+ (set! (.colorsymbols attr) (list sym))
+ (set! (.pixel sym) *basic-color*)
+ (set! (.numsymbols attr) 1)
+ (if (not (eqv? 1 (.numsymbols attr))) (snd-display #__line__ ";numsymbols xpm attr: ~A" (.numsymbols attr)))
+ (set! (.depth attr) (vals 3))
+ (if (not (equal? (vals 3) (.depth attr))) (snd-display #__line__ ";depth xpm attr: ~A" (.depth attr)))
+ (set! (.colormap attr) (vals 1))
+ (if (not (equal? (vals 1) (.colormap attr))) (snd-display #__line__ ";colormap xpm attr: ~A" (.colormap attr)))
+ (set! (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual))
+ (if (not (= (.valuemask attr) (logior XpmColorSymbols XpmDepth XpmColormap XpmVisual)))
+ (snd-display #__line__ ";valuemask: ~A" (.valuemask attr)))
+ (if (not (= (.x_hotspot attr) 0)) (snd-display #__line__ ";x_hotspot: ~A" (.x_hotspot attr)))
+ (if (not (= (.y_hotspot attr) 0)) (snd-display #__line__ ";y_hotspot: ~A" (.y_hotspot attr)))
+ (if (not (= (.npixels attr) 0)) (snd-display #__line__ ";npixels: ~A" (.npixels attr)))
+ (let ((err (XpmCreatePixmapFromData dpy win
+ (list "16 14 6 1"
+ " c None s None"
+ ". c gray50"
+ "X c black"
+ "o c white"
+ "O c yellow"
+ "- c ivory2 s basiccolor"
+ "------.XXX.-----"
+ "-----X.ooo.X----"
+ "----..oXXXo..---"
+ "----XoX...XoX---"
+ "----XoX.--XoX.--"
+ "----XoX.--XoX.--"
+ "---XXXXXXXXXXX--"
+ "---XOOOOOOOOOX.-"
+ "---XO.......OX.-"
+ "---XOOOOOOOOOX.-"
+ "---XO.......OX.-"
+ "---XOOOOOOOOOX.-"
+ "---XXXXXXXXXXX.-"
+ "----...........-")
+ attr)))
+ (if (or (not (= (car err) XpmSuccess))
+ (not (Pixmap? (cadr err))))
+ (snd-display #__line__ ";XpmCreatePixmapFromData: ~A" err)))
+
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell))
+ (button (XmCreatePushButton shell "button" ()))
+ (status-and-whatnot (XpmReadFileToPixmap dpy (XRootWindowOfScreen (XtScreen shell)) "bullet.xpm" #f))
+ (status (car status-and-whatnot))
+ (pixmap (cadr status-and-whatnot))
+ (pixmap1 (caddr status-and-whatnot)))
+ (if (not (string=? (XpmGetErrorString XpmSuccess) "XpmSuccess"))
+ (snd-display #__line__ ";XpmGetErrorString: ~A" (XpmGetErrorString XpmSuccess)))
+ (if (not (= status XpmSuccess))
+ (snd-display #__line__ "; XpmError ReadFileToPixmap: ~A" (XpmGetErrorString status)))
+ (XtVaSetValues button (list XmNlabelType XmPIXMAP
+ XmNlabelPixmap pixmap))
+ (XpmWriteFileFromPixmap dpy "test.xpm" pixmap pixmap1 #f)
+ (XpmCreateDataFromPixmap dpy pixmap pixmap1 #f)
+ (let ((status (XpmReadFileToXpmImage "bullet.xpm"))
+ (symb (XpmColorSymbol "Foreground" "green" *basic-color*))
+ (attr (XpmAttributes)))
+ (if (not (XpmImage? status))
+ (snd-display #__line__ "; XpmError ReadFileToXpmImage: ~A ~A" symb (XpmGetErrorString status)))
+ (set! (.valuemask attr) XpmColorSymbols)
+ (XpmCreatePixmapFromXpmImage dpy (XRootWindowOfScreen (XtScreen shell)) status attr)
+ (XpmCreateXpmImageFromPixmap dpy pixmap pixmap1 attr)
+ (for-each
+ (lambda (func val name)
+ (set! (func attr) val)
+ (if (not (equal? (func attr) val)) (snd-display #__line__ ";attr ~A ~A" name (func attr))))
+ (list .valuemask .depth .width .x_hotspot .y_hotspot .cpp .npixels .ncolors)
+ (list 0 0 0 0 0 0 0 0)
+ (list 'valuemask 'depth 'width 'x_hotspot 'y_hotspot 'cpp 'npixels 'ncolors)))
+ )
+ (XDestroyImage i11)))
+
+ (XDestroyImage before)
+ (XFreePixmap dpy pix)
+ (XVisualIDFromVisual vis)
+ (XGrabServer dpy)
+ (XUngrabServer dpy)
+ (XGrabPointer dpy win #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None) (list 'Time CurrentTime))
+ (XUngrabPointer dpy (list 'Time CurrentTime))
+ (XGrabKeyboard dpy win #t GrabModeSync GrabModeSync (list 'Time CurrentTime))
+ (XUngrabKeyboard dpy (list 'Time CurrentTime))
+ (XGrabKey dpy AnyKey AnyModifier win #t GrabModeSync GrabModeSync)
+ (XUngrabKey dpy AnyKey AnyModifier win)
+ (XGrabButton dpy AnyButton AnyModifier win #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None))
+ (XUngrabButton dpy AnyButton AnyModifier win)
+ (XtGrabPointer shell #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None) (list 'Time CurrentTime))
+ (XtUngrabPointer shell (list 'Time CurrentTime))
+ (XtGrabKeyboard shell #t GrabModeSync GrabModeSync (list 'Time CurrentTime))
+ (XtUngrabKeyboard shell (list 'Time CurrentTime))
+ (XtGrabKey shell (list 'KeyCode AnyKey) AnyModifier #t GrabModeSync GrabModeSync)
+ (XtUngrabKey shell (list 'KeyCode AnyKey) AnyModifier)
+ (XtGrabButton shell AnyButton AnyModifier #t ButtonPressMask GrabModeSync GrabModeSync (list 'Window None) (list 'Cursor None))
+ (XtUngrabButton shell AnyButton AnyModifier)
+ ))
+
+ (let* ((sgc (car (snd-gcs)))
+ (grf1 (car (channel-widgets)))
+ (dpy (XtDisplay grf1))
+ (win (XtWindow grf1))
+ (shl (cadr (main-widgets))))
+ (let ((wid (XtWindowToWidget dpy win)))
+ (if (not (equal? wid grf1))
+ (snd-display #__line__ ";XtWindowToWidget: ~A ~A" grf1 win)))
; these are causing: X Error of failed request: BadAccess (attempt to access private resource denied)
; (if (not (equal? (XGetTransientForHint dpy win) (list 0 #f)))
; (snd-display #__line__ ";XGetTransientForHint: ~A" (XGetTransientForHint dpy win)))
- (if (not (equal? (XGetErrorText dpy BadColor #f 9) (list 0 "BadColor")))
- (snd-display #__line__ ";XGetErrorText: ~A" (XGetErrorText dpy BadColor #f 9)))
- (if (not (equal? (XGeometry dpy 0 "500x400" "500x400+10+10" 4 7 14 2 2) (list 12 10 10 500 400)))
- (snd-display #__line__ ";XGeometry: ~A" (XGeometry dpy 0 "500x400" "500x400+10+10" 4 7 14 2 2)))
- (if (< (XEventsQueued dpy QueuedAlready) 0)
- (snd-display #__line__ ";XEventsQueued: ~A" (XEventsQueued dpy QueuedAlready)))
+ (if (not (equal? (XGetErrorText dpy BadColor #f 9) (list 0 "BadColor")))
+ (snd-display #__line__ ";XGetErrorText: ~A" (XGetErrorText dpy BadColor #f 9)))
+ (if (not (equal? (XGeometry dpy 0 "500x400" "500x400+10+10" 4 7 14 2 2) (list 12 10 10 500 400)))
+ (snd-display #__line__ ";XGeometry: ~A" (XGeometry dpy 0 "500x400" "500x400+10+10" 4 7 14 2 2)))
+ (if (< (XEventsQueued dpy QueuedAlready) 0)
+ (snd-display #__line__ ";XEventsQueued: ~A" (XEventsQueued dpy QueuedAlready)))
; (let ((coords (XTranslateCoordinates dpy (XtWindow shl) win 10 10)))
; (if (not (car coords))
; (snd-display #__line__ ";XTranslateCoordinates: ~A" coords)))
- (let ((coords (XtTranslateCoords shl 10 10)))
- (if (not (number? (car coords)))
- (snd-display #__line__ ";XtTranslateCoords: ~A" coords)))
- (if (not (XmIsVendorShell shl)) (snd-display #__line__ ";XmIsVendorShell?"))
- (if (XmIsPrimitive shl) (snd-display #__line__ ";XmIsPrimitive?"))
- (if (XmIsManager shl) (snd-display #__line__ ";XmIsManager?"))
- (if (XmIsIconGadget shl) (snd-display #__line__ ";XmIsIconGadget?"))
- (if (XmIsGadget shl) (snd-display #__line__ ";XmIsGadget?"))
- (if (XmIsIconHeader shl) (snd-display #__line__ ";XmIsHeader?"))
- (if (XmIsDropTransfer shl) (snd-display #__line__ ";XmIsDropTransfer?"))
- (if (XmIsDropSiteManager shl) (snd-display #__line__ ";XmIsDropSiteManager?"))
- (if (XmIsDragContext shl) (snd-display #__line__ ";XmIsDragContext?"))
- (if (XmIsDragIconObjectClass shl) (snd-display #__line__ ";XmIsDragIconObjectClass?"))
- (if (XmIsMessageBox shl) (snd-display #__line__ ";XmIsMessageBox?"))
- (if (XmIsScreen shl) (snd-display #__line__ ";XmIsScreen?"))
- (if (XmIsDisplay shl) (snd-display #__line__ ";XmIsDisplay?"))
-
- (let ((val 0))
- (XSetErrorHandler (lambda (dpy e)
- (set! val (.error_code e))))
- (XGetAtomName dpy '(Atom 0))
- (if (not (= val 5)) (snd-display #__line__ ";XSetErrorHandler: ~A" val)))
-
- (XDrawImageString dpy win sgc 10 10 "hiho" 4)
- (XDrawRectangle dpy win sgc 0 0 10 10)
- (XDrawString dpy win sgc 10 10 "hi" 2)
- (XDrawSegments dpy win sgc (list (XSegment 1 1 2 20) (XSegment 3 3 40 4)) 2)
- (XDrawRectangles dpy win sgc (list (XRectangle 0 0 10 10) (XRectangle 20 20 30 30)) 2)
- (XFillRectangles dpy win sgc (list (XRectangle 0 0 10 10) (XRectangle 20 20 30 30)) 2)
- (XDrawRectangle dpy win sgc 10 10 10 10)
- (XFillRectangle dpy win sgc 10 10 10 10)
- (XDrawPoints dpy win sgc (list (XPoint 23 23) (XPoint 109 10)) 2 CoordModeOrigin)
- (XDrawPoint dpy win sgc 10 10)
- (XDrawLines dpy win sgc (list (XPoint 23 23) (XPoint 109 10)) 2 CoordModeOrigin)
- (XDrawLine dpy win sgc 10 10 20 20)
- (XDrawArcs dpy win sgc (list (XArc 10 10 4 4 0 360) (XArc 20 20 1 23 0 123)) 2)
- (XFillArcs dpy win sgc (list (XArc 10 10 4 4 0 360) (XArc 20 20 1 23 0 123)) 2)
- (XDrawArc dpy win sgc 0 0 10 10 45 90)
- (XFillArc dpy win sgc 0 0 10 10 45 90)
- (XFillPolygon dpy win sgc (list (XPoint 0 0) (XPoint 0 10) (XPoint 10 10) (XPoint 10 0) (XPoint 0 0)) 5 Convex CoordModeOrigin)
- (XClearArea dpy win 10 10 20 20 #f)
- (XClearWindow dpy win))
-
- (close-sound)
-
- (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
- (val1 0))
- (define (call1 w c i)
- (set! val1 (+ 1 val1)))
- (let ((descr (XtAddCallback button XmNactivateCallback call1 #f)))
- (XtCallCallbacks button XmNactivateCallback #f)
- (if (not (= val1 1))
- (snd-display #__line__ ";XtCallCallbacks val1: ~A" val1))
- (XtRemoveCallback button XmNactivateCallback descr)
- (let ((calls (XtHasCallbacks button XmNactivateCallback)))
- (if (not (= calls XtCallbackHasNone))
- (snd-display #__line__ ";XtRemoveCallbacks: ~A" calls))))
- (XtUnmanageChild button)
+ (let ((coords (XtTranslateCoords shl 10 10)))
+ (if (not (number? (car coords)))
+ (snd-display #__line__ ";XtTranslateCoords: ~A" coords)))
+ (if (not (XmIsVendorShell shl)) (snd-display #__line__ ";XmIsVendorShell?"))
+ (if (XmIsPrimitive shl) (snd-display #__line__ ";XmIsPrimitive?"))
+ (if (XmIsManager shl) (snd-display #__line__ ";XmIsManager?"))
+ (if (XmIsIconGadget shl) (snd-display #__line__ ";XmIsIconGadget?"))
+ (if (XmIsGadget shl) (snd-display #__line__ ";XmIsGadget?"))
+ (if (XmIsIconHeader shl) (snd-display #__line__ ";XmIsHeader?"))
+ (if (XmIsDropTransfer shl) (snd-display #__line__ ";XmIsDropTransfer?"))
+ (if (XmIsDropSiteManager shl) (snd-display #__line__ ";XmIsDropSiteManager?"))
+ (if (XmIsDragContext shl) (snd-display #__line__ ";XmIsDragContext?"))
+ (if (XmIsDragIconObjectClass shl) (snd-display #__line__ ";XmIsDragIconObjectClass?"))
+ (if (XmIsMessageBox shl) (snd-display #__line__ ";XmIsMessageBox?"))
+ (if (XmIsScreen shl) (snd-display #__line__ ";XmIsScreen?"))
+ (if (XmIsDisplay shl) (snd-display #__line__ ";XmIsDisplay?"))
+
+ (let ((val 0))
+ (XSetErrorHandler (lambda (dpy e)
+ (set! val (.error_code e))))
+ (XGetAtomName dpy '(Atom 0))
+ (if (not (= val 5)) (snd-display #__line__ ";XSetErrorHandler: ~A" val)))
+
+ (XDrawImageString dpy win sgc 10 10 "hiho" 4)
+ (XDrawRectangle dpy win sgc 0 0 10 10)
+ (XDrawString dpy win sgc 10 10 "hi" 2)
+ (XDrawSegments dpy win sgc (list (XSegment 1 1 2 20) (XSegment 3 3 40 4)) 2)
+ (XDrawRectangles dpy win sgc (list (XRectangle 0 0 10 10) (XRectangle 20 20 30 30)) 2)
+ (XFillRectangles dpy win sgc (list (XRectangle 0 0 10 10) (XRectangle 20 20 30 30)) 2)
+ (XDrawRectangle dpy win sgc 10 10 10 10)
+ (XFillRectangle dpy win sgc 10 10 10 10)
+ (XDrawPoints dpy win sgc (list (XPoint 23 23) (XPoint 109 10)) 2 CoordModeOrigin)
+ (XDrawPoint dpy win sgc 10 10)
+ (XDrawLines dpy win sgc (list (XPoint 23 23) (XPoint 109 10)) 2 CoordModeOrigin)
+ (XDrawLine dpy win sgc 10 10 20 20)
+ (XDrawArcs dpy win sgc (list (XArc 10 10 4 4 0 360) (XArc 20 20 1 23 0 123)) 2)
+ (XFillArcs dpy win sgc (list (XArc 10 10 4 4 0 360) (XArc 20 20 1 23 0 123)) 2)
+ (XDrawArc dpy win sgc 0 0 10 10 45 90)
+ (XFillArc dpy win sgc 0 0 10 10 45 90)
+ (XFillPolygon dpy win sgc (list (XPoint 0 0) (XPoint 0 10) (XPoint 10 10) (XPoint 10 0) (XPoint 0 0)) 5 Convex CoordModeOrigin)
+ (XClearArea dpy win 10 10 20 20 #f)
+ (XClearWindow dpy win))
+
+ (close-sound)
+
+ (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) () 0))
+ (val1 0))
+ (define (call1 w c i)
+ (set! val1 (+ 1 val1)))
+ (let ((descr (XtAddCallback button XmNactivateCallback call1 #f)))
+ (XtCallCallbacks button XmNactivateCallback #f)
+ (if (not (= val1 1))
+ (snd-display #__line__ ";XtCallCallbacks val1: ~A" val1))
+ (XtRemoveCallback button XmNactivateCallback descr)
+ (let ((calls (XtHasCallbacks button XmNactivateCallback)))
+ (if (not (= calls XtCallbackHasNone))
+ (snd-display #__line__ ";XtRemoveCallbacks: ~A" calls))))
+ (XtUnmanageChild button)
;(XtDestroyWidget button)
- )
-
- (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
- (val1 0)
- (val2 0))
- (define (call1 w c i)
- (set! val1 (+ 1 val1)))
- (define (call2 w c i)
- (set! val2 (+ 1 val2)))
- (let ((descr1 (XtAddCallback button XmNactivateCallback call1 #f))
- (descr2 (XtAddCallback button XmNactivateCallback call2 #f)))
- (XtCallCallbacks button XmNactivateCallback #f)
- (if (and (not (= val1 1)) (not (= val2 1)))
- (snd-display #__line__ ";XtCallCallbacks val12: ~A ~A" val1 val2))
- (XtRemoveCallbacks button XmNactivateCallback (list descr1 descr2))
- (let ((calls (XtHasCallbacks button XmNactivateCallback)))
- (if (not (= calls XtCallbackHasNone))
- (snd-display #__line__ ";XtRemoveCallbacks: ~A" calls))))
- (XtUnmanageChild button)
+ )
+
+ (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) () 0))
+ (val1 0)
+ (val2 0))
+ (define (call1 w c i)
+ (set! val1 (+ 1 val1)))
+ (define (call2 w c i)
+ (set! val2 (+ 1 val2)))
+ (let ((descr1 (XtAddCallback button XmNactivateCallback call1 #f))
+ (descr2 (XtAddCallback button XmNactivateCallback call2 #f)))
+ (XtCallCallbacks button XmNactivateCallback #f)
+ (if (and (not (= val1 1)) (not (= val2 1)))
+ (snd-display #__line__ ";XtCallCallbacks val12: ~A ~A" val1 val2))
+ (XtRemoveCallbacks button XmNactivateCallback (list descr1 descr2))
+ (let ((calls (XtHasCallbacks button XmNactivateCallback)))
+ (if (not (= calls XtCallbackHasNone))
+ (snd-display #__line__ ";XtRemoveCallbacks: ~A" calls))))
+ (XtUnmanageChild button)
;(XtDestroyWidget button)
- )
-
- (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) '() 0))
- (val1 0)
- (val2 0))
- (define (call1 w c i)
- (set! val1 (+ 1 val1)))
- (define (call2 w c i)
- (set! val2 (+ 1 val2)))
- (let ((descrs (XtAddCallbacks button XmNactivateCallback (list (list call1 #f) (list call2 #f)))))
- (XtCallCallbacks button XmNactivateCallback #f)
- (if (and (not (= val1 1)) (not (= val2 1)))
- (snd-display #__line__ ";XtCallCallbacks add val12: ~A ~A" val1 val2))
- (XtRemoveCallbacks button XmNactivateCallback descrs)
- (let ((calls (XtHasCallbacks button XmNactivateCallback)))
- (if (not (= calls XtCallbackHasNone))
- (snd-display #__line__ ";XtRemoveCallbacks (add): ~A" calls))))
- (XtUnmanageChild button)
+ )
+
+ (let ((button (XtCreateManagedWidget "button" xmPushButtonWidgetClass (cadr (main-widgets)) () 0))
+ (val1 0)
+ (val2 0))
+ (define (call1 w c i)
+ (set! val1 (+ 1 val1)))
+ (define (call2 w c i)
+ (set! val2 (+ 1 val2)))
+ (let ((descrs (XtAddCallbacks button XmNactivateCallback (list (list call1 #f) (list call2 #f)))))
+ (XtCallCallbacks button XmNactivateCallback #f)
+ (if (and (not (= val1 1)) (not (= val2 1)))
+ (snd-display #__line__ ";XtCallCallbacks add val12: ~A ~A" val1 val2))
+ (XtRemoveCallbacks button XmNactivateCallback descrs)
+ (let ((calls (XtHasCallbacks button XmNactivateCallback)))
+ (if (not (= calls XtCallbackHasNone))
+ (snd-display #__line__ ";XtRemoveCallbacks (add): ~A" calls))))
+ (XtUnmanageChild button)
;(XtDestroyWidget button)
- )
-
- (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
- (browsed 0)
- (lst (XtCreateManagedWidget "lst" xmListWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNautomaticSelection XmNO_AUTO_SELECT
- XmNdoubleClickInterval 100
- XmNitemCount 3
- XmNitems (list (XmStringCreate "one" XmFONTLIST_DEFAULT_TAG)
- (XmStringCreate "two" XmFONTLIST_DEFAULT_TAG)
- (XmStringCreate "three" XmFONTLIST_DEFAULT_TAG))
- XmNlistMarginHeight 4
- XmNlistMarginWidth 1
- XmNlistSizePolicy XmVARIABLE
- XmNlistSpacing 2
- XmNmatchBehavior XmQUICK_NAVIGATE
- XmNprimaryOwnership XmOWN_NEVER
- XmNscrollBarDisplayPolicy XmAS_NEEDED
- XmNselectColor (basic-color)
- XmNselectedPositions (list 0 1)
- XmNselectionMode XmNORMAL_MODE
- XmNselectionPolicy XmBROWSE_SELECT))))
- (XtAddCallback lst XmNbrowseSelectionCallback (lambda (w c i) (set! browsed 123)))
- (let ((vals (XtVaGetValues lst
- (list XmNautomaticSelection 0 XmNdoubleClickInterval 0 XmNitemCount 0 XmNitems 0 XmNlistMarginHeight 0
- XmNlistMarginWidth 0 XmNlistSizePolicy 0 XmNlistSpacing 0 XmNmatchBehavior 0
- XmNprimaryOwnership 0 XmNscrollBarDisplayPolicy 0 XmNselectColor 0 XmNselectionMode 0
- XmNselectionPolicy 0 XmNhorizontalScrollBar 0 XmNselectedItemCount 0 XmNtopItemPosition 0))))
- (if (not (= (list-ref vals 1) XmNO_AUTO_SELECT)) (snd-display #__line__ ";XmNautomaticSelection: ~A" (list-ref vals 1)))
- (if (not (= (list-ref vals 3) 100)) (snd-display #__line__ ";XmNdoubleClickInterval: ~A" (list-ref vals 3)))
- (if (not (= (list-ref vals 5) 3)) (snd-display #__line__ ";XmNitemCount: ~A" (list-ref vals 5)))
- (if (or (null? (list-ref vals 7)) (not (XmString? (car (list-ref vals 7))))) (snd-display #__line__ ";XmNitems: ~A" (list-ref vals 7)))
- (if (not (= (list-ref vals 9) 4)) (snd-display #__line__ ";XmNlistMarginHeight: ~A" (list-ref vals 9)))
- (if (not (= (list-ref vals 11) 1)) (snd-display #__line__ ";XmNlistMarginWidth: ~A" (list-ref vals 11)))
- (if (not (= (list-ref vals 13) XmVARIABLE)) (snd-display #__line__ ";XmNlistSizePolicy: ~A" (list-ref vals 13)))
- (if (not (= (list-ref vals 15) 2)) (snd-display #__line__ ";XmNlistSpacing: ~A" (list-ref vals 15)))
- (if (not (= (list-ref vals 17) XmQUICK_NAVIGATE)) (snd-display #__line__ ";XmNmatchBehavior: ~A" (list-ref vals 17)))
- (if (not (= (list-ref vals 19) XmOWN_NEVER)) (snd-display #__line__ ";XmNprimaryOwnership : ~A" (list-ref vals 19)))
- (if (not (= (list-ref vals 21) XmAS_NEEDED)) (snd-display #__line__ ";XmNscrollBarDisplayPolicy: ~A" (list-ref vals 21)))
- (if (not (Pixel? (list-ref vals 23))) (snd-display #__line__ ";XmNselectColor: ~A" (list-ref vals 23)))
- (if (not (= (list-ref vals 25) XmNORMAL_MODE)) (snd-display #__line__ ";XmNselectionMode: ~A" (list-ref vals 25)))
- (if (not (= (list-ref vals 27) XmBROWSE_SELECT)) (snd-display #__line__ ";XmNselectionPolicy: ~A" (list-ref vals 27)))
- (if (list-ref vals 29) (snd-display #__line__ ";XmNhorizontalScrollBar: ~A" (list-ref vals 29)))
- (if (not (= (list-ref vals 31) 0)) (snd-display #__line__ ";XmNselectedItemCount : ~A" (list-ref vals 31)))
- (if (not (= (list-ref vals 33) 1)) (snd-display #__line__ ";XmNtopItemPosition: ~A" (list-ref vals 33)))
-
- (let ((tag (catch #t
- (lambda ()
- (XmListAddItem frm (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG) 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";list type check: ~A" tag)))
-
- (XmListAddItem lst (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG) 0) ; 0 -> last position
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 4)) (snd-display #__line__ ";XmAddItem len: ~A" (list-ref vals 1)))
- (XmListAddItems lst (list (XmStringCreateLocalized "five") (XmStringCreateLocalized "six")) 2 0)
- (let ((tag (catch #t
- (lambda () (XmListAddItems lst (list (XmStringCreateLocalized "seven") 123) 2 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";xstrings->list add: ~A" tag)))
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 6)) (snd-display #__line__ ";XmAddItems len: ~A" (list-ref vals 1)))
-
- (XmListDeletePos lst 1)
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 5)) (snd-display #__line__ ";XmListDeletePos len: ~A" (list-ref vals 1)))
- (XmListDeletePositions lst (list 2 4))
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 3)) (snd-display #__line__ ";XmListDeletePositions len: ~A" (list-ref vals 1)))
-
- (XmListAddItemUnselected lst (XmStringCreate "seven" XmFONTLIST_DEFAULT_TAG) 0) ; 0 -> last position
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 4)) (snd-display #__line__ ";XmListAddItemUnselected len: ~A" (list-ref vals 1)))
- (XmListAddItemsUnselected lst (list (XmStringCreateLocalized "eight") (XmStringCreateLocalized "nine")) 2 0)
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 6)) (snd-display #__line__ ";XmListAddItemsUnselected len: ~A" (list-ref vals 1)))
-
- (XmListDeleteAllItems lst)
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 0)) (snd-display #__line__ ";XmListDeleteAllItems len: ~A" (list-ref vals 1)))
- (if (not (null? (list-ref vals 3)))
- (snd-display #__line__ ";deleted all items: ~A" (list-ref vals 3)))
-
- (let ((item1 (XmStringCreate "one" XmFONTLIST_DEFAULT_TAG))
- (item2 (XmStringCreate "two" XmFONTLIST_DEFAULT_TAG))
- (item3 (XmStringCreate "three" XmFONTLIST_DEFAULT_TAG))
- (item4 (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG))
- (item5 (XmStringCreate "five" XmFONTLIST_DEFAULT_TAG)))
- (XtVaSetValues lst
- (list XmNitemCount 5
- XmNitems (list item1 item2 item3 item4 item5)))
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 5)) (snd-display #__line__ ";Xt set items len: ~A" (list-ref vals 1)))
-
- (XmListSelectItem lst item3 #t)
- (if (not (= browsed 123)) (snd-display #__line__ ";XmListSelectItem callback: ~A" browsed))
- (if (XmListPosSelected lst 1) (snd-display #__line__ ";XmList selected pos 1?"))
- (if (not (XmListPosSelected lst 3)) (snd-display #__line__ ";XmList didn't select pos 3?"))
- (set! vals (XtVaGetValues lst (list XmNselectedItemCount 0 XmNselectedItems 0)))
- (if (not (= (list-ref vals 1) 1)) (snd-display #__line__ ";selected count: ~A" (list-ref vals 1)))
- (set! vals (XmListGetSelectedPos lst))
- (if (not (= (length vals) 1)) (snd-display #__line__ ";XmListGetSelectedPos: ~A" vals))
- (if (not (= (car vals) 3)) (snd-display #__line__ ";XmListGetSelectedPos: ~A" vals))
- (set! browsed 0)
- (XmListSelectPos lst 1 #f)
- (if (not (= browsed 0)) (snd-display #__line__ ";XmListSelectPos callback: ~A" browsed))
- (if (not (XmListPosSelected lst 1)) (snd-display #__line__ ";XmList select pos?"))
- (if (not (= (XmListItemPos lst item3) 3)) (snd-display #__line__ ";XmListItemPos: ~A" (XmListItemPos lst item3)))
- (if (not (= (car (XmListGetMatchPos lst item3)) 3)) (snd-display #__line__ ";XmListGetMatchPos: ~A" (XmListGetMatchPos lst item3)))
- (if (not (XmListItemExists lst item3)) (snd-display #__line__ ";XmListItemExists?"))
-
- (if (not (= (XmListYToPos lst 40) 2)) (snd-display #__line__ ";XmListYToPos: ~A" (XmListYToPos lst 40)))
- (let ((box (XmListPosToBounds lst 2)))
- (if (and (not (= (cadr box) 3))
- (not (= (cadr box) 2)))
- (snd-display #__line__ ";XmListPosToBounds: ~A" box)))
- (XmListDeselectPos lst 1)
- (if (XmListPosSelected lst 1) (snd-display #__line__ ";XmList deselected pos?"))
- (XmListSelectItem lst item3 #t)
- (XmListDeselectAllItems lst)
- (if (XmListPosSelected lst 3) (snd-display #__line__ ";XmList deselect all pos?"))
- (XmListSelectItem lst item3 #f)
- (XmListDeselectItem lst item3)
- (if (XmListPosSelected lst 3) (snd-display #__line__ ";XmList deselect item?"))
-
- (XmListDeleteItem lst item2)
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 4)) (snd-display #__line__ ";XmDeleteItem len: ~A" (list-ref vals 1)))
- (XmListDeleteItems lst (list item1 item4))
- (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
- (if (not (= (list-ref vals 1) 2)) (snd-display #__line__ ";XmDeleteItems len: ~A" (list-ref vals 1)))
- (XmListDeleteAllItems lst)
- (XtVaSetValues lst
- (list XmNitemCount 5
- XmNitems (list item1 item2 item3 item4 item5)))
-
- (XtUnmanageChild frm))))
-
- (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
- (current-time (list 'Time CurrentTime))
- (calls (make-vector 10 "none"))
- (txt (XtCreateManagedWidget "text" xmTextWidgetClass frm
- (list XmNeditable #t
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE
- XmNdestinationCallback
- (list (lambda (w c i)
- (vector-set! calls c "dest")
- (if (< (.location_data i) 0) (snd-display #__line__ ";location_data: A~" (.location_data i))))
- 1)
- XmNactivateCallback (list (lambda (w c i) (vector-set! calls c "act")) 2)
- XmNfocusCallback (list (lambda (w c i) (vector-set! calls c "focus")) 3)
- XmNlosingFocusCallback (list (lambda (w c i) (vector-set! calls c "losingfocus")) 4)
- XmNgainPrimaryCallback (list (lambda (w c i) (vector-set! calls c "gain")) 5)
- XmNlosePrimaryCallback (list (lambda (w c i) (vector-set! calls c "lose")) 6)
- XmNmodifyVerifyCallback
- (list (lambda (w c i)
- (vector-set! calls c "modify")
- (if (< (.currInsert i) 0) (snd-display #__line__ ";currInsert: A~" (.currInsert i)))
- (if (< (.newInsert i) 0) (snd-display #__line__ ";newInsert: A~" (.newInsert i)))
- (if (string? (.doit i)) (snd-display #__line__ ";doit: A~" (.doit i)))
- (if (< (.startPos i) 0) (snd-display #__line__ ";startPos: A~" (.startPos i)))
- (if (< (.endPos i) 0) (snd-display #__line__ ";endPos: A~" (.endPos i))))
- 7)
- XmNmotionVerifyCallback (list (lambda (w c i) (vector-set! calls c "motion")) 8)
- XmNvalueChangedCallback (list (lambda (w c i) (vector-set! calls c "value")) 9)))))
- (letrec ((transfer-proc
- (lambda (w c info)
- (let* ((dpy (XtDisplay w))
- (TARGETS (XmInternAtom dpy "TARGETS" #f))
- (CB_TARGETS (XmInternAtom dpy "_MOTIF_CLIPBOARD_TARGETS" #f)))
- (if (equal? (.target info) XA_STRING)
- (begin
- ;(XmTextInsert w (XmTextGetInsertionPosition w) (->string (.value info)))
- ;I think the .value field here is an XmString
- (XmTransferDone (.transfer_id info) XmTRANSFER_DONE_SUCCEED))
- (if (and (or (equal? (.target info) TARGETS)
- (equal? (.target info) CB_TARGETS))
- (equal? (.type info) XA_ATOM))
- (let ((targets (->Atoms (.value info) (.length info)))
- (happy #f))
- (for-each
- (lambda (targ)
- (if (equal? targ XA_STRING)
- (set! happy #t)))
- targets)
- (if happy
- (XmTransferValue (.transfer_id info)
- XA_STRING
- transfer-proc
- #f
- (XtLastTimestampProcessed dpy)))))))))
- (txtf (XtVaCreateManagedWidget "textfield" xmTextFieldWidgetClass frm
- (list XmNeditable #t
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget txt
- XmNbottomAttachment XmATTACH_FORM))))
-
- (let ((vals (XtVaGetValues txt (list XmNrenderTable 0 XmNselectionArray 0))))
- (if (not (XmRenderTable? (list-ref vals 1))) (snd-display #__line__ ";XmNrenderTable: ~A" (list-ref vals 1)))
- (if (not (pair? (list-ref vals 3))) (snd-display #__line__ ";XmNselectionArray: ~A" (list-ref vals 3))))
- (if (not (XmTextGetEditable txt)) (snd-display #__line__ ";XmTextGetEditable?"))
- (if (not (XmTextFieldGetEditable txtf)) (snd-display #__line__ ";XmTextFieldGetEditable?"))
- (XmTextSetEditable txt #f)
- (XmTextFieldSetEditable txtf #f)
- (if (XmTextGetEditable txt) (snd-display #__line__ ";XmTextSetEditable?"))
- (if (XmTextFieldGetEditable txtf) (snd-display #__line__ ";XmTextFieldSetEditable?"))
- (XmTextSetEditable txt #t)
- (XmTextFieldSetEditable txtf #t)
- (XmTextSetString txt "0123456789")
- (XmTextFieldSetString txtf "0123456789")
- (XmTextFieldCopyLink txtf (list 'Time CurrentTime))
- (let ((val (XmTextGetString txt))
- (valf (XmTextFieldGetString txtf))
- (val1 (cadr (XtVaGetValues txt (list XmNvalue 0))))
- (val1f (cadr (XtVaGetValues txtf (list XmNvalue 0)))))
- (if (not (string=? val "0123456789")) (snd-display #__line__ ";XmTextSetString: ~A" val))
- (if (not (string=? valf "0123456789")) (snd-display #__line__ ";XmTextFieldSetString: ~A" valf))
- (if (not (string=? val1 "0123456789")) (snd-display #__line__ ";text value: ~A" val1))
- (if (not (string=? val1f "0123456789")) (snd-display #__line__ ";text field value: ~A" val)))
- (let ((untext (XtCreateWidget "untext" xmTextWidgetClass frm '()))
- (source (XmTextGetSource txt)))
- (XmTextSetSource untext source 0 3)
- (if (not (XmTextSource? source))
- (snd-display #__line__ ";XmTextSource? ~A" source))
- (if (not (equal? (XmTextGetSource untext) source))
- (snd-display #__line__ ";XmTextSetSource: ~A ~A" source (XmTextGetSource untext)))
- (if (XtIsSubclass untext xmFormWidgetClass)
- (snd-display #__line__ ";XtIsSubclass thinks untext is a form?"))
- (if (not (XtIsSubclass untext coreWidgetClass))
- (snd-display #__line__ ";XtIsSubclass thinks untext is not a core widget"))
- (XmTextCopyLink untext (list 'Time CurrentTime))
- (XmTextPasteLink untext))
- (let ((val (XmTextGetSubstring txt 2 3))
- (valf (XmTextFieldGetSubstring txtf 2 3)))
- (if (or (not (string? val)) (not (string=? val "234"))) (snd-display #__line__ ";XmTextGetSubstring: ~A" val))
- (if (or (not (string? valf)) (not (string=? valf "234"))) (snd-display #__line__ ";XmTextFieldGetSubstring: ~A" valf)))
- (XmTextSetSelection txt 2 5 current-time)
- (let ((val (XmTextGetSelection txt)))
- (if (or (not (string? val)) (not (string=? val "234"))) (snd-display #__line__ ";XmTextGetSelection: ~A" val)))
- (XmTextClearSelection txt current-time)
- (let ((val (XmTextGetSelection txt)))
- (if val (snd-display #__line__ ";XmTextClearSelection: ~A" val)))
- (XmTextFieldSetSelection txtf 2 5 current-time)
- (let ((tag (catch #t
- (lambda ()
- (XmTextFieldSetSelection txt 2 3 current-time))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";text field type check: ~A" tag)))
- (let ((tag (catch #t
- (lambda ()
- (XmTextSetSelection frm 2 3 current-time))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";text type check: ~A" tag)))
- (let ((dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets))))
- (app (car (main-widgets))))
- (let ((tag (catch #t (lambda () (XmTransferSetParameters 123 123 123 123 "hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmTransferSetParameters type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmDropSiteConfigureStackingOrder txtf txtf "hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmDropSiteConfigureStackingOrder type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmScrollVisible txtf txtf 5 "hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmScrollVisible type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmDragStart txtf (XEvent KeyPress) (list 0 1) "hiho")) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmDragStart type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmClipboardStartRetrieve dpy win 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardStartRetrieve type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmClipboardCopyByName dpy win 1 "hi" "hi" 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardCopyByName type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmClipboardBeginCopy dpy win "hi" txtf #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardBeginCopy type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmRemoveProtocolCallback txtf XA_STRING XA_STRING #f 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmRemoveProtocolCallback type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetRGBColormaps dpy win (list 'XStandardColormap 0) 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetRGBColormap type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetWMHints dpy win 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMHints type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XWindowEvent dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XWindowEvent type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XStoreNamedColor dpy (list 'Colormap 0) "hi" 0 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreNamedColor type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XStoreColors dpy (list 'Colormap 0) (list 1 2) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreColors type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XStoreColor dpy (list 'Colormap 0) (list 1 2))) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreColor type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtDisplayInitialize app dpy "hi" "ho" 1 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtDisplayInitialize type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtOwnSelectionIncremental txtf '(Atom 0) '(Time 0) #f #f #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtOwnSelectionIncremental type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtOwnSelection txtf '(Atom 0) '(Time 0) #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtOwnSelection type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionValue txtf '(Atom 0) '(Atom 0) #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValue type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionValues txtf '(Atom 0) (list (list 'Atom 0)) #f #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValues type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtDisownSelection txtf '(Atom 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtDisownSelection type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionRequest txtf '(Atom 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionRequest type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionValueIncremental txtf '(Atom 0) (list (list 'Atom 0)) 1 #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValueIncremental type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtGetSelectionValuesIncremental txtf '(Atom 0) '(Atom 0) 1 #f #f #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValuesIncremental type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XtSendSelectionRequest txtf '(Atom 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtSendSelectionRequest type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XReconfigureWMWindow dpy win 1 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReconfigureWMWindow type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetWMProtocols dpy win 1 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMProtocols type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XIconifyWindow dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XIconifyWindow type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XWithdrawWindow dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XWithdrawWindow type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetWMColormapWindows dpy win #f 1)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMColormapWindows type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetTransientForHint dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetTransientForHint type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XAllowEvents dpy 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XAllowEvents type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XChangeActivePointerGrab dpy 1 '(Cursor 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeActivePointerGrab type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XChangeGC dpy '(GC 0) 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeGC type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XChangeKeyboardMapping dpy 1 1 (list 1 1) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeKeyboardMapping type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XConfigureWindow dpy win 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XConfigureWindow type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XConvertSelection dpy '(Atom 0) '(Atom 0) '(Atom 0) win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XConvertSelection type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XReparentWindow dpy win win 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReparentWindow type check: ~A" tag)))
-
- (let ((tag (catch #t (lambda () (XFreeColors dpy '(Colormap 0) (list 0) 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XFreeColors type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XReadBitmapFile dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReadBitmapFile type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XRebindKeysym dpy '(KeySym 0) (list 0) 1 "hi" #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRebindKeysym type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XRestackWindows dpy (list 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRestackWindows type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XRotateWindowProperties dpy win (list 0) 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRotateWindowProperties type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSelectInput dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSelectInput type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetFontPath dpy (list 0) #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetFontPath type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetInputFocus dpy win 1 #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetInputFocus type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetSelectionOwner dpy '(Atom 0) win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetSelectionOwner type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XSetWindowColormap dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWindowColormap type check: ~A" tag)))
- (let ((tag (catch #t (lambda () (XmClipboardCancelCopy dpy win #f)) (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardCancelCopy type check: ~A" tag)))
-
- )
-
- (let ((valf (XmTextFieldGetSelection txtf)))
- (if (not (string=? valf "234")) (snd-display #__line__ ";XmTextFieldGetSelection: ~A" valf)))
- (XmTextFieldClearSelection txtf current-time)
- (let ((valf (XmTextFieldGetSelection txtf)))
- (if valf (snd-display #__line__ ";XmTextFieldClearSelection: ~A" valf)))
- (let ((val (XmTextGetInsertionPosition txt))
- (valf (XmTextFieldGetInsertionPosition txtf)))
- (if (not (= val 5)) (snd-display #__line__ ";XmTextGetInsertionPosition: ~A" val))
- (if (not (= valf 5)) (snd-display #__line__ ";XmTextFieldGetInsertionPosition: ~A" val)))
-
- (XmTextScroll txt 1)
- (XmTextScroll txt -1)
- (let ((pos (XmTextGetTopCharacter txt)))
- (if (not (= pos 0)) (snd-display #__line__ ";XmTextGetTopCharacter after scroll: ~A" pos)))
- (XmTextShowPosition txt 0)
- (XmTextFieldShowPosition txtf 0)
- (XmTextSetTopCharacter txt 0)
- (XmTextXYToPos txt 10 10)
- (XmTextFieldXYToPos txtf 10 10)
-
- (XmTextSetHighlight txt 3 6 XmHIGHLIGHT_SELECTED)
- (XmTextFieldSetHighlight txtf 3 6 XmHIGHLIGHT_SELECTED)
- (XmTextFieldGetBaseline txtf)
- (XmTextSetAddMode txt #t)
- (if (not (XmTextGetAddMode txt)) (snd-display #__line__ ";XmTextSetAddMode?"))
- (XmTextFieldSetAddMode txtf #t)
- (if (not (XmTextFieldGetAddMode txtf)) (snd-display #__line__ ";XmTextFieldSetAddMode?"))
-
- (if (not (string=? (vector-ref calls 5) "gain")) (snd-display #__line__ ";gain callback: ~A" (vector-ref calls 5)))
- (if (not (string=? (vector-ref calls 7) "modify")) (snd-display #__line__ ";modify callback: ~A" (vector-ref calls 7)))
- (if (not (string=? (vector-ref calls 8) "motion")) (snd-display #__line__ ";motion callback: ~A" (vector-ref calls 8)))
- (if (not (string=? (vector-ref calls 9) "value")) (snd-display #__line__ ";value callback: ~A" (vector-ref calls 9)))
-
- (let ((txtf1 (XtVaCreateManagedWidget "textfield" xmTextFieldWidgetClass frm
- (list XmNeditable #t
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget txt
- XmNbottomAttachment XmATTACH_FORM
- XmNdestinationCallback
- (list (lambda (w c info)
- (let* ((dpy (XtDisplay w))
- (TARGETS (XmInternAtom dpy "TARGETS" #f)))
- (XmTransferValue (.transfer_id info)
- TARGETS
- transfer-proc
- #f
- (XtLastTimestampProcessed dpy))))
- #f)))))
- (focus-widget txtf1)
- (XmTextFieldPaste txtf1)
- (XmTextFieldPasteLink txtf1)
- (if (not (Widget? (XmGetTabGroup txtf1))) (snd-display #__line__ ";XmGetTabGroup: ~A " (XmGetTabGroup txtf1)))
- (let ((fw (XmGetFocusWidget (cadr (main-widgets)))))
- (if (not (equal? fw txtf1))
- (snd-display #__line__ ";XmGetFocusWidget: ~A" fw)))
- (let ((callback (lambda (w context ev flag)
- (XtSetValues w (list XmNbackground (white-pixel))))))
- (XtAddEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtRemoveEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtAddRawEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtRemoveRawEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtInsertEventHandler txtf1 EnterWindowMask #f callback #f XtListHead)
- (XtRemoveEventHandler txtf1 EnterWindowMask #f callback #f)
- (XtInsertRawEventHandler txtf1 EnterWindowMask #f callback #f XtListTail)
- (XtRemoveRawEventHandler txtf1 EnterWindowMask #f callback #f))
- (XtRemoveAllCallbacks txtf1 XmNdestinationCallback))
- (XtAppAddActions (car (main-widgets)) (list (list "hiho" (lambda args (snd-print "hiho")))))
- (XtAugmentTranslations txt (XtParseTranslationTable "Ctrl <Key>i: hiho()\n"))
- (XtCallActionProc txt "hiho" (XEvent) #f 0)
- (XtUninstallTranslations txt)
- (XtUnmanageChild frm)))
-
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (win (XtWindow shell))
- (err (XmClipboardRegisterFormat dpy "SND_DATA" 8)))
- (if (not (= err ClipboardSuccess))
- (snd-display #__line__ ";XmClipboardRegisterFormat: ~A" err)
- (let ((vals (XmClipboardStartCopy dpy win
- (XmStringCreateLocalized "SND_DATA")
- (list 'Time CurrentTime)
- shell
- (lambda (w id pid reason)
- (let ((status (XmClipboardCopyByName dpy win id "copy this" 10 123))))))))
- (if (not (= (car vals) ClipboardSuccess))
- (snd-display #__line__ ";XmClipboardStartCopy: ~A" vals)
- (let ((data-id (cadr vals)))
- (set! err (XmClipboardCopy dpy win data-id "SND_DATA" "copy this" 10 0))
- (if (not (= (car err) ClipboardSuccess)) (snd-display #__line__ ";XmClipboardCopy: ~A" err))
- (let ((item-id (cadr err)))
- (set! err (XmClipboardEndCopy dpy win data-id))
- (if (not (= err ClipboardSuccess)) (snd-display #__line__ ";copy ~A" err))
- (if (not (= (cadr (XmClipboardInquireLength dpy win "SND_DATA")) 10))
- (snd-display #__line__ ";clip len: ~A" (XmClipboardInquireLength dpy win "SND_DATA")))
- (let ((pend (XmClipboardInquirePendingItems dpy win "SND_DATA")))
- (if (not (= (car pend) ClipboardSuccess)) (snd-display #__line__ ";XmClipboardInquirePendingItems: ~A" pend)))
- (let ((formats1 (XmClipboardInquireCount dpy win)))
- (if (= (cadr formats1) 0) (snd-display #__line__ ";XmClipboardInquireCount: ~A" formats1))
- (let ((data (XmClipboardInquireFormat dpy win 1 10)))
- (let ((clip (XmClipboardRetrieve dpy win "SND_DATA" 10)))
- (if (not (string=? (cadr clip) "copy this")) (snd-display #__line__ ";XmClipboardRetrieve: ~A" clip))
- (XmClipboardWithdrawFormat dpy win item-id)))))))))
- (let ((val (XmClipboardLock dpy win)))
- (if (not (= val ClipboardLocked))
- (XmClipboardUnlock dpy win #t)))
- (let ((selbox (XmCreateSelectionBox shell "selbox" '() 0)))
- (XmSelectionBoxGetChild selbox XmDIALOG_APPLY_BUTTON)))
+ )
+
+ (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
+ (browsed 0)
+ (lst (XtCreateManagedWidget "lst" xmListWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNautomaticSelection XmNO_AUTO_SELECT
+ XmNdoubleClickInterval 100
+ XmNitemCount 3
+ XmNitems (list (XmStringCreate "one" XmFONTLIST_DEFAULT_TAG)
+ (XmStringCreate "two" XmFONTLIST_DEFAULT_TAG)
+ (XmStringCreate "three" XmFONTLIST_DEFAULT_TAG))
+ XmNlistMarginHeight 4
+ XmNlistMarginWidth 1
+ XmNlistSizePolicy XmVARIABLE
+ XmNlistSpacing 2
+ XmNmatchBehavior XmQUICK_NAVIGATE
+ XmNprimaryOwnership XmOWN_NEVER
+ XmNscrollBarDisplayPolicy XmAS_NEEDED
+ XmNselectColor *basic-color*
+ XmNselectedPositions (list 0 1)
+ XmNselectionMode XmNORMAL_MODE
+ XmNselectionPolicy XmBROWSE_SELECT))))
+ (XtAddCallback lst XmNbrowseSelectionCallback (lambda (w c i) (set! browsed 123)))
+ (let ((vals (XtVaGetValues lst
+ (list XmNautomaticSelection 0 XmNdoubleClickInterval 0 XmNitemCount 0 XmNitems 0 XmNlistMarginHeight 0
+ XmNlistMarginWidth 0 XmNlistSizePolicy 0 XmNlistSpacing 0 XmNmatchBehavior 0
+ XmNprimaryOwnership 0 XmNscrollBarDisplayPolicy 0 XmNselectColor 0 XmNselectionMode 0
+ XmNselectionPolicy 0 XmNhorizontalScrollBar 0 XmNselectedItemCount 0 XmNtopItemPosition 0))))
+ (if (not (= (vals 1) XmNO_AUTO_SELECT)) (snd-display #__line__ ";XmNautomaticSelection: ~A" (vals 1)))
+ (if (not (= (vals 3) 100)) (snd-display #__line__ ";XmNdoubleClickInterval: ~A" (vals 3)))
+ (if (not (= (vals 5) 3)) (snd-display #__line__ ";XmNitemCount: ~A" (vals 5)))
+ (if (or (null? (vals 7)) (not (XmString? (car (vals 7))))) (snd-display #__line__ ";XmNitems: ~A" (vals 7)))
+ (if (not (= (vals 9) 4)) (snd-display #__line__ ";XmNlistMarginHeight: ~A" (vals 9)))
+ (if (not (= (vals 11) 1)) (snd-display #__line__ ";XmNlistMarginWidth: ~A" (vals 11)))
+ (if (not (= (vals 13) XmVARIABLE)) (snd-display #__line__ ";XmNlistSizePolicy: ~A" (vals 13)))
+ (if (not (= (vals 15) 2)) (snd-display #__line__ ";XmNlistSpacing: ~A" (vals 15)))
+ (if (not (= (vals 17) XmQUICK_NAVIGATE)) (snd-display #__line__ ";XmNmatchBehavior: ~A" (vals 17)))
+ (if (not (= (vals 19) XmOWN_NEVER)) (snd-display #__line__ ";XmNprimaryOwnership : ~A" (vals 19)))
+ (if (not (= (vals 21) XmAS_NEEDED)) (snd-display #__line__ ";XmNscrollBarDisplayPolicy: ~A" (vals 21)))
+ (if (not (Pixel? (vals 23))) (snd-display #__line__ ";XmNselectColor: ~A" (vals 23)))
+ (if (not (= (vals 25) XmNORMAL_MODE)) (snd-display #__line__ ";XmNselectionMode: ~A" (vals 25)))
+ (if (not (= (vals 27) XmBROWSE_SELECT)) (snd-display #__line__ ";XmNselectionPolicy: ~A" (vals 27)))
+ (if (vals 29) (snd-display #__line__ ";XmNhorizontalScrollBar: ~A" (vals 29)))
+ (if (not (= (vals 31) 0)) (snd-display #__line__ ";XmNselectedItemCount : ~A" (vals 31)))
+ (if (not (= (vals 33) 1)) (snd-display #__line__ ";XmNtopItemPosition: ~A" (vals 33)))
- (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
- (current-time (list 'Time CurrentTime))
- (box (XtCreateManagedWidget "box" xmContainerWidgetClass frm '()))
- (tgl (XtCreateManagedWidget "tgl" xmToggleButtonWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE)))
- (tgg (XtCreateManagedWidget "tgg" xmToggleButtonGadgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget tgl
- XmNbottomAttachment XmATTACH_NONE)))
- (spn (XtCreateManagedWidget "spn" xmSimpleSpinBoxWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget tgg
- XmNbottomAttachment XmATTACH_NONE)))
- (cmd (XtCreateManagedWidget "cmd" xmCommandWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget spn
- XmNbottomAttachment XmATTACH_NONE)))
- (scl (XtCreateManagedWidget "scl" xmScaleWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget cmd
- XmNbottomAttachment XmATTACH_NONE)))
- (notes (XtCreateManagedWidget "notes" xmNotebookWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget scl
- XmNbottomAttachment XmATTACH_NONE)))
-
- (cmb (XtCreateManagedWidget "cmb" xmComboBoxWidgetClass frm
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_WIDGET
- XmNtopWidget notes
- XmNbottomAttachment XmATTACH_FORM)))
- (toggled 0))
- (XtCreateManagedWidget "one" xmPushButtonWidgetClass notes '())
- (XtCreateManagedWidget "two" xmPushButtonWidgetClass notes '())
- (let ((info (cadr (XmNotebookGetPageInfo notes 1))))
- (if (not (= (.page_number info) 1)) (snd-display #__line__ ";page_number: ~A" (.page_number info)))
- (if (.page_widget info) (snd-display #__line__ ";page_widget: ~A" (.page_widget info)))
- (if (.status_area_widget info) (snd-display #__line__ ";status_area_widget: ~A" (.status_area_widget info)))
- (if (not (Widget? (.major_tab_widget info))) (snd-display #__line__ ";major_tab_widget: ~A" (.major_tab_widget info)))
- (if (.minor_tab_widget info) (snd-display #__line__ ";minor_tab_widget: ~A" (.minor_tab_widget info)))
- ;(segfault) (XtFree (cadr info))
- )
+ (let ((tag (catch #t
+ (lambda ()
+ (XmListAddItem frm (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG) 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";list type check: ~A" tag)))
+
+ (XmListAddItem lst (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG) 0) ; 0 -> last position
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 4)) (snd-display #__line__ ";XmAddItem len: ~A" (vals 1)))
+ (XmListAddItems lst (list (XmStringCreateLocalized "five") (XmStringCreateLocalized "six")) 2 0)
+ (let ((tag (catch #t
+ (lambda () (XmListAddItems lst (list (XmStringCreateLocalized "seven") 123) 2 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";xstrings->list add: ~A" tag)))
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 6)) (snd-display #__line__ ";XmAddItems len: ~A" (vals 1)))
+
+ (XmListDeletePos lst 1)
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 5)) (snd-display #__line__ ";XmListDeletePos len: ~A" (vals 1)))
+ (XmListDeletePositions lst (list 2 4))
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 3)) (snd-display #__line__ ";XmListDeletePositions len: ~A" (vals 1)))
+
+ (XmListAddItemUnselected lst (XmStringCreate "seven" XmFONTLIST_DEFAULT_TAG) 0) ; 0 -> last position
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 4)) (snd-display #__line__ ";XmListAddItemUnselected len: ~A" (vals 1)))
+ (XmListAddItemsUnselected lst (list (XmStringCreateLocalized "eight") (XmStringCreateLocalized "nine")) 2 0)
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 6)) (snd-display #__line__ ";XmListAddItemsUnselected len: ~A" (vals 1)))
+
+ (XmListDeleteAllItems lst)
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 0)) (snd-display #__line__ ";XmListDeleteAllItems len: ~A" (vals 1)))
+ (if (pair? (vals 3))
+ (snd-display #__line__ ";deleted all items: ~A" (vals 3)))
+
+ (let ((item1 (XmStringCreate "one" XmFONTLIST_DEFAULT_TAG))
+ (item2 (XmStringCreate "two" XmFONTLIST_DEFAULT_TAG))
+ (item3 (XmStringCreate "three" XmFONTLIST_DEFAULT_TAG))
+ (item4 (XmStringCreate "four" XmFONTLIST_DEFAULT_TAG))
+ (item5 (XmStringCreate "five" XmFONTLIST_DEFAULT_TAG)))
+ (XtVaSetValues lst
+ (list XmNitemCount 5
+ XmNitems (list item1 item2 item3 item4 item5)))
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 5)) (snd-display #__line__ ";Xt set items len: ~A" (vals 1)))
- (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "hiho") 0)
- (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "away") 0)
- (XmSimpleSpinBoxDeletePos spn 0)
- (let ((vals (XtVaGetValues spn (list XmNvalues 0))))
- (XmSimpleSpinBoxSetItem spn (car (cadr vals))))
- (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "another") 0)
- (let ((vals (XtGetValues spn (list XmNeditable 0 XmNtextField 0))))
- (if (not (list-ref vals 1)) (snd-display #__line__ ";XmNeditable spin box"))
- (if (not (Widget? (list-ref vals 3))) (snd-display #__line__ ";XmNtextField: ~A" (list-ref vals 3))))
+ (XmListSelectItem lst item3 #t)
+ (if (not (= browsed 123)) (snd-display #__line__ ";XmListSelectItem callback: ~A" browsed))
+ (if (XmListPosSelected lst 1) (snd-display #__line__ ";XmList selected pos 1?"))
+ (if (not (XmListPosSelected lst 3)) (snd-display #__line__ ";XmList didn't select pos 3?"))
+ (set! vals (XtVaGetValues lst (list XmNselectedItemCount 0 XmNselectedItems 0)))
+ (if (not (= (vals 1) 1)) (snd-display #__line__ ";selected count: ~A" (vals 1)))
+ (set! vals (XmListGetSelectedPos lst))
+ (if (not (= (length vals) 1)) (snd-display #__line__ ";XmListGetSelectedPos: ~A" vals))
+ (if (not (= (car vals) 3)) (snd-display #__line__ ";XmListGetSelectedPos: ~A" vals))
+ (set! browsed 0)
+ (XmListSelectPos lst 1 #f)
+ (if (not (= browsed 0)) (snd-display #__line__ ";XmListSelectPos callback: ~A" browsed))
+ (if (not (XmListPosSelected lst 1)) (snd-display #__line__ ";XmList select pos?"))
+ (if (not (= (XmListItemPos lst item3) 3)) (snd-display #__line__ ";XmListItemPos: ~A" (XmListItemPos lst item3)))
+ (if (not (= (car (XmListGetMatchPos lst item3)) 3)) (snd-display #__line__ ";XmListGetMatchPos: ~A" (XmListGetMatchPos lst item3)))
+ (if (not (XmListItemExists lst item3)) (snd-display #__line__ ";XmListItemExists?"))
- (XtAddCallback tgl XmNvalueChangedCallback (lambda (w c i) (set! toggled 123)) #f)
- (XmToggleButtonSetState tgl #f #f)
- (XmToggleButtonGadgetSetState tgg #f #f)
- (if (not (= toggled 0)) (snd-display #__line__ ";toggle calledback: ~A?" toggled))
- (if (XmToggleButtonGetState tgl) (snd-display #__line__ ";XmToggleButtonSetState #f"))
- (if (XmToggleButtonGadgetGetState tgg) (snd-display #__line__ ";XmToggleButtonGadgetSetState #f"))
- (XtVaSetValues tgl (list XmNtoggleMode XmTOGGLE_INDETERMINATE))
- (XmToggleButtonSetValue tgl XmINDETERMINATE #t)
- (XmToggleButtonGadgetSetValue tgg XmINDETERMINATE #t)
- (if (not (= toggled 123)) (snd-display #__line__ ";toggle not calledback: ~A?" toggled))
+ (if (not (= (XmListYToPos lst 40) 2)) (snd-display #__line__ ";XmListYToPos: ~A" (XmListYToPos lst 40)))
+ (let ((box (XmListPosToBounds lst 2)))
+ (if (and (not (= (cadr box) 3))
+ (not (= (cadr box) 2)))
+ (snd-display #__line__ ";XmListPosToBounds: ~A" box)))
+ (XmListDeselectPos lst 1)
+ (if (XmListPosSelected lst 1) (snd-display #__line__ ";XmList deselected pos?"))
+ (XmListSelectItem lst item3 #t)
+ (XmListDeselectAllItems lst)
+ (if (XmListPosSelected lst 3) (snd-display #__line__ ";XmList deselect all pos?"))
+ (XmListSelectItem lst item3 #f)
+ (XmListDeselectItem lst item3)
+ (if (XmListPosSelected lst 3) (snd-display #__line__ ";XmList deselect item?"))
- (XmCommandAppendValue cmd (XmStringCreateLocalized "hiho"))
- (XmCommandError cmd (XmStringCreateLocalized "hiho"))
- (if (not (Widget? (XmCommandGetChild cmd XmDIALOG_COMMAND_TEXT)))
- (snd-display #__line__ ";XmCommandGetChild: ~A" (XmCommandGetChild cmd XmDIALOG_COMMAND_TEXT)))
- (XmCommandSetValue cmd (XmStringCreateLocalized "hiho"))
+ (XmListDeleteItem lst item2)
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 4)) (snd-display #__line__ ";XmDeleteItem len: ~A" (vals 1)))
+ (XmListDeleteItems lst (list item1 item4))
+ (set! vals (XtGetValues lst (list XmNitemCount 0 XmNitems 0)))
+ (if (not (= (vals 1) 2)) (snd-display #__line__ ";XmDeleteItems len: ~A" (vals 1)))
+ (XmListDeleteAllItems lst)
+ (XtVaSetValues lst
+ (list XmNitemCount 5
+ XmNitems (list item1 item2 item3 item4 item5)))
- (let ((one1 (XmStringCreateLocalized "one"))
- (two1 (XmStringCreateLocalized "two"))
- (three1 (XmStringCreateLocalized "three")))
- (XmComboBoxAddItem cmb one1 0 #f)
- (XmComboBoxAddItem cmb two1 0 #f)
- (XmComboBoxAddItem cmb three1 0 #f)
- (XmComboBoxDeletePos cmb 1)
- (XmComboBoxSelectItem cmb three1)
- (XmComboBoxSetItem cmb three1) ; hunh??
- (XmComboBoxUpdate cmb)
- (let ((vals (cadr (XtGetValues cmb (list XmNitems 0)))))
- (if (not (equal? vals (list two1 three1))) (snd-display #__line__ ";XmComboBox: ~A" vals))))
+ (XtUnmanageChild frm))))
+
+ (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
+ (current-time (list 'Time CurrentTime))
+ (calls (make-vector 10 "none"))
+ (txt (XtCreateManagedWidget "text" xmTextWidgetClass frm
+ (list XmNeditable #t
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE
+ XmNdestinationCallback
+ (list (lambda (w c i)
+ (set! (calls c) "dest")
+ (if (< (.location_data i) 0) (snd-display #__line__ ";location_data: ~A" (.location_data i))))
+ 1)
+ XmNactivateCallback (list (lambda (w c i) (set! (calls c) "act")) 2)
+ XmNfocusCallback (list (lambda (w c i) (set! (calls c) "focus")) 3)
+ XmNlosingFocusCallback (list (lambda (w c i) (set! (calls c) "losingfocus")) 4)
+ XmNgainPrimaryCallback (list (lambda (w c i) (set! (calls c) "gain")) 5)
+ XmNlosePrimaryCallback (list (lambda (w c i) (set! (calls c) "lose")) 6)
+ XmNmodifyVerifyCallback
+ (list (lambda (w c i)
+ (set! (calls c) "modify")
+ (if (< (.currInsert i) 0) (snd-display #__line__ ";currInsert: ~A" (.currInsert i)))
+ (if (< (.newInsert i) 0) (snd-display #__line__ ";newInsert: ~A" (.newInsert i)))
+ (if (string? (.doit i)) (snd-display #__line__ ";doit: ~A" (.doit i)))
+ (if (< (.startPos i) 0) (snd-display #__line__ ";startPos: ~A" (.startPos i)))
+ (if (< (.endPos i) 0) (snd-display #__line__ ";endPos: ~A" (.endPos i))))
+ 7)
+ XmNmotionVerifyCallback (list (lambda (w c i) (set! (calls c) "motion")) 8)
+ XmNvalueChangedCallback (list (lambda (w c i) (set! (calls c) "value")) 9)))))
+ (letrec ((transfer-proc
+ (lambda (w c info)
+ (let* ((dpy (XtDisplay w))
+ (TARGETS (XmInternAtom dpy "TARGETS" #f))
+ (CB_TARGETS (XmInternAtom dpy "_MOTIF_CLIPBOARD_TARGETS" #f)))
+ (if (equal? (.target info) XA_STRING)
+ (XmTransferDone (.transfer_id info) XmTRANSFER_DONE_SUCCEED)
+ (if (and (or (equal? (.target info) TARGETS)
+ (equal? (.target info) CB_TARGETS))
+ (equal? (.type info) XA_ATOM))
+ (let ((targets (->Atoms (.value info) (.length info)))
+ (happy #f))
+ (for-each
+ (lambda (targ)
+ (if (equal? targ XA_STRING)
+ (set! happy #t)))
+ targets)
+ (if happy
+ (XmTransferValue (.transfer_id info)
+ XA_STRING
+ transfer-proc
+ #f
+ (XtLastTimestampProcessed dpy)))))))))
+ (txtf (XtVaCreateManagedWidget "textfield" xmTextFieldWidgetClass frm
+ (list XmNeditable #t
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget txt
+ XmNbottomAttachment XmATTACH_FORM))))
+
+ (let ((vals (XtVaGetValues txt (list XmNrenderTable 0 XmNselectionArray 0))))
+ (if (not (XmRenderTable? (vals 1))) (snd-display #__line__ ";XmNrenderTable: ~A" (vals 1)))
+ (if (not (pair? (vals 3))) (snd-display #__line__ ";XmNselectionArray: ~A" (vals 3))))
+ (if (not (XmTextGetEditable txt)) (snd-display #__line__ ";XmTextGetEditable?"))
+ (if (not (XmTextFieldGetEditable txtf)) (snd-display #__line__ ";XmTextFieldGetEditable?"))
+ (XmTextSetEditable txt #f)
+ (XmTextFieldSetEditable txtf #f)
+ (if (XmTextGetEditable txt) (snd-display #__line__ ";XmTextSetEditable?"))
+ (if (XmTextFieldGetEditable txtf) (snd-display #__line__ ";XmTextFieldSetEditable?"))
+ (XmTextSetEditable txt #t)
+ (XmTextFieldSetEditable txtf #t)
+ (XmTextSetString txt "0123456789")
+ (XmTextFieldSetString txtf "0123456789")
+ (XmTextFieldCopyLink txtf (list 'Time CurrentTime))
+ (let ((val (XmTextGetString txt))
+ (valf (XmTextFieldGetString txtf))
+ (val1 (cadr (XtVaGetValues txt (list XmNvalue 0))))
+ (val1f (cadr (XtVaGetValues txtf (list XmNvalue 0)))))
+ (if (not (string=? val "0123456789")) (snd-display #__line__ ";XmTextSetString: ~A" val))
+ (if (not (string=? valf "0123456789")) (snd-display #__line__ ";XmTextFieldSetString: ~A" valf))
+ (if (not (string=? val1 "0123456789")) (snd-display #__line__ ";text value: ~A" val1))
+ (if (not (string=? val1f "0123456789")) (snd-display #__line__ ";text field value: ~A" val)))
+ (let ((untext (XtCreateWidget "untext" xmTextWidgetClass frm ()))
+ (source (XmTextGetSource txt)))
+ (XmTextSetSource untext source 0 3)
+ (if (not (XmTextSource? source))
+ (snd-display #__line__ ";XmTextSource? ~A" source))
+ (if (not (equal? (XmTextGetSource untext) source))
+ (snd-display #__line__ ";XmTextSetSource: ~A ~A" source (XmTextGetSource untext)))
+ (if (XtIsSubclass untext xmFormWidgetClass)
+ (snd-display #__line__ ";XtIsSubclass thinks untext is a form?"))
+ (if (not (XtIsSubclass untext coreWidgetClass))
+ (snd-display #__line__ ";XtIsSubclass thinks untext is not a core widget"))
+ (XmTextCopyLink untext (list 'Time CurrentTime))
+ (XmTextPasteLink untext))
+ (let ((val (XmTextGetSubstring txt 2 3))
+ (valf (XmTextFieldGetSubstring txtf 2 3)))
+ (if (or (not (string? val)) (not (string=? val "234"))) (snd-display #__line__ ";XmTextGetSubstring: ~A" val))
+ (if (or (not (string? valf)) (not (string=? valf "234"))) (snd-display #__line__ ";XmTextFieldGetSubstring: ~A" valf)))
+ (XmTextSetSelection txt 2 5 current-time)
+ (let ((val (XmTextGetSelection txt)))
+ (if (or (not (string? val)) (not (string=? val "234"))) (snd-display #__line__ ";XmTextGetSelection: ~A" val)))
+ (XmTextClearSelection txt current-time)
+ (let ((val (XmTextGetSelection txt)))
+ (if val (snd-display #__line__ ";XmTextClearSelection: ~A" val)))
+ (XmTextFieldSetSelection txtf 2 5 current-time)
+ (let ((tag (catch #t
+ (lambda ()
+ (XmTextFieldSetSelection txt 2 3 current-time))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";text field type check: ~A" tag)))
+ (let ((tag (catch #t
+ (lambda ()
+ (XmTextSetSelection frm 2 3 current-time))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";text type check: ~A" tag)))
+ (let ((dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets))))
+ (app (car (main-widgets))))
+ (let ((tag (catch #t (lambda () (XmTransferSetParameters 123 123 123 123 "hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmTransferSetParameters type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmDropSiteConfigureStackingOrder txtf txtf "hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmDropSiteConfigureStackingOrder type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmScrollVisible txtf txtf 5 "hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmScrollVisible type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmDragStart txtf (XEvent KeyPress) (list 0 1) "hiho")) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmDragStart type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmClipboardStartRetrieve dpy win 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardStartRetrieve type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmClipboardCopyByName dpy win 1 "hi" "hi" 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardCopyByName type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmClipboardBeginCopy dpy win "hi" txtf #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardBeginCopy type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmRemoveProtocolCallback txtf XA_STRING XA_STRING #f 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmRemoveProtocolCallback type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetRGBColormaps dpy win (list 'XStandardColormap 0) 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetRGBColormap type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetWMHints dpy win 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMHints type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XWindowEvent dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XWindowEvent type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XStoreNamedColor dpy (list 'Colormap 0) "hi" 0 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreNamedColor type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XStoreColors dpy (list 'Colormap 0) (list 1 2) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreColors type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XStoreColor dpy (list 'Colormap 0) (list 1 2))) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XStoreColor type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtDisplayInitialize app dpy "hi" "ho" 1 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtDisplayInitialize type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtOwnSelectionIncremental txtf '(Atom 0) '(Time 0) #f #f #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtOwnSelectionIncremental type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtOwnSelection txtf '(Atom 0) '(Time 0) #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtOwnSelection type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionValue txtf '(Atom 0) '(Atom 0) #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValue type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionValues txtf '(Atom 0) (list (list 'Atom 0)) #f #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValues type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtDisownSelection txtf '(Atom 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtDisownSelection type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionRequest txtf '(Atom 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionRequest type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionValueIncremental txtf '(Atom 0) (list (list 'Atom 0)) 1 #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValueIncremental type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtGetSelectionValuesIncremental txtf '(Atom 0) '(Atom 0) 1 #f #f #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtGetSelectionValuesIncremental type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XtSendSelectionRequest txtf '(Atom 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XtSendSelectionRequest type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XReconfigureWMWindow dpy win 1 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReconfigureWMWindow type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetWMProtocols dpy win 1 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMProtocols type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XIconifyWindow dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XIconifyWindow type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XWithdrawWindow dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XWithdrawWindow type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetWMColormapWindows dpy win #f 1)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWMColormapWindows type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetTransientForHint dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetTransientForHint type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XAllowEvents dpy 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XAllowEvents type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XChangeActivePointerGrab dpy 1 '(Cursor 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeActivePointerGrab type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XChangeGC dpy '(GC 0) 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeGC type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XChangeKeyboardMapping dpy 1 1 (list 1 1) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XChangeKeyboardMapping type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XConfigureWindow dpy win 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XConfigureWindow type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XConvertSelection dpy '(Atom 0) '(Atom 0) '(Atom 0) win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XConvertSelection type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XReparentWindow dpy win win 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReparentWindow type check: ~A" tag)))
- (XmContainerCut box current-time)
- (XmContainerCopy box current-time)
- (XmContainerPaste box)
- (XmContainerCopyLink box (list 'Time CurrentTime))
- (XmContainerPasteLink box)
- (let ((vals (XtVaGetValues box (list XmNlargeIconX 0 XmNlargeIconY 0))))
- (if (or (null? (cdr vals))
- (not (real? (cadr vals)))
- (fneq (cadr vals) 0.0)
- (null? (cdddr vals))
- (not (real? (cadddr vals)))
- (fneq (cadddr vals) 0.0))
- (snd-display #__line__ ";xm-float resource vals: ~A" vals)))
+ (let ((tag (catch #t (lambda () (XFreeColors dpy '(Colormap 0) (list 0) 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XFreeColors type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XReadBitmapFile dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XReadBitmapFile type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XRebindKeysym dpy '(KeySym 0) (list 0) 1 "hi" #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRebindKeysym type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XRestackWindows dpy (list 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRestackWindows type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XRotateWindowProperties dpy win (list 0) 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XRotateWindowProperties type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSelectInput dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSelectInput type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetFontPath dpy (list 0) #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetFontPath type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetInputFocus dpy win 1 #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetInputFocus type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetSelectionOwner dpy '(Atom 0) win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetSelectionOwner type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XSetWindowColormap dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XSetWindowColormap type check: ~A" tag)))
+ (let ((tag (catch #t (lambda () (XmClipboardCancelCopy dpy win #f)) (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg)) (snd-display #__line__ ";XmClipboardCancelCopy type check: ~A" tag)))
- (XtAddCallback scl XmNvalueChangedCallback (lambda (w c i) #f))
- (XmScaleSetValue scl 25)
- (if (not (= (XmScaleGetValue scl) 25)) (snd-display #__line__ ";XmScaleSetValue: ~A" (XmScaleGetValue scl)))
- (if (XmGetTearOffControl (car (menu-widgets))) (snd-display #__line__ ";XmGetTearOffControl: ~A" (XmGetTearOffControl (car (menu-widgets)))))
- (let ((children (cadr (XtGetValues scl (list XmNchildren 0)))))
- (for-each
- (lambda (w)
- (let ((name (XtName w)))
- (if (and (XmIsSeparatorGadget w)
- (or (string=? name "BigTic")
- (string=? name "MedTic")
- (string=? name "SmallTic")))
- (XtDestroyWidget w))))
- children))
- (XmScaleSetTicks scl 5 2 0 10 5 0)
)
- (XmSetColorCalculation #f)
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (scr1 (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr1))
- (screen (XDefaultScreenOfDisplay dpy))
- (scr (XmGetXmScreen (XDefaultScreenOfDisplay dpy)))
- (old-h (cadr (XtVaGetValues scr (list XmNhorizontalFontUnit 0))))
- (old-v (cadr (XtVaGetValues scr (list XmNverticalFontUnit 0)))))
- (if (not (XmIsScreen scr)) (snd-display #__line__ ";XmIsScreen: ~A" scr))
- (let ((colors (XmGetColors screen cmap (basic-color))))
- (if (not (Pixel? (car colors)))
- (snd-display #__line__ ";colors: ~A " colors))
- (let ((color-proc (lambda (bg)
- (list (white-pixel) (black-pixel) (white-pixel) (black-pixel)))))
- (XmSetColorCalculation color-proc)
- (if (not (equal? (XmGetColorCalculation) color-proc))
- (snd-display #__line__ ";XmSetColorcalulcation ~A" (XmGetColorCalculation)))))
- (let ((vals (XtVaGetValues scr
- (list XmNbitmapConversionModel 0 XmNdarkThreshold 0 XmNfont 0 XmNunpostBehavior 0))))
- (if (not (= (list-ref vals 1) XmMATCH_DEPTH)) (snd-display #__line__ ";XmNbitmapConversionModel: ~A" (list-ref vals 1)))
- (if (not (= (list-ref vals 3) 0)) (snd-display #__line__ ";XmNdarkThreshold: ~A" (list-ref vals 3)))
- (if (not (XFontStruct? (list-ref vals 5))) (snd-display #__line__ ";XmNfont: ~A" (list-ref vals 5)))
- (if (not (= (list-ref vals 7) XmUNPOST_AND_REPLAY)) (snd-display #__line__ ";XmNunpostBehavior: ~A" (list-ref vals 7)))
- (XSetScreenSaver dpy -1 5 DefaultBlanking DefaultExposures)
- ))
- (let ((dpy (XtDisplay (cadr (main-widgets)))))
- (let* ((dp (XmGetXmDisplay dpy))
- (vals (XtVaGetValues dp
- (list XmNdragInitiatorProtocolStyle 0 XmNenableThinThickness 0 XmNmotifVersion 0))))
- (if (not (XmIsDisplay dp)) (snd-display #__line__ ";XmIsDisplay: ~A" dp))
- (if (not (= (list-ref vals 1) XmDRAG_PREFER_RECEIVER)) (snd-display #__line__ ";XmNdragInitiatorProtocolStyle: ~A" (list-ref vals 1)))
- (if (not (list-ref vals 3)) (snd-display #__line__ ";XmNenableThinThickness?"))
- (if (not (= (list-ref vals 5) 2002)) (snd-display #__line__ ";XmGetXmDisplay motif version: ~A" (list-ref vals 5)))
- (XtAddCallback dp XmNdragStartCallback (lambda (w c i) #f)))
-
- (if (not (string=? (XmCvtXmStringToCT (XmStringCreateLocalized "hiho")) "hiho"))
- (snd-display #__line__ ";XmCvtXmStringToCT: ~A" (XmCvtXmStringToCT (XmStringCreateLocalized "hiho"))))
- (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmINCHES)))
- (if (not (= val 3)) (snd-display #__line__ ";XmConvertStringToUnits in->in ~A" val)))
- (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmPOINTS)))
- (if (not (= val 225)) (snd-display #__line__ ";XmConvertStringToUnits in->pts ~A" val)))
- (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmCENTIMETERS)))
- (if (not (= val 7)) (snd-display #__line__ ";XmConvertStringToUnits in->cm ~A" val)))
- (let ((val (XmConvertUnits (cadr (main-widgets)) XmHORIZONTAL XmCENTIMETERS 7 XmMILLIMETERS)))
- (if (not (= val 70)) (snd-display #__line__ ";XmConvertUnits cm->mm ~A" val)))
- (let ((val (XmConvertUnits (cadr (main-widgets)) XmHORIZONTAL XmCENTIMETERS 7 XmPIXELS)))
- (if (and (not (= val 278)) (not (= val 273))) (snd-display #__line__ ";XmConvertUnits cm->pix ~A" val)))
- (XmVaCreateSimpleRadioBox (caddr (main-widgets)) "hiho" 0 (lambda (w c i) #f) '())
- (XmVaCreateSimpleCheckBox (caddr (main-widgets)) "hiho" (lambda (w c i) #f) '())
- (XmVaCreateSimplePulldownMenu (caddr (main-widgets)) "hiho" 0 (lambda (w c i) #f) '())
- (XmVaCreateSimplePopupMenu (caddr (main-widgets)) "hiho" (lambda (w c i) #f) '())
- (XmVaCreateSimpleMenuBar (caddr (main-widgets)) "hiho" '())
- (XmVaCreateSimpleOptionMenu (caddr (main-widgets)) "hiho"
- (XmStringCreateLocalized "away")
- (XKeycodeToKeysym dpy (list 'KeyCode XK_b) 0)
- 0 (lambda (w c i) #f) '())
-
- ; (if (not (XmIsMotifWMRunning (cadr (main-widgets)))) (snd-display #__line__ ";not XmIsMotifWMRunning?"))
- (install-searcher (lambda (file) (= (mus-sound-srate file) 44100)))
- (zync)
- (make-pixmap (cadr (main-widgets)) arrow-strs)
- (display-scanned-synthesis)
- (add-mark-pane)
- (let ((ind (open-sound "oboe.snd")))
- (snd-clock-icon ind 6)
- (add-tooltip (cadr (channel-widgets)) "the w button")
- (with-minmax-button ind)
- (make-channel-drop-site ind 0)
- (set-channel-drop (lambda (file s c) (snd-print file)) ind 0)
- (let ((drop-site (find-child (XtParent (XtParent (list-ref (channel-widgets ind 0) 7))) "drop here")))
- (if drop-site
- (begin
- (XtVaGetValues drop-site (list XmNdropRectangles 0))
- (let ((val (XmDropSiteRetrieve drop-site (list XmNnumImportTargets 0))))
- (if (not (= (cadr val) 1)) (snd-display #__line__ ";XmDropSiteRetrieve num: ~A" val)))
- (XmDropSiteRetrieve drop-site (list XmNimportTargets 0))
- (if (not (XmDropSiteRegistered drop-site))
- (snd-display #__line__ ";XmDropSiteRegistered?"))
- (XmDropSiteUnregister drop-site))
- (snd-display #__line__ ";no drop site?"))))
-
- (add-mark 123)
- (let ((container
- (make-sound-box "sounds"
- (list-ref (main-widgets) 3)
- (lambda (file)
- (mix file))
- (lambda (file chn)
- (define (without-directories filename)
- (call-with-exit
- (lambda (return)
- (do ((i (- (string-length filename) 1) (- i 1)))
- ((= 0 i) filename)
- (if (char=? (string-ref filename i) #\/)
- (return (my-substring filename (+ i 1))))))))
- (format #f "~~/peaks/~A-peaks-~D"
- (snd-test-clean-string (mus-expand-filename file))
- chn))
- (list "oboe.snd" "pistol.snd" "cardinal.snd" "storm.snd")
- '())))
- (XmContainerRelayout container)
- (let ((vals (XtVaGetValues container
- (list XmNlargeCellHeight 0 XmNcollapsedStatePixmap 0 XmNdetailOrder 0 XmNdetailTabList 0
- XmNselectedObjects 0 XmNconvertCallback 0 XmNdestinationCallback 0 XmNselectionCallback 0))))
- (if (not (= (list-ref vals 1) 0)) (snd-display #__line__ ";XmNlargeCellHeight: ~A" (list-ref vals 1)))
- (if (not (Pixmap? (list-ref vals 3))) (snd-display #__line__ ";XmNcollapsedStatePixmap: ~A" (list-ref vals 3)))
- (let ((children '()))
- (for-each-child container
- (lambda (w)
- (if (XmIsIconGadget w)
- (set! children (cons w children)))))
- (XmContainerReorder container children (length children)))
- (let ((func (lambda (w) 0)))
- (XtSetValues container (list XmNinsertPosition func))
- (let ((func1 (cadr (XtGetValues container (list XmNinsertPosition 0)))))
- (if (not (equal? func func1)) (snd-display #__line__ ";XmNinsertPosition: ~A ~A" func func1))))))
-
- (with-level-meters 4)
- (play)
- (close-sound))
-
- ;; qualify proc is causing a segfault somehow
+ (let ((valf (XmTextFieldGetSelection txtf)))
+ (if (not (string=? valf "234")) (snd-display #__line__ ";XmTextFieldGetSelection: ~A" valf)))
+ (XmTextFieldClearSelection txtf current-time)
+ (let ((valf (XmTextFieldGetSelection txtf)))
+ (if valf (snd-display #__line__ ";XmTextFieldClearSelection: ~A" valf)))
+ (let ((val (XmTextGetInsertionPosition txt))
+ (valf (XmTextFieldGetInsertionPosition txtf)))
+ (if (not (= val 5)) (snd-display #__line__ ";XmTextGetInsertionPosition: ~A" val))
+ (if (not (= valf 5)) (snd-display #__line__ ";XmTextFieldGetInsertionPosition: ~A" val)))
+
+ (XmTextScroll txt 1)
+ (XmTextScroll txt -1)
+ (let ((pos (XmTextGetTopCharacter txt)))
+ (if (not (= pos 0)) (snd-display #__line__ ";XmTextGetTopCharacter after scroll: ~A" pos)))
+ (XmTextShowPosition txt 0)
+ (XmTextFieldShowPosition txtf 0)
+ (XmTextSetTopCharacter txt 0)
+ (XmTextXYToPos txt 10 10)
+ (XmTextFieldXYToPos txtf 10 10)
+
+ (XmTextSetHighlight txt 3 6 XmHIGHLIGHT_SELECTED)
+ (XmTextFieldSetHighlight txtf 3 6 XmHIGHLIGHT_SELECTED)
+ (XmTextFieldGetBaseline txtf)
+ (XmTextSetAddMode txt #t)
+ (if (not (XmTextGetAddMode txt)) (snd-display #__line__ ";XmTextSetAddMode?"))
+ (XmTextFieldSetAddMode txtf #t)
+ (if (not (XmTextFieldGetAddMode txtf)) (snd-display #__line__ ";XmTextFieldSetAddMode?"))
+
+ (if (not (string=? (vector-ref calls 5) "gain")) (snd-display #__line__ ";gain callback: ~A" (vector-ref calls 5)))
+ (if (not (string=? (vector-ref calls 7) "modify")) (snd-display #__line__ ";modify callback: ~A" (vector-ref calls 7)))
+ (if (not (string=? (vector-ref calls 8) "motion")) (snd-display #__line__ ";motion callback: ~A" (vector-ref calls 8)))
+ (if (not (string=? (vector-ref calls 9) "value")) (snd-display #__line__ ";value callback: ~A" (vector-ref calls 9)))
+
+ (let ((txtf1 (XtVaCreateManagedWidget "textfield" xmTextFieldWidgetClass frm
+ (list XmNeditable #t
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget txt
+ XmNbottomAttachment XmATTACH_FORM
+ XmNdestinationCallback
+ (list (lambda (w c info)
+ (let* ((dpy (XtDisplay w))
+ (TARGETS (XmInternAtom dpy "TARGETS" #f)))
+ (XmTransferValue (.transfer_id info)
+ TARGETS
+ transfer-proc
+ #f
+ (XtLastTimestampProcessed dpy))))
+ #f)))))
+ (focus-widget txtf1)
+ (XmTextFieldPaste txtf1)
+ (XmTextFieldPasteLink txtf1)
+ (if (not (Widget? (XmGetTabGroup txtf1))) (snd-display #__line__ ";XmGetTabGroup: ~A " (XmGetTabGroup txtf1)))
+ (let ((fw (XmGetFocusWidget (cadr (main-widgets)))))
+ (if (not (equal? fw txtf1))
+ (snd-display #__line__ ";XmGetFocusWidget: ~A" fw)))
+ (let ((callback (lambda (w context ev flag)
+ (XtSetValues w (list XmNbackground (white-pixel))))))
+ (XtAddEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtRemoveEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtAddRawEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtRemoveRawEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtInsertEventHandler txtf1 EnterWindowMask #f callback #f XtListHead)
+ (XtRemoveEventHandler txtf1 EnterWindowMask #f callback #f)
+ (XtInsertRawEventHandler txtf1 EnterWindowMask #f callback #f XtListTail)
+ (XtRemoveRawEventHandler txtf1 EnterWindowMask #f callback #f))
+ (XtRemoveAllCallbacks txtf1 XmNdestinationCallback))
+ (XtAppAddActions (car (main-widgets)) (list (list "hiho" (lambda args (snd-print "hiho")))))
+ (XtAugmentTranslations txt (XtParseTranslationTable "Ctrl <Key>i: hiho()\n"))
+ (XtCallActionProc txt "hiho" (XEvent) #f 0)
+ (XtUninstallTranslations txt)
+ (XtUnmanageChild frm)))
+
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell))
+ (win (XtWindow shell))
+ (err (XmClipboardRegisterFormat dpy "SND_DATA" 8)))
+ (if (not (= err ClipboardSuccess))
+ (snd-display #__line__ ";XmClipboardRegisterFormat: ~A" err)
+ (let ((vals (XmClipboardStartCopy dpy win
+ (XmStringCreateLocalized "SND_DATA")
+ (list 'Time CurrentTime)
+ shell
+ (lambda (w id pid reason)
+ (XmClipboardCopyByName dpy win id "copy this" 10 123)))))
+ (if (not (= (car vals) ClipboardSuccess))
+ (snd-display #__line__ ";XmClipboardStartCopy: ~A" vals)
+ (let ((data-id (cadr vals)))
+ (set! err (XmClipboardCopy dpy win data-id "SND_DATA" "copy this" 10 0))
+ (if (not (= (car err) ClipboardSuccess)) (snd-display #__line__ ";XmClipboardCopy: ~A" err))
+ (let ((item-id (cadr err)))
+ (set! err (XmClipboardEndCopy dpy win data-id))
+ (if (not (= err ClipboardSuccess)) (snd-display #__line__ ";copy ~A" err))
+ (if (not (= (cadr (XmClipboardInquireLength dpy win "SND_DATA")) 10))
+ (snd-display #__line__ ";clip len: ~A" (XmClipboardInquireLength dpy win "SND_DATA")))
+ (let ((pend (XmClipboardInquirePendingItems dpy win "SND_DATA")))
+ (if (not (= (car pend) ClipboardSuccess)) (snd-display #__line__ ";XmClipboardInquirePendingItems: ~A" pend)))
+ (let ((formats1 (XmClipboardInquireCount dpy win)))
+ (if (= (cadr formats1) 0) (snd-display #__line__ ";XmClipboardInquireCount: ~A" formats1))
+ (XmClipboardInquireFormat dpy win 1 10)
+ (let ((clip (XmClipboardRetrieve dpy win "SND_DATA" 10)))
+ (if (not (string=? (cadr clip) "copy this")) (snd-display #__line__ ";XmClipboardRetrieve: ~A" clip))
+ (XmClipboardWithdrawFormat dpy win item-id))))))))
+ (let ((val (XmClipboardLock dpy win)))
+ (if (not (= val ClipboardLocked))
+ (XmClipboardUnlock dpy win #t)))
+ (let ((selbox (XmCreateSelectionBox shell "selbox" () 0)))
+ (XmSelectionBoxGetChild selbox XmDIALOG_APPLY_BUTTON)))
+
+ (let* ((frm (add-main-pane "hi" xmFormWidgetClass (list XmNpaneMinimum 120)))
+ (current-time (list 'Time CurrentTime))
+ (box (XtCreateManagedWidget "box" xmContainerWidgetClass frm ()))
+ (tgl (XtCreateManagedWidget "tgl" xmToggleButtonWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE)))
+ (tgg (XtCreateManagedWidget "tgg" xmToggleButtonGadgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget tgl
+ XmNbottomAttachment XmATTACH_NONE)))
+ (spn (XtCreateManagedWidget "spn" xmSimpleSpinBoxWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget tgg
+ XmNbottomAttachment XmATTACH_NONE)))
+ (cmd (XtCreateManagedWidget "cmd" xmCommandWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget spn
+ XmNbottomAttachment XmATTACH_NONE)))
+ (scl (XtCreateManagedWidget "scl" xmScaleWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget cmd
+ XmNbottomAttachment XmATTACH_NONE)))
+ (notes (XtCreateManagedWidget "notes" xmNotebookWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget scl
+ XmNbottomAttachment XmATTACH_NONE)))
+
+ (cmb (XtCreateManagedWidget "cmb" xmComboBoxWidgetClass frm
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_WIDGET
+ XmNtopWidget notes
+ XmNbottomAttachment XmATTACH_FORM)))
+ (toggled 0))
+ (XtCreateManagedWidget "one" xmPushButtonWidgetClass notes ())
+ (XtCreateManagedWidget "two" xmPushButtonWidgetClass notes ())
+ (let ((info (cadr (XmNotebookGetPageInfo notes 1))))
+ (if (not (= (.page_number info) 1)) (snd-display #__line__ ";page_number: ~A" (.page_number info)))
+ (if (.page_widget info) (snd-display #__line__ ";page_widget: ~A" (.page_widget info)))
+ (if (.status_area_widget info) (snd-display #__line__ ";status_area_widget: ~A" (.status_area_widget info)))
+ (if (not (Widget? (.major_tab_widget info))) (snd-display #__line__ ";major_tab_widget: ~A" (.major_tab_widget info)))
+ (if (.minor_tab_widget info) (snd-display #__line__ ";minor_tab_widget: ~A" (.minor_tab_widget info)))
+ ;(segfault) (XtFree (cadr info))
+ )
+
+ (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "hiho") 0)
+ (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "away") 0)
+ (XmSimpleSpinBoxDeletePos spn 0)
+ (let ((vals (XtVaGetValues spn (list XmNvalues 0))))
+ (XmSimpleSpinBoxSetItem spn (caadr vals)))
+ (XmSimpleSpinBoxAddItem spn (XmStringCreateLocalized "another") 0)
+ (let ((vals (XtGetValues spn (list XmNeditable 0 XmNtextField 0))))
+ (if (not (vals 1)) (snd-display #__line__ ";XmNeditable spin box"))
+ (if (not (Widget? (vals 3))) (snd-display #__line__ ";XmNtextField: ~A" (vals 3))))
+
+ (XtAddCallback tgl XmNvalueChangedCallback (lambda (w c i) (set! toggled 123)) #f)
+ (XmToggleButtonSetState tgl #f #f)
+ (XmToggleButtonGadgetSetState tgg #f #f)
+ (if (not (= toggled 0)) (snd-display #__line__ ";toggle calledback: ~A?" toggled))
+ (if (XmToggleButtonGetState tgl) (snd-display #__line__ ";XmToggleButtonSetState #f"))
+ (if (XmToggleButtonGadgetGetState tgg) (snd-display #__line__ ";XmToggleButtonGadgetSetState #f"))
+ (XtVaSetValues tgl (list XmNtoggleMode XmTOGGLE_INDETERMINATE))
+ (XmToggleButtonSetValue tgl XmINDETERMINATE #t)
+ (XmToggleButtonGadgetSetValue tgg XmINDETERMINATE #t)
+ (if (not (= toggled 123)) (snd-display #__line__ ";toggle not calledback: ~A?" toggled))
+
+ (XmCommandAppendValue cmd (XmStringCreateLocalized "hiho"))
+ (XmCommandError cmd (XmStringCreateLocalized "hiho"))
+ (if (not (Widget? (XmCommandGetChild cmd XmDIALOG_COMMAND_TEXT)))
+ (snd-display #__line__ ";XmCommandGetChild: ~A" (XmCommandGetChild cmd XmDIALOG_COMMAND_TEXT)))
+ (XmCommandSetValue cmd (XmStringCreateLocalized "hiho"))
+
+ (let ((one1 (XmStringCreateLocalized "one"))
+ (two1 (XmStringCreateLocalized "two"))
+ (three1 (XmStringCreateLocalized "three")))
+ (XmComboBoxAddItem cmb one1 0 #f)
+ (XmComboBoxAddItem cmb two1 0 #f)
+ (XmComboBoxAddItem cmb three1 0 #f)
+ (XmComboBoxDeletePos cmb 1)
+ (XmComboBoxSelectItem cmb three1)
+ (XmComboBoxSetItem cmb three1) ; hunh??
+ (XmComboBoxUpdate cmb)
+ (let ((vals (cadr (XtGetValues cmb (list XmNitems 0)))))
+ (if (not (equal? vals (list two1 three1))) (snd-display #__line__ ";XmComboBox: ~A" vals))))
+
+ (XmContainerCut box current-time)
+ (XmContainerCopy box current-time)
+ (XmContainerPaste box)
+ (XmContainerCopyLink box (list 'Time CurrentTime))
+ (XmContainerPasteLink box)
+ (let ((vals (XtVaGetValues box (list XmNlargeIconX 0 XmNlargeIconY 0))))
+ (if (or (null? (cdr vals))
+ (not (real? (cadr vals)))
+ (fneq (cadr vals) 0.0)
+ (null? (cdddr vals))
+ (not (real? (cadddr vals)))
+ (fneq (cadddr vals) 0.0))
+ (snd-display #__line__ ";xm-float resource vals: ~A" vals)))
+
+ (XtAddCallback scl XmNvalueChangedCallback (lambda (w c i) #f))
+ (XmScaleSetValue scl 25)
+ (if (not (= (XmScaleGetValue scl) 25)) (snd-display #__line__ ";XmScaleSetValue: ~A" (XmScaleGetValue scl)))
+ (if (XmGetTearOffControl (car (menu-widgets))) (snd-display #__line__ ";XmGetTearOffControl: ~A" (XmGetTearOffControl (car (menu-widgets)))))
+ (let ((children (cadr (XtGetValues scl (list XmNchildren 0)))))
+ (for-each
+ (lambda (w)
+ (let ((name (XtName w)))
+ (if (and (XmIsSeparatorGadget w)
+ (member name '("BigTic" "MedTic" "SmallTic") string=?))
+ (XtDestroyWidget w))))
+ children))
+ (XmScaleSetTicks scl 5 2 0 10 5 0)
+ )
+
+ (XmSetColorCalculation #f)
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (scr1 (DefaultScreen dpy))
+ (cmap (DefaultColormap dpy scr1))
+ (screen (XDefaultScreenOfDisplay dpy))
+ (scr (XmGetXmScreen (XDefaultScreenOfDisplay dpy)))
+ ;(old-h (cadr (XtVaGetValues scr (list XmNhorizontalFontUnit 0))))
+ ;(old-v (cadr (XtVaGetValues scr (list XmNverticalFontUnit 0))))
+ )
+ (if (not (XmIsScreen scr)) (snd-display #__line__ ";XmIsScreen: ~A" scr))
+ (let ((colors (XmGetColors screen cmap *basic-color*)))
+ (if (not (Pixel? (car colors)))
+ (snd-display #__line__ ";colors: ~A " colors))
+ (let ((color-proc (lambda (bg)
+ (list (white-pixel) (black-pixel) (white-pixel) (black-pixel)))))
+ (XmSetColorCalculation color-proc)
+ (if (not (equal? (XmGetColorCalculation) color-proc))
+ (snd-display #__line__ ";XmSetColorcalulcation ~A" (XmGetColorCalculation)))))
+ (let ((vals (XtVaGetValues scr
+ (list XmNbitmapConversionModel 0 XmNdarkThreshold 0 XmNfont 0 XmNunpostBehavior 0))))
+ (if (not (= (vals 1) XmMATCH_DEPTH)) (snd-display #__line__ ";XmNbitmapConversionModel: ~A" (vals 1)))
+ (if (not (= (vals 3) 0)) (snd-display #__line__ ";XmNdarkThreshold: ~A" (vals 3)))
+ (if (not (XFontStruct? (vals 5))) (snd-display #__line__ ";XmNfont: ~A" (vals 5)))
+ (if (not (= (vals 7) XmUNPOST_AND_REPLAY)) (snd-display #__line__ ";XmNunpostBehavior: ~A" (vals 7)))
+ (XSetScreenSaver dpy -1 5 DefaultBlanking DefaultExposures)
+ ))
+ (let ((dpy (XtDisplay (cadr (main-widgets)))))
+ (let* ((dp (XmGetXmDisplay dpy))
+ (vals (XtVaGetValues dp
+ (list XmNdragInitiatorProtocolStyle 0 XmNenableThinThickness 0 XmNmotifVersion 0))))
+ (if (not (XmIsDisplay dp)) (snd-display #__line__ ";XmIsDisplay: ~A" dp))
+ (if (not (= (vals 1) XmDRAG_PREFER_RECEIVER)) (snd-display #__line__ ";XmNdragInitiatorProtocolStyle: ~A" (vals 1)))
+ (if (not (vals 3)) (snd-display #__line__ ";XmNenableThinThickness?"))
+ (if (not (= (vals 5) 2002)) (snd-display #__line__ ";XmGetXmDisplay motif version: ~A" (vals 5)))
+ (XtAddCallback dp XmNdragStartCallback (lambda (w c i) #f)))
+
+ (if (not (string=? (XmCvtXmStringToCT (XmStringCreateLocalized "hiho")) "hiho"))
+ (snd-display #__line__ ";XmCvtXmStringToCT: ~A" (XmCvtXmStringToCT (XmStringCreateLocalized "hiho"))))
+ (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmINCHES)))
+ (if (not (= val 3)) (snd-display #__line__ ";XmConvertStringToUnits in->in ~A" val)))
+ (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmPOINTS)))
+ (if (not (= val 225)) (snd-display #__line__ ";XmConvertStringToUnits in->pts ~A" val)))
+ (let ((val (XmConvertStringToUnits (XDefaultScreenOfDisplay dpy) "3.14 in" XmHORIZONTAL XmCENTIMETERS)))
+ (if (not (= val 7)) (snd-display #__line__ ";XmConvertStringToUnits in->cm ~A" val)))
+ (let ((val (XmConvertUnits (cadr (main-widgets)) XmHORIZONTAL XmCENTIMETERS 7 XmMILLIMETERS)))
+ (if (not (= val 70)) (snd-display #__line__ ";XmConvertUnits cm->mm ~A" val)))
+ (let ((val (XmConvertUnits (cadr (main-widgets)) XmHORIZONTAL XmCENTIMETERS 7 XmPIXELS)))
+ (if (and (not (= val 278)) (not (= val 273))) (snd-display #__line__ ";XmConvertUnits cm->pix ~A" val)))
+ (XmVaCreateSimpleRadioBox (caddr (main-widgets)) "hiho" 0 (lambda (w c i) #f) ())
+ (XmVaCreateSimpleCheckBox (caddr (main-widgets)) "hiho" (lambda (w c i) #f) ())
+ (XmVaCreateSimplePulldownMenu (caddr (main-widgets)) "hiho" 0 (lambda (w c i) #f) ())
+ (XmVaCreateSimplePopupMenu (caddr (main-widgets)) "hiho" (lambda (w c i) #f) ())
+ (XmVaCreateSimpleMenuBar (caddr (main-widgets)) "hiho" ())
+ (zync)
+ (make-pixmap (cadr (main-widgets)) arrow-strs)
+ ;(display-scanned-synthesis) -- needs updating
+ (add-mark-pane)
+ (let ((ind (open-sound "oboe.snd")))
+ (snd-clock-icon ind 6)
+ (add-tooltip (cadr (channel-widgets)) "the w button")
+ (with-minmax-button ind)
+ (make-channel-drop-site ind 0)
+ (set-channel-drop (lambda (file s c) (snd-print file)) ind 0)
+ (let ((drop-site (find-child (XtParent (XtParent ((channel-widgets ind 0) 7))) "drop here")))
+ (if drop-site
+ (begin
+ (XtVaGetValues drop-site (list XmNdropRectangles 0))
+ (let ((val (XmDropSiteRetrieve drop-site (list XmNnumImportTargets 0))))
+ (if (not (= (cadr val) 1)) (snd-display #__line__ ";XmDropSiteRetrieve num: ~A" val)))
+ (XmDropSiteRetrieve drop-site (list XmNimportTargets 0))
+ (if (not (XmDropSiteRegistered drop-site))
+ (snd-display #__line__ ";XmDropSiteRegistered?"))
+ (XmDropSiteUnregister drop-site))
+ (snd-display #__line__ ";no drop site?"))))
+
+ (add-mark 123)
+ (let ((container
+ (make-sound-box "sounds"
+ ((main-widgets) 3)
+ (lambda (file)
+ (mix file))
+ (lambda (file chn)
+ (define (without-directories filename)
+ (call-with-exit
+ (lambda (return)
+ (do ((i (- (length filename) 1) (- i 1)))
+ ((= i 0) filename)
+ (if (char=? (filename i) #\/)
+ (return (substring filename (+ i 1))))))))
+ (format #f "~~/peaks/~A-peaks-~D"
+ (snd-test-clean-string (mus-expand-filename file))
+ chn))
+ (list "oboe.snd" "pistol.snd" "cardinal.snd" "storm.snd")
+ ())))
+ (XmContainerRelayout container)
+ (let ((vals (XtVaGetValues container
+ (list XmNlargeCellHeight 0 XmNcollapsedStatePixmap 0 XmNdetailOrder 0 XmNdetailTabList 0
+ XmNselectedObjects 0 XmNconvertCallback 0 XmNdestinationCallback 0 XmNselectionCallback 0))))
+ (if (not (= (vals 1) 0)) (snd-display #__line__ ";XmNlargeCellHeight: ~A" (vals 1)))
+ (if (not (Pixmap? (vals 3))) (snd-display #__line__ ";XmNcollapsedStatePixmap: ~A" (vals 3)))
+ (let ((children ()))
+ (for-each-child container
+ (lambda (w)
+ (if (XmIsIconGadget w)
+ (set! children (cons w children)))))
+ (XmContainerReorder container children (length children)))
+ (let ((func (lambda (w) 0)))
+ (XtSetValues container (list XmNinsertPosition func))
+ (let ((func1 (cadr (XtGetValues container (list XmNinsertPosition 0)))))
+ (if (not (equal? func func1)) (snd-display #__line__ ";XmNinsertPosition: ~A ~A" func func1))))))
+ (close-sound))
+
+ ;; qualify proc is causing a segfault somehow
; (let ((box (XmCreateFileSelectionBox (cadr (main-widgets)) "box"
; (list XmNfileSearchProc (lambda (w c) #f)
; XmNqualifySearchDataProc (lambda (w c i)
; (display "qualifier was called!")
; )))))
; (XtUnmanageChild box))
- (let ((hi (XtCreateManagedWidget "hi" xmTextWidgetClass (cadr (main-widgets))
- (list XmNqualifySearchDataProc (lambda (w c i) "hi")
- XmNtransferProc (lambda (a b c d e f g) "ho")
- XmNcolorAllocationProc (lambda (a b c) #f)
- XmNcolorCalculationProc (lambda (a b) #f)
- XmNcreatePopupChildProc (lambda (a) #f)
- XmNlargeIconX 0.5
- ))))
- (XtVaSetValues hi (list XmNqualifySearchDataProc (lambda (w c i) "hi")
- XmNtransferProc (lambda (a b c d e f g) "ho")
- XmNcolorAllocationProc (lambda (a b c) #f)
- XmNcolorCalculationProc (lambda (a b) #f)
- XmNcreatePopupChildProc (lambda (a) #f)))
- (XtVaSetValues hi (list XmNqualifySearchDataProc #f
- XmNcolorAllocationProc #f
- XmNcolorCalculationProc #f
- XmNcreatePopupChildProc #f
- XmNx 10
- XmNsource (XmTextGetSource hi)
- ))
- (XtUnmanageChild hi))
-
- (if (and (defined? 'XmCreateFontSelector)
- (defined? 'XmCreateColorSelector))
- (let ((fonts-dialog #f)
- (colors-dialog #f))
- (for-each
- (lambda (make-dialog)
- (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Fonts" XmFONTLIST_DEFAULT_TAG))
- (new-dialog (XmCreateTemplateDialog
- (cadr (main-widgets)) "Fonts"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNokLabelString xok
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNtransient #f))))
- (XtAddCallback new-dialog XmNcancelCallback (lambda (w c i) (XtUnmanageChild w)))
- (XtAddCallback new-dialog XmNhelpCallback (lambda (w c i) (help-dialog "Fonts" "no help yet")))
- (XtAddCallback new-dialog XmNokCallback (lambda (w c i) (XtUnmanageChild w)))
- (XmStringFree xhelp)
- (XmStringFree xok)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (if (not fonts-dialog)
- (set! fonts-dialog new-dialog)
- (set! colors-dialog new-dialog))
- (let* ((mainform (XtCreateManagedWidget "mainform" xmFormWidgetClass new-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild new-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color))))
- (fnts (make-dialog mainform)))
- (XtManageChild fnts)
- (if (not colors-dialog)
- (XtManageChild fonts-dialog)
- (XtManageChild colors-dialog)))))
- (list
- (lambda (mainform)
- (XmCreateFontSelector mainform "Fonts"
- (list XmNbackground (basic-color)
- XmNcurrentFont "-*-times-bold-r-*-*-14-140-*-*-*-*-*-*"
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE)))
-
- (lambda (mainform)
- (XmCreateColorSelector mainform "Colors"
- (list XmNbackground (basic-color)
- XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_NONE)))))
- (XtUnmanageChild fonts-dialog)
- (XtUnmanageChild colors-dialog)))
-
- (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Fonts" XmFONTLIST_DEFAULT_TAG))
- (new-dialog (XmCreateTemplateDialog
- (cadr (main-widgets)) "Fonts"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNokLabelString xok
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNtransient #f))))
- (XmStringFree xhelp)
- (XmStringFree xok)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (let* ((mainform (XtCreateManagedWidget "mainform" xmFormWidgetClass new-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild new-dialog XmDIALOG_SEPARATOR)
- XmNbackground (basic-color))))
- (fnts
- (if (defined? 'XmIsColumn)
- (let* ((w1 (XmCreateColumn mainform "column" '()))
- (w1-child (XtCreateManagedWidget "hihi" xmLabelWidgetClass w1 '() 0))
- (w2 (XtCreateManagedWidget "column1" xmColumnWidgetClass mainform '() 0)))
- (if (or (not (XmIsColumn w1))
- (not (XmIsColumn w2))
- (not (XmColumn? w1)))
- (snd-display #__line__ ";XmIsColumn: ~A ~A" w1 w2))
- (if (defined? 'XmColumnGetChildLabel)
- (let ((child (XmColumnGetChildLabel w1)))
- (if (or (not (child)) (not (equal? child w1-child)))
- (snd-display #__line__ ";XmColumn child: ~A ~A" child w1-child))))
- (XtManageChild w1)
- w1)
- #f))
- (fntt
- (if (defined? 'XmIsButtonBox)
- (let ((w1 (XmCreateButtonBox mainform "box" (list XmNfillOption XmFillMajor))))
- (if (or (not (XmIsButtonBox w1))
- (not (XmButtonBox? w1)))
- (snd-display #__line__ ";XmIsButtonBox: ~A ~A ~A" w1 (XmIsButtonBox w1) (XmButtonBox? w1)))
- (XtManageChild w1)
- w1)
- #f))
- (fntd
- (if (defined? 'XmIsDropDown)
- (let ((w1 (XmCreateDropDown mainform "drop" '())))
- (if (or (not (XmIsDropDown w1))
- (not (XmDropDown? w1)))
- (snd-display #__line__ ";XmIsDropDown: ~A ~A ~A" w1 (XmIsDropDown w1) (XmDropDown? w1)))
- (XtManageChild w1)
- (let ((text (XmDropDownGetText w1))
- (label (XmDropDownGetLabel w1))
- (arrow (XmDropDownGetArrow w1))
- (lst (XmDropDownGetList w1))
- (str (XmDropDownGetValue w1)))
- (if (not (XmTextField? text)) (snd-display #__line__ ";dropdown text: ~A" text))
- (if (not (XmLabel? label)) (snd-display #__line__ ";dropdown label: ~A" label))
- (if (not (XmArrowButton? arrow)) (snd-display #__line__ ";dropdown arrow: ~A" arrow))
- (if (not (XmList? lst)) (snd-display #__line__ ";dropdown lst: ~A" text))
- w1))
- #f))
- (fntda
- (if (defined? 'XmIsDataField)
- (let ((w1 (XmCreateDataField mainform "data" '())))
- (if (or (not (XmIsDataField w1))
- (not (XmDataField? w1)))
- (snd-display #__line__ ";XmIsDataField: ~A ~A ~A" w1 (XmIsDataField w1) (XmDataField? w1)))
- (let ((str (XmDataFieldGetString w1))
- (sel (XmDataFieldGetSelection w1)))
- (XmDataFieldSetString w1 "hiho")
- (XmDataFieldSetEditable w1 #t)
- (XmDataFieldSetAddMode w1 #f)
- (XmDataFieldShowPosition w1 0)
- (XmDataFieldXYToPos w1 0 0)
- (XmDataFieldSetHighlight w1 0 0 0)
- (let ((sel1 (XmDataFieldGetSelectionPosition w1)))
- (XmDataFieldSetSelection w1 0 0 '(Time 0)))
- (XmDataFieldCopy w1 '(Time 0))
- ;(XmDataFieldPaste w1) ; x error
- (XmDataFieldCut w1 '(Time 0))
- w1))
- #f))
- (fnttab
- (if (defined? 'XmIsTabStack)
- (let ((w1 (XmCreateTabStack mainform "hi" '())))
- (if (or (not (XmIsTabStack w1))
- (not (XmTabStack? w1)))
- (snd-display #__line__ ";XmIsTabStack: ~A ~A ~A" w1 (XmIsTabStack w1) (XmTabStack? w1)))
- (let ((tab (XmTabStackGetSelectedTab w1)))
- (XmTabStackSelectTab w1 #f)
- w1))
- #f)))
-
- (if (and (defined? 'XmToolTipGetLabel)
- (defined? 'XmNtoolTipString))
- (let ((wid1 (XtCreateManagedWidget "wid1" xmPushButtonWidgetClass mainform
- (list XmNtoolTipString (XmStringCreateLocalized "tooltip")
- XmNtoolTipPostDelay 100
- XmNtoolTipPostDuration 500
- XmNtoolTipEnable #t
- XmNanimate #f))))
- (let ((tip (XmToolTipGetLabel wid1)))
- (if (not (Widget? tip)) (snd-display #__line__ ";tooltip label: ~A" tip)))))
-
- (XtManageChild new-dialog)
- (XtUnmanageChild new-dialog)))
-
- (let* ((shell (cadr (main-widgets)))
- (dpy (XtDisplay shell))
- (prop (XmInternAtom dpy "TESTING" #f))
- (proto1 (XmInternAtom dpy "TEST1" #f))
- (proto2 (XmInternAtom dpy "TEST2" #f))
- (val 0))
- (if (not (Atom? prop)) (snd-display #__line__ ";XmInternAtom: ~A" prop))
- (if (not (string=? (XmGetAtomName dpy prop) "TESTING")) (snd-display #__line__ ";XmGetAtomName: ~A" (XmGetAtomName dpy prop)))
- (XmAddProtocols shell prop (list proto1 proto2))
- (XmSetProtocolHooks shell
- (XmInternAtom dpy "WM_PROTOCOLS" #f)
- prop
- (lambda (w c i)
- (snd-display #__line__ ";prehook: ~A ~A ~A" w c i))
- 12345
- (lambda (w c i)
- (snd-display #__line__ ";posthook: ~A ~A ~A" w c i))
- 54321)
- (XmDeactivateProtocol shell prop proto2)
- (XmRemoveProtocols shell prop (list proto2))
- (XmAddProtocolCallback shell prop proto1 (lambda (w c i) (set! val c)) 123)
- (XmActivateProtocol shell prop proto1)
- (let ((e (XEvent ClientMessage))
- (window (XtWindow shell)))
- (set! (.window e) window)
- (set! (.display e) dpy)
- (set! (.format e) 8)
- (set! (.message_type e) XA_STRING)
- (set! (.data e) "hiho")
- (XSendEvent dpy window #f 0 e))
- (XmRemoveProtocols shell prop (list proto1)))
- (XmCascadeButtonHighlight (XmCreateCascadeButton (cadr (main-widgets)) "cascade" '()) #f)
- ;(XmCascadeButtonGadgetHighlight (XmCreateCascadeButtonGadget (cadr (main-widgets)) "gadget" '()) #f)
-
- (let ((callbacks
- (list
- (list XmAnyCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event))
- (list XmArrowButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .click_count 'int '.click_count))
- (list XmCommandCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .value 'XmString '.value) (list .length 'int '.length #f))
- (list XmDragDropFinishCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp))
- (list XmDragMotionCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
- (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f))
- (list XmDragProcCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .dragContext 'Widget '.dragContext #f)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f) (list .animate 'Boolean '.animate #f))
- (list XmDrawingAreaCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .window 'Window '.window))
- (list XmDrawnButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .window 'Window '.window) (list .click_count 'int '.click_count))
- (list XmDropFinishCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
- (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .dropAction 'uchar '.dropAction #f) (list .completionStatus 'uchar '.completionStatus #f))
- (list XmDropProcCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .dragContext 'Widget '.dragContext #f)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f) (list .dropAction 'uchar '.dropAction #f))
- (list XmDropSiteEnterCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
- (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f))
- (list XmDropSiteLeaveCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp))
- (list XmDropStartCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
- (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
- (list .dropAction 'uchar '.dropAction #f))
- (list XmFileSelectionBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .value 'XmString '.value) (list .length 'int '.length #f) (list .mask 'XmString '.mask #f)
- (list .mask_length 'int '.mask_length #f) (list .dir 'XmString '.dir #f) (list .dir_length 'int '.dir_length #f)
- (list .pattern 'XmString '.pattern #f) (list .pattern_length 'int '.pattern_length #f))
- (list XmListCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .item 'XmString '.item #f) (list .item_length 'int '.item_length #f) (list .item_position 'int '.item_position #f)
- (list .selected_items 'XmString* '.selected_items) (list .selected_item_count 'int '.selected_item_count #f)
- (list .selected_item_positions 'int* '.selected_item_positions) (list .selection_type 'char '.selection_type #f)
- (list .auto_selection_type 'char '.auto_selection_type #f))
- (list XmOperationChangedCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f)
- (list .dropSiteStatus 'uchar '.dropSiteStatus))
- (list XmPushButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .click_count 'int '.click_count))
- (list XmRowColumnCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .widget 'Widget '.widget #f) (list .data 'char* '.data #f) (list .callbackstruct 'char* '.callbackstruct #f))
- (list XmScaleCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .value 'int '.value))
- (list XmScrollBarCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .value 'int '.value) (list .pixel 'int '.pixel #f))
- (list XmSelectionBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .value 'XmString '.value) (list .length 'int '.length #f))
- (list XmTextVerifyCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .doit 'Boolean '.doit) (list .currInsert 'int '.currInsert #f) (list .newInsert 'int '.newInsert #f)
- (list .startPos 'int '.startPos #f) (list .endPos 'int '.endPos #f)
- (list .text 'XmTextBlock '.text #f))
- (list XmToggleButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .set 'int '.set))
- (list XmDestinationCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .selection 'Atom '.selection #f) (list .operation 'uchar '.operation) (list .flags 'int '.flags #f)
- (list .transfer_id 'XtPointer '.transfer_id #f) (list .destination_data 'XtPointer '.destination_data #f)
- (list .location_data 'XtPointer '.location_data #f) (list .time 'Time '.time))
- (list XmConvertCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .selection 'Atom '.selection #f)
- (list .target 'Atom '.target #f) (list .source_data 'XtPointer '.source_data #f)
- (list .location_data 'XtPointer '.location_data #f) (list .flags 'int '.flags #f) (list .parm 'XtPointer '.parm #f)
- (list .parm_format 'int '.parm_format #f) (list .parm_length 'int '.parm_length #f)
- (list .parm_type 'Atom '.parm_type #f) (list .status 'int '.status #f) (list .value 'XtPointer '.value #f)
- (list .type 'Atom '.type #f) (list .format 'int '.format #f) (list .length 'int '.length #f))
- (list XmComboBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .item_or_text 'XmString '.item_or_text #f) (list .item_position 'int '.item_position #f))
- (list XmContainerOutlineCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .item 'Widget '.item #f) (list .new_outline_state 'uchar '.new_outline_state #f))
- (list XmContainerSelectCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .selected_items 'Widget* '.selected_items) (list .selected_item_count 'int '.selected_item_count #f)
- (list .auto_selection_type 'uchar '.auto_selection_type #f))
- (list XmNotebookCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .page_number 'int '.page_number #f) (list .page_widget 'Widget '.page_widget #f)
- (list .prev_page_number 'int '.prev_page_number #f) (list .prev_page_widget 'Widget '.prev_page_widget #f))
- (list XmSpinBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .widget 'Widget '.widget #f) (list .doit 'Boolean '.doit) (list .position 'int '.position #f)
- (list .value 'XmString '.value #f) (list .crossed_boundary 'Boolean '.crossed-boundary #f))
- (list XmTraverseObscuredCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .traversal_destination 'Widget '.traversal_destination #f))
- (list XmTopLevelLeaveCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .screen 'Screen '.screen) (list .window 'Window '.window))
- (list XmTopLevelEnterCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .timeStamp 'Time '.timeStamp) (list .screen 'Screen '.screen) (list .window 'Window '.window)
- (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dragProtocolStyle 'uchar '.dragProtocolStyle #f))
- (list XmPopupHandlerCallbackStruct (list .reason 'int '.reason)
- (list .event 'XEvent '.event) (list .menuToPost 'Widget '.menuToPost) (list .postIt 'Boolean '.postIt)
- (list .target 'Widget '.target #f))
- (list XmSelectionCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .selection 'Atom '.selection #f) (list .target 'Atom '.target #f) (list .type 'Atom '.type #f)
- (list .transfer_id 'XtPointer '.transfer_id #f) (list .flags 'int '.flags #f) (list .remaining 'int '.remaining #f)
- (list .value 'XtPointer '.value #f) (list .length 'int '.length #f) (list .format 'int '.format #f))
- (list XmTransferDoneCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .selection 'Atom '.selection #f) (list .transfer_id 'XtPointer '.transfer_id #f) (list .status 'int '.status #f)
- (list .client_data 'XtPointer '.client_data #f))
- (list XmDisplayCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .font_name 'char* '.font_name #f) (list .tag 'int '.tag #f)
- (list .render_table 'XmRenderTable '.render_table #f)
- (list .rendition 'XmRendition '.rendition #f))
- (list XmDragStartCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
- (list .widget 'Widget '.widget #f) (list .doit 'Boolean '.doit))
- )))
-
-
- (for-each
- (lambda (call)
- (let ((struct ((car call)))
- (val #f))
- (set! (.event struct) (XEvent))
- (for-each
- (lambda (field)
- (if (not (pair? field)) (snd-display #__line__ ";~A: ~A" struct field))
- (set! val ((car field) struct))
- (if (< (length field) 4)
- (case (cadr field)
- ((int) (set! ((car field) struct) 0))
- ((Atom) (set! ((car field) struct) XA_STRING))
- ((uchar) (set! ((car field) struct) 0))
- ((Position) (set! ((car field) struct) 0))
- ((Widget) (set! ((car field) struct) (list 'Widget 0)))
- ((XmString) (set! ((car field) struct) (list 'XmString 0)))
- ((XtPointer) (set! ((car field) struct) 0))
- ((char*) (set! ((car field) struct) "hi"))
- ((Boolean) (set! ((car field) struct) #f))
- ((XEvent) #f) ; already being set
- ((XmString* int* Time Window Widget* Screen) #f)
- ((char) (set! ((car field) struct) 0))
- )))
- (cdr call))))
- callbacks)
- )
-
- (let ((shell (cadr (main-widgets)))
- (resource-list
- (list
- (list XmNaccelerator XM_STRING) (list XmNacceleratorText XM_XMSTRING) (list XmNaccelerators XM_ULONG)
- (list XmNactivateCallback XM_CALLBACK) (list XmNadjustLast XM_BOOLEAN) (list XmNadjustMargin XM_BOOLEAN)
- (list XmNalignment XM_UCHAR) (list XmNallowOverlap XM_BOOLEAN) (list XmNallowResize XM_BOOLEAN)
- (list XmNallowShellResize XM_BOOLEAN) (list XmNancestorSensitive XM_BOOLEAN) (list XmNanimationMask XM_PIXMAP)
- (list XmNanimationPixmap XM_PIXMAP) (list XmNanimationPixmapDepth XM_INT) (list XmNanimationStyle XM_UCHAR)
- (list XmNapplyCallback XM_CALLBACK) (list XmNapplyLabelString XM_XMSTRING) (list XmNargc XM_INT)
- (list XmNargv XM_STRING_LIST) (list XmNarmCallback XM_CALLBACK) (list XmNarmColor XM_PIXEL)
- (list XmNarmPixmap XM_PIXMAP) (list XmNarrowDirection XM_UCHAR) (list XmNattachment XM_UCHAR)
- (list XmNaudibleWarning XM_UCHAR) (list XmNautoShowCursorPosition XM_BOOLEAN) (list XmNautoUnmanage XM_BOOLEAN)
- (list XmNautomaticSelection XM_UCHAR) (list XmNbackground XM_PIXEL) (list XmNbackgroundPixmap XM_PIXMAP)
- (list XmNbaseHeight XM_INT) (list XmNbaseWidth XM_INT) (list XmNbitmap XM_PIXMAP)
- (list XmNblendModel XM_ULONG) (list XmNblinkRate XM_INT) (list XmNborderColor XM_PIXEL)
- (list XmNborderPixmap XM_PIXMAP) (list XmNborderWidth XM_DIMENSION) (list XmNbottomAttachment XM_UCHAR)
- (list XmNbottomOffset XM_INT) (list XmNbottomPosition XM_INT) (list XmNbottomShadowColor XM_PIXEL)
- (list XmNbottomShadowPixmap XM_PIXMAP) (list XmNbottomWidget XM_WIDGET) (list XmNbrowseSelectionCallback XM_CALLBACK)
- (list XmNbuttonAcceleratorText XM_STRING_TABLE) (list XmNbuttonAccelerators XM_STRING_TABLE) (list XmNbuttonCount XM_INT)
- (list XmNbuttonMnemonicCharSets XM_CHARSET_TABLE) (list XmNbuttonMnemonics XM_KEYSYM_TABLE) (list XmNbuttonSet XM_INT)
- (list XmNbuttonType XM_ULONG) (list XmNbuttons XM_STRING_TABLE) (list XmNcancelButton XM_WIDGET)
- (list XmNcancelCallback XM_CALLBACK) (list XmNcancelLabelString XM_XMSTRING) (list XmNcascadePixmap XM_PIXMAP)
- (list XmNcascadingCallback XM_CALLBACK) (list XmNchildHorizontalAlignment XM_UCHAR) (list XmNchildHorizontalSpacing XM_DIMENSION)
- (list XmNchildPlacement XM_UCHAR) (list XmNchildVerticalAlignment XM_UCHAR) (list XmNchildren XM_WIDGET_LIST)
- (list XmNclientData XM_ULONG) (list XmNclipWindow XM_WIDGET) (list XmNcolormap XM_COLORMAP)
- (list XmNcolumns XM_SHORT) (list XmNcommand XM_XMSTRING) (list XmNcommandChangedCallback XM_CALLBACK)
- (list XmNcommandEnteredCallback XM_CALLBACK) (list XmNcommandWindow XM_WIDGET) (list XmNcommandWindowLocation XM_UCHAR)
- (list XmNconvertProc XM_CONVERT_CALLBACK) (list XmNcreatePopupChildProc XM_POPUP_CALLBACK) (list XmNcursorBackground XM_PIXEL)
- (list XmNcursorForeground XM_PIXEL) (list XmNcursorPosition XM_INT) (list XmNcursorPositionVisible XM_BOOLEAN)
- (list XmNdarkThreshold XM_INT) (list XmNdecimalPoints XM_SHORT) (list XmNdecrementCallback XM_CALLBACK)
- (list XmNdefaultActionCallback XM_CALLBACK) (list XmNdefaultButton XM_WIDGET) (list XmNdefaultButtonShadowThickness XM_DIMENSION)
- (list XmNdefaultButtonType XM_UCHAR) (list XmNdefaultCopyCursorIcon XM_WIDGET) (list XmNdefaultInvalidCursorIcon XM_WIDGET)
- (list XmNdefaultLinkCursorIcon XM_WIDGET) (list XmNdefaultMoveCursorIcon XM_WIDGET) (list XmNdefaultNoneCursorIcon XM_WIDGET)
- (list XmNdefaultPosition XM_BOOLEAN) (list XmNdefaultSourceCursorIcon XM_WIDGET) (list XmNdefaultValidCursorIcon XM_WIDGET)
- (list XmNdeleteResponse XM_UCHAR) (list XmNdepth XM_INT) (list XmNdestroyCallback XM_CALLBACK)
- (list XmNdialogStyle XM_UCHAR) (list XmNdialogTitle XM_XMSTRING) (list XmNdialogType XM_UCHAR)
- (list XmNdirListItemCount XM_INT) (list XmNdirListItems XM_STRING_TABLE) (list XmNdirListLabelString XM_XMSTRING)
- (list XmNdirMask XM_XMSTRING) (list XmNdirSearchProc XM_SEARCH_CALLBACK) (list XmNdirSpec XM_XMSTRING)
- (list XmNdirectory XM_XMSTRING) (list XmNdirectoryValid XM_BOOLEAN) (list XmNdisarmCallback XM_CALLBACK)
- (list XmNdoubleClickInterval XM_INT) (list XmNdragDropFinishCallback XM_CALLBACK) (list XmNdragInitiatorProtocolStyle XM_UCHAR)
- (list XmNdragMotionCallback XM_CALLBACK) (list XmNdragOperations XM_UCHAR) (list XmNdragReceiverProtocolStyle XM_UCHAR)
- (list XmNdropFinishCallback XM_CALLBACK) (list XmNdropProc XM_DROP_CALLBACK) (list XmNdropRectangles XM_RECTANGLE_LIST)
- (list XmNdropSiteActivity XM_UCHAR) (list XmNdropSiteEnterCallback XM_CALLBACK) (list XmNdropSiteLeaveCallback XM_CALLBACK)
- (list XmNdropSiteOperations XM_UCHAR) (list XmNdropSiteType XM_UCHAR) (list XmNdropStartCallback XM_CALLBACK)
- (list XmNdropTransfers XM_TRANSFER_ENTRY_LIST) (list XmNeditMode XM_INT) (list XmNeditable XM_BOOLEAN)
- (list XmNentryAlignment XM_UCHAR) (list XmNentryBorder XM_DIMENSION) (list XmNentryCallback XM_CALLBACK)
- (list XmNentryClass XM_WIDGET_CLASS) (list XmNentryVerticalAlignment XM_UCHAR) (list XmNexportTargets XM_ATOM_LIST)
- (list XmNexposeCallback XM_CALLBACK) (list XmNextendedSelectionCallback XM_CALLBACK) (list XmNfileListItemCount XM_INT)
- (list XmNfileListItems XM_STRING_TABLE) (list XmNfileListLabelString XM_XMSTRING) (list XmNfileSearchProc XM_SEARCH_CALLBACK)
- (list XmNfileTypeMask XM_UCHAR) (list XmNfillOnArm XM_BOOLEAN) (list XmNfillOnSelect XM_BOOLEAN)
- (list XmNfilterLabelString XM_XMSTRING) (list XmNfocusCallback XM_CALLBACK) (list XmNfont XM_XFONTSTRUCT)
- (list XmNforeground XM_PIXEL) (list XmNforegroundThreshold XM_INT) (list XmNfractionBase XM_INT)
- (list XmNgainPrimaryCallback XM_CALLBACK) (list XmNgeometry XM_STRING) (list XmNheight XM_DIMENSION)
- (list XmNheightInc XM_INT) (list XmNhelpCallback XM_CALLBACK) (list XmNhelpLabelString XM_XMSTRING)
- (list XmNhighlightColor XM_PIXEL) (list XmNhighlightOnEnter XM_BOOLEAN) (list XmNhighlightPixmap XM_PIXMAP)
- (list XmNhighlightThickness XM_DIMENSION) (list XmNhistoryItemCount XM_INT) (list XmNhistoryItems XM_STRING_TABLE)
- (list XmNhistoryMaxItems XM_INT) (list XmNhistoryVisibleItemCount XM_INT) (list XmNhorizontalFontUnit XM_INT)
- (list XmNhorizontalScrollBar XM_WIDGET) (list XmNhorizontalSpacing XM_DIMENSION) (list XmNhotX XM_POSITION)
- (list XmNhotY XM_POSITION) (list XmNiconMask XM_PIXMAP) (list XmNiconName XM_STRING)
- (list XmNiconNameEncoding XM_ATOM) (list XmNiconPixmap XM_PIXMAP) (list XmNiconWindow XM_WIDGET)
- (list XmNiconX XM_INT) (list XmNiconY XM_INT) (list XmNiconic XM_BOOLEAN)
- (list XmNimportTargets XM_ATOM_LIST) (list XmNincrement XM_INT) (list XmNincrementCallback XM_CALLBACK)
- (list XmNincremental XM_BOOLEAN) (list XmNindicatorOn XM_INT) (list XmNindicatorSize XM_DIMENSION)
- (list XmNindicatorType XM_UCHAR) (list XmNinitialDelay XM_INT) (list XmNinitialFocus XM_WIDGET)
- (list XmNinitialResourcesPersistent XM_BOOLEAN) (list XmNinitialState XM_INT) (list XmNinput XM_BOOLEAN)
- (list XmNinputCallback XM_CALLBACK) (list XmNinputMethod XM_STRING) (list XmNinsertPosition XM_ORDER_CALLBACK)
- (list XmNinvalidCursorForeground XM_PIXEL) (list XmNisAligned XM_BOOLEAN) (list XmNisHomogeneous XM_BOOLEAN)
- (list XmNitemCount XM_INT) (list XmNitems XM_STRING_TABLE) (list XmNkeyboardFocusPolicy XM_UCHAR)
- (list XmNlabelInsensitivePixmap XM_PIXMAP) (list XmNlabelPixmap XM_PIXMAP) (list XmNlabelString XM_XMSTRING)
- (list XmNlabelType XM_UCHAR) (list XmNleftAttachment XM_UCHAR) (list XmNleftOffset XM_INT)
- (list XmNleftPosition XM_INT) (list XmNleftWidget XM_WIDGET) (list XmNlightThreshold XM_INT)
- (list XmNlistItemCount XM_INT) (list XmNlistItems XM_STRING_TABLE) (list XmNlistLabelString XM_XMSTRING)
- (list XmNlistMarginHeight XM_DIMENSION) (list XmNlistMarginWidth XM_DIMENSION) (list XmNlistSizePolicy XM_UCHAR)
- (list XmNlistSpacing XM_DIMENSION) (list XmNlistUpdated XM_BOOLEAN) (list XmNlistVisibleItemCount XM_INT)
- (list XmNlosePrimaryCallback XM_CALLBACK) (list XmNlosingFocusCallback XM_CALLBACK) (list XmNmainWindowMarginHeight XM_DIMENSION)
- (list XmNmainWindowMarginWidth XM_DIMENSION) (list XmNmapCallback XM_CALLBACK) (list XmNmappedWhenManaged XM_BOOLEAN)
- (list XmNmappingDelay XM_INT) (list XmNmargin XM_DIMENSION) (list XmNmarginBottom XM_DIMENSION)
- (list XmNmarginHeight XM_DIMENSION) (list XmNmarginLeft XM_DIMENSION) (list XmNmarginRight XM_DIMENSION)
- (list XmNmarginTop XM_DIMENSION) (list XmNmarginWidth XM_DIMENSION) (list XmNmask XM_PIXMAP)
- (list XmNmaxAspectX XM_INT) (list XmNmaxAspectY XM_INT) (list XmNmaxHeight XM_INT)
- (list XmNmaxLength XM_INT) (list XmNmaxWidth XM_INT) (list XmNmaximum XM_INT)
- (list XmNmenuAccelerator XM_STRING) (list XmNmenuBar XM_WIDGET) (list XmNmenuCursor XM_STRING)
- (list XmNmenuHelpWidget XM_WIDGET) (list XmNmenuHistory XM_WIDGET) (list XmNmenuPost XM_STRING)
- (list XmNmessageAlignment XM_UCHAR) (list XmNmessageString XM_XMSTRING) (list XmNmessageWindow XM_WIDGET)
- (list XmNminAspectX XM_INT) (list XmNminAspectY XM_INT) (list XmNminHeight XM_INT)
- (list XmNminWidth XM_INT) (list XmNminimizeButtons XM_BOOLEAN) (list XmNminimum XM_INT)
- (list XmNmnemonic XM_KEYSYM) (list XmNmnemonicCharSet XM_STRING) (list XmNmodifyVerifyCallback XM_CALLBACK)
- (list XmNmotionVerifyCallback XM_CALLBACK) (list XmNmoveOpaque XM_BOOLEAN) (list XmNmultiClick XM_UCHAR)
- (list XmNmultipleSelectionCallback XM_CALLBACK) (list XmNmustMatch XM_BOOLEAN) (list XmNmwmDecorations XM_INT)
- (list XmNmwmFunctions XM_INT) (list XmNmwmInputMode XM_INT) (list XmNmwmMenu XM_STRING)
- (list XmNnavigationType XM_UCHAR) (list XmNnoMatchCallback XM_CALLBACK) (list XmNnoMatchString XM_XMSTRING)
- (list XmNnoResize XM_BOOLEAN) (list XmNnoneCursorForeground XM_PIXEL) (list XmNnumChildren XM_INT)
- (list XmNnumColumns XM_SHORT) (list XmNnumDropRectangles XM_INT) (list XmNnumDropTransfers XM_INT)
- (list XmNnumExportTargets XM_INT) (list XmNnumImportTargets XM_INT) (list XmNoffsetX XM_POSITION)
- (list XmNoffsetY XM_POSITION) (list XmNokCallback XM_CALLBACK) (list XmNokLabelString XM_XMSTRING)
- (list XmNoperationChangedCallback XM_CALLBACK) (list XmNoperationCursorIcon XM_WIDGET) (list XmNoptionLabel XM_XMSTRING)
- (list XmNoptionMnemonic XM_KEYSYM) (list XmNorientation XM_UCHAR) (list XmNoverrideRedirect XM_BOOLEAN)
- (list XmNpacking XM_UCHAR) (list XmNpageDecrementCallback XM_CALLBACK) (list XmNpageIncrement XM_INT)
- (list XmNpageIncrementCallback XM_CALLBACK) (list XmNpaneMaximum XM_DIMENSION) (list XmNpaneMinimum XM_DIMENSION)
- (list XmNpattern XM_STRING_OR_XMSTRING) (list XmNpendingDelete XM_BOOLEAN) (list XmNpixmap XM_PIXMAP)
- (list XmNpopdownCallback XM_CALLBACK) (list XmNpopupCallback XM_CALLBACK) (list XmNpopupEnabled XM_INT)
- (list XmNpositionIndex XM_SHORT) (list XmNpostFromButton XM_INT) (list XmNpreeditType XM_STRING)
- (list XmNprocessingDirection XM_UCHAR) (list XmNpromptString XM_XMSTRING) (list XmNpushButtonEnabled XM_BOOLEAN)
- (list XmNqualifySearchDataProc XM_QUALIFY_CALLBACK) (list XmNradioAlwaysOne XM_BOOLEAN) (list XmNradioBehavior XM_BOOLEAN)
- (list XmNrecomputeSize XM_BOOLEAN) (list XmNrefigureMode XM_BOOLEAN) (list XmNrepeatDelay XM_INT)
- (list XmNresizable XM_BOOLEAN) (list XmNresizeCallback XM_CALLBACK) (list XmNresizeHeight XM_BOOLEAN)
- (list XmNresizePolicy XM_UCHAR) (list XmNresizeWidth XM_BOOLEAN) (list XmNrightAttachment XM_UCHAR)
- (list XmNrightOffset XM_INT) (list XmNrightPosition XM_INT) (list XmNrightWidget XM_WIDGET)
- (list XmNrowColumnType XM_UCHAR) (list XmNrows XM_SHORT) (list XmNrubberPositioning XM_BOOLEAN)
- (list XmNsashHeight XM_DIMENSION) (list XmNsashIndent XM_POSITION) (list XmNsashShadowThickness XM_DIMENSION)
- (list XmNsashWidth XM_DIMENSION) (list XmNsaveUnder XM_BOOLEAN) (list XmNscaleHeight XM_DIMENSION)
- (list XmNscaleMultiple XM_INT) (list XmNscaleWidth XM_DIMENSION) (list XmNscreen XM_SCREEN)
- (list XmNscrollBarDisplayPolicy XM_UCHAR) (list XmNscrollBarPlacement XM_UCHAR) (list XmNscrollHorizontal XM_BOOLEAN)
- (list XmNscrollLeftSide XM_BOOLEAN) (list XmNscrollTopSide XM_BOOLEAN) (list XmNscrollVertical XM_BOOLEAN)
- (list XmNscrolledWindowMarginHeight XM_DIMENSION) (list XmNscrolledWindowMarginWidth XM_DIMENSION) (list XmNscrollingPolicy XM_UCHAR)
- (list XmNselectColor XM_PIXEL) (list XmNselectInsensitivePixmap XM_PIXMAP) (list XmNselectPixmap XM_PIXMAP)
- (list XmNselectThreshold XM_INT) (list XmNselectedItemCount XM_INT) (list XmNselectedItems XM_STRING_TABLE)
- (list XmNselectionArray XM_INT_TABLE) (list XmNselectionArrayCount XM_INT) (list XmNselectionLabelString XM_XMSTRING)
- (list XmNselectionPolicy XM_UCHAR) (list XmNsensitive XM_BOOLEAN) (list XmNseparatorOn XM_BOOLEAN)
- (list XmNseparatorType XM_UCHAR) (list XmNset XM_UCHAR) (list XmNshadowThickness XM_DIMENSION)
- (list XmNshadowType XM_UCHAR) (list XmNshowArrows XM_BOOLEAN) (list XmNshowAsDefault XM_DIMENSION)
- (list XmNshowSeparator XM_BOOLEAN) (list XmNsimpleCallback XM_CALLBACK) (list XmNsingleSelectionCallback XM_CALLBACK)
- (list XmNskipAdjust XM_BOOLEAN) (list XmNsliderSize XM_INT) (list XmNsliderVisual XM_INT)
- (list XmNslidingMode XM_INT) (list XmNsource XM_TEXT_SOURCE) (list XmNsourceCursorIcon XM_WIDGET)
- (list XmNsourcePixmapIcon XM_WIDGET) (list XmNspacing XM_DIMENSION) (list XmNspotLocation XM_INT)
- (list XmNstateCursorIcon XM_WIDGET) (list XmNsubMenuId XM_WIDGET) (list XmNsymbolPixmap XM_PIXMAP)
- (list XmNtearOffMenuActivateCallback XM_CALLBACK) (list XmNtearOffMenuDeactivateCallback XM_CALLBACK) (list XmNtearOffModel XM_UCHAR)
- (list XmNtextAccelerators XM_ULONG) (list XmNtextColumns XM_SHORT) (list XmNtextString XM_XMSTRING)
- (list XmNtextTranslations XM_CALLBACK) (list XmNtitle XM_STRING) (list XmNtitleEncoding XM_ATOM)
- (list XmNtitleString XM_XMSTRING) (list XmNtoBottomCallback XM_CALLBACK) (list XmNtoTopCallback XM_CALLBACK)
- (list XmNtopAttachment XM_UCHAR) (list XmNtopCharacter XM_INT) (list XmNtopItemPosition XM_INT)
- (list XmNtopLevelEnterCallback XM_CALLBACK) (list XmNtopLevelLeaveCallback XM_CALLBACK) (list XmNtopOffset XM_INT)
- (list XmNtopPosition XM_INT) (list XmNtopShadowColor XM_PIXEL) (list XmNtopShadowPixmap XM_PIXMAP)
- (list XmNtopWidget XM_WIDGET) (list XmNtransferProc XM_TRANSFER_CALLBACK) (list XmNtransferStatus XM_UCHAR)
- (list XmNtransient XM_BOOLEAN) (list XmNtransientFor XM_WIDGET) (list XmNtranslations XM_CALLBACK)
- (list XmNtraversalOn XM_BOOLEAN) (list XmNtraverseObscuredCallback XM_CALLBACK) (list XmNtroughColor XM_PIXEL)
- (list XmNunitType XM_UCHAR) (list XmNunmapCallback XM_CALLBACK) (list XmNunpostBehavior XM_UCHAR)
- (list XmNuseAsyncGeometry XM_BOOLEAN) (list XmNuserData XM_ULONG) (list XmNvalidCursorForeground XM_PIXEL)
- (list XmNvalue XM_STRING_OR_INT) (list XmNvalueChangedCallback XM_CALLBACK) (list XmNverifyBell XM_BOOLEAN)
- (list XmNverticalFontUnit XM_INT) (list XmNverticalScrollBar XM_WIDGET) (list XmNverticalSpacing XM_DIMENSION)
- (list XmNvisibleItemCount XM_INT) (list XmNvisibleWhenOff XM_BOOLEAN) (list XmNvisual XM_VISUAL)
- (list XmNvisualPolicy XM_UCHAR) (list XmNwidth XM_DIMENSION) (list XmNwidthInc XM_INT)
- (list XmNwinGravity XM_INT) (list XmNwindow XM_WIDGET) (list XmNwindowGroup XM_WINDOW)
- (list XmNwmTimeout XM_INT) (list XmNwordWrap XM_BOOLEAN) (list XmNworkWindow XM_WIDGET)
- (list XmNx XM_POSITION) (list XmNy XM_POSITION) (list XmNarrowLayout XM_UCHAR)
- (list XmNarrowOrientation XM_UCHAR) (list XmNarrowSensitivity XM_UCHAR) (list XmNarrowSize XM_INT)
- (list XmNarrowSpacing XM_INT) (list XmNautoDragModel XM_INT) (list XmNbackPageBackground XM_PIXEL)
- (list XmNbackPageForeground XM_PIXEL) (list XmNbackPageNumber XM_INT) (list XmNbackPagePlacement XM_UCHAR)
- (list XmNbackPageSize XM_DIMENSION) (list XmNbindingPixmap XM_PIXMAP) (list XmNbindingType XM_UCHAR)
- (list XmNbindingWidth XM_INT) (list XmNbitmapConversionModel XM_INT) (list XmNbuttonRenderTable XM_RENDER_TABLE)
- (list XmNcollapsedStatePixmap XM_PIXMAP) (list XmNcolorAllocationProc XM_ALLOC_COLOR_CALLBACK)
- (list XmNcolorCalculationProc XM_SCREEN_COLOR_CALLBACK)
- (list XmNcomboBoxType XM_UCHAR) (list XmNconvertCallback XM_CALLBACK) (list XmNcurrentPageNumber XM_INT)
- (list XmNdecimal XM_STRING) (list XmNdefaultArrowSensitivity XM_UCHAR) (list XmNdefaultButtonEmphasis XM_INT)
- (list XmNdefaultVirtualBindings XM_STRING) (list XmNdestinationCallback XM_CALLBACK) (list XmNdetail XM_STRING_TABLE)
- (list XmNdetailColumnHeading XM_INT) (list XmNdetailColumnHeadingCount XM_INT) (list XmNdetailCount XM_INT)
- (list XmNdetailOrder XM_INT_TABLE) (list XmNdetailOrderCount XM_INT) (list XmNdetailShadowThickness XM_INT)
- (list XmNdetailTabList XM_TAB_LIST) (list XmNdirTextLabelString XM_XMSTRING) (list XmNdragStartCallback XM_CALLBACK)
- (list XmNenableBtn1Transfer XM_INT) (list XmNenableButtonTab XM_BOOLEAN) (list XmNenableDragIcon XM_BOOLEAN)
- (list XmNenableEtchedInMenu XM_BOOLEAN) (list XmNenableMultiKeyBindings XM_BOOLEAN) (list XmNenableThinThickness XM_BOOLEAN)
- (list XmNenableToggleColor XM_BOOLEAN) (list XmNenableToggleVisual XM_BOOLEAN) (list XmNenableUnselectableDrag XM_BOOLEAN)
- (list XmNenableWarp XM_INT) (list XmNentryParent XM_WIDGET) (list XmNentryViewType XM_UCHAR)
- (list XmNexpandedStatePixmap XM_PIXMAP) (list XmNfileFilterStyle XM_INT) (list XmNfirstPageNumber XM_INT)
- (list XmNfontName XM_STRING) (list XmNfontType XM_UCHAR) (list XmNframeBackground XM_PIXEL)
- (list XmNframeChildType XM_UCHAR) (list XmNframeShadowThickness XM_DIMENSION) (list XmNgrabStyle XM_INT)
- (list XmNincludeStatus XM_INT) (list XmNincrementValue XM_INT) (list XmNindeterminateInsensitivePixmap XM_PIXMAP)
- (list XmNindeterminatePixmap XM_PIXMAP) (list XmNinnerMarginHeight XM_DIMENSION) (list XmNinnerMarginWidth XM_DIMENSION)
- (list XmNinputPolicy XM_ULONG) (list XmNinsensitiveStippleBitmap XM_PIXMAP) (list XmNinvokeParseProc XM_PARSE_CALLBACK)
- (list XmNlabelRenderTable XM_RENDER_TABLE) (list XmNlargeCellHeight XM_DIMENSION) (list XmNlargeCellWidth XM_DIMENSION)
- (list XmNlargeIconMask XM_PIXMAP) (list XmNlargeIconPixmap XM_PIXMAP) (list XmNlargeIconX XM_FLOAT)
- (list XmNlargeIconY XM_FLOAT) (list XmNlastPageNumber XM_INT) (list XmNlayoutDirection XM_UCHAR)
- (list XmNlayoutType XM_UCHAR) (list XmNlist XM_WIDGET) (list XmNloadModel XM_UCHAR)
- (list XmNmajorTabSpacing XM_DIMENSION) (list XmNmatchBehavior XM_UCHAR) (list XmNmaximumValue XM_INT)
- (list XmNminimumValue XM_INT) (list XmNminorTabSpacing XM_DIMENSION) (list XmNmotifVersion XM_INT)
- (list XmNnoFontCallback XM_CALLBACK) (list XmNnoRenditionCallback XM_CALLBACK) (list XmNnotebookChildType XM_UCHAR)
- (list XmNnumValues XM_INT) (list XmNoutlineButtonPolicy XM_UCHAR) (list XmNoutlineChangedCallback XM_CALLBACK)
- (list XmNoutlineColumnWidth XM_DIMENSION) (list XmNoutlineIndentation XM_DIMENSION) (list XmNoutlineLineStyle XM_UCHAR)
- (list XmNoutlineState XM_UCHAR) (list XmNpageChangedCallback XM_CALLBACK) (list XmNpageNumber XM_INT)
- (list XmNpathMode XM_INT) (list XmNpatternType XM_UCHAR) (list XmNpopupHandlerCallback XM_CALLBACK)
- (list XmNposition XM_INT) (list XmNpositionMode XM_INT) (list XmNpositionType XM_UCHAR)
- (list XmNprimaryOwnership XM_UCHAR) (list XmNrenderTable XM_RENDER_TABLE) (list XmNrenditionBackground XM_PIXEL)
- (list XmNrenditionForeground XM_PIXEL) (list XmNscrolledWindowChildType XM_UCHAR) (list XmNselectedItem XM_XMSTRING)
- (list XmNselectedObjectCount XM_INT) (list XmNselectedObjects XM_WIDGET_LIST) (list XmNselectedPosition XM_INT)
- (list XmNselectedPositionCount XM_INT) (list XmNselectedPositions XM_INT_TABLE) (list XmNselectionCallback XM_CALLBACK)
- (list XmNselectionMode XM_UCHAR) (list XmNselectionTechnique XM_UCHAR) (list XmNsliderMark XM_INT)
- (list XmNsmallCellHeight XM_DIMENSION) (list XmNsmallCellWidth XM_DIMENSION) (list XmNsmallIconMask XM_PIXMAP)
- (list XmNsmallIconPixmap XM_PIXMAP) (list XmNsmallIconX XM_FLOAT) (list XmNsmallIconY XM_FLOAT)
- (list XmNsnapBackMultiple XM_SHORT) (list XmNspatialIncludeModel XM_UCHAR) (list XmNspatialResizeModel XM_UCHAR)
- (list XmNspatialSnapModel XM_UCHAR) (list XmNspatialStyle XM_UCHAR) (list XmNspinBoxChildType XM_UCHAR)
- (list XmNstrikethruType XM_UCHAR) (list XmNsubstitute XM_XMSTRING) (list XmNtabList XM_TAB_LIST)
- (list XmNtag XM_STRING) (list XmNtearOffTitle XM_XMSTRING) (list XmNtextField XM_WIDGET)
- (list XmNtextRenderTable XM_RENDER_TABLE) (list XmNtoggleMode XM_UCHAR) (list XmNunderlineType XM_UCHAR)
- (list XmNunselectColor XM_PIXEL) (list XmNtabValue XM_FLOAT) (list XmNoffsetModel XM_INT)
- (list XmNcallback XM_CALLBACK) (list XmNwaitForWm XM_BOOLEAN) (list XmNuseColorObj XM_BOOLEAN)
- (list XmNvalues XM_STRING_TABLE) (list XmNviewType XM_UCHAR) (list XmNvisualEmphasis XM_UCHAR)
- (list XmNwrap XM_BOOLEAN)
- )))
-
+ (let ((hi (XtCreateManagedWidget "hi" xmTextWidgetClass (cadr (main-widgets))
+ (list XmNqualifySearchDataProc (lambda (w c i) "hi")
+ XmNtransferProc (lambda (a b c d e f g) "ho")
+ XmNcolorAllocationProc (lambda (a b c) #f)
+ XmNcolorCalculationProc (lambda (a b) #f)
+ XmNcreatePopupChildProc (lambda (a) #f)
+ XmNlargeIconX 0.5
+ ))))
+ (XtVaSetValues hi (list XmNqualifySearchDataProc (lambda (w c i) "hi")
+ XmNtransferProc (lambda (a b c d e f g) "ho")
+ XmNcolorAllocationProc (lambda (a b c) #f)
+ XmNcolorCalculationProc (lambda (a b) #f)
+ XmNcreatePopupChildProc (lambda (a) #f)))
+ (XtVaSetValues hi (list XmNqualifySearchDataProc #f
+ XmNcolorAllocationProc #f
+ XmNcolorCalculationProc #f
+ XmNcreatePopupChildProc #f
+ XmNx 10
+ XmNsource (XmTextGetSource hi)
+ ))
+ (XtUnmanageChild hi))
+
+ (if (and (defined? 'XmCreateFontSelector)
+ (defined? 'XmCreateColorSelector))
+ (let ((fonts-dialog #f)
+ (colors-dialog #f))
(for-each
- (lambda (n)
- (if (not (string? (car n))) (snd-display #__line__ ";resource ~A is not a string?" (car n)))
- (XtVaGetValues shell (list (car n) 0)))
- resource-list)
- )
-
- (if (not (XEvent? (XEvent)))
- (snd-display #__line__ ";xevent type trouble! ~A -> ~A" (XEvent) (XEvent? (XEvent))))
- (if (not (XGCValues? (XGCValues)))
- (snd-display #__line__ ";xgcvalues type trouble! ~A -> ~A" (XGCValues) (XGCValues? (XGCValues))))
- (if (not (= (.direction (XmTraverseObscuredCallbackStruct)) 0))
- (snd-display #__line__ ";.direction: ~A" (.direction (XmTraverseObscuredCallbackStruct))))
- (if (.ptr (XmTextBlock))
- (snd-display #__line__ ";.ptr block: ~A" (.ptr (XmTextBlock))))
- (let ((hi (XmTextBlock)))
- (set! (.ptr hi) "hi")
- (if (not (string=? (.ptr hi) "hi"))
- (snd-display #__line__ ";.ptr set block: ~A" (.ptr hi)))
- (if (not (= (.length hi) 0)) (snd-display #__line__ ";.length block: ~A" (.length hi)))
- (set! (.length hi) 3)
- (if (not (= (.length hi) 3)) (snd-display #__line__ ";set .length block: ~A" (.length hi))))
- (if (not (= (.dashes (XGCValues)) 0)) (snd-display #__line__ ";dashes: ~A" (.dashes (XGCValues))))
- (set! (.dashes (XGCValues)) 1)
- (set! (.clip_mask (XGCValues)) (list 'Pixmap 0))
- (set! (.resourceid (XEvent -1)) 0)
- (set! (.error_code (XEvent -1)) 0)
- (set! (.request_code (XEvent -1)) 0)
- (if (not (= (.resourceid (XEvent -1)) 0)) (snd-display #__line__ ";error resourceid: ~A" (.resourceid (XEvent -1))))
- (if (not (= (.request_code (XEvent -1)) 0)) (snd-display #__line__ ";error request_code: ~A" (.request_code (XEvent -1))))
- (set! (.pad (XColor)) 1)
- )
+ (lambda (make-dialog)
+ (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "Fonts" XmFONTLIST_DEFAULT_TAG))
+ (new-dialog (XmCreateTemplateDialog
+ (cadr (main-widgets)) "Fonts"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNokLabelString xok
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground *basic-color*
+ XmNtransient #f))))
+ (XtAddCallback new-dialog XmNcancelCallback (lambda (w c i) (XtUnmanageChild w)))
+ (XtAddCallback new-dialog XmNhelpCallback (lambda (w c i) (help-dialog "Fonts" "no help yet")))
+ (XtAddCallback new-dialog XmNokCallback (lambda (w c i) (XtUnmanageChild w)))
+ (XmStringFree xhelp)
+ (XmStringFree xok)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+ (if (not fonts-dialog)
+ (set! fonts-dialog new-dialog)
+ (set! colors-dialog new-dialog))
+ (let* ((mainform (XtCreateManagedWidget "mainform" xmFormWidgetClass new-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild new-dialog XmDIALOG_SEPARATOR)
+ XmNbackground *basic-color*)))
+ (fnts (make-dialog mainform)))
+ (XtManageChild fnts)
+ (if (not colors-dialog)
+ (XtManageChild fonts-dialog)
+ (XtManageChild colors-dialog)))))
+ (list
+ (lambda (mainform)
+ (XmCreateFontSelector mainform "Fonts"
+ (list XmNbackground *basic-color*
+ XmNcurrentFont "-*-times-bold-r-*-*-14-140-*-*-*-*-*-*"
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE)))
+
+ (lambda (mainform)
+ (XmCreateColorSelector mainform "Colors"
+ (list XmNbackground *basic-color*
+ XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_NONE)))))
+ (XtUnmanageChild fonts-dialog)
+ (XtUnmanageChild colors-dialog)))
+
+ (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
+ (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
+ (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
+ (titlestr (XmStringCreate "Fonts" XmFONTLIST_DEFAULT_TAG))
+ (new-dialog (XmCreateTemplateDialog
+ (cadr (main-widgets)) "Fonts"
+ (list XmNcancelLabelString xdismiss
+ XmNhelpLabelString xhelp
+ XmNokLabelString xok
+ XmNautoUnmanage #f
+ XmNdialogTitle titlestr
+ XmNresizePolicy XmRESIZE_GROW
+ XmNnoResize #f
+ XmNbackground *basic-color*
+ XmNtransient #f))))
+ (XmStringFree xhelp)
+ (XmStringFree xok)
+ (XmStringFree xdismiss)
+ (XmStringFree titlestr)
+ (let* ((mainform (XtCreateManagedWidget "mainform" xmFormWidgetClass new-dialog
+ (list XmNleftAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_WIDGET
+ XmNbottomWidget (XmMessageBoxGetChild new-dialog XmDIALOG_SEPARATOR)
+ XmNbackground *basic-color*)))
+ (fnts
+ (and (defined? 'XmIsColumn)
+ (let* ((w1 (XmCreateColumn mainform "column" ()))
+ (w1-child (XtCreateManagedWidget "hihi" xmLabelWidgetClass w1 () 0))
+ (w2 (XtCreateManagedWidget "column1" xmColumnWidgetClass mainform () 0)))
+ (if (or (not (XmIsColumn w1))
+ (not (XmIsColumn w2))
+ (not (XmColumn? w1)))
+ (snd-display #__line__ ";XmIsColumn: ~A ~A" w1 w2))
+ (if (defined? 'XmColumnGetChildLabel)
+ (let ((child (XmColumnGetChildLabel w1)))
+ (if (or (not (child)) (not (equal? child w1-child)))
+ (snd-display #__line__ ";XmColumn child: ~A ~A" child w1-child))))
+ (XtManageChild w1)
+ w1)))
+ (fntt
+ (and (defined? 'XmIsButtonBox)
+ (let ((w1 (XmCreateButtonBox mainform "box" (list XmNfillOption XmFillMajor))))
+ (if (or (not (XmIsButtonBox w1))
+ (not (XmButtonBox? w1)))
+ (snd-display #__line__ ";XmIsButtonBox: ~A ~A ~A" w1 (XmIsButtonBox w1) (XmButtonBox? w1)))
+ (XtManageChild w1)
+ w1)))
+ (fntd
+ (and (defined? 'XmIsDropDown)
+ (let ((w1 (XmCreateDropDown mainform "drop" ())))
+ (if (or (not (XmIsDropDown w1))
+ (not (XmDropDown? w1)))
+ (snd-display #__line__ ";XmIsDropDown: ~A ~A ~A" w1 (XmIsDropDown w1) (XmDropDown? w1)))
+ (XtManageChild w1)
+ (let ((text (XmDropDownGetText w1))
+ (label (XmDropDownGetLabel w1))
+ (arrow (XmDropDownGetArrow w1))
+ (lst (XmDropDownGetList w1)))
+ (XmDropDownGetValue w1)
+ (if (not (XmTextField? text)) (snd-display #__line__ ";dropdown text: ~A" text))
+ (if (not (XmLabel? label)) (snd-display #__line__ ";dropdown label: ~A" label))
+ (if (not (XmArrowButton? arrow)) (snd-display #__line__ ";dropdown arrow: ~A" arrow))
+ (if (not (XmList? lst)) (snd-display #__line__ ";dropdown lst: ~A" text))
+ w1))))
+ (fntda
+ (and (defined? 'XmIsDataField)
+ (let ((w1 (XmCreateDataField mainform "data" ())))
+ (if (or (not (XmIsDataField w1))
+ (not (XmDataField? w1)))
+ (snd-display #__line__ ";XmIsDataField: ~A ~A ~A" w1 (XmIsDataField w1) (XmDataField? w1)))
+ (XmDataFieldGetString w1)
+ (XmDataFieldGetSelection w1)
+ (XmDataFieldSetString w1 "hiho")
+ (XmDataFieldSetEditable w1 #t)
+ (XmDataFieldSetAddMode w1 #f)
+ (XmDataFieldShowPosition w1 0)
+ (XmDataFieldXYToPos w1 0 0)
+ (XmDataFieldSetHighlight w1 0 0 0)
+ (XmDataFieldGetSelectionPosition w1)
+ (XmDataFieldSetSelection w1 0 0 '(Time 0))
+ (XmDataFieldCopy w1 '(Time 0))
+ (XmDataFieldCut w1 '(Time 0))
+ w1)))
+ (fnttab
+ (and (defined? 'XmIsTabStack)
+ (let ((w1 (XmCreateTabStack mainform "hi" ())))
+ (if (or (not (XmIsTabStack w1))
+ (not (XmTabStack? w1)))
+ (snd-display #__line__ ";XmIsTabStack: ~A ~A ~A" w1 (XmIsTabStack w1) (XmTabStack? w1)))
+ (XmTabStackGetSelectedTab w1)
+ (XmTabStackSelectTab w1 #f)
+ w1))))
+
+ (if (and (defined? 'XmToolTipGetLabel)
+ (defined? 'XmNtoolTipString))
+ (let ((wid1 (XtCreateManagedWidget "wid1" xmPushButtonWidgetClass mainform
+ (list XmNtoolTipString (XmStringCreateLocalized "tooltip")
+ XmNtoolTipPostDelay 100
+ XmNtoolTipPostDuration 500
+ XmNtoolTipEnable #t
+ XmNanimate #f))))
+ (let ((tip (XmToolTipGetLabel wid1)))
+ (if (not (Widget? tip)) (snd-display #__line__ ";tooltip label: ~A ~A ~A ~A ~A ~A" tip fnttab fntda fntd fntt fnts)))))
+
+ (XtManageChild new-dialog)
+ (XtUnmanageChild new-dialog)))
+
+ (let* ((shell (cadr (main-widgets)))
+ (dpy (XtDisplay shell))
+ (prop (XmInternAtom dpy "TESTING" #f))
+ (proto1 (XmInternAtom dpy "TEST1" #f))
+ (proto2 (XmInternAtom dpy "TEST2" #f))
+ (val 0))
+ (if (not (Atom? prop)) (snd-display #__line__ ";XmInternAtom: ~A" prop))
+ (if (not (string=? (XmGetAtomName dpy prop) "TESTING")) (snd-display #__line__ ";XmGetAtomName: ~A" (XmGetAtomName dpy prop)))
+ (XmAddProtocols shell prop (list proto1 proto2))
+ (XmSetProtocolHooks shell
+ (XmInternAtom dpy "WM_PROTOCOLS" #f)
+ prop
+ (lambda (w c i)
+ (snd-display #__line__ ";prehook: ~A ~A ~A" w c i))
+ 12345
+ (lambda (w c i)
+ (snd-display #__line__ ";posthook: ~A ~A ~A" w c i))
+ 54321)
+ (XmDeactivateProtocol shell prop proto2)
+ (XmRemoveProtocols shell prop (list proto2))
+ (XmAddProtocolCallback shell prop proto1 (lambda (w c i) (set! val c)) 123)
+ (XmActivateProtocol shell prop proto1)
+ (let ((e (XEvent ClientMessage))
+ (window (XtWindow shell)))
+ (set! (.window e) window)
+ (set! (.display e) dpy)
+ (set! (.format e) (if val 8))
+ (set! (.message_type e) XA_STRING)
+ (set! (.data e) "hiho")
+ (XSendEvent dpy window #f 0 e))
+ (XmRemoveProtocols shell prop (list proto1)))
+ (XmCascadeButtonHighlight (XmCreateCascadeButton (cadr (main-widgets)) "cascade" ()) #f)
+ ;(XmCascadeButtonGadgetHighlight (XmCreateCascadeButtonGadget (cadr (main-widgets)) "gadget" ()) #f)
+
+ (let ((callbacks
+ (list
+ (list XmAnyCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event))
+ (list XmArrowButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .click_count 'int '.click_count))
+ (list XmCommandCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .value 'XmString '.value) (list .length 'int '.length #f))
+ (list XmDragDropFinishCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp))
+ (list XmDragMotionCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
+ (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f))
+ (list XmDragProcCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .dragContext 'Widget '.dragContext #f)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f) (list .animate 'Boolean '.animate #f))
+ (list XmDrawingAreaCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .window 'Window '.window))
+ (list XmDrawnButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .window 'Window '.window) (list .click_count 'int '.click_count))
+ (list XmDropFinishCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
+ (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .dropAction 'uchar '.dropAction #f) (list .completionStatus 'uchar '.completionStatus #f))
+ (list XmDropProcCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .dragContext 'Widget '.dragContext #f)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f) (list .dropAction 'uchar '.dropAction #f))
+ (list XmDropSiteEnterCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
+ (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f))
+ (list XmDropSiteLeaveCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp))
+ (list XmDropStartCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation)
+ (list .operations 'uchar '.operations #f) (list .dropSiteStatus 'uchar '.dropSiteStatus)
+ (list .dropAction 'uchar '.dropAction #f))
+ (list XmFileSelectionBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .value 'XmString '.value) (list .length 'int '.length #f) (list .mask 'XmString '.mask #f)
+ (list .mask_length 'int '.mask_length #f) (list .dir 'XmString '.dir #f) (list .dir_length 'int '.dir_length #f)
+ (list .pattern 'XmString '.pattern #f) (list .pattern_length 'int '.pattern_length #f))
+ (list XmListCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .item 'XmString '.item #f) (list .item_length 'int '.item_length #f) (list .item_position 'int '.item_position #f)
+ (list .selected_items 'XmString* '.selected_items) (list .selected_item_count 'int '.selected_item_count #f)
+ (list .selected_item_positions 'int* '.selected_item_positions) (list .selection_type 'char '.selection_type #f)
+ (list .auto_selection_type 'char '.auto_selection_type #f))
+ (list XmOperationChangedCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .operation 'uchar '.operation) (list .operations 'uchar '.operations #f)
+ (list .dropSiteStatus 'uchar '.dropSiteStatus))
+ (list XmPushButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .click_count 'int '.click_count))
+ (list XmRowColumnCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .widget 'Widget '.widget #f) (list .data 'char* '.data #f) (list .callbackstruct 'char* '.callbackstruct #f))
+ (list XmScaleCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .value 'int '.value))
+ (list XmScrollBarCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .value 'int '.value) (list .pixel 'int '.pixel #f))
+ (list XmSelectionBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .value 'XmString '.value) (list .length 'int '.length #f))
+ (list XmTextVerifyCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .doit 'Boolean '.doit) (list .currInsert 'int '.currInsert #f) (list .newInsert 'int '.newInsert #f)
+ (list .startPos 'int '.startPos #f) (list .endPos 'int '.endPos #f)
+ (list .text 'XmTextBlock '.text #f))
+ (list XmToggleButtonCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .set 'int '.set))
+ (list XmDestinationCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .selection 'Atom '.selection #f) (list .operation 'uchar '.operation) (list .flags 'int '.flags #f)
+ (list .transfer_id 'XtPointer '.transfer_id #f) (list .destination_data 'XtPointer '.destination_data #f)
+ (list .location_data 'XtPointer '.location_data #f) (list .time 'Time '.time))
+ (list XmConvertCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event) (list .selection 'Atom '.selection #f)
+ (list .target 'Atom '.target #f) (list .source_data 'XtPointer '.source_data #f)
+ (list .location_data 'XtPointer '.location_data #f) (list .flags 'int '.flags #f) (list .parm 'XtPointer '.parm #f)
+ (list .parm_format 'int '.parm_format #f) (list .parm_length 'int '.parm_length #f)
+ (list .parm_type 'Atom '.parm_type #f) (list .status 'int '.status #f) (list .value 'XtPointer '.value #f)
+ (list .type 'Atom '.type #f) (list .format 'int '.format #f) (list .length 'int '.length #f))
+ (list XmComboBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .item_or_text 'XmString '.item_or_text #f) (list .item_position 'int '.item_position #f))
+ (list XmContainerOutlineCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .item 'Widget '.item #f) (list .new_outline_state 'uchar '.new_outline_state #f))
+ (list XmContainerSelectCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .selected_items 'Widget* '.selected_items) (list .selected_item_count 'int '.selected_item_count #f)
+ (list .auto_selection_type 'uchar '.auto_selection_type #f))
+ (list XmNotebookCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .page_number 'int '.page_number #f) (list .page_widget 'Widget '.page_widget #f)
+ (list .prev_page_number 'int '.prev_page_number #f) (list .prev_page_widget 'Widget '.prev_page_widget #f))
+ (list XmSpinBoxCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .widget 'Widget '.widget #f) (list .doit 'Boolean '.doit) (list .position 'int '.position #f)
+ (list .value 'XmString '.value #f) (list .crossed_boundary 'Boolean '.crossed-boundary #f))
+ (list XmTraverseObscuredCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .traversal_destination 'Widget '.traversal_destination #f))
+ (list XmTopLevelLeaveCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .screen 'Screen '.screen) (list .window 'Window '.window))
+ (list XmTopLevelEnterCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .timeStamp 'Time '.timeStamp) (list .screen 'Screen '.screen) (list .window 'Window '.window)
+ (list .x 'Position '.x #f) (list .y 'Position '.y #f) (list .dragProtocolStyle 'uchar '.dragProtocolStyle #f))
+ (list XmPopupHandlerCallbackStruct (list .reason 'int '.reason)
+ (list .event 'XEvent '.event) (list .menuToPost 'Widget '.menuToPost) (list .postIt 'Boolean '.postIt)
+ (list .target 'Widget '.target #f))
+ (list XmSelectionCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .selection 'Atom '.selection #f) (list .target 'Atom '.target #f) (list .type 'Atom '.type #f)
+ (list .transfer_id 'XtPointer '.transfer_id #f) (list .flags 'int '.flags #f) (list .remaining 'int '.remaining #f)
+ (list .value 'XtPointer '.value #f) (list .length 'int '.length #f) (list .format 'int '.format #f))
+ (list XmTransferDoneCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .selection 'Atom '.selection #f) (list .transfer_id 'XtPointer '.transfer_id #f) (list .status 'int '.status #f)
+ (list .client_data 'XtPointer '.client_data #f))
+ (list XmDisplayCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .font_name 'char* '.font_name #f) (list .tag 'int '.tag #f)
+ (list .render_table 'XmRenderTable '.render_table #f)
+ (list .rendition 'XmRendition '.rendition #f))
+ (list XmDragStartCallbackStruct (list .reason 'int '.reason) (list .event 'XEvent '.event)
+ (list .widget 'Widget '.widget #f) (list .doit 'Boolean '.doit))
+ )))
+
+
+ (for-each
+ (lambda (call)
+ (let ((struct ((car call)))
+ (val #f))
+ (set! (.event struct) (XEvent))
+ (for-each
+ (lambda (field)
+ (if (not (pair? field)) (snd-display #__line__ ";~A: ~A" struct field))
+ (set! val ((car field) struct))
+ (if (< (length field) 4)
+ (case (cadr field)
+ ((int Position XtPointer char) (set! ((car field) struct) 0))
+ ((Atom) (set! ((car field) struct) XA_STRING))
+ ((uchar) (set! ((car field) struct) val))
+ ((Widget) (set! ((car field) struct) (list 'Widget 0)))
+ ((XmString) (set! ((car field) struct) (list 'XmString 0)))
+ ((char*) (set! ((car field) struct) "hi"))
+ ((XEvent Boolean XmString* int* Time Window Widget* Screen) #f)
+ )))
+ (cdr call))))
+ callbacks)
+ )
+
+ (let ((shell (cadr (main-widgets)))
+ (resource-list
+ (list
+ (list XmNaccelerator XM_STRING) (list XmNacceleratorText XM_XMSTRING) (list XmNaccelerators XM_ULONG)
+ (list XmNactivateCallback XM_CALLBACK) (list XmNadjustLast XM_BOOLEAN) (list XmNadjustMargin XM_BOOLEAN)
+ (list XmNalignment XM_UCHAR) (list XmNallowOverlap XM_BOOLEAN) (list XmNallowResize XM_BOOLEAN)
+ (list XmNallowShellResize XM_BOOLEAN) (list XmNancestorSensitive XM_BOOLEAN) (list XmNanimationMask XM_PIXMAP)
+ (list XmNanimationPixmap XM_PIXMAP) (list XmNanimationPixmapDepth XM_INT) (list XmNanimationStyle XM_UCHAR)
+ (list XmNapplyCallback XM_CALLBACK) (list XmNapplyLabelString XM_XMSTRING) (list XmNargc XM_INT)
+ (list XmNargv XM_STRING_LIST) (list XmNarmCallback XM_CALLBACK) (list XmNarmColor XM_PIXEL)
+ (list XmNarmPixmap XM_PIXMAP) (list XmNarrowDirection XM_UCHAR) (list XmNattachment XM_UCHAR)
+ (list XmNaudibleWarning XM_UCHAR) (list XmNautoShowCursorPosition XM_BOOLEAN) (list XmNautoUnmanage XM_BOOLEAN)
+ (list XmNautomaticSelection XM_UCHAR) (list XmNbackground XM_PIXEL) (list XmNbackgroundPixmap XM_PIXMAP)
+ (list XmNbaseHeight XM_INT) (list XmNbaseWidth XM_INT) (list XmNbitmap XM_PIXMAP)
+ (list XmNblendModel XM_ULONG) (list XmNblinkRate XM_INT) (list XmNborderColor XM_PIXEL)
+ (list XmNborderPixmap XM_PIXMAP) (list XmNborderWidth XM_DIMENSION) (list XmNbottomAttachment XM_UCHAR)
+ (list XmNbottomOffset XM_INT) (list XmNbottomPosition XM_INT) (list XmNbottomShadowColor XM_PIXEL)
+ (list XmNbottomShadowPixmap XM_PIXMAP) (list XmNbottomWidget XM_WIDGET) (list XmNbrowseSelectionCallback XM_CALLBACK)
+ (list XmNbuttonAcceleratorText XM_STRING_TABLE) (list XmNbuttonAccelerators XM_STRING_TABLE) (list XmNbuttonCount XM_INT)
+ (list XmNbuttonMnemonicCharSets XM_CHARSET_TABLE) (list XmNbuttonMnemonics XM_KEYSYM_TABLE) (list XmNbuttonSet XM_INT)
+ (list XmNbuttonType XM_ULONG) (list XmNbuttons XM_STRING_TABLE) (list XmNcancelButton XM_WIDGET)
+ (list XmNcancelCallback XM_CALLBACK) (list XmNcancelLabelString XM_XMSTRING) (list XmNcascadePixmap XM_PIXMAP)
+ (list XmNcascadingCallback XM_CALLBACK) (list XmNchildHorizontalAlignment XM_UCHAR) (list XmNchildHorizontalSpacing XM_DIMENSION)
+ (list XmNchildPlacement XM_UCHAR) (list XmNchildVerticalAlignment XM_UCHAR) (list XmNchildren XM_WIDGET_LIST)
+ (list XmNclientData XM_ULONG) (list XmNclipWindow XM_WIDGET) (list XmNcolormap XM_COLORMAP)
+ (list XmNcolumns XM_SHORT) (list XmNcommand XM_XMSTRING) (list XmNcommandChangedCallback XM_CALLBACK)
+ (list XmNcommandEnteredCallback XM_CALLBACK) (list XmNcommandWindow XM_WIDGET) (list XmNcommandWindowLocation XM_UCHAR)
+ (list XmNconvertProc XM_CONVERT_CALLBACK) (list XmNcreatePopupChildProc XM_POPUP_CALLBACK) (list XmNcursorBackground XM_PIXEL)
+ (list XmNcursorForeground XM_PIXEL) (list XmNcursorPosition XM_INT) (list XmNcursorPositionVisible XM_BOOLEAN)
+ (list XmNdarkThreshold XM_INT) (list XmNdecimalPoints XM_SHORT) (list XmNdecrementCallback XM_CALLBACK)
+ (list XmNdefaultActionCallback XM_CALLBACK) (list XmNdefaultButton XM_WIDGET) (list XmNdefaultButtonShadowThickness XM_DIMENSION)
+ (list XmNdefaultButtonType XM_UCHAR) (list XmNdefaultCopyCursorIcon XM_WIDGET) (list XmNdefaultInvalidCursorIcon XM_WIDGET)
+ (list XmNdefaultLinkCursorIcon XM_WIDGET) (list XmNdefaultMoveCursorIcon XM_WIDGET) (list XmNdefaultNoneCursorIcon XM_WIDGET)
+ (list XmNdefaultPosition XM_BOOLEAN) (list XmNdefaultSourceCursorIcon XM_WIDGET) (list XmNdefaultValidCursorIcon XM_WIDGET)
+ (list XmNdeleteResponse XM_UCHAR) (list XmNdepth XM_INT) (list XmNdestroyCallback XM_CALLBACK)
+ (list XmNdialogStyle XM_UCHAR) (list XmNdialogTitle XM_XMSTRING) (list XmNdialogType XM_UCHAR)
+ (list XmNdirListItemCount XM_INT) (list XmNdirListItems XM_STRING_TABLE) (list XmNdirListLabelString XM_XMSTRING)
+ (list XmNdirMask XM_XMSTRING) (list XmNdirSearchProc XM_SEARCH_CALLBACK) (list XmNdirSpec XM_XMSTRING)
+ (list XmNdirectory XM_XMSTRING) (list XmNdirectoryValid XM_BOOLEAN) (list XmNdisarmCallback XM_CALLBACK)
+ (list XmNdoubleClickInterval XM_INT) (list XmNdragDropFinishCallback XM_CALLBACK) (list XmNdragInitiatorProtocolStyle XM_UCHAR)
+ (list XmNdragMotionCallback XM_CALLBACK) (list XmNdragOperations XM_UCHAR) (list XmNdragReceiverProtocolStyle XM_UCHAR)
+ (list XmNdropFinishCallback XM_CALLBACK) (list XmNdropProc XM_DROP_CALLBACK) (list XmNdropRectangles XM_RECTANGLE_LIST)
+ (list XmNdropSiteActivity XM_UCHAR) (list XmNdropSiteEnterCallback XM_CALLBACK) (list XmNdropSiteLeaveCallback XM_CALLBACK)
+ (list XmNdropSiteOperations XM_UCHAR) (list XmNdropSiteType XM_UCHAR) (list XmNdropStartCallback XM_CALLBACK)
+ (list XmNdropTransfers XM_TRANSFER_ENTRY_LIST) (list XmNeditMode XM_INT) (list XmNeditable XM_BOOLEAN)
+ (list XmNentryAlignment XM_UCHAR) (list XmNentryBorder XM_DIMENSION) (list XmNentryCallback XM_CALLBACK)
+ (list XmNentryClass XM_WIDGET_CLASS) (list XmNentryVerticalAlignment XM_UCHAR) (list XmNexportTargets XM_ATOM_LIST)
+ (list XmNexposeCallback XM_CALLBACK) (list XmNextendedSelectionCallback XM_CALLBACK) (list XmNfileListItemCount XM_INT)
+ (list XmNfileListItems XM_STRING_TABLE) (list XmNfileListLabelString XM_XMSTRING) (list XmNfileSearchProc XM_SEARCH_CALLBACK)
+ (list XmNfileTypeMask XM_UCHAR) (list XmNfillOnArm XM_BOOLEAN) (list XmNfillOnSelect XM_BOOLEAN)
+ (list XmNfilterLabelString XM_XMSTRING) (list XmNfocusCallback XM_CALLBACK) (list XmNfont XM_XFONTSTRUCT)
+ (list XmNforeground XM_PIXEL) (list XmNforegroundThreshold XM_INT) (list XmNfractionBase XM_INT)
+ (list XmNgainPrimaryCallback XM_CALLBACK) (list XmNgeometry XM_STRING) (list XmNheight XM_DIMENSION)
+ (list XmNheightInc XM_INT) (list XmNhelpCallback XM_CALLBACK) (list XmNhelpLabelString XM_XMSTRING)
+ (list XmNhighlightColor XM_PIXEL) (list XmNhighlightOnEnter XM_BOOLEAN) (list XmNhighlightPixmap XM_PIXMAP)
+ (list XmNhighlightThickness XM_DIMENSION) (list XmNhistoryItemCount XM_INT) (list XmNhistoryItems XM_STRING_TABLE)
+ (list XmNhistoryMaxItems XM_INT) (list XmNhistoryVisibleItemCount XM_INT) (list XmNhorizontalFontUnit XM_INT)
+ (list XmNhorizontalScrollBar XM_WIDGET) (list XmNhorizontalSpacing XM_DIMENSION) (list XmNhotX XM_POSITION)
+ (list XmNhotY XM_POSITION) (list XmNiconMask XM_PIXMAP) (list XmNiconName XM_STRING)
+ (list XmNiconNameEncoding XM_ATOM) (list XmNiconPixmap XM_PIXMAP) (list XmNiconWindow XM_WIDGET)
+ (list XmNiconX XM_INT) (list XmNiconY XM_INT) (list XmNiconic XM_BOOLEAN)
+ (list XmNimportTargets XM_ATOM_LIST) (list XmNincrement XM_INT) (list XmNincrementCallback XM_CALLBACK)
+ (list XmNincremental XM_BOOLEAN) (list XmNindicatorOn XM_INT) (list XmNindicatorSize XM_DIMENSION)
+ (list XmNindicatorType XM_UCHAR) (list XmNinitialDelay XM_INT) (list XmNinitialFocus XM_WIDGET)
+ (list XmNinitialResourcesPersistent XM_BOOLEAN) (list XmNinitialState XM_INT) (list XmNinput XM_BOOLEAN)
+ (list XmNinputCallback XM_CALLBACK) (list XmNinputMethod XM_STRING) (list XmNinsertPosition XM_ORDER_CALLBACK)
+ (list XmNinvalidCursorForeground XM_PIXEL) (list XmNisAligned XM_BOOLEAN) (list XmNisHomogeneous XM_BOOLEAN)
+ (list XmNitemCount XM_INT) (list XmNitems XM_STRING_TABLE) (list XmNkeyboardFocusPolicy XM_UCHAR)
+ (list XmNlabelInsensitivePixmap XM_PIXMAP) (list XmNlabelPixmap XM_PIXMAP) (list XmNlabelString XM_XMSTRING)
+ (list XmNlabelType XM_UCHAR) (list XmNleftAttachment XM_UCHAR) (list XmNleftOffset XM_INT)
+ (list XmNleftPosition XM_INT) (list XmNleftWidget XM_WIDGET) (list XmNlightThreshold XM_INT)
+ (list XmNlistItemCount XM_INT) (list XmNlistItems XM_STRING_TABLE) (list XmNlistLabelString XM_XMSTRING)
+ (list XmNlistMarginHeight XM_DIMENSION) (list XmNlistMarginWidth XM_DIMENSION) (list XmNlistSizePolicy XM_UCHAR)
+ (list XmNlistSpacing XM_DIMENSION) (list XmNlistUpdated XM_BOOLEAN) (list XmNlistVisibleItemCount XM_INT)
+ (list XmNlosePrimaryCallback XM_CALLBACK) (list XmNlosingFocusCallback XM_CALLBACK) (list XmNmainWindowMarginHeight XM_DIMENSION)
+ (list XmNmainWindowMarginWidth XM_DIMENSION) (list XmNmapCallback XM_CALLBACK) (list XmNmappedWhenManaged XM_BOOLEAN)
+ (list XmNmappingDelay XM_INT) (list XmNmargin XM_DIMENSION) (list XmNmarginBottom XM_DIMENSION)
+ (list XmNmarginHeight XM_DIMENSION) (list XmNmarginLeft XM_DIMENSION) (list XmNmarginRight XM_DIMENSION)
+ (list XmNmarginTop XM_DIMENSION) (list XmNmarginWidth XM_DIMENSION) (list XmNmask XM_PIXMAP)
+ (list XmNmaxAspectX XM_INT) (list XmNmaxAspectY XM_INT) (list XmNmaxHeight XM_INT)
+ (list XmNmaxLength XM_INT) (list XmNmaxWidth XM_INT) (list XmNmaximum XM_INT)
+ (list XmNmenuAccelerator XM_STRING) (list XmNmenuBar XM_WIDGET) (list XmNmenuCursor XM_STRING)
+ (list XmNmenuHelpWidget XM_WIDGET) (list XmNmenuHistory XM_WIDGET) (list XmNmenuPost XM_STRING)
+ (list XmNmessageAlignment XM_UCHAR) (list XmNmessageString XM_XMSTRING) (list XmNmessageWindow XM_WIDGET)
+ (list XmNminAspectX XM_INT) (list XmNminAspectY XM_INT) (list XmNminHeight XM_INT)
+ (list XmNminWidth XM_INT) (list XmNminimizeButtons XM_BOOLEAN) (list XmNminimum XM_INT)
+ (list XmNmnemonic XM_KEYSYM) (list XmNmnemonicCharSet XM_STRING) (list XmNmodifyVerifyCallback XM_CALLBACK)
+ (list XmNmotionVerifyCallback XM_CALLBACK) (list XmNmoveOpaque XM_BOOLEAN) (list XmNmultiClick XM_UCHAR)
+ (list XmNmultipleSelectionCallback XM_CALLBACK) (list XmNmustMatch XM_BOOLEAN) (list XmNmwmDecorations XM_INT)
+ (list XmNmwmFunctions XM_INT) (list XmNmwmInputMode XM_INT) (list XmNmwmMenu XM_STRING)
+ (list XmNnavigationType XM_UCHAR) (list XmNnoMatchCallback XM_CALLBACK) (list XmNnoMatchString XM_XMSTRING)
+ (list XmNnoResize XM_BOOLEAN) (list XmNnoneCursorForeground XM_PIXEL) (list XmNnumChildren XM_INT)
+ (list XmNnumColumns XM_SHORT) (list XmNnumDropRectangles XM_INT) (list XmNnumDropTransfers XM_INT)
+ (list XmNnumExportTargets XM_INT) (list XmNnumImportTargets XM_INT) (list XmNoffsetX XM_POSITION)
+ (list XmNoffsetY XM_POSITION) (list XmNokCallback XM_CALLBACK) (list XmNokLabelString XM_XMSTRING)
+ (list XmNoperationChangedCallback XM_CALLBACK) (list XmNoperationCursorIcon XM_WIDGET) (list XmNoptionLabel XM_XMSTRING)
+ (list XmNoptionMnemonic XM_KEYSYM) (list XmNorientation XM_UCHAR) (list XmNoverrideRedirect XM_BOOLEAN)
+ (list XmNpacking XM_UCHAR) (list XmNpageDecrementCallback XM_CALLBACK) (list XmNpageIncrement XM_INT)
+ (list XmNpageIncrementCallback XM_CALLBACK) (list XmNpaneMaximum XM_DIMENSION) (list XmNpaneMinimum XM_DIMENSION)
+ (list XmNpattern XM_STRING_OR_XMSTRING) (list XmNpendingDelete XM_BOOLEAN) (list XmNpixmap XM_PIXMAP)
+ (list XmNpopdownCallback XM_CALLBACK) (list XmNpopupCallback XM_CALLBACK) (list XmNpopupEnabled XM_INT)
+ (list XmNpositionIndex XM_SHORT) (list XmNpostFromButton XM_INT) (list XmNpreeditType XM_STRING)
+ (list XmNprocessingDirection XM_UCHAR) (list XmNpromptString XM_XMSTRING) (list XmNpushButtonEnabled XM_BOOLEAN)
+ (list XmNqualifySearchDataProc XM_QUALIFY_CALLBACK) (list XmNradioAlwaysOne XM_BOOLEAN) (list XmNradioBehavior XM_BOOLEAN)
+ (list XmNrecomputeSize XM_BOOLEAN) (list XmNrefigureMode XM_BOOLEAN) (list XmNrepeatDelay XM_INT)
+ (list XmNresizable XM_BOOLEAN) (list XmNresizeCallback XM_CALLBACK) (list XmNresizeHeight XM_BOOLEAN)
+ (list XmNresizePolicy XM_UCHAR) (list XmNresizeWidth XM_BOOLEAN) (list XmNrightAttachment XM_UCHAR)
+ (list XmNrightOffset XM_INT) (list XmNrightPosition XM_INT) (list XmNrightWidget XM_WIDGET)
+ (list XmNrowColumnType XM_UCHAR) (list XmNrows XM_SHORT) (list XmNrubberPositioning XM_BOOLEAN)
+ (list XmNsashHeight XM_DIMENSION) (list XmNsashIndent XM_POSITION) (list XmNsashShadowThickness XM_DIMENSION)
+ (list XmNsashWidth XM_DIMENSION) (list XmNsaveUnder XM_BOOLEAN) (list XmNscaleHeight XM_DIMENSION)
+ (list XmNscaleMultiple XM_INT) (list XmNscaleWidth XM_DIMENSION) (list XmNscreen XM_SCREEN)
+ (list XmNscrollBarDisplayPolicy XM_UCHAR) (list XmNscrollBarPlacement XM_UCHAR) (list XmNscrollHorizontal XM_BOOLEAN)
+ (list XmNscrollLeftSide XM_BOOLEAN) (list XmNscrollTopSide XM_BOOLEAN) (list XmNscrollVertical XM_BOOLEAN)
+ (list XmNscrolledWindowMarginHeight XM_DIMENSION) (list XmNscrolledWindowMarginWidth XM_DIMENSION) (list XmNscrollingPolicy XM_UCHAR)
+ (list XmNselectColor XM_PIXEL) (list XmNselectInsensitivePixmap XM_PIXMAP) (list XmNselectPixmap XM_PIXMAP)
+ (list XmNselectThreshold XM_INT) (list XmNselectedItemCount XM_INT) (list XmNselectedItems XM_STRING_TABLE)
+ (list XmNselectionArray XM_INT_TABLE) (list XmNselectionArrayCount XM_INT) (list XmNselectionLabelString XM_XMSTRING)
+ (list XmNselectionPolicy XM_UCHAR) (list XmNsensitive XM_BOOLEAN) (list XmNseparatorOn XM_BOOLEAN)
+ (list XmNseparatorType XM_UCHAR) (list XmNset XM_UCHAR) (list XmNshadowThickness XM_DIMENSION)
+ (list XmNshadowType XM_UCHAR) (list XmNshowArrows XM_BOOLEAN) (list XmNshowAsDefault XM_DIMENSION)
+ (list XmNshowSeparator XM_BOOLEAN) (list XmNsimpleCallback XM_CALLBACK) (list XmNsingleSelectionCallback XM_CALLBACK)
+ (list XmNskipAdjust XM_BOOLEAN) (list XmNsliderSize XM_INT) (list XmNsliderVisual XM_INT)
+ (list XmNslidingMode XM_INT) (list XmNsource XM_TEXT_SOURCE) (list XmNsourceCursorIcon XM_WIDGET)
+ (list XmNsourcePixmapIcon XM_WIDGET) (list XmNspacing XM_DIMENSION) (list XmNspotLocation XM_INT)
+ (list XmNstateCursorIcon XM_WIDGET) (list XmNsubMenuId XM_WIDGET) (list XmNsymbolPixmap XM_PIXMAP)
+ (list XmNtearOffMenuActivateCallback XM_CALLBACK) (list XmNtearOffMenuDeactivateCallback XM_CALLBACK) (list XmNtearOffModel XM_UCHAR)
+ (list XmNtextAccelerators XM_ULONG) (list XmNtextColumns XM_SHORT) (list XmNtextString XM_XMSTRING)
+ (list XmNtextTranslations XM_CALLBACK) (list XmNtitle XM_STRING) (list XmNtitleEncoding XM_ATOM)
+ (list XmNtitleString XM_XMSTRING) (list XmNtoBottomCallback XM_CALLBACK) (list XmNtoTopCallback XM_CALLBACK)
+ (list XmNtopAttachment XM_UCHAR) (list XmNtopCharacter XM_INT) (list XmNtopItemPosition XM_INT)
+ (list XmNtopLevelEnterCallback XM_CALLBACK) (list XmNtopLevelLeaveCallback XM_CALLBACK) (list XmNtopOffset XM_INT)
+ (list XmNtopPosition XM_INT) (list XmNtopShadowColor XM_PIXEL) (list XmNtopShadowPixmap XM_PIXMAP)
+ (list XmNtopWidget XM_WIDGET) (list XmNtransferProc XM_TRANSFER_CALLBACK) (list XmNtransferStatus XM_UCHAR)
+ (list XmNtransient XM_BOOLEAN) (list XmNtransientFor XM_WIDGET) (list XmNtranslations XM_CALLBACK)
+ (list XmNtraversalOn XM_BOOLEAN) (list XmNtraverseObscuredCallback XM_CALLBACK) (list XmNtroughColor XM_PIXEL)
+ (list XmNunitType XM_UCHAR) (list XmNunmapCallback XM_CALLBACK) (list XmNunpostBehavior XM_UCHAR)
+ (list XmNuseAsyncGeometry XM_BOOLEAN) (list XmNuserData XM_ULONG) (list XmNvalidCursorForeground XM_PIXEL)
+ (list XmNvalue XM_STRING_OR_INT) (list XmNvalueChangedCallback XM_CALLBACK) (list XmNverifyBell XM_BOOLEAN)
+ (list XmNverticalFontUnit XM_INT) (list XmNverticalScrollBar XM_WIDGET) (list XmNverticalSpacing XM_DIMENSION)
+ (list XmNvisibleItemCount XM_INT) (list XmNvisibleWhenOff XM_BOOLEAN) (list XmNvisual XM_VISUAL)
+ (list XmNvisualPolicy XM_UCHAR) (list XmNwidth XM_DIMENSION) (list XmNwidthInc XM_INT)
+ (list XmNwinGravity XM_INT) (list XmNwindow XM_WIDGET) (list XmNwindowGroup XM_WINDOW)
+ (list XmNwmTimeout XM_INT) (list XmNwordWrap XM_BOOLEAN) (list XmNworkWindow XM_WIDGET)
+ (list XmNx XM_POSITION) (list XmNy XM_POSITION) (list XmNarrowLayout XM_UCHAR)
+ (list XmNarrowOrientation XM_UCHAR) (list XmNarrowSensitivity XM_UCHAR) (list XmNarrowSize XM_INT)
+ (list XmNarrowSpacing XM_INT) (list XmNautoDragModel XM_INT) (list XmNbackPageBackground XM_PIXEL)
+ (list XmNbackPageForeground XM_PIXEL) (list XmNbackPageNumber XM_INT) (list XmNbackPagePlacement XM_UCHAR)
+ (list XmNbackPageSize XM_DIMENSION) (list XmNbindingPixmap XM_PIXMAP) (list XmNbindingType XM_UCHAR)
+ (list XmNbindingWidth XM_INT) (list XmNbitmapConversionModel XM_INT) (list XmNbuttonRenderTable XM_RENDER_TABLE)
+ (list XmNcollapsedStatePixmap XM_PIXMAP) (list XmNcolorAllocationProc XM_ALLOC_COLOR_CALLBACK)
+ (list XmNcolorCalculationProc XM_SCREEN_COLOR_CALLBACK)
+ (list XmNcomboBoxType XM_UCHAR) (list XmNconvertCallback XM_CALLBACK) (list XmNcurrentPageNumber XM_INT)
+ (list XmNdecimal XM_STRING) (list XmNdefaultArrowSensitivity XM_UCHAR) (list XmNdefaultButtonEmphasis XM_INT)
+ (list XmNdefaultVirtualBindings XM_STRING) (list XmNdestinationCallback XM_CALLBACK) (list XmNdetail XM_STRING_TABLE)
+ (list XmNdetailColumnHeading XM_INT) (list XmNdetailColumnHeadingCount XM_INT) (list XmNdetailCount XM_INT)
+ (list XmNdetailOrder XM_INT_TABLE) (list XmNdetailOrderCount XM_INT) (list XmNdetailShadowThickness XM_INT)
+ (list XmNdetailTabList XM_TAB_LIST) (list XmNdirTextLabelString XM_XMSTRING) (list XmNdragStartCallback XM_CALLBACK)
+ (list XmNenableBtn1Transfer XM_INT) (list XmNenableButtonTab XM_BOOLEAN) (list XmNenableDragIcon XM_BOOLEAN)
+ (list XmNenableEtchedInMenu XM_BOOLEAN) (list XmNenableMultiKeyBindings XM_BOOLEAN) (list XmNenableThinThickness XM_BOOLEAN)
+ (list XmNenableToggleColor XM_BOOLEAN) (list XmNenableToggleVisual XM_BOOLEAN) (list XmNenableUnselectableDrag XM_BOOLEAN)
+ (list XmNenableWarp XM_INT) (list XmNentryParent XM_WIDGET) (list XmNentryViewType XM_UCHAR)
+ (list XmNexpandedStatePixmap XM_PIXMAP) (list XmNfileFilterStyle XM_INT) (list XmNfirstPageNumber XM_INT)
+ (list XmNfontName XM_STRING) (list XmNfontType XM_UCHAR) (list XmNframeBackground XM_PIXEL)
+ (list XmNframeChildType XM_UCHAR) (list XmNframeShadowThickness XM_DIMENSION) (list XmNgrabStyle XM_INT)
+ (list XmNincludeStatus XM_INT) (list XmNincrementValue XM_INT) (list XmNindeterminateInsensitivePixmap XM_PIXMAP)
+ (list XmNindeterminatePixmap XM_PIXMAP) (list XmNinnerMarginHeight XM_DIMENSION) (list XmNinnerMarginWidth XM_DIMENSION)
+ (list XmNinputPolicy XM_ULONG) (list XmNinsensitiveStippleBitmap XM_PIXMAP) (list XmNinvokeParseProc XM_PARSE_CALLBACK)
+ (list XmNlabelRenderTable XM_RENDER_TABLE) (list XmNlargeCellHeight XM_DIMENSION) (list XmNlargeCellWidth XM_DIMENSION)
+ (list XmNlargeIconMask XM_PIXMAP) (list XmNlargeIconPixmap XM_PIXMAP) (list XmNlargeIconX XM_FLOAT)
+ (list XmNlargeIconY XM_FLOAT) (list XmNlastPageNumber XM_INT) (list XmNlayoutDirection XM_UCHAR)
+ (list XmNlayoutType XM_UCHAR) (list XmNlist XM_WIDGET) (list XmNloadModel XM_UCHAR)
+ (list XmNmajorTabSpacing XM_DIMENSION) (list XmNmatchBehavior XM_UCHAR) (list XmNmaximumValue XM_INT)
+ (list XmNminimumValue XM_INT) (list XmNminorTabSpacing XM_DIMENSION) (list XmNmotifVersion XM_INT)
+ (list XmNnoFontCallback XM_CALLBACK) (list XmNnoRenditionCallback XM_CALLBACK) (list XmNnotebookChildType XM_UCHAR)
+ (list XmNnumValues XM_INT) (list XmNoutlineButtonPolicy XM_UCHAR) (list XmNoutlineChangedCallback XM_CALLBACK)
+ (list XmNoutlineColumnWidth XM_DIMENSION) (list XmNoutlineIndentation XM_DIMENSION) (list XmNoutlineLineStyle XM_UCHAR)
+ (list XmNoutlineState XM_UCHAR) (list XmNpageChangedCallback XM_CALLBACK) (list XmNpageNumber XM_INT)
+ (list XmNpathMode XM_INT) (list XmNpatternType XM_UCHAR) (list XmNpopupHandlerCallback XM_CALLBACK)
+ (list XmNposition XM_INT) (list XmNpositionMode XM_INT) (list XmNpositionType XM_UCHAR)
+ (list XmNprimaryOwnership XM_UCHAR) (list XmNrenderTable XM_RENDER_TABLE) (list XmNrenditionBackground XM_PIXEL)
+ (list XmNrenditionForeground XM_PIXEL) (list XmNscrolledWindowChildType XM_UCHAR) (list XmNselectedItem XM_XMSTRING)
+ (list XmNselectedObjectCount XM_INT) (list XmNselectedObjects XM_WIDGET_LIST) (list XmNselectedPosition XM_INT)
+ (list XmNselectedPositionCount XM_INT) (list XmNselectedPositions XM_INT_TABLE) (list XmNselectionCallback XM_CALLBACK)
+ (list XmNselectionMode XM_UCHAR) (list XmNselectionTechnique XM_UCHAR) (list XmNsliderMark XM_INT)
+ (list XmNsmallCellHeight XM_DIMENSION) (list XmNsmallCellWidth XM_DIMENSION) (list XmNsmallIconMask XM_PIXMAP)
+ (list XmNsmallIconPixmap XM_PIXMAP) (list XmNsmallIconX XM_FLOAT) (list XmNsmallIconY XM_FLOAT)
+ (list XmNsnapBackMultiple XM_SHORT) (list XmNspatialIncludeModel XM_UCHAR) (list XmNspatialResizeModel XM_UCHAR)
+ (list XmNspatialSnapModel XM_UCHAR) (list XmNspatialStyle XM_UCHAR) (list XmNspinBoxChildType XM_UCHAR)
+ (list XmNstrikethruType XM_UCHAR) (list XmNsubstitute XM_XMSTRING) (list XmNtabList XM_TAB_LIST)
+ (list XmNtag XM_STRING) (list XmNtearOffTitle XM_XMSTRING) (list XmNtextField XM_WIDGET)
+ (list XmNtextRenderTable XM_RENDER_TABLE) (list XmNtoggleMode XM_UCHAR) (list XmNunderlineType XM_UCHAR)
+ (list XmNunselectColor XM_PIXEL) (list XmNtabValue XM_FLOAT) (list XmNoffsetModel XM_INT)
+ (list XmNcallback XM_CALLBACK) (list XmNwaitForWm XM_BOOLEAN) (list XmNuseColorObj XM_BOOLEAN)
+ (list XmNvalues XM_STRING_TABLE) (list XmNviewType XM_UCHAR) (list XmNvisualEmphasis XM_UCHAR)
+ (list XmNwrap XM_BOOLEAN)
+ )))
- (if (defined? 'XShapeQueryExtents)
- (let* ((dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets))))
- (vals (XShapeQueryExtents dpy win)))
- (if (not (= (car vals) 1))
- (snd-display #__line__ ";XShapeQueryExtents: ~A" vals))
- (set! vals (XShapeGetRectangles dpy win 0))
- (if (not (list? vals)) (snd-display #__line__ ";XShapeGetRectangles: ~A" vals))
+ (for-each
+ (lambda (n)
+ (if (not (string? (car n))) (snd-display #__line__ ";resource ~A is not a string?" (car n)))
+ (XtVaGetValues shell (list (car n) 0)))
+ resource-list)
+ )
+
+ (if (not (XEvent? (XEvent)))
+ (snd-display #__line__ ";xevent type trouble! ~A -> ~A" (XEvent) (XEvent? (XEvent))))
+ (if (not (XGCValues? (XGCValues)))
+ (snd-display #__line__ ";xgcvalues type trouble! ~A -> ~A" (XGCValues) (XGCValues? (XGCValues))))
+ (if (not (= (.direction (XmTraverseObscuredCallbackStruct)) 0))
+ (snd-display #__line__ ";.direction: ~A" (.direction (XmTraverseObscuredCallbackStruct))))
+ (if (.ptr (XmTextBlock))
+ (snd-display #__line__ ";.ptr block: ~A" (.ptr (XmTextBlock))))
+ (let ((hi (XmTextBlock)))
+ (set! (.ptr hi) "hi")
+ (if (not (string=? (.ptr hi) "hi"))
+ (snd-display #__line__ ";.ptr set block: ~A" (.ptr hi)))
+ (if (not (= (.length hi) 0)) (snd-display #__line__ ";.length block: ~A" (.length hi)))
+ (set! (.length hi) 3)
+ (if (not (= (.length hi) 3)) (snd-display #__line__ ";set .length block: ~A" (.length hi))))
+ (if (not (= (.dashes (XGCValues)) 0)) (snd-display #__line__ ";dashes: ~A" (.dashes (XGCValues))))
+ (set! (.dashes (XGCValues)) 1)
+ (set! (.clip_mask (XGCValues)) (list 'Pixmap 0))
+ (set! (.resourceid (XEvent -1)) 0)
+ (set! (.error_code (XEvent -1)) 0)
+ (set! (.request_code (XEvent -1)) 0)
+ (if (not (= (.resourceid (XEvent -1)) 0)) (snd-display #__line__ ";error resourceid: ~A" (.resourceid (XEvent -1))))
+ (if (not (= (.request_code (XEvent -1)) 0)) (snd-display #__line__ ";error request_code: ~A" (.request_code (XEvent -1))))
+ (set! (.pad (XColor)) 1)
+ ;;)
+
+ (if (defined? 'XShapeQueryExtents)
+ (let* ((dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets))))
+ (vals (XShapeQueryExtents dpy win)))
+ (if (not (= (car vals) 1))
+ (snd-display #__line__ ";XShapeQueryExtents: ~A" vals))
+ (set! vals (XShapeGetRectangles dpy win 0))
+ (if (not (list? vals)) (snd-display #__line__ ";XShapeGetRectangles: ~A" vals))
;(segfault) (XtFree (cadr vals))
- (set! vals (XShapeQueryExtension dpy))
- (if (not (equal? vals (list #t 64 0))) (snd-display #__line__ ";XShapeQueryExtension: ~A" vals))
- (set! vals (XShapeQueryVersion dpy))
- (if (and (not (equal? vals (list #t 1 0)))
- (not (equal? vals (list #t 1 1))))
- (snd-display #__line__ ";XShapeQueryVersion: ~A" vals))
- (if (XShapeOffsetShape dpy win 0 0 0) (snd-display #__line__ ";XShapeOffsetShape?"))
-
- (let* ((attr (XSetWindowAttributes #f (basic-color) #f (highlight-color)))
- (newwin (XCreateWindow dpy win 10 10 100 100 3
- CopyFromParent InputOutput (list 'Visual CopyFromParent)
- (logior CWBackPixel CWBorderPixel)
- attr))
- (bitmap (XCreateBitmapFromData dpy win right-arrow 16 12))) ; right-arrow is in snd-motif.scm
- (XShapeCombineMask dpy newwin ShapeClip 0 0 bitmap ShapeSet)
- (XShapeCombineRectangles dpy newwin ShapeUnion 0 0
- (list (XRectangle 0 0 10 10) (XRectangle 0 0 10 30)) 2
- ShapeSet ShapeBounding)
- (let ((newerwin (XCreateWindow dpy win 10 10 100 100 3
- CopyFromParent InputOutput (list 'Visual CopyFromParent)
- (logior CWBackPixel CWBorderPixel)
- attr)))
- (XShapeCombineShape dpy newerwin ShapeIntersect 0 0 newwin ShapeSet ShapeClip))
- (let* ((reg1 (XPolygonRegion (list (XPoint 2 2) (XPoint 10 2) (XPoint 10 10) (XPoint 2 10)) 4 WindingRule)))
- (XShapeCombineRegion dpy newwin ShapeUnion 0 0 reg1 ShapeSet)))))
-
- (let ((classes (list xmArrowButtonWidgetClass xmBulletinBoardWidgetClass xmCascadeButtonWidgetClass xmCommandWidgetClass
- xmDrawingAreaWidgetClass xmDrawnButtonWidgetClass xmFileSelectionBoxWidgetClass xmFormWidgetClass
- xmFrameWidgetClass xmLabelWidgetClass xmListWidgetClass xmMainWindowWidgetClass xmManagerWidgetClass
- xmMessageBoxWidgetClass xmPanedWindowWidgetClass xmPrimitiveWidgetClass xmPushButtonWidgetClass
- xmRowColumnWidgetClass xmScaleWidgetClass xmScrollBarWidgetClass xmScrolledWindowWidgetClass
- xmSelectionBoxWidgetClass xmSeparatorWidgetClass xmTextFieldWidgetClass xmTextWidgetClass
- xmToggleButtonWidgetClass xmContainerWidgetClass xmComboBoxWidgetClass xmNotebookWidgetClass))
- (wids '()))
- (for-each
- (lambda (class)
- (let* ((shell (cadr (main-widgets)))
- (wid (XtCreateWidget "hiho" class shell '())))
- (set! wids (cons wid wids))
- (XtAddCallback wid XmNhelpCallback (lambda (w c i) "help!"))))
- classes)
- (for-each
- (lambda (w)
- (XtCallCallbacks w XmNhelpCallback #f))
- wids))
-
- (let ((key (XStringToKeysym "Cancel")))
- (if (not (= (cadr key) XK_Cancel))
- (snd-display #__line__ ";XStringToKeysym ~A ~A" key XK_Cancel)))
-
- (let* ((win (XtWindow (cadr (main-widgets))))
- (xm-procs-1
- (list
- XPutBackEvent XNextEvent
- XtAppProcessEvent XtAppMainLoop XtAppAddActions XtAppNextEvent XtAppPeekEvent
-
- XtSetArg XtManageChildren XtManageChild XtUnmanageChildren XtUnmanageChild
- XtDispatchEvent XtCallAcceptFocus XtIsSubclass XtIsObject XtIsManaged XtIsRealized
- XtIsSensitive XtOwnSelection XtOwnSelectionIncremental XtMakeResizeRequest XtTranslateCoords
- XtKeysymToKeycodeList XtParseTranslationTable XtParseAcceleratorTable XtOverrideTranslations XtAugmentTranslations
- XtInstallAccelerators XtInstallAllAccelerators XtUninstallTranslations XtAppAddActionHook
- XtRemoveActionHook XtGetActionList XtCallActionProc XtRegisterGrabAction XtSetMultiClickTime
- XtGetMultiClickTime XtGetActionKeysym XtTranslateKeycode XtTranslateKey XtSetKeyTranslator
- XtRegisterCaseConverter XtConvertCase XtAddEventHandler XtRemoveEventHandler XtAddRawEventHandler
- XtRemoveRawEventHandler XtInsertEventHandler XtInsertRawEventHandler XtDispatchEventToWidget
- XtBuildEventMask XtAddGrab XtRemoveGrab XtAddExposureToRegion XtSetKeyboardFocus
- XtGetKeyboardFocusWidget XtLastEventProcessed XtLastTimestampProcessed
- XtAppAddTimeOut XtRemoveTimeOut XtAppAddInput XtRemoveInput XtAppPending
- XtRealizeWidget XtUnrealizeWidget XtSetSensitive XtNameToWidget XtWindowToWidget
- XtMergeArgLists XtVaCreateArgsList XtDisplay XtDisplayOfObject XtScreen XtScreenOfObject
- XtWindow XtWindowOfObject XtName XtSuperclass XtClass XtParent XtAddCallback XtRemoveCallback
- XtAddCallbacks XtRemoveCallbacks XtRemoveAllCallbacks XtCallCallbacks
- XtHasCallbacks XtCreatePopupShell XtVaCreatePopupShell XtPopup XtPopupSpringLoaded
- XtCallbackNone XtCallbackNonexclusive XtCallbackExclusive XtPopdown XtCallbackPopdown
- XtCreateWidget XtCreateManagedWidget XtVaCreateWidget XtVaCreateManagedWidget
- XtAppCreateShell XtVaAppCreateShell
- XtDisplayToApplicationContext
- XtSetValues XtVaSetValues XtGetValues XtVaGetValues
- XtAppSetErrorMsgHandler XtAppSetWarningMsgHandler
- XtAppErrorMsg XtAppWarningMsg XtAppSetErrorHandler
- XtAppSetWarningHandler XtAppError
- XtAppAddWorkProc XtGetGC XtAllocateGC XtDestroyGC XtReleaseGC
- XtFindFile XtResolvePathname XtDisownSelection XtGetSelectionValue
- XtGetSelectionValues XtAppSetSelectionTimeout XtAppGetSelectionTimeout
- XtGetSelectionRequest XtGetSelectionValueIncremental
- XtGetSelectionValuesIncremental XtCreateSelectionRequest XtSendSelectionRequest
- XtCancelSelectionRequest XtGrabKey XtUngrabKey
- XtGrabKeyboard XtUngrabKeyboard XtGrabButton XtUngrabButton XtGrabPointer XtUngrabPointer
- XtGetApplicationNameAndClass XtGetDisplays XtToolkitThreadInitialize XtAppLock XtAppUnlock XtIsRectObj XtIsWidget
- XtIsComposite XtIsConstraint XtIsShell XtIsOverrideShell XtIsWMShell XtIsVendorShell
- XtIsTransientShell XtIsTopLevelShell XtIsApplicationShell XtIsSessionShell XtMapWidget
- XtUnmapWidget XLoadQueryFont XQueryFont XGetMotionEvents XDeleteModifiermapEntry
- XGetModifierMapping XInsertModifiermapEntry XNewModifiermap XCreateImage XGetImage
- XGetSubImage XOpenDisplay XFetchBytes XFetchBuffer XGetAtomName XDisplayName XUniqueContext
- XKeysymToString XSynchronize XSetAfterFunction XInternAtom XCopyColormapAndFree XCreateColormap
- XCreatePixmapCursor XCreateGlyphCursor XCreateFontCursor XLoadFont XCreateGC XFlushGC
- XCreatePixmap XCreateBitmapFromData XCreatePixmapFromBitmapData XCreateSimpleWindow
- XGetSelectionOwner XCreateWindow XListInstalledColormaps XListFonts XListFontsWithInfo
- XListExtensions XListProperties XKeycodeToKeysym XLookupKeysym
- XGetKeyboardMapping ;XStringToKeysym
- XDisplayMotionBufferSize XVisualIDFromVisual XMaxRequestSize XExtendedMaxRequestSize
- XRootWindow XDefaultRootWindow XRootWindowOfScreen
- XDefaultVisual XDefaultVisualOfScreen XDefaultGC XDefaultGCOfScreen XBlackPixel XWhitePixel
- XAllPlanes XBlackPixelOfScreen XWhitePixelOfScreen XNextRequest XLastKnownRequestProcessed
- XServerVendor XDisplayString XDefaultColormap XDefaultColormapOfScreen XDisplayOfScreen
- XScreenOfDisplay XDefaultScreenOfDisplay XEventMaskOfScreen XScreenNumberOfScreen
- XSetErrorHandler XSetIOErrorHandler XListPixmapFormats XListDepths XReconfigureWMWindow
- XGetWMProtocols XSetWMProtocols XIconifyWindow XWithdrawWindow XGetCommand XGetWMColormapWindows
- XSetTransientForHint XActivateScreenSaver
- XAllocColor XAllocColorCells XAllocColorPlanes XAllocNamedColor
- XAllowEvents XAutoRepeatOff XAutoRepeatOn XBell XBitmapBitOrder XBitmapPad XBitmapUnit
- XCellsOfScreen XChangeActivePointerGrab XChangeGC XChangeKeyboardControl XChangeKeyboardMapping
- XChangePointerControl XChangeProperty XChangeWindowAttributes ; XCheckIfEvent
- XCheckMaskEvent XCheckTypedEvent XCheckTypedWindowEvent XCheckWindowEvent XCirculateSubwindows
- XCirculateSubwindowsDown XCirculateSubwindowsUp XClearArea XClearWindow XCloseDisplay
- XConfigureWindow XConnectionNumber XConvertSelection XCopyArea XCopyGC XCopyPlane XDefaultDepth
- XDefaultDepthOfScreen XDefaultScreen XDefineCursor XDeleteProperty XDestroyWindow
- XDestroySubwindows XDoesBackingStore XDoesSaveUnders XDisableAccessControl XDisplayCells
- XDisplayHeight XDisplayHeightMM XDisplayKeycodes XDisplayPlanes XDisplayWidth XDisplayWidthMM
- XDrawArc XDrawArcs XDrawImageString XDrawLine XDrawLines XDrawLinesDirect XDrawPoint
- XDrawPoints XDrawRectangle XDrawRectangles XDrawSegments XDrawString XDrawText
- XEnableAccessControl XEventsQueued XFetchName XFillArc XFillArcs XFillPolygon XFillRectangle
- XFillRectangles XFlush XForceScreenSaver XFreeColormap XFreeColors XFreeCursor
- XFreeExtensionList XFreeFont XFreeFontInfo XFreeFontNames XFreeFontPath XFreeGC
- XFreeModifiermap XFreePixmap XGeometry XGetErrorText XGetFontProperty
- XGetGCValues XGCValues XEvent XGetGeometry XGetIconName XGetInputFocus XGetKeyboardControl
- XGetPointerControl XGetPointerMapping XGetScreenSaver XGetTransientForHint XGetWindowProperty
- XGetWindowAttributes XGrabButton XGrabKey XGrabKeyboard XGrabPointer XGrabServer
- XHeightMMOfScreen XHeightOfScreen XIfEvent XImageByteOrder XInstallColormap XKeysymToKeycode
- XKillClient XLookupColor XLowerWindow XMapRaised XMapSubwindows XMapWindow XMaskEvent
- XMaxCmapsOfScreen XMinCmapsOfScreen XMoveResizeWindow XMoveWindow XNoOp XParseColor
- XParseGeometry XPeekEvent XPeekIfEvent XPending XPlanesOfScreen XProtocolRevision
- XProtocolVersion XPutImage XQLength XQueryBestCursor XQueryBestSize XQueryBestStipple
- XQueryBestTile XQueryColor XQueryColors XQueryExtension XQueryKeymap XQueryPointer
- XQueryTextExtents XQueryTree XRaiseWindow XRebindKeysym XRecolorCursor XRefreshKeyboardMapping
- XReparentWindow XResetScreenSaver XResizeWindow
- XRestackWindows XRotateBuffers XRotateWindowProperties XScreenCount XSelectInput XSendEvent
- XSetAccessControl XSetArcMode XSetBackground XSetClipMask XSetClipOrigin XSetClipRectangles
- XSetCloseDownMode XSetCommand XSetDashes XSetFillRule XSetFillStyle XSetFont XSetFontPath
- XSetForeground XSetFunction XSetGraphicsExposures XSetIconName XSetInputFocus XSetLineAttributes
- XSetModifierMapping XSetPlaneMask XSetPointerMapping XSetScreenSaver XSetSelectionOwner
- XSetState XSetStipple XSetSubwindowMode XSetTSOrigin XSetTile XSetWindowBackground
- XSetWindowBackgroundPixmap XSetWindowBorder XSetWindowBorderPixmap XSetWindowBorderWidth
- XSetWindowColormap XStoreBuffer XStoreBytes XStoreColor XStoreColors XStoreName
- XStoreNamedColor XSync XTextExtents XTextWidth XTranslateCoordinates XUndefineCursor
- XUngrabButton XUngrabKey XUngrabKeyboard XUngrabPointer XUngrabServer XUninstallColormap
- XUnloadFont XUnmapSubwindows XUnmapWindow XVendorRelease XWarpPointer XWidthMMOfScreen
- XWidthOfScreen XWindowEvent XWriteBitmapFile XSupportsLocale XSetLocaleModifiers XCreateFontSet
- XFreeFontSet XFontsOfFontSet XBaseFontNameListOfFontSet XLocaleOfFontSet XContextDependentDrawing
- XDirectionalDependentDrawing XContextualDrawing XFilterEvent XAllocIconSize
- XAllocStandardColormap XAllocWMHints XClipBox XCreateRegion XDefaultString XDeleteContext
- XDestroyRegion XEmptyRegion XEqualRegion ;XFindContext
- XGetIconSizes XGetRGBColormaps
- XGetVisualInfo XGetWMHints XIntersectRegion XConvertCase XLookupString
- XMatchVisualInfo XOffsetRegion XPointInRegion XPolygonRegion XRectInRegion XSaveContext
- XSetRGBColormaps XSetWMHints XSetRegion XShrinkRegion XSubtractRegion
- XUnionRectWithRegion XUnionRegion XXorRegion DefaultScreen DefaultRootWindow QLength
- ScreenCount ServerVendor ProtocolVersion ProtocolRevision VendorRelease DisplayString
- BitmapUnit BitmapBitOrder BitmapPad ImageByteOrder NextRequest LastKnownRequestProcessed
- DefaultScreenOfDisplay DisplayOfScreen RootWindowOfScreen BlackPixelOfScreen WhitePixelOfScreen
- DefaultColormapOfScreen DefaultDepthOfScreen DefaultGCOfScreen DefaultVisualOfScreen
- WidthOfScreen HeightOfScreen WidthMMOfScreen HeightMMOfScreen PlanesOfScreen CellsOfScreen
- MinCmapsOfScreen MaxCmapsOfScreen DoesSaveUnders DoesBackingStore EventMaskOfScreen RootWindow
- DefaultVisual DefaultGC BlackPixel WhitePixel DisplayWidth DisplayHeight DisplayWidthMM
- DisplayHeightMM DisplayPlanes DisplayCells DefaultColormap ScreenOfDisplay DefaultDepth
- IsKeypadKey IsPrivateKeypadKey IsCursorKey IsPFKey IsFunctionKey IsMiscFunctionKey
- IsModifierKey XmCreateMessageBox XmCreateMessageDialog XmCreateErrorDialog
- XmCreateInformationDialog XmCreateQuestionDialog XmCreateWarningDialog XmCreateWorkingDialog
- XmCreateTemplateDialog XmMessageBoxGetChild XmCreateArrowButtonGadget XmCreateArrowButton
- XmCreateNotebook XmNotebookGetPageInfo
- XmTransferSetParameters XmTransferValue XmCreateComboBox
- XmCreateDropDownComboBox XmCreateDropDownList XmComboBoxAddItem XmComboBoxDeletePos
- XmComboBoxSelectItem XmComboBoxSetItem XmComboBoxUpdate XmCreateContainer
- XmContainerGetItemChildren XmContainerRelayout XmContainerReorder XmContainerCut XmContainerCopy
- XmContainerPaste XmContainerCopyLink XmContainerPasteLink XmCreateSpinBox
- XmSpinBoxValidatePosition XmCreateSimpleSpinBox XmSimpleSpinBoxAddItem XmSimpleSpinBoxDeletePos
- XmSimpleSpinBoxSetItem XmDropSiteRegistered XmTextFieldCopyLink XmTextFieldPasteLink
- XmTextGetCenterline XmToggleButtonGadgetSetValue XmCreateIconGadget
- XmCreateIconHeader XmObjectAtPoint XmConvertStringToUnits XmCreateGrabShell
- XmToggleButtonSetValue XmTextPasteLink XmTextCopyLink XmScaleSetTicks XmInternAtom XmGetAtomName
- XmCreatePanedWindow XmCreateBulletinBoard XmCreateBulletinBoardDialog XmCreateCascadeButtonGadget
- XmCascadeButtonGadgetHighlight XmAddProtocols XmRemoveProtocols XmAddProtocolCallback
- XmRemoveProtocolCallback XmActivateProtocol XmDeactivateProtocol XmSetProtocolHooks
- XmCreateCascadeButton XmCascadeButtonHighlight XmCreatePushButtonGadget XmCreatePushButton
- XmCreateCommand XmCommandGetChild XmCommandSetValue XmCommandAppendValue XmCommandError
- XmCreateCommandDialog XmMenuPosition XmCreateRowColumn XmCreateWorkArea XmCreateRadioBox
- XmCreateOptionMenu XmOptionLabelGadget XmOptionButtonGadget XmCreateMenuBar XmCreatePopupMenu
- XmCreatePulldownMenu XmGetPostedFromWidget XmGetTearOffControl
- XmScaleSetValue XmScaleGetValue XmCreateScale
- XmClipboardStartCopy XmClipboardCopy XmClipboardEndCopy XmClipboardCancelCopy
- XmClipboardWithdrawFormat XmClipboardCopyByName XmClipboardUndoCopy XmClipboardLock
- XmClipboardUnlock XmClipboardStartRetrieve XmClipboardEndRetrieve XmClipboardRetrieve
- XmClipboardInquireCount XmClipboardInquireFormat XmClipboardInquireLength
- XmClipboardInquirePendingItems XmClipboardRegisterFormat XmGetXmScreen XmCreateScrollBar
- XmScrollBarGetValues XmScrollBarSetValues XmCreateDialogShell
- XmCreateScrolledWindow XmScrollVisible XmGetDragContext XmGetXmDisplay XmSelectionBoxGetChild
- XmCreateSelectionBox XmCreateSelectionDialog XmCreatePromptDialog XmDragStart XmDragCancel
- XmTargetsAreCompatible XmCreateSeparatorGadget XmCreateDragIcon XmCreateSeparator
- XmCreateDrawingArea XmCreateDrawnButton XmDropSiteRegister XmDropSiteUnregister
- XmDropSiteStartUpdate XmDropSiteUpdate XmDropSiteEndUpdate XmDropSiteRetrieve
- XmDropSiteQueryStackingOrder XmDropSiteConfigureStackingOrder XmDropTransferStart
- XmDropTransferAdd XmTextFieldGetString XmTextFieldGetSubstring XmTextFieldGetLastPosition
- XmTextFieldSetString XmTextFieldReplace XmTextFieldInsert XmTextFieldSetAddMode
- XmTextFieldGetAddMode XmTextFieldGetEditable XmTextFieldSetEditable XmTextFieldGetMaxLength
- XmTextFieldSetMaxLength XmTextFieldGetCursorPosition XmTextFieldGetInsertionPosition
- XmTextFieldSetCursorPosition XmTextFieldSetInsertionPosition XmTextFieldGetSelectionPosition
- XmTextFieldGetSelection XmTextFieldRemove XmTextFieldCopy XmTextFieldCut XmTextFieldPaste
- XmTextFieldClearSelection XmTextFieldSetSelection XmTextFieldXYToPos XmTextFieldPosToXY
- XmTextFieldShowPosition XmTextFieldSetHighlight XmTextFieldGetBaseline XmCreateTextField
- XmFileSelectionBoxGetChild XmFileSelectionDoSearch XmCreateFileSelectionBox
- XmCreateFileSelectionDialog XmTextSetHighlight XmCreateScrolledText XmCreateText
- XmTextGetSubstring XmTextGetString XmTextGetLastPosition XmTextSetString XmTextReplace
- XmTextInsert XmTextSetAddMode XmTextGetAddMode XmTextGetEditable XmTextSetEditable
- XmTextGetMaxLength XmTextSetMaxLength XmTextGetTopCharacter XmTextSetTopCharacter
- XmTextGetCursorPosition XmTextGetInsertionPosition XmTextSetInsertionPosition
- XmTextSetCursorPosition XmTextRemove XmTextCopy XmTextCut XmTextPaste XmTextGetSelection
- XmTextSetSelection XmTextClearSelection XmTextGetSelectionPosition XmTextXYToPos XmTextPosToXY
- XmTextGetSource XmTextSetSource XmTextShowPosition XmTextScroll XmTextGetBaseline
- XmTextDisableRedisplay XmTextEnableRedisplay XmTextFindString XmCreateForm XmCreateFormDialog
- XmCreateFrame XmToggleButtonGadgetGetState XmToggleButtonGadgetSetState XmCreateToggleButtonGadget
- XmToggleButtonGetState XmToggleButtonSetState XmCreateToggleButton XmCreateLabelGadget
- XmCreateLabel XmIsMotifWMRunning XmListAddItem XmListAddItems XmListAddItemsUnselected
- XmListAddItemUnselected XmListDeleteItem XmListDeleteItems XmListDeletePositions XmListDeletePos
- XmListDeleteItemsPos XmListDeleteAllItems XmListReplaceItems XmListReplaceItemsPos
- XmListReplaceItemsUnselected XmListReplaceItemsPosUnselected XmListReplacePositions
- XmListSelectItem XmListSelectPos XmListDeselectItem XmListDeselectPos XmListDeselectAllItems
- XmListSetPos XmListSetBottomPos XmListSetItem XmListSetBottomItem XmListSetAddMode
- XmListItemExists XmListItemPos XmListGetKbdItemPos XmListSetKbdItemPos XmListYToPos
- XmListPosToBounds XmListGetMatchPos XmListGetSelectedPos XmListSetHorizPos
- XmListUpdateSelectedList XmListPosSelected XmCreateList XmCreateScrolledList XmTranslateKey
- XmInstallImage XmUninstallImage XmGetPixmap XmGetPixmapByDepth XmDestroyPixmap XmUpdateDisplay
- XmWidgetGetBaselines XmRegisterSegmentEncoding XmMapSegmentEncoding
- XmCvtCTToXmString XmCvtXmStringToCT XmConvertUnits
- XmCreateSimpleMenuBar XmCreateSimplePopupMenu XmCreateSimplePulldownMenu
- XmCreateSimpleOptionMenu XmCreateSimpleRadioBox XmCreateSimpleCheckBox XmVaCreateSimpleMenuBar
- XmVaCreateSimplePopupMenu XmVaCreateSimplePulldownMenu XmVaCreateSimpleOptionMenu
- XmVaCreateSimpleRadioBox XmVaCreateSimpleCheckBox XmTrackingEvent
- XmSetColorCalculation XmGetColorCalculation XmGetColors XmChangeColor XmStringCreate
- XmStringCreateLocalized XmStringDirectionCreate XmStringSeparatorCreate
- XmStringInitContext
- XmStringFreeContext
- XmStringConcatAndFree XmStringIsVoid XmStringPeekNextTriple XmStringGetNextTriple
- XmStringComponentCreate XmStringUnparse XmStringParseText XmStringToXmStringTable
- XmStringTableToXmString XmStringTableUnparse XmStringTableParseStringArray
- XmDirectionToStringDirection XmStringDirectionToDirection XmStringGenerate XmStringPutRendition
- XmParseMappingGetValues XmParseMappingFree XmParseTableFree XmStringTableProposeTablist
- XmTabSetValue XmTabGetValues XmTabFree XmTabCreate XmTabListTabCount XmTabListRemoveTabs
- XmTabListReplacePositions XmTabListGetTab XmTabListCopy XmTabListInsertTabs
+ (set! vals (XShapeQueryExtension dpy))
+ (if (not (equal? vals (list #t 64 0))) (snd-display #__line__ ";XShapeQueryExtension: ~A" vals))
+ (set! vals (XShapeQueryVersion dpy))
+ (if (and (not (equal? vals (list #t 1 0)))
+ (not (equal? vals (list #t 1 1))))
+ (snd-display #__line__ ";XShapeQueryVersion: ~A" vals))
+ (if (XShapeOffsetShape dpy win 0 0 0) (snd-display #__line__ ";XShapeOffsetShape?"))
+
+ (let* ((attr (XSetWindowAttributes #f *basic-color* #f *highlight-color*))
+ (newwin (XCreateWindow dpy win 10 10 100 100 3
+ CopyFromParent InputOutput (list 'Visual CopyFromParent)
+ (logior CWBackPixel CWBorderPixel)
+ attr))
+ (bitmap (XCreateBitmapFromData dpy win right-arrow 16 12))) ; right-arrow is in snd-motif.scm
+ (XShapeCombineMask dpy newwin ShapeClip 0 0 bitmap ShapeSet)
+ (XShapeCombineRectangles dpy newwin ShapeUnion 0 0
+ (list (XRectangle 0 0 10 10) (XRectangle 0 0 10 30)) 2
+ ShapeSet ShapeBounding)
+ (let ((newerwin (XCreateWindow dpy win 10 10 100 100 3
+ CopyFromParent InputOutput (list 'Visual CopyFromParent)
+ (logior CWBackPixel CWBorderPixel)
+ attr)))
+ (XShapeCombineShape dpy newerwin ShapeIntersect 0 0 newwin ShapeSet ShapeClip))
+ (let ((reg1 (XPolygonRegion (list (XPoint 2 2) (XPoint 10 2) (XPoint 10 10) (XPoint 2 10)) 4 WindingRule)))
+ (XShapeCombineRegion dpy newwin ShapeUnion 0 0 reg1 ShapeSet)))))
+
+ (let ((classes (list xmArrowButtonWidgetClass xmBulletinBoardWidgetClass xmCascadeButtonWidgetClass xmCommandWidgetClass
+ xmDrawingAreaWidgetClass xmDrawnButtonWidgetClass xmFileSelectionBoxWidgetClass xmFormWidgetClass
+ xmFrameWidgetClass xmLabelWidgetClass xmListWidgetClass xmMainWindowWidgetClass xmManagerWidgetClass
+ xmMessageBoxWidgetClass xmPanedWindowWidgetClass xmPrimitiveWidgetClass xmPushButtonWidgetClass
+ xmRowColumnWidgetClass xmScaleWidgetClass xmScrollBarWidgetClass xmScrolledWindowWidgetClass
+ xmSelectionBoxWidgetClass xmSeparatorWidgetClass xmTextFieldWidgetClass xmTextWidgetClass
+ xmToggleButtonWidgetClass xmContainerWidgetClass xmComboBoxWidgetClass xmNotebookWidgetClass))
+ (wids ()))
+ (for-each
+ (lambda (class)
+ (let* ((shell (cadr (main-widgets)))
+ (wid (XtCreateWidget "hiho" class shell ())))
+ (set! wids (cons wid wids))
+ (XtAddCallback wid XmNhelpCallback (lambda (w c i) "help!"))))
+ classes)
+ (for-each
+ (lambda (w)
+ (XtCallCallbacks w XmNhelpCallback #f))
+ wids))
+
+ (let ((key (XStringToKeysym "Cancel")))
+ (if (not (= (cadr key) XK_Cancel))
+ (snd-display #__line__ ";XStringToKeysym ~A ~A" key XK_Cancel)))
+
+ (let* ((win (XtWindow (cadr (main-widgets))))
+ (xm-procs-1
+ (list
+ XPutBackEvent XNextEvent
+ XtAppProcessEvent XtAppMainLoop XtAppAddActions XtAppNextEvent XtAppPeekEvent
+
+ XtSetArg XtManageChildren XtManageChild XtUnmanageChildren XtUnmanageChild
+ XtDispatchEvent XtCallAcceptFocus XtIsSubclass XtIsObject XtIsManaged XtIsRealized
+ XtIsSensitive XtOwnSelection XtOwnSelectionIncremental XtMakeResizeRequest XtTranslateCoords
+ XtKeysymToKeycodeList XtParseTranslationTable XtParseAcceleratorTable XtOverrideTranslations XtAugmentTranslations
+ XtInstallAccelerators XtInstallAllAccelerators XtUninstallTranslations XtAppAddActionHook
+ XtRemoveActionHook XtGetActionList XtCallActionProc XtRegisterGrabAction XtSetMultiClickTime
+ XtGetMultiClickTime XtGetActionKeysym XtTranslateKeycode XtTranslateKey XtSetKeyTranslator
+ XtRegisterCaseConverter XtConvertCase XtAddEventHandler XtRemoveEventHandler XtAddRawEventHandler
+ XtRemoveRawEventHandler XtInsertEventHandler XtInsertRawEventHandler XtDispatchEventToWidget
+ XtBuildEventMask XtAddGrab XtRemoveGrab XtAddExposureToRegion XtSetKeyboardFocus
+ XtGetKeyboardFocusWidget XtLastEventProcessed XtLastTimestampProcessed
+ XtAppAddTimeOut XtRemoveTimeOut XtAppAddInput XtRemoveInput XtAppPending
+ XtRealizeWidget XtUnrealizeWidget XtSetSensitive XtNameToWidget XtWindowToWidget
+ XtMergeArgLists XtVaCreateArgsList XtDisplay XtDisplayOfObject XtScreen XtScreenOfObject
+ XtWindow XtWindowOfObject XtName XtSuperclass XtClass XtParent XtAddCallback XtRemoveCallback
+ XtAddCallbacks XtRemoveCallbacks XtRemoveAllCallbacks XtCallCallbacks
+ XtHasCallbacks XtCreatePopupShell XtVaCreatePopupShell XtPopup XtPopupSpringLoaded
+ XtCallbackNone XtCallbackNonexclusive XtCallbackExclusive XtPopdown XtCallbackPopdown
+ XtCreateWidget XtCreateManagedWidget XtVaCreateWidget XtVaCreateManagedWidget
+ XtAppCreateShell XtVaAppCreateShell
+ XtDisplayToApplicationContext
+ XtSetValues XtVaSetValues XtGetValues XtVaGetValues
+ XtAppSetErrorMsgHandler XtAppSetWarningMsgHandler
+ XtAppErrorMsg XtAppWarningMsg XtAppSetErrorHandler
+ XtAppSetWarningHandler XtAppError
+ XtAppAddWorkProc XtGetGC XtAllocateGC XtDestroyGC XtReleaseGC
+ XtFindFile XtResolvePathname XtDisownSelection XtGetSelectionValue
+ XtGetSelectionValues XtAppSetSelectionTimeout XtAppGetSelectionTimeout
+ XtGetSelectionRequest XtGetSelectionValueIncremental
+ XtGetSelectionValuesIncremental XtCreateSelectionRequest XtSendSelectionRequest
+ XtCancelSelectionRequest XtGrabKey XtUngrabKey
+ XtGrabKeyboard XtUngrabKeyboard XtGrabButton XtUngrabButton XtGrabPointer XtUngrabPointer
+ XtGetApplicationNameAndClass XtGetDisplays XtToolkitThreadInitialize XtAppLock XtAppUnlock XtIsRectObj XtIsWidget
+ XtIsComposite XtIsConstraint XtIsShell XtIsOverrideShell XtIsWMShell XtIsVendorShell
+ XtIsTransientShell XtIsTopLevelShell XtIsApplicationShell XtIsSessionShell XtMapWidget
+ XtUnmapWidget XLoadQueryFont XQueryFont XGetMotionEvents XDeleteModifiermapEntry
+ XGetModifierMapping XInsertModifiermapEntry XNewModifiermap XCreateImage XGetImage
+ XGetSubImage XOpenDisplay XFetchBytes XFetchBuffer XGetAtomName XDisplayName XUniqueContext
+ XKeysymToString XSynchronize XSetAfterFunction XInternAtom XCopyColormapAndFree XCreateColormap
+ XCreatePixmapCursor XCreateGlyphCursor XCreateFontCursor XLoadFont XCreateGC XFlushGC
+ XCreatePixmap XCreateBitmapFromData XCreatePixmapFromBitmapData XCreateSimpleWindow
+ XGetSelectionOwner XCreateWindow XListInstalledColormaps XListFonts XListFontsWithInfo
+ XListExtensions XListProperties ;XKeycodeToKeysym
+ XLookupKeysym
+ XGetKeyboardMapping ;XStringToKeysym
+ XDisplayMotionBufferSize XVisualIDFromVisual XMaxRequestSize XExtendedMaxRequestSize
+ XRootWindow XDefaultRootWindow XRootWindowOfScreen
+ XDefaultVisual XDefaultVisualOfScreen XDefaultGC XDefaultGCOfScreen XBlackPixel XWhitePixel
+ XAllPlanes XBlackPixelOfScreen XWhitePixelOfScreen XNextRequest XLastKnownRequestProcessed
+ XServerVendor XDisplayString XDefaultColormap XDefaultColormapOfScreen XDisplayOfScreen
+ XScreenOfDisplay XDefaultScreenOfDisplay XEventMaskOfScreen XScreenNumberOfScreen
+ XSetErrorHandler XSetIOErrorHandler XListPixmapFormats XListDepths XReconfigureWMWindow
+ XGetWMProtocols XSetWMProtocols XIconifyWindow XWithdrawWindow XGetCommand XGetWMColormapWindows
+ XSetTransientForHint XActivateScreenSaver
+ XAllocColor XAllocColorCells XAllocColorPlanes XAllocNamedColor
+ XAllowEvents XAutoRepeatOff XAutoRepeatOn XBell XBitmapBitOrder XBitmapPad XBitmapUnit
+ XCellsOfScreen XChangeActivePointerGrab XChangeGC XChangeKeyboardControl XChangeKeyboardMapping
+ XChangePointerControl XChangeProperty XChangeWindowAttributes ; XCheckIfEvent
+ XCheckMaskEvent XCheckTypedEvent XCheckTypedWindowEvent XCheckWindowEvent XCirculateSubwindows
+ XCirculateSubwindowsDown XCirculateSubwindowsUp XClearArea XClearWindow XCloseDisplay
+ XConfigureWindow XConnectionNumber XConvertSelection XCopyArea XCopyGC XCopyPlane XDefaultDepth
+ XDefaultDepthOfScreen XDefaultScreen XDefineCursor XDeleteProperty XDestroyWindow
+ XDestroySubwindows XDoesBackingStore XDoesSaveUnders XDisableAccessControl XDisplayCells
+ XDisplayHeight XDisplayHeightMM XDisplayKeycodes XDisplayPlanes XDisplayWidth XDisplayWidthMM
+ XDrawArc XDrawArcs XDrawImageString XDrawLine XDrawLines XDrawLinesDirect XDrawPoint
+ XDrawPoints XDrawRectangle XDrawRectangles XDrawSegments XDrawString XDrawText
+ XEnableAccessControl XEventsQueued XFetchName XFillArc XFillArcs XFillPolygon XFillRectangle
+ XFillRectangles XFlush XForceScreenSaver XFreeColormap XFreeColors XFreeCursor
+ XFreeExtensionList XFreeFont XFreeFontInfo XFreeFontNames XFreeFontPath XFreeGC
+ XFreeModifiermap XFreePixmap XGeometry XGetErrorText XGetFontProperty
+ XGetGCValues XGCValues XEvent XGetGeometry XGetIconName XGetInputFocus XGetKeyboardControl
+ XGetPointerControl XGetPointerMapping XGetScreenSaver XGetTransientForHint XGetWindowProperty
+ XGetWindowAttributes XGrabButton XGrabKey XGrabKeyboard XGrabPointer XGrabServer
+ XHeightMMOfScreen XHeightOfScreen XIfEvent XImageByteOrder XInstallColormap XKeysymToKeycode
+ XKillClient XLookupColor XLowerWindow XMapRaised XMapSubwindows XMapWindow XMaskEvent
+ XMaxCmapsOfScreen XMinCmapsOfScreen XMoveResizeWindow XMoveWindow XNoOp XParseColor
+ XParseGeometry XPeekEvent XPeekIfEvent XPending XPlanesOfScreen XProtocolRevision
+ XProtocolVersion XPutImage XQLength XQueryBestCursor XQueryBestSize XQueryBestStipple
+ XQueryBestTile XQueryColor XQueryColors XQueryExtension XQueryKeymap XQueryPointer
+ XQueryTextExtents XQueryTree XRaiseWindow XRebindKeysym XRecolorCursor XRefreshKeyboardMapping
+ XReparentWindow XResetScreenSaver XResizeWindow
+ XRestackWindows XRotateBuffers XRotateWindowProperties XScreenCount XSelectInput XSendEvent
+ XSetAccessControl XSetArcMode XSetBackground XSetClipMask XSetClipOrigin XSetClipRectangles
+ XSetCloseDownMode XSetCommand XSetDashes XSetFillRule XSetFillStyle XSetFont XSetFontPath
+ XSetForeground XSetFunction XSetGraphicsExposures XSetIconName XSetInputFocus XSetLineAttributes
+ XSetModifierMapping XSetPlaneMask XSetPointerMapping XSetScreenSaver XSetSelectionOwner
+ XSetState XSetStipple XSetSubwindowMode XSetTSOrigin XSetTile XSetWindowBackground
+ XSetWindowBackgroundPixmap XSetWindowBorder XSetWindowBorderPixmap XSetWindowBorderWidth
+ XSetWindowColormap XStoreBuffer XStoreBytes XStoreColor XStoreColors XStoreName
+ XStoreNamedColor XSync XTextExtents XTextWidth XTranslateCoordinates XUndefineCursor
+ XUngrabButton XUngrabKey XUngrabKeyboard XUngrabPointer XUngrabServer XUninstallColormap
+ XUnloadFont XUnmapSubwindows XUnmapWindow XVendorRelease XWarpPointer XWidthMMOfScreen
+ XWidthOfScreen XWindowEvent XWriteBitmapFile XSupportsLocale XSetLocaleModifiers XCreateFontSet
+ XFreeFontSet XFontsOfFontSet XBaseFontNameListOfFontSet XLocaleOfFontSet XContextDependentDrawing
+ XDirectionalDependentDrawing XContextualDrawing XFilterEvent XAllocIconSize
+ XAllocStandardColormap XAllocWMHints XClipBox XCreateRegion XDefaultString XDeleteContext
+ XDestroyRegion XEmptyRegion XEqualRegion ;XFindContext
+ XGetIconSizes XGetRGBColormaps
+ XGetVisualInfo XGetWMHints XIntersectRegion XConvertCase XLookupString
+ XMatchVisualInfo XOffsetRegion XPointInRegion XPolygonRegion XRectInRegion XSaveContext
+ XSetRGBColormaps XSetWMHints XSetRegion XShrinkRegion XSubtractRegion
+ XUnionRectWithRegion XUnionRegion XXorRegion DefaultScreen DefaultRootWindow QLength
+ ScreenCount ServerVendor ProtocolVersion ProtocolRevision VendorRelease DisplayString
+ BitmapUnit BitmapBitOrder BitmapPad ImageByteOrder NextRequest LastKnownRequestProcessed
+ DefaultScreenOfDisplay DisplayOfScreen RootWindowOfScreen BlackPixelOfScreen WhitePixelOfScreen
+ DefaultColormapOfScreen DefaultDepthOfScreen DefaultGCOfScreen DefaultVisualOfScreen
+ WidthOfScreen HeightOfScreen WidthMMOfScreen HeightMMOfScreen PlanesOfScreen CellsOfScreen
+ MinCmapsOfScreen MaxCmapsOfScreen DoesSaveUnders DoesBackingStore EventMaskOfScreen RootWindow
+ DefaultVisual DefaultGC BlackPixel WhitePixel DisplayWidth DisplayHeight DisplayWidthMM
+ DisplayHeightMM DisplayPlanes DisplayCells DefaultColormap ScreenOfDisplay DefaultDepth
+ IsKeypadKey IsPrivateKeypadKey IsCursorKey IsPFKey IsFunctionKey IsMiscFunctionKey
+ IsModifierKey XmCreateMessageBox XmCreateMessageDialog XmCreateErrorDialog
+ XmCreateInformationDialog XmCreateQuestionDialog XmCreateWarningDialog XmCreateWorkingDialog
+ XmCreateTemplateDialog XmMessageBoxGetChild XmCreateArrowButtonGadget XmCreateArrowButton
+ XmCreateNotebook XmNotebookGetPageInfo
+ XmTransferSetParameters XmTransferValue XmCreateComboBox
+ XmCreateDropDownComboBox XmCreateDropDownList XmComboBoxAddItem XmComboBoxDeletePos
+ XmComboBoxSelectItem XmComboBoxSetItem XmComboBoxUpdate XmCreateContainer
+ XmContainerGetItemChildren XmContainerRelayout XmContainerReorder XmContainerCut XmContainerCopy
+ XmContainerPaste XmContainerCopyLink XmContainerPasteLink XmCreateSpinBox
+ XmSpinBoxValidatePosition XmCreateSimpleSpinBox XmSimpleSpinBoxAddItem XmSimpleSpinBoxDeletePos
+ XmSimpleSpinBoxSetItem XmDropSiteRegistered XmTextFieldCopyLink XmTextFieldPasteLink
+ XmTextGetCenterline XmToggleButtonGadgetSetValue XmCreateIconGadget
+ XmCreateIconHeader XmObjectAtPoint XmConvertStringToUnits XmCreateGrabShell
+ XmToggleButtonSetValue XmTextPasteLink XmTextCopyLink XmScaleSetTicks XmInternAtom XmGetAtomName
+ XmCreatePanedWindow XmCreateBulletinBoard XmCreateBulletinBoardDialog XmCreateCascadeButtonGadget
+ XmCascadeButtonGadgetHighlight XmAddProtocols XmRemoveProtocols XmAddProtocolCallback
+ XmRemoveProtocolCallback XmActivateProtocol XmDeactivateProtocol XmSetProtocolHooks
+ XmCreateCascadeButton XmCascadeButtonHighlight XmCreatePushButtonGadget XmCreatePushButton
+ XmCreateCommand XmCommandGetChild XmCommandSetValue XmCommandAppendValue XmCommandError
+ XmCreateCommandDialog XmMenuPosition XmCreateRowColumn XmCreateWorkArea XmCreateRadioBox
+ XmCreateOptionMenu XmOptionLabelGadget XmOptionButtonGadget XmCreateMenuBar XmCreatePopupMenu
+ XmCreatePulldownMenu XmGetPostedFromWidget XmGetTearOffControl
+ XmScaleSetValue XmScaleGetValue XmCreateScale
+ XmClipboardStartCopy XmClipboardCopy XmClipboardEndCopy XmClipboardCancelCopy
+ XmClipboardWithdrawFormat XmClipboardCopyByName XmClipboardUndoCopy XmClipboardLock
+ XmClipboardUnlock XmClipboardStartRetrieve XmClipboardEndRetrieve XmClipboardRetrieve
+ XmClipboardInquireCount XmClipboardInquireFormat XmClipboardInquireLength
+ XmClipboardInquirePendingItems XmClipboardRegisterFormat XmGetXmScreen XmCreateScrollBar
+ XmScrollBarGetValues XmScrollBarSetValues XmCreateDialogShell
+ XmCreateScrolledWindow XmScrollVisible XmGetDragContext XmGetXmDisplay XmSelectionBoxGetChild
+ XmCreateSelectionBox XmCreateSelectionDialog XmCreatePromptDialog XmDragStart XmDragCancel
+ XmTargetsAreCompatible XmCreateSeparatorGadget XmCreateDragIcon XmCreateSeparator
+ XmCreateDrawingArea XmCreateDrawnButton XmDropSiteRegister XmDropSiteUnregister
+ XmDropSiteStartUpdate XmDropSiteUpdate XmDropSiteEndUpdate XmDropSiteRetrieve
+ XmDropSiteQueryStackingOrder XmDropSiteConfigureStackingOrder XmDropTransferStart
+ XmDropTransferAdd XmTextFieldGetString XmTextFieldGetSubstring XmTextFieldGetLastPosition
+ XmTextFieldSetString XmTextFieldReplace XmTextFieldInsert XmTextFieldSetAddMode
+ XmTextFieldGetAddMode XmTextFieldGetEditable XmTextFieldSetEditable XmTextFieldGetMaxLength
+ XmTextFieldSetMaxLength XmTextFieldGetCursorPosition XmTextFieldGetInsertionPosition
+ XmTextFieldSetCursorPosition XmTextFieldSetInsertionPosition XmTextFieldGetSelectionPosition
+ XmTextFieldGetSelection XmTextFieldRemove XmTextFieldCopy XmTextFieldCut XmTextFieldPaste
+ XmTextFieldClearSelection XmTextFieldSetSelection XmTextFieldXYToPos XmTextFieldPosToXY
+ XmTextFieldShowPosition XmTextFieldSetHighlight XmTextFieldGetBaseline XmCreateTextField
+ XmFileSelectionBoxGetChild XmFileSelectionDoSearch XmCreateFileSelectionBox
+ XmCreateFileSelectionDialog XmTextSetHighlight XmCreateScrolledText XmCreateText
+ XmTextGetSubstring XmTextGetString XmTextGetLastPosition XmTextSetString XmTextReplace
+ XmTextInsert XmTextSetAddMode XmTextGetAddMode XmTextGetEditable XmTextSetEditable
+ XmTextGetMaxLength XmTextSetMaxLength XmTextGetTopCharacter XmTextSetTopCharacter
+ XmTextGetCursorPosition XmTextGetInsertionPosition XmTextSetInsertionPosition
+ XmTextSetCursorPosition XmTextRemove XmTextCopy XmTextCut XmTextPaste XmTextGetSelection
+ XmTextSetSelection XmTextClearSelection XmTextGetSelectionPosition XmTextXYToPos XmTextPosToXY
+ XmTextGetSource XmTextSetSource XmTextShowPosition XmTextScroll XmTextGetBaseline
+ XmTextDisableRedisplay XmTextEnableRedisplay XmTextFindString XmCreateForm XmCreateFormDialog
+ XmCreateFrame XmToggleButtonGadgetGetState XmToggleButtonGadgetSetState XmCreateToggleButtonGadget
+ XmToggleButtonGetState XmToggleButtonSetState XmCreateToggleButton XmCreateLabelGadget
+ XmCreateLabel XmIsMotifWMRunning XmListAddItem XmListAddItems XmListAddItemsUnselected
+ XmListAddItemUnselected XmListDeleteItem XmListDeleteItems XmListDeletePositions XmListDeletePos
+ XmListDeleteItemsPos XmListDeleteAllItems XmListReplaceItems XmListReplaceItemsPos
+ XmListReplaceItemsUnselected XmListReplaceItemsPosUnselected XmListReplacePositions
+ XmListSelectItem XmListSelectPos XmListDeselectItem XmListDeselectPos XmListDeselectAllItems
+ XmListSetPos XmListSetBottomPos XmListSetItem XmListSetBottomItem XmListSetAddMode
+ XmListItemExists XmListItemPos XmListGetKbdItemPos XmListSetKbdItemPos XmListYToPos
+ XmListPosToBounds XmListGetMatchPos XmListGetSelectedPos XmListSetHorizPos
+ XmListUpdateSelectedList XmListPosSelected XmCreateList XmCreateScrolledList XmTranslateKey
+ XmInstallImage XmUninstallImage XmGetPixmap XmGetPixmapByDepth XmDestroyPixmap XmUpdateDisplay
+ XmWidgetGetBaselines XmRegisterSegmentEncoding XmMapSegmentEncoding
+ XmCvtCTToXmString XmCvtXmStringToCT XmConvertUnits
+ XmCreateSimpleMenuBar XmCreateSimplePopupMenu XmCreateSimplePulldownMenu
+ XmCreateSimpleOptionMenu XmCreateSimpleRadioBox XmCreateSimpleCheckBox XmVaCreateSimpleMenuBar
+ XmVaCreateSimplePopupMenu XmVaCreateSimplePulldownMenu XmVaCreateSimpleOptionMenu
+ XmVaCreateSimpleRadioBox XmVaCreateSimpleCheckBox XmTrackingEvent
+ XmSetColorCalculation XmGetColorCalculation XmGetColors XmChangeColor XmStringCreate
+ XmStringCreateLocalized XmStringDirectionCreate XmStringSeparatorCreate
+ XmStringInitContext
+ XmStringFreeContext
+ XmStringConcatAndFree XmStringIsVoid XmStringPeekNextTriple XmStringGetNextTriple
+ XmStringComponentCreate XmStringUnparse XmStringParseText XmStringToXmStringTable
+ XmStringTableToXmString XmStringTableUnparse XmStringTableParseStringArray
+ XmDirectionToStringDirection XmStringDirectionToDirection XmStringGenerate XmStringPutRendition
+ XmParseMappingGetValues XmParseMappingFree XmParseTableFree XmStringTableProposeTablist
+ XmTabSetValue XmTabGetValues XmTabFree XmTabCreate XmTabListTabCount XmTabListRemoveTabs
+ XmTabListReplacePositions XmTabListGetTab XmTabListCopy XmTabListInsertTabs
; XmRenderTableCvtFromProp XmRenderTableCvtToProp XmRenditionUpdate XmRenditionRetrieve
- XmRenditionFree XmRenditionCreate XmRenderTableGetRenditions XmRenderTableGetRendition
- XmRenderTableGetTags XmRenderTableFree XmRenderTableCopy XmRenderTableRemoveRenditions
- XmRenderTableAddRenditions
- XmStringEmpty XmStringHasSubstring XmStringFree XmStringBaseline XmStringWidth XmStringHeight
- XmStringExtent XmStringLineCount XmStringDraw XmStringDrawImage XmStringDrawUnderline
- XmGetDestination XmIsTraversable XmGetVisibility XmGetTabGroup XmGetFocusWidget
- XmProcessTraversal XmCreateMenuShell XmIsMessageBox
- XmIsArrowButtonGadget XmIsArrowButton XmIsNotebook XmIsComboBox XmIsContainer
- XmIsGrabShell XmIsIconGadget XmIsIconHeader XmIsPanedWindow XmIsBulletinBoard XmIsPrimitive
- XmIsCascadeButtonGadget XmIsCascadeButton XmIsPushButtonGadget XmIsPushButton XmIsCommand
- XmIsRowColumn XmIsScale XmIsScreen XmIsScrollBar XmIsDialogShell XmIsScrolledWindow XmIsDisplay
- XmIsSelectionBox XmIsDragContext XmIsSeparatorGadget XmIsDragIconObjectClass
- XmIsSeparator XmIsDrawingArea XmIsDrawnButton XmIsDropSiteManager XmIsDropTransfer XmIsTextField
- XmIsFileSelectionBox XmIsText XmIsForm XmIsFrame XmIsGadget XmIsToggleButtonGadget
- XmIsToggleButton XmIsLabelGadget XmIsLabel XmIsVendorShell XmIsList XmIsManager
- XmIsMenuShell XGetPixel XDestroyImage XPutPixel XSubImage XAddPixel
- XtAppContext? XtRequestId? XtWorkProcId? XtInputId? XtIntervalId? Screen? XEvent?
- XRectangle? XArc? XPoint? XSegment? XColor? Atom? Colormap?
- XModifierKeymap? Depth? Display? Drawable? Font? GC? KeySym? Pixel? Pixmap? Region?
- Time? Visual? Window? XFontProp? XFontSet? XFontStruct? XGCValues? XImage? XVisualInfo?
- XWMHints? XWindowAttributes? XWindowChanges? KeyCode? XContext? XCharStruct? XTextItem?
- Widget? XmStringContext? WidgetClass? XmString?
- XmToggleButton? XmDrawingArea? XmPushButton? XmTextField? XmFileSelectionBox? XmText?
- XmFrame? XmLabel? XmList? XmArrowButton? XmScrollBar? XmCommand? XmScale? XmRowColumn?
- XmTab? XmNotebook? XmComboBox? XmContainer? XmIconHeader?
- XmGrabShell? XmRendition? XmRenderTable? XmIconGadget? XmTabList? XmParseMapping?
- XmPanedWindow? XmScrolledWindow? XmCascadeButton? XmForm? XmBulletinBoard? XmScreen?
- XmDialogShell? XmDisplay? XmSelectionBox? XmDragContext? XmDragIconObjectClass? XmSeparator?
- XmDropSiteManager? XmDropTransfer? XmVendorShell? XmMessageBox? XmManager?
- XmMenuShell? XmLabelGadget? XmPushButtonGadget? XmSeparatorGadget? XmArrowButtonGadget?
- XmCascadeButtonGadget? XmToggleButtonGadget? XmDrawnButton? XmPrimitive?
- XmTextSource?
-
- XButtonEvent? XCirculateEvent? XCirculateRequestEvent? XClientMessageEvent? XColormapEvent?
- XConfigureEvent? XConfigureRequestEvent? XCreateWindowEvent? XCrossingEvent? XDeleteProperty
- XDestroyWindowEvent? XErrorEvent? XExposeEvent? XFocusChangeEvent? XGraphicsExposeEvent? XGravityEvent?
- XIconSize? XKeyEvent? XKeymapEvent? XMapEvent? XMapRequestEvent? XMappingEvent? XMotionEvent?
- XNoExposeEvent? XPropertyEvent? XReparentEvent? XResizeRequestEvent? XSelectionClearEvent?
- XSelectionEvent? XSelectionRequestEvent? XSetWindowAttributes? XStandardColormap? XUnmapEvent? XVisibilityEvent?
-
- ))
- (xm-procs (if (defined? 'XpmImage?)
- (append xm-procs-1
- (list
- XpmCreatePixmapFromData XpmCreateDataFromPixmap XpmReadFileToPixmap
- XpmReadPixmapFile XpmWriteFileFromPixmap XpmWritePixmapFile XpmCreatePixmapFromXpmImage
- XpmCreateXpmImageFromPixmap XpmAttributes? XpmImage? XpmColorSymbol?))
- xm-procs-1))
- (xm-procs0 (remove-if (lambda (n) (not (arity-ok n 0))) xm-procs))
- (xm-procs1 (remove-if (lambda (n) (not (arity-ok n 1))) xm-procs))
- (xm-procs2 (remove-if (lambda (n) (not (arity-ok n 2))) xm-procs))
- (xm-procs3 (remove-if (lambda (n) (not (arity-ok n 3))) xm-procs))
- (xm-procs4 (remove-if (lambda (n) (not (arity-ok n 4))) xm-procs))
- )
+ XmRenditionFree XmRenditionCreate XmRenderTableGetRenditions XmRenderTableGetRendition
+ XmRenderTableGetTags XmRenderTableFree XmRenderTableCopy XmRenderTableRemoveRenditions
+ XmRenderTableAddRenditions
+ XmStringEmpty XmStringHasSubstring XmStringFree XmStringBaseline XmStringWidth XmStringHeight
+ XmStringExtent XmStringLineCount XmStringDraw XmStringDrawImage XmStringDrawUnderline
+ XmGetDestination XmIsTraversable XmGetVisibility XmGetTabGroup XmGetFocusWidget
+ XmProcessTraversal XmCreateMenuShell XmIsMessageBox
+ XmIsArrowButtonGadget XmIsArrowButton XmIsNotebook XmIsComboBox XmIsContainer
+ XmIsGrabShell XmIsIconGadget XmIsIconHeader XmIsPanedWindow XmIsBulletinBoard XmIsPrimitive
+ XmIsCascadeButtonGadget XmIsCascadeButton XmIsPushButtonGadget XmIsPushButton XmIsCommand
+ XmIsRowColumn XmIsScale XmIsScreen XmIsScrollBar XmIsDialogShell XmIsScrolledWindow XmIsDisplay
+ XmIsSelectionBox XmIsDragContext XmIsSeparatorGadget XmIsDragIconObjectClass
+ XmIsSeparator XmIsDrawingArea XmIsDrawnButton XmIsDropSiteManager XmIsDropTransfer XmIsTextField
+ XmIsFileSelectionBox XmIsText XmIsForm XmIsFrame XmIsGadget XmIsToggleButtonGadget
+ XmIsToggleButton XmIsLabelGadget XmIsLabel XmIsVendorShell XmIsList XmIsManager
+ XmIsMenuShell XGetPixel XDestroyImage XPutPixel XSubImage XAddPixel
+ XtAppContext? XtRequestId? XtWorkProcId? XtInputId? XtIntervalId? Screen? XEvent?
+ XRectangle? XArc? XPoint? XSegment? XColor? Atom? Colormap?
+ XModifierKeymap? Depth? Display? Drawable? Font? GC? KeySym? Pixel? Pixmap? Region?
+ Time? Visual? Window? XFontProp? XFontSet? XFontStruct? XGCValues? XImage? XVisualInfo?
+ XWMHints? XWindowAttributes? XWindowChanges? KeyCode? XContext? XCharStruct? XTextItem?
+ Widget? XmStringContext? WidgetClass? XmString?
+ XmToggleButton? XmDrawingArea? XmPushButton? XmTextField? XmFileSelectionBox? XmText?
+ XmFrame? XmLabel? XmList? XmArrowButton? XmScrollBar? XmCommand? XmScale? XmRowColumn?
+ XmTab? XmNotebook? XmComboBox? XmContainer? XmIconHeader?
+ XmGrabShell? XmRendition? XmRenderTable? XmIconGadget? XmTabList? XmParseMapping?
+ XmPanedWindow? XmScrolledWindow? XmCascadeButton? XmForm? XmBulletinBoard? XmScreen?
+ XmDialogShell? XmDisplay? XmSelectionBox? XmDragContext? XmDragIconObjectClass? XmSeparator?
+ XmDropSiteManager? XmDropTransfer? XmVendorShell? XmMessageBox? XmManager?
+ XmMenuShell? XmLabelGadget? XmPushButtonGadget? XmSeparatorGadget? XmArrowButtonGadget?
+ XmCascadeButtonGadget? XmToggleButtonGadget? XmDrawnButton? XmPrimitive?
+ XmTextSource?
+
+ XButtonEvent? XCirculateEvent? XCirculateRequestEvent? XClientMessageEvent? XColormapEvent?
+ XConfigureEvent? XConfigureRequestEvent? XCreateWindowEvent? XCrossingEvent? XDeleteProperty
+ XDestroyWindowEvent? XErrorEvent? XExposeEvent? XFocusChangeEvent? XGraphicsExposeEvent? XGravityEvent?
+ XIconSize? XKeyEvent? XKeymapEvent? XMapEvent? XMapRequestEvent? XMappingEvent? XMotionEvent?
+ XNoExposeEvent? XPropertyEvent? XReparentEvent? XResizeRequestEvent? XSelectionClearEvent?
+ XSelectionEvent? XSelectionRequestEvent? XSetWindowAttributes? XStandardColormap? XUnmapEvent? XVisibilityEvent?
+
+ ))
+ (xm-procs (if (defined? 'XpmImage?)
+ (append xm-procs-1
+ (list
+ XpmCreatePixmapFromData XpmCreateDataFromPixmap XpmReadFileToPixmap
+ XpmReadPixmapFile XpmWriteFileFromPixmap XpmWritePixmapFile XpmCreatePixmapFromXpmImage
+ XpmCreateXpmImageFromPixmap XpmAttributes? XpmImage? XpmColorSymbol?))
+ xm-procs-1))
+ (xm-procs0 (remove-if (lambda (n) (not (aritable? n 0))) xm-procs))
+ (xm-procs1 (remove-if (lambda (n) (not (aritable? n 1))) xm-procs))
+ (xm-procs2 (remove-if (lambda (n) (not (aritable? n 2))) xm-procs))
+ (xm-procs3 (remove-if (lambda (n) (not (aritable? n 3))) xm-procs))
+ )
+
+ ;; ---------------- 0 Args
+ (for-each
+ (lambda (n)
+ (catch #t
+ n
+ (lambda args (car args))))
+ xm-procs0)
+
+ ;; ---------------- 1 Arg
+ (for-each
+ (lambda (arg)
+ (for-each
+ (lambda (n)
+ (catch #t
+ (lambda () (n arg))
+ (lambda args (car args))))
+ xm-procs1))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4 'mus-error 0+i (make-delay 32)
+ (lambda () #t) (curlet) (make-float-vector (list 2 3) 0.0) :order 0 1 -1 #f #t () (make-vector 0)))
+
+ ;; ---------------- 2 Args
+ (for-each
+ (lambda (arg1)
+ (for-each
+ (lambda (arg2)
+ (for-each
+ (lambda (n)
+ (catch #t
+ (lambda () (n arg1 arg2))
+ (lambda args (car args))))
+ xm-procs2))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4
+ 0+i (make-delay 32) :feedback -1 0 #f #t () (make-vector 0))))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) (make-color-with-catch .95 .95 .95) #(0 1) 3/4
+ 0+i (make-delay 32) :frequency -1 0 #f #t () (make-vector 0)))
+
+ (if all-args
+ ;; ---------------- 3 Args
+ (for-each
+ (lambda (arg1)
+ (for-each
+ (lambda (arg2)
+ (for-each
+ (lambda (arg3)
+ (for-each
+ (lambda (n)
+ (catch #t
+ (lambda () (n arg1 arg2 arg3))
+ (lambda args (car args))))
+ xm-procs3))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #(0 1) 0+i (make-delay 32)
+ :start -1 0 #f #t () (make-vector 0))))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #(0 1) 0+i (make-delay 32)
+ :phase -1 0 #f #t () (make-vector 0))))
+ (list win 1.5 "/hiho" (list 0 1) 1234 (make-float-vector 3) #(0 1) 0+i (make-delay 32)
+ :channels -1 0 #f #t () (make-vector 0)))
+ )
+
+ (let* ((struct-accessors-1
+ (list .pixel .red .green .blue .flags .pad .x .y .width .height .angle1 .angle2 .ptr
+ .x1 .y1 .x2 .y2 .dashes .dash_offset .clip_mask .clip_y_origin .clip_x_origin .graphics_exposures
+ .subwindow_mode .font .ts_y_origin .ts_x_origin .stipple .tile .arc_mode .fill_rule .fill_style
+ .join_style .cap_style .line_style .line_width .background .foreground .plane_mask .function .delta
+ .nchars .chars .name .depth .visual .mwidth .mheight .ndepths .depths .root_depth .root_visual
+ .default_gc .cmap .white_pixel .black_pixel .max_maps .min_maps .backing_store .save_unders .root_input_mask
+ .lbearing .rbearing .ascent .descent .attributes .card32 .fid .properties .min_bounds .max_bounds .per_char
+ .input .initial_state .icon_pixmap .icon_window .icon_x .icon_y .icon_mask .window_group .visualid
+ .class .red_mask .green_mask .blue_mask .bits_per_rgb .map_entries .nvisuals .visuals .bits_per_pixel
+ .background_pixmap .background_pixel .border_pixmap .border_pixel .bit_gravity .win_gravity .backing_planes
+ .backing_pixel .save_under .event_mask .do_not_propagate_mask .cursor .map_installed .map_state .all_event_masks
+ .your_event_mask .screen .xoffset .byte_order .bitmap_unit .bitmap_bit_order .bitmap_pad .bytes_per_line
+ .obdata .sibling .stack_mode .red_max .red_mult .green_max .green_mult .blue_max .blue_mult .base_pixel
+ .killid .data .min_height .max_height .min_width .max_width .height_inc .width_inc .page_number
+ .page_widget .status_area_widget .major_tab_widget .minor_tab_widget .source_data .location_data .parm
+ .parm_format .parm_length .parm_type .transfer_id .destination_data .remaining .item_or_text .auto_selection_type
+ .new_outline_state .prev_page_number .prev_page_widget .rendition .render_table
+ ; .last_page
+ .crossed_boundary
+ .client_data .status .font_name .tag .traversal_destination .dragProtocolStyle .direction .reason
+ .timeStamp .operation .operations .dropSiteStatus .dropAction .iccHandle .completionStatus .dragContext
+ .animate .length .click_count .widget .item_position .callbackstruct
+ .set .item .item_length .selected_items .selected_item_count .selected_item_positions .selection_type
+ .mask .mask_length .dir .dir_length .pattern .pattern_length .position .currInsert .newInsert .startPos
+ .endPos .text .request_code .error_code .first_keycode .request .resourceid .format .message_type .new
+ .property .display .target .requestor .owner .selection .atom .place .value_mask .above .from_configure
+ .event .override_redirect .border_width .parent .minor_code .major_code .drawable .count .key_vector .focus
+ .detail .mode .is_hint .button .same_screen .keycode .state .y_root .x_root .root .time .subwindow .window
+ .send_event .serial .type .value .doit .colormap .menuToPost .postIt))
+ (struct-accessors (if (defined? 'XpmImage?)
+ (append struct-accessors-1
+ (list .valuemask .ncolors .cpp .numsymbols .colorsymbols .npixels
+ .y_hotspot .x_hotspot .colormap_size))
+ struct-accessors-1))
+
+ (struct-accessor-names-1
+ (list '.pixel '.red '.green '.blue '.flags '.pad '.x '.y '.width '.height '.angle1 '.angle2 '.ptr
+ '.x1 '.y1 '.x2 '.y2 '.dashes '.dash_offset '.clip_mask '.clip_y_origin '.clip_x_origin '.graphics_exposures
+ '.subwindow_mode '.font '.ts_y_origin '.ts_x_origin '.stipple '.tile '.arc_mode '.fill_rule '.fill_style
+ '.join_style '.cap_style '.line_style '.line_width '.background '.foreground '.plane_mask '.function '.delta
+ '.nchars '.chars '.name '.depth '.visual '.mwidth '.mheight '.ndepths '.depths '.root_depth '.root_visual
+ '.default_gc '.cmap '.white_pixel '.black_pixel '.max_maps '.min_maps '.backing_store '.save_unders '.root_input_mask
+ '.lbearing '.rbearing '.ascent '.descent '.attributes '.card32 '.fid '.properties '.min_bounds '.max_bounds '.per_char
+ '.input '.initial_state '.icon_pixmap '.icon_window '.icon_x '.icon_y '.icon_mask '.window_group '.visualid
+ '.class '.red_mask '.green_mask '.blue_mask '.bits_per_rgb '.map_entries '.nvisuals '.visuals '.bits_per_pixel
+ '.background_pixmap '.background_pixel '.border_pixmap '.border_pixel '.bit_gravity '.win_gravity '.backing_planes
+ '.backing_pixel '.save_under '.event_mask '.do_not_propagate_mask '.cursor '.map_installed '.map_state '.all_event_masks
+ '.your_event_mask '.screen '.xoffset '.byte_order '.bitmap_unit '.bitmap_bit_order '.bitmap_pad '.bytes_per_line
+ '.obdata '.sibling '.stack_mode '.red_max '.red_mult '.green_max '.green_mult '.blue_max '.blue_mult '.base_pixel
+ '.killid '.data '.min_height '.max_height '.min_width '.max_width '.height_inc '.width_inc '.page_number
+ '.page_widget '.status_area_widget '.major_tab_widget '.minor_tab_widget '.source_data '.location_data '.parm
+ '.parm_format '.parm_length '.parm_type '.transfer_id '.destination_data '.remaining '.item_or_text '.auto_selection_type
+ '.new_outline_state '.prev_page_number '.prev_page_widget '.rendition '.render_table
+ ; '.last_page
+ '.crossed_boundary
+ '.client_data '.status '.font_name '.tag '.traversal_destination '.dragProtocolStyle '.direction '.reason
+ '.timeStamp '.operation '.operations '.dropSiteStatus '.dropAction '.iccHandle '.completionStatus '.dragContext
+ '.animate '.length '.click_count '.widget '.item_position '.callbackstruct
+ '.set '.item '.item_length '.selected_items '.selected_item_count '.selected_item_positions '.selection_type
+ '.mask '.mask_length '.dir '.dir_length '.pattern '.pattern_length '.position '.currInsert '.newInsert '.startPos
+ '.endPos '.text '.request_code '.error_code '.first_keycode '.request '.resourceid '.format '.message_type '.new
+ '.property '.display '.target '.requestor '.owner '.selection '.atom '.place '.value_mask '.above '.from_configure
+ '.event '.override_redirect '.border_width '.parent '.minor_code '.major_code '.drawable '.count '.key_vector '.focus
+ '.detail '.mode '.is_hint '.button '.same_screen '.keycode '.state '.y_root '.x_root '.root '.time '.subwindow '.window
+ '.send_event '.serial '.type '.value '.doit '.colormap '.menuToPost '.postIt))
+ (struct-accessor-names (if (defined? 'XpmImage?)
+ (append struct-accessor-names-1
+ (list '.valuemask '.ncolors '.cpp
+ '.numsymbols '.colorsymbols '.npixels '.y_hotspot '.x_hotspot '.colormap_size))
+ struct-accessor-names-1))
+ (dpy (XtDisplay (cadr (main-widgets))))
+ (win (XtWindow (cadr (main-widgets)))))
;; ---------------- 0 Args
(for-each
- (lambda (n)
- (catch #t
- (lambda ()
- (n))
- (lambda args (car args))))
- xm-procs0)
+ (lambda (n name)
+ (let ((tag
+ (catch #t
+ n
+ (lambda args (car args)))))
+ (if (not (memq tag '(wrong-type-arg wrong-number-of-args)))
+ (snd-display #__line__ ";(~A) -> ~A" name tag)))
+ (if (dilambda? n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (set! (n) 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-number-of-args))
+ (snd-display #__line__ ";(~A) -> ~A" name tag)))))
+ struct-accessors
+ struct-accessor-names)
;; ---------------- 1 Arg
(for-each
(lambda (arg)
(for-each
- (lambda (n)
- (catch #t
- (lambda () (n arg))
- (lambda args (car args))))
- xm-procs1))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4 'mus-error (sqrt -1.0) (make-delay 32)
- (lambda () #t) (current-environment) (make-sound-data 2 3) :order 0 1 -1 (make-hook 2) #f #t '() (make-vector 0)))
-
- ;; ---------------- 2 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (n)
- (catch #t
- (lambda () (n arg1 arg2))
- (lambda args (car args))))
- xm-procs2))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4
- (sqrt -1.0) (make-delay 32) :feedback -1 0 #f #t '() (make-vector 0))))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) (make-color-with-catch .95 .95 .95) '#(0 1) 3/4
- (sqrt -1.0) (make-delay 32) :frequency -1 0 #f #t '() (make-vector 0)))
-
- (if all-args
- (begin
-
- ;; ---------------- 3 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (n)
- (catch #t
- (lambda () (n arg1 arg2 arg3))
- (lambda args (car args))))
- xm-procs3))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) '#(0 1) (sqrt -1.0) (make-delay 32)
- :start -1 0 #f #t '() (make-vector 0))))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) '#(0 1) (sqrt -1.0) (make-delay 32)
- :phase -1 0 #f #t '() (make-vector 0))))
- (list win 1.5 "/hiho" (list 0 1) 1234 (make-vct 3) '#(0 1) (sqrt -1.0) (make-delay 32)
- :channels -1 0 #f #t '() (make-vector 0)))
- ))
-
- (let* ((struct-accessors-1
- (list .pixel .red .green .blue .flags .pad .x .y .width .height .angle1 .angle2 .ptr
- .x1 .y1 .x2 .y2 .dashes .dash_offset .clip_mask .clip_y_origin .clip_x_origin .graphics_exposures
- .subwindow_mode .font .ts_y_origin .ts_x_origin .stipple .tile .arc_mode .fill_rule .fill_style
- .join_style .cap_style .line_style .line_width .background .foreground .plane_mask .function .delta
- .nchars .chars .name .depth .visual .mwidth .mheight .ndepths .depths .root_depth .root_visual
- .default_gc .cmap .white_pixel .black_pixel .max_maps .min_maps .backing_store .save_unders .root_input_mask
- .lbearing .rbearing .ascent .descent .attributes .card32 .fid .properties .min_bounds .max_bounds .per_char
- .input .initial_state .icon_pixmap .icon_window .icon_x .icon_y .icon_mask .window_group .visualid
- .class .red_mask .green_mask .blue_mask .bits_per_rgb .map_entries .nvisuals .visuals .bits_per_pixel
- .background_pixmap .background_pixel .border_pixmap .border_pixel .bit_gravity .win_gravity .backing_planes
- .backing_pixel .save_under .event_mask .do_not_propagate_mask .cursor .map_installed .map_state .all_event_masks
- .your_event_mask .screen .xoffset .byte_order .bitmap_unit .bitmap_bit_order .bitmap_pad .bytes_per_line
- .obdata .sibling .stack_mode .red_max .red_mult .green_max .green_mult .blue_max .blue_mult .base_pixel
- .killid .data .min_height .max_height .min_width .max_width .height_inc .width_inc .page_number
- .page_widget .status_area_widget .major_tab_widget .minor_tab_widget .source_data .location_data .parm
- .parm_format .parm_length .parm_type .transfer_id .destination_data .remaining .item_or_text .auto_selection_type
- .new_outline_state .prev_page_number .prev_page_widget .rendition .render_table
- ; .last_page
- .crossed_boundary
- .client_data .status .font_name .tag .traversal_destination .dragProtocolStyle .direction .reason
- .timeStamp .operation .operations .dropSiteStatus .dropAction .iccHandle .completionStatus .dragContext
- .animate .length .click_count .widget .item_position .callbackstruct
- .set .item .item_length .selected_items .selected_item_count .selected_item_positions .selection_type
- .mask .mask_length .dir .dir_length .pattern .pattern_length .position .currInsert .newInsert .startPos
- .endPos .text .request_code .error_code .first_keycode .request .resourceid .format .message_type .new
- .property .display .target .requestor .owner .selection .atom .place .value_mask .above .from_configure
- .event .override_redirect .border_width .parent .minor_code .major_code .drawable .count .key_vector .focus
- .detail .mode .is_hint .button .same_screen .keycode .state .y_root .x_root .root .time .subwindow .window
- .send_event .serial .type .value .doit .colormap .menuToPost .postIt))
- (struct-accessors (if (defined? 'XpmImage?)
- (append struct-accessors-1
- (list .valuemask .ncolors .cpp .numsymbols .colorsymbols .npixels
- .y_hotspot .x_hotspot .colormap_size))
- struct-accessors-1))
-
- (struct-accessor-names-1
- (list '.pixel '.red '.green '.blue '.flags '.pad '.x '.y '.width '.height '.angle1 '.angle2 '.ptr
- '.x1 '.y1 '.x2 '.y2 '.dashes '.dash_offset '.clip_mask '.clip_y_origin '.clip_x_origin '.graphics_exposures
- '.subwindow_mode '.font '.ts_y_origin '.ts_x_origin '.stipple '.tile '.arc_mode '.fill_rule '.fill_style
- '.join_style '.cap_style '.line_style '.line_width '.background '.foreground '.plane_mask '.function '.delta
- '.nchars '.chars '.name '.depth '.visual '.mwidth '.mheight '.ndepths '.depths '.root_depth '.root_visual
- '.default_gc '.cmap '.white_pixel '.black_pixel '.max_maps '.min_maps '.backing_store '.save_unders '.root_input_mask
- '.lbearing '.rbearing '.ascent '.descent '.attributes '.card32 '.fid '.properties '.min_bounds '.max_bounds '.per_char
- '.input '.initial_state '.icon_pixmap '.icon_window '.icon_x '.icon_y '.icon_mask '.window_group '.visualid
- '.class '.red_mask '.green_mask '.blue_mask '.bits_per_rgb '.map_entries '.nvisuals '.visuals '.bits_per_pixel
- '.background_pixmap '.background_pixel '.border_pixmap '.border_pixel '.bit_gravity '.win_gravity '.backing_planes
- '.backing_pixel '.save_under '.event_mask '.do_not_propagate_mask '.cursor '.map_installed '.map_state '.all_event_masks
- '.your_event_mask '.screen '.xoffset '.byte_order '.bitmap_unit '.bitmap_bit_order '.bitmap_pad '.bytes_per_line
- '.obdata '.sibling '.stack_mode '.red_max '.red_mult '.green_max '.green_mult '.blue_max '.blue_mult '.base_pixel
- '.killid '.data '.min_height '.max_height '.min_width '.max_width '.height_inc '.width_inc '.page_number
- '.page_widget '.status_area_widget '.major_tab_widget '.minor_tab_widget '.source_data '.location_data '.parm
- '.parm_format '.parm_length '.parm_type '.transfer_id '.destination_data '.remaining '.item_or_text '.auto_selection_type
- '.new_outline_state '.prev_page_number '.prev_page_widget '.rendition '.render_table
- ; '.last_page
- '.crossed_boundary
- '.client_data '.status '.font_name '.tag '.traversal_destination '.dragProtocolStyle '.direction '.reason
- '.timeStamp '.operation '.operations '.dropSiteStatus '.dropAction '.iccHandle '.completionStatus '.dragContext
- '.animate '.length '.click_count '.widget '.item_position '.callbackstruct
- '.set '.item '.item_length '.selected_items '.selected_item_count '.selected_item_positions '.selection_type
- '.mask '.mask_length '.dir '.dir_length '.pattern '.pattern_length '.position '.currInsert '.newInsert '.startPos
- '.endPos '.text '.request_code '.error_code '.first_keycode '.request '.resourceid '.format '.message_type '.new
- '.property '.display '.target '.requestor '.owner '.selection '.atom '.place '.value_mask '.above '.from_configure
- '.event '.override_redirect '.border_width '.parent '.minor_code '.major_code '.drawable '.count '.key_vector '.focus
- '.detail '.mode '.is_hint '.button '.same_screen '.keycode '.state '.y_root '.x_root '.root '.time '.subwindow '.window
- '.send_event '.serial '.type '.value '.doit '.colormap '.menuToPost '.postIt))
- (struct-accessor-names (if (defined? 'XpmImage?)
- (append struct-accessor-names-1
- (list '.valuemask '.ncolors '.cpp
- '.numsymbols '.colorsymbols '.npixels '.y_hotspot '.x_hotspot '.colormap_size))
- struct-accessor-names-1))
- (dpy (XtDisplay (cadr (main-widgets))))
- (win (XtWindow (cadr (main-widgets)))))
-
- ;; ---------------- 0 Args
- (for-each
- (lambda (n name)
- (let ((tag
- (catch #t
- (lambda ()
- (n))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-number-of-args))
- (snd-display #__line__ ";(~A) -> ~A" name tag)))
- (if (procedure-with-setter? n)
- (let ((tag
- (catch #t
- (lambda ()
- (set! (n) 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-number-of-args))
- (snd-display #__line__ ";(~A) -> ~A" name tag)))))
- struct-accessors
- struct-accessor-names)
-
- ;; ---------------- 1 Arg
- (for-each
- (lambda (arg)
- (for-each
- (lambda (n name)
- (let ((tag
- (catch #t
- (lambda () (n arg))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";(~A ~A) -> ~A" name arg tag)))
- (if (procedure-with-setter? n)
- (begin
- (let ((tag
- (catch #t
- (lambda () (set! (n arg) 0))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";(~A ~A) -> ~A" name arg tag)))
- (let ((tag
- (catch #t
- (lambda () (set! (n 0) arg))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";(set ~A ~A) -> ~A" name arg tag))))))
- struct-accessors
- struct-accessor-names))
- (list dpy win '(Atom 0) '(Colormap 0) 1.5 "/hiho" 1234 #f #\c '(Time 0) '(Font 0) (make-vector 0) '(Cursor 1))))
- )
- (show-sounds-in-directory)
+ (lambda (n name)
+ (let ((tag
+ (catch #t
+ (lambda () (n arg))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";(~A ~A) -> ~A" name arg tag)))
+ (if (dilambda? n)
+ (begin
+ (let ((tag
+ (catch #t
+ (lambda () (set! (n arg) 0))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";(~A ~A) -> ~A" name arg tag)))
+ (let ((tag
+ (catch #t
+ (lambda () (set! (n 0) arg))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";(set ~A ~A) -> ~A" name arg tag))))))
+ struct-accessors
+ struct-accessor-names))
+ (list dpy win '(Atom 0) '(Colormap 0) 1.5 "/hiho" 1234 #f #\c '(Time 0) '(Font 0) (make-vector 0) '(Cursor 1))))
+ )
+ (show-sounds-in-directory)
;(show-all-atoms)
- )))
-
-
-
-;;; ---------------- test 26: --------------------
-;;; was Gtk (xg) but it became a nightmare to run/maintain
+ )))
-(define (snd_test_26) #f)
-;;; ---------------- test 27: GL --------------------
+;;; ---------------- test 24: GL --------------------
-(define (snd_test_27)
+(define (snd_test_24)
(if (and (provided? 'snd-motif)
(provided? 'gl)
(provided? 'xm))
- (begin
-
- (if (not (provided? 'snd-snd-gl.scm)) (load "snd-gl.scm"))
+ (with-let (sublet *gl*)
+ (require snd-snd-gl.scm)
(gl-info)
(if all-args (gl-dump-state))
(let ((gl-procs
@@ -61219,7 +47376,7 @@ EDITS: 1
gluBuild2DMipmaps gluDeleteTess gluEndPolygon gluErrorString gluGetString gluGetTessProperty
gluOrtho2D gluPerspective gluPickMatrix gluProject gluScaleImage gluTessBeginContour gluTessBeginPolygon
gluTessEndPolygon gluTessNormal gluTessProperty gluTessVertex gluUnProject)
- '())))
+ ())))
;; ---------------- 1 Arg
(for-each
@@ -61230,9 +47387,9 @@ EDITS: 1
(lambda () (n arg))
(lambda args (car args))))
gl-procs))
- (list (list 0 1) (sqrt -1.0)))
+ (list (list 0 1) 0+i))
- (if (not (null? glu-procs))
+ (if (pair? glu-procs)
(begin
(for-each
(lambda (arg)
@@ -61242,12 +47399,12 @@ EDITS: 1
(lambda () (n arg))
(lambda args (car args))))
gl-procs))
- (list (list 0 1) (sqrt -1.0)))
+ (list (list 0 1) 0+i))
(let ((ind (open-sound "oboe.snd")))
- (glXMakeCurrent (XtDisplay (cadr (main-widgets)))
- (XtWindow (car (channel-widgets)))
- (snd-glx-context))
+ (glXMakeCurrent ((*motif* 'XtDisplay) (cadr (main-widgets)))
+ ((*motif* 'XtWindow) (car (channel-widgets)))
+ (snd-gl-context))
(glEnable GL_DEPTH_TEST)
(glDepthFunc GL_LEQUAL)
(glClearDepth 1.0)
@@ -61256,8 +47413,8 @@ EDITS: 1
(gluPerspective 40.0 1.0 10.0 200.0)
(glTranslatef 0.0 0.0 -50.0)
(glRotatef -58.0 0.0 1.0 0.0)
- (let ((vals (XtVaGetValues (car (channel-widgets)) (list XmNwidth 0 XmNheight 0))))
- (glViewport 0 0 (list-ref vals 1) (list-ref vals 3)))
+ (let ((vals ((*motif* 'XtVaGetValues) (car (channel-widgets)) (list (*motif* 'XmNwidth) 0 (*motif* 'XmNheight) 0))))
+ (glViewport 0 0 (vals 1) (vals 3)))
(glClear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
(glBegin GL_POLYGON)
(glColor3f 0.0 0.0 0.0) (glVertex3f -10.0 -10.0 0.0)
@@ -61275,36 +47432,34 @@ EDITS: 1
(glColor3f 0.0 0.0 1.0) (glVertex3f 4.0 -9.0 -10.0)
(glColor3f 1.0 0.0 1.0) (glVertex3f 4.0 -6.0 -10.0)
(glEnd)
- (glXSwapBuffers (XtDisplay (cadr (main-widgets)))
- (XtWindow (car (channel-widgets))))
+ (glXSwapBuffers ((*motif* 'XtDisplay) (cadr (main-widgets)))
+ ((*motif* 'XtWindow) (car (channel-widgets))))
(glFlush)
(close-sound ind)))))
)))
(if (and with-gui
(provided? 'xm)
- (= snd-test 25))
- (if (file-exists? "misc.scm")
- (load "misc.scm")))
+ (= snd-test 25)
+ (file-exists? "misc.scm"))
+ (load "misc.scm"))
-;;; ---------------- test 28: errors ----------------
+;;; ---------------- test 25: errors ----------------
-(defvar env3 '(0 0 1 1))
-
-(defmacro simple-time (a)
+(define-macro (simple-time a)
`(let ((start (get-internal-real-time)))
,a
(- (get-internal-real-time) start)))
-(define (snd_test_28)
+(define (snd_test_25)
(define (traced a) (+ 2 a))
(define (extract-channel filename snd chn)
- (save-sound-as filename snd #f #f #f chn))
+ (save-sound-as filename snd :channel chn))
(define* (extract-channels :rest chans)
;; extract a list of channels from the current sound and save as test.snd: (extract-channels 0 2)
@@ -61315,25 +47470,26 @@ EDITS: 1
(lambda (chan)
(set! (selection-member? snd chan) #t)
(set! (selection-position snd chan) 0)
- (set! (selection-frames snd chan) (frames snd chan)))
+ (set! (selection-framples snd chan) (framples snd chan)))
chans)
(save-selection "test.snd")))))
- (define* (notch-out-rumble-and-hiss snd chn)
- "(notch-out-rumble-and-hiss s c) applies a bandpass filter with cutoffs at 40 Hz and 3500 Hz"
- (let* ((cur-srate (exact->inexact (srate snd))))
- (filter-sound
- (list 0.0 0.0 ; get rid of DC
- (/ 80.0 cur-srate) 0.0 ; get rid of anything under 40 Hz (1.0=srate/2 here)
- (/ 90.0 cur-srate) 1.0 ; now the passband
- (/ 7000.0 cur-srate) 1.0
- (/ 8000.0 cur-srate) 0.0 ; end passband (40..4000)
- 1.0 0.0) ; get rid of some of the hiss
- ;; since the minimum band is 10 Hz here,
- ;; cur-srate/10 rounded up to next power of 2 seems a safe filter size
- ;; filter-sound will actually use overlap-add convolution in this case
- (expt 2 (ceiling (/ (log (/ cur-srate 10.0)) (log 2.0))))
- snd chn)))
+ (define notch-out-rumble-and-hiss
+ (let ((documentation "(notch-out-rumble-and-hiss s c) applies a bandpass filter with cutoffs at 40 Hz and 3500 Hz"))
+ (lambda* (snd chn)
+ (let ((cur-srate (* 1.0 (srate snd))))
+ (filter-sound
+ (list 0.0 0.0 ; get rid of DC
+ (/ 80.0 cur-srate) 0.0 ; get rid of anything under 40 Hz (1.0=srate/2 here)
+ (/ 90.0 cur-srate) 1.0 ; now the passband
+ (/ 7000.0 cur-srate) 1.0
+ (/ 8000.0 cur-srate) 0.0 ; end passband (40..4000)
+ 1.0 0.0) ; get rid of some of the hiss
+ ;; since the minimum band is 10 Hz here,
+ ;; cur-srate/10 rounded up to next power of 2 seems a safe filter size
+ ;; filter-sound will actually use overlap-add convolution in this case
+ (expt 2 (ceiling (log (/ cur-srate 10.0) 2.0)))
+ snd chn)))))
(define* (reverse-channels snd)
(let* ((ind (or snd (selected-sound) (car (sounds))))
@@ -61341,36 +47497,36 @@ EDITS: 1
(let ((swaps (floor (/ chns 2))))
(as-one-edit
(lambda ()
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(j (- chns 1) (- j 1)))
((= i swaps))
(swap-channels ind i ind j)))))))
(define* (rotate-channel (samps 1) snd chn)
- (let* ((ind (or snd (selected-sound) (car (sounds))))
+ (let ((ind (or snd (selected-sound) (car (sounds))))
(chan (or chn (selected-channel) 0)))
(let ((reg (make-region 0 (- samps 1) ind chan)))
(as-one-edit
(lambda ()
(delete-samples 0 samps ind chan)
- (insert-region reg (frames ind chan))))
+ (insert-region reg (framples ind chan))))
(forget-region reg))))
(define (randomize-list lst)
(let* ((len (length lst))
(vals (make-vector len #f))
- (nlst '()))
- (do ((i 0 (+ 1 i)))
+ (nlst ()))
+ (do ((i 0 (+ i 1)))
((= i len))
(let ((loc (random len)))
(if (vector-ref vals loc)
- (do ((j 0 (+ 1 j)))
+ (do ((j 0 (+ j 1)))
((or (= j len)
(not (vector-ref vals j)))
- (vector-set! vals j (car lst))))
- (vector-set! vals loc (car lst)))
+ (set! (vals j) (car lst))))
+ (set! (vals loc) (car lst)))
(set! lst (cdr lst))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
(set! nlst (cons (vector-ref vals i) nlst)))
nlst))
@@ -61386,38 +47542,36 @@ EDITS: 1
(snd-display #__line__ ";check-error-tag ~A from ~A: ~A"
expected-tag (procedure-source thunk) tag))))
- (set! (with-background-processes) #t)
- (set! (remember-sound-state) #f)
-
+ (set! *with-background-processes* #t)
+ (set! *remember-sound-state* #f)
+
(if with-gui
-
(let* ((delay-32 (make-delay 32))
(color-95 (make-color-with-catch .95 .95 .95))
(vector-0 (make-vector 0))
- (vct-3 (make-vct 3))
- (vct-5 (make-vct 5))
- (car-main (if with-gui (car (main-widgets)) #f))
- (cadr-main (if with-gui (cadr (main-widgets)) #f))
- (sound-data-23 (make-sound-data 2 3))
- (a-hook (make-hook 2))
- (a-sound #f)
+ (str-3 "/hiho")
+ (float-vector-3 (make-float-vector 3))
+ (float-vector-5 (make-float-vector 5))
+ (car-main (and with-gui (car (main-widgets))))
+ (cadr-main (and with-gui (cadr (main-widgets))))
+ (a-hook (make-hook 'a 'b))
(exts (sound-file-extensions)) ; save across possible set below
(procs (list
add-mark add-sound-file-extension add-source-file-extension sound-file-extensions sound-file?
add-to-main-menu add-to-menu add-transform amp-control ask-about-unsaved-edits
- as-one-edit ask-before-overwrite audio-input-device audio-output-device ; add-player
+ as-one-edit ask-before-overwrite
auto-resize auto-update autocorrelate axis-color axis-info axis-label-font axis-numbers-font
- basic-color bind-key bomb apply-controls change-samples-with-origin channel-style
+ basic-color bind-key apply-controls change-samples-with-origin channel-style
channel-widgets channels chans peaks-font bold-peaks-font close-sound combined-data-color
color-cutoff color-orientation-dialog colormap-ref add-colormap delete-colormap colormap-size colormap-name colormap?
color-inverted color-scale color->list colormap color? comment contrast-control contrast-control-amp
contrast-control? convolve-selection-with convolve-with channel-properties channel-property controls->channel
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
reverb-control-length-bounds reverb-control-scale-bounds cursor-update-interval cursor-location-offset
- auto-update-interval count-matches current-font cursor cursor-color with-tracking-cursor cursor-size
- cursor-style tracking-cursor-style dac-combines-channels dac-size clipping data-color data-format data-location data-size
- default-output-chans default-output-data-format default-output-srate default-output-header-type define-envelope
+ auto-update-interval current-font cursor cursor-color with-tracking-cursor cursor-size
+ cursor-style tracking-cursor-style dac-combines-channels dac-size clipping data-color sample-type data-location data-size
+ default-output-chans default-output-sample-type default-output-srate default-output-header-type define-envelope
delete-mark delete-marks forget-region delete-sample delete-samples delete-samples-and-smooth
delete-selection delete-selection-and-smooth dialog-widgets display-edits dot-size draw-dot draw-dots draw-line
draw-lines draw-string edit-header-dialog edit-fragment edit-list->function edit-position edit-tree edits env-selection
@@ -61425,43 +47579,42 @@ EDITS: 1
enved-target enved-waveform-color enved-wave? eps-file eps-left-margin
eps-bottom-margin eps-size expand-control expand-control-hop expand-control-jitter expand-control-length expand-control-ramp
expand-control? fft fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases transform-size disk-kspace
- transform-graph-type fft-window transform-graph? view-files-dialog mix-file-dialog file-name fill-polygon
+ transform-graph-type fft-window transform-graph? mix-file-dialog file-name fill-polygon
fill-rectangle filter-sound filter-control-in-dB filter-control-envelope enved-filter-order enved-filter
- filter-control-in-hz filter-control-order filter-selection filter-channel filter-control-waveform-color filter-control? find-channel
+ filter-control-in-hz filter-control-order filter-selection filter-channel filter-control-waveform-color filter-control?
find-mark find-sound finish-progress-report foreground-color insert-file-dialog file-write-date
- frames free-sampler graph transform? delete-transform
+ framples free-sampler graph transform? delete-transform
graph-color graph-cursor graph-data graph->ps gl-graph->ps graph-style lisp-graph? graphs-horizontal header-type
help-dialog info-dialog highlight-color insert-region insert-sample insert-samples
insert-samples-with-origin insert-selection insert-silence insert-sound just-sounds key key-binding
left-sample listener-color listener-font listener-prompt listener-selection listener-text-color
main-widgets make-color make-graph-data make-mix-sampler make-player make-region
- make-region-sampler make-sampler map-chan mark-color mark-name mark-properties mark-property
- mark-sample mark-sync mark-sync-max mark-home marks mark? max-transform-peaks max-regions max-virtual-ptrees
- maxamp maxamp-position menu-widgets minibuffer-history-length min-dB log-freq-start mix mixes mix-amp mix-amp-env
+ make-region-sampler make-sampler mark-color mark-name mark-properties mark-property
+ mark-sample mark-sync mark-sync-max mark-home marks mark? max-transform-peaks max-regions
+ maxamp maxamp-position menu-widgets min-dB log-freq-start mix mixes mix-amp mix-amp-env
mix-color mix-length mix? view-mixes-dialog mix-position
mix-dialog-mix mix-name mix-sync-max mix-sync mix-properties mix-property
mix-region mix-sampler? mix-selection mix-sound mix-home mix-speed mix-tag-height mix-tag-width mark-tag-height mark-tag-width
- mix-tag-y mix-vct mix-waveform-height time-graph-style lisp-graph-style transform-graph-style
+ mix-tag-y mix-float-vector mix-waveform-height time-graph-style lisp-graph-style transform-graph-style
;new-sound in
- read-mix-sample next-sample read-region-sample show-full-duration initial-beg initial-dur
+ read-mix-sample next-sample read-region-sample show-full-duration show-full-range initial-beg initial-dur
transform-normalization open-file-dialog-directory open-raw-sound open-sound previous-sample
peaks player? players play-arrow-size
- position-color position->x position->y add-directory-to-view-files-list add-file-to-view-files-list view-files-sort
- view-files-amp view-files-speed view-files-files view-files-selected-files view-files-speed-style view-files-amp-env
- print-length progress-report prompt-in-minibuffer read-only
+ position-color position->x position->y
+ print-length progress-report read-only read-sample-with-direction
redo region-chans view-regions-dialog region-home
- region-graph-style region-frames region-position region-maxamp region-maxamp-position remember-sound-state
- selection-maxamp selection-maxamp-position region-sample region->vct clear-minibuffer
- region-srate regions region? remove-from-menu report-in-minibuffer reset-controls restore-controls
+ region-graph-style region-framples region-position region-maxamp region-maxamp-position remember-sound-state
+ selection-maxamp selection-maxamp-position region-sample region->float-vector
+ region-srate regions region? remove-from-menu status-report reset-controls restore-controls
restore-region reverb-control-decay reverb-control-feedback
reverb-control-length reverb-control-lowpass reverb-control-scale reverb-control? reverse-sound
reverse-selection revert-sound right-sample sample sampler-at-end? sampler? samples sampler-position
sash-color save-controls ladspa-dir peak-env-dir save-dir save-edit-history save-envelopes
save-listener save-marks save-region save-selection save-sound save-sound-as
save-state save-state-file scale-by scale-selection-by scale-selection-to scale-to
- scan-chan search-procedure select-all select-channel select-sound
+ search-procedure select-all select-channel select-sound
selected-channel selected-data-color selected-graph-color selected-sound
- selection-position selection-color selection-creates-region selection-frames selection-member? selection?
+ selection-position selection-color selection-creates-region selection-framples selection-member? selection?
short-file-name show-axes show-controls show-transform-peaks show-indices show-listener show-selection unselect-all
show-marks show-mix-waveforms show-selection-transform show-y-zero sinc-width show-grid show-sonogram-cursor grid-density
smooth-sound smooth-selection snd-print snd-spectrum snd-tempnam snd-version sound-files-in-directory
@@ -61471,66 +47624,62 @@ EDITS: 1
;start-playing
start-progress-report stop-player stop-playing swap-channels syncd-marks sync sync-max sound-properties sound-property temp-dir
text-focus-color tiny-font region-sampler? transform-dialog transform-sample
- transform->vct transform-frames transform-type trap-segfault with-file-monitor optimization unbind-key undo
+ transform->float-vector transform-framples transform-type with-file-monitor unbind-key undo
update-transform-graph update-time-graph update-lisp-graph update-sound clm-table-size clm-default-frequency
- with-verbose-cursor view-sound wavelet-type with-inset-graph with-pointer-focus with-smpte-label
+ with-verbose-cursor view-sound wavelet-type with-inset-graph with-interrupts with-pointer-focus with-smpte-label
with-toolbar with-tooltips with-menu-icons save-as-dialog-src save-as-dialog-auto-comment
time-graph? time-graph-type wavo-hop wavo-trace window-height window-width window-x window-y
with-mix-tags with-relative-panes with-gl x-axis-style beats-per-measure
- beats-per-minute x-bounds x-position-slider x->position x-zoom-slider mus-header-type->string mus-data-format->string
+ beats-per-minute x-bounds x-position-slider x->position x-zoom-slider mus-header-type->string mus-sample-type->string
y-bounds y-position-slider y->position y-zoom-slider zero-pad zoom-color zoom-focus-style sync-style mus-set-formant-radius-and-frequency
- mus-sound-samples mus-sound-frames mus-sound-duration mus-sound-datum-size mus-sound-data-location data-size
- mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-data-format mus-sound-length
- mus-sound-type-specifier mus-header-type-name mus-data-format-name mus-sound-comment mus-sound-write-date
- mus-bytes-per-sample mus-sound-loop-info mus-sound-mark-info mus-audio-describe
+ mus-sound-samples mus-sound-framples mus-sound-duration mus-sound-datum-size mus-sound-data-location data-size
+ mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-sample-type mus-sound-length
+ mus-sound-type-specifier mus-header-type-name mus-sample-type-name mus-sound-comment mus-sound-write-date
+ mus-bytes-per-sample mus-sound-loop-info mus-sound-mark-info
;mus-alsa-buffers mus-alsa-buffer-size mus-apply
mus-alsa-squelch-warning
;mus-alsa-device mus-alsa-playback-device mus-alsa-capture-device
mus-sound-maxamp mus-sound-maxamp-exists?
- ;mus-sound-open-input mus-sound-open-output
- ;mus-sound-reopen-output mus-sound-close-input mus-sound-close-output mus-sound-read mus-sound-write
- ;mus-sound-seek-frame
- mus-file-prescaler mus-prescaler mus-clipping mus-file-clipping mus-header-raw-defaults
- moving-average moving-average? make-moving-average
- mus-expand-filename
- make-sound-data sound-data-ref sound-data-set! sound-data-scale! sound-data-fill! sound-data? sound-data-length
- sound-data-multiply! sound-data-add! sound-data-offset! sound-data* sound-data+ sound-data-copy sound-data-reverse!
- sound-data-maxamp sound-data-chans sound-data->vct vct->sound-data sound-data-peak
+ mus-clipping mus-file-clipping mus-header-raw-defaults
+ moving-average moving-average? make-moving-average moving-max moving-max? make-moving-max
+ make-moving-norm moving-norm moving-norm? mus-expand-filename
all-pass all-pass? amplitude-modulate
- array->file array-interp mus-interpolate asymmetric-fm asymmetric-fm? sound-data->sound-data
- clear-array comb comb? filtered-comb filtered-comb? contrast-enhancement convolution convolve convolve? db->linear degrees->radians
- delay delay? dot-product env env-interp env? file->array file->frame file->frame? file->sample
- file->sample? filter filter? fir-filter fir-filter? formant formant-bank formant? frame* frame+ firmant firmant?
- frame->file frame->file? frame->frame frame->list frame->sample frame-ref frame-set! frame?
- granulate granulate? hz->radians iir-filter iir-filter? linear->db locsig ; in-any ina inb (sound-data arg troubles)
+ array->file array-interp mus-interpolate asymmetric-fm asymmetric-fm?
+ comb comb? filtered-comb filtered-comb? contrast-enhancement convolution convolve convolve? db->linear degrees->radians
+ delay delay? dot-product env env-interp env? file->array file->frample file->frample? file->sample
+ even-multiple even-weight odd-multiple odd-weight
+ file->sample? filter filter? fir-filter fir-filter? formant formant-bank formant-bank? formant? firmant firmant?
+ comb-bank make-comb-bank comb-bank? all-pass-bank make-all-pass-bank all-pass-bank? filtered-comb-bank make-filtered-comb-bank filtered-comb-bank?
+ granulate granulate? hz->radians iir-filter iir-filter? linear->db locsig ; in-any ina inb
locsig-ref locsig-reverb-ref locsig-reverb-set! locsig-set! locsig? make-all-pass make-asymmetric-fm
- make-comb make-filtered-comb make-convolve make-delay make-env make-fft-window make-file->frame
- make-file->sample make-filter make-fir-filter make-formant make-firmant frame make-frame make-frame->file make-granulate
- make-iir-filter make-locsig move-locsig make-mixer make-notch make-one-pole make-one-zero make-oscil
+ make-comb make-filtered-comb make-convolve make-delay make-env make-fft-window make-file->frample
+ make-file->sample make-filter make-fir-filter make-formant make-firmant make-frample->file make-granulate
+ make-iir-filter make-locsig move-locsig make-notch make-one-pole make-one-pole-all-pass make-one-zero make-oscil
make-pulse-train make-rand make-rand-interp make-readin make-sample->file make-sawtooth-wave
- make-nrxysin make-nrxycos make-square-wave make-src make-ncos
+ make-nrxysin make-nrxycos make-square-wave make-src make-ncos make-rxyk!cos make-rxyk!sin
make-nsin make-ssb-am make-table-lookup make-triangle-wave
- make-two-pole make-two-zero make-wave-train mixer mixer* mixer-ref mixer-set! mixer? mixer+
+ make-two-pole make-two-zero make-wave-train
move-sound make-move-sound move-sound? mus-float-equal-fudge-factor
- multiply-arrays mus-array-print-length mus-channel mus-channels make-polyshape polyshape polyshape? make-polywave polywave polywave?
+ mus-array-print-length mus-channel mus-channels make-polyshape polyshape polyshape? make-polywave polywave polywave?
mus-close mus-data mus-feedback mus-feedforward mus-fft mus-frequency
- mus-hop mus-increment mus-input? mus-file-name mus-length mus-location mus-mix mus-order mus-output? mus-phase
- mus-ramp mus-random mus-scaler mus-srate mus-xcoeff mus-xcoeffs mus-ycoeff mus-ycoeffs notch notch? one-pole one-pole?
+ mus-hop mus-increment mus-input? mus-file-name mus-length mus-location mus-file-mix mus-order mus-output? mus-phase
+ mus-ramp mus-random mus-scaler mus-srate mus-xcoeff mus-xcoeffs mus-ycoeff mus-ycoeffs
+ notch notch? one-pole one-pole? one-pole-all-pass one-pole-all-pass?
one-zero one-zero? oscil oscil? out-any outa outb outc outd partials->polynomial normalize-partials
partials->wave phase-partials->wave polynomial pulse-train pulse-train?
radians->degrees radians->hz rand rand-interp rand-interp? rand? readin readin? rectangular->polar rectangular->magnitudes
- ring-modulate sample->file sample->file? sample->frame sawtooth-wave
- sawtooth-wave? nrxysin nrxysin? nrxycos nrxycos?
+ ring-modulate sample->file sample->file? sawtooth-wave
+ sawtooth-wave? nrxysin nrxysin? nrxycos nrxycos? rxyk!cos rxyk!cos? rxyk!sin rxyk!sin?
spectrum square-wave square-wave? src src? ncos nsin ssb-am
- ncos? nsin? ssb-am? table-lookup table-lookup? tap triangle-wave triangle-wave? two-pole two-pole? two-zero
- two-zero? wave-train wave-train? make-vct vct-add! vct-subtract! vct-copy
- vct-length vct-multiply! vct-offset! vct-ref vct-scale! vct-fill! vct-set! vct-peak
- vct? list->vct vct->list vector->vct vct->vector vct-move! vct-reverse! vct-subseq vct little-endian? vct->string
+ ncos? nsin? ssb-am? table-lookup table-lookup? tap tap? triangle-wave triangle-wave? two-pole two-pole? two-zero
+ two-zero? wave-train wave-train? make-float-vector float-vector-add! float-vector-subtract!
+ float-vector-multiply! float-vector-offset! float-vector-ref float-vector-scale! float-vector-set! float-vector-peak float-vector-max float-vector-min
+ float-vector? float-vector-move! float-vector-subseq float-vector little-endian? float-vector->string
clm-channel env-channel env-channel-with-base map-channel scan-channel
reverse-channel seconds->samples samples->seconds
- smooth-channel vct->channel channel->vct src-channel scale-channel ramp-channel pad-channel normalize-channel
- cursor-position clear-listener mus-sound-prune mus-sound-forget xramp-channel ptree-channel
- snd->sample snd->sample? make-snd->sample make-scalar-mixer
+ smooth-channel float-vector->channel channel->float-vector src-channel scale-channel ramp-channel pad-channel normalize-channel
+ cursor-position clear-listener mus-sound-prune mus-sound-forget xramp-channel
+ snd->sample snd->sample? make-snd->sample
beats-per-minute beats-per-measure channel-amp-envs convolve-files filter-control-coeffs
locsig-type make-phase-vocoder
@@ -61540,7 +47689,7 @@ EDITS: 1
phase-vocoder-phase-increments phase-vocoder-phases mus-generator?
read-sample reset-listener-cursor goto-listener-end sampler-home selection-chans selection-srate snd-gcs snd-font snd-color
- snd-warning channel-data x-axis-label variable-graph? y-axis-label
+ snd-warning x-axis-label variable-graph? y-axis-label
snd-url snd-urls free-player
delay-tick playing pausing draw-axes copy-sampler html-dir html-program
@@ -61550,15 +47699,15 @@ EDITS: 1
))
(set-procs (list
- amp-control ask-about-unsaved-edits ask-before-overwrite audio-input-device audio-output-device auto-resize
+ amp-control ask-about-unsaved-edits ask-before-overwrite auto-resize
auto-update axis-color axis-label-font axis-numbers-font ;basic-color
- channel-style peaks-font bold-peaks-font sound-file-extensions show-full-duration initial-beg initial-dur
+ channel-style peaks-font bold-peaks-font sound-file-extensions show-full-duration show-full-range initial-beg initial-dur
color-cutoff color-inverted color-scale contrast-control contrast-control-amp combined-data-color
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
reverb-control-length-bounds reverb-control-scale-bounds cursor-update-interval cursor-location-offset
contrast-control? auto-update-interval current-font cursor cursor-color channel-properties channel-property
with-tracking-cursor cursor-size cursor-style tracking-cursor-style dac-combines-channels dac-size clipping data-color
- default-output-chans default-output-data-format default-output-srate default-output-header-type dot-size
+ default-output-chans default-output-sample-type default-output-srate default-output-header-type dot-size
enved-envelope enved-base enved-clip? enved-in-dB enved-style enved-power
enved-target enved-waveform-color enved-wave? eps-file eps-left-margin eps-bottom-margin eps-size
expand-control expand-control-hop expand-control-jitter expand-control-length expand-control-ramp expand-control?
@@ -61568,12 +47717,10 @@ EDITS: 1
graph-color graph-cursor graph-style lisp-graph? graphs-horizontal highlight-color
just-sounds left-sample listener-color listener-font listener-prompt listener-text-color mark-color
mark-name mark-properties mark-property mark-sample mark-sync max-transform-peaks max-regions min-dB log-freq-start mix-amp
- mix-amp-env mix-color mix-name mix-position mix-sync mix-properties mix-property max-virtual-ptrees
+ mix-amp-env mix-color mix-name mix-position mix-sync mix-properties mix-property
mix-speed mix-tag-height mix-tag-width mix-tag-y mark-tag-width mark-tag-height
mix-waveform-height transform-normalization open-file-dialog-directory
- position-color view-files-sort print-length play-arrow-size
- view-files-amp view-files-speed view-files-speed-style view-files-amp-env
- view-files-files view-files-selected-files ; remember-sound-state
+ position-color print-length play-arrow-size
region-graph-style reverb-control-decay reverb-control-feedback
reverb-control-length reverb-control-lowpass reverb-control-scale time-graph-style lisp-graph-style transform-graph-style
reverb-control? sash-color ladspa-dir peak-env-dir save-dir save-state-file selected-data-color selected-graph-color
@@ -61582,38 +47729,37 @@ EDITS: 1
show-y-zero show-grid show-sonogram-cursor sinc-width spectrum-end spectro-hop spectrum-start spectro-x-angle grid-density
spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle spectro-z-scale speed-control
speed-control-style speed-control-tones squelch-update sync sound-properties sound-property temp-dir text-focus-color tiny-font y-bounds
- transform-type trap-segfault with-file-monitor optimization with-verbose-cursor
- with-inset-graph with-pointer-focus wavelet-type x-bounds with-smpte-label
+ transform-type with-file-monitor with-verbose-cursor
+ with-inset-graph with-interrupts with-pointer-focus wavelet-type x-bounds with-smpte-label
with-toolbar with-tooltips with-menu-icons save-as-dialog-src save-as-dialog-auto-comment
time-graph? wavo-hop wavo-trace with-gl with-mix-tags x-axis-style beats-per-minute zero-pad zoom-color zoom-focus-style sync-style
with-relative-panes window-x window-y window-width window-height mix-dialog-mix beats-per-measure
- channels chans colormap comment data-format data-location data-size edit-position frames header-type maxamp
- minibuffer-history-length read-only right-sample sample samples selected-channel colormap-size colormap?
- selected-sound selection-position selection-frames selection-member? sound-loop-info
+ channels chans colormap comment sample-type data-location data-size edit-position framples header-type maxamp
+ read-only right-sample sample samples selected-channel colormap-size colormap?
+ selected-sound selection-position selection-framples selection-member? sound-loop-info
srate time-graph-type x-position-slider x-zoom-slider
- y-position-slider y-zoom-slider sound-data-ref mus-array-print-length mus-float-equal-fudge-factor
+ y-position-slider y-zoom-slider mus-array-print-length mus-float-equal-fudge-factor
;mus-data
mus-feedback mus-feedforward mus-frequency mus-hop
- mus-increment mus-length mus-location mus-name mus-phase mus-ramp mus-scaler vct-ref x-axis-label
+ mus-increment mus-length mus-location mus-name mus-phase mus-ramp mus-scaler x-axis-label
filter-control-coeffs locsig-type mus-file-buffer-size
mus-rand-seed mus-width clm-table-size clm-default-frequency mus-offset mus-reset
phase-vocoder-amp-increments phase-vocoder-amps
phase-vocoder-freqs phase-vocoder-phase-increments phase-vocoder-phases
html-dir html-program mus-interp-type widget-position widget-size
- mixer-ref frame-ref locsig-ref locsig-reverb-ref
- mus-file-prescaler mus-prescaler mus-clipping mus-file-clipping mus-header-raw-defaults
+ mus-clipping mus-file-clipping mus-header-raw-defaults
))
(make-procs (list
- make-all-pass make-asymmetric-fm make-snd->sample make-moving-average
- make-comb make-filtered-comb make-convolve make-delay make-env make-fft-window make-file->frame
- make-file->sample make-filter make-fir-filter make-formant make-firmant make-frame make-frame->file make-granulate
- make-iir-filter make-locsig make-mixer make-notch make-one-pole make-one-zero make-oscil
+ make-all-pass make-asymmetric-fm make-snd->sample make-moving-average make-moving-max make-moving-norm
+ make-comb make-filtered-comb make-convolve make-delay make-env make-fft-window make-file->frample
+ make-file->sample make-filter make-fir-filter make-formant make-firmant make-frample->file make-granulate
+ make-iir-filter make-locsig make-notch make-one-pole make-one-pole-all-pass make-one-zero make-oscil
make-pulse-train make-rand make-rand-interp make-readin make-sample->file make-sawtooth-wave
- make-nrxysin make-nrxycos make-square-wave
+ make-nrxysin make-nrxycos make-rxyk!cos make-rxyk!sin make-square-wave
make-src make-ncos make-nsin make-table-lookup make-triangle-wave
make-two-pole make-two-zero make-wave-train make-phase-vocoder make-ssb-am make-polyshape make-polywave
- make-color make-player make-region make-scalar-mixer
+ make-color make-player make-region
))
(keyargs
@@ -61625,61 +47771,15 @@ EDITS: 1
:length :hop :ramp :jitter :type :format :comment :channels :filter :revout :width :edit
:synthesize :analyze :interp :overlap :pitch :distribution :sines :dur))
- (procs0 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 0)))) procs))
+ (procs0 (remove-if (lambda (n) (or (not (procedure? n)) (not (aritable? n 0)))) procs))
(set-procs0 (remove-if (lambda (n) (or (not (procedure? n)) (not (set-arity-ok n 1)))) set-procs))
- (procs1 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 1)))) procs))
+ (procs1 (remove-if (lambda (n) (or (not (procedure? n)) (not (aritable? n 1)))) procs))
(set-procs1 (remove-if (lambda (n) (or (not (procedure? n)) (not (set-arity-ok n 2)))) set-procs))
- (procs2 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 2)))) procs))
+ (procs2 (remove-if (lambda (n) (or (not (procedure? n)) (not (aritable? n 2)))) procs))
(set-procs2 (remove-if (lambda (n) (or (not (procedure? n)) (not (set-arity-ok n 3)))) set-procs))
- (procs3 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 3)))) procs))
- (set-procs3 (remove-if (lambda (n) (or (not (procedure? n)) (not (set-arity-ok n 4)))) set-procs))
- (procs4 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 4)))) procs))
- (set-procs4 (remove-if (lambda (n) (or (not (procedure? n)) (not (set-arity-ok n 5)))) set-procs))
- (procs5 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 5)))) procs))
- (procs6 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 6)))) procs))
- (procs7 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 7)))) procs))
- (procs8 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 8)))) procs))
- (procs10 (remove-if (lambda (n) (or (not (procedure? n)) (not (arity-ok n 10)))) procs))
-
- (already-warned '("mus-length" "mus-data" "hz->radians" "mus-order" "mus-xcoeffs" "mus-ycoeffs"
- "list->vct" "vct" "formant-bank"
- ))
)
- #|
- (for-each
- (lambda (n)
- (if (and (not (member n procs0))
- (not (member n procs1))
- (not (member n procs2))
- (not (member n procs3))
- (not (member n procs4))
- (not (member n procs5))
- (not (member n procs6))
- (not (member n procs8))
- (not (member n procs10)))
- (snd-display #__line__ ";not in any list: ~A" n)))
- procs)
- (for-each
- (lambda (n)
- (if (and (not (member n set-procs0))
- (not (member n set-procs1))
- (not (member n set-procs2))
- (not (member n set-procs3))
- (not (member n set-procs4)))
- (snd-display #__line__ ";not in any set list: ~A" n)))
- set-procs)
- |#
- (if all-args
- (snd-display #__line__ ";procs 0: ~A ~A, 1: ~A ~A, 2: ~A ~A, 3: ~A ~A, 4: ~A ~A, 5: ~A, 6: ~A, 7: ~A, 8: ~A, 10: ~A"
- (length procs0) (length set-procs0)
- (length procs1) (length set-procs1)
- (length procs2) (length set-procs2)
- (length procs3) (length set-procs3)
- (length procs4) (length set-procs4)
- (length procs5) (length procs6) (length procs7) (length procs8) (length procs10)))
-
- (reset-almost-all-hooks)
+ (reset-all-hooks)
(do ((test-28 0 (+ 1 test-28)))
((= test-28 tests))
@@ -61690,39 +47790,35 @@ EDITS: 1
(set! delay-32 (make-oscil 440))
(set! color-95 (vector 1 2 3))
(set! vector-0 (make-comb .1 3))
- (set! vct-3 (make-notch .1 101))
+ (set! float-vector-3 (make-notch .1 101))
(set! car-main (make-all-pass .4 .5 2))
(set! cadr-main (make-table-lookup 101))
- (set! sound-data-23 (make-square-wave 440))
(set! a-hook (make-triangle-wave 220)))
(if (= test-28 2)
(begin
(set! delay-32 (make-sawtooth-wave 440))
(set! color-95 123+123i)
(set! vector-0 (make-rand 100))
- (set! vct-3 (make-rand-interp 100))
+ (set! float-vector-3 (make-rand-interp 100))
(set! car-main (make-asymmetric-fm 100))
- (set! sound-data-23 (make-one-zero .1 .1))
(set! a-hook (make-one-pole .1 .1)))
(if (= test-28 3)
(begin
(set! delay-32 (make-two-zero .5 .5 .1))
(set! color-95 (list 1 2 3))
(set! vector-0 (make-formant 100 .1))
- (set! vct-3 (make-polyshape :frequency 300 :partials '(1 1 2 1)))
+ (set! float-vector-3 (make-polyshape :frequency 300 :partials '(1 1 2 1)))
(set! car-main (make-oscil))
(set! cadr-main (vector 1 2 3))
- (set! sound-data-23 (make-wave-train 100))
- (set! a-hook (make-frame 2 .2 .1)))
+ (set! a-hook (float-vector .2 .1)))
(if (= test-28 4)
(begin
- (set! delay-32 (make-filter 3 (vct 3 1 2 3) (vct 3 1 2 3)))
- (set! color-95 (make-sound-data 2 1))
- (set! vector-0 (make-iir-filter 3 (vct 1 2 3)))
- (set! vct-3 (make-ncos))
+ (set! delay-32 (make-filter 3 (float-vector 3 1 2 3) (float-vector 3 1 2 3)))
+ (set! color-95 (make-float-vector (list 2 1) 0.0))
+ (set! vector-0 (make-iir-filter 3 (float-vector 1 2 3)))
+ (set! float-vector-3 (make-ncos))
(set! car-main (make-env '(0 0 1 1) :length 101))
(set! cadr-main (make-nsin 100 4))
- (set! sound-data-23 (make-ssb-am 440))
(set! a-hook (make-nsin 100 3)))
(if (= test-28 5)
(begin
@@ -61731,24 +47827,24 @@ EDITS: 1
(set! vector-0 (make-vector 1))
(set! car-main (make-moving-average 3))
(set! cadr-main (make-oscil 440))
- (set! a-hook (make-mixer 2 .1 .2 .1 .2))
+ (set! a-hook (make-shared-vector (float-vector .1 .2 .1 .2) (list 2 2)))
))))))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n (integer->sound 123)))
- (lambda args (car args)))))
+ (lambda ()
+ (n (integer->sound 123)))
+ (lambda args (car args)))))
(if (not (eq? tag 'no-such-sound))
(snd-display #__line__ ";snd no-such-sound ~A: ~A" n tag))))
(list amp-control apply-controls channels chans comment contrast-control
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
reverb-control-length-bounds reverb-control-scale-bounds
- contrast-control-amp contrast-control? data-format data-location data-size
+ contrast-control-amp contrast-control? sample-type data-location data-size
expand-control expand-control-hop expand-control-jitter
expand-control-length expand-control-ramp expand-control? file-name filter-control-in-dB filter-control-in-hz
- filter-control-envelope filter-control-order filter-control? finish-progress-report frames header-type
+ filter-control-envelope filter-control-order filter-control? finish-progress-report framples header-type
progress-report read-only reset-controls restore-controls reverb-control-decay reverb-control-feedback
reverb-control-length reverb-control-lowpass reverb-control-scale reverb-control? save-controls
select-sound short-file-name sound-loop-info soundfont-info speed-control speed-control-style
@@ -61758,16 +47854,16 @@ EDITS: 1
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n arg))
- (lambda args (car args)))))
+ (lambda ()
+ (n arg))
+ (lambda args (car args)))))
(if (and (not (eq? tag 'wrong-type-arg))
(not (eq? tag 'mus-error)))
(snd-display #__line__ ";snd wrong-type-arg ~A: ~A ~A" n tag arg))))
- (list amp-control bomb apply-controls close-sound comment contrast-control
+ (list amp-control apply-controls close-sound comment contrast-control
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
reverb-control-length-bounds reverb-control-scale-bounds
- contrast-control-amp contrast-control? data-format data-location data-size expand-control
+ contrast-control-amp contrast-control? sample-type data-location data-size expand-control
expand-control-hop expand-control-jitter expand-control-length expand-control-ramp expand-control?
filter-control-in-dB filter-control-in-hz filter-control-envelope filter-control-order filter-control?
finish-progress-report header-type read-only reset-controls restore-controls
@@ -61775,429 +47871,374 @@ EDITS: 1
reverb-control-scale reverb-control? save-controls select-sound short-file-name
sound-loop-info soundfont-info speed-control speed-control-style speed-control-tones srate
channel-style start-progress-report sync sound-properties swap-channels)))
- (list vct-5 (sqrt -1.0) 1.5 "hiho" delay-32))
+ (list float-vector-5 0+i 1.5 "hiho" delay-32))
(for-each (lambda (arg)
- (let ((ctr 0))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (set! (n arg) 0))
+ (lambda args (car args)))))
+ (if (and (not (eq? tag 'wrong-type-arg))
+ (not (eq? tag 'syntax-error))
+ (not (eq? tag 'error)))
+ (snd-display #__line__ ";snd set wrong-type-arg: ~A: ~A ~A" n tag arg))))
+ (list amp-control channels chans comment contrast-control contrast-control-amp
+ amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
+ reverb-control-length-bounds reverb-control-scale-bounds
+ contrast-control? sample-type data-location data-size expand-control expand-control-hop expand-control-jitter
+ expand-control-length expand-control-ramp expand-control? filter-control-in-dB filter-control-in-hz
+ filter-control-envelope filter-control-order filter-control? framples header-type read-only
+ reverb-control-decay reverb-control-feedback reverb-control-length reverb-control-lowpass
+ reverb-control-scale reverb-control? sound-loop-info soundfont-info speed-control
+ speed-control-style speed-control-tones srate channel-style sync)))
+ (list float-vector-5 0+i 1.5 "hiho" delay-32))
+
+ (let ((index (open-sound "obtest.snd")))
+ (for-each (lambda (arg)
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (set! (n arg) 0))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'syntax-error))
- (not (eq? tag 'error)))
- (snd-display #__line__ ";snd set wrong-type-arg ~D: ~A: ~A ~A" ctr n tag arg))
- (set! ctr (+ ctr 1))))
- (list amp-control channels chans comment contrast-control contrast-control-amp
+ (lambda ()
+ (set! (n index) arg))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ ";snd safe set wrong-type-arg: ~A ~A ~A" n tag arg))))
+ (list amp-control contrast-control contrast-control-amp contrast-control? expand-control
amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
reverb-control-length-bounds reverb-control-scale-bounds
- contrast-control? data-format data-location data-size expand-control expand-control-hop expand-control-jitter
- expand-control-length expand-control-ramp expand-control? filter-control-in-dB filter-control-in-hz
- filter-control-envelope filter-control-order filter-control? frames header-type read-only
+ expand-control-hop expand-control-jitter expand-control-length expand-control-ramp expand-control?
+ filter-control-in-dB filter-control-in-hz filter-control-envelope filter-control-order filter-control?
reverb-control-decay reverb-control-feedback reverb-control-length reverb-control-lowpass
- reverb-control-scale reverb-control? sound-loop-info soundfont-info speed-control
- speed-control-style speed-control-tones srate channel-style sync))))
- (list vct-5 (sqrt -1.0) 1.5 "hiho" delay-32))
-
- (let ((index (open-sound "obtest.snd")))
- (for-each (lambda (arg)
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (set! (n index) arg))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";snd safe set wrong-type-arg ~A: ~A ~A ~A" ctr n tag arg))
- (set! ctr (+ ctr 1))))
- (list amp-control contrast-control contrast-control-amp contrast-control? expand-control
- amp-control-bounds speed-control-bounds expand-control-bounds contrast-control-bounds
- reverb-control-length-bounds reverb-control-scale-bounds
- expand-control-hop expand-control-jitter expand-control-length expand-control-ramp expand-control?
- filter-control-in-dB filter-control-in-hz filter-control-envelope filter-control-order filter-control?
- reverb-control-decay reverb-control-feedback reverb-control-length reverb-control-lowpass
- reverb-control-scale reverb-control? speed-control speed-control-style speed-control-tones
- channel-style sync))))
- (list vct-5 (sqrt -1.0) "hiho" delay-32))
+ reverb-control-scale reverb-control? speed-control speed-control-style speed-control-tones
+ channel-style sync)))
+ (list float-vector-5 0+i "hiho" delay-32))
(close-sound index))
(for-each (lambda (arg)
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n arg))
- (lambda args (car args)))))
+ (lambda ()
+ (n arg))
+ (lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";vct 0 wrong-type-arg ~A: ~A ~A" n tag arg))))
- (list make-vct vct-copy vct-length vct->list vct-peak)))
- (list (make-vector 1) "hiho" (sqrt -1.0) 1.5 (list 1 0) '#(0 1) delay-32))
+ (snd-display #__line__ ";float-vector 0 wrong-type-arg ~A: ~A ~A" n tag arg))))
+ (list make-float-vector float-vector-peak float-vector-max float-vector-min)))
+ (list (make-vector 1) "hiho" 0+i 1.5 #(0 1) delay-32))
(for-each (lambda (arg1)
(for-each (lambda (arg2)
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n arg1 arg2))
- (lambda args (car args)))))
- (if (not (or (eq? tag 'wrong-type-arg)
- (eq? tag 'wrong-number-of-args)
- (eq? tag 'mus-error)))
- (snd-display #__line__ ";vct 1 wrong-whatever ~A: ~A ~A ~A" n tag arg1 arg2))))
- (list vct-add! vct-subtract! vct-multiply! vct-ref vct-scale! vct-fill!)))
- (list vct-5 "hiho" (sqrt -1.0) 1.5 (list 1 0) '#(0 1) delay-32)))
- (list (make-vector 1) "hiho" (sqrt -1.0) 1.5 (list 1 0) '#(0 1) delay-32))
+ (lambda ()
+ (n arg1 arg2))
+ (lambda args (car args)))))
+ (if (not (memq tag '(wrong-type-arg wrong-number-of-args mus-error)))
+ (snd-display #__line__ ";float-vector 1 wrong-whatever ~A: ~A ~A ~A" n tag arg1 arg2))))
+ (list float-vector-add! float-vector-subtract! float-vector-multiply! float-vector-ref float-vector-scale!)))
+ (list float-vector-5 "hiho" 0+i 1.5 (list 1 0) #(0 1) delay-32)))
+ (list (make-vector 1) "hiho" 0+i 1.5 (list 1 0) #(0 1) delay-32))
(for-each (lambda (arg)
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n vct-3 arg))
- (lambda args (car args)))))
+ (lambda ()
+ (n float-vector-3 arg))
+ (lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";vct 2 wrong-type-arg ~A: ~A" n tag))))
- (list vct-add! vct-subtract! vct-multiply! vct-ref vct-scale! vct-fill!)))
- (list (make-vector 1) "hiho" (sqrt -1.0) (list 1 0) '#(0 1) delay-32))
-
- (let ((tag
- (catch #t
- (lambda ()
- (make-vct -23))
- (lambda args (car args)))))
- (if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";make-vct -23: ~A" tag)))
+ (snd-display #__line__ ";float-vector arg 2 (scaler) wrong-type-arg ~A: ~A ~A" n arg tag))))
+ (list float-vector-add! float-vector-subtract! float-vector-multiply! float-vector-ref float-vector-scale!)))
+ (list (make-vector 1) "hiho" 0+i (list 1 0) #(0 1) delay-32))
- (let* ((v vct-3))
+ (let ((v float-vector-3))
(let ((tag
(catch #t
- (lambda ()
- (vct-ref v 12))
- (lambda args (car args)))))
+ (lambda ()
+ (v 12))
+ (lambda args (car args)))))
(if (not (eq? tag 'out-of-range))
- (snd-display #__line__ ";vct[12]: ~A" tag))))
+ (snd-display #__line__ ";float-vector[12]: ~A" tag))))
(for-each (lambda (arg)
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n arg))
- (lambda args (car args)))))
+ (lambda ()
+ (n arg))
+ (lambda args (car args)))))
(if tag
(snd-display #__line__ ";?proc ~A: ~A" n tag))))
- (list all-pass? asymmetric-fm? comb? filtered-comb? convolve? delay? env? file->frame? file->sample? snd->sample?
- filter? fir-filter? formant? firmant? frame->file? frame? granulate? iir-filter? locsig? mixer? move-sound? mus-input?
- mus-output? notch? one-pole? one-zero? oscil? phase-vocoder? pulse-train? rand-interp? rand? readin?
- sample->file? sawtooth-wave? nrxysin? nrxycos?
- square-wave? src? ncos? nsin? table-lookup?
- triangle-wave? two-pole? two-zero? wave-train? color? mix-sampler? moving-average? ssb-am?
- sampler? region-sampler? vct? )))
- (list (make-vector 1) "hiho" (sqrt -1.0) 1.5 (list 1 0) '#(0 1)))
+ (list all-pass? asymmetric-fm? comb? filtered-comb? convolve? delay? env? file->frample? file->sample? snd->sample?
+ filter? fir-filter? formant? formant-bank? firmant? frample->file? granulate? iir-filter? locsig? move-sound? mus-input?
+ mus-output? notch? one-pole? one-pole-all-pass? one-zero? oscil? phase-vocoder? pulse-train? rand-interp? rand? readin?
+ sample->file? sawtooth-wave? nrxysin? nrxycos? rxyk!cos? rxyk!sin?
+ square-wave? src? ncos? nsin? tap? table-lookup?
+ triangle-wave? two-pole? two-zero? wave-train? color? mix-sampler? moving-average? moving-max? moving-norm? ssb-am?
+ sampler? region-sampler? float-vector? )))
+ (list (make-vector 1) "hiho" 0+i 1.5 (list 1 0) #(0 1)))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n (make-oscil 440)))
- (lambda args (car args)))))
+ (lambda ()
+ (n (make-oscil 440)))
+ (lambda args (car args)))))
(if tag
(snd-display #__line__ ";oscil?proc ~A: ~A" n tag))))
- (list all-pass? asymmetric-fm? comb? filtered-comb? convolve? delay? env? file->frame? file->sample? snd->sample?
- filter? fir-filter? formant? firmant? frame->file? frame? granulate? iir-filter? locsig? mixer? move-sound? mus-input?
- mus-output? notch? one-pole? one-zero? phase-vocoder? pulse-train? rand-interp? rand? readin?
- sample->file? sawtooth-wave? nrxysin? nrxycos?
- square-wave? src? ncos? nsin? table-lookup?
- triangle-wave? two-pole? two-zero? wave-train? sound? color? mix-sampler? moving-average? ssb-am?
- sampler? region-sampler? vct?))
+ (list all-pass? asymmetric-fm? comb? filtered-comb? convolve? delay? env? file->frample? file->sample? snd->sample?
+ filter? fir-filter? formant? formant-bank? firmant? frample->file? granulate? iir-filter? locsig? move-sound? mus-input?
+ mus-output? notch? one-pole? one-pole-all-pass? one-zero? phase-vocoder? pulse-train? rand-interp? rand? readin?
+ sample->file? sawtooth-wave? nrxysin? nrxycos? rxyk!cos? rxyk!sin?
+ square-wave? src? ncos? nsin? tap? table-lookup?
+ triangle-wave? two-pole? two-zero? wave-train? sound? color? mix-sampler? moving-average? moving-max? moving-norm? ssb-am?
+ sampler? region-sampler? float-vector?))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n))
- (lambda args (car args)))))
+ n
+ (lambda args (car args)))))
(if (not (eq? tag 'no-active-selection))
(snd-display #__line__ ";selection ~A: ~A" n tag))))
- (list reverse-selection selection-position selection-frames smooth-selection
+ (list reverse-selection selection-position selection-framples smooth-selection
scale-selection-to insert-selection delete-selection delete-selection-and-smooth mix-selection))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n 0.0))
- (lambda args (car args)))))
+ (lambda ()
+ (n 0.0))
+ (lambda args (car args)))))
(if (not (eq? tag 'no-active-selection))
(snd-display #__line__ ";selection ~A: ~A" n tag))))
(list src-selection filter-selection env-selection))
(for-each (lambda (arg)
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n arg))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'no-data))
- (not (eq? tag 'no-such-method))
- (not (eq? tag 'bad-type))
- (not (eq? tag 'error))
- (not (eq? tag 'arg-error)))
- (snd-display #__line__ ";clm ~A: tag: ~A arg: ~A [~A]" n tag arg ctr))
- (set! ctr (+ 1 ctr))))
- (list all-pass asymmetric-fm clear-array comb filtered-comb convolve db->linear moving-average
- degrees->radians delay env formant firmant frame->list granulate hz->radians linear->db
- make-all-pass make-asymmetric-fm make-comb make-filtered-comb make-convolve make-delay make-env
- make-file->frame make-file->sample make-filter make-fir-filter make-formant make-firmant make-frame
- make-granulate make-iir-filter make-locsig make-notch make-one-pole make-one-zero
- make-oscil make-pulse-train make-rand make-rand-interp make-readin
- make-sawtooth-wave make-nrxysin make-nrxycos make-square-wave make-src
- make-ncos make-nsin
- make-table-lookup make-triangle-wave make-two-pole make-two-zero make-wave-train make-ssb-am
- mus-channel mus-channels make-polyshape make-polywave
- mus-data mus-feedback mus-feedforward mus-frequency mus-hop
- mus-increment mus-length mus-file-name mus-location mus-name mus-order mus-phase mus-ramp mus-random mus-run
- mus-scaler mus-xcoeffs mus-ycoeffs notch one-pole one-zero make-moving-average seconds->samples samples->seconds
- oscil partials->polynomial partials->wave phase-partials->wave
- phase-vocoder pulse-train radians->degrees radians->hz rand rand-interp readin
- sawtooth-wave nrxysin nrxycos square-wave src
- ncos nsin table-lookup tap triangle-wave
- two-pole two-zero wave-train ssb-am))))
- (list (make-vector 1) color-95 (sqrt -1.0) (list 1.0)))
-
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n arg))
+ (lambda args (car args)))))
+ (if (not (member tag '(wrong-type-arg no-data no-such-method bad-type error arg-error) eq?))
+ (snd-display #__line__ ";clm ~A: tag: ~A arg: ~A" n tag arg))))
+ (list all-pass asymmetric-fm comb filtered-comb convolve db->linear moving-average moving-max moving-norm
+ degrees->radians delay env formant firmant granulate hz->radians linear->db even-weight odd-weight
+ make-all-pass make-asymmetric-fm make-comb make-filtered-comb make-convolve make-delay make-env
+ make-file->frample make-file->sample make-filter make-fir-filter make-formant make-firmant
+ make-granulate make-iir-filter make-locsig make-notch make-one-pole make-one-zero
+ make-oscil make-pulse-train make-rand make-rand-interp make-readin
+ make-sawtooth-wave make-nrxysin make-nrxycos make-rxyk!cos make-rxyk!sin make-square-wave make-src
+ make-ncos make-nsin
+ make-table-lookup make-triangle-wave make-two-pole make-two-zero make-wave-train make-ssb-am
+ mus-channel mus-channels make-polyshape make-polywave
+ mus-data mus-feedback mus-feedforward mus-frequency mus-hop
+ mus-increment mus-length mus-file-name mus-location mus-name mus-order mus-phase mus-ramp mus-random mus-run
+ mus-scaler mus-xcoeffs mus-ycoeffs notch one-pole one-pole-all-pass one-zero
+ make-moving-average make-moving-max make-moving-norm
+ seconds->samples samples->seconds
+ oscil partials->polynomial partials->wave phase-partials->wave
+ phase-vocoder pulse-train radians->degrees radians->hz rand rand-interp readin
+ sawtooth-wave nrxysin nrxycos rxyk!cos rxyk!sin square-wave src
+ ncos nsin table-lookup tap triangle-wave
+ two-pole two-zero wave-train ssb-am)))
+ (list (make-vector 1) color-95 (list 1.0)))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n (make-oscil) vct-5)
- )
- (lambda args (car args)))))
- (if (not (or (eq? tag 'wrong-type-arg)
- (eq? tag 'bad-arity)
- (eq? tag 'error)
- (eq? tag 'mus-error)))
+ (lambda ()
+ (n (make-oscil) float-vector-5)
+ )
+ (lambda args (car args)))))
+ (if (not (member tag '(wrong-type-arg bad-arity error mus-error) eq?))
(snd-display #__line__ ";clm-1 ~A: ~A" n tag))))
- (list all-pass array-interp asymmetric-fm comb filtered-comb contrast-enhancement convolution convolve moving-average
- convolve-files delay dot-product env-interp file->frame file->sample snd->sample filter fir-filter formant firmant
- formant-bank frame* frame+ frame->frame frame-ref frame->sample granulate iir-filter ina
+ (list all-pass array-interp asymmetric-fm comb filtered-comb contrast-enhancement convolution convolve moving-average moving-max moving-norm
+ convolve-files delay dot-product env-interp file->sample snd->sample filter fir-filter formant firmant
+ formant-bank granulate iir-filter ina
inb locsig-ref locsig-reverb-ref make-all-pass make-asymmetric-fm make-comb make-filtered-comb
- make-delay make-env make-fft-window make-filter make-fir-filter make-formant make-firmant make-frame make-granulate
- make-iir-filter make-locsig make-notch make-one-pole make-one-zero make-oscil make-phase-vocoder
- make-pulse-train make-rand make-rand-interp make-readin make-sawtooth-wave make-moving-average
- make-nrxysin make-nrxycos make-square-wave make-src make-ncos
+ make-delay make-env make-fft-window make-filter make-fir-filter make-formant make-firmant make-granulate
+ make-iir-filter make-locsig make-notch make-one-pole make-one-pole-all-pass make-one-zero make-oscil make-phase-vocoder
+ make-pulse-train make-rand make-rand-interp make-readin make-sawtooth-wave make-moving-average make-moving-max make-moving-norm
+ make-nrxysin make-nrxycos make-rxyk!cos make-rxyk!sin make-square-wave make-src make-ncos
make-nsin make-table-lookup make-triangle-wave
- make-two-pole make-two-zero make-wave-train mixer* mixer+ multiply-arrays
- notch one-pole one-zero oscil partials->polynomial partials->wave make-polyshape make-polywave
+ make-two-pole make-two-zero make-wave-train
+ notch one-pole one-pole-all-pass one-zero oscil partials->polynomial partials->wave make-polyshape make-polywave
phase-partials->wave phase-vocoder polynomial pulse-train rand rand-interp rectangular->polar rectangular->magnitudes
- ring-modulate sample->frame sawtooth-wave nrxysin nrxycos square-wave src ncos nsin
+ ring-modulate sawtooth-wave nrxysin nrxycos rxyk!cos rxyk!sin square-wave src ncos nsin
table-lookup tap triangle-wave two-pole two-zero wave-train ssb-am make-ssb-am))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (set! (n (make-oscil)) vector-0))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'syntax-error))
- (not (eq? tag 'error)))
+ (lambda ()
+ (set! (n (make-oscil)) vector-0))
+ (lambda args (car args)))))
+ (if (not (member tag '(wrong-type-arg syntax-error error) eq?))
(snd-display #__line__ ";mus-gen ~A: ~A" n tag))))
(list mus-channel mus-channels mus-data
mus-feedback mus-feedforward mus-frequency mus-hop mus-increment mus-length
- mus-location mus-mix mus-name mus-order mus-phase mus-ramp mus-random mus-run mus-scaler mus-xcoeffs
+ mus-location mus-file-mix mus-name mus-order mus-phase mus-ramp mus-random mus-run mus-scaler mus-xcoeffs
mus-ycoeffs))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n vct-5))
- (lambda args (car args)))))
+ (lambda ()
+ (n float-vector-5))
+ (lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
(snd-display #__line__ ";mus-sound ~A: ~A" n tag))))
- (list mus-sound-samples mus-sound-frames mus-sound-duration mus-sound-datum-size
- mus-sound-data-location mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-data-format
- mus-sound-length mus-sound-type-specifier mus-header-type-name mus-data-format-name mus-sound-comment
- mus-sound-write-date mus-bytes-per-sample mus-sound-loop-info mus-sound-mark-info mus-sound-maxamp
- mus-sound-maxamp-exists? mus-header-type->string mus-data-format->string))
-
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-number-of-args))
- (not (eq? tag 'error)))
- (snd-display #__line__ ";no arg mus-sound ~A: ~A" n tag))))
- (list mus-sound-samples mus-sound-frames mus-sound-duration mus-sound-datum-size
- mus-sound-data-location mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-data-format
- mus-sound-length mus-sound-type-specifier mus-header-type-name mus-data-format-name mus-sound-comment
+ (list mus-sound-samples mus-sound-framples mus-sound-duration mus-sound-datum-size
+ mus-sound-data-location mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-sample-type
+ mus-sound-length mus-sound-type-specifier mus-header-type-name mus-sample-type-name mus-sound-comment
mus-sound-write-date mus-bytes-per-sample mus-sound-loop-info mus-sound-mark-info mus-sound-maxamp
- mus-sound-maxamp-exists? mus-header-type->string mus-data-format->string))
+ mus-sound-maxamp-exists? mus-header-type->string mus-sample-type->string))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n "/bad/baddy"))
- (lambda args (car args)))))
+ (lambda ()
+ (n "/bad/baddy"))
+ (lambda args (car args)))))
(if (not (eq? tag 'mus-error))
(snd-display #__line__ ";bad file mus-sound ~A: ~A" n tag))))
- (list mus-sound-samples mus-sound-frames mus-sound-duration mus-sound-datum-size
- mus-sound-data-location mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-data-format
+ (list mus-sound-samples mus-sound-framples mus-sound-duration mus-sound-datum-size
+ mus-sound-data-location mus-sound-chans mus-sound-srate mus-sound-header-type mus-sound-sample-type
mus-sound-length mus-sound-type-specifier mus-sound-comment mus-sound-write-date mus-sound-maxamp
mus-sound-maxamp-exists?))
(mus-sound-forget "/bad/baddy") ; for possible second time around
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n vct-5))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'error))
- (not (eq? tag 'no-such-sound)))
- (snd-display #__line__ ";~D: chn (no snd) procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list channel-widgets count-matches cursor channel-properties channel-property
- cursor-position cursor-size cursor-style tracking-cursor-style delete-sample display-edits dot-size
- draw-dots draw-lines edit-fragment edit-position edit-tree edits fft-window-alpha fft-window-beta fft-log-frequency
- fft-log-magnitude fft-with-phases transform-size transform-graph-type fft-window transform-graph? find-channel
- graph graph-style lisp-graph? (lambda (a) (insert-region 0 a)) insert-sound
- time-graph-style lisp-graph-style transform-graph-style
- left-sample make-graph-data map-chan max-transform-peaks maxamp-position min-dB mix-region
- transform-normalization peaks ;play
- position->x position->y reverse-sound
- revert-sound right-sample sample save-sound save-sound-as scan-chan
- select-channel show-axes show-transform-peaks show-marks show-mix-waveforms show-y-zero show-grid show-sonogram-cursor
- spectrum-end spectro-hop spectrum-start spectro-x-angle spectro-x-scale spectro-y-angle grid-density
- spectro-y-scale spectro-z-angle spectro-z-scale squelch-update transform-sample
- transform->vct transform-frames transform-type update-transform-graph update-time-graph
- update-lisp-graph update-sound wavelet-type time-graph? time-graph-type wavo-hop wavo-trace x-bounds
- x-position-slider x-zoom-slider x-axis-label y-axis-label y-bounds y-position-slider y-zoom-slider zero-pad))
- )
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n float-vector-5))
+ (lambda args (car args)))))
+ (if (not (member tag '(wrong-type-arg error no-such-sound) eq?))
+ (snd-display #__line__ "; chn (no snd) procs ~A: ~A" n tag))))
+ (list channel-widgets cursor channel-properties channel-property
+ cursor-position cursor-size cursor-style tracking-cursor-style delete-sample display-edits dot-size
+ draw-dots draw-lines edit-fragment edit-position edit-tree edits fft-window-alpha fft-window-beta fft-log-frequency
+ fft-log-magnitude fft-with-phases transform-size transform-graph-type fft-window transform-graph?
+ graph graph-style lisp-graph? (lambda (a) (insert-region 0 a)) insert-sound
+ time-graph-style lisp-graph-style transform-graph-style
+ left-sample make-graph-data max-transform-peaks maxamp-position min-dB mix-region
+ transform-normalization peaks ;play
+ position->x position->y reverse-sound
+ revert-sound right-sample sample save-sound save-sound-as
+ select-channel show-axes show-transform-peaks show-marks show-mix-waveforms show-y-zero show-grid show-sonogram-cursor
+ spectrum-end spectro-hop spectrum-start spectro-x-angle spectro-x-scale spectro-y-angle grid-density
+ spectro-y-scale spectro-z-angle spectro-z-scale squelch-update transform-sample
+ transform->float-vector transform-framples transform-type update-transform-graph update-time-graph
+ update-lisp-graph update-sound wavelet-type time-graph? time-graph-type wavo-hop wavo-trace x-bounds
+ x-position-slider x-zoom-slider x-axis-label y-axis-label y-bounds y-position-slider y-zoom-slider zero-pad))
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n 0 vct-5))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";~D: chn (no chn) procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list channel-widgets count-matches cursor channel-properties channel-property combined-data-color
- cursor-position cursor-size cursor-style tracking-cursor-style delete-sample display-edits dot-size draw-dots draw-lines
- edit-fragment edit-position edit-tree edits fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases
- transform-size transform-graph-type fft-window transform-graph? find-channel
- graph graph-style lisp-graph? insert-region insert-sound left-sample
- time-graph-style lisp-graph-style transform-graph-style
- make-graph-data map-chan max-transform-peaks maxamp maxamp-position min-dB mix-region transform-normalization
- peaks play position->x position->y reverse-sound right-sample sample
- save-sound-as scan-chan show-axes show-transform-peaks show-marks
- show-mix-waveforms show-y-zero show-grid show-sonogram-cursor
- spectrum-end spectro-hop spectrum-start spectro-x-angle
- spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle spectro-z-scale squelch-update grid-density
- transform-sample transform->vct transform-frames transform-type
- update-transform-graph update-time-graph update-lisp-graph wavelet-type time-graph? time-graph-type
- wavo-hop wavo-trace x-bounds x-position-slider x-zoom-slider x-axis-label y-axis-label y-bounds y-position-slider
- y-zoom-slider zero-pad)))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n 0 float-vector-5))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ "; chn (no chn) procs ~A: ~A" n tag))))
+ (list channel-widgets cursor channel-properties channel-property combined-data-color
+ cursor-position cursor-size cursor-style tracking-cursor-style delete-sample display-edits dot-size draw-dots draw-lines
+ edit-fragment edit-position edit-tree edits fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases
+ transform-size transform-graph-type fft-window transform-graph?
+ graph graph-style lisp-graph? insert-region insert-sound left-sample
+ time-graph-style lisp-graph-style transform-graph-style
+ make-graph-data max-transform-peaks maxamp maxamp-position min-dB mix-region transform-normalization
+ peaks play position->x position->y reverse-sound right-sample sample
+ save-sound-as show-axes show-transform-peaks show-marks
+ show-mix-waveforms show-y-zero show-grid show-sonogram-cursor
+ spectrum-end spectro-hop spectrum-start spectro-x-angle
+ spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle spectro-z-scale squelch-update grid-density
+ transform-sample transform->float-vector transform-framples transform-type
+ update-transform-graph update-time-graph update-lisp-graph wavelet-type time-graph? time-graph-type
+ wavo-hop wavo-trace x-bounds x-position-slider x-zoom-slider x-axis-label y-axis-label y-bounds y-position-slider
+ y-zoom-slider zero-pad))
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n (integer->sound 1234)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sound))
- (snd-display #__line__ ";~D: chn procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list channel-widgets cursor channel-properties
- cursor-position cursor-size cursor-style tracking-cursor-style
- (lambda (snd) (delete-sample 0 snd)) display-edits dot-size
- (lambda (snd) (edit-fragment 0 snd))
- edit-position edit-tree edits env-sound fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases
- transform-size transform-graph-type fft-window transform-graph? filter-sound
- graph-data graph-style lisp-graph? left-sample
- time-graph-style lisp-graph-style transform-graph-style
- make-graph-data max-transform-peaks maxamp maxamp-position min-dB transform-normalization
- (lambda (snd) (position->x 0 snd))
- (lambda (snd) (position->y 0 snd))
- (lambda (snd) (redo 1 snd)) reverse-sound revert-sound right-sample
- (lambda (snd) (sample 0 snd))
- save-sound scale-by scale-to show-axes show-transform-peaks
- show-marks show-mix-waveforms show-y-zero show-grid show-sonogram-cursor
- spectrum-end spectro-hop spectrum-start spectro-x-angle
- spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle spectro-z-scale squelch-update grid-density
- src-sound
- (lambda (snd) (transform-sample 0 0 snd)) transform->vct
- transform-frames transform-type
- (lambda (snd) (undo 1 snd)) update-transform-graph update-time-graph update-lisp-graph
- update-sound wavelet-type time-graph? time-graph-type wavo-hop wavo-trace x-bounds x-position-slider
- (lambda (snd) (normalize-channel 0.5 0 #f snd))
- (lambda (snd) (x->position 0 snd))
- x-zoom-slider y-bounds y-position-slider x-axis-label y-axis-label
- (lambda (snd) (y->position 0 snd)) y-zoom-slider
- zero-pad
- (lambda (snd) (scale-channel 2.0 0 #f snd))
- )))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n (integer->sound 1234)))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-sound))
+ (snd-display #__line__ "; chn procs ~A: ~A" n tag))))
+ (list channel-widgets cursor channel-properties
+ cursor-position cursor-size cursor-style tracking-cursor-style
+ (lambda (snd) (delete-sample 0 snd)) display-edits dot-size
+ (lambda (snd) (edit-fragment 0 snd))
+ edit-position edit-tree edits env-sound fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases
+ transform-size transform-graph-type fft-window transform-graph? filter-sound
+ graph-data graph-style lisp-graph? left-sample
+ time-graph-style lisp-graph-style transform-graph-style
+ make-graph-data max-transform-peaks maxamp maxamp-position min-dB transform-normalization
+ (lambda (snd) (position->x 0 snd))
+ (lambda (snd) (position->y 0 snd))
+ (lambda (snd) (redo 1 snd)) reverse-sound revert-sound right-sample
+ (lambda (snd) (sample 0 snd))
+ save-sound scale-by scale-to show-axes show-transform-peaks
+ show-marks show-mix-waveforms show-y-zero show-grid show-sonogram-cursor
+ spectrum-end spectro-hop spectrum-start spectro-x-angle
+ spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle spectro-z-scale squelch-update grid-density
+ src-sound
+ (lambda (snd) (transform-sample 0 0 snd)) transform->float-vector
+ transform-framples transform-type
+ (lambda (snd) (undo 1 snd)) update-transform-graph update-time-graph update-lisp-graph
+ update-sound wavelet-type time-graph? time-graph-type wavo-hop wavo-trace x-bounds x-position-slider
+ (lambda (snd) (normalize-channel 0.5 0 #f snd))
+ (lambda (snd) (x->position 0 snd))
+ x-zoom-slider y-bounds y-position-slider x-axis-label y-axis-label
+ (lambda (snd) (y->position 0 snd)) y-zoom-slider
+ zero-pad
+ (lambda (snd) (scale-channel 2.0 0 #f snd))
+ ))
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n 0 1234))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sound))
- (snd-display #__line__ ";~D: snd(1) chn procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list delete-sample edit-fragment graph-data graph-style play position->x position->y redo
- time-graph-style lisp-graph-style transform-graph-style
- scale-by scale-to undo x->position y->position x-axis-label)))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n 0 1234))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-sound))
+ (snd-display #__line__ "; snd(1) chn procs ~A: ~A" n tag))))
+ (list delete-sample edit-fragment graph-data graph-style play position->x position->y redo
+ time-graph-style lisp-graph-style transform-graph-style
+ scale-by scale-to undo x->position y->position x-axis-label))
- (let ((ctr 0)
- (index (open-sound "oboe.snd")))
+ (let ((index (open-sound "oboe.snd")))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n 0 index 1234))
- (lambda args (car args)))))
+ (lambda ()
+ (n 0 index 1234))
+ (lambda args (car args)))))
(if (not (eq? tag 'no-such-channel))
- (snd-display #__line__ ";~D: snd(1 1234) chn procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
+ (snd-display #__line__ "; snd(1 1234) chn procs ~A: ~A" n tag))))
(list delete-sample edit-fragment graph-data position->x position->y redo scale-by
scale-to undo x->position y->position))
(close-sound index))
+ (if (sound? (find-sound "oboe.snd"))
+ (snd-display #__line__ ";oboe.snd is still open?"))
- (let ((ctr 0)
- (index (open-sound "oboe.snd")))
+ (let ((index (open-sound "oboe.snd")))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (n index 1234))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'no-such-channel))
- (not (eq? tag 'no-such-sound)))
- (snd-display #__line__ ";~D: chn procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
+ (lambda ()
+ (n index 1234))
+ (lambda args (car args)))))
+ (if (not (member tag '(no-such-channel no-such-sound) eq?))
+ (snd-display #__line__ "; chn procs ~A: ~A" n tag))))
(list channel-widgets cursor cursor-position cursor-size cursor-style tracking-cursor-style display-edits
dot-size edit-position edit-tree edits fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases
transform-size transform-graph-type fft-window transform-graph? graph-style lisp-graph? left-sample
@@ -62206,25 +48247,23 @@ EDITS: 1
reverse-sound right-sample show-axes show-transform-peaks show-marks
show-mix-waveforms show-y-zero show-grid show-sonogram-cursor grid-density
spectrum-end spectro-hop spectrum-start spectro-x-angle spectro-x-scale spectro-y-angle
- spectro-y-scale spectro-z-angle spectro-z-scale squelch-update transform->vct
- transform-frames transform-type update-transform-graph update-time-graph update-lisp-graph
+ spectro-y-scale spectro-z-angle spectro-z-scale squelch-update transform->float-vector
+ transform-framples transform-type update-transform-graph update-time-graph update-lisp-graph
wavelet-type time-graph? time-graph-type wavo-hop wavo-trace x-bounds x-position-slider x-axis-label
x-zoom-slider y-bounds y-position-slider y-zoom-slider zero-pad channel-properties channel-property ))
(close-sound index))
+ (if (sound? (find-sound "oboe.snd"))
+ (snd-display #__line__ ";oboe.snd is still open?"))
- (let ((ctr 0)
- (index (open-sound "oboe.snd")))
+ (let ((index (open-sound "oboe.snd")))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (set! (n index 0) vct-5))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'syntax-error))
- (not (eq? tag 'error)))
- (snd-display #__line__ ";~D: set chn procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
+ (lambda ()
+ (set! (n index 0) float-vector-5))
+ (lambda args (car args)))))
+ (if (not (member tag '(wrong-type-arg syntax-error error) eq?))
+ (snd-display #__line__ "; set chn procs ~A: ~A" n tag))))
(list channel-widgets cursor cursor-position display-edits dot-size edit-tree edits
fft-window-alpha fft-window-beta fft-log-frequency fft-log-magnitude fft-with-phases transform-size transform-graph-type fft-window
transform-graph? graph-style lisp-graph? left-sample make-graph-data max-transform-peaks maxamp maxamp-position
@@ -62232,277 +48271,180 @@ EDITS: 1
min-dB transform-normalization reverse-sound right-sample show-axes grid-density
show-transform-peaks show-marks show-mix-waveforms show-y-zero show-grid show-sonogram-cursor spectrum-end spectro-hop
spectrum-start spectro-x-angle spectro-x-scale spectro-y-angle spectro-y-scale spectro-z-angle
- spectro-z-scale squelch-update transform->vct transform-frames transform-type
+ spectro-z-scale squelch-update transform->float-vector transform-framples transform-type
update-transform-graph update-time-graph update-lisp-graph wavelet-type time-graph? time-graph-type
wavo-hop wavo-trace x-bounds x-position-slider x-zoom-slider y-bounds y-position-slider
y-zoom-slider zero-pad x-axis-label
))
(close-sound index))
+ (if (sound? (find-sound "oboe.snd"))
+ (snd-display #__line__ ";oboe.snd is still open?"))
- (let ((ctr 0))
- (for-each (lambda (n b)
- (let ((tag
- (catch #t
- (lambda ()
- (n vct-5))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'syntax-error))
- (not (eq? tag 'error)))
- (snd-display #__line__ ";[0] ~D: mix procs ~A: ~A (~A)" ctr b tag vct-5))
- (set! ctr (+ ctr 1))))
- (list mix-amp mix-amp-env mix-length mix-name mix-position mix-home mix-speed mix-tag-y)
- (list 'mix-amp 'mix-amp-env 'mix-length 'mix-name 'mix-position 'mix-home 'mix-speed 'mix-tag-y)))
+ (for-each (lambda (n b)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n float-vector-5))
+ (lambda args (car args)))))
+ (if (not (member tag '(error wrong-type-arg syntax-error) eq?))
+ (snd-display #__line__ ";[0]: mix procs ~A: ~A (~A)" b tag float-vector-5))))
+ (list mix-amp mix-amp-env mix-length mix-name mix-position mix-home mix-speed mix-tag-y)
+ (list 'mix-amp 'mix-amp-env 'mix-length 'mix-name 'mix-position 'mix-home 'mix-speed 'mix-tag-y))
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n (integer->mix 1234)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-mix))
- (snd-display #__line__ ";[1] ~D: mix procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list mix-amp mix-length mix-name mix-position mix-home mix-speed mix-tag-y)))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n (integer->mix 1234)))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-mix))
+ (snd-display #__line__ ";[1]: mix procs ~A: ~A" n tag))))
+ (list mix-amp mix-length mix-name mix-position mix-home mix-speed mix-tag-y))
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (set! (n (integer->mix 1234)) vct-5))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'syntax-error))
- (not (eq? tag 'error))
- (not (eq? tag 'no-such-mix))) ; if id checked first
- (snd-display #__line__ ";[2] ~D: mix procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list mix-name mix-position mix-home mix-speed mix-tag-y)))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (set! (n (integer->mix 1234)) float-vector-5))
+ (lambda args (car args)))))
+ (if (not (member tag '(error wrong-type-arg syntax-error no-such-mix) eq?))
+ (snd-display #__line__ ";[2]: mix procs ~A: ~A" n tag))))
+ (list mix-name mix-position mix-home mix-speed mix-tag-y))
- (let* ((ctr 0)
- (index (open-sound "oboe.snd"))
- (id (mix-sound "oboe.snd" 10)))
+ (let ((index (open-sound "oboe.snd"))
+ (id (mix-sound "oboe.snd" 10)))
(for-each (lambda (n b)
(let ((tag
(catch #t
- (lambda ()
- (set! (n id) vct-5))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'syntax-error))
- (not (eq? tag 'error)))
- (snd-display #__line__ ";[3] ~D: mix procs ~A: ~A (~A)" ctr b tag vct-5))
- (set! ctr (+ ctr 1))))
+ (lambda ()
+ (set! (n id) float-vector-5))
+ (lambda args (car args)))))
+ (if (not (member tag '(error wrong-type-arg syntax-error) eq?))
+ (snd-display #__line__ ";[3]: mix procs ~A: ~A (~A)" b tag float-vector-5))))
(list mix-name mix-position mix-home mix-speed mix-tag-y)
(list 'mix-name 'mix-position 'mix-home 'mix-speed 'mix-tag-y))
(close-sound index))
+ (if (sound? (find-sound "oboe.snd"))
+ (snd-display #__line__ ";oboe.snd is still open?"))
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n vct-5))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";~D: mark procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list add-mark mark-name mark-sample mark-sync mark-home delete-mark delete-marks find-mark)))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n float-vector-5))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'wrong-type-arg))
+ (snd-display #__line__ "; mark procs ~A: ~A" n tag))))
+ (list add-mark mark-name mark-sample mark-sync mark-home delete-mark delete-marks find-mark))
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n (integer->mark 1234)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-mark))
- (snd-display #__line__ ";~D: no mark procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list mark-name mark-sample mark-sync mark-home delete-mark)))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n (integer->mark 1234)))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-mark))
+ (snd-display #__line__ "; no mark procs ~A: ~A" n tag))))
+ (list mark-name mark-sample mark-sync mark-home delete-mark))
- (let* ((ctr 0)
- (index (open-sound "oboe.snd"))
+ (let* ((index (open-sound "oboe.snd"))
(id (add-mark 0 index 0)))
(for-each (lambda (n)
(let ((tag
(catch #t
- (lambda ()
- (set! (n id) vct-5))
- (lambda args (car args)))))
+ (lambda ()
+ (set! (n id) float-vector-5))
+ (lambda args (car args)))))
(if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";~D: set mark procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
+ (snd-display #__line__ "; set mark procs ~A: ~A" n tag))))
(list mark-name mark-sample mark-sync))
- (close-sound index)
- )
+ (close-sound index))
+ (if (sound? (find-sound "oboe.snd"))
+ (snd-display #__line__ ";oboe.snd is still open?"))
(for-each (lambda (arg)
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n arg))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'wrong-number-of-args)))
- (snd-display #__line__ ";~D: region procs ~A: ~A ~A" ctr n tag arg))
- (set! ctr (+ ctr 1))))
- (list region-chans region-home region-frames
- region-position region-maxamp region-maxamp-position region-sample
- region->vct region-srate forget-region))))
- (list vct-5 '#(0 1) (sqrt -1.0) "hiho" (list 0 1)))
-
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (n (integer->region 1234)))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-region))
- (snd-display #__line__ ";~D: (no) region procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list region-chans region-home region-frames region-position
- region-maxamp region-maxamp-position region-srate forget-region)))
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n arg))
+ (lambda args (car args)))))
+ (if (not (member tag '(wrong-type-arg wrong-number-of-args) eq?))
+ (snd-display #__line__ "; region procs ~A: ~A ~A" n tag arg))))
+ (list region-chans region-home region-framples
+ region-position region-maxamp region-maxamp-position region-sample
+ region->float-vector region-srate forget-region)))
+ (list float-vector-5 #(0 1) 0+i "hiho" (list 0 1)))
- (let ((ctr 0))
- (for-each (lambda (n)
- (let ((tag
- (catch #t
- (lambda ()
- (set! (n) vct-5))
- (lambda args (car args)))))
- (if (and (not (eq? tag 'wrong-type-arg))
- (not (eq? tag 'syntax-error))
- (not (eq? tag 'error)))
- (snd-display #__line__ ";~D: misc procs ~A: ~A" ctr n tag))
- (set! ctr (+ ctr 1))))
- (list axis-color enved-filter-order enved-filter filter-control-waveform-color ask-before-overwrite ask-about-unsaved-edits
- auto-resize auto-update axis-label-font axis-numbers-font basic-color bind-key show-full-duration initial-beg initial-dur
- channel-style color-cutoff color-orientation-dialog color-inverted color-scale
- cursor-color dac-combines-channels dac-size clipping data-color default-output-chans
- default-output-data-format default-output-srate default-output-header-type enved-envelope enved-base
- enved-clip? enved-in-dB enved-dialog enved-style enved-power enved-target
- enved-waveform-color enved-wave? eps-file eps-left-margin eps-bottom-margin eps-size
- foreground-color graph-color graph-cursor highlight-color just-sounds key-binding
- listener-color listener-font listener-prompt listener-text-color max-regions
- minibuffer-history-length mix-waveform-height region-graph-style position-color
- time-graph-style lisp-graph-style transform-graph-style peaks-font bold-peaks-font
- view-files-sort print-length play-arrow-size sash-color ladspa-dir peak-env-dir save-dir save-state-file
- selected-channel selected-data-color selected-graph-color
- selected-sound selection-creates-region show-controls show-indices show-listener
- show-selection-transform sinc-width temp-dir text-focus-color tiny-font
- trap-segfault with-file-monitor optimization unbind-key with-verbose-cursor
- with-inset-graph with-pointer-focus window-height beats-per-measure with-smpte-label
- with-toolbar with-tooltips with-menu-icons remember-sound-state save-as-dialog-src save-as-dialog-auto-comment
- window-width window-x window-y with-gl with-mix-tags x-axis-style beats-per-minute zoom-color mix-tag-height
- mix-tag-width with-relative-panes clm-table-size clm-default-frequency mark-tag-width mark-tag-height
- ))
- )
+ (for-each (lambda (n)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (n (integer->region 1234)))
+ (lambda args (car args)))))
+ (if (not (eq? tag 'no-such-region))
+ (snd-display #__line__ "; (no) region procs ~A: ~A" n tag))))
+ (list region-chans region-home region-framples region-position
+ region-maxamp region-maxamp-position region-srate forget-region))
(for-each (lambda (n)
- (let* ((hook (car n))
- (hook-name (cadr n))
- (tag
- (catch #t
- (lambda () (hook-push hook (lambda () (+ 1 2))))
- (lambda args (car args)))))
- (if (not (eq? tag 'wrong-type-arg))
- (snd-display #__line__ ";hooks ~A: ~A" hook-name tag))))
- (list (list after-graph-hook 'after-graph-hook)
- (list after-lisp-graph-hook 'after-lisp-graph-hook)
- (list lisp-graph-hook 'lisp-graph-hook)
- (list before-transform-hook 'before-transform-hook)
- (list mix-release-hook 'mix-release-hook)
- (list save-hook 'save-hook)
- (list before-save-as-hook 'before-save-as-hook)
- (list after-save-as-hook 'after-save-as-hook)
- (list save-state-hook 'save-state-hook)
- (list new-sound-hook 'new-sound-hook)
- (list mus-error-hook 'mus-error-hook)
- (list mouse-enter-graph-hook 'mouse-enter-graph-hook)
- (list mouse-leave-graph-hook 'mouse-leave-graph-hook)
- (list open-raw-sound-hook 'open-raw-sound-hook)
- (list select-channel-hook 'select-channel-hook)
- (list output-name-hook 'output-name-hook)
- (list peak-env-hook 'peak-env-hook)
- (list after-open-hook 'after-open-hook)
- (list close-hook 'close-hook)
- (list draw-mark-hook 'draw-mark-hook)
- (list draw-mix-hook 'draw-mix-hook)
- (list mark-click-hook 'mark-click-hook)
- (list listener-click-hook 'listener-click-hook)
- (list mix-click-hook 'mix-click-hook)
- (list after-save-state-hook 'after-save-state-hook)
- (list before-save-state-hook 'before-save-state-hook)
- (list mark-hook 'mark-hook)
- (list mark-drag-hook 'mark-drag-hook)
- (list mix-drag-hook 'mix-drag-hook)
- (list name-click-hook 'name-click-hook)
- (list after-apply-controls-hook 'after-apply-controls-hook)
- (list open-hook 'open-hook)
- (list output-comment-hook 'output-comment-hook)
- (list help-hook 'help-hook)
- (list play-hook 'play-hook)
- (list dac-hook 'dac-hook)
- (list new-widget-hook 'new-widget-hook)
- (list read-hook 'read-hook)
- (list bad-header-hook 'bad-header-hook)
- (list snd-error-hook 'snd-error-hook)
- (list snd-warning-hook 'snd-warning-hook)
- (list start-hook 'start-hook)
- (list start-playing-hook 'start-playing-hook)
- (list stop-playing-hook 'stop-playing-hook)
- (list mouse-enter-listener-hook 'mouse-enter-listener-hook)
- (list mouse-leave-listener-hook 'mouse-leave-listener-hook)
- (list select-sound-hook 'select-sound-hook)
- (list view-files-select-hook 'view-files-select-hook)
- (list during-open-hook 'during-open-hook)
- (list after-transform-hook 'after-transform-hook)
- (list mouse-enter-label-hook 'mouse-enter-label-hook)
- (list mouse-leave-label-hook 'mouse-leave-label-hook)
- (list initial-graph-hook 'initial-graph-hook)
- (list graph-hook 'graph-hook)
- (list key-press-hook 'key-press-hook)
- (list mouse-drag-hook 'mouse-drag-hook)
- (list mouse-press-hook 'mouse-press-hook)
- (list mouse-click-hook 'mouse-click-hook)
- (list enved-hook 'enved-hook)))
-
- (set! (ask-about-unsaved-edits) #f)
- (set! (remember-sound-state) #f)
+ (let ((tag
+ (catch #t
+ (lambda ()
+ (set! (n) float-vector-5))
+ (lambda args (car args)))))
+ (if (not (member tag '(error wrong-type-arg syntax-error) eq?))
+ (snd-display #__line__ "; misc procs ~A: ~A" n tag))))
+ (list axis-color enved-filter-order enved-filter filter-control-waveform-color ask-before-overwrite ask-about-unsaved-edits
+ auto-resize auto-update axis-label-font axis-numbers-font basic-color bind-key show-full-duration show-full-range initial-beg initial-dur
+ channel-style color-cutoff color-orientation-dialog color-inverted color-scale
+ cursor-color dac-combines-channels dac-size clipping data-color default-output-chans
+ default-output-sample-type default-output-srate default-output-header-type enved-envelope enved-base
+ enved-clip? enved-in-dB enved-dialog enved-style enved-power enved-target
+ enved-waveform-color enved-wave? eps-file eps-left-margin eps-bottom-margin eps-size
+ foreground-color graph-color graph-cursor highlight-color just-sounds key-binding
+ listener-color listener-font listener-prompt listener-text-color max-regions
+ mix-waveform-height region-graph-style position-color
+ time-graph-style lisp-graph-style transform-graph-style peaks-font bold-peaks-font
+ print-length play-arrow-size sash-color ladspa-dir peak-env-dir save-dir save-state-file
+ selected-channel selected-data-color selected-graph-color
+ selected-sound selection-creates-region show-controls show-indices show-listener
+ show-selection-transform sinc-width temp-dir text-focus-color tiny-font
+ with-file-monitor unbind-key with-verbose-cursor
+ with-inset-graph with-interrupts with-pointer-focus window-height beats-per-measure with-smpte-label
+ with-toolbar with-tooltips with-menu-icons remember-sound-state save-as-dialog-src save-as-dialog-auto-comment
+ window-width window-x window-y with-gl with-mix-tags x-axis-style beats-per-minute zoom-color mix-tag-height
+ mix-tag-width with-relative-panes clm-table-size clm-default-frequency mark-tag-width mark-tag-height
+ ))
+
+
+ (set! *ask-about-unsaved-edits* #f)
+ (set! *remember-sound-state* #f)
(if (= test-28 0)
(begin
(check-error-tag 'no-such-envelope (lambda () (set! (enved-envelope) "not-an-env")))
+ (check-error-tag 'wrong-type-arg (lambda () (envelope-interp 1.0 '(0 0 .5))))
(check-error-tag 'cannot-save (lambda () (save-envelopes "/bad/baddy")))
- (check-error-tag 'cannot-save (lambda () (save-macros "/bad/baddy")))
(check-error-tag 'cannot-save (lambda () (mus-sound-report-cache "/bad/baddy")))
(check-error-tag 'bad-arity (lambda () (set! (search-procedure) (lambda (a b c) a))))
- (check-error-tag 'no-such-sound (lambda () (set! (search-procedure 1234) (lambda (a) a))))
(check-error-tag 'no-such-channel (lambda () (make-sampler 0 "oboe.snd" 1)))
(check-error-tag 'no-such-channel (lambda () (make-sampler 0 "oboe.snd" -1)))
(check-error-tag 'bad-arity (lambda () (bind-key (char->integer #\p) 0 (lambda (a b) (play-often (max 1 a))))))
- (check-error-tag 'bad-arity (lambda () (set! (zoom-focus-style) (lambda (a) 0))))
- (check-error-tag 'wrong-type-arg (lambda () (mus-mix "oboe.snd" "pistol.snd" 0 12 0 (make-mixer 1 1.0) "a string")))
- (check-error-tag 'bad-header (lambda () (mus-mix "oboe.snd" (string-append sf-dir "bad_chans.aifc"))))
- (check-error-tag 'mus-error (lambda () (mus-mix "oboe.snd" (string-append sf-dir "bad_length.aifc"))))
- (check-error-tag 'bad-header (lambda () (mus-mix (string-append sf-dir "bad_chans.aifc") "oboe.snd")))
+ (check-error-tag 'bad-arity (lambda () (set! *zoom-focus-style* (lambda (a) 0))))
+ (check-error-tag 'bad-header (lambda () (mus-file-mix "oboe.snd" (string-append sf-dir "bad_chans.aifc"))))
+ (check-error-tag 'mus-error (lambda () (mus-file-mix "oboe.snd" (string-append sf-dir "bad_length.aifc"))))
+ (check-error-tag 'bad-header (lambda () (mus-file-mix (string-append sf-dir "bad_chans.aifc") "oboe.snd")))
(check-error-tag 'no-such-sound (lambda () (set! (sound-loop-info 123) '(0 0 1 1))))
- (check-error-tag 'bad-header (lambda () (new-sound "fmv.snd" mus-nist mus-bfloat 22050 2 "this is a comment")))
+ (check-error-tag 'bad-header (lambda () (new-sound "fmv.snd" 2 22050 mus-bfloat mus-nist "this is a comment")))
(check-error-tag 'wrong-type-arg (lambda () (player-home 123)))
- (check-error-tag 'no-such-file (lambda () (set! (temp-dir) "/hiho")))
- (check-error-tag 'no-such-file (lambda () (set! (save-dir) "/hiho")))
- (check-error-tag 'out-of-range (lambda () (snd-transform (integer->transform 20) (make-vct 4))))
+ (check-error-tag 'no-such-file (lambda () (set! *temp-dir* "/hiho")))
+ (check-error-tag 'no-such-file (lambda () (set! *save-dir* "/hiho")))
+ (check-error-tag 'out-of-range (lambda () (snd-transform (integer->transform 20) (make-float-vector 4))))
(check-error-tag 'bad-header (lambda () (mus-sound-maxamp (string-append sf-dir "bad_chans.snd"))))
- (check-error-tag 'bad-header (lambda () (set! (mus-sound-maxamp (string-append sf-dir "bad_chans.snd")) '(0.0 0.0))))
- (check-error-tag 'mus-error (lambda () (make-iir-filter :order 32 :ycoeffs (make-vct 4))))
- (check-error-tag 'mus-error (lambda () (make-iir-filter :coeffs (make-vct 4) :ycoeffs (make-vct 4))))
- (check-error-tag 'mus-error (lambda () (make-fir-filter :coeffs (make-vct 4) :xcoeffs (make-vct 4))))
+ (check-error-tag 'mus-error (lambda () (make-iir-filter :order 32 :ycoeffs (make-float-vector 4))))
+ (check-error-tag 'mus-error (lambda () (make-iir-filter :coeffs (make-float-vector 4) :ycoeffs (make-float-vector 4))))
+ (check-error-tag 'mus-error (lambda () (make-fir-filter :coeffs (make-float-vector 4) :xcoeffs (make-float-vector 4))))
(check-error-tag 'out-of-range (lambda () (make-table-lookup :size 123456789)))
; (check-error-tag 'out-of-range (lambda () (make-src :srate -0.5)))
(check-error-tag 'out-of-range (lambda () (make-granulate :ramp -0.5)))
@@ -62515,12 +48457,13 @@ EDITS: 1
(check-error-tag 'out-of-range (lambda () (make-readin "oboe.snd" :size -1)))
(check-error-tag 'out-of-range (lambda () (make-file->sample "oboe.snd" 0)))
(check-error-tag 'out-of-range (lambda () (make-file->sample "oboe.snd" -1)))
- (check-error-tag 'out-of-range (lambda () (make-file->frame "oboe.snd" 0)))
- (check-error-tag 'out-of-range (lambda () (make-file->frame "oboe.snd" -1)))
- (check-error-tag 'out-of-range (lambda () (set! (default-output-data-format) -1)))
- (check-error-tag 'out-of-range (lambda () (set! (default-output-header-type) mus-soundfont)))
+ (check-error-tag 'out-of-range (lambda () (make-file->frample "oboe.snd" 0)))
+ (check-error-tag 'out-of-range (lambda () (make-file->frample "oboe.snd" -1)))
+ (check-error-tag 'out-of-range (lambda () (set! *default-output-sample-type* -1)))
+ (check-error-tag 'out-of-range (lambda () (set! *default-output-header-type* mus-soundfont)))
(check-error-tag 'mus-error (lambda () (mus-sound-chans (string-append sf-dir "bad_location.nist"))))
(check-error-tag 'mus-error (lambda () (mus-sound-chans (string-append sf-dir "bad_field.nist"))))
+ (check-error-tag 'mus-error (lambda () (make-locsig 1/0 :channels 2)))
(if (provided? 'snd-motif)
(begin
(check-error-tag 'no-such-widget (lambda () (widget-position (list 'Widget 0)))) ; dubious -- not sure these should be supported
@@ -62532,51 +48475,38 @@ EDITS: 1
))
(check-error-tag 'no-such-menu (lambda () (main-menu -1)))
(check-error-tag 'no-such-menu (lambda () (main-menu 111)))
- (check-error-tag 'out-of-range (lambda () (new-sound "hiho" 123)))
- (check-error-tag 'out-of-range (lambda () (new-sound "hiho" mus-nist 123)))
- (check-error-tag 'bad-header (lambda () (new-sound "hiho" mus-nist mus-bfloat)))
- (check-error-tag 'out-of-range (lambda () (make-sound-data 0 1)))
- (check-error-tag 'out-of-range (lambda () (make-sound-data -2 1)))
- (check-error-tag 'out-of-range (lambda () (make-sound-data 1 -1)))
- (check-error-tag 'out-of-range (lambda () (make-sound-data 1 0)))
- (check-error-tag 'out-of-range (lambda () (mus-sound-close-output 0 1)))
- (check-error-tag 'out-of-range (lambda () (mus-sound-close-output 1 1)))
- (check-error-tag 'out-of-range (lambda () (mus-sound-close-output 2 1)))
- (check-error-tag 'out-of-range (lambda () (mus-sound-close-input 0)))
- (check-error-tag 'out-of-range (lambda () (mus-sound-close-input 1)))
- (check-error-tag 'out-of-range (lambda () (mus-sound-close-input 2)))
- (check-error-tag 'out-of-range (lambda () (set! (mus-array-print-length) -1)))
- (check-error-tag 'out-of-range (lambda () (set! (print-length) -1)))
- (check-error-tag 'out-of-range (lambda () (set! (play-arrow-size) -1)))
- ; (check-error-tag 'wrong-type-arg (lambda () (vector->vct (make-vector 3 "hio"))))
- (check-error-tag 'out-of-range (lambda () (set! (enved-style) 12)))
+ (check-error-tag 'out-of-range (lambda () (new-sound "hiho" :header-type 123)))
+ (check-error-tag 'out-of-range (lambda () (new-sound "hiho" :header-type mus-nist :sample-type 123)))
+ (check-error-tag 'bad-header (lambda () (new-sound "hiho" :header-type mus-nist :sample-type mus-bfloat)))
+ (check-error-tag 'out-of-range (lambda () (set! *mus-array-print-length* -1)))
+ (check-error-tag 'out-of-range (lambda () (set! *print-length* -1)))
+ (check-error-tag 'out-of-range (lambda () (set! *play-arrow-size* -1)))
+ (check-error-tag 'out-of-range (lambda () (set! *enved-style* 12)))
(check-error-tag 'out-of-range (lambda () (make-color 1.5 0.0 0.0)))
(check-error-tag 'out-of-range (lambda () (make-color -0.5 0.0 0.0)))
(check-error-tag 'wrong-type-arg (lambda () (make-variable-graph #f)))
- (check-error-tag 'cannot-print (lambda () (graph->ps)))
+ (check-error-tag 'cannot-print graph->ps)
(let ((ind (open-sound "oboe.snd")))
- (set! (selection-creates-region) #t)
+ (set! *selection-creates-region* #t)
(select-all)
(check-error-tag 'mus-error (lambda () (save-selection "sel0.snd" :not-a-key 3)))
(check-error-tag 'wrong-type-arg (lambda () (read-only (list ind))))
- (check-error-tag 'wrong-type-arg (lambda () (frames ind (list 0))))
+ (check-error-tag 'wrong-type-arg (lambda () (framples ind (list 0))))
(check-error-tag 'wrong-type-arg (lambda () (smooth-sound 0 -10)))
- (check-error-tag 'bad-arity (lambda () (ptree-channel (lambda (a b c) #f) 0 10 #f #f #f #f (lambda (a) #f))))
- (check-error-tag 'bad-arity (lambda () (ptree-channel (lambda (a) #f) 0 10 #f #f #f #f (lambda (a b) #f))))
(check-error-tag 'no-such-channel (lambda () (mix-selection 0 ind 123)))
(check-error-tag 'no-such-channel (lambda () (insert-selection 0 ind 123)))
(check-error-tag 'out-of-range (lambda () (set! (channels ind) 0)))
- (check-error-tag 'out-of-range (lambda () (set! (channels ind) -1)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! (channels ind) -1)))
(check-error-tag 'out-of-range (lambda () (set! (channels ind) 12340)))
- (check-error-tag 'out-of-range (lambda () (set! (data-format ind) 12340)))
+ (check-error-tag 'out-of-range (lambda () (set! (sample-type ind) 12340)))
(check-error-tag 'out-of-range (lambda () (set! (header-type ind) 12340)))
(check-error-tag 'out-of-range (lambda () (set! (srate ind) 0)))
- (check-error-tag 'out-of-range (lambda () (set! (data-location ind) -1)))
- (check-error-tag 'out-of-range (lambda () (set! (data-size ind) -1)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! (data-location ind) -1)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! (data-size ind) -1)))
(check-error-tag 'no-such-sample (lambda () (set! (sample -1) -1)))
(check-error-tag 'no-such-sample (lambda () (sample -1)))
- (check-error-tag 'out-of-range (lambda () (set! (frames) -10)))
- (check-error-tag 'out-of-range (lambda () (set! (min-dB) 0.0)))
+ (check-error-tag 'out-of-range (lambda () (set! (framples) -10)))
+ (check-error-tag 'out-of-range (lambda () (set! *min-dB* 0.0)))
(check-error-tag 'out-of-range (lambda () (set! (min-dB ind 0) 0.0)))
(check-error-tag 'out-of-range (lambda () (start-playing 1 -22)))
(check-error-tag 'out-of-range (lambda () (start-playing 1 0)))
@@ -62591,13 +48521,13 @@ EDITS: 1
(check-error-tag 'bad-header (lambda () (insert-sound (string-append sf-dir "bad_chans.snd"))))
(check-error-tag 'IO-error (lambda () (convolve-with (string-append sf-dir "bad_chans.snd"))))
(check-error-tag 'cannot-save (lambda () (save-sound-as "hiho.snd" ind -12)))
- (check-error-tag 'cannot-save (lambda () (save-sound-as "hiho.snd" ind mus-next -12)))
- (check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind mus-nist mus-bdouble)))
- (check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind mus-aifc mus-lfloat)))
- (check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind mus-riff mus-bshort)))
- (check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind mus-voc mus-bshort)))
- (check-error-tag 'cannot-save (lambda () (save-selection "test.snd" mus-riff mus-bshort)))
- (check-error-tag 'cannot-save (lambda () (save-selection "test.snd" mus-voc mus-bshort)))
+ (check-error-tag 'cannot-save (lambda () (save-sound-as "hiho.snd" ind :header-type mus-next :sample-type -12)))
+ (check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind :header-type mus-nist :sample-type mus-bdouble)))
+ (check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind :header-type mus-aifc :sample-type mus-lfloat)))
+ (check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind :header-type mus-riff :sample-type mus-bshort)))
+ (check-error-tag 'cannot-save (lambda () (save-sound-as "test.snd" ind :header-type mus-voc :sample-type mus-bshort)))
+ (check-error-tag 'cannot-save (lambda () (save-selection "test.snd" 22050 mus-bshort mus-riff)))
+ (check-error-tag 'cannot-save (lambda () (save-selection "test.snd" 22050 mus-bshort mus-voc)))
(check-error-tag 'out-of-range (lambda () (src-channel (make-env '(0 0 1 1) :length 11))))
(check-error-tag 'out-of-range (lambda () (src-channel (make-env '(0 1 1 0) :length 11))))
(check-error-tag 'out-of-range (lambda () (src-channel (make-env '(0 1 1 -1) :length 11))))
@@ -62607,14 +48537,14 @@ EDITS: 1
(check-error-tag 'out-of-range (lambda () (src-sound (make-env '(0 1 1 -1) :length 11))))
(check-error-tag 'out-of-range (lambda () (src-sound (make-env '(0 -1 1 1) :length 11))))
(check-error-tag 'mus-error (lambda () (make-readin 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
- (check-error-tag 'out-of-range (lambda () (filter-sound vct-3 32)))
+ (check-error-tag 'out-of-range (lambda () (filter-sound float-vector-3 32)))
(check-error-tag 'out-of-range (lambda () (filter-sound '(0 0 1 1) 0)))
(check-error-tag 'no-such-sound (lambda () (swap-channels ind 0 12345 0)))
- (check-error-tag 'no-such-sample (lambda () (mix-vct (vct 0.1 0.2 0.3) -1 ind 0 #t)))
- (check-error-tag 'out-of-range (lambda () (snd-spectrum (make-vct 8) 0 -123)))
- (check-error-tag 'out-of-range (lambda () (snd-spectrum (make-vct 8) 0 0)))
+ (check-error-tag 'no-such-sample (lambda () (mix-float-vector (float-vector 0.1 0.2 0.3) -1 ind 0 #t)))
+ (check-error-tag 'out-of-range (lambda () (snd-spectrum (make-float-vector 8) 0 -123)))
+ (check-error-tag 'out-of-range (lambda () (snd-spectrum (make-float-vector 8) 0 0)))
(check-error-tag 'no-such-file (lambda () (play "/baddy/hiho")))
- (check-error-tag 'bad-format (lambda () (play (string-append sf-dir "nist-shortpack.wav"))))
+ (check-error-tag 'bad-sample-type (lambda () (play (string-append sf-dir "nist-shortpack.wav"))))
; (check-error-tag 'no-such-channel (lambda () (play ind 0 :channel 123)))
(check-error-tag 'no-such-channel (lambda () (make-player ind 123)))
(check-error-tag 'no-such-file (lambda () (mix "/baddy/hiho")))
@@ -62622,20 +48552,18 @@ EDITS: 1
(check-error-tag 'no-such-file (lambda () (mix-sound "/baddy/hiho" 0)))
(check-error-tag 'no-such-file (lambda () (insert-sound "/baddy/hiho.snd")))
(check-error-tag 'no-such-file (lambda () (insert-samples 0 10 "/baddy/hiho.snd")))
- (check-error-tag 'no-data (lambda () (set! (filter-control-envelope ind) '())))
- (check-error-tag 'out-of-range (lambda () (set! (data-format ind) 123)))
+ (check-error-tag 'no-data (lambda () (set! (filter-control-envelope ind) ())))
+ (check-error-tag 'out-of-range (lambda () (set! (sample-type ind) 123)))
(check-error-tag 'out-of-range (lambda () (set! (header-type ind) 123)))
(check-error-tag 'no-such-channel (lambda () (set! (selected-channel ind) 123)))
- (check-error-tag 'bad-arity (lambda () (set! (search-procedure ind) (lambda (a b c) #t))))
- (check-error-tag 'bad-arity (lambda () (map-chan (lambda (a b c) 1.0))))
- (check-error-tag 'bad-arity (lambda () (scan-chan (lambda (a b c) 1.0))))
+ (check-error-tag 'bad-arity (lambda () (set! (search-procedure) (lambda (a b c) #t))))
+ (check-error-tag 'bad-arity (lambda () (map-channel (lambda (a b c) 1.0))))
+ (check-error-tag 'bad-arity (lambda () (scan-channel (lambda (a b c) 1.0))))
(check-error-tag 'bad-arity (lambda () (set! (cursor-style ind 0) (lambda (a) 32))))
- (check-error-tag 'bad-arity (lambda () (find-channel (lambda () 1.0))))
- (check-error-tag 'bad-arity (lambda () (count-matches (lambda () 1.0))))
(check-error-tag 'no-such-graphics-context (lambda () (draw-line 0 0 1 1 ind 0 1234)))
(check-error-tag 'no-such-graphics-context (lambda () (foreground-color ind 0 1234)))
(check-error-tag 'no-such-graphics-context (lambda () (current-font ind 0 1234)))
- (check-error-tag 'no-such-graphics-context (lambda () (graph-data (list vct-3 vct-3) ind 0 1234 0 1 0)))
+ (check-error-tag 'no-such-graphics-context (lambda () (graph-data (list float-vector-3 float-vector-3) ind 0 1234 0 1 0)))
(check-error-tag 'no-such-axis (lambda () (position->x 100 ind 0 1234)))
(check-error-tag 'no-such-axis (lambda () (position->y 100 ind 0 1234)))
(check-error-tag 'no-such-axis (lambda () (x->position 100 ind 0 1234)))
@@ -62645,29 +48573,29 @@ EDITS: 1
(check-error-tag 'out-of-range (lambda () (draw-axes (car (channel-widgets)) (car (snd-gcs)) "hiho" 0.0 1.0 -1.0 1.0 1234)))
(check-error-tag 'no-such-channel (lambda () (axis-info ind 1234)))
(check-error-tag 'no-such-sound (lambda () (axis-info 1234)))
- (set! (time-graph-type) graph-once)
+ (set! *time-graph-type* graph-once)
; (check-error-tag 'out-of-range (lambda () (set! (x-bounds) (list 0 0))))
(check-error-tag 'out-of-range (lambda () (set! (x-bounds) (list .1 -.1))))
; (check-error-tag 'out-of-range (lambda () (set! (y-bounds) (list .2 .1))))
(check-error-tag 'out-of-range (lambda () (make-region 100 0)))
(check-error-tag 'no-such-sample (lambda () (delete-sample -1)))
- (check-error-tag 'no-such-sample (lambda () (delete-sample (* 2 (frames ind)))))
+ (check-error-tag 'no-such-sample (lambda () (delete-sample (* 2 (framples ind)))))
(check-error-tag 'no-such-file (lambda () (play "/bad/baddy.snd")))
(check-error-tag 'no-such-sound (lambda () (play 1234 0)))
; (check-error-tag 'no-such-channel (lambda () (play ind 0 :channel 1234)))
(if (= (length (regions)) 0) (make-region 0 100))
(check-error-tag 'no-such-channel (lambda () (region-sample (car (regions)) 0 1234)))
- (check-error-tag 'no-such-channel (lambda () (region-frames (car (regions)) 1234)))
+ (check-error-tag 'no-such-channel (lambda () (region-framples (car (regions)) 1234)))
(check-error-tag 'no-such-channel (lambda () (region-position (car (regions)) 1234)))
- ; (check-error-tag 'no-such-region (lambda () (region->vct #f 0 1)))
- ; (check-error-tag 'no-such-channel (lambda () (region->vct (car regions) 0 1 1234)))
+ ; (check-error-tag 'no-such-region (lambda () (region->float-vector #f 0 1)))
+ ; (check-error-tag 'no-such-channel (lambda () (region->float-vector (car regions) 0 1 1234)))
(check-error-tag 'cannot-save (lambda () (save-sound-as "/bad/baddy.snd")))
(check-error-tag 'no-such-sound (lambda () (transform-sample 0 1 1234)))
(check-error-tag 'no-such-channel (lambda () (transform-sample 0 1 ind 1234)))
- (check-error-tag 'no-such-sound (lambda () (graph (vct 0 1) "hi" 0 1 0 1 1234)))
- (check-error-tag 'no-such-channel (lambda () (graph (vct 0 1) "hi" 0 1 0 1 ind 1234)))
+ (check-error-tag 'no-such-sound (lambda () (graph (float-vector 0 1) "hi" 0 1 0 1 1234)))
+ (check-error-tag 'no-such-channel (lambda () (graph (float-vector 0 1) "hi" 0 1 0 1 ind 1234)))
(set! (selection-member? #t) #f)
- (check-error-tag 'no-active-selection (lambda () (filter-selection (vct 0 0 1 1) 4)))
+ (check-error-tag 'no-active-selection (lambda () (filter-selection (float-vector 0 0 1 1) 4)))
(check-error-tag 'no-active-selection (lambda () (save-selection "/bad/baddy.snd")))
(check-error-tag 'no-active-selection (lambda () (env-selection '(0 0 1 1))))
(check-error-tag 'no-such-region (lambda () (save-region (integer->region 1234) "/bad/baddy.snd")))
@@ -62681,18 +48609,17 @@ EDITS: 1
(check-error-tag 'no-such-direction (lambda () (make-sampler 0 ind 0 123)))
(check-error-tag 'no-such-direction (lambda () (make-sampler 0 ind 0 0)))
(check-error-tag 'no-such-direction (lambda () (make-sampler 0 ind 0 -2)))
- (check-error-tag 'no-data (lambda () (scale-by '())))
- (check-error-tag 'no-data (lambda () (scale-to '())))
- (check-error-tag 'bad-arity (lambda () (prompt-in-minibuffer "hi" (lambda (x y) (+ x y)))))
+ (check-error-tag 'no-data (lambda () (scale-by ())))
+ (check-error-tag 'no-data (lambda () (scale-to ())))
(check-error-tag 'no-such-sample (lambda () (set! (selection-position ind 0) -999)))
- (check-error-tag 'wrong-type-arg (lambda () (set! (selection-frames ind 0) -999)))
- (check-error-tag 'wrong-type-arg (lambda () (set! (selection-frames ind 0) 0)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! (selection-framples ind 0) -999)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! (selection-framples ind 0) 0)))
(check-error-tag 'no-such-edit (lambda () (edit-fragment -1)))
(check-error-tag 'no-such-edit (lambda () (edit-fragment 101 ind 0)))
(check-error-tag 'no-such-edit (lambda () (edit-tree ind 0 -2)))
(check-error-tag 'no-such-edit (lambda () (edit-tree ind 0 101)))
(check-error-tag 'no-such-sample (lambda () (add-mark -1)))
- (check-error-tag 'no-such-sample (lambda () (add-mark (* 2 (frames)))))
+ (check-error-tag 'no-such-sample (lambda () (add-mark (* 2 (framples)))))
(check-error-tag 'no-such-file (lambda () (convolve-with "/bad/baddy")))
(check-error-tag 'no-such-file (lambda () (mix "/bad/baddy")))
(check-error-tag 'no-such-sound (lambda () (swap-channels ind 0 123)))
@@ -62711,14 +48638,13 @@ EDITS: 1
(check-error-tag 'wrong-type-arg (lambda () (add-mark 123 (list 0))))
(check-error-tag 'no-such-sound (lambda () (filter-channel '(0 0 1 1) 100 #f #f 1234 0)))
(check-error-tag 'no-such-channel (lambda () (filter-channel '(0 0 1 1) 100 #f #f ind 1)))
- (check-error-tag 'no-such-channel (lambda () (filter-channel (vct 0 0 1 1) 4 #f #f ind 1)))
- (check-error-tag 'out-of-range (lambda () (filter-sound (vct 0 0 1 1) 0)))
- (check-error-tag 'out-of-range (lambda () (filter-sound (vct 0 0 1 1) 10)))
+ (check-error-tag 'no-such-channel (lambda () (filter-channel (float-vector 0 0 1 1) 4 #f #f ind 1)))
+ (check-error-tag 'out-of-range (lambda () (filter-sound (float-vector 0 0 1 1) 0)))
+ (check-error-tag 'out-of-range (lambda () (filter-sound (float-vector 0 0 1 1) 10)))
(check-error-tag 'bad-arity (lambda () (play (selected-sound) 0 :stop (lambda () #f))))
(check-error-tag 'out-of-range (lambda () (set! (reverb-control-length-bounds ind) (list .1 .01))))
(check-error-tag 'out-of-range (lambda () (set! (reverb-control-scale-bounds ind) (list .1 .01))))
(check-error-tag 'wrong-type-arg (lambda () (scale-by #f)))
- (check-error-tag 'wrong-type-arg (lambda () (scale-by (make-mixer 2 .1 .1 .2 .2))))
(check-error-tag 'wrong-type-arg (lambda () (src-sound 3.0 1.0 #t)))
(check-error-tag 'wrong-type-arg (lambda () (src-sound 3.0 1.0 ind #t)))
(check-error-tag 'no-such-edit (lambda () (display-edits ind 0 123)))
@@ -62731,8 +48657,8 @@ EDITS: 1
(check-error-tag 'no-such-menu (lambda () (add-to-menu 1234 "hi" (lambda () #f))))
(check-error-tag 'bad-arity (lambda () (add-to-main-menu "hi" (lambda (a b) #f))))
(check-error-tag 'bad-arity (lambda () (add-to-menu 1 "hi" (lambda (a b) #f))))
- (check-error-tag 'wrong-type-arg (lambda () (set! (transform-type) (integer->transform -1))))
- (check-error-tag 'out-of-range (lambda () (set! (transform-type) (integer->transform 123))))
+ (check-error-tag 'wrong-type-arg (lambda () (set! *transform-type* (integer->transform -1))))
+ (check-error-tag 'out-of-range (lambda () (set! *transform-type* (integer->transform 123))))
(check-error-tag 'wrong-type-arg (lambda () (help-dialog (list 0 1) "hiho")))
(check-error-tag 'wrong-type-arg (lambda () (info-dialog (list 0 1) "hiho")))
(check-error-tag 'no-such-sound (lambda () (edit-header-dialog 1234)))
@@ -62749,41 +48675,31 @@ EDITS: 1
(check-error-tag 'no-such-key (lambda () (key-binding -1 0)))
(check-error-tag 'no-such-key (lambda () (key-binding 12 17)))
(check-error-tag 'no-such-key (lambda () (key-binding 12 -1)))
- (check-error-tag 'bad-header (lambda () (file->array (string-append sf-dir "bad_chans.snd") 0 0 123 (make-vct 123))))
+ (check-error-tag 'bad-header (lambda () (file->array (string-append sf-dir "bad_chans.snd") 0 0 123 (make-float-vector 123))))
(check-error-tag 'bad-header (lambda () (make-readin (string-append sf-dir "bad_chans.snd"))))
- (check-error-tag 'mus-error (lambda () (make-iir-filter 30 (make-vct 3))))
+ (check-error-tag 'mus-error (lambda () (make-iir-filter 30 (make-float-vector 3))))
(check-error-tag 'out-of-range (lambda () (make-wave-train :size (expt 2 30))))
- (check-error-tag 'out-of-range (lambda () (set! (mus-srate) 0.0)))
- (check-error-tag 'out-of-range (lambda () (set! (mus-srate) -1000)))
- (check-error-tag 'out-of-range (lambda () (dot-product (make-vct 3) (make-vct 3) -1)))
- (check-error-tag 'out-of-range (lambda () (sine-bank (make-vct 3) (make-vct 3) -1)))
- (check-error-tag 'out-of-range (lambda () (multiply-arrays (make-vct 3) (make-vct 3) -1)))
- (check-error-tag 'out-of-range (lambda () (make-delay 3 :initial-element 0.0 :initial-contents (vct .1 .2 .3))))
- (check-error-tag 'out-of-range (lambda () (make-delay 3 :max-size 100 :initial-contents (vct .1 .2 .3))))
- (check-error-tag 'out-of-range (lambda () (make-table-lookup :size 100 :wave (make-vct 3))))
- (check-error-tag 'out-of-range (lambda () (make-wave-train :size 100 :wave (make-vct 3))))
+ (check-error-tag 'out-of-range (lambda () (set! *clm-srate* 0.0)))
+ (check-error-tag 'out-of-range (lambda () (set! *clm-srate* -1000)))
+ (check-error-tag 'out-of-range (lambda () (dot-product (make-float-vector 3) (make-float-vector 3) -1)))
+ (check-error-tag 'out-of-range (lambda () (make-delay 3 :initial-element 0.0 :initial-contents (float-vector .1 .2 .3))))
+ (check-error-tag 'out-of-range (lambda () (make-delay 3 :max-size 100 :initial-contents (float-vector .1 .2 .3))))
+ (check-error-tag 'out-of-range (lambda () (make-table-lookup :size 100 :wave (make-float-vector 3))))
+ (check-error-tag 'out-of-range (lambda () (make-wave-train :size 100 :wave (make-float-vector 3))))
; (check-error-tag 'out-of-range (lambda () (make-granulate :max-size (expt 2 30))))
(check-error-tag 'out-of-range (lambda () (make-ssb-am 100 12345678)))
- (check-error-tag 'mus-error (lambda () (make-rand :envelope '(0 0 1 1) :distribution (make-vct 10))))
+ (check-error-tag 'mus-error (lambda () (make-rand :envelope '(0 0 1 1) :distribution (make-float-vector 10))))
(check-error-tag 'mus-error (lambda () (make-rand :envelope '(0 0 1))))
(check-error-tag 'out-of-range (lambda () (make-rand :envelope '(0 0 1 1) :size -2)))
(check-error-tag 'out-of-range (lambda () (make-rand :envelope '(0 0 1 1) :size 1234567890)))
- (check-error-tag 'bad-arity (lambda () (let ((grn (make-granulate))) (granulate grn #f (lambda (a s d) #f)))))
- (check-error-tag 'bad-arity (lambda () (let ((pv (make-phase-vocoder))) (phase-vocoder pv #f (lambda () #f)))))
- (check-error-tag 'bad-arity (lambda () (let ((pv (make-phase-vocoder))) (phase-vocoder pv #f #f (lambda () #f)))))
- (check-error-tag 'bad-arity (lambda () (let ((pv (make-phase-vocoder))) (phase-vocoder pv #f #f #f (lambda () #f)))))
- (check-error-tag 'mus-error (lambda () (let ((f (make-filter 3 :xcoeffs vct-3 :ycoeffs vct-3))) (mus-xcoeff f 4))))
- (check-error-tag 'mus-error (lambda () (let ((f (make-filter 3 :xcoeffs vct-3 :ycoeffs vct-3))) (mus-ycoeff f 4))))
- (check-error-tag 'mus-error (lambda () (let ((f (make-filter 3 :xcoeffs vct-3 :ycoeffs vct-3))) (set! (mus-xcoeff f 4) 1.0))))
- (check-error-tag 'mus-error (lambda () (let ((f (make-filter 3 :xcoeffs vct-3 :ycoeffs vct-3))) (set! (mus-ycoeff f 4) 1.0))))
- (check-error-tag 'mus-error (lambda () (make-filter :ycoeffs (make-vct 4) :order 12)))
+ (check-error-tag 'mus-error (lambda () (let ((f (make-filter 3 :xcoeffs float-vector-3 :ycoeffs float-vector-3))) (mus-xcoeff f 4))))
+ (check-error-tag 'mus-error (lambda () (let ((f (make-filter 3 :xcoeffs float-vector-3 :ycoeffs float-vector-3))) (mus-ycoeff f 4))))
+ (check-error-tag 'mus-error (lambda () (let ((f (make-filter 3 :xcoeffs float-vector-3 :ycoeffs float-vector-3))) (set! (mus-xcoeff f 4) 1.0))))
+ (check-error-tag 'mus-error (lambda () (let ((f (make-filter 3 :xcoeffs float-vector-3 :ycoeffs float-vector-3))) (set! (mus-ycoeff f 4) 1.0))))
+ (check-error-tag 'mus-error (lambda () (make-filter :ycoeffs (make-float-vector 4) :order 12)))
(check-error-tag 'mus-error (lambda () (let ((hi (make-oscil))) (set! (mus-offset hi) 1))))
(check-error-tag 'out-of-range (lambda () (make-locsig :channels (expt 2 30))))
(check-error-tag 'out-of-range (lambda () (make-src :width 3000)))
- (check-error-tag 'out-of-range (lambda () (make-frame -1)))
- (check-error-tag 'mus-error (lambda () (let ((hi (make-frame 2 .1 .2))) (frame-ref hi 3))))
- (check-error-tag 'out-of-range (lambda () (make-scalar-mixer 0 .1)))
- (check-error-tag 'mus-error (lambda () (let ((m (make-mixer 2))) (mixer-ref m 3 4))))
(check-error-tag 'bad-arity (lambda () (add-colormap "baddy" (lambda () #f))))
(check-error-tag 'bad-arity (lambda () (add-colormap "baddy" (lambda (a b c) #f))))
; (check-error-tag 'out-of-range (lambda () (make-phase-vocoder :fft-size (expt 2 30))))
@@ -62793,11 +48709,11 @@ EDITS: 1
(check-error-tag 'out-of-range (lambda () (make-polyshape 440.0 :partials '(1 1) :kind -1)))
(check-error-tag 'out-of-range (lambda () (make-polyshape 440.0 :partials '(1 1) :kind 3)))
(check-error-tag 'wrong-type-arg (lambda () (normalize-partials 32)))
- (check-error-tag 'wrong-type-arg (lambda () (normalize-partials '())))
+ (check-error-tag 'wrong-type-arg (lambda () (normalize-partials ())))
(check-error-tag 'bad-type (lambda () (normalize-partials '(1 2 3))))
- (check-error-tag 'bad-type (lambda () (normalize-partials (vct 3))))
+ (check-error-tag 'bad-type (lambda () (normalize-partials (float-vector 3))))
- (check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (vct 1 1 -2 1))))
+ (check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (float-vector 1 1 -2 1))))
(check-error-tag 'no-data (lambda () (make-polyshape 440.0 :partials (list 1 1 -2 1))))
;(check-error-tag 'wrong-type-arg (lambda () (make-polyshape 440.0 :partials (list 1 1 "hi" 1)))) ; can be 'no-data etc
;(check-error-tag 'wrong-type-arg (lambda () (make-polyshape 440.0 :partials (list 1 1 2 "hi"))))
@@ -62806,34 +48722,55 @@ EDITS: 1
(check-error-tag 'wrong-type-arg (lambda () (set! (mus-header-raw-defaults) 1234)))
(check-error-tag 'wrong-type-arg (lambda () (set! (mus-header-raw-defaults) (list 44100 2.123 "hi"))))
- (check-error-tag 'wrong-type-arg (lambda () (set! (with-toolbar) 123)))
- (check-error-tag 'wrong-type-arg (lambda () (set! (with-tooltips) 123)))
- (check-error-tag 'wrong-type-arg (lambda () (set! (with-menu-icons) 123)))
- (check-error-tag 'wrong-type-arg (lambda () (set! (save-as-dialog-src) 123)))
- (check-error-tag 'wrong-type-arg (lambda () (set! (save-as-dialog-auto-comment) 123)))
- (check-error-tag 'wrong-type-arg (lambda () (set! (with-smpte-label) 123)))
- (check-error-tag 'wrong-type-arg (lambda () (set! (ask-about-unsaved-edits) 123)))
-
+ (check-error-tag 'wrong-type-arg (lambda () (set! *with-toolbar* 123)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! *with-tooltips* 123)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! *with-menu-icons* 123)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! *save-as-dialog-src* 123)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! *save-as-dialog-auto-comment* 123)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! *with-smpte-label* 123)))
+ (check-error-tag 'wrong-type-arg (lambda () (set! *ask-about-unsaved-edits* 123)))
+
(check-error-tag 'no-such-mix (lambda () (mix-properties (integer->mix (+ 1 (mix-sync-max))))))
(check-error-tag 'no-such-mix (lambda () (set! (mix-properties (integer->mix (+ 1 (mix-sync-max)))) 1)))
))
+ ;; xen.h over-optimization regression check
+ (catch #t
+ (lambda ()
+ (set! (x-zoom-slider -1) 123))
+ (lambda args
+ (let ((str (apply format #f (cadr args))))
+ (if (not (string=? str "set! x-zoom-slider: no such sound: -1"))
+ (snd-display #__line__ ";x-zoom-slider error: ~S~%" str)))))
+ (catch #t
+ (lambda ()
+ (set! (y-zoom-slider -1) 123))
+ (lambda args
+ (let ((str (apply format #f (cadr args))))
+ (if (not (string=? str "set! y-zoom-slider: no such sound: -1"))
+ (snd-display #__line__ ";y-zoom-slider error: ~S~%" str)))))
+ (catch #t
+ (lambda ()
+ (set! (beats-per-measure -1) 123))
+ (lambda args
+ (let ((str (apply format #f (cadr args))))
+ (if (not (string=? str "set! beats-per-measure: no such sound: -1"))
+ (snd-display #__line__ ";beats-per-measure error: ~S~%" str)))))
+
+ (if (pair? (sounds))
+ (snd-display #__line__ ";sounds after error checks: ~A~%" (map short-file-name (sounds))))
+
(if (provided? 'snd-motif)
(for-each
(lambda (n name)
(let ((tag (catch #t
- (lambda () (n (list 'Widget 0)))
- (lambda args (car args)))))
+ (lambda () (n (list 'Widget 0)))
+ (lambda args (car args)))))
(if (not (eq? tag 'no-such-widget))
(snd-display #__line__ ";~A of null widget -> ~A" name tag))))
(list widget-position widget-size widget-text hide-widget show-widget focus-widget)
(list 'widget-position 'widget-size 'widget-text 'hide-widget 'show-widget 'focus-widget)))
- ;; now try everything! (all we care about here is that Snd keeps running)
-
- ; (set! (hook-functions snd-error-hook) '())
- ; (hook-push snd-error-hook (lambda (msg) (snd-display #__line__ msg) #t))
-
;; ---------------- key args
(for-each
(lambda (arg1)
@@ -62842,10 +48779,10 @@ EDITS: 1
(for-each
(lambda (n)
(catch #t
- (lambda () (n arg1 arg2))
- (lambda args (car args))))
+ (lambda () (n arg1 arg2))
+ (lambda args (car args))))
make-procs))
- (list 1.5 "/hiho" (list 0 1) 1234 vct-3 :wave -1 0 1 #f #t '() vector-0 delay-32)))
+ (list 1.5 str-3 (list 0 1) 12 float-vector-3 :wave -1 0 1 #f #t () vector-0 delay-32)))
keyargs)
(if (and all-args (= test-28 0))
@@ -62859,12 +48796,12 @@ EDITS: 1
(for-each
(lambda (n)
(catch #t
- (lambda () (n arg1 arg2 arg3))
- (lambda args (car args))))
+ (lambda () (n arg1 arg2 arg3))
+ (lambda args (car args))))
make-procs))
- (list 1.5 "/hiho" (list 0 1) 1234 vct-3 :wave -1 0 1 #f #t '() vector-0 delay-32)))
+ (list 1.5 str-3 (list 0 1) 12 float-vector-3 :wave -1 0 1 #f #t () vector-0 delay-32)))
keyargs))
- (list 1.5 "/hiho" (list 0 1) 1234 vct-3 :wave -1 0 1 #f #t '() vector-0 delay-32))
+ (list 1.5 str-3 (list 0 1) 12 float-vector-3 :wave -1 0 1 #f #t () vector-0 delay-32))
(for-each
(lambda (arg1)
@@ -62877,45 +48814,39 @@ EDITS: 1
(for-each
(lambda (n)
(catch #t
- (lambda () (n arg1 arg2 arg3 arg4))
- (lambda args (car args))))
+ (lambda () (n arg1 arg2 arg3 arg4))
+ (lambda args (car args))))
make-procs))
keyargs))
- (list 1.5 "/hiho" (list 0 1) 1234 vct-3 :wave -1 0 1 #f #t '() vector-0 delay-32)))
+ (list 1.5 str-3 (list 0 1) 12 float-vector-3 :wave -1 0 1 #f #t () vector-0 delay-32)))
keyargs))
- (list 1.5 "/hiho" (list 0 1) 1234 vct-3 :wave -1 0 1 #f #t '() vector-0 delay-32))))
-
- ;; (set! a-sound (new-sound "test.snd" mus-next mus-bshort 22050 1 "set-samples test" 100))
- (if all-args (snd-display #__line__ ";args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time)))))
+ (list 1.5 str-3 (list 0 1) 12 float-vector-3 :wave -1 0 1 #f #t () vector-0 delay-32))))
+; (if all-args (snd-display #__line__ ";args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time)))))
;; ---------------- 0 Args
(for-each
(lambda (n)
(let ((err (catch #t
- (lambda ()
- (n))
- (lambda args (car args)))))
+ n
+ (lambda args (car args)))))
(if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs0: ~A ~A" err (procedure-property n 'documentation)))))
+ (snd-display #__line__ ";procs0: ~A ~A" err (procedure-documentation n)))))
procs0)
(dismiss-all-dialogs)
+ (for-each close-sound (sounds))
- (let* ((main-args (list 1.5 "/hiho" (list 0 1) 1234 vct-3 color-95 '#(0 1) 3/4 'mus-error (sqrt -1.0) delay-32
- (lambda () #t) vct-5 sound-data-23 :order 0 1 -1 a-hook #f #t #\c 0.0 -1.0
- '() '3 64 -64 vector-0 '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0) car-main cadr-main
+ (let* ((main-args (list 1.5 str-3 (list 0 1) 12 float-vector-3 color-95 #(0 1) 3/4 'mus-error 0+i delay-32
+ (lambda () #t) float-vector-5 :order 0 1 -1 a-hook #f #t #\c 0.0 -1.0
+ () 3 64 -64 vector-0 '(1 . 2) (expt 2.0 21.5) (expt 2.0 -18.0) car-main cadr-main
(lambda (a) #f) abs
1.0+1.0i (cons 1 2) '((1 2) (3 4)) '((1 (2)) (((3) 4)))
(vector 1 #\a '(3)) (make-vector 0)
(let ((x 3)) (lambda (y) (+ x y))) (lambda args args)
"" (make-hash-table 256)
- (symbol->value '_?__undefined__?_) ; -> #<undefined> hopefully
- (vector-fill! (vector 0) 0) ; -> #<unspecified>?
- (with-input-from-string "" (lambda () (read-char))) ; -> #<eof>?
- (make-random-state 1234)
- ))
- (few-args (list 1.5 "/hiho" (list 0 1) 1234 vct-3 color-95 '#(0 1) 3/4 -1.0
- (sqrt -1.0) delay-32 :feedback -1 0 1 "" 'hi (lambda (a) (+ a 1)) -64 #f #t '() vector-0))
- (fewer-args (list "/hiho" 1234 vct-3 -1.0 (sqrt -1.0) delay-32 -1 0 1 #f #t "" '()))
+ #<undefined> #<unspecified> #<eof>
+ (random-state 12) (float-vector) (vector)))
+ (few-args (list 1.5 str-3 (list 0 1) 12 float-vector-3 color-95 #(0 1) 3/4 -1.0 (float-vector) (vector) (list) (string)
+ 0+i delay-32 :feedback -1 0 1 'hi (lambda (a) (+ a 1)) -64 #f #t vector-0))
(less-args (if all-args main-args few-args)))
;; ---------------- 1 Arg
@@ -62923,13 +48854,14 @@ EDITS: 1
(lambda (arg)
(for-each
(lambda (n)
- (let ((err (catch #t
- (lambda () (n arg))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs1 wna: ~A ~A" err (procedure-property n 'documentation)))))
+ (catch #t
+ (lambda () (n arg))
+ (lambda args
+ (if (eq? (car args) 'wrong-number-of-args)
+ (snd-display #__line__ ";procs1 wna: ~A" (procedure-documentation n))))))
procs1))
main-args)
+ (for-each close-sound (sounds))
;; ---------------- 2 Args
(for-each
@@ -62938,27 +48870,29 @@ EDITS: 1
(lambda (arg2)
(for-each
(lambda (n)
- (let ((err (catch #t
- (lambda () (n arg1 arg2))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs2: ~A ~A" err (procedure-property n 'documentation)))))
+ (catch #t
+ (lambda () (n arg1 arg2))
+ (lambda args
+ (if (eq? (car args) 'wrong-number-of-args)
+ (snd-display #__line__ ";procs2: ~A" (procedure-documentation n))))))
procs2))
main-args))
main-args)
+ (for-each close-sound (sounds))
;; ---------------- set! no Args
(for-each
(lambda (arg)
(for-each
(lambda (n)
- (let ((err (catch #t
- (lambda () (set! (n) arg))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";set-procs0: ~A ~A" err (procedure-property n 'documentation)))))
+ (catch #t
+ (lambda () (set! (n) arg))
+ (lambda args
+ (if (eq? (car args) 'wrong-number-of-args)
+ (snd-display #__line__ ";set-procs0: ~A" (procedure-documentation n))))))
set-procs0))
main-args)
+ (for-each close-sound (sounds))
;; ---------------- set! 1 Arg
(for-each
@@ -62967,594 +48901,102 @@ EDITS: 1
(lambda (arg2)
(for-each
(lambda (n)
- (let ((err (catch #t
- (lambda () (set! (n arg1) arg2))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";set-procs1: ~A ~A" err (procedure-property n 'documentation)))))
+ (catch #t
+ (lambda () (set! (n arg1) arg2))
+ (lambda args
+ (if (eq? (car args) 'wrong-number-of-args)
+ (snd-display #__line__ ";set-procs1: ~A" (procedure-documentation n))))))
set-procs1))
main-args))
main-args)
+ (for-each close-sound (sounds))
;; ---------------- set! 2 Args
(for-each
(lambda (arg1)
+ (for-each close-sound (sounds))
(for-each
(lambda (arg2)
(for-each
(lambda (arg3)
(for-each
(lambda (n)
- (let ((err (catch #t
- (lambda () (set! (n arg1 arg2) arg3))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";set-procs2: ~A ~A" err (procedure-property n 'documentation)))))
+ (catch #t
+ (lambda () (set! (n arg1 arg2) arg3))
+ (lambda args
+ (if (eq? (car args) 'wrong-number-of-args)
+ (snd-display #__line__ ";set-procs2: ~A" (procedure-documentation n))))))
set-procs2))
less-args))
less-args))
less-args)
- (if (and all-args (= test-28 0))
- ;; these can take awhile...
- (begin
-
- (snd-display #__line__ ";3 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- ;; ---------------- 3 Args
- (for-each
- (lambda (arg1)
- (begin
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (n)
- (let ((err (catch #t
- (lambda () (n arg1 arg2 arg3))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs3: ~A ~A" err (procedure-property n 'documentation)))))
- procs3))
- less-args))
- less-args)))
- less-args)
-
- (snd-display #__line__ ";set 3 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- ;; ---------------- set! 3 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (arg4)
- (for-each
- (lambda (n)
- (let ((err (catch #t
- (lambda () (set! (n arg1 arg2 arg3) arg4))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";set-procs3: ~A ~A" err (procedure-property n 'documentation)))))
- set-procs3))
- less-args))
- less-args))
- less-args))
- less-args)
-
- (snd-display #__line__ ";4 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- ;; ---------------- 4 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (arg4)
- (for-each
- (lambda (n)
- (let ((err (catch #t
- (lambda () (n arg1 arg2 arg3 arg4))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs4: ~A ~A ~A" err n (procedure-property n 'documentation)))))
- procs4))
- few-args))
- few-args))
- few-args))
- few-args)
-
- (snd-display #__line__ ";set 4 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- ;; ---------------- set! 4 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (arg4)
- (for-each
- (lambda (arg5)
- (for-each
- (lambda (n)
- (let ((err (catch #t
- (lambda () (set! (n arg1 arg2 arg3 arg4) arg5))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";set-procs4: ~A ~A" err (procedure-property n 'documentation)))))
- set-procs4))
- fewer-args))
- fewer-args))
- fewer-args))
- fewer-args))
- fewer-args)
-
- (clear-sincs)
- (stop-playing)
- (snd-display #__line__ ";5 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- ;; ---------------- 5 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (arg4)
- (for-each
- (lambda (arg5)
- (for-each
- (lambda (n)
- (let ((err (catch #t
- (lambda () (n arg1 arg2 arg3 arg4 arg5))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs5: ~A ~A ~A" err n (procedure-property n 'documentation)))))
- procs5))
- fewer-args))
- fewer-args))
- fewer-args))
- fewer-args))
- fewer-args)
-
- (clear-sincs)
- (snd-display #__line__ ";6 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- ;; ---------------- 6 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (arg4)
- (for-each
- (lambda (arg5)
- (for-each
- (lambda (arg6)
- (for-each
- (lambda (n)
- (let ((err (catch #t
- (lambda () (n arg1 arg2 arg3 arg4 arg5 arg6))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs6: ~A ~A" err (procedure-property n 'documentation)))))
- procs6))
- (list 1.5 "/hiho" -1234 -1 0 #f #t '() vct-3 delay-32)))
- (list 1.5 "/hiho" -1234 0 vct-5 #f #t delay-32)))
- (list 1.5 "/hiho" -1234 vct-3 #f #t delay-32)))
- (list 1.5 "/hiho" -1234 vct-3 -1 #f #t delay-32)))
- (list 1.5 -1234 vct-3 vct-5 -1 0 #f #t delay-32)))
- (list 1.5 "/hiho" -1234 #f #t vct-5 delay-32))
-
- (snd-display #__line__ ";8 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- ;; ---------------- 8 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (arg4)
- (for-each
- (lambda (arg5)
- (for-each
- (lambda (arg6)
- (for-each
- (lambda (arg7)
- (for-each
- (lambda (arg8)
- (for-each
- (lambda (n)
- (let ((err (catch #t
- (lambda () (n arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs8: ~A ~A" err (procedure-property n 'documentation)))))
- procs8))
- (list 1.5 -1 1234 #f '() delay-32)))
- (list "/hiho" -1 1234 '() vct-5 delay-32)))
- (list #t #f -1 1234 '() vct-3 delay-32)))
- (list (sqrt -1.0) 1234 0 -1 '() delay-32)))
- (list 1.5 -1 #f 1234 vct-3 '() delay-32)))
- (list 2 #f #t 1234 vct-5 -1 delay-32)))
- (list #f #t -1 1234 vct-3 delay-32)))
- (list 1.5 -1 '() 1234 "/hiho" delay-32))
-
- (clear-sincs)
- (snd-display #__line__ ";10 args: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- ;; ---------------- 10 Args
- (for-each
- (lambda (arg1)
- (for-each
- (lambda (arg2)
- (for-each
- (lambda (arg3)
- (for-each
- (lambda (arg4)
- (for-each
- (lambda (arg5)
- (for-each
- (lambda (arg6)
- (for-each
- (lambda (arg7)
- (for-each
- (lambda (arg8)
- (for-each
- (lambda (arg9)
- (for-each
- (lambda (arg10)
- (for-each
- (lambda (n)
- (let ((err (catch #t
- (lambda () (n arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10))
- (lambda args (car args)))))
- (if (eq? err 'wrong-number-of-args)
- (snd-display #__line__ ";procs10: ~A ~A" err (procedure-property n 'documentation)))))
- procs10))
- (list 1.5 -1 #f 1234 delay-32)))
- (list "/hiho" -1 1234 delay-32)))
- (list #t #f vct-3 1234 delay-32)))
- (list (sqrt -1.0) #f -1 vct-5 delay-32)))
- (list 1.5 #f -1 1234 '() delay-32)))
- (list -2 #f 1234 vct-3 delay-32)))
- (list #f #t '() 1234 vct-5 delay-32)))
- (list 1.5 -1 "/hiho" '() delay-32)))
- (list 1.5 -1 '() delay-32)))
- (list #f -1 1234 delay-32))
- ))))
-
- (snd-display #__line__ ";end args")
-
- (if (defined? 'mus-audio-reinitialize) (mus-audio-reinitialize))
- (set! (window-y) 10)
- (dismiss-all-dialogs)
-
- (if (file-exists? "test.snd")
- (begin
- (system "chmod 644 test.snd")
- (delete-file "test.snd")))
-
- (copy-file "oboe.snd" "test.snd")
- (let ((ind (open-sound "test.snd")))
- (delete-file "test.snd")
- (let ((tag (catch #t
- (lambda ()
- (update-sound ind))
- (lambda args (car args)))))
- (if (not (eq? tag 'cant-update-file))
- (snd-display #__line__ ";update-sound after deletion: ~A" tag)))
- (delete-sample 10)
- (let ((tag (catch #t
- (lambda () (save-sound ind))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-save))
- (snd-display #__line__ ";save file deleted: ~A" tag)))
- (close-sound ind))
-
- (copy-file "oboe.snd" "test.snd")
- (let ((ind (open-sound "test.snd"))
- (reg (select-all)))
- (delete-file "test.snd")
- (view-regions-dialog)
- (dismiss-all-dialogs)
- (close-sound ind))
-
- (copy-file "oboe.snd" "test.snd")
- (let ((ind (open-sound "test.snd")))
- (system "chmod 400 test.snd")
- (delete-sample 10)
- (let ((tag (catch #t
- (lambda () (save-sound ind))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-save))
- (snd-display #__line__ ";save protected sound msg: ~A" tag)))
- (close-sound ind))
-
- (system "chmod 644 test.snd")
- (delete-file "test.snd")
-
- (copy-file "oboe.snd" "test.snd")
- (system "chmod 400 test.snd")
- (let ((ind (open-sound "oboe.snd")))
- (delete-sample 10)
- (let ((tag
- (catch #t
- (lambda () (save-sound-as "test.snd"))
- (lambda args (car args)))))
- (if (not (eq? tag 'cannot-save))
- (snd-display #__line__ ";save-as write-protected sound: ~A" tag)))
- (close-sound ind))
- (system "chmod 644 test.snd")
- (delete-file "test.snd")
-
- ;; these redefine several basic names ("tap"), so they're not in test 23
- (if all-args
- (begin
- (snd-display #__line__ ";away and colony5: ~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time))))
-
- (set! (optimization) 6)
- (set! *clm-table-size* 512)
- (set! *clm-file-buffer-size* (* 1024 1024))
- (if (and (file-exists? "away.scm")
- (file-exists? "away.frb"))
- (begin
- (let ((val (simple-time (load "away.scm"))))
- (snd-display #__line__ ";away: ~A" val))
- (for-each close-sound (sounds))
- (if (file-exists? "a.snd") (delete-file "a.snd"))
- (if (file-exists? "ar.snd") (delete-file "ar.snd"))))
- (if (file-exists? "colony5.scm")
- (begin
- (let ((val (simple-time (load "colony5.scm"))))
- (snd-display #__line__ ";colony 5: ~A" val))
- (for-each close-sound (sounds))
- (if (file-exists? "col5.snd") (delete-file "col5.snd"))
- (if (file-exists? "reverb.snd") (delete-file "reverb.snd"))))))
-
- ;; close-sound cases that are nutty...
-
- (let ((tag (catch #t
- (lambda ()
- (let ((ind (open-sound "oboe.snd")))
- (map-channel
- (lambda (y)
- (if (sound? ind)
- (close-sound ind))
- 0.0))))
- (lambda args (car args)))))
- (if (not (eq? tag 'no-such-channel)) (snd-display #__line__ ";map-channel closing own chan: ~A" tag)))
-
- #|
- ;; this will return a truncated (at the start) result, but I currently can't think of a
- ;; reasonable way to disallow it. We either need a before-undo-hook, or edit-hook that is
- ;; local to the map-channel lambda (so that we can remove it before map-channel itself
- ;; wants to edit, but adding/removing it on every call seems silly).
-
- (let ((ind (open-sound "oboe.snd"))
- (ctr 0))
- (set! (sample 100) .5)
- (map-channel (lambda (y)
- (if (= ctr 0)
- (begin
- (revert-sound ind)
- (set! (sample 200) .6)))
- (set! ctr (+ 1 ctr))
- (* y 3))))
- |#
-
- (let ((ind1 (open-sound "oboe.snd"))
- (ind2 (open-sound "pistol.snd")))
- (as-one-edit
- (lambda ()
- (close-sound ind1)
- (close-sound ind2))))
-
- (let ((ind1 (open-sound "oboe.snd"))
- (ind2 (open-sound "pistol.snd")))
- (as-one-edit
- (lambda ()
- (set! (sample 100 ind1 0) .1)
- (set! (sample 200 ind2 0) .1)
- (as-one-edit
- (lambda ()
- (close-sound ind1)
- (close-sound ind2))
- "inner edit"))
- "outer edit"))
-
- (let ((ind (open-sound "oboe.snd")))
- (find-channel
- (lambda (y)
- (if (sound? ind)
- (close-sound ind))
- #f)))
-
- (let ((ind (open-sound "oboe.snd")))
- (let ((rd (make-sampler 0)))
- (close-sound ind)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (read-sample rd))
- (let ((home (sampler-home rd)))
- (if (and (list? home)
- (sound? (car home)))
- (snd-display #__line__ ";reader-home of closed sound: ~A ~A" home (sounds))))
- (let ((loc (sampler-position rd)))
- (if (not (= loc 0))
- (snd-display #__line__ ";closed reader position: ~A" loc)))
- (let ((at-end (sampler-at-end? rd)))
- (if (not at-end)
- (snd-display #__line__ ";closed sampler at end: ~A" at-end)))))
-
- (let ((ind (open-sound "oboe.snd")))
- (let ((mx (mix-vct (vct .1 .2 .3))))
- (let ((rd (make-mix-sampler mx)))
- (close-sound ind)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (read-mix-sample rd)))))
-
- (set! (max-regions) (max 8 (max-regions)))
- (let ((ind (open-sound "oboe.snd")))
- (let ((reg (make-region 0 100 ind 0)))
- (let ((rd (make-region-sampler reg 0)))
- (close-sound ind)
- (forget-region reg)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (read-sample rd)))))
-
- (let ((ind (open-sound "oboe.snd"))
- (scl 1.0))
- (set! (sample 100 ind 0) .5)
- (map-channel (lambda (y)
- (if (> y .4)
- (let* ((mx 0.0))
- (scan-channel (lambda (x)
- (set! mx (max mx (abs x)))
- #f))
- (set! scl (/ 1.0 mx))))
- (* scl y)))
- (if (fneq (sample 100 ind 0) 1.0) (snd-display #__line__ ";scan + map 100: ~A" (sample 100 ind 0)))
- (revert-sound ind)
-
- (set! (sample 100 ind 0) .5)
- (map-channel (lambda (y)
- (if (> y .4)
- (set! (frames ind 0) 1))
- y))
- (if (fneq (sample 100 ind 0) 0.5) (snd-display #__line__ ";map + reset frames: ~A" (sample 100 ind 0)))
- (if (not (= (frames ind 0) 50828)) (snd-display #__line__ ";map + reset frames, frames: ~A" (frames ind 0)))
- (undo 1 ind 0)
- (if (not (= (frames ind 0) 1)) (snd-display #__line__ ";map + reset frames, undo frames: ~A" (frames ind 0)))
- (revert-sound ind)
-
- (set! (sample 100 ind 0) .5)
- ;(let ((tag (catch #t (lambda () (set! (frames ind 0 1) 1)) (lambda args (car args)))))
- ; (if (not (eq? tag 'wrong-number-of-args)) (snd-display #__line__ ";set frames + edpos: ~A" tag)))
- (revert-sound ind)
-
- (let ((tag (catch #t (lambda () (map-channel (lambda (y) (* y 0.0+1.0i)))) (lambda args (car args)))))
- (if (not (eq? tag 'bad-type)) (snd-display #__line__ ";map-channel rtn complex: ~A" tag)))
-
- (let ((rd (make-sampler 0)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (rd))
- (let ((crd (copy-sampler rd)))
- (close-sound ind)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (read-sample crd))
- (let ((home (sampler-home crd)))
- (if (and (list? home)
- (sound? (car home)))
- (snd-display #__line__ ";copy reader-home of closed sound: ~A ~A" home (sounds))))
- (let ((loc (sampler-position crd)))
- (if (not (= loc 0))
- (snd-display #__line__ ";closed copy reader position: ~A" loc)))
- (let ((at-end (sampler-at-end? crd)))
- (if (not at-end)
- (snd-display #__line__ ";closed copy sampler at end: ~A" at-end)))))
-
- (let ((tag (catch #t (lambda () (revert-sound ind)) (lambda args (car args)))))
- (if (not (eq? tag 'no-such-sound)) (snd-display #__line__ ";revert-sound of closed sound: ~A" tag)))
-
- (set! ind (open-sound "oboe.snd")) ; closed in copy case above
- (set! (sample 100 ind 0) .5)
- (let ((tag (catch #t
- (lambda () (scale-channel .5 0 100 ind 0 (lambda () (close-sound ind) current-edit-position)))
- (lambda args (car args)))))
- (if (not (eq? tag 'bad-arity)) (snd-display #__line__ ";edpos proc bad args: ~A" tag)))
-
- (if (not (sound? ind))
- (snd-display #__line__ ";edpos bad arity proc clobbers chan?? ~A" ind)
- (close-sound ind))
- )
-
- (set! env3 #f)
- (set! delay-32 #f)
- (set! color-95 #f)
- (set! vector-0 #f)
- (set! vct-3 #f)
- (set! sound-data-23 #f)
- (set! (mus-srate) 22050)
- (set! *clm-srate* 22050)
- (set! (print-length) 12)
- (set! (mus-array-print-length) 12)
- (set! (sound-file-extensions) exts)
- (set! car-main #f)
- (set! cadr-main #f)
- (set! a-hook #f)
- (set! a-sound #f)
- (set! vct-5 #f)
-
- )))
-
-
-;;; ---------------- test 29: s7 ----------------
-
-(define (snd_test_29)
+ (set! delay-32 #f)
+ (set! color-95 #f)
+ (set! vector-0 #f)
+ (set! float-vector-3 #f)
+ (set! *clm-srate* 22050)
+ (set! *print-length* 12)
+ (set! *mus-array-print-length* 12)
+ (set! (sound-file-extensions) exts)
+ (set! car-main #f)
+ (set! cadr-main #f)
+ (set! a-hook #f)
+ (set! float-vector-5 #f)
+ )))))
+
+
+;;; ---------------- test 26: s7 ----------------
+
+(define (snd_test_26)
(load "s7test.scm"))
-
- ;(tracing #t)
-
(define test-funcs (make-vector (+ 1 total-tests)))
-(vector-set! test-funcs 0 snd_test_0)
-(vector-set! test-funcs 1 snd_test_1)
-(vector-set! test-funcs 2 snd_test_2)
-(vector-set! test-funcs 3 snd_test_3)
-(vector-set! test-funcs 4 snd_test_4)
-(vector-set! test-funcs 5 snd_test_5)
-(vector-set! test-funcs 6 snd_test_6)
-(vector-set! test-funcs 7 snd_test_7)
-(vector-set! test-funcs 8 snd_test_8)
-(vector-set! test-funcs 9 snd_test_9)
-(vector-set! test-funcs 10 snd_test_10)
-(vector-set! test-funcs 11 snd_test_11)
-(vector-set! test-funcs 12 snd_test_12)
-(vector-set! test-funcs 13 snd_test_13)
-(vector-set! test-funcs 14 snd_test_14)
-(vector-set! test-funcs 15 snd_test_15)
-(vector-set! test-funcs 16 snd_test_16)
-(vector-set! test-funcs 17 snd_test_17)
-(vector-set! test-funcs 18 snd_test_18)
-(vector-set! test-funcs 19 snd_test_19)
-(vector-set! test-funcs 20 snd_test_20)
-(vector-set! test-funcs 21 snd_test_21)
-(vector-set! test-funcs 22 snd_test_22)
-(vector-set! test-funcs 23 snd_test_23)
-(vector-set! test-funcs 24 snd_test_24)
-(vector-set! test-funcs 25 snd_test_25)
-(vector-set! test-funcs 26 snd_test_26)
-(vector-set! test-funcs 27 snd_test_27)
-(vector-set! test-funcs 28 snd_test_28)
-(vector-set! test-funcs 29 snd_test_29)
+(set! (test-funcs 0) snd_test_0)
+(set! (test-funcs 1) snd_test_1)
+(set! (test-funcs 2) snd_test_2)
+(set! (test-funcs 3) snd_test_3)
+(set! (test-funcs 4) snd_test_4)
+(set! (test-funcs 5) snd_test_5)
+(set! (test-funcs 6) snd_test_6)
+(set! (test-funcs 7) snd_test_7)
+(set! (test-funcs 8) snd_test_8)
+(set! (test-funcs 9) snd_test_9)
+(set! (test-funcs 10) snd_test_10)
+(set! (test-funcs 11) snd_test_11)
+(set! (test-funcs 12) snd_test_12)
+(if (or (and (not (provided? 'openbsd))
+ (not (provided? 'freebsd)))
+ (not (provided? 'snd-gtk)))
+ (begin
+ (set! (test-funcs 13) snd_test_13)
+ (set! (test-funcs 14) snd_test_14)
+ (set! (test-funcs 15) snd_test_15))
+ (begin
+ (set! (test-funcs 13) (lambda () #f))
+ (set! (test-funcs 14) (lambda () #f))
+ (set! (test-funcs 15) (lambda () #f))))
+(set! (test-funcs 16) snd_test_16)
+(set! (test-funcs 17) snd_test_17)
+(set! (test-funcs 18) snd_test_18)
+(set! (test-funcs 19) snd_test_19)
+(set! (test-funcs 20) snd_test_20)
+(set! (test-funcs 21) snd_test_21)
+(set! (test-funcs 22) snd_test_22)
+(set! (test-funcs 23) snd_test_23)
+(set! (test-funcs 24) snd_test_24)
+(set! (test-funcs 25) snd_test_25)
+(set! (test-funcs 26) snd_test_26)
(if (> test-at-random 0)
- (begin ; run tests in any random order
- (do ((i 0 (+ 1 i)))
- ((= i test-at-random))
- (set! snd-test (min 23 (random 24)))
- (display (format #f "~%~A: ~A" i snd-test))
- (before-test-hook snd-test)
- ((vector-ref test-funcs snd-test))
- (after-test-hook snd-test)
- ))
+ (do ((i 0 (+ i 1))) ; run tests in any random order
+ ((= i test-at-random))
+ (set! snd-test (random 23))
+ (if (> snd-test 22) (set! snd-test 22))
+ (format *stderr* "~%~A: ~A~%" i snd-test)
+ (before-test-hook snd-test)
+ ((vector-ref test-funcs snd-test))
+ (after-test-hook snd-test))
(if (and (not full-test)
(not keep-going)
@@ -63564,10 +49006,9 @@ EDITS: 1
((vector-ref test-funcs snd-test))
(after-test-hook snd-test))
- (do ((i 0 (+ 1 i))) ; run all tests except the irritating ones
+ (do ((i 0 (+ i 1))) ; run all tests except the irritating ones
((> i total-tests))
- (if (and ;(not (= i 26))
- (or (< i 24) (> i 26))
+ (if (and (or (< i 23) (> i 24))
(or full-test
(and keep-going (<= snd-test i))))
(begin
@@ -63578,89 +49019,86 @@ EDITS: 1
;;; ---------------- test all done
-(let ((regs (regions)))
- (for-each
- (lambda (n)
- (forget-region n))
- regs))
-(set! (view-files-sort) 0)
+(for-each forget-region (regions))
+(if with-motif (set! (view-files-sort) 0))
-(clear-sincs)
(stop-playing)
(mus-oss-set-buffers 4 12)
-(reset-almost-all-hooks)
-(set! (ask-about-unsaved-edits) #f)
-(set! (remember-sound-state) #f)
-(close-output-port optimizer-log)
+(reset-all-hooks)
+(set! *ask-about-unsaved-edits* #f)
+(set! *remember-sound-state* #f)
-(if (and full-test
- (= test-at-random 0)
- (= tests 1)
- (file-exists? "oldopt.log"))
- (system "diff -w optimizer.log oldopt.log"))
-
-(save-listener "test.output")
-(set! (listener-prompt) original-prompt)
+;(save-listener "test.output")
+(set! *listener-prompt* original-prompt)
(clear-listener)
(set! (show-listener) #t)
-(display (format #f "~%;all done!~%~A" original-prompt))
-
-(set! (print-length) 64)
-(display (format #f "~%;times: ~A~%;total: ~A~%" timings (round (- (real-time) overall-start-time))))
-
-#|
-(let ((best-times (vector 59 58 114 95 2244 5373 613 134 11680 2892 609 743 868 976 815 1288 3020 197 168 2952 758 1925 4997 6567 846 183 0 242 6696 0))) ; 571
-;; this runs 4x faster on the i7 930 nogui/no-audio
-
- (do ((i 0 (+ 1 i)))
- ((= i (vector-length timings)))
- (if (and (> (vector-ref timings i) 0)
- (> (vector-ref best-times i) 0))
- (vector-set! best-times i (exact->inexact (/ (vector-ref timings i) (vector-ref best-times i))))
- (vector-set! best-times i 0.0)))
- (display (format #f ";ratios: ("))
- (do ((i 0 (+ 1 i)))
- ((= i (vector-length timings)))
- (if (< (vector-ref best-times i) 10.0)
- (display (format #f "~1,1F " (vector-ref best-times i)))
- (display (format #f "(test ~D:) ~1,1F " i (vector-ref best-times i)))))
- (display (format #f ")~%~%")))
-|#
+(format #t "~%;all done!~%~A" original-prompt)
+
+(set! *print-length* 64)
+(format *stderr* "~%;times: ~A~%;total: ~A~%" timings (round (- (real-time) overall-start-time)))
+
+
+;; #(59 58 114 95 2244 5373 613 134 11680 2892 609 743 868 976 815 1288 3020 197 168 2952 758 1925 4997 6567 846 183 0 242 6696 0))) ; 571
+;;
+;; 19-Dec-12: #(1 1 2 2 69 240 6 1 583 1 23 1 1 17 70 1 233 1 1 271 89 119 1 1877 0 0 0 1 1 73) ; 37
+;; 23-Dec-12: #(1 1 2 1 67 243 7 1 586 1 16 1 2 18 63 1 223 1 1 270 92 115 1 1821 0 0 0 1 1 80) ; 36
+;; 26-Dec-12: #(1 1 2 1 65 199 6 1 556 1 15 1 1 12 26 1 229 1 1 276 52 108 1 1777 0 0 0 1 2 75) ; 34
+;; 1-Jan-13: #(1 1 2 2 64 200 7 1 575 1 17 1 2 12 84 1 246 1 1 215 45 111 1 1552 0 0 0 1 2 77) ; 32
+;; 3-Jan-13: #(1 1 2 1 65 185 6 1 564 1 20 1 2 11 26 1 202 1 1 213 45 109 1 1545 0 0 0 1 1 80) ; 31
+;; 9-Jan-13: #(1 1 2 1 63 181 7 1 540 1 19 1 2 11 22 1 201 1 1 207 44 107 1 1504 0 0 0 1 1 79) ; 30
+;; 25-Jan-13: #(1 1 2 1 58 178 6 1 505 1 13 1 2 10 20 1 205 1 1 198 44 111 1 1487 0 0 0 1 1 75) ; 29
+;; 11-Feb-13: #(1 1 3 2 49 170 5 1 463 1 15 1 1 11 46 1 216 1 2 158 42 110 1 1456 0 0 0 1 1 80) ; 28
+;; 15-Feb-13: #(1 1 2 2 42 160 5 1 450 1 18 1 1 10 21 1 196 1 1 158 42 107 1 1407 0 0 0 1 1 79) ; 27
+;; 21-Feb-13: #(1 1 2 2 43 159 6 1 448 1 12 1 2 10 20 1 189 1 2 156 41 106 1 1331 0 0 0 1 1 76) ; 26
+;; 26-Feb-13: #(1 1 2 2 42 118 5 1 450 1 16 1 2 11 19 1 97 1 1 161 42 105 1 1323 0 0 0 1 2 74) ; 25
+;; 1-Mar-13: #(1 1 3 1 40 117 5 1 439 1 16 1 2 11 20 1 109 1 2 159 43 100 1 1263 0 0 0 1 2 78) ; 24
+;; 7-Mar-13: #(1 1 2 2 41 119 6 1 396 1 16 1 2 10 23 1 103 1 1 144 41 85 1 1215 0 0 0 1 1 80) ; 23
+;; 8-Mar-13: #(1 1 3 2 32 102 5 1 363 1 15 1 2 10 21 1 90 1 1 144 41 87 1 1219 0 0 0 1 2 78) ; 22
+;; 14-Mar-13: #(1 1 2 2 31 92 4 1 316 1 19 1 2 12 17 1 80 1 1 121 40 81 1 1174 0 0 0 1 1 75) ; 21
+;; 20-Mar-13: #(1 1 2 2 30 90 4 1 317 1 12 1 1 10 22 1 79 1 1 115 40 78 1 1131 0 0 0 1 2 79) ; 20
+;; 3-Apr-13: #(1 1 2 2 30 89 4 1 297 1 11 1 2 10 9 1 81 1 1 110 41 73 1 1048 0 0 0 1 2 80) ; 19
+;; 14-Apr-13: #(1 1 2 2 31 88 4 1 288 1 16 1 2 10 17 1 77 1 1 110 39 73 1 975 0 0 0 1 2 75) ; 18
+;; 21-Apr-13: #(1 1 2 2 27 88 4 1 266 1 15 1 2 10 15 1 78 1 1 97 39 69 1 917 0 0 0 1 2 77) ; 17
+;; 24-Feb-14: #(1 1 2 1 22 74 2 1 162 2 9 1 3 8 9 2 54 2 70 33 24 2 791 0 0 1 82) ; 14
+;; 15-Mar-14: #(1 2 3 2 25 71 3 2 129 1 8 1 2 8 14 2 45 2 74 32 25 1 781 0 0 2 81) ; 13
+;; 1-Oct-14: #(1 2 2 2 22 68 2 2 114 2 9 1 3 8 50 1 45 2 70 32 26 2 749 0 0 2 113) ; 13
+;; 9-Mar-15: #(1 1 3 2 86 69 3 3 131 1 8 2 2 8 8 3 43 2 71 30 33 2 697 0 0 3 130) ; 13
+;; 29-May-15: #(2 3 3 3 22 79 3 3 130 3 8 3 4 9 9 3 49 3 75 30 28 3 708 0 0 3 144) ; 13
;;; -------- cleanup temp files
(if (provided? 'snd-nogui)
- (set! (max-regions) 0))
+ (set! *max-regions* 0))
(if (file-exists? "saved-snd.scm") (delete-file "saved-snd.scm"))
(if (file-exists? original-save-dir)
(begin
- (display (format #f "ls ~A/snd_* | wc~%" original-save-dir))
- (system (format #f "ls ~A/snd_* | wc" original-save-dir))
+ ;(format #t "ls ~A/snd_* | wc~%" original-save-dir)
+ ;(system (format #f "ls ~A/snd_* | wc" original-save-dir))
(system (format #f "rm -f ~A/snd_*" original-save-dir))))
(if (file-exists? original-temp-dir)
(begin
- (display (format #f "ls ~A/snd_* | wc~%" original-temp-dir))
- (system (format #f "ls ~A/snd_* | wc" original-temp-dir))
+ ;(format #t "ls ~A/snd_* | wc~%" original-temp-dir)
+ ;(system (format #f "ls ~A/snd_* | wc" original-temp-dir))
(system (format #f "rm -f ~A/snd_*" original-temp-dir))))
(if (file-exists? "/tmp")
(begin
- (display (format #f "ls /tmp/snd_* | wc~%"))
- (system "ls /tmp/snd_* | wc")
+ ;(format #t "ls /tmp/snd_* | wc~%")
+ ;(system "ls /tmp/snd_* | wc")
(system "rm -f /tmp/snd_*")
- (system "ls /tmp/file*.snd | wc")
+ ;(system "ls /tmp/file*.snd | wc")
(system "rm -f /tmp/file*.snd")))
(if (file-exists? "/var/tmp")
(begin
- (display (format #f "ls /var/tmp/snd_* | wc~%"))
- (system "ls /var/tmp/snd_* | wc")
+ ;(format #t "ls /var/tmp/snd_* | wc~%")
+ ;(system "ls /var/tmp/snd_* | wc")
(system "rm -f /var/tmp/snd_*")
- (system "ls /var/tmp/file*.snd | wc")
+ ;(system "ls /var/tmp/file*.snd | wc")
(system "rm -f /var/tmp/file*.snd")))
(if (defined? 'dlocsig-speaker-configs) (set! dlocsig-speaker-configs #f))
@@ -63720,9 +49158,9 @@ EDITS: 1
(string-append sf-dir "nasahal.avi.snd")
(string-append sf-dir "hcom-16.snd.snd")
(string-append sf-dir "ce-c3.w02.snd")
- (string-append sf-dir "oboe.g723_24.snd")
- (string-append sf-dir "oboe.g723_40.snd")
- (string-append sf-dir "oboe.g721.snd")
+; (string-append sf-dir "oboe.g723_24.snd")
+; (string-append sf-dir "oboe.g723_40.snd")
+; (string-append sf-dir "oboe.g721.snd")
(string-append sf-dir "wood.sds.snd")
(string-append sf-dir "o2_dvi.wave.snd")
(string-append sf-dir "nist-shortpack.wav.snd")
@@ -63734,36 +49172,32 @@ EDITS: 1
(for-each close-sound (sounds))
(mus-sound-prune)
-(if (dialog-widgets)
- (let ((vfs (list-ref (dialog-widgets) 8))) ; view-files (possible list)
+(if (and with-motif (dialog-widgets))
+ (let ((vfs ((dialog-widgets) 5))) ; view-files (possible list)
(if vfs
(if (symbol? (car vfs))
- (set! (view-files-files vfs) '())
+ (set! (view-files-files vfs) ())
(for-each
(lambda (d)
- (set! (view-files-files d) '()))
+ (set! (view-files-files d) ()))
vfs)))))
-(if (defined? 'run-report-counts) (run-report-counts))
-
-;; (if profiling (profile)) ; writes to sort.data
-
#|
(let ((st (symbol-table)))
- (do ((i 0 (+ i 1)))
- ((= i (vector-length st)))
- (let ((lst (vector-ref st i)))
- (for-each
- (lambda (sym)
- (if (defined? sym)
- (let ((val (symbol->value sym)))
- (if (and (procedure? val)
- (string=? "" (procedure-documentation val)))
- (format #t "~A " sym)))))
- lst))))
+ (for-each
+ (lambda (sym)
+ (if (defined? sym)
+ (let ((val (symbol->value sym)))
+ (if (and (procedure? val)
+ (string=? "" (procedure-documentation val)))
+ (snd-display #__line__ "~A " sym)))))
+ st))
|#
+(gc) (gc)
+(s7-version)
+
(if with-exit (exit))
;;; ---------------- test the end
@@ -63774,7 +49208,7 @@ valgrind --tool=callgrind snd -l snd-test
callgrind_annotate --auto=yes callgrind.out.<pid> > hi
10-Feb-10 (full snd-test, not just test 23):
-372,028,372,850 PROGRAM TOTALS
+372,028,372,850
45,638,227,518 io.c:mus_read_any_1 [/home/bil/snd-11/snd]
44,386,146,639 s7.c:eval [/home/bil/snd-11/snd]
26,599,493,642 s7.c:eval'2 [/home/bil/snd-11/snd]
@@ -63785,42 +49219,8 @@ callgrind_annotate --auto=yes callgrind.out.<pid> > hi
14,486,041,393 snd-sig.c:direct_filter [/home/bil/snd-11/snd]
10,836,543,187 run.c:eval_ptree [/home/bil/snd-11/snd]
-7-Mar-10
-318,148,021,968 PROGRAM TOTALS
-40,864,919,790 s7.c:eval [/home/bil/snd-s7/snd]
-26,485,168,742 io.c:mus_read_any_1 [/home/bil/snd-s7/snd]
-24,338,113,084 s7.c:eval'2 [/home/bil/snd-s7/snd]
-21,345,385,043 snd-edits.c:next_sample_value_unscaled [/home/bil/snd-s7/snd]
-18,089,464,229 snd-edits.c:channel_local_maxamp [/home/bil/snd-s7/snd]
-16,230,371,673 s7.c:gc [/home/bil/snd-s7/snd]
-10,973,188,812 io.c:mus_write_1 [/home/bil/snd-s7/snd]
-10,939,541,547 run.c:eval_ptree [/home/bil/snd-s7/snd]
-8,918,483,945 snd-sig.c:direct_filter [/home/bil/snd-s7/snd]
-
-24-Jul-10
-290,992,535,136 PROGRAM TOTALS
-41,408,289,112 s7.c:eval [/home/bil/snd-11/snd]
-32,616,883,526 s7.c:eval'2 [/home/bil/snd-11/snd]
-25,031,312,834 snd-edits.c:channel_local_maxamp [/home/bil/snd-11/snd]
-20,823,611,841 io.c:mus_read_any_1 [/home/bil/snd-11/snd]
-15,322,708,021 s7.c:gc [/home/bil/snd-11/snd]
-10,968,070,604 io.c:mus_write_1 [/home/bil/snd-11/snd]
-10,030,190,974 run.c:eval_ptree [/home/bil/snd-11/snd]
- 8,918,483,905 snd-sig.c:direct_filter [/home/bil/snd-11/snd]
-
-15-Oct-10
-265,752,846,149 PROGRAM TOTALS
-34,814,887,043 s7.c:eval [/home/bil/test-snd/snd]
-26,289,382,435 s7.c:eval'2 [/home/bil/test-snd/snd]
-24,643,766,551 snd-edits.c:channel_local_maxamp [/home/bil/test-snd/snd]
-21,181,140,399 io.c:mus_read_any_1 [/home/bil/test-snd/snd]
-12,896,421,436 s7.c:gc [/home/bil/test-snd/snd]
-10,979,592,154 io.c:mus_write_1 [/home/bil/test-snd/snd]
-10,045,760,800 run.c:eval_ptree [/home/bil/test-snd/snd]
- 8,918,483,905 snd-sig.c:direct_filter [/home/bil/test-snd/snd]
-
10-Dec-10 (64-bit)
-224,005,122,781 PROGRAM TOTALS
+224,005,122,781
32,349,320,555 s7.c:eval [/home/bil/snd-11/snd]
24,560,182,751 s7.c:eval'2 [/home/bil/snd-11/snd]
19,534,468,570 ???:sin [/lib64/libm-2.12.so]
@@ -63829,6 +49229,179 @@ callgrind_annotate --auto=yes callgrind.out.<pid> > hi
11,175,405,494 s7.c:gc [/home/bil/snd-11/snd]
8,937,855,502 run.c:eval_ptree [/home/bil/snd-11/snd]
8,913,093,185 snd-sig.c:direct_filter [/home/bil/snd-11/snd]
+
+14-Dec-11:
+153,472,402,051
+15,964,352,672 ???:sin [/lib64/libm-2.12.so]
+15,349,566,001 io.c:mus_read_any_1 [/home/bil/snd-16/snd]
+ 9,724,315,504 s7.c:eval [/home/bil/snd-16/snd]
+ 9,340,050,109 snd-edits.c:channel_local_maxamp [/home/bil/snd-16/snd]
+ 8,904,652,480 snd-sig.c:direct_filter [/home/bil/snd-16/snd]
+ 8,727,766,020 run.c:eval_ptree [/home/bil/snd-16/snd]
+ 7,219,826,287 io.c:mus_write_1 [/home/bil/snd-16/snd]
+ 5,925,019,812 s7.c:eval'2 [/home/bil/snd-16/snd]
+ 2,960,895,840 clm.c:mus_fir_filter [/home/bil/snd-16/snd]
+ 2,765,667,308 clm.c:mus_out_any_to_file [/home/bil/snd-16/snd]
+ 2,732,722,538 ???:cos [/lib64/libm-2.12.so]
+ 2,654,002,973 clm.c:mus_src [/home/bil/snd-16/snd]
+ 2,216,029,830 s7.c:find_symbol_or_bust [/home/bil/snd-16/snd]
+ 2,051,926,172 s7.c:gc [/home/bil/snd-16/snd]
+
+2-Jul-12:
+152,015,041,884
+15,958,491,763 ???:sin [/lib64/libm-2.12.so]
+14,742,080,012 io.c:mus_read_any_1 [/home/bil/snd-16/snd]
+10,457,919,006 s7.c:eval [/home/bil/snd-16/snd]
+ 9,312,647,839 snd-edits.c:channel_local_maxamp [/home/bil/snd-16/snd]
+ 8,913,093,185 snd-sig.c:direct_filter [/home/bil/snd-16/snd]
+ 8,725,479,212 run.c:eval_ptree [/home/bil/snd-16/snd]
+ 7,219,930,929 io.c:mus_write_1 [/home/bil/snd-16/snd]
+ 4,366,174,949 s7.c:eval'2 [/home/bil/snd-16/snd]
+ 3,042,551,502 clm.c:mus_src [/home/bil/snd-16/snd]
+ 2,960,895,840 clm.c:mus_fir_filter [/home/bil/snd-16/snd]
+ 2,762,641,235 clm.c:mus_out_any_to_file [/home/bil/snd-16/snd]
+ 2,745,046,475 ???:cos [/lib64/libm-2.12.so]
+ 2,227,836,598 s7.c:find_symbol_or_bust [/home/bil/snd-16/snd]
+ 1,839,006,887 s7.c:gc [/home/bil/snd-16/snd]
+ 1,306,950,910 run.c:eval_ptree'2 [/home/bil/snd-16/snd]
+ 1,273,733,564 ???:t2_32 [/home/bil/snd-16/snd]
+ 1,259,047,832 clm.c:mus_formant_bank [/home/bil/snd-16/snd]
+ 1,204,213,789 snd-edits.c:next_sample_value [/home/bil/snd-16/snd]
+ 1,129,624,275 clm.c:mus_ssb_am_unmodulated [/home/bil/snd-16/snd]
+ 1,116,765,922 clm.c:mus_phase_vocoder_with_editors [/home/bil/snd-16/snd]
+
+6-Jul-12:
+314,557,435,854
+96,266,822,080 s7.c:eval [/home/bil/snd-16/snd]
+20,140,459,790 s7.c:find_symbol_or_bust [/home/bil/snd-16/snd]
+15,094,536,285 ???:sin [/lib64/libm-2.12.so]
+14,561,228,879 io.c:mus_read_any_1 [/home/bil/snd-16/snd]
+13,267,844,138 s7.c:gc [/home/bil/snd-16/snd]
+10,735,806,413 s7.c:s7_make_real [/home/bil/snd-16/snd]
+ 9,597,104,099 snd-edits.c:channel_local_maxamp [/home/bil/snd-16/snd]
+ 8,903,732,430 snd-sig.c:direct_filter [/home/bil/snd-16/snd]
+ 8,756,184,253 s7.c:eval'2 [/home/bil/snd-16/snd]
+ 6,939,439,659 io.c:mus_write_1 [/home/bil/snd-16/snd]
+ 4,221,129,319 s7.c:g_add [/home/bil/snd-16/snd]
+ 3,790,496,511 s7.c:g_multiply_2 [/home/bil/snd-16/snd]
+ 2,960,895,524 clm.c:mus_fir_filter [/home/bil/snd-16/snd]
+ 2,866,346,964 s7.c:g_equal_2 [/home/bil/snd-16/snd]
+ 2,647,149,349 clm.c:mus_src [/home/bil/snd-16/snd]
+ 2,373,255,704 s7.c:g_add_2 [/home/bil/snd-16/snd]
+ 2,365,017,452 s7.c:g_add_1s [/home/bil/snd-16/snd]
+ 2,014,711,657 ???:cos [/lib64/libm-2.12.so]
+
+23-Apr-13:
+52,886,592,302
+6,697,050,795 s7.c:eval [/home/bil/snd-16/snd]
+6,228,616,918 ???:sin [/lib64/libm-2.12.so]
+2,546,631,823 clm.c:mus_src [/home/bil/snd-16/snd]
+2,496,647,180 ???:cos [/lib64/libm-2.12.so]
+2,176,750,987 s7.c:find_symbol_or_bust [/home/bil/snd-16/snd]
+1,263,726,083 s7.c:eval'2 [/home/bil/snd-16/snd]
+1,248,608,065 s7.c:gc [/home/bil/snd-16/snd]
+1,021,282,278 io.c:mus_read_any_1 [/home/bil/snd-16/snd]
+1,003,986,022 clm.c:mus_phase_vocoder_with_editors [/home/bil/snd-16/snd]
+ 933,290,098 clm.c:mus_formant_bank [/home/bil/snd-16/snd]
+ 911,248,552 clm.c:fir_8 [/home/bil/snd-16/snd]
+ 885,305,356 ???:t2_32 [/home/bil/snd-16/snd]
+ 796,412,317 snd-edits.c:channel_local_maxamp [/home/bil/snd-16/snd]
+ 785,981,295 ???:t2_64 [/home/bil/snd-16/snd]
+ 693,360,038 clm.c:run_hilbert [/home/bil/snd-16/snd]
+ 507,150,000 clm.c:mus_formant_bank_with_inputs [/home/bil/snd-16/snd]
+ 459,853,855 clm.c:mus_src_20 [/home/bil/snd-16/snd]
+ 449,476,048 ???:n1_64 [/home/bil/snd-16/snd]
+ 444,970,752 io.c:mus_write_1 [/home/bil/snd-16/snd]
+ 428,928,818 float-vector.c:g_float-vector_add [/home/bil/snd-16/snd]
+
+27-Apr-14:
+35,390,341,125
+5,444,441,772 s7.c:eval [/home/bil/gtk-snd/snd]
+2,255,959,839 ???:sin [/lib64/libm-2.12.so]
+2,027,776,135 ???:cos [/lib64/libm-2.12.so]
+1,266,976,906 clm.c:fir_ge_20 [/home/bil/gtk-snd/snd]
+1,041,138,903 clm.c:mus_src [/home/bil/gtk-snd/snd]
+ 886,288,100 ???:t2_32 [/home/bil/gtk-snd/snd]
+ 784,981,866 s7.c:gc [/home/bil/gtk-snd/snd]
+ 781,643,274 ???:t2_64 [/home/bil/gtk-snd/snd]
+ 653,499,001 snd-edits.c:channel_local_maxamp [/home/bil/gtk-snd/snd]
+ 648,406,214 clm.c:mus_phase_vocoder_with_editors [/home/bil/gtk-snd/snd]
+ 592,801,688 clm.c:fb_one_with_amps_c1_c2 [/home/bil/gtk-snd/snd]
+ 558,124,334 io.c:mus_read_any_1 [/home/bil/gtk-snd/snd]
+ 449,476,076 ???:n1_64 [/home/bil/gtk-snd/snd]
+ 418,857,421 s7.c:eval'2 [/home/bil/gtk-snd/snd]
+ 414,027,948 vct.c:g_vct_add [/home/bil/gtk-snd/snd]
+ 394,639,129 clm.c:mus_src_to_buffer [/home/bil/gtk-snd/snd]
+ 372,681,428 clm.c:mus_env_linear [/home/bil/gtk-snd/snd]
+ 338,359,320 clm.c:run_hilbert [/home/bil/gtk-snd/snd]
+ 327,141,926 clm.c:fb_many_with_amps_c1_c2 [/home/bil/gtk-snd/snd]
+
+14-Aug-14:
+35,133,061,231
+5,365,681,646 s7.c:eval [/home/bil/gtk-snd/snd]
+2,256,581,832 ???:sin [/lib64/libm-2.12.so]
+2,050,537,059 ???:cos [/lib64/libm-2.12.so]
+1,266,976,906 clm.c:fir_ge_20 [/home/bil/gtk-snd/snd]
+1,095,141,759 clm.c:mus_src [/home/bil/gtk-snd/snd]
+ 901,140,028 ???:t2_32 [/home/bil/gtk-snd/snd]
+ 795,199,572 s7.c:gc [/home/bil/gtk-snd/snd]
+ 720,395,914 ???:t2_64 [/home/bil/gtk-snd/snd]
+ 648,414,838 clm.c:mus_phase_vocoder_with_editors [/home/bil/gtk-snd/snd]
+ 592,801,688 clm.c:fb_one_with_amps_c1_c2 [/home/bil/gtk-snd/snd]
+ 573,460,056 snd-edits.c:channel_local_maxamp [/home/bil/gtk-snd/snd]
+ 557,892,664 io.c:mus_read_any_1 [/home/bil/gtk-snd/snd]
+ 452,423,080 s7.c:eval'2 [/home/bil/gtk-snd/snd]
+ 435,066,604 ???:n1_64 [/home/bil/gtk-snd/snd]
+ 414,027,948 vct.c:g_vct_add [/home/bil/gtk-snd/snd]
+ 405,194,494 clm.c:mus_src_to_buffer [/home/bil/gtk-snd/snd]
+ 379,588,776 clm.c:mus_env_linear [/home/bil/gtk-snd/snd]
+ 338,359,320 clm.c:run_hilbert [/home/bil/gtk-snd/snd]
+ 327,141,926 clm.c:fb_many_with_amps_c1_c2 [/home/bil/gtk-snd/snd]
+
+18-Jan-15:
+34,313,456,123
+5,020,772,013 s7.c:eval [/home/bil/motif-snd/snd]
+2,260,969,439 ???:sin [/lib64/libm-2.12.so]
+2,034,364,836 ???:cos [/lib64/libm-2.12.so]
+1,267,013,962 clm.c:fir_ge_20 [/home/bil/motif-snd/snd]
+1,031,565,836 clm.c:mus_src [/home/bil/motif-snd/snd]
+ 902,070,908 ???:t2_32 [/home/bil/motif-snd/snd]
+ 736,726,776 ???:t2_64 [/home/bil/motif-snd/snd]
+ 703,948,457 s7.c:gc [/home/bil/motif-snd/snd]
+ 638,189,523 clm.c:mus_phase_vocoder_with_editors [/home/bil/motif-snd/snd]
+ 602,023,066 snd-edits.c:channel_local_maxamp [/home/bil/motif-snd/snd]
+ 594,199,460 clm.c:fb_one_with_amps_c1_c2 [/home/bil/motif-snd/snd]
+ 488,422,860 io.c:mus_read_any_1 [/home/bil/motif-snd/snd]
+ 439,946,024 ???:n1_64 [/home/bil/motif-snd/snd]
+ 428,393,510 s7.c:eval'2 [/home/bil/motif-snd/snd]
+ 414,054,253 vct.c:g_vct_add [/home/bil/motif-snd/snd]
+ 365,408,166 clm.c:mus_env_linear [/home/bil/motif-snd/snd]
+ 362,204,844 clm.c:mus_src_to_buffer [/home/bil/motif-snd/snd]
+ 345,704,896 clm.c:run_hilbert [/home/bil/motif-snd/snd]
+ 330,406,288 clm.c:fb_many_with_amps_c1_c2 [/home/bil/motif-snd/snd]
+
+15-Feb-15:
+33,895,270,323
+5,048,563,075 s7.c:eval [/home/bil/motif-snd/snd]
+2,109,026,775 ???:sin [/lib64/libm-2.12.so]
+2,024,119,795 ???:cos [/lib64/libm-2.12.so]
+1,267,013,962 clm.c:fir_ge_20 [/home/bil/motif-snd/snd]
+1,033,000,931 clm.c:mus_src [/home/bil/motif-snd/snd]
+ 902,016,316 ???:t2_32 [/home/bil/motif-snd/snd]
+ 736,981,999 ???:t2_64 [/home/bil/motif-snd/snd]
+ 698,073,576 s7.c:gc [/home/bil/motif-snd/snd]
+ 627,011,081 clm.c:mus_phase_vocoder_with_editors [/home/bil/motif-snd/snd]
+ 594,199,460 clm.c:fb_one_with_amps_c1_c2 [/home/bil/motif-snd/snd]
+ 584,394,041 snd-edits.c:channel_local_maxamp [/home/bil/motif-snd/snd]
+ 489,621,727 io.c:mus_read_any_1 [/home/bil/motif-snd/snd]
+ 440,021,064 ???:n1_64 [/home/bil/motif-snd/snd]
+ 434,398,893 s7.c:eval'2 [/home/bil/motif-snd/snd]
+ 412,021,596 vct.c:g_vct_add [/home/bil/motif-snd/snd]
+ 379,620,192 clm.c:mus_src_to_buffer [/home/bil/motif-snd/snd]
+ 358,009,460 clm.c:mus_env_linear [/home/bil/motif-snd/snd]
+ 345,704,896 clm.c:run_hilbert [/home/bil/motif-snd/snd]
+ 330,406,288 clm.c:fb_many_with_amps_c1_c2 [/home/bil/motif-snd/snd]
+
|#
diff --git a/snd-trans.c b/snd-trans.c
index 558dd01..f08d4ba 100644
--- a/snd-trans.c
+++ b/snd-trans.c
@@ -1,6 +1,7 @@
/* translate various special case sound files to something we can edit
- *
- * I'm ignoring proprietary or licensed schemes even where the code is publicly available (Rockwell ADPCM, shorten, etc)
+ * (this code is going away...)
+ *
+ * I'm ignoring proprietary or licensed schemes even where the code is publicly available (Rockwell ADPCM, etc)
*
* currently supported:
* IEEE text
@@ -12,7 +13,6 @@
* Oki (Dialogic) ADPCM (RIFF)
* IBM ADPCM (as per Perry Cook)
* Yamaha TX-16 12-bit
- * NeXT/Sun G721, G723 3 and 5 bit versions (also RIFF) (AIFC cases could be handled if they exist)
*
* libavcodec has an amazing number of decoders -- are these useful in this context?
* also libmpcodecs (available with MPlayer)
@@ -20,45 +20,36 @@
#include "snd.h"
-
-/* from io.c, but no longer in sndlib.h */
-void mus_bint_to_char(unsigned char *j, int x);
-void mus_bshort_to_char(unsigned char *j, short x);
-int mus_char_to_bint(const unsigned char *inp);
-short mus_char_to_bshort(const unsigned char *inp);
-short mus_char_to_lshort(const unsigned char *inp);
-
-
#define TRANS_BUF_SIZE 8192
static char write_error_buffer[PRINT_BUFFER_SIZE];
-static ssize_t snd_checked_write(int fd, unsigned char *buf, ssize_t bytes, const char *filename)
+static long long int snd_checked_write(int fd, unsigned char *buf, long long int bytes, const char *filename)
{
/* io.c checked_write assumes its file descriptors are around */
/* can't call mus_error here because we need to clean up first in case of error */
- ssize_t bytes_written;
+ long long int bytes_written;
mus_long_t kfree;
- kfree = disk_kspace(filename);
+ kfree = (long long int)disk_kspace(filename);
if (kfree < 0)
{
- mus_snprintf(write_error_buffer, PRINT_BUFFER_SIZE,
+ snprintf(write_error_buffer, PRINT_BUFFER_SIZE,
"no space left on device: %s",
snd_io_strerror());
return(MUS_ERROR);
}
if (kfree < (bytes >> 10))
{
- mus_snprintf(write_error_buffer, PRINT_BUFFER_SIZE,
- "only " MUS_LD " bytes left on device (we need " SSIZE_TD " bytes)",
+ snprintf(write_error_buffer, PRINT_BUFFER_SIZE,
+ "only %lld bytes left on device (we need %lld bytes)",
kfree << 10, bytes);
return(MUS_ERROR);
}
bytes_written = write(fd, buf, bytes);
if (bytes_written != bytes)
{
- mus_snprintf(write_error_buffer, PRINT_BUFFER_SIZE,
- "write error (wrote " SSIZE_TD " of requested " SSIZE_TD " bytes): %s",
+ snprintf(write_error_buffer, PRINT_BUFFER_SIZE,
+ "write error (wrote %lld of requested %lld bytes): %s",
bytes_written, bytes, snd_io_strerror());
return(MUS_ERROR);
}
@@ -70,10 +61,10 @@ static int be_snd_checked_write(int fd, unsigned char *buf, int bytes, const cha
{
/* handle little-endian swap if necessary */
#if MUS_LITTLE_ENDIAN
- unsigned char tmp;
int i;
for (i = 0; i < bytes; i += 2)
{
+ unsigned char tmp;
tmp = buf[i];
buf[i] = buf[i + 1];
buf[i + 1] = tmp;
@@ -83,10 +74,9 @@ static int be_snd_checked_write(int fd, unsigned char *buf, int bytes, const cha
}
-#define RETURN_MUS_IO_ERROR(IO_Func, IO_Name) return(mus_error(MUS_CANT_OPEN_FILE, "translator: %s(%s) %s", IO_Func, IO_Name, snd_io_strerror()))
-
+#define return_mus_io_error(IO_Func, IO_Name) return(mus_error(MUS_CANT_OPEN_FILE, "translator: %s(%s) %s", IO_Func, IO_Name, snd_io_strerror()))
-#define RETURN_MUS_WRITE_ERROR(OldName, NewName) \
+#define return_mus_write_error(OldName, NewName) \
do { \
mus_error(MUS_WRITE_ERROR, "can't translate %s to %s:\n %s", OldName, NewName, write_error_buffer); \
write_error_buffer[0] = '\0'; \
@@ -94,8 +84,7 @@ static int be_snd_checked_write(int fd, unsigned char *buf, int bytes, const cha
} \
while (false)
-
-#define RETURN_MUS_ALLOC_ERROR(OldName, Bytes, VariableName) \
+#define return_mus_alloc_error(OldName, Bytes, VariableName) \
return(mus_error(MUS_MEMORY_ALLOCATION_FAILED, "translate %s: can't allocate %d bytes for %s", OldName, Bytes, VariableName))
@@ -113,18 +102,18 @@ static int be_snd_checked_write(int fd, unsigned char *buf, int bytes, const cha
#define STARTUP(OldName, NewName, BufSize, BufType) \
do { \
fs = CREAT(NewName, 0666); \
- if (fs == -1) RETURN_MUS_IO_ERROR("create", NewName); \
+ if (fs == -1) return_mus_io_error("create", NewName); \
fd = OPEN(OldName, O_RDONLY, 0); \
if (fd == -1) \
{ \
CLEANUP(OldName, NewName); \
- RETURN_MUS_IO_ERROR("open", OldName); \
+ return_mus_io_error("open", OldName); \
} \
buf = (BufType *)calloc(BufSize, sizeof(BufType)); \
if (buf == NULL) \
{ \
CLEANUP(OldName, NewName); \
- RETURN_MUS_ALLOC_ERROR(OldName, BufSize, "buf"); \
+ return_mus_alloc_error(OldName, BufSize, "buf"); \
} \
} \
while (false)
@@ -162,7 +151,7 @@ static int read_midi_sample_dump(const char *oldname, const char *newname, char
if (snd_checked_write(fs, (unsigned char *)hdr, 28, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
happy = true;
inp = 21;
@@ -201,7 +190,7 @@ static int read_midi_sample_dump(const char *oldname, const char *newname, char
if (snd_checked_write(fs, (unsigned char *)hdr, TRANS_BUF_SIZE, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
osp = 0;
outp = 0;
@@ -255,7 +244,7 @@ static int read_midi_sample_dump(const char *oldname, const char *newname, char
}
if (outp > 0) err = snd_checked_write(fs, (unsigned char *)hdr, outp, newname);
CLEANUP(oldname, newname);
- if (err == MUS_ERROR) RETURN_MUS_WRITE_ERROR(oldname, newname);
+ if (err == MUS_ERROR) return_mus_write_error(oldname, newname);
return(MUS_NO_ERROR);
}
@@ -297,7 +286,7 @@ static int read_ieee_text(const char *oldname, const char *newname, char *hdr)
{
for (i = op + 15, j = 0; j < 6; i++, j++) str[j] = buf[i];
str[6] = '\0';
- sscanf(str, "%f", &fsrate);
+ sscanf(str, "%6f", &fsrate);
srate = (int)(fsrate * 1000);
}
else
@@ -306,7 +295,7 @@ static int read_ieee_text(const char *oldname, const char *newname, char *hdr)
{
for (i = op + 15, j = 0; j < 6; i++, j++) str[j] = buf[i];
str[6] = '\0';
- sscanf(str, "%d", &srate);
+ sscanf(str, "%6d", &srate);
}
}
}
@@ -338,7 +327,7 @@ static int read_ieee_text(const char *oldname, const char *newname, char *hdr)
if (snd_checked_write(fs, (unsigned char *)hdr, outp, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
happy = true;
s0 = 0;
@@ -361,7 +350,7 @@ static int read_ieee_text(const char *oldname, const char *newname, char *hdr)
if (snd_checked_write(fs, (unsigned char *)hdr, TRANS_BUF_SIZE, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
osp = 0;
outp = 0;
@@ -371,7 +360,7 @@ static int read_ieee_text(const char *oldname, const char *newname, char *hdr)
if (buf[inp] == '\n')
{
str[s0] = '\0';
- sscanf(str, "%d", &j);
+ sscanf(str, "%12d", &j);
mus_bshort_to_char((unsigned char *)(hdr + osp), (short)j);
osp += 2;
outp += 2;
@@ -389,7 +378,7 @@ static int read_ieee_text(const char *oldname, const char *newname, char *hdr)
err = snd_checked_write(fs, (unsigned char *)hdr, outp, newname);
/* update size field? */
CLEANUP(oldname, newname);
- if (err == MUS_ERROR) RETURN_MUS_WRITE_ERROR(oldname, newname);
+ if (err == MUS_ERROR) return_mus_write_error(oldname, newname);
return(MUS_NO_ERROR);
}
@@ -435,7 +424,7 @@ static int read_mus10(const char *oldname, const char *newname, char *hdr)
if ((mode != 4) && (mode != 0))
{
CLEANUP(oldname, newname);
- return(mus_error(MUS_UNSUPPORTED_DATA_FORMAT,
+ return(mus_error(MUS_UNSUPPORTED_SAMPLE_TYPE,
"read_mus10: can't translate Mus10 file %s:\n mode = %d\n",
oldname, mode));
}
@@ -445,7 +434,7 @@ static int read_mus10(const char *oldname, const char *newname, char *hdr)
if (snd_checked_write(fs, (unsigned char *)hdr, 28, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
happy = true;
outp = 0;
@@ -467,7 +456,7 @@ static int read_mus10(const char *oldname, const char *newname, char *hdr)
if (snd_checked_write(fs, (unsigned char *)hdr, TRANS_BUF_SIZE, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
osp = 0;
outp = 0;
@@ -501,7 +490,7 @@ static int read_mus10(const char *oldname, const char *newname, char *hdr)
}
err = snd_checked_write(fs, (unsigned char *)hdr, outp, newname);
CLEANUP(oldname, newname);
- if (err == MUS_ERROR) RETURN_MUS_WRITE_ERROR(oldname, newname);
+ if (err == MUS_ERROR) return_mus_write_error(oldname, newname);
return(MUS_NO_ERROR);
}
@@ -524,7 +513,7 @@ static int read_hcom(const char *oldname, const char *newname, char *hdr)
if (snd_checked_write(fs, (unsigned char *)hdr, 28, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
lseek(fd, 132, SEEK_SET);
bytes = read(fd, buf, 18); /* count sum type div size */
@@ -540,7 +529,7 @@ static int read_hcom(const char *oldname, const char *newname, char *hdr)
{
if (d) free(d);
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname); /* read actually, but it's a generic message */
+ return_mus_write_error(oldname, newname); /* read actually, but it's a generic message */
}
osp = 0;
for (i = 0; i < size; i++)
@@ -577,7 +566,7 @@ static int read_hcom(const char *oldname, const char *newname, char *hdr)
for (i = 0; i < size; i++) free(d[i]);
free(d);
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
osp = 0;
outp = 0;
@@ -611,7 +600,7 @@ static int read_hcom(const char *oldname, const char *newname, char *hdr)
for (i = 0; i < size; i++) free(d[i]);
free(d);
CLEANUP(oldname, newname);
- if (err == MUS_ERROR) RETURN_MUS_WRITE_ERROR(oldname, newname);
+ if (err == MUS_ERROR) return_mus_write_error(oldname, newname);
return(MUS_NO_ERROR);
}
@@ -638,7 +627,7 @@ static int read_nist_shortpack(const char *oldname, const char *newname, char *h
if (snd_checked_write(fs, (unsigned char *)hdr, 28, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
lseek(fd, 1024, SEEK_SET); /* NIST header always 1024 bytes */
totalin = read(fd, buf, TRANS_BUF_SIZE);
@@ -743,7 +732,7 @@ static int read_nist_shortpack(const char *oldname, const char *newname, char *h
if (snd_checked_write(fs, (unsigned char *)hdr, TRANS_BUF_SIZE, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
osp = 0;
outp = 0;
@@ -751,7 +740,7 @@ static int read_nist_shortpack(const char *oldname, const char *newname, char *h
}
err = snd_checked_write(fs, (unsigned char *)hdr, outp, newname);
CLEANUP(oldname, newname);
- if (err == MUS_ERROR) RETURN_MUS_WRITE_ERROR(oldname, newname);
+ if (err == MUS_ERROR) return_mus_write_error(oldname, newname);
return(MUS_NO_ERROR);
}
@@ -778,7 +767,7 @@ static int read_ibm_adpcm(const char *oldname, const char *newname, char *hdr)
if (snd_checked_write(fs, (unsigned char *)hdr, 28, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
lseek(fd, loc, SEEK_SET);
buf1 = (short *)calloc(TRANS_BUF_SIZE, sizeof(short));
@@ -810,7 +799,7 @@ static int read_ibm_adpcm(const char *oldname, const char *newname, char *hdr)
{
free(buf1);
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
}
free(buf1);
@@ -821,7 +810,7 @@ static int read_ibm_adpcm(const char *oldname, const char *newname, char *hdr)
/* -------------------------------- Intel ADPCM --------------------------------
*
- * described in detail Microsoft RIFF docs. This code assumes bits = 4.
+ * described in detail in the Microsoft RIFF docs. This code assumes bits = 4.
* in 'wave' file, these are stored as block_align sized blocks, each with a
* header storing the current state. These can be multi-channel, but we're handling
* only mono until someone complains. See also Apple Tech note 1081 by Mark Cookson.
@@ -839,7 +828,7 @@ static int stepsizeTable[89] = {7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 19, 21, 23,
static int adpcm_decoder(unsigned char *indata, short *outdata, int totalbytes, int type)
{
unsigned int delta, inputbuffer = 0;
- int step, valpred, vpdiff, index, i, j;
+ int valpred, index, i, j;
bool happy;
bool bufferstep = false;
happy = true;
@@ -859,6 +848,7 @@ static int adpcm_decoder(unsigned char *indata, short *outdata, int totalbytes,
outdata[0] = valpred;
while (happy)
{
+ int step, vpdiff;
if (bufferstep)
{
delta = inputbuffer & 0xf;
@@ -887,7 +877,7 @@ static int adpcm_decoder(unsigned char *indata, short *outdata, int totalbytes,
static int read_dvi_adpcm(const char *oldname, const char *newname, char *hdr, int type)
{
- int fs = -1, fd = -1, chans, srate, blksiz, samps, samps_read;
+ int fs = -1, fd = -1, chans, srate, blksiz, samps;
unsigned char *buf = NULL;
mus_long_t loc;
loc = mus_sound_data_location(oldname);
@@ -895,7 +885,7 @@ static int read_dvi_adpcm(const char *oldname, const char *newname, char *hdr, i
blksiz = mus_sound_block_align(oldname);
samps = mus_sound_fact_samples(oldname);
if ((chans != 1) || (mus_sound_bits_per_sample(oldname) != 4))
- return(mus_error(MUS_UNSUPPORTED_DATA_FORMAT,
+ return(mus_error(MUS_UNSUPPORTED_SAMPLE_TYPE,
"read_dvi_adpcm: can't translate DVI ADPCM file %s: chans: %d and bits: %d\n",
oldname, chans, mus_sound_bits_per_sample(oldname)));
srate = mus_sound_srate(oldname);
@@ -905,12 +895,12 @@ static int read_dvi_adpcm(const char *oldname, const char *newname, char *hdr, i
if (snd_checked_write(fs, (unsigned char *)hdr, 28, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
lseek(fd, loc, SEEK_SET);
- samps_read = 0;
while (samps > 0)
{
+ int samps_read;
ssize_t totalin;
totalin = read(fd, buf, blksiz);
if (totalin < blksiz) break;
@@ -918,7 +908,7 @@ static int read_dvi_adpcm(const char *oldname, const char *newname, char *hdr, i
if (be_snd_checked_write(fs, (unsigned char *)hdr, samps_read * 2, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
samps -= samps_read;
}
@@ -969,15 +959,14 @@ static short oki_adpcm_decode(char code, struct oki_adpcm_status *stat)
static int read_oki_adpcm(const char *oldname, const char *newname, char *hdr)
{
- int fs = -1, fd = -1, i, j, chans, srate, blksiz, samps, samps_read;
- ssize_t totalin;
+ int fs = -1, fd = -1, i, j, chans, srate, blksiz, samps;
unsigned char *buf = NULL;
mus_long_t loc;
short *buf1;
struct oki_adpcm_status stat;
chans = mus_sound_chans(oldname);
if (chans != 1)
- return(mus_error(MUS_UNSUPPORTED_DATA_FORMAT,
+ return(mus_error(MUS_UNSUPPORTED_SAMPLE_TYPE,
"read_oki_adpcm: can't translate Oki ADPCM file %s: chans: %d\n",
oldname, chans));
loc = mus_sound_data_location(oldname);
@@ -986,7 +975,7 @@ static int read_oki_adpcm(const char *oldname, const char *newname, char *hdr)
STARTUP(oldname, newname, blksiz, unsigned char);
buf1 = (short *)calloc(blksiz * 2, sizeof(short));
samps = mus_sound_fact_samples(oldname);
- if (samps == 0) samps = (int)mus_sound_frames(oldname);
+ if (samps == 0) samps = (int)mus_sound_framples(oldname);
srate = mus_sound_srate(oldname);
mus_bint_to_char((unsigned char *)(hdr + 16), srate);
mus_bint_to_char((unsigned char *)(hdr + 20), chans);
@@ -994,14 +983,15 @@ static int read_oki_adpcm(const char *oldname, const char *newname, char *hdr)
{
free(buf1);
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
lseek(fd, loc, SEEK_SET);
- samps_read = 0;
stat.last = 0;
stat.step_index = 0;
while (samps > 0)
{
+ int samps_read;
+ ssize_t totalin;
totalin = read(fd, buf, blksiz);
if (totalin <= 0) break;
for (i = 0, j = 0; i < totalin; i++)
@@ -1015,7 +1005,7 @@ static int read_oki_adpcm(const char *oldname, const char *newname, char *hdr)
{
free(buf1);
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
samps -= samps_read;
}
@@ -1032,7 +1022,6 @@ static int read_oki_adpcm(const char *oldname, const char *newname, char *hdr)
static int read_12bit(const char *oldname, const char *newname, char *hdr)
{
int chans, i, j, fs = -1, fd = -1;
- ssize_t totalin;
unsigned char *buf = NULL;
short *buf1;
mus_long_t loc, samps;
@@ -1045,12 +1034,13 @@ static int read_12bit(const char *oldname, const char *newname, char *hdr)
if (snd_checked_write(fs, (unsigned char *)hdr, 28, newname) == MUS_ERROR)
{
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
lseek(fd, loc, SEEK_SET);
buf1 = (short *)calloc(TRANS_BUF_SIZE, sizeof(short));
while (samps > 0)
{
+ ssize_t totalin;
totalin = read(fd, buf, (int)(TRANS_BUF_SIZE * 1.5));
if (totalin <= 0) break;
for (i = 0, j = 0; i < totalin; i += 3, j += 2)
@@ -1062,7 +1052,7 @@ static int read_12bit(const char *oldname, const char *newname, char *hdr)
{
free(buf1);
CLEANUP(oldname, newname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
samps -= j;
}
@@ -1072,30 +1062,75 @@ static int read_12bit(const char *oldname, const char *newname, char *hdr)
}
+#if G7XX
/* -------------------------------- G721 and G723 from Sun --------------------------------
* code boiled down considerably here since I have no love of compression schemes.
*/
struct g72x_state {long yl; short yu; short dms; short dml; short ap; short a[2]; short b[6]; short pk[2]; short dq[6]; short sr[2]; char td;};
-static short power2[15] = {1, 2, 4, 8, 0x10, 0x20, 0x40, 0x80, 0x100, 0x200, 0x400, 0x800, 0x1000, 0x2000, 0x4000};
-
-static int quan(int val, short *table, int size)
+static int quan(short val)
{
- int i;
- for (i = 0; i < size; i++)
- if (val < *table++) break;
- return(i);
+#if 0
+ if (val >= 16384) return(15);
+ if (val >= 8192) return(14);
+ if (val >= 4096) return(13);
+ if (val >= 2048) return(12);
+ if (val >= 1024) return(11);
+ if (val >= 512) return(10);
+ if (val >= 256) return(9);
+ if (val >= 128) return(8);
+ if (val >= 64) return(7);
+ if (val >= 32) return(6);
+ if (val >= 16) return(5);
+ if (val >= 8) return(4);
+ if (val >= 4) return(3);
+ if (val >= 2) return(2);
+ if (val >= 1) return(1);
+ return(0);
+#else
+ if (val >= 256)
+ {
+ if (val >= 1024)
+ {
+ if (val >= 4096)
+ {
+ if (val >= 16384) return(15);
+ if (val >= 8192) return(14);
+ return(13);
+ }
+ if (val >= 2048) return(12);
+ return(11);
+ }
+ if (val >= 512) return(10);
+ return(9);
+ }
+ if (val >= 8)
+ {
+ if (val >= 64)
+ {
+ if (val >= 128) return(8);
+ return(7);
+ }
+ if (val >= 32) return(6);
+ if (val >= 16) return(5);
+ return(4);
+ }
+ if (val >= 4) return(3);
+ if (val >= 2) return(2);
+ if (val >= 1) return(1);
+ return(0);
+#endif
}
static int fmult(int an, int srn)
{
- short anmag, anexp, anmant;
- short wanexp, wanmant;
- short retval;
+ short anmag, anexp, anmant;
+ short wanexp, wanmant;
+ short retval;
anmag = (an > 0) ? an : ((-an) & 0x1FFF);
- anexp = quan(anmag, power2, 15) - 6;
+ anexp = quan(anmag) - 6;
anmant = (anmag == 0) ? 32 : (anexp >= 0) ? anmag >> anexp : anmag << -anexp;
wanexp = anexp + ((srn >> 6) & 0xF) - 13;
wanmant = (anmant * (srn & 077) + 0x30) >> 4;
@@ -1172,7 +1207,7 @@ static int reconstruct(int sign, int dqln, int y)
}
-static void update(int code_size, int y, int wi, int fi, int dq, int sr, int dqsez, struct g72x_state *state_ptr)
+static void update(int code_size, int y, int wi, int fi, int dq, int sr, int dqsez, struct g72x_state *state_ptr)
{
int cnt;
short mag, exp, a2p = 0, a1ul, pks1, fa1, ylint, thr2, dqthr, ylfrac, thr1, pk0;
@@ -1226,7 +1261,7 @@ static void update(int code_size, int y, int wi, int fi, int dq, int sr, int dqs
}
else
{
- exp = quan(mag, power2, 15);
+ exp = quan(mag);
state_ptr->dq[0] = (dq >= 0) ?
(exp << 6) + ((mag << 6) >> exp) :
(exp << 6) + ((mag << 6) >> exp) - 0x400;
@@ -1239,14 +1274,14 @@ static void update(int code_size, int y, int wi, int fi, int dq, int sr, int dqs
else
if (sr > 0)
{
- exp = quan(sr, power2, 15);
+ exp = quan(sr);
state_ptr->sr[0] = (exp << 6) + ((sr << 6) >> exp);
}
else
if (sr > -32768)
{
mag = -sr;
- exp = quan(mag, power2, 15);
+ exp = quan(mag);
state_ptr->sr[0] = (exp << 6) + ((mag << 6) >> exp) - 0x400;
}
else
@@ -1366,11 +1401,11 @@ static int read_g72x_adpcm(const char *oldname, const char *newname, char *hdr,
g72x_init_state(&state);
chans = mus_sound_chans(oldname);
if (chans != 1)
- return(mus_error(MUS_UNSUPPORTED_DATA_FORMAT,
+ return(mus_error(MUS_UNSUPPORTED_SAMPLE_TYPE,
"read_g72x_adpcm: can't translate G72x file %s: chans: %d\n",
oldname, chans));
fs = CREAT(newname, 0666);
- if (fs == -1) RETURN_MUS_IO_ERROR("create", newname);
+ if (fs == -1) return_mus_io_error("create", newname);
loc = mus_sound_data_location(oldname);
srate = mus_sound_srate(oldname);
mus_bint_to_char((unsigned char *)(hdr + 16), srate);
@@ -1379,20 +1414,20 @@ static int read_g72x_adpcm(const char *oldname, const char *newname, char *hdr,
if (fd == NULL)
{
snd_close(fs, newname);
- RETURN_MUS_IO_ERROR("fopen", oldname);
+ return_mus_io_error("fopen", oldname);
}
if (snd_checked_write(fs, (unsigned char *)hdr, 28, newname) == MUS_ERROR)
{
snd_close(fs, newname);
snd_fclose(fd, oldname);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
buf = (short *)calloc(TRANS_BUF_SIZE, sizeof(short));
if (buf == NULL)
{
snd_close(fs, newname);
snd_fclose(fd, oldname);
- RETURN_MUS_ALLOC_ERROR(oldname, TRANS_BUF_SIZE, "buf");
+ return_mus_alloc_error(oldname, TRANS_BUF_SIZE, "buf");
}
bytes = fread(buf, 1, loc, fd);
if (bytes == 0)
@@ -1400,7 +1435,7 @@ static int read_g72x_adpcm(const char *oldname, const char *newname, char *hdr,
snd_close(fs, newname);
snd_fclose(fd, oldname);
free(buf);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
switch (which_g)
{
@@ -1424,7 +1459,7 @@ static int read_g72x_adpcm(const char *oldname, const char *newname, char *hdr,
snd_close(fs, newname);
snd_fclose(fd, oldname);
free(buf);
- RETURN_MUS_WRITE_ERROR(oldname, newname);
+ return_mus_write_error(oldname, newname);
}
j = 0;
}
@@ -1433,9 +1468,10 @@ static int read_g72x_adpcm(const char *oldname, const char *newname, char *hdr,
snd_close(fs, newname);
snd_fclose(fd, oldname);
free(buf);
- if (err == MUS_ERROR) RETURN_MUS_WRITE_ERROR(oldname, newname);
+ if (err == MUS_ERROR) return_mus_write_error(oldname, newname);
return(MUS_NO_ERROR);
}
+#endif
@@ -1443,40 +1479,39 @@ static int read_g72x_adpcm(const char *oldname, const char *newname, char *hdr,
#define RIFF_Intel_ADPCM 0x11
#define RIFF_Oki_ADPCM 0x10
+#define RIFF_MS_ADPCM 2
+#define RIFF_IBM_ADPCM 0x103
+
+#if G7XX
#define RIFF_G723 0x14
#define RIFF_MS_G723 0x42
#define RIFF_Lucent_G723 0x59
#define RIFF_Vivo_G723 0x111
#define RIFF_G721 0x40
-#define RIFF_MS_ADPCM 2
-#define RIFF_IBM_ADPCM 0x103
+
#define NeXT_G721 23
#define NeXT_G723 25
#define NeXT_G723_5 26
+#endif
-static int MUS_CANT_TRANSLATE = 0;
-
-static const char *any_format_name(const char *name)
+static const char *any_samp_type_name(const char *name)
{
- int format;
- format = mus_sound_data_format(name);
- if (format != MUS_UNKNOWN)
- return(mus_data_format_name(format));
- else return(mus_header_original_format_name(mus_sound_original_format(name),
- mus_sound_header_type(name)));
+ mus_sample_t samp_type;
+ samp_type = mus_sound_sample_type(name);
+ if (samp_type != MUS_UNKNOWN_SAMPLE)
+ return(mus_sample_type_name(samp_type));
+ else return(mus_header_original_sample_type_name(mus_sound_original_sample_type(name), mus_sound_header_type(name)));
}
-int snd_translate(const char *oldname, const char *newname, int type)
+int snd_translate(const char *oldname, const char *newname, mus_header_t type)
{
/* read oldname, translate to newname as 16-bit linear NeXT file */
/* called from snd-file.c */
int err;
char *hdr = NULL;
- if (MUS_CANT_TRANSLATE == 0) MUS_CANT_TRANSLATE = mus_make_error((char *)"can't translate");
err = MUS_CANT_TRANSLATE;
-
hdr = (char *)calloc(TRANS_BUF_SIZE, sizeof(char));
/* set up default output header */
mus_bint_to_char((unsigned char *)hdr, 0x2e736e64); /* .snd */
@@ -1508,13 +1543,15 @@ int snd_translate(const char *oldname, const char *newname, int type)
err = read_12bit(oldname, newname, hdr);
break;
+#if G7XX
case MUS_NVF:
err = read_g72x_adpcm(oldname, newname, hdr, 0);
break;
+#endif
case MUS_RF64:
case MUS_RIFF:
- switch (mus_sound_original_format(oldname))
+ switch (mus_sound_original_sample_type(oldname))
{
case RIFF_MS_ADPCM: case RIFF_Intel_ADPCM:
err = read_dvi_adpcm(oldname, newname, hdr, 0);
@@ -1528,6 +1565,7 @@ int snd_translate(const char *oldname, const char *newname, int type)
err = read_oki_adpcm(oldname, newname, hdr);
break;
+#if G7XX
case RIFF_G721:
err = read_g72x_adpcm(oldname, newname, hdr, 0);
break; /* untested */
@@ -1539,30 +1577,33 @@ int snd_translate(const char *oldname, const char *newname, int type)
if (mus_sound_bits_per_sample(oldname) == 5)
err = read_g72x_adpcm(oldname, newname, hdr, 2);
break;
+#endif
}
break;
case MUS_NIST:
- if (mus_sound_original_format(oldname) == MUS_NIST_SHORTPACK)
+ if (mus_sound_original_sample_type(oldname) == MUS_NIST_SHORTPACK)
err = read_nist_shortpack(oldname, newname, hdr);
break;
+#if G7XX
case MUS_NEXT:
- switch (mus_sound_original_format(oldname))
+ switch (mus_sound_original_sample_type(oldname))
{
case NeXT_G721: err = read_g72x_adpcm(oldname, newname, hdr, 0); break;
case NeXT_G723: err = read_g72x_adpcm(oldname, newname, hdr, 1); break;
case NeXT_G723_5: err = read_g72x_adpcm(oldname, newname, hdr, 2); break;
}
break;
+#endif
case MUS_AIFC:
- if (mus_sound_original_format(oldname) == MUS_AIFF_IMA_ADPCM)
+ if (mus_sound_original_sample_type(oldname) == MUS_AIFF_IMA_ADPCM)
err = read_dvi_adpcm(oldname, newname, hdr, 1);
break;
case MUS_OGG: case MUS_SPEEX: case MUS_FLAC: case MUS_MIDI: case MUS_MPEG:
- case MUS_SHORTEN: case MUS_TTA: case MUS_WAVPACK:
+ case MUS_TTA: case MUS_WAVPACK:
default:
if (snd_decode(type, oldname, newname) == 0)
err = MUS_NO_ERROR;
@@ -1572,10 +1613,10 @@ int snd_translate(const char *oldname, const char *newname, int type)
free(hdr);
if (err == MUS_CANT_TRANSLATE)
return(mus_error(MUS_CANT_TRANSLATE,
- "can't translate %s\n (%s header: %s (0x%x) data format)\n",
+ "can't translate %s\n (%s header: %s (0x%x) sample type)\n",
oldname,
mus_header_type_name(type),
- any_format_name(oldname),
- mus_sound_original_format(oldname)));
+ any_samp_type_name(oldname),
+ mus_sound_original_sample_type(oldname)));
return(err);
}
diff --git a/snd-utils.c b/snd-utils.c
index 14cf5f8..cc83cd6 100644
--- a/snd-utils.c
+++ b/snd-utils.c
@@ -92,33 +92,22 @@ mus_float_t in_dB(mus_float_t min_dB, mus_float_t lin_dB, mus_float_t val)
#endif
-#if HAVE_STRFTIME
#define TIME_STR_SIZE 64
static char time_buf[TIME_STR_SIZE];
-#endif
-
char *snd_local_time(void)
{
-#if HAVE_STRFTIME
time_t ts;
time(&ts);
strftime(time_buf, TIME_STR_SIZE, STRFTIME_FORMAT, localtime(&ts));
return(time_buf);
-#else
- return(" ");
-#endif
}
char *snd_strftime(const char *format, time_t date)
{
-#if HAVE_STRFTIME
strftime(time_buf, TIME_STR_SIZE, format, localtime(&date));
return(time_buf);
-#else
- return(" ");
-#endif
}
@@ -140,16 +129,6 @@ char *snd_open_strerror(void)
}
-int snd_mkdir(const char *filename)
-{
-#ifdef __MINGW32__
- return(mkdir(filename));
-#else
- return(mkdir(filename, 0777));
-#endif
-}
-
-
char *string_to_colon(char *val)
{
char *up_to_colon;
@@ -239,24 +218,20 @@ char *file_to_string(const char *filename)
char *vstr(const char *format, va_list ap)
{
char *buf;
-#if HAVE_VASPRINTF
+#ifndef _MSC_VER
if (vasprintf(&buf, format, ap) == -1)
return(NULL);
#else
int len;
len = mus_strlen(format) + PRINT_BUFFER_SIZE;
buf = (char *)calloc(len, sizeof(char));
- #if HAVE_VSNPRINTF
vsnprintf(buf, len, format, ap);
- #else
- vsprintf(buf, format, ap);
- #endif
#endif
return(buf);
}
-disk_space_t disk_space_p(mus_long_t bytes, const char *filename)
+disk_space_t disk_has_space(mus_long_t bytes, const char *filename)
{
mus_long_t kfree, kneeded;
kfree = disk_kspace(filename);
@@ -268,7 +243,7 @@ disk_space_t disk_space_p(mus_long_t bytes, const char *filename)
kneeded = bytes >> 10;
if (kfree < kneeded)
{
- snd_error("not enough space left on disk: only "MUS_LD " kbytes available", kfree);
+ snd_error("not enough space left on disk: only %lld kbytes available", kfree);
return(NOT_ENOUGH_DISK_SPACE);
}
return(DISK_SPACE_OK);
@@ -323,7 +298,7 @@ char *shorter_tempnam(const char *udir, const char *prefix)
if ((udir == NULL) || (mus_strlen(udir) == 0))
tmpdir = get_tmpdir(); /* incoming dir could be "" */
else tmpdir = mus_strdup(udir);
- mus_snprintf(str, PRINT_BUFFER_SIZE, "%s/%s%d_%d.snd", tmpdir, (prefix) ? prefix : "snd_", (int)getpid(), sect_ctr++);
+ snprintf(str, PRINT_BUFFER_SIZE, "%s/%s%d_%d.snd", tmpdir, (prefix) ? prefix : "snd_", (int)getpid(), sect_ctr++);
if (tmpdir) free(tmpdir);
tmpdir = mus_strdup(str);
free(str);
@@ -347,340 +322,38 @@ char *snd_tempnam(void)
void snd_exit(int val)
{
-#ifndef SND_AS_WIDGET
#if MUS_PORTAUDIO
Pa_Terminate();
#endif
exit(val);
-#endif
}
-/* glib now has a "gio" module that provides a fam-like service, but it requires using gio style file handlers throughout. */
-
-
-/* ---------------- file alteration monitor (fam or gamin) ---------------- */
-#if HAVE_FAM
-#define MUS_DEBUGGING_FAM 0
-
-/* one confusing thing: if user deletes the file we're monitoring, apparently Linux doesn't
- * actually delete it, though a directory monitor reports the deletion; the file itself
- * hangs around, I guess because we have it open(?) -- can't decide how to deal with this.
- *
- * The main open is in snd_chn add_channel_data, and the file channel is held open unless
- * too_many_files forces us to close as many as possible.
+/* currently this is only used by the test suite (snd-test.scm)
*/
-
-static bool fam_already_warned = false;
-
-#if MUS_DEBUGGING_FAM
-static char *fam_event_name(int code)
-{
- switch (code)
- {
- case FAMChanged: return("Changed"); break;
- case FAMDeleted: return("Deleted"); break;
- case FAMCreated: return("Created"); break;
- case FAMMoved: return("Moved"); break;
- case FAMStartExecuting: return("StartExecuting"); break;
- case FAMStopExecuting: return("StopExecuting"); break;
- case FAMAcknowledge: return("Acknowledge"); break;
- case FAMExists: return("Exists"); break;
- case FAMEndExist: return("EndExist"); break;
- }
- return("unknown");
-}
-#endif
-
-
-static const char *fam_error_to_string(int err)
-{
- if (err > 0)
- return(FamErrlist[err]); /* not sure this actually does anything anymore */
- return("0");
-}
-
-
-static void fam_check(void)
-{
- FAMEvent fe;
- if (!(ss->fam_ok)) return;
- while (FAMPending(ss->fam_connection) > 0)
- {
- if (FAMNextEvent(ss->fam_connection, &fe) < 0)
- snd_error("fam error: %s\n", fam_error_to_string(FAMErrno));
- else
- {
- if (!(ss->checking_explicitly))
- /* not in check_for_event -- we can't just ignore these because gamin hangs */
- {
- switch (fe.code)
- {
- case FAMStartExecuting:
- case FAMStopExecuting:
- case FAMAcknowledge:
- case FAMExists:
- case FAMEndExist:
- /* ignore these (fp pointer can be a dangling reference here) */
- break;
- default:
- {
- fam_info *fp = (fam_info *)(fe.userdata);
- if ((!fp) || (fp->action == fp->data))
- fprintf(stderr, "no fam user data!");
- else
- {
-#if MUS_DEBUGGING_FAM
- fprintf(stderr, "fam %s: %d (%s): %p\n", fe.filename, fe.code, fam_event_name(fe.code), fp);
-#endif
- (*(fp->action))(fp, &fe);
- }
- }
- break;
- }
- }
- }
- }
-}
-
-
-#if USE_MOTIF
-static void fam_reader(XtPointer context, int *fd, XtInputId *id)
-{
- fam_check();
-}
-#else
-static gboolean fam_reader(GIOChannel *source, GIOCondition condition, gpointer data)
-{
- fam_check();
- return(true);
-}
-#endif
-
-
-static fam_info *make_fam_info(FAMRequest *rp, void *data, void (*action)(struct fam_info *fp, FAMEvent *fe))
-{
- fam_info *fp;
- fp = (fam_info *)calloc(1, sizeof(fam_info));
- fp->data = data;
- fp->action = action;
- fp->rp = rp;
- return(fp);
-}
-
-
-static FAMRequest *fam_monitor(void)
-{
- if (!fam_already_warned)
- {
- if (!(ss->fam_connection))
- {
- int err;
- ss->fam_connection = (FAMConnection *)calloc(1, sizeof(FAMConnection));
- err = FAMOpen(ss->fam_connection);
- if (err < 0)
- {
- fam_already_warned = true;
- snd_warning("can't start file alteration monitor: %s\n", fam_error_to_string(FAMErrno));
- ss->fam_ok = false;
- return(NULL);
- }
- else
- {
- int fd;
- ss->fam_ok = true;
- fd = FAMCONNECTION_GETFD(ss->fam_connection);
-#if USE_MOTIF
- ss->fam_port = XtAppAddInput(MAIN_APP(ss),
- fd,
- (XtPointer)XtInputReadMask,
- fam_reader,
- NULL);
-#endif
-#if USE_GTK
- {
- GIOChannel *channel;
- channel = g_io_channel_unix_new(fd);
- ss->fam_port = g_io_add_watch_full(channel,
- G_PRIORITY_DEFAULT,
- (GIOCondition)(G_IO_IN | G_IO_HUP | G_IO_ERR),
- fam_reader, NULL, NULL);
- g_io_channel_unref(channel);
- }
-#endif
- }
- }
- return((FAMRequest *)calloc(1, sizeof(FAMRequest)));
- }
- return(NULL);
-}
-
-
-fam_info *fam_monitor_file(const char *filename, void *data, void (*action)(struct fam_info *fp, FAMEvent *fe))
-{
- fam_info *fp = NULL;
- FAMRequest *rp = NULL;
- int err;
- if (!(with_file_monitor(ss))) return(NULL);
- rp = fam_monitor();
- if (rp)
- {
-#if MUS_DEBUGGING_FAM
- fprintf(stderr, "monitor %s\n", filename);
-#endif
- fp = make_fam_info(rp, data, action);
-#if MUS_DEBUGGING
- fp->filename = mus_strdup(filename);
-#endif
- err = FAMMonitorFile(ss->fam_connection, filename, rp, (void *)fp);
- if (err < 0)
- {
- snd_warning("can't monitor %s: %s (free %p %p)\n", filename, fam_error_to_string(FAMErrno), fp, rp);
- free(rp);
- rp = NULL;
- free(fp);
- fp = NULL;
- }
- else return(fp);
- }
- else
- {
- if (!fam_already_warned)
- snd_warning("can't get fam request for %s: %s\n", filename, fam_error_to_string(FAMErrno));
- }
- return(NULL);
-}
-
-
-fam_info *fam_monitor_directory(const char *dir_name, void *data, void (*action)(struct fam_info *fp, FAMEvent *fe))
-{
- fam_info *fp = NULL;
- FAMRequest *rp = NULL;
- int err;
- if (!(with_file_monitor(ss))) return(NULL);
- rp = fam_monitor();
- if (rp)
- {
- fp = make_fam_info(rp, data, action);
-#if MUS_DEBUGGING
- fp->filename = mus_strdup(dir_name);
-#endif
- err = FAMMonitorDirectory(ss->fam_connection, dir_name, rp, (void *)fp);
- if (err < 0)
- {
- snd_warning("can't monitor %s: %s\n", dir_name, fam_error_to_string(FAMErrno));
- free(rp);
- rp = NULL;
- free(fp);
- fp = NULL;
- }
- else return(fp);
- }
- else
- {
- if (!fam_already_warned)
- snd_warning("can't get fam request for %s: %s\n", dir_name, fam_error_to_string(FAMErrno));
- }
- return(NULL);
-}
-
-
-fam_info *fam_unmonitor_file(const char *filename, fam_info *fp)
-{
- int err;
- if (fp)
- {
-#if MUS_DEBUGGING_FAM
- fprintf(stderr, "unmonitor %s: %p %p\n", filename, fp, fp->rp);
-#endif
-#if MUS_DEBUGGING
- if (fp->filename) {free(fp->filename); fp->filename = NULL;}
-#endif
- if (fp->rp)
- {
- err = FAMCancelMonitor(ss->fam_connection, fp->rp);
- if (err < 0)
- snd_warning("can't unmonitor %s: %s\n", filename, fam_error_to_string(FAMErrno));
- free(fp->rp);
- /* /usr/include/fam.h implies that cancel frees this, but valgrind seems to disagree */
- /* as far as I can see, gamin (libgamin/gam_api.c) does not free it */
- /* nor does fam (fam/fam.c++ in 2.6.10 does not, and their test case assumes it won't) */
- fp->rp = NULL;
- /* free(fp) below in debugging case will fill this with 'X', 0x858585... */
- }
- fp->action = NULL;
- fp->data = NULL;
- free(fp);
- }
- return(NULL);
-}
-
-#else
-/* no fam */
-
-fam_info *fam_monitor_file(const char *filename, void *data, void (*action)(struct fam_info *fp, FAMEvent *fe))
-{
- return(NULL);
-}
-
-
-fam_info *fam_monitor_directory(const char *dir_name, void *data, void (*action)(struct fam_info *fp, FAMEvent *fe))
-{
- return(NULL);
-}
-
-
-fam_info *fam_unmonitor_file(const char *filename, fam_info *fp)
-{
- if (fp) free(fp);
- return(NULL);
-}
-
-#if MUS_DEBUGGING_FAM
-static char *fam_event_name(int code)
-{
- return("no fam!");
-}
-#endif
-#endif
-
-
-fam_info *fam_unmonitor_directory(const char *filename, fam_info *fp)
-{
- return(fam_unmonitor_file(filename, fp));
-}
-
-
#if HAVE_SCHEME
#define S_file_to_string "file->string"
-static XEN g_file_to_string(XEN name)
+static Xen g_file_to_string(Xen name)
{
char *contents;
- XEN val = XEN_FALSE;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, S_file_to_string, "a string");
- contents = file_to_string(XEN_TO_C_STRING(name));
- val = C_TO_XEN_STRING(contents);
+ Xen val = Xen_false;
+ Xen_check_type(Xen_is_string(name), name, 1, S_file_to_string, "a string");
+ contents = file_to_string(Xen_string_to_C_string(name));
+ val = C_string_to_Xen_string(contents);
free(contents);
return(val);
}
#endif
-#ifdef XEN_ARGIFY_1
#if HAVE_SCHEME
- XEN_NARGIFY_1(g_file_to_string_w, g_file_to_string)
+ Xen_wrap_1_arg(g_file_to_string_w, g_file_to_string)
#endif
-#else
-#if HAVE_SCHEME
- #define g_file_to_string_w g_file_to_string
-#endif
-#endif
-
void g_init_utils(void)
{
#if HAVE_SCHEME
- XEN_DEFINE_PROCEDURE(S_file_to_string, g_file_to_string_w, 1, 0, 0, "file contents as string");
+ Xen_define_safe_procedure(S_file_to_string, g_file_to_string_w, 1, 0, 0, "file contents as string");
#endif
}
diff --git a/snd-x0.h b/snd-x0.h
index 8fb820a..8a6f130 100644
--- a/snd-x0.h
+++ b/snd-x0.h
@@ -10,19 +10,29 @@
#include <GL/glx.h>
#endif
+#define XOR(a, b) ((a) ^ (b))
+/* can't get used to this operator -- in the good old days, ^ meant exponentiation */
+
#define xm_font_t XmRenderTable
#define XM_FONT_RESOURCE XmNrenderTable
#define XM_FONT_FREE XmRenderTableFree
#define LOTSA_PIXELS 10000
-#define XEN_WRAP_WIDGET(Value) ((Value) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("Widget"), XEN_WRAP_C_POINTER(Value)) : XEN_FALSE)
-#define XEN_WRAP_WINDOW(Value) ((Value) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("Window"), C_TO_XEN_ULONG(Value)) : XEN_FALSE)
-#define XEN_UNWRAP_WIDGET(Value) (XEN_LIST_P(Value) ? XEN_UNWRAP_C_POINTER(XEN_CADR(Value)) : 0)
-#define XEN_WIDGET_P(Value) (XEN_LIST_P(Value) && (XEN_LIST_LENGTH(Value) >= 2) && (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp("Widget", XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
+
+#define Xen_wrap_widget(Value) ((Value) ? Xen_list_2(C_string_to_Xen_symbol("Widget"), Xen_wrap_C_pointer(Value)) : Xen_false)
+#define Xen_wrap_window(Value) ((Value) ? Xen_list_2(C_string_to_Xen_symbol("Window"), C_ulong_to_Xen_ulong(Value)) : Xen_false)
+#define Xen_unwrap_widget(Value) (Xen_is_list(Value) ? Xen_unwrap_C_pointer(Xen_cadr(Value)) : 0)
+#define Xen_is_widget(Value) (Xen_is_list(Value) && (Xen_list_length(Value) >= 2) && (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp("Widget", Xen_symbol_to_C_string(Xen_car(Value))) == 0))
+#define Xen_wrap_pixel(Value) Xen_list_2(C_string_to_Xen_symbol("Pixel"), C_int_to_Xen_integer((int)Value))
+ /* not ulong here! -- messes up the equal? check */
+#define Xen_unwrap_pixel(Value) (unsigned long)Xen_integer_to_C_int(Xen_cadr(Value))
+#define Xen_is_pixel(Value) (Xen_is_list(Value) && (Xen_list_length(Value) >= 2) && (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp("Pixel", Xen_symbol_to_C_string(Xen_car(Value))) == 0))
+
#define NULL_WIDGET NULL
-typedef enum {NOT_ACTIVATABLE, ACTIVATABLE, NOT_ACTIVATABLE_OR_FOCUSED, ACTIVATABLE_BUT_NOT_FOCUSED} text_cr_t;
+typedef enum {NOT_ACTIVATABLE, ACTIVATABLE, ACTIVATABLE_BUT_NOT_FOCUSED} text_cr_t;
#define LINE_MARGIN 4
#define CONTROLS_MARGIN 1
@@ -58,8 +68,8 @@ typedef enum {NOT_ACTIVATABLE, ACTIVATABLE, NOT_ACTIVATABLE_OR_FOCUSED, ACTIVATA
#define rgb_t unsigned short
#define RGB_MAX 65535
-#define FLOAT_TO_RGB(Val) (rgb_t)(RGB_MAX * (Val))
-#define RGB_TO_FLOAT(Val) (float)((float)(Val) / (float)RGB_MAX)
+#define float_to_rgb(Val) (rgb_t)(RGB_MAX * (Val))
+#define rgb_to_float(Val) (float)((float)(Val) / (float)RGB_MAX)
typedef struct {
@@ -72,9 +82,11 @@ typedef struct {
typedef enum {NOT_A_SCANF_WIDGET, SRATE_WIDGET, CHANS_WIDGET, DATA_LOCATION_WIDGET, SAMPLES_WIDGET} scanf_widget_t;
typedef struct {
- Widget header_list, format_list, srate_text, chans_text, comment_text, location_text, samples_text, error_text;
+ Widget header_type_list, sample_type_list, srate_text, chans_text, comment_text, location_text, samples_text, error_text;
Widget dialog, src_button, auto_comment_button;
- int current_type, current_format, formats, header_pos, format_pos;
+ mus_header_t current_header_type;
+ mus_sample_t current_sample_type;
+ int sample_types, header_type_pos, sample_type_pos;
scanf_widget_t scanf_widget, error_widget;
bool src, auto_comment;
char *saved_comment;
diff --git a/snd-x1.h b/snd-x1.h
index 5fff328..e4a7876 100644
--- a/snd-x1.h
+++ b/snd-x1.h
@@ -1,9 +1,6 @@
#ifndef SND_X1_H
#define SND_X1_H
-#define SOUND_ENV_EDITOR(Sp) ((env_editor *)(sp->flt))
-
-
/* -------- snd-xhelp.c -------- */
@@ -33,7 +30,6 @@ void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, in
void draw_spectro_line(graphics_context *ax, int color, int x0, int y0, int x1, int y1);
void allocate_color_map(int colormap);
void check_colormap_sizes(int size);
-void initialize_colormap(void);
void reflect_color_list(bool setup_time);
void allocate_sono_rects(int size);
void set_sono_rectangle(int j, int color, int x, int y, int width, int height);
@@ -49,9 +45,8 @@ void set_spectro_z_angle(mus_float_t val);
void set_spectro_x_scale(mus_float_t val);
void set_spectro_y_scale(mus_float_t val);
void set_spectro_z_scale(mus_float_t val);
-void view_color_orientation_callback(Widget w, XtPointer context, XtPointer info);
bool color_orientation_dialog_is_active(void);
-Widget start_color_orientation_dialog(bool managed);
+Widget make_color_orientation_dialog(bool managed);
void reflect_spectro(void);
void set_with_gl(bool val, bool with_dialogs);
void g_init_gxdraw(void);
@@ -84,7 +79,6 @@ Widget make_textfield_widget(const char *name, Widget parent, Arg *args, int n,
void clear_listener(void);
void set_listener_text_font(void);
void g_init_gxlistener(void);
-bool highlight_unbalanced_paren(void);
/* -------- snd-xmenu.c -------- */
@@ -101,7 +95,8 @@ void post_basic_popup_menu(void *ev);
void post_lisp_popup_menu(void *ev);
void post_fft_popup_menu(void *ev);
void post_selection_popup_menu(void *ev);
-
+widget_t make_file_print_dialog(bool managed, bool direct_to_printer);
+void save_print_dialog_state(FILE *fd);
/* -------- snd-xmain.c -------- */
@@ -111,10 +106,6 @@ color_t get_in_between_color(color_t fg, color_t bg);
void auto_update_restart(void);
void save_colors(FILE *Fp);
-#ifdef SND_AS_WIDGET
- void snd_as_widget(int argc, char **argv, XtAppContext app, Widget parent, Arg *caller_args, int caller_argn);
-#endif
-
/* -------- snd-xfft.c -------- */
@@ -124,7 +115,7 @@ void set_fft_window_alpha(mus_float_t val);
void set_transform_size(mus_long_t val);
void set_fft_window(mus_fft_window_t val);
void set_wavelet_type(int val);
-Widget fire_up_transform_dialog(bool managed);
+Widget make_transform_dialog(bool managed);
bool transform_dialog_is_active(void);
void set_spectrum_start(mus_float_t val);
@@ -144,31 +135,18 @@ void reflect_log_freq_start_in_transform_dialog(void);
void reflect_min_db_in_transform_dialog(void);
-/* -------- snd-xdrop.c -------- */
-
-void add_drag_and_drop(Widget w,
- void (*drop_watcher)(Widget w, const char *message, Position x, Position y, void *data),
- void (*drag_watcher)(Widget w, const char *message, Position x, Position y, drag_style_t dtype, void *data),
- void *context);
-void g_init_gxdrop(void);
-
-
/* -------- snd-xregion.c -------- */
-void update_region_browser(bool grf_too);
+int update_region_browser(bool grf_too);
bool region_browser_is_active(void);
void delete_region_and_update_browser(int n);
void reflect_play_region_stop(int n);
-void view_region_callback(Widget w, XtPointer context, XtPointer info);
bool region_dialog_is_active(void);
void allocate_region_rows(int n);
void reflect_regions_in_region_browser(void);
void reflect_no_regions_in_region_browser(void);
void reflect_region_graph_style(void);
-int region_dialog_region(void);
-char *regrow_get_label(void *ur);
-int regrow_get_pos(void *ur);
void g_init_gxregion(void);
@@ -185,7 +163,7 @@ const char **stop_sign_bits(void);
void make_toolbar_icons(Widget w);
enum {SND_XPM_BACK_ARROW, SND_XPM_FORWARD_ARROW, SND_XPM_ZOOM_IN, SND_XPM_ZOOM_OUT, SND_XPM_CUT, SND_XPM_PASTE, SND_XPM_PREFERENCES, SND_XPM_CLOSE,
- SND_XPM_REDO, SND_XPM_UNDO, SND_XPM_SAVE, SND_XPM_NEW, SND_XPM_OPEN, SND_XPM_NEXT, SND_XPM_BACK, SND_XPM_EXIT, SND_XPM_SEPARATOR, SND_XPM_UP,
+ SND_XPM_REDO, SND_XPM_UNDO, SND_XPM_SAVE, SND_XPM_SAVE_AS, SND_XPM_NEW, SND_XPM_OPEN, SND_XPM_NEXT, SND_XPM_BACK, SND_XPM_EXIT, SND_XPM_SEPARATOR, SND_XPM_UP,
SND_XPM_STOP, SND_XPM_REVERT, SND_XPM_PLAY, SND_XPM_CURSOR_PLAY, SND_XPM_STOP_PLAY,
NUM_TOOLBAR_PIXMAPS};
Pixmap toolbar_icon(int which);
@@ -200,16 +178,22 @@ char *colormap_name(int n);
bool is_colormap(int n);
int num_colormaps(void);
void get_current_color(int colormap, int n, rgb_t *r, rgb_t *g, rgb_t *b);
+#if HAVE_GL
rgb_t *color_map_reds(int index);
rgb_t *color_map_greens(int index);
rgb_t *color_map_blues(int index);
+#endif
void g_init_gxcolormaps(void);
/* -------- snd-xfind.c -------- */
-void edit_find_callback(Widget w, XtPointer context, XtPointer info);
-void set_find_dialog_label(const char *str);
+void find_dialog(chan_info *cp);
+void find_dialog_set_label(const char *str);
+void stop_search_if_error(const char *msg, void *data);
+void errors_to_find_text(const char *msg, void *data);
+void find_dialog_stop_label(bool show_stop);
+bool find_dialog_is_active(void);
void save_find_dialog_state(FILE *fd);
void g_init_gxfind(void);
@@ -227,17 +211,11 @@ int number_width(const char *num, bool use_tiny_font);
int number_height(XFontStruct *numbers_font);
int label_height(bool use_tiny_font);
int mark_name_width(const char *txt);
-void map_over_children(Widget w, void (*func)(Widget w));
void map_over_children_with_color(Widget w, void (*func)(Widget uw, color_t color), color_t color);
void clear_window(graphics_context *ax);
-void raise_dialog(Widget w);
-void set_main_color_of_widget(Widget w);
-char *get_label(Widget label);
void set_label(Widget label, const char *str);
void set_title(const char *title);
void goto_window(Widget text);
-XtCallbackList make_callback_list(XtCallbackProc callback, XtPointer closure);
-void color_sashes(Widget w);
void check_for_event(void);
void color_cursor(Pixel color);
void color_marks(Pixel color);
@@ -261,13 +239,7 @@ void set_widget_y(Widget w, Position y);
void set_widget_size(Widget w, Dimension width, Dimension height);
void set_widget_position(Widget w, Position x, Position y);
idle_t add_work_proc(XtWorkProc func, XtPointer data);
-int attach_all_sides(Arg *args, int n);
-void widget_int_to_text(Widget w, int val);
-void widget_mus_long_t_to_text(Widget w, mus_long_t val);
void draw_rotated_axis_label(chan_info *cp, graphics_context *ax, const char *text, int x0, int y0);
-void ensure_list_row_visible(widget_t list, int row);
-void ensure_scrolled_window_row_visible(widget_t list, int pos, int num_rows);
-XmString multi_line_label(const char *s, int *lines);
/* -------- snd-xchn.c -------- */
@@ -317,11 +289,7 @@ int control_panel_height(snd_info *sp);
Widget w_snd_pane(snd_info *sp);
Widget unite_button(snd_info *sp);
void set_control_panel_play_button(snd_info *sp);
-void make_minibuffer_label(snd_info *sp, const char *str);
-void goto_minibuffer(snd_info *sp);
-void set_minibuffer_string(snd_info *sp, const char *str, bool update);
-void set_minibuffer_cursor_position(snd_info *sp, int pos);
-char *get_minibuffer_string(snd_info *sp);
+void set_status(snd_info *sp, const char *str, bool update);
void snd_info_cleanup(snd_info *sp);
void set_amp(snd_info *sp, mus_float_t val);
int amp_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval);
@@ -348,8 +316,6 @@ void show_lock(snd_info *sp);
void hide_lock(snd_info *sp);
void start_bomb(snd_info *sp);
void stop_bomb(snd_info *sp);
-void show_bomb(snd_info *sp);
-void hide_bomb(snd_info *sp);
snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr);
void set_sound_pane_file_label(snd_info *sp, const char *str);
void color_filter_waveform(Pixel color);
@@ -365,17 +331,31 @@ XmString initial_speed_label(speed_style_t style);
void g_init_gxsnd(void);
void make_sound_icons_transparent_again(Pixel old_color, Pixel new_color);
void reflect_sound_selection(snd_info *sp);
-void display_minibuffer_error(snd_info *sp, const char *str);
-void clear_minibuffer_error(snd_info *sp);
void make_controls_dialog(void);
+void update_sound_label(snd_info *sp);
/* -------- snd-xfile.c -------- */
-char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, int *type, int *format, mus_long_t *location, mus_long_t *samples, int min_chan);
+void cleanup_file_monitor(void);
+void *unmonitor_file(void *watcher);
+void monitor_sound(snd_info *sp);
+
+void save_view_files_dialogs(FILE *fd);
+widget_t make_view_files_dialog(bool managed, bool make_new);
+void view_files_unplay(void);
+void view_files_add_directory(widget_t dialog, const char *dirname);
+char *view_files_find_any_directory(void);
+int view_files_dialog_list_length(void);
+char **view_files_dialog_titles(void);
+void view_files_start_dialog_with_title(const char *title);
+
+char *get_file_dialog_sound_attributes(file_data *fdat, int *srate, int *chans, mus_header_t *header_type,
+ mus_sample_t *sample_type, mus_long_t *location, mus_long_t *samples, int min_chan);
void alert_new_file(void);
widget_t make_open_file_dialog(read_only_t read_only, bool managed);
widget_t make_sound_save_as_dialog(bool managed);
+void make_channel_extract_dialog(int chan);
widget_t make_selection_save_as_dialog(bool managed);
widget_t make_region_save_as_dialog(bool managed);
widget_t make_new_file_dialog(bool managed);
@@ -383,23 +363,29 @@ void mouse_enter_label(void *r, int type);
void mouse_leave_label(void *r, int type);
Widget edit_header(snd_info *sp);
void save_edit_header_dialog_state(FILE *fd);
-void cleanup_edit_header_watcher(void);
-void cleanup_new_file_watcher(void);
void set_open_file_play_button(bool val);
widget_t make_mix_file_dialog(bool managed);
widget_t make_insert_file_dialog(bool managed);
void g_init_gxfile(void);
-void clear_deleted_snd_info(struct dialog_play_info *dp);
+void clear_deleted_snd_info(void *dp);
void reflect_just_sounds(void);
void save_file_dialog_state(FILE *fd);
widget_t post_it(const char *subject, const char *str);
+void post_it_append(const char *str);
void save_post_it_dialog_state(FILE *fd);
void reflect_region_in_save_as_dialog(void);
+void reflect_selection_in_save_as_dialog(bool on);
void save_edits_now(snd_info *sp);
+void changed_file_dialog(snd_info *sp);
+void unpost_file_has_changed_if_any(snd_info *sp);
void unpost_unsaved_edits_if_any(snd_info *sp);
void reflect_save_as_src(bool val);
void reflect_save_as_auto_comment(bool val);
void reflect_save_as_sound_selection(const char *sound_name);
+void add_drag_and_drop(Widget w,
+ void (*drop_watcher)(Widget w, const char *message, Position x, Position y, void *data),
+ void (*drag_watcher)(Widget w, const char *message, Position x, Position y, drag_style_t dtype, void *data),
+ void *context);
@@ -413,19 +399,19 @@ void set_enved_revert_sensitive(bool val);
void set_enved_undo_sensitive(bool val);
void set_enved_save_sensitive(bool val);
void set_enved_show_sensitive(bool val);
+void enved_reflect_selection(bool on);
void make_scrolled_env_list(void);
void enved_reflect_peak_env_completion(snd_info *sp);
void new_active_channel_alert(void);
void env_redisplay(void);
void env_redisplay_with_print(void);
void update_enved_background_waveform(chan_info *cp);
-void enved_print(char *name);
Widget create_envelope_editor(void);
-void set_enved_clip_p(bool val);
+void set_enved_clipping(bool val);
void reflect_enved_style(void);
void set_enved_base(mus_float_t val);
void set_enved_target(enved_target_t val);
-void set_enved_wave_p(bool val);
+void set_enved_with_wave(bool val);
void set_enved_in_dB(bool val);
bool enved_dialog_is_active(void);
void set_enved_filter_order(int order);
@@ -444,23 +430,9 @@ int mix_dialog_mix(void);
void mix_dialog_set_mix(int id);
-
-/* -------- snd-xrec.c -------- */
-
-widget_t record_file(void);
-
-
-
-/* -------- snd-xprint.c -------- */
-
-void file_print_callback(Widget w, XtPointer context, XtPointer info);
-widget_t make_file_print_dialog(bool managed, bool direct_to_printer);
-void save_print_dialog_state(FILE *fd);
-
-
/* -------- snd-xprefs.c -------- */
-widget_t start_preferences_dialog(void);
+widget_t make_preferences_dialog(void);
#endif
diff --git a/snd-xchn.c b/snd-xchn.c
deleted file mode 100644
index a4f165e..0000000
--- a/snd-xchn.c
+++ /dev/null
@@ -1,1710 +0,0 @@
-#include "snd.h"
-
-enum {W_top, W_form, W_main_window, W_edhist, W_wf_buttons, W_f, W_w, W_left_scrollers, W_zy, W_sy,
- W_bottom_scrollers, W_sx, W_zx, W_graph, W_gzy, W_gsy,
- NUM_CHAN_WIDGETS
-};
-
-
-#if ((XmVERSION >= 2) && (XmREVISION >= 3))
- #define DEFAULT_EDIT_HISTORY_WIDTH 2
-#else
- #define DEFAULT_EDIT_HISTORY_WIDTH 1
-#endif
-
-
-Widget channel_main_pane(chan_info *cp)
-{
- if (cp) return(cp->chan_widgets[W_form]);
- return(NULL);
-}
-
-
-Widget channel_graph(chan_info *cp) {return(cp->chan_widgets[W_graph]);}
-static Widget channel_sx(chan_info *cp) {return(cp->chan_widgets[W_sx]);}
-static Widget channel_sy(chan_info *cp) {return(cp->chan_widgets[W_sy]);}
-static Widget channel_zx(chan_info *cp) {return(cp->chan_widgets[W_zx]);}
-static Widget channel_zy(chan_info *cp) {return(cp->chan_widgets[W_zy]);}
-static Widget channel_gsy(chan_info *cp) {return(cp->chan_widgets[W_gsy]);}
-static Widget channel_gzy(chan_info *cp) {return(cp->chan_widgets[W_gzy]);}
-Widget channel_w(chan_info *cp) {return(cp->chan_widgets[W_w]);}
-Widget channel_f(chan_info *cp) {return(cp->chan_widgets[W_f]);}
-
-
-bool channel_graph_is_visible(chan_info *cp)
-{
- return((cp) &&
- (channel_graph(cp)) &&
- (XtIsManaged(channel_graph(cp))) &&
- (cp->sound) &&
- /* here we may have a sound wrapper for variable display in which case the sound widgets are not implemented */
- (((cp->sound->inuse == SOUND_WRAPPER) || (cp->sound->inuse == SOUND_REGION)) ||
- ((cp->sound->inuse == SOUND_NORMAL) &&
- /* other choice: SOUND_IDLE -> no display */
- (w_snd_pane(cp->sound)) &&
- (XtIsManaged(w_snd_pane(cp->sound))))));
-}
-
-
-#define EDIT_HISTORY_LIST(Cp) (Cp)->chan_widgets[W_edhist]
-
-
-static mus_float_t sqr(mus_float_t a) {return(a * a);}
-
-static mus_float_t cube(mus_float_t a) {return(a * a * a);}
-
-
-static mus_float_t get_scrollbar(Widget w, int val, int scrollbar_max)
-{
- int size;
- if (val == 0) return(0.0);
- XtVaGetValues(w, XmNsliderSize, &size, NULL);
- return((mus_float_t)val / (mus_float_t)(scrollbar_max - size));
-}
-
-
-static void sy_changed(int value, chan_info *cp)
-{
- axis_info *ap;
- mus_float_t low;
- ap = cp->axis;
- low = get_scrollbar(channel_sy(cp), value, SCROLLBAR_MAX);
- ap->sy = (1.0 - ap->zy) * low;
- apply_y_axis_change(ap, cp);
-}
-
-
-static void sx_changed(int value, chan_info *cp)
-{
- /* treat as centered with non-slider trough as defining current bounds */
- axis_info *ap;
- double low;
- ap = cp->axis;
- low = get_scrollbar(channel_sx(cp), value, SCROLLBAR_MAX);
- ap->sx = low * (1.0 - ap->zx);
- apply_x_axis_change(ap, cp);
-}
-
-
-static void zy_changed(int value, chan_info *cp)
-{
- axis_info *ap;
- mus_float_t old_zy;
- ap = cp->axis;
- if (value < 1) value = 1;
- old_zy = ap->zy;
- ap->zy = sqr(get_scrollbar(channel_zy(cp), value, SCROLLBAR_MAX));
- ap->sy += (.5 * (old_zy - ap->zy)); /* try to keep wave centered */
- if (ap->sy < 0) ap->sy = 0;
- apply_y_axis_change(ap, cp);
- resize_sy(cp);
-}
-
-
-#define X_RANGE_CHANGEOVER 20.0
-
-static void zx_changed(int value, chan_info *cp)
-{ /* scrollbar change */
- axis_info *ap;
- static int old_zx_value = -1;
- #define ZX_MIN 20
-
- if (value < ZX_MIN) value = ZX_MIN; /* less than this causes underflow in snd-axis describe_ticks */
- /* snd-gchn uses .01 -- its equivalent here would be 100 */
- /* perhaps the definition should be ((int)(0.002 * MAX_SCROLLBAR)) */
- if (old_zx_value == value) return; /* try to keep click on slider from moving the window! */
- old_zx_value = value;
-
- ap = cp->axis;
- if (ap->xmax == 0.0) return;
- if (ap->xmax <= ap->xmin)
- {
- ap->xmax = ap->xmin + .001;
- ap->x_ambit = .001;
- }
- if (ap->x_ambit < X_RANGE_CHANGEOVER)
- ap->zx = sqr(get_scrollbar(channel_zx(cp), value, SCROLLBAR_MAX));
- else ap->zx = cube(get_scrollbar(channel_zx(cp), value, SCROLLBAR_MAX));
- /* if cursor visible, focus on that, else selection, else mark, else left side */
- focus_x_axis_change(ap, cp, zoom_focus_style(ss));
- resize_sx(cp);
-}
-
-
-static void set_scrollbar(Widget w, mus_float_t position, mus_float_t range, int scrollbar_max) /* position and range 0 to 1.0 */
-{
- int size, val;
- size = (int)(scrollbar_max * range);
- if (size > scrollbar_max)
- size = scrollbar_max; /* this can't happen!?! */
- if (size < 1) size = 1;
- val = (int)(scrollbar_max * position);
- if ((val + size) > scrollbar_max) val = scrollbar_max - size;
- if (val < 0) val = 0;
- XtVaSetValues(w,
- XmNsliderSize, size,
- XmNvalue, val,
- NULL);
-}
-
-
-static void change_gzy_1(mus_float_t val, chan_info *cp)
-{
- mus_float_t chan_frac, new_gsy, new_size;
- cp->gzy = val;
- chan_frac = 1.0 / ((mus_float_t)(((snd_info *)(cp->sound))->nchans));
- new_size = chan_frac + ((1.0 - chan_frac) * cp->gzy);
- if ((cp->gsy + new_size) > 1.0)
- new_gsy = 1.0 - new_size;
- else new_gsy = cp->gsy;
- if (new_gsy < 0.0) new_gsy = 0.0;
- set_scrollbar(channel_gsy(cp), new_gsy, new_size, SCROLLBAR_MAX);
-}
-
-
-static void gzy_changed(int value, chan_info *cp)
-{
- change_gzy_1(get_scrollbar(channel_gzy(cp), value, SCROLLBAR_MAX), cp);
- for_each_sound_chan(cp->sound, update_graph_or_warn);
-}
-
-
-void change_gzy(mus_float_t val, chan_info *cp)
-{
- change_gzy_1(val, cp);
- set_scrollbar(channel_gzy(cp), val, 1.0 / (mus_float_t)(cp->sound->nchans), SCROLLBAR_MAX);
-}
-
-
-static void gsy_changed(int value, chan_info *cp)
-{
- mus_float_t low;
- low = get_scrollbar(channel_gsy(cp), value, SCROLLBAR_MAX);
- cp->gsy = (1.0 - cp->gzy) * low;
- for_each_sound_chan(cp->sound, update_graph_or_warn);
-}
-
-
-mus_float_t gsy_value(chan_info *cp)
-{
- Widget wcp;
- int ival;
- wcp = channel_gsy(cp);
- XtVaGetValues(wcp, XmNvalue, &ival, NULL);
- return((mus_float_t)ival / (mus_float_t)(SCROLLBAR_MAX));
-}
-
-
-mus_float_t gsy_size(chan_info *cp)
-{
- Widget wcp;
- int ival;
- wcp = channel_gsy(cp);
- XtVaGetValues(wcp, XmNsliderSize, &ival, NULL);
- return((mus_float_t)ival / (mus_float_t)(SCROLLBAR_MAX));
-}
-
-
-static void set_zx_scrollbar(chan_info *cp, axis_info *ap)
-{
- if (ap->x_ambit < X_RANGE_CHANGEOVER)
- set_scrollbar(channel_zx(cp), sqrt(ap->zx), .1, SCROLLBAR_MAX); /* assume size is 10% of scrollbar length */
- else set_scrollbar(channel_zx(cp), pow(ap->zx, .333), .1, SCROLLBAR_MAX);
-}
-
-
-void set_z_scrollbars(chan_info *cp, axis_info *ap)
-{
- set_zx_scrollbar(cp, ap);
- set_scrollbar(channel_zy(cp), sqrt(ap->zy), .1, SCROLLBAR_MAX);
-}
-
-
-void initialize_scrollbars(chan_info *cp)
-{
- axis_info *ap;
- snd_info *sp;
-
- cp->gzy = 1.0;
- cp->gsy = 1.0;
-
- ap = cp->axis;
- sp = cp->sound;
-
- set_scrollbar(channel_sx(cp), ap->sx, ap->zx, SCROLLBAR_MAX);
- set_scrollbar(channel_sy(cp), ap->sy, ap->zy, SCROLLBAR_MAX);
- set_z_scrollbars(cp, ap);
-
- if ((sp->nchans > 1) &&
- (cp->chan == 0) &&
- (channel_gsy(cp)))
- {
- set_scrollbar(channel_gsy(cp), 1.0, 1.0, SCROLLBAR_MAX);
- set_scrollbar(channel_gzy(cp), 1.0, 1.0 / (mus_float_t)(sp->nchans), SCROLLBAR_MAX);
- }
-}
-
-
-void resize_sy(chan_info *cp)
-{
- /* something changed the y axis view, so the scale scroller needs to reflect that change (in size and position) */
- axis_info *ap;
- ap = cp->axis;
- if (ap->y_ambit != 0.0)
- set_scrollbar(channel_sy(cp),
- (ap->y0 - ap->ymin) / ap->y_ambit,
- (ap->y1 - ap->y0) / ap->y_ambit,
- SCROLLBAR_MAX);
-}
-
-
-void resize_sy_and_zy(chan_info *cp)
-{
- resize_sy(cp);
- set_scrollbar(channel_zy(cp), sqrt(cp->axis->zy), .1, SCROLLBAR_MAX);
-}
-
-
-void resize_sx(chan_info *cp)
-{
- axis_info *ap;
- ap = cp->axis;
- if (ap->x_ambit != 0.0)
- set_scrollbar(channel_sx(cp),
- (ap->x0 - ap->xmin) / ap->x_ambit,
- (ap->x1 - ap->x0) / ap->x_ambit,
- SCROLLBAR_MAX);
-}
-
-
-void resize_sx_and_zx(chan_info *cp)
-{
- resize_sx(cp);
- /* change zx position (not its size) */
- set_zx_scrollbar(cp, cp->axis);
-}
-
-
-void channel_open_pane(chan_info *cp)
-{
- XtManageChild(channel_main_pane(cp));
-}
-
-
-void channel_unlock_pane(chan_info *cp)
-{
- XtVaSetValues(channel_main_pane(cp),
- XmNpaneMinimum, 5,
- XmNpaneMaximum, LOTSA_PIXELS,
- NULL);
-}
-
-
-static void channel_lock_pane(chan_info *cp, int val)
-{
- if (val < 6) val = 6;
- XtUnmanageChild(channel_main_pane(cp));
- XtVaSetValues(channel_main_pane(cp),
- XmNpaneMinimum, val - 5,
- XmNpaneMaximum, val + 5,
- NULL);
-}
-
-
-static void sy_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- sy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-static void sy_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- sy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-static void sx_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- sx_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-static void sx_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- sx_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-static void sx_increment_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* problem here is that in large files these increments, if determined via scrollbar values, are huge */
- /* so, move ahead one-tenth window on each tick */
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- sx_incremented(cp, 0.1);
-}
-
-
-static void sx_decrement_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- sx_incremented(cp, -0.1);
-}
-
-
-static void zy_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- zy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-static void zy_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- zy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-static void zx_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- zx_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-/* can't use value changed callback in scrollbars because they are called upon mouse release
- * even when nothing changed, and the value passed appears to be the right edge of the
- * slider -- this is too unpredictable, and the result is the window moves when the user
- * did not want it to.
- */
-
-
-static void gzy_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- gzy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-static void gsy_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- gsy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-
-static void gsy_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp = (chan_info *)(context);
- if (cp->active == CHANNEL_HAS_AXES)
- gsy_changed(((XmScrollBarCallbackStruct *)info)->value, cp);
-}
-
-/* anything special for increment? XmNincrementCallback sx_increment_callback */
-
-
-static void f_toggle_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- XButtonEvent *ev;
- ev = (XButtonEvent *)(cb->event);
- f_button_callback((chan_info *)context, cb->set, (ev->state & snd_ControlMask));
-}
-
-
-static void w_toggle_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- XButtonEvent *ev;
- ev = (XButtonEvent *)(cb->event);
- w_button_callback((chan_info *)context, cb->set, (ev->state & snd_ControlMask));
-}
-
-
-static void channel_expose_callback(Widget w, XtPointer context, XtPointer info)
-{
- static oclock_t last_expose_event_time = 0;
- static chan_info *last_cp = NULL;
- snd_info *sp;
- chan_info *cp = (chan_info *)context;
- XmDrawingAreaCallbackStruct *cb = (XmDrawingAreaCallbackStruct *)info;
- XExposeEvent *ev;
- oclock_t curtime;
-
- if ((cp == NULL) || (cp->active < CHANNEL_HAS_AXES) || (cp->sound == NULL)) return;
-
- ev = (XExposeEvent *)(cb->event);
-
- /* if multiple channels/sounds displayed, each gets an expose event, but the earlier ones
- * have count>0, and the last can get more than 1, causing our notion of last_cp to
- * be useless, and we'll drop the earlier ones anyway, so if cp != last_cp, expose
- * last_cp if last_count>0 or times equal (not sure which is safest).
- */
-
- curtime = XtLastTimestampProcessed(MAIN_DISPLAY(ss));
-
- if ((ev->count == 0) ||
- (last_expose_event_time != curtime) ||
- (cp != last_cp))
- {
- sp = cp->sound;
- if (sp->channel_style != CHANNELS_SEPARATE)
- {
- if ((cp->chan == 0) && (ev->width > 10) && (ev->height > 10))
- for_each_sound_chan(sp, update_graph_or_warn);
- }
- else update_graph_or_warn(cp);
- }
-
- last_cp = cp;
- last_expose_event_time = curtime;
-}
-
-
-static void channel_resize_callback(Widget w, XtPointer context, XtPointer info)
-{
- channel_resize((chan_info *)context);
-}
-
-
-static XEN mouse_enter_graph_hook;
-static XEN mouse_leave_graph_hook;
-
-static void graph_mouse_enter(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- pointer_or_int_t data;
- XEnterWindowEvent *ev = (XEnterWindowEvent *)event;
-
- if (with_pointer_focus(ss))
- goto_window(w);
-
- XtVaGetValues(w, XmNuserData, &data, NULL);
- if (XEN_HOOKED(mouse_enter_graph_hook))
- run_hook(mouse_enter_graph_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(UNPACK_SOUND(data)),
- C_TO_XEN_INT(UNPACK_CHANNEL(data))),
- S_mouse_enter_graph_hook);
-
- check_cursor_shape((chan_info *)context, ev->x, ev->y);
-}
-
-
-static void graph_mouse_leave(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- pointer_or_int_t data;
- XLeaveWindowEvent *ev = (XLeaveWindowEvent *)event;
-
- XtVaGetValues(w, XmNuserData, &data, NULL);
- if (XEN_HOOKED(mouse_leave_graph_hook))
- run_hook(mouse_leave_graph_hook,
- XEN_LIST_2(C_INT_TO_XEN_SOUND(UNPACK_SOUND(data)),
- C_TO_XEN_INT(UNPACK_CHANNEL(data))),
- S_mouse_leave_graph_hook);
-
- /*
- XUndefineCursor(XtDisplay(w), XtWindow(w));
- */
- check_cursor_shape((chan_info *)context, ev->x, ev->y);
-}
-
-
-static void graph_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XButtonEvent *ev = (XButtonEvent *)event;
- graph_button_press_callback((chan_info *)context, (void *)ev, ev->x, ev->y, ev->state, ev->button, ev->time);
-}
-
-
-static void graph_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont) /* cont = "continue to dispatch" */
-{
- XButtonEvent *ev = (XButtonEvent *)event;
- graph_button_release_callback((chan_info *)context, ev->x, ev->y, ev->state, ev->button);
-}
-
-#if 0
-static void graph_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{ /* mouse drag */
- XMotionEvent *ev = (XMotionEvent *)event;
- graph_button_motion_callback((chan_info *)context, ev->x, ev->y, ev->time);
-}
-#endif
-
-
-static void graph_mouse_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{ /* mouse movement */
- XMotionEvent *ev = (XMotionEvent *)event;
- if ((ev->state & Button1Mask) == 0)
- check_cursor_shape((chan_info *)context, ev->x, ev->y);
- else graph_button_motion_callback((chan_info *)context, ev->x, ev->y, ev->time);
-}
-
-
-static int no_padding(Arg *args, int n)
-{
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNmarginWidth, 0); n++;
- XtSetArg(args[n], XmNmarginTop, 0); n++;
- XtSetArg(args[n], XmNmarginBottom, 0); n++;
- XtSetArg(args[n], XmNmarginLeft, 0); n++;
- XtSetArg(args[n], XmNmarginRight, 0); n++;
- return(n);
-}
-
-
-static void hide_gz_scrollbars(snd_info *sp)
-{
- Widget w;
- w = channel_gsy(sp->chans[0]);
- if ((w) && (XtIsManaged(w))) XtUnmanageChild(w);
- w = channel_gzy(sp->chans[0]);
- if ((w) && (XtIsManaged(w))) XtUnmanageChild(w);
-}
-
-
-static void show_gz_scrollbars(snd_info *sp)
-{
- Widget w;
- w = channel_gsy(sp->chans[0]);
- if ((w) && (!XtIsManaged(w))) XtManageChild(w);
- w = channel_gzy(sp->chans[0]);
- if ((w) && (!XtIsManaged(w))) XtManageChild(w);
-}
-
-
-/* edit history support */
-
-static void history_select_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* undo/redo to reach selected position */
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- edit_history_select((chan_info *)context, cbs->item_position - 1);
-}
-
-
-#if WITH_RELATIVE_PANES
-#include <Xm/SashP.h>
-
-/* using undocumented callback here, as in snd-xsnd.c */
-static void remake_edit_history(Widget lst, chan_info *cp, int from_graph)
-{
- snd_info *sp;
- int i, eds;
- XmString *edits;
-
- if (cp->squelch_update) return;
- XmListDeleteAllItems(lst);
- sp = cp->sound;
-
- if (sp->channel_style != CHANNELS_SEPARATE)
- {
- chan_info *ncp;
- int k, all_eds = 0, ed, filelen;
- char *title;
-
- MUS_LOCK(sp->edit_history_lock);
- for (k = 0; k < sp->nchans; k++)
- {
- ncp = sp->chans[k];
- eds = ncp->edit_ctr;
- while ((eds < (ncp->edit_size - 1)) && (ncp->edits[eds + 1])) eds++;
- all_eds += eds;
- }
- all_eds += 3 * sp->nchans;
- edits = (XmString *)calloc(all_eds, sizeof(XmString));
- filelen = 16 + strlen(sp->filename);
- title = (char *)calloc(filelen, sizeof(char));
- for (k = 0, ed = 0; k < sp->nchans; k++)
- {
- ncp = sp->chans[k];
- ncp->edhist_base = ed;
- snprintf(title, filelen, "chan %d: %s", k + 1, sp->filename);
- edits[ed++] = XmStringCreateLocalized(title);
- eds = ncp->edit_ctr;
- while ((eds < (ncp->edit_size - 1)) && (ncp->edits[eds + 1])) eds++;
- for (i = 1; i <= eds; i++)
- {
- char *temp;
- temp = edit_to_string(ncp, i);
- edits[ed++] = XmStringCreateLocalized(temp);
- free(temp);
- }
- if (k < sp->nchans - 1)
- edits[ed++] = XmStringCreateLocalized((char *)"______________________________");
- }
- free(title);
- XtVaSetValues(lst,
- XmNitems, edits,
- XmNitemCount, ed,
- NULL);
- for (i = 0; i < ed; i++)
- XmStringFree(edits[i]);
- free(edits);
- XmListSelectPos(lst, cp->edhist_base + cp->edit_ctr + 1, false);
- if (from_graph) goto_graph(cp);
- MUS_UNLOCK(sp->edit_history_lock);
- }
- else
- {
- int items = 0;
- eds = cp->edit_ctr;
- while ((eds < (cp->edit_size - 1)) && (cp->edits[eds + 1])) eds++;
- edits = (XmString *)calloc(eds + 1, sizeof(XmString));
- edits[0] = XmStringCreateLocalized(sp->filename);
- for (i = 1; i <= eds; i++)
- {
- char *temp;
- temp = edit_to_string(cp, i);
- edits[i] = XmStringCreateLocalized(temp);
- free(temp);
- }
- XtVaSetValues(lst,
- XmNitems, edits,
- XmNitemCount, eds + 1,
- NULL);
- for (i = 0; i <= eds; i++)
- XmStringFree(edits[i]);
- free(edits);
- XmListSelectPos(lst, cp->edit_ctr + 1, false);
- XtVaGetValues(lst, XmNvisibleItemCount, &items, NULL);
- if (items <= eds)
- XtVaSetValues(lst, XmNtopItemPosition, eds - items + 2, NULL);
- if (from_graph) goto_graph(cp);
- }
-}
-
-
-static void watch_edit_history_sash(Widget w, XtPointer closure, XtPointer info)
-{
- SashCallData call_data = (SashCallData)info;
- /* call_data->params[0]: Commit, Move, Key, Start (as strings) */
- if ((call_data->params) &&
- (mus_strcmp(call_data->params[0], "Start")))
- {
- chan_info *cp = (chan_info *)closure;
- Widget edhist;
- if ((cp) && (cp->chan_widgets))
- {
- edhist = EDIT_HISTORY_LIST(cp);
- if (edhist)
- remake_edit_history(edhist, cp, false);
- }
- }
-}
-#endif
-
-
-void reflect_edit_history_change(chan_info *cp)
-{
- /* new edit so it is added, and any trailing lines removed */
- snd_info *sp;
- Widget lst;
-
- if (cp->squelch_update) return;
- if (cp->in_as_one_edit > 0) return;
- sp = cp->sound;
- lst = EDIT_HISTORY_LIST(cp);
-#if WITH_RELATIVE_PANES
- if ((lst) && (widget_width(lst) > 1))
- remake_edit_history(lst, cp, true);
- else
- {
- if ((cp->chan > 0) && (sp->channel_style != CHANNELS_SEPARATE))
- {
- lst = EDIT_HISTORY_LIST(sp->chans[0]);
- if ((lst) && (widget_width(lst) > 1))
- remake_edit_history(lst, sp->chans[0], true);
- }
- }
-#else
- /* old form */
- if (lst)
- {
- int i, eds, items = 0;
- XmString *edits;
- eds = cp->edit_ctr;
- while ((eds < (cp->edit_size - 1)) && (cp->edits[eds + 1])) eds++;
- if (eds >= 0)
- {
- if ((eds == cp->edit_ctr) && (eds > 1)) /* need to force 0 (1) case to start list with sound file name */
- {
- XmString edit;
- /* special common case -- we're appending a new edit description */
- XtVaGetValues(lst, XmNitemCount, &items, NULL);
- if (items > eds )
- XmListDeleteItemsPos(lst, cp->edit_size, eds + 1);
- /* cp->edit_size is too large, but the manual says this is the way to delete to the end */
- {
- char *temp;
- temp = edit_to_string(cp, eds);
- edit = XmStringCreateLocalized(temp);
- free(temp);
- }
- XmListAddItemUnselected(lst, edit, eds + 1);
- XmStringFree(edit);
- }
- else
- {
- edits = (XmString *)calloc(eds + 1, sizeof(XmString));
- edits[0] = XmStringCreateLocalized(sp->filename);
- for (i = 1; i <= eds; i++)
- {
- char *temp;
- temp = edit_to_string(cp, i);
- edits[i] = XmStringCreateLocalized(temp);
- free(temp);
- }
- XtVaSetValues(lst,
- XmNitems, edits,
- XmNitemCount, eds + 1,
- NULL);
- for (i = 0; i <= eds; i++)
- XmStringFree(edits[i]);
- free(edits);
- }
- XmListSelectPos(lst, cp->edit_ctr + 1, false);
- XtVaGetValues(lst, XmNvisibleItemCount, &items, NULL);
- if (items <= eds)
- XtVaSetValues(lst, XmNtopItemPosition, eds - items + 2, NULL);
- goto_graph(cp);
- }
- }
-#endif
-}
-
-
-void reflect_edit_counter_change(chan_info *cp)
-{
- /* undo/redo/revert -- change which line is highlighted */
- Widget lst;
-
- if (cp->squelch_update) return;
- lst = EDIT_HISTORY_LIST(cp);
- if ((lst) && (widget_width(lst) > 1))
- {
- int len, top;
- XmListSelectPos(lst, cp->edit_ctr + 1, false);
- XtVaGetValues(lst,
- XmNvisibleItemCount, &len,
- XmNtopItemPosition, &top,
- NULL);
- if ((cp->edit_ctr + 1) < top)
- XtVaSetValues(lst, XmNtopItemPosition, cp->edit_ctr + 1, NULL);
- else
- if ((cp->edit_ctr + 1) >= (top + len))
- XtVaSetValues(lst, XmNtopItemPosition, cp->edit_ctr, NULL);
- goto_graph(cp);
- }
-}
-
-
-/* for combined cases, the incoming chan_info pointer is always chan[0],
- * but the actual channel depends on placement if mouse oriented.
- * virtual_selected_channel(cp) (snd-chn.c) retains the current selected channel
- */
-
-void graph_key_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XKeyEvent *ev = (XKeyEvent *)event;
- KeySym keysym;
- int key_state;
- snd_info *sp = (snd_info *)context;
- key_state = ev->state;
- keysym = XKeycodeToKeysym(XtDisplay(w),
- (int)(ev->keycode),
- (key_state & snd_ShiftMask) ? 1 : 0);
- key_press_callback(any_selected_channel(sp), ev->x, ev->y, ev->state, keysym);
-}
-
-
-static void cp_graph_key_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- /* called by every key-intercepting widget in the entire sound pane */
- XKeyEvent *ev = (XKeyEvent *)event;
- KeySym keysym;
- int key_state;
- chan_info *cp = (chan_info *)context;
- if ((cp == NULL) || (cp->sound == NULL)) return; /* can't happen */
- key_state = ev->state;
- keysym = XKeycodeToKeysym(XtDisplay(w),
- (int)(ev->keycode),
- (key_state & snd_ShiftMask) ? 1 : 0);
- key_press_callback(cp, ev->x, ev->y, ev->state, keysym);
-}
-
-
-static void channel_drop_watcher(Widget w, const char *str, Position x, Position y, void *context)
-{
- pointer_or_int_t data;
- data = (pointer_or_int_t)context;
- drag_and_drop_mix_at_x_y((int)data, str, x, y);
-}
-
-
-static void channel_drag_watcher(Widget w, const char *str, Position x, Position y, drag_style_t dtype, void *context)
-{
- int snd, chn;
- pointer_or_int_t data;
- snd_info *sp;
- chan_info *cp;
- float seconds;
- XtVaGetValues(w, XmNuserData, &data, NULL);
- chn = UNPACK_CHANNEL(data);
- snd = UNPACK_SOUND(data);
-
- sp = ss->sounds[snd];
- if (snd_ok(sp))
- {
- switch (dtype)
- {
- case DRAG_ENTER:
- case DRAG_MOTION:
- cp = sp->chans[chn];
- if ((sp->nchans > 1) && (sp->channel_style == CHANNELS_COMBINED))
- cp = which_channel(sp, y);
- seconds = (float)(ungrf_x(cp->axis, x));
- if (seconds < 0.0) seconds = 0.0;
- if (sp->nchans > 1)
- report_in_minibuffer(sp, "drop to mix file in chan %d at %.4f", cp->chan + 1, seconds);
- else report_in_minibuffer(sp, "drop to mix file at %.4f", seconds);
- break;
-
- case DRAG_LEAVE:
- string_to_minibuffer(sp, " "); /* not clear_minibuffer here! => segfault */
- break;
- }
- }
-}
-
-
-int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Widget main, fw_button_t button_style, bool with_events)
-{
- int i;
- bool need_extra_scrollbars;
- Widget *cw;
- chan_info *cp;
- graphics_context *cax;
- bool make_widgets;
-
- /* if ((main) && ((!(XmIsForm(main))) || (!(XtWindow(main))))) return(-1); */ /* new gcc complains about the XmIsForm for some reason */
- if ((main) && (!(XtWindow(main)))) return(-1); /* can this happen? */
-
- make_widgets = ((sp->chans[channel]) == NULL);
- sp->chans[channel] = make_chan_info(sp->chans[channel], channel, sp);
- cp = sp->chans[channel];
-
- if (cp->chan_widgets == NULL)
- cp->chan_widgets = (Widget *)calloc(NUM_CHAN_WIDGETS, sizeof(Widget));
- cw = cp->chan_widgets;
- need_extra_scrollbars = ((!main) && (channel == 0));
-
- if (make_widgets)
- {
- XtCallbackList n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12, n13, n14, n15;
- int n;
- Arg args[32];
-
- /* allocate the entire widget apparatus for this channel of this sound */
-
- if (!main)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- if (insertion) {XtSetArg(args[n], XmNpositionIndex, (short)channel); n++;}
- XtSetArg(args[n], XmNpaneMinimum, chan_y); n++;
-
- cw[W_form] = XtCreateManagedWidget("chn-form", xmFormWidgetClass, w_snd_pane(sp), args, n);
- if ((sp->channel_style == CHANNELS_COMBINED) && (channel > 0)) XtUnmanageChild(cw[W_form]);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- /* n = no_padding(args, n); */
- n = attach_all_sides(args, n);
- XtSetArg(args[n], XmNsashIndent, 2); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
- cw[W_top] = XtCreateManagedWidget("chn-top", xmPanedWindowWidgetClass, cw[W_form], args, n);
- XtAddEventHandler(cw[W_top], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNpaneMaximum, DEFAULT_EDIT_HISTORY_WIDTH); n++;
- XtSetArg(args[n], XmNlistSizePolicy, XmCONSTANT); n++;
- cw[W_edhist] = XmCreateScrolledList(cw[W_top], (char *)"chn-edhist", args, n);
- XtManageChild(cw[W_edhist]);
-
- XtAddCallback(cw[W_edhist], XmNbrowseSelectionCallback, history_select_callback, cp);
- XtAddEventHandler(cw[W_edhist], KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddEventHandler(XtParent(cw[W_edhist]), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
- cw[W_main_window] = XtCreateManagedWidget("chn-main-window", xmFormWidgetClass, cw[W_top], args, n);
- XtAddEventHandler(cw[W_main_window], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
-#if WITH_RELATIVE_PANES
- {
- int k;
- Widget child;
- CompositeWidget w = (CompositeWidget)(cw[W_top]);
- for (k = w->composite.num_children - 1; k >= 0; k--)
- {
- child = w->composite.children[k];
- if ((XtIsWidget(child)) &&
- (XtIsSubclass(child, xmSashWidgetClass)))
- {
- XtAddCallback(child, XmNcallback, watch_edit_history_sash, (XtPointer)cp);
- break; /* there seems to be more than 1?? */
- }
- }
- }
-#endif
- }
- else cw[W_main_window] = main;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- n = no_padding(args, n);
- XtSetArg(args[n], XmNpacking, XmPACK_COLUMN); n++;
- XtSetArg(args[n], XmNnumColumns, 1); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- cw[W_wf_buttons] = XtCreateManagedWidget("chn-buttons", xmRowColumnWidgetClass, cw[W_main_window], args, n);
-
- if (button_style == WITH_FW_BUTTONS)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNspacing, 1); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- cw[W_f] = make_togglebutton_widget("f", cw[W_wf_buttons], args, n);
- XtAddCallback(cw[W_f], XmNvalueChangedCallback, f_toggle_callback, cp);
- XtAddEventHandler(cw[W_f], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- XtSetArg(args[n], XmNset, true); n++;
- cw[W_w] = make_togglebutton_widget("w", cw[W_wf_buttons], args, n);
- XtAddCallback(cw[W_w], XmNvalueChangedCallback, w_toggle_callback, cp);
- XtAddEventHandler(cw[W_w], KeyPressMask, false, graph_key_press, (XtPointer)sp);
- }
- else
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNarrowDirection, XmARROW_UP); n++;
- XtSetArg(args[n], XmNsensitive, false); n++;
- cw[W_f] = XtCreateManagedWidget("up", xmArrowButtonWidgetClass, cw[W_wf_buttons], args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNarrowDirection, XmARROW_DOWN); n++;
- XtSetArg(args[n], XmNsensitive, false); n++;
- cw[W_w] = XtCreateManagedWidget("down", xmArrowButtonWidgetClass, cw[W_wf_buttons], args, n);
- }
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, cw[W_wf_buttons]); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNspacing, 0); n++;
- cw[W_left_scrollers] = XtCreateManagedWidget("chn-left", xmRowColumnWidgetClass, cw[W_main_window], args, n);
- XtAddEventHandler(cw[W_left_scrollers], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
- XtSetArg(args[n], XmNwidth, ss->position_slider_width); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNincrement, 1); n++;
- XtSetArg(args[n], XmNprocessingDirection, XmMAX_ON_TOP); n++;
- XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(zy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(zy_valuechanged_callback, (XtPointer)cp)); n++;
- cw[W_zy] = XtCreateManagedWidget("chn-zy", xmScrollBarWidgetClass, cw[W_left_scrollers], args, n);
- XtAddEventHandler(cw[W_zy], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNwidth, ss->zoom_slider_width); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, cw[W_zy]); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNincrement, 1); n++;
- XtSetArg(args[n], XmNprocessingDirection, XmMAX_ON_TOP); n++;
- XtSetArg(args[n], XmNdragCallback, n3 = make_callback_list(sy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n4 = make_callback_list(sy_valuechanged_callback, (XtPointer)cp)); n++;
- cw[W_sy] = XtCreateManagedWidget("chn-sy", xmScrollBarWidgetClass, cw[W_left_scrollers], args, n);
- XtAddEventHandler(cw[W_sy], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, cw[W_wf_buttons]); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNspacing, 0); n++;
- cw[W_bottom_scrollers] = XtCreateManagedWidget("chn-bottom", xmRowColumnWidgetClass, cw[W_main_window], args, n);
- XtAddEventHandler(cw[W_bottom_scrollers], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNheight, ss->position_slider_width); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNincrement, 1); n++;
- XtSetArg(args[n], XmNdragCallback, n5 = make_callback_list(sx_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNincrementCallback, n6 = make_callback_list(sx_increment_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNdecrementCallback, n7 = make_callback_list(sx_decrement_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n8 = make_callback_list(sx_valuechanged_callback, (XtPointer)cp)); n++;
- cw[W_sx] = XtCreateManagedWidget("chn-sx", xmScrollBarWidgetClass, cw[W_bottom_scrollers], args, n);
- XtAddEventHandler(cw[W_sx], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
- XtSetArg(args[n], XmNheight, ss->zoom_slider_width + 2); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, cw[W_sx]); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNincrement, 1); n++;
- XtSetArg(args[n], XmNdragCallback, n9 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNincrementCallback, n10 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNdecrementCallback, n11 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNpageIncrementCallback, n12 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNpageDecrementCallback, n13 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNtoTopCallback, n14 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNtoBottomCallback, n15 = make_callback_list(zx_drag_callback, (XtPointer)cp)); n++;
-
- cw[W_zx] = XtCreateManagedWidget("chn-zx", xmScrollBarWidgetClass, cw[W_bottom_scrollers], args, n);
- XtAddEventHandler(cw[W_zx], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->graph_color); n++;
- XtSetArg(args[n], XmNforeground, ss->data_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, cw[W_bottom_scrollers]); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, cw[W_left_scrollers]); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNuserData, PACK_SOUND_AND_CHANNEL(sp->index, cp->chan)); n++;
- /* this collides with W_gzy below, but a consistent version came up with half a window blank */
- XtSetArg(args[n], XmNnavigationType, XmNONE); n++;
- cw[W_graph] = XtCreateManagedWidget("chn-graph", xmDrawingAreaWidgetClass, cw[W_main_window], args, n);
-
- if (with_events)
- {
- /* region regraph sets up its own callbacks */
- XtAddCallback(cw[W_graph], XmNresizeCallback, channel_resize_callback, (XtPointer)cp);
- XtAddCallback(cw[W_graph], XmNexposeCallback, channel_expose_callback, (XtPointer)cp);
- }
- /* allow cursor in all cases (zoom to cursor in region window for example, or fft axis drag in variable display) */
- XtAddEventHandler(cw[W_graph], ButtonPressMask, false, graph_button_press, (XtPointer)cp);
- XtAddEventHandler(cw[W_graph], ButtonReleaseMask, false, graph_button_release, (XtPointer)cp);
- /* XtAddEventHandler(cw[W_graph], ButtonMotionMask, false, graph_button_motion, (XtPointer)cp); */
- XtAddEventHandler(cw[W_graph], PointerMotionMask, false, graph_mouse_motion, (XtPointer)cp);
- if (main == NULL)
- {
- pointer_or_int_t data;
- XtAddEventHandler(cw[W_graph], EnterWindowMask, false, graph_mouse_enter, (XtPointer)cp);
- XtAddEventHandler(cw[W_graph], LeaveWindowMask, false, graph_mouse_leave, (XtPointer)cp);
- XtAddEventHandler(cw[W_graph], KeyPressMask, false, cp_graph_key_press, (XtPointer)cp);
-
- data = (pointer_or_int_t)PACK_SOUND_AND_CHANNEL(sp->index, cp->chan);
- add_drag_and_drop(cw[W_graph], channel_drop_watcher, channel_drag_watcher, (void *)data);
- }
-
- free(n1);
- free(n2);
- free(n3);
- free(n4);
- free(n5);
- free(n6);
- free(n7);
- free(n8);
- free(n9);
- free(n10);
- free(n11);
- free(n12);
- free(n13);
- free(n14);
- free(n15);
-
- if (need_extra_scrollbars)
- {
- /* that is: not region browser chan, might need combined graph, channel 0 is the controller in that case */
- /* this is independent of sp->nchans because these structs are re-used and added to as needed */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
- XtSetArg(args[n], XmNwidth, ss->position_slider_width); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, cw[W_bottom_scrollers]); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNincrement, 1); n++;
- XtSetArg(args[n], XmNprocessingDirection, XmMAX_ON_TOP); n++;
-
- XtSetArg(args[n], XmNincrementCallback, n1 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNdecrementCallback, n2 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNpageIncrementCallback, n3 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNpageDecrementCallback, n4 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNtoTopCallback, n5 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNtoBottomCallback, n6 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNdragCallback, n7 = make_callback_list(gzy_drag_callback, (XtPointer)cp)); n++;
-
- cw[W_gzy] = XtCreateManagedWidget("chn-gzy", xmScrollBarWidgetClass, cw[W_main_window], args, n);
- XtAddEventHandler(cw[W_gzy], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNwidth, ss->position_slider_width); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, cw[W_bottom_scrollers]); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, cw[W_gzy]); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNincrement, 1); n++;
- XtSetArg(args[n], XmNprocessingDirection, XmMAX_ON_TOP); n++;
- XtSetArg(args[n], XmNdragCallback, n8 = make_callback_list(gsy_drag_callback, (XtPointer)cp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n9 = make_callback_list(gsy_valuechanged_callback, (XtPointer)cp)); n++;
- cw[W_gsy] = XtCreateManagedWidget("chn-gsy", xmScrollBarWidgetClass, cw[W_main_window], args, n);
- XtAddEventHandler(cw[W_gsy], KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- free(n1);
- free(n2);
- free(n3);
- free(n4);
- free(n5);
- free(n6);
- free(n7);
-
- free(n8);
- free(n9);
- }
- else
- {
- cw[W_gsy] = NULL;
- cw[W_gzy] = NULL;
- }
- run_new_widget_hook(cw[W_main_window]);
- /* also position of current graph in overall sound as window */
-
- } /* end alloc new chan */
-
- else
-
- {
- /* re-manage currently inactive chan */
- XtVaSetValues(cw[W_main_window], XmNpaneMinimum, chan_y, NULL);
- if (cw[W_edhist])
- XtVaSetValues(XtParent(cw[W_edhist]), XmNpaneMaximum, 1, NULL);
- if ((sp->channel_style != CHANNELS_COMBINED) ||
- (channel == 0))
- for (i = 0; i < NUM_CHAN_WIDGETS - 1; i++)
- if ((cw[i]) && (!XtIsManaged(cw[i])))
- XtManageChild(cw[i]);
- recolor_graph(cp, false); /* in case selection color left over from previous use */
- }
-
- if (cw[W_edhist])
- XtVaSetValues(XtParent(cw[W_edhist]), XmNpaneMaximum, LOTSA_PIXELS, NULL);
-
- if ((need_extra_scrollbars) &&
- (sp->channel_style != CHANNELS_COMBINED))
- hide_gz_scrollbars(sp); /* default is on in this case */
-
- cax = cp->ax;
- cax->wn = XtWindow(cw[W_graph]);
- cax->dp = XtDisplay(cw[W_graph]);
- cax->gc = ss->basic_gc;
- return(0);
-}
-
-
-static void set_graph_font(chan_info *cp, graphics_context *ax, XFontStruct *bf)
-{
- if (!ax) return;
- ax->current_font = bf->fid;
- XSetFont(XtDisplay(cp->chan_widgets[W_graph]), copy_GC(cp), bf->fid);
-}
-
-
-void set_peak_numbers_font(chan_info *cp, graphics_context *ax) {set_graph_font(cp, ax, PEAKS_FONT(ss));}
-
-void set_tiny_numbers_font(chan_info *cp, graphics_context *ax) {set_graph_font(cp, ax, TINY_FONT(ss));}
-
-void set_bold_peak_numbers_font(chan_info *cp, graphics_context *ax) {set_graph_font(cp, ax, BOLD_PEAKS_FONT(ss));}
-
-
-color_t get_foreground_color(graphics_context *ax)
-{
- XGCValues gv;
- XGetGCValues(MAIN_DISPLAY(ss), ax->gc, GCForeground, &gv);
- return(gv.foreground);
-}
-
-
-void set_foreground_color(graphics_context *ax, Pixel color)
-{
- XSetForeground(MAIN_DISPLAY(ss), ax->gc, color);
-}
-
-
-GC copy_GC(chan_info *cp)
-{
- if (cp->selected) return(ss->selected_basic_gc);
- return(ss->basic_gc);
-}
-
-
-GC erase_GC(chan_info *cp)
-{
- /* used only to clear partial bgs in chan graphs */
- snd_info *sp;
- sp = cp->sound;
- if ((cp->selected) ||
- ((sp) &&
- (sp->channel_style == CHANNELS_SUPERIMPOSED) &&
- (sp->index == ss->selected_sound)))
- return(ss->selected_erase_gc);
- return(ss->erase_gc);
-}
-
-
-void free_fft_pix(chan_info *cp)
-{
- if ((cp->fft_pix != None) &&
- (channel_graph(cp)))
- XFreePixmap(XtDisplay(channel_graph(cp)),
- cp->fft_pix);
- cp->fft_pix = None;
- cp->fft_pix_ready = false;
-}
-
-
-bool restore_fft_pix(chan_info *cp, graphics_context *ax)
-{
- XCopyArea(ax->dp,
- cp->fft_pix,
- ax->wn,
- copy_GC(cp),
- 0, 0, /* source x y */
- cp->fft_pix_width, cp->fft_pix_height,
- cp->fft_pix_x0, cp->fft_pix_y0);
- return(true);
-}
-
-
-void save_fft_pix(chan_info *cp, graphics_context *ax, int fwidth, int fheight, int x0, int y1)
-{
- if ((fwidth == 0) || (fheight == 0)) return;
- if (cp->fft_pix == None)
- {
- /* make new pixmap */
- cp->fft_pix_width = fwidth;
- cp->fft_pix_height = fheight;
- cp->fft_pix_x0 = x0;
- cp->fft_pix_y0 = y1;
- cp->fft_pix_cutoff = cp->spectrum_end;
- cp->fft_pix = XCreatePixmap(ax->dp,
- RootWindowOfScreen(XtScreen(channel_graph(cp))),
- fwidth, fheight,
- DefaultDepthOfScreen(XtScreen(channel_graph(cp))));
- }
- XCopyArea(ax->dp,
- ax->wn,
- cp->fft_pix,
- copy_GC(cp),
- cp->fft_pix_x0, cp->fft_pix_y0,
- cp->fft_pix_width, cp->fft_pix_height,
- 0, 0);
- cp->fft_pix_ready = true;
-}
-
-
-void cleanup_cw(chan_info *cp)
-{
- if (cp)
- {
- Widget *cw;
- free_fft_pix(cp);
-
- cp->selected = false;
- cw = cp->chan_widgets;
- if (cw)
- {
- if (cw[W_w])
- {
- XtVaSetValues(cw[W_w], XmNset, true, NULL);
- XtVaSetValues(cw[W_f], XmNset, false, NULL);
- }
- if (channel_main_pane(cp))
- XtUnmanageChild(channel_main_pane(cp));
- }
- }
-}
-
-
-void change_channel_style(snd_info *sp, channel_style_t new_style)
-{
- if ((sp) &&
- (sp->nchans > 1))
- {
- int i;
- channel_style_t old_style;
-
- old_style = sp->channel_style;
- sp->channel_style = new_style;
-
- if (new_style != old_style)
- {
- int height;
-
-#if WITH_RELATIVE_PANES
- if ((new_style == CHANNELS_SEPARATE) || (old_style == CHANNELS_SEPARATE))
- {
- Widget lst;
- lst = EDIT_HISTORY_LIST(sp->chans[0]);
- if ((lst) && (widget_width(lst) > 1))
- remake_edit_history(lst, sp->chans[0], true);
- }
-#endif
-
- if (old_style == CHANNELS_COMBINED)
- {
- hide_gz_scrollbars(sp);
- for (i = 1; i < sp->nchans; i++) channel_set_mix_tags_erased(sp->chans[i]);
- }
- else
- {
- if (new_style == CHANNELS_COMBINED)
- {
- show_gz_scrollbars(sp);
- for (i = 1; i < sp->nchans; i++) channel_set_mix_tags_erased(sp->chans[i]);
- }
- }
-
- if (old_style == CHANNELS_SUPERIMPOSED)
- {
- syncb(sp, sp->previous_sync);
- XtVaSetValues(unite_button(sp), XmNselectColor, ss->selection_color, NULL);
- }
- else
- {
- if (new_style == CHANNELS_SUPERIMPOSED)
- {
- sp->previous_sync = sp->sync;
- if (sp->sync == 0) syncb(sp, 1);
- XtVaSetValues(unite_button(sp), XmNselectColor, ss->green, NULL);
- apply_y_axis_change((sp->chans[0])->axis, sp->chans[0]);
- apply_x_axis_change((sp->chans[0])->axis, sp->chans[0]);
- for (i = 1; i < sp->nchans; i++)
- CURSOR(sp->chans[i]) = CURSOR(sp->chans[0]);
- }
- }
-
- height = widget_height(w_snd_pane(sp)) - control_panel_height(sp);
- if (old_style == CHANNELS_SEPARATE)
- {
- chan_info *ncp;
- ncp = sp->chans[0];
- channel_lock_pane(ncp, height);
-
- for (i = 1; i < sp->nchans; i++)
- cleanup_cw(sp->chans[i]);
-
- channel_open_pane(sp->chans[0]);
- channel_unlock_pane(sp->chans[0]);
- XmToggleButtonSetState(unite_button(sp), true, false);
- }
- else
- {
- if (new_style == CHANNELS_SEPARATE)
- {
- axis_info *ap;
- chan_info *pcp;
-
- /* height = total space available */
- height /= sp->nchans;
- for_each_sound_chan_with_int(sp, channel_lock_pane, height);
- for_each_sound_chan(sp, channel_open_pane);
- for_each_sound_chan(sp, channel_unlock_pane);
-
- pcp = sp->chans[0];
- ap = pcp->axis;
- for (i = 1; i < sp->nchans; i++)
- {
- Widget *cw;
- chan_info *cp;
- int j;
-
- cp = sp->chans[i];
- cw = cp->chan_widgets;
-
- for (j = 0; j < NUM_CHAN_WIDGETS - 1; j++)
- if ((cw[j]) && (!XtIsManaged(cw[j])))
- XtManageChild(cw[j]);
-
- XmToggleButtonSetState(cw[W_f], (Boolean)(cp->graph_transform_p), false);
- XmToggleButtonSetState(cw[W_w], (Boolean)(cp->graph_time_p), false);
- /* these can get out of sync if changes are made in the unseparated case */
- set_axes(cp, ap->x0, ap->x1, ap->y0, ap->y1);
- }
-
- XmToggleButtonSetState(unite_button(sp), false, false);
- if (sp->selected_channel > 0) color_selected_channel(sp);
- }
- }
-
- if ((new_style == CHANNELS_COMBINED) &&
- (sp->selected_channel > 0))
- color_selected_channel(sp);
- }
- }
-}
-
-
-static XEN g_channel_widgets(XEN snd, XEN chn)
-{
- #define H_channel_widgets "(" S_channel_widgets " :optional snd chn): a list of widgets: ((0)graph (1)w (2)f (3)sx (4)sy (5)zx (6)zy (7)edhist)"
- chan_info *cp;
- ASSERT_CHANNEL(S_channel_widgets, snd, chn, 1);
- cp = get_cp(snd, chn, S_channel_widgets);
- if (!cp) return(XEN_FALSE);
- return(XEN_CONS(XEN_WRAP_WIDGET(channel_graph(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_w(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_f(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_sx(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_sy(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_zx(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_zy(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(EDIT_HISTORY_LIST(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_gsy(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_gzy(cp)),
- XEN_CONS(XEN_WRAP_WIDGET(channel_main_pane(cp)),
- XEN_EMPTY_LIST))))))))))));
-}
-
-
-/* previous snd-xxen.c contents) */
-
-static void timed_eval(XtPointer in_code, XtIntervalId *id)
-{
-#if HAVE_EXTENSION_LANGUAGE
- XEN lst = (XEN)in_code;
- XEN_CALL_0(XEN_CADR(lst), "timed callback func");
- snd_unprotect_at(XEN_TO_C_INT(XEN_CAR(lst)));
-#endif
-}
-
-
-static XEN g_in(XEN ms, XEN code)
-{
- #define H_in "(" S_in " msecs thunk): invoke thunk in msecs milliseconds (named call_in in Ruby)"
-
-#if HAVE_EXTENSION_LANGUAGE
- XEN_ASSERT_TYPE(XEN_NUMBER_P(ms), ms, XEN_ARG_1, S_in, "a number");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(code), code, XEN_ARG_2, S_in, "a procedure");
-
- if (XEN_REQUIRED_ARGS_OK(code, 0))
- {
- int secs;
- secs = XEN_TO_C_INT(ms);
- if (secs < 0)
- XEN_OUT_OF_RANGE_ERROR(S_in, XEN_ARG_1, ms, "a positive integer");
- else
- {
- XEN lst;
- lst = XEN_LIST_2(XEN_FALSE, code);
- XEN_LIST_SET(lst, 0, C_TO_XEN_INT(snd_protect(lst)));
- XtAppAddTimeOut(MAIN_APP(ss),
- (unsigned long)secs,
- (XtTimerCallbackProc)timed_eval,
- (XtPointer)lst);
- /* the "code" arg can still be something misleading like an applicable smob */
- /* there's a way to catch that in run.c line 129, but I'm not sure it's the "right thing" here */
- }
- }
- else XEN_BAD_ARITY_ERROR(S_in, 2, code, "should take no args");
-#endif
-
- return(ms);
-}
-
-
-void color_unselected_graphs(color_t color)
-{
- int i;
- for (i = 0; i < ss->max_sounds; i++)
- {
- snd_info *sp;
- int j;
- sp = ss->sounds[i];
- if ((sp) && (sp->inuse != SOUND_WRAPPER))
- for (j = 0; j < sp->allocated_chans; j++)
- {
- chan_info *cp;
- cp = sp->chans[j];
- if ((cp) && ((i != ss->selected_sound) || (j != sp->selected_channel)))
- XtVaSetValues(channel_graph(cp), XmNbackground, color, NULL);
- }
- }
-}
-
-
-void color_chan_components(color_t color, slider_choice_t which_component)
-{
- int i;
- for (i = 0; i < ss->max_sounds; i++)
- {
- snd_info *sp;
- int j;
- sp = ss->sounds[i];
- if ((sp) && (sp->inuse != SOUND_WRAPPER))
- for (j = 0; j < sp->allocated_chans; j++)
- {
- chan_info *cp;
- cp = sp->chans[j];
- if (cp)
- {
- if (which_component == COLOR_POSITION)
- {
- XtVaSetValues(channel_sx(cp), XmNbackground, color, NULL);
- XtVaSetValues(channel_sy(cp), XmNbackground, color, NULL);
- }
- else
- {
- XtVaSetValues(channel_zy(cp), XmNbackground, color, NULL);
- XtVaSetValues(channel_zx(cp), XmNbackground, color, NULL);
- }
- }
- }
- }
-}
-
-
-static XEN g_graph_cursor(void)
-{
- #define H_graph_cursor "(" S_graph_cursor "): current graph cursor shape"
- return(C_TO_XEN_INT(in_graph_cursor(ss)));
-}
-
-
-#include <X11/cursorfont.h>
-
-static XEN g_set_graph_cursor(XEN curs)
-{
- int val;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(curs), curs, XEN_ONLY_ARG, S_setB S_graph_cursor, "an integer");
- /* X11/cursorfont.h has various even-numbered glyphs, but the odd numbers are ok, and XC_num_glyphs is a lie */
- /* if you use too high a number here, X dies */
- val = XEN_TO_C_INT(curs);
- if ((val >= 0) && (val <= XC_xterm))
- {
- ss->Graph_Cursor = val;
- ss->graph_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), in_graph_cursor(ss));
- }
- else XEN_OUT_OF_RANGE_ERROR(S_setB S_graph_cursor, 1, curs, "~A: invalid cursor");
- return(curs);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_2(g_in_w, g_in)
-XEN_NARGIFY_0(g_graph_cursor_w, g_graph_cursor)
-XEN_NARGIFY_1(g_set_graph_cursor_w, g_set_graph_cursor)
-XEN_ARGIFY_2(g_channel_widgets_w, g_channel_widgets)
-#else
-#define g_in_w g_in
-#define g_graph_cursor_w g_graph_cursor
-#define g_set_graph_cursor_w g_set_graph_cursor
-#define g_channel_widgets_w g_channel_widgets
-#endif
-
-
-void g_init_gxchn(void)
-{
- XEN_DEFINE_PROCEDURE(S_in, g_in_w, 2, 0, 0, H_in);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_graph_cursor, g_graph_cursor_w, H_graph_cursor,
- S_setB S_graph_cursor, g_set_graph_cursor_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE(S_channel_widgets, g_channel_widgets_w, 0, 2, 0, H_channel_widgets);
-
-#if HAVE_SCHEME
- #define H_mouse_enter_graph_hook S_mouse_enter_graph_hook " (snd chn): called when the mouse \
-enters the drawing area (graph pane) of the given channel.\n\
- (add-hook! " S_mouse_enter_graph_hook "\n\
- (lambda (snd chn)\n\
- (" S_focus_widget " (car (" S_channel_widgets " snd chn)))))"
-
- #define H_mouse_leave_graph_hook S_mouse_leave_graph_hook " (snd chn): is called when the mouse \
-leaves the drawing area (graph pane) of the given channel."
-#endif
-#if HAVE_RUBY
- #define H_mouse_enter_graph_hook S_mouse_enter_graph_hook " (snd chn): called when the mouse \
-enters the drawing area (graph pane) of the given channel.\n\
- $mouse_enter_graph_hook.add-hook!(\"focus\") do |snd chn|\n\
- focus_widget(channel_widgets(snd, chn)[0])\n\
- end"
-
- #define H_mouse_leave_graph_hook S_mouse_leave_graph_hook " (snd chn): called when the mouse \
-leaves the drawing area (graph pane) of the given channel."
-#endif
-#if HAVE_FORTH
- #define H_mouse_enter_graph_hook S_mouse_enter_graph_hook " (snd chn): called when the mouse \
-enters the drawing area (graph pane) of the given channel.\n\
-" S_mouse_enter_graph_hook " lambda: <{ snd chn }>\n\
- snd chn " S_channel_widgets " car " S_focus_widget "\n\
-; add-hook!"
- #define H_mouse_leave_graph_hook S_mouse_leave_graph_hook " (snd chn): is called when the mouse \
-leaves the drawing area (graph pane) of the given channel."
-#endif
-
- mouse_enter_graph_hook = XEN_DEFINE_HOOK(S_mouse_enter_graph_hook, 2, H_mouse_enter_graph_hook); /* args = snd chn */
- mouse_leave_graph_hook = XEN_DEFINE_HOOK(S_mouse_leave_graph_hook, 2, H_mouse_leave_graph_hook); /* args = snd chn */
-}
diff --git a/snd-xdraw.c b/snd-xdraw.c
deleted file mode 100644
index a63ea74..0000000
--- a/snd-xdraw.c
+++ /dev/null
@@ -1,1429 +0,0 @@
-#include "snd.h"
-
-#include <Xm/ScaleP.h>
-/* needed to set the scale title background */
-
-
-void draw_line(graphics_context *ax, int x0, int y0, int x1, int y1)
-{
- XDrawLine(ax->dp, ax->wn, ax->gc, x0, y0, x1, y1);
-}
-
-
-void fill_rectangle(graphics_context *ax, int x0, int y0, int width, int height)
-{
- XFillRectangle(ax->dp, ax->wn, ax->gc, x0, y0, width, height);
-}
-
-
-void erase_rectangle(chan_info *cp, graphics_context *ax, int x0, int y0, int width, int height)
-{
- XFillRectangle(ax->dp, ax->wn, erase_GC(cp), x0, y0, width, height);
-}
-
-
-void draw_string(graphics_context *ax, int x0, int y0, const char *str, int len)
-{
- if ((str) && (*str))
- XDrawString(ax->dp, ax->wn, ax->gc, x0, y0, str, len);
-}
-
-
-void gtk_style_draw_string(graphics_context *ax, int x0, int y0, const char *str, int len)
-{
- /* for callers of Scheme-level draw-string, the Motif and Gtk versions should agree on where "y0" is */
- XGCValues gv;
- static XFontStruct *fs = NULL;
-
- XGetGCValues(MAIN_DISPLAY(ss), ax->gc, GCFont, &gv);
-
- /* now gv.font is the default font */
- if (fs) XFree(fs);
- /* this doesn't free all the space */
- /* but this: */
- /* if (fs) XFreeFont(MAIN_DISPLAY(ss), fs); */
- /* gets:
- X Error of failed request: BadFont (invalid Font parameter)
- Major opcode of failed request: 56 (X_ChangeGC)
- Resource id in failed request: 0x4e0035c
- Serial number of failed request: 8479111
- Current serial number in output stream: 8479240
- */
-
- fs = XQueryFont(MAIN_DISPLAY(ss), gv.font);
- if (fs)
- XDrawString(ax->dp, ax->wn, ax->gc, x0, y0 + fs->ascent, str, len);
- else XDrawString(ax->dp, ax->wn, ax->gc, x0, y0, str, len); /* not sure why this happens... */
-
- /* XFreeFont here is trouble, but handling it as above seems ok -- Font.c in xlib does allocate new space */
-}
-
-
-static void draw_polygon_va(graphics_context *ax, bool filled, int points, va_list ap)
-{
- int i;
- XPoint *pts;
- pts = (XPoint *)calloc(points, sizeof(XPoint));
- for (i = 0; i < points; i++)
- {
- pts[i].x = va_arg(ap, int);
- pts[i].y = va_arg(ap, int);
- }
- if (filled)
- XFillPolygon(ax->dp, ax->wn, ax->gc, pts, points, Convex, CoordModeOrigin);
- else XDrawLines(ax->dp, ax->wn, ax->gc, pts, points, CoordModeOrigin);
- free(pts);
-}
-
-
-void fill_polygon(graphics_context *ax, int points, ...)
-{ /* currently used only in snd-marks.c */
- va_list ap;
- if (points == 0) return;
- va_start(ap, points);
- draw_polygon_va(ax, true, points, ap);
- va_end(ap);
-}
-
-#if 0
-void draw_polygon(graphics_context *ax, int points, ...)
-{
- va_list ap;
- if (points == 0) return;
- va_start(ap, points);
- draw_polygon_va(ax, false, points, ap);
- va_end(ap);
-}
-#endif
-
-void draw_lines(graphics_context *ax, point_t *points, int num)
-{
- if (num == 0) return;
- XDrawLines(ax->dp, ax->wn, ax->gc, points, num, CoordModeOrigin);
-}
-
-
-void draw_points(graphics_context *ax, point_t *points, int num, int size)
-{
- if (num == 0) return;
- if (size == 1)
- XDrawPoints(ax->dp, ax->wn, ax->gc, points, num, CoordModeOrigin);
- else
- {
- int i, size2;
- XArc *rs;
- /* create squares or whatever centered on each point */
- size2 = size / 2;
- rs = (XArc *)calloc(num, sizeof(XArc));
- for (i = 0; i < num; i++)
- {
- rs[i].x = points[i].x - size2;
- rs[i].y = points[i].y - size2;
- rs[i].angle1 = 0;
- rs[i].angle2 = 360 * 64;
- rs[i].width = size;
- rs[i].height = size;
- }
- XFillArcs(ax->dp, ax->wn, ax->gc, rs, num);
- free(rs);
- }
-}
-
-
-#if 0
-void draw_point(graphics_context *ax, point_t point, int size)
-{
- if (size == 1)
- XDrawPoint(ax->dp, ax->wn, ax->gc, point.x, point.y);
- else
- XFillArc(ax->dp, ax->wn, ax->gc,
- point.x - size / 2,
- point.y - size / 2,
- size, size, 0,
- 360 * 64);
-}
-#endif
-
-
-void draw_dot(graphics_context *ax, int x, int y, int size)
-{
- XFillArc(ax->dp, ax->wn, ax->gc,
- x - size / 2,
- y - size / 2,
- size, size, 0,
- 360 * 64);
-}
-
-
-void fill_polygons(graphics_context *ax, point_t *points, int num, int y0)
-{
- XPoint polypts[4];
- int i;
- for (i = 1; i < num; i++)
- {
- polypts[0].x = points[i - 1].x;
- polypts[0].y = points[i - 1].y;
- polypts[1].x = points[i].x;
- polypts[1].y = points[i].y;
- polypts[2].x = polypts[1].x;
- polypts[2].y = y0;
- polypts[3].x = points[i - 1].x;
- polypts[3].y = y0;
- XFillPolygon(ax->dp, ax->wn, ax->gc, polypts, 4, Convex, CoordModeOrigin);
- }
-}
-
-
-void fill_two_sided_polygons(graphics_context *ax, point_t *points, point_t *points1, int num)
-{
- XPoint polypts[4];
- int i;
- for (i = 1; i < num; i++)
- {
- polypts[0].x = points[i - 1].x;
- polypts[0].y = points[i - 1].y;
- polypts[1].x = points[i].x;
- polypts[1].y = points[i].y;
- polypts[2].x = points1[i].x;
- polypts[2].y = points1[i].y;
- polypts[3].x = points1[i - 1].x;
- polypts[3].y = points1[i - 1].y;
- XFillPolygon(ax->dp, ax->wn, ax->gc, polypts, 4, Convex, CoordModeOrigin);
- }
-}
-
-
-void setup_graphics_context(chan_info *cp, graphics_context *ax)
-{
- Widget w;
- snd_info *sp;
- sp = cp->sound;
- w = channel_to_widget(cp);
- ax->dp = XtDisplay(w);
- ax->gc = copy_GC(cp);
- ax->wn = XtWindow(w);
-}
-
-
-/* colormaps */
-
-static int sono_bins = 0; /* tracks total_bins -- each sono_data[i] is an array of total_bins rectangles */
-static Pixel *current_colors = NULL;
-static int current_colors_size = 0;
-static int current_colormap = BLACK_AND_WHITE_COLORMAP;
-static XRectangle **sono_data = NULL; /* each entry in sono_data is an array of colormap_size arrays: sono_data[colormap_size][total_bins] */
-static int sono_colors = 0; /* tracks colormap_size */
-static GC colormap_GC;
-
-
-void check_colormap_sizes(int colors)
-{
- int i, old_size;
- if (current_colors_size > 0)
- {
- if (current_colormap != BLACK_AND_WHITE_COLORMAP)
- {
- int scr;
- Colormap cmap;
- Display *dpy;
- dpy = XtDisplay(MAIN_SHELL(ss));
- scr = DefaultScreen(dpy);
- cmap = DefaultColormap(dpy, scr);
- XFreeColors(dpy, cmap, current_colors, current_colors_size, 0);
- current_colormap = BLACK_AND_WHITE_COLORMAP;
- }
- if ((current_colors) && (current_colors_size < colors))
- {
- old_size = current_colors_size;
- current_colors_size = colors;
- current_colors = (Pixel *)realloc(current_colors, current_colors_size * sizeof(Pixel));
- for (i = old_size; i < current_colors_size; i++) current_colors[i] = 0;
- }
- }
- if ((sono_data) && (sono_colors < colors) && (sono_bins > 0))
- {
- old_size = sono_colors;
- sono_colors = colors;
- sono_data = (XRectangle **)realloc(sono_data, sono_colors * sizeof(XRectangle *));
- for (i = old_size; i < sono_colors; i++) sono_data[i] = (XRectangle *)calloc(sono_bins, sizeof(XRectangle));
- }
-}
-
-
-void initialize_colormap(void)
-{
- XGCValues gv;
- gv.background = ss->white;
- gv.foreground = ss->data_color;
- colormap_GC = XCreateGC(MAIN_DISPLAY(ss), XtWindow(MAIN_SHELL(ss)), GCForeground | GCBackground, &gv);
- sono_colors = color_map_size(ss);
- sono_data = (XRectangle **)calloc(sono_colors, sizeof(XRectangle *));
- current_colors_size = color_map_size(ss);
- current_colors = (Pixel *)calloc(current_colors_size, sizeof(Pixel));
-}
-
-
-void draw_spectro_line(graphics_context *ax, int color, int x0, int y0, int x1, int y1)
-{
- XSetForeground(ax->dp, colormap_GC, current_colors[color]);
- XDrawLine(ax->dp, ax->wn, colormap_GC, x0, y0, x1, y1);
-}
-
-
-void draw_sono_rectangles(graphics_context *ax, int color, int jmax)
-{
- XSetForeground(ax->dp, colormap_GC, current_colors[color]);
- XFillRectangles(ax->dp, ax->wn, colormap_GC, sono_data[color], jmax);
-}
-
-
-void set_sono_rectangle(int j, int color, int x, int y, int width, int height)
-{
- XRectangle *r;
- r = sono_data[color];
- r[j].x = x;
- r[j].y = y;
- r[j].width = width;
- r[j].height = height;
-}
-
-
-void allocate_sono_rects(int bins)
-{
- if (bins != sono_bins)
- {
- int i;
- for (i = 0; i < sono_colors; i++)
- {
- if ((sono_bins > 0) && (sono_data[i]))
- free(sono_data[i]); /* each is array of XRectangle structs, but it's the wrong size */
- sono_data[i] = (XRectangle *)calloc(bins, sizeof(XRectangle));
- }
- sono_bins = bins;
- }
-}
-
-
-void allocate_color_map(int colormap)
-{
- static bool warned_color = false;
- if (current_colormap != colormap)
- {
- int i;
- Colormap cmap;
- XColor tmp_color;
- Display *dpy;
- int scr;
- tmp_color.flags = DoRed | DoGreen | DoBlue;
-
- dpy = XtDisplay(MAIN_SHELL(ss));
- scr = DefaultScreen(dpy);
- cmap = DefaultColormap(dpy, scr);
-
- /* 8-bit color displays can't handle all these colors, apparently, so we have to check status */
- if (current_colormap != BLACK_AND_WHITE_COLORMAP)
- XFreeColors(dpy, cmap, current_colors, current_colors_size, 0);
-
- for (i = 0; i < current_colors_size; i++)
- {
- get_current_color(colormap, i, &(tmp_color.red), &(tmp_color.green), &(tmp_color.blue));
- if ((XAllocColor(dpy, cmap, &tmp_color)) == 0) /* 0 = failure -- try black as a fallback */
- {
- tmp_color.red = 0;
- tmp_color.green = 0;
- tmp_color.blue = 0;
- if ((XAllocColor(dpy, cmap, &tmp_color)) == 0)
- {
- if (!warned_color)
- snd_error_without_format("can't even allocate black?!?");
- warned_color = true;
- }
- }
- current_colors[i] = tmp_color.pixel;
- }
- current_colormap = colormap;
- }
-}
-
-
-void draw_colored_lines(chan_info *cp, graphics_context *ax, point_t *points, int num, int *colors, int axis_y0, color_t default_color)
-{
- int i, x0, y0, x1, y1, y2 = 0, y00 = -1, cur, prev;
- color_t old_color;
-
- if (num <= 0) return;
-
- old_color = get_foreground_color(ax);
-
- x0 = points[0].x;
- y0 = points[0].y;
-
- if (abs(y0 - axis_y0) < 5)
- prev = -1;
- else prev = colors[0];
-
- set_foreground_color(ax, (prev == -1) ? default_color : current_colors[prev]);
-
- for (i = 1; i < num; i++)
- {
- x1 = points[i].x;
- y1 = points[i].y;
- if (i < num - 1)
- y2 = points[i + 1].y;
- else y2 = y1;
-
- if ((abs(y0 - axis_y0) < 5) &&
- (abs(y1 - axis_y0) < 5))
- cur = -1;
- else
- {
- if ((y00 > y0) &&
- (y00 > y1) &&
- (i > 1))
- cur = colors[i - 2];
- else
- {
- if ((y2 > y1) &&
- (y2 > y0))
- cur = colors[i + 1];
- else
- {
- if (y0 > y1)
- cur = colors[i];
- else cur = colors[i - 1]; /* coords are upside down */
- }
- }
- }
-
- if (cur != prev)
- {
- set_foreground_color(ax, (cur == -1) ? default_color : current_colors[cur]);
- prev = cur;
- }
-
- if (cp->transform_graph_style == GRAPH_DOTS)
- draw_dot(ax, x0, y0, cp->dot_size);
- else draw_line(ax, x0, y0, x1, y1);
-
- y00 = y0;
- x0 = x1;
- y0 = y1;
- }
-
- set_foreground_color(ax, old_color);
-}
-
-
-
-/* -------- color/orientation browser -------- */
-
-static XEN color_hook;
-
-static void check_color_hook(void)
-{
- if (XEN_HOOKED(color_hook))
- run_hook(color_hook, XEN_EMPTY_LIST, S_color_hook);
-}
-
-
-static Widget ccd_dialog = NULL, ccd_list, ccd_scale, ccd_invert, ccd_cutoff;
-
-static void update_graph_setting_fft_changed(chan_info *cp)
-{
- cp->fft_changed = FFT_CHANGE_LOCKED;
- update_graph(cp);
-}
-
-
-static void invert_color_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- in_set_color_inverted(cb->set);
- check_color_hook();
- for_each_chan(update_graph_setting_fft_changed);
-}
-
-
-void set_color_inverted(bool val)
-{
- in_set_color_inverted(val);
- if (ccd_dialog)
- XmToggleButtonSetState(ccd_invert, (Boolean)val, false);
- check_color_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph_setting_fft_changed);
-}
-
-
-static void scale_color_callback(Widget w, XtPointer context, XtPointer info)
-{
- mus_float_t val;
- int scale_val;
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- scale_val = cbs->value;
- if (scale_val <= 50)
- val = (mus_float_t)(scale_val + 1) / 51.0;
- else val = 1.0 + (mus_float_t)((scale_val - 50) * (scale_val - 50)) / 12.5;
- in_set_color_scale(val);
- check_color_hook();
- for_each_chan(update_graph_setting_fft_changed);
-}
-
-
-static void reflect_color_scale(mus_float_t val)
-{
- if (val < 0.02)
- XmScaleSetValue(ccd_scale, 0);
- else
- {
- if (val <= 1.0)
- XmScaleSetValue(ccd_scale, mus_iclamp(0, (int)(val * 51.0 - 1), 100));
- else XmScaleSetValue(ccd_scale, mus_iclamp(0, 50 + (int)sqrt((val - 1.0) * 12.5), 100));
- }
-}
-
-
-void set_color_scale(mus_float_t val)
-{
- in_set_color_scale(val);
- if (ccd_dialog)
- reflect_color_scale(color_scale(ss));
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph_setting_fft_changed);
-}
-
-
-static void list_color_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- if (is_colormap(cbs->item_position - 1))
- {
- in_set_color_map(cbs->item_position - 1);
- check_color_hook();
- for_each_chan(update_graph_setting_fft_changed);
- }
-}
-
-
-void set_color_map(int val)
-{
- in_set_color_map(val);
- if ((ccd_dialog) && (val >= 0))
- XmListSelectPos(ccd_list, val + 1, false);
- check_color_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph_setting_fft_changed);
-}
-
-
-static XmString fscale_label(const char *orig_label, mus_float_t value)
-{
- XmString x;
- char *lab;
- lab = mus_format("%s: %.3f", orig_label, value);
- x = XmStringCreateLocalized(lab);
- free(lab);
- return(x);
-}
-
-
-static void fscale_set_label(const char *orig_label, Widget w, mus_float_t value)
-{
- XmString x;
- char *lab;
- lab = mus_format("%s: %.3f", orig_label, value);
- x = XmStringCreateLocalized(lab);
- XtVaSetValues(w, XmNtitleString, x, NULL);
- free(lab);
- XmStringFree(x);
-}
-
-
-static void cutoff_color_callback(Widget w, XtPointer context, XtPointer info) /* cutoff point */
-{
- /* cutoff point for color chooser */
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- in_set_color_cutoff((mus_float_t)(cbs->value) / 1000.0);
- fscale_set_label("data cutoff", w, color_cutoff(ss));
- check_color_hook();
- for_each_chan(update_graph_setting_fft_changed);
-}
-
-
-void set_color_cutoff(mus_float_t val)
-{
- in_set_color_cutoff(val);
- if (ccd_dialog)
- XmScaleSetValue(ccd_cutoff, (int)(val * 1000.0));
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph_setting_fft_changed);
-}
-
-
-static void dismiss_color_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtUnmanageChild(ccd_dialog);
-}
-
-
-static void help_color_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- color_orientation_dialog_help();
-}
-
-
-void reflect_color_list(bool setup_time)
-{
- if ((ccd_dialog) && (ccd_list))
- {
- int i, size;
- XmString *cmaps;
- size = num_colormaps();
- cmaps = (XmString *)calloc(size, sizeof(XmString));
- for (i = 0; i < size; i++)
- cmaps[i] = XmStringCreateLocalized(colormap_name(i));
- XtVaSetValues(ccd_list,
- XmNitems, cmaps,
- XmNitemCount, size,
- NULL);
- if (setup_time)
- XtVaSetValues(ccd_list,
- XmNvisibleItemCount, 6,
- NULL);
- for (i = 0; i < size; i++) XmStringFree(cmaps[i]);
- free(cmaps);
- }
-}
-
-
-static XEN orientation_hook;
-
-static void check_orientation_hook(void)
-{
- if (XEN_HOOKED(orientation_hook))
- run_hook(orientation_hook, XEN_EMPTY_LIST, S_orientation_hook);
-}
-
-
-static Widget oid_ax, oid_ay, oid_az, oid_sx, oid_sy, oid_sz, oid_hop;
-#if HAVE_GL
- static Widget oid_glbutton;
-#endif
-
-#define HOP_MAX 20
-
-static XmString scale_label(const char *orig_label, int value, bool dec)
-{
- XmString x;
- char *lab;
- if (!dec)
- lab = mus_format("%s: %d", orig_label, value);
- else lab = mus_format("%s: %.2f", orig_label, value * 0.01);
- x = XmStringCreateLocalized(lab);
- free(lab);
- return(x);
-}
-
-
-static void scale_set_label(const char *orig_label, Widget w, int value, bool dec)
-{
- /* in new motif (after version 2.1), showValue not XmNONE clobbers XmScale title!
- * also XmNEAR_BORDER has no effect -- same as XmNEAR_SLIDER
- * so...
- * we create the full label by hand here.
- */
-
- XmString x;
- char *lab;
- if (!dec)
- lab = mus_format("%s: %d", orig_label, value);
- else lab = mus_format("%s: %.2f", orig_label, value * 0.01);
- x = XmStringCreateLocalized(lab);
- XtVaSetValues(w, XmNtitleString, x, NULL);
- free(lab);
- XmStringFree(x);
-}
-
-
-static void ax_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- scale_set_label("x angle", w, cbs->value, false);
- in_set_spectro_x_angle((mus_float_t)(cbs->value));
- chans_field(FCP_X_ANGLE, (mus_float_t)(cbs->value));
- check_orientation_hook();
- for_each_chan(update_graph);
-}
-
-
-void set_spectro_x_angle(mus_float_t val)
-{
- if (val < 0.0) val += 360.0; else if (val >= 360.0) val = fmod(val, 360.0);
- in_set_spectro_x_angle(val);
- if (ccd_dialog)
- {
- XmScaleSetValue(oid_ax, (int)val);
- scale_set_label("x angle", oid_ax, (int)val, false);
- }
- chans_field(FCP_X_ANGLE, val);
- check_orientation_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph);
-}
-
-
-static void ay_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- scale_set_label("y angle", w, cbs->value, false);
- in_set_spectro_y_angle((mus_float_t)(cbs->value));
- chans_field(FCP_Y_ANGLE, (mus_float_t)(cbs->value));
- check_orientation_hook();
- for_each_chan(update_graph);
-}
-
-
-void set_spectro_y_angle(mus_float_t val)
-{
- if (val < 0.0) val += 360.0; else if (val >= 360.0) val = fmod(val, 360.0);
- in_set_spectro_y_angle(val);
- if (ccd_dialog)
- {
- XmScaleSetValue(oid_ay, (int)val);
- scale_set_label("y angle", oid_ay, (int)val, false);
- }
- chans_field(FCP_Y_ANGLE, val);
- check_orientation_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph);
-}
-
-
-static void az_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- scale_set_label("z angle", w, cbs->value, false);
- in_set_spectro_z_angle((mus_float_t)(cbs->value));
- chans_field(FCP_Z_ANGLE, (mus_float_t)(cbs->value));
- check_orientation_hook();
- for_each_chan(update_graph);
-}
-
-
-void set_spectro_z_angle(mus_float_t val)
-{
- if (val < 0.0) val += 360.0; else if (val >= 360.0) val = fmod(val, 360.0);
- in_set_spectro_z_angle(val);
- if (ccd_dialog)
- {
- XmScaleSetValue(oid_az, (int)val);
- scale_set_label("z angle", oid_az, (int)val, false);
- }
- chans_field(FCP_Z_ANGLE, val);
- check_orientation_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph);
-}
-
-
-static void sx_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- scale_set_label("x scale", w, cbs->value, true);
- in_set_spectro_x_scale((mus_float_t)(cbs->value) * 0.01);
- chans_field(FCP_X_SCALE, (mus_float_t)(cbs->value) * 0.01);
- check_orientation_hook();
- for_each_chan(update_graph);
-}
-
-
-void set_spectro_x_scale(mus_float_t val)
-{
- in_set_spectro_x_scale(val);
- if (ccd_dialog)
- {
- int value;
- value = mus_iclamp(0, (int)(val * 100), (int)(100 * SPECTRO_X_SCALE_MAX));
- XmScaleSetValue(oid_sx, value);
- scale_set_label("x scale", oid_sx, value, true);
- }
- chans_field(FCP_X_SCALE, val);
- check_orientation_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph);
-}
-
-
-static void sy_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- scale_set_label("y scale", w, cbs->value, true);
- in_set_spectro_y_scale((mus_float_t)(cbs->value) * 0.01);
- chans_field(FCP_Y_SCALE, (mus_float_t)(cbs->value) * 0.01);
- check_orientation_hook();
- for_each_chan(update_graph);
-}
-
-
-void set_spectro_y_scale(mus_float_t val)
-{
- in_set_spectro_y_scale(val);
- if (ccd_dialog)
- {
- int value;
- value = mus_iclamp(0, (int)(val * 100), (int)(100 * SPECTRO_Y_SCALE_MAX));
- XmScaleSetValue(oid_sy, value);
- scale_set_label("y scale", oid_sy, value, true);
- }
- chans_field(FCP_Y_SCALE, val);
- check_orientation_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph);
-}
-
-
-static void sz_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- scale_set_label("z scale", w, cbs->value, true);
- in_set_spectro_z_scale((mus_float_t)(cbs->value) * 0.01);
- chans_field(FCP_Z_SCALE, (mus_float_t)(cbs->value) * 0.01);
- check_orientation_hook();
- for_each_chan(update_graph);
-}
-
-
-void set_spectro_z_scale(mus_float_t val)
-{
- in_set_spectro_z_scale(val);
- if (ccd_dialog)
- {
- int value;
- value = mus_iclamp(0, (int)(val * 100), (int)(100 * SPECTRO_Z_SCALE_MAX));
- XmScaleSetValue(oid_sz, value);
- scale_set_label("z scale", oid_sz, value, true);
- }
- chans_field(FCP_Z_SCALE, val);
- check_orientation_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph);
-}
-
-
-static void chans_spectro_hop(chan_info *cp, int value)
-{
- cp->spectro_hop = value;
-}
-
-
-static void hop_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- int val;
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- scale_set_label("hop", w, cbs->value, false);
- val = mus_iclamp(1, cbs->value, HOP_MAX);
- in_set_spectro_hop(val);
- for_each_chan_with_int(chans_spectro_hop,val);
- check_orientation_hook();
- for_each_chan(update_graph);
-}
-
-
-void set_spectro_hop(int val)
-{
- if (val > 0)
- {
- in_set_spectro_hop(val);
- if (ccd_dialog)
- {
- int value;
- value = mus_iclamp(1, val, HOP_MAX);
- XmScaleSetValue(oid_hop, value);
- scale_set_label("hop", oid_hop, value, false);
- }
- for_each_chan_with_int(chans_spectro_hop, val);
- check_orientation_hook();
- if (!(ss->graph_hook_active))
- for_each_chan(update_graph);
- }
-}
-
-
-static int fixup_angle(mus_float_t ang)
-{
- int na;
- na = (int)ang;
- if (na < 0) na += 360;
- na = na % 360;
- return(na);
-}
-
-
-void reflect_spectro(void)
-{
- /* set color/orientaton widget values */
- if (ccd_dialog)
- {
- XmToggleButtonSetState(ccd_invert, (Boolean)(color_inverted(ss)), false);
- XtVaSetValues(ccd_cutoff, XmNvalue, (int)((color_cutoff(ss)) * 1000), NULL);
- reflect_color_scale(color_scale(ss));
-
- XtVaSetValues(oid_ax, XmNvalue, fixup_angle(spectro_x_angle(ss)), NULL);
- XtVaSetValues(oid_ay, XmNvalue, fixup_angle(spectro_y_angle(ss)), NULL);
- XtVaSetValues(oid_az, XmNvalue, fixup_angle(spectro_z_angle(ss)), NULL);
- XtVaSetValues(oid_sx, XmNvalue, mus_iclamp(0, (int)(spectro_x_scale(ss) * 100), 100), NULL);
- XtVaSetValues(oid_sy, XmNvalue, mus_iclamp(0, (int)(spectro_y_scale(ss) * 100), 100), NULL);
- XtVaSetValues(oid_sz, XmNvalue, mus_iclamp(0, (int)(spectro_z_scale(ss) * 100), 100), NULL);
- XtVaSetValues(oid_hop, XmNvalue, mus_iclamp(1, spectro_hop(ss), HOP_MAX), NULL);
- check_orientation_hook();
- }
-}
-
-
-void set_with_gl(bool val, bool with_dialogs)
-{
-#if HAVE_GL
- sgl_save_currents();
-#endif
- in_set_with_gl(val);
-#if HAVE_GL
- sgl_set_currents(with_dialogs);
- if ((ccd_dialog) && (with_dialogs))
- XmToggleButtonSetState(oid_glbutton, val, false);
-#endif
-}
-
-
-#if HAVE_GL
-static void with_gl_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- sgl_save_currents();
- in_set_with_gl(cb->set);
- sgl_set_currents(true);
- /* this only sets the slider positions -- it doesn't update the labels! */
- /* and reflect_spectro() doesn't help! */
- if (ccd_dialog)
- {
- scale_set_label("x angle", oid_ax, spectro_x_angle(ss), false);
- scale_set_label("y angle", oid_ay, spectro_y_angle(ss), false);
- scale_set_label("z angle", oid_az, spectro_z_angle(ss), false);
- scale_set_label("x scale", oid_sx, spectro_x_scale(ss), false);
- scale_set_label("y scale", oid_sy, spectro_y_scale(ss), false);
- scale_set_label("z scale", oid_sz, spectro_z_scale(ss), false);
- }
- for_each_chan(update_graph);
-}
-#endif
-
-
-static void reset_color_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* put everything back the way it was at the start */
- reset_spectro();
- reflect_spectro();
- for_each_chan(update_graph);
-}
-
-
-
-/* I tried a scrolled window with each colormap name in an appropriate color, but it looked kinda dumb */
-
-Widget start_color_orientation_dialog(bool managed)
-{
- if (!ccd_dialog)
- {
- Arg args[32];
- int n, initial_value;
- XmString xhelp, xdismiss, xinvert, titlestr, xreset, xstr;
- Widget mainform, light_label, lsep, rsep, sep1, tsep, color_frame, orientation_frame, color_form, orientation_form;
- Widget color_title, orientation_title;
-#if HAVE_GL
- XmString glstr;
-#endif
-
- xdismiss = XmStringCreateLocalized((char *)"Go Away"); /* needed by template dialog */
- xhelp = XmStringCreateLocalized((char *)"Help");
- xreset = XmStringCreateLocalized((char *)"Reset");
- titlestr = XmStringCreateLocalized((char *)"Color and Orientation");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNcancelLabelString, xdismiss); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNokLabelString, xreset); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- ccd_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Color and Orientation", args, n);
-
- XtAddCallback(ccd_dialog, XmNcancelCallback, dismiss_color_orientation_callback, NULL);
- XtAddCallback(ccd_dialog, XmNhelpCallback, help_color_orientation_callback, NULL);
- XtAddCallback(ccd_dialog, XmNokCallback, reset_color_orientation_callback, NULL);
-
- XmStringFree(xhelp);
- XmStringFree(xdismiss);
- XmStringFree(titlestr);
- XmStringFree(xreset);
-
- XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(ccd_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(ccd_dialog, XmDIALOG_SEPARATOR)); n++;
- mainform = XtCreateManagedWidget("formd", xmFormWidgetClass, ccd_dialog, args, n);
-
- /* color section */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNborderWidth, 10); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- color_frame = XtCreateManagedWidget("color", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- color_form = XtCreateManagedWidget("cform", xmFormWidgetClass, color_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- color_title = XtCreateManagedWidget("colors", xmLabelWidgetClass, color_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 60); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, color_title); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNlistMarginWidth, 3); n++;
- ccd_list = XmCreateScrolledList(color_form, (char *)"colormap-list", args, n);
-
- XtVaSetValues(ccd_list,
- XmNbackground, ss->white,
- XmNforeground, ss->black,
- NULL);
- reflect_color_list(true);
- XtAddCallback(ccd_list, XmNbrowseSelectionCallback, list_color_callback, NULL);
- XtManageChild(ccd_list);
- XmListSelectPos(ccd_list, color_map(ss) + 1, false);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, color_title); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNwidth, 10); n++;
- lsep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, color_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, ccd_list); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, color_title); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNwidth, 10); n++;
- rsep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, color_form, args, n);
-
- /* this horizontal separator exists solely to keep the "light" label from clobbering the "dark" label! */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, lsep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, rsep); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, color_title); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNwidth, 250); n++;
- XtSetArg(args[n], XmNheight, 10); n++;
- sep1 = XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, color_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, lsep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, rsep); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep1); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNEAR_SLIDER); n++;
- XtSetArg(args[n], XmNvalue, 50); n++;
- ccd_scale = XtCreateManagedWidget("ccdscl", xmScaleWidgetClass, color_form, args, n);
- XtAddCallback(ccd_scale, XmNvalueChangedCallback, scale_color_callback, NULL);
- XtAddCallback(ccd_scale, XmNdragCallback, scale_color_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, lsep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, ccd_scale); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- light_label = XtCreateManagedWidget("light", xmLabelWidgetClass, color_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, rsep); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, ccd_scale); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtCreateManagedWidget("dark", xmLabelWidgetClass, color_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, lsep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, rsep); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, light_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNwidth, 250); n++;
- XtSetArg(args[n], XmNheight, 10); n++;
- tsep = XtCreateManagedWidget("tsep", xmSeparatorWidgetClass, color_form, args, n);
-
- n = 0;
- xstr = fscale_label("data cutoff", color_cutoff(ss));
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, lsep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, rsep); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, tsep); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNmaximum, 250); n++;
- XtSetArg(args[n], XmNdecimalPoints, 3); n++;
- XtSetArg(args[n], XmNtitleString, xstr); n++;
- XtSetArg(args[n], XmNvalue, (int)(color_cutoff(ss) * 1000)); n++;
- ccd_cutoff = XtCreateManagedWidget("cutoff", xmScaleWidgetClass, color_form, args, n);
- XtAddCallback(ccd_cutoff, XmNvalueChangedCallback, cutoff_color_callback, NULL);
- XtAddCallback(ccd_cutoff, XmNdragCallback, cutoff_color_callback, NULL);
- XmStringFree(xstr);
-
- XtVaSetValues(((XmScaleWidget)ccd_cutoff)->composite.children[0], XmNbackground, ss->basic_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, lsep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, ccd_cutoff); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNset, color_inverted(ss)); n++;
- xinvert = XmStringCreateLocalized((char *)"invert");
- XtSetArg(args[n], XmNlabelString, xinvert); n++;
- ccd_invert = make_togglebutton_widget("invert", color_form, args, n);
- XtAddCallback(ccd_invert, XmNvalueChangedCallback, invert_color_callback, NULL);
- XmStringFree(xinvert);
-
-
- /* orientation section */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, color_frame); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNborderWidth, 10); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- orientation_frame = XtCreateManagedWidget("color", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- orientation_form = XtCreateManagedWidget("oform", xmFormWidgetClass, orientation_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- orientation_title = XtCreateManagedWidget("orientation", xmLabelWidgetClass, orientation_form, args, n);
-
- #define SCALE_BORDER_WIDTH 6
-
- n = 0;
- initial_value = fixup_angle(spectro_x_angle(ss));
- xstr = scale_label("x angle", initial_value, false);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNvalue, initial_value); n++;
- XtSetArg(args[n], XmNmaximum, 360); n++;
- XtSetArg(args[n], XmNtitleString, xstr); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 48); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, orientation_title); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- oid_ax = XtCreateManagedWidget("ax", xmScaleWidgetClass, orientation_form, args, n);
- XtAddCallback(oid_ax, XmNvalueChangedCallback, ax_orientation_callback, NULL);
- XtAddCallback(oid_ax, XmNdragCallback, ax_orientation_callback, NULL);
- XmStringFree(xstr);
-
- XtVaSetValues(((XmScaleWidget)oid_ax)->composite.children[0], XmNbackground, ss->basic_color, NULL);
-
- n = 0;
- initial_value = mus_iclamp(0, (int)(spectro_x_scale(ss) * 100), (int)(100 * SPECTRO_X_SCALE_MAX));
- xstr = scale_label("x scale", initial_value, true);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNmaximum, (int)(100 * SPECTRO_X_SCALE_MAX)); n++;
- XtSetArg(args[n], XmNvalue, initial_value); n++;
- XtSetArg(args[n], XmNtitleString, xstr); n++;
- XtSetArg(args[n], XmNdecimalPoints, 2); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 52); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, oid_ax); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- oid_sx = XtCreateManagedWidget("xs", xmScaleWidgetClass, orientation_form, args, n);
- XtAddCallback(oid_sx, XmNvalueChangedCallback, sx_orientation_callback, NULL);
- XtAddCallback(oid_sx, XmNdragCallback, sx_orientation_callback, NULL);
- XmStringFree(xstr);
-
- XtVaSetValues(((XmScaleWidget)oid_sx)->composite.children[0], XmNbackground, ss->basic_color, NULL);
-
- n = 0;
- initial_value = fixup_angle(spectro_y_angle(ss));
- xstr = scale_label("y angle", initial_value, false);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNvalue, initial_value); n++;
- XtSetArg(args[n], XmNmaximum, 360); n++;
- XtSetArg(args[n], XmNtitleString, xstr); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 48); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, oid_ax); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- oid_ay = XtCreateManagedWidget("ay", xmScaleWidgetClass, orientation_form, args, n);
- XtAddCallback(oid_ay, XmNvalueChangedCallback, ay_orientation_callback, NULL);
- XtAddCallback(oid_ay, XmNdragCallback, ay_orientation_callback, NULL);
- XmStringFree(xstr);
-
- XtVaSetValues(((XmScaleWidget)oid_ay)->composite.children[0], XmNbackground, ss->basic_color, NULL);
-
- n = 0;
- initial_value = mus_iclamp(0, (int)(spectro_y_scale(ss) * 100), (int)(100 * SPECTRO_Y_SCALE_MAX));
- xstr = scale_label("y scale", initial_value, true);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNmaximum, (int)(100 * SPECTRO_Y_SCALE_MAX)); n++;
- XtSetArg(args[n], XmNvalue, initial_value); n++;
- XtSetArg(args[n], XmNtitleString, xstr); n++;
- XtSetArg(args[n], XmNdecimalPoints, 2); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 52); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, oid_sx); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- oid_sy = XtCreateManagedWidget("ys", xmScaleWidgetClass, orientation_form, args, n);
- XtAddCallback(oid_sy, XmNvalueChangedCallback, sy_orientation_callback, NULL);
- XtAddCallback(oid_sy, XmNdragCallback, sy_orientation_callback, NULL);
- XmStringFree(xstr);
-
- XtVaSetValues(((XmScaleWidget)oid_sy)->composite.children[0], XmNbackground, ss->basic_color, NULL);
-
- n = 0;
- initial_value = fixup_angle(spectro_z_angle(ss));
- xstr = scale_label("z angle", initial_value, false);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNtitleString, xstr); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNvalue, initial_value); n++;
- XtSetArg(args[n], XmNmaximum, 360); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 48); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, oid_ay); n++;
- XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- oid_az = XtCreateManagedWidget("az", xmScaleWidgetClass, orientation_form, args, n);
- XtAddCallback(oid_az, XmNvalueChangedCallback, az_orientation_callback, NULL);
- XtAddCallback(oid_az, XmNdragCallback, az_orientation_callback, NULL);
- XmStringFree(xstr);
-
- XtVaSetValues(((XmScaleWidget)oid_az)->composite.children[0], XmNbackground, ss->basic_color, NULL);
-
- n = 0;
- initial_value = mus_iclamp(0, (int)(spectro_z_scale(ss) * 100), (int)(100 * SPECTRO_Z_SCALE_MAX));
- xstr = scale_label("z scale", initial_value, true);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNdecimalPoints, 2); n++;
- XtSetArg(args[n], XmNmaximum, (int)(100 * SPECTRO_Z_SCALE_MAX)); n++;
- XtSetArg(args[n], XmNvalue, initial_value); n++;
- XtSetArg(args[n], XmNtitleString, xstr); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 52); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, oid_sy); n++;
- XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- oid_sz = XtCreateManagedWidget("zs", xmScaleWidgetClass, orientation_form, args, n);
- XtAddCallback(oid_sz, XmNvalueChangedCallback, sz_orientation_callback, NULL);
- XtAddCallback(oid_sz, XmNdragCallback, sz_orientation_callback, NULL);
- XmStringFree(xstr);
-
- XtVaSetValues(((XmScaleWidget)oid_sz)->composite.children[0], XmNbackground, ss->basic_color, NULL);
-
- n = 0;
- initial_value = mus_iclamp(1, spectro_hop(ss), HOP_MAX);
- xstr = scale_label("hop", initial_value, false);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNvalue, initial_value); n++;
- XtSetArg(args[n], XmNmaximum, HOP_MAX); n++;
- XtSetArg(args[n], XmNtitleString, xstr); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 48); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, oid_az); n++;
-#if HAVE_GL
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
-#else
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
-#endif
- XtSetArg(args[n], XmNborderWidth, SCALE_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- oid_hop = XtCreateManagedWidget("hop", xmScaleWidgetClass, orientation_form, args, n);
- XtAddCallback(oid_hop, XmNvalueChangedCallback, hop_orientation_callback, NULL);
- XtAddCallback(oid_hop, XmNdragCallback, hop_orientation_callback, NULL);
- XmStringFree(xstr);
-
- XtVaSetValues(((XmScaleWidget)oid_hop)->composite.children[0], XmNbackground, ss->basic_color, NULL);
-
-#if HAVE_GL
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNset, with_gl(ss)); n++;
- glstr = XmStringCreateLocalized((char *)"use OpenGL");
- XtSetArg(args[n], XmNlabelString, glstr); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, oid_hop); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- oid_glbutton = make_togglebutton_widget("use OpenGL", orientation_form, args, n);
- XtAddCallback(oid_glbutton, XmNvalueChangedCallback, with_gl_callback, NULL);
- XmStringFree(glstr);
-#endif
-
- if (color_scale(ss) != 1.0)
- reflect_color_scale(color_scale(ss));
-
- map_over_children(ccd_dialog, set_main_color_of_widget);
- set_dialog_widget(COLOR_ORIENTATION_DIALOG, ccd_dialog);
- if (managed) XtManageChild(ccd_dialog);
- }
- else
- {
- if (managed)
- {
- if (!XtIsManaged(ccd_dialog)) XtManageChild(ccd_dialog);
- raise_dialog(ccd_dialog);
- }
- }
- return(ccd_dialog);
-}
-
-
-void view_color_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- start_color_orientation_dialog(true);
-}
-
-
-bool color_orientation_dialog_is_active(void)
-{
- return((ccd_dialog) && (XtIsManaged(ccd_dialog)));
-}
-
-
-
-void g_init_gxdraw(void)
-{
- #define H_orientation_hook S_orientation_hook " (): called whenever one of the variables associated with the \
-orientation dialog changes"
- #define H_color_hook S_color_hook " (): called whenever one of the variables associated with the \
-color dialog changes"
-
- orientation_hook = XEN_DEFINE_HOOK(S_orientation_hook, 0, H_orientation_hook);
- color_hook = XEN_DEFINE_HOOK(S_color_hook, 0, H_color_hook);
-}
diff --git a/snd-xdrop.c b/snd-xdrop.c
deleted file mode 100644
index 9934a8f..0000000
--- a/snd-xdrop.c
+++ /dev/null
@@ -1,339 +0,0 @@
-#include "snd.h"
-
-/* -------- drop watcher lists -------- */
-
-/* the rigamarole for dealing with a drop is so messed up that I think it's
- * worth the trouble of setting up a separate callback list -- hence the
- * drop watchers
- */
-
-typedef struct {
- void (*drop_watcher)(Widget w, const char *message, Position x, Position y, void *data);
- void (*drag_watcher)(Widget w, const char *message, Position x, Position y, drag_style_t dtype, void *data);
- Widget caller;
- void *context;
-} drop_watcher_t;
-
-static drop_watcher_t **drop_watchers = NULL;
-static int drop_watchers_size = 0;
-
-#define DROP_WATCHER_SIZE_INCREMENT 2
-
-
-static int add_drop_watcher(Widget w,
- void (*drop_watcher)(Widget w, const char *message, Position x, Position y, void *data),
- void (*drag_watcher)(Widget w, const char *message, Position x, Position y, drag_style_t dtype, void *data),
- void *context)
-{
- int loc = -1;
- if (!(drop_watchers))
- {
- loc = 0;
- drop_watchers_size = DROP_WATCHER_SIZE_INCREMENT;
- drop_watchers = (drop_watcher_t **)calloc(drop_watchers_size, sizeof(drop_watcher_t *));
- }
- else
- {
- int i;
- for (i = 0; i < drop_watchers_size; i++)
- if (!(drop_watchers[i]))
- {
- loc = i;
- break;
- }
- if (loc == -1)
- {
- loc = drop_watchers_size;
- drop_watchers_size += DROP_WATCHER_SIZE_INCREMENT;
- drop_watchers = (drop_watcher_t **)realloc(drop_watchers, drop_watchers_size * sizeof(drop_watcher_t *));
- for (i = loc; i < drop_watchers_size; i++) drop_watchers[i] = NULL;
- }
- }
- drop_watchers[loc] = (drop_watcher_t *)calloc(1, sizeof(drop_watcher_t));
- drop_watchers[loc]->drop_watcher = drop_watcher;
- drop_watchers[loc]->drag_watcher = drag_watcher;
- drop_watchers[loc]->context = context;
- drop_watchers[loc]->caller = w;
- return(loc);
-}
-
-
-#if 0
-static bool remove_drop_watcher(int loc)
-{
- if ((drop_watchers) &&
- (loc < drop_watchers_size) &&
- (loc >= 0) &&
- (drop_watchers[loc]))
- {
- free(drop_watchers[loc]);
- drop_watchers[loc] = NULL;
- return(true);
- }
- return(false);
-}
-#endif
-
-
-static drop_watcher_t *find_drop_watcher(Widget caller)
-{
- if (drop_watchers)
- {
- int i;
- for (i = 0; i < drop_watchers_size; i++)
- {
- if (drop_watchers[i])
- {
- drop_watcher_t *d;
- d = drop_watchers[i];
- if (d->caller == caller)
- return(d);
- }
- }
- }
- return(NULL);
-}
-
-
-
-/* can't move axes if icon dragged to end of graph because the entire system freezes! */
-
-static Atom FILE_NAME; /* Sun uses this, SGI uses STRING */
-static Atom COMPOUND_TEXT; /* various Motif widgets use this and the next */
-static Atom _MOTIF_COMPOUND_STRING;
-static Atom text_plain; /* gtk uses this -- apparently a url */
-static Atom uri_list; /* rox uses this -- looks just like text/plain to me */
-static Atom TEXT; /* ditto */
-
-static XEN drop_hook;
-
-
-static char *atom_to_string(Atom type, XtPointer value, unsigned long length)
-{
- unsigned long i;
- char *str = NULL;
- if ((type == XA_STRING) || (type == FILE_NAME) || (type == text_plain) || (type == uri_list) || (type == TEXT))
- {
- str = (char *)calloc(length + 1, sizeof(char));
- for (i = 0; i < length; i++)
- str[i] = ((char *)value)[i];
- }
- else
- {
- if ((type == COMPOUND_TEXT) || (type == _MOTIF_COMPOUND_STRING))
- {
- char *temp;
- XmString cvt, tmp;
- XmParseTable parser = (XmParseTable)XtCalloc(1, sizeof(XmParseMapping));
- int n;
- Arg args[12];
-
- /* create parse table to catch separator in XmString and insert "\n" in output */
- /* multiple file names are passed this way in Motif */
- tmp = XmStringSeparatorCreate();
- n = 0;
- XtSetArg(args[n], XmNincludeStatus, XmINSERT); n++;
- XtSetArg(args[n], XmNsubstitute, tmp); n++;
- XtSetArg(args[n], XmNpattern, "\n"); n++;
- parser[0] = XmParseMappingCreate(args, n);
-
- if (type == _MOTIF_COMPOUND_STRING)
- cvt = XmCvtByteStreamToXmString((unsigned char *)value);
- else cvt = XmCvtCTToXmString((char *)value);
- temp = (char *)XmStringUnparse(cvt, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, parser, 1, XmOUTPUT_ALL);
-
- XmParseTableFree(parser, 1);
- XmStringFree(cvt);
- str = mus_strdup(temp);
- XtFree(temp);
- }
- }
- return(str);
-}
-
-
-static Position mx, my;
-
-static void massage_selection(Widget w, XtPointer context, Atom *selection, Atom *type, XtPointer value, unsigned long *length, int *format)
-{
- char *str = NULL;
- str = atom_to_string(*type, value, *length);
- /* str can contain more than one name (separated by cr) */
- if (str)
- {
- if ((!(XEN_HOOKED(drop_hook))) ||
- (!(XEN_TRUE_P(run_or_hook(drop_hook,
- XEN_LIST_1(C_TO_XEN_STRING(str)),
- S_drop_hook)))))
- {
- Widget caller; /* "w" above is the transfer control widget, not the drop-receiver */
- drop_watcher_t *d;
- caller = (Widget)((XmDropTransferEntry)context)->client_data;
- d = find_drop_watcher(caller);
- if (d)
- {
- /* loop through possible list of filenames, calling watcher on each */
- char *filename;
- int len = 0, i, j = 0;
- len = mus_strlen(str);
- filename = (char *)calloc(len, sizeof(char));
- for (i = 0; i < len; i++)
- {
- if ((str[i] == '\n') || (str[i] == '\r')) /* apparently the only space chars here are \n and \r? */
- {
- if (j > 0)
- {
- filename[j] = '\0';
- if (strncmp(filename, "file://", 7) == 0)
- {
- char *tmp;
- tmp = (char *)(filename + 7);
- (*(d->drop_watcher))(caller, (const char *)tmp, mx, my, d->context);
- }
- else (*(d->drop_watcher))(caller, (const char *)filename, mx, my, d->context);
- j = 0;
- }
- /* else ignore extra white space chars */
- }
- else
- {
- filename[j++] = str[i];
- }
- }
- free(filename);
- }
- }
- free(str);
- }
-}
-
-
-static void handle_drop(Widget w, XtPointer context, XtPointer info)
-{
- XmDropProcCallbackStruct *cb = (XmDropProcCallbackStruct *)info;
- Arg args[12];
- int n, i, num_targets, k;
- Atom *targets;
- XmDropTransferEntryRec entries[2];
-
- if ((cb->dropAction != XmDROP) ||
- ((cb->operation != XmDROP_COPY) &&
- (cb->operation != XmDROP_LINK)))
- {
- cb->dropSiteStatus = XmINVALID_DROP_SITE;
- return;
- }
-
- k = -1;
- XtVaGetValues(cb->dragContext,
- XmNexportTargets, &targets,
- XmNnumExportTargets, &num_targets,
- NULL);
-
- for (i = 0; i < num_targets; i++)
- if ((targets[i] == XA_STRING) ||
- (targets[i] == FILE_NAME) ||
- (targets[i] == COMPOUND_TEXT) ||
- (targets[i] == _MOTIF_COMPOUND_STRING) ||
- (targets[i] == TEXT) ||
- (targets[i] == text_plain) ||
- (targets[i] == uri_list))
- {
- k = i;
- break;
- }
- if (k == -1)
- {
-#if MUS_DEBUGGING
- fprintf(stderr, "failed drop attempt:\n");
- for (i = 0; i < num_targets; i++)
- fprintf(stderr, " target %d = %s\n", i,
- XGetAtomName(MAIN_DISPLAY(ss),
- targets[i]));
-#endif
- cb->dropSiteStatus = XmINVALID_DROP_SITE;
- cb->operation = XmDROP_NOOP;
- n = 0;
- XtSetArg(args[n], XmNnumDropTransfers, 0); n++;
- XtSetArg(args[n], XmNtransferStatus, XmTRANSFER_FAILURE); n++;
- XmDropTransferStart(cb->dragContext, args, n);
- return;
- }
-
- mx = cb->x;
- my = cb->y;
- entries[0].target = targets[k];
- entries[0].client_data = (XtPointer)w;
- n = 0;
- XtSetArg(args[n], XmNdropTransfers, entries); n++;
- XtSetArg(args[n], XmNnumDropTransfers, 1); n++;
- XtSetArg(args[n], XmNtransferProc, massage_selection); n++;
- /* cb->operation = XmDROP_COPY; */
-
- XmDropTransferStart(cb->dragContext, args, n);
-}
-
-
-static void handle_drag(Widget w, XtPointer context, XtPointer info)
-{
- XmDragProcCallbackStruct *cb = (XmDragProcCallbackStruct *)info;
- drop_watcher_t *d;
- d = find_drop_watcher(w);
- if ((d) && (d->drag_watcher))
- {
- switch (cb->reason)
- {
- case XmCR_DROP_SITE_MOTION_MESSAGE:
- (*(d->drag_watcher))(w, NULL, cb->x, cb->y, DRAG_MOTION, d->context);
- break;
- case XmCR_DROP_SITE_ENTER_MESSAGE:
- (*(d->drag_watcher))(w, NULL, cb->x, cb->y, DRAG_ENTER, d->context);
- break;
- case XmCR_DROP_SITE_LEAVE_MESSAGE:
- (*(d->drag_watcher))(w, NULL, cb->x, cb->y, DRAG_LEAVE, d->context);
- break;
- }
- }
-}
-
-#define NUM_TARGETS 7
-void add_drag_and_drop(Widget w,
- void (*drop_watcher)(Widget w, const char *message, Position x, Position y, void *data),
- void (*drag_watcher)(Widget w, const char *message, Position x, Position y, drag_style_t dtype, void *data),
- void *context)
-{
- Display *dpy;
- int n;
- Atom targets[NUM_TARGETS];
- Arg args[12];
- dpy = MAIN_DISPLAY(ss);
- targets[0] = XA_STRING;
- FILE_NAME = XInternAtom(dpy, "FILE_NAME", false);
- targets[1] = FILE_NAME;
- COMPOUND_TEXT = XInternAtom(dpy, "COMPOUND_TEXT", false);
- targets[2] = COMPOUND_TEXT;
- _MOTIF_COMPOUND_STRING = XInternAtom(dpy, "_MOTIF_COMPOUND_STRING", false);
- targets[3] = _MOTIF_COMPOUND_STRING;
- text_plain = XInternAtom(dpy, "text/plain", false);
- targets[4] = text_plain;
- TEXT = XInternAtom(dpy, "TEXT", false);
- targets[5] = TEXT;
- uri_list = XInternAtom(dpy, "text/uri-list", false);
- targets[6] = uri_list;
- n = 0;
- XtSetArg(args[n], XmNdropSiteOperations, XmDROP_COPY | XmDROP_LINK); n++;
- XtSetArg(args[n], XmNimportTargets, targets); n++;
- XtSetArg(args[n], XmNnumImportTargets, NUM_TARGETS); n++;
- XtSetArg(args[n], XmNdropProc, handle_drop); n++;
- XtSetArg(args[n], XmNdragProc, handle_drag); n++;
- XmDropSiteRegister(w, args, n);
- add_drop_watcher(w, drop_watcher, drag_watcher, context);
-}
-
-void g_init_gxdrop(void)
-{
- #define H_drop_hook S_drop_hook " (filename): called whenever Snd receives a drag-and-drop \
-event. If it returns " PROC_TRUE ", the file is not opened or mixed by Snd."
-
- drop_hook = XEN_DEFINE_HOOK(S_drop_hook, 1, H_drop_hook); /* arg = filename */
-}
diff --git a/snd-xen.c b/snd-xen.c
index a05b4ec..130f80b 100644
--- a/snd-xen.c
+++ b/snd-xen.c
@@ -1,131 +1,369 @@
+#if (defined(__GNUC__))
+#ifndef _GNU_SOURCE
+#define _GNU_SOURCE
+#endif
+#include <string.h>
+#endif
+
#include "snd.h"
#include "clm2xen.h"
+#define HAVE_SPECIAL_FUNCTIONS (!_MSC_VER)
+
/* Snd defines its own exit and delay
*
* In Ruby, rand is kernel_rand.
*
* In Forth, Snd's exit is named snd-exit.
*/
+/* error handlers */
+
+static const char *io_error_names[IO_ERROR_NUM] = {"no error", "save-hook cancellation", "bad channel",
+ "can't reopen file", "too many open files", "unknown sndlib error",
+ "no memory", "can't open", "no filename", "bad sample type", "bad header type", "sndlib uninitialized",
+ "not a sound file", "file closed", "write error", "interrupted", "can't close",
+ "bad header", "disk full", "write protected", "can't read selection file",
+ "need write confirmation", "no changes", "io edit-hook cancellation", "can't create file"
+};
+
+const char *io_error_name(io_error_t err)
+{
+ if (err < IO_ERROR_NUM)
+ return(io_error_names[(int)err]);
+ return(mus_format("unknown io_error: %d", err));
+}
+
+
+/* this is needed as a C int below */
+#ifndef USE_NO_GUI
+ #define USE_NO_GUI 0
+#endif
+
+
+static bool run_snd_error_hook(const char *msg)
+{
+ return((Xen_hook_has_list(ss->snd_error_hook)) &&
+ (Xen_is_true(run_or_hook(ss->snd_error_hook,
+ Xen_list_1(C_string_to_Xen_string(msg)),
+ S_snd_error_hook))));
+}
+
+
+void redirect_snd_warning_to(void (*handler)(const char *warning_msg, void *ufd), void *data)
+{
+ ss->snd_warning_handler = handler;
+ ss->snd_warning_data = data;
+}
+
+
+void redirect_snd_error_to(void (*handler)(const char *error_msg, void *ufd), void *data)
+{
+ ss->snd_error_handler = handler;
+ ss->snd_error_data = data;
+}
+
+
+static void snd_error_1(const char *msg, bool with_redirection_and_hook)
+{
+ if (with_redirection_and_hook)
+ {
+ if (ss->snd_error_handler)
+ {
+ /* make sure it doesn't call itself recursively */
+ void (*old_snd_error_handler)(const char *error_msg, void *data);
+ void *old_snd_error_data;
+ old_snd_error_handler = ss->snd_error_handler;
+ old_snd_error_data = ss->snd_error_data;
+ ss->snd_error_handler = NULL;
+ ss->snd_error_data = NULL;
+ (*(old_snd_error_handler))(msg, old_snd_error_data);
+ ss->snd_error_handler = old_snd_error_handler;
+ ss->snd_error_data = old_snd_error_data;
+ return;
+ }
+
+ if (run_snd_error_hook(msg))
+ return;
+ }
+#if (USE_NO_GUI)
+ fprintf(stderr, "%s", msg);
+#else
+ if (ss)
+ {
+ if (ss->batch_mode)
+ fprintf(stderr, "%s", msg);
+#if ((!HAVE_EXTENSION_LANGUAGE) && (!USE_NO_GUI))
+ {
+ snd_info *sp;
+ sp = any_selected_sound();
+ if ((sp) && (sp->active))
+ status_report(sp, "%s", msg);
+ else post_it("Error", msg);
+ }
+#endif
+ }
+ else
+ {
+ fprintf(stderr, "%s", msg);
+ fputc('\n', stderr);
+ }
+#endif
+ /* end USE_NO_GUI */
+}
+
+
+static void snd_warning_1(const char *msg)
+{
+ if (ss->snd_warning_handler)
+ {
+ /* make sure it doesn't call itself recursively */
+ void (*old_snd_warning_handler)(const char *msg, void *data);
+ void *old_snd_warning_data;
+ old_snd_warning_handler = ss->snd_warning_handler;
+ old_snd_warning_data = ss->snd_warning_data;
+ ss->snd_warning_handler = NULL;
+ ss->snd_warning_data = NULL;
+ (*(old_snd_warning_handler))(msg, old_snd_warning_data);
+ ss->snd_warning_handler = old_snd_warning_handler;
+ ss->snd_warning_data = old_snd_warning_data;
+ return;
+ }
+
+ if ((Xen_hook_has_list(ss->snd_warning_hook)) &&
+ (Xen_is_true(run_or_hook(ss->snd_warning_hook,
+ Xen_list_1(C_string_to_Xen_string(msg)),
+ S_snd_warning_hook))))
+ return;
+
+ if ((ss) && (!(ss->batch_mode)) && (ss->max_sounds > 0))
+ {
+ snd_info *sp;
+ sp = any_selected_sound();
+ if ((sp) && (sp->active))
+ status_report(sp, "%s", msg); /* make the Mac C compiler happy */
+ else
+ {
+ listener_append(msg);
+ fprintf(stderr, "%s", msg);
+ }
+ }
+ else fprintf(stderr, "%s", msg);
+}
+
+
+static int snd_error_buffer_size = 1024;
+static char *snd_error_buffer = NULL;
+
+void snd_warning(const char *format, ...)
+{
+ int bytes_needed = 0;
+ va_list ap;
+
+ if (snd_error_buffer == NULL)
+ snd_error_buffer = (char *)calloc(snd_error_buffer_size, sizeof(char));
+ va_start(ap, format);
+
+ /* can't use vasprintf here -- we may jump anywhere leaving unclaimed memory behind
+ */
+ bytes_needed = vsnprintf(snd_error_buffer, snd_error_buffer_size, format, ap);
+ va_end(ap);
+
+ if (bytes_needed >= snd_error_buffer_size)
+ {
+ snd_error_buffer_size = bytes_needed * 2;
+ free(snd_error_buffer);
+ snd_error_buffer = (char *)calloc(snd_error_buffer_size, sizeof(char));
+ va_start(ap, format);
+ vsnprintf(snd_error_buffer, snd_error_buffer_size, format, ap);
+ va_end(ap);
+ }
+ snd_warning_1(snd_error_buffer);
+}
+
+
+void snd_warning_without_format(const char *msg)
+{
+ snd_warning_1(msg);
+}
+
+
+void snd_error(const char *format, ...)
+{
+ int bytes_needed = 0;
+ va_list ap;
+ if (snd_error_buffer == NULL)
+ snd_error_buffer = (char *)calloc(snd_error_buffer_size, sizeof(char));
+
+ va_start(ap, format);
+ bytes_needed = vsnprintf(snd_error_buffer, snd_error_buffer_size, format, ap);
+ va_end(ap);
+
+ if (bytes_needed > snd_error_buffer_size)
+ {
+ snd_error_buffer_size = bytes_needed * 2;
+ free(snd_error_buffer);
+ snd_error_buffer = (char *)calloc(snd_error_buffer_size, sizeof(char));
+
+ va_start(ap, format);
+ vsnprintf(snd_error_buffer, snd_error_buffer_size, format, ap);
+ va_end(ap);
+ }
+ snd_error_1(snd_error_buffer, true);
+}
+
+
+void snd_error_without_format(const char *msg)
+{
+ snd_error_1(msg, true);
+}
+
+
+static Xen g_snd_error(Xen msg)
+{
+ /* this throws a 'snd-error error; it does not call snd_error_1 or friends above */
+ #define H_snd_error "(" S_snd_error " str): throws a 'snd-error error"
+ Xen_check_type(Xen_is_string(msg), msg, 1, S_snd_error, "a string");
+
+ if (!(run_snd_error_hook(Xen_string_to_C_string(msg)))) /* have to call this before the throw, else we end up at top level */
+ Xen_error(Xen_make_error_type("snd-error"),
+ Xen_list_2(C_string_to_Xen_string(S_snd_error ": ~A"),
+ msg));
+ return(msg);
+}
+
+
+static Xen g_snd_warning(Xen msg)
+{
+ #define H_snd_warning "(" S_snd_warning " str): reports warning message str (normally in the status area)"
+ Xen_check_type(Xen_is_string(msg), msg, 1, S_snd_warning, "a string");
+ snd_warning("%s", Xen_string_to_C_string(msg));
+ return(msg);
+}
+
+
+static Xen clip_hook;
-/* -------- protect XEN vars from GC -------- */
+static mus_float_t run_clip_hook(mus_float_t val)
+{
+ if (Xen_hook_has_list(clip_hook))
+ {
+ Xen result;
+ result = run_progn_hook(clip_hook,
+ Xen_list_1(C_double_to_Xen_real(val)),
+ S_clip_hook);
+ if (Xen_is_number(result))
+ return(Xen_real_to_C_double(result));
+ }
+ /* otherwise mimic the built-in default in io.c */
+ if (val >= 0.99999)
+ return(0.99999);
+ return(-1.0);
+}
+
+static bool clip_hook_checker(void)
+{
+ bool result;
+ result = Xen_hook_has_list(clip_hook);
+ if (result)
+ mus_clip_set_handler(run_clip_hook);
+ else mus_clip_set_handler(NULL);
+ return(result);
+}
+
+
+
+
+/* -------- protect Xen vars from GC -------- */
#if HAVE_SCHEME
-int snd_protect(XEN obj) {return(s7_gc_protect(s7, obj));}
+int snd_protect(Xen obj) {return(s7_gc_protect(s7, obj));}
void snd_unprotect_at(int loc) {s7_gc_unprotect_at(s7, loc);}
-XEN snd_protected_at(int loc) {return(s7_gc_protected_at(s7, loc));}
#else
-static XEN gc_protection;
+static Xen gc_protection;
static int gc_protection_size = 0;
-#define DEFAULT_GC_VALUE XEN_UNDEFINED
+#define DEFAULT_GC_VALUE Xen_undefined
static int gc_last_cleared = NOT_A_GC_LOC;
static int gc_last_set = NOT_A_GC_LOC;
-#if HAVE_PTHREADS
- static mus_lock_t gc_lock = MUS_LOCK_INITIALIZER;
-#endif
-
-int snd_protect(XEN obj)
+int snd_protect(Xen obj)
{
int i, old_size;
- XEN tmp;
+ Xen tmp;
- MUS_LOCK(&gc_lock);
-
if (gc_protection_size == 0)
{
gc_protection_size = 512;
- gc_protection = XEN_MAKE_VECTOR(gc_protection_size, DEFAULT_GC_VALUE);
- XEN_PROTECT_FROM_GC(gc_protection);
- XEN_VECTOR_SET(gc_protection, 0, obj);
+ gc_protection = Xen_make_vector(gc_protection_size, DEFAULT_GC_VALUE);
+ Xen_GC_protect(gc_protection);
+ Xen_vector_set(gc_protection, 0, obj);
gc_last_set = 0;
}
else
{
if ((gc_last_cleared >= 0) &&
- XEN_EQ_P(XEN_VECTOR_REF(gc_protection, gc_last_cleared), DEFAULT_GC_VALUE))
+ Xen_is_eq(Xen_vector_ref(gc_protection, gc_last_cleared), DEFAULT_GC_VALUE))
{
/* we hit this branch about 2/3 of the time */
- XEN_VECTOR_SET(gc_protection, gc_last_cleared, obj);
+ Xen_vector_set(gc_protection, gc_last_cleared, obj);
gc_last_set = gc_last_cleared;
gc_last_cleared = NOT_A_GC_LOC;
- MUS_UNLOCK(&gc_lock);
-
return(gc_last_set);
}
for (i = gc_last_set; i < gc_protection_size; i++)
- if (XEN_EQ_P(XEN_VECTOR_REF(gc_protection, i), DEFAULT_GC_VALUE))
+ if (Xen_is_eq(Xen_vector_ref(gc_protection, i), DEFAULT_GC_VALUE))
{
- XEN_VECTOR_SET(gc_protection, i, obj);
+ Xen_vector_set(gc_protection, i, obj);
gc_last_set = i;
- MUS_UNLOCK(&gc_lock);
-
return(gc_last_set);
}
for (i = 0; i < gc_last_set; i++)
- if (XEN_EQ_P(XEN_VECTOR_REF(gc_protection, i), DEFAULT_GC_VALUE))
+ if (Xen_is_eq(Xen_vector_ref(gc_protection, i), DEFAULT_GC_VALUE))
{
/* here we average 3 checks before a hit, so this isn't as bad as it looks */
- XEN_VECTOR_SET(gc_protection, i, obj);
+ Xen_vector_set(gc_protection, i, obj);
gc_last_set = i;
- MUS_UNLOCK(&gc_lock);
-
return(gc_last_set);
}
tmp = gc_protection;
old_size = gc_protection_size;
gc_protection_size *= 2;
- gc_protection = XEN_MAKE_VECTOR(gc_protection_size, DEFAULT_GC_VALUE);
- XEN_PROTECT_FROM_GC(gc_protection);
+ gc_protection = Xen_make_vector(gc_protection_size, DEFAULT_GC_VALUE);
+ Xen_GC_protect(gc_protection);
for (i = 0; i < old_size; i++)
{
- XEN_VECTOR_SET(gc_protection, i, XEN_VECTOR_REF(tmp, i));
- XEN_VECTOR_SET(tmp, i, DEFAULT_GC_VALUE);
+ Xen_vector_set(gc_protection, i, Xen_vector_ref(tmp, i));
+ Xen_vector_set(tmp, i, DEFAULT_GC_VALUE);
}
- XEN_VECTOR_SET(gc_protection, old_size, obj);
+ Xen_vector_set(gc_protection, old_size, obj);
/* in Ruby, I think we can unprotect it */
#if HAVE_RUBY || HAVE_FORTH
- XEN_UNPROTECT_FROM_GC(tmp);
+ Xen_GC_unprotect(tmp);
#endif
gc_last_set = old_size;
}
-
- MUS_UNLOCK(&gc_lock);
return(gc_last_set);
}
void snd_unprotect_at(int loc)
{
- MUS_LOCK(&gc_lock);
-
if (loc >= 0)
{
- XEN_VECTOR_SET(gc_protection, loc, DEFAULT_GC_VALUE);
+ Xen_vector_set(gc_protection, loc, DEFAULT_GC_VALUE);
gc_last_cleared = loc;
}
-
- MUS_UNLOCK(&gc_lock);
-}
-
-
-XEN snd_protected_at(int loc)
-{
- if (loc >= 0)
- return(XEN_VECTOR_REF(gc_protection, loc));
- return(DEFAULT_GC_VALUE);
}
#endif
@@ -135,13 +373,14 @@ XEN snd_protected_at(int loc)
static char *last_file_loaded = NULL;
#if HAVE_SCHEME
-static XEN g_snd_s7_error_handler(XEN args)
+static Xen g_snd_s7_error_handler(Xen args)
{
-#if MUS_DEBUGGING
- fprintf(stderr, "error: %s\n", s7_object_to_c_string(s7, args));
-#endif
+ s7_pointer msg;
+ msg = s7_car(args);
+ Xen_check_type(Xen_is_string(msg), msg, 1, "_snd_s7_error_handler_", "a string");
+
if (ss->xen_error_handler)
- (*(ss->xen_error_handler))(s7_string(s7_car(args)), (void *)any_selected_sound()); /* not NULL! */
+ (*(ss->xen_error_handler))(s7_string(msg), (void *)any_selected_sound()); /* not NULL! */
return(s7_f(s7));
}
#endif
@@ -154,29 +393,28 @@ void redirect_xen_error_to(void (*handler)(const char *msg, void *ufd), void *da
#if HAVE_SCHEME
if (handler == NULL)
- s7_eval_c_string(s7, "(set! (hook-functions *error-hook*) '())");
- else s7_eval_c_string(s7, "(set! (hook-functions *error-hook*) (list \n\
- (lambda (tag args) \n\
- (_snd_s7_error_handler_ \n\
- (string-append \n\
- (if (string? args) \n\
- args \n\
- (if (pair? args) \n\
- (apply format #f (car args) (cdr args)) \n\
- \"\")) \n\
- (if (and (*error-info* 2) \n\
- (string? (*error-info* 4)) \n\
- (number? (*error-info* 3))) \n\
- (format #f \"~%~S[~D]: ~A~%\" \n\
- (*error-info* 4) \n\
- (*error-info* 3) \n\
- (*error-info* 2)) \n\
- \"\"))))))");
-#endif
-}
-
-
-void redirect_snd_print_to(void (*handler)(const char *msg, void *ufd), void *data)
+ s7_eval_c_string(s7, "(set! (hook-functions *error-hook*) ())");
+ else s7_eval_c_string(s7, "(set! (hook-functions *error-hook*) (list \n\
+ (lambda (hook) \n\
+ (let ((args (hook 'data))) \n\
+ (_snd_s7_error_handler_ \n\
+ (string-append \n\
+ (if (string? args) \n\
+ args \n\
+ (if (pair? args) \n\
+ (apply format #f args) \n\
+ \"\")) \n\
+ (with-let (owlet) \n\
+ (if (and error-code \n\
+ (string? error-file) \n\
+ (number? error-line)) \n\
+ (format #f \"~%~S[~D]: ~A~%\" error-file error-line error-code) \n\
+ \"\"))))))))");
+#endif
+}
+
+
+static void redirect_snd_print_to(void (*handler)(const char *msg, void *ufd), void *data)
{
ss->snd_print_handler = handler;
ss->snd_print_data = data;
@@ -200,425 +438,350 @@ void redirect_errors_to(void (*handler)(const char *msg, void *ufd), void *data)
}
-static char *gl_print(XEN result);
-
+static char *gl_print(Xen result);
-/* ---------------- RUBY error handler ---------------- */
-#if HAVE_RUBY
-static XEN snd_format_if_needed(XEN args)
-{
- /* if car has formatting info, use next arg as arg list for it */
- XEN format_args = XEN_EMPTY_LIST, cur_arg, result;
- int i, start = 0, num_args, format_info_len, err_size = 8192;
- bool got_tilde = false, was_formatted = false;
- char *format_info = NULL, *errmsg = NULL;
- num_args = XEN_LIST_LENGTH(args);
- if (num_args == 1) return(XEN_CAR(args));
+/* ---------------- RUBY error handler ---------------- */
- format_info = mus_strdup(XEN_TO_C_STRING(XEN_CAR(args)));
- format_info_len = mus_strlen(format_info);
-
- if (XEN_LIST_P(XEN_CADR(args)))
- format_args = XEN_COPY_ARG(XEN_CADR(args)); /* protect Ruby case */
- else format_args = XEN_CADR(args);
+#if HAVE_RUBY
+static Xen snd_format_if_needed(Xen args)
+{
+ /* if car has formatting info, use next arg as arg list for it */
+ Xen format_args = Xen_empty_list, cur_arg, result;
+ int i, start = 0, num_args, format_info_len, err_size = 8192;
+ bool got_tilde = false, was_formatted = false;
+ char *format_info = NULL, *errmsg = NULL;
- errmsg = (char *)calloc(err_size, sizeof(char));
+ num_args = Xen_list_length(args);
+ if (num_args == 1) return(Xen_car(args));
- for (i = 0; i < format_info_len; i++)
- {
- if (format_info[i] == '~')
- {
- strncat(errmsg, (char *)(format_info + start), i - start);
- start = i + 2;
- got_tilde = true;
- }
- else
- {
- if (got_tilde)
- {
- was_formatted = true;
- got_tilde = false;
- switch (format_info[i])
- {
- case '~': errmsg = mus_strcat(errmsg, "~", &err_size); break;
- case '%': errmsg = mus_strcat(errmsg, "\n", &err_size); break;
- case 'S':
- case 'A':
- if (XEN_NOT_NULL_P(format_args))
- {
- cur_arg = XEN_CAR(format_args);
- format_args = XEN_CDR(format_args);
- if (XEN_VECTOR_P(cur_arg))
- {
- char *vstr;
- vstr = gl_print(cur_arg);
- errmsg = mus_strcat(errmsg, vstr, &err_size);
- free(vstr);
- }
- else
- {
- char *temp = NULL;
- errmsg = mus_strcat(errmsg, temp = (char *)XEN_AS_STRING(cur_arg), &err_size);
- }
- }
- /* else ignore it */
- break;
- default: start = i - 1; break;
- }
- }
- }
- }
- if (i > start)
- strncat(errmsg, (char *)(format_info + start), i - start);
- if (format_info) free(format_info);
- if (!was_formatted)
- {
- char *temp = NULL;
- errmsg = mus_strcat(errmsg, " ", &err_size);
- errmsg = mus_strcat(errmsg, temp = (char *)XEN_AS_STRING(XEN_CADR(args)), &err_size);
- }
- if (num_args > 2)
- {
- if ((!was_formatted) || (!(XEN_FALSE_P(XEN_CADDR(args))))) start = 2; else start = 3;
- for (i = start; i < num_args; i++)
- {
- char *temp = NULL;
- errmsg = mus_strcat(errmsg, " ", &err_size);
- errmsg = mus_strcat(errmsg, temp = (char *)XEN_AS_STRING(XEN_LIST_REF(args, i)), &err_size);
- }
- }
- result = C_TO_XEN_STRING(errmsg);
- free(errmsg);
- return(result);
-}
+ format_info = mus_strdup(Xen_string_to_C_string(Xen_car(args)));
+ format_info_len = mus_strlen(format_info);
+ if (Xen_is_cons(Xen_cadr(args)))
+ format_args = Xen_copy_arg(Xen_cadr(args)); /* protect Ruby case */
+ else format_args = Xen_cdr(args);
-void snd_rb_raise(XEN tag, XEN throw_args)
-{
- static char *msg = NULL;
- XEN err = rb_eStandardError, bt;
- bool need_comma = false;
- int size = 2048;
+ errmsg = (char *)calloc(err_size, sizeof(char));
- if (strcmp(rb_id2name(tag), "Out_of_range") == 0)
- err = rb_eRangeError;
- else
- if (strcmp(rb_id2name(tag), "Wrong_type_arg") == 0)
- err = rb_eTypeError;
+ for (i = 0; i < format_info_len; i++)
+ {
+ if (format_info[i] == '~')
+ {
+ strncat(errmsg, (char *)(format_info + start), i - start);
+ start = i + 2;
+ got_tilde = true;
+ }
+ else
+ {
+ if (got_tilde)
+ {
+ was_formatted = true;
+ got_tilde = false;
+ switch (format_info[i])
+ {
+ case '~': errmsg = mus_strcat(errmsg, "~", &err_size); break;
+ case '%': errmsg = mus_strcat(errmsg, "\n", &err_size); break;
+ case 'S':
+ case 'A':
+ if (!Xen_is_null(format_args))
+ {
+ cur_arg = Xen_car(format_args);
+ format_args = Xen_cdr(format_args);
+ if (Xen_is_vector(cur_arg))
+ {
+ char *vstr;
+ vstr = gl_print(cur_arg);
+ errmsg = mus_strcat(errmsg, vstr, &err_size);
+ free(vstr);
+ }
+ else
+ {
+ char *temp = NULL;
+ errmsg = mus_strcat(errmsg, temp = (char *)Xen_object_to_C_string(cur_arg), &err_size);
+ }
+ }
+ /* else ignore it */
+ break;
+ default: start = i - 1; break;
+ }
+ }
+ }
+ }
+ if (i > start)
+ strncat(errmsg, (char *)(format_info + start), i - start);
+ if (format_info) free(format_info);
+ if (!was_formatted)
+ {
+ char *temp = NULL;
+ errmsg = mus_strcat(errmsg, " ", &err_size);
+ errmsg = mus_strcat(errmsg, temp = (char *)Xen_object_to_C_string(Xen_cadr(args)), &err_size);
- if (msg) free(msg);
- msg = (char *)calloc(size, sizeof(char));
+ if (num_args > 2)
+ {
+ if (!Xen_is_false(Xen_caddr(args))) start = 2; else start = 3;
+ for (i = start; i < num_args; i++)
+ {
+ char *temp = NULL;
+ errmsg = mus_strcat(errmsg, " ", &err_size);
+ errmsg = mus_strcat(errmsg, temp = (char *)Xen_object_to_C_string(Xen_list_ref(args, i)), &err_size);
+ }
+ }
+ }
+ result = C_string_to_Xen_string(errmsg);
+ free(errmsg);
+ return(result);
+}
- if ((XEN_LIST_P(throw_args)) &&
- (XEN_LIST_LENGTH(throw_args) > 0))
- {
- /* normally car is string name of calling func */
- if (XEN_NOT_FALSE_P(XEN_CAR(throw_args)))
- {
- snprintf(msg, size, "%s: %s",
- XEN_AS_STRING(XEN_CAR(throw_args)),
- rb_id2name(tag));
- need_comma = true;
- }
+void snd_rb_raise(Xen tag, Xen throw_args)
+{
+ static char *msg = NULL;
+ Xen err = rb_eStandardError, bt;
+ int size = 2048;
+ char *idname;
- if (XEN_LIST_LENGTH(throw_args) > 1)
- {
- /* here XEN_CADR can contain formatting info and XEN_CADDR is a list of args to fit in */
- /* or it may be a list of info vars etc */
+ if (msg) free(msg);
+ msg = (char *)calloc(size, sizeof(char));
- if (need_comma)
- msg = mus_strcat(msg, ": ", &size); /* new size, if realloc, reported through size arg */
+ idname = (char *)rb_id2name(tag);
+ if (strcmp(idname, "Out_of_range") == 0)
+ err = rb_eRangeError;
+ else
+ if (strcmp(idname, "Wrong_type_arg") == 0)
+ err = rb_eTypeError;
- if (XEN_STRING_P(XEN_CADR(throw_args)))
- msg = mus_strcat(msg, XEN_TO_C_STRING(snd_format_if_needed(XEN_CDR(throw_args))), &size);
- else msg = mus_strcat(msg, XEN_AS_STRING(XEN_CDR(throw_args)), &size);
- }
- }
+ msg = mus_strcat(msg, idname, &size);
+ if (strcmp(idname, "Mus_error") == 0)
+ msg = mus_strcat(msg, ": ", &size);
+ else msg = mus_strcat(msg, " in ", &size);
+ msg = mus_strcat(msg, Xen_string_to_C_string(snd_format_if_needed(throw_args)), &size);
bt = rb_funcall(err, rb_intern("caller"), 0);
- if (XEN_VECTOR_P(bt) && XEN_VECTOR_LENGTH(bt) > 0)
- {
+ if (Xen_vector_length(bt) > 0)
+ {
int i;
msg = mus_strcat(msg, "\n", &size);
- for (i = 0; i < XEN_VECTOR_LENGTH(bt); i++)
- {
- msg = mus_strcat(msg, XEN_TO_C_STRING(XEN_VECTOR_REF(bt, i)), &size);
- msg = mus_strcat(msg, "\n", &size);
- }
- }
+ for (i = 0; i < Xen_vector_length(bt); i++)
+ {
+ msg = mus_strcat(msg, Xen_string_to_C_string(Xen_vector_ref(bt, i)), &size);
+ msg = mus_strcat(msg, "\n", &size);
+ }
+ }
- if (strcmp(rb_id2name(tag), "Snd_error") != 0)
- {
- if (!(run_snd_error_hook(msg)))
- {
- if (ss->xen_error_handler)
- {
- /* make sure it doesn't call itself recursively */
- void (*old_xen_error_handler)(const char *msg, void *data);
- void *old_xen_error_data;
- old_xen_error_handler = ss->xen_error_handler;
- old_xen_error_data = ss->xen_error_data;
- ss->xen_error_handler = NULL;
- ss->xen_error_data = NULL;
- (*(old_xen_error_handler))(msg, old_xen_error_data);
- ss->xen_error_handler = old_xen_error_handler;
- ss->xen_error_data = old_xen_error_data;
- }
- }
- }
+ if (strcmp(idname, "Snd_error") != 0)
+ {
+ if (!(run_snd_error_hook(msg)))
+ {
+ if (ss->xen_error_handler)
+ {
+ /* make sure it doesn't call itself recursively */
+ void (*old_xen_error_handler)(const char *msg, void *data);
+ void *old_xen_error_data;
+ old_xen_error_handler = ss->xen_error_handler;
+ old_xen_error_data = ss->xen_error_data;
+ ss->xen_error_handler = NULL;
+ ss->xen_error_data = NULL;
+ (*(old_xen_error_handler))(msg, old_xen_error_data);
+ ss->xen_error_handler = old_xen_error_handler;
+ ss->xen_error_data = old_xen_error_data;
+ }
+ }
+ }
- rb_raise(err, msg);
-}
-#endif
-/* end HAVE_RUBY */
+ rb_raise(err, "%s", msg);
+}
+#endif
+/* end HAVE_RUBY */
#if HAVE_EXTENSION_LANGUAGE
-XEN snd_catch_any(XEN_CATCH_BODY_TYPE body, void *body_data, const char *caller)
+Xen snd_catch_any(Xen_catch_t body, void *body_data, const char *caller)
{
return((*body)(body_data));
}
#else
-/* no extension language but user managed to try to evaluate something -- one way is to
- * activate the minibuffer (via click) and type an expression into it
+/* no extension language but user managed to try to evaluate something
+ * can this happen?
*/
-XEN snd_catch_any(XEN_CATCH_BODY_TYPE body, void *body_data, const char *caller)
+Xen snd_catch_any(Xen_catch_t body, void *body_data, const char *caller)
{
snd_error("This version of Snd has no extension language, so there's no way for %s to evaluate anything", caller);
- return(XEN_FALSE);
+ return(Xen_false);
}
#endif
-bool procedure_arity_ok(XEN proc, int args)
+bool procedure_arity_ok(Xen proc, int args)
{
- XEN arity;
+#if HAVE_SCHEME
+ return(s7_is_aritable(s7, proc, args));
+#else
+ Xen arity;
int rargs;
- arity = XEN_ARITY(proc);
+ arity = Xen_arity(proc);
+ rargs = Xen_integer_to_C_int(arity);
#if HAVE_RUBY
- rargs = XEN_TO_C_INT(arity);
return(xen_rb_arity_ok(rargs, args));
#endif
#if HAVE_FORTH
- rargs = XEN_TO_C_INT(arity);
- if (rargs != args)
- return(false);
+ return(rargs == args);
#endif
-
-#if HAVE_SCHEME
- {
- int oargs, restargs, gc_loc;
-
- gc_loc = s7_gc_protect(s7, arity);
- rargs = XEN_TO_C_INT(XEN_CAR(arity));
- oargs = XEN_TO_C_INT(XEN_CADR(arity));
- restargs = ((XEN_TRUE_P(XEN_CADDR(arity))) ? 1 : 0);
- s7_gc_unprotect_at(s7, gc_loc);
-
- if (rargs > args) return(false);
- if ((restargs == 0) && ((rargs + oargs) < args)) return(false);
- }
#endif
-
return(true);
}
-char *procedure_ok(XEN proc, int args, const char *caller, const char *arg_name, int argn)
+char *procedure_ok(Xen proc, int args, const char *caller, const char *arg_name, int argn)
{
+ int rargs;
/* if string returned, needs to be freed */
/* 0 args is special => "thunk" meaning in this case that optional args are not ok (applies to as-one-edit and two menu callbacks) */
- XEN arity;
- int rargs;
- if (!(XEN_PROCEDURE_P(proc)))
+ if (!(Xen_is_procedure(proc)))
{
- if (XEN_NOT_FALSE_P(proc)) /* #f as explicit arg to clear */
- {
- char *temp = NULL, *str;
- str = mus_format("%s: %s (%s arg %d) is not a procedure!",
- temp = (char *)XEN_AS_STRING(proc),
- arg_name, caller, argn);
-#if HAVE_SCHEME
- if (temp) free(temp);
-#endif
- return(str);
- }
+ if (!Xen_is_false(proc)) /* #f as explicit arg to clear */
+ return(mus_format(" %s is not a procedure!", (arg_name) ? arg_name : caller));
}
else
{
- arity = XEN_ARITY(proc);
+ Xen arity;
+ arity = Xen_arity(proc);
#if HAVE_RUBY
- rargs = XEN_TO_C_INT(arity);
+ rargs = Xen_integer_to_C_int(arity);
if (!xen_rb_arity_ok(rargs, args))
- return(mus_format("%s function (%s arg %d) should take %d args, not %d",
- arg_name, caller, argn, args, (rargs < 0) ? (-rargs) : rargs));
+ return(mus_format(" %s function should take %d args, not %d", (arg_name) ? arg_name : caller, args, (rargs < 0) ? (-rargs) : rargs));
#endif
#if HAVE_SCHEME
{
- int oargs, restargs;
- int loc;
+ int oargs, loc;
loc = snd_protect(arity);
- rargs = XEN_TO_C_INT(XEN_CAR(arity));
- oargs = XEN_TO_C_INT(XEN_CADR(arity));
- restargs = ((XEN_TRUE_P(XEN_CADDR(arity))) ? 1 : 0);
+ rargs = Xen_integer_to_C_int(Xen_car(arity));
+ oargs = Xen_integer_to_C_int(Xen_cdr(arity));
snd_unprotect_at(loc);
if (rargs > args)
- return(mus_format("%s function (%s arg %d) should take %d argument%s, but instead requires %d",
- arg_name, caller, argn, args, (args != 1) ? "s" : "", rargs));
-
- if ((restargs == 0) && ((rargs + oargs) < args))
- return(mus_format("%s function (%s arg %d) should accept at least %d argument%s, but instead accepts only %d",
- arg_name, caller, argn, args, (args != 1) ? "s" : "", rargs + oargs));
+ return(mus_format(" %s function should take %d argument%s, but instead requires %d",
+ (arg_name) ? arg_name : caller, args, (args != 1) ? "s" : "", rargs));
- if ((args == 0) &&
- ((rargs != 0) || (oargs != 0) || (restargs != 0)))
- return(mus_format("%s function (%s arg %d) should take no args, not %d",
- arg_name, caller, argn, rargs + oargs + restargs));
+ if ((rargs + oargs) < args)
+ return(mus_format(" %s function should accept at least %d argument%s, but instead accepts only %d",
+ (arg_name) ? arg_name : caller, args, (args != 1) ? "s" : "", rargs + oargs));
}
#endif
#if HAVE_FORTH
- rargs = XEN_TO_C_INT(arity);
+ rargs = Xen_integer_to_C_int(arity);
if (rargs != args)
- return(mus_format("%s function (%s arg %d) should take %d args, not %d",
- arg_name, caller, argn, args, rargs));
+ return(mus_format(" %s function should take %d args, not %d", (arg_name) ? arg_name : caller, args, rargs));
#endif
}
return(NULL);
}
-XEN snd_no_such_file_error(const char *caller, XEN filename)
+Xen snd_no_such_file_error(const char *caller, Xen filename)
{
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_4(C_TO_XEN_STRING("no-such-file: ~A ~S: ~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_4(C_string_to_Xen_string("no-such-file: ~A ~S: ~A"),
+ C_string_to_Xen_string(caller),
filename,
- C_TO_XEN_STRING(snd_open_strerror())));
- return(XEN_FALSE);
+ C_string_to_Xen_string(snd_open_strerror())));
+ return(Xen_false);
}
-XEN snd_no_such_channel_error(const char *caller, XEN snd, XEN chn)
+Xen snd_no_such_channel_error(const char *caller, Xen snd, Xen chn)
{
int index = NOT_A_SOUND;
- snd_info *sp;
- if (XEN_INTEGER_P(snd))
- index = XEN_TO_C_INT(snd);
+ if (Xen_is_integer(snd))
+ index = Xen_integer_to_C_int(snd);
else
{
- if (XEN_SOUND_P(snd))
- index = XEN_SOUND_TO_C_INT(snd);
+ if (xen_is_sound(snd))
+ index = Xen_sound_to_C_int(snd);
}
if ((index >= 0) &&
(index < ss->max_sounds) &&
(snd_ok(ss->sounds[index]))) /* good grief... */
{
+ snd_info *sp;
sp = ss->sounds[index];
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_6(C_TO_XEN_STRING("no-such-channel: (~A: sound: ~A, chan: ~A) (~S, chans: ~A))"),
- C_TO_XEN_STRING(caller),
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_6(C_string_to_Xen_string("no-such-channel: (~A: sound: ~A, chan: ~A) (~S, chans: ~A))"),
+ C_string_to_Xen_string(caller),
snd,
chn,
- C_TO_XEN_STRING(sp->short_filename),
- C_TO_XEN_INT(sp->nchans)));
+ C_string_to_Xen_string(sp->short_filename),
+ C_int_to_Xen_integer(sp->nchans)));
}
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_4(C_TO_XEN_STRING("no-such-channel: (~A: sound: ~A, chan: ~A)"),
- C_TO_XEN_STRING(caller),
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_4(C_string_to_Xen_string("no-such-channel: (~A: sound: ~A, chan: ~A)"),
+ C_string_to_Xen_string(caller),
snd,
chn));
- return(XEN_FALSE);
+ return(Xen_false);
}
-XEN snd_no_active_selection_error(const char *caller)
+Xen snd_no_active_selection_error(const char *caller)
{
- XEN_ERROR(XEN_ERROR_TYPE("no-active-selection"),
- XEN_LIST_2(C_TO_XEN_STRING("~A: no active selection"),
- C_TO_XEN_STRING(caller)));
- return(XEN_FALSE);
+ Xen_error(Xen_make_error_type("no-active-selection"),
+ Xen_list_2(C_string_to_Xen_string("~A: no active selection"),
+ C_string_to_Xen_string(caller)));
+ return(Xen_false);
}
-XEN snd_bad_arity_error(const char *caller, XEN errstr, XEN proc)
+Xen snd_bad_arity_error(const char *caller, Xen errstr, Xen proc)
{
- XEN_ERROR(XEN_ERROR_TYPE("bad-arity"),
- XEN_LIST_3(C_TO_XEN_STRING("~A,~A"),
- C_TO_XEN_STRING(caller),
+ Xen_error(Xen_make_error_type("bad-arity"),
+ Xen_list_3(C_string_to_Xen_string("~A,~A"),
+ C_string_to_Xen_string(caller),
errstr));
- return(XEN_FALSE);
+ return(Xen_false);
}
/* -------- various evaluators (within our error handler) -------- */
-XEN eval_str_wrapper(void *data)
-{
- return(XEN_EVAL_C_STRING((char *)data));
-}
-
-
-#if (!HAVE_SCHEME)
-XEN eval_form_wrapper(void *data)
-{
- return(XEN_EVAL_FORM((XEN)data));
-}
-#else
-XEN eval_form_wrapper(void *data)
-{
- return(XEN_FALSE);
-}
-#endif
-
-
-static XEN string_to_form_1(void *data)
-{
- return(C_STRING_TO_XEN_FORM((char *)data));
-}
-
-
-XEN string_to_form(const char *str)
+Xen eval_str_wrapper(void *data)
{
- return(snd_catch_any(string_to_form_1, (void *)str, str)); /* catch needed else #< in input (or incomplete form) exits Snd! */
+ return(Xen_eval_C_string((char *)data));
}
-static XEN eval_file_wrapper(void *data)
+static Xen eval_file_wrapper(void *data)
{
- XEN error;
+ Xen error;
last_file_loaded = (char *)data;
- error = XEN_LOAD_FILE((char *)data); /* error only meaningful in Ruby */
+ error = Xen_load((char *)data); /* error only meaningful in Ruby */
last_file_loaded = NULL;
return(error);
}
-static char *g_print_1(XEN obj) /* free return val */
+static char *g_print_1(Xen obj) /* free return val */
{
#if HAVE_SCHEME
- return(XEN_AS_STRING(obj));
+ return(Xen_object_to_C_string(obj));
#endif
#if HAVE_FORTH || HAVE_RUBY
- return(mus_strdup(XEN_AS_STRING(obj)));
+ return(mus_strdup(Xen_object_to_C_string(obj)));
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
@@ -627,7 +790,7 @@ static char *g_print_1(XEN obj) /* free return val */
}
-static char *gl_print(XEN result)
+static char *gl_print(Xen result)
{
char *newbuf = NULL, *str = NULL;
int i, ilen, savelen;
@@ -635,7 +798,7 @@ static char *gl_print(XEN result)
#if HAVE_SCHEME
/* expand \t first (neither gtk nor motif handles this automatically)
* but... "#\\t" is the character t not a tab indication!
- * (object->string #\t)
+ * (object->string #\t) or worse #\tab
*/
#define TAB_SPACES 4
int tabs = 0, len, j = 0;
@@ -644,7 +807,7 @@ static char *gl_print(XEN result)
len = mus_strlen(newbuf);
for (i = 0; i < len - 1; i++)
- if (((i == 0) || (newbuf[i - 1] != '\\')) &&
+ if (((i == 0) || ((newbuf[i - 1] != '\\') && (newbuf[i - 1] != '#'))) &&
(newbuf[i] == '\\') &&
(newbuf[i + 1] == 't'))
tabs++;
@@ -676,8 +839,8 @@ static char *gl_print(XEN result)
#endif
/* specialize vectors which can be enormous in this context */
- if ((!(XEN_VECTOR_P(result))) ||
- ((int)(XEN_VECTOR_LENGTH(result)) <= print_length(ss)))
+ if ((!(Xen_is_vector(result))) ||
+ ((int)(Xen_vector_length(result)) <= print_length(ss)))
return(g_print_1(result));
ilen = print_length(ss);
@@ -685,16 +848,16 @@ static char *gl_print(XEN result)
savelen = 128;
#if HAVE_FORTH
- sprintf(newbuf, "#(");
+ snprintf(newbuf, 128, "#(");
#endif
#if HAVE_RUBY
- sprintf(newbuf, "[");
+ snprintf(newbuf, 128, "[");
#endif
for (i = 0; i < ilen; i++)
{
- str = g_print_1(XEN_VECTOR_REF(result, i));
+ str = g_print_1(Xen_vector_ref(result, i));
if ((str) && (*str))
{
if (i != 0)
@@ -744,7 +907,7 @@ void snd_display_result(const char *str, const char *endstr)
}
-void snd_report_result(XEN result, const char *buf)
+void snd_report_result(Xen result, const char *buf)
{
char *str = NULL;
str = gl_print(result);
@@ -753,7 +916,7 @@ void snd_report_result(XEN result, const char *buf)
}
-void snd_report_listener_result(XEN form)
+void snd_report_listener_result(Xen form)
{
snd_report_result(form, "\n");
}
@@ -768,24 +931,216 @@ void clear_stdin(void)
}
-static char *stdin_check_for_full_expression(const char *newstr)
-{
-#if HAVE_SCHEME
- int end_of_text;
-#endif
- if (stdin_str)
- {
- char *str;
- str = stdin_str;
- stdin_str = (char *)calloc(mus_strlen(str) + mus_strlen(newstr) + 2, sizeof(char));
- strcat(stdin_str, str);
- strcat(stdin_str, newstr);
- free(str);
- }
- else stdin_str = mus_strdup(newstr);
#if HAVE_SCHEME
- end_of_text = check_balance(stdin_str, 0, mus_strlen(stdin_str), false); /* last-arg->not in listener */
- if (end_of_text > 0)
+static int check_balance(const char *expr, int start, int end)
+{
+ int i;
+ bool not_whitespace = false;
+ int paren_count = 0;
+ bool prev_separator = true;
+ bool quote_wait = false;
+
+ i = start;
+ while (i < end)
+ {
+ switch (expr[i])
+ {
+ case ';' :
+ /* skip till newline. */
+ do {
+ i++;
+ } while ((i < end) && (expr[i] != '\n'));
+ break;
+
+ case ' ':
+ case '\n':
+ case '\t':
+ case '\r':
+ if ((not_whitespace) && (paren_count == 0) && (!quote_wait))
+ return(i);
+ else
+ {
+ prev_separator = true;
+ i++;
+ }
+ break;
+
+ case '\"' :
+ if ((not_whitespace) && (paren_count == 0) && (!quote_wait))
+ return(i);
+ else
+ {
+ /* skip past ", ignoring \", some cases:
+ * "\"\"" '("\"\"") "\\" "#\\(" "'(\"#\\\")"
+ */
+ while (i < end)
+ {
+ i++;
+ if (expr[i] == '\\')
+ i++;
+ else
+ {
+ if (expr[i] == '\"')
+ break;
+ }
+ }
+ i++;
+ if (paren_count == 0)
+ {
+ if (i < end)
+ return(i);
+ else return(0);
+ }
+ else
+ {
+ prev_separator = true;
+ not_whitespace = true;
+ quote_wait = false;
+ }
+ }
+ break;
+
+ case '#':
+ if ((i < end - 1) &&
+ (expr[i + 1] == '|'))
+ {
+ /* (+ #| a comment |# 2 1) */
+ i++;
+ do {
+ i++;
+ } while (((expr[i] != '|') || (expr[i + 1] != '#')) && (i < end));
+ i++;
+ break;
+ }
+ else
+ {
+ /* (set! *#readers* (cons (cons #\c (lambda (str) (apply make-rectangular (read)))) *#readers*))
+ */
+ if ((not_whitespace) && (paren_count == 0) && (!quote_wait))
+ return(i);
+ else
+ {
+ bool found_it = false;
+ if (prev_separator)
+ {
+ int k, incr = 0;
+ for (k = i + 1; k < end; k++)
+ {
+ if (expr[k] == '(')
+ {
+ /* should we look at the readers here? I want to support #c(1 2) for example */
+ not_whitespace = false;
+ prev_separator = false;
+ incr = k - i;
+ break;
+ }
+ else
+ {
+ if ((!isdigit((int)expr[k])) && /* #2d(...)? */
+ (!isalpha((int)expr[k])) && /* #c(1 2)? */
+ (expr[k] != 'D') &&
+ (expr[k] != 'd') &&
+ (expr[k] != '=') && /* what is this for? */
+ (expr[k] != '#')) /* perhaps #1d(#(1 2) 3) ? */
+ break;
+ }
+ }
+ if (incr > 0)
+ {
+ i += incr;
+ found_it = true;
+ }
+ }
+ if (!found_it)
+ {
+ if ((i + 2 < end) && (expr[i + 1] == '\\') &&
+ ((expr[i + 2] == ')') || (expr[i + 2] == ';') || (expr[i + 2] == '\"') || (expr[i + 2] == '(')))
+ i += 3;
+ else
+ {
+ prev_separator = false;
+ quote_wait = false;
+ not_whitespace = true;
+ i++;
+ }
+ }
+ }
+ }
+ break;
+
+ case '(' :
+ if ((not_whitespace) && (paren_count == 0) && (!quote_wait))
+ return(i - 1); /* 'a(...) -- ignore the (...) */
+ else
+ {
+ i++;
+ paren_count++;
+ not_whitespace = true;
+ prev_separator = true;
+ quote_wait = false;
+ }
+ break;
+
+ case ')' :
+ paren_count--;
+ if ((not_whitespace) && (paren_count == 0))
+ return(i + 1);
+ else
+ {
+ i++;
+ not_whitespace = true;
+ prev_separator = true;
+ quote_wait = false;
+ }
+ break;
+
+ case '\'' :
+ case '`' : /* `(1 2) */
+ if (prev_separator)
+ quote_wait = true;
+ not_whitespace = true;
+ i++;
+ break;
+
+ case ',': /* `,(+ 1 2) */
+ case '@': /* `,@(list 1 2) */
+ prev_separator = false;
+ not_whitespace = true;
+ i++;
+ break;
+
+ default:
+ prev_separator = false;
+ quote_wait = false;
+ not_whitespace = true;
+ i++;
+ break;
+ }
+ }
+
+ return(0);
+}
+#endif
+
+
+char *stdin_check_for_full_expression(const char *newstr)
+{
+#if HAVE_SCHEME
+ int end_of_text;
+#endif
+ if (stdin_str)
+ {
+ char *str;
+ str = stdin_str;
+ stdin_str = (char *)calloc(mus_strlen(str) + mus_strlen(newstr) + 2, sizeof(char));
+ strcat(stdin_str, str);
+ strcat(stdin_str, newstr);
+ free(str);
+ }
+ else stdin_str = mus_strdup(newstr);
+#if HAVE_SCHEME
+ end_of_text = check_balance(stdin_str, 0, mus_strlen(stdin_str));
+ if (end_of_text > 0)
{
if (end_of_text + 1 < mus_strlen(stdin_str))
stdin_str[end_of_text + 1] = 0;
@@ -796,6 +1151,12 @@ static char *stdin_check_for_full_expression(const char *newstr)
return(stdin_str);
}
+void stdin_free_str(void)
+{
+ if (stdin_str) free(stdin_str);
+ stdin_str = NULL;
+}
+
static void string_to_stdout(const char *msg, void *ignored)
{
@@ -814,7 +1175,7 @@ void snd_eval_stdin_str(const char *buf)
str = stdin_check_for_full_expression(buf);
if (str)
{
- XEN result;
+ Xen result;
int loc;
redirect_everything_to(string_to_stdout, NULL);
@@ -822,9 +1183,8 @@ void snd_eval_stdin_str(const char *buf)
redirect_everything_to(NULL, NULL);
loc = snd_protect(result);
- if (stdin_str) free(stdin_str);
- /* same as str here */
- stdin_str = NULL;
+ stdin_free_str();
+
str = gl_print(result);
string_to_stdout(str, NULL);
@@ -858,12 +1218,12 @@ static void string_to_stderr_and_listener(const char *msg, void *ignore)
static bool snd_load_init_file_1(const char *filename)
{
- char *expr, *fullname;
- XEN result;
+ char *fullname;
bool happy = false;
fullname = mus_expand_filename(filename);
if (mus_file_probe(fullname))
{
+ char *expr;
happy = true;
#if HAVE_SCHEME
expr = mus_format("(load %s)", fullname);
@@ -872,27 +1232,8 @@ static bool snd_load_init_file_1(const char *filename)
#if HAVE_RUBY || HAVE_FORTH
expr = mus_format("load(%s)", fullname);
#endif
-
- result = snd_catch_any(eval_file_wrapper, (void *)fullname, expr);
+ snd_catch_any(eval_file_wrapper, (void *)fullname, expr);
free(expr);
-
-#if HAVE_RUBY || HAVE_FORTH
- if (!(XEN_TRUE_P(result)))
- {
- int loc;
- char *str;
- loc = snd_protect(result);
- str = gl_print(result);
- if (str)
- {
- expr = mus_format("%s: %s\n", filename, str);
- snd_error_without_format(expr);
- free(str);
- free(expr);
- }
- snd_unprotect_at(loc);
- }
-#endif
}
if (fullname) free(fullname);
@@ -935,10 +1276,10 @@ void snd_load_init_file(bool no_global, bool no_init)
#endif
#define SND_INIT_FILE_ENVIRONMENT_NAME "SND_INIT_FILE"
-#if (!HAVE_WINDOZE)
- #define INIT_FILE_NAME "~/.snd"
-#else
+#if (defined(_MSC_VER) || __CYGWIN__)
#define INIT_FILE_NAME "snd-init"
+#else
+ #define INIT_FILE_NAME "~/.snd"
#endif
#define SND_CONF "/etc/snd.conf"
@@ -974,7 +1315,6 @@ static char *find_source_file(const char *orig);
void snd_load_file(const char *filename)
{
char *str = NULL, *str2 = NULL;
- XEN result = XEN_TRUE;
str = mus_expand_filename(filename);
if (!(mus_file_probe(str)))
@@ -991,64 +1331,39 @@ void snd_load_file(const char *filename)
}
str2 = mus_format("(load \"%s\")", filename); /* currently unused in Forth and Ruby */
- result = snd_catch_any(eval_file_wrapper, (void *)str, str2);
+ snd_catch_any(eval_file_wrapper, (void *)str, str2);
if (str) free(str);
if (str2) free(str2);
-
-#if HAVE_RUBY || HAVE_FORTH
- if (!(XEN_TRUE_P(result)))
- {
- int loc;
- loc = snd_protect(result);
- str = gl_print(result);
- if (str)
- {
- snd_error_without_format(str);
- free(str);
- }
- snd_unprotect_at(loc);
- }
-#endif
}
-static XEN g_snd_print(XEN msg)
+static Xen g_snd_print(Xen msg)
{
#define H_snd_print "(" S_snd_print " str): display str in the listener window"
char *str = NULL;
- if (XEN_STRING_P(msg))
- str = mus_strdup(XEN_TO_C_STRING(msg));
+
+ if (Xen_is_string(msg))
+ str = mus_strdup(Xen_string_to_C_string(msg));
else
{
- if (XEN_CHAR_P(msg))
+ if (Xen_is_char(msg))
{
str = (char *)calloc(2, sizeof(char));
- str[0] = XEN_TO_C_CHAR(msg);
+ str[0] = Xen_char_to_C_char(msg);
}
else str = gl_print(msg);
}
- listener_append(str);
- if (str) free(str);
- /* used to check for event in Motif case, but that is very dangerous -- check for infinite loop C-c needs to be somewhere else */
- return(msg);
-}
-
-static XEN print_hook;
-
-bool listener_print_p(const char *msg)
-{
- static int print_depth = 0;
- XEN res = XEN_FALSE;
- if ((msg) && (print_depth == 0) && (mus_strlen(msg) > 0) && (XEN_HOOKED(print_hook)))
+ if (str)
{
- print_depth++;
- res = run_or_hook(print_hook,
- XEN_LIST_1(C_TO_XEN_STRING(msg)),
- S_print_hook);
- print_depth--;
+#if USE_GTK
+ if (ss->listener)
+#endif
+ listener_append(str);
+ free(str);
}
- return(XEN_FALSE_P(res));
+ /* used to check for event in Motif case, but that is very dangerous -- check for infinite loop C-c needs to be somewhere else */
+ return(msg);
}
@@ -1059,7 +1374,7 @@ void check_features_list(const char *features)
if (!features) return;
#if HAVE_SCHEME
- XEN_EVAL_C_STRING(mus_format("(for-each \
+ Xen_eval_C_string(mus_format("(for-each \
(lambda (f) \
(if (not (provided? f)) \
(display (format #f \"~%%no ~A!~%%~%%\" f)))) \
@@ -1068,7 +1383,7 @@ void check_features_list(const char *features)
#if HAVE_RUBY
/* provided? is defined in examp.rb */
- XEN_EVAL_C_STRING(mus_format("[%s].each do |f|\n\
+ Xen_eval_C_string(mus_format("[%s].each do |f|\n\
unless $LOADED_FEATURES.map do |ff| File.basename(ff) end.member?(f.to_s.tr(\"_\", \"-\"))\n\
$stderr.printf(\"~\\nno %%s!\\n\\n\", f.id2name)\n\
end\n\
@@ -1076,7 +1391,7 @@ void check_features_list(const char *features)
#endif
#if HAVE_FORTH
- XEN_EVAL_C_STRING(mus_format("'( %s ) [each] dup \
+ Xen_eval_C_string(mus_format("'( %s ) [each] dup \
provided? [if] \
drop \
[else] \
@@ -1092,12 +1407,12 @@ void check_features_list(const char *features)
mus_float_t string_to_mus_float_t(const char *str, mus_float_t lo, const char *field_name)
{
#if HAVE_EXTENSION_LANGUAGE
- XEN res;
- mus_float_t f;
+ Xen res;
res = snd_catch_any(eval_str_wrapper, (void *)str, "string->float");
- if (XEN_NUMBER_P(res))
+ if (Xen_is_number(res))
{
- f = XEN_TO_C_DOUBLE(res);
+ mus_float_t f;
+ f = Xen_real_to_C_double(res);
if (f < lo)
snd_error("%s: %.3f is invalid", field_name, f);
else return(f);
@@ -1105,7 +1420,7 @@ mus_float_t string_to_mus_float_t(const char *str, mus_float_t lo, const char *f
else snd_error("%s is not a number", str);
return(0.0);
#else
- mus_float_t res = 0.0;
+ float res = 0.0;
if (str)
{
if (!(sscanf(str, "%f", &res)))
@@ -1116,7 +1431,7 @@ mus_float_t string_to_mus_float_t(const char *str, mus_float_t lo, const char *f
snd_error("%s: %.3f is invalid", field_name, res);
}
}
- return(res);
+ return((mus_float_t)res);
#endif
}
@@ -1124,12 +1439,12 @@ mus_float_t string_to_mus_float_t(const char *str, mus_float_t lo, const char *f
int string_to_int(const char *str, int lo, const char *field_name)
{
#if HAVE_EXTENSION_LANGUAGE
- XEN res;
+ Xen res;
res = snd_catch_any(eval_str_wrapper, (void *)str, "string->int");
- if (XEN_NUMBER_P(res))
+ if (Xen_is_number(res))
{
int val;
- val = XEN_TO_C_INT(res);
+ val = Xen_integer_to_C_int(res);
if (val < lo)
snd_error("%s: %d is invalid", field_name, val);
else return(val);
@@ -1140,7 +1455,7 @@ int string_to_int(const char *str, int lo, const char *field_name)
int res = 0;
if (str)
{
- if (!(sscanf(str, "%d", &res)))
+ if (!(sscanf(str, "%12d", &res)))
snd_error("%s: %s is not a number", field_name, str);
else
{
@@ -1156,15 +1471,15 @@ int string_to_int(const char *str, int lo, const char *field_name)
mus_long_t string_to_mus_long_t(const char *str, mus_long_t lo, const char *field_name)
{
#if HAVE_EXTENSION_LANGUAGE
- XEN res;
+ Xen res;
res = snd_catch_any(eval_str_wrapper, (void *)str, "string->mus_long_t");
- if (XEN_NUMBER_P(res))
+ if (Xen_is_number(res))
{
mus_long_t val;
- val = XEN_TO_C_INT64_T(res);
+ val = Xen_llong_to_C_llong(res);
if (val < lo)
- snd_error("%s: " MUS_LD " is invalid", field_name, val);
+ snd_error("%s: %lld is invalid", field_name, val);
else return(val);
}
else snd_error("%s: %s is not a number", field_name, str);
@@ -1173,12 +1488,12 @@ mus_long_t string_to_mus_long_t(const char *str, mus_long_t lo, const char *fiel
mus_long_t res = 0;
if (str)
{
- if (!(sscanf(str, MUS_LD , &res)))
+ if (!(sscanf(str, "%lld" , &res)))
snd_error("%s: %s is not a number", field_name, str);
else
{
if (res < lo)
- snd_error("%s: " MUS_LD " is invalid", field_name, res);
+ snd_error("%s: %lld is invalid", field_name, res);
}
}
return(res);
@@ -1186,204 +1501,190 @@ mus_long_t string_to_mus_long_t(const char *str, mus_long_t lo, const char *fiel
}
-XEN run_progn_hook(XEN hook, XEN args, const char *caller)
+Xen run_progn_hook(Xen hook, Xen args, const char *caller)
{
#if HAVE_SCHEME
- int gc_loc;
-#endif
- XEN result = XEN_FALSE;
- XEN procs = XEN_HOOK_PROCEDURES(hook);
-
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, args);
- /* this gc protection is needed in s7 because the args are not s7 eval-assembled;
- * they are cons'd up in our C code, and applied here via s7_call, so between
- * s7_call's, they are not otherwise protected. In normal function calls, the
- * args are on the sc->args list in the evaluator, and therefore protected.
- */
-#endif
+ return(s7_call(s7, hook, args));
+#else
+ Xen result = Xen_false;
+ Xen procs = Xen_hook_list(hook);
- while (XEN_NOT_NULL_P(procs))
+ while (!Xen_is_null(procs))
{
- result = XEN_APPLY(XEN_CAR(procs), args, caller);
- procs = XEN_CDR(procs);
+ result = Xen_apply(Xen_car(procs), args, caller);
+ procs = Xen_cdr(procs);
}
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
-
return(result);
+#endif
}
-XEN run_hook(XEN hook, XEN args, const char *caller)
+Xen run_hook(Xen hook, Xen args, const char *caller)
{
#if HAVE_SCHEME
- int gc_loc;
-#endif
- XEN procs = XEN_HOOK_PROCEDURES(hook);
-
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, args);
-#endif
+ return(s7_call(s7, hook, args));
+#else
+ Xen procs = Xen_hook_list(hook);
- while (XEN_NOT_NULL_P(procs))
+ while (!Xen_is_null(procs))
{
- if (!(XEN_EQ_P(args, XEN_EMPTY_LIST)))
- XEN_APPLY(XEN_CAR(procs), args, caller);
- else XEN_CALL_0(XEN_CAR(procs), caller);
- procs = XEN_CDR (procs);
+ if (!(Xen_is_eq(args, Xen_empty_list)))
+ Xen_apply(Xen_car(procs), args, caller);
+ else Xen_call_with_no_args(Xen_car(procs), caller);
+ procs = Xen_cdr(procs);
}
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
+ return(Xen_false);
#endif
-
- return(XEN_FALSE);
}
-XEN run_or_hook(XEN hook, XEN args, const char *caller)
+Xen run_or_hook(Xen hook, Xen args, const char *caller)
{
#if HAVE_SCHEME
- int gc_loc;
-#endif
- XEN result = XEN_FALSE; /* (or): #f */
- XEN hook_result = XEN_FALSE;
- XEN procs = XEN_HOOK_PROCEDURES(hook);
-
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, args);
-#endif
+ return(s7_call(s7, hook, args));
+#else
+ Xen result = Xen_false; /* (or): #f */
+ Xen hook_result = Xen_false;
+ Xen procs = Xen_hook_list(hook);
- while (XEN_NOT_NULL_P(procs))
+ while (!Xen_is_null(procs))
{
- if (!(XEN_EQ_P(args, XEN_EMPTY_LIST)))
- result = XEN_APPLY(XEN_CAR(procs), args, caller);
- else result = XEN_CALL_0(XEN_CAR(procs), caller);
- if (XEN_NOT_FALSE_P(result))
+ if (!(Xen_is_eq(args, Xen_empty_list)))
+ result = Xen_apply(Xen_car(procs), args, caller);
+ else result = Xen_call_with_no_args(Xen_car(procs), caller);
+ if (!Xen_is_false(result))
hook_result = result;
- procs = XEN_CDR (procs);
+ procs = Xen_cdr(procs);
}
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
-
return(hook_result);
+#endif
}
-#if HAVE_SCHEME && HAVE_DLFCN_H
+#if HAVE_SCHEME && (!_MSC_VER)
#include <dlfcn.h>
/* these are included because libtool's dlopen is incredibly stupid */
-static XEN g_dlopen(XEN name)
+/* apparently netBSD does not have dlerror?
+ #ifdef __NetBSD__
+ #define dlerror() g_strerror(errno)
+ #endif
+
+ to get symbols from current program: handle = dlopen(NULL, RTLD_GLOBAL | RTLD_LAZY);
+ */
+
+static Xen g_dlopen(Xen name, Xen flags)
{
- #define H_dlopen "(dlopen lib) loads the dynamic library 'lib' and returns a handle for it (for dlinit and dlclose)"
+ #define H_dlopen "(dlopen lib (flags RTLD_LAZY)) loads the dynamic library 'lib' and returns a handle for it (for dlinit and dlclose)"
void *handle;
const char *cname;
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, "dlopen", "a string (filename)");
- cname = XEN_TO_C_STRING(name);
+ Xen_check_type(Xen_is_string(name), name, 1, "dlopen", "a string (filename)");
+ cname = Xen_string_to_C_string(name);
if (cname)
{
handle = dlopen(cname, RTLD_LAZY);
if (handle == NULL)
{
char *longname;
+
longname = mus_expand_filename(cname);
- handle = dlopen(longname, RTLD_LAZY);
+ if (Xen_is_integer(flags))
+ handle = dlopen(longname, Xen_integer_to_C_int(flags));
+ else handle = dlopen(longname, RTLD_LAZY);
free(longname);
+
if (handle == NULL)
{
char *err;
err = (char *)dlerror();
if ((err) && (*err))
- return(C_TO_XEN_STRING(err));
- return(XEN_FALSE);
+ return(C_string_to_Xen_string(err));
+ return(Xen_false);
}
}
- return(XEN_WRAP_C_POINTER(handle));
+ return(Xen_wrap_C_pointer(handle));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_dlclose(XEN handle)
+static Xen g_dlclose(Xen handle)
{
#define H_dlclose "(dlclose handle) may close the library referred to by 'handle'."
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(handle), handle, XEN_ONLY_ARG, "dlclose", "a library handle");
- return(C_TO_XEN_INT(dlclose((void *)(XEN_UNWRAP_C_POINTER(handle)))));
+ Xen_check_type(Xen_is_wrapped_c_pointer(handle), handle, 1, "dlclose", "a library handle");
+ return(C_int_to_Xen_integer(dlclose((void *)(Xen_unwrap_C_pointer(handle)))));
}
-static XEN g_dlerror(void)
+static Xen g_dlerror(void)
{
#define H_dlerror "(dlerror) returns a string describing the last dlopen/dlinit/dlclose error"
- return(C_TO_XEN_STRING(dlerror()));
+ return(C_string_to_Xen_string(dlerror()));
}
-static XEN g_dlinit(XEN handle, XEN func)
+static Xen g_dlsym(Xen handle, Xen func)
+{
+ #define H_dlsym "(dlsym library function-name) returns a pointer to function in library, or #f."
+ void *proc;
+
+ Xen_check_type(Xen_is_wrapped_c_pointer(handle), handle, 1, "dlsym", "a library handle");
+ Xen_check_type(Xen_is_string(func), func, 2, "dlsym", "a string (function name)");
+
+ proc = dlsym((void *)(Xen_unwrap_C_pointer(handle)), Xen_string_to_C_string(func));
+ if (proc == NULL) return(Xen_false);
+ return(Xen_wrap_C_pointer(func));
+}
+
+
+static Xen g_dlinit(Xen handle, Xen func)
{
#define H_dlinit "(dlinit handle func) calls 'func' from the library referred to by 'handle'."
typedef void *(*snd_dl_func)(void);
void *proc;
- proc = dlsym((void *)(XEN_UNWRAP_C_POINTER(handle)), XEN_TO_C_STRING(func));
- if (proc == NULL) return(C_TO_XEN_STRING(dlerror()));
+
+ Xen_check_type(Xen_is_wrapped_c_pointer(handle), handle, 1, "dlinit", "a library handle");
+ Xen_check_type(Xen_is_string(func), func, 2, "dlinit", "a string (init func name)");
+
+ proc = dlsym((void *)(Xen_unwrap_C_pointer(handle)), Xen_string_to_C_string(func));
+ if (proc == NULL) return(C_string_to_Xen_string(dlerror()));
((snd_dl_func)proc)();
- return(XEN_TRUE);
+ return(Xen_true);
}
+#endif
-#if 0
-static XEN g_dlinit(XEN handle, XEN func)
+#if HAVE_SCHEME
+static s7_pointer g_line_reader(s7_scheme *sc, s7_pointer args)
{
- /* 'man dlopen' suggests: double (*cosine)(double); *(void **) (&cosine) = dlsym(handle, "cos"); printf("%f\n", (*cosine)(2.0)); */
- void (*proc)(void);
- /* typedef void *(*snd_dl_func)(void); */
- /* void *proc; */
- (*(void **)(&proc)) = dlsym((void *)(XEN_UNWRAP_C_POINTER(handle)), XEN_TO_C_STRING(func));
- /* but this line triggers warnings from gcc */
- if (proc == NULL) return(C_TO_XEN_STRING(dlerror()));
- /* ((snd_dl_func)proc)(); */
- (*proc)();
- return(XEN_TRUE);
+ const char *str;
+ Xen_check_type(Xen_is_string(s7_car(args)), s7_car(args), 1, "#__line__", "a string");
+ str = s7_string(s7_car(args));
+ if ((str) && (strcmp(str, "__line__") == 0))
+ return(s7_make_integer(sc, s7_port_line_number(s7_current_input_port(sc))));
+ return(Xen_false);
}
#endif
-#endif
-
-static XEN g_little_endian(void)
+static Xen g_little_endian(void)
{
#if MUS_LITTLE_ENDIAN
- return(XEN_TRUE);
+ return(Xen_true);
#else
- return(XEN_FALSE);
+ return(Xen_false);
#endif
}
-static XEN g_snd_global_state(void)
+static Xen g_snd_global_state(void)
{
- return(XEN_WRAP_C_POINTER(ss));
+ return(Xen_wrap_C_pointer(ss));
}
-#if MUS_DEBUGGING
-static XEN g_snd_sound_pointer(XEN snd)
-{
- /* (XtCallCallbacks (cadr (sound-widgets 0)) XmNactivateCallback (snd-sound-pointer 0)) */
- int s;
- s = XEN_TO_C_INT(snd);
- if ((s < ss->max_sounds) && (s >= 0) && (ss->sounds[s]))
- return(XEN_WRAP_C_POINTER(ss->sounds[s]));
- return(XEN_FALSE);
-}
-#endif
-
-
#if (!HAVE_SCHEME)
/* fmod is the same as modulo in s7:
(do ((i 0 (+ i 1)))
@@ -1396,18 +1697,18 @@ static XEN g_snd_sound_pointer(XEN snd)
(format *stderr* "~A ~A -> ~A ~A~%" val1 val2 f m)))))
*/
-static XEN g_fmod(XEN a, XEN b)
+static Xen g_fmod(Xen a, Xen b)
{
double val, x, y;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(a), a, XEN_ARG_1, "fmod", " a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(b), b, XEN_ARG_2, "fmod", " a number");
- x = XEN_TO_C_DOUBLE(a);
- y = XEN_TO_C_DOUBLE(b);
+ Xen_check_type(Xen_is_number(a), a, 1, "fmod", " a number");
+ Xen_check_type(Xen_is_number(b), b, 2, "fmod", " a number");
+ x = Xen_real_to_C_double(a);
+ y = Xen_real_to_C_double(b);
val = fmod(x, y);
if (((y > 0.0) && (val < 0.0)) ||
((y < 0.0) && (val > 0.0)))
- return(C_TO_XEN_DOUBLE(val + y));
- return(C_TO_XEN_DOUBLE(val));
+ return(C_double_to_Xen_real(val + y));
+ return(C_double_to_Xen_real(val));
}
#endif
@@ -1422,15 +1723,13 @@ static XEN g_fmod(XEN a, XEN b)
#endif
-/* ---------------------------------------- use libm ---------------------------------------- */
-
#if HAVE_SCHEME && WITH_GMP && HAVE_SPECIAL_FUNCTIONS
#include <gmp.h>
#include <mpfr.h>
#include <mpc.h>
-static XEN big_math_1(XEN x,
+static Xen big_math_1(Xen x,
int (*mpfr_math)(mpfr_ptr, mpfr_srcptr, mpfr_rnd_t))
{
s7_pointer val;
@@ -1443,35 +1742,35 @@ static XEN big_math_1(XEN x,
}
-static XEN big_j0(XEN x) {return(big_math_1(x, mpfr_j0));}
-static XEN big_j1(XEN x) {return(big_math_1(x, mpfr_j1));}
-static XEN big_y0(XEN x) {return(big_math_1(x, mpfr_y0));}
-static XEN big_y1(XEN x) {return(big_math_1(x, mpfr_y1));}
+static Xen big_j0(Xen x) {return(big_math_1(x, mpfr_j0));}
+static Xen big_j1(Xen x) {return(big_math_1(x, mpfr_j1));}
+static Xen big_y0(Xen x) {return(big_math_1(x, mpfr_y0));}
+static Xen big_y1(Xen x) {return(big_math_1(x, mpfr_y1));}
-static XEN big_erf(XEN x) {return(big_math_1(x, mpfr_erf));}
-static XEN big_erfc(XEN x) {return(big_math_1(x, mpfr_erfc));}
+static Xen big_erf(Xen x) {return(big_math_1(x, mpfr_erf));}
+static Xen big_erfc(Xen x) {return(big_math_1(x, mpfr_erfc));}
-static XEN big_math_2(XEN n, XEN x,
+static Xen big_math_2(Xen n, Xen x,
int (*mpfr_math)(mpfr_ptr, long, mpfr_srcptr, mpfr_rnd_t))
{
s7_pointer val;
mpfr_t y;
mpfr_init_set(y, *s7_big_real(x), GMP_RNDN);
- mpfr_math(y, XEN_TO_C_INT(n), y, GMP_RNDN);
+ mpfr_math(y, Xen_integer_to_C_int(n), y, GMP_RNDN);
val = s7_make_big_real(s7, &y);
mpfr_clear(y);
return(val);
}
-static XEN big_jn(XEN n, XEN x) {return(big_math_2(n, x, mpfr_jn));}
-static XEN big_yn(XEN n, XEN x) {return(big_math_2(n, x, mpfr_yn));}
+static Xen big_jn(Xen n, Xen x) {return(big_math_2(n, x, mpfr_jn));}
+static Xen big_yn(Xen n, Xen x) {return(big_math_2(n, x, mpfr_yn));}
/* bes-i0 from G&R 8.447, 8.451, A&S 9.6.12, 9.7.1, arprec bessel.cpp */
-static XEN big_i0(XEN ux)
+static Xen big_i0(Xen ux)
{
int k;
mpfr_t sum, x, x1, x2, eps;
@@ -1691,10 +1990,12 @@ static s7_pointer bignum_fft(s7_scheme *sc, s7_pointer args)
#if HAVE_SPECIAL_FUNCTIONS && (!HAVE_GSL)
-static XEN g_j0(XEN x)
+static Xen g_j0(Xen x)
{
#define H_j0 "(" S_bes_j0 " x): returns the regular cylindrical bessel function value J0(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_j0, " a number");
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_j0, " a number");
+#endif
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
@@ -1702,14 +2003,16 @@ static XEN g_j0(XEN x)
(!(s7_is_rational(x))))
return(big_j0(x));
#endif
- return(C_TO_XEN_DOUBLE(j0(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(j0(Xen_real_to_C_double(x))));
}
-static XEN g_j1(XEN x)
+static Xen g_j1(Xen x)
{
#define H_j1 "(" S_bes_j1 " x): returns the regular cylindrical bessel function value J1(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_j1, " a number");
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_j1, " a number");
+#endif
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
@@ -1717,15 +2020,17 @@ static XEN g_j1(XEN x)
(!(s7_is_rational(x))))
return(big_j1(x));
#endif
- return(C_TO_XEN_DOUBLE(j1(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(j1(Xen_real_to_C_double(x))));
}
-static XEN g_jn(XEN order, XEN x)
+static Xen g_jn(Xen order, Xen x)
{
#define H_jn "(" S_bes_jn " n x): returns the regular cylindrical bessel function value Jn(x)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(order), x, XEN_ARG_1, S_bes_jn, " an int");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_2, S_bes_jn, " a number");
+ Xen_check_type(Xen_is_integer(order), x, 1, S_bes_jn, " an int");
+#if (!HAVE_SCHEME)
+ Xen_check_type(Xen_is_number(x), x, 2, S_bes_jn, " a number");
+#endif
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
@@ -1733,103 +2038,103 @@ static XEN g_jn(XEN order, XEN x)
(!(s7_is_rational(x))))
return(big_jn(order, x));
#endif
- return(C_TO_XEN_DOUBLE(jn(XEN_TO_C_INT(order), XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(jn(Xen_integer_to_C_int(order), Xen_real_to_C_double(x))));
}
-static XEN g_y0(XEN x)
+static Xen g_y0(Xen x)
{
#define H_y0 "(" S_bes_y0 " x): returns the irregular cylindrical bessel function value Y0(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_y0, " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_y0, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_y0(x));
#endif
- return(C_TO_XEN_DOUBLE(y0(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(y0(Xen_real_to_C_double(x))));
}
-static XEN g_y1(XEN x)
+static Xen g_y1(Xen x)
{
#define H_y1 "(" S_bes_y1 " x): returns the irregular cylindrical bessel function value Y1(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_y1, " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_y1, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_y1(x));
#endif
- return(C_TO_XEN_DOUBLE(y1(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(y1(Xen_real_to_C_double(x))));
}
-static XEN g_yn(XEN order, XEN x)
+static Xen g_yn(Xen order, Xen x)
{
#define H_yn "(" S_bes_yn " n x): returns the irregular cylindrical bessel function value Yn(x)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(order), x, XEN_ARG_1, S_bes_yn, " an int");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_2, S_bes_yn, " a number");
+ Xen_check_type(Xen_is_integer(order), x, 1, S_bes_yn, " an int");
+ Xen_check_type(Xen_is_number(x), x, 2, S_bes_yn, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_yn(order, x));
#endif
- return(C_TO_XEN_DOUBLE(yn(XEN_TO_C_INT(order), XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(yn(Xen_integer_to_C_int(order), Xen_real_to_C_double(x))));
}
-static XEN g_erf(XEN x)
+static Xen g_erf(Xen x)
{
#define H_erf "(erf x): returns the error function erf(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, "erf", " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, "erf", " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_erf(x));
#endif
- return(C_TO_XEN_DOUBLE(erf(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(erf(Xen_real_to_C_double(x))));
}
-static XEN g_erfc(XEN x)
+static Xen g_erfc(Xen x)
{
#define H_erfc "(erfc x): returns the complementary error function erfc(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, "erfc", " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, "erfc", " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_erfc(x));
#endif
- return(C_TO_XEN_DOUBLE(erfc(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(erfc(Xen_real_to_C_double(x))));
}
-static XEN g_lgamma(XEN x)
+static Xen g_lgamma(Xen x)
{
#define H_lgamma "(lgamma x): returns the log of the gamma function at x"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, "lgamma", " a number");
- return(C_TO_XEN_DOUBLE(lgamma(XEN_TO_C_DOUBLE(x))));
+ Xen_check_type(Xen_is_number(x), x, 1, "lgamma", " a number");
+ return(C_double_to_Xen_real(lgamma(Xen_real_to_C_double(x))));
}
#endif
#define S_bes_i0 "bes-i0"
-static XEN g_i0(XEN x)
+static Xen g_i0(Xen x)
{
#define H_i0 "(" S_bes_i0 " x): returns the modified cylindrical bessel function value I0(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_i0, " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_i0, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_i0(x));
#endif
- return(C_TO_XEN_DOUBLE(mus_bessi0(XEN_TO_C_DOUBLE(x)))); /* uses GSL if possible */
+ return(C_double_to_Xen_real(mus_bessi0(Xen_real_to_C_double(x)))); /* uses GSL if possible */
}
@@ -1839,10 +2144,10 @@ static XEN g_i0(XEN x)
/* include all the bessel functions, etc */
#include <gsl/gsl_sf_bessel.h>
-static XEN g_j0(XEN x)
+static Xen g_j0(Xen x)
{
#define H_j0 "(" S_bes_j0 " x): returns the regular cylindrical bessel function value J0(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_j0, " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_j0, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
@@ -1850,14 +2155,14 @@ static XEN g_j0(XEN x)
(!(s7_is_rational(x))))
return(big_j0(x));
#endif
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_J0(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(gsl_sf_bessel_J0(Xen_real_to_C_double(x))));
}
-static XEN g_j1(XEN x)
+static Xen g_j1(Xen x)
{
#define H_j1 "(" S_bes_j1 " x): returns the regular cylindrical bessel function value J1(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_j1, " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_j1, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
@@ -1865,15 +2170,15 @@ static XEN g_j1(XEN x)
(!(s7_is_rational(x))))
return(big_j1(x));
#endif
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_J1(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(gsl_sf_bessel_J1(Xen_real_to_C_double(x))));
}
-static XEN g_jn(XEN order, XEN x)
+static Xen g_jn(Xen order, Xen x)
{
#define H_jn "(" S_bes_jn " n x): returns the regular cylindrical bessel function value Jn(x)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(order), x, XEN_ARG_1, S_bes_jn, " an int");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_2, S_bes_jn, " a number");
+ Xen_check_type(Xen_is_integer(order), x, 1, S_bes_jn, " an int");
+ Xen_check_type(Xen_is_number(x), x, 2, S_bes_jn, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
@@ -1881,50 +2186,50 @@ static XEN g_jn(XEN order, XEN x)
(!(s7_is_rational(x))))
return(big_jn(order, x));
#endif
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_Jn(XEN_TO_C_INT(order), XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(gsl_sf_bessel_Jn(Xen_integer_to_C_int(order), Xen_real_to_C_double(x))));
}
-static XEN g_y0(XEN x)
+static Xen g_y0(Xen x)
{
#define H_y0 "(" S_bes_y0 " x): returns the irregular cylindrical bessel function value Y0(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_y0, " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_y0, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_y0(x));
#endif
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_Y0(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(gsl_sf_bessel_Y0(Xen_real_to_C_double(x))));
}
-static XEN g_y1(XEN x)
+static Xen g_y1(Xen x)
{
#define H_y1 "(" S_bes_y1 " x): returns the irregular cylindrical bessel function value Y1(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_y1, " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_y1, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_y1(x));
#endif
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_Y1(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(gsl_sf_bessel_Y1(Xen_real_to_C_double(x))));
}
-static XEN g_yn(XEN order, XEN x)
+static Xen g_yn(Xen order, Xen x)
{
#define H_yn "(" S_bes_yn " n x): returns the irregular cylindrical bessel function value Yn(x)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(order), x, XEN_ARG_1, S_bes_yn, " an int");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_2, S_bes_yn, " a number");
+ Xen_check_type(Xen_is_integer(order), x, 1, S_bes_yn, " an int");
+ Xen_check_type(Xen_is_number(x), x, 2, S_bes_yn, " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_yn(order, x));
#endif
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_Yn(XEN_TO_C_INT(order), XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(gsl_sf_bessel_Yn(Xen_integer_to_C_int(order), Xen_real_to_C_double(x))));
}
#define S_bes_i1 "bes-i1"
@@ -1933,175 +2238,119 @@ static XEN g_yn(XEN order, XEN x)
#define S_bes_k1 "bes-k1"
#define S_bes_kn "bes-kn"
-static XEN g_i1(XEN x)
+static Xen g_i1(Xen x)
{
#define H_i1 "(" S_bes_i1 " x): returns the regular cylindrical bessel function value I1(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_i1, " a number");
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_I1(XEN_TO_C_DOUBLE(x))));
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_i1, " a number");
+ return(C_double_to_Xen_real(gsl_sf_bessel_I1(Xen_real_to_C_double(x))));
}
-static XEN g_in(XEN order, XEN x)
+static Xen g_in(Xen order, Xen x)
{
#define H_in "(" S_bes_in " n x): returns the regular cylindrical bessel function value In(x)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(order), x, XEN_ARG_1, S_bes_in, " an int");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_2, S_bes_in, " a number");
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_In(XEN_TO_C_INT(order), XEN_TO_C_DOUBLE(x))));
+ Xen_check_type(Xen_is_integer(order), x, 1, S_bes_in, " an int");
+ Xen_check_type(Xen_is_number(x), x, 2, S_bes_in, " a number");
+ return(C_double_to_Xen_real(gsl_sf_bessel_In(Xen_integer_to_C_int(order), Xen_real_to_C_double(x))));
}
-static XEN g_k0(XEN x)
+static Xen g_k0(Xen x)
{
#define H_k0 "(" S_bes_k0 " x): returns the irregular cylindrical bessel function value K0(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_k0, " a number");
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_K0(XEN_TO_C_DOUBLE(x))));
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_k0, " a number");
+ return(C_double_to_Xen_real(gsl_sf_bessel_K0(Xen_real_to_C_double(x))));
}
-static XEN g_k1(XEN x)
+static Xen g_k1(Xen x)
{
#define H_k1 "(" S_bes_k1 " x): returns the irregular cylindrical bessel function value K1(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, S_bes_k1, " a number");
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_K1(XEN_TO_C_DOUBLE(x))));
+ Xen_check_type(Xen_is_number(x), x, 1, S_bes_k1, " a number");
+ return(C_double_to_Xen_real(gsl_sf_bessel_K1(Xen_real_to_C_double(x))));
}
-static XEN g_kn(XEN order, XEN x)
+static Xen g_kn(Xen order, Xen x)
{
#define H_kn "(" S_bes_kn " n x): returns the irregular cylindrical bessel function value Kn(x)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(order), x, XEN_ARG_1, S_bes_kn, " an int");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ARG_2, S_bes_kn, " a number");
- return(C_TO_XEN_DOUBLE(gsl_sf_bessel_Kn(XEN_TO_C_INT(order), XEN_TO_C_DOUBLE(x))));
+ Xen_check_type(Xen_is_integer(order), x, 1, S_bes_kn, " an int");
+ Xen_check_type(Xen_is_number(x), x, 2, S_bes_kn, " a number");
+ return(C_double_to_Xen_real(gsl_sf_bessel_Kn(Xen_integer_to_C_int(order), Xen_real_to_C_double(x))));
}
#include <gsl/gsl_sf_erf.h>
-static XEN g_erf(XEN x)
+static Xen g_erf(Xen x)
{
#define H_erf "(erf x): returns the error function erf(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, "erf", " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, "erf", " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_erf(x));
#endif
- return(C_TO_XEN_DOUBLE(gsl_sf_erf(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(gsl_sf_erf(Xen_real_to_C_double(x))));
}
-static XEN g_erfc(XEN x)
+static Xen g_erfc(Xen x)
{
#define H_erfc "(erfc x): returns the complementary error function value erfc(x)"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, "erfc", " a number");
+ Xen_check_type(Xen_is_number(x), x, 1, "erfc", " a number");
#if HAVE_SCHEME && WITH_GMP
if ((s7_is_bignum(x)) &&
(s7_is_real(x)) &&
(!(s7_is_rational(x))))
return(big_erfc(x));
#endif
- return(C_TO_XEN_DOUBLE(gsl_sf_erfc(XEN_TO_C_DOUBLE(x))));
+ return(C_double_to_Xen_real(gsl_sf_erfc(Xen_real_to_C_double(x))));
}
#include <gsl/gsl_sf_gamma.h>
-static XEN g_lgamma(XEN x)
+static Xen g_lgamma(Xen x)
{
#define H_lgamma "(lgamma x): returns the log of the gamma function at x"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(x), x, XEN_ONLY_ARG, "lgamma", " a number");
- return(C_TO_XEN_DOUBLE(gsl_sf_lngamma(XEN_TO_C_DOUBLE(x))));
+ Xen_check_type(Xen_is_number(x), x, 1, "lgamma", " a number");
+ return(C_double_to_Xen_real(gsl_sf_lngamma(Xen_real_to_C_double(x))));
}
#include <gsl/gsl_sf_ellint.h>
-static XEN g_gsl_ellipk(XEN k)
+static Xen g_gsl_ellipk(Xen k)
{
+ double f;
#define H_gsl_ellipk "(gsl-ellipk k): returns the complete elliptic integral k"
- XEN_ASSERT_TYPE(XEN_NUMBER_P(k), k, XEN_ONLY_ARG, "gsl-ellipk", "a number");
- return(C_TO_XEN_DOUBLE(gsl_sf_ellint_Kcomp(sqrt(XEN_TO_C_DOUBLE(k)), GSL_PREC_APPROX)));
+ Xen_check_type(Xen_is_number(k), k, 1, "gsl-ellipk", "a number");
+ f = Xen_real_to_C_double(k);
+ Xen_check_type(f >= 0.0, k, 1, "gsl-ellipk", "a non-negative number");
+ return(C_double_to_Xen_real(gsl_sf_ellint_Kcomp(sqrt(Xen_real_to_C_double(k)), GSL_PREC_APPROX)));
}
#include <gsl/gsl_sf_elljac.h>
-static XEN g_gsl_ellipj(XEN u, XEN m)
+static Xen g_gsl_ellipj(Xen u, Xen m)
{
#define H_gsl_ellipj "(gsl-ellipj u m): returns the Jacobian elliptic functions sn, cn, and dn of u and m"
double sn = 0.0, cn = 0.0, dn = 0.0;
- XEN_ASSERT_TYPE(XEN_NUMBER_P(u), u, XEN_ARG_1, "gsl-ellipj", "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(m), m, XEN_ARG_2, "gsl-ellipj", "a number");
- gsl_sf_elljac_e(XEN_TO_C_DOUBLE(u),
- XEN_TO_C_DOUBLE(m),
+ Xen_check_type(Xen_is_number(u), u, 1, "gsl-ellipj", "a number");
+ Xen_check_type(Xen_is_number(m), m, 2, "gsl-ellipj", "a number");
+ gsl_sf_elljac_e(Xen_real_to_C_double(u),
+ Xen_real_to_C_double(m),
&sn, &cn, &dn);
- return(XEN_LIST_3(C_TO_XEN_DOUBLE(sn),
- C_TO_XEN_DOUBLE(cn),
- C_TO_XEN_DOUBLE(dn)));
+ return(Xen_list_3(C_double_to_Xen_real(sn),
+ C_double_to_Xen_real(cn),
+ C_double_to_Xen_real(dn)));
}
-#if MUS_DEBUGGING && HAVE_SCHEME
-/* use gsl gegenbauer to check our function */
-
-#include <gsl/gsl_sf_gegenbauer.h>
-
-static XEN g_gsl_gegenbauer(XEN n, XEN lambda, XEN x)
-{
- gsl_sf_result val;
- gsl_sf_gegenpoly_n_e(XEN_TO_C_INT(n), XEN_TO_C_DOUBLE(lambda), XEN_TO_C_DOUBLE(x), &val);
- return(C_TO_XEN_DOUBLE(val.val));
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_3(g_gsl_gegenbauer_w, g_gsl_gegenbauer)
-#else
- #define g_gsl_gegenbauer_w g_gsl_gegenbauer
+#include <gsl/gsl_version.h>
+#if ((GSL_MAJOR_VERSION >= 1) && (GSL_MINOR_VERSION >= 9))
+ #define HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE 1
#endif
-#endif
-
-
-#include <gsl/gsl_dht.h>
-
-static XEN g_gsl_dht(XEN size, XEN data, XEN nu, XEN xmax)
-{
- #define H_gsl_dht "(gsl-dht size data nu xmax): Hankel transform of data (a vct)"
- int n;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(size), size, XEN_ARG_1, "gsl-dht", "an integer");
- XEN_ASSERT_TYPE(MUS_VCT_P(data), data, XEN_ARG_2, "gsl-dht", "a vct");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(nu), nu, XEN_ARG_3, "gsl-dht", "a number");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(xmax), xmax, XEN_ARG_4, "gsl-dht", "a number");
-
- n = XEN_TO_C_INT(size);
- if (n <= 0)
- XEN_OUT_OF_RANGE_ERROR("gsl-dht", XEN_ARG_1, size, "must be > 0");
- else
- {
- double *indata, *outdata;
- int i;
- vct *v;
-
- gsl_dht *t = gsl_dht_new(n, XEN_TO_C_DOUBLE(nu), XEN_TO_C_DOUBLE(xmax));
-
- indata = (double *)calloc(n, sizeof(double));
- outdata = (double *)calloc(n, sizeof(double));
-
- v = XEN_TO_VCT(data);
- for (i = 0; i < n; i++)
- indata[i] = v->data[i];
-
- gsl_dht_apply(t, indata, outdata);
-
- for (i = 0; i < n; i++)
- v->data[i] = outdata[i];
-
- gsl_dht_free(t);
-
- free(indata);
- free(outdata);
- }
- return(data);
-}
-
#if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
@@ -2110,22 +2359,23 @@ static XEN g_gsl_dht(XEN size, XEN data, XEN nu, XEN xmax)
#include <gsl/gsl_math.h>
#include <gsl/gsl_eigen.h>
-static XEN g_gsl_eigenvectors(XEN matrix)
+static Xen g_gsl_eigenvectors(Xen matrix)
{
double *data;
- mus_any *u1;
- mus_float_t *vals;
int i, j, len;
- XEN values = XEN_FALSE, vectors = XEN_FALSE;
+ Xen values = Xen_false, vectors = Xen_false;
- u1 = XEN_TO_MUS_ANY(matrix);
- if (!mus_mixer_p(u1)) return(XEN_FALSE);
- vals = mus_data(u1);
- len = mus_length(u1);
- data = (double *)calloc(len * len, sizeof(double));
- for (i = 0; i < len; i++)
- for (j = 0; j < len; j++)
- data[i * len + j] = mus_mixer_ref(u1, i, j);
+#if HAVE_SCHEME
+ Xen_check_type(s7_is_float_vector(matrix), matrix, 1, "gsl-eigenvectors", "a float vector");
+ len = (int)sqrt(s7_vector_length(matrix));
+ data = (double *)s7_float_vector_elements(matrix);
+#else
+ vct *v;
+ Xen_check_type(mus_is_vct(matrix), matrix, 1, "gsl-eigenvectors", "a vct");
+ v = Xen_to_vct(matrix);
+ len = (int)sqrt(mus_vct_length(v));
+ data = mus_vct_data(v);
+#endif
{
gsl_matrix_view m = gsl_matrix_view_array(data, len, len);
@@ -2139,25 +2389,37 @@ static XEN g_gsl_eigenvectors(XEN matrix)
{
int values_loc, vectors_loc;
- values = XEN_MAKE_VECTOR(len, XEN_ZERO);
+ values = Xen_make_vector(len, Xen_integer_zero);
values_loc = snd_protect(values);
- vectors = XEN_MAKE_VECTOR(len, XEN_FALSE);
+ vectors = Xen_make_vector(len, Xen_false);
vectors_loc = snd_protect(vectors);
for (i = 0; i < len; i++)
{
- XEN vect;
+ Xen vect;
+#if HAVE_SCHEME
+ s7_double *fv_data;
+#endif
gsl_complex eval_i = gsl_vector_complex_get(eval, i);
gsl_vector_complex_view evec_i = gsl_matrix_complex_column(evec, i);
- XEN_VECTOR_SET(values, i, C_TO_XEN_DOUBLE(GSL_REAL(eval_i)));
+ Xen_vector_set(values, i, C_double_to_Xen_real(GSL_REAL(eval_i)));
- vect = XEN_MAKE_VECTOR(len, XEN_ZERO);
- XEN_VECTOR_SET(vectors, i, vect);
+#if HAVE_SCHEME
+ vect = s7_make_float_vector(s7, len, 1, NULL);
+ fv_data = s7_float_vector_elements(vect);
+#else
+ vect = Xen_make_vector(len, Xen_integer_zero);
+#endif
+ Xen_vector_set(vectors, i, vect);
for (j = 0; j < len; j++)
{
gsl_complex z = gsl_vector_complex_get(&evec_i.vector, j);
- XEN_VECTOR_SET(vect, j, C_TO_XEN_DOUBLE(GSL_REAL(z)));
+#if HAVE_SCHEME
+ fv_data[j] = GSL_REAL(z);
+#else
+ Xen_vector_set(vect, j, C_double_to_Xen_real(GSL_REAL(z)));
+#endif
}
}
snd_unprotect_at(values_loc);
@@ -2168,44 +2430,62 @@ static XEN g_gsl_eigenvectors(XEN matrix)
gsl_matrix_complex_free(evec);
}
+#if (!HAVE_SCHEME)
free(data);
- return(XEN_LIST_2(values, vectors));
+#endif
+ return(Xen_list_2(values, vectors));
}
#endif
-#if HAVE_COMPLEX_TRIG && XEN_HAVE_COMPLEX_NUMBERS
+#if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS
#include <gsl/gsl_poly.h>
#include <complex.h>
-static XEN g_gsl_roots(XEN poly)
+static Xen g_gsl_roots(Xen poly)
{
#define H_gsl_roots "(gsl-roots poly): roots of poly"
int i, n, loc;
double *p;
double complex *z;
gsl_poly_complex_workspace *w;
- XEN result;
+ Xen result;
- XEN_ASSERT_TYPE(XEN_VECTOR_P(poly), poly, XEN_ONLY_ARG, "gsl-roots", "a vector");
+ /* gsl_roots: balance_companion_matrix gets hung if the vector is multidimensional */
+ Xen_check_type((Xen_is_vector(poly)) && (Xen_vector_rank(poly) == 1), poly, 1, "gsl-roots", "a vector");
- n = XEN_VECTOR_LENGTH(poly);
+ n = Xen_vector_length(poly);
w = gsl_poly_complex_workspace_alloc(n);
z = (double complex *)calloc(n, sizeof(double complex));
p = (double *)calloc(n, sizeof(double));
+#if HAVE_SCHEME
+ if (s7_is_float_vector(poly))
+ {
+ s7_double *e;
+ e = s7_float_vector_elements(poly);
+ for (i = 0; i < n; i++)
+ p[i] = e[i];
+ }
+ else
+ {
+ for (i = 0; i < n; i++)
+ p[i] = Xen_real_to_C_double(Xen_vector_ref(poly, i));
+ }
+#else
for (i = 0; i < n; i++)
- p[i] = XEN_TO_C_DOUBLE(XEN_VECTOR_REF(poly, i));
+ p[i] = Xen_real_to_C_double(Xen_vector_ref(poly, i));
+#endif
gsl_poly_complex_solve(p, n, w, (gsl_complex_packed_ptr)z);
gsl_poly_complex_workspace_free (w);
- result = XEN_MAKE_VECTOR(n - 1, XEN_ZERO);
+ result = Xen_make_vector(n - 1, Xen_integer_zero);
loc = snd_protect(result);
for (i = 0; i < n - 1; i++)
if (__imag__(z[i]) != 0.0)
- XEN_VECTOR_SET(result, i, C_TO_XEN_COMPLEX(z[i]));
- else XEN_VECTOR_SET(result, i, C_TO_XEN_DOUBLE(__real__(z[i])));
+ Xen_vector_set(result, i, C_complex_to_Xen_complex(z[i]));
+ else Xen_vector_set(result, i, C_double_to_Xen_real(__real__(z[i])));
free(z);
free(p);
@@ -2242,14 +2522,12 @@ static void add_source_file_extension(const char *ext)
}
-bool source_file_p(const char *name)
+bool is_source_file(const char *name)
{
- int i, dot_loc = -1, len;
-
if (!name) return(false);
-
if (source_file_extensions)
{
+ int i, dot_loc = -1, len;
len = strlen(name);
for (i = 0; i < len; i++)
@@ -2274,31 +2552,32 @@ bool source_file_p(const char *name)
void save_added_source_file_extensions(FILE *fd)
{
- int i;
-
if (source_file_extensions_end > default_source_file_extensions)
- for (i = default_source_file_extensions; i < source_file_extensions_end; i++)
- {
+ {
+ int i;
+ for (i = default_source_file_extensions; i < source_file_extensions_end; i++)
+ {
#if HAVE_SCHEME
- fprintf(fd, "(%s \"%s\")\n", S_add_source_file_extension, source_file_extensions[i]);
+ fprintf(fd, "(%s \"%s\")\n", S_add_source_file_extension, source_file_extensions[i]);
#endif
-
+
#if HAVE_RUBY
- fprintf(fd, "%s(\"%s\")\n", TO_PROC_NAME(S_add_source_file_extension), source_file_extensions[i]);
+ fprintf(fd, "%s(\"%s\")\n", to_proc_name(S_add_source_file_extension), source_file_extensions[i]);
#endif
-
+
#if HAVE_FORTH
- fprintf(fd, "\"%s\" %s drop\n", source_file_extensions[i], S_add_source_file_extension);
+ fprintf(fd, "\"%s\" %s drop\n", source_file_extensions[i], S_add_source_file_extension);
#endif
- }
+ }
+ }
}
-static XEN g_add_source_file_extension(XEN ext)
+static Xen g_add_source_file_extension(Xen ext)
{
#define H_add_source_file_extension "(" S_add_source_file_extension " ext): add the file extension 'ext' to the list of source file extensions"
- XEN_ASSERT_TYPE(XEN_STRING_P(ext), ext, XEN_ONLY_ARG, S_add_source_file_extension, "a string");
- add_source_file_extension(XEN_TO_C_STRING(ext));
+ Xen_check_type(Xen_is_string(ext), ext, 1, S_add_source_file_extension, "a string");
+ add_source_file_extension(Xen_string_to_C_string(ext));
return(ext);
}
@@ -2306,9 +2585,9 @@ static XEN g_add_source_file_extension(XEN ext)
static char *find_source_file(const char *orig)
{
int i;
- char *str;
for (i = 0; i < source_file_extensions_end; i++)
{
+ char *str;
str = mus_format("%s.%s", orig, source_file_extensions[i]);
if (mus_file_probe(str))
return(str);
@@ -2318,326 +2597,72 @@ static char *find_source_file(const char *orig)
}
-#if HAVE_SCHEME
-
-static s7_pointer g_char_position(s7_scheme *sc, s7_pointer args)
-{
- #define H_char_position "(char-position char str (start 0)) returns the position of the first occurrence of char in str, or #f"
- const char *porig, *p;
- char c;
- int start = 0;
-
- if (!s7_is_character(s7_car(args)))
- return(s7_wrong_type_arg_error(sc, "char-position", 1, s7_car(args), "a character"));
- if (!s7_is_string(s7_car(s7_cdr(args))))
- return(s7_wrong_type_arg_error(sc, "char-position", 2, s7_car(s7_cdr(args)), "a string"));
-
- if ((s7_is_pair(s7_cdr(s7_cdr(args)))) &&
- (s7_is_integer(s7_car(s7_cdr(s7_cdr(args))))))
- start = s7_integer(s7_car(s7_cdr(s7_cdr(args))));
-
- c = s7_character(s7_car(args));
- porig = s7_string(s7_car(s7_cdr(args)));
-
- if ((!porig) || (start >= mus_strlen(porig)))
- return(s7_f(sc));
-
- for (p = (const char *)(porig + start); (*p); p++)
- if ((*p) == c)
- return(s7_make_integer(sc, p - porig));
- return(s7_f(sc));
-}
-
-
-static s7_pointer g_string_position_1(s7_scheme *sc, s7_pointer args, bool ci, const char *name)
-{
- const char *s1, *s2, *p1, *p2;
- int start = 0;
-
- if (!s7_is_string(s7_car(args)))
- return(s7_wrong_type_arg_error(sc, name, 1, s7_car(args), "a string"));
- if (!s7_is_string(s7_car(s7_cdr(args))))
- return(s7_wrong_type_arg_error(sc, name, 2, s7_car(s7_cdr(args)), "a string"));
-
- if ((s7_is_pair(s7_cdr(s7_cdr(args)))) &&
- (s7_is_integer(s7_car(s7_cdr(s7_cdr(args))))))
- start = s7_integer(s7_car(s7_cdr(s7_cdr(args))));
-
- s1 = s7_string(s7_car(args));
- s2 = s7_string(s7_car(s7_cdr(args)));
- if (start >= mus_strlen(s2))
- return(s7_f(sc));
-
- if (!ci)
- {
- for (p2 = (const char *)(s2 + start); (*p2); p2++)
- {
- const char *ptemp;
- for (p1 = s1, ptemp = p2; (*p1) && (*ptemp) && ((*p1) == (*ptemp)); p1++, ptemp++);
- if (!(*p1))
- return(s7_make_integer(sc, p2 - s2));
- }
- }
- else
- {
- for (p2 = (const char *)(s2 + start); (*p2); p2++)
- {
- const char *ptemp;
- for (p1 = s1, ptemp = p2; (*p1) && (*ptemp) && (toupper((int)(*p1)) == toupper((int)(*ptemp))); p1++, ptemp++);
- if (!(*p1))
- return(s7_make_integer(sc, p2 - s2));
- }
- }
-
- return(s7_f(sc));
-}
-
-
-static s7_pointer g_string_position(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_position "(string-position str1 str2 (start 0)) returns the starting position of str1 in str2 or #f"
- return(g_string_position_1(sc, args, false, "string-position"));
-}
-
-
-static s7_pointer g_string_ci_position(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_ci_position "(string-ci-position str1 str2 (start 0)) returns the starting position of str1 in str2 ignoring case, or #f"
- return(g_string_position_1(sc, args, true, "string-ci-position"));
-}
-
-
-static s7_pointer g_string_vector_position(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_vector_position "(string-vector-position str vect (start 0)) returns the position of the first occurrence of str in vect starting from start, or #f"
- const char *s1;
- s7_pointer *strs;
- int i, len, start = 0;
-
- if (!s7_is_string(s7_car(args)))
- return(s7_wrong_type_arg_error(sc, "string-vector-position", 1, s7_car(args), "a string"));
- if (!s7_is_vector(s7_car(s7_cdr(args))))
- return(s7_wrong_type_arg_error(sc, "string-vector-position", 2, s7_car(s7_cdr(args)), "a vector"));
-
- if ((s7_is_pair(s7_cdr(s7_cdr(args)))) &&
- (s7_is_integer(s7_car(s7_cdr(s7_cdr(args))))))
- start = s7_integer(s7_car(s7_cdr(s7_cdr(args))));
-
- s1 = s7_string(s7_car(args));
- strs = s7_vector_elements(s7_car(s7_cdr(args)));
- len = s7_vector_length(s7_car(s7_cdr(args)));
-
- for (i = start; i < len; i++)
- if ((s7_is_string(strs[i])) &&
- (mus_strcmp(s1, s7_string(strs[i]))))
- return(s7_make_integer(sc, i));
-
- return(s7_f(sc));
-}
-
-
-static s7_pointer g_string_list_position_1(s7_scheme *sc, s7_pointer args, bool ci, const char *name)
-{
- const char *s1;
- s7_pointer p;
- int i, start = 0;
-
- if (!s7_is_string(s7_car(args)))
- return(s7_wrong_type_arg_error(sc, name, 1, s7_car(args), "a string"));
-
- p = s7_car(s7_cdr(args));
- if (p == s7_nil(sc))
- return(s7_f(sc));
- if (!s7_is_pair(p))
- return(s7_wrong_type_arg_error(sc, name, 2, p, "a list"));
-
- if ((s7_is_pair(s7_cdr(s7_cdr(args)))) &&
- (s7_is_integer(s7_car(s7_cdr(s7_cdr(args))))))
- start = s7_integer(s7_car(s7_cdr(s7_cdr(args))));
-
- s1 = s7_string(s7_car(args));
-
- if (!ci)
- {
- for (i = 0; s7_is_pair(p); p = s7_cdr(p), i++)
- if ((i >= start) &&
- (s7_is_string(s7_car(p))) &&
- (mus_strcmp(s1, s7_string(s7_car(p)))))
- return(s7_make_integer(sc, i));
- }
- else
- {
- for (i = 0; s7_is_pair(p); p = s7_cdr(p), i++)
- if ((i >= start) &&
- (s7_is_string(s7_car(p))) &&
- (strcasecmp(s1, s7_string(s7_car(p))) == 0))
- return(s7_make_integer(sc, i));
- }
- return(s7_f(sc));
-}
-
-
-static s7_pointer g_string_list_position(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_list_position "(string-list-position str lst (start 0)) returns the position of the first occurrence of str in lst starting from start, or #f"
- return(g_string_list_position_1(sc, args, false, "string-list-position"));
-}
-
-
-static s7_pointer g_string_ci_list_position(s7_scheme *sc, s7_pointer args)
-{
- #define H_string_ci_list_position "(string-ci-list-position str lst (start 0)) returns the position of the first occurrence of str in lst starting from start, or #f"
- return(g_string_list_position_1(sc, args, true, "string-ci-list-position"));
-}
-
-
/* list-in-vector|list, vector-in-list|vector, cobj-in-vector|list obj-in-cobj
* string-ci-in-vector? hash-table cases?
* most of this could be done via for-each
*/
-#endif
-
-
-#if MUS_DEBUGGING && HAVE_SCHEME
-static XEN g_test_load(XEN name)
-{
- XEN_LOAD_FILE(XEN_TO_C_STRING(name));
- return(XEN_FALSE);
-}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(g_test_load_w, g_test_load)
-#else
- #define g_test_load_w g_test_load
-#endif
-#endif
-
-
-#ifdef XEN_ARGIFY_1
-#if HAVE_SCHEME && HAVE_DLFCN_H
- XEN_NARGIFY_1(g_dlopen_w, g_dlopen)
- XEN_NARGIFY_1(g_dlclose_w, g_dlclose)
- XEN_NARGIFY_0(g_dlerror_w, g_dlerror)
- XEN_NARGIFY_2(g_dlinit_w, g_dlinit)
+#if HAVE_SCHEME && (!_MSC_VER)
+ Xen_wrap_2_optional_args(g_dlopen_w, g_dlopen)
+ Xen_wrap_1_arg(g_dlclose_w, g_dlclose)
+ Xen_wrap_no_args(g_dlerror_w, g_dlerror)
+ Xen_wrap_2_args(g_dlinit_w, g_dlinit)
+ Xen_wrap_2_args(g_dlsym_w, g_dlsym)
#endif
#if HAVE_SCHEME
- XEN_VARGIFY(g_snd_s7_error_handler_w, g_snd_s7_error_handler);
+ Xen_wrap_any_args(g_snd_s7_error_handler_w, g_snd_s7_error_handler);
#endif
-XEN_NARGIFY_1(g_snd_print_w, g_snd_print)
-XEN_NARGIFY_0(g_little_endian_w, g_little_endian)
-XEN_NARGIFY_0(g_snd_global_state_w, g_snd_global_state)
-XEN_NARGIFY_1(g_add_source_file_extension_w, g_add_source_file_extension)
-
-#if MUS_DEBUGGING
- XEN_NARGIFY_1(g_snd_sound_pointer_w, g_snd_sound_pointer)
-#endif
+Xen_wrap_1_arg(g_snd_print_w, g_snd_print)
+Xen_wrap_no_args(g_little_endian_w, g_little_endian)
+Xen_wrap_no_args(g_snd_global_state_w, g_snd_global_state)
+Xen_wrap_1_arg(g_add_source_file_extension_w, g_add_source_file_extension)
#if (!HAVE_SCHEME)
-XEN_NARGIFY_2(g_fmod_w, g_fmod)
+Xen_wrap_2_args(g_fmod_w, g_fmod)
#endif
#if HAVE_SPECIAL_FUNCTIONS || HAVE_GSL
- XEN_NARGIFY_1(g_j0_w, g_j0)
- XEN_NARGIFY_1(g_j1_w, g_j1)
- XEN_NARGIFY_2(g_jn_w, g_jn)
- XEN_NARGIFY_1(g_y0_w, g_y0)
- XEN_NARGIFY_1(g_y1_w, g_y1)
- XEN_NARGIFY_2(g_yn_w, g_yn)
- XEN_NARGIFY_1(g_erf_w, g_erf)
- XEN_NARGIFY_1(g_erfc_w, g_erfc)
- XEN_NARGIFY_1(g_lgamma_w, g_lgamma)
+ Xen_wrap_1_arg(g_j0_w, g_j0)
+ Xen_wrap_1_arg(g_j1_w, g_j1)
+ Xen_wrap_2_args(g_jn_w, g_jn)
+ Xen_wrap_1_arg(g_y0_w, g_y0)
+ Xen_wrap_1_arg(g_y1_w, g_y1)
+ Xen_wrap_2_args(g_yn_w, g_yn)
+ Xen_wrap_1_arg(g_erf_w, g_erf)
+ Xen_wrap_1_arg(g_erfc_w, g_erfc)
+ Xen_wrap_1_arg(g_lgamma_w, g_lgamma)
#endif
-XEN_NARGIFY_1(g_i0_w, g_i0)
+Xen_wrap_1_arg(g_i0_w, g_i0)
#if HAVE_GSL
- XEN_NARGIFY_1(g_i1_w, g_i1)
- XEN_NARGIFY_2(g_in_w, g_in)
- XEN_NARGIFY_1(g_k0_w, g_k0)
- XEN_NARGIFY_1(g_k1_w, g_k1)
- XEN_NARGIFY_2(g_kn_w, g_kn)
-
- XEN_NARGIFY_1(g_gsl_ellipk_w, g_gsl_ellipk)
- XEN_NARGIFY_2(g_gsl_ellipj_w, g_gsl_ellipj)
- XEN_NARGIFY_4(g_gsl_dht_w, g_gsl_dht)
+ Xen_wrap_1_arg(g_i1_w, g_i1)
+ Xen_wrap_2_args(g_in_w, g_in)
+ Xen_wrap_1_arg(g_k0_w, g_k0)
+ Xen_wrap_1_arg(g_k1_w, g_k1)
+ Xen_wrap_2_args(g_kn_w, g_kn)
+
+ Xen_wrap_1_arg(g_gsl_ellipk_w, g_gsl_ellipk)
+ Xen_wrap_2_args(g_gsl_ellipj_w, g_gsl_ellipj)
#if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
- XEN_NARGIFY_1(g_gsl_eigenvectors_w, g_gsl_eigenvectors)
+ Xen_wrap_1_arg(g_gsl_eigenvectors_w, g_gsl_eigenvectors)
#endif
- #if HAVE_COMPLEX_TRIG && XEN_HAVE_COMPLEX_NUMBERS
- XEN_NARGIFY_1(g_gsl_roots_w, g_gsl_roots)
+ #if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS
+ Xen_wrap_1_arg(g_gsl_roots_w, g_gsl_roots)
#endif
#endif
-#else
-/* not argify */
-#if HAVE_SCHEME && HAVE_DLFCN_H
- #define g_dlopen_w g_dlopen
- #define g_dlclose_w g_dlclose
- #define g_dlerror_w g_dlerror
- #define g_dlinit_w g_dlinit
-#endif
-#if HAVE_SCHEME
- #define g_snd_s7_error_handler_w g_snd_s7_error_handler
-#endif
-
-#define g_snd_print_w g_snd_print
-#define g_little_endian_w g_little_endian
-#define g_snd_global_state_w g_snd_global_state
-#define g_add_source_file_extension_w g_add_source_file_extension
-#if MUS_DEBUGGING
- #define g_snd_sound_pointer_w g_snd_sound_pointer
-#endif
-
-#if (!HAVE_SCHEME)
-#define g_fmod_w g_fmod
-#endif
-#if HAVE_SPECIAL_FUNCTIONS || HAVE_GSL
- #define g_j0_w g_j0
- #define g_j1_w g_j1
- #define g_jn_w g_jn
- #define g_y0_w g_y0
- #define g_y1_w g_y1
- #define g_yn_w g_yn
- #define g_erf_w g_erf
- #define g_erfc_w g_erfc
- #define g_lgamma_w g_lgamma
-#endif
-
-#define g_i0_w g_i0
-
-#if HAVE_GSL
- #define g_i1_w g_i1
- #define g_in_w g_in
- #define g_k0_w g_k0
- #define g_k1_w g_k1
- #define g_kn_w g_kn
- #define g_gsl_ellipk_w g_gsl_ellipk
- #define g_gsl_ellipj_w g_gsl_ellipj
- #define g_gsl_dht_w g_gsl_dht
- #if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
- #define g_gsl_eigenvectors_w g_gsl_eigenvectors
- #endif
- #if HAVE_COMPLEX_TRIG && XEN_HAVE_COMPLEX_NUMBERS
- #define g_gsl_roots_w g_gsl_roots
- #endif
-#endif
-#endif
-
-
-#if HAVE_STATIC_XM
- #if USE_MOTIF
- void Init_libxm(void);
- #else
- void Init_libxg(void);
- #endif
+#if USE_MOTIF
+ void Init_libxm(void);
+#else
+ void Init_libxg(void);
#endif
-
-#if HAVE_GL && (!JUST_GL)
+#if HAVE_GL
void Init_libgl(void);
#endif
@@ -2663,31 +2688,116 @@ static char *legalize_path(const char *in_str)
#if HAVE_GL
-static XEN g_snd_glx_context(void)
+static Xen g_snd_gl_context(void)
{
- return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GLXContext"),
- XEN_WRAP_C_POINTER(ss->cx)));
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_snd_glx_context_w, g_snd_glx_context)
+#if USE_GTK
+ /* return(Xen_list_2(C_string_to_Xen_symbol("GLContext"), Xen_wrap_C_pointer(ss->cx))); */
+#else
+#if USE_MOTIF
+ return(Xen_list_2(C_string_to_Xen_symbol("GLXContext"), Xen_wrap_C_pointer(ss->cx)));
#else
-#define g_snd_glx_context_w g_snd_glx_context
+ return(XEN_FALSE);
+#endif
#endif
+}
+
+Xen_wrap_no_args(g_snd_gl_context_w, g_snd_gl_context)
#endif
/* -------------------------------------------------------------------------------- */
+
+Xen_wrap_1_arg(g_snd_error_w, g_snd_error)
+Xen_wrap_1_arg(g_snd_warning_w, g_snd_warning)
+
void g_xen_initialize(void)
{
- add_source_file_extension(XEN_FILE_EXTENSION);
+#if HAVE_SCHEME
+ s7_pointer pl_dr, pl_dir, pl_ss, pl_b;
+#if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
+ s7_pointer pl_pf;
+#endif
+#endif
+
+#if HAVE_RUBY
+ rb_gc_disable();
+#endif
+
+ Xen_define_procedure(S_snd_error, g_snd_error_w, 1, 0, 0, H_snd_error);
+ Xen_define_procedure(S_snd_warning, g_snd_warning_w, 1, 0, 0, H_snd_warning);
+
+#if HAVE_SCHEME
+ #define H_snd_error_hook S_snd_error_hook " (message): called upon snd_error. \
+If it returns " PROC_TRUE ", Snd flushes the error (it assumes you've reported it via the hook):\n\
+ (hook-push " S_snd_error_hook "\n\
+ (lambda (hook) (" S_play " \"bong.snd\")))"
+
+ #define H_snd_warning_hook S_snd_warning_hook " (message): called upon snd_warning. \
+If it returns " PROC_TRUE ", Snd flushes the warning (it assumes you've reported it via the hook):\n\
+ (define without-warnings\n\
+ (lambda (thunk)\n\
+ (define no-warning (lambda (hook) (set! (hook 'result) #t)))\n\
+ (hook-push snd-warning-hook no-warning) \n\
+ (thunk)\n\
+ (hook-remove snd-warning-hook no-warning)))"
+#endif
+#if HAVE_RUBY
+ #define H_snd_error_hook S_snd_error_hook " (error-message): called upon snd_error. \
+If it returns true, Snd flushes the error (it assumes you've reported it via the hook):\n\
+ $snd_error_hook.add-hook!(\"error\") do |msg|\n\
+ play(\"bong.snd\")\n\
+ false\n\
+ end"
+
+ #define H_snd_warning_hook S_snd_warning_hook " (warning-message): called upon snd_warning. \
+If it returns true, Snd flushes the warning (it assumes you've reported it via the hook)\n\
+ def without_warning(&body)\n\
+ $snd_warning_hook.add_hook!(\"no_warning\") do |msg| true end\n\
+ ret = body.call\n\
+ $snd_warning_hook.remove_hook!(\"no_warning\")\n\
+ ret\n\
+ end\n\
+ # without_warning do " S_snd_warning "(\"not shown\") end"
+#endif
+#if HAVE_FORTH
+ #define H_snd_error_hook S_snd_error_hook " (error-message): called upon snd_error. \
+If it returns " PROC_TRUE ", Snd flushes the error (it assumes you've reported it via the hook):\n\
+" S_snd_error_hook " lambda: <{ msg }>\n\
+ \"bong.snd\" " S_play " drop\n\
+ #f\n\
+; add-hook!"
+
+ #define H_snd_warning_hook S_snd_warning_hook " (warning-message): called upon snd_warning. \
+If it returns " PROC_TRUE ", Snd flushes the warning (it assumes you've reported it via the hook)\n\
+ : no-warning <{ msg -- f }> #t ;\n\
+ : without-warnings <{ xt -- }>\n\
+ " S_snd_warning_hook " <'> no-warning add-hook!\n\
+ xt execute\n\
+ " S_snd_warning_hook " <'> no-warning remove-hook! drop\n\
+ ;\n\
+ \\ lambda: ( -- ) \"not shown\" " S_snd_warning " ; without-warning\n\
+"
+#endif
+
+ ss->snd_error_hook = Xen_define_hook(S_snd_error_hook, "(make-hook 'message)", 1, H_snd_error_hook);
+ ss->snd_warning_hook = Xen_define_hook(S_snd_warning_hook, "(make-hook 'message)", 1, H_snd_warning_hook);
+
+
+ #define H_clip_hook S_clip_hook " (val) is called each time a sample is about to \
+be clipped upon being written to a sound file. The hook function can return the new value to \
+be written, or rely on the default (-1.0 or 1.0 depending on the sign of 'val')."
+
+ clip_hook = Xen_define_hook(S_clip_hook, "(make-hook 'val)", 1, H_clip_hook);
+ mus_clip_set_handler_and_checker(NULL, clip_hook_checker);
+
+ add_source_file_extension(Xen_file_extension);
#if HAVE_SCHEME
add_source_file_extension("cl");
add_source_file_extension("lisp");
add_source_file_extension("init"); /* for slib */
#endif
+
#if HAVE_FORTH
add_source_file_extension("fth");
add_source_file_extension("fsm");
@@ -2695,23 +2805,13 @@ void g_xen_initialize(void)
add_source_file_extension("marks"); /* from save-marks */
default_source_file_extensions = source_file_extensions_end;
- XEN_DEFINE_PROCEDURE("snd-global-state", g_snd_global_state_w, 0, 0, 0, "internal testing function");
- XEN_DEFINE_PROCEDURE(S_add_source_file_extension, g_add_source_file_extension_w, 1, 0, 0, H_add_source_file_extension);
+ Xen_define_procedure("snd-global-state", g_snd_global_state_w, 0, 0, 0, "internal testing function");
+ Xen_define_procedure(S_add_source_file_extension, g_add_source_file_extension_w, 1, 0, 0, H_add_source_file_extension);
- ss->snd_open_file_hook = XEN_DEFINE_SIMPLE_HOOK(1);
- ss->snd_selection_hook = XEN_DEFINE_SIMPLE_HOOK(1);
+ ss->snd_open_file_hook = Xen_define_simple_hook("(make-hook 'reason)", 1);
+ Xen_GC_protect(ss->snd_open_file_hook);
- XEN_PROTECT_FROM_GC(ss->snd_open_file_hook);
- XEN_PROTECT_FROM_GC(ss->snd_selection_hook);
-
- ss->effects_hook = XEN_DEFINE_HOOK(S_effects_hook, 0, "called when something changes that the effects dialogs care about");
-
-#if MUS_DEBUGGING
- XEN_DEFINE_PROCEDURE("snd-sound-pointer", g_snd_sound_pointer_w, 1, 0, 0, "internal testing function");
-#endif
-#if MUS_DEBUGGING && HAVE_SCHEME
- XEN_DEFINE_PROCEDURE("_test_load_", g_test_load_w, 1, 0, 0, "internal testing function");
-#endif
+ ss->effects_hook = Xen_define_hook(S_effects_hook, "(make-hook)", 0, "called when something changes that the effects dialogs care about");
Init_sndlib();
@@ -2720,111 +2820,83 @@ void g_xen_initialize(void)
#endif
#if (!HAVE_SCHEME)
- gc_protection = XEN_FALSE;
+ gc_protection = Xen_false;
#endif
- XEN_DEFINE_PROCEDURE(S_snd_print, g_snd_print_w, 1, 0, 0, H_snd_print);
- XEN_DEFINE_PROCEDURE("little-endian?", g_little_endian_w, 0, 0, 0, "return " PROC_TRUE " if host is little endian");
+#if HAVE_SCHEME
+ {
+ s7_pointer s, i, b, r, d;
+ s = s7_make_symbol(s7, "string?");
+ i = s7_make_symbol(s7, "integer?");
+ b = s7_make_symbol(s7, "boolean?");
+ r = s7_make_symbol(s7, "real?");
+ d = s7_make_symbol(s7, "float?");
+ pl_ss = s7_make_signature(s7, 2, s, s);
+ pl_dr = s7_make_circular_signature(s7, 1, 2, d, r);
+ pl_dir = s7_make_signature(s7, 3, d, i, r);
+ pl_b = s7_make_signature(s7, 1, b);
+#if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
+ pl_pf = s7_make_signature(s7, 2, s7_make_symbol(s7, "pair?"), s7_make_symbol(s7, "float-vector?"));
+#endif
+ }
+#endif
+ Xen_define_typed_procedure(S_snd_print, g_snd_print_w, 1, 0, 0, H_snd_print, pl_ss);
+ Xen_define_typed_procedure("little-endian?", g_little_endian_w, 0, 0, 0, "return " PROC_TRUE " if host is little endian", pl_b);
#if HAVE_SCHEME
- XEN_EVAL_C_STRING("(define fmod modulo)");
+ Xen_eval_C_string("(define fmod modulo)");
#else
- XEN_DEFINE_PROCEDURE("fmod", g_fmod_w, 2, 0, 0, "C's fmod");
+ Xen_define_procedure("fmod", g_fmod_w, 2, 0, 0, "C's fmod");
#endif
#if HAVE_SPECIAL_FUNCTIONS || HAVE_GSL
- XEN_DEFINE_PROCEDURE(S_bes_j0, g_j0_w, 1, 0, 0, H_j0);
- XEN_DEFINE_PROCEDURE(S_bes_j1, g_j1_w, 1, 0, 0, H_j1);
- XEN_DEFINE_PROCEDURE(S_bes_jn, g_jn_w, 2, 0, 0, H_jn);
- XEN_DEFINE_PROCEDURE(S_bes_y0, g_y0_w, 1, 0, 0, H_y0);
- XEN_DEFINE_PROCEDURE(S_bes_y1, g_y1_w, 1, 0, 0, H_y1);
- XEN_DEFINE_PROCEDURE(S_bes_yn, g_yn_w, 2, 0, 0, H_yn);
- XEN_DEFINE_PROCEDURE("erf", g_erf_w, 1, 0, 0, H_erf);
- XEN_DEFINE_PROCEDURE("erfc", g_erfc_w, 1, 0, 0, H_erfc);
- XEN_DEFINE_PROCEDURE("lgamma", g_lgamma_w, 1, 0, 0, H_lgamma);
+ Xen_define_typed_procedure(S_bes_j0, g_j0_w, 1, 0, 0, H_j0, pl_dr);
+ Xen_define_typed_procedure(S_bes_j1, g_j1_w, 1, 0, 0, H_j1, pl_dr);
+ Xen_define_typed_procedure(S_bes_jn, g_jn_w, 2, 0, 0, H_jn, pl_dir);
+ Xen_define_typed_procedure(S_bes_y0, g_y0_w, 1, 0, 0, H_y0, pl_dr);
+ Xen_define_typed_procedure(S_bes_y1, g_y1_w, 1, 0, 0, H_y1, pl_dr);
+ Xen_define_typed_procedure(S_bes_yn, g_yn_w, 2, 0, 0, H_yn, pl_dir);
+ Xen_define_typed_procedure("erf", g_erf_w, 1, 0, 0, H_erf, pl_dr);
+ Xen_define_typed_procedure("erfc", g_erfc_w, 1, 0, 0, H_erfc, pl_dr);
+ Xen_define_typed_procedure("lgamma", g_lgamma_w, 1, 0, 0, H_lgamma, pl_dr);
#endif
- XEN_DEFINE_PROCEDURE(S_bes_i0, g_i0_w, 1, 0, 0, H_i0);
+ Xen_define_safe_procedure(S_bes_i0, g_i0_w, 1, 0, 0, H_i0);
#if HAVE_GSL
- XEN_DEFINE_PROCEDURE(S_bes_i1, g_i1_w, 1, 0, 0, H_i1);
- XEN_DEFINE_PROCEDURE(S_bes_in, g_in_w, 2, 0, 0, H_in);
- XEN_DEFINE_PROCEDURE(S_bes_k0, g_k0_w, 1, 0, 0, H_k0);
- XEN_DEFINE_PROCEDURE(S_bes_k1, g_k1_w, 1, 0, 0, H_k1);
- XEN_DEFINE_PROCEDURE(S_bes_kn, g_kn_w, 2, 0, 0, H_kn);
-
- XEN_DEFINE_PROCEDURE("gsl-ellipk", g_gsl_ellipk_w, 1, 0, 0, H_gsl_ellipk);
- XEN_DEFINE_PROCEDURE("gsl-ellipj", g_gsl_ellipj_w, 2, 0, 0, H_gsl_ellipj);
- XEN_DEFINE_PROCEDURE("gsl-dht", g_gsl_dht_w, 4, 0, 0, H_gsl_dht);
-#if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
- XEN_DEFINE_PROCEDURE("gsl-eigenvectors", g_gsl_eigenvectors_w, 1, 0, 0, "returns eigenvalues and eigenvectors");
-#endif
+ Xen_define_typed_procedure(S_bes_i1, g_i1_w, 1, 0, 0, H_i1, pl_dr);
+ Xen_define_typed_procedure(S_bes_in, g_in_w, 2, 0, 0, H_in, pl_dir);
+ Xen_define_typed_procedure(S_bes_k0, g_k0_w, 1, 0, 0, H_k0, pl_dr);
+ Xen_define_typed_procedure(S_bes_k1, g_k1_w, 1, 0, 0, H_k1, pl_dr);
+ Xen_define_typed_procedure(S_bes_kn, g_kn_w, 2, 0, 0, H_kn, pl_dir);
-#if MUS_DEBUGGING && HAVE_SCHEME
- XEN_DEFINE_PROCEDURE("gsl-gegenbauer", g_gsl_gegenbauer_w, 3, 0, 0, "internal test func");
-#endif
+ Xen_define_typed_procedure("gsl-ellipk", g_gsl_ellipk_w, 1, 0, 0, H_gsl_ellipk, pl_dr);
+ Xen_define_typed_procedure("gsl-ellipj", g_gsl_ellipj_w, 2, 0, 0, H_gsl_ellipj, pl_dr);
-#if HAVE_COMPLEX_TRIG && XEN_HAVE_COMPLEX_NUMBERS
- XEN_DEFINE_PROCEDURE("gsl-roots", g_gsl_roots_w, 1, 0, 0, H_gsl_roots);
+#if HAVE_GSL_EIGEN_NONSYMMV_WORKSPACE
+ Xen_define_typed_procedure("gsl-eigenvectors", g_gsl_eigenvectors_w, 1, 0, 0, "returns eigenvalues and eigenvectors", pl_pf);
#endif
+#if HAVE_COMPLEX_TRIG && HAVE_COMPLEX_NUMBERS
+ Xen_define_typed_procedure("gsl-roots", g_gsl_roots_w, 1, 0, 0, H_gsl_roots, NULL);
+#endif
#endif
#if HAVE_SCHEME && WITH_GMP
s7_define_function(s7, "bignum-fft", bignum_fft, 3, 1, false, H_bignum_fft);
#endif
-#if HAVE_SCHEME
- s7_define_function(s7, "char-position", g_char_position, 2, 1, false, H_char_position);
- s7_define_function(s7, "string-position", g_string_position, 2, 1, false, H_string_position);
- s7_define_function(s7, "string-ci-position", g_string_ci_position, 2, 1, false, H_string_ci_position);
- s7_define_function(s7, "string-vector-position", g_string_vector_position, 2, 1, false, H_string_vector_position);
- s7_define_function(s7, "string-list-position", g_string_list_position, 2, 1, false, H_string_list_position);
- s7_define_function(s7, "string-ci-list-position", g_string_ci_list_position, 2, 1, false, H_string_ci_list_position);
-
- #define H_print_hook S_print_hook " (text): called each time some Snd-generated response (text) is about to be appended to the listener. \
-If it returns some non-" PROC_FALSE " result, Snd assumes you've sent the text out yourself, as well as any needed prompt. \n\
- (add-hook! " S_print_hook "\n\
- (lambda (msg) \n\
- (" S_snd_print "\n\
- (format #f \"~A~%[~A]~%~A\" \n\
- msg \n\
- (strftime \"%d-%b %H:%M %Z\" \n\
- (localtime (current-time))) \n\
- (" S_listener_prompt ")))))"
-#endif
-
-#if HAVE_RUBY
- #define H_print_hook S_print_hook " (text): called each time some Snd-generated response (text) is about to be appended to the listener. \
-If it returns some non-false result, Snd assumes you've sent the text out yourself, as well as any needed prompt. \n\
- $print_hook.add-hook!(\"localtime\") do |msg|\n\
- $stdout.print msg\n\
- false\n\
- end"
-#endif
-
-#if HAVE_FORTH
- #define H_print_hook S_print_hook " (text): called each time some Snd-generated response (text) is about to be appended to the listener. \
-If it returns some non-#f result, Snd assumes you've sent the text out yourself, as well as any needed prompt. \n\
-" S_print_hook " lambda: <{ msg }>\n\
- \"%s\n[%s]\n%s\" '( msg date " S_listener_prompt " ) format " S_snd_print "\n\
-; add-hook!"
-#endif
-
- print_hook = XEN_DEFINE_HOOK(S_print_hook, 1, H_print_hook); /* arg = text */
-
g_init_base();
g_init_utils();
g_init_marks();
g_init_regions();
g_init_selection();
g_init_mix();
+ g_init_fft(); /* needs to precede snd-chn init */
g_init_chn();
g_init_kbd();
g_init_sig();
g_init_print();
- g_init_errors();
- g_init_fft();
g_init_edits();
g_init_listener();
g_init_help();
@@ -2846,111 +2918,97 @@ If it returns some non-#f result, Snd assumes you've sent the text out yourself,
g_init_gxlistener();
g_init_gxchn();
g_init_draw();
- g_init_gxdrop();
g_init_gxregion();
g_init_gxsnd();
g_init_gxfind();
#endif
-#if (!WITH_SHARED_SNDLIB)
- mus_init_run(); /* this needs to be called after Snd's run-optimizable functions are defined (sampler_p for example) */
-#endif
+#if HAVE_SCHEME && (!_MSC_VER)
+ Xen_define_procedure("dlopen", g_dlopen_w, 1, 1 ,0, H_dlopen);
+ Xen_define_procedure("dlclose", g_dlclose_w, 1, 0 ,0, H_dlclose);
+ Xen_define_procedure("dlerror", g_dlerror_w, 0, 0 ,0, H_dlerror);
+ Xen_define_procedure("dlinit", g_dlinit_w, 2, 0 ,0, H_dlinit);
+ Xen_define_procedure("dlsym", g_dlsym_w, 2, 0 ,0, H_dlsym);
-#if HAVE_SCHEME && HAVE_DLFCN_H
- XEN_DEFINE_PROCEDURE("dlopen", g_dlopen_w, 1, 0 ,0, H_dlopen);
- XEN_DEFINE_PROCEDURE("dlclose", g_dlclose_w, 1, 0 ,0, H_dlclose);
- XEN_DEFINE_PROCEDURE("dlerror", g_dlerror_w, 0, 0 ,0, H_dlerror);
- XEN_DEFINE_PROCEDURE("dlinit", g_dlinit_w, 2, 0 ,0, H_dlinit);
+ Xen_define_constant("RTLD_LAZY", RTLD_LAZY, "dlopen flag");
+ Xen_define_constant("RTLD_NOW", RTLD_NOW, "dlopen flag");
+ Xen_define_constant("RTLD_GLOBAL", RTLD_GLOBAL, "dlopen flag");
#endif
-#if HAVE_LADSPA && HAVE_EXTENSION_LANGUAGE && HAVE_DLFCN_H && HAVE_DIRENT_H
+#if HAVE_LADSPA && HAVE_EXTENSION_LANGUAGE
g_ladspa_to_snd();
#endif
#ifdef SCRIPTS_DIR
- XEN_ADD_TO_LOAD_PATH((char *)SCRIPTS_DIR);
+ Xen_add_to_load_path((char *)SCRIPTS_DIR);
#endif
{
char *pwd, *legal_pwd;
pwd = mus_getcwd();
legal_pwd = legalize_path(pwd);
- XEN_ADD_TO_LOAD_PATH(legal_pwd);
- free(pwd);
+ Xen_add_to_load_path(legal_pwd);
free(legal_pwd);
}
#if HAVE_SCHEME
- XEN_DEFINE_PROCEDURE("_snd_s7_error_handler_", g_snd_s7_error_handler_w, 0, 0, 1, "internal error redirection for snd/s7");
+ Xen_define_procedure("_snd_s7_error_handler_", g_snd_s7_error_handler_w, 0, 0, 1, "internal error redirection for snd/s7");
+ s7_define_safe_function(s7, "_snd-line-reader_", g_line_reader, 1, 0, false, "port-line-number reader");
- XEN_EVAL_C_STRING("(define redo-edit redo)"); /* consistency with Ruby */
- XEN_EVAL_C_STRING("(define undo-edit undo)");
+ Xen_eval_C_string("(define redo-edit redo)"); /* consistency with Ruby */
+ Xen_eval_C_string("(define undo-edit undo)");
- XEN_EVAL_C_STRING("(define (procedure-name proc) (if (procedure? proc) (format #f \"~A\" proc) #f))");
+ /* Xen_eval_C_string("(define (procedure-name proc) (if (procedure? proc) (format #f \"~A\" proc) #f))"); */
/* needed in snd-test.scm and hooks.scm */
- XEN_EVAL_C_STRING("\
- (define* (apropos name port)\
- (define (substring? subs s)\
- (let* ((start 0)\
- (ls (string-length s))\
- (lu (string-length subs))\
- (limit (- ls lu)))\
- (let loop ((i start))\
- (cond ((> i limit) #f)\
- ((do ((j i (+ j 1))\
- (k 0 (+ k 1)))\
- ((or (= k lu)\
- (not (char=? (string-ref subs k) (string-ref s j))))\
- (= k lu))) i)\
- (else (loop (+ i 1)))))))\
- (define (apropos-1 alist)\
- (for-each\
- (lambda (binding)\
- (if (substring? name (symbol->string (car binding)))\
- (let ((str (format #f \"~%~A: ~A\" \
- (car binding) \
- (if (procedure? (cdr binding))\
- (procedure-documentation (cdr binding))\
- (cdr binding)))))\
- (if (not port)\
- (snd-print str)\
- (display str port)))))\
- alist))\
- (if (or (not (string? name))\
- (= (length name) 0))\
- (error 'wrong-type-arg \"apropos argument should be a non-nil string\")\
- (for-each\
- (lambda (frame)\
- (if (vector? frame)\
- (let ((len (vector-length frame)))\
- (do ((i 0 (+ i 1)))\
- ((= i len))\
- (apropos-1 (vector-ref frame i))))\
- (apropos-1 frame)))\
- (current-environment))))");
-
- XEN_EVAL_C_STRING("\
+ Xen_eval_C_string("\
+ (define* (apropos name (port #f) (e (rootlet))) \
+ \"(apropos name (port *stdout*) (env (rootlet))) looks for 'name' as a part of any symbol name, and sends matches to 'port'\" \
+ (let ((ap-name (if (string? name) \
+ name \
+ (if (symbol? name) \
+ (symbol->string name) \
+ (error 'wrong-type-arg \"apropos argument 1 should be a string or a symbol\")))) \
+ (ap-env (if (let? e) \
+ e \
+ (error 'wrong-type-arg \"apropos argument 3 should be an environment\"))) \
+ (ap-port (if (or (not port) (output-port? port)) \
+ port \
+ (error 'wrong-type-arg \"apropos argument 2 should be an output port\")))) \
+ (for-each \
+ (lambda (binding) \
+ (if (and (pair? binding) \
+ (string-position ap-name (symbol->string (car binding)))) \
+ (snd-print \
+ (format ap-port \"~%~A: ~A\" \
+ (car binding) \
+ (if (procedure? (cdr binding)) \
+ (procedure-documentation (cdr binding)) \
+ (cdr binding)))))) \
+ ap-env) \
+ #f))");
+
+ Xen_eval_C_string("\
(define break-ok #f)\
(define break-exit #f) ; a kludge to get 2 funcs to share a local variable\n\
(define break-enter #f)\
\
(let ((saved-listener-prompt (listener-prompt)))\
(set! break-exit (lambda ()\
- (reset-hook! read-hook)\
+ (hook-clear read-hook)\
(set! (listener-prompt) saved-listener-prompt)\
#f))\
(set! break-enter (lambda ()\
(set! saved-listener-prompt (listener-prompt)))))\
\
(define-macro (break)\
- `(let ((__break__ (current-environment)))\
+ `(let ((__break__ (curlet)))\
(break-enter)\
(set! (listener-prompt) (format #f \"~A>\" (if (defined? __func__) __func__ 'break)))\
(call/cc\
(lambda (return)\
(set! break-ok return) ; save current program loc so (break-ok) continues from the break\n\
- (add-hook! read-hook ; anything typed in the listener is evaluated in the environment of the break call\n\
+ (hook-push read-hook ; anything typed in the listener is evaluated in the environment of the break call\n\
(lambda (str)\
(eval-string str __break__)))\
(error 'snd-top-level))) ; jump back to the top level\n\
@@ -2959,147 +3017,145 @@ If it returns some non-#f result, Snd assumes you've sent the text out yourself,
#endif
-#if HAVE_SCHEME && USE_GTK && (!HAVE_GTK_ADJUSTMENT_GET_UPPER)
- /* Gtk 3 is removing direct struct accesses (which they should have done years ago), so we need compatibility functions: */
- XEN_EVAL_C_STRING("(define (gtk_widget_get_window w) (.window w))");
- XEN_EVAL_C_STRING("(define (gtk_font_selection_dialog_get_ok_button w) (.ok_button w))");
- XEN_EVAL_C_STRING("(define (gtk_font_selection_dialog_get_apply_button w) (.apply_button w))");
- XEN_EVAL_C_STRING("(define (gtk_font_selection_dialog_get_cancel_button w) (.cancel_button w))");
- XEN_EVAL_C_STRING("(define (gtk_color_selection_dialog_get_color_selection w) (.colorsel w))");
- XEN_EVAL_C_STRING("(define (gtk_dialog_get_action_area w) (.action_area w))");
- XEN_EVAL_C_STRING("(define (gtk_dialog_get_content_area w) (.vbox w))");
- /* also gtk_adjustment fields, but I think they are not in use in Snd's gtk code */
-#endif
-
#if HAVE_FORTH
- XEN_EVAL_C_STRING("<'> redo alias redo-edit"); /* consistency with Ruby */
- XEN_EVAL_C_STRING("<'> undo alias undo-edit");
- XEN_EVAL_C_STRING(": clm-print ( fmt :optional args -- ) fth-format snd-print drop ;");
+ Xen_eval_C_string("<'> redo alias redo-edit"); /* consistency with Ruby */
+ Xen_eval_C_string("<'> undo alias undo-edit");
+ Xen_eval_C_string(": clm-print ( fmt :optional args -- ) fth-format snd-print drop ;");
#endif
#if HAVE_RUBY
- XEN_EVAL_C_STRING("def clm_print(str, *args)\n\
+ Xen_eval_C_string("def clm_print(str, *args)\n\
snd_print format(str, *args)\n\
end");
#endif
-#if HAVE_SCHEME
- XEN_EVAL_C_STRING("(define (clm-print . args) \"(clm-print . args) applies format to args and prints the result via snd-print\" \
- (snd-print (apply format #f args)))");
-#endif
-
#if HAVE_GL
- XEN_DEFINE_PROCEDURE("snd-glx-context", g_snd_glx_context_w, 0, 0, 0, "OpenGL GLXContext");
+ Xen_define_procedure("snd-gl-context", g_snd_gl_context_w, 0, 0, 0, "GL Context");
#endif
-#if HAVE_STATIC_XM
- #if USE_MOTIF
+#if USE_MOTIF
+#if HAVE_SCHEME
+ {
+ s7_pointer motif, old_shadow;
+ s7_define_constant(s7, "*motif*", motif = s7_inlet(s7, s7_nil(s7)));
+ old_shadow = s7_shadow_rootlet(s7);
+ s7_set_shadow_rootlet(s7, motif);
Init_libxm();
- #if HAVE_FORTH
- fth_add_loaded_files("libxm.so");
- #endif
- #else
+ s7_set_shadow_rootlet(s7, old_shadow);
+ }
+#else
+ Init_libxm();
+#endif
+ #if HAVE_FORTH
+ fth_add_loaded_files("libxm.so");
+ #endif
+#endif
+
+#if USE_GTK
+#if HAVE_SCHEME
+ {
+ s7_pointer gtk, old_shadow;
+ s7_define_constant(s7, "*gtk*", gtk = s7_inlet(s7, s7_nil(s7)));
+ old_shadow = s7_shadow_rootlet(s7);
+ s7_set_shadow_rootlet(s7, gtk);
Init_libxg();
- #if HAVE_FORTH
- fth_add_loaded_files("libxg.so");
- #endif
+ s7_set_shadow_rootlet(s7, old_shadow);
+ }
+#else
+ Init_libxg();
+#endif
+ #if HAVE_FORTH
+ fth_add_loaded_files("libxg.so");
#endif
#endif
-#if (HAVE_GL) && (!JUST_GL)
+#if HAVE_GL
+#if HAVE_SCHEME
+ {
+ s7_pointer gl, old_shadow;
+ s7_define_constant(s7, "*gl*", gl = s7_inlet(s7, s7_nil(s7)));
+ old_shadow = s7_shadow_rootlet(s7);
+ s7_set_shadow_rootlet(s7, gl);
+ Init_libgl();
+ s7_set_shadow_rootlet(s7, old_shadow);
+ }
+#else
Init_libgl();
#endif
-
-#if MUS_DEBUGGING
- XEN_YES_WE_HAVE("snd-debug");
#endif
#if HAVE_ALSA
- XEN_YES_WE_HAVE("alsa");
+ Xen_provide_feature("alsa");
#endif
#if HAVE_OSS
- XEN_YES_WE_HAVE("oss");
-#endif
-
-#if MUS_ESD
- XEN_YES_WE_HAVE("esd");
+ Xen_provide_feature("oss");
#endif
#if MUS_PULSEAUDIO
- XEN_YES_WE_HAVE("pulse-audio");
+ Xen_provide_feature("pulse-audio");
#endif
#if MUS_JACK
- XEN_YES_WE_HAVE("jack");
+ Xen_provide_feature("jack");
#endif
#if HAVE_GSL
- XEN_YES_WE_HAVE("gsl");
-#endif
-
-#if HAVE_PTHREADS
- XEN_YES_WE_HAVE("snd-threads");
+ Xen_provide_feature("gsl");
#endif
#if USE_MOTIF
- XEN_YES_WE_HAVE("snd-motif");
+ Xen_provide_feature("snd-motif");
#endif
#if USE_GTK
- XEN_YES_WE_HAVE("snd-gtk");
-#if HAVE_GTK_3
- XEN_YES_WE_HAVE("gtk3");
+ Xen_provide_feature("snd-gtk");
+#if GTK_CHECK_VERSION(3, 0, 0)
+ Xen_provide_feature("gtk3");
#else
- XEN_YES_WE_HAVE("gtk2");
+ Xen_provide_feature("gtk2");
#endif
#endif
#if USE_NO_GUI
- XEN_YES_WE_HAVE("snd-nogui");
+ Xen_provide_feature("snd-nogui");
#endif
#if HAVE_FORTH
- XEN_YES_WE_HAVE("snd-forth");
+ Xen_provide_feature("snd-forth");
#endif
#if HAVE_SCHEME
- XEN_YES_WE_HAVE("snd-s7");
+ Xen_provide_feature("snd-s7");
+#endif
+
+#if WITH_AUDIO
+ Xen_provide_feature("audio");
#endif
#if HAVE_RUBY
- XEN_YES_WE_HAVE("snd-ruby");
+ Xen_provide_feature("snd-ruby");
/* we need to set up the search path so that load and require will work as in the program irb */
- #ifdef RUBY_SEARCH_PATH
- {
- /* this code stolen from ruby.c */
- char *str, *buf;
- int i, j = 0, len;
- str = (char *)(RUBY_SEARCH_PATH);
- len = mus_strlen(str);
- buf = (char *)calloc(len + 1, sizeof(char));
- for (i = 0; i < len; i++)
- if (str[i] == ':')
- {
- buf[j] = 0;
- if (j > 0)
- {
- XEN_ADD_TO_LOAD_PATH(buf);
- }
- j = 0;
- }
- else buf[j++] = str[i];
- if (j > 0)
- {
- buf[j] = 0;
- XEN_ADD_TO_LOAD_PATH(buf);
- }
- free(buf);
- }
- #endif
+ {
+ Xen paths;
+ int i, len;
+ paths = rb_gv_get("$:");
+ /* this is printed as
+ * ["/home/bil/ruby-snd", "/usr/local/share/snd", "/usr/local/lib/ruby/site_ruby/2.0.0", ...]
+ */
+ len = Xen_vector_length(paths);
+ for (i = 0; i < len; i++)
+ Xen_add_to_load_path(Xen_string_to_C_string(Xen_vector_ref(paths, i)));
+ }
+#endif
+
+ Xen_provide_feature("snd");
+ Xen_provide_feature("snd" SND_MAJOR_VERSION);
+ Xen_provide_feature("snd-" SND_MAJOR_VERSION "." SND_MINOR_VERSION);
+
+#if HAVE_RUBY
+ rb_gc_enable();
#endif
- XEN_YES_WE_HAVE("snd");
- XEN_YES_WE_HAVE("snd" SND_MAJOR_VERSION);
- XEN_YES_WE_HAVE("snd-" SND_MAJOR_VERSION "." SND_MINOR_VERSION);
}
+
diff --git a/snd-xenv.c b/snd-xenv.c
deleted file mode 100644
index 30d6275..0000000
--- a/snd-xenv.c
+++ /dev/null
@@ -1,1732 +0,0 @@
-#include "snd.h"
-
-/* envelope editor and viewer */
-
-
-static Widget enved_dialog = NULL;
-static Widget applyB, apply2B, cancelB, drawer, showB, saveB, revertB, undoB, redoB;
-static Widget printB, brkptL, graphB, fltB, ampB, srcB, clipB;
-static Widget nameL, textL, screnvlst, dBB, orderL, deleteB, resetB, firB = NULL;
-static Widget expB, linB, baseScale, baseValue, selectionB;
-static GC gc, rgc, ggc;
-
-static const char *env_names[3] = {"amp env:", "flt env:", "src env:"};
-
-static bool showing_all_envs = false; /* edit one env (0), or view all currently defined envs (1) */
-static bool apply_to_selection = false, we_turned_selection_off = false;
-
-static int env_window_width = 0;
-static int env_window_height = 0;
-
-static chan_info *active_channel = NULL, *last_active_channel = NULL;
-
-static env* selected_env = NULL; /* if during view, one env is clicked, it is "selected" and can be pasted elsewhere */
-static env* active_env = NULL; /* env currently being edited */
-
-static axis_info *axis = NULL;
-static axis_info *gray_ap = NULL;
-static bool FIR_p = true;
-static bool old_clip_p = false;
-static bool ignore_button_release = false;
-static bool cancelling = true;
-
-
-static void fixup_graphics_context(graphics_context *ax, Widget w, GC gc)
-{
- ax->dp = XtDisplay(w);
- ax->wn = XtWindow(w);
- if (gc) ax->gc = gc;
-}
-
-
-axis_info *enved_make_axis(const char *name, graphics_context *ax,
- int ex0, int ey0, int width, int height,
- mus_float_t xmin, mus_float_t xmax, mus_float_t ymin, mus_float_t ymax,
- printing_t printing)
-{
- /* conjure up minimal context for axis drawer in snd-axis.c */
- if (!axis)
- {
- axis = (axis_info *)calloc(1, sizeof(axis_info));
- axis->ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- fixup_graphics_context(axis->ax, drawer, ax->gc);
- }
- if (!gray_ap)
- {
- gray_ap = (axis_info *)calloc(1, sizeof(axis_info));
- gray_ap->ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- gray_ap->graph_active = true;
- fixup_graphics_context(gray_ap->ax, drawer, ggc);
- }
- init_env_axes(axis, name, ex0, ey0, width, height, xmin, xmax, ymin, ymax, printing);
- return(axis);
-}
-
-
-static void display_env(env *e, const char *name, GC cur_gc, int x0, int y0, int width, int height, bool dots, printing_t printing)
-{
- graphics_context *ax = NULL;
- ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- ax->wn = XtWindow(drawer);
- if (!(ax->wn)) return;
- ax->dp = XtDisplay(drawer);
- ax->gc = cur_gc;
- ss->enved->with_dots = dots;
- env_editor_display_env(ss->enved, e, ax, name, x0, y0, width, height, printing);
- free(ax);
-}
-
-
-void display_enved_env_with_selection(env *e, const char *name, int x0, int y0, int width, int height, bool dots, printing_t printing)
-{
- display_env(e, name, (selected_env == e) ? rgc : gc, x0, y0, width, height, dots, printing);
-}
-
-
-static void reflect_segment_state(void)
-{
- if (enved_dialog)
- {
- XmChangeColor(expB, (enved_style(ss) == ENVELOPE_EXPONENTIAL) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
- XmChangeColor(linB, (enved_style(ss) == ENVELOPE_LINEAR) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
- if ((active_env) && (!(showing_all_envs))) env_redisplay();
- }
-}
-
-
-static void prepare_env_edit(env *new_env)
-{
- prepare_enved_edit(new_env);
- if (new_env->base == 1.0)
- set_enved_style(ENVELOPE_LINEAR);
- else
- {
- set_enved_base(new_env->base);
- set_enved_style(ENVELOPE_EXPONENTIAL);
- }
- reflect_segment_state();
-}
-
-
-void set_enved_redo_sensitive(bool val) {set_sensitive(redoB, val);}
-void set_enved_revert_sensitive(bool val) {set_sensitive(revertB, val);}
-void set_enved_undo_sensitive(bool val) {set_sensitive(undoB, val);}
-void set_enved_save_sensitive(bool val) {set_sensitive(saveB, val);}
-void set_enved_show_sensitive(bool val) {set_sensitive(showB, val);}
-
-
-static bool use_listener_font = false;
-
-void make_scrolled_env_list(void)
-{
- XmString *strs;
- int n, size;
- size = enved_all_envs_top();
- XtVaSetValues(screnvlst, XmNbackground, ss->highlight_color, NULL);
- strs = (XmString *)calloc(size, sizeof(XmString));
- for (n = 0; n < size; n++)
- strs[n] = XmStringCreate(enved_all_names(n), (char *)((use_listener_font) ? "listener_font" : XmFONTLIST_DEFAULT_TAG));
- XtVaSetValues(screnvlst,
- XmNitems, strs,
- XmNitemCount, size,
- NULL);
- for (n = 0; n < size; n++)
- XmStringFree(strs[n]);
- free(strs);
-}
-
-
-void enved_reflect_peak_env_completion(snd_info *sp)
-{
- if ((enved_dialog) && (active_channel) && (enved_wave_p(ss)))
- if (active_channel->sound == sp)
- env_redisplay();
-}
-
-
-void new_active_channel_alert(void)
-{
- if (enved_dialog)
- {
- /* if showing current active channel in gray, update */
- active_channel = current_channel();
- env_redisplay();
- }
-}
-
-
-static void dismiss_enved_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (!cancelling)
- {
- if (ss->checking_explicitly)
- ss->stopped_explicitly = true;
- }
- else XtUnmanageChild(enved_dialog);
-}
-
-
-static void help_enved_callback(Widget w, XtPointer context, XtPointer info)
-{
- envelope_editor_dialog_help();
-}
-
-
-static bool within_selection_src = false;
-
-static void apply_enved(void)
-{
- char *origin = NULL, *estr = NULL;
- if (active_env)
- {
- int i, j;
- env *max_env = NULL;
- active_channel = current_channel();
- if (active_channel)
- {
- set_sensitive(applyB, false);
- set_sensitive(apply2B, false);
- set_button_label(cancelB, "Stop");
- cancelling = false;
- check_for_event();
- switch (enved_target(ss))
- {
- case ENVED_AMPLITUDE:
-#if HAVE_FORTH
- origin = mus_format("%s%s %s drop",
- estr = env_to_string(active_env),
- (apply_to_selection) ? "" : " 0 " PROC_FALSE,
- (apply_to_selection) ? S_env_selection : S_env_channel);
-#else
- origin = mus_format("%s" PROC_OPEN "%s%s",
- TO_PROC_NAME((apply_to_selection) ? S_env_selection : S_env_channel),
- estr = env_to_string(active_env),
- (apply_to_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
-#endif
- apply_env(active_channel, active_env, 0,
- CURRENT_SAMPLES(active_channel),
- apply_to_selection,
- origin, NULL,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
- /* calls update_graph, I think, but in short files that doesn't update the amp-env */
- if (estr) free(estr);
- if (origin) free(origin);
- break;
- case ENVED_SPECTRUM:
-#if HAVE_FORTH
- origin = mus_format("%s %d%s %s drop",
- estr = env_to_string(active_env),
- enved_filter_order(ss),
- (apply_to_selection) ? "" : " 0 " PROC_FALSE,
- (apply_to_selection) ? S_filter_selection : S_filter_channel);
-#else
- origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d%s",
- TO_PROC_NAME((apply_to_selection) ? S_filter_selection : S_filter_channel),
- estr = env_to_string(active_env),
- enved_filter_order(ss),
- (apply_to_selection) ? "" : PROC_SEP "0" PROC_SEP PROC_FALSE);
-#endif
- apply_filter(active_channel,
- (FIR_p) ? enved_filter_order(ss) : 0,
- active_env,
- origin, NULL, apply_to_selection,
- NULL, NULL,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0, false);
- if (estr) free(estr);
- if (origin) free(origin);
- break;
- case ENVED_SRATE:
- /* mus_src no longer protects against 0 srate */
- max_env = copy_env(active_env);
- for (i = 0, j = 1; i < max_env->pts; i++, j += 2)
- if (max_env->data[j] < .01)
- max_env->data[j] = .01;
- within_selection_src = true;
- src_env_or_num(active_channel, max_env, 0.0,
- false, "Enved: src",
- apply_to_selection, NULL,
- C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
- within_selection_src = false;
- max_env = free_env(max_env);
- break;
- }
- if (enved_wave_p(ss)) env_redisplay();
- set_sensitive(applyB, true);
- set_sensitive(apply2B, true);
- set_button_label(cancelB, "Go Away");
- cancelling = true;
- }
- }
-}
-
-
-static void env_redisplay_1(printing_t printing)
-{
- if (enved_dialog_is_active())
- {
- XClearWindow(XtDisplay(drawer), XtWindow(drawer));
- if (showing_all_envs)
- view_envs(env_window_width, env_window_height, printing);
- else
- {
- char *name = NULL;
- name = XmTextGetString(textL);
- if (!name) name = mus_strdup("noname");
- /* active_env can be null here if just showing axes (empty initial graph) */
-
- if ((enved_wave_p(ss)) &&
- (active_channel) &&
- (!(active_channel->squelch_update)))
- {
- if ((enved_target(ss) == ENVED_SPECTRUM) && (active_env) && (FIR_p) && (printing == NOT_PRINTING))
- display_frequency_response(active_env, axis, gray_ap->ax, enved_filter_order(ss), enved_in_dB(ss));
- enved_show_background_waveform(axis, gray_ap, apply_to_selection, (enved_target(ss) == ENVED_SPECTRUM), printing);
- }
-
- display_env(active_env, name, gc, 0, 0, env_window_width, env_window_height, true, printing);
- if (name) XtFree(name);
- }
- }
-}
-
-
-void env_redisplay(void)
-{
- env_redisplay_1(NOT_PRINTING);
-}
-
-void env_redisplay_with_print(void)
-{
- env_redisplay_1(PRINTING);
-}
-
-
-void update_enved_background_waveform(chan_info *cp)
-{
- if ((enved_dialog_is_active()) &&
- (enved_wave_p(ss)) &&
- (enved_target(ss) == ENVED_AMPLITUDE) &&
- (cp == active_channel) &&
- ((!apply_to_selection) || (selection_is_active_in_channel(cp))))
- env_redisplay();
-}
-
-
-static void enved_reset(void)
-{
- set_enved_clip_p(DEFAULT_ENVED_CLIP_P);
- set_enved_style(ENVELOPE_LINEAR);
- set_enved_power(DEFAULT_ENVED_POWER);
- set_enved_base(DEFAULT_ENVED_BASE);
- set_enved_target(DEFAULT_ENVED_TARGET);
- set_enved_wave_p(DEFAULT_ENVED_WAVE_P);
- set_enved_in_dB(DEFAULT_ENVED_IN_DB);
- XmTextSetString(textL, NULL);
- set_enved_filter_order(DEFAULT_ENVED_FILTER_ORDER);
- if (active_env) active_env = free_env(active_env);
-#if HAVE_SCHEME
- active_env = string_to_env("'(0 0 1 0)");
-#endif
-#if HAVE_FORTH
- active_env = string_to_env("'( 0 0 1 0 )");
-#endif
-#if HAVE_RUBY
- active_env = string_to_env("[0, 0, 1, 0]");
-#endif
- set_enved_env_list_top(0);
- prepare_env_edit(active_env);
- set_sensitive(saveB, true);
- reflect_enved_style();
- env_redisplay();
-}
-
-
-static void clear_point_label(void);
-
-static void clear_xenv_error(void)
-{
- if (brkptL)
- clear_point_label();
-}
-
-
-static void unpost_xenv_error(XtPointer data, XtIntervalId *id)
-{
- clear_xenv_error();
-}
-
-
-static void errors_to_xenv_text(const char *msg, void *data)
-{
- set_button_label(brkptL, msg);
- XtAppAddTimeOut(MAIN_APP(ss),
- 5000,
- (XtTimerCallbackProc)unpost_xenv_error,
- NULL);
-}
-
-
-static void order_field_activated(void)
-{
- /* return in order text field */
- char *str = NULL;
- str = XmTextGetString(orderL);
- if ((str) && (*str))
- {
- int order;
- redirect_errors_to(errors_to_xenv_text, NULL);
- order = string_to_int(str, 1, "order");
- redirect_errors_to(NULL, NULL);
- if (order & 1) order++;
- if ((order > 0) &&
- (order < 2000))
- set_enved_filter_order(order);
- else widget_int_to_text(orderL, enved_filter_order(ss));
- }
- if (str) XtFree(str);
-}
-
-
-static void text_field_activated(void)
-{ /* might be breakpoints to load or an envelope name (<cr> in enved text field) */
- char *name = NULL, *str;
- name = XmTextGetString(textL);
- if ((name) && (*name))
- {
- env *e = NULL;
- str = name;
- while (isspace((int)(*str))) str++;
- e = name_to_env(str);
- if (!e)
- {
- if (isalpha((int)(str[0])))
- {
- alert_envelope_editor(str, copy_env(active_env));
- add_or_edit_symbol(str, active_env);
- set_sensitive(saveB, false);
- env_redisplay(); /* updates label */
- /* e is null here */
- }
- else
- {
- redirect_errors_to(errors_to_xenv_text, NULL);
- e = string_to_env(str);
- redirect_errors_to(NULL, NULL);
- }
- }
- if (e)
- {
- if (active_env)
- {
- #define ENVED_TEMP_NAME "enved-backup"
- /* save current under a temp name! -- user might have mistakenly reused a name */
- alert_envelope_editor((char *)ENVED_TEMP_NAME, copy_env(active_env));
- add_or_edit_symbol(ENVED_TEMP_NAME, active_env);
- active_env = free_env(active_env);
- }
- active_env = copy_env(e);
- set_enved_env_list_top(0);
- prepare_env_edit(active_env);
- set_sensitive(saveB, true);
- set_sensitive(undoB, false);
- set_sensitive(revertB, false);
- env_redisplay();
- e = free_env(e);
- }
- }
- if (name) XtFree(name);
-}
-
-static void text_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- text_field_activated();
-}
-
-
-static void order_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- order_field_activated();
-}
-
-
-static void save_button_pressed(Widget w, XtPointer context, XtPointer info)
-{
- char *name = NULL;
- if (active_env == NULL) return;
- name = XmTextGetString(textL);
- if ((!name) || (!(*name)))
- name = mus_strdup("unnamed");
- alert_envelope_editor(name, copy_env(active_env));
- add_or_edit_symbol(name, active_env);
- set_sensitive(saveB, false);
- env_redisplay();
- if (name) XtFree(name);
-}
-
-
-static void apply_enved_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* apply current envs to currently sync'd channels */
- Widget active_widget;
- active_widget = XmGetFocusWidget(enved_dialog);
- if (active_widget == XmMessageBoxGetChild(enved_dialog, XmDIALOG_OK_BUTTON))
- {
- apply_enved();
- last_active_channel = active_channel;
- }
-}
-
-
-static void undo_and_apply_enved_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* undo previous amp env, then apply */
- /* this blindly undoes the previous edit (assumed to be an envelope) -- if the user made some other change in the meantime, too bad */
- if ((active_channel) && (active_channel == last_active_channel))
- {
- active_channel->squelch_update = true;
- undo_edit_with_sync(active_channel, 1);
- active_channel->squelch_update = false;
- clear_minibuffer(active_channel->sound);
- }
- apply_enved();
- last_active_channel = active_channel;
-}
-
-
-static void select_or_edit_env(int pos)
-{
- if (showing_all_envs)
- {
- showing_all_envs = false;
- set_button_label(showB, "view envs");
- }
- if (active_env) active_env = free_env(active_env);
- selected_env = position_to_env(pos);
- if (!selected_env) return;
- active_env = selected_env;
- XmTextSetString(textL, enved_all_names(pos));
- set_enved_env_list_top(0);
- prepare_env_edit(active_env);
- set_sensitive(undoB, false);
- set_sensitive(revertB, false);
- set_sensitive(saveB, false);
- env_redisplay();
- set_sensitive(deleteB, true);
-}
-
-
-static void clear_point_label(void)
-{
- XtVaSetValues(brkptL, XmNlabelType, XmSTRING, XmNlabelString, NULL, NULL);
-}
-
-
-static void enved_display_point_label(mus_float_t x, mus_float_t y)
-{
- char brkpt_buf[LABEL_BUFFER_SIZE];
- if ((enved_in_dB(ss)) && (min_dB(ss) < -60))
- mus_snprintf(brkpt_buf, LABEL_BUFFER_SIZE, "%.3f : %.5f", x, y);
- else mus_snprintf(brkpt_buf, LABEL_BUFFER_SIZE, "%.3f : %.3f", x, y);
- set_button_label(brkptL, brkpt_buf);
-}
-
-
-#if HAVE_OSX
-static int press_x, press_y;
-#endif
-
-static void drawer_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XMotionEvent *ev = (XMotionEvent *)event;
- ignore_button_release = false;
-
- if (!showing_all_envs)
- {
- mus_float_t x, y;
-#if HAVE_OSX
- if ((ev->x == press_x) && (ev->y == press_y)) return;
-#endif
- env_editor_button_motion_with_xy(ss->enved, ev->x, ev->y, ev->time, active_env, &x, &y);
- enved_display_point_label(x, y);
- env_redisplay();
- }
-}
-
-
-static void drawer_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XButtonEvent *ev = (XButtonEvent *)event;
- int pos;
-#if HAVE_OSX
- press_x = ev->x;
- press_y = ev->y;
-#endif
- ss->enved->down_time = ev->time;
- ss->enved->env_dragged = false;
- if (showing_all_envs)
- {
- pos = hit_env(ev->x, ev->y, env_window_width, env_window_height);
- XmListSelectPos(screnvlst, pos + 1, false);
- if ((pos >= 0) &&
- (pos < enved_all_envs_top()))
- {
- select_or_edit_env(pos);
- ignore_button_release = true;
- }
- }
- else
- {
- if (!active_env)
- {
- active_env = default_env(1.0, 0.0);
- env_redisplay(); /* needed to get current_xs set up correctly */
- }
- if (env_editor_button_press(ss->enved, ev->x, ev->y, ev->time, active_env))
- env_redisplay();
- enved_display_point_label(ungrf_x(ss->enved->axis, ev->x), env_editor_ungrf_y_dB(ss->enved, ev->y));
- set_sensitive(saveB, true);
- set_sensitive(undoB, true);
- set_sensitive(revertB, true);
- }
-}
-
-
-static void drawer_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- if (ignore_button_release)
- ignore_button_release = false;
- else
- {
- if ((active_env) && (!showing_all_envs))
- {
- env_editor_button_release(ss->enved, active_env);
- env_redisplay();
- clear_point_label();
- }
- }
-}
-
-
-static void drawer_resize(Widget w, XtPointer context, XtPointer info)
-{
- /* update display, can be either view of all envs or sequence of current envs */
- env_window_width = widget_width(w);
- env_window_height = widget_height(w);
- env_redisplay();
-}
-
-
-static void show_button_pressed(Widget w, XtPointer context, XtPointer info)
-{
- /* if show all (as opposed to show current), loop through loaded LV_LISTs */
- showing_all_envs = (!showing_all_envs);
- set_button_label(showB, (showing_all_envs) ? "edit env" : "view envs");
- env_redisplay();
-}
-
-
-static void selection_button_pressed(Widget s, XtPointer context, XtPointer info)
-{
- we_turned_selection_off = false;
- apply_to_selection = (!apply_to_selection);
- XmChangeColor(selectionB, (apply_to_selection) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
- set_sensitive(apply2B, true);
- if ((enved_wave_p(ss)) &&
- (!showing_all_envs))
- env_redisplay();
-}
-
-
-static void delete_button_pressed(Widget w, XtPointer context, XtPointer info)
-{
- if (selected_env)
- {
- int i, len;
- len = enved_all_envs_top();
- for (i = 0; i < len; i++)
- if (selected_env == enved_all_envs(i))
- {
- delete_envelope(enved_all_names(i));
- if (enved_all_envs_top() == 0)
- set_sensitive(deleteB, false);
- if (active_env) active_env = free_env(active_env);
- selected_env = NULL;
- env_redisplay();
- break;
- }
- }
-}
-
-
-static void revert_button_pressed(Widget w, XtPointer context, XtPointer info)
-{
- revert_env_edit();
- if (active_env) active_env = free_env(active_env);
- active_env = enved_next_env();
- if (active_env == NULL)
- text_field_activated();
- env_redisplay();
-}
-
-
-static void undo_button_pressed(Widget w, XtPointer context, XtPointer info)
-{
- undo_env_edit();
- if (active_env) active_env = free_env(active_env);
- active_env = enved_next_env();
- env_redisplay();
-}
-
-
-static void redo_button_pressed(Widget w, XtPointer context, XtPointer info)
-{
- redo_env_edit();
- if (active_env) active_env = free_env(active_env);
- active_env = enved_next_env();
- env_redisplay();
-}
-
-
-static void reflect_apply_state(void)
-{
- set_label(nameL, env_names[enved_target(ss)]);
- XmChangeColor(ampB, (enved_target(ss) == ENVED_AMPLITUDE) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
- XmChangeColor(fltB, (enved_target(ss) == ENVED_SPECTRUM) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
- XmChangeColor(srcB, (enved_target(ss) == ENVED_SRATE) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
- if ((!showing_all_envs) &&
- (enved_wave_p(ss)))
- env_redisplay();
-}
-
-
-static void freq_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- in_set_enved_target(ENVED_SPECTRUM);
- old_clip_p = enved_clip_p(ss);
- set_enved_clip_p(true);
- reflect_apply_state();
-}
-
-
-static void amp_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (enved_target(ss) == ENVED_SPECTRUM)
- set_enved_clip_p(old_clip_p);
- in_set_enved_target(ENVED_AMPLITUDE);
- reflect_apply_state();
-}
-
-
-static void src_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (enved_target(ss) == ENVED_SPECTRUM)
- set_enved_clip_p(old_clip_p);
- in_set_enved_target(ENVED_SRATE);
- reflect_apply_state();
-}
-
-
-static void reset_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- enved_reset();
-}
-
-
-void enved_print(char *name)
-{
- print_enved(name, env_window_height);
-}
-
-
-static void print_button_pressed(Widget w, XtPointer context, XtPointer info)
-{
- ss->print_choice = PRINT_ENV;
- file_print_callback(w, context, info);
-}
-
-
-static void env_browse_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmListCallbackStruct *cb = (XmListCallbackStruct *)info;
- select_or_edit_env(cb->item_position - 1);
-}
-
-
-static void graph_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- in_set_enved_wave_p(cb->set);
- env_redisplay();
-}
-
-
-static void dB_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- in_set_enved_in_dB(cb->set);
- env_redisplay();
-}
-
-
-static void clip_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- in_set_enved_clip_p(cb->set);
-}
-
-
-static void exp_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* a push button */
- set_enved_style(ENVELOPE_EXPONENTIAL);
- if ((active_env) &&
- (!(showing_all_envs)))
- {
- active_env->base = enved_base(ss);
- set_sensitive(saveB, true);
- }
- reflect_segment_state();
-}
-
-
-static void lin_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* a push button */
- set_enved_style(ENVELOPE_LINEAR);
- if ((active_env) &&
- (!(showing_all_envs)))
- {
- active_env->base = 1.0;
- set_enved_base(1.0);
- set_sensitive(saveB, true);
- }
- reflect_segment_state();
-}
-
-
-#define BASE_MAX 400
-#define BASE_MID 200
-/* these two just set the granularity of the scale widget, not the user-visible bounds */
-
-static void make_base_label(mus_float_t bval)
-{
- char *sfs, *buf;
- int i, len, scale_len;
- len = (int)(enved_power(ss) * 4);
- if (len < 32) len = 32;
- sfs = (char *)calloc(len, sizeof(char));
- mus_snprintf(sfs, len, "%.3f", bval);
- scale_len = (int)(enved_power(ss) + 3);
- if (scale_len < 32) scale_len = 32;
- buf = (char *)calloc(scale_len, sizeof(char));
- for (i = 0; i < scale_len - 1; i++)
- buf[i] = sfs[i];
- set_button_label(baseValue, buf);
- free(sfs);
- free(buf);
- in_set_enved_base(bval);
- if ((active_env) &&
- (!(showing_all_envs)))
- {
- active_env->base = enved_base(ss);
- if (enved_style(ss) == ENVELOPE_EXPONENTIAL)
- env_redisplay();
- }
-}
-
-
-static void base_changed(int val)
-{
- mus_float_t bval;
- if (val == 0)
- bval = 0.0;
- else
- {
- if (val == BASE_MID)
- bval = 1.0;
- else
- {
- if (val > BASE_MID)
- bval = pow(1.0 + (10.0 * ((mus_float_t)(val - BASE_MID) / (mus_float_t)BASE_MID)), enved_power(ss));
- else
- bval = pow(((mus_float_t)val / (mus_float_t)BASE_MID), enved_power(ss) - 1.0);
- }
- }
- make_base_label(bval);
- if ((active_env) && (enved_style(ss) == ENVELOPE_EXPONENTIAL))
- set_sensitive(saveB, true); /* what about undo/redo here? */
-}
-
-
-static void reflect_changed_base(mus_float_t val)
-{
- int ival;
- if (val <= 0.0)
- ival = 0;
- else
- {
- if (val == 1.0)
- ival = BASE_MID;
- else
- {
- if (val <= 1.0)
- ival = (int)(pow(val, 1.0 / (enved_power(ss) - 1.0)) * BASE_MID);
- else ival = (int)(BASE_MID + ((BASE_MID * (pow(val, (1.0 / (enved_power(ss)))) - 1)) / 10.0));
- }
- }
- XtVaSetValues(baseScale, XmNvalue, mus_iclamp(0, ival, (int)(BASE_MAX * .9)), NULL);
- make_base_label(val);
-}
-
-
-static void base_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *sb = (XmScrollBarCallbackStruct *)info;
- base_changed(sb->value);
-}
-
-
-static int base_last_value = BASE_MID;
-
-static void base_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *sb = (XmScrollBarCallbackStruct *)info;
- base_last_value = sb->value;
- base_changed(sb->value);
-}
-
-
-static void base_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
- XButtonEvent *ev;
- int val;
- ev = (XButtonEvent *)(cb->event);
- if (ev->state & (snd_ControlMask | snd_MetaMask))
- val = base_last_value;
- else val = BASE_MID;
- base_changed(val);
- XtVaSetValues(baseScale, XmNvalue, val, NULL);
-}
-
-
-static void FIR_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- FIR_p = (!FIR_p);
- set_label(w, (FIR_p) ? "fir" : "fft");
- if (enved_wave_p(ss)) env_redisplay();
-}
-
-
-static void reflect_sound_state(void)
-{
- bool file_p;
- file_p = (bool)(any_selected_sound());
- set_sensitive(applyB, file_p);
- set_sensitive(apply2B, file_p);
-}
-
-
-static XEN reflect_file_in_enved(XEN reason)
-{
- if (enved_dialog) reflect_sound_state();
- return(XEN_FALSE);
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(reflect_file_in_enved_w, reflect_file_in_enved)
-#else
- #define reflect_file_in_enved_w reflect_file_in_enved
-#endif
-
-
-static void enved_reflect_selection(bool on);
-
-static XEN enved_selection_handler(XEN xreason)
-{
- int reason;
- reason = XEN_TO_C_INT(xreason);
- switch (reason)
- {
- case SELECTION_INACTIVE: enved_reflect_selection(false); break;
- case SELECTION_ACTIVE: enved_reflect_selection(true); break;
- default: enved_reflect_selection(selection_is_active()); break;
- }
- return(XEN_FALSE);
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(enved_selection_handler_w, enved_selection_handler)
-#else
- #define enved_selection_handler_w enved_selection_handler
-#endif
-
-
-Widget create_envelope_editor(void)
-{
- if (!enved_dialog)
- {
- int n;
- Arg args[32];
- Widget colE, colD, colB, colF;
- Widget spacer, spacer1, aform, mainform, screnvname, baseSep, baseLabel;
- XmString xhelp, xdismiss, xapply, titlestr, s1;
- XGCValues gv;
- XtCallbackList n1, n2;
- char str[LABEL_BUFFER_SIZE];
-
- /* -------- DIALOG -------- */
- xdismiss = XmStringCreateLocalized((char *)"Go Away");
- xhelp = XmStringCreateLocalized((char *)"Help");
- titlestr = XmStringCreateLocalized((char *)"Edit Envelope");
- xapply = XmStringCreateLocalized((char *)"Apply");
- /* xreset = XmStringCreateLocalized((char *)"Reset"); */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNcancelLabelString, xdismiss); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNokLabelString, xapply); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- enved_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"envelope editor", args, n);
-
- XtAddCallback(enved_dialog, XmNcancelCallback, dismiss_enved_callback, NULL);
- XtAddCallback(enved_dialog, XmNhelpCallback, help_enved_callback, NULL);
- XtAddCallback(enved_dialog, XmNokCallback, apply_enved_callback, NULL);
-
- XmStringFree(xhelp);
- XmStringFree(xdismiss);
- XmStringFree(titlestr);
- XmStringFree(xapply);
-
- XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(enved_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- apply2B = XtCreateManagedWidget("Undo&Apply", xmPushButtonGadgetClass, enved_dialog, args, n);
- XtAddCallback(apply2B, XmNactivateCallback, undo_and_apply_enved_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNforeground, ss->black); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- resetB = XtCreateManagedWidget("Reset", xmPushButtonGadgetClass, enved_dialog, args, n);
- XtAddCallback(resetB, XmNactivateCallback, reset_button_callback, NULL);
-
-
- /* -------- MAIN WIDGET -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(enved_dialog, XmDIALOG_SEPARATOR)); n++;
- mainform = XtCreateManagedWidget("formd", xmFormWidgetClass, enved_dialog, args, n);
-
- /* the order in which widgets are defined matters a lot here:
- * we need to build from the bottom up so that the graph portion expands
- * when the window is resized (if top-down, the slider at the bottom expands!)
- */
-
- /* -------- EXP SLIDER AT BOTTOM -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- baseLabel = make_pushbutton_widget("exp:", mainform, args, n);
- XtAddCallback(baseLabel, XmNactivateCallback, base_click_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- s1 = XmStringCreateLocalized((char *)"1.000");
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, baseLabel); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, baseLabel); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- /* XtSetArg(args[n], XmNrecomputeSize, false); n++; */
- XtSetArg(args[n], XmNlabelString, s1); n++;
- baseValue = XtCreateManagedWidget("base-label", xmLabelWidgetClass, mainform, args, n);
- XmStringFree(s1);
-
- /* -------- filter order -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNcolumns, 3); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNheight, 24); n++;
- XtSetArg(args[n], XmNresizeWidth, false); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNmarginBottom, 0); n++;
- mus_snprintf(str, LABEL_BUFFER_SIZE, "%d", enved_filter_order(ss));
- XtSetArg(args[n], XmNvalue, str); n++;
- orderL = make_textfield_widget("orderL", mainform, args, n, ACTIVATABLE, NO_COMPLETER);
- XtAddCallback(orderL, XmNactivateCallback, order_activate_callback, NULL);
-
- /* -------- fft/fir choice -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, orderL); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- firB = make_pushbutton_widget((char *)((FIR_p) ? "fir" : "fft"), mainform, args, n);
- XtAddCallback(firB, XmNactivateCallback, FIR_click_callback, NULL);
-
- /* -------- exp base scale -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, baseLabel); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, baseValue); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, firB); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, BASE_MAX); n++;
- XtSetArg(args[n], XmNvalue, BASE_MID); n++;
- XtSetArg(args[n], XmNincrement, 1); n++;
- XtSetArg(args[n], XmNpageIncrement, 1); n++;
- XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(base_drag_callback, NULL)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(base_valuechanged_callback, NULL)); n++;
- baseScale = XtCreateManagedWidget("expscl", xmScrollBarWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, baseScale); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNmargin, LINE_MARGIN); n++;
- XtSetArg(args[n], XmNheight, LINE_MARGIN); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNheight, 5); n++;
- baseSep = XtCreateManagedWidget("snd-rec-sep", xmSeparatorWidgetClass, mainform, args, n);
-
- /* -------- AMP ENV NAME -------- */
- n = 0;
- s1 = XmStringCreateLocalized((char *)"amp env:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- nameL = XtCreateManagedWidget("nameL", xmLabelWidgetClass, mainform, args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, nameL); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- textL = make_textfield_widget("textL", mainform, args, n, ACTIVATABLE, add_completer_func(env_name_completer, NULL));
- XtAddCallback(textL, XmNactivateCallback, text_activate_callback, NULL);
-
-
- /* -------- dB, GRAPH ('wave') AND CLIP BUTTONS -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- dBB = make_togglebutton_widget("dB", mainform, args, n);
- XtAddCallback(dBB, XmNvalueChangedCallback, dB_button_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, dBB); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- graphB = make_togglebutton_widget("wave", mainform, args, n);
- XtAddCallback(graphB, XmNvalueChangedCallback, graph_button_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, graphB); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- clipB = make_togglebutton_widget("clip", mainform, args, n);
- XtAddCallback(clipB, XmNvalueChangedCallback, clip_button_callback, NULL);
-
- /* -------- BREAKPOINT DATA DISPLAY LABEL -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, baseSep); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, textL); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, clipB); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNlabelType, XmSTRING); n++;
- brkptL = XtCreateManagedWidget(" ", xmLabelWidgetClass, mainform, args, n);
-
- /* -------- SPACERS TO DIVIDE WINDOW IN TWO -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, textL); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 4); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- spacer = XtCreateManagedWidget("spacer", xmSeparatorWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, spacer); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_IN); n++;
- spacer1 = XtCreateManagedWidget("spacer1", xmSeparatorWidgetClass, mainform, args, n);
- /* second separator needed because marginTop seems to be broken or non-existent for these widgets */
-
- /* -------- WINDOW LEFT WIDGET HOLDER -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, spacer1); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- aform = XtCreateManagedWidget("aform", xmFormWidgetClass, mainform, args, n);
-
- /* -------- BUTTON BOX AT TOP LEFT -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNshadowThickness, 4); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- colF = XtCreateManagedWidget("env-button-frame", xmFrameWidgetClass, aform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- colB = XtCreateManagedWidget("env-button-holder", xmFormWidgetClass, colF, args, n);
-
- /* VIEW ENVS */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- showB = XtCreateManagedWidget("view envs", xmPushButtonWidgetClass, colB, args, n);
- XtAddCallback(showB, XmNactivateCallback, show_button_pressed, NULL);
-
- /* SAVE PRINT */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, showB); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- saveB = XtCreateManagedWidget("save", xmPushButtonWidgetClass, colB, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, saveB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, saveB); n++;
- printB = XtCreateManagedWidget("print", xmPushButtonWidgetClass, colB, args, n);
-
- XtAddCallback(saveB, XmNactivateCallback, save_button_pressed, NULL);
- XtAddCallback(printB, XmNactivateCallback, print_button_pressed, NULL);
-
- /* UNDO REDO */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, saveB); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- undoB = XtCreateManagedWidget("undo", xmPushButtonWidgetClass, colB, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, undoB); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, undoB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- redoB = XtCreateManagedWidget("redo", xmPushButtonWidgetClass, colB, args, n);
-
- XtAddCallback(undoB, XmNactivateCallback, undo_button_pressed, NULL);
- XtAddCallback(redoB, XmNactivateCallback, redo_button_pressed, NULL);
-
- /* REVERT DELETE */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, undoB); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- revertB = XtCreateManagedWidget("revert", xmPushButtonWidgetClass, colB, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, revertB); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, revertB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- deleteB = XtCreateManagedWidget("delete", xmPushButtonWidgetClass, colB, args, n);
-
- XtAddCallback(revertB, XmNactivateCallback, revert_button_pressed, NULL);
- XtAddCallback(deleteB, XmNactivateCallback, delete_button_pressed, NULL);
-
- /* AMP FLT SRC */
- /* enved_function (target) choice (a row of three push buttons that acts like a "radio box") */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->yellow); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, revertB); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 33); n++;
- ampB = XtCreateManagedWidget("amp", xmPushButtonWidgetClass, colB, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->yellow); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, ampB); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, ampB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 67); n++;
- fltB = XtCreateManagedWidget("flt", xmPushButtonWidgetClass, colB, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->yellow); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, fltB); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, fltB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- srcB = XtCreateManagedWidget("src", xmPushButtonWidgetClass, colB, args, n);
-
- XtAddCallback(fltB, XmNactivateCallback, freq_button_callback, NULL);
- XtAddCallback(ampB, XmNactivateCallback, amp_button_callback, NULL);
- XtAddCallback(srcB, XmNactivateCallback, src_button_callback, NULL);
-
- /* LINEAR EXP [PROC] */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->yellow); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, ampB); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- linB = XtCreateManagedWidget("lin", xmPushButtonWidgetClass, colB, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->yellow); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, linB); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, linB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 100); n++;
- expB = XtCreateManagedWidget("exp", xmPushButtonWidgetClass, colB, args, n);
-
- XtAddCallback(linB, XmNactivateCallback, lin_button_callback, NULL);
- XtAddCallback(expB, XmNactivateCallback, exp_button_callback, NULL);
-
- /* SELECTION */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, linB); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- selectionB = make_pushbutton_widget("selection", colB, args, n);
-
- XtAddCallback(selectionB, XmNactivateCallback, selection_button_pressed, NULL);
-
-
- /* -------- ENV LIST AT LEFT UNDER BUTTONS -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, colF); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNshadowThickness, 4); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- colE = XtCreateManagedWidget("env-list-frame", xmFrameWidgetClass, aform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- colD = XtCreateManagedWidget("env-list-holder", xmFormWidgetClass, colE, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- screnvname = XtCreateManagedWidget("envs:", xmLabelWidgetClass, colD, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, screnvname); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- if (ss->listener_fontlist)
- {
- XtSetArg(args[n], XmNfontList, 0); n++;
- XtSetArg(args[n], XM_FONT_RESOURCE, ss->listener_fontlist); n++;
- use_listener_font = true;
- }
- screnvlst = XmCreateScrolledList(colD, (char *)"scrolled-env-list", args, n);
- XtManageChild(screnvlst);
- XtAddCallback(screnvlst, XmNbrowseSelectionCallback, env_browse_callback, NULL);
- map_over_children(screnvlst, set_main_color_of_widget);
- if (enved_all_envs_top() > 0) make_scrolled_env_list();
-
- /* -------- MAIN GRAPH -------- */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->graph_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, spacer1 /* textL */); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, aform); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNheight, 350); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- drawer = XtCreateManagedWidget("drawer", xmDrawingAreaWidgetClass, mainform, args, n);
-
- gv.function = GXcopy;
- XtVaGetValues(drawer, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
- gc = XtGetGC(drawer, GCForeground | GCFunction, &gv);
- gv.foreground = ss->red;
- rgc = XtGetGC(drawer, GCBackground | GCForeground | GCFunction, &gv);
- gv.foreground = ss->enved_waveform_color;
- ggc = XtGetGC(drawer, GCBackground | GCForeground | GCFunction, &gv);
-
- XtManageChild(enved_dialog); /* needed so that window is valid when resize callback is invoked */
- applyB = XmMessageBoxGetChild(enved_dialog, XmDIALOG_OK_BUTTON);
- cancelB = XmMessageBoxGetChild(enved_dialog, XmDIALOG_CANCEL_BUTTON);
- cancelling = true;
-
- XtAddCallback(drawer, XmNresizeCallback, drawer_resize, NULL);
- XtAddCallback(drawer, XmNexposeCallback, drawer_resize, NULL);
-
- XtAddEventHandler(drawer, ButtonPressMask, false, drawer_button_press, NULL);
- XtAddEventHandler(drawer, ButtonMotionMask, false, drawer_button_motion, NULL);
- XtAddEventHandler(drawer, ButtonReleaseMask, false, drawer_button_release, NULL);
-
- if (enved_all_envs_top() == 0)
- set_sensitive(showB, false);
- set_sensitive(revertB, false);
- set_sensitive(deleteB, false);
- set_sensitive(undoB, false);
- set_sensitive(redoB, false);
- set_sensitive(saveB, false);
- if (!(selection_is_active()))
- set_sensitive(selectionB, false);
-
- XmToggleButtonSetState(clipB, (Boolean)(enved_clip_p(ss)), false);
- XmToggleButtonSetState(graphB, (Boolean)(enved_wave_p(ss)), false);
- XmToggleButtonSetState(dBB, (Boolean)(enved_in_dB(ss)), false);
-
- free(n1);
- free(n2);
-
- reflect_apply_state();
- reflect_segment_state();
- reflect_sound_state();
-
- set_dialog_widget(ENVED_DIALOG, enved_dialog);
-
- XEN_ADD_HOOK(ss->snd_open_file_hook, reflect_file_in_enved_w, "enved-file-open-handler", "enved dialog's file-open-hook handler");
- XEN_ADD_HOOK(ss->snd_selection_hook, enved_selection_handler_w, "enved-selection-handler", "enved dialog's selection-hook handler");
- }
- else raise_dialog(enved_dialog);
- if (!XtIsManaged(enved_dialog))
- XtManageChild(enved_dialog);
- active_channel = current_channel();
- return(enved_dialog);
-}
-
-
-void set_enved_clip_p(bool val)
-{
- in_set_enved_clip_p(val);
- if (enved_dialog)
- XmToggleButtonSetState(clipB, (Boolean)val, false);
-}
-
-
-void reflect_enved_style(void)
-{
- reflect_segment_state();
-}
-
-
-void set_enved_target(enved_target_t val)
-{
- in_set_enved_target(val);
- if (enved_dialog)
- reflect_apply_state();
-}
-
-
-void set_enved_wave_p(bool val)
-{
- in_set_enved_wave_p(val);
- if (enved_dialog)
- XmToggleButtonSetState(graphB, (Boolean)val, false);
-}
-
-
-void set_enved_in_dB(bool val)
-{
- in_set_enved_in_dB(val);
- if (enved_dialog)
- XmToggleButtonSetState(dBB, (Boolean)val, false);
-}
-
-
-void set_enved_base(mus_float_t val)
-{
- in_set_enved_base(val);
- if (enved_dialog)
- reflect_changed_base(val);
-}
-
-
-bool enved_dialog_is_active(void)
-{
- return((enved_dialog) &&
- (XtIsManaged(enved_dialog)));
-}
-
-
-void set_enved_filter_order(int order)
-{
- if ((order > 0) && (order < 2000))
- {
- if (order & 1)
- in_set_enved_filter_order(order + 1);
- else in_set_enved_filter_order(order);
- if (enved_dialog)
- {
- widget_int_to_text(orderL, enved_filter_order(ss));
- if ((enved_dialog) &&
- (enved_target(ss) == ENVED_SPECTRUM) &&
- (enved_wave_p(ss)) && (!showing_all_envs))
- env_redisplay();
- }
- }
-}
-
-
-static void enved_reflect_selection(bool on)
-{
- if ((enved_dialog) && (!within_selection_src))
- {
- set_sensitive(selectionB, on);
- if ((apply_to_selection) && (!on))
- {
- apply_to_selection = false;
- we_turned_selection_off = true;
- }
- if ((on) && (we_turned_selection_off))
- {
- apply_to_selection = true;
- }
- XmChangeColor(selectionB, (apply_to_selection) ? ((Pixel)ss->yellow) : ((Pixel)ss->highlight_color));
- if ((enved_target(ss) != ENVED_SPECTRUM) &&
- (enved_wave_p(ss)) &&
- (!showing_all_envs))
- env_redisplay();
- }
-}
-
-
-
-void color_enved_waveform(Pixel pix)
-{
- ss->enved_waveform_color = pix;
- if (enved_dialog)
- {
- XSetForeground(MAIN_DISPLAY(ss), ggc, pix);
- if ((enved_wave_p(ss)) &&
- (enved_dialog))
- env_redisplay();
- }
-}
-
-
-static XEN g_enved_envelope(void)
-{
- #define H_enved_envelope "(" S_enved_envelope "): current envelope editor displayed (active) envelope"
- return(env_to_xen(active_env));
-}
-
-
-static XEN g_set_enved_envelope(XEN e)
-{
- XEN_ASSERT_TYPE(XEN_LIST_P(e) || XEN_STRING_P(e) || XEN_SYMBOL_P(e), e, XEN_ONLY_ARG, S_setB S_enved_envelope, "a list, symbol, or string");
- if (active_env) active_env = free_env(active_env);
- if ((XEN_STRING_P(e)) || (XEN_SYMBOL_P(e)))
- active_env = name_to_env((XEN_STRING_P(e)) ? XEN_TO_C_STRING(e) : XEN_SYMBOL_TO_C_STRING(e)); /* xen_to_env in name_to_env, so no copy */
- else active_env = xen_to_env(e);
- if ((!active_env) && (!(XEN_LIST_P(e))))
- XEN_ERROR(NO_SUCH_ENVELOPE,
- XEN_LIST_2(C_TO_XEN_STRING(S_setB S_enved_envelope ": bad envelope arg: ~A"),
- e));
- if (enved_dialog)
- env_redisplay();
- return(e);
-}
-
-
-static XEN g_enved_filter(void)
-{
- #define H_enved_filter "(" S_enved_filter "): envelope editor FIR/FFT filter choice (#t: FIR)"
- return(C_TO_XEN_BOOLEAN(FIR_p));
-}
-
-
-static XEN g_set_enved_filter(XEN type)
-{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(type), type, XEN_ONLY_ARG, S_setB S_enved_filter, "boolean");
- FIR_p = XEN_TO_C_BOOLEAN(type);
- if (firB)
- set_label(firB, (FIR_p) ? "fir" : "fft");
- return(type);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_enved_filter_w, g_enved_filter)
-XEN_NARGIFY_1(g_set_enved_filter_w, g_set_enved_filter)
-XEN_NARGIFY_0(g_enved_envelope_w, g_enved_envelope)
-XEN_NARGIFY_1(g_set_enved_envelope_w, g_set_enved_envelope)
-#else
-#define g_enved_filter_w g_enved_filter
-#define g_set_enved_filter_w g_set_enved_filter
-#define g_enved_envelope_w g_enved_envelope
-#define g_set_enved_envelope_w g_set_enved_envelope
-#endif
-
-void g_init_gxenv(void)
-{
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_filter, g_enved_filter_w, H_enved_filter,
- S_setB S_enved_filter, g_set_enved_filter_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_enved_envelope, g_enved_envelope_w, H_enved_envelope,
- S_setB S_enved_envelope, g_set_enved_envelope_w, 0, 0, 1, 0);
-}
diff --git a/snd-xfft.c b/snd-xfft.c
deleted file mode 100644
index c87c6b2..0000000
--- a/snd-xfft.c
+++ /dev/null
@@ -1,1863 +0,0 @@
-/* Transform settings dialog */
-
-#include "snd.h"
-
-
-static Widget transform_dialog = NULL; /* main dialog shell */
-static Widget type_list, size_list, wavelet_list, window_list;
-static Widget beta_scale, alpha_scale, start_scale, end_scale, alpha_number, beta_number, start_number, end_number;
-static Widget db_button, peaks_button, logfreq_button, sono_button, spectro_button, normo_button, normalize_button, selection_button, phases_button;
-static Widget graph_label, graph_drawer;
-static Widget peak_txt, db_txt, freq_base_txt;
-static Widget error_frame, error_label;
-
-#define NUM_TRANSFORM_SIZES 15
-static const char *transform_size_names[NUM_TRANSFORM_SIZES] =
- {"32", "64", "128", "256", "512", "1024", "2048", "4096", "8192", "16384", "65536", "262144", "1048576", "4194304 ", "16777216"};
-static mus_long_t transform_sizes[NUM_TRANSFORM_SIZES] =
- {32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 65536, 262144, 1048576, 4194304, 16777216};
-
-
-
-/* ---------------- fft window graph ---------------- */
-
-static GC gc, fgc;
-
-#define GRAPH_SIZE 128
-static mus_float_t graph_data[GRAPH_SIZE]; /* fft window graph in transform options dialog */
-static mus_float_t graph_fftr[GRAPH_SIZE * 2];
-static mus_float_t graph_ffti[GRAPH_SIZE * 2];
-/* I goofed around with making the graph size dependent on the drawer's width, but there's really nothing gained */
-/* also tried linear/db+min-dB distinction, but linear looks dumb and min-dB is a bother */
-
-static mus_float_t fp_dB(mus_float_t py)
-{
- return((py <= ss->lin_dB) ? 0.0 : (1.0 - (20.0 * log10(py) / min_dB(ss))));
-}
-
-
-static int local_grf_x(double val, axis_info *ap)
-{
- if (val >= ap->x1) return(ap->x_axis_x1);
- if (val <= ap->x0) return(ap->x_axis_x0);
- return((int)(ap->x_base + val * ap->x_scale));
-}
-
-
-static int local_grf_y(mus_float_t val, axis_info *ap)
-{
- if (val >= ap->y1) return(ap->y_axis_y1);
- if (val <= ap->y0) return(ap->y_axis_y0);
- return((int)(ap->y_base + val * ap->y_scale));
-}
-
-
-static axis_info *axis_ap = NULL;
-
-static void graph_redisplay(void)
-{
- /* fft_window(ss) is the current choice */
- int ix0, iy0, ix1, iy1, i;
- mus_float_t xincr, x;
- graphics_context *ax;
-
- if (axis_ap == NULL)
- {
- axis_ap = (axis_info *)calloc(1, sizeof(axis_info));
- ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- axis_ap->ax = ax;
- ax->dp = XtDisplay(graph_drawer);
- ax->wn = XtWindow(graph_drawer);
- }
- else ax = axis_ap->ax;
-
- axis_ap->xmin = 0.0;
- axis_ap->xmax = 1.0;
- axis_ap->x_ambit = 1.0;
- axis_ap->x0 = 0.0;
- axis_ap->x1 = 1.0;
-
- if (axis_ap->xlabel) free(axis_ap->xlabel);
- if (fft_beta_max(fft_window(ss)) != 1.0)
- axis_ap->xlabel = mus_format("(%d, beta: %.2f)", GRAPH_SIZE, fft_beta_max(fft_window(ss)) * fft_window_beta(ss));
- else axis_ap->xlabel = mus_format("(%d)", GRAPH_SIZE);
-
- if (fft_window(ss) == MUS_FLAT_TOP_WINDOW)
- {
- axis_ap->ymin = -0.1;
- axis_ap->ymax = 1.0;
- axis_ap->y_ambit = 1.1;
- axis_ap->y0 = -0.1;
- axis_ap->y1 = 1.0;
- }
- else
- {
- axis_ap->ymin = 0.0;
- axis_ap->ymax = 1.0;
- axis_ap->y_ambit = 1.0;
- axis_ap->y0 = 0.0;
- axis_ap->y1 = 1.0;
- }
-
- axis_ap->width = widget_width(graph_drawer);
- axis_ap->window_width = axis_ap->width;
- axis_ap->y_offset = 0;
- axis_ap->height = widget_height(graph_drawer);
- axis_ap->graph_x0 = 0;
-
- clear_window(ax);
- ax->gc = gc;
- make_axes_1(axis_ap, X_AXIS_IN_SECONDS, 1 /* "srate" */, SHOW_ALL_AXES, NOT_PRINTING, WITH_X_AXIS, NO_GRID, WITH_LINEAR_AXES, grid_density(ss));
-
- ix1 = local_grf_x(0.0, axis_ap);
- iy1 = local_grf_y(graph_data[0], axis_ap);
- xincr = 1.0 / (mus_float_t)GRAPH_SIZE;
-
- for (i = 1, x = xincr; i < GRAPH_SIZE; i++, x += xincr)
- {
- ix0 = ix1;
- iy0 = iy1;
- ix1 = local_grf_x(x, axis_ap);
- iy1 = local_grf_y(graph_data[i], axis_ap);
- XDrawLine(ax->dp, ax->wn, gc, ix0, iy0, ix1, iy1);
- }
-
- ax->gc = fgc;
- ix1 = local_grf_x(0.0, axis_ap);
- iy1 = local_grf_y(graph_fftr[0], axis_ap);
- xincr = 1.0 / (mus_float_t)GRAPH_SIZE;
-
- for (i = 1, x = xincr; i < GRAPH_SIZE; i++, x += xincr)
- {
- ix0 = ix1;
- iy0 = iy1;
- ix1 = local_grf_x(x, axis_ap);
- if (fft_log_magnitude(ss))
- iy1 = local_grf_y(fp_dB(graph_fftr[i]), axis_ap);
- else iy1 = local_grf_y(graph_fftr[i], axis_ap);
- XDrawLine(ax->dp, ax->wn, fgc, ix0, iy0, ix1, iy1);
- }
-}
-
-
-static void get_fft_window_data(void)
-{
- int i;
- mus_make_fft_window_with_window(fft_window(ss), GRAPH_SIZE,
- fft_window_beta(ss) * fft_beta_max(fft_window(ss)),
- fft_window_alpha(ss), graph_data);
- memset((void *)graph_fftr, 0, GRAPH_SIZE * 2 * sizeof(mus_float_t));
- memset((void *)graph_ffti, 0, GRAPH_SIZE * 2 * sizeof(mus_float_t));
- memcpy((void *)graph_fftr, (void *)graph_data, GRAPH_SIZE * sizeof(mus_float_t));
- mus_spectrum(graph_fftr, graph_ffti, NULL, GRAPH_SIZE * 2, MUS_SPECTRUM_IN_DB);
- for (i = 0; i < GRAPH_SIZE; i++)
- graph_fftr[i] = (graph_fftr[i] + 80.0) / 80.0; /* min dB here is -80 */
-}
-
-
-static void widget_float_to_text(Widget w, mus_float_t val)
-{
- char *str;
- str = (char *)calloc(16, sizeof(char));
- mus_snprintf(str, 16, "%.2f", val);
- XmTextFieldSetString(w, str);
- free(str);
-}
-
-
-
-/* ---------------- errors ---------------- */
-
-static void clear_fft_error(void)
-{
- if ((error_frame) && (XtIsManaged(error_frame)))
- XtUnmanageChild(error_frame);
-}
-
-
-static void unpost_fft_error(XtPointer data, XtIntervalId *id)
-{
- clear_fft_error();
-}
-
-
-static void errors_to_fft_text(const char *msg, void *data)
-{
- int lines = 0;
- XmString label;
- label = multi_line_label(msg, &lines);
- XtVaSetValues(error_label,
- XmNlabelString, label,
- XmNheight, lines * 20,
- NULL);
- XtVaSetValues(error_frame, XmNheight, lines * 20, NULL);
- XmStringFree(label);
- XtManageChild(error_frame);
- /* since the offending text is automatically overwritten, we can't depend on subsequent text modify callbacks
- * to clear things, so we'll just use a timer
- */
- XtAppAddTimeOut(MAIN_APP(ss),
- 5000,
- (XtTimerCallbackProc)unpost_fft_error,
- NULL);
-}
-
-
-
-/* ---------------- transform size ---------------- */
-
-static void chans_transform_size(chan_info *cp, mus_long_t size)
-{
- cp->transform_size = size;
- if (cp->fft)
- cp->fft->size = size;
-}
-
-
-void set_transform_size(mus_long_t val)
-{
- for_each_chan(force_fft_clear);
- in_set_transform_size(val);
- for_each_chan_with_mus_long_t(chans_transform_size, val);
- if (transform_dialog)
- {
- int i;
- for (i = 0; i < NUM_TRANSFORM_SIZES; i++)
- if (transform_sizes[i] == val)
- {
- XmListSelectPos(size_list, i + 1, false);
- break;
- }
- }
- if (!(ss->graph_hook_active)) for_each_chan(calculate_fft);
-}
-
-
-static void size_browse_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- for_each_chan(force_fft_clear);
- in_set_transform_size(transform_sizes[cbs->item_position - 1]);
- for_each_chan_with_mus_long_t(chans_transform_size, transform_size(ss));
- for_each_chan(calculate_fft);
- set_label(graph_label, mus_fft_window_name(fft_window(ss)));
-}
-
-
-/* ---------------- wavelet choice ---------------- */
-
-static void chans_wavelet_type(chan_info *cp, int value)
-{
- cp->wavelet_type = value;
-}
-
-
-void set_wavelet_type(int val)
-{
- if (transform_dialog) XmListSelectPos(wavelet_list, val, false);
- in_set_wavelet_type(val);
- for_each_chan_with_int(chans_wavelet_type, val);
- if ((transform_type(ss) == WAVELET) &&
- (!(ss->graph_hook_active)))
- for_each_chan(calculate_fft);
-}
-
-
-static void wavelet_browse_callback(Widget w, XtPointer context, XtPointer info)
-{
- int val;
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- in_set_wavelet_type(val = (cbs->item_position - 1)); /* make these numbers 0-based as in mus.lisp */
- for_each_chan_with_int(chans_wavelet_type, val);
- if (transform_type(ss) == WAVELET)
- for_each_chan(calculate_fft);
-}
-
-
-/* ---------------- fft window choice ---------------- */
-
-static void highlight_alpha_beta_scales(mus_fft_window_t val)
-{
- if (fft_window_beta_in_use(val))
- {
- XtVaSetValues(beta_scale, XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(beta_number, XmNbackground, ss->highlight_color, NULL);
- }
- else
- {
- XtVaSetValues(beta_scale, XmNbackground, ss->basic_color, NULL);
- XtVaSetValues(beta_number, XmNbackground, ss->basic_color, NULL);
- }
-
- if (fft_window_alpha_in_use(val))
- {
- XtVaSetValues(alpha_scale, XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(alpha_number, XmNbackground, ss->highlight_color, NULL);
- }
- else
- {
- XtVaSetValues(alpha_scale, XmNbackground, ss->basic_color, NULL);
- XtVaSetValues(alpha_number, XmNbackground, ss->basic_color, NULL);
- }
-}
-
-
-void set_fft_window(mus_fft_window_t val)
-{
- in_set_fft_window(val);
- if (!(ss->graph_hook_active)) for_each_chan(calculate_fft);
- if (transform_dialog)
- {
- XmListSelectPos(window_list, (int)val + 1, false);
- set_label(graph_label, mus_fft_window_name(val));
- get_fft_window_data();
- if (XtIsManaged(transform_dialog))
- graph_redisplay();
- highlight_alpha_beta_scales(val);
- }
-}
-
-
-static void window_browse_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- mus_fft_window_t fft_window_choice;
-
- fft_window_choice = (mus_fft_window_t)(cbs->item_position - 1); /* make these numbers 0-based as in mus.lisp */
-
- in_set_fft_window(fft_window_choice);
- for_each_chan(calculate_fft);
- set_label(graph_label, mus_fft_window_name(fft_window(ss)));
- get_fft_window_data();
- graph_redisplay();
- highlight_alpha_beta_scales(fft_window_choice);
-}
-
-
-
-/* ---------------- transform choice ---------------- */
-
-static void chans_transform_type(chan_info *cp, int value)
-{
- cp->transform_type = value;
-}
-
-
-void set_transform_type(int val)
-{
- if (transform_p(val))
- {
- if (!(ss->graph_hook_active)) for_each_chan(force_fft_clear);
- in_set_transform_type(val);
- for_each_chan_with_int(chans_transform_type, val);
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
- if (transform_dialog) XmListSelectPos(type_list, transform_type_to_position(val) + 1, false);
- }
-}
-
-
-static void transform_type_browse_callback(Widget w, XtPointer context, XtPointer info)
-{
- int type;
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- type = transform_position_to_type(cbs->item_position - 1);
- for_each_chan(force_fft_clear);
- in_set_transform_type(type);
- for_each_chan_with_int(chans_transform_type, type);
- for_each_chan(calculate_fft);
-}
-
-
-void make_transform_type_list(void)
-{
- int num;
- num = max_transform_type();
- if (transform_dialog)
- {
- XmString *types;
- int i, j;
- types = (XmString *)calloc(num, sizeof(XmString));
- for (i = 0, j = 0; i < num; i++)
- if (transform_p(i))
- {
- set_transform_position(i, j);
- types[j++] = XmStringCreateLocalized((char *)transform_name(i));
- }
- XtVaSetValues(type_list,
- XmNitems, types,
- XmNitemCount, j,
- XmNvisibleItemCount, 6,
- NULL);
- for (i = 0; i < j; i++)
- XmStringFree(types[i]);
- free(types);
- }
-}
-
-
-
-/* ---------------- transform "graph type" (i.e. sonogram etc) ---------------- */
-
-void set_transform_graph_type(graph_type_t val)
-{
- in_set_transform_graph_type(val);
- if (transform_dialog)
- switch (val)
- {
- case GRAPH_ONCE:
- XmToggleButtonSetState(normo_button, true, false);
- XmToggleButtonSetState(spectro_button, false, false);
- XmToggleButtonSetState(sono_button, false, false);
- break;
- case GRAPH_AS_SONOGRAM:
- XmToggleButtonSetState(normo_button, false, false);
- XmToggleButtonSetState(spectro_button, false, false);
- XmToggleButtonSetState(sono_button, true, false);
- break;
- case GRAPH_AS_SPECTROGRAM:
- XmToggleButtonSetState(normo_button, false, false);
- XmToggleButtonSetState(spectro_button, true, false);
- XmToggleButtonSetState(sono_button, false, false);
- break;
- case GRAPH_AS_WAVOGRAM:
- break;
- }
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-static void graph_transform_once_callback(Widget w, XtPointer context, XtPointer info)
-{
- graph_type_t old_type;
- old_type = transform_graph_type(ss);
- XmToggleButtonSetState(normo_button, true, false);
- XmToggleButtonSetState(sono_button, false, false);
- XmToggleButtonSetState(spectro_button, false, false);
- in_set_transform_graph_type(GRAPH_ONCE);
- if (old_type != GRAPH_ONCE)
- for_each_chan(calculate_fft);
-}
-
-
-static void sonogram_callback(Widget w, XtPointer context, XtPointer info)
-{
- graph_type_t old_type;
- old_type = transform_graph_type(ss);
- XmToggleButtonSetState(sono_button, true, false);
- XmToggleButtonSetState(normo_button, false, false);
- XmToggleButtonSetState(spectro_button, false, false);
- in_set_transform_graph_type(GRAPH_AS_SONOGRAM);
- if (old_type != GRAPH_AS_SONOGRAM)
- for_each_chan(calculate_fft);
-}
-
-
-static void spectrogram_callback(Widget w, XtPointer context, XtPointer info)
-{
- graph_type_t old_type;
- old_type = transform_graph_type(ss);
- XmToggleButtonSetState(spectro_button, true, false);
- XmToggleButtonSetState(normo_button, false, false);
- XmToggleButtonSetState(sono_button, false, false);
- in_set_transform_graph_type(GRAPH_AS_SPECTROGRAM);
- if (old_type != GRAPH_AS_SPECTROGRAM)
- for_each_chan(calculate_fft);
-}
-
-
-
-/* ---------------- show peaks ---------------- */
-
-static void map_show_transform_peaks(chan_info *cp, bool value)
-{
- cp->show_transform_peaks = value;
-}
-
-
-static void peaks_callback(Widget w, XtPointer context, XtPointer info)
-{
- bool val;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- val = (cb->set);
- in_set_show_transform_peaks(val);
- for_each_chan_with_bool(map_show_transform_peaks, val);
- for_each_chan(calculate_fft);
-}
-
-
-void set_show_transform_peaks(bool val)
-{
- in_set_show_transform_peaks(val);
- for_each_chan_with_bool(map_show_transform_peaks, val);
- if (transform_dialog)
- set_toggle_button(peaks_button, val, false, NULL);
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-void reflect_peaks_in_transform_dialog(void)
-{
- if (transform_dialog)
- widget_int_to_text(peak_txt, max_transform_peaks(ss));
-}
-
-
-static void peaks_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *str;
- str = XmTextFieldGetString(w);
- if ((str) && (*str))
- {
- int new_peaks;
- redirect_errors_to(errors_to_fft_text, NULL);
- new_peaks = string_to_int(str, 1, "peaks");
- redirect_errors_to(NULL, NULL);
- if (new_peaks >= 1)
- {
- set_max_transform_peaks(new_peaks);
- for_each_chan(calculate_fft);
- }
- else widget_int_to_text(w, max_transform_peaks(ss));
- XtFree(str);
- }
-}
-
-
-
-/* ---------------- log magnitude ---------------- */
-
-static void chans_fft_log_magnitude(chan_info *cp, bool value)
-{
- cp->fft_log_magnitude = value;
- cp->fft_changed = FFT_CHANGE_LOCKED;
-}
-
-
-void set_fft_log_magnitude(bool val)
-{
- in_set_fft_log_magnitude(val);
- for_each_chan_with_bool(chans_fft_log_magnitude, val);
- if (transform_dialog)
- set_toggle_button(db_button, val, false, NULL);
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-
-/* ---------------- dB ---------------- */
-
-static void fft_db_callback(Widget w, XtPointer context, XtPointer info)
-{
- bool val;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- val = cb->set;
- in_set_fft_log_magnitude(val);
- graph_redisplay();
- for_each_chan_with_bool(chans_fft_log_magnitude, val);
- for_each_chan(calculate_fft);
-}
-
-
-void reflect_min_db_in_transform_dialog(void)
-{
- if (transform_dialog)
- widget_float_to_text(db_txt, min_dB(ss));
-}
-
-
-static void min_db_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *str;
- str = XmTextFieldGetString(w);
- if ((str) && (*str))
- {
- mus_float_t new_db;
- redirect_errors_to(errors_to_fft_text, NULL);
- new_db = string_to_mus_float_t(str, -10000.0, "dB");
- redirect_errors_to(NULL, NULL);
- if (new_db < 0.0)
- set_min_db(new_db);
- else widget_float_to_text(w, min_dB(ss));
- XtFree(str);
- }
-}
-
-
-
-/* ---------------- log frequency ---------------- */
-
-static void chans_fft_log_frequency(chan_info *cp, bool value)
-{
- cp->fft_log_frequency = value;
- cp->fft_changed = FFT_CHANGE_LOCKED;
-}
-
-
-static void logfreq_callback(Widget w, XtPointer context, XtPointer info)
-{
- bool val;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- val = cb->set;
- in_set_fft_log_frequency(val);
- for_each_chan_with_bool(chans_fft_log_frequency, val);
- for_each_chan(calculate_fft);
-}
-
-
-void set_fft_log_frequency(bool val)
-{
- in_set_fft_log_frequency(val);
- for_each_chan_with_bool(chans_fft_log_frequency, val);
- if (transform_dialog)
- set_toggle_button(logfreq_button, val, false, NULL);
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-void reflect_log_freq_start_in_transform_dialog(void)
-{
- if (transform_dialog)
- widget_float_to_text(freq_base_txt, log_freq_start(ss));
-}
-
-
-static void log_freq_start_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *str;
- str = XmTextFieldGetString(w);
- if ((str) && (*str))
- {
- mus_float_t new_lfb;
- redirect_errors_to(errors_to_fft_text, NULL);
- new_lfb = string_to_mus_float_t(str, 0.0, "log freq start");
- redirect_errors_to(NULL, NULL);
- if (new_lfb > 0.0)
- set_log_freq_start(new_lfb);
- else widget_float_to_text(w, log_freq_start(ss));
- XtFree(str);
- }
-}
-
-
-
-
-/* ---------------- normalization choice ---------------- */
-
-static void chans_transform_normalization(chan_info *cp, int value)
-{
- cp->transform_normalization = (fft_normalize_t)value;
- cp->fft_changed = FFT_CHANGE_LOCKED;
-}
-
-
-static void normalize_callback(Widget w, XtPointer context, XtPointer info)
-{
- fft_normalize_t choice;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- choice = (cb->set) ? NORMALIZE_BY_CHANNEL : DONT_NORMALIZE;
- in_set_transform_normalization(choice);
- for_each_chan_with_int(chans_transform_normalization, (int)choice);
- for_each_chan(calculate_fft);
-}
-
-
-void set_transform_normalization(fft_normalize_t val)
-{
- in_set_transform_normalization(val);
- for_each_chan_with_int(chans_transform_normalization, (int)val);
- if (transform_dialog)
- set_toggle_button(normalize_button, (val != DONT_NORMALIZE), false, NULL);
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-
-/* ---------------- show selection transform ---------------- */
-
-static void selection_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- in_set_show_selection_transform(cb->set);
- for_each_chan(calculate_fft);
-}
-
-
-void set_show_selection_transform(bool show)
-{
- in_set_show_selection_transform(show);
- if (transform_dialog)
- set_toggle_button(selection_button, show, false, NULL);
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-
-/* ---------------- show phases (via color) ---------------- */
-
-static void chans_fft_with_phases(chan_info *cp, bool value)
-{
- cp->fft_with_phases = value;
- cp->fft_changed = FFT_CHANGE_LOCKED;
-}
-
-
-static void phases_callback(Widget w, XtPointer context, XtPointer info)
-{
- bool val;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- val = cb->set;
- in_set_fft_with_phases(val);
- graph_redisplay();
- for_each_chan_with_bool(chans_fft_with_phases, val);
- for_each_chan(calculate_fft);
-}
-
-
-void set_fft_with_phases(bool val)
-{
- in_set_fft_with_phases(val);
- for_each_chan_with_bool(chans_fft_with_phases, val);
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-
-/* ---------------- window alpha parameter ---------------- */
-
-static void alpha_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- char alpha_number_buffer[11];
- mus_float_t alpha;
-
- alpha = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
- in_set_fft_window_alpha(alpha);
- chans_field(FCP_ALPHA, alpha);
-
- mus_snprintf(alpha_number_buffer, 11, "alpha:%.3f", alpha);
- set_label(alpha_number, alpha_number_buffer);
-
- if (fft_window_alpha_in_use(fft_window(ss)))
- {
- get_fft_window_data();
- graph_redisplay();
- if (transform_type(ss) == FOURIER)
- for_each_chan(calculate_fft);
- }
-}
-
-static void set_alpha_scale(mus_float_t val)
-{
- char alpha_number_buffer[11];
- XtVaSetValues(alpha_scale, XmNvalue, (int)(val * 90), NULL);
- mus_snprintf(alpha_number_buffer, 11, "alpha:%.3f", val);
- set_label(alpha_number, alpha_number_buffer);
-}
-
-
-void set_fft_window_alpha(mus_float_t val)
-{
- in_set_fft_window_alpha(val);
- chans_field(FCP_ALPHA, val);
- if (transform_dialog)
- {
- set_alpha_scale(val);
- get_fft_window_data();
- if (XtIsManaged(transform_dialog))
- graph_redisplay();
- }
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-
-/* ---------------- window beta parameter ---------------- */
-
-static void beta_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- char beta_number_buffer[11];
- mus_float_t beta;
-
- beta = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
- in_set_fft_window_beta(beta);
- chans_field(FCP_BETA, beta);
-
- mus_snprintf(beta_number_buffer, 11, "beta: %.3f", beta);
- set_label(beta_number, beta_number_buffer);
-
- if (fft_window_beta_in_use(fft_window(ss)))
- {
- get_fft_window_data();
- graph_redisplay();
- if (transform_type(ss) == FOURIER)
- for_each_chan(calculate_fft);
- }
-}
-
-
-static void set_beta_scale(mus_float_t val)
-{
- char beta_number_buffer[11];
- XtVaSetValues(beta_scale, XmNvalue, (int)(val * 90), NULL);
- mus_snprintf(beta_number_buffer, 11, "beta: %.3f", val);
- set_label(beta_number, beta_number_buffer);
-}
-
-
-void set_fft_window_beta(mus_float_t val)
-{
- in_set_fft_window_beta(val);
- chans_field(FCP_BETA, val);
- if (transform_dialog)
- {
- set_beta_scale(val);
- get_fft_window_data();
- if (XtIsManaged(transform_dialog))
- graph_redisplay();
- }
- if (!(ss->graph_hook_active))
- for_each_chan(calculate_fft);
-}
-
-
-
-/* ---------------- spectrum start/end ---------------- */
-
-static void chans_spectrum_changed(chan_info *cp)
-{
- cp->fft_changed = FFT_CHANGE_LOCKED;
- update_graph(cp);
-}
-
-static void set_spectrum_start_scale(mus_float_t val)
-{
- char start_number_buffer[11];
- XtVaSetValues(start_scale, XmNvalue, (int)(val * 90), NULL);
- mus_snprintf(start_number_buffer, 11, "start:%.3f", val);
- set_label(start_number, start_number_buffer);
-}
-
-
-static void check_spectrum_start(mus_float_t end)
-{
- /* don't display chans, but do reset if necessary */
- if (spectrum_start(ss) > end)
- {
- in_set_spectrum_start(end);
- if (transform_dialog)
- set_spectrum_start_scale(end);
- chans_field(FCP_SPECTRUM_START, end);
- }
-}
-
-static void check_spectrum_end(mus_float_t start);
-
-void set_spectrum_start(mus_float_t val)
-{
- if (transform_dialog)
- set_spectrum_start_scale(val);
- in_set_spectrum_start(val);
- check_spectrum_end(val);
- chans_field(FCP_SPECTRUM_START, val);
- for_each_chan(chans_spectrum_changed);
-}
-
-
-static void start_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- char start_number_buffer[11];
- mus_float_t start;
-
- start = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
- mus_snprintf(start_number_buffer, 11, "start:%.3f", start);
- set_label(start_number, start_number_buffer);
-
- in_set_spectrum_start(start);
- check_spectrum_end(start);
- chans_field(FCP_SPECTRUM_START, start);
- for_each_chan(chans_spectrum_changed);
-}
-
-
-static void set_spectrum_end_scale(mus_float_t val)
-{
- char end_number_buffer[11];
- XtVaSetValues(end_scale, XmNvalue, (int)(val * 90), NULL);
- mus_snprintf(end_number_buffer, 11, "end: %.3f", val);
- set_label(end_number, end_number_buffer);
-}
-
-static void check_spectrum_end(mus_float_t start)
-{
- /* don't display chans, but do reset if necessary */
- if (spectrum_end(ss) < start)
- {
- in_set_spectrum_end(start);
- if (transform_dialog)
- set_spectrum_end_scale(start);
- chans_field(FCP_SPECTRUM_END, start);
- }
-}
-
-
-void set_spectrum_end(mus_float_t val)
-{
- if (transform_dialog)
- set_spectrum_end_scale(val);
- in_set_spectrum_end(val);
- check_spectrum_start(val);
- chans_field(FCP_SPECTRUM_END, val);
- for_each_chan(chans_spectrum_changed);
-}
-
-
-static void end_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- char end_number_buffer[11];
- mus_float_t end;
-
- end = (((XmScrollBarCallbackStruct *)info)->value) / 90.0;
- mus_snprintf(end_number_buffer, 11, "end: %.3f", end);
- set_label(end_number, end_number_buffer);
-
- in_set_spectrum_end(end);
- check_spectrum_start(end);
- chans_field(FCP_SPECTRUM_END, end);
- for_each_chan(chans_spectrum_changed);
-}
-
-
-
-/* ---------------- dialog buttons etc ---------------- */
-
-static void graph_resize_callback(Widget w, XtPointer context, XtPointer info)
-{
- graph_redisplay();
-}
-
-
-static void dismiss_transform_callback(Widget w, XtPointer context, XtPointer info)
-{
- Widget active_widget;
- active_widget = XmGetFocusWidget(transform_dialog);
- if (active_widget == XmMessageBoxGetChild(transform_dialog, XmDIALOG_OK_BUTTON))
- XtUnmanageChild(transform_dialog);
-}
-
-
-static void color_orientation_callback(Widget w, XtPointer context, XtPointer info)
-{
- start_color_orientation_dialog(true);
-}
-
-
-static void help_transform_callback(Widget w, XtPointer context, XtPointer info)
-{
- transform_dialog_help();
-}
-
-
-static void fft_blue_textfield_unfocus_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtVaSetValues(w, XmNbackground, ss->lighter_blue, NULL);
- XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
-}
-
-
-static void fft_blue_mouse_leave_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- XtVaSetValues(w, XmNbackground, ss->lighter_blue, NULL);
- XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
-}
-
-
-static void fft_white_mouse_enter_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- XtVaSetValues(w, XmNbackground, ss->text_focus_color, NULL);
- XtVaSetValues(w, XmNcursorPositionVisible, true, NULL);
-}
-
-
-
-/* ---------------- transform options dialog ---------------- */
-
-#define FRAME_BORDER_WIDTH 6
-
-static bool need_callback = true;
-
-Widget fire_up_transform_dialog(bool managed)
-{
- if (!transform_dialog)
- {
- Widget mainform, type_frame, type_form, type_label, size_frame, size_form, size_label, display_frame, display_form, display_label;
- Widget window_frame, window_form, window_label, wavelet_frame, wavelet_form, wavelet_label, graph_frame, graph_form, gsep;
- Widget ab_form, ab_frame, ab_title, ab_sep;
- Widget se_form, se_frame, se_title, se_sep;
- XmString s1;
- XmString xhelp, xdismiss, xtitle, bstr, xorient;
- Arg args[32];
- XmString sizes[NUM_TRANSFORM_SIZES];
- XmString wavelets[NUM_WAVELETS];
- XmString windows[MUS_NUM_FFT_WINDOWS];
- XGCValues gv;
- XtCallbackList n1, n2, n3, n4;
- int size_pos = 1;
- int n, i;
-
- for (i = 0; i < NUM_TRANSFORM_SIZES; i++)
- if (transform_sizes[i] == transform_size(ss))
- {
- size_pos = i + 1;
- break;
- }
- xdismiss = XmStringCreateLocalized((char *)"Go Away"); /* needed by template dialog */
- xhelp = XmStringCreateLocalized((char *)"Help");
- xtitle = XmStringCreateLocalized((char *)"Transform Options");
- xorient = XmStringCreateLocalized((char *)"Color/Orientation");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNcancelLabelString, xorient); n++;
- XtSetArg(args[n], XmNokLabelString, xdismiss); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, xtitle); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- transform_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Transform Options", args, n);
-
- XtAddCallback(transform_dialog, XmNcancelCallback, color_orientation_callback, NULL);
- XtAddCallback(transform_dialog, XmNokCallback, dismiss_transform_callback, NULL);
- XtAddCallback(transform_dialog, XmNhelpCallback, help_transform_callback, NULL);
- XmStringFree(xhelp);
- XmStringFree(xdismiss);
- XmStringFree(xtitle);
- XmStringFree(xorient);
-
- XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(transform_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(transform_dialog, XmDIALOG_SEPARATOR)); n++;
- mainform = XtCreateManagedWidget("mainform", xmFormWidgetClass, transform_dialog, args, n);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 2); n++;
- error_frame = XtCreateManagedWidget("error-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- error_label = XtCreateManagedWidget("", xmLabelWidgetClass, error_frame, args, n);
-
-
- /* now 7 or 8 boxes within the main box:
-
- type (list) | size (list) | display (button column)
- wavelet (list) | window (list) | graph (fft?) of current window
- alpha/beta ------------------------ |
- start/end ------------------------- |
-
- each box has a frame, label, and contents
- */
-
- /* -------- SPECTRUM START/END -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 60); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- se_frame = XtCreateManagedWidget("se-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- se_form = XtCreateManagedWidget("se-form", xmFormWidgetClass, se_frame, args, n);
- /* needed because XmFrame only accepts one child */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- se_title = XtCreateManagedWidget("spectrum start/end", xmLabelWidgetClass, se_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, se_title); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- se_sep = XtCreateManagedWidget("se_sep", xmSeparatorWidgetClass, se_form, args, n);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"start:0.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, se_sep); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- start_number = XtCreateManagedWidget("start-number", xmLabelWidgetClass, se_form, args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, start_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, start_number); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, 100); n++;
- XtSetArg(args[n], XmNvalue, 0); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNdragCallback, n3 = make_callback_list(start_drag_callback, NULL)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n3); n++;
- start_scale = XtCreateManagedWidget("start-scale", xmScrollBarWidgetClass, se_form, args, n);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"end: 1.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, start_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- end_number = XtCreateManagedWidget("end-number", xmLabelWidgetClass, se_form, args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, end_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, end_number); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, 100); n++;
- XtSetArg(args[n], XmNvalue, 90); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNdragCallback, n4 = make_callback_list(end_drag_callback, NULL)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n4); n++;
- end_scale = XtCreateManagedWidget("end-scale", xmScrollBarWidgetClass, se_form, args, n);
-
-
-
- /* -------- WINDOW ALPHA/BETA -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 60); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, se_frame); n++;
- XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- ab_frame = XtCreateManagedWidget("ab-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- ab_form = XtCreateManagedWidget("ab-form", xmFormWidgetClass, ab_frame, args, n);
- /* needed because XmFrame only accepts one child */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- ab_title = XtCreateManagedWidget("window parameter", xmLabelWidgetClass, ab_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, ab_title); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- ab_sep = XtCreateManagedWidget("ab_sep", xmSeparatorWidgetClass, ab_form, args, n);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"alpha:0.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, ab_sep); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- alpha_number = XtCreateManagedWidget("alpha-number", xmLabelWidgetClass, ab_form, args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, alpha_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, alpha_number); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, 100); n++;
- XtSetArg(args[n], XmNvalue, 0); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
-
- XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(alpha_drag_callback, NULL)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n1); n++;
- alpha_scale = XtCreateManagedWidget("alpha-scale", xmScrollBarWidgetClass, ab_form, args, n);
-
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"beta: 0.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, alpha_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- beta_number = XtCreateManagedWidget("beta-number", xmLabelWidgetClass, ab_form, args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, beta_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, beta_number); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, 100); n++;
- XtSetArg(args[n], XmNvalue, 0); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
-
- XtSetArg(args[n], XmNdragCallback, n2 = make_callback_list(beta_drag_callback, NULL)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n2); n++;
- beta_scale = XtCreateManagedWidget("beta-scale", xmScrollBarWidgetClass, ab_form, args, n);
-
-
- /* -------- WINDOW -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 30); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNtopPosition, 35); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, ab_frame); n++;
- XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- window_frame = XtCreateManagedWidget("window-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- window_form = XtCreateManagedWidget("window-form", xmFormWidgetClass, window_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- window_label = XtCreateManagedWidget("window", xmLabelWidgetClass, window_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomWidget, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, window_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopItemPosition, ((int)fft_window(ss) > 2) ? ((int)fft_window(ss) - 1) : ((int)fft_window(ss) + 1)); n++;
- window_list = XmCreateScrolledList(window_form, (char *)"window-list", args, n);
-
- XtVaSetValues(window_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- for (i = 0; i < MUS_NUM_FFT_WINDOWS; i++)
- windows[i] = XmStringCreateLocalized((char *)mus_fft_window_name((mus_fft_window_t)i));
-
- XtVaSetValues(window_list,
- XmNitems, windows,
- XmNitemCount, MUS_NUM_FFT_WINDOWS,
- XmNvisibleItemCount, 8,
- NULL);
- for (i = 0; i < MUS_NUM_FFT_WINDOWS; i++)
- XmStringFree(windows[i]);
-
- XtManageChild(window_list);
- XtAddCallback(window_list, XmNbrowseSelectionCallback, window_browse_callback, NULL);
-
-
- /* -------- WAVELET -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, window_frame); n++;
-
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 60); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNtopPosition, 35); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, ab_frame); n++;
- XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- wavelet_frame = XtCreateManagedWidget("wavelet-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- wavelet_form = XtCreateManagedWidget("wavelet-form", xmFormWidgetClass, wavelet_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- wavelet_label = XtCreateManagedWidget("wavelet", xmLabelWidgetClass, wavelet_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomWidget, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, wavelet_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- wavelet_list = XmCreateScrolledList(wavelet_form, (char *)"wavelet-list", args, n);
-
- XtVaSetValues(wavelet_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- for (i = 0; i < NUM_WAVELETS; i++)
- wavelets[i] = XmStringCreateLocalized((char *)wavelet_name(i));
-
- XtVaSetValues(wavelet_list,
- XmNitems, wavelets,
- XmNitemCount, NUM_WAVELETS,
- XmNvisibleItemCount, 8,
- NULL);
- for (i = 0; i < NUM_WAVELETS; i++)
- XmStringFree(wavelets[i]);
-
- XtManageChild(wavelet_list);
- XtAddCallback(wavelet_list, XmNbrowseSelectionCallback, wavelet_browse_callback, NULL);
-
-
- /* -------- TRANSFORM TYPE -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 30); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNbottomPosition, 35); n++;
- XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- type_frame = XtCreateManagedWidget("type-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- type_form = XtCreateManagedWidget("type-form", xmFormWidgetClass, type_frame, args, n);
- /* needed because XmFrame only accepts one child */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- type_label = XtCreateManagedWidget("type", xmLabelWidgetClass, type_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, type_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- type_list = XmCreateScrolledList(type_form, (char *)"type-list", args, n);
-
- XtVaSetValues(type_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- make_transform_type_list();
-
- XtManageChild(type_list);
- XtAddCallback(type_list, XmNbrowseSelectionCallback, transform_type_browse_callback, NULL);
-
-
- /* -------- SIZE -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, type_frame); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 60); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, type_frame); n++;
- XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- size_frame = XtCreateManagedWidget("size-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- size_form = XtCreateManagedWidget("size-form", xmFormWidgetClass, size_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- size_label = XtCreateManagedWidget("size", xmLabelWidgetClass, size_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, size_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopItemPosition, (size_pos > 2) ? (size_pos - 2) : size_pos); n++;
- size_list = XmCreateScrolledList(size_form, (char *)"size-list", args, n);
-
- XtVaSetValues(size_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- for (i = 0; i < NUM_TRANSFORM_SIZES; i++)
- sizes[i] = XmStringCreateLocalized((char *)transform_size_names[i]);
-
- XtVaSetValues(size_list,
- XmNitems, sizes,
- XmNitemCount, NUM_TRANSFORM_SIZES,
- XmNvisibleItemCount, 6,
- NULL);
- for (i = 0; i < NUM_TRANSFORM_SIZES; i++)
- XmStringFree(sizes[i]);
-
- XtManageChild(size_list);
- XtAddCallback(size_list, XmNbrowseSelectionCallback, size_browse_callback, NULL);
-
-
- /* -------- DISPLAY BOX BUTTONS -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, size_frame); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- display_frame = XtCreateManagedWidget("display-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
- n = attach_all_sides(args, n);
- display_form = XtCreateManagedWidget("display-form", xmFormWidgetClass, display_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- display_label = XtCreateManagedWidget("display", xmLabelWidgetClass, display_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"single transform");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, display_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
- normo_button = make_togglebutton_widget("normo-button", display_form, args, n);
- XtAddCallback(normo_button, XmNdisarmCallback, graph_transform_once_callback, NULL);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"sonogram");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, normo_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
- sono_button = make_togglebutton_widget("sono-button", display_form, args, n);
- XtAddCallback(sono_button, XmNdisarmCallback, sonogram_callback, NULL);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"spectrogram");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sono_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
- spectro_button = make_togglebutton_widget("spectro-button", display_form, args, n);
- XtAddCallback(spectro_button, XmNdisarmCallback, spectrogram_callback, NULL);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"peaks");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 67); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, spectro_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- peaks_button = make_togglebutton_widget("peaks-button", display_form, args, n);
- XtAddCallback(peaks_button, XmNvalueChangedCallback, peaks_callback, NULL);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNresizeWidth, false); n++;
- XtSetArg(args[n], XmNcolumns, 6); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- /* XtSetArg(args[n], XmNmarginHeight, 1); n++; */
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, peaks_button); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, peaks_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, peaks_button); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- peak_txt = make_textfield_widget("max-peaks", display_form, args, n, ACTIVATABLE, NO_COMPLETER);
- XtRemoveCallback(peak_txt, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- XtAddCallback(peak_txt, XmNlosingFocusCallback, fft_blue_textfield_unfocus_callback, NULL);
- XtAddEventHandler(peak_txt, LeaveWindowMask, false, fft_blue_mouse_leave_text_callback, NULL);
- XtAddEventHandler(peak_txt, EnterWindowMask, false, fft_white_mouse_enter_text_callback, NULL);
- widget_int_to_text(peak_txt, max_transform_peaks(ss));
- XtAddCallback(peak_txt, XmNactivateCallback, peaks_activate_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"dB");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 67); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, peaks_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- db_button = make_togglebutton_widget("db-button", display_form, args, n);
- XtAddCallback(db_button, XmNvalueChangedCallback, fft_db_callback, NULL);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNresizeWidth, false); n++;
- XtSetArg(args[n], XmNcolumns, 6); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- /* XtSetArg(args[n], XmNmarginHeight, 1); n++; */
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, db_button); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, db_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, db_button); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- db_txt = make_textfield_widget("db", display_form, args, n, ACTIVATABLE, NO_COMPLETER);
- XtRemoveCallback(db_txt, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- XtAddCallback(db_txt, XmNlosingFocusCallback, fft_blue_textfield_unfocus_callback, NULL);
- XtAddEventHandler(db_txt, LeaveWindowMask, false, fft_blue_mouse_leave_text_callback, NULL);
- XtAddEventHandler(db_txt, EnterWindowMask, false, fft_white_mouse_enter_text_callback, NULL);
- widget_float_to_text(db_txt, min_dB(ss));
- XtAddCallback(db_txt, XmNactivateCallback, min_db_activate_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"log freq");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 67); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, db_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- logfreq_button = make_togglebutton_widget("logfreq-button", display_form, args, n);
- XtAddCallback(logfreq_button, XmNvalueChangedCallback, logfreq_callback, NULL);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNresizeWidth, false); n++;
- XtSetArg(args[n], XmNcolumns, 6); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- /* XtSetArg(args[n], XmNmarginHeight, 1); n++; */
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, logfreq_button); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, logfreq_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, logfreq_button); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- freq_base_txt = make_textfield_widget("lfb", display_form, args, n, ACTIVATABLE, NO_COMPLETER);
- XtRemoveCallback(freq_base_txt, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- XtAddCallback(freq_base_txt, XmNlosingFocusCallback, fft_blue_textfield_unfocus_callback, NULL);
- XtAddEventHandler(freq_base_txt, LeaveWindowMask, false, fft_blue_mouse_leave_text_callback, NULL);
- XtAddEventHandler(freq_base_txt, EnterWindowMask, false, fft_white_mouse_enter_text_callback, NULL);
- widget_float_to_text(freq_base_txt, log_freq_start(ss));
- XtAddCallback(freq_base_txt, XmNactivateCallback, log_freq_start_activate_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"normalize");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, logfreq_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- normalize_button = make_togglebutton_widget("normalize-button", display_form, args, n);
- XtAddCallback(normalize_button, XmNvalueChangedCallback, normalize_callback, NULL);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"selection");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, normalize_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- selection_button = make_togglebutton_widget("selection-button", display_form, args, n);
- XtAddCallback(selection_button, XmNvalueChangedCallback, selection_callback, NULL);
- XmStringFree(bstr);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"with phases");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, selection_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- phases_button = make_togglebutton_widget("phases-button", display_form, args, n);
- XtAddCallback(phases_button, XmNvalueChangedCallback, phases_callback, NULL);
- XmStringFree(bstr);
-
-
-
- /* -------- GRAPH -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, wavelet_frame); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, display_frame); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNborderWidth, FRAME_BORDER_WIDTH); n++;
- XtSetArg(args[n], XmNborderColor, ss->basic_color); n++;
- graph_frame = XtCreateManagedWidget("graph-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- graph_form = XtCreateManagedWidget("graph-form", xmFormWidgetClass, graph_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- graph_label = XtCreateManagedWidget("window", xmLabelWidgetClass, graph_form, args, n);
- /* label should change according to what is being displayed */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, graph_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- gsep = XtCreateManagedWidget("gsep", xmSeparatorWidgetClass, graph_form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->graph_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, gsep); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- graph_drawer = XtCreateManagedWidget("graph-drawer", xmDrawingAreaWidgetClass, graph_form, args, n);
-
- gv.function = GXcopy;
- XtVaGetValues(graph_drawer, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
- gc = XtGetGC(graph_drawer, GCForeground | GCFunction, &gv);
-
- gv.foreground = ss->enved_waveform_color;
- fgc = XtGetGC(graph_drawer, GCForeground | GCFunction, &gv);
-
- XmToggleButtonSetState(normo_button, (Boolean)(transform_graph_type(ss) == GRAPH_ONCE), false);
- XmToggleButtonSetState(sono_button, (Boolean)(transform_graph_type(ss) == GRAPH_AS_SONOGRAM), false);
- XmToggleButtonSetState(spectro_button, (Boolean)(transform_graph_type(ss) == GRAPH_AS_SPECTROGRAM), false);
- XmToggleButtonSetState(peaks_button, (Boolean)(show_transform_peaks(ss)), false);
- XmToggleButtonSetState(db_button, (Boolean)(fft_log_magnitude(ss)), false);
- XmToggleButtonSetState(logfreq_button, (Boolean)(fft_log_frequency(ss)), false);
- XmToggleButtonSetState(normalize_button, (Boolean)(transform_normalization(ss) != DONT_NORMALIZE), false);
- XmToggleButtonSetState(selection_button, (Boolean)(show_selection_transform(ss)), false);
- XmToggleButtonSetState(phases_button, (Boolean)(fft_with_phases(ss)), false);
-
- /* select current list choices */
- /* display current windowing choice unless wavelet in force */
-
- XmListSelectPos(type_list, transform_type_to_position(transform_type(ss)) + 1, false);
- XmListSelectPos(wavelet_list, wavelet_type(ss) + 1, false);
- XmListSelectPos(size_list, size_pos, false);
- XmListSelectPos(window_list, (int)fft_window(ss) + 1, false);
-
- if (spectrum_start(ss) != 0.0) set_spectrum_start_scale(spectrum_start(ss));
- if (spectrum_end(ss) != 1.0) set_spectrum_end_scale(spectrum_end(ss));
- if (fft_window_alpha(ss) != 0.0) set_alpha_scale(fft_window_alpha(ss));
- if (fft_window_beta(ss) != 0.0) set_beta_scale(fft_window_beta(ss));
-
- highlight_alpha_beta_scales(fft_window(ss));
-
- free(n1);
- free(n2);
- free(n3);
- free(n4);
-
- set_dialog_widget(TRANSFORM_DIALOG, transform_dialog);
-
- XtUnmanageChild(error_frame);
- }
- else
- {
- if (managed)
- raise_dialog(transform_dialog);
- }
- if (managed)
- {
- if (!XtIsManaged(transform_dialog))
- XtManageChild(transform_dialog);
- }
- else XtUnmanageChild(transform_dialog);
- if ((need_callback) && (XtIsManaged(transform_dialog)))
- {
- set_label(graph_label, mus_fft_window_name(fft_window(ss)));
- get_fft_window_data();
- XtAddCallback(graph_drawer, XmNresizeCallback, graph_resize_callback, NULL);
- XtAddCallback(graph_drawer, XmNexposeCallback, graph_resize_callback, NULL);
- need_callback = false;
- }
- return(transform_dialog);
-}
-
-
-bool transform_dialog_is_active(void)
-{
- return((transform_dialog) &&
- (XtIsManaged(transform_dialog)));
-}
diff --git a/snd-xfile.c b/snd-xfile.c
deleted file mode 100644
index 539f1f4..0000000
--- a/snd-xfile.c
+++ /dev/null
@@ -1,6894 +0,0 @@
-#include "snd.h"
-#include "snd-file.h"
-
-/* various file-related dialogs:
- File|Edit:Save-as
- File:Open|View
- File|Edit:Mix
- File:Insert
- File:Edit-Header
- File:New
- Info and Raw
- View:Files
-*/
-
-
-#define FSB_BOX(Dialog, Child) XmFileSelectionBoxGetChild(Dialog, Child)
-#define MSG_BOX(Dialog, Child) XmMessageBoxGetChild(Dialog, Child)
-
-
-/* ---------------- open/mix/insert/save-as dialogs ---------------- */
-
-static void color_file_selection_box(Widget w)
-{
- /* overwrite most Motif-default colors */
- Widget wtmp;
-
- map_over_children(w, set_main_color_of_widget);
- XtVaSetValues(FSB_BOX(w, XmDIALOG_DIR_LIST),
- XmNbackground, ss->white,
- XmNforeground, ss->black,
- NULL);
- XtVaSetValues(FSB_BOX(w, XmDIALOG_LIST),
- XmNbackground, ss->white,
- XmNforeground, ss->black,
- NULL);
-
- XtVaSetValues(FSB_BOX(w, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(FSB_BOX(w, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(FSB_BOX(w, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(FSB_BOX(w, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(FSB_BOX(w, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(FSB_BOX(w, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- wtmp = FSB_BOX(w, XmDIALOG_TEXT);
- if (wtmp)
- {
- XtVaSetValues(wtmp, XmNhighlightThickness, 1, NULL);
- XtAddCallback(wtmp, XmNfocusCallback, textfield_focus_callback, NULL);
- XtAddCallback(wtmp, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- XtAddEventHandler(wtmp, EnterWindowMask, false, mouse_enter_text_callback, NULL);
- XtAddEventHandler(wtmp, LeaveWindowMask, false, mouse_leave_text_callback, NULL);
- }
-
- wtmp = FSB_BOX(w, XmDIALOG_FILTER_TEXT);
- if (wtmp)
- {
- XtVaSetValues(wtmp, XmNhighlightThickness, 1, NULL);
- XtAddCallback(wtmp, XmNfocusCallback, textfield_focus_callback, NULL);
- XtAddCallback(wtmp, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- XtAddEventHandler(wtmp, EnterWindowMask, false, mouse_enter_text_callback, NULL);
- XtAddEventHandler(wtmp, LeaveWindowMask, false, mouse_leave_text_callback, NULL);
- }
-}
-
-
-static void force_directory_reread(Widget dialog)
-{
- /* force update, but make sure the filename is not reset to its (dumb) default */
- XmString dirmask;
- Widget name_field;
- char *filename = NULL;
- name_field = FSB_BOX(dialog, XmDIALOG_TEXT);
- filename = XmTextGetString(name_field);
- XtVaGetValues(dialog, XmNdirMask, &dirmask, NULL);
- XmFileSelectionDoSearch(dialog, dirmask);
- XmStringFree(dirmask);
- XmTextSetString(name_field, filename);
- if (filename)
- {
- XmTextSetCursorPosition(name_field, mus_strlen(filename));
- XtFree(filename);
- }
-}
-
-
-static void force_directory_reread_and_let_filename_change(Widget dialog)
-{
- XmString dirmask;
- XtVaGetValues(dialog, XmNdirMask, &dirmask, NULL);
- XmFileSelectionDoSearch(dialog, dirmask);
- XmStringFree(dirmask);
-}
-
-
-
-/* -------- popups -------- */
-
-/* I think there is no way to get a key action to popup one of these menus -- Xm/RowColumn.c
- * appears to insist on a button event, and any change to that via XmNmenuPost gets an
- * error. Perhaps we should notice the POPUP_BUTTON setting however?
- */
-
-typedef struct file_pattern_info {
- /* just-sounds file lists */
- bool reread_directory;
- bool in_just_sounds_update;
- Widget dialog, just_sounds_button;
- char *last_dir;
- dir_info *current_files;
- fam_info *directory_watcher;
- int filter_choice, sorter_choice;
- dirpos_list *dir_list;
-} file_pattern_info;
-
-/* popups:
- * text: history of previous choices,
- * list: sort and filter choices
- * dir: higher level dir choices
- * filter: history of previous choices
- */
-
-typedef struct file_popup_info {
- Widget dialog;
- Widget file_text_popup, file_list_popup, file_dir_popup, file_filter_popup;
- Widget file_text_popup_label, file_filter_popup_label, file_dir_popup_label, file_list_popup_label;
- /* file_filter here refers to the dialog filter field, not file-filters */
- char **file_text_names, **file_filter_names; /* history of choices as array of strings */
- Widget *file_text_items, *file_filter_items, *file_dir_items, *file_list_items; /* menu items */
- int file_list_items_size;
- file_pattern_info *fp;
-} file_popup_info;
-
-
-/* file popup */
-static void file_text_item_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- char *filename;
- snd_info *sp;
- filename = get_label(w);
- XmTextFieldSetString(FSB_BOX(fd->dialog, XmDIALOG_TEXT), filename);
-
- ss->open_requestor = FROM_OPEN_DIALOG_POPUP;
- ss->open_requestor_data = NULL;
- sp = snd_open_file(filename, FILE_READ_WRITE);
- if (sp) select_channel(sp, 0);
-
- XtUnmanageChild(fd->dialog);
- if (filename) XtFree(filename);
-}
-
-
-#define FILE_TEXT_POPUP_LABEL "previous files"
-
-static void file_text_popup_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
- XEvent *e;
- e = cb->event;
- if (e->type == ButtonPress)
- {
- /* position menu to match current text widget, show previous choices, if any else "[no previous choices]" */
- /* XmMenuPosition(popup_menu, event) happens automatically */
- /* should max len be user-var? history-length? (replace minibuffer-history-length?) */
-
- char *current_filename;
- int i, filenames_to_display = 0;
-
- if (fd->file_text_items == NULL)
- {
- int n = 0;
- Arg args[12];
- fd->file_text_items = (Widget *)calloc(FILENAME_LIST_SIZE, sizeof(Widget));
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- for (i = 0; i < FILENAME_LIST_SIZE; i++)
- {
- fd->file_text_items[i] = XtCreateWidget("", xmPushButtonWidgetClass, fd->file_text_popup, args, n);
- XtAddCallback(fd->file_text_items[i], XmNactivateCallback, file_text_item_activate_callback, (void *)fd);
- }
- }
-
- current_filename = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_TEXT));
- /* w is probably ok here (assumes only text triggers this) */
-
- for (i = 0; i < FILENAME_LIST_SIZE; i++)
- if ((fd->file_text_names[i]) &&
- (mus_file_probe(fd->file_text_names[i])) &&
- (!(mus_strcmp(fd->file_text_names[i], current_filename))))
- {
- set_label(fd->file_text_items[filenames_to_display], fd->file_text_names[i]);
- XtManageChild(fd->file_text_items[filenames_to_display]);
- filenames_to_display++;
- }
-
- for (i = filenames_to_display; i < FILENAME_LIST_SIZE; i++)
- if ((fd->file_text_items[i]) &&
- (XtIsManaged(fd->file_text_items[i])))
- XtUnmanageChild(fd->file_text_items[i]);
- XtFree(current_filename);
-
- /* why was this commented out? */
- if (filenames_to_display == 0)
- set_label(fd->file_text_popup_label, "no " FILE_TEXT_POPUP_LABEL);
- else set_label(fd->file_text_popup_label, FILE_TEXT_POPUP_LABEL);
-
- cb->menuToPost = fd->file_text_popup;
- }
-}
-
-
-/* filter popup */
-static void file_filter_text_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- char *filter;
- filter = XmTextFieldGetString(w);
- if (filter)
- {
- remember_filename(filter, fd->file_filter_names);
- XtFree(filter);
- force_directory_reread_and_let_filename_change(fd->dialog);
- }
-}
-
-
-static void file_filter_item_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- Widget text;
- char *filtername;
- filtername = get_label(w);
- text = FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT);
- XmTextFieldSetString(text, filtername);
- force_directory_reread(fd->dialog);
- if (filtername) XtFree(filtername);
-}
-
-
-#define FILE_FILTER_POPUP_LABEL "previous filters"
-
-static void file_filter_popup_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
- XEvent *e;
- e = cb->event;
- if (e->type == ButtonPress)
- {
- char *current_filtername;
- int i, filternames_to_display = 0;
-
- if (fd->file_filter_items == NULL)
- {
- int n = 0;
- Arg args[12];
- fd->file_filter_items = (Widget *)calloc(FILENAME_LIST_SIZE, sizeof(Widget));
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- for (i = 0; i < FILENAME_LIST_SIZE; i++)
- {
- fd->file_filter_items[i] = XtCreateWidget("", xmPushButtonWidgetClass, fd->file_filter_popup, args, n);
- XtAddCallback(fd->file_filter_items[i], XmNactivateCallback, file_filter_item_activate_callback, (void *)fd);
- }
- }
-
- current_filtername = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT));
-
- for (i = 0; i < FILENAME_LIST_SIZE; i++)
- if ((fd->file_filter_names[i]) &&
- (!(mus_strcmp(fd->file_filter_names[i], current_filtername))))
- {
- set_label(fd->file_filter_items[filternames_to_display], fd->file_filter_names[i]);
- XtManageChild(fd->file_filter_items[filternames_to_display]);
- filternames_to_display++;
- }
-
- for (i = filternames_to_display; i < FILENAME_LIST_SIZE; i++)
- if ((fd->file_filter_items[i]) &&
- (XtIsManaged(fd->file_filter_items[i])))
- XtUnmanageChild(fd->file_filter_items[i]);
- XtFree(current_filtername);
- /*
- if (filternames_to_display == 0)
- set_label(fd->file_filter_popup_label, "no " FILE_FILTER_POPUP_LABEL);
- else set_label(fd->file_filter_popup_label, FILE_FILTER_POPUP_LABEL);
- */
- cb->menuToPost = fd->file_filter_popup;
- }
-}
-
-
-/* dir list popup */
-
-static void update_dir_list(Widget dialog, char *filter)
-{
- Widget text;
- text = FSB_BOX(dialog, XmDIALOG_FILTER_TEXT);
- XmTextFieldSetString(text, filter);
- force_directory_reread(dialog);
-}
-
-
-static void file_dir_item_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- char *name, *filter;
- name = get_label(w);
- filter = mus_format("%s/*", name);
- update_dir_list(fd->dialog, filter);
- if (name) XtFree(name);
- free(filter);
-}
-
-
-#define FILE_DIR_POPUP_LABEL "dirs"
-
-/* dir_items, but strs generated on the fly, current in filter text */
-
-static void file_dir_popup_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
- XEvent *e;
- e = cb->event;
- if (e->type == ButtonPress)
- {
- char *current_filename = NULL;
- int i, dirs_to_display = 0, len = 0;
-
- if (fd->file_dir_items == NULL)
- {
- int n = 0;
- Arg args[12];
- fd->file_dir_items = (Widget *)calloc(FILENAME_LIST_SIZE, sizeof(Widget));
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- for (i = 0; i < FILENAME_LIST_SIZE; i++)
- {
- fd->file_dir_items[i] = XtCreateWidget("", xmPushButtonWidgetClass, fd->file_dir_popup, args, n);
- XtAddCallback(fd->file_dir_items[i], XmNactivateCallback, file_dir_item_activate_callback, (void *)fd);
- }
- }
-
- {
- XmStringTable items;
- int num_dirs;
- XtVaGetValues(fd->dialog, XmNdirListItems, &items, XmNdirListItemCount, &num_dirs, NULL);
- if (num_dirs > 0)
- current_filename = (char *)XmStringUnparse(items[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- }
- if (!current_filename)
- {
- current_filename = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT));
- if (!current_filename)
- current_filename = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_TEXT));
- }
-
- if (current_filename)
- {
- len = strlen(current_filename);
- for (i = 0; i < len; i++)
- if (current_filename[i] == '/')
- dirs_to_display++;
-
- if (dirs_to_display > FILENAME_LIST_SIZE)
- dirs_to_display = FILENAME_LIST_SIZE;
-
- if (dirs_to_display > 0)
- {
- char **dirs;
- int j = 1;
- dirs = (char **)calloc(dirs_to_display, sizeof(char *));
- dirs[0] = mus_strdup("/");
- for (i = 1; i < len; i++)
- if (current_filename[i] == '/')
- {
- dirs[j] = (char *)calloc(i + 1, sizeof(char));
- strncpy(dirs[j], (const char *)current_filename, i);
- j++;
- }
-
- for (i = 0; i < dirs_to_display; i++)
- {
- set_label(fd->file_dir_items[i], dirs[i]);
- XtManageChild(fd->file_dir_items[i]);
- free(dirs[i]);
- }
- free(dirs);
- }
- }
-
- for (i = dirs_to_display; i < FILENAME_LIST_SIZE; i++)
- if ((fd->file_dir_items[i]) &&
- (XtIsManaged(fd->file_dir_items[i])))
- XtUnmanageChild(fd->file_dir_items[i]);
- XtFree(current_filename);
-
- cb->menuToPost = fd->file_dir_popup;
- }
-}
-
-
-#define FILE_LIST_POPUP_LABEL "sort/filter"
-#define NO_FILTER_LABEL "no filter"
-
-#define FILE_FILTER_OFFSET 1024
-#define NO_FILE_FILTER_OFFSET 2048
-
-static void sort_files_and_redisplay(file_pattern_info *fp);
-
-
-static void file_list_item_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- pointer_or_int_t data;
- int choice;
- XtVaGetValues(w, XmNuserData, &data, NULL);
- choice = (int)data;
- if (choice >= FILE_FILTER_OFFSET)
- {
- XmToggleButtonSetState(fd->fp->just_sounds_button, false, false);
- if (choice == NO_FILE_FILTER_OFFSET)
- fd->fp->filter_choice = NO_FILE_FILTER;
- else fd->fp->filter_choice = choice - FILE_FILTER_OFFSET + 2;
- fd->fp->in_just_sounds_update = true;
- force_directory_reread(fd->fp->dialog);
- fd->fp->in_just_sounds_update = false;
- }
- else
- {
- fd->fp->sorter_choice = choice;
- sort_files_and_redisplay(fd->fp);
- }
-}
-
-
-static Widget make_file_list_item(file_popup_info *fd, int choice)
-{
- int n;
- Arg args[12];
- const char *item_label;
- Widget w;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
-
- switch (choice)
- {
- case 0: item_label = "a..z"; break;
- case 1: item_label = "z..a"; break;
- case 2: item_label = "new..old"; break;
- case 3: item_label = "old..new"; break;
- case 4: item_label = "small..big"; break;
- case 5: item_label = "big..small"; break;
- default: item_label = "unused"; break;
- }
-
- XtSetArg(args[n], XmNuserData, choice); /* userData is index into sorters list */
- w = XtCreateManagedWidget(item_label, xmPushButtonWidgetClass, fd->file_list_popup, args, n + 1);
- XtAddCallback(w, XmNactivateCallback, file_list_item_activate_callback, (void *)fd);
- return(w);
-}
-
-
-static void file_list_popup_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_popup_info *fd = (file_popup_info *)context;
- XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
- XEvent *e;
- e = cb->event;
- if (e->type == ButtonPress)
- {
- int i, items_len;
- if (fd->file_list_items == NULL)
- {
- /* set up the default menu items */
-
- fd->file_list_items = (Widget *)calloc(SORT_XEN, sizeof(Widget));
- fd->file_list_items_size = SORT_XEN;
-
- for (i = 0; i < SORT_XEN; i++)
- fd->file_list_items[i] = make_file_list_item(fd, i);
- }
-
- /* clear any trailers just in case */
- if (fd->file_list_items_size > SORT_XEN)
- for (i = SORT_XEN; i < fd->file_list_items_size; i++)
- XtUnmanageChild(fd->file_list_items[i]);
-
- /* check for added sort and filter functions (allocate more items if needed) */
- {
- int extra_sorters = 0, extra_filters = 0;
- for (i = 0; i < ss->file_sorters_size; i++)
- if (!(XEN_FALSE_P(XEN_VECTOR_REF(ss->file_sorters, i))))
- extra_sorters++;
- for (i = 0; i < ss->file_filters_size; i++)
- if (!(XEN_FALSE_P(XEN_VECTOR_REF(ss->file_filters, i))))
- extra_filters++;
-
- items_len = SORT_XEN + extra_sorters + extra_filters;
- if (fd->fp->filter_choice != NO_FILE_FILTER) items_len++;
-
- if (items_len > fd->file_list_items_size)
- {
- fd->file_list_items = (Widget *)realloc(fd->file_list_items, items_len * sizeof(Widget));
- for (i = fd->file_list_items_size; i < items_len; i++)
- fd->file_list_items[i] = make_file_list_item(fd, i);
- fd->file_list_items_size = items_len;
- }
- }
-
- /* make sure all the added sorter labels are correct, bg blue, and items active */
- if (fd->file_list_items_size > SORT_XEN)
- {
- int k = SORT_XEN;
-
- /* sorters */
- for (i = 0; i < ss->file_sorters_size; i++)
- {
- if (!(XEN_FALSE_P(XEN_VECTOR_REF(ss->file_sorters, i))))
- {
- set_label(fd->file_list_items[k], XEN_TO_C_STRING(XEN_CAR(XEN_VECTOR_REF(ss->file_sorters, i))));
- XtVaSetValues(fd->file_list_items[k],
- XmNbackground, ss->lighter_blue,
- XmNuserData, SORT_XEN + i,
- NULL);
- if (!(XtIsManaged(fd->file_list_items[k])))
- XtManageChild(fd->file_list_items[k]);
- k++;
- }
- }
-
- for (i = 0; i < ss->file_filters_size; i++)
- {
- if (!(XEN_FALSE_P(XEN_VECTOR_REF(ss->file_filters, i))))
- {
- set_label(fd->file_list_items[k], XEN_TO_C_STRING(XEN_CAR(XEN_VECTOR_REF(ss->file_filters, i))));
- XtVaSetValues(fd->file_list_items[k], XmNbackground, ss->light_blue,
- XmNuserData, i + FILE_FILTER_OFFSET,
- NULL);
- if (!(XtIsManaged(fd->file_list_items[k])))
- XtManageChild(fd->file_list_items[k]);
- k++;
- }
- }
-
- /* add "no filter" item if currently filtered */
- if (fd->fp->filter_choice != NO_FILE_FILTER)
- {
- set_label(fd->file_list_items[k], NO_FILTER_LABEL);
- XtVaSetValues(fd->file_list_items[k], XmNbackground, ss->light_blue,
- XmNuserData, NO_FILE_FILTER_OFFSET,
- NULL);
- if (!(XtIsManaged(fd->file_list_items[k])))
- XtManageChild(fd->file_list_items[k]);
- }
-
- }
- cb->menuToPost = fd->file_list_popup;
- }
-}
-
-
-static void add_file_popups(file_popup_info *fd)
-{
- int n;
- Arg args[20];
-
- /* from lib/Xm.RCPopup.c:
- * When a user creates a new popup menu then we will install a particular
- * event handler on the menu's widget parent. Along with this we install
- * a grab on the button specified in XmNmenuPost or XmNwhichButton. [XmNmenuPost is a string = translation table syntax, <Btn3Down> is default]
- * [XmNwhichButton is obsolete]
- * The posting algorithm is as follows:
- *
- * 1. On receipt of a posting event, the handler will search the child
- * list for a candidate widget or gadget, and track the most specific
- * popup menu available (these can be found in the popup list). The
- * criteria for a match includes matching the XmNmenuPost information.
- *
- * 2. Matching criteria include:
- *
- * * The menu must have XmNpopupEnabled set to either
- * XmPOPUP_AUTOMATIC or XmPOPUP_AUTOMATIC_RECURSIVE.
- *
- * * The popup menu is chosen according to creation order. If there is
- * more than one, the first correct match is chosen.
- *
- * * If the popup menu is found in a parent of the target widget, and
- * the popup menu must also have XmNpopupEnabled set to
- * XmPOPUP_AUTOMATIC_RECURSIVE to match. [sigh -- no one actually reads comments...]
- *
- * 3. Once a selection is made, if the menu's parent widget has a
- * popupHandlerCallback, it is invoked. The callback allows the user to
- * determine if a more specific menu is necessary, such as would be the
- * case in a graphical manipulation environment, and includes all the
- * necessary information.
- *
- */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNpopupEnabled, XmPOPUP_AUTOMATIC); n++;
-
- /* file text */
- XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_TEXT), XmNpopupHandlerCallback, file_text_popup_callback, (void *)fd);
- fd->file_text_popup = XmCreatePopupMenu(FSB_BOX(fd->dialog, XmDIALOG_TEXT), (char *)"file-text-popup", args, n);
- fd->file_text_names = make_filename_list();
- fd->file_text_popup_label = XtCreateManagedWidget(FILE_TEXT_POPUP_LABEL, xmLabelWidgetClass, fd->file_text_popup, args, n);
- XtCreateManagedWidget("sep", xmSeparatorWidgetClass, fd->file_text_popup, args, n);
-
- /* filter text */
- XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT), XmNpopupHandlerCallback, file_filter_popup_callback, (void *)fd);
- fd->file_filter_popup = XmCreatePopupMenu(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT), (char *)"file-filter-popup", args, n);
- fd->file_filter_names = make_filename_list();
- fd->file_filter_popup_label = XtCreateManagedWidget(FILE_FILTER_POPUP_LABEL, xmLabelWidgetClass, fd->file_filter_popup, args, n);
- XtCreateManagedWidget("sep", xmSeparatorWidgetClass, fd->file_filter_popup, args, n);
- {
- char *startup_filter;
- startup_filter = XmTextFieldGetString(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT));
- if (startup_filter)
- {
- remember_filename(startup_filter, fd->file_filter_names);
- XtFree(startup_filter);
- }
- }
- XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT), XmNactivateCallback, file_filter_text_activate_callback, (void *)fd);
-
- /* file directory */
- XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_DIR_LIST), XmNpopupHandlerCallback, file_dir_popup_callback, (void *)fd);
- fd->file_dir_popup = XmCreatePopupMenu(FSB_BOX(fd->dialog, XmDIALOG_DIR_LIST), (char *)"file-dir-popup", args, n);
- fd->file_dir_popup_label = XtCreateManagedWidget(FILE_DIR_POPUP_LABEL, xmLabelWidgetClass, fd->file_dir_popup, args, n);
- XtCreateManagedWidget("sep", xmSeparatorWidgetClass, fd->file_dir_popup, args, n);
-
- /* file list */
- XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_LIST), XmNpopupHandlerCallback, file_list_popup_callback, (void *)fd);
- fd->file_list_popup = XmCreatePopupMenu(FSB_BOX(fd->dialog, XmDIALOG_LIST), (char *)"file-list-popup", args, n);
- fd->file_list_popup_label = XtCreateManagedWidget(FILE_LIST_POPUP_LABEL, xmLabelWidgetClass, fd->file_list_popup, args, n);
- XtCreateManagedWidget("sep", xmSeparatorWidgetClass, fd->file_list_popup, args, n);
-}
-
-
-
-/* ---------------- just-sounds (file-filters) ---------------- */
-
-static void file_change_directory_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* click in directory list */
- file_pattern_info *fp = (file_pattern_info *)context;
- char *leaving_dir;
-
- {
- /* save current directory list position */
- position_t position = 0;
- XmString *strs;
- char *filename = NULL;
- XtVaGetValues(w,
- XmNtopItemPosition, &position,
- XmNselectedItems, &strs,
- NULL);
- if (position > 1) /* 1 = .. */
- {
- filename = (char *)XmStringUnparse(strs[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- dirpos_update(fp->dir_list, filename, position);
- XtFree(filename);
- }
- }
-
- leaving_dir = mus_strdup(fp->last_dir);
- if ((leaving_dir) &&
- (leaving_dir[strlen(leaving_dir) - 1] == '/'))
- leaving_dir[strlen(leaving_dir) - 1] = 0;
-
- fp->reread_directory = true;
- force_directory_reread_and_let_filename_change(fp->dialog);
- fp->reread_directory = false;
-
- if (leaving_dir)
- {
- position_t pos;
- pos = dirpos_list_top(fp->dir_list, leaving_dir);
- if (pos != POSITION_UNKNOWN)
- XmListSetPos(w, pos);
- free(leaving_dir);
- }
-}
-
-
-#if HAVE_FAM
-static void watch_current_directory_contents(struct fam_info *famp, FAMEvent *fe)
-{
- switch (fe->code)
- {
- case FAMDeleted:
- /* we could simply edit the current_files list here, rather than requesting a full directory read,
- * but I doubt it matters -- directory reads are apparently very fast, and the simplicity is a blessing.
- */
-
- case FAMCreated:
- case FAMMoved:
- if ((!(just_sounds(ss))) ||
- (sound_file_p(fe->filename)))
- {
- file_pattern_info *fp = (file_pattern_info *)(famp->data);
- fp->reread_directory = true;
- if ((fp->dialog) &&
- (XtIsManaged(fp->dialog)))
- {
- force_directory_reread(fp->dialog);
- fp->reread_directory = false;
- }
- }
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-}
-#endif
-
-
-static void sort_files_and_redisplay(file_pattern_info *fp)
-{
- /* if just sorting, no need to read the directory */
- dir_info *cur_dir;
-
- cur_dir = fp->current_files;
- if (cur_dir->len > 0)
- {
- XmString *names;
- int i, new_selected_position = -1;
- char *selected_filename = NULL;
-
- {
- XmString *strs;
- int selections = 0;
- XtVaGetValues(XmFileSelectionBoxGetChild(fp->dialog, XmDIALOG_LIST),
- XmNselectedItems, &strs,
- XmNselectedItemCount, &selections,
- NULL);
- if ((selections > 0) && (strs[0]))
- selected_filename = (char *)XmStringUnparse(strs[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- }
-
- snd_sort(fp->sorter_choice, cur_dir->files, cur_dir->len);
-
- /* here we could use colored text to mark sound files, perhaps different colors for
- * different chans (as in install-searcher-with-colors), but I would rather have
- * used different background colors (less intrusive I think). As far as I can tell,
- * this is impossible given the current XmList widget -- each item is an internal
- * "Element", not a label widget or whatever, and the selection color, for example,
- * is done by hand.
- */
-
- names = (XmString *)calloc(cur_dir->len, sizeof(XmString));
- for (i = 0; i < cur_dir->len; i++)
- {
- names[i] = XmStringCreateLocalized(cur_dir->files[i]->full_filename);
- if ((new_selected_position == -1) &&
- (mus_strcmp(selected_filename, cur_dir->files[i]->full_filename)))
- new_selected_position = i;
- }
-
- XtVaSetValues(fp->dialog,
- XmNfileListItems, names,
- XmNfileListItemCount, cur_dir->len,
- XmNlistUpdated, true,
- NULL);
-
- if (new_selected_position >= 0)
- ensure_list_row_visible(XmFileSelectionBoxGetChild(fp->dialog, XmDIALOG_LIST), new_selected_position);
-
- for (i = 0; i < cur_dir->len; i++)
- if (names[i])
- XmStringFree(names[i]);
- free(names);
- }
- else
- {
- /* nothing to sort, but make sure the files list is actually empty */
- XtVaSetValues(fp->dialog,
- XmNfileListItems, NULL,
- XmNfileListItemCount, 0,
- XmNlistUpdated, true,
- NULL);
- }
-}
-
-
-static void snd_directory_reader(Widget dialog, XmFileSelectionBoxCallbackStruct *info)
-{
- /* replaces the FSB searchProc */
- file_pattern_info *fp;
- dir_info *cur_dir = NULL;
- char *pattern = NULL, *our_dir = NULL;
-
- XtVaGetValues(dialog, XmNuserData, &fp, NULL);
- if (!(fp->dialog)) fp->dialog = dialog; /* can be null at initialization */
-
- pattern = (char *)XmStringUnparse(info->pattern, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- our_dir = (char *)XmStringUnparse(info->dir, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
-
- /* get current directory contents, given filter and pattern */
- if (strcmp(pattern, "*") == 0)
- {
- if (fp->filter_choice == NO_FILE_FILTER)
- cur_dir = find_files_in_dir(our_dir);
- else cur_dir = find_filtered_files_in_dir(our_dir, fp->filter_choice);
- }
- else cur_dir = find_filtered_files_in_dir_with_pattern(our_dir, fp->filter_choice, pattern);
-
- if (fp->current_files) free_dir_info(fp->current_files);
- fp->current_files = cur_dir;
- if (pattern) XtFree(pattern);
-
- /* set file_pattern_info->selected_filename list_slider_position from history */
- {
- position_t list_pos;
- Widget file_list;
- file_list = XmFileSelectionBoxGetChild(dialog, XmDIALOG_LIST);
- list_pos = dirpos_list_top(fp->dir_list, our_dir);
-
- /* post the sorted list in the dialog -- alphabetize by default */
- sort_files_and_redisplay(fp);
-
- if (list_pos != POSITION_UNKNOWN)
- XmListSetPos(file_list, list_pos);
- }
-
-#if HAVE_FAM
- /* make sure fam knows which directory to watch */
- if ((fp->last_dir == NULL) ||
- (strcmp(our_dir, fp->last_dir) != 0))
- {
- if (fp->directory_watcher)
- fam_unmonitor_file(fp->last_dir, fp->directory_watcher); /* filename normally ignored */
-
- fp->directory_watcher = fam_monitor_directory(our_dir, (void *)fp, watch_current_directory_contents);
-
- if (fp->last_dir) free(fp->last_dir);
- fp->last_dir = mus_strdup(our_dir);
- fp->reread_directory = false;
- }
-#endif
- if (our_dir) XtFree(our_dir);
-}
-
-
-static void just_sounds_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- file_pattern_info *fp = (file_pattern_info *)context;
- if (cb->set)
- fp->filter_choice = JUST_SOUNDS_FILTER;
- else fp->filter_choice = NO_FILE_FILTER;
- fp->in_just_sounds_update = true;
- force_directory_reread(fp->dialog);
- fp->in_just_sounds_update = false;
-}
-
-
-/* -------- play selected file handlers -------- */
-
-typedef struct dialog_play_info {
- Widget dialog, play_button;
- snd_info *player;
-} dialog_play_info;
-
-
-static void file_dialog_stop_playing(dialog_play_info *dp)
-{
- if ((dp->player) &&
- (dp->player->playing))
- {
- stop_playing_sound(dp->player, PLAY_BUTTON_UNSET);
- dp->player = NULL;
- }
-}
-
-
-void clear_deleted_snd_info(struct dialog_play_info *dp)
-{
- dp->player = NULL;
-}
-
-
-static void play_selected_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- dialog_play_info *dp = (dialog_play_info *)context;
- if (cb->set)
- {
- Widget wtmp;
- char *filename = NULL;
- if ((dp->player) &&
- (dp->player->playing))
- stop_playing_sound(dp->player, PLAY_BUTTON_UNSET);
- wtmp = FSB_BOX(dp->dialog, XmDIALOG_TEXT);
- filename = XmTextGetString(wtmp);
- if (filename)
- {
- if (mus_file_probe(filename))
- {
- dp->player = make_sound_readable(filename, false);
- dp->player->delete_me = dp;
- if (dp->player)
- play_sound(dp->player, 0, NO_END_SPECIFIED);
- }
- XtFree(filename);
- }
- }
- else file_dialog_stop_playing(dp);
-}
-
-
-static void add_play_and_just_sounds_buttons(Widget dialog, Widget parent, file_pattern_info *fp, dialog_play_info *dp)
-{
- Widget rc;
- int n;
- Arg args[12];
-
- n = 0;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- rc = XtCreateManagedWidget("filebuttons-rc", xmRowColumnWidgetClass, parent, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNset, just_sounds(ss)); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- fp->just_sounds_button = XtCreateManagedWidget("sound files only", xmToggleButtonWidgetClass, rc, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_END); n++;
- dp->play_button = XtCreateWidget("play selected sound", xmToggleButtonWidgetClass, rc, args, n);
-
- XtAddCallback(dp->play_button, XmNvalueChangedCallback, play_selected_callback, (XtPointer)dp);
- XtAddCallback(fp->just_sounds_button, XmNvalueChangedCallback, just_sounds_callback, (XtPointer)fp);
-}
-
-
-
-/* -------- File Open/View/Mix Dialogs -------- */
-
-typedef struct file_dialog_info {
- read_only_t file_dialog_read_only;
- Widget dialog, mkdirB;
- Widget info_frame, info1, info2; /* labels giving info on selected file, or an error message */
- file_pattern_info *fp;
- dialog_play_info *dp;
- fam_info *unsound_directory_watcher; /* started if file doesn't exist, not a sound file, bogus header, etc (clears error msg if problem changed) */
- char *unsound_dirname, *unsound_filename;
- fam_info *info_filename_watcher; /* watch for change in selected file and repost info */
- char *info_filename;
- file_popup_info *fpop;
-} file_dialog_info;
-
-
-static void open_file_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- open_file_dialog_help();
-}
-
-
-static void file_cancel_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_dialog_stop_playing((dialog_play_info *)context);
- XtUnmanageChild (w);
-}
-
-
-static void file_wm_delete_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_dialog_stop_playing((dialog_play_info *)context);
-}
-
-
-static void post_sound_info(Widget info1, Widget info2, const char *filename, bool with_filename)
-{
- /* filename is known[strongly believed] to be a sound file, etc */
- XmString label;
- char *buf;
- buf = (char *)calloc(LABEL_BUFFER_SIZE, sizeof(char));
- mus_snprintf(buf, LABEL_BUFFER_SIZE, "%s%s%d chan%s, %d Hz, %.3f secs",
- (with_filename) ? filename_without_directory(filename) : "",
- (with_filename) ? ": " : "",
- mus_sound_chans(filename),
- (mus_sound_chans(filename) > 1) ? "s" : "",
- mus_sound_srate(filename),
- mus_sound_duration(filename));
- label = XmStringCreateLocalized(buf);
- XtVaSetValues(info1,
- XmNlabelString, label,
- NULL);
- XmStringFree(label);
- mus_snprintf(buf, LABEL_BUFFER_SIZE, "%s, %s%s",
- mus_header_type_name(mus_sound_header_type(filename)),
- short_data_format_name(mus_sound_data_format(filename), filename),
- snd_strftime(", %d-%b-%Y", mus_sound_write_date(filename)));
- label = XmStringCreateLocalized(buf);
- XtVaSetValues(info2, XmNlabelString, label, NULL);
- XmStringFree(label);
- free(buf);
-}
-
-
-#if HAVE_FAM
-static void unpost_file_info(file_dialog_info *fd);
-
-static void repost_sound_info(file_dialog_info *fd)
-{
- if ((mus_file_probe(fd->info_filename)) &&
- (plausible_sound_file_p(fd->info_filename)))
- post_sound_info(fd->info1, fd->info2, fd->info_filename, true);
- else unpost_file_info(fd);
-}
-
-
-static void watch_info_file(struct fam_info *fp, FAMEvent *fe)
-{
- switch (fe->code)
- {
- case FAMChanged:
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- repost_sound_info((file_dialog_info *)(fp->data));
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-}
-#endif
-
-
-static void post_file_info(file_dialog_info *fd, const char *filename)
-{
- XtManageChild(fd->dp->play_button);
- post_sound_info(fd->info1, fd->info2, filename, true);
- if (!(XtIsManaged(fd->info1)))
- XtManageChild(fd->info1);
- if (!(XtIsManaged(fd->info2)))
- XtManageChild(fd->info2);
- if (!(XtIsManaged(fd->info_frame)))
- XtManageChild(fd->info_frame);
-#if HAVE_FAM
- if (fd->info_filename_watcher)
- {
- fd->info_filename_watcher = fam_unmonitor_file(fd->info_filename, fd->info_filename_watcher);
- if (fd->info_filename) {free(fd->info_filename); fd->info_filename = NULL;}
- }
- fd->info_filename = mus_strdup(filename);
- fd->info_filename_watcher = fam_monitor_file(fd->info_filename, (void *)fd, watch_info_file);
-#endif
-}
-
-
-static void unpost_file_info(file_dialog_info *fd)
-{
- if (XtIsManaged(fd->dp->play_button))
- XtUnmanageChild(fd->dp->play_button);
- if (XtIsManaged(fd->info_frame))
- XtUnmanageChild(fd->info_frame);
-#if HAVE_FAM
- if (fd->info_filename_watcher)
- {
- fd->info_filename_watcher = fam_unmonitor_file(fd->info_filename, fd->info_filename_watcher);
- if (fd->info_filename) {free(fd->info_filename); fd->info_filename = NULL;}
- }
-#endif
-}
-
-
-static void file_dialog_select_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_dialog_info *fd = (file_dialog_info *)context;
- XmString *strs;
- char *filename = NULL;
- XtVaGetValues(w, XmNselectedItems, &strs, NULL);
- filename = (char *)XmStringUnparse(strs[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- if (filename)
- {
- if (plausible_sound_file_p(filename)) /* forces header read to avoid later unwanted error possibility */
- post_file_info(fd, filename);
- XtFree(filename);
- }
- else unpost_file_info(fd);
-
- {
- /* save current list position */
- position_t position = 0;
- XtVaGetValues(w, XmNtopItemPosition, &position, NULL);
- dirpos_update(fd->fp->dir_list, fd->fp->current_files->dir_name, position);
- }
-}
-
-
-static void unpost_if_filter_changed(Widget w, XtPointer context, XtPointer info)
-{
- unpost_file_info((file_dialog_info *)context);
-}
-
-
-static void watch_filename_change(Widget w, XtPointer context, XtPointer info)
-{
- /* try to move file list to show possible matches,
- * if a sound file, show info
- */
- file_dialog_info *fd = (file_dialog_info *)context;
- char *filename = NULL;
-
- filename = XmTextGetString(w);
- if ((filename) && (*filename))
- {
- XmStringTable files;
- Widget file_list;
- int num_files = 0, i, pos = -1, l, u, text_len;
- char *file_list_file = NULL;
-
- text_len = mus_strlen(filename);
-
- file_list = FSB_BOX(fd->dialog, XmDIALOG_LIST);
- XtVaGetValues(fd->dialog,
- XmNfileListItemCount, &num_files,
- XmNfileListItems, &files, /* do not free */
- NULL);
- l = 0; /* hooray for Knuth... */
- u = num_files - 1;
- while (true)
- {
- int comp;
- if (u < l) break;
- i = (l + u) / 2;
- file_list_file = (char *)XmStringUnparse(files[i], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL); /* p453 */
- comp = strcmp(file_list_file, filename);
- XtFree(file_list_file);
- pos = i + 1;
- if (comp == 0)
- break;
- if (comp < 0) /* files[i] less than filename */
- l = i + 1;
- else u = i - 1;
- }
- if (pos > 0)
- ensure_list_row_visible(file_list, pos);
-
- if ((mus_file_probe(filename)) &&
- (!directory_p(filename)))
- {
- if (sound_file_p(filename))
- post_file_info(fd, filename);
- }
- }
- if (filename) XtFree(filename);
-}
-
-
-static void focus_filename_text_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtAddCallback(w, XmNvalueChangedCallback, watch_filename_change, context);
-}
-
-
-static void unfocus_filename_text_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtRemoveCallback(w, XmNvalueChangedCallback, watch_filename_change, context);
-}
-
-
-static bool file_is_directory(Widget dialog)
-{
- char *filename = NULL;
- bool is_dir = false;
- filename = XmTextGetString(FSB_BOX(dialog, XmDIALOG_TEXT));
- if (filename)
- {
- is_dir = directory_p(filename);
- XtFree(filename);
- }
- return(is_dir);
-}
-
-
-static bool file_is_nonexistent_directory(Widget dialog)
-{
- char *filename = NULL;
- bool is_nonexistent_dir = false;
- filename = XmTextGetString(FSB_BOX(dialog, XmDIALOG_TEXT));
- if (filename)
- {
- int len;
- len = strlen(filename);
- if ((!mus_file_probe(filename)) &&
- (filename[len - 1] == '/'))
- {
- int i;
- /* check that there's some hope of making this directory */
- for (i = len - 2; i > 0; i--)
- if (filename[i] == '/')
- {
- filename[i] = '\0';
- is_nonexistent_dir = directory_p(filename);
- break;
- }
- }
- XtFree(filename);
- }
- return(is_nonexistent_dir);
-}
-
-
-static void reflect_text_in_open_button(Widget w, XtPointer context, XtPointer info)
-{
- file_dialog_info *fd = (file_dialog_info *)context;
- /* w here is the text widget, not the button */
- XtSetSensitive(FSB_BOX(fd->dialog, XmDIALOG_OK_BUTTON), (!(file_is_directory(fd->dialog))));
- if (fd->mkdirB) XtSetSensitive(fd->mkdirB, file_is_nonexistent_directory(fd->dialog));
-}
-
-
-static void multifile_completer(widget_t w, void *data)
-{
- watch_filename_change(w, (XtPointer)data, NULL);
-}
-
-
-#define FILE_DIALOG_WIDTH 450
-
-static file_dialog_info *make_file_dialog(read_only_t read_only, char *title, char *select_title,
- XtCallbackProc file_ok_proc, XtCallbackProc file_help_proc)
-{
- /* file selection dialog box with added "Just Sound Files" and "Play selected" toggle buttons and info area,
- * fam support, popups, and so on. This applies to the Open, Mix, and Insert dialogs. The save-as
- * dialogs are handled by make_save_as_dialog below
- */
- Widget w;
- file_dialog_info *fd;
- Arg args[20];
- int n;
- XmString s1, s2, ok_label, filter_list_label, cancel_label;
- Widget wtmp = NULL, rc1, rc2;
-
- fd = (file_dialog_info *)calloc(1, sizeof(file_dialog_info));
- fd->fp = (file_pattern_info *)calloc(1, sizeof(file_pattern_info));
- fd->fp->in_just_sounds_update = false;
- if (just_sounds(ss))
- fd->fp->filter_choice = JUST_SOUNDS_FILTER;
- else fd->fp->filter_choice = NO_FILE_FILTER;
-
- fd->dp = (dialog_play_info *)calloc(1, sizeof(dialog_play_info));
- fd->file_dialog_read_only = read_only;
- fd->fpop = (file_popup_info *)calloc(1, sizeof(file_popup_info));
- fd->fpop->fp = fd->fp;
-
- fd->fp->dir_list = make_dirpos_list();
-
- w = MAIN_SHELL(ss);
-
- s1 = XmStringCreateLocalized(select_title);
- s2 = XmStringCreateLocalized(title);
- ok_label = XmStringCreateLocalized(title);
- filter_list_label = XmStringCreateLocalized((char *)"files listed:");
- cancel_label = XmStringCreateLocalized((char *)"Go Away");
-
- n = 0;
- if (open_file_dialog_directory(ss))
- {
- XmString dirstr;
- dirstr = XmStringCreateLocalized(open_file_dialog_directory(ss));
- XtSetArg(args[n], XmNdirectory, dirstr); n++;
- }
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNokLabelString, ok_label); n++;
- XtSetArg(args[n], XmNselectionLabelString, s1); n++; /* "open", "mix", "insert", "open read-only:" */
- XtSetArg(args[n], XmNdialogTitle, s2); n++;
- XtSetArg(args[n], XmNfilterLabelString, filter_list_label); n++; /* default label 'Filter' is confusing in this context */
- XtSetArg(args[n], XmNfileFilterStyle, XmFILTER_HIDDEN_FILES); n++; /* the dot files mostly just get in the way */
- XtSetArg(args[n], XmNcancelLabelString, cancel_label); n++;
- XtSetArg(args[n], XmNuserData, (XtPointer)(fd->fp)); n++;
- XtSetArg(args[n], XmNfileSearchProc, snd_directory_reader); n++; /* over-ride Motif's directory reader altogether */
- XtSetArg(args[n], XmNwidth, FILE_DIALOG_WIDTH); n++;
-
- fd->dialog = XmCreateFileSelectionDialog(w, title, args, n);
- fd->fp->dialog = fd->dialog;
- fd->dp->dialog = fd->dialog;
- fd->fpop->dialog = fd->dialog;
-
- XtUnmanageChild(FSB_BOX(fd->dialog, XmDIALOG_DIR_LIST_LABEL)); /* these are obvious */
- XtUnmanageChild(FSB_BOX(fd->dialog, XmDIALOG_LIST_LABEL));
- XtUnmanageChild(FSB_BOX(fd->dialog, XmDIALOG_APPLY_BUTTON)); /* "Filter" button is useless */
-
- XtVaSetValues(FSB_BOX(fd->dialog, XmDIALOG_FILTER_LABEL), XmNbackground, ss->basic_color, NULL);
- XtVaSetValues(FSB_BOX(fd->dialog, XmDIALOG_SELECTION_LABEL), XmNbackground, ss->basic_color, NULL);
-
- XmStringFree(s1);
- XmStringFree(s2);
- XmStringFree(ok_label);
- XmStringFree(filter_list_label);
- XmStringFree(cancel_label);
-
- /* -------- play and just-sounds buttons and info area */
- rc1 = XtVaCreateManagedWidget("filebuttons-rc1",
- xmRowColumnWidgetClass, fd->dialog,
- XmNorientation, XmVERTICAL,
- NULL);
-
- add_play_and_just_sounds_buttons(fd->dialog, rc1, fd->fp, fd->dp);
-
- fd->info_frame = XtVaCreateWidget("", xmFrameWidgetClass, rc1, NULL);
- rc2 = XtVaCreateManagedWidget("info-rc2",
- xmRowColumnWidgetClass, fd->info_frame,
- XmNorientation, XmVERTICAL,
- XmNbackground, ss->highlight_color,
- NULL);
- fd->info1 = XtVaCreateManagedWidget("", xmLabelWidgetClass, rc2, XmNbackground, ss->highlight_color, NULL);
- fd->info2 = XtVaCreateManagedWidget("", xmLabelWidgetClass, rc2, XmNbackground, ss->highlight_color, NULL);
-
-
- /* -------- Snd-like color schemes */
- color_file_selection_box(fd->dialog);
- XtVaSetValues(fd->fp->just_sounds_button, XmNselectColor, ss->selection_color, NULL);
- XtVaSetValues(fd->dp->play_button, XmNselectColor, ss->selection_color, NULL);
-
- /* -------- completions */
-
- wtmp = FSB_BOX(fd->dialog, XmDIALOG_TEXT);
- add_completer_to_builtin_textfield(wtmp, add_completer_func_with_multicompleter(sound_filename_completer, (void *)fd, multifile_completer));
-
- XtAddCallback(wtmp, XmNfocusCallback, focus_filename_text_callback, (XtPointer)fd);
- XtAddCallback(wtmp, XmNlosingFocusCallback, unfocus_filename_text_callback, (XtPointer)fd);
-
- wtmp = FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT);
- add_completer_to_builtin_textfield(wtmp, add_completer_func(filename_completer, NULL));
-
- XtAddCallback(wtmp, XmNvalueChangedCallback, unpost_if_filter_changed, (XtPointer)fd);
-
- /* -------- fam/gamin */
-#if HAVE_FAM
- {
- char *our_dir;
- XmString cur_dir;
- XtVaGetValues(fd->dialog, XmNdirectory, &cur_dir, NULL);
- our_dir = (char *)XmStringUnparse(cur_dir, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- fd->fp->directory_watcher = fam_monitor_directory(our_dir, (void *)(fd->fp), watch_current_directory_contents);
- /* don't set last_dir yet */
- XtFree(our_dir);
- }
-#endif
-
- /* -------- base button callbacks */
- XtAddCallback(fd->dialog, XmNokCallback, file_ok_proc, (XtPointer)fd);
- XtAddCallback(fd->dialog, XmNcancelCallback, file_cancel_callback, (XtPointer)(fd->dp));
- XtAddCallback(fd->dialog, XmNhelpCallback, file_help_proc, NULL);
- XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_LIST), XmNbrowseSelectionCallback, file_dialog_select_callback, (XtPointer)fd);
-
- /* -------- single click in directory list */
- XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_DIR_LIST), XmNbrowseSelectionCallback, file_change_directory_callback, (XtPointer)(fd->fp));
-
- /* -------- the WM 'close' button */
- {
- Atom wm_delete_window;
- wm_delete_window = XmInternAtom(MAIN_DISPLAY(ss), (char *)"WM_DELETE_WINDOW", false);
- XmAddWMProtocolCallback(XtParent(fd->dialog), wm_delete_window, file_wm_delete_callback, (XtPointer)(fd->dp));
- }
-
- /* -------- special popups */
- add_file_popups(fd->fpop);
-
- XtSetSensitive(FSB_BOX(fd->dialog, XmDIALOG_OK_BUTTON), (!(file_is_directory(fd->dialog))));
- XtAddCallback(FSB_BOX(fd->dialog, XmDIALOG_TEXT), XmNvalueChangedCallback, reflect_text_in_open_button, (void *)fd);
-
- return(fd);
-}
-
-
-/* -------- File:Open/View dialogs -------- */
-
-
-static void file_open_error(const char *error_msg, file_dialog_info *fd)
-{
- XmString msg;
- msg = XmStringCreateLocalized((char *)error_msg);
- XtVaSetValues(fd->info1,
- XmNlabelString, msg,
- NULL);
- XmStringFree(msg);
-
- if (XtIsManaged(fd->info2))
- XtUnmanageChild(fd->info2);
- if (!(XtIsManaged(fd->info_frame)))
- XtManageChild(fd->info_frame);
-}
-
-
-static void redirect_file_open_error(const char *error_msg, void *ufd)
-{
- /* called from snd_error, redirecting error handling to the dialog */
- file_open_error(error_msg, (file_dialog_info *)ufd);
-}
-
-
-static void open_modify_callback(Widget w, XtPointer context, XtPointer info);
-
-static void unpost_open_modify_error(file_dialog_info *fd)
-{
- Widget dialog_filename_text;
- if (XtIsManaged(fd->info_frame))
- XtUnmanageChild(fd->info_frame);
- dialog_filename_text = FSB_BOX(fd->dialog, XmDIALOG_TEXT);
- if (dialog_filename_text)
- XtRemoveCallback(dialog_filename_text, XmNmodifyVerifyCallback, open_modify_callback, (XtPointer)fd);
-#if HAVE_FAM
- if (fd->unsound_directory_watcher)
- {
- fd->unsound_directory_watcher = fam_unmonitor_file(fd->unsound_dirname, fd->unsound_directory_watcher);
- if (fd->unsound_dirname) {free(fd->unsound_dirname); fd->unsound_dirname = NULL;}
- if (fd->unsound_filename) {free(fd->unsound_filename); fd->unsound_filename = NULL;}
- }
-#endif
-}
-
-
-static void open_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_dialog_info *fd = (file_dialog_info *)context;
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- if (!(fd->fp->in_just_sounds_update)) /* auto trigger from just_sounds button -- unwanted! */
- unpost_open_modify_error(fd);
- cbs->doit = true; /* fixup filename elsewhere -- returning false here makes the thing beep! */
-}
-
-
-static void clear_error_if_open_changes(Widget dialog, file_dialog_info *data)
-{
- Widget dialog_filename_text;
- dialog_filename_text = FSB_BOX(dialog, XmDIALOG_TEXT);
- if (dialog_filename_text)
- XtAddCallback(dialog_filename_text, XmNmodifyVerifyCallback, open_modify_callback, (XtPointer)data);
-}
-
-
-#if HAVE_FAM
-static void unpost_unsound_error(struct fam_info *fp, FAMEvent *fe)
-{
- file_dialog_info *fd;
- switch (fe->code)
- {
- case FAMChanged:
- case FAMCreated:
- fd = (file_dialog_info *)(fp->data);
- if ((fd) &&
- (fe->filename) &&
- (mus_strcmp(fe->filename, fd->unsound_filename)))
- unpost_open_modify_error(fd);
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-}
-
-
-static void start_unsound_watcher(file_dialog_info *fd, const char *filename)
-{
- if (fd->unsound_directory_watcher)
- {
- fd->unsound_directory_watcher = fam_unmonitor_file(fd->unsound_dirname, fd->unsound_directory_watcher);
- if (fd->unsound_dirname) free(fd->unsound_dirname);
- if (fd->unsound_filename) free(fd->unsound_filename);
- }
- fd->unsound_filename = mus_expand_filename(filename);
- fd->unsound_dirname = just_directory(fd->unsound_filename);
- fd->unsound_directory_watcher = fam_monitor_directory(fd->unsound_dirname, (void *)fd, unpost_unsound_error);
-}
-#else
-static void start_unsound_watcher(file_dialog_info *fd, const char *filename) {}
-#endif
-
-
-static void file_open_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_dialog_info *fd = (file_dialog_info *)context;
- XmFileSelectionBoxCallbackStruct *cbs = (XmFileSelectionBoxCallbackStruct *)info;
- char *filename = NULL;
- if (XmGetFocusWidget(fd->dialog) == FSB_BOX(fd->dialog, XmDIALOG_FILTER_TEXT)) return;
-
- filename = (char *)XmStringUnparse(cbs->value, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- if ((!filename) || (!(*filename)))
- {
- file_open_error("no filename given", fd);
- clear_error_if_open_changes(fd->dialog, fd);
- }
- else
- {
- file_dialog_stop_playing(fd->dp);
- if (!(directory_p(filename))) /* this can be a directory name if the user clicked 'ok' when he meant 'cancel' */
- {
- snd_info *sp;
- redirect_snd_error_to(redirect_file_open_error, (void *)fd);
- ss->requestor_dialog = w;
- ss->open_requestor = FROM_OPEN_DIALOG;
- ss->open_requestor_data = NULL;
- sp = snd_open_file(filename, fd->file_dialog_read_only);
- redirect_snd_error_to(NULL, NULL);
- if (sp)
- {
- XtUnmanageChild(w);
- remember_filename(filename, fd->fpop->file_text_names);
- select_channel(sp, 0);
- }
- else
- {
- if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
- {
- clear_error_if_open_changes(fd->dialog, fd);
- /* whatever the error was, I think it is correct here to unpost the error
- * if the underlying file is either changed or created.
- */
- start_unsound_watcher(fd, filename);
- }
- }
- if (filename) XtFree(filename);
- }
- else
- {
- char *str;
- str = mus_format("%s is a directory", filename);
- file_open_error(str, fd);
- clear_error_if_open_changes(fd->dialog, fd);
- free(str);
- }
- }
-}
-
-
-static void file_mkdir_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_dialog_info *fd = (file_dialog_info *)context;
- char *filename = NULL;
- filename = XmTextGetString(FSB_BOX(fd->dialog, XmDIALOG_TEXT));
- if (snd_mkdir(filename) < 0)
- {
- /* could not make the directory */
- char *str;
- str = mus_format("can't make %s: %s", filename, strerror(errno));
- file_open_error(str, fd);
- clear_error_if_open_changes(fd->dialog, fd);
- free(str);
- }
- else
- {
- /* set FSB to new dir and force update */
- char *filter;
- filter = mus_format("%s*", filename); /* already has the "/" at the end */
- update_dir_list(fd->dialog, filter);
- free(filter);
- XtSetSensitive(w, false);
- }
- XtFree(filename);
-}
-
-
-static file_dialog_info *odat = NULL;
-
-widget_t make_open_file_dialog(read_only_t read_only, bool managed)
-{
- char *title, *select_title;
- if (read_only == FILE_READ_ONLY)
- {
- title = (char *)"View";
- select_title = (char *)"open read-only:";
- }
- else
- {
- title = (char *)"Open";
- select_title = (char *)"open:";
- }
- if (!odat)
- {
- XmString cancel_label;
- odat = make_file_dialog(read_only, title, select_title, file_open_ok_callback, open_file_help_callback);
- set_dialog_widget(FILE_OPEN_DIALOG, odat->dialog);
-
- /* now preload last n files opened before this point */
- preload_filenames(odat->fpop->file_text_names);
-
- /* add "Mkdir" button */
- {
- int n;
- Arg args[12];
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- odat->mkdirB = XtCreateManagedWidget("Mkdir", xmPushButtonGadgetClass, odat->dialog, args, n);
- XtAddCallback(odat->mkdirB, XmNactivateCallback, file_mkdir_callback, (XtPointer)odat);
- XtSetSensitive(odat->mkdirB, false);
- }
-
- cancel_label = XmStringCreateLocalized((char *)"Go Away");
- XtVaSetValues(odat->dialog, XmNcancelLabelString, cancel_label, NULL);
- XmStringFree(cancel_label);
- }
- else
- {
- if (odat->file_dialog_read_only != read_only)
- {
- XmString s1, s2;
- s1 = XmStringCreateLocalized(select_title);
- s2 = XmStringCreateLocalized(title);
- XtVaSetValues(odat->dialog,
- XmNselectionLabelString, s1,
- XmNdialogTitle, s2,
- XmNokLabelString, s2, /* "ok" button label can be either "View" or "Open" */
- NULL);
- XmStringFree(s1);
- XmStringFree(s2);
- }
- odat->file_dialog_read_only = read_only;
- if (odat->fp->reread_directory)
- {
- force_directory_reread(odat->dialog);
- odat->fp->reread_directory = false;
- }
- }
- if ((managed) && (!(XtIsManaged(odat->dialog))))
- XtManageChild(odat->dialog);
-
- return(odat->dialog);
-}
-
-
-
-/* -------- File:Mix dialog -------- */
-
-static void file_mix_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmFileSelectionBoxCallbackStruct *cbs = (XmFileSelectionBoxCallbackStruct *)info;
- file_dialog_info *fd = (file_dialog_info *)context;
- char *filename = NULL;
-
- filename = (char *)XmStringUnparse(cbs->value, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- if ((!filename) || (!(*filename)))
- {
- file_open_error("no filename given", fd);
- clear_error_if_open_changes(fd->dialog, fd);
- }
- else
- {
- file_dialog_stop_playing(fd->dp);
- if (!(directory_p(filename))) /* this can be a directory name if the user clicked 'ok' when he meant 'cancel' */
- {
- int id_or_error;
- snd_info *sp;
- sp = any_selected_sound();
- redirect_snd_error_to(redirect_file_open_error, (void *)fd);
- ss->requestor_dialog = w;
- ss->open_requestor = FROM_MIX_DIALOG;
- ss->open_requestor_data = NULL;
- id_or_error = mix_complete_file_at_cursor(sp, filename);
- /* "id_or_error" here is either one of the mix id's or an error indication such as MIX_FILE_NO_MIX */
- /* the possible error conditions have been checked already, or go through snd_error */
- redirect_snd_error_to(NULL, NULL);
- if (id_or_error < 0) /* actually -1 .. -3 */
- {
- if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
- {
- clear_error_if_open_changes(fd->dialog, fd);
- if (id_or_error == MIX_FILE_NO_FILE)
- start_unsound_watcher(fd, filename);
- }
- }
- else
- {
- report_in_minibuffer(sp, "%s mixed in at cursor", filename);
- remember_filename(filename, fd->fpop->file_text_names);
- }
- if (filename) XtFree(filename);
- }
- else
- {
- char *str;
- str = mus_format("%s is a directory", filename);
- file_open_error(str, fd);
- clear_error_if_open_changes(fd->dialog, fd);
- free(str);
- }
- }
-}
-
-
-static void mix_file_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- mix_file_dialog_help();
-}
-
-
-static file_dialog_info *mdat = NULL;
-
-static XEN mix_open_file_watcher(XEN reason)
-{
- if ((mdat->dialog) &&
- (XtIsManaged(mdat->dialog)))
- set_sensitive(FSB_BOX(mdat->dialog, XmDIALOG_OK_BUTTON), (bool)any_selected_sound());
- return(XEN_FALSE);
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(mix_open_file_watcher_w, mix_open_file_watcher)
-#else
- #define mix_open_file_watcher_w mix_open_file_watcher
-#endif
-
-
-
-widget_t make_mix_file_dialog(bool managed)
-{
- /* called from the menu */
- if (!mdat)
- {
- mdat = make_file_dialog(FILE_READ_ONLY, (char *)"Mix Sound", (char *)"mix in:", file_mix_ok_callback, mix_file_help_callback);
- set_dialog_widget(FILE_MIX_DIALOG, mdat->dialog);
- XEN_ADD_HOOK(ss->snd_open_file_hook, mix_open_file_watcher_w, "mix-dialog-open-file-watcher", "mix dialog's open-file-hook handler");
- }
- else
- {
- if (mdat->fp->reread_directory)
- {
- force_directory_reread(mdat->dialog);
- mdat->fp->reread_directory = false;
- }
- }
- if ((managed) && (!XtIsManaged(mdat->dialog)))
- XtManageChild(mdat->dialog);
- return(mdat->dialog);
-}
-
-
-/* -------- File:Insert dialog -------- */
-
-static void file_insert_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmFileSelectionBoxCallbackStruct *cbs = (XmFileSelectionBoxCallbackStruct *)info;
- file_dialog_info *fd = (file_dialog_info *)context;
- char *filename = NULL;
-
- filename = (char *)XmStringUnparse(cbs->value, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- if ((!filename) || (!(*filename)))
- {
- file_open_error("no filename given", fd);
- clear_error_if_open_changes(fd->dialog, fd);
- }
- else
- {
- file_dialog_stop_playing(fd->dp);
- if (!(directory_p(filename))) /* this can be a directory name if the user clicked 'ok' when he meant 'cancel' */
- {
- bool ok = false;
- snd_info *sp;
- sp = any_selected_sound();
- ss->requestor_dialog = w;
- ss->open_requestor = FROM_INSERT_DIALOG;
- ss->open_requestor_data = NULL;
- redirect_snd_error_to(redirect_file_open_error, (void *)fd);
- ok = insert_complete_file_at_cursor(sp, filename);
- redirect_snd_error_to(NULL, NULL);
- if (!ok)
- {
- if (ss->open_requestor != FROM_RAW_DATA_DIALOG)
- {
- char *fullname;
- clear_error_if_open_changes(fd->dialog, fd);
- /* ideally insert_complete_file would return an indication of what the error was... */
- fullname = mus_expand_filename(filename);
- if (!(mus_file_probe(fullname)))
- start_unsound_watcher(fd, filename);
- free(fullname);
- }
- }
- else
- {
- report_in_minibuffer(sp, "%s inserted at cursor", filename);
- remember_filename(filename, fd->fpop->file_text_names);
- }
- if (filename) XtFree(filename);
- }
- else
- {
- char *str;
- str = mus_format("%s is a directory", filename);
- file_open_error(str, fd);
- clear_error_if_open_changes(fd->dialog, fd);
- free(str);
- }
- }
-}
-
-
-static void insert_file_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- insert_file_dialog_help();
-}
-
-
-static file_dialog_info *idat = NULL;
-
-static XEN insert_open_file_watcher(XEN reason)
-{
- if ((idat->dialog) &&
- (XtIsManaged(idat->dialog)))
- set_sensitive(FSB_BOX(idat->dialog, XmDIALOG_OK_BUTTON), (bool)any_selected_sound());
- return(XEN_FALSE);
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_ARGIFY_1(insert_open_file_watcher_w, insert_open_file_watcher)
-#else
- #define insert_open_file_watcher_w insert_open_file_watcher
-#endif
-
-widget_t make_insert_file_dialog(bool managed)
-{
- if (!idat)
- {
- idat = make_file_dialog(FILE_READ_ONLY, (char *)"Insert Sound", (char *)"insert:", file_insert_ok_callback, insert_file_help_callback);
- set_dialog_widget(FILE_INSERT_DIALOG, idat->dialog);
- XEN_ADD_HOOK(ss->snd_open_file_hook, insert_open_file_watcher_w, "insert-dialog-open-file-watcher", "insert dialog's open-file-hook handler");
- }
- else
- {
- if (idat->fp->reread_directory)
- {
- force_directory_reread(idat->dialog);
- idat->fp->reread_directory = false;
- }
- }
- if ((managed) && (!XtIsManaged(idat->dialog)))
- XtManageChild(idat->dialog);
- return(idat->dialog);
-}
-
-
-/* -------- reflect outside changes -------- */
-
-void set_open_file_play_button(bool val)
-{
- if ((odat) && (odat->dp->play_button))
- XmToggleButtonSetState(odat->dp->play_button, (Boolean)val, false);
- if ((mdat) && (mdat->dp->play_button))
- XmToggleButtonSetState(mdat->dp->play_button, (Boolean)val, false);
- if ((idat) && (idat->dp->play_button))
- XmToggleButtonSetState(idat->dp->play_button, (Boolean)val, false);
-}
-
-
-void alert_new_file(void)
-{
- if (ss->fam_ok) return;
- /* ideally this would include the save-as dialogs */
- if (odat)
- {
- odat->fp->reread_directory = true;
- if (XtIsManaged(odat->dialog))
- {
- force_directory_reread(odat->dialog);
- odat->fp->reread_directory = false;
- }
- }
- if (mdat)
- {
- mdat->fp->reread_directory = true;
- if (XtIsManaged(mdat->dialog))
- {
- force_directory_reread(mdat->dialog);
- mdat->fp->reread_directory = false;
- }
- }
- if (idat)
- {
- idat->fp->reread_directory = true;
- if (XtIsManaged(idat->dialog))
- {
- force_directory_reread(idat->dialog);
- idat->fp->reread_directory = false;
- }
- }
-}
-
-
-void reflect_just_sounds(void)
-{
- if ((odat) && (odat->fp->just_sounds_button))
- XmToggleButtonSetState(odat->fp->just_sounds_button, just_sounds(ss), true);
- if ((mdat) && (mdat->fp->just_sounds_button))
- XmToggleButtonSetState(mdat->fp->just_sounds_button, just_sounds(ss), true);
- if ((idat) && (idat->fp->just_sounds_button))
- XmToggleButtonSetState(idat->fp->just_sounds_button, just_sounds(ss), true);
-}
-
-
-
-/* ---------------- file data panel ---------------- */
-
-#define NUM_VISIBLE_HEADERS 5
-
-char *get_file_dialog_sound_attributes(file_data *fdat,
- int *srate, int *chans, int *type, int *format, mus_long_t *location, mus_long_t *samples,
- int min_chan)
-{
- char *str;
- int n;
- int res;
- int *ns = NULL;
- char *comment = NULL;
- fdat->error_widget = NOT_A_SCANF_WIDGET;
- fdat->scanf_widget = NOT_A_SCANF_WIDGET;
-
- if ((srate) && (fdat->srate_text))
- {
- str = XmTextGetString(fdat->srate_text);
- fdat->scanf_widget = SRATE_WIDGET;
- if ((str) && (*str))
- {
- (*srate) = string_to_int(str, 1, "srate");
- XtFree(str);
- }
- else snd_error_without_format("no srate?");
- }
-
- if ((chans) && (fdat->chans_text))
- {
- str = XmTextGetString(fdat->chans_text);
- fdat->scanf_widget = CHANS_WIDGET;
- if ((str) && (*str))
- {
- (*chans) = string_to_int(str, min_chan, "chans");
- XtFree(str);
- }
- else
- {
- if (min_chan > 0)
- snd_error_without_format("no chans?");
- }
- }
-
- if ((location) && (fdat->location_text))
- {
- str = XmTextGetString(fdat->location_text);
- fdat->scanf_widget = DATA_LOCATION_WIDGET;
- if ((str) && (*str))
- {
- (*location) = string_to_mus_long_t(str, 0, "data location");
- XtFree(str);
- }
- else snd_error_without_format("no data location?");
- }
-
- if ((samples) && (fdat->samples_text))
- {
- str = XmTextGetString(fdat->samples_text);
- fdat->scanf_widget = SAMPLES_WIDGET;
- if ((str) && (*str))
- {
- (*samples) = string_to_mus_long_t(str, 0, "samples");
- XtFree(str);
- }
- else snd_error_without_format("no samples?");
- }
- fdat->scanf_widget = SAMPLES_WIDGET;
-
- if ((type) && (fdat->header_list))
- {
- res = XmListGetSelectedPos(fdat->header_list, &ns, &n);
- if (res)
- {
- (*type) = position_to_type(ns[0] - 1);
- fdat->current_type = (*type);
- free(ns);
- ns = NULL;
- }
- }
-
- if ((format) && (fdat->format_list))
- {
- res = XmListGetSelectedPos(fdat->format_list, &ns, &n);
- if (res)
- {
- (*format) = position_to_format(fdat->current_type, ns[0] - 1);
- fdat->current_format = (*format);
- free(ns);
- ns = NULL;
- }
- }
-
- if (fdat->comment_text)
- {
- comment = XmTextGetString(fdat->comment_text);
- if (comment)
- {
- str = mus_strdup(comment);
- XtFree(comment);
- return(str);
- }
- }
-
- return(NULL);
-}
-
-
-#define IGNORE_DATA_LOCATION -1
-#define IGNORE_SAMPLES -1
-#define IGNORE_CHANS -1
-#define IGNORE_SRATE -1
-#define IGNORE_HEADER_TYPE -1
-
-static void set_file_dialog_sound_attributes(file_data *fdat,
- int type, int format, int srate, int chans, mus_long_t location, mus_long_t samples, char *comment)
-{
- int i;
- const char **fl = NULL;
- XmString *strs;
-
- if (type != IGNORE_HEADER_TYPE)
- fdat->current_type = type;
- else fdat->current_type = MUS_RAW;
- fdat->current_format = format;
- fl = type_and_format_to_position(fdat, fdat->current_type, fdat->current_format);
- if (fl == NULL) return;
-
- if ((type != IGNORE_HEADER_TYPE) &&
- (fdat->header_list))
- {
- XmListSelectPos(fdat->header_list, fdat->header_pos + 1, false);
- ensure_list_row_visible(fdat->header_list, fdat->header_pos + 1);
- }
-
- strs = (XmString *)malloc(fdat->formats * sizeof(XmString));
- for (i = 0; i < fdat->formats; i++)
- strs[i] = XmStringCreateLocalized((char *)fl[i]);
- XtVaSetValues(fdat->format_list,
- XmNitems, strs,
- XmNitemCount, fdat->formats,
- NULL);
- for (i = 0; i < fdat->formats; i++)
- XmStringFree(strs[i]);
- free(strs);
- XmListSelectPos(fdat->format_list, fdat->format_pos + 1, false);
- ensure_list_row_visible(fdat->format_list, fdat->format_pos + 1);
-
- if ((srate != IGNORE_SRATE) &&
- (fdat->srate_text))
- widget_int_to_text(fdat->srate_text, srate);
-
- if ((chans != IGNORE_CHANS) &&
- (fdat->chans_text))
- widget_int_to_text(fdat->chans_text, chans);
-
- if (fdat->comment_text)
- XmTextSetString(fdat->comment_text, comment);
-
- if ((location != IGNORE_DATA_LOCATION) &&
- (fdat->location_text))
- widget_mus_long_t_to_text(fdat->location_text, location);
-
- if ((samples != IGNORE_SAMPLES) &&
- (fdat->samples_text))
- widget_mus_long_t_to_text(fdat->samples_text, samples);
-}
-
-
-/* -------- error handling -------- */
-
-/* if an error occurs, a callback is added to the offending text widget, and an error is
- * posted in the error_text label. When the user modifies the bad entry, the callback
- * erases the error message, and removes itself from the text widget.
- */
-
-static void clear_dialog_error(file_data *fd)
-{
- if (XtIsManaged(fd->error_text))
- {
- XtUnmanageChild(fd->error_text);
- if (fd->comment_text)
- {
- XtVaSetValues(fd->comment_text,
- XmNbottomAttachment, XmATTACH_FORM,
- NULL);
- }
- }
-}
-
-
-static void show_dialog_error(file_data *fd)
-{
- if (!(XtIsManaged(fd->error_text)))
- {
- if (fd->comment_text)
- {
- XtVaSetValues(fd->comment_text,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, fd->error_text,
- NULL);
- }
- XtManageChild(fd->error_text);
- }
-}
-
-
-static void post_file_dialog_error(const char *error_msg, file_data *fd)
-{
- XmString msg;
- msg = XmStringCreateLocalized((char *)error_msg);
- XtVaSetValues(fd->error_text,
- XmNbackground, ss->yellow,
- XmNlabelString, msg,
- NULL);
- XmStringFree(msg);
- show_dialog_error(fd);
-}
-
-
-static void redirect_post_file_dialog_error(const char *error_msg, void *ufd)
-{
- post_file_dialog_error(error_msg, (file_data *)ufd);
-}
-
-
-static void filename_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_data *fd = (file_data *)context;
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- Widget dialog_filename_text;
- clear_dialog_error(fd);
- dialog_filename_text = FSB_BOX(fd->dialog, XmDIALOG_TEXT);
- if (dialog_filename_text) XtRemoveCallback(dialog_filename_text, XmNmodifyVerifyCallback, filename_modify_callback, context);
- cbs->doit = true;
-}
-
-
-static void clear_error_if_filename_changes(Widget dialog, file_data *data)
-{
- Widget dialog_filename_text;
- dialog_filename_text = FSB_BOX(dialog, XmDIALOG_TEXT);
- if (dialog_filename_text)
- XtAddCallback(dialog_filename_text, XmNmodifyVerifyCallback, filename_modify_callback, (XtPointer)data);
-}
-
-
-static void chans_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_data *fd = (file_data *)context;
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- clear_dialog_error(fd);
- XtRemoveCallback(fd->chans_text, XmNmodifyVerifyCallback, chans_modify_callback, context);
- cbs->doit = true;
-}
-
-
-static void clear_error_if_chans_changes(Widget dialog, file_data *fd)
-{
- if (fd->chans_text) XtAddCallback(fd->chans_text, XmNmodifyVerifyCallback, chans_modify_callback, (XtPointer)fd);
-}
-
-
-static void panel_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_data *fd = (file_data *)context;
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- clear_dialog_error(fd);
- XtRemoveCallback(w, XmNmodifyVerifyCallback, panel_modify_callback, context);
- cbs->doit = true;
-}
-
-
-static void clear_error_if_panel_changes(Widget dialog, file_data *fd)
-{
- Widget baddy;
- switch (fd->error_widget)
- {
- case SRATE_WIDGET: baddy = fd->srate_text; break;
- case DATA_LOCATION_WIDGET: baddy = fd->location_text; break;
- case SAMPLES_WIDGET: baddy = fd->samples_text; break;
- default: baddy = fd->chans_text; break;
- }
- if (baddy) XtAddCallback(baddy, XmNmodifyVerifyCallback, panel_modify_callback, (XtPointer)fd);
-}
-
-
-static void post_file_panel_error(const char *error_msg, void *ufd)
-{
- file_data *fd = (file_data *)ufd;
- fd->error_widget = fd->scanf_widget;
- post_file_dialog_error(error_msg, fd);
-}
-
-
-static void file_data_type_callback(Widget w, XtPointer context, XtPointer info)
-{
- int pos;
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- file_data *fd;
-
- XtVaGetValues(w, XmNuserData, &fd, NULL);
- pos = cbs->item_position - 1;
- if (position_to_type(pos) != fd->current_type)
- {
- position_to_type_and_format(fd, pos);
- set_file_dialog_sound_attributes(fd,
- fd->current_type,
- fd->current_format,
- IGNORE_SRATE, IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
- NULL);
- }
-}
-
-
-static void file_data_format_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- file_data *fd;
- XtVaGetValues(w, XmNuserData, &fd, NULL);
- fd->current_format = position_to_format(fd->current_type, cbs->item_position - 1);
-}
-
-
-static void file_data_src_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_data *fd = (file_data *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- fd->src = cb->set;
-}
-
-
-static void file_data_auto_comment_callback(Widget w, XtPointer context, XtPointer info)
-{
- file_data *fd = (file_data *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- fd->auto_comment = cb->set;
-}
-
-
-
-/* ---------------- File Data Panel ---------------- */
-
-
-#define PANEL_COMMENT_SPACE 16
-
-static file_data *make_file_data_panel(Widget parent, const char *name, Arg *in_args, int in_n,
- dialog_channels_t with_chan,
- int header_type, int data_format,
- dialog_data_location_t with_loc,
- dialog_samples_t with_samples,
- dialog_header_type_t with_header_type,
- dialog_comment_t with_comment,
- header_choice_t header_choice,
- bool with_src, bool with_auto_comment)
-{
- Widget form, header_label, data_label, srate_label, chans_label, sep1, sep2 = NULL, sep3, sep4;
- Widget comment_label = NULL, location_label, samples_label;
- file_data *fdat;
- Arg args[32];
- int i, n;
- XmString *strs;
- int nformats = 0, nheaders = 0;
- const char **formats = NULL, **headers = NULL;
-
- switch (header_choice)
- {
- case WITH_READABLE_HEADERS: headers = short_readable_headers(&nheaders); break;
- case WITH_WRITABLE_HEADERS: headers = short_writable_headers(&nheaders); break;
- case WITH_BUILTIN_HEADERS: headers = short_builtin_headers(&nheaders); break;
- }
-
- fdat = (file_data *)calloc(1, sizeof(file_data));
- fdat->src = save_as_dialog_src(ss);
- fdat->auto_comment = save_as_dialog_auto_comment(ss);
- fdat->saved_comment = NULL;
- fdat->current_type = header_type;
- fdat->current_format = data_format;
- formats = type_and_format_to_position(fdat, header_type, data_format);
- nformats = fdat->formats;
-
- /* pick up all args from caller -- args here are attachment points */
- form = XtCreateManagedWidget(name, xmFormWidgetClass, parent, in_args, in_n);
-
- if (with_header_type == WITH_HEADER_TYPE_FIELD)
- {
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNwidth, 5); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep1 = XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep1); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- header_label = XtCreateManagedWidget("header", xmLabelWidgetClass, form, args, n);
-
- /* what is selected depends on current type */
- strs = (XmString *)calloc(nheaders, sizeof(XmString));
- for (i = 0; i < nheaders; i++)
- strs[i] = XmStringCreateLocalized((char *)headers[i]);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, header_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep1); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlistMarginWidth, 1); n++;
- XtSetArg(args[n], XmNuserData, (XtPointer)fdat); n++;
- XtSetArg(args[n], XmNitems, strs); n++;
- XtSetArg(args[n], XmNitemCount, nheaders); n++;
- XtSetArg(args[n], XmNvisibleItemCount, NUM_VISIBLE_HEADERS); n++;
- fdat->header_list = XmCreateScrolledList(form, (char *)"header-type", args, n);
- XtManageChild(fdat->header_list);
-
- for (i = 0; i < nheaders; i++)
- XmStringFree(strs[i]);
- free(strs);
- XmListSelectPos(fdat->header_list, fdat->header_pos + 1, false);
- XtAddCallback(fdat->header_list, XmNbrowseSelectionCallback, file_data_type_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, fdat->header_list); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNwidth, 15); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep2 = XtCreateManagedWidget("sep2", xmSeparatorWidgetClass, form, args, n);
- }
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- if (with_header_type == WITH_HEADER_TYPE_FIELD)
- {
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep2); n++;
- }
- else
- {
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- }
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- data_label = XtCreateManagedWidget("data", xmLabelWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, data_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- if (with_header_type == WITH_HEADER_TYPE_FIELD)
- {
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep2); n++;
- }
- else
- {
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- }
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNuserData, (XtPointer)fdat); n++;
- fdat->format_list = XmCreateScrolledList(form, (char *)"data-format", args, n);
-
- strs = (XmString *)calloc(nformats, sizeof(XmString));
- for (i = 0; i < nformats; i++)
- strs[i] = XmStringCreateLocalized((char *)formats[i]);
- XtVaSetValues(fdat->format_list,
- XmNitems, strs,
- XmNitemCount, nformats,
- NULL);
- for (i = 0; i < nformats; i++)
- XmStringFree(strs[i]);
- free(strs);
-
- XmListSelectPos(fdat->format_list, fdat->format_pos + 1, false);
- XtManageChild(fdat->format_list);
- XtAddCallback(fdat->format_list, XmNbrowseSelectionCallback, file_data_format_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, fdat->format_list); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNwidth, 15); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep3 = XtCreateManagedWidget("sep3", xmSeparatorWidgetClass, form, args, n);
-
-
- /* srate */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep3); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- srate_label = XtCreateManagedWidget("srate", xmLabelWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNcolumns, 8); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, srate_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep3); n++;
- if (with_src)
- {
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- }
- else
- {
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- }
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- fdat->srate_text = make_textfield_widget("srate-text", form, args, n, NOT_ACTIVATABLE, add_completer_func(srate_completer, NULL));
-
- if (with_src)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, srate_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, fdat->srate_text); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++; /* this is probably clobbered by color_file_selection_box */
- fdat->src_button = make_togglebutton_widget("src", form, args, n);
- XtAddCallback(fdat->src_button, XmNvalueChangedCallback, file_data_src_callback, (XtPointer)fdat);
- XmToggleButtonSetState(fdat->src_button, fdat->src, false);
- }
-
- if (with_chan != WITHOUT_CHANNELS_FIELD)
- {
- /* chans */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, fdat->srate_text); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep3); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- chans_label = XtCreateManagedWidget((char *)((with_chan == WITH_CHANNELS_FIELD) ? "channels" : "extract channel"), xmLabelWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNcolumns, 6); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, chans_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep3); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- fdat->chans_text = make_textfield_widget("chans-text", form, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
- XmTextFieldSetString(fdat->chans_text, (char *)"0");
-
- if (with_loc == WITH_DATA_LOCATION_FIELD)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, fdat->chans_text); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep3); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- location_label = XtCreateManagedWidget("data location", xmLabelWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNcolumns, 6); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, location_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, (with_samples == WITHOUT_SAMPLES_FIELD) ? XmATTACH_FORM : XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep3); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- fdat->location_text = make_textfield_widget("location-text", form, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
- }
- }
-
- if (with_samples == WITH_SAMPLES_FIELD)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, ((fdat->location_text) ? fdat->location_text :
- ((fdat->chans_text) ? fdat->chans_text : fdat->srate_text))); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep3); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- samples_label = XtCreateManagedWidget("samples", xmLabelWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNcolumns, 8); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, samples_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep3); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- fdat->samples_text = make_textfield_widget("samples-text", form, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
- }
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, form); n++; /* form is the internal XmForm widget holding the lists etc */
- XtSetArg(args[n], XmNbottomAttachment, (with_comment != WITHOUT_COMMENT_FIELD) ? XmATTACH_NONE : XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, (with_comment != WITHOUT_COMMENT_FIELD) ? PANEL_COMMENT_SPACE : 2); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep4 = XtCreateManagedWidget("sep4", xmSeparatorWidgetClass, parent, args, n);
-
- /* try to make the comment field the one that grows */
- n = 0;
- if (with_comment == WITHOUT_COMMENT_FIELD)
- {
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep4); n++;
- }
- else
- {
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- }
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++; /* overridden later -> yellow */
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNborderColor, ss->black); n++;
- XtSetArg(args[n], XmNborderWidth, 2); n++;
- XtSetArg(args[n], XmNmarginWidth, 10); n++;
- XtSetArg(args[n], XmNmarginHeight, 10); n++;
- fdat->error_text = XtCreateWidget("", xmLabelWidgetClass, parent, args, n);
- /* XtUnmanageChild(fdat->error_text); */
-
- if (with_comment != WITHOUT_COMMENT_FIELD)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep4); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- comment_label = XtCreateManagedWidget("comment", xmLabelWidgetClass, parent, args, n);
-
- if (with_auto_comment)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep4); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- fdat->auto_comment_button = make_togglebutton_widget("auto", parent, args, n);
- XtAddCallback(fdat->auto_comment_button, XmNvalueChangedCallback, file_data_auto_comment_callback, (XtPointer)fdat);
- XmToggleButtonSetState(fdat->auto_comment_button, fdat->auto_comment, false);
- }
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- if (with_auto_comment)
- {
- XtSetArg(args[n], XmNtopWidget, fdat->auto_comment_button); n++;
- }
- else
- {
- XtSetArg(args[n], XmNtopWidget, comment_label); n++;
- }
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrows, 4); n++;
- /* XtSetArg(args[n], XmNcolumns, 16); n++; */ /* this sets the lower size, so we don't want it too big */
- fdat->comment_text = make_text_widget("comment-text", parent, args, n);
- }
- else fdat->comment_text = NULL;
-
- return(fdat);
-}
-
-
-static void reflect_file_data_panel_change(file_data *fd, void *data, void (*change_action)(Widget w, XtPointer context, XtPointer info))
-{
- if (fd->srate_text)
- XtAddCallback(fd->srate_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->chans_text)
- XtAddCallback(fd->chans_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->samples_text)
- XtAddCallback(fd->samples_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->location_text)
- XtAddCallback(fd->location_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->comment_text)
- XtAddCallback(fd->comment_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->format_list)
- XtAddCallback(fd->format_list, XmNbrowseSelectionCallback, change_action, (XtPointer)data);
- if (fd->header_list)
- XtAddCallback(fd->header_list, XmNbrowseSelectionCallback, change_action, (XtPointer)data);
-}
-
-
-static void unreflect_file_data_panel_change(file_data *fd, void *data, void (*change_action)(Widget w, XtPointer context, XtPointer info))
-{
- if (fd->srate_text)
- XtRemoveCallback(fd->srate_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->chans_text)
- XtRemoveCallback(fd->chans_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->samples_text)
- XtRemoveCallback(fd->samples_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->location_text)
- XtRemoveCallback(fd->location_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->comment_text)
- XtRemoveCallback(fd->comment_text, XmNvalueChangedCallback, change_action, (XtPointer)data);
- if (fd->format_list)
- XtRemoveCallback(fd->format_list, XmNbrowseSelectionCallback, change_action, (XtPointer)data);
- if (fd->header_list)
- XtRemoveCallback(fd->header_list, XmNbrowseSelectionCallback, change_action, (XtPointer)data);
-}
-
-
-/* -------- save as dialog (file and edit menus) -------- */
-
-typedef struct {
- file_data *panel_data;
- Widget dialog, filename_widget, extractB, mkdirB;
- char *filename; /* output name (?) */
- save_dialog_t type;
- file_pattern_info *fp;
- dialog_play_info *dp;
- fam_info *file_watcher;
- file_popup_info *fpop;
- const char *original_filename;
-} save_as_dialog_info;
-
-static save_as_dialog_info *save_sound_as = NULL, *save_selection_as = NULL, *save_region_as = NULL;
-
-
-static save_as_dialog_info *new_save_as_dialog_info(save_dialog_t type)
-{
- save_as_dialog_info *sd;
- sd = (save_as_dialog_info *)calloc(1, sizeof(save_as_dialog_info));
- sd->type = type;
- return(sd);
-}
-
-
-static void make_auto_comment(save_as_dialog_info *sd)
-{
- if ((sd == save_sound_as) &&
- (XtIsManaged(sd->dialog)))
- {
- file_data *fd;
- fd = sd->panel_data;
-
- if (!(fd->auto_comment))
- {
- /* don't erase typed-in comment, if any */
- XmTextSetString(fd->comment_text, fd->saved_comment);
- }
- else
- {
- snd_info *sp;
- bool edits = false;
- int i;
- char *original_sound_comment, *comment, *orig_comment = NULL;
-
- sp = any_selected_sound();
-
- original_sound_comment = mus_sound_comment(sp->filename);
- if (original_sound_comment)
- {
- if (*original_sound_comment)
- orig_comment = mus_format("\n%s comment:\n%s\n", sp->short_filename, original_sound_comment);
- free(original_sound_comment);
- original_sound_comment = NULL;
- }
-
- if (fd->saved_comment) XtFree(fd->saved_comment);
- fd->saved_comment = XmTextGetString(fd->comment_text);
- if ((fd->saved_comment) &&
- (!(*(fd->saved_comment))))
- {
- /* this is the norm in Motif */
- XtFree(fd->saved_comment);
- fd->saved_comment = NULL;
- }
-
- for (i = 0; i < sp->nchans; i++)
- if (sp->chans[i]->edit_ctr != 0)
- {
- edits = true;
- break;
- }
-
- if (!edits)
- comment = mus_format("%s%ssaved %s from %s (no edits)\n%s",
- (fd->saved_comment) ? fd->saved_comment : "",
- (fd->saved_comment) ? "\n" : "",
- snd_local_time(),
- sp->filename,
- (orig_comment) ? orig_comment : "");
- else
- {
- int len;
- char **edit_strs;
- char *time;
-
- time = snd_local_time();
- len = 2 * mus_strlen(sp->filename) +
- mus_strlen(time) +
- 32 * sp->nchans +
- mus_strlen(fd->saved_comment) +
- mus_strlen(original_sound_comment);
-
- edit_strs = (char **)malloc(sp->nchans * sizeof(char *));
- for (i = 0; i < sp->nchans; i++)
- {
- edit_strs[i] = edit_list_to_function(sp->chans[i], 1, sp->chans[i]->edit_ctr);
- len += mus_strlen(edit_strs[i]);
- }
-
- comment = (char *)calloc(len, sizeof(char));
- mus_snprintf(comment, len, "%s%ssaved %s from %s with edits:\n",
- (fd->saved_comment) ? fd->saved_comment : "",
- (fd->saved_comment) ? "\n" : "",
- snd_local_time(),
- sp->filename);
-
- for (i = 0; i < sp->nchans; i++)
- {
- if (sp->nchans > 1)
- {
- char buf[32];
- snprintf(buf, 32, "\n-------- channel %d --------\n", i);
- strcat(comment, buf);
- }
- strcat(comment, edit_strs[i]);
- }
-
- if (orig_comment)
- strcat(comment, orig_comment);
- }
-
- XmTextSetString(fd->comment_text, comment);
- if (comment) free(comment);
- if (orig_comment) free(orig_comment);
- }
- }
-}
-
-
-static void auto_comment_callback(Widget w, XtPointer context, XtPointer info)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- sd->panel_data->auto_comment = (cb->set);
- make_auto_comment(sd);
-}
-
-
-void reflect_save_as_src(bool val)
-{
- if (save_sound_as)
- XmToggleButtonSetState(save_sound_as->panel_data->src_button, val, true);
- if (save_selection_as)
- XmToggleButtonSetState(save_selection_as->panel_data->src_button, val, true);
- if (save_region_as)
- XmToggleButtonSetState(save_region_as->panel_data->src_button, val, true);
-}
-
-
-void reflect_save_as_auto_comment(bool val)
-{
- if (save_sound_as)
- XmToggleButtonSetState(save_sound_as->panel_data->auto_comment_button, val, true);
-}
-
-
-void reflect_save_as_sound_selection(const char *sound_name)
-{
- if ((save_sound_as) &&
- (XtIsManaged(save_sound_as->dialog)))
- {
- XmString xmstr2;
- char *file_string;
- file_string = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- if (sound_name)
- mus_snprintf(file_string, PRINT_BUFFER_SIZE, "save %s", sound_name);
- else
- {
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- mus_snprintf(file_string, PRINT_BUFFER_SIZE, "save %s", sp->short_filename);
- else mus_snprintf(file_string, PRINT_BUFFER_SIZE, "nothing to save!");
- }
- xmstr2 = XmStringCreateLocalized(file_string);
- XtVaSetValues(save_sound_as->dialog, XmNdialogTitle, xmstr2, NULL);
- XmStringFree(xmstr2);
- free(file_string);
- }
-}
-
-
-static XEN save_selection_hook_handler(XEN xreason)
-{
- int reason;
- save_as_dialog_info *sd;
-
- sd = save_selection_as;
- reason = XEN_TO_C_INT(xreason);
-
- if ((reason == SELECTION_ACTIVE) ||
- (selection_is_active()))
- {
- clear_dialog_error(sd->panel_data);
- }
- return(XEN_FALSE);
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_ARGIFY_1(save_selection_hook_handler_w, save_selection_hook_handler)
-#else
- #define save_selection_hook_handler_w save_selection_hook_handler
-#endif
-
-
-void reflect_region_in_save_as_dialog(void)
-{
- if ((save_region_as) &&
- (save_region_as->dialog) &&
- (XtIsManaged(save_region_as->dialog)) &&
- (region_ok(region_dialog_region())))
- clear_dialog_error(save_region_as->panel_data);
-}
-
-
-static void save_as_filename_modify_callback(Widget w, XtPointer context, XtPointer info);
-
-static void save_as_undoit(save_as_dialog_info *sd)
-{
- XmString ok_label;
- ok_label = XmStringCreateLocalized((char *)"Save");
- XtVaSetValues(sd->dialog,
- XmNokLabelString, ok_label,
- NULL);
- XmStringFree(ok_label);
- clear_dialog_error(sd->panel_data);
- XtRemoveCallback(sd->filename_widget, XmNmodifyVerifyCallback, save_as_filename_modify_callback, (XtPointer)(sd->panel_data));
- sd->file_watcher = fam_unmonitor_file(sd->filename, sd->file_watcher);
-}
-
-
-static void save_as_filename_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- save_as_undoit((save_as_dialog_info *)context);
- cbs->doit = true;
-}
-
-
-static void clear_error_if_save_as_filename_changes(Widget dialog, save_as_dialog_info *sd)
-{
- XtAddCallback(sd->filename_widget, XmNmodifyVerifyCallback, save_as_filename_modify_callback, (XtPointer)sd);
-}
-
-
-static void watch_save_as_file(struct fam_info *fp, FAMEvent *fe)
-{
-#if HAVE_FAM
- /* if file is deleted, respond in some debonair manner */
- switch (fe->code)
- {
- case FAMChanged:
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- save_as_undoit((save_as_dialog_info *)(fp->data));
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-#endif
-}
-
-
-static bool srates_differ(int srate, save_as_dialog_info *sd)
-{
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- return(SND_SRATE(any_selected_sound()) != srate);
-
- case SELECTION_SAVE_AS:
- return(selection_srate() != srate);
-
- case REGION_SAVE_AS:
- return(region_srate(region_dialog_region()) != srate);
- }
-
- return(false);
-}
-
-
-static double srate_ratio(int srate, save_as_dialog_info *sd)
-{
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- return((double)(SND_SRATE(any_selected_sound())) / (double)srate);
-
- case SELECTION_SAVE_AS:
- return((double)selection_srate() / (double)srate);
-
- case REGION_SAVE_AS:
- return((double)region_srate(region_dialog_region()) / (double)srate);
- }
-
- return(1.0);
-}
-
-
-static void save_or_extract(save_as_dialog_info *sd, bool saving)
-{
- char *str = NULL, *comment = NULL, *msg = NULL, *fullname = NULL, *tmpfile = NULL;
- snd_info *sp = NULL;
- int type = MUS_NEXT, format = DEFAULT_OUTPUT_DATA_FORMAT, srate = DEFAULT_OUTPUT_SRATE;
- int output_type, chan = 0, extractable_chans = 0;
- bool file_exists = false;
- io_error_t io_err = IO_NO_ERROR;
-
- clear_dialog_error(sd->panel_data);
-
- if ((sd->type == SELECTION_SAVE_AS) &&
- (!(selection_is_active())))
- {
- if (saving)
- msg = (char *)"no selection to save";
- else msg = (char *)"can't extract: no selection";
- post_file_dialog_error((const char *)msg, sd->panel_data);
- return;
- }
-
- if ((sd->type == REGION_SAVE_AS) &&
- (!(region_ok(region_dialog_region()))))
- {
- post_file_dialog_error("no region to save", sd->panel_data);
- return;
- }
-
- sp = any_selected_sound();
- if ((!sp) &&
- (sd->type != REGION_SAVE_AS))
- {
- if (saving)
- msg = (char *)"nothing to save";
- else msg = (char *)"nothing to extract";
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->dialog, sd->panel_data);
- return;
- }
-
- /* get output filename */
- str = XmTextGetString(sd->filename_widget);
- if ((!str) || (!*str))
- {
- if (saving)
- msg = (char *)"can't save: no file name given";
- else msg = (char *)"can't extract: no file name given";
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->dialog, sd->panel_data);
- return;
- }
-
- /* get output file attributes */
- redirect_snd_error_to(post_file_panel_error, (void *)(sd->panel_data));
- {
- mus_long_t location = 28, samples = 0;
- int chans = 1;
- if (saving)
- comment = get_file_dialog_sound_attributes(sd->panel_data, &srate, &chans, &type, &format, &location, &samples, 0);
- else comment = get_file_dialog_sound_attributes(sd->panel_data, &srate, &chan, &type, &format, &location, &samples, 0);
- }
- output_type = type;
- redirect_snd_error_to(NULL, NULL);
-
- if (sd->panel_data->error_widget != NOT_A_SCANF_WIDGET)
- {
- clear_error_if_panel_changes(sd->dialog, sd->panel_data);
- if (comment) free(comment);
- XtFree(str);
- return;
- }
-
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- clear_minibuffer(sp);
- if (!saving)
- extractable_chans = sp->nchans;
- break;
-
- case SELECTION_SAVE_AS:
- if (!saving)
- extractable_chans = selection_chans();
- break;
-
- default:
- break;
- }
-
- if (!saving)
- {
- if ((chan > extractable_chans) ||
- (((extractable_chans > 1) && (chan == extractable_chans)) ||
- (chan < 0)))
- {
- if (chan > extractable_chans)
- msg = mus_format("can't extract chan %d (%s has %d chan%s)",
- chan,
- (sd->type == SOUND_SAVE_AS) ? "sound" : "selection",
- extractable_chans,
- (extractable_chans > 1) ? "s" : "");
- else msg = mus_format("can't extract chan %d (first chan is numbered 0)", chan);
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_chans_changes(sd->dialog, sd->panel_data);
- free(msg);
- if (comment) free(comment);
- XtFree(str);
- return;
- }
- }
-
- fullname = mus_expand_filename(str);
- if (run_before_save_as_hook(sp, fullname, sd->type != SOUND_SAVE_AS, srate, type, format, comment))
- {
- msg = mus_format("%s cancelled by %s", (saving) ? "save" : "extract", S_before_save_as_hook);
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->dialog, sd->panel_data);
- free(msg);
- free(fullname);
- if (comment) free(comment);
- XtFree(str);
- return;
- }
-
- file_exists = mus_file_probe(fullname);
- if ((sd->type == SOUND_SAVE_AS) &&
- (mus_strcmp(fullname, sp->filename)))
- {
- /* save-as here is the same as save */
- if ((sp->user_read_only == FILE_READ_ONLY) ||
- (sp->file_read_only == FILE_READ_ONLY))
- {
- msg = mus_format("can't overwrite %s (it is write-protected)", sp->short_filename);
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->dialog, sd->panel_data);
- free(msg);
- free(fullname);
- if (comment) free(comment);
- XtFree(str);
- return;
- }
- }
- else
- {
- if (!(sd->file_watcher))
- {
- /* check for overwrites that are questionable -- DoIt click will return here with sd->file_watcher active */
- snd_info *parlous_sp = NULL;
- if ((file_exists) &&
- ((ask_before_overwrite(ss)) ||
- ((sd->type == SOUND_SAVE_AS) &&
- (parlous_sp = file_is_open_elsewhere_and_has_unsaved_edits(sp, fullname)))))
- {
- XmString ok_label;
- msg = mus_format("%s exists%s. To overwrite it, click 'DoIt'",
- str,
- (parlous_sp) ? ", and has unsaved edits" : "");
- sd->file_watcher = fam_monitor_file(fullname, (void *)sd, watch_save_as_file);
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_save_as_filename_changes(sd->dialog, sd);
- ok_label = XmStringCreateLocalized((char *)"DoIt");
- XtVaSetValues(sd->dialog,
- XmNokLabelString, ok_label,
- NULL);
- XmUpdateDisplay(FSB_BOX(sd->dialog, XmDIALOG_OK_BUTTON));
- XmStringFree(ok_label);
- free(msg);
- free(fullname);
- if (comment) free(comment);
- XtFree(str);
- return;
- }
- }
- }
-
- /* try to save... if it exists already, first write as temp, then move */
- if (sd->file_watcher)
- save_as_undoit(sd);
- ss->local_errno = 0;
-
- if (encoded_header_p(type))
- {
- output_type = type;
- format = MUS_LSHORT;
- type = MUS_RIFF;
- tmpfile = snd_tempnam();
- }
- else
- {
- tmpfile = fullname;
- }
-
- redirect_snd_error_to(redirect_post_file_dialog_error, (void *)(sd->panel_data));
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- if (saving)
- io_err = save_edits_without_display(sp, tmpfile, type, format, srate, comment, AT_CURRENT_EDIT_POSITION);
- else io_err = save_channel_edits(sp->chans[chan], tmpfile, AT_CURRENT_EDIT_POSITION); /* protects if same name */
- break;
-
- case SELECTION_SAVE_AS:
- {
- char *ofile;
- if (file_exists) /* file won't exist if we're encoding, so this isn't as wasteful as it looks */
- ofile = snd_tempnam();
- else ofile = mus_strdup(tmpfile);
- io_err = save_selection(ofile, type, format, srate, comment, (saving) ? SAVE_ALL_CHANS : chan);
- if (io_err == IO_NO_ERROR)
- io_err = move_file(ofile, fullname);
- free(ofile);
- }
- break;
-
- case REGION_SAVE_AS:
- {
- char *ofile;
- if (region_ok(region_dialog_region()))
- {
- if (file_exists)
- ofile = snd_tempnam();
- else ofile = mus_strdup(tmpfile);
- io_err = save_region(region_dialog_region(), ofile, type, format, comment);
- if (io_err == IO_NO_ERROR)
- io_err = move_file(ofile, fullname);
- free(ofile);
- }
- }
- break;
- }
- redirect_snd_error_to(NULL, NULL);
-
- /* check for possible srate conversion */
- if ((sd->panel_data->src) &&
- (srates_differ(srate, sd)))
- {
- /* if src, and srates differ, do the sampling rate conversion.
- * this needs to happen before the snd_encode (->OGG etc) below
- * if we do it before the save-as above, then undo it later, it messes up the user's edit history list
- * so do it here to tmpfile (tmpfile is fullname unless we're doing a translation to something like OGG)
- */
- src_file(tmpfile, srate_ratio(srate, sd));
- }
-
- if (io_err == IO_NO_ERROR)
- {
- if (encoded_header_p(output_type))
- {
- snd_encode(output_type, tmpfile, fullname);
- snd_remove(tmpfile, REMOVE_FROM_CACHE);
- free(tmpfile);
- }
- remember_filename(fullname, sd->fpop->file_text_names);
-
- if (!file_exists)
- force_directory_reread(sd->dialog);
- if (saving)
- {
- if (sd->type == SOUND_SAVE_AS)
- report_in_minibuffer(sp, "%s saved as %s", sp->short_filename, str);
- else report_in_minibuffer(sp, "%s saved as %s", (sd->type == SELECTION_SAVE_AS) ? "selection" : "region", str);
- }
- else
- {
- if (sd->type == SOUND_SAVE_AS)
- report_in_minibuffer(sp, "%s chan %d saved as %s", sp->short_filename, chan, str);
- else report_in_minibuffer(sp, "selection chan %d saved as %s", chan, str);
- }
- run_after_save_as_hook(sp, str, true); /* true => from dialog */
- XtUnmanageChild(sd->dialog);
- }
- else
- {
- msg = mus_format("%s as %s: %s (%s)", (saving) ? "save" : "extract chan", str, io_error_name(io_err), snd_io_strerror());
- post_file_dialog_error((const char *)msg, sd->panel_data);
- clear_error_if_filename_changes(sd->dialog, sd->panel_data);
- free(msg);
- }
-
- free(fullname);
- XtFree(str);
- if (comment) free(comment);
-}
-
-
-static void save_as_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- save_or_extract((save_as_dialog_info *)context, true);
-}
-
-
-static void save_as_extract_callback(Widget w, XtPointer context, XtPointer info)
-{
- save_or_extract((save_as_dialog_info *)context, false);
-}
-
-
-static void save_as_dialog_select_callback(Widget w, XtPointer context, XtPointer info)
-{
- dialog_play_info *dp = (dialog_play_info *)context;
- char *filename = NULL;
- XmString *strs;
- XtVaGetValues(w, XmNselectedItems, &strs, NULL);
- filename = (char *)XmStringUnparse(strs[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- if ((filename) && (sound_file_p(filename)))
- XtManageChild(dp->play_button);
- else
- {
- if (XtIsManaged(dp->play_button))
- XtUnmanageChild(dp->play_button);
- }
- if (filename) XtFree(filename);
-}
-
-
-static void save_as_cancel_callback(Widget w, XtPointer context, XtPointer info)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- XtUnmanageChild(sd->dialog);
-}
-
-
-static void save_as_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- save_as_dialog_help();
-}
-
-
-static void save_as_file_exists_check(Widget w, XtPointer context, XtPointer info)
-{
- Widget dialog = (Widget)context;
- char *filename = NULL;
- XmString s1;
- filename = XmTextGetString(w);
- if ((filename) && (*filename))
- {
- if ((mus_file_probe(filename)) &&
- (!directory_p(filename)))
- {
-#if HAVE_ACCESS
- if (access(filename, W_OK) < 0)
- s1 = XmStringCreateLocalized((char *)"save as (file write-protected?):");
- else
-#endif
- s1 = XmStringCreateLocalized((char *)"save as (overwriting):");
- }
- else
- {
- if (!(directory_exists(filename)))
- s1 = XmStringCreateLocalized((char *)"save as (no such directory?):");
- else s1 = XmStringCreateLocalized((char *)"save as:");
- }
- }
- else s1 = XmStringCreateLocalized((char *)"save as:");
- XtVaSetValues(dialog,
- XmNselectionLabelString, s1,
- NULL);
- if (filename) XtFree(filename);
-}
-
-
-static void save_as_mkdir_callback(Widget w, XtPointer context, XtPointer info)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- char *filename = NULL;
- filename = XmTextGetString(FSB_BOX(sd->dialog, XmDIALOG_TEXT));
- if (snd_mkdir(filename) < 0)
- {
- /* could not make the directory */
- char *str;
- str = mus_format("can't make %s: %s", filename, strerror(errno));
- post_file_dialog_error((const char *)str, sd->panel_data);
- clear_error_if_filename_changes(sd->dialog, sd->panel_data);
- free(str);
- }
- else
- {
- /* set FSB to new dir and force update */
- char *filter;
- filter = mus_format("%s*", filename); /* already has the "/" at the end */
- update_dir_list(sd->dialog, filter);
- free(filter);
- XtSetSensitive(w, false);
- }
- XtFree(filename);
-}
-
-
-static void reflect_text_in_save_button(Widget w, XtPointer context, XtPointer info)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- /* w here is text widget, not button */
- XtSetSensitive(FSB_BOX(sd->dialog, XmDIALOG_OK_BUTTON), (!(file_is_directory(sd->dialog))));
- if (sd->mkdirB) XtSetSensitive(sd->mkdirB, file_is_nonexistent_directory(sd->dialog));
-}
-
-
-static void reflect_text_in_extract_button(Widget w, XtPointer context, XtPointer info)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- /* w here is text widget, not button */
- XtSetSensitive(sd->extractB, (!(file_is_directory(sd->dialog))));
-}
-
-
-static void save_as_filter_text_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- save_as_dialog_info *sd = (save_as_dialog_info *)context;
- force_directory_reread_and_let_filename_change(sd->dialog);
-}
-
-
-static void make_save_as_dialog(save_as_dialog_info *sd, char *sound_name, int header_type, int format_type)
-{
- char *file_string;
-
- sd->original_filename = sound_name;
- if (!(sd->dialog))
- {
- Arg args[32];
- int n;
- XmString xmstr1, xmstr2, s1;
- XmString filter_list_label, cancel_label;
- Widget extractB, mainform;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- s1 = XmStringCreateLocalized((char *)"save as:");
- XtSetArg(args[n], XmNselectionLabelString, s1); n++;
-
- xmstr1 = XmStringCreateLocalized((char *)"Save");
- XtSetArg(args[n], XmNokLabelString, xmstr1); n++;
-
- file_string = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(file_string, PRINT_BUFFER_SIZE, "save %s", sound_name);
-
- xmstr2 = XmStringCreateLocalized(file_string);
- XtSetArg(args[n], XmNdialogTitle, xmstr2); n++;
-
- filter_list_label = XmStringCreateLocalized((char *)"files listed:");
- XtSetArg(args[n], XmNfilterLabelString, filter_list_label); n++;
-
- cancel_label = XmStringCreateLocalized((char *)"Go Away");
- XtSetArg(args[n], XmNcancelLabelString, cancel_label); n++;
-
- sd->fp = (file_pattern_info *)calloc(1, sizeof(file_pattern_info));
- sd->fp->in_just_sounds_update = false;
- if (just_sounds(ss))
- sd->fp->filter_choice = JUST_SOUNDS_FILTER;
- else sd->fp->filter_choice = NO_FILE_FILTER;
-
- sd->dp = (dialog_play_info *)calloc(1, sizeof(dialog_play_info));
- sd->fpop = (file_popup_info *)calloc(1, sizeof(file_popup_info));
- sd->fpop->fp = sd->fp;
-
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNchildPlacement, XmPLACE_ABOVE_SELECTION); n++;
- XtSetArg(args[n], XmNallowOverlap, false); n++;
- XtSetArg(args[n], XmNheight, 600); n++;
- XtSetArg(args[n], XmNuserData, (XtPointer)sd->fp); n++;
- XtSetArg(args[n], XmNfileFilterStyle, XmFILTER_HIDDEN_FILES); n++;
- XtSetArg(args[n], XmNfileSearchProc, snd_directory_reader); n++; /* over-ride Motif's directory reader altogether */
-
- sd->dialog = XmCreateFileSelectionDialog(MAIN_SHELL(ss), (char *)"save-as", args, n);
- sd->fp->dialog = sd->dialog;
- sd->dp->dialog = sd->dialog;
- sd->fpop->dialog = sd->dialog;
-
- free(file_string);
-
- XtUnmanageChild(FSB_BOX(sd->dialog, XmDIALOG_DIR_LIST_LABEL));
- XtUnmanageChild(FSB_BOX(sd->dialog, XmDIALOG_LIST_LABEL));
- XtUnmanageChild(FSB_BOX(sd->dialog, XmDIALOG_APPLY_BUTTON));
-
- XtVaSetValues(FSB_BOX(sd->dialog, XmDIALOG_FILTER_LABEL), XmNbackground, ss->basic_color, NULL);
- XtVaSetValues(FSB_BOX(sd->dialog, XmDIALOG_SELECTION_LABEL), XmNbackground, ss->basic_color, NULL);
-
- XmStringFree(s1);
- XmStringFree(xmstr1);
- XmStringFree(xmstr2);
- XmStringFree(filter_list_label);
- XmStringFree(cancel_label);
-
-#if HAVE_FAM
- {
- char *our_dir;
- XmString cur_dir;
- XtVaGetValues(sd->dialog, XmNdirectory, &cur_dir, NULL);
- our_dir = (char *)XmStringUnparse(cur_dir, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- sd->fp->directory_watcher = fam_monitor_directory(our_dir, (void *)(sd->fp), watch_current_directory_contents);
- /* don't set last_dir yet */
- XtFree(our_dir);
- }
-#endif
-
- sd->filename_widget = FSB_BOX(sd->dialog, XmDIALOG_TEXT);
- XtAddCallback(sd->dialog, XmNhelpCallback, save_as_help_callback, (XtPointer)sd);
- XtAddCallback(sd->dialog, XmNcancelCallback, save_as_cancel_callback, (XtPointer)sd);
- XtAddCallback(sd->dialog, XmNokCallback, save_as_ok_callback, (XtPointer)sd);
-
- mainform = XtVaCreateManagedWidget("filebuttons-mainform", xmFormWidgetClass, sd->dialog, NULL);
- add_play_and_just_sounds_buttons(sd->dialog, mainform, sd->fp, sd->dp);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sd->fp->just_sounds_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- sd->panel_data = make_file_data_panel(mainform, "data-form", args, n,
- (sd->type == REGION_SAVE_AS) ? WITHOUT_CHANNELS_FIELD : WITH_EXTRACT_CHANNELS_FIELD,
- header_type, format_type,
- WITHOUT_DATA_LOCATION_FIELD,
- WITHOUT_SAMPLES_FIELD,
- WITH_HEADER_TYPE_FIELD,
- WITH_COMMENT_FIELD,
- WITH_WRITABLE_HEADERS,
- true,
- sd->type == SOUND_SAVE_AS);
-
- sd->panel_data->dialog = sd->dialog;
-
- color_file_selection_box(sd->dialog);
-
- XtVaSetValues(sd->panel_data->format_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- XtVaSetValues(sd->panel_data->header_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- XtVaSetValues(sd->fp->just_sounds_button, XmNselectColor, ss->selection_color, NULL);
- XtVaSetValues(sd->dp->play_button, XmNselectColor, ss->selection_color, NULL);
-
- XtVaSetValues(sd->panel_data->src_button, XmNselectColor, ss->selection_color, NULL);
- if (sd->type == SOUND_SAVE_AS)
- {
- XtVaSetValues(sd->panel_data->auto_comment_button, XmNselectColor, ss->selection_color, NULL);
- XtAddCallback(sd->panel_data->auto_comment_button, XmNvalueChangedCallback, auto_comment_callback, (XtPointer)sd);
- }
- XtAddCallback(FSB_BOX(sd->dialog, XmDIALOG_LIST),
- XmNbrowseSelectionCallback, save_as_dialog_select_callback, (XtPointer)(sd->dp));
- XtAddCallback(sd->filename_widget, XmNvalueChangedCallback, save_as_file_exists_check, (XtPointer)(sd->dialog));
- XtAddCallback(FSB_BOX(sd->dialog, XmDIALOG_FILTER_TEXT), XmNactivateCallback, save_as_filter_text_activate_callback, (void *)sd);
-
- {
- Widget wtmp;
- wtmp = FSB_BOX(sd->dialog, XmDIALOG_DIR_LIST);
- if (wtmp) XtAddCallback(wtmp, XmNbrowseSelectionCallback, file_change_directory_callback, (XtPointer)(sd->fp));
- }
-
- add_file_popups(sd->fpop);
-
- /* this must come after the file data panel so that Motif puts it in the button box, not the main work area */
- if (sd->type != REGION_SAVE_AS)
- {
- /* add "Extract" button */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- extractB = XtCreateManagedWidget("Extract", xmPushButtonGadgetClass, sd->dialog, args, n);
- XtAddCallback(extractB, XmNactivateCallback, save_as_extract_callback, (XtPointer)sd);
- sd->extractB = extractB;
-
- XtSetSensitive(extractB, (!(file_is_directory(sd->dialog))));
- XtAddCallback(FSB_BOX(sd->dialog, XmDIALOG_TEXT), XmNvalueChangedCallback, reflect_text_in_extract_button, (void *)sd);
- }
-
- /* add "Mkdir" button */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- sd->mkdirB = XtCreateManagedWidget("Mkdir", xmPushButtonGadgetClass, sd->dialog, args, n);
- XtAddCallback(sd->mkdirB, XmNactivateCallback, save_as_mkdir_callback, (XtPointer)sd);
- XtSetSensitive(sd->mkdirB, false);
-
- XtSetSensitive(FSB_BOX(sd->dialog, XmDIALOG_OK_BUTTON), (!(file_is_directory(sd->dialog))));
- XtAddCallback(FSB_BOX(sd->dialog, XmDIALOG_TEXT), XmNvalueChangedCallback, reflect_text_in_save_button, (void *)sd);
-
- XtManageChild(sd->dialog);
- switch (sd->type)
- {
- case SOUND_SAVE_AS:
- set_dialog_widget(SOUND_SAVE_AS_DIALOG, sd->dialog);
- break;
-
- case SELECTION_SAVE_AS:
- set_dialog_widget(SELECTION_SAVE_AS_DIALOG, sd->dialog);
- XEN_ADD_HOOK(ss->snd_selection_hook, save_selection_hook_handler_w, "save-selection-hook-handler", "save selection dialog's selection hook handler");
- break;
-
- case REGION_SAVE_AS:
- set_dialog_widget(REGION_SAVE_AS_DIALOG, sd->dialog);
- break;
-
- default:
- snd_error("internal screw up");
- break;
- }
- }
- else
- {
- XmString xmstr2;
- file_string = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(file_string, PRINT_BUFFER_SIZE, "save %s", sound_name);
- xmstr2 = XmStringCreateLocalized(file_string);
- XtVaSetValues(sd->dialog,
- XmNdialogTitle, xmstr2,
- NULL);
- XmStringFree(xmstr2);
- free(file_string);
- }
-}
-
-
-widget_t make_sound_save_as_dialog(bool managed)
-{
- /* should the save-as dialog, at least in the file case, reflect the current file attributes/comment?
- * or should we have a save-as-hook that can set up the dialog fields?
- */
-
- snd_info *sp = NULL;
- char *com = NULL;
- file_info *hdr = NULL;
- save_as_dialog_info *sd;
-
- if (!save_sound_as)
- save_sound_as = new_save_as_dialog_info(SOUND_SAVE_AS);
- sd = save_sound_as;
-
- sp = any_selected_sound();
- if (sp) hdr = sp->hdr;
-
- make_save_as_dialog(sd,
- (char *)((sp) ? sp->short_filename : ""),
- default_output_header_type(ss),
- default_output_data_format(ss));
-
- set_file_dialog_sound_attributes(sd->panel_data,
- sd->panel_data->current_type,
- sd->panel_data->current_format,
- (hdr) ? hdr->srate : selection_srate(),
- IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
- com = output_comment(hdr));
- if (com) free(com);
- if (sd->fp->reread_directory)
- {
- force_directory_reread(sd->dialog);
- sd->fp->reread_directory = false;
- }
-
- if ((managed) && (!XtIsManaged(sd->dialog)))
- XtManageChild(sd->dialog);
-
- make_auto_comment(sd);
- return(sd->dialog);
-}
-
-
-widget_t make_selection_save_as_dialog(bool managed)
-{
- save_as_dialog_info *sd;
-
- if (!save_selection_as)
- save_selection_as = new_save_as_dialog_info(SELECTION_SAVE_AS);
- sd = save_selection_as;
-
- make_save_as_dialog(sd,
- (char *)"current selection",
- default_output_header_type(ss),
- default_output_data_format(ss));
- set_file_dialog_sound_attributes(sd->panel_data,
- sd->panel_data->current_type,
- sd->panel_data->current_format,
- selection_srate(),
- IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
- NULL);
- if (sd->fp->reread_directory)
- {
- force_directory_reread(sd->dialog);
- sd->fp->reread_directory = false;
- }
- if ((managed) && (!XtIsManaged(sd->dialog)))
- XtManageChild(sd->dialog);
- return(sd->dialog);
-}
-
-
-widget_t make_region_save_as_dialog(bool managed)
-{
- save_as_dialog_info *sd;
- char *comment = NULL;
-
- if (!save_region_as)
- save_region_as = new_save_as_dialog_info(REGION_SAVE_AS);
- sd = save_region_as;
-
- make_save_as_dialog(sd,
- (char *)"selected region",
- default_output_header_type(ss),
- default_output_data_format(ss));
- comment = region_description(region_dialog_region());
- set_file_dialog_sound_attributes(sd->panel_data,
- sd->panel_data->current_type,
- sd->panel_data->current_format,
- region_srate(region_dialog_region()),
- IGNORE_CHANS, IGNORE_DATA_LOCATION, IGNORE_SAMPLES,
- comment);
- if (sd->fp->reread_directory)
- {
- force_directory_reread(sd->dialog);
- sd->fp->reread_directory = false;
- }
- if ((managed) && (!XtIsManaged(sd->dialog)))
- XtManageChild(sd->dialog);
- if (comment) free(comment);
- return(sd->dialog);
-}
-
-
-
-/* -------- save/restore for all these dialogs -------- */
-
-void save_file_dialog_state(FILE *fd)
-{
- if ((odat) && (XtIsManaged(odat->dialog)))
- {
- /* odat->file_dialog_read_only -> "view-sound" dialog -- this distinction currently ignored */
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_open_file_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_open_file_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_open_file_dialog);
-#endif
- }
- if ((mdat) && (XtIsManaged(mdat->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_mix_file_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_mix_file_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_mix_file_dialog);
-#endif
- }
- if ((idat) && (XtIsManaged(idat->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_insert_file_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_insert_file_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_insert_file_dialog);
-#endif
- }
- if ((save_sound_as) && (XtIsManaged(save_sound_as->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_save_sound_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_save_sound_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_save_sound_dialog);
-#endif
- }
- if ((save_selection_as) && (XtIsManaged(save_selection_as->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_save_selection_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_save_selection_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_save_selection_dialog);
-#endif
- }
- if ((save_region_as) && (XtIsManaged(save_region_as->dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t)\n", S_save_region_dialog);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_save_region_dialog));
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s drop\n", S_save_region_dialog);
-#endif
- }
-}
-
-
-
-/* -------------------------------- New File -------------------------------- */
-
-static Widget new_file_dialog = NULL;
-static file_data *ndat = NULL;
-static mus_long_t initial_samples = 1;
-static Widget new_file_text = NULL;
-static char *new_file_filename = NULL;
-static fam_info *new_file_watcher = NULL;
-
-
-void cleanup_new_file_watcher(void)
-{
- if (new_file_watcher)
- new_file_watcher = fam_unmonitor_file(new_file_filename, new_file_watcher);
-}
-
-
-static void new_filename_modify_callback(Widget w, XtPointer context, XtPointer info);
-
-static void new_file_undoit(void)
-{
- XmString ok_label;
- ok_label = XmStringCreateLocalized((char *)"Ok");
- XtVaSetValues(new_file_dialog,
- XmNokLabelString, ok_label,
- NULL);
- XmStringFree(ok_label);
- clear_dialog_error(ndat);
- XtRemoveCallback(new_file_text, XmNmodifyVerifyCallback, new_filename_modify_callback, NULL);
- new_file_watcher = fam_unmonitor_file(new_file_filename, new_file_watcher);
-}
-
-
-static void new_filename_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- new_file_undoit();
- cbs->doit = true;
-}
-
-
-static void clear_error_if_new_filename_changes(Widget dialog)
-{
- XtAddCallback(new_file_text, XmNmodifyVerifyCallback, new_filename_modify_callback, NULL);
-}
-
-
-static void watch_new_file(struct fam_info *fp, FAMEvent *fe)
-{
-#if HAVE_FAM
- /* if file is deleted, respond in some debonair manner */
- switch (fe->code)
- {
- case FAMChanged:
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- new_file_undoit();
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-#endif
-}
-
-
-static void new_file_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- mus_long_t loc;
- char *comment = NULL, *newer_name = NULL, *msg;
- int header_type, data_format, srate, chans;
- newer_name = XmTextGetString(new_file_text);
- if ((!newer_name) || (!(*newer_name)))
- {
- msg = (char *)"new sound needs a file name ('New file:' field is empty)";
- post_file_dialog_error((const char *)msg, ndat);
- clear_error_if_new_filename_changes(new_file_dialog);
- }
- else
- {
- redirect_snd_error_to(post_file_panel_error, (void *)ndat);
- comment = get_file_dialog_sound_attributes(ndat, &srate, &chans, &header_type, &data_format, &loc, &initial_samples, 1);
- redirect_snd_error_to(NULL, NULL);
- if (ndat->error_widget != NOT_A_SCANF_WIDGET)
- {
- clear_error_if_panel_changes(new_file_dialog, ndat);
- }
- else
- {
- snd_info *sp;
- /* handle the overwrite hook directly */
- if (new_file_filename) free(new_file_filename);
- new_file_filename = mus_expand_filename(newer_name); /* need full filename for fam */
- if ((!new_file_watcher) &&
- (ask_before_overwrite(ss)) &&
- (mus_file_probe(new_file_filename)))
- {
- XmString ok_label;
- msg = mus_format("%s exists. If you want to overwrite it, click 'DoIt'", newer_name);
- new_file_watcher = fam_monitor_file(new_file_filename, NULL, watch_new_file);
- post_file_dialog_error((const char *)msg, ndat);
- clear_error_if_new_filename_changes(new_file_dialog);
- ok_label = XmStringCreateLocalized((char *)"DoIt");
- XtVaSetValues(new_file_dialog,
- XmNokLabelString, ok_label,
- NULL);
- XmUpdateDisplay(MSG_BOX(new_file_dialog, XmDIALOG_OK_BUTTON));
- XmStringFree(ok_label);
- free(msg);
- }
- else
- {
- if (new_file_watcher)
- new_file_undoit();
- ss->local_errno = 0;
- redirect_snd_error_to(redirect_post_file_dialog_error, (void *)ndat);
- sp = snd_new_file(new_file_filename, header_type, data_format, srate, chans, comment, initial_samples);
- redirect_snd_error_to(NULL, NULL);
- if (!sp)
- {
- if ((ss->local_errno) &&
- /* some sort of file system error -- this is confusing because fam sends
- * a "deleted" event if we don't have write permission -- as if we had
- * created it, then immediately deleted it. So, if the file doesn't
- * already exist, I can't monitor for some relevant change (except
- * perhaps at the directory level, but that's getting ridiculous).
- */
- (mus_file_probe(new_file_filename)))
- /* that is, the thing exists, so user could delete it or change its permission bits;
- * in any case, we won't be confused by an immediate irrelevant delete event
- */
- new_file_watcher = fam_monitor_file(new_file_filename, NULL, watch_new_file);
- clear_error_if_new_filename_changes(new_file_dialog);
- }
- else
- {
- XtUnmanageChild(new_file_dialog);
- }
- }
- }
- XtFree(newer_name);
- if (comment) free(comment);
- }
-}
-
-
-static char *new_file_dialog_filename(int header_type)
-{
- static int new_file_dialog_file_ctr = 1;
- char *filename = NULL;
- const char *extension = NULL;
- filename = (char *)calloc(64, sizeof(char));
- switch (header_type)
- {
- case MUS_AIFC: extension = "aiff"; break;
- case MUS_AIFF: extension = "aiff"; break;
- case MUS_RIFF: extension = "wav"; break;
- case MUS_RF64: extension = "wav"; break;
- case MUS_CAFF: extension = "caf"; break;
- default: extension = "snd"; break;
- }
- mus_snprintf(filename, 64, "new-%d.%s", new_file_dialog_file_ctr++, extension);
- return(filename);
-}
-
-
-static void load_new_file_defaults(char *newname)
-{
- char *filename = NULL, *new_comment = NULL;
- int header_type, data_format, chans, srate;
-
- header_type = default_output_header_type(ss);
- chans = default_output_chans(ss);
- data_format = default_output_data_format(ss);
- srate = default_output_srate(ss);
- new_comment = output_comment(NULL);
-
- if ((newname) && (!(*newname))) newname = NULL;
- filename = output_name(newname); /* calls output-name-hook, always free */
- if (filename == NULL)
- filename = new_file_dialog_filename(header_type);
- XmTextSetString(new_file_text, filename);
- mus_sound_forget(filename);
-
- set_file_dialog_sound_attributes(ndat, header_type, data_format, srate, chans, IGNORE_DATA_LOCATION, initial_samples, new_comment);
-
- if (new_comment) free(new_comment);
- if (filename) free(filename);
-}
-
-
-static void new_file_reset_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *current_name;
- current_name = XmTextGetString(new_file_text);
- load_new_file_defaults(current_name);
- if (current_name) XtFree(current_name);
- if (new_file_watcher)
- new_file_undoit();
-}
-
-
-static void new_file_cancel_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtUnmanageChild(w);
-}
-
-
-static void new_file_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- new_file_dialog_help();
-}
-
-
-widget_t make_new_file_dialog(bool managed)
-{
- if (!new_file_dialog)
- {
- Arg args[20];
- int n;
- XmString xok, xcancel, xhelp;
- Widget name_label, form;
- XmString titlestr;
- Widget sep, reset_button;
-
- titlestr = XmStringCreateLocalized((char *)"New file");
- xhelp = XmStringCreateLocalized((char *)"Help");
- xcancel = XmStringCreateLocalized((char *)"Go Away");
- xok = XmStringCreateLocalized((char *)"Ok");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNcancelLabelString, xcancel); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNokLabelString, xok); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- new_file_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"new", args, n);
-
- XmStringFree(titlestr);
- XmStringFree(xok);
- XmStringFree(xcancel);
- XmStringFree(xhelp);
-
- XtAddCallback(new_file_dialog, XmNhelpCallback, new_file_help_callback, NULL);
- XtAddCallback(new_file_dialog, XmNcancelCallback, new_file_cancel_callback, NULL);
- XtAddCallback(new_file_dialog, XmNokCallback, new_file_ok_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- reset_button = XtCreateManagedWidget("Reset", xmPushButtonGadgetClass, new_file_dialog, args, n);
- XtAddCallback(reset_button, XmNactivateCallback, new_file_reset_callback, NULL);
-
- n = 0;
- form = XtCreateManagedWidget("newfile", xmFormWidgetClass, new_file_dialog, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNforeground, ss->black); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- name_label = XtCreateManagedWidget("New file:", xmLabelWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, name_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- new_file_text = make_textfield_widget("newtext", form, args, n, ACTIVATABLE, add_completer_func(filename_completer, NULL));
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, new_file_text); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 8); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- ndat = make_file_data_panel(form, "data-form", args, n,
- WITH_CHANNELS_FIELD,
- default_output_header_type(ss),
- default_output_data_format(ss),
- WITHOUT_DATA_LOCATION_FIELD,
- WITH_SAMPLES_FIELD,
- WITH_HEADER_TYPE_FIELD,
- WITH_COMMENT_FIELD,
- WITH_BUILTIN_HEADERS,
- false, false);
- ndat->dialog = new_file_dialog;
- XtManageChild(ndat->error_text);
- XtManageChild(new_file_dialog);
-
- map_over_children(new_file_dialog, set_main_color_of_widget);
- XtVaSetValues(ndat->format_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- XtVaSetValues(ndat->header_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
-
- XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(new_file_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- set_dialog_widget(NEW_FILE_DIALOG, new_file_dialog);
- XtUnmanageChild(ndat->error_text);
-
- load_new_file_defaults(NULL);
- }
- else
- {
- char *new_name;
- new_name = XmTextGetString(new_file_text);
-#if (!HAVE_FAM)
- if (new_file_watcher)
- {
- /* if overwrite question pends, but file has been deleted in the meantime, go back to normal state */
- if ((!new_name) || (!(*new_name)) ||
- (!(mus_file_probe(new_name))))
- new_file_undoit();
- }
-#endif
- if (strncmp(new_name, "new-", 4) == 0)
- {
- /* if file is open with currently posted new-file dialog name, and it's our name (new-%d), then tick the counter */
- snd_info *sp;
- sp = find_sound(new_name, 0);
- if (sp)
- {
- char *filename;
- filename = new_file_dialog_filename(default_output_header_type(ss));
- XmTextSetString(new_file_text, filename);
- mus_sound_forget(filename);
- free(filename);
- }
- }
- if (new_name) XtFree(new_name);
- }
- if ((managed) &&
- (!(XtIsManaged(new_file_dialog))))
- XtManageChild(new_file_dialog);
- return(new_file_dialog);
-}
-
-
-
-/* ---------------- Edit Header ---------------- */
-
-typedef struct edhead_info {
- Widget dialog;
- file_data *edat;
- snd_info *sp;
- bool panel_changed;
- fam_info *file_ro_watcher;
- int sp_ro_watcher_loc;
-} edhead_info;
-
-static int edhead_info_size = 0;
-static edhead_info **edhead_infos = NULL;
-
-
-static edhead_info *new_edhead_dialog(void)
-{
- int loc = -1;
- if (edhead_info_size == 0)
- {
- loc = 0;
- edhead_info_size = 4;
- edhead_infos = (edhead_info **)calloc(edhead_info_size, sizeof(edhead_info *));
- }
- else
- {
- int i;
- for (i = 0; i < edhead_info_size; i++)
- if ((!edhead_infos[i]) ||
- (!(XtIsManaged(edhead_infos[i]->dialog))))
- {
- loc = i;
- break;
- }
- if (loc == -1)
- {
- loc = edhead_info_size;
- edhead_info_size += 4;
- edhead_infos = (edhead_info **)realloc(edhead_infos, edhead_info_size * sizeof(edhead_info *));
- for (i = loc; i < edhead_info_size; i++) edhead_infos[i] = NULL;
- }
- }
- if (!edhead_infos[loc])
- {
- edhead_infos[loc] = (edhead_info *)calloc(1, sizeof(edhead_info));
- edhead_infos[loc]->dialog = NULL;
- edhead_infos[loc]->panel_changed = false;
- }
- edhead_infos[loc]->sp = NULL;
- edhead_infos[loc]->file_ro_watcher = NULL;
- return(edhead_infos[loc]);
-}
-
-
-void cleanup_edit_header_watcher(void)
-{
- int i;
- for (i = 0; i < edhead_info_size; i++)
- if (edhead_infos[i])
- {
- edhead_info *ep;
- ep = edhead_infos[i];
- if (ep->file_ro_watcher)
- ep->file_ro_watcher = fam_unmonitor_file(ep->sp->filename, ep->file_ro_watcher);
- }
-}
-
-
-static XmString make_header_dialog_title(edhead_info *ep, snd_info *sp)
-{
- /* dialog may not yet exist */
- char *str;
- XmString xstr;
- str = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- if ((sp->user_read_only == FILE_READ_ONLY) ||
- (sp->file_read_only == FILE_READ_ONLY))
- {
- if (sp->hdr->type == MUS_RAW)
- mus_snprintf(str, PRINT_BUFFER_SIZE, "Add header to (write-protected) %s", sp->short_filename);
- else mus_snprintf(str, PRINT_BUFFER_SIZE, "Edit header of (write-protected) %s", sp->short_filename);
- if (ep->dialog)
- set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), (sp->hdr->type == MUS_RAW));
- }
- else
- {
- if (sp->hdr->type == MUS_RAW)
- mus_snprintf(str, PRINT_BUFFER_SIZE, "Add header to %s", sp->short_filename);
- else mus_snprintf(str, PRINT_BUFFER_SIZE, "Edit header of %s", sp->short_filename);
- if (ep->dialog)
- set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), ep->panel_changed);
- }
- xstr = XmStringCreateLocalized(str);
- free(str);
- return(xstr);
-}
-
-
-static void edit_header_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- edit_header_dialog_help();
-}
-
-
-static void edit_header_set_ok_sensitive(Widget w, XtPointer context, XtPointer info)
-{
- edhead_info *ep = (edhead_info *)context;
- if (ep->sp->file_read_only == FILE_READ_WRITE)
- set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), true);
- ep->panel_changed = true;
-}
-
-
-static void eh_cancel(edhead_info *ep)
-{
- unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
- ep->panel_changed = false;
- if ((ep->file_ro_watcher) &&
- (ep->sp) &&
- (ep->sp->active) &&
- (ep->sp->filename))
- ep->file_ro_watcher = fam_unmonitor_file(ep->sp->filename, ep->file_ro_watcher);
-}
-
-
-static void edit_header_cancel_callback(Widget w, XtPointer context, XtPointer info)
-{
- edhead_info *ep = (edhead_info *)context;
- XtUnmanageChild(ep->dialog);
- eh_cancel(ep);
-}
-
-
-static void edit_header_wm_delete_callback(Widget w, XtPointer context, XtPointer info)
-{
- eh_cancel((edhead_info *)context);
-}
-
-
-static void watch_file_read_only(struct fam_info *fp, FAMEvent *fe)
-{
-#if HAVE_FAM
- /* if file is deleted or permissions change, respond in some debonair manner */
- edhead_info *ep = (edhead_info *)(fp->data);
- snd_info *sp = NULL;
- sp = ep->sp;
- if (sp->writing) return;
- switch (fe->code)
- {
- case FAMChanged:
-#if HAVE_ACCESS
- {
- int err;
- XmString title;
- if (mus_file_probe(sp->filename))
- {
- err = access(sp->filename, W_OK);
- sp->file_read_only = ((err < 0) ? FILE_READ_ONLY : FILE_READ_WRITE);
- if ((sp->file_read_only == FILE_READ_WRITE) &&
- (sp->user_read_only == FILE_READ_WRITE))
- clear_dialog_error(ep->edat);
- title = make_header_dialog_title(ep, sp);
- XtVaSetValues(ep->dialog,
- XmNmessageString, title,
- NULL);
- XmStringFree(title);
- return;
- }
- }
-#endif
- /* else fall through */
-
- case FAMDeleted:
- case FAMCreated:
- case FAMMoved:
- /* I don't think it makes sense to continue the dialog at this point */
- clear_dialog_error(ep->edat);
- XtUnmanageChild(ep->dialog);
- if (ep->panel_changed)
- unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
- ep->panel_changed = false;
- ep->file_ro_watcher = fam_unmonitor_file(ep->sp->filename, ep->file_ro_watcher);
- break;
-
- default:
- /* ignore the rest */
- break;
- }
-#endif
-}
-
-
-static void edit_header_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- edhead_info *ep = (edhead_info *)context;
- if ((ep->sp) && (ep->sp->active))
- {
- if (XmGetFocusWidget(ep->dialog) == MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON))
- {
- bool ok;
- redirect_snd_error_to(redirect_post_file_dialog_error, (void *)(ep->edat));
- ok = edit_header_callback(ep->sp, ep->edat, redirect_post_file_dialog_error, post_file_panel_error);
- /* edit_header_callback, if all goes well, writes the header, recopies the data,
- * then calls snd_update which closes the sound and reopens it, to force the
- * new_header to take effect. The read-only watcher is disabled during that
- * process to keep it from getting a SOUND_IS_CLOSING message from close.
- */
- redirect_snd_error_to(NULL, NULL);
- if (ep->edat->error_widget != NOT_A_SCANF_WIDGET)
- {
- clear_error_if_panel_changes(ep->dialog, ep->edat);
- return;
- }
- else
- {
- if (!ok)
- {
- set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), false);
- return;
- }
- }
- ep->file_ro_watcher = fam_unmonitor_file(ep->sp->filename, ep->file_ro_watcher);
- XtUnmanageChild(ep->dialog);
- unreflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
- }
- }
-}
-
-
-Widget edit_header(snd_info *sp)
-{
- file_info *hdr;
- XmString xstr4;
- Widget main_w;
- int i;
- edhead_info *ep = NULL;
-
- if (!sp) return(NULL);
-
- /* look for a dialog already editing this sound, raise if found, else make a new one */
- if (edhead_info_size > 0)
- {
- for (i = 0; i < edhead_info_size; i++)
- if ((edhead_infos[i]) &&
- ((edhead_infos[i]->sp == sp) ||
- ((edhead_infos[i]->sp) && /* maybe same sound open twice -- only one edit header dialog for it */
- (edhead_infos[i]->sp->inuse == SOUND_NORMAL) &&
- (mus_strcmp(sp->filename, edhead_infos[i]->sp->filename)))))
- {
- ep = edhead_infos[i];
- break;
- }
- }
- if (!ep)
- ep = new_edhead_dialog();
-
- ep->sp = sp;
- hdr = sp->hdr;
- ep->panel_changed = (hdr->type == MUS_RAW);
- xstr4 = make_header_dialog_title(ep, sp);
-
- if (!ep->dialog)
- {
- int n;
- Arg args[20];
- XmString xstr1, xstr2, xstr3, titlestr;
-
- n = 0;
- xstr1 = XmStringCreateLocalized((char *)"Go Away"); /* needed by template dialog */
- xstr2 = XmStringCreateLocalized((char *)"Help");
- xstr3 = XmStringCreateLocalized((char *)"Save");
- titlestr = XmStringCreateLocalized((char *)"Edit Header");
-
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNcancelLabelString, xstr1); n++;
- XtSetArg(args[n], XmNhelpLabelString, xstr2); n++;
- XtSetArg(args[n], XmNokLabelString, xstr3); n++;
- XtSetArg(args[n], XmNmessageString, xstr4); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- ep->dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Edit Header", args, n);
-
- XtAddCallback(ep->dialog, XmNcancelCallback, edit_header_cancel_callback, (XtPointer)ep);
- XtAddCallback(ep->dialog, XmNhelpCallback, edit_header_help_callback, (XtPointer)ep);
- XtAddCallback(ep->dialog, XmNokCallback, edit_header_ok_callback, (XtPointer)ep);
-
- XmStringFree(xstr1);
- XmStringFree(xstr2);
- XmStringFree(xstr3);
- XmStringFree(titlestr);
-
- n = 0;
- main_w = XtCreateManagedWidget("eh-main", xmFormWidgetClass, ep->dialog, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- ep->edat = make_file_data_panel(main_w, "Edit Header", args, n,
- WITH_CHANNELS_FIELD,
- hdr->type,
- hdr->format,
- WITH_DATA_LOCATION_FIELD,
- WITH_SAMPLES_FIELD,
- WITH_HEADER_TYPE_FIELD,
- WITH_COMMENT_FIELD,
- WITH_BUILTIN_HEADERS,
- false, false);
- ep->edat->dialog = ep->dialog;
-
- if (hdr->type == MUS_RAW)
- set_file_dialog_sound_attributes(ep->edat,
- default_output_header_type(ss),
- hdr->format, hdr->srate, hdr->chans,
- hdr->data_location, hdr->samples, hdr->comment);
- else set_file_dialog_sound_attributes(ep->edat,
- hdr->type, hdr->format, hdr->srate, hdr->chans,
- hdr->data_location, hdr->samples, hdr->comment);
- XtManageChild(ep->edat->error_text);
- XtManageChild(ep->dialog);
-
- map_over_children(ep->dialog, set_main_color_of_widget);
- XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(ep->edat->header_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- XtVaSetValues(ep->edat->format_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
-
- XtVaSetValues(MSG_BOX(ep->dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->basic_color, NULL);
-
- set_dialog_widget(EDIT_HEADER_DIALOG, ep->dialog);
-
- {
- Atom wm_delete_window;
- wm_delete_window = XmInternAtom(MAIN_DISPLAY(ss), (char *)"WM_DELETE_WINDOW", false);
- XmAddWMProtocolCallback(XtParent(ep->dialog), wm_delete_window, edit_header_wm_delete_callback, (XtPointer)ep);
- }
-
- XtUnmanageChild(ep->edat->error_text);
- }
- else
- {
- XtVaSetValues(ep->dialog,
- XmNmessageString, xstr4,
- NULL);
- if (hdr->type == MUS_RAW)
- set_file_dialog_sound_attributes(ep->edat,
- default_output_header_type(ss),
- hdr->format, hdr->srate, hdr->chans,
- hdr->data_location, hdr->samples, hdr->comment);
- else set_file_dialog_sound_attributes(ep->edat,
- hdr->type, hdr->format, hdr->srate, hdr->chans,
- hdr->data_location, hdr->samples, hdr->comment);
- raise_dialog(ep->dialog);
- clear_dialog_error(ep->edat);
- }
- set_sensitive(MSG_BOX(ep->dialog, XmDIALOG_OK_BUTTON), (hdr->type == MUS_RAW)); /* nothing needs to be saved when we start */
- XmStringFree(xstr4);
- if (!(XtIsManaged(ep->dialog))) XtManageChild(ep->dialog);
- reflect_file_data_panel_change(ep->edat, (void *)ep, edit_header_set_ok_sensitive);
- ep->file_ro_watcher = fam_monitor_file(ep->sp->filename, (void *)ep, watch_file_read_only);
- return(ep->dialog);
-}
-
-
-void save_edit_header_dialog_state(FILE *fd)
-{
- int i;
- for (i = 0; i < edhead_info_size; i++)
- if (edhead_infos[i])
- {
- edhead_info *ep;
- ep = edhead_infos[i];
- if ((ep->dialog) &&
- (XtIsManaged(ep->dialog)) &&
- (snd_ok(ep->sp)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s (%s \"%s\"))\n", S_edit_header_dialog, S_find_sound, ep->sp->short_filename);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(%s(\"%s\"))\n", TO_PROC_NAME(S_edit_header_dialog), TO_PROC_NAME(S_find_sound), ep->sp->short_filename);
-#endif
-#if HAVE_FORTH
- fprintf(fd, "\"%s\" %s %s drop\n", ep->sp->short_filename, S_find_sound, S_edit_header_dialog);
-#endif
- break;
- }
- }
-}
-
-
-
-
-/* -------------------------------- Raw Data Dialog -------------------------------- */
-
-/* we keep an array of raw data dialogs so that any number can be active at once */
-
-typedef struct raw_info {
- Widget dialog;
- mus_long_t location;
- file_data *rdat;
- read_only_t read_only;
- bool selected;
- char *filename;
- char *help;
- open_requestor_t requestor;
- void *requestor_data;
- Widget requestor_dialog;
-} raw_info;
-
-static int raw_info_size = 0;
-static raw_info **raw_infos = NULL;
-
-
-static raw_info *new_raw_dialog(void)
-{
- int loc = -1;
- if (raw_info_size == 0)
- {
- loc = 0;
- raw_info_size = 4;
- raw_infos = (raw_info **)calloc(raw_info_size, sizeof(raw_info *));
- }
- else
- {
- int i;
- for (i = 0; i < raw_info_size; i++)
- if ((!raw_infos[i]) ||
- (!(XtIsManaged(raw_infos[i]->dialog))))
- {
- loc = i;
- break;
- }
- if (loc == -1)
- {
- loc = raw_info_size;
- raw_info_size += 4;
- raw_infos = (raw_info **)realloc(raw_infos, raw_info_size * sizeof(raw_info *));
- for (i = loc; i < raw_info_size; i++) raw_infos[i] = NULL;
- }
- }
- if (!raw_infos[loc])
- {
- raw_infos[loc] = (raw_info *)calloc(1, sizeof(raw_info));
- raw_infos[loc]->dialog = NULL;
- raw_infos[loc]->filename = NULL;
- raw_infos[loc]->help = NULL;
- }
- raw_infos[loc]->requestor = NO_REQUESTOR;
- raw_infos[loc]->requestor_data = NULL;
- raw_infos[loc]->location = 0;
- return(raw_infos[loc]);
-}
-
-
-static void raw_data_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- raw_info *rp = (raw_info *)context;
- int raw_srate, raw_chans, raw_data_format;
- redirect_snd_error_to(post_file_panel_error, (void *)(rp->rdat));
- get_file_dialog_sound_attributes(rp->rdat, &raw_srate, &raw_chans, NULL, &raw_data_format, &(rp->location), NULL, 1);
- redirect_snd_error_to(NULL, NULL);
- if (rp->rdat->error_widget != NOT_A_SCANF_WIDGET)
- {
- clear_error_if_panel_changes(rp->dialog, rp->rdat);
- }
- else
- {
- mus_header_set_raw_defaults(raw_srate, raw_chans, raw_data_format);
- mus_sound_override_header(rp->filename, raw_srate, raw_chans,
- raw_data_format, MUS_RAW, rp->location,
- mus_bytes_to_samples(raw_data_format,
- mus_sound_length(rp->filename) - rp->location));
- /* choose action based on how we got here */
- if ((rp->requestor_dialog) &&
- ((rp->requestor == FROM_MIX_DIALOG) ||
- (rp->requestor == FROM_INSERT_DIALOG) ||
- (rp->requestor == FROM_VIEW_FILES_MIX_DIALOG) ||
- (rp->requestor == FROM_VIEW_FILES_INSERT_DIALOG)))
- {
- ss->reloading_updated_file = true; /* don't reread lack-of-header! */
- /* redirection may be still set here, but I'll make it obvious */
- switch (rp->requestor)
- {
- case FROM_MIX_DIALOG:
- redirect_snd_error_to(redirect_file_open_error, (void *)mdat);
- mix_complete_file_at_cursor(any_selected_sound(), rp->filename);
- break;
-
- case FROM_INSERT_DIALOG:
- redirect_snd_error_to(redirect_file_open_error, (void *)idat);
- insert_complete_file_at_cursor(any_selected_sound(), rp->filename);
- break;
-
- case FROM_VIEW_FILES_MIX_DIALOG:
- {
- int err;
- view_files_info *vdat = (view_files_info *)(rp->requestor_data);
- redirect_snd_error_to(redirect_vf_post_error, rp->requestor_data);
- err = vf_mix(vdat);
- }
- break;
-
- case FROM_VIEW_FILES_INSERT_DIALOG:
- {
- int err;
- view_files_info *vdat = (view_files_info *)(rp->requestor_data);
- redirect_snd_error_to(redirect_vf_post_error, rp->requestor_data);
- err = vf_insert(vdat);
- }
- break;
-
- default:
- snd_error("wrong requestor type in raw data dialog? %d\n", (int)(rp->requestor));
- break;
- }
- redirect_snd_error_to(NULL, NULL);
- ss->reloading_updated_file = false;
- }
- else
- {
- /* FROM_OPEN_DIALOG (has requestor_dialog)
- * FROM_KEYBOARD (has sp = requestor_data)
- * FROM_DRAG_AND_DROP (just open, no needed side effects)
- * FROM_VIEW_FILES (ditto)
- * FROM_VIEW_FILES_MIX_DIALOG or INSERT -- requestor_data contains needed info to complete the action
- */
- file_info *hdr;
- hdr = (file_info *)calloc(1, sizeof(file_info));
- hdr->name = mus_strdup(rp->filename);
- hdr->type = MUS_RAW;
- hdr->srate = raw_srate;
- hdr->chans = raw_chans;
- hdr->format = raw_data_format;
- hdr->samples = mus_bytes_to_samples(raw_data_format,
- mus_sound_length(rp->filename) - rp->location);
- hdr->data_location = rp->location;
- hdr->comment = NULL;
- if (rp->requestor == FROM_KEYBOARD)
- {
- clear_minibuffer((snd_info *)(rp->requestor_data));
- rp->selected = true;
- }
- finish_opening_sound(add_sound_window(rp->filename, rp->read_only, hdr), rp->selected);
- }
- XtUnmanageChild(rp->dialog);
- }
-}
-
-
-static void raw_data_cancel_callback(Widget w, XtPointer context, XtPointer info)
-{
- raw_info *rp = (raw_info *)context;
- XtUnmanageChild(rp->dialog);
- if ((rp->requestor_dialog) &&
- ((rp->requestor == FROM_OPEN_DIALOG) ||
- (rp->requestor == FROM_MIX_DIALOG)))
- XtManageChild(rp->requestor_dialog);
-}
-
-
-static void raw_data_reset_callback(Widget w, XtPointer context, XtPointer info)
-{
- raw_info *rp = (raw_info *)context;
- int raw_srate, raw_chans, raw_data_format;
- rp->location = 0;
- mus_header_raw_defaults(&raw_srate, &raw_chans, &raw_data_format); /* pick up defaults */
- set_file_dialog_sound_attributes(rp->rdat,
- IGNORE_HEADER_TYPE,
- raw_data_format, raw_srate, raw_chans, rp->location,
- IGNORE_SAMPLES, NULL);
- if (XtIsManaged(rp->rdat->error_text))
- XtUnmanageChild(rp->rdat->error_text);
-}
-
-
-static void raw_data_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- raw_info *rp = (raw_info *)context;
- raw_data_dialog_help(rp->help);
-}
-
-
-static void make_raw_data_dialog(raw_info *rp, const char *title)
-{
- XmString xstr1, xstr2, xstr3, xstr4, titlestr;
- int n;
- int raw_srate, raw_chans, raw_data_format;
- Arg args[20];
- Widget reset_button, main_w;
-
- xstr1 = XmStringCreateLocalized((char *)"Go Away"); /* needed by template dialog */
- xstr2 = XmStringCreateLocalized((char *)"Help");
- xstr3 = XmStringCreateLocalized((char *)"Ok");
- if (!title)
- titlestr = XmStringCreateLocalized((char *)"No header on file");
- else titlestr = XmStringCreateLocalized((char *)title);
- xstr4 = XmStringCreateLocalized((char *)title);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNcancelLabelString, xstr1); n++;
- XtSetArg(args[n], XmNhelpLabelString, xstr2); n++;
- XtSetArg(args[n], XmNokLabelString, xstr3); n++;
- XtSetArg(args[n], XmNmessageString, xstr4); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNallowShellResize, true); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- /* not transient -- we want this window to remain visible if possible */
- rp->dialog = XmCreateWarningDialog(MAIN_SHELL(ss), (char *)"raw data", args, n);
-
- XtAddCallback(rp->dialog, XmNcancelCallback, raw_data_cancel_callback, (XtPointer)rp);
- XtAddCallback(rp->dialog, XmNhelpCallback, raw_data_help_callback, (XtPointer)rp);
- XtAddCallback(rp->dialog, XmNokCallback, raw_data_ok_callback, (XtPointer)rp);
- XmStringFree(xstr1);
- XmStringFree(xstr2);
- XmStringFree(xstr3);
- XmStringFree(xstr4);
- XmStringFree(titlestr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- reset_button = XtCreateManagedWidget("Reset", xmPushButtonGadgetClass, rp->dialog, args, n);
- XtAddCallback(reset_button, XmNactivateCallback, raw_data_reset_callback, (XtPointer)rp);
-
- mus_header_raw_defaults(&raw_srate, &raw_chans, &raw_data_format); /* pick up defaults */
-
- n = 0;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_NONE); n++;
- main_w = XtCreateManagedWidget("raw-main", xmFormWidgetClass, rp->dialog, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- rp->rdat = make_file_data_panel(main_w, "data-form", args, n,
- WITH_CHANNELS_FIELD,
- MUS_RAW, raw_data_format,
- WITH_DATA_LOCATION_FIELD,
- WITHOUT_SAMPLES_FIELD,
- WITHOUT_HEADER_TYPE_FIELD,
- WITHOUT_COMMENT_FIELD,
- WITH_READABLE_HEADERS,
- false, false);
- rp->rdat->dialog = rp->dialog;
-
- set_file_dialog_sound_attributes(rp->rdat,
- IGNORE_HEADER_TYPE,
- raw_data_format, raw_srate, raw_chans, rp->location,
- IGNORE_SAMPLES, NULL);
-
- map_over_children(rp->dialog, set_main_color_of_widget);
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(reset_button, XmNselectColor, ss->selection_color, NULL);
- XtVaSetValues(rp->rdat->format_list, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- /*
- * this line makes the dialog take up all vertical space on the screen
- * XtManageChild(rp->rdat->error_text);
- */
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->basic_color, NULL);
-
- XtManageChild(rp->dialog);
- XtUnmanageChild(rp->rdat->error_text);
- set_dialog_widget(RAW_DATA_DIALOG, rp->dialog);
-}
-
-
-void raw_data_dialog_to_file_info(const char *filename, char *title, char *info, read_only_t read_only, bool selected)
-{
- /* put up dialog for srate, chans, data format */
- raw_info *rp;
- rp = new_raw_dialog();
- rp->read_only = read_only;
- rp->selected = selected;
- if (rp->filename) free(rp->filename);
- rp->filename = mus_strdup(filename);
- rp->requestor = ss->open_requestor;
- rp->requestor_data = ss->open_requestor_data;
- rp->requestor_dialog = ss->requestor_dialog;
- ss->open_requestor = NO_REQUESTOR;
- ss->requestor_dialog = NULL;
- ss->open_requestor_data = NULL;
- if ((rp->requestor_dialog) &&
- ((rp->requestor == FROM_OPEN_DIALOG) ||
- (rp->requestor == FROM_MIX_DIALOG)))
- XtUnmanageChild(rp->requestor_dialog);
- if (!title)
- title = mus_format("no header found on %s\n", filename);
- if (!(rp->dialog))
- make_raw_data_dialog(rp, title);
- else
- {
- XmString xstr4;
- xstr4 = XmStringCreateLocalized(title);
- XtVaSetValues(rp->dialog,
- XmNmessageString, xstr4,
- NULL);
- XmStringFree(xstr4);
- }
- free(title);
- if (rp->help) free(rp->help);
- if (info)
- {
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_HELP_BUTTON),
- XmNbackground, ss->green,
- NULL);
- rp->help = mus_strdup(info);
- free(info);
- }
- else
- {
- XtVaSetValues(MSG_BOX(rp->dialog, XmDIALOG_HELP_BUTTON),
- XmNbackground, ss->highlight_color,
- NULL);
- rp->help = NULL;
- }
- raise_dialog(rp->dialog);
- if (!XtIsManaged(rp->dialog))
- XtManageChild(rp->dialog);
-}
-
-
-
-/* ---------------- INFO MONOLOG ---------------- */
-
-#define POST_IT_ROWS 12
-#define POST_IT_COLUMNS 56
-
-static Widget post_it_dialog = NULL;
-static Widget post_it_text = NULL;
-
-
-static void create_post_it_monolog(void)
-{
- /* create scrollable but not editable text window; used for fft peaks, sp info, and raw data help displays */
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- post_it_dialog = XmCreateMessageDialog(MAIN_PANE(ss), (char *)"info", args, n);
-
- XtUnmanageChild(MSG_BOX(post_it_dialog, XmDIALOG_CANCEL_BUTTON));
- XtUnmanageChild(MSG_BOX(post_it_dialog, XmDIALOG_HELP_BUTTON));
- XtUnmanageChild(MSG_BOX(post_it_dialog, XmDIALOG_SYMBOL_LABEL));
-
- XtVaSetValues(MSG_BOX(post_it_dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->highlight_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNeditMode, XmMULTI_LINE_EDIT); n++;
- XtSetArg(args[n], XmNeditable, false); n++;
- XtSetArg(args[n], XmNcolumns, POST_IT_COLUMNS); n++;
- XtSetArg(args[n], XmNrows, POST_IT_ROWS); n++;
- XtSetArg(args[n], XmNforeground, ss->black); n++; /* needed if color allocation fails completely */
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- post_it_text = XmCreateScrolledText(post_it_dialog, (char *)"post-it-text", args, n);
- XtManageChild(post_it_text);
- XtManageChild(post_it_dialog);
-
- map_over_children(post_it_dialog, set_main_color_of_widget);
- XtVaSetValues(post_it_text, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- XtVaSetValues(MSG_BOX(post_it_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(post_it_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- set_dialog_widget(POST_IT_DIALOG, post_it_dialog);
-}
-
-
-widget_t post_it(const char *subject, const char *str)
-{
- /* place string in scrollable help window */
- XmString xstr1, xstr2;
- if (ss == NULL) return(NULL); /* an attempt to call this before X/Motif is ready */
- if (!(post_it_dialog))
- create_post_it_monolog();
- else raise_dialog(post_it_dialog);
- xstr1 = XmStringCreateLocalized((char *)subject);
- xstr2 = XmStringCreateLocalized((char *)subject);
- XtVaSetValues(post_it_dialog,
- XmNmessageString, xstr1,
- XmNdialogTitle, xstr2,
- NULL);
- XmTextSetString(post_it_text, (char *)str);
- if (!XtIsManaged(post_it_dialog))
- XtManageChild(post_it_dialog);
- XmStringFree(xstr1);
- XmStringFree(xstr2);
- return(post_it_dialog);
-}
-
-
-void save_post_it_dialog_state(FILE *fd)
-{
- if ((post_it_dialog) && (XtIsManaged(post_it_dialog)))
- {
- char *subject = NULL, *text = NULL;
- subject = dialog_get_title(post_it_dialog);
- text = XmTextGetString(post_it_text);
-#if HAVE_SCHEME
- fprintf(fd, "(%s \"%s\" \"%s\")\n", S_info_dialog, subject, text);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(\"%s\", \"%s\")\n", TO_PROC_NAME(S_info_dialog), subject, text);
-#endif
-#if HAVE_FORTH
- fprintf(fd, "\"%s\" \"%s\" %s drop\n", subject, text, S_info_dialog);
-#endif
- if (subject) free(subject);
- if (text) XtFree(text);
- }
-}
-
-
-/* ---------------- unsaved edits dialog ---------------- */
-
-static int num_unsaved_edits_dialogs = 0;
-static Widget *unsaved_edits_dialogs = NULL;
-static snd_info **unsaved_edits_sounds = NULL;
-
-static Widget unsaved_edits_dialog(snd_info *sp)
-{
- int i;
- /* are there any such dialogs? */
- if (num_unsaved_edits_dialogs == 0)
- return(NULL);
-
- /* now see if we've already prompted about this sound */
- for (i = 0; i < num_unsaved_edits_dialogs; i++)
- if (unsaved_edits_sounds[i] == sp)
- return(unsaved_edits_dialogs[i]);
-
- /* try to find a free unmanaged dialog */
- for (i = 0; i < num_unsaved_edits_dialogs; i++)
- if ((unsaved_edits_dialogs[i]) &&
- (!XtIsManaged(unsaved_edits_dialogs[i])))
- return(unsaved_edits_dialogs[i]);
-
- return(NULL);
-}
-
-static void save_unsaved_edits_dialog(Widget d, snd_info *sp)
-{
- if (num_unsaved_edits_dialogs == 0)
- {
- unsaved_edits_dialogs = (Widget *)calloc(1, sizeof(Widget));
- unsaved_edits_sounds = (snd_info **)calloc(1, sizeof(snd_info *));
- }
- else
- {
- unsaved_edits_dialogs = (Widget *)realloc(unsaved_edits_dialogs, (num_unsaved_edits_dialogs + 1) * sizeof(Widget));
- unsaved_edits_sounds = (snd_info **)realloc(unsaved_edits_sounds, (num_unsaved_edits_dialogs + 1) * sizeof(snd_info *));
- }
-
- unsaved_edits_dialogs[num_unsaved_edits_dialogs] = d;
- unsaved_edits_sounds[num_unsaved_edits_dialogs] = sp;
- num_unsaved_edits_dialogs++;
-}
-
-
-void unpost_unsaved_edits_if_any(snd_info *sp)
-{
- int i;
- for (i = 0; i < num_unsaved_edits_dialogs; i++)
- if (((unsaved_edits_sounds[i] == sp) ||
- (!snd_ok(unsaved_edits_sounds[i]))) &&
- (XtIsManaged(unsaved_edits_dialogs[i])))
- XtUnmanageChild(unsaved_edits_dialogs[i]);
-}
-
-
-static void zero_edits(chan_info *cp)
-{
- cp->edit_ctr = 0;
-}
-
-static void unsaved_edits_no_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- for_each_sound_chan(sp, zero_edits);
- snd_close_file(sp);
-}
-
-static void unsaved_edits_yes_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- save_edits(sp);
- snd_close_file(sp);
-}
-
-static void unsaved_edits_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_help("save edits?",
- "You have set " S_ask_about_unsaved_edits " to " PROC_TRUE ", so you will be asked whether you want \
-to save edits if you try to close a sound that has unsaved edits.",
- WITH_WORD_WRAP);
-}
-
-void save_edits_now(snd_info *sp)
-{
- char *question;
- XmString q;
- Widget dialog;
-
- question = mus_format("%s has unsaved edits. Save them?", sp->short_filename);
- q = XmStringCreateLocalized(question);
-
- dialog = unsaved_edits_dialog(sp);
- if (!dialog)
- {
- Arg args[20];
- int n;
- XmString yes, no;
-
- yes = XmStringCreateLocalized((char *)"yes");
- no = XmStringCreateLocalized((char *)"no");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNokLabelString, yes); n++;
- XtSetArg(args[n], XmNcancelLabelString, no); n++;
- XtSetArg(args[n], XmNmessageString, q); n++;
- dialog = XmCreateQuestionDialog(MAIN_PANE(ss), sp->filename, args, n);
- save_unsaved_edits_dialog(dialog, sp);
-
- XtAddCallback(dialog, XmNhelpCallback, unsaved_edits_help_callback, (XtPointer)sp);
- XtAddCallback(dialog, XmNokCallback, unsaved_edits_yes_callback, (XtPointer)sp);
- XtAddCallback(dialog, XmNcancelCallback, unsaved_edits_no_callback, (XtPointer)sp);
-
- XmStringFree(yes);
- XmStringFree(no);
-
- map_over_children(dialog, set_main_color_of_widget);
- XtVaSetValues(MSG_BOX(dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- }
- else
- {
- XtVaSetValues(dialog, XmNmessageString, q, NULL);
- }
-
- XmStringFree(q);
- free(question);
- XtManageChild(dialog);
-}
-
-
-
-/* ---------------- view files dialog ---------------- */
-
-static XEN mouse_enter_label_hook;
-static XEN mouse_leave_label_hook;
-
-static char *vf_row_get_label(void *ur)
-{
- vf_row *r = (vf_row *)ur;
- return(((view_files_info *)(r->vdat))->full_names[r->pos]);
-}
-
-
-static int vf_row_get_pos(void *ur)
-{
- vf_row *r = (vf_row *)ur;
- return(r->pos);
-}
-
-
-static void mouse_enter_or_leave_label(void *r, int type, XEN hook, const char *caller)
-{
- if ((r) &&
- (XEN_HOOKED(hook)))
- {
- char *label = NULL;
- bool need_free = false;
- if (type == FILE_VIEWER)
- label = vf_row_get_label(r);
- else
- {
- label = regrow_get_label(r);
- if (label) need_free = true;
- }
- if (label)
- run_hook(hook,
- XEN_LIST_3(C_TO_XEN_INT(type),
- C_TO_XEN_INT((type == FILE_VIEWER) ? (vf_row_get_pos(r)) : (regrow_get_pos(r))),
- C_TO_XEN_STRING(label)),
- caller);
- if (need_free) XtFree(label);
- }
-}
-
-
-void mouse_leave_label(void *r, int type)
-{
- mouse_enter_or_leave_label(r, type, mouse_leave_label_hook, S_mouse_leave_label_hook);
-}
-
-
-void mouse_enter_label(void *r, int type)
-{
- mouse_enter_or_leave_label(r, type, mouse_enter_label_hook, S_mouse_enter_label_hook);
-}
-
-
-static void vf_mouse_enter_label(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- mouse_enter_label(context, FILE_VIEWER);
-}
-
-
-static void vf_mouse_leave_label(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- mouse_leave_label(context, FILE_VIEWER);
-}
-
-
-static vf_row *make_vf_row(view_files_info *vdat,
- Widget last_row,
- XtCallbackProc play_callback, XtCallbackProc name_callback)
-{
- int n;
- Arg args[32];
- vf_row *r;
- XmString s1;
- XtCallbackList n1, n3;
-
- s1 = XmStringCreateLocalized((char *)"");
- r = (vf_row *)calloc(1, sizeof(vf_row));
- r->vdat = (void *)vdat;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, (last_row) ? XmATTACH_WIDGET : XmATTACH_FORM); n++;
- if (last_row) {XtSetArg(args[n], XmNtopWidget, last_row); n++;}
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNheight, 18); n++;
- r->rw = XtCreateWidget("rw", xmFormWidgetClass, vdat->file_list_holder, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n1 = make_callback_list(play_callback, (XtPointer)r)); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- XtSetArg(args[n], XmNmarginWidth, 8); n++;
- r->pl = make_togglebutton_widget("pl", r->rw, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, r->pl); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNwidth, 500); n++; /* this sets the max name length indirectly -- was 300 which truncates some long file names (29-Oct-07) */
- XtSetArg(args[n], XmNactivateCallback, n3 = make_callback_list(name_callback, (XtPointer)r)); n++;
- r->nm = XtCreateManagedWidget("nm", xmPushButtonWidgetClass, r->rw, args, n);
- XmStringFree(s1);
-
- XtAddEventHandler(r->nm, EnterWindowMask, false, vf_mouse_enter_label, (XtPointer)r);
- XtAddEventHandler(r->nm, LeaveWindowMask, false, vf_mouse_leave_label, (XtPointer)r);
-
- free(n1);
- free(n3);
- return(r);
-}
-
-
-void vf_unhighlight_row(widget_t nm, widget_t rw)
-{
- XtVaSetValues(rw, XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(nm, XmNbackground, ss->highlight_color, NULL);
-}
-
-
-void vf_highlight_row(widget_t nm, widget_t rw)
-{
- XtVaSetValues(rw, XmNbackground, ss->zoom_color, NULL);
- XtVaSetValues(nm, XmNbackground, ss->zoom_color, NULL);
-}
-
-
-typedef struct {
- vf_row *r;
- color_t old_color;
-} vf_flash_data;
-
-
-static void vf_unflash_row(XtPointer data, XtIntervalId *id)
-{
- vf_flash_data *v = (vf_flash_data *)data;
- XtVaSetValues(v->r->rw, XmNbackground, v->old_color, NULL);
- XtVaSetValues(v->r->nm, XmNbackground, v->old_color, NULL);
- free(v);
-}
-
-
-void vf_flash_row(vf_row *r)
-{
- vf_flash_data *v;
- v = (vf_flash_data *)calloc(1, sizeof(vf_flash_data));
- v->r = r;
- XtVaGetValues(r->rw, XmNbackground, &(v->old_color), NULL);
- XtVaSetValues(r->rw, XmNbackground, ss->light_blue, NULL);
- XtVaSetValues(r->nm, XmNbackground, ss->light_blue, NULL);
- XtAppAddTimeOut(MAIN_APP(ss),
- 500,
- (XtTimerCallbackProc)vf_unflash_row,
- (void *)v);
-}
-
-
-void vf_post_info(view_files_info *vdat, int pos)
-{
- char *title;
- XmString s3;
- title = mus_format("%s:", vdat->names[pos]);
- s3 = XmStringCreateLocalized(title);
- XtVaSetValues(vdat->left_title,
- XmNlabelString, s3,
- NULL);
- XmStringFree(s3);
- free(title);
- post_sound_info(vdat->info1, vdat->info2, vdat->full_names[pos], false);
-}
-
-
-void vf_post_selected_files_list(view_files_info *vdat)
-{
- int len;
- char *msg1 = NULL, *msg2 = NULL, *title;
- XmString s1, s2, s3;
- len = vdat->currently_selected_files;
-
- title = mus_strdup("selected files:");
- s3 = XmStringCreateLocalized(title);
- XtVaSetValues(vdat->left_title,
- XmNlabelString, s3,
- NULL);
- XmStringFree(s3);
- free(title);
-
- if (len == 2)
- {
- msg1 = mus_strdup(vdat->names[vdat->selected_files[0]]);
- msg2 = mus_strdup(vdat->names[vdat->selected_files[1]]);
- }
- else
- {
- if (len == 3)
- {
- msg1 = mus_format("%s, %s", vdat->names[vdat->selected_files[0]], vdat->names[vdat->selected_files[1]]);
- msg2 = mus_strdup(vdat->names[vdat->selected_files[2]]);
- }
- else
- {
- msg1 = mus_format("%s, %s", vdat->names[vdat->selected_files[0]], vdat->names[vdat->selected_files[1]]);
- msg2 = mus_format("%s, %s%s", vdat->names[vdat->selected_files[2]], vdat->names[vdat->selected_files[3]],
- (len == 4) ? "" : "...");
- }
- }
-
- s1 = XmStringCreateLocalized(msg1);
- s2 = XmStringCreateLocalized(msg2);
- XtVaSetValues(vdat->info1, XmNlabelString, s1, NULL);
- XtVaSetValues(vdat->info2, XmNlabelString, s2, NULL);
- XmStringFree(s1);
- XmStringFree(s2);
- free(msg1);
- free(msg2);
-}
-
-
-void vf_unpost_info(view_files_info *vdat)
-{
- XmString s1, s2, s3;
- char *title;
-
- title = mus_strdup("(no files selected)");
- s3 = XmStringCreateLocalized(title);
- XtVaSetValues(vdat->left_title,
- XmNlabelString, s3,
- NULL);
- XmStringFree(s3);
- free(title);
-
- s1 = XmStringCreateLocalized((char *)"|");
- s2 = XmStringCreateLocalized((char *)"|");
- XtVaSetValues(vdat->info1, XmNlabelString, s1, NULL);
- XtVaSetValues(vdat->info2, XmNlabelString, s2, NULL);
- XmStringFree(s1);
- XmStringFree(s2);
-}
-
-
-static void view_files_select_callback(Widget w, XtPointer context, XtPointer info)
-{
- static oclock_t mouse_down_time = 0;
- XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
- XButtonEvent *ev;
- ev = (XButtonEvent *)(cb->event);
-
- /* cb->click_count is always 1 so we can't detect a double-click that way
- * ss->click_time has the (very short!) multiclick time
- */
-
- if (mouse_down_time != 0)
- {
- if ((ev->time - mouse_down_time) < ss->click_time)
- {
- mouse_down_time = ev->time;
- view_files_open_selected_files((view_files_info *)(((vf_row *)context)->vdat));
- return;
- }
- }
- mouse_down_time = ev->time;
- view_files_select((vf_row *)context, ev->state & snd_ShiftMask);
-}
-
-
-static void view_files_play_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* open and play -- close at end or when button off toggled */
- vf_row *r = (vf_row *)context;
- view_files_info *vdat;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- vdat = (view_files_info *)(r->vdat);
- if (view_files_play(vdat, r->pos, cb->set))
- XmToggleButtonSetState(w, false, false);
- else vdat->current_play_button = w;
-}
-
-
-vf_row *view_files_make_row(view_files_info *vdat, widget_t last_row)
-{
- return(make_vf_row(vdat, last_row, view_files_play_callback, view_files_select_callback));
-}
-
-
-static void view_files_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_dialog_help();
-}
-
-
-static void view_files_dismiss_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- Widget active_widget;
- active_widget = XmGetFocusWidget(vdat->dialog);
- if (active_widget == MSG_BOX(vdat->dialog, XmDIALOG_OK_BUTTON))
- XtUnmanageChild(vdat->dialog);
-}
-
-
-static void view_files_new_viewer_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- if ((vdat) &&
- (vdat->dialog) &&
- (XtIsManaged(vdat->dialog)))
- {
- Position x = 0, y = 0;
- /* jog the current one over a bit -- otherwise the new one lands exactly on top of the old! */
- XtVaGetValues(vdat->dialog, XmNx, &x, XmNy, &y, NULL);
- XtVaSetValues(vdat->dialog, XmNx, x + 30, XmNy, y - 30, NULL);
- }
- vdat = new_view_files_dialog();
- start_view_files_dialog_1(vdat, true);
-
-}
-
-
-#if (!HAVE_FAM)
-static void view_files_clear_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- view_files_clear_list(vdat);
- view_files_display_list(vdat);
-}
-
-
-static void view_files_update_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- /* run through view files list looking for any that have been deleted behind our back */
- view_files_update_list(vdat);
- view_files_display_list(vdat);
-}
-#endif
-
-
-static void sort_vf(view_files_info *vdat, int sort_choice)
-{
- vdat->sorter = sort_choice;
- vf_reflect_sort_choice_in_menu(vdat);
- view_files_display_list(vdat);
-}
-
-
-static void sort_view_files_a_to_z(Widget w, XtPointer context, XtPointer info)
-{
- sort_vf((view_files_info *)context, SORT_A_TO_Z);
-}
-
-
-static void sort_view_files_z_to_a(Widget w, XtPointer context, XtPointer info)
-{
- sort_vf((view_files_info *)context, SORT_Z_TO_A);
-}
-
-
-static void sort_view_files_new_to_old(Widget w, XtPointer context, XtPointer info)
-{
- sort_vf((view_files_info *)context, SORT_NEW_TO_OLD);
-}
-
-
-static void sort_view_files_old_to_new(Widget w, XtPointer context, XtPointer info)
-{
- sort_vf((view_files_info *)context, SORT_OLD_TO_NEW);
-}
-
-
-static void sort_view_files_big_to_small(Widget w, XtPointer context, XtPointer info)
-{
- sort_vf((view_files_info *)context, SORT_BIG_TO_SMALL);
-}
-
-
-static void sort_view_files_small_to_big(Widget w, XtPointer context, XtPointer info)
-{
- sort_vf((view_files_info *)context, SORT_SMALL_TO_BIG);
-}
-
-
-static void sort_view_files_xen(Widget w, XtPointer context, XtPointer info)
-{
- pointer_or_int_t index;
- XtVaGetValues(w, XmNuserData, &index, NULL); /* index is location in list of file-sorters */
- sort_vf((view_files_info *)context, (int)index);
-}
-
-
-void vf_reflect_sort_choice_in_menu(view_files_info *vdat)
-{
- int i;
- set_sensitive(vdat->a_to_z, vdat->sorter != SORT_A_TO_Z);
- set_sensitive(vdat->z_to_a, vdat->sorter != SORT_Z_TO_A);
- set_sensitive(vdat->new_to_old, vdat->sorter != SORT_NEW_TO_OLD);
- set_sensitive(vdat->old_to_new, vdat->sorter != SORT_OLD_TO_NEW);
- set_sensitive(vdat->small_to_big, vdat->sorter != SORT_SMALL_TO_BIG);
- set_sensitive(vdat->big_to_small, vdat->sorter != SORT_BIG_TO_SMALL);
- for (i = 0; i < vdat->sort_items_size; i++)
- if (XtIsManaged(vdat->sort_items[i]))
- set_sensitive(vdat->sort_items[i], vdat->sorter != (SORT_XEN + i));
-}
-
-
-void view_files_add_file_or_directory(view_files_info *vdat, const char *file_or_dir)
-{
- char *filename;
- filename = mus_expand_filename((const char *)file_or_dir);
- if ((filename) && (filename[strlen(filename) - 1] == '*'))
- filename[strlen(filename) - 1] = 0;
- if (directory_p(filename))
- add_directory_to_view_files_list(vdat, (const char *)filename);
- else add_file_to_view_files_list(vdat, file_or_dir, filename);
- free(filename);
-}
-
-
-static void view_files_add_files(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- char *file_or_dir;
- file_or_dir = XmTextFieldGetString(w);
- if ((file_or_dir) && (*file_or_dir))
- {
- view_files_add_file_or_directory(vdat, (const char *)file_or_dir);
- XtFree(file_or_dir);
- view_files_display_list(vdat);
- }
-}
-
-
-static void view_files_drop_watcher(Widget w, const char *str, Position x, Position y, void *context)
-{
- view_files_info *vdat = (view_files_info *)context;
- /* incoming str is a single filename (drop watcher code splits the possible list and calls us on each one) */
- view_files_add_file_or_directory(vdat, str);
- view_files_display_list(vdat);
-}
-
-
-static void view_files_drag_watcher(Widget w, const char *str, Position x, Position y, drag_style_t dtype, void *context)
-{
- view_files_info *vdat = (view_files_info *)context;
- switch (dtype)
- {
- case DRAG_ENTER:
- XmChangeColor(vdat->file_list, ss->selection_color);
- break;
-
- case DRAG_LEAVE:
- XmChangeColor(vdat->file_list, ss->basic_color);
- break;
-
- default:
- break;
- }
-}
-
-
-static void view_files_open_selected_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_open_selected_files((view_files_info *)context);
-}
-
-
-static void view_files_remove_selected_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* the "unlist" button's callback */
- view_files_remove_selected_files((view_files_info *)context);
-}
-
-
-mus_long_t vf_location(view_files_info *vdat)
-{
- mus_long_t pos = 0;
- snd_info *sp;
- chan_info *cp;
- char *str;
- switch (vdat->location_choice)
- {
- case VF_AT_CURSOR:
- sp = any_selected_sound();
- if (sp)
- {
- cp = any_selected_channel(sp);
- return(CURSOR(cp));
- }
- break;
-
- case VF_AT_END:
- sp = any_selected_sound();
- if (sp)
- {
- cp = any_selected_channel(sp);
- return(CURRENT_SAMPLES(cp));
- }
- break;
-
- case VF_AT_BEGINNING:
- return(0);
- break;
-
- case VF_AT_MARK:
- str = XmTextGetString(vdat->at_mark_text);
- if ((str) && (*str))
- {
- pos = mark_id_to_sample(string_to_int(str, 0, "mark"));
- XtFree(str);
- if (pos < 0)
- snd_error_without_format("no such mark");
- }
- else snd_error_without_format("no mark?");
- break;
-
- case VF_AT_SAMPLE:
- str = XmTextGetString(vdat->at_sample_text);
- if ((str) && (*str))
- {
- pos = string_to_mus_long_t(str, 0, "sample");
- XtFree(str);
- /* pos already checked for lower bound */
- }
- else snd_error_without_format("no sample number?");
- break;
- }
- return(pos);
-}
-
-
-static void vf_clear_sample(view_files_info *vdat);
-
-static void vf_sample_button_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- vf_clear_sample((view_files_info *)context);
-}
-
-
-static void vf_sample_text_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- vf_clear_sample((view_files_info *)context);
- cbs->doit = true;
-}
-
-
-static void vf_clear_sample(view_files_info *vdat)
-{
- vf_clear_error(vdat);
- XtRemoveCallback(vdat->at_sample_text, XmNmodifyVerifyCallback, vf_sample_text_modify_callback, (XtPointer)vdat);
- XtRemoveCallback(vdat->at_sample_button, XmNvalueChangedCallback, vf_sample_button_modify_callback, (XtPointer)vdat);
-}
-
-
-static void vf_clear_mark(view_files_info *vdat);
-
-static void vf_mark_button_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- vf_clear_mark((view_files_info *)context);
-}
-
-
-static void vf_mark_text_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- vf_clear_mark((view_files_info *)context);
- cbs->doit = true;
-}
-
-
-static void vf_clear_mark(view_files_info *vdat)
-{
- vf_clear_error(vdat);
- XtRemoveCallback(vdat->at_mark_text, XmNmodifyVerifyCallback, vf_mark_text_modify_callback, (XtPointer)vdat);
- XtRemoveCallback(vdat->at_mark_button, XmNvalueChangedCallback, vf_mark_button_modify_callback, (XtPointer)vdat);
-}
-
-
-static void vf_add_text_modify_callback(Widget w, XtPointer context, XtPointer info);
-
-static void remove_all_pending_clear_callbacks(view_files_info *vdat)
-{
- /* docs say this is a no-op if the indicated callback does not exist (i.e. not an error or segfault) */
- XtRemoveCallback(vdat->at_mark_text, XmNmodifyVerifyCallback, vf_mark_text_modify_callback, (XtPointer)vdat);
- XtRemoveCallback(vdat->at_mark_button, XmNvalueChangedCallback, vf_mark_button_modify_callback, (XtPointer)vdat);
- XtRemoveCallback(vdat->at_sample_text, XmNmodifyVerifyCallback, vf_sample_text_modify_callback, (XtPointer)vdat);
- XtRemoveCallback(vdat->at_sample_button, XmNvalueChangedCallback, vf_sample_button_modify_callback, (XtPointer)vdat);
- XtRemoveCallback(vdat->add_text, XmNmodifyVerifyCallback, vf_add_text_modify_callback, (XtPointer)vdat);
-}
-
-
-void vf_post_error(const char *error_msg, view_files_info *vdat)
-{
- XmString msg;
- remove_all_pending_clear_callbacks(vdat);
- vdat->error_p = true;
- msg = XmStringCreateLocalized((char *)error_msg);
- XtVaSetValues(vdat->info1,
- XmNlabelString, msg,
- NULL);
- XmStringFree(msg);
- msg = XmStringCreateLocalized((char *)"");
- XtVaSetValues(vdat->info2,
- XmNlabelString, msg,
- NULL);
- XmStringFree(msg);
-}
-
-
-void redirect_vf_post_error(const char *error_msg, void *vdat)
-{
- vf_post_error(error_msg, (view_files_info *)vdat);
-}
-
-
-void redirect_vf_post_location_error(const char *error_msg, void *data)
-{
- view_files_info *vdat = (view_files_info *)data;
- vf_post_error(error_msg, vdat);
- if (vdat->location_choice == VF_AT_SAMPLE)
- {
- /* watch at_sample_text or button (undo) */
- XtAddCallback(vdat->at_sample_text, XmNmodifyVerifyCallback, vf_sample_text_modify_callback, (XtPointer)vdat);
- XtAddCallback(vdat->at_sample_button, XmNvalueChangedCallback, vf_sample_button_modify_callback, (XtPointer)vdat);
- }
- else
- {
- /* watch at_mark_text or button */
- XtAddCallback(vdat->at_mark_text, XmNmodifyVerifyCallback, vf_mark_text_modify_callback, (XtPointer)vdat);
- XtAddCallback(vdat->at_mark_button, XmNvalueChangedCallback, vf_mark_button_modify_callback, (XtPointer)vdat);
- }
-}
-
-
-static void vf_add_text_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- view_files_info *vdat = (view_files_info *)context;
- vf_clear_error(vdat);
- XtRemoveCallback(vdat->add_text, XmNmodifyVerifyCallback, vf_add_text_modify_callback, (XtPointer)vdat);
- cbs->doit = true;
-}
-
-
-void vf_post_add_error(const char *error_msg, view_files_info *vdat)
-{
- vf_post_error(error_msg, vdat);
- XtAddCallback(vdat->add_text, XmNmodifyVerifyCallback, vf_add_text_modify_callback, (XtPointer)vdat);
- /* what about other clearing actions? */
-}
-
-
-static void view_files_mix_selected_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_mix_selected_files(w, (view_files_info *)context);
-}
-
-
-static void view_files_insert_selected_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_insert_selected_files(w, (view_files_info *)context);
-}
-
-
-static void view_files_at_cursor_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- if (vdat->error_p)
- {
- if (vdat->location_choice == VF_AT_SAMPLE)
- vf_clear_sample(vdat);
- else vf_clear_mark(vdat);
- }
- XmToggleButtonSetState(vdat->at_cursor_button, true, false);
- XmToggleButtonSetState(vdat->at_end_button, false, false);
- XmToggleButtonSetState(vdat->at_beginning_button, false, false);
- XmToggleButtonSetState(vdat->at_mark_button, false, false);
- XmToggleButtonSetState(vdat->at_sample_button, false, false);
- vdat->location_choice = VF_AT_CURSOR;
-}
-
-
-static void view_files_at_end_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- if (vdat->error_p)
- {
- if (vdat->location_choice == VF_AT_SAMPLE)
- vf_clear_sample(vdat);
- else vf_clear_mark(vdat);
- }
- XmToggleButtonSetState(vdat->at_cursor_button, false, false);
- XmToggleButtonSetState(vdat->at_end_button, true, false);
- XmToggleButtonSetState(vdat->at_beginning_button, false, false);
- XmToggleButtonSetState(vdat->at_mark_button, false, false);
- XmToggleButtonSetState(vdat->at_sample_button, false, false);
- vdat->location_choice = VF_AT_END;
-}
-
-
-static void view_files_at_beginning_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- if (vdat->error_p)
- {
- if (vdat->location_choice == VF_AT_SAMPLE)
- vf_clear_sample(vdat);
- else vf_clear_mark(vdat);
- }
- XmToggleButtonSetState(vdat->at_cursor_button, false, false);
- XmToggleButtonSetState(vdat->at_end_button, false, false);
- XmToggleButtonSetState(vdat->at_beginning_button, true, false);
- XmToggleButtonSetState(vdat->at_mark_button, false, false);
- XmToggleButtonSetState(vdat->at_sample_button, false, false);
- vdat->location_choice = VF_AT_BEGINNING;
-}
-
-
-static void view_files_at_sample_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- if ((vdat->error_p) &&
- (vdat->location_choice == VF_AT_MARK))
- vf_clear_mark(vdat);
- XmToggleButtonSetState(vdat->at_cursor_button, false, false);
- XmToggleButtonSetState(vdat->at_end_button, false, false);
- XmToggleButtonSetState(vdat->at_beginning_button, false, false);
- XmToggleButtonSetState(vdat->at_mark_button, false, false);
- XmToggleButtonSetState(vdat->at_sample_button, true, false);
- vdat->location_choice = VF_AT_SAMPLE;
-}
-
-
-static void view_files_at_mark_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- if ((vdat->error_p) &&
- (vdat->location_choice == VF_AT_SAMPLE))
- vf_clear_sample(vdat);
- XmToggleButtonSetState(vdat->at_cursor_button, false, false);
- XmToggleButtonSetState(vdat->at_end_button, false, false);
- XmToggleButtonSetState(vdat->at_beginning_button, false, false);
- XmToggleButtonSetState(vdat->at_mark_button, true, false);
- XmToggleButtonSetState(vdat->at_sample_button, false, false);
- vdat->location_choice = VF_AT_MARK;
-}
-
-
-
-/* -------- speed -------- */
-
-static int vf_speed_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0);
- if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
- return(snd_round(0.9 * SCROLLBAR_MAX * ((log(val) - log(minval)) / (log(maxval) - log(minval)))));
-}
-
-
-void vf_set_speed(view_files_info *vdat, mus_float_t val)
-{
- char speed_number_buffer[6];
- vdat->speed = speed_changed(val,
- speed_number_buffer,
- vdat->speed_style,
- speed_control_tones(ss),
- 6);
- set_label(vdat->speed_number, speed_number_buffer);
- XtVaSetValues(vdat->speed_scrollbar,
- XmNvalue, vf_speed_to_scroll(speed_control_min(ss), val, speed_control_max(ss)),
- NULL);
-}
-
-
-static void vf_speed_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- vf_set_speed(vdat, 1.0);
- XtVaSetValues(vdat->speed_scrollbar,
- XmNvalue, vf_speed_to_scroll(speed_control_min(ss), 1.0, speed_control_max(ss)),
- NULL);
-}
-
-
-static void speed_label_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- char speed_number_buffer[6];
- view_files_info *vdat = (view_files_info *)context;
-
- switch (vdat->speed_style)
- {
- default:
- case SPEED_CONTROL_AS_FLOAT: vdat->speed_style = SPEED_CONTROL_AS_RATIO; break;
- case SPEED_CONTROL_AS_RATIO: vdat->speed_style = SPEED_CONTROL_AS_SEMITONE; break;
- case SPEED_CONTROL_AS_SEMITONE: vdat->speed_style = SPEED_CONTROL_AS_FLOAT; break;
- }
- speed_changed(vdat->speed,
- speed_number_buffer,
- vdat->speed_style,
- speed_control_tones(ss),
- 6);
- set_label(vdat->speed_number, speed_number_buffer);
-}
-
-
-static void vf_speed_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- vf_set_speed(vdat, exp((cb->value *
- (log(speed_control_max(ss)) - log(speed_control_min(ss))) /
- (0.9 * SCROLLBAR_MAX)) + log(speed_control_min(ss))));
-}
-
-
-static void vf_speed_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- vf_set_speed(vdat, exp((cb->value *
- (log(speed_control_max(ss)) - log(speed_control_min(ss))) /
- (0.9 * SCROLLBAR_MAX)) + log(speed_control_min(ss))));
-}
-
-
-
-/* -------- amp -------- */
-
-static mus_float_t vf_scroll_to_amp(int val)
-{
- if (val <= 0)
- return(amp_control_min(ss));
- if (val >= (0.9 * SCROLLBAR_MAX))
- return(amp_control_max(ss));
- if (val > (0.5 * 0.9 * SCROLLBAR_MAX))
- return((((val / (0.5 * 0.9 * SCROLLBAR_MAX)) - 1.0) * (amp_control_max(ss) - 1.0)) + 1.0);
- else return((val * (1.0 - amp_control_min(ss)) / (0.5 * 0.9 * SCROLLBAR_MAX)) + amp_control_min(ss));
-}
-
-
-static int vf_amp_to_scroll(mus_float_t amp)
-{
- return(amp_to_scroll(amp_control_min(ss), amp, amp_control_max(ss)));
-}
-
-
-void vf_set_amp(view_files_info *vdat, mus_float_t val)
-{
- char sfs[6];
- vdat->amp = val;
- mus_snprintf(sfs, 6, "%.2f", val);
- set_label(vdat->amp_number, sfs);
- XtVaSetValues(vdat->amp_scrollbar,
- XmNvalue, amp_to_scroll(amp_control_min(ss), val, amp_control_max(ss)),
- NULL);
-}
-
-
-static void vf_amp_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- vf_set_amp((view_files_info *)context, 1.0);
-}
-
-
-static void vf_amp_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- vf_set_amp((view_files_info *)context,
- vf_scroll_to_amp(((XmScrollBarCallbackStruct *)info)->value));
-}
-
-
-static void vf_amp_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- vf_set_amp((view_files_info *)context,
- vf_scroll_to_amp(((XmScrollBarCallbackStruct *)info)->value));
-}
-
-
-
-
-/* -------- amp-envs -------- */
-
-static void vf_amp_env_resize(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- if (vdat->env_ax == NULL)
- {
- XGCValues gv;
- gv.function = GXcopy;
- XtVaGetValues(vdat->env_drawer, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
- vdat->env_gc = XtGetGC(vdat->env_drawer, GCForeground | GCFunction, &gv);
- vdat->env_ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- vdat->env_ax->wn = XtWindow(vdat->env_drawer);
- vdat->env_ax->dp = XtDisplay(vdat->env_drawer);
- vdat->env_ax->gc = vdat->env_gc;
- if (!(vdat->env_ax->wn)) return;
- }
- else
- {
- if (!(vdat->env_ax->wn))
- {
- vdat->env_ax->wn = XtWindow(vdat->env_drawer); /* sometimes the dialog window is not ready when display_env gets called */
- if (!(vdat->env_ax->wn)) return;
- }
- clear_window(vdat->env_ax);
- }
- vdat->spf->with_dots = true;
- env_editor_display_env(vdat->spf, vdat->amp_env, vdat->env_ax, "amp env",
- 0, 0,
- widget_width(w), widget_height(w),
- NOT_PRINTING);
- /* it might be nice to show the sound data in the background, but there are
- * complications involving multichannel and multiselection cases, also
- * how to get the "peak-func" and how to call g_channel_amp_envs.
- * Too many problems...
- * but perhaps something like the region browser display would work:
- * label saying file+chan and up/down arrows to see the rest + off button
- */
-}
-
-
-static void vf_amp_env_redraw(Widget w, view_files_info *vdat)
-{
- vf_amp_env_resize(w, (void *)vdat, NULL);
-}
-
-
-#if HAVE_OSX
-static int press_x, press_y;
-#endif
-
-static void vf_drawer_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- view_files_info *vdat = (view_files_info *)context;
- XMotionEvent *ev = (XMotionEvent *)event;
- mus_float_t pos;
-
-#if HAVE_OSX
- if ((press_x == ev->x) && (press_y == ev->y)) return;
-#endif
-
- pos = (mus_float_t)(ev->x) / (mus_float_t)widget_width(w);
- env_editor_button_motion(vdat->spf, ev->x, ev->y, ev->time, vdat->amp_env);
- vf_amp_env_resize(w, context, NULL);
-}
-
-
-static void vf_drawer_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- view_files_info *vdat = (view_files_info *)context;
- XButtonEvent *ev = (XButtonEvent *)event;
- mus_float_t pos;
-
-#if HAVE_OSX
- press_x = ev->x;
- press_y = ev->y;
-#endif
-
- pos = (mus_float_t)(ev->x) / (mus_float_t)widget_width(w);
- if (env_editor_button_press(vdat->spf, ev->x, ev->y, ev->time, vdat->amp_env))
- vf_amp_env_resize(w, context, NULL);
-}
-
-
-static void vf_drawer_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- view_files_info *vdat = (view_files_info *)context;
- XButtonEvent *ev = (XButtonEvent *)event;
- mus_float_t pos;
-
- pos = (mus_float_t)(ev->x) / (mus_float_t)widget_width(w);
- env_editor_button_release(vdat->spf, vdat->amp_env);
- vf_amp_env_resize(w, context, NULL);
-}
-
-
-void vf_set_amp_env(view_files_info *vdat, env *new_e)
-{
- if (!vdat) return;
- if (vdat->amp_env) free_env(vdat->amp_env);
- vdat->amp_env = copy_env(new_e);
- if ((vdat->dialog) &&
- (widget_is_active(vdat->dialog)))
- vf_amp_env_redraw(vdat->env_drawer, vdat);
-}
-
-
-static void blue_textfield_unfocus_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtVaSetValues(w, XmNbackground, ss->lighter_blue, NULL);
- XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
-}
-
-
-static void blue_mouse_leave_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- XtVaSetValues(w, XmNbackground, ss->lighter_blue, NULL);
- XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
-}
-
-
-static void white_mouse_enter_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- XtVaSetValues(w, XmNbackground, ss->text_focus_color, NULL);
- XtVaSetValues(w, XmNcursorPositionVisible, true, NULL);
-}
-
-
-static void view_files_reset_callback(Widget w, XtPointer context, XtPointer info)
-{
- view_files_info *vdat = (view_files_info *)context;
- env *e;
- vf_set_amp(vdat, 1.0);
- vf_set_speed(vdat, 1.0);
- vf_set_amp_env(vdat, e = default_env(1.0, 1.0)); /* vf_set_amp_env copies the envelope */
- free_env(e);
- sort_vf(vdat, view_files_sort(ss));
-}
-
-
-widget_t start_view_files_dialog_1(view_files_info *vdat, bool managed)
-{
- if (!(vdat->dialog))
- {
- int i, n;
- Arg args[20];
- XmString xdismiss, xhelp, titlestr, new_viewer_str, s1, bstr;
- Widget mainform, viewform, leftform, reset_button;
- Widget left_title_sep, add_label, sep1, sep3, sep4, sep5, sep6, sep7, sort_cascade_menu;
-#if (!HAVE_FAM)
- Widget sep2;
-#endif
- Widget plw, rlw, sbar;
- XtCallbackList n1, n2, n3, n4;
- Widget amp_label, speed_label, env_frame;
- Widget bframe, bform;
-
- xdismiss = XmStringCreateLocalized((char *)"Go Away");
- xhelp = XmStringCreateLocalized((char *)"Help");
- new_viewer_str = XmStringCreateLocalized((char *)"New Viewer");
-
- {
- char *filestr = NULL;
- filestr = mus_format("%s %d", "Files", vdat->index + 1);
- titlestr = XmStringCreateLocalized(filestr);
- free(filestr);
- }
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNokLabelString, xdismiss); n++;
- XtSetArg(args[n], XmNcancelLabelString, new_viewer_str); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- vdat->dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Files", args, n);
-
- XtAddCallback(vdat->dialog, XmNhelpCallback, view_files_help_callback, (XtPointer)vdat);
- XtAddCallback(vdat->dialog, XmNokCallback, view_files_dismiss_callback, (XtPointer)vdat);
- XtAddCallback(vdat->dialog, XmNcancelCallback, view_files_new_viewer_callback, (XtPointer)vdat);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- reset_button = XtCreateManagedWidget("Reset", xmPushButtonGadgetClass, vdat->dialog, args, n);
- XtAddCallback(reset_button, XmNactivateCallback, view_files_reset_callback, (XtPointer)vdat);
-
- XmStringFree(xhelp);
- XmStringFree(xdismiss);
- XmStringFree(titlestr);
- XmStringFree(new_viewer_str);
-
- XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(vdat->dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, MSG_BOX(vdat->dialog, XmDIALOG_SEPARATOR)); n++;
- XtSetArg(args[n], XmNsashIndent, 2); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNspacing, 24); n++;
- XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
- mainform = XtCreateManagedWidget("formd", xmPanedWindowWidgetClass, vdat->dialog, args, n);
-
- /* -------- left side controls -------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- leftform = XtCreateManagedWidget("leftform", xmFormWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- vdat->left_title = XtCreateManagedWidget("(no files selected)", xmLabelWidgetClass, leftform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->left_title); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmDOUBLE_LINE); n++;
- left_title_sep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, leftform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, left_title_sep); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- vdat->info1 = XtCreateManagedWidget("|", xmLabelWidgetClass, leftform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->info1); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- vdat->info2 = XtCreateManagedWidget("|", xmLabelWidgetClass, leftform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->info2); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 8); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep6 = XtCreateManagedWidget("dialog-sep1", xmSeparatorWidgetClass, leftform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNmarginTop, 0); n++;
- XtSetArg(args[n], XmNmarginBottom, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 1); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep6); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- vdat->openB = XtCreateManagedWidget("Open", xmPushButtonGadgetClass, leftform, args, n);
- XtAddCallback(vdat->openB, XmNactivateCallback, view_files_open_selected_callback, (XtPointer)vdat);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNmarginTop, 0); n++;
- XtSetArg(args[n], XmNmarginBottom, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 1); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->openB); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, vdat->openB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- vdat->removeB = XtCreateManagedWidget("Unlist", xmPushButtonGadgetClass, leftform, args, n);
- XtAddCallback(vdat->removeB, XmNactivateCallback, view_files_remove_selected_callback, (XtPointer)vdat);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->openB); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 8); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep5 = XtCreateManagedWidget("dialog-sep1", xmSeparatorWidgetClass, leftform, args, n);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
- XtSetArg(args[n], XmNborderColor, ss->zoom_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep5); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNborderWidth, 2); n++;
- bframe = XtCreateManagedWidget("bframe", xmFrameWidgetClass, leftform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- bform = XtCreateManagedWidget("bform", xmFormWidgetClass, bframe, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNmarginTop, 0); n++;
- XtSetArg(args[n], XmNmarginBottom, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 1); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- vdat->mixB = XtCreateManagedWidget("Mix", xmPushButtonWidgetClass, bform, args, n);
- XtAddCallback(vdat->mixB, XmNactivateCallback, view_files_mix_selected_callback, (XtPointer)vdat);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNmarginTop, 0); n++;
- XtSetArg(args[n], XmNmarginBottom, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 1); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, vdat->mixB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- vdat->insertB = XtCreateManagedWidget("Insert", xmPushButtonWidgetClass, bform, args, n);
- XtAddCallback(vdat->insertB, XmNactivateCallback, view_files_insert_selected_callback, (XtPointer)vdat);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"at cursor");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->mixB); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
- XtSetArg(args[n], XmNset, XmSET); n++;
- vdat->at_cursor_button = make_togglebutton_widget("at-cursor-button", bform, args, n);
- XtAddCallback(vdat->at_cursor_button, XmNdisarmCallback, view_files_at_cursor_callback, (XtPointer)vdat);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"at end");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->at_cursor_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
- vdat->at_end_button = make_togglebutton_widget("at-end-button", bform, args, n);
- XtAddCallback(vdat->at_end_button, XmNdisarmCallback, view_files_at_end_callback, (XtPointer)vdat);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"at beginning");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->at_end_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
- vdat->at_beginning_button = make_togglebutton_widget("at-beginning-button", bform, args, n);
- XtAddCallback(vdat->at_beginning_button, XmNdisarmCallback, view_files_at_beginning_callback, (XtPointer)vdat);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"at sample");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->at_beginning_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
- vdat->at_sample_button = make_togglebutton_widget("at-sample-button", bform, args, n);
- XtAddCallback(vdat->at_sample_button, XmNdisarmCallback, view_files_at_sample_callback, (XtPointer)vdat);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->at_beginning_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, vdat->at_sample_button); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, vdat->at_sample_button); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- vdat->at_sample_text = make_textfield_widget("at-sample-text", bform, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
- XtRemoveCallback(vdat->at_sample_text, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- XtAddCallback(vdat->at_sample_text, XmNlosingFocusCallback, blue_textfield_unfocus_callback, NULL);
- XtAddEventHandler(vdat->at_sample_text, LeaveWindowMask, false, blue_mouse_leave_text_callback, NULL);
- XtAddEventHandler(vdat->at_sample_text, EnterWindowMask, false, white_mouse_enter_text_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNselectColor, ss->red); n++;
- bstr = XmStringCreateLocalized((char *)"at mark");
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->at_sample_button); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNlabelString, bstr); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNindicatorType, XmONE_OF_MANY); n++;
- vdat->at_mark_button = make_togglebutton_widget("at-mark-button", bform, args, n);
- XtAddCallback(vdat->at_mark_button, XmNdisarmCallback, view_files_at_mark_callback, (XtPointer)vdat);
- XmStringFree(bstr);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->at_sample_text); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, vdat->at_mark_button); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- vdat->at_mark_text = make_textfield_widget("at-mark-text", bform, args, n, NOT_ACTIVATABLE, NO_COMPLETER);
- XtRemoveCallback(vdat->at_mark_text, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- XtAddCallback(vdat->at_mark_text, XmNlosingFocusCallback, blue_textfield_unfocus_callback, NULL);
- XtAddEventHandler(vdat->at_mark_text, LeaveWindowMask, false, blue_mouse_leave_text_callback, NULL);
- XtAddEventHandler(vdat->at_mark_text, EnterWindowMask, false, white_mouse_enter_text_callback, NULL);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, bframe); n++;
-
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNheight, 8); n++;
- sep4 = XtCreateManagedWidget("sep4", xmSeparatorWidgetClass, leftform, args, n);
-
- n = 0;
- /* AMP */
- s1 = XmStringCreateLocalized((char *)"amp:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep4); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- /* XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++; */
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- amp_label = make_pushbutton_widget("amp-label", leftform, args, n);
- XtAddCallback(amp_label, XmNactivateCallback, vf_amp_click_callback, (XtPointer)vdat);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"1.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep4); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, amp_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- /* XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++; */
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- /* XtSetArg(args[n], XmNmarginRight, 3); n++; */
- vdat->amp_number = XtCreateManagedWidget("amp-number", xmLabelWidgetClass, leftform, args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep4); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, vdat->amp_number); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, vf_amp_to_scroll(1.0)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(vf_amp_valuechanged_callback, (XtPointer)vdat)); n++;
- XtSetArg(args[n], XmNdragCallback, n3 = make_callback_list(vf_amp_drag_callback, (XtPointer)vdat)); n++;
- vdat->amp_scrollbar = XtCreateManagedWidget("amp-scroll", xmScrollBarWidgetClass, leftform, args, n);
-
- n = 0;
- /* SPEED */
- s1 = XmStringCreateLocalized((char *)"speed:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, amp_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- /* XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++; */
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- speed_label = make_pushbutton_widget("speed-label", leftform, args, n);
- XtAddCallback(speed_label, XmNactivateCallback, vf_speed_click_callback, (XtPointer)vdat);
- XmStringFree(s1);
-
- n = 0;
- s1 = initial_speed_label(speed_control_style(ss));
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, speed_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, speed_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- /* XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++; */
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- /* XtSetArg(args[n], XmNmarginRight, 3); n++; */
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- vdat->speed_number = make_pushbutton_widget("speed-number", leftform, args, n);
- XtAddCallback(vdat->speed_number, XmNactivateCallback, speed_label_click_callback, (XtPointer)vdat);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, vdat->speed_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, vdat->speed_number); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, vf_speed_to_scroll(speed_control_min(ss), 1.0, speed_control_max(ss))); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n4 = make_callback_list(vf_speed_valuechanged_callback, (XtPointer)vdat)); n++;
- XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(vf_speed_drag_callback, (XtPointer)vdat)); n++;
- vdat->speed_scrollbar = XtCreateManagedWidget("speed-scroll", xmScrollBarWidgetClass, leftform, args, n);
-
-
- /* separator before envelope */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, speed_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 8); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep7 = XtCreateManagedWidget("dialog-sep1", xmSeparatorWidgetClass, leftform, args, n);
-
-
- /* amp env */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep7); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 4); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 98); n++;
- XtSetArg(args[n], XmNheight, 100); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 4); n++;
- env_frame = XtCreateManagedWidget("amp-env-frame", xmFrameWidgetClass, leftform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNheight, 100); n++;
- vdat->env_drawer = XtCreateManagedWidget("amp-env-window", xmDrawingAreaWidgetClass, env_frame, args, n);
-
- /* right side */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- viewform = XtCreateManagedWidget("viewform", xmFormWidgetClass, mainform, args, n);
-
- /* Add dir/file text entry at bottom */
- n = 0;
- s1 = XmStringCreateLocalized((char *)"add:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- add_label = XtCreateManagedWidget("add", xmLabelWidgetClass, viewform, args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, add_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- vdat->add_text = make_textfield_widget("add-text", viewform, args, n, ACTIVATABLE, add_completer_func(filename_completer, NULL));
- XtAddCallback(vdat->add_text, XmNactivateCallback, view_files_add_files, (XtPointer)vdat);
-
-#if (!HAVE_FAM)
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, vdat->add_text); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNheight, 4); n++;
- sep2 = XtCreateManagedWidget("sep2", xmSeparatorWidgetClass, viewform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNmarginTop, 0); n++;
- XtSetArg(args[n], XmNmarginBottom, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 1); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, sep2); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 50); n++;
- vdat->updateB = XtCreateManagedWidget("Update", xmPushButtonGadgetClass, viewform, args, n);
- /* need Gadget if we want a subsequent XmNbackgroundPixmap change to be reflected in the button */
- XtAddCallback(vdat->updateB, XmNactivateCallback, view_files_update_callback, (XtPointer)vdat);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNmarginTop, 0); n++;
- XtSetArg(args[n], XmNmarginBottom, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 1); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, sep2); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, vdat->updateB); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- vdat->clearB = XtCreateManagedWidget("Clear", xmPushButtonGadgetClass, viewform, args, n);
- XtAddCallback(vdat->clearB, XmNactivateCallback, view_files_clear_callback, (XtPointer)vdat);
-#endif
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
-#if (!HAVE_FAM)
- XtSetArg(args[n], XmNbottomWidget, vdat->updateB); n++;
-#else
- XtSetArg(args[n], XmNbottomWidget, vdat->add_text); n++;
-#endif
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNheight, 4); n++;
- sep3 = XtCreateManagedWidget("sep3", xmSeparatorWidgetClass, viewform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_CENTER); n++;
- rlw = XtCreateManagedWidget("files", xmLabelWidgetClass, viewform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, rlw); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmDOUBLE_LINE); n++;
- sep1 = XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, viewform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 5); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep1); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- plw = XtCreateManagedWidget("play", xmLabelWidgetClass, viewform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep1); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- sbar = XmCreateMenuBar(viewform, (char *)"menuBar", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- vdat->smenu = XmCreatePulldownMenu(sbar, (char *)"sort-menu", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNsubMenuId, vdat->smenu); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNmarginHeight, 1); n++;
- sort_cascade_menu = XtCreateManagedWidget("sort", xmCascadeButtonWidgetClass, sbar, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- vdat->a_to_z = XtCreateManagedWidget("a..z", xmPushButtonWidgetClass, vdat->smenu, args, n);
- vdat->z_to_a = XtCreateManagedWidget("z..a", xmPushButtonWidgetClass, vdat->smenu, args, n);
- vdat->new_to_old = XtCreateManagedWidget("new..old", xmPushButtonWidgetClass, vdat->smenu, args, n);
- vdat->old_to_new = XtCreateManagedWidget("old..new", xmPushButtonWidgetClass, vdat->smenu, args, n);
- vdat->small_to_big = XtCreateManagedWidget("small..big", xmPushButtonWidgetClass, vdat->smenu, args, n);
- vdat->big_to_small = XtCreateManagedWidget("big..small", xmPushButtonWidgetClass, vdat->smenu, args, n);
-
- vdat->sort_items_size = 4;
- vdat->sort_items = (Widget *)calloc(vdat->sort_items_size, sizeof(Widget));
- for (i = 0; i < vdat->sort_items_size; i++)
- vdat->sort_items[i] = XtCreateWidget("unused", xmPushButtonWidgetClass, vdat->smenu, args, n);
-
- XtManageChild(sbar);
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 5); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, plw); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, sep3); n++;
- XtSetArg(args[n], XmNscrollingPolicy, XmAUTOMATIC); n++;
- XtSetArg(args[n], XmNscrollBarDisplayPolicy, XmSTATIC); n++;
- vdat->file_list = XmCreateScrolledWindow(viewform, (char *)"file_list", args, n);
-
- n = attach_all_sides(args, 0);
- vdat->file_list_holder = XtCreateManagedWidget("file_list_holder", xmRowColumnWidgetClass, vdat->file_list, args, n);
- XtVaSetValues(vdat->file_list,
- XmNworkWindow, vdat->file_list_holder,
- NULL);
- add_drag_and_drop(vdat->file_list, view_files_drop_watcher, view_files_drag_watcher, (void *)vdat);
-
- if (managed) view_files_display_list(vdat);
-
- XtAddCallback(vdat->a_to_z, XmNactivateCallback, sort_view_files_a_to_z, (XtPointer)vdat);
- XtAddCallback(vdat->z_to_a, XmNactivateCallback, sort_view_files_z_to_a, (XtPointer)vdat);
- XtAddCallback(vdat->new_to_old, XmNactivateCallback, sort_view_files_new_to_old, (XtPointer)vdat);
- XtAddCallback(vdat->old_to_new, XmNactivateCallback, sort_view_files_old_to_new, (XtPointer)vdat);
- XtAddCallback(vdat->small_to_big, XmNactivateCallback, sort_view_files_small_to_big, (XtPointer)vdat);
- XtAddCallback(vdat->big_to_small, XmNactivateCallback, sort_view_files_big_to_small, (XtPointer)vdat);
- vf_reflect_sort_choice_in_menu(vdat);
-
- {
- int i;
- for (i = 0; i < vdat->sort_items_size; i++)
- XtAddCallback(vdat->sort_items[i], XmNactivateCallback, sort_view_files_xen, (XtPointer)vdat);
- }
- /* XtAddCallback(sort_cascade_menu, XmNcascadingCallback, vf_display_sort_items, (XtPointer)vdat); -- segfaults */
-
- map_over_children(vdat->file_list, set_main_color_of_widget);
-
- set_dialog_widget(VIEW_FILES_DIALOG, vdat->dialog);
-
- if (managed)
- XtManageChild(vdat->dialog);
-
- XtAddCallback(vdat->env_drawer, XmNresizeCallback, vf_amp_env_resize, (XtPointer)vdat);
- XtAddCallback(vdat->env_drawer, XmNexposeCallback, vf_amp_env_resize, (XtPointer)vdat);
-
- vdat->spf = new_env_editor(); /* one global amp env */
-
- XtAddEventHandler(vdat->env_drawer, ButtonPressMask, false, vf_drawer_button_press, (XtPointer)vdat);
- XtAddEventHandler(vdat->env_drawer, ButtonMotionMask, false, vf_drawer_button_motion, (XtPointer)vdat);
- XtAddEventHandler(vdat->env_drawer, ButtonReleaseMask, false, vf_drawer_button_release, (XtPointer)vdat);
-
- free(n1);
- free(n2);
- free(n3);
- free(n4);
-
- vf_mix_insert_buttons_set_sensitive(vdat, false);
- vf_open_remove_buttons_set_sensitive(vdat, false); /* need selection */
-#if (!HAVE_FAM)
- vf_clear_button_set_sensitive(vdat, vdat->end > 0);
-#endif
- }
- else
- {
- if (managed)
- {
- if (!XtIsManaged(vdat->dialog))
- XtManageChild(vdat->dialog);
- raise_dialog(vdat->dialog);
- view_files_display_list(vdat);
- }
- }
- if (managed)
- {
- vf_amp_env_resize(vdat->env_drawer, (XtPointer)vdat, NULL);
- view_files_reflect_sort_items();
-#if (!HAVE_FAM)
- vf_clear_button_set_sensitive(vdat, vdat->end >= 0);
-#endif
- }
- return(vdat->dialog);
-}
-
-
-void g_init_gxfile(void)
-{
-#if HAVE_SCHEME
- #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
-The 'type' is 1 for view-files, and 2 for regions. The 'position' \
-is the scrolled list position of the label. The label itself is 'label'. We could use the 'finfo' procedure in examp.scm \
-to popup file info as follows: \n\
-(add-hook! " S_mouse_enter_label_hook "\n\
- (lambda (type position name)\n\
- (if (not (= type 2))\n\
- (" S_info_dialog " name (finfo name)))))\n\
-See also nb.scm."
-#else
- #define H_mouse_enter_label_hook S_mouse_enter_label_hook " (type position label): called when the mouse enters a file viewer or region label. \
-The 'type' is 1 for view-files, and 2 for regions. The 'position' \
-is the scrolled list position of the label. The label itself is 'label'."
-#endif
-
- #define H_mouse_leave_label_hook S_mouse_leave_label_hook " (type position label): called when the mouse leaves a file viewer or region label"
-
- mouse_enter_label_hook = XEN_DEFINE_HOOK(S_mouse_enter_label_hook, 3, H_mouse_enter_label_hook);
- mouse_leave_label_hook = XEN_DEFINE_HOOK(S_mouse_leave_label_hook, 3, H_mouse_leave_label_hook);
-}
diff --git a/snd-xfind.c b/snd-xfind.c
deleted file mode 100644
index 43424e0..0000000
--- a/snd-xfind.c
+++ /dev/null
@@ -1,370 +0,0 @@
-#include "snd.h"
-
-
-
-/* -------- edit find -------- */
-
-static Widget edit_find_dialog, edit_find_text, cancelB, edit_find_label, findnextB;
-
-static Widget find_error_frame = NULL, find_error_label = NULL;
-
-static void clear_find_error(void);
-
-static void edit_find_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- clear_find_error();
-}
-
-
-static void clear_find_error(void)
-{
- if ((find_error_frame) && (XtIsManaged(find_error_frame)))
- XtUnmanageChild(find_error_frame);
- XtRemoveCallback(edit_find_text, XmNmodifyVerifyCallback, edit_find_modify_callback, NULL);
- /* squeezing out the error label room here moves the text widget, which is irritating since it
- * means the text we're typing gets lost
- */
-}
-
-
-static void errors_to_find_text(const char *msg, void *data)
-{
- Dimension find_height = 0;
- int lines = 0;
- XmString label;
- set_find_dialog_label("error");
- label = multi_line_label(msg, &lines);
- XtVaSetValues(find_error_label,
- XmNlabelString, label,
- XmNheight, lines * 20,
- NULL);
- XtVaSetValues(find_error_frame, XmNheight, lines * 20, NULL);
- XtVaGetValues(edit_find_dialog, XmNheight, &find_height, NULL);
- if (find_height < (lines * 20 + 140))
- {
- XtUnmanageChild(edit_find_dialog);
- XtVaSetValues(edit_find_dialog, XmNheight, 140 + 20 * lines, NULL);
- XtManageChild(edit_find_dialog);
- }
- XmStringFree(label);
- XtManageChild(find_error_frame);
- XtAddCallback(edit_find_text, XmNmodifyVerifyCallback, edit_find_modify_callback, NULL);
-}
-
-
-static void stop_search_if_error(const char *msg, void *data)
-{
- errors_to_find_text(msg, data);
- ss->stopped_explicitly = true; /* should be noticed in global_search in snd-find.c */
-}
-
-
-static void edit_find_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- find_dialog_help();
-}
-
-
-static void edit_find_ok_callback(read_direction_t direction, Widget w, XtPointer context, XtPointer info)
-{ /* "Find" is the label here */
- char *str = NULL, *buf = NULL;
- XmString s1;
- XEN proc;
- str = XmTextGetString(edit_find_text);
- if ((str) && (*str))
- {
- clear_global_search_procedure(true);
- ss->search_expr = mus_strdup(str);
- redirect_errors_to(errors_to_find_text, NULL);
- proc = snd_catch_any(eval_str_wrapper, str, str);
- redirect_errors_to(NULL, NULL);
- if ((XEN_PROCEDURE_P(proc)) && (procedure_arity_ok(proc, 1)))
- {
- ss->search_proc = proc;
- ss->search_proc_loc = snd_protect(proc);
-#if HAVE_SCHEME
- if (optimization(ss) > 0)
- ss->search_tree = mus_run_form_to_ptree_1_b(XEN_PROCEDURE_SOURCE(proc));
-#endif
- buf = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(buf, PRINT_BUFFER_SIZE, "find: %s", str);
- set_label(edit_find_label, buf);
- /* XmTextSetString(edit_find_text, NULL); */
- free(buf);
- }
- }
- else
- {
- if (ss->search_expr == NULL)
- {
- char *temp = NULL;
- /* using global search_proc set by user */
- buf = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(buf, PRINT_BUFFER_SIZE, "find: %s", temp = (char *)XEN_AS_STRING(ss->search_proc));
-#if HAVE_SCHEME
- if (temp) free(temp);
-#endif
- set_label(edit_find_label, buf);
- /* XmTextSetString(edit_find_text, NULL); */
- free(buf);
- }
- }
- if (str) XtFree(str);
- if ((XEN_PROCEDURE_P(ss->search_proc)) || (ss->search_tree))
- {
- s1 = XmStringCreateLocalized((char *)"Stop");
- XtVaSetValues(cancelB, XmNlabelString, s1, NULL);
- XmStringFree(s1);
- redirect_xen_error_to(stop_search_if_error, NULL);
- str = global_search(direction);
- redirect_xen_error_to(NULL, NULL);
- s1 = XmStringCreateLocalized((char *)"Go Away");
- XtVaSetValues(cancelB, XmNlabelString, s1, NULL);
- XmStringFree(s1);
- if ((str) && (*str)) set_label(edit_find_label, str);
- }
-}
-
-
-void set_find_dialog_label(const char *str)
-{
- if (edit_find_label)
- set_label(edit_find_label, str);
-}
-
-
-static void edit_find_next_callback(Widget w, XtPointer context, XtPointer info)
-{
- edit_find_ok_callback(READ_FORWARD, w, context, info);
-}
-
-
-static void edit_find_previous_callback(Widget w, XtPointer context, XtPointer info)
-{
- edit_find_ok_callback(READ_BACKWARD, w, context, info);
-}
-
-
-static void find_dialog_close(Widget w, XtPointer context, XtPointer info)
-{
- clear_find_error();
-}
-
-
-static void edit_find_cancel_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (XmGetFocusWidget(edit_find_dialog) == XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_OK_BUTTON))
- {
- if (ss->checking_explicitly)
- ss->stopped_explicitly = true;
- else
- {
- XtUnmanageChild(edit_find_dialog);
- clear_find_error();
- }
- }
- else edit_find_next_callback(w, context, info);
-}
-
-
-static void make_edit_find_dialog(bool managed)
-{
- if (!edit_find_dialog)
- {
- Widget dl, rc;
- Arg args[20];
- int n;
- XmString xmstr1, xmstr3, titlestr;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- xmstr1 = XmStringCreateLocalized((char *)"Go Away");
- xmstr3 = XmStringCreateLocalized((char *)"Previous");
- titlestr = XmStringCreateLocalized((char *)"Find");
- XtSetArg(args[n], XmNokLabelString, xmstr1); n++;
- XtSetArg(args[n], XmNcancelLabelString, xmstr3); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- edit_find_dialog = XmCreateMessageDialog(MAIN_SHELL(ss), (char *)"find", args, n);
-
- XmStringFree(xmstr1);
- XmStringFree(xmstr3);
- XmStringFree(titlestr);
-
- XtUnmanageChild(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_SYMBOL_LABEL));
- XtUnmanageChild(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_MESSAGE_LABEL));
-
- XtAddCallback(edit_find_dialog, XmNhelpCallback, edit_find_help_callback, NULL);
- XtAddCallback(edit_find_dialog, XmNcancelCallback, edit_find_previous_callback, NULL);
- XtAddCallback(edit_find_dialog, XmNokCallback, edit_find_cancel_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- findnextB = XtCreateManagedWidget("Next", xmPushButtonGadgetClass, edit_find_dialog, args, n);
- XtAddCallback(findnextB, XmNactivateCallback, edit_find_next_callback, NULL);
-
- rc = XtCreateManagedWidget("row", xmFormWidgetClass, edit_find_dialog, NULL, 0);
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- dl = XtCreateManagedWidget("find:", xmLabelWidgetClass, rc, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, dl); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- edit_find_text = make_textfield_widget("text", rc, args, n, ACTIVATABLE, add_completer_func(expression_completer, NULL));
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, edit_find_text); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNmarginHeight, 10); n++;
- edit_find_label = XtCreateManagedWidget(" ", xmLabelWidgetClass, rc, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, edit_find_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 2); n++;
- find_error_frame = XtCreateManagedWidget("find-error-frame", xmFrameWidgetClass, rc, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- find_error_label = XtCreateManagedWidget("", xmLabelWidgetClass, find_error_frame, args, n);
-
- map_over_children(edit_find_dialog, set_main_color_of_widget);
- XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- cancelB = XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_OK_BUTTON);
- set_dialog_widget(FIND_DIALOG, edit_find_dialog);
-
- XtUnmanageChild(find_error_frame);
-
- if (managed) XtManageChild(edit_find_dialog);
-
- {
- Atom wm_delete_window;
- wm_delete_window = XmInternAtom(MAIN_DISPLAY(ss), (char *)"WM_DELETE_WINDOW", false);
- XmAddWMProtocolCallback(XtParent(edit_find_dialog), wm_delete_window, find_dialog_close, NULL);
- }
- }
- else
- {
- if (managed)
- {
- if (!XtIsManaged(edit_find_dialog)) XtManageChild(edit_find_dialog);
- raise_dialog(edit_find_dialog);
- }
- }
-}
-
-
-void edit_find_callback(Widget w, XtPointer context, XtPointer info)
-{
- make_edit_find_dialog(true);
-}
-
-
-void save_find_dialog_state(FILE *fd)
-{
- if ((edit_find_dialog) && (XtIsManaged(edit_find_dialog)))
- {
- char *text = NULL;
- text = XmTextGetString(edit_find_text);
- if ((text) && (*text))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t \"%s\")\n", S_find_dialog, text);
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true, \"%s\")\n", TO_PROC_NAME(S_find_dialog), text);
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t \"%s\" %s drop\n", text, S_find_dialog);
-#endif
- XtFree(text);
- }
- else
- {
-#if HAVE_SCHEME
- if (ss->search_expr)
- fprintf(fd, "(%s #t \"%s\")\n", S_find_dialog, ss->search_expr);
- else fprintf(fd, "(%s #t)\n", S_find_dialog);
-#endif
-#if HAVE_RUBY
- if (ss->search_expr)
- fprintf(fd, "%s(true, \"%s\")\n", TO_PROC_NAME(S_find_dialog), ss->search_expr);
- else fprintf(fd, "%s(true)\n", TO_PROC_NAME(S_find_dialog));
-#endif
-#if HAVE_FORTH
- if (ss->search_expr)
- fprintf(fd, "#t \"%s\" %s drop\n", ss->search_expr, S_find_dialog);
- else fprintf(fd, "#t %s drop\n", S_find_dialog);
-#endif
- }
- }
-}
-
-
-static XEN g_find_dialog(XEN managed, XEN text)
-{
- #define H_find_dialog "(" S_find_dialog " :optional managed text): create and activate the Edit:Find dialog, return the dialog widget. \
-If 'text' is included, it is preloaded into the find dialog text widget."
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(managed), managed, XEN_ARG_1, S_find_dialog, "a boolean");
- XEN_ASSERT_TYPE(XEN_STRING_IF_BOUND_P(text), text, XEN_ARG_2, S_find_dialog, "a string");
- make_edit_find_dialog(XEN_TO_C_BOOLEAN(managed));
- if ((edit_find_text) && (XEN_STRING_P(text)))
- XmTextSetString(edit_find_text, (char *)XEN_TO_C_STRING(text));
- return(XEN_WRAP_WIDGET(edit_find_dialog));
-}
-
-
-static XEN g_find_dialog_widgets(void)
-{
- if (edit_find_dialog)
- return(XEN_CONS(XEN_WRAP_WIDGET(edit_find_dialog),
- XEN_CONS(XEN_WRAP_WIDGET(edit_find_text),
- XEN_CONS(XEN_WRAP_WIDGET(findnextB),
- XEN_CONS(XEN_WRAP_WIDGET(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_CANCEL_BUTTON)), /* find previous */
- XEN_CONS(XEN_WRAP_WIDGET(XmMessageBoxGetChild(edit_find_dialog, XmDIALOG_OK_BUTTON)), /* cancel */
- XEN_EMPTY_LIST))))));
- return(XEN_EMPTY_LIST);
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_2(g_find_dialog_w, g_find_dialog)
-XEN_NARGIFY_0(g_find_dialog_widgets_w, g_find_dialog_widgets)
-#else
-#define g_find_dialog_w g_find_dialog
-#define g_find_dialog_widgets_w g_find_dialog_widgets
-#endif
-
-void g_init_gxfind(void)
-{
- XEN_DEFINE_PROCEDURE(S_find_dialog, g_find_dialog_w, 0, 2, 0, H_find_dialog);
- XEN_DEFINE_PROCEDURE("find-dialog-widgets", g_find_dialog_widgets_w, 0, 0, 0, "internal auto-test function");
-}
-
diff --git a/snd-xhelp.c b/snd-xhelp.c
deleted file mode 100644
index 8544b27..0000000
--- a/snd-xhelp.c
+++ /dev/null
@@ -1,630 +0,0 @@
-#include "snd.h"
-
-#define HELP_ROWS 10
-#define HELP_XREFS 8
-#define HELP_COLUMNS 72
-/* these set the initial size of the help dialog text area */
-
-static Widget help_dialog = NULL;
-static Widget help_text = NULL;
-static char *original_help_text = NULL;
-static with_word_wrap_t outer_with_wrap = WITHOUT_WORD_WRAP;
-static const char **help_urls = NULL; /* shouldn't this be static char* const char*? */
-
-static int old_help_text_width = 0;
-
-static void help_expose(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- int curwid;
- curwid = widget_width(help_text);
- if (old_help_text_width == 0)
- old_help_text_width = curwid;
- else
- {
- if ((outer_with_wrap == WITH_WORD_WRAP) &&
- (abs(curwid - old_help_text_width) > 10))
- {
- char *cur_help_str, *new_help_str = NULL;
- cur_help_str = XmTextGetString(help_text);
- new_help_str = word_wrap(original_help_text, curwid);
- XmTextSetString(help_text, new_help_str);
- if (new_help_str) free(new_help_str);
- if (cur_help_str) XtFree(cur_help_str);
- old_help_text_width = curwid;
- }
- }
-}
-
-
-static XmString parse_crossref(const char *xref)
-{
- XmString xs = NULL, tmp;
- int i, len, start = 0, j, k;
- char *str;
- /* crossref has text for scrolled list entry, but url is in '{}'. It is displayed via the texts rendition */
- len = strlen(xref);
- for (i = 0; i < len; i++)
- {
- if (xref[i] == '{')
- {
- if (i > 0)
- {
- str = (char *)calloc(i - start + 1, sizeof(char));
- for (k = 0, j = start; j < i; k++, j++) str[k] = xref[j];
- tmp = XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"normal_text");
- free(str);
- if (xs)
- xs = XmStringConcatAndFree(xs, tmp);
- else xs = tmp;
- }
- start = i + 1;
- }
- else
- {
- if (xref[i] == '}')
- {
- str = (char *)calloc(i - start + 1, sizeof(char));
- for (k = 0, j = start; j < i; k++, j++) str[k] = xref[j];
- if (xs)
- xs = XmStringConcatAndFree(xs, XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"url_text"));
- else xs = XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"url_text");
- free(str);
- start = i + 1;
- }
- }
- }
- if (start < len)
- {
- str = (char *)calloc(len - start + 1, sizeof(char));
- for (k = 0, j = start; j < len; k++, j++) str[k] = xref[j];
- if (xs)
- xs = XmStringConcatAndFree(xs, XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"normal_text"));
- else xs = XmStringGenerate(str, NULL, XmCHARSET_TEXT, (char *)"normal_text");
- free(str);
- }
- return(xs);
-}
-
-
-static char *find_highlighted_text(XmString xs)
-{
- /* search xs for text in "url_text" rendition, returning first such portion */
- XtPointer text;
- bool in_red_text = false;
- unsigned int len;
- char *result;
- XmStringComponentType type;
- XmStringContext ctx;
-
- XmStringInitContext(&ctx, xs);
-
- while ((type = XmStringGetNextTriple(ctx, &len, &text)) != XmSTRING_COMPONENT_END)
- {
- switch (type)
- {
- case XmSTRING_COMPONENT_RENDITION_BEGIN:
- in_red_text = mus_strcmp((char *)text, "url_text");
- break;
-
- case XmSTRING_COMPONENT_RENDITION_END:
- in_red_text = false;
- break;
-
- case XmSTRING_COMPONENT_TEXT:
- if (in_red_text)
- {
- result = mus_strdup((char *)text);
- XtFree((char *)text);
- XmStringFreeContext(ctx);
- return(result);
- }
- }
-
- /* this from the Motif docs, though it looks odd to me */
- if (text) XtFree((char *)text);
- text = NULL;
- }
-
- XmStringFreeContext(ctx);
- return(NULL);
-}
-
-
-static Widget related_items = NULL;
-
-static char *help_completer(widget_t w, const char *text, void *data)
-{
- return(expression_completer(w, text, data));
- /* might want to look at help topics too */
-}
-
-
-static bool new_help(const char *pattern, bool complain)
-{
- const char *url = NULL;
- const char **xrefs;
-
- url = snd_url(pattern);
- if (url)
- {
- /* given name, find doc string, if any */
- XEN xstr;
- xstr = g_snd_help(C_TO_XEN_STRING(pattern), 0);
- if (XEN_STRING_P(xstr))
- {
- int gc_loc;
- gc_loc = snd_protect(xstr);
- xrefs = help_name_to_xrefs(pattern);
- snd_help_with_xrefs(pattern, XEN_TO_C_STRING(xstr), WITH_WORD_WRAP, xrefs, NULL);
- snd_unprotect_at(gc_loc);
- if (xrefs) free(xrefs);
- return(true);
- }
- url_to_html_viewer(url);
- return(true);
- }
-
- if ((!(snd_topic_help(pattern))) && (complain))
- {
- xrefs = help_name_to_xrefs(pattern);
- if (xrefs)
- {
- snd_help_with_xrefs(pattern, "(no help found)", WITH_WORD_WRAP, xrefs, NULL);
- free(xrefs);
- return(true);
- }
- else snd_help_with_xrefs(pattern, "(no help found)", WITH_WORD_WRAP, NULL, NULL);
- }
-
- return(false);
-}
-
-
-static char **help_history = NULL;
-static int help_history_size = 0;
-static int help_history_pos = 0;
-static bool help_needed = true;
-
-static void add_pattern_to_help_history(const char *pattern)
-{
- if (!help_needed) return;
- if (help_history_size == 0)
- {
- help_history_size = 16;
- help_history = (char **)calloc(help_history_size, sizeof(char *));
- }
- else
- {
- if (help_history_pos >= help_history_size)
- {
- int i;
- for (i = 0; i < 8; i++)
- {
- if (help_history[i]) free(help_history[i]);
- help_history[i] = help_history[i + 8];
- help_history[i + 8] = NULL;
- }
- help_history_pos = 8;
- }
- }
- if (help_history[help_history_pos]) free(help_history[help_history_pos]);
- help_history[help_history_pos++] = mus_strdup(pattern);
-}
-
-
-static void help_next_callback(Widget w, XtPointer context, XtPointer info)
-{
- if ((help_history_pos < help_history_size) &&
- (help_history[help_history_pos]))
- {
- help_needed = false;
- help_history_pos++;
- new_help(help_history[help_history_pos - 1], true);
- help_needed = true;
- }
-}
-
-
-static void help_previous_callback(Widget w, XtPointer context, XtPointer info)
-{
- if ((help_history_pos > 1) &&
- (help_history[help_history_pos - 2]))
- {
- help_needed = false;
- help_history_pos--;
- new_help(help_history[help_history_pos - 1], true);
- help_needed = true;
- }
-}
-
-
-static void help_browse_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* single-click to select item in "related items" list */
- char *red_text = NULL;
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- if ((help_urls) && (help_urls[cbs->item_position - 1]))
- url_to_html_viewer(help_urls[cbs->item_position - 1]);
- else
- {
- red_text = find_highlighted_text(cbs->item);
- if (red_text)
- {
- name_to_html_viewer(red_text);
- free(red_text);
- }
- else
- {
- red_text = (char *)XmStringUnparse(cbs->item, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- if (red_text)
- {
- new_help(red_text, true);
- XtFree(red_text);
- }
- }
- }
-}
-
-
-static void help_double_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* double-click item in "related items" list */
- char *red_text = NULL;
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- if ((help_urls) && (help_urls[cbs->item_position - 1]))
- url_to_html_viewer(help_urls[cbs->item_position - 1]);
- else
- {
- red_text = find_highlighted_text(cbs->selected_items[0]);
- if (red_text)
- {
- name_to_html_viewer(red_text);
- free(red_text);
- }
- else
- {
- red_text = (char *)XmStringUnparse(cbs->selected_items[0], NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- if (red_text)
- {
- name_to_html_viewer(red_text);
- XtFree(red_text);
- }
- }
- }
-}
-
-
-static Widget help_search = NULL;
-
-static void ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- Widget active_widget;
- active_widget = XmGetFocusWidget(help_dialog);
- if ((!active_widget) || (active_widget != help_search))
- XtUnmanageChild(help_dialog);
-}
-
-
-static void text_release_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- char *help_str;
- help_str = XmTextGetSelection(w);
- if (help_str)
- {
- int i, len;
- bool one_word = true;
- len = mus_strlen(help_str);
- for (i = 0; i < len; i++)
- if (isspace(help_str[i]))
- {
- one_word = false;
- break;
- }
- if (one_word) new_help(help_str, false);
- XtFree(help_str);
- }
-}
-
-
-static void help_search_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *pattern = NULL;
- pattern = XmTextFieldGetString(w);
- if (new_help(pattern, true))
- XmTextFieldSetString(w, (char *)"");
- if (pattern) XtFree(pattern);
-}
-
-
-static Widget help_next_button = NULL, help_previous_button = NULL;
-static XmRendition texts[2];
-
-static void create_help_monolog(void)
-{
- /* create scrollable but not editable text window */
- Arg args[20];
- int n;
- XmString titlestr, forward, dismiss;
- Widget holder, xref_label; /* documentation says this isn't needed, but it is */
- Widget frame, label, inner_holder, sep, parent;
- XmRenderTable rs = NULL;
- titlestr = XmStringCreateLocalized((char *)"Help");
- forward = XmStringCreateLocalized((char *)"Forward");
- dismiss = XmStringCreateLocalized((char *)"Go Away");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- /* this window should be resizable by the user (i.e. have the resize bars), but not resize itself */
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- XtSetArg(args[n], XmNokLabelString, dismiss); n++;
- XtSetArg(args[n], XmNcancelLabelString, forward); n++;
-
- help_dialog = XmCreateMessageDialog(MAIN_PANE(ss), (char *)"snd-help", args, n);
- XtAddEventHandler(help_dialog, ExposureMask, false, help_expose, NULL);
- XtAddCallback(help_dialog, XmNokCallback, ok_callback, NULL);
- XtAddCallback(help_dialog, XmNcancelCallback, help_next_callback, NULL);
- help_next_button = XmMessageBoxGetChild(help_dialog, XmDIALOG_CANCEL_BUTTON);
-
- XtUnmanageChild(XmMessageBoxGetChild(help_dialog, XmDIALOG_HELP_BUTTON));
- XtUnmanageChild(XmMessageBoxGetChild(help_dialog, XmDIALOG_SYMBOL_LABEL));
-
- XtVaSetValues(XmMessageBoxGetChild(help_dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->highlight_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- help_previous_button = XtCreateManagedWidget("Back", xmPushButtonGadgetClass, help_dialog, args, n);
- XtAddCallback(help_previous_button, XmNactivateCallback, help_previous_callback, NULL);
- XtSetSensitive(help_next_button, false);
- XtSetSensitive(help_previous_button, false);
-
- XmStringFree(titlestr);
- XmStringFree(forward);
- holder = XtCreateManagedWidget("holder", xmFormWidgetClass, help_dialog, NULL, 0);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNeditMode, XmMULTI_LINE_EDIT); n++;
- XtSetArg(args[n], XmNeditable, false); n++;
- XtSetArg(args[n], XmNcolumns, HELP_COLUMNS); n++;
- XtSetArg(args[n], XmNrows, HELP_ROWS); n++;
- XtSetArg(args[n], XmNforeground, ss->black); n++; /* needed if color allocation fails completely */
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- help_text = XmCreateScrolledText(holder, (char *)"help-text", args, n);
- XtAddEventHandler(help_text, ButtonReleaseMask, false, text_release_callback, NULL);
- XtManageChild(help_text);
-
- /* to display the url-related portion of the text in red, we need a rendition for it in the rendertable */
- /* try to find the current default render table. */
- parent = help_text;
- while ((parent != NULL) && (rs == NULL))
- {
- XtVaGetValues(parent, XmNrenderTable, &rs, NULL);
- parent = XtParent(parent);
- }
- n = 0;
- if (rs == NULL)
- {
- /* failed to find a rendertable to specialize, so we need an explicit font */
- XtSetArg(args[n], XmNfontName, listener_font(ss)); n++;
- XtSetArg(args[n], XmNfontType, XmFONT_IS_FONT); n++;
- XtSetArg(args[n], XmNloadModel, XmLOAD_IMMEDIATE); n++;
- }
- XtSetArg(args[n], XmNrenditionBackground, ss->white); n++;
- XtSetArg(args[n], XmNrenditionForeground, ss->red); n++;
- texts[0] = XmRenditionCreate(help_text, (char *)"url_text", args, n);
- XtSetArg(args[n - 1], XmNrenditionForeground, ss->black);
- texts[1] = XmRenditionCreate(help_text, (char *)"normal_text", args, n);
- rs = XmRenderTableCopy(XmRenderTableAddRenditions(rs, texts, 2, XmMERGE_NEW), NULL, 0);
- /*
- * valgrind says this data is used later
- * XmRenditionFree(texts[0]);
- * XmRenditionFree(texts[1]);
- */
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, XtParent(help_text)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNheight, 6); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, holder, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNheight, 24); n++;
- /* XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++; */
- label = XtCreateManagedWidget("help topic:", xmLabelWidgetClass, holder, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- help_search = make_textfield_widget("help-search", holder, args, n, ACTIVATABLE, add_completer_func(help_completer, NULL));
- XtAddCallback(help_search, XmNactivateCallback, help_search_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, help_search); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNshadowThickness, 4); n++;
- frame = XtCreateManagedWidget("frame", xmFrameWidgetClass, holder, args, n);
-
- inner_holder = XtCreateManagedWidget("inner-holder", xmFormWidgetClass, frame, NULL, 0);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- xref_label = XtCreateManagedWidget("related topics:", xmLabelWidgetClass, inner_holder, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, xref_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
-
- /* in operton-based solaris 10 this (next) line causes an X server error (with no stack...):
- * complaint is X_ChangeGC got an invalid font.
- * Do I need a configure test program for this? Is there some other way to force the render table to take effect?
- */
-#if (!HAVE_SUN) || (!MUS_LITTLE_ENDIAN)
- XtSetArg(args[n], XmNfontList, 0); n++; /* needed or new rendertable doesn't take effect! */
- /* also, 0, not NULL so types match */
- XtSetArg(args[n], XmNrenderTable, rs); n++;
-#endif
-
- XtSetArg(args[n], XmNvisibleItemCount, HELP_XREFS); n++; /* appears to be a no-op */
- XtSetArg(args[n], XmNheight, 150); n++;
-
- XtSetArg(args[n], XmNscrollBarDisplayPolicy, XmAS_NEEDED); n++;
- related_items = XmCreateScrolledList(inner_holder, (char *)"help-list", args, n);
- XtManageChild(related_items);
- XtAddCallback(related_items, XmNbrowseSelectionCallback, help_browse_callback, NULL);
- XtAddCallback(related_items, XmNdefaultActionCallback, help_double_click_callback, NULL);
-
- XtManageChild(help_dialog);
-
- map_over_children(help_dialog, set_main_color_of_widget);
- XtVaSetValues(help_text, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- XtVaSetValues(related_items, XmNbackground, ss->highlight_color, XmNforeground, ss->black, NULL);
- XtVaSetValues(xref_label, XmNbackground, ss->highlight_color, XmNforeground, ss->black, NULL);
- XtVaSetValues(XmMessageBoxGetChild(help_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(help_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(help_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(help_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- set_dialog_widget(HELP_DIALOG, help_dialog);
-}
-
-
-int help_text_width(const char *txt, int start, int end)
-{
-#if 0
- /* this is full of problems... -- adding renditions below makes everything else flakey */
- if ((help_text) && (end > start))
- {
- char *msg;
- int i, j;
- XmString s1;
- Dimension text_wid = 0;
- XmFontList fonts;
- XtVaGetValues(help_text, XmNfontList, &fonts, NULL);
- msg = (char *)calloc(end - start + 1, sizeof(char));
- for (i = start, j = 0; i < end; i++, j++) msg[j] = txt[i];
- s1 = XmStringCreateLocalized(msg);
- text_wid = XmStringWidth(fonts, s1);
- XmStringFree(s1);
- free(msg);
- return((int)text_wid);
- }
-#endif
- return((end - start) * 8);
-}
-
-
-Widget snd_help(const char *subject, const char *helpstr, with_word_wrap_t with_wrap)
-{
- /* place help string in scrollable help window */
- /* if window is already active, add this help at the top and reposition */
- XmString xstr1;
-
- outer_with_wrap = with_wrap;
- if (!(help_dialog))
- create_help_monolog();
- else raise_dialog(help_dialog);
-
- xstr1 = XmStringCreateLocalized((char *)subject);
- XtVaSetValues(help_dialog, XmNmessageString, xstr1, NULL);
- original_help_text = (char *)helpstr;
-
- if (with_wrap == WITH_WORD_WRAP)
- {
- char *new_help_str = NULL;
- new_help_str = word_wrap(helpstr, widget_width(help_text));
- XmTextSetString(help_text, new_help_str);
- if (new_help_str) free(new_help_str);
- }
- else XmTextSetString(help_text, (char *)helpstr);
-
- if (!XtIsManaged(help_dialog))
- XtManageChild(help_dialog);
-
- XmStringFree(xstr1);
- XtVaSetValues(related_items, XmNitems, NULL, XmNitemCount, 0, NULL);
- if (help_needed) add_pattern_to_help_history(subject);
- XtSetSensitive(help_next_button, (help_history_pos < help_history_size) && (help_history[help_history_pos]));
- XtSetSensitive(help_previous_button, (help_history_pos > 1));
- return(help_dialog);
-}
-
-
-Widget snd_help_with_xrefs(const char *subject, const char *helpstr, with_word_wrap_t with_wrap, const char **xrefs, const char **urls)
-{
- Widget w;
- w = snd_help(subject, helpstr, with_wrap);
- help_urls = urls; /* can't associate the url with the help item in any "natural" way in Motif (no user-data per item) */
- if (xrefs)
- {
- int i, len;
-
- for (i = 0; ; i++)
- if (!xrefs[i])
- {
- len = i;
- break;
- }
-
- if (len > 0)
- {
- XmString *strs;
- strs = (XmString *)calloc(len, sizeof(XmString));
-
- for (i = 0; i < len; i++)
- strs[i] = parse_crossref((const char *)(xrefs[i]));
- XtVaSetValues(related_items, XmNitems, strs, XmNitemCount, len, NULL);
-
- for (i = 0; i < len; i++)
- XmStringFree(strs[i]);
- free(strs);
- }
- }
- return(w);
-}
-
-
-void snd_help_append(const char *text)
-{
- if (help_text)
- XmTextInsert(help_text,
- XmTextGetLastPosition(help_text),
- (char *)text);
-}
-
-
-void snd_help_back_to_top(void)
-{
- if (help_text) XmTextShowPosition(help_text, 0);
-}
diff --git a/snd-xlistener.c b/snd-xlistener.c
deleted file mode 100644
index 72ab053..0000000
--- a/snd-xlistener.c
+++ /dev/null
@@ -1,1600 +0,0 @@
-#include "snd.h"
-
-
-#define OVERRIDE_TOGGLE 1
-/* Motif 2.0 defines control-button1 to be "take focus" -- this is not a good idea!! */
-
-
-static void Tab_completion(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- int completer;
- pointer_or_int_t data;
-
- XtVaGetValues(w, XmNuserData, &data, NULL);
- completer = (int)data;
-
- if (completer >= 0)
- {
- int matches;
- char *old_text, *new_text;
-
- old_text = XmTextGetString(w);
- if (mus_strlen(old_text) == 0) return; /* C-x C-f TAB in minibuffer, for example */
-
- new_text = complete_text(w, old_text, completer);
- if (mus_strlen(new_text) == 0) return; /* can this happen? */
- XmTextSetString(w, new_text);
- XmTextSetCursorPosition(w, XmTextGetLastPosition(w));
-
- matches = get_completion_matches();
-
- if ((mus_strcmp(old_text, new_text)) &&
- (matches != -1))
- {
- Pixel old_color;
- XtVaGetValues(w, XmNforeground, &old_color, NULL);
- if (matches > 1)
- XtVaSetValues(w, XmNforeground, ss->green, NULL);
- else
- if (matches == 0)
- XtVaSetValues(w, XmNforeground, ss->red, NULL);
- if (matches != 1)
- {
- XmUpdateDisplay(w);
-#if HAVE_SLEEP
- sleep(1);
-#endif
- XtVaSetValues(w, XmNforeground, old_color, NULL);
- XmUpdateDisplay(w);
- }
-
- if (matches > 1) /* there are several possible completions -- let the widget decide how to handle it */
- handle_completions(w, completer);
- }
-
- if (old_text) XtFree(old_text);
- if (new_text) free(new_text);
- }
-}
-
-
-/* listener completions */
-
-static Widget listener_text = NULL;
-static Widget listener_pane = NULL; /* form widget that hold the listener scrolled text widget */
-
-static Widget completions_list = NULL;
-static Widget completions_pane = NULL;
-
-
-static void perform_completion(XmString selection)
-{
- int i, j, old_len, new_len;
- char *text = NULL, *old_text = NULL;
-
- text = (char *)XmStringUnparse(selection, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- save_completion_choice(text);
-
- old_text = XmTextGetString(listener_text);
- old_len = mus_strlen(old_text);
- new_len = mus_strlen(text);
- for (i = old_len - 1, j = new_len - 1; j >= 0; j--)
- {
- if (old_text[i] != text[j])
- {
- i = old_len - 1;
- if (old_text[i] == text[j]) i--;
- /* this added 15-Apr-02 for case like map-chan(nel) */
- /* probably should go back new_len and scan forwards instead */
- }
- else i--;
- }
-
- append_listener_text(XmTextGetLastPosition(listener_text), (char *)(text - 1 + old_len - i));
-
- if (text) XtFree(text);
- if (old_text) XtFree(old_text);
-}
-
-
-static void listener_completions_browse_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmListCallbackStruct *cbs = (XmListCallbackStruct *)info;
- /* choice = cbs->item_position - 1; */
- perform_completion(cbs->item);
- XtUnmanageChild(completions_pane);
-}
-
-
-static int alphabetize(const void *a, const void *b)
-{
- return(strcmp(*((const char **)a), (*(const char **)b)));
-}
-
-
-static int find_prompt(Widget w, XmTextPosition start)
-{
- Boolean found_prompt;
- XmTextPosition loc = 0;
-
- found_prompt = XmTextFindString(w, start, listener_prompt(ss), XmTEXT_BACKWARD, &loc);
- if (!found_prompt)
- return(0);
- else return((int)loc + mus_strlen(listener_prompt(ss)));
-}
-
-
-static void Listener_completion(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- /* used only by the listener widget -- needs to be smart about text since overall string can be enormous
- * and we don't want to back up past the last prompt
- * also if at start of line (or all white-space to previous \n), indent
- */
- int beg, end, replace_end, len, matches = 0;
- char *old_text;
-
- if ((completions_pane) &&
- (XtIsManaged(completions_pane)))
- {
- XmString *strs;
- XtVaGetValues(completions_list,
- XmNselectedItems, &strs,
- NULL);
- perform_completion(strs[0]);
- XtUnmanageChild(completions_pane);
- return;
- }
-
- beg = 0;
- end = XmTextGetInsertionPosition(w);
- replace_end = end;
-
- beg = find_prompt(w, (XmTextPosition)end);
- len = end - beg + 1;
-
- old_text = (char *)calloc(len + 1, sizeof(char));
- XmTextGetSubstring(w, beg, len, len + 1, old_text);
- /* now old_text is the stuff typed since the last prompt */
-
- if (old_text[len - 1] == '\n')
- {
- old_text[len - 1] = 0;
- end--;
- }
-
- if (old_text)
- {
- char *new_text = NULL, *file_text = NULL;
- bool try_completion = true;
- new_text = complete_listener_text(old_text, end, &try_completion, &file_text);
-
- if (!try_completion)
- {
- free(old_text);
- return;
- }
-
- if (mus_strcmp(old_text, new_text))
- matches = get_completion_matches();
- else XmTextReplace(w, beg, replace_end, new_text);
-
- if (new_text)
- {
- free(new_text);
- new_text = NULL;
- }
-
- if (matches > 1)
- {
- int num;
- char **buffer;
- clear_possible_completions();
- set_save_completions(true);
- if (file_text)
- new_text = filename_completer(w, file_text, NULL);
- else new_text = expression_completer(w, old_text, NULL);
- if (new_text)
- {
- free(new_text);
- new_text = NULL;
- }
- num = get_possible_completions_size();
- if (num > 0)
- {
- int i;
- XmString *match;
-
- if (!completions_list)
- {
- Arg args[20];
- int n = 0;
-
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNscrollBarPlacement, XmBOTTOM_LEFT); n++;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNforeground, ss->black); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
-
- completions_list = XmCreateScrolledList(listener_pane, (char *)"completion-help-text", args, n);
- completions_pane = XtParent(completions_list);
-
- XtAddCallback(completions_list, XmNbrowseSelectionCallback, listener_completions_browse_callback, NULL);
- XtManageChild(completions_list);
- }
-
- buffer = get_possible_completions();
- qsort((void *)buffer, num, sizeof(char *), alphabetize);
-
- match = (XmString *)calloc(num, sizeof(XmString));
- for (i = 0; i < num; i++)
- match[i] = XmStringCreateLocalized(buffer[i]);
-
- XtVaSetValues(completions_list,
- XmNitems, match,
- XmNitemCount, num,
- XmNvisibleItemCount, mus_iclamp(1, num, 20),
- NULL);
-
- if (!(XtIsManaged(completions_pane)))
- XtManageChild(completions_pane);
-
- /* look at previous completions list first for a match, then
- * look back from "beg" for any member of the match list previously typed
- */
- {
- int row;
- row = find_best_completion(buffer, num);
- XmListSelectPos(completions_list, row, false);
- ensure_list_row_visible(completions_list, row);
- }
-
- for (i = 0; i < num; i++)
- XmStringFree(match[i]);
- free(match);
- }
- set_save_completions(false);
- }
-
- if (file_text) free(file_text);
- if (old_text) free(old_text);
- }
-}
-
-
-
-
-/* ---------------- text widget specializations ---------------- */
-
-void textfield_focus_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtVaSetValues(w, XmNbackground, ss->text_focus_color, NULL);
- XtVaSetValues(w, XmNcursorPositionVisible, true, NULL);
-}
-
-
-void textfield_unfocus_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtVaSetValues(w, XmNbackground, ss->basic_color, NULL);
- XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
-}
-
-
-static void textfield_no_color_focus_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtVaSetValues(w, XmNcursorPositionVisible, true, NULL);
-}
-
-
-static void textfield_no_color_unfocus_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtVaSetValues(w, XmNcursorPositionVisible, false, NULL);
-}
-
-
-/* -------- specialized action procs -------- */
-
-static bool actions_loaded = false;
-#define CONTROL_KEY 4
-
-static void No_op(Widget w, XEvent *ev, char **str, Cardinal *num)
-{
- /* return does not cause widget activation in many textfield cases -- it is a true no-op */
-}
-
-
-#define snd_K_u XK_u
-#define snd_K_x XK_x
-
-static void Activate_keyboard(Widget w, XEvent *ev, char **str, Cardinal *num)
-{
- /* make the current channel active preloading kbd cmd with str[0]+ctrl bit */
- chan_info *cp;
- cp = current_channel();
- if (cp)
- {
- goto_graph(cp);
- keyboard_command(cp, (str[0][0] == 'u') ? snd_K_u : snd_K_x, CONTROL_KEY);
- }
-}
-
-
-static char *listener_selection = NULL;
-
-static void Kill_line(Widget w, XEvent *ev, char **str, Cardinal *num)
-{
- /* C-k with storage of killed text */
- XmTextPosition curpos, loc;
- Boolean found;
- curpos = XmTextGetCursorPosition(w);
- found = XmTextFindString(w, curpos, (char *)"\n", XmTEXT_FORWARD, &loc);
- if (!found) loc = XmTextGetLastPosition(w);
- if (loc > curpos)
- {
- if (listener_selection) {XtFree(listener_selection); listener_selection = NULL;}
- XmTextSetSelection(w, curpos, loc, CurrentTime);
- listener_selection = XmTextGetSelection(w); /* xm manual p329 sez storage is allocated here */
- XmTextCut(w, CurrentTime);
- }
-}
-
-
-static void Yank(Widget w, XEvent *ev, char **str, Cardinal *num)
-{
- /* copy current selection at current cursor position */
- if (listener_selection)
- {
- XmTextPosition curpos;
- curpos = XmTextGetCursorPosition(w);
- XmTextInsert(w, curpos, listener_selection);
- curpos += strlen(listener_selection);
- XmTextShowPosition(w, curpos);
- XmTextSetCursorPosition(w, curpos);
- XmTextClearSelection(w, ev->xkey.time); /* so C-y + edit doesn't forbid the edit */
- }
-}
-
-
-static void Begin_of_line(Widget w, XEvent *ev, char **ustr, Cardinal *num)
-{
- /* don't back up before listener prompt */
- XmTextPosition curpos, loc;
- Boolean found;
- curpos = XmTextGetCursorPosition(w) - 1;
- found = XmTextFindString(w, curpos, (char *)"\n", XmTEXT_BACKWARD, &loc);
- if (found)
- {
- char *str = NULL;
- str = (char *)calloc(ss->listener_prompt_length + 3, sizeof(char));
- XmTextGetSubstring(w, loc + 1, ss->listener_prompt_length, ss->listener_prompt_length + 2, str);
- if (strncmp(listener_prompt(ss), str, ss->listener_prompt_length) == 0)
- XmTextSetCursorPosition(w, loc + ss->listener_prompt_length + 1);
- else XmTextSetCursorPosition(w, loc + 1);
- free(str);
- }
- else XmTextSetCursorPosition(w, 1);
-}
-
-
-static void Delete_region(Widget w, XEvent *ev, char **str, Cardinal *num)
-{
- XmTextCut(w, CurrentTime);
-}
-
-
-static XmTextPosition down_pos, last_pos;
-static XEN listener_click_hook;
-
-static void B1_press(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- XmTextPosition pos;
- XButtonEvent *ev = (XButtonEvent *)event;
- XmProcessTraversal(w, XmTRAVERSE_CURRENT);
- /* we're replacing the built-in take_focus action here, so do it by hand, but leave listener blue, so to speak */
- if (w != listener_text)
- XtVaSetValues(w, XmNbackground, ss->white, NULL);
- else XmTextClearSelection(listener_text, CurrentTime); /* should this happen in other windows as well? */
- pos = XmTextXYToPos(w, (Position)(ev->x), (Position)(ev->y));
- XmTextSetCursorPosition(w, pos);
- down_pos = pos;
- last_pos = pos;
- if (XEN_HOOKED(listener_click_hook))
- run_hook(listener_click_hook,
- XEN_LIST_1(C_TO_XEN_INT((int)pos)),
- S_listener_click_hook);
-}
-
-
-static void B1_move(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- XmTextPosition pos;
- XButtonEvent *ev = (XButtonEvent *)event;
- pos = XmTextXYToPos(w, (Position)(ev->x), (Position)(ev->y));
- if (last_pos > pos) /* must have backed up the cursor */
- XmTextSetHighlight(w, pos, last_pos, XmHIGHLIGHT_NORMAL);
- if (down_pos != pos)
- XmTextSetHighlight(w, down_pos, pos, XmHIGHLIGHT_SELECTED);
- last_pos = pos;
-}
-
-
-static void B1_release(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- XmTextPosition pos;
- XButtonEvent *ev = (XButtonEvent *)event;
- pos = XmTextXYToPos(w, (Position)(ev->x), (Position)(ev->y));
- XmTextSetCursorPosition(w, pos);
- if (down_pos != pos)
- {
- XmTextSetHighlight(w, down_pos, pos, XmHIGHLIGHT_SELECTED);
- if (listener_selection) {XtFree(listener_selection); listener_selection = NULL;}
- XmTextSetSelection(w, down_pos, pos, CurrentTime);
- listener_selection = XmTextGetSelection(w);
- }
-}
-
-
-static void Text_transpose(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- XmTextPosition curpos;
- curpos = XmTextGetCursorPosition(w);
- if (curpos > 1)
- {
- char buf[3]; /* needs room for null */
- char tmp;
- XmTextGetSubstring(w, (XmTextPosition)(curpos - 1), 2, 3, buf);
- tmp = buf[0];
- buf[0] = buf[1];
- buf[1] = tmp;
- XmTextReplace(w, curpos - 1, curpos + 1, buf);
- XmTextSetCursorPosition(w, curpos + 1);
- }
-}
-
-
-static void Complain(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- /* if the minibuffer has focus (via pointer movement) and user types C-j (for example),
- * the textfield widget doesn't have any action associated with that, so it prints
- * C-j and leaves the cursor where it was; without this action, Motif posts a small
- * empty box where the character should be, which can be confusing; another option
- * would be to activate the keyboard instead (as in C-x), but I think that would only
- * add to the confusion.
- */
- char *old_text, *new_text;
- XmTextPosition curpos;
- int len;
-
- curpos = XmTextGetCursorPosition(w);
- old_text = XmTextGetString(w);
- len = mus_strlen(old_text) + 5;
- new_text = (char *)calloc(len, sizeof(char));
- snprintf(new_text, len, "%s C-%c", (old_text) ? old_text : "", str[0][0]);
-
- XmTextSetString(w, new_text);
- XmTextSetCursorPosition(w, curpos);
-
- if (old_text) XtFree(old_text);
- free(new_text);
-}
-
-
-static void text_at_cursor(Widget w)
-{
- XmTextPosition curpos, endpos, start, end;
- int len, prompt_pos;
- char *buf;
-
- curpos = XmTextGetCursorPosition(w);
- if (curpos <= 1)
- curpos = XmTextGetInsertionPosition(w);
- if (curpos <= 1)
- {
- snd_help("Listener", "This is the 'listener', a text widget in which you can interact with Snd's extension language. See extsnd.html.", WITH_WORD_WRAP);
- return;
- }
-
- prompt_pos = find_prompt(w, curpos);
-
- if (curpos > 40)
- start = curpos - 40;
- else start = 0;
- if (start < prompt_pos)
- start = prompt_pos;
-
- endpos = XmTextGetLastPosition(w);
- if ((endpos - curpos) > 40)
- end = curpos + 40;
- else end = endpos;
-
- len = end - start + 1;
- buf = (char *)calloc(len + 1, sizeof(char));
- XmTextGetSubstring(w, start, len, len + 1, buf);
-
- listener_help_at_cursor(buf, curpos - start - 1, len, prompt_pos);
- free(buf);
-}
-
-
-static void Help_At_Cursor(Widget w, XEvent *ev, char **str, Cardinal *num)
-{
- text_at_cursor(w);
-}
-
-
-static void Word_upper(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- bool up, cap;
- XmTextPosition curpos, endpos;
- up = (str[0][0] == 'u');
- cap = (str[0][0] == 'c');
- curpos = XmTextGetCursorPosition(w);
- endpos = XmTextGetLastPosition(w);
- if (curpos < endpos)
- {
- int i, length, wstart, wend;
- char *buf = NULL;
- length = endpos - curpos;
- buf = (char *)calloc(length + 1, sizeof(char));
- XmTextGetSubstring(w, curpos, length, length + 1, buf);
- wstart = 0;
- wend = length;
- for (i = 0; i < length; i++)
- if (!isspace((int)(buf[i])))
- {
- wstart = i;
- break;
- }
- for (i = wstart + 1; i < length; i++)
- if (isspace((int)(buf[i])))
- {
- wend = i;
- break;
- }
- if (cap)
- {
- buf[0] = toupper(buf[wstart]);
- buf[1] = '\0';
- XmTextReplace(w, curpos + wstart, curpos + wstart + 1, buf);
- }
- else
- {
- int j;
- for (i = wstart, j = 0; i < wend; i++, j++)
- if (up)
- buf[j] = toupper(buf[i]);
- else buf[j] = tolower(buf[i]);
- buf[j] = '\0';
- XmTextReplace(w, curpos + wstart, curpos + wend, buf);
- }
- XmTextSetCursorPosition(w, curpos + wend);
- if (buf) free(buf);
- }
-}
-
-
-void append_listener_text(int end, const char *msg)
-{
- if (listener_text)
- {
- if (end == -1) end = XmTextGetLastPosition(listener_text);
- XmTextInsert(listener_text, end, (char *)msg);
- XmTextSetCursorPosition(listener_text, XmTextGetLastPosition(listener_text));
- }
-}
-
-
-static bool dont_check_motion = false;
-
-void listener_delete_text(int new_end)
-{
- int old_end;
- old_end = XmTextGetLastPosition(listener_text);
- if (old_end > new_end)
- {
- dont_check_motion = true;
- XmTextSetSelection(listener_text, new_end, old_end, CurrentTime);
- XmTextRemove(listener_text);
- dont_check_motion = false;
- }
-}
-
-
-static void Listener_Meta_P(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- listener_delete_text(find_prompt(w, XmTextGetInsertionPosition(w)));
- restore_listener_string(true);
-}
-
-
-static void Listener_Meta_N(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- listener_delete_text(find_prompt(w, XmTextGetInsertionPosition(w)));
- restore_listener_string(false);
-}
-
-
-int save_listener_text(FILE *fp)
-{
- /* return -1 if fwrite problem */
- if (listener_text)
- {
- char *str = NULL;
- str = XmTextGetString(listener_text);
- if (str)
- {
- size_t bytes;
- bytes = fwrite((void *)str, sizeof(char), mus_strlen(str), fp);
- XtFree(str);
- if (bytes == 0) return(-1);
- }
- }
- return(0);
-}
-
-
-static void Listener_clear(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- clear_listener();
-}
-
-
-static void Listener_g(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- ss->C_g_typed = true;
- control_g(any_selected_sound());
-}
-
-
-static void Listener_Backup(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- backup_listener_to_previous_expression();
-}
-
-
-static void Listener_Arrow_Up(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- if ((completions_pane) &&
- (XtIsManaged(completions_pane)))
- {
- int *ns;
- int n;
- XmListGetSelectedPos(completions_list, &ns, &n);
- if (ns[0] > 1)
- XmListSelectPos(completions_list, ns[0] - 1, false);
- free(ns);
- }
- else XtCallActionProc(w, "previous-line", event, str, *num);
-}
-
-
-static void Listener_Arrow_Down(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- if ((completions_pane) &&
- (XtIsManaged(completions_pane)))
- {
- int *ns;
- int n;
- XmListGetSelectedPos(completions_list, &ns, &n);
- XmListSelectPos(completions_list, ns[0] + 1, false);
- free(ns);
- }
- else XtCallActionProc(w, "next-line", event, str, *num);
-}
-
-
-static void Listener_Return(Widget w, XEvent *event, char **str, Cardinal *num)
-{
- if ((completions_pane) &&
- (XtIsManaged(completions_pane)))
- {
- XmString *strs;
- XtVaGetValues(completions_list,
- XmNselectedItems, &strs,
- NULL);
- perform_completion(strs[0]);
- XtUnmanageChild(completions_pane);
- }
- else XtCallActionProc(w, "activate", event, str, *num);
-}
-
-
-#define NUM_ACTS 24
-static XtActionsRec acts[NUM_ACTS] = {
- {(char *)"no-op", No_op},
- {(char *)"activate-keyboard", Activate_keyboard},
- {(char *)"yank", Yank},
- {(char *)"delete-region", Delete_region},
- {(char *)"kill-line", Kill_line},
- {(char *)"begin-of-line", Begin_of_line},
- {(char *)"b1-press", B1_press},
- {(char *)"b1-move", B1_move},
- {(char *)"b1-release", B1_release},
- {(char *)"text-transpose", Text_transpose},
- {(char *)"word-upper", Word_upper},
- {(char *)"tab-completion", Tab_completion},
- {(char *)"listener-completion", Listener_completion},
- {(char *)"listener-clear", Listener_clear},
- {(char *)"listener-g", Listener_g},
- {(char *)"listener-meta-p", Listener_Meta_P},
- {(char *)"listener-meta-n", Listener_Meta_N},
- {(char *)"listener-next-line", Listener_Arrow_Down},
- {(char *)"listener-previous-line", Listener_Arrow_Up},
- {(char *)"listener-return", Listener_Return},
- {(char *)"delete-to-previous-command", Listener_Backup},
- {(char *)"complain", Complain},
- {(char *)"help-at-cursor", Help_At_Cursor},
-};
-
-
-/* translation tables for emacs compatibility and better inter-widget communication */
-/* these values are listed in lib/Xm/Transltns.c */
-
-/* for textfield (single-line) widgets */
-static char TextTrans2[] =
- "Ctrl <Key>a: beginning-of-line()\n\
- Ctrl <Key>b: backward-character()\n\
- Mod1 <Key>b: backward-word()\n\
- Mod1 <Key>c: word-upper(c)\n\
- Ctrl <Key>c: complain(c)\n\
- Ctrl <Key>d: delete-next-character()\n\
- Mod1 <Key>d: delete-next-word()\n\
- Ctrl <Key>e: end-of-line()\n\
- Ctrl <Key>f: forward-character()\n\
- Mod1 <Key>f: forward-word()\n\
- Ctrl <Key>g: activate()\n\
- Ctrl <Key>h: delete-previous-character()\n\
- Ctrl <Key>i: complain(i)\n\
- Ctrl <Key>j: complain(j)\n\
- Ctrl <Key>k: delete-to-end-of-line()\n\
- Mod1 <Key>l: word-upper(l)\n\
- Ctrl <Key>m: complain(m)\n\
- Ctrl <Key>n: complain(n)\n\
- Mod1 <Key>n: activate()\n\
- Ctrl <Key>o: complain(o)\n\
- Mod1 <Key>p: activate()\n\
- Ctrl <Key>p: complain(p)\n\
- Ctrl <Key>q: complain(q)\n\
- Ctrl <Key>r: activate()\n\
- Ctrl <Key>s: activate()\n\
- Ctrl <Key>t: text-transpose()\n\
- Mod1 <Key>u: word-upper(u)\n\
- Ctrl <Key>u: complain(u)\n\
- Ctrl <Key>v: complain(v)\n\
- Ctrl <Key>w: complain(w)\n\
- Ctrl <Key>x: activate-keyboard(x)\n\
- Ctrl <Key>y: complain(y)\n\
- Ctrl <Key>z: complain(z)\n\
- Mod1 <Key><: beginning-of-line()\n\
- Mod1 <Key>>: end-of-line()\n\
- <Key>Delete: delete-previous-character()\n\
- Mod1 <Key>Delete: delete-to-start-of-line()\n\
- <Key>Tab: tab-completion()\n\
- <Key>Return: activate()\n";
-static XtTranslations transTable2 = NULL;
-
-
-/* same (but not activatable), try to avoid causing the currently active pushbutton widget to appear to be activated by <cr> in the text widget */
-static char TextTrans6[] =
- "Ctrl <Key>a: beginning-of-line()\n\
- Ctrl <Key>b: backward-character()\n\
- Mod1 <Key>b: backward-word()\n\
- Mod1 <Key>c: word-upper(c)\n\
- Ctrl <Key>d: delete-next-character()\n\
- Mod1 <Key>d: delete-next-word()\n\
- Ctrl <Key>e: end-of-line()\n\
- Ctrl <Key>f: forward-character()\n\
- Mod1 <Key>f: forward-word()\n\
- Ctrl <Key>g: no-op()\n\
- Ctrl <Key>h: delete-previous-character()\n\
- Ctrl <Key>k: delete-to-end-of-line()\n\
- Mod1 <Key>l: word-upper(l)\n\
- Ctrl <Key>t: text-transpose()\n\
- Mod1 <Key>u: word-upper(u)\n\
- Mod1 <Key><: beginning-of-line()\n\
- Mod1 <Key>>: end-of-line()\n\
- <Key>Delete: delete-previous-character()\n\
- Mod1 <Key>Delete: delete-to-start-of-line()\n\
- <Key>Tab: tab-completion()\n\
- <Key>Return: no-op()\n";
-static XtTranslations transTable6 = NULL;
-
-
-/* for text (multi-line) widgets */
-static char TextTrans3[] =
- "Ctrl <Key>a: beginning-of-line()\n\
- Ctrl <Key>b: backward-character()\n\
- Mod1 <Key>b: backward-word()\n\
- Mod1 <Key>c: word-upper(c)\n\
- Ctrl <Key>d: delete-next-character()\n\
- Mod1 <Key>d: delete-next-word()\n\
- Ctrl <Key>e: end-of-line()\n\
- Ctrl <Key>f: forward-character()\n\
- Mod1 <Key>f: forward-word()\n\
- Ctrl <Key>g: activate()\n\
- Ctrl <Key>h: delete-previous-character()\n\
- Ctrl <Key>j: newline-and-indent()\n\
- Ctrl <Key>k: kill-line()\n\
- Mod1 <Key>l: word-upper(l)\n\
- Ctrl <Key>n: next-line()\n\
- Ctrl <Key>o: newline-and-backup()\n\
- Ctrl <Key>p: previous-line()\n\
- Ctrl <Key>t: text-transpose()\n\
- Mod1 <Key>u: word-upper(u)\n\
- Ctrl <Key>v: next-page()\n\
- Mod1 <Key>v: previous-page()\n\
- Ctrl <Key>w: delete-region()\n\
- Ctrl <Key>y: yank()\n\
- Ctrl <Key>z: activate()\n\
- Mod1 <Key>[: backward-paragraph()\n\
- Mod1 <Key>]: forward-paragraph()\n\
- Mod1 <Key><: beginning-of-file()\n\
- Mod1 <Key>>: end-of-file()\n\
- <Key>Delete: delete-previous-character()\n\
- Mod1 <Key>Delete: delete-to-start-of-line()\n\
- Ctrl <Key>osfLeft: page-left()\n\
- Ctrl <Key>osfRight: page-right()\n\
- Ctrl <Key>osfDown: next-page()\n\
- Ctrl <Key>osfUp: previous-page()\n\
- Ctrl <Key>space: set-anchor()\n\
- <Btn1Down>: b1-press()\n\
- <Btn1Up>: b1-release()\n\
- <Btn1Motion>: b1-move()\n\
- <Key>Return: newline()\n";
-static XtTranslations transTable3 = NULL;
-
-
-/* for lisp listener */
-static char TextTrans4[] =
- "Ctrl <Key>a: begin-of-line()\n\
- Ctrl <Key>b: backward-character()\n\
- Mod1 <Key>b: backward-word()\n\
- Mod1 <Key>c: word-upper(c)\n\
- Ctrl <Key>d: delete-next-character()\n\
- Mod1 <Key>d: delete-next-word()\n\
- Ctrl <Key>e: end-of-line()\n\
- Ctrl <Key>f: forward-character()\n\
- Mod1 <Key>f: forward-word()\n\
- Ctrl Meta <Key>g: listener-clear()\n\
- Ctrl <Key>g: listener-g()\n\
- Ctrl <Key>h: delete-previous-character()\n\
- Ctrl <Key>j: newline-and-indent()\n\
- Ctrl <Key>k: kill-line()\n\
- Ctrl <Key>l: redraw-display()\n\
- Mod1 <Key>l: word-upper(l)\n\
- Ctrl <Key>n: next-line()\n\
- Mod1 <Key>n: listener-meta-n()\n\
- Ctrl <Key>o: newline-and-backup()\n\
- Ctrl <Key>p: previous-line()\n\
- Mod1 <Key>p: listener-meta-p()\n\
- Ctrl <Key>t: text-transpose()\n\
- Ctrl <Key>u: activate-keyboard(u)\n\
- Mod1 <Key>u: word-upper(u)\n\
- Ctrl <Key>v: next-page()\n\
- Mod1 <Key>v: previous-page()\n\
- Ctrl <Key>w: delete-region()\n\
- Ctrl <Key>x: activate-keyboard(x)\n\
- Ctrl <Key>y: yank()\n\
- Ctrl <Key>z: activate()\n\
- Ctrl <Key>?: help-at-cursor()\n\
- Mod1 <Key>[: backward-paragraph()\n\
- Mod1 <Key>]: forward-paragraph()\n\
- Mod1 <Key><: beginning-of-file()\n\
- Mod1 <Key>>: end-of-file()\n\
- Shift Ctrl <Key>-: delete-to-previous-command()\n\
- <Key>Delete: delete-previous-character()\n\
- Mod1 <Key>Delete: delete-to-start-of-line()\n\
- Ctrl <Key>osfLeft: page-left()\n\
- Ctrl <Key>osfRight: page-right()\n\
- Ctrl <Key>osfDown: next-page()\n\
- Ctrl <Key>osfUp: previous-page()\n\
- <Key>osfDown: listener-next-line()\n\
- <Key>osfUp: listener-previous-line()\n\
- Ctrl <Key>space: set-anchor()\n\
- <Btn1Down>: b1-press()\n\
- <Btn1Up>: b1-release()\n\
- <Btn1Motion>: b1-move()\n\
- <Key>Tab: listener-completion()\n\
- <Key>Return: listener-return()\n";
-static XtTranslations transTable4 = NULL;
-
-
-void add_completer_to_builtin_textfield(Widget w, int completer)
-{
- /* used to make file selection dialog's file and filter text widgets act like other text field widgets */
- if (!actions_loaded)
- {
- XtAppAddActions(MAIN_APP(ss), acts, NUM_ACTS);
- actions_loaded = true;
- }
- if (!transTable2)
- transTable2 = XtParseTranslationTable(TextTrans2);
-
- XtOverrideTranslations(w, transTable2);
- XtVaSetValues(w, XmNuserData, completer, NULL);
-}
-
-
-
-/* -------- text related widgets -------- */
-
-static XEN mouse_enter_text_hook;
-static XEN mouse_leave_text_hook;
-
-void mouse_enter_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- if (with_pointer_focus(ss))
- goto_window(w);
-
- if (XEN_HOOKED(mouse_enter_text_hook))
- run_hook(mouse_enter_text_hook,
- XEN_LIST_1(XEN_WRAP_WIDGET(w)),
- S_mouse_enter_text_hook);
-}
-
-
-void mouse_leave_text_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- if (XEN_HOOKED(mouse_leave_text_hook))
- run_hook(mouse_leave_text_hook,
- XEN_LIST_1(XEN_WRAP_WIDGET(w)),
- S_mouse_leave_text_hook);
-}
-
-
-Widget make_textfield_widget(const char *name, Widget parent, Arg *args, int n, text_cr_t activatable, int completer)
-{
- /* white background when active, emacs translations */
- Widget df;
-
- if (!actions_loaded)
- {
- XtAppAddActions(MAIN_APP(ss), acts, NUM_ACTS);
- actions_loaded = true;
- }
-
- XtSetArg(args[n], XmNuserData, completer); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- XtSetArg(args[n], XmNcursorPositionVisible, false); n++;
- df = XtCreateManagedWidget(name, xmTextFieldWidgetClass, parent, args, n);
-
- if ((activatable != NOT_ACTIVATABLE_OR_FOCUSED) &&
- (activatable != ACTIVATABLE_BUT_NOT_FOCUSED))
- {
- XtAddCallback(df, XmNfocusCallback, textfield_focus_callback, NULL);
- XtAddCallback(df, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- }
- else
- {
- XtAddCallback(df, XmNfocusCallback, textfield_no_color_focus_callback, NULL);
- XtAddCallback(df, XmNlosingFocusCallback, textfield_no_color_unfocus_callback, NULL);
- }
-
- XtAddEventHandler(df, EnterWindowMask, false, mouse_enter_text_callback, NULL);
- XtAddEventHandler(df, LeaveWindowMask, false, mouse_leave_text_callback, NULL);
-
- if ((activatable == ACTIVATABLE) ||
- (activatable == ACTIVATABLE_BUT_NOT_FOCUSED))
- {
- if (!transTable2)
- transTable2 = XtParseTranslationTable(TextTrans2);
- XtOverrideTranslations(df, transTable2);
- }
- else
- {
- if (!transTable6)
- transTable6 = XtParseTranslationTable(TextTrans6);
- XtOverrideTranslations(df, transTable6);
- }
-
- return(df);
-}
-
-
-
-Widget make_text_widget(const char *name, Widget parent, Arg *args, int n)
-{
- /* white background when active, emacs translations */
- /* used only for comment widget in file data box (snd-xfile.c), but needs to be in this file to pick up actions etc */
- Widget df;
- if (!actions_loaded)
- {
- XtAppAddActions(MAIN_APP(ss), acts, NUM_ACTS);
- actions_loaded = true;
- }
- XtSetArg(args[n], XmNeditMode, XmMULTI_LINE_EDIT); n++;
- /* XmNblinkRate 0 turns off the cursor blink */
- XtSetArg(args[n], XmNcursorPositionVisible, false); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- df = XmCreateScrolledText(parent, (char *)name, args, n);
- XtManageChild(df);
- XtAddCallback(df, XmNfocusCallback, textfield_focus_callback, NULL);
- XtAddCallback(df, XmNlosingFocusCallback, textfield_unfocus_callback, NULL);
- XtAddEventHandler(df, EnterWindowMask, false, mouse_enter_text_callback, NULL);
- XtAddEventHandler(df, LeaveWindowMask, false, mouse_leave_text_callback, NULL);
- if (!transTable3)
- transTable3 = XtParseTranslationTable(TextTrans3);
- XtOverrideTranslations(df, transTable3);
- return(df);
-}
-
-
-/* ---------------- listener widget ---------------- */
-
-static Widget lisp_window = NULL;
-
-void listener_append(const char *msg)
-{
- if ((listener_print_p(msg)) && /* we need this first -- runs print-hook */
- (listener_text))
- XmTextInsert(listener_text, XmTextGetLastPosition(listener_text), (char *)msg);
-}
-
-
-void listener_append_and_prompt(const char *msg)
-{
- if ((listener_print_p(msg)) &&
- (listener_text))
- {
- XmTextPosition cmd_eot;
- if (msg)
- XmTextInsert(listener_text, XmTextGetLastPosition(listener_text), (char *)msg);
- cmd_eot = XmTextGetLastPosition(listener_text);
- XmTextInsert(listener_text, cmd_eot, listener_prompt_with_cr());
- cmd_eot = XmTextGetLastPosition(listener_text);
- XmTextShowPosition(listener_text, cmd_eot - 1);
- }
-}
-
-
-static void listener_return_callback(Widget w, XtPointer context, XtPointer info)
-{
- listener_return(w, find_prompt(w, XmTextGetInsertionPosition(w)));
- /* prompt loc (last prompt pos) used only by read hook */
-}
-
-
-static int flashes = 0;
-static int paren_pos = -1;
-#define FLASH_TIME 150
-
-static void flash_unbalanced_paren(XtPointer context, XtIntervalId *id)
-{
- flashes--;
- XmTextSetHighlight(listener_text, paren_pos, paren_pos + 1, (flashes & 1) ? XmHIGHLIGHT_NORMAL : XmHIGHLIGHT_SELECTED);
- if (flashes > 0)
- XtAppAddTimeOut(MAIN_APP(ss),
- (unsigned long)FLASH_TIME,
- (XtTimerCallbackProc)flash_unbalanced_paren,
- NULL);
- else
- {
- XmTextSetHighlight(listener_text, paren_pos, paren_pos + 1, XmHIGHLIGHT_NORMAL);
- paren_pos = -1;
- }
-}
-
-
-bool highlight_unbalanced_paren(void)
-{
- /* if cursor is positioned at close paren, try to find reason for unbalanced expr and highlight it */
- int pos;
- bool success = true;
- pos = XmTextGetInsertionPosition(listener_text);
- if (pos > 2)
- {
- char *str;
- str = XmTextGetString(listener_text);
- if ((str[pos - 1] == ')') &&
- ((str[pos - 2] != '\\') || (str[pos - 3] != '#')))
- {
- int parens;
- parens = find_matching_paren(str, 2, pos - 1, &paren_pos);
- if (parens == 0)
- {
- XmTextSetHighlight(listener_text, paren_pos, paren_pos + 1, XmHIGHLIGHT_SELECTED);
- flashes = 4;
- XtAppAddTimeOut(MAIN_APP(ss),
- (unsigned long)FLASH_TIME,
- (XtTimerCallbackProc)flash_unbalanced_paren,
- NULL);
- }
- else success = false;
- }
- if (str) XtFree(str);
- }
- return(success);
-}
-
-
-static int last_highlight_position = -1;
-
-static void listener_motion_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
- int pos;
-
- cbs->doit = true;
- if (dont_check_motion) return;
- if (last_highlight_position != -1)
- {
- XmTextSetHighlight(w, last_highlight_position, last_highlight_position + 1, XmHIGHLIGHT_NORMAL);
- last_highlight_position = -1;
- }
-
- pos = cbs->newInsert - 1;
- if (pos > 0)
- {
- char *str = NULL;
- str = XmTextGetString(w);
- if ((str[pos] == ')') &&
- ((pos <= 1) || (str[pos - 1] != '\\') || (str[pos - 2] != '#')))
- {
- int parens;
- parens = find_matching_paren(str, 1, pos, &last_highlight_position);
- if (parens == 0)
- XmTextSetHighlight(w, last_highlight_position, last_highlight_position + 1, XmHIGHLIGHT_SECONDARY_SELECTED);
- }
- if (str) XtFree(str);
- }
-}
-
-
-static void listener_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmTextVerifyCallbackStruct *cbs = (XmTextVerifyCallbackStruct *)info;
-
- /* pure motion stuff (arrow keys) does not trigger this callback */
-
- if ((completions_pane) &&
- (XtIsManaged(completions_pane)))
- XtUnmanageChild(completions_pane);
-
- if (((cbs->text)->length > 0) || (dont_check_motion))
- cbs->doit = true;
- else
- {
- char *str = NULL;
- int len;
- str = XmTextGetString(w);
- len = XmTextGetLastPosition(w);
- if (within_prompt(str, cbs->startPos, len))
- cbs->doit = false;
- else cbs->doit = true;
- if (str) XtFree(str);
- }
-}
-
-
-static XEN mouse_enter_listener_hook;
-static XEN mouse_leave_listener_hook;
-
-static void listener_focus_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- if (with_pointer_focus(ss))
- goto_window(listener_text);
-
- if (XEN_HOOKED(mouse_enter_listener_hook))
- run_hook(mouse_enter_listener_hook,
- XEN_LIST_1(XEN_WRAP_WIDGET(listener_text)), /* not w */
- S_mouse_enter_listener_hook);
-}
-
-
-static void listener_unfocus_callback(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- if (XEN_HOOKED(mouse_leave_listener_hook))
- run_hook(mouse_leave_listener_hook,
- XEN_LIST_1(XEN_WRAP_WIDGET(listener_text)), /* not w */
- S_mouse_leave_listener_hook);
-}
-
-
-/* ---------------- popup callbacks ---------------- */
-
-static Widget listener_popup = NULL;
-
-static void listener_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *txt;
- txt = XmTextGetSelection(listener_text);
- if (txt)
- {
- char *trim_txt;
- trim_txt = trim(txt);
- if (trim_txt)
- {
- snd_help(trim_txt, XEN_TO_C_STRING(g_snd_help(C_TO_XEN_STRING(trim_txt), 0)), WITH_WORD_WRAP);
- free(trim_txt);
- }
- XtFree(txt);
- }
- else text_at_cursor(listener_text);
-}
-
-static void listener_save_callback(Widget w, XtPointer context, XtPointer info)
-{
- FILE *fp = NULL;
- fp = FOPEN("listener.txt", "w");
- if (fp)
- {
- save_listener_text(fp);
- snd_fclose(fp, "listener.txt");
- }
-}
-
-
-static void listener_clear_callback(Widget w, XtPointer context, XtPointer info)
-{
- clear_listener();
-}
-
-
-#if HAVE_SCHEME
-static bool (*current_begin_hook)(s7_scheme *sc);
-
-static bool stacktrace_begin_hook(s7_scheme *sc)
-{
- s7_stacktrace(sc, s7_name_to_value(sc, "*stderr*"));
- s7_set_begin_hook(s7, current_begin_hook);
- return(false);
-}
-
-
-static void listener_stacktrace_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* if we're running, replace the current begin_hook with one that grabs a stacktrace and
- * replaces itself with the previous one
- */
- current_begin_hook = s7_begin_hook(s7);
- if (current_begin_hook)
- s7_set_begin_hook(s7, stacktrace_begin_hook);
-}
-#endif
-
-
-static void listener_stop_callback(Widget w, XtPointer context, XtPointer info)
-{
- control_g(any_selected_sound());
-}
-
-
-static void listener_popup_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmPopupHandlerCallbackStruct *cb = (XmPopupHandlerCallbackStruct *)info;
- XEvent *e;
- e = cb->event;
- if (e->type == ButtonPress)
- {
- cb->menuToPost = listener_popup;
- }
-}
-
-
-static void make_listener_widget(int height)
-{
- if (!listener_text)
- {
- Arg args[32];
- Widget wv, wh, w;
- int n;
-
- if (!actions_loaded) {XtAppAddActions(MAIN_APP(ss), acts, NUM_ACTS); actions_loaded = true;}
-
- n = attach_all_sides(args, 0);
- XtSetArg(args[n], XmNheight, height); n++;
- XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++; /* Xm/Paned initializes each pane max to 1000 apparently! */
-
- if ((sound_style(ss) == SOUNDS_IN_NOTEBOOK) || (sound_style(ss) == SOUNDS_HORIZONTAL))
- listener_pane = XtCreateManagedWidget("frm", xmFormWidgetClass, SOUND_PANE_BOX(ss), args, n);
- else listener_pane = XtCreateManagedWidget("frm", xmFormWidgetClass, SOUND_PANE(ss), args, n);
- /* this widget is not redundant at least in Metroworks Motif */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->listener_color); n++;
- XtSetArg(args[n], XmNforeground, ss->listener_text_color); n++;
- if (ss->listener_fontlist) {XtSetArg(args[n], XM_FONT_RESOURCE, ss->listener_fontlist); n++;}
- n = attach_all_sides(args, n);
- XtSetArg(args[n], XmNeditMode, XmMULTI_LINE_EDIT); n++;
- XtSetArg(args[n], XmNskipAdjust, true); n++;
- XtSetArg(args[n], XmNvalue, listener_prompt(ss)); n++;
- XtSetArg(args[n], XmNpendingDelete, false); n++; /* don't cut selection upon paste */
- XtSetArg(args[n], XmNpositionIndex, XmLAST_POSITION); n++;
- XtSetArg(args[n], XmNhighlightThickness, 1); n++;
- listener_text = XmCreateScrolledText(listener_pane, (char *)"lisp-listener", args, n);
- ss->listener_pane = listener_text;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNpopupEnabled, XmPOPUP_AUTOMATIC); n++;
- listener_popup = XmCreatePopupMenu(listener_text, (char *)"listener-popup", args, n);
-
- w = XtCreateManagedWidget("Help", xmPushButtonWidgetClass, listener_popup, args, n);
- XtAddCallback(w, XmNactivateCallback, listener_help_callback, NULL);
-
- w = XtCreateManagedWidget("Stop", xmPushButtonWidgetClass, listener_popup, args, n);
- XtAddCallback(w, XmNactivateCallback, listener_stop_callback, NULL);
-
-#if HAVE_SCHEME
- w = XtCreateManagedWidget("Stacktrace", xmPushButtonWidgetClass, listener_popup, args, n);
- XtAddCallback(w, XmNactivateCallback, listener_stacktrace_callback, NULL);
-#endif
-
- w = XtCreateManagedWidget("Save", xmPushButtonWidgetClass, listener_popup, args, n);
- XtAddCallback(w, XmNactivateCallback, listener_save_callback, NULL);
-
- w = XtCreateManagedWidget("Clear", xmPushButtonWidgetClass, listener_popup, args, n);
- XtAddCallback(w, XmNactivateCallback, listener_clear_callback, NULL);
-
- XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
-
- XtManageChild(listener_text);
- XmTextSetCursorPosition(listener_text, 1);
- if (!transTable4)
- transTable4 = XtParseTranslationTable(TextTrans4);
- XtOverrideTranslations(listener_text, transTable4);
- XtAddCallback(listener_text, XmNactivateCallback, listener_return_callback, NULL);
- XtAddCallback(listener_text, XmNmodifyVerifyCallback, listener_modify_callback, NULL);
- XtAddCallback(listener_text, XmNmotionVerifyCallback, listener_motion_callback, NULL);
-
- lisp_window = XtParent(listener_text);
- XtAddEventHandler(lisp_window, EnterWindowMask, false, listener_focus_callback, NULL);
- XtAddEventHandler(lisp_window, LeaveWindowMask, false, listener_unfocus_callback, NULL);
-
- XtAddCallback(listener_text, XmNpopupHandlerCallback, listener_popup_callback, NULL);
-
- XmChangeColor(lisp_window, ss->basic_color);
- XtVaGetValues(lisp_window, XmNverticalScrollBar, &wv,
- XmNhorizontalScrollBar, &wh,
- NULL);
- XmChangeColor(wv, ss->basic_color);
- XmChangeColor(wh, ss->basic_color);
- map_over_children(SOUND_PANE(ss), color_sashes);
-
- if (auto_resize(ss))
- XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
- }
-}
-
-
-void goto_listener(void)
-{
- goto_window(listener_text);
- XmTextSetCursorPosition(listener_text, XmTextGetLastPosition(listener_text) + 1);
- XmTextSetInsertionPosition(listener_text, XmTextGetLastPosition(listener_text) + 1);
-}
-
-
-void color_listener(Pixel pix)
-{
- ss->listener_color = pix;
- if (listener_text)
- XmChangeColor(listener_text, pix);
-}
-
-
-void color_listener_text(Pixel pix)
-{
- ss->listener_text_color = pix;
- if (listener_text)
- XtVaSetValues(listener_text, XmNforeground, pix, NULL);
-}
-
-
-void handle_listener(bool open)
-{
- if (open)
- {
- if (!listener_text)
- make_listener_widget(100);
- else
- {
- XtManageChild(listener_pane);
- if (!(listener_is_visible()))
- {
- XtUnmanageChild(listener_pane);
- XtVaSetValues(listener_pane, XmNpaneMinimum, 100, XmNpaneMaximum, LOTSA_PIXELS, NULL);
- XtManageChild(listener_pane);
- XtVaSetValues(listener_pane, XmNpaneMinimum, 1, NULL);
- }
- }
- }
- else XtUnmanageChild(listener_pane);
-}
-
-
-bool listener_exists(void)
-{
- return((bool)listener_text);
-}
-
-
-int listener_height(void)
-{
- if ((listener_text) && (XtIsManaged(listener_pane)))
- return(widget_height(listener_text));
- else return(0);
-}
-
-
-int listener_width(void)
-{
- if ((listener_text) && (XtIsManaged(listener_pane)))
- return(widget_width(listener_text));
- else return(0);
-}
-
-
-#if OVERRIDE_TOGGLE
-static char ToggleTrans2[] =
- "c<Btn1Down>: ArmAndActivate()\n";
-static XtTranslations toggleTable2 = NULL;
-
-static void override_toggle_translation(Widget w)
-{
- if (!toggleTable2) toggleTable2 = XtParseTranslationTable(ToggleTrans2);
- XtOverrideTranslations(w, toggleTable2);
-}
-#endif
-
-
-Widget make_togglebutton_widget(const char *name, Widget parent, Arg *args, int n)
-{
- Widget w;
- w = XtCreateManagedWidget(name, xmToggleButtonWidgetClass, parent, args, n);
-#if OVERRIDE_TOGGLE
- override_toggle_translation(w);
-#endif
- return(w);
-}
-
-
-Widget make_pushbutton_widget(const char *name, Widget parent, Arg *args, int n)
-{
- Widget w;
- w = XtCreateManagedWidget(name, xmPushButtonWidgetClass, parent, args, n);
-#if OVERRIDE_TOGGLE
- override_toggle_translation(w); /* ??? activate here (rather than armandactivate) fails? */
-#endif
- return(w);
-}
-
-
-static XEN g_listener_selection(void)
-{
- #define H_listener_selection "(" S_listener_selection "): currently selected text in listener or " PROC_FALSE
- XEN res = XEN_FALSE;
- if (listener_text)
- {
- char *txt;
- txt = XmTextGetSelection(listener_text);
- if (txt)
- {
- res = C_TO_XEN_STRING(txt);
- XtFree(txt);
- }
- }
- return(res);
-}
-
-
-static XEN g_reset_listener_cursor(void)
-{
- #define H_reset_listener_cursor "(" S_reset_listener_cursor "): reset listener cursor to the default pointer"
- if (listener_text)
- XUndefineCursor(XtDisplay(listener_text),
- XtWindow(listener_text));
- return(XEN_FALSE);
-}
-
-
-void clear_listener(void)
-{
- if ((listener_text) && /* this can be called even when there is no listener */
- (XmTextGetCursorPosition(listener_text) > 1))
- {
- dont_check_motion = true;
- XmTextSetSelection(listener_text, 1, XmTextGetCursorPosition(listener_text), CurrentTime);
- XmTextRemove(listener_text);
- dont_check_motion = false;
- }
-}
-
-
-void set_listener_text_font(void)
-{
- if (listener_text)
- XtVaSetValues(listener_text, XM_FONT_RESOURCE, ss->listener_fontlist, NULL);
-}
-
-
-static XEN g_goto_listener_end(void)
-{
- #define H_goto_listener_end "(" S_goto_listener_end "): move cursor and scroll to bottom of listener pane"
- if (listener_text)
- {
- XmTextPosition eot;
- eot = XmTextGetLastPosition(listener_text);
- XmTextShowPosition(listener_text, eot);
- XmTextSetInsertionPosition(listener_text, eot);
- return(C_TO_XEN_INT(eot));
- }
- return(XEN_FALSE);
-}
-
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_0(g_listener_selection_w, g_listener_selection)
- XEN_NARGIFY_0(g_reset_listener_cursor_w, g_reset_listener_cursor)
- XEN_NARGIFY_0(g_goto_listener_end_w, g_goto_listener_end)
-#else
- #define g_listener_selection_w g_listener_selection
- #define g_reset_listener_cursor_w g_reset_listener_cursor
- #define g_goto_listener_end_w g_goto_listener_end
-#endif
-
-void g_init_gxlistener(void)
-{
-#if HAVE_SCHEME
- #define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (listener): called when the mouse \
-enters the lisp listener pane:\n\
- (add-hook! " S_mouse_enter_listener_hook "\n\
- (lambda (widget)\n\
- (" S_focus_widget " widget)))"
-#endif
-
-#if HAVE_RUBY
- #define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (listener): called when the mouse \
-enters the lisp listener pane:\n\
- $mouse_enter_listener_hook.add-hook!(\"enter\") do |widget|\n\
- focus_widget(widget)\n\
- end"
-#endif
-
-#if HAVE_FORTH
- #define H_mouse_enter_listener_hook S_mouse_enter_listener_hook " (listener): called when the mouse \
-enters the lisp listener pane:\n\
-" S_mouse_enter_listener_hook " lambda: <{ wid }> wid " S_focus_widget " ; add-hook!"
-#endif
-
- #define H_mouse_leave_listener_hook S_mouse_leave_listener_hook " (listener): called when the mouse \
-leaves the lisp listener pane"
-
- mouse_enter_listener_hook = XEN_DEFINE_HOOK(S_mouse_enter_listener_hook, 1, H_mouse_enter_listener_hook); /* arg = listener_text widget */
- mouse_leave_listener_hook = XEN_DEFINE_HOOK(S_mouse_leave_listener_hook, 1, H_mouse_leave_listener_hook); /* arg = listener_text widget */
-
-#if HAVE_SCHEME
- #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
-(add-hook! " S_mouse_enter_text_hook "\n\
- (lambda (w)\n\
- (" S_focus_widget " w)))"
-#endif
-
-#if HAVE_RUBY
- #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
-$mouse_enter_text_hook.add_hook!(\"enter\") do |w|\n\
- focus_widget(w)\n\
- end"
-#endif
-
-#if HAVE_FORTH
- #define H_mouse_enter_text_hook S_mouse_enter_text_hook " (widget): called when the mouse enters a text widget:\n\
-" S_mouse_enter_text_hook " lambda: <{ wid }> wid " S_focus_widget " ; add-hook!"
-#endif
-
- #define H_mouse_leave_text_hook S_mouse_leave_text_hook " (widget): called when the mouse leaves a text widget"
-
- mouse_enter_text_hook = XEN_DEFINE_HOOK(S_mouse_enter_text_hook, 1, H_mouse_enter_text_hook); /* arg = text widget */
- mouse_leave_text_hook = XEN_DEFINE_HOOK(S_mouse_leave_text_hook, 1, H_mouse_leave_text_hook); /* arg = text widget */
-
- XEN_DEFINE_PROCEDURE(S_listener_selection, g_listener_selection_w, 0, 0, 0, H_listener_selection);
- XEN_DEFINE_PROCEDURE(S_reset_listener_cursor, g_reset_listener_cursor_w, 0, 0, 0, H_reset_listener_cursor);
- XEN_DEFINE_PROCEDURE(S_goto_listener_end, g_goto_listener_end_w, 0, 0, 0, H_goto_listener_end);
-
- #define H_listener_click_hook S_listener_click_hook " (pos): called when listener clicked; pos is text pos of click in listener"
- listener_click_hook = XEN_DEFINE_HOOK(S_listener_click_hook, 1, H_listener_click_hook); /* arg = pos */
-
- preload_best_completions();
-}
diff --git a/snd-xm.fs b/snd-xm.fs
index 278f6f8..2a03975 100644
--- a/snd-xm.fs
+++ b/snd-xm.fs
@@ -2,13 +2,16 @@
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
\ Created: Mon Dec 26 22:36:46 CET 2005
-\ Changed: Sun Feb 20 14:49:49 CET 2011
+\ Changed: Tue Dec 11 01:55:54 CET 2012
\ Commentary:
\
-\ Requires --with-motif|gtk and module libxm.so|libxg.so or --with-static-xm|xg!
+\ Requires --with-motif|gtk
\
-\ Tested with Snd 11.10, Motif 2.3.0, Gtk+ 2.20.1, Fth 1.2.x
+\ Tested with Snd 13.x
+\ Fth 1.3.x
+\ Motif 2.3.4 X11R6
+\ Gtk+ 3.0.12, Glib 2.28.8, Pango 1.28.4, Cairo 1.10.2
\
\ Motif and Gtk:
\
@@ -20,8 +23,6 @@
\ load-font ( name -- fid|#f )
\ host-name ( -- host )
\ add-main-pane ( name class args -- wid )
-\ white-pixel ( -- pix )
-\ black-pixel ( -- pix )
\ raise-dialog ( dialog -- )
\ activate-dialog ( dialog -- )
\ show-disk-space ( snd -- )
@@ -30,6 +31,8 @@
\
\ main-dpy ( -- dpy )
\ current-screen ( -- scr )
+\ white-pixel ( -- pix )
+\ black-pixel ( -- pix )
\ screen-depth ( -- n )
\
\ children->array ( widget -- array )
@@ -51,11 +54,20 @@
'snd-nogui provided? [if] skip-file [then]
-$" X error" create-exception x-error
+'snd-gtk provided? [if]
+ 'gtk3 provided? not [if]
+ \ We use is-managed? in snd-test.fs
+ [defined] Fgtk_widget_get_realized [if]
+ <'> Fgtk_widget_get_realized
+ [else]
+ <'> noop
+ [then] alias is-managed? ( wid -- f )
+ .( snd-gtk: gtk3 required -- skipping snd-xm.fs ) cr
+ skip-file
+ [then]
+[then]
-\ if not configured --with-static-xm|g
-'snd-motif provided? 'xm provided? not && [if] dl-load libxm Init_libxm [then]
-'snd-gtk provided? 'xg provided? not && [if] dl-load libxg Init_libxg [then]
+"X error" create-exception x-error
require extensions
@@ -67,24 +79,24 @@ hide
#() value labelled-snds
: kmg { num -- str }
- num 0<= if
- $" disk full!"
- else
- "" { str }
- num 1024 d> if
- num 1024 1024 * d> if
- $" space: %6.3fG" #( num 1024.0 1024.0 f* f/ ) string-format
- else
- $" space: %6.3fM" #( num 1024.0 f/ ) string-format
- then
- else
- $" space: %10dK" #( num ) string-format
- then ( str )
- then
+ num 0<= if
+ "disk full!"
+ else
+ "" { str }
+ num 1024 d> if
+ num 1024 1024 * d> if
+ "space: %6.3fG" #( num 1024.0 1024.0 f* f/ )
+ else
+ "space: %6.3fM" #( num 1024.0 f/ )
+ then
+ else
+ "space: %10dK" #( num )
+ then string-format
+ then
;
set-current
-#f value showing-disk-space \ for prefs
+#f value showing-disk-space \ for prefs
\
\ after-open-hook <'> show-disk-space add-hook!
\
@@ -92,538 +104,678 @@ previous
\ ===== Gtk and Motif =====
-'snd-gtk provided? [if]
- : widget? ( w -- f ) FGTK_IS_WIDGET ;
- : set-sensitive ( w f -- ) Fgtk_widget_set_sensitive drop ;
-
- [undefined] Fgtk_widget_get_realized [if]
- <'> noop alias is-managed? ( wid -- f )
- [else]
- <'> Fgtk_widget_get_realized alias is-managed? ( wid -- f )
- [then]
-
- : change-label ( wid new-label -- )
- doc" Changes WIDGET's label to be NEW-LABEL."
- { wid new-label }
- wid if
- wid FGTK_IS_LABEL if
- wid
- else
- wid FGTK_BIN Fgtk_bin_get_child
- then FGTK_LABEL new-label Fgtk_label_set_text drop
- then
- ;
-
- hide
- : for-each-cb ( cb -- prc; w d self -- val )
- 2 proc-create swap , ( prc )
- does> { w d self -- val }
- self @ ( cb ) #( w ) run-proc
- ;
- set-current
-
- : for-each-child { wid prc -- }
- doc" Applies PRC ( w -- val ) to WIDGET and each of its children."
- wid widget? if
- prc #( wid ) run-proc drop
- wid FGTK_CONTAINER prc for-each-cb Fgtk_container_foreach drop
- then
- ;
- previous
-
- : load-font ( name -- fid|#f ) Fpango_font_description_from_string ;
-
- : host-name ( -- host )
- doc" Returns name of current machine."
- main-widgets 0 array-ref
- "WM_CLIENT_MACHINE" #f Fgdk_atom_intern
- FGDK_TARGET_STRING 0 1024 0 Fgdk_property_get { val }
- \ we get '( #t #( GdkAtom 0x3f ) 8 21 "pumpkin.fth-devel.net" )
- val car if
- val 4 list-ref 0 val 3 list-ref string-substring
- else
- #f
- then
- ;
-
- \ --- add our own pane to the overall Snd window (underneath the listener in this case) ---
-
- \ main-widgets 5 array-ref (without -notebook) and
- \ main-widgets 2 array-ref
- \ seem to be of type GTK_BOX [ms]
-
- : add-main-pane <{ name :optional class-not-needed #f args-not-needed #f -- wid }>
- #f 0 Fgtk_hbox_new { pane }
- main-widgets 5 array-ref { parent }
- parent FGTK_IS_BOX unless main-widgets 2 array-ref to parent then
- parent FGTK_IS_BOX unless
- 'x-error $" %s: no GTK_BOX widget found" #( get-func-name ) fth-raise
- then
- parent FGTK_BOX pane #f #f 4 Fgtk_box_pack_start drop
- pane Fgtk_widget_show drop
- pane name Fgtk_widget_set_name drop
- pane
- ;
-
- : get-color-pixel ( name -- pix )
- { name }
- FGdkColor { tmp }
- name tmp Fgdk_color_parse drop
- tmp Fgdk_color_copy
- ;
-
- : white-pixel ( -- pix ) "white" get-color-pixel ;
- : black-pixel ( -- pix ) "black" get-color-pixel ;
-
- \ --- bring possibly-obscured dialog to top ---
-
- : raise-dialog ( dialog -- )
- { w }
- w Fgtk_widget_show drop
- w FGTK_WINDOW Fgtk_window_present drop
- ;
-
- <'> raise-dialog alias activate-dialog ( dialog -- )
-
- \ --- show-disk-space, Gtk specific ---
-
- hide
- : show-label <{ data -- n }>
- data 0 array-ref sound? if
- data 0 array-ref { snd }
- data 1 array-ref { wid }
- snd file-name disk-kspace kmg { space }
- wid FGTK_LABEL space Fgtk_label_set_text drop
- 10000 running-word data Fg_timeout_add drop
- 0
- else
- nil
- then
- ;
- set-current
-
- : show-disk-space <{ snd -- }>
- doc" Adds a label to the minibuffer area showing the current free space \
- (for use with after-open-hook)."
- #f ( flag )
- labelled-snds each { n } n 0 array-ref snd equal? if
- ( flag ) drop
- n
- leave
- then
- end-each { previous-label }
- previous-label unless
- snd sound? if
- #t to showing-disk-space
- snd sound-widgets 10 array-ref { name-form }
- snd file-name disk-kspace kmg { space }
- space Fgtk_label_new { new-label }
- name-form FGTK_BOX new-label #f #f 6 Fgtk_box_pack_start drop
- new-label Fgtk_widget_show drop
- #( snd new-label ) to previous-label
- labelled-snds previous-label array-push drop
- 10000 <'> show-label previous-label Fg_timeout_add drop
- else
- $" no sound found for disk space label" snd-error drop
- then
- then
- ;
- previous
-[else] \ Motif
- : widget? ( w -- f) FWidget? ;
- : set-sensitive ( w f -- ) FXtSetSensitive drop ;
-
- <'> FXtIsManaged alias is-managed? ( wid -- f )
-
- : change-label ( wid new-label -- )
- doc" Changes WIDGET's label to be NEW-LABEL."
- { wid new-label }
- new-label FXmStringCreateLocalized { str }
- wid #( FXmNlabelString str ) FXtVaSetValues drop
- str FXmStringFree drop
- ;
-
- : for-each-child { wid prc -- }
- doc" Applies PRC to WIDGET and each of its children."
- prc #( wid ) run-proc drop
- wid FXtIsComposite if
- wid #( FXmNchildren 0 ) FXtVaGetValues 1 array-ref each ( w ) prc recurse end-each
- then
- ;
-
- : main-dpy ( -- dpy ) main-widgets 1 array-ref FXtDisplay ;
-
- : load-font ( name -- fid|#f )
- { name }
- main-dpy name FXLoadQueryFont { fs }
- fs FXFontStruct? if fs Ffid else #f then
- ;
-
- : current-screen ( -- scr )
- doc" Returns the current X screen number of the current display."
- main-dpy FDefaultScreenOfDisplay
- ;
-
- : white-pixel ( -- pix ) current-screen FWhitePixelOfScreen ;
- : black-pixel ( -- pix ) current-screen FBlackPixelOfScreen ;
- : screen-depth ( -- n ) current-screen FDefaultDepthOfScreen ;
-
- \ --- apply func to every widget belonging to w ---
-
- hide
- : children->array-cb ( ary -- xt; child self -- )
- 1 proc-create swap ,
- does> ( child self -- )
- ( self ) @ swap ( child ) array-push drop
- ;
- set-current
-
- : children->array ( widget -- array )
- #() { ary }
- ( widget ) ary children->array-cb for-each-child
- ary
- ;
- previous
-
- : find-child ( widget name -- wid )
- doc" Returns a widget named NAME, if one can be found in the widget hierarchy beneath WIDGET."
- { widget name }
- #f
- widget children->array each { w }
- w FXtName name string= if
- not
- w swap
- leave
- then
- end-each
- unless 'no-such-widget #( get-func-name name ) fth-throw then
- ;
-
- : widget-exists? { widget name -- f }
- #f ( flag ) widget children->array each ( w ) FXtName name string= if not leave then end-each
- ;
-
- : main-widget-exists? ( name -- f ) main-widgets 1 array-ref swap widget-exists? ;
-
- hide
- : display-widget <{ widget n -- }>
- widget FXtName empty? if
- "<unnamed>"
- else
- widget FXtName
- then
- n spaces .string cr
- widget FXtIsComposite if
- widget #( FXmNchildren 0 ) FXtVaGetValues 1 array-ref each ( w ) n 2 + recurse end-each
- then
- ;
- set-current
-
- : display-widget-tree { widget -- }
- doc" Displays the hierarchy of widgets beneath WIDGET."
- <'> display-widget #( widget 0 ) run-proc drop
- ;
- previous
-
- hide
- : change-color-cb <{ w -- }>
- w FXtIsWidget if
- w FXmIsScrollBar if
- w position-color FXmChangeColor drop
- else
- w basic-color FXmChangeColor drop
- then
- then
- ;
- set-current
-
- : set-main-color-of-widget ( widget -- )
- doc" Sets the background color of WIDGET."
- <'> change-color-cb for-each-child
- ;
- previous
-
- : host-name ( -- host )
- doc" Returns name of current machine."
- main-widgets 1 array-ref { wid }
- wid FXtWindow { win }
- main-dpy win main-dpy "WM_CLIENT_MACHINE" #f FXInternAtom 0 32 #f FXA_STRING
- FXGetWindowProperty { host }
- host if host 5 array-ref else host then
- ;
-
- \ --- add our own pane to the channel section ---
- \
- \ 0 0 "new-pane" FxmDrawingAreaWidgetClass
- \ #( FXmNbackground graph-color FXmNforeground data-color ) add-channel-pane value draw-widget
-
- : add-channel-pane { snd chn name typ args -- wid }
- name typ snd chn channel-widgets 7 array-ref FXtParent FXtParent args FXtCreateManagedWidget
- ;
-
- \ --- add our own pane to the sound section (underneath the controls in this case) ---
-
- : add-sound-pane { snd name typ args -- wid }
- name typ snd sound-widgets 0 array-ref args undef FXtCreateManagedWidget
- ;
-
- \ --- add our own pane to the overall Snd window (underneath the listener in this case) ---
-
- : add-main-pane { name class args -- wid }
- main-widgets 5 array-ref dup unless drop main-widgets 3 array-ref then { parent }
- name class parent args undef FXtCreateManagedWidget
- ;
-
- \ --- add a widget at the top of the listener ---
-
- : add-listener-pane { name typ args -- wid }
- main-widgets 1 array-ref "lisp-listener" find-child { listener }
- listener FXtParent { listener-scroll }
- listener-scroll FXtParent { listener-form }
- listener-scroll FXtUnmanageChild drop
- args
- #( FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNtopAttachment FXmATTACH_FORM ) array-append to args
- name typ listener-form args undef FXtCreateManagedWidget { top-widget }
- listener-scroll
- #( FXmNtopAttachment FXmATTACH_WIDGET FXmNtopWidget top-widget ) FXtVaSetValues drop
- listener-scroll FXtManageChild drop
- top-widget
- ;
-
- \ --- bring possibly-obscured dialog to top ---
-
- : raise-dialog ( dialog -- )
- { w }
- w FWidget? if
- w FXtIsManaged if
- w FXtParent { parent }
- parent FWidget? if
- parent FxmDialogShellWidgetClass FXtIsSubclass if
- parent FXtGrabNone FXtPopup drop
- then
- then
- then
- then
- ;
-
- : activate-dialog ( dialog -- ) dup FXtIsManaged if raise-dialog else FXtManageChild drop then ;
-
- \ --- add-mark-pane ---
-
- #f value including-mark-pane
-
- hide
- #() value mark-list-lengths
- #() value mark-lists
-
- : find-mark-list { snd chn dats -- lst }
- #f \ flag
- dats each { dat }
- snd dat 0 array-ref =
- chn dat 1 array-ref = && if
- drop \ drop flag
- dat 2 array-ref
- leave
- then
- end-each
- ;
-
- : mark-list-length ( snd chn -- len ) mark-list-lengths find-mark-list dup unless drop 0 then ;
-
- : set-mark-list-length { snd chn len -- }
- mark-list-lengths each { dat }
- snd dat 0 array-ref =
- chn dat 1 array-ref = && if
- mark-list-lengths i array-delete! drop
- leave
- then
- end-each
- mark-list-lengths #( snd chn len ) array-push drop
- ;
-
- : mark-list ( snd chn -- lst ) mark-lists find-mark-list dup if 2 array-ref else drop #() then ;
-
- : set-mark-list { snd chn lst -- } mark-lists #( snd chn lst ) array-push drop ;
-
- : deactivate-channel { snd chn -- }
- snd chn mark-list-length 0>
- snd chn mark-list FWidget? && if
- snd chn mark-list #( FXmNchildren 0 ) FXtVaGetValues 1 array-ref each
- FXtUnmanageChild drop
- end-each
- then
- ;
-
- : marks-focus-cb <{ w c i -- f }> w #( FXmNbackground white-pixel ) FXtVaSetValues ;
- : marks-losing-focus-cb <{ w c i -- f }> w #( FXmNbackground basic-color ) FXtVaSetValues ;
-
- : marks-activate-cb <{ w c info -- }>
- w #( FXmNuserData 0 ) FXtVaGetValues 1 array-ref { id }
- w #( FXmNvalue 0 ) FXtVaGetValues 1 array-ref { txt }
- txt string? txt length 0> && if txt string->number else #f then { samp }
- samp if id samp set-mark-sample else id delete-mark then drop
- w #( FXmNbackground basic-color ) FXtVaSetValues drop
- ;
-
- : marks-enter-cb <{ w c i f -- f }> mouse-enter-text-hook #( w ) run-hook ;
- : marks-leave-cb <{ w c i f -- f }> mouse-leave-text-hook #( w ) run-hook ;
-
- : make-mark-list { snd chn -- }
- snd chn mark-list-length { cur-len }
- snd chn deactivate-channel
- snd chn mark-list FWidget? unless
- snd chn "mark-box" FxmFormWidgetClass
- #( FXmNbackground basic-color
- FXmNorientation FXmVERTICAL
- FXmNpaneMinimum 100
- FXmNbottomAttachment FXmATTACH_FORM ) add-channel-pane { mark-box }
- "Marks" FxmLabelWidgetClass mark-box
- #( FXmNbackground highlight-color
- FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNalignment FXmALIGNMENT_CENTER
- FXmNtopAttachment FXmATTACH_FORM ) undef FXtCreateManagedWidget { mark-label }
- "mark-scroller" FxmScrolledWindowWidgetClass mark-box
- #( FXmNbackground basic-color
- FXmNscrollingPolicy FXmAUTOMATIC
- FXmNscrollBarDisplayPolicy FXmSTATIC
- FXmNleftAttachment FXmATTACH_FORM
- FXmNrightAttachment FXmATTACH_FORM
- FXmNtopAttachment FXmATTACH_WIDGET
- FXmNtopWidget mark-label
- FXmNbottomAttachment FXmATTACH_FORM ) undef FXtCreateManagedWidget { mark-scroller }
- "mark-list" FxmRowColumnWidgetClass mark-scroller
- #( FXmNorientation FXmVERTICAL
- FXmNtopAttachment FXmATTACH_FORM
- FXmNbottomAttachment FXmATTACH_FORM
- FXmNspacing 0 ) undef FXtCreateManagedWidget { mlist }
- mark-scroller set-main-color-of-widget
- mark-box #( FXmNpaneMinimum 1 ) FXtVaSetValues drop
- snd chn #( snd chn mlist ) set-mark-list
- then
- snd chn #f marks { new-marks }
- new-marks length cur-len > if
- snd chn mark-list { lst }
- new-marks length cur-len ?do
- "field" FxmTextFieldWidgetClass lst
- #( FXmNbackground basic-color ) undef FXtCreateWidget { tf }
- tf FXmNfocusCallback <'> marks-focus-cb undef FXtAddCallback drop
- tf FXmNlosingFocusCallback <'> marks-losing-focus-cb undef FXtAddCallback drop
- tf FXmNactivateCallback <'> marks-activate-cb undef FXtAddCallback drop
- tf FEnterWindowMask #f <'> marks-enter-cb undef FXtAddEventHandler drop
- tf FLeaveWindowMask #f <'> marks-leave-cb undef FXtAddEventHandler drop
- loop
- then
- snd chn new-marks length set-mark-list-length
- snd chn mark-list #( FXmNchildren 0 ) FXtVaGetValues 1 array-ref each { wid }
- new-marks empty? ?leave
- wid FXmIsTextField if
- wid
- #( FXmNvalue new-marks 0 array-ref undef mark-sample number->string
- FXmNuserData new-marks 0 array-ref ) FXtVaSetValues drop
- wid FXtManageChild drop
- new-marks array-shift to new-marks
- then
- end-each
- #f
- ;
-
- : remark <{ id snd chn reason -- }> snd chn make-mark-list ;
- : unremark <{ snd -- }> snd channels 0 ?do snd i deactivate-channel loop ;
-
- : marks-edit-cb { snd chn -- proc; self -- }
- 0 proc-create chn , snd ,
- does> ( self -- )
- { self }
- self @ { chn }
- self cell+ @ { snd }
- snd chn mark-list FWidget? if snd chn make-mark-list then
- ;
-
- : open-remarks <{ snd -- }>
- snd channels 0 ?do
- snd i after-edit-hook snd i marks-edit-cb add-hook!
- snd i undo-hook snd i marks-edit-cb add-hook!
- loop
- ;
-
- : marks-update-proc <{ snd -- }> snd channels 0 ?do snd i make-mark-list loop ;
- : marks-update-cb <{ snd -- proc }> snd <'> marks-update-proc ;
- set-current
-
- : add-mark-pane ( -- )
- #t to including-mark-pane
- mark-hook <'> remark add-hook!
- close-hook <'> unremark add-hook!
- after-open-hook <'> open-remarks add-hook!
- update-hook <'> marks-update-cb add-hook!
- ;
- previous
-
- \ --- show-disk-space, Motif specific ---
-
- hide
- : show-label <{ data id -- }>
- data 0 array-ref empty? unless
- data 0 array-ref { snd }
- data 1 array-ref { wid }
- data 2 array-ref { app }
- snd sound? if wid snd file-name disk-kspace kmg change-label then
- app 10000 running-word data FXtAppAddTimeOut drop
- then
- ;
- set-current
-
- : show-disk-space <{ snd -- }>
- doc" Adds a label to the minibuffer area showing the current free space \
- (for use with after-open-hook)."
- #f ( flag )
- labelled-snds each { n } n 0 array-ref snd equal? if
- ( flag ) drop
- n
- leave
- then
- end-each { previous-label }
- previous-label unless
- snd sound? if
- #t to showing-disk-space
- main-widgets 0 array-ref { app }
- snd sound-widgets { widgets }
- widgets 3 array-ref { minibuffer }
- widgets 6 array-ref { unite-button }
- widgets 9 array-ref { sync-button }
- minibuffer FXtParent { name-form }
- snd file-name disk-kspace kmg FXmStringCreateLocalized { str }
- minibuffer FXtUnmanageChild drop
- minibuffer #( FXmNrightAttachment FXmATTACH_NONE ) FXtVaSetValues drop
- "space" FxmLabelWidgetClass name-form
- #( FXmNbackground basic-color
- FXmNleftAttachment FXmATTACH_NONE
- FXmNlabelString str
- FXmNrightAttachment FXmATTACH_WIDGET
- FXmNrightWidget unite-button FXtIsManaged if unite-button else sync-button then
- FXmNtopAttachment FXmATTACH_FORM ) undef FXtCreateManagedWidget { new-label }
- minibuffer
- #( FXmNrightWidget new-label FXmNrightAttachment FXmATTACH_WIDGET ) FXtVaSetValues drop
- minibuffer FXtManageChild drop
- str FXmStringFree drop
- #( snd new-label app ) to previous-label
- labelled-snds previous-label array-push drop
- app 10000 <'> show-label previous-label FXtAppAddTimeOut drop
- else
- $" no sound found for disk space label" snd-error drop
- then
- then
- ;
- previous
-
- : current-label ( widget -- label )
- doc" Returns WIDGET's label."
- ( wid ) #( FXmNlabelString 0 ) FXtVaGetValues 1 array-ref { xmstr }
- xmstr #f FXmCHARSET_TEXT FXmCHARSET_TEXT #f 0 FXmOUTPUT_ALL FXmStringUnparse
- ;
+'snd-gtk provided? [if] \ !HAVE_MOTIF
+ : widget? ( w -- f )
+ FGTK_IS_WIDGET
+ ;
+
+ : set-sensitive ( w f -- )
+ Fgtk_widget_set_sensitive drop
+ ;
+
+ [defined] Fgtk_widget_get_realized [if]
+ <'> Fgtk_widget_get_realized
+ [else]
+ <'> noop
+ [then] alias is-managed? ( wid -- f )
+
+ : change-label ( wid new-label -- )
+ doc" Change WIDGET's label to be NEW-LABEL."
+ { wid new-label }
+ wid if
+ wid FGTK_IS_LABEL if
+ wid
+ else
+ wid FGTK_BIN Fgtk_bin_get_child
+ then FGTK_LABEL new-label Fgtk_label_set_text drop
+ then
+ ;
+
+ hide
+ : for-each-cb ( cb -- prc; w d self -- val )
+ { cb }
+ 2 proc-create ( prc )
+ cb ,
+ does> { w d self -- val }
+ self @ ( cb ) #( w ) run-proc
+ ;
+ set-current
+
+ : for-each-child { wid prc -- }
+ doc" Apply PRC ( w -- val ) to WIDGET and each of its children."
+ wid widget? if
+ prc #( wid ) run-proc drop
+ wid FGTK_CONTAINER prc for-each-cb
+ Fgtk_container_foreach drop
+ then
+ ;
+ previous
+
+ : load-font ( name -- fid|#f )
+ Fpango_font_description_from_string
+ ;
+
+ : host-name ( -- host )
+ doc" Return name of current machine."
+ main-widgets 0 array-ref
+ "WM_CLIENT_MACHINE" #f Fgdk_atom_intern
+ FGDK_TARGET_STRING 0 1024 0 Fgdk_property_get { val }
+ \ we get '( #t #( GdkAtom 0x3f ) 8 21 "pumpkin.fth-devel.net" )
+ val car if
+ val 4 list-ref 0 val 3 list-ref string-substring
+ else
+ #f
+ then
+ ;
+
+ \ --- add our own pane to the overall Snd window (underneath the
+ \ listener in this case) ---
+
+ \ main-widgets 5 array-ref (without -notebook) and
+ \ main-widgets 2 array-ref
+ \ seem to be of type GTK_BOX [ms]
+
+ : add-main-pane <{ name
+ :optional class-not-needed #f args-not-needed #f -- wid }>
+ FGTK_ORIENTATION_HORIZONTAL 0 Fgtk_box_new { pane }
+ main-widgets 5 array-ref { parent }
+ parent FGTK_IS_BOX unless
+ main-widgets 2 array-ref to parent
+ then
+ parent FGTK_IS_BOX unless
+ 'x-error
+ #( "%s: no GTK_BOX widget found"
+ get-func-name ) fth-throw
+ then
+ parent FGTK_BOX pane #f #f 4 Fgtk_box_pack_start drop
+ pane Fgtk_widget_show drop
+ pane name Fgtk_widget_set_name drop
+ pane
+ ;
+
+ \ --- bring possibly-obscured dialog to top ---
+
+ : raise-dialog ( dialog -- )
+ { w }
+ w Fgtk_widget_show drop
+ w FGTK_WINDOW Fgtk_window_present drop
+ ;
+
+ <'> raise-dialog alias activate-dialog ( dialog -- )
+
+ \ --- show-disk-space, Gtk specific ---
+
+ hide
+ : show-label <{ data -- n }>
+ data 0 array-ref sound? if
+ data 0 array-ref { snd }
+ data 1 array-ref { wid }
+ snd file-name disk-kspace kmg { space }
+ wid FGTK_LABEL space Fgtk_label_set_text drop
+ 10000 running-word data Fg_timeout_add drop
+ 0
+ else
+ nil
+ then
+ ;
+ set-current
+
+ : show-disk-space <{ snd -- }>
+ doc" Add a label to the minibuffer area showing the current \
+free space (for use with after-open-hook)."
+ #f ( flag )
+ labelled-snds each { n }
+ n 0 array-ref snd equal? if
+ ( flag ) drop
+ n
+ leave
+ then
+ end-each { previous-label }
+ previous-label unless
+ snd sound? if
+ #t to showing-disk-space
+ snd sound-widgets 10 array-ref { name-form }
+ snd file-name disk-kspace kmg { space }
+ space Fgtk_label_new { new-label }
+ name-form FGTK_BOX new-label #f #f 6
+ Fgtk_box_pack_start drop
+ new-label Fgtk_widget_show drop
+ #( snd new-label ) to previous-label
+ labelled-snds previous-label array-push drop
+ 10000 <'> show-label previous-label
+ Fg_timeout_add drop
+ else
+ "no sound found for disk space label"
+ snd-error drop
+ then
+ then
+ ;
+ previous
+[else] \ HAVE_MOTIF
+ : widget? ( w -- f)
+ FWidget?
+ ;
+
+ : set-sensitive ( w f -- )
+ FXtSetSensitive drop
+ ;
+
+ <'> FXtIsManaged alias is-managed? ( wid -- f )
+
+ : change-label ( wid new-label -- )
+ doc" Change WIDGET's label to be NEW-LABEL."
+ { wid new-label }
+ new-label FXmStringCreateLocalized { str }
+ wid #( FXmNlabelString str ) FXtVaSetValues drop
+ str FXmStringFree drop
+ ;
+
+ : for-each-child { wid prc -- }
+ doc" Apply PRC to WIDGET and each of its children."
+ prc #( wid ) run-proc drop
+ wid FXtIsComposite if
+ wid #( FXmNchildren 0 )
+ FXtVaGetValues 1 array-ref each ( w )
+ prc recurse
+ end-each
+ then
+ ;
+
+ : main-dpy ( -- dpy )
+ main-widgets 1 array-ref FXtDisplay
+ ;
+
+ : load-font ( name -- fid|#f )
+ { name }
+ main-dpy name FXLoadQueryFont { fs }
+ fs FXFontStruct? if
+ fs Ffid
+ else
+ #f
+ then
+ ;
+
+ : current-screen ( -- scr )
+ doc" Return the current X screen number of the current display."
+ main-dpy FDefaultScreenOfDisplay
+ ;
+
+ : white-pixel ( -- pix ) current-screen FWhitePixelOfScreen ;
+ : black-pixel ( -- pix ) current-screen FBlackPixelOfScreen ;
+ : screen-depth ( -- n ) current-screen FDefaultDepthOfScreen ;
+
+ \ --- apply func to every widget belonging to w ---
+
+ hide
+ : children->array-cb ( ary -- prc; child self -- )
+ { ary }
+ 1 proc-create ( prc )
+ ary ,
+ does> { child self -- }
+ self @ ( ary ) child array-push drop
+ ;
+ set-current
+
+ : children->array ( widget -- array )
+ #() { ary }
+ ( widget ) ary children->array-cb for-each-child
+ ary
+ ;
+ previous
+
+ : find-child ( widget name -- wid )
+ doc" Return a widget named NAME, if one can be found in the \
+ widget hierarchy beneath WIDGET."
+ { widget name }
+ #f
+ widget children->array each { w }
+ w FXtName name string= if
+ not
+ w swap
+ leave
+ then
+ end-each unless
+ 'no-such-widget
+ #( "%s: %S" get-func-name name ) fth-throw
+ then
+ ;
+
+ : widget-exists? { widget name -- f }
+ #f ( flag ) widget children->array each ( w )
+ FXtName name string= if
+ ( flag ) not leave
+ then
+ end-each ( flag )
+ ;
+
+ : main-widget-exists? ( name -- f )
+ main-widgets 1 array-ref swap widget-exists?
+ ;
+
+ hide
+ : display-widget <{ widget n -- }>
+ widget FXtName empty? if
+ "<unnamed>"
+ else
+ widget FXtName
+ then
+ n spaces .string cr
+ widget FXtIsComposite if
+ widget #( FXmNchildren 0 )
+ FXtVaGetValues 1 array-ref each ( w )
+ n 2 + recurse
+ end-each
+ then
+ ;
+ set-current
+
+ : display-widget-tree { widget -- }
+ doc" Display the hierarchy of widgets beneath WIDGET."
+ <'> display-widget #( widget 0 ) run-proc drop
+ ;
+ previous
+
+ hide
+ : change-color-cb <{ w -- }>
+ w FXtIsWidget if
+ w FXmIsScrollBar if
+ w position-color FXmChangeColor drop
+ else
+ w basic-color FXmChangeColor drop
+ then
+ then
+ ;
+ set-current
+
+ : set-main-color-of-widget ( widget -- )
+ doc" Set the background color of WIDGET."
+ <'> change-color-cb for-each-child
+ ;
+ previous
+
+ : host-name ( -- host )
+ doc" Return name of current machine."
+ main-widgets 1 array-ref { wid }
+ wid FXtWindow { win }
+ main-dpy win main-dpy "WM_CLIENT_MACHINE" #f
+ FXInternAtom 0 32 #f FXA_STRING FXGetWindowProperty { host }
+ host if
+ host 5 array-ref
+ else
+ host
+ then
+ ;
+
+ \ --- add our own pane to the channel section ---
+ \
+ \ 0 0 "new-pane" FxmDrawingAreaWidgetClass
+ \ #( FXmNbackground graph-color FXmNforeground data-color )
+ \ add-channel-pane value draw-widget
+
+ : add-channel-pane { snd chn name typ args -- wid }
+ name typ snd chn channel-widgets 7 array-ref
+ FXtParent FXtParent args FXtCreateManagedWidget
+ ;
+
+ \ --- add our own pane to the sound section (underneath the controls
+ \ in this case) ---
+
+ : add-sound-pane { snd name typ args -- wid }
+ name typ snd sound-widgets 0 array-ref args
+ undef FXtCreateManagedWidget
+ ;
+
+ \ --- add our own pane to the overall Snd window (underneath the
+ \ listener in this case) ---
+
+ : add-main-pane { name class args -- wid }
+ main-widgets 5 array-ref dup unless
+ drop main-widgets 3 array-ref
+ then { parent }
+ name class parent args undef FXtCreateManagedWidget
+ ;
+
+ \ --- add a widget at the top of the listener ---
+
+ : add-listener-pane { name typ args -- wid }
+ main-widgets 1 array-ref "lisp-listener" find-child { listener }
+ listener FXtParent { listener-scroll }
+ listener-scroll FXtParent { listener-form }
+ listener-scroll FXtUnmanageChild drop
+ args
+ #( FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNtopAttachment FXmATTACH_FORM ) array-append to args
+ name typ listener-form args
+ undef FXtCreateManagedWidget { top-widget }
+ listener-scroll
+ #( FXmNtopAttachment FXmATTACH_WIDGET
+ FXmNtopWidget top-widget ) FXtVaSetValues drop
+ listener-scroll FXtManageChild drop
+ top-widget
+ ;
+
+ \ --- bring possibly-obscured dialog to top ---
+
+ : raise-dialog ( dialog -- )
+ { w }
+ w FWidget? if
+ w FXtIsManaged if
+ w FXtParent { parent }
+ parent FWidget? if
+ parent FxmDialogShellWidgetClass
+ FXtIsSubclass if
+ parent FXtGrabNone
+ FXtPopup drop
+ then
+ then
+ then
+ then
+ ;
+
+ : activate-dialog ( dialog -- )
+ dup FXtIsManaged if
+ raise-dialog
+ else
+ FXtManageChild drop
+ then
+ ;
+
+ \ --- add-mark-pane ---
+
+ #f value including-mark-pane
+
+ hide
+ #() value mark-list-lengths
+ #() value mark-lists
+
+ : find-mark-list { snd chn dats -- lst }
+ #f \ flag
+ dats each { dat }
+ snd dat 0 array-ref =
+ chn dat 1 array-ref = && if
+ drop \ drop flag
+ dat 2 array-ref
+ leave
+ then
+ end-each
+ ;
+
+ : mark-list-length ( snd chn -- len )
+ mark-list-lengths find-mark-list dup unless
+ drop 0
+ then
+ ;
+
+ : set-mark-list-length { snd chn len -- }
+ mark-list-lengths each { dat }
+ snd dat 0 array-ref =
+ chn dat 1 array-ref = && if
+ mark-list-lengths i array-delete! drop
+ leave
+ then
+ end-each
+ mark-list-lengths #( snd chn len ) array-push drop
+ ;
+
+ : mark-list ( snd chn -- lst )
+ mark-lists find-mark-list dup if
+ 2 array-ref
+ else
+ drop #()
+ then
+ ;
+
+ : set-mark-list { snd chn lst -- }
+ mark-lists #( snd chn lst ) array-push drop
+ ;
+
+ : deactivate-channel { snd chn -- }
+ snd chn mark-list-length 0>
+ snd chn mark-list FWidget? && if
+ snd chn mark-list #( FXmNchildren 0 )
+ FXtVaGetValues 1 array-ref each ( w )
+ FXtUnmanageChild drop
+ end-each
+ then
+ ;
+
+ : marks-focus-cb <{ w c i -- f }>
+ w #( FXmNbackground white-pixel ) FXtVaSetValues
+ ;
+
+ : marks-losing-focus-cb <{ w c i -- f }>
+ w #( FXmNbackground basic-color ) FXtVaSetValues
+ ;
+
+ : marks-activate-cb <{ w c info -- }>
+ w #( FXmNuserData 0 ) FXtVaGetValues 1 array-ref { id }
+ w #( FXmNvalue 0 ) FXtVaGetValues 1 array-ref { txt }
+ txt string?
+ txt length 0> && if
+ txt string->number
+ else
+ #f
+ then
+ { samp }
+ samp if
+ id samp set-mark-sample
+ else
+ id delete-mark
+ then drop
+ w #( FXmNbackground basic-color ) FXtVaSetValues drop
+ ;
+
+ : marks-enter-cb <{ w c i f -- f }>
+ mouse-enter-text-hook #( w ) run-hook
+ ;
+
+ : marks-leave-cb <{ w c i f -- f }>
+ mouse-leave-text-hook #( w ) run-hook
+ ;
+
+ : make-mark-list { snd chn -- }
+ snd chn mark-list-length { cur-len }
+ snd chn deactivate-channel
+ snd chn mark-list FWidget? unless
+ snd chn "mark-box" FxmFormWidgetClass
+ #( FXmNbackground basic-color
+ FXmNorientation FXmVERTICAL
+ FXmNpaneMinimum 100
+ FXmNbottomAttachment FXmATTACH_FORM )
+ add-channel-pane { mark-box }
+ "Marks" FxmLabelWidgetClass mark-box
+ #( FXmNbackground highlight-color
+ FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNalignment FXmALIGNMENT_CENTER
+ FXmNtopAttachment FXmATTACH_FORM )
+ undef FXtCreateManagedWidget { mark-label }
+ "mark-scroller" FxmScrolledWindowWidgetClass mark-box
+ #( FXmNbackground basic-color
+ FXmNscrollingPolicy FXmAUTOMATIC
+ FXmNscrollBarDisplayPolicy FXmSTATIC
+ FXmNleftAttachment FXmATTACH_FORM
+ FXmNrightAttachment FXmATTACH_FORM
+ FXmNtopAttachment FXmATTACH_WIDGET
+ FXmNtopWidget mark-label
+ FXmNbottomAttachment FXmATTACH_FORM )
+ undef FXtCreateManagedWidget { mark-scroller }
+ "mark-list" FxmRowColumnWidgetClass mark-scroller
+ #( FXmNorientation FXmVERTICAL
+ FXmNtopAttachment FXmATTACH_FORM
+ FXmNbottomAttachment FXmATTACH_FORM
+ FXmNspacing 0 )
+ undef FXtCreateManagedWidget { mlist }
+ mark-scroller set-main-color-of-widget
+ mark-box #( FXmNpaneMinimum 1 ) FXtVaSetValues drop
+ snd chn #( snd chn mlist ) set-mark-list
+ then
+ snd chn #f marks { new-marks }
+ new-marks length cur-len > if
+ snd chn mark-list { lst }
+ new-marks length cur-len ?do
+ "field" FxmTextFieldWidgetClass lst
+ #( FXmNbackground basic-color )
+ undef FXtCreateWidget { tf }
+ tf FXmNfocusCallback
+ <'> marks-focus-cb
+ undef FXtAddCallback drop
+ tf FXmNlosingFocusCallback
+ <'> marks-losing-focus-cb
+ undef FXtAddCallback drop
+ tf FXmNactivateCallback
+ <'> marks-activate-cb
+ undef FXtAddCallback drop
+ tf FEnterWindowMask #f
+ <'> marks-enter-cb
+ undef FXtAddEventHandler drop
+ tf FLeaveWindowMask #f
+ <'> marks-leave-cb
+ undef FXtAddEventHandler drop
+ loop
+ then
+ snd chn new-marks length set-mark-list-length
+ snd chn mark-list #( FXmNchildren 0 )
+ FXtVaGetValues 1 array-ref each { wid }
+ new-marks empty? ?leave
+ wid FXmIsTextField if
+ wid #( FXmNvalue
+ new-marks car undef mark-sample
+ number->string
+ FXmNuserData
+ new-marks car ) FXtVaSetValues drop
+ wid FXtManageChild drop
+ new-marks array-shift to new-marks
+ then
+ end-each
+ #f
+ ;
+
+ : remark <{ id snd chn reason -- }>
+ snd chn make-mark-list
+ ;
+
+ : unremark <{ snd -- }>
+ snd channels 0 ?do
+ snd i deactivate-channel
+ loop
+ ;
+
+ : marks-edit-cb { snd chn -- prc; self -- }
+ 0 proc-create ( prc )
+ chn , snd ,
+ does> { self -- }
+ self @ { chn }
+ self cell+ @ { snd }
+ snd chn mark-list FWidget? if
+ snd chn make-mark-list
+ then
+ ;
+
+ : open-remarks <{ snd -- }>
+ snd channels 0 ?do
+ snd i after-edit-hook snd i marks-edit-cb add-hook!
+ snd i undo-hook snd i marks-edit-cb add-hook!
+ loop
+ ;
+
+ : marks-update-proc <{ snd -- }>
+ snd channels 0 ?do
+ snd i make-mark-list
+ loop
+ ;
+
+ : marks-update-cb <{ snd -- proc }>
+ snd <'> marks-update-proc
+ ;
+ set-current
+
+ : add-mark-pane ( -- )
+ #t to including-mark-pane
+ mark-hook <'> remark add-hook!
+ close-hook <'> unremark add-hook!
+ after-open-hook <'> open-remarks add-hook!
+ update-hook <'> marks-update-cb add-hook!
+ ;
+ previous
+
+ \ --- show-disk-space, Motif specific ---
+
+ hide
+ : show-label <{ data id -- }>
+ data 0 array-ref empty? unless
+ data 0 array-ref { snd }
+ data 1 array-ref { wid }
+ data 2 array-ref { app }
+ snd sound? if
+ wid snd file-name disk-kspace kmg change-label
+ then
+ app 10000 running-word data FXtAppAddTimeOut drop
+ then
+ ;
+ set-current
+
+ : show-disk-space <{ snd -- }>
+ doc" Add a label to the minibuffer area showing the current \
+free space (for use with after-open-hook)."
+ #f ( flag )
+ labelled-snds each { n }
+ n 0 array-ref snd equal? if
+ ( flag ) drop
+ n
+ leave
+ then
+ end-each { previous-label }
+ previous-label if
+ exit
+ then
+ snd sound? unless
+ "no sound found for disk space label" snd-error drop
+ exit
+ then
+ #t to showing-disk-space
+ main-widgets 0 array-ref { app }
+ snd sound-widgets { widgets }
+ widgets 3 array-ref { minibuffer }
+ widgets 6 array-ref { unite-button }
+ widgets 9 array-ref { sync-button }
+ minibuffer FXtParent { name-form }
+ snd file-name disk-kspace kmg FXmStringCreateLocalized { str }
+ minibuffer FXtUnmanageChild drop
+ minibuffer #( FXmNrightAttachment FXmATTACH_NONE )
+ FXtVaSetValues drop
+ "space" FxmLabelWidgetClass name-form
+ #( FXmNbackground basic-color
+ FXmNleftAttachment FXmATTACH_NONE
+ FXmNlabelString str
+ FXmNrightAttachment FXmATTACH_WIDGET
+ FXmNrightWidget
+ unite-button FXtIsManaged if
+ unite-button
+ else
+ sync-button
+ then
+ FXmNtopAttachment FXmATTACH_FORM )
+ undef FXtCreateManagedWidget { new-label }
+ minibuffer
+ #( FXmNrightWidget new-label
+ FXmNrightAttachment FXmATTACH_WIDGET )
+ FXtVaSetValues drop
+ minibuffer FXtManageChild drop
+ str FXmStringFree drop
+ #( snd new-label app ) to previous-label
+ labelled-snds previous-label array-push drop
+ app 10000 <'> show-label previous-label FXtAppAddTimeOut drop
+ ;
+ previous
+
+ : current-label ( widget -- label )
+ doc" Return WIDGET's label."
+ ( wid ) #( FXmNlabelString 0 ) FXtVaGetValues
+ 1 array-ref ( xmstr ) #f FXmCHARSET_TEXT
+ FXmCHARSET_TEXT #f 0 FXmOUTPUT_ALL FXmStringUnparse
+ ;
[then]
\ snd-xm.fs ends here
diff --git a/snd-xm.rb b/snd-xm.rb
index 5db571e..1ffa4d5 100644
--- a/snd-xm.rb
+++ b/snd-xm.rb
@@ -1,14 +1,14 @@
# snd-xm.rb -- snd-motif and snd-gtk classes and functions
# Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Wed Feb 25 05:31:02 CET 2004
-# Changed: Sun Feb 20 15:42:45 CET 2011
+# Created: 04/02/25 05:31:02
+# Changed: 14/12/07 06:34:47
-# Commentary:
+# Requires --with-motif|gtk
#
-# Requires --with-motif|gtk and module libxm.so|libxg.so or --with-static-xm|xg!
-#
-# Tested with Snd 11, Motif 2.2.3, Gtk+ 2.20.1, Ruby 1.8.0/7, 1.9.2/3.
+# Tested with Snd 15.x
+# Ruby 2.x.x
+# Motif 2.3.3 X11R6
#
# module Snd_XM
# make_snd_menu(name, args) do ... end
@@ -44,17 +44,6 @@
# add_main_pane(name, type, *args)
# show_disk_space(snd)
#
-# class Level_meter
-# initialize(parent, width, height, args, resizable)
-# inspect
-# make_meter
-# display
-# update_display
-#
-# make_level_meter(parent, width, height, args, resizable)
-# display_level(lm)
-# with_level_meters(n)
-#
# class Scale_widget
# initialize(parent)
# scale
@@ -73,7 +62,7 @@
# clear_string(*args)
#
# class Dialog < Dialog_base
-# add_slider(title, low, init, high, scale, kind, parent) do |w, c, i| ... end
+# add_slider(title, low, init, high, scl, kind, parent) do |w, c, i| ... end
# add_toggle(label, value) do |val| ... end
# add_target(labels) do |val| ... end
#
@@ -123,10 +112,6 @@
# > create
# > display(var)
# >
-# > class Variable_display_meter < Variable_display
-# > create
-# > display(var)
-# >
# > class Variable_display_graph < Variable_display
# > create
# > display(var)
@@ -162,20 +147,18 @@
# separator
# cascade(name, args) do ... end
-# Code:
-
require "clm"
-provided? :snd_motif and (not provided? :xm) and require "libxm.so"
-provided? :snd_gtk and (not provided? :xg) and require "libxg.so"
+$with_motif = provided?(:snd_motif)
+$with_gtk = provided?(:snd_gtk)
-unless provided? :xm or provided? :xg
- Snd.raise(:runtime_error, __FILE__, "file requires --with-motif or --with-gtk \
-and module libxm.so or libxg.so, or --with-static-xm")
+unless $with_motif or $with_gtk
+ Snd.raise(:runtime_error, __FILE__, "--with-motif or --with-gtk required")
end
-$with_motif = provided?(:xm)
-$with_gtk = provided?(:xg)
+if $with_gtk and !provided?(:gtk3)
+ Snd.raise(:runtime_error, __FILE__, "gtk3 required")
+end
#
# --- functions working with Motif as well as with Gtk ---
@@ -230,30 +213,39 @@ module Snd_XM
Edhist = 7
Gsy = 8
Gzy = 9
+ Channel_main_pane = 10
# dialog_widgets
+ Orientation_dialog = 0
+ Enved_dialog = 1
+ Transform_dialog = 2
+ File_open_dialog = 3
+ File_save_as_dialog = 4
+ View_files_dialog = 5
+ Raw_data_dialog = 6
+ New_file_dialog = 7
+ File_mix_dialog = 8
+ Edit_header_dialog = 9
+ Find_dialog = 10
+ Help_dialog = 11
+ Mix_panel_dialog = 12
+ Print_dialog = 13
+ Region_dialog = 14
+ Info_dialog = 15
+ Extra_controls_dialog = 16
+ Save_selection_dialog = 17
+ Insert_file_dialog = 18
+ Save_region_dialog = 19
+ Preferences_dialog = 20
+ #
+ # old names
+ #
Color_dialog = 0
- Orientation_dialog = 1
- Enved_dialog = 2
- Error_dialog = 3
- Yes_or_no_dialog = 4
- Transform_dialog = 5
- File_open_dialog = 6
- File_save_as_dialog = 7
- View_files_dialog = 8
- Raw_data_dialog = 9
- New_file_dialog = 10
- File_mix_dialog = 11
- Edit_header_dialog = 12
- Find_dialog = 13
- Help_dialog = 14
- Completion_dialog = 15
- Mix_panel_dialog = 16
- Print_dialog = 17
- Recorder_dialog = 18
- Region_dialog = 19
- Info_dialog = 20
- Track_dialog = 21
+ Error_dialog = 0
+ Yes_or_no_dialog = 0
+ Completion_dialog = 0
+ Recorder_dialog = 0
+ Track_dialog = 0
# MAKE_MENU as well as MAKE_POPUP_MENU may be used in non-Snd
# scripts. MAKE_SND_MENU and MAKE_SND_POPUP (see popup.rb) are
@@ -295,7 +287,9 @@ module Snd_XM
:info)
unless proc?(help_cb)
if string?(help_str) and !help_str.empty?
- help_cb = lambda do |w, c, i| help_dialog(label, help_str) end
+ help_cb = lambda do |w, c, i|
+ help_dialog(label, help_str)
+ end
end
end
d = Dialog.new(label, ok_cb, reset_cb, clear_cb, target_cb, help_cb)
@@ -390,13 +384,16 @@ module Snd_XM
def update_label(list)
if array?(list) and (not widget?(list))
- list.each do |prc| prc.call end
+ list.each do |prc|
+ prc.call
+ end
end
end
add_help(:find_child,
"find_child(widget, name) \
-returns a widget named 'name', if one can be found in the widget hierarchy beneath 'widget'")
+Returns a widget named NAME, \
+if one can be found in the widget hierarchy beneath WIDGET.")
def find_child(widget, name)
res = false
each_child(widget) do |child|
@@ -417,7 +414,10 @@ returns a widget named 'name', if one can be found in the widget hierarchy benea
end
def set_label_sensitive(widget, name, set_p = false)
- if widget?(wid = Snd.catch(:no_such_widget) do find_child(widget, name) end.first)
+ wid = Snd.catch(:no_such_widget) do
+ find_child(widget, name)
+ end.first
+ if widget?(wid)
set_sensitive(wid, set_p)
end
end
@@ -519,7 +519,8 @@ module Snd_Gtk
if RGTK_IS_LABEL(widget)
Rgtk_label_set_text(RGTK_LABEL(widget), string)
else
- Rgtk_label_set_text(RGTK_LABEL(Rgtk_bin_get_child(RGTK_BIN(widget))), string)
+ c = Rgtk_bin_get_child(RGTK_BIN(widget))
+ Rgtk_label_set_text(RGTK_LABEL(c), string)
end
end
end
@@ -528,7 +529,9 @@ module Snd_Gtk
if widget?(widget)
body.call(widget)
Rgtk_container_foreach(RGTK_CONTAINER(widget),
- lambda do |w, d| body.call(RGTK_WIDGET(w)) end)
+ lambda do |w, d|
+ body.call(RGTK_WIDGET(w))
+ end)
end
end
alias for_each_child each_child
@@ -577,7 +580,7 @@ module Snd_Gtk
# main_widgets[2]
# seem to be of kind GTK_BOX [ms]
def add_main_pane(name, motif_class_not_needed = nil, *motif_args_not_needed)
- pane = Rgtk_hbox_new(false, 0)
+ pane = Rgtk_box_new(RGTK_ORIENTATION_HORIZONTAL, 0)
unless RGTK_IS_BOX(parent = main_widgets[Notebook_outer_pane])
parent = main_widgets[Main_pane_shell]
end
@@ -591,7 +594,10 @@ module Snd_Gtk
end
def show_disk_space(snd)
- unless previous_label = labelled_snds.detect do |n| n.first == snd end
+ previous_label = labelled_snds.detect do |n|
+ n.first == snd
+ end
+ unless previous_label
name_form = sound_widgets[10]
space = kmg(disk_kspace(file_name(snd)))
new_label = Rgtk_label_new(space)
@@ -611,160 +617,6 @@ module Snd_Gtk
Rg_timeout_add(10000, show_label, previous_label)
end
# $after_open_hook.add_hook!("disk-space", &method(:show_disk_space).to_proc)
-
- #
- # level meter
- #
- # with-level-meters, make-level-meter, display-level
-
- class Level_meter
- def initialize(parent, width, height, args = [], resizable = true)
- @parent = parent
- @width = width
- @height = height
- @meter = nil
- @level = 0.0
- @size = 1.0
- @last_level = 0.0
- @red_deg = 0.0
- end
- attr_accessor :level, :size
- attr_reader :width, :height, :meter, :last_level, :red_deg
-
- def inspect
- format("make_level_meter(%s, %s, %s, [], true)", @parent, @width, @height)
- end
-
- def make_meter
- frame = Rgtk_frame_new(false)
- Rgtk_widget_set_size_request(frame, @width, @height)
- Rgtk_box_pack_start(RGTK_BOX(@parent), frame, true, true, 4)
- Rgtk_widget_show(frame)
- @meter = Rgtk_drawing_area_new()
- Rgtk_widget_set_events(@meter, RGDK_EXPOSURE_MASK | RGDK_STRUCTURE_MASK)
- Rgtk_container_add(RGTK_CONTAINER(frame), @meter)
- Rgtk_widget_show(@meter)
- add_event_handler(@meter, "expose_event") do |w, e, d| self.display end
- add_event_handler(@meter, "configure_event") do |w, e, d|
- xy = Rgdk_drawable_get_size(RGDK_DRAWABLE(Rgtk_widget_get_window(w)))
- @width = xy.car
- @height = xy.cadr
- self.display
- end
- end
-
- def display
- win = RGDK_DRAWABLE(Rgtk_widget_get_window(@meter))
- major_tick = (@width / 24.0).round
- ang0 = 45 * 64
- ang1 = 90 * 64
- wid2 = (@width / 2.0).floor
- gc = snd_gcs[0]
- top = (@height / 3.2).round
- Rgdk_gc_set_foreground(gc, white_pixel)
- Rgdk_draw_rectangle(win, gc, true, 0, 0, @width, @height)
- Rgdk_gc_set_foreground(gc, black_pixel)
- Rgdk_draw_arc(win, gc, false, 0, top, @width, @width, ang0, ang1)
- Rgdk_draw_arc(win, gc, false, 0, top - 1, @width, @width, ang0, ang1)
- if @width > 100
- Rgdk_draw_arc(win, gc, false, 0, top - 2, @width, @width, ang0, ang1)
- end
- Rgdk_draw_arc(win, gc, false, 4, top + 4, @width - 8, @width - 8, ang0, ang1)
- 5.times do |i|
- rdeg = degrees2radians(45 - i * 22.5)
- sinr = sin(rdeg)
- cosr = cos(rdeg)
- x0 = (wid2 + wid2 * sinr).round
- y0 = ((wid2 + top) - wid2 * cosr).round
- x1 = (wid2 + (wid2 + major_tick) * sinr).round
- y1 = ((wid2 + top) - (wid2 + major_tick) * cosr).round
- Rgdk_draw_line(win, gc, x0, y0, x1, y1)
- Rgdk_draw_line(win, gc, x0 + 1, y0, x1 + 1, y1)
- if i < 4
- 1.upto(5) do |j|
- rdeg = degrees2radians(45 - i * 22.5 - j * (90.0 / 20.0))
- sinr = sin(rdeg)
- cosr = cos(rdeg)
- x0 = (wid2 * (1.0 + sinr)).round
- y0 = ((wid2 + top) - wid2 * cosr).round
- x1 = (wid2 + (wid2 + major_tick) * sinr).round
- y1 = ((wid2 + top) - (wid2 + major_tick) * cosr).round
- Rgdk_draw_line(win, gc, x0, y0, x1, y1)
- end
- end
- end
- needle_speed = 0.25
- bubble_speed = 0.025
- bubble_size = 15 * 64
- val = @level * needle_speed + @last_level * (1.0 - needle_speed)
- deg = val * 90.0 - 45.0
- rdeg = degrees2radians(deg)
- nx1 = (wid2 + (wid2 + major_tick) * sin(rdeg)).round
- ny1 = ((wid2 + top) - (wid2 + major_tick) * cos(rdeg)).round
- Rgdk_draw_line(win, gc, wid2, top + wid2, nx1, ny1)
- @last_level = val
- @red_deg = if val > @red_deg
- val
- else
- val * bubble_size + @red_deg * (1.0 - bubble_speed)
- end
- if @red_deg > 0.01
- Rgdk_gc_set_foreground(gc, red_pixel)
- redx = (@red_deg * 90.0 * 64).floor
- redy = [redx, bubble_size].min
- 4.times do |i|
- width2 = @width - i * 2
- Rgdk_draw_arc(win, gc, false, i, top + i, width2, width2, 135 * 64 - redx, redy)
- end
- Rgdk_gc_set_foreground(gc, black_pixel)
- end
- end
- end
-
- def make_level_meter(parent, width, height, args = [], resizable = true)
- lm = Level_meter.new(parent, width, height, args, resizable)
- lm.make_meter
- lm
- end
-
- def display_level(lm)
- lm.display
- end
-
- def with_level_meters(n)
- if widget?(parent = (main_widgets[Notebook_outer_pane] or main_widgets[Main_sound_pane]))
- height = n > 2 ? 70 : 85
- window = Rgtk_widget_get_window(parent)
- width = (Rgdk_drawable_get_size(RGDK_DRAWABLE(window)).cadr / Float(n)).floor
- meters = Rgtk_hbox_new(true, 4)
- Rgtk_box_pack_start(RGTK_BOX(parent), meters, false, false, 4)
- Rgtk_widget_set_size_request(meters, width, height)
- Rgtk_widget_show(meters)
- meter_list = make_array(n) do |i| make_level_meter(meters, width, height) end
- $dac_hook.add_hook!(get_func_name) do |sd|
- maxes = sound_data_maxamp(sd)
- meter_list.each_with_index do |meter, i|
- meter.level = (maxes[i] or 0.0)
- meter.display
- end
- end
- if defined? Rg_idle_add
- $stop_dac_hook.add_hook!(get_func_name) do | |
- Rg_idle_add(let(0) do |ctr|
- lambda do |ignored|
- meter_list.each do |meter|
- meter.level = 0.0
- meter.display
- end
- ctr += 1
- ctr < 200
- end
- end, false)
- end
- end
- meter_list
- end
- end
# body.arity == 3
# lambda do |w, e, d| ... end
@@ -772,12 +624,12 @@ module Snd_Gtk
# lambda_data func_data,
# GClosureNotify destroy_data)"
def add_event_handler(parent, event, cb_data = false, &body)
+ t = RG_OBJECT_TYPE(RG_OBJECT(parent))
Rg_signal_connect_closure_by_id(RGPOINTER(parent),
- Rg_signal_lookup(event, RG_OBJECT_TYPE(RG_OBJECT(parent))),
+ Rg_signal_lookup(event, t),
0,
- Rg_cclosure_new(lambda do |w, e, d|
- body.call(w, e, d)
- end, cb_data, false), false)
+ Rg_cclosure_new(body, cb_data, false),
+ false)
end
# body.arity == 2
@@ -806,7 +658,7 @@ module Snd_Gtk
attr_reader :scale
def add_scale(title, low, init, high, scale, kind)
- tbl = Rgtk_table_new(3, 1, false)
+ tbl = Rgtk_grid_new()
Rgtk_box_pack_start(RGTK_BOX(@parent), tbl, false, false, 4)
Rgtk_widget_show(tbl)
@scale = case kind
@@ -816,19 +668,21 @@ module Snd_Gtk
else
Rgtk_adjustment_new(init, low, high, 0.0, 0.0, 0.0)
end
- scl = Rgtk_hscale_new(RGTK_ADJUSTMENT(@scale))
+ scl = Rgtk_scale_new(RGTK_ORIENTATION_HORIZONTAL, RGTK_ADJUSTMENT(@scale))
sclscl = RGTK_SCALE(scl)
- tbltbl = RGTK_TABLE(tbl)
- Rgtk_range_set_update_policy(RGTK_RANGE(sclscl), RGTK_UPDATE_CONTINUOUS)
+ tbltbl = RGTK_GRID(tbl)
+ unless provided?(:GTK3)
+ Rgtk_range_set_update_policy(RGTK_RANGE(sclscl), RGTK_UPDATE_CONTINUOUS)
+ end
Rgtk_scale_set_value_pos(sclscl, RGTK_POS_TOP)
- expand_fill = RGTK_EXPAND | RGTK_FILL
+ # expand_fill = RGTK_EXPAND | RGTK_FILL
case kind
when :log
Rgtk_scale_set_digits(sclscl, 0)
Rgtk_scale_set_draw_value(sclscl, false)
log_lab = Rgtk_label_new("%1.2f" % init)
Rgtk_misc_set_alignment(RGTK_MISC(log_lab), 0.0, 0.0)
- Rgtk_table_attach(tbltbl, log_lab, 0, 1, 0, 1, expand_fill, expand_fill, 0, 0)
+ Rgtk_grid_attach(tbltbl, log_lab, 0, 1, 1, 1)
Rgtk_widget_show(log_lab)
add_callback(@scale, "value_changed") do |w, d|
val = Rgtk_adjustment_get_value(RGTK_ADJUSTMENT(@scale))
@@ -849,9 +703,10 @@ module Snd_Gtk
end
label = Rgtk_label_new(title)
Rgtk_misc_set_alignment(RGTK_MISC(label), 0.0, 0.0)
- Rgtk_table_attach(tbltbl, scl, 0, 1, 1, 2, expand_fill, expand_fill, 0, 0)
+ Rgtk_widget_set_hexpand(scl, true)
+ Rgtk_grid_attach(tbltbl, scl, 1, 1, 1, 1)
Rgtk_widget_show(scl)
- Rgtk_table_attach(tbltbl, label, 0, 1, 2, 3, expand_fill, expand_fill, 0, 0)
+ Rgtk_grid_attach(tbltbl, label, 1, 1, 1, 1)
Rgtk_widget_show(label)
Rgtk_widget_set_name(scl, title)
end
@@ -876,20 +731,28 @@ module Snd_Gtk
Rgtk_window_set_resizable(window, true)
#
box = RGTK_BOX(Rgtk_dialog_get_action_area(RGTK_DIALOG(@dialog)))
- add_event_handler(@dialog, "delete_event") do |w, e, d| Rgtk_widget_hide(@dialog) end
+ add_event_handler(@dialog, "delete_event") do |w, e, d|
+ Rgtk_widget_hide(@dialog)
+ end
Rgtk_box_pack_start(box, @dismiss_button, true, true, 20)
- add_callback(@dismiss_button, "clicked") do |w, d| Rgtk_widget_hide(@dialog) end
+ add_callback(@dismiss_button, "clicked") do |w, d|
+ Rgtk_widget_hide(@dialog)
+ end
Rgtk_widget_show(@dismiss_button)
#
Rgtk_box_pack_start(box, @okay_button, true, true, 20)
- add_callback(@okay_button, "clicked") do |w, d| @ok_cb.call(w, d, nil) end
+ add_callback(@okay_button, "clicked") do |w, d|
+ @ok_cb.call(w, d, nil)
+ end
Rgtk_widget_show(@okay_button)
#
if @reset_cb
@reset_button = Rgtk_button_new_with_label(@reset)
Rgtk_widget_set_name(@reset_button, "reset_button")
Rgtk_box_pack_start(box, @reset_button, true, true, 20)
- add_callback(@reset_button, "clicked") do |w, d| @reset_cb.call(w, d, nil) end
+ add_callback(@reset_button, "clicked") do |w, d|
+ @reset_cb.call(w, d, nil)
+ end
Rgtk_widget_show(@reset_button)
end
#
@@ -897,13 +760,17 @@ module Snd_Gtk
@clear_button = Rgtk_button_new_with_label(@clear)
Rgtk_widget_set_name(@clear_button, "clear_button")
Rgtk_box_pack_start(box, @clear_button, true, true, 20)
- add_callback(@clear_button, "clicked") do |w, d| @clear_cb.call(w, d, nil) end
+ add_callback(@clear_button, "clicked") do |w, d|
+ @clear_cb.call(w, d, nil)
+ end
Rgtk_widget_show(@clear_button)
end
Rgtk_box_pack_start(box, @help_button, true, true, 20)
#
if @help_cb
- add_callback(@help_button, "clicked") do |w, d| @help_cb.call(w, d, nil) end
+ add_callback(@help_button, "clicked") do |w, d|
+ @help_cb.call(w, d, nil)
+ end
end
Rgtk_widget_show(@help_button)
#
@@ -917,7 +784,8 @@ module Snd_Gtk
end
end
#
- Rg_object_set_data(RG_OBJECT(@dialog), "ok-button", RGPOINTER(@okay_button))
+ Rg_object_set_data(RG_OBJECT(@dialog),
+ "ok-button", RGPOINTER(@okay_button))
@parent = Rgtk_dialog_get_content_area(RGTK_DIALOG(@dialog))
end
@@ -927,7 +795,8 @@ module Snd_Gtk
# slider = @dialog.add_slider(...)
# slider.scale --> widget
# slider.label --> label
- def add_slider(title, low, init, high, scale = 1, kind = :linear, parent = @dialog, &func)
+ def add_slider(title, low, init, high,
+ scale = 1, kind = :linear, parent = @dialog, &func)
slider = Scale_widget.new(parent)
slider.add_scale(title, low, init, high, scale, kind)
add_callback(slider.scale, "value_changed") do |w, d|
@@ -950,7 +819,7 @@ module Snd_Gtk
def add_target(labels = [["entire sound", :sound, true],
["selection", :selection, false],
["between marks", :marks, false]], &target_cb)
- rc = Rgtk_hbox_new(false, 0)
+ rc = Rgtk_box_new(RGTK_ORIENTATION_HORIZONTAL, 0)
Rgtk_box_pack_start(RGTK_BOX(@parent), rc, false, false, 4)
Rgtk_widget_show(rc)
group = false
@@ -960,7 +829,9 @@ module Snd_Gtk
Rgtk_box_pack_start(RGTK_BOX(rc), button, false, false, 4)
Rgtk_toggle_button_set_active(RGTK_TOGGLE_BUTTON(button), on)
Rgtk_widget_show(button)
- add_callback(button, "clicked") do |w, d| target_cb.call(type) end
+ add_callback(button, "clicked") do |w, d|
+ target_cb.call(type)
+ end
end
end
end
@@ -977,7 +848,10 @@ module Snd_Motif
def create_color(color)
col = RXColor()
dpy = RXtDisplay(main_widgets[Top_level_shell])
- if RXAllocNamedColor(dpy, RDefaultColormap(dpy, RDefaultScreen(dpy)), color, col, col).zero?
+ c = RXAllocNamedColor(dpy,
+ RDefaultColormap(dpy, RDefaultScreen(dpy)),
+ color, col, col)
+ if c.zero?
Snd.raise(:no_such_color, color, "can't allocate")
else
Rpixel(col)
@@ -998,8 +872,12 @@ module Snd_Motif
RXmStringFree(xs)
end
- add_help(:each_child, "each_child(w, &func) applies func to w and each of its children")
- add_help(:for_each_child, "for_each_child(w, &func) applies func to w and each of its children")
+ add_help(:each_child,
+ "each_child(w, &func) \
+Applies FUNC to W and each of its children.")
+ add_help(:for_each_child,
+ "for_each_child(w, &func) \
+Applies FUNC to W and each of its children.")
def each_child(widget, &body)
if RWidget?(widget)
body.call(widget)
@@ -1050,10 +928,8 @@ module Snd_Motif
end
def add_main_pane(name, type, *args)
- RXtCreateManagedWidget(name,
- type,
- (main_widgets[Notebook_outer_pane] or main_widgets[Main_sound_pane]),
- *args)
+ w = main_widgets[Notebook_outer_pane] or main_widgets[Main_sound_pane]
+ RXtCreateManagedWidget(name, type, w, *args)
end
def add_sound_pane(snd, name, type, *args)
@@ -1061,8 +937,8 @@ module Snd_Motif
end
def add_channel_pane(snd, chn, name, type, *args)
- RXtCreateManagedWidget(name, type, RXtParent(RXtParent(channel_widgets(snd, chn)[Edhist])),
- *args)
+ xp = RXtParent(RXtParent(channel_widgets(snd, chn)[Edhist]))
+ RXtCreateManagedWidget(name, type, xp, *args)
end
# string must be freed
@@ -1072,7 +948,8 @@ module Snd_Motif
end
def compound2string(xstr)
- RXmStringUnparse(xstr, false, RXmCHARSET_TEXT, RXmCHARSET_TEXT, false, 0, RXmOUTPUT_ALL)
+ RXmStringUnparse(xstr, false, RXmCHARSET_TEXT, RXmCHARSET_TEXT,
+ false, 0, RXmOUTPUT_ALL)
end
def get_xtvalue(widget, item)
@@ -1084,13 +961,15 @@ module Snd_Motif
end
add_help(:current_screen,
- "current_screen() returns the current X screen number of the current display")
+ "current_screen() \
+Returns the current X screen number of the current display.")
def current_screen
RDefaultScreenOfDisplay(RXtDisplay(main_widgets[Top_level_shell]))
end
def get_pixmap(screen, file)
- pix = RXmGetPixmap(screen, file, RBlackPixelOfScreen(screen), RWhitePixelOfScreen(screen))
+ pix = RXmGetPixmap(screen, file, RBlackPixelOfScreen(screen),
+ RWhitePixelOfScreen(screen))
if pix == RXmUNSPECIFIED_PIXMAP
Snd.raise(:snd_x_error, pix, "can't create pixmap")
else
@@ -1104,7 +983,7 @@ module Snd_Motif
add_help(:display_widget_tree,
"display_widget_tree(widget, spaces=\"\") \
-displays the hierarchy of widgets beneath 'widget'" )
+Displays the hierarchy of widgets beneath WIDGET." )
def display_widget_tree(widget, spaces = "")
if (name = RXtName(widget)).null?
name = "<unnamed>"
@@ -1119,16 +998,20 @@ displays the hierarchy of widgets beneath 'widget'" )
add_help(:show_disk_space,
"show_disk_space(snd) \
-adds a label to the minibuffer area showing \
-the current free space (for use with $after_open_hook)")
+Adds a label to the minibuffer area showing \
+the current free space (for use with $after_open_hook).")
def show_disk_space(snd)
- unless previous_label = labelled_snds.detect do |n| n.first == snd end
+ previous_label = labelled_snds.detect do |n|
+ n.first == snd
+ end
+ unless previous_label
app = main_widgets[Top_level_application]
minibuffer = sound_widgets(snd)[Minibuffer]
name_form = RXtParent(minibuffer)
space = kmg(disk_kspace(file_name(snd)))
str = RXmStringCreateLocalized(space)
- new_label = RXtCreateManagedWidget("space:", RxmLabelWidgetClass, name_form,
+ new_label = RXtCreateManagedWidget("space:",
+ RxmLabelWidgetClass, name_form,
[RXmNbackground, basic_color,
RXmNleftAttachment, RXmATTACH_WIDGET,
RXmNleftWidget, minibuffer,
@@ -1153,7 +1036,8 @@ the current free space (for use with $after_open_hook)")
# $after_open_hook.add_hook!("disk-space", &method(:show_disk_space).to_proc)
add_help(:menu_option,
- "menu_option(name) finds the widget associated with a given menu item name")
+ "menu_option(name) \
+Finds the widget associated with a given menu item NAME.")
def menu_option(name)
menu_widgets.cdr.each do |top_menu|
each_child(top_menu) do |w|
@@ -1178,7 +1062,8 @@ the current free space (for use with $after_open_hook)")
end
add_help(:set_main_color_of_widget,
- "set_main_color_of_widget(widget) sets the background color of WIDGET")
+ "set_main_color_of_widget(widget) \
+Sets the background color of WIDGET.")
def set_main_color_of_widget(w)
each_child(w) do |n|
if RXtIsWidget(n)
@@ -1249,32 +1134,38 @@ the current free space (for use with $after_open_hook)")
RXmNorientation, RXmVERTICAL,
RXmNpaneMinimum, 100,
RXmNbottomAttachment, RXmATTACH_FORM])
- mark_label = RXtCreateManagedWidget("Marks", RxmLabelWidgetClass, mark_box,
- [RXmNbackground, highlight_color,
- RXmNleftAttachment, RXmATTACH_FORM,
- RXmNrightAttachment, RXmATTACH_FORM,
- RXmNalignment, RXmALIGNMENT_CENTER,
- RXmNtopAttachment, RXmATTACH_FORM])
- mark_scr = RXtCreateManagedWidget("mark-scr", RxmScrolledWindowWidgetClass, mark_box,
- [RXmNbackground, basic_color,
- RXmNscrollingPolicy, RXmAUTOMATIC,
- RXmNscrollBarDisplayPolicy, RXmSTATIC,
- RXmNleftAttachment, RXmATTACH_FORM,
- RXmNrightAttachment, RXmATTACH_FORM,
- RXmNtopAttachment, RXmATTACH_WIDGET,
- RXmNtopWidget, mark_label,
- RXmNbottomAttachment, RXmATTACH_FORM])
- mlist = RXtCreateManagedWidget("mark-list", RxmRowColumnWidgetClass, mark_scr,
- [RXmNorientation, RXmVERTICAL,
- RXmNtopAttachment, RXmATTACH_FORM,
- RXmNbottomAttachment, RXmATTACH_FORM,
- RXmNspacing, 0])
+ ls = [RXmNbackground, highlight_color,
+ RXmNleftAttachment, RXmATTACH_FORM,
+ RXmNrightAttachment, RXmATTACH_FORM,
+ RXmNalignment, RXmALIGNMENT_CENTER,
+ RXmNtopAttachment, RXmATTACH_FORM]
+ mark_label = RXtCreateManagedWidget("Marks",
+ RxmLabelWidgetClass, mark_box, ls)
+ ls = [RXmNbackground, basic_color,
+ RXmNscrollingPolicy, RXmAUTOMATIC,
+ RXmNscrollBarDisplayPolicy, RXmSTATIC,
+ RXmNleftAttachment, RXmATTACH_FORM,
+ RXmNrightAttachment, RXmATTACH_FORM,
+ RXmNtopAttachment, RXmATTACH_WIDGET,
+ RXmNtopWidget, mark_label,
+ RXmNbottomAttachment, RXmATTACH_FORM]
+ mark_scr = RXtCreateManagedWidget("mark-scr",
+ RxmScrolledWindowWidgetClass,
+ mark_box, ls)
+ ls = [RXmNorientation, RXmVERTICAL,
+ RXmNtopAttachment, RXmATTACH_FORM,
+ RXmNbottomAttachment, RXmATTACH_FORM,
+ RXmNspacing, 0]
+ mlist = RXtCreateManagedWidget("mark-list",
+ RxmRowColumnWidgetClass, mark_scr, ls)
set_main_color_of_widget(mark_scr)
RXtSetValues(mark_box, [RXmNpaneMinimum, 1])
set_list(snd, chn, mlist)
end
lst = list(snd, chn)
- if (new_marks = Snd.marks(snd, chn)).length > (current_list_length = length(snd, chn))
+ new_marks = Snd.marks(snd, chn)
+ current_list_length = @mark_list_lengths.length
+ if new_marks.length > current_list_length
current_list_length.upto(new_marks.length) do
tf = RXtCreateWidget("field", RxmTextFieldWidgetClass, lst,
[RXmNbackground, basic_color])
@@ -1298,9 +1189,13 @@ the current free space (for use with $after_open_hook)")
RXtSetValues(w, [RXmNbackground, basic_color])
end)
RXtAddEventHandler(tf, REnterWindowMask, false,
- lambda do |w, c, i, f| $mouse_enter_text_hook.call(w) end)
+ lambda do |w, c, i, f|
+ $mouse_enter_text_hook.call(w)
+ end)
RXtAddEventHandler(tf, RLeaveWindowMask, false,
- lambda do |w, c, i, f| $mouse_leave_text_hook.call(w) end)
+ lambda do |w, c, i, f|
+ $mouse_leave_text_hook.call(w)
+ end)
end
end
set_length(snd, chn, new_marks.length)
@@ -1308,8 +1203,7 @@ the current free space (for use with $after_open_hook)")
break if new_marks.empty?
if RXmIsTextField(n)
mk = new_marks.shift
- RXtSetValues(n, [RXmNvalue, mark_sample(mk).to_s,
- RXmNuserData, mk])
+ RXtSetValues(n, [RXmNvalue, mark_sample(mk).to_s, RXmNuserData, mk])
RXtManageChild(n)
end
end
@@ -1330,7 +1224,10 @@ the current free space (for use with $after_open_hook)")
private
def find(snd, chn, dats)
- if val = dats.detect do |dat| snd == dat.car and chn == dat.cadr end
+ val = dats.detect do |dat|
+ snd == dat.car and chn == dat.cadr
+ end
+ if val
val.caddr
else
false
@@ -1342,7 +1239,9 @@ the current free space (for use with $after_open_hook)")
end
def set_length(snd, chn, len)
- @mark_list_lengths.delete_if do |dat| snd == dat.car and chn == dat.cadr end
+ @mark_list_lengths.delete_if do |dat|
+ snd == dat.car and chn == dat.cadr
+ end
@mark_list_lengths.push([snd, chn, len])
end
@@ -1351,183 +1250,6 @@ the current free space (for use with $after_open_hook)")
end
end
- #
- # level meter
- #
- # with-level-meters, make-level-meter, display-level
-
- class Level_meter
- def initialize(parent, width, height, args, resizable = true)
- @parent = parent
- @width = width
- @height = height
- @args = args
- @resizable = resizable
- @meter = nil
- @level = 0.0
- @size = 1.0
- @last_level = 0.0
- @red_deg = 0.0
- end
- attr_accessor :level, :size
- attr_reader :width, :height, :meter, :last_level, :red_deg
-
- def inspect
- format("make_level_meter(%s, %s, %s, %s, %s)", @parent, @width, @height, @args, @resizable)
- end
-
- def make_meter
- frame = RXtCreateManagedWidget("meter-frame", RxmFrameWidgetClass, @parent,
- @args + [RXmNshadowType, RXmSHADOW_ETCHED_IN,
- RXmNwidth, @width,
- RXmNheight, @height,
- RXmNshadowThickness, (@width > 500 ? 6 : 3)])
- meter_args = [RXmNbackground, white_pixel,
- RXmNforeground, black_pixel,
- RXmNtopAttachment, RXmATTACH_FORM,
- RXmNbottomAttachment, RXmATTACH_FORM,
- RXmNleftAttachment, RXmATTACH_FORM,
- RXmNrightAttachment, RXmATTACH_FORM]
- if @resizable
- meter_args + [RXmNwidth, @width, RXmNheight, @height, RXmNresizePolicy, RXmRESIZE_NONE]
- end
- @meter = RXtCreateManagedWidget("meter", RxmDrawingAreaWidgetClass, frame, meter_args)
- RXtAddCallback(@meter, RXmNexposeCallback, lambda do |w, c, i| self.display end)
-
- if @resizable
- RXtAddCallback(@meter, RXmNresizeCallback,
- lambda do |w, c, i|
- @width = RXtGetValues(w, [RXmNwidth, 0])[1]
- @height = RXtGetValues(w, [RXmNheight, 0])[1]
- self.display
- end)
- end
- end
-
- def display
- dpy = RXtDisplay(@meter)
- win = RXtWindow(@meter)
- major_tick = (@width / 24.0).round
- ang0 = 45 * 64
- ang1 = 90 * 64
- wid2 = (@width / 2.0).floor
- gc = snd_gcs[0]
- top = (@height / 3.2).round
- RXSetForeground(dpy, gc, white_pixel)
- RXFillRectangle(dpy, win, gc, 0, 0, @width, @height)
- RXSetForeground(dpy, gc, black_pixel)
- RXDrawArc(dpy, win, gc, 0, top, @width, @width, ang0, ang1)
- RXDrawArc(dpy, win, gc, 0, top - 2, @width, @width, ang0, ang1)
- if @width > 100
- RXDrawArc(dpy, win, gc, 0, top - 2, @width, @width, ang0, ang1)
- end
- RXDrawArc(dpy, win, gc, 4, top + 4, @width - 8, @width - 8, ang0, ang1)
- 5.times do |i|
- rdeg = degrees2radians(45 - i * 22.5)
- sinr = sin(rdeg)
- cosr = cos(rdeg)
- x0 = (wid2 + wid2 * sinr).round
- y0 = ((wid2 + top) - wid2 * cosr).round
- x1 = (wid2 + (wid2 + major_tick) * sinr).round
- y1 = ((wid2 + top) - (wid2 + major_tick) * cosr).round
- RXDrawLine(dpy, win, gc, x0, y0, x1, y1)
- RXDrawLine(dpy, win, gc, x0 + 1, y0, x1 + 1, y1)
- if i < 4
- 1.upto(5) do |j|
- rdeg = degrees2radians(45 - i * 22.5 - j * (90.0 / 20.0))
- sinr = sin(rdeg)
- cosr = cos(rdeg)
- x0 = (wid2 * (1.0 + sinr)).round
- y0 = ((wid2 + top) - wid2 * cosr).round
- x1 = (wid2 + (wid2 + major_tick) * sinr).round
- y1 = ((wid2 + top) - (wid2 + major_tick) * cosr).round
- RXDrawLine(dpy, win, gc, x0, y0, x1, y1)
- end
- end
- end
- needle_speed = 0.25
- bubble_speed = 0.025
- bubble_size = 15 * 64
- val = @level * needle_speed + @last_level * (1.0 - needle_speed)
- deg = val * 90.0 - 45.0
- rdeg = degrees2radians(deg)
- nx1 = (wid2 + (wid2 + major_tick) * sin(rdeg)).round
- ny1 = ((wid2 + top) - (wid2 + major_tick) * cos(rdeg)).round
- RXDrawLine(dpy, win, gc, wid2, top + wid2, nx1, ny1)
- @last_level = val
- @red_deg = if val > @red_deg
- val
- else
- val * bubble_size + @red_deg * (1.0 - bubble_speed)
- end
- if @red_deg > 0.01
- RXSetForeground(dpy, gc, red_pixel)
- redx = (@red_deg * 90.0 * 64).floor
- redy = [redx, bubble_size].min
- 4.times do |i|
- RXDrawArc(dpy, win, gc, i, top + i, @width - i * 2, @width - i * 2, 135 * 64 - redx, redy)
- end
- RXSetForeground(dpy, gc, black_pixel)
- end
- end
-
- def update_display
- RXmUpdateDisplay(@meter)
- end
- end
-
- def make_level_meter(parent, width, height, args, resizable = true)
- lm = Level_meter.new(parent, width, height, args, resizable)
- lm.make_meter
- lm
- end
-
- def display_level(lm)
- lm.display
- end
-
- def with_level_meters(n)
- parent = (main_widgets[Notebook_outer_pane] or main_widgets[Main_sound_pane])
- height = 70
- width = (RXtGetValues(parent, [RXmNwidth, 0])[1] / Float(n)).floor
- meters = RXtCreateManagedWidget("meters", RxmFormWidgetClass, parent,
- [RXmNpositionIndex, 0,
- RXmNbackground, basic_color,
- RXmNfractionBase, n * 10,
- RXmNpaneMinimum, height])
- meter_list = make_array(n) do |i|
- make_level_meter(meters, width, height,
- [RXmNtopAttachment, RXmATTACH_FORM,
- RXmNbottomAttachment, RXmATTACH_FORM,
- RXmNleftAttachment, RXmATTACH_POSITION,
- RXmNleftPosition, i * 10,
- RXmNrightAttachment, RXmATTACH_POSITION,
- RXmNrightPosition, (i + 1) * 10])
- end
- $dac_hook.add_hook!(get_func_name) do |sd|
- maxes = sound_data_maxamp(sd)
- meter_list.each_with_index do |meter, i|
- meter.level = (maxes[i] or 0.0)
- meter.display
- end
- end
- $stop_dac_hook.add_hook!(get_func_name) do
- RXtAppAddWorkProc(main_widgets[Top_level_shell],
- let(0) do |ctr|
- lambda do |ignored|
- meter_list.each do |meter|
- meter.level = 0.0
- meter.display
- end
- ctr += 1
- ctr > 200
- end
- end)
- end
- RXtSetValues(meters, [RXmNpaneMinimum, 1])
- meter_list
- end
-
class Variable_display
include Snd_XM
@@ -1535,7 +1257,7 @@ the current free space (for use with $after_open_hook)")
@name = page_name
@variable = variable_name
@@dialog = nil unless defined? @@dialog
- @@pages = {} unless defined? @@pages
+ @@pages = {} unless defined? @@pages
@@notebook = nil unless defined? @@notebook
@widget = nil
@snd = false
@@ -1556,7 +1278,8 @@ the current free space (for use with $after_open_hook)")
def make_dialog
xdismiss = RXmStringCreateLocalized("Dismiss")
titlestr = RXmStringCreateLocalized("Variables")
- @@dialog = RXmCreateTemplateDialog(main_widgets[Top_level_shell], "variables-dialog",
+ @@dialog = RXmCreateTemplateDialog(main_widgets[Top_level_shell],
+ "variables-dialog",
[RXmNokLabelString, xdismiss,
RXmNautoUnmanage, false,
RXmNdialogTitle, titlestr,
@@ -1566,34 +1289,43 @@ the current free space (for use with $after_open_hook)")
RXmNheight, 400,
RXmNwidth, 400,
RXmNbackground, basic_color])
- RXtAddCallback(@@dialog, RXmNokCallback, lambda do |w, c, i| RXtUnmanageChild(@@dialog) end)
+ RXtAddCallback(@@dialog, RXmNokCallback,
+ lambda do |w, c, i|
+ RXtUnmanageChild(@@dialog)
+ end)
RXmStringFree(xdismiss)
RXmStringFree(titlestr)
- @@notebook = RXtCreateManagedWidget("variables-notebook", RxmNotebookWidgetClass, @@dialog,
- [RXmNleftAttachment, RXmATTACH_FORM,
- RXmNrightAttachment, RXmATTACH_FORM,
- RXmNtopAttachment, RXmATTACH_FORM,
- RXmNbottomAttachment, RXmATTACH_WIDGET,
- RXmNbottomWidget,
- RXmMessageBoxGetChild(@@dialog, RXmDIALOG_SEPARATOR),
- RXmNbackground, basic_color,
- RXmNframeBackground, zoom_color,
- RXmNbindingWidth, 14])
+ ls = [RXmNleftAttachment, RXmATTACH_FORM,
+ RXmNrightAttachment, RXmATTACH_FORM,
+ RXmNtopAttachment, RXmATTACH_FORM,
+ RXmNbottomAttachment, RXmATTACH_WIDGET,
+ RXmNbottomWidget,
+ RXmMessageBoxGetChild(@@dialog, RXmDIALOG_SEPARATOR),
+ RXmNbackground, basic_color,
+ RXmNframeBackground, zoom_color,
+ RXmNbindingWidth, 14]
+ @@notebook = RXtCreateManagedWidget("variables-notebook",
+ RxmNotebookWidgetClass, @@dialog, ls)
RXtManageChild(@@dialog)
- @default_background = RWhitePixelOfScreen(RDefaultScreenOfDisplay(RXtDisplay(@@dialog)))
+ c = RDefaultScreenOfDisplay(RXtDisplay(@@dialog))
+ @default_background = RWhitePixelOfScreen(c)
end
def create
- unless RWidget?(@@dialog) then make_dialog end
+ unless RWidget?(@@dialog)
+ make_dialog
+ end
unless @@pages[@name]
- panes = RXtCreateManagedWidget(@name, RxmPanedWindowWidgetClass, @@notebook, [])
- simple_cases = RXtCreateManagedWidget(@name, RxmRowColumnWidgetClass, panes,
+ panes = RXtCreateManagedWidget(@name, RxmPanedWindowWidgetClass,
+ @@notebook, [])
+ simple_cases = RXtCreateManagedWidget(@name,
+ RxmRowColumnWidgetClass, panes,
[RXmNorientation, RXmVERTICAL,
- RXmNpaneMinimum, 30,
- RXmNbackground, basic_color])
+ RXmNpaneMinimum, 30,
+ RXmNbackground, basic_color])
RXtCreateManagedWidget(@name, RxmPushButtonWidgetClass, @@notebook,
[RXmNnotebookChildType, RXmMAJOR_TAB,
- RXmNbackground, basic_color])
+ RXmNbackground, basic_color])
@@pages[@name] = [@name, panes, simple_cases]
end
@@pages[@name]
@@ -1615,12 +1347,14 @@ the current free space (for use with $after_open_hook)")
row = RXtCreateManagedWidget(@variable + "-row",
RxmRowColumnWidgetClass, row_pane,
[RXmNorientation, RXmHORIZONTAL,
- RXmNbackground, basic_color])
- RXtCreateManagedWidget(var_label, RxmLabelWidgetClass, row, [RXmNbackground, basic_color])
- @widget = RXtCreateManagedWidget(@variable + "-value", RxmTextFieldWidgetClass, row,
+ RXmNbackground, basic_color])
+ RXtCreateManagedWidget(var_label, RxmLabelWidgetClass, row,
+ [RXmNbackground, basic_color])
+ @widget = RXtCreateManagedWidget(@variable + "-value",
+ RxmTextFieldWidgetClass, row,
[RXmNeditable, false,
- RXmNresizeWidth, true,
- RXmNbackground, @default_background])
+ RXmNresizeWidth, true,
+ RXmNbackground, @default_background])
end
def display(var)
@@ -1628,7 +1362,9 @@ the current free space (for use with $after_open_hook)")
new_str = var.to_s
if old_str != new_str
RXmTextFieldSetString(@widget, new_str)
- if RXtIsManaged(@widget) then RXmUpdateDisplay(@widget) end
+ if RXtIsManaged(@widget)
+ RXmUpdateDisplay(@widget)
+ end
end
var
end
@@ -1649,16 +1385,20 @@ the current free space (for use with $after_open_hook)")
row_pane = page_info[2]
var_label = @variable + ":"
title = RXmStringCreateLocalized(var_label)
- @widget = RXtCreateManagedWidget(@variable, RxmScaleWidgetClass, row_pane,
+ @widget = RXtCreateManagedWidget(@variable,
+ RxmScaleWidgetClass, row_pane,
[RXmNbackground, basic_color,
- RXmNslidingMode, RXmTHERMOMETER,
- RXmNminimum, (100.0 * @range[0]).floor,
- RXmNmaximum, (100.0 * @range[1]).floor,
- RXmNdecimalPoints, 2,
- RXmNtitleString, title,
- RXmNorientation, RXmHORIZONTAL,
+ RXmNslidingMode, RXmTHERMOMETER,
+ RXmNminimum, (100.0 * @range[0]).floor,
+ RXmNmaximum, (100.0 * @range[1]).floor,
+ RXmNdecimalPoints, 2,
+ RXmNtitleString, title,
+ RXmNorientation, RXmHORIZONTAL,
RXmNshowValue, RXmNEAR_BORDER])
- if widget?(wid = Snd.catch(:no_such_widget) do find_child(@widget, "Scrollbar") end.first)
+ wid = Snd.catch(:no_such_widget) do
+ find_child(@widget, "Scrollbar")
+ end.first
+ if widget?(wid)
RXtVaSetValues(wid, [RXmNtroughColor, red_pixel])
end
RXmStringFree(title)
@@ -1670,25 +1410,6 @@ the current free space (for use with $after_open_hook)")
end
end
- class Variable_display_meter < Variable_display
- def create
- page_info = super
- row_pane = page_info[2]
- var_label = @variable + ":"
- height = 70
- width = 210
- RXtCreateManagedWidget(var_label, RxmLabelWidgetClass, row_pane, [RXmNbackground, basic_color])
- @widget = make_level_meter(row_pane, width, height, [], false)
- end
-
- def display(var)
- @widget.level = var
- @widget.display
- @widget.update_display
- var
- end
- end
-
class Variable_display_graph < Variable_display
def create
page_info = super
@@ -1696,16 +1417,21 @@ the current free space (for use with $after_open_hook)")
var_label = @variable + ":"
form = RXtCreateManagedWidget(var_label, RxmFormWidgetClass, pane,
[RXmNpaneMinimum, 100])
- @snd = make_variable_graph(form, @variable + ": time", 2048, mus_srate.to_i)
+ @snd = make_variable_graph(form, @variable + ": time",
+ 2048, mus_srate.to_i)
@data = channel_data(@snd, 0)
end
def display(var)
frames = @data.length
loc = cursor(snd, 0)
- @data[0, loc] = var
- if time_graph?(@snd) then update_time_graph(@snd) end
- if transform_graph?(@snd) then update_transform_graph(@snd) end
+ @data[loc] = var
+ if time_graph?(@snd)
+ update_time_graph(@snd)
+ end
+ if transform_graph?(@snd)
+ update_transform_graph(@snd)
+ end
if loc + 1 == frames
set_cursor(0, @snd, 0)
else
@@ -1737,9 +1463,13 @@ the current free space (for use with $after_open_hook)")
def display(var)
frames = @data.length
loc = cursor(snd, 0)
- @data[0, loc] = var
- if time_graph?(@snd) then update_time_graph(@snd) end
- if transform_graph?(@snd) then update_transform_graph(@snd) end
+ @data[loc] = var
+ if time_graph?(@snd)
+ update_time_graph(@snd)
+ end
+ if transform_graph?(@snd)
+ update_transform_graph(@snd)
+ end
if loc + 1 == frames
set_cursor(0, @snd, 0)
else
@@ -1754,14 +1484,13 @@ the current free space (for use with $after_open_hook)")
end
end
- def make_variable_display(page_name, variable_name, type = :text, range = [0.0, 1.0])
+ def make_variable_display(page_name, variable_name,
+ type = :text, range = [0.0, 1.0])
case type
when :text
Variable_display_text.new(page_name, variable_name)
when :scale
Variable_display_scale.new(page_name, variable_name, range)
- when :meter
- Variable_display_meter.new(page_name, variable_name)
when :graph
Variable_display_graph.new(page_name, variable_name)
when :spectrum
@@ -1804,33 +1533,41 @@ the current free space (for use with $after_open_hook)")
RXmNbackground, highlight_color])
case kind
when :log
- @label = RXtCreateManagedWidget(format("%1.2f", init),
- RxmLabelWidgetClass, rc,
+ s = format("%1.2f", init),
+ @label = RXtCreateManagedWidget(s, RxmLabelWidgetClass, rc,
[RXmNalignment, RXmALIGNMENT_BEGINNING,
RXmNbackground, basic_color])
@scale = general_scale(rc, title, xtitle)
- RXtVaSetValues(@scale, [RXmNmaximum, $log_scale_ticks,
- RXmNvalue, scale_log2linear(low, init, high).round])
+ RXtVaSetValues(@scale,
+ [RXmNmaximum, $log_scale_ticks,
+ RXmNvalue, scale_log2linear(low, init, high).round])
RXtAddCallback(@scale, RXmNvalueChangedCallback,
lambda do |w, c, i|
- change_label(@label, scale_log_label(low, Rvalue(i), high))
+ change_label(@label,
+ scale_log_label(low, Rvalue(i), high))
end)
RXtAddCallback(@scale, RXmNdragCallback,
lambda do |w, c, i|
- change_label(@label, scale_log_label(low, Rvalue(i), high))
+ change_label(@label,
+ scale_log_label(low, Rvalue(i), high))
end)
when :semi
- @label = RXtCreateManagedWidget(format("semitones: %d", ratio2semitones(init)),
- RxmLabelWidgetClass, rc,
+ s = format("semitones: %d", ratio2semitones(init))
+ @label = RXtCreateManagedWidget(s, RxmLabelWidgetClass, rc,
[RXmNalignment, RXmALIGNMENT_BEGINNING,
RXmNbackground, basic_color])
@scale = general_scale(rc, title, xtitle)
- RXtVaSetValues(@scale, [RXmNmaximum, 2 * $semi_range,
- RXmNvalue, $semi_range + ratio2semitones(init)])
+ RXtVaSetValues(@scale,
+ [RXmNmaximum, 2 * $semi_range,
+ RXmNvalue, $semi_range + ratio2semitones(init)])
RXtAddCallback(@scale, RXmNvalueChangedCallback,
- lambda do |w, c, i| change_label(@label, semi_scale_label(Rvalue(i))) end)
+ lambda do |w, c, i|
+ change_label(@label, semi_scale_label(Rvalue(i)))
+ end)
RXtAddCallback(@scale, RXmNdragCallback,
- lambda do |w, c, i| change_label(@label, semi_scale_label(Rvalue(i))) end)
+ lambda do |w, c, i|
+ change_label(@label, semi_scale_label(Rvalue(i)))
+ end)
else
@scale = linear_scale(rc, title, xtitle, low, init, high, scale)
end
@@ -1901,27 +1638,42 @@ the current free space (for use with $after_open_hook)")
[[RXmDIALOG_HELP_BUTTON, highlight_color],
[RXmDIALOG_CANCEL_BUTTON, highlight_color],
[RXmDIALOG_OK_BUTTON, highlight_color]].each do |button, color|
- RXtVaSetValues(RXmMessageBoxGetChild(@dialog, button), [RXmNarmColor, selection_color,
- RXmNbackground, color])
+ RXtVaSetValues(RXmMessageBoxGetChild(@dialog, button),
+ [RXmNarmColor, selection_color,
+ RXmNbackground, color])
end
RXtAddCallback(@dialog, RXmNcancelCallback,
- lambda do |w, c, i| RXtUnmanageChild(@dialog) end)
+ lambda do |w, c, i|
+ RXtUnmanageChild(@dialog)
+ end)
RXtAddCallback(@dialog, RXmNhelpCallback,
- lambda do |w, c, i| @help_cb.call(w, c, i) end)
+ lambda do |w, c, i|
+ @help_cb.call(w, c, i)
+ end)
RXtAddCallback(@dialog, RXmNokCallback,
- lambda do |w, c, i| @ok_cb.call(w, c, i) end)
+ lambda do |w, c, i|
+ @ok_cb.call(w, c, i)
+ end)
vals = [RXmNbackground, highlight_color,
RXmNforeground, black_pixel,
RXmNarmColor, selection_color]
if @clear_cb
- @clear_button = RXtCreateManagedWidget(@clear, RxmPushButtonWidgetClass, @dialog, vals)
+ @clear_button = RXtCreateManagedWidget(@clear,
+ RxmPushButtonWidgetClass,
+ @dialog, vals)
RXtAddCallback(@clear_button, RXmNactivateCallback,
- lambda do |w, c, i| @clear_cb.call(w, c, i) end)
+ lambda do |w, c, i|
+ @clear_cb.call(w, c, i)
+ end)
end
if @reset_cb
- @reset_button = RXtCreateManagedWidget(@reset, RxmPushButtonWidgetClass, @dialog, vals)
+ @reset_button = RXtCreateManagedWidget(@reset,
+ RxmPushButtonWidgetClass,
+ @dialog, vals)
RXtAddCallback(@reset_button, RXmNactivateCallback,
- lambda do |w, c, i| @reset_cb.call(w, c, i) end)
+ lambda do |w, c, i|
+ @reset_cb.call(w, c, i)
+ end)
end
@help_button = RXmMessageBoxGetChild(@dialog, RXmDIALOG_HELP_BUTTON)
@dismiss_button = RXmMessageBoxGetChild(@dialog, RXmDIALOG_CANCEL_BUTTON)
@@ -1937,7 +1689,8 @@ the current free space (for use with $after_open_hook)")
RXtSetSensitive(@okay_button, (not Snd.sounds.empty?))
end
end
- @parent = RXtCreateManagedWidget("pane", RxmPanedWindowWidgetClass, @dialog,
+ @parent = RXtCreateManagedWidget("pane",
+ RxmPanedWindowWidgetClass, @dialog,
[RXmNsashHeight, 1,
RXmNsashWidth, 1,
RXmNbackground, basic_color,
@@ -1952,11 +1705,14 @@ the current free space (for use with $after_open_hook)")
# slider = @dialog.add_slider(...)
# slider.scale --> widget
# slider.label --> label
- def add_slider(title, low, init, high, scale = 1, kind = :linear, parent = @parent, &func)
+ def add_slider(title, low, init, high,
+ scale = 1, kind = :linear, parent = @parent, &func)
slider = Scale_widget.new(parent)
slider.add_scale(title, low, init, high, scale, kind)
unless proc?(func) and func.arity == 3
- func = lambda do |w, c, i| func.call end
+ func = lambda do |w, c, i|
+ func.call
+ end
end
RXtAddCallback(slider.scale, RXmNvalueChangedCallback, func)
slider
@@ -1964,13 +1720,16 @@ the current free space (for use with $after_open_hook)")
# change_cb.arity == 1
def add_toggle(label = "truncate at end", value = true, &change_cb)
- button = RXtCreateManagedWidget(label, RxmToggleButtonWidgetClass, @parent,
+ button = RXtCreateManagedWidget(label,
+ RxmToggleButtonWidgetClass, @parent,
[RXmNbackground, basic_color,
RXmNalignment, RXmALIGNMENT_BEGINNING,
RXmNset, value,
RXmNselectColor, yellow_pixel])
RXtAddCallback(button, RXmNvalueChangedCallback,
- lambda do |w, c, i| change_cb.call(Rset(i)) end)
+ lambda do |w, c, i|
+ change_cb.call(Rset(i))
+ end)
h = get_xtvalue(button, RXmNheight)
h += (h * 0.1).round
RXtVaSetValues(button, [RXmNpaneMinimum, h, RXmNpaneMaximum, h])
@@ -1985,21 +1744,21 @@ the current free space (for use with $after_open_hook)")
[RXmNorientation, RXmHORIZONTAL,
RXmNseparatorType, RXmSHADOW_ETCHED_OUT,
RXmNbackground, basic_color])
- rc = RXtCreateManagedWidget("rc", RxmRowColumnWidgetClass, @parent,
- [RXmNorientation, RXmHORIZONTAL,
- RXmNbackground, basic_color,
- RXmNradioBehavior, true,
- RXmNradioAlwaysOne, true,
- RXmNbottomAttachment, RXmATTACH_FORM,
- RXmNleftAttachment, RXmATTACH_FORM,
- RXmNrightAttachment, RXmATTACH_FORM,
- RXmNentryClass, RxmToggleButtonWidgetClass,
- RXmNisHomogeneous, true])
+ ls = [RXmNorientation, RXmHORIZONTAL,
+ RXmNbackground, basic_color,
+ RXmNradioBehavior, true,
+ RXmNradioAlwaysOne, true,
+ RXmNbottomAttachment, RXmATTACH_FORM,
+ RXmNleftAttachment, RXmATTACH_FORM,
+ RXmNrightAttachment, RXmATTACH_FORM,
+ RXmNentryClass, RxmToggleButtonWidgetClass,
+ RXmNisHomogeneous, true]
+ rc = RXtCreateManagedWidget("rc", RxmRowColumnWidgetClass, @parent, ls)
labels.map do |name, type, on|
RXtCreateManagedWidget(name, RxmToggleButtonWidgetClass, rc,
- [RXmNbackground, basic_color,
- RXmNselectColor, yellow_pixel,
- RXmNset, on,
+ [RXmNbackground, basic_color,
+ RXmNselectColor, yellow_pixel,
+ RXmNset, on,
RXmNindicatorType, RXmONE_OF_MANY_ROUND,
RXmNarmCallback, [lambda do |w, c, i|
target_cb.call(type)
@@ -2035,13 +1794,21 @@ the current free space (for use with $after_open_hook)")
RXmNbackground, basic_color])
RXtAddCallback(text_field, RXmNactivateCallback, activate_cb)
RXtAddCallback(text_field, RXmNfocusCallback,
- lambda do |w, c, i| RXtSetValues(w, [RXmNbackground, text_focus_color]) end)
+ lambda do |w, c, i|
+ RXtSetValues(w, [RXmNbackground, text_focus_color])
+ end)
RXtAddCallback(text_field, RXmNlosingFocusCallback,
- lambda do |w, c, i| RXtSetValues(w, [RXmNbackground, basic_color]) end)
+ lambda do |w, c, i|
+ RXtSetValues(w, [RXmNbackground, basic_color])
+ end)
RXtAddEventHandler(text_field, REnterWindowMask, false,
- lambda do |w, c, i, f| $mouse_enter_text_hook.call(w) end)
+ lambda do |w, c, i, f|
+ $mouse_enter_text_hook.call(w)
+ end)
RXtAddEventHandler(text_field, RLeaveWindowMask, false,
- lambda do |w, c, i, f| $mouse_leave_text_hook.call(w) end)
+ lambda do |w, c, i, f|
+ $mouse_leave_text_hook.call(w)
+ end)
text_field
end
@@ -2051,7 +1818,8 @@ the current free space (for use with $after_open_hook)")
[:columns, 60],
[:wordwrap, true],
[:value, ""],
- [:scroll_horizontal, false])
+ [:scroll_horizontal,
+ false])
text = RXmCreateScrolledText(@parent, "text",
[RXmNtopAttachment, RXmATTACH_WIDGET,
RXmNeditMode, RXmMULTI_LINE_EDIT,
@@ -2062,13 +1830,21 @@ the current free space (for use with $after_open_hook)")
RXmNvalue, value,
RXmNbackground, basic_color])
RXtAddCallback(text, RXmNfocusCallback,
- lambda do |w, c, i| RXtSetValues(w, [RXmNbackground, text_focus_color]) end)
+ lambda do |w, c, i|
+ RXtSetValues(w, [RXmNbackground, text_focus_color])
+ end)
RXtAddCallback(text, RXmNlosingFocusCallback,
- lambda do |w, c, i| RXtSetValues(w, [RXmNbackground, basic_color]) end)
+ lambda do |w, c, i|
+ RXtSetValues(w, [RXmNbackground, basic_color])
+ end)
RXtAddEventHandler(text, REnterWindowMask, false,
- lambda do |w, c, i, f| $mouse_enter_text_hook.call(w) end)
+ lambda do |w, c, i, f|
+ $mouse_enter_text_hook.call(w)
+ end)
RXtAddEventHandler(text, RLeaveWindowMask, false,
- lambda do |w, c, i, f| $mouse_leave_text_hook.call(w) end)
+ lambda do |w, c, i, f|
+ $mouse_leave_text_hook.call(w)
+ end)
RXtManageChild(text)
text
end
@@ -2166,7 +1942,9 @@ make_snd_menu("Effects") do
entry(Modulated_echo, "Modulated echo")
end
separator
- entry("Octave-down") do down_oct end
+ entry("Octave-down") do
+ down_oct
+ end
entry("Remove DC") do
lastx = lasty = 0.0
map_chan(lambda do |inval|
@@ -2175,7 +1953,9 @@ make_snd_menu("Effects") do
lasty
end)
end
- entry("Spiker") do spike end
+ entry("Spiker") do
+ spike
+ end
end
=end
@@ -2190,8 +1970,8 @@ class Menu
attr_reader :menu
def inspect
- format("#<%s: label: %s, menu: %s, args: %s>",
- self.class, @label.inspect, @menu.inspect, @args.inspect)
+ format("#<%s: label: %p, menu: %p, args: %p>",
+ self.class, @label, @menu, @args)
end
def entry(name, *rest, &body)
@@ -2203,15 +1983,17 @@ class Menu
child = RXtCreateManagedWidget(name, widget_class, @menu, args)
case widget_class
when RxmPushButtonWidgetClass
- RXtAddCallback(child, RXmNactivateCallback, lambda do |w, c, i| body.call(w, c, i) end)
+ RXtAddCallback(child, RXmNactivateCallback, body)
when RxmToggleButtonWidgetClass
- RXtAddCallback(child, RXmNvalueChangedCallback, lambda do |w, c, i| body.call(w, c, i) end)
+ RXtAddCallback(child, RXmNvalueChangedCallback, body)
end
else
child = Rgtk_menu_item_new_with_label(name)
Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), child)
Rgtk_widget_show(child)
- add_callback(child, "activate") do |w, d| body.call(w, d, nil) end
+ add_callback(child, "activate") do |w, d|
+ body.call(w, d, nil)
+ end
end
child
end
@@ -2231,7 +2013,8 @@ class Menu
def separator(single = :single)
if $with_motif
line = (single == :double ? RXmDOUBLE_LINE : RXmSINGLE_LINE)
- RXtCreateManagedWidget("s", RxmSeparatorWidgetClass, @menu, [RXmNseparatorType, line])
+ RXtCreateManagedWidget("s", RxmSeparatorWidgetClass, @menu,
+ [RXmNseparatorType, line])
else
sep = Rgtk_menu_item_new()
Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), sep)
@@ -2250,9 +2033,13 @@ class Menu
def change_menu_color(new_color)
color_pixel = get_color(new_color)
if $with_motif
- each_child(@menu) do |child| RXmChangeColor(child, color_pixel) end
+ each_child(@menu) do |child|
+ RXmChangeColor(child, color_pixel)
+ end
else
- each_child(@menu) do |child| Rgtk_widget_modify_bg(child, RGTK_STATE_NORMAL, color_pixel) end
+ each_child(@menu) do |child|
+ Rgtk_widget_modify_bg(child, RGTK_STATE_NORMAL, color_pixel)
+ end
end
end
end
@@ -2275,8 +2062,12 @@ class Snd_main_menu < Menu
menu = arg.new(*rest)
if menu.respond_to?(:post_dialog)
if $with_motif
- child = RXtCreateManagedWidget(rest[0].to_s, RxmPushButtonWidgetClass, @menu, @args)
- RXtAddCallback(child, RXmNactivateCallback, lambda do |w, c, i| menu.post_dialog end)
+ child = RXtCreateManagedWidget(rest[0].to_s,
+ RxmPushButtonWidgetClass, @menu, @args)
+ RXtAddCallback(child, RXmNactivateCallback,
+ lambda do |w, c, i|
+ menu.post_dialog
+ end)
else
child = Rgtk_menu_item_new_with_label(rest[0].to_s)
Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), child)
@@ -2287,11 +2078,12 @@ class Snd_main_menu < Menu
end
child
else
- Snd.raise(:snd_x_error, arg.class, "class does not respond to `post_dialog'")
+ Snd.raise(:snd_x_error, arg.class,
+ "class does not respond to `post_dialog'")
end
else
if block_given?
- add_to_menu(@menu_number, arg, lambda do | | body.call end)
+ add_to_menu(@menu_number, arg, body)
else
Snd.raise(:wrong_number_of_args, "no block given")
end
@@ -2314,14 +2106,18 @@ class Snd_main_menu < Menu
@children = []
if $with_motif
@menu = RXmCreatePulldownMenu(parent, @label, @args)
- cascade = RXtCreateManagedWidget(@label, RxmCascadeButtonWidgetClass, parent,
+ cascade = RXtCreateManagedWidget(@label,
+ RxmCascadeButtonWidgetClass,
+ parent,
[RXmNsubMenuId, @menu] + @args)
RXtAddCallback(cascade, RXmNcascadingCallback,
- lambda do |w, c, i| update_label(@children) end)
+ lambda do |w, c, i|
+ update_label(@children)
+ end)
else
cascade = Rgtk_menu_item_new_with_label(@label)
- Rgtk_menu_shell_append(RGTK_MENU_SHELL(Rgtk_menu_item_get_submenu(RGTK_MENU_ITEM(parent))),
- cascade)
+ s = RGTK_MENU_SHELL(Rgtk_menu_item_get_submenu(RGTK_MENU_ITEM(parent)))
+ Rgtk_menu_shell_append(s, cascade)
Rgtk_widget_show(cascade)
@menu = Rgtk_menu_new()
Rgtk_menu_item_set_submenu(RGTK_MENU_ITEM(cascade), @menu)
@@ -2337,8 +2133,13 @@ class Snd_main_menu < Menu
menu = arg.new(*rest)
if menu.respond_to?(:post_dialog)
if $with_motif
- child = RXtCreateManagedWidget(rest[0].to_s, RxmPushButtonWidgetClass, @menu, @args)
- RXtAddCallback(child, RXmNactivateCallback, lambda do |w, c, i| menu.post_dialog end)
+ child = RXtCreateManagedWidget(rest[0].to_s,
+ RxmPushButtonWidgetClass,
+ @menu, @args)
+ RXtAddCallback(child, RXmNactivateCallback,
+ lambda do |w, c, i|
+ menu.post_dialog
+ end)
else
child = Rgtk_menu_item_new_with_label(rest[0].to_s)
Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), child)
@@ -2347,15 +2148,23 @@ class Snd_main_menu < Menu
menu.post_dialog
end
end
- @children.push(lambda do | | change_label(child, menu.inspect) end)
+ @children.push(lambda do | |
+ change_label(child, menu.inspect)
+ end)
else
- Snd.raise(:snd_x_error, arg.class, "class does not respond to `post_dialog'")
+ Snd.raise(:snd_x_error, arg.class,
+ "class does not respond to `post_dialog'")
end
else
if block_given?
if $with_motif
- child = RXtCreateManagedWidget(arg.to_s, RxmPushButtonWidgetClass, @menu, @args)
- RXtAddCallback(child, RXmNactivateCallback, lambda do |w, c, i| body.call end)
+ child = RXtCreateManagedWidget(arg.to_s,
+ RxmPushButtonWidgetClass,
+ @menu, @args)
+ RXtAddCallback(child, RXmNactivateCallback,
+ lambda do |w, c, i|
+ body.call
+ end)
else
child = Rgtk_menu_item_new_with_label(arg.to_s)
Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), child)
@@ -2375,7 +2184,8 @@ class Snd_main_menu < Menu
def separator(single = :single)
if $with_motif
line = (single == :double ? RXmDOUBLE_LINE : RXmSINGLE_LINE)
- RXtCreateManagedWidget("s", RxmSeparatorWidgetClass, @menu, [RXmNseparatorType, line])
+ RXtCreateManagedWidget("s", RxmSeparatorWidgetClass, @menu,
+ [RXmNseparatorType, line])
else
sep = Rgtk_menu_item_new()
Rgtk_menu_shell_append(RGTK_MENU_SHELL(@menu), sep)
@@ -2396,13 +2206,15 @@ class Main_menu < Menu
RXtVaSetValues(parent, [RXmNmenuHelpWidget, wid]) if name =~ /help/
else
wid = Rgtk_menu_item_new_with_label(@label)
- Rgtk_menu_shell_append(RGTK_MENU_SHELL(Rgtk_menu_item_get_submenu(RGTK_MENU_ITEM(parent))),
- wid)
+ s = RGTK_MENU_SHELL(Rgtk_menu_item_get_submenu(RGTK_MENU_ITEM(parent)))
+ Rgtk_menu_shell_append(s, wid)
Rgtk_widget_show(wid)
@menu = Rgtk_menu_new()
Rgtk_menu_item_set_submenu(RGTK_MENU_ITEM(wid), @menu)
end
- instance_eval(&body) if block_given?
+ if block_given?
+ instance_eval(&body)
+ end
end
end
@@ -2437,7 +2249,9 @@ class Main_popup_menu < Menu
label(@label)
separator
end
- instance_eval(&body) if block_given?
+ if block_given?
+ instance_eval(&body)
+ end
end
end
diff --git a/snd-xmain.c b/snd-xmain.c
deleted file mode 100644
index 4f1886a..0000000
--- a/snd-xmain.c
+++ /dev/null
@@ -1,945 +0,0 @@
-#include "snd.h"
-
-#define FALLBACK_FONT "fixed"
-#define DEFAULT_FONTLIST "9x15"
-#define HIGHLIGHT_COLOR "ivory1"
-#define BASIC_COLOR "ivory2"
-#define POSITION_COLOR "ivory3"
-#define ZOOM_COLOR "ivory4"
-#define CURSOR_COLOR "red"
-#define SELECTION_COLOR "lightsteelblue1"
-#define ENVED_WAVEFORM_COLOR "blue"
-#define MIX_COLOR "darkgray"
-#define GRAPH_COLOR "white"
-#define SELECTED_GRAPH_COLOR "white"
-#define DATA_COLOR "black"
-#define SELECTED_DATA_COLOR "black"
-#define MARK_COLOR "red"
-#define LISTENER_COLOR "AliceBlue"
-#define LISTENER_TEXT_COLOR "black"
-#define LIGHT_BLUE_COLOR "lightsteelblue1"
-#define LIGHTER_BLUE_COLOR "AliceBlue"
-#define WHITE_COLOR "white"
-#define BLACK_COLOR "black"
-#define GREEN_COLOR "green2"
-#define RED_COLOR "red"
-#define YELLOW_COLOR "yellow"
-#define TEXT_FOCUS_COLOR "white"
-#define FILTER_CONTROL_WAVEFORM_COLOR "blue"
-#define SASH_COLOR "lightgreen"
-#define CHANNEL_SASH_INDENT -10
-#define CHANNEL_SASH_SIZE 0
-/* 0 means: use Motif default size */
-
-#define POSITION_SLIDER_WIDTH 13
-#define ZOOM_SLIDER_WIDTH 10
-#if (!HAVE_LINUX)
- #define TOGGLE_SIZE 0
-#else
- #define TOGGLE_SIZE 15
-#endif
-#define CHANNEL_MIN_HEIGHT 150 /* open size (set to 5 immediately thereafter) */
- /* paned window default setup is not very smart, so we force these to be this size to begin with */
- /* this number is only a first approximation -- we try not to expand below the screen */
- /* if too small (i.e. 100), the scrollbars are sometimes messed up on the initial layout */
-
-#define SASH_SIZE 16
-#define SASH_INDENT -20
-#define AUTO_RESIZE_DEFAULT 1
-
-#define INITIAL_WINDOW_WIDTH 700
-#define INITIAL_WINDOW_HEIGHT 300
-
-
-#ifndef SND_AS_WIDGET
-static void window_close(Widget w, XtPointer context, XtPointer info)
-{
- /* this is called from the window manager close event, not (exit) or the File:Exit item */
- snd_exit_cleanly(EXIT_FORCED);
-}
-#endif
-
-
-#if (!HAVE_FAM)
-static XtIntervalId auto_update_proc = 0;
-
-static void auto_update_check(XtPointer context, XtIntervalId *id)
-{
- if (auto_update_interval(ss) > 0.0)
- {
- if (!(play_in_progress()))
- for_each_sound(sound_not_current);
- auto_update_proc = XtAppAddTimeOut(MAIN_APP(ss),
- (unsigned long)(auto_update_interval(ss) * 1000),
- (XtTimerCallbackProc)auto_update_check,
- context);
- }
- else auto_update_proc = 0;
-}
-
-
-void auto_update_restart(void)
-{
- if (auto_update_proc == 0)
- auto_update_proc = XtAppAddTimeOut(MAIN_APP(ss),
- (unsigned long)(auto_update_interval(ss) * 1000),
- (XtTimerCallbackProc)auto_update_check,
- (XtPointer)NULL);
-}
-#else
-void auto_update_restart(void) {}
-#endif
-
-
-#ifndef SND_AS_WIDGET
-/* handle iconification */
-static Widget *iconify_active_dialogs = NULL;
-
-static void minify_maxify_window(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XMapEvent *ev = (XMapEvent *)event;
- int i;
- if ((!ss) || (!(ss->dialogs)))
- return;
-
- /* ev->type can be several things, but the ones we care about here are
- * MapNotify and UnmapNotify. Snd dialogs are "windows" in X-jargon, so
- * when the main window is minimized (iconified), other active dialogs
- * aren't also closed unless we mess with them explicitly here. We keep
- * a list of created dialogs, and depend on XtIsManaged to tell us which
- * ones need to be unmanaged. But, if the user has several "desks", a change
- * of desk can also generate an unmap event, and if we dismiss the dialogs,
- * they don't come back upon remap; if we save a list of live dialogs, they
- * don't return to their previous location upon being re-managed. We
- * need to see just iconfication events here, but there's no way I can
- * see to distinguish an iconify event from a desk event (WM_STATE atom state
- * of property changed event is identical etc), so I'll do what I can...
- * This problem may be a side-effect of using non-transient dialogs:
- * perhaps XSetTransientFor would handle this more cleanly?
- *
- * Also, ideally we'd equalize/relative-panes upon maxify, but ICCC thinks maxify
- * is the same as map (i.e. from iconified state), and the only difference
- * I can see in the mwm code is the window size.
- *
- * a rumor in the air that what we need is to catch StructureNotify event, then
- * check in that for UnmapNotify
- */
- if (ev->type == UnmapNotify)
- {
- if (iconify_active_dialogs) free(iconify_active_dialogs);
- iconify_active_dialogs = (Widget *)calloc(ss->num_dialogs, sizeof(Widget));
-
- for (i = 0; i < ss->num_dialogs; i++)
- if (ss->dialogs[i])
- {
- if (XtIsManaged(ss->dialogs[i]))
- iconify_active_dialogs[i] = ss->dialogs[i];
- XtUnmanageChild(ss->dialogs[i]);
- }
- }
- else
- {
- if (ev->type == MapNotify)
- {
- if (iconify_active_dialogs)
- {
- for (i = 0; i < ss->num_dialogs; i++)
- if (iconify_active_dialogs[i])
- XtManageChild(iconify_active_dialogs[i]);
-
- free(iconify_active_dialogs);
- iconify_active_dialogs = NULL;
- }
- }
- }
-}
-#endif
-
-
-#if HAVE_SETJMP_H
-#include <setjmp.h>
-
-#if MUS_TRAP_SEGFAULT
-/* stolen from scwm.c */
-static sigjmp_buf envHandleEventsLoop;
-
-static void segv(int ignored)
-{
- siglongjmp(envHandleEventsLoop, 1);
-}
-#endif
-
-static jmp_buf top_level_jump;
-
-void top_level_catch(int ignore);
-void top_level_catch(int ignore)
-{
- longjmp(top_level_jump, 1);
-}
-
-
-#if MUS_DEBUGGING
-static void trap_xt_error(String message)
-{
- fprintf(stderr, "%s", message);
- XEN_ERROR(XEN_ERROR_TYPE("xt-error"),
- XEN_LIST_2(C_TO_XEN_STRING("Xt error: ~A"),
- C_TO_XEN_STRING(message)));
-}
-#endif
-#endif
-
-
-static char **auto_open_file_names = NULL;
-static int auto_open_files = 0;
-static bool noglob = false, noinit = false, batch = false, nostdin = false;
-
-#if HAVE_EXTENSION_LANGUAGE
-static XtInputId stdin_id = 0;
-
-static void get_stdin_string(XtPointer context, int *fd, XtInputId *id)
-{
- int size;
- ssize_t bytes;
- char *buf;
- buf = (char *)calloc(1024, sizeof(char));
- size = 1024;
- bytes = read(*fd, buf, 1024);
- if (bytes <= 0)
- {
- /* redirected to /dev/null?? -- apparently in kde/kfm the process is started without stdin? */
- XtRemoveInput(stdin_id);
- stdin_id = 0;
- }
- else
- {
- while (bytes == 1024)
- {
- size += 1024;
- buf = (char *)realloc(buf, size);
- bytes = read(*fd, (char *)(buf + size - 1024), 1024);
- }
- snd_eval_stdin_str(buf);
- }
- free(buf);
-}
-#endif
-
-
-static void startup_funcs(void)
-{
-#ifndef SND_AS_WIDGET
- Atom wm_delete_window;
-#endif
- snd_info *sp;
- static int auto_open_ctr = 0;
- Widget shell;
- Display *dpy;
- shell = ss->mainshell;
- dpy = MAIN_DISPLAY(ss);
-
-#ifndef SND_AS_WIDGET
-#ifndef __alpha__
- add_menu_drop();
-#endif
-
- /* trap outer-level Close for cleanup check */
- wm_delete_window = XmInternAtom(dpy, (char *)"WM_DELETE_WINDOW", false);
- XmAddWMProtocolCallback(shell, wm_delete_window, window_close, NULL);
- XtAddEventHandler(shell, StructureNotifyMask, false, minify_maxify_window, NULL);
-#endif
-
- ss->graph_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), in_graph_cursor(ss));
- ss->wait_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_watch);
- ss->bounds_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_sb_h_double_arrow);
- ss->play_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_sb_right_arrow);
- ss->loop_play_cursor = XCreateFontCursor(XtDisplay(MAIN_SHELL(ss)), XC_sb_left_arrow);
-
-#if HAVE_EXTENSION_LANGUAGE
- snd_load_init_file(noglob, noinit);
-#endif
-
-#if HAVE_SIGNAL && HAVE_EXTENSION_LANGUAGE && !__MINGW32__
- if (!nostdin)
- {
- signal(SIGTTIN, SIG_IGN);
- signal(SIGTTOU, SIG_IGN);
- /* these signals are sent by a shell if we start Snd as a background process,
- * but try to read stdin (needed to support the emacs subjob connection). If
- * we don't do this, the background job is suspended when the shell sends SIGTTIN.
- */
- stdin_id = XtAppAddInput(MAIN_APP(ss),
- STDIN_FILENO,
- (XtPointer)XtInputReadMask,
- get_stdin_string,
- NULL);
- }
-#endif
-
- while (auto_open_ctr < auto_open_files)
- auto_open_ctr = handle_next_startup_arg(auto_open_ctr, auto_open_file_names, false, auto_open_files);
-
- if (ss->init_window_width > 0) set_widget_width(MAIN_SHELL(ss), ss->init_window_width);
- if (ss->init_window_height > 0) set_widget_height(MAIN_SHELL(ss), ss->init_window_height);
- if (ss->init_window_x != DEFAULT_INIT_WINDOW_X) set_widget_x(MAIN_SHELL(ss), ss->init_window_x);
- if (ss->init_window_y != DEFAULT_INIT_WINDOW_Y) set_widget_y(MAIN_SHELL(ss), ss->init_window_y);
-
-#if (!HAVE_FAM)
- if (auto_update_interval(ss) > 0.0)
- XtAppAddTimeOut(MAIN_APP(ss),
- (unsigned long)(auto_update_interval(ss) * 1000),
- auto_update_check,
- NULL);
-#endif
-
-#if MUS_TRAP_SEGFAULT
- if (trap_segfault(ss)) signal(SIGSEGV, segv);
-#endif
-
- if ((ss->sounds) &&
- (ss->selected_sound == NO_SELECTION))
- {
- sp = ss->sounds[0];
- if ((sp) &&
- (sp->inuse == SOUND_NORMAL) &&
- (sp->selected_channel == NO_SELECTION)) /* don't clobber possible select-channel in loaded startup files */
- select_channel(sp, 0);
- }
-
- if ((ss->init_window_height == 0) && (sound_style(ss) == SOUNDS_HORIZONTAL))
- set_widget_height(MAIN_SHELL(ss), 200); /* otherwise it's just a title bar! */
-}
-
-
-#ifndef SND_AS_WIDGET
-#include <X11/xpm.h>
-
-static void SetupIcon(Widget shell)
-{
- Display *dpy;
- Window root;
- int status, scr;
- Pixmap pix, mask;
- XpmAttributes attributes;
- dpy = XtDisplay(shell);
- root = DefaultRootWindow(dpy);
- scr = DefaultScreen(dpy);
- XtVaGetValues(shell, XmNdepth, &attributes.depth, XmNcolormap, &attributes.colormap, NULL);
- attributes.visual = DefaultVisual(dpy, scr);
- attributes.valuemask = XpmDepth | XpmColormap | XpmVisual;
- status = XpmCreatePixmapFromData(dpy, root, (char **)snd_icon_bits(), &pix, &mask, &attributes);
- if (mask) XFreePixmap(dpy, mask);
- XtVaSetValues(shell, XmNiconPixmap, pix, NULL);
-}
-#endif
-
-
-#ifndef SND_AS_WIDGET
-static void muffle_warning(char *name, char *type, char *klass, char *defaultp, char **params, unsigned int *num_params)
-{
-#if 0
- int i;
- fprintf(stderr, "Xt warning: %s, %s: %s", type, name, defaultp);
- if (num_params) /* can be null! */
- for (i = 0; i < (int)(*num_params); i++)
- fprintf(stderr, " %s", params[i]);
- fprintf(stderr, "\n");
-#endif
-}
-#endif
-
-
-static void notebook_page_changed_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* if page chosen via major tab click, select that sound */
- XmNotebookCallbackStruct *nb = (XmNotebookCallbackStruct *)info;
- Widget page;
- if ((nb->reason == XmCR_MAJOR_TAB) && (nb->page_widget))
- {
- int index = 0;
- snd_info *sp;
- page = nb->page_widget;
- if (page)
- {
- pointer_or_int_t data;
- XtVaGetValues(page, XmNuserData, &data, NULL);
- index = (int)data;
- if ((index < ss->max_sounds) &&
- (snd_ok(ss->sounds[index])))
- {
- sp = ss->sounds[index];
- if (sp->selected_channel == NO_SELECTION)
- select_channel(ss->sounds[index], 0);
- else select_channel(ss->sounds[index], sp->selected_channel);
- }
- }
- }
-}
-
-
-color_t get_in_between_color(color_t fg, color_t bg)
-{
- Colormap cmap;
- Display *dpy;
- int scr;
- XColor fg_color, bg_color, new_color;
- dpy = MAIN_DISPLAY(ss);
- scr = DefaultScreen(dpy);
- cmap = DefaultColormap(dpy, scr);
- fg_color.flags = DoRed | DoGreen | DoBlue;
- fg_color.pixel = fg;
- XQueryColor(dpy, cmap, &fg_color);
- bg_color.flags = DoRed | DoGreen | DoBlue;
- bg_color.pixel = bg;
- XQueryColor(dpy, cmap, &bg_color);
- new_color.flags = DoRed | DoGreen | DoBlue;
- new_color.red = (rgb_t)((fg_color.red + (2 * bg_color.red)) / 3);
- new_color.green = (rgb_t)((fg_color.green + (2 * bg_color.green)) / 3);
- new_color.blue = (rgb_t)((fg_color.blue + (2 * bg_color.blue)) / 3);
- if ((XAllocColor(dpy, cmap, &new_color)) == 0)
- return(fg);
- return(new_color.pixel);
-}
-
-
-static Pixel get_color(Widget shell, const char *defined_color,
- const char *fallback_color, const char *second_fallback_color, bool use_white)
-{
- Colormap cmap;
- Display *dpy;
- int scr;
- XColor tmp_color, ignore;
-
- dpy = XtDisplay(shell);
- scr = DefaultScreen(dpy);
- cmap = DefaultColormap(dpy, scr);
- /* I suppose we could use XQueryColors and search for the closest available, or try yet again to get XCreateColormap to behave itself */
-
- if ((!XAllocNamedColor(dpy, cmap, defined_color, &tmp_color, &ignore)) &&
- ((!fallback_color) ||
- (!XAllocNamedColor(dpy, cmap, fallback_color, &tmp_color, &ignore))) &&
- ((!second_fallback_color) ||
- (!XAllocNamedColor(dpy, cmap, second_fallback_color, &tmp_color, &ignore))))
- {
- /* snd_error here causes a seg fault (it builds on mainpane which has not yet been created) */
- if (use_white)
- {
- fprintf(stderr, "can't get color %s -- will use white\n", defined_color);
- return(WhitePixel(dpy, scr));
- }
- else
- {
- fprintf(stderr, "can't get color %s -- will use black\n", defined_color);
- return(BlackPixel(dpy, scr));
- }
- }
- return(tmp_color.pixel);
-}
-
-
-static void save_a_color(FILE *Fp, Display *dpy, Colormap cmap, const char *name, Pixel pix, const char *ext_name)
-{
-#if HAVE_EXTENSION_LANGUAGE
- Status lookup_ok;
- XColor default_color, ignore;
-
- lookup_ok = XLookupColor(dpy, cmap, name, &default_color, &ignore);
- if (lookup_ok)
- {
- XColor current_color;
- current_color.flags = DoRed | DoGreen | DoBlue;
- current_color.pixel = pix;
- XQueryColor(dpy, cmap, ¤t_color);
- if ((current_color.red != default_color.red) ||
- (current_color.green != default_color.green) ||
- (current_color.blue != default_color.blue))
-
-#if HAVE_FORTH
- fprintf(Fp, "%.3f %.3f %.3f %s set-%s drop\n",
- RGB_TO_FLOAT(current_color.red),
- RGB_TO_FLOAT(current_color.green),
- RGB_TO_FLOAT(current_color.blue),
- S_make_color,
- ext_name);
-#else
-
-#if HAVE_SCHEME
- fprintf(Fp, "(set! (%s) (%s %.3f %.3f %.3f))\n",
-#endif
-
-#if HAVE_RUBY
- fprintf(Fp, "set_%s(%s(%.3f, %.3f, %.3f))\n",
-#endif
- TO_PROC_NAME(ext_name),
- TO_PROC_NAME(S_make_color),
- RGB_TO_FLOAT(current_color.red),
- RGB_TO_FLOAT(current_color.green),
- RGB_TO_FLOAT(current_color.blue));
-#endif
- }
-#endif
-}
-
-
-void save_colors(FILE *Fp)
-{
- Colormap cmap;
- Display *dpy;
- int scr;
-
- dpy = XtDisplay(ss->mainshell);
- scr = DefaultScreen(dpy);
- cmap = DefaultColormap(dpy, scr);
-
- save_a_color(Fp, dpy, cmap, BASIC_COLOR, ss->basic_color, S_basic_color);
- save_a_color(Fp, dpy, cmap, CURSOR_COLOR, ss->cursor_color, S_cursor_color);
- save_a_color(Fp, dpy, cmap, DATA_COLOR, ss->data_color, S_data_color);
- save_a_color(Fp, dpy, cmap, SELECTED_DATA_COLOR, ss->selected_data_color, S_selected_data_color);
- save_a_color(Fp, dpy, cmap, HIGHLIGHT_COLOR, ss->highlight_color, S_highlight_color);
- save_a_color(Fp, dpy, cmap, POSITION_COLOR, ss->position_color, S_position_color);
- save_a_color(Fp, dpy, cmap, ZOOM_COLOR, ss->zoom_color, S_zoom_color);
- save_a_color(Fp, dpy, cmap, SELECTION_COLOR, ss->selection_color, S_selection_color);
- save_a_color(Fp, dpy, cmap, MIX_COLOR, ss->mix_color, S_mix_color);
- save_a_color(Fp, dpy, cmap, ENVED_WAVEFORM_COLOR, ss->enved_waveform_color, S_enved_waveform_color);
- save_a_color(Fp, dpy, cmap, LISTENER_COLOR, ss->listener_color, S_listener_color);
- save_a_color(Fp, dpy, cmap, LISTENER_TEXT_COLOR, ss->listener_text_color, S_listener_text_color);
- save_a_color(Fp, dpy, cmap, GRAPH_COLOR, ss->graph_color, S_graph_color);
- save_a_color(Fp, dpy, cmap, SELECTED_GRAPH_COLOR, ss->selected_graph_color, S_selected_graph_color);
- save_a_color(Fp, dpy, cmap, MARK_COLOR, ss->mark_color, S_mark_color);
- save_a_color(Fp, dpy, cmap, SASH_COLOR, ss->sash_color, S_sash_color);
- save_a_color(Fp, dpy, cmap, TEXT_FOCUS_COLOR, ss->text_focus_color, S_text_focus_color);
- save_a_color(Fp, dpy, cmap, FILTER_CONTROL_WAVEFORM_COLOR, ss->filter_control_waveform_color, S_filter_control_waveform_color);
-}
-
-
-#ifdef SND_AS_WIDGET
-
-void snd_as_widget(int argc, char **argv, XtAppContext app, Widget parent, Arg *caller_args, int caller_argn)
-{
-
-#else
-
-static char *fallbacks[] = {
- (char *)"*fontList: " DEFAULT_FONTLIST,
- (char *)"*enableEtchedInMenu: True",
- (char *)"*enableThinThickness: True",
- (char *)"*enableToggleColor: True",
- (char *)"*enableToggleVisual: True",
- NULL
-};
-
-
-void snd_doit(int argc, char **argv)
-{
- XtAppContext app;
-#endif
- Widget shell;
- Display *dpy;
- Drawable wn;
- Arg args[32];
- int i, n, err = 0;
- Widget menu;
- XGCValues gv;
- char *app_title = NULL;
-
-#ifdef SND_AS_WIDGET
- ss = snd_main(argc, argv);
-#else
- XtSetLanguageProc(NULL, NULL, NULL);
-#endif
-
- ss->channel_min_height = CHANNEL_MIN_HEIGHT;
- ss->Graph_Cursor = DEFAULT_GRAPH_CURSOR;
-
-#ifndef SND_AS_WIDGET
-#ifndef __alpha__
- XtSetArg(args[0], XtNwidth, INITIAL_WINDOW_WIDTH);
- XtSetArg(args[1], XtNheight, INITIAL_WINDOW_HEIGHT);
- shell = XtAppInitialize(&app, "Snd", NULL, 0, &argc, argv, fallbacks, args, 2);
-#else
- shell = XtVaOpenApplication(&app, "Snd", NULL, 0, &argc, argv, fallbacks, applicationShellWidgetClass,
- XmNallowShellResize, AUTO_RESIZE_DEFAULT,
- NULL);
-#endif
-
- /* if user has *keyboardFocusPolicy: Pointer in .Xdefaults, it can screw up Snd's attempt to
- * keep the channel graphics window as the active widget in case of keyboard input. So,
- * we try to force Snd's focus policy to be XmEXPLICIT
- */
- XtVaGetValues(shell, XmNkeyboardFocusPolicy, &err, NULL);
- if (err != XmEXPLICIT)
- XtVaSetValues(shell, XmNkeyboardFocusPolicy, XmEXPLICIT, NULL);
-
-#else
- /* SND_AS_WIDGET */
- shell = parent;
-#endif
-
- auto_open_files = argc - 1;
- if (argc > 1) auto_open_file_names = (char **)(argv + 1);
-
- dpy = XtDisplay(shell);
-
- XtVaGetValues(shell, XmNtitle, &app_title, NULL); /* perhaps caller included -title arg */
- if (app_title)
- ss->startup_title = mus_strdup(app_title);
- else ss->startup_title = mus_strdup("snd");
-
- for (i = 1; i < argc; i++)
- if ((strcmp(argv[i], "-h") == 0) ||
- (strcmp(argv[i], "-horizontal") == 0) ||
- (strcmp(argv[i], "--horizontal") == 0))
- set_sound_style(SOUNDS_HORIZONTAL);
- else
- if ((strcmp(argv[i], "-v") == 0) ||
- (strcmp(argv[i], "-vertical") == 0) ||
- (strcmp(argv[i], "--vertical") == 0))
- set_sound_style(SOUNDS_VERTICAL);
- else
- if ((strcmp(argv[i], "-notebook") == 0) ||
- (strcmp(argv[i], "--notebook") == 0))
- {
- set_sound_style(SOUNDS_IN_NOTEBOOK);
- set_auto_resize(false);
- }
- else
- if ((strcmp(argv[i], "-separate") == 0) ||
- (strcmp(argv[i], "--separate") == 0))
- set_sound_style(SOUNDS_IN_SEPARATE_WINDOWS);
- else
- if (strcmp(argv[i], "-noglob") == 0)
- noglob = true;
- else
- if (strcmp(argv[i], "-noinit") == 0)
- noinit = true;
- else
- if (strcmp(argv[i], "-nostdin") == 0)
- nostdin = true;
- else
- if ((strcmp(argv[i], "-b") == 0) ||
- (strcmp(argv[i], "-batch") == 0) ||
- (strcmp(argv[i], "--batch") == 0))
- batch = true;
- else
- if (strcmp(argv[i], "--features") == 0) /* testing (compsnd) */
- check_features_list(argv[i + 1]);
-
- ss->batch_mode = batch;
- if (batch) XtSetMappedWhenManaged(shell, 0);
-
- ss->zoom_slider_width = ZOOM_SLIDER_WIDTH;
- ss->position_slider_width = POSITION_SLIDER_WIDTH;
- ss->channel_sash_indent = CHANNEL_SASH_INDENT;
- ss->channel_sash_size = CHANNEL_SASH_SIZE;
- ss->sash_size = SASH_SIZE;
- ss->sash_indent = SASH_INDENT;
- ss->toggle_size = TOGGLE_SIZE;
- ss->click_time = (oclock_t)XtGetMultiClickTime(dpy);
-
-#if (HAVE_GL) && (!SND_AS_WIDGET)
- {
- /* this taken from glxmotif.c from xjournal/sgi */
- XVisualInfo *vi = NULL;
- Colormap cmap;
- GLXContext cx;
- int snglBuf[] = {GLX_RGBA, GLX_DEPTH_SIZE, 16, None};
- int dblBuf[] = {GLX_RGBA, GLX_DEPTH_SIZE, 16, GLX_DOUBLEBUFFER, None};
- vi = glXChooseVisual(dpy, DefaultScreen(dpy), dblBuf);
- if (vi)
- ss->gl_has_double_buffer = true;
- else
- {
- ss->gl_has_double_buffer = false;
- vi = glXChooseVisual(dpy, DefaultScreen(dpy), snglBuf);
- }
- if (vi == NULL)
- fprintf(stderr, "%s", "no RGB visual with desired depth\n"); /* not snd_error -- shell not ready yet */
- else
- {
- /* create an OpenGL rendering context */
- cx = glXCreateContext(dpy, vi, /* no display list sharing */ None, /* favor direct */ GL_TRUE);
- if (cx == NULL)
- fprintf(stderr, "%s", "could not create rendering context\n");
- else
- {
- /* create an X colormap since probably not using default visual */
- cmap = XCreateColormap(dpy, RootWindow(dpy, vi->screen), vi->visual, AllocNone);
- XtVaSetValues(shell, XtNvisual, vi->visual, XtNdepth, vi->depth, XtNcolormap, cmap, NULL);
- ss->cx = cx;
- }
- XFree(vi);
- }
- }
-#endif
-
-#ifndef SND_AS_WIDGET
- XtAppSetWarningMsgHandler(app, muffle_warning);
-#endif
-
- ss->mainapp = app;
- ss->mainshell = shell;
- ss->mdpy = dpy;
- ss->toolbar = NULL;
-
- ss->white = get_color(shell, WHITE_COLOR, NULL, NULL, true);
- ss->black = get_color(shell, BLACK_COLOR, NULL, NULL, false);
- ss->light_blue = get_color(shell, LIGHT_BLUE_COLOR, "blue", NULL, true);
- ss->lighter_blue = get_color(shell, LIGHTER_BLUE_COLOR, "blue", NULL, true);
- ss->red = get_color(shell, RED_COLOR, NULL, NULL, false);
- ss->green = get_color(shell, GREEN_COLOR, NULL, NULL, false);
- ss->yellow = get_color(shell, YELLOW_COLOR, NULL, NULL, true);
- ss->highlight_color = get_color(shell, HIGHLIGHT_COLOR, "gray90", NULL, true);
- ss->basic_color = get_color(shell, BASIC_COLOR, "gray80", "gray", true);
- ss->position_color = get_color(shell, POSITION_COLOR, "gray60", "blue", false);
- ss->zoom_color = get_color(shell, ZOOM_COLOR, "gray20", "gray", false);
- ss->cursor_color = get_color(shell, CURSOR_COLOR, NULL, NULL, false);
- ss->selection_color = get_color(shell, SELECTION_COLOR, "gray80", NULL, false);
- ss->mix_color = get_color(shell, MIX_COLOR, "red", NULL, false);
- ss->enved_waveform_color = get_color(shell, ENVED_WAVEFORM_COLOR, "red", NULL, false);
- ss->filter_control_waveform_color = get_color(shell, FILTER_CONTROL_WAVEFORM_COLOR, "blue", NULL, false);
- ss->listener_color = get_color(shell, LISTENER_COLOR, NULL, NULL, true);
- ss->listener_text_color = get_color(shell, LISTENER_TEXT_COLOR, NULL, NULL, false);
- ss->graph_color = get_color(shell, GRAPH_COLOR, NULL, NULL, true);
- ss->selected_graph_color = get_color(shell, SELECTED_GRAPH_COLOR, NULL, NULL, true);
- ss->data_color = get_color(shell, DATA_COLOR, NULL, NULL, false);
- ss->selected_data_color = get_color(shell, SELECTED_DATA_COLOR, NULL, NULL, false);
- ss->mark_color = get_color(shell, MARK_COLOR, "red", NULL, false);
- ss->sash_color = get_color(shell, SASH_COLOR, NULL, NULL, false);
- ss->text_focus_color = get_color(shell, TEXT_FOCUS_COLOR, NULL, NULL, true);
- ss->grid_color = get_in_between_color(ss->data_color, ss->graph_color);
- ss->selected_grid_color = get_in_between_color(ss->selected_data_color, ss->selected_graph_color);
-
- ss->axis_color_set = false;
-
- ss->orig_data_color = ss->data_color;
- ss->orig_selected_data_color = ss->selected_data_color;
- ss->orig_mark_color = ss->mark_color;
- ss->orig_mix_color = ss->mix_color;
- ss->orig_graph_color = ss->graph_color;
- ss->orig_selected_graph_color = ss->selected_graph_color;
- ss->orig_listener_color = ss->listener_color;
- ss->orig_listener_text_color = ss->listener_text_color;
- ss->orig_cursor_color = ss->cursor_color;
- ss->orig_basic_color = ss->basic_color;
- ss->orig_selection_color = ss->selection_color;
- ss->orig_zoom_color = ss->zoom_color;
- ss->orig_position_color = ss->position_color;
- ss->orig_highlight_color = ss->highlight_color;
-
- if ((!(set_peaks_font(DEFAULT_PEAKS_FONT))) &&
- (!(set_peaks_font(FALLBACK_FONT))))
- fprintf(stderr, "can't find peaks font %s", DEFAULT_PEAKS_FONT);
-
- if ((!(set_tiny_font(DEFAULT_TINY_FONT))) &&
- (!(set_tiny_font(FALLBACK_FONT))))
- fprintf(stderr, "can't find tiny font %s", DEFAULT_TINY_FONT);
-
- if ((!(set_bold_peaks_font(DEFAULT_BOLD_PEAKS_FONT))) &&
- (!(set_bold_peaks_font(FALLBACK_FONT))))
- fprintf(stderr, "can't find bold peaks font %s", DEFAULT_BOLD_PEAKS_FONT);
-
- if ((!(set_axis_label_font(DEFAULT_AXIS_LABEL_FONT))) &&
- (!(set_axis_label_font(FALLBACK_FONT))))
- fprintf(stderr, "can't find axis label font %s", DEFAULT_AXIS_LABEL_FONT);
-
- if ((!(set_axis_numbers_font(DEFAULT_AXIS_NUMBERS_FONT))) &&
- (!(set_axis_numbers_font(FALLBACK_FONT))))
- fprintf(stderr, "can't find axis numbers font %s", DEFAULT_AXIS_NUMBERS_FONT);
-
- ss->orig_axis_label_font = mus_strdup(axis_label_font(ss));
- ss->orig_axis_numbers_font = mus_strdup(axis_numbers_font(ss));
- ss->orig_peaks_font = mus_strdup(peaks_font(ss));
- ss->orig_bold_peaks_font = mus_strdup(bold_peaks_font(ss));
- ss->orig_listener_font = mus_strdup(listener_font(ss));
- ss->orig_tiny_font = mus_strdup(tiny_font(ss));
-
- XtVaSetValues(shell, XmNbackground, ss->basic_color, NULL);
-
-#ifndef SND_AS_WIDGET
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- XtSetArg(args[n], XmNallowResize, true); n++;
- ss->mainpane = XtCreateManagedWidget("mainpane", xmFormWidgetClass, shell, args, n);
-#else
- ss->mainpane = XtCreateManagedWidget("mainpane", xmFormWidgetClass, parent, caller_args, caller_argn);
-#endif
- menu = add_menu();
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, menu); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
- switch (sound_style(ss))
- {
- case SOUNDS_IN_SEPARATE_WINDOWS:
- ss->soundpane = XtCreateManagedWidget("soundpane", xmFormWidgetClass, ss->mainpane, args, n);
- break;
-
- case SOUNDS_HORIZONTAL:
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- ss->soundpanebox = XtCreateManagedWidget("soundpane", xmPanedWindowWidgetClass, ss->mainpane, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNsashHeight, ss->sash_size); n++;
- XtSetArg(args[n], XmNsashWidth, ss->sash_size); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNsashIndent, ss->sash_indent); n++;
- ss->soundpane = XtCreateManagedWidget("soundpane", xmPanedWindowWidgetClass, ss->soundpanebox, args, n);
- break;
-
- case SOUNDS_VERTICAL:
- XtSetArg(args[n], XmNsashHeight, ss->sash_size); n++;
- XtSetArg(args[n], XmNsashWidth, ss->sash_size); n++;
- XtSetArg(args[n], XmNsashIndent, ss->sash_indent); n++;
- ss->soundpane = XtCreateManagedWidget("soundpane", xmPanedWindowWidgetClass, ss->mainpane, args, n);
- break;
-
- case SOUNDS_IN_NOTEBOOK:
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- ss->soundpanebox = XtCreateManagedWidget("soundpane", xmPanedWindowWidgetClass, ss->mainpane, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNframeBackground, ss->zoom_color); n++;
- XtSetArg(args[n], XmNbindingType, XmNONE); n++;
- XtSetArg(args[n], XmNbackPagePlacement, XmTOP_RIGHT); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- ss->soundpane = XtCreateWidget("nb", xmNotebookWidgetClass, ss->soundpanebox, args, n);
-
- {
- /* get rid of the useless spinbox */
- Widget scroll;
- n = 0;
- XtSetArg(args[n], XmNnotebookChildType, XmPAGE_SCROLLER); n++;
- scroll = XtCreateWidget("scroller", xmScrollBarWidgetClass, ss->soundpane, NULL, 0);
- }
- XtManageChild(ss->soundpane);
- XtAddCallback(ss->soundpane, XmNpageChangedCallback, notebook_page_changed_callback, NULL);
- map_over_children(ss->soundpane, set_main_color_of_widget); /* appears to be a no-op */
- break;
- }
-
-#ifndef SND_AS_WIDGET
- SetupIcon(shell);
- XtRealizeWidget(shell);
- if (auto_resize(ss) != AUTO_RESIZE_DEFAULT)
- XtVaSetValues(shell, XmNallowShellResize, auto_resize(ss), NULL);
-#endif
-
- wn = XtWindow(shell);
- gv.background = ss->graph_color;
- gv.foreground = ss->data_color;
- ss->basic_gc = XCreateGC(dpy, wn, GCForeground | GCBackground, &gv);
-
- gv.background = ss->graph_color;
- gv.foreground = ss->data_color;
- ss->combined_basic_gc = XCreateGC(dpy, wn, GCForeground | GCBackground, &gv);
-
- gv.background = ss->graph_color;
- gv.foreground = ss->mix_color;
- ss->mix_gc = XCreateGC(dpy, wn, GCForeground | GCBackground, &gv);
-
- gv.function = GXxor;
- gv.background = ss->graph_color;
- gv.foreground = (Pixel)(XOR(ss->cursor_color, gv.background));
- ss->cursor_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
-
- gv.function = GXxor;
- gv.background = ss->graph_color;
- gv.foreground = (Pixel)(XOR(ss->selection_color, gv.background));
- ss->selection_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
-
- gv.function = GXxor;
- gv.background = ss->graph_color;
- gv.foreground = (Pixel)(XOR(ss->mark_color, gv.background));
- ss->mark_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
-
- gv.function = GXcopy;
- gv.background = ss->data_color;
- gv.foreground = ss->graph_color;
- ss->erase_gc = XCreateGC(dpy, wn, GCForeground | GCBackground | GCFunction, &gv);
-
- gv.background = ss->selected_graph_color;
- gv.foreground = ss->selected_data_color;
- ss->selected_basic_gc = XCreateGC(dpy, wn, GCForeground | GCBackground, &gv);
-
- gv.function = GXxor;
- gv.background = ss->selected_graph_color;
- gv.foreground = (Pixel)(XOR(ss->cursor_color, gv.background));
- ss->selected_cursor_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
-
- gv.function = GXxor;
- gv.background = ss->selected_graph_color;
- gv.foreground = (Pixel)(XOR(ss->selection_color, gv.background));
- ss->selected_selection_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
-
- gv.function = GXxor;
- gv.background = ss->selected_graph_color;
- gv.foreground = (Pixel)(XOR(ss->mark_color, gv.background));
- ss->selected_mark_gc = XCreateGC(dpy, wn, GCForeground | GCFunction, &gv);
-
- gv.function = GXcopy;
- gv.background = ss->selected_data_color;
- gv.foreground = ss->selected_graph_color;
- ss->selected_erase_gc = XCreateGC(dpy, wn, GCForeground | GCBackground | GCFunction, &gv);
-
- gv.function = GXcopy;
- gv.background = ss->basic_color;
- gv.foreground = ss->black;
- ss->fltenv_basic_gc = XCreateGC(dpy, wn, GCBackground | GCForeground | GCFunction, &gv);
-
- gv.function = GXcopy;
- gv.background = ss->basic_color;
- gv.foreground = ss->filter_control_waveform_color;
- ss->fltenv_data_gc = XCreateGC(dpy, wn, GCBackground | GCForeground | GCFunction, &gv);
-
- initialize_colormap(); /* X11 not ours */
- make_icons_transparent(BASIC_COLOR);
-
- if (with_toolbar(ss)) show_toolbar();
- startup_funcs();
-
-#if HAVE_SETJMP_H
-#if MUS_TRAP_SEGFAULT
- if (sigsetjmp(envHandleEventsLoop, 1))
- {
- if (!(ss->exiting))
- snd_error_without_format("Caught seg fault (will try to continue):\n");
- else
- {
- snd_error_without_format("Caught seg fault while trying to exit.\n");
- exit(0);
- }
- }
-#endif
-
- if (setjmp(top_level_jump))
- {
- if (!(ss->jump_ok))
- snd_error_without_format("Caught top level error (will try to continue):\n");
- else ss->jump_ok = false;
- }
-
-#if MUS_DEBUGGING
- XtAppSetErrorHandler(MAIN_APP(ss), trap_xt_error);
-#endif
-#endif
-
- if (ss->startup_errors)
- {
- post_it("Error in initialization", ss->startup_errors);
- free(ss->startup_errors);
- ss->startup_errors = NULL;
- }
-
-#ifndef SND_AS_WIDGET
- XtAppMainLoop(app);
-#endif
-}
diff --git a/snd-xmenu.c b/snd-xmenu.c
deleted file mode 100644
index 39789ba..0000000
--- a/snd-xmenu.c
+++ /dev/null
@@ -1,1923 +0,0 @@
-#include "snd.h"
-#include "snd-menu.h"
-#include <X11/cursorfont.h>
-
-
-void set_menu_label(Widget w, const char *label) {if (w) set_button_label(w, label);}
-
-
-/* -------------------------------- FILE MENU -------------------------------- */
-
-static Widget *recent_file_items = NULL;
-static int recent_file_items_size = 0;
-
-static void open_recent_file_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *filename;
- snd_info *sp;
- filename = get_label(w);
- ss->open_requestor = FROM_OPEN_RECENT_MENU;
- ss->open_requestor_data = NULL;
- sp = snd_open_file(filename, FILE_READ_WRITE);
- if (sp) select_channel(sp, 0);
-}
-
-
-static void file_open_recent_callback(Widget w, XtPointer info, XtPointer context)
-{
- int size;
- size = recent_files_size();
- if (size > 0)
- {
- int i;
- char **recent_file_names;
-
- if (size > recent_file_items_size)
- {
- if (recent_file_items_size == 0)
- recent_file_items = (Widget *)calloc(size, sizeof(Widget));
- else
- {
- recent_file_items = (Widget *)realloc(recent_file_items, size * sizeof(Widget));
- for (i = recent_file_items_size; i < size; i++)
- recent_file_items[i] = NULL;
- }
- recent_file_items_size = size;
- }
-
- recent_file_names = recent_files();
-
- for (i = 0; i < size; i++)
- {
- if (recent_file_items[i] == NULL)
- {
- int n = 0;
- Arg args[6];
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
-
- recent_file_items[i] = XtCreateManagedWidget(recent_file_names[i], xmPushButtonWidgetClass, file_open_recent_menu, args, n);
- XtAddCallback(recent_file_items[i], XmNactivateCallback, open_recent_file_callback, NULL);
- }
- else
- {
- set_label(recent_file_items[i], recent_file_names[i]);
- XtManageChild(recent_file_items[i]);
- }
- }
-
- for (i = size; i < recent_file_items_size; i++) /* maybe previous file was deleted */
- if ((recent_file_items[i]) &&
- (XtIsManaged(recent_file_items[i])))
- XtUnmanageChild(recent_file_items[i]);
- }
-}
-
-
-static void make_open_recent_menu(void)
-{
- int n = 0;
- Arg args[6];
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNpositionIndex, 1); n++; /* just after "Open" menu */
-
- file_open_recent_menu = XmCreatePulldownMenu(file_menu, (char *)"open-recent", args, n);
-
- XtSetArg(args[n], XmNsubMenuId, file_open_recent_menu); n++;
-
- file_open_recent_cascade_menu = XtCreateManagedWidget("Open recent", xmCascadeButtonWidgetClass, file_menu, args, n);
- XtAddCallback(file_open_recent_cascade_menu, XmNcascadingCallback, file_open_recent_callback, NULL);
-}
-
-
-static void file_menu_update_1(Widget w, XtPointer info, XtPointer context)
-{
- if (recent_files_size() > 0)
- {
- if (file_open_recent_menu == NULL)
- make_open_recent_menu();
- else set_sensitive(file_open_recent_cascade_menu, true);
- }
- else
- {
- if (file_open_recent_menu)
- set_sensitive(file_open_recent_cascade_menu, false);
- }
-
- file_menu_update();
-}
-
-
-static void file_open_callback(Widget w, XtPointer info, XtPointer context) {make_open_file_dialog(FILE_READ_WRITE, true);}
-static void file_view_callback(Widget w, XtPointer info, XtPointer context) {make_open_file_dialog(FILE_READ_ONLY, true);}
-static void file_new_callback(Widget w, XtPointer info, XtPointer context) {make_new_file_dialog(true);}
-static void file_record_callback(Widget w, XtPointer info, XtPointer context) {record_file();}
-static void file_close_callback(Widget w, XtPointer info, XtPointer context) {if (any_selected_sound()) snd_close_file(any_selected_sound());}
-static void file_close_all_callback(Widget w, XtPointer info, XtPointer context) {for_each_sound(snd_close_file);}
-static void file_save_callback(Widget w, XtPointer info, XtPointer context) {if (any_selected_sound()) save_edits_with_prompt(any_selected_sound());}
-static void file_update_callback(Widget w, XtPointer info, XtPointer context) {update_file_from_menu();}
-static void file_save_as_callback(Widget w, XtPointer info, XtPointer context) {make_sound_save_as_dialog(true);}
-static void file_revert_callback(Widget w, XtPointer info, XtPointer context) {revert_file_from_menu();}
-static void file_exit_callback(Widget w, XtPointer info, XtPointer context) {if (snd_exit_cleanly(EXIT_NOT_FORCED)) snd_exit(1);}
-static void file_mix_callback_1(Widget w, XtPointer info, XtPointer context) {make_mix_file_dialog(true);}
-static void file_insert_callback_1(Widget w, XtPointer info, XtPointer context) {make_insert_file_dialog(true);}
-static void file_print_callback_1(Widget w, XtPointer info, XtPointer context) {file_print_callback(w, info, context);}
-
-
-/* -------------------------------- EDIT MENU -------------------------------- */
-
-static void edit_mix_callback(Widget w, XtPointer info, XtPointer context) {add_selection_or_region(0, selected_channel());}
-static void edit_envelope_callback(Widget w, XtPointer info, XtPointer context) {create_envelope_editor();}
-static void edit_cut_callback(Widget w, XtPointer info, XtPointer context) {delete_selection(UPDATE_DISPLAY);}
-static void edit_paste_callback(Widget w, XtPointer info, XtPointer context) {insert_selection_from_menu();}
-static void edit_save_as_callback(Widget w, XtPointer info, XtPointer context) {make_selection_save_as_dialog(true);}
-static void edit_select_all_callback(Widget w, XtPointer info, XtPointer context) {select_all(current_channel());}
-static void edit_unselect_callback(Widget w, XtPointer info, XtPointer context) {deactivate_selection();}
-static void edit_undo_callback(Widget w, XtPointer info, XtPointer context) {undo_edit_with_sync(current_channel(), 1);}
-static void edit_redo_callback(Widget w, XtPointer info, XtPointer context) {redo_edit_with_sync(current_channel(), 1);}
-
-static void edit_menu_update_1(Widget w, XtPointer info, XtPointer context) {edit_menu_update();}
-
-
-static void edit_play_callback(Widget w, XtPointer info, XtPointer context)
-{
- if (ss->selection_play_stop)
- {
- stop_playing_all_sounds(PLAY_BUTTON_UNSET);
- reflect_play_selection_stop(); /* if there was an error, stop_playing might not remember to clear this */
- }
- else
- {
- set_menu_label(edit_play_menu, "Stop");
- ss->selection_play_stop = true;
- play_selection(IN_BACKGROUND);
- }
-}
-
-
-void reflect_play_selection_stop(void)
-{
- set_menu_label(edit_play_menu, "Play Selection");
- ss->selection_play_stop = false;
-}
-
-
-static void edit_header_callback_1(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp) edit_header(sp);
-}
-
-
-#if HAVE_EXTENSION_LANGUAGE
-static void edit_find_callback_1(Widget w, XtPointer info, XtPointer context)
-{
- edit_find_callback(w, info, context);
-}
-#endif
-
-
-
-/* -------------------------------- VIEW MENU -------------------------------- */
-
-static Widget *view_files_items = NULL;
-static Widget view_files_cascade_menu = NULL;
-static int view_files_items_size = 0;
-
-
-static void view_files_item_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *dirname;
- dirname = get_label(w);
- if (mus_strcmp(dirname, "new viewer"))
- start_view_files_dialog(true, true); /* managed and empty (brand-new) */
- else view_files_start_dialog_with_title(dirname);
-}
-
-
-static void view_files_callback(Widget w, XtPointer info, XtPointer context)
-{
- int size;
-
- size = view_files_dialog_list_length();
- if (size == 0)
- {
- start_view_files_dialog(true, true); /* managed and empty (brand-new) */
- }
- else
- {
- int i;
- char **view_files_names;
-
- if ((XmIsPushButton(view_files_menu)) && /* autotest check */
- (!view_files_cascade_menu))
- return;
-
- view_files_names = view_files_dialog_titles();
- view_files_names[size++] = mus_strdup("new viewer");
-
- if (size > view_files_items_size)
- {
- if (view_files_items_size == 0)
- view_files_items = (Widget *)calloc(size, sizeof(Widget));
- else
- {
- view_files_items = (Widget *)realloc(view_files_items, size * sizeof(Widget));
- for (i = view_files_items_size; i < size; i++)
- view_files_items[i] = NULL;
- }
- view_files_items_size = size;
- }
-
- for (i = 0; i < size; i++)
- {
- if (view_files_items[i] == NULL)
- {
- int n = 0;
- Arg args[6];
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
-
- view_files_items[i] = XtCreateManagedWidget(view_files_names[i], xmPushButtonWidgetClass, view_files_menu, args, n);
- XtAddCallback(view_files_items[i], XmNactivateCallback, view_files_item_callback, NULL);
- }
- else
- {
- set_label(view_files_items[i], view_files_names[i]);
- XtManageChild(view_files_items[i]);
- }
- free(view_files_names[i]);
- }
- free(view_files_names);
- }
-}
-
-
-static void make_view_files_list_menu(void)
-{
- int n = 0, pos = 2;
- Arg args[6];
-
- if ((view_files_menu) &&
- (XmIsPushButton(view_files_menu)))
- {
- XtVaGetValues(view_files_menu, XmNpositionIndex, &pos, NULL);
- XtUnmanageChild(view_files_menu);
- }
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNpositionIndex, pos); n++;
-
- view_files_menu = XmCreatePulldownMenu(view_menu, (char *)"view-files", args, n);
- XtSetArg(args[n], XmNsubMenuId, view_files_menu); n++;
-
- view_files_cascade_menu = XtCreateManagedWidget("Files", xmCascadeButtonWidgetClass, view_menu, args, n);
- XtAddCallback(view_files_cascade_menu, XmNcascadingCallback, view_files_callback, NULL);
-}
-
-
-static void view_menu_update_1(Widget w, XtPointer info, XtPointer context)
-{
- if ((view_files_dialog_list_length() > 0) &&
- (!view_files_cascade_menu))
- make_view_files_list_menu();
-
- view_menu_update();
-}
-
-
-
-static void view_separate_callback(Widget w, XtPointer info, XtPointer context) {set_channel_style(CHANNELS_SEPARATE);}
-static void view_combined_callback(Widget w, XtPointer info, XtPointer context) {set_channel_style(CHANNELS_COMBINED);}
-static void view_superimposed_callback(Widget w, XtPointer info, XtPointer context) {set_channel_style(CHANNELS_SUPERIMPOSED);}
-static void view_dots_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_DOTS);}
-static void view_lines_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_LINES);}
-static void view_filled_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_FILLED);}
-static void view_dots_and_lines_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_DOTS_AND_LINES);}
-static void view_lollipops_callback(Widget w, XtPointer info, XtPointer context) {set_graph_style(GRAPH_LOLLIPOPS);}
-#if HAVE_EXTENSION_LANGUAGE
-static void view_listener_callback(Widget w, XtPointer info, XtPointer context) {handle_listener(!(listener_is_visible()));}
-#endif
-static void view_mix_dialog_callback(Widget w, XtPointer info, XtPointer context) {make_mix_dialog();}
-static void view_zero_callback(Widget w, XtPointer info, XtPointer context){set_show_y_zero((!(show_y_zero(ss))));}
-static void view_cursor_callback(Widget w, XtPointer info, XtPointer context){set_verbose_cursor((!(verbose_cursor(ss))));}
-
-#if HAVE_EXTENSION_LANGUAGE
-static void view_inset_callback(Widget w, XtPointer info, XtPointer context)
-{
- set_with_inset_graph((!(with_inset_graph(ss))));
- for_each_chan(update_graph);
-}
-#endif
-
-static void view_controls_callback(Widget w, XtPointer info, XtPointer context) {set_show_controls(!in_show_controls(ss));}
-static void view_region_callback_1(Widget w, XtPointer info, XtPointer context) {view_region_callback(w, info, context);}
-static void view_color_orientation_callback_1(Widget w, XtPointer info, XtPointer context) {view_color_orientation_callback(w, info, context);}
-
-static void view_x_axis_seconds_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_IN_SECONDS);}
-static void view_x_axis_clock_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_AS_CLOCK);}
-static void view_x_axis_beats_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_IN_BEATS);}
-static void view_x_axis_measures_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_IN_MEASURES);}
-static void view_x_axis_samples_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_IN_SAMPLES);}
-static void view_x_axis_percentage_callback(Widget w, XtPointer info, XtPointer context) {set_x_axis_style(X_AXIS_AS_PERCENTAGE);}
-
-static void view_no_axes_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_NO_AXES);}
-static void view_all_axes_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_ALL_AXES);}
-static void view_just_x_axis_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_X_AXIS);}
-static void view_all_axes_unlabelled_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_ALL_AXES_UNLABELLED);}
-static void view_just_x_axis_unlabelled_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_X_AXIS_UNLABELLED);}
-static void view_bare_x_axis_callback(Widget w, XtPointer info, XtPointer context) {set_show_axes(SHOW_BARE_X_AXIS);}
-
-static void view_focus_right_callback(Widget w, XtPointer info, XtPointer context) {set_zoom_focus_style(ZOOM_FOCUS_RIGHT);}
-static void view_focus_left_callback(Widget w, XtPointer info, XtPointer context) {set_zoom_focus_style(ZOOM_FOCUS_LEFT);}
-static void view_focus_middle_callback(Widget w, XtPointer info, XtPointer context) {set_zoom_focus_style(ZOOM_FOCUS_MIDDLE);}
-static void view_focus_active_callback(Widget w, XtPointer info, XtPointer context) {set_zoom_focus_style(ZOOM_FOCUS_ACTIVE);}
-
-
-
-/* -------------------------------- OPTIONS MENU -------------------------------- */
-
-static void options_transform_callback(Widget w, XtPointer info, XtPointer context) {fire_up_transform_dialog(true);}
-static void options_controls_callback(Widget w, XtPointer info, XtPointer context) {make_controls_dialog();}
-#if HAVE_EXTENSION_LANGUAGE
-static void options_save_callback(Widget w, XtPointer info, XtPointer context) {save_options_from_menu();}
-#endif
-#if HAVE_EXTENSION_LANGUAGE
-static void options_save_state_callback(Widget w, XtPointer info, XtPointer context) {save_state_from_menu();}
-#endif
-static void options_preferences_callback(Widget w, XtPointer info, XtPointer context) {start_preferences_dialog();}
-
-
-
-/* -------------------------------- HELP MENU -------------------------------- */
-
-static void help_about_snd_callback(Widget w, XtPointer info, XtPointer context) {about_snd_help();}
-static void help_fft_callback(Widget w, XtPointer info, XtPointer context) {fft_help();}
-#if HAVE_EXTENSION_LANGUAGE
-static void help_find_callback(Widget w, XtPointer info, XtPointer context) {find_help();}
-static void help_init_file_callback(Widget w, XtPointer info, XtPointer context) {init_file_help();}
-#endif
-static void help_undo_callback(Widget w, XtPointer info, XtPointer context) {undo_help();}
-static void help_sync_callback(Widget w, XtPointer info, XtPointer context) {sync_help();}
-static void help_debug_callback(Widget w, XtPointer info, XtPointer context) {debug_help();}
-static void help_controls_callback(Widget w, XtPointer info, XtPointer context) {controls_help();}
-static void help_env_callback(Widget w, XtPointer info, XtPointer context) {env_help();}
-static void help_marks_callback(Widget w, XtPointer info, XtPointer context) {marks_help();}
-static void help_mix_callback(Widget w, XtPointer info, XtPointer context) {mix_help();}
-static void help_sound_files_callback(Widget w, XtPointer info, XtPointer context) {sound_files_help();}
-static void help_recording_callback(Widget w, XtPointer info, XtPointer context) {recording_help();}
-static void help_keys_callback(Widget w, XtPointer info, XtPointer context) {key_binding_help();}
-static void help_play_callback(Widget w, XtPointer info, XtPointer context) {play_help();}
-static void help_filter_callback(Widget w, XtPointer info, XtPointer context) {filter_help();}
-static void help_save_callback(Widget w, XtPointer info, XtPointer context) {save_help();}
-static void help_reverb_callback(Widget w, XtPointer info, XtPointer context) {reverb_help();}
-static void help_resample_callback(Widget w, XtPointer info, XtPointer context) {resample_help();}
-static void help_insert_callback(Widget w, XtPointer info, XtPointer context) {insert_help();}
-static void help_delete_callback(Widget w, XtPointer info, XtPointer context) {delete_help();}
-static void help_region_callback(Widget w, XtPointer info, XtPointer context) {region_help();}
-static void help_selection_callback(Widget w, XtPointer info, XtPointer context) {selection_help();}
-static void help_colors_callback(Widget w, XtPointer info, XtPointer context) {colors_help();}
-
-void check_menu_labels(int key, int state, bool extended)
-{
- /* user has redefined key, so erase old key binding info from the menu label */
- if (extended)
- {
- if (state == snd_ControlMask)
- {
- if (key == snd_K_f) set_label(file_open_menu, "Open"); else
- if (key == snd_K_s) set_label(file_save_menu, "Save"); else
- if (key == snd_K_q) set_label(file_mix_menu, "Mix"); else
- if (key == snd_K_i) set_label(file_insert_menu, "Insert"); else
- if (key == snd_K_u) set_label(edit_undo_menu, "Undo"); else
- if (key == snd_K_r) set_label(edit_redo_menu, "Redo");
- }
- else
- {
- if (key == snd_K_k) set_label(file_close_menu, "Close"); else
- if (key == snd_K_i) set_label(edit_paste_menu, "Insert Selection"); else
- if (key == snd_K_q) set_label(edit_mix_menu, "Mix Selection"); else
- if (key == snd_K_p) set_label(edit_play_menu, "Play Selection"); else
- if (key == snd_K_w) set_label(edit_save_as_menu, "Save Selection");
- }
- }
- else
- {
- if ((key == snd_K_s) && (state == snd_ControlMask))
- set_label(edit_find_menu, "Find");
- }
-}
-
-
-/* -------------------------------- MAIN MENU -------------------------------- */
-
-static void menu_drag_watcher(Widget w, const char *str, Position x, Position y, drag_style_t dtype, void *data)
-{
- char *new_title;
- switch (dtype)
- {
- case DRAG_ENTER:
- new_title = mus_format("%s: drop to open file", ss->startup_title);
- XtVaSetValues(MAIN_SHELL(ss), XmNtitle, (char *)new_title, NULL);
- XmChangeColor(w, ss->selection_color);
- free(new_title);
- break;
-
- case DRAG_LEAVE:
- reflect_file_change_in_title();
- XmChangeColor(w, ss->highlight_color);
- break;
-
- default:
- break;
- }
-}
-
-
-static void menu_drop_watcher(Widget w, const char *str, Position x, Position y, void *data)
-{
- snd_info *sp = NULL;
- ss->open_requestor = FROM_DRAG_AND_DROP;
- sp = snd_open_file(str, FILE_READ_WRITE);
- if (sp) select_channel(sp, 0);
-}
-
-
-void add_menu_drop(void)
-{
- add_drag_and_drop(main_menu, menu_drop_watcher, menu_drag_watcher, NULL);
-}
-
-
-Widget add_menu(void)
-{
- static Arg main_args[12];
- static Arg in_args[12];
- static Arg high_args[12];
- Arg sep_args[12];
- int in_n = 0, n, high_n = 0, main_n = 0, start_high_n, k, j;
-
- ss->mw = (Widget *)calloc(NUM_MENU_WIDGETS, sizeof(Widget));
-
- XtSetArg(main_args[main_n], XmNbackground, ss->basic_color); main_n++;
- XtSetArg(high_args[high_n], XmNbackground, ss->highlight_color); high_n++;
- XtSetArg(in_args[in_n], XmNbackground, ss->basic_color); in_n++;
-
- start_high_n = high_n;
- XtSetArg(in_args[in_n], XmNsensitive, false); in_n++;
-
- n = high_n;
- XtSetArg(high_args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(high_args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(high_args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(high_args[n], XmNrightAttachment, XmATTACH_FORM); n++;
-
-#ifdef SND_AS_WIDGET
- main_menu = XtCreateWidget("mb", xmRowColumnWidgetClass, MAIN_PANE(ss), high_args, n);
-#else
- main_menu = XmCreateMenuBar(MAIN_PANE(ss), (char *)"menuBar", high_args, n);
-#endif
-
- /* FILE MENU */
- XtSetArg(main_args[main_n], XmNuserData, (XtPointer)0);
- file_menu = XmCreatePulldownMenu(main_menu, (char *)"File", main_args, main_n + 1);
-
- high_n = start_high_n;
- XtSetArg(high_args[high_n], XmNsubMenuId, file_menu); high_n++;
- XtSetArg(high_args[high_n], XmNmnemonic, 'F'); high_n++;
- XtSetArg(high_args[high_n], XmNuserData, (XtPointer)0); high_n++;
- file_cascade_menu = XtCreateManagedWidget("File", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
-
- file_open_menu = XtCreateManagedWidget("Open", xmPushButtonWidgetClass, file_menu, main_args, main_n);
- XtAddCallback(file_open_menu, XmNactivateCallback, file_open_callback, NULL);
- XtVaSetValues(file_open_menu, XmNmnemonic, 'O', NULL);
-
- file_close_menu = XtCreateManagedWidget("Close", xmPushButtonWidgetClass, file_menu, in_args, in_n);
- XtAddCallback(file_close_menu, XmNactivateCallback, file_close_callback, NULL);
- XtVaSetValues(file_close_menu, XmNmnemonic, 'C', NULL);
-
- file_close_all_menu = XtCreateWidget("Close all", xmPushButtonWidgetClass, file_menu, main_args, main_n);
- XtAddCallback(file_close_all_menu, XmNactivateCallback, file_close_all_callback, NULL);
-
- file_save_menu = XtCreateManagedWidget("Save", xmPushButtonWidgetClass, file_menu, in_args, in_n);
- XtAddCallback(file_save_menu, XmNactivateCallback, file_save_callback, NULL);
- XtVaSetValues(file_save_menu, XmNmnemonic, 'S', NULL);
-
- file_save_as_menu = XtCreateManagedWidget("Save as", xmPushButtonWidgetClass, file_menu, in_args, in_n);
- XtAddCallback(file_save_as_menu, XmNactivateCallback, file_save_as_callback, NULL);
- XtVaSetValues(file_save_as_menu, XmNmnemonic, 'a', NULL);
-
- file_revert_menu = XtCreateManagedWidget("Revert", xmPushButtonWidgetClass, file_menu, in_args, in_n);
- XtAddCallback(file_revert_menu, XmNactivateCallback, file_revert_callback, NULL);
- XtVaSetValues(file_revert_menu, XmNmnemonic, 'R', NULL);
-
- file_mix_menu = XtCreateManagedWidget("Mix", xmPushButtonWidgetClass, file_menu, in_args, in_n);
- XtAddCallback(file_mix_menu, XmNactivateCallback, file_mix_callback_1, NULL);
- XtVaSetValues(file_mix_menu, XmNmnemonic, 'M', NULL);
-
- file_insert_menu = XtCreateManagedWidget("Insert", xmPushButtonWidgetClass, file_menu, in_args, in_n);
- XtAddCallback(file_insert_menu, XmNactivateCallback, file_insert_callback_1, NULL);
- XtVaSetValues(file_insert_menu, XmNmnemonic, 'I', NULL);
-
- file_update_menu = XtCreateManagedWidget("Update", xmPushButtonWidgetClass, file_menu, in_args, in_n);
- XtAddCallback(file_update_menu, XmNactivateCallback, file_update_callback, NULL);
- XtVaSetValues(file_update_menu, XmNmnemonic, 'U', NULL);
-
- file_new_menu = XtCreateManagedWidget("New", xmPushButtonWidgetClass, file_menu, main_args, main_n);
- XtAddCallback(file_new_menu, XmNactivateCallback, file_new_callback, NULL);
- XtVaSetValues(file_new_menu, XmNmnemonic, 'N', NULL);
-
- file_record_menu = XtCreateManagedWidget("Record", xmPushButtonWidgetClass, file_menu, main_args, main_n);
- XtAddCallback(file_record_menu, XmNactivateCallback, file_record_callback, NULL);
-
- file_view_menu = XtCreateManagedWidget("View", xmPushButtonWidgetClass, file_menu, main_args, main_n);
- XtAddCallback(file_view_menu, XmNactivateCallback, file_view_callback, NULL);
- XtVaSetValues(file_view_menu, XmNmnemonic, 'V', NULL);
-
- file_print_menu = XtCreateManagedWidget("Print", xmPushButtonWidgetClass, file_menu, in_args, in_n);
- XtAddCallback(file_print_menu, XmNactivateCallback, file_print_callback_1, NULL);
- XtVaSetValues(file_print_menu, XmNmnemonic, 'P', NULL);
-
- j = 0;
- XtSetArg(sep_args[j], XmNbackground, ss->basic_color); j++;
- XtSetArg(sep_args[j], XmNseparatorType, XmSHADOW_ETCHED_IN); j++;
- file_sep_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, file_menu, sep_args, j);
-
- file_exit_menu = XtCreateManagedWidget("Exit", xmPushButtonWidgetClass, file_menu, main_args, main_n);
- XtAddCallback(file_exit_menu, XmNactivateCallback, file_exit_callback, NULL);
- XtVaSetValues(file_exit_menu, XmNmnemonic, 'E', NULL);
-
-
- /* EDIT MENU */
- XtSetArg(main_args[main_n], XmNuserData, (XtPointer)1);
- edit_menu = XmCreatePulldownMenu(main_menu, (char *)"Edit", main_args, main_n + 1);
-
- high_n = start_high_n;
- XtSetArg(high_args[high_n], XmNsubMenuId, edit_menu); high_n++;
- XtSetArg(high_args[high_n], XmNmnemonic, 'E'); high_n++;
- XtSetArg(high_args[high_n], XmNuserData, (XtPointer)1); high_n++;
- edit_cascade_menu = XtCreateManagedWidget("Edit", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
-
- edit_undo_menu = XtCreateManagedWidget("Undo", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_undo_menu, XmNactivateCallback, edit_undo_callback, NULL);
- XtVaSetValues(edit_undo_menu, XmNmnemonic, 'U', NULL);
-
- edit_redo_menu = XtCreateManagedWidget("Redo", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_redo_menu, XmNactivateCallback, edit_redo_callback, NULL);
- XtVaSetValues(edit_redo_menu, XmNmnemonic, 'R', NULL);
-
-#if HAVE_EXTENSION_LANGUAGE
- edit_find_menu = XtCreateManagedWidget("Find", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_find_menu, XmNactivateCallback, edit_find_callback_1, NULL);
- XtVaSetValues(edit_find_menu, XmNmnemonic, 'F', NULL);
-#endif
-
- edit_select_sep_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, edit_menu, sep_args, j);
-
- edit_cut_menu = XtCreateManagedWidget("Delete Selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_cut_menu, XmNactivateCallback, edit_cut_callback, NULL);
- XtVaSetValues(edit_cut_menu, XmNmnemonic, 'C', NULL);
-
- edit_paste_menu = XtCreateManagedWidget("Insert Selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_paste_menu, XmNactivateCallback, edit_paste_callback, NULL);
- XtVaSetValues(edit_paste_menu, XmNmnemonic, 'P', NULL);
-
- edit_mix_menu = XtCreateManagedWidget("Mix Selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_mix_menu, XmNactivateCallback, edit_mix_callback, NULL);
- XtVaSetValues(edit_mix_menu, XmNmnemonic, 'M', NULL);
-
- edit_play_menu = XtCreateManagedWidget("Play Selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_play_menu, XmNactivateCallback, edit_play_callback, NULL);
- XtVaSetValues(edit_play_menu, XmNmnemonic, 'P', NULL);
-
- edit_save_as_menu = XtCreateManagedWidget("Save Selection", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_save_as_menu, XmNactivateCallback, edit_save_as_callback, NULL);
- XtVaSetValues(edit_save_as_menu, XmNmnemonic, 'S', NULL);
-
- edit_select_all_menu = XtCreateManagedWidget("Select all", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_select_all_menu, XmNactivateCallback, edit_select_all_callback, NULL);
-
- edit_unselect_menu = XtCreateManagedWidget("Unselect all", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_unselect_menu, XmNactivateCallback, edit_unselect_callback, NULL);
-
- edit_edit_sep_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, edit_menu, sep_args, j);
-
- edit_env_menu = XtCreateManagedWidget("Edit Envelope", xmPushButtonWidgetClass, edit_menu, main_args, main_n);
- XtAddCallback(edit_env_menu, XmNactivateCallback, edit_envelope_callback, NULL);
- XtVaSetValues(edit_env_menu, XmNmnemonic, 'E', NULL);
-
- edit_header_menu = XtCreateManagedWidget("Edit Header", xmPushButtonWidgetClass, edit_menu, in_args, in_n);
- XtAddCallback(edit_header_menu, XmNactivateCallback, edit_header_callback_1, NULL);
- XtVaSetValues(edit_header_menu, XmNmnemonic, 'H', NULL);
-
-
- /* VIEW MENU */
- XtSetArg(main_args[main_n], XmNuserData, (XtPointer)2);
- view_menu = XmCreatePulldownMenu(main_menu, (char *)"View", main_args, main_n + 1);
-
- high_n = start_high_n;
- XtSetArg(high_args[high_n], XmNsubMenuId, view_menu); high_n++;
- XtSetArg(high_args[high_n], XmNmnemonic, 'V'); high_n++;
- XtSetArg(high_args[high_n], XmNuserData, (XtPointer)2); high_n++;
- view_cascade_menu = XtCreateManagedWidget("View", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
-
- view_controls_menu = XtCreateManagedWidget("Show controls", xmPushButtonWidgetClass, view_menu, main_args, main_n);
- XtAddCallback(view_controls_menu, XmNactivateCallback, view_controls_callback, NULL);
- XtVaSetValues(view_controls_menu, XmNmnemonic, 'S', NULL);
-
-#if HAVE_EXTENSION_LANGUAGE
- view_listener_menu = XtCreateManagedWidget("Open listener", xmPushButtonWidgetClass, view_menu, main_args, main_n);
- XtAddCallback(view_listener_menu, XmNactivateCallback, view_listener_callback, NULL);
- XtVaSetValues(view_listener_menu, XmNmnemonic, 'L', NULL);
-#endif
-
- view_files_menu = XtCreateManagedWidget("Files", xmPushButtonWidgetClass, view_menu, main_args, main_n);
- XtAddCallback(view_files_menu, XmNactivateCallback, view_files_callback, NULL);
- XtVaSetValues(view_files_menu, XmNmnemonic, 'F', NULL);
-
- view_mix_dialog_menu = XtCreateManagedWidget("Mixes", xmPushButtonWidgetClass, view_menu, main_args, main_n);
- XtAddCallback(view_mix_dialog_menu, XmNactivateCallback, view_mix_dialog_callback, NULL);
-
- view_region_menu = XtCreateManagedWidget("Regions", xmPushButtonWidgetClass, view_menu, in_args, in_n);
- XtAddCallback(view_region_menu, XmNactivateCallback, view_region_callback_1, NULL);
- XtVaSetValues(view_region_menu, XmNmnemonic, 'R', NULL);
-
- view_color_orientation_menu = XtCreateManagedWidget("Color/Orientation", xmPushButtonWidgetClass, view_menu, main_args, main_n);
- XtAddCallback(view_color_orientation_menu, XmNactivateCallback, view_color_orientation_callback_1, NULL);
-
- view_sep2_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, view_menu, sep_args, j);
-
- view_graph_style_menu = XmCreatePulldownMenu(view_menu, (char *)"graph-style", main_args, main_n);
-
- k = main_n;
- XtSetArg(main_args[k], XmNsubMenuId, view_graph_style_menu); k++;
- view_graph_style_cascade_menu = XtCreateManagedWidget("Graph style", xmCascadeButtonWidgetClass, view_menu, main_args, k);
-
- view_lines_menu = XtCreateManagedWidget("lines", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
- XtAddCallback(view_lines_menu, XmNactivateCallback, view_lines_callback, NULL);
- if (graph_style(ss) == GRAPH_LINES) set_sensitive(view_lines_menu, false);
-
- view_dots_menu = XtCreateManagedWidget("dots", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
- XtAddCallback(view_dots_menu, XmNactivateCallback, view_dots_callback, NULL);
- if (graph_style(ss) == GRAPH_DOTS) set_sensitive(view_dots_menu, false);
-
- view_filled_menu = XtCreateManagedWidget("filled", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
- XtAddCallback(view_filled_menu, XmNactivateCallback, view_filled_callback, NULL);
- if (graph_style(ss) == GRAPH_FILLED) set_sensitive(view_filled_menu, false);
-
- view_dots_and_lines_menu = XtCreateManagedWidget("dots and lines", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
- XtAddCallback(view_dots_and_lines_menu, XmNactivateCallback, view_dots_and_lines_callback, NULL);
- if (graph_style(ss) == GRAPH_DOTS_AND_LINES) set_sensitive(view_dots_and_lines_menu, false);
-
- view_lollipops_menu = XtCreateManagedWidget("lollipops", xmPushButtonWidgetClass, view_graph_style_menu, main_args, main_n);
- XtAddCallback(view_lollipops_menu, XmNactivateCallback, view_lollipops_callback, NULL);
- if (graph_style(ss) == GRAPH_LOLLIPOPS) set_sensitive(view_lollipops_menu, false);
-
- view_cursor_menu = XtCreateManagedWidget("Verbose cursor", xmPushButtonWidgetClass, view_menu, main_args, main_n);
- XtAddCallback(view_cursor_menu, XmNactivateCallback, view_cursor_callback, NULL);
-
-#if HAVE_EXTENSION_LANGUAGE
- view_inset_menu = XtCreateManagedWidget("With inset graph", xmPushButtonWidgetClass, view_menu, main_args, main_n);
- XtAddCallback(view_inset_menu, XmNactivateCallback, view_inset_callback, NULL);
-#endif
-
- view_combine_menu = XmCreatePulldownMenu(view_menu, (char *)"combine", main_args, main_n);
-
- k = main_n;
- XtSetArg(main_args[k], XmNsubMenuId, view_combine_menu); k++;
- view_combine_cascade_menu = XtCreateManagedWidget("Channel style", xmCascadeButtonWidgetClass, view_menu, main_args, k);
-
- view_combine_separate_menu = XtCreateManagedWidget("separate", xmPushButtonWidgetClass, view_combine_menu, main_args, main_n);
- XtAddCallback(view_combine_separate_menu, XmNactivateCallback, view_separate_callback, NULL);
- if (channel_style(ss) == CHANNELS_SEPARATE) set_sensitive(view_combine_separate_menu, false);
-
- view_combine_combined_menu = XtCreateManagedWidget("combined", xmPushButtonWidgetClass, view_combine_menu, main_args, main_n);
- XtAddCallback(view_combine_combined_menu, XmNactivateCallback, view_combined_callback, NULL);
- if (channel_style(ss) == CHANNELS_COMBINED) set_sensitive(view_combine_combined_menu, false);
-
- view_combine_superimposed_menu = XtCreateManagedWidget("superimposed", xmPushButtonWidgetClass, view_combine_menu, main_args, main_n);
- XtAddCallback(view_combine_superimposed_menu, XmNactivateCallback, view_superimposed_callback, NULL);
- if (channel_style(ss) == CHANNELS_SUPERIMPOSED) set_sensitive(view_combine_superimposed_menu, false);
-
- view_zero_menu = XtCreateManagedWidget("Show Y = 0", xmPushButtonWidgetClass, view_menu, main_args, main_n);
- XtAddCallback(view_zero_menu, XmNactivateCallback, view_zero_callback, NULL);
- XtVaSetValues(view_zero_menu, XmNmnemonic, 'y', NULL);
-
- view_x_axis_menu = XmCreatePulldownMenu(view_menu, (char *)"xaxis", main_args, main_n);
-
- k = main_n;
- XtSetArg(main_args[k], XmNsubMenuId, view_x_axis_menu); k++;
- view_x_axis_cascade_menu = XtCreateManagedWidget("X axis units", xmCascadeButtonWidgetClass, view_menu, main_args, k);
-
- view_x_axis_seconds_menu = XtCreateManagedWidget("seconds", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
- XtAddCallback(view_x_axis_seconds_menu, XmNactivateCallback, view_x_axis_seconds_callback, NULL);
- set_sensitive(view_x_axis_seconds_menu, false);
-
- view_x_axis_samples_menu = XtCreateManagedWidget("samples", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
- XtAddCallback(view_x_axis_samples_menu, XmNactivateCallback, view_x_axis_samples_callback, NULL);
-
- view_x_axis_clock_menu = XtCreateManagedWidget("clock", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
- XtAddCallback(view_x_axis_clock_menu, XmNactivateCallback, view_x_axis_clock_callback, NULL);
-
- view_x_axis_percentage_menu = XtCreateManagedWidget("percentage", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
- XtAddCallback(view_x_axis_percentage_menu, XmNactivateCallback, view_x_axis_percentage_callback, NULL);
-
- view_x_axis_beats_menu = XtCreateManagedWidget("beats", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
- XtAddCallback(view_x_axis_beats_menu, XmNactivateCallback, view_x_axis_beats_callback, NULL);
-
- view_x_axis_measures_menu = XtCreateManagedWidget("measures", xmPushButtonWidgetClass, view_x_axis_menu, main_args, main_n);
- XtAddCallback(view_x_axis_measures_menu, XmNactivateCallback, view_x_axis_measures_callback, NULL);
-
-
- view_axes_menu = XmCreatePulldownMenu(view_menu, (char *)"axes", main_args, main_n);
-
- k = main_n;
- XtSetArg(main_args[k], XmNsubMenuId, view_axes_menu); k++;
- view_axes_cascade_menu = XtCreateManagedWidget("Axes", xmCascadeButtonWidgetClass, view_menu, main_args, k);
-
- view_no_axes_menu = XtCreateManagedWidget("no axes", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
- XtAddCallback(view_no_axes_menu, XmNactivateCallback, view_no_axes_callback, NULL);
- if (show_axes(ss) == SHOW_NO_AXES) set_sensitive(view_no_axes_menu, false); /* false because it is already chosen */
-
- view_all_axes_menu = XtCreateManagedWidget("both axes", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
- XtAddCallback(view_all_axes_menu, XmNactivateCallback, view_all_axes_callback, NULL);
- if (show_axes(ss) == SHOW_ALL_AXES) set_sensitive(view_all_axes_menu, false);
-
- view_just_x_axis_menu = XtCreateManagedWidget("just x axis", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
- XtAddCallback(view_just_x_axis_menu, XmNactivateCallback, view_just_x_axis_callback, NULL);
- if (show_axes(ss) == SHOW_X_AXIS) set_sensitive(view_just_x_axis_menu, false);
-
- view_all_axes_unlabelled_menu = XtCreateManagedWidget("both axes, no labels", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
- XtAddCallback(view_all_axes_unlabelled_menu, XmNactivateCallback, view_all_axes_unlabelled_callback, NULL);
- if (show_axes(ss) == SHOW_ALL_AXES_UNLABELLED) set_sensitive(view_all_axes_unlabelled_menu, false);
-
- view_just_x_axis_unlabelled_menu = XtCreateManagedWidget("just x axis, no label", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
- XtAddCallback(view_just_x_axis_unlabelled_menu, XmNactivateCallback, view_just_x_axis_unlabelled_callback, NULL);
- if (show_axes(ss) == SHOW_X_AXIS_UNLABELLED) set_sensitive(view_just_x_axis_unlabelled_menu, false);
-
- view_bare_x_axis_menu = XtCreateManagedWidget("bare x axis", xmPushButtonWidgetClass, view_axes_menu, main_args, main_n);
- XtAddCallback(view_bare_x_axis_menu, XmNactivateCallback, view_bare_x_axis_callback, NULL);
- if (show_axes(ss) == SHOW_BARE_X_AXIS) set_sensitive(view_bare_x_axis_menu, false);
-
- view_focus_style_menu = XmCreatePulldownMenu(view_menu, (char *)"focusstyle", main_args, main_n);
-
- k = main_n;
- XtSetArg(main_args[k], XmNsubMenuId, view_focus_style_menu); k++;
- view_focus_cascade_menu = XtCreateManagedWidget("Zoom focus", xmCascadeButtonWidgetClass, view_menu, main_args, k);
-
- view_focus_left_menu = XtCreateManagedWidget("window left edge", xmPushButtonWidgetClass, view_focus_style_menu, main_args, main_n);
- XtAddCallback(view_focus_left_menu, XmNactivateCallback, view_focus_left_callback, NULL);
-
- view_focus_right_menu = XtCreateManagedWidget("window right edge", xmPushButtonWidgetClass, view_focus_style_menu, main_args, main_n);
- XtAddCallback(view_focus_right_menu, XmNactivateCallback, view_focus_right_callback, NULL);
-
- view_focus_middle_menu = XtCreateManagedWidget("window midpoint", xmPushButtonWidgetClass, view_focus_style_menu, main_args, main_n);
- XtAddCallback(view_focus_middle_menu, XmNactivateCallback, view_focus_middle_callback, NULL);
-
- view_focus_active_menu = XtCreateManagedWidget("cursor or selection", xmPushButtonWidgetClass, view_focus_style_menu, main_args, main_n);
- XtAddCallback(view_focus_active_menu, XmNactivateCallback, view_focus_active_callback, NULL);
-
-
- /* OPTIONS MENU */
- XtSetArg(main_args[main_n], XmNuserData, (XtPointer)3);
- options_menu = XmCreatePulldownMenu(main_menu, (char *)"Option", main_args, main_n + 1);
-
- high_n = start_high_n;
- XtSetArg(high_args[high_n], XmNsubMenuId, options_menu); high_n++;
- XtSetArg(high_args[high_n], XmNmnemonic, 'O'); high_n++;
- XtSetArg(high_args[high_n], XmNuserData, (XtPointer)3); high_n++;
- options_cascade_menu = XtCreateManagedWidget("Options", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
-
- options_transform_menu = XtCreateManagedWidget("Transform Options", xmPushButtonWidgetClass, options_menu, main_args, main_n);
- XtAddCallback(options_transform_menu, XmNactivateCallback, options_transform_callback, NULL);
- XtVaSetValues(options_transform_menu, XmNmnemonic, 't', NULL);
-
- options_controls_menu = XtCreateManagedWidget("Controls", xmPushButtonWidgetClass, options_menu, main_args, main_n);
- XtAddCallback(options_controls_menu, XmNactivateCallback, options_controls_callback, NULL);
- XtVaSetValues(options_controls_menu, XmNmnemonic, 'c', NULL);
-
-
-#if HAVE_EXTENSION_LANGUAGE
- options_save_menu = XtCreateManagedWidget("Save options", xmPushButtonWidgetClass, options_menu, main_args, main_n);
- XtAddCallback(options_save_menu, XmNactivateCallback, options_save_callback, NULL);
- XtVaSetValues(options_save_menu, XmNmnemonic, 'a', NULL);
-
- options_save_state_menu = XtCreateManagedWidget("Save session", xmPushButtonWidgetClass, options_menu, main_args, main_n);
- XtAddCallback(options_save_state_menu, XmNactivateCallback, options_save_state_callback, NULL);
-#endif
-
- options_sep_menu = XtCreateManagedWidget("", xmSeparatorWidgetClass, options_menu, sep_args, j);
-
- options_preferences_menu = XtCreateManagedWidget("Preferences", xmPushButtonWidgetClass, options_menu, main_args, main_n);
- XtAddCallback(options_preferences_menu, XmNactivateCallback, options_preferences_callback, NULL);
-
-
- /* HELP MENU */
- XtSetArg(main_args[main_n], XmNuserData, (XtPointer)4);
- help_menu = XmCreatePulldownMenu(main_menu, (char *)"Help", main_args, main_n + 1);
-
- high_n = start_high_n;
- XtSetArg(high_args[high_n], XmNsubMenuId, help_menu); high_n++;
- XtSetArg(high_args[high_n], XmNmnemonic, 'H'); high_n++;
- XtSetArg(high_args[high_n], XmNuserData, (XtPointer)4); high_n++;
- help_cascade_menu = XtCreateManagedWidget("Help", xmCascadeButtonWidgetClass, main_menu, high_args, high_n);
-
- help_about_snd_menu = XtCreateManagedWidget("About Snd", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_about_snd_menu, XmNactivateCallback, help_about_snd_callback, NULL);
- XtVaSetValues(help_about_snd_menu, XmNmnemonic, 'O', NULL);
-
-#if HAVE_EXTENSION_LANGUAGE
- help_init_file_menu = XtCreateManagedWidget("Customization", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_init_file_menu, XmNactivateCallback, help_init_file_callback, NULL);
-#endif
-
- help_controls_menu = XtCreateManagedWidget("Control Panel", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_controls_menu, XmNactivateCallback, help_controls_callback, NULL);
-
- help_keys_menu = XtCreateManagedWidget("Key bindings", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_keys_menu, XmNactivateCallback, help_keys_callback, NULL);
-
- help_recording_menu = XtCreateManagedWidget("Record", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_recording_menu, XmNactivateCallback, help_recording_callback, NULL);
-
- help_play_menu = XtCreateManagedWidget("Play", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_play_menu, XmNactivateCallback, help_play_callback, NULL);
-
- help_save_menu = XtCreateManagedWidget("Save", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_save_menu, XmNactivateCallback, help_save_callback, NULL);
-
- help_mix_menu = XtCreateManagedWidget("Mix", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_mix_menu, XmNactivateCallback, help_mix_callback, NULL);
-
- help_resample_menu = XtCreateManagedWidget("Resample", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_resample_menu, XmNactivateCallback, help_resample_callback, NULL);
-
- help_fft_menu = XtCreateManagedWidget("FFT", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_fft_menu, XmNactivateCallback, help_fft_callback, NULL);
-
- help_filter_menu = XtCreateManagedWidget("Filter", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_filter_menu, XmNactivateCallback, help_filter_callback, NULL);
-
- help_reverb_menu = XtCreateManagedWidget("Reverb", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_reverb_menu, XmNactivateCallback, help_reverb_callback, NULL);
-
- help_env_menu = XtCreateManagedWidget("Envelope", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_env_menu, XmNactivateCallback, help_env_callback, NULL);
-
- help_marks_menu = XtCreateManagedWidget("Mark", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_marks_menu, XmNactivateCallback, help_marks_callback, NULL);
-
- help_insert_menu = XtCreateManagedWidget("Insert", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_insert_menu, XmNactivateCallback, help_insert_callback, NULL);
-
- help_delete_menu = XtCreateManagedWidget("Delete", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_delete_menu, XmNactivateCallback, help_delete_callback, NULL);
-
- help_undo_menu = XtCreateManagedWidget("Undo and redo", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_undo_menu, XmNactivateCallback, help_undo_callback, NULL);
-
-#if HAVE_EXTENSION_LANGUAGE
- help_find_menu = XtCreateManagedWidget("Search", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_find_menu, XmNactivateCallback, help_find_callback, NULL);
-#endif
-
- help_sync_menu = XtCreateManagedWidget("Sync and Unite", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_sync_menu, XmNactivateCallback, help_sync_callback, NULL);
-
- help_sound_files_menu = XtCreateManagedWidget("Headers and Data", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_sound_files_menu, XmNactivateCallback, help_sound_files_callback, NULL);
-
- help_debug_menu = XtCreateManagedWidget("Debugging", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_debug_menu, XmNactivateCallback, help_debug_callback, NULL);
-
- help_region_menu = XtCreateManagedWidget("Regions", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_region_menu, XmNactivateCallback, help_region_callback, NULL);
-
- help_selection_menu = XtCreateManagedWidget("Selections", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_selection_menu, XmNactivateCallback, help_selection_callback, NULL);
-
- help_colors_menu = XtCreateManagedWidget("Colors", xmPushButtonWidgetClass, help_menu, main_args, main_n);
- XtAddCallback(help_colors_menu, XmNactivateCallback, help_colors_callback, NULL);
-
- XtVaSetValues(main_menu, XmNmenuHelpWidget, help_cascade_menu, NULL);
-
- XtAddCallback(file_cascade_menu, XmNcascadingCallback, file_menu_update_1, NULL);
- XtAddCallback(edit_cascade_menu, XmNcascadingCallback, edit_menu_update_1, NULL);
- XtAddCallback(view_cascade_menu, XmNcascadingCallback, view_menu_update_1, NULL);
-
-#ifndef SND_AS_WIDGET
- XtManageChild(main_menu);
-#endif
- return(main_menu);
-}
-
-
-/* -------------------------------- POPUP MENU -------------------------------- */
-
-static Widget basic_popup_menu = NULL, selection_popup_menu = NULL, fft_popup_menu = NULL;
-
-static Widget add_menu_item(Widget menu, const char *label, void (*callback)(Widget w, XtPointer info, XtPointer context))
-{
- Arg args[20];
- int n;
- Widget w;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- w = XtCreateManagedWidget(label, xmPushButtonWidgetClass, menu, args, n);
- XtAddCallback(w, XmNactivateCallback, callback, NULL);
- return(w);
-}
-
-static void popup_info_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp) display_info(sp);
-}
-
-static void popup_normalize_callback(Widget w, XtPointer info, XtPointer context)
-{
- mus_float_t scl[1];
- scl[0] = 1.0;
- scale_to(any_selected_sound(), current_channel(), scl, 1, OVER_SOUND);
-}
-
-
-static void popup_apply_controls_callback(Widget w, XtPointer info, XtPointer context)
-{
- menu_apply_controls(any_selected_sound());
-}
-
-
-static void popup_reset_controls_callback(Widget w, XtPointer info, XtPointer context)
-{
- menu_reset_controls(any_selected_sound());
-}
-
-static void popup_reverse_callback(Widget w, XtPointer info, XtPointer context)
-{
- reverse_sound(current_channel(), OVER_SOUND, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
-}
-
-
-static void stop_everything_callback(Widget w, XtPointer info, XtPointer context)
-{
- control_g(any_selected_sound());
-}
-
-
-void post_basic_popup_menu(void *e)
-{
- XButtonPressedEvent *event = (XButtonPressedEvent *)e;
- if (!basic_popup_menu)
- {
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNpopupEnabled, false); n++; /* this was XmPOPUP_AUTOMATIC_RECURSIVE */
- basic_popup_menu = XmCreatePopupMenu(MAIN_PANE(ss), (char *)"basic-popup-menu", args, n + 1);
-
- add_menu_item(basic_popup_menu, "Info", popup_info_callback);
- add_menu_item(basic_popup_menu, "Select all", edit_select_all_callback);
- add_menu_item(basic_popup_menu, "Stop!", stop_everything_callback);
- add_menu_item(basic_popup_menu, "-> 1.0", popup_normalize_callback);
- add_menu_item(basic_popup_menu, "Reverse", popup_reverse_callback);
- add_menu_item(basic_popup_menu, "Apply controls", popup_apply_controls_callback);
- add_menu_item(basic_popup_menu, "Reset controls", popup_reset_controls_callback);
- }
-
- XmMenuPosition(basic_popup_menu, event);
- XtManageChild(basic_popup_menu);
-}
-
-
-/* -------- selection popup -------- */
-
-static void popup_show_selection_callback(Widget w, XtPointer info, XtPointer context)
-{
- show_selection();
-}
-
-static void popup_zero_selection_callback(Widget w, XtPointer info, XtPointer context)
-{
- mus_float_t scl[1];
- scl[0] = 0.0;
- scale_by(NULL, scl, 1, OVER_SELECTION);
-}
-
-static void popup_normalize_selection_callback(Widget w, XtPointer info, XtPointer context)
-{
- mus_float_t scl[1];
- scl[0] = 1.0;
- scale_to(NULL, NULL, scl, 1, OVER_SELECTION);
-}
-
-static void popup_error_handler(const char *msg, void *data)
-{
- redirect_snd_error_to(NULL, NULL);
- redirect_snd_warning_to(NULL, NULL);
- report_in_minibuffer(any_selected_sound(), "%s: %s", (char *)data, msg);
-}
-
-static void popup_cut_to_new_callback_1(bool cut)
-{
- char *temp_file;
- io_error_t io_err = IO_NO_ERROR;
-
- temp_file = snd_tempnam();
- io_err = save_selection(temp_file, default_output_header_type(ss), default_output_data_format(ss), selection_srate(), NULL, SAVE_ALL_CHANS);
- if (io_err == IO_NO_ERROR)
- {
- if (cut) delete_selection(UPDATE_DISPLAY);
-
- ss->open_requestor = FROM_POPUP_CUT_TO_NEW;
- redirect_snd_error_to(popup_error_handler, (void *)"popup cut->new");
- snd_open_file(temp_file, FILE_READ_WRITE);
- redirect_snd_error_to(NULL, NULL);
-
- free(temp_file);
- }
-}
-
-static void popup_cut_to_new_callback(Widget w, XtPointer info, XtPointer context) {popup_cut_to_new_callback_1(true);}
-static void popup_copy_to_new_callback(Widget w, XtPointer info, XtPointer context) {popup_cut_to_new_callback_1(false);}
-
-static void crop(chan_info *cp)
-{
- if (selection_is_active_in_channel(cp))
- {
- mus_long_t beg, end, frames;
- frames = CURRENT_SAMPLES(cp);
- beg = selection_beg(cp);
- end = selection_end(cp);
- if (beg > 0)
- delete_samples(0, beg, cp, cp->edit_ctr);
- if (end < (frames - 1))
- delete_samples(end + 1, frames - end, cp, cp->edit_ctr);
- }
-}
-
-static void popup_crop_callback(Widget w, XtPointer info, XtPointer context)
-{
- for_each_chan(crop);
-}
-
-
-static void popup_cut_and_smooth_callback(Widget w, XtPointer info, XtPointer context)
-{
- for_each_chan(cut_and_smooth);
-}
-
-static void mark_selection(chan_info *cp)
-{
- if (selection_is_active_in_channel(cp))
- {
- add_mark(selection_beg(cp), NULL, cp);
- add_mark(selection_end(cp), NULL, cp);
- }
-}
-
-static void popup_mark_selection_callback(Widget w, XtPointer info, XtPointer context)
-{
- for_each_chan(mark_selection);
-}
-
-static void popup_reverse_selection_callback(Widget w, XtPointer info, XtPointer context)
-{
- reverse_sound(current_channel(), OVER_SELECTION, C_TO_XEN_INT(AT_CURRENT_EDIT_POSITION), 0);
-}
-
-static mus_float_t selection_max = 0.0;
-
-static void selection_info(chan_info *cp)
-{
- if ((selection_is_active_in_channel(cp)) &&
- (selection_maxamp(cp) > selection_max))
- selection_max = selection_maxamp(cp);
-}
-
-static void popup_selection_info_callback(Widget w, XtPointer info, XtPointer context)
-{
- selection_max = 0.0;
- for_each_chan(selection_info);
- report_in_minibuffer(any_selected_sound(), "selection max: %f", selection_max);
-}
-
-static void popup_selection_apply_controls_callback(Widget w, XtPointer info, XtPointer context)
-{
- ss->apply_choice = APPLY_TO_SELECTION;
- menu_apply_controls(any_selected_sound());
-}
-
-
-static void popup_loop_play_callback(Widget w, XtPointer info, XtPointer context)
-{
- if (ss->selection_play_stop)
- {
- stop_playing_all_sounds(PLAY_BUTTON_UNSET);
- reflect_play_selection_stop();
- }
- else
- {
- set_menu_label(edit_play_menu, "Stop");
- ss->selection_play_stop = true;
- loop_play_selection();
- }
-}
-
-
-void post_selection_popup_menu(void *e)
-{
- XButtonPressedEvent *event = (XButtonPressedEvent *)e;
- if (!selection_popup_menu)
- {
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNpopupEnabled, false); n++; /* this was XmPOPUP_AUTOMATIC_RECURSIVE */
- selection_popup_menu = XmCreatePopupMenu(MAIN_PANE(ss), (char *)"selection-popup-menu", args, n + 1);
-
- add_menu_item(selection_popup_menu, "Fill Window", popup_show_selection_callback);
- add_menu_item(selection_popup_menu, "Cut", edit_cut_callback);
- add_menu_item(selection_popup_menu, "Cut and smooth", popup_cut_and_smooth_callback);
- add_menu_item(selection_popup_menu, "Cut -> new", popup_cut_to_new_callback);
- add_menu_item(selection_popup_menu, "Save as", edit_save_as_callback);
- add_menu_item(selection_popup_menu, "Play", edit_play_callback);
- add_menu_item(selection_popup_menu, "Play looping", popup_loop_play_callback);
- add_menu_item(selection_popup_menu, "Crop", popup_crop_callback);
- add_menu_item(selection_popup_menu, "Unselect", edit_unselect_callback);
- add_menu_item(selection_popup_menu, "-> 0.0", popup_zero_selection_callback);
- add_menu_item(selection_popup_menu, "-> 1.0", popup_normalize_selection_callback);
- add_menu_item(selection_popup_menu, "Copy -> new", popup_copy_to_new_callback);
- add_menu_item(selection_popup_menu, "Paste", edit_paste_callback);
- add_menu_item(selection_popup_menu, "Mix", edit_mix_callback);
- add_menu_item(selection_popup_menu, "Mark", popup_mark_selection_callback);
- add_menu_item(selection_popup_menu, "Reverse", popup_reverse_selection_callback);
- add_menu_item(selection_popup_menu, "Apply controls", popup_selection_apply_controls_callback);
- add_menu_item(selection_popup_menu, "Info", popup_selection_info_callback);
- }
-
- XmMenuPosition(selection_popup_menu, event);
- XtManageChild(selection_popup_menu);
-}
-
-
-/* -------- fft popup -------- */
-
-static void popup_peaks_callback(Widget w, XtPointer info, XtPointer context)
-{
- FILE *peaks_fd;
- peaks_fd = FOPEN("fft.txt", "w");
- if (peaks_fd)
- {
- write_transform_peaks(peaks_fd, current_channel()); /* follows sync */
- fclose(peaks_fd);
- }
-}
-
-static void fft_size_16_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(16);}
-static void fft_size_64_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(64);}
-static void fft_size_256_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(256);}
-static void fft_size_1024_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(1024);}
-static void fft_size_4096_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(4096);}
-static void fft_size_16384_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(16384);}
-static void fft_size_65536_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(65536);}
-static void fft_size_262144_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(262144);}
-static void fft_size_1048576_callback(Widget w, XtPointer info, XtPointer context) {set_transform_size(1048576);}
-
-
-static void fft_window_rectangular_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_RECTANGULAR_WINDOW);}
-static void fft_window_hann_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_HANN_WINDOW);}
-static void fft_window_welch_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_WELCH_WINDOW);}
-static void fft_window_parzen_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_PARZEN_WINDOW);}
-static void fft_window_bartlett_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BARTLETT_WINDOW);}
-static void fft_window_blackman2_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN2_WINDOW);}
-static void fft_window_blackman3_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN3_WINDOW);}
-static void fft_window_blackman4_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN4_WINDOW);}
-static void fft_window_hamming_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_HAMMING_WINDOW);}
-static void fft_window_exponential_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_EXPONENTIAL_WINDOW);}
-static void fft_window_riemann_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_RIEMANN_WINDOW);}
-static void fft_window_kaiser_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_KAISER_WINDOW);}
-static void fft_window_cauchy_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_CAUCHY_WINDOW);}
-static void fft_window_poisson_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_POISSON_WINDOW);}
-static void fft_window_gaussian_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_GAUSSIAN_WINDOW);}
-static void fft_window_tukey_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_TUKEY_WINDOW);}
-static void fft_window_dolph_chebyshev_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_DOLPH_CHEBYSHEV_WINDOW);}
-static void fft_window_blackman6_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN6_WINDOW);}
-static void fft_window_blackman8_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN8_WINDOW);}
-static void fft_window_blackman10_callback(Widget w, XtPointer info, XtPointer context) {set_fft_window(MUS_BLACKMAN10_WINDOW);}
-
-static void fft_type_fourier_callback(Widget w, XtPointer info, XtPointer context) {set_transform_type(FOURIER);}
-static void fft_type_wavelet_callback(Widget w, XtPointer info, XtPointer context) {set_transform_type(WAVELET);}
-static void fft_type_autocorrelation_callback(Widget w, XtPointer info, XtPointer context) {set_transform_type(AUTOCORRELATION);}
-static void fft_type_cepstrum_callback(Widget w, XtPointer info, XtPointer context) {set_transform_type(CEPSTRUM);}
-
-
-static void fft_graph_once_callback(Widget w, XtPointer info, XtPointer context) {set_transform_graph_type(GRAPH_ONCE);}
-static void fft_graph_sonogram_callback(Widget w, XtPointer info, XtPointer context) {set_transform_graph_type(GRAPH_AS_SONOGRAM);}
-static void fft_graph_spectrogram_callback(Widget w, XtPointer info, XtPointer context) {set_transform_graph_type(GRAPH_AS_SPECTROGRAM);}
-
-
-static void fft_gray_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(GRAY_COLORMAP);}
-static void fft_hot_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(HOT_COLORMAP);}
-static void fft_cool_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(COOL_COLORMAP);}
-static void fft_bone_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(BONE_COLORMAP);}
-static void fft_copper_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(COPPER_COLORMAP);}
-static void fft_pink_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(PINK_COLORMAP);}
-static void fft_jet_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(JET_COLORMAP);}
-static void fft_prism_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(PRISM_COLORMAP);}
-static void fft_autumn_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(AUTUMN_COLORMAP);}
-static void fft_winter_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(WINTER_COLORMAP);}
-static void fft_spring_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(SPRING_COLORMAP);}
-static void fft_summer_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(SUMMER_COLORMAP);}
-static void fft_rainbow_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(RAINBOW_COLORMAP);}
-static void fft_flag_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(FLAG_COLORMAP);}
-static void fft_phases_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(PHASES_COLORMAP);}
-static void fft_black_and_white_callback(Widget w, XtPointer info, XtPointer context) {set_color_map(BLACK_AND_WHITE_COLORMAP);}
-
-void post_fft_popup_menu(void *e)
-{
- XButtonPressedEvent *event = (XButtonPressedEvent *)e;
- if (!fft_popup_menu)
- {
- Widget outer_menu, cascade_menu;
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNpopupEnabled, false); n++; /* this was XmPOPUP_AUTOMATIC_RECURSIVE */
- fft_popup_menu = XmCreatePopupMenu(MAIN_PANE(ss), (char *)"fft-popup-menu", args, n + 1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Size", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
- cascade_menu = XtCreateManagedWidget("Size", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
-
- add_menu_item(outer_menu, "16", fft_size_16_callback);
- add_menu_item(outer_menu, "64", fft_size_64_callback);
- add_menu_item(outer_menu, "256", fft_size_256_callback);
- add_menu_item(outer_menu, "1024", fft_size_1024_callback);
- add_menu_item(outer_menu, "4096", fft_size_4096_callback);
- add_menu_item(outer_menu, "16384", fft_size_16384_callback);
- add_menu_item(outer_menu, "65536", fft_size_65536_callback);
- add_menu_item(outer_menu, "262144", fft_size_262144_callback);
- add_menu_item(outer_menu, "1048576", fft_size_1048576_callback);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Window", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
- cascade_menu = XtCreateManagedWidget("Window", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
-
- add_menu_item(outer_menu, "rectangular", fft_window_rectangular_callback);
- add_menu_item(outer_menu, "hann", fft_window_hann_callback);
- add_menu_item(outer_menu, "welch", fft_window_welch_callback);
- add_menu_item(outer_menu, "parzen", fft_window_parzen_callback);
- add_menu_item(outer_menu, "bartlett", fft_window_bartlett_callback);
- add_menu_item(outer_menu, "hamming", fft_window_hamming_callback);
- add_menu_item(outer_menu, "blackman2", fft_window_blackman2_callback);
- add_menu_item(outer_menu, "blackman3", fft_window_blackman3_callback);
- add_menu_item(outer_menu, "blackman4", fft_window_blackman4_callback);
- add_menu_item(outer_menu, "exponential", fft_window_exponential_callback);
- add_menu_item(outer_menu, "riemann", fft_window_riemann_callback);
- add_menu_item(outer_menu, "kaiser", fft_window_kaiser_callback);
- add_menu_item(outer_menu, "cauchy", fft_window_cauchy_callback);
- add_menu_item(outer_menu, "poisson", fft_window_poisson_callback);
- add_menu_item(outer_menu, "gaussian", fft_window_gaussian_callback);
- add_menu_item(outer_menu, "tukey", fft_window_tukey_callback);
- add_menu_item(outer_menu, "dolph-chebyshev", fft_window_dolph_chebyshev_callback);
- add_menu_item(outer_menu, "blackman6", fft_window_blackman6_callback);
- add_menu_item(outer_menu, "blackman8", fft_window_blackman8_callback);
- add_menu_item(outer_menu, "blackman10" , fft_window_blackman10_callback);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Graph type", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
- cascade_menu = XtCreateManagedWidget("Graph type", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
-
- add_menu_item(outer_menu, "one fft", fft_graph_once_callback);
- add_menu_item(outer_menu, "sonogram", fft_graph_sonogram_callback);
- add_menu_item(outer_menu, "spectrogram", fft_graph_spectrogram_callback);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Transform type", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
- cascade_menu = XtCreateManagedWidget("Transform type", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
-
- add_menu_item(outer_menu, "fourier", fft_type_fourier_callback);
- add_menu_item(outer_menu, "wavelet", fft_type_wavelet_callback);
- add_menu_item(outer_menu, "autocorrelation", fft_type_autocorrelation_callback);
- add_menu_item(outer_menu, "cepstrum", fft_type_cepstrum_callback);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- outer_menu = XmCreatePulldownMenu(fft_popup_menu, (char *)"Colormap", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNsubMenuId, outer_menu); n++;
- cascade_menu = XtCreateManagedWidget("Colormap", xmCascadeButtonWidgetClass, fft_popup_menu, args, n);
-
- add_menu_item(outer_menu, "gray", fft_gray_callback);
- add_menu_item(outer_menu, "autumn", fft_autumn_callback);
- add_menu_item(outer_menu, "spring", fft_spring_callback);
- add_menu_item(outer_menu, "winter", fft_winter_callback);
- add_menu_item(outer_menu, "summer", fft_summer_callback);
- add_menu_item(outer_menu, "cool", fft_cool_callback);
- add_menu_item(outer_menu, "copper", fft_copper_callback);
- add_menu_item(outer_menu, "flag", fft_flag_callback);
- add_menu_item(outer_menu, "prism", fft_prism_callback);
- add_menu_item(outer_menu, "bone", fft_bone_callback);
- add_menu_item(outer_menu, "hot", fft_hot_callback);
- add_menu_item(outer_menu, "jet", fft_jet_callback);
- add_menu_item(outer_menu, "pink", fft_pink_callback);
- add_menu_item(outer_menu, "rainbow", fft_rainbow_callback);
- add_menu_item(outer_menu, "phases", fft_phases_callback);
- add_menu_item(outer_menu, "black and white", fft_black_and_white_callback);
-
-
- add_menu_item(fft_popup_menu, "Peaks->fft.txt", popup_peaks_callback);
- }
-
- XmMenuPosition(fft_popup_menu, event);
- XtManageChild(fft_popup_menu);
-}
-
-
-
-void post_lisp_popup_menu(void *e) {}
-
-
-
-
-/* ---------------- tooltips ---------------- */
-
-static Widget tooltip_shell = NULL;
-static Widget tooltip_label = NULL;
-static timeout_result_t tool_proc = 0, quit_proc = 0;
-static Time tool_last_time = 0;
-static Position tool_x, tool_y;
-static Widget tool_w;
-
-static void leave_tooltip(XtPointer tooltip, XtIntervalId *id)
-{
- XtUnmanageChild(tooltip_shell);
- quit_proc = 0;
-}
-
-
-static void handle_tooltip(XtPointer tooltip, XtIntervalId *id)
-{
- char *tip = (char *)tooltip;
- Position rx, ry;
- XmString str;
- int lines = 0;
-
- if (!tooltip_shell)
- {
- tooltip_shell = XtVaCreatePopupShell(tip, overrideShellWidgetClass, MAIN_SHELL(ss),
- XmNallowShellResize, true,
- NULL);
- tooltip_label = XtVaCreateManagedWidget("tooltip", xmLabelWidgetClass, tooltip_shell,
- XmNrecomputeSize, true,
- XmNbackground, ss->lighter_blue,
- NULL);
- }
- str = multi_line_label(tip, &lines);
- XtVaSetValues(tooltip_label, XmNlabelString, str, NULL);
- XmStringFree(str);
-
- XtTranslateCoords(tool_w, tool_x, tool_y, &rx, &ry);
- XtVaSetValues(tooltip_shell, XmNx, rx, XmNy, ry, NULL);
- XtManageChild(tooltip_shell);
- quit_proc = XtAppAddTimeOut(MAIN_APP(ss), (unsigned long)10000, (XtTimerCallbackProc)leave_tooltip, NULL);
-}
-
-
-static void tool_starter(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XEnterWindowEvent *ev = (XEnterWindowEvent *)event;
- char *tip = (char *)context;
- if ((with_tooltips(ss)) &&
- ((ev->time - tool_last_time) > 2))
- {
- tool_x = ev->x;
- tool_y = ev->y;
- tool_w = w;
- tool_last_time = ev->time;
- tool_proc = XtAppAddTimeOut(MAIN_APP(ss), (unsigned long)300, (XtTimerCallbackProc)handle_tooltip, (XtPointer)tip);
- }
-}
-
-
-static void tool_stopper(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XLeaveWindowEvent *ev = (XLeaveWindowEvent *)event;
- tool_last_time = ev->time;
- if (tool_proc != 0)
- {
- XtRemoveTimeOut(tool_proc);
- tool_proc = 0;
- }
- if (quit_proc != 0)
- {
- XtRemoveTimeOut(quit_proc);
- quit_proc = 0;
- }
- if ((tooltip_shell) && (XtIsManaged(tooltip_shell)))
- XtUnmanageChild(tooltip_shell);
-}
-
-
-void add_tooltip(Widget w, const char *tip)
-{
- XtAddEventHandler(w, EnterWindowMask, false, tool_starter, (XtPointer)tip);
- XtAddEventHandler(w, LeaveWindowMask, false, tool_stopper, NULL);
-}
-
-
-
-/* ---------------- toolbar ---------------- */
-
-static void add_to_toolbar(Widget bar, Pixmap icon, const char *tip, void (*callback)(Widget w, XtPointer info, XtPointer context))
-{
- Widget w;
- w = XtVaCreateManagedWidget("icon", xmPushButtonWidgetClass, bar,
- XmNlabelPixmap, icon,
- XmNlabelType, XmPIXMAP,
- XmNwidth, 24,
- XmNheight, 24,
- XmNshadowThickness, 0,
- XmNhighlightThickness, 0,
- /* XmNmarginHeight, 0, */
- XmNbackground, ss->basic_color,
- NULL);
- XtAddCallback(w, XmNactivateCallback, callback, NULL);
- add_tooltip(w, tip);
-}
-
-
-static void add_separator_to_toolbar(Widget bar)
-{
- XtVaCreateManagedWidget("icon", xmPushButtonWidgetClass, bar,
- XmNlabelPixmap, toolbar_icon(SND_XPM_SEPARATOR),
- XmNlabelType, XmPIXMAP,
- XmNwidth, 8,
- XmNheight, 24,
- XmNshadowThickness, 0,
- XmNhighlightThickness, 0,
- XmNbackground, ss->basic_color,
- NULL);
-}
-
-
-static void play_from_start_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- play_sound(sp, 0, NO_END_SPECIFIED);
-}
-
-
-static void play_from_cursor_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- {
- chan_info *cp;
- cp = any_selected_channel(sp);
- if (cp)
- play_sound(sp, CURSOR(cp), NO_END_SPECIFIED);
- }
-}
-
-
-static void stop_playing_callback(Widget w, XtPointer info, XtPointer context)
-{
- stop_playing_all_sounds(PLAY_C_G);
- reflect_play_selection_stop(); /* this sets ss->selection_play_stop = false; */
-}
-
-
-static void full_dur_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- {
- int i;
- for (i = 0; i < sp->nchans; i++)
- set_x_axis_x0x1(sp->chans[i], 0.0, sp->chans[i]->axis->xmax);
- }
-}
-
-
-static void zoom_out_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- {
- int i;
- for (i = 0; i < sp->nchans; i++)
- zx_incremented(sp->chans[i], 2.0);
- }
-}
-
-
-static void zoom_in_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- {
- int i;
- for (i = 0; i < sp->nchans; i++)
- zx_incremented(sp->chans[i], 0.5);
- }
-}
-
-
-static void goto_start_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- {
- int i;
- for (i = 0; i < sp->nchans; i++)
- set_x_axis_x0x1(sp->chans[i], 0.0, sp->chans[i]->axis->x1 - sp->chans[i]->axis->x0);
- }
-}
-
-static void go_back_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- {
- int i;
- for (i = 0; i < sp->nchans; i++)
- sx_incremented(sp->chans[i], -1.0);
- }
-}
-
-
-static void go_forward_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- {
- int i;
- for (i = 0; i < sp->nchans; i++)
- sx_incremented(sp->chans[i], 1.0);
- }
-}
-
-static void goto_end_callback(Widget w, XtPointer info, XtPointer context)
-{
- snd_info *sp;
- sp = any_selected_sound();
- if (sp)
- {
- int i;
- for (i = 0; i < sp->nchans; i++)
- set_x_axis_x0x1(sp->chans[i], sp->chans[i]->axis->xmax - sp->chans[i]->axis->x1 + sp->chans[i]->axis->x0, sp->chans[i]->axis->xmax);
- }
-}
-
-
-
-static Widget toolbar = NULL;
-
-void show_toolbar(void)
-{
- if (!toolbar)
- {
- #define ICON_HEIGHT 28
- Arg args[32];
- int n;
-
- XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
-
- n = attach_all_sides(args, 0);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNheight, ICON_HEIGHT); n++;
- XtSetArg(args[n], XmNpaneMaximum, ICON_HEIGHT); n++; /* Xm/Paned initializes each pane max to 1000 apparently! */
- XtSetArg(args[n], XmNpositionIndex, 0); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
-
- if ((sound_style(ss) == SOUNDS_IN_NOTEBOOK) ||
- (sound_style(ss) == SOUNDS_HORIZONTAL))
- toolbar = XtCreateManagedWidget("toolbar", xmRowColumnWidgetClass, SOUND_PANE_BOX(ss), args, n);
- else toolbar = XtCreateManagedWidget("toolbar", xmRowColumnWidgetClass, SOUND_PANE(ss), args, n);
- ss->toolbar = toolbar;
-
- if (auto_resize(ss))
- XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
-
- make_toolbar_icons(MAIN_SHELL(ss));
-
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_NEW), "new sound", file_new_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_OPEN), "open sound", file_open_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_SAVE), "save selected sound", file_save_as_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_REVERT), "revert to saved", file_revert_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_UNDO), "undo edit", edit_undo_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_REDO), "redo last (undone) edit", edit_redo_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_CLOSE), "close selected sound", file_close_callback);
- add_separator_to_toolbar(toolbar);
-
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_PLAY), "play from the start", play_from_start_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_CURSOR_PLAY), "play from the cursor", play_from_cursor_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_STOP_PLAY), "stop playing", stop_playing_callback);
- add_separator_to_toolbar(toolbar);
-
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_UP), "show full sound", full_dur_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_ZOOM_OUT), "zoom out", zoom_out_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_ZOOM_IN), "zoom in", zoom_in_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_BACK_ARROW), "go to start of sound", goto_start_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_BACK), "go back a window", go_back_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_NEXT), "go forward a window", go_forward_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_FORWARD_ARROW), "go to end of sound", goto_end_callback);
- add_separator_to_toolbar(toolbar);
-
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_CUT), "delete selection", edit_cut_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_PASTE), "insert selection at cursor", edit_paste_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_PREFERENCES), "open preferences dialog", options_preferences_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_STOP), "stop the current operation", stop_everything_callback);
- add_to_toolbar(toolbar, toolbar_icon(SND_XPM_EXIT), "exit Snd", file_exit_callback);
-
- }
- else
- {
- XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
- XtManageChild(toolbar);
- if (auto_resize(ss))
- XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
- }
-}
-
-
-void hide_toolbar(void)
-{
- if (toolbar)
- {
- XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
- XtUnmanageChild(toolbar);
- if (auto_resize(ss))
- XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
- }
-}
-
-
-
-
-/* ---------------- ext lang tie-ins ---------------- */
-
-#define INVALID_MENU -1
-#define CALL_INDEX(Data) (Data >> 16)
-#define PACK_MENU_DATA(Slot, Menu) ((Slot << 16) | (Menu))
-
-static void SND_callback(Widget w, XtPointer info, XtPointer context)
-{
- pointer_or_int_t callb;
- XtVaGetValues(w, XmNuserData, &callb, NULL);
- g_snd_callback(CALL_INDEX(callb)); /* menu option activate callback */
-}
-
-
-static void GHC_callback(Widget w, XtPointer info, XtPointer context)
-{
- pointer_or_int_t slot;
- XtVaGetValues(w, XmNuserData, &slot, NULL);
- g_snd_callback(CALL_INDEX(slot)); /* main menu cascading callback */
-}
-
-
-static Widget *main_menus = NULL;
-static int main_menus_size = 0;
-/* fancy code here looping through the main menus children hangs or segfaults in 86_64 unoptimized cases! */
-
-Widget menu_widget(int which_menu)
-{
- switch (which_menu)
- {
- case 0: return(file_menu); break;
- case 1: return(edit_menu); break;
- case 2: return(view_menu); break;
- case 3: return(options_menu); break;
- case 4: return(help_menu); break;
-
- default:
- if (which_menu < main_menus_size)
- return(main_menus[which_menu]);
- break;
- }
- return(NULL);
-}
-
-
-#include <X11/IntrinsicP.h>
-
-static bool or_over_children(Widget w, bool (*func)(Widget uw, const char *ustr), const char *str)
-{
- if (w)
- {
- if ((*func)(w, str)) return(true);
- if (XtIsComposite(w))
- {
- unsigned int i;
- CompositeWidget cw = (CompositeWidget)w;
- for (i = 0; i < cw->composite.num_children; i++)
- if (or_over_children(cw->composite.children[i], func, str))
- return(true);
- }
- }
- return(false);
-}
-
-
-static bool clobber_menu(Widget w, const char *name)
-{
- char *wname;
- wname = XtName(w);
- if ((wname) &&
- (mus_strcmp(name, wname)) &&
- (XtIsManaged(w)))
- {
- pointer_or_int_t slot;
- XtVaGetValues(w, XmNuserData, &slot, NULL);
- unprotect_callback(CALL_INDEX(slot));
- XtUnmanageChild(w);
- return(true);
- }
- return(false);
-}
-
-
-int g_remove_from_menu(int which_menu, const char *label)
-{
- Widget top_menu;
- top_menu = menu_widget(which_menu);
- if (top_menu)
- {
- or_over_children(top_menu, clobber_menu, label);
- return(0);
- }
- return(INVALID_MENU);
-}
-
-
-static void set_widget_name(Widget w, const char *new_name)
-{
- /* based on XtName in Xt/Intrinsic.c, Xt/Create.c, and Xt/ResourceI.h */
- w->core.xrm_name = XrmStringToName(new_name);
-}
-
-
-static int new_menu = 5;
-
-int g_add_to_main_menu(const char *label, int slot)
-{
- static Arg args[12];
- Widget m, cas;
- int n;
-
- if (auto_resize(ss)) XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, false, NULL);
- new_menu++;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNuserData, PACK_MENU_DATA(slot, new_menu)); n++;
- m = XmCreatePulldownMenu(main_menu, (char *)label, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNsubMenuId, m); n++;
- XtSetArg(args[n], XmNuserData, PACK_MENU_DATA(slot, new_menu)); n++;
- cas = XtCreateManagedWidget(label, xmCascadeButtonWidgetClass, main_menu, args, n);
- if (slot >= 0) XtAddCallback(cas, XmNcascadingCallback, GHC_callback, NULL);
-
- if (auto_resize(ss)) XtVaSetValues(MAIN_SHELL(ss), XmNallowShellResize, true, NULL);
-
- if (main_menus_size == 0)
- {
- main_menus_size = 8;
- main_menus = (Widget *)calloc(main_menus_size, sizeof(Widget));
- }
- else
- {
- if (new_menu >= main_menus_size)
- {
- main_menus_size = new_menu + 8;
- main_menus = (Widget *)realloc(main_menus, main_menus_size * sizeof(Widget));
- }
- }
- main_menus[new_menu] = m;
- return(new_menu);
-}
-
-
-Widget g_add_to_menu(int which_menu, const char *label, int callb, int position)
-{
- Widget m, menw;
- Arg args[12];
- int n = 0;
- unsigned int i;
- menw = menu_widget(which_menu);
- if (menw == NULL) return(NULL);
- if (label)
- {
- /* look for currently unused widget first */
- /* but close-all and open-recent should be left alone! */
- CompositeWidget cw = (CompositeWidget)menw;
- for (i = 0; i < cw->composite.num_children; i++)
- {
- m = cw->composite.children[i];
- if ((m) &&
- (!(XtIsManaged(m))) &&
- (m != file_close_all_menu) &&
- (m != file_open_recent_menu) &&
- (m != file_open_recent_cascade_menu))
- {
- if (!(mus_strcmp(XtName(m), label)))
- {
- set_widget_name(m, label);
- set_button_label(m, label);
- }
- if (position >= 0) XtVaSetValues(m, XmNpositionIndex, position, NULL);
- XtVaSetValues(m, XmNuserData, PACK_MENU_DATA(callb, which_menu), NULL);
- XtManageChild(m);
- return(m);
- }
- }
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- if (position >= 0) {XtSetArg(args[n], XmNpositionIndex, position); n++;}
- XtSetArg(args[n], XmNuserData, PACK_MENU_DATA(callb, which_menu)); n++;
- m = XtCreateManagedWidget(label, xmPushButtonWidgetClass, menw, args, n);
- XtAddCallback(m, XmNactivateCallback, SND_callback, NULL);
- }
- else
- {
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- if (position >= 0) {XtSetArg(args[n], XmNpositionIndex, position); n++;}
- m = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, menw, args, n);
- }
- return(m);
-}
-
-
-static XEN g_menu_widgets(void)
-{
- #define H_menu_widgets "(" S_menu_widgets "): a list of top level menu widgets: ((0)main (1)file (2)edit (3)view (4)options (5)help)"
- return(XEN_CONS(XEN_WRAP_WIDGET(main_menu),
- XEN_CONS(XEN_WRAP_WIDGET(file_cascade_menu),
- XEN_CONS(XEN_WRAP_WIDGET(edit_cascade_menu),
- XEN_CONS(XEN_WRAP_WIDGET(view_cascade_menu),
- XEN_CONS(XEN_WRAP_WIDGET(options_cascade_menu),
- XEN_CONS(XEN_WRAP_WIDGET(help_cascade_menu),
- XEN_EMPTY_LIST)))))));
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_menu_widgets_w, g_menu_widgets)
-#else
-#define g_menu_widgets_w g_menu_widgets
-#endif
-
-void g_init_gxmenu(void)
-{
- XEN_DEFINE_PROCEDURE(S_menu_widgets, g_menu_widgets_w, 0, 0, 0, H_menu_widgets);
-}
-
-/* Motif bug: the button backgrounds remain in the original highlight color? but the widget (if it is one) is not the child of any obvious widget
- */
diff --git a/snd-xmix.c b/snd-xmix.c
deleted file mode 100644
index 9076899..0000000
--- a/snd-xmix.c
+++ /dev/null
@@ -1,1122 +0,0 @@
-#include "snd.h"
-
-#define NAME_COLUMNS 8
-
-/* ---------------- mix dialog ---------------- */
-
-static Widget mix_dialog = NULL;
-static int mix_dialog_id = INVALID_MIX_ID, old_mix_dialog_id = INVALID_MIX_ID;
-static env *dialog_env = NULL;
-
-static bool dragging = false;
-static int edpos_before_drag;
-static with_hook_t hookable_before_drag;
-static mus_long_t drag_beg = 0, drag_end = 0;
-
-static void start_dragging(int mix_id)
-{
- chan_info *cp;
- cp = mix_chan_info_from_id(mix_id);
- edpos_before_drag = cp->edit_ctr;
- hookable_before_drag = cp->hookable;
- cp->hookable = WITHOUT_HOOK;
- dragging = true;
- drag_beg = mix_position_from_id(mix_id);
- drag_end = drag_beg + mix_length_from_id(mix_id);
- start_dragging_syncd_mixes(mix_id);
-}
-
-
-static void keep_dragging(int mix_id)
-{
- chan_info *cp;
- cp = mix_chan_info_from_id(mix_id);
- cp->edit_ctr = edpos_before_drag;
- keep_dragging_syncd_mixes(mix_id);
-}
-
-
-static void stop_dragging(int mix_id)
-{
- chan_info *cp;
- cp = mix_chan_info_from_id(mix_id);
- undo_edit(cp, 1);
- cp->hookable = hookable_before_drag;
- dragging = false;
- stop_dragging_syncd_mixes(mix_id);
-}
-
-
-/* -------- speed -------- */
-
-static Widget w_speed_number, w_speed_label, w_speed;
-static speed_style_t xmix_speed_control_style = SPEED_CONTROL_AS_FLOAT;
-
-static int speed_to_scrollbar(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0);
- if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
- return(snd_round(0.9 * SCROLLBAR_MAX * ((log(val) - log(minval)) / (log(maxval) - log(minval)))));
-}
-
-
-static mus_float_t set_speed_label(Widget speed_number, int ival)
-{
- char speed_number_buffer[6];
- mus_float_t speed;
- speed = speed_changed(exp((ival * (log(speed_control_max(ss)) - log(speed_control_min(ss))) / (0.9 * SCROLLBAR_MAX)) + log(speed_control_min(ss))),
- speed_number_buffer,
- xmix_speed_control_style,
- speed_control_tones(ss),
- 6);
- set_label(speed_number, speed_number_buffer);
- return(speed);
-}
-
-
-static void mix_speed_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- char speed_number_buffer[6];
- mus_float_t speed;
-
- if (!(mix_is_active(mix_dialog_id))) return;
- speed = speed_changed(1.0,
- speed_number_buffer,
- xmix_speed_control_style,
- speed_control_tones(ss),
- 6);
-
- drag_beg = mix_position_from_id(mix_dialog_id);
- drag_end = drag_beg + mix_length_from_id(mix_dialog_id);
-
- mix_set_speed_edit(mix_dialog_id, speed);
- syncd_mix_set_speed(mix_dialog_id, speed);
- after_mix_edit(mix_dialog_id);
- set_label(w_speed_number, speed_number_buffer);
- XtVaSetValues(w_speed, XmNvalue, speed_to_scrollbar(speed_control_min(ss), 1.0, speed_control_max(ss)), NULL);
-}
-
-
-static void mix_speed_label_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- char speed_number_buffer[6];
- if (!(mix_is_active(mix_dialog_id))) return;
- switch (xmix_speed_control_style)
- {
- default:
- case SPEED_CONTROL_AS_FLOAT: xmix_speed_control_style = SPEED_CONTROL_AS_RATIO; break;
- case SPEED_CONTROL_AS_RATIO: xmix_speed_control_style = SPEED_CONTROL_AS_SEMITONE; break;
- case SPEED_CONTROL_AS_SEMITONE: xmix_speed_control_style = SPEED_CONTROL_AS_FLOAT; break;
- }
- speed_changed(mix_speed_from_id(mix_dialog_id),
- speed_number_buffer,
- xmix_speed_control_style,
- speed_control_tones(ss),
- 6);
- set_label(w_speed_number, speed_number_buffer);
-}
-
-
-static void mix_speed_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- int ival;
- mus_float_t speed;
- mus_long_t beg, end;
-
- if (!(mix_is_active(mix_dialog_id))) return;
-
- ival = ((XmScrollBarCallbackStruct *)info)->value;
- if (!dragging)
- start_dragging(mix_dialog_id);
- else keep_dragging(mix_dialog_id);
-
- speed = set_speed_label(w_speed_number, ival);
- mix_set_speed_edit(mix_dialog_id, speed);
-
- beg = mix_position_from_id(mix_dialog_id);
- end = beg + mix_length_from_id(mix_dialog_id);
- if (drag_beg > beg) drag_beg = beg;
- if (drag_end < end) drag_end = end;
-
- mix_display_during_drag(mix_dialog_id, drag_beg, drag_end);
- syncd_mix_set_speed(mix_dialog_id, speed);
-}
-
-
-static void mix_speed_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- mus_float_t speed;
-
- if (!(mix_is_active(mix_dialog_id))) return;
- if (dragging)
- stop_dragging(mix_dialog_id);
-
- speed = set_speed_label(w_speed_number, cb->value);
- mix_set_speed_edit(mix_dialog_id, speed);
- syncd_mix_set_speed(mix_dialog_id, speed);
- after_mix_edit(mix_dialog_id);
- after_syncd_mix_edit(mix_dialog_id);
-}
-
-
-/* -------- amp -------- */
-
-static Widget w_amp_number, w_amp_label, w_amp;
-
-static mus_float_t scrollbar_to_amp(int val)
-{
- if (val <= 0)
- return(amp_control_min(ss));
- if (val >= (0.9 * SCROLLBAR_MAX))
- return(amp_control_max(ss));
- if (val > (0.5 * 0.9 * SCROLLBAR_MAX))
- return((((val / (0.5 * 0.9 * SCROLLBAR_MAX)) - 1.0) * (amp_control_max(ss) - 1.0)) + 1.0);
- else return((val * (1.0 - amp_control_min(ss)) / (0.5 * 0.9 * SCROLLBAR_MAX)) + amp_control_min(ss));
-}
-
-
-static int amp_to_scrollbar(Widget amp_number, mus_float_t amp)
-{
- char sfs[6];
- mus_snprintf(sfs, 6, "%.2f", amp);
- set_label(amp_number, sfs);
- return(amp_to_scroll(amp_control_min(ss), amp, amp_control_max(ss)));
-}
-
-
-static void change_mix_amp(int mix_id, mus_float_t val)
-{
- char sfs[6];
- mix_set_amp_edit(mix_id, val);
- syncd_mix_set_amp(mix_id, val);
- mus_snprintf(sfs, 6, "%.2f", val);
- set_label(w_amp_number, sfs);
-}
-
-
-static void mix_amp_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (!(mix_is_active(mix_dialog_id))) return;
- change_mix_amp(mix_dialog_id, 1.0);
- after_mix_edit(mix_dialog_id);
- XtVaSetValues(w_amp, XmNvalue, amp_to_scroll(amp_control_min(ss), 1.0, amp_control_max(ss)), NULL);
-}
-
-
-static void mix_amp_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- int ival;
- if (!(mix_is_active(mix_dialog_id))) return;
- ival = ((XmScrollBarCallbackStruct *)info)->value;
- if (!dragging)
- start_dragging(mix_dialog_id);
- else keep_dragging(mix_dialog_id);
- change_mix_amp(mix_dialog_id, scrollbar_to_amp(ival));
- mix_display_during_drag(mix_dialog_id, drag_beg, drag_end);
-}
-
-
-static void mix_amp_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- int ival;
- if (!(mix_is_active(mix_dialog_id))) return;
- ival = ((XmScrollBarCallbackStruct *)info)->value;
- if (dragging)
- stop_dragging(mix_dialog_id);
- change_mix_amp(mix_dialog_id, scrollbar_to_amp(ival));
- after_mix_edit(mix_dialog_id);
- after_syncd_mix_edit(mix_dialog_id);
-}
-
-
-/* -------- amp-env -------- */
-
-static Widget w_env_frame, w_env;
-static graphics_context *ax = NULL;
-static GC cur_gc;
-static env_editor *spf = NULL;
-static bool with_mix_background_wave = false;
-
-static void show_mix_background_wave(int mix_id)
-{
- int pts;
- bool two_sided = false;
- if (spf == NULL) return;
- pts = prepare_mix_dialog_waveform(mix_id, spf->axis, &two_sided);
- if (pts > 0)
- {
- XSetForeground(MAIN_DISPLAY(ss), ax->gc, ss->enved_waveform_color);
- if (two_sided)
- draw_both_grf_points(1, ax, pts, GRAPH_LINES);
- else draw_grf_points(1, ax, pts, spf->axis, ungrf_y(spf->axis, 0.0), GRAPH_LINES);
- XSetForeground(MAIN_DISPLAY(ss), ax->gc, ss->black);
- }
-}
-
-
-static void mix_amp_env_resize(Widget w, XtPointer context, XtPointer info)
-{
- env *cur_env;
- if (!(mix_is_active(mix_dialog_id))) return;
-
- if (ax == NULL)
- {
- XGCValues gv;
- gv.function = GXcopy;
- XtVaGetValues(w_env, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
- cur_gc = XtGetGC(w_env, GCForeground | GCFunction, &gv);
- ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- ax->wn = XtWindow(w_env);
- ax->dp = XtDisplay(w_env);
- ax->gc = cur_gc;
- }
- else clear_window(ax);
-
- cur_env = dialog_env;
- spf->with_dots = true;
- env_editor_display_env(spf, cur_env, ax, "mix env", 0, 0, widget_width(w), widget_height(w), NOT_PRINTING);
- if (with_mix_background_wave)
- show_mix_background_wave(mix_dialog_id);
-}
-
-
-#if HAVE_OSX
-static int press_x, press_y;
-#endif
-
-static void mix_drawer_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XMotionEvent *ev = (XMotionEvent *)event;
- if (!(mix_is_active(mix_dialog_id))) return;
-#if HAVE_OSX
- if ((press_x == ev->x) && (press_y == ev->y)) return;
-#endif
- env_editor_button_motion(spf, ev->x, ev->y, ev->time, dialog_env);
- mix_amp_env_resize(w, NULL, NULL);
-}
-
-
-static void mix_drawer_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- XButtonEvent *ev = (XButtonEvent *)event;
- if (!(mix_is_active(mix_dialog_id))) return;
-#if HAVE_OSX
- press_x = ev->x;
- press_y = ev->y;
-#endif
- if (env_editor_button_press(spf, ev->x, ev->y, ev->time, dialog_env))
- mix_amp_env_resize(w, NULL, NULL);
-}
-
-
-static void mix_drawer_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- if (!(mix_is_active(mix_dialog_id))) return;
- env_editor_button_release(spf, dialog_env);
- mix_amp_env_resize(w, NULL, NULL);
-}
-
-
-static Widget w_id = NULL, w_beg = NULL, mix_play = NULL;
-static Widget error_frame = NULL, error_label = NULL;
-
-static void clear_mix_error(void)
-{
- if ((error_frame) && (XtIsManaged(error_frame)))
- XtUnmanageChild(error_frame);
-}
-
-
-static void unpost_mix_error(XtPointer data, XtIntervalId *id)
-{
- clear_mix_error();
-}
-
-
-static void errors_to_mix_text(const char *msg, void *data)
-{
- int lines = 0;
- XmString label;
- label = multi_line_label(msg, &lines);
- XtVaSetValues(error_label,
- XmNlabelString, label,
- XmNheight, lines * 20,
- NULL);
- XtVaSetValues(error_frame, XmNheight, lines * 20, NULL);
- XmStringFree(label);
- XtManageChild(error_frame);
- /* since the offending text is automatically overwritten, we can't depend on subsequent text modify callbacks
- * to clear things, so we'll just use a timer
- */
- XtAppAddTimeOut(MAIN_APP(ss),
- 5000,
- (XtTimerCallbackProc)unpost_mix_error,
- NULL);
-}
-
-
-static void widget_mix_to_text(Widget w, int id)
-{
- if (mix_name(id))
- XmTextFieldSetString(w, (char *)mix_name(id));
- else widget_int_to_text(w, id);
-}
-
-
-static bool id_changed = false;
-
-static void id_activated(void)
-{
- char *val;
- id_changed = false;
- val = XmTextGetString(w_id);
- if (val)
- {
- int id;
- /* look for a mix name first, then a number */
- id = mix_name_to_id(val);
- if (id < 0)
- {
- redirect_errors_to(errors_to_mix_text, NULL);
- id = string_to_int(val, 0, "id");
- redirect_errors_to(NULL, NULL);
- }
- if (mix_is_active(id))
- {
- mix_dialog_id = id;
- reflect_mix_change(id);
- }
- XtFree(val);
- }
-}
-
-
-static void id_modify_callback(Widget w, XtPointer context, XtPointer info)
-{
- id_changed = true;
-}
-
-
-static void id_check_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (id_changed) id_activated();
-}
-
-
-static void beg_activated(void)
-{
- char *val;
- if (!(mix_is_active(mix_dialog_id))) return;
- val = XmTextGetString(w_beg);
- if (val)
- {
- chan_info *cp;
- char *up_to_colon;
- mus_float_t beg;
- cp = mix_chan_info_from_id(mix_dialog_id);
- up_to_colon = string_to_colon(val);
- redirect_errors_to(errors_to_mix_text, NULL);
- beg = string_to_mus_float_t(up_to_colon, 0.0, "begin time");
- redirect_errors_to(NULL, NULL);
- if (beg >= 0.0)
- {
- mus_long_t pos, old_pos;
- old_pos = mix_position_from_id(mix_dialog_id);
- pos = (mus_long_t)(beg * SND_SRATE(cp->sound));
- mix_set_position_edit(mix_dialog_id, pos);
- syncd_mix_change_position(mix_dialog_id, pos - old_pos);
- }
- after_mix_edit(mix_dialog_id);
- free(up_to_colon);
- XtFree(val);
- }
-}
-
-
-static void apply_mix_dialog_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (!(mix_is_active(mix_dialog_id))) return;
- if ((dialog_env) &&
- (!(default_env_p(dialog_env))))
- {
- mix_set_amp_env_edit(mix_dialog_id, dialog_env);
- syncd_mix_set_amp_env(mix_dialog_id, dialog_env);
- }
- else
- {
- mix_set_amp_env_edit(mix_dialog_id, NULL);
- syncd_mix_set_amp_env(mix_dialog_id, NULL);
- }
- mix_amp_env_resize(w_env, NULL, NULL);
- after_mix_edit(mix_dialog_id);
-}
-
-
-static void copy_mix_dialog_callback(Widget w, XtPointer context, XtPointer info)
-{
- copy_mix(mix_dialog_id);
- after_mix_edit(mix_dialog_id);
-}
-
-
-static void dismiss_mix_dialog_callback(Widget w, XtPointer context, XtPointer info)
-{
- Widget active_widget;
- clear_mix_error();
- active_widget = XmGetFocusWidget(mix_dialog);
- if (active_widget == XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON))
- XtUnmanageChild(mix_dialog);
- else
- {
- if (active_widget == w_id)
- id_activated();
- else
- {
- if (active_widget == w_beg)
- beg_activated();
- }
- }
-}
-
-
-static void help_mix_dialog_callback(Widget w, XtPointer context, XtPointer info)
-{
- mix_dialog_help();
-}
-
-
-/* -------- play -------- */
-
-static bool mix_playing = false;
-
-void reflect_mix_play_stop(void)
-{
- if (mix_play)
- XmChangeColor(mix_play, ss->basic_color);
- mix_playing = false;
-}
-
-
-static void mix_dialog_play_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (mix_playing)
- reflect_mix_play_stop();
- else
- {
- if (!(mix_exists(mix_dialog_id))) return;
- if (mix_play)
- XmChangeColor(mix_play, ss->selection_color); /* this needs to happen before trying to play */
- syncd_mix_play(mix_dialog_id);
- mix_playing = true; /* don't use the return value here */
- play_mix_from_id(mix_dialog_id);
- }
-}
-
-
-/* -------- dB -------- */
-
-static void mix_dB_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- spf->in_dB = cb->set;
- mix_amp_env_resize(w_env, NULL, NULL);
-}
-
-
-/* -------- sync -------- */
-
-static void mix_sync_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- if ((cb->set) &&
- (mix_sync_from_id(mix_dialog_id) == 0))
- {
- mix_set_sync_from_id(mix_dialog_id, GET_ORIGINAL_SYNC); /* choose a new sync val or return to previous */
- /* check for resync */
- syncd_mix_set_color(mix_dialog_id, ss->red);
- }
- else
- {
- if ((!(cb->set)) &&
- (mix_sync_from_id(mix_dialog_id) != 0))
- {
- syncd_mix_unset_color(mix_dialog_id); /* unset colors of any syncd mixes */
- mix_set_sync_from_id(mix_dialog_id, 0);
- }
- }
- for_each_normal_chan(display_channel_mixes);
-}
-
-
-/* -------- clip -------- */
-
-static void mix_clip_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- spf->clip_p = cb->set;
- mix_amp_env_resize(w_env, NULL, NULL);
-}
-
-
-/* -------- wave -------- */
-
-static void mix_wave_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- with_mix_background_wave = cb->set;
- mix_amp_env_resize(w_env, NULL, NULL);
-}
-
-
-/* -------- next/previous -------- */
-
-static Widget nextb, previousb;
-
-static void mix_next_callback(Widget w, XtPointer context, XtPointer info)
-{
- int id;
- clear_mix_error();
- id = next_mix_id(mix_dialog_id);
- if (id != INVALID_MIX_ID)
- {
- mix_dialog_id = id;
- reflect_mix_change(id);
- if (next_mix_id(id) == INVALID_MIX_ID)
- set_sensitive(nextb, false);
- }
-}
-
-
-static void mix_previous_callback(Widget w, XtPointer context, XtPointer info)
-{
- int id;
- clear_mix_error();
- id = previous_mix_id(mix_dialog_id);
- if (id != INVALID_MIX_ID)
- {
- mix_dialog_id = id;
- reflect_mix_change(id);
- if (previous_mix_id(id) == INVALID_MIX_ID)
- set_sensitive(previousb, false);
- }
-}
-
-
-static Pixmap make_pixmap(unsigned char *bits, int width, int height, int depth, GC gc)
-{
- Pixmap rb, nr;
- rb = XCreateBitmapFromData(MAIN_DISPLAY(ss),
- RootWindowOfScreen(XtScreen(MAIN_PANE(ss))),
- (const char *)bits,
- width, height);
- nr = XCreatePixmap(MAIN_DISPLAY(ss),
- RootWindowOfScreen(XtScreen(MAIN_PANE(ss))),
- width, height, depth);
- XCopyPlane(MAIN_DISPLAY(ss), rb, nr, gc, 0, 0, width, height, 0, 0, 1);
- XFreePixmap(MAIN_DISPLAY(ss), rb);
- return(nr);
-}
-
-
-
-#define p_speaker_width 12
-#define p_speaker_height 12
-static unsigned char p_speaker_bits[] = {
- 0x00, 0x07, 0xc0, 0x04, 0x30, 0x04, 0x0e, 0x04, 0x06, 0x04, 0x06, 0x04,
- 0x06, 0x04, 0x06, 0x04, 0x0e, 0x04, 0x30, 0x04, 0xc0, 0x04, 0x00, 0x07};
-
-static int mixer_depth;
-static GC gc;
-static Pixmap speaker_r;
-
-void make_mixer_icons_transparent_again(Pixel old_color, Pixel new_color)
-{
- if (mix_dialog)
- {
- XFreePixmap(XtDisplay(mix_dialog), speaker_r);
- XSetBackground(XtDisplay(mix_dialog), gc, new_color);
- speaker_r = make_pixmap(p_speaker_bits, p_speaker_width, p_speaker_height, mixer_depth, gc);
- XtVaSetValues(mix_play, XmNlabelPixmap, speaker_r, NULL);
- }
-}
-
-static Widget w_sync;
-
-Widget make_mix_dialog(void)
-{
- if (mix_dialog == NULL)
- {
- Widget mainform, mix_row, mix_frame, sep, w_sep1;
- Widget w_dB_frame, w_dB, w_clip, w_wave, w_dB_row, env_button;
- XmString xdismiss, xhelp, xtitle, s1, xcopy;
- int n;
- Arg args[20];
- XtCallbackList n1, n2;
- XGCValues v;
- char amplab[LABEL_BUFFER_SIZE];
-
- xmix_speed_control_style = speed_control_style(ss);
-
- mix_dialog_id = any_mix_id();
- xdismiss = XmStringCreateLocalized((char *)"Go Away");
- xcopy = XmStringCreateLocalized((char *)"Copy mix");
- xhelp = XmStringCreateLocalized((char *)"Help");
- xtitle = XmStringCreateLocalized((char *)"Mixes");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNokLabelString, xdismiss); n++;
- XtSetArg(args[n], XmNcancelLabelString, xcopy); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, xtitle); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- mix_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Mixes", args, n);
-
- XtAddCallback(mix_dialog, XmNokCallback, dismiss_mix_dialog_callback, NULL);
- XtAddCallback(mix_dialog, XmNcancelCallback, copy_mix_dialog_callback, NULL);
- XtAddCallback(mix_dialog, XmNhelpCallback, help_mix_dialog_callback, NULL);
-
- XmStringFree(xhelp);
- XmStringFree(xcopy);
- XmStringFree(xdismiss);
- XmStringFree(xtitle);
-
- XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(mix_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- env_button = XtCreateManagedWidget("Apply env", xmPushButtonGadgetClass, mix_dialog, args, n);
- XtAddCallback(env_button, XmNactivateCallback, apply_mix_dialog_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(mix_dialog, XmDIALOG_SEPARATOR)); n++;
- mainform = XtCreateManagedWidget("formd", xmFormWidgetClass, mix_dialog, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 2); n++;
- mix_frame = XtCreateManagedWidget("mix-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- mix_row = XtCreateManagedWidget("mix-dialog-row", xmRowColumnWidgetClass, mix_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtCreateManagedWidget("mix:", xmLabelWidgetClass, mix_row, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNresizeWidth, false); n++;
- XtSetArg(args[n], XmNcolumns, NAME_COLUMNS); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- w_id = make_textfield_widget("mix-id", mix_row, args, n, ACTIVATABLE, NO_COMPLETER);
- XtAddCallback(w_id, XmNlosingFocusCallback, id_check_callback, NULL);
- XtAddCallback(w_id, XmNmodifyVerifyCallback, id_modify_callback, NULL);
- XmTextSetString(w_id, (char *)"0");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- w_beg = make_textfield_widget("mix-times", mix_row, args, n, ACTIVATABLE, NO_COMPLETER);
- XmTextSetString(w_beg, (char *)"0.000 : 1.000");
-
- XtVaGetValues(mix_row, XmNforeground, &v.foreground, XmNbackground, &v.background, XmNdepth, &mixer_depth, NULL);
- gc = XtGetGC(mix_row, GCForeground | GCBackground, &v);
- speaker_r = make_pixmap(p_speaker_bits, p_speaker_width, p_speaker_height, mixer_depth, gc);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
- XtSetArg(args[n], XmNlabelPixmap, speaker_r); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- mix_play = XtCreateManagedWidget("mix-play", xmPushButtonWidgetClass, mix_row, args, n);
- XtAddCallback(mix_play, XmNactivateCallback, mix_dialog_play_callback, NULL);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- previousb = XtCreateManagedWidget("Previous", xmPushButtonWidgetClass, mix_row, args, n);
- if (previous_mix_id(mix_dialog_id) == INVALID_MIX_ID)
- set_sensitive(previousb, false);
- XtAddCallback(previousb, XmNactivateCallback, mix_previous_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- nextb = XtCreateManagedWidget("Next", xmPushButtonWidgetClass, mix_row, args, n);
- if (next_mix_id(mix_dialog_id) == INVALID_MIX_ID)
- set_sensitive(nextb, false);
- XtAddCallback(nextb, XmNactivateCallback, mix_next_callback, NULL);
-
-
-
- /* separator before sliders */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, mix_row); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 10); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- sep = XtCreateManagedWidget("mix-dialog-sep", xmSeparatorWidgetClass, mainform, args, n);
-
- /* SPEED */
- n = 0;
- s1 = XmStringCreateLocalized((char *)"speed:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- w_speed_label = make_pushbutton_widget("mix-speed-label", mainform, args, n);
- XtAddCallback(w_speed_label, XmNactivateCallback, mix_speed_click_callback, NULL);
- XmStringFree(s1);
-
- n = 0;
- s1 = initial_speed_label(xmix_speed_control_style);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, w_speed_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, w_speed_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- w_speed_number = make_pushbutton_widget("mix-speed-number", mainform, args, n);
- XtAddCallback(w_speed_number, XmNactivateCallback, mix_speed_label_click_callback, NULL);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, w_speed_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, w_speed_number); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, speed_to_scrollbar(speed_control_min(ss), 1.0, speed_control_max(ss))); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(mix_speed_drag_callback, NULL)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(mix_speed_valuechanged_callback, NULL)); n++;
- w_speed = XtCreateManagedWidget("mix-speed", xmScrollBarWidgetClass, mainform, args, n);
-
- free(n1);
- free(n2);
-
- n = 0;
- mus_snprintf(amplab, LABEL_BUFFER_SIZE, "%s", "amp:");
- s1 = XmStringCreateLocalized(amplab);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, w_speed_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- w_amp_label = make_pushbutton_widget("mix-amp-label", mainform, args, n);
- XtAddCallback(w_amp_label, XmNactivateCallback, mix_amp_click_callback, NULL);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"1.00");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, w_speed_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, w_amp_label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- w_amp_number = XtCreateManagedWidget("mix-amp-number", xmLabelWidgetClass, mainform, args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, w_amp_number); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, w_amp_number); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, 0); n++;
- XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(mix_amp_drag_callback, NULL)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(mix_amp_valuechanged_callback, NULL)); n++;
- w_amp = XtCreateManagedWidget("mix-amp", xmScrollBarWidgetClass, mainform, args, n);
- free(n1);
- free(n2);
-
- /* separator before envelopes */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, w_amp_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 8); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- w_sep1 = XtCreateManagedWidget("mix-dialog-sep1", xmSeparatorWidgetClass, mainform, args, n);
-
- /* button box for dB clip wave sync */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, w_sep1); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 4); n++;
- w_dB_frame = XtCreateManagedWidget("mix-dB-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- w_dB_row = XtCreateManagedWidget("mix-dB-row", xmRowColumnWidgetClass, w_dB_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
-
- w_clip = make_togglebutton_widget("clip", w_dB_row, args, n);
- XtAddCallback(w_clip, XmNvalueChangedCallback, mix_clip_callback, NULL);
- XmToggleButtonSetState(w_clip, true, false);
-
- w_wave = make_togglebutton_widget("wave", w_dB_row, args, n);
- XtAddCallback(w_wave, XmNvalueChangedCallback, mix_wave_callback, NULL);
-
- w_dB = make_togglebutton_widget("dB", w_dB_row, args, n);
- XtAddCallback(w_dB, XmNvalueChangedCallback, mix_dB_callback, NULL);
-
- if (mix_sync_from_id(mix_dialog_id) != 0)
- {XtSetArg(args[n], XmNset, true); n++;}
- w_sync = make_togglebutton_widget("sync", w_dB_row, args, n);
- XtAddCallback(w_sync, XmNvalueChangedCallback, mix_sync_callback, NULL);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 2); n++;
- error_frame = XtCreateManagedWidget("error-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- error_label = XtCreateManagedWidget("", xmLabelWidgetClass, error_frame, args, n);
-
-
- /* amp env */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, w_sep1); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 4); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, w_dB_frame); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 4); n++;
- w_env_frame = XtCreateManagedWidget("mix-amp-env-frame", xmFrameWidgetClass, mainform, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- w_env = XtCreateManagedWidget("mix-amp-env-window", xmDrawingAreaWidgetClass, w_env_frame, args, n);
-
- XtManageChild(mix_dialog);
-
- XtAddCallback(w_env, XmNresizeCallback, mix_amp_env_resize, NULL);
- XtAddCallback(w_env, XmNexposeCallback, mix_amp_env_resize, NULL);
-
- spf = new_env_editor();
-
- XtAddEventHandler(w_env, ButtonPressMask, false, mix_drawer_button_press, NULL);
- XtAddEventHandler(w_env, ButtonMotionMask, false, mix_drawer_button_motion, NULL);
- XtAddEventHandler(w_env, ButtonReleaseMask, false, mix_drawer_button_release, NULL);
-
- set_dialog_widget(MIX_DIALOG, mix_dialog);
-
- XtUnmanageChild(error_frame);
- }
- else
- {
- if (!(XtIsManaged(mix_dialog))) XtManageChild(mix_dialog);
- raise_dialog(mix_dialog);
- }
- reflect_mix_change(mix_dialog_id);
- return(mix_dialog);
-}
-
-
-void reflect_mix_change(int mix_id)
-{
- if ((mix_dialog) &&
- (XtIsManaged(mix_dialog)))
- {
- if (mix_id != ANY_MIX_ID)
- mix_dialog_id = mix_id;
-
- if (!(mix_exists(mix_dialog_id)))
- {
- mix_dialog_id = any_mix_id();
- mix_id = mix_dialog_id;
- }
-
- if ((mix_id == mix_dialog_id) || (mix_id == ANY_MIX_ID))
- {
- mus_float_t val;
- set_sensitive(nextb, (next_mix_id(mix_dialog_id) != INVALID_MIX_ID));
- set_sensitive(previousb, (previous_mix_id(mix_dialog_id) != INVALID_MIX_ID));
-
- /* now reflect current mix state in mix dialog controls */
- if (mix_exists(mix_dialog_id))
- {
- chan_info *cp = NULL;
- mus_long_t beg, len;
- char lab[LABEL_BUFFER_SIZE];
-
- /* syncd mixes have the same color (red) reverting to old color when sync changes */
- cp = mix_chan_info_from_id(mix_dialog_id);
- if (old_mix_dialog_id != INVALID_MIX_ID)
- {
- mix_unset_color_from_id(old_mix_dialog_id);
- syncd_mix_unset_color(old_mix_dialog_id);
- }
- old_mix_dialog_id = mix_dialog_id;
- mix_set_color_from_id(mix_dialog_id, ss->red);
- syncd_mix_set_color(mix_dialog_id, ss->red);
-
- for_each_normal_chan(display_channel_mixes);
-
- if (!dragging)
- {
- val = mix_speed_from_id(mix_dialog_id);
- XtVaSetValues(w_speed, XmNvalue, speed_to_scrollbar(speed_control_min(ss), val, speed_control_max(ss)), NULL);
- speed_changed(val, lab, xmix_speed_control_style, speed_control_tones(ss), 6);
- set_label(w_speed_number, lab);
- }
- widget_mix_to_text(w_id, mix_dialog_id);
-
- beg = mix_position_from_id(mix_dialog_id);
- len = mix_length_from_id(mix_dialog_id);
- mus_snprintf(lab, LABEL_BUFFER_SIZE, "%.3f : %.3f%s",
- (float)((double)beg / (float)SND_SRATE(cp->sound)),
- (float)((double)(beg + len) / (float)SND_SRATE(cp->sound)),
- (mix_is_active(mix_dialog_id)) ? "" : " (locked)");
- XmTextSetString(w_beg, lab);
-
- set_sensitive(XmMessageBoxGetChild(mix_dialog, XmDIALOG_CANCEL_BUTTON), true);
- }
- else
- {
- XmTextSetString(w_id, (char *)"-1");
- XmTextSetString(w_beg, (char *)"no active mixes");
- set_sensitive(XmMessageBoxGetChild(mix_dialog, XmDIALOG_CANCEL_BUTTON), false);
- }
- if (!dragging)
- {
- if (mix_is_active(mix_dialog_id))
- val = mix_amp_from_id(mix_dialog_id);
- else val = 1.0;
- XtVaSetValues(w_amp, XmNvalue, amp_to_scrollbar(w_amp_number, val), NULL);
- }
-
- if (mix_amp_env_from_id(mix_dialog_id))
- {
- if (dialog_env) free_env(dialog_env);
- dialog_env = copy_env(mix_amp_env_from_id(mix_dialog_id));
- }
- /* copy here else we're editing it directly afterwards (and we free old in mix_set_amp_env_edit) */
- if (!dialog_env)
- dialog_env = default_env(1.0, 1.0);
- mix_amp_env_resize(w_env, NULL, NULL);
-
- set_toggle_button(w_sync, (mix_sync_from_id(mix_dialog_id) != 0), false, NULL);
- }
- }
-}
-
-
-int mix_dialog_mix(void)
-{
- return(mix_dialog_id);
-}
-
-
-void mix_dialog_set_mix(int id)
-{
- mix_dialog_id = id;
- reflect_mix_change(mix_dialog_id);
-}
-
-
-
diff --git a/snd-xprefs.c b/snd-xprefs.c
deleted file mode 100644
index 5a5d758..0000000
--- a/snd-xprefs.c
+++ /dev/null
@@ -1,2696 +0,0 @@
-#include "snd.h"
-#include "sndlib-strings.h"
-
-
-/* preferences dialog; layout design taken from webmail
- */
-
-static Widget preferences_dialog = NULL, load_path_text_widget = NULL;
-static bool prefs_unsaved = false;
-static char *prefs_saved_filename = NULL;
-static char *include_load_path = NULL;
-
-#define MID_POSITION 50
-#define COLOR_POSITION 62
-#define FIRST_COLOR_POSITION 6
-#define SECOND_COLOR_POSITION 30
-#define THIRD_COLOR_POSITION 55
-
-#define MID_SPACE 16
-#define INTER_TOPIC_SPACE 3
-#define INTER_VARIABLE_SPACE 2
-
-#define POWER_WAIT_TIME 100
-#define POWER_INITIAL_WAIT_TIME 500
-/* "power" is an old-timey name for auto-repeat */
-#define ERROR_WAIT_TIME 5000
-
-#define STARTUP_WIDTH 925
-#define STARTUP_HEIGHT 800
-
-
-typedef struct prefs_info {
- Widget label, text, arrow_up, arrow_down, arrow_right, error, toggle, scale, toggle2, toggle3;
- Widget color, rscl, gscl, bscl, rtxt, gtxt, btxt, list_menu, radio_button;
- Widget *radio_buttons;
- bool got_error;
- timeout_result_t power_id;
- const char *var_name, *saved_label;
- int num_buttons;
- mus_float_t scale_max;
- void (*toggle_func)(struct prefs_info *prf);
- void (*toggle2_func)(struct prefs_info *prf);
- void (*scale_func)(struct prefs_info *prf);
- void (*arrow_up_func)(struct prefs_info *prf);
- void (*arrow_down_func)(struct prefs_info *prf);
- void (*text_func)(struct prefs_info *prf);
- void (*list_func)(struct prefs_info *prf, char *value);
- void (*color_func)(struct prefs_info *prf, float r, float g, float b);
- void (*reflect_func)(struct prefs_info *prf);
- void (*save_func)(struct prefs_info *prf, FILE *fd);
- const char *(*help_func)(struct prefs_info *prf);
- void (*clear_func)(struct prefs_info *prf);
- void (*revert_func)(struct prefs_info *prf);
-} prefs_info;
-
-
-static void prefs_set_dialog_title(const char *filename);
-static void reflect_key(prefs_info *prf, const char *key_name);
-static void save_key_binding(prefs_info *prf, FILE *fd, char *(*binder)(char *key, bool c, bool m, bool x));
-static void key_bind(prefs_info *prf, char *(*binder)(char *key, bool c, bool m, bool x));
-static void clear_prefs_dialog_error(void);
-static void scale_set_color(prefs_info *prf, color_t pixel);
-static color_t rgb_to_color(mus_float_t r, mus_float_t g, mus_float_t b);
-static void post_prefs_error(const char *msg, prefs_info *data);
-#ifdef __GNUC__
- static void va_post_prefs_error(const char *msg, prefs_info *data, ...) __attribute__ ((format (printf, 1, 0)));
-#else
- static void va_post_prefs_error(const char *msg, prefs_info *data, ...);
-#endif
-
-/* used in snd-prefs */
-#define GET_TOGGLE(Toggle) (XmToggleButtonGetState(Toggle) == XmSET)
-#define SET_TOGGLE(Toggle, Value) XmToggleButtonSetState(Toggle, Value, false)
-#define GET_TEXT(Text) XmTextFieldGetString(Text)
-#define SET_TEXT(Text, Val) XmTextFieldSetString(Text, (char *)Val)
-#define free_TEXT(Val) XtFree(Val)
-#define SET_SCALE(Value) XmScaleSetValue(prf->scale, (int)(100 * Value))
-#define SET_SENSITIVE(Wid, Val) XtSetSensitive(Wid, Val)
-#define black_text(Prf) XtVaSetValues(Prf->label, XmNforeground, ss->black, NULL)
-#define red_text(Prf) XtVaSetValues(Prf->label, XmNforeground, ss->red, NULL)
-
-#define TIMEOUT(Func) XtAppAddTimeOut(MAIN_APP(ss), ERROR_WAIT_TIME, Func, (XtPointer)prf)
-
-
-static int get_scale_1(Widget scale)
-{
- int val = 0;
- XmScaleGetValue(scale, &val);
- return(val);
-}
-
-#define GET_SCALE() (get_scale_1(prf->scale) * 0.01)
-
-
-static void set_radio_button(prefs_info *prf, int which)
-{
- if ((which >= 0) && (which < prf->num_buttons))
- {
- int i;
- for (i = 0; i < prf->num_buttons; i++)
- {
- if ((prf->radio_buttons[i]) &&
- (XmIsToggleButton(prf->radio_buttons[i])))
- XmToggleButtonSetState(prf->radio_buttons[i], (i == which), false);
- }
- prf->radio_button = prf->radio_buttons[which];
- }
-}
-
-
-static int which_radio_button(prefs_info *prf)
-{
- pointer_or_int_t which = 0;
- XtVaGetValues(prf->radio_button, XmNuserData, &which, NULL);
- return(which);
-}
-
-
-#include "snd-prefs.c"
-
-static bool prefs_dialog_error_is_posted = false;
-
-static void post_prefs_dialog_error(const char *message, void *data)
-{
- XmString title;
- title = XmStringCreateLocalized((char *)message);
- XtVaSetValues(preferences_dialog,
- XmNmessageString, title,
- NULL);
- XmStringFree(title);
- prefs_dialog_error_is_posted = (message != NULL);
-}
-
-
-static void clear_prefs_dialog_error(void)
-{
- if (prefs_dialog_error_is_posted)
- {
- prefs_dialog_error_is_posted = false;
- post_prefs_dialog_error(NULL, NULL);
- }
-}
-
-
-static void prefs_change_callback(Widget w, XtPointer context, XtPointer info)
-{
- prefs_unsaved = true;
- prefs_set_dialog_title(NULL);
- clear_prefs_dialog_error();
-}
-
-
-/* ---------------- row (main) label widget ---------------- */
-
-static Widget make_row_label(prefs_info *prf, const char *label, Widget box, Widget top_widget)
-{
- Widget w;
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, MID_POSITION); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_END); n++;
- w = XtCreateManagedWidget(label, xmLabelWidgetClass, box, args, n);
- prf->saved_label = label;
- return(w);
-}
-
-
-/* ---------------- row inner label widget ---------------- */
-
-static Widget make_row_inner_label(prefs_info *prf, const char *label, Widget left_widget, Widget box, Widget top_widget)
-{
- Widget w;
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- w = XtCreateManagedWidget(label, xmLabelWidgetClass, box, args, n);
- return(w);
-}
-
-
-/* ---------------- row middle separator widget ---------------- */
-
-static Widget make_row_middle_separator(Widget label, Widget box, Widget top_widget)
-{
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, label); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, label); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNwidth, MID_SPACE); n++;
- XtSetArg(args[n], XmNseparatorType, XmSHADOW_ETCHED_OUT); n++;
- return(XtCreateManagedWidget("sep", xmSeparatorWidgetClass, box, args, n));
-}
-
-
-/* ---------------- row inner separator widget ---------------- */
-
-static Widget make_row_inner_separator(int width, Widget left_widget, Widget box, Widget top_widget)
-{
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNwidth, width); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- return(XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, box, args, n));
-}
-
-
-static Widget make_row_error(prefs_info *prf, Widget box, Widget left_widget, Widget top_widget)
-{
- Arg args[20];
- int n;
- Widget w;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, left_widget); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_END); n++;
- w = XtCreateManagedWidget("", xmLabelWidgetClass, box, args, n);
- return(w);
-}
-
-
-/* ---------------- row toggle widget ---------------- */
-
-static Widget make_row_toggle_with_label(prefs_info *prf, bool current_value, Widget left_widget, Widget box, Widget top_widget, const char *label)
-{
- Widget w;
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNset, (current_value) ? XmSET : XmUNSET); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNborderColor, ss->white); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNindicatorOn, XmINDICATOR_FILL); n++;
- XtSetArg(args[n], XmNindicatorSize, 14); n++;
- w = XtCreateManagedWidget(label, xmToggleButtonWidgetClass, box, args, n);
- return(w);
-}
-
-
-static Widget make_row_toggle(prefs_info *prf, bool current_value, Widget left_widget, Widget box, Widget top_widget)
-{
- return(make_row_toggle_with_label(prf, current_value, left_widget, box, top_widget, " "));
-}
-
-
-
-/* ---------------- row arrows ---------------- */
-
-static void remove_arrow_func(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if (prf->power_id != 0)
- {
- XtRemoveTimeOut(prf->power_id);
- prf->power_id = 0;
- }
-}
-
-
-static void arrow_func_up(XtPointer context, XtIntervalId *id)
-{
- prefs_info *prf = (prefs_info *)context;
- if (XtIsSensitive(prf->arrow_up))
- {
- if ((prf) && (prf->arrow_up_func))
- {
- (*(prf->arrow_up_func))(prf);
- prf->power_id = XtAppAddTimeOut(MAIN_APP(ss),
- POWER_WAIT_TIME,
- arrow_func_up,
- (XtPointer)prf);
- }
- else prf->power_id = 0;
- }
-}
-
-
-static void arrow_func_down(XtPointer context, XtIntervalId *id)
-{
- prefs_info *prf = (prefs_info *)context;
- if (XtIsSensitive(prf->arrow_down))
- {
- if ((prf) && (prf->arrow_down_func))
- {
- (*(prf->arrow_down_func))(prf);
- prf->power_id = XtAppAddTimeOut(MAIN_APP(ss),
- POWER_WAIT_TIME,
- arrow_func_down,
- (XtPointer)prf);
- }
- else prf->power_id = 0;
- }
-}
-
-
-static void call_arrow_down_press(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->arrow_down_func))
- {
- (*(prf->arrow_down_func))(prf);
- if (XtIsSensitive(w))
- prf->power_id = XtAppAddTimeOut(MAIN_APP(ss),
- POWER_INITIAL_WAIT_TIME,
- arrow_func_down,
- (XtPointer)prf);
- else prf->power_id = 0;
- }
-}
-
-
-static void call_arrow_up_press(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->arrow_up_func))
- {
- (*(prf->arrow_up_func))(prf);
- if (XtIsSensitive(w))
- prf->power_id = XtAppAddTimeOut(MAIN_APP(ss),
- POWER_INITIAL_WAIT_TIME,
- arrow_func_up,
- (XtPointer)prf);
- else prf->power_id = 0;
- }
-}
-
-
-static Widget make_row_arrows(prefs_info *prf, Widget box, Widget left_widget, Widget top_widget)
-{
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- XtSetArg(args[n], XmNarrowDirection, XmARROW_DOWN); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- prf->arrow_down = XtCreateManagedWidget("arrow-down", xmArrowButtonWidgetClass, box, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, prf->arrow_down); n++;
- XtSetArg(args[n], XmNarrowDirection, XmARROW_UP); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- prf->arrow_up = XtCreateManagedWidget("arrow-up", xmArrowButtonWidgetClass, box, args, n);
-
- XtAddCallback(prf->arrow_down, XmNarmCallback, call_arrow_down_press, (XtPointer)prf);
- XtAddCallback(prf->arrow_down, XmNdisarmCallback, remove_arrow_func, (XtPointer)prf);
- XtAddCallback(prf->arrow_up, XmNarmCallback, call_arrow_up_press, (XtPointer)prf);
- XtAddCallback(prf->arrow_up, XmNdisarmCallback, remove_arrow_func, (XtPointer)prf);
-
- XtAddCallback(prf->arrow_up, XmNactivateCallback, prefs_change_callback, NULL);
- XtAddCallback(prf->arrow_down, XmNactivateCallback, prefs_change_callback, NULL);
-
- return(prf->arrow_up);
-}
-
-
-/* ---------------- bool row ---------------- */
-
-static void call_toggle_func(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->toggle_func))
- (*(prf->toggle_func))(prf);
-}
-
-
-static prefs_info *prefs_row_with_toggle(const char *label, const char *varname, bool current_value,
- Widget box, Widget top_widget,
- void (*toggle_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->toggle_func = toggle_func;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->toggle = make_row_toggle(prf, current_value, sep, box, top_widget);
-
- XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
- return(prf);
-}
-
-
-/* ---------------- two toggles ---------------- */
-
-static void call_toggle2_func(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->toggle2_func))
- (*(prf->toggle2_func))(prf);
-}
-
-
-static prefs_info *prefs_row_with_two_toggles(const char *label, const char *varname,
- const char *label1, bool value1,
- const char *label2, bool value2,
- Widget box, Widget top_widget,
- void (*toggle_func)(prefs_info *prf),
- void (*toggle2_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep, sep1;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->toggle_func = toggle_func;
- prf->toggle2_func = toggle2_func;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->toggle = make_row_toggle_with_label(prf, value1, sep, box, top_widget, label1);
- sep1 = make_row_inner_separator(20, prf->toggle, box, top_widget);
- prf->toggle2 = make_row_toggle_with_label(prf, value2, sep1, box, top_widget, label2);
-
- XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
- XtAddCallback(prf->toggle2, XmNvalueChangedCallback, call_toggle2_func, (XtPointer)prf);
- return(prf);
-}
-
-
-/* ---------------- toggle with text ---------------- */
-
-static void call_text_func(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->text_func))
- (*(prf->text_func))(prf);
-}
-
-
-/* earlier versions of this dialog assumed the user would type <cr> to save a new value
- * typed in a text widget, but no one does that anymore, so now, to catch these changes
- * but not be confused by automatic changes (such as in a scale widget's label),
- * we'll use XmNfocusCallback to set a text_focussed flag, XmNlosingFocusCallback to
- * unset it, XmNvalueChangedCallback to set a text_changed flag, XmNactivateCallback
- * to clear text_changed, and if XmNlosingFocusCallback sees that flag set, it
- * calls the activate function and unsets the flag.
- */
-
-typedef struct {
- bool text_focussed, text_changed;
- prefs_info *prf;
-} text_info;
-
-
-static void text_change_callback(Widget w, XtPointer context, XtPointer info)
-{
- text_info *data = (text_info *)context;
- if (data->text_focussed) /* try to omit non-user actions that change the value */
- data->text_changed = true;
-}
-
-
-static void text_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- text_info *data = (text_info *)context;
- data->text_changed = false;
-}
-
-
-static void text_grab_focus_callback(Widget w, XtPointer context, XtPointer info)
-{
- text_info *data = (text_info *)context;
- data->text_focussed = true;
-}
-
-
-static void text_lose_focus_callback(Widget w, XtPointer context, XtPointer info)
-{
- text_info *data = (text_info *)context;
- if ((data->text_focussed) &&
- (data->text_changed) &&
- (data->prf) &&
- (data->prf->text_func))
- {
- (*(data->prf->text_func))(data->prf);
- data->text_changed = false;
- }
-}
-
-
-static Widget make_row_text(prefs_info *prf, const char *text_value, int cols, Widget left_widget, Widget box, Widget top_widget)
-{
- Widget w;
- int n;
- Arg args[30];
- text_info *info;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- if (cols != 0)
- {
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNcolumns, cols); n++;
- }
- else
- {
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- }
- if (text_value)
- {
- XtSetArg(args[n], XmNvalue, text_value); n++;
- }
- XtSetArg(args[n], XmNmarginHeight, 1); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNborderColor, ss->white); n++;
- XtSetArg(args[n], XmNbottomShadowColor, ss->white); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNtopShadowColor, ss->white); n++;
- w = make_textfield_widget("text", box, args, n, ACTIVATABLE_BUT_NOT_FOCUSED, NO_COMPLETER);
-
- XtAddCallback(w, XmNactivateCallback, prefs_change_callback, NULL);
-
- info = (text_info *)calloc(1, sizeof(text_info));
- info->prf = prf;
-
- XtAddCallback(w, XmNactivateCallback, text_activate_callback, (XtPointer)info);
- XtAddCallback(w, XmNvalueChangedCallback, text_change_callback, (XtPointer)info);
- XtAddCallback(w, XmNfocusCallback, text_grab_focus_callback, (XtPointer)info);
- XtAddCallback(w, XmNlosingFocusCallback, text_lose_focus_callback, (XtPointer)info);
-
- return(w);
-}
-
-
-static prefs_info *prefs_row_with_toggle_with_text(const char *label, const char *varname, bool current_value,
- const char *text_label, const char *text_value, int cols,
- Widget box, Widget top_widget,
- void (*toggle_func)(prefs_info *prf),
- void (*text_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep, sep1, lab1;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->toggle_func = toggle_func;
- prf->text_func = text_func;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->toggle = make_row_toggle(prf, current_value, sep, box, top_widget);
- sep1 = make_row_inner_separator(16, prf->toggle, box, top_widget);
- lab1 = make_row_inner_label(prf, text_label, sep1, box, top_widget);
- prf->text = make_row_text(prf, text_value, cols, lab1, box, top_widget);
-
- XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
-
- return(prf);
-}
-
-
-static prefs_info *prefs_row_with_toggle_with_two_texts(const char *label, const char *varname, bool current_value,
- const char *label1, const char *text1,
- const char *label2, const char *text2, int cols,
- Widget box, Widget top_widget,
- void (*toggle_func)(prefs_info *prf),
- void (*text_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep, lab1, lab2, sep1;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->toggle_func = toggle_func;
- prf->text_func = text_func;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->toggle = make_row_toggle(prf, current_value, sep, box, top_widget);
- sep1 = make_row_inner_separator(16, prf->toggle, box, top_widget);
- lab1 = make_row_inner_label(prf, label1, sep1, box, top_widget);
- prf->text = make_row_text(prf, text1, cols, lab1, box, top_widget);
- lab2 = make_row_inner_label(prf, label2, prf->text, box, top_widget);
- prf->rtxt = make_row_text(prf, text2, cols, lab2, box, top_widget);
-
- XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
- XtAddCallback(prf->rtxt, XmNactivateCallback, call_text_func, (XtPointer)prf);
-
- return(prf);
-}
-
-
-/* ---------------- text with toggle ---------------- */
-
-static prefs_info *prefs_row_with_text_with_toggle(const char *label, const char *varname, bool current_value,
- const char *toggle_label, const char *text_value, int cols,
- Widget box, Widget top_widget,
- void (*toggle_func)(prefs_info *prf),
- void (*text_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep, sep1, lab1;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->toggle_func = toggle_func;
- prf->text_func = text_func;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->text = make_row_text(prf, text_value, cols, sep, box, top_widget);
- sep1 = make_row_inner_separator(8, prf->text, box, top_widget);
- lab1 = make_row_inner_label(prf, toggle_label, sep1, box, top_widget);
- prf->toggle = make_row_toggle(prf, current_value, lab1, box, top_widget);
-
- XtAddCallback(prf->toggle, XmNvalueChangedCallback, call_toggle_func, (XtPointer)prf);
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
-
- return(prf);
-}
-
-
-/* ---------------- text with toggle ---------------- */
-
-static prefs_info *prefs_row_with_text_and_three_toggles(const char *label, const char *varname,
- const char *text_label, int cols,
- const char *toggle1_label, const char *toggle2_label, const char *toggle3_label,
- const char *text_value,
- bool toggle1_value, bool toggle2_value, bool toggle3_value,
- Widget box, Widget top_widget,
- void (*text_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep, sep1, lab1, sep2, lab2, lab3, sep3, lab4;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->text_func = text_func;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- lab3 = make_row_inner_label(prf, text_label, sep, box, top_widget);
- prf->text = make_row_text(prf, text_value, cols, lab3, box, top_widget);
- sep1 = make_row_inner_separator(12, prf->text, box, top_widget);
- lab1 = make_row_inner_label(prf, toggle1_label, sep1, box, top_widget);
- prf->toggle = make_row_toggle(prf, toggle1_value, lab1, box, top_widget);
- sep2 = make_row_inner_separator(4, prf->toggle, box, top_widget);
- lab2 = make_row_inner_label(prf, toggle2_label, sep2, box, top_widget);
- prf->toggle2 = make_row_toggle(prf, toggle2_value, lab2, box, top_widget);
- sep3 = make_row_inner_separator(4, prf->toggle2, box, top_widget);
- lab4 = make_row_inner_label(prf, toggle3_label, sep3, box, top_widget);
- prf->toggle3 = make_row_toggle(prf, toggle3_value, lab4, box, top_widget);
-
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
-
- return(prf);
-}
-
-
-/* ---------------- radio row ---------------- */
-
-static void call_radio_func(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->toggle_func))
- {
- prf->radio_button = w;
- (*(prf->toggle_func))(prf);
- }
-}
-
-
-static Widget make_row_radio_box(prefs_info *prf,
- const char **labels, int num_labels, int current_value,
- Widget box, Widget left_widget, Widget top_widget)
-{
- Arg args[20];
- int i, n;
- Widget w;
-
- prf->radio_buttons = (Widget *)calloc(num_labels, sizeof(Widget));
- prf->num_buttons = num_labels;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNborderColor, ss->white); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNpacking, XmPACK_TIGHT); n++;
- w = XmCreateRadioBox(box, (char *)"radio-box", args, n);
- XtManageChild(w);
-
- for (i = 0; i < num_labels; i++)
- {
- Widget button;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNset, (i == current_value) ? XmSET : XmUNSET); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNborderColor, ss->white); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNindicatorOn, XmINDICATOR_FILL); n++;
- XtSetArg(args[n], XmNindicatorSize, 14); n++;
- XtSetArg(args[n], XmNselectColor, ss->green); n++;
- XtSetArg(args[n], XmNuserData, i); n++;
- button = XtCreateManagedWidget(labels[i], xmToggleButtonWidgetClass, w, args, n);
- prf->radio_buttons[i] = button;
-
- XtAddCallback(button, XmNvalueChangedCallback, call_radio_func, (XtPointer)prf);
- XtAddCallback(button, XmNvalueChangedCallback, prefs_change_callback, NULL);
- }
- return(w);
-}
-
-
-static prefs_info *prefs_row_with_radio_box(const char *label, const char *varname,
- const char **labels, int num_labels, int current_value,
- Widget box, Widget top_widget,
- void (*toggle_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->toggle_func = toggle_func;
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->toggle = make_row_radio_box(prf, labels, num_labels, current_value, box, sep, top_widget);
- return(prf);
-}
-
-
-/* ---------------- radio box + number ---------------- */
-
-static prefs_info *prefs_row_with_radio_box_and_number(const char *label, const char *varname,
- const char **labels, int num_labels, int current_value,
- const char *text_value, int text_cols,
- Widget box, Widget top_widget,
- void (*toggle_func)(prefs_info *prf),
- void (*arrow_up_func)(prefs_info *prf), void (*arrow_down_func)(prefs_info *prf),
- void (*text_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->toggle_func = toggle_func;
- prf->text_func = text_func;
- prf->arrow_up_func = arrow_up_func;
- prf->arrow_down_func = arrow_down_func;
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->toggle = make_row_radio_box(prf, labels, num_labels, current_value, box, sep, top_widget);
- prf->text = make_row_text(prf, text_value, text_cols, prf->toggle, box, top_widget);
- prf->arrow_up = make_row_arrows(prf, box, prf->text, top_widget);
-
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
- return(prf);
-}
-
-
-/* ---------------- scale row ---------------- */
-
-static void call_scale_func(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->scale_func))
- (*(prf->scale_func))(prf);
-}
-
-
-static void call_scale_text_func(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->text_func))
- (*(prf->text_func))(prf);
-}
-
-
-static void prefs_scale_callback(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- XmScaleCallbackStruct *cb = (XmScaleCallbackStruct *)info;
- float_to_textfield(prf->text, (cb->value * prf->scale_max) / 100.0);
-}
-
-
-static prefs_info *prefs_row_with_scale(const char *label, const char *varname,
- mus_float_t max_val, mus_float_t current_value,
- Widget box, Widget top_widget,
- void (*scale_func)(prefs_info *prf),
- void (*text_func)(prefs_info *prf))
-{
- Arg args[20];
- int n;
- prefs_info *prf = NULL;
- Widget sep;
- XtCallbackList n1, n2;
- char *str;
-
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- prf->scale_max = max_val;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
-
- str = (char *)calloc(12, sizeof(char));
- mus_snprintf(str, 12, "%.3f", current_value);
- prf->text = make_row_text(prf, str, 6, sep, box, top_widget);
- free(str);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, prf->text); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNborderColor, ss->white); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowValue, XmNONE); n++;
- XtSetArg(args[n], XmNvalue, (int)(100 * current_value / max_val)); n++;
- XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(prefs_scale_callback, (XtPointer)prf)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(prefs_scale_callback, (XtPointer)prf)); n++;
- prf->scale = XtCreateManagedWidget("", xmScaleWidgetClass, box, args, n);
-
- prf->scale_func = scale_func;
- prf->text_func = text_func;
-
- XtAddCallback(prf->scale, XmNvalueChangedCallback, call_scale_func, (XtPointer)prf);
- XtAddCallback(prf->text, XmNactivateCallback, call_scale_text_func, (XtPointer)prf);
- XtAddCallback(prf->scale, XmNvalueChangedCallback, prefs_change_callback, NULL);
-
- free(n1);
- free(n2);
-
- return(prf);
-}
-
-
-/* ---------------- text row ---------------- */
-
-static prefs_info *prefs_row_with_text(const char *label, const char *varname, const char *value,
- Widget box, Widget top_widget,
- void (*text_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->text = make_row_text(prf, value, 0, sep, box, top_widget);
-
- prf->text_func = text_func;
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
- return(prf);
-}
-
-
-
-/* ---------------- two texts in a row ---------------- */
-
-static prefs_info *prefs_row_with_two_texts(const char *label, const char *varname,
- const char *label1, const char *text1, const char *label2, const char *text2, int cols,
- Widget box, Widget top_widget,
- void (*text_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep, lab1, lab2;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- lab1 = make_row_inner_label(prf, label1, sep, box, top_widget);
- prf->text = make_row_text(prf, text1, cols, lab1, box, top_widget);
- lab2 = make_row_inner_label(prf, label2, prf->text, box, top_widget);
- prf->rtxt = make_row_text(prf, text2, cols, lab2, box, top_widget);
-
- prf->text_func = text_func;
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
- XtAddCallback(prf->rtxt, XmNactivateCallback, call_text_func, (XtPointer)prf);
-
- return(prf);
-}
-
-
-/* ---------------- number row ---------------- */
-
-static prefs_info *prefs_row_with_number(const char *label, const char *varname, const char *value, int cols,
- Widget box, Widget top_widget,
- void (*arrow_up_func)(prefs_info *prf), void (*arrow_down_func)(prefs_info *prf),
- void (*text_func)(prefs_info *prf))
-{
- prefs_info *prf = NULL;
- Widget sep;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
- prf->text = make_row_text(prf, value, cols, sep, box, top_widget);
- prf->arrow_up = make_row_arrows(prf, box, prf->text, top_widget);
- prf->error = make_row_error(prf, box, prf->arrow_up, top_widget);
-
- prf->text_func = text_func;
- prf->arrow_up_func = arrow_up_func;
- prf->arrow_down_func = arrow_down_func;
-
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
-
- return(prf);
-}
-
-
-/* ---------------- list row ---------------- */
-
-typedef struct {
- prefs_info *prf;
- char *value;
-} list_entry;
-
-static list_entry *make_list_entry(prefs_info *prf, const char *value)
-{
- list_entry *le;
- le = (list_entry *)calloc(1, sizeof(list_entry));
- le->prf = prf;
- le->value = (char *)value;
- return(le);
-}
-
-
-static void prefs_list_callback(Widget w, XtPointer context, XtPointer info)
-{
- list_entry *le = (list_entry *)context;
- if ((le) && (le->prf->list_func))
- (*(le->prf->list_func))(le->prf, le->value);
-}
-
-
-static prefs_info *prefs_row_with_list(const char *label, const char *varname, const char *value,
- const char **values, int num_values,
- Widget box, Widget top_widget,
- void (*text_func)(prefs_info *prf),
- char *(*completion_func)(widget_t w, const char *text, void *context), void *completion_context,
- void (*list_func)(prefs_info *prf, char *value))
-{
- Arg args[20];
- int n, i, cols = 0;
- prefs_info *prf = NULL;
- Widget sep, sbar;
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
-
- /* get text widget size */
- for (i = 0; i < num_values; i++)
- if (values[i])
- {
- int len;
- len = strlen(values[i]);
- if (len > cols) cols = len;
- }
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNcolumns, cols + 1); n++;
- XtSetArg(args[n], XmNvalue, value); n++;
- XtSetArg(args[n], XmNmarginHeight, 1); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNborderColor, ss->white); n++;
- XtSetArg(args[n], XmNbottomShadowColor, ss->white); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNtopShadowColor, ss->white); n++;
- if (completion_func)
- prf->text = make_textfield_widget("text", box, args, n, ACTIVATABLE_BUT_NOT_FOCUSED, add_completer_func(completion_func, completion_context));
- else prf->text = make_textfield_widget("text", box, args, n, ACTIVATABLE_BUT_NOT_FOCUSED, NO_COMPLETER);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, prf->text); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- sbar = XmCreateMenuBar(box, (char *)"menuBar", args, n);
- XtManageChild(sbar);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- prf->list_menu = XmCreatePulldownMenu(sbar, (char *)"sort-menu", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNsubMenuId, prf->list_menu); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNmarginHeight, 1); n++;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, prf->text); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- prf->arrow_right = XtCreateManagedWidget(">", xmCascadeButtonWidgetClass, sbar, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- for (i = 0; i < num_values; i++)
- if (values[i])
- {
- Widget tmp;
- tmp = XtCreateManagedWidget(values[i], xmPushButtonWidgetClass, prf->list_menu, args, n);
- XtAddCallback(tmp, XmNactivateCallback, prefs_list_callback, make_list_entry(prf, values[i]));
- XtAddCallback(tmp, XmNactivateCallback, prefs_change_callback, NULL);
- }
-
- prf->error = make_row_error(prf, box, prf->arrow_right, top_widget);
- prf->text_func = text_func;
- XtAddCallback(prf->text, XmNactivateCallback, call_text_func, (XtPointer)prf);
- XtAddCallback(prf->text, XmNactivateCallback, prefs_change_callback, NULL);
- XtAddCallback(prf->arrow_right, XmNactivateCallback, prefs_change_callback, NULL);
-
- prf->list_func = list_func;
- return(prf);
-}
-
-
-/* ---------------- color selector row(s) ---------------- */
-
-static XColor *rgb_to_color_1(mus_float_t r, mus_float_t g, mus_float_t b)
-{
- Display *dpy;
- XColor *new_color;
- new_color = (XColor *)calloc(1, sizeof(XColor));
- new_color->flags = DoRed | DoGreen | DoBlue;
- new_color->red = FLOAT_TO_RGB(r);
- new_color->green = FLOAT_TO_RGB(g);
- new_color->blue = FLOAT_TO_RGB(b);
- dpy = MAIN_DISPLAY(ss);
- XAllocColor(dpy, DefaultColormap(dpy, DefaultScreen(dpy)), new_color);
- return(new_color);
-}
-
-
-#define COLOR_MAX 90
-#define COLOR_MAXF 90.0
-#define COLOR_MARGIN 1
-
-static color_t rgb_to_color(mus_float_t r, mus_float_t g, mus_float_t b)
-{
- color_t temp;
- XColor *color;
- color = rgb_to_color_1(r, g, b);
- temp = color->pixel;
- free(color);
- return(temp);
-}
-
-
-static void pixel_to_rgb(Pixel pix, float *r, float *g, float *b)
-{
- XColor tmp_color;
- Display *dpy;
- dpy = XtDisplay(MAIN_SHELL(ss));
- tmp_color.flags = DoRed | DoGreen | DoBlue;
- tmp_color.pixel = pix;
- XQueryColor(dpy, DefaultColormap(dpy, DefaultScreen(dpy)), &tmp_color);
- (*r) = RGB_TO_FLOAT(tmp_color.red);
- (*g) = RGB_TO_FLOAT(tmp_color.green);
- (*b) = RGB_TO_FLOAT(tmp_color.blue);
-}
-
-
-static void XmScrollBarGetValue(Widget w, int *val)
-{
- XtVaGetValues(w, XmNvalue, val, NULL);
-}
-
-
-static void XmScrollBarSetValue(Widget w, int val)
-{
- XtVaSetValues(w, XmNvalue, val, NULL);
-}
-
-
-static void reflect_color(prefs_info *prf)
-{
- int ir = 0, ig = 0, ib = 0;
- mus_float_t r, g, b;
- XColor *current_color;
- Pixel pixel;
-
- XmScrollBarGetValue(prf->rscl, &ir);
- XmScrollBarGetValue(prf->gscl, &ig);
- XmScrollBarGetValue(prf->bscl, &ib);
-
- current_color = rgb_to_color_1(ir / COLOR_MAXF, ig / COLOR_MAXF, ib / COLOR_MAXF);
- r = RGB_TO_FLOAT(current_color->red);
- g = RGB_TO_FLOAT(current_color->green);
- b = RGB_TO_FLOAT(current_color->blue);
-
- pixel = current_color->pixel;
- free(current_color);
- current_color = NULL;
-
- XtVaSetValues(prf->color, XmNbackground, pixel, NULL);
- float_to_textfield(prf->rtxt, r);
- float_to_textfield(prf->gtxt, g);
- float_to_textfield(prf->btxt, b);
-}
-
-
-static void prefs_color_callback(Widget w, XtPointer context, XtPointer info)
-{
- reflect_color((prefs_info *)context);
-}
-
-
-static void unpost_color_error(XtPointer data, XtIntervalId *id)
-{
- prefs_info *prf = (prefs_info *)data;
- reflect_color(prf);
- prf->got_error = false;
- black_text(prf);
- set_label(prf->label, prf->saved_label);
-}
-
-
-static void errors_to_color_text(const char *msg, void *data)
-{
- prefs_info *prf = (prefs_info *)data;
- prf->got_error = true;
- red_text(prf);
- set_label(prf->label, msg);
- XtAppAddTimeOut(MAIN_APP(ss),
- ERROR_WAIT_TIME,
- (XtTimerCallbackProc)unpost_color_error,
- data);
-}
-
-
-static void prefs_r_callback(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- char *str;
- float r = 0.0;
- str = XmTextFieldGetString(w);
- redirect_errors_to(errors_to_color_text, (void *)prf);
- r = (float)string_to_mus_float_t(str, 0.0, "red amount");
- redirect_errors_to(NULL, NULL);
-
- XmScrollBarSetValue(prf->rscl, mus_iclamp(0, (int)(COLOR_MAX * r), COLOR_MAX));
-
- if (!(prf->got_error)) reflect_color(prf);
- if (str) XtFree(str);
-}
-
-
-static void prefs_g_callback(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- char *str;
- float r = 0.0;
- str = XmTextFieldGetString(w);
- redirect_errors_to(errors_to_color_text, (void *)prf);
- r = (float)string_to_mus_float_t(str, 0.0, "green amount");
- redirect_errors_to(NULL, NULL);
-
- XmScrollBarSetValue(prf->gscl, mus_iclamp(0, (int)(COLOR_MAX * r), COLOR_MAX));
-
- if (!(prf->got_error)) reflect_color(prf);
- if (str) XtFree(str);
-}
-
-
-static void prefs_b_callback(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- char *str;
- float r = 0.0;
- str = XmTextFieldGetString(w);
- redirect_errors_to(errors_to_color_text, (void *)prf);
- r = (float)string_to_mus_float_t(str, 0.0, "blue amount");
- redirect_errors_to(NULL, NULL);
-
- XmScrollBarSetValue(prf->bscl, mus_iclamp(0, (int)(COLOR_MAX * r), COLOR_MAX));
-
- if (!(prf->got_error)) reflect_color(prf);
- if (str) XtFree(str);
-}
-
-
-static void prefs_call_color_func_callback(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- if ((prf) && (prf->color_func))
- {
- int ir = 0, ig = 0, ib = 0;
-
- XmScrollBarGetValue(prf->rscl, &ir);
- XmScrollBarGetValue(prf->gscl, &ig);
- XmScrollBarGetValue(prf->bscl, &ib);
-
- (*(prf->color_func))(prf, (float)ir / COLOR_MAXF, (float)ig / COLOR_MAXF, (float)ib / COLOR_MAXF);
- }
-}
-
-
-static void scale_set_color(prefs_info *prf, color_t pixel)
-{
- float r = 0.0, g = 0.0, b = 0.0;
- pixel_to_rgb(pixel, &r, &g, &b);
- float_to_textfield(prf->rtxt, r);
- XmScrollBarSetValue(prf->rscl, (int)(COLOR_MAX * r));
- float_to_textfield(prf->gtxt, g);
- XmScrollBarSetValue(prf->gscl, (int)(COLOR_MAX * g));
- float_to_textfield(prf->btxt, b);
- XmScrollBarSetValue(prf->bscl, (int)(COLOR_MAX * b));
- XtVaSetValues(prf->color, XmNbackground, pixel, NULL);
-}
-
-
-static Pixel red, green, blue;
-
-static prefs_info *prefs_color_selector_row(const char *label, const char *varname,
- Pixel current_pixel,
- Widget box, Widget top_widget,
- void (*color_func)(prefs_info *prf, float r, float g, float b))
-{
- Arg args[20];
- int n;
- prefs_info *prf = NULL;
- Widget sep, sep1, frame;
- XtCallbackList n1;
- float r = 0.0, g = 0.0, b = 0.0;
-
- prf = (prefs_info *)calloc(1, sizeof(prefs_info));
- prf->var_name = varname;
- pixel_to_rgb(current_pixel, &r, &g, &b);
-
- prf->label = make_row_label(prf, label, box, top_widget);
- sep = make_row_middle_separator(prf->label, box, top_widget);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, current_pixel); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, sep); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, sep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, COLOR_POSITION); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- frame = XtCreateManagedWidget("frame", xmFrameWidgetClass, box, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, current_pixel); n++;
- prf->color = XtCreateManagedWidget("", xmLabelWidgetClass, frame, args, n);
-
- sep1 = make_row_inner_separator(8, prf->color, box, top_widget);
-
- prf->rtxt = make_row_text(prf, NULL, 6, sep1, box, top_widget);
- float_to_textfield(prf->rtxt, r);
-
- prf->gtxt = make_row_text(prf, NULL, 6, prf->rtxt, box, top_widget);
- float_to_textfield(prf->gtxt, g);
-
- prf->btxt = make_row_text(prf, NULL, 6, prf->gtxt, box, top_widget);
- float_to_textfield(prf->btxt, b);
-
- /* 2nd row = 3 scales */
- n1 = make_callback_list(prefs_color_callback, (XtPointer)prf);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNforeground, red); n++;
- XtSetArg(args[n], XmNsliderVisual, XmFOREGROUND_COLOR); n++;
- XtSetArg(args[n], XmNsliderMark, XmTHUMB_MARK); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, prf->label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- if (FIRST_COLOR_POSITION == 0)
- {
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- }
- else
- {
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, FIRST_COLOR_POSITION); n++;
- }
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, SECOND_COLOR_POSITION - COLOR_MARGIN); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- /* scale widget borders are messed up in some Motifs -- they aren't erased correctly in a scrolled window
- * so, try to use a scrollbar instead.
- */
- XtSetArg(args[n], XmNmaximum, 100); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowArrows, XmNONE); n++;
- XtSetArg(args[n], XmNvalue, (int)(COLOR_MAX * r)); n++;
- XtSetArg(args[n], XmNdragCallback, n1); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n1); n++;
- prf->rscl = XtCreateManagedWidget("", xmScrollBarWidgetClass, box, args, n);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNforeground, green); n++;
- XtSetArg(args[n], XmNsliderVisual, XmFOREGROUND_COLOR); n++;
- XtSetArg(args[n], XmNsliderMark, XmTHUMB_MARK); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, prf->label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, SECOND_COLOR_POSITION + COLOR_MARGIN); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, THIRD_COLOR_POSITION - COLOR_MARGIN); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNmaximum, 100); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowArrows, XmNONE); n++;
- XtSetArg(args[n], XmNvalue, (int)(COLOR_MAX * g)); n++;
- XtSetArg(args[n], XmNdragCallback, n1); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n1); n++;
- prf->gscl = XtCreateManagedWidget("", xmScrollBarWidgetClass, box, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNforeground, blue); n++;
- XtSetArg(args[n], XmNsliderVisual, XmFOREGROUND_COLOR); n++;
- XtSetArg(args[n], XmNsliderMark, XmTHUMB_MARK); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, prf->label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, THIRD_COLOR_POSITION + COLOR_MARGIN); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 80); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNmaximum, 100); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNshowArrows, XmNONE); n++;
- XtSetArg(args[n], XmNvalue, (int)(COLOR_MAX * b)); n++;
- XtSetArg(args[n], XmNdragCallback, n1); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n1); n++;
- prf->bscl = XtCreateManagedWidget("", xmScrollBarWidgetClass, box, args, n);
-
- XtAddCallback(prf->rtxt, XmNactivateCallback, prefs_r_callback, (XtPointer)prf);
- XtAddCallback(prf->gtxt, XmNactivateCallback, prefs_g_callback, (XtPointer)prf);
- XtAddCallback(prf->btxt, XmNactivateCallback, prefs_b_callback, (XtPointer)prf);
-
- XtAddCallback(prf->rscl, XmNvalueChangedCallback, prefs_call_color_func_callback, (XtPointer)prf);
- XtAddCallback(prf->gscl, XmNvalueChangedCallback, prefs_call_color_func_callback, (XtPointer)prf);
- XtAddCallback(prf->bscl, XmNvalueChangedCallback, prefs_call_color_func_callback, (XtPointer)prf);
-
- XtAddCallback(prf->rscl, XmNvalueChangedCallback, prefs_change_callback, NULL);
- XtAddCallback(prf->gscl, XmNvalueChangedCallback, prefs_change_callback, NULL);
- XtAddCallback(prf->bscl, XmNvalueChangedCallback, prefs_change_callback, NULL);
-
- prf->color_func = color_func;
- free(n1);
- return(prf);
-}
-
-
-/* ---------------- topic separator ---------------- */
-
-static Widget make_inter_topic_separator(Widget topics)
-{
- int n;
- Arg args[20];
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, INTER_TOPIC_SPACE); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- return(XtCreateManagedWidget("sep", xmSeparatorWidgetClass, topics, args, n));
-}
-
-
-/* ---------------- variable separator ---------------- */
-
-static Widget make_inter_variable_separator(Widget topics, Widget top_widget)
-{
- int n;
- Arg args[20];
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, INTER_VARIABLE_SPACE); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- return(XtCreateManagedWidget("sep", xmSeparatorWidgetClass, topics, args, n));
-}
-
-
-/* ---------------- top-level contents label ---------------- */
-
-static Widget make_top_level_label(const char *label, Widget parent)
-{
- int n;
- Arg args[20];
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->light_blue); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNheight, 32); n++;
- return(XtCreateManagedWidget(label, xmLabelWidgetClass, parent, args, n));
-}
-
-
-static Widget make_top_level_box(Widget topics)
-{
- Widget frame;
- int n;
- Arg args[20];
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- frame = XtCreateManagedWidget("pref-frame", xmFrameWidgetClass, topics, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- return(XtCreateManagedWidget("pref-box", xmFormWidgetClass, frame, args, n));
-}
-
-static Widget make_inner_label(const char *label, Widget parent, Widget top_widget)
-{
- int n;
- Arg args[20];
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, top_widget); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNheight, 32); n++;
- return(XtCreateManagedWidget(label, xmLabelWidgetClass, parent, args, n));
-}
-
-
-/* ---------------- base buttons ---------------- */
-
-static void wm_delete_callback(Widget w, XtPointer context, XtPointer info)
-{
- clear_prefs_dialog_error();
-}
-
-
-static void preferences_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_help("preferences",
- "This dialog sets various global variables. 'Save' then writes the new values \
-to ~/.snd_prefs_ruby|forth|s7 so that they take effect the next time you start Snd. 'Revert' resets each variable either to \
-its value when the Preferences dialog was started, or to the last saved value. 'Clear' resets each variable to its default value (its \
-value when Snd starts, before loading initialization files). 'Help' starts this dialog, and as long as it's active, it will post helpful \
-information if the mouse lingers over some variable -- sort of a tooltip that stays out of your way. \
-You can also request help on a given topic by clicking the variable name on the far right.",
- WITH_WORD_WRAP);
-}
-
-
-static void preferences_quit_callback(Widget w, XtPointer context, XtPointer info)
-{
- clear_prefs_dialog_error();
- if (XmGetFocusWidget(preferences_dialog) == XmMessageBoxGetChild(preferences_dialog, XmDIALOG_OK_BUTTON))
- XtUnmanageChild(preferences_dialog);
-}
-
-
-static void prefs_set_dialog_title(const char *filename)
-{
- XmString title;
- char *str;
- if (filename)
- {
- if (prefs_saved_filename) free(prefs_saved_filename);
- prefs_saved_filename = mus_strdup(filename);
- }
- if (prefs_saved_filename)
- str = mus_format("Preferences%s (saved in %s)\n",
- (prefs_unsaved) ? "*" : "",
- prefs_saved_filename);
- else str = mus_format("Preferences%s",
- (prefs_unsaved) ? "*" : "");
- title = XmStringCreateLocalized(str);
- free(str);
- XtVaSetValues(preferences_dialog,
- XmNdialogTitle, title,
- NULL);
- XmStringFree(title);
-}
-
-
-static void preferences_revert_callback(Widget w, XtPointer context, XtPointer info)
-{
- preferences_revert_or_clear(true);
-}
-
-
-static void preferences_clear_callback(Widget w, XtPointer context, XtPointer info)
-{
- preferences_revert_or_clear(false);
-}
-
-
-#if HAVE_EXTENSION_LANGUAGE
-static void preferences_save_callback(Widget w, XtPointer context, XtPointer info)
-{
- clear_prefs_dialog_error();
- redirect_snd_error_to(post_prefs_dialog_error, NULL);
- redirect_snd_warning_to(post_prefs_dialog_error, NULL);
- save_prefs();
- redirect_snd_error_to(NULL, NULL);
- redirect_snd_warning_to(NULL, NULL);
-}
-#endif
-
-
-
-/* ---------------- errors ---------------- */
-
-static void clear_prefs_error(Widget w, XtPointer context, XtPointer info)
-{
- prefs_info *prf = (prefs_info *)context;
- XtRemoveCallback(prf->text, XmNvalueChangedCallback, clear_prefs_error, context);
- set_label(prf->error, "");
-}
-
-
-static void post_prefs_error(const char *msg, prefs_info *prf)
-{
- prf->got_error = true;
- set_label(prf->error, msg);
- XtAddCallback(prf->text, XmNvalueChangedCallback, clear_prefs_error, (XtPointer)prf);
-}
-
-
-static void va_post_prefs_error(const char *msg, prefs_info *data, ...)
-{
- char *buf;
- va_list ap;
- va_start(ap, data);
- buf = vstr(msg, ap);
- va_end(ap);
- post_prefs_error(buf, data);
- free(buf);
-}
-
-
-/* ---------------- preferences dialog ---------------- */
-
-widget_t start_preferences_dialog(void)
-{
- Arg args[20];
- int n;
- Widget scroller, topics, current_sep;
- char *str;
- prefs_info *prf;
-
- if (preferences_dialog)
- {
- /* I don't think this should reflect current state except when it is created */
- if (!(XtIsManaged(preferences_dialog)))
- XtManageChild(preferences_dialog);
- else raise_dialog(preferences_dialog);
- return(preferences_dialog);
- }
-
- /* -------- base buttons -------- */
- {
- XmString title, help, revert, clear, save, dismiss;
- Widget revert_button, clear_button;
-
- title = XmStringCreateLocalized((char *)"Preferences");
- help = XmStringCreateLocalized((char *)"Help");
- revert = XmStringCreateLocalized((char *)"Revert");
- clear = XmStringCreateLocalized((char *)"Clear");
-#if HAVE_EXTENSION_LANGUAGE
- save = XmStringCreateLocalized((char *)"Save");
-#endif
- dismiss = XmStringCreateLocalized((char *)"Go Away");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
-#if HAVE_EXTENSION_LANGUAGE
- XtSetArg(args[n], XmNcancelLabelString, save); n++;
-#endif
- XtSetArg(args[n], XmNhelpLabelString, help); n++;
- XtSetArg(args[n], XmNokLabelString, dismiss); n++;
- XtSetArg(args[n], XmNdialogTitle, title); n++;
- XtSetArg(args[n], XmNallowShellResize, true); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- {
- Dimension width, height;
- width = XDisplayWidth(MAIN_DISPLAY(ss), DefaultScreen(MAIN_DISPLAY(ss)));
- height = XDisplayHeight(MAIN_DISPLAY(ss), DefaultScreen(MAIN_DISPLAY(ss)));
-
- XtSetArg(args[n], XmNwidth, (STARTUP_WIDTH < width) ? (Dimension)STARTUP_WIDTH : ((Dimension)(width - 50))); n++;
- XtSetArg(args[n], XmNheight, (STARTUP_HEIGHT < height) ? (Dimension)STARTUP_HEIGHT : ((Dimension)(height - 50))); n++;
- }
- preferences_dialog = XmCreateTemplateDialog(MAIN_PANE(ss), (char *)"preferences", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- revert_button = XtCreateManagedWidget("Revert", xmPushButtonGadgetClass, preferences_dialog, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- clear_button = XtCreateManagedWidget("Clear", xmPushButtonGadgetClass, preferences_dialog, args, n);
-
-#if HAVE_EXTENSION_LANGUAGE
- XtAddCallback(preferences_dialog, XmNcancelCallback, preferences_save_callback, NULL);
-#endif
- XtAddCallback(preferences_dialog, XmNhelpCallback, preferences_help_callback, NULL);
- XtAddCallback(preferences_dialog, XmNokCallback, preferences_quit_callback, NULL);
- XtAddCallback(revert_button, XmNactivateCallback, preferences_revert_callback, NULL);
- XtAddCallback(clear_button, XmNactivateCallback, preferences_clear_callback, NULL);
-
- XmStringFree(title);
- XmStringFree(help);
-#if HAVE_EXTENSION_LANGUAGE
- XmStringFree(save);
-#endif
- XmStringFree(dismiss);
- XmStringFree(revert);
- XmStringFree(clear);
-
- map_over_children(preferences_dialog, set_main_color_of_widget);
-#if HAVE_EXTENSION_LANGUAGE
- XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
-#endif
- XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(preferences_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(preferences_dialog, XmDIALOG_SEPARATOR)); n++;
- XtSetArg(args[n], XmNscrollingPolicy, XmAUTOMATIC); n++;
- XtSetArg(args[n], XmNscrollBarDisplayPolicy, XmSTATIC); n++;
- scroller = XmCreateScrolledWindow(preferences_dialog, (char *)"pref-scroller", args, n);
- XtManageChild(scroller);
-
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- n = attach_all_sides(args, 0);
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- topics = XtCreateManagedWidget("pref-topics", xmRowColumnWidgetClass, scroller, args, n);
- XtVaSetValues(scroller,
- XmNworkWindow, topics,
- NULL);
- }
-
- red = rgb_to_color(1.0, 0.0, 0.0);
- green = rgb_to_color(0.0, 1.0, 0.0);
- blue = rgb_to_color(0.0, 0.0, 1.0);
-
-
- /* ---------------- overall behavior ---------------- */
-
- {
- Widget dpy_box, dpy_label, file_label, cursor_label, key_label;
- char *str1, *str2;
-
- /* ---------------- overall behavior ----------------*/
-
- dpy_box = make_top_level_box(topics);
- dpy_label = make_top_level_label("overall behavior choices", dpy_box);
-
- current_sep = dpy_label;
- str1 = mus_format("%d", ss->init_window_width);
- str2 = mus_format("%d", ss->init_window_height);
- rts_init_window_width = ss->init_window_width;
- rts_init_window_height = ss->init_window_height;
- prf = prefs_row_with_two_texts("start up size", S_window_width,
- "width:", str1, "height:", str2, 6,
- dpy_box, current_sep,
- startup_size_text);
- remember_pref(prf, reflect_init_window_size, save_init_window_size, help_init_window_size, clear_init_window_size, revert_init_window_size);
- free(str2);
- free(str1);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_toggle("ask before overwriting anything", S_ask_before_overwrite,
- rts_ask_before_overwrite = ask_before_overwrite(ss),
- dpy_box, current_sep,
- overwrite_toggle);
- remember_pref(prf, reflect_ask_before_overwrite, save_ask_before_overwrite, help_ask_before_overwrite, NULL, revert_ask_before_overwrite);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_toggle("ask about unsaved edits before exiting", S_ask_about_unsaved_edits,
- rts_unsaved_edits = ask_about_unsaved_edits(ss),
- dpy_box, current_sep,
- unsaved_edits_toggle);
- remember_pref(prf, reflect_unsaved_edits, save_unsaved_edits, help_unsaved_edits, clear_unsaved_edits, revert_unsaved_edits);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_toggle("include thumbnail graph in upper right corner", S_with_inset_graph,
- rts_with_inset_graph = with_inset_graph(ss),
- dpy_box, current_sep,
- with_inset_graph_toggle);
- remember_pref(prf, reflect_with_inset_graph, save_with_inset_graph, help_inset_graph,
- clear_with_inset_graph, revert_with_inset_graph);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_toggle("resize main window as sounds open and close", S_auto_resize,
- rts_auto_resize = auto_resize(ss),
- dpy_box, current_sep,
- resize_toggle);
- remember_pref(prf, reflect_auto_resize, save_auto_resize, help_auto_resize, NULL, revert_auto_resize);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_toggle("pointer focus", S_with_pointer_focus,
- rts_with_pointer_focus = with_pointer_focus(ss),
- dpy_box, current_sep,
- with_pointer_focus_toggle);
- remember_pref(prf, reflect_with_pointer_focus, save_with_pointer_focus, help_pointer_focus,
- clear_with_pointer_focus, revert_with_pointer_focus);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_sync_style = sync_style(ss);
- prf = prefs_row_with_two_toggles("operate on all channels together", S_sync,
- "within each sound", rts_sync_style == SYNC_BY_SOUND,
- "across all sounds", rts_sync_style == SYNC_ALL,
- dpy_box, current_sep,
- sync1_choice, sync2_choice);
- remember_pref(prf, reflect_sync_style, save_sync_style, help_sync_style, clear_sync_style, revert_sync_style);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_remember_sound_state = remember_sound_state(ss);
- prf = prefs_row_with_toggle("restore a sound's state if reopened later", S_remember_sound_state,
- rts_remember_sound_state,
- dpy_box, current_sep,
- toggle_remember_sound_state);
- remember_pref(prf, reflect_remember_sound_state, save_remember_sound_state, help_remember_sound_state,
- clear_remember_sound_state, revert_remember_sound_state);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_toggle("show the control panel upon opening a sound", S_show_controls,
- rts_show_controls = in_show_controls(ss),
- dpy_box, current_sep,
- controls_toggle);
- remember_pref(prf, reflect_show_controls, save_show_controls, help_show_controls, NULL, revert_show_controls);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- include_peak_env_directory = mus_strdup(peak_env_dir(ss));
- rts_peak_env_directory = mus_strdup(include_peak_env_directory);
- include_peak_envs = find_peak_envs();
- rts_peak_envs = include_peak_envs;
- prf = prefs_row_with_toggle_with_text("save peak envs to speed up initial display", S_peak_env_dir,
- include_peak_envs,
- "directory:", include_peak_env_directory, 25,
- dpy_box, current_sep,
- peak_envs_toggle, peak_envs_text);
- remember_pref(prf, reflect_peak_envs, save_peak_envs, help_peak_envs, clear_peak_envs, revert_peak_envs);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- str = mus_format("%d", rts_max_regions = max_regions(ss));
- prf = prefs_row_with_toggle_with_text("selection creates an associated region", S_selection_creates_region,
- rts_selection_creates_region = selection_creates_region(ss),
- "max regions:", str, 5,
- dpy_box, current_sep,
- selection_creates_region_toggle, max_regions_text);
- remember_pref(prf, reflect_selection_creates_region, save_selection_creates_region, help_selection_creates_region, NULL, revert_selection_creates_region);
- free(str);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_with_toolbar = with_toolbar(ss);
- prf = prefs_row_with_toggle("include a toolbar", S_with_toolbar,
- rts_with_toolbar,
- dpy_box, current_sep,
- toggle_with_toolbar);
- remember_pref(prf, reflect_with_toolbar, save_with_toolbar, help_with_toolbar, clear_with_toolbar, revert_with_toolbar);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_with_tooltips = with_tooltips(ss);
- prf = prefs_row_with_toggle("enable tooltips", S_with_tooltips,
- rts_with_tooltips,
- dpy_box, current_sep,
- toggle_with_tooltips);
- remember_pref(prf, reflect_with_tooltips, save_with_tooltips, help_with_tooltips, clear_with_tooltips, revert_with_tooltips);
-
-
-
- /* ---------------- file options ---------------- */
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- file_label = make_inner_label(" file options", dpy_box, current_sep);
-
- rts_load_path = find_sources();
- prf = prefs_row_with_text("directory containing Snd's " XEN_LANGUAGE_NAME " files", "load path",
- rts_load_path,
- dpy_box, file_label,
- load_path_text);
- remember_pref(prf, reflect_load_path, NULL, help_load_path, clear_load_path, revert_load_path);
- load_path_text_widget = prf->text;
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_toggle("display only sound files in various file lists", S_just_sounds,
- rts_just_sounds = just_sounds(ss),
- dpy_box, current_sep,
- just_sounds_toggle);
- remember_pref(prf, prefs_reflect_just_sounds, save_just_sounds, help_just_sounds, NULL, revert_just_sounds);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_temp_dir = mus_strdup(temp_dir(ss));
- prf = prefs_row_with_text("directory for temporary files", S_temp_dir,
- temp_dir(ss),
- dpy_box, current_sep,
- temp_dir_text);
- remember_pref(prf, reflect_temp_dir, save_temp_dir, help_temp_dir, NULL, revert_temp_dir);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_save_dir = mus_strdup(save_dir(ss));
- prf = prefs_row_with_text("directory for save-state files", S_save_dir,
- save_dir(ss),
- dpy_box, current_sep,
- save_dir_text);
- remember_pref(prf, reflect_save_dir, save_save_dir, help_save_dir, NULL, revert_save_dir);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_save_state_file = mus_strdup(save_state_file(ss));
- prf = prefs_row_with_text("default save-state filename", S_save_state_file,
- save_state_file(ss),
- dpy_box, current_sep,
- save_state_file_text);
- remember_pref(prf, reflect_save_state_file, save_save_state_file, help_save_state_file, NULL, revert_save_state_file);
-
-#if HAVE_LADSPA
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_ladspa_dir = mus_strdup(ladspa_dir(ss));
- prf = prefs_row_with_text("directory for ladspa plugins", S_ladspa_dir,
- ladspa_dir(ss),
- dpy_box, current_sep,
- ladspa_dir_text);
- remember_pref(prf, reflect_ladspa_dir, save_ladspa_dir, help_ladspa_dir, NULL, revert_ladspa_dir);
-#endif
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_vf_directory = mus_strdup(view_files_find_any_directory());
- prf = prefs_row_with_text("directory for view-files dialog", S_add_directory_to_view_files_list,
- rts_vf_directory,
- dpy_box, current_sep,
- view_files_directory_text);
- remember_pref(prf, reflect_view_files_directory, save_view_files_directory, help_view_files_directory, NULL, revert_view_files_directory);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- rts_html_program = mus_strdup(html_program(ss));
- prf = prefs_row_with_text("external program to read HTML files via snd-help", S_html_program,
- html_program(ss),
- dpy_box, current_sep,
- html_program_text);
- remember_pref(prf, reflect_html_program, save_html_program, help_html_program, NULL, revert_html_program);
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
-
- rts_default_output_chans = default_output_chans(ss);
- prf = prefs_row_with_radio_box("default new sound attributes: chans", S_default_output_chans,
- output_chan_choices, NUM_OUTPUT_CHAN_CHOICES, -1,
- dpy_box, current_sep,
- default_output_chans_choice);
- remember_pref(prf, reflect_default_output_chans, save_default_output_chans, help_default_output_chans, NULL, revert_default_output_chans);
- reflect_default_output_chans(prf);
-
- rts_default_output_srate = default_output_srate(ss);
- prf = prefs_row_with_radio_box("srate", S_default_output_srate,
- output_srate_choices, NUM_OUTPUT_SRATE_CHOICES, -1,
- dpy_box, prf->label,
- default_output_srate_choice);
- remember_pref(prf, reflect_default_output_srate, save_default_output_srate, help_default_output_srate, NULL, revert_default_output_srate);
- reflect_default_output_srate(prf);
-
- rts_default_output_header_type = default_output_header_type(ss);
- prf = prefs_row_with_radio_box("header type", S_default_output_header_type,
- output_type_choices, NUM_OUTPUT_TYPE_CHOICES, -1,
- dpy_box, prf->label,
- default_output_header_type_choice);
- output_header_type_prf = prf;
- remember_pref(prf, reflect_default_output_header_type, save_default_output_header_type, help_default_output_header_type, NULL, revert_default_output_header_type);
-
- rts_default_output_data_format = default_output_data_format(ss);
- prf = prefs_row_with_radio_box("data format", S_default_output_data_format,
- output_format_choices, NUM_OUTPUT_FORMAT_CHOICES, -1,
- dpy_box, prf->label,
- default_output_data_format_choice);
- output_data_format_prf = prf;
- remember_pref(prf, reflect_default_output_data_format, save_default_output_data_format, help_default_output_data_format, NULL, revert_default_output_data_format);
- reflect_default_output_header_type(output_header_type_prf);
- reflect_default_output_data_format(output_data_format_prf);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- {
- int i, srate = 0, chans = 0, format = 0;
- mus_header_raw_defaults(&srate, &chans, &format);
- rts_raw_chans = chans;
- rts_raw_srate = srate;
- rts_raw_data_format = format;
- str = mus_format("%d", chans);
- str1 = mus_format("%d", srate);
- raw_data_format_choices = (char **)calloc(MUS_NUM_DATA_FORMATS - 1, sizeof(char *));
- for (i = 1; i < MUS_NUM_DATA_FORMATS; i++)
- raw_data_format_choices[i - 1] = raw_data_format_to_string(i); /* skip MUS_UNKNOWN */
- prf = prefs_row_with_text("default raw sound attributes: chans", S_mus_header_raw_defaults, str,
- dpy_box, current_sep,
- raw_chans_choice);
- remember_pref(prf, reflect_raw_chans, save_raw_chans, help_raw_chans, NULL, revert_raw_chans);
-
- prf = prefs_row_with_text("srate", S_mus_header_raw_defaults, str1,
- dpy_box, prf->label,
- raw_srate_choice);
- remember_pref(prf, reflect_raw_srate, save_raw_srate, help_raw_srate, NULL, revert_raw_srate);
-
- prf = prefs_row_with_list("data format", S_mus_header_raw_defaults, raw_data_format_choices[format - 1],
- (const char **)raw_data_format_choices, MUS_NUM_DATA_FORMATS - 1,
- dpy_box, prf->label,
- raw_data_format_from_text,
- NULL, NULL,
- raw_data_format_from_menu);
- remember_pref(prf, reflect_raw_data_format, save_raw_data_format, help_raw_data_format, NULL, revert_raw_data_format);
- free(str);
- free(str1);
- }
-
-
- /* ---------------- additional key bindings ---------------- */
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- key_label = make_inner_label(" additional key bindings", dpy_box, current_sep);
-
- {
- key_info *ki;
-
- ki = find_prefs_key_binding("play-from-cursor");
- prf = prefs_row_with_text_and_three_toggles("play all chans from cursor", S_play,
- "key:", 8, "ctrl:", "meta:", "C-x:",
- ki->key, ki->c, ki->m, ki->x,
- dpy_box, key_label,
- bind_play_from_cursor);
- remember_pref(prf, reflect_play_from_cursor, save_pfc_binding, help_play_from_cursor, clear_play_from_cursor, NULL);
- free(ki);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- ki = find_prefs_key_binding("show-all");
- prf = prefs_row_with_text_and_three_toggles("show entire sound", S_x_bounds,
- "key:", 8, "ctrl:", "meta:", "C-x:",
- ki->key, ki->c, ki->m, ki->x,
- dpy_box, current_sep,
- bind_show_all);
- remember_pref(prf, reflect_show_all, save_show_all_binding, help_show_all, clear_show_all, NULL);
- free(ki);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- ki = find_prefs_key_binding("select-all");
- prf = prefs_row_with_text_and_three_toggles("select entire sound", S_select_all,
- "key:", 8, "ctrl:", "meta:", "C-x:",
- ki->key, ki->c, ki->m, ki->x,
- dpy_box, current_sep,
- bind_select_all);
- remember_pref(prf, reflect_select_all, save_select_all_binding, help_select_all, clear_select_all, NULL);
- free(ki);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- ki = find_prefs_key_binding("show-selection");
- prf = prefs_row_with_text_and_three_toggles("show current selection", "show-selection",
- "key:", 8, "ctrl:", "meta:", "C-x:",
- ki->key, ki->c, ki->m, ki->x,
- dpy_box, current_sep,
- bind_show_selection);
- remember_pref(prf, reflect_show_selection, save_show_selection_binding, help_show_selection, clear_show_selection, NULL);
- free(ki);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- ki = find_prefs_key_binding("revert-sound");
- prf = prefs_row_with_text_and_three_toggles("undo all edits (revert)", S_revert_sound,
- "key:", 8, "ctrl:", "meta:", "C-x:",
- ki->key, ki->c, ki->m, ki->x,
- dpy_box, current_sep,
- bind_revert);
- remember_pref(prf, reflect_revert, save_revert_binding, help_revert, clear_revert_sound, NULL);
- free(ki);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- ki = find_prefs_key_binding("exit");
- prf = prefs_row_with_text_and_three_toggles("exit from Snd", S_exit,
- "key:", 8, "ctrl:", "meta:", "C-x:",
- ki->key, ki->c, ki->m, ki->x,
- dpy_box, current_sep,
- bind_exit);
- remember_pref(prf, reflect_exit, save_exit_binding, help_exit, clear_exit, NULL);
- free(ki);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- ki = find_prefs_key_binding("goto-maxamp");
- prf = prefs_row_with_text_and_three_toggles("move cursor to channel's maximum sample", S_maxamp_position,
- "key:", 8, "ctrl:", "meta:", "C-x:",
- ki->key, ki->c, ki->m, ki->x,
- dpy_box, current_sep,
- bind_goto_maxamp);
- remember_pref(prf, reflect_goto_maxamp, save_goto_maxamp_binding, help_goto_maxamp, clear_goto_maxamp, NULL);
- free(ki);
-
- }
-
-
- /* ---------------- cursor options ---------------- */
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- cursor_label = make_inner_label(" cursor options", dpy_box, current_sep);
-
- prf = prefs_row_with_toggle("report cursor location as it moves", S_with_verbose_cursor,
- rts_verbose_cursor = verbose_cursor(ss),
- dpy_box, cursor_label,
- verbose_cursor_toggle);
- remember_pref(prf, reflect_verbose_cursor, save_verbose_cursor, help_verbose_cursor, NULL, revert_verbose_cursor);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- {
- char *str1;
- str = mus_format("%.2f", rts_cursor_update_interval = cursor_update_interval(ss));
- str1 = mus_format("%d", rts_cursor_location_offset = cursor_location_offset(ss));
- prf = prefs_row_with_toggle_with_two_texts("track current location while playing", S_with_tracking_cursor,
- (rts_with_tracking_cursor = with_tracking_cursor(ss)),
- "update:", str,
- "offset:", str1, 8,
- dpy_box, current_sep,
- with_tracking_cursor_toggle,
- cursor_location_text);
- remember_pref(prf, reflect_with_tracking_cursor, save_with_tracking_cursor, help_with_tracking_cursor, NULL, revert_with_tracking_cursor);
- free(str);
- free(str1);
- }
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- str = mus_format("%d", rts_cursor_size = cursor_size(ss));
- prf = prefs_row_with_number("size", S_cursor_size,
- str, 4,
- dpy_box, current_sep,
- cursor_size_up, cursor_size_down, cursor_size_from_text);
- remember_pref(prf, reflect_cursor_size, save_cursor_size, help_cursor_size, NULL, revert_cursor_size);
- free(str);
- if (cursor_size(ss) <= 0) XtSetSensitive(prf->arrow_down, false);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_radio_box("shape", S_cursor_style,
- cursor_styles, NUM_CURSOR_STYLES,
- rts_cursor_style = cursor_style(ss),
- dpy_box, current_sep,
- cursor_style_choice);
- remember_pref(prf, reflect_cursor_style, save_cursor_style, help_cursor_style, NULL, revert_cursor_style);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- prf = prefs_row_with_radio_box("tracking cursor shape", S_tracking_cursor_style,
- cursor_styles, NUM_CURSOR_STYLES,
- rts_tracking_cursor_style = tracking_cursor_style(ss),
- dpy_box, current_sep,
- tracking_cursor_style_choice);
- remember_pref(prf, reflect_tracking_cursor_style, save_tracking_cursor_style, help_tracking_cursor_style, NULL, revert_tracking_cursor_style);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->label);
- saved_cursor_color = ss->cursor_color;
- prf = prefs_color_selector_row("color", S_cursor_color, ss->cursor_color,
- dpy_box, current_sep,
- cursor_color_func);
- remember_pref(prf, NULL, save_cursor_color, help_cursor_color, clear_cursor_color, revert_cursor_color);
-
-
- /* ---------------- (overall) colors ---------------- */
-
- current_sep = make_inter_variable_separator(dpy_box, prf->rscl);
- cursor_label = make_inner_label(" colors", dpy_box, current_sep);
-
- saved_basic_color = ss->basic_color;
- prf = prefs_color_selector_row("main background color", S_basic_color, ss->basic_color,
- dpy_box, cursor_label,
- basic_color_func);
- remember_pref(prf, NULL, save_basic_color, help_basic_color, clear_basic_color, revert_basic_color);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->rscl);
- saved_highlight_color = ss->highlight_color;
- prf = prefs_color_selector_row("main highlight color", S_highlight_color, ss->highlight_color,
- dpy_box, current_sep,
- highlight_color_func);
- remember_pref(prf, NULL, save_highlight_color, help_highlight_color, clear_highlight_color, revert_highlight_color);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->rscl);
- saved_position_color = ss->position_color;
- prf = prefs_color_selector_row("second highlight color", S_position_color, ss->position_color,
- dpy_box, current_sep,
- position_color_func);
- remember_pref(prf, NULL, save_position_color, help_position_color, clear_position_color, revert_position_color);
-
- current_sep = make_inter_variable_separator(dpy_box, prf->rscl);
- saved_zoom_color = ss->zoom_color;
- prf = prefs_color_selector_row("third highlight color", S_zoom_color, ss->zoom_color,
- dpy_box, current_sep,
- zoom_color_func);
- remember_pref(prf, NULL, save_zoom_color, help_zoom_color, clear_zoom_color, revert_zoom_color);
- }
-
- current_sep = make_inter_topic_separator(topics);
-
- /* -------- graphs -------- */
- {
- Widget grf_box, grf_label, colgrf_label;
-
- /* ---------------- graph options ---------------- */
-
- grf_box = make_top_level_box(topics);
- grf_label = make_top_level_label("graph options", grf_box);
-
- prf = prefs_row_with_radio_box("how to connect the dots", S_graph_style,
- graph_styles, NUM_GRAPH_STYLES,
- rts_graph_style = graph_style(ss),
- grf_box, grf_label,
- graph_style_choice);
- remember_pref(prf, reflect_graph_style, save_graph_style, help_graph_style, NULL, revert_graph_style);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- str = mus_format("%d", rts_dot_size = dot_size(ss));
- prf = prefs_row_with_number("dot size", S_dot_size,
- str, 4,
- grf_box, current_sep,
- dot_size_up, dot_size_down, dot_size_from_text);
- remember_pref(prf, reflect_dot_size, save_dot_size, help_dot_size, NULL, revert_dot_size);
- free(str);
- if (dot_size(ss) <= 0) XtSetSensitive(prf->arrow_down, false);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- rts_initial_beg = initial_beg(ss);
- rts_initial_dur = initial_dur(ss);
- str = mus_format("%.2f : %.2f", rts_initial_beg, rts_initial_dur);
- prf = prefs_row_with_text_with_toggle("initial graph x bounds", S_initial_graph_hook,
- (rts_full_duration = show_full_duration(ss)),
- "show full duration", str, 16,
- grf_box, current_sep,
- initial_bounds_toggle,
- initial_bounds_text);
- free(str);
- remember_pref(prf, reflect_initial_bounds, save_initial_bounds, help_initial_bounds, clear_initial_bounds, revert_initial_bounds);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- prf = prefs_row_with_radio_box("how to layout multichannel graphs", S_channel_style,
- channel_styles, NUM_CHANNEL_STYLES,
- rts_channel_style = channel_style(ss),
- grf_box, current_sep,
- channel_style_choice);
- remember_pref(prf, reflect_channel_style, save_channel_style, help_channel_style, NULL, revert_channel_style);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- prf = prefs_row_with_toggle("layout wave and fft graphs horizontally", S_graphs_horizontal,
- rts_graphs_horizontal = graphs_horizontal(ss),
- grf_box, current_sep,
- graphs_horizontal_toggle);
- remember_pref(prf, reflect_graphs_horizontal, save_graphs_horizontal, help_graphs_horizontal, NULL, revert_graphs_horizontal);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- prf = prefs_row_with_toggle("include y=0 line in sound graphs", S_show_y_zero,
- rts_show_y_zero = show_y_zero(ss),
- grf_box, current_sep,
- y_zero_toggle);
- remember_pref(prf, reflect_show_y_zero, save_show_y_zero, help_show_y_zero, NULL, revert_show_y_zero);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- rts_show_grid = show_grid(ss);
- prf = prefs_row_with_toggle("include a grid in sound graphs", S_show_grid,
- rts_show_grid == WITH_GRID,
- grf_box, current_sep,
- grid_toggle);
- remember_pref(prf, reflect_show_grid, save_show_grid, help_show_grid, NULL, revert_show_grid);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- prf = prefs_row_with_scale("grid density", S_grid_density,
- 2.0, rts_grid_density = grid_density(ss),
- grf_box, current_sep,
- grid_density_scale_callback, grid_density_text_callback);
- remember_pref(prf, reflect_grid_density, save_grid_density, help_grid_density, NULL, revert_grid_density);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- rts_show_axes = show_axes(ss);
- prf = prefs_row_with_list("what axes to display", S_show_axes, show_axes_choices[(int)rts_show_axes],
- show_axes_choices, NUM_SHOW_AXES,
- grf_box, current_sep,
- show_axes_from_text,
- NULL, NULL,
- show_axes_from_menu);
- remember_pref(prf, reflect_show_axes, save_show_axes, help_show_axes, clear_show_axes, revert_show_axes);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- rts_x_axis_style = x_axis_style(ss);
- prf = prefs_row_with_list("time division", S_x_axis_style, x_axis_styles[(int)rts_x_axis_style],
- x_axis_styles, NUM_X_AXIS_STYLES,
- grf_box, current_sep,
- x_axis_style_from_text,
- NULL, NULL,
- x_axis_style_from_menu);
- remember_pref(prf, reflect_x_axis_style, save_x_axis_style, help_x_axis_style, clear_x_axis_style, revert_x_axis_style);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- prf = prefs_row_with_toggle("include smpte info", "show-smpte-label",
- rts_with_smpte_label = with_smpte_label(ss),
- grf_box, current_sep,
- smpte_toggle);
- remember_pref(prf, reflect_smpte, save_smpte, help_smpte, clear_smpte, revert_smpte);
-
-
- /* ---------------- (graph) colors ---------------- */
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- colgrf_label = make_inner_label(" colors", grf_box, current_sep);
-
- saved_data_color = ss->data_color;
- prf = prefs_color_selector_row("unselected data (waveform) color", S_data_color, ss->data_color,
- grf_box, colgrf_label,
- data_color_func);
- remember_pref(prf, NULL, save_data_color, help_data_color, clear_data_color, revert_data_color);
-
- current_sep = make_inter_variable_separator(grf_box, prf->rscl);
- saved_graph_color = ss->graph_color;
- prf = prefs_color_selector_row("unselected graph (background) color", S_graph_color, ss->graph_color,
- grf_box, current_sep,
- graph_color_func);
- remember_pref(prf, NULL, save_graph_color, help_graph_color, clear_graph_color, revert_graph_color);
-
- current_sep = make_inter_variable_separator(grf_box, prf->rscl);
- saved_selected_data_color = ss->selected_data_color;
- prf = prefs_color_selector_row("selected channel data (waveform) color", S_selected_data_color, ss->selected_data_color,
- grf_box, current_sep,
- selected_data_color_func);
- remember_pref(prf, NULL, save_selected_data_color, help_selected_data_color, clear_selected_data_color, revert_selected_data_color);
-
- current_sep = make_inter_variable_separator(grf_box, prf->rscl);
- saved_selected_graph_color = ss->selected_graph_color;
- prf = prefs_color_selector_row("selected channel graph (background) color", S_selected_graph_color, ss->selected_graph_color,
- grf_box, current_sep,
- selected_graph_color_func);
- remember_pref(prf, NULL, save_selected_graph_color, help_selected_graph_color, clear_selected_graph_color, revert_selected_graph_color);
-
- current_sep = make_inter_variable_separator(grf_box, prf->rscl);
- saved_selection_color = ss->selection_color;
- prf = prefs_color_selector_row("selection color", S_selection_color, ss->selection_color,
- grf_box, current_sep,
- selection_color_func);
- remember_pref(prf, NULL, save_selection_color, help_selection_color, clear_selection_color, revert_selection_color);
-
- /* ---------------- (graph) fonts ---------------- */
-
- current_sep = make_inter_variable_separator(grf_box, prf->rscl);
- colgrf_label = make_inner_label(" fonts", grf_box, current_sep);
-
- rts_axis_label_font = mus_strdup(axis_label_font(ss));
- prf = prefs_row_with_text("axis label font", S_axis_label_font,
- axis_label_font(ss),
- grf_box, colgrf_label,
- axis_label_font_text);
- remember_pref(prf, reflect_axis_label_font, save_axis_label_font, help_axis_label_font, clear_axis_label_font, revert_axis_label_font);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- rts_axis_numbers_font = mus_strdup(axis_numbers_font(ss));
- prf = prefs_row_with_text("axis number font", S_axis_numbers_font,
- axis_numbers_font(ss),
- grf_box, current_sep,
- axis_numbers_font_text);
- remember_pref(prf, reflect_axis_numbers_font, save_axis_numbers_font, help_axis_numbers_font, clear_axis_numbers_font, revert_axis_numbers_font);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- rts_peaks_font = mus_strdup(peaks_font(ss));
- prf = prefs_row_with_text("fft peaks font", S_peaks_font,
- peaks_font(ss),
- grf_box, current_sep,
- peaks_font_text);
- remember_pref(prf, reflect_peaks_font, save_peaks_font, help_peaks_font, clear_peaks_font, revert_peaks_font);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- rts_bold_peaks_font = mus_strdup(bold_peaks_font(ss));
- prf = prefs_row_with_text("fft peaks bold font (for main peaks)", S_bold_peaks_font,
- bold_peaks_font(ss),
- grf_box, current_sep,
- bold_peaks_font_text);
- remember_pref(prf, reflect_bold_peaks_font, save_bold_peaks_font, help_bold_peaks_font, clear_bold_peaks_font, revert_bold_peaks_font);
-
- current_sep = make_inter_variable_separator(grf_box, prf->label);
- rts_tiny_font = mus_strdup(tiny_font(ss));
- prf = prefs_row_with_text("tiny font (for various annotations)", S_peaks_font,
- tiny_font(ss),
- grf_box, current_sep,
- tiny_font_text);
- remember_pref(prf, reflect_tiny_font, save_tiny_font, help_tiny_font, clear_tiny_font, revert_tiny_font);
- }
-
- current_sep = make_inter_topic_separator(topics);
-
- /* -------- transform -------- */
- {
- Widget fft_box, fft_label;
-
- /* ---------------- transform options ---------------- */
-
- fft_box = make_top_level_box(topics);
- fft_label = make_top_level_label("transform options", fft_box);
-
- rts_fft_size = transform_size(ss);
- str = mus_format(MUS_LD, rts_fft_size);
- prf = prefs_row_with_number("size", S_transform_size,
- str, 12,
- fft_box, fft_label,
- fft_size_up, fft_size_down, fft_size_from_text);
- remember_pref(prf, reflect_fft_size, save_fft_size, help_fft_size, NULL, revert_fft_size);
- free(str);
- if (transform_size(ss) <= 2) XtSetSensitive(prf->arrow_down, false);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- prf = prefs_row_with_radio_box("transform graph choice", S_transform_graph_type,
- transform_graph_types, NUM_TRANSFORM_GRAPH_TYPES,
- rts_transform_graph_type = transform_graph_type(ss),
- fft_box, current_sep,
- transform_graph_type_choice);
- remember_pref(prf, reflect_transform_graph_type, save_transform_graph_type, help_transform_graph_type, NULL, revert_transform_graph_type);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- rts_transform_type = transform_type(ss);
- prf = prefs_row_with_list("transform", S_transform_type, transform_types[rts_transform_type],
- transform_types, NUM_BUILTIN_TRANSFORM_TYPES,
- fft_box, current_sep,
- transform_type_from_text,
- transform_type_completer, NULL,
- transform_type_from_menu);
- remember_pref(prf, reflect_transform_type, save_transform_type, help_transform_type, clear_transform_type, revert_transform_type);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- rts_fft_window = fft_window(ss);
- prf = prefs_row_with_list("data window", S_fft_window, mus_fft_window_name(rts_fft_window),
- mus_fft_window_names(), MUS_NUM_FFT_WINDOWS,
- fft_box, current_sep,
- fft_window_from_text,
- fft_window_completer, NULL,
- fft_window_from_menu);
- remember_pref(prf, reflect_fft_window, save_fft_window, help_fft_window, clear_fft_window, revert_fft_window);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- prf = prefs_row_with_scale("data window family parameter", S_fft_window_beta,
- 1.0, rts_fft_window_beta = fft_window_beta(ss),
- fft_box, current_sep,
- fft_window_beta_scale_callback, fft_window_beta_text_callback);
- remember_pref(prf, reflect_fft_window_beta, save_fft_window_beta, help_fft_window_beta, NULL, revert_fft_window_beta);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- str = mus_format("%d", rts_max_transform_peaks = max_transform_peaks(ss));
- prf = prefs_row_with_toggle_with_text("show fft peak data", S_show_transform_peaks,
- rts_show_transform_peaks = show_transform_peaks(ss),
- "max peaks:", str, 5,
- fft_box, current_sep,
- transform_peaks_toggle, max_peaks_text);
- remember_pref(prf, reflect_transform_peaks, save_transform_peaks, help_transform_peaks, NULL, revert_transform_peaks);
- free(str);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- {
- const char **cmaps;
- int i, len;
- len = num_colormaps();
- cmaps = (const char **)calloc(len, sizeof(const char *));
- for (i = 0; i < len; i++)
- cmaps[i] = (const char *)colormap_name(i);
- rts_colormap = color_map(ss);
- prf = prefs_row_with_list("sonogram colormap", S_colormap, cmaps[rts_colormap],
- cmaps, len,
- fft_box, current_sep,
- colormap_from_text,
- colormap_completer, NULL,
- colormap_from_menu);
- remember_pref(prf, reflect_colormap, save_colormap, help_colormap, clear_colormap, revert_colormap);
- free(cmaps);
- }
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- prf = prefs_row_with_toggle("y axis as log magnitude (dB)", S_fft_log_magnitude,
- rts_fft_log_magnitude = fft_log_magnitude(ss),
- fft_box, current_sep,
- log_magnitude_toggle);
- remember_pref(prf, reflect_fft_log_magnitude, save_fft_log_magnitude, help_fft_log_magnitude, NULL, revert_fft_log_magnitude);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- str = mus_format("%.1f", rts_min_dB = min_dB(ss));
- prf = prefs_row_with_text("minimum y-axis dB value", S_min_dB, str,
- fft_box, current_sep,
- min_dB_text);
- remember_pref(prf, reflect_min_dB, save_min_dB, help_min_dB, NULL, revert_min_dB);
- free(str);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- prf = prefs_row_with_toggle("x axis as log freq", S_fft_log_frequency,
- rts_fft_log_frequency = fft_log_frequency(ss),
- fft_box, current_sep,
- log_frequency_toggle);
- remember_pref(prf, reflect_fft_log_frequency, save_fft_log_frequency, help_fft_log_frequency, NULL, revert_fft_log_frequency);
-
- current_sep = make_inter_variable_separator(fft_box, prf->label);
- prf = prefs_row_with_radio_box("normalization", S_transform_normalization,
- transform_normalizations, NUM_TRANSFORM_NORMALIZATIONS,
- rts_transform_normalization = transform_normalization(ss),
- fft_box, current_sep,
- transform_normalization_choice);
- remember_pref(prf, reflect_transform_normalization, save_transform_normalization, help_transform_normalization, NULL, revert_transform_normalization);
- }
-
- current_sep = make_inter_topic_separator(topics);
-
- /* -------- marks, mixes, and regions -------- */
- {
- Widget mmr_box, mmr_label;
- char *str1, *str2;
-
- /* ---------------- marks and mixes ---------------- */
-
- mmr_box = make_top_level_box(topics);
- mmr_label = make_top_level_label("marks and mixes", mmr_box);
-
- saved_mark_color = ss->mark_color;
- prf = prefs_color_selector_row("mark and mix tag color", S_mark_color, ss->mark_color,
- mmr_box, mmr_label,
- mark_color_func);
- remember_pref(prf, NULL, save_mark_color, help_mark_color, clear_mark_color, revert_mark_color);
-
- current_sep = make_inter_variable_separator(mmr_box, prf->rscl);
-
- str1 = mus_format("%d", rts_mark_tag_width = mark_tag_width(ss));
- str2 = mus_format("%d", rts_mark_tag_height = mark_tag_height(ss));
- prf = prefs_row_with_two_texts("mark tag size", S_mark_tag_width,
- "width:", str1, "height:", str2, 4,
- mmr_box, current_sep,
- mark_tag_size_text);
- remember_pref(prf, reflect_mark_tag_size, save_mark_tag_size, help_mark_tag_size, NULL, revert_mark_tag_size);
- free(str2);
- free(str1);
-
- current_sep = make_inter_variable_separator(mmr_box, prf->label);
- str1 = mus_format("%d", rts_mix_tag_width = mix_tag_width(ss));
- str2 = mus_format("%d", rts_mix_tag_height = mix_tag_height(ss));
- prf = prefs_row_with_two_texts("mix tag size", S_mix_tag_width,
- "width:", str1, "height:", str2, 4,
- mmr_box, current_sep,
- mix_tag_size_text);
- remember_pref(prf, reflect_mix_tag_size, save_mix_tag_size, help_mix_tag_size, NULL, revert_mix_tag_size);
- free(str2);
- free(str1);
-
- current_sep = make_inter_variable_separator(mmr_box, prf->label);
- saved_mix_color = ss->mix_color;
- prf = prefs_color_selector_row("mix waveform color", S_mix_color, ss->mix_color,
- mmr_box, current_sep,
- mix_color_func);
- remember_pref(prf, NULL, save_mix_color, help_mix_color, clear_mix_color, revert_mix_color);
-
- current_sep = make_inter_variable_separator(mmr_box, prf->rscl);
- str = mus_format("%d", rts_mix_waveform_height = mix_waveform_height(ss));
- prf = prefs_row_with_toggle_with_text("show mix waveforms (attached to the mix tag)", S_show_mix_waveforms,
- rts_show_mix_waveforms = show_mix_waveforms(ss),
- "max waveform height:", str, 5,
- mmr_box, current_sep,
- show_mix_waveforms_toggle, mix_waveform_height_text);
- remember_pref(prf, reflect_mix_waveforms, save_mix_waveforms, help_mix_waveforms, NULL, revert_mix_waveforms);
- free(str);
- }
-
- current_sep = make_inter_topic_separator(topics);
-
- /* -------- clm -------- */
- {
- Widget clm_box, clm_label;
-
- /* ---------------- clm options ---------------- */
-
- clm_box = make_top_level_box(topics);
- clm_label = make_top_level_label("clm", clm_box);
-
- rts_speed_control_style = speed_control_style(ss);
- str = mus_format("%d", rts_speed_control_tones = speed_control_tones(ss));
- prf = prefs_row_with_radio_box_and_number("speed control choice", S_speed_control_style,
- speed_control_styles, NUM_SPEED_CONTROL_STYLES, (int)speed_control_style(ss),
- str, 6,
- clm_box, clm_label,
- speed_control_choice, speed_control_up, speed_control_down, speed_control_text);
- XtSetSensitive(prf->arrow_down, (speed_control_tones(ss) > MIN_SPEED_CONTROL_SEMITONES));
- remember_pref(prf, reflect_speed_control, save_speed_control, help_speed_control, NULL, revert_speed_control);
- free(str);
-
- current_sep = make_inter_variable_separator(clm_box, prf->label);
- str = mus_format("%d", rts_sinc_width = sinc_width(ss));
- prf = prefs_row_with_text("sinc interpolation width in srate converter", S_sinc_width, str,
- clm_box, current_sep,
- sinc_width_text);
- remember_pref(prf, reflect_sinc_width, save_sinc_width, help_sinc_width, NULL, revert_sinc_width);
- free(str);
- }
-
- current_sep = make_inter_topic_separator(topics);
-
- /* -------- programming -------- */
- {
- Widget prg_box, prg_label;
-
- /* ---------------- listener options ---------------- */
-
- prg_box = make_top_level_box(topics);
- prg_label = make_top_level_label("listener options", prg_box);
-
- prf = prefs_row_with_toggle("show listener at start up", S_show_listener,
- rts_show_listener = listener_is_visible(),
- prg_box, prg_label,
- show_listener_toggle);
- remember_pref(prf, reflect_show_listener, save_show_listener, help_show_listener, clear_show_listener, revert_show_listener);
-
- current_sep = make_inter_variable_separator(prg_box, prf->label);
- rts_listener_prompt = mus_strdup(listener_prompt(ss));
- prf = prefs_row_with_text("prompt", S_listener_prompt,
- listener_prompt(ss),
- prg_box, current_sep,
- listener_prompt_text);
- remember_pref(prf, reflect_listener_prompt, save_listener_prompt, help_listener_prompt, NULL, revert_listener_prompt);
-
- current_sep = make_inter_variable_separator(prg_box, prf->label);
- str = mus_format("%d", rts_print_length = print_length(ss));
- prf = prefs_row_with_text("number of vector elements to display", S_print_length, str,
- prg_box, current_sep,
- print_length_text);
- remember_pref(prf, reflect_print_length, save_print_length, help_print_length, NULL, revert_print_length);
- free(str);
-
- current_sep = make_inter_variable_separator(prg_box, prf->label);
- rts_listener_font = mus_strdup(listener_font(ss));
- prf = prefs_row_with_text("font", S_listener_font,
- listener_font(ss),
- prg_box, current_sep,
- listener_font_text);
- remember_pref(prf, reflect_listener_font, save_listener_font, help_listener_font, clear_listener_font, revert_listener_font);
-
- current_sep = make_inter_variable_separator(prg_box, prf->label);
- saved_listener_color = ss->listener_color;
- prf = prefs_color_selector_row("background color", S_listener_color, ss->listener_color,
- prg_box, current_sep,
- listener_color_func);
- remember_pref(prf, NULL, save_listener_color, help_listener_color, clear_listener_color, revert_listener_color);
-
- current_sep = make_inter_variable_separator(prg_box, prf->rscl);
- saved_listener_text_color = ss->listener_text_color;
- prf = prefs_color_selector_row("text color", S_listener_text_color, ss->listener_text_color,
- prg_box, current_sep,
- listener_text_color_func);
- remember_pref(prf, NULL, save_listener_text_color, help_listener_text_color, clear_listener_text_color, revert_listener_text_color);
- }
-
- current_sep = make_inter_topic_separator(topics);
-
- /* -------- audio -------- */
- {
- Widget aud_box, aud_label;
-
- /* ---------------- audio options ---------------- */
-
- aud_box = make_top_level_box(topics);
- aud_label = make_top_level_label("audio options", aud_box);
-
- str = mus_format("%d", rts_dac_size = dac_size(ss));
- prf = prefs_row_with_text("dac buffer size", S_dac_size,
- str,
- aud_box, aud_label,
- dac_size_text);
- remember_pref(prf, reflect_dac_size, save_dac_size, help_dac_size, NULL, revert_dac_size);
- free(str);
-
- current_sep = make_inter_variable_separator(aud_box, prf->label);
- prf = prefs_row_with_toggle("fold in otherwise unplayable channels", S_dac_combines_channels,
- rts_dac_combines_channels = dac_combines_channels(ss),
- aud_box, current_sep,
- dac_combines_channels_toggle);
- remember_pref(prf, reflect_dac_combines_channels, save_dac_combines_channels, help_dac_combines_channels, NULL, revert_dac_combines_channels);
- }
-
- {
- Atom wm_delete_window;
- wm_delete_window = XmInternAtom(MAIN_DISPLAY(ss), (char *)"WM_DELETE_WINDOW", false);
- XmAddWMProtocolCallback(XtParent(preferences_dialog), wm_delete_window, wm_delete_callback, NULL);
- }
-
- XtManageChild(preferences_dialog);
- set_dialog_widget(PREFERENCES_DIALOG, preferences_dialog);
-
- return(preferences_dialog);
-}
diff --git a/snd-xprint.c b/snd-xprint.c
deleted file mode 100644
index 0045284..0000000
--- a/snd-xprint.c
+++ /dev/null
@@ -1,359 +0,0 @@
-#include "snd.h"
-
-/* X side of file print */
-
-static Widget print_dialog = NULL;
-static Widget print_name = NULL;
-static Widget print_eps_or_lpr = NULL;
-static char print_string[PRINT_BUFFER_SIZE];
-static Widget error_info_box, error_info_frame, error_info;
-
-static void print_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- print_dialog_help();
-}
-
-
-static void clear_print_error(void);
-
-static void print_cancel_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (XmGetFocusWidget(print_dialog) == XmMessageBoxGetChild(print_dialog, XmDIALOG_CANCEL_BUTTON))
- {
- ss->print_choice = PRINT_SND;
- clear_print_error();
- XtUnmanageChild(print_dialog);
- }
- /* else it's the <cr> from the text widget probably */
-}
-
-
-static int lpr(char *name)
-{
- /* make some desultory effort to print the file */
- mus_snprintf(print_string, PRINT_BUFFER_SIZE, "lpr %s", name);
- return(system(print_string));
-}
-
-
-static void watch_print(Widget w, XtPointer context, XtPointer info)
-{
- clear_print_error();
-}
-
-
-static Widget rc;
-static bool print_watching = false, print_error = false;
-
-static void clear_print_error(void)
-{
- XtUnmanageChild(rc);
- XtUnmanageChild(error_info_box);
- XtVaSetValues(print_eps_or_lpr, XmNbottomAttachment, XmATTACH_FORM, NULL);
- XtManageChild(rc);
- print_error = false;
- if (print_watching)
- {
- print_watching = false;
- XtRemoveCallback(print_name, XmNvalueChangedCallback, watch_print, NULL);
- XtRemoveCallback(print_eps_or_lpr, XmNvalueChangedCallback, watch_print, NULL);
- }
-}
-
-
-static void report_in_error_info(const char *msg, void *ignore)
-{
- XmString s1;
- if ((!msg) || (!(*msg))) return;
- print_error = true;
- s1 = XmStringCreateLocalized((char *)msg);
- XtVaSetValues(error_info, XmNlabelString, s1, NULL);
- if (!(XtIsManaged(error_info_box)))
- {
- Dimension text_wid = 0, dialog_wid = 0;
- XmFontList fonts;
-
- XtVaGetValues(error_info, XmNfontList, &fonts, NULL);
- XtVaGetValues(print_dialog, XmNwidth, &dialog_wid, NULL);
- text_wid = XmStringWidth(fonts, s1);
- XtUnmanageChild(rc);
-
- XtVaSetValues(print_eps_or_lpr, XmNbottomAttachment, XmATTACH_NONE, NULL);
- if (text_wid > dialog_wid)
- {
- XtUnmanageChild(print_dialog);
- XtVaSetValues(print_dialog, XmNwidth, text_wid + 40, NULL);
- XtManageChild(print_dialog);
- }
- XtManageChild(error_info_box);
- XtManageChild(rc);
- print_watching = true;
- XtAddCallback(print_name, XmNvalueChangedCallback, watch_print, NULL);
- XtAddCallback(print_eps_or_lpr, XmNvalueChangedCallback, watch_print, NULL);
- }
- XmStringFree(s1);
-}
-
-
-static printing_t printing = NOT_PRINTING;
-
-static void print_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- bool quit = false;
- XmString plab, slab;
- snd_info *nsp = NULL;
-
- if (printing)
- ss->stopped_explicitly = true;
- else
- {
- bool print_it;
- char *str = NULL;
-
- clear_print_error();
- if (ss->print_choice == PRINT_SND)
- {
- plab = XmStringCreateLocalized((char *)"Stop");
- nsp = any_selected_sound();
- mus_snprintf(print_string, PRINT_BUFFER_SIZE, "printing %s", nsp->short_filename);
- slab = XmStringCreateLocalized(print_string);
- XtVaSetValues(print_dialog,
- XmNokLabelString, plab,
- XmNmessageString, slab,
- NULL);
- XmStringFree(plab);
- XmStringFree(slab);
- }
-
- printing = PRINTING;
- print_it = (bool)XmToggleButtonGetState(print_eps_or_lpr);
- quit = (ss->print_choice == PRINT_ENV);
-
- if (print_it)
- {
- int err = 0;
- char *name;
- name = snd_tempnam();
-
- redirect_snd_error_to(report_in_error_info, NULL);
- switch (ss->print_choice)
- {
- case PRINT_SND:
- snd_print(name);
- break;
-
- case PRINT_ENV:
- enved_print(name);
- break;
- }
- redirect_snd_error_to(NULL, NULL);
- if (!print_error)
- {
- err = lpr(name); /* lpr apparently insists on printing to stderr? */
- if (err != 0)
- report_in_error_info("can't print!", NULL);
- snd_remove(name, IGNORE_CACHE);
- }
- free(name);
- }
- else
- {
- redirect_snd_error_to(report_in_error_info, NULL);
- str = XmTextGetString(print_name);
- switch (ss->print_choice)
- {
- case PRINT_SND:
- if (snd_print(str))
- report_in_minibuffer(nsp, "printed current view to %s", str);
- break;
-
- case PRINT_ENV:
- enved_print(str);
- break;
- }
- redirect_snd_error_to(NULL, NULL);
- if (str) XtFree(str);
- }
- }
-
- printing = NOT_PRINTING;
- if (ss->print_choice == PRINT_SND)
- {
- plab = XmStringCreateLocalized((char *)"Print");
- mus_snprintf(print_string, PRINT_BUFFER_SIZE, "print %s", nsp->short_filename);
- slab = XmStringCreateLocalized(print_string);
- XtVaSetValues(print_dialog,
- XmNokLabelString, plab,
- XmNmessageString, slab,
- NULL);
- XmStringFree(plab);
- XmStringFree(slab);
- }
- ss->print_choice = PRINT_SND;
- if (quit)
- XtUnmanageChild(print_dialog);
-}
-
-
-static void start_print_dialog(XmString xmstr4, bool managed)
-{
- if (!print_dialog)
- {
- Widget dl;
- XmString xmstr1, xmstr2, xmstr3, titlestr;
- Arg args[20];
- int n;
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- xmstr1 = XmStringCreateLocalized((char *)"Print"); /* "ok" here is confusing -- might mean, ok I'm done */
- xmstr2 = XmStringCreateLocalized((char *)"Help");
- xmstr3 = XmStringCreateLocalized((char *)"Go Away");
- titlestr = XmStringCreateLocalized((char *)"Print");
-
- XtSetArg(args[n], XmNmessageString, xmstr4); n++;
- XtSetArg(args[n], XmNokLabelString, xmstr1); n++;
- XtSetArg(args[n], XmNhelpLabelString, xmstr2); n++;
- XtSetArg(args[n], XmNcancelLabelString, xmstr3); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++; /* this gives us the resize handles */
- print_dialog = XmCreateMessageDialog(MAIN_PANE(ss), (char *)"eps file:", args, n);
-
- XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_MESSAGE_LABEL), XmNbackground, ss->basic_color, NULL);
-
- XmStringFree(xmstr1);
- XmStringFree(xmstr2);
- XmStringFree(xmstr3);
- XmStringFree(titlestr);
-
- XtUnmanageChild(XmMessageBoxGetChild(print_dialog, XmDIALOG_SYMBOL_LABEL));
-
- XtAddCallback(print_dialog, XmNhelpCallback, print_help_callback, NULL);
- XtAddCallback(print_dialog, XmNcancelCallback, print_cancel_callback, NULL);
- XtAddCallback(print_dialog, XmNokCallback, print_ok_callback, NULL);
-
- n = 0;
- rc = XtCreateManagedWidget("form", xmFormWidgetClass, print_dialog, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- dl = XtCreateManagedWidget("eps file:", xmLabelWidgetClass, rc, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, dl); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNvalue, eps_file(ss)); n++;
- print_name = make_textfield_widget("text", rc, args, n, ACTIVATABLE, NO_COMPLETER);
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, print_name); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- print_eps_or_lpr = make_togglebutton_widget("direct to printer", rc, args, n);
-
- /* error display */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, print_eps_or_lpr); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNmargin, 0); n++;
- error_info_box = XtCreateWidget("error-box", xmRowColumnWidgetClass, rc, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNmarginHeight, 4); n++;
- error_info_frame = XtCreateManagedWidget("error-frame", xmFrameWidgetClass, error_info_box, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- error_info = XtCreateManagedWidget("error-info", xmLabelWidgetClass, error_info_frame, args, n);
-
- XtVaSetValues(print_eps_or_lpr, XmNbottomAttachment, XmATTACH_FORM, NULL);
-
- if (managed) XtManageChild(print_dialog);
-
- map_over_children(print_dialog, set_main_color_of_widget);
- XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(print_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(print_eps_or_lpr, XmNselectColor, ss->selection_color, NULL);
-
- set_dialog_widget(PRINT_DIALOG, print_dialog);
- }
- else
- {
- XtVaSetValues(print_dialog, XmNmessageString, xmstr4, NULL);
- if (managed)
- {
- if (!XtIsManaged(print_dialog))
- XtManageChild(print_dialog);
- raise_dialog(print_dialog); /* a no-op unless already managed */
- }
- }
-}
-
-
-widget_t make_file_print_dialog(bool managed, bool direct_to_printer)
-{
- XmString xmstr4;
- xmstr4 = XmStringCreateLocalized((char *)"print");
- start_print_dialog(xmstr4, managed);
- XmStringFree(xmstr4);
- XmToggleButtonSetState(print_eps_or_lpr, direct_to_printer, false);
- return(print_dialog);
-}
-
-
-void file_print_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmString xmstr4;
- if (ss->print_choice == PRINT_SND)
- {
- snd_info *nsp;
- nsp = any_selected_sound();
- if (!nsp) return;
- mus_snprintf(print_string, PRINT_BUFFER_SIZE, "print %s", nsp->short_filename);
- xmstr4 = XmStringCreateLocalized(print_string);
- }
- else xmstr4 = XmStringCreateLocalized((char *)"print env");
- start_print_dialog(xmstr4, true);
- XmStringFree(xmstr4);
-}
-
-
-void save_print_dialog_state(FILE *fd)
-{
- if ((print_dialog) && (XtIsManaged(print_dialog)))
- {
-#if HAVE_SCHEME
- fprintf(fd, "(%s #t %s)\n", S_print_dialog, ((bool)(XmToggleButtonGetState(print_eps_or_lpr))) ? "#t" : "#f");
-#endif
-#if HAVE_RUBY
- fprintf(fd, "%s(true, %s)\n", TO_PROC_NAME(S_print_dialog), ((bool)(XmToggleButtonGetState(print_eps_or_lpr))) ? "true" : "false");
-#endif
-#if HAVE_FORTH
- fprintf(fd, "#t %s %s drop\n", ((bool)(XmToggleButtonGetState(print_eps_or_lpr))) ? "#t" : "#f", S_print_dialog);
-#endif
- }
-}
diff --git a/snd-xrec.c b/snd-xrec.c
deleted file mode 100644
index 687d63a..0000000
--- a/snd-xrec.c
+++ /dev/null
@@ -1,473 +0,0 @@
-#include "snd.h"
-
-static Widget recorder = NULL, meters = NULL, record_button = NULL, recorder_output = NULL;
-static bool reading = false, recording = false;
-static char *recorder_filename = NULL;
-static int recorder_fd = -1, recorder_srate = 44100, recorder_chans = 2, recorder_format = MUS_LFLOAT;
-static mus_long_t recorder_total_bytes = 0;
-static graphics_context *recorder_ax = NULL;
-static int meter_width = 0, meter_height = 0, meters_width = 0;
-static bool meters_in_db = false;
-static Widget file_label;
-
-#define RECORDER_HEIGHT 300
-
-
-/* error handling */
-
-static bool record_error_watching = false;
-static Widget error_info;
-
-static void clear_record_error(void);
-
-static void watch_record_error(Widget w, XtPointer context, XtPointer info)
-{
- clear_record_error();
-}
-
-
-static char *base_message(void)
-{
- return(mus_format("srate: %d, chans: %d", recorder_srate, recorder_chans));
-}
-
-
-static void clear_record_error(void)
-{
- XmString s1;
- char *bmsg;
- XtVaSetValues(error_info, XmNbackground, ss->basic_color, NULL);
- bmsg = base_message();
- s1 = XmStringCreateLocalized(bmsg);
- free(bmsg);
- XtVaSetValues(error_info, XmNlabelString, s1, NULL);
- XmStringFree(s1);
- if (record_error_watching)
- {
- record_error_watching = false;
- XtRemoveCallback(recorder_output, XmNvalueChangedCallback, watch_record_error, NULL);
- }
-}
-
-
-static void report_in_error_info(const char *msg, void *ignore)
-{
- XmString s1;
- if ((!msg) || (!(*msg))) return;
- XtVaSetValues(error_info, XmNbackground, ss->highlight_color, NULL);
- s1 = XmStringCreateLocalized((char *)msg);
- XtVaSetValues(error_info, XmNlabelString, s1, NULL);
- record_error_watching = true;
- XtAddCallback(recorder_output, XmNvalueChangedCallback, watch_record_error, NULL);
- XmStringFree(s1);
-}
-
-
-static void stop_recording(void)
-{
- XmString s2;
- recording = false;
- mus_sound_close_output(recorder_fd, recorder_total_bytes);
- recorder_fd = -1;
- recorder_total_bytes = 0;
- s2 = XmStringCreateLocalized((char *)"Record");
- XtVaSetValues(record_button, XmNlabelString, s2, NULL);
- XmStringFree(s2);
-}
-
-
-static void close_recorder(Widget w, XtPointer context, XtPointer info)
-{
- /* window manager close button */
- if (recording)
- stop_recording();
- reading = false;
- XtUnmanageChild(recorder);
-}
-
-
-static void quit_recorder(Widget w, XtPointer context, XtPointer info)
-{
- /* Quit button in the recorder dialog */
- clear_record_error();
- if (recording)
- stop_recording();
- reading = false;
- XtUnmanageChild(recorder);
-}
-
-
-static void recorder_help(Widget w, XtPointer context, XtPointer info)
-{
- recording_help();
-}
-
-
-static void display_meters(mus_float_t *maxes)
-{
- int i, x0 = 0, yc;
- /* if maxes is NULL, assume all 0's */
- if (recorder_chans == 0) return;
- if (!(recorder_ax->wn)) recorder_ax->wn = XtWindow(meters);
-
- XSetForeground(recorder_ax->dp, recorder_ax->gc, ss->white);
- XSetBackground(recorder_ax->dp, recorder_ax->gc, ss->white);
- XFillRectangle(recorder_ax->dp, recorder_ax->wn, recorder_ax->gc, 0, 0, meters_width, meter_height);
-
- XSetLineAttributes(recorder_ax->dp, recorder_ax->gc, 2, LineSolid, CapRound, JoinRound);
- XSetForeground(recorder_ax->dp, recorder_ax->gc, ss->black);
-
- yc = (int)(0.5 * meter_width + 0.2 * meter_height);
-
- for (i = 0; i < recorder_chans; i++, x0 += meter_width)
- {
- mus_float_t cur_max = 0.0, rads;
- int xc;
- if (maxes)
- {
- if (!meters_in_db)
- cur_max = maxes[i];
- else
- {
- mus_float_t dv;
- dv = in_dB(min_dB(ss), ss->lin_dB, maxes[i]);
- cur_max = 1.0 + ((dv < -30.0) ? -30.0 : dv) / 30.0;
- }
- }
-
- rads = (M_PI * 0.5 * cur_max) - (M_PI / 4);
- xc = (int)(x0 + 0.5 * meter_width);
-
- XDrawArc(recorder_ax->dp, recorder_ax->wn, recorder_ax->gc, x0, 20, meter_width, meter_width, 45 * 64, 90 * 64);
- XDrawLine(recorder_ax->dp, recorder_ax->wn, recorder_ax->gc,
- xc, yc,
- (int)(xc + 0.55 * meter_width * sin(rads)),
- (int)(yc - 0.55 * meter_width * cos(rads)));
- }
-}
-
-
-static void start_recording(void)
-{
- char *str;
- clear_record_error();
- if (recorder_filename) free(recorder_filename);
- str = XmTextGetString(recorder_output);
- if (!str)
- recorder_filename = mus_strdup("test.snd");
- else
- {
- recorder_filename = mus_strdup(str);
- XtFree(str);
- }
- redirect_snd_error_to(report_in_error_info, NULL);
- recorder_fd = mus_sound_open_output(recorder_filename, recorder_srate, recorder_chans, recorder_format,
- (recorder_format == MUS_LFLOAT) ? MUS_RIFF : MUS_NEXT,
- NULL);
- redirect_snd_error_to(NULL, NULL);
- if (recorder_fd < 0)
- {
- recording = false;
- }
- else
- {
- XmString s2;
- recording = true;
- s2 = XmStringCreateLocalized((char *)"Done");
- XtVaSetValues(record_button, XmNlabelString, s2, NULL);
- XmStringFree(s2);
- }
-}
-
-
-static void start_reading(void)
-{
- mus_float_t *maxes;
- int input_device, buffer_size, err = MUS_NO_ERROR;
- unsigned char *inbuf;
-
- clear_record_error();
-
- recorder_chans = mus_audio_device_channels(MUS_AUDIO_DEFAULT);
- if (recorder_chans > 4) recorder_chans = 8;
- if (recorder_chans <= 0)
- {
- char *msg;
- msg = mus_format("chans: %d?\n", recorder_chans);
- report_in_error_info(msg, NULL);
- free(msg);
- reading = false;
- return;
- }
-
- recorder_srate = 44100;
- recorder_format = mus_audio_device_format(MUS_AUDIO_DEFAULT);
- buffer_size = 4096;
-
- input_device = mus_audio_open_input(MUS_AUDIO_DEFAULT, recorder_srate, recorder_chans, recorder_format, buffer_size);
- if (input_device < 0)
- {
- char *msg;
- msg = mus_format("open input failed: chans: %d, srate: %d, format: %s, size: %d -> %d\n",
- recorder_chans, recorder_srate, mus_data_format_short_name(recorder_format), buffer_size, input_device);
- report_in_error_info(msg, NULL);
- free(msg);
- reading = false;
- return;
- }
-
- maxes = (mus_float_t *)calloc(recorder_chans, sizeof(mus_float_t));
- inbuf = (unsigned char *)calloc(buffer_size, sizeof(unsigned char));
-
- reading = true;
- while (true)
- {
- err = mus_audio_read(input_device, (char *)inbuf, buffer_size);
- if (err != MUS_NO_ERROR) break;
- if (recording)
- {
- ssize_t bytes;
- bytes = write(recorder_fd, (char *)inbuf, buffer_size);
- if (bytes != buffer_size)
- {
- char *msg;
- msg = mus_format("recorder wrote " SSIZE_TD " bytes of %d requested?", bytes, buffer_size);
- report_in_error_info(msg, NULL);
- free(msg);
- }
- recorder_total_bytes += buffer_size;
- }
- check_for_event(); /* watch for close event or "go away" clicked */
- if (!reading) break;
- err = mus_samples_peak(inbuf, buffer_size, recorder_chans, recorder_format, maxes);
- if (err != MUS_ERROR)
- display_meters(maxes);
- else
- {
- char *msg;
- msg = mus_format("data conversion problem; format is %s\n", mus_data_format_name(recorder_format));
- report_in_error_info(msg, NULL);
- free(msg);
- err = MUS_NO_ERROR;
- break;
- }
- }
-
- if (err != MUS_NO_ERROR)
- {
- char *msg;
- msg = mus_format("error: %s\n", mus_error_type_to_string(err));
- report_in_error_info(msg, NULL);
- free(msg);
- }
-
- mus_audio_close(input_device);
- free(inbuf);
- free(maxes);
-}
-
-
-static void start_or_stop_recorder(Widget w, XtPointer context, XtPointer info)
-{
- if (recording)
- stop_recording();
- else start_recording();
-}
-
-
-static void meters_resize(Widget w, XtPointer context, XtPointer info)
-{
- if (recorder_chans == 0) return;
- meters_width = widget_width(meters);
- meter_width = meters_width / recorder_chans;
- meter_height = widget_height(meters);
- display_meters(NULL);
-}
-
-
-static void db_callback(Widget w, XtPointer context, XtPointer info)
-{
- meters_in_db = (bool)XmToggleButtonGetState(w);
-}
-
-
-widget_t record_file(void)
-{
- if (!recorder)
- {
- Arg args[32];
- int n;
- XmString xquit, xhelp, xrecord, xtitle;
- Atom wm_delete;
-
- xquit = XmStringCreateLocalized((char *)"Go Away");
- xhelp = XmStringCreateLocalized((char *)"Help");
- xrecord = XmStringCreateLocalized((char *)"Record");
- xtitle = XmStringCreateLocalized((char *)"Record");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNcancelLabelString, xquit); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNokLabelString, xrecord); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, xtitle); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_ANY); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- XtSetArg(args[n], XmNheight, RECORDER_HEIGHT); n++;
- recorder = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Record", args, n);
-
- record_button = XmMessageBoxGetChild(recorder, XmDIALOG_OK_BUTTON);
-
- XtAddCallback(recorder, XmNcancelCallback, quit_recorder, NULL);
- XtAddCallback(recorder, XmNhelpCallback, recorder_help, NULL);
- XtAddCallback(recorder, XmNokCallback, start_or_stop_recorder, NULL);
-
- XmStringFree(xhelp);
- XmStringFree(xquit);
- XmStringFree(xrecord);
- XmStringFree(xtitle);
-
- XtVaSetValues(XmMessageBoxGetChild(recorder, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(recorder, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(recorder, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(recorder, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(recorder, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(recorder, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- recorder_filename = mus_strdup("test.snd");
-
- {
- Widget sep, sep1, form, db_button, error_info_box, error_info_frame;
-
- n = 0;
- form = XtCreateManagedWidget("form", xmFormWidgetClass, recorder, args, n);
-
- /* error/info display */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNmargin, 20); n++;
- error_info_box = XtCreateManagedWidget("error-box", xmRowColumnWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNmarginHeight, 4); n++;
- error_info_frame = XtCreateManagedWidget("error-frame", xmFrameWidgetClass, error_info_box, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- error_info = XtCreateManagedWidget("error-info", xmLabelWidgetClass, error_info_frame, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, error_info_box); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNheight, 10); n++;
- sep1 = XtCreateManagedWidget("sep1", xmSeparatorWidgetClass, form, args, n);
-
-
- /* dB button, filename */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, sep1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNmarginWidth, 8); n++;
- db_button = make_togglebutton_widget("dB", form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, sep1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- file_label = XtCreateManagedWidget("file:", xmLabelWidgetClass, form, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, file_label); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, sep1); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, db_button); n++;
- XtSetArg(args[n], XmNvalue, recorder_filename); n++;
- recorder_output = make_textfield_widget("text", form, args, n, ACTIVATABLE, NO_COMPLETER);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, recorder_output); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNheight, 10); n++;
- sep = XtCreateManagedWidget("sep", xmSeparatorWidgetClass, form, args, n);
-
-
- /* meters */
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, sep); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNheight, 50); n++;
- meters = XtCreateManagedWidget("meters", xmDrawingAreaWidgetClass, form, args, n);
-
- XtAddCallback(db_button, XmNvalueChangedCallback, db_callback, NULL);
- }
-
- recorder_ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- {
- XGCValues gv;
- gv.function = GXcopy;
- XtVaGetValues(meters, XmNbackground, &gv.background, XmNforeground, &gv.foreground, NULL);
- recorder_ax->gc = XtGetGC(meters, GCForeground | GCFunction, &gv);
- }
-
- wm_delete = XmInternAtom(XtDisplay(recorder), (char *)"WM_DELETE_WINDOW", false);
- XmAddWMProtocolCallback(XtParent(recorder), wm_delete, close_recorder, NULL);
-
- XtManageChild(recorder);
- map_over_children(recorder, set_main_color_of_widget);
- set_dialog_widget(RECORDER_DIALOG, recorder);
-
- recorder_ax->wn = XtWindow(meters);
- recorder_ax->dp = XtDisplay(meters);
-
- XtAddCallback(meters, XmNresizeCallback, meters_resize, NULL);
- XtAddCallback(meters, XmNexposeCallback, meters_resize, NULL);
-
- XtVaSetValues(recorder, XmNheight, RECORDER_HEIGHT, NULL);
- }
- else
- {
- if (!XtIsManaged(recorder)) XtManageChild(recorder);
- raise_dialog(recorder);
- }
-
- start_reading();
- return(recorder);
-}
-
-
diff --git a/snd-xref.c b/snd-xref.c
index 430e489..fbeac26 100644
--- a/snd-xref.c
+++ b/snd-xref.c
@@ -1,823 +1,956 @@
/* Snd help index (generated by make-index.scm) */
-#define HELP_NAMES_SIZE 1374
+#define HELP_NAMES_SIZE 1602
#if HAVE_SCHEME || HAVE_FORTH
static const char *help_names[HELP_NAMES_SIZE] = {
- "*#readers*", "abort", "add-amp-controls", "add-colormap", "add-comment", "add-directory-to-view-files-list",
- "add-file-filter", "add-file-sorter", "add-file-to-view-files-list", "add-mark", "add-mark-pane", "add-player",
- "add-sound-file-extension", "add-source-file-extension", "add-to-main-menu", "add-to-menu", "add-tooltip", "add-transform",
- "additive synthesis", "after-apply-controls-hook", "after-edit-hook", "after-graph-hook", "after-lisp-graph-hook", "after-open-hook",
- "after-save-as-hook", "after-save-state-hook", "after-transform-hook", "all-pass", "all-pass?", "amp-control",
- "amp-control-bounds", "amplitude-modulate", "analyse-ladspa", "any-env-channel", "append-sound", "apply-controls",
- "apply-ladspa", "array->file", "array-interp", "as-one-edit", "ask-about-unsaved-edits", "ask-before-overwrite",
- "asymmetric-fm", "asymmetric-fm?", "audio-input-device", "audio-output-device", "augment-environment", "auto-resize",
- "auto-save", "auto-update", "auto-update-interval", "autocorrelate", "axis-color", "axis-info",
- "axis-label-font", "axis-numbers-font", "background-gradient", "bad-header-hook", "bagpipe", "basic-color",
- "beats-per-measure", "beats-per-minute", "before-close-hook", "before-exit-hook", "before-save-as-hook", "before-save-state-hook",
- "before-transform-hook", "bessel filters", "bigbird", "bignum", "bignum-precision", "bignum?",
- "binary files", "bind-key", "bird", "bold-peaks-font", "bomb", "break",
- "brown-noise", "butterworth filters", "c-g?", "call-with-exit", "call_in", "cascade->canonical",
- "catch", "chain-dsps", "channel->vct", "channel-amp-envs", "channel-data", "channel-envelope",
- "channel-polynomial", "channel-properties", "channel-property", "channel-rms", "channel-style", "channel-sync",
- "channel-widgets", "channels", "channels-equal?", "channels-separate", "channels=?", "chans",
- "chebyshev filters", "check-mix-tags", "clean-channel", "clean-sound", "clear-array", "clear-listener",
- "clear-minibuffer", "clip-hook", "clipping", "clm-channel", "clm-load", "clone-sound-as",
- "close-hook", "close-sound", "color->list", "color-cutoff", "color-hook", "color-inverted",
- "color-mixes", "color-orientation-dialog", "color-scale", "color?", "colormap", "colormap->integer",
- "colormap-name", "colormap-ref", "colormap-size", "colormap?", "comb", "comb?",
- "combined-data-color", "comment", "compand-channel", "compand-sound", "concatenate-envelopes", "constant?",
- "continue-frame->file", "continue-sample->file", "contrast-channel", "contrast-control", "contrast-control-amp", "contrast-control-bounds",
- "contrast-control?", "contrast-enhancement", "contrast-sound", "controls->channel", "convolution", "convolution reverb",
- "convolve", "convolve-files", "convolve-selection-with", "convolve-with", "convolve?", "copy-frame-reader",
- "copy-sampler", "correlate", "count-matches", "create-ssb-dialog", "cross-fade (amplitude)", "cross-fade (frequency domain)",
- "cross-synthesis", "current-edit-position", "current-environment", "current-font", "cursor", "cursor-color",
- "cursor-follows-play", "cursor-in-view", "cursor-location-offset", "cursor-position", "cursor-size", "cursor-style",
- "cursor-update-interval", "dac-combines-channels", "dac-hook", "dac-size", "data-color", "data-format",
- "data-location", "data-size", "db->linear", "default-output-chans", "default-output-data-format", "default-output-header-type",
- "default-output-srate", "defgenerator", "define*", "define-constant", "define-envelope", "define-macro",
- "define-macro*", "define-selection-via-marks", "definstrument", "defvar", "degrees->radians", "delay",
+ "*#readers*", "->byte-vector", "abcos", "abcos?", "abort", "absin",
+ "absin?", "add-amp-controls", "add-colormap", "add-delete-option", "add-directory-to-view-files-list", "add-file-filter",
+ "add-file-sorter", "add-file-to-view-files-list", "add-mark", "add-mark-pane", "add-player", "add-sound-file-extension",
+ "add-source-file-extension", "add-to-main-menu", "add-to-menu", "add-tooltip", "add-transform", "additive synthesis",
+ "adjustable-sawtooth-wave", "adjustable-sawtooth-wave?", "adjustable-square-wave", "adjustable-square-wave?", "adjustable-triangle-wave", "adjustable-triangle-wave?",
+ "after-apply-controls-hook", "after-edit-hook", "after-graph-hook", "after-lisp-graph-hook", "after-open-hook", "after-save-as-hook",
+ "after-save-state-hook", "after-transform-hook", "all-chans", "all-pass", "all-pass-bank", "all-pass-bank?",
+ "all-pass?", "amp-control", "amp-control-bounds", "amplitude-modulate", "analyse-ladspa", "anoi",
+ "any-env-channel", "any-random", "apply-controls", "apply-ladspa", "aritable?", "arity",
+ "array->file", "array-interp", "as-one-edit", "ask-about-unsaved-edits", "ask-before-overwrite", "asyfm-I",
+ "asyfm-J", "asyfm?", "asymmetric-fm", "asymmetric-fm?", "auto-resize", "auto-save",
+ "auto-update", "auto-update-interval", "autocorrelate", "axis-color", "axis-info", "axis-label-font",
+ "axis-numbers-font", "background-gradient", "bad-header-hook", "bagpipe", "basic-color", "beats-per-measure",
+ "beats-per-minute", "before-close-hook", "before-exit-hook", "before-save-as-hook", "before-save-state-hook", "before-transform-hook",
+ "bes-j0", "bess", "bess?", "bessel filters", "bigbird", "bignum",
+ "bignum?", "binary files", "bind-key", "bird", "blackman", "blackman4-env-channel",
+ "blackman?", "bold-peaks-font", "break", "brown-noise", "brown-noise?", "butterworth filters",
+ "byte-vector", "byte-vector?", "c-define", "c-g?", "c-object?", "c-pointer",
+ "c-pointer?", "call-with-exit", "canter", "cascade->canonical", "catch", "cellon",
+ "chain-dsps", "channel->vct", "channel-amp-envs", "channel-data", "channel-envelope", "channel-polynomial",
+ "channel-properties", "channel-property", "channel-rms", "channel-style", "channel-sync", "channel-widgets",
+ "channels", "channels-equal?", "channels=?", "chans", "char-position", "cheby-hka",
+ "chebyshev filters", "check-mix-tags", "chordalize", "chorus", "clean-channel", "clean-sound",
+ "clear-listener", "clip-hook", "clipping", "clm-channel", "clm-expsrc", "close-hook",
+ "close-sound", "color->list", "color-cutoff", "color-hook", "color-inverted", "color-mixes",
+ "color-orientation-dialog", "color-scale", "color?", "colormap", "colormap->integer", "colormap-name",
+ "colormap-ref", "colormap-size", "colormap?", "comb", "comb-bank", "comb-bank?",
+ "comb?", "combined-data-color", "comment", "complexify", "compute-uniform-circular-string", "concatenate-envelopes",
+ "constant?", "continuation?", "continue-frample->file", "continue-sample->file", "contrast-channel", "contrast-control",
+ "contrast-control-amp", "contrast-control-bounds", "contrast-control?", "contrast-enhancement", "contrast-sound", "controls->channel",
+ "convolution", "convolution reverb", "convolve", "convolve-files", "convolve-selection-with", "convolve-with",
+ "convolve?", "copy", "copy-context", "copy-sampler", "correlate", "coverlet",
+ "cross-fade (amplitude)", "cross-fade (frequency domain)", "cross-synthesis", "curlet", "current-font", "cursor",
+ "cursor-color", "cursor-context", "cursor-location-offset", "cursor-position", "cursor-size", "cursor-style",
+ "cursor-update-interval", "cutlet", "cyclic-sequences", "dac-combines-channels", "dac-size", "data-color",
+ "data-location", "data-size", "db->linear", "default-output-chans", "default-output-header-type", "default-output-sample-type",
+ "default-output-srate", "defgenerator", "define*", "define-constant", "define-envelope", "define-expansion",
+ "define-macro", "define-macro*", "define-selection-via-marks", "defined?", "degrees->radians", "delay",
"delay-channel-mixes", "delay-tick", "delay?", "delete-colormap", "delete-file-filter", "delete-file-sorter",
"delete-mark", "delete-marks", "delete-sample", "delete-samples", "delete-samples-and-smooth", "delete-selection",
- "delete-selection-and-smooth", "delete-transform", "describe-hook", "describe-mark", "dialog-widgets", "disable-control-panel",
- "display-bark-fft", "display-db", "display-edits", "display-scanned-synthesis", "dissolve-fade", "dither-channel",
- "dither-sound", "dlocsig", "dot-product", "dot-size", "draw-axes", "draw-dot",
- "draw-dots", "draw-line", "draw-lines", "draw-mark-hook", "draw-mix-hook", "draw-string",
- "drop sites", "drop-hook", "during-open-hook", "edit-fragment", "edit-header-dialog", "edit-hook",
- "edit-list->function", "edit-position", "edit-properties", "edit-property", "edit-tree", "edits",
- "edot-product", "effects-hook", "elliptic filters", "env", "env-any", "env-channel",
- "env-channel-with-base", "env-expt-channel", "env-interp", "env-mixes", "env-selection", "env-sound",
- "env-sound-interp", "env?", "enved-base", "enved-clip?", "enved-dialog", "enved-envelope",
+ "delete-selection-and-smooth", "delete-transform", "describe-hook", "describe-mark", "dht", "dialog-widgets",
+ "dilambda", "disable-control-panel", "display-bark-fft", "display-correlation", "display-db", "display-edits",
+ "display-energy", "dissolve-fade", "dither-channel", "dither-sound", "dolph", "dot-product",
+ "dot-size", "down-oct", "draw-axes", "draw-dot", "draw-dots", "draw-line",
+ "draw-lines", "draw-mark-hook", "draw-mix-hook", "draw-string", "drone", "drop sites",
+ "drop-hook", "during-open-hook", "edit-fragment", "edit-header-dialog", "edit-hook", "edit-list->function",
+ "edit-position", "edit-properties", "edit-property", "edit-tree", "edits", "edot-product",
+ "effects-hook", "elliptic filters", "env", "env-any", "env-channel", "env-channel-with-base",
+ "env-expt-channel", "env-interp", "env-mixes", "env-selection", "env-sound", "env-sound-interp",
+ "env-squared-channel", "env?", "enved-base", "enved-clip?", "enved-dialog", "enved-envelope",
"enved-filter", "enved-filter-order", "enved-hook", "enved-in-dB", "enved-power", "enved-style",
- "enved-target", "enved-wave?", "enved-waveform-color", "envelope-interp", "enveloped-mix", "eps-bottom-margin",
- "eps-file", "eps-left-margin", "eps-size", "*error-hook*", "*error-info*", "eval-between-marks",
- "eval-over-selection", "every-sample?", "exit", "exit-hook", "expand-control", "expand-control-bounds",
- "expand-control-hop", "expand-control-jitter", "expand-control-length", "expand-control-ramp", "expand-control?", "explode-sf2",
- "exponentially-weighted-moving-average", "extract-channel", "extract-channels", "*features*", "feedback fm", "fft",
- "fft sizes", "fft-edit", "fft-log-frequency", "fft-log-magnitude", "fft-smoother", "fft-squelch",
- "fft-window", "fft-window-alpha", "fft-window-beta", "fft-with-phases", "file database", "file->array",
- "file->frame", "file->frame?", "file->sample", "file->sample?", "file->sound-data", "file->vct",
- "file-name", "fill-polygon", "fill-rectangle", "filter", "filter-channel", "filter-control-coeffs",
+ "enved-target", "enved-wave?", "enved-waveform-color", "envelope-interp", "enveloped-mix", "eoddcos",
+ "eoddcos?", "eps-bottom-margin", "eps-file", "eps-left-margin", "eps-size", "ercos",
+ "ercos?", "*error-hook*", "erssb", "erssb?", "even-multiple", "even-weight",
+ "every-sample?", "exit", "exit-hook", "expand-control", "expand-control-bounds", "expand-control-hop",
+ "expand-control-jitter", "expand-control-length", "expand-control-ramp", "expand-control?", "explode-sf2", "exponentially-weighted-moving-average",
+ "expsnd", "expsrc", "*features*", "feedback fm", "fft", "fft-cancel",
+ "fft-edit", "fft-env-edit", "fft-env-interp", "fft-log-frequency", "fft-log-magnitude", "fft-smoother",
+ "fft-squelch", "fft-window", "fft-window-alpha", "fft-window-beta", "fft-with-phases", "file database",
+ "file->array", "file->frample", "file->frample?", "file->sample", "file->sample?", "file-name",
+ "fill!", "fill-polygon", "fill-rectangle", "filter", "filter-channel", "filter-control-coeffs",
"filter-control-envelope", "filter-control-in-dB", "filter-control-in-hz", "filter-control-order", "filter-control-waveform-color", "filter-control?",
- "filter-selection", "filter-selection-and-smooth", "filter-sound", "filter?", "filtered-comb", "filtered-comb?",
- "find-channel", "find-dialog", "find-mark", "find-mix", "find-sound", "finish-progress-report",
- "fir-filter", "fir-filter?", "firmant", "firmant?", "flocsig", "flocsig?",
- "flute model", "fm-bell", "fm-drum", "fm-noise", "fm-talker", "fm-trumpet",
- "fm-violin", "fm-voice", "focus-widget", "FOF synthesis", "for-each-child", "for-each-sound-file",
- "Forbidden Planet", "foreground-color", "forget-region", "formant", "formant?", "format",
- "fourier-transform", "fractional-fourier-transform", "frame", "frame*", "frame+", "frame->file",
- "frame->file?", "frame->frame", "frame->list", "frame->sample", "frame->sound", "frame->sound-data",
- "frame->vct", "frame-copy", "frame-reader-at-end?", "frame-reader-chans", "frame-reader-home", "frame-reader-position",
- "frame-reader?", "frame-ref", "frame-reverse!", "frame-set!", "frame?", "frames",
- "free-frame-reader", "free-player", "free-sampler", "freeverb", "fullmix", "gaussian-distribution",
- "gc-off", "gc-on", "gensym", "gl-graph->ps", "global-environment", "glSpectrogram",
- "goertzel", "goto-listener-end", "grab-lock", "grani", "granulate", "granulate?",
+ "filter-fft", "filter-selection", "filter-selection-and-smooth", "filter-sound", "filter?", "filtered-comb",
+ "filtered-comb-bank", "filtered-comb-bank?", "filtered-comb?", "find-dialog", "find-mark", "find-mix",
+ "find-sound", "finfo", "finish-progress-report", "fir-filter", "fir-filter?", "firmant",
+ "firmant?", "fit-selection-between-marks", "flatten-partials", "float-vector", "float-vector*", "float-vector+",
+ "float-vector->channel", "float-vector->list", "float-vector->string", "float-vector-abs!", "float-vector-add!", "float-vector-copy",
+ "float-vector-equal?", "float-vector-fill!", "float-vector-length", "float-vector-max", "float-vector-min", "float-vector-move!",
+ "float-vector-multiply!", "float-vector-offset!", "float-vector-peak", "float-vector-polynomial", "float-vector-ref", "float-vector-reverse!",
+ "float-vector-scale!", "float-vector-set!", "float-vector-subseq", "float-vector-subtract!", "float-vector?", "flocsig",
+ "flocsig?", "flute model", "fm-bell", "fm-drum", "fm-noise", "fm-parallel-component",
+ "fm-talker", "fm-trumpet", "fm-violin", "fm-voice", "fmssb", "fmssb?",
+ "focus-widget", "FOF synthesis", "fofins", "for-each-child", "for-each-sound-file", "Forbidden Planet",
+ "foreground-color", "forget-region", "formant", "formant-bank", "formant-bank?", "formant?",
+ "format", "fp", "fractional-fourier-transform", "frample->file", "frample->file?", "frample->frample",
+ "framples", "free-player", "free-sampler", "freeverb", "fullmix", "funclet",
+ "gaussian-distribution", "gc-off", "gc-on", "gensym", "gensym?", "gl-graph->ps",
+ "glSpectrogram", "goertzel", "goto-listener-end", "grani", "granulate", "granulate?",
"granulated-sound-interp", "graph", "graph->ps", "graph-color", "graph-cursor", "graph-data",
- "graph-hook", "graph-lines", "graph-style", "graphic equalizer", "graphs-horizontal", "green-noise",
- "green-noise-interp", "grid-density", "harmonicizer", "Hartley transform", "hash-table", "header-type",
+ "graph-hook", "graph-style", "graphic equalizer", "graphs-horizontal", "green-noise", "green-noise-interp",
+ "green-noise-interp?", "green-noise?", "grid-density", "harmonicizer", "Hartley transform", "hash-table",
+ "hash-table*", "hash-table-entries", "hash-table-ref", "hash-table-set!", "hash-table?", "header-type",
"hello-dentist", "help-dialog", "help-hook", "hide-widget", "highlight-color", "hilbert-transform",
- "hook", "hook-arity", "hook-functions", "hook-member", "html-dir", "html-program",
- "hz->radians", "iir-filter", "iir-filter?", "in", "in-any", "ina",
- "inb", "info-dialog", "init-ladspa", "initial-beg", "initial-dur", "initial-graph-hook",
- "insert-channel", "insert-file-dialog", "insert-frame", "insert-region", "insert-sample", "insert-samples",
- "insert-selection", "insert-silence", "insert-sound", "insert-sound-data", "insert-vct", "Instruments",
+ "hook-functions", "hook-member", "html", "html-dir", "html-program", "hz->radians",
+ "iir-filter", "iir-filter?", "in", "in-any", "ina", "inb",
+ "info-dialog", "init-ladspa", "initial-beg", "initial-dur", "initial-graph-hook", "inlet",
+ "insert-channel", "insert-file-dialog", "insert-region", "insert-sample", "insert-samples", "insert-selection",
+ "insert-silence", "insert-sound", "int-vector", "int-vector-ref", "int-vector-set!", "int-vector?",
"integer->colormap", "integer->mark", "integer->mix", "integer->region", "integer->sound", "integer->transform",
- "integrate-envelope", "jc-reverb", "join-thread", "just-sounds", "kalman-filter-channel", "key",
- "key-binding", "key-press-hook", "ladspa-descriptor", "ladspa-dir", "lambda*", "left-sample",
- "level meters", "linear->db", "linear-src-channel", "lisp-graph-hook", "lisp-graph-style", "lisp-graph?",
- "list->vct", "list-ladspa", "listener-click-hook", "listener-color", "listener-font", "listener-prompt",
- "listener-selection", "listener-text-color", "little-endian?", "*load-hook*", "*load-path*", "locsig",
- "locsig-ref", "locsig-reverb-ref", "locsig-reverb-set!", "locsig-set!", "locsig-type", "locsig?",
- "log-freq-start", "loop-between-marks", "lpc-coeffs", "lpc-predict", "macro?", "macroexpand",
- "main-menu", "main-widgets", "make-all-pass", "make-asymmetric-fm", "make-bandpass", "make-bandstop",
- "make-biquad", "make-birds", "make-color", "make-comb", "make-convolve", "make-delay",
- "make-differentiator", "make-env", "make-fft-window", "make-file->frame", "make-file->sample", "make-filter",
- "make-filtered-comb", "make-fir-coeffs", "make-fir-filter", "make-firmant", "make-flocsig", "make-formant",
- "make-frame", "make-frame!", "make-frame->file", "make-frame-reader", "make-granulate", "make-graph-data",
- "make-hash-table", "make-highpass", "make-hilbert-transform", "make-hook", "make-iir-filter", "make-lock",
- "make-locsig", "make-lowpass", "make-mix-sampler", "make-mixer", "make-mixer!", "make-move-sound",
- "make-moving-autocorrelation", "make-moving-average", "make-moving-fft", "make-moving-pitch", "make-moving-scentroid", "make-moving-spectrum",
- "make-ncos", "make-noid", "make-notch", "make-nrxycos", "make-nrxysin", "make-nsin",
- "make-one-pole", "make-one-zero", "make-oscil", "make-phase-vocoder", "make-pixmap", "make-player",
- "make-polyoid", "make-polyshape", "make-polywave", "make-pulse-train", "make-rand", "make-rand-interp",
- "make-random-state", "make-readin", "make-region", "make-region-frame-reader", "make-region-sampler", "make-sample->file",
- "make-sampler", "make-sawtooth-wave", "make-scalar-mixer", "make-selection", "make-selection-frame-reader", "make-snd->sample",
- "make-sound-box", "make-sound-data", "make-square-wave", "make-src", "make-ssb-am", "make-sync-frame-reader",
- "make-table-lookup", "make-thread", "make-thread-variable", "make-triangle-wave", "make-two-pole", "make-two-zero",
- "make-type", "make-variable-display", "make-variable-graph", "make-vct", "make-wave-train", "map-channel",
- "map-sound", "map-sound-files", "maracas", "mark->integer", "mark-click-hook", "mark-color",
+ "integrate-envelope", "invert-filter", "iterate", "iterator-at-end?", "iterator-sequence", "iterator?",
+ "izcos", "izcos?", "j0evencos", "j0evencos?", "j0j1cos", "j0j1cos?",
+ "j2cos", "j2cos?", "jc-reverb", "jjcos", "jjcos?", "jncos",
+ "jncos?", "jpcos", "jpcos?", "just-sounds", "jycos", "jycos?",
+ "k2cos", "k2cos?", "k2sin", "k2sin?", "k2ssb", "k2ssb?",
+ "k3sin", "k3sin?", "kalman-filter-channel", "key", "key-binding", "key-press-hook",
+ "krksin", "krksin?", "ladspa-descriptor", "ladspa-dir", "lambda*", "lbj-piano",
+ "left-sample", "let->list", "let-ref", "let-set!", "let?", "linear->db",
+ "linear-src-channel", "lint for scheme", "lisp-graph-hook", "lisp-graph-style", "lisp-graph?", "list->float-vector",
+ "list->vct", "list-ladspa", "listener-click-hook", "listener-color", "listener-colorized", "listener-font",
+ "listener-prompt", "listener-selection", "listener-text-color", "little-endian?", "*load-hook*", "*load-path*",
+ "locate-zero", "locsig", "locsig-ref", "locsig-reverb-ref", "locsig-reverb-set!", "locsig-set!",
+ "locsig-type", "locsig?", "log-freq-start", "lpc-coeffs", "lpc-predict", "macro?",
+ "macroexpand", "main-menu", "main-widgets", "make-abcos", "make-absin", "make-adjustable-sawtooth-wave",
+ "make-adjustable-square-wave", "make-adjustable-triangle-wave", "make-all-pass", "make-all-pass-bank", "make-asyfm", "make-asymmetric-fm",
+ "make-bandpass", "make-bandstop", "make-bess", "make-biquad", "make-birds", "make-blackman",
+ "make-brown-noise", "make-byte-vector", "make-channel-drop-site", "make-color", "make-comb", "make-comb-bank",
+ "make-convolve", "make-delay", "make-differentiator", "make-env", "make-eoddcos", "make-ercos",
+ "make-erssb", "make-fft-window", "make-file->frample", "make-file->sample", "make-filter", "make-filtered-comb",
+ "make-filtered-comb-bank", "make-fir-coeffs", "make-fir-filter", "make-firmant", "make-float-vector", "make-flocsig",
+ "make-fmssb", "make-formant", "make-formant-bank", "make-frample->file", "make-granulate", "make-graph-data",
+ "make-green-noise", "make-green-noise-interp", "make-hash-table", "make-highpass", "make-hilbert-transform", "make-hook",
+ "make-iir-filter", "make-int-vector", "make-iterator", "make-izcos", "make-j0evencos", "make-j0j1cos",
+ "make-j2cos", "make-jjcos", "make-jncos", "make-jpcos", "make-jycos", "make-k2cos",
+ "make-k2sin", "make-k2ssb", "make-k3sin", "make-krksin", "make-locsig", "make-lowpass",
+ "make-mix-sampler", "make-move-sound", "make-moving-autocorrelation", "make-moving-average", "make-moving-fft", "make-moving-max",
+ "make-moving-norm", "make-moving-pitch", "make-moving-scentroid", "make-moving-spectrum", "make-n1cos", "make-nchoosekcos",
+ "make-ncos", "make-nkssb", "make-noddcos", "make-noddsin", "make-noddssb", "make-noid",
+ "make-notch", "make-nrcos", "make-nrsin", "make-nrssb", "make-nrxycos", "make-nrxysin",
+ "make-nsin", "make-nsincos", "make-nssb", "make-nxy1cos", "make-nxy1sin", "make-nxycos",
+ "make-nxysin", "make-one-pole", "make-one-pole-all-pass", "make-one-zero", "make-oscil", "make-oscil-bank",
+ "make-phase-vocoder", "make-pink-noise", "make-pixmap", "make-player", "make-polyoid", "make-polyshape",
+ "make-polywave", "make-pulse-train", "make-pulsed-env", "make-r2k!cos", "make-r2k2cos", "make-ramp",
+ "make-rand", "make-rand-interp", "make-rcos", "make-readin", "make-region", "make-region-sampler",
+ "make-rk!cos", "make-rk!ssb", "make-rkcos", "make-rkoddssb", "make-rksin", "make-rkssb",
+ "make-round-interp", "make-rssb", "make-rxycos", "make-rxyk!cos", "make-rxyk!sin", "make-rxysin",
+ "make-sample->file", "make-sampler", "make-sawtooth-wave", "make-selection", "make-sinc-train", "make-snd->sample",
+ "make-sound-box", "make-spencer-filter", "make-square-wave", "make-src", "make-ssb-am", "make-table-lookup",
+ "make-table-lookup-with-env", "make-tanhsin", "make-triangle-wave", "make-two-pole", "make-two-zero", "make-variable-display",
+ "make-variable-graph", "make-vct", "make-wave-train", "make-wave-train-with-env", "map-channel", "map-sound-files",
+ "maracas", "mark->integer", "mark-click-hook", "mark-click-info", "mark-color", "mark-context",
"mark-drag-hook", "mark-explode", "mark-home", "mark-hook", "mark-loops", "mark-name",
- "mark-name->id", "mark-properties", "mark-property", "mark-sample", "mark-sync", "mark-sync-max",
- "mark-tag-height", "mark-tag-width", "mark?", "marks", "match-sound-files", "max-envelope",
- "max-regions", "max-transform-peaks", "max-virtual-ptrees", "maxamp", "maxamp-position", "menu-widgets",
- "menus, optional", "min-dB", "minibuffer-history-length", "mix", "mix->integer", "mix->vct",
- "mix-amp", "mix-amp-env", "mix-channel", "mix-click-hook", "mix-color", "mix-dialog-mix",
- "mix-drag-hook", "mix-file-dialog", "mix-frame", "mix-home", "mix-length", "mix-maxamp",
- "mix-move-sound", "mix-name", "mix-name->id", "mix-position", "mix-properties", "mix-property",
- "mix-region", "mix-release-hook", "mix-sampler?", "mix-selection", "mix-sound", "mix-sound-data",
- "mix-speed", "mix-sync", "mix-sync-max", "mix-tag-height", "mix-tag-width", "mix-tag-y",
- "mix-vct", "mix-waveform-height", "mix?", "mixer", "mixer as matrix", "mixer*",
- "mixer+", "mixer-copy", "mixer-determinant", "mixer-inverse", "mixer-poly", "mixer-ref",
- "mixer-set!", "mixer-solve", "mixer-transpose", "mixer?", "mixes", "mono->stereo",
- "moog-filter", "mouse-click-hook", "mouse-drag-hook", "mouse-enter-graph-hook", "mouse-enter-label-hook", "mouse-enter-listener-hook",
- "mouse-enter-text-hook", "mouse-leave-graph-hook", "mouse-leave-label-hook", "mouse-leave-listener-hook", "mouse-leave-text-hook", "mouse-press-hook",
- "move-locsig", "move-mixes", "move-sound", "move-sound?", "moving-autocorrelation", "moving-autocorrelation?",
- "moving-average", "moving-average?", "moving-fft", "moving-fft?", "moving-length", "moving-max",
- "moving-pitch", "moving-pitch?", "moving-rms", "moving-scentroid", "moving-scentroid?", "moving-spectrum",
- "moving-spectrum?", "moving-sum", "mpg", "multiply-arrays", "mus-alsa-buffer-size", "mus-alsa-buffers",
- "mus-alsa-capture-device", "mus-alsa-device", "mus-alsa-playback-device", "mus-alsa-squelch-warning", "mus-array-print-length", "mus-audio-close",
- "mus-audio-describe", "mus-audio-open-input", "mus-audio-open-output", "mus-audio-read", "mus-audio-write", "mus-bytes-per-sample",
- "mus-channel", "mus-channels", "mus-chebyshev-tu-sum", "mus-clipping", "mus-close", "mus-data",
- "mus-data-format->string", "mus-data-format-name", "mus-describe", "mus-error-hook", "mus-error-type->string", "mus-expand-filename",
- "mus-feedback", "mus-feedforward", "mus-fft", "mus-file-buffer-size", "mus-file-clipping", "mus-file-name",
- "mus-file-prescaler", "mus-float-equal-fudge-factor", "mus-frequency", "mus-generator?", "mus-header-raw-defaults", "mus-header-type->string",
+ "mark-name->id", "mark-properties", "mark-property", "mark-sample", "mark-sync", "mark-sync-color",
+ "mark-sync-max", "mark-tag-height", "mark-tag-width", "mark?", "marks", "match-sound-files",
+ "max-envelope", "max-regions", "max-transform-peaks", "maxamp", "maxamp-position", "menu-widgets",
+ "menus, optional", "min-dB", "mix", "mix->float-vector", "mix->integer", "mix-amp",
+ "mix-amp-env", "mix-channel", "mix-click-hook", "mix-click-info", "mix-click-sets-amp", "mix-color",
+ "mix-dialog-mix", "mix-drag-hook", "mix-file-dialog", "mix-home", "mix-length", "mix-maxamp",
+ "mix-name", "mix-name->id", "mix-position", "mix-properties", "mix-property", "mix-region",
+ "mix-release-hook", "mix-sampler?", "mix-selection", "mix-sound", "mix-speed", "mix-sync",
+ "mix-sync-max", "mix-tag-height", "mix-tag-width", "mix-tag-y", "mix-vct", "mix-waveform-height",
+ "mix?", "mixes", "mono->stereo", "moog-filter", "morally-equal?", "mouse-click-hook",
+ "mouse-drag-hook", "mouse-enter-graph-hook", "mouse-enter-label-hook", "mouse-enter-listener-hook", "mouse-enter-text-hook", "mouse-leave-graph-hook",
+ "mouse-leave-label-hook", "mouse-leave-listener-hook", "mouse-leave-text-hook", "mouse-press-hook", "move-locsig", "move-mixes",
+ "move-sound", "move-sound?", "move-syncd-marks", "moving-autocorrelation", "moving-autocorrelation?", "moving-average",
+ "moving-average?", "moving-fft", "moving-fft?", "moving-length", "moving-max", "moving-max?",
+ "moving-norm", "moving-norm?", "moving-pitch", "moving-pitch?", "moving-rms", "moving-scentroid",
+ "moving-scentroid?", "moving-spectrum", "moving-spectrum?", "moving-sum", "mpg", "mus-alsa-buffer-size",
+ "mus-alsa-buffers", "mus-alsa-capture-device", "mus-alsa-device", "mus-alsa-playback-device", "mus-alsa-squelch-warning", "mus-array-print-length",
+ "mus-bytes-per-sample", "mus-channel", "mus-channels", "mus-chebyshev-tu-sum", "mus-clipping", "mus-close",
+ "mus-copy", "mus-data", "mus-describe", "mus-error-hook", "mus-error-type->string", "mus-expand-filename",
+ "mus-feedback", "mus-feedforward", "mus-fft", "mus-file-buffer-size", "mus-file-clipping", "mus-file-mix",
+ "mus-file-name", "mus-float-equal-fudge-factor", "mus-frequency", "mus-generator?", "mus-header-raw-defaults", "mus-header-type->string",
"mus-header-type-name", "mus-hop", "mus-increment", "mus-input?", "mus-interp-type", "mus-interpolate",
- "mus-length", "mus-location", "mus-max-malloc", "mus-max-table-size", "mus-mix", "mus-name",
- "mus-offset", "mus-order", "mus-oss-set-buffers", "mus-out-format", "mus-output?", "mus-phase",
- "mus-prescaler", "mus-ramp", "mus-random", "mus-reset", "mus-run", "mus-safety",
- "mus-scaler", "mus-sound-chans", "mus-sound-close-input", "mus-sound-close-output", "mus-sound-comment", "mus-sound-data-format",
- "mus-sound-data-location", "mus-sound-datum-size", "mus-sound-duration", "mus-sound-forget", "mus-sound-frames", "mus-sound-header-type",
- "mus-sound-length", "mus-sound-loop-info", "mus-sound-mark-info", "mus-sound-maxamp", "mus-sound-maxamp-exists?", "mus-sound-open-input",
- "mus-sound-open-output", "mus-sound-prune", "mus-sound-read", "mus-sound-reopen-output", "mus-sound-report-cache", "mus-sound-samples",
- "mus-sound-seek-frame", "mus-sound-srate", "mus-sound-type-specifier", "mus-sound-write", "mus-sound-write-date", "mus-srate",
- "mus-width", "mus-xcoeff", "mus-xcoeffs", "mus-ycoeff", "mus-ycoeffs", "name-click-hook",
- "ncos", "ncos?", "new-sound", "new-sound-dialog", "new-sound-hook", "new-widget-hook",
- "next-frame", "next-sample", "noid", "normalize-channel", "normalize-envelope", "normalize-partials",
- "normalize-sound", "normalized-mix", "notch", "notch-channel", "notch-out-rumble-and-hiss", "notch-selection",
- "notch-sound", "notch?", "nrev", "nrxycos", "nrxycos?", "nrxysin",
- "nrxysin?", "nsin", "nsin?", "offset-channel", "offset-sound", "one-pole",
- "one-pole?", "one-zero", "one-zero?", "open-file-dialog", "open-file-dialog-directory", "open-hook",
- "open-next-file-in-directory", "open-raw-sound", "open-raw-sound-hook", "open-sound", "optimization", "optimization-hook",
- "orientation-hook", "oscil", "oscil?", "oscilloscope dialog", "out-any", "outa",
- "*output*", "output-comment-hook", "output-name-hook", "overlay-rms-env", "pad-channel", "pad-marks",
- "pad-sound", "pan-mix", "pan-mix-vct", "partials->polynomial", "partials->wave", "pausing",
- "peak-env-dir", "peak-env-hook", "peaks", "peaks-font", "phase-partials->wave", "phase-vocoder",
- "phase-vocoder?", "piano model", "pink-noise", "place-sound", "play", "play-arrow-size",
- "play-between-marks", "play-hook", "play-mixes", "play-sines", "play-syncd-marks", "player-home",
+ "mus-length", "mus-location", "mus-max-malloc", "mus-max-table-size", "mus-name", "mus-offset",
+ "mus-order", "mus-oss-set-buffers", "mus-output?", "mus-phase", "mus-ramp", "mus-rand-seed",
+ "mus-random", "mus-reset", "mus-run", "mus-sample-type->string", "mus-sample-type-name", "mus-scaler",
+ "mus-sound-chans", "mus-sound-close-input", "mus-sound-close-output", "mus-sound-comment", "mus-sound-data-location", "mus-sound-datum-size",
+ "mus-sound-duration", "mus-sound-forget", "mus-sound-framples", "mus-sound-header-type", "mus-sound-length", "mus-sound-loop-info",
+ "mus-sound-mark-info", "mus-sound-maxamp", "mus-sound-maxamp-exists?", "mus-sound-open-input", "mus-sound-open-output", "mus-sound-path",
+ "mus-sound-preload", "mus-sound-prune", "mus-sound-read", "mus-sound-reopen-output", "mus-sound-report-cache", "mus-sound-sample-type",
+ "mus-sound-samples", "mus-sound-seek-frample", "mus-sound-srate", "mus-sound-type-specifier", "mus-sound-write", "mus-sound-write-date",
+ "mus-srate", "mus-width", "mus-xcoeff", "mus-xcoeffs", "mus-ycoeff", "mus-ycoeffs",
+ "n1cos", "n1cos?", "name-click-hook", "nchoosekcos", "nchoosekcos?", "ncos",
+ "ncos2?", "ncos4?", "ncos?", "new-sound", "new-sound-dialog", "new-sound-hook",
+ "new-widget-hook", "next-sample", "nkssb", "nkssb-interp", "nkssb?", "noddcos",
+ "noddcos?", "noddsin", "noddsin?", "noddssb", "noddssb?", "noid",
+ "normalize-channel", "normalize-envelope", "normalize-partials", "normalize-sound", "normalized-mix", "notch",
+ "notch-channel", "notch-selection", "notch-sound", "notch?", "npcos?", "nrcos",
+ "nrcos?", "nrev", "nrsin", "nrsin?", "nrssb", "nrssb-interp",
+ "nrssb?", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin",
+ "nsin?", "nsincos", "nsincos?", "nssb", "nssb?", "nxy1cos",
+ "nxy1cos?", "nxy1sin", "nxy1sin?", "nxycos", "nxycos?", "nxysin",
+ "nxysin?", "object->string", "odd-multiple", "odd-weight", "offset-channel", "offset-sound",
+ "one-pole", "one-pole-all-pass", "one-pole-all-pass?", "one-pole?", "one-zero", "one-zero?",
+ "open-file-dialog", "open-file-dialog-directory", "open-hook", "open-next-file-in-directory", "open-raw-sound", "open-raw-sound-hook",
+ "open-sound", "openlet", "openlet?", "orientation-hook", "oscil", "oscil-bank",
+ "oscil-bank?", "oscil?", "out-any", "out-bank", "outa", "outlet",
+ "*output*", "output-comment-hook", "overlay-rms-env", "owlet", "pad-channel", "pad-marks",
+ "pad-sound", "pan-mix", "pan-mix-float-vector", "partials->polynomial", "partials->wave", "pausing",
+ "peak-env-dir", "peaks", "peaks-font", "phase-partials->wave", "phase-vocoder", "phase-vocoder?",
+ "piano model", "pink-noise", "pink-noise?", "pins", "place-sound", "play",
+ "play-arrow-size", "play-between-marks", "play-hook", "play-mixes", "play-often", "play-region-forever",
+ "play-sine", "play-sines", "play-syncd-marks", "play-until-c-g", "play-with-envs", "player-home",
"player?", "players", "playing", "pluck", "polar->rectangular", "polynomial",
"polynomial operations", "polyoid", "polyoid-env", "polyoid?", "polyshape", "polyshape?",
"polywave", "polywave?", "position->x", "position->y", "position-color", "power-env",
- "preferences-dialog", "previous-frame", "previous-sample", "print-dialog", "print-hook", "print-length",
- "procedure-source", "procedure-with-setter", "profile", "progress-report", "prompt-in-minibuffer", "ptree-channel",
- "pulse-train", "pulse-train?", "radians->degrees", "radians->hz", "ramp-channel", "rand",
- "rand-interp", "rand-interp?", "rand?", "random", "read-frame", "read-hook",
- "read-mix-sample", "read-only", "read-region-sample", "read-sample", "readin", "readin?",
- "recorder-dialog", "rectangular->magnitudes", "rectangular->polar", "redo", "redo-channel", "redo-edit",
- "region->frame", "region->integer", "region->sound-data", "region->vct", "region-chans", "region-frames",
+ "pqw", "pqw-vox", "preferences-dialog", "previous-sample", "print-dialog", "print-length",
+ "procedure-documentation", "procedure-setter", "procedure-signature", "procedure-source", "profile", "progress-report",
+ "pulse-train", "pulse-train?", "pulsed-env", "pulsed-env?", "r2k!cos", "r2k!cos?",
+ "r2k2cos", "r2k2cos?", "radians->degrees", "radians->hz", "ramp-channel", "rand",
+ "rand-interp", "rand-interp?", "rand?", "random", "random-state", "random-state?",
+ "rcos", "rcos?", "read-hook", "read-mix-sample", "read-only", "read-region-sample",
+ "read-sample", "read-sample-with-direction", "reader-cond", "readin", "readin?", "rectangular->magnitudes",
+ "rectangular->polar", "redo", "region->integer", "region->vct", "region-chans", "region-framples",
"region-graph-style", "region-home", "region-maxamp", "region-maxamp-position", "region-play-list", "region-position",
- "region-sample", "region-sampler?", "region-srate", "region?", "regions", "release-lock",
- "remember-sound-state", "remove-from-menu", "report-in-minibuffer", "reset-all-hooks", "reset-controls", "reset-listener-cursor",
- "restore-controls", "*reverb*", "reverb-control-decay", "reverb-control-feedback", "reverb-control-length", "reverb-control-length-bounds",
- "reverb-control-lowpass", "reverb-control-scale", "reverb-control-scale-bounds", "reverb-control?", "reverse-channel", "reverse-channels",
- "reverse-envelope", "reverse-selection", "reverse-sound", "revert-sound", "right-sample", "ring-modulate",
- "rms", "rms, gain, balance gens", "rms-envelope", "rotate-channel", "rubber-sound", "run",
- "sample", "sample->file", "sample->file?", "sample->frame", "sampler-at-end?", "sampler-home",
- "sampler-position", "sampler?", "samples", "samples->seconds", "sash-color", "save-as-dialog-auto-comment",
- "save-as-dialog-src", "save-controls", "save-dir", "save-edit-history", "save-envelopes", "save-hook",
- "save-listener", "save-macros", "save-mark-properties", "save-marks", "save-mix", "save-mixes",
- "save-region", "save-region-dialog", "save-selection", "save-selection-dialog", "save-sound", "save-sound-as",
- "save-sound-dialog", "save-state", "save-state-file", "save-state-hook", "savitzky-golay-filter", "sawtooth-wave",
- "sawtooth-wave?", "scale-by", "scale-channel", "scale-envelope", "scale-mixes", "scale-selection-by",
- "scale-selection-to", "scale-sound", "scale-tempo", "scale-to", "scan-channel", "scan-sound",
- "scanned synthesis", "scentroid", "script-arg", "script-args", "search-procedure", "seconds->samples",
- "select-all", "select-channel", "select-channel-hook", "select-sound", "select-sound-hook", "selected-channel",
- "selected-data-color", "selected-graph-color", "selected-sound", "selection", "selection->mix", "selection->sound-data",
- "selection-chans", "selection-color", "selection-creates-region", "selection-frames", "selection-maxamp", "selection-maxamp-position",
- "selection-member?", "selection-members", "selection-position", "selection-srate", "selection?", "set-samples",
- "shepard-tone", "short-file-name", "show-axes", "show-controls", "show-disk-space", "show-full-duration",
- "show-grid", "show-indices", "show-listener", "show-marks", "show-mix-waveforms", "show-selection",
- "show-selection-transform", "show-sonogram-cursor", "show-transform-peaks", "show-widget", "show-y-zero", "silence-all-mixes",
- "silence-mixes", "sinc-train", "sinc-width", "sine-env-channel", "sine-ramp", "singer",
- "smooth-channel", "smooth-selection", "smooth-sound", "SMS synthesis", "snap-mark-to-beat", "snap-mix-to-beat",
- "snd->sample", "snd->sample?", "snd-color", "snd-error", "snd-error-hook", "snd-font",
- "snd-gcs", "snd-help", "snd-hooks", "*snd-opened-sound*", "snd-print", "snd-spectrum",
- "snd-tempnam", "snd-url", "snd-urls", "snd-version", "snd-warning", "snd-warning-hook",
- "sndwarp", "sound->amp-env", "sound->frame", "sound->integer", "sound->sound-data", "sound-data*",
- "sound-data+", "sound-data->file", "sound-data->frame", "sound-data->sound", "sound-data->sound-data", "sound-data->vct",
- "sound-data-add!", "sound-data-chans", "sound-data-copy", "sound-data-fill!", "sound-data-length", "sound-data-maxamp",
- "sound-data-multiply!", "sound-data-offset!", "sound-data-peak", "sound-data-ref", "sound-data-reverse!", "sound-data-scale!",
- "sound-data-set!", "sound-data?", "sound-file-extensions", "sound-file?", "sound-files-in-directory", "sound-interp",
- "sound-let", "sound-loop-info", "sound-properties", "sound-property", "sound-widgets", "sound?",
- "soundfont-info", "sounds", "spectral interpolation", "spectral-polynomial", "spectro-hop", "spectro-x-angle",
- "spectro-x-scale", "spectro-y-angle", "spectro-y-scale", "spectro-z-angle", "spectro-z-scale", "spectrum",
- "spectrum->coeffs", "spectrum-end", "spectrum-start", "speed-control", "speed-control-bounds", "speed-control-style",
- "speed-control-tones", "square-wave", "square-wave?", "squelch-update", "squelch-vowels", "srate",
- "src", "src-channel", "src-duration", "src-mixes", "src-selection", "src-sound",
+ "region-rms", "region-sample", "region-sampler?", "region-srate", "region?", "regions",
+ "remember-sound-state", "remove-clicks", "remove-from-menu", "replace-with-selection", "report-mark-names", "require",
+ "reset-all-hooks", "reset-controls", "reset-listener-cursor", "reson", "restore-controls", "*reverb*",
+ "reverb-control-decay", "reverb-control-feedback", "reverb-control-length", "reverb-control-length-bounds", "reverb-control-lowpass", "reverb-control-scale",
+ "reverb-control-scale-bounds", "reverb-control?", "reverse!", "reverse-by-blocks", "reverse-channel", "reverse-envelope",
+ "reverse-selection", "reverse-sound", "revert-sound", "right-sample", "ring-modulate", "rk!cos",
+ "rk!cos?", "rk!ssb", "rk!ssb?", "rkcos", "rkcos?", "rkoddssb",
+ "rkoddssb?", "rksin", "rksin?", "rkssb", "rkssb?", "rms",
+ "rms, gain, balance gens", "rms-envelope", "rootlet", "round-interp", "round-interp?", "rssb",
+ "rssb-interp", "rssb?", "rubber-sound", "rxycos", "rxycos?", "rxyk!cos",
+ "rxyk!cos?", "rxyk!sin", "rxyk!sin?", "rxysin", "rxysin?", "sample",
+ "sample->file", "sample->file?", "sample-type", "sampler-at-end?", "sampler-home", "sampler-position",
+ "sampler?", "samples", "samples->seconds", "sash-color", "save-as-dialog-auto-comment", "save-as-dialog-src",
+ "save-controls", "save-dir", "save-edit-history", "save-envelopes", "save-hook", "save-listener",
+ "save-mark-properties", "save-marks", "save-mix", "save-region", "save-region-dialog", "save-selection",
+ "save-selection-dialog", "save-sound", "save-sound-as", "save-sound-dialog", "save-state", "save-state-file",
+ "save-state-hook", "savitzky-golay-filter", "sawtooth-wave", "sawtooth-wave?", "scale-by", "scale-channel",
+ "scale-envelope", "scale-mixes", "scale-selection-by", "scale-selection-to", "scale-sound", "scale-tempo",
+ "scale-to", "scan-channel", "scanned synthesis", "scentroid", "scratch", "script-arg",
+ "script-args", "search-for-click", "search-procedure", "seconds->samples", "select-all", "select-channel",
+ "select-channel-hook", "select-sound", "select-sound-hook", "selected-channel", "selected-data-color", "selected-graph-color",
+ "selected-sound", "selection", "selection->mix", "selection-chans", "selection-color", "selection-context",
+ "selection-creates-region", "selection-framples", "selection-maxamp", "selection-maxamp-position", "selection-member?", "selection-members",
+ "selection-position", "selection-rms", "selection-srate", "selection?", "set-samples", "short-file-name",
+ "show-axes", "show-controls", "show-disk-space", "show-full-duration", "show-full-range", "show-grid",
+ "show-indices", "show-listener", "show-marks", "show-mix-waveforms", "show-selection", "show-selection-transform",
+ "show-sonogram-cursor", "show-transform-peaks", "show-widget", "show-y-zero", "silence-all-mixes", "silence-mixes",
+ "sinc-train", "sinc-train?", "sinc-width", "sine-env-channel", "sine-ramp", "singer",
+ "smooth-channel", "smooth-selection", "smooth-sound", "SMS synthesis", "snap-mark-to-beat", "snap-marks",
+ "snap-mix-to-beat", "snd->sample", "snd->sample?", "snd-color", "snd-error", "snd-error-hook",
+ "snd-font", "snd-gcs", "snd-help", "snd-hooks", "*snd-opened-sound*", "snd-print",
+ "snd-spectrum", "snd-tempnam", "snd-url", "snd-urls", "snd-version", "snd-warning",
+ "snd-warning-hook", "sndwarp", "sort!", "sound->amp-env", "sound->integer", "sound-file-extensions",
+ "sound-file?", "sound-files-in-directory", "sound-interp", "sound-loop-info", "sound-properties", "sound-property",
+ "sound-widgets", "sound?", "soundfont-info", "sounds", "sounds->segment-data", "spectra",
+ "spectral interpolation", "spectral-polynomial", "spectro-hop", "spectro-x-angle", "spectro-x-scale", "spectro-y-angle",
+ "spectro-y-scale", "spectro-z-angle", "spectro-z-scale", "spectrum", "spectrum->coeffs", "spectrum-end",
+ "spectrum-start", "speed-control", "speed-control-bounds", "speed-control-style", "speed-control-tones", "spot-freq",
+ "square-wave", "square-wave?", "squelch-update", "squelch-vowels", "srate", "src",
+ "src-channel", "src-duration", "src-fit-envelope", "src-mixes", "src-selection", "src-sound",
"src?", "ssb-am", "ssb-am?", "ssb-bank", "ssb-bank-env", "ssb-fm",
- "stacktrace", "start-hook", "start-playing", "start-playing-hook", "start-playing-selection-hook", "start-progress-report",
- "start-waterfall", "stereo->mono", "stop-dac-hook", "stop-player", "stop-playing", "stop-playing-hook",
- "stop-playing-selection-hook", "stretch-envelope", "superimpose-ffts", "swap-channels", "swap-selection-channels", "symbol-access",
- "sync", "sync-everything", "sync-max", "sync-style", "syncd-marks", "table-lookup",
- "table-lookup?", "tap", "telephone", "temp-dir", "text-focus-color", "time-graph-style",
- "time-graph-type", "time-graph?", "tiny-font", "trace", "*trace-hook*", "tracking-cursor-style",
- "transform->integer", "transform->vct", "transform-dialog", "transform-frames", "transform-graph-style", "transform-graph-type",
- "transform-graph?", "transform-normalization", "transform-sample", "transform-size", "transform-type", "transform?",
- "transpose-mixes", "trap-segfault", "triangle-wave", "triangle-wave?", "tubular bell", "two-pole",
- "two-pole?", "two-zero", "two-zero?", "unbind-key", "*unbound-variable-hook*", "unclip-channel",
- "undo", "undo-channel", "undo-edit", "undo-hook", "unselect-all", "update-graphs",
- "update-hook", "update-lisp-graph", "update-sound", "update-time-graph", "update-transform-graph", "user interface extensions",
- "variable-display", "variable-graph?", "vct", "vct*", "vct+", "vct->channel",
- "vct->file", "vct->frame", "vct->list", "vct->sound-data", "vct->string", "vct->vector",
- "vct-add!", "vct-copy", "vct-fill!", "vct-length", "vct-map!", "vct-move!",
- "vct-multiply!", "vct-offset!", "vct-peak", "vct-polynomial", "vct-ref", "vct-reverse!",
+ "start-dac", "start-playing", "start-playing-hook", "start-playing-selection-hook", "start-progress-report", "status-report",
+ "stereo->mono", "stereo-flute", "stop-player", "stop-playing", "stop-playing-hook", "stop-playing-selection-hook",
+ "stretch-envelope", "stretch-sound-via-dft", "string-position", "sublet", "superimpose-ffts", "swap-channels",
+ "swap-selection-channels", "symbol->dynamic-value", "symbol->value", "symbol-access", "symbol-table", "sync",
+ "sync-everything", "sync-max", "sync-style", "syncd-marks", "syncd-mixes", "syncup",
+ "table-lookup", "table-lookup?", "tanhsin", "tanhsin?", "tap", "tap?",
+ "telephone", "temp-dir", "text-focus-color", "time-graph-style", "time-graph-type", "time-graph?",
+ "times->samples", "tiny-font", "touch-tone", "trace", "tracking-cursor-style", "transform->integer",
+ "transform->vct", "transform-dialog", "transform-framples", "transform-graph-style", "transform-graph-type", "transform-graph?",
+ "transform-normalization", "transform-sample", "transform-size", "transform-type", "transform?", "transpose-mixes",
+ "triangle-wave", "triangle-wave?", "tubebell", "tubular bell", "two-pole", "two-pole?",
+ "two-tab", "two-zero", "two-zero?", "unbind-key", "*unbound-variable-hook*", "unclip-channel",
+ "undo", "undo-hook", "unlet", "unselect-all", "update-graphs", "update-hook",
+ "update-lisp-graph", "update-sound", "update-time-graph", "update-transform-graph", "upon-save-yourself", "user interface extensions",
+ "variable-display", "variable-graph?", "varlet", "vct", "vct*", "vct+",
+ "vct->channel", "vct->list", "vct->string", "vct->vector", "vct-abs!", "vct-add!",
+ "vct-copy", "vct-equal?", "vct-fill!", "vct-length", "vct-max", "vct-min",
+ "vct-move!", "vct-multiply!", "vct-offset!", "vct-peak", "vct-ref", "vct-reverse!",
"vct-scale!", "vct-set!", "vct-subseq", "vct-subtract!", "vct?", "vector->vct",
- "*vector-print-length*", "view-files-amp", "view-files-amp-env", "view-files-dialog", "view-files-files", "view-files-select-hook",
- "view-files-selected-files", "view-files-sort", "view-files-speed", "view-files-speed-style", "view-mixes-dialog", "view-regions-dialog",
- "view-sound", "voice physical model", "voiced->unvoiced", "volterra-filter", "wave-train", "wave-train?",
+ "view-files-amp", "view-files-amp-env", "view-files-dialog", "view-files-files", "view-files-select-hook", "view-files-selected-files",
+ "view-files-sort", "view-files-speed", "view-files-speed-style", "view-mixes-dialog", "view-regions-dialog", "view-sound",
+ "voice physical model", "voiced->unvoiced", "volterra-filter", "vox", "wave-train", "wave-train?",
"wavelet-type", "waveshaping voice", "wavo-hop", "wavo-trace", "weighted-moving-average", "widget-position",
"widget-size", "widget-text", "window-height", "window-samples", "window-width", "window-x",
- "window-y", "with-background-processes", "with-environment", "with-file-monitor", "with-gl", "with-inset-graph",
- "with-local-hook", "with-marked-sound", "with-menu-icons", "with-mix-tags", "with-mixed-sound", "with-mixed-sound->notelist",
- "with-pointer-focus", "with-relative-panes", "with-smpte-label", "with-sound", "with-temp-sound", "with-temporary-selection",
- "with-threaded-channels", "with-threaded-sound", "with-toolbar", "with-tooltips", "with-tracking-cursor", "with-verbose-cursor",
- "x->position", "x-axis-label", "x-axis-style", "x-bounds", "x-position-slider", "x-zoom-slider",
- "xramp-channel", "y->position", "y-axis-label", "y-bounds", "y-position-slider", "y-zoom-slider",
- "z-transform", "zero-pad", "zip-sound", "zipper", "zoom-color", "zoom-focus-style"};
+ "window-y", "with-background-processes", "with-baffle", "with-file-monitor", "with-gl", "with-inset-graph",
+ "with-interrupts", "with-let", "with-local-hook", "with-menu-icons", "with-mix-tags", "with-pointer-focus",
+ "with-relative-panes", "with-smpte-label", "with-sound", "with-temporary-selection", "with-toolbar", "with-tooltips",
+ "with-tracking-cursor", "with-verbose-cursor", "x->position", "x-axis-label", "x-axis-style", "x-bounds",
+ "x-position-slider", "x-zoom-slider", "xb-open", "xramp-channel", "y->position", "y-axis-label",
+ "y-bounds", "y-position-slider", "y-zoom-slider", "z-transform", "zecho", "zero+",
+ "zero-pad", "zero-phase", "zip-sound", "zipper", "zoom-color", "zoom-focus-style"};
#endif
#if HAVE_RUBY
static const char *help_names[HELP_NAMES_SIZE] = {
- "*#readers*", "abort", "add_amp_controls", "add_colormap", "add_comment", "add_directory_to_view_files_list",
- "add_file_filter", "add_file_sorter", "add_file_to_view_files_list", "add_mark", "add_mark_pane", "add_player",
- "add_sound_file_extension", "add_source_file_extension", "add_to_main_menu", "add_to_menu", "add_tooltip", "add_transform",
- "additive_synthesis", "after_apply_controls_hook", "after_edit_hook", "after_graph_hook", "after_lisp_graph_hook", "after_open_hook",
- "after_save_as_hook", "after_save_state_hook", "after_transform_hook", "all_pass", "all_pass?", "amp_control",
- "amp_control_bounds", "amplitude_modulate", "analyse_ladspa", "any_env_channel", "append_sound", "apply_controls",
- "apply_ladspa", "array2file", "array_interp", "as_one_edit", "ask_about_unsaved_edits", "ask_before_overwrite",
- "asymmetric_fm", "asymmetric_fm?", "audio_input_device", "audio_output_device", "augment_environment", "auto_resize",
- "auto_save", "auto_update", "auto_update_interval", "autocorrelate", "axis_color", "axis_info",
- "axis_label_font", "axis_numbers_font", "background_gradient", "bad_header_hook", "bagpipe", "basic_color",
- "beats_per_measure", "beats_per_minute", "before_close_hook", "before_exit_hook", "before_save_as_hook", "before_save_state_hook",
- "before_transform_hook", "bessel_filters", "bigbird", "bignum", "bignum_precision", "bignum?",
- "binary_files", "bind_key", "bird", "bold_peaks_font", "bomb", "break",
- "brown_noise", "butterworth_filters", "c_g?", "call_with_exit", "call_in", "cascade2canonical",
- "catch", "chain_dsps", "channel2vct", "channel_amp_envs", "channel_data", "channel_envelope",
- "channel_polynomial", "channel_properties", "channel_property", "channel_rms", "channel_style", "channel_sync",
- "channel_widgets", "channels", "channels_equal?", "Channels_separate", "channels_?", "chans",
- "chebyshev_filters", "check_mix_tags", "clean_channel", "clean_sound", "clear_array", "clear_listener",
- "clear_minibuffer", "clip_hook", "clipping", "clm_channel", "clm_load", "clone_sound_as",
- "close_hook", "close_sound", "color2list", "color_cutoff", "color_hook", "color_inverted",
- "color_mixes", "color_orientation_dialog", "color_scale", "color?", "colormap", "colormap2integer",
- "colormap_name", "colormap_ref", "colormap_size", "colormap?", "comb", "comb?",
- "combined_data_color", "comment", "compand_channel", "compand_sound", "concatenate_envelopes", "constant?",
- "continue_frame2file", "continue_sample2file", "contrast_channel", "contrast_control", "contrast_control_amp", "contrast_control_bounds",
- "contrast_control?", "contrast_enhancement", "contrast_sound", "controls2channel", "convolution", "convolution_reverb",
- "convolve", "convolve_files", "convolve_selection_with", "convolve_with", "convolve?", "copy_frame_reader",
- "copy_sampler", "correlate", "count_matches", "create_ssb_dialog", "cross_fade__amplitude_", "cross_fade__frequency_domain_",
- "cross_synthesis", "Current_edit_position", "current_environment", "current_font", "cursor", "cursor_color",
- "cursor_follows_play", "Cursor_in_view", "cursor_location_offset", "cursor_position", "cursor_size", "cursor_style",
- "cursor_update_interval", "dac_combines_channels", "dac_hook", "dac_size", "data_color", "data_format",
- "data_location", "data_size", "db2linear", "default_output_chans", "default_output_data_format", "default_output_header_type",
- "default_output_srate", "defgenerator", "define_", "define_constant", "define_envelope", "define_macro",
- "define_macro_", "define_selection_via_marks", "definstrument", "defvar", "degrees2radians", "delay",
+ "*#readers*", "2byte_vector", "abcos", "abcos?", "abort", "absin",
+ "absin?", "add_amp_controls", "add_colormap", "add_delete_option", "add_directory_to_view_files_list", "add_file_filter",
+ "add_file_sorter", "add_file_to_view_files_list", "add_mark", "add_mark_pane", "add_player", "add_sound_file_extension",
+ "add_source_file_extension", "add_to_main_menu", "add_to_menu", "add_tooltip", "add_transform", "additive_synthesis",
+ "adjustable_sawtooth_wave", "adjustable_sawtooth_wave?", "adjustable_square_wave", "adjustable_square_wave?", "adjustable_triangle_wave", "adjustable_triangle_wave?",
+ "after_apply_controls_hook", "after_edit_hook", "after_graph_hook", "after_lisp_graph_hook", "after_open_hook", "after_save_as_hook",
+ "after_save_state_hook", "after_transform_hook", "all_chans", "all_pass", "all_pass_bank", "all_pass_bank?",
+ "all_pass?", "amp_control", "amp_control_bounds", "amplitude_modulate", "analyse_ladspa", "anoi",
+ "any_env_channel", "any_random", "apply_controls", "apply_ladspa", "aritable?", "arity",
+ "array2file", "array_interp", "as_one_edit", "ask_about_unsaved_edits", "ask_before_overwrite", "asyfm_I",
+ "asyfm_J", "asyfm?", "asymmetric_fm", "asymmetric_fm?", "auto_resize", "auto_save",
+ "auto_update", "auto_update_interval", "autocorrelate", "axis_color", "axis_info", "axis_label_font",
+ "axis_numbers_font", "background_gradient", "bad_header_hook", "bagpipe", "basic_color", "beats_per_measure",
+ "beats_per_minute", "before_close_hook", "before_exit_hook", "before_save_as_hook", "before_save_state_hook", "before_transform_hook",
+ "bes_j0", "bess", "bess?", "bessel_filters", "bigbird", "bignum",
+ "bignum?", "binary_files", "bind_key", "bird", "blackman", "blackman4_env_channel",
+ "blackman?", "bold_peaks_font", "break", "brown_noise", "brown_noise?", "butterworth_filters",
+ "byte_vector", "byte_vector?", "c_define", "c_g?", "c_object?", "c_pointer",
+ "c_pointer?", "call_with_exit", "canter", "cascade2canonical", "catch", "cellon",
+ "chain_dsps", "channel2vct", "channel_amp_envs", "channel_data", "channel_envelope", "channel_polynomial",
+ "channel_properties", "channel_property", "channel_rms", "channel_style", "channel_sync", "channel_widgets",
+ "channels", "channels_equal?", "channels_?", "chans", "char_position", "cheby_hka",
+ "chebyshev_filters", "check_mix_tags", "chordalize", "chorus", "clean_channel", "clean_sound",
+ "clear_listener", "clip_hook", "clipping", "clm_channel", "clm_expsrc", "close_hook",
+ "close_sound", "color2list", "color_cutoff", "color_hook", "color_inverted", "color_mixes",
+ "color_orientation_dialog", "color_scale", "color?", "colormap", "colormap2integer", "colormap_name",
+ "colormap_ref", "colormap_size", "colormap?", "comb", "comb_bank", "comb_bank?",
+ "comb?", "combined_data_color", "comment", "complexify", "compute_uniform_circular_string", "concatenate_envelopes",
+ "constant?", "continuation?", "continue_frample2file", "continue_sample2file", "contrast_channel", "contrast_control",
+ "contrast_control_amp", "contrast_control_bounds", "contrast_control?", "contrast_enhancement", "contrast_sound", "controls2channel",
+ "convolution", "convolution_reverb", "convolve", "convolve_files", "convolve_selection_with", "convolve_with",
+ "convolve?", "copy", "Copy_context", "copy_sampler", "correlate", "coverlet",
+ "cross_fade__amplitude_", "cross_fade__frequency_domain_", "cross_synthesis", "curlet", "current_font", "cursor",
+ "cursor_color", "Cursor_context", "cursor_location_offset", "cursor_position", "cursor_size", "cursor_style",
+ "cursor_update_interval", "cutlet", "cyclic_sequences", "dac_combines_channels", "dac_size", "data_color",
+ "data_location", "data_size", "db2linear", "default_output_chans", "default_output_header_type", "default_output_sample_type",
+ "default_output_srate", "defgenerator", "define_", "define_constant", "define_envelope", "define_expansion",
+ "define_macro", "define_macro_", "define_selection_via_marks", "defined?", "degrees2radians", "delay",
"delay_channel_mixes", "delay_tick", "delay?", "delete_colormap", "delete_file_filter", "delete_file_sorter",
"delete_mark", "delete_marks", "delete_sample", "delete_samples", "delete_samples_and_smooth", "delete_selection",
- "delete_selection_and_smooth", "delete_transform", "describe_hook", "describe_mark", "dialog_widgets", "disable_control_panel",
- "display_bark_fft", "display_db", "display_edits", "display_scanned_synthesis", "dissolve_fade", "dither_channel",
- "dither_sound", "dlocsig", "dot_product", "dot_size", "draw_axes", "draw_dot",
- "draw_dots", "draw_line", "draw_lines", "draw_mark_hook", "draw_mix_hook", "draw_string",
- "drop_sites", "drop_hook", "during_open_hook", "edit_fragment", "edit_header_dialog", "edit_hook",
- "edit_list2function", "edit_position", "edit_properties", "edit_property", "edit_tree", "edits",
- "edot_product", "effects_hook", "elliptic_filters", "env", "env_any", "env_channel",
- "env_channel_with_base", "env_expt_channel", "env_interp", "env_mixes", "env_selection", "env_sound",
- "env_sound_interp", "env?", "enved_base", "enved_clip?", "enved_dialog", "enved_envelope",
+ "delete_selection_and_smooth", "delete_transform", "describe_hook", "describe_mark", "dht", "dialog_widgets",
+ "dilambda", "disable_control_panel", "display_bark_fft", "display_correlation", "display_db", "display_edits",
+ "display_energy", "dissolve_fade", "dither_channel", "dither_sound", "dolph", "dot_product",
+ "dot_size", "down_oct", "draw_axes", "draw_dot", "draw_dots", "draw_line",
+ "draw_lines", "draw_mark_hook", "draw_mix_hook", "draw_string", "drone", "drop_sites",
+ "drop_hook", "during_open_hook", "edit_fragment", "edit_header_dialog", "edit_hook", "edit_list2function",
+ "edit_position", "edit_properties", "edit_property", "edit_tree", "edits", "edot_product",
+ "effects_hook", "elliptic_filters", "env", "env_any", "env_channel", "env_channel_with_base",
+ "env_expt_channel", "env_interp", "env_mixes", "env_selection", "env_sound", "env_sound_interp",
+ "env_squared_channel", "env?", "enved_base", "enved_clip?", "enved_dialog", "enved_envelope",
"enved_filter", "enved_filter_order", "enved_hook", "enved_in_dB", "enved_power", "enved_style",
- "enved_target", "enved_wave?", "enved_waveform_color", "envelope_interp", "enveloped_mix", "eps_bottom_margin",
- "eps_file", "eps_left_margin", "eps_size", "_error_hook_", "_error_info_", "eval_between_marks",
- "eval_over_selection", "every_sample?", "exit", "exit_hook", "expand_control", "expand_control_bounds",
- "expand_control_hop", "expand_control_jitter", "expand_control_length", "expand_control_ramp", "expand_control?", "explode_sf2",
- "exponentially_weighted_moving_average", "extract_channel", "extract_channels", "_features_", "feedback_fm", "fft",
- "fft_sizes", "fft_edit", "fft_log_frequency", "fft_log_magnitude", "fft_smoother", "fft_squelch",
- "fft_window", "fft_window_alpha", "fft_window_beta", "fft_with_phases", "file_database", "file2array",
- "file2frame", "file2frame?", "file2sample", "file2sample?", "file2sound_data", "file2vct",
- "file_name", "fill_polygon", "fill_rectangle", "filter", "filter_channel", "filter_control_coeffs",
+ "enved_target", "enved_wave?", "enved_waveform_color", "envelope_interp", "enveloped_mix", "eoddcos",
+ "eoddcos?", "eps_bottom_margin", "eps_file", "eps_left_margin", "eps_size", "ercos",
+ "ercos?", "_error_hook_", "erssb", "erssb?", "even_multiple", "even_weight",
+ "every_sample?", "exit", "exit_hook", "expand_control", "expand_control_bounds", "expand_control_hop",
+ "expand_control_jitter", "expand_control_length", "expand_control_ramp", "expand_control?", "explode_sf2", "exponentially_weighted_moving_average",
+ "expsnd", "expsrc", "_features_", "feedback_fm", "fft", "fft_cancel",
+ "fft_edit", "fft_env_edit", "fft_env_interp", "fft_log_frequency", "fft_log_magnitude", "fft_smoother",
+ "fft_squelch", "fft_window", "fft_window_alpha", "fft_window_beta", "fft_with_phases", "file_database",
+ "file2array", "file2frample", "file2frample?", "file2sample", "file2sample?", "file_name",
+ "fill!", "fill_polygon", "fill_rectangle", "filter", "filter_channel", "filter_control_coeffs",
"filter_control_envelope", "filter_control_in_dB", "filter_control_in_hz", "filter_control_order", "filter_control_waveform_color", "filter_control?",
- "filter_selection", "filter_selection_and_smooth", "filter_sound", "filter?", "filtered_comb", "filtered_comb?",
- "find_channel", "find_dialog", "find_mark", "find_mix", "find_sound", "finish_progress_report",
- "fir_filter", "fir_filter?", "firmant", "firmant?", "flocsig", "flocsig?",
- "flute_model", "fm_bell", "fm_drum", "fm_noise", "fm_talker", "fm_trumpet",
- "fm_violin", "fm_voice", "focus_widget", "FOF_synthesis", "for_each_child", "for_each_sound_file",
- "Forbidden_Planet", "foreground_color", "forget_region", "formant", "formant?", "format",
- "Fourier_transform", "fractional_fourier_transform", "frame", "frame_multiply", "frame_add", "frame2file",
- "frame2file?", "frame2frame", "frame2list", "frame2sample", "frame2sound", "frame2sound_data",
- "frame2vct", "frame_copy", "frame_reader_at_end?", "frame_reader_chans", "frame_reader_home", "frame_reader_position",
- "frame_reader?", "frame_ref", "frame_reverse!", "frame_set!", "frame?", "frames",
- "free_frame_reader", "free_player", "free_sampler", "freeverb", "fullmix", "gaussian_distribution",
- "gc_off", "gc_on", "gensym", "gl_graph2ps", "global_environment", "glSpectrogram",
- "goertzel", "goto_listener_end", "grab_lock", "grani", "granulate", "granulate?",
+ "filter_fft", "filter_selection", "filter_selection_and_smooth", "filter_sound", "filter?", "filtered_comb",
+ "filtered_comb_bank", "filtered_comb_bank?", "filtered_comb?", "find_dialog", "find_mark", "find_mix",
+ "find_sound", "finfo", "finish_progress_report", "fir_filter", "fir_filter?", "firmant",
+ "firmant?", "fit_selection_between_marks", "flatten_partials", "float_vector", "float-vector_multiply", "float-vector_add",
+ "float_vector2channel", "float_vector2list", "float_vector2string", "float_vector_abs!", "float_vector_add!", "float_vector_copy",
+ "float_vector_equal?", "float_vector_fill!", "float_vector_length", "float_vector_max", "float_vector_min", "float_vector_move!",
+ "float_vector_multiply!", "float_vector_offset!", "float_vector_peak", "float_vector_polynomial", "float_vector_ref", "float_vector_reverse!",
+ "float_vector_scale!", "float_vector_set!", "float_vector_subseq", "float_vector_subtract!", "float_vector?", "flocsig",
+ "flocsig?", "flute_model", "fm_bell", "fm_drum", "fm_noise", "fm_parallel_component",
+ "fm_talker", "fm_trumpet", "fm_violin", "fm_voice", "fmssb", "fmssb?",
+ "focus_widget", "FOF_synthesis", "fofins", "for_each_child", "for_each_sound_file", "Forbidden_Planet",
+ "foreground_color", "forget_region", "formant", "formant_bank", "formant_bank?", "formant?",
+ "format", "fp", "fractional_fourier_transform", "frample2file", "frample2file?", "frample2frample",
+ "framples", "free_player", "free_sampler", "freeverb", "fullmix", "funclet",
+ "gaussian_distribution", "gc_off", "gc_on", "gensym", "gensym?", "gl_graph2ps",
+ "glSpectrogram", "goertzel", "goto_listener_end", "grani", "granulate", "granulate?",
"granulated_sound_interp", "graph", "graph2ps", "graph_color", "graph_cursor", "graph_data",
- "graph_hook", "Graph_lines", "graph_style", "graphic_equalizer", "graphs_horizontal", "green_noise",
- "green_noise_interp", "grid_density", "harmonicizer", "Hartley_transform", "hash_table", "header_type",
+ "graph_hook", "graph_style", "graphic_equalizer", "graphs_horizontal", "green_noise", "green_noise_interp",
+ "green_noise_interp?", "green_noise?", "grid_density", "harmonicizer", "Hartley_transform", "hash_table",
+ "hash_table_", "hash_table_entries", "hash_table_ref", "hash_table_set!", "hash_table?", "header_type",
"hello_dentist", "help_dialog", "help_hook", "hide_widget", "highlight_color", "hilbert_transform",
- "hook", "hook_arity", "hook_functions", "hook_member", "html_dir", "html_program",
- "hz2radians", "iir_filter", "iir_filter?", "call_in", "in_any", "ina",
- "inb", "info_dialog", "init_ladspa", "initial_beg", "initial_dur", "initial_graph_hook",
- "insert_channel", "insert_file_dialog", "insert_frame", "insert_region", "insert_sample", "insert_samples",
- "insert_selection", "insert_silence", "insert_sound", "insert_sound_data", "insert_vct", "Instruments",
+ "hook_functions", "hook_member", "html", "html_dir", "html_program", "hz2radians",
+ "iir_filter", "iir_filter?", "call_in", "in_any", "ina", "inb",
+ "info_dialog", "init_ladspa", "initial_beg", "initial_dur", "initial_graph_hook", "inlet",
+ "insert_channel", "insert_file_dialog", "insert_region", "insert_sample", "insert_samples", "insert_selection",
+ "insert_silence", "insert_sound", "int_vector", "int_vector_ref", "int_vector_set!", "int_vector?",
"integer2colormap", "integer2mark", "integer2mix", "integer2region", "integer2sound", "integer2transform",
- "integrate_envelope", "jc_reverb", "join_thread", "just_sounds", "kalman_filter_channel", "key",
- "key_binding", "key_press_hook", "ladspa_descriptor", "ladspa_dir", "lambda_", "left_sample",
- "level_meters", "linear2db", "linear_src_channel", "lisp_graph_hook", "lisp_graph_style", "lisp_graph?",
- "list2vct", "list_ladspa", "listener_click_hook", "listener_color", "listener_font", "listener_prompt",
- "listener_selection", "listener_text_color", "little_endian?", "_load_hook_", "_load_path_", "locsig",
- "locsig_ref", "locsig_reverb_ref", "locsig_reverb_set!", "locsig_set!", "locsig_type", "locsig?",
- "log_freq_start", "loop_between_marks", "lpc_coeffs", "lpc_predict", "macro?", "macroexpand",
- "main_menu", "main_widgets", "make_all_pass", "make_asymmetric_fm", "make_bandpass", "make_bandstop",
- "make_biquad", "make_birds", "make_color", "make_comb", "make_convolve", "make_delay",
- "make_differentiator", "make_env", "make_fft_window", "make_file2frame", "make_file2sample", "make_filter",
- "make_filtered_comb", "make_fir_coeffs", "make_fir_filter", "make_firmant", "make_flocsig", "make_formant",
- "make_frame", "make_frame!", "make_frame2file", "make_frame_reader", "make_granulate", "make_graph_data",
- "make_hash_table", "make_highpass", "make_hilbert_transform", "make_hook", "make_iir_filter", "make_lock",
- "make_locsig", "make_lowpass", "make_mix_sampler", "make_mixer", "make_mixer!", "make_move_sound",
- "make_moving_autocorrelation", "make_moving_average", "make_moving_fft", "make_moving_pitch", "make_moving_scentroid", "make_moving_spectrum",
- "make_ncos", "make_noid", "make_notch", "make_nrxycos", "make_nrxysin", "make_nsin",
- "make_one_pole", "make_one_zero", "make_oscil", "make_phase_vocoder", "make_pixmap", "make_player",
- "make_polyoid", "make_polyshape", "make_polywave", "make_pulse_train", "make_rand", "make_rand_interp",
- "make_random_state", "make_readin", "make_region", "make_region_frame_reader", "make_region_sampler", "make_sample2file",
- "make_sampler", "make_sawtooth_wave", "make_scalar_mixer", "make_selection", "make_selection_frame_reader", "make_snd2sample",
- "make_sound_box", "make_sound_data", "make_square_wave", "make_src", "make_ssb_am", "make_sync_frame_reader",
- "make_table_lookup", "make_thread", "make_thread_variable", "make_triangle_wave", "make_two_pole", "make_two_zero",
- "make_type", "make_variable_display", "make_variable_graph", "make_vct", "make_wave_train", "map_channel",
- "map_sound", "map_sound_files", "maracas", "mark2integer", "mark_click_hook", "mark_color",
+ "integrate_envelope", "invert_filter", "iterate", "iterator_at_end?", "iterator_sequence", "iterator?",
+ "izcos", "izcos?", "j0evencos", "j0evencos?", "j0j1cos", "j0j1cos?",
+ "j2cos", "j2cos?", "jc_reverb", "jjcos", "jjcos?", "jncos",
+ "jncos?", "jpcos", "jpcos?", "just_sounds", "jycos", "jycos?",
+ "k2cos", "k2cos?", "k2sin", "k2sin?", "k2ssb", "k2ssb?",
+ "k3sin", "k3sin?", "kalman_filter_channel", "key", "key_binding", "key_press_hook",
+ "krksin", "krksin?", "ladspa_descriptor", "ladspa_dir", "lambda_", "lbj_piano",
+ "left_sample", "let2list", "let_ref", "let_set!", "let?", "linear2db",
+ "linear_src_channel", "lint_for_scheme", "lisp_graph_hook", "lisp_graph_style", "lisp_graph?", "list2float_vector",
+ "list2vct", "list_ladspa", "listener_click_hook", "listener_color", "listener_colorized", "listener_font",
+ "listener_prompt", "listener_selection", "listener_text_color", "little_endian?", "_load_hook_", "_load_path_",
+ "locate_zero", "locsig", "locsig_ref", "locsig_reverb_ref", "locsig_reverb_set!", "locsig_set!",
+ "locsig_type", "locsig?", "log_freq_start", "lpc_coeffs", "lpc_predict", "macro?",
+ "macroexpand", "main_menu", "main_widgets", "make_abcos", "make_absin", "make_adjustable_sawtooth_wave",
+ "make_adjustable_square_wave", "make_adjustable_triangle_wave", "make_all_pass", "make_all_pass_bank", "make_asyfm", "make_asymmetric_fm",
+ "make_bandpass", "make_bandstop", "make_bess", "make_biquad", "make_birds", "make_blackman",
+ "make_brown_noise", "make_byte_vector", "make_channel_drop_site", "make_color", "make_comb", "make_comb_bank",
+ "make_convolve", "make_delay", "make_differentiator", "make_env", "make_eoddcos", "make_ercos",
+ "make_erssb", "make_fft_window", "make_file2frample", "make_file2sample", "make_filter", "make_filtered_comb",
+ "make_filtered_comb_bank", "make_fir_coeffs", "make_fir_filter", "make_firmant", "make_float_vector", "make_flocsig",
+ "make_fmssb", "make_formant", "make_formant_bank", "make_frample2file", "make_granulate", "make_graph_data",
+ "make_green_noise", "make_green_noise_interp", "make_hash_table", "make_highpass", "make_hilbert_transform", "make_hook",
+ "make_iir_filter", "make_int_vector", "make_iterator", "make_izcos", "make_j0evencos", "make_j0j1cos",
+ "make_j2cos", "make_jjcos", "make_jncos", "make_jpcos", "make_jycos", "make_k2cos",
+ "make_k2sin", "make_k2ssb", "make_k3sin", "make_krksin", "make_locsig", "make_lowpass",
+ "make_mix_sampler", "make_move_sound", "make_moving_autocorrelation", "make_moving_average", "make_moving_fft", "make_moving_max",
+ "make_moving_norm", "make_moving_pitch", "make_moving_scentroid", "make_moving_spectrum", "make_n1cos", "make_nchoosekcos",
+ "make_ncos", "make_nkssb", "make_noddcos", "make_noddsin", "make_noddssb", "make_noid",
+ "make_notch", "make_nrcos", "make_nrsin", "make_nrssb", "make_nrxycos", "make_nrxysin",
+ "make_nsin", "make_nsincos", "make_nssb", "make_nxy1cos", "make_nxy1sin", "make_nxycos",
+ "make_nxysin", "make_one_pole", "make_one_pole_all_pass", "make_one_zero", "make_oscil", "make_oscil_bank",
+ "make_phase_vocoder", "make_pink_noise", "make_pixmap", "make_player", "make_polyoid", "make_polyshape",
+ "make_polywave", "make_pulse_train", "make_pulsed_env", "make_r2k!cos", "make_r2k2cos", "make_ramp",
+ "make_rand", "make_rand_interp", "make_rcos", "make_readin", "make_region", "make_region_sampler",
+ "make_rk!cos", "make_rk!ssb", "make_rkcos", "make_rkoddssb", "make_rksin", "make_rkssb",
+ "make_round_interp", "make_rssb", "make_rxycos", "make_rxyk!cos", "make_rxyk!sin", "make_rxysin",
+ "make_sample2file", "make_sampler", "make_sawtooth_wave", "make_selection", "make_sinc_train", "make_snd2sample",
+ "make_sound_box", "make_spencer_filter", "make_square_wave", "make_src", "make_ssb_am", "make_table_lookup",
+ "make_table_lookup_with_env", "make_tanhsin", "make_triangle_wave", "make_two_pole", "make_two_zero", "make_variable_display",
+ "make_variable_graph", "make_vct", "make_wave_train", "make_wave_train_with_env", "map_channel", "map_sound_files",
+ "maracas", "mark2integer", "mark_click_hook", "mark_click_info", "mark_color", "Mark_context",
"mark_drag_hook", "mark_explode", "mark_home", "mark_hook", "mark_loops", "mark_name",
- "mark_name2id", "mark_properties", "mark_property", "mark_sample", "mark_sync", "mark_sync_max",
- "mark_tag_height", "mark_tag_width", "mark?", "marks", "match_sound_files", "max_envelope",
- "max_regions", "max_transform_peaks", "max_virtual_ptrees", "maxamp", "maxamp_position", "menu_widgets",
- "menus__optional", "min_dB", "minibuffer_history_length", "mix", "mix2integer", "mix2vct",
- "mix_amp", "mix_amp_env", "mix_channel", "mix_click_hook", "mix_color", "mix_dialog_mix",
- "mix_drag_hook", "mix_file_dialog", "mix_frame", "mix_home", "mix_length", "mix_maxamp",
- "mix_move_sound", "mix_name", "mix_name2id", "mix_position", "mix_properties", "mix_property",
- "mix_region", "mix_release_hook", "mix_sampler?", "mix_selection", "mix_sound", "mix_sound_data",
- "mix_speed", "mix_sync", "mix_sync_max", "mix_tag_height", "mix_tag_width", "mix_tag_y",
- "mix_vct", "mix_waveform_height", "mix?", "mixer", "mixer_as_matrix", "mixer_multiply",
- "mixer_add", "mixer_copy", "mixer_determinant", "mixer_inverse", "mixer_poly", "mixer_ref",
- "mixer_set!", "mixer_solve", "mixer_transpose", "mixer?", "mixes", "mono2stereo",
- "moog_filter", "mouse_click_hook", "mouse_drag_hook", "mouse_enter_graph_hook", "mouse_enter_label_hook", "mouse_enter_listener_hook",
- "mouse_enter_text_hook", "mouse_leave_graph_hook", "mouse_leave_label_hook", "mouse_leave_listener_hook", "mouse_leave_text_hook", "mouse_press_hook",
- "move_locsig", "move_mixes", "move_sound", "move_sound?", "moving_autocorrelation", "moving_autocorrelation?",
- "moving_average", "moving_average?", "moving_fft", "moving_fft?", "moving_length", "moving_max",
- "moving_pitch", "moving_pitch?", "moving_rms", "moving_scentroid", "moving_scentroid?", "moving_spectrum",
- "moving_spectrum?", "moving_sum", "mpg", "multiply_arrays", "mus_alsa_buffer_size", "mus_alsa_buffers",
- "mus_alsa_capture_device", "mus_alsa_device", "mus_alsa_playback_device", "mus_alsa_squelch_warning", "mus_array_print_length", "mus_audio_close",
- "mus_audio_describe", "mus_audio_open_input", "mus_audio_open_output", "mus_audio_read", "mus_audio_write", "mus_bytes_per_sample",
- "mus_channel", "mus_channels", "mus_chebyshev_tu_sum", "mus_clipping", "mus_close", "mus_data",
- "mus_data_format2string", "mus_data_format_name", "mus_describe", "mus_error_hook", "mus_error_type2string", "mus_expand_filename",
- "mus_feedback", "mus_feedforward", "mus_fft", "mus_file_buffer_size", "mus_file_clipping", "mus_file_name",
- "mus_file_prescaler", "mus_float_equal_fudge_factor", "mus_frequency", "mus_generator?", "mus_header_raw_defaults", "mus_header_type2string",
+ "mark_name2id", "mark_properties", "mark_property", "mark_sample", "mark_sync", "mark_sync_color",
+ "mark_sync_max", "mark_tag_height", "mark_tag_width", "mark?", "marks", "match_sound_files",
+ "max_envelope", "max_regions", "max_transform_peaks", "maxamp", "maxamp_position", "menu_widgets",
+ "menus__optional", "min_dB", "mix", "mix2float_vector", "mix2integer", "mix_amp",
+ "mix_amp_env", "mix_channel", "mix_click_hook", "mix_click_info", "mix_click_sets_amp", "mix_color",
+ "mix_dialog_mix", "mix_drag_hook", "mix_file_dialog", "mix_home", "mix_length", "mix_maxamp",
+ "mix_name", "mix_name2id", "mix_position", "mix_properties", "mix_property", "mix_region",
+ "mix_release_hook", "mix_sampler?", "mix_selection", "mix_sound", "mix_speed", "mix_sync",
+ "mix_sync_max", "mix_tag_height", "mix_tag_width", "mix_tag_y", "mix_vct", "mix_waveform_height",
+ "mix?", "mixes", "mono2stereo", "moog_filter", "morally_equal?", "mouse_click_hook",
+ "mouse_drag_hook", "mouse_enter_graph_hook", "mouse_enter_label_hook", "mouse_enter_listener_hook", "mouse_enter_text_hook", "mouse_leave_graph_hook",
+ "mouse_leave_label_hook", "mouse_leave_listener_hook", "mouse_leave_text_hook", "mouse_press_hook", "move_locsig", "move_mixes",
+ "move_sound", "move_sound?", "move_syncd_marks", "moving_autocorrelation", "moving_autocorrelation?", "moving_average",
+ "moving_average?", "moving_fft", "moving_fft?", "moving_length", "moving_max", "moving_max?",
+ "moving_norm", "moving_norm?", "moving_pitch", "moving_pitch?", "moving_rms", "moving_scentroid",
+ "moving_scentroid?", "moving_spectrum", "moving_spectrum?", "moving_sum", "mpg", "mus_alsa_buffer_size",
+ "mus_alsa_buffers", "mus_alsa_capture_device", "mus_alsa_device", "mus_alsa_playback_device", "mus_alsa_squelch_warning", "mus_array_print_length",
+ "mus_bytes_per_sample", "mus_channel", "mus_channels", "mus_chebyshev_tu_sum", "mus_clipping", "mus_close",
+ "mus_copy", "mus_data", "mus_describe", "mus_error_hook", "mus_error_type2string", "mus_expand_filename",
+ "mus_feedback", "mus_feedforward", "mus_fft", "mus_file_buffer_size", "mus_file_clipping", "mus_file_mix",
+ "mus_file_name", "mus_float_equal_fudge_factor", "mus_frequency", "mus_generator?", "mus_header_raw_defaults", "mus_header_type2string",
"mus_header_type_name", "mus_hop", "mus_increment", "mus_input?", "mus_interp_type", "mus_interpolate",
- "mus_length", "mus_location", "mus_max_malloc", "mus_max_table_size", "mus_mix", "mus_name",
- "mus_offset", "mus_order", "mus_oss_set_buffers", "Mus_out_format", "mus_output?", "mus_phase",
- "mus_prescaler", "mus_ramp", "mus_random", "mus_reset", "mus_run", "mus_safety",
- "mus_scaler", "mus_sound_chans", "mus_sound_close_input", "mus_sound_close_output", "mus_sound_comment", "mus_sound_data_format",
- "mus_sound_data_location", "mus_sound_datum_size", "mus_sound_duration", "mus_sound_forget", "mus_sound_frames", "mus_sound_header_type",
- "mus_sound_length", "mus_sound_loop_info", "mus_sound_mark_info", "mus_sound_maxamp", "mus_sound_maxamp_exists?", "mus_sound_open_input",
- "mus_sound_open_output", "mus_sound_prune", "mus_sound_read", "mus_sound_reopen_output", "mus_sound_report_cache", "mus_sound_samples",
- "mus_sound_seek_frame", "mus_sound_srate", "mus_sound_type_specifier", "mus_sound_write", "mus_sound_write_date", "mus_srate",
- "mus_width", "mus_xcoeff", "mus_xcoeffs", "mus_ycoeff", "mus_ycoeffs", "name_click_hook",
- "ncos", "ncos?", "new_sound", "new_sound_dialog", "new_sound_hook", "new_widget_hook",
- "next_frame", "next_sample", "noid", "normalize_channel", "normalize_envelope", "normalize_partials",
- "normalize_sound", "normalized_mix", "notch", "notch_channel", "notch_out_rumble_and_hiss", "notch_selection",
- "notch_sound", "notch?", "nrev", "nrxycos", "nrxycos?", "nrxysin",
- "nrxysin?", "nsin", "nsin?", "offset_channel", "offset_sound", "one_pole",
- "one_pole?", "one_zero", "one_zero?", "open_file_dialog", "open_file_dialog_directory", "open_hook",
- "open_next_file_in_directory", "open_raw_sound", "open_raw_sound_hook", "open_sound", "optimization", "optimization_hook",
- "orientation_hook", "oscil", "oscil?", "oscilloscope_dialog", "out_any", "outa",
- "_output_", "output_comment_hook", "output_name_hook", "overlay_rms_env", "pad_channel", "pad_marks",
- "pad_sound", "pan_mix", "pan_mix_vct", "partials2polynomial", "partials2wave", "pausing",
- "peak_env_dir", "peak_env_hook", "peaks", "peaks_font", "phase_partials2wave", "phase_vocoder",
- "phase_vocoder?", "piano_model", "pink_noise", "place_sound", "play", "play_arrow_size",
- "play_between_marks", "play_hook", "play_mixes", "play_sines", "play_syncd_marks", "player_home",
+ "mus_length", "mus_location", "mus_max_malloc", "mus_max_table_size", "mus_name", "mus_offset",
+ "mus_order", "mus_oss_set_buffers", "mus_output?", "mus_phase", "mus_ramp", "mus_rand_seed",
+ "mus_random", "mus_reset", "mus_run", "mus_sample_type2string", "mus_sample_type_name", "mus_scaler",
+ "mus_sound_chans", "mus_sound_close_input", "mus_sound_close_output", "mus_sound_comment", "mus_sound_data_location", "mus_sound_datum_size",
+ "mus_sound_duration", "mus_sound_forget", "mus_sound_framples", "mus_sound_header_type", "mus_sound_length", "mus_sound_loop_info",
+ "mus_sound_mark_info", "mus_sound_maxamp", "mus_sound_maxamp_exists?", "mus_sound_open_input", "mus_sound_open_output", "mus_sound_path",
+ "mus_sound_preload", "mus_sound_prune", "mus_sound_read", "mus_sound_reopen_output", "mus_sound_report_cache", "mus_sound_sample_type",
+ "mus_sound_samples", "mus_sound_seek_frample", "mus_sound_srate", "mus_sound_type_specifier", "mus_sound_write", "mus_sound_write_date",
+ "mus_srate", "mus_width", "mus_xcoeff", "mus_xcoeffs", "mus_ycoeff", "mus_ycoeffs",
+ "n1cos", "n1cos?", "name_click_hook", "nchoosekcos", "nchoosekcos?", "ncos",
+ "ncos2?", "ncos4?", "ncos?", "new_sound", "new_sound_dialog", "new_sound_hook",
+ "new_widget_hook", "next_sample", "nkssb", "nkssb_interp", "nkssb?", "noddcos",
+ "noddcos?", "noddsin", "noddsin?", "noddssb", "noddssb?", "noid",
+ "normalize_channel", "normalize_envelope", "normalize_partials", "normalize_sound", "normalized_mix", "notch",
+ "notch_channel", "notch_selection", "notch_sound", "notch?", "npcos?", "nrcos",
+ "nrcos?", "nrev", "nrsin", "nrsin?", "nrssb", "nrssb_interp",
+ "nrssb?", "nrxycos", "nrxycos?", "nrxysin", "nrxysin?", "nsin",
+ "nsin?", "nsincos", "nsincos?", "nssb", "nssb?", "nxy1cos",
+ "nxy1cos?", "nxy1sin", "nxy1sin?", "nxycos", "nxycos?", "nxysin",
+ "nxysin?", "object2string", "odd_multiple", "odd_weight", "offset_channel", "offset_sound",
+ "one_pole", "one_pole_all_pass", "one_pole_all_pass?", "one_pole?", "one_zero", "one_zero?",
+ "open_file_dialog", "open_file_dialog_directory", "open_hook", "open_next_file_in_directory", "open_raw_sound", "open_raw_sound_hook",
+ "open_sound", "openlet", "openlet?", "orientation_hook", "oscil", "oscil_bank",
+ "oscil_bank?", "oscil?", "out_any", "out_bank", "outa", "outlet",
+ "_output_", "output_comment_hook", "overlay_rms_env", "owlet", "pad_channel", "pad_marks",
+ "pad_sound", "pan_mix", "pan_mix_float_vector", "partials2polynomial", "partials2wave", "pausing",
+ "peak_env_dir", "peaks", "peaks_font", "phase_partials2wave", "phase_vocoder", "phase_vocoder?",
+ "piano_model", "pink_noise", "pink_noise?", "pins", "place_sound", "play",
+ "play_arrow_size", "play_between_marks", "play_hook", "play_mixes", "play_often", "play_region_forever",
+ "play_sine", "play_sines", "play_syncd_marks", "play_until_c_g", "play_with_envs", "player_home",
"player?", "players", "playing", "pluck", "polar2rectangular", "polynomial",
"polynomial_operations", "polyoid", "polyoid_env", "polyoid?", "polyshape", "polyshape?",
"polywave", "polywave?", "position2x", "position2y", "position_color", "power_env",
- "preferences_dialog", "previous_frame", "previous_sample", "print_dialog", "print_hook", "print_length",
- "procedure_source", "procedure_with_setter", "profile", "progress_report", "prompt_in_minibuffer", "ptree_channel",
- "pulse_train", "pulse_train?", "radians2degrees", "radians2hz", "ramp_channel", "rand",
- "rand_interp", "rand_interp?", "rand?", "random", "read_frame", "read_hook",
- "read_mix_sample", "read_only", "read_region_sample", "read_sample", "readin", "readin?",
- "recorder_dialog", "rectangular2magnitudes", "rectangular2polar", "redo_edit", "redo_channel", "redo_edit",
- "region2frame", "region2integer", "region2sound_data", "region2vct", "region_chans", "region_frames",
+ "pqw", "pqw_vox", "preferences_dialog", "previous_sample", "print_dialog", "print_length",
+ "procedure_documentation", "procedure_setter", "procedure_signature", "procedure_source", "profile", "progress_report",
+ "pulse_train", "pulse_train?", "pulsed_env", "pulsed_env?", "r2k!cos", "r2k!cos?",
+ "r2k2cos", "r2k2cos?", "radians2degrees", "radians2hz", "ramp_channel", "rand",
+ "rand_interp", "rand_interp?", "rand?", "random", "random_state", "random_state?",
+ "rcos", "rcos?", "read_hook", "read_mix_sample", "read_only", "read_region_sample",
+ "read_sample", "read_sample_with_direction", "reader_cond", "readin", "readin?", "rectangular2magnitudes",
+ "rectangular2polar", "redo_edit", "region2integer", "region2vct", "region_chans", "region_framples",
"region_graph_style", "region_home", "region_maxamp", "region_maxamp_position", "region_play_list", "region_position",
- "region_sample", "region_sampler?", "region_srate", "region?", "regions", "release_lock",
- "remember_sound_state", "remove_from_menu", "report_in_minibuffer", "reset_all_hooks", "reset_controls", "reset_listener_cursor",
- "restore_controls", "_reverb_", "reverb_control_decay", "reverb_control_feedback", "reverb_control_length", "reverb_control_length_bounds",
- "reverb_control_lowpass", "reverb_control_scale", "reverb_control_scale_bounds", "reverb_control?", "reverse_channel", "reverse_channels",
- "reverse_envelope", "reverse_selection", "reverse_sound", "revert_sound", "right_sample", "ring_modulate",
- "rms", "rms__gain__balance_gens", "rms_envelope", "rotate_channel", "rubber_sound", "run",
- "sample", "sample2file", "sample2file?", "sample2frame", "sampler_at_end?", "sampler_home",
- "sampler_position", "sampler?", "samples", "samples2seconds", "sash_color", "save_as_dialog_auto_comment",
- "save_as_dialog_src", "save_controls", "save_dir", "save_edit_history", "save_envelopes", "save_hook",
- "save_listener", "save_macros", "save_mark_properties", "save_marks", "save_mix", "save_mixes",
- "save_region", "save_region_dialog", "save_selection", "save_selection_dialog", "save_sound", "save_sound_as",
- "save_sound_dialog", "save_state", "save_state_file", "save_state_hook", "savitzky_golay_filter", "sawtooth_wave",
- "sawtooth_wave?", "scale_by", "scale_channel", "scale_envelope", "scale_mixes", "scale_selection_by",
- "scale_selection_to", "scale_sound", "scale_tempo", "scale_to", "scan_channel", "scan_sound",
- "scanned_synthesis", "scentroid", "script_arg", "script_args", "search_procedure", "seconds2samples",
- "select_all", "select_channel", "select_channel_hook", "select_sound", "select_sound_hook", "selected_channel",
- "selected_data_color", "selected_graph_color", "selected_sound", "selection", "selection2mix", "selection2sound_data",
- "selection_chans", "selection_color", "selection_creates_region", "selection_frames", "selection_maxamp", "selection_maxamp_position",
- "selection_member?", "selection_members", "selection_position", "selection_srate", "selection?", "set_samples",
- "shepard_tone", "short_file_name", "show_axes", "show_controls", "show_disk_space", "show_full_duration",
- "show_grid", "show_indices", "show_listener", "show_marks", "show_mix_waveforms", "show_selection",
- "show_selection_transform", "show_sonogram_cursor", "show_transform_peaks", "show_widget", "show_y_zero", "silence_all_mixes",
- "silence_mixes", "sinc_train", "sinc_width", "sine_env_channel", "sine_ramp", "singer",
- "smooth_channel", "smooth_selection", "smooth_sound", "SMS_synthesis", "snap_mark_to_beat", "snap_mix_to_beat",
- "snd2sample", "snd2sample?", "snd_color", "snd_error", "snd_error_hook", "snd_font",
- "snd_gcs", "snd_help", "snd_hooks", "_snd_opened_sound_", "snd_print", "snd_spectrum",
- "snd_tempnam", "snd_url", "snd_urls", "snd_version", "snd_warning", "snd_warning_hook",
- "sndwarp", "sound2amp_env", "sound2frame", "sound2integer", "sound2sound_data", "sound_data_",
- "sound_data_", "sound_data2file", "sound_data2frame", "sound_data2sound", "sound_data2sound_data", "sound_data2vct",
- "sound_data_add!", "sound_data_chans", "sound_data_copy", "sound_data_fill!", "sound_data_length", "sound_data_maxamp",
- "sound_data_multiply!", "sound_data_offset!", "sound_data_peak", "sound_data_ref", "sound_data_reverse!", "sound_data_scale!",
- "sound_data_set!", "sound_data?", "sound_file_extensions", "sound_file?", "sound_files_in_directory", "sound_interp",
- "sound_let", "sound_loop_info", "sound_properties", "sound_property", "sound_widgets", "sound?",
- "soundfont_info", "sounds", "spectral_interpolation", "spectral_polynomial", "spectro_hop", "spectro_x_angle",
- "spectro_x_scale", "spectro_y_angle", "spectro_y_scale", "spectro_z_angle", "spectro_z_scale", "spectrum",
- "spectrum2coeffs", "spectrum_end", "spectrum_start", "speed_control", "speed_control_bounds", "speed_control_style",
- "speed_control_tones", "square_wave", "square_wave?", "squelch_update", "squelch_vowels", "srate",
- "src", "src_channel", "src_duration", "src_mixes", "src_selection", "src_sound",
+ "region_rms", "region_sample", "region_sampler?", "region_srate", "region?", "regions",
+ "remember_sound_state", "remove_clicks", "remove_from_menu", "replace_with_selection", "report_mark_names", "require",
+ "reset_all_hooks", "reset_controls", "reset_listener_cursor", "reson", "restore_controls", "_reverb_",
+ "reverb_control_decay", "reverb_control_feedback", "reverb_control_length", "reverb_control_length_bounds", "reverb_control_lowpass", "reverb_control_scale",
+ "reverb_control_scale_bounds", "reverb_control?", "reverse!", "reverse_by_blocks", "reverse_channel", "reverse_envelope",
+ "reverse_selection", "reverse_sound", "revert_sound", "right_sample", "ring_modulate", "rk!cos",
+ "rk!cos?", "rk!ssb", "rk!ssb?", "rkcos", "rkcos?", "rkoddssb",
+ "rkoddssb?", "rksin", "rksin?", "rkssb", "rkssb?", "rms",
+ "rms__gain__balance_gens", "rms_envelope", "rootlet", "round_interp", "round_interp?", "rssb",
+ "rssb_interp", "rssb?", "rubber_sound", "rxycos", "rxycos?", "rxyk!cos",
+ "rxyk!cos?", "rxyk!sin", "rxyk!sin?", "rxysin", "rxysin?", "sample",
+ "sample2file", "sample2file?", "sample_type", "sampler_at_end?", "sampler_home", "sampler_position",
+ "sampler?", "samples", "samples2seconds", "sash_color", "save_as_dialog_auto_comment", "save_as_dialog_src",
+ "save_controls", "save_dir", "save_edit_history", "save_envelopes", "save_hook", "save_listener",
+ "save_mark_properties", "save_marks", "save_mix", "save_region", "save_region_dialog", "save_selection",
+ "save_selection_dialog", "save_sound", "save_sound_as", "save_sound_dialog", "save_state", "save_state_file",
+ "save_state_hook", "savitzky_golay_filter", "sawtooth_wave", "sawtooth_wave?", "scale_by", "scale_channel",
+ "scale_envelope", "scale_mixes", "scale_selection_by", "scale_selection_to", "scale_sound", "scale_tempo",
+ "scale_to", "scan_channel", "scanned_synthesis", "scentroid", "scratch", "script_arg",
+ "script_args", "search_for_click", "search_procedure", "seconds2samples", "select_all", "select_channel",
+ "select_channel_hook", "select_sound", "select_sound_hook", "selected_channel", "selected_data_color", "selected_graph_color",
+ "selected_sound", "selection", "selection2mix", "selection_chans", "selection_color", "Selection_context",
+ "selection_creates_region", "selection_framples", "selection_maxamp", "selection_maxamp_position", "selection_member?", "selection_members",
+ "selection_position", "selection_rms", "selection_srate", "selection?", "set_samples", "short_file_name",
+ "show_axes", "show_controls", "show_disk_space", "show_full_duration", "show_full_range", "show_grid",
+ "show_indices", "show_listener", "show_marks", "show_mix_waveforms", "show_selection", "show_selection_transform",
+ "show_sonogram_cursor", "show_transform_peaks", "show_widget", "show_y_zero", "silence_all_mixes", "silence_mixes",
+ "sinc_train", "sinc_train?", "sinc_width", "sine_env_channel", "sine_ramp", "singer",
+ "smooth_channel", "smooth_selection", "smooth_sound", "SMS_synthesis", "snap_mark_to_beat", "snap_marks",
+ "snap_mix_to_beat", "snd2sample", "snd2sample?", "snd_color", "snd_error", "snd_error_hook",
+ "snd_font", "snd_gcs", "snd_help", "snd_hooks", "_snd_opened_sound_", "snd_print",
+ "snd_spectrum", "snd_tempnam", "snd_url", "snd_urls", "snd_version", "snd_warning",
+ "snd_warning_hook", "sndwarp", "sort!", "sound2amp_env", "sound2integer", "sound_file_extensions",
+ "sound_file?", "sound_files_in_directory", "sound_interp", "sound_loop_info", "sound_properties", "sound_property",
+ "sound_widgets", "sound?", "soundfont_info", "sounds", "sounds2segment_data", "spectra",
+ "spectral_interpolation", "spectral_polynomial", "spectro_hop", "spectro_x_angle", "spectro_x_scale", "spectro_y_angle",
+ "spectro_y_scale", "spectro_z_angle", "spectro_z_scale", "spectrum", "spectrum2coeffs", "spectrum_end",
+ "spectrum_start", "speed_control", "speed_control_bounds", "speed_control_style", "speed_control_tones", "spot_freq",
+ "square_wave", "square_wave?", "squelch_update", "squelch_vowels", "srate", "src",
+ "src_channel", "src_duration", "src_fit_envelope", "src_mixes", "src_selection", "src_sound",
"src?", "ssb_am", "ssb_am?", "ssb_bank", "ssb_bank_env", "ssb_fm",
- "stacktrace", "start_hook", "start_playing", "start_playing_hook", "start_playing_selection_hook", "start_progress_report",
- "start_waterfall", "stereo2mono", "stop_dac_hook", "stop_player", "stop_playing", "stop_playing_hook",
- "stop_playing_selection_hook", "stretch_envelope", "superimpose_ffts", "swap_channels", "swap_selection_channels", "symbol_access",
- "sync", "sync_everything", "sync_max", "sync_style", "syncd_marks", "table_lookup",
- "table_lookup?", "tap", "telephone", "temp_dir", "text_focus_color", "time_graph_style",
- "time_graph_type", "time_graph?", "tiny_font", "trace", "_trace_hook_", "tracking_cursor_style",
- "transform2integer", "transform2vct", "transform_dialog", "transform_frames", "transform_graph_style", "transform_graph_type",
- "transform_graph?", "transform_normalization", "transform_sample", "transform_size", "transform_type", "transform?",
- "transpose_mixes", "trap_segfault", "triangle_wave", "triangle_wave?", "tubular_bell", "two_pole",
- "two_pole?", "two_zero", "two_zero?", "unbind_key", "_unbound_variable_hook_", "unclip_channel",
- "undo", "undo_channel", "undo_edit", "undo_hook", "unselect_all", "update_graphs",
- "update_hook", "update_lisp_graph", "update_sound", "update_time_graph", "update_transform_graph", "user_interface_extensions",
- "variable_display", "variable_graph?", "vct", "vct_multiply", "vct_add", "vct2channel",
- "vct2file", "vct2frame", "vct2list", "vct2sound_data", "vct2string", "vct2vector",
- "vct_add!", "vct_copy", "vct_fill!", "vct_length", "vct_map!", "vct_move!",
- "vct_multiply!", "vct_offset!", "vct_peak", "vct_polynomial", "vct_ref", "vct_reverse!",
+ "start_dac", "start_playing", "start_playing_hook", "start_playing_selection_hook", "start_progress_report", "status_report",
+ "stereo2mono", "stereo_flute", "stop_player", "stop_playing", "stop_playing_hook", "stop_playing_selection_hook",
+ "stretch_envelope", "stretch_sound_via_dft", "string_position", "sublet", "superimpose_ffts", "swap_channels",
+ "swap_selection_channels", "symbol2dynamic_value", "symbol2value", "symbol_access", "symbol_table", "sync",
+ "sync_everything", "sync_max", "sync_style", "syncd_marks", "syncd_mixes", "syncup",
+ "table_lookup", "table_lookup?", "tanhsin", "tanhsin?", "tap", "tap?",
+ "telephone", "temp_dir", "text_focus_color", "time_graph_style", "time_graph_type", "time_graph?",
+ "times2samples", "tiny_font", "touch_tone", "trace", "tracking_cursor_style", "transform2integer",
+ "transform2vct", "transform_dialog", "transform_framples", "transform_graph_style", "transform_graph_type", "transform_graph?",
+ "transform_normalization", "transform_sample", "transform_size", "transform_type", "transform?", "transpose_mixes",
+ "triangle_wave", "triangle_wave?", "tubebell", "tubular_bell", "two_pole", "two_pole?",
+ "two_tab", "two_zero", "two_zero?", "unbind_key", "_unbound_variable_hook_", "unclip_channel",
+ "undo", "undo_hook", "unlet", "unselect_all", "update_graphs", "update_hook",
+ "update_lisp_graph", "update_sound", "update_time_graph", "update_transform_graph", "upon_save_yourself", "user_interface_extensions",
+ "variable_display", "variable_graph?", "varlet", "vct", "vct_", "vct_",
+ "vct2channel", "vct2list", "vct2string", "vct2vector", "vct_abs!", "vct_add!",
+ "vct_copy", "vct_equal?", "vct_fill!", "vct_length", "vct_max", "vct_min",
+ "vct_move!", "vct_multiply!", "vct_offset!", "vct_peak", "vct_ref", "vct_reverse!",
"vct_scale!", "vct_set!", "vct_subseq", "vct_subtract!", "vct?", "vector2vct",
- "_vector_print_length_", "view_files_amp", "view_files_amp_env", "view_files_dialog", "view_files_files", "view_files_select_hook",
- "view_files_selected_files", "view_files_sort", "view_files_speed", "view_files_speed_style", "view_mixes_dialog", "view_regions_dialog",
- "view_sound", "voice_physical_model", "voiced2unvoiced", "volterra_filter", "wave_train", "wave_train?",
+ "view_files_amp", "view_files_amp_env", "view_files_dialog", "view_files_files", "view_files_select_hook", "view_files_selected_files",
+ "view_files_sort", "view_files_speed", "view_files_speed_style", "view_mixes_dialog", "view_regions_dialog", "view_sound",
+ "voice_physical_model", "voiced2unvoiced", "volterra_filter", "vox", "wave_train", "wave_train?",
"wavelet_type", "waveshaping_voice", "wavo_hop", "wavo_trace", "weighted_moving_average", "widget_position",
"widget_size", "widget_text", "window_height", "window_samples", "window_width", "window_x",
- "window_y", "with_background_processes", "with_environment", "with_file_monitor", "with_gl", "with_inset_graph",
- "with_local_hook", "with_marked_sound", "with_menu_icons", "with_mix_tags", "with_mixed_sound", "with_mixed_sound2notelist",
- "with_pointer_focus", "with_relative_panes", "with_smpte_label", "with_sound", "with_temp_sound", "with_temporary_selection",
- "with_threaded_channels", "with_threaded_sound", "with_toolbar", "with_tooltips", "with_tracking_cursor", "with_verbose_cursor",
- "x2position", "x_axis_label", "x_axis_style", "x_bounds", "x_position_slider", "x_zoom_slider",
- "xramp_channel", "y2position", "y_axis_label", "y_bounds", "y_position_slider", "y_zoom_slider",
- "z_transform", "zero_pad", "zip_sound", "zipper", "zoom_color", "zoom_focus_style"};
+ "window_y", "with_background_processes", "with_baffle", "with_file_monitor", "with_gl", "with_inset_graph",
+ "with_interrupts", "with_let", "with_local_hook", "with_menu_icons", "with_mix_tags", "with_pointer_focus",
+ "with_relative_panes", "with_smpte_label", "with_sound", "with_temporary_selection", "with_toolbar", "with_tooltips",
+ "with_tracking_cursor", "with_verbose_cursor", "x2position", "x_axis_label", "x_axis_style", "x_bounds",
+ "x_position_slider", "x_zoom_slider", "xb_open", "xramp_channel", "y2position", "y_axis_label",
+ "y_bounds", "y_position_slider", "y_zoom_slider", "z_transform", "zecho", "zero_",
+ "zero_pad", "zero_phase", "zip_sound", "zipper", "zoom_color", "zoom_focus_style"};
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
static const char **help_names = NULL;
#endif
static const char *help_urls[HELP_NAMES_SIZE] = {
- "*#readers*", "extsnd.html#abort", "sndscm.html#addampcontrols", "extsnd.html#addcolormap",
- "extsnd.html#addcomment", "extsnd.html#adddirectorytoviewfileslist", "extsnd.html#addfilefilter", "extsnd.html#addfilesorter",
- "extsnd.html#addfiletoviewfileslist", "extsnd.html#addmark", "sndscm.html#addmarkpane", "extsnd.html#addplayer",
- "extsnd.html#addsoundfileextension", "extsnd.html#addsourcefileextension", "extsnd.html#addtomainmenu", "extsnd.html#addtomenu",
- "sndscm.html#addtooltip", "extsnd.html#addtransform", "sndscm.html#spectra", "extsnd.html#afterapplycontrolshook",
- "extsnd.html#afteredithook", "extsnd.html#aftergraphhook", "extsnd.html#afterlispgraphhook", "extsnd.html#afteropenhook",
- "extsnd.html#aftersaveashook", "extsnd.html#aftersavestatehook", "extsnd.html#aftertransformhook", "sndclm.html#all-pass",
- "sndclm.html#all-pass?", "extsnd.html#ampcontrol", "extsnd.html#ampcontrolbounds", "sndclm.html#amplitude-modulate",
- "grfsnd.html#analyseladspa", "sndscm.html#anyenvchannel", "extsnd.html#appendsound", "extsnd.html#applycontrols",
- "grfsnd.html#applyladspa", "sndclm.html#arraytofile", "sndclm.html#array-interp", "extsnd.html#asoneedit",
- "extsnd.html#askaboutunsavededits", "extsnd.html#askbeforeoverwrite", "sndclm.html#asymmetric-fm", "sndclm.html#asymmetric-fm?",
- "extsnd.html#audioinputdevice", "extsnd.html#audiooutputdevice", "s7.html#augmentenvironment", "extsnd.html#autoresize",
- "sndscm.html#autosavedoc", "extsnd.html#autoupdate", "extsnd.html#autoupdateinterval", "sndclm.html#autocorrelate",
- "extsnd.html#axiscolor", "extsnd.html#axisinfo", "extsnd.html#axislabelfont", "extsnd.html#axisnumbersfont",
- "extsnd.html#backgroundgradient", "extsnd.html#badheaderhook", "sndscm.html#bagpipe", "extsnd.html#basiccolor",
- "extsnd.html#beatspermeasure", "extsnd.html#beatsperminute", "extsnd.html#beforeclosehook", "extsnd.html#beforeexithook",
- "extsnd.html#beforesaveashook", "extsnd.html#beforesavestatehook", "extsnd.html#beforetransformhook", "sndscm.html#analogfilterdoc",
- "sndscm.html#bigbird", "s7.html#bignum", "s7.html#bignumprecision", "s7.html#bignump",
- "sndscm.html#binaryiodoc", "extsnd.html#bindkey", "sndscm.html#bird", "extsnd.html#boldpeaksfont",
- "extsnd.html#bomb", "extsnd.html#break", "sndclm.html#brown-noise", "sndscm.html#analogfilterdoc",
- "extsnd.html#cgp", "s7.html#callwithexit", "extsnd.html#callin", "sndscm.html#cascadetocanonical",
- "s7.html#catch", "sndscm.html#chaindsps", "extsnd.html#channeltovct", "extsnd.html#channelampenvs",
- "extsnd.html#channeldata", "sndscm.html#channelenvelope", "sndscm.html#channelpolynomial", "extsnd.html#channelproperties",
- "extsnd.html#channelproperty", "sndscm.html#channelrms", "extsnd.html#channelstyle", "sndscm.html#channelsync",
- "extsnd.html#channelwidgets", "extsnd.html#channels", "sndscm.html#channelsequal", "extsnd.html#channelstyleconstants",
- "sndscm.html#channels=", "extsnd.html#chans", "sndscm.html#analogfilterdoc", "sndscm.html#checkmixtags",
- "sndscm.html#cleanchannel", "sndscm.html#cleansound", "sndclm.html#clear-array", "extsnd.html#clearlistener",
- "extsnd.html#clearminibuffer", "extsnd.html#cliphook", "extsnd.html#clipping", "extsnd.html#clmchannel",
- "sndscm.html#clmload", "extsnd.html#clonesoundas", "extsnd.html#closehook", "extsnd.html#closesound",
- "extsnd.html#colortolist", "extsnd.html#colorcutoff", "extsnd.html#colorhook", "extsnd.html#colorinverted",
- "sndscm.html#colormixes", "extsnd.html#colororientationdialog", "extsnd.html#colorscale", "extsnd.html#colorp",
- "extsnd.html#colormap", "extsnd.html#colormaptointeger", "extsnd.html#colormapname", "extsnd.html#colormapref",
- "extsnd.html#colormapsize", "extsnd.html#colormapp", "sndclm.html#comb", "sndclm.html#comb?",
- "extsnd.html#combineddatacolor", "extsnd.html#comment", "sndscm.html#compandchannel", "sndscm.html#compandsound",
- "sndscm.html#concatenateenvelopes", "s7.html#constantp", "sndclm.html#continue-frametofile", "sndclm.html#continue-sampletofile",
+ "*#readers*", "s7.html#tobytevector", "sndclm.html#abcos", "sndclm.html#abcos?",
+ "extsnd.html#abort", "sndclm.html#absin", "sndclm.html#absin?", "sndscm.html#addampcontrols",
+ "extsnd.html#addcolormap", "sndscm.html#adddeleteoption", "extsnd.html#adddirectorytoviewfileslist", "extsnd.html#addfilefilter",
+ "extsnd.html#addfilesorter", "extsnd.html#addfiletoviewfileslist", "extsnd.html#addmark", "sndscm.html#addmarkpane",
+ "extsnd.html#addplayer", "extsnd.html#addsoundfileextension", "extsnd.html#addsourcefileextension", "extsnd.html#addtomainmenu",
+ "extsnd.html#addtomenu", "sndscm.html#addtooltip", "extsnd.html#addtransform", "sndscm.html#spectra",
+ "sndclm.html#adjustable-sawtooth-wave", "sndclm.html#adjustable-sawtooth-wave?", "sndclm.html#adjustable-square-wave", "sndclm.html#adjustable-square-wave?",
+ "sndclm.html#adjustable-triangle-wave", "sndclm.html#adjustable-triangle-wave?", "extsnd.html#afterapplycontrolshook", "extsnd.html#afteredithook",
+ "extsnd.html#aftergraphhook", "extsnd.html#afterlispgraphhook", "extsnd.html#afteropenhook", "extsnd.html#aftersaveashook",
+ "extsnd.html#aftersavestatehook", "extsnd.html#aftertransformhook", "sndscm.html#allchans", "sndclm.html#all-pass",
+ "sndclm.html#allpassbank", "sndclm.html#allpassbankp", "sndclm.html#all-pass?", "extsnd.html#ampcontrol",
+ "extsnd.html#ampcontrolbounds", "sndclm.html#amplitude-modulate", "grfsnd.html#analyseladspa", "sndscm.html#anoi",
+ "sndscm.html#anyenvchannel", "sndscm.html#anyrandom", "extsnd.html#applycontrols", "grfsnd.html#applyladspa",
+ "s7.html#aritablep", "s7.html#arity", "sndclm.html#arraytofile", "sndclm.html#array-interp",
+ "extsnd.html#asoneedit", "extsnd.html#askaboutunsavededits", "extsnd.html#askbeforeoverwrite", "sndclm.html#asyfmI",
+ "sndclm.html#asyfmJ", "sndclm.html#asyfm?", "sndclm.html#asymmetric-fm", "sndclm.html#asymmetric-fm?",
+ "extsnd.html#autoresize", "sndscm.html#autosavedoc", "extsnd.html#autoupdate", "extsnd.html#autoupdateinterval",
+ "sndclm.html#autocorrelate", "extsnd.html#axiscolor", "extsnd.html#axisinfo", "extsnd.html#axislabelfont",
+ "extsnd.html#axisnumbersfont", "extsnd.html#backgroundgradient", "extsnd.html#badheaderhook", "sndscm.html#bagpipe",
+ "extsnd.html#basiccolor", "extsnd.html#beatspermeasure", "extsnd.html#beatsperminute", "extsnd.html#beforeclosehook",
+ "extsnd.html#beforeexithook", "extsnd.html#beforesaveashook", "extsnd.html#beforesavestatehook", "extsnd.html#beforetransformhook",
+ "extsnd.html#besj0", "sndclm.html#bess", "sndclm.html#bess?", "sndscm.html#analogfilterdoc",
+ "sndscm.html#bigbird", "s7.html#bignum", "s7.html#bignump", "sndscm.html#binaryiodoc",
+ "extsnd.html#bindkey", "sndscm.html#bird", "sndclm.html#blackman", "sndscm.html#blackman4envchannel",
+ "sndclm.html#blackman?", "extsnd.html#boldpeaksfont", "extsnd.html#break", "sndclm.html#brown-noise",
+ "sndclm.html#brown-noise?", "sndscm.html#analogfilterdoc", "s7.html#bytevector", "s7.html#bytevectorp",
+ "s7.html#definecfunction", "extsnd.html#cgp", "s7.html#cobject", "s7.html#cpoint",
+ "s7.html#cpointer", "s7.html#callwithexit", "sndscm.html#bagpipe", "sndscm.html#cascadetocanonical",
+ "s7.html#catch", "sndscm.html#cellon", "sndscm.html#chaindsps", "extsnd.html#channeltovct",
+ "extsnd.html#channelampenvs", "extsnd.html#channeldata", "sndscm.html#channelenvelope", "sndscm.html#channelpolynomial",
+ "extsnd.html#channelproperties", "extsnd.html#channelproperty", "sndscm.html#channelrms", "extsnd.html#channelstyle",
+ "sndscm.html#channelsync", "extsnd.html#channelwidgets", "extsnd.html#channels", "sndscm.html#channelsequal",
+ "sndscm.html#channelseq", "extsnd.html#chans", "s7.html#charposition", "sndscm.html#chebyhka",
+ "sndscm.html#analogfilterdoc", "sndscm.html#checkmixtags", "sndscm.html#chordalize", "sndscm.html#chorus",
+ "sndscm.html#cleanchannel", "sndscm.html#cleansound", "extsnd.html#clearlistener", "extsnd.html#cliphook",
+ "extsnd.html#clipping", "extsnd.html#clmchannel", "sndscm.html#clmexpsrc", "extsnd.html#closehook",
+ "extsnd.html#closesound", "extsnd.html#colortolist", "extsnd.html#colorcutoff", "extsnd.html#colorhook",
+ "extsnd.html#colorinverted", "sndscm.html#colormixes", "extsnd.html#colororientationdialog", "extsnd.html#colorscale",
+ "extsnd.html#colorp", "extsnd.html#colormap", "extsnd.html#colormaptointeger", "extsnd.html#colormapname",
+ "extsnd.html#colormapref", "extsnd.html#colormapsize", "extsnd.html#colormapp", "sndclm.html#comb",
+ "sndclm.html#combbank", "sndclm.html#combbankp", "sndclm.html#comb?", "extsnd.html#combineddatacolor",
+ "extsnd.html#comment", "sndscm.html#complexify", "sndscm.html#computeuniformcircularstring", "sndscm.html#concatenateenvelopes",
+ "s7.html#constantp", "s7.html#continuationp", "sndclm.html#continue-frampletofile", "sndclm.html#continue-sampletofile",
"sndscm.html#contrastchannel", "extsnd.html#contrastcontrol", "extsnd.html#contrastcontrolamp", "extsnd.html#contrastcontrolbounds",
"extsnd.html#contrastcontrolp", "sndclm.html#contrast-enhancement", "sndscm.html#contrastsound", "extsnd.html#controlstochannel",
"sndclm.html#convolution", "extsnd.html#convolvewith", "sndclm.html#convolve", "sndclm.html#convolvefiles",
- "extsnd.html#convolveselectionwith", "extsnd.html#convolvewith", "sndclm.html#convolve?", "sndscm.html#copyframereader",
- "extsnd.html#copysampler", "sndclm.html#correlate", "extsnd.html#countmatches", "sndscm.html#createssbdialog",
- "sndscm.html#mixdoc", "sndscm.html#fadedoc", "sndscm.html#crosssynthesis", "extsnd.html#currenteditposition",
- "s7.html#currentenvironment", "extsnd.html#currentfont", "extsnd.html#cursor", "extsnd.html#cursorcolor",
- "extsnd.html#cursorfollowsplay", "extsnd.html#cursorchoices", "extsnd.html#cursorlocationoffset", "extsnd.html#cursorposition",
- "extsnd.html#cursorsize", "extsnd.html#cursorstyle", "extsnd.html#cursorupdateinterval", "extsnd.html#dacfolding",
- "extsnd.html#dachook", "extsnd.html#dacsize", "extsnd.html#datacolor", "extsnd.html#dataformat",
- "extsnd.html#datalocation", "extsnd.html#datasize", "sndclm.html#dbtolinear", "extsnd.html#defaultoutputchans",
- "extsnd.html#defaultoutputdataformat", "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsrate", "sndclm.html#defgenerator",
- "s7.html#definestar", "s7.html#defineconstant", "extsnd.html#defineenvelope", "s7.html#definemacro",
- "s7.html#definemacrostar", "sndscm.html#defineselectionviamarks", "sndscm.html#definstrument", "extsnd.html#defvar",
- "sndclm.html#degreestoradians", "sndclm.html#delay", "sndscm.html#delaychannelmixes", "sndclm.html#delaytick",
- "sndclm.html#delay?", "extsnd.html#deletecolormap", "extsnd.html#deletefilefilter", "extsnd.html#deletefilesorter",
- "extsnd.html#deletemark", "extsnd.html#deletemarks", "extsnd.html#deletesample", "extsnd.html#deletesamples",
- "extsnd.html#deletesamplesandsmooth", "extsnd.html#deleteselection", "extsnd.html#deleteselectionandsmooth", "extsnd.html#deletetransform",
- "sndscm.html#describehook", "sndscm.html#describemark", "extsnd.html#dialogwidgets", "sndscm.html#disablecontrolpanel",
- "sndscm.html#displaybarkfft", "sndscm.html#displaydb", "extsnd.html#displayedits", "sndscm.html#displayscannedsynthesis",
- "sndscm.html#dissolvefade", "sndscm.html#ditherchannel", "sndscm.html#dithersound", "sndscm.html#dlocsig",
- "sndclm.html#dot-product", "extsnd.html#dotsize", "extsnd.html#drawaxes", "extsnd.html#drawdot",
- "extsnd.html#drawdots", "extsnd.html#drawline", "extsnd.html#drawlines", "extsnd.html#drawmarkhook",
- "extsnd.html#drawmixhook", "extsnd.html#drawstring", "sndscm.html#makedropsite", "extsnd.html#drophook",
- "extsnd.html#duringopenhook", "extsnd.html#editfragment", "extsnd.html#editheaderdialog", "extsnd.html#edithook",
- "extsnd.html#editlisttofunction", "extsnd.html#editposition", "extsnd.html#editproperties", "extsnd.html#editproperty",
- "extsnd.html#edittree", "extsnd.html#edits", "sndclm.html#edot-product", "extsnd.html#effectshook",
- "sndscm.html#analogfilterdoc", "sndclm.html#env", "sndclm.html#env-any", "extsnd.html#envchannel",
- "extsnd.html#envchannelwithbase", "sndscm.html#envexptchannel", "sndclm.html#env-interp", "sndscm.html#envmixes",
- "extsnd.html#envselection", "extsnd.html#envsound", "sndscm.html#envsoundinterp", "sndclm.html#env?",
+ "extsnd.html#convolveselectionwith", "extsnd.html#convolvewith", "sndclm.html#convolve?", "s7.html#s7copy",
+ "extsnd.html#copycontext", "extsnd.html#copysampler", "sndclm.html#correlate", "s7.html#coverlet",
+ "sndscm.html#mixdoc", "sndscm.html#fadedoc", "sndscm.html#crosssynthesis", "s7.html#curlet",
+ "extsnd.html#currentfont", "extsnd.html#cursor", "extsnd.html#cursorcolor", "extsnd.html#cursorcontext",
+ "extsnd.html#cursorlocationoffset", "extsnd.html#cursorposition", "extsnd.html#cursorsize", "extsnd.html#cursorstyle",
+ "extsnd.html#cursorupdateinterval", "s7.html#cutlet", "s7.html#cyclicsequences", "extsnd.html#dacfolding",
+ "extsnd.html#dacsize", "extsnd.html#datacolor", "extsnd.html#datalocation", "extsnd.html#datasize",
+ "sndclm.html#dbtolinear", "extsnd.html#defaultoutputchans", "extsnd.html#defaultoutputheadertype", "extsnd.html#defaultoutputsampletype",
+ "extsnd.html#defaultoutputsrate", "sndclm.html#defgenerator", "s7.html#definestar", "s7.html#defineconstant",
+ "extsnd.html#defineenvelope", "s7.html#expansion", "s7.html#definemacro", "s7.html#definemacrostar",
+ "sndscm.html#defineselectionviamarks", "s7.html#definedp", "sndclm.html#degreestoradians", "sndclm.html#delay",
+ "sndscm.html#delaychannelmixes", "sndclm.html#delaytick", "sndclm.html#delay?", "extsnd.html#deletecolormap",
+ "extsnd.html#deletefilefilter", "extsnd.html#deletefilesorter", "extsnd.html#deletemark", "extsnd.html#deletemarks",
+ "extsnd.html#deletesample", "extsnd.html#deletesamples", "extsnd.html#deletesamplesandsmooth", "extsnd.html#deleteselection",
+ "extsnd.html#deleteselectionandsmooth", "extsnd.html#deletetransform", "sndscm.html#describehook", "sndscm.html#describemark",
+ "sndscm.html#dht", "extsnd.html#dialogwidgets", "s7.html#dilambda", "sndscm.html#disablecontrolpanel",
+ "sndscm.html#displaybarkfft", "sndscm.html#displaycorrelation", "sndscm.html#displaydb", "extsnd.html#displayedits",
+ "sndscm.html#displayenergy", "sndscm.html#dissolvefade", "sndscm.html#ditherchannel", "sndscm.html#dithersound",
+ "sndscm.html#dolph", "sndclm.html#dot-product", "extsnd.html#dotsize", "sndscm.html#downoct",
+ "extsnd.html#drawaxes", "extsnd.html#drawdot", "extsnd.html#drawdots", "extsnd.html#drawline",
+ "extsnd.html#drawlines", "extsnd.html#drawmarkhook", "extsnd.html#drawmixhook", "extsnd.html#drawstring",
+ "sndscm.html#drone", "sndscm.html#makedropsite", "extsnd.html#drophook", "extsnd.html#duringopenhook",
+ "extsnd.html#editfragment", "extsnd.html#editheaderdialog", "extsnd.html#edithook", "extsnd.html#editlisttofunction",
+ "extsnd.html#editposition", "extsnd.html#editproperties", "extsnd.html#editproperty", "extsnd.html#edittree",
+ "extsnd.html#edits", "sndclm.html#edot-product", "extsnd.html#effectshook", "sndscm.html#analogfilterdoc",
+ "sndclm.html#env", "sndclm.html#env-any", "extsnd.html#envchannel", "extsnd.html#envchannelwithbase",
+ "sndscm.html#envexptchannel", "sndclm.html#env-interp", "sndscm.html#envmixes", "extsnd.html#envselection",
+ "extsnd.html#envsound", "sndscm.html#envsoundinterp", "sndscm.html#envsquaredchannel", "sndclm.html#env?",
"extsnd.html#envedbase", "extsnd.html#envedclipping", "extsnd.html#enveddialog", "extsnd.html#envedenvelope",
"extsnd.html#filterenv", "extsnd.html#filterenvorder", "extsnd.html#envedhook", "extsnd.html#envedin-dB",
"extsnd.html#envedpower", "extsnd.html#envedstyle", "extsnd.html#envedtarget", "extsnd.html#envedwaving",
- "extsnd.html#envedwaveformcolor", "sndscm.html#envelopeinterp", "sndscm.html#envelopedmix", "extsnd.html#epsbottommargin",
- "extsnd.html#epsfile", "extsnd.html#epsleftmargin", "extsnd.html#epssize", "s7.html#errorhook",
- "s7.html#errorinfo", "sndscm.html#evalbetweenmarks", "sndscm.html#evaloverselection", "sndscm.html#everysample",
- "extsnd.html#exit", "extsnd.html#exithook", "extsnd.html#expandcontrol", "extsnd.html#expandcontrolbounds",
- "extsnd.html#expandcontrolhop", "extsnd.html#expandcontroljitter", "extsnd.html#expandcontrollength", "extsnd.html#expandcontrolramp",
- "extsnd.html#expandcontrolp", "sndscm.html#explodesf2", "sndclm.html#exponentially-weighted-moving-average", "extsnd.html#extractchannel",
- "extsnd.html#extractchannels", "s7.html#featureslist", "sndscm.html#cellon", "extsnd.html#fft",
- "snd.html#fftsize", "sndscm.html#fftedit", "extsnd.html#fftlogfrequency", "extsnd.html#fftlogmagnitude",
- "sndscm.html#fftsmoother", "sndscm.html#fftsquelch", "extsnd.html#fftwindow", "extsnd.html#fftalpha",
- "extsnd.html#fftbeta", "extsnd.html#fftwithphases", "sndscm.html#nbdoc", "sndclm.html#filetoarray",
- "sndclm.html#filetoframe", "sndclm.html#filetoframe?", "sndclm.html#filetosample", "sndclm.html#filetosample?",
- "sndscm.html#filetosounddata", "sndscm.html#filetovct", "extsnd.html#filename", "extsnd.html#fillpolygon",
- "extsnd.html#fillrectangle", "sndclm.html#filter", "extsnd.html#filterchannel", "extsnd.html#filtercontrolcoeffs",
- "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB", "extsnd.html#filtercontrolinhz", "extsnd.html#filtercontrolorder",
- "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp", "extsnd.html#filterselection", "sndscm.html#filterselectionandsmooth",
- "extsnd.html#filtersound", "sndclm.html#filter?", "sndclm.html#filtered-comb", "sndclm.html#filtered-comb?",
- "extsnd.html#findchannel", "extsnd.html#finddialog", "extsnd.html#findmark", "sndscm.html#findmix",
- "extsnd.html#findsound", "extsnd.html#finishprogressreport", "sndclm.html#fir-filter", "sndclm.html#fir-filter?",
- "sndclm.html#firmant", "sndclm.html#firmant?", "sndclm.html#flocsig", "sndclm.html#flocsig?",
- "sndscm.html#stereoflute", "sndscm.html#fmbell", "sndscm.html#fmdrum", "sndscm.html#fmnoise",
- "sndscm.html#fmvox", "sndscm.html#fmtrumpet", "sndscm.html#vdoc", "sndscm.html#reson",
- "extsnd.html#focuswidget", "sndscm.html#fofins", "sndscm.html#foreachchild", "sndscm.html#foreachsoundfile",
- "sndscm.html#fp", "extsnd.html#foregroundcolor", "extsnd.html#forgetregion", "sndclm.html#formant",
- "sndclm.html#formant?", "s7.html#format", "extsnd.html#fouriertransform", "sndscm.html#fractionalfouriertransform",
- "sndclm.html#frame1", "sndclm.html#frame*", "sndclm.html#frame+", "sndclm.html#frametofile",
- "sndclm.html#frametofile?", "sndclm.html#frametoframe", "sndclm.html#frametolist", "sndclm.html#frametosample",
- "sndscm.html#frametosound", "sndscm.html#frametosounddata", "sndscm.html#frametovct", "sndscm.html#framecopy",
- "sndscm.html#framereaderatendQ", "sndscm.html#framereaderchans", "sndscm.html#framereaderhome", "sndscm.html#framereaderposition",
- "sndscm.html#framereaderQ", "sndclm.html#frame-ref", "sndscm.html#framereverse", "sndclm.html#frame-set!",
- "sndclm.html#frame?", "extsnd.html#frames", "sndscm.html#freeframereader", "extsnd.html#freeplayer",
- "extsnd.html#freesampler", "sndscm.html#freeverb", "sndscm.html#fullmix", "sndscm.html#gaussiandistribution",
- "extsnd.html#gcoff", "extsnd.html#gcon", "s7.html#gensym", "extsnd.html#glgraphtops",
- "s7.html#globalenvironment", "extsnd.html#glspectrogram", "sndscm.html#goertzel", "extsnd.html#gotolistenerend",
- "s7.html#grablock", "sndscm.html#grani", "sndclm.html#granulate", "sndclm.html#granulate?",
+ "extsnd.html#envedwaveformcolor", "sndclm.html#envelopeinterp", "sndscm.html#envelopedmix", "sndclm.html#eoddcos",
+ "sndclm.html#eoddcos?", "extsnd.html#epsbottommargin", "extsnd.html#epsfile", "extsnd.html#epsleftmargin",
+ "extsnd.html#epssize", "sndclm.html#ercos", "sndclm.html#ercos?", "s7.html#errorhook",
+ "sndclm.html#erssb", "sndclm.html#erssb?", "sndclm.html#evenmultiple", "sndclm.html#evenweight",
+ "sndscm.html#everysample", "extsnd.html#exit", "extsnd.html#exithook", "extsnd.html#expandcontrol",
+ "extsnd.html#expandcontrolbounds", "extsnd.html#expandcontrolhop", "extsnd.html#expandcontroljitter", "extsnd.html#expandcontrollength",
+ "extsnd.html#expandcontrolramp", "extsnd.html#expandcontrolp", "sndscm.html#explodesf2", "sndclm.html#exponentially-weighted-moving-average",
+ "sndscm.html#expsnd", "sndscm.html#expsrc", "s7.html#featureslist", "sndscm.html#cellon",
+ "extsnd.html#fft", "sndscm.html#fftcancel", "sndscm.html#fftedit", "sndscm.html#fftenvedit",
+ "sndscm.html#fftenvinterp", "extsnd.html#fftlogfrequency", "extsnd.html#fftlogmagnitude", "sndscm.html#fftsmoother",
+ "sndscm.html#fftsquelch", "extsnd.html#fftwindow", "extsnd.html#fftalpha", "extsnd.html#fftbeta",
+ "extsnd.html#fftwithphases", "sndscm.html#nbdoc", "sndclm.html#filetoarray", "sndclm.html#filetoframple",
+ "sndclm.html#filetoframple?", "sndclm.html#filetosample", "sndclm.html#filetosample?", "extsnd.html#filename",
+ "s7.html#fillb", "extsnd.html#fillpolygon", "extsnd.html#fillrectangle", "sndclm.html#filter",
+ "extsnd.html#filterchannel", "extsnd.html#filtercontrolcoeffs", "extsnd.html#filtercontrolenvelope", "extsnd.html#filtercontrolindB",
+ "extsnd.html#filtercontrolinhz", "extsnd.html#filtercontrolorder", "extsnd.html#filterwaveformcolor", "extsnd.html#filtercontrolp",
+ "sndscm.html#filterfft", "extsnd.html#filterselection", "sndscm.html#filterselectionandsmooth", "extsnd.html#filtersound",
+ "sndclm.html#filter?", "sndclm.html#filtered-comb", "sndclm.html#filteredcombbank", "sndclm.html#filteredcombbankp",
+ "sndclm.html#filtered-comb?", "extsnd.html#finddialog", "extsnd.html#findmark", "sndscm.html#findmix",
+ "extsnd.html#findsound", "sndscm.html#finfo", "extsnd.html#finishprogressreport", "sndclm.html#fir-filter",
+ "sndclm.html#fir-filter?", "sndclm.html#firmant", "sndclm.html#firmant?", "sndscm.html#fitselectionbetweenmarks",
+ "sndscm.html#flattenpartials", "extsnd.html#fv", "extsnd.html#fvtimes", "extsnd.html#fvplus",
+ "extsnd.html#fvtochannel", "extsnd.html#fvtolist", "extsnd.html#fvtostring", "extsnd.html#fvabs",
+ "extsnd.html#fvadd", "extsnd.html#fvcopy", "extsnd.html#fvequal", "extsnd.html#fvfill",
+ "extsnd.html#fvlength", "extsnd.html#fvmax", "extsnd.html#fvmin", "extsnd.html#fvmove",
+ "extsnd.html#fvmultiply", "extsnd.html#fvoffset", "extsnd.html#fvpeak", "sndscm.html#vctpolynomial",
+ "extsnd.html#fvref", "extsnd.html#fvreverse", "extsnd.html#fvscale", "extsnd.html#fvset",
+ "extsnd.html#fvsubseq", "extsnd.html#fvsubtract", "extsnd.html#fvp", "sndclm.html#flocsig",
+ "sndclm.html#flocsig?", "sndscm.html#stereoflute", "sndscm.html#fmbell", "sndscm.html#fmdrum",
+ "sndscm.html#fmnoise", "sndscm.html#fmparallelcomponent", "sndscm.html#fmvox", "sndscm.html#fmtrumpet",
+ "sndscm.html#vdoc", "sndscm.html#fmvoice", "sndclm.html#fmssb", "sndclm.html#fmssb?",
+ "extsnd.html#focuswidget", "sndscm.html#fofins", "sndscm.html#fofins", "sndscm.html#foreachchild",
+ "sndscm.html#foreachsoundfile", "sndscm.html#fp", "extsnd.html#foregroundcolor", "extsnd.html#forgetregion",
+ "sndclm.html#formant", "sndclm.html#formantbank", "sndclm.html#formantbankp", "sndclm.html#formant?",
+ "s7.html#format", "sndscm.html#fp", "sndscm.html#fractionalfouriertransform", "sndclm.html#frampletofile",
+ "sndclm.html#frampletofile?", "sndclm.html#frampletoframple", "extsnd.html#framples", "extsnd.html#freeplayer",
+ "extsnd.html#freesampler", "sndscm.html#freeverb", "sndscm.html#fullmix", "s7.html#funclet",
+ "sndscm.html#gaussiandistribution", "extsnd.html#gcoff", "extsnd.html#gcon", "s7.html#gensym",
+ "s7.html#gensym?", "extsnd.html#glgraphtops", "extsnd.html#glspectrogram", "sndscm.html#goertzel",
+ "extsnd.html#gotolistenerend", "sndscm.html#grani", "sndclm.html#granulate", "sndclm.html#granulate?",
"sndscm.html#granulatedsoundinterp", "extsnd.html#graph", "extsnd.html#graphtops", "extsnd.html#graphcolor",
- "extsnd.html#graphcursor", "extsnd.html#graphdata", "extsnd.html#graphhook", "extsnd.html#graphlines",
- "extsnd.html#graphstyle", "sndscm.html#grapheq", "extsnd.html#graphshorizontal", "sndclm.html#green-noise",
- "sndclm.html#green-noise-interp", "extsnd.html#griddensity", "sndscm.html#harmonicizer", "sndscm.html#dht",
- "s7.html#hashtable", "extsnd.html#headertype", "sndscm.html#hellodentist", "extsnd.html#helpdialog",
- "extsnd.html#helphook", "extsnd.html#hidewidget", "extsnd.html#highlightcolor", "sndscm.html#hilberttransform",
- "s7.html#hook", "s7.html#hookarity", "s7.html#hookfunctions", "sndscm.html#hookmember",
- "extsnd.html#htmldir", "extsnd.html#htmlprogram", "sndclm.html#hztoradians", "sndclm.html#iir-filter",
- "sndclm.html#iir-filter?", "extsnd.html#gin", "sndclm.html#in-any", "sndclm.html#ina",
- "sndclm.html#inb", "extsnd.html#infodialog", "grfsnd.html#initladspa", "extsnd.html#initialbeg",
- "extsnd.html#initialdur", "extsnd.html#initialgraphhook", "sndscm.html#insertchannel", "extsnd.html#insertfiledialog",
- "sndscm.html#insertframe", "extsnd.html#insertregion", "extsnd.html#insertsample", "extsnd.html#insertsamples",
- "extsnd.html#insertselection", "extsnd.html#insertsilence", "extsnd.html#insertsound", "sndscm.html#insertsounddata",
- "sndscm.html#insertvct", "sndclm.html#instruments", "extsnd.html#integertocolormap", "extsnd.html#integertomark",
- "extsnd.html#integertomix", "extsnd.html#integertoregion", "extsnd.html#integertosound", "extsnd.html#integertotransform",
- "sndscm.html#integrateenvelope", "sndscm.html#jcreverb", "s7.html#jointhread", "extsnd.html#justsounds",
- "sndscm.html#kalmanfilterchannel", "extsnd.html#key", "extsnd.html#keybinding", "extsnd.html#keypresshook",
- "grfsnd.html#ladspadescriptor", "extsnd.html#ladspadir", "s7.html#lambdastar", "extsnd.html#leftsample",
- "sndscm.html#makelevelmeter", "sndclm.html#lineartodb", "sndscm.html#linearsrcchannel", "extsnd.html#lispgraphhook",
- "extsnd.html#lispgraphstyle", "extsnd.html#lispgraphp", "extsnd.html#listtovct", "grfsnd.html#listladspa",
- "extsnd.html#listenerclickhook", "extsnd.html#listenercolor", "extsnd.html#listenerfont", "extsnd.html#listenerprompt",
- "extsnd.html#listenerselection", "extsnd.html#listenertextcolor", "extsnd.html#littleendianp", "s7.html#loadhook",
- "s7.html#loadpath", "sndclm.html#locsig", "sndclm.html#locsig-ref", "sndclm.html#locsig-reverb-ref",
+ "extsnd.html#graphcursor", "extsnd.html#graphdata", "extsnd.html#graphhook", "extsnd.html#graphstyle",
+ "sndscm.html#grapheq", "extsnd.html#graphshorizontal", "sndclm.html#green-noise", "sndclm.html#green-noise-interp",
+ "sndclm.html#green-noise-interp?", "sndclm.html#green-noise?", "extsnd.html#griddensity", "sndscm.html#harmonicizer",
+ "sndscm.html#dht", "s7.html#hashtable", "s7.html#hashtablestar", "s7.html#hashtableentries",
+ "s7.html#hashtableref", "s7.html#hashtableset", "s7.html#hashtablep", "extsnd.html#headertype",
+ "sndscm.html#hellodentist", "extsnd.html#helpdialog", "extsnd.html#helphook", "extsnd.html#hidewidget",
+ "extsnd.html#highlightcolor", "sndscm.html#hilberttransform", "s7.html#hookfunctions", "sndscm.html#hookmember",
+ "sndscm.html#html", "extsnd.html#htmldir", "extsnd.html#htmlprogram", "sndclm.html#hztoradians",
+ "sndclm.html#iir-filter", "sndclm.html#iir-filter?", "extsnd.html#gin", "sndclm.html#in-any",
+ "sndclm.html#ina", "sndclm.html#inb", "extsnd.html#infodialog", "grfsnd.html#initladspa",
+ "extsnd.html#initialbeg", "extsnd.html#initialdur", "extsnd.html#initialgraphhook", "s7.html#inlet",
+ "sndscm.html#insertchannel", "extsnd.html#insertfiledialog", "extsnd.html#insertregion", "extsnd.html#insertsample",
+ "extsnd.html#insertsamples", "extsnd.html#insertselection", "extsnd.html#insertsilence", "extsnd.html#insertsound",
+ "s7.html#intvector", "s7.html#intvectorref", "s7.html#intvectorset", "s7.html#intvectorp",
+ "extsnd.html#integertocolormap", "extsnd.html#integertomark", "extsnd.html#integertomix", "extsnd.html#integertoregion",
+ "extsnd.html#integertosound", "extsnd.html#integertotransform", "sndscm.html#integrateenvelope", "sndscm.html#invertfilter",
+ "s7.html#iterate", "s7.html#iteratoratend", "s7.html#iteratorsequence", "s7.html#iteratorp",
+ "sndclm.html#izcos", "sndclm.html#izcos?", "sndclm.html#j0evencos", "sndclm.html#j0evencos?",
+ "sndclm.html#j0j1cos", "sndclm.html#j0j1cos?", "sndclm.html#j2cos", "sndclm.html#j2cos?",
+ "sndscm.html#jcreverb", "sndclm.html#jjcos", "sndclm.html#jjcos?", "sndclm.html#jncos",
+ "sndclm.html#jncos?", "sndclm.html#jpcos", "sndclm.html#jpcos?", "extsnd.html#justsounds",
+ "sndclm.html#jycos", "sndclm.html#jycos?", "sndclm.html#k2cos", "sndclm.html#k2cos?",
+ "sndclm.html#k2sin", "sndclm.html#k2sin?", "sndclm.html#k2ssb", "sndclm.html#k2ssb?",
+ "sndclm.html#k3sin", "sndclm.html#k3sin?", "sndscm.html#kalmanfilterchannel", "extsnd.html#key",
+ "extsnd.html#keybinding", "extsnd.html#keypresshook", "sndclm.html#krksin", "sndclm.html#krksin?",
+ "grfsnd.html#ladspadescriptor", "extsnd.html#ladspadir", "s7.html#lambdastar", "sndscm.html#lbjpiano",
+ "extsnd.html#leftsample", "s7.html#lettolist", "s7.html#letref", "s7.html#letset",
+ "s7.html#letp", "sndclm.html#lineartodb", "sndscm.html#linearsrcchannel", "sndscm.html#lintdoc",
+ "extsnd.html#lispgraphhook", "extsnd.html#lispgraphstyle", "extsnd.html#lispgraphp", "extsnd.html#listtofv",
+ "extsnd.html#listtovct", "grfsnd.html#listladspa", "extsnd.html#listenerclickhook", "extsnd.html#listenercolor",
+ "extsnd.html#listenercolorized", "extsnd.html#listenerfont", "extsnd.html#listenerprompt", "extsnd.html#listenerselection",
+ "extsnd.html#listenertextcolor", "extsnd.html#littleendianp", "s7.html#loadhook", "s7.html#loadpath",
+ "sndscm.html#locatezero", "sndclm.html#locsig", "sndclm.html#locsig-ref", "sndclm.html#locsig-reverb-ref",
"sndclm.html#locsig-reverb-set!", "sndclm.html#locsig-set!", "sndclm.html#locsig-type", "sndclm.html#locsig?",
- "extsnd.html#logfreqstart", "sndscm.html#loopbetweenmarks", "sndscm.html#lpccoeffs", "sndscm.html#lpcpredict",
- "s7.html#macrop", "s7.html#macroexpand", "extsnd.html#mainmenu", "extsnd.html#mainwidgets",
- "sndclm.html#make-all-pass", "sndclm.html#make-asymmetric-fm", "sndscm.html#makebandpass", "sndscm.html#makebandstop",
- "sndscm.html#makebiquad", "sndscm.html#makebirds", "extsnd.html#makecolor", "sndclm.html#make-comb",
+ "extsnd.html#logfreqstart", "sndscm.html#lpccoeffs", "sndscm.html#lpcpredict", "s7.html#macrop",
+ "s7.html#macroexpand", "extsnd.html#mainmenu", "extsnd.html#mainwidgets", "sndclm.html#make-abcos",
+ "sndclm.html#make-absin", "sndclm.html#make-adjustable-sawtooth-wave", "sndclm.html#make-adjustable-square-wave", "sndclm.html#make-adjustable-triangle-wave",
+ "sndclm.html#make-all-pass", "sndclm.html#makeallpassbank", "sndclm.html#make-asyfm", "sndclm.html#make-asymmetric-fm",
+ "sndscm.html#makebandpass", "sndscm.html#makebandstop", "sndclm.html#make-bess", "sndscm.html#makebiquad",
+ "sndscm.html#makebirds", "sndclm.html#make-blackman", "sndclm.html#make-brown-noise", "s7.html#makebytevector",
+ "sndscm.html#makedropsite", "extsnd.html#makecolor", "sndclm.html#make-comb", "sndclm.html#makecombbank",
"sndclm.html#make-convolve", "sndclm.html#make-delay", "sndscm.html#makedifferentiator", "sndclm.html#make-env",
- "sndclm.html#make-fft-window", "sndclm.html#make-filetoframe", "sndclm.html#make-filetosample", "sndclm.html#make-filter",
- "sndclm.html#make-filtered-comb", "sndclm.html#make-fir-coeffs", "sndclm.html#make-fir-filter", "sndclm.html#make-firmant",
- "sndclm.html#make-flocsig", "sndclm.html#make-formant", "sndclm.html#make-frame", "sndclm.html#make-frame!",
- "sndclm.html#make-frametofile", "sndscm.html#makeframereader", "sndclm.html#make-granulate", "extsnd.html#makegraphdata",
- "s7.html#makehashtable", "sndscm.html#makehighpass", "sndscm.html#makehilberttransform", "s7.html#makehook",
- "sndclm.html#make-iir-filter", "s7.html#makelock", "sndclm.html#make-locsig", "sndscm.html#makelowpass",
- "extsnd.html#makemixsampler", "sndclm.html#make-mixer", "sndclm.html#make-mixer!", "sndclm.html#make-move-sound",
- "sndclm.html#make-moving-autocorrelation", "sndclm.html#make-moving-average", "sndclm.html#make-moving-fft", "sndclm.html#make-moving-pitch",
- "sndclm.html#make-moving-scentroid", "sndclm.html#make-moving-spectrum", "sndclm.html#make-ncos", "sndclm.html#make-noid",
- "sndclm.html#make-notch", "sndclm.html#make-nrxycos", "sndclm.html#make-nrxysin", "sndclm.html#make-nsin",
- "sndclm.html#make-one-pole", "sndclm.html#make-one-zero", "sndclm.html#make-oscil", "sndclm.html#make-phase-vocoder",
- "sndscm.html#makepixmap", "extsnd.html#makeplayer", "sndclm.html#make-polyoid", "sndclm.html#make-polyshape",
- "sndclm.html#make-polywave", "sndclm.html#make-pulse-train", "sndclm.html#make-rand", "sndclm.html#make-rand-interp",
- "s7.html#makerandomstate", "sndclm.html#make-readin", "extsnd.html#makeregion", "sndscm.html#makeregionframereader",
- "extsnd.html#makeregionsampler", "sndclm.html#make-sampletofile", "extsnd.html#makesampler", "sndclm.html#make-sawtooth-wave",
- "sndclm.html#make-scalar-mixer", "sndscm.html#makeselection", "sndscm.html#makeselectionframereader", "extsnd.html#makesndtosample",
- "sndscm.html#makesoundbox", "extsnd.html#makesounddata", "sndclm.html#make-square-wave", "sndclm.html#make-src",
- "sndclm.html#make-ssb-am", "sndscm.html#makesyncframereader", "sndclm.html#make-table-lookup", "s7.html#makethread",
- "s7.html#makethreadvariable", "sndclm.html#make-triangle-wave", "sndclm.html#make-two-pole", "sndclm.html#make-two-zero",
- "s7.html#maketype", "sndscm.html#makevariabledisplay", "extsnd.html#makevariablegraph", "extsnd.html#makevct",
- "sndclm.html#make-wave-train", "extsnd.html#mapchannel", "sndscm.html#mapsound", "sndscm.html#mapsoundfiles",
- "sndscm.html#maracadoc", "extsnd.html#marktointeger", "extsnd.html#markclickhook", "extsnd.html#markcolor",
+ "sndclm.html#make-eoddcos", "sndclm.html#make-ercos", "sndclm.html#make-erssb", "sndclm.html#make-fft-window",
+ "sndclm.html#make-filetoframple", "sndclm.html#make-filetosample", "sndclm.html#make-filter", "sndclm.html#make-filtered-comb",
+ "sndclm.html#makefilteredcombbank", "sndclm.html#make-fir-coeffs", "sndclm.html#make-fir-filter", "sndclm.html#make-firmant",
+ "extsnd.html#makefv", "sndclm.html#make-flocsig", "sndclm.html#make-fmssb", "sndclm.html#make-formant",
+ "sndclm.html#makeformantbank", "sndclm.html#make-frampletofile", "sndclm.html#make-granulate", "extsnd.html#makegraphdata",
+ "sndclm.html#make-green-noise", "sndclm.html#make-green-noise-interp", "s7.html#makehashtable", "sndscm.html#makehighpass",
+ "sndscm.html#makehilberttransform", "s7.html#makehook", "sndclm.html#make-iir-filter", "s7.html#makeintvector",
+ "s7.html#makeiterator", "sndclm.html#make-izcos", "sndclm.html#make-j0evencos", "sndclm.html#make-j0j1cos",
+ "sndclm.html#make-j2cos", "sndclm.html#make-jjcos", "sndclm.html#make-jncos", "sndclm.html#make-jpcos",
+ "sndclm.html#make-jycos", "sndclm.html#make-k2cos", "sndclm.html#make-k2sin", "sndclm.html#make-k2ssb",
+ "sndclm.html#make-k3sin", "sndclm.html#make-krksin", "sndclm.html#make-locsig", "sndscm.html#makelowpass",
+ "extsnd.html#makemixsampler", "sndclm.html#make-move-sound", "sndclm.html#make-moving-autocorrelation", "sndclm.html#make-moving-average",
+ "sndclm.html#make-moving-fft", "sndclm.html#make-moving-max", "sndclm.html#make-moving-norm", "sndclm.html#make-moving-pitch",
+ "sndclm.html#make-moving-scentroid", "sndclm.html#make-moving-spectrum", "sndclm.html#make-n1cos", "sndclm.html#make-nchoosekcos",
+ "sndclm.html#make-ncos", "sndclm.html#make-nkssb", "sndclm.html#make-noddcos", "sndclm.html#make-noddsin",
+ "sndclm.html#make-noddssb", "sndclm.html#make-noid", "sndclm.html#make-notch", "sndclm.html#make-nrcos",
+ "sndclm.html#make-nrsin", "sndclm.html#make-nrssb", "sndclm.html#make-nrxycos", "sndclm.html#make-nrxysin",
+ "sndclm.html#make-nsin", "sndclm.html#make-nsincos", "sndclm.html#make-nssb", "sndclm.html#make-nxy1cos",
+ "sndclm.html#make-nxy1sin", "sndclm.html#make-nxycos", "sndclm.html#make-nxysin", "sndclm.html#make-one-pole",
+ "sndclm.html#make-one-pole-all-pass", "sndclm.html#make-one-zero", "sndclm.html#make-oscil", "sndclm.html#make-oscil-bank",
+ "sndclm.html#make-phase-vocoder", "sndclm.html#make-pink-noise", "sndscm.html#makepixmap", "extsnd.html#makeplayer",
+ "sndclm.html#make-polyoid", "sndclm.html#make-polyshape", "sndclm.html#make-polywave", "sndclm.html#make-pulse-train",
+ "sndclm.html#make-pulsed-env", "sndclm.html#make-r2k!cos", "sndclm.html#make-r2k2cos", "sndscm.html#makeramp",
+ "sndclm.html#make-rand", "sndclm.html#make-rand-interp", "sndclm.html#make-rcos", "sndclm.html#make-readin",
+ "extsnd.html#makeregion", "extsnd.html#makeregionsampler", "sndclm.html#make-rk!cos", "sndclm.html#make-rk!ssb",
+ "sndclm.html#make-rkcos", "sndclm.html#make-rkoddssb", "sndclm.html#make-rksin", "sndclm.html#make-rkssb",
+ "sndclm.html#make-round-interp", "sndclm.html#make-rssb", "sndclm.html#make-rxycos", "sndclm.html#make-rxyk!cos",
+ "sndclm.html#make-rxyk!sin", "sndclm.html#make-rxysin", "sndclm.html#make-sampletofile", "extsnd.html#makesampler",
+ "sndclm.html#make-sawtooth-wave", "sndscm.html#makeselection", "sndclm.html#make-sinc-train", "extsnd.html#makesndtosample",
+ "sndscm.html#makesoundbox", "sndscm.html#makespencerfilter", "sndclm.html#make-square-wave", "sndclm.html#make-src",
+ "sndclm.html#make-ssb-am", "sndclm.html#make-table-lookup", "sndclm.html#make-table-lookup-with-env", "sndclm.html#make-tanhsin",
+ "sndclm.html#make-triangle-wave", "sndclm.html#make-two-pole", "sndclm.html#make-two-zero", "sndscm.html#makevariabledisplay",
+ "extsnd.html#makevariablegraph", "extsnd.html#makevct", "sndclm.html#make-wave-train", "sndclm.html#make-wave-train-with-env",
+ "extsnd.html#mapchannel", "sndscm.html#mapsoundfiles", "sndscm.html#maracadoc", "extsnd.html#marktointeger",
+ "extsnd.html#markclickhook", "sndscm.html#markclickinfo", "extsnd.html#markcolor", "extsnd.html#markcontext",
"extsnd.html#markdraghook", "sndscm.html#markexplode", "extsnd.html#markhome", "extsnd.html#markhook",
"sndscm.html#markloops", "extsnd.html#markname", "sndscm.html#marknametoid", "extsnd.html#markproperties",
- "extsnd.html#markproperty", "extsnd.html#marksample", "extsnd.html#marksync", "extsnd.html#marksyncmax",
- "extsnd.html#marktagheight", "extsnd.html#marktagwidth", "extsnd.html#markp", "extsnd.html#emarks",
- "sndscm.html#matchsoundfiles", "sndscm.html#maxenvelope", "extsnd.html#maxregions", "extsnd.html#maxfftpeaks",
- "extsnd.html#maxvirtualptrees", "extsnd.html#maxamp", "extsnd.html#maxampposition", "extsnd.html#menuwidgets",
- "sndscm.html#menusdoc", "extsnd.html#mindb", "extsnd.html#minibufferhistorylength", "extsnd.html#mix",
- "extsnd.html#mixtointeger", "sndscm.html#mixtovct", "extsnd.html#mixamp", "extsnd.html#mixampenv",
- "sndscm.html#mixchannel", "extsnd.html#mixclickhook", "extsnd.html#mixcolor", "extsnd.html#mixdialogmix",
- "extsnd.html#mixdraghook", "extsnd.html#mixfiledialog", "sndscm.html#mixframe", "extsnd.html#mixhome",
- "extsnd.html#mixlength", "sndscm.html#mixmaxamp", "extsnd.html#mixmovesound", "extsnd.html#mixname",
- "sndscm.html#mixnametoid", "extsnd.html#mixposition", "extsnd.html#mixproperties", "extsnd.html#mixproperty",
- "extsnd.html#mixregion", "extsnd.html#mixreleasehook", "extsnd.html#mixsamplerQ", "extsnd.html#mixselection",
- "sndscm.html#mixsound", "sndscm.html#mixsounddata", "extsnd.html#mixspeed", "extsnd.html#mixsync",
- "extsnd.html#mixsyncmax", "extsnd.html#mixtagheight", "extsnd.html#mixtagwidth", "extsnd.html#mixtagy",
- "extsnd.html#mixvct", "extsnd.html#mixwaveformheight", "extsnd.html#mixp", "sndclm.html#mixer1",
- "sndscm.html#mixerdoc", "sndclm.html#mixermultiply", "sndclm.html#mixeradd", "sndscm.html#mixercopy",
- "sndscm.html#mixer-determinant", "sndscm.html#mixer-inverse", "sndscm.html#mixer-poly", "sndclm.html#mixer-ref",
- "sndclm.html#mixer-set!", "sndscm.html#mixer-solve", "sndscm.html#mixer-transpose", "sndclm.html#mixer?",
- "extsnd.html#mixes", "sndscm.html#monotostereo", "sndscm.html#moogfilter", "extsnd.html#mouseclickhook",
- "extsnd.html#mousedraghook", "extsnd.html#mouseentergraphhook", "extsnd.html#mouseenterlabelhook", "extsnd.html#mouseenterlistenerhook",
- "extsnd.html#mouseentertexthook", "extsnd.html#mouseleavegraphhook", "extsnd.html#mouseleavelabelhook", "extsnd.html#mousleavelistenerhook",
- "extsnd.html#mousleavetexthook", "extsnd.html#mousepresshook", "sndclm.html#move-locsig", "sndscm.html#movemixes",
- "sndclm.html#move-sound", "sndclm.html#move-sound?", "sndclm.html#moving-autocorrelation", "sndclm.html#moving-autocorrelation?",
- "sndclm.html#moving-average", "sndclm.html#moving-average?", "sndclm.html#moving-fft", "sndclm.html#moving-fft?",
- "sndclm.html#moving-length", "sndclm.html#moving-max", "sndclm.html#moving-pitch", "sndclm.html#moving-pitch?",
- "sndclm.html#moving-rms", "sndclm.html#moving-scentroid", "sndclm.html#moving-scentroid?", "sndclm.html#moving-spectrum",
- "sndclm.html#moving-spectrum?", "sndclm.html#moving-sum", "sndscm.html#mpg", "sndclm.html#multiply-arrays",
- "extsnd.html#musalsabuffersize", "extsnd.html#musalsabuffers", "extsnd.html#musalsacapturedevice", "extsnd.html#musalsadevice",
- "extsnd.html#musalsaplaybackdevice", "extsnd.html#musalsasquelchwarning", "sndclm.html#musarrayprintlength", "extsnd.html#musaudioclose",
- "extsnd.html#musaudiodescribe", "extsnd.html#musaudioopeninput", "extsnd.html#musaudioopenoutput", "extsnd.html#musaudioread",
- "extsnd.html#musaudiowrite", "extsnd.html#musbytespersample", "sndclm.html#mus-channel", "sndclm.html#mus-channels",
- "sndclm.html#mus-chebyshev-tu-sum", "extsnd.html#musclipping", "sndclm.html#mus-close", "sndclm.html#mus-data",
- "extsnd.html#musdataformattostring", "extsnd.html#musdataformatname", "sndclm.html#mus-describe", "extsnd.html#muserrorhook",
- "extsnd.html#muserrortypetostring", "extsnd.html#musexpandfilename", "sndclm.html#mus-feedback", "sndclm.html#mus-feedforward",
- "extsnd.html#musfft", "sndclm.html#musfilebuffersize", "extsnd.html#musfileclipping", "sndclm.html#mus-file-name",
- "extsnd.html#musfileprescaler", "sndclm.html#musfloatequalfudgefactor", "sndclm.html#mus-frequency", "sndclm.html#musgeneratorp",
- "extsnd.html#musheaderrawdefaults", "extsnd.html#musheadertypetostring", "extsnd.html#musheadertypename", "sndclm.html#mus-hop",
- "sndclm.html#mus-increment", "sndclm.html#mus-input?", "sndclm.html#mus-interp-type", "sndclm.html#mus-interpolate",
- "sndclm.html#mus-length", "sndclm.html#mus-location", "extsnd.html#musmaxmalloc", "extsnd.html#musmaxtablesize",
- "sndscm.html#musmix", "sndclm.html#mus-name", "sndclm.html#mus-offset", "sndclm.html#mus-order",
- "extsnd.html#musosssetbuffers", "extsnd.html#musoutformat", "sndclm.html#mus-output?", "sndclm.html#mus-phase",
- "extsnd.html#musprescaler", "sndclm.html#mus-ramp", "sndclm.html#mus-random", "sndclm.html#mus-reset",
- "sndclm.html#mus-run", "sndclm.html#mus-safety", "sndclm.html#mus-scaler", "extsnd.html#mussoundchans",
- "extsnd.html#mussoundcloseinput", "extsnd.html#mussoundcloseoutput", "extsnd.html#mussoundcomment", "extsnd.html#mussounddataformat",
+ "extsnd.html#markproperty", "extsnd.html#marksample", "extsnd.html#marksync", "sndscm.html#marksynccolor",
+ "extsnd.html#marksyncmax", "extsnd.html#marktagheight", "extsnd.html#marktagwidth", "extsnd.html#markp",
+ "extsnd.html#emarks", "sndscm.html#matchsoundfiles", "sndscm.html#maxenvelope", "extsnd.html#maxregions",
+ "extsnd.html#maxfftpeaks", "extsnd.html#maxamp", "extsnd.html#maxampposition", "extsnd.html#menuwidgets",
+ "sndscm.html#menusdoc", "extsnd.html#mindb", "extsnd.html#mix", "sndscm.html#mixtovct",
+ "extsnd.html#mixtointeger", "extsnd.html#mixamp", "extsnd.html#mixampenv", "sndscm.html#mixchannel",
+ "extsnd.html#mixclickhook", "sndscm.html#mixclickinfo", "sndscm.html#mixclicksetsamp", "extsnd.html#mixcolor",
+ "extsnd.html#mixdialogmix", "extsnd.html#mixdraghook", "extsnd.html#mixfiledialog", "extsnd.html#mixhome",
+ "extsnd.html#mixlength", "sndscm.html#mixmaxamp", "extsnd.html#mixname", "sndscm.html#mixnametoid",
+ "extsnd.html#mixposition", "extsnd.html#mixproperties", "extsnd.html#mixproperty", "extsnd.html#mixregion",
+ "extsnd.html#mixreleasehook", "extsnd.html#mixsamplerQ", "extsnd.html#mixselection", "sndscm.html#mixsound",
+ "extsnd.html#mixspeed", "extsnd.html#mixsync", "extsnd.html#mixsyncmax", "extsnd.html#mixtagheight",
+ "extsnd.html#mixtagwidth", "extsnd.html#mixtagy", "extsnd.html#mixvct", "extsnd.html#mixwaveformheight",
+ "extsnd.html#mixp", "extsnd.html#mixes", "sndscm.html#monotostereo", "sndscm.html#moogfilter",
+ "s7.html#morallyequalp", "extsnd.html#mouseclickhook", "extsnd.html#mousedraghook", "extsnd.html#mouseentergraphhook",
+ "extsnd.html#mouseenterlabelhook", "extsnd.html#mouseenterlistenerhook", "extsnd.html#mouseentertexthook", "extsnd.html#mouseleavegraphhook",
+ "extsnd.html#mouseleavelabelhook", "extsnd.html#mousleavelistenerhook", "extsnd.html#mousleavetexthook", "extsnd.html#mousepresshook",
+ "sndclm.html#move-locsig", "sndscm.html#movemixes", "sndclm.html#move-sound", "sndclm.html#move-sound?",
+ "sndscm.html#movesyncdmarks", "sndclm.html#moving-autocorrelation", "sndclm.html#moving-autocorrelation?", "sndclm.html#moving-average",
+ "sndclm.html#moving-average?", "sndclm.html#moving-fft", "sndclm.html#moving-fft?", "sndclm.html#moving-length",
+ "sndclm.html#moving-max", "sndclm.html#moving-max?", "sndclm.html#moving-norm", "sndclm.html#moving-norm?",
+ "sndclm.html#moving-pitch", "sndclm.html#moving-pitch?", "sndclm.html#moving-rms", "sndclm.html#moving-scentroid",
+ "sndclm.html#moving-scentroid?", "sndclm.html#moving-spectrum", "sndclm.html#moving-spectrum?", "sndclm.html#moving-sum",
+ "sndscm.html#mpg", "extsnd.html#musalsabuffersize", "extsnd.html#musalsabuffers", "extsnd.html#musalsacapturedevice",
+ "extsnd.html#musalsadevice", "extsnd.html#musalsaplaybackdevice", "extsnd.html#musalsasquelchwarning", "sndclm.html#musarrayprintlength",
+ "extsnd.html#musbytespersample", "sndclm.html#mus-channel", "sndclm.html#mus-channels", "sndclm.html#mus-chebyshev-tu-sum",
+ "extsnd.html#musclipping", "sndclm.html#mus-close", "sndclm.html#mus-copy", "sndclm.html#mus-data",
+ "sndclm.html#mus-describe", "extsnd.html#muserrorhook", "extsnd.html#muserrortypetostring", "extsnd.html#musexpandfilename",
+ "sndclm.html#mus-feedback", "sndclm.html#mus-feedforward", "sndclm.html#fft", "sndclm.html#musfilebuffersize",
+ "extsnd.html#musfileclipping", "sndscm.html#musfilemix", "sndclm.html#mus-file-name", "sndclm.html#musfloatequalfudgefactor",
+ "sndclm.html#mus-frequency", "sndclm.html#musgeneratorp", "extsnd.html#musheaderrawdefaults", "extsnd.html#musheadertypetostring",
+ "extsnd.html#musheadertypename", "sndclm.html#mus-hop", "sndclm.html#mus-increment", "sndclm.html#mus-input?",
+ "sndclm.html#mus-interp-type", "sndclm.html#mus-interpolate", "sndclm.html#mus-length", "sndclm.html#mus-location",
+ "extsnd.html#musmaxmalloc", "extsnd.html#musmaxtablesize", "sndclm.html#mus-name", "sndclm.html#mus-offset",
+ "sndclm.html#mus-order", "extsnd.html#musosssetbuffers", "sndclm.html#mus-output?", "sndclm.html#mus-phase",
+ "sndclm.html#mus-ramp", "sndclm.html#mus-rand-seed", "sndclm.html#mus-random", "sndclm.html#mus-reset",
+ "sndclm.html#mus-run", "extsnd.html#mussampletypetostring", "extsnd.html#mussampletypename", "sndclm.html#mus-scaler",
+ "extsnd.html#mussoundchans", "extsnd.html#mussoundcloseinput", "extsnd.html#mussoundcloseoutput", "extsnd.html#mussoundcomment",
"extsnd.html#mussounddatalocation", "extsnd.html#mussounddatumsize", "extsnd.html#mussoundduration", "extsnd.html#mussoundforget",
- "extsnd.html#mussoundframes", "extsnd.html#mussoundheadertype", "extsnd.html#mussoundlength", "extsnd.html#mussoundloopinfo",
+ "extsnd.html#mussoundframples", "extsnd.html#mussoundheadertype", "extsnd.html#mussoundlength", "extsnd.html#mussoundloopinfo",
"extsnd.html#mussoundmarkinfo", "extsnd.html#mussoundmaxamp", "extsnd.html#mussoundmaxampexists", "extsnd.html#mussoundopeninput",
- "extsnd.html#mussoundopenoutput", "extsnd.html#mussoundprune", "extsnd.html#mussoundread", "extsnd.html#mussoundreopenoutput",
- "extsnd.html#mussoundreportcache", "extsnd.html#mussoundsamples", "extsnd.html#mussoundseekframe", "extsnd.html#mussoundsrate",
- "extsnd.html#mussoundtypespecifier", "extsnd.html#mussoundwrite", "extsnd.html#mussoundwritedate", "sndclm.html#mussrate",
- "sndclm.html#mus-width", "sndclm.html#mus-xcoeff", "sndclm.html#mus-xcoeffs", "sndclm.html#mus-ycoeff",
- "sndclm.html#mus-ycoeffs", "extsnd.html#nameclickhook", "sndclm.html#ncos", "sndclm.html#ncos?",
- "extsnd.html#newsound", "extsnd.html#newsounddialog", "extsnd.html#newsoundhook", "extsnd.html#newwidgethook",
- "sndscm.html#nextframe", "extsnd.html#nextsample", "sndclm.html#noid", "extsnd.html#normalizechannel",
- "sndscm.html#normalizeenvelope", "sndclm.html#normalizepartials", "sndscm.html#normalizesound", "sndscm.html#normalizedmix",
- "sndclm.html#notch", "sndscm.html#notchchannel", "sndscm.html#notchoutrumbleandhiss", "sndscm.html#notchselection",
- "sndscm.html#notchsound", "sndclm.html#notch?", "sndscm.html#nrev", "sndclm.html#nrxycos",
+ "extsnd.html#mussoundopenoutput", "extsnd.html#mussoundpath", "extsnd.html#mussoundpreload", "extsnd.html#mussoundprune",
+ "extsnd.html#mussoundread", "extsnd.html#mussoundreopenoutput", "extsnd.html#mussoundreportcache", "extsnd.html#mussoundsampletype",
+ "extsnd.html#mussoundsamples", "extsnd.html#mussoundseekframple", "extsnd.html#mussoundsrate", "extsnd.html#mussoundtypespecifier",
+ "extsnd.html#mussoundwrite", "extsnd.html#mussoundwritedate", "sndclm.html#mussrate", "sndclm.html#mus-width",
+ "sndclm.html#mus-xcoeff", "sndclm.html#mus-xcoeffs", "sndclm.html#mus-ycoeff", "sndclm.html#mus-ycoeffs",
+ "sndclm.html#n1cos", "sndclm.html#n1cos?", "extsnd.html#nameclickhook", "sndclm.html#nchoosekcos",
+ "sndclm.html#nchoosekcos?", "sndclm.html#ncos", "sndclm.html#ncos2?", "sndclm.html#ncos4?",
+ "sndclm.html#ncos?", "extsnd.html#newsound", "extsnd.html#newsounddialog", "extsnd.html#newsoundhook",
+ "extsnd.html#newwidgethook", "extsnd.html#nextsample", "sndclm.html#nkssb", "sndclm.html#nkssbinterp",
+ "sndclm.html#nkssb?", "sndclm.html#noddcos", "sndclm.html#noddcos?", "sndclm.html#noddsin",
+ "sndclm.html#noddsin?", "sndclm.html#noddssb", "sndclm.html#noddssb?", "sndclm.html#noid",
+ "extsnd.html#normalizechannel", "sndscm.html#normalizeenvelope", "sndclm.html#normalizepartials", "sndscm.html#normalizesound",
+ "sndscm.html#normalizedmix", "sndclm.html#notch", "sndscm.html#notchchannel", "sndscm.html#notchselection",
+ "sndscm.html#notchsound", "sndclm.html#notch?", "sndclm.html#npcos?", "sndclm.html#nrcos",
+ "sndclm.html#nrcos?", "sndscm.html#nrev", "sndclm.html#nrsin", "sndclm.html#nrsin?",
+ "sndclm.html#nrssb", "sndclm.html#nrssbinterp", "sndclm.html#nrssb?", "sndclm.html#nrxycos",
"sndclm.html#nrxycos?", "sndclm.html#nrxysin", "sndclm.html#nrxysin?", "sndclm.html#nsin",
- "sndclm.html#nsin?", "sndscm.html#offsetchannel", "sndscm.html#offsetsound", "sndclm.html#one-pole",
- "sndclm.html#one-pole?", "sndclm.html#one-zero", "sndclm.html#one-zero?", "extsnd.html#openfiledialog",
- "extsnd.html#openfiledialogdirectory", "extsnd.html#openhook", "sndscm.html#opennextfileindirectory", "extsnd.html#openrawsound",
- "extsnd.html#openrawsoundhook", "extsnd.html#opensound", "extsnd.html#optimization", "extsnd.html#optimizationhook",
- "extsnd.html#orientationhook", "sndclm.html#oscil", "sndclm.html#oscil?", "sndscm.html#oscopedoc",
- "sndclm.html#out-any", "sndclm.html#outa", "sndclm.html#*output*", "extsnd.html#outputcommenthook",
- "extsnd.html#outputnamehook", "sndscm.html#overlayrmsenv", "extsnd.html#padchannel", "sndscm.html#padmarks",
+ "sndclm.html#nsin?", "sndclm.html#nsincos", "sndclm.html#nsincos?", "sndclm.html#nssb",
+ "sndclm.html#nssb?", "sndclm.html#nxy1cos", "sndclm.html#nxy1cos?", "sndclm.html#nxy1sin",
+ "sndclm.html#nxy1sin?", "sndclm.html#nxycos", "sndclm.html#nxycos?", "sndclm.html#nxysin",
+ "sndclm.html#nxysin?", "s7.html#objecttostring", "sndclm.html#oddmultiple", "sndclm.html#oddweight",
+ "sndscm.html#offsetchannel", "sndscm.html#offsetsound", "sndclm.html#one-pole", "sndclm.html#one-pole-all-pass",
+ "sndclm.html#one-pole-all-pass?", "sndclm.html#one-pole?", "sndclm.html#one-zero", "sndclm.html#one-zero?",
+ "extsnd.html#openfiledialog", "extsnd.html#openfiledialogdirectory", "extsnd.html#openhook", "sndscm.html#opennextfileindirectory",
+ "extsnd.html#openrawsound", "extsnd.html#openrawsoundhook", "extsnd.html#opensound", "s7.html#openlet",
+ "s7.html#openletp", "extsnd.html#orientationhook", "sndclm.html#oscil", "sndclm.html#oscil-bank",
+ "sndclm.html#oscil-bank?", "sndclm.html#oscil?", "sndclm.html#out-any", "sndclm.html#outbank",
+ "sndclm.html#outa", "s7.html#outlet", "sndclm.html#*output*", "extsnd.html#outputcommenthook",
+ "sndscm.html#overlayrmsenv", "s7.html#owlet", "extsnd.html#padchannel", "sndscm.html#padmarks",
"sndscm.html#padsound", "sndscm.html#panmix", "sndscm.html#panmixvct", "sndclm.html#partialstopolynomial",
- "sndclm.html#partialstowave", "extsnd.html#pausing", "extsnd.html#peakenvdir", "extsnd.html#peakenvhook",
- "extsnd.html#peaks", "extsnd.html#peaksfont", "sndclm.html#phase-partialstowave", "sndclm.html#phase-vocoder",
- "sndclm.html#phase-vocoder?", "sndscm.html#pianodoc", "sndclm.html#pink-noise", "sndscm.html#placesound",
- "extsnd.html#play", "extsnd.html#playarrowsize", "sndscm.html#playbetweenmarks", "extsnd.html#playhook",
- "sndscm.html#playmixes", "sndscm.html#playsines", "sndscm.html#playsyncdmarks", "extsnd.html#playerhome",
- "extsnd.html#playerQ", "extsnd.html#players", "extsnd.html#playing", "sndscm.html#pluck",
- "sndclm.html#polartorectangular", "sndclm.html#polynomial", "sndscm.html#polydoc", "sndclm.html#polyoid",
- "sndclm.html#polyoidenv", "sndclm.html#polyoid?", "sndclm.html#polyshape", "sndclm.html#polyshape?",
- "sndclm.html#polywave", "sndclm.html#polywave?", "extsnd.html#positiontox", "extsnd.html#positiontoy",
- "extsnd.html#positioncolor", "sndscm.html#powerenv", "extsnd.html#preferencesdialog", "sndscm.html#previousframe",
- "extsnd.html#previoussample", "extsnd.html#printdialog", "extsnd.html#printhook", "extsnd.html#printlength",
- "s7.html#proceduresource", "s7.html#procedurewithsetter", "sndscm.html#profile", "extsnd.html#progressreport",
- "extsnd.html#promptinminibuffer", "extsnd.html#ptreechannel", "sndclm.html#pulse-train", "sndclm.html#pulse-train?",
+ "sndclm.html#partialstowave", "extsnd.html#pausing", "extsnd.html#peakenvdir", "extsnd.html#peaks",
+ "extsnd.html#peaksfont", "sndclm.html#phase-partialstowave", "sndclm.html#phase-vocoder", "sndclm.html#phase-vocoder?",
+ "sndscm.html#pianodoc", "sndclm.html#pink-noise", "sndclm.html#pink-noise?", "sndscm.html#pins",
+ "sndscm.html#placesound", "extsnd.html#play", "extsnd.html#playarrowsize", "sndscm.html#playbetweenmarks",
+ "extsnd.html#playhook", "sndscm.html#playmixes", "sndscm.html#playoften", "sndscm.html#playregionforever",
+ "sndscm.html#playsine", "sndscm.html#playsines", "sndscm.html#playsyncdmarks", "sndscm.html#playuntilcg",
+ "sndscm.html#playwithenvs", "extsnd.html#playerhome", "extsnd.html#playerQ", "extsnd.html#players",
+ "extsnd.html#playing", "sndscm.html#pluck", "sndclm.html#polartorectangular", "sndclm.html#polynomial",
+ "sndscm.html#polydoc", "sndclm.html#polyoid", "sndclm.html#polyoidenv", "sndclm.html#polyoid?",
+ "sndclm.html#polyshape", "sndclm.html#polyshape?", "sndclm.html#polywave", "sndclm.html#polywave?",
+ "extsnd.html#positiontox", "extsnd.html#positiontoy", "extsnd.html#positioncolor", "sndscm.html#powerenv",
+ "sndscm.html#pqw", "sndscm.html#pqwvox", "extsnd.html#preferencesdialog", "extsnd.html#previoussample",
+ "extsnd.html#printdialog", "extsnd.html#printlength", "s7.html#proceduredocumentation", "s7.html#proceduresetter",
+ "s7.html#proceduresignature", "s7.html#proceduresource", "s7.html#profile", "extsnd.html#progressreport",
+ "sndclm.html#pulse-train", "sndclm.html#pulse-train?", "sndclm.html#pulsedenv", "sndclm.html#pulsedenv?",
+ "sndclm.html#r2k!cos", "sndclm.html#r2k!cos?", "sndclm.html#r2k2cos", "sndclm.html#r2k2cos?",
"sndclm.html#radianstodegrees", "sndclm.html#radianstohz", "extsnd.html#rampchannel", "sndclm.html#rand",
"sndclm.html#rand-interp", "sndclm.html#rand-interp?", "sndclm.html#rand?", "s7.html#random",
- "sndscm.html#readframe", "extsnd.html#readhook", "extsnd.html#readmixsample", "extsnd.html#readonly",
- "extsnd.html#readregionsample", "extsnd.html#readsample", "sndclm.html#readin", "sndclm.html#readin?",
- "extsnd.html#recorderdialog", "sndclm.html#rectangulartomagnitudes", "sndclm.html#rectangulartopolar", "extsnd.html#redo",
- "extsnd.html#redochannel", "extsnd.html#redoedit", "sndscm.html#regiontoframe", "extsnd.html#regiontointeger",
- "sndscm.html#regiontosounddata", "extsnd.html#regiontovct", "extsnd.html#regionchans", "extsnd.html#regionframes",
+ "s7.html#randomstate", "s7.html#randomstatep", "sndclm.html#rcos", "sndclm.html#rcos?",
+ "extsnd.html#readhook", "extsnd.html#readmixsample", "extsnd.html#readonly", "extsnd.html#readregionsample",
+ "extsnd.html#readsample", "extsnd.html#readsamplewithdirection", "s7.html#readercond", "sndclm.html#readin",
+ "sndclm.html#readin?", "sndclm.html#rectangulartomagnitudes", "sndclm.html#rectangulartopolar", "extsnd.html#redo",
+ "extsnd.html#regiontointeger", "extsnd.html#regiontovct", "extsnd.html#regionchans", "extsnd.html#regionframples",
"extsnd.html#regiongraphstyle", "extsnd.html#regionhome", "extsnd.html#regionmaxamp", "extsnd.html#regionmaxampposition",
- "sndscm.html#regionplaylist", "extsnd.html#regionposition", "extsnd.html#regionsample", "extsnd.html#regionsamplerQ",
- "extsnd.html#regionsrate", "extsnd.html#regionok", "extsnd.html#eregions", "s7.html#releaselock",
- "extsnd.html#remembersoundstate", "extsnd.html#removefrommenu", "extsnd.html#reportinminibuffer", "sndscm.html#resetallhooks",
- "extsnd.html#resetcontrols", "extsnd.html#resetlistenercursor", "extsnd.html#restorecontrols", "sndclm.html#*reverb*",
+ "sndscm.html#regionplaylist", "extsnd.html#regionposition", "sndscm.html#regionrms", "extsnd.html#regionsample",
+ "extsnd.html#regionsamplerQ", "extsnd.html#regionsrate", "extsnd.html#regionok", "extsnd.html#eregions",
+ "extsnd.html#remembersoundstate", "sndscm.html#removeclicks", "extsnd.html#removefrommenu", "sndscm.html#replacewithselection",
+ "sndscm.html#reportmarknames", "s7.html#requires7", "sndscm.html#resetallhooks", "extsnd.html#resetcontrols",
+ "extsnd.html#resetlistenercursor", "sndscm.html#reson", "extsnd.html#restorecontrols", "sndclm.html#*reverb*",
"extsnd.html#reverbdecay", "extsnd.html#reverbcontrolfeedback", "extsnd.html#reverbcontrollength", "extsnd.html#reverbcontrollengthbounds",
"extsnd.html#reverbcontrollowpass", "extsnd.html#reverbcontrolscale", "extsnd.html#reverbcontrolscalebounds", "extsnd.html#reverbcontrolp",
- "extsnd.html#reversechannel", "extsnd.html#reversechannels", "sndscm.html#reverseenvelope", "extsnd.html#reverseselection",
- "extsnd.html#reversesound", "extsnd.html#revertsound", "extsnd.html#rightsample", "sndclm.html#ring-modulate",
- "sndscm.html#rmsgain", "sndscm.html#rmsgain", "sndscm.html#rmsenvelope", "extsnd.html#rotatechannel",
- "sndscm.html#rubbersound", "extsnd.html#run", "extsnd.html#sample", "sndclm.html#sampletofile",
- "sndclm.html#sampletofile?", "sndclm.html#sampletoframe", "extsnd.html#sampleratendQ", "extsnd.html#samplerhome",
- "extsnd.html#samplerposition", "extsnd.html#samplerQ", "extsnd.html#samples", "sndclm.html#samplestoseconds",
- "extsnd.html#sashcolor", "extsnd.html#saveasdialogautocomment", "extsnd.html#saveasdialogsrc", "extsnd.html#savecontrols",
- "extsnd.html#savedir", "extsnd.html#saveedithistory", "extsnd.html#saveenvelopes", "extsnd.html#savehook",
- "extsnd.html#savelistener", "extsnd.html#savemacros", "sndscm.html#savemarkproperties", "extsnd.html#savemarks",
- "extsnd.html#savemix", "sndscm.html#savemixes", "extsnd.html#saveregion", "extsnd.html#saveregiondialog",
- "extsnd.html#saveselection", "extsnd.html#saveselectiondialog", "extsnd.html#savesound", "extsnd.html#savesoundas",
- "extsnd.html#savesounddialog", "extsnd.html#savestate", "extsnd.html#savestatefile", "extsnd.html#savestatehook",
- "sndscm.html#sgfilter", "sndclm.html#sawtooth-wave", "sndclm.html#sawtooth-wave?", "extsnd.html#scaleby",
- "extsnd.html#scalechannel", "sndscm.html#scaleenvelope", "sndscm.html#scalemixes", "extsnd.html#scaleselectionby",
- "extsnd.html#scaleselectionto", "sndscm.html#scalesound", "sndscm.html#scaletempo", "extsnd.html#scaleto",
- "extsnd.html#scanchannel", "sndscm.html#scansound", "sndscm.html#dspdocscanned", "sndscm.html#scentroid",
- "extsnd.html#scriptarg", "extsnd.html#scriptargs", "extsnd.html#searchprocedure", "sndclm.html#secondstosamples",
+ "s7.html#reverseb", "sndscm.html#reversebyblocks", "extsnd.html#reversechannel", "sndscm.html#reverseenvelope",
+ "extsnd.html#reverseselection", "extsnd.html#reversesound", "extsnd.html#revertsound", "extsnd.html#rightsample",
+ "sndclm.html#ring-modulate", "sndclm.html#rk!cos", "sndclm.html#rk!cos?", "sndclm.html#rk!ssb",
+ "sndclm.html#rk!ssb?", "sndclm.html#rkcos", "sndclm.html#rkcos?", "sndclm.html#rkoddssb",
+ "sndclm.html#rkoddssb?", "sndclm.html#rksin", "sndclm.html#rksin?", "sndclm.html#rkssb",
+ "sndclm.html#rkssb?", "sndscm.html#rmsgain", "sndscm.html#rmsgain", "sndscm.html#rmsenvelope",
+ "s7.html#rootlet", "sndclm.html#round-interp", "sndclm.html#round-interp?", "sndclm.html#rssb",
+ "sndclm.html#rssbinterp", "sndclm.html#rssb?", "sndscm.html#rubbersound", "sndclm.html#rxycos",
+ "sndclm.html#rxycos?", "sndclm.html#rxyk!cos", "sndclm.html#rxyk!cos?", "sndclm.html#rxyk!sin",
+ "sndclm.html#rxyk!sin?", "sndclm.html#rxysin", "sndclm.html#rxysin?", "extsnd.html#sample",
+ "sndclm.html#sampletofile", "sndclm.html#sampletofile?", "extsnd.html#sampletype", "extsnd.html#sampleratendQ",
+ "extsnd.html#samplerhome", "extsnd.html#samplerposition", "extsnd.html#samplerQ", "extsnd.html#samples",
+ "sndclm.html#samplestoseconds", "extsnd.html#sashcolor", "extsnd.html#saveasdialogautocomment", "extsnd.html#saveasdialogsrc",
+ "extsnd.html#savecontrols", "extsnd.html#savedir", "extsnd.html#saveedithistory", "extsnd.html#saveenvelopes",
+ "extsnd.html#savehook", "extsnd.html#savelistener", "sndscm.html#savemarkproperties", "extsnd.html#savemarks",
+ "extsnd.html#savemix", "extsnd.html#saveregion", "extsnd.html#saveregiondialog", "extsnd.html#saveselection",
+ "extsnd.html#saveselectiondialog", "extsnd.html#savesound", "extsnd.html#savesoundas", "extsnd.html#savesounddialog",
+ "extsnd.html#savestate", "extsnd.html#savestatefile", "extsnd.html#savestatehook", "sndscm.html#sgfilter",
+ "sndclm.html#sawtooth-wave", "sndclm.html#sawtooth-wave?", "extsnd.html#scaleby", "extsnd.html#scalechannel",
+ "sndscm.html#scaleenvelope", "sndscm.html#scalemixes", "extsnd.html#scaleselectionby", "extsnd.html#scaleselectionto",
+ "sndscm.html#scalesound", "sndscm.html#scaletempo", "extsnd.html#scaleto", "extsnd.html#scanchannel",
+ "sndscm.html#dspdocscanned", "sndscm.html#scentroid", "sndscm.html#scratch", "extsnd.html#scriptarg",
+ "extsnd.html#scriptargs", "sndscm.html#searchforclick", "extsnd.html#searchprocedure", "sndclm.html#secondstosamples",
"extsnd.html#selectall", "extsnd.html#selectchannel", "extsnd.html#selectchannelhook", "extsnd.html#selectsound",
"extsnd.html#selectsoundhook", "extsnd.html#selectedchannel", "extsnd.html#selecteddatacolor", "extsnd.html#selectedgraphcolor",
- "extsnd.html#selectedsound", "extsnd.html#selection", "extsnd.html#selectiontomix", "sndscm.html#selectiontosounddata",
- "extsnd.html#selectionchans", "extsnd.html#selectioncolor", "extsnd.html#selectioncreatesregion", "extsnd.html#selectionframes",
+ "extsnd.html#selectedsound", "extsnd.html#selection", "extsnd.html#selectiontomix", "extsnd.html#selectionchans",
+ "extsnd.html#selectioncolor", "extsnd.html#selectioncontext", "extsnd.html#selectioncreatesregion", "extsnd.html#selectionframples",
"extsnd.html#selectionmaxamp", "extsnd.html#selectionmaxampposition", "extsnd.html#selectionmember", "sndscm.html#selectionmembers",
- "extsnd.html#selectionposition", "extsnd.html#selectionsrate", "extsnd.html#selectionok", "extsnd.html#setsamples",
- "sndscm.html#shepardtone", "extsnd.html#shortfilename", "extsnd.html#showaxes", "extsnd.html#showcontrols",
- "sndscm.html#showdiskspace", "extsnd.html#showfullduration", "extsnd.html#showgrid", "extsnd.html#showindices",
- "extsnd.html#showlistener", "extsnd.html#showmarks", "extsnd.html#showmixwaveforms", "extsnd.html#showselection",
- "extsnd.html#showselectiontransform", "extsnd.html#showsonogramcursor", "extsnd.html#showtransformpeaks", "extsnd.html#showwidget",
- "extsnd.html#showyzero", "sndscm.html#silenceallmixes", "sndscm.html#silencemixes", "sndclm.html#sinc-train",
- "extsnd.html#sincwidth", "sndscm.html#sineenvchannel", "sndscm.html#sineramp", "sndscm.html#singerdoc",
- "extsnd.html#smoothchannel", "extsnd.html#smoothselection", "extsnd.html#smoothsound", "sndscm.html#pins",
- "sndscm.html#snapmarktobeat", "sndscm.html#snapmixtobeat", "extsnd.html#sndtosample", "extsnd.html#sndtosamplep",
- "extsnd.html#sndcolor", "extsnd.html#snderror", "extsnd.html#snderrorhook", "extsnd.html#sndfont",
- "extsnd.html#sndgcs", "extsnd.html#sndhelp", "sndscm.html#sndscmhooks", "extsnd.html#sndopenedsound",
- "extsnd.html#sndprint", "extsnd.html#sndspectrum", "extsnd.html#sndtempnam", "extsnd.html#sndurl",
- "extsnd.html#sndurls", "extsnd.html#sndversion", "extsnd.html#sndwarning", "extsnd.html#sndwarninghook",
- "sndscm.html#sndwarp", "sndscm.html#soundtoamp_env", "sndscm.html#soundtoframe", "extsnd.html#soundtointeger",
- "sndscm.html#soundtosounddata", "extsnd.html#sounddata*", "extsnd.html#sounddata+", "sndscm.html#sounddatatofile",
- "sndscm.html#sounddatatoframe", "sndscm.html#sounddatatosound", "extsnd.html#sounddatatosounddata", "extsnd.html#sounddatatovct",
- "extsnd.html#sounddataadd", "extsnd.html#sounddatachans", "extsnd.html#sounddatacopy", "extsnd.html#sounddatafill",
- "extsnd.html#sounddatalength", "extsnd.html#sounddatamaxamp", "extsnd.html#sounddatamultiply", "extsnd.html#sounddataoffset",
- "extsnd.html#sounddatapeak", "extsnd.html#sounddataref", "extsnd.html#sounddatareverse", "extsnd.html#sounddatascale",
- "extsnd.html#sounddataset", "extsnd.html#sounddata?", "extsnd.html#soundfileextensions", "extsnd.html#soundfilep",
- "extsnd.html#soundfilesindirectory", "sndscm.html#soundinterp", "sndscm.html#sound-let", "extsnd.html#soundloopinfo",
+ "extsnd.html#selectionposition", "sndscm.html#selectionrms", "extsnd.html#selectionsrate", "extsnd.html#selectionok",
+ "extsnd.html#setsamples", "extsnd.html#shortfilename", "extsnd.html#showaxes", "extsnd.html#showcontrols",
+ "sndscm.html#showdiskspace", "extsnd.html#showfullduration", "extsnd.html#showfullrange", "extsnd.html#showgrid",
+ "extsnd.html#showindices", "extsnd.html#showlistener", "extsnd.html#showmarks", "extsnd.html#showmixwaveforms",
+ "extsnd.html#showselection", "extsnd.html#showselectiontransform", "extsnd.html#showsonogramcursor", "extsnd.html#showtransformpeaks",
+ "extsnd.html#showwidget", "extsnd.html#showyzero", "sndscm.html#silenceallmixes", "sndscm.html#silencemixes",
+ "sndclm.html#sinc-train", "sndclm.html#sinc-train?", "extsnd.html#sincwidth", "sndscm.html#sineenvchannel",
+ "sndscm.html#sineramp", "sndscm.html#singerdoc", "extsnd.html#smoothchannel", "extsnd.html#smoothselection",
+ "extsnd.html#smoothsound", "sndscm.html#pins", "sndscm.html#snapmarktobeat", "sndscm.html#snapmarks",
+ "sndscm.html#snapmixtobeat", "extsnd.html#sndtosample", "extsnd.html#sndtosamplep", "extsnd.html#sndcolor",
+ "extsnd.html#snderror", "extsnd.html#snderrorhook", "extsnd.html#sndfont", "extsnd.html#sndgcs",
+ "extsnd.html#sndhelp", "sndscm.html#sndscmhooks", "extsnd.html#sndopenedsound", "extsnd.html#sndprint",
+ "extsnd.html#sndspectrum", "extsnd.html#sndtempnam", "extsnd.html#sndurl", "extsnd.html#sndurls",
+ "extsnd.html#sndversion", "extsnd.html#sndwarning", "extsnd.html#sndwarninghook", "sndscm.html#sndwarp",
+ "s7.html#sortb", "sndscm.html#soundtoamp_env", "extsnd.html#soundtointeger", "extsnd.html#soundfileextensions",
+ "extsnd.html#soundfilep", "extsnd.html#soundfilesindirectory", "sndscm.html#soundinterp", "extsnd.html#soundloopinfo",
"extsnd.html#soundproperties", "extsnd.html#soundproperty", "extsnd.html#soundwidgets", "extsnd.html#soundp",
- "extsnd.html#soundfontinfo", "extsnd.html#sounds", "sndscm.html#twotab", "sndscm.html#spectralpolynomial",
- "extsnd.html#spectrohop", "extsnd.html#spectroxangle", "extsnd.html#spectroxscale", "extsnd.html#spectroyangle",
- "extsnd.html#spectroyscale", "extsnd.html#spectrozangle", "extsnd.html#spectrozscale", "sndclm.html#spectrum",
- "sndscm.html#spectrumtocoeffs", "extsnd.html#spectrumend", "extsnd.html#spectrumstart", "extsnd.html#speedcontrol",
- "extsnd.html#speedcontrolbounds", "extsnd.html#speedstyle", "extsnd.html#speedtones", "sndclm.html#square-wave",
- "sndclm.html#square-wave?", "extsnd.html#squelchupdate", "sndscm.html#squelchvowels", "extsnd.html#srate",
- "sndclm.html#src", "extsnd.html#srcchannel", "sndscm.html#srcduration", "sndscm.html#srcmixes",
+ "extsnd.html#soundfontinfo", "extsnd.html#sounds", "sndscm.html#soundstosegmentdata", "sndscm.html#spectra",
+ "sndscm.html#twotab", "sndscm.html#spectralpolynomial", "extsnd.html#spectrohop", "extsnd.html#spectroxangle",
+ "extsnd.html#spectroxscale", "extsnd.html#spectroyangle", "extsnd.html#spectroyscale", "extsnd.html#spectrozangle",
+ "extsnd.html#spectrozscale", "sndclm.html#spectrum", "sndscm.html#spectrumtocoeffs", "extsnd.html#spectrumend",
+ "extsnd.html#spectrumstart", "extsnd.html#speedcontrol", "extsnd.html#speedcontrolbounds", "extsnd.html#speedstyle",
+ "extsnd.html#speedtones", "sndscm.html#spotfreq", "sndclm.html#square-wave", "sndclm.html#square-wave?",
+ "extsnd.html#squelchupdate", "sndscm.html#squelchvowels", "extsnd.html#srate", "sndclm.html#src",
+ "extsnd.html#srcchannel", "sndscm.html#srcduration", "sndscm.html#srcfitenvelope", "sndscm.html#srcmixes",
"extsnd.html#srcsoundselection", "extsnd.html#srcsound", "sndclm.html#src?", "sndclm.html#ssb-am",
"sndclm.html#ssb-am?", "sndscm.html#ssbbank", "sndscm.html#ssbbankenv", "sndscm.html#ssbfm",
- "s7.html#stacktrace", "extsnd.html#starthook", "extsnd.html#startplaying", "extsnd.html#startplayinghook",
- "extsnd.html#startplayingselectionhook", "extsnd.html#startprogressreport", "sndscm.html#startwaterfall", "sndscm.html#stereotomono",
- "extsnd.html#stopdachook", "extsnd.html#stopplayer", "extsnd.html#stopplaying", "extsnd.html#stopplayinghook",
- "extsnd.html#stopplayingselectionhook", "sndscm.html#stretchenvelope", "sndscm.html#superimposeffts", "extsnd.html#swapchannels",
- "sndscm.html#swapselectionchannels", "s7.html#symbolaccess", "extsnd.html#sync", "sndscm.html#sync-everything",
- "extsnd.html#syncmax", "extsnd.html#syncstyle", "extsnd.html#syncdmarks", "sndclm.html#table-lookup",
- "sndclm.html#table-lookup?", "sndclm.html#tap", "sndscm.html#telephone", "extsnd.html#tempdir",
- "extsnd.html#textfocuscolor", "extsnd.html#timegraphstyle", "extsnd.html#timegraphtype", "extsnd.html#timegraphp",
- "extsnd.html#tinyfont", "s7.html#trace", "s7.html#tracehook", "extsnd.html#trackingcursorstyle",
- "extsnd.html#transformtointeger", "extsnd.html#transformtovct", "extsnd.html#transformdialog", "extsnd.html#transformframes",
- "extsnd.html#transformgraphstyle", "extsnd.html#transformgraphtype", "extsnd.html#transformgraphp", "extsnd.html#normalizefft",
- "extsnd.html#transformsample", "extsnd.html#transformsize", "extsnd.html#transformtype", "extsnd.html#transformp",
- "sndscm.html#transposemixes", "extsnd.html#trapsegfault", "sndclm.html#triangle-wave", "sndclm.html#triangle-wave?",
- "sndscm.html#tubebell", "sndclm.html#two-pole", "sndclm.html#two-pole?", "sndclm.html#two-zero",
+ "sndscm.html#startdac", "extsnd.html#startplaying", "extsnd.html#startplayinghook", "extsnd.html#startplayingselectionhook",
+ "extsnd.html#startprogressreport", "extsnd.html#statusreport", "sndscm.html#stereotomono", "sndscm.html#stereoflute",
+ "extsnd.html#stopplayer", "extsnd.html#stopplaying", "extsnd.html#stopplayinghook", "extsnd.html#stopplayingselectionhook",
+ "sndscm.html#stretchenvelope", "sndscm.html#stretchsoundviadft", "s7.html#stringposition", "s7.html#sublet",
+ "sndscm.html#superimposeffts", "extsnd.html#swapchannels", "sndscm.html#swapselectionchannels", "s7.html#symboltodynamicvalue",
+ "s7.html#symboltovalue", "s7.html#symbolaccess", "s7.html#symboltable", "extsnd.html#sync",
+ "sndscm.html#sync-everything", "extsnd.html#syncmax", "extsnd.html#syncstyle", "extsnd.html#syncdmarks",
+ "sndscm.html#syncdmixes", "sndscm.html#syncup", "sndclm.html#table-lookup", "sndclm.html#table-lookup?",
+ "sndclm.html#tanhsin", "sndclm.html#tanhsin?", "sndclm.html#tap", "sndclm.html#tap?",
+ "sndscm.html#telephone", "extsnd.html#tempdir", "extsnd.html#textfocuscolor", "extsnd.html#timegraphstyle",
+ "extsnd.html#timegraphtype", "extsnd.html#timegraphp", "sndclm.html#timestosamples", "extsnd.html#tinyfont",
+ "sndscm.html#telephone", "s7.html#trace", "extsnd.html#trackingcursorstyle", "extsnd.html#transformtointeger",
+ "extsnd.html#transformtovct", "extsnd.html#transformdialog", "extsnd.html#transformframples", "extsnd.html#transformgraphstyle",
+ "extsnd.html#transformgraphtype", "extsnd.html#transformgraphp", "extsnd.html#normalizefft", "extsnd.html#transformsample",
+ "extsnd.html#transformsize", "extsnd.html#transformtype", "extsnd.html#transformp", "sndscm.html#transposemixes",
+ "sndclm.html#triangle-wave", "sndclm.html#triangle-wave?", "sndscm.html#tubebell", "sndscm.html#tubebell",
+ "sndclm.html#two-pole", "sndclm.html#two-pole?", "sndscm.html#twotab", "sndclm.html#two-zero",
"sndclm.html#two-zero?", "extsnd.html#unbindkey", "s7.html#unboundvariablehook", "sndscm.html#unclipchannel",
- "extsnd.html#undo", "extsnd.html#undochannel", "extsnd.html#undoedit", "extsnd.html#undohook",
- "extsnd.html#unselectall", "sndscm.html#updategraphs", "extsnd.html#updatehook", "extsnd.html#updatelispgraph",
- "extsnd.html#updatesound", "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph", "sndscm.html#sndmotifdoc",
- "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "extsnd.html#vct", "extsnd.html#vcttimes",
- "extsnd.html#vctplus", "extsnd.html#vcttochannel", "sndscm.html#vcttofile", "sndscm.html#vcttoframe",
- "extsnd.html#vcttolist", "extsnd.html#vcttosounddata", "extsnd.html#vcttostring", "extsnd.html#vcttovector",
- "extsnd.html#vctadd", "extsnd.html#vctcopy", "extsnd.html#vctfill", "extsnd.html#vctlength",
- "extsnd.html#vctmap", "extsnd.html#vctmove", "extsnd.html#vctmultiply", "extsnd.html#vctoffset",
- "extsnd.html#vctpeak", "sndscm.html#vctpolynomial", "extsnd.html#vctref", "extsnd.html#vctreverse",
+ "extsnd.html#undo", "extsnd.html#undohook", "s7.html#unlet", "extsnd.html#unselectall",
+ "sndscm.html#updategraphs", "extsnd.html#updatehook", "extsnd.html#updatelispgraph", "extsnd.html#updatesound",
+ "extsnd.html#updatetimegraph", "extsnd.html#updatetransformgraph", "sndscm.html#uponsaveyourself", "sndscm.html#sndmotifdoc",
+ "sndscm.html#variabledisplay", "extsnd.html#variablegraphp", "s7.html#varlet", "extsnd.html#vct",
+ "extsnd.html#vcttimes", "extsnd.html#vctplus", "extsnd.html#vcttochannel", "extsnd.html#vcttolist",
+ "extsnd.html#vcttostring", "extsnd.html#vcttovector", "extsnd.html#vctabs", "extsnd.html#vctadd",
+ "extsnd.html#vctcopy", "extsnd.html#vctequal", "extsnd.html#vctfill", "extsnd.html#vctlength",
+ "extsnd.html#vctmax", "extsnd.html#vctmin", "extsnd.html#vctmove", "extsnd.html#vctmultiply",
+ "extsnd.html#vctoffset", "extsnd.html#vctpeak", "extsnd.html#vctref", "extsnd.html#vctreverse",
"extsnd.html#vctscale", "extsnd.html#vctset", "extsnd.html#vctsubseq", "extsnd.html#vctsubtract",
- "extsnd.html#vctp", "extsnd.html#vectortovct", "s7.html#vectorprintlength", "extsnd.html#viewfilesamp",
- "extsnd.html#viewfilesampenv", "extsnd.html#viewfilesdialog", "extsnd.html#viewfilesfiles", "extsnd.html#viewfilesselecthook",
- "extsnd.html#viewfilesselectedfiles", "extsnd.html#viewfilessort", "extsnd.html#viewfilesspeed", "extsnd.html#viewfilesspeedstyle",
- "extsnd.html#viewmixesdialog", "extsnd.html#viewregionsdialog", "extsnd.html#viewsound", "sndscm.html#singerdoc",
- "sndscm.html#voicedtounvoiced", "sndscm.html#volterrafilter", "sndclm.html#wave-train", "sndclm.html#wave-train?",
+ "extsnd.html#vctp", "extsnd.html#vectortovct", "extsnd.html#viewfilesamp", "extsnd.html#viewfilesampenv",
+ "extsnd.html#viewfilesdialog", "extsnd.html#viewfilesfiles", "extsnd.html#viewfilesselecthook", "extsnd.html#viewfilesselectedfiles",
+ "extsnd.html#viewfilessort", "extsnd.html#viewfilesspeed", "extsnd.html#viewfilesspeedstyle", "extsnd.html#viewmixesdialog",
+ "extsnd.html#viewregionsdialog", "extsnd.html#viewsound", "sndscm.html#singerdoc", "sndscm.html#voicedtounvoiced",
+ "sndscm.html#volterrafilter", "sndscm.html#fmvox", "sndclm.html#wave-train", "sndclm.html#wave-train?",
"extsnd.html#wavelettype", "sndscm.html#pqwvox", "extsnd.html#wavohop", "extsnd.html#wavotrace",
"sndclm.html#weighted-moving-average", "extsnd.html#widgetposition", "extsnd.html#widgetsize", "extsnd.html#widgettext",
"extsnd.html#windowheight", "sndscm.html#windowsamples", "extsnd.html#windowwidth", "extsnd.html#windowx",
- "extsnd.html#windowy", "extsnd.html#withbackgroundprocesses", "s7.html#withenvironment", "extsnd.html#withfilemonitor",
- "extsnd.html#withgl", "extsnd.html#withinsetgraph", "sndscm.html#withlocalhook", "sndscm.html#withmarkedsound",
- "extsnd.html#withmenuicons", "extsnd.html#withmixtags", "sndscm.html#withmixedsound", "sndscm.html#withmixedsoundtonotelist",
- "extsnd.html#withpointerfocus", "extsnd.html#withrelativepanes", "extsnd.html#withsmptelabel", "sndscm.html#withsound",
- "sndscm.html#withtempsound", "sndscm.html#withtemporaryselection", "sndscm.html#withthreadedchannels", "sndscm.html#withthreadedsound",
+ "extsnd.html#windowy", "extsnd.html#withbackgroundprocesses", "s7.html#withbaffle", "extsnd.html#withfilemonitor",
+ "extsnd.html#withgl", "extsnd.html#withinsetgraph", "extsnd.html#withinterrupts", "s7.html#with-let",
+ "sndscm.html#withlocalhook", "extsnd.html#withmenuicons", "extsnd.html#withmixtags", "extsnd.html#withpointerfocus",
+ "extsnd.html#withrelativepanes", "extsnd.html#withsmptelabel", "sndscm.html#withsound", "sndscm.html#withtemporaryselection",
"extsnd.html#withtoolbar", "extsnd.html#withtooltips", "extsnd.html#withtrackingcursor", "extsnd.html#withverbosecursor",
"extsnd.html#xtoposition", "extsnd.html#xaxislabel", "extsnd.html#xaxisstyle", "extsnd.html#xbounds",
- "extsnd.html#xpositionslider", "extsnd.html#xzoomslider", "extsnd.html#xrampchannel", "extsnd.html#ytoposition",
- "extsnd.html#yaxislabel", "extsnd.html#ybounds", "extsnd.html#ypositionslider", "extsnd.html#yzoomslider",
- "sndscm.html#ztransform", "extsnd.html#zeropad", "sndscm.html#zipsound", "sndscm.html#zipper",
+ "extsnd.html#xpositionslider", "extsnd.html#xzoomslider", "sndscm.html#xbopen", "extsnd.html#xrampchannel",
+ "extsnd.html#ytoposition", "extsnd.html#yaxislabel", "extsnd.html#ybounds", "extsnd.html#ypositionslider",
+ "extsnd.html#yzoomslider", "sndscm.html#ztransform", "sndscm.html#zecho", "sndscm.html#zeroplus",
+ "extsnd.html#zeropad", "sndscm.html#zerophase", "sndscm.html#zipsound", "sndscm.html#zipper",
"extsnd.html#zoomcolor", "extsnd.html#zoomfocusstyle"};
static const char *Tracking_cursors_xrefs[] = {
"play from the current cursor position with a tracking cursor: {pfc}",
"display tracking cursor as a full height vertical line: {tracking-cursor-style}",
"track play once: control-click 'play'. (You can add a mark at the current tracking cursor location during the play with C-m)",
- "leave the cursor at the final position after tracking play: if-cursor-follows-play-it-stays-where-play-stopped in examp.scm",
+ "leave the cursor at the final position after tracking play: (set! *with-tracking-cursor* :track-and-stay)",
"tracking cursor accuracy: {cursor-location-offset}",
"tracking cursor updating: {cursor-update-interval}",
NULL};
@@ -835,24 +968,19 @@ static const char *Copying_xrefs[] = {
"copy file: in Scheme: copy-file, in Ruby: File.copy or File.syscopy",
"copy string: in Forth: string-copy",
"copy list: in Forth: list-copy or copy-tree",
- "copy vct: {vct-copy}, {vct->vector}, {vct->frame}",
- "copy mix: {mix->vct}",
+ "copy mix: {mix->float-vector}",
"copy sampler: {copy-sampler}",
"copy (clone) current sound edit state: {clone-sound-as}",
- "copy channel data: {channel->vct}, or {save-sound-as}",
- "copy selection data: {selection->vct} or {save-selection}",
- "copy region data: {region->vct}, {region->vct}, {save-region}, or {region->sound-data}",
- "copy transform data: {transform->vct}",
- "copy sound-data: {sound-data->vct}",
- "copy a frame: {frame-copy}, {frame->vct}",
- "copy vector: {vector->vct}",
+ "copy channel data: {channel->float-vector}, or {save-sound-as}",
+ "copy selection data: {selection->float-vector} or {save-selection}",
+ "copy region data: {region->float-vector}, {save-region}",
+ "copy transform data: {transform->float-vector}",
NULL};
static const char *Copying_urls[] = {
NULL,
NULL,
NULL,
- "extsnd.html#vctcopy",
"sndscm.html#mixtovct",
"extsnd.html#copysampler",
"extsnd.html#clonesoundas",
@@ -860,24 +988,20 @@ static const char *Copying_urls[] = {
"extsnd.html#selection2vct",
"extsnd.html#regiontovct",
"extsnd.html#transformtovct",
- "extsnd.html#sounddatatovct",
- "sndscm.html#framecopy",
- "extsnd.html#vectortovct",
NULL};
static const char *Marking_xrefs[] = {
- "global find-mark: {mark-name->id}",
+ "{Marks}",
+ "find mark in any sound: {mark-name->id}",
"mark history: {describe-mark}",
"synchronize marks by inserting silences: {syncup}",
"squeeze selection between marks: {fit-selection-between-marks}",
"insert silence before marks: {pad-marks}",
"move syncd marks: {move-syncd-marks}",
"play starting from syncd marks: {play-syncd-marks}",
- "evaluate function between marks: {eval-between-marks}",
"place marks at selection start and end: {snap-marks}",
"define selection via marks: {define-selection-via-marks}",
"force dragged mark to land on a beat: {snap-mark-to-beat}",
- "loop continuously between the two specified marks: {loop-between-marks}",
"split sound into separate files based on mark placement: {mark-explode}",
"mark property lists: {mark-property}",
"save mark properties in saved state file: {save-mark-properties}",
@@ -885,6 +1009,7 @@ static const char *Marking_xrefs[] = {
NULL};
static const char *Marking_urls[] = {
+ NULL,
"sndscm.html#marknametoid",
"sndscm.html#describemark",
"sndscm.html#syncup",
@@ -892,11 +1017,9 @@ static const char *Marking_urls[] = {
"sndscm.html#padmarks",
"sndscm.html#movesyncdmarks",
"sndscm.html#playsyncdmarks",
- "sndscm.html#evalbetweenmarks",
"sndscm.html#snapmarks",
"sndscm.html#defineselectionviamarks",
"sndscm.html#snapmarktobeat",
- "sndscm.html#loopbetweenmarks",
"sndscm.html#markexplode",
"extsnd.html#markproperty",
"sndscm.html#savemarkproperties",
@@ -904,19 +1027,18 @@ static const char *Marking_urls[] = {
NULL};
static const char *Mixing_xrefs[] = {
+ "{Mixing}",
"mix sound file: {mix} or drag-and-drop it where you want it mixed",
"mix channel: see {mix-channel} in extensions.scm",
"mix region: {mix-region}",
"mix selection: {mix-selection}",
"mix vct: {mix-vct}",
- "mix sound-data: {mix-sound-data}",
- "mix a frame: {mix-frame}",
"enveloped mix: see {enveloped-mix} in extensions.scm",
"read mix samples: {make-mix-sampler}",
"mix data maxamp: {mix-maxamp}",
"mix data to vct: {mix->vct}",
"save mix data in file: {save-mix}",
- "mix property list: {mix-property}",
+ "mix property list: {mix-property} in mix.scm",
"pan mono sound into stereo: see {place-sound} in examp.scm",
"move a mixed sound via dlocsig: {mix-move-sound}",
"the mix dialog: {Mix Dialog}",
@@ -928,13 +1050,12 @@ static const char *Mixing_xrefs[] = {
NULL};
static const char *Mixing_urls[] = {
+ NULL,
"extsnd.html#mix",
"sndscm.html#mixchannel",
"extsnd.html#mixregion",
"extsnd.html#mixselection",
"extsnd.html#mixvct",
- "sndscm.html#mixsounddata",
- "sndscm.html#mixframe",
"sndscm.html#envelopedmix",
"extsnd.html#makemixsampler",
"sndscm.html#mixmaxamp",
@@ -952,20 +1073,19 @@ static const char *Mixing_urls[] = {
NULL};
static const char *Regions_xrefs[] = {
+ "{Regions}",
"Max length of region list: {max-regions}",
"Whether selection creates a region: {selection-creates-region}",
"To play region repeatedly: {play-region-forever}",
- "Start region browser: {view-regions-dialog}",
+ "Start region browser from Scheme: {view-regions-dialog}",
"All about regions: {regions}",
"The region dialog: {region browser}",
"Region rms amp: {region-rms}",
"region-play-list and region-play-sequence in examp.scm",
- "{region->frame}",
- "{region->sound-data}",
- "{make-region-frame-reader}",
NULL};
static const char *Regions_urls[] = {
+ NULL,
"extsnd.html#maxregions",
"extsnd.html#selectioncreatesregion",
"sndscm.html#playregionforever",
@@ -974,12 +1094,10 @@ static const char *Regions_urls[] = {
"snd.html#regionbrowser",
"sndscm.html#regionrms",
NULL,
- "sndscm.html#regiontoframe",
- "sndscm.html#regiontosounddata",
- "sndscm.html#makeregionframereader",
NULL};
static const char *Selections_xrefs[] = {
+ "{Selections}",
"show the current selection: {show-selection}",
"color of selected portion: {selection-color}",
"set whether creating a selection creates a region: {selection-creates-region}",
@@ -988,8 +1106,7 @@ static const char *Selections_xrefs[] = {
"swap chans in selected portion: {swap-selection-channels}",
"replace portion with selection: {replace-with-selection}",
"select portion via function: {make-selection}",
- "evaluate func on each sample of selection: {eval-over-selection} (map-selection in effect)",
- "selection members as list of lists of sounds and channels: {selection-members}",
+ "selection members as list of lists of sound indices and channels: {selection-members}",
"rms of selection data: {selection-rms}",
"delete selection and smooth the splice: {delete-selection-and-smooth}",
"select portion between two marks: {define-selection-via-marks}",
@@ -1006,6 +1123,7 @@ static const char *Selections_xrefs[] = {
NULL};
static const char *Selections_urls[] = {
+ NULL,
"extsnd.html#showselection",
"extsnd.html#selectioncolor",
"extsnd.html#selectioncreatesregion",
@@ -1014,7 +1132,6 @@ static const char *Selections_urls[] = {
"sndscm.html#swapselectionchannels",
"sndscm.html#replacewithselection",
"sndscm.html#makeselection",
- "sndscm.html#evaloverselection",
"sndscm.html#selectionmembers",
"sndscm.html#selectionrms",
"extsnd.html#deleteselectionandsmooth",
@@ -1032,10 +1149,16 @@ static const char *Selections_urls[] = {
NULL};
static const char *Cursors_xrefs[] = {
- "Tracking cursor: {with-tracking-cursor} (cursor-follows-play was the old name)",
+ "Tracking cursor: {with-tracking-cursor}",
"Change cursor shape or size: {cursor-style}, {cursor-size}",
"Cursor moving keys: {Moving the Cursor}",
- "Display data about sample under cursor: {with-verbose cursor}",
+ "Display data about sample under cursor: {with-verbose-cursor}",
+ "play from the current cursor position with a tracking cursor: {pfc}",
+ "display tracking cursor as a full height vertical line: {tracking-cursor-style}",
+ "track play once: control-click 'play'. (You can add a mark at the current tracking cursor location during the play with C-m)",
+ "leave the cursor at the final position after tracking play: (set! *with-tracking-cursor* :track-and-stay)",
+ "tracking cursor accuracy: {cursor-location-offset}",
+ "tracking cursor updating: {cursor-update-interval}",
NULL};
static const char *Cursors_urls[] = {
@@ -1043,10 +1166,16 @@ static const char *Cursors_urls[] = {
"extsnd.html#cursorstyle",
"snd.html#movecursor",
"extsnd.html#withverbosecursor",
+ "extsnd.html#pfc",
+ "extsnd.html#trackingcursorstyle",
+ NULL,
+ NULL,
+ "extsnd.html#cursorlocationoffset",
+ "extsnd.html#cursorupdateinterval",
NULL};
static const char *Deletions_xrefs[] = {
- "delete a file: use the Scheme function delete-file, Ruby's File.delete, or Forth's file-delete",
+ "delete a file: in scheme delete-file or Ruby's File.delete",
"delete a region: {forget-region}",
"delete the currently selected samples: {delete-selection}",
"delete the selection and smooth the splice: {delete-selection-and-smooth}",
@@ -1078,7 +1207,6 @@ static const char *Deletions_urls[] = {
NULL};
static const char *Envelopes_xrefs[] = {
- "envelopes in Snd:",
"envelope sound: {env-channel}, {env-sound}",
"Other enveloping functions: {ramp-channel}, {xramp-channel}, {smooth-channel}",
"The CLM env generator: {env}, many examples in examp.scm, new-effects.scm, etc",
@@ -1088,7 +1216,7 @@ static const char *Envelopes_xrefs[] = {
"Envelope over mix: {enveloped-mix}",
"Local envelope editor: {enved.scm}, xm-enved.scm",
"Read sound indexed through envelope: {env-sound-interp}",
- "Cosine as envelope: {cosine-channel}, {cosine-channel-via-ptree}, {bell-curve}",
+ "Cosine as envelope: {cosine-channel}, {bell-curve}",
"envelope with sinusoidal connections between points: {sine-env-channel}",
"envelope with separate base for each segment: {powenv-channel}",
"envelope with x^2 connections: {env-squared-channel}",
@@ -1099,7 +1227,6 @@ static const char *Envelopes_xrefs[] = {
NULL};
static const char *Envelopes_urls[] = {
- NULL,
"extsnd.html#envchannel",
"extsnd.html#rampchannel",
"sndclm.html#make-env",
@@ -1111,7 +1238,7 @@ static const char *Envelopes_urls[] = {
"sndscm.html#envsoundinterp",
"extsnd.html#cosinechannel",
"sndscm.html#sineenvchannel",
- "extsnd.html#powenvchannel",
+ "sndscm.html#powenvchannel",
"sndscm.html#envsquaredchannel",
"sndscm.html#envexptchannel",
"sndclm.html#ncos",
@@ -1132,7 +1259,7 @@ static const char *Filters_xrefs[] = {
"IIR filters of various orders/kinds: {dsp.scm}",
"Hilbert transform: {make-hilbert-transform} in dsp.scm",
"differentiator: {make-differentiator} in dsp.scm",
- "block DC: see example above, dc-block in prc95.scm, clean-channel in clean.scm, or stereo-flute in clm-ins.scm",
+ "block DC: see example above, dc-block in prc95.scm, or stereo-flute in clm-ins.scm",
"hum elimination: see {eliminate-hum} and {notch-channel} in dsp.scm",
"hiss elimination: {notch-out-rumble-and-hiss}",
"smoothing filters: {moving-average}, {weighted-moving-average}, exponentially-weighted-moving-average",
@@ -1145,14 +1272,12 @@ static const char *Filters_xrefs[] = {
"Moog filter: {moog.scm}",
"Savitzky-Golay filter: {savitzky-golay-filter}",
"Click reduction: {remove-clicks}, {clean-channel}",
- "FIR filter as virtual edit: {virtual-filter-channel}",
"Max Mathews resonator: {firmant}, {maxf.scm, maxf.rb}",
"Spectral edit dialog: {Envelope Editor}",
"graphical equalizer filter bank: {graphEq}",
"nonlinear (Volterra) filter: {volterra-filter}",
"Kalman filter: {kalman-filter-channel}",
"see also convolution, physical modeling, reverb, and {fft-based filtering}",
- "Scheme srfi-1 filter function: %filter.",
NULL};
static const char *Filters_urls[] = {
@@ -1181,14 +1306,12 @@ static const char *Filters_urls[] = {
"sndscm.html#moogdoc",
"sndscm.html#sgfilter",
"sndscm.html#removeclicks",
- "sndscm.html#virtualfilterchannel",
"sndclm.html#firmant",
"snd.html#editenvelope",
"sndscm.html#clminsdoc",
"sndscm.html#volterrafilter",
"sndscm.html#kalmanfilterchannel",
"sndscm.html#ssffts",
- NULL,
NULL};
static const char *Searching_xrefs[] = {
@@ -1196,13 +1319,10 @@ static const char *Searching_xrefs[] = {
"find a mix: {find-mix}",
"find a sound: {find-sound}",
"Example find procedures: {search-for-click, zero+, next-peak, find-pitch}",
- "Search via continuation: {scan-again}",
- "Explicit access to search procedures: {search-procedure}",
+ "Default search procedure: {search-procedure}",
"The Find dialog: {Find} or {find-dialog}",
"find silence: {map-silence}, scramble-channel in examp.scm",
"find any difference between two chans: {channels-equal}",
- "see also {count-matches} and {scan-channel}",
- "search a multichannel sound: {scan-sound}",
"find a widget: find-child in snd-motif.scm",
"add C-s and C-r to the listener key bindings: add-find-to-listener in snd-motif.scm",
"Scheme find: find-if",
@@ -1213,13 +1333,10 @@ static const char *Searching_urls[] = {
"sndscm.html#findmix",
"extsnd.html#findsound",
"sndscm.html#searchforclick",
- "extsnd.html#scanagain",
"extsnd.html#searchprocedure",
"snd.html#editoperations",
"extsnd.html#mapsilence",
"sndscm.html#channelsequal",
- "extsnd.html#countmatches",
- "sndscm.html#scansound",
NULL,
NULL,
NULL,
@@ -1230,11 +1347,9 @@ static const char *Insertions_xrefs[] = {
"insert a silence: {pad-channel}, {insert-silence}, {pad-sound}",
"insert a region: {insert-region}",
"insert the selection: {insert-selection}",
- "insert a vct of samples: {insert-samples}, {insert-vct}",
- "insert a sound: {insert-sound} or {insert-file-dialog}",
+ "insert a vct of samples: {insert-samples}",
+ "insert a sound: {insert-sound}",
"append a sound and silence: {append-sound}",
- "insert a frame: {insert-frame}",
- "insert sound-data: {insert-sound-data}",
NULL};
static const char *Insertions_urls[] = {
@@ -1245,12 +1360,9 @@ static const char *Insertions_urls[] = {
"extsnd.html#insertsamples",
"extsnd.html#insertsound",
"extsnd.html#appendsound",
- "sndscm.html#insertframe",
- "sndscm.html#insertsounddata",
NULL};
static const char *Window_size_and_position_xrefs[] = {
- "time domain window:",
"Built-in keyboard commands: {Moving the Window}",
"Specialized keyboard commands: {bind-key}",
"Window size: {x-zoom-slider}, {zoom-one-pixel}, ",
@@ -1267,7 +1379,6 @@ static const char *Window_size_and_position_xrefs[] = {
NULL};
static const char *Window_size_and_position_urls[] = {
- NULL,
"snd.html#movewindow",
"extsnd.html#bindkey",
"extsnd.html#xzoomslider",
@@ -1287,8 +1398,6 @@ static const char *Maxamps_xrefs[] = {
"Sound file maxamp: {mus-sound-maxamp}",
"Region maxamp: {region-maxamp}",
"Selection maxamp: {selection-maxamp}",
- "Sound data object maxamp: {sound-data-maxamp}",
- "Vct maxamp: {vct-peak}",
"To set the y axis bounds to reflect the channel's maxamp: {y-bounds}",
"Mix maxamp: {mix-maxamp}",
"maxamp locations: {maxamp-position}, {region-maxamp-position}, {selection-maxamp-position}",
@@ -1298,23 +1407,19 @@ static const char *Maxamps_urls[] = {
"extsnd.html#mussoundmaxamp",
"extsnd.html#regionmaxamp",
"extsnd.html#selectionmaxamp",
- "extsnd.html#sounddatamaxamp",
- "extsnd.html#vctpeak",
"extsnd.html#ybounds",
"sndscm.html#mixmaxamp",
"extsnd.html#maxampposition",
NULL};
static const char *Playing_xrefs[] = {
- "play one channel: (play sound-object :channel n), play button in control panel or files dialog",
"play from cursor: C-q and example above",
"play from cursor with tracking cursor: {pfc} above",
"play the selection: (play (selection)), {C-x p}",
"play a region: (play region-object), {C-x p}, play button in Region dialog",
"play a mix: (play mix-object), play button in Mix dialog",
"play a sequence of mixes: {play-mixes}",
- "play from mark: click triangle (control-click for all chans)",
- "play continuously between two marks: {loop-it}",
+ "play from mark: click or drag triangle (control-click for all chans)",
"stop playing: C-g, C-t, {stop-playing}, set {playing} to #f",
"pause or resume playback: space, set {pausing}",
"play repeatedly: {play-often}",
@@ -1324,22 +1429,18 @@ static const char *Playing_xrefs[] = {
"play using an external program: (system \"sndplay wood16.wav\")",
"play a sine-wave or spectrum: {play-sine} and {play-sines}",
"play arbitrary mixtures of things: {make-player} and related functions, {play-syncd-marks}",
- "send arbitrary data to the DAC: {mus-audio-write}, {start-dac}",
- "play after sending the data through some function: {play-sound}",
- "play with applied amplitude envelope: {play-with-envs}, {play-panned}",
+ "play with applied amplitude envelope: {play-with-envs}",
"play an external file: (play \"file\")",
NULL};
static const char *Playing_urls[] = {
NULL,
- NULL,
"extsnd.html#pfc",
"snd.html#cxp",
"snd.html#cxp",
NULL,
"sndscm.html#playmixes",
NULL,
- "sndscm.html#loopbetweenmarks",
"extsnd.html#stopplaying",
"extsnd.html#pausing",
"sndscm.html#playoften",
@@ -1349,13 +1450,12 @@ static const char *Playing_urls[] = {
NULL,
"sndscm.html#playsine",
"extsnd.html#makeplayer",
- "extsnd.html#musaudiowrite",
- "sndscm.html#playsound",
"sndscm.html#playwithenvs",
NULL,
NULL};
static const char *Reversing_xrefs[] = {
+ "reverse channel: {reverse-channel}, {reverse-sound}",
"reverse selected portion: {reverse-selection}",
"read samples in reverse: use {make-sampler} with direction -1",
"reverse at new sampling rate: use {src-channel} with a negative ratio",
@@ -1365,12 +1465,12 @@ static const char *Reversing_xrefs[] = {
"reverse via FFT: {silly-reverse}",
"reverse order of channels: {reverse-channels}",
"reverse a list: reverse and reverse!",
- "reverse a string: in Forth: string-reverse, in Ruby: reverse",
- "reverse a vct: {vct-reverse!}",
- "reverse a frame: {frame-reverse}",
+ "reverse a string: in Ruby: reverse",
+ "reverse vct: {vct-reverse!}",
NULL};
static const char *Reversing_urls[] = {
+ "extsnd.html#reversechannel",
"extsnd.html#reverseselection",
"extsnd.html#makesampler",
"extsnd.html#srcchannel",
@@ -1382,15 +1482,15 @@ static const char *Reversing_urls[] = {
NULL,
NULL,
"extsnd.html#vctreverse",
- "sndscm.html#framereverse",
NULL};
static const char *Saving_xrefs[] = {
+ "save sound: {save-sound}",
"save all sounds: (for-each save-sound (sounds))",
"save a sound under a different name: {save-sound-as}",
"extract one channel from a sound: {extract-channel}",
"extract a set of channels from a sound: {extract-channels}",
- "save a sound in a different format or header: {save-sound-as}",
+ "save a sound in a different sample type or header: {save-sound-as}",
"backup edits automatically: {autosave}",
"check first for unsaved edits: {ask-about-unsaved-edits}",
"save Snd's complete state (unsaved edits and all): {save-state}, {save-dir}, {save-state-hook}, {save-state-file}",
@@ -1403,7 +1503,6 @@ static const char *Saving_xrefs[] = {
"start the selection save dialog: {save-selection-dialog}",
"start the region save dialog: {save-region-dialog}",
"save the current listener text: {save-listener}",
- "save keyboard macros: {save-macros}",
"save marks: {save-marks}",
"save just the edit history: {save-edit-history}",
"take some action upon a window manager save-yourself signal: {upon-save-yourself}",
@@ -1412,12 +1511,13 @@ static const char *Saving_xrefs[] = {
NULL};
static const char *Saving_urls[] = {
+ "extsnd.html#savesound",
NULL,
"extsnd.html#savesoundas",
"extsnd.html#extractchannel",
"extsnd.html#extractchannels",
"extsnd.html#savesoundas",
- "sndscm.html#autosave",
+ "sndscm.html#autosavedoc",
"extsnd.html#askaboutunsavededits",
"extsnd.html#savestate",
"extsnd.html#saveselection",
@@ -1429,7 +1529,6 @@ static const char *Saving_urls[] = {
"extsnd.html#saveselectiondialog",
"extsnd.html#saveregiondialog",
"extsnd.html#savelistener",
- "extsnd.html#savemacros",
"extsnd.html#savemarks",
"extsnd.html#saveedithistory",
"sndscm.html#uponsaveyourself",
@@ -1438,26 +1537,27 @@ static const char *Saving_urls[] = {
NULL};
static const char *Smoothing_xrefs[] = {
+ "smooth channel: {smooth-channel}",
"smooth all channels: {smooth-sound}",
"smooth selection: {smooth-selection}",
"delete the selection and smooth the splice: {delete-selection-and-smooth}",
- "smoothing as virtual op: smooth-channel-via-ptree in examp.scm",
"smoothing via fft: {fft-smoother}",
"smooth via low-pass {filter}",
"smooth over click: {remove-clicks} in examp.scm",
NULL};
static const char *Smoothing_urls[] = {
+ "extsnd.html#smoothchannel",
"extsnd.html#smoothsound",
"extsnd.html#smoothselection",
"extsnd.html#deleteselectionandsmooth",
- NULL,
"sndscm.html#fftsmoother",
"extsnd.html#filtersinsnd",
"sndscm.html#removeclicks",
NULL};
static const char *Resampling_xrefs[] = {
+ "resample channel: {src-channel}",
"resample all chans: {src-sound}",
"resample selection: {src-selection}",
"resample mix: speed control in {Mix dialog} (also {apply-controls})",
@@ -1467,7 +1567,7 @@ static const char *Resampling_xrefs[] = {
"resample with independent time control (granulate): expand in {control panel}, {expsrc} and {expsnd}",
"resample with independent time control (vocoder): {phase-vocoder} (this never works)",
"another time stretcher (autocorrelation):{rubber-sound} (this takes forever and rarely works)",
- "resampling-based sound effects: {hello-dentist}, {fp} (\"Forbidden Planet\"), flange and chorus in dsp.scm and new-effects.scm",
+ "resampling-based sound effects: {hello-dentist}, {fp}, flange and chorus in dsp.scm and new-effects.scm",
"the digital zipper: {zipper}",
"resample via FFT: {down-oct}",
"resample through env: {sound-interp} and {env-sound-interp}",
@@ -1478,6 +1578,7 @@ static const char *Resampling_xrefs[] = {
NULL};
static const char *Resampling_urls[] = {
+ "extsnd.html#srcchannel",
"extsnd.html#srcsound",
"extsnd.html#srcsoundselection",
"snd.html#mixdialog",
@@ -1498,6 +1599,7 @@ static const char *Resampling_urls[] = {
NULL};
static const char *Undo_and_Redo_xrefs[] = {
+ "undo edit: {undo} and {undo-channel}",
"undo all edits: {revert-sound}",
"specialize undo: {undo-hook}",
"protect against undo: {edit-hook}",
@@ -1507,6 +1609,7 @@ static const char *Undo_and_Redo_xrefs[] = {
NULL};
static const char *Undo_and_Redo_urls[] = {
+ "extsnd.html#undo",
"extsnd.html#revertsound",
"extsnd.html#undohook",
"extsnd.html#edithook",
@@ -1538,8 +1641,6 @@ static const char *FFTs_xrefs[] = {
"spectral modeling: {pins}",
"polynomial approach to spectral multiplies (convolution): {spectral-polynomial}",
"Superimpose ffts: {superimpose-ffts}",
- "Waterfall real-time spectrograph: {start-waterfall}",
- "Simple rt spectrum: {show-input-fft}, {show-draggable-input-fft}",
"More transforms: {fractional-fourier-transform}, {z-transform} in dsp.scm",
"3D (single) fft display: {complexify}",
"bark, mel, erb scale display: {display-bark-fft}",
@@ -1569,8 +1670,6 @@ static const char *FFTs_urls[] = {
"sndscm.html#clminsdoc",
"sndscm.html#spectralpolynomial",
"sndscm.html#superimposeffts",
- "sndscm.html#startwaterfall",
- "sndscm.html#showinputfft",
"sndscm.html#fractionalfouriertransform",
"sndscm.html#complexify",
"sndscm.html#displaybarkfft",
@@ -1578,6 +1677,7 @@ static const char *FFTs_urls[] = {
NULL};
static const char *Colors_xrefs[] = {
+ "{Colors}",
"Other color-related stuff:",
"Color names: {rgb.scm, rgb.rb}",
"colors in the file dialogs: install-searcher-with-colors in snd-motif.scm",
@@ -1588,13 +1688,13 @@ static const char *Colors_xrefs[] = {
"colors in rxvt: red-text et al in examp.scm",
"flashing colors: flash-selected-data in examp.scm",
"openGL: snd-gl.scm, {Snd and OpenGL}",
- "fancy widget backgrounds: new-backgrounds.scm in the tutorial",
"color hook: {color-hook}",
"Snd graphics contexts: {snd-gcs}",
NULL};
static const char *Colors_urls[] = {
NULL,
+ NULL,
"sndscm.html#rgbdoc",
NULL,
"extsnd.html#colororientationdialog",
@@ -1604,33 +1704,17 @@ static const char *Colors_urls[] = {
NULL,
NULL,
"grfsnd.html#sndandgl",
- NULL,
"extsnd.html#colorhook",
"extsnd.html#sndgcs",
NULL};
-static const char *Noise_Reduction_xrefs[] = {
- "clicks: {smooth-channel}, {remove-clicks}, {fft-smoother}",
- "rumble, hiss: {notch-out-rumble-and-hiss}, {fft-squelch}, {fft-cancel}",
- "hum: {notch-channel}",
- "via CLM ins: {anoi}",
- NULL};
-
-static const char *Noise_Reduction_urls[] = {
- "extsnd.html#smoothchannel",
- "sndscm.html#notchoutrumbleandhiss",
- "sndscm.html#notchchannel",
- "sndscm.html#anoi",
- NULL};
-
static const char *Random_Numbers_xrefs[] = {
- "Random Numbers in Snd/CLM:",
"generators, arbitrary distributions, fractals, 1/f: {rand and rand-interp}",
"dithering: {dither-channel}, {dither-sound}",
"noise-making instrument: {noise.scm, noise.rb}",
"physical modeling of noisy instruments: {maraca.scm, maraca.rb}",
"arbitrary distribution via rejection method: {any-random}",
- "CL: random, *random-state*, make-random-state*: random number between 0 and arg, arg can't be 0!",
+ "s7: random, random-state: random number between 0 and arg",
"Ruby: kernel_rand (alias for Ruby's rand), srand: random integer between 0 and arg, or float between 0 and 1",
"{mus-random, mus_random}: random float between -arg and arg",
"mus-rand-seed (settable)",
@@ -1639,7 +1723,6 @@ static const char *Random_Numbers_xrefs[] = {
NULL};
static const char *Random_Numbers_urls[] = {
- NULL,
"sndclm.html#randdoc",
"sndscm.html#ditherchannel",
"sndscm.html#noisedoc",
@@ -1654,7 +1737,6 @@ static const char *Random_Numbers_urls[] = {
NULL};
static const char *Reverb_xrefs[] = {
- "Reverbs in Snd",
"freeverb: {freeverb.scm, freeverb.rb}",
"jc-reverb: {jcrev.scm}",
"jl-reverb: {clm-ins.scm}",
@@ -1665,7 +1747,6 @@ static const char *Reverb_xrefs[] = {
NULL};
static const char *Reverb_urls[] = {
- NULL,
"sndscm.html#freeverbdoc",
"sndscm.html#jcrevdoc",
"sndscm.html#clminsdoc",
@@ -1677,519 +1758,5804 @@ static const char *Reverb_urls[] = {
#if HAVE_SCHEME
-#define AUTOLOAD_FILES 60
-static const char *autoload_files[AUTOLOAD_FILES] = {
- "analog-filter.scm", "animals.scm", "autosave.scm", "big-gens.scm", "binary-io.scm", "bird.scm", "clean.scm",
- "clm-ins.scm", "cmn-glyphs.lisp", "dlocsig.scm", "draw.scm", "dsp.scm", "env.scm",
- "enved.scm", "examp.scm", "expandn.scm", "extensions.scm", "fade.scm", "frame.scm",
- "freeverb.scm", "fullmix.scm", "generators.scm", "grani.scm", "hooks.scm", "index.scm",
- "jcrev.scm", "jcvoi.scm", "maraca.scm", "marks.scm", "maxf.scm", "mix.scm",
- "mixer.scm", "moog.scm", "musglyphs.scm", "nb.scm", "noise.scm", "numerics.scm",
- "peak-phases.scm", "piano.scm", "play.scm", "poly.scm", "prc95.scm", "pretty-print.scm",
- "primes.scm", "pvoc.scm", "rtio.scm", "rubber.scm", "selection.scm", "singer.scm",
- "snd10.scm", "snd11.scm", "snd9.scm", "snddiff.scm", "sndwarp.scm", "spokenword.scm",
- "stochastic.scm", "strad.scm", "v.scm", "ws.scm", "zip.scm"};
-
-#define AUTOLOAD_NAMES 1693
-
-static const char *autoload_names[AUTOLOAD_NAMES] = {
- "*clm-array-print-length*", "*clm-channels*", "*clm-clipped*", "*clm-data-format*", "*clm-default-frequency*",
- "*clm-delete-reverb*", "*clm-file-buffer-size*", "*clm-file-name*", "*clm-header-type*",
- "*clm-locsig-type*", "*clm-notehook*", "*clm-output-safety*", "*clm-play*",
- "*clm-player*", "*clm-reverb*", "*clm-reverb-channels*", "*clm-reverb-data*",
- "*clm-search-list*", "*clm-srate*", "*clm-statistics*", "*clm-table-size*",
- "*clm-threads*", "*clm-verbose*", "*clm-with-sound-depth*", "*default-player*",
- "*definstrument-hook*", "*to-snd*", "->frequency", "->sample",
- "->x", "->y", "?", "Ci",
- "Si", "a-cricket", "a-frog", "abcos",
- "abcos-methods", "abcos?", "absin", "absin-methods",
- "absin?", "acadian-flycatcher", "acorn-woodpecker", "add-envelopes",
- "add-notes", "add-watcher", "addenv", "adjustable-oscil",
- "adjustable-oscil-methods", "adjustable-oscil?", "adjustable-sawtooth-wave", "adjustable-sawtooth-wave-methods",
- "adjustable-sawtooth-wave?", "adjustable-square-wave", "adjustable-square-wave-methods", "adjustable-square-wave?",
- "adjustable-triangle-wave", "adjustable-triangle-wave-methods", "adjustable-triangle-wave?", "adsat",
- "all-chans", "am", "amargosa-toad", "ambisonics-channels",
- "american-crow", "american-crow-no-formants", "american-robin", "american-toad",
- "amplify", "analog->digital", "angles-in-degree", "angles-in-radians",
- "angles-in-turns", "anoi", "any-env-channel", "any-random",
- "aref", "arrange-speakers", "ash-throated-flycatcher", "asyfm-I",
- "asyfm-J", "asyfm-methods", "asyfm?", "attack-point",
- "attract", "auto-dot", "auto-save", "aux-f",
- "aux-g", "b-american-widgeon", "b-audubons-warbler", "b-bachmans-sparrow",
- "b-bairds-sparrow", "b-black-chinned-sparrow", "b-black-necked-stilt", "b-black-throated-gray-warbler",
- "b-black-throated-sparrow", "b-blue-gray-gnatcatcher", "b-bobwhite", "b-cassins-kingbird",
- "b-cedar-waxwing", "b-cerulean-warbler", "b-chestnut-sided-warbler", "b-chipping-sparrow",
- "b-chuck-wills-widow", "b-eastern-bluebird", "b-eastern-phoebe", "b-golden-crowned-sparrow",
- "b-grasshopper-sparrow", "b-great-horned-owl", "b-hooded-warbler", "b-indigo-bunting",
- "b-kentucky-warbler", "b-lark-bunting", "b-louisiana-waterthrush", "b-nashville-warbler",
- "b-orchard-oriole", "b-painted-bunting", "b-pigeon-hawk", "b-prothonotary-warbler",
- "b-robin", "b-rufous-sided-towhee", "b-scissor-tailed-flycatcher", "b-solitary-vireo",
- "b-swamp-sparrow", "b-western-flycatcher", "b-western-meadowlark", "b-yellow-warbler",
- "bachmans-sparrow", "balance", "balance-avg", "bald-eagle",
- "band-limited-sawtooth", "band-limited-square-wave", "bandpass", "bandstop",
- "barking-tree-frog", "barn-owl", "barred-owl-1", "bernoulli-poly",
- "bernoulli3", "bes-fm", "bes-i1", "bes-in",
- "bess", "bess-methods", "bess?", "bessel-prototype",
- "bezier-render", "big-amplitude-modulate", "big-array-clear", "big-array-interp",
- "big-array-normalize", "big-contrast-enhancement", "big-db->linear", "big-degrees->radians",
- "big-dot-product", "big-hz->radians", "big-linear->db", "big-maraca",
- "big-multiply-arrays", "big-ncos", "big-ncos-methods", "big-ncos?",
- "big-nsin", "big-nsin-methods", "big-nsin?", "big-one-pole",
- "big-one-pole-methods", "big-one-pole?", "big-one-zero", "big-one-zero-methods",
- "big-one-zero?", "big-oscil", "big-oscil-methods", "big-oscil?",
- "big-polar->rectangular", "big-polynomial", "big-radians->degrees", "big-radians->hz",
- "big-rectangular->polar", "big-ring-modulate", "big-samples->seconds", "big-seconds->samples",
- "big-table-lookup", "big-table-lookup-methods", "big-table-lookup?", "bigbird",
- "binomial", "binomial-direct", "bird", "black-billed-cuckoo",
- "black-chinned-sparrow", "black-crowned-night-heron", "black-horned-tree-cricket", "black-necked-stilt",
- "black-phoebe", "black-rail", "black-throated-blue-warbler", "black-throated-sparrow",
- "blackman", "blackman-methods", "blackman4-env", "blackman4-env-channel",
- "blackman4-ramp", "blackman?", "blue-grosbeak", "bobwhite",
- "bouncy", "bow", "bowstr", "bowtable",
- "brass", "brassy", "brighten-slightly", "brighten-slightly-1",
- "broad-winged-tree-cricket", "brown-crested-flycatcher-1", "brown-crested-flycatcher-2", "brown-jay",
- "brown-noise", "brown-noise-methods", "brown-noise?", "bullfrog",
- "bump", "burrowing-owl", "bushtit", "butter",
- "butterworth-prototype", "calculate-fit", "california-quail", "california-towhee",
- "calling-all-animals", "calling-all-birds", "calling-all-frogs", "calling-all-generators",
- "calling-all-insects", "calling-all-mammals", "canada-goose", "canada-goose-1",
- "canada-goose-2", "canada-goose-3", "cancel-auto-save", "canter",
- "cape-may-warbler", "card+device", "cardinal", "carolina-grasshopper",
- "carolina-wren", "cascade->canonical", "cassins-sparrow", "cassins-vireo",
- "cedar-waxwing", "cellon", "chain-dsps", "channel-average-power",
- "channel-clipped?", "channel-distance", "channel-lp", "channel-lp-inf",
- "channel-mean", "channel-norm", "channel-polynomial", "channel-rms",
- "channel-total-energy", "channel-variance", "channel2-angle", "channel2-coefficient-of-projection",
- "channel2-inner-product", "channel2-orthogonal?", "channels-equal?", "channels=?",
- "cheby-hka", "chebyshev", "chebyshev-polynomial", "chebyshev-prototype",
- "check-freq", "check-mix-tags", "checkpt", "chestnut-sided-warbler",
- "chipping-sparrow", "chordalize", "chorus", "chuck-wills-widow",
- "circle", "cis", "clamp-rxycos-r", "clarinet",
- "clean-channel", "clean-sound", "click-middle-button-to-open-next-file-in-directory", "click-to-sync",
- "clm-display-globals", "clm-expsrc", "clm-find-file", "clm-load",
- "close-all-buffers", "close-buffer", "cnvrev", "cnvtest",
- "color-mixes", "color-samples", "comb-chord", "comb-filter",
- "common-gull", "common-loon-1", "common-loon-2", "common-pauraque",
- "common-yellowthroat", "compand", "compand-channel", "compand-sound",
- "compute-string", "compute-uniform-circular-string", "concatenate-envelopes", "confused-ground-cricket",
- "constant-velocity", "contrast-channel", "contrast-sound", "copy-frame-reader",
- "cosine-summation", "crawfish-frog", "create-initial-envelopes", "crested-caracara",
- "cross-correlate", "cross-fade", "cross-synthesis", "curveto",
- "dark-eyed-junco", "davis-tree-cricket", "db-envelope", "dblsum",
- "dblsum-methods", "dblsum?", "dc-block", "def-clm-struct",
- "defgenerator", "define-selection-via-marks", "definstrument", "delay-channel-mixes",
- "delaya", "delayl", "delete-from-out-to-in", "delete-mix",
- "delete-watcher", "describe", "describe-hook", "describe-mark",
- "dht", "differentiator", "display-bark-fft", "display-colored-samples",
- "display-correlation", "display-db", "display-energy", "display-previous-edits",
- "display-samples-in-color", "dissolve-fade", "distance", "distances-in-feet",
- "distances-in-meters", "dither-channel", "dither-sound", "dlocsig",
- "dlya-methods", "dlya?", "do-all-chans", "do-chans",
- "do-sound-chans", "dog-day-cicada", "dolph", "dolph-1",
- "down-oct", "draw", "draw-128th-rest", "draw-16th-rest",
- "draw-32nd-rest", "draw-64th-rest", "draw-8th-flag-down", "draw-8th-flag-up",
- "draw-8th-rest", "draw-a-note", "draw-accent", "draw-arpeggio",
- "draw-arpeggios", "draw-bass-clef", "draw-breath-mark", "draw-c-clef",
- "draw-caesura", "draw-circled-x", "draw-coda", "draw-common-time",
- "draw-cut-time", "draw-diamond", "draw-diamond-1", "draw-double-flat",
- "draw-double-mordent", "draw-double-sharp", "draw-double-whole-note", "draw-double-whole-rest",
- "draw-down-bow", "draw-eight", "draw-extend-flag-down", "draw-extend-flag-up",
- "draw-f", "draw-fermata", "draw-filled-diamond-1", "draw-five",
- "draw-flat", "draw-four", "draw-half-note", "draw-half-rest",
- "draw-left-paren", "draw-lig-p", "draw-lower-bracket", "draw-m",
- "draw-measure-rest", "draw-mordent", "draw-mslash", "draw-n",
- "draw-natural", "draw-niente", "draw-nine", "draw-one",
- "draw-p", "draw-ped", "draw-pedal-off", "draw-percussion-clef",
- "draw-plus", "draw-quarter-note", "draw-quarter-rest", "draw-r",
- "draw-repeat-sign", "draw-rhythmX", "draw-right-paren", "draw-s",
- "draw-segno", "draw-seven", "draw-sharp", "draw-six",
- "draw-slash", "draw-square", "draw-staff", "draw-subito",
- "draw-three", "draw-tnecca", "draw-tr", "draw-treble-clef",
- "draw-triangle", "draw-trill-section", "draw-trill-sections", "draw-turn",
- "draw-two", "draw-up-bow", "draw-upper-bracket", "draw-upside-down-fermata",
- "draw-wedge", "draw-whole-note", "draw-whole-rest", "draw-z",
- "draw-zero", "drone", "dusky-flycatcher", "eared-grebe",
- "eastern-bluebird", "eastern-meadowlark", "eastern-wood-pewee-1", "eastern-wood-pewee-2",
- "echo", "eliminate-hum", "elliptic-prototype", "env-expt-channel",
- "env-mixes", "env-sound-interp", "env-squared-channel", "envelope-exp",
- "envelope-interp", "envelope-last-x", "envelope-or-number", "enveloped-mix",
- "enveloping-key-press", "eoddcos", "eoddcos-methods", "eoddcos?",
- "ercos", "ercos-methods", "ercos?", "ercoser",
- "erssb", "erssb-methods", "erssb?", "eval-between-marks",
- "eval-over-selection", "evening-grosbeak", "every-sample?", "exp-envelope",
- "exp-snd", "expandn", "expfil", "explode-sf2",
- "exponentially-weighted-moving-average", "exponentially-weighted-moving-average-methods", "exponentially-weighted-moving-average?", "expseg",
- "expseg-methods", "expseg?", "expsnd", "expsrc",
- "factorial", "factorize", "fast-calling-tree-cricket", "fejer-sum",
- "fft-cancel", "fft-edit", "fft-env-data", "fft-env-edit",
- "fft-env-interp", "fft-peak", "fft-smoother", "fft-squelch",
- "field-sparrow", "file->sound-data", "file->vct", "files-popdown-info",
- "files-popup-info", "fill-in", "fillfnc", "filter-fft",
- "filter-selection-and-smooth", "filtered-env", "find-click", "find-if",
- "find-mix", "find-noddsin-max", "find-nxysin-max", "find-other-mins",
- "find-pitch", "find-sine", "finfo", "finish-with-sound",
- "first-mark-in-window-at-left", "fit-path", "fit-selection-between-marks", "flammulated-owl",
- "flash-selected-data", "flatten-partials", "flecho", "flipxy",
- "float64_to_int32", "float64_to_int64", "flocsig", "flocsig-methods",
- "flocsig?", "fltit-1", "flute", "fm-bell",
- "fm-cancellation", "fm-cascade-component", "fm-complex-component", "fm-drum",
- "fm-insect", "fm-noise", "fm-parallel-component", "fm-trumpet",
- "fm-violin", "fm-voice", "fm2", "fmssb",
- "fmssb-methods", "fmssb?", "fncval", "focus-follows-mouse",
- "fofins", "for-each-sound-file", "formant-filter", "formants",
- "four-spotted-tree-cricket", "fourth", "fox-sparrow", "fp",
- "fpmc", "fractional-fourier-transform", "frame->sound", "frame->sound-data",
- "frame->vct", "frame-copy", "frame-reader-at-end?", "frame-reader-chans",
- "frame-reader-home", "frame-reader-position", "frame-reader?", "frame-reverse!",
- "free-frame-reader", "freeverb", "freqdiv", "frequency->note-octave-and-accidental",
- "fullmix", "g-mustext", "gain", "gain-avg",
- "gambels-quail", "gaussian-distribution", "gaussian-envelope", "gegenbauer",
- "generator-clamp-r", "generic-write", "get-best", "get-speaker-configuration",
- "get-worst-overall", "glassy", "goertzel", "goertzel-channel",
- "golden-crowned-sparrow", "gong", "gran-synth", "grani",
- "granulated-sound-interp", "graphEq", "grasshopper-sparrow", "gray-crowned-rosy-finch",
- "gray-vireo", "gray-vireo-1", "gray-vireo-2", "gray-vireo-3",
- "gray-vireo-4", "gray-vireo-5", "great-crested-flycatcher", "great-horned-owl",
- "great-kiskadee", "great-plains-narrow-mouthed-toad", "greater-pewee", "greater-roadrunner",
- "green-noise", "green-noise-interp", "green-noise-interp-methods", "green-noise-interp?",
- "green-noise-methods", "green-noise?", "green-tailed-towhee", "green-toad",
- "green-tree-frog", "grn-methods", "grn?", "groove-billed-ani",
- "hairy-woodpecker", "hammondoid", "hammonds-flycatcher", "handsome-trig",
- "hard-clipped", "harmonicizer", "hello-dentist", "henslows-sparrow",
- "hermit-thrush", "hermite", "hermite-polynomial", "highpass",
- "hilbert-transform", "hook-member", "house-finch", "house-sparrow-1",
- "hp", "html", "huttons-vireo", "hz->2pi",
- "if-cursor-follows-play-it-stays-where-play-stopped", "in-out", "inca-dove-1", "inca-dove-2",
- "indri", "init-with-sound", "insert-channel", "insert-frame",
- "insert-sound-data", "insert-vct", "int_to_float32", "int_to_float64",
- "integrate-envelope", "inverse-chebyshev-prototype", "inverse-integrate", "invert-filter",
- "invert-matrix", "izcos", "izcos-methods", "izcos?",
- "j0evencos", "j0evencos-methods", "j0evencos?", "j0j1cos",
- "j0j1cos-methods", "j0j1cos?", "j2cos", "j2cos-methods",
- "j2cos?", "jackson-sum", "jc-reverb", "jettable",
- "jjcos", "jjcos-methods", "jjcos?", "jl-reverb",
- "jncos", "jncos-methods", "jncos?", "jpcos",
- "jpcos-methods", "jpcos?", "jycos", "jycos-methods",
- "jycos?", "k2cos", "k2cos-methods", "k2cos?",
- "k2sin", "k2sin-methods", "k2sin?", "k2ssb",
- "k2ssb-methods", "k2ssb?", "k3sin", "k3sin-methods",
- "k3sin?", "kalman-filter-channel", "keypad-spectro-bindings", "killdeer",
- "kirtlands-warbler", "knudsens-frog", "kosine-summation", "krksin",
- "krksin-methods", "krksin?", "lag?", "laguerre",
- "laguerre-polynomial", "last", "lbj-piano", "least-bittern",
- "least-flycatcher", "legendre", "legendre-polynomial", "legendre-sum",
- "lesser-nighthawk", "linear-src-channel", "lineto", "linnaeus-cicada",
- "lip", "lip-set-freq", "list->hook", "list??",
- "listp", "literal-render", "little-grass-frog", "local-data",
- "local-peak", "local-rms", "local-smooth", "locate-zero",
- "log10", "loggerhead-shrike-1", "loggerhead-shrike-2", "long-eared-owl",
- "long-spurred-meadow-katydid", "loop-between-marks", "lowpass", "lp",
- "lpc-coeffs", "lpc-predict", "lucys-warbler", "lutish",
- "lyric-cicada", "macgillivrays-warbler", "machine1", "magnolia-warbler",
- "make-a-even", "make-a-odd", "make-abcos", "make-absin",
- "make-adjustable-oscil", "make-adjustable-sawtooth-wave", "make-adjustable-square-wave", "make-adjustable-triangle-wave",
- "make-asyfm", "make-bandpass", "make-bandstop", "make-bess",
- "make-bessel-bandpass", "make-bessel-bandstop", "make-bessel-highpass", "make-bessel-lowpass",
- "make-bezier-1", "make-bezier-path", "make-big-ncos", "make-big-nsin",
- "make-big-one-pole", "make-big-one-zero", "make-big-oscil", "make-big-table-lookup",
- "make-biquad", "make-birds", "make-blackman", "make-bowtable",
- "make-brown-noise", "make-butter-band-pass", "make-butter-band-reject", "make-butter-bp",
- "make-butter-bs", "make-butter-high-pass", "make-butter-hp", "make-butter-low-pass",
- "make-butter-lp", "make-butterworth-bandpass", "make-butterworth-bandstop", "make-butterworth-highpass",
- "make-butterworth-lowpass", "make-chebyshev-bandpass", "make-chebyshev-bandstop", "make-chebyshev-highpass",
- "make-chebyshev-lowpass", "make-closed-path", "make-cosine-summation", "make-current-window-display",
- "make-db-env", "make-dblsum", "make-dc-block", "make-delaya",
- "make-delayl", "make-differentiator", "make-dlocsig", "make-dlya",
- "make-eliminate-hum", "make-elliptic-bandpass", "make-elliptic-bandstop", "make-elliptic-highpass",
- "make-elliptic-lowpass", "make-eoddcos", "make-ercos", "make-erssb",
- "make-exponentially-weighted-moving-average", "make-expseg", "make-flocsig", "make-fm-noise",
- "make-fm2", "make-fmssb", "make-frame-reader", "make-gr-env",
- "make-green-noise", "make-green-noise-interp", "make-grn", "make-group",
- "make-highpass", "make-hilbert-transform", "make-iir-band-pass-2", "make-iir-band-stop-2",
- "make-iir-high-pass-2", "make-iir-low-pass-2", "make-inverse-chebyshev-bandpass", "make-inverse-chebyshev-bandstop",
- "make-inverse-chebyshev-highpass", "make-inverse-chebyshev-lowpass", "make-izcos", "make-j0evencos",
- "make-j0j1cos", "make-j2cos", "make-jjcos", "make-jncos",
- "make-jpcos", "make-jycos", "make-k2cos", "make-k2sin",
- "make-k2ssb", "make-k3sin", "make-kosine-summation", "make-krksin",
- "make-list-1", "make-literal-path", "make-literal-polar-path", "make-lowpass",
- "make-mfilter", "make-mflt", "make-moog", "make-moog-filter",
- "make-moving-autocorrelation", "make-moving-fft", "make-moving-length", "make-moving-max",
- "make-moving-pitch", "make-moving-rms", "make-moving-scentroid", "make-moving-spectrum",
- "make-moving-sum", "make-moving-variance", "make-mvm", "make-n1cos",
- "make-nchoosekcos", "make-ncos2", "make-ncos4", "make-nkssb",
- "make-noddcos", "make-noddsin", "make-noddssb", "make-noid",
- "make-notch-frequency-response", "make-npcos", "make-nrcos", "make-nrsin",
- "make-nrssb", "make-nsincos", "make-nssb", "make-nxy1cos",
- "make-nxy1sin", "make-nxycos", "make-nxysin", "make-octaves-env",
- "make-one-pole-allpass", "make-one-pole-swept", "make-onep", "make-onezero",
- "make-open-bezier-path", "make-oscil", "make-path", "make-peaking-2",
- "make-penv", "make-pink-noise", "make-plsenv", "make-pnoise",
- "make-polar-path", "make-polygon", "make-polyoid", "make-power-env",
- "make-ppolar", "make-pulsed-env", "make-pvocoder", "make-r2k!cos",
- "make-r2k2cos", "make-ramp", "make-rcos", "make-reed",
- "make-region-frame-reader", "make-rk!cos", "make-rk!ssb", "make-rkcos",
- "make-rkoddssb", "make-rksin", "make-rkssb", "make-rmsg",
- "make-rmsgain", "make-round-interp", "make-rssb", "make-rxycos",
- "make-rxyk!cos", "make-rxyk!sin", "make-rxysin", "make-safe-rxycos",
- "make-savitzky-golay-filter", "make-sbfm", "make-selection", "make-selection-frame-reader",
- "make-semitones-env", "make-sinc-train", "make-sine-summation", "make-sound-interp",
- "make-speaker-config", "make-spencer-filter", "make-spiral-path", "make-ssb-fm",
- "make-sum-of-cosines", "make-sum-of-sines", "make-sync-frame-reader", "make-table-lookup-with-env",
- "make-tanhsin", "make-volterra-filter", "make-wave-train-with-env", "make-waveshape",
- "make-weighted-moving-average", "make-zdata", "make-zero-mixer", "make-zipper",
- "make-zpolar", "map-envelopes", "map-sound", "map-sound-files",
- "maraca", "mark-click-info", "mark-explode", "mark-in",
- "mark-loops", "mark-name->id", "mark-out", "marsh-meadow-grasshopper",
- "match-sound-files", "max-envelope", "maxfilter", "metal",
- "mfilter", "mfilter-1", "mflt-methods", "mflt?",
- "min-envelope", "mirror-path", "mix->vct", "mix-channel",
- "mix-click-info", "mix-click-sets-amp", "mix-frame", "mix-maxamp",
- "mix-name->id", "mix-notelists", "mix-sound", "mix-sound-data",
- "mixer-copy", "mixer-determinant", "mixer-diagonal?", "mixer-inverse",
- "mixer-poly", "mixer-solve", "mixer-trace", "mixer-transpose",
- "mixes-length", "mixes-maxamp", "mono->stereo", "mono-files->stereo",
- "montezuma-quail", "moog-filter", "moog-methods", "moog?",
- "mosquito", "mountain-quail", "mourning-dove", "mouse-drag-envelope",
- "mouse-press-envelope", "mouse-release-envelope", "move-mixes", "move-syncd-marks",
- "moveto", "moving-autocorrelation", "moving-autocorrelation-methods", "moving-autocorrelation?",
- "moving-fft", "moving-fft-methods", "moving-fft?", "moving-formant",
- "moving-length", "moving-length-methods", "moving-length?", "moving-max",
- "moving-max-methods", "moving-max?", "moving-pitch", "moving-pitch-methods",
- "moving-pitch?", "moving-rms", "moving-rms-methods", "moving-rms?",
- "moving-scentroid", "moving-scentroid-methods", "moving-scentroid?", "moving-spectrum",
- "moving-spectrum-methods", "moving-spectrum?", "moving-sum", "moving-sum-methods",
- "moving-sum?", "moving-variance", "moving-variance-methods", "moving-variance?",
- "mpg", "multi-expt-env", "multiply-envelopes", "music-font",
- "mvm-methods", "mvm?", "n-choose-k", "n1cos",
- "n1cos-methods", "n1cos?", "narrow-winged-tree-cricket", "nashville-warbler",
- "nb", "nchoosekcos", "nchoosekcos-methods", "nchoosekcos?",
- "ncos2", "ncos2-methods", "ncos2?", "ncos4",
- "nearest-point", "next-frame", "next-peak", "next-phrase",
- "nkssb", "nkssb-interp", "nkssb-methods", "nkssb?",
- "nkssber", "noddcos", "noddcos-methods", "noddcos?",
- "noddsin", "noddsin-methods", "noddsin?", "noddssb",
- "noddssb-methods", "noddssb?", "noid", "noid?",
- "normalize-envelope", "normalize-sound", "normalized-mix", "northern-beardless-tyrannulet",
- "northern-goshawk", "northern-leopard-frog-1", "northern-leopard-frog-2", "not-fitted",
- "not-parsed", "not-rendered", "not-transformed", "notch-channel",
- "notch-filter", "notch-selection", "notch-sound", "note-data->accidental",
- "note-data->cclass", "note-data->octave", "note-data->pclass", "note-data->pitch",
- "npcos", "npcos-methods", "npcos?", "nrcos",
- "nrcos-methods", "nrcos?", "nrev", "nrsin",
- "nrsin-methods", "nrsin?", "nrssb", "nrssb-interp",
- "nrssb-methods", "nrssb?", "nsincos", "nsincos-methods",
- "nsincos?", "nssb", "nssb-methods", "nssb?",
- "nxy1cos", "nxy1cos-methods", "nxy1cos?", "nxy1sin",
- "nxy1sin-methods", "nxy1sin?", "nxycos", "nxycos-methods",
- "nxycos?", "nxysin", "nxysin-methods", "nxysin?",
- "oak-titmouse", "oak-toad", "oboish", "octaves-envelope",
- "offset-channel", "offset-sound", "old-make-formant", "old-play",
- "olive-sided-flycatcher", "one-pole-allpass", "one-pole-allpass-methods", "one-pole-allpass?",
- "one-pole-swept", "one-pole-swept-methods", "one-pole-swept?", "one-turn-is",
- "open-buffer", "open-current-buffer", "open-next-file-in-directory", "open-play-output",
- "orange-crowned-warbler", "organish", "ornate-chorus-frog", "osc-formants",
- "oscil-bank", "output-type", "overlay-rms-env", "overlay-sounds",
- "p", "pacific-chorus-frog", "pacific-slope-flycatcher", "pad-marks",
- "pad-sound", "pan-mix", "pan-mix-region", "pan-mix-selection",
- "pan-mix-vct", "pareto-distribution", "parse-cartesian-coordinates", "parse-polar-coordinates",
- "partials->waveshape", "path-time", "path-x", "path-y",
- "path-z", "penv-methods", "penv?", "periodogram",
- "phainopepla", "philadelphia-vireo", "phrase-start?", "phrase?",
- "pianoy", "pianoy1", "pianoy2", "pileated-woodpecker",
- "pine-tree-cricket", "pine-warbler", "pinewoods-tree-frog", "pink-noise",
- "pink-noise-methods", "pink-noise?", "pins", "pinyon-jay",
- "place-sound", "plain-chacalaca", "plains-spadefoot", "play-ac3",
- "play-and-wait", "play-between-marks", "play-channel", "play-mix",
- "play-mixes", "play-often", "play-panned", "play-preview",
- "play-region", "play-region-forever", "play-selection", "play-sine",
- "play-sines", "play-sound", "play-syncd-marks", "play-until-c-g",
- "play-with-amps", "play-with-envs", "plgndr", "plsenv-methods",
- "plsenv?", "pluck", "plucky", "plumbeous-vireo-1",
- "plumbeous-vireo-2", "pnoise", "pnoise-methods", "pnoise?",
- "poly*", "poly+", "poly-as-vector*", "poly-as-vector+",
- "poly-as-vector-derivative", "poly-as-vector-discriminant", "poly-as-vector-eval", "poly-as-vector-gcd",
- "poly-as-vector-reduce", "poly-as-vector-resultant", "poly-as-vector-roots", "poly-as-vector/",
- "poly-derivative", "poly-discriminant", "poly-gcd", "poly-reduce",
- "poly-resultant", "poly-roots", "poly/", "polyoid",
- "polyoid-env", "polyoid-methods", "polyoid?", "poussin-sum",
- "powenv-channel", "power-env", "power-env-channel", "pprint",
- "pqw", "pqw-vox", "pretty-print", "pretty-print-with-keys",
- "previous-frame", "previous-phrase", "profile", "prototype->highpass",
- "prune-db", "pulse-voice", "pulsed-env", "pulsed-env?",
- "purple-finch", "pvoc", "pvocoder", "pygmy-nuthatch",
- "r2k!cos", "r2k!cos-methods", "r2k!cos?", "r2k2cos",
- "r2k2cos-methods", "r2k2cos-norm", "r2k2cos?", "raised-cosine",
- "ramp", "ramp-expt", "ramp-squared", "rcos",
- "rcos-methods", "rcos?", "read-aif-header", "read-ascii",
- "read-au-header", "read-bfloat32", "read-bfloat64", "read-bfloat80->int",
- "read-bint16", "read-bint32", "read-bint64", "read-chars",
- "read-flac", "read-frame", "read-lfloat32", "read-lfloat64",
- "read-lint16", "read-lint32", "read-lint64", "read-ogg",
- "read-speex", "read-string", "red-breasted-nuthatch", "red-eyed-vireo",
- "red-shouldered-hawk", "red-spotted-toad", "redo-channel", "reedtable",
- "region->frame", "region->sound-data", "region-play-list", "region-play-sequence",
- "region-rms", "remove-clicks", "remove-if", "remove-pops",
- "remove-single-sample-clicks", "render-path", "repeat-envelope", "replace-with-selection",
- "report-mark-names", "reset-all-hooks", "reset-fit", "reset-rendering",
- "reset-transformation", "resflt", "reson", "reverse-by-blocks",
- "reverse-envelope", "reverse-string-append", "reverse-within-blocks", "rhodey",
- "ring-mod", "ring-modulate-channel", "river-frog", "rk!cos",
- "rk!cos-methods", "rk!cos?", "rk!ssb", "rk!ssb-methods",
- "rk!ssb?", "rkcos", "rkcos-methods", "rkcos?",
- "rkoddssb", "rkoddssb-methods", "rkoddssb?", "rksin",
- "rksin-methods", "rksin?", "rkssb", "rkssb-methods",
- "rkssb?", "rlineto", "rmoveto", "rms",
- "rms-envelope", "rmsg-methods", "rmsg?", "rotate-path",
- "rotate-phase", "round-interp", "round-interp-methods", "round-interp?",
- "rssb", "rssb-interp", "rssb-methods", "rssb?",
- "rubber-sound", "ruby-crowned-kinglet", "ruffed-grouse", "run-with-fm-and-pm",
- "rxycos", "rxycos-methods", "rxycos?", "rxyk!cos",
- "rxyk!cos-methods", "rxyk!cos?", "rxyk!sin", "rxyk!sin-methods",
- "rxyk!sin?", "rxysin", "rxysin-methods", "rxysin?",
- "safe-rxycos", "safe-rxycos-methods", "safe-rxycos?", "safe-srate",
- "sage-sparrow", "samples->sound-data", "samples-via-colormap", "sandhill-crane",
- "savannah-sparrow", "save-mark-properties", "save-mixes", "says-phoebe",
- "sbfm-methods", "sbfm?", "scale-envelope", "scale-mixes",
- "scale-path", "scale-sound", "scale-tempo", "scaled-quail",
- "scan-sound", "scentroid", "scotts-oriole", "scramble-channel",
- "scramble-channels", "scratch", "scrub-euphonia", "search-for-click",
- "secs->samples", "selection->sound-data", "selection-members", "selection-rms",
- "selection-rms-1", "semitones-envelope", "set-gain", "set-mixes-tag-y",
- "set-pole", "set-speaker-configuration", "setf-aref", "shift-channel-pitch",
- "show-digits-of-pi-starting-at-digit", "show-draggable-input-fft", "show-input", "show-input-fft",
- "show-mins", "showall", "signum", "silence-all-mixes",
- "silence-mixes", "silence?", "simplify-complex", "simplify-envelope",
- "simultaneous-zero-crossing", "sin-m*pi/n", "sin-nx-peak", "sinc-train",
- "sinc-train-methods", "sinc-train?", "sine-bank", "sine-env",
- "sine-env-channel", "sine-ramp", "singer", "slightly-musical-conehead",
- "smooth-channel-via-ptree", "smooth-vct", "smoothing-filter", "snap-mark-to-beat",
- "snap-marks", "snap-mix-1", "snap-mix-to-beat", "snap-syncd-mixes-1",
- "snap-syncd-mixes-to-beat", "snd-hooks", "snd-msg", "snddiff",
- "snddiff-1", "snddiff-2", "sndwarp", "snowy-tree-cricket",
- "soft-clipped", "song-sparrow", "sonoran-desert-toad", "sora",
- "sort-samples", "sound->frame", "sound->sound-data", "sound-data->file",
- "sound-data->frame", "sound-data->sound", "sound-interp", "sound-let",
- "sounds->segment-data", "southeastern-field-cricket", "southern-cricket-frog", "southern-mole-cricket",
- "southwestern-toad", "spectra", "spectral-polynomial", "spectrum->coeffs",
- "sphagnum-ground-cricket", "spike", "spiral-render", "spot-freq",
- "spring-peeper", "square-env", "squelch-vowels", "squirrel-tree-frog-1",
- "src-duration", "src-fit-envelope", "src-mixes", "ssb-bank",
- "ssb-bank-env", "ssb-fm", "start-dac", "start-enveloping",
- "start-sync", "stellers-jay", "stereo->mono", "stereo-flute",
- "stochastic", "stop-enveloping", "stop-sync", "stretch-envelope",
- "stretch-sound-via-dft", "stringy", "striped-ground-cricket", "sub-matrix",
- "sum-of-n-odd-cosines", "sum-of-n-odd-sines", "sum-of-n-sines", "summer-tanager",
- "superimpose-ffts", "swainsons-thrush", "swap-selection-channels", "switch-to-buf",
- "sync-all-mixes", "sync-everything", "syncd-mixes", "syncup",
- "tanhsin", "tanhsin-methods", "tanhsin?", "test-notch-hum",
- "test-remove-DC", "test-remove-pops", "test-remove-single-clicks", "test-sv",
- "texas-toad", "third", "times->samples", "tinkling-ground-cricket",
- "touch-tone", "townsends-solitaire", "transform-path", "translate-path",
- "transpose-mixes", "tree-for-each", "tree-for-each-reversed", "trumpeter-swan-1",
- "tstall", "tstallderiv", "tstallf", "tsteven",
- "tstodd", "tstoddderiv", "tstprime", "tubebell",
- "tufted-titmouse", "tvf-channel", "two-tab", "unb",
- "unclip-channel", "unclip-sound", "uncolor-samples", "unconvolve",
- "unconvolve-1", "undisplay-bark-fft", "undo-channel", "update-graphs",
- "varied-thrush", "various-gull-cries-from-end-of-colony-5", "vct->file", "vct->frame",
- "vct-polynomial", "vct-size", "vector-add!", "vector-copy",
- "vector-scale!", "vector-synthesis", "verdin", "vermillion-flycatcher",
- "vibro", "virginia-rail", "virtual-filter-channel", "voiced->unvoiced",
- "volterra-filter", "vox", "warbling-vireo", "weighted-moving-average",
- "weighted-moving-average-methods", "weighted-moving-average?", "western-meadowlark", "western-tanager",
- "western-toad", "western-wood-pewee-1", "western-wood-pewee-2", "whip-poor-will",
- "white-breasted-nuthatch", "white-eyed-vireo", "white-headed-woodpecker", "white-throated-sparrow",
- "white-tipped-dove", "whooping-crane", "willet", "willow-flycatcher",
- "wilsons-warbler", "window-envelope", "window-rms", "window-samples",
- "with-full-sound", "with-local-hook", "with-marked-sound", "with-mix-file-extension",
- "with-mix-find-file-with-extensions", "with-mixed-sound", "with-mixed-sound->notelist", "with-mixed-sound-mix-info",
- "with-simple-sound", "with-simple-sound-helper", "with-sound", "with-sound-helper",
- "with-temp-sound", "with-temporary-selection", "with-threaded-channels", "with-threaded-sound",
- "wood-duck", "wrentit", "write-au-header", "write-bfloat32",
- "write-bfloat64", "write-bint16", "write-bint32", "write-bint64",
- "write-chars", "write-flac", "write-int->bfloat80", "write-lfloat32",
- "write-lfloat64", "write-lint16", "write-lint32", "write-lint64",
- "write-ogg", "write-speex", "write-string", "ws-interrupt?",
- "ws-save-state", "wurley", "x-norm", "xb-close",
- "xb-open", "xparse-path", "yellow-bellied-flycatcher", "yellow-green-vireo",
- "yellow-rumped-warbler", "yellow-warbler", "z-transform", "za",
- "zc", "zcomb", "zdata-methods", "zdata?",
- "zecho", "zero+", "zero-phase", "zip-sound",
- "zipper", "zn", "zone-tailed-hawk", "zoom-spectrum"};
-
-static int autoload_indices[AUTOLOAD_NAMES] = {
- 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58, 58,
- 58, 58, 58, 58, 33, 33, 24, 36, 36, 1, 1, 21, 21, 21, 21, 21, 21, 1, 1, 12, 14, 50, 26, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 11, 14, 14, 1, 9, 1, 1, 1, 1, 45, 0, 9, 9,
- 9, 7, 16, 11, 26, 9, 1, 21, 21, 21, 21, 35, 7, 14, 2, 36, 36, 5, 5, 5, 5, 5, 5, 5,
- 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
- 5, 5, 5, 5, 5, 5, 5, 5, 1, 7, 7, 1, 51, 51, 11, 11, 1, 1, 1, 36, 36, 7, 36, 36,
- 21, 21, 21, 0, 9, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 27, 3, 3, 3, 3, 3, 3, 3, 3,
- 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 36, 36, 5, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 21, 21, 21, 16, 16, 21, 1, 1, 21, 56, 41, 41, 41, 21, 11, 11,
- 1, 1, 1, 1, 21, 21, 21, 1, 21, 1, 1, 11, 0, 9, 1, 1, 1, 1, 1, 21, 1, 1, 1, 1,
- 1, 1, 2, 7, 1, 45, 1, 1, 1, 11, 1, 1, 1, 7, 14, 11, 14, 11, 11, 11, 11, 11, 11, 11,
- 11, 11, 11, 11, 11, 11, 16, 16, 11, 36, 36, 0, 6, 30, 26, 1, 1, 11, 11, 1, 33, 9, 21, 41,
- 6, 6, 14, 28, 58, 7, 58, 58, 14, 14, 7, 14, 30, 10, 14, 14, 1, 1, 1, 1, 1, 14, 14, 14,
- 11, 11, 12, 1, 9, 16, 16, 18, 51, 1, 13, 1, 52, 17, 14, 33, 1, 1, 22, 21, 21, 21, 41, 58,
- 21, 28, 58, 30, 41, 41, 54, 30, 50, 9, 23, 28, 11, 11, 11, 10, 14, 14, 14, 10, 10, 17, 9, 9,
- 9, 16, 16, 9, 41, 41, 14, 14, 14, 1, 11, 11, 11, 33, 8, 8, 8, 8, 8, 8, 8, 33, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 33, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
- 8, 8, 8, 8, 8, 7, 1, 1, 1, 1, 1, 1, 14, 11, 0, 16, 30, 14, 16, 12, 12, 12, 22, 16,
- 13, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 28, 47, 1, 14, 22, 7, 15, 7, 14, 21, 21, 21, 38,
- 38, 38, 14, 14, 36, 43, 1, 51, 14, 14, 14, 14, 14, 14, 14, 14, 1, 18, 18, 34, 34, 33, 26, 14,
- 47, 14, 14, 58, 30, 21, 21, 37, 14, 11, 14, 58, 14, 9, 28, 1, 14, 11, 14, 26, 4, 4, 21, 21,
- 21, 11, 41, 7, 21, 11, 11, 7, 7, 35, 11, 7, 57, 26, 7, 21, 21, 21, 26, 50, 7, 16, 14, 14,
- 1, 9, 1, 14, 21, 11, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 19, 11, 33, 20, 33, 7, 7,
- 1, 11, 11, 36, 21, 42, 37, 9, 37, 21, 11, 6, 1, 7, 7, 22, 14, 7, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 1, 1, 1, 1, 1, 21, 21, 21, 21, 21, 21, 1, 1, 1, 7, 7, 1, 1, 7, 1, 1,
- 11, 11, 14, 1, 1, 36, 36, 11, 11, 23, 1, 1, 45, 24, 1, 11, 54, 45, 1, 1, 1, 58, 16, 18,
- 18, 18, 4, 4, 12, 0, 11, 11, 31, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 51, 25, 41,
- 21, 21, 21, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 11, 49, 1, 1, 1, 51, 21, 21, 21, 52, 36, 36, 9, 7, 1, 1, 36, 36, 51, 1, 11, 33, 1,
- 41, 41, 23, 9, 9, 9, 1, 54, 54, 54, 54, 14, 11, 1, 1, 1, 1, 39, 11, 45, 11, 11, 1, 21,
- 1, 1, 21, 1, 9, 9, 21, 21, 21, 21, 21, 21, 21, 11, 11, 21, 0, 0, 0, 0, 33, 9, 3, 3,
- 3, 3, 3, 3, 11, 5, 21, 41, 21, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0,
- 0, 9, 51, 50, 22, 21, 41, 41, 41, 11, 9, 41, 11, 0, 0, 0, 0, 21, 21, 21, 21, 38, 21, 35,
- 7, 21, 18, 22, 21, 21, 7, 9, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 51, 21, 9, 9, 9, 11, 51, 51, 32, 32, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 29, 21, 21, 21, 21, 21, 21, 21, 21, 21, 11, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22,
- 38, 38, 41, 41, 9, 51, 9, 11, 12, 21, 21, 38, 9, 33, 21, 12, 51, 21, 44, 21, 21, 14, 21, 41,
- 18, 21, 21, 21, 21, 21, 21, 7, 7, 21, 21, 21, 21, 21, 21, 21, 11, 7, 47, 18, 22, 21, 49, 14,
- 9, 11, 9, 7, 49, 49, 18, 21, 21, 11, 21, 21, 21, 59, 31, 59, 51, 12, 18, 16, 27, 28, 28, 54,
- 14, 28, 54, 1, 16, 12, 29, 7, 51, 51, 51, 51, 12, 9, 30, 16, 30, 30, 18, 30, 30, 58, 30, 18,
- 31, 31, 31, 31, 31, 31, 31, 31, 30, 30, 16, 16, 1, 32, 32, 32, 1, 1, 1, 13, 13, 13, 30, 28,
- 33, 21, 21, 21, 21, 21, 21, 14, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 14, 21, 12, 33, 29, 29, 36, 21, 21, 21, 1, 1, 34, 21, 21, 21,
- 21, 21, 21, 21, 9, 18, 14, 54, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 12, 16, 16, 1, 1, 1, 1, 9, 9, 9, 9, 11, 14, 11, 11, 33, 33, 33, 33, 33, 21, 21, 21, 21,
- 21, 21, 7, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 1, 1, 21, 22, 16, 16, 51, 50, 1, 38, 38, 38, 38, 38, 38, 9, 14, 14, 14, 39,
- 1, 21, 1, 14, 44, 33, 10, 10, 38, 1, 1, 28, 16, 30, 30, 30, 30, 11, 9, 9, 21, 9, 9, 9,
- 9, 12, 12, 11, 1, 1, 54, 54, 21, 21, 21, 1, 1, 1, 1, 21, 21, 21, 7, 1, 14, 1, 1, 14,
- 50, 28, 50, 50, 30, 39, 13, 54, 50, 39, 50, 39, 39, 39, 28, 39, 39, 13, 36, 21, 21, 7, 41, 1,
- 1, 38, 38, 38, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 40, 21,
- 21, 21, 21, 51, 12, 12, 12, 42, 7, 7, 42, 42, 18, 54, 16, 0, 34, 14, 21, 21, 1, 44, 44, 1,
- 21, 21, 21, 21, 21, 21, 21, 22, 14, 16, 16, 21, 21, 21, 4, 14, 4, 4, 4, 4, 4, 4, 4, 4,
- 14, 18, 4, 4, 4, 4, 4, 14, 14, 4, 1, 1, 1, 1, 16, 41, 18, 18, 14, 14, 14, 14, 16, 6,
- 6, 9, 12, 47, 28, 23, 9, 9, 9, 7, 7, 14, 12, 42, 14, 7, 14, 14, 1, 21, 21, 21, 21, 21,
- 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 33, 33, 7, 12, 7, 7, 9, 11, 21, 21, 21,
- 21, 21, 21, 21, 46, 1, 1, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 59,
- 1, 39, 10, 1, 1, 28, 30, 1, 7, 7, 12, 30, 9, 16, 30, 1, 18, 11, 1, 14, 14, 7, 1, 14,
- 54, 18, 47, 14, 14, 22, 41, 30, 41, 9, 26, 11, 36, 45, 45, 45, 37, 37, 11, 30, 30, 54, 40, 12,
- 18, 36, 36, 21, 21, 21, 51, 21, 16, 16, 48, 1, 14, 6, 51, 28, 28, 30, 30, 30, 30, 23, 29, 52,
- 52, 52, 53, 1, 11, 1, 1, 1, 14, 18, 18, 18, 18, 18, 14, 58, 14, 1, 1, 1, 1, 7, 11, 11,
- 1, 11, 9, 11, 1, 21, 14, 1, 11, 11, 30, 11, 11, 7, 39, 13, 28, 1, 16, 7, 55, 13, 28, 12,
- 11, 21, 1, 31, 51, 51, 51, 1, 14, 1, 47, 14, 30, 14, 30, 28, 21, 21, 21, 6, 6, 6, 6, 21,
- 1, 9, 58, 1, 7, 1, 9, 9, 30, 30, 30, 1, 37, 37, 37, 37, 37, 37, 37, 7, 1, 6, 7, 34,
- 11, 11, 10, 52, 52, 11, 16, 14, 1, 5, 18, 18, 11, 52, 40, 40, 40, 39, 1, 1, 14, 1, 14, 14,
- 11, 7, 1, 21, 21, 21, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 12, 14, 14,
- 58, 23, 58, 50, 50, 58, 58, 58, 58, 58, 58, 58, 58, 47, 16, 58, 1, 1, 4, 4, 4, 4, 4, 4,
- 4, 14, 4, 4, 4, 4, 4, 4, 14, 14, 4, 58, 58, 7, 9, 14, 14, 9, 1, 1, 1, 1, 11, 7,
- 7, 14, 59, 59, 14, 14, 11, 59, 59, 7, 1, 14};
+static const char *snd_names[11580] = {
+ "*clm-array-print-length*", "ws.scm",
+ "*clm-channels*", "ws.scm",
+ "*clm-clipped*", "ws.scm",
+ "*clm-default-frequency*", "ws.scm",
+ "*clm-delete-reverb*", "ws.scm",
+ "*clm-file-buffer-size*", "ws.scm",
+ "*clm-file-name*", "ws.scm",
+ "*clm-header-type*", "ws.scm",
+ "*clm-locsig-type*", "ws.scm",
+ "*clm-notehook*", "ws.scm",
+ "*clm-play*", "ws.scm",
+ "*clm-player*", "ws.scm",
+ "*clm-reverb*", "ws.scm",
+ "*clm-reverb-channels*", "ws.scm",
+ "*clm-reverb-data*", "ws.scm",
+ "*clm-sample-type*", "ws.scm",
+ "*clm-search-list*", "ws.scm",
+ "*clm-srate*", "ws.scm",
+ "*clm-statistics*", "ws.scm",
+ "*clm-table-size*", "ws.scm",
+ "*clm-verbose*", "ws.scm",
+ "*clm-with-sound-depth*", "ws.scm",
+ "*default-player*", "ws.scm",
+ "*definstrument-hook*", "ws.scm",
+ "*libc*", "libc.scm",
+ "*libdl*", "libdl.scm",
+ "*libgdbm*", "libgdbm.scm",
+ "*libgsl*", "libgsl.scm",
+ "*libm*", "libm.scm",
+ "*mock-char*", "mockery.scm",
+ "*mock-hash-table*", "mockery.scm",
+ "*mock-number*", "mockery.scm",
+ "*mock-pair*", "mockery.scm",
+ "*mock-port*", "mockery.scm",
+ "*mock-string*", "mockery.scm",
+ "*mock-symbol*", "mockery.scm",
+ "*mock-vector*", "mockery.scm",
+ "*repl*", "repl.scm",
+ "*s7*->list", "stuff.scm",
+ "*to-snd*", "ws.scm",
+ "->frequency", "ws.scm",
+ "->predicate", "stuff.scm",
+ "->sample", "ws.scm",
+ "->x", "musglyphs.scm",
+ "->y", "musglyphs.scm",
+ "1+", "stuff.scm",
+ "1-", "stuff.scm",
+ "2^n-1?", "stuff.scm",
+ "2^n?", "stuff.scm",
+ "AF_APPLETALK", "libc.scm",
+ "AF_ASH", "libc.scm",
+ "AF_ATMPVC", "libc.scm",
+ "AF_ATMSVC", "libc.scm",
+ "AF_AX25", "libc.scm",
+ "AF_BLUETOOTH", "libc.scm",
+ "AF_BRIDGE", "libc.scm",
+ "AF_CAN", "libc.scm",
+ "AF_DECnet", "libc.scm",
+ "AF_ECONET", "libc.scm",
+ "AF_FILE", "libc.scm",
+ "AF_IEEE802154", "libc.scm",
+ "AF_INET", "libc.scm",
+ "AF_INET6", "libc.scm",
+ "AF_IPX", "libc.scm",
+ "AF_IRDA", "libc.scm",
+ "AF_ISDN", "libc.scm",
+ "AF_IUCV", "libc.scm",
+ "AF_KEY", "libc.scm",
+ "AF_LLC", "libc.scm",
+ "AF_LOCAL", "libc.scm",
+ "AF_MAX", "libc.scm",
+ "AF_NETBEUI", "libc.scm",
+ "AF_NETLINK", "libc.scm",
+ "AF_NETROM", "libc.scm",
+ "AF_PACKET", "libc.scm",
+ "AF_PHONET", "libc.scm",
+ "AF_PPPOX", "libc.scm",
+ "AF_RDS", "libc.scm",
+ "AF_ROSE", "libc.scm",
+ "AF_ROUTE", "libc.scm",
+ "AF_RXRPC", "libc.scm",
+ "AF_SECURITY", "libc.scm",
+ "AF_SNA", "libc.scm",
+ "AF_TIPC", "libc.scm",
+ "AF_UNIX", "libc.scm",
+ "AF_UNSPEC", "libc.scm",
+ "AF_WANPIPE", "libc.scm",
+ "AF_X25", "libc.scm",
+ "AI_ADDRCONFIG", "libc.scm",
+ "AI_ALL", "libc.scm",
+ "AI_CANONNAME", "libc.scm",
+ "AI_NUMERICHOST", "libc.scm",
+ "AI_NUMERICSERV", "libc.scm",
+ "AI_PASSIVE", "libc.scm",
+ "AI_V4MAPPED", "libc.scm",
+ "BC_BASE_MAX", "libc.scm",
+ "BC_DIM_MAX", "libc.scm",
+ "BC_SCALE_MAX", "libc.scm",
+ "BC_STRING_MAX", "libc.scm",
+ "BRKINT", "libc.scm",
+ "BUFSIZ", "libc.scm",
+ "CHARCLASS_NAME_MAX", "libc.scm",
+ "CHAR_BIT", "libc.scm",
+ "CHAR_MAX", "libc.scm",
+ "CHAR_MIN", "libc.scm",
+ "CLOCKS_PER_SEC", "libc.scm",
+ "CLOCK_MONOTONIC", "libc.scm",
+ "CLOCK_MONOTONIC_COARSE", "libc.scm",
+ "CLOCK_MONOTONIC_RAW", "libc.scm",
+ "CLOCK_PROCESS_CPUTIME_ID", "libc.scm",
+ "CLOCK_REALTIME", "libc.scm",
+ "CLOCK_REALTIME_COARSE", "libc.scm",
+ "CLOCK_THREAD_CPUTIME_ID", "libc.scm",
+ "COLL_WEIGHTS_MAX", "libc.scm",
+ "CblasColMajor", "libgsl.scm",
+ "CblasConjTrans", "libgsl.scm",
+ "CblasLeft", "libgsl.scm",
+ "CblasLower", "libgsl.scm",
+ "CblasNoTrans", "libgsl.scm",
+ "CblasNonUnit", "libgsl.scm",
+ "CblasRight", "libgsl.scm",
+ "CblasRowMajor", "libgsl.scm",
+ "CblasTrans", "libgsl.scm",
+ "CblasUnit", "libgsl.scm",
+ "CblasUpper", "libgsl.scm",
+ "Ci", "numerics.scm",
+ "DBL_DIG", "libc.scm",
+ "DBL_EPSILON", "libc.scm",
+ "DBL_MANT_DIG", "libc.scm",
+ "DBL_MAX", "libc.scm",
+ "DBL_MAX_10_EXP", "libc.scm",
+ "DBL_MAX_EXP", "libc.scm",
+ "DBL_MIN", "libc.scm",
+ "DBL_MIN_10_EXP", "libc.scm",
+ "DBL_MIN_EXP", "libc.scm",
+ "E2BIG", "libc.scm",
+ "EACCES", "libc.scm",
+ "EAGAIN", "libc.scm",
+ "EAI_AGAIN", "libc.scm",
+ "EAI_BADFLAGS", "libc.scm",
+ "EAI_FAIL", "libc.scm",
+ "EAI_FAMILY", "libc.scm",
+ "EAI_MEMORY", "libc.scm",
+ "EAI_NONAME", "libc.scm",
+ "EAI_OVERFLOW", "libc.scm",
+ "EAI_SERVICE", "libc.scm",
+ "EAI_SOCKTYPE", "libc.scm",
+ "EAI_SYSTEM", "libc.scm",
+ "EBADF", "libc.scm",
+ "EBUSY", "libc.scm",
+ "ECANCELED", "libc.scm",
+ "ECHILD", "libc.scm",
+ "ECHO", "libc.scm",
+ "ECHOE", "libc.scm",
+ "ECHOK", "libc.scm",
+ "ECHONL", "libc.scm",
+ "EDOM", "libc.scm",
+ "EEXIST", "libc.scm",
+ "EFAULT", "libc.scm",
+ "EFBIG", "libc.scm",
+ "EILSEQ", "libc.scm",
+ "EINTR", "libc.scm",
+ "EINVAL", "libc.scm",
+ "EIO", "libc.scm",
+ "EISDIR", "libc.scm",
+ "EMFILE", "libc.scm",
+ "EMLINK", "libc.scm",
+ "ENFILE", "libc.scm",
+ "ENODEV", "libc.scm",
+ "ENOENT", "libc.scm",
+ "ENOEXEC", "libc.scm",
+ "ENOMEM", "libc.scm",
+ "ENOSPC", "libc.scm",
+ "ENOTBLK", "libc.scm",
+ "ENOTDIR", "libc.scm",
+ "ENOTRECOVERABLE", "libc.scm",
+ "ENOTTY", "libc.scm",
+ "ENXIO", "libc.scm",
+ "EOF", "libc.scm",
+ "EOWNERDEAD", "libc.scm",
+ "EPERM", "libc.scm",
+ "EPIPE", "libc.scm",
+ "ERANGE", "libc.scm",
+ "ERFKILL", "libc.scm",
+ "EROFS", "libc.scm",
+ "ESPIPE", "libc.scm",
+ "ESRCH", "libc.scm",
+ "ETXTBSY", "libc.scm",
+ "EXDEV", "libc.scm",
+ "EXIT_FAILURE", "libc.scm",
+ "EXIT_SUCCESS", "libc.scm",
+ "EXPR_NEST_MAX", "libc.scm",
+ "FD_CLOEXEC", "libc.scm",
+ "FE_ALL_EXCEPT", "libc.scm",
+ "FE_DIVBYZERO", "libc.scm",
+ "FE_DOWNWARD", "libc.scm",
+ "FE_INEXACT", "libc.scm",
+ "FE_INVALID", "libc.scm",
+ "FE_OVERFLOW", "libc.scm",
+ "FE_TONEAREST", "libc.scm",
+ "FE_TOWARDZERO", "libc.scm",
+ "FE_UNDERFLOW", "libc.scm",
+ "FE_UPWARD", "libc.scm",
+ "FILENAME_MAX", "libc.scm",
+ "FLT_DIG", "libc.scm",
+ "FLT_EPSILON", "libc.scm",
+ "FLT_MANT_DIG", "libc.scm",
+ "FLT_MAX", "libc.scm",
+ "FLT_MAX_10_EXP", "libc.scm",
+ "FLT_MAX_EXP", "libc.scm",
+ "FLT_MIN", "libc.scm",
+ "FLT_MIN_10_EXP", "libc.scm",
+ "FLT_MIN_EXP", "libc.scm",
+ "FLT_RADIX", "libc.scm",
+ "FLT_ROUNDS", "libc.scm",
+ "FNM_NOESCAPE", "libc.scm",
+ "FNM_NOMATCH", "libc.scm",
+ "FNM_PATHNAME", "libc.scm",
+ "FNM_PERIOD", "libc.scm",
+ "FOPEN_MAX", "libc.scm",
+ "FP_INFINITE", "libm.scm",
+ "FP_NAN", "libm.scm",
+ "FP_NORMAL", "libm.scm",
+ "FP_SUBNORMAL", "libm.scm",
+ "FP_ZERO", "libm.scm",
+ "FTW_D", "libc.scm",
+ "FTW_DNR", "libc.scm",
+ "FTW_F", "libc.scm",
+ "FTW_NS", "libc.scm",
+ "F_DUPFD", "libc.scm",
+ "F_GETFD", "libc.scm",
+ "F_GETFL", "libc.scm",
+ "F_GETLK", "libc.scm",
+ "F_GETLK64", "libc.scm",
+ "F_LOCK", "libc.scm",
+ "F_OK", "libc.scm",
+ "F_RDLCK", "libc.scm",
+ "F_SETFD", "libc.scm",
+ "F_SETFL", "libc.scm",
+ "F_SETLK", "libc.scm",
+ "F_SETLK64", "libc.scm",
+ "F_SETLKW", "libc.scm",
+ "F_SETLKW64", "libc.scm",
+ "F_TEST", "libc.scm",
+ "F_TLOCK", "libc.scm",
+ "F_ULOCK", "libc.scm",
+ "F_UNLCK", "libc.scm",
+ "F_WRLCK", "libc.scm",
+ "GDBM_BAD_FILE_OFFSET", "libgdbm.scm",
+ "GDBM_BAD_MAGIC_NUMBER", "libgdbm.scm",
+ "GDBM_BAD_OPEN_FLAGS", "libgdbm.scm",
+ "GDBM_BLOCK_SIZE_ERROR", "libgdbm.scm",
+ "GDBM_BYTE_SWAPPED", "libgdbm.scm",
+ "GDBM_CACHESIZE", "libgdbm.scm",
+ "GDBM_CANNOT_REPLACE", "libgdbm.scm",
+ "GDBM_CANT_BE_READER", "libgdbm.scm",
+ "GDBM_CANT_BE_WRITER", "libgdbm.scm",
+ "GDBM_CENTFREE", "libgdbm.scm",
+ "GDBM_CLOEXEC", "libgdbm.scm",
+ "GDBM_COALESCEBLKS", "libgdbm.scm",
+ "GDBM_EMPTY_DATABASE", "libgdbm.scm",
+ "GDBM_FAST", "libgdbm.scm",
+ "GDBM_FASTMODE", "libgdbm.scm",
+ "GDBM_FILE_EOF", "libgdbm.scm",
+ "GDBM_FILE_OPEN_ERROR", "libgdbm.scm",
+ "GDBM_FILE_READ_ERROR", "libgdbm.scm",
+ "GDBM_FILE_SEEK_ERROR", "libgdbm.scm",
+ "GDBM_FILE_STAT_ERROR", "libgdbm.scm",
+ "GDBM_FILE_WRITE_ERROR", "libgdbm.scm",
+ "GDBM_GETCACHESIZE", "libgdbm.scm",
+ "GDBM_GETCENTFREE", "libgdbm.scm",
+ "GDBM_GETCOALESCEBLKS", "libgdbm.scm",
+ "GDBM_GETDBNAME", "libgdbm.scm",
+ "GDBM_GETFLAGS", "libgdbm.scm",
+ "GDBM_GETMAXMAPSIZE", "libgdbm.scm",
+ "GDBM_GETMMAP", "libgdbm.scm",
+ "GDBM_GETSYNCMODE", "libgdbm.scm",
+ "GDBM_ILLEGAL_DATA", "libgdbm.scm",
+ "GDBM_INSERT", "libgdbm.scm",
+ "GDBM_ITEM_NOT_FOUND", "libgdbm.scm",
+ "GDBM_MALLOC_ERROR", "libgdbm.scm",
+ "GDBM_NEWDB", "libgdbm.scm",
+ "GDBM_NOLOCK", "libgdbm.scm",
+ "GDBM_NOMMAP", "libgdbm.scm",
+ "GDBM_NO_ERROR", "libgdbm.scm",
+ "GDBM_OPENMASK", "libgdbm.scm",
+ "GDBM_OPT_ALREADY_SET", "libgdbm.scm",
+ "GDBM_OPT_ILLEGAL", "libgdbm.scm",
+ "GDBM_READER", "libgdbm.scm",
+ "GDBM_READER_CANT_DELETE", "libgdbm.scm",
+ "GDBM_READER_CANT_REORGANIZE", "libgdbm.scm",
+ "GDBM_READER_CANT_STORE", "libgdbm.scm",
+ "GDBM_REORGANIZE_FAILED", "libgdbm.scm",
+ "GDBM_REPLACE", "libgdbm.scm",
+ "GDBM_SETCACHESIZE", "libgdbm.scm",
+ "GDBM_SETCENTFREE", "libgdbm.scm",
+ "GDBM_SETCOALESCEBLKS", "libgdbm.scm",
+ "GDBM_SETMAXMAPSIZE", "libgdbm.scm",
+ "GDBM_SETMMAP", "libgdbm.scm",
+ "GDBM_SETSYNCMODE", "libgdbm.scm",
+ "GDBM_SYNC", "libgdbm.scm",
+ "GDBM_SYNCMODE", "libgdbm.scm",
+ "GDBM_UNKNOWN_UPDATE", "libgdbm.scm",
+ "GDBM_VERSION_MAJOR", "libgdbm.scm",
+ "GDBM_VERSION_MINOR", "libgdbm.scm",
+ "GDBM_VERSION_PATCH", "libgdbm.scm",
+ "GDBM_WRCREAT", "libgdbm.scm",
+ "GDBM_WRITER", "libgdbm.scm",
+ "GLOB_ABORTED", "libc.scm",
+ "GLOB_ALTDIRFUNC", "libc.scm",
+ "GLOB_APPEND", "libc.scm",
+ "GLOB_BRACE", "libc.scm",
+ "GLOB_DOOFFS", "libc.scm",
+ "GLOB_ERR", "libc.scm",
+ "GLOB_MAGCHAR", "libc.scm",
+ "GLOB_MARK", "libc.scm",
+ "GLOB_NOCHECK", "libc.scm",
+ "GLOB_NOESCAPE", "libc.scm",
+ "GLOB_NOMAGIC", "libc.scm",
+ "GLOB_NOMATCH", "libc.scm",
+ "GLOB_NOSORT", "libc.scm",
+ "GLOB_NOSPACE", "libc.scm",
+ "GLOB_NOSYS", "libc.scm",
+ "GLOB_ONLYDIR", "libc.scm",
+ "GLOB_PERIOD", "libc.scm",
+ "GLOB_TILDE", "libc.scm",
+ "GLOB_TILDE_CHECK", "libc.scm",
+ "GSL_COMPLEX_EQ", "libgsl.scm",
+ "GSL_COMPLEX_NEGONE", "libgsl.scm",
+ "GSL_COMPLEX_ONE", "libgsl.scm",
+ "GSL_COMPLEX_ZERO", "libgsl.scm",
+ "GSL_CONST_CGSM_ACRE", "libgsl.scm",
+ "GSL_CONST_CGSM_ANGSTROM", "libgsl.scm",
+ "GSL_CONST_CGSM_ASTRONOMICAL_UNIT", "libgsl.scm",
+ "GSL_CONST_CGSM_BAR", "libgsl.scm",
+ "GSL_CONST_CGSM_BARN", "libgsl.scm",
+ "GSL_CONST_CGSM_BOHR_MAGNETON", "libgsl.scm",
+ "GSL_CONST_CGSM_BOHR_RADIUS", "libgsl.scm",
+ "GSL_CONST_CGSM_BOLTZMANN", "libgsl.scm",
+ "GSL_CONST_CGSM_BTU", "libgsl.scm",
+ "GSL_CONST_CGSM_CALORIE", "libgsl.scm",
+ "GSL_CONST_CGSM_CANADIAN_GALLON", "libgsl.scm",
+ "GSL_CONST_CGSM_CARAT", "libgsl.scm",
+ "GSL_CONST_CGSM_CUP", "libgsl.scm",
+ "GSL_CONST_CGSM_CURIE", "libgsl.scm",
+ "GSL_CONST_CGSM_DAY", "libgsl.scm",
+ "GSL_CONST_CGSM_DYNE", "libgsl.scm",
+ "GSL_CONST_CGSM_ELECTRON_CHARGE", "libgsl.scm",
+ "GSL_CONST_CGSM_ELECTRON_MAGNETIC_MOMENT", "libgsl.scm",
+ "GSL_CONST_CGSM_ELECTRON_VOLT", "libgsl.scm",
+ "GSL_CONST_CGSM_ERG", "libgsl.scm",
+ "GSL_CONST_CGSM_FARADAY", "libgsl.scm",
+ "GSL_CONST_CGSM_FATHOM", "libgsl.scm",
+ "GSL_CONST_CGSM_FLUID_OUNCE", "libgsl.scm",
+ "GSL_CONST_CGSM_FOOT", "libgsl.scm",
+ "GSL_CONST_CGSM_FOOTCANDLE", "libgsl.scm",
+ "GSL_CONST_CGSM_FOOTLAMBERT", "libgsl.scm",
+ "GSL_CONST_CGSM_GRAM_FORCE", "libgsl.scm",
+ "GSL_CONST_CGSM_GRAVITATIONAL_CONSTANT", "libgsl.scm",
+ "GSL_CONST_CGSM_GRAV_ACCEL", "libgsl.scm",
+ "GSL_CONST_CGSM_HECTARE", "libgsl.scm",
+ "GSL_CONST_CGSM_HORSEPOWER", "libgsl.scm",
+ "GSL_CONST_CGSM_HOUR", "libgsl.scm",
+ "GSL_CONST_CGSM_INCH", "libgsl.scm",
+ "GSL_CONST_CGSM_INCH_OF_MERCURY", "libgsl.scm",
+ "GSL_CONST_CGSM_INCH_OF_WATER", "libgsl.scm",
+ "GSL_CONST_CGSM_JOULE", "libgsl.scm",
+ "GSL_CONST_CGSM_KILOMETERS_PER_HOUR", "libgsl.scm",
+ "GSL_CONST_CGSM_KILOPOUND_FORCE", "libgsl.scm",
+ "GSL_CONST_CGSM_KNOT", "libgsl.scm",
+ "GSL_CONST_CGSM_LAMBERT", "libgsl.scm",
+ "GSL_CONST_CGSM_LIGHT_YEAR", "libgsl.scm",
+ "GSL_CONST_CGSM_LITER", "libgsl.scm",
+ "GSL_CONST_CGSM_LUMEN", "libgsl.scm",
+ "GSL_CONST_CGSM_LUX", "libgsl.scm",
+ "GSL_CONST_CGSM_MASS_ELECTRON", "libgsl.scm",
+ "GSL_CONST_CGSM_MASS_MUON", "libgsl.scm",
+ "GSL_CONST_CGSM_MASS_NEUTRON", "libgsl.scm",
+ "GSL_CONST_CGSM_MASS_PROTON", "libgsl.scm",
+ "GSL_CONST_CGSM_METER_OF_MERCURY", "libgsl.scm",
+ "GSL_CONST_CGSM_METRIC_TON", "libgsl.scm",
+ "GSL_CONST_CGSM_MICRON", "libgsl.scm",
+ "GSL_CONST_CGSM_MIL", "libgsl.scm",
+ "GSL_CONST_CGSM_MILE", "libgsl.scm",
+ "GSL_CONST_CGSM_MILES_PER_HOUR", "libgsl.scm",
+ "GSL_CONST_CGSM_MINUTE", "libgsl.scm",
+ "GSL_CONST_CGSM_MOLAR_GAS", "libgsl.scm",
+ "GSL_CONST_CGSM_NAUTICAL_MILE", "libgsl.scm",
+ "GSL_CONST_CGSM_NEWTON", "libgsl.scm",
+ "GSL_CONST_CGSM_NUCLEAR_MAGNETON", "libgsl.scm",
+ "GSL_CONST_CGSM_OUNCE_MASS", "libgsl.scm",
+ "GSL_CONST_CGSM_PARSEC", "libgsl.scm",
+ "GSL_CONST_CGSM_PHOT", "libgsl.scm",
+ "GSL_CONST_CGSM_PINT", "libgsl.scm",
+ "GSL_CONST_CGSM_PLANCKS_CONSTANT_H", "libgsl.scm",
+ "GSL_CONST_CGSM_PLANCKS_CONSTANT_HBAR", "libgsl.scm",
+ "GSL_CONST_CGSM_POINT", "libgsl.scm",
+ "GSL_CONST_CGSM_POISE", "libgsl.scm",
+ "GSL_CONST_CGSM_POUNDAL", "libgsl.scm",
+ "GSL_CONST_CGSM_POUND_FORCE", "libgsl.scm",
+ "GSL_CONST_CGSM_POUND_MASS", "libgsl.scm",
+ "GSL_CONST_CGSM_PROTON_MAGNETIC_MOMENT", "libgsl.scm",
+ "GSL_CONST_CGSM_PSI", "libgsl.scm",
+ "GSL_CONST_CGSM_QUART", "libgsl.scm",
+ "GSL_CONST_CGSM_RAD", "libgsl.scm",
+ "GSL_CONST_CGSM_ROENTGEN", "libgsl.scm",
+ "GSL_CONST_CGSM_RYDBERG", "libgsl.scm",
+ "GSL_CONST_CGSM_SOLAR_MASS", "libgsl.scm",
+ "GSL_CONST_CGSM_SPEED_OF_LIGHT", "libgsl.scm",
+ "GSL_CONST_CGSM_STANDARD_GAS_VOLUME", "libgsl.scm",
+ "GSL_CONST_CGSM_STD_ATMOSPHERE", "libgsl.scm",
+ "GSL_CONST_CGSM_STEFAN_BOLTZMANN_CONSTANT", "libgsl.scm",
+ "GSL_CONST_CGSM_STILB", "libgsl.scm",
+ "GSL_CONST_CGSM_STOKES", "libgsl.scm",
+ "GSL_CONST_CGSM_TABLESPOON", "libgsl.scm",
+ "GSL_CONST_CGSM_TEASPOON", "libgsl.scm",
+ "GSL_CONST_CGSM_TEXPOINT", "libgsl.scm",
+ "GSL_CONST_CGSM_THERM", "libgsl.scm",
+ "GSL_CONST_CGSM_THOMSON_CROSS_SECTION", "libgsl.scm",
+ "GSL_CONST_CGSM_TON", "libgsl.scm",
+ "GSL_CONST_CGSM_TORR", "libgsl.scm",
+ "GSL_CONST_CGSM_TROY_OUNCE", "libgsl.scm",
+ "GSL_CONST_CGSM_UK_GALLON", "libgsl.scm",
+ "GSL_CONST_CGSM_UK_TON", "libgsl.scm",
+ "GSL_CONST_CGSM_UNIFIED_ATOMIC_MASS", "libgsl.scm",
+ "GSL_CONST_CGSM_US_GALLON", "libgsl.scm",
+ "GSL_CONST_CGSM_WEEK", "libgsl.scm",
+ "GSL_CONST_CGSM_YARD", "libgsl.scm",
+ "GSL_CONST_CGS_ACRE", "libgsl.scm",
+ "GSL_CONST_CGS_ANGSTROM", "libgsl.scm",
+ "GSL_CONST_CGS_ASTRONOMICAL_UNIT", "libgsl.scm",
+ "GSL_CONST_CGS_BAR", "libgsl.scm",
+ "GSL_CONST_CGS_BARN", "libgsl.scm",
+ "GSL_CONST_CGS_BOHR_RADIUS", "libgsl.scm",
+ "GSL_CONST_CGS_BOLTZMANN", "libgsl.scm",
+ "GSL_CONST_CGS_BTU", "libgsl.scm",
+ "GSL_CONST_CGS_CALORIE", "libgsl.scm",
+ "GSL_CONST_CGS_CANADIAN_GALLON", "libgsl.scm",
+ "GSL_CONST_CGS_CARAT", "libgsl.scm",
+ "GSL_CONST_CGS_CUP", "libgsl.scm",
+ "GSL_CONST_CGS_CURIE", "libgsl.scm",
+ "GSL_CONST_CGS_DAY", "libgsl.scm",
+ "GSL_CONST_CGS_DYNE", "libgsl.scm",
+ "GSL_CONST_CGS_ELECTRON_VOLT", "libgsl.scm",
+ "GSL_CONST_CGS_ERG", "libgsl.scm",
+ "GSL_CONST_CGS_FATHOM", "libgsl.scm",
+ "GSL_CONST_CGS_FLUID_OUNCE", "libgsl.scm",
+ "GSL_CONST_CGS_FOOT", "libgsl.scm",
+ "GSL_CONST_CGS_FOOTCANDLE", "libgsl.scm",
+ "GSL_CONST_CGS_FOOTLAMBERT", "libgsl.scm",
+ "GSL_CONST_CGS_GRAM_FORCE", "libgsl.scm",
+ "GSL_CONST_CGS_GRAVITATIONAL_CONSTANT", "libgsl.scm",
+ "GSL_CONST_CGS_GRAV_ACCEL", "libgsl.scm",
+ "GSL_CONST_CGS_HECTARE", "libgsl.scm",
+ "GSL_CONST_CGS_HORSEPOWER", "libgsl.scm",
+ "GSL_CONST_CGS_HOUR", "libgsl.scm",
+ "GSL_CONST_CGS_INCH", "libgsl.scm",
+ "GSL_CONST_CGS_INCH_OF_MERCURY", "libgsl.scm",
+ "GSL_CONST_CGS_INCH_OF_WATER", "libgsl.scm",
+ "GSL_CONST_CGS_JOULE", "libgsl.scm",
+ "GSL_CONST_CGS_KILOMETERS_PER_HOUR", "libgsl.scm",
+ "GSL_CONST_CGS_KILOPOUND_FORCE", "libgsl.scm",
+ "GSL_CONST_CGS_KNOT", "libgsl.scm",
+ "GSL_CONST_CGS_LAMBERT", "libgsl.scm",
+ "GSL_CONST_CGS_LIGHT_YEAR", "libgsl.scm",
+ "GSL_CONST_CGS_LITER", "libgsl.scm",
+ "GSL_CONST_CGS_LUMEN", "libgsl.scm",
+ "GSL_CONST_CGS_LUX", "libgsl.scm",
+ "GSL_CONST_CGS_MASS_ELECTRON", "libgsl.scm",
+ "GSL_CONST_CGS_MASS_MUON", "libgsl.scm",
+ "GSL_CONST_CGS_MASS_NEUTRON", "libgsl.scm",
+ "GSL_CONST_CGS_MASS_PROTON", "libgsl.scm",
+ "GSL_CONST_CGS_METER_OF_MERCURY", "libgsl.scm",
+ "GSL_CONST_CGS_METRIC_TON", "libgsl.scm",
+ "GSL_CONST_CGS_MICRON", "libgsl.scm",
+ "GSL_CONST_CGS_MIL", "libgsl.scm",
+ "GSL_CONST_CGS_MILE", "libgsl.scm",
+ "GSL_CONST_CGS_MILES_PER_HOUR", "libgsl.scm",
+ "GSL_CONST_CGS_MINUTE", "libgsl.scm",
+ "GSL_CONST_CGS_MOLAR_GAS", "libgsl.scm",
+ "GSL_CONST_CGS_NAUTICAL_MILE", "libgsl.scm",
+ "GSL_CONST_CGS_NEWTON", "libgsl.scm",
+ "GSL_CONST_CGS_OUNCE_MASS", "libgsl.scm",
+ "GSL_CONST_CGS_PARSEC", "libgsl.scm",
+ "GSL_CONST_CGS_PHOT", "libgsl.scm",
+ "GSL_CONST_CGS_PINT", "libgsl.scm",
+ "GSL_CONST_CGS_PLANCKS_CONSTANT_H", "libgsl.scm",
+ "GSL_CONST_CGS_PLANCKS_CONSTANT_HBAR", "libgsl.scm",
+ "GSL_CONST_CGS_POINT", "libgsl.scm",
+ "GSL_CONST_CGS_POISE", "libgsl.scm",
+ "GSL_CONST_CGS_POUNDAL", "libgsl.scm",
+ "GSL_CONST_CGS_POUND_FORCE", "libgsl.scm",
+ "GSL_CONST_CGS_POUND_MASS", "libgsl.scm",
+ "GSL_CONST_CGS_PSI", "libgsl.scm",
+ "GSL_CONST_CGS_QUART", "libgsl.scm",
+ "GSL_CONST_CGS_RAD", "libgsl.scm",
+ "GSL_CONST_CGS_ROENTGEN", "libgsl.scm",
+ "GSL_CONST_CGS_RYDBERG", "libgsl.scm",
+ "GSL_CONST_CGS_SOLAR_MASS", "libgsl.scm",
+ "GSL_CONST_CGS_SPEED_OF_LIGHT", "libgsl.scm",
+ "GSL_CONST_CGS_STANDARD_GAS_VOLUME", "libgsl.scm",
+ "GSL_CONST_CGS_STD_ATMOSPHERE", "libgsl.scm",
+ "GSL_CONST_CGS_STEFAN_BOLTZMANN_CONSTANT", "libgsl.scm",
+ "GSL_CONST_CGS_STILB", "libgsl.scm",
+ "GSL_CONST_CGS_STOKES", "libgsl.scm",
+ "GSL_CONST_CGS_TABLESPOON", "libgsl.scm",
+ "GSL_CONST_CGS_TEASPOON", "libgsl.scm",
+ "GSL_CONST_CGS_TEXPOINT", "libgsl.scm",
+ "GSL_CONST_CGS_THERM", "libgsl.scm",
+ "GSL_CONST_CGS_THOMSON_CROSS_SECTION", "libgsl.scm",
+ "GSL_CONST_CGS_TON", "libgsl.scm",
+ "GSL_CONST_CGS_TORR", "libgsl.scm",
+ "GSL_CONST_CGS_TROY_OUNCE", "libgsl.scm",
+ "GSL_CONST_CGS_UK_GALLON", "libgsl.scm",
+ "GSL_CONST_CGS_UK_TON", "libgsl.scm",
+ "GSL_CONST_CGS_UNIFIED_ATOMIC_MASS", "libgsl.scm",
+ "GSL_CONST_CGS_US_GALLON", "libgsl.scm",
+ "GSL_CONST_CGS_WEEK", "libgsl.scm",
+ "GSL_CONST_CGS_YARD", "libgsl.scm",
+ "GSL_CONST_MKSA_ACRE", "libgsl.scm",
+ "GSL_CONST_MKSA_ANGSTROM", "libgsl.scm",
+ "GSL_CONST_MKSA_ASTRONOMICAL_UNIT", "libgsl.scm",
+ "GSL_CONST_MKSA_BAR", "libgsl.scm",
+ "GSL_CONST_MKSA_BARN", "libgsl.scm",
+ "GSL_CONST_MKSA_BOHR_MAGNETON", "libgsl.scm",
+ "GSL_CONST_MKSA_BOHR_RADIUS", "libgsl.scm",
+ "GSL_CONST_MKSA_BOLTZMANN", "libgsl.scm",
+ "GSL_CONST_MKSA_BTU", "libgsl.scm",
+ "GSL_CONST_MKSA_CALORIE", "libgsl.scm",
+ "GSL_CONST_MKSA_CANADIAN_GALLON", "libgsl.scm",
+ "GSL_CONST_MKSA_CARAT", "libgsl.scm",
+ "GSL_CONST_MKSA_CUP", "libgsl.scm",
+ "GSL_CONST_MKSA_CURIE", "libgsl.scm",
+ "GSL_CONST_MKSA_DAY", "libgsl.scm",
+ "GSL_CONST_MKSA_DEBYE", "libgsl.scm",
+ "GSL_CONST_MKSA_DYNE", "libgsl.scm",
+ "GSL_CONST_MKSA_ELECTRON_CHARGE", "libgsl.scm",
+ "GSL_CONST_MKSA_ELECTRON_MAGNETIC_MOMENT", "libgsl.scm",
+ "GSL_CONST_MKSA_ELECTRON_VOLT", "libgsl.scm",
+ "GSL_CONST_MKSA_ERG", "libgsl.scm",
+ "GSL_CONST_MKSA_FARADAY", "libgsl.scm",
+ "GSL_CONST_MKSA_FATHOM", "libgsl.scm",
+ "GSL_CONST_MKSA_FLUID_OUNCE", "libgsl.scm",
+ "GSL_CONST_MKSA_FOOT", "libgsl.scm",
+ "GSL_CONST_MKSA_FOOTCANDLE", "libgsl.scm",
+ "GSL_CONST_MKSA_FOOTLAMBERT", "libgsl.scm",
+ "GSL_CONST_MKSA_GAUSS", "libgsl.scm",
+ "GSL_CONST_MKSA_GRAM_FORCE", "libgsl.scm",
+ "GSL_CONST_MKSA_GRAVITATIONAL_CONSTANT", "libgsl.scm",
+ "GSL_CONST_MKSA_GRAV_ACCEL", "libgsl.scm",
+ "GSL_CONST_MKSA_HECTARE", "libgsl.scm",
+ "GSL_CONST_MKSA_HORSEPOWER", "libgsl.scm",
+ "GSL_CONST_MKSA_HOUR", "libgsl.scm",
+ "GSL_CONST_MKSA_INCH", "libgsl.scm",
+ "GSL_CONST_MKSA_INCH_OF_MERCURY", "libgsl.scm",
+ "GSL_CONST_MKSA_INCH_OF_WATER", "libgsl.scm",
+ "GSL_CONST_MKSA_JOULE", "libgsl.scm",
+ "GSL_CONST_MKSA_KILOMETERS_PER_HOUR", "libgsl.scm",
+ "GSL_CONST_MKSA_KILOPOUND_FORCE", "libgsl.scm",
+ "GSL_CONST_MKSA_KNOT", "libgsl.scm",
+ "GSL_CONST_MKSA_LAMBERT", "libgsl.scm",
+ "GSL_CONST_MKSA_LIGHT_YEAR", "libgsl.scm",
+ "GSL_CONST_MKSA_LITER", "libgsl.scm",
+ "GSL_CONST_MKSA_LUMEN", "libgsl.scm",
+ "GSL_CONST_MKSA_LUX", "libgsl.scm",
+ "GSL_CONST_MKSA_MASS_ELECTRON", "libgsl.scm",
+ "GSL_CONST_MKSA_MASS_MUON", "libgsl.scm",
+ "GSL_CONST_MKSA_MASS_NEUTRON", "libgsl.scm",
+ "GSL_CONST_MKSA_MASS_PROTON", "libgsl.scm",
+ "GSL_CONST_MKSA_METER_OF_MERCURY", "libgsl.scm",
+ "GSL_CONST_MKSA_METRIC_TON", "libgsl.scm",
+ "GSL_CONST_MKSA_MICRON", "libgsl.scm",
+ "GSL_CONST_MKSA_MIL", "libgsl.scm",
+ "GSL_CONST_MKSA_MILE", "libgsl.scm",
+ "GSL_CONST_MKSA_MILES_PER_HOUR", "libgsl.scm",
+ "GSL_CONST_MKSA_MINUTE", "libgsl.scm",
+ "GSL_CONST_MKSA_MOLAR_GAS", "libgsl.scm",
+ "GSL_CONST_MKSA_NAUTICAL_MILE", "libgsl.scm",
+ "GSL_CONST_MKSA_NEWTON", "libgsl.scm",
+ "GSL_CONST_MKSA_NUCLEAR_MAGNETON", "libgsl.scm",
+ "GSL_CONST_MKSA_OUNCE_MASS", "libgsl.scm",
+ "GSL_CONST_MKSA_PARSEC", "libgsl.scm",
+ "GSL_CONST_MKSA_PHOT", "libgsl.scm",
+ "GSL_CONST_MKSA_PINT", "libgsl.scm",
+ "GSL_CONST_MKSA_PLANCKS_CONSTANT_H", "libgsl.scm",
+ "GSL_CONST_MKSA_PLANCKS_CONSTANT_HBAR", "libgsl.scm",
+ "GSL_CONST_MKSA_POINT", "libgsl.scm",
+ "GSL_CONST_MKSA_POISE", "libgsl.scm",
+ "GSL_CONST_MKSA_POUNDAL", "libgsl.scm",
+ "GSL_CONST_MKSA_POUND_FORCE", "libgsl.scm",
+ "GSL_CONST_MKSA_POUND_MASS", "libgsl.scm",
+ "GSL_CONST_MKSA_PROTON_MAGNETIC_MOMENT", "libgsl.scm",
+ "GSL_CONST_MKSA_PSI", "libgsl.scm",
+ "GSL_CONST_MKSA_QUART", "libgsl.scm",
+ "GSL_CONST_MKSA_RAD", "libgsl.scm",
+ "GSL_CONST_MKSA_ROENTGEN", "libgsl.scm",
+ "GSL_CONST_MKSA_RYDBERG", "libgsl.scm",
+ "GSL_CONST_MKSA_SOLAR_MASS", "libgsl.scm",
+ "GSL_CONST_MKSA_SPEED_OF_LIGHT", "libgsl.scm",
+ "GSL_CONST_MKSA_STANDARD_GAS_VOLUME", "libgsl.scm",
+ "GSL_CONST_MKSA_STD_ATMOSPHERE", "libgsl.scm",
+ "GSL_CONST_MKSA_STEFAN_BOLTZMANN_CONSTANT", "libgsl.scm",
+ "GSL_CONST_MKSA_STILB", "libgsl.scm",
+ "GSL_CONST_MKSA_STOKES", "libgsl.scm",
+ "GSL_CONST_MKSA_TABLESPOON", "libgsl.scm",
+ "GSL_CONST_MKSA_TEASPOON", "libgsl.scm",
+ "GSL_CONST_MKSA_TEXPOINT", "libgsl.scm",
+ "GSL_CONST_MKSA_THERM", "libgsl.scm",
+ "GSL_CONST_MKSA_THOMSON_CROSS_SECTION", "libgsl.scm",
+ "GSL_CONST_MKSA_TON", "libgsl.scm",
+ "GSL_CONST_MKSA_TORR", "libgsl.scm",
+ "GSL_CONST_MKSA_TROY_OUNCE", "libgsl.scm",
+ "GSL_CONST_MKSA_UK_GALLON", "libgsl.scm",
+ "GSL_CONST_MKSA_UK_TON", "libgsl.scm",
+ "GSL_CONST_MKSA_UNIFIED_ATOMIC_MASS", "libgsl.scm",
+ "GSL_CONST_MKSA_US_GALLON", "libgsl.scm",
+ "GSL_CONST_MKSA_VACUUM_PERMEABILITY", "libgsl.scm",
+ "GSL_CONST_MKSA_VACUUM_PERMITTIVITY", "libgsl.scm",
+ "GSL_CONST_MKSA_WEEK", "libgsl.scm",
+ "GSL_CONST_MKSA_YARD", "libgsl.scm",
+ "GSL_CONST_MKS_ACRE", "libgsl.scm",
+ "GSL_CONST_MKS_ANGSTROM", "libgsl.scm",
+ "GSL_CONST_MKS_ASTRONOMICAL_UNIT", "libgsl.scm",
+ "GSL_CONST_MKS_BAR", "libgsl.scm",
+ "GSL_CONST_MKS_BARN", "libgsl.scm",
+ "GSL_CONST_MKS_BOHR_MAGNETON", "libgsl.scm",
+ "GSL_CONST_MKS_BOHR_RADIUS", "libgsl.scm",
+ "GSL_CONST_MKS_BOLTZMANN", "libgsl.scm",
+ "GSL_CONST_MKS_BTU", "libgsl.scm",
+ "GSL_CONST_MKS_CALORIE", "libgsl.scm",
+ "GSL_CONST_MKS_CANADIAN_GALLON", "libgsl.scm",
+ "GSL_CONST_MKS_CARAT", "libgsl.scm",
+ "GSL_CONST_MKS_CUP", "libgsl.scm",
+ "GSL_CONST_MKS_CURIE", "libgsl.scm",
+ "GSL_CONST_MKS_DAY", "libgsl.scm",
+ "GSL_CONST_MKS_DEBYE", "libgsl.scm",
+ "GSL_CONST_MKS_DYNE", "libgsl.scm",
+ "GSL_CONST_MKS_ELECTRON_CHARGE", "libgsl.scm",
+ "GSL_CONST_MKS_ELECTRON_MAGNETIC_MOMENT", "libgsl.scm",
+ "GSL_CONST_MKS_ELECTRON_VOLT", "libgsl.scm",
+ "GSL_CONST_MKS_ERG", "libgsl.scm",
+ "GSL_CONST_MKS_FARADAY", "libgsl.scm",
+ "GSL_CONST_MKS_FATHOM", "libgsl.scm",
+ "GSL_CONST_MKS_FLUID_OUNCE", "libgsl.scm",
+ "GSL_CONST_MKS_FOOT", "libgsl.scm",
+ "GSL_CONST_MKS_FOOTCANDLE", "libgsl.scm",
+ "GSL_CONST_MKS_FOOTLAMBERT", "libgsl.scm",
+ "GSL_CONST_MKS_GAUSS", "libgsl.scm",
+ "GSL_CONST_MKS_GRAM_FORCE", "libgsl.scm",
+ "GSL_CONST_MKS_GRAVITATIONAL_CONSTANT", "libgsl.scm",
+ "GSL_CONST_MKS_GRAV_ACCEL", "libgsl.scm",
+ "GSL_CONST_MKS_HECTARE", "libgsl.scm",
+ "GSL_CONST_MKS_HORSEPOWER", "libgsl.scm",
+ "GSL_CONST_MKS_HOUR", "libgsl.scm",
+ "GSL_CONST_MKS_INCH", "libgsl.scm",
+ "GSL_CONST_MKS_INCH_OF_MERCURY", "libgsl.scm",
+ "GSL_CONST_MKS_INCH_OF_WATER", "libgsl.scm",
+ "GSL_CONST_MKS_JOULE", "libgsl.scm",
+ "GSL_CONST_MKS_KILOMETERS_PER_HOUR", "libgsl.scm",
+ "GSL_CONST_MKS_KILOPOUND_FORCE", "libgsl.scm",
+ "GSL_CONST_MKS_KNOT", "libgsl.scm",
+ "GSL_CONST_MKS_LAMBERT", "libgsl.scm",
+ "GSL_CONST_MKS_LIGHT_YEAR", "libgsl.scm",
+ "GSL_CONST_MKS_LITER", "libgsl.scm",
+ "GSL_CONST_MKS_LUMEN", "libgsl.scm",
+ "GSL_CONST_MKS_LUX", "libgsl.scm",
+ "GSL_CONST_MKS_MASS_ELECTRON", "libgsl.scm",
+ "GSL_CONST_MKS_MASS_MUON", "libgsl.scm",
+ "GSL_CONST_MKS_MASS_NEUTRON", "libgsl.scm",
+ "GSL_CONST_MKS_MASS_PROTON", "libgsl.scm",
+ "GSL_CONST_MKS_METER_OF_MERCURY", "libgsl.scm",
+ "GSL_CONST_MKS_METRIC_TON", "libgsl.scm",
+ "GSL_CONST_MKS_MICRON", "libgsl.scm",
+ "GSL_CONST_MKS_MIL", "libgsl.scm",
+ "GSL_CONST_MKS_MILE", "libgsl.scm",
+ "GSL_CONST_MKS_MILES_PER_HOUR", "libgsl.scm",
+ "GSL_CONST_MKS_MINUTE", "libgsl.scm",
+ "GSL_CONST_MKS_MOLAR_GAS", "libgsl.scm",
+ "GSL_CONST_MKS_NAUTICAL_MILE", "libgsl.scm",
+ "GSL_CONST_MKS_NEWTON", "libgsl.scm",
+ "GSL_CONST_MKS_NUCLEAR_MAGNETON", "libgsl.scm",
+ "GSL_CONST_MKS_OUNCE_MASS", "libgsl.scm",
+ "GSL_CONST_MKS_PARSEC", "libgsl.scm",
+ "GSL_CONST_MKS_PHOT", "libgsl.scm",
+ "GSL_CONST_MKS_PINT", "libgsl.scm",
+ "GSL_CONST_MKS_PLANCKS_CONSTANT_H", "libgsl.scm",
+ "GSL_CONST_MKS_PLANCKS_CONSTANT_HBAR", "libgsl.scm",
+ "GSL_CONST_MKS_POINT", "libgsl.scm",
+ "GSL_CONST_MKS_POISE", "libgsl.scm",
+ "GSL_CONST_MKS_POUNDAL", "libgsl.scm",
+ "GSL_CONST_MKS_POUND_FORCE", "libgsl.scm",
+ "GSL_CONST_MKS_POUND_MASS", "libgsl.scm",
+ "GSL_CONST_MKS_PROTON_MAGNETIC_MOMENT", "libgsl.scm",
+ "GSL_CONST_MKS_PSI", "libgsl.scm",
+ "GSL_CONST_MKS_QUART", "libgsl.scm",
+ "GSL_CONST_MKS_RAD", "libgsl.scm",
+ "GSL_CONST_MKS_ROENTGEN", "libgsl.scm",
+ "GSL_CONST_MKS_RYDBERG", "libgsl.scm",
+ "GSL_CONST_MKS_SOLAR_MASS", "libgsl.scm",
+ "GSL_CONST_MKS_SPEED_OF_LIGHT", "libgsl.scm",
+ "GSL_CONST_MKS_STANDARD_GAS_VOLUME", "libgsl.scm",
+ "GSL_CONST_MKS_STD_ATMOSPHERE", "libgsl.scm",
+ "GSL_CONST_MKS_STEFAN_BOLTZMANN_CONSTANT", "libgsl.scm",
+ "GSL_CONST_MKS_STILB", "libgsl.scm",
+ "GSL_CONST_MKS_STOKES", "libgsl.scm",
+ "GSL_CONST_MKS_TABLESPOON", "libgsl.scm",
+ "GSL_CONST_MKS_TEASPOON", "libgsl.scm",
+ "GSL_CONST_MKS_TEXPOINT", "libgsl.scm",
+ "GSL_CONST_MKS_THERM", "libgsl.scm",
+ "GSL_CONST_MKS_THOMSON_CROSS_SECTION", "libgsl.scm",
+ "GSL_CONST_MKS_TON", "libgsl.scm",
+ "GSL_CONST_MKS_TORR", "libgsl.scm",
+ "GSL_CONST_MKS_TROY_OUNCE", "libgsl.scm",
+ "GSL_CONST_MKS_UK_GALLON", "libgsl.scm",
+ "GSL_CONST_MKS_UK_TON", "libgsl.scm",
+ "GSL_CONST_MKS_UNIFIED_ATOMIC_MASS", "libgsl.scm",
+ "GSL_CONST_MKS_US_GALLON", "libgsl.scm",
+ "GSL_CONST_MKS_VACUUM_PERMEABILITY", "libgsl.scm",
+ "GSL_CONST_MKS_VACUUM_PERMITTIVITY", "libgsl.scm",
+ "GSL_CONST_MKS_WEEK", "libgsl.scm",
+ "GSL_CONST_MKS_YARD", "libgsl.scm",
+ "GSL_CONST_NUM_ATTO", "libgsl.scm",
+ "GSL_CONST_NUM_AVOGADRO", "libgsl.scm",
+ "GSL_CONST_NUM_EXA", "libgsl.scm",
+ "GSL_CONST_NUM_FEMTO", "libgsl.scm",
+ "GSL_CONST_NUM_FINE_STRUCTURE", "libgsl.scm",
+ "GSL_CONST_NUM_GIGA", "libgsl.scm",
+ "GSL_CONST_NUM_KILO", "libgsl.scm",
+ "GSL_CONST_NUM_MEGA", "libgsl.scm",
+ "GSL_CONST_NUM_MICRO", "libgsl.scm",
+ "GSL_CONST_NUM_MILLI", "libgsl.scm",
+ "GSL_CONST_NUM_NANO", "libgsl.scm",
+ "GSL_CONST_NUM_PETA", "libgsl.scm",
+ "GSL_CONST_NUM_PICO", "libgsl.scm",
+ "GSL_CONST_NUM_TERA", "libgsl.scm",
+ "GSL_CONST_NUM_YOCTO", "libgsl.scm",
+ "GSL_CONST_NUM_YOTTA", "libgsl.scm",
+ "GSL_CONST_NUM_ZEPTO", "libgsl.scm",
+ "GSL_CONST_NUM_ZETTA", "libgsl.scm",
+ "GSL_CONTINUE", "libgsl.scm",
+ "GSL_DBL_EPSILON", "libgsl.scm",
+ "GSL_DBL_MAX", "libgsl.scm",
+ "GSL_DBL_MIN", "libgsl.scm",
+ "GSL_EBADFUNC", "libgsl.scm",
+ "GSL_EBADLEN", "libgsl.scm",
+ "GSL_EBADTOL", "libgsl.scm",
+ "GSL_ECACHE", "libgsl.scm",
+ "GSL_EDIVERGE", "libgsl.scm",
+ "GSL_EDOM", "libgsl.scm",
+ "GSL_EFACTOR", "libgsl.scm",
+ "GSL_EFAILED", "libgsl.scm",
+ "GSL_EFAULT", "libgsl.scm",
+ "GSL_EIGEN_SORT_ABS_ASC", "libgsl.scm",
+ "GSL_EIGEN_SORT_ABS_DESC", "libgsl.scm",
+ "GSL_EIGEN_SORT_VAL_ASC", "libgsl.scm",
+ "GSL_EIGEN_SORT_VAL_DESC", "libgsl.scm",
+ "GSL_EINVAL", "libgsl.scm",
+ "GSL_ELOSS", "libgsl.scm",
+ "GSL_EMAXITER", "libgsl.scm",
+ "GSL_ENOMEM", "libgsl.scm",
+ "GSL_ENOPROG", "libgsl.scm",
+ "GSL_ENOPROGJ", "libgsl.scm",
+ "GSL_ENOTSQR", "libgsl.scm",
+ "GSL_EOF", "libgsl.scm",
+ "GSL_EOVRFLW", "libgsl.scm",
+ "GSL_ERANGE", "libgsl.scm",
+ "GSL_EROUND", "libgsl.scm",
+ "GSL_ERUNAWAY", "libgsl.scm",
+ "GSL_ESANITY", "libgsl.scm",
+ "GSL_ESING", "libgsl.scm",
+ "GSL_ETABLE", "libgsl.scm",
+ "GSL_ETOL", "libgsl.scm",
+ "GSL_ETOLF", "libgsl.scm",
+ "GSL_ETOLG", "libgsl.scm",
+ "GSL_ETOLX", "libgsl.scm",
+ "GSL_EUNDRFLW", "libgsl.scm",
+ "GSL_EUNIMPL", "libgsl.scm",
+ "GSL_EUNSUP", "libgsl.scm",
+ "GSL_EZERODIV", "libgsl.scm",
+ "GSL_FAILURE", "libgsl.scm",
+ "GSL_FLT_EPSILON", "libgsl.scm",
+ "GSL_FLT_MAX", "libgsl.scm",
+ "GSL_FLT_MIN", "libgsl.scm",
+ "GSL_IEEE_DOUBLE_PRECISION", "libgsl.scm",
+ "GSL_IEEE_EXTENDED_PRECISION", "libgsl.scm",
+ "GSL_IEEE_MASK_ALL", "libgsl.scm",
+ "GSL_IEEE_MASK_DENORMALIZED", "libgsl.scm",
+ "GSL_IEEE_MASK_DIVISION_BY_ZERO", "libgsl.scm",
+ "GSL_IEEE_MASK_INVALID", "libgsl.scm",
+ "GSL_IEEE_MASK_OVERFLOW", "libgsl.scm",
+ "GSL_IEEE_MASK_UNDERFLOW", "libgsl.scm",
+ "GSL_IEEE_ROUND_DOWN", "libgsl.scm",
+ "GSL_IEEE_ROUND_TO_NEAREST", "libgsl.scm",
+ "GSL_IEEE_ROUND_TO_ZERO", "libgsl.scm",
+ "GSL_IEEE_ROUND_UP", "libgsl.scm",
+ "GSL_IEEE_SINGLE_PRECISION", "libgsl.scm",
+ "GSL_IEEE_TRAP_INEXACT", "libgsl.scm",
+ "GSL_IEEE_TYPE_DENORMAL", "libgsl.scm",
+ "GSL_IEEE_TYPE_INF", "libgsl.scm",
+ "GSL_IEEE_TYPE_NAN", "libgsl.scm",
+ "GSL_IEEE_TYPE_NORMAL", "libgsl.scm",
+ "GSL_IEEE_TYPE_ZERO", "libgsl.scm",
+ "GSL_IMAG", "libgsl.scm",
+ "GSL_INTEG_GAUSS15", "libgsl.scm",
+ "GSL_INTEG_GAUSS21", "libgsl.scm",
+ "GSL_INTEG_GAUSS31", "libgsl.scm",
+ "GSL_INTEG_GAUSS41", "libgsl.scm",
+ "GSL_INTEG_GAUSS51", "libgsl.scm",
+ "GSL_INTEG_GAUSS61", "libgsl.scm",
+ "GSL_IS_EVEN", "libgsl.scm",
+ "GSL_IS_ODD", "libgsl.scm",
+ "GSL_IS_REAL", "libgsl.scm",
+ "GSL_LINALG_MOD_CONJUGATE", "libgsl.scm",
+ "GSL_LINALG_MOD_NONE", "libgsl.scm",
+ "GSL_LINALG_MOD_TRANSPOSE", "libgsl.scm",
+ "GSL_LOG_DBL_EPSILON", "libgsl.scm",
+ "GSL_LOG_DBL_MAX", "libgsl.scm",
+ "GSL_LOG_DBL_MIN", "libgsl.scm",
+ "GSL_LOG_FLT_EPSILON", "libgsl.scm",
+ "GSL_LOG_FLT_MAX", "libgsl.scm",
+ "GSL_LOG_FLT_MIN", "libgsl.scm",
+ "GSL_LOG_MACH_EPS", "libgsl.scm",
+ "GSL_LOG_SFLT_EPSILON", "libgsl.scm",
+ "GSL_MACH_EPS", "libgsl.scm",
+ "GSL_MAJOR_VERSION", "libgsl.scm",
+ "GSL_MAX", "libgsl.scm",
+ "GSL_MAX_DBL", "libgsl.scm",
+ "GSL_MAX_INT", "libgsl.scm",
+ "GSL_MESSAGE_MASK_A", "libgsl.scm",
+ "GSL_MESSAGE_MASK_B", "libgsl.scm",
+ "GSL_MESSAGE_MASK_C", "libgsl.scm",
+ "GSL_MESSAGE_MASK_D", "libgsl.scm",
+ "GSL_MESSAGE_MASK_E", "libgsl.scm",
+ "GSL_MESSAGE_MASK_F", "libgsl.scm",
+ "GSL_MESSAGE_MASK_G", "libgsl.scm",
+ "GSL_MESSAGE_MASK_H", "libgsl.scm",
+ "GSL_MIN", "libgsl.scm",
+ "GSL_MINOR_VERSION", "libgsl.scm",
+ "GSL_MIN_DBL", "libgsl.scm",
+ "GSL_MIN_INT", "libgsl.scm",
+ "GSL_MODE_DEFAULT", "libgsl.scm",
+ "GSL_NAN", "libgsl.scm",
+ "GSL_NEGINF", "libgsl.scm",
+ "GSL_NEGZERO", "libgsl.scm",
+ "GSL_POSINF", "libgsl.scm",
+ "GSL_POSZERO", "libgsl.scm",
+ "GSL_PREC_APPROX", "libgsl.scm",
+ "GSL_PREC_DOUBLE", "libgsl.scm",
+ "GSL_PREC_SINGLE", "libgsl.scm",
+ "GSL_REAL", "libgsl.scm",
+ "GSL_ROOT3_DBL_EPSILON", "libgsl.scm",
+ "GSL_ROOT3_DBL_MAX", "libgsl.scm",
+ "GSL_ROOT3_DBL_MIN", "libgsl.scm",
+ "GSL_ROOT3_FLT_EPSILON", "libgsl.scm",
+ "GSL_ROOT3_FLT_MAX", "libgsl.scm",
+ "GSL_ROOT3_FLT_MIN", "libgsl.scm",
+ "GSL_ROOT3_MACH_EPS", "libgsl.scm",
+ "GSL_ROOT3_SFLT_EPSILON", "libgsl.scm",
+ "GSL_ROOT4_DBL_EPSILON", "libgsl.scm",
+ "GSL_ROOT4_DBL_MAX", "libgsl.scm",
+ "GSL_ROOT4_DBL_MIN", "libgsl.scm",
+ "GSL_ROOT4_FLT_EPSILON", "libgsl.scm",
+ "GSL_ROOT4_FLT_MAX", "libgsl.scm",
+ "GSL_ROOT4_FLT_MIN", "libgsl.scm",
+ "GSL_ROOT4_MACH_EPS", "libgsl.scm",
+ "GSL_ROOT4_SFLT_EPSILON", "libgsl.scm",
+ "GSL_ROOT5_DBL_EPSILON", "libgsl.scm",
+ "GSL_ROOT5_DBL_MAX", "libgsl.scm",
+ "GSL_ROOT5_DBL_MIN", "libgsl.scm",
+ "GSL_ROOT5_FLT_EPSILON", "libgsl.scm",
+ "GSL_ROOT5_FLT_MAX", "libgsl.scm",
+ "GSL_ROOT5_FLT_MIN", "libgsl.scm",
+ "GSL_ROOT5_MACH_EPS", "libgsl.scm",
+ "GSL_ROOT5_SFLT_EPSILON", "libgsl.scm",
+ "GSL_ROOT6_DBL_EPSILON", "libgsl.scm",
+ "GSL_ROOT6_DBL_MAX", "libgsl.scm",
+ "GSL_ROOT6_DBL_MIN", "libgsl.scm",
+ "GSL_ROOT6_FLT_EPSILON", "libgsl.scm",
+ "GSL_ROOT6_FLT_MAX", "libgsl.scm",
+ "GSL_ROOT6_FLT_MIN", "libgsl.scm",
+ "GSL_ROOT6_MACH_EPS", "libgsl.scm",
+ "GSL_ROOT6_SFLT_EPSILON", "libgsl.scm",
+ "GSL_SFLT_EPSILON", "libgsl.scm",
+ "GSL_SF_DOUBLEFACT_NMAX", "libgsl.scm",
+ "GSL_SF_FACT_NMAX", "libgsl.scm",
+ "GSL_SF_GAMMA_XMAX", "libgsl.scm",
+ "GSL_SF_MATHIEU_COEFF", "libgsl.scm",
+ "GSL_SIGN", "libgsl.scm",
+ "GSL_SPMATRIX_CCS", "libgsl.scm",
+ "GSL_SPMATRIX_TRIPLET", "libgsl.scm",
+ "GSL_SQRT_DBL_EPSILON", "libgsl.scm",
+ "GSL_SQRT_DBL_MAX", "libgsl.scm",
+ "GSL_SQRT_DBL_MIN", "libgsl.scm",
+ "GSL_SQRT_FLT_EPSILON", "libgsl.scm",
+ "GSL_SQRT_FLT_MAX", "libgsl.scm",
+ "GSL_SQRT_FLT_MIN", "libgsl.scm",
+ "GSL_SQRT_MACH_EPS", "libgsl.scm",
+ "GSL_SQRT_SFLT_EPSILON", "libgsl.scm",
+ "GSL_SUCCESS", "libgsl.scm",
+ "GSL_VERSION", "libgsl.scm",
+ "ICANON", "libc.scm",
+ "ICRNL", "libc.scm",
+ "IEXTEN", "libc.scm",
+ "IGNBRK", "libc.scm",
+ "IGNCR", "libc.scm",
+ "IGNPAR", "libc.scm",
+ "IMAXBEL", "libc.scm",
+ "INLCR", "libc.scm",
+ "INPCK", "libc.scm",
+ "INT16_MAX", "libc.scm",
+ "INT16_MIN", "libc.scm",
+ "INT32_MAX", "libc.scm",
+ "INT32_MIN", "libc.scm",
+ "INT64_MAX", "libc.scm",
+ "INT64_MIN", "libc.scm",
+ "INT8_MAX", "libc.scm",
+ "INT8_MIN", "libc.scm",
+ "INTMAX_MAX", "libc.scm",
+ "INTMAX_MIN", "libc.scm",
+ "INTPTR_MAX", "libc.scm",
+ "INTPTR_MIN", "libc.scm",
+ "INT_FAST16_MAX", "libc.scm",
+ "INT_FAST16_MIN", "libc.scm",
+ "INT_FAST32_MAX", "libc.scm",
+ "INT_FAST32_MIN", "libc.scm",
+ "INT_FAST64_MAX", "libc.scm",
+ "INT_FAST64_MIN", "libc.scm",
+ "INT_FAST8_MAX", "libc.scm",
+ "INT_FAST8_MIN", "libc.scm",
+ "INT_LEAST16_MAX", "libc.scm",
+ "INT_LEAST16_MIN", "libc.scm",
+ "INT_LEAST32_MAX", "libc.scm",
+ "INT_LEAST32_MIN", "libc.scm",
+ "INT_LEAST64_MAX", "libc.scm",
+ "INT_LEAST64_MIN", "libc.scm",
+ "INT_LEAST8_MAX", "libc.scm",
+ "INT_LEAST8_MIN", "libc.scm",
+ "INT_MAX", "libc.scm",
+ "INT_MIN", "libc.scm",
+ "IPPORT_BIFFUDP", "libc.scm",
+ "IPPORT_CMDSERVER", "libc.scm",
+ "IPPORT_DAYTIME", "libc.scm",
+ "IPPORT_DISCARD", "libc.scm",
+ "IPPORT_ECHO", "libc.scm",
+ "IPPORT_EFSSERVER", "libc.scm",
+ "IPPORT_EXECSERVER", "libc.scm",
+ "IPPORT_FINGER", "libc.scm",
+ "IPPORT_FTP", "libc.scm",
+ "IPPORT_LOGINSERVER", "libc.scm",
+ "IPPORT_MTP", "libc.scm",
+ "IPPORT_NAMESERVER", "libc.scm",
+ "IPPORT_NETSTAT", "libc.scm",
+ "IPPORT_RESERVED", "libc.scm",
+ "IPPORT_RJE", "libc.scm",
+ "IPPORT_ROUTESERVER", "libc.scm",
+ "IPPORT_SMTP", "libc.scm",
+ "IPPORT_SUPDUP", "libc.scm",
+ "IPPORT_SYSTAT", "libc.scm",
+ "IPPORT_TELNET", "libc.scm",
+ "IPPORT_TFTP", "libc.scm",
+ "IPPORT_TIMESERVER", "libc.scm",
+ "IPPORT_TTYLINK", "libc.scm",
+ "IPPORT_USERRESERVED", "libc.scm",
+ "IPPORT_WHOIS", "libc.scm",
+ "IPPORT_WHOSERVER", "libc.scm",
+ "IPPROTO_AH", "libc.scm",
+ "IPPROTO_COMP", "libc.scm",
+ "IPPROTO_DCCP", "libc.scm",
+ "IPPROTO_DSTOPTS", "libc.scm",
+ "IPPROTO_EGP", "libc.scm",
+ "IPPROTO_ENCAP", "libc.scm",
+ "IPPROTO_ESP", "libc.scm",
+ "IPPROTO_FRAGMENT", "libc.scm",
+ "IPPROTO_GRE", "libc.scm",
+ "IPPROTO_HOPOPTS", "libc.scm",
+ "IPPROTO_ICMP", "libc.scm",
+ "IPPROTO_ICMPV6", "libc.scm",
+ "IPPROTO_IDP", "libc.scm",
+ "IPPROTO_IGMP", "libc.scm",
+ "IPPROTO_IP", "libc.scm",
+ "IPPROTO_IPIP", "libc.scm",
+ "IPPROTO_IPV6", "libc.scm",
+ "IPPROTO_MTP", "libc.scm",
+ "IPPROTO_NONE", "libc.scm",
+ "IPPROTO_PIM", "libc.scm",
+ "IPPROTO_PUP", "libc.scm",
+ "IPPROTO_RAW", "libc.scm",
+ "IPPROTO_ROUTING", "libc.scm",
+ "IPPROTO_RSVP", "libc.scm",
+ "IPPROTO_SCTP", "libc.scm",
+ "IPPROTO_TCP", "libc.scm",
+ "IPPROTO_TP", "libc.scm",
+ "IPPROTO_UDP", "libc.scm",
+ "IPPROTO_UDPLITE", "libc.scm",
+ "ISIG", "libc.scm",
+ "ISTRIP", "libc.scm",
+ "IUCLC", "libc.scm",
+ "IUTF8", "libc.scm",
+ "IXANY", "libc.scm",
+ "IXOFF", "libc.scm",
+ "IXON", "libc.scm",
+ "LC_ADDRESS", "libc.scm",
+ "LC_ALL", "libc.scm",
+ "LC_COLLATE", "libc.scm",
+ "LC_CTYPE", "libc.scm",
+ "LC_IDENTIFICATION", "libc.scm",
+ "LC_MEASUREMENT", "libc.scm",
+ "LC_MESSAGES", "libc.scm",
+ "LC_MONETARY", "libc.scm",
+ "LC_NAME", "libc.scm",
+ "LC_NUMERIC", "libc.scm",
+ "LC_PAPER", "libc.scm",
+ "LC_TELEPHONE", "libc.scm",
+ "LC_TIME", "libc.scm",
+ "LDBL_DIG", "libc.scm",
+ "LDBL_EPSILON", "libc.scm",
+ "LDBL_MANT_DIG", "libc.scm",
+ "LDBL_MAX", "libc.scm",
+ "LDBL_MAX_10_EXP", "libc.scm",
+ "LDBL_MAX_EXP", "libc.scm",
+ "LDBL_MIN", "libc.scm",
+ "LDBL_MIN_10_EXP", "libc.scm",
+ "LDBL_MIN_EXP", "libc.scm",
+ "LINE_MAX", "libc.scm",
+ "LLONG_MAX", "libc.scm",
+ "LLONG_MIN", "libc.scm",
+ "LONG_MAX", "libc.scm",
+ "LONG_MIN", "libc.scm",
+ "L_ctermid", "libc.scm",
+ "L_tmpnam", "libc.scm",
+ "MB_CUR_MAX", "libc.scm",
+ "MSG_CMSG_CLOEXEC", "libc.scm",
+ "MSG_CONFIRM", "libc.scm",
+ "MSG_CTRUNC", "libc.scm",
+ "MSG_DONTROUTE", "libc.scm",
+ "MSG_DONTWAIT", "libc.scm",
+ "MSG_EOR", "libc.scm",
+ "MSG_ERRQUEUE", "libc.scm",
+ "MSG_FIN", "libc.scm",
+ "MSG_MORE", "libc.scm",
+ "MSG_NOSIGNAL", "libc.scm",
+ "MSG_OOB", "libc.scm",
+ "MSG_PEEK", "libc.scm",
+ "MSG_PROXY", "libc.scm",
+ "MSG_RST", "libc.scm",
+ "MSG_SYN", "libc.scm",
+ "MSG_TRUNC", "libc.scm",
+ "MSG_WAITALL", "libc.scm",
+ "MSG_WAITFORONE", "libc.scm",
+ "M_1_PI", "libm.scm",
+ "M_2_PI", "libm.scm",
+ "M_2_SQRTPI", "libm.scm",
+ "M_E", "libm.scm",
+ "M_LN10", "libm.scm",
+ "M_LN2", "libm.scm",
+ "M_LOG10E", "libm.scm",
+ "M_LOG2E", "libm.scm",
+ "M_PI", "libm.scm",
+ "M_PI_2", "libm.scm",
+ "M_PI_4", "libm.scm",
+ "M_SQRT1_2", "libm.scm",
+ "M_SQRT2", "libm.scm",
+ "NGROUPS_MAX", "libc.scm",
+ "NI_DGRAM", "libc.scm",
+ "NI_NAMEREQD", "libc.scm",
+ "NI_NOFQDN", "libc.scm",
+ "NI_NUMERICHOST", "libc.scm",
+ "NI_NUMERICSERV", "libc.scm",
+ "NOFLSH", "libc.scm",
+ "NSS_BUFLEN_PASSWD", "libc.scm",
+ "NULL", "libc.scm",
+ "OCRNL", "libc.scm",
+ "OFDEL", "libc.scm",
+ "OFILL", "libc.scm",
+ "OLCUC", "libc.scm",
+ "ONLCR", "libc.scm",
+ "ONLRET", "libc.scm",
+ "ONOCR", "libc.scm",
+ "OPOST", "libc.scm",
+ "O_ACCMODE", "libc.scm",
+ "O_APPEND", "libc.scm",
+ "O_ASYNC", "libc.scm",
+ "O_CREAT", "libc.scm",
+ "O_DSYNC", "libc.scm",
+ "O_EXCL", "libc.scm",
+ "O_FSYNC", "libc.scm",
+ "O_NDELAY", "libc.scm",
+ "O_NOCTTY", "libc.scm",
+ "O_NONBLOCK", "libc.scm",
+ "O_RDONLY", "libc.scm",
+ "O_RDWR", "libc.scm",
+ "O_RSYNC", "libc.scm",
+ "O_SYNC", "libc.scm",
+ "O_TRUNC", "libc.scm",
+ "O_WRONLY", "libc.scm",
+ "PARMRK", "libc.scm",
+ "PF_APPLETALK", "libc.scm",
+ "PF_ASH", "libc.scm",
+ "PF_ATMPVC", "libc.scm",
+ "PF_ATMSVC", "libc.scm",
+ "PF_AX25", "libc.scm",
+ "PF_BLUETOOTH", "libc.scm",
+ "PF_BRIDGE", "libc.scm",
+ "PF_CAN", "libc.scm",
+ "PF_DECnet", "libc.scm",
+ "PF_ECONET", "libc.scm",
+ "PF_FILE", "libc.scm",
+ "PF_IEEE802154", "libc.scm",
+ "PF_INET", "libc.scm",
+ "PF_INET6", "libc.scm",
+ "PF_IPX", "libc.scm",
+ "PF_IRDA", "libc.scm",
+ "PF_ISDN", "libc.scm",
+ "PF_IUCV", "libc.scm",
+ "PF_KEY", "libc.scm",
+ "PF_LLC", "libc.scm",
+ "PF_LOCAL", "libc.scm",
+ "PF_MAX", "libc.scm",
+ "PF_NETBEUI", "libc.scm",
+ "PF_NETLINK", "libc.scm",
+ "PF_NETROM", "libc.scm",
+ "PF_PACKET", "libc.scm",
+ "PF_PHONET", "libc.scm",
+ "PF_PPPOX", "libc.scm",
+ "PF_RDS", "libc.scm",
+ "PF_ROSE", "libc.scm",
+ "PF_ROUTE", "libc.scm",
+ "PF_RXRPC", "libc.scm",
+ "PF_SECURITY", "libc.scm",
+ "PF_SNA", "libc.scm",
+ "PF_TIPC", "libc.scm",
+ "PF_UNIX", "libc.scm",
+ "PF_UNSPEC", "libc.scm",
+ "PF_WANPIPE", "libc.scm",
+ "PF_X25", "libc.scm",
+ "POSIX_FADV_DONTNEED", "libc.scm",
+ "POSIX_FADV_NOREUSE", "libc.scm",
+ "POSIX_FADV_NORMAL", "libc.scm",
+ "POSIX_FADV_RANDOM", "libc.scm",
+ "POSIX_FADV_SEQUENTIAL", "libc.scm",
+ "POSIX_FADV_WILLNEED", "libc.scm",
+ "PRIO_MAX", "libc.scm",
+ "PRIO_MIN", "libc.scm",
+ "PRIO_PGRP", "libc.scm",
+ "PRIO_PROCESS", "libc.scm",
+ "PRIO_USER", "libc.scm",
+ "PTRDIFF_MAX", "libc.scm",
+ "PTRDIFF_MIN", "libc.scm",
+ "P_tmpdir", "libc.scm",
+ "RAND_MAX", "libc.scm",
+ "RE_DUP_MAX", "libc.scm",
+ "RLIMIT_AS", "libc.scm",
+ "RLIMIT_CORE", "libc.scm",
+ "RLIMIT_CPU", "libc.scm",
+ "RLIMIT_DATA", "libc.scm",
+ "RLIMIT_FSIZE", "libc.scm",
+ "RLIMIT_LOCKS", "libc.scm",
+ "RLIMIT_MEMLOCK", "libc.scm",
+ "RLIMIT_MSGQUEUE", "libc.scm",
+ "RLIMIT_NICE", "libc.scm",
+ "RLIMIT_NLIMITS", "libc.scm",
+ "RLIMIT_NOFILE", "libc.scm",
+ "RLIMIT_NPROC", "libc.scm",
+ "RLIMIT_OFILE", "libc.scm",
+ "RLIMIT_RSS", "libc.scm",
+ "RLIMIT_RTPRIO", "libc.scm",
+ "RLIMIT_SIGPENDING", "libc.scm",
+ "RLIMIT_STACK", "libc.scm",
+ "RLIM_INFINITY", "libc.scm",
+ "RLIM_NLIMITS", "libc.scm",
+ "RLIM_SAVED_CUR", "libc.scm",
+ "RLIM_SAVED_MAX", "libc.scm",
+ "RTLD_BINDING_MASK", "libdl.scm",
+ "RTLD_DEEPBIND", "libdl.scm",
+ "RTLD_LOCAL", "libdl.scm",
+ "RTLD_NODELETE", "libdl.scm",
+ "RTLD_NOLOAD", "libdl.scm",
+ "RUSAGE_CHILDREN", "libc.scm",
+ "RUSAGE_SELF", "libc.scm",
+ "R_OK", "libc.scm",
+ "SA_NOCLDSTOP", "libc.scm",
+ "SA_NOCLDWAIT", "libc.scm",
+ "SA_NODEFER", "libc.scm",
+ "SA_NOMASK", "libc.scm",
+ "SA_ONESHOT", "libc.scm",
+ "SA_ONSTACK", "libc.scm",
+ "SA_RESETHAND", "libc.scm",
+ "SA_RESTART", "libc.scm",
+ "SA_SIGINFO", "libc.scm",
+ "SA_STACK", "libc.scm",
+ "SCHAR_MAX", "libc.scm",
+ "SCHAR_MIN", "libc.scm",
+ "SEEK_CUR", "libc.scm",
+ "SEEK_END", "libc.scm",
+ "SEEK_SET", "libc.scm",
+ "SHRT_MAX", "libc.scm",
+ "SHRT_MIN", "libc.scm",
+ "SHUT_RD", "libc.scm",
+ "SHUT_RDWR", "libc.scm",
+ "SHUT_WR", "libc.scm",
+ "SIGABRT", "libc.scm",
+ "SIGALRM", "libc.scm",
+ "SIGBUS", "libc.scm",
+ "SIGCHLD", "libc.scm",
+ "SIGCLD", "libc.scm",
+ "SIGCONT", "libc.scm",
+ "SIGFPE", "libc.scm",
+ "SIGHUP", "libc.scm",
+ "SIGILL", "libc.scm",
+ "SIGINT", "libc.scm",
+ "SIGIO", "libc.scm",
+ "SIGIOT", "libc.scm",
+ "SIGKILL", "libc.scm",
+ "SIGPIPE", "libc.scm",
+ "SIGPOLL", "libc.scm",
+ "SIGPROF", "libc.scm",
+ "SIGPWR", "libc.scm",
+ "SIGQUIT", "libc.scm",
+ "SIGSEGV", "libc.scm",
+ "SIGSTKFLT", "libc.scm",
+ "SIGSTOP", "libc.scm",
+ "SIGSYS", "libc.scm",
+ "SIGTERM", "libc.scm",
+ "SIGTRAP", "libc.scm",
+ "SIGTSTP", "libc.scm",
+ "SIGTTIN", "libc.scm",
+ "SIGTTOU", "libc.scm",
+ "SIGUNUSED", "libc.scm",
+ "SIGURG", "libc.scm",
+ "SIGUSR1", "libc.scm",
+ "SIGUSR2", "libc.scm",
+ "SIGVTALRM", "libc.scm",
+ "SIGWINCH", "libc.scm",
+ "SIGXCPU", "libc.scm",
+ "SIGXFSZ", "libc.scm",
+ "SIG_ATOMIC_MAX", "libc.scm",
+ "SIG_ATOMIC_MIN", "libc.scm",
+ "SIG_BLOCK", "libc.scm",
+ "SIG_DFL", "libc.scm",
+ "SIG_ERR", "libc.scm",
+ "SIG_IGN", "libc.scm",
+ "SIG_SETMASK", "libc.scm",
+ "SIG_UNBLOCK", "libc.scm",
+ "SIZE_MAX", "libc.scm",
+ "SOCK_CLOEXEC", "libc.scm",
+ "SOCK_DCCP", "libc.scm",
+ "SOCK_DGRAM", "libc.scm",
+ "SOCK_NONBLOCK", "libc.scm",
+ "SOCK_PACKET", "libc.scm",
+ "SOCK_RAW", "libc.scm",
+ "SOCK_RDM", "libc.scm",
+ "SOCK_SEQPACKET", "libc.scm",
+ "SOCK_STREAM", "libc.scm",
+ "SOL_AAL", "libc.scm",
+ "SOL_ATM", "libc.scm",
+ "SOL_DECNET", "libc.scm",
+ "SOL_IRDA", "libc.scm",
+ "SOL_PACKET", "libc.scm",
+ "SOL_RAW", "libc.scm",
+ "SOL_X25", "libc.scm",
+ "SSIZE_MAX", "libc.scm",
+ "STDERR_FILENO", "libc.scm",
+ "STDIN_FILENO", "libc.scm",
+ "STDOUT_FILENO", "libc.scm",
+ "S_IFBLK", "libc.scm",
+ "S_IFCHR", "libc.scm",
+ "S_IFDIR", "libc.scm",
+ "S_IFIFO", "libc.scm",
+ "S_IFLNK", "libc.scm",
+ "S_IFMT", "libc.scm",
+ "S_IFREG", "libc.scm",
+ "S_IFSOCK", "libc.scm",
+ "S_IRGRP", "libc.scm",
+ "S_IROTH", "libc.scm",
+ "S_IRUSR", "libc.scm",
+ "S_IRWXG", "libc.scm",
+ "S_IRWXO", "libc.scm",
+ "S_IRWXU", "libc.scm",
+ "S_ISBLK", "libc.scm",
+ "S_ISCHR", "libc.scm",
+ "S_ISDIR", "libc.scm",
+ "S_ISFIFO", "libc.scm",
+ "S_ISGID", "libc.scm",
+ "S_ISLNK", "libc.scm",
+ "S_ISREG", "libc.scm",
+ "S_ISSOCK", "libc.scm",
+ "S_ISUID", "libc.scm",
+ "S_IWGRP", "libc.scm",
+ "S_IWOTH", "libc.scm",
+ "S_IWUSR", "libc.scm",
+ "S_IXGRP", "libc.scm",
+ "S_IXOTH", "libc.scm",
+ "S_IXUSR", "libc.scm",
+ "Si", "numerics.scm",
+ "TCIFLUSH", "libc.scm",
+ "TCIOFF", "libc.scm",
+ "TCIOFLUSH", "libc.scm",
+ "TCION", "libc.scm",
+ "TCOFLUSH", "libc.scm",
+ "TCOOFF", "libc.scm",
+ "TCOON", "libc.scm",
+ "TCSADRAIN", "libc.scm",
+ "TCSAFLUSH", "libc.scm",
+ "TCSANOW", "libc.scm",
+ "TMP_MAX", "libc.scm",
+ "TOSTOP", "libc.scm",
+ "UCHAR_MAX", "libc.scm",
+ "UINT16_MAX", "libc.scm",
+ "UINT32_MAX", "libc.scm",
+ "UINT64_MAX", "libc.scm",
+ "UINT8_MAX", "libc.scm",
+ "UINTMAX_MAX", "libc.scm",
+ "UINTPTR_MAX", "libc.scm",
+ "UINT_FAST16_MAX", "libc.scm",
+ "UINT_FAST32_MAX", "libc.scm",
+ "UINT_FAST64_MAX", "libc.scm",
+ "UINT_FAST8_MAX", "libc.scm",
+ "UINT_LEAST16_MAX", "libc.scm",
+ "UINT_LEAST32_MAX", "libc.scm",
+ "UINT_LEAST64_MAX", "libc.scm",
+ "UINT_LEAST8_MAX", "libc.scm",
+ "UINT_MAX", "libc.scm",
+ "ULLONG_MAX", "libc.scm",
+ "ULONG_MAX", "libc.scm",
+ "USHRT_MAX", "libc.scm",
+ "VDISCARD", "libc.scm",
+ "VEOF", "libc.scm",
+ "VEOL", "libc.scm",
+ "VEOL2", "libc.scm",
+ "VERASE", "libc.scm",
+ "VINTR", "libc.scm",
+ "VKILL", "libc.scm",
+ "VLNEXT", "libc.scm",
+ "VMIN", "libc.scm",
+ "VQUIT", "libc.scm",
+ "VREPRINT", "libc.scm",
+ "VSTART", "libc.scm",
+ "VSTOP", "libc.scm",
+ "VSUSP", "libc.scm",
+ "VSWTC", "libc.scm",
+ "VTIME", "libc.scm",
+ "VWERASE", "libc.scm",
+ "WCHAR_MAX", "libc.scm",
+ "WCHAR_MIN", "libc.scm",
+ "WCONTINUED", "libc.scm",
+ "WEXITED", "libc.scm",
+ "WEXITSTATUS", "libc.scm",
+ "WIFEXITED", "libc.scm",
+ "WIFSIGNALED", "libc.scm",
+ "WIFSTOPPED", "libc.scm",
+ "WINT_MAX", "libc.scm",
+ "WINT_MIN", "libc.scm",
+ "WNOHANG", "libc.scm",
+ "WNOWAIT", "libc.scm",
+ "WRDE_APPEND", "libc.scm",
+ "WRDE_BADCHAR", "libc.scm",
+ "WRDE_BADVAL", "libc.scm",
+ "WRDE_CMDSUB", "libc.scm",
+ "WRDE_DOOFFS", "libc.scm",
+ "WRDE_NOCMD", "libc.scm",
+ "WRDE_NOSPACE", "libc.scm",
+ "WRDE_REUSE", "libc.scm",
+ "WRDE_SHOWERR", "libc.scm",
+ "WRDE_SYNTAX", "libc.scm",
+ "WRDE_UNDEF", "libc.scm",
+ "WSTOPPED", "libc.scm",
+ "WSTOPSIG", "libc.scm",
+ "WTERMSIG", "libc.scm",
+ "WUNTRACED", "libc.scm",
+ "W_OK", "libc.scm",
+ "X_OK", "libc.scm",
+ "_CS_GNU_LIBC_VERSION", "libc.scm",
+ "_CS_GNU_LIBPTHREAD_VERSION", "libc.scm",
+ "_CS_PATH", "libc.scm",
+ "_IOFBF", "libc.scm",
+ "_IOLBF", "libc.scm",
+ "_IONBF", "libc.scm",
+ "_PATH_NETWORKS", "libc.scm",
+ "_PATH_NSSWITCH_CONF", "libc.scm",
+ "_PATH_PROTOCOLS", "libc.scm",
+ "_PATH_SERVICES", "libc.scm",
+ "_PC_2_SYMLINKS", "libc.scm",
+ "_PC_ALLOC_SIZE_MIN", "libc.scm",
+ "_PC_ASYNC_IO", "libc.scm",
+ "_PC_CHOWN_RESTRICTED", "libc.scm",
+ "_PC_FILESIZEBITS", "libc.scm",
+ "_PC_LINK_MAX", "libc.scm",
+ "_PC_MAX_CANON", "libc.scm",
+ "_PC_MAX_INPUT", "libc.scm",
+ "_PC_NAME_MAX", "libc.scm",
+ "_PC_NO_TRUNC", "libc.scm",
+ "_PC_PATH_MAX", "libc.scm",
+ "_PC_PIPE_BUF", "libc.scm",
+ "_PC_PRIO_IO", "libc.scm",
+ "_PC_REC_INCR_XFER_SIZE", "libc.scm",
+ "_PC_REC_MAX_XFER_SIZE", "libc.scm",
+ "_PC_REC_MIN_XFER_SIZE", "libc.scm",
+ "_PC_REC_XFER_ALIGN", "libc.scm",
+ "_PC_SOCK_MAXBUF", "libc.scm",
+ "_PC_SYMLINK_MAX", "libc.scm",
+ "_PC_SYNC_IO", "libc.scm",
+ "_PC_VDISABLE", "libc.scm",
+ "_POSIX2_BC_BASE_MAX", "libc.scm",
+ "_POSIX2_BC_DIM_MAX", "libc.scm",
+ "_POSIX2_BC_SCALE_MAX", "libc.scm",
+ "_POSIX2_BC_STRING_MAX", "libc.scm",
+ "_POSIX2_CHARCLASS_NAME_MAX", "libc.scm",
+ "_POSIX2_CHAR_TERM", "libc.scm",
+ "_POSIX2_COLL_WEIGHTS_MAX", "libc.scm",
+ "_POSIX2_EXPR_NEST_MAX", "libc.scm",
+ "_POSIX2_LINE_MAX", "libc.scm",
+ "_POSIX2_RE_DUP_MAX", "libc.scm",
+ "_POSIX2_VERSION", "libc.scm",
+ "_POSIX_ADVISORY_INFO", "libc.scm",
+ "_POSIX_AIO_LISTIO_MAX", "libc.scm",
+ "_POSIX_AIO_MAX", "libc.scm",
+ "_POSIX_ARG_MAX", "libc.scm",
+ "_POSIX_ASYNCHRONOUS_IO", "libc.scm",
+ "_POSIX_ASYNC_IO", "libc.scm",
+ "_POSIX_BARRIERS", "libc.scm",
+ "_POSIX_CHILD_MAX", "libc.scm",
+ "_POSIX_CHOWN_RESTRICTED", "libc.scm",
+ "_POSIX_CLOCKRES_MIN", "libc.scm",
+ "_POSIX_CLOCK_SELECTION", "libc.scm",
+ "_POSIX_CPUTIME", "libc.scm",
+ "_POSIX_DELAYTIMER_MAX", "libc.scm",
+ "_POSIX_FSYNC", "libc.scm",
+ "_POSIX_HOST_NAME_MAX", "libc.scm",
+ "_POSIX_IPV6", "libc.scm",
+ "_POSIX_JOB_CONTROL", "libc.scm",
+ "_POSIX_LINK_MAX", "libc.scm",
+ "_POSIX_LOGIN_NAME_MAX", "libc.scm",
+ "_POSIX_MAPPED_FILES", "libc.scm",
+ "_POSIX_MAX_CANON", "libc.scm",
+ "_POSIX_MAX_INPUT", "libc.scm",
+ "_POSIX_MEMLOCK", "libc.scm",
+ "_POSIX_MEMLOCK_RANGE", "libc.scm",
+ "_POSIX_MEMORY_PROTECTION", "libc.scm",
+ "_POSIX_MESSAGE_PASSING", "libc.scm",
+ "_POSIX_MONOTONIC_CLOCK", "libc.scm",
+ "_POSIX_MQ_OPEN_MAX", "libc.scm",
+ "_POSIX_MQ_PRIO_MAX", "libc.scm",
+ "_POSIX_NAME_MAX", "libc.scm",
+ "_POSIX_NGROUPS_MAX", "libc.scm",
+ "_POSIX_NO_TRUNC", "libc.scm",
+ "_POSIX_OPEN_MAX", "libc.scm",
+ "_POSIX_PATH_MAX", "libc.scm",
+ "_POSIX_PIPE_BUF", "libc.scm",
+ "_POSIX_PRIORITIZED_IO", "libc.scm",
+ "_POSIX_PRIORITY_SCHEDULING", "libc.scm",
+ "_POSIX_RAW_SOCKETS", "libc.scm",
+ "_POSIX_READER_WRITER_LOCKS", "libc.scm",
+ "_POSIX_REALTIME_SIGNALS", "libc.scm",
+ "_POSIX_REENTRANT_FUNCTIONS", "libc.scm",
+ "_POSIX_REGEXP", "libc.scm",
+ "_POSIX_RE_DUP_MAX", "libc.scm",
+ "_POSIX_RTSIG_MAX", "libc.scm",
+ "_POSIX_SAVED_IDS", "libc.scm",
+ "_POSIX_SEMAPHORES", "libc.scm",
+ "_POSIX_SEM_NSEMS_MAX", "libc.scm",
+ "_POSIX_SEM_VALUE_MAX", "libc.scm",
+ "_POSIX_SHARED_MEMORY_OBJECTS", "libc.scm",
+ "_POSIX_SHELL", "libc.scm",
+ "_POSIX_SIGQUEUE_MAX", "libc.scm",
+ "_POSIX_SPAWN", "libc.scm",
+ "_POSIX_SPIN_LOCKS", "libc.scm",
+ "_POSIX_SPORADIC_SERVER", "libc.scm",
+ "_POSIX_SSIZE_MAX", "libc.scm",
+ "_POSIX_STREAM_MAX", "libc.scm",
+ "_POSIX_SYMLINK_MAX", "libc.scm",
+ "_POSIX_SYMLOOP_MAX", "libc.scm",
+ "_POSIX_SYNCHRONIZED_IO", "libc.scm",
+ "_POSIX_THREADS", "libc.scm",
+ "_POSIX_THREAD_ATTR_STACKADDR", "libc.scm",
+ "_POSIX_THREAD_ATTR_STACKSIZE", "libc.scm",
+ "_POSIX_THREAD_CPUTIME", "libc.scm",
+ "_POSIX_THREAD_PRIORITY_SCHEDULING", "libc.scm",
+ "_POSIX_THREAD_PRIO_INHERIT", "libc.scm",
+ "_POSIX_THREAD_PRIO_PROTECT", "libc.scm",
+ "_POSIX_THREAD_PROCESS_SHARED", "libc.scm",
+ "_POSIX_THREAD_SAFE_FUNCTIONS", "libc.scm",
+ "_POSIX_THREAD_SPORADIC_SERVER", "libc.scm",
+ "_POSIX_TIMEOUTS", "libc.scm",
+ "_POSIX_TIMERS", "libc.scm",
+ "_POSIX_TIMER_MAX", "libc.scm",
+ "_POSIX_TRACE", "libc.scm",
+ "_POSIX_TRACE_EVENT_FILTER", "libc.scm",
+ "_POSIX_TRACE_INHERIT", "libc.scm",
+ "_POSIX_TRACE_LOG", "libc.scm",
+ "_POSIX_TTY_NAME_MAX", "libc.scm",
+ "_POSIX_TYPED_MEMORY_OBJECTS", "libc.scm",
+ "_POSIX_TZNAME_MAX", "libc.scm",
+ "_POSIX_VDISABLE", "libc.scm",
+ "_POSIX_VERSION", "libc.scm",
+ "_SC_2_CHAR_TERM", "libc.scm",
+ "_SC_2_C_BIND", "libc.scm",
+ "_SC_2_C_DEV", "libc.scm",
+ "_SC_2_C_VERSION", "libc.scm",
+ "_SC_2_FORT_DEV", "libc.scm",
+ "_SC_2_FORT_RUN", "libc.scm",
+ "_SC_2_LOCALEDEF", "libc.scm",
+ "_SC_2_PBS", "libc.scm",
+ "_SC_2_PBS_ACCOUNTING", "libc.scm",
+ "_SC_2_PBS_CHECKPOINT", "libc.scm",
+ "_SC_2_PBS_LOCATE", "libc.scm",
+ "_SC_2_PBS_MESSAGE", "libc.scm",
+ "_SC_2_PBS_TRACK", "libc.scm",
+ "_SC_2_SW_DEV", "libc.scm",
+ "_SC_2_UPE", "libc.scm",
+ "_SC_2_VERSION", "libc.scm",
+ "_SC_ADVISORY_INFO", "libc.scm",
+ "_SC_AIO_LISTIO_MAX", "libc.scm",
+ "_SC_AIO_MAX", "libc.scm",
+ "_SC_AIO_PRIO_DELTA_MAX", "libc.scm",
+ "_SC_ARG_MAX", "libc.scm",
+ "_SC_ASYNCHRONOUS_IO", "libc.scm",
+ "_SC_ATEXIT_MAX", "libc.scm",
+ "_SC_AVPHYS_PAGES", "libc.scm",
+ "_SC_BARRIERS", "libc.scm",
+ "_SC_BASE", "libc.scm",
+ "_SC_BC_BASE_MAX", "libc.scm",
+ "_SC_BC_DIM_MAX", "libc.scm",
+ "_SC_BC_SCALE_MAX", "libc.scm",
+ "_SC_BC_STRING_MAX", "libc.scm",
+ "_SC_CHARCLASS_NAME_MAX", "libc.scm",
+ "_SC_CHAR_BIT", "libc.scm",
+ "_SC_CHAR_MAX", "libc.scm",
+ "_SC_CHAR_MIN", "libc.scm",
+ "_SC_CHILD_MAX", "libc.scm",
+ "_SC_CLK_TCK", "libc.scm",
+ "_SC_CLOCK_SELECTION", "libc.scm",
+ "_SC_COLL_WEIGHTS_MAX", "libc.scm",
+ "_SC_CPUTIME", "libc.scm",
+ "_SC_C_LANG_SUPPORT", "libc.scm",
+ "_SC_C_LANG_SUPPORT_R", "libc.scm",
+ "_SC_DELAYTIMER_MAX", "libc.scm",
+ "_SC_DEVICE_IO", "libc.scm",
+ "_SC_DEVICE_SPECIFIC", "libc.scm",
+ "_SC_DEVICE_SPECIFIC_R", "libc.scm",
+ "_SC_EQUIV_CLASS_MAX", "libc.scm",
+ "_SC_EXPR_NEST_MAX", "libc.scm",
+ "_SC_FD_MGMT", "libc.scm",
+ "_SC_FIFO", "libc.scm",
+ "_SC_FILE_ATTRIBUTES", "libc.scm",
+ "_SC_FILE_LOCKING", "libc.scm",
+ "_SC_FILE_SYSTEM", "libc.scm",
+ "_SC_FSYNC", "libc.scm",
+ "_SC_GETGR_R_SIZE_MAX", "libc.scm",
+ "_SC_GETPW_R_SIZE_MAX", "libc.scm",
+ "_SC_HOST_NAME_MAX", "libc.scm",
+ "_SC_INT_MAX", "libc.scm",
+ "_SC_INT_MIN", "libc.scm",
+ "_SC_IOV_MAX", "libc.scm",
+ "_SC_IPV6", "libc.scm",
+ "_SC_JOB_CONTROL", "libc.scm",
+ "_SC_LEVEL1_DCACHE_ASSOC", "libc.scm",
+ "_SC_LEVEL1_DCACHE_LINESIZE", "libc.scm",
+ "_SC_LEVEL1_DCACHE_SIZE", "libc.scm",
+ "_SC_LEVEL1_ICACHE_ASSOC", "libc.scm",
+ "_SC_LEVEL1_ICACHE_LINESIZE", "libc.scm",
+ "_SC_LEVEL1_ICACHE_SIZE", "libc.scm",
+ "_SC_LEVEL2_CACHE_ASSOC", "libc.scm",
+ "_SC_LEVEL2_CACHE_LINESIZE", "libc.scm",
+ "_SC_LEVEL2_CACHE_SIZE", "libc.scm",
+ "_SC_LEVEL3_CACHE_ASSOC", "libc.scm",
+ "_SC_LEVEL3_CACHE_LINESIZE", "libc.scm",
+ "_SC_LEVEL3_CACHE_SIZE", "libc.scm",
+ "_SC_LEVEL4_CACHE_ASSOC", "libc.scm",
+ "_SC_LEVEL4_CACHE_LINESIZE", "libc.scm",
+ "_SC_LEVEL4_CACHE_SIZE", "libc.scm",
+ "_SC_LINE_MAX", "libc.scm",
+ "_SC_LOGIN_NAME_MAX", "libc.scm",
+ "_SC_LONG_BIT", "libc.scm",
+ "_SC_MAPPED_FILES", "libc.scm",
+ "_SC_MB_LEN_MAX", "libc.scm",
+ "_SC_MEMLOCK", "libc.scm",
+ "_SC_MEMLOCK_RANGE", "libc.scm",
+ "_SC_MEMORY_PROTECTION", "libc.scm",
+ "_SC_MESSAGE_PASSING", "libc.scm",
+ "_SC_MONOTONIC_CLOCK", "libc.scm",
+ "_SC_MQ_OPEN_MAX", "libc.scm",
+ "_SC_MQ_PRIO_MAX", "libc.scm",
+ "_SC_MULTI_PROCESS", "libc.scm",
+ "_SC_NETWORKING", "libc.scm",
+ "_SC_NGROUPS_MAX", "libc.scm",
+ "_SC_NL_ARGMAX", "libc.scm",
+ "_SC_NL_LANGMAX", "libc.scm",
+ "_SC_NL_MSGMAX", "libc.scm",
+ "_SC_NL_NMAX", "libc.scm",
+ "_SC_NL_SETMAX", "libc.scm",
+ "_SC_NL_TEXTMAX", "libc.scm",
+ "_SC_NPROCESSORS_CONF", "libc.scm",
+ "_SC_NPROCESSORS_ONLN", "libc.scm",
+ "_SC_NZERO", "libc.scm",
+ "_SC_OPEN_MAX", "libc.scm",
+ "_SC_PAGESIZE", "libc.scm",
+ "_SC_PAGE_SIZE", "libc.scm",
+ "_SC_PASS_MAX", "libc.scm",
+ "_SC_PHYS_PAGES", "libc.scm",
+ "_SC_PII", "libc.scm",
+ "_SC_PII_INTERNET", "libc.scm",
+ "_SC_PII_INTERNET_DGRAM", "libc.scm",
+ "_SC_PII_INTERNET_STREAM", "libc.scm",
+ "_SC_PII_OSI", "libc.scm",
+ "_SC_PII_OSI_CLTS", "libc.scm",
+ "_SC_PII_OSI_COTS", "libc.scm",
+ "_SC_PII_OSI_M", "libc.scm",
+ "_SC_PII_SOCKET", "libc.scm",
+ "_SC_PII_XTI", "libc.scm",
+ "_SC_PIPE", "libc.scm",
+ "_SC_POLL", "libc.scm",
+ "_SC_PRIORITIZED_IO", "libc.scm",
+ "_SC_PRIORITY_SCHEDULING", "libc.scm",
+ "_SC_RAW_SOCKETS", "libc.scm",
+ "_SC_READER_WRITER_LOCKS", "libc.scm",
+ "_SC_REALTIME_SIGNALS", "libc.scm",
+ "_SC_REGEXP", "libc.scm",
+ "_SC_REGEX_VERSION", "libc.scm",
+ "_SC_RE_DUP_MAX", "libc.scm",
+ "_SC_RTSIG_MAX", "libc.scm",
+ "_SC_SAVED_IDS", "libc.scm",
+ "_SC_SCHAR_MAX", "libc.scm",
+ "_SC_SCHAR_MIN", "libc.scm",
+ "_SC_SELECT", "libc.scm",
+ "_SC_SEMAPHORES", "libc.scm",
+ "_SC_SEM_NSEMS_MAX", "libc.scm",
+ "_SC_SEM_VALUE_MAX", "libc.scm",
+ "_SC_SHARED_MEMORY_OBJECTS", "libc.scm",
+ "_SC_SHELL", "libc.scm",
+ "_SC_SHRT_MAX", "libc.scm",
+ "_SC_SHRT_MIN", "libc.scm",
+ "_SC_SIGNALS", "libc.scm",
+ "_SC_SIGQUEUE_MAX", "libc.scm",
+ "_SC_SINGLE_PROCESS", "libc.scm",
+ "_SC_SPAWN", "libc.scm",
+ "_SC_SPIN_LOCKS", "libc.scm",
+ "_SC_SPORADIC_SERVER", "libc.scm",
+ "_SC_SSIZE_MAX", "libc.scm",
+ "_SC_SS_REPL_MAX", "libc.scm",
+ "_SC_STREAMS", "libc.scm",
+ "_SC_STREAM_MAX", "libc.scm",
+ "_SC_SYMLOOP_MAX", "libc.scm",
+ "_SC_SYNCHRONIZED_IO", "libc.scm",
+ "_SC_SYSTEM_DATABASE", "libc.scm",
+ "_SC_SYSTEM_DATABASE_R", "libc.scm",
+ "_SC_THREADS", "libc.scm",
+ "_SC_THREAD_ATTR_STACKADDR", "libc.scm",
+ "_SC_THREAD_ATTR_STACKSIZE", "libc.scm",
+ "_SC_THREAD_CPUTIME", "libc.scm",
+ "_SC_THREAD_DESTRUCTOR_ITERATIONS", "libc.scm",
+ "_SC_THREAD_KEYS_MAX", "libc.scm",
+ "_SC_THREAD_PRIORITY_SCHEDULING", "libc.scm",
+ "_SC_THREAD_PRIO_INHERIT", "libc.scm",
+ "_SC_THREAD_PRIO_PROTECT", "libc.scm",
+ "_SC_THREAD_PROCESS_SHARED", "libc.scm",
+ "_SC_THREAD_ROBUST_PRIO_INHERIT", "libc.scm",
+ "_SC_THREAD_ROBUST_PRIO_PROTECT", "libc.scm",
+ "_SC_THREAD_SAFE_FUNCTIONS", "libc.scm",
+ "_SC_THREAD_SPORADIC_SERVER", "libc.scm",
+ "_SC_THREAD_STACK_MIN", "libc.scm",
+ "_SC_THREAD_THREADS_MAX", "libc.scm",
+ "_SC_TIMEOUTS", "libc.scm",
+ "_SC_TIMERS", "libc.scm",
+ "_SC_TIMER_MAX", "libc.scm",
+ "_SC_TRACE", "libc.scm",
+ "_SC_TRACE_EVENT_FILTER", "libc.scm",
+ "_SC_TRACE_EVENT_NAME_MAX", "libc.scm",
+ "_SC_TRACE_INHERIT", "libc.scm",
+ "_SC_TRACE_LOG", "libc.scm",
+ "_SC_TRACE_NAME_MAX", "libc.scm",
+ "_SC_TRACE_SYS_MAX", "libc.scm",
+ "_SC_TRACE_USER_EVENT_MAX", "libc.scm",
+ "_SC_TTY_NAME_MAX", "libc.scm",
+ "_SC_TYPED_MEMORY_OBJECTS", "libc.scm",
+ "_SC_TZNAME_MAX", "libc.scm",
+ "_SC_T_IOV_MAX", "libc.scm",
+ "_SC_UCHAR_MAX", "libc.scm",
+ "_SC_UINT_MAX", "libc.scm",
+ "_SC_UIO_MAXIOV", "libc.scm",
+ "_SC_ULONG_MAX", "libc.scm",
+ "_SC_USER_GROUPS", "libc.scm",
+ "_SC_USER_GROUPS_R", "libc.scm",
+ "_SC_USHRT_MAX", "libc.scm",
+ "_SC_VERSION", "libc.scm",
+ "_SC_WORD_BIT", "libc.scm",
+ "__BIGGEST_ALIGNMENT__", "libm.scm",
+ "__BIG_ENDIAN", "libc.scm",
+ "__BYTE_ORDER", "libc.scm",
+ "__CHAR_BIT__", "libm.scm",
+ "__DBL_DENORM_MIN__", "libm.scm",
+ "__DBL_DIG__", "libm.scm",
+ "__DBL_EPSILON__", "libm.scm",
+ "__DBL_MANT_DIG__", "libm.scm",
+ "__DBL_MAX_10_EXP__", "libm.scm",
+ "__DBL_MAX_EXP__", "libm.scm",
+ "__DBL_MAX__", "libm.scm",
+ "__DBL_MIN_10_EXP__", "libm.scm",
+ "__DBL_MIN_EXP__", "libm.scm",
+ "__DBL_MIN__", "libm.scm",
+ "__DECIMAL_DIG__", "libm.scm",
+ "__FLT_DENORM_MIN__", "libm.scm",
+ "__FLT_DIG__", "libm.scm",
+ "__FLT_EPSILON__", "libm.scm",
+ "__FLT_MANT_DIG__", "libm.scm",
+ "__FLT_MAX_10_EXP__", "libm.scm",
+ "__FLT_MAX_EXP__", "libm.scm",
+ "__FLT_MAX__", "libm.scm",
+ "__FLT_MIN_10_EXP__", "libm.scm",
+ "__FLT_MIN_EXP__", "libm.scm",
+ "__FLT_MIN__", "libm.scm",
+ "__FLT_RADIX__", "libm.scm",
+ "__GLIBC_MINOR__", "libc.scm",
+ "__GLIBC__", "libc.scm",
+ "__INTMAX_MAX__", "libm.scm",
+ "__INT_MAX__", "libm.scm",
+ "__LDBL_DENORM_MIN__", "libm.scm",
+ "__LDBL_DIG__", "libm.scm",
+ "__LDBL_EPSILON__", "libm.scm",
+ "__LDBL_MANT_DIG__", "libm.scm",
+ "__LDBL_MAX_10_EXP__", "libm.scm",
+ "__LDBL_MAX_EXP__", "libm.scm",
+ "__LDBL_MAX__", "libm.scm",
+ "__LDBL_MIN_10_EXP__", "libm.scm",
+ "__LDBL_MIN_EXP__", "libm.scm",
+ "__LDBL_MIN__", "libm.scm",
+ "__LITTLE_ENDIAN", "libc.scm",
+ "__LONG_LONG_MAX__", "libm.scm",
+ "__LONG_MAX__", "libm.scm",
+ "__SIZEOF_DOUBLE__", "libm.scm",
+ "__SIZEOF_FLOAT__", "libm.scm",
+ "__SIZEOF_INT__", "libm.scm",
+ "__SIZEOF_LONG_DOUBLE__", "libm.scm",
+ "__SIZEOF_LONG_LONG__", "libm.scm",
+ "__SIZEOF_LONG__", "libm.scm",
+ "__SIZEOF_POINTER__", "libm.scm",
+ "__SIZEOF_SHORT__", "libm.scm",
+ "__SIZEOF_SIZE_T__", "libm.scm",
+ "__S_IFLNK", "libc.scm",
+ "__VERSION__", "libm.scm",
+ "__WORDSIZE", "libc.scm",
+ "_exit", "libc.scm",
+ "a-cricket", "animals.scm",
+ "a-frog", "animals.scm",
+ "abcos", "generators.scm",
+ "abcos?", "generators.scm",
+ "absin", "generators.scm",
+ "absin?", "generators.scm",
+ "acadian-flycatcher", "animals.scm",
+ "accept", "libc.scm",
+ "access", "libc.scm",
+ "acorn-woodpecker", "animals.scm",
+ "add-envelopes", "env.scm",
+ "add-notes", "examp.scm",
+ "add-predicate", "stuff.scm",
+ "addenv", "jcvoi.scm",
+ "addrinfo.ai_canonname", "libc.scm",
+ "addrinfo.ai_family", "libc.scm",
+ "addrinfo.ai_flags", "libc.scm",
+ "addrinfo.ai_next", "libc.scm",
+ "addrinfo.ai_protocol", "libc.scm",
+ "addrinfo.ai_socktype", "libc.scm",
+ "addrinfo.make", "libc.scm",
+ "addrinfo.set_ai_family", "libc.scm",
+ "addrinfo.set_ai_flags", "libc.scm",
+ "addrinfo.set_ai_protocol", "libc.scm",
+ "addrinfo.set_ai_socktype", "libc.scm",
+ "adjoin", "stuff.scm",
+ "adjustable-oscil", "generators.scm",
+ "adjustable-oscil?", "generators.scm",
+ "adjustable-sawtooth-wave", "generators.scm",
+ "adjustable-sawtooth-wave?", "generators.scm",
+ "adjustable-square-wave", "generators.scm",
+ "adjustable-square-wave?", "generators.scm",
+ "adjustable-triangle-wave", "generators.scm",
+ "adjustable-triangle-wave?", "generators.scm",
+ "adsat", "dsp.scm",
+ "alarm", "libc.scm",
+ "all-chans", "examp.scm",
+ "all-methods", "stuff.scm",
+ "am", "examp.scm",
+ "amargosa-toad", "animals.scm",
+ "ambisonics-channels", "dlocsig.scm",
+ "american-crow", "animals.scm",
+ "american-crow-no-formants", "animals.scm",
+ "american-robin", "animals.scm",
+ "american-toad", "animals.scm",
+ "analog->digital", "analog-filter.scm",
+ "angles-in-degree", "dlocsig.scm",
+ "angles-in-radians", "dlocsig.scm",
+ "angles-in-turns", "dlocsig.scm",
+ "anoi", "clm-ins.scm",
+ "any-env-channel", "extensions.scm",
+ "any-random", "dsp.scm",
+ "any?", "stuff.scm",
+ "aref", "jcvoi.scm",
+ "arrange-speakers", "dlocsig.scm",
+ "array-set!", "maxf.scm",
+ "asctime", "libc.scm",
+ "ash-throated-flycatcher", "animals.scm",
+ "asyfm-I", "generators.scm",
+ "asyfm-J", "generators.scm",
+ "asyfm?", "generators.scm",
+ "asymmetric-difference", "stuff.scm",
+ "atan2", "libm.scm",
+ "atof", "libc.scm",
+ "atoi", "libc.scm",
+ "atol", "libc.scm",
+ "atoll", "libc.scm",
+ "attack-point", "noise.scm",
+ "attract", "clm-ins.scm",
+ "auto-dot", "examp.scm",
+ "auto-save", "autosave.scm",
+ "aux-f", "numerics.scm",
+ "aux-g", "numerics.scm",
+ "b-american-widgeon", "bird.scm",
+ "b-audubons-warbler", "bird.scm",
+ "b-bachmans-sparrow", "bird.scm",
+ "b-bairds-sparrow", "bird.scm",
+ "b-black-chinned-sparrow", "bird.scm",
+ "b-black-necked-stilt", "bird.scm",
+ "b-black-throated-gray-warbler", "bird.scm",
+ "b-black-throated-sparrow", "bird.scm",
+ "b-blue-gray-gnatcatcher", "bird.scm",
+ "b-bobwhite", "bird.scm",
+ "b-cassins-kingbird", "bird.scm",
+ "b-cedar-waxwing", "bird.scm",
+ "b-cerulean-warbler", "bird.scm",
+ "b-chestnut-sided-warbler", "bird.scm",
+ "b-chipping-sparrow", "bird.scm",
+ "b-chuck-wills-widow", "bird.scm",
+ "b-eastern-bluebird", "bird.scm",
+ "b-eastern-phoebe", "bird.scm",
+ "b-golden-crowned-sparrow", "bird.scm",
+ "b-grasshopper-sparrow", "bird.scm",
+ "b-great-horned-owl", "bird.scm",
+ "b-hooded-warbler", "bird.scm",
+ "b-indigo-bunting", "bird.scm",
+ "b-kentucky-warbler", "bird.scm",
+ "b-lark-bunting", "bird.scm",
+ "b-louisiana-waterthrush", "bird.scm",
+ "b-nashville-warbler", "bird.scm",
+ "b-orchard-oriole", "bird.scm",
+ "b-painted-bunting", "bird.scm",
+ "b-pigeon-hawk", "bird.scm",
+ "b-prothonotary-warbler", "bird.scm",
+ "b-robin", "bird.scm",
+ "b-rufous-sided-towhee", "bird.scm",
+ "b-scissor-tailed-flycatcher", "bird.scm",
+ "b-solitary-vireo", "bird.scm",
+ "b-swamp-sparrow", "bird.scm",
+ "b-western-flycatcher", "bird.scm",
+ "b-western-meadowlark", "bird.scm",
+ "b-yellow-warbler", "bird.scm",
+ "bachmans-sparrow", "animals.scm",
+ "balance", "clm-ins.scm",
+ "balance-avg", "clm-ins.scm",
+ "bald-eagle", "animals.scm",
+ "barking-tree-frog", "animals.scm",
+ "barn-owl", "animals.scm",
+ "barred-owl-1", "animals.scm",
+ "bernoulli-poly", "numerics.scm",
+ "bernoulli3", "numerics.scm",
+ "bes-fm", "clm-ins.scm",
+ "bess", "generators.scm",
+ "bess?", "generators.scm",
+ "bessel-prototype", "analog-filter.scm",
+ "bezier-3d", "dlocsig.scm",
+ "bezier-bx", "dlocsig.scm",
+ "bezier-by", "dlocsig.scm",
+ "bezier-bz", "dlocsig.scm",
+ "bezier-curvature", "dlocsig.scm",
+ "bezier-error", "dlocsig.scm",
+ "bezier-path", "dlocsig.scm",
+ "bezier-polar", "dlocsig.scm",
+ "bezier-render", "dlocsig.scm",
+ "bezier-v", "dlocsig.scm",
+ "bezier-x", "dlocsig.scm",
+ "bezier-y", "dlocsig.scm",
+ "bezier-z", "dlocsig.scm",
+ "big-amplitude-modulate", "big-gens.scm",
+ "big-array-clear", "big-gens.scm",
+ "big-array-interp", "big-gens.scm",
+ "big-array-normalize", "big-gens.scm",
+ "big-contrast-enhancement", "big-gens.scm",
+ "big-db->linear", "big-gens.scm",
+ "big-degrees->radians", "big-gens.scm",
+ "big-dot-product", "big-gens.scm",
+ "big-hz->radians", "big-gens.scm",
+ "big-linear->db", "big-gens.scm",
+ "big-maraca", "maraca.scm",
+ "big-ncos", "big-gens.scm",
+ "big-nsin", "big-gens.scm",
+ "big-one-pole", "big-gens.scm",
+ "big-one-zero", "big-gens.scm",
+ "big-oscil", "big-gens.scm",
+ "big-polar->rectangular", "big-gens.scm",
+ "big-polynomial", "big-gens.scm",
+ "big-radians->degrees", "big-gens.scm",
+ "big-radians->hz", "big-gens.scm",
+ "big-rectangular->polar", "big-gens.scm",
+ "big-samples->seconds", "big-gens.scm",
+ "big-seconds->samples", "big-gens.scm",
+ "big-table-lookup", "big-gens.scm",
+ "bigbird", "bird.scm",
+ "binary-port?", "r7rs.scm",
+ "bind", "libc.scm",
+ "binomial", "dsp.scm",
+ "binomial-direct", "numerics.scm",
+ "bird", "bird.scm",
+ "black-billed-cuckoo", "animals.scm",
+ "black-chinned-sparrow", "animals.scm",
+ "black-crowned-night-heron", "animals.scm",
+ "black-horned-tree-cricket", "animals.scm",
+ "black-necked-stilt", "animals.scm",
+ "black-phoebe", "animals.scm",
+ "black-rail", "animals.scm",
+ "black-throated-blue-warbler", "animals.scm",
+ "black-throated-sparrow", "animals.scm",
+ "blackman", "generators.scm",
+ "blackman4-env", "generators.scm",
+ "blackman4-env-channel", "extensions.scm",
+ "blackman4-ramp", "extensions.scm",
+ "blackman?", "generators.scm",
+ "blue-grosbeak", "animals.scm",
+ "bobwhite", "animals.scm",
+ "boolean=?", "r7rs.scm",
+ "bouncy", "generators.scm",
+ "bow", "strad.scm",
+ "bowstr", "prc95.scm",
+ "bowtable", "prc95.scm",
+ "box", "r7rs.scm",
+ "box-type?", "r7rs.scm",
+ "box?", "r7rs.scm",
+ "brass", "prc95.scm",
+ "brassy", "generators.scm",
+ "brighten-slightly", "dsp.scm",
+ "brighten-slightly-1", "dsp.scm",
+ "broad-winged-tree-cricket", "animals.scm",
+ "brown-crested-flycatcher-1", "animals.scm",
+ "brown-crested-flycatcher-2", "animals.scm",
+ "brown-jay", "animals.scm",
+ "brown-noise", "generators.scm",
+ "brown-noise?", "generators.scm",
+ "bullfrog", "animals.scm",
+ "bump", "generators.scm",
+ "burrowing-owl", "animals.scm",
+ "bushtit", "animals.scm",
+ "butterworth-prototype", "analog-filter.scm",
+ "byte", "stuff.scm",
+ "bytevector->list", "r7rs.scm",
+ "bytevector-append", "r7rs.scm",
+ "bytevector-copy", "r7rs.scm",
+ "bytevector-copy!", "r7rs.scm",
+ "bytevector-length", "r7rs.scm",
+ "bytevector-u8-ref", "r7rs.scm",
+ "bytevector-u8-set!", "r7rs.scm",
+ "c-define-1", "cload.scm",
+ "c-null?", "libc.scm",
+ "c-pointer->string", "libc.scm",
+ "c?r", "stuff.scm",
+ "calculate-fit", "dlocsig.scm",
+ "california-quail", "animals.scm",
+ "california-towhee", "animals.scm",
+ "call-with-input-vector", "stuff.scm",
+ "call-with-output-vector", "stuff.scm",
+ "call-with-port", "r7rs.scm",
+ "calling-all-animals", "animals.scm",
+ "calling-all-birds", "animals.scm",
+ "calling-all-frogs", "animals.scm",
+ "calling-all-generators", "generators.scm",
+ "calling-all-insects", "animals.scm",
+ "calling-all-mammals", "animals.scm",
+ "calloc", "libc.scm",
+ "canada-goose", "animals.scm",
+ "canada-goose-1", "animals.scm",
+ "canada-goose-2", "animals.scm",
+ "canada-goose-3", "animals.scm",
+ "cancel-auto-save", "autosave.scm",
+ "canonicalize", "peak-phases.scm",
+ "canonicalize-one", "peak-phases.scm",
+ "canter", "clm-ins.scm",
+ "cape-may-warbler", "animals.scm",
+ "cardinal", "animals.scm",
+ "carolina-grasshopper", "animals.scm",
+ "carolina-wren", "animals.scm",
+ "cascade->canonical", "dsp.scm",
+ "cassins-sparrow", "animals.scm",
+ "cassins-vireo", "animals.scm",
+ "cblas_dasum", "libgsl.scm",
+ "cblas_daxpy", "libgsl.scm",
+ "cblas_dcopy", "libgsl.scm",
+ "cblas_ddot", "libgsl.scm",
+ "cblas_dgbmv", "libgsl.scm",
+ "cblas_dgemm", "libgsl.scm",
+ "cblas_dgemv", "libgsl.scm",
+ "cblas_dger", "libgsl.scm",
+ "cblas_dnrm2", "libgsl.scm",
+ "cblas_drot", "libgsl.scm",
+ "cblas_drotg", "libgsl.scm",
+ "cblas_drotm", "libgsl.scm",
+ "cblas_drotmg", "libgsl.scm",
+ "cblas_dsbmv", "libgsl.scm",
+ "cblas_dscal", "libgsl.scm",
+ "cblas_dspmv", "libgsl.scm",
+ "cblas_dspr", "libgsl.scm",
+ "cblas_dspr2", "libgsl.scm",
+ "cblas_dswap", "libgsl.scm",
+ "cblas_dsymm", "libgsl.scm",
+ "cblas_dsymv", "libgsl.scm",
+ "cblas_dsyr", "libgsl.scm",
+ "cblas_dsyr2", "libgsl.scm",
+ "cblas_dsyr2k", "libgsl.scm",
+ "cblas_dsyrk", "libgsl.scm",
+ "cblas_dtbmv", "libgsl.scm",
+ "cblas_dtbsv", "libgsl.scm",
+ "cblas_dtpmv", "libgsl.scm",
+ "cblas_dtpsv", "libgsl.scm",
+ "cblas_dtrmm", "libgsl.scm",
+ "cblas_dtrmv", "libgsl.scm",
+ "cblas_dtrsm", "libgsl.scm",
+ "cblas_dtrsv", "libgsl.scm",
+ "cblas_dzasum", "libgsl.scm",
+ "cblas_dznrm2", "libgsl.scm",
+ "cblas_icamax", "libgsl.scm",
+ "cblas_idamax", "libgsl.scm",
+ "cblas_izamax", "libgsl.scm",
+ "cblas_zaxpy", "libgsl.scm",
+ "cblas_zcopy", "libgsl.scm",
+ "cblas_zdotc_sub", "libgsl.scm",
+ "cblas_zdotu_sub", "libgsl.scm",
+ "cblas_zdscal", "libgsl.scm",
+ "cblas_zgbmv", "libgsl.scm",
+ "cblas_zgemm", "libgsl.scm",
+ "cblas_zgemv", "libgsl.scm",
+ "cblas_zgerc", "libgsl.scm",
+ "cblas_zgeru", "libgsl.scm",
+ "cblas_zhbmv", "libgsl.scm",
+ "cblas_zhemm", "libgsl.scm",
+ "cblas_zhemv", "libgsl.scm",
+ "cblas_zher", "libgsl.scm",
+ "cblas_zher2", "libgsl.scm",
+ "cblas_zher2k", "libgsl.scm",
+ "cblas_zherk", "libgsl.scm",
+ "cblas_zhpmv", "libgsl.scm",
+ "cblas_zhpr", "libgsl.scm",
+ "cblas_zhpr2", "libgsl.scm",
+ "cblas_zscal", "libgsl.scm",
+ "cblas_zswap", "libgsl.scm",
+ "cblas_zsymm", "libgsl.scm",
+ "cblas_zsyr2k", "libgsl.scm",
+ "cblas_zsyrk", "libgsl.scm",
+ "cblas_ztbmv", "libgsl.scm",
+ "cblas_ztbsv", "libgsl.scm",
+ "cblas_ztpmv", "libgsl.scm",
+ "cblas_ztpsv", "libgsl.scm",
+ "cblas_ztrmm", "libgsl.scm",
+ "cblas_ztrmv", "libgsl.scm",
+ "cblas_ztrsm", "libgsl.scm",
+ "cblas_ztrsv", "libgsl.scm",
+ "cbrt", "libm.scm",
+ "cdr*", "stuff.scm",
+ "cdr-assoc", "stuff.scm",
+ "cedar-waxwing", "animals.scm",
+ "ceil", "libm.scm",
+ "cellon", "clm-ins.scm",
+ "cfgetispeed", "libc.scm",
+ "cfgetospeed", "libc.scm",
+ "cfsetispeed", "libc.scm",
+ "cfsetospeed", "libc.scm",
+ "chain-dsps", "examp.scm",
+ "channel-average-power", "dsp.scm",
+ "channel-clipped?", "examp.scm",
+ "channel-distance", "dsp.scm",
+ "channel-envelope", "enved.scm",
+ "channel-lp", "dsp.scm",
+ "channel-mean", "dsp.scm",
+ "channel-norm", "dsp.scm",
+ "channel-polynomial", "dsp.scm",
+ "channel-rms", "dsp.scm",
+ "channel-sync", "extensions.scm",
+ "channel-total-energy", "dsp.scm",
+ "channel-variance", "dsp.scm",
+ "channel2-angle", "dsp.scm",
+ "channel2-coefficient-of-projection", "dsp.scm",
+ "channel2-inner-product", "dsp.scm",
+ "channel2-orthogonal?", "dsp.scm",
+ "channels-equal?", "extensions.scm",
+ "channels=?", "extensions.scm",
+ "char-foldcase", "r7rs.scm",
+ "chdir", "libc.scm",
+ "cheby-hka", "dsp.scm",
+ "chebyshev", "numerics.scm",
+ "chebyshev-polynomial", "numerics.scm",
+ "chebyshev-prototype", "analog-filter.scm",
+ "check-freq", "clean.scm",
+ "check-mix-tags", "mix.scm",
+ "checkpt", "jcvoi.scm",
+ "chestnut-sided-warbler", "animals.scm",
+ "chipping-sparrow", "animals.scm",
+ "chmod", "libc.scm",
+ "chordalize", "dsp.scm",
+ "chorus", "dsp.scm",
+ "chown", "libc.scm",
+ "chuck-wills-widow", "animals.scm",
+ "circle", "musglyphs.scm",
+ "circular-list", "stuff.scm",
+ "circular-list?", "stuff.scm",
+ "cis", "dlocsig.scm",
+ "cl-set-difference", "stuff.scm",
+ "clamp", "stuff.scm",
+ "clamp-rxycos-r", "generators.scm",
+ "clarinet", "prc95.scm",
+ "clean-channel", "clean.scm",
+ "clean-sound", "clean.scm",
+ "clearerr", "libc.scm",
+ "click-middle-button-to-open-next-file-in-directory", "examp.scm",
+ "click-to-sync", "marks.scm",
+ "clm-display-globals", "ws.scm",
+ "clm-expsrc", "clm-ins.scm",
+ "clm-find-file", "ws.scm",
+ "clm-load", "ws.scm",
+ "cload.scm", "cload.scm",
+ "clock", "libc.scm",
+ "clock_getcpuclockid", "libc.scm",
+ "clock_getres", "libc.scm",
+ "clock_gettime", "libc.scm",
+ "clock_nanosleep", "libc.scm",
+ "clock_settime", "libc.scm",
+ "close", "libc.scm",
+ "close-port", "r7rs.scm",
+ "closedir", "libc.scm",
+ "cnvrev", "clm-ins.scm",
+ "cnvtest", "examp.scm",
+ "collect-if", "stuff.scm",
+ "color-mixes", "mix.scm",
+ "color-samples", "draw.scm",
+ "comb-chord", "examp.scm",
+ "comb-filter", "examp.scm",
+ "command-line", "r7rs.scm",
+ "common-gull", "animals.scm",
+ "common-loon-1", "animals.scm",
+ "common-loon-2", "animals.scm",
+ "common-pauraque", "animals.scm",
+ "common-yellowthroat", "animals.scm",
+ "compand", "examp.scm",
+ "compute-string", "dsp.scm",
+ "compute-uniform-circular-string", "dsp.scm",
+ "concatenate", "stuff.scm",
+ "concatenate-envelopes", "env.scm",
+ "confstr", "libc.scm",
+ "confused-ground-cricket", "animals.scm",
+ "connect", "libc.scm",
+ "constant-velocity", "dlocsig.scm",
+ "continuable-error", "stuff.scm",
+ "continue-from-error", "stuff.scm",
+ "contrast-channel", "extensions.scm",
+ "contrast-sound", "extensions.scm",
+ "copy-tree", "stuff.scm",
+ "copysign", "libm.scm",
+ "count-if", "stuff.scm",
+ "cpu-architecture", "r7rs.scm",
+ "crawfish-frog", "animals.scm",
+ "creat", "libc.scm",
+ "create-initial-envelopes", "enved.scm",
+ "crested-caracara", "animals.scm",
+ "cross-correlate", "snddiff.scm",
+ "cross-fade", "fade.scm",
+ "cross-synthesis", "examp.scm",
+ "ctermid", "libc.scm",
+ "ctime", "libc.scm",
+ "current-jiffy", "r7rs.scm",
+ "current-second", "r7rs.scm",
+ "curveto", "musglyphs.scm",
+ "cyclic?", "stuff.scm",
+ "dark-eyed-junco", "animals.scm",
+ "davis-tree-cricket", "animals.scm",
+ "db-envelope", "grani.scm",
+ "dblsum", "generators.scm",
+ "dblsum?", "generators.scm",
+ "dc-block", "prc95.scm",
+ "defgenerator", "generators.scm",
+ "define-class", "stuff.scm",
+ "define-library", "r7rs.scm",
+ "define-record-type", "r7rs.scm",
+ "define-selection-via-marks", "marks.scm",
+ "definstrument", "ws.scm",
+ "delay-channel-mixes", "mix.scm",
+ "delayl", "prc95.scm",
+ "delete-from-out-to-in", "spokenword.scm",
+ "delete-mix", "mix.scm",
+ "describe", "dlocsig.scm",
+ "describe-hook", "hooks.scm",
+ "describe-mark", "marks.scm",
+ "determinant", "poly.scm",
+ "dht", "dsp.scm",
+ "differ", "peak-phases.scm",
+ "difftime", "libc.scm",
+ "digit-value", "r7rs.scm",
+ "display-bark-fft", "dsp.scm",
+ "display-colored-samples", "draw.scm",
+ "display-correlation", "examp.scm",
+ "display-db", "examp.scm",
+ "display-energy", "examp.scm",
+ "display-previous-edits", "draw.scm",
+ "display-samples-in-color", "draw.scm",
+ "dissolve-fade", "fade.scm",
+ "distance", "dlocsig.scm",
+ "distances-in-feet", "dlocsig.scm",
+ "distances-in-meters", "dlocsig.scm",
+ "dither-channel", "extensions.scm",
+ "dither-sound", "extensions.scm",
+ "div", "libc.scm",
+ "do*", "stuff.scm",
+ "do-all-chans", "examp.scm",
+ "do-chans", "examp.scm",
+ "do-sound-chans", "examp.scm",
+ "dog-day-cicada", "animals.scm",
+ "dolph", "dsp.scm",
+ "dolph-1", "dsp.scm",
+ "double*", "libgsl.scm",
+ "down-oct", "dsp.scm",
+ "dpb", "stuff.scm",
+ "draw", "musglyphs.scm",
+ "draw-128th-rest", "cmn-glyphs.lisp",
+ "draw-16th-rest", "cmn-glyphs.lisp",
+ "draw-32nd-rest", "cmn-glyphs.lisp",
+ "draw-64th-rest", "cmn-glyphs.lisp",
+ "draw-8th-flag-down", "cmn-glyphs.lisp",
+ "draw-8th-flag-up", "cmn-glyphs.lisp",
+ "draw-8th-rest", "cmn-glyphs.lisp",
+ "draw-a-note", "musglyphs.scm",
+ "draw-accent", "cmn-glyphs.lisp",
+ "draw-arpeggio", "cmn-glyphs.lisp",
+ "draw-arpeggios", "cmn-glyphs.lisp",
+ "draw-bass-clef", "cmn-glyphs.lisp",
+ "draw-breath-mark", "cmn-glyphs.lisp",
+ "draw-c-clef", "cmn-glyphs.lisp",
+ "draw-caesura", "cmn-glyphs.lisp",
+ "draw-circled-x", "cmn-glyphs.lisp",
+ "draw-coda", "cmn-glyphs.lisp",
+ "draw-common-time", "cmn-glyphs.lisp",
+ "draw-cut-time", "cmn-glyphs.lisp",
+ "draw-diamond", "cmn-glyphs.lisp",
+ "draw-diamond-1", "cmn-glyphs.lisp",
+ "draw-double-flat", "cmn-glyphs.lisp",
+ "draw-double-mordent", "cmn-glyphs.lisp",
+ "draw-double-sharp", "cmn-glyphs.lisp",
+ "draw-double-whole-note", "cmn-glyphs.lisp",
+ "draw-double-whole-rest", "cmn-glyphs.lisp",
+ "draw-down-bow", "cmn-glyphs.lisp",
+ "draw-eight", "cmn-glyphs.lisp",
+ "draw-extend-flag-down", "cmn-glyphs.lisp",
+ "draw-extend-flag-up", "cmn-glyphs.lisp",
+ "draw-f", "cmn-glyphs.lisp",
+ "draw-fermata", "cmn-glyphs.lisp",
+ "draw-filled-diamond-1", "cmn-glyphs.lisp",
+ "draw-five", "cmn-glyphs.lisp",
+ "draw-flat", "cmn-glyphs.lisp",
+ "draw-four", "cmn-glyphs.lisp",
+ "draw-half-note", "cmn-glyphs.lisp",
+ "draw-half-rest", "cmn-glyphs.lisp",
+ "draw-left-paren", "cmn-glyphs.lisp",
+ "draw-lig-p", "cmn-glyphs.lisp",
+ "draw-lower-bracket", "cmn-glyphs.lisp",
+ "draw-m", "cmn-glyphs.lisp",
+ "draw-measure-rest", "cmn-glyphs.lisp",
+ "draw-mordent", "cmn-glyphs.lisp",
+ "draw-mslash", "cmn-glyphs.lisp",
+ "draw-n", "cmn-glyphs.lisp",
+ "draw-natural", "cmn-glyphs.lisp",
+ "draw-niente", "cmn-glyphs.lisp",
+ "draw-nine", "cmn-glyphs.lisp",
+ "draw-one", "cmn-glyphs.lisp",
+ "draw-p", "cmn-glyphs.lisp",
+ "draw-ped", "cmn-glyphs.lisp",
+ "draw-pedal-off", "cmn-glyphs.lisp",
+ "draw-percussion-clef", "cmn-glyphs.lisp",
+ "draw-plus", "cmn-glyphs.lisp",
+ "draw-quarter-note", "cmn-glyphs.lisp",
+ "draw-quarter-rest", "cmn-glyphs.lisp",
+ "draw-r", "cmn-glyphs.lisp",
+ "draw-repeat-sign", "cmn-glyphs.lisp",
+ "draw-rhythmX", "cmn-glyphs.lisp",
+ "draw-right-paren", "cmn-glyphs.lisp",
+ "draw-s", "cmn-glyphs.lisp",
+ "draw-segno", "cmn-glyphs.lisp",
+ "draw-seven", "cmn-glyphs.lisp",
+ "draw-sharp", "cmn-glyphs.lisp",
+ "draw-six", "cmn-glyphs.lisp",
+ "draw-slash", "cmn-glyphs.lisp",
+ "draw-square", "cmn-glyphs.lisp",
+ "draw-staff", "musglyphs.scm",
+ "draw-subito", "cmn-glyphs.lisp",
+ "draw-three", "cmn-glyphs.lisp",
+ "draw-tnecca", "cmn-glyphs.lisp",
+ "draw-tr", "cmn-glyphs.lisp",
+ "draw-treble-clef", "cmn-glyphs.lisp",
+ "draw-triangle", "cmn-glyphs.lisp",
+ "draw-trill-section", "cmn-glyphs.lisp",
+ "draw-trill-sections", "cmn-glyphs.lisp",
+ "draw-turn", "cmn-glyphs.lisp",
+ "draw-two", "cmn-glyphs.lisp",
+ "draw-up-bow", "cmn-glyphs.lisp",
+ "draw-upper-bracket", "cmn-glyphs.lisp",
+ "draw-upside-down-fermata", "cmn-glyphs.lisp",
+ "draw-wedge", "cmn-glyphs.lisp",
+ "draw-whole-note", "cmn-glyphs.lisp",
+ "draw-whole-rest", "cmn-glyphs.lisp",
+ "draw-z", "cmn-glyphs.lisp",
+ "draw-zero", "cmn-glyphs.lisp",
+ "drone", "clm-ins.scm",
+ "dup", "libc.scm",
+ "dup2", "libc.scm",
+ "dusky-flycatcher", "animals.scm",
+ "eared-grebe", "animals.scm",
+ "eastern-bluebird", "animals.scm",
+ "eastern-meadowlark", "animals.scm",
+ "eastern-wood-pewee-1", "animals.scm",
+ "eastern-wood-pewee-2", "animals.scm",
+ "echo", "examp.scm",
+ "eighth", "stuff.scm",
+ "elambda", "stuff.scm",
+ "elliptic-prototype", "analog-filter.scm",
+ "empty?", "stuff.scm",
+ "endhostent", "libc.scm",
+ "endnetent", "libc.scm",
+ "endprotoent", "libc.scm",
+ "endpwent", "libc.scm",
+ "endservent", "libc.scm",
+ "enum", "stuff.scm",
+ "env-expt-channel", "extensions.scm",
+ "env-mixes", "mix.scm",
+ "env-sound-interp", "examp.scm",
+ "env-squared-channel", "extensions.scm",
+ "envelope-exp", "env.scm",
+ "envelope-last-x", "env.scm",
+ "envelope-or-number", "grani.scm",
+ "enveloped-mix", "extensions.scm",
+ "enveloping-key-press", "enved.scm",
+ "eoddcos", "generators.scm",
+ "eoddcos?", "generators.scm",
+ "eof-object", "r7rs.scm",
+ "ercos", "generators.scm",
+ "ercos?", "generators.scm",
+ "ercoser", "generators.scm",
+ "errno", "libc.scm",
+ "error-message", "r7rs.scm",
+ "erssb", "generators.scm",
+ "erssb?", "generators.scm",
+ "evening-grosbeak", "animals.scm",
+ "every-sample?", "examp.scm",
+ "every?", "stuff.scm",
+ "exact", "r7rs.scm",
+ "exact-integer-sqrt", "r7rs.scm",
+ "exact-integer?", "r7rs.scm",
+ "exp-envelope", "grani.scm",
+ "exp-snd", "clm-ins.scm",
+ "exp2", "libm.scm",
+ "expandn", "expandn.scm",
+ "expfil", "clm-ins.scm",
+ "explode-sf2", "examp.scm",
+ "expm1", "libm.scm",
+ "exponentially-weighted-moving-average?", "generators.scm",
+ "expsnd", "examp.scm",
+ "expsrc", "examp.scm",
+ "exptmod", "numerics.scm",
+ "fabs", "libm.scm",
+ "factorial", "numerics.scm",
+ "factorize", "primes.scm",
+ "false", "libc.scm",
+ "fast-calling-tree-cricket", "animals.scm",
+ "fclose", "libc.scm",
+ "fcntl", "libc.scm",
+ "fdim", "libm.scm",
+ "fdopen", "libc.scm",
+ "features", "r7rs.scm",
+ "feclearexcept", "libc.scm",
+ "fegetenv", "libc.scm",
+ "fegetexceptflag", "libc.scm",
+ "fegetround", "libc.scm",
+ "feholdexcept", "libc.scm",
+ "feof", "libc.scm",
+ "feraiseexcept", "libc.scm",
+ "ferror", "libc.scm",
+ "fesetenv", "libc.scm",
+ "fesetexceptflag", "libc.scm",
+ "fesetround", "libc.scm",
+ "fetestexcept", "libc.scm",
+ "feupdateenv", "libc.scm",
+ "fflush", "libc.scm",
+ "fft-cancel", "examp.scm",
+ "fft-edit", "examp.scm",
+ "fft-env-data", "examp.scm",
+ "fft-env-edit", "examp.scm",
+ "fft-env-interp", "examp.scm",
+ "fft-peak", "examp.scm",
+ "fft-smoother", "examp.scm",
+ "fft-squelch", "examp.scm",
+ "fgetc", "libc.scm",
+ "fgetpos", "libc.scm",
+ "fgets", "libc.scm",
+ "field-sparrow", "animals.scm",
+ "fifth", "stuff.scm",
+ "file->floats", "examp.scm",
+ "file-error?", "r7rs.scm",
+ "fileno", "libc.scm",
+ "files-popdown-info", "nb.scm",
+ "files-popup-info", "nb.scm",
+ "fill-in", "musglyphs.scm",
+ "fillfnc", "jcvoi.scm",
+ "filter-fft", "examp.scm",
+ "filter-selection-and-smooth", "selection.scm",
+ "filtered-env", "examp.scm",
+ "final-direction", "dlocsig.scm",
+ "find-click", "examp.scm",
+ "find-if", "stuff.scm",
+ "find-mix", "mix.scm",
+ "find-noddsin-max", "generators.scm",
+ "find-nxysin-max", "generators.scm",
+ "find-other-mins", "peak-phases.scm",
+ "find-pitch", "examp.scm",
+ "find-sine", "dsp.scm",
+ "finfo", "examp.scm",
+ "finish-with-sound", "ws.scm",
+ "finite?", "r7rs.scm",
+ "first", "stuff.scm",
+ "first-mark-in-window-at-left", "examp.scm",
+ "fit-path", "dlocsig.scm",
+ "fit-selection-between-marks", "marks.scm",
+ "flammulated-owl", "animals.scm",
+ "flash-selected-data", "examp.scm",
+ "flatten-let", "stuff.scm",
+ "flatten-partials", "dsp.scm",
+ "flecho", "examp.scm",
+ "flipxy", "jcvoi.scm",
+ "float-vector->gsl_matrix", "libgsl.scm",
+ "float-vector->gsl_vector", "libgsl.scm",
+ "float-vector->vector", "poly.scm",
+ "float-vector-polynomial", "dsp.scm",
+ "float-vector-size", "snddiff.scm",
+ "float64_to_int32", "binary-io.scm",
+ "float64_to_int64", "binary-io.scm",
+ "flockfile", "libc.scm",
+ "flocsig", "generators.scm",
+ "flocsig?", "generators.scm",
+ "floor-quotient", "r7rs.scm",
+ "floor-remainder", "r7rs.scm",
+ "fltit-1", "dsp.scm",
+ "flute", "prc95.scm",
+ "fm-bell", "clm-ins.scm",
+ "fm-cancellation", "generators.scm",
+ "fm-cascade-component", "dsp.scm",
+ "fm-complex-component", "dsp.scm",
+ "fm-drum", "clm-ins.scm",
+ "fm-insect", "clm-ins.scm",
+ "fm-noise", "noise.scm",
+ "fm-parallel-component", "dsp.scm",
+ "fm-trumpet", "clm-ins.scm",
+ "fm-violin", "v.scm",
+ "fm-voice", "jcvoi.scm",
+ "fm2", "clm-ins.scm",
+ "fma", "libm.scm",
+ "fmssb", "generators.scm",
+ "fmssb?", "generators.scm",
+ "fncval", "jcvoi.scm",
+ "fnmatch", "libc.scm",
+ "fofins", "clm-ins.scm",
+ "fopen", "libc.scm",
+ "for-each-permutation", "stuff.scm",
+ "for-each-sound-file", "extensions.scm",
+ "for-each-subset", "stuff.scm",
+ "force", "r7rs.scm",
+ "fork", "libc.scm",
+ "formant-filter", "examp.scm",
+ "formants", "examp.scm",
+ "four-spotted-tree-cricket", "animals.scm",
+ "fourth", "stuff.scm",
+ "fox-sparrow", "animals.scm",
+ "fp", "examp.scm",
+ "fpathconf", "libc.scm",
+ "fpclassify", "libm.scm",
+ "fpmc", "generators.scm",
+ "fputc", "libc.scm",
+ "fputs", "libc.scm",
+ "fractional-fourier-transform", "dsp.scm",
+ "fread", "libc.scm",
+ "free", "libc.scm",
+ "freeaddrinfo", "libc.scm",
+ "freeverb", "freeverb.scm",
+ "freopen", "libc.scm",
+ "freqdiv", "dsp.scm",
+ "frequency->note-octave-and-accidental", "musglyphs.scm",
+ "frexp", "libm.scm",
+ "fseek", "libc.scm",
+ "fsetpos", "libc.scm",
+ "fstat", "libc.scm",
+ "ftruncate", "libc.scm",
+ "ftrylockfile", "libc.scm",
+ "ftw", "libc.scm",
+ "full-count-if", "stuff.scm",
+ "full-find-if", "stuff.scm",
+ "full-index-if", "stuff.scm",
+ "fullmix", "fullmix.scm",
+ "fully-macroexpand", "stuff.scm",
+ "funlockfile", "libc.scm",
+ "fwrite", "libc.scm",
+ "g-mustext", "musglyphs.scm",
+ "gai_strerror", "libc.scm",
+ "gain", "clm-ins.scm",
+ "gain-avg", "clm-ins.scm",
+ "gambels-quail", "animals.scm",
+ "gather-symbols", "stuff.scm",
+ "gaussian-distribution", "dsp.scm",
+ "gaussian-envelope", "dsp.scm",
+ "gdbm_close", "libgdbm.scm",
+ "gdbm_delete", "libgdbm.scm",
+ "gdbm_errno", "libgdbm.scm",
+ "gdbm_exists", "libgdbm.scm",
+ "gdbm_fdesc", "libgdbm.scm",
+ "gdbm_fetch", "libgdbm.scm",
+ "gdbm_firstkey", "libgdbm.scm",
+ "gdbm_nextkey", "libgdbm.scm",
+ "gdbm_open", "libgdbm.scm",
+ "gdbm_reorganize", "libgdbm.scm",
+ "gdbm_store", "libgdbm.scm",
+ "gdbm_strerror", "libgdbm.scm",
+ "gdbm_sync", "libgdbm.scm",
+ "gdbm_version", "libgdbm.scm",
+ "gegenbauer", "numerics.scm",
+ "generator-clamp-r", "generators.scm",
+ "get-best", "peak-phases.scm",
+ "get-environment-variable", "r7rs.scm",
+ "get-environment-variables", "r7rs.scm",
+ "get-output-bytevector", "r7rs.scm",
+ "get-speaker-configuration", "dlocsig.scm",
+ "getaddrinfo", "libc.scm",
+ "getc", "libc.scm",
+ "getchar", "libc.scm",
+ "getegid", "libc.scm",
+ "getenvs", "libc.scm",
+ "geteuid", "libc.scm",
+ "getgid", "libc.scm",
+ "getgrgid", "libc.scm",
+ "getgrnam", "libc.scm",
+ "getgroups", "libc.scm",
+ "gethostbyaddr", "libc.scm",
+ "gethostbyname", "libc.scm",
+ "gethostent", "libc.scm",
+ "getlogin", "libc.scm",
+ "getnameinfo", "libc.scm",
+ "getnetbyaddr", "libc.scm",
+ "getnetbyname", "libc.scm",
+ "getnetent", "libc.scm",
+ "getpeername", "libc.scm",
+ "getpgid", "libc.scm",
+ "getppid", "libc.scm",
+ "getpriority", "libc.scm",
+ "getprotobyname", "libc.scm",
+ "getprotobynumber", "libc.scm",
+ "getprotoent", "libc.scm",
+ "getpwent", "libc.scm",
+ "getpwnam", "libc.scm",
+ "getpwuid", "libc.scm",
+ "getrlimit", "libc.scm",
+ "getrusage", "libc.scm",
+ "getservbyname", "libc.scm",
+ "getservbyport", "libc.scm",
+ "getservent", "libc.scm",
+ "getsid", "libc.scm",
+ "getsockname", "libc.scm",
+ "getsockopt", "libc.scm",
+ "gettimeofday", "libc.scm",
+ "getuid", "libc.scm",
+ "glassy", "generators.scm",
+ "glob", "libc.scm",
+ "glob.gl_pathc", "libc.scm",
+ "glob.gl_pathv", "libc.scm",
+ "glob.make", "libc.scm",
+ "globfree", "libc.scm",
+ "gmtime", "libc.scm",
+ "goertzel", "dsp.scm",
+ "goertzel-channel", "clean.scm",
+ "golden-crowned-sparrow", "animals.scm",
+ "gong", "clm-ins.scm",
+ "gran-synth", "clm-ins.scm",
+ "grani", "grani.scm",
+ "granulated-sound-interp", "examp.scm",
+ "graphEq", "clm-ins.scm",
+ "grasshopper-sparrow", "animals.scm",
+ "gray-crowned-rosy-finch", "animals.scm",
+ "gray-vireo", "animals.scm",
+ "gray-vireo-1", "animals.scm",
+ "gray-vireo-2", "animals.scm",
+ "gray-vireo-3", "animals.scm",
+ "gray-vireo-4", "animals.scm",
+ "gray-vireo-5", "animals.scm",
+ "great-crested-flycatcher", "animals.scm",
+ "great-horned-owl", "animals.scm",
+ "great-kiskadee", "animals.scm",
+ "great-plains-narrow-mouthed-toad", "animals.scm",
+ "greater-pewee", "animals.scm",
+ "greater-roadrunner", "animals.scm",
+ "green-noise", "generators.scm",
+ "green-noise-interp", "generators.scm",
+ "green-noise-interp?", "generators.scm",
+ "green-noise?", "generators.scm",
+ "green-tailed-towhee", "animals.scm",
+ "green-toad", "animals.scm",
+ "green-tree-frog", "animals.scm",
+ "groove-billed-ani", "animals.scm",
+ "group-id", "dlocsig.scm",
+ "group-matrix", "dlocsig.scm",
+ "group-size", "dlocsig.scm",
+ "group-speakers", "dlocsig.scm",
+ "group-vertices", "dlocsig.scm",
+ "group.gr_gid", "libc.scm",
+ "group.gr_mem", "libc.scm",
+ "group.gr_name", "libc.scm",
+ "group.gr_passwd", "libc.scm",
+ "gsl_acosh", "libgsl.scm",
+ "gsl_asinh", "libgsl.scm",
+ "gsl_atanh", "libgsl.scm",
+ "gsl_blas_dasum", "libgsl.scm",
+ "gsl_blas_daxpy", "libgsl.scm",
+ "gsl_blas_dcopy", "libgsl.scm",
+ "gsl_blas_dgemm", "libgsl.scm",
+ "gsl_blas_dgemv", "libgsl.scm",
+ "gsl_blas_dger", "libgsl.scm",
+ "gsl_blas_dnrm2", "libgsl.scm",
+ "gsl_blas_drot", "libgsl.scm",
+ "gsl_blas_drotg", "libgsl.scm",
+ "gsl_blas_drotm", "libgsl.scm",
+ "gsl_blas_drotmg", "libgsl.scm",
+ "gsl_blas_dscal", "libgsl.scm",
+ "gsl_blas_dswap", "libgsl.scm",
+ "gsl_blas_dsymm", "libgsl.scm",
+ "gsl_blas_dsymv", "libgsl.scm",
+ "gsl_blas_dsyr", "libgsl.scm",
+ "gsl_blas_dsyr2", "libgsl.scm",
+ "gsl_blas_dsyr2k", "libgsl.scm",
+ "gsl_blas_dsyrk", "libgsl.scm",
+ "gsl_blas_dtrmm", "libgsl.scm",
+ "gsl_blas_dtrmv", "libgsl.scm",
+ "gsl_blas_dtrsm", "libgsl.scm",
+ "gsl_blas_dtrsv", "libgsl.scm",
+ "gsl_blas_dzasum", "libgsl.scm",
+ "gsl_blas_dznrm2", "libgsl.scm",
+ "gsl_blas_idamax", "libgsl.scm",
+ "gsl_blas_izamax", "libgsl.scm",
+ "gsl_blas_zcopy", "libgsl.scm",
+ "gsl_blas_zdotc", "libgsl.scm",
+ "gsl_blas_zdotu", "libgsl.scm",
+ "gsl_blas_zdscal", "libgsl.scm",
+ "gsl_blas_zher", "libgsl.scm",
+ "gsl_blas_zherk", "libgsl.scm",
+ "gsl_blas_zswap", "libgsl.scm",
+ "gsl_blas_ztrmv", "libgsl.scm",
+ "gsl_blas_ztrsv", "libgsl.scm",
+ "gsl_bspline_alloc", "libgsl.scm",
+ "gsl_bspline_breakpoint", "libgsl.scm",
+ "gsl_bspline_deriv_eval", "libgsl.scm",
+ "gsl_bspline_deriv_eval_nonzero", "libgsl.scm",
+ "gsl_bspline_eval", "libgsl.scm",
+ "gsl_bspline_eval_nonzero", "libgsl.scm",
+ "gsl_bspline_free", "libgsl.scm",
+ "gsl_bspline_greville_abscissa", "libgsl.scm",
+ "gsl_bspline_knots", "libgsl.scm",
+ "gsl_bspline_knots_greville", "libgsl.scm",
+ "gsl_bspline_knots_uniform", "libgsl.scm",
+ "gsl_bspline_nbreak", "libgsl.scm",
+ "gsl_bspline_ncoeffs", "libgsl.scm",
+ "gsl_bspline_order", "libgsl.scm",
+ "gsl_cdf_beta_P", "libgsl.scm",
+ "gsl_cdf_beta_Pinv", "libgsl.scm",
+ "gsl_cdf_beta_Q", "libgsl.scm",
+ "gsl_cdf_beta_Qinv", "libgsl.scm",
+ "gsl_cdf_binomial_P", "libgsl.scm",
+ "gsl_cdf_binomial_Q", "libgsl.scm",
+ "gsl_cdf_cauchy_P", "libgsl.scm",
+ "gsl_cdf_cauchy_Pinv", "libgsl.scm",
+ "gsl_cdf_cauchy_Q", "libgsl.scm",
+ "gsl_cdf_cauchy_Qinv", "libgsl.scm",
+ "gsl_cdf_chisq_P", "libgsl.scm",
+ "gsl_cdf_chisq_Pinv", "libgsl.scm",
+ "gsl_cdf_chisq_Q", "libgsl.scm",
+ "gsl_cdf_chisq_Qinv", "libgsl.scm",
+ "gsl_cdf_exponential_P", "libgsl.scm",
+ "gsl_cdf_exponential_Pinv", "libgsl.scm",
+ "gsl_cdf_exponential_Q", "libgsl.scm",
+ "gsl_cdf_exponential_Qinv", "libgsl.scm",
+ "gsl_cdf_exppow_P", "libgsl.scm",
+ "gsl_cdf_exppow_Q", "libgsl.scm",
+ "gsl_cdf_fdist_P", "libgsl.scm",
+ "gsl_cdf_fdist_Pinv", "libgsl.scm",
+ "gsl_cdf_fdist_Q", "libgsl.scm",
+ "gsl_cdf_fdist_Qinv", "libgsl.scm",
+ "gsl_cdf_flat_P", "libgsl.scm",
+ "gsl_cdf_flat_Pinv", "libgsl.scm",
+ "gsl_cdf_flat_Q", "libgsl.scm",
+ "gsl_cdf_flat_Qinv", "libgsl.scm",
+ "gsl_cdf_gamma_P", "libgsl.scm",
+ "gsl_cdf_gamma_Pinv", "libgsl.scm",
+ "gsl_cdf_gamma_Q", "libgsl.scm",
+ "gsl_cdf_gamma_Qinv", "libgsl.scm",
+ "gsl_cdf_gaussian_P", "libgsl.scm",
+ "gsl_cdf_gaussian_Pinv", "libgsl.scm",
+ "gsl_cdf_gaussian_Q", "libgsl.scm",
+ "gsl_cdf_gaussian_Qinv", "libgsl.scm",
+ "gsl_cdf_geometric_P", "libgsl.scm",
+ "gsl_cdf_geometric_Q", "libgsl.scm",
+ "gsl_cdf_gumbel1_P", "libgsl.scm",
+ "gsl_cdf_gumbel1_Pinv", "libgsl.scm",
+ "gsl_cdf_gumbel1_Q", "libgsl.scm",
+ "gsl_cdf_gumbel1_Qinv", "libgsl.scm",
+ "gsl_cdf_gumbel2_P", "libgsl.scm",
+ "gsl_cdf_gumbel2_Pinv", "libgsl.scm",
+ "gsl_cdf_gumbel2_Q", "libgsl.scm",
+ "gsl_cdf_gumbel2_Qinv", "libgsl.scm",
+ "gsl_cdf_hypergeometric_P", "libgsl.scm",
+ "gsl_cdf_hypergeometric_Q", "libgsl.scm",
+ "gsl_cdf_laplace_P", "libgsl.scm",
+ "gsl_cdf_laplace_Pinv", "libgsl.scm",
+ "gsl_cdf_laplace_Q", "libgsl.scm",
+ "gsl_cdf_laplace_Qinv", "libgsl.scm",
+ "gsl_cdf_logistic_P", "libgsl.scm",
+ "gsl_cdf_logistic_Pinv", "libgsl.scm",
+ "gsl_cdf_logistic_Q", "libgsl.scm",
+ "gsl_cdf_logistic_Qinv", "libgsl.scm",
+ "gsl_cdf_lognormal_P", "libgsl.scm",
+ "gsl_cdf_lognormal_Pinv", "libgsl.scm",
+ "gsl_cdf_lognormal_Q", "libgsl.scm",
+ "gsl_cdf_lognormal_Qinv", "libgsl.scm",
+ "gsl_cdf_negative_binomial_P", "libgsl.scm",
+ "gsl_cdf_negative_binomial_Q", "libgsl.scm",
+ "gsl_cdf_pareto_P", "libgsl.scm",
+ "gsl_cdf_pareto_Pinv", "libgsl.scm",
+ "gsl_cdf_pareto_Q", "libgsl.scm",
+ "gsl_cdf_pareto_Qinv", "libgsl.scm",
+ "gsl_cdf_pascal_P", "libgsl.scm",
+ "gsl_cdf_pascal_Q", "libgsl.scm",
+ "gsl_cdf_poisson_P", "libgsl.scm",
+ "gsl_cdf_poisson_Q", "libgsl.scm",
+ "gsl_cdf_rayleigh_P", "libgsl.scm",
+ "gsl_cdf_rayleigh_Pinv", "libgsl.scm",
+ "gsl_cdf_rayleigh_Q", "libgsl.scm",
+ "gsl_cdf_rayleigh_Qinv", "libgsl.scm",
+ "gsl_cdf_tdist_P", "libgsl.scm",
+ "gsl_cdf_tdist_Pinv", "libgsl.scm",
+ "gsl_cdf_tdist_Q", "libgsl.scm",
+ "gsl_cdf_tdist_Qinv", "libgsl.scm",
+ "gsl_cdf_ugaussian_P", "libgsl.scm",
+ "gsl_cdf_ugaussian_Pinv", "libgsl.scm",
+ "gsl_cdf_ugaussian_Q", "libgsl.scm",
+ "gsl_cdf_ugaussian_Qinv", "libgsl.scm",
+ "gsl_cdf_weibull_P", "libgsl.scm",
+ "gsl_cdf_weibull_Pinv", "libgsl.scm",
+ "gsl_cdf_weibull_Q", "libgsl.scm",
+ "gsl_cdf_weibull_Qinv", "libgsl.scm",
+ "gsl_cheb_alloc", "libgsl.scm",
+ "gsl_cheb_calc_deriv", "libgsl.scm",
+ "gsl_cheb_calc_integ", "libgsl.scm",
+ "gsl_cheb_coeffs", "libgsl.scm",
+ "gsl_cheb_eval", "libgsl.scm",
+ "gsl_cheb_eval_err", "libgsl.scm",
+ "gsl_cheb_eval_mode", "libgsl.scm",
+ "gsl_cheb_eval_mode_e", "libgsl.scm",
+ "gsl_cheb_eval_n", "libgsl.scm",
+ "gsl_cheb_eval_n_err", "libgsl.scm",
+ "gsl_cheb_free", "libgsl.scm",
+ "gsl_cheb_init", "libgsl.scm",
+ "gsl_cheb_order", "libgsl.scm",
+ "gsl_cheb_size", "libgsl.scm",
+ "gsl_check_range", "libgsl.scm",
+ "gsl_coerce_double", "libgsl.scm",
+ "gsl_combination->int-vector", "libgsl.scm",
+ "gsl_combination_alloc", "libgsl.scm",
+ "gsl_combination_calloc", "libgsl.scm",
+ "gsl_combination_fprintf", "libgsl.scm",
+ "gsl_combination_fread", "libgsl.scm",
+ "gsl_combination_free", "libgsl.scm",
+ "gsl_combination_fscanf", "libgsl.scm",
+ "gsl_combination_fwrite", "libgsl.scm",
+ "gsl_combination_get", "libgsl.scm",
+ "gsl_combination_init_first", "libgsl.scm",
+ "gsl_combination_init_last", "libgsl.scm",
+ "gsl_combination_k", "libgsl.scm",
+ "gsl_combination_memcpy", "libgsl.scm",
+ "gsl_combination_n", "libgsl.scm",
+ "gsl_combination_next", "libgsl.scm",
+ "gsl_combination_prev", "libgsl.scm",
+ "gsl_combination_valid", "libgsl.scm",
+ "gsl_complex_abs", "libgsl.scm",
+ "gsl_complex_abs2", "libgsl.scm",
+ "gsl_complex_add", "libgsl.scm",
+ "gsl_complex_add_imag", "libgsl.scm",
+ "gsl_complex_add_real", "libgsl.scm",
+ "gsl_complex_arccos", "libgsl.scm",
+ "gsl_complex_arccos_real", "libgsl.scm",
+ "gsl_complex_arccosh", "libgsl.scm",
+ "gsl_complex_arccosh_real", "libgsl.scm",
+ "gsl_complex_arccot", "libgsl.scm",
+ "gsl_complex_arccoth", "libgsl.scm",
+ "gsl_complex_arccsc", "libgsl.scm",
+ "gsl_complex_arccsc_real", "libgsl.scm",
+ "gsl_complex_arccsch", "libgsl.scm",
+ "gsl_complex_arcsec", "libgsl.scm",
+ "gsl_complex_arcsec_real", "libgsl.scm",
+ "gsl_complex_arcsech", "libgsl.scm",
+ "gsl_complex_arcsin", "libgsl.scm",
+ "gsl_complex_arcsin_real", "libgsl.scm",
+ "gsl_complex_arcsinh", "libgsl.scm",
+ "gsl_complex_arctan", "libgsl.scm",
+ "gsl_complex_arctanh", "libgsl.scm",
+ "gsl_complex_arctanh_real", "libgsl.scm",
+ "gsl_complex_arg", "libgsl.scm",
+ "gsl_complex_conjugate", "libgsl.scm",
+ "gsl_complex_cos", "libgsl.scm",
+ "gsl_complex_cosh", "libgsl.scm",
+ "gsl_complex_cot", "libgsl.scm",
+ "gsl_complex_coth", "libgsl.scm",
+ "gsl_complex_csc", "libgsl.scm",
+ "gsl_complex_csch", "libgsl.scm",
+ "gsl_complex_div", "libgsl.scm",
+ "gsl_complex_div_imag", "libgsl.scm",
+ "gsl_complex_div_real", "libgsl.scm",
+ "gsl_complex_exp", "libgsl.scm",
+ "gsl_complex_inverse", "libgsl.scm",
+ "gsl_complex_log", "libgsl.scm",
+ "gsl_complex_log10", "libgsl.scm",
+ "gsl_complex_log_b", "libgsl.scm",
+ "gsl_complex_logabs", "libgsl.scm",
+ "gsl_complex_mul", "libgsl.scm",
+ "gsl_complex_mul_imag", "libgsl.scm",
+ "gsl_complex_mul_real", "libgsl.scm",
+ "gsl_complex_negative", "libgsl.scm",
+ "gsl_complex_polar", "libgsl.scm",
+ "gsl_complex_poly_complex_eval", "libgsl.scm",
+ "gsl_complex_pow", "libgsl.scm",
+ "gsl_complex_pow_real", "libgsl.scm",
+ "gsl_complex_rect", "libgsl.scm",
+ "gsl_complex_sec", "libgsl.scm",
+ "gsl_complex_sech", "libgsl.scm",
+ "gsl_complex_sin", "libgsl.scm",
+ "gsl_complex_sinh", "libgsl.scm",
+ "gsl_complex_sqrt", "libgsl.scm",
+ "gsl_complex_sqrt_real", "libgsl.scm",
+ "gsl_complex_sub", "libgsl.scm",
+ "gsl_complex_sub_imag", "libgsl.scm",
+ "gsl_complex_sub_real", "libgsl.scm",
+ "gsl_complex_tan", "libgsl.scm",
+ "gsl_complex_tanh", "libgsl.scm",
+ "gsl_deriv_backward", "libgsl.scm",
+ "gsl_deriv_central", "libgsl.scm",
+ "gsl_deriv_forward", "libgsl.scm",
+ "gsl_dft_complex_backward", "libgsl.scm",
+ "gsl_dft_complex_forward", "libgsl.scm",
+ "gsl_dft_complex_inverse", "libgsl.scm",
+ "gsl_dft_complex_transform", "libgsl.scm",
+ "gsl_dht_alloc", "libgsl.scm",
+ "gsl_dht_apply", "libgsl.scm",
+ "gsl_dht_free", "libgsl.scm",
+ "gsl_dht_init", "libgsl.scm",
+ "gsl_dht_k_sample", "libgsl.scm",
+ "gsl_dht_new", "libgsl.scm",
+ "gsl_dht_x_sample", "libgsl.scm",
+ "gsl_eigen_francis", "libgsl.scm",
+ "gsl_eigen_francis_T", "libgsl.scm",
+ "gsl_eigen_francis_Z", "libgsl.scm",
+ "gsl_eigen_francis_alloc", "libgsl.scm",
+ "gsl_eigen_francis_free", "libgsl.scm",
+ "gsl_eigen_gen", "libgsl.scm",
+ "gsl_eigen_gen_QZ", "libgsl.scm",
+ "gsl_eigen_gen_alloc", "libgsl.scm",
+ "gsl_eigen_gen_free", "libgsl.scm",
+ "gsl_eigen_gen_params", "libgsl.scm",
+ "gsl_eigen_genherm", "libgsl.scm",
+ "gsl_eigen_genherm_alloc", "libgsl.scm",
+ "gsl_eigen_genherm_free", "libgsl.scm",
+ "gsl_eigen_genherm_standardize", "libgsl.scm",
+ "gsl_eigen_genhermv", "libgsl.scm",
+ "gsl_eigen_genhermv_alloc", "libgsl.scm",
+ "gsl_eigen_genhermv_free", "libgsl.scm",
+ "gsl_eigen_genhermv_sort", "libgsl.scm",
+ "gsl_eigen_gensymm", "libgsl.scm",
+ "gsl_eigen_gensymm_alloc", "libgsl.scm",
+ "gsl_eigen_gensymm_free", "libgsl.scm",
+ "gsl_eigen_gensymm_standardize", "libgsl.scm",
+ "gsl_eigen_gensymmv", "libgsl.scm",
+ "gsl_eigen_gensymmv_alloc", "libgsl.scm",
+ "gsl_eigen_gensymmv_free", "libgsl.scm",
+ "gsl_eigen_gensymmv_sort", "libgsl.scm",
+ "gsl_eigen_genv", "libgsl.scm",
+ "gsl_eigen_genv_QZ", "libgsl.scm",
+ "gsl_eigen_genv_alloc", "libgsl.scm",
+ "gsl_eigen_genv_free", "libgsl.scm",
+ "gsl_eigen_genv_sort", "libgsl.scm",
+ "gsl_eigen_herm", "libgsl.scm",
+ "gsl_eigen_herm_alloc", "libgsl.scm",
+ "gsl_eigen_herm_free", "libgsl.scm",
+ "gsl_eigen_hermv", "libgsl.scm",
+ "gsl_eigen_hermv_alloc", "libgsl.scm",
+ "gsl_eigen_hermv_free", "libgsl.scm",
+ "gsl_eigen_hermv_sort", "libgsl.scm",
+ "gsl_eigen_invert_jacobi", "libgsl.scm",
+ "gsl_eigen_jacobi", "libgsl.scm",
+ "gsl_eigen_nonsymm", "libgsl.scm",
+ "gsl_eigen_nonsymm_Z", "libgsl.scm",
+ "gsl_eigen_nonsymm_alloc", "libgsl.scm",
+ "gsl_eigen_nonsymm_free", "libgsl.scm",
+ "gsl_eigen_nonsymm_params", "libgsl.scm",
+ "gsl_eigen_nonsymmv", "libgsl.scm",
+ "gsl_eigen_nonsymmv_Z", "libgsl.scm",
+ "gsl_eigen_nonsymmv_alloc", "libgsl.scm",
+ "gsl_eigen_nonsymmv_free", "libgsl.scm",
+ "gsl_eigen_nonsymmv_params", "libgsl.scm",
+ "gsl_eigen_nonsymmv_sort", "libgsl.scm",
+ "gsl_eigen_symm", "libgsl.scm",
+ "gsl_eigen_symm_alloc", "libgsl.scm",
+ "gsl_eigen_symm_free", "libgsl.scm",
+ "gsl_eigen_symmv", "libgsl.scm",
+ "gsl_eigen_symmv_alloc", "libgsl.scm",
+ "gsl_eigen_symmv_free", "libgsl.scm",
+ "gsl_eigen_symmv_sort", "libgsl.scm",
+ "gsl_error", "libgsl.scm",
+ "gsl_expm1", "libgsl.scm",
+ "gsl_fcmp", "libgsl.scm",
+ "gsl_fdiv", "libgsl.scm",
+ "gsl_fft_backward", "libgsl.scm",
+ "gsl_fft_complex_backward", "libgsl.scm",
+ "gsl_fft_complex_forward", "libgsl.scm",
+ "gsl_fft_complex_inverse", "libgsl.scm",
+ "gsl_fft_complex_memcpy", "libgsl.scm",
+ "gsl_fft_complex_radix2_backward", "libgsl.scm",
+ "gsl_fft_complex_radix2_dif_backward", "libgsl.scm",
+ "gsl_fft_complex_radix2_dif_forward", "libgsl.scm",
+ "gsl_fft_complex_radix2_dif_inverse", "libgsl.scm",
+ "gsl_fft_complex_radix2_dif_transform", "libgsl.scm",
+ "gsl_fft_complex_radix2_forward", "libgsl.scm",
+ "gsl_fft_complex_radix2_inverse", "libgsl.scm",
+ "gsl_fft_complex_radix2_transform", "libgsl.scm",
+ "gsl_fft_complex_transform", "libgsl.scm",
+ "gsl_fft_complex_wavetable_alloc", "libgsl.scm",
+ "gsl_fft_complex_wavetable_free", "libgsl.scm",
+ "gsl_fft_complex_workspace_alloc", "libgsl.scm",
+ "gsl_fft_complex_workspace_free", "libgsl.scm",
+ "gsl_fft_forward", "libgsl.scm",
+ "gsl_fft_real_radix2_transform", "libgsl.scm",
+ "gsl_fft_real_transform", "libgsl.scm",
+ "gsl_fft_real_unpack", "libgsl.scm",
+ "gsl_fft_real_wavetable_alloc", "libgsl.scm",
+ "gsl_fft_real_wavetable_free", "libgsl.scm",
+ "gsl_fft_real_workspace_alloc", "libgsl.scm",
+ "gsl_fft_real_workspace_free", "libgsl.scm",
+ "gsl_finite", "libgsl.scm",
+ "gsl_fit_linear", "libgsl.scm",
+ "gsl_fit_linear_est", "libgsl.scm",
+ "gsl_fit_mul", "libgsl.scm",
+ "gsl_fit_mul_est", "libgsl.scm",
+ "gsl_fit_wlinear", "libgsl.scm",
+ "gsl_fit_wmul", "libgsl.scm",
+ "gsl_frexp", "libgsl.scm",
+ "gsl_histogram2d_accumulate", "libgsl.scm",
+ "gsl_histogram2d_add", "libgsl.scm",
+ "gsl_histogram2d_alloc", "libgsl.scm",
+ "gsl_histogram2d_calloc", "libgsl.scm",
+ "gsl_histogram2d_calloc_range", "libgsl.scm",
+ "gsl_histogram2d_calloc_uniform", "libgsl.scm",
+ "gsl_histogram2d_clone", "libgsl.scm",
+ "gsl_histogram2d_cov", "libgsl.scm",
+ "gsl_histogram2d_div", "libgsl.scm",
+ "gsl_histogram2d_equal_bins_p", "libgsl.scm",
+ "gsl_histogram2d_find", "libgsl.scm",
+ "gsl_histogram2d_fprintf", "libgsl.scm",
+ "gsl_histogram2d_fread", "libgsl.scm",
+ "gsl_histogram2d_free", "libgsl.scm",
+ "gsl_histogram2d_fscanf", "libgsl.scm",
+ "gsl_histogram2d_fwrite", "libgsl.scm",
+ "gsl_histogram2d_get", "libgsl.scm",
+ "gsl_histogram2d_get_xrange", "libgsl.scm",
+ "gsl_histogram2d_get_yrange", "libgsl.scm",
+ "gsl_histogram2d_increment", "libgsl.scm",
+ "gsl_histogram2d_max_bin", "libgsl.scm",
+ "gsl_histogram2d_max_val", "libgsl.scm",
+ "gsl_histogram2d_memcpy", "libgsl.scm",
+ "gsl_histogram2d_min_bin", "libgsl.scm",
+ "gsl_histogram2d_min_val", "libgsl.scm",
+ "gsl_histogram2d_mul", "libgsl.scm",
+ "gsl_histogram2d_nx", "libgsl.scm",
+ "gsl_histogram2d_ny", "libgsl.scm",
+ "gsl_histogram2d_pdf_alloc", "libgsl.scm",
+ "gsl_histogram2d_pdf_free", "libgsl.scm",
+ "gsl_histogram2d_pdf_init", "libgsl.scm",
+ "gsl_histogram2d_pdf_sample", "libgsl.scm",
+ "gsl_histogram2d_reset", "libgsl.scm",
+ "gsl_histogram2d_scale", "libgsl.scm",
+ "gsl_histogram2d_set_ranges_uniform", "libgsl.scm",
+ "gsl_histogram2d_shift", "libgsl.scm",
+ "gsl_histogram2d_sub", "libgsl.scm",
+ "gsl_histogram2d_sum", "libgsl.scm",
+ "gsl_histogram2d_xmax", "libgsl.scm",
+ "gsl_histogram2d_xmean", "libgsl.scm",
+ "gsl_histogram2d_xmin", "libgsl.scm",
+ "gsl_histogram2d_xsigma", "libgsl.scm",
+ "gsl_histogram2d_ymax", "libgsl.scm",
+ "gsl_histogram2d_ymean", "libgsl.scm",
+ "gsl_histogram2d_ymin", "libgsl.scm",
+ "gsl_histogram2d_ysigma", "libgsl.scm",
+ "gsl_histogram_accumulate", "libgsl.scm",
+ "gsl_histogram_add", "libgsl.scm",
+ "gsl_histogram_alloc", "libgsl.scm",
+ "gsl_histogram_bins", "libgsl.scm",
+ "gsl_histogram_calloc", "libgsl.scm",
+ "gsl_histogram_calloc_range", "libgsl.scm",
+ "gsl_histogram_calloc_uniform", "libgsl.scm",
+ "gsl_histogram_clone", "libgsl.scm",
+ "gsl_histogram_div", "libgsl.scm",
+ "gsl_histogram_equal_bins_p", "libgsl.scm",
+ "gsl_histogram_find", "libgsl.scm",
+ "gsl_histogram_fprintf", "libgsl.scm",
+ "gsl_histogram_fread", "libgsl.scm",
+ "gsl_histogram_free", "libgsl.scm",
+ "gsl_histogram_fscanf", "libgsl.scm",
+ "gsl_histogram_fwrite", "libgsl.scm",
+ "gsl_histogram_get", "libgsl.scm",
+ "gsl_histogram_get_range", "libgsl.scm",
+ "gsl_histogram_increment", "libgsl.scm",
+ "gsl_histogram_max", "libgsl.scm",
+ "gsl_histogram_max_bin", "libgsl.scm",
+ "gsl_histogram_max_val", "libgsl.scm",
+ "gsl_histogram_mean", "libgsl.scm",
+ "gsl_histogram_memcpy", "libgsl.scm",
+ "gsl_histogram_min", "libgsl.scm",
+ "gsl_histogram_min_bin", "libgsl.scm",
+ "gsl_histogram_min_val", "libgsl.scm",
+ "gsl_histogram_mul", "libgsl.scm",
+ "gsl_histogram_pdf_alloc", "libgsl.scm",
+ "gsl_histogram_pdf_free", "libgsl.scm",
+ "gsl_histogram_pdf_init", "libgsl.scm",
+ "gsl_histogram_pdf_sample", "libgsl.scm",
+ "gsl_histogram_reset", "libgsl.scm",
+ "gsl_histogram_scale", "libgsl.scm",
+ "gsl_histogram_set_ranges", "libgsl.scm",
+ "gsl_histogram_set_ranges_uniform", "libgsl.scm",
+ "gsl_histogram_shift", "libgsl.scm",
+ "gsl_histogram_sigma", "libgsl.scm",
+ "gsl_histogram_sub", "libgsl.scm",
+ "gsl_histogram_sum", "libgsl.scm",
+ "gsl_hypot", "libgsl.scm",
+ "gsl_hypot3", "libgsl.scm",
+ "gsl_ieee_env_setup", "libgsl.scm",
+ "gsl_ieee_set_mode", "libgsl.scm",
+ "gsl_integration_cquad_workspace_alloc", "libgsl.scm",
+ "gsl_integration_cquad_workspace_free", "libgsl.scm",
+ "gsl_integration_glfixed", "libgsl.scm",
+ "gsl_integration_glfixed_point", "libgsl.scm",
+ "gsl_integration_glfixed_table_alloc", "libgsl.scm",
+ "gsl_integration_glfixed_table_free", "libgsl.scm",
+ "gsl_integration_qag", "libgsl.scm",
+ "gsl_integration_qagi", "libgsl.scm",
+ "gsl_integration_qagil", "libgsl.scm",
+ "gsl_integration_qagiu", "libgsl.scm",
+ "gsl_integration_qagp", "libgsl.scm",
+ "gsl_integration_qags", "libgsl.scm",
+ "gsl_integration_qawc", "libgsl.scm",
+ "gsl_integration_qawf", "libgsl.scm",
+ "gsl_integration_qawo", "libgsl.scm",
+ "gsl_integration_qawo_table_alloc", "libgsl.scm",
+ "gsl_integration_qawo_table_free", "libgsl.scm",
+ "gsl_integration_qawo_table_set", "libgsl.scm",
+ "gsl_integration_qawo_table_set_length", "libgsl.scm",
+ "gsl_integration_qaws", "libgsl.scm",
+ "gsl_integration_qaws_table_alloc", "libgsl.scm",
+ "gsl_integration_qaws_table_free", "libgsl.scm",
+ "gsl_integration_qaws_table_set", "libgsl.scm",
+ "gsl_integration_qcheb", "libgsl.scm",
+ "gsl_integration_qk", "libgsl.scm",
+ "gsl_integration_qk15", "libgsl.scm",
+ "gsl_integration_qk21", "libgsl.scm",
+ "gsl_integration_qk31", "libgsl.scm",
+ "gsl_integration_qk41", "libgsl.scm",
+ "gsl_integration_qk51", "libgsl.scm",
+ "gsl_integration_qk61", "libgsl.scm",
+ "gsl_integration_qng", "libgsl.scm",
+ "gsl_integration_workspace_alloc", "libgsl.scm",
+ "gsl_integration_workspace_free", "libgsl.scm",
+ "gsl_interp2d_alloc", "libgsl.scm",
+ "gsl_interp2d_bicubic", "libgsl.scm",
+ "gsl_interp2d_bilinear", "libgsl.scm",
+ "gsl_interp2d_eval", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_x", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_x_e", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_xx", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_xx_e", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_xy", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_xy_e", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_y", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_y_e", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_yy", "libgsl.scm",
+ "gsl_interp2d_eval_deriv_yy_e", "libgsl.scm",
+ "gsl_interp2d_eval_e", "libgsl.scm",
+ "gsl_interp2d_eval_e_extrap", "libgsl.scm",
+ "gsl_interp2d_eval_extrap", "libgsl.scm",
+ "gsl_interp2d_free", "libgsl.scm",
+ "gsl_interp2d_get", "libgsl.scm",
+ "gsl_interp2d_idx", "libgsl.scm",
+ "gsl_interp2d_init", "libgsl.scm",
+ "gsl_interp2d_min_size", "libgsl.scm",
+ "gsl_interp2d_name", "libgsl.scm",
+ "gsl_interp2d_set", "libgsl.scm",
+ "gsl_interp2d_type_min_size", "libgsl.scm",
+ "gsl_interp_accel_alloc", "libgsl.scm",
+ "gsl_interp_accel_find", "libgsl.scm",
+ "gsl_interp_accel_free", "libgsl.scm",
+ "gsl_interp_accel_reset", "libgsl.scm",
+ "gsl_interp_akima", "libgsl.scm",
+ "gsl_interp_akima_periodic", "libgsl.scm",
+ "gsl_interp_alloc", "libgsl.scm",
+ "gsl_interp_bsearch", "libgsl.scm",
+ "gsl_interp_cspline", "libgsl.scm",
+ "gsl_interp_cspline_periodic", "libgsl.scm",
+ "gsl_interp_eval", "libgsl.scm",
+ "gsl_interp_eval_deriv", "libgsl.scm",
+ "gsl_interp_eval_deriv2", "libgsl.scm",
+ "gsl_interp_eval_deriv2_e", "libgsl.scm",
+ "gsl_interp_eval_deriv_e", "libgsl.scm",
+ "gsl_interp_eval_e", "libgsl.scm",
+ "gsl_interp_eval_integ", "libgsl.scm",
+ "gsl_interp_eval_integ_e", "libgsl.scm",
+ "gsl_interp_free", "libgsl.scm",
+ "gsl_interp_init", "libgsl.scm",
+ "gsl_interp_linear", "libgsl.scm",
+ "gsl_interp_min_size", "libgsl.scm",
+ "gsl_interp_name", "libgsl.scm",
+ "gsl_interp_polynomial", "libgsl.scm",
+ "gsl_interp_steffen", "libgsl.scm",
+ "gsl_interp_type_min_size", "libgsl.scm",
+ "gsl_isinf", "libgsl.scm",
+ "gsl_isnan", "libgsl.scm",
+ "gsl_ldexp", "libgsl.scm",
+ "gsl_linalg_HH_solve", "libgsl.scm",
+ "gsl_linalg_HH_svx", "libgsl.scm",
+ "gsl_linalg_LQ_LQsolve", "libgsl.scm",
+ "gsl_linalg_LQ_Lsolve_T", "libgsl.scm",
+ "gsl_linalg_LQ_Lsvx_T", "libgsl.scm",
+ "gsl_linalg_LQ_decomp", "libgsl.scm",
+ "gsl_linalg_LQ_lssolve_T", "libgsl.scm",
+ "gsl_linalg_LQ_solve_T", "libgsl.scm",
+ "gsl_linalg_LQ_svx_T", "libgsl.scm",
+ "gsl_linalg_LQ_unpack", "libgsl.scm",
+ "gsl_linalg_LQ_update", "libgsl.scm",
+ "gsl_linalg_LQ_vecQ", "libgsl.scm",
+ "gsl_linalg_LQ_vecQT", "libgsl.scm",
+ "gsl_linalg_LU_decomp", "libgsl.scm",
+ "gsl_linalg_LU_det", "libgsl.scm",
+ "gsl_linalg_LU_invert", "libgsl.scm",
+ "gsl_linalg_LU_lndet", "libgsl.scm",
+ "gsl_linalg_LU_refine", "libgsl.scm",
+ "gsl_linalg_LU_sgndet", "libgsl.scm",
+ "gsl_linalg_LU_solve", "libgsl.scm",
+ "gsl_linalg_LU_svx", "libgsl.scm",
+ "gsl_linalg_L_solve_T", "libgsl.scm",
+ "gsl_linalg_PTLQ_LQsolve_T", "libgsl.scm",
+ "gsl_linalg_PTLQ_Lsolve_T", "libgsl.scm",
+ "gsl_linalg_PTLQ_Lsvx_T", "libgsl.scm",
+ "gsl_linalg_PTLQ_decomp", "libgsl.scm",
+ "gsl_linalg_PTLQ_decomp2", "libgsl.scm",
+ "gsl_linalg_PTLQ_solve_T", "libgsl.scm",
+ "gsl_linalg_PTLQ_svx_T", "libgsl.scm",
+ "gsl_linalg_PTLQ_update", "libgsl.scm",
+ "gsl_linalg_QRPT_QRsolve", "libgsl.scm",
+ "gsl_linalg_QRPT_Rsolve", "libgsl.scm",
+ "gsl_linalg_QRPT_Rsvx", "libgsl.scm",
+ "gsl_linalg_QRPT_decomp", "libgsl.scm",
+ "gsl_linalg_QRPT_decomp2", "libgsl.scm",
+ "gsl_linalg_QRPT_solve", "libgsl.scm",
+ "gsl_linalg_QRPT_svx", "libgsl.scm",
+ "gsl_linalg_QRPT_update", "libgsl.scm",
+ "gsl_linalg_QR_QRsolve", "libgsl.scm",
+ "gsl_linalg_QR_QTmat", "libgsl.scm",
+ "gsl_linalg_QR_QTvec", "libgsl.scm",
+ "gsl_linalg_QR_Qvec", "libgsl.scm",
+ "gsl_linalg_QR_Rsolve", "libgsl.scm",
+ "gsl_linalg_QR_Rsvx", "libgsl.scm",
+ "gsl_linalg_QR_decomp", "libgsl.scm",
+ "gsl_linalg_QR_lssolve", "libgsl.scm",
+ "gsl_linalg_QR_matQ", "libgsl.scm",
+ "gsl_linalg_QR_solve", "libgsl.scm",
+ "gsl_linalg_QR_svx", "libgsl.scm",
+ "gsl_linalg_QR_unpack", "libgsl.scm",
+ "gsl_linalg_QR_update", "libgsl.scm",
+ "gsl_linalg_R_solve", "libgsl.scm",
+ "gsl_linalg_R_svx", "libgsl.scm",
+ "gsl_linalg_SV_decomp", "libgsl.scm",
+ "gsl_linalg_SV_decomp_jacobi", "libgsl.scm",
+ "gsl_linalg_SV_decomp_mod", "libgsl.scm",
+ "gsl_linalg_SV_leverage", "libgsl.scm",
+ "gsl_linalg_SV_solve", "libgsl.scm",
+ "gsl_linalg_balance_accum", "libgsl.scm",
+ "gsl_linalg_balance_columns", "libgsl.scm",
+ "gsl_linalg_balance_matrix", "libgsl.scm",
+ "gsl_linalg_bidiag_decomp", "libgsl.scm",
+ "gsl_linalg_bidiag_unpack", "libgsl.scm",
+ "gsl_linalg_bidiag_unpack2", "libgsl.scm",
+ "gsl_linalg_bidiag_unpack_B", "libgsl.scm",
+ "gsl_linalg_cholesky_decomp", "libgsl.scm",
+ "gsl_linalg_cholesky_decomp_unit", "libgsl.scm",
+ "gsl_linalg_cholesky_invert", "libgsl.scm",
+ "gsl_linalg_cholesky_solve", "libgsl.scm",
+ "gsl_linalg_cholesky_svx", "libgsl.scm",
+ "gsl_linalg_complex_LU_decomp", "libgsl.scm",
+ "gsl_linalg_complex_LU_det", "libgsl.scm",
+ "gsl_linalg_complex_LU_invert", "libgsl.scm",
+ "gsl_linalg_complex_LU_lndet", "libgsl.scm",
+ "gsl_linalg_complex_LU_refine", "libgsl.scm",
+ "gsl_linalg_complex_LU_sgndet", "libgsl.scm",
+ "gsl_linalg_complex_LU_solve", "libgsl.scm",
+ "gsl_linalg_complex_LU_svx", "libgsl.scm",
+ "gsl_linalg_complex_cholesky_decomp", "libgsl.scm",
+ "gsl_linalg_complex_cholesky_invert", "libgsl.scm",
+ "gsl_linalg_complex_cholesky_solve", "libgsl.scm",
+ "gsl_linalg_complex_cholesky_svx", "libgsl.scm",
+ "gsl_linalg_complex_householder_hm", "libgsl.scm",
+ "gsl_linalg_complex_householder_hv", "libgsl.scm",
+ "gsl_linalg_complex_householder_mh", "libgsl.scm",
+ "gsl_linalg_complex_householder_transform", "libgsl.scm",
+ "gsl_linalg_exponential_ss", "libgsl.scm",
+ "gsl_linalg_givens", "libgsl.scm",
+ "gsl_linalg_givens_gv", "libgsl.scm",
+ "gsl_linalg_hermtd_decomp", "libgsl.scm",
+ "gsl_linalg_hermtd_unpack", "libgsl.scm",
+ "gsl_linalg_hermtd_unpack_T", "libgsl.scm",
+ "gsl_linalg_hessenberg", "libgsl.scm",
+ "gsl_linalg_hessenberg_decomp", "libgsl.scm",
+ "gsl_linalg_hessenberg_set_zero", "libgsl.scm",
+ "gsl_linalg_hessenberg_submatrix", "libgsl.scm",
+ "gsl_linalg_hessenberg_unpack", "libgsl.scm",
+ "gsl_linalg_hessenberg_unpack_accum", "libgsl.scm",
+ "gsl_linalg_hesstri_decomp", "libgsl.scm",
+ "gsl_linalg_householder_hm", "libgsl.scm",
+ "gsl_linalg_householder_hm1", "libgsl.scm",
+ "gsl_linalg_householder_hv", "libgsl.scm",
+ "gsl_linalg_householder_mh", "libgsl.scm",
+ "gsl_linalg_householder_transform", "libgsl.scm",
+ "gsl_linalg_matmult", "libgsl.scm",
+ "gsl_linalg_matmult_mod", "libgsl.scm",
+ "gsl_linalg_solve_cyc_tridiag", "libgsl.scm",
+ "gsl_linalg_solve_symm_cyc_tridiag", "libgsl.scm",
+ "gsl_linalg_solve_symm_tridiag", "libgsl.scm",
+ "gsl_linalg_solve_tridiag", "libgsl.scm",
+ "gsl_linalg_symmtd_decomp", "libgsl.scm",
+ "gsl_linalg_symmtd_unpack", "libgsl.scm",
+ "gsl_linalg_symmtd_unpack_T", "libgsl.scm",
+ "gsl_log1p", "libgsl.scm",
+ "gsl_matrix->float-vector", "libgsl.scm",
+ "gsl_matrix_add", "libgsl.scm",
+ "gsl_matrix_add_constant", "libgsl.scm",
+ "gsl_matrix_add_diagonal", "libgsl.scm",
+ "gsl_matrix_alloc", "libgsl.scm",
+ "gsl_matrix_alloc_from_matrix", "libgsl.scm",
+ "gsl_matrix_calloc", "libgsl.scm",
+ "gsl_matrix_complex_add", "libgsl.scm",
+ "gsl_matrix_complex_add_constant", "libgsl.scm",
+ "gsl_matrix_complex_add_diagonal", "libgsl.scm",
+ "gsl_matrix_complex_alloc", "libgsl.scm",
+ "gsl_matrix_complex_alloc_from_matrix", "libgsl.scm",
+ "gsl_matrix_complex_calloc", "libgsl.scm",
+ "gsl_matrix_complex_const_ptr", "libgsl.scm",
+ "gsl_matrix_complex_div_elements", "libgsl.scm",
+ "gsl_matrix_complex_equal", "libgsl.scm",
+ "gsl_matrix_complex_fprintf", "libgsl.scm",
+ "gsl_matrix_complex_fread", "libgsl.scm",
+ "gsl_matrix_complex_free", "libgsl.scm",
+ "gsl_matrix_complex_fscanf", "libgsl.scm",
+ "gsl_matrix_complex_fwrite", "libgsl.scm",
+ "gsl_matrix_complex_get", "libgsl.scm",
+ "gsl_matrix_complex_get_col", "libgsl.scm",
+ "gsl_matrix_complex_get_row", "libgsl.scm",
+ "gsl_matrix_complex_isneg", "libgsl.scm",
+ "gsl_matrix_complex_isnonneg", "libgsl.scm",
+ "gsl_matrix_complex_isnull", "libgsl.scm",
+ "gsl_matrix_complex_ispos", "libgsl.scm",
+ "gsl_matrix_complex_memcpy", "libgsl.scm",
+ "gsl_matrix_complex_mul_elements", "libgsl.scm",
+ "gsl_matrix_complex_ptr", "libgsl.scm",
+ "gsl_matrix_complex_scale", "libgsl.scm",
+ "gsl_matrix_complex_set", "libgsl.scm",
+ "gsl_matrix_complex_set_all", "libgsl.scm",
+ "gsl_matrix_complex_set_col", "libgsl.scm",
+ "gsl_matrix_complex_set_identity", "libgsl.scm",
+ "gsl_matrix_complex_set_row", "libgsl.scm",
+ "gsl_matrix_complex_set_zero", "libgsl.scm",
+ "gsl_matrix_complex_sub", "libgsl.scm",
+ "gsl_matrix_complex_swap", "libgsl.scm",
+ "gsl_matrix_complex_swap_columns", "libgsl.scm",
+ "gsl_matrix_complex_swap_rowcol", "libgsl.scm",
+ "gsl_matrix_complex_swap_rows", "libgsl.scm",
+ "gsl_matrix_complex_transpose", "libgsl.scm",
+ "gsl_matrix_complex_transpose_memcpy", "libgsl.scm",
+ "gsl_matrix_const_ptr", "libgsl.scm",
+ "gsl_matrix_div_elements", "libgsl.scm",
+ "gsl_matrix_equal", "libgsl.scm",
+ "gsl_matrix_fprintf", "libgsl.scm",
+ "gsl_matrix_fread", "libgsl.scm",
+ "gsl_matrix_free", "libgsl.scm",
+ "gsl_matrix_fscanf", "libgsl.scm",
+ "gsl_matrix_fwrite", "libgsl.scm",
+ "gsl_matrix_get", "libgsl.scm",
+ "gsl_matrix_get_col", "libgsl.scm",
+ "gsl_matrix_get_row", "libgsl.scm",
+ "gsl_matrix_isneg", "libgsl.scm",
+ "gsl_matrix_isnonneg", "libgsl.scm",
+ "gsl_matrix_isnull", "libgsl.scm",
+ "gsl_matrix_ispos", "libgsl.scm",
+ "gsl_matrix_max", "libgsl.scm",
+ "gsl_matrix_max_index", "libgsl.scm",
+ "gsl_matrix_memcpy", "libgsl.scm",
+ "gsl_matrix_min", "libgsl.scm",
+ "gsl_matrix_min_index", "libgsl.scm",
+ "gsl_matrix_minmax", "libgsl.scm",
+ "gsl_matrix_minmax_index", "libgsl.scm",
+ "gsl_matrix_mul_elements", "libgsl.scm",
+ "gsl_matrix_ptr", "libgsl.scm",
+ "gsl_matrix_scale", "libgsl.scm",
+ "gsl_matrix_set", "libgsl.scm",
+ "gsl_matrix_set_all", "libgsl.scm",
+ "gsl_matrix_set_col", "libgsl.scm",
+ "gsl_matrix_set_identity", "libgsl.scm",
+ "gsl_matrix_set_row", "libgsl.scm",
+ "gsl_matrix_set_zero", "libgsl.scm",
+ "gsl_matrix_size", "libgsl.scm",
+ "gsl_matrix_sub", "libgsl.scm",
+ "gsl_matrix_swap", "libgsl.scm",
+ "gsl_matrix_swap_columns", "libgsl.scm",
+ "gsl_matrix_swap_rowcol", "libgsl.scm",
+ "gsl_matrix_swap_rows", "libgsl.scm",
+ "gsl_matrix_transpose", "libgsl.scm",
+ "gsl_matrix_transpose_memcpy", "libgsl.scm",
+ "gsl_max", "libgsl.scm",
+ "gsl_message", "libgsl.scm",
+ "gsl_message_mask", "libgsl.scm",
+ "gsl_min", "libgsl.scm",
+ "gsl_min_find_bracket", "libgsl.scm",
+ "gsl_min_fminimizer_alloc", "libgsl.scm",
+ "gsl_min_fminimizer_brent", "libgsl.scm",
+ "gsl_min_fminimizer_f_lower", "libgsl.scm",
+ "gsl_min_fminimizer_f_minimum", "libgsl.scm",
+ "gsl_min_fminimizer_f_upper", "libgsl.scm",
+ "gsl_min_fminimizer_free", "libgsl.scm",
+ "gsl_min_fminimizer_goldensection", "libgsl.scm",
+ "gsl_min_fminimizer_iterate", "libgsl.scm",
+ "gsl_min_fminimizer_minimum", "libgsl.scm",
+ "gsl_min_fminimizer_name", "libgsl.scm",
+ "gsl_min_fminimizer_quad_golden", "libgsl.scm",
+ "gsl_min_fminimizer_set", "libgsl.scm",
+ "gsl_min_fminimizer_set_with_values", "libgsl.scm",
+ "gsl_min_fminimizer_x_lower", "libgsl.scm",
+ "gsl_min_fminimizer_x_minimum", "libgsl.scm",
+ "gsl_min_fminimizer_x_upper", "libgsl.scm",
+ "gsl_min_test_interval", "libgsl.scm",
+ "gsl_multifit_covar", "libgsl.scm",
+ "gsl_multifit_covar_QRPT", "libgsl.scm",
+ "gsl_multifit_fsolver_alloc", "libgsl.scm",
+ "gsl_multifit_fsolver_driver", "libgsl.scm",
+ "gsl_multifit_fsolver_free", "libgsl.scm",
+ "gsl_multifit_fsolver_iterate", "libgsl.scm",
+ "gsl_multifit_fsolver_name", "libgsl.scm",
+ "gsl_multifit_fsolver_position", "libgsl.scm",
+ "gsl_multifit_fsolver_set", "libgsl.scm",
+ "gsl_multifit_gradient", "libgsl.scm",
+ "gsl_multifit_linear", "libgsl.scm",
+ "gsl_multifit_linear_Lk", "libgsl.scm",
+ "gsl_multifit_linear_Lsobolev", "libgsl.scm",
+ "gsl_multifit_linear_alloc", "libgsl.scm",
+ "gsl_multifit_linear_applyW", "libgsl.scm",
+ "gsl_multifit_linear_bsvd", "libgsl.scm",
+ "gsl_multifit_linear_est", "libgsl.scm",
+ "gsl_multifit_linear_free", "libgsl.scm",
+ "gsl_multifit_linear_genform1", "libgsl.scm",
+ "gsl_multifit_linear_genform2", "libgsl.scm",
+ "gsl_multifit_linear_lcorner", "libgsl.scm",
+ "gsl_multifit_linear_lcorner2", "libgsl.scm",
+ "gsl_multifit_linear_lcurve", "libgsl.scm",
+ "gsl_multifit_linear_lreg", "libgsl.scm",
+ "gsl_multifit_linear_residuals", "libgsl.scm",
+ "gsl_multifit_linear_solve", "libgsl.scm",
+ "gsl_multifit_linear_stdform1", "libgsl.scm",
+ "gsl_multifit_linear_stdform2", "libgsl.scm",
+ "gsl_multifit_linear_svd", "libgsl.scm",
+ "gsl_multifit_linear_wgenform2", "libgsl.scm",
+ "gsl_multifit_linear_wstdform1", "libgsl.scm",
+ "gsl_multifit_linear_wstdform2", "libgsl.scm",
+ "gsl_multifit_robust", "libgsl.scm",
+ "gsl_multifit_robust_alloc", "libgsl.scm",
+ "gsl_multifit_robust_bisquare", "libgsl.scm",
+ "gsl_multifit_robust_cauchy", "libgsl.scm",
+ "gsl_multifit_robust_default", "libgsl.scm",
+ "gsl_multifit_robust_est", "libgsl.scm",
+ "gsl_multifit_robust_fair", "libgsl.scm",
+ "gsl_multifit_robust_free", "libgsl.scm",
+ "gsl_multifit_robust_huber", "libgsl.scm",
+ "gsl_multifit_robust_maxiter", "libgsl.scm",
+ "gsl_multifit_robust_name", "libgsl.scm",
+ "gsl_multifit_robust_ols", "libgsl.scm",
+ "gsl_multifit_robust_residuals", "libgsl.scm",
+ "gsl_multifit_robust_statistics", "libgsl.scm",
+ "gsl_multifit_robust_tune", "libgsl.scm",
+ "gsl_multifit_robust_weights", "libgsl.scm",
+ "gsl_multifit_robust_welsch", "libgsl.scm",
+ "gsl_multifit_test_delta", "libgsl.scm",
+ "gsl_multifit_test_gradient", "libgsl.scm",
+ "gsl_multifit_wlinear", "libgsl.scm",
+ "gsl_multifit_wlinear_svd", "libgsl.scm",
+ "gsl_multifit_wlinear_usvd", "libgsl.scm",
+ "gsl_multimin_diff", "libgsl.scm",
+ "gsl_multimin_fminimizer_alloc", "libgsl.scm",
+ "gsl_multimin_fminimizer_free", "libgsl.scm",
+ "gsl_multimin_fminimizer_fval", "libgsl.scm",
+ "gsl_multimin_fminimizer_iterate", "libgsl.scm",
+ "gsl_multimin_fminimizer_minimum", "libgsl.scm",
+ "gsl_multimin_fminimizer_name", "libgsl.scm",
+ "gsl_multimin_fminimizer_nmsimplex", "libgsl.scm",
+ "gsl_multimin_fminimizer_nmsimplex2", "libgsl.scm",
+ "gsl_multimin_fminimizer_nmsimplex2rand", "libgsl.scm",
+ "gsl_multimin_fminimizer_set", "libgsl.scm",
+ "gsl_multimin_fminimizer_size", "libgsl.scm",
+ "gsl_multimin_fminimizer_x", "libgsl.scm",
+ "gsl_multimin_test_gradient", "libgsl.scm",
+ "gsl_multimin_test_size", "libgsl.scm",
+ "gsl_multiroot_fdjacobian", "libgsl.scm",
+ "gsl_multiroot_fsolver_alloc", "libgsl.scm",
+ "gsl_multiroot_fsolver_broyden", "libgsl.scm",
+ "gsl_multiroot_fsolver_dnewton", "libgsl.scm",
+ "gsl_multiroot_fsolver_dx", "libgsl.scm",
+ "gsl_multiroot_fsolver_f", "libgsl.scm",
+ "gsl_multiroot_fsolver_free", "libgsl.scm",
+ "gsl_multiroot_fsolver_hybrid", "libgsl.scm",
+ "gsl_multiroot_fsolver_hybrids", "libgsl.scm",
+ "gsl_multiroot_fsolver_iterate", "libgsl.scm",
+ "gsl_multiroot_fsolver_name", "libgsl.scm",
+ "gsl_multiroot_fsolver_root", "libgsl.scm",
+ "gsl_multiroot_fsolver_set", "libgsl.scm",
+ "gsl_multiroot_test_delta", "libgsl.scm",
+ "gsl_multiroot_test_residual", "libgsl.scm",
+ "gsl_multiset_alloc", "libgsl.scm",
+ "gsl_multiset_calloc", "libgsl.scm",
+ "gsl_multiset_data", "libgsl.scm",
+ "gsl_multiset_fprintf", "libgsl.scm",
+ "gsl_multiset_fread", "libgsl.scm",
+ "gsl_multiset_free", "libgsl.scm",
+ "gsl_multiset_fscanf", "libgsl.scm",
+ "gsl_multiset_fwrite", "libgsl.scm",
+ "gsl_multiset_get", "libgsl.scm",
+ "gsl_multiset_init_first", "libgsl.scm",
+ "gsl_multiset_init_last", "libgsl.scm",
+ "gsl_multiset_k", "libgsl.scm",
+ "gsl_multiset_memcpy", "libgsl.scm",
+ "gsl_multiset_n", "libgsl.scm",
+ "gsl_multiset_next", "libgsl.scm",
+ "gsl_multiset_prev", "libgsl.scm",
+ "gsl_multiset_valid", "libgsl.scm",
+ "gsl_nan", "libgsl.scm",
+ "gsl_neginf", "libgsl.scm",
+ "gsl_permutation_alloc", "libgsl.scm",
+ "gsl_permutation_calloc", "libgsl.scm",
+ "gsl_permutation_canonical_cycles", "libgsl.scm",
+ "gsl_permutation_canonical_to_linear", "libgsl.scm",
+ "gsl_permutation_data", "libgsl.scm",
+ "gsl_permutation_fprintf", "libgsl.scm",
+ "gsl_permutation_fread", "libgsl.scm",
+ "gsl_permutation_free", "libgsl.scm",
+ "gsl_permutation_fscanf", "libgsl.scm",
+ "gsl_permutation_fwrite", "libgsl.scm",
+ "gsl_permutation_get", "libgsl.scm",
+ "gsl_permutation_init", "libgsl.scm",
+ "gsl_permutation_inverse", "libgsl.scm",
+ "gsl_permutation_inversions", "libgsl.scm",
+ "gsl_permutation_linear_cycles", "libgsl.scm",
+ "gsl_permutation_linear_to_canonical", "libgsl.scm",
+ "gsl_permutation_memcpy", "libgsl.scm",
+ "gsl_permutation_mul", "libgsl.scm",
+ "gsl_permutation_next", "libgsl.scm",
+ "gsl_permutation_prev", "libgsl.scm",
+ "gsl_permutation_reverse", "libgsl.scm",
+ "gsl_permutation_size", "libgsl.scm",
+ "gsl_permutation_swap", "libgsl.scm",
+ "gsl_permutation_valid", "libgsl.scm",
+ "gsl_permute", "libgsl.scm",
+ "gsl_permute_complex", "libgsl.scm",
+ "gsl_permute_complex_inverse", "libgsl.scm",
+ "gsl_permute_inverse", "libgsl.scm",
+ "gsl_permute_vector", "libgsl.scm",
+ "gsl_permute_vector_complex", "libgsl.scm",
+ "gsl_permute_vector_complex_inverse", "libgsl.scm",
+ "gsl_permute_vector_inverse", "libgsl.scm",
+ "gsl_poly_complex_eval", "libgsl.scm",
+ "gsl_poly_complex_solve", "libgsl.scm",
+ "gsl_poly_complex_solve_cubic", "libgsl.scm",
+ "gsl_poly_complex_solve_quadratic", "libgsl.scm",
+ "gsl_poly_complex_workspace_alloc", "libgsl.scm",
+ "gsl_poly_complex_workspace_free", "libgsl.scm",
+ "gsl_poly_dd_eval", "libgsl.scm",
+ "gsl_poly_dd_hermite_init", "libgsl.scm",
+ "gsl_poly_dd_init", "libgsl.scm",
+ "gsl_poly_dd_taylor", "libgsl.scm",
+ "gsl_poly_eval", "libgsl.scm",
+ "gsl_poly_eval_derivs", "libgsl.scm",
+ "gsl_poly_solve_cubic", "libgsl.scm",
+ "gsl_poly_solve_quadratic", "libgsl.scm",
+ "gsl_posinf", "libgsl.scm",
+ "gsl_pow_2", "libgsl.scm",
+ "gsl_pow_3", "libgsl.scm",
+ "gsl_pow_4", "libgsl.scm",
+ "gsl_pow_5", "libgsl.scm",
+ "gsl_pow_6", "libgsl.scm",
+ "gsl_pow_7", "libgsl.scm",
+ "gsl_pow_8", "libgsl.scm",
+ "gsl_pow_9", "libgsl.scm",
+ "gsl_pow_int", "libgsl.scm",
+ "gsl_prec_eps", "libgsl.scm",
+ "gsl_prec_root3_eps", "libgsl.scm",
+ "gsl_prec_root4_eps", "libgsl.scm",
+ "gsl_prec_root5_eps", "libgsl.scm",
+ "gsl_prec_root6_eps", "libgsl.scm",
+ "gsl_prec_sqrt_eps", "libgsl.scm",
+ "gsl_qrng_alloc", "libgsl.scm",
+ "gsl_qrng_clone", "libgsl.scm",
+ "gsl_qrng_free", "libgsl.scm",
+ "gsl_qrng_get", "libgsl.scm",
+ "gsl_qrng_halton", "libgsl.scm",
+ "gsl_qrng_init", "libgsl.scm",
+ "gsl_qrng_memcpy", "libgsl.scm",
+ "gsl_qrng_name", "libgsl.scm",
+ "gsl_qrng_niederreiter_2", "libgsl.scm",
+ "gsl_qrng_reversehalton", "libgsl.scm",
+ "gsl_qrng_size", "libgsl.scm",
+ "gsl_qrng_sobol", "libgsl.scm",
+ "gsl_qrng_state", "libgsl.scm",
+ "gsl_ran_bernoulli", "libgsl.scm",
+ "gsl_ran_bernoulli_pdf", "libgsl.scm",
+ "gsl_ran_beta", "libgsl.scm",
+ "gsl_ran_beta_pdf", "libgsl.scm",
+ "gsl_ran_binomial", "libgsl.scm",
+ "gsl_ran_binomial_knuth", "libgsl.scm",
+ "gsl_ran_binomial_pdf", "libgsl.scm",
+ "gsl_ran_binomial_tpe", "libgsl.scm",
+ "gsl_ran_bivariate_gaussian", "libgsl.scm",
+ "gsl_ran_bivariate_gaussian_pdf", "libgsl.scm",
+ "gsl_ran_cauchy", "libgsl.scm",
+ "gsl_ran_cauchy_pdf", "libgsl.scm",
+ "gsl_ran_chisq", "libgsl.scm",
+ "gsl_ran_chisq_pdf", "libgsl.scm",
+ "gsl_ran_choose", "libgsl.scm",
+ "gsl_ran_dir_2d", "libgsl.scm",
+ "gsl_ran_dir_2d_trig_method", "libgsl.scm",
+ "gsl_ran_dir_3d", "libgsl.scm",
+ "gsl_ran_dir_nd", "libgsl.scm",
+ "gsl_ran_dirichlet", "libgsl.scm",
+ "gsl_ran_dirichlet_lnpdf", "libgsl.scm",
+ "gsl_ran_dirichlet_pdf", "libgsl.scm",
+ "gsl_ran_discrete", "libgsl.scm",
+ "gsl_ran_discrete_free", "libgsl.scm",
+ "gsl_ran_discrete_pdf", "libgsl.scm",
+ "gsl_ran_discrete_preproc", "libgsl.scm",
+ "gsl_ran_erlang", "libgsl.scm",
+ "gsl_ran_erlang_pdf", "libgsl.scm",
+ "gsl_ran_exponential", "libgsl.scm",
+ "gsl_ran_exponential_pdf", "libgsl.scm",
+ "gsl_ran_exppow", "libgsl.scm",
+ "gsl_ran_exppow_pdf", "libgsl.scm",
+ "gsl_ran_fdist", "libgsl.scm",
+ "gsl_ran_fdist_pdf", "libgsl.scm",
+ "gsl_ran_flat", "libgsl.scm",
+ "gsl_ran_flat_pdf", "libgsl.scm",
+ "gsl_ran_gamma", "libgsl.scm",
+ "gsl_ran_gamma_int", "libgsl.scm",
+ "gsl_ran_gamma_knuth", "libgsl.scm",
+ "gsl_ran_gamma_mt", "libgsl.scm",
+ "gsl_ran_gamma_pdf", "libgsl.scm",
+ "gsl_ran_gaussian", "libgsl.scm",
+ "gsl_ran_gaussian_pdf", "libgsl.scm",
+ "gsl_ran_gaussian_ratio_method", "libgsl.scm",
+ "gsl_ran_gaussian_tail", "libgsl.scm",
+ "gsl_ran_gaussian_tail_pdf", "libgsl.scm",
+ "gsl_ran_gaussian_ziggurat", "libgsl.scm",
+ "gsl_ran_geometric", "libgsl.scm",
+ "gsl_ran_geometric_pdf", "libgsl.scm",
+ "gsl_ran_gumbel1", "libgsl.scm",
+ "gsl_ran_gumbel1_pdf", "libgsl.scm",
+ "gsl_ran_gumbel2", "libgsl.scm",
+ "gsl_ran_gumbel2_pdf", "libgsl.scm",
+ "gsl_ran_hypergeometric", "libgsl.scm",
+ "gsl_ran_hypergeometric_pdf", "libgsl.scm",
+ "gsl_ran_landau", "libgsl.scm",
+ "gsl_ran_landau_pdf", "libgsl.scm",
+ "gsl_ran_laplace", "libgsl.scm",
+ "gsl_ran_laplace_pdf", "libgsl.scm",
+ "gsl_ran_levy", "libgsl.scm",
+ "gsl_ran_levy_skew", "libgsl.scm",
+ "gsl_ran_logarithmic", "libgsl.scm",
+ "gsl_ran_logarithmic_pdf", "libgsl.scm",
+ "gsl_ran_logistic", "libgsl.scm",
+ "gsl_ran_logistic_pdf", "libgsl.scm",
+ "gsl_ran_lognormal", "libgsl.scm",
+ "gsl_ran_lognormal_pdf", "libgsl.scm",
+ "gsl_ran_negative_binomial", "libgsl.scm",
+ "gsl_ran_negative_binomial_pdf", "libgsl.scm",
+ "gsl_ran_pareto", "libgsl.scm",
+ "gsl_ran_pareto_pdf", "libgsl.scm",
+ "gsl_ran_pascal", "libgsl.scm",
+ "gsl_ran_pascal_pdf", "libgsl.scm",
+ "gsl_ran_poisson", "libgsl.scm",
+ "gsl_ran_poisson_pdf", "libgsl.scm",
+ "gsl_ran_rayleigh", "libgsl.scm",
+ "gsl_ran_rayleigh_pdf", "libgsl.scm",
+ "gsl_ran_rayleigh_tail", "libgsl.scm",
+ "gsl_ran_rayleigh_tail_pdf", "libgsl.scm",
+ "gsl_ran_sample", "libgsl.scm",
+ "gsl_ran_shuffle", "libgsl.scm",
+ "gsl_ran_tdist", "libgsl.scm",
+ "gsl_ran_tdist_pdf", "libgsl.scm",
+ "gsl_ran_ugaussian", "libgsl.scm",
+ "gsl_ran_ugaussian_pdf", "libgsl.scm",
+ "gsl_ran_ugaussian_ratio_method", "libgsl.scm",
+ "gsl_ran_ugaussian_tail", "libgsl.scm",
+ "gsl_ran_ugaussian_tail_pdf", "libgsl.scm",
+ "gsl_ran_weibull", "libgsl.scm",
+ "gsl_ran_weibull_pdf", "libgsl.scm",
+ "gsl_rng_alloc", "libgsl.scm",
+ "gsl_rng_borosh13", "libgsl.scm",
+ "gsl_rng_clone", "libgsl.scm",
+ "gsl_rng_cmrg", "libgsl.scm",
+ "gsl_rng_coveyou", "libgsl.scm",
+ "gsl_rng_default", "libgsl.scm",
+ "gsl_rng_default_seed", "libgsl.scm",
+ "gsl_rng_env_setup", "libgsl.scm",
+ "gsl_rng_fishman18", "libgsl.scm",
+ "gsl_rng_fishman20", "libgsl.scm",
+ "gsl_rng_fishman2x", "libgsl.scm",
+ "gsl_rng_fread", "libgsl.scm",
+ "gsl_rng_free", "libgsl.scm",
+ "gsl_rng_fwrite", "libgsl.scm",
+ "gsl_rng_get", "libgsl.scm",
+ "gsl_rng_gfsr4", "libgsl.scm",
+ "gsl_rng_knuthran", "libgsl.scm",
+ "gsl_rng_knuthran2", "libgsl.scm",
+ "gsl_rng_knuthran2002", "libgsl.scm",
+ "gsl_rng_lecuyer21", "libgsl.scm",
+ "gsl_rng_max", "libgsl.scm",
+ "gsl_rng_memcpy", "libgsl.scm",
+ "gsl_rng_min", "libgsl.scm",
+ "gsl_rng_minstd", "libgsl.scm",
+ "gsl_rng_mrg", "libgsl.scm",
+ "gsl_rng_mt19937", "libgsl.scm",
+ "gsl_rng_mt19937_1998", "libgsl.scm",
+ "gsl_rng_mt19937_1999", "libgsl.scm",
+ "gsl_rng_name", "libgsl.scm",
+ "gsl_rng_print_state", "libgsl.scm",
+ "gsl_rng_r250", "libgsl.scm",
+ "gsl_rng_ran0", "libgsl.scm",
+ "gsl_rng_ran1", "libgsl.scm",
+ "gsl_rng_ran2", "libgsl.scm",
+ "gsl_rng_ran3", "libgsl.scm",
+ "gsl_rng_rand", "libgsl.scm",
+ "gsl_rng_rand48", "libgsl.scm",
+ "gsl_rng_random128_bsd", "libgsl.scm",
+ "gsl_rng_random128_glibc2", "libgsl.scm",
+ "gsl_rng_random128_libc5", "libgsl.scm",
+ "gsl_rng_random256_bsd", "libgsl.scm",
+ "gsl_rng_random256_glibc2", "libgsl.scm",
+ "gsl_rng_random256_libc5", "libgsl.scm",
+ "gsl_rng_random32_bsd", "libgsl.scm",
+ "gsl_rng_random32_glibc2", "libgsl.scm",
+ "gsl_rng_random32_libc5", "libgsl.scm",
+ "gsl_rng_random64_bsd", "libgsl.scm",
+ "gsl_rng_random64_glibc2", "libgsl.scm",
+ "gsl_rng_random64_libc5", "libgsl.scm",
+ "gsl_rng_random8_bsd", "libgsl.scm",
+ "gsl_rng_random8_glibc2", "libgsl.scm",
+ "gsl_rng_random8_libc5", "libgsl.scm",
+ "gsl_rng_random_bsd", "libgsl.scm",
+ "gsl_rng_random_glibc2", "libgsl.scm",
+ "gsl_rng_random_libc5", "libgsl.scm",
+ "gsl_rng_randu", "libgsl.scm",
+ "gsl_rng_ranf", "libgsl.scm",
+ "gsl_rng_ranlux", "libgsl.scm",
+ "gsl_rng_ranlux389", "libgsl.scm",
+ "gsl_rng_ranlxd1", "libgsl.scm",
+ "gsl_rng_ranlxd2", "libgsl.scm",
+ "gsl_rng_ranlxs0", "libgsl.scm",
+ "gsl_rng_ranlxs1", "libgsl.scm",
+ "gsl_rng_ranlxs2", "libgsl.scm",
+ "gsl_rng_ranmar", "libgsl.scm",
+ "gsl_rng_set", "libgsl.scm",
+ "gsl_rng_size", "libgsl.scm",
+ "gsl_rng_slatec", "libgsl.scm",
+ "gsl_rng_state", "libgsl.scm",
+ "gsl_rng_taus", "libgsl.scm",
+ "gsl_rng_taus113", "libgsl.scm",
+ "gsl_rng_taus2", "libgsl.scm",
+ "gsl_rng_transputer", "libgsl.scm",
+ "gsl_rng_tt800", "libgsl.scm",
+ "gsl_rng_types_setup", "libgsl.scm",
+ "gsl_rng_uni", "libgsl.scm",
+ "gsl_rng_uni32", "libgsl.scm",
+ "gsl_rng_uniform", "libgsl.scm",
+ "gsl_rng_uniform_int", "libgsl.scm",
+ "gsl_rng_uniform_pos", "libgsl.scm",
+ "gsl_rng_vax", "libgsl.scm",
+ "gsl_rng_waterman14", "libgsl.scm",
+ "gsl_rng_zuf", "libgsl.scm",
+ "gsl_root_fsolver_alloc", "libgsl.scm",
+ "gsl_root_fsolver_bisection", "libgsl.scm",
+ "gsl_root_fsolver_brent", "libgsl.scm",
+ "gsl_root_fsolver_falsepos", "libgsl.scm",
+ "gsl_root_fsolver_free", "libgsl.scm",
+ "gsl_root_fsolver_iterate", "libgsl.scm",
+ "gsl_root_fsolver_name", "libgsl.scm",
+ "gsl_root_fsolver_root", "libgsl.scm",
+ "gsl_root_fsolver_set", "libgsl.scm",
+ "gsl_root_fsolver_x_lower", "libgsl.scm",
+ "gsl_root_fsolver_x_upper", "libgsl.scm",
+ "gsl_root_test_delta", "libgsl.scm",
+ "gsl_root_test_interval", "libgsl.scm",
+ "gsl_root_test_residual", "libgsl.scm",
+ "gsl_rstat_add", "libgsl.scm",
+ "gsl_rstat_alloc", "libgsl.scm",
+ "gsl_rstat_free", "libgsl.scm",
+ "gsl_rstat_kurtosis", "libgsl.scm",
+ "gsl_rstat_max", "libgsl.scm",
+ "gsl_rstat_mean", "libgsl.scm",
+ "gsl_rstat_median", "libgsl.scm",
+ "gsl_rstat_min", "libgsl.scm",
+ "gsl_rstat_n", "libgsl.scm",
+ "gsl_rstat_quantile_add", "libgsl.scm",
+ "gsl_rstat_quantile_alloc", "libgsl.scm",
+ "gsl_rstat_quantile_free", "libgsl.scm",
+ "gsl_rstat_quantile_get", "libgsl.scm",
+ "gsl_rstat_reset", "libgsl.scm",
+ "gsl_rstat_sd", "libgsl.scm",
+ "gsl_rstat_sd_mean", "libgsl.scm",
+ "gsl_rstat_skew", "libgsl.scm",
+ "gsl_rstat_variance", "libgsl.scm",
+ "gsl_schur_gen_eigvals", "libgsl.scm",
+ "gsl_schur_solve_equation", "libgsl.scm",
+ "gsl_schur_solve_equation_z", "libgsl.scm",
+ "gsl_set_error_handler", "libgsl.scm",
+ "gsl_set_error_handler_off", "libgsl.scm",
+ "gsl_set_stream", "libgsl.scm",
+ "gsl_set_stream_handler", "libgsl.scm",
+ "gsl_sf_Chi", "libgsl.scm",
+ "gsl_sf_Chi_e", "libgsl.scm",
+ "gsl_sf_Ci", "libgsl.scm",
+ "gsl_sf_Ci_e", "libgsl.scm",
+ "gsl_sf_Shi", "libgsl.scm",
+ "gsl_sf_Shi_e", "libgsl.scm",
+ "gsl_sf_Si", "libgsl.scm",
+ "gsl_sf_Si_e", "libgsl.scm",
+ "gsl_sf_airy_Ai", "libgsl.scm",
+ "gsl_sf_airy_Ai_deriv", "libgsl.scm",
+ "gsl_sf_airy_Ai_deriv_e", "libgsl.scm",
+ "gsl_sf_airy_Ai_deriv_scaled", "libgsl.scm",
+ "gsl_sf_airy_Ai_deriv_scaled_e", "libgsl.scm",
+ "gsl_sf_airy_Ai_e", "libgsl.scm",
+ "gsl_sf_airy_Ai_scaled", "libgsl.scm",
+ "gsl_sf_airy_Ai_scaled_e", "libgsl.scm",
+ "gsl_sf_airy_Bi", "libgsl.scm",
+ "gsl_sf_airy_Bi_deriv", "libgsl.scm",
+ "gsl_sf_airy_Bi_deriv_e", "libgsl.scm",
+ "gsl_sf_airy_Bi_deriv_scaled", "libgsl.scm",
+ "gsl_sf_airy_Bi_deriv_scaled_e", "libgsl.scm",
+ "gsl_sf_airy_Bi_e", "libgsl.scm",
+ "gsl_sf_airy_Bi_scaled", "libgsl.scm",
+ "gsl_sf_airy_Bi_scaled_e", "libgsl.scm",
+ "gsl_sf_airy_zero_Ai", "libgsl.scm",
+ "gsl_sf_airy_zero_Ai_deriv", "libgsl.scm",
+ "gsl_sf_airy_zero_Ai_deriv_e", "libgsl.scm",
+ "gsl_sf_airy_zero_Ai_e", "libgsl.scm",
+ "gsl_sf_airy_zero_Bi", "libgsl.scm",
+ "gsl_sf_airy_zero_Bi_deriv", "libgsl.scm",
+ "gsl_sf_airy_zero_Bi_deriv_e", "libgsl.scm",
+ "gsl_sf_airy_zero_Bi_e", "libgsl.scm",
+ "gsl_sf_angle_restrict_pos", "libgsl.scm",
+ "gsl_sf_angle_restrict_pos_e", "libgsl.scm",
+ "gsl_sf_angle_restrict_pos_err_e", "libgsl.scm",
+ "gsl_sf_angle_restrict_symm", "libgsl.scm",
+ "gsl_sf_angle_restrict_symm_e", "libgsl.scm",
+ "gsl_sf_angle_restrict_symm_err_e", "libgsl.scm",
+ "gsl_sf_atanint", "libgsl.scm",
+ "gsl_sf_atanint_e", "libgsl.scm",
+ "gsl_sf_bessel_I0", "libgsl.scm",
+ "gsl_sf_bessel_I0_e", "libgsl.scm",
+ "gsl_sf_bessel_I0_scaled", "libgsl.scm",
+ "gsl_sf_bessel_I0_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_I1", "libgsl.scm",
+ "gsl_sf_bessel_I1_e", "libgsl.scm",
+ "gsl_sf_bessel_I1_scaled", "libgsl.scm",
+ "gsl_sf_bessel_I1_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_In", "libgsl.scm",
+ "gsl_sf_bessel_In_array", "libgsl.scm",
+ "gsl_sf_bessel_In_e", "libgsl.scm",
+ "gsl_sf_bessel_In_scaled", "libgsl.scm",
+ "gsl_sf_bessel_In_scaled_array", "libgsl.scm",
+ "gsl_sf_bessel_In_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_Inu", "libgsl.scm",
+ "gsl_sf_bessel_Inu_e", "libgsl.scm",
+ "gsl_sf_bessel_Inu_scaled", "libgsl.scm",
+ "gsl_sf_bessel_Inu_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_J0", "libgsl.scm",
+ "gsl_sf_bessel_J0_e", "libgsl.scm",
+ "gsl_sf_bessel_J1", "libgsl.scm",
+ "gsl_sf_bessel_J1_e", "libgsl.scm",
+ "gsl_sf_bessel_Jn", "libgsl.scm",
+ "gsl_sf_bessel_Jn_array", "libgsl.scm",
+ "gsl_sf_bessel_Jn_e", "libgsl.scm",
+ "gsl_sf_bessel_Jnu", "libgsl.scm",
+ "gsl_sf_bessel_Jnu_e", "libgsl.scm",
+ "gsl_sf_bessel_K0", "libgsl.scm",
+ "gsl_sf_bessel_K0_e", "libgsl.scm",
+ "gsl_sf_bessel_K0_scaled", "libgsl.scm",
+ "gsl_sf_bessel_K0_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_K1", "libgsl.scm",
+ "gsl_sf_bessel_K1_e", "libgsl.scm",
+ "gsl_sf_bessel_K1_scaled", "libgsl.scm",
+ "gsl_sf_bessel_K1_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_Kn", "libgsl.scm",
+ "gsl_sf_bessel_Kn_array", "libgsl.scm",
+ "gsl_sf_bessel_Kn_e", "libgsl.scm",
+ "gsl_sf_bessel_Kn_scaled", "libgsl.scm",
+ "gsl_sf_bessel_Kn_scaled_array", "libgsl.scm",
+ "gsl_sf_bessel_Kn_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_Knu", "libgsl.scm",
+ "gsl_sf_bessel_Knu_e", "libgsl.scm",
+ "gsl_sf_bessel_Knu_scaled", "libgsl.scm",
+ "gsl_sf_bessel_Knu_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_Knu_scaled_e10_e", "libgsl.scm",
+ "gsl_sf_bessel_Y0", "libgsl.scm",
+ "gsl_sf_bessel_Y0_e", "libgsl.scm",
+ "gsl_sf_bessel_Y1", "libgsl.scm",
+ "gsl_sf_bessel_Y1_e", "libgsl.scm",
+ "gsl_sf_bessel_Yn", "libgsl.scm",
+ "gsl_sf_bessel_Yn_array", "libgsl.scm",
+ "gsl_sf_bessel_Yn_e", "libgsl.scm",
+ "gsl_sf_bessel_Ynu", "libgsl.scm",
+ "gsl_sf_bessel_Ynu_e", "libgsl.scm",
+ "gsl_sf_bessel_i0_scaled", "libgsl.scm",
+ "gsl_sf_bessel_i0_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_i1_scaled", "libgsl.scm",
+ "gsl_sf_bessel_i1_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_i2_scaled", "libgsl.scm",
+ "gsl_sf_bessel_i2_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_il_scaled", "libgsl.scm",
+ "gsl_sf_bessel_il_scaled_array", "libgsl.scm",
+ "gsl_sf_bessel_il_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_j0", "libgsl.scm",
+ "gsl_sf_bessel_j0_e", "libgsl.scm",
+ "gsl_sf_bessel_j1", "libgsl.scm",
+ "gsl_sf_bessel_j1_e", "libgsl.scm",
+ "gsl_sf_bessel_j2", "libgsl.scm",
+ "gsl_sf_bessel_j2_e", "libgsl.scm",
+ "gsl_sf_bessel_jl", "libgsl.scm",
+ "gsl_sf_bessel_jl_array", "libgsl.scm",
+ "gsl_sf_bessel_jl_e", "libgsl.scm",
+ "gsl_sf_bessel_jl_steed_array", "libgsl.scm",
+ "gsl_sf_bessel_k0_scaled", "libgsl.scm",
+ "gsl_sf_bessel_k0_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_k1_scaled", "libgsl.scm",
+ "gsl_sf_bessel_k1_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_k2_scaled", "libgsl.scm",
+ "gsl_sf_bessel_k2_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_kl_scaled", "libgsl.scm",
+ "gsl_sf_bessel_kl_scaled_array", "libgsl.scm",
+ "gsl_sf_bessel_kl_scaled_e", "libgsl.scm",
+ "gsl_sf_bessel_lnKnu", "libgsl.scm",
+ "gsl_sf_bessel_lnKnu_e", "libgsl.scm",
+ "gsl_sf_bessel_sequence_Jnu_e", "libgsl.scm",
+ "gsl_sf_bessel_y0", "libgsl.scm",
+ "gsl_sf_bessel_y0_e", "libgsl.scm",
+ "gsl_sf_bessel_y1", "libgsl.scm",
+ "gsl_sf_bessel_y1_e", "libgsl.scm",
+ "gsl_sf_bessel_y2", "libgsl.scm",
+ "gsl_sf_bessel_y2_e", "libgsl.scm",
+ "gsl_sf_bessel_yl", "libgsl.scm",
+ "gsl_sf_bessel_yl_array", "libgsl.scm",
+ "gsl_sf_bessel_yl_e", "libgsl.scm",
+ "gsl_sf_bessel_zero_J0", "libgsl.scm",
+ "gsl_sf_bessel_zero_J0_e", "libgsl.scm",
+ "gsl_sf_bessel_zero_J1", "libgsl.scm",
+ "gsl_sf_bessel_zero_J1_e", "libgsl.scm",
+ "gsl_sf_bessel_zero_Jnu", "libgsl.scm",
+ "gsl_sf_bessel_zero_Jnu_e", "libgsl.scm",
+ "gsl_sf_beta", "libgsl.scm",
+ "gsl_sf_beta_e", "libgsl.scm",
+ "gsl_sf_beta_inc", "libgsl.scm",
+ "gsl_sf_beta_inc_e", "libgsl.scm",
+ "gsl_sf_choose", "libgsl.scm",
+ "gsl_sf_choose_e", "libgsl.scm",
+ "gsl_sf_clausen", "libgsl.scm",
+ "gsl_sf_clausen_e", "libgsl.scm",
+ "gsl_sf_complex_cos_e", "libgsl.scm",
+ "gsl_sf_complex_dilog_e", "libgsl.scm",
+ "gsl_sf_complex_dilog_xy_e", "libgsl.scm",
+ "gsl_sf_complex_log_e", "libgsl.scm",
+ "gsl_sf_complex_logsin_e", "libgsl.scm",
+ "gsl_sf_complex_psi_e", "libgsl.scm",
+ "gsl_sf_complex_sin_e", "libgsl.scm",
+ "gsl_sf_complex_spence_xy_e", "libgsl.scm",
+ "gsl_sf_conicalP_0", "libgsl.scm",
+ "gsl_sf_conicalP_0_e", "libgsl.scm",
+ "gsl_sf_conicalP_1", "libgsl.scm",
+ "gsl_sf_conicalP_1_e", "libgsl.scm",
+ "gsl_sf_conicalP_cyl_reg", "libgsl.scm",
+ "gsl_sf_conicalP_cyl_reg_e", "libgsl.scm",
+ "gsl_sf_conicalP_half", "libgsl.scm",
+ "gsl_sf_conicalP_half_e", "libgsl.scm",
+ "gsl_sf_conicalP_mhalf", "libgsl.scm",
+ "gsl_sf_conicalP_mhalf_e", "libgsl.scm",
+ "gsl_sf_conicalP_sph_reg", "libgsl.scm",
+ "gsl_sf_conicalP_sph_reg_e", "libgsl.scm",
+ "gsl_sf_cos", "libgsl.scm",
+ "gsl_sf_cos_e", "libgsl.scm",
+ "gsl_sf_cos_err_e", "libgsl.scm",
+ "gsl_sf_coulomb_CL_array", "libgsl.scm",
+ "gsl_sf_coulomb_CL_e", "libgsl.scm",
+ "gsl_sf_coulomb_wave_FG_array", "libgsl.scm",
+ "gsl_sf_coulomb_wave_FG_e", "libgsl.scm",
+ "gsl_sf_coulomb_wave_FGp_array", "libgsl.scm",
+ "gsl_sf_coulomb_wave_F_array", "libgsl.scm",
+ "gsl_sf_coulomb_wave_sphF_array", "libgsl.scm",
+ "gsl_sf_coupling_3j", "libgsl.scm",
+ "gsl_sf_coupling_3j_e", "libgsl.scm",
+ "gsl_sf_coupling_6j", "libgsl.scm",
+ "gsl_sf_coupling_6j_e", "libgsl.scm",
+ "gsl_sf_coupling_9j", "libgsl.scm",
+ "gsl_sf_coupling_9j_e", "libgsl.scm",
+ "gsl_sf_coupling_RacahW", "libgsl.scm",
+ "gsl_sf_coupling_RacahW_e", "libgsl.scm",
+ "gsl_sf_dawson", "libgsl.scm",
+ "gsl_sf_dawson_e", "libgsl.scm",
+ "gsl_sf_debye_1", "libgsl.scm",
+ "gsl_sf_debye_1_e", "libgsl.scm",
+ "gsl_sf_debye_2", "libgsl.scm",
+ "gsl_sf_debye_2_e", "libgsl.scm",
+ "gsl_sf_debye_3", "libgsl.scm",
+ "gsl_sf_debye_3_e", "libgsl.scm",
+ "gsl_sf_debye_4", "libgsl.scm",
+ "gsl_sf_debye_4_e", "libgsl.scm",
+ "gsl_sf_debye_5", "libgsl.scm",
+ "gsl_sf_debye_5_e", "libgsl.scm",
+ "gsl_sf_debye_6", "libgsl.scm",
+ "gsl_sf_debye_6_e", "libgsl.scm",
+ "gsl_sf_dilog", "libgsl.scm",
+ "gsl_sf_dilog_e", "libgsl.scm",
+ "gsl_sf_doublefact", "libgsl.scm",
+ "gsl_sf_doublefact_e", "libgsl.scm",
+ "gsl_sf_ellint_D", "libgsl.scm",
+ "gsl_sf_ellint_D_e", "libgsl.scm",
+ "gsl_sf_ellint_Dcomp", "libgsl.scm",
+ "gsl_sf_ellint_Dcomp_e", "libgsl.scm",
+ "gsl_sf_ellint_E", "libgsl.scm",
+ "gsl_sf_ellint_E_e", "libgsl.scm",
+ "gsl_sf_ellint_Ecomp", "libgsl.scm",
+ "gsl_sf_ellint_Ecomp_e", "libgsl.scm",
+ "gsl_sf_ellint_F", "libgsl.scm",
+ "gsl_sf_ellint_F_e", "libgsl.scm",
+ "gsl_sf_ellint_Kcomp", "libgsl.scm",
+ "gsl_sf_ellint_Kcomp_e", "libgsl.scm",
+ "gsl_sf_ellint_P", "libgsl.scm",
+ "gsl_sf_ellint_P_e", "libgsl.scm",
+ "gsl_sf_ellint_Pcomp", "libgsl.scm",
+ "gsl_sf_ellint_Pcomp_e", "libgsl.scm",
+ "gsl_sf_ellint_RC", "libgsl.scm",
+ "gsl_sf_ellint_RC_e", "libgsl.scm",
+ "gsl_sf_ellint_RD", "libgsl.scm",
+ "gsl_sf_ellint_RD_e", "libgsl.scm",
+ "gsl_sf_ellint_RF", "libgsl.scm",
+ "gsl_sf_ellint_RF_e", "libgsl.scm",
+ "gsl_sf_ellint_RJ", "libgsl.scm",
+ "gsl_sf_ellint_RJ_e", "libgsl.scm",
+ "gsl_sf_elljac_e", "libgsl.scm",
+ "gsl_sf_erf", "libgsl.scm",
+ "gsl_sf_erf_Q", "libgsl.scm",
+ "gsl_sf_erf_Q_e", "libgsl.scm",
+ "gsl_sf_erf_Z", "libgsl.scm",
+ "gsl_sf_erf_Z_e", "libgsl.scm",
+ "gsl_sf_erf_e", "libgsl.scm",
+ "gsl_sf_erfc", "libgsl.scm",
+ "gsl_sf_erfc_e", "libgsl.scm",
+ "gsl_sf_eta", "libgsl.scm",
+ "gsl_sf_eta_e", "libgsl.scm",
+ "gsl_sf_eta_int", "libgsl.scm",
+ "gsl_sf_eta_int_e", "libgsl.scm",
+ "gsl_sf_exp", "libgsl.scm",
+ "gsl_sf_exp_e", "libgsl.scm",
+ "gsl_sf_exp_e10_e", "libgsl.scm",
+ "gsl_sf_exp_err_e", "libgsl.scm",
+ "gsl_sf_exp_err_e10_e", "libgsl.scm",
+ "gsl_sf_exp_mult", "libgsl.scm",
+ "gsl_sf_exp_mult_e", "libgsl.scm",
+ "gsl_sf_exp_mult_e10_e", "libgsl.scm",
+ "gsl_sf_exp_mult_err_e", "libgsl.scm",
+ "gsl_sf_exp_mult_err_e10_e", "libgsl.scm",
+ "gsl_sf_expint_3", "libgsl.scm",
+ "gsl_sf_expint_3_e", "libgsl.scm",
+ "gsl_sf_expint_E1", "libgsl.scm",
+ "gsl_sf_expint_E1_e", "libgsl.scm",
+ "gsl_sf_expint_E1_scaled", "libgsl.scm",
+ "gsl_sf_expint_E1_scaled_e", "libgsl.scm",
+ "gsl_sf_expint_E2", "libgsl.scm",
+ "gsl_sf_expint_E2_e", "libgsl.scm",
+ "gsl_sf_expint_E2_scaled", "libgsl.scm",
+ "gsl_sf_expint_E2_scaled_e", "libgsl.scm",
+ "gsl_sf_expint_Ei", "libgsl.scm",
+ "gsl_sf_expint_Ei_e", "libgsl.scm",
+ "gsl_sf_expint_Ei_scaled", "libgsl.scm",
+ "gsl_sf_expint_Ei_scaled_e", "libgsl.scm",
+ "gsl_sf_expint_En", "libgsl.scm",
+ "gsl_sf_expint_En_e", "libgsl.scm",
+ "gsl_sf_expint_En_scaled", "libgsl.scm",
+ "gsl_sf_expint_En_scaled_e", "libgsl.scm",
+ "gsl_sf_expm1", "libgsl.scm",
+ "gsl_sf_expm1_e", "libgsl.scm",
+ "gsl_sf_exprel", "libgsl.scm",
+ "gsl_sf_exprel_2", "libgsl.scm",
+ "gsl_sf_exprel_2_e", "libgsl.scm",
+ "gsl_sf_exprel_e", "libgsl.scm",
+ "gsl_sf_exprel_n", "libgsl.scm",
+ "gsl_sf_exprel_n_CF_e", "libgsl.scm",
+ "gsl_sf_exprel_n_e", "libgsl.scm",
+ "gsl_sf_fact", "libgsl.scm",
+ "gsl_sf_fact_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_0", "libgsl.scm",
+ "gsl_sf_fermi_dirac_0_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_1", "libgsl.scm",
+ "gsl_sf_fermi_dirac_1_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_2", "libgsl.scm",
+ "gsl_sf_fermi_dirac_2_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_3half", "libgsl.scm",
+ "gsl_sf_fermi_dirac_3half_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_half", "libgsl.scm",
+ "gsl_sf_fermi_dirac_half_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_inc_0", "libgsl.scm",
+ "gsl_sf_fermi_dirac_inc_0_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_int", "libgsl.scm",
+ "gsl_sf_fermi_dirac_int_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_m1", "libgsl.scm",
+ "gsl_sf_fermi_dirac_m1_e", "libgsl.scm",
+ "gsl_sf_fermi_dirac_mhalf", "libgsl.scm",
+ "gsl_sf_fermi_dirac_mhalf_e", "libgsl.scm",
+ "gsl_sf_gamma", "libgsl.scm",
+ "gsl_sf_gamma_e", "libgsl.scm",
+ "gsl_sf_gamma_inc", "libgsl.scm",
+ "gsl_sf_gamma_inc_P", "libgsl.scm",
+ "gsl_sf_gamma_inc_P_e", "libgsl.scm",
+ "gsl_sf_gamma_inc_Q", "libgsl.scm",
+ "gsl_sf_gamma_inc_Q_e", "libgsl.scm",
+ "gsl_sf_gamma_inc_e", "libgsl.scm",
+ "gsl_sf_gammainv", "libgsl.scm",
+ "gsl_sf_gammainv_e", "libgsl.scm",
+ "gsl_sf_gammastar", "libgsl.scm",
+ "gsl_sf_gammastar_e", "libgsl.scm",
+ "gsl_sf_gegenpoly_1", "libgsl.scm",
+ "gsl_sf_gegenpoly_1_e", "libgsl.scm",
+ "gsl_sf_gegenpoly_2", "libgsl.scm",
+ "gsl_sf_gegenpoly_2_e", "libgsl.scm",
+ "gsl_sf_gegenpoly_3", "libgsl.scm",
+ "gsl_sf_gegenpoly_3_e", "libgsl.scm",
+ "gsl_sf_gegenpoly_array", "libgsl.scm",
+ "gsl_sf_gegenpoly_n", "libgsl.scm",
+ "gsl_sf_gegenpoly_n_e", "libgsl.scm",
+ "gsl_sf_hazard", "libgsl.scm",
+ "gsl_sf_hazard_e", "libgsl.scm",
+ "gsl_sf_hydrogenicR", "libgsl.scm",
+ "gsl_sf_hydrogenicR_1", "libgsl.scm",
+ "gsl_sf_hydrogenicR_1_e", "libgsl.scm",
+ "gsl_sf_hydrogenicR_e", "libgsl.scm",
+ "gsl_sf_hyperg_0F1", "libgsl.scm",
+ "gsl_sf_hyperg_0F1_e", "libgsl.scm",
+ "gsl_sf_hyperg_1F1", "libgsl.scm",
+ "gsl_sf_hyperg_1F1_e", "libgsl.scm",
+ "gsl_sf_hyperg_1F1_int", "libgsl.scm",
+ "gsl_sf_hyperg_1F1_int_e", "libgsl.scm",
+ "gsl_sf_hyperg_2F0", "libgsl.scm",
+ "gsl_sf_hyperg_2F0_e", "libgsl.scm",
+ "gsl_sf_hyperg_2F1", "libgsl.scm",
+ "gsl_sf_hyperg_2F1_conj", "libgsl.scm",
+ "gsl_sf_hyperg_2F1_conj_e", "libgsl.scm",
+ "gsl_sf_hyperg_2F1_conj_renorm", "libgsl.scm",
+ "gsl_sf_hyperg_2F1_conj_renorm_e", "libgsl.scm",
+ "gsl_sf_hyperg_2F1_e", "libgsl.scm",
+ "gsl_sf_hyperg_2F1_renorm", "libgsl.scm",
+ "gsl_sf_hyperg_2F1_renorm_e", "libgsl.scm",
+ "gsl_sf_hyperg_U", "libgsl.scm",
+ "gsl_sf_hyperg_U_e", "libgsl.scm",
+ "gsl_sf_hyperg_U_e10_e", "libgsl.scm",
+ "gsl_sf_hyperg_U_int", "libgsl.scm",
+ "gsl_sf_hyperg_U_int_e", "libgsl.scm",
+ "gsl_sf_hyperg_U_int_e10_e", "libgsl.scm",
+ "gsl_sf_hypot", "libgsl.scm",
+ "gsl_sf_hypot_e", "libgsl.scm",
+ "gsl_sf_hzeta", "libgsl.scm",
+ "gsl_sf_hzeta_e", "libgsl.scm",
+ "gsl_sf_laguerre_1", "libgsl.scm",
+ "gsl_sf_laguerre_1_e", "libgsl.scm",
+ "gsl_sf_laguerre_2", "libgsl.scm",
+ "gsl_sf_laguerre_2_e", "libgsl.scm",
+ "gsl_sf_laguerre_3", "libgsl.scm",
+ "gsl_sf_laguerre_3_e", "libgsl.scm",
+ "gsl_sf_laguerre_n", "libgsl.scm",
+ "gsl_sf_laguerre_n_e", "libgsl.scm",
+ "gsl_sf_lambert_W0", "libgsl.scm",
+ "gsl_sf_lambert_W0_e", "libgsl.scm",
+ "gsl_sf_lambert_Wm1", "libgsl.scm",
+ "gsl_sf_lambert_Wm1_e", "libgsl.scm",
+ "gsl_sf_legendre_H3d", "libgsl.scm",
+ "gsl_sf_legendre_H3d_0", "libgsl.scm",
+ "gsl_sf_legendre_H3d_0_e", "libgsl.scm",
+ "gsl_sf_legendre_H3d_1", "libgsl.scm",
+ "gsl_sf_legendre_H3d_1_e", "libgsl.scm",
+ "gsl_sf_legendre_H3d_array", "libgsl.scm",
+ "gsl_sf_legendre_H3d_e", "libgsl.scm",
+ "gsl_sf_legendre_P1", "libgsl.scm",
+ "gsl_sf_legendre_P1_e", "libgsl.scm",
+ "gsl_sf_legendre_P2", "libgsl.scm",
+ "gsl_sf_legendre_P2_e", "libgsl.scm",
+ "gsl_sf_legendre_P3", "libgsl.scm",
+ "gsl_sf_legendre_P3_e", "libgsl.scm",
+ "gsl_sf_legendre_Pl", "libgsl.scm",
+ "gsl_sf_legendre_Pl_array", "libgsl.scm",
+ "gsl_sf_legendre_Pl_deriv_array", "libgsl.scm",
+ "gsl_sf_legendre_Pl_e", "libgsl.scm",
+ "gsl_sf_legendre_Plm", "libgsl.scm",
+ "gsl_sf_legendre_Plm_e", "libgsl.scm",
+ "gsl_sf_legendre_Q0", "libgsl.scm",
+ "gsl_sf_legendre_Q0_e", "libgsl.scm",
+ "gsl_sf_legendre_Q1", "libgsl.scm",
+ "gsl_sf_legendre_Q1_e", "libgsl.scm",
+ "gsl_sf_legendre_Ql", "libgsl.scm",
+ "gsl_sf_legendre_Ql_e", "libgsl.scm",
+ "gsl_sf_legendre_array", "libgsl.scm",
+ "gsl_sf_legendre_array_e", "libgsl.scm",
+ "gsl_sf_legendre_array_index", "libgsl.scm",
+ "gsl_sf_legendre_array_n", "libgsl.scm",
+ "gsl_sf_legendre_deriv2_alt_array", "libgsl.scm",
+ "gsl_sf_legendre_deriv2_alt_array_e", "libgsl.scm",
+ "gsl_sf_legendre_deriv2_array", "libgsl.scm",
+ "gsl_sf_legendre_deriv2_array_e", "libgsl.scm",
+ "gsl_sf_legendre_deriv_alt_array", "libgsl.scm",
+ "gsl_sf_legendre_deriv_alt_array_e", "libgsl.scm",
+ "gsl_sf_legendre_deriv_array", "libgsl.scm",
+ "gsl_sf_legendre_deriv_array_e", "libgsl.scm",
+ "gsl_sf_legendre_nlm", "libgsl.scm",
+ "gsl_sf_legendre_sphPlm", "libgsl.scm",
+ "gsl_sf_legendre_sphPlm_e", "libgsl.scm",
+ "gsl_sf_lnbeta", "libgsl.scm",
+ "gsl_sf_lnbeta_e", "libgsl.scm",
+ "gsl_sf_lnbeta_sgn_e", "libgsl.scm",
+ "gsl_sf_lnchoose", "libgsl.scm",
+ "gsl_sf_lnchoose_e", "libgsl.scm",
+ "gsl_sf_lncosh", "libgsl.scm",
+ "gsl_sf_lncosh_e", "libgsl.scm",
+ "gsl_sf_lndoublefact", "libgsl.scm",
+ "gsl_sf_lndoublefact_e", "libgsl.scm",
+ "gsl_sf_lnfact", "libgsl.scm",
+ "gsl_sf_lnfact_e", "libgsl.scm",
+ "gsl_sf_lngamma", "libgsl.scm",
+ "gsl_sf_lngamma_complex_e", "libgsl.scm",
+ "gsl_sf_lngamma_e", "libgsl.scm",
+ "gsl_sf_lngamma_sgn_e", "libgsl.scm",
+ "gsl_sf_lnpoch", "libgsl.scm",
+ "gsl_sf_lnpoch_e", "libgsl.scm",
+ "gsl_sf_lnpoch_sgn_e", "libgsl.scm",
+ "gsl_sf_lnsinh", "libgsl.scm",
+ "gsl_sf_lnsinh_e", "libgsl.scm",
+ "gsl_sf_log", "libgsl.scm",
+ "gsl_sf_log_1plusx", "libgsl.scm",
+ "gsl_sf_log_1plusx_e", "libgsl.scm",
+ "gsl_sf_log_1plusx_mx", "libgsl.scm",
+ "gsl_sf_log_1plusx_mx_e", "libgsl.scm",
+ "gsl_sf_log_abs", "libgsl.scm",
+ "gsl_sf_log_abs_e", "libgsl.scm",
+ "gsl_sf_log_e", "libgsl.scm",
+ "gsl_sf_log_erfc", "libgsl.scm",
+ "gsl_sf_log_erfc_e", "libgsl.scm",
+ "gsl_sf_mathieu_Mc", "libgsl.scm",
+ "gsl_sf_mathieu_Mc_array", "libgsl.scm",
+ "gsl_sf_mathieu_Mc_e", "libgsl.scm",
+ "gsl_sf_mathieu_Ms", "libgsl.scm",
+ "gsl_sf_mathieu_Ms_array", "libgsl.scm",
+ "gsl_sf_mathieu_Ms_e", "libgsl.scm",
+ "gsl_sf_mathieu_a", "libgsl.scm",
+ "gsl_sf_mathieu_a_array", "libgsl.scm",
+ "gsl_sf_mathieu_a_coeff", "libgsl.scm",
+ "gsl_sf_mathieu_a_e", "libgsl.scm",
+ "gsl_sf_mathieu_alloc", "libgsl.scm",
+ "gsl_sf_mathieu_b", "libgsl.scm",
+ "gsl_sf_mathieu_b_array", "libgsl.scm",
+ "gsl_sf_mathieu_b_coeff", "libgsl.scm",
+ "gsl_sf_mathieu_b_e", "libgsl.scm",
+ "gsl_sf_mathieu_ce", "libgsl.scm",
+ "gsl_sf_mathieu_ce_array", "libgsl.scm",
+ "gsl_sf_mathieu_ce_e", "libgsl.scm",
+ "gsl_sf_mathieu_free", "libgsl.scm",
+ "gsl_sf_mathieu_se", "libgsl.scm",
+ "gsl_sf_mathieu_se_array", "libgsl.scm",
+ "gsl_sf_mathieu_se_e", "libgsl.scm",
+ "gsl_sf_multiply", "libgsl.scm",
+ "gsl_sf_multiply_e", "libgsl.scm",
+ "gsl_sf_multiply_err_e", "libgsl.scm",
+ "gsl_sf_poch", "libgsl.scm",
+ "gsl_sf_poch_e", "libgsl.scm",
+ "gsl_sf_pochrel", "libgsl.scm",
+ "gsl_sf_pochrel_e", "libgsl.scm",
+ "gsl_sf_polar_to_rect", "libgsl.scm",
+ "gsl_sf_pow_int", "libgsl.scm",
+ "gsl_sf_pow_int_e", "libgsl.scm",
+ "gsl_sf_psi", "libgsl.scm",
+ "gsl_sf_psi_1", "libgsl.scm",
+ "gsl_sf_psi_1_e", "libgsl.scm",
+ "gsl_sf_psi_1_int", "libgsl.scm",
+ "gsl_sf_psi_1_int_e", "libgsl.scm",
+ "gsl_sf_psi_1piy", "libgsl.scm",
+ "gsl_sf_psi_1piy_e", "libgsl.scm",
+ "gsl_sf_psi_e", "libgsl.scm",
+ "gsl_sf_psi_int", "libgsl.scm",
+ "gsl_sf_psi_int_e", "libgsl.scm",
+ "gsl_sf_psi_n", "libgsl.scm",
+ "gsl_sf_psi_n_e", "libgsl.scm",
+ "gsl_sf_rect_to_polar", "libgsl.scm",
+ "gsl_sf_result.err", "libgsl.scm",
+ "gsl_sf_result.make", "libgsl.scm",
+ "gsl_sf_result.val", "libgsl.scm",
+ "gsl_sf_result_e10.make", "libgsl.scm",
+ "gsl_sf_result_smash_e", "libgsl.scm",
+ "gsl_sf_sin", "libgsl.scm",
+ "gsl_sf_sin_e", "libgsl.scm",
+ "gsl_sf_sin_err_e", "libgsl.scm",
+ "gsl_sf_sinc", "libgsl.scm",
+ "gsl_sf_sinc_e", "libgsl.scm",
+ "gsl_sf_synchrotron_1", "libgsl.scm",
+ "gsl_sf_synchrotron_1_e", "libgsl.scm",
+ "gsl_sf_synchrotron_2", "libgsl.scm",
+ "gsl_sf_synchrotron_2_e", "libgsl.scm",
+ "gsl_sf_taylorcoeff", "libgsl.scm",
+ "gsl_sf_taylorcoeff_e", "libgsl.scm",
+ "gsl_sf_transport_2", "libgsl.scm",
+ "gsl_sf_transport_2_e", "libgsl.scm",
+ "gsl_sf_transport_3", "libgsl.scm",
+ "gsl_sf_transport_3_e", "libgsl.scm",
+ "gsl_sf_transport_4", "libgsl.scm",
+ "gsl_sf_transport_4_e", "libgsl.scm",
+ "gsl_sf_transport_5", "libgsl.scm",
+ "gsl_sf_transport_5_e", "libgsl.scm",
+ "gsl_sf_zeta", "libgsl.scm",
+ "gsl_sf_zeta_e", "libgsl.scm",
+ "gsl_sf_zeta_int", "libgsl.scm",
+ "gsl_sf_zeta_int_e", "libgsl.scm",
+ "gsl_sf_zetam1", "libgsl.scm",
+ "gsl_sf_zetam1_e", "libgsl.scm",
+ "gsl_sf_zetam1_int", "libgsl.scm",
+ "gsl_sf_zetam1_int_e", "libgsl.scm",
+ "gsl_sort", "libgsl.scm",
+ "gsl_sort2", "libgsl.scm",
+ "gsl_sort_index", "libgsl.scm",
+ "gsl_sort_largest", "libgsl.scm",
+ "gsl_sort_largest_index", "libgsl.scm",
+ "gsl_sort_smallest", "libgsl.scm",
+ "gsl_sort_smallest_index", "libgsl.scm",
+ "gsl_sort_vector", "libgsl.scm",
+ "gsl_sort_vector2", "libgsl.scm",
+ "gsl_sort_vector_index", "libgsl.scm",
+ "gsl_sort_vector_largest", "libgsl.scm",
+ "gsl_sort_vector_largest_index", "libgsl.scm",
+ "gsl_sort_vector_smallest", "libgsl.scm",
+ "gsl_sort_vector_smallest_index", "libgsl.scm",
+ "gsl_spblas_dgemm", "libgsl.scm",
+ "gsl_spblas_dgemv", "libgsl.scm",
+ "gsl_spblas_scatter", "libgsl.scm",
+ "gsl_splinalg_itersolve_alloc", "libgsl.scm",
+ "gsl_splinalg_itersolve_free", "libgsl.scm",
+ "gsl_splinalg_itersolve_gmres", "libgsl.scm",
+ "gsl_splinalg_itersolve_iterate", "libgsl.scm",
+ "gsl_splinalg_itersolve_name", "libgsl.scm",
+ "gsl_splinalg_itersolve_normr", "libgsl.scm",
+ "gsl_spline2d_alloc", "libgsl.scm",
+ "gsl_spline2d_eval", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_x", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_x_e", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_xx", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_xx_e", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_xy", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_xy_e", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_y", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_y_e", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_yy", "libgsl.scm",
+ "gsl_spline2d_eval_deriv_yy_e", "libgsl.scm",
+ "gsl_spline2d_eval_e", "libgsl.scm",
+ "gsl_spline2d_free", "libgsl.scm",
+ "gsl_spline2d_get", "libgsl.scm",
+ "gsl_spline2d_init", "libgsl.scm",
+ "gsl_spline2d_min_size", "libgsl.scm",
+ "gsl_spline2d_name", "libgsl.scm",
+ "gsl_spline2d_set", "libgsl.scm",
+ "gsl_spline_alloc", "libgsl.scm",
+ "gsl_spline_eval", "libgsl.scm",
+ "gsl_spline_eval_deriv", "libgsl.scm",
+ "gsl_spline_eval_deriv2", "libgsl.scm",
+ "gsl_spline_eval_deriv2_e", "libgsl.scm",
+ "gsl_spline_eval_deriv_e", "libgsl.scm",
+ "gsl_spline_eval_e", "libgsl.scm",
+ "gsl_spline_eval_integ", "libgsl.scm",
+ "gsl_spline_eval_integ_e", "libgsl.scm",
+ "gsl_spline_free", "libgsl.scm",
+ "gsl_spline_init", "libgsl.scm",
+ "gsl_spline_min_size", "libgsl.scm",
+ "gsl_spline_name", "libgsl.scm",
+ "gsl_spmatrix_add", "libgsl.scm",
+ "gsl_spmatrix_alloc", "libgsl.scm",
+ "gsl_spmatrix_alloc_nzmax", "libgsl.scm",
+ "gsl_spmatrix_compare_idx", "libgsl.scm",
+ "gsl_spmatrix_compcol", "libgsl.scm",
+ "gsl_spmatrix_cumsum", "libgsl.scm",
+ "gsl_spmatrix_d2sp", "libgsl.scm",
+ "gsl_spmatrix_equal", "libgsl.scm",
+ "gsl_spmatrix_free", "libgsl.scm",
+ "gsl_spmatrix_get", "libgsl.scm",
+ "gsl_spmatrix_memcpy", "libgsl.scm",
+ "gsl_spmatrix_minmax", "libgsl.scm",
+ "gsl_spmatrix_nnz", "libgsl.scm",
+ "gsl_spmatrix_realloc", "libgsl.scm",
+ "gsl_spmatrix_scale", "libgsl.scm",
+ "gsl_spmatrix_set", "libgsl.scm",
+ "gsl_spmatrix_set_zero", "libgsl.scm",
+ "gsl_spmatrix_sp2d", "libgsl.scm",
+ "gsl_spmatrix_transpose_memcpy", "libgsl.scm",
+ "gsl_stats_absdev", "libgsl.scm",
+ "gsl_stats_absdev_m", "libgsl.scm",
+ "gsl_stats_correlation", "libgsl.scm",
+ "gsl_stats_covariance", "libgsl.scm",
+ "gsl_stats_covariance_m", "libgsl.scm",
+ "gsl_stats_kurtosis", "libgsl.scm",
+ "gsl_stats_kurtosis_m_sd", "libgsl.scm",
+ "gsl_stats_lag1_autocorrelation", "libgsl.scm",
+ "gsl_stats_lag1_autocorrelation_m", "libgsl.scm",
+ "gsl_stats_max", "libgsl.scm",
+ "gsl_stats_max_index", "libgsl.scm",
+ "gsl_stats_mean", "libgsl.scm",
+ "gsl_stats_median_from_sorted_data", "libgsl.scm",
+ "gsl_stats_min", "libgsl.scm",
+ "gsl_stats_min_index", "libgsl.scm",
+ "gsl_stats_minmax", "libgsl.scm",
+ "gsl_stats_minmax_index", "libgsl.scm",
+ "gsl_stats_pvariance", "libgsl.scm",
+ "gsl_stats_quantile_from_sorted_data", "libgsl.scm",
+ "gsl_stats_sd", "libgsl.scm",
+ "gsl_stats_sd_m", "libgsl.scm",
+ "gsl_stats_sd_with_fixed_mean", "libgsl.scm",
+ "gsl_stats_skew", "libgsl.scm",
+ "gsl_stats_skew_m_sd", "libgsl.scm",
+ "gsl_stats_spearman", "libgsl.scm",
+ "gsl_stats_tss", "libgsl.scm",
+ "gsl_stats_tss_m", "libgsl.scm",
+ "gsl_stats_ttest", "libgsl.scm",
+ "gsl_stats_variance", "libgsl.scm",
+ "gsl_stats_variance_m", "libgsl.scm",
+ "gsl_stats_variance_with_fixed_mean", "libgsl.scm",
+ "gsl_stats_wabsdev", "libgsl.scm",
+ "gsl_stats_wabsdev_m", "libgsl.scm",
+ "gsl_stats_wkurtosis", "libgsl.scm",
+ "gsl_stats_wkurtosis_m_sd", "libgsl.scm",
+ "gsl_stats_wmean", "libgsl.scm",
+ "gsl_stats_wsd", "libgsl.scm",
+ "gsl_stats_wsd_m", "libgsl.scm",
+ "gsl_stats_wsd_with_fixed_mean", "libgsl.scm",
+ "gsl_stats_wskew", "libgsl.scm",
+ "gsl_stats_wskew_m_sd", "libgsl.scm",
+ "gsl_stats_wtss", "libgsl.scm",
+ "gsl_stats_wtss_m", "libgsl.scm",
+ "gsl_stats_wvariance", "libgsl.scm",
+ "gsl_stats_wvariance_m", "libgsl.scm",
+ "gsl_stats_wvariance_with_fixed_mean", "libgsl.scm",
+ "gsl_stream_printf", "libgsl.scm",
+ "gsl_strerror", "libgsl.scm",
+ "gsl_sum_levin_u_accel", "libgsl.scm",
+ "gsl_sum_levin_u_alloc", "libgsl.scm",
+ "gsl_sum_levin_u_free", "libgsl.scm",
+ "gsl_sum_levin_u_minmax", "libgsl.scm",
+ "gsl_sum_levin_u_step", "libgsl.scm",
+ "gsl_sum_levin_utrunc_accel", "libgsl.scm",
+ "gsl_sum_levin_utrunc_alloc", "libgsl.scm",
+ "gsl_sum_levin_utrunc_free", "libgsl.scm",
+ "gsl_sum_levin_utrunc_minmax", "libgsl.scm",
+ "gsl_sum_levin_utrunc_step", "libgsl.scm",
+ "gsl_vector->float-vector", "libgsl.scm",
+ "gsl_vector_add", "libgsl.scm",
+ "gsl_vector_add_constant", "libgsl.scm",
+ "gsl_vector_alloc", "libgsl.scm",
+ "gsl_vector_alloc_col_from_matrix", "libgsl.scm",
+ "gsl_vector_alloc_from_vector", "libgsl.scm",
+ "gsl_vector_alloc_row_from_matrix", "libgsl.scm",
+ "gsl_vector_calloc", "libgsl.scm",
+ "gsl_vector_complex_alloc", "libgsl.scm",
+ "gsl_vector_complex_alloc_col_from_matrix", "libgsl.scm",
+ "gsl_vector_complex_alloc_row_from_matrix", "libgsl.scm",
+ "gsl_vector_complex_free", "libgsl.scm",
+ "gsl_vector_complex_get", "libgsl.scm",
+ "gsl_vector_const_ptr", "libgsl.scm",
+ "gsl_vector_div", "libgsl.scm",
+ "gsl_vector_equal", "libgsl.scm",
+ "gsl_vector_fprintf", "libgsl.scm",
+ "gsl_vector_fread", "libgsl.scm",
+ "gsl_vector_free", "libgsl.scm",
+ "gsl_vector_fscanf", "libgsl.scm",
+ "gsl_vector_fwrite", "libgsl.scm",
+ "gsl_vector_get", "libgsl.scm",
+ "gsl_vector_isneg", "libgsl.scm",
+ "gsl_vector_isnonneg", "libgsl.scm",
+ "gsl_vector_isnull", "libgsl.scm",
+ "gsl_vector_ispos", "libgsl.scm",
+ "gsl_vector_max", "libgsl.scm",
+ "gsl_vector_max_index", "libgsl.scm",
+ "gsl_vector_memcpy", "libgsl.scm",
+ "gsl_vector_min", "libgsl.scm",
+ "gsl_vector_min_index", "libgsl.scm",
+ "gsl_vector_minmax", "libgsl.scm",
+ "gsl_vector_minmax_index", "libgsl.scm",
+ "gsl_vector_mul", "libgsl.scm",
+ "gsl_vector_ptr", "libgsl.scm",
+ "gsl_vector_reverse", "libgsl.scm",
+ "gsl_vector_scale", "libgsl.scm",
+ "gsl_vector_set", "libgsl.scm",
+ "gsl_vector_set_all", "libgsl.scm",
+ "gsl_vector_set_basis", "libgsl.scm",
+ "gsl_vector_set_zero", "libgsl.scm",
+ "gsl_vector_sub", "libgsl.scm",
+ "gsl_vector_swap", "libgsl.scm",
+ "gsl_vector_swap_elements", "libgsl.scm",
+ "gsl_version", "libgsl.scm",
+ "gsl_wavelet2d_nstransform", "libgsl.scm",
+ "gsl_wavelet2d_nstransform_forward", "libgsl.scm",
+ "gsl_wavelet2d_nstransform_inverse", "libgsl.scm",
+ "gsl_wavelet2d_nstransform_matrix", "libgsl.scm",
+ "gsl_wavelet2d_nstransform_matrix_forward", "libgsl.scm",
+ "gsl_wavelet2d_nstransform_matrix_inverse", "libgsl.scm",
+ "gsl_wavelet2d_transform", "libgsl.scm",
+ "gsl_wavelet2d_transform_forward", "libgsl.scm",
+ "gsl_wavelet2d_transform_inverse", "libgsl.scm",
+ "gsl_wavelet2d_transform_matrix", "libgsl.scm",
+ "gsl_wavelet2d_transform_matrix_forward", "libgsl.scm",
+ "gsl_wavelet2d_transform_matrix_inverse", "libgsl.scm",
+ "gsl_wavelet_alloc", "libgsl.scm",
+ "gsl_wavelet_backward", "libgsl.scm",
+ "gsl_wavelet_bspline", "libgsl.scm",
+ "gsl_wavelet_bspline_centered", "libgsl.scm",
+ "gsl_wavelet_daubechies", "libgsl.scm",
+ "gsl_wavelet_daubechies_centered", "libgsl.scm",
+ "gsl_wavelet_forward", "libgsl.scm",
+ "gsl_wavelet_free", "libgsl.scm",
+ "gsl_wavelet_haar", "libgsl.scm",
+ "gsl_wavelet_haar_centered", "libgsl.scm",
+ "gsl_wavelet_name", "libgsl.scm",
+ "gsl_wavelet_transform", "libgsl.scm",
+ "gsl_wavelet_transform_forward", "libgsl.scm",
+ "gsl_wavelet_transform_inverse", "libgsl.scm",
+ "gsl_wavelet_workspace_alloc", "libgsl.scm",
+ "gsl_wavelet_workspace_free", "libgsl.scm",
+ "hairy-woodpecker", "animals.scm",
+ "hammondoid", "clm-ins.scm",
+ "hammonds-flycatcher", "animals.scm",
+ "handsome-trig", "animals.scm",
+ "hard-clipped", "dsp.scm",
+ "harmonicizer", "dsp.scm",
+ "hash-table->alist", "stuff.scm",
+ "hello-dentist", "examp.scm",
+ "henslows-sparrow", "animals.scm",
+ "hermit-thrush", "animals.scm",
+ "hermite", "numerics.scm",
+ "hermite-polynomial", "numerics.scm",
+ "hook-member", "hooks.scm",
+ "hostent.h_addrtype", "libc.scm",
+ "hostent.h_aliases", "libc.scm",
+ "hostent.h_length", "libc.scm",
+ "hostent.h_name", "libc.scm",
+ "house-finch", "animals.scm",
+ "house-sparrow-1", "animals.scm",
+ "html", "index.scm",
+ "html-lint", "lint.scm",
+ "htonl", "libc.scm",
+ "htons", "libc.scm",
+ "huttons-vireo", "animals.scm",
+ "hypot", "libm.scm",
+ "hz->2pi", "dsp.scm",
+ "ilogb", "libm.scm",
+ "implementation-name", "r7rs.scm",
+ "implementation-version", "r7rs.scm",
+ "inca-dove-1", "animals.scm",
+ "inca-dove-2", "animals.scm",
+ "index-if", "stuff.scm",
+ "indexable?", "stuff.scm",
+ "indri", "animals.scm",
+ "inexact", "r7rs.scm",
+ "init-with-sound", "ws.scm",
+ "initial-direction", "dlocsig.scm",
+ "initstate", "libc.scm",
+ "input-port-open?", "r7rs.scm",
+ "insert-channel", "extensions.scm",
+ "int_to_float32", "binary-io.scm",
+ "int_to_float64", "binary-io.scm",
+ "integrate-envelope", "env.scm",
+ "interaction-environment", "r7rs.scm",
+ "intersection", "stuff.scm",
+ "inverse-chebyshev-prototype", "analog-filter.scm",
+ "inverse-integrate", "dsp.scm",
+ "invert-filter", "dsp.scm",
+ "invert-matrix", "dsp.scm",
+ "io-read-string", "binary-io.scm",
+ "io-write-string", "binary-io.scm",
+ "iota", "stuff.scm",
+ "isalnum", "libc.scm",
+ "isalpha", "libc.scm",
+ "isatty", "libc.scm",
+ "iscntrl", "libc.scm",
+ "isdigit", "libc.scm",
+ "isfinite", "libm.scm",
+ "isgraph", "libc.scm",
+ "isinf", "libm.scm",
+ "islower", "libc.scm",
+ "isnan", "libm.scm",
+ "isnormal", "libm.scm",
+ "isprint", "libc.scm",
+ "ispunct", "libc.scm",
+ "isspace", "libc.scm",
+ "isupper", "libc.scm",
+ "isxdigit", "libc.scm",
+ "izcos", "generators.scm",
+ "izcos?", "generators.scm",
+ "j0", "libm.scm",
+ "j0evencos", "generators.scm",
+ "j0evencos?", "generators.scm",
+ "j0j1cos", "generators.scm",
+ "j0j1cos?", "generators.scm",
+ "j1", "libm.scm",
+ "j2cos", "generators.scm",
+ "j2cos?", "generators.scm",
+ "jc-reverb", "jcrev.scm",
+ "jettable", "prc95.scm",
+ "jiffies-per-second", "r7rs.scm",
+ "jjcos", "generators.scm",
+ "jjcos?", "generators.scm",
+ "jl-reverb", "clm-ins.scm",
+ "jncos", "generators.scm",
+ "jncos?", "generators.scm",
+ "jpcos", "generators.scm",
+ "jpcos?", "generators.scm",
+ "jycos", "generators.scm",
+ "jycos?", "generators.scm",
+ "k2cos", "generators.scm",
+ "k2cos?", "generators.scm",
+ "k2sin", "generators.scm",
+ "k2sin?", "generators.scm",
+ "k2ssb", "generators.scm",
+ "k2ssb?", "generators.scm",
+ "k3sin", "generators.scm",
+ "k3sin?", "generators.scm",
+ "kalman-filter-channel", "dsp.scm",
+ "kill", "libc.scm",
+ "killdeer", "animals.scm",
+ "kirtlands-warbler", "animals.scm",
+ "knudsens-frog", "animals.scm",
+ "krksin", "generators.scm",
+ "krksin?", "generators.scm",
+ "labs", "libc.scm",
+ "lag?", "snddiff.scm",
+ "laguerre", "numerics.scm",
+ "laguerre-polynomial", "numerics.scm",
+ "last", "dlocsig.scm",
+ "lbj-piano", "clm-ins.scm",
+ "ldb", "stuff.scm",
+ "ldexp", "libm.scm",
+ "ldiv", "libc.scm",
+ "least-bittern", "animals.scm",
+ "least-flycatcher", "animals.scm",
+ "legendre", "numerics.scm",
+ "legendre-polynomial", "numerics.scm",
+ "lesser-nighthawk", "animals.scm",
+ "libc.scm", "libc.scm",
+ "libdl.scm", "libdl.scm",
+ "libgdbm.scm", "libgdbm.scm",
+ "libm.scm", "libm.scm",
+ "linear-src-channel", "dsp.scm",
+ "linearize", "stuff.scm",
+ "lineto", "musglyphs.scm",
+ "link", "libc.scm",
+ "linnaeus-cicada", "animals.scm",
+ "lint", "lint.scm",
+ "lip", "prc95.scm",
+ "lip-set-freq", "prc95.scm",
+ "list-copy", "r7rs.scm",
+ "list??", "dlocsig.scm",
+ "listen", "libc.scm",
+ "literal-3d", "dlocsig.scm",
+ "literal-points", "dlocsig.scm",
+ "literal-polar", "dlocsig.scm",
+ "literal-render", "dlocsig.scm",
+ "little-grass-frog", "animals.scm",
+ "llabs", "libc.scm",
+ "llrint", "libm.scm",
+ "llround", "libm.scm",
+ "local-data", "spokenword.scm",
+ "local-peak", "spokenword.scm",
+ "local-rms", "spokenword.scm",
+ "local-smooth", "spokenword.scm",
+ "localeconv", "libc.scm",
+ "locate-zero", "examp.scm",
+ "lockf", "libc.scm",
+ "log-all-of", "stuff.scm",
+ "log-any-of", "stuff.scm",
+ "log-n-of", "stuff.scm",
+ "log-none-of", "stuff.scm",
+ "log10", "dsp.scm",
+ "log1p", "libm.scm",
+ "log2", "libm.scm",
+ "logeqv", "stuff.scm",
+ "loggerhead-shrike-1", "animals.scm",
+ "loggerhead-shrike-2", "animals.scm",
+ "lognand", "stuff.scm",
+ "lognor", "stuff.scm",
+ "long-eared-owl", "animals.scm",
+ "long-spurred-meadow-katydid", "animals.scm",
+ "lpc-coeffs", "dsp.scm",
+ "lpc-predict", "dsp.scm",
+ "lseek", "libc.scm",
+ "lstat", "libc.scm",
+ "lucys-warbler", "animals.scm",
+ "lutish", "generators.scm",
+ "lyric-cicada", "animals.scm",
+ "macgillivrays-warbler", "animals.scm",
+ "machine-name", "r7rs.scm",
+ "machine1", "generators.scm",
+ "magnolia-warbler", "animals.scm",
+ "make-a-even", "dlocsig.scm",
+ "make-a-odd", "dlocsig.scm",
+ "make-abcos", "generators.scm",
+ "make-absin", "generators.scm",
+ "make-adjustable-oscil", "generators.scm",
+ "make-adjustable-sawtooth-wave", "generators.scm",
+ "make-adjustable-square-wave", "generators.scm",
+ "make-adjustable-triangle-wave", "generators.scm",
+ "make-array", "maxf.scm",
+ "make-asyfm", "generators.scm",
+ "make-bandpass", "dsp.scm",
+ "make-bandstop", "dsp.scm",
+ "make-bess", "generators.scm",
+ "make-bessel-bandpass", "analog-filter.scm",
+ "make-bessel-bandstop", "analog-filter.scm",
+ "make-bessel-highpass", "analog-filter.scm",
+ "make-bessel-lowpass", "analog-filter.scm",
+ "make-bezier-1", "musglyphs.scm",
+ "make-bezier-path", "dlocsig.scm",
+ "make-biquad", "strad.scm",
+ "make-birds", "bird.scm",
+ "make-blackman", "generators.scm",
+ "make-bowtable", "prc95.scm",
+ "make-box-type", "r7rs.scm",
+ "make-brown-noise", "generators.scm",
+ "make-butter-band-pass", "dsp.scm",
+ "make-butter-band-reject", "dsp.scm",
+ "make-butter-bp", "dsp.scm",
+ "make-butter-bs", "dsp.scm",
+ "make-butter-high-pass", "dsp.scm",
+ "make-butter-hp", "dsp.scm",
+ "make-butter-low-pass", "dsp.scm",
+ "make-butter-lp", "dsp.scm",
+ "make-butterworth-bandpass", "analog-filter.scm",
+ "make-butterworth-bandstop", "analog-filter.scm",
+ "make-butterworth-highpass", "analog-filter.scm",
+ "make-butterworth-lowpass", "analog-filter.scm",
+ "make-chebyshev-bandpass", "analog-filter.scm",
+ "make-chebyshev-bandstop", "analog-filter.scm",
+ "make-chebyshev-highpass", "analog-filter.scm",
+ "make-chebyshev-lowpass", "analog-filter.scm",
+ "make-circular-list", "stuff.scm",
+ "make-closed-path", "dlocsig.scm",
+ "make-complete-iterator", "stuff.scm",
+ "make-db-env", "grani.scm",
+ "make-dblsum", "generators.scm",
+ "make-dc-block", "prc95.scm",
+ "make-delayl", "prc95.scm",
+ "make-differentiator", "dsp.scm",
+ "make-directory-iterator", "stuff.scm",
+ "make-dlocsig", "dlocsig.scm",
+ "make-elliptic-bandpass", "analog-filter.scm",
+ "make-elliptic-bandstop", "analog-filter.scm",
+ "make-elliptic-highpass", "analog-filter.scm",
+ "make-elliptic-lowpass", "analog-filter.scm",
+ "make-eoddcos", "generators.scm",
+ "make-ercos", "generators.scm",
+ "make-erssb", "generators.scm",
+ "make-exponentially-weighted-moving-average", "generators.scm",
+ "make-flocsig", "generators.scm",
+ "make-fm-noise", "noise.scm",
+ "make-fm2", "clm-ins.scm",
+ "make-fmssb", "generators.scm",
+ "make-gr-env", "grani.scm",
+ "make-green-noise", "generators.scm",
+ "make-green-noise-interp", "generators.scm",
+ "make-group", "dlocsig.scm",
+ "make-highpass", "dsp.scm",
+ "make-hilbert-transform", "dsp.scm",
+ "make-iir-band-pass-2", "dsp.scm",
+ "make-iir-band-stop-2", "dsp.scm",
+ "make-iir-high-pass-2", "dsp.scm",
+ "make-iir-low-pass-2", "dsp.scm",
+ "make-inverse-chebyshev-bandpass", "analog-filter.scm",
+ "make-inverse-chebyshev-bandstop", "analog-filter.scm",
+ "make-inverse-chebyshev-highpass", "analog-filter.scm",
+ "make-inverse-chebyshev-lowpass", "analog-filter.scm",
+ "make-izcos", "generators.scm",
+ "make-j0evencos", "generators.scm",
+ "make-j0j1cos", "generators.scm",
+ "make-j2cos", "generators.scm",
+ "make-jjcos", "generators.scm",
+ "make-jncos", "generators.scm",
+ "make-jpcos", "generators.scm",
+ "make-jycos", "generators.scm",
+ "make-k2cos", "generators.scm",
+ "make-k2sin", "generators.scm",
+ "make-k2ssb", "generators.scm",
+ "make-k3sin", "generators.scm",
+ "make-krksin", "generators.scm",
+ "make-list-1", "dlocsig.scm",
+ "make-literal-path", "dlocsig.scm",
+ "make-literal-polar-path", "dlocsig.scm",
+ "make-lowpass", "dsp.scm",
+ "make-method", "mockery.scm",
+ "make-moog", "moog.scm",
+ "make-moog-filter", "moog.scm",
+ "make-moving-autocorrelation", "generators.scm",
+ "make-moving-fft", "generators.scm",
+ "make-moving-length", "generators.scm",
+ "make-moving-pitch", "generators.scm",
+ "make-moving-rms", "generators.scm",
+ "make-moving-scentroid", "generators.scm",
+ "make-moving-spectrum", "generators.scm",
+ "make-moving-sum", "generators.scm",
+ "make-moving-variance", "generators.scm",
+ "make-n1cos", "generators.scm",
+ "make-nchoosekcos", "generators.scm",
+ "make-ncos2", "generators.scm",
+ "make-ncos4", "generators.scm",
+ "make-nkssb", "generators.scm",
+ "make-noddcos", "generators.scm",
+ "make-noddsin", "generators.scm",
+ "make-noddssb", "generators.scm",
+ "make-noid", "generators.scm",
+ "make-notch-frequency-response", "dsp.scm",
+ "make-npcos", "generators.scm",
+ "make-nrcos", "generators.scm",
+ "make-nrsin", "generators.scm",
+ "make-nrssb", "generators.scm",
+ "make-nsincos", "generators.scm",
+ "make-nssb", "generators.scm",
+ "make-nxy1cos", "generators.scm",
+ "make-nxy1sin", "generators.scm",
+ "make-nxycos", "generators.scm",
+ "make-nxysin", "generators.scm",
+ "make-object", "mockery.scm",
+ "make-octaves-env", "grani.scm",
+ "make-onep", "prc95.scm",
+ "make-onezero", "prc95.scm",
+ "make-open-bezier-path", "dlocsig.scm",
+ "make-parameter", "r7rs.scm",
+ "make-path", "dlocsig.scm",
+ "make-peaking-2", "dsp.scm",
+ "make-pink-noise", "generators.scm",
+ "make-polar-path", "dlocsig.scm",
+ "make-polygon", "musglyphs.scm",
+ "make-polyoid", "generators.scm",
+ "make-power-env", "env.scm",
+ "make-promise", "r7rs.scm",
+ "make-pvocoder", "pvoc.scm",
+ "make-r2k!cos", "generators.scm",
+ "make-r2k2cos", "generators.scm",
+ "make-ramp", "examp.scm",
+ "make-rcos", "generators.scm",
+ "make-reed", "prc95.scm",
+ "make-rk!cos", "generators.scm",
+ "make-rk!ssb", "generators.scm",
+ "make-rkcos", "generators.scm",
+ "make-rkoddssb", "generators.scm",
+ "make-rksin", "generators.scm",
+ "make-rkssb", "generators.scm",
+ "make-rmsgain", "clm-ins.scm",
+ "make-round-interp", "generators.scm",
+ "make-rssb", "generators.scm",
+ "make-rxycos", "generators.scm",
+ "make-rxysin", "generators.scm",
+ "make-safe-rxycos", "generators.scm",
+ "make-savitzky-golay-filter", "dsp.scm",
+ "make-selection", "selection.scm",
+ "make-semitones-env", "grani.scm",
+ "make-sinc-train", "generators.scm",
+ "make-sound-interp", "examp.scm",
+ "make-speaker-config", "dlocsig.scm",
+ "make-spencer-filter", "dsp.scm",
+ "make-spiral-path", "dlocsig.scm",
+ "make-ssb-fm", "clm-ins.scm",
+ "make-table-lookup-with-env", "generators.scm",
+ "make-tanhsin", "generators.scm",
+ "make-unmoving-sum", "generators.scm",
+ "make-volterra-filter", "dsp.scm",
+ "make-wave-train-with-env", "generators.scm",
+ "make-waveshape", "generators.scm",
+ "make-weighted-moving-average", "generators.scm",
+ "make-zipper", "zip.scm",
+ "malloc", "libc.scm",
+ "map-envelopes", "env.scm",
+ "map-sound-files", "extensions.scm",
+ "maraca", "maraca.scm",
+ "mark-click-info", "marks.scm",
+ "mark-explode", "marks.scm",
+ "mark-in", "spokenword.scm",
+ "mark-loops", "examp.scm",
+ "mark-name->id", "marks.scm",
+ "mark-out", "spokenword.scm",
+ "marsh-meadow-grasshopper", "animals.scm",
+ "match-sound-files", "extensions.scm",
+ "matrix-solve", "dsp.scm",
+ "max-envelope", "env.scm",
+ "maxfilter", "maxf.scm",
+ "member?", "stuff.scm",
+ "memchr", "libc.scm",
+ "memcmp", "libc.scm",
+ "memcpy", "libc.scm",
+ "memmove", "libc.scm",
+ "memset", "libc.scm",
+ "merge-hash-tables", "stuff.scm",
+ "metal", "clm-ins.scm",
+ "min-envelope", "env.scm",
+ "mirror-path", "dlocsig.scm",
+ "mix->float-vector", "mix.scm",
+ "mix-channel", "extensions.scm",
+ "mix-click-info", "mix.scm",
+ "mix-click-sets-amp", "mix.scm",
+ "mix-maxamp", "mix.scm",
+ "mix-name->id", "mix.scm",
+ "mix-notelists", "ws.scm",
+ "mix-sound", "mix.scm",
+ "mixes-length", "mix.scm",
+ "mixes-maxamp", "mix.scm",
+ "mkdir", "libc.scm",
+ "mkfifo", "libc.scm",
+ "mknod", "libc.scm",
+ "mkstemp", "libc.scm",
+ "mktemp", "libc.scm",
+ "mktime", "libc.scm",
+ "mock->string", "mockery.scm",
+ "mockery.scm", "mockery.scm",
+ "modf", "libm.scm",
+ "mono->stereo", "extensions.scm",
+ "mono-files->stereo", "extensions.scm",
+ "montezuma-quail", "animals.scm",
+ "moog-filter", "moog.scm",
+ "moog-filter-saturated", "moog.scm",
+ "moog-frequency", "moog.scm",
+ "moog?", "moog.scm",
+ "mosquito", "animals.scm",
+ "mountain-quail", "animals.scm",
+ "mourning-dove", "animals.scm",
+ "mouse-drag-envelope", "enved.scm",
+ "mouse-press-envelope", "enved.scm",
+ "mouse-release-envelope", "enved.scm",
+ "move-mixes", "mix.scm",
+ "move-syncd-marks", "marks.scm",
+ "moveto", "musglyphs.scm",
+ "moving-autocorrelation", "generators.scm",
+ "moving-autocorrelation?", "generators.scm",
+ "moving-fft", "generators.scm",
+ "moving-fft?", "generators.scm",
+ "moving-formant", "examp.scm",
+ "moving-length", "generators.scm",
+ "moving-length?", "generators.scm",
+ "moving-pitch", "generators.scm",
+ "moving-pitch?", "generators.scm",
+ "moving-rms", "generators.scm",
+ "moving-rms?", "generators.scm",
+ "moving-scentroid", "generators.scm",
+ "moving-scentroid?", "generators.scm",
+ "moving-spectrum", "generators.scm",
+ "moving-spectrum?", "generators.scm",
+ "moving-sum", "generators.scm",
+ "moving-sum?", "generators.scm",
+ "moving-variance", "generators.scm",
+ "moving-variance?", "generators.scm",
+ "mpg", "examp.scm",
+ "multi-expt-env", "generators.scm",
+ "multiply-envelopes", "env.scm",
+ "music-font", "musglyphs.scm",
+ "mvmfilt", "maxf.scm",
+ "n-choose-k", "stuff.scm",
+ "n1cos", "generators.scm",
+ "n1cos?", "generators.scm",
+ "nan", "libm.scm",
+ "nanosleep", "libc.scm",
+ "narrow-winged-tree-cricket", "animals.scm",
+ "nashville-warbler", "animals.scm",
+ "nb", "nb.scm",
+ "nchoosekcos", "generators.scm",
+ "nchoosekcos?", "generators.scm",
+ "ncos2", "generators.scm",
+ "ncos2?", "generators.scm",
+ "ncos4", "generators.scm",
+ "nearbyint", "libm.scm",
+ "nearest-point", "dlocsig.scm",
+ "netent.n_addrtype", "libc.scm",
+ "netent.n_aliases", "libc.scm",
+ "netent.n_name", "libc.scm",
+ "netent.n_net", "libc.scm",
+ "next-peak", "examp.scm",
+ "next-phrase", "spokenword.scm",
+ "nextafter", "libm.scm",
+ "nexttoward", "libm.scm",
+ "ninth", "stuff.scm",
+ "nkssb", "generators.scm",
+ "nkssb-interp", "generators.scm",
+ "nkssb?", "generators.scm",
+ "nkssber", "generators.scm",
+ "noddcos", "generators.scm",
+ "noddcos?", "generators.scm",
+ "noddsin", "generators.scm",
+ "noddsin?", "generators.scm",
+ "noddssb", "generators.scm",
+ "noddssb?", "generators.scm",
+ "noid", "generators.scm",
+ "noid?", "generators.scm",
+ "nonce", "stuff.scm",
+ "normalize-envelope", "env.scm",
+ "normalize-sound", "extensions.scm",
+ "normalized-mix", "extensions.scm",
+ "northern-beardless-tyrannulet", "animals.scm",
+ "northern-goshawk", "animals.scm",
+ "northern-leopard-frog-1", "animals.scm",
+ "northern-leopard-frog-2", "animals.scm",
+ "not-fitted", "dlocsig.scm",
+ "not-parsed", "dlocsig.scm",
+ "not-rendered", "dlocsig.scm",
+ "not-transformed", "dlocsig.scm",
+ "notch-channel", "dsp.scm",
+ "notch-filter", "examp.scm",
+ "notch-selection", "dsp.scm",
+ "notch-sound", "dsp.scm",
+ "note-data->pitch", "musglyphs.scm",
+ "npcos", "generators.scm",
+ "npcos?", "generators.scm",
+ "nrcos", "generators.scm",
+ "nrcos->polywave", "animals.scm",
+ "nrcos-set-scaler", "generators.scm",
+ "nrcos?", "generators.scm",
+ "nrev", "clm-ins.scm",
+ "nrsin?", "generators.scm",
+ "nrssb", "generators.scm",
+ "nrssb-interp", "generators.scm",
+ "nrssb?", "generators.scm",
+ "nsincos", "generators.scm",
+ "nsincos?", "generators.scm",
+ "nssb", "generators.scm",
+ "nssb?", "generators.scm",
+ "ntohl", "libc.scm",
+ "ntohs", "libc.scm",
+ "nxy1cos", "generators.scm",
+ "nxy1cos?", "generators.scm",
+ "nxy1sin", "generators.scm",
+ "nxy1sin?", "generators.scm",
+ "nxycos", "generators.scm",
+ "nxycos?", "generators.scm",
+ "nxysin", "generators.scm",
+ "nxysin?", "generators.scm",
+ "oak-titmouse", "animals.scm",
+ "oak-toad", "animals.scm",
+ "oboish", "generators.scm",
+ "octaves-envelope", "grani.scm",
+ "offset-channel", "extensions.scm",
+ "offset-sound", "extensions.scm",
+ "olive-sided-flycatcher", "animals.scm",
+ "one-turn-is", "dlocsig.scm",
+ "open", "libc.scm",
+ "open-binary-input-file", "r7rs.scm",
+ "open-binary-output-file", "r7rs.scm",
+ "open-input-bytevector", "r7rs.scm",
+ "open-next-file-in-directory", "examp.scm",
+ "open-output-bytevector", "r7rs.scm",
+ "opendir", "libc.scm",
+ "orange-crowned-warbler", "animals.scm",
+ "organish", "generators.scm",
+ "ornate-chorus-frog", "animals.scm",
+ "os-type", "r7rs.scm",
+ "os-version", "r7rs.scm",
+ "osc-formants", "examp.scm",
+ "outlet-member", "mockery.scm",
+ "output-port-open?", "r7rs.scm",
+ "output-type", "musglyphs.scm",
+ "overlay-rms-env", "draw.scm",
+ "overlay-sounds", "draw.scm",
+ "ow!", "stuff.scm",
+ "owlets", "stuff.scm",
+ "p", "piano.scm",
+ "pacific-chorus-frog", "animals.scm",
+ "pacific-slope-flycatcher", "animals.scm",
+ "pad-marks", "marks.scm",
+ "pad-sound", "extensions.scm",
+ "pan-mix", "mix.scm",
+ "pan-mix-float-vector", "mix.scm",
+ "pan-mix-region", "mix.scm",
+ "pan-mix-selection", "mix.scm",
+ "pareto-distribution", "dsp.scm",
+ "parse-cartesian-coordinates", "dlocsig.scm",
+ "parse-polar-coordinates", "dlocsig.scm",
+ "partials->waveshape", "generators.scm",
+ "passwd.pw_dir", "libc.scm",
+ "passwd.pw_gecos", "libc.scm",
+ "passwd.pw_gid", "libc.scm",
+ "passwd.pw_name", "libc.scm",
+ "passwd.pw_passwd", "libc.scm",
+ "passwd.pw_shell", "libc.scm",
+ "passwd.pw_uid", "libc.scm",
+ "path-rt", "dlocsig.scm",
+ "path-rv", "dlocsig.scm",
+ "path-rx", "dlocsig.scm",
+ "path-ry", "dlocsig.scm",
+ "path-rz", "dlocsig.scm",
+ "path-time", "dlocsig.scm",
+ "path-tt", "dlocsig.scm",
+ "path-tx", "dlocsig.scm",
+ "path-ty", "dlocsig.scm",
+ "path-tz", "dlocsig.scm",
+ "path-x", "dlocsig.scm",
+ "path-y", "dlocsig.scm",
+ "path-z", "dlocsig.scm",
+ "pathconf", "libc.scm",
+ "pause", "libc.scm",
+ "pclose", "libc.scm",
+ "peek-u8", "r7rs.scm",
+ "periodogram", "dsp.scm",
+ "perror", "libc.scm",
+ "phainopepla", "animals.scm",
+ "philadelphia-vireo", "animals.scm",
+ "phrase-start?", "spokenword.scm",
+ "phrase?", "spokenword.scm",
+ "pianoy", "generators.scm",
+ "pianoy1", "generators.scm",
+ "pianoy2", "generators.scm",
+ "pileated-woodpecker", "animals.scm",
+ "pine-tree-cricket", "animals.scm",
+ "pine-warbler", "animals.scm",
+ "pinewoods-tree-frog", "animals.scm",
+ "pink-noise?", "generators.scm",
+ "pins", "clm-ins.scm",
+ "pinyon-jay", "animals.scm",
+ "pipe", "libc.scm",
+ "place-sound", "examp.scm",
+ "plain-chacalaca", "animals.scm",
+ "plains-spadefoot", "animals.scm",
+ "play-ac3", "examp.scm",
+ "play-between-marks", "marks.scm",
+ "play-mixes", "mix.scm",
+ "play-often", "play.scm",
+ "play-preview", "spokenword.scm",
+ "play-region-forever", "play.scm",
+ "play-sine", "play.scm",
+ "play-sines", "play.scm",
+ "play-syncd-marks", "marks.scm",
+ "play-until-c-g", "play.scm",
+ "play-with-amps", "play.scm",
+ "play-with-envs", "enved.scm",
+ "plgndr", "numerics.scm",
+ "pluck", "clm-ins.scm",
+ "plucky", "prc95.scm",
+ "plumbeous-vireo-1", "animals.scm",
+ "plumbeous-vireo-2", "animals.scm",
+ "poly*", "poly.scm",
+ "poly+", "poly.scm",
+ "poly-as-vector*", "poly.scm",
+ "poly-as-vector+", "poly.scm",
+ "poly-as-vector-derivative", "poly.scm",
+ "poly-as-vector-discriminant", "poly.scm",
+ "poly-as-vector-eval", "poly.scm",
+ "poly-as-vector-gcd", "poly.scm",
+ "poly-as-vector-reduce", "poly.scm",
+ "poly-as-vector-resultant", "poly.scm",
+ "poly-as-vector-roots", "poly.scm",
+ "poly-as-vector/", "poly.scm",
+ "poly-derivative", "poly.scm",
+ "poly-discriminant", "poly.scm",
+ "poly-gcd", "poly.scm",
+ "poly-reduce", "poly.scm",
+ "poly-resultant", "poly.scm",
+ "poly-roots", "poly.scm",
+ "poly/", "poly.scm",
+ "polyoid", "generators.scm",
+ "polyoid-env", "generators.scm",
+ "polyoid-tn", "generators.scm",
+ "polyoid-un", "generators.scm",
+ "polyoid?", "generators.scm",
+ "popen", "libc.scm",
+ "port?", "r7rs.scm",
+ "posix_fadvise", "libc.scm",
+ "posix_fallocate", "libc.scm",
+ "pow", "libm.scm",
+ "powenv-channel", "env.scm",
+ "power-env", "env.scm",
+ "power-env-channel", "env.scm",
+ "power-set", "stuff.scm",
+ "pp", "write.scm",
+ "pqw", "clm-ins.scm",
+ "pqw-vox", "clm-ins.scm",
+ "pread", "libc.scm",
+ "pretty-print", "write.scm",
+ "previous-phrase", "spokenword.scm",
+ "protoent.p_aliases", "libc.scm",
+ "protoent.p_name", "libc.scm",
+ "protoent.p_proto", "libc.scm",
+ "prototype->highpass", "analog-filter.scm",
+ "prune-db", "nb.scm",
+ "pulse-voice", "examp.scm",
+ "purple-finch", "animals.scm",
+ "putc", "libc.scm",
+ "putchar", "libc.scm",
+ "putenv", "libc.scm",
+ "puts", "libc.scm",
+ "pvoc", "pvoc.scm",
+ "pvocoder", "pvoc.scm",
+ "pwrite", "libc.scm",
+ "pygmy-nuthatch", "animals.scm",
+ "r2k!cos", "generators.scm",
+ "r2k!cos?", "generators.scm",
+ "r2k2cos", "generators.scm",
+ "r2k2cos-norm", "generators.scm",
+ "r2k2cos?", "generators.scm",
+ "r7rs-file-exists?", "r7rs.scm",
+ "r7rs-make-hash-table", "r7rs.scm",
+ "r7rs-string-copy", "r7rs.scm",
+ "r7rs-string-fill!", "r7rs.scm",
+ "r7rs.scm", "r7rs.scm",
+ "raise", "r7rs.scm",
+ "raise-continuable", "r7rs.scm",
+ "raised-cosine", "grani.scm",
+ "ramp", "examp.scm",
+ "ramp-expt", "extensions.scm",
+ "ramp-squared", "extensions.scm",
+ "rcos", "generators.scm",
+ "rcos?", "generators.scm",
+ "reactive-lambda*", "stuff.scm",
+ "reactive-let", "stuff.scm",
+ "reactive-let*", "stuff.scm",
+ "read-aif-header", "binary-io.scm",
+ "read-ascii", "examp.scm",
+ "read-au-header", "binary-io.scm",
+ "read-bfloat32", "binary-io.scm",
+ "read-bfloat64", "binary-io.scm",
+ "read-bfloat80->int", "binary-io.scm",
+ "read-bint16", "binary-io.scm",
+ "read-bint32", "binary-io.scm",
+ "read-bint64", "binary-io.scm",
+ "read-bytevector", "r7rs.scm",
+ "read-bytevector!", "r7rs.scm",
+ "read-chars", "binary-io.scm",
+ "read-error?", "r7rs.scm",
+ "read-flac", "examp.scm",
+ "read-lfloat32", "binary-io.scm",
+ "read-lfloat64", "binary-io.scm",
+ "read-lint16", "binary-io.scm",
+ "read-lint32", "binary-io.scm",
+ "read-lint64", "binary-io.scm",
+ "read-ogg", "examp.scm",
+ "read-speex", "examp.scm",
+ "read-u8", "r7rs.scm",
+ "read_dir", "libc.scm",
+ "realloc", "libc.scm",
+ "realpath", "libc.scm",
+ "recv", "libc.scm",
+ "recvfrom", "libc.scm",
+ "recvmsg", "libc.scm",
+ "red-breasted-nuthatch", "animals.scm",
+ "red-eyed-vireo", "animals.scm",
+ "red-shouldered-hawk", "animals.scm",
+ "red-spotted-toad", "animals.scm",
+ "redo-channel", "extensions.scm",
+ "reedtable", "prc95.scm",
+ "reflective-let", "stuff.scm",
+ "reflective-probe", "stuff.scm",
+ "region-play-list", "examp.scm",
+ "region-play-sequence", "examp.scm",
+ "region-rms", "examp.scm",
+ "remove", "libc.scm",
+ "remove-clicks", "examp.scm",
+ "remove-if", "stuff.scm",
+ "remove-pops", "clean.scm",
+ "remove-single-sample-clicks", "clean.scm",
+ "remquo", "libm.scm",
+ "rename", "libc.scm",
+ "render-path", "dlocsig.scm",
+ "repeat-envelope", "env.scm",
+ "replace-with-selection", "selection.scm",
+ "report-mark-names", "marks.scm",
+ "reset-all-hooks", "hooks.scm",
+ "reset-fit", "dlocsig.scm",
+ "reset-rendering", "dlocsig.scm",
+ "reset-transformation", "dlocsig.scm",
+ "resflt", "clm-ins.scm",
+ "reson", "clm-ins.scm",
+ "reverse-by-blocks", "examp.scm",
+ "reverse-envelope", "env.scm",
+ "reverse-within-blocks", "examp.scm",
+ "rewind", "libc.scm",
+ "rewinddir", "libc.scm",
+ "rhodey", "clm-ins.scm",
+ "ring-mod", "examp.scm",
+ "rint", "libm.scm",
+ "river-frog", "animals.scm",
+ "rk!cos", "generators.scm",
+ "rk!cos?", "generators.scm",
+ "rk!ssb", "generators.scm",
+ "rk!ssb?", "generators.scm",
+ "rkcos", "generators.scm",
+ "rkcos?", "generators.scm",
+ "rkoddssb", "generators.scm",
+ "rkoddssb?", "generators.scm",
+ "rksin", "generators.scm",
+ "rksin?", "generators.scm",
+ "rkssb", "generators.scm",
+ "rkssb?", "generators.scm",
+ "rlimit.make", "libc.scm",
+ "rlimit.rlim_cur", "libc.scm",
+ "rlimit.rlim_max", "libc.scm",
+ "rlineto", "musglyphs.scm",
+ "rmdir", "libc.scm",
+ "rmoveto", "musglyphs.scm",
+ "rms", "clm-ins.scm",
+ "rms-envelope", "env.scm",
+ "rotate-path", "dlocsig.scm",
+ "rotate-phase", "dsp.scm",
+ "round-interp", "generators.scm",
+ "round-interp?", "generators.scm",
+ "rssb", "generators.scm",
+ "rssb-interp", "generators.scm",
+ "rssb?", "generators.scm",
+ "rubber-sound", "rubber.scm",
+ "ruby-crowned-kinglet", "animals.scm",
+ "ruffed-grouse", "animals.scm",
+ "run-with-fm-and-pm", "generators.scm",
+ "rusage.make", "libc.scm",
+ "rusage.ru_inblock", "libc.scm",
+ "rusage.ru_majflt", "libc.scm",
+ "rusage.ru_maxrss", "libc.scm",
+ "rusage.ru_minflt", "libc.scm",
+ "rusage.ru_nivcsw", "libc.scm",
+ "rusage.ru_nvcsw", "libc.scm",
+ "rusage.ru_oublock", "libc.scm",
+ "rusage.ru_stime", "libc.scm",
+ "rusage.ru_utime", "libc.scm",
+ "rxycos", "generators.scm",
+ "rxycos?", "generators.scm",
+ "rxysin", "generators.scm",
+ "rxysin?", "generators.scm",
+ "safe-count-if", "stuff.scm",
+ "safe-find-if", "stuff.scm",
+ "safe-rxycos", "generators.scm",
+ "safe-rxycos?", "generators.scm",
+ "safe-srate", "zip.scm",
+ "sage-sparrow", "animals.scm",
+ "samples-via-colormap", "draw.scm",
+ "sandhill-crane", "animals.scm",
+ "savannah-sparrow", "animals.scm",
+ "save-mark-properties", "marks.scm",
+ "says-phoebe", "animals.scm",
+ "scalbln", "libm.scm",
+ "scalbn", "libm.scm",
+ "scale-envelope", "env.scm",
+ "scale-mixes", "mix.scm",
+ "scale-path", "dlocsig.scm",
+ "scale-sound", "extensions.scm",
+ "scale-tempo", "mix.scm",
+ "scaled-quail", "animals.scm",
+ "scentroid", "dsp.scm",
+ "scotts-oriole", "animals.scm",
+ "scramble-channel", "examp.scm",
+ "scramble-channels", "examp.scm",
+ "scratch", "clm-ins.scm",
+ "scrub-euphonia", "animals.scm",
+ "search-for-click", "examp.scm",
+ "second", "stuff.scm",
+ "secs->samples", "spokenword.scm",
+ "selection-members", "selection.scm",
+ "selection-rms", "examp.scm",
+ "semitones-envelope", "grani.scm",
+ "send", "libc.scm",
+ "sendmsg", "libc.scm",
+ "sendto", "libc.scm",
+ "sequence->string", "stuff.scm",
+ "sequences->list", "stuff.scm",
+ "servent.s_aliases", "libc.scm",
+ "servent.s_name", "libc.scm",
+ "servent.s_port", "libc.scm",
+ "servent.s_proto", "libc.scm",
+ "set-box!", "r7rs.scm",
+ "set-coeffs", "maxf.scm",
+ "set-gain", "prc95.scm",
+ "set-mixes-tag-y", "mix.scm",
+ "set-pole", "prc95.scm",
+ "set-speaker-configuration", "dlocsig.scm",
+ "set_errno", "libc.scm",
+ "setbuf", "libc.scm",
+ "setenv", "libc.scm",
+ "setf-aref", "jcvoi.scm",
+ "setgid", "libc.scm",
+ "sethostent", "libc.scm",
+ "setlinebuf", "libc.scm",
+ "setlocale", "libc.scm",
+ "setnetent", "libc.scm",
+ "setpgid", "libc.scm",
+ "setpriority", "libc.scm",
+ "setprotoent", "libc.scm",
+ "setpwent", "libc.scm",
+ "setrlimit", "libc.scm",
+ "setservent", "libc.scm",
+ "setsid", "libc.scm",
+ "setsockopt", "libc.scm",
+ "setstate", "libc.scm",
+ "setuid", "libc.scm",
+ "setvbuf", "libc.scm",
+ "seventh", "stuff.scm",
+ "shift-channel-pitch", "dsp.scm",
+ "show-digits-of-pi-starting-at-digit", "numerics.scm",
+ "show-mins", "peak-phases.scm",
+ "showall", "peak-phases.scm",
+ "showdiff", "peak-phases.scm",
+ "showodd", "peak-phases.scm",
+ "showphases", "peak-phases.scm",
+ "shutdown", "libc.scm",
+ "sigaction", "libc.scm",
+ "sigaction.make", "libc.scm",
+ "sigaction.sa_flags", "libc.scm",
+ "sigaction.sa_handler", "libc.scm",
+ "sigaction.sa_mask", "libc.scm",
+ "sigaction.set_sa_flags", "libc.scm",
+ "sigaction.set_sa_handler", "libc.scm",
+ "sigaddset", "libc.scm",
+ "sigdelset", "libc.scm",
+ "sigemptyset", "libc.scm",
+ "sigfillset", "libc.scm",
+ "siginfo.make", "libc.scm",
+ "siginfo.si_addr", "libc.scm",
+ "siginfo.si_band", "libc.scm",
+ "siginfo.si_code", "libc.scm",
+ "siginfo.si_errno", "libc.scm",
+ "siginfo.si_fd", "libc.scm",
+ "siginfo.si_int", "libc.scm",
+ "siginfo.si_overrun", "libc.scm",
+ "siginfo.si_pid", "libc.scm",
+ "siginfo.si_ptr", "libc.scm",
+ "siginfo.si_signo", "libc.scm",
+ "siginfo.si_status", "libc.scm",
+ "siginfo.si_stime", "libc.scm",
+ "siginfo.si_timerid", "libc.scm",
+ "siginfo.si_uid", "libc.scm",
+ "siginfo.si_utime", "libc.scm",
+ "siginfo.si_value", "libc.scm",
+ "sigismember", "libc.scm",
+ "signal", "libc.scm",
+ "signbit", "libm.scm",
+ "signum", "dsp.scm",
+ "sigpending", "libc.scm",
+ "sigprocmask", "libc.scm",
+ "sigqueue", "libc.scm",
+ "sigset.make", "libc.scm",
+ "sigsuspend", "libc.scm",
+ "sigtimedwait", "libc.scm",
+ "sigwait", "libc.scm",
+ "sigwaitinfo", "libc.scm",
+ "silence-all-mixes", "mix.scm",
+ "silence-mixes", "mix.scm",
+ "silence?", "spokenword.scm",
+ "simplify-complex", "poly.scm",
+ "simplify-envelope", "env.scm",
+ "sin-m*pi/n", "numerics.scm",
+ "sin-nx-peak", "numerics.scm",
+ "sinc-train", "generators.scm",
+ "sinc-train?", "generators.scm",
+ "sine-bank", "pvoc.scm",
+ "sine-env", "generators.scm",
+ "sine-env-channel", "extensions.scm",
+ "sine-ramp", "extensions.scm",
+ "singer", "singer.scm",
+ "sixth", "stuff.scm",
+ "sleep", "libc.scm",
+ "slightly-musical-conehead", "animals.scm",
+ "smooth-float-vector", "clean.scm",
+ "snap-mark-to-beat", "marks.scm",
+ "snap-marks", "marks.scm",
+ "snap-mix-1", "mix.scm",
+ "snap-mix-to-beat", "mix.scm",
+ "snap-syncd-mixes-1", "mix.scm",
+ "snap-syncd-mixes-to-beat", "mix.scm",
+ "snd-analog-filter.scm", "analog-filter.scm",
+ "snd-animals.scm", "animals.scm",
+ "snd-autosave.scm", "autosave.scm",
+ "snd-bess.scm", "bess.scm",
+ "snd-bess1.scm", "bess1.scm",
+ "snd-big-gens.scm", "big-gens.scm",
+ "snd-binary-io.scm", "binary-io.scm",
+ "snd-bird.scm", "bird.scm",
+ "snd-clean.scm", "clean.scm",
+ "snd-clm-ins.scm", "clm-ins.scm",
+ "snd-clm23.scm", "clm23.scm",
+ "snd-dlocsig.scm", "dlocsig.scm",
+ "snd-draw.scm", "draw.scm",
+ "snd-dsp.scm", "dsp.scm",
+ "snd-edit-menu.scm", "edit-menu.scm",
+ "snd-edit123.scm", "edit123.scm",
+ "snd-effects-utils.scm", "effects-utils.scm",
+ "snd-env.scm", "env.scm",
+ "snd-enved.scm", "enved.scm",
+ "snd-examp.scm", "examp.scm",
+ "snd-expandn.scm", "expandn.scm",
+ "snd-extensions.scm", "extensions.scm",
+ "snd-fade.scm", "fade.scm",
+ "snd-fft-menu.scm", "fft-menu.scm",
+ "snd-fmv.scm", "fmv.scm",
+ "snd-freeverb.scm", "freeverb.scm",
+ "snd-fullmix.scm", "fullmix.scm",
+ "snd-generators.scm", "generators.scm",
+ "snd-grani.scm", "grani.scm",
+ "snd-gtk-effects-utils.scm", "gtk-effects-utils.scm",
+ "snd-gtk-effects.scm", "gtk-effects.scm",
+ "snd-hooks", "hooks.scm",
+ "snd-hooks.scm", "hooks.scm",
+ "snd-index.scm", "index.scm",
+ "snd-jcrev.scm", "jcrev.scm",
+ "snd-jcvoi.scm", "jcvoi.scm",
+ "snd-maraca.scm", "maraca.scm",
+ "snd-marks-menu.scm", "marks-menu.scm",
+ "snd-marks.scm", "marks.scm",
+ "snd-maxf.scm", "maxf.scm",
+ "snd-misc.scm", "misc.scm",
+ "snd-mix.scm", "mix.scm",
+ "snd-moog.scm", "moog.scm",
+ "snd-msg", "maxf.scm",
+ "snd-musglyphs.scm", "musglyphs.scm",
+ "snd-nb.scm", "nb.scm",
+ "snd-new-backgrounds.scm", "new-backgrounds.scm",
+ "snd-new-effects.scm", "new-effects.scm",
+ "snd-noise.scm", "noise.scm",
+ "snd-nrev.scm", "nrev.scm",
+ "snd-numerics.scm", "numerics.scm",
+ "snd-peak-phases.scm", "peak-phases.scm",
+ "snd-piano.scm", "piano.scm",
+ "snd-play.scm", "play.scm",
+ "snd-poly.scm", "poly.scm",
+ "snd-prc95.scm", "prc95.scm",
+ "snd-pvoc.scm", "pvoc.scm",
+ "snd-rgb.scm", "rgb.scm",
+ "snd-rubber.scm", "rubber.scm",
+ "snd-selection.scm", "selection.scm",
+ "snd-singer.scm", "singer.scm",
+ "snd-snd-gl.scm", "snd-gl.scm",
+ "snd-snd-gtk.scm", "snd-gtk.scm",
+ "snd-snd-motif.scm", "snd-motif.scm",
+ "snd-snddiff.scm", "snddiff.scm",
+ "snd-sndwarp.scm", "sndwarp.scm",
+ "snd-special-menu.scm", "special-menu.scm",
+ "snd-spectr.scm", "spectr.scm",
+ "snd-strad.scm", "strad.scm",
+ "snd-v.scm", "v.scm",
+ "snd-ws.scm", "ws.scm",
+ "snd-xm-enved.scm", "xm-enved.scm",
+ "snd-zip.scm", "zip.scm",
+ "snddiff", "snddiff.scm",
+ "snddiff-1", "snddiff.scm",
+ "snddiff-2", "snddiff.scm",
+ "sndlib-ws.scm", "sndlib-ws.scm",
+ "sndwarp", "sndwarp.scm",
+ "snowy-tree-cricket", "animals.scm",
+ "socket", "libc.scm",
+ "socketpair", "libc.scm",
+ "soft-clipped", "dsp.scm",
+ "song-sparrow", "animals.scm",
+ "sonoran-desert-toad", "animals.scm",
+ "sora", "animals.scm",
+ "sort-samples", "examp.scm",
+ "sound-interp", "examp.scm",
+ "sound-let", "ws.scm",
+ "southeastern-field-cricket", "animals.scm",
+ "southern-cricket-frog", "animals.scm",
+ "southern-mole-cricket", "animals.scm",
+ "southwestern-toad", "animals.scm",
+ "speaker-config-coords", "dlocsig.scm",
+ "speaker-config-delays", "dlocsig.scm",
+ "speaker-config-dimension", "dlocsig.scm",
+ "speaker-config-groups", "dlocsig.scm",
+ "speaker-config-map", "dlocsig.scm",
+ "speaker-config-number", "dlocsig.scm",
+ "spectra", "clm-ins.scm",
+ "spectral-polynomial", "dsp.scm",
+ "spectrum->coeffs", "dsp.scm",
+ "sphagnum-ground-cricket", "animals.scm",
+ "spike", "dsp.scm",
+ "spiral-distance", "dlocsig.scm",
+ "spiral-height", "dlocsig.scm",
+ "spiral-render", "dlocsig.scm",
+ "spiral-start-angle", "dlocsig.scm",
+ "spiral-step-angle", "dlocsig.scm",
+ "spiral-total-angle", "dlocsig.scm",
+ "spiral-turns", "dlocsig.scm",
+ "spiral-velocity", "dlocsig.scm",
+ "spot-freq", "dsp.scm",
+ "spring-peeper", "animals.scm",
+ "square", "r7rs.scm",
+ "square-env", "generators.scm",
+ "squelch-vowels", "examp.scm",
+ "squirrel-tree-frog", "animals.scm",
+ "srand", "libc.scm",
+ "srandom", "libc.scm",
+ "src-duration", "dsp.scm",
+ "src-fit-envelope", "dsp.scm",
+ "src-mixes", "mix.scm",
+ "ssb-bank", "dsp.scm",
+ "ssb-bank-env", "dsp.scm",
+ "ssb-fm", "clm-ins.scm",
+ "start-dac", "play.scm",
+ "start-enveloping", "enved.scm",
+ "start-sync", "marks.scm",
+ "stat", "libc.scm",
+ "stat.make", "libc.scm",
+ "stat.st_atime", "libc.scm",
+ "stat.st_blksize", "libc.scm",
+ "stat.st_blocks", "libc.scm",
+ "stat.st_ctime", "libc.scm",
+ "stat.st_dev", "libc.scm",
+ "stat.st_gid", "libc.scm",
+ "stat.st_ino", "libc.scm",
+ "stat.st_mode", "libc.scm",
+ "stat.st_mtime", "libc.scm",
+ "stat.st_nlink", "libc.scm",
+ "stat.st_rdev", "libc.scm",
+ "stat.st_size", "libc.scm",
+ "stat.st_uid", "libc.scm",
+ "stderr", "libc.scm",
+ "stdin", "libc.scm",
+ "stdout", "libc.scm",
+ "stellers-jay", "animals.scm",
+ "stereo->mono", "extensions.scm",
+ "stereo-flute", "clm-ins.scm",
+ "stochastic", "stochastic.scm",
+ "stop-enveloping", "enved.scm",
+ "stop-sync", "marks.scm",
+ "strcasecmp", "libc.scm",
+ "strcat", "libc.scm",
+ "strchr", "libc.scm",
+ "strcmp", "libc.scm",
+ "strcoll", "libc.scm",
+ "strcpy", "libc.scm",
+ "strcspn", "libc.scm",
+ "strerror", "libc.scm",
+ "stretch-envelope", "env.scm",
+ "stretch-sound-via-dft", "dsp.scm",
+ "string->c-pointer", "libc.scm",
+ "string->utf8", "r7rs.scm",
+ "string->vector", "r7rs.scm",
+ "string-copy!", "r7rs.scm",
+ "string-for-each", "r7rs.scm",
+ "string-map", "r7rs.scm",
+ "stringy", "generators.scm",
+ "striped-ground-cricket", "animals.scm",
+ "strlen", "libc.scm",
+ "strncasecmp", "libc.scm",
+ "strncat", "libc.scm",
+ "strncmp", "libc.scm",
+ "strncpy", "libc.scm",
+ "strnlen", "libc.scm",
+ "strpbrk", "libc.scm",
+ "strrchr", "libc.scm",
+ "strspn", "libc.scm",
+ "strstr", "libc.scm",
+ "strtod", "libc.scm",
+ "strtof", "libc.scm",
+ "strtok", "libc.scm",
+ "strtol", "libc.scm",
+ "strtoll", "libc.scm",
+ "strxfrm", "libc.scm",
+ "stuff.scm", "stuff.scm",
+ "submatrix", "poly.scm",
+ "subsequence", "stuff.scm",
+ "summer-tanager", "animals.scm",
+ "superimpose-ffts", "examp.scm",
+ "swainsons-thrush", "animals.scm",
+ "swap-selection-channels", "selection.scm",
+ "symbol=?", "r7rs.scm",
+ "symmetric-difference", "stuff.scm",
+ "sync-all-mixes", "mix.scm",
+ "sync-everything", "examp.scm",
+ "syncd-mixes", "mix.scm",
+ "syncup", "marks.scm",
+ "sysconf", "libc.scm",
+ "tanhsin", "generators.scm",
+ "tanhsin?", "generators.scm",
+ "tcdrain", "libc.scm",
+ "tcflow", "libc.scm",
+ "tcflush", "libc.scm",
+ "tcgetattr", "libc.scm",
+ "tcgetpgrp", "libc.scm",
+ "tcsendbreak", "libc.scm",
+ "tcsetattr", "libc.scm",
+ "tcsetpgrp", "libc.scm",
+ "tempnam", "libc.scm",
+ "tenth", "stuff.scm",
+ "termios.c_lflag", "libc.scm",
+ "termios.make", "libc.scm",
+ "termios.set_c_cc", "libc.scm",
+ "termios.set_c_lflag", "libc.scm",
+ "test-grani", "grani.scm",
+ "test-notch-hum", "clean.scm",
+ "test-remove-DC", "clean.scm",
+ "test-remove-pops", "clean.scm",
+ "test-remove-single-clicks", "clean.scm",
+ "test-sv", "generators.scm",
+ "texas-toad", "animals.scm",
+ "textual-port?", "r7rs.scm",
+ "tgamma", "libm.scm",
+ "third", "stuff.scm",
+ "time", "libc.scm",
+ "time.make", "libc.scm",
+ "times->samples", "ws.scm",
+ "timespec.make", "libc.scm",
+ "timespec.tv_nsec", "libc.scm",
+ "timespec.tv_sec", "libc.scm",
+ "tinkling-ground-cricket", "animals.scm",
+ "tmpfile", "libc.scm",
+ "tolower", "libc.scm",
+ "touch-tone", "clm-ins.scm",
+ "toupper", "libc.scm",
+ "townsends-solitaire", "animals.scm",
+ "transform-path", "dlocsig.scm",
+ "translate-path", "dlocsig.scm",
+ "transpose-mixes", "mix.scm",
+ "tree-for-each", "mix.scm",
+ "tree-for-each-reversed", "mix.scm",
+ "tree-member", "stuff.scm",
+ "true", "libc.scm",
+ "trumpeter-swan-1", "animals.scm",
+ "trunc", "libm.scm",
+ "truncate-quotient", "r7rs.scm",
+ "truncate-remainder", "r7rs.scm",
+ "tstall", "peak-phases.scm",
+ "tstallderiv", "peak-phases.scm",
+ "tstallf", "peak-phases.scm",
+ "tsteven", "peak-phases.scm",
+ "tstodd", "peak-phases.scm",
+ "tstoddderiv", "peak-phases.scm",
+ "tstprime", "peak-phases.scm",
+ "ttyname", "libc.scm",
+ "tubebell", "clm-ins.scm",
+ "tufted-titmouse", "animals.scm",
+ "tvf-channel", "clean.scm",
+ "two-tab", "clm-ins.scm",
+ "typecase", "stuff.scm",
+ "typeq?", "stuff.scm",
+ "u8-ready?", "r7rs.scm",
+ "uname", "libc.scm",
+ "unb", "nb.scm",
+ "unbox", "r7rs.scm",
+ "unclip-channel", "dsp.scm",
+ "unclip-sound", "dsp.scm",
+ "uncolor-samples", "draw.scm",
+ "unconvolve", "snddiff.scm",
+ "unconvolve-1", "snddiff.scm",
+ "undisplay-bark-fft", "dsp.scm",
+ "undo-channel", "extensions.scm",
+ "ungetc", "libc.scm",
+ "union", "stuff.scm",
+ "unique-reactive-let-name", "stuff.scm",
+ "unlink", "libc.scm",
+ "unsetenv", "libc.scm",
+ "update-graphs", "examp.scm",
+ "utf8->string", "r7rs.scm",
+ "utime", "libc.scm",
+ "varied-thrush", "animals.scm",
+ "various-gull-cries-from-end-of-colony-5", "bird.scm",
+ "vector->float-vector", "poly.scm",
+ "vector->string", "r7rs.scm",
+ "vector-add!", "poly.scm",
+ "vector-copy", "r7rs.scm",
+ "vector-copy!", "r7rs.scm",
+ "vector-for-each", "r7rs.scm",
+ "vector-map", "r7rs.scm",
+ "vector-scale!", "poly.scm",
+ "verdin", "animals.scm",
+ "vermillion-flycatcher", "animals.scm",
+ "vibro", "examp.scm",
+ "virginia-rail", "animals.scm",
+ "voiced->unvoiced", "examp.scm",
+ "volterra-filter", "dsp.scm",
+ "vox", "clm-ins.scm",
+ "wait", "libc.scm",
+ "waitid", "libc.scm",
+ "waitpid", "libc.scm",
+ "warbling-vireo", "animals.scm",
+ "waveshape", "generators.scm",
+ "waveshape?", "generators.scm",
+ "weighted-moving-average", "generators.scm",
+ "weighted-moving-average?", "generators.scm",
+ "western-meadowlark", "animals.scm",
+ "western-tanager", "animals.scm",
+ "western-toad", "animals.scm",
+ "western-wood-pewee-1", "animals.scm",
+ "western-wood-pewee-2", "animals.scm",
+ "while", "stuff.scm",
+ "whip-poor-will", "animals.scm",
+ "white-breasted-nuthatch", "animals.scm",
+ "white-eyed-vireo", "animals.scm",
+ "white-headed-woodpecker", "animals.scm",
+ "white-throated-sparrow", "animals.scm",
+ "white-tipped-dove", "animals.scm",
+ "whooping-crane", "animals.scm",
+ "willet", "animals.scm",
+ "willow-flycatcher", "animals.scm",
+ "wilsons-warbler", "animals.scm",
+ "window-envelope", "env.scm",
+ "window-rms", "examp.scm",
+ "window-samples", "examp.scm",
+ "with-exception-handler", "r7rs.scm",
+ "with-full-sound", "ws.scm",
+ "with-local-hook", "hooks.scm",
+ "with-marked-sound", "ws.scm",
+ "with-mixed-sound", "ws.scm",
+ "with-mixed-sound->notelist", "ws.scm",
+ "with-mixed-sound-mix-info", "ws.scm",
+ "with-simple-sound", "ws.scm",
+ "with-simple-sound-helper", "ws.scm",
+ "with-sound", "ws.scm",
+ "with-sound-helper", "ws.scm",
+ "with-temp-sound", "ws.scm",
+ "with-temporary-selection", "selection.scm",
+ "wood-duck", "animals.scm",
+ "wordexp", "libc.scm",
+ "wordexp.make", "libc.scm",
+ "wordexp.we_wordc", "libc.scm",
+ "wordexp.we_wordv", "libc.scm",
+ "wordfree", "libc.scm",
+ "wrentit", "animals.scm",
+ "write-au-header", "binary-io.scm",
+ "write-bfloat32", "binary-io.scm",
+ "write-bfloat64", "binary-io.scm",
+ "write-bint16", "binary-io.scm",
+ "write-bint32", "binary-io.scm",
+ "write-bint64", "binary-io.scm",
+ "write-bytevector", "r7rs.scm",
+ "write-chars", "binary-io.scm",
+ "write-flac", "examp.scm",
+ "write-int->bfloat80", "binary-io.scm",
+ "write-lfloat32", "binary-io.scm",
+ "write-lfloat64", "binary-io.scm",
+ "write-lint16", "binary-io.scm",
+ "write-lint32", "binary-io.scm",
+ "write-lint64", "binary-io.scm",
+ "write-ogg", "examp.scm",
+ "write-simple", "r7rs.scm",
+ "write-speex", "examp.scm",
+ "write-u8", "r7rs.scm",
+ "write.scm", "write.scm",
+ "ws-save-state", "ws.scm",
+ "wsdat-play", "ws.scm",
+ "wurley", "clm-ins.scm",
+ "x-norm", "dlocsig.scm",
+ "xe-envelope", "xm-enved.scm",
+ "xparse-path", "dlocsig.scm",
+ "yellow-bellied-flycatcher", "animals.scm",
+ "yellow-green-vireo", "animals.scm",
+ "yellow-rumped-warbler", "animals.scm",
+ "yellow-warbler", "animals.scm",
+ "z-transform", "dsp.scm",
+ "za", "clm-ins.scm",
+ "zc", "clm-ins.scm",
+ "zcomb", "examp.scm",
+ "zecho", "examp.scm",
+ "zero+", "examp.scm",
+ "zero-phase", "dsp.scm",
+ "zip-sound", "zip.scm",
+ "zipper", "zip.scm",
+ "zn", "clm-ins.scm",
+ "zone-tailed-hawk", "animals.scm",
+ "zoom-spectrum", "examp.scm",
+};
+static void autoload_info(s7_scheme *sc)
+{
+ s7_autoload_set_names(sc, snd_names, 5790);
+}
#endif
+
diff --git a/snd-xregion.c b/snd-xregion.c
deleted file mode 100644
index 9cf19d1..0000000
--- a/snd-xregion.c
+++ /dev/null
@@ -1,762 +0,0 @@
-#include "snd.h"
-
-/* -------- region browser -------- */
-
-typedef struct {
- Widget rw, nm, pl;
- int pos;
-} regrow;
-
-static Widget region_dialog = NULL, region_list, region_grf;
-static regrow **region_rows = NULL;
-static int region_rows_size = 0;
-static snd_info *rsp = NULL;
-static int current_region = -1;
-static Widget reg_srtxt, reg_lentxt, reg_chntxt, reg_maxtxt;
-static Widget region_ww = NULL;
-static Widget mix_button = NULL, save_as_button = NULL, insert_button = NULL;
-static regrow *region_row(int n);
-
-
-static void set_current_region(int rg)
-{
- bool reg_ok = false;
- current_region = rg;
- reflect_region_in_save_as_dialog();
- if (rg >= 0)
- reg_ok = region_ok(region_list_position_to_id(rg));
- if (save_as_button) XtSetSensitive(save_as_button, reg_ok);
- if (mix_button) XtSetSensitive(mix_button, reg_ok);
- if (insert_button) XtSetSensitive(insert_button, reg_ok);
-}
-
-
-void reflect_regions_in_region_browser(void)
-{
- if (rsp)
- {
- int i;
- rsp->active = true;
- if (rsp->chans)
- for (i = 0; i < rsp->nchans; i++)
- rsp->chans[i]->active = CHANNEL_HAS_AXES;
- }
-}
-
-
-void reflect_no_regions_in_region_browser(void)
-{
- if (rsp)
- {
- int i;
- rsp->active = false;
- if (rsp->chans)
- for (i = 0; i < rsp->nchans; i++)
- rsp->chans[i]->active = CHANNEL_INACTIVE;
- }
-}
-
-
-static void region_update_graph(chan_info *cp)
-{
- if (current_region == -1) return;
- rsp->nchans = region_chans(region_list_position_to_id(current_region));
- if (rsp->nchans == 0) return;
- update_graph(cp);
- rsp->nchans = 1;
-}
-
-
-void reflect_region_graph_style(void)
-{
- if (current_region == -1) return;
- if ((rsp) &&
- (rsp->chans) &&
- (rsp->chans[0]) &&
- (region_dialog_is_active()))
- {
- rsp->chans[0]->time_graph_style = region_graph_style(ss);
- rsp->chans[0]->dot_size = dot_size(ss);
- /* update_graph(rsp->chans[0]); */
- update_region_browser(true);
- }
-}
-
-
-static void unhighlight_region(void)
-{
- if (current_region != -1)
- {
- regrow *oldr;
- oldr = region_row(current_region);
- XtVaSetValues(oldr->rw, XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(oldr->nm, XmNbackground, ss->highlight_color, NULL);
- }
-}
-
-
-static void highlight_region(void)
-{
- if (current_region != -1)
- {
- regrow *oldr;
- oldr = region_row(current_region);
- XtVaSetValues(oldr->rw, XmNbackground, ss->zoom_color, NULL);
- XtVaSetValues(oldr->nm, XmNbackground, ss->zoom_color, NULL);
- }
-}
-
-
-static void make_region_labels(file_info *hdr)
-{
- char *str;
- if (hdr == NULL) return;
- str = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(str, PRINT_BUFFER_SIZE, "srate: %d", hdr->srate);
- set_label(reg_srtxt, str);
- mus_snprintf(str, PRINT_BUFFER_SIZE, "chans: %d", hdr->chans);
- set_label(reg_chntxt, str);
- mus_snprintf(str, PRINT_BUFFER_SIZE, "length: %.3f", (float)((double)(hdr->samples) / (float)(hdr->chans * hdr->srate)));
- set_label(reg_lentxt, str);
- mus_snprintf(str, PRINT_BUFFER_SIZE, "maxamp: %.3f", region_maxamp(region_list_position_to_id(current_region)));
- set_label(reg_maxtxt, str);
- free(str);
-}
-
-
-void update_region_browser(bool grf_too)
-{
- int i, len;
- region_state *rs;
- chan_info *cp;
-
- rs = region_report();
- len = rs->len;
-
- for (i = 0; i < len; i++)
- {
- regrow *r;
- r = region_row(i);
- set_button_label(r->nm, rs->name[i]);
- XmToggleButtonSetState(r->pl, false, false);
- XtManageChild(r->rw);
- }
-
- for (i = len; i < max_regions(ss); i++)
- if (region_rows[i])
- XtUnmanageChild(region_rows[i]->rw);
-
- free_region_state(rs);
- if (len == 0) return;
-
- XtManageChild(region_list);
- if (grf_too)
- {
- unhighlight_region();
- set_current_region(0);
- highlight_region();
- goto_window(region_rows[0]->nm);
- cp = rsp->chans[0];
- if (cp)
- {
- cp->sound = rsp;
- cp->chan = 0;
- set_sensitive(channel_f(cp), false);
- set_sensitive(channel_w(cp), (region_chans(region_list_position_to_id(0)) > 1));
- rsp->hdr = fixup_region_data(cp, 0, 0);
- make_region_labels(rsp->hdr);
- region_update_graph(cp);
- }
- }
-}
-
-
-static void region_ok_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtUnmanageChild(region_dialog);
-}
-
-
-bool region_browser_is_active(void)
-{
- return((region_dialog) && (XtIsRealized(region_dialog)));
-}
-
-
-static void region_resize_callback(Widget w, XtPointer context, XtPointer info)
-{
- region_update_graph((chan_info *)context);
-}
-
-
-void delete_region_and_update_browser(int pos)
-{
- int act;
- unhighlight_region();
- act = remove_region_from_list(pos);
- if (act == INVALID_REGION) return;
- if (region_dialog)
- {
- if (act != NO_REGIONS)
- {
- set_current_region(0);
- highlight_region();
- goto_window(region_rows[0]->nm);
- }
- else set_current_region(-1);
- update_region_browser(1);
- }
-}
-
-
-static void region_unlist_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (current_region != -1)
- delete_region_and_update_browser(current_region);
-}
-
-
-static void region_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- region_dialog_help();
-}
-
-
-static void region_insert_callback(Widget w, XtPointer context, XtPointer info)
-{
- if ((current_region != -1) &&
- (selected_channel()))
- paste_region(region_list_position_to_id(current_region), selected_channel());
-}
-
-
-static void region_mix_callback(Widget w, XtPointer context, XtPointer info)
-{
- if ((current_region != -1) &&
- (selected_channel()))
- add_region(region_list_position_to_id(current_region), selected_channel());
-}
-
-
-static void region_save_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (current_region != -1)
- make_region_save_as_dialog(true);
-}
-
-
-static void region_up_arrow_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp;
- cp = rsp->chans[0];
- cp->sound = rsp;
- if (cp->chan > 0)
- {
- cp->chan--;
- set_sensitive(channel_f(cp), (cp->chan > 0));
- set_sensitive(channel_w(cp), true);
- fixup_region_data(cp, cp->chan, current_region);
- region_update_graph(cp);
- }
-}
-
-
-static void region_down_arrow_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp;
- cp = rsp->chans[0];
- cp->sound = rsp;
- if ((cp->chan + 1) < region_chans(region_list_position_to_id(current_region)))
- {
- cp->chan++;
- set_sensitive(channel_f(cp), true);
- set_sensitive(channel_w(cp), (region_chans(region_list_position_to_id(current_region)) > (cp->chan + 1)));
- fixup_region_data(cp, cp->chan, current_region);
- region_update_graph(cp);
- }
-}
-
-
-static void region_focus_callback(Widget w, XtPointer context, XtPointer info)
-{
- chan_info *cp;
- regrow *r = (regrow *)context;
-
- unhighlight_region();
- if (region_list_position_to_id(r->pos) == INVALID_REGION) return; /* needed by auto-tester */
- set_current_region(r->pos);
- cp = rsp->chans[0];
- cp->sound = rsp;
- cp->chan = 0;
- highlight_region();
- set_sensitive(channel_f(cp), false);
- set_sensitive(channel_w(cp), (region_chans(region_list_position_to_id(current_region)) > 1));
- rsp->hdr = fixup_region_data(cp, 0, current_region);
- if (rsp->hdr == NULL) return;
- make_region_labels(rsp->hdr);
- region_update_graph(cp);
-}
-
-
-void reflect_play_region_stop(int n)
-{
- if (region_rows)
- {
- regrow *rg;
- rg = region_row(region_id_to_list_position(n));
- if (rg) XmToggleButtonSetState(rg->pl, false, false);
- }
-}
-
-
-static void region_play_callback(Widget w, XtPointer context, XtPointer info)
-{
- regrow *r = (regrow *)context;
- if (XmToggleButtonGetState(r->pl))
- play_region(region_list_position_to_id(r->pos), IN_BACKGROUND);
- else stop_playing_region(region_list_position_to_id(r->pos), PLAY_BUTTON_UNSET);
-}
-
-
-static void region_edit_callback(Widget w, XtPointer context, XtPointer info)
-{
- if (current_region != -1)
- region_edit(current_region);
-}
-
-
-static XEN reflect_file_in_region_browser(XEN reason)
-{
- if (region_dialog)
- {
- bool file_p;
- file_p = (bool)(any_selected_sound());
- set_sensitive(mix_button, file_p);
- set_sensitive(insert_button, file_p);
- }
- return(XEN_FALSE);
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(reflect_file_in_region_browser_w, reflect_file_in_region_browser)
-#else
- #define reflect_file_in_region_browser_w reflect_file_in_region_browser
-#endif
-
-
-char *regrow_get_label(void *ur)
-{
- regrow *r = (regrow *)ur;
- return(get_label(r->nm));
-}
-
-
-int regrow_get_pos(void *ur)
-{
- regrow *r = (regrow *)ur;
- return(r->pos);
-}
-
-
-static void regrow_mouse_enter_label(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- mouse_enter_label(context, REGION_VIEWER);
-}
-
-
-static void regrow_mouse_leave_label(Widget w, XtPointer context, XEvent *event, Boolean *flag)
-{
- mouse_leave_label(context, REGION_VIEWER);
-}
-
-
-static regrow *make_regrow(Widget ww, Widget last_row, XtCallbackProc play_callback, XtCallbackProc name_callback)
-{
- int n;
- Arg args[32];
- regrow *r;
- XmString s1;
- XtCallbackList n1, n3;
-
- s1 = XmStringCreateLocalized((char *)"");
- r = (regrow *)calloc(1, sizeof(regrow));
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, (last_row) ? XmATTACH_WIDGET : XmATTACH_FORM); n++;
- if (last_row) {XtSetArg(args[n], XmNtopWidget, last_row); n++;}
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNheight, 18); n++;
- r->rw = XtCreateWidget("rw", xmFormWidgetClass, ww, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n1 = make_callback_list(play_callback, (XtPointer)r)); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- XtSetArg(args[n], XmNmarginWidth, 8); n++;
- r->pl = make_togglebutton_widget("pl", r->rw, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, r->pl); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNwidth, 300); n++;
- XtSetArg(args[n], XmNactivateCallback, n3 = make_callback_list(name_callback, (XtPointer)r)); n++;
- r->nm = XtCreateManagedWidget("nm", xmPushButtonWidgetClass, r->rw, args, n);
- XmStringFree(s1);
-
- XtAddEventHandler(r->nm, EnterWindowMask, false, regrow_mouse_enter_label, (XtPointer)r);
- XtAddEventHandler(r->nm, LeaveWindowMask, false, regrow_mouse_leave_label, (XtPointer)r);
-
- free(n1);
- free(n3);
- return(r);
-}
-
-
-static void make_region_dialog(void)
-{
- int n, i, id;
- Arg args[32];
- Widget formw, last_row, infosep, fr ,rw;
- Widget editb, unlistb, plw, panes, toppane, sep1 = NULL;
- XmString xok, xinsert, xhelp, titlestr;
- regrow *r;
- chan_info *cp;
-
- xok = XmStringCreateLocalized((char *)"Go Away");
- xhelp = XmStringCreateLocalized((char *)"Help");
- xinsert = XmStringCreateLocalized((char *)"Insert");
- titlestr = XmStringCreateLocalized((char *)"Regions");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNcancelLabelString, xinsert); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNokLabelString, xok); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- region_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"Regions", args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- save_as_button = XtCreateManagedWidget("Save as", xmPushButtonGadgetClass, region_dialog, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- mix_button = XtCreateManagedWidget("Mix", xmPushButtonGadgetClass, region_dialog, args, n);
-
- XtAddCallback(region_dialog, XmNokCallback, region_ok_callback, NULL);
- XtAddCallback(region_dialog, XmNcancelCallback, region_insert_callback, NULL);
- XtAddCallback(region_dialog, XmNhelpCallback, region_help_callback, NULL);
- XtAddCallback(mix_button, XmNactivateCallback, region_mix_callback, NULL);
- XtAddCallback(save_as_button, XmNactivateCallback, region_save_callback, NULL);
-
- XmStringFree(xhelp);
- XmStringFree(xok);
- XmStringFree(xinsert);
- XmStringFree(titlestr);
-
- XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(XmMessageBoxGetChild(region_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- insert_button = XmMessageBoxGetChild(region_dialog, XmDIALOG_CANCEL_BUTTON);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, XmMessageBoxGetChild(region_dialog, XmDIALOG_SEPARATOR)); n++;
- formw = XtCreateManagedWidget("formw", xmFormWidgetClass, region_dialog, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, sep1); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++;
- panes = XtCreateManagedWidget("panes", xmPanedWindowWidgetClass, formw, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- XtSetArg(args[n], XmNpaneMinimum, 40); n++;
- toppane = XtCreateManagedWidget("toppane", xmFormWidgetClass, panes, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- plw = XtCreateManagedWidget("play", xmLabelWidgetClass, toppane, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 70); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, plw); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNscrollingPolicy, XmAUTOMATIC); n++;
- XtSetArg(args[n], XmNscrollBarDisplayPolicy, XmSTATIC); n++;
- region_list = XmCreateScrolledWindow(toppane, (char *)"reglist", args, n);
-
- n = attach_all_sides(args, 0);
- region_ww = XtCreateManagedWidget("ww", xmFormWidgetClass, region_list, args, n);
- XtVaSetValues(region_list,
- XmNworkWindow, region_ww,
- NULL);
-
- map_over_children(region_list, set_main_color_of_widget);
- last_row = NULL;
-
- region_rows = (regrow **)calloc(max_regions(ss), sizeof(regrow *));
- region_rows_size = max_regions(ss);
- for (i = 0; i < max_regions(ss); i++)
- {
- r = make_regrow(region_ww, last_row, region_play_callback, region_focus_callback);
- region_rows[i] = r;
- r->pos = i;
- last_row = r->rw;
- }
-
- update_region_browser(0);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, region_list); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- XtSetArg(args[n], XmNseparatorType, XmNO_LINE); n++;
- XtSetArg(args[n], XmNwidth, 8); n++;
- infosep = XtCreateManagedWidget("infosep", xmSeparatorWidgetClass, toppane, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, infosep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- reg_srtxt = XtCreateManagedWidget("srate:", xmLabelWidgetClass, toppane, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, infosep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, reg_srtxt); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- reg_chntxt = XtCreateManagedWidget("chans:", xmLabelWidgetClass, toppane, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, infosep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, reg_chntxt); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- reg_lentxt = XtCreateManagedWidget("length:", xmLabelWidgetClass, toppane, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, infosep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, reg_lentxt); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- reg_maxtxt = XtCreateManagedWidget("maxamp:", xmLabelWidgetClass, toppane, args, n);
-
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->zoom_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, reg_maxtxt); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, infosep); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 1); n++;
- fr = XtCreateManagedWidget("reg-fr", xmFrameWidgetClass, toppane, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmVERTICAL); n++;
- rw = XtCreateManagedWidget("reg-rw", xmRowColumnWidgetClass, fr, args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNarmColor, ss->red); n++;
- editb = XtCreateManagedWidget("edit", xmPushButtonWidgetClass, rw, args, n);
- XtAddCallback(editb, XmNactivateCallback, region_edit_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->lighter_blue); n++;
- XtSetArg(args[n], XmNarmColor, ss->red); n++;
- unlistb = XtCreateManagedWidget("unlist", xmPushButtonWidgetClass, rw, args, n);
- XtAddCallback(unlistb, XmNactivateCallback, region_unlist_callback, NULL);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->white); n++;
- n = attach_all_sides(args, n);
- XtSetArg(args[n], XmNpaneMinimum, 150); n++;
- region_grf = XtCreateManagedWidget("grf", xmFormWidgetClass, panes, args, n);
-
- XtManageChild(region_dialog);
- if (widget_width(region_dialog) < 400) set_widget_width(region_dialog, 400);
-
- id = region_list_position_to_id(0);
- rsp = make_simple_channel_display(region_srate(id), region_len(id), WITH_ARROWS, region_graph_style(ss), region_grf, WITHOUT_EVENTS);
- rsp->inuse = SOUND_REGION;
- set_current_region(0);
- cp = rsp->chans[0];
- XtVaSetValues(region_rows[0]->nm, XmNbackground, ss->white, XmNforeground, ss->black, NULL);
- map_over_children(panes, color_sashes);
- XtVaSetValues(toppane, XmNpaneMinimum, 1, NULL);
- XtVaSetValues(region_grf, XmNpaneMinimum, 1, NULL);
-
- XtAddCallback(channel_graph(cp), XmNresizeCallback, region_resize_callback, (XtPointer)cp);
- XtAddCallback(channel_graph(cp), XmNexposeCallback, region_resize_callback, (XtPointer)cp);
-
- /* channel_f is up arrow, channel_w is down arrow */
- XtAddCallback(channel_f(cp), XmNactivateCallback, region_up_arrow_callback, NULL);
- XtAddCallback(channel_w(cp), XmNactivateCallback, region_down_arrow_callback, NULL);
- set_sensitive(channel_f(cp), false);
- if (region_chans(region_list_position_to_id(0)) > 1) set_sensitive(channel_w(cp), true);
- cp->chan = 0;
- rsp->hdr = fixup_region_data(cp, 0, 0);
- make_region_labels(rsp->hdr);
- highlight_region();
- region_update_graph(cp);
-
- XEN_ADD_HOOK(ss->snd_open_file_hook, reflect_file_in_region_browser_w, "region-dialog-open-file-watcher", "region dialog open-file-hook handler");
-
- set_dialog_widget(REGION_DIALOG, region_dialog);
-}
-
-
-void view_region_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* put up scrollable dialog describing/playing/editing the region list */
- if (region_dialog == NULL)
- make_region_dialog();
- else raise_dialog(region_dialog);
- if (!XtIsManaged(region_dialog))
- {
- set_current_region(0);
- XtManageChild(region_dialog);
- }
-}
-
-
-bool region_dialog_is_active(void)
-{
- return((region_dialog != NULL) &&
- (XtIsManaged(region_dialog)));
-}
-
-
-void allocate_region_rows(int n)
-{
- if ((region_dialog) &&
- (n > region_rows_size))
- {
- int i;
- region_rows = (regrow **)realloc(region_rows, n * sizeof(regrow *));
- for (i = region_rows_size; i < n; i++) region_rows[i] = NULL;
- region_rows_size = n;
- }
-}
-
-
-static regrow *region_row(int n)
-{
- if (n < region_rows_size)
- {
- regrow *r;
- if (region_rows[n] == NULL)
- {
- r = make_regrow(region_ww,
- (n > 0) ? (region_rows[n - 1]->rw) : NULL,
- region_play_callback, region_focus_callback);
- region_rows[n] = r;
- r->pos = n;
- }
- return(region_rows[n]);
- }
- return(NULL);
-}
-
-
-int region_dialog_region(void)
-{
- return(region_list_position_to_id(current_region));
-}
-
-
-static XEN g_view_regions_dialog(void)
-{
- #define H_view_regions_dialog "(" S_view_regions_dialog "): start the region dialog"
- if (snd_regions() > 0)
- view_region_callback(MAIN_PANE(ss), NULL, NULL);
- return(XEN_WRAP_WIDGET(region_dialog));
-}
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_0(g_view_regions_dialog_w, g_view_regions_dialog)
-#else
-#define g_view_regions_dialog_w g_view_regions_dialog
-#endif
-
-
-void g_init_gxregion(void)
-{
- XEN_DEFINE_PROCEDURE(S_view_regions_dialog, g_view_regions_dialog_w, 0, 0, 0, H_view_regions_dialog);
-}
diff --git a/snd-xsnd.c b/snd-xsnd.c
deleted file mode 100644
index 8c7fcc7..0000000
--- a/snd-xsnd.c
+++ /dev/null
@@ -1,3507 +0,0 @@
-#include "snd.h"
-#include <X11/xpm.h>
-
-#define TOGGLE_MARGIN 0
-
-enum {W_pane,
- W_name_form, W_amp_form,
- W_amp, W_amp_label, W_amp_number,
- W_speed, W_speed_label, W_speed_number, W_speed_arrow,
- W_expand, W_expand_label, W_expand_number, W_expand_button,
- W_contrast, W_contrast_label, W_contrast_number, W_contrast_button,
- W_revscl, W_revscl_label, W_revscl_number,
- W_revlen, W_revlen_label, W_revlen_number, W_reverb_button,
- W_filter_label, W_filter_order, W_filter_env, W_filter, W_filter_button, W_filter_dB, W_filter_hz, W_filter_frame,
- W_filter_order_down, W_filter_order_up,
- W_name, W_lock_or_bomb, W_stop_icon, W_info_label, W_info,
- W_play, W_sync, W_unite, W_close,
- W_error_info_box, W_error_info_frame, W_error_info_label,
- NUM_SND_WIDGETS
-};
-
-
-Widget unite_button(snd_info *sp) {return(sp->snd_widgets[W_unite]);}
-Widget w_snd_pane(snd_info *sp) {return(sp->snd_widgets[W_pane]);}
-
-#define ERROR_INFO(Sp) Sp->snd_widgets[W_error_info_label]
-#define ERROR_INFO_FRAME(Sp) Sp->snd_widgets[W_error_info_frame]
-#define ERROR_INFO_BOX(Sp) Sp->snd_widgets[W_error_info_box]
-
-#define SND_PANE(Sp) Sp->snd_widgets[W_pane]
-#define SND_NAME(Sp) Sp->snd_widgets[W_name]
-
-#define NAME_BOX(Sp) Sp->snd_widgets[W_name_form]
-#define LOCK_OR_BOMB(Sp) Sp->snd_widgets[W_lock_or_bomb]
-#define STOP_ICON(Sp) Sp->snd_widgets[W_stop_icon]
-#define NAME_LABEL(Sp) Sp->snd_widgets[W_name]
-#define MINIBUFFER_LABEL(Sp) Sp->snd_widgets[W_info_label]
-#define MINIBUFFER_TEXT(Sp) Sp->snd_widgets[W_info]
-#define SYNC_BUTTON(Sp) Sp->snd_widgets[W_sync]
-#define PLAY_BUTTON(Sp) Sp->snd_widgets[W_play]
-#define UNITE_BUTTON(Sp) Sp->snd_widgets[W_unite]
-#define CLOSE_BUTTON(Sp) Sp->snd_widgets[W_close]
-
-#define CONTROLS(Sp) Sp->snd_widgets[W_amp_form]
-#define AMP_SCROLLBAR(Sp) Sp->snd_widgets[W_amp]
-#define AMP_LABEL(Sp) Sp->snd_widgets[W_amp_number]
-#define AMP_BUTTON(Sp) Sp->snd_widgets[W_amp_label]
-
-#define SPEED_SCROLLBAR(Sp) Sp->snd_widgets[W_speed]
-#define SPEED_ARROW(Sp) Sp->snd_widgets[W_speed_arrow]
-#define SPEED_LABEL(Sp) Sp->snd_widgets[W_speed_number]
-#define SPEED_BUTTON(Sp) Sp->snd_widgets[W_speed_label]
-
-#define EXPAND_SCROLLBAR(Sp) Sp->snd_widgets[W_expand]
-#define EXPAND_LABEL(Sp) Sp->snd_widgets[W_expand_number]
-#define EXPAND_RIGHT_BUTTON(Sp) Sp->snd_widgets[W_expand_button]
-#define EXPAND_LEFT_BUTTON(Sp) Sp->snd_widgets[W_expand_label]
-
-#define CONTRAST_SCROLLBAR(Sp) Sp->snd_widgets[W_contrast]
-#define CONTRAST_LABEL(Sp) Sp->snd_widgets[W_contrast_number]
-#define CONTRAST_RIGHT_BUTTON(Sp) Sp->snd_widgets[W_contrast_button]
-#define CONTRAST_LEFT_BUTTON(Sp) Sp->snd_widgets[W_contrast_label]
-
-#define REVSCL_SCROLLBAR(Sp) Sp->snd_widgets[W_revscl]
-#define REVLEN_SCROLLBAR(Sp) Sp->snd_widgets[W_revlen]
-#define REVSCL_LABEL(Sp) Sp->snd_widgets[W_revscl_number]
-#define REVLEN_LABEL(Sp) Sp->snd_widgets[W_revlen_number]
-#define REVSCL_BUTTON(Sp) Sp->snd_widgets[W_revscl_label]
-#define REVLEN_BUTTON(Sp) Sp->snd_widgets[W_revlen_label]
-#define REVERB_BUTTON(Sp) Sp->snd_widgets[W_reverb_button]
-
-#define FILTER_ORDER_TEXT(Sp) Sp->snd_widgets[W_filter_order]
-#define FILTER_COEFFS_TEXT(Sp) Sp->snd_widgets[W_filter]
-#define FILTER_BUTTON(Sp) Sp->snd_widgets[W_filter_button]
-#define FILTER_DB_BUTTON(Sp) Sp->snd_widgets[W_filter_dB]
-#define FILTER_HZ_BUTTON(Sp) Sp->snd_widgets[W_filter_hz]
-#define FILTER_LABEL(Sp) Sp->snd_widgets[W_filter_label]
-#define FILTER_GRAPH(Sp) Sp->snd_widgets[W_filter_env]
-#define FILTER_ORDER_UP(Sp) Sp->snd_widgets[W_filter_order_up]
-#define FILTER_ORDER_DOWN(Sp) Sp->snd_widgets[W_filter_order_down]
-#define FILTER_FRAME(Sp) Sp->snd_widgets[W_filter_frame]
-
-#define PROGRESS_ICON(Cp) (Cp)->sound->progress_widgets[(Cp)->chan]
-
-
-int snd_pane_height(snd_info *sp)
-{
- Dimension height;
- XtVaGetValues(SND_PANE(sp), XmNheight, &height, NULL);
- return((int)height);
-}
-
-
-static void watch_minibuffer(Widget w, XtPointer context, XtPointer info)
-{
- clear_minibuffer_error((snd_info *)context);
-}
-
-
-void clear_minibuffer_error(snd_info *sp)
-{
- Dimension height = 20;
- if (sp->minibuffer_height > 5)
- height = sp->minibuffer_height;
- XtUnmanageChild(ERROR_INFO_BOX(sp));
- if (sp->minibuffer_watcher)
- {
- sp->minibuffer_watcher = false;
- XtRemoveCallback(MINIBUFFER_TEXT(sp), XmNvalueChangedCallback, watch_minibuffer, (XtPointer)sp);
- }
- XtUnmanageChild(NAME_BOX(sp));
- XtVaSetValues(NAME_BOX(sp),
- XmNpaneMinimum, height,
- XmNpaneMaximum, height + 1,
- NULL);
- XtManageChild(NAME_BOX(sp));
-}
-
-
-void display_minibuffer_error(snd_info *sp, const char *str)
-{
- XmString s1;
- int lines = 0;
- Dimension y;
-
- if ((!str) || (!(*str)))
- return; /* this is causing a segfault in _XmStringEntryCopy? */
-
- if (sp->minibuffer_height == 0)
- {
- XtVaGetValues(NAME_BOX(sp), XmNheight, &y, NULL);
- sp->minibuffer_height = y;
- }
- s1 = multi_line_label(str, &lines);
-
- XtVaSetValues(ERROR_INFO(sp), XmNlabelString, s1, NULL);
- XmStringFree(s1);
-
- if (!(XtIsManaged(ERROR_INFO_BOX(sp)))) /* else we're simply changing the label of an existing message */
- {
- XtUnmanageChild(NAME_BOX(sp));
- XtVaSetValues(NAME_BOX(sp),
- XmNpaneMinimum, (lines + 2) * 20,
- XmNpaneMaximum, (lines + 2) * 20,
- NULL);
-
- if (!(XtIsManaged(ERROR_INFO_FRAME(sp))))
- XtManageChild(ERROR_INFO_FRAME(sp));
- if (!(XtIsManaged(ERROR_INFO(sp))))
- XtManageChild(ERROR_INFO(sp));
- XtManageChild(ERROR_INFO_BOX(sp));
- XtManageChild(NAME_BOX(sp));
-
- XtVaGetValues(ERROR_INFO_FRAME(sp),
- XmNheight, &y,
- NULL);
- XtVaSetValues(NAME_BOX(sp),
- XmNpaneMinimum, 20,
- XmNpaneMaximum, y + 24,
- NULL);
-
- if (!(sp->minibuffer_watcher))
- {
- sp->minibuffer_watcher = true;
- XtAddCallback(MINIBUFFER_TEXT(sp), XmNvalueChangedCallback, watch_minibuffer, (XtPointer)sp);
- }
- }
-}
-
-
-void goto_minibuffer(snd_info *sp)
-{
- if (sp) goto_window(MINIBUFFER_TEXT(sp));
-}
-
-
-void set_minibuffer_string(snd_info *sp, const char *str, bool update)
-{
- if ((sp->inuse != SOUND_NORMAL) || (!HAS_WIDGETS(sp))) return;
- XmTextSetString(MINIBUFFER_TEXT(sp), (char *)str);
- /* updating clears the entire graph widget and triggers an expose event -- this is evil if we're currently displaying! */
- /* there's also a bug in libxcb (fixed, but not propagated yet) that causes a segfault here if more than
- * one thread is affected by this global X queue flush.
- */
-#if (!HAVE_PTHREADS)
- if (update) XmUpdateDisplay(MINIBUFFER_TEXT(sp));
-#endif
-}
-
-
-void set_minibuffer_cursor_position(snd_info *sp, int pos)
-{
- if ((sp->inuse != SOUND_NORMAL) || (!HAS_WIDGETS(sp))) return;
- XmTextSetCursorPosition(MINIBUFFER_TEXT(sp), pos);
-}
-
-
-char *get_minibuffer_string(snd_info *sp)
-{
- if ((sp->inuse != SOUND_NORMAL) || (!HAS_WIDGETS(sp))) return(NULL);
- return(XmTextGetString(MINIBUFFER_TEXT(sp)));
-}
-
-
-void make_minibuffer_label(snd_info *sp , const char *str)
-{
- if (HAS_WIDGETS(sp))
- {
- XmString s1;
- /* there seems to be no way to get this label to reflect its string width --
- * I have tried everything imaginable with no luck
- */
- s1 = XmStringCreateLocalized((char *)str);
- XtVaSetValues(MINIBUFFER_LABEL(sp),
- XmNlabelString, s1,
- NULL);
- XmStringFree(s1);
- }
-}
-
-
-static void name_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- sp_name_click((snd_info *)context);
-}
-
-
-static void stop_sign_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- if ((ss->checking_explicitly) || (play_in_progress()))
- ss->stopped_explicitly = true;
- stop_playing_all_sounds(PLAY_C_G);
- if (sp->applying) stop_applying(sp);
- for_each_sound_chan(sp, stop_fft_in_progress);
-}
-
-
-/* The 0.9 * SCROLLBAR_MAX reflects the fact that the slider is 10% of the trough, and the left edge of the slider is the readback value */
-
-/* ---------------- AMP-CONTROL ---------------- */
-
-int amp_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0);
- if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
- if (val >= 1.0)
- return(snd_round(0.9 * 0.5 * SCROLLBAR_MAX * (1.0 + (val - 1.0) / (maxval - 1.0))));
- return(snd_round(0.9 * 0.5 * SCROLLBAR_MAX * ((val - minval) / (1.0 - minval))));
-}
-
-
-static int scroll_to_amp(snd_info *sp, int val)
-{
- char amp_number_buffer[6];
- if (val <= 0)
- sp->amp_control = sp->amp_control_min;
- else
- {
- if (val >= (0.9 * SCROLLBAR_MAX))
- sp->amp_control = sp->amp_control_max;
- else
- {
- if (val > (0.5 * 0.9 * SCROLLBAR_MAX))
- sp->amp_control = (((val / (0.5 * 0.9 * SCROLLBAR_MAX)) - 1.0) * (sp->amp_control_max - 1.0)) + 1.0;
- else sp->amp_control = (val * (1.0 - sp->amp_control_min) / (0.5 * 0.9 * SCROLLBAR_MAX)) + sp->amp_control_min;
- }
- }
- mus_snprintf(amp_number_buffer, 6, "%.3f", sp->amp_control);
- set_label(AMP_LABEL(sp), amp_number_buffer);
- return(val);
-}
-
-
-void set_amp(snd_info *sp, mus_float_t val)
-{
- if (!HAS_WIDGETS(sp))
- sp->amp_control = val;
- else XtVaSetValues(AMP_SCROLLBAR(sp),
- XmNvalue,
- scroll_to_amp(sp, amp_to_scroll(sp->amp_control_min, val, sp->amp_control_max)),
- NULL);
-}
-
-
-static void amp_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
- XButtonEvent *ev;
- ev = (XButtonEvent *)(cb->event);
- if (ev->state & (snd_ControlMask | snd_MetaMask))
- set_amp(sp, sp->last_amp_control);
- else set_amp(sp, 1.0);
-}
-
-
-static void amp_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- scroll_to_amp((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
-}
-
-
-static void amp_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
- scroll_to_amp(sp, cb->value);
- sp->last_amp_control = sp->saved_amp_control;
- sp->saved_amp_control = sp->amp_control;
-}
-
-
-/* ---------------- SPEED-CONTROL ---------------- */
-
-XmString initial_speed_label(speed_style_t style)
-{
- /* used also in snd-xmix.c */
- switch (style)
- {
- case SPEED_CONTROL_AS_RATIO: return(XmStringCreateLocalized((char *)" 1/1")); break;
- case SPEED_CONTROL_AS_SEMITONE: return(XmStringCreateLocalized((char *)" 0")); break;
- default: return(XmStringCreateLocalized((char *)" 1.00")); break;
- }
-}
-
-
-static int speed_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0);
- if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
- return(snd_round(0.9 * SCROLLBAR_MAX * ((log(val) - log(minval)) / (log(maxval) - log(minval)))));
-}
-
-
-static int scroll_to_speed(snd_info *sp, int ival)
-{
- char speed_number_buffer[6];
- sp->speed_control = speed_changed(exp((ival * (log(sp->speed_control_max) - log(sp->speed_control_min)) /
- (0.9 * SCROLLBAR_MAX)) +
- log(sp->speed_control_min)),
- speed_number_buffer,
- sp->speed_control_style,
- sp->speed_control_tones,
- 6);
- set_label(SPEED_LABEL(sp), speed_number_buffer);
- /* set_label works with buttons or labels */
- return(ival);
-}
-
-
-void set_speed(snd_info *sp, mus_float_t val)
-{
- if (!HAS_WIDGETS(sp))
- sp->speed_control = val;
- else XtVaSetValues(SPEED_SCROLLBAR(sp),
- XmNvalue,
- scroll_to_speed(sp, speed_to_scroll(sp->speed_control_min, val, sp->speed_control_max)),
- NULL);
-}
-
-
-static void speed_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
- XButtonEvent *ev;
-
-
- ev = (XButtonEvent *)(cb->event);
- if (ev->state & (snd_ControlMask | snd_MetaMask))
- set_speed(sp, sp->last_speed_control);
- else set_speed(sp, 1.0);
-
-#if XEN_HAVE_RATIOS
- if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
- snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
-#endif
-}
-
-
-static void speed_label_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
-
-
- switch (sp->speed_control_style)
- {
- default:
- case SPEED_CONTROL_AS_FLOAT: sp->speed_control_style = SPEED_CONTROL_AS_RATIO; break;
- case SPEED_CONTROL_AS_RATIO: sp->speed_control_style = SPEED_CONTROL_AS_SEMITONE; break;
- case SPEED_CONTROL_AS_SEMITONE: sp->speed_control_style = SPEED_CONTROL_AS_FLOAT; break;
- }
- set_speed(sp, sp->speed_control); /* remake label */
-}
-
-
-static void speed_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
-#if (HAVE_MAKE_RATIO || HAVE_MAKE_RECTANGULAR)
- snd_info *sp = (snd_info *)context;
-#endif
-
-
- scroll_to_speed((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
-
-#if XEN_HAVE_RATIOS
- if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
- snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
-#endif
-}
-
-
-static void speed_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
-
-
- scroll_to_speed(sp, cb->value);
-
-#if XEN_HAVE_RATIOS
- if (sp->speed_control_style == SPEED_CONTROL_AS_RATIO)
- snd_rationalize(sp->speed_control, &(sp->speed_control_numerator), &(sp->speed_control_denominator));
-#endif
- sp->last_speed_control = sp->saved_speed_control;
- sp->saved_speed_control = sp->speed_control;
-}
-
-
-void toggle_direction_arrow(snd_info *sp, bool state)
-{
- if (!HAS_WIDGETS(sp))
- sp->speed_control_direction = ((state) ? -1 : 1);
- else XmToggleButtonSetState(SPEED_ARROW(sp), (Boolean)state, true);
-}
-
-
-/* ---------------- EXPAND-CONTROL ---------------- */
-
-static int expand_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0);
- if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
- return(snd_round(0.9 * SCROLLBAR_MAX * ((log(val) - log(minval)) / (log(maxval) - log(minval)))));
-}
-
-
-static int scroll_to_expand(snd_info *sp, int val)
-{
- char expand_number_buffer[6];
-
- if (val <= 0)
- sp->expand_control = sp->expand_control_min;
- else
- {
- if (val >= (0.9 * SCROLLBAR_MAX))
- sp->expand_control = sp->expand_control_max;
- else sp->expand_control = exp((val * (log(sp->expand_control_max) - log(sp->expand_control_min)) / (0.9 * SCROLLBAR_MAX)) + log(sp->expand_control_min));
- }
-
- if (sp->playing) dac_set_expand(sp, sp->expand_control);
- mus_snprintf(expand_number_buffer, 6, "%.3f", sp->expand_control);
- set_label(EXPAND_LABEL(sp), expand_number_buffer);
- return(val);
-}
-
-
-void set_expand(snd_info *sp, mus_float_t val)
-{
- if (!HAS_WIDGETS(sp))
- sp->expand_control = val;
- else XtVaSetValues(EXPAND_SCROLLBAR(sp),
- XmNvalue,
- scroll_to_expand(sp, expand_to_scroll(sp->expand_control_min, val, sp->expand_control_max)),
- NULL);
-}
-
-
-static void expand_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
- XButtonEvent *ev;
-
-
- ev = (XButtonEvent *)(cb->event);
- if (ev->state & (snd_ControlMask | snd_MetaMask))
- set_expand(sp, sp->last_expand_control);
- else set_expand(sp, 1.0);
-}
-
-
-static void expand_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- scroll_to_expand((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
-}
-
-
-static void expand_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
-
-
- scroll_to_expand(sp, cb->value);
- sp->last_expand_control = sp->saved_expand_control;
- sp->saved_expand_control = sp->expand_control;
-}
-
-
-static void expand_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
-
-
- sp->expand_control_p = cb->set;
- XmChangeColor(EXPAND_SCROLLBAR(sp), (Pixel)((sp->expand_control_p) ? (ss->position_color) : (ss->basic_color)));
-}
-
-
-void toggle_expand_button(snd_info *sp, bool state)
-{
- if (!HAS_WIDGETS(sp))
- sp->expand_control_p = state;
- else XmToggleButtonSetState(EXPAND_RIGHT_BUTTON(sp), (Boolean)state, true);
-}
-
-
-/* ---------------- CONTRAST-CONTROL ---------------- */
-
-static int contrast_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0);
- if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
- return(snd_round((val - minval) / (maxval - minval) * 0.9 * SCROLLBAR_MAX));
-}
-
-
-static int scroll_to_contrast(snd_info *sp, int val)
-{
- char contrast_number_buffer[6];
- sp->contrast_control = sp->contrast_control_min + val * (sp->contrast_control_max - sp->contrast_control_min) / (0.9 * SCROLLBAR_MAX);
- mus_snprintf(contrast_number_buffer, 6, "%.3f", sp->contrast_control);
- set_label(CONTRAST_LABEL(sp), contrast_number_buffer);
- return(val);
-}
-
-
-void set_contrast(snd_info *sp, mus_float_t val)
-{
- if (!HAS_WIDGETS(sp))
- sp->contrast_control = val;
- else XtVaSetValues(CONTRAST_SCROLLBAR(sp),
- XmNvalue,
- scroll_to_contrast(sp, contrast_to_scroll(sp->contrast_control_min, val, sp->contrast_control_max)),
- NULL);
-}
-
-
-static void contrast_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
- XButtonEvent *ev;
-
-
- ev = (XButtonEvent *)(cb->event);
- if (ev->state & (snd_ControlMask | snd_MetaMask))
- set_contrast(sp, sp->last_contrast_control);
- else set_contrast(sp, 0.0);
-}
-
-
-static void contrast_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- scroll_to_contrast((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
-}
-
-
-static void contrast_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
-
-
- scroll_to_contrast(sp, cb->value);
- sp->last_contrast_control = sp->saved_contrast_control;
- sp->saved_contrast_control = sp->contrast_control;
-}
-
-
-static void contrast_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
-
-
- sp->contrast_control_p = cb->set;
- XmChangeColor(CONTRAST_SCROLLBAR(sp), (Pixel)((sp->contrast_control_p) ? (ss->position_color) : (ss->basic_color)));
-}
-
-
-void toggle_contrast_button(snd_info *sp, bool state)
-{
- if (!HAS_WIDGETS(sp))
- sp->contrast_control_p = state;
- else XmToggleButtonSetState(CONTRAST_RIGHT_BUTTON(sp), (Boolean)state, true);
-}
-
-
-/* ---------------- REVERB-CONTROL-SCALE ---------------- */
-
-static int revscl_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0);
- if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
- return(snd_round(0.9 * SCROLLBAR_MAX * (pow(val, 0.333) - pow(minval, 0.333)) / (pow(maxval, 0.333) - pow(minval, 0.333))));
-}
-
-
-static mus_float_t cube(mus_float_t a) {return(a*a*a);}
-
-
-static int scroll_to_revscl(snd_info *sp, int val)
-{
- char revscl_number_buffer[7];
-
- if (val <= 0)
- sp->reverb_control_scale = sp->reverb_control_scale_min;
- else
- {
- if (val >= (0.9 * SCROLLBAR_MAX))
- sp->reverb_control_scale = sp->reverb_control_scale_max;
- else sp->reverb_control_scale = cube((val * (pow(sp->reverb_control_scale_max, 0.333) - pow(sp->reverb_control_scale_min, 0.333)) /
- (0.9 * SCROLLBAR_MAX)) +
- pow(sp->reverb_control_scale_min, 0.333));
- }
-
- mus_snprintf(revscl_number_buffer, 7, "%.4f", sp->reverb_control_scale);
- set_label(REVSCL_LABEL(sp), revscl_number_buffer);
- return(val);
-}
-
-
-void set_revscl(snd_info *sp, mus_float_t val)
-{
- if (!HAS_WIDGETS(sp))
- sp->reverb_control_scale = val;
- else XtVaSetValues(REVSCL_SCROLLBAR(sp),
- XmNvalue,
- scroll_to_revscl(sp, revscl_to_scroll(sp->reverb_control_scale_min, val, sp->reverb_control_scale_max)),
- NULL);
-}
-
-
-static void revscl_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
- XButtonEvent *ev;
-
-
- ev = (XButtonEvent *)(cb->event);
- if (ev->state & (snd_ControlMask | snd_MetaMask))
- set_revscl(sp, sp->last_reverb_control_scale);
- else set_revscl(sp, 0.0);
-}
-
-
-static void revscl_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- scroll_to_revscl((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
-}
-
-
-static void revscl_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
-
-
- scroll_to_revscl(sp, cb->value);
- sp->last_reverb_control_scale = sp->saved_reverb_control_scale;
- sp->saved_reverb_control_scale = sp->reverb_control_scale;
-}
-
-
-/* ---------------- REVERB-CONTROL-LENGTH ---------------- */
-
-static int revlen_to_scroll(mus_float_t minval, mus_float_t val, mus_float_t maxval)
-{
- if (val <= minval) return(0);
- if (val >= maxval) return((int)(0.9 * SCROLLBAR_MAX));
- return(snd_round((val - minval) / (maxval - minval) * 0.9 * SCROLLBAR_MAX));
-}
-
-
-static int scroll_to_revlen(snd_info *sp, int val)
-{
- char revlen_number_buffer[5];
-
- sp->reverb_control_length = sp->reverb_control_length_min +
- (sp->reverb_control_length_max - sp->reverb_control_length_min) * (mus_float_t)val / (0.9 * SCROLLBAR_MAX);
- mus_snprintf(revlen_number_buffer, 5, "%.2f", sp->reverb_control_length);
- set_label(REVLEN_LABEL(sp), revlen_number_buffer);
- return(val);
-}
-
-
-void set_revlen(snd_info *sp, mus_float_t val)
-{
- if (!HAS_WIDGETS(sp))
- sp->reverb_control_length = val;
- else XtVaSetValues(REVLEN_SCROLLBAR(sp),
- XmNvalue,
- scroll_to_revlen(sp, revlen_to_scroll(sp->reverb_control_length_min, val, sp->reverb_control_length_max)),
- NULL);
-}
-
-
-static void revlen_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmPushButtonCallbackStruct *cb = (XmPushButtonCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
- XButtonEvent *ev;
-
-
- ev = (XButtonEvent *)(cb->event);
- if (ev->state & (snd_ControlMask | snd_MetaMask))
- set_revlen(sp, sp->last_reverb_control_length);
- else set_revlen(sp, 1.0);
-}
-
-
-static void revlen_drag_callback(Widget w, XtPointer context, XtPointer info)
-{
- scroll_to_revlen((snd_info *)context, ((XmScrollBarCallbackStruct *)info)->value);
-}
-
-
-static void revlen_valuechanged_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScrollBarCallbackStruct *cb = (XmScrollBarCallbackStruct *)info;
- snd_info *sp = (snd_info *)context;
-
-
- scroll_to_revlen(sp, cb->value);
- sp->last_reverb_control_length = sp->saved_reverb_control_length;
- sp->saved_reverb_control_length = sp->reverb_control_length;
-}
-
-
-static void reverb_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
-
-
- sp->reverb_control_p = cb->set;
- XmChangeColor(REVLEN_SCROLLBAR(sp), (Pixel)((sp->reverb_control_p) ? (ss->position_color) : (ss->basic_color)));
- XmChangeColor(REVSCL_SCROLLBAR(sp), (Pixel)((sp->reverb_control_p) ? (ss->position_color) : (ss->basic_color)));
-}
-
-
-void toggle_reverb_button(snd_info *sp, bool state)
-{
- if (!HAS_WIDGETS(sp))
- sp->reverb_control_p = state;
- else XmToggleButtonSetState(REVERB_BUTTON(sp), (Boolean)state, true);
-}
-
-
-/* ---------------- FILTER_CONTROL ---------------- */
-
-static void filter_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- sp->filter_control_p = cb->set;
-}
-
-
-void toggle_filter_button(snd_info *sp, bool state)
-{
- if (!HAS_WIDGETS(sp))
- sp->filter_control_p = state;
- else XmToggleButtonSetState(FILTER_BUTTON(sp), (Boolean)state, true);
-}
-
-
-static void filter_textfield_deactivate(snd_info *sp)
-{
- chan_info *active_chan;
- active_chan = any_selected_channel(sp);
- if (active_chan)
- goto_window(channel_graph(active_chan));
-}
-
-
-#define MIN_FILTER_GRAPH_HEIGHT 20
-
-void display_filter_env(snd_info *sp)
-{
- graphics_context *ax;
- int height, width;
- Widget drawer;
- env_editor *edp;
-
- if (!(snd_ok(sp))) return; /* autotest close + lagging X updates */
-
- edp = sp->flt;
- drawer = FILTER_GRAPH(sp);
- height = widget_height(drawer);
- if (height < MIN_FILTER_GRAPH_HEIGHT) return;
-
- width = widget_width(drawer);
- ax = (graphics_context *)calloc(1, sizeof(graphics_context));
- ax->gc = ss->fltenv_basic_gc;
- ax->wn = XtWindow(drawer);
- ax->dp = XtDisplay(drawer);
-
- XClearWindow(ax->dp, ax->wn);
- edp->in_dB = sp->filter_control_in_dB;
- edp->with_dots = true;
-
- if (sp->filter_control_in_hz)
- sp->filter_control_xmax = (mus_float_t)(SND_SRATE(sp) / 2);
- else sp->filter_control_xmax = 1.0;
-
- if (sp->filter_control_envelope == NULL)
- sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
-
- env_editor_display_env(edp, sp->filter_control_envelope, ax, "frequency response", 0, 0, width, height, NOT_PRINTING);
- if (edp->edited)
- {
- ax->gc = ss->fltenv_data_gc;
- display_frequency_response(sp->filter_control_envelope,
- (SOUND_ENV_EDITOR(sp))->axis, ax,
- sp->filter_control_order,
- sp->filter_control_in_dB);
- }
- free(ax);
-}
-
-
-void set_filter_text(snd_info *sp, const char *str)
-{
- if (HAS_WIDGETS(sp))
- XmTextSetString(FILTER_COEFFS_TEXT(sp), (char *)str);
-}
-
-#if HAVE_OSX
-static int press_x, press_y;
-#endif
-
-
-static void filter_drawer_button_motion(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- snd_info *sp = (snd_info *)context;
- XMotionEvent *ev = (XMotionEvent *)event;
- env_editor *edp;
-#if HAVE_OSX
- if ((press_x == ev->x) && (press_y == ev->y)) return;
-#endif
- edp = sp->flt;
- edp->in_dB = sp->filter_control_in_dB;
- env_editor_button_motion(edp, ev->x, ev->y, ev->time, sp->filter_control_envelope);
- display_filter_env(sp);
- sp->filter_control_changed = true;
-}
-
-
-static void filter_drawer_button_press(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- snd_info *sp = (snd_info *)context;
- XButtonEvent *ev = (XButtonEvent *)event;
- env_editor *edp;
- if (!(sp->filter_control_envelope)) return;
-#if HAVE_OSX
- press_x = ev->x;
- press_y = ev->y;
-#endif
- edp = sp->flt;
- edp->in_dB = sp->filter_control_in_dB;
- if (env_editor_button_press(edp, ev->x, ev->y, ev->time, sp->filter_control_envelope))
- display_filter_env(sp);
-}
-
-
-static void filter_drawer_button_release(Widget w, XtPointer context, XEvent *event, Boolean *cont)
-{
- char *tmpstr = NULL;
- snd_info *sp = (snd_info *)context;
- env_editor_button_release(SOUND_ENV_EDITOR(sp), sp->filter_control_envelope);
- display_filter_env(sp);
- set_filter_text(sp, tmpstr = env_to_string(sp->filter_control_envelope));
- if (tmpstr) free(tmpstr);
- sp->filter_control_changed = true;
-}
-
-
-static void filter_drawer_resize(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- display_filter_env(sp);
-}
-
-
-static void filter_dB_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- sp->filter_control_in_dB = (cb->set);
- display_filter_env(sp);
-}
-
-
-void set_filter_in_dB(snd_info *sp, bool val)
-{
- sp->filter_control_in_dB = val;
- if (HAS_WIDGETS(sp))
- {
- XmToggleButtonSetState(FILTER_DB_BUTTON(sp), (Boolean)val, false);
- display_filter_env(sp);
- }
-}
-
-
-static void new_in_hz(snd_info *sp, bool val)
-{
- sp->filter_control_in_hz = val;
- if (val)
- sp->filter_control_xmax = (mus_float_t)(SND_SRATE(sp) / 2);
- else sp->filter_control_xmax = 1.0;
- if (sp->filter_control_envelope) free_env(sp->filter_control_envelope);
- sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
-}
-
-
-static void filter_hz_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- new_in_hz(sp, cb->set);
- display_filter_env(sp);
-}
-
-
-void set_filter_in_hz(snd_info *sp, bool val)
-{
- new_in_hz(sp, val);
- if (HAS_WIDGETS(sp))
- {
- XmToggleButtonSetState(FILTER_HZ_BUTTON(sp), (Boolean)val, false);
- display_filter_env(sp);
- }
-}
-
-
-void set_filter_order(snd_info *sp, int order)
-{
- if (order & 1) order++;
- if (order <= 0) order = 2;
- sp->filter_control_order = order;
- if (HAS_WIDGETS(sp))
- {
- widget_int_to_text(FILTER_ORDER_TEXT(sp), order);
- display_filter_env(sp);
- }
- sp->filter_control_changed = true;
-}
-
-
-static void filter_order_up_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- set_filter_order(sp, sp->filter_control_order + 2);
-}
-
-
-static void filter_order_down_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- if (sp->filter_control_order > 2)
- set_filter_order(sp, sp->filter_control_order - 2);
-}
-
-
-static void get_filter_order(snd_info *sp, char *str)
-{
- int order;
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- order = string_to_int(str, 1, "filter order");
- redirect_errors_to(NULL, NULL);
- if (order & 1) order++;
- if (order <= 0) order = 2;
- sp->filter_control_order = order;
-}
-
-
-static void filter_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* make an envelope out of the data */
- snd_info *sp = (snd_info *)context;
- char *str = NULL;
- XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *)info;
- XKeyEvent *ev;
- KeySym keysym;
- ev = (XKeyEvent *)(cb->event);
- keysym = XKeycodeToKeysym(XtDisplay(w),
- (int)(ev->keycode),
- (ev->state & snd_ShiftMask) ? 1 : 0);
- if ((ev->state & snd_MetaMask) &&
- ((keysym == snd_K_p) || (keysym == snd_K_P) || (keysym == snd_K_n) || (keysym == snd_K_N)))
- {
- restore_filter_string(sp, (keysym == snd_K_p) || (keysym == snd_K_P));
- return;
- }
- str = XmTextGetString(w);
- if ((str) && (*str)) remember_filter_string(sp, str);
-
- if (sp->filter_control_envelope) sp->filter_control_envelope = free_env(sp->filter_control_envelope);
- redirect_errors_to(errors_to_minibuffer, (void *)sp);
- sp->filter_control_envelope = string_to_env((const char *)str);
- redirect_errors_to(NULL, NULL);
- if (str) XtFree(str);
- if (!(sp->filter_control_envelope)) /* maybe user cleared text field? */
- sp->filter_control_envelope = default_env(sp->filter_control_xmax, 1.0);
- str = XmTextGetString(FILTER_ORDER_TEXT(sp));
- if ((str) && (*str))
- {
- get_filter_order(sp, str);
- XtFree(str);
- }
- (SOUND_ENV_EDITOR(sp))->edited = true;
- display_filter_env(sp);
- filter_textfield_deactivate(sp);
- sp->filter_control_changed = true;
-}
-
-
-static void filter_order_activate_callback(Widget w, XtPointer context, XtPointer info)
-{
- char *str;
- snd_info *sp = (snd_info *)context;
- str = XmTextGetString(w);
- if ((str) && (*str))
- {
- get_filter_order(sp, str);
- sp->filter_control_changed = true;
- display_filter_env(sp);
- XtFree(str);
- }
- filter_textfield_deactivate(sp);
-}
-
-
-void filter_env_changed(snd_info *sp, env *e)
-{
- /* turn e back into a string for textfield widget */
- if (HAS_WIDGETS(sp))
- {
- char *tmpstr = NULL;
- XmTextSetString(FILTER_COEFFS_TEXT(sp), tmpstr = env_to_string(e));
- if (tmpstr) free(tmpstr);
- (SOUND_ENV_EDITOR(sp))->edited = true;
- display_filter_env(sp);
- }
- sp->filter_control_changed = true;
-}
-
-
-/* ---------------- PLAY BUTTON ---------------- */
-
-void set_play_button(snd_info *sp, bool val)
-{
- if (HAS_WIDGETS(sp))
- XmToggleButtonSetState(PLAY_BUTTON(sp), (Boolean)val, false);
- set_open_file_play_button(val);
-}
-
-
-static void play_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- chan_info *cp;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- XButtonEvent *ev;
-
- ev = (XButtonEvent *)(cb->event);
-
- if (sp->playing)
- stop_playing_sound(sp, PLAY_BUTTON_UNSET);
-
- ss->tracking = ((with_tracking_cursor(ss)) ||
- ((cb->set) &&
- (ev->state & (snd_ControlMask | snd_MetaMask))));
-
- cp = any_selected_channel(sp);
- goto_graph(cp);
- if (cb->set)
- {
- XtVaSetValues(w, XmNselectColor, (ss->tracking) ? ss->green : ss->selection_color, NULL);
- play_sound(sp, 0, NO_END_SPECIFIED);
- }
-}
-
-
-typedef struct {bool pausing; } pause_data;
-
-static void set_play_button_pause(snd_info *sp, void *ptr)
-{
- if ((sp->playing) && (HAS_WIDGETS(sp)))
- {
- pause_data *pd = (pause_data *)ptr;
- Widget w;
- w = PLAY_BUTTON(sp);
- if (pd->pausing)
- XtVaSetValues(w, XmNselectColor, ss->red, NULL);
- else XtVaSetValues(w, XmNselectColor, (ss->tracking) ? ss->green : ss->selection_color, NULL);
- }
-}
-
-
-void play_button_pause(bool pausing)
-{
- pause_data *pd;
- pd = (pause_data *)calloc(1, sizeof(pause_data));
- pd->pausing = pausing;
- for_each_sound_with_void(set_play_button_pause, (void *)pd);
- free(pd);
-}
-
-
-void set_control_panel_play_button(snd_info *sp)
-{
- if (HAS_WIDGETS(sp))
- {
- set_toggle_button(PLAY_BUTTON(sp), false, false, sp);
- XtVaSetValues(PLAY_BUTTON(sp), XmNselectColor, ss->selection_color, NULL);
- }
-}
-
-
-static void play_arrow_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- bool dir;
- dir = (bool)(cb->set);
- if (dir) sp->speed_control_direction = -1; else sp->speed_control_direction = 1;
-}
-
-
-/* ---------------- SYNC BUTTON ---------------- */
-
-static void set_sync_color(snd_info *sp)
-{
- Widget syb;
- syb = SYNC_BUTTON(sp);
- switch (sp->sync)
- {
- case 1: case 0: XtVaSetValues(syb, XmNselectColor, ss->selection_color, NULL); break;
- case 2: XtVaSetValues(syb, XmNselectColor, ss->green, NULL); break;
- case 3: XtVaSetValues(syb, XmNselectColor, ss->yellow, NULL); break;
- case 4: XtVaSetValues(syb, XmNselectColor, ss->red, NULL); break;
- default: XtVaSetValues(syb, XmNselectColor, ss->black, NULL); break;
- }
-}
-
-
-void syncb(snd_info *sp, int on)
-{
- sp->sync = on;
- if (on > ss->sound_sync_max) ss->sound_sync_max = on;
- if (HAS_WIDGETS(sp))
- {
- set_sync_color(sp);
- XmToggleButtonSetState(SYNC_BUTTON(sp), (on != 0), false); /* need actual bool here, not a cast! */
- }
-}
-
-
-static void sync_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- XButtonEvent *ev;
-
-
- ev = (XButtonEvent *)(cb->event);
- if (cb->set)
- if (ev->state & snd_ControlMask)
- if (ev->state & snd_MetaMask)
- if (ev->state & snd_ShiftMask)
- sp->sync = 4;
- else sp->sync = 3;
- else sp->sync = 2;
- else sp->sync = 1;
- else sp->sync = 0;
-
- set_sync_color(sp);
-
- if (sp->sync != 0)
- {
- chan_info *cp;
- if (sp->sync > ss->sound_sync_max) ss->sound_sync_max = sp->sync;
- cp = sp->lacp;
- if (cp == NULL) cp = any_selected_channel(sp);
- goto_graph(cp);
- if (cp->cursor_on) sync_cursors(cp, CURSOR(cp));
- apply_x_axis_change(cp->axis, cp);
- }
-}
-
-
-/* ---------------- UNITE BUTTON ---------------- */
-
-static void unite_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* click if set unsets, click if unset->combine, ctrl-click->superimpose */
- snd_info *sp = (snd_info *)context;
- XmToggleButtonCallbackStruct *cb = (XmToggleButtonCallbackStruct *)info;
- XButtonEvent *ev;
- channel_style_t val;
- ev = (XButtonEvent *)(cb->event);
-
- if (cb->set)
- {
- if (ev->state & (snd_ControlMask | snd_MetaMask))
- val = CHANNELS_SUPERIMPOSED;
- else val = CHANNELS_COMBINED;
- }
- else val = CHANNELS_SEPARATE;
-
- set_sound_channel_style(sp, val);
-}
-
-
-/* ---------------- CLOSE BUTTON ---------------- */
-
-static void close_button_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_close_file((snd_info *)context);
-}
-
-
-
-static void minibuffer_click_callback(Widget w, XtPointer context, XtPointer info)
-{
- /* can be response to various things */
- snd_info *sp = (snd_info *)context;
- XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *)info;
- XKeyEvent *ev;
- KeySym keysym;
- ev = (XKeyEvent *)(cb->event);
- keysym = XKeycodeToKeysym(XtDisplay(w),
- (int)(ev->keycode),
- (ev->state & snd_ShiftMask) ? 1 : 0);
- snd_minibuffer_activate(sp, keysym, (ev->state & snd_MetaMask));
-}
-
-
-/* apply is only safe if the DAC is currently inactive and remains safe only
- * if all other apply buttons are locked out (and play).
- */
-
-/* relative panes needs to notice overall window resize, but there's no way to do so in Motif, as far as I can tell */
-
-#if WITH_RELATIVE_PANES
-/* It would be nice if we could set a paned window to keep its children relative
- * amounts the same upon outside resize, but the Paned Window widget doesn't
- * have a resize callback, and no obvious way to advise the resize mechanism.
- * An attempt to get the same effect by wrapping w_pane in a drawingarea widget
- * ran into other troubles (the thing is seriously confused about its size).
- * You'd naively think the Actions "Start" and "Commit" could be used, since
- * XtActions are said to be a list of XtActionProcs, but I can't find a way to add
- * my action without deactivating the built-in action of the same name --
- * XtAugmentTranslations ignores new actions if the old exists, XtOverride
- * replaces the old, etc. (And XtActions involve far more complexity than
- * anyone should have to endure).
- *
- * so... drop down into the sashes...(using undocumented stuff throughout this code)
- */
-#include <Xm/SashP.h>
-
-
-static void sash_lock_control_panel(snd_info *sp)
-{
- if (showing_controls(sp))
- {
- /* lock to its current size */
- int hgt;
- hgt = control_panel_height(sp);
- XtVaSetValues(CONTROLS(sp),
- XmNpaneMinimum, hgt,
- XmNpaneMaximum, hgt,
- NULL);
- }
-}
-
-
-static void sash_unlock_control_panel(snd_info *sp)
-{
- if (showing_controls(sp))
- {
- XtVaSetValues(CONTROLS(sp),
- XmNpaneMinimum, 1,
- XmNpaneMaximum, LOTSA_PIXELS,
- NULL);
- }
-}
-
-
-static int outer_panes = 0;
-static int *inner_panes = NULL;
-static Dimension *outer_sizes = NULL;
-static Dimension **inner_sizes = NULL;
-
-static void watch_sash(Widget w, XtPointer closure, XtPointer info)
-{
- SashCallData call_data = (SashCallData)info;
- /* call_data->params[0]: Commit, Move, Key, Start (as strings) */
-
- if ((call_data->params) &&
- (call_data->params[0]) &&
- (with_relative_panes(ss)) &&
- (sound_style(ss) == SOUNDS_VERTICAL))
- {
- int i, k;
- snd_info *sp;
- if (mus_strcmp(call_data->params[0], "Start"))
- {
- int outer_ctr = 0;
- for (i = 0; i < ss->max_sounds; i++)
- {
- sp = ss->sounds[i];
- if ((sp) &&
- (sp->inuse == SOUND_NORMAL) &&
- (sp->nchans > 1) &&
- (sp->channel_style == CHANNELS_SEPARATE))
- outer_panes++;
- }
-
- for_each_sound(sash_lock_control_panel);
-
- if (outer_panes > 0)
- {
- inner_panes = (int *)calloc(outer_panes, sizeof(int));
- outer_sizes = (Dimension *)calloc(outer_panes, sizeof(Dimension));
- inner_sizes = (Dimension **)calloc(outer_panes, sizeof(Dimension *));
- outer_ctr = 0;
-
- for (i = 0; i < ss->max_sounds; i++)
- {
- sp = ss->sounds[i];
- if ((sp) &&
- (sp->inuse == SOUND_NORMAL) &&
- (sp->nchans > 1) &&
- (sp->channel_style == CHANNELS_SEPARATE))
- {
- Widget child;
- child = SND_PANE(sp);
- inner_panes[outer_ctr] = sp->nchans;
- inner_sizes[outer_ctr] = (Dimension *)calloc(sp->nchans, sizeof(Dimension));
- XtVaGetValues(child, XmNheight, &(outer_sizes[outer_ctr]), NULL);
-
- for (k = 0; k < sp->nchans; k++)
- XtVaGetValues(channel_main_pane(sp->chans[k]), XmNheight, &(inner_sizes[outer_ctr][k]), NULL);
-
- outer_ctr++;
- if (outer_ctr >= outer_panes) break;
- }
- }
- }
- }
- else
- {
- if (mus_strcmp(call_data->params[0], "Commit")) /* release sash */
- {
- if (outer_panes > 0)
- {
- int outer_ctr = 0;
- Dimension cur_outer_size = 0;
-
- for (i = 0; i < ss->max_sounds; i++)
- {
- sp = ss->sounds[i];
- if ((sp) &&
- (sp->inuse == SOUND_NORMAL) &&
- (sp->nchans > 1) &&
- (sp->channel_style == CHANNELS_SEPARATE))
- {
- XtVaGetValues(SND_PANE(sp), XmNheight, &cur_outer_size, NULL);
-
- if ((cur_outer_size > 40) &&
- (abs(cur_outer_size - outer_sizes[outer_ctr]) > (sp->nchans * 2)))
- {
- /* this pane has multiple chans and its size has changed enough to matter */
- Dimension total_inner = 0, diff;
- int size;
- float ratio;
-
- for (k = 0; k < sp->nchans; k++)
- total_inner += inner_sizes[outer_ctr][k];
- diff = outer_sizes[outer_ctr] - total_inner; /* this is non-channel stuff */
-
- for (k = 0; k < sp->nchans; k++)
- XtUnmanageChild(channel_main_pane(sp->chans[k]));
-
- ratio = (float)(cur_outer_size - diff) / (float)(outer_sizes[outer_ctr] - diff);
- if (ratio > 0.0)
- {
- for (k = 0; k < sp->nchans; k++)
- {
- size = (int)(ratio * inner_sizes[outer_ctr][k]);
- XtVaSetValues(channel_main_pane(sp->chans[k]),
- XmNpaneMinimum, size - 1,
- XmNpaneMaximum, size + 1,
- NULL);
- }
- for (k = 0; k < sp->nchans; k++)
- XtManageChild(channel_main_pane(sp->chans[k]));
- for (k = 0; k < sp->nchans; k++)
- XtVaSetValues(channel_main_pane(sp->chans[k]),
- XmNpaneMinimum, 1,
- XmNpaneMaximum, LOTSA_PIXELS,
- NULL);
- }
- }
- outer_ctr++;
- }
- }
-
- for (i = 0; i < outer_panes; i++)
- if (inner_sizes[i])
- free(inner_sizes[i]);
- free(inner_panes);
- free(inner_sizes);
- free(outer_sizes);
- outer_panes = 0;
- }
-
- for_each_sound(sash_unlock_control_panel);
- }
- }
- }
-}
-
-static Widget *sashes = NULL;
-static int sashes_size = 0;
-
-static void remember_sash(Widget w)
-{
- /* add callback only once (means remembering which widgets already have our callback */
- int loc = -1;
- if (sashes_size == 0)
- {
- sashes = (Widget *)calloc(16, sizeof(Widget));
- sashes_size = 16;
- loc = 0;
- }
- else
- {
- int i;
- for (i = 0; i < sashes_size; i++)
- {
- if (sashes[i] == w) return;
- if (sashes[i] == NULL)
- {
- loc = i;
- break;
- }
- }
- if (loc == -1)
- {
- sashes = (Widget *)realloc(sashes, sashes_size * 2 * sizeof(Widget));
- for (i = sashes_size; i < sashes_size * 2; i++) sashes[i] = NULL;
- loc = sashes_size;
- sashes_size *= 2;
- }
- }
- sashes[loc] = w;
- XtAddCallback(w, XmNcallback, watch_sash, NULL);
-}
-
-
-static void add_sash_watchers(Widget w)
-{
- /* if relative panes, add sash watchers to the outer paned window sashes (SOUND_PANE(ss)) */
- unsigned int i;
- CompositeWidget cw = (CompositeWidget)w;
- for (i = 0; i < cw->composite.num_children; i++) /* only outermost sashes count here */
- {
- Widget child;
- child = cw->composite.children[i];
- if ((XtIsWidget(child)) &&
- (XtIsManaged(child)) &&
- (XtIsSubclass(child, xmSashWidgetClass)))
- remember_sash(child);
- }
-}
-
-#endif
-
-
-static bool cant_write(char *name)
-{
-#if HAVE_ACCESS
- return((access(name, W_OK)) != 0);
-#else
- return(false);
-#endif
-}
-
-
-/* bitmaps for the playback direction arrow */
-
-static unsigned char speed_r_bits1[] = {
- 0x00, 0x04, 0x10, 0x08, 0x00, 0x10, 0x04, 0x20, 0x00, 0x40, 0xa5, 0xbf,
- 0x00, 0x40, 0x04, 0x20, 0x00, 0x10, 0x10, 0x08, 0x00, 0x04, 0x00, 0x00};
-static unsigned char speed_l_bits1[] = {
- 0x20, 0x00, 0x10, 0x08, 0x08, 0x00, 0x04, 0x20, 0x02, 0x00, 0xfd, 0xa5,
- 0x02, 0x00, 0x04, 0x20, 0x08, 0x00, 0x10, 0x08, 0x20, 0x00, 0x00, 0x00};
-
-static Pixmap mini_lock = 0;
-static Pixmap close_icon = 0;
-static Pixmap blank_pixmap = 0;
-static bool mini_lock_allocated = false;
-static Pixmap bombs[NUM_BOMBS];
-static Pixmap hourglasses[NUM_HOURGLASSES];
-static Pixmap stop_sign = 0;
-
-void show_lock(snd_info *sp)
-{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- if (mini_lock)
- {
- XtVaSetValues(LOCK_OR_BOMB(sp), XmNlabelPixmap, mini_lock, NULL);
- }
- MUS_UNLOCK(sp->stop_sign_lock);
- }
-}
-
-
-void hide_lock(snd_info *sp)
-{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- if (mini_lock)
- {
- XtVaSetValues(LOCK_OR_BOMB(sp), XmNlabelPixmap, blank_pixmap, NULL);
- }
- /* these Pixmaps can be null if the colormap is screwed up */
- MUS_UNLOCK(sp->stop_sign_lock);
- }
-}
-
-
-static void show_stop_sign(snd_info *sp)
-{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- if (stop_sign)
- XtVaSetValues(STOP_ICON(sp), XmNlabelPixmap, stop_sign, NULL);
- MUS_UNLOCK(sp->stop_sign_lock);
- }
-}
-
-
-static void hide_stop_sign(snd_info *sp)
-{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- if (blank_pixmap)
- XtVaSetValues(STOP_ICON(sp), XmNlabelPixmap, blank_pixmap, NULL);
- MUS_UNLOCK(sp->stop_sign_lock);
- }
-}
-
-
-void show_bomb(snd_info *sp)
-{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- if (sp->bomb_ctr >= NUM_BOMBS)
- sp->bomb_ctr = 0;
- if (bombs[sp->bomb_ctr])
- {
- XtVaSetValues(LOCK_OR_BOMB(sp), XmNlabelPixmap, bombs[sp->bomb_ctr], NULL);
- }
- sp->bomb_ctr++;
- MUS_UNLOCK(sp->stop_sign_lock);
- }
-}
-
-
-void hide_bomb(snd_info *sp)
-{
- if (!HAS_WIDGETS(sp)) return;
- if (MUS_TRY_LOCK(sp->stop_sign_lock) != MUS_ALREADY_LOCKED)
- {
- XtVaSetValues(LOCK_OR_BOMB(sp), XmNlabelPixmap, blank_pixmap, NULL);
- sp->bomb_ctr = 0;
- MUS_UNLOCK(sp->stop_sign_lock);
- }
-}
-
-
-#define BOMB_TIME 200
-
-static void tick_bomb(XtPointer context, XtIntervalId *id)
-{
- snd_info *sp = (snd_info *)context;
- if (!HAS_WIDGETS(sp)) return;
- if ((sp->need_update) || (sp->file_unreadable))
- {
- show_bomb(sp);
- XtAppAddTimeOut(MAIN_APP(ss),
- (unsigned long)BOMB_TIME,
- (XtTimerCallbackProc)tick_bomb,
- context);
- }
- else
- {
- hide_bomb(sp);
- sp->bomb_in_progress = false;
- }
-}
-
-
-void start_bomb(snd_info *sp)
-{
- if (!HAS_WIDGETS(sp)) return;
- sp->bomb_ctr = 0;
- if (!(sp->bomb_in_progress))
- {
- sp->bomb_in_progress = true;
- XtAppAddTimeOut(MAIN_APP(ss),
- (unsigned long)BOMB_TIME,
- (XtTimerCallbackProc)tick_bomb,
- (void *)sp);
- }
-}
-
-
-void stop_bomb(snd_info *sp)
-{
- if (!HAS_WIDGETS(sp)) return;
- hide_bomb(sp);
- sp->bomb_in_progress = false;
-}
-
-
-static char *bits_to_string(const char **icon)
-{
- /* show first few lines */
- char *buf;
- buf = (char *)calloc(128, sizeof(char));
- mus_snprintf(buf, 128, "\n%s\n%s\n%s...", icon[0], icon[1], icon[2]);
- return(buf);
-}
-
-
-static void allocate_icons(Widget w)
-{
- Pixmap shape1, shape2, shape3, shape4;
- XpmAttributes attributes;
- XpmColorSymbol symbols[1];
- int scr, k, pixerr = XpmSuccess;
- Display *dp;
- Drawable wn;
-
- dp = XtDisplay(w);
- wn = XtWindow(w);
- scr = DefaultScreen(dp);
- XtVaGetValues(w, XmNdepth, &attributes.depth, XmNcolormap, &attributes.colormap, NULL);
- attributes.visual = DefaultVisual(dp, scr);
- symbols[0].name = (char *)"basiccolor";
- symbols[0].value = NULL;
- symbols[0].pixel = ss->basic_color;
- attributes.colorsymbols = symbols;
- attributes.numsymbols = 1;
- attributes.valuemask = XpmColorSymbols | XpmDepth | XpmColormap | XpmVisual;
-
- pixerr = XpmCreatePixmapFromData(dp, wn, (char **)mini_lock_bits(), &mini_lock, &shape1, &attributes);
- if (pixerr != XpmSuccess)
- snd_error("lock pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(mini_lock_bits()));
-
- pixerr = XpmCreatePixmapFromData(dp, wn, (char **)blank_bits(), &blank_pixmap, &shape1, &attributes);
- if (pixerr != XpmSuccess)
- snd_error("blank pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(blank_bits()));
-
- pixerr = XpmCreatePixmapFromData(dp, wn, (char **)stop_sign_bits(), &stop_sign, &shape4, &attributes);
- if (pixerr != XpmSuccess)
- snd_error("stop sign pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(stop_sign_bits()));
-
- pixerr = XpmCreatePixmapFromData(dp, wn, (char **)close_icon_bits(), &close_icon, &shape1, &attributes);
- if (pixerr != XpmSuccess)
- snd_error("stop sign pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(close_icon_bits()));
-
- for (k = 0; k < NUM_BOMBS; k++)
- {
- pixerr = XpmCreatePixmapFromData(dp, wn, (char **)mini_bomb_bits(k), &(bombs[k]), &shape2, &attributes);
- if (pixerr != XpmSuccess)
- {
- snd_error("bomb pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(mini_bomb_bits(k)));
- break;
- }
- pixerr = XpmCreatePixmapFromData(dp, wn, (char **)mini_glass_bits(k), &(hourglasses[k]), &shape3, &attributes);
- if (pixerr != XpmSuccess)
- {
- snd_error("glass pixmap trouble: %s from %s\n", XpmGetErrorString(pixerr), bits_to_string(mini_glass_bits(k)));
- break;
- }
- }
- mini_lock_allocated = true;
-}
-
-
-static void change_pixmap_background(Widget w, Pixmap orig, Pixel old_color, Pixel new_color, int width, int height)
-{
- XImage *before;
- Display *dp;
- Drawable wn;
- Visual *vis;
- XGCValues v;
- GC draw_gc;
- int depth, depth_bytes, x, y;
- char *data;
-
- dp = XtDisplay(w);
- wn = XtWindow(w);
- vis = DefaultVisual(dp, DefaultScreen(dp));
- XtVaGetValues(w, XmNdepth, &depth, NULL);
- depth_bytes = (depth >> 3);
-
- data = (char *)calloc((width + 1) * (height + 1) * depth_bytes, sizeof(char)); /* not calloc since X will free this */
- /* there's overflow in X here, apparently -- the +1's fix it according to valgrind */
- /* perhaps this is supposed to be rounded up to byte boundaries? */
-
- before = XCreateImage(dp, vis, depth, XYPixmap, 0, data, width, height, 8, 0);
- XGetSubImage(dp, orig, 0, 0, width, height, AllPlanes, XYPixmap, before, 0, 0);
-
- v.background = new_color;
- draw_gc = XCreateGC(dp, wn, GCBackground, &v);
- XSetBackground(dp, draw_gc, new_color);
-
- for (x = 0; x < width; x++)
- for (y = 0; y < height; y++)
- if (XGetPixel(before, x, y) == old_color)
- XPutPixel(before, x, y, new_color);
-
- XPutImage(dp, orig, draw_gc, before, 0, 0, 0, 0, width, height);
- XDestroyImage(before); /* frees data as well */
- XFreeGC(dp, draw_gc);
-}
-
-
-void make_sound_icons_transparent_again(Pixel old_color, Pixel new_color)
-{
- int i;
- if (!mini_lock_allocated) allocate_icons(MAIN_SHELL(ss));
- change_pixmap_background(MAIN_SHELL(ss), mini_lock, old_color, new_color, 16, 14);
- change_pixmap_background(MAIN_SHELL(ss), blank_pixmap, old_color, new_color, 16, 14);
- change_pixmap_background(MAIN_SHELL(ss), close_icon, old_color, new_color, 16, 14);
- /* change_pixmap_background(MAIN_SHELL(ss), stop_sign, old_color, new_color, 17, 17); */
- /* memory corruption here! */
- for (i = 0; i < NUM_BOMBS; i++)
- change_pixmap_background(MAIN_SHELL(ss), bombs[i], old_color, new_color, 16, 14);
- for (i = 0; i < NUM_HOURGLASSES; i++)
- change_pixmap_background(MAIN_SHELL(ss), hourglasses[i], old_color, new_color, 16, 14);
-}
-
-
-static Pixmap spd_r, spd_l;
-static bool spd_ok = false;
-
-static void close_sound_dialog(Widget w, XtPointer context, XtPointer info)
-{
- snd_info *sp = (snd_info *)context;
- if (sp) snd_close_file(sp);
-}
-
-
-static void manage_sync_button(snd_info *sp)
-{
- XtManageChild(SYNC_BUTTON(sp));
-}
-
-
-static void attach_minibuffer(snd_info *sp)
-{
- XtUnmanageChild(MINIBUFFER_TEXT(sp));
- XtVaSetValues(MINIBUFFER_TEXT(sp),
- XmNrightAttachment, XmATTACH_WIDGET,
- XmNrightWidget, (XtIsManaged(UNITE_BUTTON(sp))) ? UNITE_BUTTON(sp) : ((XtIsManaged(SYNC_BUTTON(sp))) ? SYNC_BUTTON(sp) : PLAY_BUTTON(sp)),
- NULL);
- XtManageChild(MINIBUFFER_TEXT(sp));
-}
-
-
-snd_info *add_sound_window(char *filename, read_only_t read_only, file_info *hdr)
-{
- snd_info *sp = NULL, *osp;
- Widget *sw;
- XmString s1;
- int snd_slot, nchans = 1, i, k, n, old_chans;
- bool make_widgets;
- Arg args[32];
- char *old_name = NULL, *title;
- Dimension app_dy, screen_y, chan_min_y;
- Position app_y;
- /* these dimensions are used to try to get a reasonable channel graph size without falling off the screen bottom */
- Pixmap rb, lb;
- int depth;
- bool free_filename = false;
- Widget form;
- XtCallbackList n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12;
- Atom sound_delete;
-
- if (ss->translated_filename)
- {
- old_name = filename;
- filename = ss->translated_filename;
- free_filename = true;
- ss->translated_filename = NULL;
- }
-
- nchans = hdr->chans;
- if (nchans <= 0) nchans = 1;
- XtVaGetValues(MAIN_SHELL(ss),
- XmNy, &app_y,
- XmNheight, &app_dy,
- NULL);
- screen_y = DisplayHeight(MAIN_DISPLAY(ss),
- DefaultScreen(MAIN_DISPLAY(ss)));
- app_dy = (screen_y - app_y - app_dy - 20 * nchans);
- chan_min_y = (Dimension)(app_dy / (Dimension)nchans);
- if (chan_min_y > (Dimension)(ss->channel_min_height))
- chan_min_y = ss->channel_min_height;
- else
- if (chan_min_y < 5)
- chan_min_y = 5;
-
- snd_slot = find_free_sound_slot(nchans); /* expands sound list if needed */
- if (ss->sounds[snd_slot]) /* we're trying to re-use an old, inactive set of widgets and whatnot */
- {
- osp = ss->sounds[snd_slot];
- old_chans = osp->allocated_chans;
- }
- else old_chans = 0;
- make_widgets = (ss->sounds[snd_slot] == NULL);
- ss->sounds[snd_slot] = make_snd_info(ss->sounds[snd_slot], filename, hdr, snd_slot, read_only);
- sp = ss->sounds[snd_slot];
- sp->inuse = SOUND_NORMAL;
- sp->bomb_ctr = 0;
- sp->write_date = file_write_date(filename); /* needed early in this process by the peak-env handlers */
-
- if (sp->snd_widgets == NULL)
- sp->snd_widgets = (Widget *)calloc(NUM_SND_WIDGETS, sizeof(Widget));
- sw = sp->snd_widgets;
-
- if ((!make_widgets) && (old_chans < nchans))
- {
- for (i = old_chans; i < nchans; i++)
- add_channel_window(sp, i, chan_min_y, 1, NULL, WITH_FW_BUTTONS, WITH_EVENTS);
- }
-
- if (make_widgets)
- {
- if ((sound_style(ss) == SOUNDS_IN_SEPARATE_WINDOWS))
- {
- title = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(title, PRINT_BUFFER_SIZE, "%d: %s", snd_slot, sp->short_filename);
- if (sp->dialog == NULL)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- sp->dialog = XtCreatePopupShell(title, xmDialogShellWidgetClass, MAIN_SHELL(ss), args, n);
- /* using popup shell here gets around the problem that the shell passes resize requests to all its children
- * -- as a popup, it's not considered a child, but that means we don't inherit things like popup menus from
- * the main shell.
- */
- sound_delete = XmInternAtom(XtDisplay(sp->dialog), (char *)"WM_DELETE_WINDOW", false);
- XmAddWMProtocolCallback(sp->dialog, sound_delete, close_sound_dialog, (XtPointer)sp);
- }
- else XtVaSetValues(sp->dialog, XmNtitle, title, NULL);
- free(title);
- if (!XtIsManaged(sp->dialog)) XtManageChild(sp->dialog);
- }
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- n = attach_all_sides(args, n);
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNsashIndent, ss->channel_sash_indent); n++;
- XtSetArg(args[n], XmNpaneMaximum, LOTSA_PIXELS); n++; /* Xm/Paned.c initializes this to 1000! */
- if (ss->channel_sash_size != 0)
- {
- XtSetArg(args[n], XmNsashHeight, ss->channel_sash_size); n++;
- XtSetArg(args[n], XmNsashWidth, ss->channel_sash_size); n++;
- }
-
- /* if (mumble_style(ss) == CHANNELS_HORIZONTAL) {XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;} */
- /* this doesn't work yet because the control panel is screwed up when trying to display itself horizontally */
- /* Perhaps another layer of panes? */
-
- if (sound_style(ss) == SOUNDS_VERTICAL)
- {
- if (ss->toolbar)
- XtSetArg(args[n], XmNpositionIndex, snd_slot + 1);
- else XtSetArg(args[n], XmNpositionIndex, snd_slot);
- n++;
- }
- XtSetArg(args[n], XmNuserData, sp->index); n++;
-
- if (sound_style(ss) == SOUNDS_IN_SEPARATE_WINDOWS)
- SND_PANE(sp) = XtCreateManagedWidget("snd-pane", xmPanedWindowWidgetClass, sp->dialog, args, n);
- else
- {
- unsigned int i;
- CompositeWidget cw = (CompositeWidget)SOUND_PANE(ss);
- SND_PANE(sp) = XtCreateManagedWidget("snd-pane", xmPanedWindowWidgetClass, SOUND_PANE(ss), args, n);
-
- /* try to make the division between sounds more obvious */
- for (i = 0; i < cw->composite.num_children; i++)
- {
- Widget child;
- child = cw->composite.children[i];
- if (((XtIsWidget(child))|| (XmIsGadget(child))) &&
- (XtIsManaged(child)) &&
- ((XmIsSeparator(child)) || (XmIsSeparatorGadget(child))))
- XtVaSetValues(child, XmNseparatorType, XmDOUBLE_LINE,
- XmNbackground, ss->white,
- NULL);
- }
- }
-
- XtAddEventHandler(SND_PANE(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- /* if user clicks in controls, then starts typing, try to send key events to current active channel */
- /* all widgets in the control-pane that would otherwise intercept the key events get this event handler */
-
- for (i = 0; i < nchans; i++)
- add_channel_window(sp, i, chan_min_y, 0, NULL, WITH_FW_BUTTONS, WITH_EVENTS);
- /* creates channel (horizontal) paned window widget as child of w_snd_pane(sp) == SND_PANE(sp) */
-
-
- /* -------- sound file name, minibuffer, various buttons -------- */
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNpaneMinimum, 20); n++;
- XtSetArg(args[n], XmNpaneMaximum, 20); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- NAME_BOX(sp) = XtCreateManagedWidget("snd-name-form", xmFormWidgetClass, SND_PANE(sp), args, n);
- XtAddEventHandler(NAME_BOX(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- if (!mini_lock_allocated)
- allocate_icons(NAME_BOX(sp));
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
- XtSetArg(args[n], XmNlabelPixmap, close_icon); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNwidth, 32); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- CLOSE_BUTTON(sp) = XtCreateManagedWidget("close-button", xmPushButtonWidgetClass, NAME_BOX(sp), args, n);
- XtAddCallback(CLOSE_BUTTON(sp), XmNactivateCallback, close_button_callback, (XtPointer)sp);
-
- n = 0;
- s1 = XmStringCreateLocalized(shortname_indexed(sp));
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- /* XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++; */
-
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, CLOSE_BUTTON(sp)); n++;
-
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- NAME_LABEL(sp) = XtCreateManagedWidget("snd-name", xmPushButtonWidgetClass, NAME_BOX(sp), args, n);
- XtAddEventHandler(NAME_LABEL(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(NAME_LABEL(sp), XmNactivateCallback, name_click_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, NAME_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
-
- if (blank_pixmap)
- {
- /* if xpm failed (blank_pixmap == 0), this can cause X to kill Snd! */
- XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
- XtSetArg(args[n], XmNlabelPixmap, blank_pixmap); n++;
- }
-
- LOCK_OR_BOMB(sp) = XtCreateManagedWidget("", xmLabelWidgetClass, NAME_BOX(sp), args, n);
-
- {
- int i;
- Widget left_widget;
-
- left_widget = LOCK_OR_BOMB(sp);
- sp->progress_widgets = (Widget *)calloc(sp->nchans, sizeof(Widget));
- sp->num_progress_widgets = sp->nchans;
- /* when an unused sound is reopened in snd-data.c, it's possible for its channel number
- * to be increased. If we then try to draw the clock icon in the new channel, its
- * widget will be unallocated -> segfault, so to keep things simple, we check this number.
- */
-
- for (i = 0; i < sp->nchans; i++)
- {
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
-
- if (blank_pixmap)
- {
- /* if xpm failed (blank_pixmap == 0), this can cause X to kill Snd! */
- XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
- XtSetArg(args[n], XmNlabelPixmap, blank_pixmap); n++;
- }
-
- sp->progress_widgets[i] = XtCreateManagedWidget("", xmLabelWidgetClass, NAME_BOX(sp), args, n);
- left_widget = sp->progress_widgets[i];
- }
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, left_widget); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
-
- if (blank_pixmap)
- {
- XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
- XtSetArg(args[n], XmNlabelPixmap, blank_pixmap); n++;
- }
-
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- STOP_ICON(sp) = XtCreateManagedWidget("", xmPushButtonWidgetClass, NAME_BOX(sp), args, n);
- XtAddCallback(STOP_ICON(sp), XmNactivateCallback, stop_sign_click_callback, (XtPointer)sp);
- }
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)" ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, STOP_ICON(sp)); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, STOP_ICON(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- MINIBUFFER_LABEL(sp) = XtCreateManagedWidget("snd-info-label", xmLabelWidgetClass, NAME_BOX(sp), args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, MINIBUFFER_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNresizeWidth, true); n++;
- XtSetArg(args[n], XmNmarginHeight, 1); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- MINIBUFFER_TEXT(sp) = make_textfield_widget("snd-info", NAME_BOX(sp), args, n, ACTIVATABLE, add_completer_func(info_completer, (void *)sp));
- XtAddCallback(MINIBUFFER_TEXT(sp), XmNactivateCallback, minibuffer_click_callback, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
-#ifdef TOGGLE_MARGIN
- XtSetArg(args[n], XmNmarginHeight, TOGGLE_MARGIN); n++;
- XtSetArg(args[n], XmNmarginTop, TOGGLE_MARGIN); n++;
-#endif
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- /* in Motif 2.2 this sets up a tooltip:
- XtSetArg(args[n], XmNtoolTipString, XmStringCreateLocalized((char *)"play this sound")); n++;
- */
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- PLAY_BUTTON(sp) = make_togglebutton_widget("play", NAME_BOX(sp), args, n);
- XtAddCallback(PLAY_BUTTON(sp), XmNvalueChangedCallback, play_button_callback, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
-#ifdef TOGGLE_MARGIN
- XtSetArg(args[n], XmNmarginHeight, TOGGLE_MARGIN); n++;
- XtSetArg(args[n], XmNmarginTop, TOGGLE_MARGIN); n++;
-#endif
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, PLAY_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- SYNC_BUTTON(sp) = make_togglebutton_widget("sync", NAME_BOX(sp), args, n);
- XtAddEventHandler(SYNC_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(SYNC_BUTTON(sp), XmNvalueChangedCallback, sync_button_callback, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNbottomWidget, SYNC_BUTTON(sp)); n++;
-#ifdef TOGGLE_MARGIN
- XtSetArg(args[n], XmNmarginHeight, TOGGLE_MARGIN); n++;
- XtSetArg(args[n], XmNmarginTop, TOGGLE_MARGIN); n++;
-#endif
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, SYNC_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- UNITE_BUTTON(sp) = make_togglebutton_widget("unite", NAME_BOX(sp), args, n);
- XtAddEventHandler(UNITE_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(UNITE_BUTTON(sp), XmNvalueChangedCallback, unite_button_callback, (XtPointer)sp);
-
- /* error display */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, MINIBUFFER_TEXT(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- ERROR_INFO_BOX(sp) = XtCreateWidget("error-box", xmRowColumnWidgetClass, NAME_BOX(sp), args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- ERROR_INFO_FRAME(sp) = XtCreateManagedWidget("error-frame", xmFrameWidgetClass, ERROR_INFO_BOX(sp), args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- ERROR_INFO(sp) = XtCreateManagedWidget("error-info", xmLabelWidgetClass, ERROR_INFO_FRAME(sp), args, n);
-
-
- /* ---------------- control panel ---------------- */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- CONTROLS(sp) = XtCreateManagedWidget("snd-amp", xmFormWidgetClass, SND_PANE(sp), args, n);
- XtAddEventHandler(CONTROLS(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- /* AMP */
- s1 = XmStringCreateLocalized((char *)"amp:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- AMP_BUTTON(sp) = make_pushbutton_widget("amp-label", CONTROLS(sp), args, n);
- XtAddEventHandler(AMP_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(AMP_BUTTON(sp), XmNactivateCallback, amp_click_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"1.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, AMP_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, AMP_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginRight, 3); n++;
- AMP_LABEL(sp) = XtCreateManagedWidget("amp-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, AMP_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, AMP_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, amp_to_scroll(sp->amp_control_min, 1.0, sp->amp_control_max)); n++;
- XtSetArg(args[n], XmNdragCallback, n1 = make_callback_list(amp_drag_callback, (XtPointer)sp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n2 = make_callback_list(amp_valuechanged_callback, (XtPointer)sp)); n++;
- AMP_SCROLLBAR(sp) = XtCreateManagedWidget("amp", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
- XtAddEventHandler(AMP_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- /* SPEED */
- s1 = XmStringCreateLocalized((char *)"speed:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, AMP_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- SPEED_BUTTON(sp) = make_pushbutton_widget("speed-label", CONTROLS(sp), args, n);
- XtAddEventHandler(SPEED_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(SPEED_BUTTON(sp), XmNactivateCallback, speed_click_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- s1 = initial_speed_label(sp->speed_control_style);
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, SPEED_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, SPEED_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNmarginRight, 3); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- SPEED_LABEL(sp) = make_pushbutton_widget("speed-number", CONTROLS(sp), args, n);
- XtAddEventHandler(SPEED_LABEL(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(SPEED_LABEL(sp), XmNactivateCallback, speed_label_click_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, SPEED_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNindicatorOn, false); n++;
- XtSetArg(args[n], XmNlabelType, XmPIXMAP); n++;
- XtSetArg(args[n], XmNmarginHeight, 0); n++;
- XtSetArg(args[n], XmNmarginWidth, 0); n++;
- XtSetArg(args[n], XmNmarginTop, 0); n++;
- XtSetArg(args[n], XmNtopOffset, 0); n++;
- SPEED_ARROW(sp) = make_togglebutton_widget("dir", CONTROLS(sp), args, n);
- form = SPEED_ARROW(sp);
- if (!spd_ok)
- {
- rb = XCreateBitmapFromData(XtDisplay(form), RootWindowOfScreen(XtScreen(form)), (const char *)speed_r_bits1, 16, 12);
- lb = XCreateBitmapFromData(XtDisplay(form), RootWindowOfScreen(XtScreen(form)), (const char *)speed_l_bits1, 16, 12);
- XtVaGetValues(form, XmNdepth, &depth, NULL);
- spd_r = XCreatePixmap(XtDisplay(form), RootWindowOfScreen(XtScreen(form)), 16, 12, depth);
- spd_l = XCreatePixmap(XtDisplay(form), RootWindowOfScreen(XtScreen(form)), 16, 12, depth);
- XCopyPlane(XtDisplay(form), rb, spd_r, ss->fltenv_basic_gc, 0, 0, 16, 12, 0, 0, 1);
- XCopyPlane(XtDisplay(form), lb, spd_l, ss->fltenv_basic_gc, 0, 0, 16, 12, 0, 0, 1);
- XFreePixmap(XtDisplay(form), rb);
- XFreePixmap(XtDisplay(form), lb);
- spd_ok = true;
- }
- XtVaSetValues(form, XmNselectPixmap, spd_l, XmNlabelPixmap, spd_r, NULL);
- XtAddEventHandler(SPEED_ARROW(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(SPEED_ARROW(sp), XmNvalueChangedCallback, play_arrow_callback, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->position_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, SPEED_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, SPEED_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, SPEED_ARROW(sp)); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, speed_to_scroll(sp->speed_control_min, 1.0, sp->speed_control_max)); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNdragCallback, n3 = make_callback_list(speed_drag_callback, (XtPointer)sp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n4 = make_callback_list(speed_valuechanged_callback, (XtPointer)sp)); n++;
- SPEED_SCROLLBAR(sp) = XtCreateManagedWidget("speed-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
- XtAddEventHandler(SPEED_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- n = 0;
- /* EXPAND */
- s1 = XmStringCreateLocalized((char *)"expand:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, SPEED_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- EXPAND_LEFT_BUTTON(sp) = make_pushbutton_widget("expand-label", CONTROLS(sp), args, n);
- XtAddEventHandler(EXPAND_LEFT_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(EXPAND_LEFT_BUTTON(sp), XmNactivateCallback, expand_click_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"1.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, EXPAND_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, EXPAND_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginRight, 3); n++;
- EXPAND_LABEL(sp) = XtCreateManagedWidget("expand-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, EXPAND_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNmarginWidth, 0); n++;
- XtSetArg(args[n], XmNtopOffset, 1); n++;
- XtSetArg(args[n], XmNspacing, 0); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- EXPAND_RIGHT_BUTTON(sp) = make_togglebutton_widget("expoff", CONTROLS(sp), args, n);
- XtAddEventHandler(EXPAND_RIGHT_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(EXPAND_RIGHT_BUTTON(sp), XmNvalueChangedCallback, expand_button_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, EXPAND_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, EXPAND_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, EXPAND_RIGHT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, expand_to_scroll(sp->expand_control_min, 1.0, sp->expand_control_max)); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNdragCallback, n5 = make_callback_list(expand_drag_callback, (XtPointer)sp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n6 = make_callback_list(expand_valuechanged_callback, (XtPointer)sp)); n++;
- EXPAND_SCROLLBAR(sp) = XtCreateManagedWidget("expand-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
- XtAddEventHandler(EXPAND_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
-
- /* CONTRAST */
- n = 0;
- s1 = XmStringCreateLocalized((char *)"contrast:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, EXPAND_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- CONTRAST_LEFT_BUTTON(sp) = make_pushbutton_widget("contrast-label", CONTROLS(sp), args, n);
- XtAddEventHandler(CONTRAST_LEFT_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(CONTRAST_LEFT_BUTTON(sp), XmNactivateCallback, contrast_click_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"1.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginRight, 3); n++;
- CONTRAST_LABEL(sp) = XtCreateManagedWidget("contrast-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNmarginWidth, 0); n++;
- XtSetArg(args[n], XmNtopOffset, 1); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNspacing, 0); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- CONTRAST_RIGHT_BUTTON(sp) = make_togglebutton_widget("conoff", CONTROLS(sp), args, n);
- XtAddEventHandler(CONTRAST_RIGHT_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(CONTRAST_RIGHT_BUTTON(sp), XmNvalueChangedCallback, contrast_button_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, CONTRAST_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, CONTRAST_RIGHT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNvalue, 0); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNdragCallback, n7 = make_callback_list(contrast_drag_callback, (XtPointer)sp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n8 = make_callback_list(contrast_valuechanged_callback, (XtPointer)sp)); n++;
- CONTRAST_SCROLLBAR(sp) = XtCreateManagedWidget("contrast-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
- XtAddEventHandler(CONTRAST_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- /* REVERB */
- /* REVSCL */
- n = 0;
- s1 = XmStringCreateLocalized((char *)"reverb:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, CONTRAST_LEFT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- REVSCL_BUTTON(sp) = make_pushbutton_widget("revscl-label", CONTROLS(sp), args, n);
- XtAddEventHandler(REVSCL_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(REVSCL_BUTTON(sp), XmNactivateCallback, revscl_click_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"0.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, REVSCL_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, REVSCL_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNmarginRight, 3); n++;
- REVSCL_LABEL(sp) = XtCreateManagedWidget("revscl-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, REVSCL_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, REVSCL_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 60); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, 0); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNdragCallback, n9 = make_callback_list(revscl_drag_callback, (XtPointer)sp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n10 = make_callback_list(revscl_valuechanged_callback, (XtPointer)sp)); n++;
- REVSCL_SCROLLBAR(sp) = XtCreateManagedWidget("revscl-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
- XtAddEventHandler(REVSCL_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- /* REVOFF */
- n = 0;
- s1 = XmStringCreateLocalized((char *)"");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, REVSCL_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, CONTRAST_RIGHT_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNmarginWidth, 0); n++;
- XtSetArg(args[n], XmNtopOffset, 1); n++;
- XtSetArg(args[n], XmNspacing, 0); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- REVERB_BUTTON(sp) = make_togglebutton_widget("revoff", CONTROLS(sp), args, n);
- XtAddEventHandler(REVERB_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(REVERB_BUTTON(sp), XmNvalueChangedCallback, reverb_button_callback, (XtPointer)sp);
- XmStringFree(s1);
-
-
- /* REVLEN */
- n = 0;
- s1 = XmStringCreateLocalized((char *)"len:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, REVSCL_SCROLLBAR(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 60); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- REVLEN_BUTTON(sp) = make_pushbutton_widget("revlen-label", CONTROLS(sp), args, n);
- XtAddEventHandler(REVLEN_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(REVLEN_BUTTON(sp), XmNactivateCallback, revlen_click_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"1.0 ");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, REVLEN_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, REVLEN_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNmarginRight, 3); n++;
- REVLEN_LABEL(sp) = XtCreateManagedWidget("revlen-number", xmLabelWidgetClass, CONTROLS(sp), args, n);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, REVLEN_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, REVLEN_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, REVERB_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNorientation, XmHORIZONTAL); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNmaximum, SCROLLBAR_MAX); n++;
- XtSetArg(args[n], XmNvalue, revlen_to_scroll(sp->reverb_control_length_min, 1.0, sp->reverb_control_length_max)); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNdragCallback, n11 = make_callback_list(revlen_drag_callback, (XtPointer)sp)); n++;
- XtSetArg(args[n], XmNvalueChangedCallback, n12 = make_callback_list(revlen_valuechanged_callback, (XtPointer)sp)); n++;
- REVLEN_SCROLLBAR(sp) = XtCreateManagedWidget("revlen-scroll", xmScrollBarWidgetClass, CONTROLS(sp), args, n);
- XtAddEventHandler(REVLEN_SCROLLBAR(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
-
- /* FILTER */
- n = 0;
- s1 = XmStringCreateLocalized((char *)"filter:");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, REVSCL_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- XtSetArg(args[n], XmNshadowThickness, 0); n++;
- XtSetArg(args[n], XmNhighlightThickness, 0); n++;
- XtSetArg(args[n], XmNfillOnArm, false); n++;
- FILTER_LABEL(sp) = XtCreateManagedWidget("filter-label", xmLabelWidgetClass, CONTROLS(sp), args, n);
- XmStringFree(s1);
-
- /* filter order */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNresizeWidth, false); n++;
- XtSetArg(args[n], XmNcolumns, 3); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, FILTER_LABEL(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, FILTER_LABEL(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- XtSetArg(args[n], XmNrecomputeSize, false); n++;
- FILTER_ORDER_TEXT(sp) = make_textfield_widget("filter-order", CONTROLS(sp), args, n, ACTIVATABLE, NO_COMPLETER);
- XmTextSetString(FILTER_ORDER_TEXT(sp), (char *)" 20");
- XtAddCallback(FILTER_ORDER_TEXT(sp), XmNactivateCallback, filter_order_activate_callback, (XtPointer)sp);
-
- #define ARROW_SIZE 12
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, FILTER_ORDER_TEXT(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, FILTER_ORDER_TEXT(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNheight, ARROW_SIZE); n++;
- XtSetArg(args[n], XmNwidth, ARROW_SIZE); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNmarginWidth, 0); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- FILTER_ORDER_DOWN(sp) = make_pushbutton_widget("", CONTROLS(sp), args, n);
- XtAddEventHandler(FILTER_ORDER_DOWN(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(FILTER_ORDER_DOWN(sp), XmNactivateCallback, filter_order_down_callback, (XtPointer)sp);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, FILTER_ORDER_DOWN(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, FILTER_ORDER_TEXT(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNheight, ARROW_SIZE); n++;
- XtSetArg(args[n], XmNwidth, ARROW_SIZE); n++;
- XtSetArg(args[n], XmNborderWidth, 0); n++;
- XtSetArg(args[n], XmNmarginWidth, 0); n++;
- XtSetArg(args[n], XmNarmColor, ss->selection_color); n++;
- FILTER_ORDER_UP(sp) = make_pushbutton_widget("", CONTROLS(sp), args, n);
- XtAddEventHandler(FILTER_ORDER_UP(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(FILTER_ORDER_UP(sp), XmNactivateCallback, filter_order_up_callback, (XtPointer)sp);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, REVERB_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNheight, 16); n++;
- XtSetArg(args[n], XmNmarginWidth, 0); n++;
- XtSetArg(args[n], XmNtopOffset, 2); n++;
- XtSetArg(args[n], XmNspacing, 0); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- FILTER_BUTTON(sp) = make_togglebutton_widget("fltoff", CONTROLS(sp), args, n);
- XtAddEventHandler(FILTER_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(FILTER_BUTTON(sp), XmNvalueChangedCallback, filter_button_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"hz");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, FILTER_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, FILTER_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNvalue, sp->filter_control_in_hz); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- FILTER_HZ_BUTTON(sp) = make_togglebutton_widget("flthz", CONTROLS(sp), args, n);
- XtAddEventHandler(FILTER_HZ_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(FILTER_HZ_BUTTON(sp), XmNvalueChangedCallback, filter_hz_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- s1 = XmStringCreateLocalized((char *)"dB");
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, FILTER_HZ_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, FILTER_HZ_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNlabelString, s1); n++;
- XtSetArg(args[n], XmNvalue, sp->filter_control_in_dB); n++;
- if (ss->toggle_size > 0) {XtSetArg(args[n], XmNindicatorSize, ss->toggle_size); n++;}
- XtSetArg(args[n], XmNselectColor, ss->selection_color); n++;
- FILTER_DB_BUTTON(sp) = make_togglebutton_widget("fltdB", CONTROLS(sp), args, n);
- XtAddEventHandler(FILTER_DB_BUTTON(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
- XtAddCallback(FILTER_DB_BUTTON(sp), XmNvalueChangedCallback, filter_dB_callback, (XtPointer)sp);
- XmStringFree(s1);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNalignment, XmALIGNMENT_BEGINNING); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_OPPOSITE_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, FILTER_ORDER_DOWN(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_NONE); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNleftWidget, FILTER_ORDER_DOWN(sp)); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNrightWidget, FILTER_DB_BUTTON(sp)); n++;
- XtSetArg(args[n], XmNmarginHeight, CONTROLS_MARGIN); n++;
- FILTER_COEFFS_TEXT(sp) = make_textfield_widget("filter-text", CONTROLS(sp), args, n, ACTIVATABLE, add_completer_func(filename_completer, NULL));
- XtAddCallback(FILTER_COEFFS_TEXT(sp), XmNactivateCallback, filter_activate_callback, (XtPointer)sp);
-
- /* FILTER GRAPH */
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
- XtSetArg(args[n], XmNtopWidget, FILTER_COEFFS_TEXT(sp)); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNleftPosition, 4); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_POSITION); n++;
- XtSetArg(args[n], XmNrightPosition, 98); n++;
- XtSetArg(args[n], XmNallowResize, true); n++;
- XtSetArg(args[n], XmNshadowType, XmSHADOW_ETCHED_IN); n++;
- XtSetArg(args[n], XmNshadowThickness, 4); n++;
- FILTER_FRAME(sp) = XtCreateManagedWidget("filter-frame", xmFrameWidgetClass, CONTROLS(sp), args, n);
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->highlight_color); n++;
- n = attach_all_sides(args, n);
- XtSetArg(args[n], XmNallowResize, true); n++;
- FILTER_GRAPH(sp) = XtCreateManagedWidget("filter-window", xmDrawingAreaWidgetClass, FILTER_FRAME(sp), args, n);
- XtAddCallback(FILTER_GRAPH(sp), XmNresizeCallback, filter_drawer_resize, (XtPointer)sp);
- XtAddCallback(FILTER_GRAPH(sp), XmNexposeCallback, filter_drawer_resize, (XtPointer)sp);
-
- sp->flt = new_env_editor();
-
- XtAddEventHandler(FILTER_GRAPH(sp), ButtonPressMask, false, filter_drawer_button_press, sp);
- XtAddEventHandler(FILTER_GRAPH(sp), ButtonMotionMask, false, filter_drawer_button_motion, sp);
- XtAddEventHandler(FILTER_GRAPH(sp), ButtonReleaseMask, false, filter_drawer_button_release, sp);
- XtAddEventHandler(FILTER_GRAPH(sp), KeyPressMask, false, graph_key_press, (XtPointer)sp);
-
- free(n1); free(n2); free(n3); free(n4); free(n5); free(n6);
- free(n7); free(n8); free(n9); free(n10); free(n11); free(n12);
- /* end if control-panel */
- if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
- {
- char *name;
- name = just_filename(sp->short_filename); /* copies */
- if (strlen(name) > 8) name[8] = '\0';
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->graph_color); n++;
- XtSetArg(args[n], XmNnotebookChildType, XmMAJOR_TAB); n++;
- XtSetArg(args[n], XmNuserData, sp->index); n++;
- sp->tab = XtCreateManagedWidget(name, xmPushButtonWidgetClass, SOUND_PANE(ss), args, n);
- free(name);
- }
-
-
- if (sound_style(ss) != SOUNDS_IN_SEPARATE_WINDOWS)
- run_new_widget_hook(SND_PANE(sp));
- else run_new_widget_hook(sp->dialog);
-
-#if WITH_RELATIVE_PANES
- if (sound_style(ss) == SOUNDS_VERTICAL)
- add_sash_watchers(SOUND_PANE(ss)); /* add in any case since we might later change the sense of with_relative_panes */
-#endif
-
- } /* new sound ss */
- else
- { /* re-manage currently inactive chan */
- if (sound_style(ss) == SOUNDS_IN_SEPARATE_WINDOWS)
- {
- title = (char *)calloc(PRINT_BUFFER_SIZE, sizeof(char));
- mus_snprintf(title, PRINT_BUFFER_SIZE, "%d: %s", snd_slot, sp->short_filename);
- XtVaSetValues(sp->dialog, XmNtitle, title, NULL);
- free(title);
- if (!XtIsManaged(sp->dialog)) XtManageChild(sp->dialog);
- }
-
- for (i = 0; i < NUM_SND_WIDGETS - 1; i++)
- if ((sw[i]) &&
- (!XtIsManaged(sw[i])) &&
- (in_show_controls(ss) || (i != W_amp_form)) &&
- (i != W_error_info_box))
- XtManageChild(sw[i]);
-
- for (k = 0; k < nchans; k++)
- add_channel_window(sp, k, chan_min_y, 0, NULL, WITH_FW_BUTTONS, WITH_EVENTS);
-
- set_button_label(NAME_LABEL(sp), shortname_indexed(sp));
- XtVaSetValues(SND_PANE(sp), XmNuserData, sp->index, NULL);
-
- if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
- {
- char *name;
- name = just_filename(sp->short_filename);
- set_label(sp->tab, name);
- free(name);
- }
- }
-
- map_over_children(SOUND_PANE(ss), color_sashes);
- if (!(in_show_controls(ss)))
- hide_controls(sp);
- else show_controls(sp);
-
- if (sp->nchans == 1)
- {
- XmToggleButtonSetState(UNITE_BUTTON(sp), false, false);
- XtUnmanageChild(UNITE_BUTTON(sp));
-
- if (ss->active_sounds == 0) /* ticked at the end in snd-file.c */
- {
- XmToggleButtonSetState(SYNC_BUTTON(sp), false, false);
- XtUnmanageChild(SYNC_BUTTON(sp));
- }
- else
- {
- for_each_sound(manage_sync_button);
- }
- }
- else
- {
- for_each_sound(manage_sync_button);
- }
- attach_minibuffer(sp);
-
- add_sound_data(filename, sp, WITH_GRAPH);
-
- if (cant_write(sp->filename))
- sp->file_read_only = FILE_READ_ONLY;
- if ((sp->file_read_only == FILE_READ_ONLY) ||
- (sp->user_read_only == FILE_READ_ONLY))
- show_lock(sp);
- else hide_lock(sp);
-
- if (old_name)
- report_in_minibuffer(sp, "(translated %s)", old_name);
-
- if (sound_style(ss) != SOUNDS_IN_SEPARATE_WINDOWS)
- {
- reset_controls(sp);
- }
- else
- {
- XtVaSetValues(sp->dialog,
- XmNwidth, 100,
- XmNheight, 100,
- NULL);
- /* this is not redundant -- apparently they're trying to ignore size resets to the "current" */
- /* value, but forgot that unmanage/remanage does not return to the previous size */
- XtVaSetValues(sp->dialog,
- XmNwidth, (Dimension)(widget_width(MAIN_SHELL(ss))),
- XmNheight, (Dimension)(chan_min_y * nchans), /* bugfix thanks to Paul @pobox */
- NULL);
- }
-
- after_open(sp);
- if (free_filename) free(filename);
- return(sp);
-}
-
-
-void snd_info_cleanup(snd_info *sp)
-{
- if (HAS_WIDGETS(sp))
- {
- clear_minibuffer_error(sp);
- if (SYNC_BUTTON(sp))
- {
- XtVaSetValues(SYNC_BUTTON(sp), XmNset, false, NULL);
- XtVaSetValues(EXPAND_RIGHT_BUTTON(sp), XmNset, false, NULL);
- XtVaSetValues(CONTRAST_RIGHT_BUTTON(sp), XmNset, false, NULL);
- XtVaSetValues(SPEED_ARROW(sp), XmNset, false, NULL);
- XtVaSetValues(FILTER_BUTTON(sp), XmNset, false, NULL);
- XtVaSetValues(REVERB_BUTTON(sp), XmNset, false, NULL);
- XmToggleButtonSetState(UNITE_BUTTON(sp), false, false);
- sp->channel_style = CHANNELS_SEPARATE;
- if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
- {
- set_label(sp->tab, "none");
- XmChangeColor(sp->tab, ss->graph_color);
- }
- XtUnmanageChild(SND_PANE(sp));
- }
- if ((sp->dialog) &&
- (XtIsManaged(sp->dialog)))
- XtUnmanageChild(sp->dialog);
- }
-}
-
-
-static XEN reflect_file_close_in_sync(XEN xreason)
-{
- int reason;
- reason = XEN_TO_C_INT(xreason);
- if ((reason == FILE_CLOSED) && /* snd-file.c */
- (ss->active_sounds == 1))
- {
- snd_info *sp;
- sp = any_selected_sound();
- if ((sp) && (sp->nchans == 1))
- {
- XtUnmanageChild(SYNC_BUTTON(sp));
- attach_minibuffer(sp);
- }
- }
- return(XEN_FALSE);
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(reflect_file_close_in_sync_w, reflect_file_close_in_sync)
-#else
- #define reflect_file_close_in_sync_w reflect_file_close_in_sync
-#endif
-
-
-void set_sound_pane_file_label(snd_info *sp, const char *str)
-{
- if (MUS_TRY_LOCK(sp->starred_name_lock) != MUS_ALREADY_LOCKED)
- {
- if (!(mus_strcmp(sp->name_string, str)))
- {
- if (sp->name_string) free(sp->name_string);
- sp->name_string = mus_strdup(str);
- set_button_label(SND_NAME(sp), str); /* this causes an expose event, so it's worth minimizing */
- }
- MUS_UNLOCK(sp->starred_name_lock);
- }
-}
-
-
-void color_filter_waveform(Pixel color)
-{
- int i;
- XSetForeground(MAIN_DISPLAY(ss), ss->fltenv_data_gc, color);
- ss->filter_control_waveform_color = color;
- for (i = 0; i < ss->max_sounds; i++)
- {
- snd_info *sp;
- sp = ss->sounds[i];
- if ((sp) && (sp->inuse == SOUND_NORMAL))
- display_filter_env(sp);
- }
-}
-
-
-void show_controls(snd_info *sp)
-{
- Dimension hgt;
- XtVaGetValues(FILTER_LABEL(sp),
- XmNy, &hgt,
- NULL);
- if (XtIsManaged(CONTROLS(sp)))
- XtUnmanageChild(CONTROLS(sp));
- XtVaSetValues(CONTROLS(sp),
- XmNpaneMinimum, hgt,
- XmNpaneMaximum, hgt,
- NULL);
- XtManageChild(CONTROLS(sp));
- XtVaSetValues(CONTROLS(sp),
- XmNpaneMinimum, 1,
- XmNpaneMaximum, LOTSA_PIXELS,
- NULL);
-}
-
-
-void hide_controls(snd_info *sp)
-{
- XtUnmanageChild(CONTROLS(sp));
-}
-
-
-bool showing_controls(snd_info *sp)
-{
- return((bool)(XtIsManaged(CONTROLS(sp))));
-}
-
-
-void show_all_controls(void)
-{
- int i;
- for (i = 0; i < ss->max_sounds; i++)
- {
- snd_info *sp;
- sp = ss->sounds[i];
- if ((sp) && (sp->inuse == SOUND_NORMAL))
- show_controls(sp);
- }
-}
-
-
-void hide_all_controls(void)
-{
- int i;
- for (i = 0; i < ss->max_sounds; i++)
- {
- snd_info *sp;
- sp = ss->sounds[i];
- if ((sp) && (sp->inuse == SOUND_NORMAL))
- hide_controls(sp);
- }
-}
-
-
-int control_panel_height(snd_info *sp)
-{
- return(widget_height(CONTROLS(sp)));
-}
-
-
-/* -------- PROGRESS REPORT -------- */
-
-/* since threads can be acting on all chans at once, it's probably useful to show a progress bar for each */
-
-void progress_report(chan_info *cp, mus_float_t pct)
-{
- int which;
- snd_info *sp;
- sp = cp->sound;
-
- if ((!HAS_WIDGETS(sp)) || (sp->inuse != SOUND_NORMAL)) return;
-
- which = (int)(pct * NUM_HOURGLASSES);
- if (which >= NUM_HOURGLASSES) which = NUM_HOURGLASSES - 1;
- if (which < 0) which = 0;
-
- if ((hourglasses[which]) &&
- (cp->chan < sp->num_progress_widgets) &&
- ((cp->chan == 0) ||
- (sp->channel_style != CHANNELS_SUPERIMPOSED)))
- {
- XtVaSetValues(PROGRESS_ICON(cp), XmNlabelPixmap, hourglasses[which], NULL);
-#if (!HAVE_PTHREADS)
- XmUpdateDisplay(PROGRESS_ICON(cp));
-#endif
- }
-
- check_for_event();
-}
-
-void finish_progress_report(chan_info *cp)
-{
- snd_info *sp;
- sp = cp->sound;
-
- if ((!HAS_WIDGETS(sp)) || (sp->inuse != SOUND_NORMAL)) return;
-
- if ((cp->chan < sp->num_progress_widgets) &&
- ((cp->chan == 0) ||
- (sp->channel_style != CHANNELS_SUPERIMPOSED)))
- {
- XtVaSetValues(PROGRESS_ICON(cp), XmNlabelPixmap, blank_pixmap, NULL);
-
-#if (!HAVE_PTHREADS)
- XmUpdateDisplay(PROGRESS_ICON(cp));
-#endif
- hide_stop_sign(sp);
- }
-}
-
-
-void start_progress_report(chan_info *cp)
-{
- snd_info *sp;
- sp = cp->sound;
-
- if ((!HAS_WIDGETS(sp)) || (sp->inuse != SOUND_NORMAL)) return;
-
- if ((cp->chan < sp->num_progress_widgets) &&
- ((cp->chan == 0) ||
- (sp->channel_style != CHANNELS_SUPERIMPOSED)))
- {
- XtVaSetValues(PROGRESS_ICON(cp), XmNlabelPixmap, hourglasses[0], NULL);
-#if (!HAVE_PTHREADS)
- XmUpdateDisplay(PROGRESS_ICON(cp));
-#endif
- show_stop_sign(sp);
- }
-}
-
-
-
-void reflect_sound_selection(snd_info *sp)
-{
- /* sp is the newly selected sound, ss->selected_sound is the previous one */
- snd_info *osp = NULL;
-
- if (ss->selected_sound != NO_SELECTION)
- osp = ss->sounds[ss->selected_sound];
-
- if ((osp) &&
- (sp != osp) &&
- (osp->inuse == SOUND_NORMAL))
- {
- XmChangeColor(SND_NAME(osp), ss->highlight_color);
- if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
- XmChangeColor(osp->tab, ss->graph_color);
- }
-
- if (sp->selected_channel != NO_SELECTION)
- {
- XmChangeColor(SND_NAME(sp), ss->white);
- if (sound_style(ss) == SOUNDS_IN_NOTEBOOK)
- {
- int page, current_page;
- XmNotebookPageStatus status;
- XmNotebookPageInfo info;
- XmChangeColor(sp->tab, ss->selected_graph_color);
- XtVaGetValues(SOUND_PANE(ss), XmNcurrentPageNumber, ¤t_page, NULL);
- XtVaGetValues(sp->tab, XmNpageNumber, &page, NULL);
- if (page != current_page)
- {
- status = XmNotebookGetPageInfo(SOUND_PANE(ss), page, &info);
- if (status == XmPAGE_FOUND)
- {
- XtVaSetValues(SOUND_PANE(ss), XmNcurrentPageNumber, page, NULL);
- }
- }
- }
- }
-}
-
-
-/* -------- controls dialog -------- */
-
-static Widget controls_dialog = NULL;
-enum {EXPAND_HOP, EXPAND_LENGTH, EXPAND_RAMP, EXPAND_JITTER, CONTRAST_AMP, REVERB_LOWPASS, REVERB_FEEDBACK};
-static Widget controls[7];
-
-static void reset_all_sliders(void)
-{
- expand_control_set_hop(DEFAULT_EXPAND_CONTROL_HOP);
- expand_control_set_length(DEFAULT_EXPAND_CONTROL_LENGTH);
- expand_control_set_ramp(DEFAULT_EXPAND_CONTROL_RAMP);
- expand_control_set_jitter(DEFAULT_EXPAND_CONTROL_JITTER);
- contrast_control_set_amp(DEFAULT_CONTRAST_CONTROL_AMP);
- reverb_control_set_lowpass(DEFAULT_REVERB_CONTROL_LOWPASS);
- reverb_control_set_feedback(DEFAULT_REVERB_CONTROL_FEEDBACK);
-
- XtVaSetValues(controls[EXPAND_HOP], XmNvalue, (int)(expand_control_hop(ss) * 1000), NULL);
- XtVaSetValues(controls[EXPAND_LENGTH], XmNvalue, (int)(expand_control_length(ss) * 1000), NULL);
- XtVaSetValues(controls[EXPAND_RAMP], XmNvalue, (int)(expand_control_ramp(ss) * 1000), NULL);
- XtVaSetValues(controls[EXPAND_JITTER], XmNvalue, (int)(expand_control_jitter(ss) * 1000), NULL);
- XtVaSetValues(controls[CONTRAST_AMP], XmNvalue, (int)(contrast_control_amp(ss) * 1000), NULL);
- XtVaSetValues(controls[REVERB_LOWPASS], XmNvalue, (int)(reverb_control_lowpass(ss) * 1000), NULL);
- XtVaSetValues(controls[REVERB_FEEDBACK], XmNvalue, (int)(reverb_control_feedback(ss) * 1000), NULL);
-}
-
-static void controls_reset_callback(Widget w, XtPointer context, XtPointer info)
-{
- reset_all_sliders();
-}
-
-static void controls_help_callback(Widget w, XtPointer context, XtPointer info)
-{
- snd_help("More controls",
-"This dialog controls all the otherwise hidden control-panel variables.\n\
-Expand-hop sets the time in seconds between successive grains.\n\
-Expand-length sets the length of each grain.\n\
-Expand-ramp sets the ramp-time in the grain envelope.\n\
-Expand-jitter sets the grain timing jitter.\n\
-Contrast-amp sets the prescaler for contrast-enhancement.\n\
-Reverb-lowpass sets the feedback lowpass filter coeficient.\n\
-Reverb-feedback sets the scaler on the feedback.",
- WITHOUT_WORD_WRAP);
-}
-
-static void controls_dismiss_callback(Widget w, XtPointer context, XtPointer info)
-{
- XtUnmanageChild(controls_dialog);
-}
-
-static void expand_hop_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- expand_control_set_hop(cbs->value * 0.001);
-}
-
-static void expand_length_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- expand_control_set_length(cbs->value * 0.001);
-}
-
-static void expand_ramp_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- expand_control_set_ramp(cbs->value * 0.001);
-}
-
-static void expand_jitter_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- expand_control_set_jitter(cbs->value * 0.001);
-}
-
-static void contrast_amp_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- contrast_control_set_amp(cbs->value * 0.001);
-}
-
-static void reverb_lowpass_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- reverb_control_set_lowpass(cbs->value * 0.001);
-}
-
-static void reverb_feedback_callback(Widget w, XtPointer context, XtPointer info)
-{
- XmScaleCallbackStruct *cbs = (XmScaleCallbackStruct *)info;
- reverb_control_set_feedback(cbs->value * 0.001);
-}
-
-void make_controls_dialog(void)
-{
- #define MSG_BOX(Dialog, Child) XmMessageBoxGetChild(Dialog, Child)
- if (!controls_dialog)
- {
- int n;
- Arg args[32];
- XmString xdismiss, xhelp, titlestr, xreset;
- Widget mainform, slider;
-
- xdismiss = XmStringCreateLocalized((char *)"Go Away");
- xhelp = XmStringCreateLocalized((char *)"Help");
- titlestr = XmStringCreateLocalized((char *)"More controls");
- xreset = XmStringCreateLocalized((char *)"Reset");
-
- n = 0;
- XtSetArg(args[n], XmNbackground, ss->basic_color); n++;
- XtSetArg(args[n], XmNhelpLabelString, xhelp); n++;
- XtSetArg(args[n], XmNokLabelString, xdismiss); n++;
- XtSetArg(args[n], XmNcancelLabelString, xreset); n++;
- XtSetArg(args[n], XmNautoUnmanage, false); n++;
- XtSetArg(args[n], XmNdialogTitle, titlestr); n++;
- XtSetArg(args[n], XmNresizePolicy, XmRESIZE_GROW); n++;
- XtSetArg(args[n], XmNnoResize, false); n++;
- XtSetArg(args[n], XmNtransient, false); n++;
- XtSetArg(args[n], XmNwidth, 400); n++;
- controls_dialog = XmCreateTemplateDialog(MAIN_SHELL(ss), (char *)"More controls", args, n);
-
- XtAddCallback(controls_dialog, XmNhelpCallback, controls_help_callback, NULL);
- XtAddCallback(controls_dialog, XmNokCallback, controls_dismiss_callback, NULL);
- XtAddCallback(controls_dialog, XmNcancelCallback, controls_reset_callback, NULL);
-
- XmStringFree(xhelp);
- XmStringFree(xdismiss);
- XmStringFree(titlestr);
- XmStringFree(xreset);
-
- XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_OK_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_HELP_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_CANCEL_BUTTON), XmNarmColor, ss->selection_color, NULL);
- XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_OK_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_HELP_BUTTON), XmNbackground, ss->highlight_color, NULL);
- XtVaSetValues(MSG_BOX(controls_dialog, XmDIALOG_CANCEL_BUTTON), XmNbackground, ss->highlight_color, NULL);
-
- mainform = XtVaCreateManagedWidget("formd", xmRowColumnWidgetClass, controls_dialog,
- XmNleftAttachment, XmATTACH_FORM,
- XmNrightAttachment, XmATTACH_FORM,
- XmNtopAttachment, XmATTACH_FORM,
- XmNbottomAttachment, XmATTACH_WIDGET,
- XmNbottomWidget, XmMessageBoxGetChild(controls_dialog, XmDIALOG_SEPARATOR),
- XmNorientation, XmVERTICAL,
- NULL);
-
- titlestr = XmStringCreateLocalized((char *)"expand hop");
- slider = XtVaCreateManagedWidget("expand-hop", xmScaleWidgetClass, mainform,
- XmNorientation, XmHORIZONTAL,
- XmNshowValue, true,
- XmNminimum, 1,
- XmNmaximum, 300,
- XmNvalue, (int)(expand_control_hop(ss) * 1000),
- XmNdecimalPoints, 3,
- XmNtitleString, titlestr,
- XmNborderWidth, 1,
- XmNbackground, ss->basic_color,
- NULL);
- XmStringFree(titlestr);
- XtAddCallback(slider, XmNvalueChangedCallback, expand_hop_callback, NULL);
- XtAddCallback(slider, XmNdragCallback, expand_hop_callback, NULL);
- controls[EXPAND_HOP] = slider;
-
- titlestr = XmStringCreateLocalized((char *)"expand length");
- slider = XtVaCreateManagedWidget("expand-length", xmScaleWidgetClass, mainform,
- XmNorientation, XmHORIZONTAL,
- XmNshowValue, true,
- XmNminimum, 10,
- XmNmaximum, 500,
- XmNvalue, (int)(expand_control_length(ss) * 1000),
- XmNdecimalPoints, 3,
- XmNtitleString, titlestr,
- XmNborderWidth, 1,
- XmNbackground, ss->basic_color,
- NULL);
- XmStringFree(titlestr);
- XtAddCallback(slider, XmNvalueChangedCallback, expand_length_callback, NULL);
- XtAddCallback(slider, XmNdragCallback, expand_length_callback, NULL);
- controls[EXPAND_LENGTH] = slider;
-
- titlestr = XmStringCreateLocalized((char *)"expand ramp");
- slider = XtVaCreateManagedWidget("expand-ramp", xmScaleWidgetClass, mainform,
- XmNorientation, XmHORIZONTAL,
- XmNshowValue, true,
- XmNminimum, 10,
- XmNmaximum, 500,
- XmNvalue, (int)(expand_control_ramp(ss) * 1000),
- XmNdecimalPoints, 3,
- XmNtitleString, titlestr,
- XmNborderWidth, 1,
- XmNbackground, ss->basic_color,
- NULL);
- XmStringFree(titlestr);
- XtAddCallback(slider, XmNvalueChangedCallback, expand_ramp_callback, NULL);
- XtAddCallback(slider, XmNdragCallback, expand_ramp_callback, NULL);
- controls[EXPAND_RAMP] = slider;
-
- titlestr = XmStringCreateLocalized((char *)"expand jitter");
- slider = XtVaCreateManagedWidget("expand-hop", xmScaleWidgetClass, mainform,
- XmNorientation, XmHORIZONTAL,
- XmNshowValue, true,
- XmNminimum, 0,
- XmNmaximum, 200,
- XmNvalue, (int)(expand_control_jitter(ss) * 1000),
- XmNdecimalPoints, 3,
- XmNtitleString, titlestr,
- XmNborderWidth, 1,
- XmNbackground, ss->basic_color,
- NULL);
- XmStringFree(titlestr);
- XtAddCallback(slider, XmNvalueChangedCallback, expand_jitter_callback, NULL);
- XtAddCallback(slider, XmNdragCallback, expand_jitter_callback, NULL);
- controls[EXPAND_JITTER] = slider;
-
- titlestr = XmStringCreateLocalized((char *)"contrast amp");
- slider = XtVaCreateManagedWidget("contrast-amp", xmScaleWidgetClass, mainform,
- XmNorientation, XmHORIZONTAL,
- XmNshowValue, true,
- XmNminimum, 0,
- XmNmaximum, 2000,
- XmNvalue, (int)(contrast_control_amp(ss) * 1000),
- XmNdecimalPoints, 3,
- XmNtitleString, titlestr,
- XmNborderWidth, 1,
- XmNbackground, ss->basic_color,
- NULL);
- XmStringFree(titlestr);
- XtAddCallback(slider, XmNvalueChangedCallback, contrast_amp_callback, NULL);
- XtAddCallback(slider, XmNdragCallback, contrast_amp_callback, NULL);
- controls[CONTRAST_AMP] = slider;
-
- titlestr = XmStringCreateLocalized((char *)"reverb lowpass");
- slider = XtVaCreateManagedWidget("reverb-lowpass", xmScaleWidgetClass, mainform,
- XmNorientation, XmHORIZONTAL,
- XmNshowValue, true,
- XmNminimum, 0,
- XmNmaximum, 1000,
- XmNvalue, (int)(reverb_control_lowpass(ss) * 1000),
- XmNdecimalPoints, 3,
- XmNtitleString, titlestr,
- XmNborderWidth, 1,
- XmNbackground, ss->basic_color,
- NULL);
- XmStringFree(titlestr);
- XtAddCallback(slider, XmNvalueChangedCallback, reverb_lowpass_callback, NULL);
- XtAddCallback(slider, XmNdragCallback, reverb_lowpass_callback, NULL);
- controls[REVERB_LOWPASS] = slider;
-
- titlestr = XmStringCreateLocalized((char *)"reverb feedback");
- slider = XtVaCreateManagedWidget("reverb-feedback", xmScaleWidgetClass, mainform,
- XmNorientation, XmHORIZONTAL,
- XmNshowValue, true,
- XmNminimum, 0,
- XmNmaximum, 1250,
- XmNvalue, (int)(reverb_control_feedback(ss) * 1000),
- XmNdecimalPoints, 3,
- XmNtitleString, titlestr,
- XmNborderWidth, 1,
- XmNbackground, ss->basic_color,
- NULL);
- XmStringFree(titlestr);
- XtAddCallback(slider, XmNvalueChangedCallback, reverb_feedback_callback, NULL);
- XtAddCallback(slider, XmNdragCallback, reverb_feedback_callback, NULL);
- controls[REVERB_FEEDBACK] = slider;
-
- set_dialog_widget(CONTROLS_DIALOG, controls_dialog);
- }
-
- if (!XtIsManaged(controls_dialog))
- XtManageChild(controls_dialog);
-}
-
-
-/* ---------------------------------------- */
-
-static XEN g_sound_widgets(XEN snd)
-{
- #define H_sound_widgets "(" S_sound_widgets " :optional snd): a list of \
-widgets: (0)pane (1)name (2)control-panel (3)minibuffer (4)play-button (5)filter-env (6)unite-button (7)name-label (8)name-icon (9)sync-button"
-
- snd_info *sp;
-
- ASSERT_SOUND(S_sound_widgets, snd, 1);
-
- sp = get_sp(snd);
- if (sp == NULL)
- return(snd_no_such_sound_error(S_sound_widgets, snd));
- if (!HAS_WIDGETS(sp))
- return(XEN_EMPTY_LIST);
-
- return(XEN_CONS(XEN_WRAP_WIDGET(SND_PANE(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(SND_NAME(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(CONTROLS(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(MINIBUFFER_TEXT(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(PLAY_BUTTON(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(FILTER_GRAPH(sp)), /* this is the drawingarea widget */
- XEN_CONS(XEN_WRAP_WIDGET(UNITE_BUTTON(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(MINIBUFFER_LABEL(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(LOCK_OR_BOMB(sp)),
- XEN_CONS(XEN_WRAP_WIDGET(SYNC_BUTTON(sp)),
- XEN_EMPTY_LIST)))))))))));
-}
-
-
-#ifdef XEN_ARGIFY_1
- XEN_ARGIFY_1(g_sound_widgets_w, g_sound_widgets)
-#else
- #define g_sound_widgets_w g_sound_widgets
-#endif
-
-void g_init_gxsnd(void)
-{
- XEN_ADD_HOOK(ss->snd_open_file_hook, reflect_file_close_in_sync_w, "sync-open-file-watcher", "sound sync open-file-hook handler");
-
- XEN_DEFINE_PROCEDURE(S_sound_widgets, g_sound_widgets_w, 0, 1, 0, H_sound_widgets);
-}
diff --git a/snd-xutils.c b/snd-xutils.c
deleted file mode 100644
index 62203ee..0000000
--- a/snd-xutils.c
+++ /dev/null
@@ -1,795 +0,0 @@
-#include "snd.h"
-
-#include <X11/IntrinsicP.h>
-
-#if __GNUC__
-#ifdef LESSTIF_VERSION
- /* moved the warning here so it only is displayed once */
- #warning You appear to be using Lesstif: this is not recommended! Expect bugs...
-#endif
-#if (XmVERSION == 1)
- #warning Motif 1 is no longer supported -- this has little chance of working...
-#endif
-#endif
-
-
-static XmRenderTable get_xm_font(XFontStruct *ignore, const char *font, const char *tag)
-{
- XmRendition tmp;
- XmRenderTable tabl;
- int n;
- Arg args[12];
-
- n = 0;
- XtSetArg(args[n], XmNfontName, font); n++;
- XtSetArg(args[n], XmNfontType, XmFONT_IS_FONT); n++;
- XtSetArg(args[n], XmNloadModel, XmLOAD_IMMEDIATE); n++;
- tmp = XmRenditionCreate(MAIN_SHELL(ss), (char *)tag, args, n);
- tabl = XmRenderTableAddRenditions(NULL, &tmp, 1, XmMERGE_NEW);
-
- /* XmRenditionFree(tmp); */ /* valgrind thinks this is a bad idea */
- return(tabl);
-}
-
-
-/* to see all fonts: (format #f "~{~A~%~}" (XListFonts (XtDisplay (cadr (main-widgets))) "*" 10000))
- */
-
-bool set_tiny_font(const char *font)
-{
- XFontStruct *fs = NULL;
- fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
- if (fs)
- {
- /* it's not clear to me whether this is safe -- what if two fontstructs are pointing to the same font? */
- if (TINY_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), TINY_FONT(ss));
- if (tiny_font(ss)) free(tiny_font(ss));
- in_set_tiny_font(mus_strdup(font));
- TINY_FONT(ss) = fs;
- if (ss->tiny_fontlist) XM_FONT_FREE(ss->tiny_fontlist);
- ss->tiny_fontlist = get_xm_font(TINY_FONT(ss), font, "tiny_font");
- return(true);
- }
- return(false);
-}
-
-
-bool set_listener_font(const char *font)
-{
- XFontStruct *fs = NULL;
- fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
- if (fs)
- {
- if (LISTENER_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), LISTENER_FONT(ss));
- if (listener_font(ss)) free(listener_font(ss));
- in_set_listener_font(mus_strdup(font));
- LISTENER_FONT(ss) = fs;
- if (ss->listener_fontlist) XM_FONT_FREE(ss->listener_fontlist);
- ss->listener_fontlist = get_xm_font(LISTENER_FONT(ss), font, "listener_font");
- set_listener_text_font();
- return(true);
- }
- return(false);
-}
-
-
-bool set_peaks_font(const char *font)
-{
- XFontStruct *fs = NULL;
- fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
- if (fs)
- {
- if (PEAKS_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), PEAKS_FONT(ss));
- if (peaks_font(ss)) free(peaks_font(ss));
- in_set_peaks_font(mus_strdup(font));
- PEAKS_FONT(ss) = fs;
- if (ss->peaks_fontlist) XM_FONT_FREE(ss->peaks_fontlist);
- ss->peaks_fontlist = get_xm_font(PEAKS_FONT(ss), font, "peaks_font");
- return(true);
- }
- return(false);
-}
-
-
-bool set_bold_peaks_font(const char *font)
-{
- XFontStruct *fs = NULL;
- fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
- if (fs)
- {
- if (BOLD_PEAKS_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), BOLD_PEAKS_FONT(ss));
- if (bold_peaks_font(ss)) free(bold_peaks_font(ss));
- in_set_bold_peaks_font(mus_strdup(font));
- BOLD_PEAKS_FONT(ss) = fs;
- if (ss->bold_peaks_fontlist) XM_FONT_FREE(ss->bold_peaks_fontlist);
- ss->bold_peaks_fontlist = get_xm_font(BOLD_PEAKS_FONT(ss), font, "bold_peaks_font");
- return(true);
- }
- return(false);
-}
-
-
-bool set_axis_label_font(const char *font)
-{
- XFontStruct *fs = NULL;
- fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
- if (fs)
- {
- if (AXIS_LABEL_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), AXIS_LABEL_FONT(ss));
- if (axis_label_font(ss)) free(axis_label_font(ss));
- in_set_axis_label_font(mus_strdup(font));
- AXIS_LABEL_FONT(ss) = fs;
-#if HAVE_GL
- reload_label_font();
-#endif
- return(true);
- }
- return(false);
-}
-
-
-bool set_axis_numbers_font(const char *font)
-{
- XFontStruct *fs = NULL;
- fs = XLoadQueryFont(MAIN_DISPLAY(ss), font);
- if (fs)
- {
- if (AXIS_NUMBERS_FONT(ss)) XFreeFont(MAIN_DISPLAY(ss), AXIS_NUMBERS_FONT(ss));
- if (axis_numbers_font(ss)) free(axis_numbers_font(ss));
- in_set_axis_numbers_font(mus_strdup(font));
- AXIS_NUMBERS_FONT(ss) = fs;
-#if HAVE_GL
- reload_number_font();
-#endif
- return(true);
- }
- return(false);
-}
-
-
-int mark_name_width(const char *txt)
-{
- if (txt)
- return(XTextWidth(PEAKS_FONT(ss), txt, strlen(txt)));
- return(0);
-}
-
-
-int label_width(const char *txt, bool use_tiny_font)
-{
- if (txt)
- return(XTextWidth((use_tiny_font) ? TINY_FONT(ss) : AXIS_LABEL_FONT(ss), txt, strlen(txt)));
- else return(0);
-}
-
-
-int number_width(const char *num, bool use_tiny_font)
-{
- if (num)
- return(XTextWidth((use_tiny_font) ? TINY_FONT(ss) : AXIS_NUMBERS_FONT(ss), num, strlen(num)));
- return(0);
-}
-
-
-int number_height(XFontStruct *numbers_font)
-{
- return(numbers_font->ascent);
-}
-
-
-int label_height(bool use_tiny_font)
-{
- XFontStruct *label_font;
- if (use_tiny_font)
- label_font = TINY_FONT(ss);
- else label_font = AXIS_LABEL_FONT(ss);
- return(label_font->ascent + label_font->descent);
-}
-
-
-void clear_window(graphics_context *ax)
-{
- if ((ax) && (ax->dp) && (ax->wn))
- XClearWindow(ax->dp, ax->wn);
-}
-
-
-void map_over_children(Widget w, void (*func)(Widget uw))
-{
- /* apply func to each child in entire tree beneath top widget */
- /* taken from Douglas Young, "Motif Debugging and Performance Tuning" Prentice-Hall 1995 */
- /* used mostly to get colors right in environments with "convenience" widgets */
- if (w)
- {
- unsigned int i;
- (*func)(w);
- if (XtIsComposite(w))
- {
- CompositeWidget cw = (CompositeWidget)w;
- for (i = 0; i < cw->composite.num_children; i++)
- map_over_children(cw->composite.children[i], func);
- }
-
- if (XtIsWidget(w))
- for (i = 0; i < w->core.num_popups; i++)
- map_over_children(w->core.popup_list[i], func);
- }
-}
-
-
-void map_over_children_with_color(Widget w, void (*func)(Widget uw, color_t color), color_t color)
-{
- if (w)
- {
- unsigned int i;
- (*func)(w, color);
- if (XtIsComposite(w))
- {
- CompositeWidget cw = (CompositeWidget)w;
- for (i = 0; i < cw->composite.num_children; i++)
- map_over_children_with_color(cw->composite.children[i], func, color);
- }
-
- if (XtIsWidget(w))
- for (i = 0; i < w->core.num_popups; i++)
- map_over_children_with_color(w->core.popup_list[i], func, color);
- }
-}
-
-
-void raise_dialog(Widget w)
-{
- /* since we're using non-transient message dialogs, the dialog window can become completely
- * hidden behind other windows, with no easy way to raise it back to the top, so...
- */
- if ((w) && (XtIsManaged(w)))
- {
- Widget parent;
- parent = XtParent(w);
- if ((parent) &&
- (XtIsSubclass(parent, xmDialogShellWidgetClass)))
- XtPopup(parent, XtGrabNone);
- /* XtGrabNone means don't lock out events to rest of App (i.e. modeless dialog) */
- }
-}
-
-
-void set_main_color_of_widget(Widget w)
-{
- if (XtIsWidget(w))
- {
- if (XmIsScrollBar(w))
- XmChangeColor(w, (Pixel)ss->position_color);
- else
- {
- Pixel cur_color;
- XtVaGetValues(w, XmNbackground, &cur_color, NULL);
- if ((cur_color != ss->highlight_color) &&
- (cur_color != ss->white))
- XmChangeColor(w, (Pixel)ss->basic_color);
- }
- }
-}
-
-
-void set_label(Widget label, const char *str)
-{
- XmString s1;
- s1 = XmStringCreateLocalized((char *)str);
- XtVaSetValues(label, XmNlabelString, s1, NULL);
- XmStringFree(s1);
-}
-
-
-char *get_label(Widget label)
-{
- char *text;
- XmString str = NULL;
- XtVaGetValues(label, XmNlabelString, &str, NULL);
- if (XmStringEmpty(str)) return(NULL);
- text = (char *)XmStringUnparse(str, NULL, XmCHARSET_TEXT, XmCHARSET_TEXT, NULL, 0, XmOUTPUT_ALL);
- XmStringFree(str);
- return(text);
-}
-
-
-void set_button_label(Widget label, const char *str)
-{
- set_label(label, str);
-}
-
-
-void set_title(const char *title)
-{
- XtVaSetValues(MAIN_SHELL(ss), XmNtitle, (char *)title, NULL);
-}
-
-
-void goto_window(Widget text)
-{
- if (XmIsTraversable(text))
- XmProcessTraversal(text, XmTRAVERSE_CURRENT);
-}
-
-
-XtCallbackList make_callback_list(XtCallbackProc callback, XtPointer closure)
-{
- XtCallbackList nlist;
- nlist = (XtCallbackList)calloc(2, sizeof(XtCallbackRec));
- nlist[0].callback = callback;
- nlist[0].closure = closure;
- nlist[1].callback = NULL;
- nlist[1].closure = NULL;
- return(nlist);
-}
-
-
-#include <Xm/SashP.h>
-void color_sashes(Widget w)
-{
- if ((XtIsWidget(w)) &&
- (XtIsSubclass(w, xmSashWidgetClass)))
- XmChangeColor(w, (Pixel)ss->sash_color);
-}
-
-
-void check_for_event(void)
-{
- /* this is needed to force label updates and provide interrupts from long computations */
- XEvent event;
- XtInputMask msk = 0;
- XtAppContext app;
-
- if (ss->checking_explicitly) return;
- ss->checking_explicitly = true;
-
- app = MAIN_APP(ss);
- while (true)
- {
- msk = XtAppPending(app);
- /* if (msk & (XtIMXEvent | XtIMAlternateInput)) */
- if (msk & XtIMXEvent)
- /* was also tracking alternate input events, but these are problematic if libfam is in use (even with check) */
- {
- XtAppNextEvent(app, &event);
- XtDispatchEvent(&event);
- /* widget = XtWindowToWidget(event.xany.display, event.xany.window); */
- }
- else break;
- }
- ss->checking_explicitly = false;
-}
-
-
-void color_cursor(Pixel color)
-{
- ss->cursor_color = color;
- XSetForeground(MAIN_DISPLAY(ss), ss->cursor_gc, (Pixel)(XOR(color, ss->graph_color)));
- XSetForeground(MAIN_DISPLAY(ss), ss->selected_cursor_gc, (Pixel)(XOR(color, ss->selected_graph_color)));
-}
-
-
-void color_marks(Pixel color)
-{
- ss->mark_color = color;
- XSetForeground(MAIN_DISPLAY(ss), ss->mark_gc, (Pixel)(XOR(color, ss->graph_color)));
- XSetForeground(MAIN_DISPLAY(ss), ss->selected_mark_gc, (Pixel)(XOR(color, ss->selected_graph_color)));
-}
-
-
-void color_selection(Pixel color)
-{
- ss->selection_color = color;
- XSetForeground(MAIN_DISPLAY(ss), ss->selection_gc, (Pixel)(XOR(color, ss->graph_color)));
- XSetForeground(MAIN_DISPLAY(ss), ss->selected_selection_gc, (Pixel)(XOR(color, ss->selected_graph_color)));
-}
-
-
-void color_graph(Pixel color)
-{
- Display *dpy;
- dpy = MAIN_DISPLAY(ss);
- ss->graph_color = color;
- XSetBackground(dpy, ss->basic_gc, color);
- XSetForeground(dpy, ss->erase_gc, color);
- XSetForeground(dpy, ss->selection_gc, (Pixel)(XOR(ss->selection_color, color)));
- XSetForeground(dpy, ss->cursor_gc, (Pixel)(XOR(ss->cursor_color, color)));
- XSetForeground(dpy, ss->mark_gc, (Pixel)(XOR(ss->mark_color, color)));
-}
-
-
-void color_selected_graph(Pixel color)
-{
- Display *dpy;
- dpy = MAIN_DISPLAY(ss);
- ss->selected_graph_color = color;
- XSetBackground(dpy, ss->selected_basic_gc, color);
- XSetForeground(dpy, ss->selected_erase_gc, color);
- XSetForeground(dpy, ss->selected_selection_gc, (Pixel)(XOR(ss->selection_color, color)));
- XSetForeground(dpy, ss->selected_cursor_gc, (Pixel)(XOR(ss->cursor_color, color)));
- XSetForeground(dpy, ss->selected_mark_gc, (Pixel)(XOR(ss->mark_color, color)));
-}
-
-
-void color_data(Pixel color)
-{
- Display *dpy;
- dpy = MAIN_DISPLAY(ss);
- ss->data_color = color;
- XSetForeground(dpy, ss->basic_gc, color);
- XSetBackground(dpy, ss->erase_gc, color);
-}
-
-
-void color_selected_data(Pixel color)
-{
- Display *dpy;
- dpy = MAIN_DISPLAY(ss);
- ss->selected_data_color = color;
- XSetForeground(dpy, ss->selected_basic_gc, color);
- XSetBackground(dpy, ss->selected_erase_gc, color);
-}
-
-
-void recolor_graph(chan_info *cp, bool selected)
-{
- XtVaSetValues(channel_graph(cp), XmNbackground, (selected) ? ss->selected_graph_color : ss->graph_color, NULL);
-}
-
-
-void set_mix_color(Pixel color)
-{
- /* called only from g_set_mix_color -- docs imply it changes existing colors */
- Display *dpy;
- dpy = MAIN_DISPLAY(ss);
- ss->mix_color = color;
- XSetForeground(dpy, ss->mix_gc, color);
-
-}
-
-
-void set_sensitive(Widget wid, bool val)
-{
- if (wid) XtSetSensitive(wid, val);
-}
-
-
-void set_toggle_button(Widget wid, bool val, bool passed, void *ignore)
-{
- XmToggleButtonSetState(wid, (Boolean)val, (Boolean)passed);
-}
-
-
-Dimension widget_height(Widget w)
-{
- Dimension height;
- XtVaGetValues(w, XmNheight, &height, NULL);
- return(height);
-}
-
-
-Dimension widget_width(Widget w)
-{
- Dimension width;
- XtVaGetValues(w, XmNwidth, &width, NULL);
- return(width);
-}
-
-
-void set_widget_height(Widget w, Dimension height)
-{
- XtVaSetValues(w, XmNheight, height, NULL);
-}
-
-
-void set_widget_width(Widget w, Dimension width)
-{
- XtVaSetValues(w, XmNwidth, width, NULL);
-}
-
-
-void set_widget_size(Widget w, Dimension width, Dimension height)
-{
- XtVaSetValues(w, XmNwidth, width, XmNheight, height, NULL);
-}
-
-
-Position widget_x(Widget w)
-{
- Position x;
- XtVaGetValues(w, XmNx, &x, NULL);
- return(x);
-}
-
-
-Position widget_y(Widget w)
-{
- Position y;
- XtVaGetValues(w, XmNy, &y, NULL);
- return(y);
-}
-
-
-void set_widget_x(Widget w, Position x)
-{
- XtVaSetValues(w, XmNx, x, NULL);
-}
-
-
-void set_widget_y(Widget w, Position y)
-{
- XtVaSetValues(w, XmNy, y, NULL);
-}
-
-
-void set_widget_position(Widget w, Position x, Position y)
-{
- XtVaSetValues(w, XmNx, x, XmNy, y, NULL);
-}
-
-
-idle_t add_work_proc(XtWorkProc func, XtPointer data)
-{
- /* during auto-testing I need to force the background procs to run to completion */
- if (with_background_processes(ss))
- return(XtAppAddWorkProc(MAIN_APP(ss), func, data));
- else
- {
- while (((*func)(data)) == BACKGROUND_CONTINUE) ;
- return((idle_t)0);
- }
-}
-
-
-int attach_all_sides(Arg *args, int n)
-{
- XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
- XtSetArg(args[n], XmNbottomAttachment, XmATTACH_FORM); n++;
- return(n);
-}
-
-
-void widget_int_to_text(Widget w, int val)
-{
- char *str;
- str = (char *)calloc(8, sizeof(char));
- mus_snprintf(str, 8, "%d", val);
- XmTextFieldSetString(w, str);
- free(str);
-}
-
-
-void widget_mus_long_t_to_text(Widget w, mus_long_t val)
-{
- char *str;
- str = (char *)calloc(32, sizeof(char));
- mus_snprintf(str, 32, MUS_LD, val);
- XmTextFieldSetString(w, str);
- free(str);
-}
-
-
-static Pixmap rotate_text(Widget w, const char *str, XFontStruct *font, mus_float_t angle_in_degrees, int *nw, int *nh, Pixel bg, Pixel fg, GC d_gc)
-{
- /* rotate clockwise by angle_in_degrees degrees (i.e. 45 points text south-east),
- * new bounding box (text centered in it) returned in nw and nh
- * bg = background color, fg = foreground (text) color)
- */
- mus_float_t matrix[4];
- mus_float_t angle_in_radians;
- XImage *before, *after;
- Pixmap pix, rotpix;
- unsigned int width, height, depth, nwidth, nheight, x, y, nx, ny, tx, ty, depth_bytes;
- char *data;
- unsigned long px;
- Display *dp;
- Drawable wn;
- Visual *vis;
- int scr;
- int bx0 = 0, bx1 = 0, by0 = 0, by1 = 0, b;
- if (str == NULL) return(BadPixmap);
-
- angle_in_radians = mus_degrees_to_radians(angle_in_degrees);
- matrix[0] = cos(angle_in_radians);
- matrix[1] = sin(angle_in_radians);
- matrix[2] = -sin(angle_in_radians);
- matrix[3] = cos(angle_in_radians);
-
- dp = XtDisplay(w);
- wn = XtWindow(w);
- scr = DefaultScreen(dp);
- vis = DefaultVisual(dp, scr);
-
- XtVaGetValues(w, XmNdepth, &depth, NULL);
- depth_bytes = (depth >> 3);
- if (depth_bytes == 0) depth_bytes = 1; /* unsigned so can't be negative */
-
- /* find extent of original text, expand out to byte boundaries */
- XSetFont(dp, d_gc, font->fid);
- width = XTextWidth(font, str, strlen(str)) + 8;
- height = (font->ascent + font->descent) + 8;
- if (width % 8) width = 8 * (1 + (int)(width / 8));
- if (height % 8) height = 8 * (1 + (int)(height / 8));
-
- /* get bounding box of rotated text (this could be simplfied -- used to involve scaling) */
- b = (int)(width * matrix[0]);
- if (b < 0) bx0 = b; else bx1 = b;
- b = (int)(height * matrix[2]);
- if (b < 0) bx0 += b; else bx1 += b;
- b = (int)(width * matrix[1]);
- if (b < 0) by0 = b; else by1 = b;
- b = (int)(height * matrix[3]);
- if (b < 0) by0 += b; else by1 += b;
-
- /* set translation vector so we're centered in the resultant pixmap */
- if (bx0 < 0) tx = -bx0; else tx = 0;
- if (by0 < 0) ty = -by0; else ty = 0;
- nx = bx1 - bx0;
- ny = by1 - by0;
-
- /* expand result bounds to byte boundaries */
- if (nx % 8) nwidth = 8 * (1 + (int)(nx / 8)); else nwidth = nx;
- if (ny % 8) nheight = 8 * (1 + (int)(ny / 8)); else nheight = ny;
- (*nw) = nwidth;
- (*nh) = nheight;
-
- XSetBackground(dp, d_gc, bg);
- XSetForeground(dp, d_gc, bg);
-
- /* create pixmaps, fill with background color, write string to pix */
- pix = XCreatePixmap(dp, wn, width, height, depth);
- rotpix= XCreatePixmap(dp, wn, nwidth, nheight, depth);
- XFillRectangle(dp, pix, d_gc, 0, 0, width, height);
- XFillRectangle(dp, rotpix, d_gc, 0, 0, nwidth, nheight);
-#if HAVE_SUN
- XSync(dp, 0);
- /* needed to get the numbers drawn at all */
-#endif
- XSetForeground(dp, d_gc, fg);
- XDrawImageString(dp, pix, d_gc, 4, height - 4, str, strlen(str));
-
- /* dump pixmap bits into an image; image data will be freed automatically later */
- data = (char *)calloc((width + 1) * (height + 1) * depth_bytes, sizeof(char)); /* not calloc since X will free this */
- before = XCreateImage(dp, vis, depth, XYPixmap, 0, data, width, height, 8, 0);
- XGetSubImage(dp, pix, 0, 0, width, height, AllPlanes, XYPixmap, before, 0, 0);
- data = (char *)calloc((nwidth + 1) * (nheight + 1) * depth_bytes, sizeof(char));
- after = XCreateImage(dp, vis, depth, XYPixmap, 0, data, nwidth, nheight, 8, 0);
-
- /* clear background of result image */
- for (x = 0; x < nwidth; x++)
- for (y = 0; y < nheight; y++)
- XPutPixel(after, x, y, bg);
-
- /* write rotated pixels to result image */
- for (x = 0; x < width; x++)
- for (y = 0; y < height; y++)
- {
- px = XGetPixel(before, x, y);
- if (px != bg)
- XPutPixel(after,
- mus_iclamp(0, (int)snd_round(tx + x * matrix[0] + y * matrix[2]), nwidth - 1),
- mus_iclamp(0, (int)snd_round(ty + x * matrix[1] + y * matrix[3]), nheight - 1),
- px);
- }
-
- /* dump image into result pixmap (needed for later display) */
- XPutImage(dp, rotpix, d_gc, after, 0, 0, 0, 0, nwidth, nheight);
-
- /* cleanup */
- XDestroyImage(before); /* frees data as well */
- XDestroyImage(after);
- XFreePixmap(dp, pix);
- return(rotpix);
-}
-
-
-void draw_rotated_axis_label(chan_info *cp, graphics_context *ax, const char *text, int x0, int y0)
-{
- Pixmap pix;
- int h = 0, w = 0;
- XGCValues gv;
- Display *dp;
- Widget widget;
-
- if ((cp->chan > 0) && (cp->sound->channel_style == CHANNELS_COMBINED))
- widget = channel_graph(cp->sound->chans[0]);
- else widget = channel_graph(cp);
- dp = XtDisplay(widget);
- XGetGCValues(MAIN_DISPLAY(ss), ax->gc, GCForeground | GCBackground, &gv);
-
- pix = rotate_text(widget, text, AXIS_LABEL_FONT(ss), -90.0, &w, &h, gv.background, gv.foreground, ax->gc);
-
- XCopyArea(dp, pix, XtWindow(widget), ax->gc, 0, 0, w, h, x0, y0); /* XtWindow?? */
- XFreePixmap(dp, pix);
-}
-
-
-void ensure_list_row_visible(widget_t list, int pos)
-{
- if (pos >= 0)
- {
- int top, visible, num_rows;
- XtVaGetValues(list,
- XmNtopItemPosition, &top,
- XmNvisibleItemCount, &visible,
- XmNitemCount, &num_rows,
- NULL);
- if (pos <= top)
- XmListSetPos(list, pos); /* was pos+1?? (new file dialog data format list off by 1 in that case) */
- else
- {
- if (pos >= (top + visible))
- {
- if ((pos + visible) > num_rows)
- XmListSetBottomPos(list, num_rows);
- else XmListSetPos(list, pos);
- }
- }
- }
-}
-
-
-void ensure_scrolled_window_row_visible(widget_t list, int row, int num_rows)
-{
- int minimum, maximum, value, size, new_value, increment, page_increment;
- Widget scrollbar, work_window;
-
- XtVaGetValues(list,
- XmNverticalScrollBar, &scrollbar,
- XmNworkWindow, &work_window,
- NULL);
-
- XtVaGetValues(scrollbar,
- XmNminimum, &minimum,
- XmNmaximum, &maximum,
- XmNvalue, &value,
- XmNsliderSize, &size,
- XmNincrement, &increment, /* needed for XmScrollBarSetValues which is needed to force list display update */
- XmNpageIncrement, &page_increment,
- NULL);
-
- maximum -= size;
- if (row == 0)
- new_value = 0;
- else
- {
- if (row >= (num_rows - 1))
- new_value = maximum;
- else new_value = (int)((row + 0.5) * ((float)(maximum - minimum) / (float)(num_rows - 1)));
- }
- XmScrollBarSetValues(scrollbar, new_value, size, increment, page_increment, true);
-}
-
-
-XmString multi_line_label(const char *s, int *lines)
-{
- /* taken from the Motif FAQ */
- XmString xms1, xms2, line, separator;
- char *p, *tmp;
-
- (*lines) = 1;
- tmp = mus_strdup(s);
- separator = XmStringSeparatorCreate();
- p = strtok(tmp, "\n");
- xms1 = XmStringCreateLocalized(p);
-
- p = strtok(NULL, "\n");
- while (p)
- {
- (*lines)++;
- line = XmStringCreateLocalized(p);
- xms2 = XmStringConcat(xms1, separator);
- XmStringFree(xms1);
- xms1 = XmStringConcat(xms2, line);
- XmStringFree(xms2);
- XmStringFree(line);
- p = strtok(NULL, "\n");
- }
-
- XmStringFree(separator);
- free(tmp);
- return(xms1);
-}
-
diff --git a/snd.1 b/snd.1
index 29a5de5..1fd56c9 100644
--- a/snd.1
+++ b/snd.1
@@ -10,9 +10,7 @@ Snd is a sound editor.
.PP
.B Snd
is free software.
-It's available as source, prebuilt images, and rpm packages
-at http://ccrma.stanford.edu/ and ftp://ccrma-ftp.stanford.edu/pub/Lisp/.
-The 'official' version is at http://sourceforge.net/projects/snd/.
+It's available at ftp://ccrma-ftp.stanford.edu/pub/Lisp/.
.SH USAGE
snd oboe.snd
@@ -23,12 +21,8 @@ loads oboe.snd into Snd.
Load extension language code in file.
.IP \-p dir
Preload sound files found in directory dir.
-.IP \-noglob
-Don't load any global configuration files.
.IP \-noinit
Don't load any initialization files (~/.snd et al).
-.IP \-nogtkrc
-Don't look for any gtkrc stuff.
.IP \-\-help
Give some help.
.IP \-\-version
@@ -41,6 +35,5 @@ a file that can contain local customization code.
.SH AUTHORS
Bill Schottstaedt <bil at ccrma.stanford.edu>
Michael Scholz
-Kjetil Matheussen
with many generous far-flung helpers.
diff --git a/snd.c b/snd.c
index 083bbbd..326bd66 100644
--- a/snd.c
+++ b/snd.c
@@ -9,22 +9,22 @@ snd_state *ss = NULL;
static bool ignore_mus_error(int type, char *msg)
{
- XEN result = XEN_FALSE;
+ Xen result = Xen_false;
- if (XEN_HOOKED(ss->mus_error_hook))
+ if (Xen_hook_has_list(ss->mus_error_hook))
result = run_or_hook(ss->mus_error_hook,
- XEN_LIST_2(C_TO_XEN_INT(type),
- C_TO_XEN_STRING(msg)),
+ Xen_list_2(C_int_to_Xen_integer(type),
+ C_string_to_Xen_string(msg)),
S_mus_error_hook);
- return(XEN_NOT_FALSE_P(result));
+ return(Xen_is_true(result));
}
-#if HAVE_SETJMP_H
+#ifndef _MSC_VER
void top_level_catch(int ignore);
#endif
-void mus_error_to_snd(int type, char *msg)
+static void mus_error_to_snd(int type, char *msg)
{
if (!ss)
{
@@ -36,13 +36,13 @@ void mus_error_to_snd(int type, char *msg)
{
#if HAVE_EXTENSION_LANGUAGE
if (msg == NULL)
- XEN_ERROR(XEN_ERROR_TYPE("mus-error"),
- XEN_LIST_1(C_TO_XEN_STRING((char *)mus_error_type_to_string(type))));
- else XEN_ERROR(XEN_ERROR_TYPE("mus-error"),
- XEN_LIST_1(C_TO_XEN_STRING(msg)));
+ Xen_error(Xen_make_error_type("mus-error"),
+ Xen_list_1(C_string_to_Xen_string((char *)mus_error_type_to_string(type))));
+ else Xen_error(Xen_make_error_type("mus-error"),
+ Xen_list_1(C_string_to_Xen_string(msg)));
#endif
snd_error("%s: %s", mus_error_type_to_string(type), msg);
-#if HAVE_SETJMP_H
+#ifndef _MSC_VER
ss->jump_ok = true;
top_level_catch(1); /* sigh -- try to keep going */
#endif
@@ -122,7 +122,7 @@ static void initialize_load_path(void)
for (i = curdir - 1; i >= 0; i--)
{
- XEN_ADD_TO_LOAD_PATH(dirnames[i]);
+ Xen_add_to_load_path(dirnames[i]);
free(dirnames[i]);
}
free(dirnames);
@@ -145,9 +145,9 @@ void snd_set_global_defaults(bool need_cleanup)
if (ss->Open_File_Dialog_Directory) {free(ss->Open_File_Dialog_Directory); ss->Open_File_Dialog_Directory = NULL;}
/* not sure about the next two... */
- if ((cursor_style(ss) == CURSOR_PROC) && (XEN_PROCEDURE_P(ss->cursor_proc)))
+ if ((cursor_style(ss) == CURSOR_PROC) && (Xen_is_procedure(ss->cursor_proc)))
snd_unprotect_at(ss->cursor_proc_loc);
- if ((zoom_focus_style(ss) == ZOOM_FOCUS_PROC) && (XEN_PROCEDURE_P(ss->zoom_focus_proc)))
+ if ((zoom_focus_style(ss) == ZOOM_FOCUS_PROC) && (Xen_is_procedure(ss->zoom_focus_proc)))
snd_unprotect_at(ss->zoom_focus_proc_loc);
}
@@ -174,9 +174,7 @@ void snd_set_global_defaults(bool need_cleanup)
ss->Default_Output_Chans = DEFAULT_OUTPUT_CHANS;
ss->Default_Output_Srate = DEFAULT_OUTPUT_SRATE;
ss->Default_Output_Header_Type = DEFAULT_OUTPUT_HEADER_TYPE;
- ss->Default_Output_Data_Format = DEFAULT_OUTPUT_DATA_FORMAT;
- ss->Audio_Input_Device = DEFAULT_AUDIO_INPUT_DEVICE;
- ss->Audio_Output_Device = DEFAULT_AUDIO_OUTPUT_DEVICE;
+ ss->Default_Output_Sample_Type = DEFAULT_OUTPUT_SAMPLE_TYPE;
ss->Dac_Size = DEFAULT_DAC_SIZE;
ss->Dac_Combines_Channels = DEFAULT_DAC_COMBINES_CHANNELS;
ss->Auto_Resize = DEFAULT_AUTO_RESIZE;
@@ -190,6 +188,7 @@ void snd_set_global_defaults(bool need_cleanup)
ss->Save_As_Dialog_Src = DEFAULT_SAVE_AS_DIALOG_SRC;
ss->Save_As_Dialog_Auto_Comment = DEFAULT_SAVE_AS_DIALOG_AUTO_COMMENT;
ss->Show_Full_Duration = DEFAULT_SHOW_FULL_DURATION;
+ ss->Show_Full_Range = DEFAULT_SHOW_FULL_RANGE;
ss->Initial_Beg = DEFAULT_INITIAL_BEG;
ss->Initial_Dur = DEFAULT_INITIAL_DUR;
ss->With_Background_Processes = DEFAULT_WITH_BACKGROUND_PROCESSES;
@@ -209,15 +208,15 @@ void snd_set_global_defaults(bool need_cleanup)
ss->Dot_Size = DEFAULT_DOT_SIZE;
ss->Grid_Density = DEFAULT_GRID_DENSITY;
ss->Zoom_Focus_Style = DEFAULT_ZOOM_FOCUS_STYLE;
- ss->zoom_focus_proc = XEN_UNDEFINED;
+ ss->zoom_focus_proc = Xen_undefined;
ss->zoom_focus_proc_loc = NOT_A_GC_LOC;
ss->Max_Regions = DEFAULT_MAX_REGIONS;
ss->Show_Y_Zero = DEFAULT_SHOW_Y_ZERO;
ss->Show_Grid = DEFAULT_SHOW_GRID;
ss->Show_Axes = DEFAULT_SHOW_AXES;
ss->Show_Indices = DEFAULT_SHOW_INDICES;
- ss->Show_Backtrace = DEFAULT_SHOW_BACKTRACE;
ss->With_Inset_Graph = DEFAULT_WITH_INSET_GRAPH;
+ ss->With_Interrupts = DEFAULT_WITH_INTERRUPTS;
ss->With_Menu_Icons = DEFAULT_WITH_MENU_ICONS;
ss->With_Smpte_Label = DEFAULT_WITH_SMPTE_LABEL;
ss->With_Pointer_Focus = DEFAULT_WITH_POINTER_FOCUS;
@@ -225,9 +224,7 @@ void snd_set_global_defaults(bool need_cleanup)
ss->Sync_Style = DEFAULT_SYNC_STYLE;
ss->Listener_Prompt = mus_strdup(DEFAULT_LISTENER_PROMPT);
ss->listener_prompt_length = mus_strlen(ss->Listener_Prompt);
- ss->Minibuffer_History_Length = DEFAULT_MINIBUFFER_HISTORY_LENGTH;
ss->Clipping = DEFAULT_CLIPPING;
- ss->Optimization = DEFAULT_OPTIMIZATION;
ss->Print_Length = DEFAULT_PRINT_LENGTH;
ss->View_Files_Sort = DEFAULT_VIEW_FILES_SORT;
ss->Just_Sounds = DEFAULT_JUST_SOUNDS;
@@ -238,9 +235,9 @@ void snd_set_global_defaults(bool need_cleanup)
ss->Cursor_Style = DEFAULT_CURSOR_STYLE;
ss->Tracking_Cursor_Style = DEFAULT_TRACKING_CURSOR_STYLE;
ss->With_Tracking_Cursor = DEFAULT_WITH_TRACKING_CURSOR;
- ss->cursor_proc = XEN_UNDEFINED;
+ ss->cursor_proc = Xen_undefined;
ss->cursor_proc_loc = NOT_A_GC_LOC;
- ss->Verbose_Cursor = DEFAULT_VERBOSE_CURSOR;
+ ss->With_Verbose_Cursor = DEFAULT_WITH_VERBOSE_CURSOR;
ss->Cursor_Update_Interval = DEFAULT_CURSOR_UPDATE_INTERVAL;
ss->Cursor_Location_Offset = DEFAULT_CURSOR_LOCATION_OFFSET;
ss->Show_Mix_Waveforms = DEFAULT_SHOW_MIX_WAVEFORMS;
@@ -270,7 +267,7 @@ void snd_set_global_defaults(bool need_cleanup)
ss->Spectrum_Start = DEFAULT_SPECTRUM_START;
ss->Enved_Base = DEFAULT_ENVED_BASE;
ss->Enved_Power = DEFAULT_ENVED_POWER;
- ss->Enved_Wave_p = DEFAULT_ENVED_WAVE_P;
+ ss->Enved_With_Wave = DEFAULT_ENVED_WITH_WAVE;
ss->Enved_Style = DEFAULT_ENVED_STYLE;
ss->Enved_Target = DEFAULT_ENVED_TARGET;
ss->Enved_Filter_Order = DEFAULT_ENVED_FILTER_ORDER;
@@ -327,15 +324,192 @@ void snd_set_global_defaults(bool need_cleanup)
if (DEFAULT_EPS_FILE != (char *)NULL)
ss->Eps_File = mus_strdup(DEFAULT_EPS_FILE);
else ss->Eps_File = NULL;
-}
+#if HAVE_SCHEME
+ ss->eps_file_symbol = s7_define_variable(s7, "*" S_eps_file "*", s7_make_string(s7, DEFAULT_EPS_FILE));
+ ss->enved_filter_order_symbol = s7_define_variable(s7, "*" S_enved_filter_order "*", s7_make_integer(s7, DEFAULT_ENVED_FILTER_ORDER));
+ ss->eps_left_margin_symbol = s7_define_variable(s7, "*" S_eps_left_margin "*", s7_make_real(s7, DEFAULT_EPS_LEFT_MARGIN));
+ ss->eps_bottom_margin_symbol = s7_define_variable(s7, "*" S_eps_bottom_margin "*", s7_make_real(s7, DEFAULT_EPS_BOTTOM_MARGIN));
+ ss->eps_size_symbol = s7_define_variable(s7, "*" S_eps_size "*", s7_make_real(s7, DEFAULT_EPS_SIZE));
+ ss->log_freq_start_symbol = s7_define_variable(s7, "*" S_log_freq_start "*", s7_make_real(s7, DEFAULT_LOG_FREQ_START));
+ ss->color_map_symbol = s7_define_variable(s7, "*" S_colormap "*", s7_make_integer(s7, DEFAULT_COLOR_MAP));
+ ss->color_map_size_symbol = s7_define_variable(s7, "*" S_colormap_size "*", s7_make_integer(s7, DEFAULT_COLOR_MAP_SIZE));
+ ss->mix_waveform_height_symbol = s7_define_variable(s7, "*" S_mix_waveform_height "*", s7_make_integer(s7, DEFAULT_MIX_WAVEFORM_HEIGHT));
+ ss->sinc_width_symbol = s7_define_variable(s7, "*" S_sinc_width "*", s7_make_integer(s7, DEFAULT_SINC_WIDTH));
+ ss->region_graph_style_symbol = s7_define_variable(s7, "*" S_region_graph_style "*", s7_make_integer(s7, ss->Region_Graph_Style));
+ ss->max_regions_symbol = s7_define_variable(s7, "*" S_max_regions "*", s7_make_integer(s7, DEFAULT_MAX_REGIONS));
+ ss->with_gl_symbol = s7_define_variable(s7, "*" S_with_gl "*", s7_make_boolean(s7, DEFAULT_WITH_GL));
+ ss->with_relative_panes_symbol = s7_define_variable(s7, "*" S_with_relative_panes "*", s7_make_boolean(s7, DEFAULT_WITH_RELATIVE_PANES));
+ ss->dac_size_symbol = s7_define_variable(s7, "*" S_dac_size "*", s7_make_integer(s7, DEFAULT_DAC_SIZE));
+ ss->view_files_sort_symbol = s7_define_variable(s7, "*" S_view_files_sort "*", s7_make_integer(s7, DEFAULT_VIEW_FILES_SORT));
+ ss->dac_combines_channels_symbol = s7_define_variable(s7, "*" S_dac_combines_channels "*", s7_make_boolean(s7, DEFAULT_DAC_COMBINES_CHANNELS));
+ ss->show_selection_transform_symbol = s7_define_variable(s7, "*" S_show_selection_transform "*", s7_make_boolean(s7, DEFAULT_SHOW_SELECTION_TRANSFORM));
+ ss->with_mix_tags_symbol = s7_define_variable(s7, "*" S_with_mix_tags "*", s7_make_boolean(s7, DEFAULT_WITH_MIX_TAGS));
+ ss->listener_prompt_symbol = s7_define_variable(s7, "*" S_listener_prompt "*", s7_make_string(s7, DEFAULT_LISTENER_PROMPT));
+ ss->enved_base_symbol = s7_define_variable(s7, "*" S_enved_base "*", s7_make_real(s7, DEFAULT_ENVED_BASE));
+ ss->enved_power_symbol = s7_define_variable(s7, "*" S_enved_power "*", s7_make_real(s7, DEFAULT_ENVED_POWER));
+ ss->enved_with_wave_symbol = s7_define_variable(s7, "*" S_enved_with_wave "*", s7_make_boolean(s7, DEFAULT_ENVED_WITH_WAVE));
+ ss->enved_style_symbol = s7_define_variable(s7, "*" S_enved_style "*", s7_make_integer(s7, DEFAULT_ENVED_STYLE));
+ ss->graph_cursor_symbol = s7_define_variable(s7, "*" S_graph_cursor "*", s7_make_integer(s7, DEFAULT_GRAPH_CURSOR));
+ ss->mix_tag_width_symbol = s7_define_variable(s7, "*" S_mix_tag_width "*", s7_make_integer(s7, DEFAULT_MIX_TAG_WIDTH));
+ ss->mix_tag_height_symbol = s7_define_variable(s7, "*" S_mix_tag_height "*", s7_make_integer(s7, DEFAULT_MIX_TAG_HEIGHT));
+ ss->mark_tag_height_symbol = s7_define_variable(s7, "*" S_mark_tag_height "*", s7_make_integer(s7, DEFAULT_MARK_TAG_HEIGHT));
+ ss->mark_tag_width_symbol = s7_define_variable(s7, "*" S_mark_tag_width "*", s7_make_integer(s7, DEFAULT_MARK_TAG_WIDTH));
+ ss->enved_target_symbol = s7_define_variable(s7, "*" S_enved_target "*", s7_make_integer(s7, DEFAULT_ENVED_TARGET));
+ ss->cursor_update_interval_symbol = s7_define_variable(s7, "*" S_cursor_update_interval "*", s7_make_real(s7, DEFAULT_CURSOR_UPDATE_INTERVAL));
+ ss->cursor_location_offset_symbol = s7_define_variable(s7, "*" S_cursor_location_offset "*", s7_make_integer(s7, DEFAULT_CURSOR_LOCATION_OFFSET));
+ ss->show_controls_symbol = s7_define_variable(s7, "*" S_show_controls "*", s7_make_boolean(s7, DEFAULT_SHOW_CONTROLS));
+ ss->with_tracking_cursor_symbol = s7_define_variable(s7, "*" S_with_tracking_cursor "*", s7_make_integer(s7, (int)DEFAULT_WITH_TRACKING_CURSOR));
+ ss->html_dir_symbol = s7_define_variable(s7, "*" S_html_dir "*", s7_make_string(s7, DEFAULT_HTML_DIR));
+ ss->html_program_symbol = s7_define_variable(s7, "*" S_html_program "*", s7_make_string(s7, DEFAULT_HTML_PROGRAM));
+ ss->open_file_dialog_directory_symbol = s7_define_variable(s7, "*" S_open_file_dialog_directory "*", s7_make_string(s7, ss->Open_File_Dialog_Directory));
+
+ /* snd-file.c */
+ ss->auto_update_symbol = s7_define_variable(s7, "*" S_auto_update "*", s7_make_boolean(s7, DEFAULT_AUTO_UPDATE));
+ ss->auto_update_interval_symbol = s7_define_variable(s7, "*" S_auto_update_interval "*", s7_make_real(s7, DEFAULT_AUTO_UPDATE_INTERVAL));
+ ss->clipping_symbol = s7_define_variable(s7, "*" S_clipping "*", s7_make_boolean(s7, DEFAULT_CLIPPING));
+ ss->default_output_header_type_symbol = s7_define_variable(s7, "*" S_default_output_header_type "*", s7_make_integer(s7, DEFAULT_OUTPUT_HEADER_TYPE));
+ ss->default_output_sample_type_symbol = s7_define_variable(s7, "*" S_default_output_sample_type "*", s7_make_integer(s7, DEFAULT_OUTPUT_SAMPLE_TYPE));
+ ss->default_output_chans_symbol = s7_define_variable(s7, "*" S_default_output_chans "*", s7_make_integer(s7, DEFAULT_OUTPUT_CHANS));
+ ss->default_output_srate_symbol = s7_define_variable(s7, "*" S_default_output_srate "*", s7_make_integer(s7, DEFAULT_OUTPUT_SRATE));
+ ss->ask_before_overwrite_symbol = s7_define_variable(s7, "*" S_ask_before_overwrite "*", s7_make_boolean(s7, DEFAULT_ASK_BEFORE_OVERWRITE));
+ ss->ask_about_unsaved_edits_symbol = s7_define_variable(s7, "*" S_ask_about_unsaved_edits "*", s7_make_boolean(s7, DEFAULT_ASK_ABOUT_UNSAVED_EDITS));
+ ss->show_full_duration_symbol = s7_define_variable(s7, "*" S_show_full_duration "*", s7_make_boolean(s7, DEFAULT_SHOW_FULL_DURATION));
+ ss->show_full_range_symbol = s7_define_variable(s7, "*" S_show_full_range "*", s7_make_boolean(s7, DEFAULT_SHOW_FULL_RANGE));
+ ss->remember_sound_state_symbol = s7_define_variable(s7, "*" S_remember_sound_state "*", s7_make_boolean(s7, DEFAULT_REMEMBER_SOUND_STATE));
+ ss->save_as_dialog_src_symbol = s7_define_variable(s7, "*" S_save_as_dialog_src "*", s7_make_boolean(s7, DEFAULT_SAVE_AS_DIALOG_SRC));
+ ss->save_as_dialog_auto_comment_symbol = s7_define_variable(s7, "*" S_save_as_dialog_auto_comment "*", s7_make_boolean(s7, DEFAULT_SAVE_AS_DIALOG_AUTO_COMMENT));
+ ss->with_toolbar_symbol = s7_define_variable(s7, "*" S_with_toolbar "*", s7_make_boolean(s7, DEFAULT_WITH_TOOLBAR));
+ ss->with_tooltips_symbol = s7_define_variable(s7, "*" S_with_tooltips "*", s7_make_boolean(s7, DEFAULT_WITH_TOOLTIPS));
+ ss->with_menu_icons_symbol = s7_define_variable(s7, "*" S_with_menu_icons "*", s7_make_boolean(s7, DEFAULT_WITH_MENU_ICONS));
+ ss->initial_beg_symbol = s7_define_variable(s7, "*" S_initial_beg "*", s7_make_real(s7, DEFAULT_INITIAL_BEG));
+ ss->initial_dur_symbol = s7_define_variable(s7, "*" S_initial_dur "*", s7_make_real(s7, DEFAULT_INITIAL_DUR));
+
+ /* snd-main.c */
+ ss->show_indices_symbol = s7_define_variable(s7, "*" S_show_indices "*", s7_make_boolean(s7, DEFAULT_SHOW_INDICES));
+ ss->just_sounds_symbol = s7_define_variable(s7, "*" S_just_sounds "*", s7_make_boolean(s7, DEFAULT_JUST_SOUNDS));
+ ss->play_arrow_size_symbol = s7_define_variable(s7, "*" S_play_arrow_size "*", s7_make_integer(s7, DEFAULT_PLAY_ARROW_SIZE));
+ ss->print_length_symbol = s7_define_variable(s7, "*" S_print_length "*", s7_make_integer(s7, DEFAULT_PRINT_LENGTH));
+ ss->selection_creates_region_symbol = s7_define_variable(s7, "*" S_selection_creates_region "*", s7_make_boolean(s7, DEFAULT_SELECTION_CREATES_REGION));
+ ss->save_state_file_symbol = s7_define_variable(s7, "*" S_save_state_file "*", s7_make_string(s7, DEFAULT_SAVE_STATE_FILE));
+ ss->with_background_processes_symbol = s7_define_variable(s7, "*" S_with_background_processes "*", s7_make_boolean(s7, DEFAULT_WITH_BACKGROUND_PROCESSES));
+ ss->with_file_monitor_symbol = s7_define_variable(s7, "*" S_with_file_monitor "*", s7_make_boolean(s7, DEFAULT_WITH_FILE_MONITOR));
+ ss->temp_dir_symbol = s7_define_variable(s7, "*" S_temp_dir "*", s7_make_string(s7, ss->Temp_Dir));
+ ss->save_dir_symbol = s7_define_variable(s7, "*" S_save_dir "*", s7_make_string(s7, ss->Save_Dir));
+ ss->ladspa_dir_symbol = s7_define_variable(s7, "*" S_ladspa_dir "*", s7_make_string(s7, DEFAULT_LADSPA_DIR));
+ ss->peak_env_dir_symbol = s7_define_variable(s7, "*" S_peak_env_dir "*", s7_make_string(s7, DEFAULT_PEAK_ENV_DIR));
+ ss->axis_label_font_symbol = s7_define_variable(s7, "*" S_axis_label_font "*", s7_make_string(s7, DEFAULT_AXIS_LABEL_FONT));
+ ss->axis_numbers_font_symbol = s7_define_variable(s7, "*" S_axis_numbers_font "*", s7_make_string(s7, DEFAULT_AXIS_NUMBERS_FONT));
+ ss->tiny_font_symbol = s7_define_variable(s7, "*" S_tiny_font "*", s7_make_string(s7, DEFAULT_TINY_FONT));
+ ss->peaks_font_symbol = s7_define_variable(s7, "*" S_peaks_font "*", s7_make_string(s7, DEFAULT_PEAKS_FONT));
+ ss->bold_peaks_font_symbol = s7_define_variable(s7, "*" S_bold_peaks_font "*", s7_make_string(s7, DEFAULT_BOLD_PEAKS_FONT));
+ ss->with_inset_graph_symbol = s7_define_variable(s7, "*" S_with_inset_graph "*", s7_make_boolean(s7, DEFAULT_WITH_INSET_GRAPH));
+ ss->with_pointer_focus_symbol = s7_define_variable(s7, "*" S_with_pointer_focus "*", s7_make_boolean(s7, DEFAULT_WITH_POINTER_FOCUS));
+ ss->with_smpte_label_symbol = s7_define_variable(s7, "*" S_with_smpte_label "*", s7_make_boolean(s7, DEFAULT_WITH_SMPTE_LABEL));
+ ss->with_interrupts_symbol = s7_define_variable(s7, "*" S_with_interrupts "*", s7_make_boolean(s7, DEFAULT_WITH_INTERRUPTS));
+ ss->color_scale_symbol = s7_define_variable(s7, "*" S_color_scale "*", s7_make_real(s7, DEFAULT_COLOR_SCALE));
+ ss->color_cutoff_symbol = s7_define_variable(s7, "*" S_color_cutoff "*", s7_make_real(s7, DEFAULT_COLOR_CUTOFF));
+ ss->color_inverted_symbol = s7_define_variable(s7, "*" S_color_inverted "*", s7_make_boolean(s7, DEFAULT_COLOR_INVERTED));
+ ss->auto_resize_symbol = s7_define_variable(s7, "*" S_auto_resize "*", s7_make_boolean(s7, DEFAULT_AUTO_RESIZE));
+#if USE_MOTIF
+ #define DEFAULT_LISTENER_FONT "9x15"
+#endif
+#if (!USE_NO_GUI)
+ ss->listener_font_symbol = s7_define_variable(s7, "*" S_listener_font "*", s7_make_string(s7, DEFAULT_LISTENER_FONT));
+#else
+ ss->listener_font_symbol = s7_define_variable(s7, "*" S_listener_font "*", s7_make_string(s7, ""));
+#endif
-#if HAVE_SETJMP_H && HAVE_SCHEME
-static void jump_to_top_level(void)
-{
- top_level_catch(1);
-}
+ /* snd-snd.c */
+ ss->channel_style_symbol = s7_define_variable(s7, "*" S_channel_style "*", s7_make_integer(s7, DEFAULT_CHANNEL_STYLE));
+ ss->filter_control_in_db_symbol = s7_define_variable(s7, "*" S_filter_control_in_dB "*", s7_make_boolean(s7, DEFAULT_FILTER_CONTROL_IN_DB));
+ ss->filter_control_in_hz_symbol = s7_define_variable(s7, "*" S_filter_control_in_hz "*", s7_make_boolean(s7, DEFAULT_FILTER_CONTROL_IN_HZ));
+ ss->speed_control_tones_symbol = s7_define_variable(s7, "*" S_speed_control_tones "*", s7_make_integer(s7, DEFAULT_SPEED_CONTROL_TONES));
+ ss->speed_control_style_symbol = s7_define_variable(s7, "*" S_speed_control_style "*", s7_make_integer(s7, DEFAULT_SPEED_CONTROL_STYLE));
+ ss->expand_control_length_symbol = s7_define_variable(s7, "*" S_expand_control_length "*", s7_make_real(s7, DEFAULT_EXPAND_CONTROL_LENGTH));
+ ss->expand_control_ramp_symbol = s7_define_variable(s7, "*" S_expand_control_ramp "*", s7_make_real(s7, DEFAULT_EXPAND_CONTROL_RAMP));
+ ss->expand_control_hop_symbol = s7_define_variable(s7, "*" S_expand_control_hop "*", s7_make_real(s7, DEFAULT_EXPAND_CONTROL_HOP));
+ ss->expand_control_jitter_symbol = s7_define_variable(s7, "*" S_expand_control_jitter "*", s7_make_real(s7, DEFAULT_EXPAND_CONTROL_JITTER));
+ ss->contrast_control_amp_symbol = s7_define_variable(s7, "*" S_contrast_control_amp "*", s7_make_real(s7, DEFAULT_CONTRAST_CONTROL_AMP));
+ ss->reverb_control_feedback_symbol = s7_define_variable(s7, "*" S_reverb_control_feedback "*", s7_make_real(s7, DEFAULT_REVERB_CONTROL_FEEDBACK));
+ ss->reverb_control_lowpass_symbol = s7_define_variable(s7, "*" S_reverb_control_lowpass "*", s7_make_real(s7, DEFAULT_REVERB_CONTROL_LOWPASS));
+ ss->reverb_control_decay_symbol = s7_define_variable(s7, "*" S_reverb_control_decay "*", s7_make_real(s7, DEFAULT_REVERB_CONTROL_DECAY));
+ ss->filter_control_order_symbol = s7_define_variable(s7, "*" S_filter_control_order "*", s7_make_integer(s7, DEFAULT_FILTER_CONTROL_ORDER));
+
+ /* snd-chn.c */
+ ss->show_transform_peaks_symbol = s7_define_variable(s7, "*" S_show_transform_peaks "*", s7_make_boolean(s7, DEFAULT_SHOW_TRANSFORM_PEAKS));
+ ss->show_y_zero_symbol = s7_define_variable(s7, "*" S_show_y_zero "*", s7_make_boolean(s7, DEFAULT_SHOW_Y_ZERO));
+ ss->show_marks_symbol = s7_define_variable(s7, "*" S_show_marks "*", s7_make_boolean(s7, DEFAULT_SHOW_MARKS));
+ ss->show_grid_symbol = s7_define_variable(s7, "*" S_show_grid "*", s7_make_boolean(s7, DEFAULT_SHOW_GRID));
+ ss->fft_log_frequency_symbol = s7_define_variable(s7, "*" S_fft_log_frequency "*", s7_make_boolean(s7, DEFAULT_FFT_LOG_FREQUENCY));
+ ss->fft_log_magnitude_symbol = s7_define_variable(s7, "*" S_fft_log_magnitude "*", s7_make_boolean(s7, DEFAULT_FFT_LOG_MAGNITUDE));
+ ss->fft_with_phases_symbol = s7_define_variable(s7, "*" S_fft_with_phases "*", s7_make_boolean(s7, DEFAULT_FFT_WITH_PHASES));
+ ss->sync_style_symbol = s7_define_variable(s7, "*" S_sync_style "*", s7_make_integer(s7, DEFAULT_SYNC_STYLE));
+ ss->show_axes_symbol = s7_define_variable(s7, "*" S_show_axes "*", s7_make_integer(s7, DEFAULT_SHOW_AXES));
+ ss->min_db_symbol = s7_define_variable(s7, "*" S_min_dB "*", s7_make_real(s7, DEFAULT_MIN_DB));
+ ss->cursor_size_symbol = s7_define_variable(s7, "*" S_cursor_size "*", s7_make_integer(s7, DEFAULT_CURSOR_SIZE));
+ ss->cursor_style_symbol = s7_define_variable(s7, "*" S_cursor_style "*", s7_make_integer(s7, DEFAULT_CURSOR_STYLE));
+ ss->tracking_cursor_style_symbol = s7_define_variable(s7, "*" S_tracking_cursor_style "*", s7_make_integer(s7, DEFAULT_TRACKING_CURSOR_STYLE));
+ ss->show_sonogram_cursor_symbol = s7_define_variable(s7, "*" S_show_sonogram_cursor "*", s7_make_boolean(s7, DEFAULT_SHOW_SONOGRAM_CURSOR));
+ ss->with_verbose_cursor_symbol = s7_define_variable(s7, "*" S_with_verbose_cursor "*", s7_make_boolean(s7, DEFAULT_WITH_VERBOSE_CURSOR));
+ ss->spectro_x_scale_symbol = s7_define_variable(s7, "*" S_spectro_x_scale "*", s7_make_real(s7, DEFAULT_SPECTRO_X_SCALE));
+ ss->spectro_y_scale_symbol = s7_define_variable(s7, "*" S_spectro_y_scale "*", s7_make_real(s7, DEFAULT_SPECTRO_Y_SCALE));
+ ss->spectro_z_scale_symbol = s7_define_variable(s7, "*" S_spectro_z_scale "*", s7_make_real(s7, DEFAULT_SPECTRO_Z_SCALE));
+ ss->spectro_z_angle_symbol = s7_define_variable(s7, "*" S_spectro_z_angle "*", s7_make_real(s7, DEFAULT_SPECTRO_Z_ANGLE));
+ ss->spectro_x_angle_symbol = s7_define_variable(s7, "*" S_spectro_x_angle "*", s7_make_real(s7, DEFAULT_SPECTRO_X_ANGLE));
+ ss->spectro_y_angle_symbol = s7_define_variable(s7, "*" S_spectro_y_angle "*", s7_make_real(s7, DEFAULT_SPECTRO_Y_ANGLE));
+ ss->spectrum_end_symbol = s7_define_variable(s7, "*" S_spectrum_end "*", s7_make_real(s7, DEFAULT_SPECTRUM_END));
+ ss->spectrum_start_symbol = s7_define_variable(s7, "*" S_spectrum_start "*", s7_make_real(s7, DEFAULT_SPECTRUM_START));
+ ss->spectro_hop_symbol = s7_define_variable(s7, "*" S_spectro_hop "*", s7_make_integer(s7, DEFAULT_SPECTRO_HOP));
+ ss->graphs_horizontal_symbol = s7_define_variable(s7, "*" S_graphs_horizontal "*", s7_make_boolean(s7, DEFAULT_GRAPHS_HORIZONTAL));
+ ss->max_transform_peaks_symbol = s7_define_variable(s7, "*" S_max_transform_peaks "*", s7_make_integer(s7, DEFAULT_MAX_TRANSFORM_PEAKS));
+ ss->fft_window_alpha_symbol = s7_define_variable(s7, "*" S_fft_window_alpha "*", s7_make_real(s7, DEFAULT_FFT_WINDOW_ALPHA));
+ ss->fft_window_beta_symbol = s7_define_variable(s7, "*" S_fft_window_beta "*", s7_make_real(s7, DEFAULT_FFT_WINDOW_BETA));
+ ss->grid_density_symbol = s7_define_variable(s7, "*" S_grid_density "*", s7_make_real(s7, DEFAULT_GRID_DENSITY));
+ ss->beats_per_minute_symbol = s7_define_variable(s7, "*" S_beats_per_minute "*", s7_make_real(s7, DEFAULT_BEATS_PER_MINUTE));
+ ss->show_mix_waveforms_symbol = s7_define_variable(s7, "*" S_show_mix_waveforms "*", s7_make_boolean(s7, DEFAULT_SHOW_MIX_WAVEFORMS));
+ ss->beats_per_measure_symbol = s7_define_variable(s7, "*" S_beats_per_measure "*", s7_make_integer(s7, DEFAULT_BEATS_PER_MEASURE));
+ ss->transform_normalization_symbol = s7_define_variable(s7, "*" S_transform_normalization "*", s7_make_integer(s7, DEFAULT_TRANSFORM_NORMALIZATION));
+ ss->x_axis_style_symbol = s7_define_variable(s7, "*" S_x_axis_style "*", s7_make_integer(s7, DEFAULT_X_AXIS_STYLE));
+ ss->zoom_focus_style_symbol = s7_define_variable(s7, "*" S_zoom_focus_style "*", s7_make_integer(s7, DEFAULT_ZOOM_FOCUS_STYLE));
+ ss->graph_style_symbol = s7_define_variable(s7, "*" S_graph_style "*", s7_make_integer(s7, DEFAULT_GRAPH_STYLE));
+ ss->wavelet_type_symbol = s7_define_variable(s7, "*" S_wavelet_type "*", s7_make_integer(s7, DEFAULT_WAVELET_TYPE));
+ ss->dot_size_symbol = s7_define_variable(s7, "*" S_dot_size "*", s7_make_integer(s7, DEFAULT_DOT_SIZE));
+ ss->zero_pad_symbol = s7_define_variable(s7, "*" S_zero_pad "*", s7_make_integer(s7, DEFAULT_ZERO_PAD));
+ ss->wavo_hop_symbol = s7_define_variable(s7, "*" S_wavo_hop "*", s7_make_integer(s7, DEFAULT_WAVO_HOP));
+ ss->wavo_trace_symbol = s7_define_variable(s7, "*" S_wavo_trace "*", s7_make_integer(s7, DEFAULT_WAVO_TRACE));
+ ss->transform_size_symbol = s7_define_variable(s7, "*" S_transform_size "*", s7_make_integer(s7, DEFAULT_TRANSFORM_SIZE));
+ ss->fft_window_symbol = s7_define_variable(s7, "*" S_fft_window "*", s7_make_integer(s7, DEFAULT_FFT_WINDOW));
+ ss->transform_graph_type_symbol = s7_define_variable(s7, "*" S_transform_graph_type "*", s7_make_integer(s7, DEFAULT_TRANSFORM_GRAPH_TYPE));
+ ss->time_graph_type_symbol = s7_define_variable(s7, "*" S_time_graph_type "*", s7_make_integer(s7, DEFAULT_TIME_GRAPH_TYPE));
+
+ /* snd-draw.c */
+ ss->data_color_symbol = s7_define_variable(s7, "*" S_data_color "*", s7_f(s7));
+ ss->selected_data_color_symbol = s7_define_variable(s7, "*" S_selected_data_color "*", s7_f(s7));
+ ss->mark_color_symbol = s7_define_variable(s7, "*" S_mark_color "*", s7_f(s7));
+ ss->graph_color_symbol = s7_define_variable(s7, "*" S_graph_color "*", s7_f(s7));
+ ss->selected_graph_color_symbol = s7_define_variable(s7, "*" S_selected_graph_color "*", s7_f(s7));
+ ss->listener_color_symbol = s7_define_variable(s7, "*" S_listener_color "*", s7_f(s7));
+ ss->listener_text_color_symbol = s7_define_variable(s7, "*" S_listener_text_color "*", s7_f(s7));
+ ss->basic_color_symbol = s7_define_variable(s7, "*" S_basic_color "*", s7_f(s7));
+ ss->selection_color_symbol = s7_define_variable(s7, "*" S_selection_color "*", s7_f(s7));
+ ss->zoom_color_symbol = s7_define_variable(s7, "*" S_zoom_color "*", s7_f(s7));
+ ss->position_color_symbol = s7_define_variable(s7, "*" S_position_color "*", s7_f(s7));
+ ss->highlight_color_symbol = s7_define_variable(s7, "*" S_highlight_color "*", s7_f(s7));
+ ss->enved_waveform_color_symbol = s7_define_variable(s7, "*" S_enved_waveform_color "*", s7_f(s7));
+ ss->cursor_color_symbol = s7_define_variable(s7, "*" S_cursor_color "*", s7_f(s7));
+ ss->text_focus_color_symbol = s7_define_variable(s7, "*" S_text_focus_color "*", s7_f(s7));
+ ss->filter_control_waveform_color_symbol = s7_define_variable(s7, "*" S_filter_control_waveform_color "*", s7_f(s7));
+ ss->mix_color_symbol = s7_define_variable(s7, "*" S_mix_color "*", s7_f(s7));
+ ss->sash_color_symbol = s7_define_variable(s7, "*" S_sash_color "*", s7_f(s7));
+ ss->axis_color_symbol = s7_define_variable(s7, "*" S_axis_color "*", s7_f(s7));
+
+ ss->transform_type_symbol = s7_define_variable(s7, "*" S_transform_type "*", s7_f(s7)); /* set in snd-chn.c(!) */
+#if USE_GTK
+ ss->listener_colorized_symbol = s7_define_variable(s7, "*listener-colorized*", s7_make_boolean(s7, s7_f(s7)));
+#endif
#endif
+}
#if HAVE_GSL
@@ -346,25 +520,25 @@ static void jump_to_top_level(void)
static void snd_gsl_error(const char *reason, const char *file, int line, int gsl_errno)
{
- XEN_ERROR(XEN_ERROR_TYPE("gsl-error"),
- XEN_LIST_6(C_TO_XEN_STRING("GSL: ~A, ~A in ~A line ~A, gsl err: ~A"),
- C_TO_XEN_STRING(gsl_strerror(gsl_errno)),
- C_TO_XEN_STRING(reason),
- C_TO_XEN_STRING(file),
- C_TO_XEN_INT(line),
- C_TO_XEN_INT(gsl_errno)));
+ Xen_error(Xen_make_error_type("gsl-error"),
+ Xen_list_6(C_string_to_Xen_string("GSL: ~A, ~A in ~A line ~A, gsl err: ~A"),
+ C_string_to_Xen_string(gsl_strerror(gsl_errno)),
+ C_string_to_Xen_string(reason),
+ C_string_to_Xen_string(file),
+ C_int_to_Xen_integer(line),
+ C_int_to_Xen_integer(gsl_errno)));
}
#endif
-#if SND_AS_WIDGET
- snd_state *snd_main(int argc, char **argv)
-#else
- int main(int argc, char **argv)
-#endif
+int main(int argc, char **argv)
{
int i;
+#if (!_MSC_VER)
+ setlocale(LC_NUMERIC, "C"); /* use decimal point in floats */
+#endif
+
#if HAVE_GSL
/* if HAVE_GSL and the environment variable GSL_IEEE_MODE exists, use it */
/* GSL_IEEE_MODE=double-precision,mask-underflow,mask-denormalized */
@@ -374,21 +548,17 @@ static void snd_gsl_error(const char *reason, const char *file, int line, int gs
#endif
ss = (snd_state *)calloc(1, sizeof(snd_state)); /* not calloc! */
- ss->fam_ok = false;
- ss->cg_seen = false;
ss->startup_errors = NULL;
-#if HAVE_GTK_3
+#if USE_GTK
+#if GTK_CHECK_VERSION(3, 0, 0) && (!GLIB_CHECK_VERSION(2,35,0))
g_type_init();
#endif
+#endif
mus_sound_initialize(); /* has to precede version check (mus_audio_moniker needs to be setup in Alsa/Oss) */
xen_initialize();
-#if HAVE_SCHEME && HAVE_SETJMP_H
- s7_set_error_exiter(s7, jump_to_top_level);
-#endif
-
for (i = 1; i < argc; i++)
{
if (strcmp(argv[i], "--version") == 0)
@@ -407,15 +577,11 @@ static void snd_gsl_error(const char *reason, const char *file, int line, int gs
}
}
- initialize_format_lists();
+ initialize_sample_type_lists();
snd_set_global_defaults(false);
-#if MUS_DEBUGGING
- ss->Trap_Segfault = false;
-#else
- ss->Trap_Segfault = DEFAULT_TRAP_SEGFAULT;
-#endif
ss->jump_ok = false;
+ ss->file_monitor_ok = false;
allocate_regions(max_regions(ss));
ss->init_window_x = DEFAULT_INIT_WINDOW_X;
ss->init_window_y = DEFAULT_INIT_WINDOW_Y;
@@ -437,7 +603,6 @@ static void snd_gsl_error(const char *reason, const char *file, int line, int gs
ss->lisp_graph_hook_active = false;
ss->exiting = false;
ss->deferred_regions = 0;
- ss->fam_connection = NULL;
ss->snd_error_data = NULL;
ss->snd_error_handler = NULL;
ss->snd_warning_data = NULL;
@@ -445,32 +610,28 @@ static void snd_gsl_error(const char *reason, const char *file, int line, int gs
ss->xen_error_data = NULL;
ss->xen_error_handler = NULL;
ss->update_sound_channel_style = NOT_A_CHANNEL_STYLE;
+ ss->squelch_mark_drag_info = false;
#if HAVE_GL && WITH_GL2PS
ss->gl_printing = false;
#endif
g_xen_initialize();
- ss->search_proc = XEN_UNDEFINED;
+ ss->search_proc = Xen_undefined;
ss->search_expr = NULL;
- ss->search_tree = NULL;
mus_error_set_handler(mus_error_to_snd);
mus_print_set_handler(mus_print_to_snd);
initialize_load_path(); /* merge SND_PATH entries into the load-path */
-#ifdef SND_AS_WIDGET
- return(ss);
-#else
snd_doit(argc, argv);
return(0);
-#endif
}
void g_init_base(void)
{
- #define H_mus_error_hook S_mus_error_hook " (error-type error-message): called upon mus_error. \
+ #define H_mus_error_hook S_mus_error_hook " (type message): called upon mus_error. \
If it returns " PROC_TRUE ", Snd ignores the error (it assumes you've handled it via the hook)."
- ss->mus_error_hook = XEN_DEFINE_HOOK(S_mus_error_hook, 2, H_mus_error_hook); /* arg = error-type error-message */
+ ss->mus_error_hook = Xen_define_hook(S_mus_error_hook, "(make-hook 'type 'message)", 2, H_mus_error_hook);
}
diff --git a/snd.h b/snd.h
index 3c8691a..fa92aec 100644
--- a/snd.h
+++ b/snd.h
@@ -7,38 +7,20 @@
#include <stddef.h>
#include <math.h>
#include <stdio.h>
-#if HAVE_FCNTL_H
- #include <fcntl.h>
-#endif
+#include <fcntl.h>
#include <signal.h>
-#if HAVE_LIMITS_H
- #include <limits.h>
-#endif
+#include <limits.h>
#include <errno.h>
#include <stdlib.h>
-#if HAVE_LIBC_H && (!HAVE_UNISTD_H)
- #include <libc.h>
-#else
- #ifndef _MSC_VER
- #include <unistd.h>
- #endif
-#endif
-#if HAVE_STRING_H
- #include <string.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
+ #include <locale.h>
#endif
+#include <string.h>
#include <stdarg.h>
#include <time.h>
#include <sys/types.h>
#include <sys/stat.h>
-#if HAVE_SETLOCALE
- #include <locale.h>
-#endif
-#if HAVE_FAM_H
- #include <fam.h>
-#endif
-#if HAVE_PTHREAD_H
- #include <pthread.h>
-#endif
#include "_sndlib.h"
#include "xen.h"
@@ -71,11 +53,11 @@
#include "snd-strings.h"
-#define SND_DATE "18-Mar-11"
+#define SND_DATE "30-Nov-15"
#ifndef SND_VERSION
-#define SND_VERSION "12.0"
+#define SND_VERSION "16.1"
#endif
-#define SND_MAJOR_VERSION "12"
-#define SND_MINOR_VERSION "0"
+#define SND_MAJOR_VERSION "16"
+#define SND_MINOR_VERSION "1"
#endif
diff --git a/snd.html b/snd.html
index 0f20f3b..da085e9 100644
--- a/snd.html
+++ b/snd.html
@@ -1,8 +1,10 @@
-<html>
+<!DOCTYPE html>
+
+<html lang="en">
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>Snd</title>
<style type="text/css">
-<!--
EM.red {color:red; font-style:normal}
H1 {text-align: center}
UL {list-style-type: none}
@@ -12,91 +14,143 @@
A.quiet {color:black; text-decoration:none}
A.quiet:hover {text-decoration:underline}
A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black}
--->
+ EM.emdef {font-weight: bold; font-style: normal; text-decoration:none; text-color:black}
+ EM.noem {font-style: normal}
+
+ TH.beige {background-color: beige;
+ border: 1px solid black;
+ padding-left: 0.2cm;
+ padding-right: 0.2cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TD.br {border: 1px solid lightgray;
+ padding-left: 0.2cm;
+ padding-right: 0.2cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+
+ PRE.indented {padding-left: 1.0cm}
+ DIV.center {text-align: center}
+ BODY.body {background-color: #ffffff; /* white */
+ margin-left: 0.5cm;
+ margin-right: 0.5cm;
+ }
+ TABLE.spaced {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 0.5cm;
+ }
+ TABLE.borderspaced {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 0.5cm;
+ border: 8px solid gray;
+ }
+ DIV.centered1 {padding-left: 35%;
+ padding-bottom: 0.5cm;
+ }
+ DIV.header {margin-top: 50px;
+ margin-bottom: 10px;
+ font-size: 20px;
+ font-weight: bold;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ text-align: center;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.innerheader {margin-top: 60px;
+ margin-bottom: 30px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #eefdee; /* lightgreen */
+ padding-left: 30px;
+ width: 50%;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.related {text-align:center;
+ border: 1px solid lightgray;
+ margin-bottom: 1.0cm;
+ margin-top: 1.0cm;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ background-color: #f0f0f0;
+ }
+ DIV.center {margin-top: 0.25cm;
+ margin-bottom: 0.75cm;
+ }
+ IMG.mapped {border: none}
+ IMG.indented {margin-left: 1.0cm;
+ }
</style>
-<!-- P {text-align: justify} -->
</head>
-<body bgcolor=white>
-
-<script language=JavaScript type="text/javascript" src="wz_tooltip.js"></script>
-<script language=JavaScript type="text/javascript" src="wz_data.js"></script>
-
-<center>
-
-<img src="pix/s.png" alt="S"><img src="pix/n.png" alt="n"><img src="pix/d.png" alt="d">
+<body class="body">
-</center>
-<br><br>
-<center>Bill Schottstaedt (bil at ccrma.stanford.edu)</center>
-<br><br>
+<div class="centered1"><img src="pix/s.png" alt="S"><img src="pix/n.png" alt="n"><img src="pix/d.png" alt="d"></div>
-<!-- I'm using A NAME (i.e caps) where the entity should be ignored by the indexer (make-index.scm) -->
+<div class="center">Bill Schottstaedt (bil at ccrma.stanford.edu)</div>
-<center><img src="pix/title.png" usemap="#sndwindow" vspace=10 border=0 alt="standard Snd appearance"></center>
+<div class="center"><img class="mapped" src="pix/title.png" usemap="#sndwindow" alt="standard Snd appearance"></div>
<map name="sndwindow">
<area shape=rect coords="0,0,608,20" href="#overview" alt="title bar">
- <area shape=rect coords="0,20,50,50" href="#fileoperations" alt="File menu" onmouseout="UnTip()" onmouseover="Tip('open, close, save a file, exit Snd...')">
- <area shape=rect coords="65,20,105,50" href="#editoperations" alt="Edit menu" onmouseout="UnTip()" onmouseover="Tip('cut, paste, save selection, undo...')">
- <area shape=rect coords="110,20,150,50" href="#viewing" alt="View menu" onmouseout="UnTip()" onmouseover="Tip('various dialogs, graphing choices')">
- <area shape=rect coords="160,20,230,50" href="#options" alt="Options menu" onmouseout="UnTip()" onmouseover="Tip('save session, fft choices, preferences')">
- <area shape=rect coords="540,20,570,50" href="#options" alt="Help menu" onmouseout="UnTip()" onmouseover="Tip('helpful essays')">
- <area shape=rect coords="12,60,20,70" href="#gettingstarted" alt="edit history list" onmouseout="UnTip()" onmouseover="Tip('this opens a list of the current edits')">
- <area shape=rect coords="23,60,32,190" href="#gettingstarted" alt="Y axis zoom" onmouseout="UnTip()" onmouseover="Tip('this slider changes the y-axis bounds')">
- <area shape=rect coords="34,60,44,190" href="#gettingstarted" alt="Y axis position" onmouseout="UnTip()" onmouseover="Tip('this slider changes the y-axis midpoint')">
- <area shape=rect coords="20,205,50,220" href="#gettingstarted" alt="fft button" onmouseout="UnTip()" onmouseover="Tip('this button turns on the fft display')">
- <area shape=rect coords="20,230,50,245" href="#gettingstarted" alt="waveform button" onmouseout="UnTip()" onmouseover="Tip('this button turns on the time-domain display')">
- <area shape=rect coords="50,60,100,220" href="#gettingstarted" alt="graphs" onmouseout="UnTip()" onmouseover="Tip('the y axis bounds')">
- <area shape=rect coords="101,60,580,195" href="#gettingstarted" alt="graphs" onmouseout="UnTip()" onmouseover="Tip('time domain, FFT, and special-purpose graphs')">
- <area shape=rect coords="101,196,580,220" href="#gettingstarted" alt="graphs" onmouseout="UnTip()" onmouseover="Tip('x axis bounds (in seconds)')">
- <area shape=rect coords="50,227,580,239" href="#gettingstarted" alt="X axis position" onmouseout="UnTip()" onmouseover="Tip('this slider changes where we are in the sound')">
- <area shape=rect coords="50,240,580,250" href="#gettingstarted" alt="X axis zoom" onmouseout="UnTip()" onmouseover="Tip('this slider changes how much of the sound we see (zoom in and out)')">
- <area shape=rect coords="30,260,130,280" href="#gettingstarted" alt="sound file name" onmouseout="UnTip()" onmouseover="Tip('sound file name')">
- <area shape=rect coords="0,260,29,280" href="#gettingstarted" alt="sound file name" onmouseout="UnTip()" onmouseover="Tip('sound index (used by many of the extension language functions)')">
- <area shape=rect coords="140,260,450,280" href="#gettingstarted" alt="minibuffer" onmouseout="UnTip()" onmouseover="Tip('error messages get displayed here')">
- <area shape=rect coords="460,260,475,280" href="#syncbutton" alt="sync button" onmouseout="UnTip()" onmouseover="Tip('this button can make all chans/sounds move together<br>It's not doing anything in the current case.')">
- <area shape=rect coords="522,260,535,280" href="#menuplay" alt="play button" onmouseout="UnTip()" onmouseover="Tip('play the sound')">
- <area shape=rect coords="563,255,573,262" href="#menuplay" alt="play button" onmouseout="UnTip()" onmouseover="Tip('this opens the control panel')">
- <area shape=rect coords="0,0,25,20" href="#menuplay" alt="play button" onmouseout="UnTip()" onmouseover="Tip('Snd's icon!')">
+ <area shape=rect coords="0,20,50,50" href="#fileoperations" alt="File menu">
+ <area shape=rect coords="65,20,105,50" href="#editoperations" alt="Edit menu">
+ <area shape=rect coords="110,20,150,50" href="#viewing" alt="View menu">
+ <area shape=rect coords="160,20,230,50" href="#options" alt="Options menu">
+ <area shape=rect coords="540,20,570,50" href="#options" alt="Help menu">
+ <area shape=rect coords="12,60,20,70" href="#gettingstarted" alt="edit history list">
+ <area shape=rect coords="23,60,32,190" href="#gettingstarted" alt="Y axis zoom">
+ <area shape=rect coords="34,60,44,190" href="#gettingstarted" alt="Y axis position">
+ <area shape=rect coords="20,205,50,220" href="#gettingstarted" alt="fft button">
+ <area shape=rect coords="20,230,50,245" href="#gettingstarted" alt="waveform button">
+ <area shape=rect coords="50,60,100,220" href="#gettingstarted" alt="graphs">
+ <area shape=rect coords="101,60,580,195" href="#gettingstarted" alt="graphs">
+ <area shape=rect coords="101,196,580,220" href="#gettingstarted" alt="graphs">
+ <area shape=rect coords="50,227,580,239" href="#gettingstarted" alt="X axis position">
+ <area shape=rect coords="50,240,580,250" href="#gettingstarted" alt="X axis zoom">
+ <area shape=rect coords="30,260,130,280" href="#gettingstarted" alt="sound file name">
+ <area shape=rect coords="0,260,29,280" href="#gettingstarted" alt="sound file name">
+ <area shape=rect coords="140,260,450,280" href="#gettingstarted" alt="status area">
+ <area shape=rect coords="460,260,475,280" href="#syncbutton" alt="sync button">
+ <area shape=rect coords="522,260,535,280" href="#menuplay" alt="play button">
+ <area shape=rect coords="563,255,573,262" href="#menuplay" alt="play button">
+ <area shape=rect coords="0,0,25,20" href="#menuplay" alt="play button">
</map>
-<p><A NAME="overview"><b>Snd</b></a> is a sound editor modelled
-loosely after Emacs.
-It
+
+<p id="overview">Snd is a sound editor modelled
+loosely after Emacs. It
can be customized and extended
using either <a href="s7.html">s7</a> (included in the Snd sources),
<a href="http://www.ruby-lang.org">Ruby</a>, or
<a href="http://www.sourceforge.net/projects/fth">Forth</a>.
Snd is free; the code is available via anonymous ftp as
-<a href="ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-12.tar.gz">snd-12.tar.gz</a>.
+<a href="ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz">snd-16.tar.gz</a>.
Snd has a <a href="http://ccrma.stanford.edu/software/snd/">home page</a>
and a CVS <a href="http://snd.cvs.sourceforge.net/snd/cvs-snd">repository</a>, and
is included in <a href="http://ccrma.stanford.edu/planetccrma/software/">PlanetCCRMA</a>.
</p>
-<br>
-
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html">index.html</a></small></td>
-</tr></table>
-</center>
-
-<br><br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>Contents</h2></td></tr></table>
-</td></tr></table>
-
-<table border=0 cellpadding=5>
+
+
+
+<div class="related">
+related documentation:
+<a href="extsnd.html">extsnd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="fm.html">fm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
+
+
+<div class="header">Contents</div>
+
+<table class="spaced">
<tr><th>this file:</th><th>extsnd.html:</th><th>grfsnd.html:</th></tr>
-<tr><td><small>
+<tr><td>
<ul>
<li><a href="#gettingstarted">Getting Started</a>
@@ -124,22 +178,19 @@ is included in <a href="http://ccrma.stanford.edu/planetccrma/software/">PlanetC
<li><a href="#undoredo">Undo, redo, revert</a>
<li><a href="#menuplay">Play</a>
<li><a href="#mixingfiles">Mix Files</a>
- <li><a href="#kbdmacros">Keyboard macros</a>
<li><a href="#changeformat">Change file format</a>
<li><a href="#extendfile">Extend a file</a>
- <li><a href="#recordfile">Record a file</a>
<li><a href="#editenvelope">Edit or view an envelope</a>
<li><a href="#editheader">Edit, add, or remove the header</a>
<li><a href="#centeryaxis">Center a tiny signal with DC</a>
<li><a href="#savedstate">Save session for later restart</a>
<li><a href="#misccommands">Miscellaneous commands</a>
</ul>
-
</ul>
<li><a href="#controls">The Control Panel</a>
-</ul></small>
-</td><td><small>
+</ul>
+</td><td>
<ul>
<li><a href="extsnd.html#extsndcontents">Customization and Extension</a>
@@ -150,25 +201,24 @@ is included in <a href="http://ccrma.stanford.edu/planetccrma/software/">PlanetC
<ul>
<li><a href="extsnd.html#sndglobalvars">Global variables</a>
<li><a href="extsnd.html#sndgenericfuncs">Generic functions</a>
- <li><a href="extsnd.html#sndhooks" onmouseout="UnTip()" onmouseover="Tip('callbacks')">Hooks</a>
+ <li><a href="extsnd.html#sndhooks">Hooks</a>
</ul>
<li><a href="extsnd.html#sndobjects">Snd's objects</a>
<ul>
- <li><a href="extsnd.html#samplers" onmouseout="UnTip()" onmouseover="Tip('sound data iterators', WIDTH, 200)">Samplers</a>
- <li><a href="extsnd.html#Vcts" onmouseout="UnTip()" onmouseover="Tip('real arrays', WIDTH, 100)">Vcts</a>
- <li><a href="extsnd.html#sndsounddata" onmouseout="UnTip()" onmouseover="Tip('arrays of vcts for multichannel data')">Sound-data</a>
- <li><a href="extsnd.html#extsndlib" onmouseout="UnTip()" onmouseover="Tip('the underlying library that handles sound data and files')">Sndlib</a>
- <li><a href="extsnd.html#sndmarks" onmouseout="UnTip()" onmouseover="Tip('location markers in sound data')">Marks</a>
- <li><a href="extsnd.html#sndmixes" onmouseout="UnTip()" onmouseover="Tip('mixed sounds and groups of mixed sounds')">Mixes</a>
- <li><a href="extsnd.html#sndregions" onmouseout="UnTip()" onmouseover="Tip('selected or saved portions of sound data')">Regions and Selections</a>
- <li><a href="extsnd.html#sndsounds" onmouseout="UnTip()" onmouseover="Tip('editing functions, per-channel display decisions, etc')">Sounds and channels</a>
+ <li><a href="extsnd.html#samplers">Samplers</a>
+ <li><a href="extsnd.html#Vcts">Vcts</a>
+ <li><a href="extsnd.html#extsndlib">Sndlib</a>
+ <li><a href="extsnd.html#sndmarks">Marks</a>
+ <li><a href="extsnd.html#sndmixes">Mixes</a>
+ <li><a href="extsnd.html#sndregions">Regions and Selections</a>
+ <li><a href="extsnd.html#sndsounds">Sounds and channels</a>
<ul>
- <li><a href="extsnd.html#customcontrols" onmouseout="UnTip()" onmouseover="Tip('a set of common sound effects below the main graph')">the control panel</a>
- <li><a href="extsnd.html#editlists" onmouseout="UnTip()" onmouseover="Tip('current edit sequence', WIDTH, 200)">edit lists</a>
+ <li><a href="extsnd.html#customcontrols">the control panel</a>
+ <li><a href="extsnd.html#editlists">edit lists</a>
</ul>
- <li><a href="extsnd.html#sndtransforms" onmouseout="UnTip()" onmouseover="Tip('Fourier transform, wavelets, autocorelation, etc')">Transforms</a>
- <li><a href="extsnd.html#snddialogs" onmouseout="UnTip()" onmouseover="Tip('customizing the built-in dialogs, etc')">Dialogs and Other Widgets</a>
- <li><a href="extsnd.html#sndmisc" onmouseout="UnTip()" onmouseover="Tip('bind-key, exit, etc')">Miscellaneous functions</a>
+ <li><a href="extsnd.html#sndtransforms">Transforms</a>
+ <li><a href="extsnd.html#snddialogs">Dialogs and Other Widgets</a>
+ <li><a href="extsnd.html#sndmisc">Miscellaneous functions</a>
<li><a href="extsnd.html#sndconstants">Constants</a>
<li><a href="extsnd.html#snderrors">Errors and Debugging</a>
</ul>
@@ -176,181 +226,179 @@ is included in <a href="http://ccrma.stanford.edu/planetccrma/software/">PlanetC
<ul>
<li><a href="extsnd.html#colors">Colors</a>
<li><a href="extsnd.html#fonts">Fonts</a>
- <li><a href="extsnd.html#graphics" onmouseout="UnTip()" onmouseover="Tip('write your own sound display functions or customize Snd\'s')">Graphics</a>
+ <li><a href="extsnd.html#graphics">Graphics</a>
</ul>
</ul>
-</ul></small>
-</td><td><small>
+</ul>
+</td><td>
<ul>
-
<li><a href="grfsnd.html#startup">Snd Startup</a>
<ul>
- <li><a href="grfsnd.html#sndswitches" onmouseout="UnTip()" onmouseover="Tip('startup switches such as -l and -p')">Snd invocation flags</a>
- <li><a href="grfsnd.html#sndinitfile" onmouseout="UnTip()" onmouseover="Tip('~/.snd, ~/.snd_s7, ~/.snd_prefs_s7, etc')">The initialization file</a>
- <li><a href="grfsnd.html#sndconfigurationswitches" onmouseout="UnTip()" onmouseover="Tip('this refers to the configure script used to build Snd')">Configuration choices</a>
- <li><a href="grfsnd.html#sndenvvars" onmouseout="UnTip()" onmouseover="Tip('mostly related to audio hardware choices')">Environment variables</a>
+ <li><a href="grfsnd.html#sndswitches">Snd invocation flags</a>
+ <li><a href="grfsnd.html#sndinitfile">The initialization file</a>
+ <li><a href="grfsnd.html#sndconfigurationswitches">Configuration choices</a>
+ <li><a href="grfsnd.html#sndenvvars">Environment variables</a>
</ul>
<li><a href="grfsnd.html#snddynamic">Runtime modules and external programs</a>
<ul>
- <li><a href="grfsnd.html#emacssnd" onmouseout="UnTip()" onmouseover="Tip('Use Emacs as the listener')">Snd as an Emacs subjob</a>
- <li><a href="grfsnd.html#dynamic" onmouseout="UnTip()" onmouseover="Tip('Load your own C code into Snd')">Dynamically loaded modules</a>
- <li><a href="grfsnd.html#sndaswidget" onmouseout="UnTip()" onmouseover="Tip('Embed Snd in some other program')">Snd as a Widget</a>
- <li><a href="grfsnd.html#sndwithclm" onmouseout="UnTip()" onmouseover="Tip('CLM is built into Snd')">Snd and CLM</a>
- <li><a href="grfsnd.html#sndwithcm" onmouseout="UnTip()" onmouseover="Tip('CM is Rick Taube\'s composition environment')">Snd and Common Music</a>
- <li><a href="grfsnd.html#sndwithmotif" onmouseout="UnTip()" onmouseover="Tip('Motif extensions from xm.c')">Snd and Motif</a>
- <li><a href="grfsnd.html#sndwithgtk" onmouseout="UnTip()" onmouseover="Tip('Gtk extensions from xg.c')">Snd and Gtk</a>
+ <li><a href="grfsnd.html#emacssnd">Snd as an Emacs subjob</a>
+ <li><a href="grfsnd.html#dynamic">Dynamically loaded modules</a>
+ <li><a href="grfsnd.html#sndwithclm">Snd and CLM</a>
+ <li><a href="grfsnd.html#sndwithcm">Snd and Common Music</a>
+ <li><a href="grfsnd.html#sndwithmotif">Snd and Motif</a>
+ <li><a href="grfsnd.html#sndwithgtk">Snd and Gtk</a>
<li><a href="grfsnd.html#sndwithnogui">Snd with no GUI and as script engine</a>
- <li><a href="grfsnd.html#sndandruby" onmouseout="UnTip()" onmouseover="Tip('Ruby is a scripting/extension language somewhat like Python')">Snd with Ruby</a>
- <li><a href="grfsnd.html#sndandforth" onmouseout="UnTip()" onmouseover="Tip('Forth is a postfix extension language')">Snd with Forth</a>
- <li><a href="grfsnd.html#sndands7" onmouseout="UnTip()" onmouseover="Tip('s7 is yet another Scheme extension language')">Snd with s7</a>
- <li><a href="grfsnd.html#sndandladspa" onmouseout="UnTip()" onmouseover="Tip('This is a Linux-based sound-effects plugin system')">Snd and LADSPA plugins</a>
- <li><a href="grfsnd.html#sndandjack" onmouseout="UnTip()" onmouseover="Tip('This is the Jack audio library')">Snd and Jack</a>
- <li><a href="grfsnd.html#sndandalsa" onmouseout="UnTip()" onmouseover="Tip('This is the new Linux audio library')">Snd and ALSA</a>
- <li><a href="grfsnd.html#sndandgl" onmouseout="UnTip()" onmouseover="Tip('OpenGL (Mesa) extensions via gl.c')">Snd and OpenGL</a>
- <li><a href="grfsnd.html#sndandgsl" onmouseout="UnTip()" onmouseover="Tip('include some special functions from GSL')">Snd and GSL</a>
- <li><a href="grfsnd.html#sndandgmp" onmouseout="UnTip()" onmouseover="Tip('include multiprecision arithmetic')">Snd and multiprecision arithmetic (gmp, mpfr, mpc)</a>
+ <li><a href="grfsnd.html#sndandruby">Snd with Ruby</a>
+ <li><a href="grfsnd.html#sndandforth">Snd with Forth</a>
+ <li><a href="grfsnd.html#sndands7">Snd with s7</a>
+ <li><a href="grfsnd.html#sndandladspa">Snd and LADSPA plugins</a>
+ <li><a href="grfsnd.html#sndandjack">Snd and Jack</a>
+ <li><a href="grfsnd.html#sndandalsa">Snd and ALSA</a>
+ <li><a href="grfsnd.html#sndandgl">Snd and OpenGL</a>
+ <li><a href="grfsnd.html#sndandgsl">Snd and GSL</a>
+ <li><a href="grfsnd.html#sndandgmp">Snd and multiprecision arithmetic</a>
</ul>
-
+ <li><a href="grfsnd.html#otherstuff">Other stuff</a>
<li><a href="sndscm.html#introduction">Scheme, Ruby, and Forth</a>
<li><a href="index.html">Overall Index</a>
- </ul></small>
+ </ul>
</td></tr>
</table>
-<br>
-<table border=8 bordercolor="lightgreen" hspace=20>
+
+<table class="borderspaced">
<tr>
-<th width=140 bgcolor="beige"><a href="#fileoperations">File</a> Menu</th>
-<th width=140 bgcolor="beige"><a href="#editoperations">Edit</a> Menu</th>
-<th width=160 bgcolor="beige"><a href="#viewing">View</a> Menu</th>
-<th width=160 bgcolor="beige"><a href="#options">Options</a> Menu</th>
-<th width=140 bgcolor="beige">Help Menu</th>
+<th class="beige"><a href="#fileoperations">File</a> Menu</th>
+<th class="beige"><a href="#editoperations">Edit</a> Menu</th>
+<th class="beige"><a href="#viewing">View</a> Menu</th>
+<th class="beige"><a href="#options">Options</a> Menu</th>
+<th class="beige">Help Menu</th>
</tr>
<tr>
-<td><a href="#openfile">Open</a></td>
-<td><a href="#undoredo">Undo</a></td>
-<td><a href="#controls">Show controls</a></td>
-<td><a href="#viewfft">Transform Options</a></td>
-<td><a href="#overview">About Snd</a></td>
+<td class="br"><a href="#openfile">Open</a></td>
+<td class="br"><a href="#undoredo">Undo</a></td>
+<td class="br"><a href="extsnd.html#lisplistener">Open listener</a></td>
+<td class="br"><a href="#viewfft">Transform Options</a></td>
+<td class="br"><a href="#overview">About Snd</a></td>
</tr>
<tr>
-<td><a href="#closefile">Close</a></td>
-<td><a href="#undoredo">Redo</a></td>
-<td><a href="extsnd.html#lisplistener">Open listener</a></td>
-<td>Controls</td>
-<td><a href="extsnd.html#appearance">Customization</a></td>
+<td class="br"><a href="#closefile">Close</a></td>
+<td class="br"><a href="#undoredo">Redo</a></td>
+<td class="br"><a href="#viewfiles">Files</a></td>
+<td class="br">Control panel options</td>
+<td class="br"><a href="extsnd.html#appearance">Customization</a></td>
</tr>
<tr>
-<td><a href="#savefile">Save</a></td>
-<td><a href="#menufind">Find</a></td>
-<td><a href="#mixdialog">Mixes</a></td>
-<td><a href="#saveoptions">Save options</a></td>
-<td><a href="#controls">Control panel</a></td>
+<td class="br"><a href="#savefile">Save</a></td>
+<td class="br"><a href="#menufind">Find</a></td>
+<td class="br"><a href="#mixdialog">Mixes</a></td>
+<td class="br"><a href="#savedstate">Save session</a></td>
+<td class="br"><a href="#controls">Control panel</a></td>
</tr>
<tr>
-<td><a href="#savefile">Save as</a></td>
-<td><a href="#editcut">Cut</a></td>
-<td><a href="#regionbrowser">Regions</a></td>
-<td><a href="#savedstate">Save session</a></td>
-<td>Key bindings</td>
+<td class="br"><a href="#savefile">Save as</a></td>
+<td class="br"><a href="#editcut">Delete selection</a></td>
+<td class="br"><a href="#regionbrowser">Regions</a></td>
+<td class="br"><a href="#preferencesbrowser">Preferences</a></td>
+<td class="br">Key bindings</td>
</tr>
<tr>
-<td><a href="#revertfile">Revert</a></td>
-<td><a href="#editcut">Paste</a></td>
-<td><a href="#viewfiles">Files</a></td>
-<td><a href="#preferencesbrowser">Preferences</a></td>
-<td><a href="#recordfile">Record</a></td>
+<td class="br"><a href="#revertfile">Revert</a></td>
+<td class="br"><a href="#editcut">Insert selection</a></td>
+<td class="br"><a href="#colorbrowser">Color/Orientation</a></td>
+<td></td>
+<td class="br"><a href="#menuplay">Play</a></td>
</tr>
<tr>
-<td><a href="#mixingfiles">Mix</a></td>
-<td><a href="#editcut">Mix Selection</a></td>
-<td><a href="#colorbrowser">Color/Orientation</a></td>
+<td class="br"><a href="#mixingfiles">Mix</a></td>
+<td class="br"><a href="#editcut">Mix Selection</a></td>
+<td class="br"><a href="#controls">Show controls</a></td>
<td></td>
-<td><a href="#menuplay">Play</a></td>
+<td class="br"><a href="#savefile">Save</a></td>
</tr>
<tr>
-<td><a href="#insertfile">Insert</a></td>
-<td><a href="#cxp">Play Selection</a></td>
-<td><a href="#viewdots">Graph style</a></td>
+<td class="br"><a href="#insertfile">Insert</a></td>
+<td class="br"><a href="#cxp">Play Selection</a></td>
+<td class="br"><a href="#viewdots">Graph style</a></td>
<td></td>
-<td><a href="#savefile">Save</a></td>
+<td class="br"><a href="#mixingfiles">Mix</a></td>
</tr>
<tr>
-<td><a href="#updatefile">Update</a></td>
-<td><a href="#cxw">Save Selection</a></td>
-<td><a href="extsnd.html#withverbosecursor">Verbose cursor</a></td>
+<td class="br"><a href="#updatefile">Update</a></td>
+<td class="br">Save Selection</td>
+<td class="br"><a href="extsnd.html#withverbosecursor">Verbose cursor</a></td>
<td></td>
-<td><a href="#mixingfiles">Mix</a></td>
+<td class="br"><a href="#speed">Resample</a></td>
</tr>
<tr>
-<td><a href="#newfile">New</a></td>
-<td><a href="#menuselectall">Select all</a></td>
-<td><a href="extsnd.html#withinsetgraph">With inset graph</a></td>
+<td class="br"><a href="#newfile">New</a></td>
+<td class="br"><a href="#menuselectall">Select all</a></td>
+<td class="br"><a href="extsnd.html#withinsetgraph">With inset graph</a></td>
<td></td>
-<td><a href="#speed">Resample</a></td>
+<td class="br"><a href="#viewfft">FFT</a></td>
</tr>
<tr>
-<td><a href="#recordfile">Record</a></td>
-<td>Unselect</td>
-<td><a href="#unitebutton">Channel style</a></td>
+<td class="br"><a href="#openfile">View</a></td>
+<td class="br">Unselect all</td>
+<td class="br"><a href="#unitebutton">Channel style</a></td>
<td></td>
-<td><a href="#viewfft">FFT</a></td>
+<td class="br"><a href="#filtercontrol">Filter</a></td>
</tr>
<tr>
-<td><a href="#openfile">View</a></td>
-<td><a href="#editenvelope">Edit Envelope</a></td>
-<td><a href="#viewy0">Show y=0</a></td>
+<td class="br"><a href="#printfile">Print</a></td>
+<td class="br"><a href="#editenvelope">Edit Envelope</a></td>
+<td class="br"><a href="#viewy0">Show y=0</a></td>
<td></td>
-<td><a href="#filtercontrol">Filter</a></td>
+<td class="br"><a href="#reverb">Reverb</a></td>
</tr>
<tr>
-<td><a href="#printfile">Print</a></td>
-<td><a href="#editheader">Edit Header</a></td>
-<td><a href="extsnd.html#xaxisstyle">X axis units</a></td>
+<td class="br"><a href="#exitfile">Exit</a></td>
+<td class="br"><a href="#editheader">Edit Header</a></td>
+<td class="br"><a href="extsnd.html#xaxisstyle">X axis units</a></td>
<td></td>
-<td><a href="#reverb">Reverb</a></td>
+<td class="br"><a href="#ampenvs">Envelope</a></td>
</tr>
<tr>
-<td><a href="#exitfile">Exit</a></td>
<td></td>
-<td><a href="extsnd.html#showaxes">Axes</a></td>
<td></td>
-<td><a href="#ampenvs">Envelope</a></td>
+<td class="br"><a href="extsnd.html#showaxes">Axes</a></td>
+<td></td>
+<td class="br"><a href="#marks">Marks</a></td>
</tr>
<tr>
<td></td>
<td></td>
-<td><a href="#zoomoption">Zoom focus</a></td>
+<td class="br"><a href="#zoomoption">Zoom focus</a></td>
<td></td>
-<td><a href="#marks">Marks</a></td>
+<td class="br">Insert</td>
+</tr>
+<tr>
+<td></td>
+<td></td>
+<td class="br"><a href="extsnd.html#showgrid">With grid</a></td>
+<td></td>
+<td class="br">Delete</td>
</tr>
</table>
-<br>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="gettingstarted">Getting Started</a></h2></td></tr></table>
-</td></tr></table>
-<br><br>
-<img src="pix/intro2.png" alt="basic snd display" align=right hspace=30>
-<p>Once compiled and loaded (see README.Snd for instructions), start Snd:
-</p>
+<div class="header" id="gettingstarted">Getting started</div>
+<p>Once compiled and loaded (see README.Snd for instructions), start Snd, <code>snd some.snd</code>:
+</p>
-<pre>
- snd some.snd
-</pre>
+
+<img class="indented" src="pix/intro2.png" alt="basic snd display">
<p>where "some.snd" is any available sound file. You should
get a window with the first .1 seconds of the sound displayed as a time
domain waveform. Click the file name at the lower left to get
-some information about the file. <A NAME="fw"></a> Click the "f" button, and an fft window
+some information about the file. Click the "f" button, and an fft window
appears alongside the waveform. Drag the upper scale at the
bottom of the graph and both graphs are updated as you move
through the file. Drag the lower scale to zoom in or out.
@@ -363,7 +411,7 @@ play the file. "sync" is more complicated — it is used
to group sounds together for simultaneous editing.
</p>
-<img src="pix/intro1.png" alt="basic snd display" align=right hspace=30>
+<img class="indented" src="pix/intro1.png" alt="basic snd display">
<p>Now return to the time domain form (click "w" and "f"),
and click in the graph itself. A red cursor (a big "+")
@@ -394,7 +442,8 @@ to life. Just for laughs, delete the selection (via the Edit menu), then click
button to get the popup menu, and try Undo followed
by Redo.</p>
-<img src="pix/intro.png" alt="basic snd display" align=right hspace=30 vspace=10>
+<img class="indented" src="pix/intro.png" alt="basic snd display">
+
<p>Next type C-m. This places a
mark at the current cursor location. C-a goes
to the start of the window; C-j jumps forward to the
@@ -418,7 +467,7 @@ But this is all standard stuff; even the
various dialogs scattered around the menus will present
no surprises.
The GL spectrograph is somewhat unusual,
-and I like the paned window approach to multichannel sounds ("<i>de gustibus...</i>").
+and I like the paned window approach to multichannel sounds ("de gustibus...").
But it is primarily the embedded extension language
(s7, Ruby, or Forth) that
makes Snd different from other editors.
@@ -437,7 +486,7 @@ editing operations built into other editors. Just load the
files that look interesting, and start clicking widgets.
</p>
-<img src="pix/intro3.png" alt="basic snd display" align=right hspace=30 vspace=10>
+<img class="indented" src="pix/intro3.png" alt="basic snd display">
<p>Manipulating sounds in a programming environment
is most enjoyable if you can edit and retry expressions
@@ -456,68 +505,63 @@ presents the programming interface; <a href="grfsnd.html">grfsnd.html</a> descri
to various other programs and X; <a href="sndscm.html">sndscm.html</a> has brief descriptions of
most of the Scheme/Ruby/Forth code included in the Snd tarball; <a href="fm.html">fm.html</a>
is an introduction to FM; <a href="sndclm.html">sndclm.html</a> is the basic generator documentation;
-<a href="sndlib.html">sndlib.html</a> describes the underlying sound IO library; <a href="libxm.html">libxm.html</a>
-describes the user-interface extension library.
+<a href="sndlib.html">sndlib.html</a> describes the underlying sound IO library;
+<a href="s7.html">s7.html</a> is the s7 documentation.
</p>
<p>There are context-sensitive popup menus, and (if you like) a toolbar:
</p>
-<img src="pix/selpop.png" alt="selection popup menu" hspace=20>
-
-<br>
-<br>
-<br>
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="fileoperations">File Operations</a></h2></td></tr></table>
-</td></tr></table>
-
-<br>
-
-<table border=8 bordercolor="lightgreen" hspace=20>
-<tr><th></th><th>File Menu</th><th></th></tr>
-<tr><td width=100><a href="#openfile">Open</a></td><td>open a new file</td><td>(C-x C-f)</td></tr>
-<tr><td><a href="#closefile">Close</a></td><td>close a file, flush any unsaved edits</td><td>(C-x k)</td></tr>
-<tr><td><a href="#savefile">Save</a></td><td>save current edits, overwriting previous version</td><td>(C-x C-s)</td></tr>
-<tr><td><a href="#savefileas">Save as</a></td><td>save current edits under a new name, stay in current file</td><td></td></tr>
-<tr><td><a href="#revertfile">Revert</a></td><td>flush edits</td><td></td></tr>
-<tr><td><a href="#mixingfiles">Mix</a></td><td>mix file</td><td>(C-x C-q)</td></tr>
-<tr><td><a href="#insertfile">Insert</a></td><td>insert file</td><td>(C-x C-i)</td></tr>
-<tr><td><a href="#updatefile">Update</a></td><td>re-read file (data changed behind Snd's back)</td><td></td></tr>
-<tr><td><a href="#viewfile">View</a></td><td>open file read-only</td><td></td></tr>
-<tr><td><a href="#newfile">New</a></td><td>create a new, empty file</td><td></td></tr>
-<tr><td><a href="#recordfile">Record</a></td><td>record sound producing a new file</td><td></td></tr>
-<tr><td><a href="#printfile">Print</a></td><td>produce a Postscript version of current display</td><td></td></tr>
-<tr><td><a href="#exitfile">Exit</a></td><td>leave Snd, flushing all pending edits</td><td></td></tr>
+<img class="indented" src="pix/selpop.png" alt="selection popup menu">
+
+
+
+<div class="header" id="fileoperations">File operations</div>
+
+<table class="borderspaced">
+<tr><th class="beige" colspan=3>File Menu</th></tr>
+
+<tr><td class="br"><a href="#openfile">Open</a></td> <td class="br">open a new file</td></tr>
+<tr><td class="br"><a href="#closefile">Close</a></td> <td class="br">close a file, flush any unsaved edits</td></tr>
+<tr><td class="br"><a href="#savefile">Save</a></td> <td class="br">save current edits, overwriting previous version</td></tr>
+<tr><td class="br"><a href="#savefileas">Save as</a></td> <td class="br">save current edits under a new name, stay in current file</td></tr>
+<tr><td class="br"><a href="#revertfile">Revert</a></td> <td class="br">flush edits</td></tr>
+<tr><td class="br"><a href="#mixingfiles">Mix</a></td> <td class="br">mix file</td></tr>
+<tr><td class="br"><a href="#insertfile">Insert</a></td> <td class="br">insert file</td></tr>
+<tr><td class="br"><a href="#updatefile">Update</a></td> <td class="br">re-read file (data changed behind Snd's back)</td></tr>
+<tr><td class="br"><a href="#viewfile">View</a></td> <td class="br">open file read-only</td></tr>
+<tr><td class="br"><a href="#newfile">New</a></td> <td class="br">create a new, empty file</td></tr>
+<tr><td class="br"><a href="#printfile">Print</a></td> <td class="br">produce a Postscript version of current display</td></tr>
+<tr><td class="br"><a href="#exitfile">Exit</a></td> <td class="br">leave Snd, flushing all pending edits</td></tr>
</table>
<p>When invoked, Snd scans
its arguments for file names, and opens any it finds.
</p>
-<pre>
- snd oboe.snd fyow.snd
+
+<pre class="indented">
+snd oboe.snd fyow.snd
</pre>
<p>If there are no arguments, Snd comes up as a bare menu bar.
If a name is preceded by "-p" or "-preload", it is treated as a directory
-name and all sound files found in that directory are added
+name, and all sound files found in that directory are added
to the <a href="#viewfiles">View:Files</a> list. To
load arbitrary Snd customizations (your own code, or a <a href="#savedstate">saved state</a> file),
-precede the file name with <A class=def NAME="minusl">"-l"</a> or "-load" (or use the load function).
+precede the file name with "-l" or "-load" (or use the load function).
</p>
-<pre>
- snd oboe.snd -l examp.scm
+
+<pre class="indented">
+snd oboe.snd -l examp.scm
</pre>
-<p>opens the sound file oboe.snd and loads the Scheme code in <a href="sndscm.html#exampdoc">examp.scm</a>.
+<p>opens the sound file oboe.snd and loads the Scheme file <a href="sndscm.html#exampdoc">examp.scm</a>.
</p>
<p>Normally Snd adds each new sound below those currently being
displayed.
-<A NAME="verticalpane"></a>
To position sounds horizontally (adding on the right), use the "-h" (or "-horizontal") flag.
Other overall layout
choices include the Notebook widget (-notebook),
@@ -525,28 +569,26 @@ and separate windows for each sound (-separate).
</p>
-<A NAME="openfile"></a>
-
-<img src="pix/open-dialog.png" usemap="#opendialogmap" alt="Open File dialog" align=right hspace=20 border=0>
+<img class="indented" id="openfile" src="pix/open-dialog.png" usemap="#opendialogmap" alt="Open File dialog">
<map name="opendialogmap">
<area shape=rect coords="365,40,400,60"
- onmouseout="UnTip()"
- onmouseover="Tip('In Motif, you can right-click the text widget to<br>get a drop-down list of previous file filters, but<br>in Gtk, you have to click this weird icon')">
+
+ >
<area shape=rect coords="365,350,400,370"
- onmouseout="UnTip()"
- onmouseover="Tip('In Motif, you can right-click the text widget to<br>get a drop-down list of previous files, but<br>in Gtk, you have to click this weird icon')">
+
+ >
</map>
-<p>A file can be opened from the File menu via Open
-or View. <A class=def NAME="viewfile">View</a> opens the file read-only, whereas Open
+<p id="updatefile">A file can be opened from the File menu via Open
+or View. <em class=emdef id="viewfile">View</em> opens the file read-only, whereas Open
allows it to be changed. The equivalent keyboard
command is C-x C-f.
If a file cannot be changed (either it was opened read-only
or you don't have write permission for it), a lock appears
-next to the file name. <A NAME="updatefile"></a>Similarly, if Snd notices that
+next to the file name. Similarly, if Snd notices that
the file on the disk no longer matches the original,
-a bomb appears. This can happen if some other program
+a warning is posted. This can happen if some other program
writes a sound while you are editing an earlier version
of it.
If the variable <a href="extsnd.html#autoupdate">auto-update</a> is #t (the default is #f), Snd
@@ -565,20 +607,18 @@ extension; you can add to the list of sound file extensions via <a href="extsnd.
The built-in extensions are
"snd", "wav", "aiff", "aif", "au", "aifc", "voc", and "wve".
When a sound file is selected, information about it is posted under the lists, and a 'play'
-button is displayed. If you have libgamin (fam), it is tied into the file list, so what you
-see should always be up-to-date. The name field has TAB completion, of course, and also
+button is displayed. The name field has TAB completion, of course, and also
watches as you type a new name, reflecting that partial name by moving the file list to
display possible matches.
</p>
-<!-- INDEX formats:Headers and Data formats -->
-<A NAME="formats"></a>
-<p>Snd can handle the following file and data types:</p>
+<!-- INDEX formats:Headers and sample types -->
+
+<p id="formats">Snd can handle the following file and data types:</p>
+
+<pre class="indented">
+read/write (many sample types):
-<table border=0 hspace=20>
-<tr><td bgcolor="#EEFDEE">read/write (many data formats)</td></tr>
-<tr><td>
-<pre>
NeXT/Sun/DEC/AFsp
AIFF/AIFC
RIFF (Microsoft wave)
@@ -587,29 +627,25 @@ display possible matches.
NIST-sphere
CAFF
no header ("raw")
-</pre>
-</td></tr>
-<tr><td><br></td></tr>
-<tr><td bgcolor="#EEFDEE">read-only (in selected data formats)</td></tr>
-<tr><td>
-<pre>
- 8SVX (IFF), EBICSF, INRS, ESPS, SPPACK, ADC (OGI), AVR, VOC, PVF, NVF,
+
+
+read-only (in selected sample types):
+
+ 8SVX (IFF), EBICSF, INRS, ESPS, SPPACK, ADC (OGI), AVR, VOC, PVF,
Sound Tools, Turtle Beach SMP, SoundFont 2.0, Sound Designer I, PSION, MAUD, Kurzweil 2000,
Gravis Ultrasound, ASF, PAF, CSL, Comdisco SPW, Goldwave sample, omf, quicktime, sox,
Sonic Foundry, SBStudio II, Delusion digital, Digiplayer ST3, Farandole Composer WaveSample,
Ultratracker WaveSample, Sample Dump exchange, Yamaha SY85, SY99, and TX16, Covox v8, AVI,
Impulse tracker, Korg, Akai, Turtle Beach, Matlab-5
-</pre>
-</td></tr>
-<tr><td><br></td></tr>
-<tr><td bgcolor="#EEFDEE">automatically translated to a readable format</td></tr>
-<tr><td>
-<pre>
+
+
+automatically translated to a readable format:
+
IEEE text, Mus10, SAM 16-bit (modes 1 and 4), AVI, NIST shortpack, HCOM, Intel,
IBM, and Oki (Dialogic) ADPCM, G721, G723_24, G723_40, MIDI sample dump, Ogg, Speex,
Flac, Midi, Mpeg, Shorten, Wavepack, tta (via external programs)
+
</pre>
-</td></tr></table>
<p>
@@ -620,7 +656,7 @@ the default output variables such as <a href="extsnd.html#defaultoutputheadertyp
or from a dialog that pops up when some field has not been set
in advance.
Similary, a raw data file gets its srate, chans,
-and data format information either from the open-raw-sound-hook
+and sample type information either from the open-raw-sound-hook
or from a dialog window that pops up when such a file
is opened. The file types listed above as "automatically translated" are
decoded upon being opened, translated to some format Snd can read and write,
@@ -634,7 +670,7 @@ and that file is the one the editor sees from then on.
screen space; within that section, each channel
has a pane, and below the channels is the 'control
pane', normally hidden except for the file name
-and 'minibuffer'. At the very bottom
+and 'status area'. At the very bottom
of the Snd window is the listener, if any (see
the View menu Open listener option).
The panes can all be independently
@@ -649,10 +685,10 @@ the frequency domain (FFT) display.
There is a third display settable by user-provided
functions; if both the 'w' and 'f' buttons are
off and there is no active user-display function,
-you get an empty display. <A NAME="panecontrol"></a>For each sound there is
+you get an empty display. For each sound there is
a control panel containing the file name, in parentheses if
the file is actually a link, with an
-asterisk if there are unsaved edits, a 'minibuffer'
+asterisk if there are unsaved edits, a 'status area'
for various kinds of simple text-based interactions,
a 'sync' button for grouped display and edit
operations, a 'unite' button (if the sound has more than one channel),
@@ -660,28 +696,23 @@ and a 'play' button to play the
current (edited) state of the file.
</p>
-<A NAME="newfile"></a><p>To open a new, empty file, use the File:New option.
+<p id="newfile">To open a new, empty file, use the File:New option.
The default values for the fields can be set by clicking "Reset". These values are <a href="extsnd.html#defaultoutputchans">default-output-chans</a>,
-<a href="extsnd.html#defaultoutputdataformat">default-output-data-format</a>,
+<a href="extsnd.html#defaultoutputsampletype">default-output-sample-type</a>,
<a href="extsnd.html#defaultoutputsrate">default-output-srate</a>, and
-<a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a>. The name
-field can be set upon each invocation through
-<a href="extsnd.html#outputnamehook">output-name-hook</a>, and the
-comment field via <a href="extsnd.html#outputcommenthook">output-comment-hook</a>.
+<a href="extsnd.html#defaultoutputheadertype">default-output-header-type</a>.
</p>
-<A NAME="closefile"></a><p>To close a file (flushing any unsaved edits), use
+<p id="closefile">To close a file (flushing any unsaved edits), use
the File:Close option, or C-x k. This command
applies to the currently selected sound.
</p>
-<A NAME="savefile"></a><p>To save the current edited state of a file, use the
+<p id="savefile">To save the current edited state of a file, use the
Save option (to overwrite the old version of the
-file), or <A class=def NAME="savefileas">Save as</a> (to write to a new file, leaving
+file), or <em class=emdef id="savefileas">Save as</em> (to write to a new file, leaving
the old file unchanged). The equivalent keyboard
-command is C-x C-s (save). Other related keyboard
-commands are C-x w (save selection as file), and
-<A class=def NAME="cxcw">C-x C-w</a> (extract and save the current channel as a file).
+command is C-x C-s (save).
Normally, if the new file already exists, and it is
not currently being edited in Snd, it is silently
overwritten. If you try to overwrite a file, and
@@ -697,7 +728,7 @@ put the desired channel number (0-based) in the "extract channel" field,
then click 'Extract'.
</p>
-<A NAME="revertfile"></a><p>To undo all edits and return to the last saved state
+<p id="revertfile">To undo all edits and return to the last saved state
of a file, use the Revert option. The edit history
is still available, so you can redo all the edits
in order by calling <a href="#undoredo">Redo</a> repeatedly.
@@ -705,17 +736,19 @@ There's also a list on the left of each channel pane containing a list of
the current edits. You can click anywhere in the list to move to that
edit.
</p>
-<img src="pix/edithistory.png" alt="edit history list" hspace=40 usemap="#edithistorymap" border=0>
+
+<img class="indented" src="pix/edithistory.png" alt="edit history list" usemap="#edithistorymap">
+
<map name="edithistorymap">
- <area shape=rect coords="0,30,245,230" onmouseout="UnTip()" onmouseover="Tip('this is the edit history list. We\'ve made 4 edits so far.')">
- <area shape=rect coords="285,30,420,210" onmouseout="UnTip()" onmouseover="Tip('this is the time domain graph with display-current-window.')">
- <area shape=rect coords="530,30,760,210" onmouseout="UnTip()" onmouseover="Tip('this is the frequency domain (FFT) graph with peaks.')">
- <area shape=rect coords="0,285,750,415" onmouseout="UnTip()" onmouseover="Tip('this is the listener showing the edits.')">
- <area shape=rect coords="210,245,570,275" onmouseout="UnTip()" onmouseover="Tip('this is the minibuffer telling us about the cursor.')">
+ <area shape=rect coords="0,30,245,230">
+ <area shape=rect coords="285,30,420,210">
+ <area shape=rect coords="530,30,760,210">
+ <area shape=rect coords="0,285,750,415">
+ <area shape=rect coords="210,245,570,275">
</map>
-<A NAME="printfile"></a><p>The Print option opens the Print
+<p id="printfile">The Print option opens the Print
dialog. You can send the currently active graph directly to
a printer, or save it as an encapsulated Postscript
file. The default name
@@ -723,47 +756,51 @@ of this file is "snd.eps"; it can be set via <a href="extsnd.html#epsfile">eps-f
</p>
<p>To mix files, see <a href="#mixingfiles">"Mix Files"</a>.
-To record a file, see <a href="#recordfile">"Record Files"</a>.
The <a href="#insertfile">Insert</a> option inserts a file at the cursor.
</p>
-<A NAME="exitfile"></a><p>Finally, to exit Snd cleanly (that is, removing any
+<p id="exitfile">Finally, to exit Snd cleanly (that is, removing any
temporary files, and cleaning up some system stuff),
use the Exit option. Unsaved edits are silently
-flushed (but see the function <a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a>).</p>
-
-<br>
-
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="viewing">The Display</a></h3></td></tr></table>
-<br>
-
-<table border=8 bordercolor="lightgreen" hspace=20>
-<tr><th></th><th>View Menu</th><th></th></tr>
-<tr><td width=140><a href="#controls">Show controls</a></td><td>show the control panel</td><td>(C-x C-o, C-x C-c)</td></tr>
-<tr><td><a href="extsnd.html#lisplistener">Open listener</a></td><td>show listener</td><td></td></tr>
-<tr><td><a href="#mixdialog">Mixes</a></td><td>mix browser</td><td></td></tr>
-<tr><td><a href="#regionbrowser">Regions</a></td><td>a browser to examine the region stack</td><td></td></tr>
-<tr><td><a href="#viewfiles">Files</a></td><td>a browser of interesting files</td><td></td></tr>
-<tr><td><a href="#colorbrowser">Color/Orientation</a></td><td>a browser for color and viewing-orientation choices</td><td></td></tr>
-<tr><td><a href="#unitebutton">Channel style</a></td><td>separate, combined or superimposed channels</td><td></td></tr>
-<tr><td><a href="#viewdots">Graph style</a></td><td>use dots, lines, filled polygons etc in the data displays</td><td></td></tr>
-<tr><td><a href="extsnd.html#withverbosecursor">Verbose cursor</a></td><td>describe the current sample every time the cursor moves</td><td></td></tr>
-<tr><td><a href="#viewy0">Show y=0</a></td><td>show or hide the y=0 line</td><td></td></tr>
-<tr><td><a href="extsnd.html#xaxisstyle">X axis units</a></td><td>x axis labelled in seconds, samples, percent of total</td><td></td></tr>
-<tr><td><a href="#zoomoption">Zoom focus</a></td><td>where to focus during zooms</td></tr>
+flushed (but see the function <a href="extsnd.html#askaboutunsavededits">ask-about-unsaved-edits</a>).
+</p>
+
+
+
+
+<div class="innerheader" id="viewing">The display</div>
+
+<table class="borderspaced">
+<tr><th class="beige" colspan=3>View Menu</th></tr>
+<tr><td class="br"><a href="#controls">Show controls</a></td><td class="br">show the control panel</td></tr>
+<tr><td class="br"><a href="extsnd.html#lisplistener">Open listener</a></td><td class="br">show listener</td></tr>
+<tr><td class="br"><a href="#mixdialog">Mixes</a></td><td class="br">mix browser</td></tr>
+<tr><td class="br"><a href="#regionbrowser">Regions</a></td><td class="br">a browser to examine the region stack</td></tr>
+<tr><td class="br"><a href="#viewfiles">Files</a></td><td class="br">a browser of interesting files</td></tr>
+<tr><td class="br"><a href="#colorbrowser">Color/Orientation</a></td><td class="br">a browser for color and viewing-orientation choices</td></tr>
+<tr><td class="br"><a href="#unitebutton">Channel style</a></td><td class="br">separate, combined or superimposed channels</td></tr>
+<tr><td class="br"><a href="#viewdots">Graph style</a></td><td class="br">use dots, lines, filled polygons etc in the data displays</td></tr>
+<tr><td class="br"><a href="extsnd.html#withverbosecursor">Verbose cursor</a></td><td class="br">describe the current sample every time the cursor moves</td></tr>
+<tr><td class="br"><a href="#viewy0">Show y=0</a></td><td class="br">show or hide the y=0 line</td></tr>
+<tr><td class="br"><a href="extsnd.html#xaxisstyle">X axis units</a></td><td class="br">x axis labelled in seconds, samples, percent of total</td></tr>
+<tr><td class="br"><a href="#zoomoption">Zoom focus</a></td><td class="br">where to focus during zooms</td></tr>
+<tr><td class="br"><a href="extsnd.html#showgrid">With grid</a></td><td class="br">show a grid in the graph</td></tr>
</table>
-<p>The sound display can be modified in various ways. <A NAME="viewdots"></a>Choose View:Graph style:dots
+<p id="viewdots">The sound display can be modified in various ways. Choose View:Graph style:dots
to view the sound as dots rather than connected lines
-(see also <a href="extsnd.html#dotsize">dot-size</a>). <A NAME="viewy0"></a>Similarly, to show (or hide) the line
+(see also <a href="extsnd.html#dotsize">dot-size</a>).
+</p>
+
+<p id="viewy0">Similarly, to show (or hide) the line
Y = 0, use the y=0 option. The Region browser is described under
<a href="#regions">Regions</a>. To open the control panel, use Show Controls.
To open or close the listener, use Open listener.
</p>
-<p>The <A class=def NAME="colorbrowser">Color/Orientation</a> option
+<p>The <em class=emdef id="colorbrowser">Color/Orientation</em> option
activates a window that sets various aspects of the sonogram, spectrogram,
and wavogram displays. There are fifteen or so colormaps available along with
ways to invert the maps, and scale (darken) them differently according to screen or
@@ -771,11 +808,11 @@ printer characteristics.
</p>
-<p>The <A class=def NAME="viewinfo">Popup menu's Info</a> dialog can be left in view and updated with M-v i
+<p>The Popup menu's Info dialog can be left in view and updated with M-v i
to reflect the currently active sound. The same information is displayed in the
-minibuffer when you click the file name.</p>
+status area when you click the file name.</p>
-<p>The <A NAME="viewfiles">Files</a> option
+<p id="viewfiles">In the Motif version of Snd, the View Files option
starts a dialog with a list of interesting files,
controls for amplitude, speed (sampling rate change), and amplitude envelope,
and buttons to mix, insert, or open the selected files.
@@ -791,7 +828,7 @@ is a very awkward thing to do), or by calling <a href="extsnd.html#addfilesorter
by typing the file or directory name in the 'add:' text widget.
</p>
-<img src="pix/vf.png" alt="View:Files dialog" hspace=20 align=left>
+<img class="indented" src="pix/vf.png" alt="View:Files dialog">
<p>Files can be added to the list at startup
via the -p switch, and with the functions <a href="extsnd.html#addfiletoviewfileslist">add-file-to-view-files-list</a>
@@ -800,62 +837,57 @@ The 'Mix' button mixes in the currently selected sound, and 'Insert' inserts it.
See nb.scm for an extension of this dialog that posts various kinds of information
about each file as the mouse passes over it.
</p>
-<br clear=left>
<p>The <a href="#regionbrowser">Regions</a> and <a href="#mixdialog">Mix Dialog</a> options are described below.</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="options">Other Options</a></h3></td></tr></table>
-<br>
-<table border=8 bordercolor="lightgreen" hspace=20>
-<tr><th></th><th>Options Menu</th><th></th></tr>
-<tr><td width=160><a href="#viewfft">Transform options</a></td><td>various transform (FFT, etc) choices</td></tr>
-<tr><td>Controls</td><td>set variables that affect the control panel processing</td></tr>
-<tr><td><a href="#saveoptions">Save options</a></td><td>save current state of various variables</td></tr>
-<tr><td><a href="#savedstate">Save session</a></td><td>save current state</td></tr>
-<tr><td><a href="#preferencesbrowser">Preferences</a></td><td>customize Snd</td></tr>
+<div class="innerheader" id="options">Other options</div>
+
+<table class="borderspaced">
+<tr><th class="beige" colspan=2>Options Menu</th></tr>
+<tr><td class="br"><a href="#viewfft">Transform options</a></td><td class="br">various transform (FFT, etc) choices</td></tr>
+<tr><td class="br">Control panel options</td><td class="br">set variables that affect the control panel processing</td></tr>
+<tr><td class="br"><a href="#savedstate">Save session</a></td><td class="br">save current state</td></tr>
+<tr><td class="br"><a href="#preferencesbrowser">Preferences</a></td><td class="br">customize Snd</td></tr>
</table>
-<A NAME="viewfft"></a><p>
+<p id="viewfft">
Transform Options applies mainly to the FFT display triggered
by setting the 'f' button in the channel window. The dialog that is
launched by this menu item has six sections: on the upper left
is a list of available transform types; next on the right is a
-list of <a name="fftsize">fft sizes</a>; next is a panel of buttons that sets various
+list of fft sizes; next is a panel of buttons that sets various
display-oriented choices; the lower left panel sets the current
-wavelet, when relevant; <A NAME="menufftwindow"></a>next is the fft data window choice; and
+wavelet, when relevant; next is the fft data window choice; and
next to it is a graph of the current fft window with the spectrum of that window
in blue.
-<A NAME="Xfftbeta"></a>When the window
+When the window
has an associated parameter (sometimes known as "alpha" or "beta"),
the slider beneath the window list is highlighted and can be used
to choose the desired member of that family of windows.
</p>
-<img src="pix/ffts.png" alt="transform dialog" hspace=20 align=left>
+<img class="indented" src="pix/ffts.png" alt="transform dialog">
<p>The FFT is taken from the start (the left edge) of the
current window and is updated as the window bounds change.
If you'd like the fft size to reflect the current time domain
window size:</p>
-<table border=0 cellpadding=5 hspace=20><tr><td>
-<pre>
-(hook-push <a class=quiet href="extsnd.html#graphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphhook_tip)">graph-hook</a>
- (lambda (snd chn y0 y1)
+<pre class="indented">
+(hook-push <a class=quiet href="extsnd.html#graphhook">graph-hook</a>
+ (lambda (hook)
;; check that we are displaying an FFT,
;; if so, set the FFT size to reflect the graph boundaries
- (if (and (<a class=quiet href="extsnd.html#transformgraphp" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformgraphp_tip)">transform-graph?</a>)
- (= (<a class=quiet href="extsnd.html#transformgraphtype" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformgraphtype_tip)">transform-graph-type</a>) <a class=quiet href="extsnd.html#transformgraphtype" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphonce_tip)">graph-once</a>))
- (set! (<a class=quiet href="extsnd.html#transformsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformsize_tip)">transform-size)</a>
- (expt 2 (ceiling (/ (log (- (<a class=quiet href="extsnd.html#rightsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_rightsample_tip)">right-sample</a>)
- (<a class=quiet href="extsnd.html#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>)))
- (log 2.0))))))))
-</pre></td></tr></table>
+ (if (and (<a class=quiet href="extsnd.html#transformgraphp">transform-graph?</a>)
+ (= (<a class=quiet href="extsnd.html#transformgraphtype">transform-graph-type</a>) <a class=quiet href="extsnd.html#transformgraphtype">graph-once</a>))
+ (let ((size (expt 2 (ceiling (log (+ 1.0 (- (<a class=quiet href="extsnd.html#rightsample">right-sample</a>) (<a class=quiet href="extsnd.html#leftsample">left-sample</a>))) 2.0)))))
+ (if (not (= size (<a class=quiet href="extsnd.html#transformsize">transform-size)</a>))
+ (set! (<a class=quiet href="extsnd.html#transformsize">transform-size)</a> size))))))
+</pre>
<p>
The fft data is scaled to fit between 0.0 and 1.0 unless
@@ -867,20 +899,20 @@ to changing the variable <a href="extsnd.html#spectrumend">spectrum-end</a>). Y
on any point in the fft to get the associated fft value at that point
displayed; if with-verbose-cursor is on, you can
drag the mouse through the fft display and the
-description in the minibuffer will be constantly
+description in the status area will be constantly
updated.
</p>
-<A NAME="menutransformtype"></a><p>The transform is
+<p>The transform is
normally the Fourier Transform, but others are available, including
-about 20 wavelet choices, and <A NAME="autocorrelation">autocorrelation</a>.</p>
+about 20 wavelet choices, and autocorrelation.</p>
-<A NAME="fftstyle"></a><p>The top three buttons in the transform dialog choose between a normal
-fft, a sonogram, or a spectrogram. The <A NAME="showpeaks"></a>peaks
+<p>The top three buttons in the transform dialog choose between a normal
+fft, a sonogram, or a spectrogram. The peaks
button affects whether peak info is displayed alongside the graph
-of the spectrum. The <A NAME="fftindb"></a>dB button selects between
-a linear and logarithmic Y (magnitude) axis. The <A NAME="logfreq"></a>log freq
+of the spectrum. The dB button selects between
+a linear and logarithmic Y (magnitude) axis. The log freq
button makes a similar choice along the frequency axis.
</p>
@@ -889,51 +921,49 @@ of the spectrogram, wavogram, and sonogram, is to use the Color/Orientation
dialog from the View menu.
The keypad keys are mapped to various variables as follows:</p>
-<table border=0 hspace=20>
-<tr><th align=left><small>variable</small></th><th align=left><small>increase</small></th><th align=left><small>decrease</small></th></tr>
-<tr><td width=110><a href="extsnd.html#spectrohop"><small>spectro-hop</small></a></td><td><small>Add (+)</small></td><td><small>Subtract (-)</small></td></tr>
-<tr><td><a href="extsnd.html#transformsize"><small>transform-size</small></a></td><td><small>Multiply (*)</small></td><td><small>Divide (/)</small></td></tr>
-<tr><td><a href="extsnd.html#dotsize"><small>dot-size</small></a></td><td><small>Delete</small></td><td><small>Insert</small></td></tr>
-</table>
+
+<pre class="indented">
+variable increase decrease
+<a href="extsnd.html#spectrohop">spectro-hop</a> Add (+) Subtract (-)
+<a href="extsnd.html#transformsize">transform-size</a> Multiply (*) Divide (/)
+<a href="extsnd.html#dotsize">dot-size</a> Delete Insert
+</pre>
+
+
<p>
The keypad Enter key resets all the
spectrogram variables to their default values.
The keypad arrow keys zoom and move the fft spectrum.
</p>
-<img src="pix/hfft.png" alt="picture of sonogram">
-<br><br>
-<p>If your time domain data can be viewed as a series of slices
+<img class="indented" src="pix/hfft.png" alt="picture of sonogram">
+
+
+<p id="wavogram">If your time domain data can be viewed as a series of slices
through a 3-D landscape, you can use the
-<A NAME="wavogram"></a>"wavogram" to mimic the spectrogram in the time domain.
+"wavogram" to mimic the spectrogram in the time domain.
The first trace is at the bottom of the graph, moving from left to right.
The same rotation commands apply to this display,
with the additional variable <a href="extsnd.html#wavohop">wavo-hop</a> which sets the
-density of the traces. To get this display <code>(set! (<a href="extsnd.html#timegraphtype">time-graph-type</a>) <a class=quiet href="extsnd.html#timegraphtype" onmouseout="UnTip()" onmouseover="Tip(extsnd_timegraphtype_tip)">graph-as-wavogram</a>)</code>. It is
+density of the traces. To get this display <code>(set! (<a href="extsnd.html#timegraphtype">time-graph-type</a>) <a class=quiet href="extsnd.html#timegraphtype">graph-as-wavogram</a>)</code>. It is
important to set the length of each trace
so that successive peaks line up. The
trace length in samples is set by the variable <a href="extsnd.html#wavotrace">wavo-trace</a>,
or the numeric keypad + and - keys.
</p>
-<img src="pix/wavo.png" alt="wavogram of oboe" hspace=20>
+<img class="indented" src="pix/wavo.png" alt="wavogram of oboe">
-<A NAME="saveoptions"></a><p>The Save options menu option is a part
-of the <a href="extsnd.html#appearance">customization</a> process. It
-sets up (or adds to) an <a href="grfsnd.html#sndinitfile">initialization file</a> (normally ~/.snd) that sets all
-the options to their current settings,
-similar to Emacs' ~/.emacs file.
-</p>
-<A NAME="zoomoption"></a><p>The Zoom style option chooses which graph point to center on
+<p id="zoomoption">The Zoom style option chooses which graph point to center on
during an x-axis zoom.
The default is to zoom onto the cursor or the beginning of the current
selection if either is visible. You can also have
zoom focus on the left edge, right edge, or
midpoint of the current window.</p>
-<A NAME="preferencesbrowser"></a>
-<p>The Preferences dialog tries to make it easier to set up Snd initially. It is a GUI-based way to
+<p id="preferencesbrowser">
+The Preferences dialog tries to make it easier to set up Snd initially. It is a GUI-based way to
write your initialization file. Most of the global variables are included, and a number of
ancillary functions that seem to be popular. It's not yet completed, but more than 100 topics
are currently included — a good start!
@@ -942,31 +972,29 @@ the far right, and click on the one you're
interested in. If you leave the help dialog active, it becomes a sort of tooltip —
if you linger over some other topic, its help info will be posted in the help dialog.
</p>
-<img src="pix/prefs.png" alt="preferences dialog">
-<br>
-<br>
-<br>
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="editoperations">Edit Operations</a></h2></td></tr></table>
-</td></tr></table>
-
-<br>
-
-<table border=8 bordercolor="lightgreen" hspace=20>
-<tr><th></th><th>Edit Menu</th><th></th></tr>
-<tr><td width=160><a href="#undoredo">Undo</a></td><td>Undo last edit</td><td>(C-x C-u or C-_)</td></tr>
-<tr><td><a href="#undoredo">Redo</a></td><td>Redo last edit</td><td>(C-x C-r)</td></tr>
-<tr><td><a href="#menufind">Find</a></td><td>Global search via find dialog</td><td>(C-s, C-r)</td></tr>
-<tr><td><a href="#editcut">Cut</a></td><td>Cut (delete) selected portion</td><td></td></tr>
-<tr><td><a href="#editcut">Paste</a></td><td>Paste (insert) selected portion</td><td>(C-y, C-x i)</td></tr>
-<tr><td><a href="#editcut">Mix selection</a></td><td>Mix (add) selected portion</td><td>(C-x q)</td></tr>
-<tr><td><a href="#cxp">Play selection</a></td><td>Play selected portion</td><td>(C-x p)</td></tr>
-<tr><td><a href="#cxw">Save selection</a></td><td>Save selected portion as file</td><td>(C-x w)</td></tr>
-<tr><td><a href="#menuselectall">Select all</a></td><td>select entire file</td><td></td></tr>
-<tr><td>Unselect</td><td>unselect everything</td><td></td></tr>
-<tr><td><a href="#editenvelope">Edit Envelope</a></td><td>Edit or view envelopes</td><td></td></tr>
-<tr><td><a href="#editheader">Edit Header</a></td><td>Edit or view file header</td><td></td></tr>
+
+<img class="indented" src="pix/prefs.png" alt="preferences dialog">
+
+
+
+
+<div class="header" id="editoperations">Edit operations</div>
+
+
+<table class="borderspaced">
+<tr><th class="beige" colspan=2>Edit Menu</th></tr>
+<tr><td class="br"><a href="#undoredo">Undo</a></td><td class="br">Undo last edit</td></tr>
+<tr><td class="br"><a href="#undoredo">Redo</a></td><td class="br">Redo last edit</td></tr>
+<tr><td class="br"><a href="#menufind">Find</a></td><td class="br">Global search via find dialog</td></tr>
+<tr><td class="br"><a href="#editcut">Cut</a></td><td class="br">Cut (delete) selected portion</td></tr>
+<tr><td class="br"><a href="#editcut">Paste</a></td><td class="br">Paste (insert) selected portion</td></tr>
+<tr><td class="br"><a href="#editcut">Mix selection</a></td><td class="br">Mix (add) selected portion</td></tr>
+<tr><td class="br"><a href="#cxp">Play selection</a></td><td class="br">Play selected portion</td></tr>
+<tr><td class="br">Save selection</td><td class="br">Save selected portion as file</td></tr>
+<tr><td class="br"><a href="#menuselectall">Select all</a></td><td class="br">select entire file</td></tr>
+<tr><td class="br">Unselect all</td><td class="br">unselect everything</td></tr>
+<tr><td class="br"><a href="#editenvelope">Edit Envelope</a></td><td class="br">Edit or view envelopes</td></tr>
+<tr><td class="br"><a href="#editheader">Edit Header</a></td><td class="br">Edit or view file header</td></tr>
</table>
@@ -987,32 +1015,33 @@ how to use marks and regions; how to perform various
common editing operations. It ends with a description of
all the mouse and keyboard editing commands. The 'control
panel' provides more complex editing operations, but
-has a chapter to itself.</p>
+has a chapter to itself.
+</p>
+
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="thecursor">The Active Channel and The Cursor</a></h3></td></tr></table>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>The Active Channel</h4></td></tr></table>
+
+<div class="innerheader" id="thecursor">The active channel and cursor</div>
<p>Click in the time domain waveform to activate the cursor and select that channel.
To make the selected channel stand out from the rest,
set the <a href="extsnd.html#selecteddatacolor">selected-data-color</a>
or the <a href="extsnd.html#selectedgraphcolor">selected-graph-color</a>:</p>
-<pre>
- (define beige (<a class=quiet href="extsnd.html#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0.96 0.96 0.86))
- (define blue (<a class=quiet href="extsnd.html#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 0 0 1))
- (set! (<a class=quiet href="extsnd.html#selectedgraphcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedgraphcolor_tip)">selected-graph-color</a>) beige)
- (set! (<a class=quiet href="extsnd.html#selecteddatacolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selecteddatacolor_tip)">selected-data-color</a>) blue)
+
+<pre class="indented">
+(define beige (<a class=quiet href="extsnd.html#makecolor">make-color</a> 0.96 0.96 0.86))
+(define blue (<a class=quiet href="extsnd.html#makecolor">make-color</a> 0 0 1))
+(set! (<a class=quiet href="extsnd.html#selectedgraphcolor">selected-graph-color</a>) beige)
+(set! (<a class=quiet href="extsnd.html#selecteddatacolor">selected-data-color</a>) blue)
</pre>
+
<p>The selected channel receives keyboard commands. You can
-also move between windows with <A NAME="cxo"></a>C-x o.</p>
+also move between windows with C-x o.</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>Moving the Cursor</h4></td></tr></table>
+<div class="innerheader">Moving the cursor</div>
-<A NAME="movecursor"></a>
-<p>Any mouse click on the waveform causes the cursor to move to that point.
+
+<p id="movecursor">Any mouse click on the waveform causes the cursor to move to that point.
"The cursor" here refers to the sample cursor, normally a big "+". There is also the
cursor associated with the mouse which is a slanting arrow outside the graph, but
changes to a small "+" inside the graph. When the mouse
@@ -1021,35 +1050,35 @@ it changes to a double arrow. When a mouse click will start sound playing,
it becomes a right arrow. And when it's over the selection
loop-play triangle, it's a left arrow. But the main cursor in Snd is the big "+" that marks a particular sample.
To move it from the keyboard, use:</p>
-<pre>
- < move cursor to sample 0
- > move cursor to last sample
- C-< move cursor to sample 0
- C-> move cursor to last sample
-
- <A NAME="ca"></a>C-a move cursor to window start
- <A NAME="ce"></a>C-e move cursor to window end
- C-b move cursor back one pixel
- C-f move cursor ahead one pixel or n samples
-
- C-n move cursor ahead one 'line'
- C-p move cursor back one 'line'
- <A NAME="cv"></a>C-v move cursor to mid-window
-
- <A NAME="ci"></a>C-i display cursor info
- C-j go to mark
- C-x j go to named mark
+
+<pre class="indented">
+< move cursor to sample 0
+> move cursor to last sample
+C-< move cursor to sample 0
+C-> move cursor to last sample
+
+C-a move cursor to window start
+C-e move cursor to window end
+C-b move cursor back one pixel
+C-f move cursor ahead one pixel or n samples
+
+C-n move cursor ahead one 'line'
+C-p move cursor back one 'line'
+C-v move cursor to mid-window
+
+C-i display cursor info
+C-j go to mark
</pre>
-<A NAME="cu"></a>
+
<p>All keyboard commands accept numerical arguments, as in Emacs.
If the argument is a float, it is multiplied by the sampling
rate before being applied to the command, so C-u 2.1 C-f moves
the cursor forward 2.1 seconds in the data.</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>Moving the Window</h4></td></tr></table>
-<A NAME="movingwindow"></a>
+
+<div class="innerheader">Moving the window</div>
+
<p>The simplest way to move the window (the portion of the data in the current graph) is to drag the
scrollbars with the mouse. The darker scrollbars zoom in and
out; the lighter bars move the window along the x or y axis.
@@ -1066,22 +1095,24 @@ and you'll zoom an increasing amount into the data at that
point.
</p>
-<A NAME="movewindow"></a>
-<p>Various keyboard commands provide
-much more precise control of the window bounds and placement:</p>
-<pre>
- C-l position window so cursor is in the middle
- C-x b position window so cursor is on left margin
- <A NAME="cxf"></a>C-x f position window so cursor is on right margin
- [Down] zoom out, amount depends on shift, control, and meta
- [Up] zoom in
- [Left] move window left
- [Right] move window right
- <A NAME="cxl"></a>C-x l position selection in mid-view
- C-x v position window over current selection
- <A NAME="cxcb"></a>C-x C-b set x window bounds (preceded by number of leftmost sample)
- C-x C-p set window size (preceded by size as numeric argument)
+<p id="movewindow">Various keyboard commands provide
+much more precise control of the window bounds and placement:
+</p>
+
+<pre class="indented">
+C-l position window so cursor is in the middle
+C-x b position window so cursor is on left margin
+C-x f position window so cursor is on right margin
+[Down] zoom out, amount depends on shift, control, and meta
+[Up] zoom in
+[Left] move window left
+[Right] move window right
+C-x l position selection in mid-view
+C-x v position window over current selection
+C-x C-b set x window bounds (preceded by number of leftmost sample)
+C-x C-p set window size (preceded by size as numeric argument)
</pre>
+
<p>As in most other cases, the sample numbers (or sizes) can be floats;
if the argument is not an integer, it is multiplied by the sampling
rate before being applied to the command. So, C-u .1 C-x C-p makes
@@ -1090,8 +1121,10 @@ If you'd like far more precise window moving and zooming control,
see <a href="extsnd.html#moveonepixel">move-one-pixel</a> and
<a href="extsnd.html#zoomonepixel">zoom-one-pixel</a>.
</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="marks">Marks</a></h3></td></tr></table>
+
+
+
+<div class="innerheader" id="marks">Marks</div>
<p>A 'mark' marks a particular sample in a sound (not a
position in that sound).
@@ -1119,15 +1152,16 @@ than 0) will move together when one is moved, and so on.
See the <a href="extsnd.html#sndmarks">marks</a> chapter
for a further discussion of synced marks.
The following keyboard commands relate to marks:</p>
-<pre>
- <A NAME="cm"></a>C-m place (or remove if argument negative) mark at cursor
- C-M place syncd marks at all currently syncd chan cursors
- C-x / place named mark at cursor
- <A NAME="cxcm"></a>C-x C-m add named mark
-
- <A NAME="cj"></a>C-j go to mark
- <A NAME="cxj"></a>C-x j go to named mark
+
+<pre class="indented">
+C-m place (or remove if argument negative) mark at cursor
+C-M place syncd marks at all currently syncd chan cursors
+C-x / place named mark at cursor
+C-x C-m add named mark
+
+C-j go to mark
</pre>
+
<p>The distance from the cursor to a mark can be used as a numeric
argument for other commands by following C-u with C-m. Any
number in-between is the number of marks to jump forward before
@@ -1137,8 +1171,9 @@ getting the distance.</p>
file.
</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="regions">Regions</a></h3></td></tr></table>
+
+
+<div class="innerheader" id="regions">Regions</div>
<p>A region is a portion of the sound
data. Although I'm not completely consistent in this document,
@@ -1153,9 +1188,9 @@ will not affect the region data.
You can disable the region creation by setting the variable
<a href="extsnd.html#selectioncreatesregion">selection-creates-region</a>
to #f (its default is #t which can slow down editing of very large sounds).
-<A NAME="mousedefsect"></a>Regions can be defined by <a href="extsnd.html#makeregion">make-region</a>, by dragging the mouse
+Regions can be defined by <a href="extsnd.html#makeregion">make-region</a>, by dragging the mouse
through a portion of the data, or via
-the <A NAME="menuselectall"></a>Select All menu option.
+the <em class="noem" id="menuselectall">Select All</em> menu option.
If the mouse drags off
the end of the graph, the x axis moves, in a sense dragging
the data along to try to keep up with the mouse; the further
@@ -1167,26 +1202,26 @@ coalesced by X; move deliberately as you near the end
of the sound). In large sounds, the mouse granularity can be
large, but you can zoom onto the start or end of the selected
portion and move them using <a href="extsnd.html#selectionposition">selection-position</a>
-and <a href="extsnd.html#selectionframes">selection-frames</a>.
+and <a href="extsnd.html#selectionframples">selection-framples</a>.
A region can also be defined with keyboard
commands, much as in Emacs. C-[space] starts the
region definition and the various cursor moving
commands continue the definition.</p>
-<A NAME="regionbrowser"></a><p>Once defined, the copied region
+<p id="regionbrowser">Once defined, the copied region
is added to a list of currently
available regions (the maximum list size is normally 16 — see <a href="extsnd.html#maxregions">max-regions</a>).
The currently available regions can be view from the
View menu's Region browser:</p>
-<img src="pix/regions.png" alt="picture of region browser" align=left hspace=20>
+<img class="indented" src="pix/regions.png" alt="picture of region browser">
<p>
'play' plays the region. The graphical
display
shows the waveform with arrows to move around in the
-channels of multichannel regions. The 'edit' button
+channels of multichannel regions. If you double click the region entry, it
loads the region into the main editor as a temporary
file. It can be edited or renamed, etc. If you save
the file, the region is updated to reflect any edits
@@ -1194,18 +1229,15 @@ you made.
</p>
<p>The keyboard commands that apply to regions are:</p>
-<pre>
- C-y paste in current selection at cursor
- C-[space] start keyboard-based selection definition
- C-x a apply amplitude envelope to selection
- <A NAME="cxc"></a>C-x c define selection from cursor to mark
- <A NAME="cxi"></a>C-x i insert selection
- C-x p play selection or region
- <A NAME="cxq"></a>C-x q mix in selection
- <A NAME="cxw"></a>C-x w save selection as file
-
- C-x l position selection in mid-view
- C-x v position window over current selection
+
+<pre class="indented">
+C-y paste in current selection at cursor
+C-[space] start keyboard-based selection definition
+C-x c define selection from cursor to mark
+C-x p play selection or region
+C-x q mix in selection
+C-x l position selection in mid-view
+C-x v position window over current selection
</pre>
<p>If the current selection is active (displayed somewhere in the
@@ -1215,12 +1247,10 @@ If the 'selection' button is set in the transform options dialog,
(or equivalently, <a href="extsnd.html#showselectiontransform">show-selection-transform</a>
is #t), the fft display, if any, displays the transform of the selected portion.
</p>
-<br>
-<br>
-<br>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="edithistory">The Edit List</a></h3></td></tr></table>
+
+
+<div class="innerheader" id="edithistory">The edit list</div>
<p>The current state of the undo/redo list can be viewed
as a scrolled list of strings in the pane on the left of the
@@ -1241,10 +1271,10 @@ meantime). The file can be edited (it's just a text file with comments).
See <a href="extsnd.html#editlists">Edit Lists</a> for more details.
</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="howtoedit">How to...</a></h3></td></tr></table>
-<br>
-<table><tr><td>
+
+
+<div class="innerheader" id="howtoedit">How to ...</div>
+
<ul>
<li><a href="#saveopen">Save, open, close, print</a>
<li><a href="#deleteinsert">Delete, insert, mix</a>
@@ -1252,80 +1282,73 @@ See <a href="extsnd.html#editlists">Edit Lists</a> for more details.
<li><a href="#ampenvs">Amplitude envelopes and scaling</a>
<li><a href="#menufind">Find</a>
<li><a href="#changesamples">Change samples</a>
-</ul></td><td>
-<ul>
<li><a href="#undoredo">Undo, redo, revert</a>
<li><a href="#menuplay">Play</a>
<li><a href="#mixingfiles">Mix Files</a>
-<li><a href="#kbdmacros">Keyboard macros</a>
<li><a href="#changeformat">Change file format</a>
<li><a href="#extendfile">Extend a file</a>
-</ul></td><td>
-<ul>
-<li><a href="#recordfile">Record a file</a>
<li><a href="#editenvelope">Edit or view an envelope</a>
<li><a href="#editheader">Edit, add, or remove the header</a>
<li><a href="#centeryaxis">Center a tiny signal with DC</a>
<li><a href="#savedstate">Save session for later restart</a>
-<li><a href="#misccommands">Miscellaneous commands</a>
+<li><a href="#misccommands">whatever...</a>
<li>
</ul>
-</td></tr></table>
+<div class="innerheader" id="saveopen">Save, open, close, print</div>
+
+<p>Most of these kinds of operations are accessible from the File menu:
+</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="saveopen">Save, open, close, print</a></h4></td></tr></table>
+<img class="indented" src="pix/saveas.png" alt="save as dialog">
-<img src="pix/saveas.png" alt="save as dialog" align=right>
-<p>Most of these kinds of operations are accessible from the File menu.
+<p>
They can also
be invoked from the keyboard:</p>
-<pre>
- <A NAME="cxk"></a>C-x k close currently selected file
- C-x w save selection as file
- <A NAME="cxcd"></a>C-x C-d print
- <A NAME="cxcf"></a>C-x C-f open file
- <A NAME="cxcs"></a>C-x C-s save file
- C-x C-i insert file
- C-x C-w save currently selected channel as file
+
+<pre class="indented">
+C-x k close currently selected file
+C-x C-f open file
+C-x C-s save file
+C-x C-w save currently selected channel as file
</pre>
+
<p>The Print command produces a PostScript
-file which can be sent to directly a printer or saved for later use.</p>
+file which can be sent to directly a printer or saved for later use.
+</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="deleteinsert">Delete, insert, mix</a></h4></td></tr></table>
-<A NAME="editcut"></a><p>The fastest way to delete a section is to drag the mouse through it and
-call the Edit menu's Delete selection option. Any region
-can be pasted or mixed in using C-x q and C-x i with a
-numeric argument (the region number); the current selection
+
+<div class="innerheader" id="deleteinsert">Delete, insert, mix</div>
+
+<p id="editcut">The fastest way to delete a section is to drag the mouse through it and
+call the Edit menu's Delete selection option.
+The current selection
can be pasted in
by clicking the middle mouse button. The
associated keyboard commands are:</p>
-<pre>
- C-d delete sample at cursor
- C-h delete previous sample
- <A NAME="ck"></a>C-k delete a 'line' — 128 samples
- <A NAME="cw"></a>C-w delete current selected portion
-
- <A NAME="co"></a>C-o insert a zero sample at cursor
- C-x i insert selection at cursor
- <A NAME="cxci"></a>C-x C-i insert file
-
- C-y paste in current selection at cursor
- C-x q mix in region (arg = region number)
- <A NAME="cxcq"></a>C-x C-q mix in file
+<pre class="indented">
+C-d delete sample at cursor
+C-h delete previous sample
+C-k delete a 'line' — 128 samples
+C-w delete current selected portion
+C-o insert a zero sample at cursor
+C-y paste in current selection at cursor
+C-x q mix in region (arg = region number)
+C-x C-q mix in file
</pre>
-<p>The <A NAME="insertfile">File:Insert</a> menu option inserts a sound file at the cursor, and
+
+<p id="insertfile">The File:Insert menu option inserts a sound file at the cursor, and
the Edit:Insert Selection menu option does the same with the current selection.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="multichannel">Multichannel operations</a></h4></td></tr></table>
-<A NAME="syncbutton"></a><p>Normally each operation applies only to the currently
+
+<div class="innerheader" id="multichannel">Multichannel operations</div>
+
+<p id="syncbutton">Normally each operation applies only to the currently
active channel. If, however, the sound's 'sync' button is set,
the operations apply to every sound or channel that also
has the sync field set to the same value. If you click
@@ -1341,7 +1364,7 @@ different values; that way, the channels within each sound are
sync'd together (giving stereo operations), but the sounds themselves
are separate.</p>
-<A NAME="unitebutton"></a><p>A multichannel sound also
+<p id="unitebutton">A multichannel sound also
has a 'unite' button to the left of the 'sync' button.
If this button is set, all channels are displayed in
one graph; the x and y-axis scrollbars apply to all the
@@ -1360,6 +1383,7 @@ to get superimposed channels.
If the channels are not combined (the default), control-click the 'f' or 'w' button in one
channel to affect all channels at once.
</p>
+
<p>
The superimposed channels display is not very useful if you're trying to
edit the sound; it's aimed more at FFT comparisons and so on.
@@ -1371,8 +1395,9 @@ the mouse) in one channel, and the parallel
portions of the other channels will also be
selected.</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="ampenvs">Amplitude envelopes and scaling</a></h4></td></tr></table>
+
+
+<div class="innerheader" id="ampenvs">Amplitude envelopes and scaling</div>
<p>An envelope in Snd is a list of x y break-point pairs.
The x axis range is arbitrary.
@@ -1384,52 +1409,42 @@ Use the <a href="#editenvelope">envelope editor</a>
to draw envelopes with the mouse.
</p>
-<p>To apply an envelope to a sound, use the extended
-command C-x C-a. If this command gets a numeric
-argument, the envelope is applied from the cursor
-for that many samples. Otherwise, the envelope is
-applied to the entire file.</p>
-<pre>
- C-x a apply amplitude envelope to selection
- <A NAME="cxca"></a>C-x C-a apply amplitude envelope to channel
-</pre>
-<p>You can also specify an envelope name to the C-x C-a prompt.
-</p>
-
-<A NAME="scaling"></a><p>To scale a file or selection by or to some
+<p id="scaling">To scale a file or selection by or to some
amplitude, use the functions:</p>
-<pre>
- <a href="extsnd.html#scaleby">scale-by</a> args
- <a href="extsnd.html#scaleto">scale-to</a> args
- <a href="extsnd.html#scaleselectionby">scale-selection-by</a> args
- <a href="extsnd.html#scaleselectionto">scale-selection-to</a> args
+
+<pre class="indented">
+<a href="extsnd.html#scaleby">scale-by</a> args
+<a href="extsnd.html#scaleto">scale-to</a> args
+<a href="extsnd.html#scaleselectionby">scale-selection-by</a> args
+<a href="extsnd.html#scaleselectionto">scale-selection-to</a> args
</pre>
-<p><i>scale-by</i> scales the current sync'd channels by its arguments,
-and <i>scale-to</i> scales them to its arguments (a normalization).
+
+<p>scale-by scales the current sync'd channels by its arguments,
+and scale-to scales them to its arguments (a normalization).
The arguments in each case are either a list of floats
corresponding to each successive member of the current
set of sync'd channels, or just one argument. In the
latter case, scale-by uses that scaler for all its
channels, and scale-to normalizes all the channels
together so that the loudest reaches that amplitude
-(that is, (<a class=quiet href="extsnd.html#scaleto" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleto_tip)">scale-to</a> .5) when applied to a stereo file
+(that is, (<a class=quiet href="extsnd.html#scaleto">scale-to</a> .5) when applied to a stereo file
means that both channels are scaled by the same amount so
that the loudest point in the file becomes .5). There's
-one special case here: if you (<a class=quiet href="extsnd.html#scaleto" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleto_tip)">scale-to</a> 1.0) in a sound
+one special case here: if you (<a class=quiet href="extsnd.html#scaleto">scale-to</a> 1.0) in a sound
that is stored as short ints and you haven't set the clipping
variable to #t, since 1.0 itself is not representable,
the actual scaled-to value is just less than 1.0 to avoid the
(unwanted) wrap-around.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="menufind">Find</a></h4></td></tr></table>
+
+
+<div class="innerheader" id="menufind">Find</div>
<p>Searches in Snd refer to the sound data, and are,
in general, patterned after Emacs. When you type
-C-s or C-r, the minibuffer below the graph is
-activated and you are asked for the search expression.
-The expression is a
+C-s, the find dialog is activated.
+The expression it asks for is a
function that takes one argument, the current
sample value, and returns #t when it finds a match.
To look for the next sample that is greater than
@@ -1437,19 +1452,11 @@ To look for the next sample that is greater than
cursor then moves
to the next such sample, if any.
Successive C-s's
-or C-r's repeat the search. C-x C-s can redefine the
-search pattern, which is also cleared by various other
-commands, much as in Emacs.
-The search commands are:</p>
-<pre>
- C-r find backwards
- <A NAME="cs"></a>C-s find forwards
-</pre>
-<p>These searching functions can be closures; the following searches for
+repeat the search.
+These searching functions can be closures; the following searches for
the next positive-going zero crossing, placing the cursor just before it:</p>
-<table border=0 cellpadding=5 hspace=20><tr><td>
-<pre>
+<pre class="indented">
(define (zero+)
;; return a closure to search for positive-going zero crossing.
(let ((lastn 0.0))
@@ -1459,28 +1466,30 @@ the next positive-going zero crossing, placing the cursor just before it:</p>
-1)))
(set! lastn n)
rtn))))
-</pre></td></tr></table>
+</pre>
<p>Now C-s (zero+) followed by C-s's moves to successive zero crossings.
There are more examples in <a href="sndscm.html#zeroplus">sndscm.html</a>.
-See also the functions <a href="extsnd.html#findchannel">find-channel</a> and <a href="extsnd.html#countmatches">count-matches</a>.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="changesamples">Change samples</a></h4></td></tr></table>
+
+
+
+<div class="innerheader" id="changesamples">Change samples</div>
<p>The simplest changes are:</p>
-<pre>
- <A NAME="cz"></a>C-z set current sample to zero
- <A NAME="cxcz"></a>C-x C-z smooth data using cosine (<a href="extsnd.html#smoothsound">smooth-sound</a>)
+
+<pre class="indented">
+C-z set current sample to zero
+C-x C-z smooth data using cosine (<a href="extsnd.html#smoothsound">smooth-sound</a>)
</pre>
-<p>M-x (set! (<a class=quiet href="extsnd.html#sample" onmouseout="UnTip()" onmouseover="Tip(extsnd_sample_tip)">sample</a> (<a class=quiet href="extsnd.html#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>)) .1) sets the sample
+<p><code>(set! (<a class=quiet href="extsnd.html#sample">sample</a> (<a class=quiet href="extsnd.html#cursor">cursor</a>)) .1)</code> sets the sample
at the cursor to .1. To set several samples to zero, use C-u <number> C-z.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="undoredo">Undo, redo, revert</a></h4></td></tr></table>
+
+<div class="innerheader" id="undoredo">Undo, redo, revert</div>
<p>Snd supports 'unlimited undo' in the sense that you can
move back and forth in the list of edits without any
@@ -1490,16 +1499,20 @@ extends the current edit list; each undo backs up in that
list, and each redo moves forward in the list of previously
un-done edits. Besides the Edit and Popup menu options, there
are these keyboard commands:</p>
-<pre>
- C-x r redo last edit
- C-x u undo last edit
- <A NAME="cxcr"></a>C-x C-r redo last edit
- <A NAME="cxcu"></a>C-x C-u undo last edit
- C-_ undo last edit
+
+<pre class="indented">
+C-x r redo last edit
+C-x u undo last edit
+C-x C-r redo last edit
+C-x C-u undo last edit
+C-_ undo last edit
</pre>
+
<p>Revert is the same as undoing all edits.</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="menuplay">Play</a></h4></td></tr></table>
+
+
+
+<div class="innerheader" id="menuplay">Play</div>
<p>To play a sound, click the 'play' button. If the sound has more
channels than your DAC(s), Snd will (normally) try to mix the extra channels
@@ -1518,10 +1531,10 @@ triangle of one of them.
The Edit menu 'Play' option plays the current
selection, if any.
And the region and file browsers provide
-play buttons for each of the listed regions or files. <A NAME="trackingcursor"></a>If you
+play buttons for each of the listed regions or files. If you
hold down the control key when you click 'play', the cursor
follows along as the sound is played. If 'verbose cursor' is
-on, the time is also displayed in the minibuffer.
+on, the time is also displayed in the status area.
If you stop the play
in progress, the cursor remains where you stopped it, but
otherwise returns to its original position. Type space
@@ -1535,21 +1548,20 @@ red: playback paused.</p>
If you're getting
interruptions while playing a sound (stereo 44.1 kHz sounds can be problematic),
try using a very large dac buffer. Use set! to change this:
-<code>(set! (<a class=quiet href="extsnd.html#dacsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_dacsize_tip)">dac-size</a>) 65536)</code>.
+<code>(set! (<a class=quiet href="extsnd.html#dacsize">dac-size</a>) 65536)</code>.
If you're getting clicks in Linux despite a large dac-size, try setting the OSS fragment sizes by hand: <code>
-(<a class=quiet href="extsnd.html#musosssetbuffers" onmouseout="UnTip()" onmouseover="Tip(extsnd_musosssetbuffers_tip)">mus-oss-set-buffers</a> fragments fragment-size)</code>. OSS's
+(<a class=quiet href="extsnd.html#musosssetbuffers">mus-oss-set-buffers</a> fragments fragment-size)</code>. OSS's
defaults are 16 and 12 which make the control panel controls very sluggish. Snd used to
default to 4 and 12, but this seems to cause trouble for a variety of new sound cards.
My initialization file uses <code>(mus-oss-set-buffers 2 12)</code>.
</p>
+<p>The keyboard commands for playing are:</p>
-
-<A NAME="cq"></a><p>The keyboard commands for playing are:</p>
-<pre>
- C-q or space play current channel starting at the cursor
- C-t stop playing
- <A NAME="cxp"></a>C-x p play region (numeric arg selects region)
+<pre class="indented">
+C-q or space play current channel starting at the cursor
+C-t stop playing
+<em class="noem" id="cxp">C-x p</em> play region (numeric arg selects region)
</pre>
<p>In a multichannel file, C-q plays all channels from the current channel's
@@ -1566,8 +1578,10 @@ any current playing. If no numeric argument is supplied,
C-x p plays the currently active selection.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="mixingfiles">Mix Files</a></h4></td></tr></table>
+
+
+
+<div class="innerheader" id="mixingfiles">Mix Files</div>
<p>Mixing (adding, not multiplying by a sinusoid) is the most common
editing operation performed on sounds, so there is relatively
@@ -1587,15 +1601,27 @@ be changed independently of anything else either through such functions as
<a href="extsnd.html#mixamp">mix-amp</a>, or through the View:Mix Dialog.
</p>
-<img src="pix/mixer.png" alt="mix tags">
-<br>
-<br>
-<table width="35%" border=0><tr><td bgcolor="#FDFDF2" valign="middle"><A NAME="mixdialog">The Mix Dialog</a></td></tr></table>
+<img class="indented" src="pix/mixer.png" alt="mix tags">
+
+<p>
+The function <a href="sndscm.html#makesoundbox">make-sound-box</a>
+produces a container with each sound represented by an icon;
+you can drag-and-drop the icon to the place where you want it mixed,
+or drop it on the main menubar to open it.
+</p>
+
+
+
+
+<div class="innerheader" id="mixdialog">The Mix dialog</div>
+
+<p>The Mix Dialog (click a mix tag, or click Mixes in the View Menu) provides various
+commonly-used controls on the currently chosen mix.
+</p>
-<img src="pix/mixdialog.png" alt="mix dialog" align=right>
+<img class="indented" src="pix/mixdialog.png" alt="mix dialog">
-<p>The Mix Dialog (click a mix tag, or look in the View Menu) provides various
-commonly-used controls on the currently chosen mix. At the top are
+<p>At the top are
the mix id (an integer), its begin and end times, and a play button for the mix.
Beneath that are various sliders
controlling the speed (resampling rate) and amplitude of the mix,
@@ -1608,41 +1634,19 @@ are edited in parallel with the current one.
</p>
-<A NAME="gotomix"></a>
-<p>To move the cursor from one mix to the next, in the same
-manner as C-j moves through marks, use <A NAME="cxcj"></a>C-x C-j.
-</p>
-<p>
-The function <a href="sndscm.html#makesoundbox">make-sound-box</a>
-produces a container with each sound represented by an icon;
-you can drag-and-drop the icon to the place where you want it mixed,
-or drop it on the main menubar to open it.
-</p>
+<div class="innerheader" id="changeformat">Change file format</div>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="kbdmacros">Keyboard macros</a></h4></td></tr></table>
-
-<p><A NAME="kce"></a>As in Emacs, C-x ( begins keyboard macro definition, C-x )
-ends it, and C-x e executes the last keyboard macro. Unlike
-Emacs, C-x C-e prompts for a name for the last defined
-macro; M-x name invokes the macro "name", and the
-function save-macros saves all currently named macros.
-See the <a href="extsnd.html#lisplistener">lisp</a> section for
-more details.</p>
-
-
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="changeformat">Change file format</a></h4></td></tr></table>
-
-<p>To change the sound file's header or data format, use the File or Edit menu Save as option.
-Choose the header type you want, then the data format,
-(the data format list will change depending on the header
+<p>To change the sound file's header or sample type, use the File or Edit menu Save as option.
+Choose the header type you want, then the sample type,
+(the sample type list will change depending on the header
choice). The File:Save dialog saves the currently selected sound.
The Edit:Save dialog saves the selection in a new file.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="extendfile">Extend a File</a></h4></td></tr></table>
+
+
+
+<div class="innerheader" id="extendfile">Extend a File</div>
<p>
The easiest way to extend the
@@ -1654,23 +1658,14 @@ to add a second, C-> C-u 1.0 C-o. The same sequence
can be used to add silence to the start of a file.
Functions such as <a href="extsnd.html#insertsound">insert-sound</a>
automatically pad with zeros, if necessary.
-
</p>
-<br>
-<!-- INDEX recordfile:Recording -->
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="recordfile">Record a File</a></h4></td></tr></table>
-<img src="pix/simprec.png" alt="picture of recorder dialog" align=right hspace=20>
-<p>Snd's recorder is very simple; for complex recording tasks, use Ardour. The record dialog presents one or two VU meters (just
-the curve and a needle), a text widget for the output sound file name, a button to change the meters from linear to dB, and
-the usual buttons along the bottom to start or stop the recorder, provide help, and exit.
-</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="editenvelope">Edit or View an Envelope</a></h4></td></tr></table>
-<img src="pix/env.png" alt="picture of envelope editor" align=right hspace=10>
+<div class="innerheader" id="editenvelope">Edit or View an Envelope</div>
+
+<img class="indented" src="pix/env.png" alt="picture of envelope editor">
<p>The Edit Envelope dialog (under the Edit menu) opens a window
for viewing and editing envelopes.
@@ -1683,21 +1678,22 @@ its position, and click an existing breakpoint to delete it.
The Undo and Redo buttons can be used to move around
in the list of envelope edits;
the current state
-of the envelope can be saved with the 'save' button, or
-printed with 'print'.</p>
-
-<p>Envelopes can be defined
-using define or defvar (the latter for CL compatibility), and loaded from a separate file of envelope
+of the envelope can be defined in the extension language (and added to the envelope list on the left) with the 'define it' button.
+Envelopes can also be
+loaded from a separate file of envelope
definitions via load:
</p>
-<pre>
- (<a class=quiet href="extsnd.html#defvar" onmouseout="UnTip()" onmouseover="Tip(extsnd_defvar_tip)">defvar</a> ramp '(0 0 1 1))
- (<a class=quiet href="extsnd.html#defvar" onmouseout="UnTip()" onmouseover="Tip(extsnd_defvar_tip)">defvar</a> pyramid '(0 0 1 1 2 0))
+
+<pre class="indented">
+(<a class=quiet>define-envelope</a> ramp '(0 0 1 1))
+(<a class=quiet>define-envelope</a> pyramid '(0 0 1 1 2 0))
</pre>
-<p>defines two envelopes that can be used in Snd wherever an
-envelope is needed (e.g. C-x C-a). You can also define
-a new envelope in the dialog's text field;
-'(0 0 1 1) followed by return creates a ramp.</p>
+
+<p>This defines two envelopes that can be used in Snd wherever an
+envelope is needed. You can also define
+a new envelope in the dialog's text field; for example,
+'(0 0 1 1) followed by return creates a ramp.
+</p>
<p>In the overall view of envelopes,
click one, or click its name in the scrolled
@@ -1707,7 +1703,7 @@ was previously there. To load an existing envelope into the editor, you can
also type its name in the text field; to give a name to
the envelope as it is currently defined in the
graph viewer, type its name in this field, then
-either push return or the 'save' button.
+either hit return or the 'define it' button.
</p>
<p>Once you have an envelope in the
@@ -1754,10 +1750,11 @@ improve the fit. In this case, the X axis goes from 0 Hz to half the sampling r
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="editheader">Edit, add, or remove the header</a></h4></td></tr></table>
-<img src="pix/editheader.png" alt="edit header dialog" align=right>
+<div class="innerheader" id="editheader">Edit, add, or remove the header</div>
+
+<img class="indented" src="pix/editheader.png" alt="edit header dialog">
+
<p>The Edit menu's Edit Header option starts a dialog to edit, add, or
remove the sound's header. No change is made to the actual sound
data; the new header is blindly written out; any unsaved edits are
@@ -1770,19 +1767,24 @@ resultant header will be syntactically correct.
After writing the new header, you should either close or update the
associated sound.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="savedstate">Save session</a></h4></td></tr></table>
+
+
+
+
+<div class="innerheader" id="savedstate">Save session</div>
<p>At any time you can save the current
-state of Snd by calling <code>(save-state name)</code> where <i>name</i>
+state of Snd by calling <code>(save-state name)</code> where name
is a file name. You can restart the saved session by calling Snd
with this file name and the "-l" switch: snd -l name.
This file is in exactly the same format as the <a href="grfsnd.html#sndinitfile">initialization file</a>, and can be edited, renamed, or
whatever. To load such a file after startup, <code>(load name)</code>.
</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="centeryaxis">Center a tiny signal with DC</a></h4></td></tr></table>
+
+
+
+<div class="innerheader" id="centeryaxis">Center a tiny signal with DC</div>
<p>Due to the quantized nature of the y-axis position scroller, a tiny
signal that is not centered on 0 can be a pain to position in the
@@ -1790,20 +1792,22 @@ window. Use the <a href="extsnd.html#ybounds">y-bounds</a> function to set the
small number, then use the position scroller to find the signal.
For example, if your signal is a very soft recording setting only the lowest two bits
of a 16 bit signal but with DC offset due to the recording conditions,
-M-x (set! (<a class=quiet href="extsnd.html#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a>) '(-.01 .01)) and try the scroller.</p>
+<code>(set! (<a class=quiet href="extsnd.html#ybounds">y-bounds</a>) '(-.01 .01))</code>
+and try the scroller.</p>
-<br>
-<table width="50%" border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4><A NAME="misccommands">Miscellaneous commands</a></h4></td></tr></table>
-<p><A NAME="kgc"></a>C-g at any point aborts the current keyboard command
+
+<div class="innerheader" id="misccommands">Miscellaneous commands</div>
+
+<p>C-g at any point aborts the current keyboard command
sequence, as does any mouse click. C-g can also interrupt most long
computations (search, eval expression, and the various envelope applications).
If you notice one that is not interruptible, send me a note — I probably just
forgot about it.
</p>
-<p><A NAME="kcu"></a>C-u introduces a numeric argument. Besides the integer and
+<p>C-u introduces a numeric argument. Besides the integer and
float cases mentioned several times above, you can also
use marks to set the argument. If the (optional) number
after C-u is followed by C-m, the resultant number passed
@@ -1815,17 +1819,9 @@ same as C-j.</p>
by a numeric argument or aborted with C-g. C-x halts any
on-going region definition.</p>
-<p><A NAME="ktempdir"></a>C-x d prompts for the temporary directory name. Snd
-saves some editing operations in temporary files, rather
-than in-core buffers. If the temporary directory has
-been set (in various ways), it is used; otherwise
-Snd looks for the TMPDIR environment variable; if it
-is not found, or is null, the directory /var/tmp is
-used.</p>
-
<p>C-x C-c closes the control panel.
-<A NAME="cxco"></a>C-x C-o opens the
-panel.</p>
+C-x C-o opens the panel.
+</p>
<p>To change a key binding, use <a href="extsnd.html#bindkey">bind-key</a>.</p>
@@ -1837,44 +1833,45 @@ the selection, carriage-return accepts the current selection, mouse click on any
any other character removes the list.
</p>
-<br>
+
+
<!-- INDEX controls:Control Panel -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="controls">The Control Panel</a></h2></td></tr></table>
-</td></tr></table>
+
+<div class="header" id="controls">The control panel</div>
<p>The control panel is the portion of each sound's pane
beneath the channel graphs.
</p>
-<img src="pix/controls.png" alt="picture of Snd control panel" hspace=20 usemap="#controlsmap" border=0>
+<img class="indented" src="pix/controls.png" alt="picture of Snd control panel" usemap="#controlsmap">
+
<map name="controlsmap">
- <area shape=rect coords="0,0,25,25" onmouseout="UnTip()" onmouseover="Tip('This is Snd's icon!')">
- <area shape=rect coords="650,60,820,95" onmouseout="UnTip()" onmouseover="Tip('See with-inset-graph')">
-
- <area shape=rect coords="0,295,820,310" onmouseout="UnTip()" onmouseover="Tip('amplitude control')">
- <area shape=rect coords="0,311,800,325" onmouseout="UnTip()" onmouseover="Tip('speed (sampling rate) control')">
- <area shape=rect coords="801,311,820,325" onmouseout="UnTip()" onmouseover="Tip('resampling direction (click the arrow to change direction)')">
- <area shape=rect coords="0,326,800,345" onmouseout="UnTip()" onmouseover="Tip('expansion control (tempo change); uses granular synthesis')">
- <area shape=rect coords="801,326,820,345" onmouseout="UnTip()" onmouseover="Tip('this button turns on/off the expansion effect')">
- <area shape=rect coords="0,346,800,365" onmouseout="UnTip()" onmouseover="Tip('contrast enhancement; this can make loud portions more intense')">
- <area shape=rect coords="801,346,820,365" onmouseout="UnTip()" onmouseover="Tip('this button turns on/off the contrast enhancement effect')">
- <area shape=rect coords="0,366,499,380" onmouseout="UnTip()" onmouseover="Tip('reverb amount')">
- <area shape=rect coords="500,366,800,380" onmouseout="UnTip()" onmouseover="Tip('reverb length')">
- <area shape=rect coords="801,366,820,380" onmouseout="UnTip()" onmouseover="Tip('this button turns on/off the reverberator')">
- <area shape=rect coords="80,381,130,400" onmouseout="UnTip()" onmouseover="Tip('filter order')">
- <area shape=rect coords="131,381,710,400" onmouseout="UnTip()" onmouseover="Tip('filter frequency response envelope; 1.0 = srate/2')">
- <area shape=rect coords="711,381,760,400" onmouseout="UnTip()" onmouseover="Tip('filter graph y-axis displayed in dB or linear')">
- <area shape=rect coords="761,381,800,400" onmouseout="UnTip()" onmouseover="Tip('filter graph x-axis displayed in Hz or 0..1')">
- <area shape=rect coords="801,381,820,400" onmouseout="UnTip()" onmouseover="Tip('this button turns on/off the filter')">
- <area shape=rect coords="0,401,820,525" onmouseout="UnTip()" onmouseover="Tip('this graph shows the desired frequency response,<br>and the actual one given the current filter order')">
+ <area shape=rect coords="0,0,25,25">
+ <area shape=rect coords="650,60,820,95">
+
+ <area shape=rect coords="0,295,820,310">
+ <area shape=rect coords="0,311,800,325">
+ <area shape=rect coords="801,311,820,325">
+ <area shape=rect coords="0,326,800,345">
+ <area shape=rect coords="801,326,820,345">
+ <area shape=rect coords="0,346,800,365">
+ <area shape=rect coords="801,346,820,365">
+ <area shape=rect coords="0,366,499,380">
+ <area shape=rect coords="500,366,800,380">
+ <area shape=rect coords="801,366,820,380">
+ <area shape=rect coords="80,381,130,400">
+ <area shape=rect coords="131,381,710,400">
+ <area shape=rect coords="711,381,760,400">
+ <area shape=rect coords="761,381,800,400">
+ <area shape=rect coords="801,381,820,400">
+ <area shape=rect coords="0,401,820,525">
</map>
<p>The controls are: amp, speed, expand, contrast,
reverb, and filter.</p>
-<p><A NAME="speed"></a>'Speed' here refers to the rate at which the
+<p id="speed">'Speed' here refers to the rate at which the
sound data is consumed during playback.
Another term might be 'srate'.
The arrow button on the right determines
@@ -1883,7 +1880,7 @@ The scroll bar position is normally interpreted
as a float between .05 and 20.
</p>
-<p><A NAME="expand"></a>'Expand' refers to granular
+<p id="expand">'Expand' refers to granular
synthesis used to change the tempo of events
in the sound without changing pitch. Successive
short slices of the file are overlapped with
@@ -1901,7 +1898,7 @@ button is set.
</p>
-<p><A NAME="reverb"></a>The reverberator is a version of Michael
+<p id="reverb">The reverberator is a version of Michael
McNabb's Nrev. In addition to the controls
in the control pane, you can set the reverb
<a href="extsnd.html#reverbcontrolfeedback">feedback</a> gain and the coefficient of the <a href="extsnd.html#reverbcontrollowpass">lowpass</a>
@@ -1911,10 +1908,9 @@ if the reverb button is set. The reverb length
field takes effect only when the reverb is
set up (when the DAC is started by clicking
'play' when nothing else is being played).
-
</p>
-<p><A NAME="contrast"></a>'Contrast enhancement' is my name for a
+<p id="contrast">'Contrast enhancement' is my name for a
somewhat weird waveshaper or compander. It
phase-modulates a sound, which can in some
cases make it sound sharper or brighter.
@@ -1928,7 +1924,7 @@ contrast-control-amp. Contrast is on only if the contrast
button is set.
</p>
-<p>The <A NAME="filtercontrol"></a>filter is an arbitrary (even) order FIR filter
+<p id="filtercontrol">The filter is an arbitrary (even) order FIR filter
specified by giving the frequency response
envelope
and filter order in the text windows provided.
@@ -1943,8 +1939,8 @@ returning in this case a list of breakpoints; you can
define a function that returns the list you want, then call that function
in the text field.
The filter is on only if the filter button is set.
-
</p>
+
<p>There are many variables that reflect or control
the panel's various sliders; each also has a default
value. The reverb and expand functions also have
@@ -1966,33 +1962,32 @@ edited version).
<p>The keyboard commands associated with the control
panel are:</p>
-<pre>
- C-x C-o show ("open") control panel
- C-x C-c hide ("close") control panel
+
+<pre class="indented">
+C-x C-o show ("open") control panel
+C-x C-c hide ("close") control panel
</pre>
-<br>
-<h2>Customization and Extension</h2>
+
+
+
+<div class="header">Customization and extension</div>
<p>For information on the extension language functions, see <a href="extsnd.html#extsndcontents">extsnd.html</a>.
For information on initialization, configuration, and connections to other programs, see <a href="grfsnd.html#grfsndcontents">grfsnd.html</a>.
</p>
-<br>
-
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
+<div class="related">
+related documentation:
+<a href="extsnd.html">extsnd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="fm.html">fm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
+
</body></html>
diff --git a/snd1.html b/snd1.html
deleted file mode 100644
index d07f716..0000000
--- a/snd1.html
+++ /dev/null
@@ -1,9 +0,0 @@
-<html>
-<head>
-<title>Snd</title>
-</head>
-<frameset cols="20%,*">
-<frame src="snd-contents.html" name="toc">
-<frame src="snd.html" name="snd1">
-</frameset>
-</html>
diff --git a/snd10.scm b/snd10.scm
deleted file mode 100644
index 0317fca..0000000
--- a/snd10.scm
+++ /dev/null
@@ -1,105 +0,0 @@
-;;; backwards compatibility for snd 10
-
-(provide 'snd-snd10.scm)
-
-(define sine-summation nrxysin)
-(define sine-summation? nrxysin?)
-
-(define sum-of-sines nsin)
-(define sum-of-sines? nsin?)
-
-(define sum-of-cosines ncos)
-(define sum-of-cosines? ncos?)
-
-(define* (make-sum-of-sines (sines 1) (frequency 0.0) (initial-phase 0.0))
- (let ((gen (make-nsin :frequency frequency :n sines)))
- (set! (mus-phase gen) initial-phase)
- gen))
-
-(define* (make-sum-of-cosines (cosines 1) (frequency 0.0) (initial-phase 0.0))
- (let ((gen (make-ncos :frequency frequency :n cosines)))
- (set! (mus-phase gen) initial-phase)
- gen))
-
-(define* (make-sine-summation (frequency 0.0) (initial-phase 0.0) (n 1) (a 0.5) (ratio 1.0))
- (let ((gen (make-nrxysin :frequency frequency :ratio ratio :n n :r a)))
- (set! (mus-phase gen) initial-phase)
- gen))
-
-
-(define (keypad-spectro-bindings)
- "establish the old spectro-* keypad bindings"
-
- (bind-key "KP_Page_Down" 0
- (lambda ()
- "move spectrum end down by about 5%"
- (set! (spectrum-end) (* (spectrum-end) 0.95))))
-
- (bind-key "KP_Page_Up" 0
- (lambda ()
- "move spectrum end up by about 5%"
- (set! (spectrum-end) (min 1.0 (/ (spectrum-end) 0.95)))))
-
- (bind-key "KP_Up" 0
- (lambda ()
- "increase spectro-z-scale by 0.01"
- (set! (spectro-z-scale) (+ (spectro-z-scale) 0.01))))
-
- (bind-key "KP_Down" 0
- (lambda ()
- "decrease spectro-z-scale by 0.01"
- (set! (spectro-z-scale) (max 0.0 (- (spectro-z-scale) 0.01)))))
-
- (bind-key "KP_Left" 0
- (lambda ()
- "decrease spectro-z-angle by 1.0"
- (set! (spectro-z-angle) (max 0.0 (- (spectro-z-angle) 1.0)))))
-
- (bind-key "KP_Right" 0
- (lambda ()
- "increase spectro-z-angle by 1.0"
- (set! (spectro-z-angle) (min 359.0 (+ (spectro-z-angle) 1.0)))))
-
- (bind-key "KP_Up" 4
- (lambda ()
- "increase spectro-x-angle by 1.0"
- (set! (spectro-x-angle) (min 359.0 (+ (spectro-x-angle) 1.0)))))
-
- (bind-key "KP_Down" 4
- (lambda ()
- "decrease spectro-x-angle by 1.0"
- (set! (spectro-x-angle) (max 0.0 (- (spectro-x-angle) 1.0)))))
-
- (bind-key "KP_Left" 4
- (lambda ()
- "decrease spectro-y-angle by 1.0"
- (set! (spectro-y-angle) (max 0.0 (- (spectro-y-angle) 1.0)))))
-
- (bind-key "KP_Right" 4
- (lambda ()
- "increase spectro-y-angle by 1.0"
- (set! (spectro-y-angle) (min 359.0 (+ (spectro-y-angle) 1.0)))))
- )
-
-
-(if (not (defined? 'in-hz)) (define in-hz hz->radians))
-
-;;; all sample-reader -> sampler
-
-(define copy-sample-reader copy-sampler)
-(define free-sample-reader free-sampler)
-(define make-mix-sample-reader make-mix-sampler)
-(define make-region-sample-reader make-region-sampler)
-(define make-sample-reader make-sampler)
-(define mix-sample-reader? mix-sampler?)
-(define region-sample-reader? region-sampler?)
-(define sample-reader-at-end? sampler-at-end?)
-(define sample-reader-home sampler-home)
-(define sample-reader? sampler?)
-(define sample-reader-position sampler-position)
-
-(define show-backtrace
- (make-procedure-with-setter
- (lambda () #t)
- (lambda (va) #t)))
-
diff --git a/snd11.scm b/snd11.scm
deleted file mode 100644
index c723c68..0000000
--- a/snd11.scm
+++ /dev/null
@@ -1,715 +0,0 @@
-;;; backwards compatibility for snd 11
-
-;;; -------- with-mix --------
-;;;
-;;; weird syntax = with-mix (with-sound-args) file-name start-in-output &body body
-;;;
-;;; (with-sound ()
-;;; (with-mix () "section-1" 0 (fm-violin 0 1 440 .1)
-;;; (fm-violin 1 2 660 .1))
-;;; ...)
-
-(define (with-mix-find-file-with-extensions file extensions)
- "(with-mix-find-file-with-extensions file extensions) helps the with-mix macro find checkpoint files"
- (if (file-exists? file)
- file
- (call-with-exit
- (lambda (found-one)
- (for-each
- (lambda (ext)
- (let ((new-file (string-append file "." ext)))
- (if (file-exists? new-file)
- (found-one new-file))))
- extensions)
- #f))))
-
-(define (with-mix-file-extension file default)
- "(with-mix-file-extension file default) is a helper function for the with-mix macro"
- (let ((len (string-length file)))
- (call-with-exit
- (lambda (ok)
- (do ((i (- len 1) (- i 1)))
- ((= i 0))
- (if (char=? (string-ref file i) #\.)
- (ok (substring file (+ 1 i) len))))
- default))))
-
-(defmacro with-mix (options ur-chkpt-file ur-beg . body)
- `(let ((chkpt-file ,ur-chkpt-file)
- (beg-1 ,ur-beg))
- (if (not (list? ',options))
- (throw 'with-sound-interrupt (format #f "with-mix options list (arg 1) is ~A?~%;" ',options))
- (if (not (string? chkpt-file))
- (throw 'with-sound-interrupt (format #f "with-mix file (arg 2) is ~A?~%;" ,ur-chkpt-file))
- (if (not (number? beg-1))
- (throw 'with-sound-interrupt (format #f "with-mix begin time (arg 3) for ~S = ~A?~%;" chkpt-file beg-1))
- (let ((beg (round (* (mus-srate) beg-1))))
- (if (null? ',body)
- (mus-mix *output* chkpt-file beg)
- (let* ((call-str (object->string ',body))
- (option-str (object->string ',options))
- (sndf (with-mix-find-file-with-extensions chkpt-file (list (with-mix-file-extension *clm-file-name* "snd") "snd")))
- (revf (and sndf *reverb* (with-mix-find-file-with-extensions chkpt-file (list "rev"))))
- (mix-values (and sndf
- (or (not *reverb*)
- revf)
- (let ((comment (mus-sound-comment sndf)))
- (and (string? comment)
- (catch #t
- (lambda ()
- (eval-string comment))
- (lambda args #f))))))) ; any error means we lost
- (if (and sndf
- (or (not *reverb*)
- revf)
- (list? mix-values)
- (= (length mix-values) 2)
- (string? (car mix-values))
- (string? (cadr mix-values))
- (string=? (car mix-values) option-str)
- (string=? (cadr mix-values) call-str))
- (begin
- (if *clm-verbose* (snd-print (format #f "mix ~S at ~,3F~%" sndf beg)))
- (mus-mix *output* sndf beg)
- (if revf (mus-mix *reverb* revf beg)))
- ;; else recompute
- (let ((old-to-snd *to-snd*))
- (set! *to-snd* #f)
- (if *clm-verbose* (snd-print (format #f "remake ~S at ~,3F~%" chkpt-file beg)))
- (let ((new-sound
- (apply with-sound-helper
- (lambda () , at body)
- (append (list :output
- (string-append chkpt-file "." (with-mix-file-extension *clm-file-name* "snd")))
- (list :comment
- (format #f "(begin~%;; written ~A (Snd: ~A)~%(list ~S ~S))~%"
- (strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time)))
- (snd-version)
- option-str
- call-str))
- (if (and (> (channels *output*) 1)
- (not (member :channels ',options)))
- (list :channels (channels *output*))
- '())
- ',options))))
- (set! *to-snd* old-to-snd)
- (mus-mix *output* new-sound beg)
- (if revf (mus-mix *reverb* revf beg)))))))))))))
-
-
-#|
-;;; this is the with-mix documentation:
-
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>with-mix</h4></td></tr></table>
-</td></tr></table>
-
-<p><a name="with-mix">with-mix</a> is a "checkpointing" version of with-sound, more useful in the bad old days when computers
-were incredibly slow, but lingering on...
-It is a macro, callable within <a href="#wsdoc">with-sound</a> or <a href="#clmload">clm-load</a>,
-which saves the computation in its body in a separate file, and
-then upon a subsequent recomputation, tries to tell (via a string comparison) when that file's data is up to date
-and does not need to be recomputed.
-</p>
-
-<table border=0 hspace=40 cellpadding=8 cellspacing=3><tr><td>
-<pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (fm-violin 0 .1 440 .1)
- (<em class=red>with-mix</em> () "sec1" .5
- (fm-violin 0 .1 550 .1)
- (fm-violin .1 .1 660 .1))
- (<em class=red>with-mix</em> (:reverb jc-reverb) "sec2" 1.0
- (fm-violin 0 .1 880 .1 :reverb-amount .2)
- (fm-violin .1 .1 1320 .1 :reverb-amount .2))
- (fm-violin 2 .1 220 .1)
- (<em class=red>mix</em> "/zap/slow.snd"))
-</pre>
-</td></tr></table>
-
-<p>Now, if we change just the first note in the with-mix call, the
-second with-mix section will not be recomputed, but will be mixed in from the
-saved file "sec2.snd".
-In the old days, when notes took hours to compute, this was a big deal,
-but not anymore.
-</p>
-
-
-;;; and these are the regression tests
-
- (define (check-with-mix num dur total-dur amp opts calls old-date chkmx)
- (let ((ind (find-sound "test.snd")))
- (if (not (sound? ind)) (snd-display #__line__ ";with-mix (~A) init: no test.snd?" num))
- (if (and chkmx (fneq (maxamp ind) amp)) (snd-display #__line__ ";with-mix (~A) maxamp: ~A (~A)" num (maxamp ind) amp))
- (if (not (file-exists? "with-mix.snd")) (snd-display #__line__ ";with-mix (~A) output doesn't exist" num))
- (let ((mx (mus-sound-maxamp "with-mix.snd"))
- (date (mus-sound-write-date "with-mix.snd"))
- (duration (mus-sound-duration "with-mix.snd")))
- (if (fneq duration dur) (snd-display #__line__ ";with-mix (~A) dur: ~A ~A" num dur duration))
- (if (fneq total-dur (/ (frames ind) (srate ind)))
- (snd-display #__line__ ";with-mix (~A) total dur: ~A ~A" num total-dur (/ (frames ind) (srate ind))))
- (if (and old-date
- (> (- date old-date) 1)) ; these can be off by some amount in Linux
- (snd-display #__line__ ";with-mix (~A) rewrote output?: ~A ~A ~A" num (- date old-date)
- (strftime "%d-%b-%g %H:%M:%S" (localtime old-date))
- (strftime "%d-%b-%g %H:%M:%S" (localtime date))))
- (if (and chkmx (or (not mx) (fneq (cadr mx) amp))) (snd-display #__line__ ";with-mix sndf (~A) maxamp: ~A (~A)" num mx amp))
- (let ((header-str (mus-sound-comment "with-mix.snd")))
- (if (not (string? header-str)) (snd-display #__line__ ";with-mix (~A) comment unwritten?: ~A" num (mus-sound-comment "with-mix.snd")))
- (let ((header (eval-string header-str)))
- (if (not (list? header)) (snd-display #__line__ ";with-mix (~A) comment: ~A -> ~A" num header-str header))
- (if (or (not (string=? (car header) opts))
- (not (string=? (cadr header) calls)))
- (snd-display #__line__ ";with-mix (~A) header values: ~A" num header))))
- (close-sound ind)
- date)))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound () (with-mix () "with-mix" 0 (fm-violin 0 .1 440 .1)))
- (let ((old-date (check-with-mix 1 .1 .1 .1 "()" "((fm-violin 0 0.1 440 0.1))" #f #t)))
- (with-sound () (with-mix () "with-mix" 0 (fm-violin 0 .1 440 .1)))
- (check-with-mix 1 .1 .1 .1 "()" "((fm-violin 0 0.1 440 0.1))" old-date #t))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1)))
- (let ((old-date (check-with-mix 2 .1 .2 .1 "()" "((fm-violin 0 0.1 440 0.1))" #f #t)))
- (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1)))
- (check-with-mix 2 .1 .2 .1 "()" "((fm-violin 0 0.1 440 0.1))" old-date #t))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1) (fm-violin .1 .1 660 .2)))
- (let ((old-date (check-with-mix 3 .2 .3 .2 "()" "((fm-violin 0 0.1 440 0.1) (fm-violin 0.1 0.1 660 0.2))" #f #t)))
- (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1) (fm-violin .1 .1 660 .2)))
- (check-with-mix 3 .2 .3 .2 "()" "((fm-violin 0 0.1 440 0.1) (fm-violin 0.1 0.1 660 0.2))" old-date #t))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound ()
- (with-mix () "with-mix" 0
- (sound-let ((tmp () (fm-violin 0 1 440 .1))) (mus-mix *output* tmp 0))))
- (let ((old-date (check-with-mix 4 1 1 .1 "()" "((sound-let ((tmp () (fm-violin 0 1 440 0.1))) (mus-mix *output* tmp 0)))" #f #t)))
- (with-sound ()
- (with-mix () "with-mix" 0
- (sound-let ((tmp () (fm-violin 0 1 440 .1))) (mus-mix *output* tmp 0))))
- (check-with-mix 4 1 1 .1 "()" "((sound-let ((tmp () (fm-violin 0 1 440 0.1))) (mus-mix *output* tmp 0)))" old-date #t))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound (:channels 2) (fm-violin 0 .1 440 .1 :degree 0) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3 :degree 90)))
- (let ((ind (find-sound "test.snd")))
- (if (or (fneq (maxamp ind 0) .1)
- (fneq (maxamp ind 1) .3))
- (snd-display #__line__ ";with-mix stereo: ~A" (maxamp ind #t)))
- (if (not (= (mus-sound-chans "with-mix.snd") 2)) (snd-display #__line__ ";with-mix stereo out: ~A" (mus-sound-chans "with-mix.snd"))))
- (let ((old-date (mus-sound-write-date "with-mix.snd")))
- (with-sound (:channels 2) (fm-violin 0 .1 440 .1 :degree 0) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3 :degree 90)))
- (if (not (= (mus-sound-write-date "with-mix.snd") old-date))
- (snd-display #__line__ ";stereo with-mix dates: ~A ~A" old-date (mus-sound-write-date "with-mix.snd"))))
- (let ((ind (find-sound "test.snd")))
- (close-sound ind))
-
- (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
- (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3)))
- (let ((old-date (check-with-mix 6 .1 1.1 .398 "()" "((fm-violin 0 0.1 550 0.3))" #f #f)))
- (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3)))
- (check-with-mix 6 .1 1.1 .398 "()" "((fm-violin 0 0.1 550 0.3))" old-date #f))
-
-|#
-
-;;; --------------------------------------------------------------------------------
-
-
-(define (focus-follows-mouse) (set! (with-pointer-focus) #t))
-(define (make-current-window-display) (set! (with-inset-graph) #t))
-(define load-from-path load)
-;(define def-optkey-fun define*)
-;(define def-optkey-instrument definstrument)
-
-(define spectro-cutoff spectrum-start)
-(define spectro-end spectrum-end)
-
-
-
-(define* (play-region reg wait stop-func)
- (play (if (integer? reg) (integer->region reg) reg) :wait wait :stop stop-func))
-
-(define* (play-selection wait stop-func)
- (play (selection) :wait wait :stop stop-func))
-
-(define* (play-mix id (beg 0))
- (play (if (integer? id) (integer->mix id) id) beg))
-
-(define* (play-and-wait (start 0) snd chn syncd end (pos -1) stop-proc)
- (if (string? start)
- (play start (or snd 0) :end (or chn -1) :wait #t)
- (play (if (integer? snd) (integer->sound snd)
- (if (sound? snd) snd
- (or (selected-sound) (car (sounds)))))
- :channel (or chn -1) :wait #t :with-sync syncd :start start :end (or end -1)
- :stop stop-proc :edit-position pos)))
-
-(define* (old-play (start 0) snd chn syncd end (pos -1) stop-proc (out-chan -1))
- (play (if (integer? snd) (integer->sound snd)
- (if (sound? snd) snd
- (or (selected-sound) (car (sounds)))))
- :channel (or chn -1) :with-sync syncd :start start :end (or end -1)
- :stop stop-proc :out-channel out-chan :edit-position pos))
-
-(define* (play-channel (beg 0) dur snd chn (pos -1) stop-proc (out-chan -1))
- (play (if (integer? snd) (integer->sound snd)
- (if (sound? snd) snd
- (or (selected-sound) (car (sounds)))))
- :channel (or chn -1) :with-sync #f :start beg :end (if dur (+ beg dur) -1)
- :stop stop-proc :out-channel out-chan :edit-position pos))
-
-
-(define quit-button-color (make-procedure-with-setter (lambda () 'obsolete) (lambda (val) 'obsolete)))
-(define reset-button-color (make-procedure-with-setter (lambda () 'obsolete) (lambda (val) 'obsolete)))
-(define help-button-color (make-procedure-with-setter (lambda () 'obsolete) (lambda (val) 'obsolete)))
-(define do-it-button-color (make-procedure-with-setter (lambda () 'obsolete) (lambda (val) 'obsolete)))
-(define do-it-again-button-color (make-procedure-with-setter (lambda () 'obsolete) (lambda (val) 'obsolete)))
-(define pushed-button-button-color (make-procedure-with-setter (lambda () 'obsolete) (lambda (val) 'obsolete)))
-
-
-;;; --------------------------------------------------------------------------------
-
-(define (add-watcher func)
- (hook-push effects-hook func))
-
-(define (delete-watcher func)
- (hook-remove effects-hook func))
-
-
-#|
-;;; -------- reopen menu
-
-(define including-reopen-menu #f)
-
-(define (with-reopen-menu)
- (if (not including-reopen-menu)
- (let ((reopen-menu (add-to-main-menu "Reopen"))
- (reopen-names '()))
-
- (define (add-to-reopen-menu snd)
- (let ((brief-name (short-file-name snd))
- (long-name (file-name snd))
- (reopen-max-length 16)) ; sets max length of menu
- (if (not (member brief-name reopen-names))
- (begin
- (add-to-menu reopen-menu
- brief-name
- (lambda ()
- (remove-from-menu reopen-menu brief-name)
- (open-sound long-name))
- 0) ; add to top
- (set! reopen-names (append reopen-names (list brief-name)))
- (if (> (length reopen-names) reopen-max-length)
- (let ((goner (car reopen-names)))
- (set! reopen-names (cdr reopen-names))
- (remove-from-menu reopen-menu goner)))))))
-
- (define (check-reopen-menu filename)
- (define (just-filename name)
- (let ((last-slash -1)
- (len (string-length name)))
- (do ((i 0 (+ 1 i)))
- ((= i len) (substring name (+ 1 last-slash)))
- (if (char=? (string-ref name i) #\/)
- (set! last-slash i)))))
- (let ((brief-name (just-filename filename)))
- (if (member brief-name reopen-names)
- (set! reopen-names (remove-if (lambda (n)
- (let ((val (string=? n brief-name)))
- (if val (remove-from-menu reopen-menu brief-name))
- val))
- reopen-names))))
- #f)
-
- (set! including-reopen-menu #t)
- (hook-push close-hook add-to-reopen-menu)
- (hook-push open-hook check-reopen-menu))))
-
-
-
-
-;;; -------- hidden controls panel --------
-
-(define hidden-controls-dialog #f)
-(define hidden-controls '())
-
-(define hidden-controls-help
-"make-hidden-controls-dialog adds an item \"Hidden controls\" to the Option
-menu that creates a dialog that controls all the otherwise hidden control-panel variables.
-Expand-hop sets the time in seconds between successive grains.
-Expand-length sets the length of each grain.
-Expand-ramp sets the ramp-time in the grain envelope.
-Expand-jitter sets the grain timing jitter.
-Contrast-amp sets the prescaler for contrast-enhancement.
-Reverb-lowpass sets the feedback lowpass filter coeficient.
-Reverb-feedback sets the scaler on the feedback.
-")
-
-(define (make-hidden-controls-dialog)
- (if (provided? 'snd-motif)
- (begin
- (define (reset-all-sliders)
- (for-each
- (lambda (ctl)
- (set! ((caddr ctl) #t) (cadr ctl))
- (XtSetValues (car ctl)
- (list XmNvalue (floor (* (cadr ctl) 100)))))
- hidden-controls))
-
- (if (not (Widget? hidden-controls-dialog))
- (let ((xdismiss (XmStringCreate "Go Away" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "More Controls" XmFONTLIST_DEFAULT_TAG))
- (xreset (XmStringCreate "Reset" XmFONTLIST_DEFAULT_TAG)))
- (set! hidden-controls-dialog
- (XmCreateTemplateDialog (cadr (main-widgets)) "More Controls"
- (list XmNcancelLabelString xreset
- XmNokLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNtransient #f
- XmNbackground (basic-color))))
-
- (for-each
- (lambda (button color)
- (XtVaSetValues (XmMessageBoxGetChild hidden-controls-dialog button)
- (list XmNarmColor (selection-color)
- XmNbackground color)))
- (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON)
- (list (highlight-color) (highlight-color) (highlight-color)))
-
- (XtAddCallback hidden-controls-dialog
- XmNokCallback (lambda (w context info)
- (XtUnmanageChild hidden-controls-dialog)))
- (XtAddCallback hidden-controls-dialog
- XmNhelpCallback (lambda (w context info)
- (help-dialog "More Controls" hidden-controls-help)))
- (XtAddCallback hidden-controls-dialog
- XmNcancelCallback (lambda (w context info)
- (reset-all-sliders)))
- (XmStringFree xhelp)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (XmStringFree xreset)
-
- (let* ((mainform
- (XtCreateManagedWidget "formd" xmRowColumnWidgetClass hidden-controls-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild hidden-controls-dialog XmDIALOG_SEPARATOR)
- XmNorientation XmVERTICAL))))
- (for-each
- (lambda (lst)
- (let* ((name (car lst))
- (low (cadr lst))
- (high (caddr lst))
- (initial (list-ref lst 3))
- (func (list-ref lst 4))
- (title (XmStringCreate name XmFONTLIST_DEFAULT_TAG))
- (slider (XtCreateManagedWidget name xmScaleWidgetClass mainform
- (list XmNorientation XmHORIZONTAL
- XmNshowValue #t
- XmNminimum (floor (* low 1000))
- XmNmaximum (floor (* high 1000))
- XmNvalue (floor (* initial 1000))
- XmNdecimalPoints 3
- XmNtitleString title
- XmNborderWidth 1
- XmNbackground (basic-color)))))
- (XmStringFree title)
- (set! hidden-controls (cons (list slider initial func) hidden-controls))
- (XtAddCallback slider
- XmNvalueChangedCallback
- (lambda (w context info)
- (set! (func) (/ (.value info) 1000.0))))
- (XtAddCallback slider
- XmNdragCallback
- (lambda (w context info)
- (set! (func) (/ (.value info) 1000.0))))))
- (list (list "expand-hop" 0.001 0.3 0.05 expand-control-hop)
- (list "expand-length" 0.01 .5 0.15 expand-control-length)
- (list "expand-ramp" 0.01 .5 0.4 expand-control-ramp)
- (list "expand-jitter" 0.0 2.0 1.0 expand-control-jitter)
- (list "contrast-amp" 0.0 2.0 1.0 contrast-control-amp)
- (list "reverb-lowpass" 0.0 1.0 0.7 reverb-control-lowpass)
- (list "reverb-feedback" 0.0 1.25 1.09 reverb-control-feedback))))
- (add-to-menu 3 "Hidden controls"
- (lambda ()
- (if (not (XtIsManaged hidden-controls-dialog))
- (XtManageChild hidden-controls-dialog)
- (raise-dialog hidden-controls-dialog))))))
- ) ; motif case
- (begin
-
- (define (reset-all-sliders)
- (for-each
- (lambda (ctl)
- (set! ((caddr ctl)) (cadr ctl))
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car ctl)) (cadr ctl))
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car ctl)))
- )
- hidden-controls))
-
- (if (not hidden-controls-dialog)
- (let ((dismiss-button (gtk_button_new_with_label "Go Away"))
- (help-button (gtk_button_new_with_label "Help"))
- (reset-button (gtk_button_new_with_label "Reset")))
- (gtk_widget_set_name dismiss-button "quit_button")
- (gtk_widget_set_name help-button "help_button")
- (gtk_widget_set_name reset-button "reset_button")
- (set! hidden-controls-dialog (gtk_dialog_new))
- (gtk_window_set_title (GTK_WINDOW hidden-controls-dialog) "More Controls")
- (gtk_container_set_border_width (GTK_CONTAINER hidden-controls-dialog) 10)
- (gtk_window_set_default_size (GTK_WINDOW hidden-controls-dialog) -1 -1)
- (gtk_window_set_resizable (GTK_WINDOW hidden-controls-dialog) #t)
- (gtk_widget_realize hidden-controls-dialog)
- (g_signal_connect hidden-controls-dialog "delete_event" (lambda (w ev data) (gtk_widget_hide hidden-controls-dialog) #t) #f)
-
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG hidden-controls-dialog))) dismiss-button #t #t 20)
- (g_signal_connect dismiss-button "clicked" (lambda (w data) (gtk_widget_hide hidden-controls-dialog)) #f)
- (gtk_widget_show dismiss-button)
- (gtk_box_pack_start (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG hidden-controls-dialog))) reset-button #t #t 20)
- (g_signal_connect reset-button "clicked" (lambda (w data) (reset-all-sliders)) #f)
- (gtk_widget_show reset-button)
- (gtk_box_pack_end (GTK_BOX (gtk_dialog_get_action_area (GTK_DIALOG hidden-controls-dialog))) help-button #t #t 20)
- (g_signal_connect help-button "clicked" (lambda (w data) (help-dialog "More Controls" hidden-controls-help)) #f)
- (gtk_widget_show help-button)
-
- (let ((mainform (gtk_dialog_get_content_area (GTK_DIALOG hidden-controls-dialog))))
- (for-each
- (lambda (lst)
- (let* ((title (car lst))
- (low (cadr lst))
- (high (caddr lst))
- (initial (list-ref lst 3))
- (func (list-ref lst 4))
- (adj (gtk_adjustment_new initial low high .001 .001 .1))
- (slider (gtk_hscale_new (GTK_ADJUSTMENT adj)))
- (label (gtk_label_new title)))
- (if (not (provided? 'gtk3)) (gtk_range_set_update_policy (GTK_RANGE (GTK_SCALE slider)) GTK_UPDATE_CONTINUOUS))
- (gtk_scale_set_digits (GTK_SCALE slider) 3)
- (gtk_scale_set_value_pos (GTK_SCALE slider) GTK_POS_TOP)
- (gtk_scale_set_draw_value (GTK_SCALE slider) #t)
- (gtk_box_pack_start (GTK_BOX mainform) slider #t #t 4)
- (gtk_box_pack_start (GTK_BOX mainform) label #t #t 4)
- (set! hidden-controls (cons (list adj initial func) hidden-controls))
- (g_signal_connect adj "value_changed" (lambda (adj data) (set! (func) (gtk_adjustment_get_value (GTK_ADJUSTMENT adj)))) #f)
- (gtk_widget_show slider)
- (gtk_widget_show label)))
-
- (list (list "expand-hop" 0.001 0.3 0.05 expand-control-hop)
- (list "expand-length" 0.01 .5 0.15 expand-control-length)
- (list "expand-ramp" 0.01 .5 0.4 expand-control-ramp)
- (list "expand-jitter" 0.0 2.0 1.0 expand-control-jitter)
- (list "contrast-amp" 0.0 2.0 1.0 contrast-control-amp)
- (list "reverb-lowpass" 0.0 1.0 0.7 reverb-control-lowpass)
- (list "reverb-feedback" 0.0 1.25 1.09 reverb-control-feedback))))
-
- (add-to-menu 3 "Hidden controls"
- (lambda ()
- (gtk_widget_show hidden-controls-dialog)))
- )))
- ))
-|#
-
-;;; --------------------------------------------------------------------------------
-
-(define clear-selection unselect-all)
-
-
-
-#|
-;;; --------------------------------------------------------------------------------
-;;; this is now built-in
-
-(define remembering-sound-state 0) ; for prefs
-(define remember-sound-filename ".snd-remember-sound") ; should this be in the home directory?
-
-(define* (remember-sound-state (choice 3))
- "(remember-sound-state) remembers the state of a sound when it is closed, and if it is subsquently re-opened, restores that state"
-
- (let ((states '())
- (sound-funcs (list sync with-tracking-cursor selected-channel show-controls read-only
- contrast-control? expand-control? reverb-control? filter-control?
- amp-control amp-control-bounds
- contrast-control contrast-control-amp contrast-control-bounds
- expand-control expand-control-bounds expand-control-hop expand-control-jitter expand-control-length expand-control-ramp
- filter-control-envelope filter-control-in-dB filter-control-in-hz filter-control-order
- reverb-control-decay reverb-control-feedback reverb-control-length reverb-control-length-bounds
- reverb-control-lowpass reverb-control-scale reverb-control-scale-bounds
- speed-control speed-control-bounds speed-control-style speed-control-tones))
-
- (channel-funcs (list time-graph? transform-graph? lisp-graph? x-bounds y-bounds cursor cursor-size
- cursor-style show-marks show-y-zero show-grid wavo-hop wavo-trace max-transform-peaks
- show-transform-peaks fft-log-frequency fft-log-magnitude with-verbose-cursor zero-pad
- wavelet-type min-dB transform-size transform-graph-type time-graph-type fft-window
- transform-type transform-normalization time-graph-style show-mix-waveforms dot-size
- x-axis-style show-axes graphs-horizontal lisp-graph-style transform-graph-style
- grid-density tracking-cursor-style
- )))
-
- (define (print-readably fd field depth first)
- (if (not first) (format fd " "))
- (if (string? field)
- (if (= (string-length (format #f "~S" "1")) 3)
- (format fd "~S" field)
- (format fd "\"~S\"" field)) ; sometimes format omits the double quotes!
- (if (number? field)
- (if (rational? field) ; get these out of our way before float stuff
- (format fd "~A" field)
- (format fd "~,4F" field))
- (if (procedure? field)
- (format fd "~A" (procedure-source field))
- (if (list? field)
- (begin
- (if (or (= depth 1)
- (> (length field) 12))
- (begin
- (format fd "~%")
- (do ((i 0 (+ 1 i)))
- ((= i depth))
- (format fd " "))))
- (format fd "(")
- (let ((fst #t))
- (for-each
- (lambda (val)
- (print-readably fd val (+ 1 depth) fst)
- (set! fst #f))
- field))
- (format fd ")"))
- (format fd "~A" field))))))
-
- (define (find-if pred l)
- "(find-if func lst) scans 'lst' for any element that 'func' likes"
- (cond ((null? l) #f)
- ((pred (car l)) (car l))
- (else (find-if pred (cdr l)))))
-
- (define saved-state
- (make-procedure-with-setter
- (lambda (snd)
- (find-if (lambda (n)
- (string=? (car n) (file-name snd)))
- states))
- (lambda (snd new-state)
- (set! states (cons new-state
- (remove-if
- (lambda (n)
- (string=? (car n) (file-name snd)))
- states))))))
-
- (define (remember-sound-at-close snd)
- ;; save current state in list (name write-date (snd props) (chan props))
- (set! (saved-state snd)
- (list (file-name snd)
- (file-write-date (file-name snd))
- (map (lambda (f)
- (f snd))
- sound-funcs)
- (map (lambda (sc)
- (map (lambda (f)
- (if (equal? f transform-type)
- (transform->integer (f (car sc) (cadr sc)))
- (f (car sc) (cadr sc))))
- channel-funcs))
- (let ((scs '()))
- (do ((i 0 (+ 1 i)))
- ((= i (channels snd)))
- (set! scs (cons (list snd i) scs)))
- (reverse scs)))))
- #f)
-
- (define (remember-sound-at-open snd)
- ;; restore previous state, if any
- (let ((state (saved-state snd))) ; removes old state from current list
- (if (and state
- (= (file-write-date (file-name snd)) (cadr state))
- (= (channels snd) (length (cadddr state)))
- (not (= choice 2)))
- ;; we need the chans check because auto-test files seem to have confused write dates
- (begin
- (for-each (lambda (f val)
- (set! (f snd) val))
- sound-funcs
- (caddr state))
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels snd)))
- (dynamic-wind
- (lambda () (set! (squelch-update snd chn) #t))
- (lambda ()
- (for-each (lambda (f val)
- (if (and (list? val)
- (not (null? val))
- (eq? (car val) 'lambda))
- (set! (f snd chn) (eval val (current-environment)))
- (if (equal? f transform-type)
- (set! (f snd chn) (integer->transform val))
- (set! (f snd chn) val))))
- channel-funcs
- (list-ref (cadddr state) chn)))
- (lambda () (set! (squelch-update snd chn) #f)))
- (if (time-graph? snd chn) (update-time-graph snd chn))
- (if (transform-graph? snd chn) (update-transform-graph snd chn)))))))
-
- (define (remember-sound-at-start filename)
- (if (and (null? states)
- (file-exists? remember-sound-filename))
- (begin
- (load remember-sound-filename)
- (set! states -saved-remember-sound-states-states-)))
- #f)
-
- (define (remember-sound-at-exit)
- (if (not (null? states))
- (call-with-output-file remember-sound-filename
- (lambda (fd)
- (format fd "~%~%;;; from remember-sound-state in extensions.scm~%")
- (format fd "(define -saved-remember-sound-states-states-~% '")
- (print-readably fd states 0 #t)
- (format fd ")~%"))))
- #f)
-
- (if (or (= choice 0) ; no remembering
- (= choice 1)) ; just within-run remembering
- (begin
- (if (= choice 0)
- (begin
- (hook-remove close-hook remember-sound-at-close)
- (hook-remove after-open-hook remember-sound-at-open)))
- (hook-remove open-hook remember-sound-at-start)
- (hook-remove before-exit-hook remember-sound-at-exit)
- (if (file-exists? remember-sound-filename)
- (delete-file remember-sound-filename))))
-
- (if (not (= choice 0))
- (begin
- (hook-push close-hook remember-sound-at-close)
- (hook-push after-open-hook remember-sound-at-open)
- (if (not (= choice 1))
- (begin
- (hook-push open-hook remember-sound-at-start)
- (hook-push before-exit-hook remember-sound-at-exit)))))
-
- (set! remembering-sound-state choice)
- 'remembering!))
-|#
-
-
-;;; -------- clear-selection
-
-(define clear-selection unselect-all)
-
-
-(define cursor-follows-play (make-procedure-with-setter
- (lambda (snd)
- (with-tracking-cursor))
- (lambda (snd val)
- (set! (with-tracking-cursor) val))))
diff --git a/snd13.scm b/snd13.scm
new file mode 100644
index 0000000..2be528b
--- /dev/null
+++ b/snd13.scm
@@ -0,0 +1,1136 @@
+(provide 'snd-snd13.scm)
+
+(define (clm-print . args)
+ "(clm-print . args) applies format to args and prints the result"
+ (snd-print (apply format #f args)))
+
+#|
+;;; this is now moved to C
+;;; -------- envelope-interp
+
+(define* (envelope-interp x e (base 1.0)) ;e is list of x y breakpoint pairs, interpolate at x returning y
+;; "(envelope-interp x e (base 1.0)) -> value of e at x; base controls connecting segment type: (envelope-interp .3 '(0 0 .5 1 1 0) -> .6"
+ (cond ((null? e) 0.0) ;no data -- return 0.0
+ ((or (<= x (car e)) ;we're sitting on x val (or if < we blew it)
+ (null? (cddr e))) ;or we're at the end of the list
+ (cadr e)) ;so return current y value
+ ((> (caddr e) x) ;x <= next env x axis value
+ (if (or (= (cadr e) (cadddr e))
+ (= base 0.0))
+ (cadr e) ;y1=y0, so just return y0 (avoid endless calculations below)
+ (if (= base 1.0)
+ (+ (cadr e) ;y0+(x-x0)*(y1-y0)/(x1-x0)
+ (* (- x (car e))
+ (/ (- (cadddr e) (cadr e))
+ (- (caddr e) (car e)))))
+ (+ (cadr e) ; this does not exactly match xramp-channel
+ (* (/ (- (cadddr e) (cadr e))
+ (- base 1.0))
+ (- (expt base (/ (- x (car e))
+ (- (caddr e) (car e))))
+ 1.0))))))
+ (else (envelope-interp x (cddr e) base)))) ;go on looking for x segment
+|#
+
+
+#|
+
+;;; ---------------- waterfall spectrum ----------------
+;;; this is obsolete
+
+(define waterfall
+ (let* ((drawer #f)
+ (input-port #f)
+ (input-proc 0)
+ (gl-list #f)
+ (slices 256) ; number of traces displayed
+ (slice 0)
+ (data (make-vector slices))
+ (bins 512) ; fft size
+ (input-data #f)
+ (scaler 1.0) ; data scaler before GL turns it into colors
+ (cutoff 0.2)) ; 0.5 is full spectrum
+
+ (define (redraw-graph)
+ (let ((win (XtWindow drawer))
+ (dpy (XtDisplay drawer))
+ (cx (snd-gl-context)))
+ (glXMakeCurrent dpy win cx)
+ (if gl-list (glDeleteLists gl-list 1))
+ (set! gl-list (glGenLists 1))
+ (glEnable GL_DEPTH_TEST)
+ (glShadeModel GL_SMOOTH)
+ (glClearDepth 1.0)
+ (glClearColor 1.0 1.0 1.0 1.0) ; todo: bg color here
+ (glClear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
+ ;;gl_spectrogram(Xen data, Xen gl_list, Xen cutoff, Xen use_dB, Xen min_dB, Xen scale, Xen br, Xen bg, Xen bb)
+ (glSpectrogram data gl-list cutoff #f -60.0 scaler 65535 65535 65535)
+ (let ((vals (XtVaGetValues drawer (list XmNwidth 0 XmNheight 0))))
+ (glViewport 0 0 (list-ref vals 1) (list-ref vals 3)))
+ (glMatrixMode GL_PROJECTION)
+ (glLoadIdentity)
+ (glRotatef (spectro-x-angle) 1.0 0.0 0.0)
+ (glRotatef (spectro-y-angle) 0.0 1.0 0.0)
+ (glRotatef (spectro-z-angle) 0.0 0.0 1.0)
+ (glScalef (spectro-x-scale) (spectro-y-scale) (spectro-z-scale))
+ (glCallList gl-list)
+ ;; todo: make axis
+ (glXSwapBuffers dpy win)
+ (glDrawBuffer GL_BACK)))
+
+ (define (tick-audio id)
+ ;; background process reads incoming audio data, creates spectrum, displays next trace
+ (mus-audio-read input-port input-data (* bins 2))
+ (let ((rl-data (copy (input-data 0) (data slice))))
+ (snd-spectrum rl-data blackman2-window bins #t 0.0 #t #f)
+ (redraw-graph))
+ (set! slice (+ 1 slice))
+ (if (>= slice slices)
+ (set! slice 0))
+ #f)
+
+ (define (stop-it)
+ ;; turn off the waterfall display
+ (if input-port
+ (begin
+ (mus-audio-close input-port)
+ (set! input-port #f)))
+ (if (XtWorkProcId? input-proc)
+ (begin
+ (XtRemoveWorkProc input-proc)
+ (set! input-proc 0)))
+ (do ((i 0 (+ 1 i)))
+ ((= i slices))
+ (float-vector-scale! (data i) 0.0)))
+
+ (define (start-it)
+ (define (add-main-pane name type args)
+ (XtCreateManagedWidget name type (list-ref (main-widgets) 3) args))
+ (if (not drawer)
+ (let ((outer (add-main-pane "Waterfall" xmFormWidgetClass
+ (list XmNbackground (basic-color)
+ XmNpaneMinimum 320))))
+ (set! drawer (XtCreateManagedWidget "draw" xmDrawingAreaWidgetClass outer
+ (list XmNbackground (graph-color)
+ XmNforeground (data-color)
+ XmNleftAttachment XmATTACH_FORM
+ XmNtopAttachment XmATTACH_FORM
+ XmNbottomAttachment XmATTACH_FORM
+ XmNrightAttachment XmATTACH_FORM)))
+ (XtAddCallback drawer XmNresizeCallback (lambda (w context info) (redraw-graph)))
+ (XtAddCallback drawer XmNexposeCallback (lambda (w context info) (redraw-graph)))
+ (hook-push orientation-hook (lambda (hook) (redraw-graph)))
+ (hook-push color-hook (lambda (hook) (redraw-graph)))))
+ ;; start the waterfall display
+ (if (not (or input-port (XtWorkProcId? input-proc)))
+ (begin
+ (set! input-port (mus-audio-open-input mus-audio-default 22050 1 mus-lshort 512))
+ (set! input-proc (XtAppAddWorkProc (car (main-widgets)) tick-audio)))))
+
+ ;; turn display with orientation dialog
+ ;; for example: x-angle 290, y angle: 60
+
+ (lambda* (start scl pc-spectrum fft-size)
+ (if start
+ (begin
+ (set! cutoff pc-spectrum)
+ (set! scaler scl)
+ (set! bins fft-size)
+ (set! input-data (make-float-vector (list 1 (* bins 2)) 0.0))
+ (do ((i 0 (+ 1 i)))
+ ((= i slices))
+ (set! (data i) (make-float-vector bins)))
+ (start-it))
+ (stop-it)))))
+
+
+(define* (start-waterfall (scl 1.0) (pc-spectrum 0.2) (fft-size 512))
+ "(start-waterfall (scl 1.0) (pc-spectrum 0.2) (fft-size 512)) starts a 'waterfall' spectrum display of the incoming audio data"
+ (waterfall #t scl pc-spectrum fft-size))
+
+(define (stop-waterfall)
+ "(stop-waterfall) stops a waterfall display"
+ (waterfall #f))
+
+|#
+
+
+
+#|
+;;; -------- "vector synthesis"
+;;; also obsolete
+;;; this idea (and the weird name) from linux-audio-development mailing list discussion
+;;; apparently some commercial synths (or software?) provide this
+
+(define (vector-synthesis driver files read-even-when-not-playing)
+
+ "(vector-synthesis driver files read-even-when-not-playing) uses 'driver', a
+function of two args (the number of files, and the number of samples between calls) to decide which file to play. If
+'read-even-when-not-playing' is #t (default is #f), the input files are constantly
+read, even if not playing. 'files' is a list of files to be played."
+
+ (let ((files-len (length files)))
+ (if (> files-len 0)
+ (let* ((bufsize 256)
+ (srate (srate (car files)))
+ (chans (apply max (map channels files)))
+ (data (make-float-vector (list chans bufsize) 0.0))
+ (readers (map make-file->frame files))
+ (locs (make-vector files-len 0))
+ (pframes (make-vector files-len 0))
+ (current-file 0)
+ (reading #t)
+ (out-port (mus-audio-open-output 0 srate chans mus-lshort (* bufsize 2))))
+ (if (< out-port 0)
+ (format #t "can't open audio port! ~A" out-port)
+ (begin
+ (do ((i 0 (+ i 1)))
+ ((= i files-len))
+ (set! (pframes i) (framples (files i))))
+ (catch #t
+ (lambda ()
+ (while reading
+ (let ((next-file (driver files-len bufsize)))
+ (if (not (= next-file current-file))
+ (let ((ramp-down 1.0)
+ (ramp (/ 1.0 bufsize))
+ (current (readers current-file))
+ (current-loc (locs current-file))
+ (next (readers next-file))
+ (next-loc (locs next-file))
+ (up (make-frame chans))
+ (down (make-frame chans)))
+ (do ((i 0 (+ i 1)))
+ ((= i bufsize))
+ (file->frame next (+ next-loc i) up)
+ (file->frame current (+ current-loc i) down)
+ (do ((j 0 (+ 1 j)))
+ ((= j chans))
+ (vector-set! data j i
+ (+ (* ramp-down (frame-ref down j))
+ (* (- 1.0 ramp-down) (frame-ref up j)))))
+ (set! ramp-down (- ramp-down ramp)))
+ (if read-even-when-not-playing
+ (do ((i 0 (+ i 1)))
+ ((= i files-len))
+ (set! (locs i) (+ (locs i) bufsize)))
+ (begin
+ (set! (locs current-file) (+ (locs current-file) bufsize))
+ (set! (locs next-file) (+ (locs next-file) bufsize))))
+ (set! current-file next-file))
+ (let ((current (readers current-file))
+ (current-loc (locs current-file))
+ (on (make-frame chans)))
+ (do ((i 0 (+ i 1)))
+ ((= i bufsize))
+ (file->frame current (+ current-loc i) on)
+ (do ((k 0 (+ 1 k)))
+ ((= k chans))
+ (vector-set! data k i (frame-ref on k))))
+ (if read-even-when-not-playing
+ (do ((i 0 (+ i 1)))
+ ((= i files-len))
+ (set! (locs i) (+ (locs i) bufsize)))
+ (set! (locs current-file) (+ (locs current-file) bufsize)))))
+ (mus-audio-write out-port data bufsize)
+ (set! reading (letrec ((any-data-left
+ (lambda (f)
+ (if (= f files-len)
+ #f
+ (or (< (locs f) (pframes f))
+ (any-data-left (+ 1 f)))))))
+ (any-data-left 0))))))
+ (lambda args (begin (snd-print (format #f "error ~A" args)) (car args))))
+ (mus-audio-close out-port)))))))
+|#
+#|
+(vector-synthesis (let ((ctr 0) (file 0))
+ (lambda (files bufsize)
+ (if (> ctr 4)
+ (begin
+ (set! file (+ 1 file))
+ (set! ctr 0)
+ (if (>= file files)
+ (set! file 0)))
+ (set! ctr (+ ctr 1)))
+ file))
+ (list "oboe.snd" "pistol.snd") #t)
+|#
+
+
+;;; --------------------------------------------------------------------------------
+;;; old frame.scm
+;;; various frame-related extensions
+
+;;; frame-reverse! frame-copy (from mixer.scm)
+;;; sound->frame frame->sound
+;;; region->frame
+;;;
+;;; make-frame-reader frame-reader? frame-reader-at-end frame-reader-position frame-reader-home free-frame-reader copy-frame-reader frame-reader-chans
+;;; next-frame previous-frame read-frame
+;;; make-region-frame-reader make-selection-frame-reader
+;;; make-sync-frame-reader
+;;;
+;;; file->frample frample->file
+;;; frame->float-vector float-vector->frame
+;;;
+;;; insert-frame insert-float-vector
+;;; mix-frame
+;;; scan-sound map-sound
+;;;
+;;; simultaneous-zero-crossing
+
+(provide 'snd-frame.scm)
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+
+
+(define frame-reverse! reverse)
+(define frame-copy copy)
+
+#|
+(define (frame-cross m1 m2)
+ "(frame-cross fr1 fr2) returns the cross product (a frame) of frames fr1 and fr2"
+ (if (or (not (= (channels m1) 3))
+ (not (= (channels m2) 3)))
+ (snd-print "cross product only in 3 dimensions")
+ (make-frame 3
+ (- (* (m1 1) (m2 2))
+ (* (m1 2) (m2 1)))
+ (- (* (m1 2) (m2 0))
+ (* (m1 0) (m2 2)))
+ (- (* (m1 0) (m2 1))
+ (* (m1 1) (m2 0))))))
+
+;;; (frame-cross (make-frame 3 0 0 1) (make-frame 3 0 -1 0))
+;;; <frame[3]: [1.000 0.000 0.000]>
+
+(define (frame-normalize f)
+ "(frame-normalize fr) scales the contents of frame fr so that its euclidean length is 1.0"
+ (let ((mag (sqrt (dot-product (mus-data f) (mus-data f)))))
+ (if (> mag 0.0)
+ (frame* f (/ 1.0 mag))
+ f)))
+
+;;; (frame-normalize (make-frame 3 4 3 0))
+;;; <frame[3]: [0.800 0.600 0.000]>
+|#
+
+(define* (frame->float-vector fr v)
+ "(frame->float-vector fr v) copies frame fr into either float-vector v or a new float-vector, returning the float-vector"
+ (copy fr (or v (make-float-vector (length fr)))))
+
+(define* (float-vector->frame v fr)
+ "(float-vector->frame v fr) copies float-vector v into either frame fr or a new frame, returning the frame"
+ (copy v (or fr (make-frame (length v)))))
+
+(define frame->vct frame->float-vector)
+(define vct->frame float-vector->frame)
+
+
+(define* (sound->frame (pos 0) snd)
+ "(sound->frame pos snd) returns a frame containing the contents of the sound snd at position pos"
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (not (sound? index))
+ (error 'no-such-sound "sound->frame: ~A" snd)
+ (let ((fr (make-frame (channels index))))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels index))
+ fr)
+ (set! (fr i) (sample pos index i)))))))
+
+(define* (frame->sound fr (pos 0) snd)
+ "(frame->sound fr pos snd) places the contents of frame fr into sound snd at position pos"
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (not (sound? index))
+ (error 'no-such-sound "frame->sound: ~A" snd)
+ (do ((i 0 (+ i 1)))
+ ((= i (channels index))
+ fr)
+ (set! (sample pos index i) (fr i))))))
+
+
+(define (region->frame reg pos)
+ "(region->frame pos reg) returns a frame with the contents of region reg at position pos"
+ (if (not (region? reg))
+ (error 'no-such-region "region->frame: ~A" reg)
+ (let ((fr (make-frame (channels reg))))
+ (do ((i 0 (+ i 1)))
+ ((= i (channels reg))
+ fr)
+ (set! (fr i) (region-sample reg pos i))))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; frame-readers
+;;;
+
+(defgenerator frame-sampler snd chns frm samplers)
+
+(define* (make-frame-reader (beg 0) snd dir edpos)
+ "(make-frame-reader beg snd dir edpos) returns a frame reader, basically a sampler that reads all channels on each call"
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (and (not (sound? index))
+ (not (string? index))) ; filename is a possibility here
+ (error 'no-such-sound "make-frame-reader: ~A" snd)
+ (let ((chns (channels index))) ; this works in both cases
+ (make-frame-sampler index chns
+ (make-frame chns)
+ (let ((v (make-vector chns)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns) v)
+ (set! (v i) (make-sampler beg index i dir edpos)))))))))
+
+(define frame-reader? frame-sampler?)
+
+(define (frame-reader-at-end? fr)
+ "(frame-reader-at-end? fr) -> #t if the samplers in frame-reader fr have reached the end of their respective channels"
+ (with-let fr
+ (call-with-exit
+ (lambda (return)
+ (do ((i 0 (+ i 1)))
+ ((= i chns) #t)
+ (if (not (sampler-at-end? (samplers i)))
+ (return #f)))))))
+
+(define (frame-reader-position fr)
+ "(frame-reader-position fr) -> current read position of frame-reader fr"
+ (with-let fr (sampler-position (samplers 0))))
+
+(define (frame-reader-home fr)
+ "(frame-reader-home fr) -> sound object associated with frame-reader fr"
+ (with-let fr snd))
+
+(define (frame-reader-chans fr)
+ "(frame-reader-chans fr) -> number of channels read by frame-reader fr"
+ (with-let fr chns))
+
+(define (free-frame-reader fr)
+ "(free-frame-reader fr) frees all samplers associated with frame-reader fr"
+ (with-let fr
+ (do ((i 0 (+ i 1)))
+ ((= i chns))
+ (free-sampler (samplers i)))))
+
+(define (copy-frame-reader fr)
+ "(copy-frame-reader fr) returns a copy of frame-reader fr"
+ (with-let fr
+ (make-frame-sampler snd chns
+ (make-frame chns)
+ (let ((v (make-vector chns)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns) v)
+ (set! (v i) (copy-sampler (samplers i))))))))
+
+(define (next-frame fr)
+;; "(next-frame fr) returns the next frame as read by frame-reader fr"
+ (with-let fr
+ (do ((i 0 (+ i 1)))
+ ((= i chns) frm)
+ (set! (frm i) (next-sample (samplers i))))))
+
+(define (previous-frame fr)
+ "(previous-frame fr) returns the previous frame as read by frame-reader fr"
+ (with-let fr
+ (do ((i 0 (+ i 1)))
+ ((= i chns) frm)
+ (set! (frm i) (previous-sample (samplers i))))))
+
+(define (read-frame fr)
+;; "(read-frame fr) returns the next frame read by frame-reader fr taking its current read direction into account"
+ (with-let fr
+ (do ((i 0 (+ i 1)))
+ ((= i chns) frm)
+ (set! (frm i) (read-sample (samplers i))))))
+
+
+(define* (make-region-frame-reader reg beg dir)
+ "(make-region-frame-reader reg beg dir) returns a frame-reader reading the contents of region reg"
+ (if (not (region? reg))
+ (error 'no-such-region "make-region-frame-reader: ~A" reg)
+ (let ((chns (channels reg)))
+ (make-frame-sampler reg chns
+ (make-frame chns)
+ (let ((v (make-vector chns)))
+ (do ((i 0 (+ i 1)))
+ ((= i chns) v)
+ (set! (v i) (make-region-sampler reg beg i dir))))))))
+
+(define* (make-sync-frame-reader (beg 0) snd dir edpos)
+ "(make-sync-frame-reader beg snd dir edpos) returns a frame-reader that reads all channels sync'd to 'snd'"
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (not (sound? index))
+ (error 'no-such-sound "make-sync-frame-reader: ~A" snd)
+ (let ((snc (sync index)))
+ (if (= snc 0)
+ (make-frame-reader beg index dir edpos)
+ (let ((chns 0))
+ (for-each
+ (lambda (s)
+ (if (= (sync s) snc) ; sync field is always an int (0 = none)
+ (set! chns (+ chns (channels s)))))
+ (sounds))
+ (make-frame-sampler index chns
+ (make-frame chns)
+ (let ((v (make-vector chns))
+ (ctr 0))
+ (for-each
+ (lambda (s)
+ (if (= (sync s) snc)
+ (begin
+ (do ((i 0 (+ i 1)))
+ ((= i (channels s)))
+ (set! (v (+ i ctr)) (make-sampler beg s i dir edpos)))
+ (set! ctr (+ ctr (channels s))))))
+ (sounds))
+ v))))))))
+
+(define* (make-selection-frame-reader (beg 0))
+ "(make-selection-frame-reader (beg 0)) returns a frame reader that reads all channels of the current selection"
+ (if (not (selection?))
+ (error 'no-active-selection "make-selection-frame-reader: ~A" beg)
+ (let ((chns (selection-chans)))
+ (make-frame-sampler -1 chns
+ (make-frame chns)
+ (let ((ctr 0)
+ (v (make-vector chns)))
+ (for-each
+ (lambda (snd)
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels snd)))
+ (if (selection-member? snd chn)
+ (begin
+ (set! (v ctr) (make-sampler (+ beg (selection-position snd chn)) snd chn))
+ (set! ctr (+ ctr 1))))))
+ (sounds))
+ v)))))
+
+
+(define (old-file->frample file)
+ (samples 0 (framples file) file))
+
+(define file->vct old-file->frample)
+
+
+(define* (old-frample->file v file (srate 22050) (comment ""))
+ "(frample->file v file srate comment) writes the data in float-vector v to the specified sound file"
+ (if (float-vector? v)
+ (let ((fd (mus-sound-open-output file srate 1 #f mus-riff comment)))
+ (mus-sound-write fd 0 (- (length v) 1) 1 (make-shared-vector v (list 1 (length v))))
+ (mus-sound-close-output fd (* (mus-bytes-per-sample mus-out-format) (length v)))
+ file)
+ (error 'wrong-type-arg "file->frample: ~A" v)))
+
+(define vct->file old-frample->file)
+
+
+(define* (insert-float-vector v (beg 0) dur snd chn edpos)
+ "(insert-float-vector v beg dur snd chn edpos) inserts float-vector v's data into sound snd at beg"
+ (if (not (float-vector? v))
+ (error 'wrong-type-arg "insert-float-vector: ~A" v)
+ (let ((len (or dur (length v))))
+ (insert-samples beg len v snd chn edpos #f (format #f "insert-float-vector ~A ~A ~A" (float-vector->string v) beg dur)))))
+
+(define insert-vct insert-float-vector)
+
+
+(define* (insert-frame fr (beg 0) snd edpos)
+ "(insert-frame fr beg snd edpos) inserts frame fr's data into sound snd (one sample in each channel) at beg"
+ (if (not (frame? fr))
+ (error 'wrong-type-arg "insert-frame: ~A" fr)
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (not (sound? index))
+ (error 'no-such-sound "insert-frame: ~A" snd)
+ (let ((chns (min (channels fr) (channels index))))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn chns))
+ (insert-sample beg (fr chn) index chn edpos)))))))
+
+
+(define* (mix-frame fr (beg 0) snd)
+ "(mix-frame fr beg snd) mixes frame fr's data into sound snd (one sample in each channel) at beg"
+ (if (not (frame? fr))
+ (error 'wrong-type-arg "mix-frame: ~A" fr)
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (not (sound? index))
+ (error 'no-such-sound "mix-frame: ~A" snd)
+ (let ((chns (min (channels fr) (channels index))))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn chns))
+ (set! (sample beg index chn) (+ (fr chn) (sample beg index chn)))))))))
+
+
+(define* (scan-sound func (beg 0) dur snd with-sync)
+ "(scan-sound func beg dur snd with-sync) is like scan-channel; it passes func a frame on each call, and stops when func returns true"
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (sound? index)
+ (let* ((reader (if with-sync
+ (make-sync-frame-reader beg index)
+ (make-frame-reader beg index)))
+ (result #f)
+ (len (framples index))
+ (end (if dur (min len (+ beg dur)) len)))
+ (do ((i beg (+ i 1)))
+ ((or result (= i end))
+ (and result
+ (list result (- i 1))))
+ (set! result (func (read-frame reader)))))
+ (error 'no-such-sound "scan-sound: ~A" snd))))
+
+(define +read-forward+ 1)
+
+(define* (map-sound func (beg 0) dur snd edpos)
+ "(map-sound func beg dur snd edpos) is a version of map-channel that passes func a frame on each call, rather than a sample"
+ ;; not sure map-sound with sync is a good idea -- even scale-by following sync seems bad
+ (let ((index (or snd (selected-sound) (car (sounds)))))
+ (if (sound? index)
+ (let* ((out-chans (channels index))
+ (reader (make-frame-reader beg index +read-forward+ edpos))
+ (filename (snd-tempnam))
+ (writer (make-frame->file filename out-chans))
+ (len (framples index))
+ (end (if dur (min len (+ beg dur)) len))
+ (loc 0))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((result (func (next-frame reader))))
+ (if result
+ (begin
+ (frame->file writer loc result)
+ (set! loc (+ loc 1))))))
+ (mus-close writer)
+ (free-frame-reader reader)
+ (do ((i 0 (+ i 1)))
+ ((= i (channels index)))
+ (set! (samples beg loc index i #f "map-sound" i #f (= i 0)) filename))) ; edpos = #f, auto-delete = chan=0
+ (error 'no-such-sound "map-sound: ~A" snd))))
+
+
+(define* (simultaneous-zero-crossing (beg 0) dur snd)
+ "(simultaneous-zero-crossing :option beg dur snd) looks through all channels of 'snd' for a simultaneous zero crossing."
+ (let ((last-fr (make-frame (channels snd))))
+ (scan-sound (lambda (fr)
+ (let ((result #t))
+ (do ((chn 0 (+ 1 chn)))
+ ((= chn (channels fr)))
+ (set! result (and result (< (* (fr chn) (last-fr chn)) 0.0)))
+ (set! (last-fr chn) (fr chn)))
+ result))
+ beg dur snd)))
+
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; old mixer.scm
+
+;;; mixer and frame stuff, mostly oriented toward linear algebra (see also snd-test)
+;;;
+;;; make-zero-mixer, mixer-diagonal?, mixer-transpose, mixer-determinant,
+;;; mixer-solve, mixer-inverse, invert-matrix, mixer-trace, mixer-poly, mixer-copy
+
+(provide 'snd-mixer.scm)
+
+(define make-zero-mixer make-mixer)
+
+(define (mixer-copy umx)
+ "(mixer-copy umx) returns a copy of its argument (a mixer)"
+ (let* ((size (length umx))
+ (mx (make-mixer size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (do ((j 0 (+ j 1)))
+ ((= j size))
+ (set! (mx i j) (umx i j))))
+ mx))
+
+
+(define (mixer-diagonal? m)
+ "(mixer-diagonal? m) returns #t if 'm' is a diagonal mixer"
+ (let ((n (length m)))
+ (or (= n 1)
+ (call-with-exit
+ (lambda (return)
+ (do ((i 0 (+ i 1)))
+ ((= i n) #t)
+ (do ((j 0 (+ j 1)))
+ ((= j n))
+ (if (and (not (= i j))
+ (not (= (m i j) 0.0)))
+ (return #f)))))))))
+
+(define (mixer-transpose mx)
+ "(mixer-transpose mx) returns a new mixer of 'mx' transposed"
+ (let* ((n (length mx))
+ (nmx (make-zero-mixer n)))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (do ((j 0 (+ j 1)))
+ ((= j n))
+ (set! (nmx j i) (mx i j))))
+ nmx))
+
+(define (sub-matrix mx row col)
+ "(sub-matrix mx row col) returns a portion of the matrix 'mx'"
+ (let* ((old-n (length mx))
+ (new-n (- old-n 1))
+ (nmx (make-zero-mixer new-n)))
+ (do ((i 0 (+ i 1))
+ (ni 0))
+ ((= i old-n))
+ (if (not (= i row))
+ (begin
+ (do ((j 0 (+ j 1))
+ (nj 0))
+ ((= j old-n))
+ (if (not (= j col))
+ (begin
+ (set! (nmx ni nj) (mx i j))
+ (set! nj (+ nj 1)))))
+ (set! ni (+ 1 ni)))))
+ nmx))
+
+(define (mixer-determinant mx)
+ "(mixer-determinant mx) returns the determinant of 'mx'"
+ (if (not (mixer? mx))
+ (error 'wrong-type-arg "mixer-determinant argument should be a mixer")
+ (let ((n (length mx)))
+ (if (= n 1)
+ (mx 0 0)
+ (if (= n 2)
+ (- (* (mx 0 0) (mx 1 1))
+ (* (mx 0 1) (mx 1 0)))
+ (if (= n 3)
+ (- (+ (* (mx 0 0) (mx 1 1) (mx 2 2))
+ (* (mx 0 1) (mx 1 2) (mx 2 0))
+ (* (mx 0 2) (mx 1 0) (mx 2 1)))
+ (+ (* (mx 0 0) (mx 1 2) (mx 2 1))
+ (* (mx 0 1) (mx 1 0) (mx 2 2))
+ (* (mx 0 2) (mx 1 1) (mx 2 0))))
+ (let ((sum 0.0)
+ (sign 1))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((mult (mx 0 i)))
+ (if (not (= mult 0.0))
+ (set! sum (+ sum (* sign mult (mixer-determinant (sub-matrix mx 0 i))))))
+ (set! sign (- sign))))
+ sum)))))))
+
+(define* (mixer-poly mx :rest coeffs)
+ "(mixer-poly mx :rest coeffs) returns a new mixer, the result of treating 'mx' as the argument to the polynomial defined by the 'coeffs' list"
+ (let* ((n (length coeffs))
+ (nmx (make-scalar-mixer (length mx) (coeffs (- n 1))))
+ (x (mixer* mx 1.0)))
+ (do ((i (- n 2) (- i 1)))
+ ((< i 0))
+ (set! nmx (mixer+ nmx (mixer* x (coeffs i))))
+ (set! x (mixer* mx x)))
+ nmx))
+
+;;; (define (float-vector-norm v1) (sqrt (dot-product v1 v1)))
+
+(define (mixer-trace mx)
+ "(mixer-trace mx) returns the trace of 'mx'"
+ (let ((sum 0.0)
+ (n (length mx)))
+ (do ((i 0 (+ i 1)))
+ ((= i n) sum)
+ (set! sum (+ sum (mx i i))))))
+
+
+;;; invert-matrix is in dsp.scm
+;;; it would be faster to use invert-matrix to calculate the determinant
+
+(define (mixer-solve A b)
+ "(mixer-solve A b) returns the solution of Ax=b"
+ (let ((val (invert-matrix A b)))
+ (and val (cadr val))))
+
+(define (mixer-inverse A)
+ "(mixer-inverse A) returns the inverse of 'A'"
+ (let ((val (invert-matrix A)))
+ (and val (car val))))
+
+#|
+(define (plane p1 p2 p3) ; each p a list of 3 coords, returns list (a b c d) of ax + by + cz = 1 (d = -1)
+ (let ((m (make-mixer 3))
+ (f (make-frame 3 1 1 1)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3))
+ (set! (m 0 i) (p1 i))
+ (set! (m 1 i) (p2 i))
+ (set! (m 2 i) (p3 i)))
+ (let ((b (mixer-solve m f)))
+ (list (b 0) (b 1) (b 2) -1))))
+
+;;; (plane '(0 0 1) '(1 0 0) '(0 1 0))
+;;; (1.0 1.0 1.0 -1)
+|#
+
+
+
+
+;;; backwards compatibility for snd 12
+
+(define (mus-audio-describe) "no description available anymore")
+
+(define verbose-cursor with-verbose-cursor)
+
+(define (recorder-dialog) "recorder-dialog is obsolete")
+
+
+
+;;; backwards compatibility for snd 11 and earlier
+
+;;; backwards compatibility for snd 11
+
+
+;;; old Guile-style hook functions
+(define (hook-empty? hook)
+ (null? (hook-functions hook)))
+
+(define (reset-hook! hook)
+ (set! (hook-functions hook) ()))
+
+;(define (run-hook . args)
+; (hook-apply (car args) (cdr args)))
+
+(define hook->list hook-functions)
+
+(define* (add-hook! hook func at-end)
+ (set! (hook-functions hook)
+ (if (not at-end)
+ (cons func (hook-functions hook))
+ (append (hook-functions hook) (list func)))))
+
+(define (remove-hook! hook func)
+ (set! (hook-functions hook)
+ (let loop ((l (hook-functions hook))
+ (result ()))
+ (cond ((null? l) (reverse! result))
+ ((eq? func (car l)) (loop (cdr l) result))
+ (else (loop (cdr l) (cons (car l) result)))))))
+
+
+;;; these are carried forward from snd10.scm
+
+(define sine-summation nrxysin)
+(define sine-summation? nrxysin?)
+
+(define sum-of-sines nsin)
+(define sum-of-sines? nsin?)
+
+(define sum-of-cosines ncos)
+(define sum-of-cosines? ncos?)
+
+(define* (make-sum-of-sines (sines 1) (frequency 0.0) (initial-phase 0.0))
+ (let ((gen (make-nsin :frequency frequency :n sines)))
+ (set! (mus-phase gen) initial-phase)
+ gen))
+
+(define* (make-sum-of-cosines (cosines 1) (frequency 0.0) (initial-phase 0.0))
+ (let ((gen (make-ncos :frequency frequency :n cosines)))
+ (set! (mus-phase gen) initial-phase)
+ gen))
+
+(define* (make-sine-summation (frequency 0.0) (initial-phase 0.0) (n 1) (a 0.5) (ratio 1.0))
+ (let ((gen (make-nrxysin :frequency frequency :ratio ratio :n n :r a)))
+ (set! (mus-phase gen) initial-phase)
+ gen))
+
+(if (not (defined? 'in-hz)) (define in-hz hz->radians))
+
+(define copy-sample-reader copy-sampler)
+(define free-sample-reader free-sampler)
+(define make-mix-sample-reader make-mix-sampler)
+(define make-region-sample-reader make-region-sampler)
+(define make-sample-reader make-sampler)
+(define mix-sample-reader? mix-sampler?)
+(define region-sample-reader? region-sampler?)
+(define sample-reader-at-end? sampler-at-end?)
+(define sample-reader-home sampler-home)
+(define sample-reader? sampler?)
+(define sample-reader-position sampler-position)
+
+
+
+;;; -------- with-mix --------
+;;;
+;;; weird syntax = with-mix (with-sound-args) file-name start-in-output &body body
+;;;
+;;; (with-sound ()
+;;; (with-mix () "section-1" 0 (fm-violin 0 1 440 .1)
+;;; (fm-violin 1 2 660 .1))
+;;; ...)
+
+(define with-mix-find-file-with-extensions
+ (let ((documentation "(with-mix-find-file-with-extensions file extensions) helps the with-mix macro find checkpoint files"))
+ (lambda (file extensions)
+ (if (file-exists? file)
+ file
+ (call-with-exit
+ (lambda (found-one)
+ (for-each
+ (lambda (ext)
+ (let ((new-file (string-append file "." ext)))
+ (if (file-exists? new-file)
+ (found-one new-file))))
+ extensions)
+ #f))))))
+
+(define with-mix-file-extension
+ (let ((documentation "(with-mix-file-extension file default) is a helper function for the with-mix macro"))
+ (lambda (file default)
+ (let ((len (length file)))
+ (call-with-exit
+ (lambda (ok)
+ (do ((i (- len 1) (- i 1)))
+ ((= i 0))
+ (if (char=? (file i) #\.)
+ (ok (substring file (+ 1 i) len))))
+ default))))))
+
+(define-macro (with-mix options ur-chkpt-file ur-beg . body)
+ `(let ((chkpt-file ,ur-chkpt-file)
+ (beg-1 ,ur-beg))
+ (if (not (list? ',options))
+ (throw 'with-sound-interrupt (format #f "with-mix options list (arg 1) is ~A?~%;" ',options))
+ (if (not (string? chkpt-file))
+ (throw 'with-sound-interrupt (format #f "with-mix file (arg 2) is ~A?~%;" ,ur-chkpt-file))
+ (if (not (number? beg-1))
+ (throw 'with-sound-interrupt (format #f "with-mix begin time (arg 3) for ~S = ~A?~%;" chkpt-file beg-1))
+ (let ((beg (round (* *clm-srate* beg-1))))
+ (if (null? ',body)
+ (mus-file-mix *output* chkpt-file beg)
+ (let* ((call-str (object->string ',body))
+ (option-str (object->string ',options))
+ (sndf (with-mix-find-file-with-extensions chkpt-file (list (with-mix-file-extension *clm-file-name* "snd") "snd")))
+ (revf (and sndf *reverb* (with-mix-find-file-with-extensions chkpt-file (list "rev"))))
+ (mix-values (and sndf
+ (or (not *reverb*)
+ revf)
+ (let ((comment (mus-sound-comment sndf)))
+ (and (string? comment)
+ (catch #t
+ (lambda ()
+ (eval-string comment))
+ (lambda args #f))))))) ; any error means we lost
+ (if (and sndf
+ (or (not *reverb*)
+ revf)
+ (list? mix-values)
+ (= (length mix-values) 2)
+ (string? (car mix-values))
+ (string? (cadr mix-values))
+ (string=? (car mix-values) option-str)
+ (string=? (cadr mix-values) call-str))
+ (begin
+ (if *clm-verbose* (snd-print (format #f "mix ~S at ~,3F~%" sndf beg)))
+ (mus-file-mix *output* sndf beg)
+ (if revf (mus-file-mix *reverb* revf beg)))
+ ;; else recompute
+ (let ((old-to-snd *to-snd*))
+ (set! *to-snd* #f)
+ (if *clm-verbose* (snd-print (format #f "remake ~S at ~,3F~%" chkpt-file beg)))
+ (let ((new-snd
+ (apply with-sound-helper
+ (lambda () , at body)
+ (append (list :output
+ (string-append chkpt-file "." (with-mix-file-extension *clm-file-name* "snd")))
+ (list :comment
+ (format #f "(begin~%;; written ~A (Snd: ~A)~%(list ~S ~S))~%"
+ (strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time)))
+ (snd-version)
+ option-str
+ call-str))
+ (if (and (> (channels *output*) 1)
+ (not (member :channels ',options)))
+ (list :channels (channels *output*))
+ ())
+ ',options))))
+ (set! *to-snd* old-to-snd)
+ (mus-file-mix *output* new-snd beg)
+ (if revf (mus-file-mix *reverb* revf beg)))))))))))))
+
+
+#|
+;;; this is the with-mix documentation:
+
+<br>
+<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
+<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>with-mix</h4></td></tr></table>
+</td></tr></table>
+
+<p><a name="with-mix">with-mix</a> is a "checkpointing" version of with-sound, more useful in the bad old days when computers
+were incredibly slow, but lingering on...
+It is a macro, callable within <a href="#wsdoc">with-sound</a> or <a href="#clmload">clm-load</a>,
+which saves the computation in its body in a separate file, and
+then upon a subsequent recomputation, tries to tell (via a string comparison) when that file's data is up to date
+and does not need to be recomputed.
+</p>
+
+<table border=0 hspace=40 cellpadding=8 cellspacing=3><tr><td>
+<pre>
+(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+ (fm-violin 0 .1 440 .1)
+ (<em class=red>with-mix</em> () "sec1" .5
+ (fm-violin 0 .1 550 .1)
+ (fm-violin .1 .1 660 .1))
+ (<em class=red>with-mix</em> (:reverb jc-reverb) "sec2" 1.0
+ (fm-violin 0 .1 880 .1 :reverb-amount .2)
+ (fm-violin .1 .1 1320 .1 :reverb-amount .2))
+ (fm-violin 2 .1 220 .1)
+ (<em class=red>mix</em> "/zap/slow.snd"))
+</pre>
+</td></tr></table>
+
+<p>Now, if we change just the first note in the with-mix call, the
+second with-mix section will not be recomputed, but will be mixed in from the
+saved file "sec2.snd".
+In the old days, when notes took hours to compute, this was a big deal,
+but not anymore.
+</p>
+
+
+;;; and these are the regression tests
+
+ (define (check-with-mix num dur total-dur amp opts calls old-date chkmx)
+ (let ((ind (find-sound "test.snd")))
+ (if (not (sound? ind)) (snd-display #__line__ ";with-mix (~A) init: no test.snd?" num))
+ (if (and chkmx (fneq (maxamp ind) amp)) (snd-display #__line__ ";with-mix (~A) maxamp: ~A (~A)" num (maxamp ind) amp))
+ (if (not (file-exists? "with-mix.snd")) (snd-display #__line__ ";with-mix (~A) output doesn't exist" num))
+ (let ((mx (mus-sound-maxamp "with-mix.snd"))
+ (date (mus-sound-write-date "with-mix.snd"))
+ (duration (mus-sound-duration "with-mix.snd")))
+ (if (fneq duration dur) (snd-display #__line__ ";with-mix (~A) dur: ~A ~A" num dur duration))
+ (if (fneq total-dur (/ (framples ind) (srate ind)))
+ (snd-display #__line__ ";with-mix (~A) total dur: ~A ~A" num total-dur (/ (framples ind) (srate ind))))
+ (if (and old-date
+ (> (- date old-date) 1)) ; these can be off by some amount in Linux
+ (snd-display #__line__ ";with-mix (~A) rewrote output?: ~A ~A ~A" num (- date old-date)
+ (strftime "%d-%b-%g %H:%M:%S" (localtime old-date))
+ (strftime "%d-%b-%g %H:%M:%S" (localtime date))))
+ (if (and chkmx (or (not mx) (fneq (cadr mx) amp))) (snd-display #__line__ ";with-mix sndf (~A) maxamp: ~A (~A)" num mx amp))
+ (let ((header-str (mus-sound-comment "with-mix.snd")))
+ (if (not (string? header-str)) (snd-display #__line__ ";with-mix (~A) comment unwritten?: ~A" num (mus-sound-comment "with-mix.snd")))
+ (let ((header (eval-string header-str)))
+ (if (not (list? header)) (snd-display #__line__ ";with-mix (~A) comment: ~A -> ~A" num header-str header))
+ (if (or (not (string=? (car header) opts))
+ (not (string=? (cadr header) calls)))
+ (snd-display #__line__ ";with-mix (~A) header values: ~A" num header))))
+ (close-sound ind)
+ date)))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound () (with-mix () "with-mix" 0 (fm-violin 0 .1 440 .1)))
+ (let ((old-date (check-with-mix 1 .1 .1 .1 "()" "((fm-violin 0 0.1 440 0.1))" #f #t)))
+ (with-sound () (with-mix () "with-mix" 0 (fm-violin 0 .1 440 .1)))
+ (check-with-mix 1 .1 .1 .1 "()" "((fm-violin 0 0.1 440 0.1))" old-date #t))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1)))
+ (let ((old-date (check-with-mix 2 .1 .2 .1 "()" "((fm-violin 0 0.1 440 0.1))" #f #t)))
+ (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1)))
+ (check-with-mix 2 .1 .2 .1 "()" "((fm-violin 0 0.1 440 0.1))" old-date #t))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1) (fm-violin .1 .1 660 .2)))
+ (let ((old-date (check-with-mix 3 .2 .3 .2 "()" "((fm-violin 0 0.1 440 0.1) (fm-violin 0.1 0.1 660 0.2))" #f #t)))
+ (with-sound () (fm-violin 0 .1 660 .1) (with-mix () "with-mix" .1 (fm-violin 0 .1 440 .1) (fm-violin .1 .1 660 .2)))
+ (check-with-mix 3 .2 .3 .2 "()" "((fm-violin 0 0.1 440 0.1) (fm-violin 0.1 0.1 660 0.2))" old-date #t))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound ()
+ (with-mix () "with-mix" 0
+ (sound-let ((tmp () (fm-violin 0 1 440 .1))) (mus-file-mix *output* tmp 0))))
+ (let ((old-date (check-with-mix 4 1 1 .1 "()" "((sound-let ((tmp () (fm-violin 0 1 440 0.1))) (mus-file-mix *output* tmp 0)))" #f #t)))
+ (with-sound ()
+ (with-mix () "with-mix" 0
+ (sound-let ((tmp () (fm-violin 0 1 440 .1))) (mus-file-mix *output* tmp 0))))
+ (check-with-mix 4 1 1 .1 "()" "((sound-let ((tmp () (fm-violin 0 1 440 0.1))) (mus-file-mix *output* tmp 0)))" old-date #t))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound (:channels 2) (fm-violin 0 .1 440 .1 :degree 0) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3 :degree 90)))
+ (let ((ind (find-sound "test.snd")))
+ (if (or (fneq (maxamp ind 0) .1)
+ (fneq (maxamp ind 1) .3))
+ (snd-display #__line__ ";with-mix stereo: ~A" (maxamp ind #t)))
+ (if (not (= (mus-sound-chans "with-mix.snd") 2)) (snd-display #__line__ ";with-mix stereo out: ~A" (mus-sound-chans "with-mix.snd"))))
+ (let ((old-date (mus-sound-write-date "with-mix.snd")))
+ (with-sound (:channels 2) (fm-violin 0 .1 440 .1 :degree 0) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3 :degree 90)))
+ (if (not (= (mus-sound-write-date "with-mix.snd") old-date))
+ (snd-display #__line__ ";stereo with-mix dates: ~A ~A" old-date (mus-sound-write-date "with-mix.snd"))))
+ (let ((ind (find-sound "test.snd")))
+ (close-sound ind))
+
+ (if (file-exists? "with-mix.snd") (delete-file "with-mix.snd"))
+ (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3)))
+ (let ((old-date (check-with-mix 6 .1 1.1 .398 "()" "((fm-violin 0 0.1 550 0.3))" #f #f)))
+ (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1) (with-mix () "with-mix" 0 (fm-violin 0 .1 550 .3)))
+ (check-with-mix 6 .1 1.1 .398 "()" "((fm-violin 0 0.1 550 0.3))" old-date #f))
+
+|#
+
+;;; --------------------------------------------------------------------------------
+
+
+(define (focus-follows-mouse) (set! *with-pointer-focus* #t))
+(define (make-current-window-display) (set! *with-inset-graph* #t))
+(define load-from-path load)
+;(define def-optkey-fun define*)
+;(define def-optkey-instrument definstrument)
+
+(define spectro-cutoff spectrum-start)
+(define spectro-end spectrum-end)
+
+
+
+(define* (play-region reg wait stop-func)
+ (play (if (integer? reg) (integer->region reg) reg) :wait wait :stop stop-func))
+
+(define* (play-selection wait stop-func)
+ (play (selection) :wait wait :stop stop-func))
+
+(define* (play-mix id (beg 0))
+ (play (if (integer? id) (integer->mix id) id) beg))
+
+(define* (play-and-wait (start 0) snd chn syncd end (pos -1) stop-proc)
+ (if (string? start)
+ (play start (or snd 0) :end (or chn -1) :wait #t)
+ (play (if (integer? snd) (integer->sound snd)
+ (if (sound? snd) snd
+ (or (selected-sound) (car (sounds)))))
+ :channel (or chn -1) :wait #t :with-sync syncd :start start :end (or end -1)
+ :stop stop-proc :edit-position pos)))
+
+(define* (old-play (start 0) snd chn syncd end (pos -1) stop-proc (out-chan -1))
+ (play (if (integer? snd) (integer->sound snd)
+ (if (sound? snd) snd
+ (or (selected-sound) (car (sounds)))))
+ :channel (or chn -1) :with-sync syncd :start start :end (or end -1)
+ :stop stop-proc :out-channel out-chan :edit-position pos))
+
+(define* (play-channel (beg 0) dur snd chn (pos -1) stop-proc (out-chan -1))
+ (play (if (integer? snd) (integer->sound snd)
+ (if (sound? snd) snd
+ (or (selected-sound) (car (sounds)))))
+ :channel (or chn -1) :with-sync #f :start beg :end (if dur (+ beg dur) -1)
+ :stop stop-proc :out-channel out-chan :edit-position pos))
+
+
+;;; --------------------------------------------------------------------------------
+
+(define (add-watcher func)
+ (hook-push effects-hook func))
+
+(define (delete-watcher func)
+ (hook-remove effects-hook func))
+
+
+(define clear-selection unselect-all)
+
+(define cursor-follows-play with-tracking-cursor)
+
diff --git a/snd14.scm b/snd14.scm
new file mode 100644
index 0000000..462cc18
--- /dev/null
+++ b/snd14.scm
@@ -0,0 +1,352 @@
+(define trap-segfault
+ (dilambda
+ (lambda () #f)
+ (lambda (val) val)))
+
+(define* (if-cursor-follows-play-it-stays-where-play-stopped (enable #t))
+ (set! *with-tracking-cursor* (and enable :track-and-stay)))
+
+
+(define* (find-channel func (beg 0) snd chn edpos)
+ (scan-channel func beg #f snd chn edpos))
+
+(define scan-chan scan-channel)
+
+(define* (map-chan proc beg end origin snd chn edpos)
+ (map-channel proc beg (+ (- end beg) 1) snd chn edpos origin))
+
+
+(define smooth-vct smooth-float-vector)
+(define vct-polynomial float-vector-polynomial)
+(define mix->vct mix->float-vector)
+(define pan-mix-vct pan-mix-float-vector)
+(define vct-size float-vector-size)
+
+
+
+#|
+;;; -------- sound segmentation
+;;;
+;;; this code was used to return note on and off points for the Iowa Musical Instrument Sound library
+;;; the main function takes the top level directory of the sounds, and returns (eventually) a text
+;;; file containing the start times (in samples) and durations of all the notes (each sound file in
+;;; this library can have about 12 notes). The results of this function need to be fixed up by hand
+;;; in some cases (violin notes in particular).
+
+;;; this code needs closedir, readdir and opendir (Guile-isms, I think)
+
+(define* (sounds->segment-data main-dir (output-file "sounds.data"))
+
+ (define (lower-case-and-no-spaces name)
+ (let* ((new-name (string-downcase name))
+ (len (length new-name)))
+ (do ((i 0 (+ i 1)))
+ ((= i len) new-name)
+ (if (char=? (new-name i) #\space)
+ (set! (new-name i) #\-)))))
+
+ (define (directory->list dir)
+ (let ((dport (opendir dir))
+ (ctr 0)) ; try to avoid infinite loop in the broken cases
+ (let loop ((entry (readdir dport))
+ (files ()))
+ (set! ctr (+ ctr 1))
+ (if (and (< ctr 2000)
+ (not (eof-object? entry)))
+ (loop (readdir dport) (cons entry files))
+ (begin
+ (closedir dport)
+ (reverse! files))))))
+
+ (define (segment-maxamp name beg dur)
+ (float-vector-peak (samples beg dur name)))
+
+ (define (segment-sound name high low)
+ (let* ((end (framples name))
+ (reader (make-sampler 0 name)) ; no need to open the sound and display it
+ (avg (make-moving-average :size 128))
+ (lavg (make-moving-average :size 2048)) ; to distinguish between slow pulse train (low horn) and actual silence
+ (segments (make-float-vector 100))
+ (segctr 0)
+ (possible-end 0)
+ (in-sound #f))
+ ;; this block is where 99% of the time goes
+ (do ((i 0 (+ i 1)))
+ ((= i end))
+ (let* ((samp (abs (next-sample reader)))
+ (val (moving-average avg samp))
+ (lval (moving-average lavg samp)))
+ (if in-sound
+ (if (< val low)
+ (begin
+ (set! possible-end i)
+ (if (< lval low)
+ (begin
+ (set! (segments segctr) (+ possible-end 128))
+ (set! segctr (+ segctr 1))
+ (set! in-sound #f)))))
+ (if (> val high)
+ (begin
+ (set! (segments segctr) (- i 128))
+ (set! segctr (+ segctr 1))
+ (set! in-sound #t))))))
+ (if in-sound
+ (begin
+ (set! (segments segctr) end)
+ (list (+ 1 segctr) segments))
+ (list segctr segments))))
+
+ (define* (do-one-directory fd dir-name ins-name (high .01) (low .001))
+ (snd-print (format #f ";~A~%" dir-name))
+ (for-each
+ (lambda (sound)
+ (let* ((sound-name (string-append dir-name "/" sound))
+ (boundary-data (segment-sound sound-name high low))
+ (boundaries (cadr boundary-data))
+ (segments (car boundary-data)))
+ (format fd "~%~%;;; ~A" sound)
+ (format fd "~%(~A ~S" ins-name (string-append dir-name "/" sound))
+ (do ((bnd 0 (+ bnd 2)))
+ ((>= bnd segments))
+ (let* ((segbeg (floor (boundaries bnd)))
+ (segdur (floor (- (boundaries (+ 1 bnd)) segbeg))))
+ (format fd " (~A ~A ~A)" segbeg segdur (segment-maxamp sound-name segbeg segdur))))
+ (format fd ")")
+ (mus-sound-forget (string-append dir-name "/" sound))))
+ (sound-files-in-directory dir-name)))
+
+ (call-with-output-file
+ output-file
+ (lambda (fd)
+ (let ((old-fam (with-file-monitor)))
+ (set! (with-file-monitor) #f) ; no need to monitor these guys
+ (format fd ";;; sound data from ~S" main-dir)
+ (if (not (char=? (main-dir (- (length main-dir) 1)) #\/))
+ (set! main-dir (string-append main-dir "/")))
+ (for-each
+ (lambda (dir)
+ (if (not (char=? (dir 0) #\.))
+ (let ((ins-name (lower-case-and-no-spaces dir)))
+ (format fd "~%~%;;; ---------------- ~A ----------------" dir)
+ (if (string=? dir "Piano")
+ (for-each
+ (lambda (inner-dir)
+ (if (not (char=? (inner-dir 0) #\.))
+ (do-one-directory fd (string-append main-dir dir "/" inner-dir) ins-name .001 .0001))) ; pp piano notes are .01 maxamp and short
+ (directory->list (string-append main-dir dir)))
+ (do-one-directory fd (string-append main-dir dir) ins-name)))))
+ (directory->list main-dir))
+ (set! (with-file-monitor) old-fam)))))
+
+;;; (sounds->segment-data "/home/bil/test/iowa/sounds/" "iowa.data")
+|#
+
+
+
+
+
+;;; not replaced:
+;;; dac-hook stop-dac-hook with-level-meters make-level-meter save-mixes
+;;; mus-sound-close-input mus-sound-close-output mus-sound-open-input mus-sound-open-output
+;;; mus-sound-read mus-sound-reopen-output mus-sound-seek-frame mus-sound-write
+
+(define continue-float-vector->file continue-frample->file)
+
+(define continue-frame->file continue-frample->file)
+
+(define file->float-vector file->frample)
+
+(define file->float-vector? file->frample?)
+
+(define file->frame file->frample)
+
+(define file->frame? file->frample?)
+
+(define float-vector->file frample->file)
+
+(define float-vector->file? frample->file?)
+
+(define (float-vector-mix f m o)
+ (frample->frample m f o))
+
+(define frame float-vector)
+
+(define (frame* f1 f2 outf)
+ (float-vector-multiply! (copy f1 (or outf (make-float-vector (length f1)))) f2))
+
+(define (frame+ f1 f2 outf)
+ (float-vector-add! (copy f1 (or outf (make-float-vector (length f1)))) f2))
+
+(define frame->file frample->file)
+
+(define frame->file? frample->file?)
+
+(define (frame->frame a b c)
+ (if (> (length a) (length b))
+ (frample->frample a b c)
+ (frample->frample b a c)))
+
+(define (frame->list a)
+ (copy a (make-list (length a))))
+
+(define frame->sample dot-product)
+
+(define sample->frame frame*)
+
+(define frame-ref float-vector-ref)
+
+(define frame-set! float-vector-set!)
+
+(define (frame? obj)
+ (and (float-vector? obj)
+ (= (vector-rank obj) 1)))
+
+(define frames framples)
+
+(define make-file->float-vector make-file->frample)
+
+(define make-file->frame make-file->frample)
+
+(define make-float-vector->file make-frample->file)
+
+(define (make-frame chans . args)
+ (let ((v (make-float-vector chans)))
+ (do ((i 0 (+ i 1))
+ (arg args (cdr args)))
+ ((null? arg) v)
+ (set! (v i) (car arg)))))
+
+(define make-frame! make-frame)
+
+(define make-frame->file make-frample->file)
+
+(define (mixer-rows mx) (floor (sqrt (length mx))))
+
+(define (make-mixer chans . args)
+ (let ((v (make-float-vector (* chans chans))))
+ (do ((i 0 (+ i 1))
+ (arg args (cdr args)))
+ ((null? arg) v)
+ (set! (v i) (car arg)))))
+
+(define make-mixer! make-mixer)
+
+(define (make-scalar-mixer chans val)
+ (let ((m (make-float-vector (* chans chans) 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i chans) m)
+ (set! (m (+ (* i chans) i)) val))))
+
+(define (make-sound-data c f)
+ (make-float-vector (list c f)))
+
+(define (mixer . args)
+ (apply make-mixer (floor (sqrt (length args))) args))
+
+(define mixer+ frame+)
+
+(define (mixer-ref mx i j)
+ (mx (+ (* i (mixer-rows mx)) j)))
+
+(define (mixer-set! mx i j val)
+ (set! (mx (+ (* i (mixer-rows mx)) j)) val))
+
+(define (mixer? obj)
+ (and (float-vector? obj)
+ (= (vector-rank obj) 1)
+ (let ((d (mixer-rows mx)))
+ (= (* d d) (length obj)))))
+
+(define* (mixer* m1 m2 m3)
+ (let ((rows (mixer-rows m1))
+ (m4 (or m3 (make-float-vector (length m1)))))
+ (do ((i 0 (+ i 1)))
+ ((= i rows) m4)
+ (do ((j 0 (+ j 1)))
+ ((= j rows))
+ (let ((sum 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k rows))
+ (set! sum (+ sum (* (m1 (+ (* i rows) k)) (m2 (+ (* k rows) j))))))
+ (set! (m4 (+ (* i rows) j)) sum))))))
+
+(define multiply-arrays float-vector-multiply!)
+
+(define mus-sound-frames mus-sound-framples)
+
+(define region-frames region-framples)
+
+(define selection-frames selection-framples)
+
+(define (sound-data+ x1 x2)
+ (if (real? x1)
+ (if (real? x2)
+ (+ x1 x2)
+ (float-vector-offset! x2 x1))
+ (if (real? x2)
+ (float-vector-offset! x1 x2)
+ (float-vector-add! x1 x2))))
+
+(define (sound-data* x1 x2)
+ (if (real? x1)
+ (if (real? x2)
+ (* x1 x2)
+ (float-vector-scale! x2 x1))
+ (if (real? x2)
+ (float-vector-scale! x1 x2)
+ (float-vector-multiply! x1 x2))))
+
+(define sound-data-add! float-vector-add!)
+
+(define (sound-data-chans s)
+ ((vector-dimensions s) 0))
+
+(define sound-data-copy copy)
+
+(define sound-data-fill! fill!)
+
+(define (sound-data-length s)
+ ((vector-dimensions s) 1))
+
+(define (sound-data-maxamp s)
+ (let* ((chans (sound-data-chans s))
+ (maxamps (make-list chans)))
+ (do ((i 0 (+ i 1)))
+ ((= i chans) maxamps)
+ (set! (maxamps i) (float-vector-peak (s i))))))
+
+(define sound-data-multiply! float-vector-multiply!)
+
+(define sound-data-offset! float-vector-offset!)
+
+(define sound-data-peak float-vector-peak)
+
+(define sound-data-ref float-vector-ref)
+
+(define (sound-data-reverse! s)
+ (let ((chans (sound-data-chans s)))
+ (do ((i 0 (+ i 1)))
+ ((= i chans) s)
+ (reverse! (s i)))))
+
+(define sound-data-scale! float-vector-scale!)
+
+(define sound-data-set! float-vector-set!)
+
+(define (sound-data? s)
+ (and (float-vector? s)
+ (= (vector-rank s) 2)))
+
+(define transform-frames transform-framples)
+
+(define vct-copy copy)
+(define vct-fill! fill!)
+(define vct float-vector)
+(define vct-length length)
+(define vct-reverse! reverse!) ; slight difference: no optional length arg (use make-shared-vector)
+(define vct->list vector->list)
+(define (list->vct x) (apply float-vector x))
+(define make-vct make-float-vector)
+(define (vector->vct v) (copy v (make-float-vector (length v))))
+(define (vct->vector v) (copy v (make-vector (length v))))
+(define vct? float-vector?)
diff --git a/snd15.scm b/snd15.scm
new file mode 100644
index 0000000..0e69437
--- /dev/null
+++ b/snd15.scm
@@ -0,0 +1,31 @@
+(define vct-multiply! float-vector-multiply!)
+(define vct-scale! float-vector-scale!)
+(define vct-abs! float-vector-abs!)
+(define vct-add! float-vector-add!)
+(define vct-subtract! float-vector-subtract!)
+(define vct-offset! float-vector-offset!)
+(define vct-peak float-vector-peak)
+(define vct-peak-and-location float-vector-peak-and-location)
+(define vct-move! float-vector-move!)
+(define vct-subseq float-vector-subseq)
+(define vct->string float-vector->string)
+(define vct* float-vector*)
+(define vct+ float-vector+)
+(define vct-max float-vector-max)
+(define vct-min float-vector-min)
+(define vct-ref float-vector-ref)
+(define vct-set! float-vector-set!)
+(define region->vct region->float-vector)
+(define mix-vct mix-float-vector)
+(define transform->vct transform->float-vector)
+(define vct->channel float-vector->channel)
+(define channel->vct channel->float-vector)
+
+(define data-format sample-type)
+(define mus-sound-data-format mus-sound-sample-type)
+(define mus-data-format-name mus-sample-type-name)
+(define mus-data-format->string mus-sample-type->string)
+(define default-output-data-format (dilambda
+ (lambda () *default-output-sample-type*)
+ (lambda (val) (set! *default-output-sample-type* val))))
+
diff --git a/snd9.scm b/snd9.scm
deleted file mode 100644
index 85b7a2d..0000000
--- a/snd9.scm
+++ /dev/null
@@ -1,305 +0,0 @@
-;;; backwards compatibility for snd 9
-
-(provide 'snd-snd9.scm)
-
-
-;;; -------- cosine-summation (a simpler version of sine-summation)
-;;;
-;;; from Andrews, Askey, Roy "Special Functions" 5.1.16
-
-(define (cosine-summation gen r)
- "(cosine-summation gen r) is a variant of the CLM sine-summation generator; 'r' controls successive sinusoid amplitudes"
- (let* ((rr (* r r))
- (rr+1 (+ 1.0 rr))
- (rr-1 (- 1.0 rr))
- (r2 (* 2 r)))
- (* (- (/ rr-1
- (- rr+1
- (* r2 (oscil gen))))
- 1.0)
- (/ (- 1.0 r) ; amplitude normalization (not vital)
- r2))))
-
-(define make-cosine-summation make-oscil)
-
-;;; (let ((gen (make-cosine-summation 100.0))) (map-channel (lambda (y) (* .2 (cosine-summation gen 0.5)))))
-
-
-;;; -------- kosine-summation
-;;;
-;;; from Askey "Ramanujan and Hypergeometric Series" in Berndt and Rankin "Ramanujan: Essays and Surveys" p283
-;;;
-;;; this gives a sum of cosines of decreasing amp where the "k" parameter determines
-;;; the "index" (in FM nomenclature) -- higher k = more cosines; the actual amount
-;;; of the nth cos involves hypergeometric series (looks like r^n/n! (~=e^n?) with a million other terms).
-
-(define (kosine-summation gen r k)
- "(kosine-summation gen r k) is a variant of ncos; 'r' controls successive sinusoid amplitude; 'k' controls how many sinusoids are produced"
- (* (expt (- (+ 1.0 (* r r))
- (* 2 r (oscil gen)))
- (- k))
- (expt (- (+ 1.0 (* r r)) (* 2 r)) k))) ; amplitude normalization
-
-(define make-kosine-summation make-oscil)
-
-;;; (let ((gen (make-kosine-summation 100.0))) (map-channel (lambda (y) (* .2 (kosine-summation gen 0.5 5.0)))))
-;;;
-;;; there is still noticable DC offset if r != 0.5 -- could precompute it and subtract
-
-
-;;; -------- legendre, fejer, poussin, jackson
-
-(define (fejer-sum angle n)
- "(fejer-sum angle n) produces a band-limited pulse train"
- ;; from "Trigonometric Series" Zygmund p88 with changes suggested by Katznelson "Introduction to Harmonic Analysis" p12, and
- ;; scaling by an extra factor of 1/n+1 to make sure we always peak at 1.0 (I assume callers in this context are interested
- ;; in the pulse-train aspect and want easily predictable peak amp). Harmonics go as (n-i)/n+1.
- (if (< (abs angle) 1.0e-9)
- 1.0
- (let ((val (/ (sin (* 0.5 (+ n 1) angle))
- (* (+ n 1)
- (sin (* 0.5 angle))))))
- (* val val))))
-
-;;; here's Zygmund's version:
-;; (if (< (abs angle) 1.0e-9)
-;; 1.0
-;; (let ((val (/ (sin (* 0.5 (+ n 1) angle)) (* 2 (sin (* 0.5 angle))))))
-;; (* 2 (/ (* val val) (+ n 1))))))
-
-;;; (let ((angle 0.0)) (map-channel (lambda (y) (let ((val (fejer-sum angle 3))) (set! angle (+ angle .1)) (* .1 val)))))
-
-(define (poussin-sum angle n)
- "(poussin-sum angle n) produces a pulse train"
- ;; this and next taken from Katznelson p16
- (- (* 2 (fejer-sum angle (+ (* 2 n) 1)))
- (fejer-sum angle n)))
-
-(define (jackson-sum angle n)
- "(poussin-sum angle n) produces a pulse train"
- (let ((val (fejer-sum angle n)))
- (* val val))) ; we already normalized this to 1.0
-
-(define (legendre-sum angle n)
- "(legendre-sum angle n) produces a band-limited pulse train"
- ;; from Andrews, Askey, Roy "Special Functions" p 314 with my amplitude scaling
- (if (< (abs angle) 1.0e-9)
- 1.0
- (let* ((val (/ (sin (* angle (+ n 0.5)))
- (* (sin (* 0.5 angle))
- (+ (* 2 n) 1))))) ; amplitude normalization -- we want a peak amp of 1.0
- (* val val))))
-
-;;; (let ((angle 0.0)) (map-channel (lambda (y) (let ((val (legendre-sum angle 3))) (set! angle (+ angle .1)) (* .1 val)))))
-
-
-
-;;; -------- variations on ncos
-;;; from "Trigonometric Delights" by Eli Maor
-
-(define (sum-of-n-sines angle n)
- "(sum-of-n-sines angle n) produces the sum of 'n' sines"
- (let* ((a2 (* angle 0.5))
- (den (sin a2)))
- (if (< (abs den) 1.0e-9)
- 0.0
- (/ (* (sin (* n a2)) (sin (* (+ 1 n) a2))) den))))
-
-;;; identical to this is the "conjugate Dirichlet kernel" from "Trigonometric Series" Zygmund p49
-;;; (let* ((a2 (* 0.5 angle))
-;;; (den (* 2 (sin a2))))
-;;; (if (< (abs den) 1.0e-9)
-;;; 0.0
-;;; (/ (- (cos a2) (cos (* (+ n 0.5) angle))) den))))
-
-
-;(let ((angle 0.0)) (map-channel (lambda (y) (let ((val (sum-of-n-sines angle 3))) (set! angle (+ angle .1)) (* .1 val)))))
-
-(define (sum-of-n-odd-sines angle n)
- "(sum-of-n-odd-sines angle n) produces the sum of 'n' odd-numbered sines"
- (let ((den (sin angle))
- (na (sin (* n angle))))
- (if (< (abs den) 1.0e-9)
- 0.0
- (/ (* na na) den))))
-
-(define (sum-of-n-odd-cosines angle n)
- "(sum-of-n-odd-cosines angle n) produces the sum of 'n' odd-numbered cosines"
- (let ((den (* 2 (sin angle))))
- (if (< (abs den) 1.0e-9)
- (exact->inexact n) ; just guessing -- floatification is for the run macro
- (/ (sin (* 2 n angle)) den))))
-
-;;; (Gradshteyn and Ryzhik 1.342)
-
-;;; or take advantage of 1/(1-x):
-;;; (map-channel (lambda (y) (set! i (+ 1 i)) (/ 0.001 (- 1.0 (* .99 (cos (/ (* i 2.0 pi) 100.0)))))))
-;;; here the .99 controls the number of cosines, like an "index", and it can be matched at
-;;; run time to keep the amplitude constant via the 0.001 (set above to get a maxamp of .1),
-;;; and the frequency can be swept without problems.
-
-
-;;; and another...
-(define (band-limited-sawtooth x a N fi)
- "(band-limited-sawtooth x a N fi) produces a band-limited sawtooth; 'x' is the current phase, 'a' is \
-the amp (more or less), 'N' is 1..10 or thereabouts, 'fi' is the phase increment"
- ;; Alexander Kritov suggests time-varying "a" is good (this is a translation of his code)
- ;; from Stilson/Smith apparently -- was named "Discrete Summation Formula" which doesn't convey anything to me
- (let ((s4 (+ 1.0 (* -2.0 a (cos x)) (* a a))))
- (if (< (abs s4) 1.0e-9)
- 0.0
- (let* ((s1 (* (expt a (- N 1.0)) (sin (+ (* (- N 1.0) x) fi))))
- (s2 (* (expt a N) (sin (+ (* N x) fi))))
- (s3 (* a (sin (+ x fi)))))
- (/ (+ (sin fi) (- s3) (- s2) s1) s4)))))
-
-;;; (let ((angle 0.0)) (map-channel (lambda (y) (let ((val (band-limited-sawtooth angle 0.5 8 .2))) (set! angle (+ angle .2)) val))))
-
-
-;;; square-wave in the same mold
-
-(define (band-limited-square-wave theta n)
- "(band-limited-square-wave theta n) produces a square-wave; 'n' sets how squared-off it is, 'theta' is instantaneous phase"
- (tanh (* n (sin theta))))
-
-;;; (let ((angle 0.0)) (map-channel (lambda (y) (let ((val (band-limited-square-wave angle 10))) (set! angle (+ angle .2)) val))))
-
-
-
-
-(define mus-phase-vocoder-outctr
- (make-procedure-with-setter
- (lambda (gen)
- (mus-location gen))
- (lambda (gen val)
- (set! (mus-location gen) val))))
-
-
-
-;;; -------- mfilter -- this has now been implemented in CLM as firmant
-
-;;; Mathews/Smith High-Q filter as described in http://ccrma.stanford.edu/~jos/smac03maxjos/
-
-(defgenerator mflt
- (decay 0.99 :type float)
- (frequency 1000.0 :type float)
- (eps 0.0 :type float)
- (xn 0.0 :type float)
- (yn 0.0 :type float))
-
-(define* (make-mfilter (decay .99) (frequency 1000.0))
- (make-mflt :decay decay
- :frequency frequency
- :eps (* 2.0 (sin (/ (* pi frequency) (mus-srate))))))
-
-(define (mfilter-1 m x-input y-input)
- (let* ((xn1 (+ x-input
- (* (mflt-decay m) (- (mflt-xn m)
- (* (mflt-eps m) (mflt-yn m))))))
- (yn1 (+ y-input
- (* (mflt-decay m) (+ (* (mflt-eps m) xn1) (mflt-yn m))))))
- (set! (mflt-xn m) xn1)
- (set! (mflt-yn m) yn1)
- yn1))
-
-(define* (mfilter m (x-input 0.0) (y-input 0.0))
- ;; assume the "b1" business is handled by the caller
- (mfilter-1 m x-input y-input))
-
-#|
-(with-sound ()
- (let ((rd (make-sampler 0 "now.snd"))
- (m (make-mfilter)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (mfilter m (* .1 (rd))))))))
-
-;;; sweep center freq:
-(with-sound ()
- (let ((rd (make-sampler 0 "oboe.snd"))
- (m (make-mfilter :decay .99 :frequency 1000))
- (e (make-env '(0 100 1 2000) :length 10000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (outa i (mfilter m (* .1 (rd))))
- (set! (mflt-eps m) (* 2.0 (sin (/ (* pi (env e)) (mus-srate)))))))))
-
-;;; harmonics:
-(with-sound (:statistics #t)
- (let* ((filters (make-vector 9))
- (noi (make-rand 10000)))
- (do ((i 0 (+ 1 i)))
- ((= i 9))
- (vector-set! filters i (make-mfilter :decay .999 :frequency (* 400 (+ i 1)))))
- (run
- (declare (clm-vector filters))
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (let ((sum 0.0)
- (input (* .01 (rand noi))))
- (do ((j 0 (+ 1 j)))
- ((= j 9))
- (set! sum (+ sum (* (/ 1.0 (+ j 1)) (mfilter (vector-ref filters j) input)))))
- (outa i sum))))))
-|#
-
-
-
-
-(define mus-formant-radius
- (make-procedure-with-setter
- (lambda (gen)
- (mus-scaler gen))
- (lambda (gen val)
- (set! (mus-scaler gen) val))))
-
-(define mus-cosines
- (make-procedure-with-setter
- (lambda (gen)
- (length gen))
- (lambda (gen val)
- (set! (length gen) val))))
-
-
-(define* (old-make-formant (radius .5) (freq 0.0) gain)
- (if gain (snd-warning "make-formant gain argument is now ignored"))
- (make-formant freq radius))
-
-
-(define* (make-ppolar (radius 0.9) (frequency 440.0))
- (make-two-pole :frequency frequency :radius radius))
-
-(define* (make-zpolar (radius 0.9) (frequency 440.0))
- (make-two-zero :frequency frequency :radius radius))
-
-
-;;; -------- smoothing-filter
-
-;;; a simple modification is to round-off the edges:
-
-(define make-smoothing-filter make-moving-average)
-
-(define (smoothing-filter gen sig)
- (let* ((val (moving-average gen sig))
- (old-sig (tap gen))
- (n (mus-order gen)))
- (* (/ n (- n 1)) ; scale back to 1.0
- (- val (* (mus-increment gen) 0.5 (+ old-sig sig))))))
-
-
-;;; -------- sine-bank
-
-(define* (sine-bank amps phases size)
- (let ((len (or size (length amps)))
- (sum 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (set! sum (+ sum (* (vct-ref amps i)
- (sin (vct-ref phases i))))))
- sum))
-
-
-
-
\ No newline at end of file
diff --git a/sndclm.html b/sndclm.html
index d3517a5..f236cfa 100644
--- a/sndclm.html
+++ b/sndclm.html
@@ -1,17 +1,19 @@
-<html>
+<!DOCTYPE html>
+
+<html lang="en">
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>CLM</title>
<style type="text/css">
-<!--
EM.red {color:red; font-style: normal}
EM.gen {font-weight: bold; font-style: normal}
EM.error {color:chocolate; font-style: normal}
EM.narg {color:chocolate; font-style: normal}
- EM.typing {color:maroon; font-style: normal}
- EM.listener {color:darkblue; font-style: normal}
H1 {text-align: center}
+ DIV.centered {text-align: center}
UL {list-style-type: none}
EM.emdef {font-weight: bold; font-style: normal; padding-right: 0.2cm}
+ EM.noem {font-style: normal}
A {text-decoration:none}
A:hover {text-decoration:underline}
@@ -21,7 +23,195 @@
A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black; padding-right: 0.2cm}
A.olddef {font-style: normal; text-decoration:none; color:gray; padding-right: 0.2cm}
EM.gray {color:gray; font-style: normal}
--->
+ EM.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black; padding-right: 0.2cm}
+
+ TD.green {background-color: lightgreen}
+ PRE.bluish {background-color: #f2f4ff}
+ TD.beige {background-color: beige}
+ TD.greenish {background-color: #eefdee}
+ PRE.indented {padding-left: 1.0cm}
+ IMG.indented {margin-left: 2.0cm}
+
+ TH.beige {background-color: beige;
+ border: 1px solid black;
+ padding-left: 0.2cm;
+ padding-right: 0.2cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TD.br {border: 1px solid lightgray;
+ padding-left: 0.2cm;
+ padding-right: 0.2cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TD.hightop {padding-top: 0.5cm;
+ }
+ IMG.noborder {border: none}
+ DIV.center {text-align: center}
+ DIV.scheme {background-color: #f2f4ff;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.ruby {background-color: #fbfbf0;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.forth {background-color: #eefdee;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.c {background-color: #f0f0f0;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.lisp {background-color: aliceblue;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+
+ BODY.body {background-color: #ffffff; /* white */
+ margin-left: 0.5cm;
+ margin-right: 0.5cm;
+ }
+ TABLE.borderspaced {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 0.5cm;
+ border: 8px solid gray;
+ }
+ TABLE.pb {margin-top: 0.1cm;
+ margin-bottom: 0.5cm;
+ margin-left: 2.0cm;
+ border: 2px solid gray;
+ padding-left: 0.2cm;
+ padding-right: 0.2cm;
+ padding-top: 0.2cm;
+ padding-bottom: 0.2cm;
+ }
+ TABLE.grayborder {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 1.0cm;
+ border: 8px solid gray;
+ padding-left: 0.1cm;
+ padding-right: 0.1cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TABLE.contents {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 1.0cm;
+ border: 8px solid lightgray;
+ padding-left: 0.1cm;
+ padding-right: 0.1cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TABLE.method {margin-top: 0.2cm;
+ margin-bottom: 0.5cm;
+ margin-left: 1.0cm;
+ border: 1px solid gray;
+ padding-left: 0.1cm;
+ padding-right: 0.1cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TD.sumtitle {background-color: #eefdee;
+ border: 1px solid lightgray;
+ padding-top: 0.2cm;
+ padding-bottom: 0.2cm;
+ text-align: center;
+ }
+ TD.methodtitle {background-color: beige;
+ border: 1px solid gray;
+ padding-top: 0.2cm;
+ padding-bottom: 0.2cm;
+ text-align: center;
+ }
+ TD.inner {padding-right: 0.5cm;
+ padding-top: 0.1cm;
+ }
+ TD.center {text-align: center}
+ DIV.separator {margin-top: 40px;
+ margin-bottom: 15px;
+ border: 2px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ padding-top: 4px;
+ width: 30%;
+ border-radius: 4px;
+ -moz-border-radius: 4px;
+ -webkit-border-radius: 4px;
+ }
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.header {margin-top: 50px;
+ margin-bottom: 10px;
+ font-size: 20px;
+ font-weight: bold;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ text-align: center;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.innerheader {margin-top: 60px;
+ margin-bottom: 30px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #eefdee; /* lightgreen */
+ padding-left: 30px;
+ width: 50%;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.related {text-align:center;
+ border: 1px solid lightgray;
+ margin-top: 1.0cm;
+ margin-bottom: 1.0cm;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ background-color: #f0f0f0;
+ }
+ DIV.inset {margin-left: 2.0cm;
+ margin-right: 2.0cm;
+ margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ background-color: #f0f0f0;
+ padding-left: 0.25cm;
+ padding-right: 0.25cm;
+ padding-top: 0.25cm;
+ padding-bottom: 0.25cm;
+ }
+ DIV.inset_inline {background-color: #f0f0f0;
+ display: inline;
+ margin-left: 2.0cm;
+ padding-left: 0.25cm;
+ padding-right: 0.25cm;
+ padding-top: 0.25cm;
+ padding-bottom: 0.25cm;
+ }
+ DIV.contentscenter {text-align: center;
+ padding-top: 0.25cm;
+ padding-bottom: 0.25cm;
+ border: 1px solid gray;
+ }
+ TD.ic {
+ padding-left: 0.5cm;
+ padding-right: 0.1cm;
+ }
+</style>
+
<!-- the latex stuff is always embedded in:
@@ -56,174 +246,133 @@ before calling pdf2png
pdf2png is in the cairo tarball (cairo/test dir)
-->
-</style>
</head>
-<body bgcolor=white>
+<body class="body">
-<script language=JavaScript type="text/javascript" src="wz_tooltip.js"></script>
-<script language=JavaScript type="text/javascript" src="wz_data.js"></script>
-<A NAME="sndclmtop"></A><h1>CLM</h1>
+<div class="topheader" id="sndclmtop">CLM</div>
+
<p>CLM (originally an acronym for Common Lisp Music) is a sound synthesis
package in the Music V family. This file describes CLM as implemented in Snd,
-aiming primarily at the Scheme version. Common Lisp users should check out clm.html
-in the CLM tarball.
+aiming primarily at the Scheme version.
CLM is based on a set of functions known
as "generators". These can be packaged into "instruments", and instrument calls
can be packaged into "note lists". (These names are just convenient historical artifacts).
The main emphasis here is on the generators;
note lists and instruments are described in <a href="sndscm.html">sndscm.html</a>.
</p>
-<br>
-
-
-<center>Bill Schottstaedt (bil at ccrma.stanford.edu)</center>
-<br>
-
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
-
-<br>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>Contents</h2></td></tr></table>
-</td></tr></table>
-
-<br>
-<table border=8 bordercolor="lightsteelblue" cellpadding=8 hspace=20>
-
-<tr><td colspan=3><center><a href="#introduction">Introduction</a></center></td></tr>
-
-<tr><td colspan=3><center><a href="#generators">Built-in Generators</a></center></td></tr>
-
-<tr><td width=20 bgcolor="#f2f4ff"></td><td>
-<table border=0 cellpadding=0>
- <tr><td><a href="#all-passdoc">all-pass</a></td><td width=20></td><td>all-pass filter</td></tr>
- <tr><td><a href="#asymmetric-fmdoc">asymmetric-fm</a></td><td></td><td>asymmetric fm</td></tr>
- <tr><td><a href="#combdoc">comb</a></td><td></td><td>comb filter</td></tr>
- <tr><td><a href="#convolvedoc">convolve</a></td><td></td><td>convolution</td></tr>
- <tr><td><a href="#delaydoc">delay</a></td><td></td><td>delay line</td></tr>
- <tr><td><a href="#envdoc">env</a></td><td></td><td>line segment envelope</td></tr>
- <tr><td><a href="#filetosampledoc">file->sample</a></td><td></td><td>input sample from file</td></tr>
- <tr><td><a href="#filetoframe">file->frame</a></td><td></td><td>input frame from file</td></tr>
- <tr><td><a href="#filterdoc">filter</a></td><td></td><td>direct form FIR/IIR filter</td></tr>
- <tr><td><a href="#combdoc">filtered-comb</a></td><td></td><td>comb filter with filter on feedback</td></tr>
- <tr><td><a href="#fir-filterdoc">fir-filter</a></td><td></td><td>FIR filter</td></tr>
- <tr><td><a href="#formantdoc">formant and firmant</a></td><td></td><td>resonance</td></tr>
- <tr><td><a href="#frametofile">frame->file</a></td><td></td><td>output frame to file</td></tr>
- <tr><td><a href="#granulatedoc">granulate</a></td><td></td><td>granular synthesis</td></tr>
- <tr><td><a href="#iir-filterdoc">iir-filter</a></td><td></td><td>IIR filter</td></tr>
- <tr><td><a href="#in-anydoc">in-any</a></td><td></td><td>sound file input</td></tr>
- <tr><td><a href="#locsigdoc">locsig</a></td><td></td><td>static sound placement</td></tr>
- <tr><td><a href="#move-sounddoc">move-sound</a></td><td></td><td>sound motion</td></tr>
- <tr><td><a href="#moving-averagedoc">moving-average</a></td><td></td><td>moving window average</td></tr>
- <tr><td><a href="#ncosdoc">ncos</a></td><td></td><td>n equal amplitude cosines</td></tr>
- <tr><td><a href="#notchdoc">notch</a></td><td></td><td>notch filter</td></tr>
- <tr><td><a href="#nrxydoc">nrxycos</a></td><td></td><td>n scaled cosines</td></tr>
-</table>
-</td>
-<td>
-<table border=0 cellpadding=0>
- <tr><td><a href="#nrxydoc">nrxysin</a></td><td></td><td>n scaled sines</td></tr>
- <tr><td><a href="#ncosdoc">nsin</a></td><td></td><td>n equal amplitude sines</td></tr>
- <tr><td><a href="#one-poledoc">one-pole</a></td><td></td><td>one pole filter</td></tr>
- <tr><td><a href="#one-zerodoc">one-zero</a></td><td></td><td>one zero filter</td></tr>
- <tr><td><a href="#oscildoc">oscil</a></td><td></td><td>sine wave and FM</td></tr>
- <tr><td><a href="#out-anydoc">out-any</a></td><td width=20></td><td>sound output</td></tr>
- <tr><td><a href="#phase-vocoderdoc">phase-vocoder</a></td><td></td><td>vocoder analysis and resynthesis</td></tr>
- <tr><td><a href="#polyshapedoc">polyshape and polywave</a></td><td></td><td>waveshaping</td></tr>
- <tr><td><a href="#sawtoothdoc">pulse-train</a></td><td></td><td>pulse train</td></tr>
- <tr><td><a href="#randdoc">rand, rand-interp</a></td><td></td><td>random numbers, noise</td></tr>
- <tr><td><a href="#readindoc">readin</a></td><td></td><td>sound input</td></tr>
- <tr><td><a href="#sampletofile">sample->file</a></td><td></td><td>output sample to file</td></tr>
- <tr><td><a href="#sawtoothdoc">sawtooth-wave</a></td><td></td><td>sawtooth</td></tr>
- <tr><td><a href="#sawtoothdoc">square-wave</a></td><td></td><td>square wave</td></tr>
- <tr><td><a href="#srcdoc">src</a></td><td></td><td>sampling rate conversion</td></tr>
- <tr><td><a href="#ssb-amdoc">ssb-am</a></td><td></td><td>single sideband amplitude modulation</td></tr>
- <tr><td><a href="#table-lookupdoc">table-lookup</a></td><td></td><td>interpolated table lookup</td></tr>
- <tr><td><a href="#delaydoc">tap</a></td><td></td><td>delay line tap</td></tr>
- <tr><td><a href="#sawtoothdoc">triangle-wave</a></td><td></td><td>triangle wave</td></tr>
- <tr><td><a href="#two-poledoc">two-pole</a></td><td></td><td>two pole filter</td></tr>
- <tr><td><a href="#two-zerodoc">two-zero</a></td><td></td><td>two zero filter</td></tr>
- <tr><td><a href="#wave-traindoc">wave-train</a></td><td></td><td>wave train</td></tr>
-</table>
-</td></tr>
-
-<tr><td colspan=3><center><a href="#genericfunctions">Generic Functions</a></center></td></tr>
-
-<tr><td colspan=3><center><a href="#othergenerators">Other Generators</a></center></td></tr>
-
-<tr><td colspan=3><center><a href="#otherfunctions">Other Functions</a></center></td></tr>
-
-<tr><td width=20 bgcolor="#f2f4ff"></td><td>
-<table border=0 cellpadding=0>
- <tr><td><a href="#autocorrelate">autocorrelate</a></td><td></td><td>autocorrelation</td></tr>
- <tr><td><a href="#amplitude-modulate">amplitude-modulate</a></td><td></td><td>sig1 * (car + sig2)</td></tr>
- <tr><td><a href="#array-interp">array-interp</a></td><td></td><td>array interpolation</td></tr>
- <tr><td><a href="#contrast-enhancement">contrast-enhancement</a></td><td width=20></td><td>modulate signal</td></tr>
- <tr><td><a href="#convolution">convolution</a></td><td></td><td>convolve signals</td></tr>
- <tr><td><a href="#correlate">correlate</a></td><td></td><td>cross correlation</td></tr>
-</table>
-</td>
-<td>
-<table border=0 cellpadding=0>
- <tr><td><a href="#dot-product">dot-product</a></td><td></td><td>vct dot (scalar) product</td></tr>
- <tr><td><a href="#fft">fft</a></td><td></td><td>Fourier transform</td></tr>
- <tr><td><a href="#make-fft-window">make-fft-window</a></td><td></td><td>various standard windows</td></tr>
- <tr><td><a href="#polynomial">polynomial</a></td><td width=20></td><td>Horner's rule</td></tr>
- <tr><td><a href="#ring-modulate">ring-modulate</a></td><td width=20></td><td>sig * sig</td></tr>
- <tr><td><a href="#spectrum">spectrum</a></td><td width=20></td><td>power spectrum of signal</td></tr>
-</table>
-</td></tr>
+<div class="center">Bill Schottstaedt (bil at ccrma.stanford.edu)</div>
+
+
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="extsnd.html">extsnd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="fm.html">fm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
+
+
+
+<div class="header">Contents</div>
+
+
+<table class="grayborder">
+
+<tr><td colspan=4><div class="contentscenter"><a href="#introduction">Introduction</a></div></td></tr>
+
+<tr><td colspan=4><div class="contentscenter"><a href="#generators">Built-in Generators</a></div></td></tr>
+
+ <tr><td class="ic"><a href="#all-passdoc">all-pass</a></td><td class="ic">all-pass filter</td>
+ <td class="ic"><a href="#nrxydoc">nrxysin</a></td><td class="ic">n scaled sines</td></tr>
+ <tr><td class="ic"><a href="#asymmetric-fmdoc">asymmetric-fm</a></td><td class="ic">asymmetric fm</td>
+ <td class="ic"><a href="#ncosdoc">nsin</a></td><td class="ic">n equal amplitude sines</td></tr>
+ <tr><td class="ic"><a href="#combdoc">comb</a></td><td class="ic">comb filter</td>
+ <td class="ic"><a href="#one-poledoc">one-pole</a></td><td class="ic">one pole filter</td></tr>
+ <tr><td class="ic"><a href="#convolvedoc">convolve</a></td><td class="ic">convolution</td>
+ <td class="ic"><a href="#one-poledoc">one-zero</a></td><td class="ic">one zero filter</td></tr>
+ <tr><td class="ic"><a href="#delaydoc">delay</a></td><td class="ic">delay line</td>
+ <td class="ic"><a href="#oscildoc">oscil</a></td><td class="ic">sine wave and FM</td></tr>
+ <tr><td class="ic"><a href="#envdoc">env</a></td><td class="ic">line segment envelope</td>
+ <td class="ic"><a href="#in-anydoc">out-any</a></td><td class="ic">sound output</td></tr>
+ <tr><td class="ic"><a href="#filetosampledoc">file->sample</a></td><td class="ic">input sample from file</td>
+ <td class="ic"><a href="#phase-vocoderdoc">phase-vocoder</a></td><td class="ic">vocoder analysis and resynthesis</td></tr>
+ <tr><td class="ic"><a href="#filetoframple">file->frample</a></td><td class="ic">input frample from file</td>
+ <td class="ic"><a href="#polywavedoc">polyshape and polywave</a></td><td class="ic">waveshaping</td></tr>
+ <tr><td class="ic"><a href="#filterdoc">filter</a></td><td class="ic">direct form FIR/IIR filter</td>
+ <td class="ic"><a href="#sawtoothdoc">pulse-train</a></td><td class="ic">pulse train</td></tr>
+ <tr><td class="ic"><a href="#combdoc">filtered-comb</a></td><td class="ic">comb filter with filter on feedback</td>
+ <td class="ic"><a href="#randdoc">rand, rand-interp</a></td><td class="ic">random numbers, noise</td></tr>
+ <tr><td class="ic"><a href="#filterdoc">fir-filter</a></td><td class="ic">FIR filter</td>
+ <td class="ic"><a href="#readindoc">readin</a></td><td class="ic">sound input</td></tr>
+ <tr><td class="ic"><a href="#formantdoc">formant and firmant</a></td><td class="ic">resonance</td>
+ <td class="ic"><a href="#sampletofile">sample->file</a></td><td class="ic">output sample to file</td></tr>
+ <tr><td class="ic"><a href="#frampletofile">frample->file</a></td><td class="ic">output frample to file</td>
+ <td class="ic"><a href="#sawtoothdoc">sawtooth-wave</a></td><td class="ic">sawtooth</td></tr>
+ <tr><td class="ic"><a href="#granulatedoc">granulate</a></td><td class="ic">granular synthesis</td>
+ <td class="ic"><a href="#sawtoothdoc">square-wave</a></td><td class="ic">square wave</td></tr>
+ <tr><td class="ic"><a href="#filterdoc">iir-filter</a></td><td class="ic">IIR filter</td>
+ <td class="ic"><a href="#srcdoc">src</a></td><td class="ic">sampling rate conversion</td></tr>
+ <tr><td class="ic"><a href="#in-anydoc">in-any</a></td><td class="ic">sound file input</td>
+ <td class="ic"><a href="#ssb-amdoc">ssb-am</a></td><td class="ic">single sideband amplitude modulation</td></tr>
+ <tr><td class="ic"><a href="#locsigdoc">locsig</a></td><td class="ic">static sound placement</td>
+ <td class="ic"><a href="#table-lookupdoc">table-lookup</a></td><td class="ic">interpolated table lookup</td></tr>
+ <tr><td class="ic"><a href="#move-sounddoc">move-sound</a></td><td class="ic">sound motion</td>
+ <td class="ic"><a href="#delaydoc">tap</a></td><td class="ic">delay line tap</td></tr>
+ <tr><td class="ic"><a href="#moving-averagedoc">moving-average</a></td><td class="ic">moving window average</td>
+ <td class="ic"><a href="#sawtoothdoc">triangle-wave</a></td><td class="ic">triangle wave</td></tr>
+ <tr><td class="ic"><a href="#ncosdoc">ncos</a></td><td class="ic">n equal amplitude cosines</td>
+ <td class="ic"><a href="#one-poledoc">two-pole</a></td><td class="ic">two pole filter</td></tr>
+ <tr><td class="ic"><a href="#combdoc">notch</a></td><td class="ic">notch filter</td>
+ <td class="ic"><a href="#one-poledoc">two-zero</a></td><td class="ic">two zero filter</td></tr>
+ <tr><td class="ic"><a href="#nrxydoc">nrxycos</a></td><td class="ic">n scaled cosines</td>
+ <td class="ic"><a href="#wave-traindoc">wave-train</a></td><td class="ic">wave train</td></tr>
+
+<tr><td colspan=4><div class="contentscenter"><a href="#genericfunctions">Generic Functions</a></div></td></tr>
+
+<tr><td colspan=4><div class="contentscenter"><a href="#othergenerators">Other Generators</a></div></td></tr>
+
+<tr><td colspan=4><div class="contentscenter"><a href="#otherfunctions">Other Functions</a></div></td></tr>
+
+ <tr><td class="ic"><a href="#autocorrelate">autocorrelate</a></td><td class="ic">autocorrelation</td>
+ <td class="ic"><a href="#dot-product">dot-product</a></td><td class="ic">dot (scalar) product</td></tr>
+ <tr><td class="ic"><a href="#amplitude-modulate">amplitude-modulate</a></td><td class="ic">sig1 * (car + sig2)</td>
+ <td class="ic"><a href="#fft">fft</a></td><td class="ic">Fourier transform</td></tr>
+ <tr><td class="ic"><a href="#array-interp">array-interp</a></td><td class="ic">array interpolation</td>
+ <td class="ic"><a href="#make-fft-window">make-fft-window</a></td><td class="ic">various standard windows</td></tr>
+ <tr><td class="ic"><a href="#contrast-enhancement">contrast-enhancement</a></td><td class="ic">modulate signal</td>
+ <td class="ic"><a href="#polynomial">polynomial</a></td><td class="ic">Horner's rule</td></tr>
+ <tr><td class="ic"><a href="#convolution">convolution</a></td><td class="ic">convolve signals</td>
+ <td class="ic"><a href="#ring-modulate">ring-modulate</a></td><td class="ic">sig * sig</td></tr>
+ <tr><td class="ic"><a href="#correlate">correlate</a></td><td class="ic">cross correlation</td>
+ <td class="ic"><a href="#spectrum">spectrum</a></td><td class="ic">power spectrum of signal</td></tr>
+
+<tr><td colspan=4><div class="contentscenter"><a href="#instruments">Instruments</a></div></td></tr>
-<tr><td colspan=3><center><a href="#instruments">Instruments</a></center></td></tr>
</table>
-<br><br>
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A class=def NAME="introduction">Introduction</a></h2></td></tr></table>
-</td></tr></table>
-<table border=0 hspace=100 vspace=20><tr><td>
-<p><small>
-If you try to make
-new sounds, or recreate and alter existing sounds, you'll find that there are
-some functions that seem to pop up everywhere. The basic
-building block of sound is the sinusoid, so we have things like oscil and polywave.
-Another basic thing is noise, so we have rand and rand-interp.
-Sounds get louder and softer, or go up and down in pitch, so we have envelopes (env).
-We need a way to get at them (in-any, readin), and play them (out-any, locsig).
-We need tons of reverb (delay, convolve).
-</small></p></td></tr></table>
+<div class="header" id="introduction">Introduction</div>
<p>Start Snd, open the listener (choose "Show listener" in the View menu), and:
</p>
-<pre>
- <em class=listener>></em><em class=typing>(load "v.scm")</em>
- <em class=listener>fm-violin</em>
- <em class=listener>></em><em class=typing>(with-sound () (fm-violin 0 1 440 .1))</em>
- <em class=listener>"test.snd"</em>
+<pre class="indented">
+> (load "v.scm")
+fm-violin
+> (with-sound () (fm-violin 0 1 440 .1))
+"test.snd"
</pre>
-<p>Snd's printout is in blue here, and your typing is in red.
+<p>
If all went well, you should see a graph of the fm-violin's output. Click the "play" button to
hear it; click "f" to see its spectrum.
</p>
@@ -232,20 +381,20 @@ hear it; click "f" to see its spectrum.
In Ruby, we'd do it this way:
</p>
-<pre>
- <em class=listener>></em><em class=typing>load "v.rb"</em>
- <em class=listener>true</em>
- <em class=listener>></em><em class=typing>with_sound() do fm_violin_rb(0, 1.0, 440.0, 0.1) end</em>
- <em class=listener>#<With_CLM: output: "test.snd", channels: 1, srate: 22050></em>
+<pre class="indented">
+>load "v.rb"
+true
+>with_sound() do fm_violin_rb(0, 1.0, 440.0, 0.1) end
+#<With_CLM: output: "test.snd", channels: 1, srate: 22050>
</pre>
<p>and in Forth:
</p>
-<pre>
- <em class=listener>snd></em> <em class=typing>"clm-ins.fs" file-eval</em>
- <em class=listener>0</em>
- <em class=listener>snd></em> <em class=typing>0.0 1.0 440.0 0.1 ' fm-violin with-sound</em>
- <em class=listener>\ filename: test.snd</em>
+<pre class="indented">
+snd> "clm-ins.fs" file-eval
+0
+snd> 0.0 1.0 440.0 0.1 ' fm-violin with-sound
+\ filename: test.snd
</pre>
@@ -264,39 +413,25 @@ If the sound is already open, with-sound replaces it with the new version.
The body of with-sound can be any size, and can include anything that you could put in a function body.
For example,
to get an arpeggio:</p>
-<pre>
- (with-sound ()
- (do ((i 0 (+ 1 i)))
- ((= i 8))
- (fm-violin (* i .25) .5 (* 100 (+ 1 i)) .1)))
-</pre>
-
-<table border=0 hspace=40><tr><td>
-<p>If that seemed to take awhile, make sure you've turned on <a href="extsnd.html#optimization">optimization</a>:
-</p>
-
-<pre>
- <em class=listener>></em><em class=typing>(set! (optimization) 6)</em>
- <em class=listener>6</em>
+<pre class="indented">
+(with-sound ()
+ (do ((i 0 (+ i 1)))
+ ((= i 8))
+ (fm-violin (* i .25) .5 (* 100 (+ i 1)) .1)))
</pre>
-<p>The optimizer, a macro named "run", can usually speed up computations by about a factor of 10.
-</p>
-</td></tr></table>
-
-
<p>with-sound, instruments, CLM itself are all optional, of course. We could
do everything by hand:
</p>
-<pre>
- (let ((sound (<a class=quiet href="extsnd.html#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "test.snd" :size 22050))
- (increment (/ (* 440.0 2.0 pi) 22050.0))
- (current-phase 0.0))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y)
- (let ((val (* .1 (sin current-phase))))
- (set! current-phase (+ current-phase increment))
- val))))
+<pre class="indented">
+(let ((sound (<a class=quiet href="extsnd.html#newsound">new-sound</a> "test.snd" :size 22050))
+ (increment (/ (* 440.0 2.0 pi) 22050.0))
+ (current-phase 0.0))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y)
+ (let ((val (* .1 (sin current-phase))))
+ (set! current-phase (+ current-phase increment))
+ val))))
</pre>
<p>This opens a sound file (via <a href="extsnd.html#newsound">new-sound</a>) and fills it with a .1 amplitude sine wave at 440 Hz.
@@ -305,12 +440,12 @@ The "oscil" generator keeps track of the phase increment for us, so
essentially the same thing using with-sound and oscil is:
</p>
-<pre>
- (with-sound ()
- (let ((osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 440.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 44100))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .1 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc)) *output*))))
+<pre class="indented">
+(with-sound ()
+ (let ((osc (<a class=quiet href="#make-oscil">make-oscil</a> 440.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 44100))
+ (<a class=quiet href="#outa">outa</a> i (* .1 (<a class=quiet href="#oscil">oscil</a> osc)) *output*))))
</pre>
<p>*output* is the file opened by with-sound, and outa is a function that adds its second
@@ -327,13 +462,13 @@ data structure associated with the generator;
<gen>? checks whether a variable is that kind of generator.
Current generator state is accessible via various generic functions such as mus-frequency:
</p>
-<pre>
- (set! oscillator (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> :frequency 330))
+<pre class="indented">
+(set! oscillator (<a class=quiet href="#make-oscil">make-oscil</a> :frequency 330))
</pre>
<p>prepares "oscillator" to produce a sine wave
when set in motion via</p>
-<pre>
- (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> oscillator)
+<pre class="indented">
+(<a class=quiet href="#oscil">oscil</a> oscillator)
</pre>
<p>
@@ -346,8 +481,8 @@ desired.
Frequency sweeps of all kinds (vibrato, glissando, breath
noise, FM proper) are all forms of frequency modulation. So, in
normal usage, our oscillator looks something like:</p>
-<pre>
- (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> oscillator (+ vibrato glissando frequency-modulation))
+<pre class="indented">
+(<a class=quiet href="#oscil">oscil</a> oscillator (+ vibrato glissando frequency-modulation))
</pre>
<p>One special aspect of each make-<gen> function is the way it
@@ -355,8 +490,8 @@ reads its arguments. I use parenthesized parameters
in the function definitions to indicate that the argument names are
keywords, but the keywords themselves are optional.
Take the make-oscil call, defined as:</p>
-<pre>
- make-oscil (frequency *clm-default-frequency*) (initial-phase 0.0)
+<pre class="indented">
+make-oscil (frequency *clm-default-frequency*) (initial-phase 0.0)
</pre>
<p>This says that make-oscil has two optional arguments, frequency (in Hz), and
initial-phase (in radians). The keywords associated with these values are
@@ -365,17 +500,17 @@ When make-oscil is called, it scans its arguments; if a keyword is seen, that
argument and all following arguments are passed unchanged, but if a value is
seen, the corresponding keyword is prepended in the argument list:
</p>
-<pre>
- (<a class=quiet href="#make-oscil">make-oscil</a> :frequency 440.0)
- (<a class=quiet href="#make-oscil">make-oscil</a> :frequency 440.0 :initial-phase 0.0)
- (<a class=quiet href="#make-oscil">make-oscil</a> 440.0)
- (<a class=quiet href="#make-oscil">make-oscil</a> 440.0 :initial-phase 0.0)
- (<a class=quiet href="#make-oscil">make-oscil</a> 440.0 0.0)
+<pre class="indented">
+(<a class=quiet href="#make-oscil">make-oscil</a> :frequency 440.0)
+(<a class=quiet href="#make-oscil">make-oscil</a> :frequency 440.0 :initial-phase 0.0)
+(<a class=quiet href="#make-oscil">make-oscil</a> 440.0)
+(<a class=quiet href="#make-oscil">make-oscil</a> 440.0 :initial-phase 0.0)
+(<a class=quiet href="#make-oscil">make-oscil</a> 440.0 0.0)
</pre>
<p>are all equivalent, but</p>
-<pre>
- (<a class=quiet href="#make-oscil">make-oscil</a> :frequency 440.0 0.0)
- (<a class=quiet href="#make-oscil">make-oscil</a> :initial-phase 0.0 440.0)
+<pre class="indented">
+(<a class=quiet href="#make-oscil">make-oscil</a> :frequency 440.0 0.0)
+(<a class=quiet href="#make-oscil">make-oscil</a> :initial-phase 0.0 440.0)
</pre>
<p>are in error, because once we see any keyword, all the rest of the arguments have
@@ -390,141 +525,86 @@ for example), it is convenient to package up that code into a function. Our sine
could be rewritten:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (simp start end freq amp)
- (let ((os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq)))
- (do ((i start (+ 1 i)))
+ (let ((os (<a class=quiet href="#make-oscil">make-oscil</a> freq)))
+ (do ((i start (+ i 1)))
((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os)))))) ; outa output defaults to *output* so we can omit it
+ (<a class=quiet href="#outa">outa</a> i (* amp (<a class=quiet href="#oscil">oscil</a> os)))))) ; outa output defaults to *output* so we can omit it
</pre>
-</td></tr></table>
<p>Now to hear our sine wave:</p>
-<pre>
- (with-sound (:play #t) (simp 0 44100 330 .1))
+<pre class="indented">
+(with-sound (:play #t) (simp 0 44100 330 .1))
</pre>
<p>This version of "simp" forces you to think in terms of sample numbers ("start" and "end") which
are dependent on the sampling rate. Our first enhancement is to use seconds:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (simp beg dur freq amp)
- (let* ((os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq))
- (<em class=red>start</em> (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (<em class=red>end</em> (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (do ((i start (+ 1 i)))
+ (let ((os (<a class=quiet href="#make-oscil">make-oscil</a> freq))
+ (<em class=red>start</em> (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (<em class=red>end</em> (<a class=quiet href="#secondstosamples">seconds->samples</a> (+ beg dur))))
+ (do ((i start (+ i 1)))
((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os))))))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<a class=quiet href="#oscil">oscil</a> os))))))
</pre>
-</td></tr></table>
<p>Now we can use any sampling rate, and call "simp" using seconds:
</p>
-<pre>
- (with-sound (:srate 44100) (simp 0 1.0 440.0 0.1))
-</pre>
-
-<p>Our next improvement adds the "run" macro to speed up processing by about a factor of 10:
-</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
-(define (simp beg dur freq amp)
- (let* ((os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq))
- (start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (<em class=red>run</em>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os)))))))
-</pre>
-</td></tr></table>
-
-<p>Since we're using a do loop in all these examples, we could save some typing by
-defining a macro to package up the run and loop boiler-plate:
-</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
-(define-macro (run-loop start end . body)
- `(run
- (do ((i ,start (+ i 1)))
- ((= i ,end))
- , at body)))
+<pre class="indented">
+(with-sound (:srate 44100) (simp 0 1.0 440.0 0.1))
</pre>
-</td></tr></table>
-<p>and now our instrument is just:
-</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(define (simp beg dur freq amp)
- (let* ((os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq))
- (start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (<em class=red>run-loop</em> start end
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os))))))
-</pre>
-</td></tr></table>
-<p>But I think I'll stick with the do loops in this document.
-Next we turn the "simp" function into an "instrument". An instrument is
+<p>Next we turn the "simp" function into an "instrument". An instrument is
a function that has a variety of built-in actions within with-sound. The only change
is the word "definstrument":
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(<em class=red>definstrument</em> (simp beg dur freq amp)
- (let* ((os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq))
- (start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os)))))))
+ (let ((os (<a class=quiet href="#make-oscil">make-oscil</a> freq))
+ (start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (<a class=quiet href="#secondstosamples">seconds->samples</a> (+ beg dur))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<a class=quiet href="#oscil">oscil</a> os))))))
</pre>
-</td></tr></table>
<p>Now we can simulate a telephone:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (telephone start telephone-number)
(let ((touch-tab-1 '(0 697 697 697 770 770 770 852 852 852 941 941 941))
(touch-tab-2 '(0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (length telephone-number)))
- (let* ((num (list-ref telephone-number i))
- (frq1 (list-ref touch-tab-1 num))
- (frq2 (list-ref touch-tab-2 num)))
+ (let* ((num (telephone-number i))
+ (frq1 (touch-tab-1 num))
+ (frq2 (touch-tab-2 num)))
(<em class=red>simp</em> (+ start (* i .4)) .3 frq1 .1)
(<em class=red>simp</em> (+ start (* i .4)) .3 frq2 .1)))))
(with-sound () (telephone 0.0 '(7 2 3 4 9 7 1)))
</pre>
-</td></tr></table>
<p>As a last change, let's add an amplitude envelope:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (simp beg dur freq amp envelope)
- (let* ((os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq))
- (<em class=red>amp-env</em> (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> envelope :duration dur :scaler amp))
- (start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> <em class=red>amp-env</em>) (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os)))))))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (simp beg dur freq amp envelope)
+ (let ((os (<a class=quiet href="#make-oscil">make-oscil</a> freq))
+ (<em class=red>amp-env</em> (<a class=quiet href="#make-env">make-env</a> envelope :duration dur :scaler amp))
+ (start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (<a class=quiet href="#secondstosamples">seconds->samples</a> (+ beg dur))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> <em class=red>amp-env</em>) (<a class=quiet href="#oscil">oscil</a> os))))))
</pre>
-</td></tr></table>
<p>A CLM envelope is a list of (x y) break-point pairs. The
x-axis bounds are arbitrary, but it is conventional (here at ccrma) to
@@ -533,114 +613,178 @@ go from 0 to 1.0. The y-axis values are normally between -1.0 and
various different situations.
</p>
-<pre>
- (with-sound () (simp 0 2 440 .1 '(0 0 0.1 1.0 1.0 0.0)))
+<pre class="indented">
+(with-sound () (simp 0 2 440 .1 '(0 0 0.1 1.0 1.0 0.0)))
</pre>
<p>Add a few more oscils and envs, and you've got the fm-violin. You can try out a generator or a patch of generators quickly by
plugging it into the following with-sound call:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(with-sound ()
(let ((sqr (make-square-wave 100))) ; test a square-wave generator
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
(outa i (square-wave sqr)))))
</pre>
-</td></tr></table>
-<p>By the way, there's nothing special about a generator in CLM: it is a function, or perhaps more accurately, a closure.
-If such a function happens to restrict itself
-to functions that the "run" macro can handle (and this includes most of Scheme), then it will run
-nearly as fast as any built-in function. If it needs to keep on-going state around, it is simplest to use a vct
-as the generator object:
+<p>Many people find the syntax of "do" confusing. It's possible to hide that
+away in a macro:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(define (<A NAME="make-my-oscil">make-my-oscil</A> frequency) ; we want our own oscil!
- (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0.0 (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency))) ; current phase and frequency-based phase increment
+<pre class="indented">
+(define-macro (output beg dur . body)
+ `(do ((i (seconds->samples ,beg) (+ i 1)))
+ ((= i (seconds->samples (+ ,beg ,dur))))
+ (outa i (begin , at body))))
-(define (my-oscil gen fm) ; the corresponding generator
- (let ((result (sin (vct-ref gen 0)))) ; return sin(current-phase)
- (vct-set! gen 0 (+ (vct-ref gen 0) ; increment current phase
- (vct-ref gen 1) ; by frequency
- fm)) ; and FM
- result)) ; return sine wave
+(define (simp beg dur freq amp)
+ (let ((o (make-oscil freq)))
+ (output beg dur (* amp (oscil o)))))
-(with-sound ()
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (let ((osc (make-my-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 44100))
- (outa i (my-oscil osc 0.0))))))
+(with-sound ()
+ (simp 0 1 440 .1)
+ (simp .5 .5 660 .1))
</pre>
-</td></tr></table>
-<p>There are many more such generators scattered around the Snd package, most now collected in generators.scm.
-I'm also writing pure-scheme versions of the built-in generators: big-gens.scm. For comparison, here is the sinewave
-instrument in Grace (Common Music) and Snd-rt:
+<p>It's also possible to use recursion, rather than iteration:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-file "test.wav" ()
- with osc = make-oscil(440)
- loop for i below 44100
- outa(i, .1 * oscil(osc))
- end
-end
+<pre class="indented">
+(define (simp1)
+ (let ((freq (hz->radians 440.0)))
+ (let <em class=red>simp-loop</em> ((i 0) (x 0.0))
+ (outa i (sin x))
+ (if (< i 44100)
+ (<em class=red>simp-loop</em> (+ i 1) (+ x freq))))))
+
+(define <em class=red>simp2</em>
+ (let ((freq (hz->radians 440.0)))
+ (lambda* ((i 0) (x 0.0))
+ (outa i (sin x))
+ (if (< i 44100)
+ (<em class=red>simp2</em> (+ i 1) (+ x freq))))))
+</pre>
+<p>but the do-loop is faster.
+</p>
-snd-rt:
+<!--
+(define samps 44100)
-(<rt-out> :len 1 (oscil :freq 440))
+(define (simp1)
+ (let ((freq (hz->radians 440.0)))
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x freq)))
+ ((= i samps))
+ (outa i (sin x)))))
-(<rt-stalin>
- (sound :dur 1:-s
- (out (oscil :freq 440))))
-</pre>
-</td></tr></table>
+(define (simp2)
+ (let ((osc (make-oscil 440.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (outa i (oscil osc)))))
+
+(define (simp3)
+ (let ((freq (hz->radians 440.0)))
+ (let simp-loop ((i 0) (x 0.0))
+ (outa i (sin x))
+ (if (< i samps)
+ (simp-loop (+ i 1) (+ x freq))))))
+
+(define simp4
+ (let ((freq (hz->radians 440.0)))
+ (lambda* ((i 0) (x 0.0))
+ (outa i (sin x))
+ (if (< i samps)
+ (simp4 (+ i 1) (+ x freq))))))
+
+(define-macro (time a)
+ `(let ((start (get-internal-real-time)))
+ ,a
+ (* 1.0 (- (get-internal-real-time) start))))
-<br><br>
+(with-sound (:clipped #f)
+ (format *stderr* "~,4F~%" (time (simp1)))
+ (format *stderr* "~,4F~%" (time (simp2)))
+ (format *stderr* "~,4F~%" (time (simp3)))
+ (format *stderr* "~,4F~%" (time (simp4))))
+#|
+0.0044
+0.0017
+0.0165
+0.0276
+|#
+-->
<!-- INDEX generators:Generators -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h2><A class=def NAME="generators">Generators</a></h2></td></tr></table>
-<br><br>
+<div class="header" id="generators">Generators</div>
-<A NAME="oscildoc"></A>
-<!-- ---------------------------------------- OSCIL ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>oscil</h3></center></td></tr></table>
-<br>
-<pre>
- <a class=def name="make-oscil">make-oscil</a> (frequency *clm-default-frequency*) (initial-phase 0.0)
- <a class=def name="oscil">oscil</a> os (fm-input 0.0) (pm-input 0.0)
- <a class=def name="oscil?">oscil?</a> os
+
+<!-- OSCIL -->
+
+<div class="innerheader" id="oscildoc">oscil</div>
+
+<pre class="indented">
+<em class=def id="make-oscil">make-oscil</em> (frequency *clm-default-frequency*) (initial-phase 0.0)
+<em class=def id="oscil">oscil</em> os (fm-input 0.0) (pm-input 0.0)
+<em class=def id="oscil?">oscil?</em> os
+
+<em class=def id="make-oscil-bank">make-oscil-bank</em> freqs phases amps stable
+<em class=def id="oscil-bank">oscil-bank</em> os fms
+<em class=def id="oscil-bank?">oscil-bank?</em> os
+</pre>
+
+<table class="method">
+<tr><td colspan=2 class="methodtitle">oscil methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td> <td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td> <td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td> <td class="inner">1 (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td> <td class="inner">frequency in radians per sample</td></tr>
+</table>
+
+
+<p>oscil produces a sine wave (using sin) with optional frequency change (FM).
+It might be defined:
+</p>
+
+<pre class="indented">
+(let ((result (sin (+ phase pm-input))))
+ (set! phase (+ phase (<a class=quiet href="#hztoradians">hz->radians</a> frequency) fm-input))
+ result)
</pre>
+<!-- <img src="pix/sceq9.png" alt="fnm equation"> -->
+<!-- LATEX: \cos \, (\omega_{c}t+B\sin \omega_{m}t)\:=\!\!\sum_{n=-\infty}^{\infty} \! \! J_{n}(B)\cos(\omega_{c} + n\omega_{m})t -->
+<p>oscil's first argument is an oscil created by make-oscil.
+Oscil's second argument is the
+frequency change (frequency modulation), and the third argument is the
+phase change (phase modulation).
+The initial-phase argument to make-oscil is in radians. You can
+use <a href="#degreestoradians">degrees->radians</a> to convert from degrees to radians.
+To get a cosine (as opposed to sine), set the initial-phase to (/ pi 2).
+Here are examples in Scheme, Ruby, and Forth:
+</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
-<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<table><tr><td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((gen (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (oscil gen))))))
</pre>
-</td>
-
-<td width=4></td>
+</div>
+</td></tr><tr><td>
-<td bgcolor="#fbfbf0">
-<pre>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
gen = make_oscil(440.0);
44100.times do |i|
@@ -648,12 +792,11 @@ with_sound(:play, true) do
end
end.output
</pre>
-</td>
-
-<td width=4></td>
+</div>
+</td></tr><tr><td>
-<td bgcolor="#effdef">
-<pre>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 make-oscil { gen }
44100 0 do
@@ -661,79 +804,44 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
-</td>
-</tr>
-</table>
-
-
-<p>oscil produces a sine wave (using sin) with optional frequency change (FM).
-Its first argument is an oscil created by make-oscil.
-Oscil's second argument is the
-frequency change (frequency modulation), and the third argument is the
-phase change (phase modulation).
-The initial-phase argument to make-oscil is in radians. You can
-use <a href="#degreestoradians">degrees->radians</a> to convert from degrees to radians.
-To get a cosine (as opposed to sine), set the initial-phase to (/ pi 2).
-</p>
-
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>oscil methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>1 (no set!)</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-</table>
-<br>
-<pre>
- (let ((result (sin (+ phase pm-input))))
- (set! phase (+ phase (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency) fm-input))
- result)
-<!-- <img src="pix/sceq9.png" alt="fnm equation" hspace=10 vspace=10> -->
-</pre>
-<!-- LATEX: \cos \, (\omega_{c}t+B\sin \omega_{m}t)\:=\!\!\sum_{n=-\infty}^{\infty} \! \! J_{n}(B)\cos(\omega_{c} + n\omega_{m})t -->
-<br clear=left>
+</div>
+</td></tr></table>
<p>One slightly confusing aspect of oscil is that glissando has to be turned into a phase-increment envelope.
This means that the frequency envelope y values should be passed through <a href="#hztoradians">hz->radians</a>:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (simp start end freq amp frq-env)
(let ((os (make-oscil freq))
- (frqe (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> frq-env :length (+ 1 (- end start)) :scaler (<em class=red>hz->radians</em> freq))))
- (do ((i start (+ 1 i)))
+ (frqe (<a class=quiet href="#make-env">make-env</a> frq-env :length (+ 1 (- end start)) :scaler (<em class=red>hz->radians</em> freq))))
+ (do ((i start (+ i 1)))
((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (oscil os (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> <em class=red>frqe</em>)))))))
+ (<a class=quiet href="#outa">outa</a> i (* amp (oscil os (<a class=quiet href="#env">env</a> <em class=red>frqe</em>)))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (simp 0 10000 440 .1 '(0 0 1 1))) ; sweep up an octave
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (simp 0 10000 440 .1 '(0 0 1 1))) ; sweep up an octave
</pre>
-</td></tr></table>
-<p>Here is an example of FM (here the <a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> business is folded into the FM index):
+<p>Here is an example of FM (here the <a class=quiet href="#hztoradians">hz->radians</a> business is folded into the FM index):
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (simple-fm beg dur freq amp mc-ratio index amp-env index-env)
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (simple-fm beg dur freq amp mc-ratio index amp-env index-env)
+ (let* ((start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(cr (<em class=red>make-oscil</em> freq)) ; carrier
(md (<em class=red>make-oscil</em> (* freq mc-ratio))) ; modulator
- (fm-index (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (* index mc-ratio freq)))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
- (indf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)
- (<em class=red>oscil</em> cr (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf)
-
- (<em class=red>oscil</em> md)))))))))
+ (fm-index (<a class=quiet href="#hztoradians">hz->radians</a> (* index mc-ratio freq)))
+ (ampf (<a class=quiet href="#make-env">make-env</a> (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
+ (indf (<a class=quiet href="#make-env">make-env</a> (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> ampf)
+ (<em class=red>oscil</em> cr (* (<a class=quiet href="#env">env</a> indf)
+ (<em class=red>oscil</em> md))))))))
-;;; (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (simple-fm 0 1 440 .1 2 1.0))
+;;; (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (simple-fm 0 1 440 .1 2 1.0))
</pre>
-</td></tr></table>
<p><a href="fm.html">fm.html</a> has an introduction to FM.
FM and PM behave slightly differently during a glissando; FM is the more "natural" in that, left to its own devices,
@@ -742,97 +850,100 @@ up an octave, FM in channel 0, and PM in channel 1. In the first note, I fix up
keep the spectra steady, and in the second, I fix up the PM index.
</p>
-<table border=0 cellpadding=6 hspace=20>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 2)
(let* ((dur 2.0)
- (samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))
+ (samps (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))
(pitch 1000)
(modpitch 100)
(pm-index 4.0)
- (fm-index (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (* 4.0 modpitch))))
- (let* ((car1 (make-oscil pitch))
- (mod1 (make-oscil modpitch))
- (car2 (make-oscil pitch))
- (mod2 (make-oscil modpitch))
- (frqf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :duration dur))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 20 1 21 0) :duration dur :scaler .5)))
- (do ((i 0 (+ 1 i)))
+ (fm-index (<a class=quiet href="#hztoradians">hz->radians</a> (* 4.0 modpitch))))
+ (let ((car1 (make-oscil pitch))
+ (mod1 (make-oscil modpitch))
+ (car2 (make-oscil pitch))
+ (mod2 (make-oscil modpitch))
+ (frqf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1) :duration dur))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 20 1 21 0) :duration dur :scaler .5)))
+ (do ((i 0 (+ i 1)))
((= i samps))
- (let* ((frq (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf))
- (rfrq (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frq))
- (amp (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (oscil car1 (+ (* rfrq pitch)
+ (let* ((frq (<a class=quiet href="#env">env</a> frqf))
+ (rfrq (<a class=quiet href="#hztoradians">hz->radians</a> frq))
+ (amp (<a class=quiet href="#env">env</a> ampf)))
+ (<a class=quiet href="#outa">outa</a> i (* amp (oscil car1 (+ (* rfrq pitch)
(* <em class=red>fm-index (+ 1 frq)</em> ; keep spectrum the same
(oscil mod1 (* rfrq modpitch)))))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outb</a> i (* amp (oscil car2 (* rfrq pitch)
- (+ (* <em class=red>pm-index</em>
- (oscil mod2 (* rfrq modpitch)))))))))
- (let* ((car1 (make-oscil pitch))
- (mod1 (make-oscil modpitch))
- (car2 (make-oscil pitch))
- (mod2 (make-oscil modpitch))
- (frqf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :duration dur))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 20 1 21 0) :duration dur :scaler .5)))
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (let* ((frq (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf))
- (rfrq (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frq))
- (amp (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> (+ i samps) (* amp (oscil car1 (+ (* rfrq pitch)
- (* <em class=red>fm-index</em> ; let spectrum decay
- (oscil mod1 (* rfrq modpitch)))))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outb</a> (+ i samps) (* amp (oscil car2 (* rfrq pitch)
- (+ (* <em class=red>(/ pm-index (+ 1 frq))</em>
- (oscil mod2 (* rfrq modpitch)))))))))))))
+ (<a class=quiet href="#outa">outb</a> i (* amp (oscil car2 (* rfrq pitch)
+ (* <em class=red>pm-index</em> (oscil mod2 (* rfrq modpitch)))))))))
+ (let ((car1 (make-oscil pitch))
+ (mod1 (make-oscil modpitch))
+ (car2 (make-oscil pitch))
+ (mod2 (make-oscil modpitch))
+ (frqf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1) :duration dur))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 20 1 21 0) :duration dur :scaler .5)))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (let* ((frq (<a class=quiet href="#env">env</a> frqf))
+ (rfrq (<a class=quiet href="#hztoradians">hz->radians</a> frq))
+ (amp (<a class=quiet href="#env">env</a> ampf)))
+ (<a class=quiet href="#outa">outa</a> (+ i samps) (* amp (oscil car1 (+ (* rfrq pitch)
+ (* <em class=red>fm-index</em> ; let spectrum decay
+ (oscil mod1 (* rfrq modpitch)))))))
+ (<a class=quiet href="#outa">outb</a> (+ i samps) (* amp (oscil car2 (* rfrq pitch)
+ (* <em class=red>(/ pm-index (+ 1 frq))</em> (oscil mod2 (* rfrq modpitch)))))))))))
+</pre>
+
+<p>And if you read somewhere that PM can't produce a frequency shift:
+</p>
+<pre class="indented">
+(with-sound ()
+ (let ((o (make-oscil 200.0))
+ (e (make-env '(0 0 1 1) :scaler 300.0 :duration 1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 44100))
+ (outa i (oscil o 0.0 (env e))))))
</pre>
-</td></tr></table>
+
<p>To show CLM in its various embodiments, here are the Scheme, Common Lisp, Ruby, Forth, and C versions of the bird instrument;
it produces a sinusoid with (usually very elaborate) amplitude and frequency envelopes.
</p>
-<table border=2 cellpadding=6 hspace=20 vspace=20>
-<tr><td bgcolor="#f0f4ff">
-
-<table border=0 hspace=20><tr><td bgcolor="#f0f4ff">
-<pre>
+<table>
+<tr><td>
+<div class="scheme">
+<pre class="indented">
(define (scheme-bird start dur frequency freqskew amplitude freq-envelope amp-envelope)
- (let* ((gls-env (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> freq-envelope (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> freqskew) dur))
- (os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frequency))
- (amp-env (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> amp-envelope amplitude dur))
- (beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> amp-env)
- (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> gls-env))))))))
-</pre>
-</td></tr></table>
-
-</td></tr><tr><td bgcolor="#fbf4f0">
+ (let* ((gls-env (<a class=quiet href="#make-env">make-env</a> freq-envelope (<a class=quiet href="#hztoradians">hz->radians</a> freqskew) dur))
+ (os (<a class=quiet href="#make-oscil">make-oscil</a> frequency))
+ (amp-env (<a class=quiet href="#make-env">make-env</a> amp-envelope amplitude dur))
+ (beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> amp-env)
+ (<a class=quiet href="#oscil">oscil</a> os (<a class=quiet href="#env">env</a> gls-env)))))))
+</pre>
+</div>
+</td></tr><tr><td>
-<table border=0 hspace=20><tr><td bgcolor="#fbf4f0">
-<pre>
+<div class="lisp">
+<pre class="indented">
(definstrument common-lisp-bird (startime dur frequency freq-skew amplitude freq-envelope amp-envelope)
(multiple-value-bind (beg end) (times->samples startime dur)
(let* ((amp-env (make-env amp-envelope amplitude dur))
- (gls-env (make-env freq-envelope (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> freq-skew) dur))
+ (gls-env (make-env freq-envelope (<a class=quiet href="#hztoradians">hz->radians</a> freq-skew) dur))
(os (make-oscil frequency)))
(run
(loop for i from beg to end do
(outa i (* (env amp-env)
(oscil os (env gls-env)))))))))
</pre>
-</td></tr></table>
-
-</td></tr><tr><td bgcolor="#fbfbf0">
+</div>
+</td></tr><tr><td>
-<table border=0 hspace=20><tr><td bgcolor="#fbfbf0">
-<pre>
+<div class="ruby">
+<pre class="indented">
def ruby_bird(start, dur, freq, freqskew, amp, freq_envelope, amp_envelope)
gls_env = make_env(:envelope, freq_envelope, :scaler, hz2radians(freqskew), :duration, dur)
os = make_oscil(:frequency, freq)
@@ -842,12 +953,11 @@ def ruby_bird(start, dur, freq, freqskew, amp, freq_envelope, amp_envelope)
end
end
</pre>
-</td></tr></table>
-
-</td></tr><tr><td bgcolor="#effdef">
+</div>
+</td></tr><tr><td>
-<table border=0 hspace=20><tr><td bgcolor="#effdef">
-<pre>
+<div class="forth">
+<pre class="indented">
instrument: forth-bird { f: start f: dur f: freq f: freq-skew f: amp freqenv ampenv -- }
:frequency freq make-oscil { os }
:envelope ampenv :scaler amp :duration dur make-env { ampf }
@@ -859,12 +969,11 @@ instrument: forth-bird { f: start f: dur f: freq f: freq-skew f: amp freqenv amp
gls-env gen-free
;instrument
</pre>
-</td></tr></table>
-
-</td></tr><tr><td bgcolor="#f0f0f0">
+</div>
+</td></tr><tr><td>
-<table border=0 hspace=20><tr><td bgcolor="#f0f0f0">
-<pre>
+<div class="c">
+<pre class="indented">
void c_bird(double start, double dur, double frequency, double freqskew, double amplitude,
mus_float_t *freqdata, int freqpts, mus_float_t *ampdata, int amppts, mus_any *output)
{
@@ -884,22 +993,18 @@ void c_bird(double start, double dur, double frequency, double freqskew, double
mus_free(freq_env);
}
</pre>
+</div>
</td></tr></table>
-</td></tr></table>
-<p>Many of the synthesis functions in this document try to make it
+<p>Many of the CLM synthesis functions try to make it
faster or more convenient to produce a lot of sinusoids, but there
are times when nothing but a ton of oscils will do:
</p>
-<table border=1 hspace=20><tr><td>
-<table border=0 hspace=20>
-<tr><td bgcolor="#eefdee"><center>add lots of reverb!</center></td></tr>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> ()
(let* ((peaks (list 23 0.0051914 32 0.0090310 63 0.0623477 123 0.1210755 185 0.1971876
209 0.0033631 247 0.5797809 309 1.0000000 370 0.1713255 432 0.9351965
481 0.0369873 495 0.1335089 518 0.0148626 558 0.1178001 617 0.6353443
@@ -926,51 +1031,89 @@ are times when nothing but a ton of oscils will do:
(amps (make-vector len))
(ramps (make-vector len))
(freqs (make-vector len))
- (vib (<a class=quiet href="#make-rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_interp_tip)">make-rand-interp</a> 50 (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> .01)))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 10 1 11 0) :duration dur :scaler .1))
- (samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+ (vib (<a class=quiet href="#make-rand-interp">make-rand-interp</a> 50 (<a class=quiet href="#hztoradians">hz->radians</a> .01)))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 10 1 11 0) :duration dur :scaler .1))
+ (samps (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
(set! (freqs i) (peaks (* i 2)))
(set! (oscs i) (<em class=red>make-oscil</em> (freqs i) (random pi)))
(set! (amps i) (peaks (+ 1 (* 2 i))))
- (set! (ramps i) (<a class=quiet href="#make-rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_interp_tip)">make-rand-interp</a> (+ 1.0 (* i (/ 20.0 len)))
+ (set! (ramps i) (<a class=quiet href="#make-rand-interp">make-rand-interp</a> (+ 1.0 (* i (/ 20.0 len)))
(* (+ .1 (* i (/ 3.0 len))) (amps i)))))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (let ((sum 0.0)
- (fm (<a class=quiet href="#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand-interp</a> vib)))
- (do ((k 0 (+ 1 k)))
- ((= k len))
- (set! sum (+ sum (* (+ (amps k)
- (<a class=quiet href="#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand-interp</a> (ramps k)))
- (<em class=red>oscil</em> (oscs k) (* (freqs k) fm))))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) sum)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (let ((sum 0.0)
+ (fm (<a class=quiet href="#rand-interp">rand-interp</a> vib)))
+ (do ((k 0 (+ k 1)))
+ ((= k len))
+ (set! sum (+ sum (* (+ (amps k)
+ (<a class=quiet href="#rand-interp">rand-interp</a> (ramps k)))
+ (<em class=red>oscil</em> (oscs k) (* (freqs k) fm))))))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> ampf) sum))))))
</pre>
-</td></tr></table>
-</td></tr></table>
-<p>Actually, we could do this with <a href="#mus-chebyshev-tu-sum">mus-chebyshev-t-sum</a>:
+<p>oscil-bank here would be faster, or <a href="#mus-chebyshev-tu-sum">mus-chebyshev-t-sum</a>:
</p>
-<pre>
- ...
- (amps (make-vct 10607))
- (angle 0.0)
- (freq (hz->radians 1.0))
- ...
- (do ((i 0 (+ i 1))
- (k 0 (+ k 2)))
- ((= i len))
- (set! (amps (list-ref peaks k)) (list-ref peaks (+ k 1))))
- ...
- (outa i (* (env ampf) (<em class=red>mus-chebyshev-t-sum</em> angle amps)))
- (set! angle (+ angle freq (rand-interp vib)))
- ...
+<pre class="indented">
+...
+(amps (make-float-vector 10607))
+(angle 0.0)
+(freq (hz->radians 1.0))
+...
+(do ((i 0 (+ i 1))
+ (k 0 (+ k 2)))
+ ((= i len))
+ (set! (amps (peaks k)) (peaks (+ k 1))))
+...
+ (outa i (* (env ampf) (<em class=red>mus-chebyshev-t-sum</em> angle amps)))
+ (set! angle (+ angle freq (rand-interp vib)))
+...
+</pre>
+
+<p>Here's a better example: we want to start with a sum of equal amplitude harmonically
+related cosines (a sequence of spikes), and move slowly to a waveform with the same
+magnitude spectrum, but with the phases chosen to minimize the peak amplitude.
+</p>
+
+<pre class="indented">
+(let ((98-phases #(0.000000 -0.183194 0.674802 1.163820 -0.147489 1.666302 0.367236 0.494059 0.191339
+ 0.714980 1.719816 0.382307 1.017937 0.548019 0.342322 1.541035 0.966484 0.936993
+ -0.115147 1.638513 1.644277 0.036575 1.852586 1.211701 1.300475 1.231282 0.026079
+ 0.393108 1.208123 1.645585 -0.152499 0.274978 1.281084 1.674451 1.147440 0.906901
+ 1.137155 1.467770 0.851985 0.437992 0.762219 -0.417594 1.884062 1.725160 -0.230688
+ 0.764342 0.565472 0.612443 0.222826 -0.016453 1.527577 -0.045196 0.585089 0.031829
+ 0.486579 0.557276 -0.040985 1.257633 1.345950 0.061737 0.281650 -0.231535 0.620583
+ 0.504202 0.817304 -0.010580 0.584809 1.234045 0.840674 1.222939 0.685333 1.651765
+ 0.299738 1.890117 0.740013 0.044764 1.547307 0.169892 1.452239 0.352220 0.122254
+ 1.524772 1.183705 0.507801 1.419950 0.851259 0.008092 1.483245 0.608598 0.212267
+ 0.545906 0.255277 1.784889 0.270552 1.164997 -0.083981 0.200818 1.204088)))
+ (let ((freq 10.0)
+ (dur 5.0)
+ (n 98))
+ (with-sound ()
+ (let ((samps (floor (* dur 44100)))
+ (1/n (/ 1.0 n))
+ (freqs (make-float-vector n))
+ (phases (make-float-vector n (* pi 0.5))))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((off (/ (* pi (- 0.5 (98-phases i))) (* dur 44100)))
+ (h (hz->radians (* freq (+ i 1)))))
+ (set! (freqs i) (+ h off))))
+ (let ((ob (<em class=red>make-oscil-bank</em> freqs phases)))
+ (do ((i 0 (+ i 1))) ; get rid of the distracting initial click
+ ((= i 1000))
+ (<em class=red>oscil-bank</em> ob))
+ (do ((k 0 (+ k 1)))
+ ((= k samps))
+ (outa k (* 1/n (<em class=red>oscil-bank</em> ob)))))))))
</pre>
+
+
<!--
(with-sound ()
(let* ((peaks (list 23 0.0051914 32 0.0090310 63 0.0623477 123 0.1210755 185 0.1971876
@@ -999,25 +1142,28 @@ are times when nothing but a ton of oscils will do:
(vib (make-rand-interp 50 (hz->radians .01)))
(ampf (make-env '(0 0 1 1 10 1 11 0) :duration dur :scaler .1))
(samps (seconds->samples dur))
- (amps (make-vct 10607))
+ (amps (make-float-vector 10607))
(angle 0.0)
(freq (hz->radians 1.0)))
(do ((i 0 (+ i 1))
(k 0 (+ k 2)))
((= i len))
- (set! (amps (list-ref peaks k)) (list-ref peaks (+ k 1))))
+ (set! (amps (peaks k)) (peaks (+ k 1))))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(outa i (* (env ampf)
(mus-chebyshev-t-sum angle amps)))
- (set! angle (+ angle freq (rand-interp vib)))))))
+ (set! angle (+ angle freq (rand-interp vib))))))
-->
+<p>The last argument to make-oscil-bank, "stable", defaults to false. If it is
+true, oscil-bank can assume that the frequency, phase, and amplitude values passed to
+make-oscil-bank will not change over the life of the generator.
+</p>
-<p>but it seems a bit unnatural.
+<p>
Related generators are
<a href="#ncos">ncos</a>,
<a href="#nsin">nsin</a>,
@@ -1035,45 +1181,41 @@ To goof around with FM from a graphical interface, see bess.scm and bess1.scm.
</p>
-<table border=1 hspace=100 cellpadding=8><tr><td>
-<p><small>When oscil's frequency is high relative to the sampling rate,
+<p>When oscil's frequency is high relative to the sampling rate,
the waveform it produces may not look very sinusoidal. Here, for example, is oscil
at 440 Hz when the srate is 1000, 4000, and 16000:
-</small></p>
-<img src="pix/srates.png" alt="effect of different srates" hspace=40>
-</td></tr></table>
+</p>
+<img src="pix/srates.png" alt="effect of different srates">
<!--
-(set! (selected-graph-color) (make-color 1 1 1))
-(set! (selected-data-color) (make-color 0 0 0))
-(set! (axis-numbers-font) (tiny-font))
+(set! *selected-graph-color* (make-color 1 1 1))
+(set! *selected-data-color* (make-color 0 0 0))
+(set! *axis-numbers-font* *tiny-font*)
(set! (x-axis-label 0 0 0) "srate: 1000")
(set! (x-axis-label 1 0 0) "srate: 4000")
(set! (x-axis-label 2 0 0) "srate: 16000")
-(set! (axis-label-font) "12x24")
+(set! *axis-label-font* "12x24")
(with-sound (:srate 1000) ; 4000 16000
(let ((gen (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
(outa i (oscil gen)))))
-->
-<br><br>
-<A NAME="envdoc"></A>
-<!-- ---------------------------------------- ENV ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>env</h3></center></td></tr></table>
-<br>
+<!-- ENV -->
-<pre>
- <a class=def name="make-env">make-env</a>
- envelope ; list or vct of x,y break-point pairs
+<div class="innerheader" id="envdoc">env</div>
+
+<pre class="indented">
+<em class=def id="make-env">make-env</em>
+ envelope ; list or float-vector of x,y break-point pairs
(scaler 1.0) ; scaler on every y value (before offset is added)
duration ; duration in seconds
(offset 0.0) ; value added to every y value
@@ -1081,36 +1223,71 @@ at 440 Hz when the srate is 1000, 4000, and 16000:
end ; end sample number (obsolete, use length)
length ; duration in samples
- <a class=def name="env">env</a> e
- <a class=def name="env?">env?</a> e
+<em class=def id="env">env</em> e
+<em class=def id="env?">env?</em> e
- <a class=def name="env-interp">env-interp</a> x env (base 1.0) ;value of env at x
- <a class=def name="env-any">env-any</a> e connecting-function
-</pre>
+<em class=def id="env-interp">env-interp</em> x env (base 1.0) ;value of env at x
+<em class=def id="env-any">env-any</em> e connecting-function
+<em class=def id="envelopeinterp">envelope-interp</em> x env (base 1.0)
+<em class=def id="make-pulsed-env">make-pulsed-env</em> envelope duration frequency
+<em class=def id="pulsedenv">pulsed-env</em> gen (fm 0.0)
+<em class=def id="pulsedenv?">pulsed-env?</em> gen
+</pre>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">env methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-location</em></td> <td class="inner">number of calls so far on this env</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">base</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td> <td class="inner">original breakpoint list</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td> <td class="inner">scaler</td></tr>
+<tr><td class="inner"><em class=gen>mus-offset</em></td> <td class="inner">offset</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td> <td class="inner">duration in samples</td></tr>
+<tr><td class="inner"><em class=gen>mus-channels</em></td> <td class="inner">current position in the break-point list</td></tr>
+</table>
-<tr>
-<td bgcolor="#f0f4ff">
-<pre>
-(with-sound (:play #t)
- (let ((gen (make-oscil 440.0))
- (ampf (make-env
- '(0 0 .01 1 .25 .1 1 0)
- :scaler 0.5
- :length 44100)))
- (do ((i 0 (+ 1 i)))
- ((= i 44100))
- (outa i (* (env ampf) (oscil gen))))))
-</pre>
-</td>
-<td width=4></td>
+<p>An envelope is a list or float-vector of break point pairs: <code>'(0 0 100 1)</code> is
+a ramp from 0 to 1 over an x-axis excursion from 0 to 100, as is <code>(float-vector 0 0 100 1)</code>.
+This data is passed
+to make-env along with the scaler (multiplier)
+applied to the y axis, the offset added to every y value,
+and the time in samples or seconds that the x axis represents.
+make-env returns an env generator.
+env then returns the next sample of the envelope each time it is called.
+Say we want a ramp moving from .3 to .5 during 1 second.
+</p>
+<pre class="indented">
+ (make-env '(0 0 100 1) :scaler .2 :offset .3 :duration 1.0)
+ (make-env '(0 .3 1 .5) :duration 1.0)
+</pre>
+<p>
+I find the second version easier to read. The first is handy if you have a
+bunch of stored envelopes. To specify the breakpoints, you can also use the form '((0 0) (100 1)).
+</p>
-<td bgcolor="#fbfbf0">
-<pre>
+<img src="pix/pyr.png" alt="an envelope">
+<br>
+
+
+<table><tr><td>
+<div class="scheme">
+<pre class="indented">
+(with-sound (:play #t)
+ (let ((gen (make-oscil 440.0))
+ (ampf (make-env '(0 0 .01 1 .25 .1 1 0)
+ :scaler 0.5
+ :length 44100)))
+ (do ((i 0 (+ i 1)))
+ ((= i 44100))
+ (outa i (* (env ampf) (oscil gen))))))
+</pre>
+</div>
+</td></tr><tr><td>
+
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
gen = make_oscil(440.0);
ampf = make_env(
@@ -1122,12 +1299,11 @@ with_sound(:play, true) do
end
end.output
</pre>
-</td>
-
-<td width=4></td>
+</div>
+</td></tr><tr><td>
-<td bgcolor="#effdef">
-<pre>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 make-oscil { gen }
'( 0 0 0.01 1 0.25 0.1 1 0 )
@@ -1137,50 +1313,10 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
-</td>
-</tr>
-</table>
-
-
-
-
-<table border=0 hspace=40 vspace=20><tr><td>
-<table border=1 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>env methods</center></td></tr>
-<tr><td><em class=gen>mus-location</em></td><td>number of calls so far on this env</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>base</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>breakpoint list</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>scaler</td></tr>
-<tr><td><em class=gen>mus-offset</em></td><td>offset</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>duration in samples</td></tr>
-<tr><td><em class=gen>mus-channels</em></td><td>current position in the break-point list</td></tr>
-</table>
-</td><td width=50></td>
-<td>
-<img src="pix/pyr.png" alt="an envelope">
-</td>
-</tr></table>
+</div>
+</td></tr></table>
-<p>An envelope is a list or vct of break point pairs: <code>'(0 0 100 1)</code> is
-a ramp from 0 to 1 over an x-axis excursion from 0 to 100, as is <code>(<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 0 100 1)</code>.
-This data is passed
-to make-env along with the scaler (multiplier)
-applied to the y axis, the offset added to every y value,
-and the time in samples or seconds that the x axis represents.
-make-env returns an env generator.
-env then returns the next sample of the envelope each time it is called.
-Say we want a ramp moving from .3 to .5 during 1 second.
-</p>
-<pre>
- (make-env '(0 0 100 1) :scaler .2 :offset .3 :duration 1.0)
- (make-env '(0 .3 1 .5) :duration 1.0)
-</pre>
-<p>
-I find the second version easier to read. The first is handy if you have a
-bunch of stored envelopes. To specify the breakpoints, you can also use the form '((0 0) (100 1)).
-</p>
-<table border=0><tr><td>
<p>The base argument determines how the break-points are connected. If it is 1.0 (the
default), you get straight line segments. If base is 0.0, you get a step
function (the envelope changes its value suddenly to the new one without any
@@ -1189,23 +1325,23 @@ connecting the points. A base less than 1.0 gives convex curves (i.e. bowed
out), and a base greater than 1.0 gives concave curves (i.e. sagging).
If you'd rather think in terms of e^-kt, set the base to <code>(exp k)</code>.
</p>
-</td><td>
-<img src="pix/pyr03.png" alt="base .03 choice" hspace=10>
-</td><td>
-<img src="pix/pyr32.png" alt="base 32 choice" hspace=10>
-</td></tr></table>
+
+<img src="pix/pyr03.png" alt="base .03 choice">
+
+<img src="pix/pyr32.png" alt="base 32 choice">
+
<p>
You can get a lot from a couple of envelopes:
</p>
-<pre>
- <em class=listener>></em> <em class=typing>(load "animals.scm")</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em> <em class=typing>(with-sound (:play #t) (pacific-chorus-frog 0 .5))</em>
- <em class=listener>"test.snd"</em>
- <em class=listener>></em> <em class=typing>(with-sound (:play #t) (house-finch 0 .5))</em>
- <em class=listener>"test.snd"</em>
+<pre class="indented">
+> (load "animals.scm")
+#<unspecified>
+> (with-sound (:play #t) (pacific-chorus-frog 0 .5))
+"test.snd"
+> (with-sound (:play #t) (house-finch 0 .5))
+"test.snd"
</pre>
@@ -1216,50 +1352,44 @@ the output of env as the input to the connecting function. Here's an
instrument that maps the line segments into sin x^3:
</p>
-<table border=0><tr><td>
-<table border=0 hspace=20><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (mapenv beg dur frq amp en)
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frq))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (mapenv beg dur frq amp en)
+ (let* ((start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
+ (osc (<a class=quiet href="#make-oscil">make-oscil</a> frq))
(zv (<em class=red>make-env</em> <em class=red>en</em> 1.0 dur)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (let ((zval (<em class=red>env</em> zv)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i
- (* amp
- (sin (* 0.5 pi zval zval zval))
- (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc))))))))
-
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let ((zval (<em class=red>env</em> zv)))
+ (<a class=quiet href="#outa">outa</a> i
+ (* amp
+ (sin (* 0.5 pi zval zval zval))
+ (<a class=quiet href="#oscil">oscil</a> osc)))))))
+
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> ()
(mapenv 0 1 440 .5 '(0 0 50 1 75 0 86 .5 100 0)))
</pre>
-</td></tr></table>
-</td><td>
-<img src="pix/sincube.png" alt="sin cubed envelope" hspace=10>
-</td></tr></table>
+
+<img src="pix/sincube.png" alt="sin cubed envelope">
+
<!--
(define (fixup-axes)
- (set! (selected-data-color) (make-color 0 0 0))(set! (selected-data-color) (make-color 0 0 0))
- (set! (selected-graph-color) (make-color 1 1 1))
+ (set! *selected-data-color* (make-color 0 0 0))(set! *selected-data-color* (make-color 0 0 0))
+ (set! *selected-graph-color* (make-color 1 1 1))
(set! (x-axis-label 0 0) "sin^3 of '(0 0 50 1 75 0 86 .5 100 0)"))
-->
-<p>Another method is to write a function that traces out the curve you want.
+<p id="bellcurve">Another method is to write a function that traces out the curve you want.
J.C.Risset's bell curve is:</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(define <A NAME="bellcurve">(bell-curve</a> x)
+<pre class="indented">
+(define (bell-curve x)
;; x from 0.0 to 1.0 creates bell curve between .64e-4 and nearly 1.0
;; if x goes on from there, you get more bell curves; x can be
;; an envelope (a ramp from 0 to 1 if you want just a bell curve)
(+ .64e-4 (* .1565 (- (exp (- 1.0 (cos (* 2 pi x)))) 1.0))))
</pre>
-</td></tr></table>
<p>But the most flexible method is to use <b>env-any</b>.
env-any takes the env generator that produces the underlying envelope,
@@ -1268,16 +1398,13 @@ applying that connecting function between the break points.
For example, say we want to square each envelope value:
</p>
-<table border=0 hspace=40 cellpadding=10>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let ((e (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 .25 3 1 4 0)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (let ((e (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 2 .25 3 1 4 0)
:duration 0.5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>env-any</em> e (lambda (y) (* y y)))))))
-
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>env-any</em> e (lambda (y) (* y y)))))))
;; or connect the dots with a sinusoid:
@@ -1286,26 +1413,22 @@ For example, say we want to square each envelope value:
(* 0.5 (+ 1.0 (sin (+ (* -0.5 pi)
(* pi y))))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let ((e (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 .25 3 1 4 0)
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (let ((e (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 2 .25 3 1 4 0)
:duration 0.5)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i 0 (+ 1 i)))
- ((= i 44100))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (sine-env e))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 44100))
+ (<a class=quiet href="#outa">outa</a> i (sine-env e)))))
</pre>
-</td>
-<td>
<img src="pix/envany.png" alt="env-any pix">
-</td></tr>
-</table>
+
<!--
(define (fixup-axes)
- (set! (selected-data-color) (make-color 0 0 0))(set! (selected-data-color) (make-color 0 0 0))
- (set! (selected-graph-color) (make-color 1 1 1))
- (set! (axis-numbers-font) (tiny-font))
+ (set! *selected-data-color* (make-color 0 0 0))(set! *selected-data-color* (make-color 0 0 0))
+ (set! *selected-graph-color* (make-color 1 1 1))
+ (set! *axis-numbers-font* *tiny-font*)
(set! (x-axis-label 0 0) "(env-any e (lambda (y) (* y y)))")
(set! (x-axis-label 0 1) "(sine-env)"))
-->
@@ -1327,29 +1450,25 @@ an env, use <a href="#mus-location">mus-location</a>.
Here's a function that uses these methods to apply an envelope over and over:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (strum e)
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y)
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y)
(if (> (<em class=red>mus-location</em> e) (<em class=red>mus-length</em> e)) ; mus-length = dur
(<em class=red>mus-reset</em> e)) ; start env again (default is to stick at the last value)
- (* y (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> e)))))
+ (* y (<a class=quiet href="#env">env</a> e)))))
;;; (strum (make-env (list 0 0 1 1 10 .6 25 .3 100 0) :length 2000))
</pre>
-</td></tr></table>
<p>To copy an env while changing one aspect (say
duration), it's simplest to use make-env:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (change-env-dur e dur)
- (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (<a class=quiet href="#mus-data" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_data_tip)">mus-data</a> e) :scaler (<a class=quiet href="#mus-scaler" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_scaler_tip)">mus-scaler</a> e) :offset (<a class=quiet href="#mus-offset" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_offset_tip)">mus-offset</a> e) :base (<a class=quiet href="#mus-increment" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_increment_tip)">mus-increment</a> e)
+ (<a class=quiet href="#make-env">make-env</a> (<a class=quiet href="#mus-data">mus-data</a> e) :scaler (<a class=quiet href="#mus-scaler">mus-scaler</a> e) :offset (<a class=quiet href="#mus-offset">mus-offset</a> e) :base (<a class=quiet href="#mus-increment">mus-increment</a> e)
:duration dur))
</pre>
-</td></tr></table>
<p>make-env signals an error if the envelope breakpoints are either out of order, or an x axis value
occurs twice. The default error handler in with-sound may not give you the information you need to
@@ -1357,36 +1476,62 @@ track down the offending note, even given the original envelope. Here's one way
and get more info (in this case, the begin time and duration of the enclosing note):
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define* (make-env-with-catch beg dur :rest args)
(catch 'mus-error
(lambda ()
(apply <em class=red>make-env</em> args))
(lambda args
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f ";~A ~A: ~A~%" beg dur args)))))
+ (<a class=quiet>format</a> #t ";~A ~A: ~A~%" beg dur args))))
</pre>
-</td></tr></table>
+
+<p>(envelope-interp x env base) returns value of 'env' at 'x'.
+If 'base' is 0, 'env' is treated as a step function; if 'base' is 1.0 (the
+default), the breakpoints of 'env' are connected by a straight line, and
+any other 'base' connects the breakpoints with a kind of exponential
+curve:
+</p>
+
+<pre class="indented">
+> (envelope-interp .1 '(0 0 1 1))
+0.1
+> (envelope-interp .1 '(0 0 1 1) 32.0)
+0.0133617278184869
+> (envelope-interp .1 '(0 0 1 1) .012)
+0.361774730775292
+</pre>
+
+<p>The corresponding function for a CLM env generator is <a href="sndclm.html#env-interp">env-interp</a>.
+If you'd rather think in terms of e^-kt, set the 'base' to (exp k).
+</p>
+<div class="spacer"></div>
+
+
+<p>
+pulsed-env produces a repeating envelope. <a href="#env">env</a> sticks at its last value, but pulsed-env repeats it over and over.
+"duration" is the envelope duration, and "frequency" is the repeitition rate, changeable via the "fm" argument to the pulsed-env generator.
+</p>
+
<p>
An envelope applied to the amplitude of a signal is a form of amplitude modulation,
and glissando is frequency modulation. Both cause a broadening of the spectral components:
</p>
-<table border=1 hspace=40><tr>
+<table><tr>
<td>
-<img src="pix/ampenvspectrum.png" alt="amp env spectrum" onmouseout="UnTip()" onmouseover="Tip('fft size: 65536, Blackman10 window.<br><br><pre>(with-sound (:srate 10000)<br> (let* ((ampf (make-env \'(0 0 1 1 15 1 16 0) :duration 15))<br> (osc (make-oscil 50))<br> (samps (seconds->samples 15))<br> (start (seconds->samples 7))<br> (end (+ start samps)))<br> (do ((i 0 (+ 1 i)))<br> ((= i end))<br> (outa (+ i start) (* (env ampf) (oscil osc))))))</pre>')">
-</td><td width=10>
+<img src="pix/ampenvspectrum.png" alt="amp env spectrum">
</td><td>
-<img src="pix/frqenvspectrum.png" alt="frq env spectrum" onmouseout="UnTip()" onmouseover="Tip('fft size: 65536, Blackman10 window.<br><br><pre>(with-sound (:srate 10000)<br> (let* ((ampf (make-env \'(0 0 10 0 11 1 25 1 26 0 40 0) <br> :duration 40<br> :scaler (hz->radians 200)))<br> (osc (make-oscil 100))<br> (samps (seconds->samples 40))<br> (start (seconds->samples 0))<br> (end (+ start samps)))<br> (do ((i 0 (+ 1 i)))<br> ((= i end))<br> (outa (+ i start) (oscil osc (env ampf))))))<br></pre>')">
+<img src="pix/frqenvspectrum.png" alt="frq env spectrum">
</td></tr>
<tr>
-<td bgcolor="#f2f4ff"><small><center>truncated pyramid amplitude envelope<br>multiplied by sinusoid at 50Hz</center></small>
-</td><td></td>
-<td bgcolor="#f2f4ff"><small><center>truncated pyramid frquency envelope<br>sinusoid from 100Hz to 300Hz</center></small>
+<td class="center"><small>truncated pyramid amplitude envelope<br>multiplied by sinusoid at 50Hz</small>
+</td>
+<td class="center"><small>truncated pyramid frquency envelope<br>sinusoid from 100Hz to 300Hz</small>
</td>
</tr></table>
+
<!--
ampenvspectrum.png:
(with-sound (:srate 10000)
@@ -1395,16 +1540,15 @@ ampenvspectrum.png:
(samps (seconds->samples 15))
(start (seconds->samples 7))
(end (+ start samps)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i end))
- (outa (+ i start) (* (env ampf) (oscil osc)))))))
+ (outa (+ i start) (* (env ampf) (oscil osc))))))
;;; GL/ data cutoff .015 dark 78 jet invert blackman10 65536 db-100
;;; x 299 1.84 y 281 .082 z 342 1.25
;;; hop 3
-(set! (spectrum-end) .02)
-(set! (selected-graph-color) (make-color 1 1 1))
+(set! *spectrum-end* .02)
+(set! *selected-graph-color* (make-color 1 1 1))
frqenvspectrum.png:
(with-sound (:srate 10000)
@@ -1413,10 +1557,9 @@ frqenvspectrum.png:
(samps (seconds->samples 40))
(start (seconds->samples 0))
(end (+ start samps)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i end))
- (outa (+ i start) (oscil osc (env ampf)))))))
+ (outa (+ i start) (oscil osc (env ampf))))))
65536 GL blackman10 -100 dB
x 299 1.84 y 281 0.82 z 10 1.25
@@ -1433,79 +1576,114 @@ the broadening.
<br>
-<table border=3 bordercolor="tan" hspace=40 vspace=10><th bgcolor="beige">Envelopes</th><tr><td>
-<blockquote><small>
-<br>
-Various operations on envelopes: <a href="sndscm.html#envdoc">env.scm</a><br>
-<table border=0 cellpadding=0 cellspacing=0 hspace=30 vspace=6>
- <tr><td><small>add-envelopes</small></td><td width=40></td><td><small> add two envelopes</small></td></tr>
- <tr><td><small>concatenate-envelopes</small></td><td></td><td><small> concatenate a bunch of envelopes</small></td></tr>
- <tr><td><small>envelope-exp</small></td><td></td><td><small> interpolate points to approximate exponential curves</small></td></tr>
- <tr><td><small>envelope-interp</small></td><td></td><td><small> return the value of an envelope given the x position</small></td></tr>
- <tr><td><small>envelope-last-x</small></td><td></td><td><small> return the last x value in an envelope</small></td></tr>
- <tr><td><small>intergrate-envelope</small></td><td></td><td><small> return the area under an envelope</small></td></tr>
- <tr><td><small>make-power-env</small></td><td></td><td><small> exponential curves with multiple exponents (see also multi-expt-env in generators.scm)</small></td></tr>
- <tr><td><small>map-envelopes</small></td><td></td><td><small> apply a function to the breakpoints in two envelopes, returning a new envelope</small></td></tr>
- <tr><td><small>max-envelope</small></td><td></td><td><small> return the maximum y value in an envelope (also min-envelope)</small></td></tr>
- <tr><td><small>multiply-envelopes</small></td><td></td><td><small> multiply two envelopes</small></td></tr>
- <tr><td><small>normalize-envelope</small></td><td></td><td><small> scale the y values of an envelope to peak at 1.0</small></td></tr>
- <tr><td><small>repeat-envelope</small></td><td></td><td><small> concatenate copies of an envelope</small></td></tr>
- <tr><td><small>reverse-envelope</small></td><td></td><td><small> reverse the breakpoints in an envelope</small></td></tr>
- <tr><td><small>scale-envelope</small></td><td></td><td><small> scale and offset the y values of an envelope</small></td></tr>
- <tr><td><small>stretch-envelope</small></td><td></td><td><small> apply attack and decay times to an envelope ("adsr", or "divenv")</small></td></tr>
- <tr><td><small>window-envelope</small></td><td></td><td><small> return the portion of an envelope within given x axis bounds</small></td></tr>
-</table>
-envelope sound: <a href="extsnd.html#envchannel">env-channel</a>, <a href="extsnd.html#envsound">env-sound</a><br>
-other enveloping functions: <a href="extsnd.html#rampchannel">ramp-channel</a>, <a href="extsnd.html#xrampchannel">xramp-channel</a>, <a href="extsnd.html#smoothchannel">smooth-channel</a><br>
-envelope editor: <a href="snd.html#editenvelope">Edit or View and Envelope</a><br>
-panning: place-sound in examp.scm<br>
-read sound indexed through envelope: <a href="sndscm.html#envsoundinterp">env-sound-interp</a><br>
-repeating envelope: <a href="#pulsedenv">pulsed-env</a><br>
-step envelope in pitch: <a href="#rxyk!cos">brassy</a> in generators.scm<br>
-<br>
-</small></blockquote>
+<table class="method">
+<tr><td class="methodtitle">Envelopes</td></tr>
+<tr><td>
+<p>Various operations on envelopes:
+</p>
+<pre class="indented">
+<a href="sndscm.html#envdoc">env.scm</a>:
+add-envelopes add two envelopes
+concatenate-envelopes concatenate a bunch of envelopes
+envelope-exp interpolate points to approximate exponential curves
+envelope-interp return the value of an envelope given the x position
+envelope-last-x return the last x value in an envelope
+intergrate-envelope return the area under an envelope
+make-power-env exponential curves with multiple exponents (see also multi-expt-env in generators.scm)
+map-envelopes apply a function to the breakpoints in two envelopes, returning a new envelope
+max-envelope return the maximum y value in an envelope (also min-envelope)
+multiply-envelopes multiply two envelopes
+normalize-envelope scale the y values of an envelope to peak at 1.0
+repeat-envelope concatenate copies of an envelope
+reverse-envelope reverse the breakpoints in an envelope
+scale-envelope scale and offset the y values of an envelope
+stretch-envelope apply attack and decay times to an envelope ("adsr", or "divenv")
+window-envelope return the portion of an envelope within given x axis bounds
+</pre>
+<pre>
+envelope sound: <a href="extsnd.html#envchannel">env-channel</a>, <a href="extsnd.html#envsound">env-sound</a>
+other enveloping functions: <a href="extsnd.html#rampchannel">ramp-channel</a>, <a href="extsnd.html#xrampchannel">xramp-channel</a>, <a href="extsnd.html#smoothchannel">smooth-channel</a>
+envelope editor: <a href="snd.html#editenvelope">Edit or View and Envelope</a>
+panning: place-sound in examp.scm
+read sound indexed through envelope: <a href="sndscm.html#envsoundinterp">env-sound-interp</a>
+repeating envelope: <a href="#pulsedenv">pulsed-env</a>
+step envelope in pitch: <a href="#rxyk!cos">brassy</a> in generators.scm
+</pre>
</td></tr></table>
-<br><br>
-<A NAME="table-lookupdoc"></A>
-<!-- ---------------------------------------- TABLE-LOOKUP ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>table-lookup</h3></center></td></tr></table>
-<br>
+<!-- TABLE-LOOKUP -->
-<pre>
- <a class=def name="make-table-lookup">make-table-lookup</a>
+<div class="innerheader" id="table-lookupdoc">table-lookup</div>
+
+<pre class="indented">
+<em class=def id="make-table-lookup">make-table-lookup</em>
(frequency *clm-default-frequency*) ; table repetition rate in Hz
(initial-phase 0.0) ; starting point in radians (pi = mid-table)
- wave ; a vct containing the signal
+ wave ; a float-vector containing the signal
(size *clm-table-size*) ; table size if wave not specified
(type mus-interp-linear) ; interpolation type
- <a class=def name="table-lookup">table-lookup</a> tl (fm-input 0.0)
- <a class=def name="table-lookup?">table-lookup?</a> tl
+<em class=def id="table-lookup">table-lookup</em> tl (fm-input 0.0)
+<em class=def id="table-lookup?">table-lookup?</em> tl
- <a class=def NAME="make-table-lookup-with-env">make-table-lookup-with-env</a> frequency env size
+<em class=def id="make-table-lookup-with-env">make-table-lookup-with-env</em> frequency env size
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">table-lookup methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">wave float-vector</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">wave size (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-interp-type</em></td><td class="inner">interpolation choice (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">table increment per sample</td></tr>
+</table>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
-<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<p>table-lookup performs interpolating table lookup with a lookup index that moves
+through the table at a speed set by make-table-lookup's "frequency" argument and table-lookup's "fm-input" argument.
+That is, the waveform in the table is produced repeatedly, the repetition rate set by the frequency arguments.
+Table-lookup scales its
+fm-input argument to make its table size appear to be two pi.
+The intention here is that table-lookup with a sinusoid in the table and a given FM signal
+produces the same output as oscil with that FM signal.
+The "type" argument sets the type of interpolation used: <code>mus-interp-none</code>,
+<code>mus-interp-linear</code>, <code>mus-interp-lagrange</code>, or <code>mus-interp-hermite</code>.
+make-table-lookup-with-env (defined in generators.scm) returns a new table-lookup generator with the envelope 'env' loaded into its table.
+table-lookup might be defined:
+</p>
+
+<pre class="indented">
+(let ((result (<a class=quiet href="#array-interp">array-interp</a> wave phase)))
+ (set! phase (+ phase
+ (<a class=quiet href="#hztoradians">hz->radians</a> frequency)
+ (* fm-input
+ (/ (length wave)
+ (* 2 pi)))))
+ result)
+</pre>
+
+
+<table>
+<tr><td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((gen (make-table-lookup 440.0 :wave (partials->wave '(1 .5 2 .5)))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (table-lookup gen))))))
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
gen = make_table_lookup(440.0, :wave, partials2wave([1.0, 0.5, 2.0, 0.5]));
44100.times do |i|
@@ -1513,11 +1691,12 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr><tr>
-
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 :wave '( 1 0.5 2 0.5 ) #f #f partials->wave make-table-lookup { gen }
44100 0 do
@@ -1525,42 +1704,12 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<p>table-lookup performs interpolating table lookup with a lookup index that moves
-through the table at a speed set by make-table-lookup's "frequency" argument and table-lookup's "fm-input" argument.
-That is, the waveform in the table is produced repeatedly, the repetition rate set by the frequency arguments.
-Table-lookup scales its
-fm-input argument to make its table size appear to be two pi.
-The intention here is that table-lookup with a sinusoid in the table and a given FM signal
-produces the same output as oscil with that FM signal.
-The "type" argument sets the type of interpolation used: <code>mus-interp-none</code>,
-<code>mus-interp-linear</code>, <code>mus-interp-lagrange</code>, or <code>mus-interp-hermite</code>.
-make-table-lookup-with-env (defined in generators.scm) returns a new table-lookup generator with the envelope 'env' loaded into its table.
-</p>
-
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>table-lookup methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>wave vct</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>wave size (no set!)</td></tr>
-<tr><td><em class=gen>mus-interp-type</em></td><td>interpolation choice (no set!)</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>table increment per sample</td></tr>
-</table>
-<pre>
-<br>
-(let ((result (<a class=quiet href="#array-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_array_interp_tip)">array-interp</a> wave phase)))
- (set! phase (+ phase
- (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency)
- (* fm-input
- (/ (length wave)
- (* 2 pi)))))
- result)
-</pre><br clear=left>
<p>
In the past, table-lookup was often used for additive synthesis, so
@@ -1568,78 +1717,70 @@ there are two functions that make it easier to load up
various such waveforms:
</p>
-<pre>
- <a class=def name="partialstowave">partials->wave</a> synth-data wave-vct (norm #t)
- <a class=def name="phase-partialstowave">phase-partials->wave</a> synth-data wave-vct (norm #t)
+<pre class="indented">
+<em class=def id="partialstowave">partials->wave</em> synth-data wave (norm #t)
+<em class=def id="phase-partialstowave">phase-partials->wave</em> synth-data wave (norm #t)
</pre>
-<p>The "synth-data" argument is a list or vct of (partial amp) pairs: '(1 .5 2 .25)
+<p>The "synth-data" argument is a list or float-vector of (partial amp) pairs: '(1 .5 2 .25)
gives a combination of a sine wave at the carrier (partial = 1) at amplitude .5, and
another at the first harmonic (partial = 2) at amplitude .25. The partial amplitudes are
normalized to sum to a total amplitude of 1.0 unless the argument "norm"
is #f. If the initial phases matter (they almost never do), you can use
-phase-partials->wave; in this case the synth-data is a list or vct of (partial amp phase) triples with phases in radians.
-If "wave-vct" is not passed, these functions return a new vct.
+phase-partials->wave; in this case the synth-data is a list or float-vector of (partial amp phase) triples with phases in radians.
+If "wave" is not passed, these functions return a new float-vector.
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (simple-table dur)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (simple-table dur)
(let ((tab (<em class=red>make-table-lookup</em> :wave (<em class=red>partials->wave</em> '(1 .5 2 .5)))))
- (do ((i 0 (+ 1 i))) ((= i dur))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .3 (<em class=red>table-lookup</em> tab))))))
+ (do ((i 0 (+ i 1))) ((= i dur))
+ (<a class=quiet href="#outa">outa</a> i (* .3 (<em class=red>table-lookup</em> tab))))))
</pre>
-</td></tr></table>
<p>table-lookup can also be used as a sort of "freeze" function, looping through a sound repeatedly,
based on some previously chosen loop positions:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (looper start dur sound freq amp)
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (loop-data (<a class=quiet href="extsnd.html#mussoundloopinfo" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundloopinfo_tip)">mus-sound-loop-info</a> sound)))
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
+ (loop-data (<a class=quiet href="extsnd.html#mussoundloopinfo">mus-sound-loop-info</a> sound)))
(if (or (null? loop-data)
(<= (cadr loop-data) (car loop-data)))
- (throw 'no-loop-positions)
+ (error 'no-loop-positions)
(let* ((loop-start (car loop-data))
(loop-end (cadr loop-data))
(loop-length (+ 1 (- loop-end loop-start)))
- (sound-section (<a class=quiet href="#filetoarray" onmouseout="UnTip()" onmouseover="Tip(sndclm_filetoarray_tip)">file->array</a> sound 0 loop-start loop-length (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> loop-length)))
+ (sound-section (<a class=quiet href="#filetoarray">file->array</a> sound 0 loop-start loop-length (make-float-vector loop-length 0.0)))
(original-loop-duration (/ loop-length (srate sound)))
(tbl (<em class=red>make-table-lookup</em> :frequency (/ freq original-loop-duration) :wave sound-section)))
;; "freq" here is how fast we read (transpose) the sound — 1.0 returns the original
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<em class=red>table-lookup</em> tbl)))))))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<em class=red>table-lookup</em> tbl))))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100) (looper 0 10 "/home/bil/sf1/forest.aiff" 1.0 0.5))
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:srate 44100) (looper 0 10 "/home/bil/sf1/forest.aiff" 1.0 0.5))
</pre>
-</td></tr></table>
<p>And for total confusion, here's a table-lookup that modulates a sound where we specify the
modulation deviation in samples:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (fm-table file start dur amp read-speed modulator-freq index-in-samples)
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (table-length (<a class=quiet href="extsnd.html#mussoundframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundframes_tip)">mus-sound-frames</a> file))
- (tab (<em class=red>make-table-lookup</em> :frequency (/ read-speed (<a class=quiet href="extsnd.html#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> file))
- :wave (<a class=quiet href="#filetoarray" onmouseout="UnTip()" onmouseover="Tip(sndclm_filetoarray_tip)">file->array</a> file 0 0 table-length (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> table-length))))
- (osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> modulator-freq))
- (index (/ (* (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> modulator-freq) 2 pi index-in-samples) table-length)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<em class=red>table-lookup</em> tab (* index (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc)))))))))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (fm-table file start dur amp read-speed modulator-freq index-in-samples)
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
+ (table-length (<a class=quiet href="extsnd.html#mussoundframples">mus-sound-framples</a> file))
+ (tab (<em class=red>make-table-lookup</em> :frequency (/ read-speed (<a class=quiet href="extsnd.html#mussoundduration">mus-sound-duration</a> file))
+ :wave (<a class=quiet href="#filetoarray">file->array</a> file 0 0 table-length (make-float-vector table-length 0.0))))
+ (osc (<a class=quiet href="#make-oscil">make-oscil</a> modulator-freq))
+ (index (/ (* (<a class=quiet href="#hztoradians">hz->radians</a> modulator-freq) 2 pi index-in-samples) table-length)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<em class=red>table-lookup</em> tab (* index (<a class=quiet href="#oscil">oscil</a> osc))))))))
</pre>
-</td></tr></table>
<p>Lessee.. there's a factor of table-length/(2*pi) in table-lookup, so that a table with a sinusoid
behaves the same as an oscil even with FM; hz->radians
@@ -1648,7 +1789,6 @@ an actual deviation of mfreq*2*pi*index/srate, which looks like FM; hmmm. See <
below for an <a href="#src">src</a>-based way to do the same thing.
</p>
-<br>
<p>
There is one annoying problem with table-lookup: noise.
Say we have a sine wave in a table with L elements, and we want to read it at a frequency of
@@ -1659,29 +1799,28 @@ assumptions about what ought to be there. In the no-interpolation case (type =
the table-relative phase, returning a squared-off sine-wave:
</p>
-<img src="pix/interp1.png" alt="squared-off sine spectra" hspace=40 onmouseout="UnTip()" onmouseover="Tip('srate=1000000 so that aliasing does not cause confusion.<br>FFT size=262144 with a blackman2 window.<br>In detail, the first 10 pairs (with 1/nL in parens) are:<br><pre> 100 1.000000<br> 9900 0.010368 (.01)<br> 10100 0.010192<br> 19900 0.005174 (.005)<br> 20100 0.005099<br> 29900 0.003431 (.0033)<br> 30100 0.003436<br> 39900 0.002594 (.0025)<br> 40100 0.002560<br> 49900 0.002060 (.002)<br> 50100 0.002066<br> 59900 0.001732 (.0017)<br> 60100 0.001715<br> 69900 0.001477 (.0014)<br> 70100 0.001478<br> 79900 0.001300 (.00125)<br> 80100 0.001296<br> 89900 0.001157 (.0011)<br> 90100 0.001153<br> 99900 0.001043 (.001)<br> 100100 0.001046</pre>')">
+<img src="pix/interp1.png" alt="squared-off sine spectra">
<!--
(with-sound (:srate 1000000 :channels 2)
- (let ((gen1 (make-table-lookup 100.0 :wave (partials->wave '(1 1) (make-vct 100)) :type mus-interp-none))
+ (let ((gen1 (make-table-lookup 100.0 :wave (partials->wave '(1 1) (make-float-vector 100 0.0)) :type mus-interp-none))
(sine (make-oscil 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000000))
(let ((qsine (table-lookup gen1))
(tsine (oscil sine)))
(outa i qsine)
- (outb i (- tsine qsine)))))))
+ (outb i (- tsine qsine))))))
-(set! (selected-graph-color) (make-color 1 1 1))
-(set! (selected-data-color) (make-color 0 0 0))
+(set! *selected-graph-color* (make-color 1 1 1))
+(set! *selected-data-color* (make-color 0 0 0))
(set! (x-axis-label 0 0 0) "no interpolation, table size=100, sine at 100 Hz")
(set! (x-axis-label 0 1 0) "difference between sine and squared-off sine")
(set! (x-axis-label 0 0 1) "squared-off sine spectrum: srate=1000000")
(set! (x-axis-label 0 1 1) "spectrum of the error")
-(set! (axis-label-font) (axis-numbers-font))
-(set! (transform-normalization) normalize-by-sound)
-(set! (graphs-horizontal) #f)
+(set! *axis-label-font* *axis-numbers-font*)
+(set! *transform-normalization* normalize-by-sound)
+(set! *graphs-horizontal* #f)
-->
<!--
@@ -1700,19 +1839,18 @@ the amplitude is going (essentially) as 1.0 / (n * n * L * L). So the interpola
reduces the original problem by a factor of n * L:
</p>
-<img src="pix/interp2.png" alt="squared-off sine spectra" hspace=40 onmouseout="UnTip()" onmouseover="Tip('as before, srate=1000000 so that aliasing does not cause confusion.<br>FFT size=262144 with a blackman2 window.<br>In detail, the first 10 pairs (with 1/(n^2 L^2) in parens) are:<br><pre> 100 1.00000000<br> 9900 0.00010508 (.0001)<br> 10100 0.00010086<br> 19900 0.00002580 (.000025)<br> 20100 0.00002524<br> 29900 0.00001133 (.000011)<br> 30100 0.00001157<br> 39900 0.00000661 (.0000063)<br> 40100 0.00000652<br> 49900 0.00000419 (.000004)<br> 50100 0.00000422<br> 59900 0.00000263 (.0000027)<br> 60100 0.00000282<br> 69900 0.00000216 (.000002)<br> 70100 0.00000201<br> 79900 0.00000161 (.0000015)<br> 80100 0.00000155<br> 89900 0.00000120 (.0000012)<br> 90100 0.00000123<br> 99900 0.00000099 (.000001)<br> 100100 0.00000102</pre>')">
+<img src="pix/interp2.png" alt="squared-off sine spectra">
<!--
(with-sound (:srate 1000000 :channels 2)
- (let ((gen1 (make-table-lookup 100.0 :wave (partials->wave '(1 1) (make-vct 100)) :type mus-interp-linear))
+ (let ((gen1 (make-table-lookup 100.0 :wave (partials->wave '(1 1) (make-float-vector 100 0.0)) :type mus-interp-linear))
(sine (make-oscil 100.0)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000000))
(let ((qsine (table-lookup gen1))
(tsine (oscil sine)))
(outa i qsine)
- (outb i (- tsine qsine)))))))
+ (outb i (- tsine qsine))))))
(set! (x-axis-label 0 0 0) "linear interpolation, table size=100, sine at 100 Hz")
(set! (x-axis-label 0 1 0) "difference between sine and interpolated sine")
@@ -1757,22 +1895,21 @@ If you're trying to produce a sum of sinusoids, use polywave — it makes a
(with-sound (:channels 4 :clipped #f :statistics #t)
(let* ((pitch 1000.0)
(size 64)
- (tbl1 (make-table-lookup pitch 0.0 (partials->wave '(1 1) (make-vct size)) size mus-interp-none))
- (tbl2 (make-table-lookup pitch 0.0 (partials->wave '(1 1) (make-vct size)) size mus-interp-linear))
- (tbl3 (make-table-lookup pitch 0.0 (partials->wave '(1 1) (make-vct size)) size mus-interp-lagrange))
- (tbl4 (make-table-lookup pitch 0.0 (partials->wave '(1 1) (make-vct size)) size mus-interp-hermite)))
- (run
- (do ((i 0 (+ 1 i)))
+ (tbl1 (make-table-lookup pitch 0.0 (partials->wave '(1 1) (make-float-vector size 0.0)) size mus-interp-none))
+ (tbl2 (make-table-lookup pitch 0.0 (partials->wave '(1 1) (make-float-vector size 0.0)) size mus-interp-linear))
+ (tbl3 (make-table-lookup pitch 0.0 (partials->wave '(1 1) (make-float-vector size 0.0)) size mus-interp-lagrange))
+ (tbl4 (make-table-lookup pitch 0.0 (partials->wave '(1 1) (make-float-vector size 0.0)) size mus-interp-hermite)))
+ (do ((i 0 (+ i 1)))
((= i 100000))
(outa i (table-lookup tbl1))
(outb i (table-lookup tbl2))
(out-any i (table-lookup tbl3) 2)
- (out-any i (table-lookup tbl4) 3)))))
+ (out-any i (table-lookup tbl4) 3))))
(with-sound (:channels 5 :clipped #f :statistics #t)
(let* ((pitch 2.0)
(size 64)
- (wave (let ((v (make-vct size 0.0)))
+ (wave (let ((v (make-float-vector size 0.0 0.0)))
(set! (v (/ size 2)) 1.0)
v))
(tbl1 (make-table-lookup pitch 0.0 wave size mus-interp-none))
@@ -1780,27 +1917,24 @@ If you're trying to produce a sum of sinusoids, use polywave — it makes a
(tbl3 (make-table-lookup pitch 0.0 wave size mus-interp-lagrange))
(tbl4 (make-table-lookup pitch 0.0 wave size mus-interp-hermite))
(tbl5 (make-table-lookup pitch 0.0 wave size mus-interp-all-pass)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100000))
(outa i (table-lookup tbl1))
(outb i (table-lookup tbl2))
(out-any i (table-lookup tbl3) 2)
(out-any i (table-lookup tbl4) 3)
- (out-any i (table-lookup tbl5) 4)))))
+ (out-any i (table-lookup tbl5) 4))))
-->
-<center><table border=1 hspace=100 cellpadding=4 vspace=10><tr><td>
-<small>
+<div class="inset">
<p>table-lookup of a sine (or some facsimile thereof) probably predates Ptolemy.
One neat method of generating the table is that of Bhaskara I, AD 600, India, mentioned
in van Brummelen, "The Mathematics of the Heavens and the Earth": use the rational
approximation 4x(180-x)/(40500-x(180-x)), x in degrees, or more readably:
4x(pi-x)/(12.337-x(pi-x)), x in radians. The maximum error is 0.00163 at x=11.54 (degrees)!
</p>
-</small>
-</td></tr></table></center>
+</div>
<!--
(define (bhaskara-sine x) ; x degrees
@@ -1816,7 +1950,7 @@ approximation 4x(180-x)/(40500-x(180-x)), x in degrees, or more readably:
(/ (* 4 dx (- pi dx))
(- 12.337 (* dx (- pi dx)))))))
-Ayyangar: Ganesh -- same thing using n=pi/x: 16(n-1)/(5n^2-4n+4)
+Ayyangar: Ganesh; same thing using n=pi/x: 16(n-1)/(5n^2-4n+4)
(define (ganesh-sine x) ; x radians
(list (if (= x 0.0)
0.0
@@ -1838,7 +1972,7 @@ Ayyangar: Ganesh -- same thing using n=pi/x: 16(n-1)/(5n^2-4n+4)
(+ 60 (* 3 x x))))
(sin x)))
-(define (koren-sine ux) ; |ux|<pi/4, Kren and Zinaty
+(define (koren-sine ux) ; |ux| < pi/4, Kren and Zinaty
(let* ((x (/ (* 4 ux) pi))
(x2 (* x x))
(a0 1805490264.6910)
@@ -1854,83 +1988,112 @@ Ayyangar: Ganesh -- same thing using n=pi/x: 16(n-1)/(5n^2-4n+4)
(+ b0 (* x2 (+ b1 (* x2 (+ b2 (* x2 (+ b3 x2)))))))))))
-->
-<br>
<p><a href="spectr.scm">spectr.scm</a> has a steady state spectra of
several standard orchestral instruments, courtesy of James A. Moorer.
The <a href="sndscm.html#drone">drone</a> instrument in clm-ins.scm uses table-lookup for the
bagpipe drone. <a href="sndscm.html#twotab">two-tab</a> in the same file interpolates between two tables.
-See also <a href="sndscm.html#granidoc">grani</a> and <a href="sndscm.html#displayscannedsynthesis">display-scanned-synthesis</a>.
+See also <a href="sndscm.html#granidoc">grani</a>.
</p>
-<br><br>
-<A NAME="polyshapedoc"></A>
-<A NAME="polywavedoc"></A>
-<!-- ---------------------------------------- POLYWAVE, POLYSHAPE ---------------------------------------- -->
+<!-- POLYWAVE, POLYSHAPE -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>polywave, polyshape</h3></center></td></tr></table>
-<br>
-<pre>
- <a class=def name="make-polywave">make-polywave</a>
+<div class="innerheader" id="polywavedoc">polywave, polyshape</div>
+
+<pre class="indented">
+<em class=def id="make-polywave">make-polywave</em>
(frequency *clm-default-frequency*)
(partials '(1 1)) ; a list of harmonic numbers and their associated amplitudes
(type mus-chebyshev-first-kind) ; Chebyshev polynomial choice
+ xcoeffs ycoeffs ; tn/un for tu-sum case
- <a class=def name="polywave">polywave</a> w (fm 0.0)
- <a class=def name="polywave?">polywave?</a> w
+<em class=def id="polywave">polywave</em> w (fm 0.0)
+<em class=def id="polywave?">polywave?</em> w
- <a class=def name="make-polyshape">make-polyshape</a>
+<em class=def id="make-polyshape">make-polyshape</em>
(frequency *clm-default-frequency*)
(initial-phase 0.0)
coeffs
(partials '(1 1))
(kind mus-chebyshev-first-kind)
- <a class=def name="polyshape">polyshape</a> w (index 1.0) (fm 0.0)
- <a class=def name="polyshape?">polyshape?</a> w
+<em class=def id="polyshape">polyshape</em> w (index 1.0) (fm 0.0)
+<em class=def id="polyshape?">polyshape?</em> w
- <a class=def name="partialstopolynomial">partials->polynomial</a> partials (kind mus-chebyshev-first-kind)
- <a class=def name="normalizepartials">normalize-partials</a> partials
+<em class=def id="partialstopolynomial">partials->polynomial</em> partials (kind mus-chebyshev-first-kind)
+<em class=def id="normalizepartials">normalize-partials</em> partials
- <a class=def name="mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</a> x t-coeffs u-coeffs
- <em class=emdef>mus-chebyshev-t-sum</em> x t-coeffs
- <em class=emdef>mus-chebyshev-u-sum</em> x u-coeffs
+<em class=def id="mus-chebyshev-tu-sum">mus-chebyshev-tu-sum</em> x t-coeffs u-coeffs
+<em class=emdef>mus-chebyshev-t-sum</em> x t-coeffs
+<em class=emdef>mus-chebyshev-u-sum</em> x u-coeffs
</pre>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">polywave methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">index</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">polynomial coeffs</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">number of partials</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">frequency in radians per sample</td></tr>
+</table>
+
+<p>
+These two generators
+drive a sum of scaled Chebyshev polynomials with
+a cosine, creating a sort of cross between additive synthesis and FM; see
+"Digital Waveshaping Synthesis" by Marc Le Brun in JAES 1979 April, vol 27, no 4, p250.
+The basic idea is:
+</p>
+
+<img class="indented" src="pix/sceq16.png" alt="Cheby eqs">
+
+<p>
+We can add scaled Tns (polynomials) to get the spectrum we want, producing
+in the simplest case an inexpensive additive synthesis. We can vary the peak amplitude of the
+input (cos theta) to get effects similar to those of FM.
+polyshape uses a prebuilt sum of Chebyshev polynomials,
+whereas polywave uses the underlying Chebyshev recursion.
+polywave is stable and noise-free even with high partial numbers (I've tried it with 16384 harmonics).
+The "partials" argument to the make function can
+be either a list or a float-vector ("vct" in Ruby and Forth).
+The "type" or "kind" argument determines which kind of Chebyshev polynomial
+is used internally: mus-chebyshev-first-kind (Tn) which produces a sum of cosines,
+or mus-chebyshev-second-kind (Un), which produces a sum of sines.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
- (let ((gen (make-polywave 440.0
- :partials '(1 .5 2 .5))))
- (do ((i 0 (+ 1 i)))
+ (let ((gen (make-polywave 440.0 :partials '(1 .5 2 .5))))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (polywave gen))))))
</pre>
+</div>
</td>
-
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+</tr><tr>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
- gen = make_polywave(440.0,
- :partials, [1.0, 0.5, 2.0, 0.5]);
+ gen = make_polywave(440.0, :partials, [1.0, 0.5, 2.0, 0.5]);
44100.times do |i|
outa(i, 0.5 * polywave(gen), $output)
end
end.output
</pre>
+</div>
</td>
-
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+</tr><tr>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 :partials '( 1 0.5 2 0.5 ) make-polywave { gen }
44100 0 do
@@ -1938,8 +2101,8 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
-
</tr>
</table>
@@ -1953,174 +2116,139 @@ lambda: ( -- )
A&S 22.3.15
-->
-<p>
-These two generators
-drive a sum of scaled Chebyshev polynomials with
-a cosine, creating a sort of cross between additive synthesis and FM; see
-"Digital Waveshaping Synthesis" by Marc Le Brun in JAES 1979 April, vol 27, no 4, p250.
-The basic idea is:
-</p>
-
-<img src="pix/sceq16.png" alt="Cheby eqs" hspace=40>
-
-<p>
-We can add scaled Tns (polynomials) to get the spectrum we want, producing
-in the simplest case an inexpensive additive synthesis. We can vary the peak amplitude of the
-input (cos theta) to get effects similar to those of FM.
-polyshape uses a prebuilt sum of Chebyshev polynomials,
-whereas polywave uses the underlying Chebyshev recursion.
-polywave is stable and noise-free even with high partial numbers (I've tried it with 16384 harmonics).
-The "partials" argument to the make function can
-be either a list or a vct.
-The "type" or "kind" argument determines which kind of Chebyshev polynomial
-is used internally: mus-chebyshev-first-kind (Tn) which produces a sum of cosines,
-or mus-chebyshev-second-kind (Un), which produces a sum of sines.
-</p>
-<p>normalize-partials takes the list or vct of partial number and amplitudes, and
-returns a vct with the amplitudes normalized so that their magnitudes add to 1.0.
+<p>normalize-partials takes the list or float-vector of partial number and amplitudes, and
+returns a float-vector with the amplitudes normalized so that their magnitudes add to 1.0.
</p>
-<pre>
- <em class=listener>></em><em class=typing>(normalize-partials '(1 1 3 2 6 1))</em>
- <em class=listener>#<vct[len=6]: 1.000 0.250 3.000 0.500 6.000 0.250></em>
- <em class=listener>></em><em class=typing>(normalize-partials (vct 1 .1 2 .1 3 -.2))</em>
- <em class=listener>#<vct[len=6]: 1.000 0.250 2.000 0.250 3.000 -0.500></em>
+<pre class="indented">
+> (normalize-partials '(1 1 3 2 6 1))
+#(1.0 0.25 3.0 0.5 6.0 0.25);
+> (normalize-partials (float-vector 1 .1 2 .1 3 -.2))
+#(1.0 0.25 2.0 0.25 3.0 -0.5)
</pre>
<p>
partials->polynomial
-takes a list or vct of partial numbers and amplitudes
+takes a list or float-vector of partial numbers and amplitudes
and returns the Chebyshev polynomial coefficients that
produce that spectrum. These coefficients can be passed to
polyshape (the coeffs argument), or used directly by <a href="#polynomial">polynomial</a> (there are examples of both below).
</p>
-<pre>
- <em class=listener>></em><em class=typing>(partials->polynomial '(1 1 3 2 6 1))</em>
- <em class=listener>#<vct[len=7]: -1.000 -5.000 18.000 8.000 -48.000 0.000 32.000></em>
- <em class=listener>></em><em class=typing>(partials->polynomial '(1 1 3 2 6 1) mus-chebyshev-second-kind)</em>
- <em class=listener>#<vct[len=7]: -1.000 6.000 8.000 -32.000 0.000 32.000 0.000></em>
- <em class=listener>></em><em class=typing>(partials->polynomial (vct 1 .1 2 .1 3 -.2))</em>
- <em class=listener>#<vct[len=4]: -0.100 0.700 0.200 -0.800></em>
+<pre class="indented">
+> (partials->polynomial '(1 1 3 2 6 1))
+#(-1.0 -5.0 18.0 8.0 -48.0 0.0 32.0)
+> (partials->polynomial '(1 1 3 2 6 1) mus-chebyshev-second-kind)
+#(-1.0 6.0 8.0 -32.0 0.0 32.0 0.0)
+> (partials->polynomial (float-vector 1 .1 2 .1 3 -.2))
+#(-0.1 0.7 0.2 -0.8)
</pre>
<p>mus-chebyshev-tu-sum and friends perform the same function as partials->polynomial, but
use the much more stable and accurate underlying recursion (see below for a long-winded
explanation). They are the innards of the polywave and <a href="#polyoid">polyoid</a> generators.
The arguments are "x" (normally a phase), and one or two
-vcts of component amplitudes.
+float-vectors of component amplitudes.
These functions makes it easy to do additive synthesis
with any number of harmonics (I've tried 16384), each with arbitrary
initial-phase and amplitude, and each harmonic independently changeable
-in phase and amplitude at run-time by setting a vct value.
+in phase and amplitude at run-time by setting a float-vector value.
</p>
-
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>polywave methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>index (polywave only)</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>polynomial coeffs</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>number of partials</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-</table>
-
-<pre>
-<br>
-(let ((result (<a class=quiet href="#polynomial" onmouseout="UnTip()" onmouseover="Tip(sndclm_polynomial_tip)">polynomial</a> wave (cos phase))))
- (set! phase (+ phase (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency) fm))
+<pre class="indented">
+(let ((result (<a class=quiet href="#polynomial">polynomial</a> wave (cos phase))))
+ (set! phase (+ phase (<a class=quiet href="#hztoradians">hz->radians</a> frequency) fm))
result)
</pre>
-<br clear=left>
-
<p>In its simplest use, waveshaping is additive synthesis:
</p>
-<table border=0 hspace=40><tr>
-<td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<table>
+<tr><td>
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((wav (<em class=red>make-polyshape</em>
:frequency 500.0
:partials '(1 .5 2 .3 3 .2))))
- (do ((i 0 (+ 1 i))) ((= i 40000))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>polyshape</em> wav)))))
+ (do ((i 0 (+ i 1))) ((= i 40000))
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>polyshape</em> wav)))))
</pre>
</td>
<td>
-<img src="pix/polyshape.png" alt="waveshaping" hspace=40>
+<img src="pix/polyshape.png" alt="waveshaping">
</td>
</tr></table>
<p>Say we want every third harmonic at amplitude 1/sqrt(harmonic-number) for 5 harmonics total:
</p>
-<table border=0 hspace=40><tr>
-<td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:clipped #f :statistics #t :play #t :scaled-to .5)
- (let* ((gen (<em class=red>make-polywave</em> 200 (let ((harms (make-vct (* 5 2)))) ; 5 harmonics, 2 numbers for each
+
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:clipped #f :statistics #t :play #t :scaled-to .5)
+ (let ((gen (<em class=red>make-polywave</em> 200 (let ((harms (make-float-vector (* 5 2) 0.0))) ; 5 harmonics, 2 numbers for each
(do ((k 1 (+ k 3))
(i 0 (+ i 2)))
((= i (* 5 2)))
(set! (harms i) k) ; harmonic number (k*freq)
(set! (harms (+ i 1)) (/ 1.0 (sqrt k)))) ; harmonic amplitude
harms)))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 10 1 11 0) :duration 1.0 :scaler .5)))
- (do ((i 0 (+ 1 i)))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 10 1 11 0) :duration 1.0 :scaler .5)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) (<em class=red>polywave</em> gen))))))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> ampf) (<em class=red>polywave</em> gen))))))
</pre>
-</td>
-</tr></table>
+
<p>See animals.scm for many more examples along these lines.
-normalize-partials makes sure that the component amplitudes (magnitudes) add to 1.0. Its argument can be either a list or vct,
-but it always returns a vct.
+normalize-partials makes sure that the component amplitudes (magnitudes) add to 1.0. Its argument can be either a list or float-vector,
+but it always returns a float-vector.
The <a href="sndscm.html#fmviolin">fm-violin</a> uses polyshape for the multiple FM section in some cases.
The <a href="sndscm.html#pqw">pqw</a> and <a href="sndscm.html#pqwvox">pqwvox</a> instruments use
both kinds of Chebyshev polynomials to produce single side-band spectra.
Here is a somewhat low-level example:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (pqw start dur spacing carrier partials)
- (let* ((spacing-cos (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> spacing (/ pi 2.0)))
- (spacing-sin (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> spacing))
- (carrier-cos (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> carrier (/ pi 2.0)))
- (carrier-sin (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> carrier))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (pqw start dur spacing carrier partials)
+ (let* ((spacing-cos (<a class=quiet href="#make-oscil">make-oscil</a> spacing (/ pi 2.0)))
+ (spacing-sin (<a class=quiet href="#make-oscil">make-oscil</a> spacing))
+ (carrier-cos (<a class=quiet href="#make-oscil">make-oscil</a> carrier (/ pi 2.0)))
+ (carrier-sin (<a class=quiet href="#make-oscil">make-oscil</a> carrier))
(sin-coeffs (<em class=red>partials->polynomial</em>
partials mus-chebyshev-second-kind))
(cos-coeffs (<em class=red>partials->polynomial</em>
partials mus-chebyshev-first-kind))
- (beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i))) ((= i end))
- (let ((ax (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> spacing-cos)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (- (* (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> carrier-sin)
- (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> spacing-sin)
- (<em class=red>polynomial</em> sin-coeffs ax))
- (* (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> carrier-cos)
- (<em class=red>polynomial</em> cos-coeffs ax)))))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (pqw 0 1 200.0 1000.0 '(2 .2 3 .3 6 .5)))
+ (beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((ax (<a class=quiet href="#oscil">oscil</a> spacing-cos)))
+ (<a class=quiet href="#outa">outa</a> i (- (* (<a class=quiet href="#oscil">oscil</a> carrier-sin)
+ (<a class=quiet href="#oscil">oscil</a> spacing-sin)
+ (<em class=red>polynomial</em> sin-coeffs ax))
+ (* (<a class=quiet href="#oscil">oscil</a> carrier-cos)
+ (<em class=red>polynomial</em> cos-coeffs ax))))))))
</pre>
-</td><td>
+
+<table class="pb">
+<tr><td>
<img src="pix/pqw.png" alt="pqw example">
-</td></tr></table>
+</td></tr>
+<tr><td class="br">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (pqw 0 1 200.0 1000.0 '(2 .2 3 .3 6 .5)))
+</td></tr>
+</table>
+
<p>We can use waveshaping to make a band-limited triangle-wave:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+
+<pre class="indented">
(define* (make-band-limited-triangle-wave (frequency *clm-default-frequency*) (order 1))
- (let ((freqs '()))
- (do ((i 1 (+ 1 i))
+ (let ((freqs ()))
+ (do ((i 1 (+ i 1))
(j 1 (+ j 2)))
((> i order))
(set! freqs (cons (/ 1.0 (* j j)) (cons j freqs))))
@@ -2129,33 +2257,29 @@ Here is a somewhat low-level example:
(define* (band-limited-triangle-wave gen (fm 0.0))
(<em class=red>polywave</em> gen fm))
</pre>
-</td></tr></table>
<p>Band-limited square or sawtooth waves:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (bl-saw start dur frequency order)
- (let* ((norm (if (= order 1) 1.0 ; these peak amps were determined empirically
+
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (bl-saw start dur frequency order)
+ (let ((norm (if (= order 1) 1.0 ; these peak amps were determined empirically
(if (= order 2) 1.3 ; actual limit is supposed to be pi/2 (G&R 1.441)
(if (< order 9) 1.7 ; but Gibbs phenomenon pushes it to 1.851
1.852))))
- (freqs '()))
- (do ((i 1 (+ 1 i)))
+ (freqs ()))
+ (do ((i 1 (+ i 1)))
((> i order))
(set! freqs (cons (/ 1.0 (* norm i)) (cons i freqs))))
(let* ((gen (<em class=red>make-polywave</em> frequency :partials (reverse freqs) :type <em class=red>mus-chebyshev-second-kind</em>))
- (beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>polywave</em> gen)))))))
-</pre></td></tr></table>
+ (beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>polywave</em> gen))))))
+</pre>
-<table border=0>
-<tr><td>
-The "fm" argument to these generators is intended mainly for vibrato and frequency envelopes.
+<p>The "fm" argument to these generators is intended mainly for vibrato and frequency envelopes.
If you use it for frequency modulation, you'll notice that the result is not the necessarily same as applying that
modulation to the equivalent bank of oscillators, but it is the same as (for example) applying it to an ncos
generator, or most of the other generators (table-lookup, nsin, etc). The polynomial in cos(x) produces
@@ -2165,10 +2289,10 @@ This is what you want
if all the components should move together (as in vibrato). If you need better control of the FM spectrum,
use a bank of oscils where you can set each index independently. Here we used '(1 1 2 1 3 1) and polyshape
with sinusoidal FM with an index of 1.
-</td><td width=20></td><td>
-<img src="pix/polyfm.png" alt="polyshape fm">
-</td></tr>
-</table>
+</p>
+
+<img class="indented" src="pix/polyfm.png" alt="polyshape fm">
+
<p>The same thing happens if you use polyshape or ncos (or whatever) as the (complex) modulating signal to an oscil
(the reverse of the situation above).
@@ -2177,15 +2301,17 @@ is scaled to be -1..1, so that adds another layer of confusion). There's a longe
<a href="#ncosdoc">ncos</a>.
</p>
+<!-- actually you get either cos(nx) or +/-cos(nx) depending on which algorithm is actually chosen
+-->
<!--
(define* (fmsin beg dur freq amp mc-ratio index type)
(let* ((start (seconds->samples beg))
(end (+ start (seconds->samples dur)))
(carrier (if (= type 0)
(let ((oscs (make-vector 3 #f)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 3))
- (set! (oscs i) (make-oscil (* freq (+ 1 i)))))
+ (set! (oscs i) (make-oscil (* freq (+ i 1)))))
oscs)
(if (= type 1)
(make-ncos freq 3)
@@ -2209,15 +2335,15 @@ is scaled to be -1..1, so that adds another layer of confusion). There's a longe
(modulator (make-oscil (* freq mc-ratio)))
(fm-index (hz->radians (* index freq mc-ratio)))
(ampf (make-env '(0 0 1 1 10 1 11 0) :scaler amp :duration dur)))
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(let ((md (* fm-index (oscil modulator))))
(outa i (* (env ampf)
(if (= type 0)
(let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 3))
- (set! sum (+ sum (oscil (carrier k) (* (+ 1 k) md))))) ; or leave unscaled
+ (set! sum (+ sum (oscil (carrier k) (* (+ k 1) md))))) ; or leave unscaled
(/ sum 3))
(if (= type 1)
(sum-of-cosines carrier md)
@@ -2243,50 +2369,45 @@ is scaled to be -1..1, so that adds another layer of confusion). There's a longe
<p>To get the FM effect of a spectrum centered around a carrier, multiply the waveshaping output by the carrier (the 0Hz term gives us the carrier):
</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((modulator (<em class=red>make-polyshape</em> 100.0 :partials (list 0 .4 1 .4 2 .1 3 .05 4 .05)))
- (carrier (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 1000.0)))
- (do ((i 0 (+ 1 i))) ((= i 20000))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .5 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> carrier) (<em class=red>polyshape</em> modulator))))))
+ (carrier (<a class=quiet href="#make-oscil">make-oscil</a> 1000.0)))
+ (do ((i 0 (+ i 1))) ((= i 20000))
+ (<a class=quiet href="#outa">outa</a> i (* .5 (<a class=quiet href="#oscil">oscil</a> carrier) (<em class=red>polyshape</em> modulator))))))
</pre>
-</td></tr></table>
<p>The simplest way to get
-get changing spectra is to interpolate between two or more sets of coefficients.
+changing spectra is to interpolate between two or more sets of coefficients.
</p>
-<pre>
- (+ (* interp (polywave p1 ...)) ; see animals.scm for many examples
- (* (- 1.0 interp) (polywave p2 ...)))
+
+<pre class="indented">
+(+ (* interp (polywave p1 ...)) ; see animals.scm for many examples
+ (* (- 1.0 interp) (polywave p2 ...)))
</pre>
<p>Or use mus-chebyshev-*-sum and set the component amplitudes directly:
</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let* ((dur 1.0)
- (samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))
- (coeffs (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0.0 0.5 0.25 0.125 0.125))
+ (samps (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))
+ (coeffs (float-vector 0.0 0.5 0.25 0.125 0.125))
(x 0.0)
- (incr (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 100.0))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 10 1 11 0) :duration dur :scaler .5))
- (harmf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 .125 1 .25) :duration dur)))
- (do ((i 0 (+ 1 i)))
+ (incr (<a class=quiet href="#hztoradians">hz->radians</a> 100.0))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 10 1 11 0) :duration dur :scaler .5))
+ (harmf (<a class=quiet href="#make-env">make-env</a> '(0 .125 1 .25) :duration dur)))
+ (do ((i 0 (+ i 1)))
((= i samps))
- (let ((harm (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> harmf)))
+ (let ((harm (<a class=quiet href="#env">env</a> harmf)))
(set! (coeffs 3) harm)
(set! (coeffs 4) (- .25 harm))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> ampf)
(<em class=red>mus-chebyshev-t-sum</em> x coeffs)))
(set! x (+ x incr))))))
</pre>
-</td></tr></table>
<p>
But we can also vary
@@ -2295,7 +2416,7 @@ The kth partial's amplitude
at a given index, given a set h[k] of coefficients, is:
</p>
-<img src="pix/sceq43.png" alt="cheby hka calc" hspace=40>
+<img class="indented" src="pix/sceq43.png" alt="cheby hka calc">
<!-- LATEX:
&h_{k}(a) = \sum_{j=0}^{\infty} \binom{p}{j} a^{p} \sum_{i=0}^{\infty} (-1)^{i}\Big(\tbinom{p+i}{i} + \tbinom{p+i-1}{i-1}\Big) h_{p+2i}(1) & p=k+2j \\
@@ -2307,15 +2428,15 @@ is a polynomial in the index whose order depends on the number of coefficients.
energy appears in lower harmonics even if they are not included in the index=1.0 list:
</p>
-<pre>
- > (cheby-hka 3 0.25 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 0 0 0 1.0 1.0))
- -0.0732421875
- > (cheby-hka 2 0.25 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 0 0 0 1.0 1.0))
- -0.234375
- > (cheby-hka 1 0.25 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 0 0 0 1.0 1.0))
- 1.025390625
- > (cheby-hka 0 0.25 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 0 0 0 1.0 1.0))
- 1.5234375
+<pre class="indented">
+> (cheby-hka 3 0.25 (float-vector 0 0 0 0 1.0 1.0))
+-0.0732421875
+> (cheby-hka 2 0.25 (float-vector 0 0 0 0 1.0 1.0))
+-0.234375
+> (cheby-hka 1 0.25 (float-vector 0 0 0 0 1.0 1.0))
+1.025390625
+> (cheby-hka 0 0.25 (float-vector 0 0 0 0 1.0 1.0))
+1.5234375
</pre>
<p>
@@ -2324,23 +2445,21 @@ to 1.0 (sticking at 1.0 for a moment at the end), with a partials list of '(11 1
odd harmonics are independent:
</p>
-<table border=0 hspace=20>
-<tr><td colspan=2>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((gen (<em class=red>make-polyshape</em> 100.0 :partials (list 11 1 20 1)))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 20 1 21 0) :scaler .4 :length 88200))
- (indf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 1.1 1) :length 88200)))
- (do ((i 0 (+ 1 i)))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 20 1 21 0) :scaler .4 :length 88200))
+ (indf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 1.1 1) :length 88200)))
+ (do ((i 0 (+ i 1)))
((= i 88200))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) (<em class=red>polyshape</em> gen (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf)))))))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> ampf) (<em class=red>polyshape</em> gen (<a class=quiet href="#env">env</a> indf)))))))
</pre>
-</td></tr>
+<table>
<tr><td>
<img src="pix/waver.png" alt="picture of waveshaping sweep">
</td><td>
-<img src="pix/waver2.png" alt="time domain" hspace=20>
+<img src="pix/waver2.png" alt="time domain">
</td></tr>
</table>
@@ -2357,36 +2476,33 @@ problem somewhat by changing the signs of the harmonics to follow the
pattern + + - -:
</p>
-<pre>
- (list 1 .5 2 .25 3 -.125 4 -.125) ; squeeze the amplitude change toward index=0
+<pre class="indented">
+(list 1 .5 2 .25 3 -.125 4 -.125) ; squeeze the amplitude change toward index=0
</pre>
<p>but now the peak amplitude is hard to predict (it's .6242 in this example). Perhaps <a href="sndscm.html#flattenpartials">flatten-partials</a>
would be a better choice here.
-To follow an amplitude envelope despite a changing index, we can use a <a href="#moving-max">moving-max</a> generator (from generators.scm):
+To follow an amplitude envelope despite a changing index, we can use a <a href="#moving-max">moving-max</a> generator:
</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((gen (<em class=red>make-polyshape</em> 1000.0 :partials (list 1 .25 2 .25 3 .125 4 .125 5 .25)))
- (indf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 0) :duration 2.0)) ; index env
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 1 3 0) :duration 2.0)) ; desired amp env
- (mx (<a class=quiet href="#moving-max" onmouseout="UnTip()" onmouseover="Tip(sndclm_moving_max_tip)">make-moving-max</a> 256)) ; track actual current amp
- (samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> 2.0)))
- (do ((i 0 (+ 1 i)))
+ (indf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 2 0) :duration 2.0)) ; index env
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 2 1 3 0) :duration 2.0)) ; desired amp env
+ (mx (<a class=quiet href="#moving-max">make-moving-max</a> 256)) ; track actual current amp
+ (samps (<a class=quiet href="#secondstosamples">seconds->samples</a> 2.0)))
+ (do ((i 0 (+ i 1)))
((= i samps))
- (let ((val (<em class=red>polyshape</em> gen (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf)))) ; polyshape with index env
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (/ (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) val)
- (max 0.001 (<a class=quiet href="#moving-max" onmouseout="UnTip()" onmouseover="Tip(sndclm_moving_max_tip)">moving-max</a> mx val))))))))
+ (let ((val (<em class=red>polyshape</em> gen (<a class=quiet href="#env">env</a> indf)))) ; polyshape with index env
+ (<a class=quiet href="#outa">outa</a> i (/ (* (<a class=quiet href="#env">env</a> ampf) val)
+ (max 0.001 (<a class=quiet href="#moving-max">moving-max</a> mx val))))))))
</pre>
-</td></tr></table>
<p>The harmonic amplitude formula for the Chebyshev polynomials of the second kind is:
</p>
-<img src="pix/sceq44.png" alt="more cheby hka calcs" hspace=40>
+<img class="indented" src="pix/sceq44.png" alt="more cheby hka calcs">
<!-- LATEX:
&h_{k}(a) = \sum_{j=0}^{\infty} \Big(\tbinom{p-1}{j} - \tbinom{p-1}{j-1}\Big) a^p \sum_{i=0}^{\infty} (-1)^{i} \tbinom{p+i-1}{i} h_{p+2i}(1) & p=k+2j \\
@@ -2404,55 +2520,55 @@ we get sum and difference tones, much as in complex FM:
& 5 \cos (24x)-10 \cos (22x)- 10 \cos (18x)+5 \cos (16x)+ \cos (5x)+5 \cos (3x) \big)
-->
-<table border=1 cellpadding=10 hspace=20>
+<table class="method">
<tr><td>
-<center>T5 driven with sinusoids at 100Hz and 2000Hz</center>
+<div class="center">T5 driven with sinusoids at 100Hz and 2000Hz</div>
<hr>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let ((pcoeffs (<em class=red>partials->polynomial</em> (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 5 1)))
- (gen1 (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 100.0))
- (gen2 (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 2000.0)))
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (let ((pcoeffs (<em class=red>partials->polynomial</em> (float-vector 5 1)))
+ (gen1 (<a class=quiet href="#make-oscil">make-oscil</a> 100.0))
+ (gen2 (<a class=quiet href="#make-oscil">make-oscil</a> 2000.0)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>polynomial</em> pcoeffs
- (+ (* 0.5 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> gen1))
- (* 0.5 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> gen2))))))))
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>polynomial</em> pcoeffs
+ (+ (* 0.5 (<a class=quiet href="#oscil">oscil</a> gen1))
+ (* 0.5 (<a class=quiet href="#oscil">oscil</a> gen2))))))))
</pre>
<hr>
-<center><img src="pix/t5sum.png"></center>
+<div class="center"><img src="pix/t5sum.png" alt="t5"></div>
</td>
<td>
-<img src="pix/crosswave.png">
+<img class="indented" src="pix/crosswave.png" alt="cross">
</td></tr></table>
<p>This kind of output is typical; I get the impression that the cross products are
much more noticeable here than in FM.
Of course, we can take advantage of that:
</p>
-<table border=0 hspace=20><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2)
+
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 2)
(let* ((dur 2.0)
- (samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))
+ (samps (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))
(p1 (<em class=red>make-polywave</em> 800 (list 1 .1 2 .3 3 .4 5 .2)))
(p2 (<em class=red>make-polywave</em> 400 (list 1 .1 2 .3 3 .4 5 .2)))
- (interpf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :duration dur))
+ (interpf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1) :duration dur))
(p3 (<em class=red>partials->polynomial</em> (list 1 .1 2 .3 3 .4 5 .2)))
- (g1 (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 800))
- (g2 (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 400))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 10 1 11 0) :duration dur)))
- (do ((i 0 (+ 1 i)))
+ (g1 (<a class=quiet href="#make-oscil">make-oscil</a> 800))
+ (g2 (<a class=quiet href="#make-oscil">make-oscil</a> 400))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 10 1 11 0) :duration dur)))
+ (do ((i 0 (+ i 1)))
((= i samps))
- (let ((interp (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> interpf))
- (amp (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)))
+ (let ((interp (<a class=quiet href="#env">env</a> interpf))
+ (amp (<a class=quiet href="#env">env</a> ampf)))
;; chan A: interpolate from one spectrum to the next directly
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (+ (* interp (<em class=red>polywave</em> p1))
+ (<a class=quiet href="#outa">outa</a> i (* amp (+ (* interp (<em class=red>polywave</em> p1))
(* (- 1.0 interp) (<em class=red>polywave</em> p2)))))
;; chan B: interpolate inside the sum of Tns!
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outb</a> i (* amp (<em class=red>polynomial</em> p3 (+ (* interp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> g1))
- (* (- 1.0 interp) (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> g2))))))))))
-</pre></td></tr></table>
+ (<a class=quiet href="#outa">outb</a> i (* amp (<em class=red>polynomial</em> p3 (+ (* interp (<a class=quiet href="#oscil">oscil</a> g1))
+ (* (- 1.0 interp) (<a class=quiet href="#oscil">oscil</a> g2))))))))))
+</pre>
<p>
If we use an arbitrary sound as the argument
@@ -2465,13 +2581,13 @@ original:
T5(a+b) = 16(a+b)^5 - 20(a+b)^3 + 5(a+b) and the complex FM equation cos(5*(a+b))).
-->
-<pre>
+<pre class="indented">
(define (brighten-slightly coeffs)
(let ((pcoeffs (partials->polynomial coeffs))
- (mx (<a class=quiet href="extsnd.html#maxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_maxamp_tip)">maxamp</a>)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
+ (mx (<a class=quiet href="extsnd.html#maxamp">maxamp</a>)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a>
(lambda (y)
- (* mx (<a class=quiet href="#polynomial" onmouseout="UnTip()" onmouseover="Tip(sndclm_polynomial_tip)">polynomial</a> pcoeffs (/ y mx)))))))
+ (* mx (<a class=quiet href="#polynomial">polynomial</a> pcoeffs (/ y mx)))))))
</pre>
<p>but watch out for clicks from the DC component if any of the "n" in the Tn are even.
@@ -2487,7 +2603,7 @@ the DC term (coeffs[0]), but I haven't tried this.
(coeffs (partials->polynomial '(5 1)))
(gen (make-oscil 100.0))
(gen1 (make-oscil 500.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(let* ((val (oscil gen))
(nval (oscil gen1))
@@ -2503,7 +2619,7 @@ the DC term (coeffs[0]), but I haven't tried this.
run into numerical trouble (the polywave generator is immune to this bug).
Where does the trouble lie?
The polynomials are related to each other
-via the recursion: <img src="pix/sceq17.png" alt="Cheby recurse" align=absmiddle>, so the first
+via the recursion: <img src="pix/sceq17.png" alt="Cheby recurse">, so the first
few polynomials are:
</p>
@@ -2526,10 +2642,10 @@ few polynomials are:
-->
-<table border=0 hspace=40><tr>
-<td><img src="pix/sceq18.png" alt="some Chebys"></td>
-<td width=20></td>
-<td><img src="pix/sceq19.png" alt="more Chebys"></td>
+<table>
+<tr>
+<td><img class="indented" src="pix/sceq18.png" alt="some Chebys"></td>
+<td><img class="indented" src="pix/sceq19.png" alt="more Chebys"></td>
</tr></table>
<p>The first coefficient is 2^n or 2^(n-1). This is bad news if "n" is large because
@@ -2538,7 +2654,7 @@ to add up to something in the vicinity of 0.0 or 1.0.
If we're using 32-bit floats, the first sign of trouble comes when the order is around 26.
If you look at some of the coefficients, you'll see numbers like -129026688.000 (in the 32 bit case), which
should be -129026680.721 — we have run out of bits in the mantissa!
-Even if we build Snd --with-doubles,
+With doubles
we can only push the order up to around 46.
polywave, on the other hand, builds up the sum of sines from the underlying recursion, which is only slightly
slower than using the polynomial, and it is not bothered by these numerical problems.
@@ -2557,7 +2673,7 @@ To make the difference almost appalling, here are spectra comparing a sum of osc
(table-lookup based) waveshape, and table-lookup.
</p>
-<img src="pix/4grfs.png" alt="compare ffts" hspace=40>
+<img src="pix/4grfs.png" alt="compare ffts">
<!--
(with-sound (:channels 4)
@@ -2568,13 +2684,12 @@ To make the difference almost appalling, here are spectra comparing a sum of osc
(gen3 (make-oscil 1600))
(table (make-table-lookup 100.0 :wave (partials->wave '(1 1 8 1 16 1))))
)
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 500000))
(out-any i (* .3 (+ (oscil gen1) (oscil gen2) (oscil gen3))) 0)
(out-any i (* .3 (polyshape poly)) 1)
(out-any i (* .9 (waveshape wave)) 2)
- (out-any i (* .3 (table-lookup table)) 3)))))
+ (out-any i (* .3 (table-lookup table)) 3))))
(set! (x-axis-label 0 0 1) "sum of oscils: frequency")
(set! (x-axis-label 0 1 1) "polyshape: frequency")
@@ -2582,15 +2697,15 @@ To make the difference almost appalling, here are spectra comparing a sum of osc
(set! (x-axis-label 0 3 1) "table-lookup: frequency")
-->
-<table border=1 hspace=200 vspace=10 cellpadding=6><tr><td>
-<p><small>
+<div class="inset">
+<p>
The table size is 512, but that almost doesn't matter; you'd have to use a table size of at least 8192
to approach the oscil and polyshape cases. The FFT size is 1048576, with no data window ("rectangular"), and the y-axis
is in dB, going down to -120 dB. The choice of fft window
can make a big difference; using no window, but a huge fft seems like the least confusing
way to present this result.
-</small></p>
-<p><small>
+</p>
+<p>
Notice the lower peaks in the table-lookup case. partials->wave puts n periods of the nth harmonic
in the table, so the nth harmonic has an effective table length of table-length/n. n * 1/n = 1, so all
our components have their first interpolation noise peak centered (in this case) around 7100 Hz ((512 * 100) mod 22050).
@@ -2600,14 +2715,14 @@ and 8700 Hz. The 800 Hz component makes smaller peaks (by a factor of 4, since
cases are at 7000 Hz and 7200 Hz (down in amplitude by 16^2). The highest peaks are down only 60 dB.
See <a href="#table-lookup">table-lookup</a> for more discussion of interpolation noise (it's actually
amplitude modulation of the stored signal and the linear interpolating signal with severe aliasing).
-</small></p>
-<p><small>
+</p>
+<p>
The waveshaping noise is much worse because the polynomial is so
sensitive numerically. Here is a portion of the error signal at the point where the driving sinusoid
is at its maximum:
-</small></p>
-<img src="pix/errorwave.png" alt="cheby error" hspace=40>
-</td></tr></table>
+</p>
+<img class="indented" src="pix/errorwave.png" alt="cheby error">
+</div>
<!--
;;; omitted 100 component since it is clean and I couldn't get it to cancel...
@@ -2615,7 +2730,7 @@ is at its maximum:
(let ((wave (make-waveshape 100.0 :partials '(8 1 16 1) :size 512))
(osc1 (make-oscil 1600.0 (* 0.5 pi)))
(osc2 (make-oscil 800.0 (* 0.5 pi))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000000))
(outa i (- (waveshape wave)
(* 1/2 (+ (oscil osc1)
@@ -2626,7 +2741,7 @@ is at its maximum:
<!-- this works: (make-waveshape 100.0 :partials '(1 1) :size 2)
because the initial "polynomial" is a straight line:
:(mus-data (make-waveshape 100.0 :partials '(1 1) :size 2))
- #<vct[len=2]: -1.000 1.000>
+ #(-1.000 1.000)
and we use array-interp to drive it with a sinusoid, so x=x!
-->
@@ -2634,66 +2749,98 @@ is at its maximum:
See also <a href="#polyoid">polyoid and noid</a> in generators.scm.
</p>
-<br><br>
-<A NAME="sawtoothdoc"></A>
-<!-- ---------------------------------------- SAWTOOTH ETC ---------------------------------------- -->
+<!-- SAWTOOTH ETC -->
-<table width="70%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>sawtooth-wave, triangle-wave, pulse-train, square-wave</h3></center></td></tr></table>
-<br>
-<pre>
- <a class=def name="make-triangle-wave">make-triangle-wave</a> (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase pi)
- <a class=def name="triangle-wave">triangle-wave</a> s (fm 0.0)
- <a class=def name="triangle-wave?">triangle-wave?</a> s
+<div class="innerheader" id="sawtoothdoc">sawtooth-wave, triangle-wave, pulse-train, square-wave</div>
+
+<pre class="indented">
+<em class=def id="make-triangle-wave">make-triangle-wave</em> (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase pi)
+<em class=def id="triangle-wave">triangle-wave</em> s (fm 0.0)
+<em class=def id="triangle-wave?">triangle-wave?</em> s
- <a class=def name="make-square-wave">make-square-wave</a> (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0)
- <a class=def name="square-wave">square-wave</a> s (fm 0.0)
- <a class=def name="square-wave?">square-wave?</a> s
+<em class=def id="make-square-wave">make-square-wave</em> (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase 0)
+<em class=def id="square-wave">square-wave</em> s (fm 0.0)
+<em class=def id="square-wave?">square-wave?</em> s
- <a class=def name="make-sawtooth-wave">make-sawtooth-wave</a> (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase pi)
- <a class=def name="sawtooth-wave">sawtooth-wave</a> s (fm 0.0)
- <a class=def name="sawtooth-wave?">sawtooth-wave?</a> s
+<em class=def id="make-sawtooth-wave">make-sawtooth-wave</em> (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase pi)
+<em class=def id="sawtooth-wave">sawtooth-wave</em> s (fm 0.0)
+<em class=def id="sawtooth-wave?">sawtooth-wave?</em> s
+
+<em class=def id="make-pulse-train">make-pulse-train</em> (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase (* 2 pi))
+<em class=def id="pulse-train">pulse-train</em> s (fm 0.0)
+<em class=def id="pulse-train?">pulse-train?</em> s
+</pre>
+
+<table class="method">
+<tr><td colspan=2 class="methodtitle">saw-tooth and friends' methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">amplitude arg used in make-<gen></td></tr>
+<tr><td class="inner"><em class=gen>mus-width</em></td><td class="inner">width of square-wave pulse (0.0 to 1.0)</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">frequency in radians per sample</td></tr>
+</table>
+
+<p>These generators produce some standard old-timey wave forms that are still occasionally useful (well, triangle-wave
+is useful; the others are silly).
+One popular kind of vibrato is:
+</p>
- <a class=def name="make-pulse-train">make-pulse-train</a> (frequency *clm-default-frequency*) (amplitude 1.0) (initial-phase (* 2 pi))
- <a class=def name="pulse-train">pulse-train</a> s (fm 0.0)
- <a class=def name="pulse-train?">pulse-train?</a> s
+<pre class="indented">
+ (+ (triangle-wave pervib)
+ (<a class=quiet href="#rand-interp">rand-interp</a> ranvib))
</pre>
+<p>sawtooth-wave ramps from -1 to 1, then goes immediately back to -1.
+Use a negative frequency to turn the "teeth" the other way.
+To get a sawtooth from 0 to 1, you can use modulo:
+</p>
+<pre class="indented">
+(with-sound () (do ((i 0 (+ i 1)) (x 0.0 (+ x .01))) ((= i 22050)) (outa i (modulo x 1.0))))
+</pre>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<p>
+triangle-wave ramps from -1 to 1, then ramps from 1 to -1.
+pulse-train produces a single sample of 1.0, then zeros.
+square-wave produces 1 for half a period, then 0. All have a period
+of two pi, so the "fm" argument should have an effect comparable to the
+same FM applied to the same waveform in <a href="#table-lookup">table-lookup</a>.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((gen (make-triangle-wave 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (* 0.5
- (triangle-wave gen))))))
+ (outa i (* 0.5 (triangle-wave gen))))))
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
gen = make_triangle_wave(440.0);
44100.times do |i|
- outa(i, 0.5 * triangle_wave(gen),
- $output)
+ outa(i, 0.5 * triangle_wave(gen), $output)
end
end.output
</pre>
+</div>
</td>
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+</tr><tr>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 make-triangle-wave { gen }
44100 0 do
@@ -2701,61 +2848,26 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-
-<table border=1 align=left hspace=40 vspace=20 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>saw-tooth and friends' methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>amplitude arg used in make-<gen></td></tr>
-<tr><td><em class=gen>mus-width</em></td><td>width of square-wave pulse (0.0 to 1.0)</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-</table>
-<pre>
-<br>
-One popular kind of vibrato is:
- (+ (triangle-wave pervib)
- (<a class=quiet href="#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand-interp</a> ranvib))
-</pre><br clear=left>
-
-<p>These generators produce some standard old-timey wave forms that are still occasionally useful (well, triangle-wave
-is useful; the others are silly).
-sawtooth-wave ramps from -1 to 1, then goes immediately back to -1.
-Use a negative frequency to turn the "teeth" the other way.
-To get a sawtooth from 0 to 1, you can use modulo:
-</p>
-<pre>
- (with-sound () (do ((i 0 (+ i 1)) (x 0.0 (+ x .01))) ((= i 22050)) (outa i (modulo x 1.0))))
-</pre>
-<p>
-triangle-wave ramps from -1 to 1, then ramps from 1 to -1.
-pulse-train produces a single sample of 1.0, then zeros.
-square-wave produces 1 for half a period, then 0. All have a period
-of two pi, so the "fm" argument should have an effect comparable to the
-same FM applied to the same waveform in <a href="#table-lookup">table-lookup</a>.
-To get a square-wave with control over the "duty-factor":
+<p>To get a square-wave with control over the "duty-factor":
</p>
-<table border=0 hspace=40>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let* ((duty-factor .25) ; ratio of pulse duration to pulse period
(p-on (<em class=red>make-pulse-train</em> 100 0.5))
(p-off (<em class=red>make-pulse-train</em> 100 -0.5 (* 2 pi (- 1.0 duty-factor))))
(sum 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(set! sum (+ sum (<em class=red>pulse-train</em> p-on) (<em class=red>pulse-train</em> p-off)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i sum))))
+ (<a class=quiet href="#outa">outa</a> i sum))))
</pre>
-</td></tr>
-</table>
<p>
This is the <a href="#adjustable-square-wave">adjustable-square-wave</a> generator in generators.scm.
@@ -2766,256 +2878,25 @@ A more reasonable square-wave can be generated via
<code>(tanh (* B (sin theta)))</code>, where "B" (a float) sets how squared-off it is:
</p>
-<!-- MAXIMA:
-
-(%i25) g:tanh(x);
-(%o25) tanh(x)
-
-(%i26) taylor(g, x, 0, 30);
- 3 5 7 9 11 13 15
- x 2 x 17 x 62 x 1382 x 21844 x 929569 x
-(%o26)/T/ x - -- + ---- - ----- + ----- - -------- + --------- - ----------
- 3 15 315 2835 155925 6081075 638512875
- 17 19 21 23
- 6404582 x 443861162 x 18888466084 x 113927491862 x
- + ----------- - ------------- + --------------- - ----------------
- 10854718875 1856156927625 194896477400625 2900518163668125
- 25 27 29
- 58870668456604 x 8374643517010684 x 689005380505609448 x
- + ------------------- - ---------------------- + ------------------------
- 3698160658676859375 1298054391195577640625 263505041412702261046875
- + . . .
-
-
-(%i27) %o26, x=sin(z);
- 29 27
-(%o27)/R/ (689005380505609448 sin (z) - 1700052633953168852 sin (z)
- 25 23
- + 4194711739538404812 sin (z) - 10350036361494934650 sin (z)
- 21 19
- + 25537691106934706700 sin (z) - 63011727151730106750 sin (z)
- 17 15
- + 155475205260997371750 sin (z) - 383619700449993632625 sin (z)
- 13 11
- + 946543847036760472500 sin (z) - 2335507245357412376250 sin (z)
- 9 7
- + 5762720482394194068750 sin (z) - 14220906996875995040625 sin (z)
- 5 3
- + 35134005521693634806250 sin (z) - 87835013804234087015625 sin (z)
- + 263505041412702261046875 sin(z))/263505041412702261046875
-
-(%i28) trigreduce(%);
-(%o28) (86125672563201181 sin(29 z) - 1647618187356249823 sin(27 z)
- + 20405735981368709608 sin(25 z) - 143279266372116745248 sin(23 z)
- + 988870340521967329881 sin(21 z) - 2752920136953483215355 sin(19 z)
- + 29747753151337835654040 sin(17 z) + 129373079585789187237960 sin(15 z)
- + 2185282463071876214254065 sin(13 z) + 24072873961147105570521045 sin(11 z)
- + 287379988570533329332221360 sin(9 z) + 3380634686040416561206315320 sin(7 z)
- + 39937948481686006738647866205 sin(5 z)
- + 479626886628129180815136726345 sin(3 z)
- + 7176645106520349975113077043760 sin(z))/8841761993739701954543616000000
-
-
-
-(%i40) tanh(sin(x));
-(%o40) tanh(sin(x))
-
-(%i41) exponentialize(%);
- %i x - %i x %i x - %i x
- %i (%e - %e ) %i (%e - %e )
- - ---------------------- ----------------------
- 2 2
- %e - %e
-(%o41) -----------------------------------------------------
- %i x - %i x %i x - %i x
- %i (%e - %e ) %i (%e - %e )
- ---------------------- - ----------------------
- 2 2
- %e + %e
-
-(%i42) ratsimp (%);
- %i x - %i x
- %i %e %i %e
- %e - %e
-(%o42) - ---------------------------
- %i x - %i x
- %i %e %i %e
- %e + %e
-
-(%i44) demoivre(%o42);
- %i (%i sin(x) + cos(x)) %i (cos(x) - %i sin(x))
- %e - %e
-(%o44) - -----------------------------------------------------
- %i (%i sin(x) + cos(x)) %i (cos(x) - %i sin(x))
- %e + %e
-
-(%i45) trigsimp(%);
- 2 sin(x)
- %e - 1
-(%o45) --------------
- 2 sin(x)
- %e + 1
-
-(%i46) factor(%);
- sin(x) sin(x)
- (%e - 1) (%e + 1)
-(%o46) -----------------------------
- 2 sin(x)
- %e + 1
-;; if B sin x:
-(%i53) trigsimp(%);
- 2 sin(x) B
- %e - 1
-(%o53) ----------------
- 2 sin(x) B
- %e + 1
-
-(%i79) bfloat(%o28);
-(%o79) 1.130996288644772B-31 (8.612567256320118B16 sin(2.9B1 z)
- - 1.64761818735625B18 sin(2.7B1 z) + 2.040573598136871B19 sin(2.5B1 z)
- - 1.432792663721167B20 sin(2.3B1 z) + 9.888703405219673B20 sin(2.1B1 z)
- - 2.752920136953483B21 sin(1.9B1 z) + 2.974775315133784B22 sin(1.7B1 z)
- + 1.293730795857892B23 sin(1.5B1 z) + 2.185282463071876B24 sin(1.3B1 z)
- + 2.407287396114711B25 sin(1.1B1 z) + 2.873799885705333B26 sin(9.0B0 z)
- + 3.380634686040417B27 sin(7.0B0 z) + 3.993794848168601B28 sin(5.0B0 z)
- + 4.796268866281292B29 sin(3.0B0 z) + 7.17664510652035B30 sin(z))
-(%i80) expand(%);
-(%o80) 9.740781602601538B-15 sin(2.9B1 z) - 1.863450055003545B-13 sin(2.7B1 z)
- + 2.307881166199309B-12 sin(2.5B1 z) - 1.620483185066097B-11 sin(2.3B1 z)
- + 1.118408685081237B-10 sin(2.1B1 z) - 3.113542457829846B-10 sin(1.9B1 z)
- + 3.36445984096839B-9 sin(1.7B1 z) + 1.463204728620722B-8 sin(1.5B1 z)
- + 2.471546355374797B-7 sin(1.3B1 z) + 2.722633110707074B-6 sin(1.1B1 z)
- + 3.250257005040501B-5 sin(9.0B0 z) + 3.823485283175494B-4 sin(7.0B0 z)
- + 4.516967150887297B-3 sin(5.0B0 z) + 5.424562287106608B-2 sin(3.0B0 z)
- + 8.116758980395178B-1 sin(z)
-
-(%i4) (%e^(2*B*sin(x))-1)/(%e^(2*B*sin(x))+1);
- 2 sin(x) B
- %e - 1
-(%o4) ----------------
- 2 sin(x) B
- %e + 1
-(%i5) taylor(%, x, 0, 20);
- 3 3 5 3 5
- (2 B + B) x (16 B + 20 B + B) x
-(%o5)/T/ B x - ------------- + ----------------------
- 6 120
- 7 5 3 7
- (272 B + 560 B + 182 B + B) x
- - ---------------------------------
- 5040
- 9 7 5 3 9
- (7936 B + 22848 B + 15456 B + 1640 B + B) x
- + ------------------------------------------------
- 362880
- 11 9 7 5 3 11
- (353792 B + 1309440 B + 1382304 B + 399520 B + 14762 B + B) x
- - ---------------------------------------------------------------------
- 39916800
- 13 11 9 7 5
- + ((22368256 B + 101184512 B + 146395392 B + 74524736 B + 10106096 B
- 3 13 15 13
- + 132860 B + B) x )/6227020800 - ((1903757312 B + 10177556480 B
- 11 9 7 5 3
- + 18769726976 B + 14032395520 B + 3823515696 B + 253715280 B + 1195742 B
- 15 17 15
- + B) x )/1307674368000 + ((209865342976 B + 1294554972160 B
- 13 11 9 7
- + 2906710130688 B + 2896710209536 B + 1248180730368 B + 191665428864 B
- 5 3 17
- + 6352447936 B + 10761680 B + B) x )/355687428096000
- 19 17 15
- - ((29088885112832 B + 203359517343744 B + 538664323915776 B
- 13 11 9
- + 674376523857920 B + 406146637591552 B + 106694759907840 B
- 7 5 3 19
- + 9499597629248 B + 158897291840 B + 96855122 B + B) x )
-/121645100408832000 + . . .
-
-
-;;; the B^3 term is (9^n - 1)/4 (Sloane encyc A12587)
-;;; (do ((n 0 (+ n 1))) ((= n 8)) (format #t "~A " (/ (- (expt 9 n) 1) 4)))
-;;; 0 2 20 182 1640 14762 132860 1195742
-
-;;; B^5 is some 25^n business:
-;;; Sloane A002453:
-;;; (do ((n 0 (+ n 1))) ((= n 8)) (format #t "~A " (* (+ (* 625 (expt 25 n)) (* -243 (expt 9 n)) 2) 16/384)))
-;;; 16 560 15456 399520 10106096 253715280 6352447936 158897291840 "central factorial"
-
-;;; B^7 is 49
-;;; B^9 is probably 81 etc
-
-
-(%o3) tanh(sin(y) + sin(x))
-(%i4) exponentialize(%)
-;
- %i y - %i y %i x - %i x
- %i (%e - %e ) %i (%e - %e )
- - ---------------------- - ----------------------
- 2 2
-(%o4) (%e
- %i y - %i y %i x - %i x
- %i (%e - %e ) %i (%e - %e )
- ---------------------- + ----------------------
- 2 2
- - %e )
- %i y - %i y %i x - %i x
- %i (%e - %e ) %i (%e - %e )
- ---------------------- + ----------------------
- 2 2
-/(%e
- %i y - %i y %i x - %i x
- %i (%e - %e ) %i (%e - %e )
- - ---------------------- - ----------------------
- 2 2
- + %e )
-(%i5) ratsimp(%);
- %i y %i x - %i y - %i x
- %i %e + %i %e %i %e + %i %e
- %e - %e
-(%o5) - -----------------------------------------------------
- %i y %i x - %i y - %i x
- %i %e + %i %e %i %e + %i %e
- %e + %e
-(%i6) demoivre(%);
- %i (%i sin(y) + cos(y)) + %i (%i sin(x) + cos(x))
-(%o6) - (%e
- %i (cos(y) - %i sin(y)) + %i (cos(x) - %i sin(x))
- - %e )
- %i (%i sin(y) + cos(y)) + %i (%i sin(x) + cos(x))
-/(%e
- %i (cos(y) - %i sin(y)) + %i (cos(x) - %i sin(x))
- + %e )
-(%i7) trigsimp(%);
- 2 sin(y) + 2 sin(x)
- %e - 1
-(%o7) -------------------------
- 2 sin(y) + 2 sin(x)
- %e + 1
-
--->
-
+<!-- the maxima experiments are in maxima.clm -->
-<table border=1 hspace=20 vspace=10>
+<table>
<tr>
-<td bgcolor="#f2f4ff"><center>B: 1.0</center></td>
-<td width=16></td>
-<td bgcolor="#f2f4ff"><center>B: 3.0</center></td>
-<td width=16></td>
-<td bgcolor="#f2f4ff"><center>B: 100.0</center></td>
+<td class="br">B: 1.0</td>
+<td class="br">B: 3.0</td>
+<td class="br">B: 100.0</td>
</tr>
<tr>
-<td>
+<td class="br">
<img src="pix/tanh1.png" alt="tanh 1">
</td>
-<td width=16></td>
-<td>
+<td class="br">
<img src="pix/tanh3.png" alt="tanh 1">
</td>
-<td width=16></td>
-<td>
+<td class="br">
<img src="pix/tanh100.png" alt="tanh 1">
-</td></tr></table>
+</td>
+</tr></table>
<!-- LATEX: sceq11
\tanh(x) = x-\frac{x^{3}}{3}+\frac{2x^{5}}{15}-\frac{17x^{7}}{315}+\frac{62x^{9}}{2835}-\frac{1382x^{11}}{155925}\cdots
@@ -3046,28 +2927,28 @@ fourth try (break it in 2!!):
fifth try: do it as one, and set the "MediaBox" line in the pdf file by hand!!
\tanh(B \sin(x)) = \frac{-i \sin(iB \sin(x))}{\cos(iB \sin(x))} = \frac{2 \sum_{k=0}^{\infty} (-1)^{k} I_{2k+1}(B) \sin(2k+1)x}{\cos(iB \sin(x))} = \frac{e^{2B\sin(x)} - 1}{e^{2B\sin(x)}+1}
-
-->
-<br>
-<center>
-<table hspace=40 border=0 cellpadding=8>
-<tr><td>
+
<p>
The spectrum of tanh(sin) can be obtained by expanding tanh as a power series:
</p>
-<img src="pix/sceq11.png" alt="tanh power series" hspace=20>
+
+<img class="indented" src="pix/sceq11.png" alt="tanh power series">
+
<p>
plugging in "sin" for "x", expanding the sine powers, and collecting terms (very tedious —
-use <a class=quiet onmouseout="UnTip()" onmouseover="Tip('<pre>(%i25) g:tanh(x);<br>(%o25) tanh(x)<br><br>(%i26) taylor(g, x, 0, 30);<br> 3 5 7 9 11 13 15<br> x 2 x 17 x 62 x 1382 x 21844 x 929569 x<br>(%o26)/T/ x - -- + ---- - ----- + ----- - -------- + --------- - ----------<br> 3 15 315 2835 155925 6081075 638512875<br> 17 19 21 23<br> 6404582 x 443861162 x 18888466084 x 113927491862 x<br> + ----------- - ------------- + --------------- - ----------------<br> 10854718875 1856156927625 194896477400625 2900518163668125<br> 25 27 29<br> 58870668456604 x 8374643517010684 x 689005380505609448 x<br> + ------------------- - ---------------------- + ------------------------<br> 3698160658676859375 1298054391195577640625 263505041412702261046875<br> + . . .<br></pre>')">maxima</a>!):
+use maxima!):
</p>
-<img src="pix/sceq12.png" alt="tanh sin power series" hspace=20>
+
+<img class="indented" src="pix/sceq12.png" alt="tanh sin power series">
+
<p>
which is promising since a square wave is made up of odd harmonics with amplitude 1/n.
As the "B" in tanh(B sin(x)) increases above pi/2, this series doesn't apply.
</p>
-<img src="pix/tanhsum.png" alt="more tanh" hspace=20>
+<img class="indented" src="pix/tanhsum.png" alt="more tanh">
<p>but I haven't found a completion of this expansion that isn't ugly when B > pi/2.
In any case, we can check the
@@ -3076,8 +2957,6 @@ So we do get a square wave, but it's not band limited. If a complex signal repl
we get "intermodulation products" (sum and difference tones); this use of tanh as a soft clipper
goes way back — I don't know who invented it.
</p>
-</td></tr></table>
-</center>
<p>If you try to make a square wave by adding harmonics at amplitude 1/n,
you run into "Gibb's phenomenon": although the sum
@@ -3089,16 +2968,14 @@ way to do this (<a href="http://www.tweedledum.com/rwg/gibbs.html">gibbs.html</a
We could also use <a href="sndscm.html#withmixedsound">with-mixed-sound</a> and the Mixes dialog:
</p>
-<table hspace=40 border=0><tr><td>
-<pre>
+<pre class="indented">
(definstrument (sine-wave start dur freq amp)
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq)))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc)))))))
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
+ (osc (<a class=quiet href="#make-oscil">make-oscil</a> freq)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<a class=quiet href="#oscil">oscil</a> osc))))))
(<em class=red>with-mixed-sound</em> ()
(sine-wave 0 1 10.0 1.0)
@@ -3106,7 +2983,6 @@ We could also use <a href="sndscm.html#withmixedsound">with-mixed-sound</a> and
(sine-wave 0 1 50.0 .2)
(sine-wave 0 1 70.0 .143))
</pre>
-</td></tr></table>
<p>
Now we can play with the
@@ -3119,26 +2995,24 @@ the Gibbs overshoot is not reduced by adding lots more components).
The peak amplitude should be pi/4, but the Gibbs phenomenon adds .14.
</p>
-<img src="pix/smoothsq.png" alt="reduce Gibbs" hspace=40>
-<br>
+<img class="indented" src="pix/smoothsq.png" alt="reduce Gibbs">
<!--
(definstrument (sine-wave start dur freq amp)
(let* ((beg (seconds->samples start))
(end (+ beg (seconds->samples dur)))
(osc (make-oscil freq)))
- (run
- (do ((i beg (+ 1 i)))
+ (do ((i beg (+ i 1)))
((= i end))
- (outa i (* amp (oscil osc)))))))
+ (outa i (* amp (oscil osc))))))
-(with-sound (:output "4-sines.snd")
+(with-sound ("4-sines.snd")
(sine-wave 0 1 10.0 1.0)
(sine-wave 0 1 30.0 .333)
(sine-wave 0 1 50.0 .2)
(sine-wave 0 1 70.0 .143))
-(with-sound (:output "100-sines.snd")
+(with-sound ("100-sines.snd")
(do ((i 1 (+ i 2)))
((> i 200))
(sine-wave 0 1 (* i 10.0) (/ 1.0 i))))
@@ -3157,26 +3031,24 @@ tanh(B sin(x)) produces a nice square wave,
we can truncate its spectrum at the desired number of harmonics:
</p>
-
-<table hspace=40 border=0><tr><td>
-<pre>
+<pre class="indented">
(define square-wave->coeffs
(let ((previous-results (make-vector 128 #f)))
(lambda* (n B)
(or (and (< n 128)
(not B)
(previous-results n))
- (let* ((coeffs (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> (* 2 n)))
+ (let* ((coeffs (make-float-vector (* 2 n) 0.0))
(size (expt 2 12))
- (rl (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (im (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
+ (rl (make-float-vector size 0.0))
+ (im (make-float-vector size 0.0))
(incr (/ (* 2 pi) size))
(index (or B (max 1 (floor (/ n 2))))))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(x 0.0 (+ x incr)))
((= i size))
(set! (rl i) (<em class=red>tanh</em> (* index (<em class=red>sin</em> x))))) ; make our desired square wave
- (<a class=quiet href="#spectrum" onmouseout="UnTip()" onmouseover="Tip(sndclm_spectrum_tip)">spectrum</a> rl im #f 2) ; get its spectrum
+ (<a class=quiet href="#spectrum">spectrum</a> rl im #f 2) ; get its spectrum
(do ((i 0 (+ i 1))
(j 0 (+ j 2)))
((= i n))
@@ -3187,33 +3059,33 @@ we can truncate its spectrum at the desired number of harmonics:
(set! (previous-results n) coeffs))
coeffs)))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let* ((samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> 1.0))
- (wave (<a class=quiet href="#make-polywave" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_polywave_tip)">make-polywave</a> 100.0
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (let* ((samps (<a class=quiet href="#secondstosamples">seconds->samples</a> 1.0))
+ (wave (<a class=quiet href="#make-polywave">make-polywave</a> 100.0
:partials (<em class=red>square-wave->coeffs</em> 16)
:type mus-chebyshev-second-kind)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* 0.5 (<a class=quiet href="#polywave" onmouseout="UnTip()" onmouseover="Tip(sndclm_polywave_tip)">polywave</a> wave)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (<a class=quiet href="#outa">outa</a> i (* 0.5 (<a class=quiet href="#polywave">polywave</a> wave))))))
</pre>
-</td></tr></table>
-<table border=1 hspace=20 cellpadding=10 vspace=10><tr><td>
-<img src="pix/tanhexs.png">
+<table class="method"><tr><td>
+<img src="pix/tanhexs.png" alt="tanh">
</td></tr></table>
+
<p>See also <a href="#tanhsin">tanhsin</a> in generators.scm.
Another square-wave choice is <a href="#eoddcos">eoddcos</a> in <a href="#othergenerators">generators.scm</a>,
based on atan; as its "r" parameter approaches 0.0, you get closer to a square wave.
Even more amusing is this algorithm (related to tanh(sin)):
-<img src="pix/sceq13.png" alt="square" align=absmiddle hspace=10>
+</p>
+
+<img class="indented" src="pix/sceq13.png" alt="square">
+
<!-- CMJ 37 4 sept 2006 p326 -->
<!-- LATEX: \frac{(c+1)^{\cos t}-(c-1)^{\cos t}}{(c+1)^{\cos t}+(c-1)^{\cos t}} -->
-</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (cossq c theta) ; as c -> 1.0+, more of a square wave (try 1.00001)
(let* ((cs (cos theta)) ; (+ theta pi) if matching sin case (or (- ...))
(cp1 (+ c 1.0))
@@ -3226,34 +3098,30 @@ Even more amusing is this algorithm (related to tanh(sin)):
(define (sinsq c theta) (cossq c (- theta (* 0.5 pi))))
(define (sqsq c theta) (sinsq c (- (sinsq c theta)))) ; a sharper square wave
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((angle 0.0))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(angle 0.0 (+ angle 0.02)))
((= i 44100))
(outa i (* 0.5 (+ 1.0 (sqsq 1.001 angle)))))))
</pre>
-</td></tr></table>
<p>And in the slightly batty category is this method which uses only nested sines:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((angle 0.0) (z 1.18)
- (incr (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 100.0)))
- (do ((i 0 (+ 1 i)))
+ (incr (<a class=quiet href="#hztoradians">hz->radians</a> 100.0)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (let* ((result (* z (sin angle))))
- (do ((k 0 (+ 1 k)))
+ (let ((result (* z (sin angle))))
+ (do ((k 0 (+ k 1)))
((= k 100)) ; the limit here sets how square it is, and also the overall amplitude
(set! result (* z (sin result))))
(set! angle (+ angle incr))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i result)))))
+ (<a class=quiet href="#outa">outa</a> i result)))))
</pre>
-</td></tr></table>
-
<p>The continuously variable square-wave, tanh(B sin), can be differentiated to get a variable pulse-train,
@@ -3261,12 +3129,10 @@ or integrated to get a variable triangle-wave.
The derivative is B * cos(x) / (cosh^2(B * sin(x))):
</p>
-<table border=0 hspace=40><tr><td width=450>
-<pre>
+<pre class="indented">
(with-sound ()
- (let* ((Benv (make-env '(0 .1 .1 1 .7 2 2 5)
- :end 10000))
- (osc (make-oscil 100)))
+ (let ((Benv (make-env '(0 .1 .1 1 .7 2 2 5) :end 10000))
+ (osc (make-oscil 100)))
(do ((i 0 (+ i 1)))
((= i 10000))
(let* ((B (env Benv))
@@ -3274,44 +3140,40 @@ The derivative is B * cos(x) / (cosh^2(B * sin(x))):
(den (cosh (* B (oscil osc)))))
(outa i (/ num (* den den)))))))
</pre>
-</td><td>
-<img src="pix/tanhsinderiv.png" alt="tanh(sin) as pulse train">
-</td></tr></table>
+
+<img class="indented" src="pix/tanhsinderiv.png" alt="tanh(sin) as pulse train">
+
<p>
Similar, but simpler is B*cos(x)/(e^(B*cos(x)) - 1):
</p>
-<table border=0 hspace=40><tr><td width=480>
-<pre>
+<pre class="indented">
(with-sound ()
- (let* ((gen (make-oscil 40.0))
- (Benv (make-env '(0 .75 1 1.5 2 20)
- :end 10000)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i 10000))
- (let* ((B (env Benv))
- (arg (* B pi (+ 1.0 (oscil gen)))))
- (outa i (/ arg (- (exp arg) 1))))))))
+ (let ((gen (make-oscil 40.0))
+ (Benv (make-env '(0 .75 1 1.5 2 20) :end 10000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (let* ((B (env Benv))
+ (arg (* B pi (+ 1.0 (oscil gen)))))
+ (outa i (/ arg (- (exp arg) 1)))))))
</pre>
-</td><td>
-<img src="pix/xex.png" alt="another pulse train">
-</td></tr></table>
+
+<img class="indented" src="pix/xex.png" alt="another pulse train">
+
<p>
When we integrate tanh(B sin), the peak amp depends
on both the frequency and the "B" factor (which sets how close we get to a triangle wave):
</p>
-<table border=0 hspace=40><tr><td width=450>
-<pre>
+<pre class="indented">
(with-sound ()
- (let* ((gen (make-oscil 30.0))
- (Benv (make-env '(0 .1 .25 1 2 3 3 10)
- :end 20000))
- (scl (hz->radians 30.0))
- (sum 0.0))
+ (let ((gen (make-oscil 30.0))
+ (Benv (make-env '(0 .1 .25 1 2 3 3 10)
+ :end 20000))
+ (scl (hz->radians 30.0))
+ (sum 0.0))
(do ((i 0 (+ i 1)))
((= i 20000))
(let* ((B (env Benv))
@@ -3321,13 +3183,13 @@ on both the frequency and the "B" factor (which sets how close we get to a trian
(outa i (- sum 1.0))
(set! sum (+ sum val))))))
</pre>
-</td><td>
-<img src="pix/tanhsininteg.png" alt="tanh(sin) as triangle-wave">
-</td></tr></table>
+
+<img class="indented" src="pix/tanhsininteg.png" alt="tanh(sin) as triangle-wave">
+
<!--
-(set! (selected-graph-color) (make-color 1 1 1))
-(set! (selected-data-color) (make-color 0 0 0))
+(set! *selected-graph-color* (make-color 1 1 1))
+(set! *selected-data-color* (make-color 0 0 0))
(set! (x-axis-label 0 0 0) "derivative of tanh(B*sin), B from .1 to 5")
(set! (x-axis-label 0 0 0) "integration of tanh(B*sin), B from .1 to 10")
-->
@@ -3339,23 +3201,20 @@ For sawtooth output, see also <a href="#rksin">rksin</a>.
In these generators, the "fm" argument is useful mainly for various sci-fi sound effects:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (tritri start dur freq amp index mcr)
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(carrier (<em class=red>make-triangle-wave</em> freq))
(modulator (<em class=red>make-triangle-wave</em> (* mcr freq))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<em class=red>triangle-wave</em> carrier
- (* index (<em class=red>triangle-wave</em> modulator)))))))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<em class=red>triangle-wave</em> carrier
+ (* index (<em class=red>triangle-wave</em> modulator))))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100) (tritri 0 1 1000.0 0.5 0.1 0.01)) ; sci-fi laser gun
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100) (tritri 0 1 4000.0 0.7 0.1 0.01)) ; a sparrow?
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:srate 44100) (tritri 0 1 1000.0 0.5 0.1 0.01)) ; sci-fi laser gun
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:srate 44100) (tritri 0 1 4000.0 0.7 0.1 0.01)) ; a sparrow?
</pre>
-</td></tr></table>
<p>On the other hand, animals.scm uses pulse-train's fm argument to track a frequency envelope,
triggering a new peep each time the pulse goes by.
@@ -3364,44 +3223,67 @@ used. Even triangle-wave(square-wave) can make funny noises. See <a href="#nco
for more dicussion about using these generators as FM modulators.
</p>
-<br><br>
-<A NAME="ncosdoc"></A>
-<!-- ---------------------------------------- NCOS, NSIN ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>ncos and nsin</h3></center></td></tr></table>
-<br>
+<!-- NCOS, NSIN -->
-<pre>
- <a class=def name="make-ncos">make-ncos</a> (frequency *clm-default-frequency*) (n 1)
- <a class=def name="ncos">ncos</a> nc (fm 0.0)
- <a class=def name="ncos?">ncos?</a> nc
+<div class="innerheader" id="ncosdoc">ncos and nsin</div>
+
+<pre class="indented">
+<em class=def id="make-ncos">make-ncos</em> (frequency *clm-default-frequency*) (n 1)
+<em class=def id="ncos">ncos</em> nc (fm 0.0)
+<em class=def id="ncos?">ncos?</em> nc
- <a class=def name="make-nsin">make-nsin</a> (frequency *clm-default-frequency*) (n 1)
- <a class=def name="nsin">nsin</a> ns (fm 0.0)
- <a class=def name="nsin?">nsin?</a> ns
+<em class=def id="make-nsin">make-nsin</em> (frequency *clm-default-frequency*) (n 1)
+<em class=def id="nsin">nsin</em> ns (fm 0.0)
+<em class=def id="nsin?">nsin?</em> ns
</pre>
-<br>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">ncos methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">(/ 1.0 cosines)</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">n or cosines arg used in make-<gen></td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">frequency in radians per sample</td></tr>
+</table>
+
+<p>ncos produces a band-limited pulse train containing
+"n" cosines. I think this was originally viewed as a way to get a speech-oriented
+pulse train that would then be passed through formant filters (see pulse-voice in examp.scm).
+Set "n" to srate/2 to get a pulse-train (a single non-zero sample). These generators are based on the Dirichlet kernel:
+</p>
-<tr>
-<td bgcolor="#f0f4ff">
+<!-- LATEX: \sum_{k=0}^{n}\cos kx = \frac{1}{2}\Bigg(1+\frac{\sin(n+\frac{1}{2})x}{\sin \frac{x}{2}}\Bigg) -->
+<img class="indented" src="pix/sceq2.png" alt="sum of cosines">
+<!--
+ cos(x) + cos(2x) + ... cos(nx) =
+ (sin((n + .5)x) / (2 * sin(x / 2))) - 1/2
+-->
<pre>
+</pre>
+
+<table>
+<tr>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((gen (make-ncos 440.0 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (ncos gen))))))
</pre>
+</div>
</td>
-<td width=4></td>
+</tr><tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
gen = make_ncos(440.0, 10);
44100.times do |i|
@@ -3409,11 +3291,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
-<td width=4></td>
-<td bgcolor="#effdef">
-<pre>
+</tr><tr>
+
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 10 make-ncos { gen }
44100 0 do
@@ -3421,16 +3306,13 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<p>ncos produces a band-limited pulse train containing
-"n" cosines. I think this was originally viewed as a way to get a speech-oriented
-pulse train that would then be passed through formant filters (see pulse-voice in examp.scm).
-Set "n" to srate/2 to get a pulse-train (a single non-zero sample).
-There are many similar formulas:
+<p>There are many similar formulas:
see <a href="#ncos2">ncos2</a> and friends in <a href="#othergenerators">generators.scm</a>. "Trigonometric Delights" by Eli Maor has
a derivation of the nsin formula and a neat
geometric explanation. For a derivation of the ncos formula, see "Fourier
@@ -3439,70 +3321,41 @@ formula 2sin(a)cos(b) = sin(b+a)-sin(b-a), and notice that all the terms in the
cancel except the last.
</p>
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>ncos methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>(/ 1.0 cosines)</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>n or cosines arg used in make-<gen></td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-</table>
-<pre>
-<br>
-based on:
-</pre>
-<!-- LATEX: \sum_{k=0}^{n}\cos kx = \frac{1}{2}\Bigg(1+\frac{\sin(n+\frac{1}{2})x}{\sin \frac{x}{2}}\Bigg) -->
-<img src="pix/sceq2.png" alt="sum of cosines" hspace=40>
-<!--
- cos(x) + cos(2x) + ... cos(nx) =
- (sin((n + .5)x) / (2 * sin(x / 2))) - 1/2
--->
-<pre>
-the Dirichlet kernel
-see also <a href="#othergenerators">generators.scm</a>
-</pre><br clear=left>
-
-<br>
-<table border=0 hspace=40>
-<tr>
-<td>
-<pre>
+<pre class="indented">
(define (simple-soc beg dur freq amp)
(let* ((os (<em class=red>make-ncos</em> freq 10))
- (start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i))) ((= i end))
- (outa i (* amp (<em class=red>ncos</em> os)))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (simple-soc 0 1 100 1.0))
-</pre></td>
-<td>
-<img src="pix/cosines.png" alt="sum of cosines example" hspace=10>
-</td></tr></table>
+ (start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))))
+ (do ((i start (+ i 1))) ((= i end))
+ (outa i (* amp (<em class=red>ncos</em> os))))))
+
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (simple-soc 0 1 100 1.0))
+</pre>
+
+<img class="indented" src="pix/cosines.png" alt="sum of cosines example">
+
<p>The <a href="#sinc-train">sinc-train</a> generator (in generators.scm) is very similar to ncos.
If you use ncos as the FM modulating signal, you may be surprised and disappointed.
As the modulating signal approaches a spike (as n increases), the bulk of the energy collapses back onto the carrier:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(for-each
(lambda (arg)
- (let ((car1 (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 1000))
+ (let ((car1 (<a class=quiet href="#make-oscil">make-oscil</a> 1000))
(mod1 (<em class=red>make-ncos</em> 100 (cadr arg)))
- (start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> (car arg)))
- (samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> 1.0))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 20 1 21 0)
+ (start (<a class=quiet href="#secondstosamples">seconds->samples</a> (car arg)))
+ (samps (<a class=quiet href="#secondstosamples">seconds->samples</a> 1.0))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 20 1 21 0)
:duration 1.0 :scaler .8))
- (index (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (* 100 3.0))))
- (do ((i start (+ 1 i)))
+ (index (<a class=quiet href="#hztoradians">hz->radians</a> (* 100 3.0))))
+ (do ((i start (+ i 1)))
((= i (+ start samps)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)
- (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> car1 (* index
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> ampf)
+ (<a class=quiet href="#oscil">oscil</a> car1 (* index
(<em class=red>ncos</em> mod1))))))))
(list
(list 0.0 1) (list 2.0 2)
@@ -3510,9 +3363,9 @@ As the modulating signal approaches a spike (as n increases), the bulk of the en
(list 8.0 16) (list 10.0 32)
(list 12.0 64) (list 14.0 128))))
</pre>
-</td><td>
-<img src="pix/ncosfm.png" alt="ncos as FM" onmouseout="UnTip()" onmouseover="Tip('The n=1 case is at the bottom, the n=128 case at the top.<br>I tried adding axes and labels to this graph, but they looked really dumb')" hspace=40>
-</td></tr></table>
+
+<img class="indented" src="pix/ncosfm.png" alt="ncos as FM">
+
<!--
ncosfm.png:
@@ -3532,55 +3385,34 @@ pulsefm.png:
(samps (seconds->samples 1.0))
(ampf (make-env '(0 0 1 1 20 1 21 0) :duration 1.0 :scaler .8))
(index (hz->radians (* 100 3.0))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(let ((amp (env ampf))
(fm (* index (pulse-train mod1))))
(outa i fm)
(outb i (* amp (oscil car1 fm)))))))
-(set! (selected-graph-color) (make-color 1 1 1))
-(set! (selected-data-color) (make-color 0 0 0))
+(set! *selected-graph-color* (make-color 1 1 1))
+(set! *selected-data-color* (make-color 0 0 0))
(set! (show-transform-peaks 0 0) #f)
cursor 10584
-(set! (axis-label-font) (axis-numbers-font))
+(set! *axis-label-font* *axis-numbers-font*)
(set! (x-axis-label 0 0 0) "pulse train modulating signal, FM index: 3.0")
(set! (x-axis-label 0 1 0) "modulated signal")
-->
-<img src="pix/pulsefm.png" alt="pulse-train as FM" align=right hspace=20 vspace=20 border=1 onmouseout="UnTip()" onmouseover="Tip('<pre>(with-sound (:channels 2)<br> (let* ((car1 (make-oscil 1000))<br> (mod1 (<em class=red>make-pulse-train</em> 100))<br> (samps (seconds->samples 1.0))<br> (ampf (make-env \'(0 0 1 1 20 1 21 0)<br> :duration 1.0 :scaler .8))<br> (index (hz->radians (* 100 3.0))))<br> (do ((i 0 (+ 1 i)))<br> ((= i samps))<br> (let ((amp (env ampf))<br> (fm (* index (<em class=red>pulse-train</em> mod1))))<br> (outa i fm)<br> (outb i (* amp (oscil car1 fm)))))))</pre>')">
-
<p>If you go all the way and use a pulse-train as the FM source, you get a
large component for the carrier, and all the others are very small.
-One very sketchy explanation is that since a pulse is close to zero most of the time,
-the modulation is also close to zero.
-I believe this is the basis of FM radio's
-noise reduction: we can filter out the high stuff which is weak anyway, and otherwise
-the spike has no effect on our carrier.
-Another handwaving approach is:
-let "n" be the number of components ncos creates, "B" the amplitude of the modulating signal,
-and "k" be the component number.
-Since each component produced by ncos has the same
-amplitude (B/n), if it is treated as an FM component its FM index is B/(k*n); B/n because
-that's the amplitude of each component, and 1/k since we have to cancel the factor of the
-modulating frequency in its index calculation.
-As more
-components are produced (as n increases),
-the higher ones only matter when all the Ji(B/(k * n))'s are not negligible (since
-it's a huge product of J's, <img src="pix/jprod.png" alt="product of Js" align=absmiddle> — see <a href="fm.html">fm.html</a>).
-B/(k * n) is heading for 0, so the product of J's is non-negligible
-only when all the J's are J0 except the solitary J1 that hits that component directly (i.e. the kth).
-J0(0) is 1, and J1(0) is 0, and the factor of n is scrunching all our components closer
-and closer to 0, so the carrier (all J0's) approaches 1, whereas the others (J0's except
-for J1(B/(n*k))) approach 0.
</p>
+<img class="indented" src="pix/pulsefm.png" alt="pulse-train as FM">
+
<!-- LATEX jprod.png \prod_{i=1}^{k}J_{k_{i}}(B_{i}) -->
<!-- j0j1.png:
(with-sound (:channels 2 :srate 10000)
(do ((x 0.0 (+ x .0001))
- (i 0 (+ 1 i)))
+ (i 0 (+ i 1)))
((= i 40000))
(outa i (bes-j0 x))
(outb i (bes-j1 x))))
@@ -3588,67 +3420,61 @@ for J1(B/(n*k))) approach 0.
(set! (x-axis-label 0 0) "J0 and J1")
(set! (x-axis-label 0 1) "")
-(set! (axis-label-font)"9x15")
+(set! *axis-label-font*"9x15")
-->
-<table border=0 hspace=20>
-<tr><td>
-<img src="pix/j0j1.png" alt="j0 and j1">
-</td><td colspan=2>
-<pre>
+<img class="indented" src="pix/j0j1.png" alt="j0 and j1">
+
+<pre class="indented">
(define (ncfm freq-we-want wc modfreq baseindex n)
;; get amplitude of "freq-we-want" given ncos as FM,
;; "wc" as carrier, "modfreq" as ncos freq,
- ;; "baseindex" as FM-index of 1st harmonic,
+ ;; "baseindex" as FM-index of first harmonic,
;; "n" as number of harmonics
- (let ((harms '())
- (amps '()))
- (do ((i 1 (+ 1 i)))
+ (let ((harms ())
+ (amps ()))
+ (do ((i 1 (+ i 1)))
((> i n))
(set! harms (cons (* i modfreq) harms))
(set! amps (cons (/ baseindex (* i n)) amps)))
(<a class=quiet href="sndscm.html#fmparallelcomponent">fm-parallel-component</a> freq-we-want wc
- (reverse harms) (reverse amps) '() '() #f)))
+ (reverse harms) (reverse amps) () () #f)))
</pre>
-</td></tr>
-<tr><td>
-<table border=1 cellpadding=4>
-<tr><td colspan=3 bgcolor="#f2f4ff"><center>4 components: (ncfm x 1000 100 3.0 4)</center></td></tr>
-<tr><td>x=1000</td><td> 0.81</td><td> 0.81 from J0(3/(4*k)) '(0 0 0 0)</td></tr>
-<tr><td>x=900</td><td>-0.44</td><td>-0.32 from J1(3/4)*J0s '(-1 0 0 0)</td></tr>
-<tr><td>x=800</td><td>-0.14</td><td>-0.16 from J1(3/8)*J0s '(0 -1 0 0)</td></tr>
-<tr><td>x=700</td><td>-0.06</td><td>-0.10 from J1(3/12)*J0s '(0 0 -1 0)</td></tr>
+<table class="method">
+<tr><td colspan=3 class="methodtitle">4 components: (ncfm x 1000 100 3.0 4)</td></tr>
+<tr><td class="br">x=1000</td><td class="br"> 0.81</td><td class="br"> 0.81 from J0(3/(4*k)) '(0 0 0 0)</td></tr>
+<tr><td class="br">x=900</td><td class="br">-0.44</td><td class="br">-0.32 from J1(3/4)*J0s '(-1 0 0 0)</td></tr>
+<tr><td class="br">x=800</td><td class="br">-0.14</td><td class="br">-0.16 from J1(3/8)*J0s '(0 -1 0 0)</td></tr>
+<tr><td class="br">x=700</td><td class="br">-0.06</td><td class="br">-0.10 from J1(3/12)*J0s '(0 0 -1 0)</td></tr>
</table>
-</td><td width=20></td><td>
+<pre>
+</pre>
-<table border=1 cellpadding=4>
-<tr><td colspan=3 bgcolor="#f2f4ff"><center>24 components: (ncfm x 1000 100 3.0 24)</center></td></tr>
-<tr><td>x=1000</td><td>0.99</td><td> 0.99 from J0(3/(24*k)) '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</td></tr>
-<tr><td>x=900</td><td>-0.06</td><td>-0.06 from J1(3/24)*J0s '(-1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</td></tr>
-<tr><td>x=800</td><td>-0.03</td><td>-0.03 from J1(3/48)*J0s '(0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</td></tr>
-<tr><td>x=700</td><td>-0.02</td><td>-0.02 from J1(3/96)*J0s '(0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</td></tr>
+<table class="method">
+<tr><td colspan=3 class="methodtitle">24 components: (ncfm x 1000 100 3.0 24)</td></tr>
+<tr><td class="br">x=1000</td><td class="br">0.99</td><td class="br"> 0.99 from J0(3/(24*k)) '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</td></tr>
+<tr><td class="br">x=900</td><td class="br">-0.06</td><td class="br">-0.06 from J1(3/24)*J0s '(-1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</td></tr>
+<tr><td class="br">x=800</td><td class="br">-0.03</td><td class="br">-0.03 from J1(3/48)*J0s '(0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</td></tr>
+<tr><td class="br">x=700</td><td class="br">-0.02</td><td class="br">-0.02 from J1(3/96)*J0s '(0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</td></tr>
</table>
-</td></tr></table>
-
-<table border=0 vspace=10>
-<tr><td>
<p>You can multiply the index by n to counteract the effect of the n modulators
(in the n=128 case mentioned above, the index becomes 384!).
I find it surprising how smooth the spectral evolution is in this context.
Here we sweep the index from 0 to 48 using n=16:
</p>
-</td><td>
-<table border=1><tr><td>
-<img src="pix/ncossweep.png">
+
+<table class="pb">
+<tr><td>
+<img src="pix/ncossweep.png" alt="ncos">
</td></tr>
-<tr><td bgcolor="#f2f3ff"><center>ncos (n=16) as FM, index from 0 to 48</center></td></tr>
+<tr><td class="center">ncos (n=16) as FM, index from 0 to 48</td></tr>
</table>
-</td></tr></table>
+
<!--
(with-sound (:statistics #t)
@@ -3659,7 +3485,7 @@ Here we sweep the index from 0 to 48 using n=16:
(ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur :scaler .8))
(index (hz->radians (* 100 16 3.0)))
(indf (make-env '(0 0 1 1) :scaler index :duration dur)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(outa i (* (env ampf)
(oscil car1 (* (env indf)
@@ -3679,44 +3505,47 @@ spike),
getting waveforms and results like these:
</p>
-
-<table border=0 hspace=20><tr><td>
+<table class="pb">
+<tr><td>
<img src="pix/nsinfm.png" alt="ncos case but random phases">
-</td>
-<td>
+</td></tr>
+<tr><td class="center">FM of sum of n sinusoids</td></tr>
+</table>
+
+
+<table class="pb">
+<tr><td>
<img src="pix/randomsins.png" alt="ncos case but random phases">
</td></tr>
-<tr><td><center><table border=0><tr><td bgcolor="#f2f3ff">FM of sum of n sinusoids</td></tr></table></center></td>
-<td><center><table border=0><tr><td bgcolor="#f2f3ff">sum of n sinusoids minimizing resemblance to pulse-train</td></tr></table></center></td>
-</tr></table>
+<tr><td class="center">sum of n sinusoids minimizing resemblance to pulse-train</td></tr>
+</table>
<!-- same setting as above
(defgenerator (ngencos
:make-wrapper (lambda (g)
- (let ((n (ngencos-n g))
- (frq (ngencos-frequency g))
- (phases (ngencos-phases g)))
- (set! (ngencos-arr g) (make-vector n))
- (do ((i 0 (+ 1 i)))
+ (let ((n (g 'n))
+ (frq (g 'frequency))
+ (phases (g 'phases)))
+ (set! (g 'arr) (make-vector n 0.0))
+ (do ((i 0 (+ i 1)))
((= i n))
- (if (vct? phases)
- (vector-set! (ngencos-arr g) i (make-oscil (* frq (+ 1 i)) (phases i)))
- (vector-set! (ngencos-arr g) i (make-oscil (* frq (+ 1 i)) (random (* 2 pi)))))))
+ (if (float-vector? phases)
+ (set! ((g 'arr) i) (make-oscil (* frq (+ i 1)) (phases i)))
+ (set! ((g 'arr) i) (make-oscil (* frq (+ i 1)) (random (* 2 pi)))))))
g))
- (frequency 0.0) (n 1 :type int) (phases #f :type vct) (arr #f :type clm-vector))
+ frequency (n 1) (phases #f) (arr #f) fm)
(define* (ngencos gen (fm 0.0)) ; polyoid now, I think
- (declare (gen ngencos) (fm float))
- (let* ((n (ngencos-n gen))
- (arr (ngencos-arr gen))
- (sum 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i n))
- (set! sum (+ sum (oscil (vector-ref arr i) (* (+ 1 i) fm)))))
- (/ sum n)))
+ (set! (gen 'fm) fm)
+ (with-let gen
+ (let ((sum 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (set! sum (+ sum (oscil (arr i) (* (+ i 1) fm)))))
+ (/ sum n))))
(with-sound (:channels 1 :clipped #f)
(for-each
@@ -3730,41 +3559,33 @@ getting waveforms and results like these:
:duration 1.0 :scaler .8))
(index (hz->radians (* 100 3.0)))
(mx 0.0))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i (+ start samps)))
(let ((md (ngencos mod1)))
(outa i (* (env ampf)
(oscil car1 (* index norm md))))
(set! mx (max mx (abs md)))
- ))))
+ ))
(snd-display ";~A ~A ~A" (cadr arg) (caddr arg) mx)))
-
(list
- (list 0.0 1 1.0 (vct 0))
- (list 2.0 2 0.881 (vct 0 0))
- (list 4.0 4 0.5184 (vct 1.295 0.248 0.304 2.785))
- (list 6.0 8 0.393 (vct 4.515 1.780 4.259 1.771 1.166 0.254 1.419 2.735))
- (list 8.0 16 0.302 (vct 0.432 2.086 2.763 2.344 2.811 3.409 1.836 6.173 3.770 2.339 6.158 1.530 6.132 3.006 4.967 0.859))
- (list 10.0 32 0.266 (vct 6.208 4.197 3.109 1.718 5.050 1.317 4.334 3.778 4.936 0.069 3.025 2.115 5.060 1.286 3.499 5.191 1.822 5.985 4.384 1.394 3.453 2.579 3.031 3.255 3.834 2.621 1.390 0.717 0.409 3.370 6.042 6.052))
- (list 12.0 64 0.2124 (vct 4.913 5.507 5.262 1.926 4.819 3.794 0.355 1.178 4.959 1.012 3.433 2.855 2.191 4.792 3.740 1.865 5.196 1.078 4.139 5.518 3.053 3.958 3.131 6.260 2.157 4.279 2.352 4.314 1.102 5.967 3.551 2.439 5.456 4.833 5.213 3.523 3.263 2.810 0.433 0.639 2.554 3.469 2.682 4.765 0.125 3.824 1.137 6.166 0.019 2.240 4.406 4.734 5.451 6.230 4.943 4.160 3.577 5.086 2.444 0.900 1.952 2.234 4.794 3.424))
- (list 14.0 128 0.16121 (vct 1.531 4.987 1.847 0.632 6.101 4.309 0.517 1.910 4.921 4.949 6.040 5.611 2.831 5.338 0.891 5.388 0.599 2.677 6.248 5.592 1.977 1.794 3.572 2.638 1.903 3.083 2.412 6.125 3.799 5.619 5.949 1.241 3.044 5.395 5.865 4.846 4.899 2.267 4.537 3.979 1.783 3.826 1.325 5.278 5.799 4.977 2.066 3.029 1.036 4.606 1.691 6.079 4.957 6.138 2.603 1.111 1.335 1.765 5.767 2.730 0.702 1.122 1.628 1.848 0.712 2.338 5.099 6.249 2.009 3.379 1.653 4.831 2.245 1.831 1.113 5.462 5.533 2.944 4.376 4.734 3.285 4.361 1.015 2.100 5.022 3.269 0.796 0.317 5.244 2.613 4.609 3.415 4.454 0.228 2.025 0.216 1.785 3.599 3.207 5.019 3.591 5.138 4.333 3.005 6.208 5.296 0.763 3.741 3.446 3.962 0.204 1.715 4.054 2.402 1.455 1.842 4.637 4.427 0.536 2.700 4.289 3.066 0.574 6.106 1.472 5.793 4.294 2.287))))
+ (list 0.0 1 1.0 (float-vector 0))
+ (list 2.0 2 0.881 (float-vector 0 0))
+ (list 4.0 4 0.5184 (float-vector 1.295 0.248 0.304 2.785))
+ (list 6.0 8 0.393 (float-vector 4.515 1.780 4.259 1.771 1.166 0.254 1.419 2.735))
+ (list 8.0 16 0.302 (float-vector 0.432 2.086 2.763 2.344 2.811 3.409 1.836 6.173 3.770 2.339 6.158 1.530 6.132 3.006 4.967 0.859))
+ (list 10.0 32 0.266 (float-vector 6.208 4.197 3.109 1.718 5.050 1.317 4.334 3.778 4.936 0.069 3.025 2.115 5.060 1.286 3.499 5.191 1.822 5.985 4.384 1.394 3.453 2.579 3.031 3.255 3.834 2.621 1.390 0.717 0.409 3.370 6.042 6.052))
+ (list 12.0 64 0.2124 (float-vector 4.913 5.507 5.262 1.926 4.819 3.794 0.355 1.178 4.959 1.012 3.433 2.855 2.191 4.792 3.740 1.865 5.196 1.078 4.139 5.518 3.053 3.958 3.131 6.260 2.157 4.279 2.352 4.314 1.102 5.967 3.551 2.439 5.456 4.833 5.213 3.523 3.263 2.810 0.433 0.639 2.554 3.469 2.682 4.765 0.125 3.824 1.137 6.166 0.019 2.240 4.406 4.734 5.451 6.230 4.943 4.160 3.577 5.086 2.444 0.900 1.952 2.234 4.794 3.424))
+ (list 14.0 128 0.16121 (float-vector 1.531 4.987 1.847 0.632 6.101 4.309 0.517 1.910 4.921 4.949 6.040 5.611 2.831 5.338 0.891 5.388 0.599 2.677 6.248 5.592 1.977 1.794 3.572 2.638 1.903 3.083 2.412 6.125 3.799 5.619 5.949 1.241 3.044 5.395 5.865 4.846 4.899 2.267 4.537 3.979 1.783 3.826 1.325 5.278 5.799 4.977 2.066 3.029 1.036 4.606 1.691 6.079 4.957 6.138 2.603 1.111 1.335 1.765 5.767 2.730 0.702 1.122 1.628 1.848 0.712 2.338 5.099 6.249 2.009 3.379 1.653 4.831 2.245 1.831 1.113 5.462 5.533 2.944 4.376 4.734 3.285 4.361 1.015 2.100 5.022 3.269 0.796 0.317 5.244 2.613 4.609 3.415 4.454 0.228 2.025 0.216 1.785 3.599 3.207 5.019 3.591 5.138 4.333 3.005 6.208 5.296 0.763 3.741 3.446 3.962 0.204 1.715 4.054 2.402 1.455 1.842 4.637 4.427 0.536 2.700 4.289 3.066 0.574 6.106 1.472 5.793 4.294 2.287)))))
-->
-<table border=1 hspace=100 vspace=20 cellpadding=6>
-<tr><td>
-<small>
-Compare the sound of the n=64 and n=128 cases using ncos and random phases: they sound very different
+<div class="inset">
+<p>Compare the sound of the n=64 and n=128 cases using ncos and random phases: they sound very different
despite having the same spectrum. We confront the burning question: given n equal amplitude
-harmonically related sinusoids, what is the minimum peak amplitude? sqrt(n) is too low. Here are (some of) the
-best minimum peaks I've found:
-<pre>
- 1 1.0, 2 1.76, 4 2.04, 8 2.79, 16 3.87, 32 5.53, 64 8.02, 128 11.71, 256 19.42, 512 31.39, 1024 49.87, 2048 77.35
-</pre>
-For the actual phases, see <a href="sndscm.html#peakphasesdoc">peak-phases</a>.scm.
-</small>
-</td></tr></table>
+harmonically related sinusoids, what is the minimum peak amplitude?
+For my current best results, see <a href="sndscm.html#peakphasesdoc">peak-phases</a>.
+</p>
+</div>
<p>
If you use ncos (or nsin) as both the carrier and modulator, you get a very similar effect. As n increases,
@@ -3774,25 +3595,23 @@ under <a href="#polywave">polywave</a>).
And (for some reason this makes me smile), polywave modulated by ncos behaves the same way:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((modulator (<em class=red>make-ncos</em> 100 :n 128))
(carrier (<em class=red>make-polywave</em> 1000 (list 1 .5 3 .25 6 .25))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 20000))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .5 (<em class=red>polywave</em> carrier
+ (<a class=quiet href="#outa">outa</a> i (* .5 (<em class=red>polywave</em> carrier
(* (<a class=quiet href="#hztoradians">hz->radians</a> (* 3 100))
(<em class=red>ncos</em> modulator 0.0))))))))
</pre>
-</td></tr></table>
<p>So, a pulse-train modulated by a pulse-train is a pulse-train.
Are there any other cases where gen(wc + gen(wm)) = gen(wc)? My first thought was rand, but that has a hidden
surprise: the modulation obscures the underlying square-wave!
</p>
-<img src="pix/randfm.png" alt="rand(rand) spectrum" hspace=40>
+<img class="indented" src="pix/randfm.png" alt="rand(rand) spectrum">
<!-- randfm.png:
@@ -3803,7 +3622,7 @@ surprise: the modulation obscures the underlying square-wave!
(samps (seconds->samples 1.0))
(ampf (make-env '(0 0 1 1 20 1 21 0) :duration 1.0 :scaler .8))
(index (hz->radians (* 100 3.0))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(let ((amp (env ampf))
(fm (* index (rand mod1))))
@@ -3811,8 +3630,8 @@ surprise: the modulation obscures the underlying square-wave!
(outb i (* amp (rand car2)))
(outc i (* amp (rand car1 fm)))))))
-(set! (selected-graph-color) (make-color 1 1 1))
-(set! (selected-data-color) (make-color 0 0 0))
+(set! *selected-graph-color* (make-color 1 1 1))
+(set! *selected-data-color* (make-color 0 0 0))
(set! (x-axis-label 0 0 1) "100Hz rand modulating signal spectrum")
(set! (x-axis-label 0 1 1) "1000Hz rand, no modulation")
(set! (x-axis-label 0 2 1) "1000Hz rand, 100Hz modulation (from chan 0), index: 3")
@@ -3836,17 +3655,17 @@ compare ncos as FM and direct sum of cos:
(index (hz->radians (* 100 3.0)))
(car2 (make-oscil 1000))
(mods (make-vector n)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i n))
- (set! (mods i) (make-oscil (* (+ 1 i) 100) (* 0.5 pi))))
- (do ((i start (+ 1 i)))
+ (set! (mods i) (make-oscil (* (+ i 1) 100) (* 0.5 pi))))
+ (do ((i start (+ i 1)))
((= i stop))
(let ((amp (env ampf)))
(outa i (* amp (oscil car1 (* index (sum-of-cosines mod1)))))
(let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k n))
- (set! sum (+ sum (oscil (vector-ref mods k)))))
+ (set! sum (+ sum (oscil (mods k)))))
(outb i (* amp (oscil car2 (* (/ index n) sum)))))))))
(list
(list 0.0 1)
@@ -3859,7 +3678,7 @@ compare ncos as FM and direct sum of cos:
(list 14.0 128))))
-->
-<br>
+
<p>What FM input (to oscil, for a given index) would give the most dispersed output? My first guess was square-wave, but looking at graphs,
I'd say rand gives it a good contest.
If you sweep ncos upwards in frequency, you'll eventually
@@ -3867,131 +3686,97 @@ get foldover; the generator produces its preset number of cosines no
matter what. It is possible to vary the spectrum smoothly:
</p>
-<table border=0 hspace=40><tr><td><pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((os (<em class=red>make-ncos</em> 100.0 4))
- (pow (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 1.0 1 30.0) :length 10000))) ; our "index" envelope in FM jargon
- (do ((i 0 (+ 1 i)))
+ (pow (<a class=quiet href="#make-env">make-env</a> '(0 1.0 1 30.0) :length 10000))) ; our "index" envelope in FM jargon
+ (do ((i 0 (+ i 1)))
((= i 10000))
(let ((val (<em class=red>ncos</em> os)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (signum val) ; signum is in dsp.scm
- (expt (abs val) (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> pow))))))))
-</pre></td></tr></table>
+ (<a class=quiet href="#outa">outa</a> i (* (signum val) ; signum is in dsp.scm
+ (expt (abs val) (<a class=quiet href="#env">env</a> pow))))))))
+</pre>
<p>This is not a very polite sound. The same trick works on all the <a href="#ncos2">pulse-train</a> functions in generators.scm (or an oscil for that matter!),
but perhaps a filter is a simpler approach. There are a lot more of these "kernels" in <a href="#othergenerators">generators.scm</a>.
</p>
-<table border=1 hspace=20 cellspacing=4>
+<table class="method">
<tr>
-<td bgcolor="#f2f4ff"><center>ncos2 (Fejer, n=10)</center></td>
-<td bgcolor="#f2f4ff"><center>npcos (Poussin, n=5)</center></td>
-<td bgcolor="#f2f4ff"><center>ncos4 (Jackson, n=10)</center></td>
+<td class="methodtitle">ncos2 (Fejer, n=10)</td>
+<td class="methodtitle">npcos (Poussin, n=5)</td>
+<td class="methodtitle">ncos4 (Jackson, n=10)</td>
</tr><tr>
-<td><img src="pix/fejer.png" alt="fejer sum"></td>
-<td><img src="pix/poussin.png" alt="poussin sum"></td>
-<td><img src="pix/jackson.png" alt="jackson sum"></td>
+<td class="br"><img src="pix/fejer.png" alt="fejer sum"></td>
+<td class="br"><img src="pix/poussin.png" alt="poussin sum"></td>
+<td class="br"><img src="pix/jackson.png" alt="jackson sum"></td>
</tr></table>
-<!--
-fejer: fejer.png (10)
-poussin (5)
-soc2 (5)
-fejer2 (10)
-
-;; this is in snd9.scm now -- new form is kosine
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let ((freq (hz->radians 100.0)))
- (do ((i 0 (+ 1 i))
- (angle 0.0 (+ angle freq)))
- ((= i 44100))
- (outa i (fejer-sum angle 10)))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
-(let ((gen (make-kosine-summation 100.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 44100))
- (outa i (kosine-summation gen 0.5 5.0)))))
-
-
-kosine95
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
-(let ((gen (make-kosine-summation 100.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 44100))
- (outa i (kosine-summation gen 0.95 1.0)))))
--->
-<br><br>
<p>nsin produces a sum of equal amplitude sines. It is very similar (good and bad) to <a href="#ncos">ncos</a>.
For n greater than 10 or so, its peak amplitude occurs at approximately 3pi/4n, and is about .7245*n (that is, 8n*(sin^2(3pi/8))/3pi).
The nsin generator scales its output to be between -1 and 1 for any n. We can use nxysin to try any initial-phase in a
sum of equal sinusoids. The peak amp in this case varys sinusoidally from a sum of sines n * 0.7245 to a sum of cosines n * 1.0;
-the peak amp is nsin-max(n) + abs(sin(initial-phase))*(1 - nsin-max(n)).
+the peak amp is nsin-max(n) + abs(sin(initial-phase))*(1 - nsin-max(n)). nsin is based on the conjugate Dirichlet kernel:
</p>
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>nsin methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>dependent on number of sines</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>n or sines arg used in make-<gen></td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-</table>
-
<!-- LATEX: \sum_{k=1}^{n}\sin kx = \frac{\sin\frac{n+1}{2}x \: \sin\frac{nx}{2}}{\sin\frac{x}{2}} -->
-<table border=0 cellspacing=20>
-<tr><td>
-<img src="pix/sceq1.png" alt="sum of sines" hspace=40>
+<img class="indented" src="pix/sceq1.png" alt="sum of sines">
<pre>
-the conjugate Dirichlet kernel
</pre>
-</td></tr>
-<tr><td>
-<img src="pix/sos.png" alt="sum of sines graphs">
-</td></tr></table>
+<img class="indented" src="pix/sos.png" alt="sum of sines graphs">
+<pre>
+</pre>
+
+<table class="method">
+<tr><td colspan=2 class="methodtitle">nsin methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">dependent on number of sines</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">n or sines arg used in make-<gen></td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">frequency in radians per sample</td></tr>
+</table>
<p>
As with all the paired cos/sin generators (waveshaping, generators.scm, etc), we can vary
the initial phase by taking advantage of the trig identity:
</p>
-<img src="pix/fmeq18.png" alt="sin split" hspace=20><br>
+
+<img class="indented" src="pix/fmeq18.png" alt="sin split">
<p>that is,
</p>
-<pre>
- (+ (* (ncos nc) (sin initial-phase))
- (* (nsin ns) (cos initial-phase)))
+<pre class="indented">
+ (+ (* (ncos nc) (sin initial-phase))
+ (* (nsin ns) (cos initial-phase)))
</pre>
<p>Or vary it via an envelope at run-time:
</p>
-<table border=0 hspace=40>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let* ((nc (<em class=red>make-ncos</em> 500.0 6))
- (ns (<em class=red>make-nsin</em> 500.0 6))
- (phase (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1)
- :length 1000 :scaler (/ pi 2))))
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (let ((nc (<em class=red>make-ncos</em> 500.0 6))
+ (ns (<em class=red>make-nsin</em> 500.0 6))
+ (phase (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1)
+ :length 1000 :scaler (/ pi 2))))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (let ((angle (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> phase)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (+ (* (<em class=red>ncos</em> nc) (sin angle))
+ (let ((angle (<a class=quiet href="#env">env</a> phase)))
+ (<a class=quiet href="#outa">outa</a> i (+ (* (<em class=red>ncos</em> nc) (sin angle))
(* (<em class=red>nsin</em> ns) (cos angle))))))))
</pre>
-</td><td>
-<img src="pix/varyphase.png" alt="ncos+nsin example" hspace=20>
-</td></tr></table>
+
+<img class="indented" src="pix/varyphase.png" alt="ncos+nsin example">
+
<p>Compared to ncos or nsin, polywave is probably always faster and more accurate, but less convenient to set up.
Both ncos and nsin could be implemented as polynomials in cos x, just as in polyshape; in fact, ncos is
-almost the same as the Chebyshev polynomial of the 4th kind.
+almost the same as the Chebyshev polynomial of the fourth kind.
See also the <a href="#nrxydoc">nrxycos</a> generator,
and <a href="#othergenerators">generators.scm</a>.
</p>
@@ -4029,13 +3814,12 @@ sceq15:
\end{align*}
-
-old in 2nd col (replaced by JO cases):
+old in second col (replaced by JO cases):
&\sum_{k=1}^{\infty}\frac{p^{k}\sin kx}{k!} = e^{p\cos x}\sin(p\sin x) \\
&\sum_{k=0}^{\infty}\frac{p^{k}\cos kx}{k!} = e^{p\cos x}\cos(p\sin x) \\
rk!sin and cos
-original last of 1st col:
+original last of first col:
&\sum_{k=1}^{\infty} \frac{\sin^{2k} x}{k} = -2 \ln \cos x & (x^{2} < \frac{pi^{2}}{4}) \\
@@ -4135,18 +3919,16 @@ Montgomery and Vorhauer:
from Klapper, Selected Papers on Frequency Modulation, p 156
&\sum_{n=-\infty}^{\infty} (-1)^{n} J_{2n}(x) J_{2n}(y(\omega + B \cos z)) = J_{0}( \sqrt{x^{2} + y^{2} (\omega + B\cos z)^{2}})
-another kernel set: binomial coeffs G&R 1.320 etc -- not different enough
+another kernel set: binomial coeffs G&R 1.320 etc, not different enough
-->
-<table border=1 hspace=20 vspace=10><tr><td>
-<table border=0 hspace=40 vspace=10>
-<tr><td colspan=3 bgcolor="#f2f4ff"><center><h4>various sums</h4></center></td></tr>
-
+<table class="grayborder">
+<tr><td colspan=2 class="methodtitle">various sums</td></tr>
<tr>
<td>
-<img src="pix/sceq14.png" alt="many sums" usemap="#GR1" border=0>
+<img class="noborder" src="pix/sceq14.png" alt="many sums" usemap="#GR1">
<map name="GR1">
<area shape=rect coords="0,0,300,60" href="#nxysin" alt="nxysin">
<area shape=rect coords="0,61,300,100" href="#nxycos" alt="nxycos">
@@ -4154,16 +3936,13 @@ another kernel set: binomial coeffs G&R 1.320 etc -- not different enough
<area shape=rect coords="0,151,300,200" href="#nxy1sin" alt="nxy1sin">
<area shape=rect coords="0,201,300,240" href="#noddsin" alt="noddsin">
<area shape=rect coords="0,241,300,280" href="#noddcos" alt="noddcos">
- <area shape=rect coords="0,281,300,320">
- <area shape=rect coords="0,321,300,360">
<area shape=rect coords="0,361,300,410" href="#nkssb" alt="nkssb">
<area shape=rect coords="0,411,300,450" href="#nkssb" alt="nkssb">
<area shape=rect coords="0,450,300,485" href="#nchoosekcos" alt="nchoosekcos">
</map>
</td>
-<td width=40></td>
<td>
-<img src="pix/sceq15.png" alt="many more sums" usemap="#GR2" border=0>
+<img class="noborder" src="pix/sceq15.png" alt="many more sums" usemap="#GR2">
<map name="GR2">
<area shape=rect coords="0,0,300,40" href="#nrsin" alt="nrsin">
<area shape=rect coords="0,41,300,90" href="#nrcos" alt="nrcos">
@@ -4180,95 +3959,80 @@ another kernel set: binomial coeffs G&R 1.320 etc -- not different enough
</td>
</tr>
-<!-- <area shape=rect coords="0,421,300,500" href="#sin2n" alt="sin2n"> -->
-
+<tr><td colspan=2 class="sumtitle">Gradshteyn and Ryzhik, "Table of Integrals, Series, and Products", 1.341.., 1.352.., 1.447.., 1.461, 1.518, 8.516, 8.531</td></tr>
-<tr><td colspan=3 bgcolor="#eefdee"><center>Gradshteyn and Ryzhik, "Table of Integrals, Series, and Products", 1.341.., 1.352.., 1.447.., 1.461, 1.518, 8.516, 8.531</center></td></tr>
-<tr><td colspan=3 height=25></td></tr>
-
-
-<tr><td><img src="pix/sceq20.png" alt="more sums" usemap="#J1" border=0>
+<tr><td class="hightop">
+<img class="noborder" src="pix/sceq20.png" alt="more sums" usemap="#J1">
<map name="J1">
<area shape=rect coords="0,0,300,30" href="#rxycos" alt="rxycos">
<area shape=rect coords="0,31,300,60" href="#rxysin" alt="rxysin">
<area shape=rect coords="0,61,300,100" href="#k2sin" alt="k2sin">
<area shape=rect coords="0,101,300,140" href="#eoddcos" alt="eoddcos">
- <area shape=rect coords="0,141,300,180" href="#k32sin" alt="k32sin">
</map>
-</td><td></td>
-<td><img src="pix/sceq21.png" alt="more sums" usemap="#J2" border=0>
+</td>
+<td class="hightop"><img class="noborder" src="pix/sceq21.png" alt="more sums" usemap="#J2">
<map name="J2">
<area shape=rect coords="0,0,300,30" href="#rxyk!cos" alt="rxyk!cos">
<area shape=rect coords="0,31,300,60" href="#rxyk!cos" alt="rxyk!sin">
- <area shape=rect coords="0,61,300,100" alt="r2cos">
- <area shape=rect coords="0,101,300,140" alt="r2sin">
- <area shape=rect coords="0,141,300,180">
</map>
</td></tr>
-<tr><td colspan=3 bgcolor="#eefdee"><center>Jolley, "Summation of Series", 521 587 623 635 638 685 686 691 692 728</center></td></tr>
-<tr><td colspan=3 height=25></td></tr>
+<tr><td colspan=2 class="sumtitle">Jolley, "Summation of Series", 521 587 623 635 638 685 686 691 692 728</td></tr>
+
+<tr><td class="hightop"><a class=invisible href="#izcos"><img src="pix/sceq39.png" alt="I(k) sum"></a></td>
+<td class="hightop"><a class=invisible href="#k3sin"><img src="pix/sceq40.png" alt="n3 case"></a></td></tr>
+<tr><td colspan=2 class="sumtitle">Abramowitz and Stegun, "Handbook of Mathematical Functions", 9.6.34, 27.8.6</td></tr>
-<tr><td><a class=invisible href="#izcos"><img src="pix/sceq39.png" alt="I(k) sum"></a></td><td></td>
-<td><a class=invisible href="#k3sin"><img src="pix/sceq40.png" alt="n3 case"></a></td></tr>
-<tr><td colspan=3 bgcolor="#eefdee"><center>Abramowitz and Stegun, "Handbook of Mathematical Functions", 9.6.34, 27.8.6</center></td></tr>
-<tr><td colspan=3 height=25></td></tr>
+<tr><td class="hightop"><a class=invisible href="#krksin"><img src="pix/sceq25.png" alt="more sums"></a></td>
+<td class="hightop"><img src="pix/sceq26.png" alt="more sums"></td></tr>
-<tr><td><a class=invisible href="#krksin"><img src="pix/sceq25.png" alt="more sums"></a></td><td></td>
-<td><a class=invisible href="#abssin"><img src="pix/sceq26.png" alt="more sums"></a></td></tr>
-<tr><td colspan=3 bgcolor="#eefdee"><center>Zygmund, "Trigonometric Series" p34, 352</center></td></tr>
-<tr><td colspan=3 height=25></td></tr>
+<tr><td colspan=2 class="sumtitle">Zygmund, "Trigonometric Series" p34, 352</td></tr>
+<tr><td class="hightop"><img src="pix/sceq7.png" alt="more sums"></td>
+<td class="hightop"><a class=invisible href="#abcos"><img src="pix/sceq27.png" alt="more sums"></a></td></tr>
-<tr><td><img src="pix/sceq7.png" alt="more sums"></td><td></td>
-<td><a class=invisible href="#abcos"><img src="pix/sceq27.png" alt="more sums"></a></td></tr>
-<tr><td colspan=3 bgcolor="#eefdee"><center>Sansone, "Orthogonal Functions"</center></td></tr>
-<tr><td colspan=3 height=25></td></tr>
+<tr><td colspan=2 class="sumtitle">Sansone, "Orthogonal Functions"</td></tr>
-<tr><td><img src="pix/sceq36.png" alt="more sums" usemap="#GM1" border=0>
+<tr><td class="hightop"><img class="noborder" src="pix/sceq36.png" alt="more sums" usemap="#GM1">
<map name="GM1">
<area shape=rect coords="0,0,300,50" href="#j0j1cos" alt="j0j1cos">
<area shape=rect coords="0,51,300,80" href="#j0j1cos" alt="j0j1cos">
</map>
-</td><td></td>
-<td><img src="pix/sceq37.png" alt="more sums" usemap="#GM2" border=0>
+</td>
+<td class="hightop"><img class="noborder" src="pix/sceq37.png" alt="more sums" usemap="#GM2">
<map name="GM2">
<area shape=rect coords="0,0,300,50" href="#jycos" alt="jycos">
- <area shape=rect coords="0,51,300,100" alt="jjesin">
</map>
</td></tr>
-<tr><td colspan=3 bgcolor="#eefdee"><center>Gray and Mathews, "A Treatise on Bessel Functions and Their Applications to Physics" p 28, 29, 92, 240</center></td></tr>
-<tr><td colspan=3 height=25></td></tr>
+<tr><td colspan=2 class="sumtitle">Gray and Mathews, "A Treatise on Bessel Functions and Their Applications to Physics" p 28, 29, 92, 240</td></tr>
<tr>
-<td><a class=invisible href="#jncos"><img src="pix/sceq32.png" alt="more sums"></a></td><td></td>
-<td><a class=invisible href="#jjcos"><img src="pix/sceq31.png" alt="more sums"></a></td>
+<td class="hightop"><a class=invisible href="#jncos"><img src="pix/sceq32.png" alt="more sums"></a></td>
+<td class="hightop"><a class=invisible href="#jjcos"><img src="pix/sceq31.png" alt="more sums"></a></td>
</tr><tr>
-<td><a class=invisible href="#j2cos"><img src="pix/sceq34.png" alt="more sums"></a></td><td></td>
+<td><a class=invisible href="#j2cos"><img src="pix/sceq34.png" alt="more sums"></a></td>
<td><a class=invisible href="#jpcos"><img src="pix/sceq33.png" alt="more sums"></a></td>
</tr><tr>
-<td colspan=3 bgcolor="#eefdee"><center>Watson, "A Treatise on the Theory of Bessel Functions": 4.82, 11.41, 17.31</center></td></tr>
-<tr><td colspan=3 height=25></td></tr>
+<td colspan=2 class="sumtitle">Watson, "A Treatise on the Theory of Bessel Functions": 4.82, 11.41, 17.31</td></tr>
-<tr><td colspan><a class=invisible href="#r2k!cos"><img src="pix/sceq30.png" alt="kosines" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/r2kfactcos.png\' width=\'400\' height=\'177\'>')"></a></td>
-<td></td>
-<td>
+<tr><td class="hightop"><a class=invisible href="#r2k!cos"><img src="pix/sceq30.png" alt="kosines"></a></td>
+<td class="hightop">
<a class=invisible href="#n1cos"><img src="pix/sceq45.png" alt="linear cosines"></a>
</td>
</tr>
-<tr><td bgcolor="#eefdee"><center>Askey, "Ramanujan and Hypergeometric Series"</center></td>
-<td bgcolor="#eefdee"></td>
-<td bgcolor="#eefdee"><center>Ramanujan, "On certain Arithmetical Functions"</center></td>
-</tr>
+<tr><td class="sumtitle">Askey, "Ramanujan and Hypergeometric Series"</td>
+<td class="sumtitle">Ramanujan, "On certain Arithmetical Functions"</td>
+</tr>
</table>
-</td></tr></table>
+
+
<!-- LATEX
sceq38:
@@ -4284,9 +4048,11 @@ sceq45.png
There are many formulas that produce exponentially decaying or bell-curve shaped spectra;
I think these all sound about the same, so I have included only a representative sample of them.
A couple of the formulas are special cases of the "Bessel function summation theorem", G&R 8.530:
-<img src="pix/sceq38.png" alt="summation formula" align=absmiddle>,
+<img src="pix/sceq38.png" alt="summation formula">,
where Z stands for any of the various Bessel functions (J, Y, etc),
and R stands for the Poisson-like business (or is it Legendre?) in the square root.
+Most of the formulas above are implemented as generators in <a href="#othergenerators">generators.scm</a>,
+along with the single side-band cases, where possible.
Don't shy away from the sums to infinity just because you've heard shouting about "band-limited waveforms" — FM is an infinite sum:
</p>
@@ -4302,75 +4068,108 @@ Don't shy away from the sums to infinity just because you've heard shouting abou
-->
-
-<table border=1 hspace=40 vspace=20><tr><td>
-<table border=0 hspace=20>
-<tr><td>
<img src="pix/fmeq49.png" alt="cos cos cases">
-</td><td width=20></td>
-<td>
+
<img src="pix/fmeq50.png" alt="cos cos cases">
-</td>
-</tr>
-<tr><td></td><td></td><td></td></tr>
-<tr><td colspan=3><center>
-<small>(Is cos(sin(x)) is always greater than sin(cos(x))?)</small>
-</center>
-</td>
-</tr></table>
-</td></tr></table>
-<p>
-Most of the formulas are implemented as generators in <a href="#othergenerators">generators.scm</a>,
-along with the single side-band cases, where possible.
-As J. A. Moorer and Marc Le Brun pointed out
-long ago, there are many more such formulas "buried in reference works". Well, they've
-done nobody any good being buried for a generation, so I say: dig them up! If
-you know of any curious formula, anything that might trigger an interesting train of
-reflection, please send it to me, and I'll add it to this collection.
-</p>
+<br>
+<div class="inset_inline">(Is cos(sin(x)) always greater than sin(cos(x))?)</div>
-<br><br>
-<A NAME="nrxydoc"></A>
-<!-- ---------------------------------------- NRXYSIN and NRXYCOS ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>nrxysin and nrxycos</h3></center></td></tr></table>
-<br>
-<pre>
- <a class=def name="make-nrxysin">make-nrxysin</a>
+
+
+<!-- NRXYSIN and NRXYCOS -->
+
+<div class="innerheader" id="nrxydoc">nrxysin and nrxycos</div>
+
+<pre class="indented">
+<em class=def id="make-nrxysin">make-nrxysin</em>
(frequency *clm-default-frequency*)
(ratio 1.0) ; ratio between frequency and the spacing between successive sidebands
(n 1) ; number of sidebands
(r .5) ; amplitude ratio between successive sidebands (-1.0 < r < 1.0)
- <a class=def name="nrxysin">nrxysin</a> s (fm 0.0)
- <a class=def name="nrxysin?">nrxysin?</a> s
+<em class=def id="nrxysin">nrxysin</em> s (fm 0.0)
+<em class=def id="nrxysin?">nrxysin?</em> s
- <a class=def name="make-nrxycos">make-nrxycos</a> (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r .5)
- <a class=def name="nrxycos">nrxycos</a> s (fm 0.0)
- <a class=def name="nrxycos?">nrxycos?</a> s
+<em class=def id="make-nrxycos">make-nrxycos</em> (frequency *clm-default-frequency*) (ratio 1.0) (n 1) (r .5)
+<em class=def id="nrxycos">nrxycos</em> s (fm 0.0)
+<em class=def id="nrxycos?">nrxycos?</em> s
</pre>
<br>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">nrxysin methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">"r" parameter; sideband scaler</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">"n" parameter</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">frequency in radians per sample</td></tr>
+<tr><td class="inner"><em class=gen>mus-offset</em></td><td class="inner">"ratio" parameter</td></tr>
+</table>
+
+<p>These three generators
+produce a kind of additive synthesis.
+"n" is the number of sidebands (0 gives a sine wave), "r" is the amplitude
+ratio between successive sidebands (don't set it to 1.0), and "ratio" is the ratio between the
+carrier frequency and the spacing between successive sidebands.
+A "ratio" of 2 gives odd-numbered harmonics for a (vaguely) clarinet-like sound.
+A negative ratio puts the side-bands below the carrier.
+A negative r is the same as shifting the initial phase by pi (instead of lining up
+for the spike at multiples of 2*pi, the (-1)^n causes them to line up at (2k-1)*pi,
+but the waveform is the same otherwise).
+The basic idea is very similar to that used in the
+<a href="#ncos">ncos</a> generator, but you have control of the
+fall-off of the spectrum and the spacing of the partials.
+Here are the underlying formulas:
+</p>
+
+<!-- sinesummation.png:
+(with-sound (:clipped #f)
+ (let ((gen (make-sine-summation 400.0 0.0 5 0.5)))
+ (do ((i 0 (+ i 1)))
+ ((= i 30000))
+ (outa i (sine-summation gen 0.0)))))
+-->
+
+<!-- Jolley 475 is different [it runs 0 .. n-1 in our terminology, whereas Moorer's runs 0 .. n] -->
+
+<!-- LATEX:
+& \sum_{k=0}^{n} r^{k}\sin(x+ky) = \frac{\sin(x) - r\sin(x-y) - r^{n+1}\Big(\sin(x+(n+1)y) - r\sin(x+ny)\Big)}{1+r^{2}-2r\cos(y)} \\
+& \sum_{k=0}^{n} r^{k}\cos(x+ky) = \frac{\cos(x) - r\cos(x-y) - r^{n+1}\Big(\cos(x+(n+1)y) - r\cos(x+ny)\Big)}{1+r^{2}-2r\cos(y)} \\
+-->
+
+<img src="pix/sceq8.png" alt="nxry formulas">
+
+<table class="method">
+<tr><td>
+<img src="pix/sinesummation.png" alt="nxry formula">
+</td></tr>
+<tr><td class="center">nrxysin, n=5, r=0.5
+</td></tr>
+</table>
+
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((gen (make-nrxycos 440.0 :n 10)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (nrxycos gen))))))
</pre>
-</td>
-
-<td width=4></td>
+</div>
+</td></tr>
+<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
gen = make_nrxycos(440.0, 1.0, 10, 0.5);
44100.times do |i|
@@ -4378,12 +4177,13 @@ with_sound(:play, true) do
end
end.output
</pre>
-</td>
-
-<td width=4></td>
+</div>
+</td></tr>
-<td bgcolor="#effdef">
-<pre>
+<tr>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 :n 10 make-nrxycos { gen }
44100 0 ?do
@@ -4391,124 +4191,56 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<table border=0 hspace=20>
-
-<tr><td>
-<table align=left border=1 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>nrxysin methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>"r" parameter; sideband scaler</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>"n" parameter</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-<tr><td><em class=gen>mus-offset</em></td><td>"ratio" parameter</td></tr>
-</table>
-
-</td>
-<td>
-
-<table border=0 cellspacing=20>
-<tr><td>
-<!-- sinesummation.png:
-(with-sound (:clipped #f)
- (let ((gen (make-sine-summation 400.0 0.0 5 0.5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 30000))
- (outa i (sine-summation gen 0.0))))))
--->
-
-<!-- Jolley 475 is different [it runs 0 .. n-1 in our terminology, whereas Moorer's runs 0 .. n] -->
-
-<!-- LATEX:
-& \sum_{k=0}^{n} r^{k}\sin(x+ky) = \frac{\sin(x) - r\sin(x-y) - r^{n+1}\Big(\sin(x+(n+1)y) - r\sin(x+ny)\Big)}{1+r^{2}-2r\cos(y)} \\
-& \sum_{k=0}^{n} r^{k}\cos(x+ky) = \frac{\cos(x) - r\cos(x-y) - r^{n+1}\Big(\cos(x+(n+1)y) - r\cos(x+ny)\Big)}{1+r^{2}-2r\cos(y)} \\
--->
-
-<img src="pix/sceq8.png" alt="nxry formulas">
-</td></tr>
-<tr><td>
-
-<table border=1 hspace=40><tr><td>
-<img src="pix/sinesummation.png" alt="nxry formula">
-</td></tr>
-<tr><td bgcolor="#f2f4ff"><center>nrxysin, n=5, r=0.5</center></td></tr>
-</table></td></tr>
-</table>
-
-</td></tr></table>
-
-<p>These three generators
-produce a kind of additive synthesis.
-"n" is the number of sidebands (0 gives a sine wave), "r" is the amplitude
-ratio between successive sidebands (don't set it to 1.0), and "ratio" is the ratio between the
-carrier frequency and the spacing between successive sidebands.
-A "ratio" of 2 gives odd-numbered harmonics for a (vaguely) clarinet-like sound.
-A negative ratio puts the side-bands below the carrier.
-A negative r is the same as shifting the initial phase by pi (instead of lining up
-for the spike at multiples of 2*pi, the (-1)^n causes them to line up at (2k-1)*pi,
-but the waveform is the same otherwise).
-The basic idea is very similar to that used in the
-<a href="#ncos">ncos</a> generator, but you have control of the
-fall-off of the spectrum and the spacing of the partials.
-</p>
<p>The peak amplitude of nrxysin is hard to predict.
I think nrxysin is close to the -1.0..1.0 ideal, and won't go over 1.0.
<a href="#nrxycos">nrxycos</a> is normalized correctly.
-</p>
-
-<p>
Besides the usual FM input, you can also vary the "r" parameter (via mus-scaler) to get changing spectra. In the
next example, we add a glissando envelope, and use the same envelope to vary "r" so that as the frequency
goes up, "r" goes down (to avoid foldover, or whatever).
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (ss beg dur freq amp (n 1) (r .5) (ratio 1.0) (frqf #f))
- (let* ((st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (nd (+ st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (ss beg dur freq amp (n 1) (r .5) (ratio 1.0) frqf)
+ (let* ((st (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (nd (+ st (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(sgen (<em class=red>make-nrxysin</em> freq ratio n r))
- (frq-env (if frqf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> frqf :scaler (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> freq) :duration dur) #f))
- (spectr-env (if frqf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> frqf :duration dur) #f))
- (amp-env (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 1 3 0) :scaler amp :duration dur)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i st (+ 1 i)))
- ((= i nd))
- (if spectr-env
- (set! (<em class=red>mus-scaler</em> sgen) (* r (exp (- (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> spectr-env))))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> amp-env)
- (<em class=red>nrxysin</em> sgen (if frq-env (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frq-env) 0.0))))))))
+ (frq-env (and frqf (<a class=quiet href="#make-env">make-env</a> frqf :scaler (<a class=quiet href="#hztoradians">hz->radians</a> freq) :duration dur)))
+ (spectr-env (and frqf (<a class=quiet href="#make-env">make-env</a> frqf :duration dur)))
+ (amp-env (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 2 1 3 0) :scaler amp :duration dur)))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (if spectr-env
+ (set! (<em class=red>mus-scaler</em> sgen) (* r (exp (- (<a class=quiet href="#env">env</a> spectr-env))))))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> amp-env)
+ (<em class=red>nrxysin</em> sgen (if frq-env (<a class=quiet href="#env">env</a> frq-env) 0.0)))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (ss 0 1 400.0 1.0 5 0.5 1.0 '(0 0 1 2)))
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (ss 0 1 400.0 1.0 5 0.5 1.0 '(0 0 1 2)))
</pre>
-</td></tr></table>
<p>"r" can also be used in the same way as an FM index, but with much simpler spectral evolution (x^n, x between -1.0 and 1.0, rather than Jn(x)).
In the graph, r is 0 at the midpoint, r goes from -1.0 to 1.0 along the horizontal axis — I forgot to label the axes.
</p>
-<table border=0 hspace=30 cellpadding=10>
-<tr><td>
-<img src="pix/nrxy-r.png" alt="nrxycos changing r">
-</td><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<img class="indented" src="pix/nrxy-r.png" alt="nrxycos changing r">
+
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((gen1 (<em class=red>make-nrxycos</em> 400 1 15 0.95))
- (indr (<a class=quiet href="#make-env" onmouseout="UnTip()" omnouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 -1 1 1)
+ (indr (<a class=quiet href="#make-env">make-env</a> '(0 -1 1 1)
:length 80000 :scaler 0.9999)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 80000))
- (set! (<em class=red>mus-scaler</em> gen1) (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indr)) ; this sets r
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .5 (<em class=red>nrxycos</em> gen1 0.0))))))
+ (set! (<em class=red>mus-scaler</em> gen1) (env indr)) ; this sets r
+ (<a class=quiet href="#outa">outa</a> i (* .5 (<em class=red>nrxycos</em> gen1 0.0))))))
</pre>
-</td></tr></table>
+
<!-- MLB's index idea is not so great:
@@ -4519,7 +4251,7 @@ In the graph, r is 0 at the midpoint, r goes from -1.0 to 1.0 along the horizont
(samps (seconds->samples dur))
(N 60))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(th 0.0 (+ th (hz->radians 1000.0))))
((= i samps))
@@ -4540,57 +4272,75 @@ In the graph, r is 0 at the midpoint, r goes from -1.0 to 1.0 along the horizont
(outa i (* (env ampf) val))))))
-->
-<br><br>
-<A NAME="ssb-amdoc"></A>
-<!-- ---------------------------------------- SSB-AM ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>ssb-am</h3></center></td></tr></table>
-<br>
-<pre>
- <a class=def name="make-ssb-am">make-ssb-am</a> (frequency *clm-default-frequency*) (order 40)
- <a class=def name="ssb-am">ssb-am</a> gen (insig 0.0) (fm 0.0)
- <a class=def name="ssb-am?">ssb-am?</a> gen
+<!-- SSB-AM -->
+
+<div class="innerheader" id="ssb-amdoc">ssb-am</div>
+
+<pre class="indented">
+<em class=def id="make-ssb-am">make-ssb-am</em> (frequency *clm-default-frequency*) (order 40)
+<em class=def id="ssb-am">ssb-am</em> gen (insig 0.0) (fm 0.0)
+<em class=def id="ssb-am?">ssb-am?</em> gen
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">ssb-am methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase (of embedded sin osc) in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-order</em></td><td class="inner">embedded delay line size</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">same as mus-order</td></tr>
+<tr><td class="inner"><em class=gen>mus-interp-type</em></td><td class="inner"><code>mus-interp-none</code></td></tr>
+<tr><td class="inner"><em class=gen>mus-xcoeff</em></td><td class="inner">FIR filter coeff</td></tr>
+<tr><td class="inner"><em class=gen>mus-xcoeffs</em></td><td class="inner">embedded Hilbert transform FIR filter coeffs</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">embedded filter state</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">frequency in radians per sample</td></tr>
+</table>
+
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<p>ssb-am provides single sideband suppressed carrier amplitude modulation, normally used for frequency shifting.
+The basic notion is to shift a spectrum up or down while cancelling either the upper or lower half of the spectrum.
+See <a href="sndscm.html#ssbbank">dsp.scm</a> for a number of curious possibilities (time stretch without pitch shift for example).
+When this works, which it does more often than I expected, it is much better than the equivalent
+phase-vocoder or granular synthesis kludges.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t :srate 44100)
(let ((shifter (make-ssb-am 440.0 20))
(osc (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (* 0.5 (ssb-am shifter
- (oscil osc)))))))
+ (outa i (* 0.5 (ssb-am shifter (oscil osc)))))))
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true, :srate, 44100) do
shifter = make_ssb_am(440.0, 20);
osc = make_oscil(440.0);
44100.times do |i|
- outa(i,
- 0.5 * ssb_am(shifter, oscil(osc)),
- $output);
+ outa(i, 0.5 * ssb_am(shifter, oscil(osc)), $output);
end
end.output
</pre>
-</td>
-
-<td width=4></td>
+</div>
+</td></tr>
+<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 20 make-ssb-am { shifter }
440.0 make-oscil { osc }
@@ -4599,71 +4349,43 @@ lambda: ( -- )
loop
; :play #t :srate 44100 with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<p>ssb-am provides single sideband suppressed carrier amplitude modulation, normally used for frequency shifting.
-The basic notion is to shift a spectrum up or down while cancelling either the upper or lower half of the spectrum.
-See <a href="sndscm.html#ssbbank">dsp.scm</a> for a number of curious possibilities (time stretch without pitch shift for example).
-When this works, which it does more often than I expected, it is much better than the equivalent
-phase-vocoder or granular synthesis kludges.
-</p>
-
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>ssb-am methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase (of embedded sin osc) in radians</td></tr>
-<tr><td><em class=gen>mus-order</em></td><td>embedded delay line size</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>same as mus-order</td></tr>
-<tr><td><em class=gen>mus-interp-type</em></td><td><code>mus-interp-none</code></td></tr>
-<tr><td><em class=gen>mus-xcoeff</em></td><td>FIR filter coeff</td></tr>
-<tr><td><em class=gen>mus-xcoeffs</em></td><td>embedded Hilbert transform FIR filter coeffs</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>embedded filter state</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-</table>
-
-<br>
-
-<pre>
+<pre class="indented">
(define* (ssb-am freq (order 40))
;; higher order = better cancellation
(let* ((car-freq (abs freq))
- (cos-car (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> car-freq (* .5 pi)))
- (sin-car (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> car-freq))
- (dly (<a class=quiet href="#make-delay" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_delay_tip)">make-delay</a> order))
- (hlb (<a class=quiet href="sndscm.html#makehilberttransform" onmouseout="UnTip()" onmouseover="Tip(sndscm_makehilberttransform_tip)">make-hilbert-transform</a> order)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
+ (cos-car (<a class=quiet href="#make-oscil">make-oscil</a> car-freq (* .5 pi)))
+ (sin-car (<a class=quiet href="#make-oscil">make-oscil</a> car-freq))
+ (dly (<a class=quiet href="#make-delay">make-delay</a> order))
+ (hlb (<a class=quiet href="sndscm.html#makehilberttransform">make-hilbert-transform</a> order)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a>
(lambda (y)
- (let ((ccos (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> cos-car))
- (csin (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> sin-car))
- (yh (<a class=quiet href="sndscm.html#hilberttransform" onmouseout="UnTip()" onmouseover="Tip(sndscm_hilberttransform_tip)">hilbert-transform</a> hlb y))
- (yd (<a class=quiet href="#delay" onmouseout="UnTip()" onmouseover="Tip(sndclm_delay_tip)">delay</a> dly y)))
+ (let ((ccos (<a class=quiet href="#oscil">oscil</a> cos-car))
+ (csin (<a class=quiet href="#oscil">oscil</a> sin-car))
+ (yh (<a class=quiet href="sndscm.html#hilberttransform">hilbert-transform</a> hlb y))
+ (yd (<a class=quiet href="#delay">delay</a> dly y)))
(if (> freq 0.0)
(- (* ccos yd) ; shift up
(* csin yh))
(+ (* ccos yd) ; shift down
(* csin yh))))))))
-</pre>
-<br clear=left>
-<br>
-<table border=0 hspace=40 vspace=10><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (shift-pitch beg dur file freq (order 40))
- (let* ((st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (nd (+ st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (shift-pitch beg dur file freq (order 40))
+ (let* ((st (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (nd (+ st (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(gen (<em class=red>make-ssb-am</em> freq order))
- (rd (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> file)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i st (+ 1 i)))
- ((= i nd))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>ssb-am</em> gen (<a class=quiet href="#readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_readin_tip)">readin</a> rd)))))))
+ (rd (<a class=quiet href="#make-readin">make-readin</a> file)))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>ssb-am</em> gen (<a class=quiet href="#readin">readin</a> rd))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (shift-pitch 0 3 "oboe.snd" 1108.0))
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (shift-pitch 0 3 "oboe.snd" 1108.0))
</pre>
-</td></tr></table>
<p>
@@ -4671,9 +4393,11 @@ Normal amplitude modulation, cos(x) * (amp + Y(t)), where Y is some signal,
produces the carrier (cos(x)), and symmetric sidebands at x+/-frq where frq is each spectral
component of Y. This is just an elaboration of
</p>
-<pre>
- cos(x) * (amp + cos(y)) = amp * cos(x) + 1/2(cos(x - y) + cos(x + y))
+
+<pre class="indented">
+cos(x) * (amp + cos(y)) = amp * cos(x) + 1/2(cos(x - y) + cos(x + y))
</pre>
+
<p>
So, the Y spectrum (the first picture below) is shifted up by cos(x) and mirrored on either side of it (the second picture below; the spectral components
on the left side are folding under 0). In single side-band
@@ -4688,8 +4412,8 @@ We have decoupled the pitch from the duration, much as in a phase vocoder (which
rather than a filter bank, and an inverse FFT of the moved spectrum, rather than ssb-am).
</p>
-<table border=1 hspace=20><tr><td>
-<table border=0 hspace=20 vspace=10>
+
+<table class="method">
<tr>
<td><img src="pix/orig-oboe.png" alt="unaltered oboe"></td>
<td><img src="pix/am.png" alt="am oboe"></td>
@@ -4697,72 +4421,69 @@ rather than a filter bank, and an inverse FFT of the moved spectrum, rather than
<td><img src="pix/ssbambank.png" alt="ssbambank oboe"></td>
</tr>
<tr>
-<td><center>original</center></td>
-<td><center>amplitude modulation</center></td>
-<td><center>ssb-am</center></td>
-<td><center>ssb-am bank</center></td>
+<td class="center">original</td>
+<td class="center">amplitude modulation</td>
+<td class="center">ssb-am</td>
+<td class="center">ssb-am bank</td>
</tr>
</table>
-</td></tr></table>
+
<p>The second picture was created from oboe.snd (the original) via:
</p>
-<pre>
- (let ((osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 1000.0)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
- (lambda (y)
- (* .5 (<a class=quiet href="#amplitude-modulate" onmouseout="UnTip()" onmouseover="Tip(sndclm_amplitude_modulate_tip)">amplitude-modulate</a> .01 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc) y)))))
+<pre class="indented">
+(let ((osc (<a class=quiet href="#make-oscil">make-oscil</a> 1000.0)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a>
+ (lambda (y)
+ (* .5 (<a class=quiet href="#amplitude-modulate">amplitude-modulate</a> .01 (<a class=quiet href="#oscil">oscil</a> osc) y)))))
</pre>
<p>The third picture was created by:
</p>
-<pre>
- (let ((am (<em class=red>make-ssb-am</em> 1000 40)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
- (lambda (y)
- (<em class=red>ssb-am</em> am y))))
+<pre class="indented">
+(let ((am (<em class=red>make-ssb-am</em> 1000 40)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a>
+ (lambda (y)
+ (<em class=red>ssb-am</em> am y))))
</pre>
<p>
And the fourth used the ssb-am-bank function in dsp.scm rewritten here for with-sound:
</p>
-<table border=0 hspace=40 vspace=10><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (repitch beg dur sound old-freq new-freq
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (repitch beg dur sound old-freq new-freq
(amp 1.0) (pairs 10) (order 40) (bw 50.0))
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+ (let* ((start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(ssbs (make-vector pairs))
(bands (make-vector pairs))
(factor (/ (- new-freq old-freq) old-freq))
- (rd (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> sound)))
- (do ((i 1 (+ 1 i)))
+ (rd (<a class=quiet href="#make-readin">make-readin</a> sound)))
+ (do ((i 1 (+ i 1)))
((> i pairs))
- (let* ((aff (* i old-freq))
- (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
+ (let ((aff (* i old-freq))
+ (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
(set! (ssbs (- i 1)) (<em class=red>make-ssb-am</em> (* i factor old-freq)))
- (set! (bands (- i 1)) (<a class=quiet href="sndscm.html#makebandpass" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebandpass_tip)">make-bandpass</a> (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (- aff bwf)) ; bandpass is in dsp.scm
- (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (+ aff bwf))
+ (set! (bands (- i 1)) (<a class=quiet href="sndscm.html#makebandpass">make-bandpass</a> (<a class=quiet href="#hztoradians">hz->radians</a> (- aff bwf)) ; bandpass is in dsp.scm
+ (<a class=quiet href="#hztoradians">hz->radians</a> (+ aff bwf))
order))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (let ((sum 0.0)
- (y (<a class=quiet href="#readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_readin_tip)">readin</a> rd)))
- (do ((band 0 (+ 1 band)))
- ((= band pairs))
- (set! sum (+ sum (<em class=red>ssb-am</em> (ssbs band)
- (<a class=quiet href="sndscm.html#makebandpass" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebandpass_tip)">bandpass</a> (bands band) y)))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp sum)))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let ((sum 0.0)
+ (y (<a class=quiet href="#readin">readin</a> rd)))
+ (do ((band 0 (+ 1 band)))
+ ((= band pairs))
+ (set! sum (+ sum (<em class=red>ssb-am</em> (ssbs band)
+ (<a class=quiet href="sndscm.html#makebandpass">bandpass</a> (bands band) y)))))
+ (<a class=quiet href="#outa">outa</a> i (* amp sum))))))
(let* ((sound "oboe.snd")
(mx (maxamp sound))
- (dur (<a class=quiet href="extsnd.html#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> sound)))
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:scaled-to mx :srate (srate sound))
+ (dur (<a class=quiet href="extsnd.html#mussoundduration">mus-sound-duration</a> sound)))
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:scaled-to mx :srate (srate sound))
(repitch 0 dur sound 554 1000)))
</pre>
-</td></tr></table>
<p>If you'd like to move formants independently of the fundamental, add
@@ -4771,60 +4492,75 @@ frequency argument. In the repitch instrument above, say we wanted to
add a "stretch" argument to spread out or squeeze down the spectrum.
We would replace the current make-ssb-am line with:
</p>
-<pre>
- (vector-set! ssbs (- i 1) (<em class=red>make-ssb-am</em> (+ (* i factor old-freq)
- (* new-freq (round (* i <em class=red>stretch</em>))))))
+
+<pre class="indented">
+(set! (ssbs (- i 1)) (<em class=red>make-ssb-am</em> (+ (* i factor old-freq)
+ (* new-freq (round (* i <em class=red>stretch</em>))))))
</pre>
-<br><br>
-<A NAME="wave-traindoc"></A>
-<!-- ---------------------------------------- WAVE-TRAIN ---------------------------------------- -->
+<!-- WAVE-TRAIN -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>wave-train</h3></center></td></tr></table>
+<div class="innerheader" id="wave-traindoc">wave-train</div>
-<pre>
- <a class=def name="make-wave-train">make-wave-train</a>
+<pre class="indented">
+<em class=def id="make-wave-train">make-wave-train</em>
(frequency *clm-default-frequency*)
(initial-phase 0.0)
wave
(size *clm-table-size*)
(type mus-interp-linear)
- <a class=def name="wave-train">wave-train</a> w (fm 0.0)
- <a class=def name="wave-train?">wave-train?</a> w
+<em class=def id="wave-train">wave-train</em> w (fm 0.0)
+<em class=def id="wave-train?">wave-train?</em> w
- <a class=def NAME="make-wave-train-with-env">make-wave-train-with-env</a> frequency env size
+<em class=def id="make-wave-train-with-env">make-wave-train-with-env</em> frequency env size
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">wave-train methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">wave array (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">length of wave array (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-interp-type</em></td><td class="inner">interpolation choice (no set!)</td></tr>
+</table>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<p>wave-train adds a copy of its wave (a "grain" in more modern parlance) into its output at frequency times per second.
+These copies can overlap or have long intervals of silence in between, so
+wave train can be viewed either as an extension of pulse-train and table-lookup,
+or as a primitive form of granular synthesis.
+make-wave-train-with-env (defined in generators.scm) returns a new wave-train generator with the envelope 'env' loaded into its table.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((gen (make-wave-train 440.0
- :wave (let ((v (make-vct 64))
+ :wave (let ((v (make-float-vector 64 0.0))
(g (make-ncos 400 10)))
(set! (mus-phase g) (* -0.5 pi))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 64))
(set! (v i) (ncos g)))
v))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (wave-train gen))))))
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
v = make_vct(64);
g = make_ncos(400, 10);
@@ -4838,12 +4574,13 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
400 10 make-ncos { g }
g -0.5 pi f* set-mus-phase drop
@@ -4854,43 +4591,25 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<p>wave-train adds a copy of its "wave" (a "grain" in more modern parlance) into its output at "frequency" times per second.
-These copies can overlap or have long intervals of silence in between, so
-wave train can be viewed either as an extension of pulse-train and table-lookup,
-or as a primitive form of granular synthesis.
-make-wave-train-with-env (defined in generators.scm) returns a new wave-train generator with the envelope 'env' loaded into its table.
-</p>
-
-<table border=1 cellpadding=4 hspace=40 vspace=10 align=left>
-<tr><td colspan=2 bgcolor="beige"><center>wave-train methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>wave array (no set!)</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>length of wave array (no set!)</td></tr>
-<tr><td><em class=gen>mus-interp-type</em></td><td>interpolation choice (no set!)</td></tr>
-</table>
-
-<img src="pix/wt.png" alt="wave-train example" vspace=20>
-<br clear=left>
-
+<img src="pix/wt.png" alt="wave-train example">
<!--
(with-sound (:clipped #f :statistics #t :scaled-to .5 :play #t)
- (let ((gen (make-wave-train 300.0 :wave (let ((v (make-vct 64))
+ (let ((gen (make-wave-train 300.0 :wave (let ((v (make-float-vector 64 0.0))
(g (make-sum-of-cosines 10 400 (* -0.5 pi))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 64))
(set! (v i) (sum-of-cosines g)))
v))))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 1000))
- (outa i (wave-train gen))))))
+ (outa i (wave-train gen)))))
-->
<p>
@@ -4901,36 +4620,34 @@ Here is a FOF instrument based loosely on fof.c of Perry Cook and the article
"Current Directions in Computer Music Research".
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 ve ae)
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
- (frq0 (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> f0))
- (frq1 (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> f1))
- (frq2 (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> f2))
- (foflen (if (= (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) 22050) 100 200))
- (vibr (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 6))
- (vibenv (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (or ve (list 0 1 100 1)) :scaler vib :duration dur))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 ve ae)
+ (let* ((start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
+ (ampf (<a class=quiet href="#make-env">make-env</a> (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
+ (frq0 (<a class=quiet href="#hztoradians">hz->radians</a> f0))
+ (frq1 (<a class=quiet href="#hztoradians">hz->radians</a> f1))
+ (frq2 (<a class=quiet href="#hztoradians">hz->radians</a> f2))
+ (foflen (if (= *clm-srate* 22050) 100 200))
+ (vibr (<a class=quiet href="#make-oscil">make-oscil</a> 6))
+ (vibenv (<a class=quiet href="#make-env">make-env</a> (or ve (list 0 1 100 1)) :scaler vib :duration dur))
(win-freq (/ (* 2 pi) foflen))
- (foftab (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> foflen))
+ (foftab (make-float-vector foflen 0.0))
(wt0 (<em class=red>make-wave-train</em> :wave foftab :frequency frq)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i foflen))
(set! (foftab i) ;; this is not the pulse shape used by B&R
(* (+ (* a0 (sin (* i frq0)))
(* a1 (sin (* i frq1)))
(* a2 (sin (* i frq2))))
.5 (- 1.0 (cos (* i win-freq))))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) (<em class=red>wave-train</em> wt0 (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> vibenv) (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> vibr)))))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> ampf) (<em class=red>wave-train</em> wt0 (* (<a class=quiet href="#env">env</a> vibenv) (<a class=quiet href="#oscil">oscil</a> vibr))))))))
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)) ; "Ahh"
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)) ; "Ahh"
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () ; one of JC's favorite demos
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () ; one of JC's favorite demos
(fofins 0 4 270 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
'(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
(fofins 0 4 (* 6/5 540) .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
@@ -4938,109 +4655,126 @@ Here is a FOF instrument based loosely on fof.c of Perry Cook and the article
(fofins 0 4 135 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
'(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0)))
</pre>
-</td></tr></table>
-<p>The "wave" is a vct accessible via mus-data. The "fm" argument affects the frequency of
+<p>The wave-trains's wave is a float-vector accessible via mus-data. The "fm" argument affects the frequency of
repetition. Here is a wave-train instrument that increasingly filters its grain (the word "now", for example)
while increasing the repetition rate. We're also using a pulse train as a sort of internal click track,
using the same frequency envelope as the wave-train, so we have some idea when to refilter the grain.
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (when? start-time duration start-freq end-freq grain-file)
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start-time))
- (len (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> duration))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (when? start-time duration start-freq end-freq grain-file)
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start-time))
+ (len (<a class=quiet href="#secondstosamples">seconds->samples</a> duration))
(end (+ beg len))
- (grain-dur (<a class=quiet href="extsnd.html#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> grain-file))
- (frqf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :scaler (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (- end-freq start-freq)) :duration duration))
+ (grain-dur (<a class=quiet href="extsnd.html#mussoundduration">mus-sound-duration</a> grain-file))
+ (frqf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1) :scaler (<a class=quiet href="#hztoradians">hz->radians</a> (- end-freq start-freq)) :duration duration))
(click-track (<em class=red>make-pulse-train</em> start-freq))
- (grain-size (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> grain-dur))
+ (grain-size (<a class=quiet href="#secondstosamples">seconds->samples</a> grain-dur))
(grains (<em class=red>make-wave-train</em> :size grain-size :frequency start-freq))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 1 1 0) :scaler .7 :offset .3 :duration duration :base 3.0))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 1 1 0) :scaler .7 :offset .3 :duration duration :base 3.0))
(grain (<em class=red>mus-data</em> grains)))
- (<a class=quiet href="#filetoarray" onmouseout="UnTip()" onmouseover="Tip(sndclm_filetoarray_tip)">file->array</a> grain-file 0 0 grain-size grain)
- (let ((original-grain (<a class=quiet href="extsnd.html#vctcopy" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctcopy_tip)">vct-copy</a> grain)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (let* ((gliss (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf)))
- (outa i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) (<em class=red>wave-train</em> grains gliss)))
- (let ((click (<em class=red>pulse-train</em> click-track gliss)))
- (if (> click 0.0)
- (let* ((scaler (max 0.1 (* 1.0 (/ (- i beg) len))))
- (comb-len 32)
- (c1 (<a class=quiet href="#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler comb-len))
- (c2 (<a class=quiet href="#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler (floor (* comb-len .75))))
- (c3 (<a class=quiet href="#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> scaler (floor (* comb-len 1.25)))))
- (do ((k 0 (+ 1 k)))
- ((= k grain-size))
- (let ((x (original-grain k)))
- (set! (grain k) (+ (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c1 x) (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c2 x) (<a class=quiet href="#comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_comb_tip)">comb</a> c3 x))))))))))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (when? 0 4 2.0 8.0 "right-now.snd"))
+ (<a class=quiet href="#filetoarray">file->array</a> grain-file 0 0 grain-size grain)
+ (let ((original-grain (copy grain)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((gliss (<a class=quiet href="#env">env</a> frqf)))
+ (outa i (* (<a class=quiet href="#env">env</a> ampf) (<em class=red>wave-train</em> grains gliss)))
+ (let ((click (<em class=red>pulse-train</em> click-track gliss)))
+ (if (> click 0.0)
+ (let* ((scaler (max 0.1 (* 1.0 (/ (- i beg) len))))
+ (comb-len 32)
+ (c1 (<a class=quiet href="#make-comb">make-comb</a> scaler comb-len))
+ (c2 (<a class=quiet href="#make-comb">make-comb</a> scaler (floor (* comb-len .75))))
+ (c3 (<a class=quiet href="#make-comb">make-comb</a> scaler (floor (* comb-len 1.25)))))
+ (do ((k 0 (+ k 1)))
+ ((= k grain-size))
+ (let ((x (original-grain k)))
+ (set! (grain k) (+ (<a class=quiet href="#comb">comb</a> c1 x) (<a class=quiet href="#comb">comb</a> c2 x) (<a class=quiet href="#comb">comb</a> c3 x)))))))))))))
+
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (when? 0 4 2.0 8.0 "right-now.snd"))
</pre>
-</td></tr></table>
<p>wave-train is built on table-lookup and shares all of its questionable aspects. See also the <a href="#pulsedenv">pulsed-env</a>e generator
in generators.scm, used in animals.scm. It is often simpler to use <a href="#pulse-train">pulse-train</a> as the repetition
trigger, and mus-reset to restart an envelope.
</p>
-<br><br>
-<A NAME="randdoc"></A>
-<!-- ---------------------------------------- RAND, RAND-INTERP ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>rand, rand-interp</h3></center></td></tr></table>
+<!-- RAND, RAND-INTERP -->
-<pre>
- <a class=def name="make-rand">make-rand</a>
+<div class="innerheader" id="randdoc">rand, rand-interp</div>
+
+<pre class="indented">
+<em class=def id="make-rand">make-rand</em>
(frequency *clm-default-frequency*) ; frequency at which new random numbers occur
(amplitude 1.0) ; numbers are between -amplitude and amplitude
(envelope '(-1 1 1 1)) ; distribution envelope (uniform distribution is the default)
distribution ; pre-computed distribution
- <a class=def name="rand">rand</a> r (sweep 0.0)
- <a class=def name="rand?">rand?</a> r
+<em class=def id="rand">rand</em> r (sweep 0.0)
+<em class=def id="rand?">rand?</em> r
- <a class=def name="make-rand-interp">make-rand-interp</a>
+<em class=def id="make-rand-interp">make-rand-interp</em>
(frequency *clm-default-frequency*)
(amplitude 1.0)
(envelope '(-1 1 1 1)
distribution)
- <a class=def name="rand-interp">rand-interp</a> r (sweep 0.0)
- <a class=def name="rand-interp?">rand-interp?</a> r
+<em class=def id="rand-interp">rand-interp</em> r (sweep 0.0)
+<em class=def id="rand-interp?">rand-interp?</em> r
- <a class=def name="mus-random">mus-random</a> amp
- <a class=def Name="mus-rand-seed">mus-rand-seed</a>
+<em class=def id="mus-random">mus-random</em> amp
+<em class=def id="mus-rand-seed">mus-rand-seed</em>
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">rand and rand-interp methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">amplitude arg used in make-<gen></td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">distribution table (float-vector) length</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">distribution table (float-vector), if any</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">frequency in radians per sample</td></tr>
+</table>
+
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<p>rand produces a sequence of random numbers between -amplitude and
+amplitude (a sort of step function).
+rand-interp interpolates between successive
+random numbers.
+rand-interp could be defined as (<a class=quiet href="#moving-average">moving-average</a> agen (rand rgen)) where the
+averager has the same period (length) as the rand.
+In both cases, the "envelope" argument or the "distribution" argument determines the random number distribution.
+mus-random returns a random number between -amplitude and amplitude.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:channels 2 :play #t)
(let ((ran1 (make-rand 5.0 (hz->radians 220.0)))
(ran2 (make-rand-interp 5.0 (hz->radians 220.0)))
(osc1 (make-oscil 440.0))
(osc2 (make-oscil 1320.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 88200))
(outa i (* 0.5 (oscil osc1 (rand ran1))))
(outb i (* 0.5 (oscil osc2 (rand-interp ran2)))))))
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true, :channels, 2) do
ran1 = make_rand(5.0, hz2radians(220.0));
ran2 = make_rand_interp(5.0, hz2radians(220.0));
@@ -5052,12 +4786,14 @@ with_sound(:play, true, :channels, 2) do
end
end.output
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
5.0 220.0 hz->radians make-rand { ran1 }
5.0 330.0 hz->radians make-rand-interp { ran2 }
@@ -5069,41 +4805,12 @@ lambda: ( -- )
loop
; :channels 2 :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>rand produces a sequence of random numbers between -amplitude and
-amplitude (a sort of step function).
-rand-interp interpolates between successive
-random numbers.
-rand-interp could be defined as (<a class=quiet href="#moving-average">moving-average</a> agen (rand rgen)) where the
-averager has the same period (length) as the rand.
-In both cases, the "envelope" argument or the "distribution" argument determines the random number distribution.
-mus-random returns a random number between -amplitude and amplitude.
-mus-rand-seed provides access to the seed for mus-random's random number generator.
-</p>
-
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>rand and rand-interp methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>amplitude arg used in make-<gen></td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>distribution table (vct) length</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>distribution table (vct), if any</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-</table>
-<pre>
-<br>
-rand:
- (if (>= phase (* 2 pi))
- (set! output (<em class=red>mus-random</em> amplitude)))
- (set! phase (+ phase (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency) sweep))
-</pre>
-<br clear=left>
-
<p>The "frequency" is the rate at which new values are produced, so it makes sense to request a frequency above srate/2.
If rand's frequency is the current srate, it produces a new random value on every sample.
Since rand is (normally) producing a sequence of square-waves, and rand-interp a sequence of triangle-waves,
@@ -5113,42 +4820,42 @@ both reflect that in their spectra (spectrum y axis is in dB):
<!--
(with-sound ()
(let ((gen (make-rand 2000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 50000))
(outa i (* .5 (rand gen))))))
(with-sound ()
(let ((gen (make-rand-interp 2000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 50000))
(outa i (* .5 (rand-interp gen))))))
(with-sound ()
(let ((gen (make-square-wave 1000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 50000))
(outa i (* .5 (square-wave gen))))))
(with-sound ()
(let ((gen (make-triangle-wave 1000)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 50000))
(outa i (* .5 (triangle-wave gen))))))
-->
-<table border=1 hspace=20 vspace=10>
+<table class="method">
<tr>
-<td><img src="pix/sqsq.png" alt="sqwave spectrum"></td><td width=20></td><td><img src="pix/tritri.png" alt="triwave spectrum"></td>
+<td><img src="pix/sqsq.png" alt="sqwave spectrum"></td><td><img src="pix/tritri.png" alt="triwave spectrum"></td>
</tr>
<tr>
-<td bgcolor="#f2f4ff"><center>square-wave (freq=1000)</center></td><td></td><td bgcolor="#f2f4ff"><center>triangle-wave (freq=1000)</center></td>
+<td class="center">square-wave (freq=1000)</td><td class="center">triangle-wave (freq=1000)</td>
</tr>
<tr>
-<td><img src="pix/randsq.png" alt="rand spectrum"></td><td></td><td><img src="pix/randtri.png" alt="rand-interp spectrum"></td>
+<td><img src="pix/randsq.png" alt="rand spectrum"></td><td><img src="pix/randtri.png" alt="rand-interp spectrum"></td>
</tr>
<tr>
-<td bgcolor="#f2f4ff"><center>rand (freq=2000)</center></td><td></td><td bgcolor="#f2f4ff"><center>rand-interp (freq=2000)</center></td>
+<td class="center">rand (freq=2000)</td><td class="center">rand-interp (freq=2000)</td>
</tr>
</table>
@@ -5156,53 +4863,57 @@ both reflect that in their spectra (spectrum y axis is in dB):
<p>There are a variety of ways to get a non-uniform random number distribution:
<code>(random (random 1.0))</code> or <code>(sin (mus-random pi))</code> are examples. Exponential distribution could be:
</p>
-<pre>
- (/ (log (max .01 (random 1.0))) (log .01))
+
+<pre class="indented">
+(log (max .01 (random 1.0)) .01)
</pre>
+
<p>where the ".01"'s affect how tightly the resultant values cluster toward 0.0 —
set them to .0001, for example, to get most of the random values close to 0.0.
The central-limit theorem says that you can get closer and closer to gaussian
noise by adding rand's together. Orfanidis in
"Introduction to Signal Processing" says 12 calls on rand will
do perfectly well:
-</p><pre>
- (define (gaussian-noise)
- (let ((val 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 12) (/ val 12.0) )
- (set! val (+ val (random 1.0))))))
+</p>
+
+<pre class="indented">
+(define (gaussian-noise)
+ (let ((val 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 12) (/ val 12.0) )
+ (set! val (+ val (random 1.0))))))
</pre>
+
<p>You can watch this (or any other distribution) in action via:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+
+<pre class="indented">
(define (add-rands n)
(let ((bins (make-vector 201 0))
(rands (make-vector n #f)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i n))
- (set! (rands i) (<em class=red>make-rand</em> :frequency (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) :amplitude (/ 100 n)))
+ (set! (rands i) (<em class=red>make-rand</em> :frequency *clm-srate* :amplitude (/ 100 n)))
(rand (rands i)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100000))
(let ((sum 0.0))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k n))
(set! sum (+ sum (<em class=red>rand</em> (rands k)))))
(let ((bin (floor (+ 100 (round sum)))))
(set! (bins bin) (+ (bins bin) 1)))))
bins))
-(let ((ind (<a class=quiet href="extsnd.html#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "test.snd")))
+(let ((ind (<a class=quiet href="extsnd.html#newsound">new-sound</a> "test.snd")))
(do ((n 1 (+ n 1)))
((= n 12))
- (let* ((bins (vector->vct (add-rands n)))
- (pk (<a class=quiet href="extsnd.html#vctpeak" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctpeak_tip)">vct-peak</a> bins)))
- (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (<a class=quiet href="extsnd.html#vctscale" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctscale_tip)">vct-scale!</a> bins (/ 1.0 pk)))
- (set! (<a class=quiet href="extsnd.html#xaxislabel" onmouseout="UnTip()" onmouseover="Tip(extsnd_xaxislabel_tip)">x-axis-label</a>) (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "n: ~D" n))
- (<a class=quiet href="extsnd.html#updatetimegraph" onmouseout="UnTip()" onmouseover="Tip(extsnd_updatetimegraph_tip)">update-time-graph</a>))))
+ (let* ((bins (vector->float-vector (add-rands n)))
+ (pk (maxamp bins)))
+ (float-vector->channel (float-vector-scale! bins (/ 1.0 pk)))
+ (set! (<a class=quiet href="extsnd.html#xaxislabel">x-axis-label</a>) (<a class=quiet>format</a> #f "n: ~D" n))
+ (<a class=quiet href="extsnd.html#updatetimegraph">update-time-graph</a>))))
</pre>
-</td></tr></table>
<p>
Another way to get different distributions is the "rejection method" in which we generate random number
@@ -5220,37 +4931,35 @@ the y axis sets the relative weight of the corresponding x axis value.
So, the default is <code>'(-1 1 1 1)</code> which says "output numbers between -1 and 1,
each number having the same chance of being chosen".
An envelope of <code>'(0 1 1 0)</code> outputs values between 0 and 1, denser toward 0.
-If you already have the distribution table (a vct, the result of <code>(inverse-integrate envelope)</code> for example),
+If you already have the distribution table (a float-vector, the result of <code>(inverse-integrate envelope)</code> for example),
you can pass it through the "distribution" argument. Here is gaussian noise
using the "envelope" argument:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+
+<pre class="indented">
(define (gaussian-envelope s)
- (let ((e '())
+ (let ((e ())
(den (* 2.0 s s)))
- (do ((i 0 (+ 1 i))
+ (do ((i 0 (+ i 1))
(x -1.0 (+ x .1))
(y -4.0 (+ y .4)))
- ((= i 21))
- (set! e (cons x e))
- (set! e (cons (exp (- (/ (* y y) den))) e)))
- (reverse e)))
+ ((= i 21)
+ (reverse e))
+ (set! e (cons (exp (- (/ (* y y) den))) (cons x e))))))
(<em class=red>make-rand</em> :envelope (gaussian-envelope 1.0))
</pre>
-</td></tr></table>
-<p>If you want a particular set of values, it's simplest to fill a vct with those values,
+<p>If you want a particular set of values, it's simplest to fill a float-vector with those values,
then use random as the index into the array. Say we want 0.0, 0.5, and 1.0 at random,
but 0.5 should happen three times as often as either of the others:
</p>
-<pre>
- (let ((vals (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0.0 0.5 0.5 0.5 1.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f ";~A " (vals (floor (random 5.0)))))))
+<pre class="indented">
+(let ((vals (float-vector 0.0 0.5 0.5 0.5 1.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (<a class=quiet>format</a> #t ";~A " (vals (floor (random 5.0))))))
</pre>
<p>These "distributions" refer to the values returned by the random number
@@ -5265,86 +4974,80 @@ sum together n rand's, where each rand is running an octave slower
than the preceding:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (make-1f-noise n)
;; returns an array of rand's ready for the 1f-noise generator
(let ((rans (make-vector n)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i n) rans)
- (set! (rans i) (<em class=red>make-rand</em> :frequency (/ (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) (expt 2 i)))))))
+ (set! (rans i) (<em class=red>make-rand</em> :frequency (/ *clm-srate* (expt 2 i)))))))
(define (1f-noise rans)
(let ((val 0.0)
(len (length rans)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len) (/ val len))
(set! val (+ val (<em class=red>rand</em> (rans i)))))))
</pre>
-</td></tr></table>
<p>This is the <a href="#pink-noise">pink-noise</a> generator in generators.scm.
See also <a href="#green-noise">green-noise</a> — bounded brownian noise that can mimic 1/f noise in some cases.
(The brownian graph below has a different dB range, and the rand graph would be flat if we used a frequency of 44100).
</p>
-<table border=1 hspace=20 cellpadding=5>
-<tr><td>
-<table border=0>
+<table class="method">
<tr>
-<td bgcolor="#f2f4ff"><center>random</center></td>
-<td bgcolor="#f2f4ff"><center>rand</center></td>
-<td bgcolor="#f2f4ff"><center>rand-interp</center></td>
+<td class="center">random</td>
+<td class="center">rand</td>
+<td class="center">rand-interp</td>
</tr><tr>
<td><img src="pix/random.png" alt="random spectrum"></td>
<td><img src="pix/rand.png" alt="rand spectrum"></td>
<td><img src="pix/randi.png" alt="rand-interp spectrum"></td>
-</tr></table>
-</td></tr><tr><td>
-<table border=0>
+</tr>
<tr>
-<td bgcolor="#f2f4ff"><center>1/f</center></td>
-<td bgcolor="#f2f4ff"><center>brownian</center></td>
-<td bgcolor="#f2f4ff"><center>green</center></td>
+<td class="center">1/f</td>
+<td class="center">brownian</td>
+<td class="center">green</td>
</tr><tr>
<td><img src="pix/1f.png" alt="1/f spectrum"></td>
<td><img src="pix/brownian.png" alt="brownian spectrum"></td>
<td><img src="pix/green.png" alt="green spectrum"></td>
</tr></table>
-</td></tr></table>
+
<!-- CLM:
;; 1f.png
(with-sound ()
(let ((noise (make-1f-noise 12)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
(outa i (1f-noise noise)))))
;; rand.png
(with-sound ()
(let ((noise (make-rand 10000.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
(outa i (rand noise)))))
;; randi.png
(with-sound ()
(let ((noise (make-rand-interp 10000.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
(outa i (rand-interp noise)))))
;; random.png
(with-sound ()
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
(outa i (- 0.5 (random 1.0)))))
;; brownian.png
(with-sound ()
(let ((val 0.0))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
(set! val (+ val -.005 (random 0.01)))
(outa i val))))
@@ -5352,7 +5055,7 @@ See also <a href="#green-noise">green-noise</a> — bounded brownian noise t
;; green.png
(with-sound ()
(let ((noise (make-green-noise 10000.0 1)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
(outa i (green-noise noise 0.0)))))
-->
@@ -5360,24 +5063,21 @@ See also <a href="#green-noise">green-noise</a> — bounded brownian noise t
<p>And we can't talk about noise without mentioning fractals:</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (fractal start duration m x amp)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (fractal start duration m x amp)
;; use formula of M J Feigenbaum
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> duration))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp x))
- (set! x (- 1.0 (* m x x)))))))
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> duration))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp x))
+ (set! x (- 1.0 (* m x x))))))
;;; this quickly reaches a stable point for any m in[0,.75], so:
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fractal 0 1 .5 0 .5))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (fractal 0 1 .5 0 .5))
;;; is just a short "ftt"
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fractal 0 1 1.5 .20 .2))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (fractal 0 1 1.5 .20 .2))
</pre>
-</td></tr></table>
<p>With this instrument you can hear
the change over from the stable equilibria, to the period doublings,
@@ -5385,43 +5085,65 @@ and finally into the combination of noise and periodicity that
has made these curves famous. See appendix 2 to Ekeland's "Mathematics and the Unexpected" for more details.
Another instrument based on similar ideas is:</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (attract beg dur amp c) ; c from 1 to 10 or so
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (attract beg dur amp c) ; c from 1 to 10 or so
;; by James McCartney, from CMJ vol 21 no 3 p 6
- (let* ((st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (nd (+ st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+ (let* ((st (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (nd (+ st (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(a .2) (b .2) (dt .04)
(scale (/ (* .5 amp) c))
(x1 0.0) (x -1.0) (y 0.0) (z 0.0))
- (do ((i st (+ 1 i)))
+ (do ((i st (+ i 1)))
((= i nd))
(set! x1 (- x (* dt (+ y z))))
(set! y (+ y (* dt (+ x (* a y)))))
(set! z (+ z (* dt (- (+ b (* x z)) (* c z)))))
(set! x x1)
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* scale x)))))
+ (<a class=quiet href="#outa">outa</a> i (* scale x)))))
</pre>
-</td></tr></table>
<p>which gives brass-like sounds!
We can also get all the period doublings and so on from sin:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:clipped #f :scaled-to 0.5)
+
+<pre class="indented">
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> (:clipped #f :scaled-to 0.5)
(let ((x 0.5))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i x)
(set! x (* 4 (sin (* pi x)))))))
</pre>
-</td></tr></table>
<p>For an extended discussion of this case, complete with pictures of the
period doublings, see Strogatz, "Nonlinear Dynamics and Chaos".
</p>
+<p>
+mus-rand-seed provides access to the seed for mus-random's random number generator:
+</p>
+<pre class="indented">
+> (set! (mus-rand-seed) 1234)
+1234
+> (mus-random 1.0)
+-0.7828369138846
+> (mus-random 1.0)
+-0.880371093652
+> (set! (mus-rand-seed) 1234) ; now start again with the same sequence of numbers
+1234
+> (mus-random 1.0)
+-0.7828369138846
+> (mus-random 1.0)
+-0.880371093652
+</pre>
+
+<p>The clm random functions discussed here are different from s7's random function.
+The latter has a random-state record to guide the sequence (and uses a different
+algorithm), whereas the clm functions just use an integer, mus-rand-seed.
+</p>
+
+
+
<p>See also
<a href="sndscm.html#ditherchannel">dither-channel</a> (dithering),
<a href="sndscm.html#maracadoc">maraca.scm</a> (physical modelling),
@@ -5430,72 +5152,97 @@ period doublings, see Strogatz, "Nonlinear Dynamics and Chaos".
and <a href="#green-noise">green-noise</a> (bounded Brownian noise).
</p>
-<br><br>
-<A NAME="one-poledoc"></A>
-<A NAME="one-zerodoc"></A>
-<A NAME="two-poledoc"></A>
-<A NAME="two-zerodoc"></A>
-<!-- ---------------------------------------- SIMPLE FILTERS ---------------------------------------- -->
+<!-- SIMPLE FILTERS -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>one-pole, one-zero, two-pole, two-zero</h3></center></td></tr></table>
+<div class="innerheader" id="one-poledoc">one-pole, one-zero, two-pole, two-zero</div>
-<pre>
- <a class=def name="make-one-pole">make-one-pole</a> a0 b1 ; b1 < 0.0 gives lowpass, b1 > 0.0 gives highpass
- <a class=def name="one-pole">one-pole</a> f input
- <a class=def name="one-pole?">one-pole?</a> f
+<pre class="indented">
+ <em class=def id="make-one-pole">make-one-pole</em> a0 b1 ; b1 < 0.0 gives lowpass, b1 > 0.0 gives highpass
+ <em class=def id="one-pole">one-pole</em> f input
+ <em class=def id="one-pole?">one-pole?</em> f
- <a class=def name="make-one-zero">make-one-zero</a> a0 a1 ; a1 > 0.0 gives weak lowpass, a1 < 0.0 highpass
- <a class=def name="one-zero">one-zero</a> f input
- <a class=def name="one-zero?">one-zero?</a> f
+ <em class=def id="make-one-zero">make-one-zero</em> a0 a1 ; a1 > 0.0 gives weak lowpass, a1 < 0.0 highpass
+ <em class=def id="one-zero">one-zero</em> f input
+ <em class=def id="one-zero?">one-zero?</em> f
- <a class=def name="make-two-pole">make-two-pole</a> frequency [or a0] radius [or b1] b2
- <a class=def name="two-pole">two-pole</a> f input
- <a class=def name="two-pole?">two-pole?</a> f
+ <em class=def id="make-two-pole">make-two-pole</em> frequency [or a0] radius [or b1] b2
+ <em class=def id="two-pole">two-pole</em> f input
+ <em class=def id="two-pole?">two-pole?</em> f
- <a class=def name="make-two-zero">make-two-zero</a> frequency [or a0] radius [or a1] a2
- <a class=def name="two-zero">two-zero</a> f input
- <a class=def name="two-zero?">two-zero?</a> f
+ <em class=def id="make-two-zero">make-two-zero</em> frequency [or a0] radius [or a1] a2
+ <em class=def id="two-zero">two-zero</em> f input
+ <em class=def id="two-zero?">two-zero?</em> f
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">simple filter methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-xcoeff</em></td><td class="inner">a0, a1, a2 in equations</td></tr>
+<tr><td class="inner"><em class=gen>mus-ycoeff</em></td><td class="inner">b1, b2 in equations</td></tr>
+<tr><td class="inner"><em class=gen>mus-order</em></td><td class="inner">1 or 2 (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">two-pole and two-zero radius</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">two-pole and two-zero center frequency</td></tr>
+</table>
+
+<p>These are the simplest of filters. If you're curious about filters,
+Julius Smith's on-line <a href="http://www-ccrma.stanford.edu/~jos/filters/">Introduction to Digital Filters</a> is
+excellent.
+</p>
+
+<pre class="indented">
+one-zero y(n) = a0 x(n) + a1 x(n-1)
+one-pole y(n) = a0 x(n) - b1 y(n-1)
+two-pole y(n) = a0 x(n) - b1 y(n-1) - b2 y(n-2)
+two-zero y(n) = a0 x(n) + a1 x(n-1) + a2 x(n-2)
+</pre>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<p>
+The "a0, b1" nomenclature is taken from Julius Smith's "An Introduction to Digital
+Filter Theory" in Strawn "Digital Audio Signal Processing", and is different
+from that used in the more general filters such as <a href="#fir-filter">fir-filter</a>.
+In make-two-pole and make-two-zero you can specify either the actual
+desired coefficients ("a0" and friends), or the center frequency and radius of the
+filter ("frequency" and "radius"). The word "radius" refers to the unit circle,
+so it should be between 0.0 and (less than) 1.0.
+"frequency" should be between 0 and srate/2.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((flt (make-two-pole 1000.0 0.999))
(ran1 (make-rand 10000.0 .002)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (* 0.5 (two-pole flt
- (rand ran1)))))))
+ (outa i (* 0.5 (two-pole flt (rand ran1)))))))
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
flt = make_two_pole(1000.0, 0.999);
ran1 = make_rand(10000.0, 0.002);
44100.times do |i|
- outa(i,
- 0.5 * two_pole(flt, rand(ran1)),
- $output);
+ outa(i, 0.5 * two_pole(flt, rand(ran1)), $output);
end
end.output
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
1000.0 0.999 make-two-pole { flt }
10000.0 0.002 make-rand { ran1 }
@@ -5504,74 +5251,46 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<p>These are the simplest of filters. If you're curious about filters,
-Julius Smith's on-line <a href="http://www-ccrma.stanford.edu/~jos/filters/">Introduction to Digital Filters</a> is
-excellent.
+<p>We can use a one-pole filter as an "exponentially weighted moving average":
</p>
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>simple filter methods</center></td></tr>
-<tr><td><em class=gen>mus-xcoeff</em></td><td>a0, a1, a2 in equations</td></tr>
-<tr><td><em class=gen>mus-ycoeff</em></td><td>b1, b2 in equations</td></tr>
-<tr><td><em class=gen>mus-order</em></td><td>1 or 2 (no set!)</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>two-pole and two-zero radius</td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>two-pole and two-zero center frequency</td></tr>
-</table>
-<pre>
-one-zero y(n) = a0 x(n) + a1 x(n-1)
-one-pole y(n) = a0 x(n) - b1 y(n-1)
-two-pole y(n) = a0 x(n) - b1 y(n-1) - b2 y(n-2)
-two-zero y(n) = a0 x(n) + a1 x(n-1) + a2 x(n-2)
+<pre class="indented">
+(make-one-pole (/ 1.0 order) (/ (- order) (+ 1.0 order)))
</pre>
-<br clear=left>
-<p>
-The "a0, b1" nomenclature is taken from Julius Smith's "An Introduction to Digital
-Filter Theory" in Strawn "Digital Audio Signal Processing", and is different
-from that used in the more general filters such as <a href="#fir-filter">fir-filter</a>.
-In make-two-pole and make-two-zero you can specify either the actual
-desired coefficients ("a0" and friends), or the center frequency and radius of the
-filter ("frequency" and "radius"). The word "radius" refers to the unit circle,
-so it should be between 0.0 and (less than) 1.0.
-"frequency" should be between 0 and srate/2.
-</p>
-<p>We can use a one-pole filter as an "exponentially weighted moving average":
-</p>
-<pre>
- (make-one-pole (/ 1.0 order) (/ (- order) (+ 1.0 order)))
-</pre>
<p>where "order" is more or less how long an input affects the output.
The <a href="#mus-xcoeff">mus-xcoeff</a> and <a href="#mus-ycoeff">mus-ycoeff</a> functions give access to the filter coefficients.
<a href="sndscm.html#prc95doc">prc95.scm</a> uses them to make "run time"
alterations to the filters:
</p>
-<pre>
- (set! (mus-ycoeff p 1) (- val)) ; "p" is a one-pole filter, this is setting "b1"
- (set! (mus-xcoeff p 0) (- 1.0 val)) ; this is setting "a0"
+<pre class="indented">
+(set! (mus-ycoeff p 1) (- val)) ; "p" is a one-pole filter, this is setting "b1"
+(set! (mus-xcoeff p 0) (- 1.0 val)) ; this is setting "a0"
</pre>
<p>We can also use <a href="#mus-frequency">mus-frequency</a> and <a href="#mus-scaler">mus-scaler</a> (the pole "radius") as a more intuitive handle on these coefficients:
</p>
-<pre>
- <em class=listener>></em><em class=typing>(define p (make-two-pole :radius .9 :frequency 1000.0))</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>p</em>
- <em class=listener>#<two-pole: a0: 1.000, b1: -1.727, b2: 0.810, y1: 0.000, y2: 0.000></em>
- <em class=listener>></em><em class=typing>(mus-frequency p)</em>
- <em class=listener>1000.00025329731</em>
- <em class=listener>></em><em class=typing>(mus-scaler p)</em>
- <em class=listener>0.899999968210856</em>
- <em class=listener>></em><em class=typing>(set! (mus-frequency p) 2000.0)</em>
- <em class=listener>2000.0</em>
- <em class=listener>></em><em class=typing>p</em>
- <em class=listener>#<two-pole: a0: 1.000, b1: -1.516, b2: 0.810, y1: 0.000, y2: 0.000></em>
+<pre class="indented">
+> (define p (make-two-pole :radius .9 :frequency 1000.0))
+#<unspecified>
+>p
+#<two-pole: a0: 1.000, b1: -1.727, b2: 0.810, y1: 0.000, y2: 0.000>
+> (mus-frequency p)
+1000.00025329731
+> (mus-scaler p)
+0.899999968210856
+> (set! (mus-frequency p) 2000.0)
+2000.0
+>p
+#<two-pole: a0: 1.000, b1: -1.516, b2: 0.810, y1: 0.000, y2: 0.000>
</pre>
<p>A quick way to see the frequency response of a filter is to drive it with a sine wave sweeping from
@@ -5579,30 +5298,26 @@ alterations to the filters:
as the response at that frequency (in terms of a sampling rate of 1.0):
</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
+<pre class="indented">
(define (test-filter flt)
- (let* ((osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a>))
- (samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> 0.5))
- (ramp (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1)
- :scaler (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> samps)
+ (let* ((osc (<a class=quiet href="#make-oscil">make-oscil</a>))
+ (samps (<a class=quiet href="#secondstosamples">seconds->samples</a> 0.5))
+ (ramp (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1)
+ :scaler (<a class=quiet href="#hztoradians">hz->radians</a> samps)
:length samps)))
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (do ((i 0 (+ 1 i)))
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (do ((i 0 (+ i 1)))
((= i samps))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (flt (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ramp))))))))
+ (<a class=quiet href="#outa">outa</a> i (flt (<a class=quiet href="#oscil">oscil</a> osc (<a class=quiet href="#env">env</a> ramp))))))))
(test-filter (make-one-zero 0.5 0.5))
(test-filter (make-one-pole 0.1 -0.9))
(test-filter (make-two-pole 0.1 0.1 0.9))
(test-filter (make-two-zero 0.5 0.2 0.3))
</pre>
-</td><td>
-<img src="pix/2pole.png" alt="simple filters">
-</td>
-</tr>
-</table>
+
+<img class="indented" src="pix/2pole.png" alt="simple filters">
+
<!--
@@ -5611,7 +5326,7 @@ as the response at that frequency (in terms of a sampling rate of 1.0):
(samps (seconds->samples 0.5))
(ramp (make-env '(0 0 1 1) :scaler (hz->radians samps) :length samps)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(out-any i (flt (oscil osc (env ramp))) chan))))
@@ -5622,72 +5337,99 @@ as the response at that frequency (in terms of a sampling rate of 1.0):
(test-filter (make-two-zero 0.5 0.2 0.3) 3))
(define (fixup-axes)
- (set! (selected-data-color) (make-color 0 0 0))
- (set! (selected-graph-color) (make-color 1 1 1))
+ (set! *selected-data-color* (make-color 0 0 0))
+ (set! *selected-graph-color* (make-color 1 1 1))
(set! (x-axis-label 0 0) "(make-one-zero 0.5 0.5)")
(set! (x-axis-label 0 1) "(make-one-pole 0.1 -0.9)")
(set! (x-axis-label 0 2) "(make-two-pole 0.1 0.1 0.9)")
(set! (x-axis-label 0 3) "(make-two-zero 0.5 0.2 0.3)"))
-->
-<br><br>
-<A NAME="formantdoc"></A>
-<!-- ---------------------------------------- FORMANT ---------------------------------------- -->
+<!-- FORMANT -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>formant</h3></center></td></tr></table>
+<div class="innerheader" id="formantdoc">formant</div>
-<pre>
- <a class=def name="make-formant">make-formant</a>
+<pre class="indented">
+<em class=def id="make-formant">make-formant</em>
frequency ; resonance center frequency in Hz
radius ; resonance width, indirectly
- <a class=def name="formant">formant</a> f input center-frequency-in-radians
- <a class=def name="formant?">formant?</a> f
+<em class=def id="formant">formant</em> f input center-frequency-in-radians
+<em class=def id="formant?">formant?</em> f
+
+<em class=def id="formantbank">formant-bank</em> filters input
+<em class=def id="formantbankp">formant-bank?</em> f
+<em class=def id="makeformantbank">make-formant-bank</em> filters amps
- <a class=def name="make-firmant">make-firmant</a> frequency radius
- <a class=def name="firmant">firmant</a> f input center-frequency-in-radians
- <a class=def name="firmant?">firmant?</a> f
+<em class=def id="make-firmant">make-firmant</em> frequency radius
+<em class=def id="firmant">firmant</em> f input center-frequency-in-radians
+<em class=def id="firmant?">firmant?</em> f
+
+;; the next two are optimizations that I may remove
+<em class=def>mus-set-formant-frequency</em> f frequency
+<em class=def>mus-set-formant-radius-and-frequency</em> f radius frequency
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">formant methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">formant radius</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">formant center frequency</td></tr>
+<tr><td class="inner"><em class=gen>mus-order</em></td><td class="inner">2 (no set!)</td></tr>
+</table>
+
+<p>formant and firmant are resonators (two-pole, two-zero bandpass filters) centered at "frequency", with the bandwidth set by "radius".
+</p>
+
+<pre class="indented">
+formant:
+ y(n) = x(n) -
+ r * x(n-2) +
+ 2 * r * cos(frq) * y(n-1) -
+ r * r * y(n-2)
+
+firmant:
+ x(n+1) = r * (x(n) - 2 * sin(frq/2) * y(n)) + input
+ y(n+1) = r * (2 * sin(frq/2) * x(n+1) + y(n))
+</pre>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((flt (make-firmant 1000.0 0.999))
(ran1 (make-rand 10000.0 5.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
- (outa i (* 0.5 (firmant flt
- (rand ran1)))))))
+ (outa i (* 0.5 (firmant flt (rand ran1)))))))
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
flt = make_firmant(1000.0, 0.999);
ran1 = make_rand(10000.0, 5.0);
44100.times do |i|
- outa(i,
- 0.5 * firmant(flt, rand(ran1)),
- $output);
+ outa(i, 0.5 * firmant(flt, rand(ran1)), $output);
end
end.output
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
1000.0 0.999 make-firmant { flt }
10000.0 5.0 make-rand { ran1 }
@@ -5696,51 +5438,25 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>formant and firmant are resonators (two-pole, two-zero bandpass filters) centered at "frequency", with the bandwidth set by "radius".
+<p>The formant generator is described in "A Constant-gain Digital Resonator Tuned By a Single Coefficient" by Julius
+O. Smith and James B. Angell in Computer Music Journal Vol. 6 No. 4 (winter
+1982) and "A note on
+Constant-Gain Digital Resonators" by Ken Steiglitz, CMJ vol 18 No. 4 pp.8-10
+(winter 1994).
+The formant bandwidth is a function of the "radius", and its center frequency is set by "frequency".
+As the radius approaches 1.0 (the unit circle), the
+resonance gets narrower.
+Use <a href="#mus-frequency">mus-frequency</a> to change the center frequency, and <a href="#mus-scaler">mus-scaler</a> to change the radius.
+The radius can be set in terms of desired bandwidth in Hz via:
</p>
-
-<table border=0>
-<tr><td>
-<table border=1 hspace=40 vspace=16 cellpadding=4 align=left>
-<tr><td colspan=2 bgcolor="beige"><center>formant methods</center></td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>formant radius</td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>formant center frequency</td></tr>
-<tr><td><em class=gen>mus-order</em></td><td>2 (no set!)</td></tr>
-</table>
-
-</td><td>
-<pre>
- formant:
- y(n) = x(n) -
- r * x(n-2) +
- 2 * r * cos(frq) * y(n-1) -
- r * r * y(n-2)
-
- firmant:
- x(n+1) = r * (x(n) - 2 * sin(frq/2) * y(n)) + input
- y(n+1) = r * (2 * sin(frq/2) * x(n+1) + y(n))
-</pre>
-</td></tr></table>
-
-<p>The formant generator is described in "A Constant-gain Digital Resonator Tuned By a Single Coefficient" by Julius
-O. Smith and James B. Angell in Computer Music Journal Vol. 6 No. 4 (winter
-1982) and "A note on
-Constant-Gain Digital Resonators" by Ken Steiglitz, CMJ vol 18 No. 4 pp.8-10
-(winter 1994).
-The formant bandwidth is a function of the "radius", and its center frequency is set by "frequency".
-As the radius approaches 1.0 (the unit circle), the
-resonance gets narrower.
-Use <a href="#mus-frequency">mus-frequency</a> to change the center frequency, and <a href="#mus-scaler">mus-scaler</a> to change the radius.
-The radius can be set in terms of desired bandwidth in Hz via:
-</p>
-<pre>
- (exp (* -0.5 (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> bandwidth)))
-</pre>
+<pre class="indented">
+(exp (* -0.5 (<a class=quiet href="#hztoradians">hz->radians</a> bandwidth)))
+</pre>
<p>If you change the radius, the peak amplitude
of the output changes.
@@ -5751,7 +5467,7 @@ Here are some graphs showing the formant and firmant filtering white noise
as we sweep either the frequency or the radius:
</p>
-<img src="pix/formant.png" alt="various formant cases" hspace=20>
+<img class="indented" src="pix/formant.png" alt="various formant cases">
<!--
(with-sound (:channels 4 :clipped #f :statistics #t)
@@ -5764,8 +5480,7 @@ as we sweep either the frequency or the radius:
(ampf (make-env '(0 0 1 1 100 1 101 0) :duration dur))
(frqf (make-env '(0 100 1 10000) :scaler (hz->radians 1.0) :duration dur))
(rf (make-env '(0 .6 1 .999) :base .01 :duration dur)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(let* ((frq (env frqf))
(r (env rf))
@@ -5777,11 +5492,11 @@ as we sweep either the frequency or the radius:
(outb i (* amp (firmant fltc pulse frq)))
(outd i (* amp (firmant fltd pulse)))
(set! (mus-scaler fltd) r)
- )))))
+ ))))
(define (fixup-axes)
- (set! (selected-data-color) (make-color 0 0 0))
- (set! (selected-graph-color) (make-color 1 1 1))
+ (set! *selected-data-color* (make-color 0 0 0))
+ (set! *selected-graph-color* (make-color 1 1 1))
(set! (x-axis-label 0 0 0) "formant: sweep frequency from 100 to 10000")
(set! (x-axis-label 0 1 0) "firmant: sweep frequency from 100 to 10000")
(set! (x-axis-label 0 0 1) "formant radius: .999")
@@ -5796,16 +5511,16 @@ as we sweep either the frequency or the radius:
In animals.scm, the crow, for example,
</p>
-<pre>
- (load "animals.scm")
- (with-sound (:play #t) (american-crow 0 .5))
+<pre class="indented">
+(load "animals.scm")
+(with-sound (:play #t) (american-crow 0 .5))
</pre>
<p>has three formant filters. Without them, it would sound like this:
</p>
-<pre>
- (with-sound (:play #t) (american-crow-no-formants 0 .5))
+<pre class="indented">
+(with-sound (:play #t) (american-crow-no-formants 0 .5))
</pre>
@@ -5819,41 +5534,63 @@ If "radius" is .99, you get a glass-harmonica effect; if it's less, you get more
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (move-formants start file amp radius move-env num-formants)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (move-formants start file amp radius move-env num-formants)
(let* ((frms (make-vector num-formants))
- (beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (dur (<a class=quiet href="extsnd.html#mussoundframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundframes_tip)">mus-sound-frames</a> file))
+ (beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (dur (<a class=quiet href="extsnd.html#mussoundframples">mus-sound-framples</a> file))
(end (+ beg dur))
- (rd (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> file))
- (menv (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> move-env :length dur)))
- (let ((start-frq (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> menv)))
- (do ((i 0 (+ 1 i)))
+ (rd (<a class=quiet href="#make-readin">make-readin</a> file))
+ (menv (<a class=quiet href="#make-env">make-env</a> move-env :length dur)))
+ (let ((start-frq (<a class=quiet href="#env">env</a> menv)))
+ (do ((i 0 (+ i 1)))
((= i num-formants))
(set! (frms i) (<em class=red>make-formant</em> (* (+ i 1) start-frq) radius))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((k beg (+ 1 k)))
- ((= k end))
- (let ((sum 0.0)
- (x (<a class=quiet href="#readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_readin_tip)">readin</a> rd))
- (frq (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> menv)))
- (do ((i 0 (+ 1 i)))
- ((= i num-formants))
- (set! sum (+ sum (<em class=red>formant</em> (frms i) x)))
- (let ((curfrq (* (+ i 1) frq)))
- (if (< (* 2 curfrq) (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>))
- (set! (<em class=red>mus-frequency</em> (frms i)) curfrq))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> k (* amp sum)))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+ (let ((fb (<em class=red>make-formant-bank</em> frms)))
+ (do ((k beg (+ k 1)))
+ ((= k end))
+ (let ((frq (<a class=quiet href="#env">env</a> menv)))
+ (outa k (<em class=red>formant-bank</em> fb (* amp (readin rd))))
+ (do ((i 0 (+ i 1))
+ (curfrq frq (+ curfrq frq)))
+ ((= i num-formants))
+ (if (< (* 2 curfrq) *clm-srate*)
+ (set! (<em class=red>mus-frequency</em> (frms i)) curfrq))))))))
+
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(move-formants 0 "oboe.snd" 2.0 0.99 '(0 1200 1.6 2400 2 1400) 4))
</pre>
-</td></tr></table>
+<p>make-formant-bank creates a formant-bank generator, an array of formant generators that is summed in parallel. The
+explicit do loop:
+</p>
+
+<pre class="indented">
+(let ((sum 0.0)) ; say we have n formant generators in the formants vector, and we're passing each a signal x
+ (do ((i 0 (+ i 1)))
+ ((= i n) sum)
+ (set! sum (+ sum (formant (formants i) x)))))
+</pre>
+
+<p>can be replaced with:
+</p>
+
+<pre class="indented">
+(let ((fb (make-formant-bank formants)))
+ ...
+ (formant-bank fb x))
+</pre>
+<p>make-formant-bank takes a vector of formant generators as its first argument. Its optional second argument
+is a float-vector of gains (amplitudes) to scale each formant's contribution to the sum. Similarly, formant-bank's
+second argument is either a real number or a float-vector. If a float-vector, each element is treated as the input to the
+corresponding formant in the bank.
+</p>
+
+
+<br>
<p>The clm-3 formant gain calculation was incorrect. To translate from the old
-formant to the new one, multiply the old gain by (* 2 (sin (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency))).
+formant to the new one, multiply the old gain by (* 2 (sin (<a class=quiet href="#hztoradians">hz->radians</a> frequency))).
</p>
<p>If you change the radius or frequency rapidly, the formant generator will either produce
@@ -5861,77 +5598,98 @@ clicks or overflow, but firmant gives good output. Here's an
example that puts formant on the edge of disaster (the glitch is about to explode), but firmant plugs away happily:
</p>
-<table border=0 hspace=20>
-<tr>
-<td width=500>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 2)
(let* ((dur 3)
- (samps (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))
+ (samps (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))
(flta (<em class=red>make-formant</em> 100 .999))
(fltc (<em class=red>make-firmant</em> 100 .999))
- (vib (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 10))
- (index (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 100))
- (click (<a class=quiet href="#make-ncos" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_ncos_tip)">make-ncos</a> 40 500)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i samps))
- (let* ((vib (* index (+ 1 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> vib))))
- (pulse (<a class=quiet href="#ncos" onmouseout="UnTip()" onmouseover="Tip(sndclm_ncos_tip)">ncos</a> click)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* 10 (<em class=red>formant</em> flta pulse vib)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outb</a> i (* 10 (<em class=red>firmant</em> fltc pulse vib))))))))
+ (vibosc (<a class=quiet href="#make-oscil">make-oscil</a> 10))
+ (index (<a class=quiet href="#hztoradians">hz->radians</a> 100))
+ (click (<a class=quiet href="#make-ncos">make-ncos</a> 40 500)))
+ (do ((i 0 (+ i 1)))
+ ((= i samps))
+ (let ((vib (* index (+ 1 (<a class=quiet href="#oscil">oscil</a> vibosc))))
+ (pulse (<a class=quiet href="#ncos">ncos</a> click)))
+ (<a class=quiet href="#outa">outa</a> i (* 10 (<em class=red>formant</em> flta pulse vib)))
+ (<a class=quiet href="#outa">outb</a> i (* 10 (<em class=red>firmant</em> fltc pulse vib)))))))
</pre>
-</td><td>
-<img src="pix/firmant.png" alt="firmant is happy" hspace=20>
-</td>
-</tr></table>
-<br><br>
+<img class="indented" src="pix/firmant.png" alt="firmant is happy">
-<A NAME="filterdoc"></A>
-<A NAME="fir-filterdoc"></A>
-<A NAME="iir-filterdoc"></A>
-<!-- ---------------------------------------- FILTERS ---------------------------------------- -->
-<br>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>filter, iir-filter, fir-filter</h3></center></td></tr></table>
-<pre>
- <a class=def name="make-filter">make-filter</a> order xcoeffs ycoeffs
- <a class=def name="filter">filter</a> fl inp
- <a class=def name="filter?">filter?</a> fl
- <a class=def name="make-fir-filter">make-fir-filter</a> order xcoeffs
- <a class=def name="fir-filter">fir-filter</a> fl inp
- <a class=def name="fir-filter?">fir-filter?</a> fl
+<!-- FILTERS -->
+
+<div class="innerheader" id="filterdoc">filter, iir-filter, fir-filter</div>
+
+<pre class="indented">
+ <em class=def id="make-filter">make-filter</em> order xcoeffs ycoeffs
+ <em class=def id="filter">filter</em> fl inp
+ <em class=def id="filter?">filter?</em> fl
+
+ <em class=def id="make-fir-filter">make-fir-filter</em> order xcoeffs
+ <em class=def id="fir-filter">fir-filter</em> fl inp
+ <em class=def id="fir-filter?">fir-filter?</em> fl
- <a class=def name="make-iir-filter">make-iir-filter</a> order ycoeffs
- <a class=def name="iir-filter">iir-filter</a> fl inp
- <a class=def name="iir-filter?">iir-filter?</a> fl
+ <em class=def id="make-iir-filter">make-iir-filter</em> order ycoeffs
+ <em class=def id="iir-filter">iir-filter</em> fl inp
+ <em class=def id="iir-filter?">iir-filter?</em> fl
- <a class=def name="make-fir-coeffs">make-fir-coeffs</a> order v
+ <em class=def id="make-fir-coeffs">make-fir-coeffs</em> order v
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">general filter methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-order</em></td><td class="inner">filter order</td></tr>
+<tr><td class="inner"><em class=gen>mus-xcoeff</em></td><td class="inner">x (input) coeff</td></tr>
+<tr><td class="inner"><em class=gen>mus-xcoeffs</em></td><td class="inner">x (input) coeffs</td></tr>
+<tr><td class="inner"><em class=gen>mus-ycoeff</em></td><td class="inner">y (output) coeff</td></tr>
+<tr><td class="inner"><em class=gen>mus-ycoeffs</em></td><td class="inner">y (output) coeffs</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">current state (input values)</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">same as mus-order</td></tr>
+</table>
+
+<p>These are general FIR/IIR filters of arbitrary order.
+The "order" argument is one greater than the nominal filter
+order (it is the size of the coefficient array).
+The filter generator might be defined:
+</p>
+
+<pre class="indented">
+ (let ((xout 0.0))
+ (set! (state 0) input)
+ (do ((j (- order 1) (- j 1)))
+ ((= j 0))
+ (set! xout (+ xout (* (xcoeffs j) (state j))))
+ (set! (state 0) (- (state 0) (* (ycoeffs j) (state j))))
+ (set! (state j) (state (- j 1))))
+ (+ xout (* (state 0) (xcoeffs 0))))
+</pre>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
- (let ((flt (make-iir-filter 3 (vct 0.0 -1.978 0.998)))
+ (let ((flt (make-iir-filter 3 (float-vector 0.0 -1.978 0.998)))
(ran1 (make-rand 10000.0 0.002)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (iir-filter flt (rand ran1)))))))
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
flt = make_iir_filter(3, vct(0.0, -1.978, 0.998));
ran1 = make_rand(10000.0, 0.002);
@@ -5940,12 +5698,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
3 vct( 0.0 -1.978 0.998 ) make-iir-filter { flt }
10000.0 0.002 make-rand { ran1 }
@@ -5954,42 +5714,11 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>These are general FIR/IIR filters of arbitrary order.
-The "order" argument is one greater than the nominal filter
-order (it is the size of the coefficient array).
-</p>
-
-<table border=0 hspace=20 cellspacing=20><tr><td>
-<table border=1 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>general filter methods</center></td></tr>
-<tr><td><em class=gen>mus-order</em></td><td>filter order</td></tr>
-<tr><td><em class=gen>mus-xcoeff</em></td><td>x (input) coeff</td></tr>
-<tr><td><em class=gen>mus-xcoeffs</em></td><td>x (input) coeffs</td></tr>
-<tr><td><em class=gen>mus-ycoeff</em></td><td>y (output) coeff</td></tr>
-<tr><td><em class=gen>mus-ycoeffs</em></td><td>y (output) coeffs</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>current state (input values)</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>same as mus-order</td></tr>
-</table>
-</td>
-<td>
-<pre>
- (let ((xout 0.0))
- (set! (state 0) input)
- (do ((j (- order 1) (- j 1)))
- ((= j 0))
- (set! xout (+ xout (* (xcoeffs j) (state j))))
- (set! (state 0) (- (state 0) (* (ycoeffs j) (state j))))
- (set! (state j) (state (- j 1))))
- (+ xout (* (state 0) (xcoeffs 0))))
-</pre>
-</td>
-</tr></table>
-
<p><a href="sndscm.html#dspdoc">dsp.scm</a> has a number of filter design functions,
and various specializations of the filter generators, including such
perennial favorites as biquad, butterworth, hilbert transform, and
@@ -5998,28 +5727,25 @@ the usual IIR suspects: Butterworth, Chebyshev, Bessel, and Elliptic filters.
A biquad section can be implemented as:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
- (define (make-biquad a0 a1 a2 b1 b2)
- (make-filter 3 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> a0 a1 a2) (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0.0 b1 b2)))
+<pre class="indented">
+(define (make-biquad a0 a1 a2 b1 b2)
+ (make-filter 3 (float-vector 0.0 b1 b2)))
</pre>
-</td></tr></table>
<p>
The Hilbert transform can be implemented with an fir-filter:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define* (make-hilbert-transform (len 30))
(let* ((arrlen (+ 1 (* 2 len)))
- (arr (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> arrlen))
+ (arr (make-float-vector arrlen 0.0))
(lim (if (even? len) len (+ 1 len))))
- (do ((i (- len) (+ 1 i)))
+ (do ((i (- len) (+ i 1)))
((= i lim))
- (let* ((k (+ i len))
- (denom (* pi i))
- (num (- 1.0 (cos (* pi i)))))
+ (let ((k (+ i len))
+ (denom (* pi i))
+ (num (- 1.0 (cos (* pi i)))))
(if (or (= num 0.0) (= i 0))
(set! (arr k) 0.0)
(set! (arr k) (* (/ num denom)
@@ -6028,19 +5754,16 @@ The Hilbert transform can be implemented with an fir-filter:
(define hilbert-transform <em class=red>fir-filter</em>)
</pre>
-</td></tr></table>
-<p>make-fir-coeffs translates a frequency response envelope (actually, evenly spaced points in a vct) into the corresponding FIR filter coefficients.
+<p>make-fir-coeffs translates a frequency response envelope (actually, evenly spaced points in a float-vector) into the corresponding FIR filter coefficients.
The order of the filter determines how close you
get to the envelope.
</p>
-<br>
-
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="beige">Filters</th>
+<table class="method">
+<tr><td class="methodtitle">Filters</td></tr>
<tr><td>
<blockquote><small>
-<br>
lowpass filter: <a href="sndscm.html#makelowpass">make-lowpass</a> in dsp.scm<br>
highpass filter: <a href="sndscm.html#makehighpass">make-highpass</a> in dsp.scm<br>
bandpass filter: <a href="sndscm.html#makebandpass">make-bandpass</a> in dsp.scm<br>
@@ -6048,8 +5771,8 @@ bandstop filter: <a href="sndscm.html#makebandstop">make-bandstop</a> in dsp.scm
Butterworth, Chebyshev, Bessel, Elliptic filters: <a href="sndscm.html#analogfilterdoc">analog-filter.scm</a><br>
Hilbert transform: <a href="sndscm.html#makehilberttransform">make-hilbert-transform</a> in dsp.scm<br>
differentiator: <a href="sndscm.html#makedifferentiator">make-differentiator</a> in dsp.scm<br>
-block DC: dc-block in prc95.scm or (make-filter 2 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 1 -1) (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 -0.99))<br>
-hum elimination: <a href="sndscm.html#IIRfilters">eliminate-hum</a> and <a href="sndscm.html#notchchannel">notch-channel</a> in dsp.scm<br>
+block DC: dc-block in prc95.scm or (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))<br>
+hum elimination: <a href="sndscm.html#IIRfilters">make-eliminate-hum</a> and <a href="sndscm.html#notchchannel">notch-channel</a> in dsp.scm<br>
hiss elimination: <a href="sndscm.html#notchoutrumbleandhiss">notch-out-rumble-and-hiss</a><br>
smoothing filters: <a href="#moving-average">moving-average</a>, <a href="#weighted-moving-average">weighted-moving-average</a>, exponentially-weighted-moving-average<br>
notch-filters: <a href="sndscm.html#notchchannel">notch-channel</a> and <a href="sndscm.html#notchselection">notch-selection</a><br>
@@ -6066,55 +5789,86 @@ nonlinear (Volterra) filter: <a href="sndscm.html#volterrafilter">volterra-filte
Kalman filter: <a href="sndscm.html#kalmanfilterchannel">kalman-filter-channel</a><br>
filter a sound: <a href="extsnd.html#filtersound">filter-sound</a>, <a href="extsnd.html#filterchannel">filter-channel</a><br>
see also convolution, physical modeling, reverb, and <a href="sndscm.html#ssffts">fft-based filtering</a><br>
-<br>
</small></blockquote>
</td></tr></table>
-<br><br>
-<A NAME="delaydoc"></A>
-<!-- ---------------------------------------- DELAY ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>delay, tap</h3></center></td></tr></table>
+<!-- DELAY -->
-<pre>
- <a class=def name="make-delay">make-delay</a>
+<div class="innerheader" id="delaydoc">delay, tap</div>
+
+<pre class="indented">
+<em class=def id="make-delay">make-delay</em>
size ; delay length
- initial-contents ; delay line's initial values (a vct or a list)
+ initial-contents ; delay line's initial values (a float-vector or a list)
(initial-element 0.0) ; delay line's initial element
max-size ; maximum delay size in case the delay changes
type ; interpolation type
- <a class=def name="delay">delay</a> d input (pm 0.0)
- <a class=def name="delay?">delay?</a> d
-
- <a class=def name="tap">tap</a> d (offset 0)
- <a class=def name="delaytick">delay-tick</a> d input
-</pre>
+<em class=def id="delay">delay</em> d input (pm 0.0)
+<em class=def id="delay?">delay?</em> d
+
+<em class=def id="tap">tap</em> d (offset 0)
+<em class=def id="tap?">tap?</em> d
+<em class=def id="delaytick">delay-tick</em> d input
+</pre>
+
+<table class="method">
+<tr><td colspan=2 class="methodtitle">delay methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">length of delay</td></tr>
+<tr><td class="inner"><em class=gen>mus-order</em></td><td class="inner">same as mus-length</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">delay line itself (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-interp-type</em></td><td class="inner">interpolation choice (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">available for delay specializations</td></tr>
+<tr><td class="inner"><em class=gen>mus-location</em></td><td class="inner">current delay line write position</td></tr>
+</table>
+<p>The delay generator is a delay line.
+The make-delay "size" argument sets the delay line length (in samples).
+Input fed into a delay line reappears at the output size samples later.
+If "max-size" is specified in make-delay,
+and it is larger than "size", the delay line can provide varying-length delays (including fractional amounts).
+The delay generator's "pm" argument determines how far from the original "size" we are; that is,
+it is difference between the length set by make-delay
+and the current actual delay length, size + pm. So, a positive "pm" corresponds to a longer
+delay line. See <a href="sndscm.html#zecho">zecho</a> in examp.scm for an example.
+The make-delay "type" argument sets the interpolation type in the case of fractional delays:
+mus-interp-none, mus-interp-linear, mus-interp-all-pass,
+mus-interp-lagrange, mus-interp-bezier, or mus-interp-hermite.
+Delay could be defined:
+</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<pre class="indented">
+(let ((result (<a class=quiet href="#array-interp">array-interp</a> line (- loc pm))))
+ (set! (line loc) input)
+ (set! loc (+ 1 loc))
+ (if (<= size loc) (set! loc 0))
+ result)
+</pre>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((dly (make-delay (seconds->samples 0.5)))
(osc1 (make-oscil 440.0))
(osc2 (make-oscil 660.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5
(+ (oscil osc1)
- (delay dly
- (oscil osc2))))))))
+ (delay dly (oscil osc2))))))))
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
dly = make_delay(seconds2samples(0.5));
osc1 = make_oscil(440.0);
@@ -6127,12 +5881,13 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
0.5 seconds->samples make-delay { dly }
440.0 make-oscil { osc1 }
@@ -6145,45 +5900,11 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>The delay generator is a delay line.
-The make-delay "size" argument sets the delay line length (in samples).
-Input fed into a delay line reappears at the output size samples later.
-If "max-size" is specified in make-delay,
-and it is larger than "size", the delay line can provide varying-length delays (including fractional amounts).
-The delay generator's "pm" argument determines how far from the original "size" we are; that is,
-it is difference between the length set by make-delay
-and the current actual delay length, size + pm. So, a positive "pm" corresponds to a longer
-delay line. See <a href="sndscm.html#zecho">zecho</a> in examp.scm for an example.
-The make-delay "type" argument sets the interpolation type in the case of fractional delays:
-mus-interp-none, mus-interp-linear, mus-interp-all-pass,
-mus-interp-lagrange, mus-interp-bezier, or mus-interp-hermite.
-</p>
-
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>delay methods</center></td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>length of delay</td></tr>
-<tr><td><em class=gen>mus-order</em></td><td>same as mus-length</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>delay line itself (no set!)</td></tr>
-<tr><td><em class=gen>mus-interp-type</em></td><td>interpolation choice (no set!)</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>available for delay specializations</td></tr>
-<tr><td><em class=gen>mus-location</em></td><td>current delay line write position</td></tr>
-</table>
-<br>
-<pre>
-(let ((result (<a class=quiet href="#array-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_array_interp_tip)">array-interp</a> line (- loc pm))))
- (set! (line loc) input)
- (set! loc (+ 1 loc))
- (if (<= size loc) (set! loc 0))
- result)
-</pre>
-<br clear=left>
-<br>
-
<p>
The tap function taps a delay line at a given offset from the output point.
delay-tick is a function that just puts a sample in the delay line, 'ticks' the delay forward, and
@@ -6191,20 +5912,17 @@ returns its "input" argument.
See prc95.scm for examples of both of these functions.
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (echo beg dur scaler secs file)
- (let ((del (<em class=red>make-delay</em> (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> secs)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (echo beg dur scaler secs file)
+ (let ((del (<em class=red>make-delay</em> (<a class=quiet href="#secondstosamples">seconds->samples</a> secs)))
(rd (make-sampler 0 file)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i (+ beg dur)))
- (let ((inval (rd)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (+ inval (<em class=red>delay</em> del (* scaler (+ (<em class=red>tap</em> del) inval))))))))))
+ (do ((i beg (+ i 1)))
+ ((= i (+ beg dur)))
+ (let ((inval (rd)))
+ (<a class=quiet href="#outa">outa</a> i (+ inval (<em class=red>delay</em> del (* scaler (+ (<em class=red>tap</em> del) inval)))))))))
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (echo 0 60000 .5 1.0 "pistol.snd"))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (echo 0 60000 .5 1.0 "pistol.snd"))
</pre>
-</td></tr></table>
<p>The <a href="#mus-scaler">mus-scaler</a> field is available for simple extensions of the delay. For example,
the <a href="#moving-max">moving-max</a> generator uses mus-scaler to track the current maximum sample value
@@ -6214,9 +5932,9 @@ The <a href="#mus-location">mus-location</a> field returns the current delay lin
To access the delay line contents as a sliding window on the input data, use:
</p>
-<pre>
- (define (delay-ref dly loc)
- (vct-ref (mus-data dly) (modulo (+ loc (<em class=red>mus-location</em> dly)) (mus-length dly))))
+<pre class="indented">
+(define (delay-ref dly loc)
+ (float-vector-ref (mus-data dly) (modulo (+ loc (<em class=red>mus-location</em> dly)) (mus-length dly))))
</pre>
<p>
@@ -6226,51 +5944,87 @@ chorus effects (<a href="sndscm.html#chorus">chorus</a> in dsp.scm), and flangin
and is the basis for about a dozen extensions (comb and friends below).
</p>
-<br><br>
+<!-- COMB, NOTCH -->
-<A NAME="combdoc"></A>
-<A NAME="notchdoc"></A>
-<!-- ---------------------------------------- COMB, NOTCH ---------------------------------------- -->
+<div class="innerheader" id="combdoc">comb, notch</div>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>comb, notch</h3></center></td></tr></table>
+<pre class="indented">
+<em class=def id="make-comb">make-comb</em> (scaler 1.0) size initial-contents (initial-element 0.0) max-size
+<em class=def id="comb">comb</em> cflt input (pm 0.0)
+<em class=def id="comb?">comb?</em> cflt
-<pre>
- <a class=def name="make-comb">make-comb</a> (scaler 1.0) size initial-contents (initial-element 0.0) max-size
- <a class=def name="comb">comb</a> cflt input (pm 0.0)
- <a class=def name="comb?">comb?</a> cflt
+<em class=def id="combbank">comb-bank</em> combs input
+<em class=def id="combbankp">comb-bank?</em> object
+<em class=def id="makecombbank">make-comb-bank</em> combs
+
+<em class=def id="make-filtered-comb">make-filtered-comb</em> (scaler 1.0) size initial-contents (initial-element 0.0) max-size filter
+<em class=def id="filtered-comb">filtered-comb</em> cflt input (pm 0.0)
+<em class=def id="filtered-comb?">filtered-comb?</em> cflt
- <a class=def name="make-filtered-comb">make-filtered-comb</a> (scaler 1.0) size initial-contents (initial-element 0.0) max-size filter
- <a class=def name="filtered-comb">filtered-comb</a> cflt input (pm 0.0)
- <a class=def name="filtered-comb?">filtered-comb?</a> cflt
+<em class=def id="filteredcombbank">filtered-comb-bank</em> fcombs input
+<em class=def id="filteredcombbankp">filtered-comb-bank?</em> object
+<em class=def id="makefilteredcombbank">make-filtered-comb-bank</em> fcombs
- <a class=def name="make-notch">make-notch</a> (scaler 1.0) size initial-contents (initial-element 0.0) max-size
- <a class=def name="notch">notch</a> cflt input (pm 0.0)
- <a class=def name="notch?">notch?</a> cflt
+<em class=def id="make-notch">make-notch</em> (scaler 1.0) size initial-contents (initial-element 0.0) max-size
+<em class=def id="notch">notch</em> cflt input (pm 0.0)
+<em class=def id="notch?">notch?</em> cflt
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">comb, filtered-comb, and notch methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">length of delay</td></tr>
+<tr><td class="inner"><em class=gen>mus-order</em></td><td class="inner">same as mus-length</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">delay line itself (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-feedback</em></td><td class="inner">scaler (comb only)</td></tr>
+<tr><td class="inner"><em class=gen>mus-feedforward</em></td><td class="inner">scaler (notch only)</td></tr>
+<tr><td class="inner"><em class=gen>mus-interp-type</em></td><td class="inner">interpolation choice (no set!)</td></tr>
+</table>
+
+<p>The comb generator is a delay line with a scaler on the feedback. notch
+is a delay line with a scaler on the current input.
+filtered-comb is a comb filter with a filter on the feedback.
+Although normally this is a <a href="#one-zero">one-zero</a> filter, it can be any CLM generator.
+The make-<gen> "size" argument sets the length
+in samples of the delay line,
+and the other arguments are also handled as in <a href="#delay">delay</a>.
+</p>
+
+<pre class="indented">
+comb: y(n) = x(n - size) + scaler * y(n - size)
+notch: y(n) = x(n) * scaler + x(n - size)
+filtered-comb: y(n) = x(n - size) + scaler * filter(y(n - size))
+</pre>
+
+<img class="indented" src="pix/comb.png" alt="sonogram of comb">
+
+<!-- 1024 blackman2 dB jet light=1 data-cutoff around .009 invert off using the local zc (not clm-ins!): (with-sound (:srate 44100) (zc 0 2 2000 .1 100 1000 .99))
+-->
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((cmb (make-comb 0.4 (seconds->samples 0.4)))
(osc (make-oscil 440.0))
(ampf (make-env '(0 0 1 1 2 1 3 0) :length 4410)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 88200))
(outa i (* 0.5 (comb cmb (* (env ampf) (oscil osc))))))))
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
cmb = make_comb(0.4, seconds2samples(0.4));
osc = make_oscil(440.0);
@@ -6280,12 +6034,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
0.4 0.4 seconds->samples make-comb { cmb }
440.0 make-oscil { osc }
@@ -6299,57 +6055,20 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>The comb generator is a delay line with a scaler on the feedback. notch
-is a delay line with a scaler on the current input.
-filtered-comb is a comb filter with a filter on the feedback.
-Although normally this is a <a href="#one-zero">one-zero</a> filter, it can be any CLM generator.
-The make-<gen> "size" argument sets the length
-in samples of the delay line,
-and the other arguments are also handled as in <a href="#delay">delay</a>.
-</p>
-
-<table border=0><tr><td>
-<table border=1 hspace=40 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>comb, filtered-comb, and notch methods</center></td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>length of delay</td></tr>
-<tr><td><em class=gen>mus-order</em></td><td>same as mus-length</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>delay line itself (no set!)</td></tr>
-<tr><td><em class=gen>mus-feedback</em></td><td>scaler (comb only)</td></tr>
-<tr><td><em class=gen>mus-feedforward</em></td><td>scaler (notch only)</td></tr>
-<tr><td><em class=gen>mus-interp-type</em></td><td>interpolation choice (no set!)</td></tr>
-</table>
-</td>
-<td>
-
-
-<pre>
- comb: y(n) = x(n - size) + scaler * y(n - size)
- notch: y(n) = x(n) * scaler + x(n - size)
- filtered-comb: y(n) = x(n - size) + scaler * filter(y(n - size))
-</pre>
-
-<img src="pix/comb.png" alt="sonogram of comb" vspace=10>
-
-<!-- 1024 blackman2 dB jet light=1 data-cutoff around .009 invert off using the local zc (not clm-ins!): (with-sound (:srate 44100) (zc 0 2 2000 .1 100 1000 .99))
--->
-
-</td></tr></table>
-
-
<p>As a rule of thumb, the decay time of the feedback is
7.0 * size / (1.0 - scaler) samples, so to get a decay of feedback-dur seconds,
</p>
-<pre>
- (make-comb :size size :scaler (- 1.0 (/ (* 7.0 size) (* feedback-dur (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>)))))
+<pre class="indented">
+ (make-comb :size size :scaler (- 1.0 (/ (* 7.0 size) (* feedback-dur *clm-srate*))))
</pre>
<p>The peak gain is 1.0 / (1.0 - (abs scaler)). The peaks (or valleys in notch's case) are evenly spaced
-at (<a class=quiet href="#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) / size. The height (or depth) thereof is determined by scaler —
+at *clm-srate* / size. The height (or depth) thereof is determined by scaler —
the closer to 1.0 it is, the more pronounced the dips or peaks.
See Julius Smith's "An Introduction to Digital Filter Theory" in
Strawn "Digital Audio Signal Processing", or Smith's "Music Applications of
@@ -6357,120 +6076,137 @@ Digital Waveguides".
The following instrument sweeps the comb filter using the pm argument:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (zc time dur freq amp length1 length2 feedback)
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> time))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (s (<a class=quiet href="#make-pulse-train" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_pulse_train_tip)">make-pulse-train</a> :frequency freq)) ; some raspy input so we can hear the effect easily
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (zc time dur freq amp length1 length2 feedback)
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> time))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
+ (s (<a class=quiet href="#make-pulse-train">make-pulse-train</a> :frequency freq)) ; some raspy input so we can hear the effect easily
(d0 (<em class=red>make-comb</em> :size length1 :max-size (max length1 length2) :scaler feedback))
- (aenv (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 .1 1 .9 1 1 0) :scaler amp :duration dur))
- (zenv (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :scaler (- length2 length1) :base 12.0 :duration dur)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i))) ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> aenv) (<em class=red>comb</em> d0 (<a class=quiet href="#pulse-train" onmouseout="UnTip()" onmouseover="Tip(sndclm_pulse_train_tip)">pulse-train</a> s) (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> zenv))))))))
+ (aenv (<a class=quiet href="#make-env">make-env</a> '(0 0 .1 1 .9 1 1 0) :scaler amp :duration dur))
+ (zenv (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1) :scaler (- length2 length1) :base 12.0 :duration dur)))
+ (do ((i beg (+ i 1))) ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> aenv) (<em class=red>comb</em> d0 (<a class=quiet href="#pulse-train">pulse-train</a> s) (<a class=quiet href="#env">env</a> zenv)))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(zc 0 3 100 .1 20 100 .5)
(zc 3.5 3 100 .1 90 100 .95))
-</pre></td></tr></table>
+</pre>
+
+<p>Nearly every actual use of comb filters involves a bank of them, a vector of combs
+summed in parallel. The comb-bank generator is intended for this kind of application.
+make-comb-bank takes a vector of combs and returns the comb-bank generator which can
+be called via comb-bank.
+</p>
+
+<pre class="indented">
+(let ((sum 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i n) sum)
+ (set! sum (+ sum (comb (combs i) x)))))
+</pre>
+
+<p>can be replaced with:
+</p>
+
+<pre class="indented">
+(let ((cb (make-comb-bank combs)))
+ ...
+ (comb-bank cb x))
+</pre>
+
<p>The comb filter can produce some nice effects; here's one that treats the comb filter's
delay line as the coefficients for an FIR filter:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (fir+comb beg dur freq amp size)
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+ (let* ((start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(dly (<em class=red>make-comb</em> :scaler .9 :size size))
- (flt (<a class=quiet href="#make-fir-filter" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_fir_filter_tip)">make-fir-filter</a> :order size :xcoeffs (<em class=red>mus-data</em> dly))) ; comb delay line as FIR coeffs
- (r (<a class=quiet href="#make-rand" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_tip)">make-rand</a> freq))) ; feed comb with white noise
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<a class=quiet href="#fir-filter" onmouseout="UnTip()" onmouseover="Tip(sndclm_fir_filter_tip)">fir-filter</a> flt (<em class=red>comb</em> dly (<a class=quiet href="#rand" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_tip)">rand</a> r)))))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+ (flt (<a class=quiet href="#make-fir-filter">make-fir-filter</a> :order size :xcoeffs (<em class=red>mus-data</em> dly))) ; comb delay line as FIR coeffs
+ (r (<a class=quiet href="#make-rand">make-rand</a> freq))) ; feed comb with white noise
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<a class=quiet href="#fir-filter">fir-filter</a> flt (<em class=red>comb</em> dly (<a class=quiet href="#rand">rand</a> r))))))))
+
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(fir+comb 0 2 10000 .001 200)
(fir+comb 2 2 1000 .0005 400)
(fir+comb 4 2 3000 .001 300)
(fir+comb 6 2 3000 .0005 1000))
-</pre></td></tr></table>
+</pre>
-<p>Here's another that fluctuates between two sets of combs; it usually works best with voice sounds:
+<p>Here's another that fluctuates between two sets of combs; it usually works best with voice sounds. We use comb-bank generators:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (flux start-time file frequency combs0 combs1 (scaler 0.99) (comb-len 32))
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start-time))
- (len (<a class=quiet href="extsnd.html#mussoundframes" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundframes_tip)">mus-sound-frames</a> file))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (flux start-time file frequency combs0 combs1 (scaler 0.99) (comb-len 32))
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start-time))
+ (len (<a class=quiet href="extsnd.html#mussoundframples">mus-sound-framples</a> file))
(end (+ beg len))
(num-combs0 (length combs0))
(num-combs1 (length combs1))
(cmbs0 (make-vector num-combs0))
(cmbs1 (make-vector num-combs1))
- (osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frequency))
- (rd (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> file)))
- (do ((k 0 (+ 1 k)))
+ (osc (<a class=quiet href="#make-oscil">make-oscil</a> frequency))
+ (rd (<a class=quiet href="#make-readin">make-readin</a> file)))
+ (do ((k 0 (+ k 1)))
((= k num-combs0))
(set! (cmbs0 k)
(<em class=red>make-comb</em> scaler
- (floor (* comb-len (list-ref combs0 k))))))
- (do ((k 0 (+ 1 k)))
+ (floor (* comb-len (combs0 k))))))
+ (do ((k 0 (+ k 1)))
((= k num-combs1))
(set! (cmbs1 k)
(<em class=red>make-comb</em> scaler
- (floor (* comb-len (list-ref combs1 k))))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (let* ((interp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc))
- (sum0 0.0)
- (sum1 0.0)
- (x (<a class=quiet href="#readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_readin_tip)">readin</a> rd)))
- (do ((k 0 (+ 1 k)))
- ((= k num-combs0))
- (set! sum0 (+ sum0 (<em class=red>comb</em> (cmbs0 k) x))))
- (do ((k 0 (+ 1 k)))
- ((= k num-combs1))
- (set! sum1 (+ sum1 (<em class=red>comb</em> (cmbs1 k) x))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (+ (* interp sum0) (* (- 1.0 interp) sum1))))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:scaled-to .5)
+ (floor (* comb-len (combs1 k))))))
+ (let ((nc0 (<em class=red>make-comb-bank</em> cmbs0))
+ (nc1 (<em class=red>make-comb-bank</em> cmbs1)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((interp (<a class=quiet href="#oscil">oscil</a> osc))
+ (x (<a class=quiet href="#readin">readin</a> rd)))
+ (<a class=quiet href="#outa">outa</a> i (+ (* interp (<em class=red>comb-bank</em> nc0 x))
+ (* (- 1.0 interp) (<em class=red>comb-bank</em> nc1 x)))))))))
+
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:scaled-to .5)
(flux 0 "oboe.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6)) ; bowed oboe?
(flux 2 "now.snd" 4.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0))
(flux 4 "now.snd" 1.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.995 20)
(flux 6 "now.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.99 10)
(flux 8 "now.snd" 10.0 '(2.0) '(1.0 1.333 1.6 2.0 3.0) 0.99 120)
(flux 10 "fyow.snd" .50 '(1.0 2.0 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.99 120))
-</pre></td></tr></table>
-
+</pre>
<p>For more comb filter examples,
see examp.scm, <a href="sndscm.html#chordalize">chordalize</a> in dsp.scm, or
-any of the standard reverbs such as <a href="sndscm.html#nrev">nrev</a>.
-filtered-comb is used in <a href="sndscm.html#freeverb">freeverb</a>
+any of the standard reverbs such as <a href="sndscm.html#nrev">nrev</a>.
+</p>
+
+<br>
+<p>filtered-comb is used in <a href="sndscm.html#freeverb">freeverb</a>
where a <a href="#one-zero">one-zero</a> filter is placed
in the feedback loop:
</p>
-<pre>
- (make-filtered-comb :size len :scaler room-decay-val :filter (make-one-zero :a0 (- 1.0 dmp) :a1 dmp))
+
+<pre class="indented">
+(make-filtered-comb :size len :scaler room-decay-val :filter (make-one-zero :a0 (- 1.0 dmp) :a1 dmp))
</pre>
-<br><br>
+<p>As with the normal comb filter, the filtered-comb-bank generator sums a vector of filtered-comb
+generators in parallel.
+</p>
-<A NAME="all-passdoc"></A>
-<!-- ---------------------------------------- ALL-PASS ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>all-pass</h3></center></td></tr></table>
+<!-- ALL-PASS -->
-<pre>
- <a class=def name="make-all-pass">make-all-pass</a>
+<div class="innerheader" id="all-passdoc">all-pass</div>
+
+<pre class="indented">
+<em class=def id="make-all-pass">make-all-pass</em>
(feedback 0.0)
(feedforward 0.0)
size
@@ -6478,29 +6214,58 @@ in the feedback loop:
(initial-element 0.0)
max-size
- <a class=def name="all-pass">all-pass</a> f input (pm 0.0)
- <a class=def name="all-pass?">all-pass?</a> f
+<em class=def id="all-pass">all-pass</em> f input (pm 0.0)
+<em class=def id="all-pass?">all-pass?</em> f
+
+<em class=def id="allpassbank">all-pass-bank</em> all-passes input
+<em class=def id="allpassbankp">all-pass-bank?</em> object
+<em class=def id="makeallpassbank">make-all-pass-bank</em> all-passes
+
+<em class=def id="make-one-pole-all-pass">make-one-pole-all-pass</em> size coeff
+<em class=def id="one-pole-all-pass">one-pole-all-pass</em> f input
+<em class=def id="one-pole-all-pass?">one-pole-all-pass?</em> f
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">all-pass methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">length of delay</td></tr>
+<tr><td class="inner"><em class=gen>mus-order</em></td><td class="inner">same as mus-length</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">delay line itself (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-feedback</em></td><td class="inner">feedback scaler</td></tr>
+<tr><td class="inner"><em class=gen>mus-feedforward</em></td><td class="inner">feedforward scaler</td></tr>
+<tr><td class="inner"><em class=gen>mus-interp-type</em></td><td class="inner">interpolation choice (no set!)</td></tr>
+</table>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=12 cellpadding=5>
+<p>The all-pass or moving average comb generator is just like <a href="#comb">comb</a> but with
+an added scaler on the input ("feedforward" is Julius Smith's suggested name for it). If feedforward is 0.0, we get a
+comb filter. If both scale terms are 0.0, we get a pure delay line.
+</p>
+<pre class="indented">
+y(n) = feedforward * x(n) + x(n - size) + feedback * y(n - size)
+</pre>
+
+
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((alp (make-all-pass -0.4 0.4 (seconds->samples 0.4)))
(osc (make-oscil 440.0))
(ampf (make-env '(0 0 1 1 2 1 3 0) :length 4410)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 88200))
(outa i (* 0.5 (all-pass alp (* (env ampf) (oscil osc))))))))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
alp = make_all_pass(-0.4, 0.4, seconds2samples(0.4));
osc = make_oscil(440.0);
@@ -6510,12 +6275,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
-0.4 0.4 0.4 seconds->samples make-all-pass { alp }
440.0 make-oscil { osc }
@@ -6529,32 +6296,13 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<p>The all-pass or moving average comb generator is just like <a href="#comb">comb</a> but with
-an added scaler on the input ("feedforward" is Julius Smith's suggested name for it). If feedforward is 0.0, we get a
-comb filter. If both scale terms are 0.0, we get a pure delay line.
-</p>
-
-<table border=1 align=left hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>all-pass methods</center></td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>length of delay</td></tr>
-<tr><td><em class=gen>mus-order</em></td><td>same as mus-length</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>delay line itself (no set!)</td></tr>
-<tr><td><em class=gen>mus-feedback</em></td><td>feedback scaler</td></tr>
-<tr><td><em class=gen>mus-feedforward</em></td><td>feedforward scaler</td></tr>
-<tr><td><em class=gen>mus-interp-type</em></td><td>interpolation choice (no set!)</td></tr>
-</table>
-<br>
-
-<pre>
- y(n) = feedforward * x(n) + x(n - size) + feedback * y(n - size)
-</pre><br clear=left>
-
<p>all-pass filters are used extensively in reverberation;
see <a href="sndscm.html#jcrevdoc">jcrev</a> or <a href="sndscm.html#nrev">nrev</a>.
To get the "all-pass" behavior, set feedback equal to -feedforward. Here's an example
@@ -6562,9 +6310,7 @@ To get the "all-pass" behavior, set feedback equal to -feedforward. Here's an ex
old analog tapes — the reverb slightly precedes the direct signal:
</p>
-<table border=0 hspace=40>
-<tr><td>
-<pre>
+<pre class="indented">
(define (later file dly rev)
(let* ((allpass1 (<em class=red>make-all-pass</em> -0.700 0.700 1051))
(allpass2 (<em class=red>make-all-pass</em> -0.700 0.700 337))
@@ -6573,77 +6319,124 @@ old analog tapes — the reverb slightly precedes the direct signal:
(comb2 (make-comb 0.733 4999))
(comb3 (make-comb 0.715 5399))
(comb4 (make-comb 0.697 5801))
- (file-dur (mus-sound-frames file))
- (decay-dur (mus-srate))
+ (file-dur (mus-sound-framples file))
+ (decay-dur *clm-srate*)
(len (floor (+ decay-dur file-dur)))
(rd (make-readin file)) ; the direct signal (via sound-let below)
(d (make-delay dly)) ; this delays the direct signal
(backup (min 4799 dly)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let* ((inval (readin rd))
- (allpass-sum (<em class=red>all-pass</em> allpass3
- (<em class=red>all-pass</em> allpass2
- (<em class=red>all-pass</em> allpass1
- (* rev inval)))))
- (comb-sum
- (+ (comb comb1 allpass-sum)
- (comb comb2 allpass-sum)
- (comb comb3 allpass-sum)
- (comb comb4 allpass-sum)))
- (orig (delay d inval)))
- (if (>= i backup)
- (outa (- i backup) (+ comb-sum orig))))))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let* ((inval (readin rd))
+ (allpass-sum (<em class=red>all-pass</em> allpass3
+ (<em class=red>all-pass</em> allpass2
+ (<em class=red>all-pass</em> allpass1
+ (* rev inval)))))
+ (comb-sum
+ (+ (comb comb1 allpass-sum)
+ (comb comb2 allpass-sum)
+ (comb comb3 allpass-sum)
+ (comb comb4 allpass-sum)))
+ (orig (delay d inval)))
+ (if (>= i backup)
+ (outa (- i backup) (+ comb-sum orig)))))))
(with-sound ()
(sound-let ((tmp () (fm-violin 0 .1 440 .1)))
(later tmp 10000 .1)))
</pre>
-</td>
-</tr>
-</table>
-<br><br>
+<p>In all such applications, the all-pass filters are connected in series (each one's output is the
+input to the next in the set). To package this up in one generator, use an all-pass-bank. An
+all-pass-bank is slightly different from the other "bank" generators in that it connects the
+vector of all-passes in series, rather than summing them in parallel.
+Code of the form:
+</p>
+<pre class="indented">
+(all-pass a1 (all-pass a2 input))
+</pre>
+<p>can be replaced with:
+</p>
+<pre class="indented">
+(let ((ab (make-all-pass-bank (vector a1 a2))))
+ (all-pass-bank ab input))
+</pre>
-<A NAME="moving-averagedoc"></A>
-<!-- ---------------------------------------- MOVING-AVERAGE ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>moving-average</h3></center></td></tr></table>
+<p>one-pole-all-pass is used by piano.scm:
+</p>
-<pre>
- <a class=def name="make-moving-average">make-moving-average</a> size initial-contents (initial-element 0.0)
- <a class=def name="moving-average">moving-average</a> f input
- <a class=def name="moving-average?">moving-average?</a> f
+<pre class="indented">
+y(n) = x(n) + coeff * (y(n-1) - y(n))
+x(n) = y(n-1)
+</pre>
+
+<p>This is repeated "size" times, with the generator input as the first y(n-1) value.
+</p>
+
+
+
+
+<!-- MOVING-AVERAGE. MOVING-MAX. MOVING-NORM. -->
+
+<div class="innerheader" id="moving-averagedoc">moving-average, moving-max, moving-norm</div>
+
+<pre class="indented">
+<em class=def id="make-moving-average">make-moving-average</em> size initial-contents (initial-element 0.0)
+<em class=def id="moving-average">moving-average</em> f input
+<em class=def id="moving-average?">moving-average?</em> f
+
+<em class=def id="make-moving-max">make-moving-max</em> size initial-contents (initial-element 0.0)
+<em class=def id="moving-max">moving-max</em> f input
+<em class=def id="moving-max?">moving-max?</em> f
+
+<em class=def id="make-moving-norm">make-moving-norm</em> size (scaler 1.0)
+<em class=def id="moving-norm">moving-norm</em> f input
+<em class=def id="moving-norm?">moving-norm?</em> f
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">moving-average methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">length of table</td></tr>
+<tr><td class="inner"><em class=gen>mus-order</em></td><td class="inner">same as mus-length</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">table of last 'size' values</td></tr>
+</table>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<p>The moving-average or moving window average generator returns the average of the last "size" values input to it.
+</p>
+
+<pre class="indented">
+result = sum-of-last-n-inputs / n
+</pre>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((avg (make-moving-average 4410))
(osc (make-oscil 440.0))
(stop (- 44100 4410)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i stop))
(let ((val (oscil osc)))
(outa i (* val (moving-average avg (abs val))))))
- (do ((i stop (+ 1 i)))
+ (do ((i stop (+ i 1)))
((= i 44100))
(outa i (* (oscil osc) (moving-average avg 0.0))))))
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
avg = make_moving_average(4410);
osc = make_oscil(440.0);
@@ -6656,12 +6449,14 @@ with_sound(:play, true) do
outa(stop + i, oscil(osc) * moving_average(avg, 0.0), $output);
end
end.output</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
4410 make-moving-average { avg }
440.0 make-oscil { osc }
@@ -6676,28 +6471,11 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-
-<p>The moving-average or moving window average generator returns the average of the last "size" values input to it.
-</p>
-
-<table align=left border=1 hspace=40 vspace=10 cellpadding=4>
-<tr><td colspan=2 bgcolor="beige"><center>moving-average methods</center></td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>length of table</td></tr>
-<tr><td><em class=gen>mus-order</em></td><td>same as mus-length</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>table of last 'size' values</td></tr>
-</table>
-<br>
-
-<pre>
-result = sum-of-last-n-inputs / n
-</pre>
-<br clear=left>
-
<p>
moving-average is used both to track rms values and to generate ramps between 0 and 1 in a "gate"
effect in new-effects.scm and in rms-envelope in env.scm. It can also be viewed as a low-pass filter.
@@ -6708,66 +6486,102 @@ throwing away any samples below a threshhold, and ramping between portions
that are squelched and those that are unchanged (to avoid clicks):
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (squelch-channel amount snd chn gate-size) ; gate-size = ramp length and rms window length
(let ((gate (<em class=red>make-moving-average</em> gate-size))
(ramp (<em class=red>make-moving-average</em> gate-size :initial-element 1.0)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y)
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y)
(* y (<em class=red>moving-average</em> ramp ; ramp between 0 and 1
(if (< (<em class=red>moving-average</em> gate (* y y)) amount) ; local (r)ms value
0.0 ; below "amount" so squelch
1.0))))
0 #f snd chn)))
</pre>
-</td></tr></table>
-<p>See also generators.scm for several related functions:
-<a href="#moving-max">moving-max</a>,
+<p>
+moving-max is a specialization
+of the <a href="#delay">delay</a> generator; it produces an envelope that tracks the peak amplitude of the last 'n' samples.
+<code>(make-moving-max 256)</code> returns the generator (this one's window size is 256),
+and <code>(moving-max gen y)</code> then returns the envelope traced out by the signal 'y'.
+The <a href="sndscm.html#harmonicizer">harmonicizer</a> uses this generator to normalize an in-coming signal to 1.0
+so that the Chebyshev polynomials it is driving will produce a full spectrum at all times.
+Here is a similar, but simpler, example; we use the moving-max generator to track the
+current peak amplitude over a small window, use that value to drive a <a href="#contrast-enhancement">contrast-enhancement</a>
+generator (so that its output is always fully modulated), and rescale by the same value
+upon output (to track the original sound's amplitude envelope):
+</p>
+
+<pre class="indented">
+(define (intensify index)
+ (let ((mx (<em class=red>make-moving-max</em>))
+ (flt (<a class=quiet href="sndscm.html#makelowpass">make-lowpass</a> (* pi .1) 8))) ; smooth the maxamp signal
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y)
+ (let ((amp (max .1 (<a class=quiet href="#fir-filter">fir-filter</a> flt (<em class=red>moving-max</em> mx y)))))
+ (* amp (<a class=quiet href="#contrast-enhancement">contrast-enhancement</a> (/ y amp) index)))))))
+</pre>
+
+<p>moving-norm specializes moving-max to provide automatic gain control. It is essentially a one-pole (low-pass)
+filter on the output of moving-max, inverted and multiplied by a scaler. <code>(* input-signal (moving-norm g input-signal))</code>
+is the normal usage.
+</p>
+
+<p>
+See generators.scm for several related functions:
<a href="#moving-rms">moving-rms</a>, <a href="#moving-sum">moving-sum</a>,
<a href="#moving-length">moving-length</a>, <a href="#weighted-moving-average">weighted-moving-average</a>, and
<a href="#exponentially-weighted-moving-average">exponentially-weighted-moving-average</a>
(the latter being just a one-pole filter).
</p>
-<br><br>
-<A NAME="srcdoc"></A>
-<!-- ---------------------------------------- SRC ---------------------------------------- -->
+<!-- SRC -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>src</h3></center></td></tr></table>
+<div class="innerheader" id="srcdoc">src</div>
-<pre>
- <a class=def name="make-src">make-src</a> input (srate 1.0) (width 5)
- <a class=def name="src">src</a> s (sr-change 0.0) input-function
- <a class=def name="src?">src?</a> s
+<pre class="indented">
+<em class=def id="make-src">make-src</em> input (srate 1.0) (width 5)
+<em class=def id="src">src</em> s (sr-change 0.0)
+<em class=def id="src?">src?</em> s
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">src methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">srate arg to make-src</td></tr>
+</table>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<p>The src generator performs sampling rate conversion
+by convolving its input with a sinc
+function.
+make-src's "srate" argument is the
+ratio between the old sampling rate and the new; an srate of 2 causes the sound to be half as long, transposed up an octave.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t :srate 22050)
(let* ((rd (make-readin "oboe.snd"))
- (len (* 2 (mus-sound-frames "oboe.snd")))
+ (len (* 2 (mus-sound-framples "oboe.snd")))
(sr (make-src rd 0.5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
(outa i (src sr)))))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true, :srate, 22050) do
rd = make_readin("oboe.snd");
- len = 2 * mus_sound_frames("oboe.snd");
+ len = 2 * mus_sound_framples("oboe.snd");
sr = make_src(lambda do |dir|
readin(rd) end, 0.5);
len.times do |i|
@@ -6775,89 +6589,25 @@ with_sound(:play, true, :srate, 22050) do
end
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
"oboe.snd" make-readin { rd }
rd 0.5 make-src { sr }
- "oboe.snd" mus-sound-frames 2* ( len ) 0 do
+ "oboe.snd" mus-sound-framples 2* ( len ) 0 do
i sr 0 #f src *output* outa drop
loop
; :play #t :srate 22050 with-sound drop
</pre>
-</td>
-
-</tr>
-<tr>
-
-<td bgcolor="#f0f4ff">
-<pre>
-(with-sound (:play #t)
- (let ((osc (make-oscil 440.0))
- (sr (make-src :srate 2.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 44100))
- (outa i (src sr 0.0 (lambda (dir) (oscil osc)))))))
-</pre>
+</div>
</td>
</tr>
-<tr>
-
-<td bgcolor="#fbfbf0">
-<pre>
-with_sound(:play, true) do
- osc = make_oscil(440.0);
- sr = make_src(:srate, 2.0);
- 44100.times do |i|
- outa(i, src(sr, 0.0, lambda do |dir|
- oscil(osc)
- end),
- $output);
- end
- end.output
-</pre>
-</td>
-</tr>
-<tr>
-
-<td bgcolor="#effdef">
-<pre>
-: make-src-proc { osc -- prc; dir self -- val }
- 1 proc-create osc , ( prc )
- does> { dir self -- val }
- self @ ( osc ) 0 0 oscil
-;
-
-lambda: ( -- )
- 440.0 make-oscil { osc }
- osc make-src-proc { prc }
- :srate 2.0 make-src { sr }
- 44100 0 do
- i sr 0 prc src *output* outa drop
- loop
-; :play #t with-sound drop
-</pre>
-</td>
-
-</tr>
-</table>
-
-
-
-<p>The src generator performs sampling rate conversion
-by convolving its input with a sinc
-function.
-make-src's "srate" argument is the
-ratio between the old sampling rate and the new; an srate of 2 causes the sound to be half as long, transposed up an octave.
-</p>
-
-<table border=1 cellpadding=4 hspace=40 vspace=10>
-<tr><td colspan=2 bgcolor="beige"><center>src methods</center></td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>srate arg to make-src</td></tr>
</table>
@@ -6877,44 +6627,38 @@ Here's
an instrument that provides time-varying sampling rate conversion:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (simple-src start-time duration amp srt srt-env filename)
- (let* ((senv (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> srt-env :duration duration))
- (beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start-time))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> duration)))
- (src-gen (<em class=red>make-src</em> :input (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> filename) :srate srt)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<em class=red>src</em> src-gen (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> senv))))))))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (simple-src start-time duration amp srt srt-env filename)
+ (let* ((senv (<a class=quiet href="#make-env">make-env</a> srt-env :duration duration))
+ (beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start-time))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> duration)))
+ (src-gen (<em class=red>make-src</em> :input (<a class=quiet href="#make-readin">make-readin</a> filename) :srate srt)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<em class=red>src</em> src-gen (<a class=quiet href="#env">env</a> senv)))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (simple-src 0 4 1.0 0.5 '(0 1 1 2) "oboe.snd"))
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (simple-src 0 4 1.0 0.5 '(0 1 1 2) "oboe.snd"))
</pre>
-</td></tr></table>
-<p>src can provide an all-purpose "Forbidden Planet" sound effect:</p>
+<p id="srcer">src can provide an all-purpose "Forbidden Planet" sound effect:</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (<A NAME="srcer">srcer</A> start-time duration amp srt fmamp fmfreq filename)
- (let* ((os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> fmfreq))
- (beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start-time))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> duration)))
- (src-gen (<em class=red>make-src</em> :input (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> filename) :srate srt)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<em class=red>src</em> src-gen (* fmamp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os)))))))))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (srcer start-time duration amp srt fmamp fmfreq filename)
+ (let* ((os (<a class=quiet href="#make-oscil">make-oscil</a> fmfreq))
+ (beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start-time))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> duration)))
+ (src-gen (<em class=red>make-src</em> :input (<a class=quiet href="#make-readin">make-readin</a> filename) :srate srt)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* amp (<em class=red>src</em> src-gen (* fmamp (<a class=quiet href="#oscil">oscil</a> os))))))))
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (srcer 0 2 1.0 1 .3 20 "fyow.snd"))
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (srcer 0 25 10.0 .01 1 10 "fyow.snd"))
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (srcer 0 2 1.0 .9 .05 60 "oboe.snd"))
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (srcer 0 2 1.0 1.0 .5 124 "oboe.snd"))
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (srcer 0 2 10.0 .01 .2 8 "oboe.snd"))
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (srcer 0 2 1.0 1 3 20 "oboe.snd"))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (srcer 0 2 1.0 1 .3 20 "fyow.snd"))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (srcer 0 25 10.0 .01 1 10 "fyow.snd"))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (srcer 0 2 1.0 .9 .05 60 "oboe.snd"))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (srcer 0 2 1.0 1.0 .5 124 "oboe.snd"))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (srcer 0 2 10.0 .01 .2 8 "oboe.snd"))
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (srcer 0 2 1.0 1 3 20 "oboe.snd"))
</pre>
-</td></tr></table>
<p>The "input" argument to make-src and the "input-function" argument
to src provide the generator with input as it is needed.
@@ -6923,8 +6667,7 @@ is a function of one argument (the desired read direction, if the reader can sup
sample of input. Here's an example instrument that reads a file with an envelope on the src:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(definstrument (src-change filename start-time duration file-start srcenv)
(let* ((beg (seconds->samples start-time))
(end (+ beg (seconds->samples duration)))
@@ -6932,17 +6675,15 @@ sample of input. Here's an example instrument that reads a file with an envelope
(src-gen (make-src :srate 0.0))
(e (make-env srcenv :duration duration))
(inp (make-file->sample filename)))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (outa i (src src-gen (env e)
- (<em class=red>lambda (dir)</em> ; our input function
- (set! loc (+ loc dir))
- (ina loc inp))))))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (src src-gen (env e)
+ (<em class=red>lambda (dir)</em> ; our input function
+ (set! loc (+ loc dir))
+ (ina loc inp)))))))
;;; (with-sound () (src-change "pistol.snd" 0 2 0 '(0 0.5 1 -1.5)))
</pre>
-</td></tr></table>
<p>
If you jump around in the input (via mus-location for example), use
@@ -6959,44 +6700,53 @@ a time-varying src is applied, use <a href="sndscm.html#srcduration">src-duratio
envelope so that the result has a given duration, use <a href="sndscm.html#srcfitenvelope">scr-fit-envelope</a>.
</p>
-<br><br>
-<A NAME="convolvedoc"></A>
-<!-- ---------------------------------------- CONVOLVE ---------------------------------------- -->
+<!-- CONVOLVE -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>convolve</h3></center></td></tr></table>
+<div class="innerheader" id="convolvedoc">convolve</div>
-<pre>
- <a class=def name="make-convolve">make-convolve</a> input filter fft-size filter-size
- <a class=def name="convolve">convolve</a> ff input-function
- <a class=def name="convolve?">convolve?</a> ff
+<pre class="indented">
+<em class=def id="make-convolve">make-convolve</em> input filter fft-size filter-size
+<em class=def id="convolve">convolve</em> gen
+<em class=def id="convolve?">convolve?</em> gen
- <a class=def name="convolvefiles">convolve-files</a> file1 file2 (maxamp 1.0) (output-file "tmp.snd")
+<em class=def id="convolvefiles">convolve-files</em> file1 file2 (maxamp 1.0) (output-file "tmp.snd")
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">convolve methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">fft size used in the convolution</td></tr>
+</table>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<p>The convolve generator convolves its input with the impulse response "filter" (a float-vector).
+"input" is a function of one argument that is
+called whenever convolve needs input.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t :statistics #t)
(let ((cnv (make-convolve
(make-readin "pistol.snd")
- (file->vct "oboe.snd")))) ; file->vct is in examp.scm
- (do ((i 0 (+ 1 i)))
+ (file->float-vector "oboe.snd" 0 (make-float-vector (framples "pistol.snd"))))))
+ (do ((i 0 (+ i 1)))
((= i 88200))
(outa i (* 0.25 (convolve cnv))))))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true, :statistics, true) do
rd = make_readin("oboe.snd");
flt = file2vct("pistol.snd"); # examp.rb
@@ -7006,12 +6756,14 @@ with_sound(:play, true, :statistics, true) do
end
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
"pistol.snd" make-readin ( rd )
"oboe.snd" file->vct ( v ) make-convolve { cnv }
@@ -7020,35 +6772,40 @@ lambda: ( -- )
loop
; :play #t :statistics #t with-sound drop
</pre>
+</div>
</td>
-
</tr>
+</table>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let* ((tempfile (convolve-files "oboe.snd"
"pistol.snd" 0.5
"convolved.snd"))
- (len (mus-sound-frames tempfile))
+ (len (mus-sound-framples tempfile))
(reader (make-readin tempfile)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
(outa i (readin reader)))
(delete-file tempfile)))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
tempfile = convolve_files("oboe.snd",
"pistol.snd", 0.5,
"convolved.snd");
- len = mus_sound_frames(tempfile);
+ len = mus_sound_framples(tempfile);
reader = make_readin(tempfile);
len.times do |i|
outa(i, readin(reader), $output);
@@ -7056,99 +6813,80 @@ with_sound(:play, true) do
File.unlink(tempfile)
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
"oboe.snd" "pistol.snd" 0.5 "convolved.snd" convolve-files { tempfile }
tempfile make-readin { reader }
- tempfile mus-sound-frames ( len ) 0 do
+ tempfile mus-sound-framples ( len ) 0 do
i reader readin *output* outa drop
- loop
- tempfile file-delete
-; :play #t with-sound drop
-</pre>
-</td>
-
-</tr>
-</table>
-
-
-
-<p>The convolve generator convolves its input with the impulse response "filter" (a vct).
-"input" and "input-function" are functions of one argument that are
-called whenever convolve needs input.
-</p>
+ loop
+ tempfile file-delete
+; :play #t with-sound drop
+</pre>
+</div>
+</td>
-<table border=1 cellpadding=4 hspace=40 vspace=10>
-<tr><td colspan=2 bgcolor="beige"><center>convolve methods</center></td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>fft size used in the convolution</td></tr>
+</tr>
</table>
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (convins beg dur filter file (size 128))
+ (let* ((start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
+ (ff (<em class=red>make-convolve</em> :input (<a class=quiet href="#make-readin">make-readin</a> file) :fft-size size :filter filter)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>convolve</em> ff)))))
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (convins beg dur filter file (size 128))
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (ff (<em class=red>make-convolve</em> :input (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> file) :fft-size size :filter filter)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>convolve</em> ff))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (convins 0 2 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 1.0 0.5 0.25 0.125) "oboe.snd")) ; same as fir-filter with those coeffs
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (convins 0 2 (float-vector 1.0 0.5 0.25 0.125) "oboe.snd")) ; same as fir-filter with those coeffs
</pre>
-</td></tr></table>
<p>convolve-files handles a very common special case: convolve
two files, then normalize the result to some maxamp. The convolve generator does not
know in advance what its maxamp will be, and when the two files are more or less
-the same size, there's no real computational savings to using overlap-add (i.e.
+the same size, there's no real computational savings from using overlap-add (i.e.
the generator), so a one-time giant FFT saved as a temporary sound file is much
handier. If you're particular about the format of the convolved data:
</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define* (convolve-files->aifc file1 file2 (maxamp 1.0) (output-file "test.snd"))
(let ((outname (string-append "temp-" output-file)))
(<em class=red>convolve-files</em> file1 file2 maxamp outname)
- (with-sound (:header-type mus-aifc :data-format mus-bfloat)
+ (with-sound (:header-type mus-aifc :sample-type mus-bfloat)
(let ((len (seconds->samples (mus-sound-duration outname)))
(reader (make-readin outname)))
- (run
- (do ((i 0 (+ i 1)))
- ((= i len))
- (outa i (readin reader))))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (outa i (readin reader)))))
(delete-file outname)
output-file))
</pre>
-</td></tr></table>
-
<p>The convolve generator is the modern way to add reverb. There are impulse responses of various concert
halls floating around the web. convolve and <a href="#fir-filter">fir-filter</a> actually perform the same mathematical operation,
but convolve uses an FFT internally, rather than a laborious dot-product.
</p>
-<br><br>
-<A NAME="granulatedoc"></A>
-<!-- ---------------------------------------- GRANULATE ---------------------------------------- -->
+<!-- GRANULATE -->
-<!-- INDEX grains:Granular synthesis --><A class=def NAME="grains"></a>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>granulate</h3></center></td></tr></table>
+<!-- INDEX grains:Granular synthesis --><em class=def id="grains"></em>
-<pre>
- <a class=def name="make-granulate">make-granulate</a>
+<div class="innerheader" id="granulatedoc">granulate</div>
+
+<pre class="indented">
+<em class=def id="make-granulate">make-granulate</em>
input
(expansion 1.0) ; how much to lengthen or compress the file
(length .15) ; length of file slices that are overlapped
@@ -7159,28 +6897,53 @@ but convolve uses an FFT internally, rather than a laborious dot-product.
max-size ; internal buffer size
edit ; grain editing function
- <a class=def name="granulate">granulate</a> e input-function edit-function
- <a class=def name="granulate?">granulate?</a> e
+<em class=def id="granulate">granulate</em> e
+<em class=def id="granulate?">granulate?</em> e
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">granulate methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">time (seconds) between output grains (hop)</td></tr>
+<tr><td class="inner"><em class=gen>mus-ramp</em></td><td class="inner">length (samples) of grain envelope ramp segment</td></tr>
+<tr><td class="inner"><em class=gen>mus-hop</em></td><td class="inner">time (samples) between output grains (hop)</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">grain amp (scaler)</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">expansion</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">grain length (samples)</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">grain samples (a float-vector)</td></tr>
+<tr><td class="inner"><em class=gen>mus-location</em></td><td class="inner">granulate's local random number seed</td></tr>
+</table>
+
+<p>The granulate generator "granulates" its input (normally a sound file). It is the poor man's way
+to change the speed at which things happen in a recorded sound without
+changing the pitches. It works by slicing the input file into short
+pieces, then overlapping these slices to lengthen (or shorten) the
+result; this process is sometimes known as granular synthesis, and is
+similar to the freeze function.
+</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<pre class="indented">
+result = overlap add many tiny slices from input
+</pre>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((grn (make-granulate (make-readin "oboe.snd") 2.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (granulate grn)))))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
rd = make_readin("oboe.snd");
grn = make_granulate(lambda do |dir| readin(rd) end, 2.0);
@@ -7189,12 +6952,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
"oboe.snd" make-readin 2.0 make-granulate { grn }
44100 0 do
@@ -7202,12 +6967,16 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
+</table>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let* ((osc (make-oscil 440.0))
(sweep (make-env '(0 0 1 1)
@@ -7217,16 +6986,18 @@ lambda: ( -- )
(* 0.2 (oscil osc (env sweep))))
:expansion 2.0
:length .5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 88200))
(outa i (granulate grn)))))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
osc = make_oscil(440.0);
sweep = make_env([0.0, 0.0, 1.0, 1.0],
@@ -7240,12 +7011,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
: make-granulate-proc { osc sweep -- prc; dir self -- val }
1 proc-create osc , sweep , ( prc )
does> { dir self -- val }
@@ -7261,36 +7034,11 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>The granulate generator "granulates" its input (normally a sound file). It is the poor man's way
-to change the speed at which things happen in a recorded sound without
-changing the pitches. It works by slicing the input file into short
-pieces, then overlapping these slices to lengthen (or shorten) the
-result; this process is sometimes known as granular synthesis, and is
-similar to the freeze function.
-</p>
-
-<table align=left border=1 cellpadding=4 hspace=40 vspace=10>
-<tr><td colspan=2 bgcolor="beige"><center>granulate methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>time (seconds) between output grains (hop)</td></tr>
-<tr><td><em class=gen>mus-ramp</em></td><td>length (samples) of grain envelope ramp segment</td></tr>
-<tr><td><em class=gen>mus-hop</em></td><td>time (samples) between output grains (hop)</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>grain amp (scaler)</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>expansion</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>grain length (samples)</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>grain samples (a vct)</td></tr>
-<tr><td><em class=gen>mus-location</em></td><td>granulate's local random number seed</td></tr>
-</table>
-<br>
-<pre>
-result = overlap add many tiny slices from input
-</pre>
-<br clear=left>
-
<p>The duration of each slice is
"length" — the longer the slice, the more the effect resembles reverb. The
portion of the length (on a scale from 0 to 1.0) spent on each
@@ -7320,64 +7068,57 @@ close to the original tempo.
one argument that return a new input sample whenever they are called by granulate).
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (granulate-sound file beg dur (orig-beg 0.0) (exp-amt 1.0))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (granulate-sound file beg dur (orig-beg 0.0) (exp-amt 1.0))
(let* ((f-srate (srate file))
(f-start (round (* f-srate orig-beg)))
- (f (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> file :start f-start))
- (st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (new-dur (or dur (- (<a class=quiet href="extsnd.html#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> file) orig-beg)))
+ (f (<a class=quiet href="#make-readin">make-readin</a> file :start f-start))
+ (st (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (new-dur (or dur (- (<a class=quiet href="extsnd.html#mussoundduration">mus-sound-duration</a> file) orig-beg)))
(exA (<em class=red>make-granulate</em> :input f :expansion exp-amt))
- (nd (+ st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> new-dur))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i st (+ 1 i)))
- ((= i nd))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>granulate</em> exA))))))
+ (nd (+ st (<a class=quiet href="#secondstosamples">seconds->samples</a> new-dur))))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>granulate</em> exA)))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (granulate-sound "now.snd" 0 3.0 0 2.0))
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (granulate-sound "now.snd" 0 3.0 0 2.0))
</pre>
-</td></tr></table>
<p>See <a href="sndscm.html#expsrc">clm-expsrc</a> in clm-ins.scm. Here's an instrument that uses the input-function
argument to granulate. It cause the granulation to run backwards through the file:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (grev beg dur exp-amt file file-beg)
- (let* ((exA (<em class=red>make-granulate</em> :expansion exp-amt))
- (fil (<a class=quiet href="#make-filetosample" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_filetosample_tip)">make-file->sample</a> file))
- (ctr file-beg))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i (+ beg dur)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>granulate</em> exA
- (lambda (dir)
- (let ((inval (<a class=quiet href="#filetosample" onmouseout="UnTip()" onmouseover="Tip(sndclm_filetosample_tip)">file->sample</a> fil ctr 0)))
- (if (> ctr 0) (set! ctr (- ctr 1)))
- inval))))))))
-
-(<a class=quiet href="sndscm.html#withsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (grev 0 100000 2.0 "pistol.snd" 40000))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (grev beg dur exp-amt file file-beg)
+ (let ((exA (<em class=red>make-granulate</em> :expansion exp-amt))
+ (fil (<a class=quiet href="#make-filetosample">make-file->sample</a> file))
+ (ctr file-beg))
+ (do ((i beg (+ i 1)))
+ ((= i (+ beg dur)))
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>granulate</em> exA
+ (lambda (dir)
+ (let ((inval (<a class=quiet href="#filetosample">file->sample</a> fil ctr 0)))
+ (if (> ctr 0) (set! ctr (- ctr 1)))
+ inval)))))))
+
+(<a class=quiet href="sndscm.html#withsound">with-sound</a> () (grev 0 100000 2.0 "pistol.snd" 40000))
</pre>
-</td></tr></table>
<p>But it's unnecessary to write clever input functions. It is just as fast, and much more perspicuous,
to use sound-let in cases like this. Here's an example that takes any set of notes and calls granulate
on the result:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+
+<pre class="indented">
(define-macro (gran-any beg dur expansion . body)
`(<em class=red>sound-let</em> ((tmp () , at body))
- (let* ((start (floor (* (mus-srate) ,beg)))
- (end (+ start (* (mus-srate) ,dur)))
+ (let* ((start (floor (* *clm-srate* ,beg)))
+ (end (+ start (* *clm-srate* ,dur)))
(rd (make-readin tmp))
(gran (<em class=red>make-granulate</em> :input rd :expansion ,expansion)))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (outa i (granulate gran)))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (outa i (granulate gran))))))
(with-sound ()
(gran-any 0 2.5 4
@@ -7385,7 +7126,6 @@ on the result:
(fm-violin .2 .1 660 .1)
(fm-violin .4 .1 880 .1)))
</pre>
-</td></tr></table>
<p>Any of the input-oriented generators (src, etc) can use this trick.
</p>
@@ -7398,58 +7138,76 @@ The edit function, if any, should return the length in samples of the grain, or
In the following example, we use the edit function to reverse every other grain:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(let ((forward #t))
(let ((grn (<em class=red>make-granulate</em> :expansion 2.0
:edit (lambda (g)
- (let ((grain (<a class=quiet href="#mus-data" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_data_tip)">mus-data</a> g)) ; current grain
- (len (<a class=quiet href="#mus-length" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_length_tip)">mus-length</a> g))) ; current grain length
+ (let ((grain (<a class=quiet href="#mus-data">mus-data</a> g)) ; current grain
+ (len (<a class=quiet href="#mus-length">mus-length</a> g))) ; current grain length
(if forward ; no change to data
(set! forward #f)
(begin
(set! forward #t)
- (<a class=quiet href="extsnd.html#vctreverse" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctreverse_tip)">vct-reverse!</a> grain len)))
+ (reverse! grain)))
len))))
- (rd (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (<em class=red>granulate</em> grn (lambda (dir) (rd)))))))
+ (rd (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y) (<em class=red>granulate</em> grn (lambda (dir) (rd)))))))
</pre>
-</td></tr></table>
-<br><br>
-<A NAME="phase-vocoderdoc"></A>
-<!-- ---------------------------------------- PHASE-VOCODER ---------------------------------------- -->
+<!-- PHASE-VOCODER -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>phase-vocoder</h3></center></td></tr></table>
+<div class="innerheader" id="phase-vocoderdoc">phase-vocoder</div>
-<pre>
- <a class=def name="make-phase-vocoder">make-phase-vocoder</a> input (fft-size 512) (overlap 4) (interp 128) (pitch 1.0) analyze edit synthesize
- <a class=def name="phase-vocoder">phase-vocoder</a> pv input-function analyze-function edit-function synthesize-function
- <a class=def name="phase-vocoder?">phase-vocoder?</a> pv
+<pre class="indented">
+<em class=def id="make-phase-vocoder">make-phase-vocoder</em> input (fft-size 512) (overlap 4) (interp 128) (pitch 1.0) analyze edit synthesize
+<em class=def id="phase-vocoder">phase-vocoder</em> pv
+<em class=def id="phase-vocoder?">phase-vocoder?</em> pv
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">phase-vocoder methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">pitch shift</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">fft-size</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">interp</td></tr>
+<tr><td class="inner"><em class=gen>mus-hop</em></td><td class="inner">fft-size / overlap</td></tr>
+<tr><td class="inner"><em class=gen>mus-location</em></td><td class="inner">outctr (counter to next fft)</td></tr>
+</table>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<p>The phase-vocoder generator performs phase-vocoder analysis and resynthesis. The process is
+split into three pieces, the analysis stage, editing of the amplitudes and phases, then the resynthesis.
+Each stage has a default that is invoked if the "analyze", "edit", or "synthesize"
+arguments are omitted from make-phase-vocoder or the phase-vocoder generator. The edit and synthesize arguments are functions of one argument, the
+phase-vocoder generator. The analyze argument is a function of two arguments, the generator and
+the input function. The default is to read the current input,
+take an fft, get the new amplitudes and phases (as the edit
+function default), then resynthesize using sines; so, the
+default case returns a resynthesis of the original input. The "interp" argument sets the time between
+ffts (for time stretching, etc).
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t) ; new pitch = 2 * old
(let ((pv (make-phase-vocoder
(make-readin "oboe.snd") :pitch 2.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (phase-vocoder pv)))))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
rd = make_readin("oboe.snd");
pv = make_phase_vocoder(
@@ -7460,12 +7218,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
"oboe.snd" make-readin :pitch 2.0 make-phase-vocoder { pv }
44100 0 do
@@ -7473,106 +7233,77 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
+</table>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t :srate 22050) ; new dur = 2 * old
(let ((pv (make-phase-vocoder
(make-readin "oboe.snd")
:interp 256)) ; 2 * 512 / 4
;; 512: fft size, 4: overlap, new dur: 2 * old dur
- (samps (* 2 (mus-sound-frames "oboe.snd"))))
- (do ((i 0 (+ 1 i)))
+ (samps (* 2 (mus-sound-framples "oboe.snd"))))
+ (do ((i 0 (+ i 1)))
((= i samps))
(outa i (phase-vocoder pv)))))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true, :srate, 22050) do
rd = make_readin("oboe.snd");
pv = make_phase_vocoder(
lambda do |dir| readin(rd) end,
:interp, 2 * 512 / 4);
- samps = 2 * mus_sound_frames("oboe.snd");
+ samps = 2 * mus_sound_framples("oboe.snd");
samps.times do |i|
outa(i, phase_vocoder(pv), $output);
end
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
"oboe.snd" make-readin :interp 256 make-phase-vocoder { pv }
- "oboe.snd" mus-sound-frames 2* ( samps ) 0 do
+ "oboe.snd" mus-sound-framples 2* ( samps ) 0 do
i pv #f #f #f #f phase-vocoder *output* outa drop
loop
; :play #t :srate 22050 with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<br>
-
-
-<table border=1 cellpadding=4 hspace=40 vspace=10>
-<tr><td colspan=2 bgcolor="beige"><center>phase-vocoder methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>pitch shift</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>fft-size</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>interp</td></tr>
-<tr><td><em class=gen>mus-hop</em></td><td>fft-size / overlap</td></tr>
-<tr><td><em class=gen>mus-location</em></td><td>outctr (counter to next fft)</td></tr>
-</table>
-
-<p>The phase-vocoder generator performs phase-vocoder analysis and resynthesis. The process is
-split into three pieces, the analysis stage, editing of the amplitudes and phases, then the resynthesis.
-Each stage has a default that is invoked if the "analyze", "edit", or "synthesize"
-arguments are omitted from make-phase-vocoder or the phase-vocoder generator. The edit and synthesize arguments are functions of one argument, the
-phase-vocoder generator. The analyze argument is a function of two arguments, the generator and
-the input function. The default is to read the current input,
-take an fft, get the new amplitudes and phases (as the edit
-function default), then resynthesize using sines; so, the
-default case returns a resynthesis of the original input. The "interp" argument sets the time between
-ffts (for time stretching, etc).
-</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (simple-pvoc beg dur amp size file)
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (sr (<em class=red>make-phase-vocoder</em> (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> file) :fft-size size)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<em class=red>phase-vocoder</em> sr)))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (simple-pvoc 0 2.0 1.0 512 "oboe.snd"))
-</pre>
-</td></tr></table>
<p>There are several functions giving access to the phase-vocoder data:
</p>
-<pre>
- <em class=emdef>phase-vocoder-amps</em> gen
- <em class=emdef>phase-vocoder-freqs</em> gen
- <em class=emdef>phase-vocoder-phases</em> gen
- <em class=emdef>phase-vocoder-amp-increments</em> gen
- <em class=emdef>phase-vocoder-phase-increments</em> gen
+<pre class="indented">
+<em class=emdef>phase-vocoder-amps</em> gen
+<em class=emdef>phase-vocoder-freqs</em> gen
+<em class=emdef>phase-vocoder-phases</em> gen
+<em class=emdef>phase-vocoder-amp-increments</em> gen
+<em class=emdef>phase-vocoder-phase-increments</em> gen
</pre>
-<p>These are arrays (vcts) containing the spectral data the phase-vocoder uses to
+<p>These are arrays (float-vectors) containing the spectral data the phase-vocoder uses to
reconstruct the sound. See clm23.scm for examples,
in particular pvoc-e that
specifies all of the functions with their default values (that is, it explicitly passes
@@ -7582,10 +7313,7 @@ generator).
In the next example we use all these special functions to resynthesize down an octave:
</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
-
+<pre class="indented">
(with-sound (:srate 22050 :statistics #t)
(let ((pv (<em class=red>make-phase-vocoder</em>
(make-readin "oboe.snd")
@@ -7593,22 +7321,20 @@ In the next example we use all these special functions to resynthesize down an o
#f ; no change to analysis method
#f ; no change to spectrum
(lambda (gen) ; resynthesis function
- (vct-add! (phase-vocoder-amps gen) (phase-vocoder-amp-increments gen))
- (vct-add! (phase-vocoder-phase-increments gen) (phase-vocoder-freqs gen))
- (vct-add! (phase-vocoder-phases gen) (phase-vocoder-phase-increments gen))
+ (float-vector-add! (phase-vocoder-amps gen) (phase-vocoder-amp-increments gen))
+ (float-vector-add! (phase-vocoder-phase-increments gen) (phase-vocoder-freqs gen))
+ (float-vector-add! (phase-vocoder-phases gen) (phase-vocoder-phase-increments gen))
(let ((sum 0.0)
(n (length (phase-vocoder-amps gen))))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k n))
- (set! sum (+ sum (* (vct-ref (phase-vocoder-amps gen) k)
- (sin (* 0.5 (vct-ref (phase-vocoder-phases gen) k)))))))
+ (set! sum (+ sum (* (float-vector-ref (phase-vocoder-amps gen) k)
+ (sin (* 0.5 (float-vector-ref (phase-vocoder-phases gen) k)))))))
sum)))))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 44100))
- (outa i (<em class=red>phase-vocoder</em> pv))))))
+ (do ((i 0 (+ i 1)))
+ ((= i 44100))
+ (outa i (<em class=red>phase-vocoder</em> pv)))))
</pre>
-</td></tr></table>
<p>but, sadly, this code crawls. It won't actually be useful until I optimize
handling of the caller's resynthesis function, but I am dragging my feet because I've never felt
@@ -7616,44 +7342,77 @@ that this phase-vocoder (as a generator) was the "right thing". The first step
moving-spectrum in generators.scm.
</p>
-<br><br>
-
-<A NAME="asymmetric-fmdoc"></A>
-<!-- ---------------------------------------- ASYMMETRIC-FM ---------------------------------------- -->
+<!-- ASYMMETRIC-FM -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>asymmetric-fm</h3></center></td></tr></table>
+<div class="innerheader" id="asymmetric-fmdoc">asymmetric-fm</div>
-<pre>
- <a class=def name="make-asymmetric-fm">make-asymmetric-fm</a>
+<pre class="indented">
+<em class=def id="make-asymmetric-fm">make-asymmetric-fm</em>
(frequency *clm-default-frequency*)
(initial-phase 0.0)
(r 1.0) ; amplitude ratio between successive sidebands
(ratio 1.0) ; ratio between carrier and sideband spacing
- <a class=def name="asymmetric-fm">asymmetric-fm</a> af index (fm 0.0)
- <a class=def name="asymmetric-fm?">asymmetric-fm?</a> af
+<em class=def id="asymmetric-fm">asymmetric-fm</em> af index (fm 0.0)
+<em class=def id="asymmetric-fm?">asymmetric-fm?</em> af
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">asymmetric-fm methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-frequency</em></td><td class="inner">frequency in Hz</td></tr>
+<tr><td class="inner"><em class=gen>mus-phase</em></td><td class="inner">phase in radians</td></tr>
+<tr><td class="inner"><em class=gen>mus-scaler</em></td><td class="inner">"r" parameter; sideband scaler</td></tr>
+<tr><td class="inner"><em class=gen>mus-offset</em></td><td class="inner">"ratio" parameter</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">frequency in radians per sample</td></tr>
+</table>
+
+<p>The asymmetric-fm generator provides a way around the symmetric spectra normally produced by FM.
+See Palamin and Palamin, "A Method of Generating and Controlling Asymmetrical
+Spectra" JAES vol 36, no 9, Sept 88, p671-685. P&P use sin(sin), but I'm using cos(sin) so
+that we get a sum of cosines, and can therefore easily normalize the peak amplitude to -1.0..1.0.
+asymmetric-fm is based on:
+</p>
+
+<!-- LATEX:
+original:
+e^{(\frac{B}{2}(r-\frac{1}{r})\cos \omega_{m}t)}\sin(\omega_{c}t+\frac{B}{2}(r+\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}J_{n}(B)\sin(\omega_{c}t+n\omega_{m}t)
+my version (for predicatable peak amp):
+e^{(\frac{B}{2}(r-\frac{1}{r})\cos \omega_{m}t)}\cos(\omega_{c}t+\frac{B}{2}(r+\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}J_{n}(B)\cos(\omega_{c}t+n\omega_{m}t)
+
+original:
+e^{(\frac{B}{2}(r+\frac{1}{r})\cos \omega_{m}t)}\sin(\omega_{c}t+\frac{B}{2}(r-\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}I_{n}(B)\sin(\omega_{c}t+n\omega_{m}t)
+my version:
+e^{(\frac{B}{2}(r+\frac{1}{r})\cos \omega_{m}t)}\cos(\omega_{c}t+\frac{B}{2}(r-\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}I_{n}(B)\cos(\omega_{c}t+n\omega_{m}t)
+
+here's the complicated case:
+e^{\big( \big(\frac{B}{2}\big(r+\frac{1}{r}\big)\cos \omega_{m}t\big) - \frac{1}{2} \ln \big(I_{0}\big(B\big(r+\frac{1}{r}\big)\big)\big) \big)} \sin\big(\omega_{c}t+\frac{B}{2}\big(r-\frac{1}{r}\big)\sin \omega_{m}t\big)=\frac{1}{\sqrt{I_{0}(B(r+\frac{1}{r}))}} \sum r^{n}I_{n}(B)\sin(\omega_{c}t+n\omega_{m}t)
+ -->
+
+<img class="indented" src="pix/sceq10.png" alt="e sin"><br>
+<img class="indented" src="pix/sceq22.png" alt="I form">
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=8 cellpadding=5>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((fm (make-asymmetric-fm 440.0 0.0 0.9 0.5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (asymmetric-fm fm 1.0))))))
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
fm = make_asymmetric_fm(440.0, 0.0, 0.9, 0.5);
44100.times do |i|
@@ -7661,12 +7420,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr>
<tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 0.0 0.9 0.5 make-asymmetric-fm { fm }
44100 0 do
@@ -7674,51 +7435,11 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>The asymmetric-fm generator provides a way around the symmetric spectra normally produced by FM.
-See Palamin and Palamin, "A Method of Generating and Controlling Asymmetrical
-Spectra" JAES vol 36, no 9, Sept 88, p671-685. P&P use sin(sin), but I'm using cos(sin) so
-that we get a sum of cosines, and can therefore easily normalize the peak amplitude to -1.0..1.0.
-</p>
-
-
-<table align=left border=1 cellpadding=4 hspace=40 vspace=10>
-<tr><td colspan=2 bgcolor="beige"><center>asymmetric-fm methods</center></td></tr>
-<tr><td><em class=gen>mus-frequency</em></td><td>frequency in Hz</td></tr>
-<tr><td><em class=gen>mus-phase</em></td><td>phase in radians</td></tr>
-<tr><td><em class=gen>mus-scaler</em></td><td>"r" parameter; sideband scaler</td></tr>
-<tr><td><em class=gen>mus-offset</em></td><td>"ratio" parameter</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>frequency in radians per sample</td></tr>
-</table>
-<br>
-
-<!-- LATEX:
-original:
-e^{(\frac{B}{2}(r-\frac{1}{r})\cos \omega_{m}t)}\sin(\omega_{c}t+\frac{B}{2}(r+\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}J_{n}(B)\sin(\omega_{c}t+n\omega_{m}t)
-my version (for predicatable peak amp):
-e^{(\frac{B}{2}(r-\frac{1}{r})\cos \omega_{m}t)}\cos(\omega_{c}t+\frac{B}{2}(r+\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}J_{n}(B)\cos(\omega_{c}t+n\omega_{m}t)
-
-original:
-e^{(\frac{B}{2}(r+\frac{1}{r})\cos \omega_{m}t)}\sin(\omega_{c}t+\frac{B}{2}(r-\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}I_{n}(B)\sin(\omega_{c}t+n\omega_{m}t)
-my version:
-e^{(\frac{B}{2}(r+\frac{1}{r})\cos \omega_{m}t)}\cos(\omega_{c}t+\frac{B}{2}(r-\frac{1}{r})\sin \omega_{m}t)=\sum_{n=-\infty}^{\infty} r^{n}I_{n}(B)\cos(\omega_{c}t+n\omega_{m}t)
-
-here's the complicated case:
-e^{\big( \big(\frac{B}{2}\big(r+\frac{1}{r}\big)\cos \omega_{m}t\big) - \frac{1}{2} \ln \big(I_{0}\big(B\big(r+\frac{1}{r}\big)\big)\big) \big)} \sin\big(\omega_{c}t+\frac{B}{2}\big(r-\frac{1}{r}\big)\sin \omega_{m}t\big)=\frac{1}{\sqrt{I_{0}(B(r+\frac{1}{r}))}} \sum r^{n}I_{n}(B)\sin(\omega_{c}t+n\omega_{m}t)
- -->
-
-<pre>
-based on:
-</pre>
-<img src="pix/sceq10.png" alt="e sin"><br>
-<img src="pix/sceq22.png" alt="I form">
-
-<br clear=left>
-
<p>"r" is the ratio between successive
sideband amplitudes, r < 0.0 or r > 1.0 pushes energy above the carrier, whereas r between 0.0 and 1.0 pushes it below. (r = 1.0
gives normal FM). The mirror image of r (around a given
@@ -7728,199 +7449,38 @@ that asymmetric-fm takes "index" (the fm-index) as its second argument, but othe
would be tricky to get time-varying indices. In this instrument we sweep "r" with an envelope:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (asy beg dur freq amp index (ratio 1.0))
- (let* ((st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (nd (+ st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (r-env (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 -1 1 -20) :duration dur))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (asy beg dur freq amp index (ratio 1.0))
+ (let* ((st (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (nd (+ st (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
+ (r-env (<a class=quiet href="#make-env">make-env</a> '(0 -1 1 -20) :duration dur))
(asyf (<em class=red>make-asymmetric-fm</em> :ratio ratio :frequency freq)))
- (do ((i st (+ 1 i)))
+ (do ((i st (+ i 1)))
((= i nd))
- (set! (<a class=quiet href="#mus-scaler" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_scaler_tip)">mus-scaler</a> asyf) (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> r-env)) ; this sets "r"
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<em class=red>asymmetric-fm</em> asyf index))))))
+ (set! (<a class=quiet href="#mus-scaler">mus-scaler</a> asyf) (<a class=quiet href="#env">env</a> r-env)) ; this sets "r"
+ (<a class=quiet href="#outa">outa</a> i (* amp (<em class=red>asymmetric-fm</em> asyf index))))))
</pre>
-</td></tr></table>
<p>For the other kind of asymmetric-fm see generators.scm, and for asymmetric spectra via "single sideband FM" see generators.scm.
</p>
-<br><br>
-
-
-
-<!-- INDEX framedoc:frames -->
-<!-- INDEX framedoc:mixers -->
-<A NAME="framedoc"></A>
-<!-- ---------------------------------------- FRAME, MIXER ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>frames and mixers</h3></center></td></tr></table>
-<p>
-There are two special data types in CLM: frames and mixers.
-A frame is an array that represents
-a multichannel sample (that is, in a stereo file, at time 0.0, there
-are two samples, one for each channel, and the frame that represents it has 2 samples). A mixer is a array of arrays
-that represents a set of input to output scalers, as if it were the
-current state of a mixing console's volume controls. A frame (a multichannel
-input) can be mixed into a new frame (a multichannel output) by passing
-it through a mixer (a matrix, the operation being a (left) matrix multiply).
-These are combined with the notion of a sample (one datum of sampled music), and
-input/output ports (files, audio ports, etc) to handle all the
-sound data input and output.
-</p>
-
-<table cellspacing=0 cellpadding=0 hspace=40>
-<tr><td><a class=def name="make-frame">make-frame</a><code> chans :rest args</code></td><td width=20></td><td>create frame and load it with args</td></tr>
-<tr><td><a class=def name="make-frame!">make-frame!</a><code> chans :rest args</code></td><td width=20></td><td>create frame of any size and load it with args</td></tr>
-<tr><td><a class=def name="frame1">frame</a><code> :rest args</code></td><td width=20></td><td>create frame and load it with args</td></tr>
-<tr><td><a class=def name="frame?">frame?</a><code> obj</code></td><td></td><td>is obj a frame</td></tr>
-<tr><td><a class=def name="frame-ref">frame-ref</a><code> f1 chan</code></td><td></td><td>return f1[chan]</td></tr>
-<tr><td><a class=def name="frame-set!">frame-set!</a><code> f1 chan val</code></td><td></td><td>f1[chan] = val (also set! with frame-ref)</td></tr>
-<tr><td><a class=def name="frame+">frame+</a><code> f1 f2 outf</code></td><td></td><td>add f1 and f2 element-wise, return new frame (or outf)</td></tr>
-<tr><td><a class=def name="frame*">frame*</a><code> f1 f2 outf</code></td><td></td><td>multiply f1 and f2 element-size, return new frame (or outf)</td></tr>
-<tr><td><br></td><td></td><td></td></tr>
-<tr><td><a class=def name="make-mixer">make-mixer</a><code> chans :rest args</code></td><td></td><td>create a mixer and load it with args</td></tr>
-<tr><td><a class=def name="make-mixer!">make-mixer!</a><code> chans :rest args</code></td><td></td><td>create a mixer of any size and load it with args</td></tr>
-<tr><td><a class=def name="mixer1">mixer</a><code> :rest args</code></td><td></td><td>create a mixer and load it with args</td></tr>
-<tr><td><a class=def name="make-scalar-mixer">make-scalar-mixer</a><code> chans scl</code></td><td></td><td>create a mixer with scl on the diagonal</td></tr>
-<tr><td><a class=def name="mixer?">mixer?</a><code> obj</code></td><td></td><td>is obj a mixer</td></tr>
-<tr><td><a class=def name="mixer-ref">mixer-ref</a><code> m1 in out</code></td><td></td><td>m1[in,out] (use set! to change)</td></tr>
-<tr><td><a class=def name="mixer-set!">mixer-set!</a><code> m1 in out val</code></td><td></td><td>m1[in,out] = val (also set! with mixer-ref)</td></tr>
-<tr><td><a class=def name="mixermultiply">mixer*</a><code> m1 m2 outm</code></td><td></td><td>matrix multiply of m1 and m2, return new mixer (or outm)</td></tr>
-<tr><td><a class=def name="mixeradd">mixer+</a><code> m1 m2 outm</code></td><td></td><td>matrix add of m1 and m2, return new mixer (or outm)</td></tr>
-<tr><td></td><td><br></td><td></td></tr>
-<tr><td><a class=def name="frametoframe">frame->frame</a><code> mf mf outf</code></td><td></td><td>pass frame through mixer, return new frame (or outf)</td></tr>
-<tr><td><a class=def name="frametolist">frame->list</a><code> frame</code></td><td></td><td>return list of frame's contents</td></tr>
-<tr><td><a class=def name="sampletoframe">sample->frame</a><code> mf sample outf</code></td><td></td><td>pass sample through mf (a frame or mixer), return new frame (or outf)</td></tr>
-<tr><td><a class=def name="frametosample">frame->sample</a><code> mf frame</code></td><td></td><td>pass frame through mf (a frame or mixer), return sample</td></tr>
-</table>
-
-<A NAME="framemuschannels"></A>
-<table border=1 cellpadding=4 hspace=40 vspace=20>
-<tr><td colspan=2 bgcolor="beige"><center>frame and mixer methods</center></td></tr>
-<tr><td><em class=gen>mus-channels</em></td><td>number of channels accommodated</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>same as mus-channels</td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>frame data (vct)</td></tr>
+<table class="method">
+<tr><td class="inner"><em class=def id="frampletoframple">frample->frample</em><code> mf inf outf</code></td><td>pass frample through a matrix multiply, return outf</td></tr>
</table>
-<p>
-The arguments to frame*, frame+, mixer*, and mixer+ can be floats as well as mixers and
-frames. In that case, the mixer or frame is either scaled by the float, or the float is
-added to each element.
-In matrix terminology, a mixer is a square matrix, a frame is a column (or row) vector, mixer* is a
-matrix multiply, and so on.
-The form <code>(frame->frame frame mixer frame)</code> multiplies a row vector (the first frame)
-by a matrix (the mixer), whereas <code>(frame->frame mixer frame frame)</code> multiplies
-a matrix by a column vector.
-See <a href="sndscm.html#framedoc">frame.scm</a> for many more
-frame-related functions, <a href="sndscm.html#mixerdoc">mixer.scm</a> for mixer functions,
-and fullmix in clm-ins.scm for an extended example.
-In Ruby, frame* is frame_multiply, frame+ is frame_add, and mixer* is mixer_multiply.
-</p>
-
-<pre>
- <em class=listener>></em><em class=typing>(define f1 (make-frame 3 1.0 0.5 0.1))</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>f1</em>
- <em class=listener>#<frame[3]: [1.000 0.500 0.100]></em>
- <em class=listener>></em><em class=typing>(frame-ref f1 2)</em>
- <em class=listener>0.100000001490116</em>
- <em class=listener>></em><em class=typing>(frame* f1 2.0)</em>
- <em class=listener>#<frame[3]: [2.000 1.000 0.200]></em>
- <em class=listener>></em><em class=typing>(define f2 (make-frame 3 0.0 1.0 0.0))</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(frame+ f1 f2)</em>
- <em class=listener>#<frame[3]: [1.000 1.500 0.100]></em>
- <em class=listener>></em><em class=typing>(frame->sample f1 f2)</em> ; dot-product in this case
- <em class=listener>0.5</em>
- <em class=listener>></em><em class=typing>(define m1 (make-mixer 3 1 0 0 0 1 0 0 0 2))</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>m1</em>
- <em class=listener>#<mixer: chans: 3, [
- 1.000 0.000 0.000
- 0.000 1.000 0.000
- 0.000 0.000 2.000
- ]></em>
- <em class=listener>></em><em class=typing>(mixer-ref m1 2 2)</em>
- <em class=listener>2.0</em>
- <em class=listener>></em><em class=typing>(frame->frame m1 f1)</em>
- <em class=listener>#<frame[3]: [1.000 0.500 0.200]></em>
- <em class=listener>></em><em class=typing>(mus-length m1)</em>
- <em class=listener>3</em>
- <em class=listener>></em><em class=typing>(mus-data f1)</em>
- <em class=listener>#<vct[len=3]: 1.000 0.500 0.100></em>
- <em class=listener>></em><em class=typing>(frame-set! f1 1 -.5)</em> ; same as (set! (frame-ref f1 1) -.5)
- <em class=listener>-0.5</em>
- <em class=listener>></em><em class=typing>f1</em>
- <em class=listener>#<frame[3]: [1.000 -0.500 0.100]></em>
- <em class=listener>></em><em class=typing>(mixer-set! m1 0 1 0.5)</em> ; same as (set! (mixer-ref m1 0 1) 0.5)
- <em class=listener>0.5</em>
- <em class=listener>></em><em class=typing>m1</em>
- <em class=listener>#<mixer: chans: 3, [
- 1.000 0.500 0.000
- 0.000 1.000 0.000
- 0.000 0.000 2.000
- ]></em>
-</pre>
-
-<p>make-mixer! (with the exclamation point) overrides an internal size check. Since the size
-is interpreted normally as the number of channels, make-mixer (without the trailing "!") imposes a maximum size that is pretty
-low (128 when last checked). If you're using mixers as honest matrices, you'll often want large
-mixers. Here's a curious example that takes the "wavogram" view of a sound (as a sequence
-of equal length traces), loads it into a mixer, inverts the mixer (via matrix inversion, <a href="sndscm.html#invertmatrix">invert-matrix</a>), then
-writes out the new "sound":
-</p>
-
-<pre>
-(let* ((snd (open-sound "oboe.snd"))
- (size 225) ; 225 * 225 is about the size of oboe.snd
- (mx (<em class=red>make-mixer!</em> size))
- (rd (make-sampler 0)))
- (do ((i 0 (+ i 1)))
- ((= i size))
- (do ((j 0 (+ j 1)))
- ((= j size))
- (<em class=red>mixer-set!</em> mx i j (rd))))
-
- (invert-matrix mx)
- (let ((nsnd (new-sound "test.snd" :srate 22050))
- (samp 0)
- (samps (make-vct (* size size))))
- (do ((i 0 (+ i 1)))
- ((= i size))
- (do ((j 0 (+ j 1)))
- ((= j size))
- (set! (samps samp) (<em class=red>mixer-ref</em> mx i j))
- (set! samp (+ samp 1))))
-
- (vct->channel samps 0 (* size size) nsnd)))
-</pre>
-
-<p>In s7, mixers and frames are "applicable objects", like vcts, so mixer-ref and frame-ref are
-unnecessary, and mixer-set! and frame-set! can be replaced with set!:
-</p>
-<pre>
- <em class=listener>></em><em class=typing>(let ((fr (frame .1 .2)))
- (set! (fr 1) .3)
- (fr 1))</em>
- <em class=listener>0.3</em>
-</pre>
-
-<br><br>
+<!-- FILE->SAMPLE -->
-<A NAME="filetosampledoc"></A>
-<!-- ---------------------------------------- FILE->SAMPLE ---------------------------------------- -->
+<div class="innerheader" id="filetosampledoc">sound IO</div>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>sound IO</h3></center></td></tr></table>
-
-<p>Sound file IO is based on a set of file readers and writers that deal either in samples, frames, or vcts.
-The six functions are file->sample, sample->file, file->frame, frame->file, array->file, and file->array.
-The name "array" is used here, rather than "vct" for historical reasons (the CL version of CLM predates
+<p>Sound file IO is based on a set of file readers and writers that deal either in samples or float-vectors.
+The six functions are file->sample, sample->file, file->frample, frample->file, array->file, and file->array.
+The name "array" is used here, rather than "float-vector" for historical reasons (the CL version of CLM predates
Snd by many years).
These functions are then packaged up in more convenient forms as in-any, out-any, locsig, readin, etc.
Within with-sound, the variable *output* is bound to the with-sound output file via a sample->file
@@ -7928,117 +7488,119 @@ object.
</p>
-<pre>
- <a class=def name="make-filetosample">make-file->sample</a> name (buffer-size 8192)
- <a class=def name="make-sampletofile">make-sample->file</a> name (chans 1) (format mus-lfloat) (type mus-next) comment
- <a class=def name="filetosample?">file->sample?</a> obj
- <a class=def name="sampletofile?">sample->file?</a> obj
- <a class=def name="filetosample">file->sample</a> obj samp chan
- <a class=def name="sampletofile">sample->file</a> obj samp chan val
- <a class=def name="continue-sampletofile">continue-sample->file</a> file
+<pre class="indented">
+<em class=def id="make-filetosample">make-file->sample</em> name (buffer-size 8192)
+<em class=def id="make-sampletofile">make-sample->file</em> name (chans 1) (format mus-lfloat) (type mus-next) comment
+<em class=def id="filetosample?">file->sample?</em> obj
+<em class=def id="sampletofile?">sample->file?</em> obj
+<em class=def id="filetosample">file->sample</em> obj samp chan
+<em class=def id="sampletofile">sample->file</em> obj samp chan val
+<em class=def id="continue-sampletofile">continue-sample->file</em> file
- <a class=def name="make-filetoframe">make-file->frame</a> name (buffer-size 8192)
- <a class=def name="make-frametofile">make-frame->file</a> name (chans 1) (format mus-lfloat) (type mus-next) comment
- <a class=def name="frametofile?">frame->file?</a> obj
- <a class=def name="filetoframe?">file->frame?</a> obj
- <a class=def name="filetoframe">file->frame</a> obj samp outf
- <a class=def name="frametofile">frame->file</a> obj samp val
- <a class=def name="continue-frametofile">continue-frame->file</a> file
+<em class=def id="make-filetoframple">make-file->frample</em> name (buffer-size 8192)
+<em class=def id="make-frampletofile">make-frample->file</em> name (chans 1) (format mus-lfloat) (type mus-next) comment
+<em class=def id="frampletofile?">frample->file?</em> obj
+<em class=def id="filetoframple?">file->frample?</em> obj
+<em class=def id="filetoframple">file->frample</em> obj samp outf
+<em class=def id="frampletofile">frample->file</em> obj samp val
+<em class=def id="continue-frampletofile">continue-frample->file</em> file
- <a class=def name="filetoarray">file->array</a> file channel beg dur array
- <a class=def name="arraytofile">array->file</a> file data len srate channels
+<em class=def id="filetoarray">file->array</em> file channel beg dur array
+<em class=def id="arraytofile">array->file</em> file data len srate channels
- <a class=def name="mus-input?">mus-input?</a> obj
- <a class=def name="mus-output?">mus-output?</a> obj
- <a class=def name="mus-close">mus-close</a> obj
- <a class=def name="*output*">*output*</a>
- <a class=def name="*reverb*">*reverb*</a>
- <a class=def name="musfilebuffersize">mus-file-buffer-size</a>
+<em class=def id="mus-input?">mus-input?</em> obj
+<em class=def id="mus-output?">mus-output?</em> obj
+<em class=def id="mus-close">mus-close</em> obj
+<em class=def id="*output*">*output*</em>
+<em class=def id="*reverb*">*reverb*</em>
+<em class=def id="musfilebuffersize">mus-file-buffer-size</em> (also known as *clm-file-buffer-size*)
</pre>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
-
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:channels 2)
;; swap channels of stereo file
- (let* ((input (make-file->frame "stereo.snd"))
- (len (mus-sound-frames "stereo.snd"))
- (frame (make-frame 2)))
- (do ((i 0 (+ 1 i)))
+ (let ((input (make-file->frample "stereo.snd"))
+ (len (mus-sound-framples "stereo.snd"))
+ (frample (make-float-vector 2 0.0)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (file->frame input i frame)
- (let ((val (frame-ref frame 0)))
- (frame-set! frame 0 (frame-ref frame 1))
- (frame-set! frame 1 val))
- (frame->file *output* i frame))))
+ (file->frample input i frample)
+ (let ((val (frample 0)))
+ (set! (frample 0) (frample 1))
+ (set! (frample 1) val))
+ (frample->file *output* i frample))))
</pre>
+</div>
</td>
-<td width=4></td>
+</tr><tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:channels, 2) do
- input = make_file2frame("stereo.snd");
- len = mus_sound_frames("stereo.snd");
- frame = make_frame(2);
+ input = make_file2frample("stereo.snd");
+ len = mus_sound_framples("stereo.snd");
+ frample = make_frample(2);
len.times do |i|
- file2frame(input, i, frame);
- val = frame_ref(frame, 0);
- frame_set!(frame, 0, frame_ref(frame, 1));
- frame_set!(frame, 1, val);
- frame2file($output, i, frame);
+ file2frample(input, i, frample);
+ val = frample_ref(frample, 0);
+ frample_set!(frample, 0, frample_ref(frample, 1));
+ frample_set!(frample, 1, val);
+ frample2file($output, i, frample);
end
end.output
</pre>
+</div>
</td>
-<td width=4></td>
+</tr><tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
- "stereo.snd" make-file->frame { input }
- 2 make-frame { frm }
- "stereo.snd" mus-sound-frames ( len ) 0 do
- input i frm file->frame ( frm ) 1 frame-ref ( val1 )
- frm 0 frame-ref ( val0 ) frm 1 rot frame-set! drop
- ( val1 ) frm 0 rot frame-set! drop
- *output* i frm frame->file drop
+ "stereo.snd" make-file->frample { input }
+ 2 make-frample { frm }
+ "stereo.snd" mus-sound-framples ( len ) 0 do
+ input i frm file->frample ( frm ) 1 frample-ref ( val1 )
+ frm 0 frample-ref ( val0 ) frm 1 rot frample-set! drop
+ ( val1 ) frm 0 rot frample-set! drop
+ *output* i frm frample->file drop
loop
; :channels 2 :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<p>file->sample writes a sample to a file, frame->file writes a frame, file->sample reads a sample
-from a file, and file->frame reads a frame.
-continue-frame->file and continue-sample->file reopen an existing file to continue adding sound data to it.
+<p>file->sample writes a sample to a file, frample->file writes a frample, file->sample reads a sample
+from a file, and file->frample reads a frample.
+continue-frample->file and continue-sample->file reopen an existing file to continue adding sound data to it.
mus-output? returns #t is its argument is some sort of file writing generator, and mus-input? returns #t if its
-argument is a file reader. file->frame returns a new frame unless you pass it an "outf" argument (a frame).
-In make-file->sample and make-file->frame, the buffer-size defaults to <a href="#musfilebuffersize">mus-file-buffer-size</a>.
+argument is a file reader.
+In make-file->sample and make-file->frample, the buffer-size defaults to *clm-file-buffer-size*.
There are many examples of these functions in snd-test.scm, clm-ins.scm, and clm23.scm.
Here is one that uses file->sample to mix in a sound file (there are a zillion other ways to do this):
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (simple-f2s beg dur amp file)
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+ (let* ((start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(fil (<em class=red>make-file->sample</em> file))
(ctr 0))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i))) ((= i end))
- (<a class=quiet href="#out-any" onmouseout="UnTip()" onmouseover="Tip(sndclm_out_any_tip)">out-any</a> i (* amp (<em class=red>file->sample</em> fil ctr 0)) 0)
- (set! ctr (+ 1 ctr))))))
+ (do ((i start (+ i 1))) ((= i end))
+ (<a class=quiet href="#out-any">out-any</a> i (* amp (<em class=red>file->sample</em> fil ctr 0)) 0)
+ (set! ctr (+ 1 ctr)))))
</pre>
-</td></tr></table>
<p>mus-close flushes any pending output and closes the output stream 'obj'.
This is normally done for you by with-sound, but if you have your own
@@ -8046,63 +7608,55 @@ output streams,
and you forget to call mus-close, the GC will eventually do it for you.
</p>
-<p>Here's a function to convert a sound file to some other header or data type using file->frame and frame->file:
-</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
-(define* (convert-soundfile in-file out-file header data)
- (with-sound (:output (or out-file "test.snd")
- :header-type (or header (mus-sound-header-type in-file))
- :data-format (or data (mus-sound-data-format in-file))
- :channels (mus-sound-chans in-file)
- :srate (mus-sound-srate in-file))
- (let ((r (<em class=red>make-file->frame</em> in-file))
- (len (mus-sound-frames in-file))
- (outf (make-frame (mus-sound-chans in-file))))
- (run
- (do ((i 0 (+ i 1)))
- ((= i len))
- (<em class=red>file->frame</em> r i outf)
- (<em class=red>frame->file</em> *output* i outf))))))
-
-(convert-soundfile "oboe.snd" "test.snd" mus-aifc mus-bfloat)
-</pre>
-</td></tr></table>
-<br><br>
-<A NAME="readindoc"></A>
-<!-- ---------------------------------------- READIN ---------------------------------------- -->
+<!-- READIN -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>readin</h3></center></td></tr></table>
+<div class="innerheader" id="readindoc">readin</div>
-<pre>
- <a class=def name="make-readin">make-readin</a> file (channel 0) (start 0) (direction 1) size
- <a class=def name="readin">readin</a> rd
- <a class=def name="readin?">readin?</a> rd
+<pre class="indented">
+ <em class=def id="make-readin">make-readin</em> file (channel 0) (start 0) (direction 1) size
+ <em class=def id="readin">readin</em> rd
+ <em class=def id="readin?">readin?</em> rd
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">readin methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-channel</em></td><td class="inner">channel arg to make-readin (no set!)</td></tr>
+<tr><td class="inner"><em class=gen>mus-location</em></td><td class="inner">current location in file</td></tr>
+<tr><td class="inner"><em class=gen>mus-increment</em></td><td class="inner">sample increment (direction arg to make-readin)</td></tr>
+<tr><td class="inner"><em class=gen>mus-file-name</em></td><td class="inner">name of file associated with gen</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">number of framples in file associated with gen</td></tr>
+</table>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<p>readin returns successive samples from a file; it is an elaboration of file->sample that keeps track of the
+current read location and channel number for you.
+Its "file" argument is the input file's name.
+"start" is the frample at which to start reading the input file.
+"channel" is which channel to read (0-based).
+"size" is the read buffer size in samples. It defaults to *clm-file-buffer-size*.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((reader (make-readin "oboe.snd")))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 2.0 (readin reader))))))
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
reader = make_readin("oboe.snd");
44100.times do |i|
@@ -8111,12 +7665,13 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
"oboe.snd" make-readin { reader }
44100 0 do
@@ -8124,106 +7679,101 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-<table border=1 cellpadding=4 hspace=40 vspace=10>
-<tr><td colspan=2 bgcolor="beige"><center>readin methods</center></td></tr>
-<tr><td><em class=gen>mus-channel</em></td><td>channel arg to make-readin (no set!)</td></tr>
-<tr><td><em class=gen>mus-location</em></td><td>current location in file</td></tr>
-<tr><td><em class=gen>mus-increment</em></td><td>sample increment (direction arg to make-readin)</td></tr>
-<tr><td><em class=gen>mus-file-name</em></td><td>name of file associated with gen</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>number of frames in file associated with gen</td></tr>
-</table>
-
-<p>readin returns successive samples from a file; it is an elaboration of file->sample that keeps track of the
-current read location and channel number for you.
-Its "file" argument is the input file's name.
-"start" is the frame at which to start reading the input file.
-"channel" is which channel to read (0-based).
-"size" is the read buffer size in samples. It defaults to <a href="#musfilebuffersize">mus-file-buffer-size</a>.
-Here is an instrument that applies an envelope to a sound file using
+<p>Here is an instrument that applies an envelope to a sound file using
readin and <a href="#env">env</a>:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (env-sound file beg (amp 1.0) (amp-env '(0 1 100 1)))
- (let* ((st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (dur (<a class=quiet href="extsnd.html#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> file))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (env-sound file beg (amp 1.0) (amp-env '(0 1 100 1)))
+ (let* ((st (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (dur (<a class=quiet href="extsnd.html#mussoundduration">mus-sound-duration</a> file))
(rev-amount .01)
(rdA (<em class=red>make-readin</em> file))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> amp-env amp dur))
- (nd (+ st (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i st (+ 1 i)))
- ((= i nd))
- (let ((outval (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) (<em class=red>readin</em> rdA))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i outval)
- (if <a class=quiet onmouseout="UnTip()" onmouseover="Tip(sndclm_reverb_tip)">*reverb*</a>
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* outval rev-amount) <a class=quiet onmouseout="UnTip()" onmouseover="Tip(sndclm_reverb_tip)">*reverb*</a>)))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (env-sound "oboe.snd" 0 1.0 '(0 0 1 1 2 1 3 0)))
+ (ampf (<a class=quiet href="#make-env">make-env</a> amp-env amp dur))
+ (nd (+ st (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))))
+ (do ((i st (+ i 1)))
+ ((= i nd))
+ (let ((outval (* (<a class=quiet href="#env">env</a> ampf) (<em class=red>readin</em> rdA))))
+ (<a class=quiet href="#outa">outa</a> i outval)
+ (if <a class=quiet>*reverb*</a>
+ (<a class=quiet href="#outa">outa</a> i (* outval rev-amount) <a class=quiet>*reverb*</a>))))))
+
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (env-sound "oboe.snd" 0 1.0 '(0 0 1 1 2 1 3 0)))
</pre>
-</td></tr></table>
-<br><br>
-<A NAME="in-anydoc"></A>
-<A NAME="out-anydoc"></A>
-<!-- ---------------------------------------- IN-ANY, OUT-ANY ---------------------------------------- -->
+<!-- IN-ANY, OUT-ANY -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>in-any, out-any</h3></center></td></tr></table>
+<div class="innerheader" id="in-anydoc">in-any, out-any</div>
-<pre>
- <a class=def name="out-any">out-any</a> loc data channel (output *output*)
- <a class=def name="outa">outa</a> loc data (output *output*)
- <em class=emdef>outb</em> loc data (output *output*)
- <em class=emdef>outc</em> loc data (output *output*)
- <em class=emdef>outd</em> loc data (output *output*)
+<pre class="indented">
+<em class=def id="out-any">out-any</em> loc data channel (output *output*)
+<em class=def id="outa">outa</em> loc data (output *output*)
+<em class=emdef>outb</em> loc data (output *output*)
+<em class=emdef>outc</em> loc data (output *output*)
+<em class=emdef>outd</em> loc data (output *output*)
+<em class=def id="outbank">out-bank</em> gens loc input
- <a class=def name="in-any">in-any</a> loc channel input
- <a class=def name="ina">ina</a> loc input
- <a class=def name="inb">inb</a> loc input
+<em class=def id="in-any">in-any</em> loc channel input
+<em class=def id="ina">ina</em> loc input
+<em class=def id="inb">inb</em> loc input
</pre>
+<p>These are the "generic" input and output functions.
+out-any adds its "data" argument (a sound sample) into the "output" object at sample
+position "loc".
+The "output" argument can be a vector as well as the more usual frample->file object.
+or any output-capable CLM generator.
+In with-sound, the current output is *output* and the reverb output is *reverb*.
+outa is the same as out-any with a channel of 0. It is not an error to try to write to a channel that doesn't exist;
+the function just returns.
+</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<p>in-any returns the sample at position "loc" in
+"input". ina is the same as in-any with a channel of 0.
+As in out-any and friends, the "input" argument can be a file->frample object, or a vector.
+</p>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
- (let ((infile
- (make-file->sample "oboe.snd")))
- (do ((i 0 (+ 1 i)))
+ (let ((infile (make-file->sample "oboe.snd")))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(out-any i (in-any i 0 infile) 0))))
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
infile = make_file2sample("oboe.snd");
44100.times do |i|
- out_any(i, in_any(i, 0, infile),
- 0, $output);
+ out_any(i, in_any(i, 0, infile), 0, $output);
end
end.output
</pre>
+</div>
</td>
+</tr><tr>
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
"oboe.snd" make-file->sample { infile }
44100 0 do
@@ -8231,120 +7781,86 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>These are the "generic" input and output functions.
-out-any adds its "data" argument (a sound sample) into the "output" object at sample
-position "loc".
-The "output" argument can be a vct, a vector, a sound-data object, or a function, as well as the more usual frame->file object.
-or any output-capable CLM generator.
-In with-sound, the current output is *output* and the reverb output is *reverb*.
-outa is the same as out-any with a channel of 0. It is not an error to try to write to a channel that doesn't exist;
-the function just returns.
-</p>
-
-<p>in-any returns the sample at position "loc" in
-"input". ina is the same as in-any with a channel of 0.
-As in out-any and friends, the "input" argument can be a file->frame object, a vct, a vector, sound-data object, or a function.
-If "input" is a function, it should take two arguments, the location and the channel number.
-</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (simple-ina beg dur amp file)
- (let* ((start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (simple-ina beg dur amp file)
+ (let* ((start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(fil (<em class=red>make-file->sample</em> file)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i
- (* amp (<em class=red>in-any</em> i 0 fil))))))) ; same as (<em class=red>ina</em> i fil)
-
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i
+ (* amp (<em class=red>in-any</em> i 0 fil)))))) ; same as (<em class=red>ina</em> i fil)
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (simple-ina 0 1 .5 "oboe.snd"))
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> () (simple-ina 0 1 .5 "oboe.snd"))
</pre>
-</td></tr></table>
-<p>To write from <a href="sndscm.html#wsdoc">with-sound</a> to a vct or sound-data object, rather than a file,
+<p>To write from <a href="sndscm.html#wsdoc">with-sound</a> to a vector, rather than a file,
use its :output argument:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(with-sound (<em class=red>:output</em> (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 44100)) ; this sets *output*, the default output location
- (<a class=quiet href="sndscm.html#vdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_fmviolin_tip)">fm-violin</a> 0 1 440 .1))
-
-;; returns #<vct[len=44100]: 0.000 0.000 0.000 ...>
+<pre class="indented">
+(with-sound (<em class=red>:output</em> (make-float-vector 44100 0.0)) ; this sets *output*, the default output location
+ (<a class=quiet href="sndscm.html#vdoc">fm-violin</a> 0 1 440 .1))
</pre>
-</td></tr></table>
<p>If *output* is a function, it should take 3 arguments, the sample number, current output value, and channel.
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(let ((avg 0.0)
(samps 0))
- (with-sound (<em class=red>:output</em> (lambda (frame val chan) ; get the average of all the samples
+ (with-sound (<em class=red>:output</em> (lambda (frample val chan) ; get the average of all the samples
(set! avg (+ avg val))
(set! samps (+ 1 samps))
val))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((> i 10))
(<em class=red>outa</em> i (* i .1))))
(/ avg samps))
;; returns 0.5
</pre>
-</td></tr></table>
<p>Similarly, if in-any's "input" argument is a function, it takes the input location (sample number), and channel (0-based).
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(let ((input (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> "oboe.snd" :start 1000)))
- (with-sound (:output (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 10))
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+(let ((input (<a class=quiet href="#make-readin">make-readin</a> "oboe.snd" :start 1000)))
+ (with-sound ((make-float-vector 10 0.0))
+ (do ((i 0 (+ i 1)))
((= i 10))
(<em class=red>outa</em> i (<em class=red>ina</em> i (lambda (loc chn)
- (<a class=quiet href="#readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_readin_tip)">readin</a> input)))))))
+ (<a class=quiet href="#readin">readin</a> input)))))))
</pre>
-</td></tr></table>
-<table border=0 hspace=40><tr><td>
-<pre>
-(let ((outv (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 10)))
+<pre class="indented">
+(let ((outv (make-float-vector 10 0.0)))
(with-sound ()
- (<em class=red>run</em>
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (outa i (* i .1) (lambda (loc val chan)
- (set! (outv loc) val))))))
- outv) ; this is equivalent to using :output (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 10) as a with-sound argument
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (outa i (* i .1) (lambda (loc val chan)
+ (set! (outv loc) val)))))
+ outv) ; this is equivalent to using :output (make-float-vector 10 0.0) as a with-sound argument
</pre>
-</td></tr></table>
-
-<br><br>
-<A NAME="locsigdoc"></A>
-<!-- ---------------------------------------- LOCSIG ---------------------------------------- -->
+<!-- LOCSIG -->
<!-- INDEX make-locsig:Sound placement -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>locsig</h3></center></td></tr></table>
+<div class="innerheader" id="locsigdoc">locsig</div>
-<pre>
- <a class=def name="make-locsig">make-locsig</a>
+<pre class="indented">
+ <em class=def id="make-locsig">make-locsig</em>
(degree 0.0)
(distance 1.0)
(reverb 0.0) ; reverb amount
@@ -8352,38 +7868,63 @@ use its :output argument:
(revout *reverb*) ; reverb output generator or location
(channels (channels output))
(type mus-interp-linear)
- <a class=def name="locsig">locsig</a> loc i in-sig
- <a class=def name="locsig?">locsig?</a> loc
+ <em class=def id="locsig">locsig</em> loc i in-sig
+ <em class=def id="locsig?">locsig?</em> loc
- <a class=def name="locsig-ref">locsig-ref</a> loc chan
- <a class=def name="locsig-set!">locsig-set!</a> loc chan val
- <a class=def name="locsig-reverb-ref">locsig-reverb-ref</a> loc chan
- <a class=def name="locsig-reverb-set!">locsig-reverb-set!</a> loc chan val
+ <em class=def id="locsig-ref">locsig-ref</em> loc chan
+ <em class=def id="locsig-set!">locsig-set!</em> loc chan val
+ <em class=def id="locsig-reverb-ref">locsig-reverb-ref</em> loc chan
+ <em class=def id="locsig-reverb-set!">locsig-reverb-set!</em> loc chan val
- <a class=def name="move-locsig">move-locsig</a> loc degree distance
- <a class=def name="locsig-type">locsig-type</a> ()
+ <em class=def id="move-locsig">move-locsig</em> loc degree distance
+ <em class=def id="locsig-type">locsig-type</em> ()
</pre>
+<table class="method">
+<tr><td colspan=2 class="methodtitle">locsig methods</td></tr>
+<tr><td class="inner"><em class=gen>mus-data</em></td><td class="inner">output scalers (a float-vector)</td></tr>
+<tr><td class="inner"><em class=gen>mus-xcoeff</em></td><td class="inner">reverb scaler</td></tr>
+<tr><td class="inner"><em class=gen>mus-xcoeffs</em></td><td class="inner">reverb scalers (a float-vector)</td></tr>
+<tr><td class="inner"><em class=gen>mus-channels</em></td><td class="inner">output channels</td></tr>
+<tr><td class="inner"><em class=gen>mus-length</em></td><td class="inner">output channels</td></tr>
+</table>
+
+<p>locsig places a sound in
+an N-channel circle of speakers
+by scaling the respective channel amplitudes
+("that old trick <em>never</em> works"). It normally replaces <a href="#outa">out-any</a>.
+"reverb" determines how much of
+the direct signal gets sent to the reverberator. "distance" tries to
+imitate a distance cue by fooling with the relative amounts of direct and
+reverberated signal (independent of the "reverb" argument). The distance should
+be greater than or equal to 1.0.
+"type" (returned by the function locsig-type) can be <code>mus-interp-linear</code> (the default) or <code>mus-interp-sinusoidal</code>.
+The mus-interp-sinusoidal
+case uses sin and cos to set the respective channel amplitudes (this is reported to
+help with the "hole-in-the-middle" problem).
+The "output" argument can be a vector as well as a frample->file generator.
+</p>
-<table border=1 bordercolor="lightgray" hspace=20 cellspacing=2 cellpadding=5>
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t :channels 2)
(let ((loc (make-locsig 60.0))
(osc (make-oscil 440.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(locsig loc i
(* 0.5 (oscil osc))))))
</pre>
+</div>
</td>
-
-<td width=4></td>
-
-<td bgcolor="#fbfbf0">
-<pre>
+</tr><tr>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true, :channels, 2) do
loc = make_locsig(60.0, :output, $output);
osc = make_oscil(440.0);
@@ -8392,12 +7933,12 @@ with_sound(:play, true, :channels, 2) do
end
end.output
</pre>
+</div>
</td>
-
-<td width=4></td>
-
-<td bgcolor="#effdef">
-<pre>
+</tr><tr>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
60.0 make-locsig { loc }
440.0 make-oscil { osc }
@@ -8406,81 +7947,52 @@ lambda: ( -- )
loop
; :play #t :channels 2 with-sound drop
</pre>
+</div>
</td>
</tr>
</table>
-
-<p>locsig places a sound in
-an N-channel circle of speakers
-by scaling the respective channel amplitudes
-("that old trick <i>never</i> works"). It normally replaces <a href="#outa">out-any</a>.
-</p>
-
-<table border=1 cellpadding=4 hspace=40>
-<tr><td colspan=2 bgcolor="beige"><center>locsig methods</center></td></tr>
-<tr><td><em class=gen>mus-data</em></td><td>output scalers (a vct)</td></tr>
-<tr><td><em class=gen>mus-xcoeff</em></td><td>reverb scaler</td></tr>
-<tr><td><em class=gen>mus-xcoeffs</em></td><td>reverb scalers (a vct)</td></tr>
-<tr><td><em class=gen>mus-channels</em></td><td>output channels</td></tr>
-<tr><td><em class=gen>mus-length</em></td><td>output channels</td></tr>
-</table>
-
-<p>"reverb" determines how much of
-the direct signal gets sent to the reverberator. "distance" tries to
-imitate a distance cue by fooling with the relative amounts of direct and
-reverberated signal (independent of the "reverb" argument). The distance should
-be greater than or equal to 1.0.
-"type" (returned by the function locsig-type) can be <code>mus-interp-linear</code> (the default) or <code>mus-interp-sinusoidal</code>.
-The mus-interp-sinusoidal
-case uses sin and cos to set the respective channel amplitudes (this is reported to
-help with the "hole-in-the-middle" problem).
-The "output" argument can be a vct or a sound-data object, as well as a frame->file generator.
-</p>
-
<p>Locsig can send output to any number of channels.
If channels > 2, the speakers are assumed to be evenly spaced in
a circle.
-You can use locsig-set! and locsig-ref to override the placement decisions.
+You can use locsig-set! to override the placement decisions.
To have full output to both channels,</p>
-<pre>
-(set! (locsig-ref loc 0) 1.0) ; or (<a class=quiet href="#locsig-set!" onmouseout="UnTip()" onmouseover="Tip(sndclm_locsig_set_tip)">locsig-set!</a> loc 0 1.0)
-(set! (locsig-ref loc 1) 1.0)
+
+<pre class="indented">
+(locsig-set! loc 0 1.0)
+(locsig-set! loc 1 1.0)
</pre>
<p>Here is an instrument that has envelopes on the distance and degrees, and optionally reverberates a file:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (space file onset duration (distance-env '(0 1 100 10)) (amplitude-env '(0 1 100 1))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (space file onset duration (distance-env '(0 1 100 10)) (amplitude-env '(0 1 100 1))
(degree-env '(0 45 50 0 100 90)) (reverb-amount .05))
- (let* ((beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> onset))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> duration)))
+ (let* ((beg (<a class=quiet href="#secondstosamples">seconds->samples</a> onset))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> duration)))
(loc (<em class=red>make-locsig</em> :degree 0 :distance 1 :reverb reverb-amount))
- (rdA (<a class=quiet href="#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> :file file))
- (dist-env (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> distance-env :duration duration))
- (amp-env (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> amplitude-env :duration duration))
- (deg-env (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> degree-env :scaler (/ 1.0 90.0) :duration duration))
+ (rdA (<a class=quiet href="#make-readin">make-readin</a> :file file))
+ (dist-env (<a class=quiet href="#make-env">make-env</a> distance-env :duration duration))
+ (amp-env (<a class=quiet href="#make-env">make-env</a> amplitude-env :duration duration))
+ (deg-env (<a class=quiet href="#make-env">make-env</a> degree-env :scaler (/ 1.0 90.0) :duration duration))
(dist-scaler 0.0))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i beg (+ 1 i)))
- ((= i end))
- (let ((rdval (* (<a class=quiet href="#readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_readin_tip)">readin</a> rdA) (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> amp-env)))
- (degval (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> deg-env))
- (distval (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> dist-env)))
- (set! dist-scaler (/ 1.0 distval))
- (set! (<em class=red>locsig-ref</em> loc 0) (* (- 1.0 degval) dist-scaler))
- (if (> (channels <a class=quiet onmouseout="UnTip()" onmouseover="Tip(sndclm_output_tip)">*output*</a>) 1)
- (set! (<em class=red>locsig-ref</em> loc 1) (* degval dist-scaler)))
- (if <a class=quiet onmouseout="UnTip()" onmouseover="Tip(sndclm_reverb_tip)">*reverb*</a>
- (set! (<em class=red>locsig-reverb-ref</em> loc 0) (* reverb-amount (sqrt dist-scaler))))
- (<em class=red>locsig</em> loc i rdval))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb jc-reverb :channels 2)
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((rdval (* (<a class=quiet href="#readin">readin</a> rdA) (<a class=quiet href="#env">env</a> amp-env)))
+ (degval (<a class=quiet href="#env">env</a> deg-env))
+ (distval (<a class=quiet href="#env">env</a> dist-env)))
+ (set! dist-scaler (/ 1.0 distval))
+ (locsig-set! loc 0 (* (- 1.0 degval) dist-scaler))
+ (if (> (channels <a class=quiet>*output*</a>) 1)
+ (locsig-set! loc 1 (* degval dist-scaler)))
+ (if <a class=quiet>*reverb*</a>
+ (locsig-reverb-set! loc 0 (* reverb-amount (sqrt dist-scaler))))
+ (<em class=red>locsig</em> loc i rdval)))))
+
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:reverb jc-reverb :channels 2)
(space "pistol.snd" 0 3 :distance-env '(0 1 1 2) :degree-env '(0 0 1 90)))
</pre>
-</td></tr></table>
<p>For a moving sound
source, see either move-locsig, Fernando Lopez Lezcano's <a class=def href="http://ccrma.stanford.edu/~nando/clm/dlocsig/index.html">dlocsig</a>,
@@ -8488,58 +8000,79 @@ or <a href="#flocsig">flocsig</a> (flanged locsig) in generators.scm.
Here is an example of move-locsig:
</p>
-<table border=0 cellspacing=15><tr><td>
-<table border=0><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 4)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 4)
(let ((loc (<em class=red>make-locsig</em>))
- (osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 440.0))
+ (osc (<a class=quiet href="#make-oscil">make-oscil</a> 440.0))
(j 0))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a> ; 360 notes one at each degree in a circle
- (do ((i 0 (+ 1 i)))
- ((= i 360))
- (do ((k 0 (+ 1 k)))
- ((= k 1000))
- (let ((sig (* .5 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc))))
- (<em class=red>locsig</em> loc j sig)
- (set! j (+ 1 j))))
- (<em class=red>move-locsig</em> loc (* 1.0 i) 1.0)))))
+ (do ((i 0 (+ i 1)))
+ ((= i 360))
+ (do ((k 0 (+ k 1)))
+ ((= k 1000))
+ (let ((sig (* .5 (<a class=quiet href="#oscil">oscil</a> osc))))
+ (<em class=red>locsig</em> loc j sig)
+ (set! j (+ j 1))))
+ (<em class=red>move-locsig</em> loc (* 1.0 i) 1.0))))
</pre>
-</td></tr></table>
-</td><td>
-<img src="pix/circle.png" alt="move-locsig example">
-<br><center>linear interp</center>
-</td>
+<table>
+<tr>
+<td><img class="indented" src="pix/circle.png" alt="move-locsig example"></td>
+<td><img class="indented" src="pix/locsine.png" alt="move-locsig example"></td>
+</tr><tr>
+<td class="center">linear interp</td>
+<td class="center">sinusoidal interp</td>
+</tr></table>
-<td>
-<img src="pix/locsine.png" alt="move-locsig example">
-<br><center>sinusoidal interp</center>
-</td>
+<p>The interaction of outa, locsig, and *reverb* seems to be causing confusion, so here are some
+simple examples:
+</p>
-</tr></table>
+<pre class="indented">
+(load "nrev.scm")
+
+(define (simp start end freq amp)
+ (let ((os (make-oscil freq)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (let ((output (* amp (oscil os))))
+ (outa i output)
+ (if *reverb* (outa i (* output .1) *reverb*))))))
-<br><br>
+; (with-sound () (simp 0 44100 440 .1)) ; no reverb
+; (with-sound (:reverb nrev) (simp 0 44100 440 .1)); reverb
+(define (locsimp start end freq amp)
+ (let ((os (make-oscil freq))
+ (loc (make-locsig :reverb .1)))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (locsig loc i (* amp (oscil os))))))
+; (with-sound () (locsimp 0 44100 440 .1)) ; no reverb
+; (with-sound (:reverb nrev) (locsimp 0 44100 440 .1)); reverb
+</pre>
-<A NAME="move-sounddoc"></A>
-<!-- ---------------------------------------- MOVE-SOUND ---------------------------------------- -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>move-sound</h3></center></td></tr></table>
-<pre>
- <a class=def name="make-move-sound">make-move-sound</a> dlocs-list (output *output*) (revout *reverb*)
- <a class=def name="move-sound">move-sound</a> dloc i in-sig
- <a class=def name="move-sound?">move-sound?</a> dloc
+
+<!-- MOVE-SOUND -->
+
+<div class="innerheader" id="move-sounddoc">move-sound</div>
+
+<pre class="indented">
+<em class=def id="make-move-sound">make-move-sound</em> dlocs-list (output *output*) (revout *reverb*)
+<em class=def id="move-sound">move-sound</em> dloc i in-sig
+<em class=def id="move-sound?">move-sound?</em> dloc
</pre>
<p>move-sound is intended as the run-time portion of <a href="sndscm.html#dlocsigdoc">dlocsig</a>. make-dlocsig
creates a move-sound structure, passing it to the move-sound generator inside the
dlocsig macro. All the necessary data is packaged up in a list:
</p>
-<pre>
+
+<pre class="indented">
(list
(start 0) ; absolute sample number at which samples first reach the listener
(end 0) ; absolute sample number of end of input samples
@@ -8556,41 +8089,34 @@ dlocsig macro. All the necessary data is packaged up in a list:
<p>Here's an instrument that uses this generator to pan a sound through four channels:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (simple-dloc beg dur freq amp)
- "(simple-dloc-4 beg dur freq amp) test instrument for dlocsig"
- (let* ((os (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq))
- (start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
+ (let* ((os (<a class=quiet href="#make-oscil">make-oscil</a> freq))
+ (start (<a class=quiet href="#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="#secondstosamples">seconds->samples</a> dur)))
(loc (<em class=red>make-move-sound</em> (list start end 4 0
- (<a class=quiet href="#make-delay" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_delay_tip)">make-delay</a> 12)
- (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 10 1) :length dur)
+ (<a class=quiet href="#make-delay">make-delay</a> 12)
+ (<a class=quiet href="#make-env">make-env</a> '(0 0 10 1) :length dur)
#f
(make-vector 4 #f)
- (vector (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 0 3 0 4 0) :duration dur)
- (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 0 2 1 3 0 4 0) :duration dur)
- (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 0 2 0 3 1 4 0) :duration dur)
- (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 0 2 0 3 0 4 1) :duration dur))
+ (vector (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 2 0 3 0 4 0) :duration dur)
+ (<a class=quiet href="#make-env">make-env</a> '(0 0 1 0 2 1 3 0 4 0) :duration dur)
+ (<a class=quiet href="#make-env">make-env</a> '(0 0 1 0 2 0 3 1 4 0) :duration dur)
+ (<a class=quiet href="#make-env">make-env</a> '(0 0 1 0 2 0 3 0 4 1) :duration dur))
#f
(vector 0 1 2 3)))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i end))
- (<em class=red>move-sound</em> loc i (* amp (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os)))))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<em class=red>move-sound</em> loc i (* amp (<a class=quiet href="#oscil">oscil</a> os))))))
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 4) (simple-dloc 0 2 440 .5))
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 4) (simple-dloc 0 2 440 .5))
</pre>
-</td></tr></table>
-
-<br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h2>Generic Functions</h2></td></tr></table>
-<A NAME="genericfunctions"></A>
+<div class="header" id="genericfunctions">Generic functions</div>
-<!-- ---------------------------------------- GENERIC FUNCTIONS ---------------------------------------- -->
+<!-- GENERIC FUNCTIONS -->
<p>Besides the 30 or so built-in generators, there are around 100 others defined in generators.scm. If we
@@ -8601,93 +8127,78 @@ frequency, for any generator that has some sort of frequency field.
The generic functions are:
</p>
-<table bordercolor="#f2f4ff" border=2 cellpadding=10 hspace=40><tr><td>
-
-<table cellspacing=0 cellpadding=0>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-channel">mus-channel</a></td><td width=30 bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">channel being read/written</td></tr>
-<tr><td><a class=def name="mus-channels">mus-channels</a></td><td></td><td>channels open</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-data">mus-data</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">vct of data</td></tr>
-<tr><td><a class=def name="mus-describe">mus-describe</a></td><td></td><td>description of current state</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-feedback">mus-feedback</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">feedback coefficient</td></tr>
-<tr><td><a class=def name="mus-feedforward">mus-feedforward</a></td><td></td><td>feedforward coefficient</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-file-name">mus-file-name</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">file being read/written</td></tr>
-<tr><td><a class=def name="mus-frequency">mus-frequency</a></td><td></td><td>frequency (Hz)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-hop">mus-hop</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">hop size for block processing</td></tr>
-<tr><td><a class=def name="mus-increment">mus-increment</a></td><td></td><td>various increments</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-interp-type">mus-interp-type</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">interpolation type (mus-interp-linear, etc)</td></tr>
-<tr><td><a class=def name="mus-length">mus-length</a></td><td></td><td>data length</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-location">mus-location</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">sample location for reads/writes</td></tr>
-<tr><td><a class=def name="mus-name">mus-name</a></td><td></td><td>generator name ("oscil")</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-offset">mus-offset</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">envelope offset</td></tr>
-<tr><td><a class=def name="mus-order">mus-order</a></td><td></td><td>filter order</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-phase">mus-phase</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">phase (radians)</td></tr>
-<tr><td><a class=def name="mus-ramp">mus-ramp</a></td><td></td><td>granulate grain envelope ramp setting</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-reset">mus-reset</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">set gen to default starting state</td></tr>
-<tr><td><a class=def name="mus-run">mus-run</a></td><td></td><td>run any generator</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-safety">mus-safety</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">experiment for multithread output</td></tr>
-
-<tr><td><a class=def name="mus-scaler">mus-scaler</a></td><td></td><td>scaler, normally on an amplitude</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-width">mus-width</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">width of interpolation tables, etc</td></tr>
-<tr><td><a class=def name="mus-xcoeff">mus-xcoeff</a></td><td></td><td>x (input) coefficient</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-xcoeffs">mus-xcoeffs</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">vct of x (input) coefficients</td></tr>
-<tr><td><a class=def name="mus-ycoeff">mus-ycoeff</a></td><td></td><td>y (output, feedback) coefficient</td></tr>
-<tr><td bgcolor="#f2f4ff"><a class=def name="mus-ycoeffs">mus-ycoeffs</a></td><td bgcolor="#f2f4ff"></td><td bgcolor="#f2f4ff">vct of y (feedback) coefficients</td></tr>
+<table class="method">
+<tr><td><em class=def id="mus-channel">mus-channel</em></td><td>channel being read/written</td></tr>
+<tr><td><em class=def id="mus-channels">mus-channels</em></td><td>channels open</td></tr>
+<tr><td><em class=def id="mus-copy">mus-copy</em></td><td>copy a generator</td></tr>
+<tr><td><em class=def id="mus-data">mus-data</em></td><td>float-vector of data</td></tr>
+<tr><td><em class=def id="mus-describe">mus-describe</em></td><td>description of current state</td></tr>
+<tr><td><em class=def id="mus-feedback">mus-feedback</em></td><td>feedback coefficient</td></tr>
+<tr><td><em class=def id="mus-feedforward">mus-feedforward</em></td><td>feedforward coefficient</td></tr>
+<tr><td><em class=def id="mus-file-name">mus-file-name</em></td><td>file being read/written</td></tr>
+<tr><td><em class=def id="mus-frequency">mus-frequency</em></td><td>frequency (Hz)</td></tr>
+<tr><td><em class=def id="mus-hop">mus-hop</em></td><td>hop size for block processing</td></tr>
+<tr><td><em class=def id="mus-increment">mus-increment</em></td><td>various increments</td></tr>
+<tr><td><em class=def id="mus-interp-type">mus-interp-type</em></td><td>interpolation type (mus-interp-linear, etc)</td></tr>
+<tr><td><em class=def id="mus-length">mus-length</em></td><td>data length</td></tr>
+<tr><td><em class=def id="mus-location">mus-location</em></td><td>sample location for reads/writes</td></tr>
+<tr><td><em class=def id="mus-name">mus-name</em></td><td>generator name ("oscil")</td></tr>
+<tr><td><em class=def id="mus-offset">mus-offset</em></td><td>envelope offset</td></tr>
+<tr><td><em class=def id="mus-order">mus-order</em></td><td>filter order</td></tr>
+<tr><td><em class=def id="mus-phase">mus-phase</em></td><td>phase (radians)</td></tr>
+<tr><td><em class=def id="mus-ramp">mus-ramp</em></td><td>granulate grain envelope ramp setting</td></tr>
+<tr><td><em class=def id="mus-reset">mus-reset</em></td><td>set gen to default starting state</td></tr>
+<tr><td><em class=def id="mus-run">mus-run</em></td><td>run any generator</td></tr>
+<tr><td><em class=def id="mus-scaler">mus-scaler</em></td><td>scaler, normally on an amplitude</td></tr>
+<tr><td><em class=def id="mus-width">mus-width</em></td><td>width of interpolation tables, etc</td></tr>
+<tr><td><em class=def id="mus-xcoeff">mus-xcoeff</em></td><td>x (input) coefficient</td></tr>
+<tr><td><em class=def id="mus-xcoeffs">mus-xcoeffs</em></td><td>float-vector of x (input) coefficients</td></tr>
+<tr><td><em class=def id="mus-ycoeff">mus-ycoeff</em></td><td>y (output, feedback) coefficient</td></tr>
+<tr><td><em class=def id="mus-ycoeffs">mus-ycoeffs</em></td><td>float-vector of y (feedback) coefficients</td></tr>
</table>
-</td></tr></table>
-
<p>Many of these are settable:
<code>(set! (mus-frequency osc1) 440.0)</code>
-sets osc1's phase increment to (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 440.0).
+sets osc1's phase increment to (<a class=quiet href="#hztoradians">hz->radians</a> 440.0).
When I have a cold, I sometimes use the following function to see how high I can hear; count
the audible tones and multiply by 1000:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (quick-check)
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let ((gen (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 1000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 400000))
- (if (= (modulo i 20000) 0)
- (set! (<em class=red>mus-frequency</em> gen) (+ 1000 (/ i 20))))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .5 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> gen))))))))
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (let ((gen (<a class=quiet href="#make-oscil">make-oscil</a> 1000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 400000))
+ (if (= (modulo i 20000) 0)
+ (set! (<em class=red>mus-frequency</em> gen) (+ 1000 (/ i 20))))
+ (<a class=quiet href="#outa">outa</a> i (* .5 (<a class=quiet href="#oscil">oscil</a> gen)))))))
</pre>
-</td></tr></table>
<p>Another example is run-with-fm-and-pm in generators.scm which applies phase modulation (as well as
the default frequency modulation) to any generator:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (run-with-fm-and-pm gen fm pm)
(set! (<em class=red>mus-phase</em> gen) (+ (<em class=red>mus-phase</em> gen) pm))
(let ((result (<em class=red>mus-run</em> gen fm 0.0)))
(set! (<em class=red>mus-phase</em> gen) (- (<em class=red>mus-phase</em> gen) pm))
result))
</pre>
-</td></tr></table>
<p>
-<a class=def name="musgeneratorp">mus-generator?</a> returns #t if its argument is
+<em class=def id="musgeneratorp">mus-generator?</em> returns #t if its argument is
a generator.
-A generator defined via <a href="#defgenerator">defgenerator</a> can take part in these methods.
-If the last element of the list (returned by defgenerator) is an association list, the generic functions
-will search that list for their name, and use the functions that follow to implement their method.
+A generator defined via <a href="#defgenerator">defgenerator</a> can also take part in these methods.
</p>
-<br>
-<br><br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h2>Other Generators</h2></td></tr></table>
-<A NAME="othergenerators"></A>
-<!-- ---------------------------------------- OTHER GENERATORS ---------------------------------------- -->
+<div class="header" id="othergenerators">Other generators</div>
+
+<!-- OTHER GENERATORS -->
<p>(this section is work in progress...)
</p>
@@ -8695,49 +8206,49 @@ will search that list for their name, and use the functions that follow to imple
<p>There are dozens of generators scattered around the *.scm files that come with Snd. Some that come to mind:
</p>
-<pre>
+<pre class="indented">
analog-filter.scm:
- filter: <a class=quiet href="sndscm.html#analogfilterdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_analogfilterdoc_tip)">butterworth-lowpass|highpass|bandpass|bandstop</a>,
- <a class=quiet href="sndscm.html#analogfilterdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_analogfilterdoc_tip)">chebyshev-lowpass|highpass|bandpass|bandstop</a>,
- <a class=quiet href="sndscm.html#analogfilterdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_analogfilterdoc_tip)">inverse-chebyshev-lowpass|highpass|bandpass|bandstop</a>,
- <a class=quiet href="sndscm.html#analogfilterdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_analogfilterdoc_tip)">elliptic-lowpass|highpass|bandpass|bandstop</a>,
- <a class=quiet href="sndscm.html#analogfilterdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_analogfilterdoc_tip)">bessel-lowpass|highpass|bandpass|bandstop</a>
+ filter: <a class=quiet href="sndscm.html#analogfilterdoc">butterworth-lowpass|highpass|bandpass|bandstop</a>,
+ <a class=quiet href="sndscm.html#analogfilterdoc">chebyshev-lowpass|highpass|bandpass|bandstop</a>,
+ <a class=quiet href="sndscm.html#analogfilterdoc">inverse-chebyshev-lowpass|highpass|bandpass|bandstop</a>,
+ <a class=quiet href="sndscm.html#analogfilterdoc">elliptic-lowpass|highpass|bandpass|bandstop</a>,
+ <a class=quiet href="sndscm.html#analogfilterdoc">bessel-lowpass|highpass|bandpass|bandstop</a>
clm-ins.scm:
- <a class=quiet href="sndscm.html#rmsgain" onmouseout="UnTip()" onmouseover="Tip(sndscm_rmsgain_tip)">rms gain balance</a>
+ <a class=quiet href="sndscm.html#rmsgain">rms gain balance</a>
dsp.scm:
- fir-filter: <a class=quiet href="sndscm.html#hilberttransform" onmouseout="UnTip()" onmouseover="Tip(sndscm_hilberttransform_tip)">hilbert-transform</a>,
- <a class=quiet href="sndscm.html#makehighpass" onmouseout="UnTip()" onmouseover="Tip(sndscm_makehighpass_tip)">highpass, lowpass, bandpass, bandstop</a>,
- <a class=quiet href="sndscm.html#makedifferentiator" onmouseout="UnTip()" onmouseover="Tip(sndscm_makedifferentiator_tip)">differentiator</a>,
- <a class=quiet href="sndscm.html#makespencerfilter" onmouseout="UnTip()" onmouseover="Tip(sndscm_makespencerfilter_tip)">make-spencer-filter</a>,
- <a class=quiet href="sndscm.html#sgfilter" onmouseout="UnTip()" onmouseover="Tip(sndscm_sgfilter_tip)">savitzky-golay-filter</a>
+ fir-filter: <a class=quiet href="sndscm.html#hilberttransform">hilbert-transform</a>,
+ <a class=quiet href="sndscm.html#makehighpass">highpass, lowpass, bandpass, bandstop</a>,
+ <a class=quiet href="sndscm.html#makedifferentiator">differentiator</a>,
+ <a class=quiet href="sndscm.html#makespencerfilter">make-spencer-filter</a>,
+ <a class=quiet href="sndscm.html#sgfilter">savitzky-golay-filter</a>
- filter: <a class=quiet href="sndscm.html#makebutter" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebutter_tip)">butter-high-pass, butter-low-pass, butter-band-pass, butter-band-reject</a>,
- <a class=quiet href="sndscm.html#makebiquad" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebiquad_tip)">biquad</a>,
- <a class=quiet href="sndscm.html#IIRfilters" onmouseout="UnTip()" onmouseover="Tip(sndscm_IIRfilters_tip)">iir-low-pass, iir-high-pass, iir-band-pass, iir-band-stop, peaking</a>,
- <a class=quiet href="sndscm.html#makebutter" onmouseout="UnTip()" onmouseover="Tip(sndscm_makebutter_tip)">butter-lp, butter-hp, butter-bp, butter-bs</a>
+ filter: <a class=quiet href="sndscm.html#makebutter">butter-high-pass, butter-low-pass, butter-band-pass, butter-band-reject</a>,
+ <a class=quiet href="sndscm.html#makebiquad">biquad</a>,
+ <a class=quiet href="sndscm.html#IIRfilters">iir-low-pass, iir-high-pass, iir-band-pass, iir-band-stop, peaking</a>,
+ <a class=quiet href="sndscm.html#makebutter">butter-lp, butter-hp, butter-bp, butter-bs</a>
- <a class=quiet href="sndscm.html#volterrafilter" onmouseout="UnTip()" onmouseover="Tip(sndscm_volterrafilter_tip)">volterra-filter</a>
+ <a class=quiet href="sndscm.html#volterrafilter">volterra-filter</a>
env.scm:
- <a class=quiet href="sndscm.html#powerenv" onmouseout="UnTip()" onmouseover="Tip(sndscm_powerenv_tip)">power-env</a> (and many env makers/modifiers)
+ <a class=quiet href="sndscm.html#powerenv">power-env</a> (and many env makers/modifiers)
extensions.scm:
- <a class=quiet href="sndscm.html#envexptchannel" onmouseout="UnTip()" onmouseover="Tip(sndscm_envexptchannel_tip)">env-expt-channel</a> (and many related env modifiers)
+ <a class=quiet href="sndscm.html#envexptchannel">env-expt-channel</a> (and many related env modifiers)
examp.scm:
- <a class=quiet href="sndscm.html#makeramp" onmouseout="UnTip()" onmouseover="Tip(sndscm_makeramp_tip)">ramp</a>,
- <a class=quiet href="sndscm.html#soundinterp" onmouseout="UnTip()" onmouseover="Tip(sndscm_soundinterp_tip)">sound-interp</a>
+ <a class=quiet href="sndscm.html#makeramp">ramp</a>,
+ <a class=quiet href="sndscm.html#soundinterp">sound-interp</a>
moog.scm:
- <a class=quiet href="sndscm.html#moogfilter" onmouseout="UnTip()" onmouseover="Tip(sndscm_moogfilter_tip)">moog-filter</a>
+ <a class=quiet href="sndscm.html#moogfilter">moog-filter</a>
prc95.scm:
- <a class=quiet href="sndscm.html#prc95doc" onmouseout="UnTip()" onmouseover="Tip(sndscm_prc95doc_tip)">reed, bowtable, jettable, onep, lip, dc-block, delaya, delayl</a>
+ <a class=quiet href="sndscm.html#prc95doc">reed, bowtable, jettable, onep, lip, dc-block, delaya, delayl</a>
zip.scm:
- <a class=quiet href="sndscm.html#zipper" onmouseout="UnTip()" onmouseover="Tip(sndscm_zipper_tip)">zipper</a>
+ <a class=quiet href="sndscm.html#zipper">zipper</a>
</pre>
<p>In this section, we concentrate on the generators defined in generators.scm. Nearly all of them respond to the
@@ -8747,49 +8258,49 @@ amplitudes), and "ratio" (the ratio between the
frequency and the spacing between successive sidebands).
</p>
+<div class="separator"></div>
-<br>
-<pre style="background-color: #f2f4ff">
- <a class=def name="make-polyoid">make-polyoid</a>
+<pre class="indented">
+<em class=def id="make-polyoid">make-polyoid</em>
(frequency *clm-default-frequency*)
(partial-amps-and-phases '(1 1 0.0)) ; a list of harmonic numbers, their associated amplitudes, and their initial-phases
- <a class=def name="polyoid">polyoid</a> w (fm 0.0)
- <a class=def name="polyoid?">polyoid?</a> w
+<em class=def id="polyoid">polyoid</em> w (fm 0.0)
+<em class=def id="polyoid?">polyoid?</em> w
- <a class=def name="polyoidenv">polyoid-env</a> w fm amps phases
+<em class=def id="polyoidenv">polyoid-env</em> w fm amps phases
- <a class=def name="make-noid">make-noid</a> (frequency 0.0) (n 1) phases
- <a class=def name="noid">noid</a> w (fm 0.0)
+<em class=def id="make-noid">make-noid</em> (frequency 0.0) (n 1) phases
+<em class=def id="noid">noid</em> w (fm 0.0)
</pre>
<p>polyoid combines the first and second Chebyshev polynomials to provide
a sum of sinusoids each with arbitrary amplitude and initial-phase.
noid is a wrapper for polyoid that sets up n equal amplitude components, a generalization
of <a href="#ncosdoc">ncos and nsin</a>.
-noid's phase argument can be a vct, <code>'min-peak</code>, <code>'max-peak</code>, or omitted (#f).
+noid's phase argument can be a float-vector, <code>'min-peak</code>, <code>'max-peak</code>, or omitted (#f).
If omitted, the phases are set to random numbers between 0 and 2 pi; if
-a vct, the vct's values are used as the phases; if 'max-peak, all phases are set
-to pi/2 (ncos essentially — use <code>(make-vct n 0.0)</code> to get nsin);
+a float-vector, the float-vector's values are used as the phases; if 'max-peak, all phases are set
+to pi/2 (ncos essentially — use <code>(make-float-vector n 0.0)</code> to get nsin);
and if 'min-peak, the minimum peak amplitude phases in <a href="sndscm.html#peakphasesdoc">peak-phases.scm</a> are used.
In the 'min-peak and 'max-peak cases, noid's output is normalized to fall between -1.0 and 1.0.
polyoid-env is an extension of polyoid that takes envelopes to control the amplitude and phase of each
harmonic.
</p>
-<img src="pix/noidchoices.png" alt="noid choices" hspace=20>
+<img src="pix/noidchoices.png" alt="noid choices">
<!--
run -horizontal
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 4))
(with-sound (:clipped #f :output (string-append "test-noid-" (number->string i) ".snd"))
(let ((samps 44100)
(gen (make-noid 100.0 32 (if (= i 0) 'max-peak
- (if (= i 1) (make-vct 32 0.0)
+ (if (= i 1) (make-float-vector 32 0.0)
(if (= i 2) #f
'min-peak))))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(outa i (noid gen 0.0))))))
-->
@@ -8798,14 +8309,14 @@ harmonic.
set of components and component amplitudes. We could, for example, change noid to use
</p>
-<pre>
- (set! (amps (+ j 1)) (/ (expt r (- i 1)) norm))
+<pre class="indented">
+(set! (amps (+ j 1)) (/ (expt r (- i 1)) norm))
</pre>
<p>where "r" is the ratio between successive component amplitude: "nroid"?
This is not as pointless as it might at first appear. Many of these waveforms actually
sound different, despite having the same (magnitude) spectrum; the minimum peak
-version usually sounds raspier, and in the limit it sounds like white noise!
+version usually sounds raspier, and in the limit it can sound like white noise!
</p>
<!--
@@ -8816,7 +8327,7 @@ version usually sounds raspier, and in the limit it sounds like white noise!
(gen2 (make-noid 40.0 128 'min-peak))
(ampf (make-env '(0 0 .1 1 1 1 2 .25 3 .25) :scaler 0.5 :duration dur))
(indf (make-env '(0 0 1 0 2 1 3 1) :duration dur)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(let ((ind (env indf)))
(outa i (* (env ampf)
@@ -8827,125 +8338,106 @@ version usually sounds raspier, and in the limit it sounds like white noise!
-->
<!--
-<img src="noid2.png">
+<img class="indented" src="noid2.png">
-->
<p>Check out the n=1024 case:
</p>
-<table border=0 cellpadding=5 hspace=20><tr>
-<td><pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((samps 44100)
(gen (<em class=red>make-noid</em> 10.0 1024 'min-peak)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* 0.5 (<em class=red>noid</em> gen 0.0))))))
-</pre></td></tr></table>
-
-<br>
+ (<a class=quiet href="#outa">outa</a> i (* 0.5 (<em class=red>noid</em> gen 0.0))))))
+</pre>
+<div class="separator"></div>
-<br>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-asyfm">make-asyfm</A> (frequency 0.0) (ratio 1.0) (r 1.0) (index 1.0)
- <A class=def NAME="asyfmJ">asyfm-J</A> gen (fm 0.0)
- <A class=def NAME="asyfmI">asyfm-I</A> gen (fm 0.0)
- <A class=def NAME="asyfm?">asyfm?</A> gen
+<pre class="indented">
+<em class=def id="make-asyfm">make-asyfm</em> (frequency 0.0) (ratio 1.0) (r 1.0) (index 1.0)
+<em class=def id="asyfmJ">asyfm-J</em> gen (fm 0.0)
+<em class=def id="asyfmI">asyfm-I</em> gen (fm 0.0)
+<em class=def id="asyfm?">asyfm?</em> gen
</pre>
<p>These two generators produce the two flavors of asymmetric-fm. asyfm-J is the same as the built-in asymmetric generator;
asyfm-I is the modified Bessel function version (the second formula in the <a href="#asymmetric-fm">asymmetric-fm</a> section).
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-fmssb">make-fmssb</A> (frequency 0.0) (ratio 1.0) (index 1.0)
- <A class=def NAME="fmssb">fmssb</A> gen (fm 0.0)
- <A class=def NAME="fmssb?">fmssb?</A> gen
+<pre class="indented">
+<em class=def id="make-fmssb">make-fmssb</em> (frequency 0.0) (ratio 1.0) (index 1.0)
+<em class=def id="fmssb">fmssb</em> gen (fm 0.0)
+<em class=def id="fmssb?">fmssb?</em> gen
</pre>
<p>This generator produces the "gapped" spectra mentioned in <a href="fm.html">fm.html</a>. It is used extensively in the
various "imaginary machines". Also included in this section of generators.scm is fpmc, an instrument
-that performs FM with a complex index (complex in the sense of complex numbers). It can be used
-in with-sound, but not within run (the run macro does not currently handle complex numbers).
-</p>
-<br>
-
-
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-pulsed-env">make-pulsed-env</A> envelope duration frequency
- <A class=def NAME="pulsedenv">pulsed-env</A> gen (fm 0.0)
- <A class=def NAME="pulsedenv?">pulsed-env?</A> gen
-</pre>
-
-<p>
-This produces a repeating envelope. <a href="#env">env</a> sticks at its last value, but pulsed-env repeats it over and over.
-"duration" is the envelope duration, and "frequency" is the repeitition rate, changeable via the "fm" argument to the pulsed-env generator.
-Many of the instruments in animals.scm use this generator. (In a sense, this is the original Music V OSC generator).
+that performs FM with a complex index (complex in the sense of complex numbers).
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-blackman">make-blackman</A> frequency n ; 1 <= n <= 10
- <A class=def NAME="blackman">blackman</A> gen (fm 0.0)
- <A class=def NAME="blackman?">blackman?</A> gen
+<pre class="indented">
+<em class=def id="make-blackman">make-blackman</em> frequency n ; 1 <= n <= 10
+<em class=def id="blackman">blackman</em> gen (fm 0.0)
+<em class=def id="blackman?">blackman?</em> gen
</pre>
<p>
This produces a Blackman-Harris sum of cosines of order 'n'. It could be viewed as a special case of pulsed-env, or
as yet another "kernel" along the lines of <a href="#ncos">ncos</a>.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-sinc-train">make-sinc-train</A> frequency (n 1)
- <a class=def name="sinc-train">sinc-train</a> gen (fm 0.0)
- <A class=def NAME="sinc-train?">sinc-train?</A> gen
+<pre class="indented">
+<em class=def id="make-sinc-train">make-sinc-train</em> frequency (n 1)
+<em class=def id="sinc-train">sinc-train</em> gen (fm 0.0)
+<em class=def id="sinc-train?">sinc-train?</em> gen
</pre>
<p>
This produces a sinc-train ((sin x)/x) with n components. It is very similar to <a href="#ncos">ncos</a>.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-pink-noise">make-pink-noise</A> (n 1)
- <a class=def name="pink-noise">pink-noise</a> gen
- <A class=def NAME="pink-noise?">pink-noise?</A> gen
+<pre class="indented">
+<em class=def id="make-pink-noise">make-pink-noise</em> (n 1)
+<em class=def id="pink-noise">pink-noise</em> gen
+<em class=def id="pink-noise?">pink-noise?</em> gen
</pre>
<p>
This produces a reasonable approximation to 1/f noise, also known as pink-noise. 'n' sets the number of octaves used (starting at the high end);
12 is the recommended choice. (If n=1, you get white noise).
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-brown-noise">make-brown-noise</A> frequency (amplitude 1.0)
- <a class=def name="brown-noise">brown-noise</a> gen
- <A class=def NAME="brown-noise?">brown-noise?</A> gen
+<pre class="indented">
+<em class=def id="make-brown-noise">make-brown-noise</em> frequency (amplitude 1.0)
+<em class=def id="brown-noise">brown-noise</em> gen
+<em class=def id="brown-noise?">brown-noise?</em> gen
</pre>
<p>
This produces (unbounded) brownian noise. 'amplitude' sets the maximum size of individual jumps.
</p>
-<br>
+<div class="separator"></div>
+<pre class="indented">
+<em class=def id="make-green-noise">make-green-noise</em> (frequency 0.0) (amplitude 1.0) (low -1.0) (high 1.0)
+<em class=def id="green-noise">green-noise</em> gen (fm 0.0)
+<em class=def id="green-noise?">green-noise?</em> gen
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-green-noise">make-green-noise</A> (frequency 0.0) (amplitude 1.0) (low -1.0) (high 1.0)
- <a class=def name="green-noise">green-noise</a> gen (fm 0.0)
- <A class=def NAME="green-noise?">green-noise?</A> gen
-
- <A class=def NAME="make-green-noise-interp">make-green-noise-interp</A> (frequency 0.0) (amplitude 1.0) (low -1.0) (high 1.0)
- <a class=def name="green-noise-interp">green-noise-interp</a> gen (fm 0.0)
- <A class=def NAME="green-noise-interp?">green-noise-interp?</A> gen
+<em class=def id="make-green-noise-interp">make-green-noise-interp</em> (frequency 0.0) (amplitude 1.0) (low -1.0) (high 1.0)
+<em class=def id="green-noise-interp">green-noise-interp</em> gen (fm 0.0)
+<em class=def id="green-noise-interp?">green-noise-interp?</em> gen
</pre>
<p>These two generators produce bounded brownian noise; "green-noise" was Michael McNabb's name for it.
@@ -8959,42 +8451,39 @@ the overall output bounds; 'frequency' controls how often a new random number is
Here's an instrument that fuzzes up its amplitude envelope a bit using green noise:
</p>
-<table border=0 cellpadding=5 hspace=20><tr>
-<td><pre>
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (green3 start dur freq amp amp-env noise-freq noise-width noise-max-step)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (green3 start dur freq amp amp-env noise-freq noise-width noise-max-step)
(let* ((grn (<em class=red>make-green-noise-interp</em> :frequency noise-freq
:amplitude noise-max-step
:high (* 0.5 noise-width) :low (* -0.5 noise-width)))
- (osc (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq))
- (e (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> amp-env :scaler amp :duration dur))
- (beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> start))
- (end (+ beg (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> e)
- (+ 1.0 (<em class=red>green-noise-interp</em> grn))
- (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc)))))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (green3 0 2.0 440 .5 '(0 0 1 1 2 1 3 0) 100 .2 .02))
-</pre></td></tr></table>
+ (osc (<a class=quiet href="#make-oscil">make-oscil</a> freq))
+ (e (<a class=quiet href="#make-env">make-env</a> amp-env :scaler amp :duration dur))
+ (beg (<a class=quiet href="#secondstosamples">seconds->samples</a> start))
+ (end (+ beg (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> e)
+ (+ 1.0 (<em class=red>green-noise-interp</em> grn))
+ (<a class=quiet href="#oscil">oscil</a> osc))))))
-<br>
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
+ (green3 0 2.0 440 .5 '(0 0 1 1 2 1 3 0) 100 .2 .02))
+</pre>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-adjustable-square-wave">make-adjustable-square-wave</A> frequency (duty-factor 0.5) (amplitude 1.0)
- <A class=def NAME="adjustable-square-wave">adjustable-square-wave</A> gen (fm 0.0)
- <A class=def NAME="adjustable-square-wave?">adjustable-square-wave?</A> gen
+<pre class="indented">
+<em class=def id="make-adjustable-square-wave">make-adjustable-square-wave</em> frequency (duty-factor 0.5) (amplitude 1.0)
+<em class=def id="adjustable-square-wave">adjustable-square-wave</em> gen (fm 0.0)
+<em class=def id="adjustable-square-wave?">adjustable-square-wave?</em> gen
- <A class=def NAME="make-adjustable-triangle-wave">make-adjustable-triangle-wave</A> frequency (duty-factor 0.5) (amplitude 1.0)
- <A class=def NAME="adjustable-triangle-wave">adjustable-triangle-wave</A> gen (fm 0.0)
- <A class=def NAME="adjustable-triangle-wave?">adjustable-triangle-wave?</A> gen
+<em class=def id="make-adjustable-triangle-wave">make-adjustable-triangle-wave</em> frequency (duty-factor 0.5) (amplitude 1.0)
+<em class=def id="adjustable-triangle-wave">adjustable-triangle-wave</em> gen (fm 0.0)
+<em class=def id="adjustable-triangle-wave?">adjustable-triangle-wave?</em> gen
- <A class=def NAME="make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</A> frequency (duty-factor 0.5) (amplitude 1.0)
- <A class=def NAME="adjustable-sawtooth-wave">adjustable-sawtooth-wave</A> gen (fm 0.0)
- <A class=def NAME="adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</A> gen
+<em class=def id="make-adjustable-sawtooth-wave">make-adjustable-sawtooth-wave</em> frequency (duty-factor 0.5) (amplitude 1.0)
+<em class=def id="adjustable-sawtooth-wave">adjustable-sawtooth-wave</em> gen (fm 0.0)
+<em class=def id="adjustable-sawtooth-wave?">adjustable-sawtooth-wave?</em> gen
</pre>
<p>
@@ -9003,7 +8492,7 @@ The other two are similar, producing triangle and sawtooth waves. There is also
Use mus-scaler to set the duty-factor at run-time.
</p>
-<img src="pix/adjustable.png" alt="mus-scaler adjusts" hspace=40>
+<img class="indented" src="pix/adjustable.png" alt="mus-scaler adjusts">
<!-- adjustable.png:
@@ -9019,8 +8508,7 @@ Use mus-scaler to set the duty-factor at run-time.
(samps (seconds->samples dur))
(ampf (make-env '(0 0 1 1 100 1 101 0) :duration dur))
(adjf (make-env '(0 .01 1 .99) :duration dur)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(let ((amp (env ampf))
(adj (env adjf))
@@ -9037,42 +8525,41 @@ Use mus-scaler to set the duty-factor at run-time.
(outb i (* amp (adjustable-sawtooth-wave sw)))
(outc i (* amp (adjustable-triangle-wave tr)))
(outd i (* amp (adjustable-oscil os)))
- )))
+ ))
))
-(set! (selected-graph-color) (make-color 1 1 1))
-(set! (selected-data-color) (make-color 0 0 0))
+(set! *selected-graph-color* (make-color 1 1 1))
+(set! *selected-data-color* (make-color 0 0 0))
(set! (x-axis-label 0 0) "adjustable-square-wave, duty-factor from .01 to .99")
(set! (x-axis-label 0 1) "adjustable-sawtooth-wave")
(set! (x-axis-label 0 2) "adjustable-triangle-wave")
(set! (x-axis-label 0 3) "adjustable-oscil")
-(set! (axis-numbers-font) (tiny-font))
-(set! (axis-label-font) "10x20")
+(set! *axis-numbers-font* *tiny-font*)
+(set! *axis-label-font* "10x20")
-->
<p>A similar trick can make, for example, a squared-off triangle-wave:
</p>
-<pre>
- (gen (<a class=quiet href="#make-triangle-wave">make-triangle-wave</a> 200.0 :amplitude 4)) ; amp sets slope
- ...
- (outa i (max -1.0 (min 1.0 (<a class=quiet href="#triangle-wave">triangle-wave</a> gen))))
+<pre class="indented">
+(gen (<a class=quiet href="#make-triangle-wave">make-triangle-wave</a> 200.0 :amplitude 4)) ; amp sets slope
+...
+(outa i (max -1.0 (min 1.0 (<a class=quiet href="#triangle-wave">triangle-wave</a> gen))))
</pre>
-<br>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-round-interp">make-round-interp</A> frequency n amplitude
- <A class=def NAME="round-interp">round-interp</A> gen (fm 0.0)
- <A class=def NAME="round-interp?">round-interp?</A> gen
+<pre class="indented">
+<em class=def id="make-round-interp">make-round-interp</em> frequency n amplitude
+<em class=def id="round-interp">round-interp</em> gen (fm 0.0)
+<em class=def id="round-interp?">round-interp?</em> gen
</pre>
<p>
This is a <a href="#rand-interp">rand-interp</a> generator feeding a <a href="#moving-average">moving-average</a> generator. "n" is the length of the moving-average;
the higher "n", the more low-passed the output.
</p>
-<img src="pix/roundinterp.png" alt="round-interp" hspace=40>
+<img class="indented" src="pix/roundinterp.png" alt="round-interp">
<!--
(with-sound (:channels 5)
@@ -9081,78 +8568,49 @@ the higher "n", the more low-passed the output.
(gen2 (make-round-interp 100 100))
(gen3 (make-round-interp 100 1000))
(gen4 (make-round-interp 100 10000)))
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100000))
(out-any i (round-interp gen0) 0)
(out-any i (round-interp gen1) 1)
(out-any i (round-interp gen2) 2)
(out-any i (round-interp gen3) 3)
- (out-any i (round-interp gen4) 4)))))
+ (out-any i (round-interp gen4) 4))))
(set! (x-axis-label 0 0) "round-interp, n=1")
(set! (x-axis-label 0 1) "round-interp, n=10")
(set! (x-axis-label 0 2) "round-interp, n=100")
(set! (x-axis-label 0 3) "round-interp, n=1000")
(set! (x-axis-label 0 4) "round-interp, n=10000")
-(set! (axis-label-font) "-*-times-medium-r-normal-*-20-*-*-*-*-*-*-*")
+(set! *axis-label-font* "-*-times-medium-r-normal-*-20-*-*-*-*-*-*-*")
-->
-<br>
-<br>
-
-
-<pre style="background-color: #f2f4ff">
- <A class=def>make-moving-max</A> (n 128)
- <a class=def name="moving-max">moving-max</a> gen y
- <A class=def>moving-max?</A> gen
+<div class="separator"></div>
- <A class=def>make-moving-sum</A> (n 128)
- <a class=def name="moving-sum">moving-sum</a> gen y
- <A class=def>moving-sum?</A> gen
- <A class=def>make-moving-rms</A> (n 128)
- <a class=def name="moving-rms">moving-rms</a> gen y
- <A class=def>moving-rms?</A> gen
+<pre class="indented">
+<A class=def>make-moving-sum</A> (n 128)
+<em class=def id="moving-sum">moving-sum</em> gen y
+<A class=def>moving-sum?</A> gen
- <A class=def>make-moving-length</A> (n 128)
- <a class=def name="moving-length">moving-length</a> gen y
- <A class=def>moving-length?</A> gen
+<A class=def>make-moving-rms</A> (n 128)
+<em class=def id="moving-rms">moving-rms</em> gen y
+<A class=def>moving-rms?</A> gen
- <A class=def>make-weighted-moving-average</A> n
- <a class=def name="weighted-moving-average">weighted-moving-average</a> gen y
- <A class=def>weighted-moving-average?</A> gen
-
- <A class=def>make-exponentially-weighted-moving-average</A> n
- <a class=def name="exponentially-weighted-moving-average">exponentially-weighted-moving-average</a> gen y
- <A class=def>exponentially-weighted-moving-average?</A> gen
-</pre>
+<A class=def>make-moving-length</A> (n 128)
+<em class=def id="moving-length">moving-length</em> gen y
+<A class=def>moving-length?</A> gen
-<p>
-moving-max is a specialization
-of the <a href="#delay">delay</a> generator; it produces an envelope that tracks the peak amplitude of the last 'n' samples.
-<code>(make-moving-max 256)</code> returns the generator (this one's window size is 256),
-and <code>(moving-max gen y)</code> then returns the envelope traced out by the signal 'y'.
-The <a href="sndscm.html#harmonicizer">harmonicizer</a> uses this generator to normalize an in-coming signal to 1.0
-so that the Chebyshev polynomials it is driving will produce a full spectrum at all times.
-Here is a similar, but simpler, example; we use the moving-max generator to track the
-current peak amplitude over a small window, use that value to drive a <a href="#contrast-enhancement">contrast-enhancement</a>
-generator (so that its output is always fully modulated), and rescale by the same value
-upon output (to track the original sound's amplitude envelope):
-</p>
+<A class=def>make-weighted-moving-average</A> n
+<em class=def id="weighted-moving-average">weighted-moving-average</em> gen y
+<A class=def>weighted-moving-average?</A> gen
-<pre>
- (define (intensify index)
- (let* ((mx (<em class=red>make-moving-max</em>))
- (flt (<a class=quiet href="sndscm.html#makelowpass" onmouseout="UnTip()" onmouseover="Tip(sndscm_makelowpass_tip)">make-lowpass</a> (* pi .1) 8))) ; smooth the maxamp signal
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y)
- (let ((amp (max .1 (<a class=quiet href="#fir-filter" onmouseout="UnTip()" onmouseover="Tip(sndclm_fir_filter_tip)">fir-filter</a> flt (<em class=red>moving-max</em> mx y)))))
- (* amp (<a class=quiet href="#contrast-enhancement" onmouseout="UnTip()" onmouseover="Tip(sndclm_contrast_enhancement_tip)">contrast-enhancement</a> (/ y amp) index)))))))
+<A class=def>make-exponentially-weighted-moving-average</A> n
+<em class=def id="exponentially-weighted-moving-average">exponentially-weighted-moving-average</em> gen y
+<A class=def>exponentially-weighted-moving-average?</A> gen
</pre>
<p>
-This can also be used for automatic gain control — see generators.scm for the agc function.
-The other "moving" generators are specializations of the <a href="#moving-average">moving-average</a>
+The "moving" generators are specializations of the <a href="#moving-average">moving-average</a>
generator. moving-sum keeps the ongoing sum of absolute values, moving-length the square root of the sum
of squares, and moving-rms the square root of the sum of squares divided by the size.
moving-rms is used in <a href="sndscm.html#overlayrmsenv">overlay-rms-env</a> in draw.scm.
@@ -9162,17 +8620,15 @@ actually just a one-pole filter — this generator wins the "longest-name-fo
Also defined, but not tested, is moving-variance; in the same mold, but not defined, are things like moving-inner-product and moving-distance.
</p>
-<br>
-<br>
<!-- bessel functions -->
-<table border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>Bessel functions</h5></center></td></tr></table>
+<div class="innerheader">Bessel functions</div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-bess">make-bess</A> (frequency 0.0) (n 0)
- <A class=def NAME="bess">bess</A> gen (fm 0.0)
- <A class=def NAME="bess?">bess?</A> gen
+<pre class="indented">
+<em class=def id="make-bess">make-bess</em> (frequency 0.0) (n 0)
+<em class=def id="bess">bess</em> gen (fm 0.0)
+<em class=def id="bess?">bess?</em> gen
</pre>
<!-- LATEX: & J_{n}(x) = \frac{a}{\sqrt{x}}\sin(x+\delta) + \frac{r_{n}(x)}{x^{\frac{3}{2}}} \\ -->
@@ -9182,7 +8638,7 @@ so bess's output is not the same as the raw bessel function value returned by <a
The "frequency" argument actually makes sense here because the Bessel functions
are close to damped sinusoids after their initial hesitation:
</p>
-<img src="pix/sceq24.png" alt="Jn" hspace=40>
+<img class="indented" src="pix/sceq24.png" alt="Jn">
<p>
where the variables other than x remain bounded as x increases. This explains, in a sketchy way, why Jn(cos) and Jn(Jn)
behave like FM. To see how close these are to FM, compare the expansion of J0(sin) with FM's cos(sin):
@@ -9194,7 +8650,7 @@ sceq35:
& \cos(B \sin x) = J_{0}(B) + 2 \sum_{k=1}^{\infty} J_{2k}(B) \cos 2kx \\
-->
-<img src="pix/sceq35.png" alt="J(sin) and cos(sin)" hspace=40>
+<img class="indented" src="pix/sceq35.png" alt="J(sin) and cos(sin)">
<p>Except for jpcos, the rest of the generators in this section suffer a similar fate. From a waveshaping perspective,
we're using a sinusoid, or a modulated sinusoid, to index into the near-zero portion of a Bessel
@@ -9202,13 +8658,13 @@ function, and the result is sadly reminiscent of standard FM. But they're such
I must be missing something.
</p>
-<br>
-<br>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-j0evencos">make-j0evencos</A> (frequency 0.0) (index 1.0)
- <A class=def NAME="j0evencos">j0evencos</A> gen (fm 0.0)
- <A class=def NAME="j0evencos?">j0evencos?</A> gen
+<div class="separator"></div>
+
+<pre class="indented">
+<em class=def id="make-j0evencos">make-j0evencos</em> (frequency 0.0) (index 1.0)
+<em class=def id="j0evencos">j0evencos</em> gen (fm 0.0)
+<em class=def id="j0evencos?">j0evencos?</em> gen
</pre>
<p>j0evencos produces the J0(index * sin(x)) case mentioned above (with the DC component subtracted out).
@@ -9218,33 +8674,28 @@ the individual component amplitudes to follow the Bessel functions half as fast.
So j0evencos produces a spectral sweep that is like FM's but smoother.
</p>
-<table border=0 hspace=40 cellspacing=20><tr><td>
-<img src="pix/j0fm.png" alt="compare FM and j0evencos">
-</td><td>
-<img src="pix/j0jfm.png" alt="compare FM and j0evencos">
-</td></tr>
-<tr> <td colspan=2>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2)
+<img class="indented" src="pix/j0fm.png" alt="compare FM and j0evencos">
+
+<img class="indented" src="pix/j0jfm.png" alt="compare FM and j0evencos">
+
+
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 2)
(let* ((dur 1.0)
- (end (<a class=quiet href="#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur))
+ (end (<a class=quiet href="#secondstosamples">seconds->samples</a> dur))
(jmd (<em class=red>make-j0evencos</em> 200.0))
- (fmd (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 200.0))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 20 1 21 0) :scaler 0.5 :duration dur))
- (indf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 20) :duration dur)))
- (do ((i 0 (+ 1 i)))
+ (fmd (<a class=quiet href="#make-oscil">make-oscil</a> 200.0))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 20 1 21 0) :scaler 0.5 :duration dur))
+ (indf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 20) :duration dur)))
+ (do ((i 0 (+ i 1)))
((= i end))
- (let ((ind (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf))
- (vol (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)))
- (set! (<em class=red>j0evencos-index</em> jmd) ind)
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* vol (- (cos (* ind (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> fmd)))
- (<a class=quiet href="extsnd.html#besj0" onmouseout="UnTip()" onmouseover="Tip(extsnd_besj0_tip)">bes-j0</a> ind)))) ; subtract out DC (see cos(B sin x) above)
- (<a class=quiet href="#out-any" onmouseout="UnTip()" onmouseover="Tip(sndclm_outb_tip)">outb</a> i (* vol (<em class=red>j0evencos</em> jmd)))))))
+ (let ((ind (<a class=quiet href="#env">env</a> indf))
+ (vol (<a class=quiet href="#env">env</a> ampf)))
+ (set! (<em class=red>jmd 'index</em>) ind)
+ (<a class=quiet href="#outa">outa</a> i (* vol (- (cos (* ind (<a class=quiet href="#oscil">oscil</a> fmd)))
+ (<a class=quiet href="extsnd.html#besj0">bes-j0</a> ind)))) ; subtract out DC (see cos(B sin x) above)
+ (<a class=quiet href="#out-any">outb</a> i (* vol (<em class=red>j0evencos</em> jmd)))))))
</pre>
-</td></tr>
-</table>
-
-
<!--
snd -horizontal
@@ -9255,15 +8706,14 @@ snd -horizontal
(md (make-oscil (* freq mc-ratio)))
(ampf (make-env '(0 0 1 1 20 1 21 0) :scaler amp :duration dur))
(indf (make-env index-env :scaler index :duration dur)))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
(let ((ind (env indf)))
(outa i (* (env ampf)
(- (cos (* ind (oscil md)))
- (bes-j0 ind)))))))))
+ (bes-j0 ind))))))))
-(with-sound (:output "test.snd") (fm 0 1.0 2000.0 0.5 .1 20.0 '(0 0 1 1)))
+(with-sound ("test.snd") (fm 0 1.0 2000.0 0.5 .1 20.0 '(0 0 1 1)))
(define* (jfm beg dur freq amp mc-ratio index (index-env '(0 1 100 1)))
(let* ((start (seconds->samples beg))
@@ -9271,14 +8721,13 @@ snd -horizontal
(md (make-j0evencos (* freq mc-ratio)))
(ampf (make-env '(0 0 1 1 20 1 21 0) :scaler amp :duration dur))
(indf (make-env index-env :scaler index :duration dur)))
- (run
- (do ((i start (+ 1 i)))
+ (do ((i start (+ i 1)))
((= i end))
- (set! (j0evencos-index md) (env indf))
+ (set! (md 'index) (env indf))
(outa i (* (env ampf)
- (j0evencos md)))))))
+ (j0evencos md))))))
-(with-sound (:output "test1.snd") (jfm 0 1.0 2000.0 0.5 .1 20.0 '(0 0 1 1)))
+(with-sound ("test1.snd") (jfm 0 1.0 2000.0 0.5 .1 20.0 '(0 0 1 1)))
x 314 1.36
y 327 .4
@@ -9286,56 +8735,54 @@ z 0 1.9
4 0.24
blackman6 2048
-(set! (selected-graph-color) (make-color 1 1 1))
+(set! *selected-graph-color* (make-color 1 1 1))
-->
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-j0j1cos">make-j0j1cos</A> (frequency 0.0) (index 0.0)
- <A class=def NAME="j0j1cos">j0j1cos</A> gen fm
- <A class=def NAME="j0j1cos?">j0j1cos?</A> gen
+<pre class="indented">
+<em class=def id="make-j0j1cos">make-j0j1cos</em> (frequency 0.0) (index 0.0)
+<em class=def id="j0j1cos">j0j1cos</em> gen fm
+<em class=def id="j0j1cos?">j0j1cos?</em> gen
</pre>
-<img src="pix/sceq36.png" alt="j0j1 formulsa" hspace=40>
+<img class="indented" src="pix/sceq36.png" alt="j0j1 formulsa">
<p>
This uses J0(index * cos(x)) + J1(index * cos(x)) to produce a full set of cosines. It is not yet normalized correctly,
and is very similar to normal FM.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-izcos">make-izcos</A> (frequency 0.0) (r 1.0)
- <A class=def NAME="izcos">izcos</A> gen (fm 0.0)
- <A class=def NAME="izcos?">izcos?</A> gen
+<pre class="indented">
+<em class=def id="make-izcos">make-izcos</em> (frequency 0.0) (r 1.0)
+<em class=def id="izcos">izcos</em> gen (fm 0.0)
+<em class=def id="izcos?">izcos?</em> gen
</pre>
-<img src="pix/sceq39.png" alt="I(k) sum" hspace=40>
+<img class="indented" src="pix/sceq39.png" alt="I(k) sum">
<p>This produces a sum of cosines scaled by In(r), again very similar to normal FM.
</p>
+<div class="separator"></div>
+<pre class="indented">
+<em class=def id="make-jjcos">make-jjcos</em> (frequency 0.0) (r 0.5) (a 1.0) (k 1.0)
+<em class=def id="jjcos">jjcos</em> gen (fm 0.0)
+<em class=def id="jjcos?">jjcos?</em> gen
-<br>
-
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-jjcos">make-jjcos</A> (frequency 0.0) (r 0.5) (a 1.0) (k 1.0)
- <A class=def NAME="jjcos">jjcos</A> gen (fm 0.0)
- <A class=def NAME="jjcos?">jjcos?</A> gen
-
- <A class=def NAME="make-j2cos">make-j2cos</A> (frequency 0.0) (r 0.5) (n 1)
- <A class=def NAME="j2cos">j2cos</A> gen (fm 0.0)
- <A class=def NAME="j2cos?">j2cos?</A> gen
+<em class=def id="make-j2cos">make-j2cos</em> (frequency 0.0) (r 0.5) (n 1)
+<em class=def id="j2cos">j2cos</em> gen (fm 0.0)
+<em class=def id="j2cos?">j2cos?</em> gen
- <A class=def NAME="make-jpcos">make-jpcos</A> (frequency 0.0) (r 0.5) (a 0.0) (k 1.0)
- <A class=def NAME="jpcos">jpcos</A> gen (fm 0.0)
- <A class=def NAME="jpcos?">jpcos?</A> gen
+<em class=def id="make-jpcos">make-jpcos</em> (frequency 0.0) (r 0.5) (a 0.0) (k 1.0)
+<em class=def id="jpcos">jpcos</em> gen (fm 0.0)
+<em class=def id="jpcos?">jpcos?</em> gen
- <A class=def NAME="make-jncos">make-jncos</A> (frequency 0.0) (r 0.5) (a 1.0) (n 0)
- <A class=def NAME="jncos">jncos</A> gen (fm 0.0)
- <A class=def NAME="jncos?">jncos?</A> gen
+<em class=def id="make-jncos">make-jncos</em> (frequency 0.0) (r 0.5) (a 1.0) (n 0)
+<em class=def id="jncos">jncos</em> gen (fm 0.0)
+<em class=def id="jncos?">jncos?</em> gen
</pre>
<p>These produce a sum of cosines scaled by a product of Bessel functions; in a sense, there are two, or maybe three "indices".
@@ -9343,19 +8790,19 @@ Normalization is handled correctly at least for jpcos. Of the four, jpcos seems
in general as a and r approach 1.0, the spectrum approaches "k" components, sometimes in a highly convoluted manner.
</p>
-<table border=0 hspace=40 cellspacing=10>
-<tr><td>jjcos:</td><td width=10></td><td><img src="pix/sceq31.png" alt="more sums"></td></tr>
-<tr><td>j2cos:</td><td width=10></td><td><img src="pix/sceq34.png" alt="more sums"></td></tr>
-<tr><td>jpcos:</td><td width=10></td><td><img src="pix/sceq33.png" alt="more sums"></td></tr>
-<tr><td>jncos:</td><td width=10></td><td><img src="pix/sceq32.png" alt="more sums"></td></tr>
+<table>
+<tr><td>jjcos:</td><td><img class="indented" src="pix/sceq31.png" alt="more sums"></td></tr>
+<tr><td>j2cos:</td><td><img class="indented" src="pix/sceq34.png" alt="more sums"></td></tr>
+<tr><td>jpcos:</td><td><img class="indented" src="pix/sceq33.png" alt="more sums"></td></tr>
+<tr><td>jncos:</td><td><img class="indented" src="pix/sceq32.png" alt="more sums"></td></tr>
</table>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-jycos">make-jycos</A> (frequency 0.0) (r 1.0) (a 1.0)
- <A class=def NAME="jycos">jycos</A> gen (fm 0.0)
- <A class=def NAME="jycos?">jycos?</A> gen
+<pre class="indented">
+<em class=def id="make-jycos">make-jycos</em> (frequency 0.0) (r 1.0) (a 1.0)
+<em class=def id="jycos">jycos</em> gen (fm 0.0)
+<em class=def id="jycos?">jycos?</em> gen
</pre>
<p>This uses bes-y0 to produce components scaled by Yn(r)*Jn(a). bes-y0(0) is -inf, so a^2 + r^2 should be greater than 2ar,
@@ -9363,13 +8810,12 @@ and r should be greater than 0.0. Tricky to use. (If you get an inf or a NaN f
both the time and frequency graphs will be unhappy).
</p>
-<br><br>
<!-- finite sums -->
-<table border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>finite sums</h5></center></td></tr></table>
+<div class="innerheader">finite sums</div>
<p>These generators produce a set of n sinusoids.
With a bit of bother,
@@ -9377,21 +8823,21 @@ they could be done with polywave. I don't
think there would be any difference, even taking FM into account.
</p>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-nssb">make-nssb</A> (frequency 0.0) (ratio 1.0) (n 1)
- <A class=def NAME="nssb">nssb</A> gen (fm 0.0)
- <A class=def NAME="nssb?">nssb?</A> gen
+<pre class="indented">
+<em class=def id="make-nssb">make-nssb</em> (frequency 0.0) (ratio 1.0) (n 1)
+<em class=def id="nssb">nssb</em> gen (fm 0.0)
+<em class=def id="nssb?">nssb?</em> gen
</pre>
<p>nssb is the single side-band version of ncos and nsin. It is very similar to <a href="#nxysin">nxysin</a> and <a href="#nxycos">nxycos</a>.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-ncos2" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/fejer.png\' width=\'320\' height=\'170\'>', TITLE, 'ncos2 (Fejer), n=10', ABOVE, true)">make-ncos2</A> (frequency 0.0) (n 1)
- <A class=def NAME="ncos2" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/fejer.png\' width=\'320\' height=\'170\'>', TITLE, 'ncos2 (Fejer), n=10', ABOVE, true)">ncos2</A> gen (fm 0.0)
- <A class=def NAME="ncos2?">ncos2?</A> gen
+<pre class="indented">
+<em class=emdef>make-ncos2</em> (frequency 0.0) (n 1)
+<em class=emdef id="ncos2">ncos2</em> gen (fm 0.0)
+<em class=def id="ncos2?">ncos2?</em> gen
</pre>
<p>This is the Fejer kernel. The i-th harmonic amplitude is (n-i)/(n+1).
@@ -9399,13 +8845,13 @@ think there would be any difference, even taking FM into account.
<!-- LATEX: &\frac{\sin^{2} \frac{1}{2}nx}{\sin^{2} \frac{1}{2}x} = \frac{n}{2} + \sum_{k=1}^{n-1} (n-k)\cos kx -->
-<img src="pix/sceq23.png" alt="sum of cosines" hspace=40><br>
-<br>
+<img class="indented" src="pix/sceq23.png" alt="sum of cosines">
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-ncos4" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/jackson.png\' width=\'320\' height=\'170\'>', TITLE, 'ncos4 (Jackson), n=10', ABOVE, true)">make-ncos4</A> (frequency 0.0) (n 1)
- <A class=def NAME="ncos4" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/jackson.png\' width=\'320\' height=\'170\'>', TITLE, 'ncos4 (Jackson), n=10', ABOVE, true)">ncos4</A> gen (fm 0.0)
- <A class=def NAME="ncos4?">ncos4?</A> gen
+<pre class="indented">
+<em class=emdef>make-ncos4</em> (frequency 0.0) (n 1)
+<em class=emdef>ncos4</em> gen (fm 0.0)
+<em class=def id="ncos4?">ncos4?</em> gen
</pre>
<p>This is the Jackson kernel, the square of ncos2.
@@ -9413,53 +8859,52 @@ think there would be any difference, even taking FM into account.
<!-- LATEX: &\Bigg(\frac{\sin(n+\frac{1}{2})x}{\sin \frac{x}{2}}\Bigg)^{4} -->
<!-- pointless...
-<img src="pix/sceq24.png" alt="sum of cosines" hspace=40>
+<img class="indented" src="pix/sceq24.png" alt="sum of cosines">
-->
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-npcos" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/poussin.png\' width=\'320\' height=\'170\'>', TITLE, 'npcos (Poussin), n=5', ABOVE, true)">make-npcos</A> (frequency 0.0) (n 1)
- <A class=def NAME="npcos" onmouseout="UnTip()" onmouseover="Tip('<img src=\'pix/poussin.png\' width=\'320\' height=\'170\'>', TITLE, 'npcos (Poussin), n=5', ABOVE, true)">npcos</A> gen (fm 0.0)
- <A class=def NAME="npcos?">npcos?</A> gen
+<pre class="indented">
+<em class=emdef>make-npcos</em> (frequency 0.0) (n 1)
+<em class=emdef>npcos</em> gen (fm 0.0)
+<em class=def id="npcos?">npcos?</em> gen
</pre>
<p>This is the Poussin kernel, a combination of two ncos2 generators, one at "n" subtracted from twice another at 2n+1.
</p>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-n1cos">make-n1cos</A> (frequency 0.0) (n 1)
- <A class=def NAME="n1cos">n1cos</A> gen (fm 0.0)
- <A class=def NAME="n1cos?">n1cos?</A> gen
+<pre class="indented">
+<em class=def id="make-n1cos">make-n1cos</em> (frequency 0.0) (n 1)
+<em class=def id="n1cos">n1cos</em> gen (fm 0.0)
+<em class=def id="n1cos?">n1cos?</em> gen
</pre>
<p>Another spikey waveform, very similar to ncos2 above.
</p>
-<img src="pix/sceq45.png" alt="linear cosines" hspace=20>
-
-
-<br>
+<img class="indented" src="pix/sceq45.png" alt="linear cosines">
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-nxycos">make-nxycos</A> (frequency 0.0) (ratio 1.0) (n 1)
- <A class=def NAME="nxycos">nxycos</A> gen (fm 0.0)
- <A class=def NAME="nxycos?">nxycos?</A> gen
+<pre class="indented">
+<em class=def id="make-nxycos">make-nxycos</em> (frequency 0.0) (ratio 1.0) (n 1)
+<em class=def id="nxycos">nxycos</em> gen (fm 0.0)
+<em class=def id="nxycos?">nxycos?</em> gen
- <A class=def NAME="make-nxysin">make-nxysin</A> (frequency 0.0) (ratio 1.0) (n 1)
- <A class=def NAME="nxysin">nxysin</A> gen (fm 0.0)
- <A class=def NAME="nxysin?">nxysin?</A> gen
+<em class=def id="make-nxysin">make-nxysin</em> (frequency 0.0) (ratio 1.0) (n 1)
+<em class=def id="nxysin">nxysin</em> gen (fm 0.0)
+<em class=def id="nxysin?">nxysin?</em> gen
- <A class=def NAME="make-nxy1cos">make-nxy1cos</A> (frequency 0.0) (ratio 1.0) (n 1)
- <A class=def NAME="nxy1cos">nxy1cos</A> gen (fm 0.0)
- <A class=def NAME="nxy1cos?">nxy1cos?</A> gen
+<em class=def id="make-nxy1cos">make-nxy1cos</em> (frequency 0.0) (ratio 1.0) (n 1)
+<em class=def id="nxy1cos">nxy1cos</em> gen (fm 0.0)
+<em class=def id="nxy1cos?">nxy1cos?</em> gen
- <A class=def NAME="make-nxy1sin">make-nxy1sin</A> (frequency 0.0) (ratio 1.0) (n 1)
- <A class=def NAME="nxy1sin">nxy1sin</A> gen (fm 0.0)
- <A class=def NAME="nxy1sin?">nxy1sin?</A> gen
+<em class=def id="make-nxy1sin">make-nxy1sin</em> (frequency 0.0) (ratio 1.0) (n 1)
+<em class=def id="nxy1sin">nxy1sin</em> gen (fm 0.0)
+<em class=def id="nxy1sin?">nxy1sin?</em> gen
</pre>
+
<p>These produce a sum of "n" sinsoids starting at "frequency", spaced by "ratio". Since "frequency" can be treated
as the carrier, there's no point in an ssb version. nxy1cos is the same as nxycos, but every other
component is multiplied by -1, and "n" produces 2n components.
@@ -9469,20 +8914,20 @@ but in some cases (mainly involving low "n" and simple "ratio"), the output migh
even trickier, so it divides by "n".
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-noddcos">make-noddcos</A> (frequency 0.0) (n 1)
- <A class=def NAME="noddcos">noddcos</A> gen (fm 0.0)
- <A class=def NAME="noddcos?">noddcos?</A> gen
+<pre class="indented">
+<em class=def id="make-noddcos">make-noddcos</em> (frequency 0.0) (n 1)
+<em class=def id="noddcos">noddcos</em> gen (fm 0.0)
+<em class=def id="noddcos?">noddcos?</em> gen
- <A class=def NAME="make-noddsin">make-noddsin</A> (frequency 0.0) (n 1)
- <A class=def NAME="noddsin">noddsin</A> gen (fm 0.0)
- <A class=def NAME="noddsin?">noddsin?</A> gen
+<em class=def id="make-noddsin">make-noddsin</em> (frequency 0.0) (n 1)
+<em class=def id="noddsin">noddsin</em> gen (fm 0.0)
+<em class=def id="noddsin?">noddsin?</em> gen
- <A class=def NAME="make-noddssb">make-noddssb</A> (frequency 0.0) (ratio 1.0) (n 1)
- <A class=def NAME="noddssb">noddssb</A> gen (fm 0.0)
- <A class=def NAME="noddssb?">noddssb?</A> gen
+<em class=def id="make-noddssb">make-noddssb</em> (frequency 0.0) (ratio 1.0) (n 1)
+<em class=def id="noddssb">noddssb</em> gen (fm 0.0)
+<em class=def id="noddssb?">noddssb?</em> gen
</pre>
@@ -9491,45 +8936,44 @@ even trickier, so it divides by "n".
<p>These produce the sum of "n" equal amplitude odd-numbered sinusoids:
</p>
-<img src="pix/sceq29.png" alt="sum of cosines" hspace=40><br>
+<img class="indented" src="pix/sceq29.png" alt="sum of cosines">
<!-- LATEX: &\sum_{k=1}^{n}\sin(2k-1)x=\frac{\sin^{2}nx}{\sin x} \\ -->
-<img src="pix/sceq28.png" alt="sum of sines" hspace=40><br>
+<img class="indented" src="pix/sceq28.png" alt="sum of sines">
<p>The corresponding "even" case is the same as ncos with twice the frequency. noddsin produces a somewhat clarinet-like tone:
</p>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
(let ((gen (<em class=red>make-noddsin</em> 300 :n 3))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 1 3 0) :length 40000 :scaler .5)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 40000))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) (<em class=red>noddsin</em> gen)))))))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 2 1 3 0) :length 40000 :scaler .5)))
+ (do ((i 0 (+ i 1)))
+ ((= i 40000))
+ (<a class=quiet href="#outa">outa</a> i (* (<a class=quiet href="#env">env</a> ampf) (<em class=red>noddsin</em> gen))))))
</pre>
<p>noddsin normalization is the same as nsin. The peak happens half as far from the 0 crossing as in nsin (3pi/(4n) for nsin,
and 3pi/(8n) for noddsin (assuming large n)), and its amplitude is 8n*sin^2(3pi/8)/(3pi), just as in nsin. The noddsin generator scales its output
by the inverse of this, so it is always between -1 and 1.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-nrcos">make-nrcos</A> (frequency 0.0) (n 1) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="nrcos">nrcos</A> gen (fm 0.0)
- <A class=def NAME="nrcos?">nrcos?</A> gen
+<pre class="indented">
+<em class=def id="make-nrcos">make-nrcos</em> (frequency 0.0) (n 1) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="nrcos">nrcos</em> gen (fm 0.0)
+<em class=def id="nrcos?">nrcos?</em> gen
- <A class=def NAME="make-nrsin">make-nrsin</A> (frequency 0.0) (n 1) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="nrsin">nrsin</A> gen (fm 0.0)
- <A class=def NAME="nrsin?">nrsin?</A> gen
+<em class=def id="make-nrsin">make-nrsin</em> (frequency 0.0) (n 1) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="nrsin">nrsin</em> gen (fm 0.0)
+<em class=def id="nrsin?">nrsin?</em> gen
- <A class=def NAME="make-nrssb">make-nrssb</A> (frequency 0.0) (ratio 1.0) (n 1) (r 0.5) ; 0.0 <= r < 1.0
- <A class=def NAME="nrssb">nrssb</A> gen (fm 0.0)
- <A class=def NAME="nrssbinterp">nrssb-interp</A> gen fm interp
- <A class=def NAME="nrssb?">nrssb?</A> gen
+<em class=def id="make-nrssb">make-nrssb</em> (frequency 0.0) (ratio 1.0) (n 1) (r 0.5) ; 0.0 <= r < 1.0
+<em class=def id="nrssb">nrssb</em> gen (fm 0.0)
+<em class=def id="nrssbinterp">nrssb-interp</em> gen fm interp
+<em class=def id="nrssb?">nrssb?</em> gen
</pre>
<p>These produce the sum of "n" sinusoids, with successive sinusoids scaled by "r"; the nth component has amplitude r^n.
@@ -9540,19 +8984,19 @@ In the nrssb-interp generator, the "interp" argument interpolates between the up
<p>The instrument lutish uses nrcos: <code>lutish beg dur freq amp</code>:
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
+ (do ((i 0 (+ i 1)))
((= i 10))
- (lutish (* i .1) 2 (* 100 (+ 1 i)) .05)))
+ (lutish (* i .1) 2 (* 100 (+ i 1)) .05)))
</pre>
<p>The instrument oboish uses nrssb: <code>oboish beg dur freq amp amp-env</code>:
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
+ (do ((i 0 (+ i 1)))
((= i 10))
(oboish (* i .3) .4 (+ 100 (* 50 i)) .05 '(0 0 1 1 2 1 3 0))))
</pre>
@@ -9560,21 +9004,21 @@ In the nrssb-interp generator, the "interp" argument interpolates between the up
<p>organish also uses nrssb: <code>organish beg dur freq amp fm-index amp-env</code>:
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
+ (do ((i 0 (+ i 1)))
((= i 10))
(organish (* i .3) .4 (+ 100 (* 50 i)) .5 1.0 #f)))
</pre>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-nkssb">make-nkssb</A> (frequency 0.0) (ratio 1.0) (n 1)
- <A class=def NAME="nkssb">nkssb</A> gen (fm 0.0)
- <A class=def NAME="nkssbinterp">nkssb-interp</A> gen fm interp
- <A class=def NAME="nkssb?">nkssb?</A> gen
+<pre class="indented">
+<em class=def id="make-nkssb">make-nkssb</em> (frequency 0.0) (ratio 1.0) (n 1)
+<em class=def id="nkssb">nkssb</em> gen (fm 0.0)
+<em class=def id="nkssbinterp">nkssb-interp</em> gen fm interp
+<em class=def id="nkssb?">nkssb?</em> gen
</pre>
<p>This generator produces the single side-band version of the sum of "n" sinusoids, where the nth component has amplitude n.
@@ -9582,8 +9026,8 @@ In the nkssb-interp generator, the "interp" argument interpolates between the up
The instrument nkssber uses nkssb-interp:
</p>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
(nkssber 0 1 1000 100 5 5 0.5)
(nkssber 1 2 600 100 4 1 0.5)
(nkssber 3 2 1000 540 3 3 0.5)
@@ -9591,24 +9035,24 @@ The instrument nkssber uses nkssb-interp:
(nkssber 9 1 30 4 40 0.5 0.5)
(nkssber 10 1 20 6 80 0.5 0.5))
</pre>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-nsincos">make-nsincos</A> (frequency 0.0) (n 1)
- <A class=def NAME="nsincos">nsincos</A> gen (fm 0.0)
- <A class=def NAME="nsincos?">nsincos?</A> gen
+<pre class="indented">
+<em class=def id="make-nsincos">make-nsincos</em> (frequency 0.0) (n 1)
+<em class=def id="nsincos">nsincos</em> gen (fm 0.0)
+<em class=def id="nsincos?">nsincos?</em> gen
</pre>
<p>This generator produces a sum of n cosines scaled by sin(k*pi/(n+1))/sin(pi/(n+1)).
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-nchoosekcos">make-nchoosekcos</A> (frequency 0.0) (ratio 1.0) (n 1)
- <A class=def NAME="nchoosekcos">nchoosekcos</A> gen (fm 0.0)
- <A class=def NAME="nchoosekcos?">nchoosekcos?</A> gen
+<pre class="indented">
+<em class=def id="make-nchoosekcos">make-nchoosekcos</em> (frequency 0.0) (ratio 1.0) (n 1)
+<em class=def id="nchoosekcos">nchoosekcos</em> gen (fm 0.0)
+<em class=def id="nchoosekcos?">nchoosekcos?</em> gen
</pre>
<p>This generator produces a sum of n cosines scaled by the binomial coefficients. If n is even, the last term is halved.
@@ -9616,102 +9060,91 @@ All these "finite sum" generators are a bit inflexible, and sound more or less t
is amplitude modulation:
</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> ()
(let ((modulator (<em class=red>make-nchoosekcos</em> 100.0 1.0 4))
(carrier (<a class=quiet href="#make-nrcos">make-nrcos</a> 2000.0 :n 3 :r .5)))
- (do ((i 0 (+ 1 i))) ((= i 20000))
+ (do ((i 0 (+ i 1))) ((= i 20000))
(<a class=quiet href="#outa">outa</a> i (* .5 (<a class=quiet href="#nrcos">nrcos</a> carrier)
(<em class=red>nchoosekcos</em> modulator))))))
</pre>
-</td><td>
+
<img src="pix/nkcos.png" alt="am nchoosekcos">
-</td></tr></table>
-<br><br>
<!-- infinite sums -->
-<table border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>infinite sums</h5></center></td></tr></table>
+<div class="innerheader">infinite sums</div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-rcos">make-rcos</A> (frequency 0.0) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="rcos">rcos</A> gen (fm 0.0)
- <A class=def NAME="rcos?">rcos?</A> gen
+<pre class="indented">
+<em class=def id="make-rcos">make-rcos</em> (frequency 0.0) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="rcos">rcos</em> gen (fm 0.0)
+<em class=def id="rcos?">rcos?</em> gen
- <A class=def NAME="make-rssb">make-rssb</A> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="rssb">rssb</A> gen (fm 0.0)
- <A class=def NAME="rssbinterp">rssb-interp</A> gen fm interp
- <A class=def NAME="rssb?">rssb?</A> gen
+<em class=def id="make-rssb">make-rssb</em> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="rssb">rssb</em> gen (fm 0.0)
+<em class=def id="rssbinterp">rssb-interp</em> gen fm interp
+<em class=def id="rssb?">rssb?</em> gen
- <A class=def NAME="make-rxycos">make-rxycos</A> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="rxycos">rxycos</A> gen (fm 0.0)
- <A class=def NAME="rxycos?">rxycos?</A> gen
+<em class=def id="make-rxycos">make-rxycos</em> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="rxycos">rxycos</em> gen (fm 0.0)
+<em class=def id="rxycos?">rxycos?</em> gen
- <A class=def NAME="make-rxysin">make-rxysin</A> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="rxysin">rxysin</A> gen (fm 0.0)
- <A class=def NAME="rxysin?">rxysin?</A> gen
+<em class=def id="make-rxysin">make-rxysin</em> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="rxysin">rxysin</em> gen (fm 0.0)
+<em class=def id="rxysin?">rxysin?</em> gen
</pre>
<p>These generators produce an infinite sum of sinusoids, each successive component scaled by "r" (so the nth component has amplitude r^n).
The bump instrument uses rssb-interp: <code>bump beg dur freq amp f0 f1 f2</code>:
</p>
-<table border=0 hspace=20><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
- (do ((k 0 (+ 1 k)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
+ (do ((k 0 (+ k 1)))
((= k 10))
(bump (* 0.4 k) 1 (* 16.3 (expt 2.0 (+ 3 (/ k 12)))) .5 520 1190 2390))
- (do ((k 0 (+ 1 k)))
+ (do ((k 0 (+ k 1)))
((= k 10))
(let* ((freq (* 16.3 (expt 2.0 (+ 3 (/ k 12)))))
(scl (sqrt (/ freq 120))))
(bump (+ 4 (* 0.4 k)) 1 freq .5 (* scl 520) (* scl 1190) (* scl 2390)))))
</pre>
-</td></tr></table>
<p>As with all the "infinite sums" generators, aliasing is a major concern. We can use the following
relatively conservative function to find the highest safe "r" given the current fundamental and sampling rate:
</p>
-<pre>
- (define (safe-r-max freq srate) ; the safe-rxycos generator in generators.scm has this built-in
- (expt .001 (/ 1.0 (floor (/ srate (* 3 freq))))))
+<pre class="indented">
+(define (safe-r-max freq srate) ; the safe-rxycos generator in generators.scm has this built-in
+ (expt .001 (/ 1.0 (floor (/ srate (* 3 freq))))))
</pre>
-<table border=0>
-<tr><td>
<p>
If you go over that value, be prepared for some very unintuitive behavior! For example,
at an srate of 44100:
</p>
-<table border=0 hspace=20><tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2)
- (let* ((gen1 (<em class=red>make-rcos</em> 1050 0.99))
- ;; r=.6 or so is the safe max
- (gen2 (<em class=red>make-rcos</em> 1048 0.99)))
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 2)
+ (let ((gen1 (<em class=red>make-rcos</em> 1050 0.99))
+ ;; r=.6 or so is the safe max
+ (gen2 (<em class=red>make-rcos</em> 1048 0.99)))
+ (do ((i 0 (+ i 1)))
((= i 88200))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (<em class=red>rcos</em> gen1))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outb_tip)">outb</a> i (<em class=red>rcos</em> gen2)))))
+ (<a class=quiet href="#outa">outa</a> i (<em class=red>rcos</em> gen1))
+ (<a class=quiet href="#outa">outb</a> i (<em class=red>rcos</em> gen2)))))
</pre>
-</td></tr></table>
<p>In the first case, all the aliased harmonics line up perfectly with the
unaliased ones because 21*1050 is 22050, but in the second case,
we get (for example) the strong 84 Hz component because the 42nd harmonic
which falls at 44100 - 42*1048 = 84 still has an amplitude of 0.99^42 = .66!
</p>
-</td><td>
-<img src="pix/rcos.png" alt="rcos aliased">
-</td></tr></table>
+
+<img class="indented" src="pix/rcos.png" alt="rcos aliased">
<p>Another artifact of aliasing is that at some frequencies,
for example at 100 Hz, and a sampling rate of 44100, if r is -0.99 and the initial phase is 0.5*pi, or if r is 0.99 and the initial phase is 1.5*pi, the peak amp
@@ -9726,20 +9159,20 @@ are the same, but there's an overall phase difference of pi.
<!--
(set! (x-axis-label 0 0 0) "rcos freq=1050 r=.99")
(set! (x-axis-label 0 1 0) "rcos freq=1048 r=.99")
-(set! (axis-label-font) "9x15")
+(set! *axis-label-font* "9x15")
-->
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-ercos">make-ercos</A> (frequency 0.0) (r 0.5) ; r > 0.0
- <A class=def NAME="ercos">ercos</A> gen (fm 0.0)
- <A class=def NAME="ercos?">ercos?</A> gen
+<pre class="indented">
+<em class=def id="make-ercos">make-ercos</em> (frequency 0.0) (r 0.5) ; r > 0.0
+<em class=def id="ercos">ercos</em> gen (fm 0.0)
+<em class=def id="ercos?">ercos?</em> gen
- <A class=def NAME="make-erssb">make-erssb</A> (frequency 0.0) (ratio 1.0) (r 0.5)
- <A class=def NAME="erssb">erssb</A> gen (fm 0.0)
- <A class=def NAME="erssb?">erssb?</A> gen
+<em class=def id="make-erssb">make-erssb</em> (frequency 0.0) (ratio 1.0) (r 0.5)
+<em class=def id="erssb">erssb</em> gen (fm 0.0)
+<em class=def id="erssb?">erssb?</em> gen
</pre>
<p>These produce a sum of sinusoids, each scaled by e^(-kr), a special case of rcos. Our safe (minimum) "r" here becomes <code>(/ (log 0.001) (floor (/ srate (* -3 freq))))</code>.
@@ -9747,53 +9180,53 @@ The ercoser instrument uses ercos:
<code>ercoser beg dur freq amp r</code>:
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
(ercoser 0 1 100 .5 0.1))
</pre>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-eoddcos">make-eoddcos</A> (frequency 0.0) (r 0.5)
- <A class=def NAME="eoddcos">eoddcos</A> gen (fm 0.0)
- <A class=def NAME="eoddcos?">eoddcos?</A> gen
+<pre class="indented">
+<em class=def id="make-eoddcos">make-eoddcos</em> (frequency 0.0) (r 0.5)
+<em class=def id="eoddcos">eoddcos</em> gen (fm 0.0)
+<em class=def id="eoddcos?">eoddcos?</em> gen
</pre>
<p>This produces a sum of odd harmonics, each scaled by e^r(2k-1)/(2k-1). As "r" approches 0.0, this approaches a square wave.
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
(let ((gen1 (<em class=red>make-eoddcos</em> 400.0 :r 0.0))
- (gen2 (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 400.0))
- (a-env (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :length 10000)))
- (do ((i 0 (+ 1 i)))
+ (gen2 (<a class=quiet href="#make-oscil">make-oscil</a> 400.0))
+ (a-env (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1) :length 10000)))
+ (do ((i 0 (+ i 1)))
((= i 10000))
- (set! (eoddcos-r gen1) (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> a-env))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .5 (<em class=red>eoddcos</em> gen1 (* .1 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> gen2))))))))
+ (set! (gen1 'r) (<a class=quiet href="#env">env</a> a-env))
+ (<a class=quiet href="#outa">outa</a> i (* .5 (<em class=red>eoddcos</em> gen1 (* .1 (<a class=quiet href="#oscil">oscil</a> gen2))))))))
</pre>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-rkcos">make-rkcos</A> (frequency 0.0) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="rkcos">rkcos</A> gen (fm 0.0)
- <A class=def NAME="rkcos?">rkcos?</A> gen
+<pre class="indented">
+<em class=def id="make-rkcos">make-rkcos</em> (frequency 0.0) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="rkcos">rkcos</em> gen (fm 0.0)
+<em class=def id="rkcos?">rkcos?</em> gen
- <A class=def NAME="make-rksin">make-rksin</A> (frequency 0.0) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="rksin">rksin</A> gen (fm 0.0)
- <A class=def NAME="rksin?">rksin?</A> gen
+<em class=def id="make-rksin">make-rksin</em> (frequency 0.0) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="rksin">rksin</em> gen (fm 0.0)
+<em class=def id="rksin?">rksin?</em> gen
- <A class=def NAME="make-rkssb">make-rkssb</A> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="rkssb">rkssb</A> gen (fm 0.0)
- <A class=def NAME="rkssb?">rkssb?</A> gen
+<em class=def id="make-rkssb">make-rkssb</em> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="rkssb">rkssb</em> gen (fm 0.0)
+<em class=def id="rkssb?">rkssb?</em> gen
</pre>
<!--
-(with-sound (:output "r7.snd")
+(with-sound ("r7.snd")
(let ((gen (make-rksin 100.0 :r .7)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (rksin gen))))))
-->
@@ -9801,13 +9234,13 @@ The ercoser instrument uses ercos:
<p>These produce a sum of sinusoids scaled by (r^k)/k. As r approaches 1.0 or -1.0, rksin approaches a sawtooth.
</p>
-<img src="pix/rksin3.png" alt="sawtooths" hspace=40>
+<img src="pix/rksin3.png" alt="sawtooths">
<p>As with rcos, we
can calculate the safe maximum r, given the current srate and frequency (this function is perhaps too cautious...):
</p>
-<pre>
+<pre class="indented">
(define (safe-rk-max freq srate)
(let ((topk (floor (/ srate (* 3 freq)))))
(min 0.999999 (expt (* .001 topk) (/ 1.0 topk)))))
@@ -9818,87 +9251,82 @@ rksin and rkcos provide a nice demonstration of how insensitive the ear is to ph
have the same timbre. The sawtooth sounds louder to me, despite having the same peak amplitude.
</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2)
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 2)
(let ((gen1 (<em class=red>make-rkcos</em> 200.0 :r 0.9))
(gen2 (<em class=red>make-rksin</em> 200.0 :r 0.9)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 100000))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .95 (<em class=red>rkcos</em> gen1)))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outb_tip)">outb</a> i (* .95 (<em class=red>rksin</em> gen2))))))
+ (<a class=quiet href="#outa">outa</a> i (* .95 (<em class=red>rkcos</em> gen1)))
+ (<a class=quiet href="#outa">outb</a> i (* .95 (<em class=red>rksin</em> gen2))))))
-<em class=typing>></em> <em class=listener>(channel-rms 0 0)</em> ; from dsp.scm
-<em class=typing>0.305301097090353</em>
-<em class=typing>></em> <em class=listener>(channel-rms 0 1)</em>
-<em class=typing>0.627769794744852</em>
+> (channel-rms 0 0) ; from dsp.scm
+0.305301097090353
+> (channel-rms 0 1)
+0.627769794744852
</pre>
-</td><td>
-<img src="pix/rksin.png" alt="sin vs cos" hspace=30>
-</td></tr></table>
+
+<img class="indented" src="pix/rksin.png" alt="sin vs cos">
<p>We might conclude that the RMS value gives the perceived amplitude, but
in the next case, the RMS values are the same, and the peak amplitudes
differ by a factor of 3. I think the one with the higher peak amplitude sounds louder.
</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2)
- (let* ((gen1 (<a class=quiet href="#make-adjustable-square-wave">make-adjustable-square-wave</a> 400
- :duty-factor .75 :amplitude .25))
- (gen2 (<a class=quiet href="#make-adjustable-square-wave">make-adjustable-square-wave</a> 400
- :duty-factor .11 :amplitude .75))
- (flt1 (<a class=quiet href="#make-moving-average">make-moving-average</a> 10))
- (flt2 (<a class=quiet href="#make-moving-average">make-moving-average</a> 10)))
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:channels 2)
+ (let ((gen1 (<a class=quiet href="#make-adjustable-square-wave">make-adjustable-square-wave</a> 400
+ :duty-factor .75 :amplitude .25))
+ (gen2 (<a class=quiet href="#make-adjustable-square-wave">make-adjustable-square-wave</a> 400
+ :duty-factor .11 :amplitude .75))
+ (flt1 (<a class=quiet href="#make-moving-average">make-moving-average</a> 10))
+ (flt2 (<a class=quiet href="#make-moving-average">make-moving-average</a> 10)))
+ (do ((i 0 (+ i 1)))
((= i 50000))
(<a class=quiet href="#outa">outa</a> i (<a class=quiet href="#moving-average">moving-average</a> flt1
(<a class=quiet href="#adjustable-square-wave">adjustable-square-wave</a> gen1)))
(<a class=quiet href="#outa">outb</a> i (<a class=quiet href="#moving-average">moving-average</a> flt2
(<a class=quiet href="#adjustable-square-wave">adjustable-square-wave</a> gen2))))))
</pre>
-</td><td>
-<img src="pix/rmspk.png" alt="rms vs peak" hspace=30>
-</td></tr></table>
+
+<img class="indented" src="pix/rmspk.png" alt="rms vs peak">
+
<p>Since clipping is a disaster, we focus on peak amplitudes in the generators.
</p>
<!--
-(set! (selected-graph-color) (make-color 1 1 1))
-(set! (selected-data-color) (make-color 0 0 0))
+(set! *selected-graph-color* (make-color 1 1 1))
+(set! *selected-data-color* (make-color 0 0 0))
(set! (x-axis-label 0 0) "rkcos, r=.9")
(set! (x-axis-label 0 1) "rksin, r=.9")
-(set! (axis-label-font) "9x15")
+(set! *axis-label-font* "9x15")
(set! (x-axis-label 0 0) "rms: .21, peak amp: .25")
(set! (x-axis-label 0 1) "rms: .21, peak amp: .75")
-->
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-rk!cos">make-rk!cos</A> (frequency 0.0) (r 0.5) ; rk!cos is a special case of rxyk!cos
- <A class=def NAME="rk!cos">rk!cos</A> gen (fm 0.0)
- <A class=def NAME="rk!cos?">rk!cos?</A> gen
+<pre class="indented">
+<em class=def id="make-rk!cos">make-rk!cos</em> (frequency 0.0) (r 0.5) ; rk!cos is a special case of rxyk!cos
+<em class=def id="rk!cos">rk!cos</em> gen (fm 0.0)
+<em class=def id="rk!cos?">rk!cos?</em> gen
- <A class=def NAME="make-rk!ssb">make-rk!ssb</A> (frequency 0.0) (ratio 1.0) (r 0.5)
- <A class=def NAME="rk!ssb">rk!ssb</A> gen (fm 0.0)
- <A class=def NAME="rk!ssb?">rk!ssb?</A> gen
+<em class=def id="make-rk!ssb">make-rk!ssb</em> (frequency 0.0) (ratio 1.0) (r 0.5)
+<em class=def id="rk!ssb">rk!ssb</em> gen (fm 0.0)
+<em class=def id="rk!ssb?">rk!ssb?</em> gen
- <A class=def NAME="make-rxyk!cos">make-rxyk!cos</A> (frequency 0.0) (ratio 1.0) (r 0.5)
- <A class=def NAME="rxyk!cos">rxyk!cos</A> gen (fm 0.0)
- <A class=def NAME="rxyk!cos?">rxyk!cos?</A> gen
+<em class=def id="make-rxyk!cos">make-rxyk!cos</em> (frequency 0.0) (ratio 1.0) (r 0.5)
+<em class=def id="rxyk!cos">rxyk!cos</em> gen (fm 0.0)
+<em class=def id="rxyk!cos?">rxyk!cos?</em> gen
- <A class=def NAME="make-rxyk!sin">make-rxyk!sin</A> (frequency 0.0) (ratio 1.0) (r 0.5)
- <A class=def NAME="rxyk!sin">rxyk!sin</A> gen (fm 0.0)
- <A class=def NAME="rxyk!sin?">rxyk!sin?</A> gen
+<em class=def id="make-rxyk!sin">make-rxyk!sin</em> (frequency 0.0) (ratio 1.0) (r 0.5)
+<em class=def id="rxyk!sin">rxyk!sin</em> gen (fm 0.0)
+<em class=def id="rxyk!sin?">rxyk!sin?</em> gen
</pre>
@@ -9907,9 +9335,6 @@ differ by a factor of 3. I think the one with the higher peak amplitude sounds
&\sum_{k=0}^{\infty}\frac{p^{k}\cos kx}{k!} = e^{p\cos x}\cos(p\sin x) \\
-->
-<table border=0>
-<tr>
-<td>
<p>These produce a sum of sinusoids scaled by (r^k)/k!.
The k! denominator dominates eventually, so r * ratio * frequency is approximately the spectral center
(the ratio between successive harmonic amplitudes is (r^(k+1)/(k+1)!)/(r^k/k!) = r/(k+1), which
@@ -9918,41 +9343,41 @@ For example, in the graph on the right, the frequency is 100 and r is 30, so the
Negative "r" gives the same spectrum as positive, but the waveform's initial-phase is shifted by pi.
The (very) safe maximum "r" is:
</p>
-<pre>
+
+<pre class="indented">
(define (safe-rk!-max freq srate)
(let ((topk (floor (/ srate (* 3 freq)))))
(expt (* .001 (factorial topk)) (/ 1.0 topk))))
;; factorial is in numerics.scm
</pre>
-</td><td>
-<img src="pix/rkbang.png" alt="rk!cos spectrum" hspace=30>
-</td></tr></table>
+
+<img src="pix/rkbang.png" alt="rk!cos spectrum">
+
<p>As in other such cases, varying "r" gives changing spectra. You can sweep r through 0 smoothly except in rk!cos where you'll get a click.
Coupled with the fm argument, these generators provide an extension of multi-carrier FM, similar in effect to the "leap-frog" FM voice.
Here is a use of rk!cos to make a bird twitter:
</p>
-<pre>
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t :scaled-to .5)
- (do ((k 0 (+ 1 k)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t :scaled-to .5)
+ (do ((k 0 (+ k 1)))
((= k 6))
(let ((gen (<em class=red>make-rk!cos</em> 3000.0 :r 0.6))
- (ampf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 1 3 0) :length 3000))
- (frqf (<a class=quiet href="#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :base .1 :scaler (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 2000) :length 3000)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 3000))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> (+ i (* k 4000))
- (* (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)
- (<em class=red>rk!cos</em> gen (<a class=quiet href="#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf)))))))))
+ (ampf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1 2 1 3 0) :length 3000))
+ (frqf (<a class=quiet href="#make-env">make-env</a> '(0 0 1 1) :base .1 :scaler (<a class=quiet href="#hztoradians">hz->radians</a> 2000) :length 3000)))
+ (do ((i 0 (+ i 1)))
+ ((= i 3000))
+ (<a class=quiet href="#outa">outa</a> (+ i (* k 4000))
+ (* (<a class=quiet href="#env">env</a> ampf)
+ (<em class=red>rk!cos</em> gen (<a class=quiet href="#env">env</a> frqf))))))))
</pre>
<p>The instrument bouncy uses rk!ssb: <code>bouncy beg dur freq amp (bounce-freq 5) (bounce-amp 20)</code>
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
(bouncy 0 2 200 .5 3 2))
</pre>
@@ -9961,13 +9386,13 @@ It takes a gliss envelope and turns it into a series of quick jumps between harm
pitch and the index ("r") of the rxyk!cos generator. The effect is vaguely brass-like.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-r2k!cos">make-r2k!cos</A> (frequency 0.0) (r 0.5) (k 0.0)
- <A class=def NAME="r2k!cos">r2k!cos</A> gen (fm 0.0)
- <A class=def NAME="r2k!cos?">r2k!cos?</A> gen
+<pre class="indented">
+<em class=def id="make-r2k!cos">make-r2k!cos</em> (frequency 0.0) (r 0.5) (k 0.0)
+<em class=def id="r2k!cos">r2k!cos</em> gen (fm 0.0)
+<em class=def id="r2k!cos?">r2k!cos?</em> gen
</pre>
<p>
@@ -9981,12 +9406,11 @@ of sinusoids and Bessel functions.
&(1 - 2r \cos \theta + r^{2})^{-k} = \frac{1}{2} {}_{2}F_{1}(k, k; 1; r^{2}) + \sum_{n=1}^{\infty} \frac{(k)_{n}}{n!} r^{n} {}_{2}F_{1}(k, k+n; n+1; r^{2}) \cos n\theta
-->
-<table border=1 hspace=40 cellpadding=6><tr><td>
-<img src="pix/sceq30.png" alt="sum of sines">
-</td></tr>
-<tr><td>
-<img src="pix/r2kfactcos.png" alt="r2k!cos spectra">
-</td></tr></table>
+
+<img class="indented" src="pix/sceq30.png" alt="sum of sines">
+<br>
+<img class="indented" src="pix/r2kfactcos.png" alt="r2k!cos spectra">
+
<!-- r2kfactcos.png:
@@ -9997,12 +9421,11 @@ of sinusoids and Bessel functions.
(indf (make-env '(0 0 1 1) :duration dur :scaler 10.0 :offset 1))
(ampf (make-env '(0 0 1 1 20 1 21 0) :duration dur))
)
- (run
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(set! (r2k!cos-k gen) (env indf))
(outa i (* (env ampf)
- (r2k!cos gen)))))))
+ (r2k!cos gen))))))
dark 3 rainbow .001 not inverted
2048 blackman2
@@ -10014,8 +9437,6 @@ hop 3
-->
-<br>
-
<p>Negative "r" gives the same output as the corresponding positive "r", and
there is sometimes a lot of DC. Despite appearances, as r increases beyond 1.0,
the spectrum collapses back towards the fundamental. (I think that r and 1/r produce the same spectrum).
@@ -10025,29 +9446,29 @@ The instruments pianoy and pianoy1 use r2k!cos: <code>pianoy beg dur freq amp</c
<code>pianoy1 beg dur freq amp (bounce-freq 5) (bounce-amp 20)</code>:
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
(pianoy 0 3 100 .5))
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
(pianoy1 0 4 200 .5 1 .1))
</pre>
<p>pianoy2 combines r2k!cos with fmssb to try to get closer to the hammer sound:
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
+<pre class="indented">
+ (<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
(pianoy2 0 1 100 .5))
</pre>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-rkoddssb">make-rkoddssb</A> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
- <A class=def NAME="rkoddssb">rkoddssb</A> gen (fm 0.0)
- <A class=def NAME="rkoddssb?">rkoddssb?</A> gen
+<pre class="indented">
+<em class=def id="make-rkoddssb">make-rkoddssb</em> (frequency 0.0) (ratio 1.0) (r 0.5) ; -1.0 < r < 1.0
+<em class=def id="rkoddssb">rkoddssb</em> gen (fm 0.0)
+<em class=def id="rkoddssb?">rkoddssb?</em> gen
</pre>
<p>This produces a sum of odd-numbered harmonics scaled by (r^(2k-1))/(2k-1). This kind of spectrum is usually
@@ -10057,7 +9478,7 @@ same output as positive. The (not very)
safe maximum r is:
</p>
-<pre>
+<pre class="indented">
(define (safe-rkodd-max-r freq srate)
(let* ((topk (floor (/ srate (* 3 freq))))
(k2-1 (- (* 2 topk) 1)))
@@ -10068,71 +9489,71 @@ safe maximum r is:
<p>The instrument stringy uses rkoddssb and rcos: <code>stringy beg dur freq amp</code>:
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (stringy (* i .3) .3 (+ 200 (* 100 i)) .5)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (stringy (* i .3) .3 (+ 200 (* 100 i)) .5)))
</pre>
<p>glassy also uses rkoddssb: <code>glassy beg dur freq amp</code>:
</p>
-<pre>
- (<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t)
- (do ((i 0 (+ 1 i)))
- ((= i 10))
- (glassy (* i .3) .1 (+ 400 (* 100 i)) .5)))
+<pre class="indented">
+(<a class=quiet href="sndscm.html#wsdoc">with-sound</a> (:play #t)
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (glassy (* i .3) .1 (+ 400 (* 100 i)) .5)))
</pre>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-k2sin">make-k2sin</A> (frequency 0.0)
- <A class=def NAME="k2sin">k2sin</A> gen (fm 0.0)
- <A class=def NAME="k2sin?">k2sin?</A> gen
+<pre class="indented">
+<em class=def id="make-k2sin">make-k2sin</em> (frequency 0.0)
+<em class=def id="k2sin">k2sin</em> gen (fm 0.0)
+<em class=def id="k2sin?">k2sin?</em> gen
- <A class=def NAME="make-k2cos">make-k2cos</A> (frequency 0.0)
- <A class=def NAME="k2cos">k2cos</A> gen (fm 0.0)
- <A class=def NAME="k2cos?">k2cos?</A> gen
+<em class=def id="make-k2cos">make-k2cos</em> (frequency 0.0)
+<em class=def id="k2cos">k2cos</em> gen (fm 0.0)
+<em class=def id="k2cos?">k2cos?</em> gen
- <A class=def NAME="make-k2ssb">make-k2ssb</A> (frequency 0.0) (ratio 1.0)
- <A class=def NAME="k2ssb">k2ssb</A> gen (fm 0.0)
- <A class=def NAME="k2ssb?">k2ssb?</A> gen
+<em class=def id="make-k2ssb">make-k2ssb</em> (frequency 0.0) (ratio 1.0)
+<em class=def id="k2ssb">k2ssb</em> gen (fm 0.0)
+<em class=def id="k2ssb?">k2ssb?</em> gen
</pre>
<p>These produce a sum of sinusoids scaled by 1/(2^k).
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-k3sin">make-k3sin</A> (frequency 0.0)
- <A class=def NAME="k3sin">k3sin</A> gen fm
- <A class=def NAME="k3sin?">k3sin?</A> gen
+<pre class="indented">
+<em class=def id="make-k3sin">make-k3sin</em> (frequency 0.0)
+<em class=def id="k3sin">k3sin</em> gen fm
+<em class=def id="k3sin?">k3sin?</em> gen
</pre>
<p>This produces a sum of sines scaled by 1.0/(k^3).
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-krksin">make-krksin</A> (frequency 0.0) (r 0.5)
- <A class=def NAME="krksin">krksin</A> gen (fm 0.0)
- <A class=def NAME="krksin?">krksin?</A> gen
+<pre class="indented">
+<em class=def id="make-krksin">make-krksin</em> (frequency 0.0) (r 0.5)
+<em class=def id="krksin">krksin</em> gen (fm 0.0)
+<em class=def id="krksin?">krksin?</em> gen
</pre>
-<img src="pix/sceq25.png" alt="sum of sines" hspace=40>
-<br>
+<img class="indented" src="pix/sceq25.png" alt="sum of sines">
+<div class="separator"></div>
<p>This produces a sum of sinusoids scaled by kr^k. Its output is not normalized. I think the formula
given assumes that r is less than 1.0, and in that case, the safe maximum r is given by:
</p>
-<pre>
+<pre class="indented">
(define (safe-krk-max-r freq srate)
- (let* ((topk (floor (/ srate (* 3 freq)))))
+ (let ((topk (floor (/ srate (* 3 freq)))))
(expt (/ .001 topk) (/ 1.0 topk))))
</pre>
@@ -10141,31 +9562,30 @@ I think r in that case is equivalent to 1/r.
The only value to avoid is 1.0.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-abcos">make-abcos</A> (frequency 0.0) (a 0.5) (b 0.25)
- <A class=def NAME="abcos">abcos</A> gen (fm 0.0)
- <A class=def NAME="abcos?">abcos?</A> gen
+<pre class="indented">
+<em class=def id="make-abcos">make-abcos</em> (frequency 0.0) (a 0.5) (b 0.25)
+<em class=def id="abcos">abcos</em> gen (fm 0.0)
+<em class=def id="abcos?">abcos?</em> gen
- <A class=def NAME="make-absin">make-absin</A> (frequency 0.0) (a 0.5) (b 0.25)
- <A class=def NAME="absin">absin</A> gen (fm 0.0)
- <A class=def NAME="absin?">absin?</A> gen
+<em class=def id="make-absin">make-absin</em> (frequency 0.0) (a 0.5) (b 0.25)
+<em class=def id="absin">absin</em> gen (fm 0.0)
+<em class=def id="absin?">absin?</em> gen
</pre>
<p>These produce a sum of sinusoids scaled as follows:
</p>
-<img src="pix/sceq27.png" alt="sum of sines" hspace=40>
-<br>
-<br>
+<img class="indented" src="pix/sceq27.png" alt="sum of sines">
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-r2k2cos">make-r2k2cos</A> (frequency 0.0) (r 0.5)
- <A class=def NAME="r2k2cos">r2k2cos</A> gen (fm 0.0)
- <A class=def NAME="r2k2cos?">r2k2cos?</A> gen
+<pre class="indented">
+<em class=def id="make-r2k2cos">make-r2k2cos</em> (frequency 0.0) (r 0.5)
+<em class=def id="r2k2cos">r2k2cos</em> gen (fm 0.0)
+<em class=def id="r2k2cos?">r2k2cos?</em> gen
</pre>
<p>This produces a sum of cosines, each scaled by 1/(r^2+k^2). r shouldn't be 0, but otherwise it almost doesn't matter what it is —
@@ -10176,24 +9596,24 @@ this is not a very flexible generator!
variants of those given above.
</p>
-<br><br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <A class=def NAME="make-tanhsin">make-tanhsin</A> (frequency *clm-default-frequency*) (r 1.0) (initial-phase 0.0)
- <A class=def NAME="tanhsin">tanhsin</A> gen (fm 0.0)
- <A class=def NAME="tanhsin?">tanhsin?</A> gen
+<pre class="indented">
+<em class=def id="make-tanhsin">make-tanhsin</em> (frequency *clm-default-frequency*) (r 1.0) (initial-phase 0.0)
+<em class=def id="tanhsin">tanhsin</em> gen (fm 0.0)
+<em class=def id="tanhsin?">tanhsin?</em> gen
</pre>
<p>This produces tanh(r * sin(x)) which approaches a square wave as "r" increases.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <a class=def name="make-moving-fft">make-moving-fft</a> (input #f :type clm) (n 512) (hop 128)
- <a class=def name="moving-fft">moving-fft</A> gen
- <a class=def name="moving-fft?">moving-fft?</A> gen
+<pre class="indented">
+<em class=def id="make-moving-fft">make-moving-fft</em> (input #f) (n 512) (hop 128)
+<em class=def id="moving-fft">moving-fft</em> gen
+<em class=def id="moving-fft?">moving-fft?</em> gen
</pre>
<p>moving-fft provides a sample-by-sample FFT (magnitudes and phases) of its
@@ -10201,23 +9621,24 @@ input (currently assumed to be a readin generator).
mus-xcoeffs returns the magnitudes, mus-ycoeffs returns the phases, and mus-data returns the current input block.
We could mimic the fft display window in the "lisp graph" via:
</p>
-<pre>
+
+<pre class="indented">
(let* ((rd (make-readin "oboe.snd"))
(ft (<em class=red>make-moving-fft</em> rd))
- (data (make-vct 256)))
+ (data (make-float-vector 256 0.0)))
(set! (lisp-graph?) #t)
(do ((i 0 (+ i 1)))
((= i 10000))
(<em class=red>moving-fft</em> ft)
- (vct-subseq (mus-xcoeffs ft) 0 255 data)
+ (float-vector-subseq (mus-xcoeffs ft) 0 255 data)
(graph data "fft" 0.0 11025.0 0.0 0.1 0 0 #t)))
</pre>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <a class=def name="make-moving-spectrum">make-moving-spectrum</a> (input #f :type clm) (n 512) (hop 128)
- <a class=def name="moving-spectrum">moving-spectrum</A> gen
- <a class=def name="moving-spectrum?">moving-spectrum?</A> gen
+<pre class="indented">
+<em class=def id="make-moving-spectrum">make-moving-spectrum</em> (input #f) (n 512) (hop 128)
+<em class=def id="moving-spectrum">moving-spectrum</em> gen
+<em class=def id="moving-spectrum?">moving-spectrum?</em> gen
</pre>
<p>moving-spectrum provides a sample-by-sample spectrum (amplitudes, frequencies, and current phases) of its
@@ -10225,64 +9646,65 @@ input (currently assumed to be a readin generator). It is identical to the firs
the phase-vocoder generator (see test-sv in generators.scm for details). To access the current amps and so on,
use moving-spectrum-amps, moving-spectrum-phases, and moving-spectrum-freqs.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <a class=def name="make-moving-autocorrelation">make-moving-autocorrelation</a> (input #f :type clm) (n 512) (hop 128)
- <a class=def name="moving-autocorrelation">moving-autocorrelation</A> gen
- <a class=def name="moving-autocorrelation?">moving-autocorrelation?</A> gen
+<pre class="indented">
+<em class=def id="make-moving-autocorrelation">make-moving-autocorrelation</em> (input #f) (n 512) (hop 128)
+<em class=def id="moving-autocorrelation">moving-autocorrelation</em> gen
+<em class=def id="moving-autocorrelation?">moving-autocorrelation?</em> gen
</pre>
<p>moving-autocorrelation provides the autocorrelation of the last 'n' samples every 'hop' samples.
The samples come from 'input' (currently assumed to be a readin generator). The output is accessible
via mus-data.
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <a class=def name="make-moving-pitch">make-moving-pitch</a> (input #f :type clm) (n 512) (hop 128)
- <a class=def name="moving-pitch">moving-pitch</A> gen
- <a class=def name="moving-pitch?">moving-pitch?</A> gen
+<pre class="indented">
+<em class=def id="make-moving-pitch">make-moving-pitch</em> (input #f) (n 512) (hop 128)
+<em class=def id="moving-pitch">moving-pitch</em> gen
+<em class=def id="moving-pitch?">moving-pitch?</em> gen
</pre>
<p>moving-pitch provides the current pitch of its input, recalculated (via moving-autocorrelation) every 'hop' samples.
</p>
-<pre>
-(let* ((rd (make-readin "oboe.snd"))
- (cur-srate (srate "oboe.snd"))
- (old-srate (mus-srate)))
- (set! (mus-srate) cur-srate)
- (let* ((scn (<em class=red>make-moving-pitch</em> rd))
- (last-pitch 0.0)
- (pitch 0.0))
+
+<pre class="indented">
+(let ((rd (make-readin "oboe.snd"))
+ (cur-srate (srate "oboe.snd"))
+ (old-srate *clm-srate*))
+ (set! *clm-srate* cur-srate)
+ (let ((scn (<em class=red>make-moving-pitch</em> rd))
+ (last-pitch 0.0)
+ (pitch 0.0))
(do ((i 0 (+ i 1)))
((= i 22050))
(set! last-pitch pitch)
(set! pitch (<em class=red>moving-pitch</em> scn))
(if (not (= last-pitch pitch))
(format #t "~A: ~A~%" (* 1.0 (/ i cur-srate)) pitch))))
- (set! (mus-srate) old-srate))
+ (set! *clm-srate* old-srate))
</pre>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <a class=def name="make-moving-scentroid">make-moving-scentroid</a> (dbfloor -40.0) (rfreq 100.0) (size 4096)
- <a class=def name="moving-scentroid">moving-scentroid</A> gen
- <a class=def name="moving-scentroid?">moving-scentroid?</A> gen
+<pre class="indented">
+<em class=def id="make-moving-scentroid">make-moving-scentroid</em> (dbfloor -40.0) (rfreq 100.0) (size 4096)
+<em class=def id="moving-scentroid">moving-scentroid</em> gen
+<em class=def id="moving-scentroid?">moving-scentroid?</em> gen
</pre>
<p>moving-scentroid provides a generator that mimics Bret Battey's scentroid instrument (in dsp.scm or scentroid.ins).
</p>
-<br>
+<div class="separator"></div>
-<pre style="background-color: #f2f4ff">
- <a class=def name="make-flocsig">make-flocsig</a> (reverb-amount 0.0) (frequency 1.0) (amplitude 2.0) offset
- <a class=def name="flocsig">flocsig</A> gen i val
- <a class=def name="flocsig?">flocsig?</A> gen
+<pre class="indented">
+<em class=def id="make-flocsig">make-flocsig</em> (reverb-amount 0.0) (frequency 1.0) (amplitude 2.0) offset
+<em class=def id="flocsig">flocsig</em> gen i val
+<em class=def id="flocsig?">flocsig?</em> gen
</pre>
<p>flocsig is a version of locsig that adds changing delays between the channels (flanging).
@@ -10293,10 +9715,9 @@ This generator is trying to open up the space in the same manner that flanging d
hopefully unobtrusively. Here is an example, including a stereo reverb:
</p>
-<pre>
+<pre class="indented">
(definstrument (jcrev2)
- (let* (
- (allpass11 (make-all-pass -0.700 0.700 1051))
+ (let* ((allpass11 (make-all-pass -0.700 0.700 1051))
(allpass21 (make-all-pass -0.700 0.700 337))
(allpass31 (make-all-pass -0.700 0.700 113))
(comb11 (make-comb 0.742 4799))
@@ -10304,7 +9725,7 @@ hopefully unobtrusively. Here is an example, including a stereo reverb:
(comb31 (make-comb 0.715 5399))
(comb41 (make-comb 0.697 5801))
(outdel11 (make-delay (seconds->samples .01)))
-
+
(allpass12 (make-all-pass -0.700 0.700 1051))
(allpass22 (make-all-pass -0.700 0.700 337))
(allpass32 (make-all-pass -0.700 0.700 113))
@@ -10313,34 +9734,32 @@ hopefully unobtrusively. Here is an example, including a stereo reverb:
(comb32 (make-comb 0.715 5399))
(comb42 (make-comb 0.697 5801))
(outdel12 (make-delay (seconds->samples .01)))
-
- (file-dur (frames *reverb*))
- (decay-dur (mus-srate))
+
+ (file-dur (framples *reverb*))
+ (decay-dur *clm-srate*)
(len (floor (+ decay-dur file-dur))))
-
- (run
- (do ((i 0 (+ 1 i)))
- ((= i len))
-
- (let* ((allpass-sum (all-pass allpass31
- (all-pass allpass21
- (all-pass allpass11
- (ina i *reverb*)))))
- (comb-sum (+ (comb comb11 allpass-sum)
- (comb comb21 allpass-sum)
- (comb comb31 allpass-sum)
- (comb comb41 allpass-sum))))
- (outa i (delay outdel11 comb-sum)))
-
- (let* ((allpass-sum (all-pass allpass32
- (all-pass allpass22
- (all-pass allpass12
- (inb i *reverb*)))))
- (comb-sum (+ (comb comb12 allpass-sum)
- (comb comb22 allpass-sum)
- (comb comb32 allpass-sum)
- (comb comb42 allpass-sum))))
- (outb i (delay outdel12 comb-sum)))))))
+
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let* ((allpass-sum (all-pass allpass31
+ (all-pass allpass21
+ (all-pass allpass11
+ (ina i *reverb*)))))
+ (comb-sum (+ (comb comb11 allpass-sum)
+ (comb comb21 allpass-sum)
+ (comb comb31 allpass-sum)
+ (comb comb41 allpass-sum))))
+ (outa i (delay outdel11 comb-sum)))
+
+ (let* ((allpass-sum (all-pass allpass32
+ (all-pass allpass22
+ (all-pass allpass12
+ (inb i *reverb*)))))
+ (comb-sum (+ (comb comb12 allpass-sum)
+ (comb comb22 allpass-sum)
+ (comb comb32 allpass-sum)
+ (comb comb42 allpass-sum))))
+ (outb i (delay outdel12 comb-sum))))))
(definstrument (simp beg dur (amp 0.5) (freq 440.0) (ramp 2.0) (rfreq 1.0) offset)
(let* ((os (make-pulse-train freq))
@@ -10350,185 +9769,134 @@ hopefully unobtrusively. Here is an example, including a stereo reverb:
:offset offset))
(start (seconds->samples beg))
(end (+ start (seconds->samples dur))))
- (run
- (do ((i start (+ i 1)))
- ((= i end))
- (<em class=red>flocsig</em> floc i (* amp (pulse-train os)))))))
-
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<em class=red>flocsig</em> floc i (* amp (pulse-train os))))))
(with-sound (:channels 2 :reverb-channels 2 :reverb jcrev2)
(simp 0 1))
-
</pre>
-<br><br>
-
<!-- defgenerator -->
-<table border=1 width=200 vspace=10 hspace=20><tr><td bgcolor="#eefdee"><center><h5>defgenerator</h5></center></td></tr></table>
+<div class="innerheader">defgenerator</div>
-<pre>
- <a class=def name="defgenerator">defgenerator</a> name fields
+<pre class="indented">
+<em class=def id="defgenerator">defgenerator</em> name fields
</pre>
<p>defgenerator defines a generator. Its syntax is modelled after Common Lisp's defstruct.
It sets up
-a structure, an object with named slots that you can get and set, and ties it into the
-optimizer so that you can use the structures without any speed penalty. It also defines a "make"
-function to create an instance of the structure, and a predicate for it. The original impetus for
-this came from user-defined generators in CLM. We want to package together all the disparate
-variables that make up a generator, just as in function groups such as
-<a href="sndclm.html#make-oscil">make-oscil</a>, <a href="sndclm.html#oscil">oscil</a>, and <a href="sndclm.html#oscil?">oscil?</a>.
-So, as a first example, here is a way to define your own oscil using defgenerator (oscil is so simple that
-you could also use a vct — see <a href="sndclm.html#make-my-oscil">make-my-oscil</a>).
+a structure, an environment with slots that you can get and set.
+It also defines a "make"
+function to create an instance of the environment, and a predicate for it.
+Here is a way to define oscil using defgenerator:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(<em class=red>defgenerator</em> osc freq phase)
-;;; this defines a struct named "osc" with the (float) fields freq and phase.
-;;; make-osc creates an osc, and osc? returns #t if passed an osc.
-;;; the fields are accessed via osc-freq and osc-phase.
+;;; make-osc creates an osc, and osc? returns #t if passed an osc.
+;;; Once we have an osc (an environment with "freq" and "phase" locals)
+;;; we can either use with-let, or refer to the local variables
+;;; directly via (gen 'freq) and (gen 'phase).
(define (osc gen fm) ; our new generator
- (<a class=quiet href="extsnd.html#declare" onmouseout="UnTip()" onmouseover="Tip(extsnd_declare_tip)">declare</a> (gen osc) (fm float))
- (let ((result (sin (<em class=red>osc-phase</em> gen))))
- (set! (<em class=red>osc-phase</em> gen) (+ (<em class=red>osc-phase</em> gen) (<em class=red>osc-freq</em> gen) fm))
+ (let ((result (sin (gen 'phase))))
+ (set! (gen 'phase) (+ (gen 'phase) (gen 'freq) fm))
result))
;;; now we can use the osc generator in an instrument:
-(<a class=quiet href="sndscm.html#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (osc-fm beg dur freq amp mc-ratio fm-index)
- (let* ((start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
- (end (+ start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (carrier (<em class=red>make-osc</em> (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> freq)))
- (modulator (<em class=red>make-osc</em> (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (* mc-ratio freq))))
- (index (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (* freq mc-ratio fm-index))))
- (run
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* amp (<em class=red>osc</em> carrier (* index (<em class=red>osc</em> modulator 0.0)))))))))
+(<a class=quiet href="sndscm.html#definstrument">definstrument</a> (osc-fm beg dur freq amp mc-ratio fm-index)
+ (let* ((start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> beg))
+ (end (+ start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> dur)))
+ (carrier (<em class=red>make-osc</em> (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> freq)))
+ (modulator (<em class=red>make-osc</em> (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> (* mc-ratio freq))))
+ (index (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> (* freq mc-ratio fm-index))))
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="sndclm.html#outa">outa</a> i (* amp (<em class=red>osc</em> carrier (* index (<em class=red>osc</em> modulator 0.0))))))))
(with-sound () (osc-fm 0 1 440 .1 1 1))
-</pre></td></tr></table>
-
-<p>
-The first argument to defgenerator is the new struct's name, and the rest are the fields of that struct.
-Each field has a name, a type, and an optional initial value. The type defaults to float, and
-the initial value to 0.0, so our declaration above is the same as any of these:
-</p>
-
-<pre>
- (defgenerator osc freq (phase 0.0))
- (defgenerator osc (freq 0.0) (phase 0.0))
- (defgenerator osc (freq 0.0 :type float) (phase 0.0 :type float))
</pre>
-<p>and so on. The "make" function (make-osc in our example) uses define* with
-the field names and types as the optional keys. So make-osc above is declared (by the
+<p>
+The first argument to defgenerator is the new object's name, and the rest are the fields of that object.
+Each field has a name and an optional initial value which defaults to 0.0.
+The "make" function (make-osc in our example) uses define* with
+the field names and initial values as the optional keys. So make-osc above is declared (by the
defgenerator macro) as:
</p>
-<pre>
- (define* (make-osc (freq 0.0) (phase 0.0)) ...)
+<pre class="indented">
+(define* (make-osc (freq 0.0) (phase 0.0)) ...)
</pre>
<p>which we can invoke in various ways, e.g.:
</p>
-<pre>
- (make-osc 440)
- (make-osc :phase (/ pi 2) :freq 440)
- (make-osc 440 :phase 0.0)
-</pre>
-
-<p>
-The currently implemented field types are:
-</p>
-
-<pre>
- int float boolean char string list symbol keyword vct sampler mix-sampler
- sound-data clm float-vector int-vector vct-vector list-vector clm-vector
+<pre class="indented">
+(make-osc 440)
+(make-osc :phase (/ pi 2) :freq 440)
+(make-osc 440 :phase 0.0)
</pre>
-<p>The struct name can be a list; in this case the first element is the actual struct name. The
-next elements are optionally <code>:make-wrapper</code> followed by a function of one argument
-(the default struct normally returned by defgenerator), and optionally <code>:methods</code>, followed
+<p>The defgenerator "name" parameter can also be a list; in this case the first element is the actual generator name. The
+next elements are <code>:make-wrapper</code> followed by a function of one argument
+(the default object normally returned by defgenerator), and <code>:methods</code>, followed
by a list of the methods the generator responds to. The make wrapper function can
make any changes it pleases, then return the fixed-up generator. For example, in our
"osc" generator, we had to remember to change frequency in Hz to radians; we can use the
wrapper to handle that:
</p>
-<pre>
- (defgenerator
- (osc <em class=red>:make-wrapper</em> (lambda (gen)
- (set! (osc-freq gen) (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (osc-freq gen)))
- gen))
- (freq 0.0) (phase 0.0))
+<pre class="indented">
+(defgenerator
+ (osc <em class=red>:make-wrapper</em> (lambda (gen)
+ (set! (gen 'freq) (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> (gen 'freq)))
+ gen))
+ (freq 0.0) (phase 0.0))
</pre>
<p>and now the make process in the instrument can be simplified to:
</p>
-<pre>
- ...
- (carrier (make-osc freq))
- (modulator (make-osc (* mc-ratio freq)))
- ...
+<pre class="indented">
+...
+(carrier (make-osc freq))
+(modulator (make-osc (* mc-ratio freq)))
+...
</pre>
<p>If you want the struct to take part in the <a href="sndclm.html#genericfunctions">generic function</a> facility
-in CLM, add the desired methods as an association list with the name :methods:
+in CLM, add the desired methods as an association list with the keyword :methods:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(defgenerator (osc :make-wrapper
(lambda (gen)
- (set! (osc-freq gen) (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (osc-freq gen)))
+ (set! (gen 'freq) (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> (gen 'freq)))
gen)
- <em class=red>:methods</em>
+ <em class=red>:methods</em>
(list
- (list 'mus-frequency
- (lambda (g) (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">radians->hz</a> (osc-freq g)))
- (lambda (g val) (set! (osc-freq g) (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> val))))
-
- (list 'mus-phase
- (lambda (g) (osc-phase g))
- (lambda (g val) (set! (osc-phase g) val)))
+ (cons 'mus-frequency
+ (dilambda
+ (lambda (g) (<a class=quiet href="sndclm.html#hztoradians">radians->hz</a> (g 'freq)))
+ (lambda (g val) (set! (g 'freq) (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> val)))))
+ (cons 'mus-phase
+ (dilambda
+ (lambda (g) (g 'phase))
+ (lambda (g val) (set! (g 'phase) val))))
- (list 'mus-describe
- (lambda (g) (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "osc freq: ~A, phase: ~A"
+ (cons 'mus-describe
+ (lambda (g) (<a class=quiet>format</a> #f "osc freq: ~A, phase: ~A"
(mus-frequency g)
(mus-phase g))))))
freq phase)
-</pre></td></tr></table>
-
-<p>The first function is the "getter" and the (optional) second function is the "setter".
-You can also use make-procedure-with-setter.
-The standard methods are actually defined for you.
-If the generator has a frequency field,
-defgenerator adds the method
-mus-frequency (radians->hz of the frequency field); similarly "angle" or "phase" become mus-phase,
-"n" or "order" becomes mus-order, and "r" or "amplitude" becomes mus-scaler.
-To specialize the make function,
-or add your own methods, the generator name can be a list:
-</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
-(defgenerator (name
- :make-wrapper (lambda (gen) ... gen)
- :methods (list
- (list 'method-name
- (lambda (gen) ...) ; get method
- (lambda (gen val) ...) ; set method, if any
- ...)))
- fields...)
</pre>
-</td></tr></table>
<p>The make-wrapper might more accurately be called an after-method; it is
evaluated at the end of the automatically-created make function. All the
@@ -10536,70 +9904,34 @@ fields have been set at that point either by arguments to the make function,
or from the default values given in the defgenerator declaration. The make
function returns whatever
the make-wrapper function returns, so you almost always want to return the "gen" argument.
-The added methods can be optimized by run, as can the generator function itself, but
-remember to declare the generator type (the "declare" business above).
-Here is an example that produces abs(oscil):
+There are many examples in generators.scm.
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(defgenerator (abssin
- :make-wrapper (lambda (g)
- (set! (abssin-osc g) (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (abssin-frequency g)))
- g)
- :methods (list
- (list 'mus-frequency
- (lambda (g) (mus-frequency (abssin-osc g)))
- (lambda (g val) (set! (mus-frequency (abssin-osc g)) val) val))
-
- (list 'mus-phase
- (lambda (g) (mus-phase (abssin-osc g)))
- (lambda (g val) (set! (mus-phase (abssin-osc g)) val) val))))
- (frequency *clm-default-frequency*)
- (osc #f :type clm))
-
-(define* (abssin gen (fm 0.0))
- (declare (gen abssin) (fm float))
- (/ (- (abs (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> (abssin-osc gen) fm))
- (/ 2.0 pi)) ; remove DC
- (/ 2.0 pi))) ; normalize
-
-#|
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let ((gen (<em class=red>make-abssin</em> 440.0)))
- (run
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .5 (<em class=red>abssin</em> gen)))))))
-#|
-</pre>
-</td></tr></table>
-
-
-<br>
-<br><br>
-<!-- ---------------------------------------- FUNCTIONS ---------------------------------------- -->
+<!-- FUNCTIONS -->
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h2><a class=def NAME="otherfunctions">Other Functions</a></h2></td></tr></table>
+<div class="header" id="otherfunctions">Other functions</div>
<p>There are several functions closely tied to the generators and instruments.
</p>
-<table cellspacing=0 cellpadding=0 hspace=40>
-<tr><td><a class=def name="hztoradians">hz->radians</a><code> freq</code></td><td width=20></td><td>convert freq to radians per sample (using mus-srate): (freq * 2 * pi) / srate</td></tr>
-<tr><td><a class=def name="radianstohz">radians->hz</a><code> rads</code></td><td></td><td>convert rads to Hz (using mus-srate): (rads * srate) / (2 * pi)</td></tr>
-<tr><td><a class=def name="dbtolinear">db->linear</a><code> dB</code></td><td></td><td>convert dB to linear value: 10^(dB/20)</td></tr>
-<tr><td><a class=def name="lineartodb">linear->db</a><code> val</code></td><td></td><td>convert val to dB: 20 * log(x) / log(10)</td></tr>
-<tr><td><a class=def Name="timestosamples">times->samples</a><code> start duration</code></td><td></td><td>convert start and duration from seconds to samples (beg+dur in latter case)</td></tr>
-<tr><td><a class=def name="samplestoseconds">samples->seconds</a><code> samps</code></td><td></td><td>convert samples to seconds (using mus-srate): samps / srate</td></tr>
-<tr><td><a class=def name="secondstosamples">seconds->samples</a><code> secs</code></td><td></td><td>convert seconds to samples (using mus-srate): secs * srate</td></tr>
-<tr><td><a class=def name="degreestoradians">degrees->radians</a><code> degs</code></td><td></td><td>convert degrees to radians: (degs * 2 * pi) / 360</td></tr>
-<tr><td><a class=def name="radianstodegrees">radians->degrees</a><code> rads</code></td><td></td><td>convert radians to degrees: (rads * 360) / (2 * pi)</td></tr>
-<tr><td><a class=def name="clear-array">clear-array</a><code> arr</code></td><td></td><td>set all values in arr (a vct) to 0.0</td></tr>
-<tr><td><a class=def name="mussrate">mus-srate</a></td><td></td><td>sampling rate in with-sound</td></tr>
+<table class="method">
+<tr><td><em class=def id="hztoradians">hz->radians</em><code> freq</code></td><td>convert freq to radians per sample (using *clm-srate*): (freq * 2 * pi) / srate</td></tr>
+<tr><td><em class=def id="radianstohz">radians->hz</em><code> rads</code></td><td>convert rads to Hz (using *clm-srate*): (rads * srate) / (2 * pi)</td></tr>
+<tr><td><em class=def id="dbtolinear">db->linear</em><code> dB</code></td><td>convert dB to linear value: 10^(dB/20)</td></tr>
+<tr><td><em class=def id="lineartodb">linear->db</em><code> val</code></td><td>convert val to dB: 20 * log(x) / log(10)</td></tr>
+<tr><td><em class=def id="timestosamples">times->samples</em><code> start duration</code></td><td>convert start and duration from seconds to samples (beg+dur in latter case)</td></tr>
+<tr><td><em class=def id="samplestoseconds">samples->seconds</em><code> samps</code></td><td>convert samples to seconds (using *clm-srate*): samps / srate</td></tr>
+<tr><td><em class=def id="secondstosamples">seconds->samples</em><code> secs</code></td><td>convert seconds to samples (using *clm-srate*): secs * srate</td></tr>
+<tr><td><em class=def id="degreestoradians">degrees->radians</em><code> degs</code></td><td>convert degrees to radians: (degs * 2 * pi) / 360</td></tr>
+<tr><td><em class=def id="radianstodegrees">radians->degrees</em><code> rads</code></td><td>convert radians to degrees: (rads * 360) / (2 * pi)</td></tr>
+<tr><td><em class=def id="mussrate">mus-srate</em></td><td>sampling rate in with-sound (better known as *clm-srate*)</td></tr>
+<tr><td><em class=def id="oddweight">odd-weight</em><code> x</code></td><td>return a number between 0.0 (x is even) and 1.0 (x is odd)</td></tr>
+<tr><td><em class=def id="evenweight">even-weight</em><code> x</code></td><td>return a number between 0.0 (x is odd) and 1.0 (x is even)</td></tr>
+<tr><td><em class=def id="oddmultiple">odd-multiple</em><code> x y</code></td><td>return y times the nearest odd integer to x</td></tr>
+<tr><td><em class=def id="evenmultiple">even-multiple</em><code> x y</code></td><td>return y times the nearest even integer to x</td></tr>
</table>
<p>
@@ -10617,166 +9949,123 @@ frequency-related value is being accessed on every sample, as
an increment of a phase variable.
</p></blockquote>
-<pre>
- <em class=listener>></em><em class=typing>(mus-srate)</em>
- <em class=listener>44100.0</em>
+<pre class="indented">
+> *clm-srate*
+44100.0
- <em class=listener>></em><em class=typing>(hz->radians 440.0)</em>
- <em class=listener>0.0626893772144902</em>
- <em class=listener>></em><em class=typing>(/ (* 440.0 2 pi) 44100.0)</em>
- <em class=listener>0.0626893772144902</em>
+> (hz->radians 440.0)
+0.0626893772144902
+> (/ (* 440.0 2 pi) 44100.0)
+0.0626893772144902
- <em class=listener>></em><em class=typing>(linear->db .1)</em>
- <em class=listener>-20.0</em>
+> (linear->db .1)
+-20.0
- <em class=listener>></em><em class=typing>(times->samples 1.0 2.0)</em>
- <em class=listener>(44100 132300)</em>
- <em class=listener>></em><em class=typing>(seconds->samples 2.0)</em>
- <em class=listener>88200</em>
- <em class=listener>></em><em class=typing>(samples->seconds 44100)</em>
- <em class=listener>1.0</em>
+> (times->samples 1.0 2.0)
+(44100 132300)
+> (seconds->samples 2.0)
+88200
+> (samples->seconds 44100)
+1.0
- <em class=listener>></em><em class=typing>(degrees->radians 45)</em>
- <em class=listener>0.785398163397448</em>
- <em class=listener>></em><em class=typing>(radians->degrees (/ pi 4))</em>
- <em class=listener>45.0</em>
+> (degrees->radians 45)
+0.785398163397448
+> (radians->degrees (/ pi 4))
+45.0
</pre>
-<br>
-<pre>
- <a class=def name="musfloatequalfudgefactor">mus-float-equal-fudge-factor</a>
+<div class="separator"></div>
+
+
+<pre class="indented">
+<em class=def id="musfloatequalfudgefactor">mus-float-equal-fudge-factor</em> (also known as *mus-float-equal-fudge-factor*)
</pre>
-<p>This function sets how far apart generator vct elements can be and still be considered equal in equal?
+<p>This function sets how far apart generator float-vector elements can be and still be considered equal in equal?
</p>
-<pre>
- <em class=listener>></em><em class=typing>(mus-float-equal-fudge-factor)</em>
- <em class=listener>1.0e-7</em>
- <em class=listener>></em><em class=typing>(define v1 (vct .1 .1 .101))</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(define v2 (vct .1 .1 .1))</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(equal? v1 v2)</em>
- <em class=listener>#f</em>
- <em class=listener>></em><em class=typing>(set! (mus-float-equal-fudge-factor) .01)</em>
- <em class=listener>1.0e-7</em> ; set! returns the previous value
- <em class=listener>></em><em class=typing>(equal? v1 v2)</em>
- <em class=listener>#t</em>
+<pre class="indented">
+> *mus-float-equal-fudge-factor*
+1.0e-7
+> (define v1 (float-vector .1 .1 .101))
+#<unspecified>
+> (define v2 (float-vector .1 .1 .1))
+#<unspecified>
+> (equal? v1 v2)
+#f
+> (set! *mus-float-equal-fudge-factor* .01)
+1.0e-7 ; set! returns the previous value
+> (equal? v1 v2)
+#t
</pre>
-<br>
-<pre>
- <a class=def name="musarrayprintlength">mus-array-print-length</a>
+<div class="separator"></div>
+
+<pre class="indented">
+<em class=def id="musarrayprintlength">mus-array-print-length</em> (also known as *mus-array-print-length*)
</pre>
<p>
-This function determines how many mixer elements are printed by mus-describe.
+This function determines how many float-vector elements are printed by mus-describe.
</p>
-<pre>
- <em class=listener>></em><em class=typing>(mus-array-print-length)</em>
- <em class=listener>8</em>
- <em class=listener>></em><em class=typing>(define m1 (make-mixer 12))</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(set! (mus-array-print-length) 3)</em>
- <em class=listener>8</em> ; set! returns the old value
- <em class=listener>></em><em class=typing>m1</em>
- <em class=listener>#<mixer chans: 12, [
- 0.000 0.000 0.000...
- 0.000 0.000 0.000...
- 0.000 0.000 0.000...
- ]></em>
-</pre>
-
-<br><br>
+<!-- POLYNOMIAL -->
-<!-- ---------------------------------------- POLYNOMIAL ---------------------------------------- -->
+<div class="innerheader">polynomial</div>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>polynomial</h3></center></td></tr></table>
-<pre>
- <a class=def name="polynomial">polynomial</a> coeffs x
+<pre class="indented">
+<em class=def id="polynomial">polynomial</em> coeffs x
</pre>
<p>The polynomial function evaluates a polynomial, defined by giving its coefficients,
at the point "x".
-"coeffs" is a vct of coefficients where
+"coeffs" is a vector of coefficients where
coeffs[0] is the constant term, and so on.
</p>
-<pre>
- <em class=listener>></em><em class=typing>(polynomial (vct 0.0 1.0) 2.0)</em> ; x
- <em class=listener>2.0</em>
- <em class=listener>></em><em class=typing>(polynomial (vct 1.0 2.0 3.0) 2.0)</em> ; 3x*x + 2x + 1
- <em class=listener>17.0</em>
+<pre class="indented">
+> (polynomial (float-vector 0.0 1.0) 2.0) ; x
+2.0
+> (polynomial (float-vector 1.0 2.0 3.0) 2.0) ; 3x*x + 2x + 1
+17.0
</pre>
<p>
<a href="sndscm.html#polydoc">poly.scm</a> has a variety of polynomial-related functions.
Abramowitz and Stegun, "A Handbook of Mathematical Functions" is a
treasure-trove of interesting polynomials.
-Here's a generator that uses polynomial to produce a Blackman4 waveform (see also <a href="#make-blackman">make-blackman</a> in generators.scm):
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(<a class=quiet href="sndclm.html#defgenerator" onmouseout="UnTip()" onmouseover="Tip(sndclm_defgenerator_tip)">defgenerator</a> (blackman4 :make-wrapper
- (lambda (g)
- (set! (blackman4-incr g) (<a class=quiet href="#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (blackman4-frequency g)))
- (set! (blackman4-coeffs g) (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> .084037 -.29145 .375696 -.20762 .041194))
- g))
- (frequency 0.0) (initial-phase 0.0) (coeffs #f :type vct) (angle 0.0) (incr 0.0))
-
-(define (blackman4 gen fm)
- (<a class=quiet href="extsnd.html#declare" onmouseout="UnTip()" onmouseover="Tip(extsnd_declare_tip)">declare</a> (gen blackman4) (fm float))
- (let ((x (blackman4-angle gen)))
- (set! (blackman4-angle gen) (+ x fm (blackman4-incr gen)))
- (<em class=red>polynomial</em> (blackman4-coeffs gen) (cos x))))
-
-(<a class=quiet href="sndscm.html#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let ((black4 (make-blackman4 440.0)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i 0 (+ 1 i)))
- ((= i 20000))
- (<a class=quiet href="#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (blackman4 black4 0.0))))))
-</pre>
-</td></tr></table>
-
-<br><br>
-
+<!-- ARRAY-INTERP -->
-<!-- ---------------------------------------- ARRAY-INTERP ---------------------------------------- -->
+<div class="innerheader">array-interp, dot-product</div>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>array-interp, dot-product</h3></center></td></tr></table>
-
-<pre>
- <a class=def name="array-interp">array-interp</a> fn x size
- <a class=def name="dot-product">dot-product</a> in1 in2
- <a class=def name="edot-product">edot-product</a> freq data
- <a class=def name="mus-interpolate">mus-interpolate</a> type x v size y1
+<pre class="indented">
+<em class=def id="array-interp">array-interp</em> fn x size
+<em class=def id="dot-product">dot-product</em> in1 in2
+<em class=def id="edot-product">edot-product</em> freq data
+<em class=def id="mus-interpolate">mus-interpolate</em> type x v size y1
</pre>
<p>array-interp interpolates in the array "fn" at the point "x". It underlies the <a href="#table-lookup">table-lookup</a>
generator, among others. Here's array-interp as a "compander":
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(define compand-table (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> -1.0 -0.96 -0.90 -0.82 -0.72 -0.60 -0.45 -0.25
+<pre class="indented">
+(define compand-table (float-vector -1.0 -0.96 -0.90 -0.82 -0.72 -0.60 -0.45 -0.25
0.0 0.25 0.45 0.60 0.72 0.82 0.90 0.96 1.0))
-(<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a>
(lambda (inval)
(let ((index (+ 8.0 (* 8.0 inval))))
(<em class=red>array-interp</em> compand-table index 17))))
</pre>
-</td></tr></table>
<p><a href="sndscm.html#soundinterp">sound-interp</a> in examp.scm fills an array with an entire sound,
@@ -10788,24 +10077,22 @@ dot-product is the usual "inner product" or "scalar product" (a name that should
We could define our own FIR filter using dot-product:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(define (make-fr-filter coeffs)
- (list coeffs (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> (length coeffs))))
+ (list coeffs (make-float-vector (length coeffs) 0.0)))
(define (fr-filter flt x)
(let* ((coeffs (car flt))
(xs (cadr flt))
(xlen (length xs)))
- (<a class=quiet href="extsnd.html#vctmove" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctmove_tip)">vct-move!</a> xs (- xlen 1) (- xlen 2) #t)
+ (float-vector-move! xs (- xlen 1) (- xlen 2) #t)
(set! (xs 0) x)
(<em class=red>dot-product</em> coeffs xs xlen)))
</pre>
-</td></tr></table>
<p>
-edot-product returns the complex dot-product of the "data" argument (a vct or a vector) with <code>(exp (* freq i))</code>.
+edot-product returns the complex dot-product of the "data" argument (a vector) with <code>(exp (* freq i))</code>.
Here, "i" goes from 0 to data's size - 1.
"freq" and the elements of "data" can be complex, as can the return value. See <a href="sndscm.html#stretchsoundviadft">stretch-sound-via-dft</a>
for an example.
@@ -10817,24 +10104,23 @@ mus-interpolate is the function used whenever table lookup interpolation is requ
<a href="#delay">delay</a> or <a href="#wave-train">wave-train</a>.
The "type" argument is one of the interpolation types (<code>mus-interp-linear</code>, for example).
</p>
-<br><br>
+<!-- CONTRAST-ENHANCEMENT -->
-<!-- ---------------------------------------- CONTRAST-ENHANCEMENT ---------------------------------------- -->
+<div class="innerheader">contrast-enhancement</div>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>contrast-enhancement</h3></center></td></tr></table>
-
-<pre>
- <a class=def name="contrast-enhancement">contrast-enhancement</a> in-samp (fm-index 1.0)
+<pre class="indented">
+<em class=def id="contrast-enhancement">contrast-enhancement</em> in-samp (fm-index 1.0)
</pre>
<p>contrast-enhancement passes its input to sin as a kind of phase modulation.
</p>
-<pre>
- (sin (+ (* input pi 0.5)
- (* index (sin (* input pi 2)))))
+
+<pre class="indented">
+(sin (+ (* input pi 0.5)
+ (* index (sin (* input pi 2)))))
</pre>
<p>
@@ -10843,52 +10129,50 @@ input, helping it cut through a huge mix.
A similar (slightly simpler) effect is:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
+<pre class="indented">
(let ((mx (maxamp)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a>
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a>
(lambda (y)
(* mx (sin (/ (* pi y) mx))))))
</pre>
-</td></tr></table>
<p>This modulates the sound but keeps the output maxamp the same as the input.
See <a href="#moving-max">moving-max</a> for a similar function that does this kind of scaling throughout the sound,
resulting in a steady modulation, rather than an intensification of just the peaks.
And a sort of converse is <a href="sndscm.html#soundinterp">sound-interp</a>.
</p>
-<br><br>
-<!-- ---------------------------------------- AMPLITUDE-MODULATE ---------------------------------------- -->
+<!-- AMPLITUDE-MODULATE -->
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>ring-modulate, amplitude-modulate</h3></center></td></tr></table>
+<div class="innerheader">ring-modulate, amplitude-modulate</div>
-<pre>
- <a class=def name="ring-modulate">ring-modulate</a> in1 in2 ; returns <code>(* in1 in2)</code>
- <a class=def name="amplitude-modulate">amplitude-modulate</a> am-carrier in1 in2 ; returns <code>(* in1 (+ am-carrier in2))</code>
+<pre class="indented">
+<em class=def id="ring-modulate">ring-modulate</em> in1 in2 ; returns <code>(* in1 in2)</code>
+<em class=def id="amplitude-modulate">amplitude-modulate</em> am-carrier in1 in2 ; returns <code>(* in1 (+ am-carrier in2))</code>
</pre>
-
-<table border=1 bordercolor="lightgray" hspace=20 vspace=10 cellspacing=8 cellpadding=5>
-
+<table>
<tr>
-<td bgcolor="#f0f4ff">
-<pre>
+<td>
+<div class="scheme">
+<pre class="indented">
(with-sound (:play #t)
(let ((osc1 (make-oscil 440.0))
(osc2 (make-oscil 220.0)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i 44100))
(outa i (* 0.5 (amplitude-modulate 0.3 (oscil osc1) (oscil osc2)))))))
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#fbfbf0">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound(:play, true) do
osc1 = make_oscil(440.0);
osc2 = make_oscil(220.0);
@@ -10897,12 +10181,14 @@ with_sound(:play, true) do
end
end.output
</pre>
+</div>
</td>
</tr><tr>
-<td bgcolor="#effdef">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
lambda: ( -- )
440.0 make-oscil { osc1 }
220.0 make-oscil { osc2 }
@@ -10914,6 +10200,7 @@ lambda: ( -- )
loop
; :play #t with-sound drop
</pre>
+</div>
</td>
</tr>
@@ -10926,10 +10213,10 @@ The nomenclature here is a bit confusing — I can't remember now why I used
these names; think of "carrier" as "carrier amplitude" and "in1" as "carrier". Normal amplitude modulation using this function is:
</p>
-<pre>
- (define carrier (<a class=quiet href="#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> carrier-freq (* .5 pi)))
- ...
- (amplitude-modulate 1.0 (<a class=quiet href="#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> carrier) signal)
+<pre class="indented">
+(define carrier (<a class=quiet href="#make-oscil">make-oscil</a> carrier-freq (* .5 pi)))
+...
+(amplitude-modulate 1.0 (<a class=quiet href="#oscil">oscil</a> carrier) signal)
</pre>
<p>Both of these functions take advantage of the "Modulation Theorem"; since
@@ -10938,7 +10225,7 @@ two pi Hz, multiplying by a sinusoid splits its spectrum into two equal parts
translated up and down by w/(two pi) Hz:
</p>
-<img src="pix/fmeq8.png" alt="coscos and sinsin" hspace=20>
+<img class="indented" src="pix/fmeq8.png" alt="coscos and sinsin">
<p>Waveshaping (via the Chebyshev polynomials) is an elaboration of AM. For example, cos^2x is amplitude modulation of cos x
with itself, splitting into cos2x and cos0x. T2 (that is, 2cos^2x - 1) then subtracts the cos0x term to return cos2x.
@@ -10947,25 +10234,23 @@ with itself, splitting into cos2x and cos0x. T2 (that is, 2cos^2x - 1) then sub
The upper sidebands may foldover (alias); if it's a problem, low-pass filter the inputs (surely no CLM user needs that silly reminder!).
</p>
-<br><br><br>
+<!-- FFT -->
-<!-- ---------------------------------------- FFT ---------------------------------------- -->
+<div class="innerheader">FFT (fourier transform)</div>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" valign="middle"><center><h3>FFT (fourier transform)</h3></center></td></tr></table>
-<pre>
- <a class=def Name="fft">mus-fft</a> rdat idat fftsize sign
- <a class=def name="make-fft-window">make-fft-window</a> type size (beta 0.0) (alpha 0.0)
- <a class=def name="multiply-arrays">multiply-arrays</a> rdat window
- <a class=def name="rectangulartopolar">rectangular->polar</a> rdat idat
- <a class=def name="rectangulartomagnitudes">rectangular->magnitudes</a> rdat idat
- <a class=def name="polartorectangular">polar->rectangular</a> rdat idat
- <a class=def name="spectrum">spectrum</a> rdat idat window norm-type
- <a class=def name="convolution">convolution</a> rdat idat size
- <a class=def name="autocorrelate">autocorrelate</a> data
- <a class=def name="correlate">correlate</a> data1 data2
+<pre class="indented">
+<em class=def id="fft">mus-fft</em> rdat idat fftsize sign
+<em class=def id="make-fft-window">make-fft-window</em> type size (beta 0.0) (alpha 0.0)
+<em class=def id="rectangulartopolar">rectangular->polar</em> rdat idat
+<em class=def id="rectangulartomagnitudes">rectangular->magnitudes</em> rdat idat
+<em class=def id="polartorectangular">polar->rectangular</em> rdat idat
+<em class=def id="spectrum">spectrum</em> rdat idat window norm-type
+<em class=def id="convolution">convolution</em> rdat idat size
+<em class=def id="autocorrelate">autocorrelate</em> data
+<em class=def id="correlate">correlate</em> data1 data2
</pre>
<p>mus-fft, spectrum, and convolution are the standard functions used everywhere.
@@ -10977,18 +10262,17 @@ only difference is that mus-fft includes the fft length as an argument, whereas
<a href="extsnd.html#fft">fft</a> does not. Here we use mus-fft to low-pass filter a sound:
</p>
-<table border=0 hspace=40><tr><td>
-<pre>
-(let* ((len (mus-sound-frames "oboe.snd"))
- (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
- (rdata (make-vct fsize))
- (idata (make-vct fsize))
+<pre class="indented">
+(let* ((len (mus-sound-framples "oboe.snd"))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (rdata (make-float-vector fsize 0.0))
+ (idata (make-float-vector fsize 0.0))
(cutoff (round (/ fsize 10)))
(fsize2 (/ fsize 2)))
(file->array "oboe.snd" 0 0 len rdata)
(<em class=red>mus-fft</em> rdata idata fsize 1)
- (do ((i cutoff (+ 1 i))
+ (do ((i cutoff (+ i 1))
(j (- fsize 1) (- j 1)))
((= i fsize2))
(set! (rdata i) 0.0)
@@ -10998,7 +10282,7 @@ only difference is that mus-fft includes the fft length as an argument, whereas
(<em class=red>mus-fft</em> rdata idata fsize -1)
(array->file "test.snd"
- (vct-scale! rdata (/ 1.0 fsize))
+ (float-vector-scale! rdata (/ 1.0 fsize))
len
(srate "oboe.snd")
1)
@@ -11007,35 +10291,35 @@ only difference is that mus-fft includes the fft length as an argument, whereas
(close-sound previous-case)))
(open-sound "test.snd"))
</pre>
-</td></tr></table>
<p>make-fft-window can return many of the standard windows including:
</p>
-<pre>
- bartlett-hann-window bartlett-window blackman2-window blackman3-window
- blackman4-window bohman-window cauchy-window connes-window
- dolph-chebyshev-window exponential-window flat-top-window gaussian-window
- hamming-window hann-poisson-window hann-window kaiser-window
- parzen-window poisson-window rectangular-window riemann-window
- samaraki-window tukey-window ultraspherical-window welch-window
- blackman5-window blackman6-window blackman7-window blackman8-window
- blackman9-window blackman10-window rv2-window rv3-window
- rv4-window mlt-sine-window papoulis-window dpss-window
- sinc-window
+<pre class="indented">
+bartlett-hann-window bartlett-window blackman2-window blackman3-window
+blackman4-window bohman-window cauchy-window connes-window
+dolph-chebyshev-window exponential-window flat-top-window gaussian-window
+hamming-window hann-poisson-window hann-window kaiser-window
+parzen-window poisson-window rectangular-window riemann-window
+samaraki-window tukey-window ultraspherical-window welch-window
+blackman5-window blackman6-window blackman7-window blackman8-window
+blackman9-window blackman10-window rv2-window rv3-window
+rv4-window mlt-sine-window papoulis-window dpss-window
+sinc-window
</pre>
<p>rectangular->polar and polar->rectangular change how we view the FFT data: in polar or rectangular coordinates.
rectangular->magnitudes is the same as rectangular->polar, but only calculates the magnitudes.
-multiply-arrays does an element-wise multiply of two vcts.
-autocorrelate performs an (in place) autocorrelation of 'data' (a vct). See <a href="#moving-pitch">moving-pitch</a> in generators.scm,
+autocorrelate performs an (in place) autocorrelation of 'data' (a float-vector). See <a href="#moving-pitch">moving-pitch</a> in generators.scm,
or <a href="sndscm.html#rubberdoc">rubber.scm</a>.
correlate performs an in-place cross-correlation of data1 and data2 (see, for example, <a href="sndscm.html#snddiffdoc">snddiff</a>).
</p>
-<table border=3 bordercolor="tan" hspace=40><th bgcolor="beige">FFTs</th><tr><td>
-<small><blockquote>
+
+<table class="method">
+<tr><td class="methodtitle">FFTs</td></tr><tr><td>
+<blockquote><small>
Hartley transform in Scheme: <a href="sndscm.html#dht">dht</a><br>
Spectral edit dialog: <a href="snd.html#editenvelope">Envelope Editor</a><br>
fft-based filter: <a href="sndscm.html#fftedit">fft-edit</a>, <a href="sndscm.html#fftenvedit">fft-env-edit</a>, <a href="sndscm.html#fftenvinterp">fft-env-interp</a>, <a href="sndscm.html#fftsquelch">fft-squelch</a>, <a href="sndscm.html#fftcancel">fft-cancel</a><br>
@@ -11052,14 +10336,12 @@ polynomial approach to spectral multiplies (convolution): <a href="sndscm.html#s
More transforms: <a href="sndscm.html#fractionalfouriertransform">fractional-fourier-transform</a>, <a href="sndscm.html#ztransform">z-transform</a> in dsp.scm<br>
bark, mel, erb scale display: <a href="sndscm.html#displaybarkfft">display-bark-fft</a><br>
apply function to spectrum, inverse fft: <a href="sndscm.html#filterfft">filter-fft</a><br>
-</blockquote></small>
+</small></blockquote>
</td></tr></table>
-<br><br>
-
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><a class=def name="instruments">Instruments</a></h3></td></tr></table>
+<div class="header" id="instruments">Instruments</div>
<p>It's hard to decide what's an "instrument" in this context, but I think I'll treat
it as something that can be called as a note in a notelist (in with-sound) and
@@ -11072,460 +10354,556 @@ test 23 in snd-test.
</p>
-<table border=8 bordercolor="lightgreen" cellpadding=2 hspace=10>
-<tr><th width=120 bgcolor="beige">instrument</th><th bgcolor="beige">function</th><th bgcolor="beige">CL</th><th bgcolor="beige">Scheme</th><th bgcolor="beige">Ruby</th><th bgcolor="beige">Forth</th></tr>
-<tr><td>complete-add</td>
- <td>additive synthesis</td>
- <td>add.ins</td>
+<table class="borderspaced">
+<tr>
+<th class="beige">instrument</th>
+<th class="beige">function</th>
+<th class="beige">CL</th>
+<th class="beige">Scheme</th>
+<th class="beige">Ruby</th>
+<th class="beige">Forth</th>
+</tr>
+<tr><td class="br">complete-add</td>
+ <td class="br">additive synthesis</td>
+ <td class="br">add.ins</td>
+ <td></td>
+ <td></td>
+ <td></td>
+ </tr>
+
+<tr><td class="br">addflts</td>
+ <td class="br">filters</td>
+ <td class="br">addflt.ins</td>
+ <td class="br"><a href="dsp.scm">dsp.scm</a></td>
+ <td class="br"><a href="dsp.rb">dsp.rb</a></td>
+ <td></td>
+ </tr>
+
+<tr><td class="br">add-sound</td>
+ <td class="br">mix in a sound file</td>
+ <td class="br">addsnd.ins</td>
+ <td></td>
+ <td></td>
+ <td></td>
+ </tr>
+
+<tr><td class="br">bullfrog et al</td>
+ <td class="br">many animals (frogs, insects, birds)</td>
+ <td class="br"></td>
+ <td class="br"><a href="animals.scm">animals.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>addflts</td>
- <td>filters</td>
- <td>addflt.ins</td>
- <td><a href="dsp.scm">dsp.scm</a></td>
- <td><a href="dsp.rb">dsp.rb</a></td>
+<tr><td class="br">anoi</td>
+ <td class="br">noise reduction</td>
+ <td class="br">anoi.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>add-sound</td>
- <td>mix in a sound file</td>
- <td>addsnd.ins</td>
+<tr><td class="br">autoc</td>
+ <td class="br">pitch estimation (Bret Battey)</td>
+ <td class="br">autoc.ins</td>
+ <td></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>bullfrog et al</td>
- <td>many animals (frogs, insects, birds)</td>
+<tr><td class="br">badd</td>
+ <td class="br">fancier additive synthesis (Doug Fulton)</td>
+ <td class="br">badd.ins</td>
+ <td></td>
+ <td></td>
<td></td>
- <td><a href="animals.scm">animals.scm</a></td>
</tr>
-<tr><td>anoi</td>
- <td>noise reduction</td>
- <td>anoi.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">bandedwg</td>
+ <td class="br">Juan Reyes banded waveguide instrument</td>
+ <td class="br">bandedwg.ins</td>
+ <td class="br"><a href="bandedwg.cms">bandedwg.cms</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>autoc</td>
- <td>autocorrelation-based pitch estimation (Bret Battey)</td>
- <td>autoc.ins</td>
+<tr><td class="br">fm-bell</td>
+ <td class="br">fm bell sounds (Michael McNabb)</td>
+ <td class="br">bell.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>badd</td>
- <td>fancier additive synthesis (Doug Fulton)</td>
- <td>badd.ins</td>
+<tr><td class="br">bigbird</td>
+ <td class="br">waveshaping</td>
+ <td class="br">bigbird.ins</td>
+ <td class="br"><a href="bird.scm">bird.scm</a></td>
+ <td class="br"><a href="bird.rb">bird.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs, bird.fs</a></td>
</tr>
-<tr><td>fm-bell</td>
- <td>fm bell sounds (Michael McNabb)</td>
- <td>bell.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">singbowl</td>
+ <td class="br">Juan Reyes Tibetan bowl instrument</td>
+ <td class="br">bowl.ins</td>
+ <td class="br"><a href="bowl.cms">bowl.cms</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>bigbird</td>
- <td>waveshaping</td>
- <td>bigbird.ins</td>
- <td><a href="bird.scm">bird.scm</a></td>
- <td><a href="bird.rb">bird.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs, bird.fs</a></td>
+<tr><td class="br">canter</td>
+ <td class="br">fm bagpipes (Peter Commons)</td>
+ <td class="br">canter.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>canter</td>
- <td>fm bagpipes (Peter Commons)</td>
- <td>canter.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">cellon</td>
+ <td class="br">feedback fm (Stanislaw Krupowicz)</td>
+ <td class="br">cellon.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>cellon</td>
- <td>feedback fm (Stanislaw Krupowicz)</td>
- <td>cellon.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">cnvrev</td>
+ <td class="br">convolution (aimed at reverb)</td>
+ <td class="br">cnv.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>cnvrev</td>
- <td>convolution (aimed at reverb)</td>
- <td>cnv.ins</td><td><a href="clm-ins.scm">clm-ins.scm</a></td>
+<tr><td class="br">moving sounds</td>
+ <td class="br">sound movement (Fernando Lopez-Lezcano)</td>
+ <td class="br">dlocsig.lisp</td>
+ <td class="br"><a href="dlocsig.scm">dlocsig.scm</a></td>
+ <td class="br"><a href="dlocsig.rb">dlocsig.rb</a></td>
+ <td></td>
</tr>
-<tr><td>moving sounds</td>
- <td>quad sound movement (Fernando Lopez-Lezcano)</td>
- <td>dlocsig.lisp</td>
- <td><a href="dlocsig.scm">dlocsig.scm</a></td>
- <td><a href="dlocsig.rb">dlocsig.rb</a></td>
+<tr><td class="br">drone</td>
+ <td class="br">additive synthesis (bag.clm) (Peter Commons)</td>
+ <td class="br">drone.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>drone</td>
- <td>additive synthesis (bag.clm) (Peter Commons)</td>
- <td>drone.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">expandn</td>
+ <td class="br">granular synthesis (Michael Klingbeil)</td>
+ <td class="br">expandn.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>expandn</td>
- <td>granular synthesis (Michael Klingbeil)</td>
- <td>expandn.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td></td>
- <td></td>
+<tr><td class="br">granulate-sound</td>
+ <td class="br">examples granular synthesis</td>
+ <td class="br">expsrc.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>granulate-sound</td>
- <td>examples of the granulate generator (granular synthesis)</td>
- <td>expsrc.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">cross-fade</td>
+ <td class="br">cross-fades in the frequency domain</td>
+ <td class="br">fade.ins</td>
+ <td class="br"><a href="fade.scm">fade.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>cross-fade</td>
- <td>cross-fades and dissolves in the frequency domain</td>
- <td>fade.ins</td>
- <td><a href="fade.scm">fade.scm</a></td>
+<tr><td class="br">filter-sound</td>
+ <td class="br">filter a sound file</td>
+ <td class="br">fltsnd.ins</td>
+ <td class="br"><a href="dsp.scm">dsp.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>filter-sound</td>
- <td>filter a sound file</td>
- <td>fltsnd.ins</td>
- <td><a href="dsp.scm">dsp.scm</a></td>
+<tr><td class="br">stereo-flute</td>
+ <td class="br">physical model of a flute (Nicky Hind)</td>
+ <td class="br">flute.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>stereo-flute</td>
- <td>physical model of a flute (Nicky Hind)</td>
- <td>flute.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">fm examples</td>
+ <td class="br">fm bell, gong, drum (Paul Weineke, Jan Mattox)</td>
+ <td class="br">fmex.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>fm examples</td>
- <td>fm bell, gong, drum (Paul Weineke, Jan Mattox)</td>
- <td>fmex.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">Jezar's reverb</td>
+ <td class="br">fancy reverb (Jezar Wakefield)</td>
+ <td class="br">freeverb.ins</td>
+ <td class="br"><a href="freeverb.scm">freeverb.scm</a></td>
+ <td class="br"><a href="freeverb.rb">freeverb.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>Jezar's reverb</td>
- <td>fancy reverb (Jezar Wakefield)</td>
- <td>freeverb.ins</td>
- <td><a href="freeverb.scm">freeverb.scm</a></td>
- <td><a href="freeverb.rb">freeverb.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">fofins</td>
+ <td class="br">FOF synthesis</td>
+ <td class="br"><a href="#wave-train">sndclm.html</a></td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>fofins</td>
- <td>FOF synthesis</td>
- <td><a href="#wave-train">sndclm.html</a></td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">fullmix</td>
+ <td class="br">a mixer</td>
+ <td class="br">fullmix.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>fullmix</td>
- <td>a mixer</td>
- <td>fullmix.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">grani</td>
+ <td class="br">granular synthesis (Fernando Lopez-Lezcano)</td>
+ <td class="br">grani.ins</td>
+ <td class="br"><a href="grani.scm">grani.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>grani</td>
- <td>granular synthesis (Fernando Lopez-Lezcano)</td>
- <td>grani.ins</td>
- <td><a href="grani.scm">grani.scm</a></td>
+<tr><td class="br">grapheq</td>
+ <td class="br">graphic equalizer (Marco Trevisani)</td>
+ <td class="br">grapheq.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>grapheq</td>
- <td>graphic equalizer (Marco Trevisani)</td>
- <td>grapheq.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">fm-insect</td>
+ <td class="br">fm</td>
+ <td class="br">insect.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td></td>
</tr>
-<tr><td>fm-insect</td>
- <td>fm</td>
- <td>insect.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
+<tr><td class="br">jc-reverb</td>
+ <td class="br">a reverberator (see also jlrev)</td>
+ <td class="br">jcrev.ins</td>
+ <td class="br"><a href="jcrev.scm">jcrev.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>jc-reverb</td>
- <td>an old reverberator (jlrev is a cavernous version)</td>
- <td>jcrev.ins</td>
- <td><a href="jcrev.scm">jcrev.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">fm-voice</td>
+ <td class="br">fm voice (John Chowning)</td>
+ <td class="br">jcvoi.ins</td>
+ <td class="br"><a href="jcvoi.scm">jcvoi.scm </a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>fm-voice</td>
- <td>fm voice (John Chowning)</td>
- <td>jcvoi.ins</td>
- <td><a href="jcvoi.scm">jcvoi.scm </a></td>
+<tr><td class="br">kiprev</td>
+ <td class="br">a fancier reverberator (Kip Sheeline)</td>
+ <td class="br">kiprev.ins</td>
+ <td></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>kiprev</td>
- <td>a fancier (temperamental) reverberator (Kip Sheeline)</td>
- <td>kiprev.ins</td>
+<tr><td class="br">lbj-piano</td>
+ <td class="br">additive synthesis piano (Doug Fulton)</td>
+ <td class="br">lbjPiano.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>lbj-piano</td>
- <td>additive synthesis piano (Doug Fulton)</td>
- <td>lbjPiano.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">rotates</td>
+ <td class="br">Juan Reyes Leslie instrument</td>
+ <td class="br">leslie.ins</td>
+ <td class="br"><a href="leslie.cms">leslie.cms</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>maraca</td>
- <td>Perry Cook's maraca physical models</td>
- <td>maraca.ins</td>
- <td><a href="maraca.scm">maraca.scm</a></td>
- <td><a href="maraca.rb">maraca.rb</a></td>
+<tr><td class="br">maraca</td>
+ <td class="br">Perry Cook's maraca physical models</td>
+ <td class="br">maraca.ins</td>
+ <td class="br"><a href="maraca.scm">maraca.scm</a></td>
+ <td class="br"><a href="maraca.rb">maraca.rb</a></td>
+ <td></td>
</tr>
-<tr><td>maxfilter</td>
- <td>Juan Reyes modular synthesis</td>
- <td>maxf.ins</td>
- <td><a href="maxf.scm">maxf.scm</a></td>
- <td><a href="maxf.rb">maxf.rb</a></td>
+<tr><td class="br">maxfilter</td>
+ <td class="br">Juan Reyes modular synthesis</td>
+ <td class="br">maxf.ins</td>
+ <td class="br"><a href="maxf.scm">maxf.scm</a></td>
+ <td class="br"><a href="maxf.rb">maxf.rb</a></td>
+ <td></td>
</tr>
-<tr><td>mlb-voice</td>
- <td>fm (originally waveshaping) voice (Marc LeBrun)</td>
- <td>mlbvoi.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">mlb-voice</td>
+ <td class="br">fm voice (Marc LeBrun)</td>
+ <td class="br">mlbvoi.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>moog filters</td>
- <td>Moog filters (Fernando Lopez-Lezcano)</td>
- <td>moog.lisp</td>
- <td><a href="moog.scm">moog.scm</a></td>
+<tr><td class="br">moog filters</td>
+ <td class="br">Moog filters (Fernando Lopez-Lezcano)</td>
+ <td class="br">moog.lisp</td>
+ <td class="br"><a href="moog.scm">moog.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>fm-noise</td>
- <td>noise maker</td>
- <td>noise.ins</td>
- <td><a href="noise.scm">noise.scm</a></td>
- <td><a href="noise.rb">noise.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">fm-noise</td>
+ <td class="br">noise maker</td>
+ <td class="br">noise.ins</td>
+ <td class="br"><a href="noise.scm">noise.scm</a></td>
+ <td class="br"><a href="noise.rb">noise.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>nrev</td>
- <td>a popular reverberator (Michael McNabb)</td>
- <td>nrev.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">nrev</td>
+ <td class="br">a popular reverberator (Michael McNabb)</td>
+ <td class="br">nrev.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>one-cut</td>
- <td>a "cut and paste" instrument (Fernando Lopez-Lezcano)</td>
- <td>one-cut.ins</td>
+<tr><td class="br">one-cut</td>
+ <td class="br">"cut and paste" (Fernando Lopez-Lezcano)</td>
+ <td class="br">one-cut.ins</td>
+ <td></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>p</td>
- <td>Scott van Duyne's piano physical model</td>
- <td>piano.ins</td>
- <td><a href="piano.scm">piano.scm</a></td>
- <td><a href="piano.rb">piano.rb</a></td>
+<tr><td class="br">p</td>
+ <td class="br">Scott van Duyne's piano physical model</td>
+ <td class="br">piano.ins</td>
+ <td class="br"><a href="piano.scm">piano.scm</a></td>
+ <td class="br"><a href="piano.rb">piano.rb</a></td>
+ <td></td>
</tr>
-<tr><td>pluck</td>
- <td>Karplus-Strong synthesis (David Jaffe)</td>
- <td>pluck.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">pluck</td>
+ <td class="br">Karplus-Strong synthesis (David Jaffe)</td>
+ <td class="br">pluck.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>pqw</td>
- <td>waveshaping</td>
- <td>pqw.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">pqw</td>
+ <td class="br">waveshaping</td>
+ <td class="br">pqw.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>pqw-vox</td>
- <td>waveshaping voice</td>
- <td>pqwvox.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">pqw-vox</td>
+ <td class="br">waveshaping voice</td>
+ <td class="br">pqwvox.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>physical models</td>
- <td>physical modelling (Perry Cook)</td>
- <td>prc-toolkit95.lisp</td>
- <td><a href="prc95.scm">prc95.scm</a></td>
- <td><a href="prc95.rb">prc95.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">physical models</td>
+ <td class="br">physical modelling (Perry Cook)</td>
+ <td class="br">prc-toolkit95.lisp</td>
+ <td class="br"><a href="prc95.scm">prc95.scm</a></td>
+ <td class="br"><a href="prc95.rb">prc95.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>various ins</td>
- <td>from Perry Cook's Synthesis Toolkit</td>
- <td>prc96.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">various ins</td>
+ <td class="br">from Perry Cook's Synthesis Toolkit</td>
+ <td class="br">prc96.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>pvoc</td>
- <td>phase vocoder (Michael Klingbeil)</td>
- <td>pvoc.ins</td>
- <td><a href="pvoc.scm">pvoc.scm</a></td>
- <td><a href="pvoc.rb">pvoc.rb</a></td>
+<tr><td class="br">pvoc</td>
+ <td class="br">phase vocoder (Michael Klingbeil)</td>
+ <td class="br">pvoc.ins</td>
+ <td class="br"><a href="pvoc.scm">pvoc.scm</a></td>
+ <td class="br"><a href="pvoc.rb">pvoc.rb</a></td>
+ <td></td>
</tr>
-<tr><td>resflt</td>
- <td>filters (3 resonators) (Xavier Serra, Richard Karpen)</td>
- <td>resflt.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">resflt</td>
+ <td class="br">filters (Xavier Serra, Richard Karpen)</td>
+ <td class="br">resflt.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>reson</td>
- <td>fm formants (John Chowning)</td>
- <td>reson.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">reson</td>
+ <td class="br">fm formants (John Chowning)</td>
+ <td class="br">reson.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>ring-modulate</td>
- <td>ring-modulation of sounds (Craig Sapp)</td>
- <td>ring-modulate.ins</td>
- <td><a href="examp.scm">examp.scm</a></td>
- <td><a href="examp.rb">examp.rb</a></td>
+<tr><td class="br">ring-modulate</td>
+ <td class="br">ring-modulation of sounds (Craig Sapp)</td>
+ <td class="br">ring-modulate.ins</td>
+ <td class="br"><a href="examp.scm">examp.scm</a></td>
+ <td class="br"><a href="examp.rb">examp.rb</a></td>
+ <td></td>
</tr>
-<tr><td>rmsenv</td>
- <td>rms envelope of sound (Bret Battey)</td>
- <td>rmsenv.ins</td>
+<tr><td class="br">rmsenv</td>
+ <td class="br">rms envelope of sound (Bret Battey)</td>
+ <td class="br">rmsenv.ins</td>
+ <td></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>pins</td>
- <td>spectral modelling</td>
- <td>san.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">pins</td>
+ <td class="br">spectral modelling</td>
+ <td class="br">san.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>scanned</td>
- <td>Juan Reyes scanned synthesis instrument</td>
- <td>scanned.ins</td>
- <td><a href="dsp.scm">dsp.scm</a></td>
+<tr><td class="br">scanned</td>
+ <td class="br">Juan Reyes scanned synthesis instrument</td>
+ <td class="br">scanned.ins</td>
+ <td class="br"><a href="dsp.scm">dsp.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>scentroid</td>
- <td>spectral scentroid envelope (Bret Battey)</td>
- <td>scentroid.ins</td>
- <td><a href="dsp.scm">dsp.scm</a></td>
+<tr><td class="br">scentroid</td>
+ <td class="br">spectral scentroid envelope (Bret Battey)</td>
+ <td class="br">scentroid.ins</td>
+ <td class="br"><a href="dsp.scm">dsp.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>shepard</td>
- <td>Shepard tones (Juan Reyes)</td>
- <td>shepard.ins</td>
- <td><a href="sndscm.html#wsdoc">sndscm.html</a></td>
- <td></td>
+<tr><td class="br">shepard</td>
+ <td class="br">Shepard tones (Juan Reyes)</td>
+ <td class="br">shepard.ins</td>
+ <td class="br"><a href="sndscm.html#wsdoc">sndscm.html</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>singer</td>
- <td>Perry Cook's vocal tract physical model</td>
- <td>singer.ins</td>
- <td><a href="singer.scm">singer.scm</a></td>
- <td><a href="singer.rb">singer.rb</a></td>
+<tr><td class="br">singer</td>
+ <td class="br">Perry Cook's vocal tract physical model</td>
+ <td class="br">singer.ins</td>
+ <td class="br"><a href="singer.scm">singer.scm</a></td>
+ <td class="br"><a href="singer.rb">singer.rb</a></td>
+ <td></td>
</tr>
-<tr><td>sndwarp</td>
- <td>Csound-like sndwarp generator (Bret Battey)</td>
- <td>sndwarp.ins</td>
- <td><a href="sndwarp.scm">sndwarp.scm</a></td>
+<tr><td class="br">sndwarp</td>
+ <td class="br">Csound-like sndwarp generator (Bret Battey)</td>
+ <td class="br">sndwarp.ins</td>
+ <td class="br"><a href="sndwarp.scm">sndwarp.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>stochastic</td>
- <td>Bill Sack's stochastic synthesis implementation</td>
- <td>stochastic.ins</td><td><a href="stochastic.scm">stochastic.scm</a></td>
+<tr><td class="br">stochastic</td>
+ <td class="br">Bill Sack's stochastic synthesis implementation</td>
+ <td class="br">stochastic.ins</td><td class="br"><a href="stochastic.scm">stochastic.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>bow</td>
- <td>Juan Reyes bowed string physical model</td>
- <td>strad.ins</td>
- <td><a href="strad.scm">strad.scm</a></td>
- <td><a href="strad.rb">strad.rb</a></td>
+<tr><td class="br">bow</td>
+ <td class="br">Juan Reyes bowed string physical model</td>
+ <td class="br">strad.ins</td>
+ <td class="br"><a href="strad.scm">strad.scm</a></td>
+ <td class="br"><a href="strad.rb">strad.rb</a></td>
+ <td></td>
</tr>
-<tr><td>track-rms</td>
- <td>rms envelope of sound file (Michael Edwards)</td>
- <td>track-rms.ins</td>
+<tr><td class="br">track-rms</td>
+ <td class="br">rms envelope of sound file (Michael Edwards)</td>
+ <td class="br">track-rms.ins</td>
+ <td></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>fm-trumpet</td>
- <td>fm trumpet (Dexter Morrill)</td>
- <td>trp.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">fm-trumpet</td>
+ <td class="br">fm trumpet (Dexter Morrill)</td>
+ <td class="br">trp.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>various ins</td>
- <td>granular synthesis, formants, etc</td>
- <td>ugex.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
+<tr><td class="br">various ins</td>
+ <td class="br">granular synthesis, formants, etc</td>
+ <td class="br">ugex.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td></td>
</tr>
-<tr><td>test ins</td>
- <td>CLM regression tests — see clm-test.lisp</td>
- <td>ug(1,2,3,4).ins</td>
- <td><a href="clm23.scm">clm23.scm</a></td>
+<tr><td class="br">test ins</td>
+ <td class="br">CLM regression tests — see clm-test.lisp</td>
+ <td class="br">ug(1,2,3,4).ins</td>
+ <td class="br"><a href="clm23.scm">clm23.scm</a></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>fm-violin</td>
- <td>fm violin (fmviolin.clm, popi.clm)</td>
- <td>v.ins</td>
- <td><a href="v.scm">v.scm</a></td>
- <td><a href="v.rb">v.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">fm-violin</td>
+ <td class="br">fm violin (fmviolin.clm, popi.clm)</td>
+ <td class="br">v.ins</td>
+ <td class="br"><a href="v.scm">v.scm</a></td>
+ <td class="br"><a href="v.rb">v.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>vowel</td>
- <td>vowels via pulse-train and formant (Michelle Daniels)</td>
- <td>vowel.ins</td>
+<tr><td class="br">vowel</td>
+ <td class="br">vowels (Michelle Daniels)</td>
+ <td class="br">vowel.ins</td>
+ <td></td>
+ <td></td>
+ <td></td>
</tr>
-<tr><td>vox</td>
- <td>fm voice (cream.clm)</td>
- <td>vox.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">vox</td>
+ <td class="br">fm voice (cream.clm)</td>
+ <td class="br">vox.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>zc, zn</td>
- <td>interpolating delays</td>
- <td>zd.ins</td>
- <td><a href="clm-ins.scm">clm-ins.scm</a></td>
- <td><a href="clm-ins.rb">clm-ins.rb</a></td>
- <td><a href="clm-ins.fs">clm-ins.fs</a></td>
+<tr><td class="br">zc, zn</td>
+ <td class="br">interpolating delays</td>
+ <td class="br">zd.ins</td>
+ <td class="br"><a href="clm-ins.scm">clm-ins.scm</a></td>
+ <td class="br"><a href="clm-ins.rb">clm-ins.rb</a></td>
+ <td class="br"><a href="clm-ins.fs">clm-ins.fs</a></td>
</tr>
-<tr><td>zipper</td>
- <td>The 'digital zipper' effect.</td>
- <td>zipper.ins</td>
- <td><a href="zip.scm">zip.scm</a></td>
- <td><a href="zip.rb">zip.rb</a></td>
+<tr><td class="br">zipper</td>
+ <td class="br">The 'digital zipper' effect.</td>
+ <td class="br">zipper.ins</td>
+ <td class="br"><a href="zip.scm">zip.scm</a></td>
+ <td class="br"><a href="zip.rb">zip.rb</a></td>
+ <td></td>
</tr>
</table>
@@ -11534,27 +10912,21 @@ test 23 in snd-test.
If you develop
an interesting instrument that you're willing to share, please send it to me
(bil at ccrma.stanford.edu).
-</p>
-
-<p><a href="sndscm.html#definstrument">definstrument</a>, the individual instruments, and <a href="sndscm.html#wsdoc">with-sound</a> are documented in
+<a href="sndscm.html#definstrument">definstrument</a>, the individual instruments, and <a href="sndscm.html#wsdoc">with-sound</a> are documented in
<a href="sndscm.html">sndscm.html</a>.
</p>
-<br><br>
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="extsnd.html">extsnd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="fm.html">fm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
</body></html>
diff --git a/sndctrl.c b/sndctrl.c
deleted file mode 100644
index 556ac9a..0000000
--- a/sndctrl.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/* sndctrl shows how to send a running Snd program a command through X */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <X11/Xlib.h>
-#include <X11/Xutil.h>
-#include <X11/Xatom.h>
-
-
-#define SND_VERSION "SND_VERSION"
-#define SND_COMMAND "SND_COMMAND"
-
-
-static Window compare_window(Display *display, Window window, char *id)
-{
- Atom type;
- int format;
- unsigned long nitems, bytesafter;
- unsigned char *version[1];
- Window found=(Window)None;
- if (((XGetWindowProperty(display, window, XInternAtom (display, id, False), 0L, (long)BUFSIZ, False,
- XA_STRING, &type, &format, &nitems, &bytesafter, (unsigned char **)version)) == Success) && (type != None))
- {
- found = window;
- if (version[0]) XFree((char *)(version[0]));
- }
- return(found);
-}
-
-
-static Window find_window(Display *display, Window starting_window, char *name, Window (*compare_func)())
-{
- Window rootwindow, window_parent;
- int i = 0;
- unsigned int num_children = 0;
- Window *children = NULL;
- Window window = (compare_func)(display, starting_window, name);
- if (window != (Window)None)return (window);
- if ((XQueryTree(display, starting_window, &rootwindow, &window_parent, &children, &num_children)) == 0) return ((Window)None);
- while ((i < num_children) && (window == (Window)None))
- window = find_window(display, children[i++], name, compare_func);
- if (children) XFree((char *)children);
- return(window);
-}
-
-
-static void send_snd(Display *dpy, char *command)
-{
- Window window;
- if ((window = find_window(dpy, DefaultRootWindow(dpy), SND_VERSION, compare_window)))
- {
- XChangeProperty(dpy, window, XInternAtom(dpy, SND_COMMAND, False), XA_STRING, 8, PropModeReplace, (unsigned char *)command, strlen(command)+1);
- XFlush(dpy);
- }
-}
-
-
-static void send_snd_char(Display *dpy, Window window, int keycode, int state)
-{
- /* this sends Snd a key event */
- XKeyEvent event;
- int status;
- event.type = KeyPress;
- event.display = dpy;
- event.window = window;
- event.root = RootWindow(dpy, DefaultScreen(dpy));
- event.keycode = keycode;
- event.state = state;
- event.time = CurrentTime;
- event.same_screen = True;
- event.x = 0;
- event.y = 0;
- event.x_root = 0;
- event.y_root = 0;
- event.subwindow = (Window)None;
- status = XSendEvent(dpy, window, False, KeyPressMask, (XEvent *)(&event));
- if (status != 0)
- {
- event.type = KeyRelease;
- event.time = CurrentTime;
- XSendEvent(dpy, window, True, KeyReleaseMask, (XEvent *)(&event));
- }
-}
-
-
-int main(int argc, char **argv)
-{
- Display *dpy;
- dpy = XOpenDisplay(NULL);
- send_snd(dpy, "(snd-print \"hiho\")");
-}
-
-
-/* cc sndctrl.c -g -o sndctrl -L/usr/X11R6/lib -lX11 */
-
-#if 0
-/*
- Window window;
- dpy = XOpenDisplay(NULL);
- if ((window = find_window(dpy, DefaultRootWindow(dpy), SND_VERSION, compare_window)))
- {
- send_snd_char(dpy, window, XKeysymToKeycode(dpy, XK_greater), ShiftMask | Mod1Mask);
- XFlush(dpy);
- }
-*/
-#endif
diff --git a/snddiff.scm b/snddiff.scm
index cbec254..779c87d 100644
--- a/snddiff.scm
+++ b/snddiff.scm
@@ -2,55 +2,46 @@
(define (cross-correlate snd0 chn0 snd1 chn1)
- (let* ((len0 (frames snd0 chn0))
- (len1 (frames snd1 chn1))
+ (let* ((len0 (framples snd0 chn0))
+ (len1 (framples snd1 chn1))
(ilen (max len0 len1))
- (pow2 (ceiling (/ (log ilen) (log 2))))
- (fftlen (floor (expt 2 pow2)))
- (fftlen2 (/ fftlen 2))
- (fftscale (/ 1.0 fftlen)))
- (correlate (channel->vct 0 fftlen snd1 chn1)
- (channel->vct 0 fftlen snd0 chn0))))
+ (pow2 (ceiling (log ilen 2)))
+ (fftlen (floor (expt 2 pow2))))
+ (correlate (channel->float-vector 0 fftlen snd1 chn1)
+ (channel->float-vector 0 fftlen snd0 chn0))))
(define (lag? snd0 chn0 snd1 chn1)
;; returns the probable lagtime between the two sounds (negative means second sound is delayed)
(let* ((corr (cross-correlate snd0 chn0 snd1 chn1))
(len (length corr))
- (pk (- (vct-peak corr) .000001))
- (pos -1)
- (lag (do ((i 0 (+ i 1)))
- ((or (= i len)
- (>= pos 0))
- pos)
- (if (>= (vct-ref corr i) pk)
- (set! pos i)))))
+ (data (float-vector-peak-and-location corr))
+ (lag (cadr data)))
(if (= lag -1)
0
(if (< lag (/ len 2))
lag
- (- (- len lag))))))
+ (- lag len)))))
(define* (snddiff-1 v0 v1 (maxdiff 0.0))
- (let ((diff (vct-subtract! (vct-copy v0) v1)))
- (if (<= (vct-peak diff) maxdiff)
+ (let ((diff (float-vector-subtract! (copy v0) v1)))
+ (if (<= (float-vector-peak diff) maxdiff)
'no-difference
(let ((diffs 0)
- (diff-data '())
+ (diff-data ())
(len (min (length v0) (length v1))))
(do ((i 0 (+ i 1)))
((or (> diffs 10)
(= i len)))
- (if (> (abs (- (vct-ref v0 i) (vct-ref v1 i))) .00001)
+ (if (> (abs (diff i)) .00001)
(begin
(set! diffs (+ diffs 1))
- (set! diff-data (cons (list i (vct-ref v0 i) (vct-ref v1 i)) diff-data)))))
- (if (< diffs 10)
- (list 'differences diff-data)
- #f)))))
+ (set! diff-data (cons (list i (v0 i) (v1 i)) diff-data)))))
+ (and (< diffs 10)
+ (list 'differences diff-data))))))
-(define (vct-size v)
+(define (float-vector-size v)
(sqrt (dot-product v v)))
(define (unconvolve-1 v0 v1 impulse-response) ; assume here that v0 is the original and that we're aligned, and both are trimmed at the front
@@ -60,62 +51,60 @@
(do ((i 0 (+ i 1)))
((or (>= pos 0)
(= i len)))
- (if (not (= (vct-ref v1 i) 0.0))
+ (if (not (= (v1 i) 0.0))
(set! pos i)))
(if (>= pos 0) ; if still -1, must be all zero
- (let ((scl (/ (vct-ref v1 pos) (vct-ref v0 0)))
- (size (vct-size v1)))
- (vct-subtract!
- (vct-move! v1 0 pos) ; align new copy with original (todo: move doesn't clear trailing entries)
- (vct-scale! (vct-copy v0) scl)) ; subtract original scaled to fit first none zero point
+ (let ((scl (/ (v1 pos) (v0 0)))
+ (size (float-vector-size v1)))
+ (float-vector-subtract!
+ (float-vector-move! v1 0 pos) ; align new copy with original (todo: move doesn't clear trailing entries)
+ (float-vector-scale! (copy v0) scl)) ; subtract original scaled to fit first none zero point
- (if (< (vct-size v1) size)
+ (if (< (float-vector-size v1) size)
(unconvolve-1 v0 v1 (cons (list scl pos) impulse-response))
impulse-response))
impulse-response)))
(define (unconvolve v0 v1)
- (and (vct? v0)
- (vct? v1)
+ (and (float-vector? v0)
+ (float-vector? v1)
(let ((trim -1)
(len (min (length v0) (length v1))))
(do ((i 0 (+ i 1)))
((or (> trim -1)
(= i len)))
- (if (or (not (= (vct-ref v0 i) 0.0))
- (not (= (vct-ref v1 i) 0.0)))
+ (if (or (not (= (v0 i) 0.0))
+ (not (= (v1 i) 0.0)))
(set! trim i)))
(if (> trim 0)
(begin
- (vct-move! v0 0 trim)
- (vct-move! v1 0 trim)))
- (let ((result (unconvolve-1 v0 (vct-copy v1) '())))
- (if (not (null? result))
- (list 'filter (reverse result))
- #f)))))
+ (float-vector-move! v0 0 trim)
+ (float-vector-move! v1 0 trim)))
+ (let ((result (unconvolve-1 v0 (copy v1) ())))
+ (and (pair? result)
+ (list 'filter (reverse result)))))))
(define (snddiff-2 snd0 chn0 snd1 chn1)
;; this can currently find initial delays, scaling differences, and scattered individual sample differences
- (let ((len0 (frames snd0 chn0))
- (len1 (frames snd1 chn1)))
+ (let ((len0 (framples snd0 chn0))
+ (len1 (framples snd1 chn1)))
(or (and (= len0 len1)
- (let ((s0 (channel->vct 0 #f snd0 chn0))
- (s1 (channel->vct 0 #f snd1 chn1)))
+ (let ((s0 (channel->float-vector 0 #f snd0 chn0))
+ (s1 (channel->float-vector 0 #f snd1 chn1)))
(or (snddiff-1 s0 s1 0.0)
(let* ((pos (maxamp-position snd0 chn0))
(mx0 (sample pos snd0 chn0))
(mx1 (sample pos snd1 chn1)) ; use actual values to keep possible sign difference
(scl (/ mx1 mx0))
- (diff (snddiff-1 (vct-scale! s0 scl) s1)))
+ (diff (snddiff-1 (float-vector-scale! s0 scl) s1)))
(if (eq? diff 'no-difference)
(list 'scale scl)
- (if (list? diff)
- (list 'scale scl 'differences diff)
- #f))))))
+ (and (list? diff)
+ (list 'scale scl 'differences diff)))))))
;; align sounds and zero out any non-overlapping sections, keeping track of whether they are zero beforehand
(let ((lag (lag? snd0 chn0 snd1 chn1))
@@ -127,47 +116,44 @@
(if (> lag 0)
(begin
(pad-channel 0 lag snd1 chn1)
- (set! pre0 (vct-peak (channel->vct 0 lag snd0 chn0)))
+ (set! pre0 (float-vector-peak (channel->float-vector 0 lag snd0 chn0)))
(if (> pre0 0.0)
(scale-channel 0.0 0 lag snd0 chn0)))
(if (< lag 0)
(let ((pad (- lag)))
(pad-channel 0 pad snd0 chn0)
- (set! pre1 (vct-peak (channel->vct 0 pad snd1 chn1)))
+ (set! pre1 (float-vector-peak (channel->float-vector 0 pad snd1 chn1)))
(if (> pre1 0.0)
(scale-channel 0.0 0 pad snd1 chn1)))))
- (set! len0 (frames snd0 chn0))
- (set! len1 (frames snd1 chn1))
+ (set! len0 (framples snd0 chn0))
+ (set! len1 (framples snd1 chn1))
(if (> len0 len1)
(let ((dur (- len0 len1)))
- (set! post0 (vct-peak (channel->vct len1 dur snd0 chn0)))
+ (set! post0 (float-vector-peak (channel->float-vector len1 dur snd0 chn0)))
(scale-channel 0.0 len1 dur snd0 chn0))
(if (> len1 len0)
(let ((dur (- len1 len0)))
- (set! post1 (vct-peak (channel->vct len0 dur snd1 chn1)))
+ (set! post1 (float-vector-peak (channel->float-vector len0 dur snd1 chn1)))
(scale-channel 0.0 len0 dur snd1 chn1))))
- (let ((s0 (channel->vct 0 #f snd0 chn0))
- (s1 (channel->vct 0 #f snd1 chn1)))
+ (let ((s0 (channel->float-vector 0 #f snd0 chn0))
+ (s1 (channel->float-vector 0 #f snd1 chn1)))
(or (let ((res (snddiff-1 s0 s1 0.0)))
- (if res
- (if (> lag 0)
- (list 'lag lag res pre0 pre1 post0 post1)
- (list res pre0 pre1 post0 post1))
- #f))
+ (and res
+ (if (> lag 0)
+ (list 'lag lag res pre0 pre1 post0 post1)
+ (list res pre0 pre1 post0 post1))))
(let* ((pos (maxamp-position snd0 chn0))
(mx0 (sample pos snd0 chn0))
(mx1 (sample pos snd1 chn1)) ; use actual values to keep possible sign difference
(scl (/ mx1 mx0))
- (diff (snddiff-1 (vct-scale! s0 scl) s1 0.0001)))
+ (diff (snddiff-1 (float-vector-scale! s0 scl) s1 0.0001)))
(if (eq? diff 'no-difference)
(list 'scale scl 'lag lag pre0 pre1 post0 post1)
- (if (list? diff)
- (list 'scale scl 'differences diff 'lag lag pre0 pre1 post0 post1)
- #f))))))
-
+ (and (list? diff)
+ (list 'scale scl 'differences diff 'lag lag pre0 pre1 post0 post1)))))))
;; align and zero + scaling didn't find a match
)))
@@ -180,7 +166,7 @@
(set! (edit-position snd0 chn0) edpos0)
(set! (edit-position snd1 chn1) edpos1)
(or result
- (unconvolve (channel->vct 0 #f snd0 chn0) (channel->vct 0 #f snd1 chn1))))))
+ (unconvolve (channel->float-vector 0 #f snd0 chn0) (channel->float-vector 0 #f snd1 chn1))))))
;; for env: slam both to 1 at every peak, check for eq, see if smooth env gives match?
;; or check spectr for eq leaving out low stuff, then try env?
\ No newline at end of file
diff --git a/sndinfo.c b/sndinfo.c
index 6b296be..1461cfc 100644
--- a/sndinfo.c
+++ b/sndinfo.c
@@ -1,18 +1,14 @@
/* sndinfo describes sounds */
-#include <mus-config.h>
+#include "mus-config.h"
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
-#else
- #if (!(defined(_MSC_VER)))
- #include <unistd.h>
- #endif
- #include <string.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
#endif
+#include <string.h>
#include <errno.h>
#include <time.h>
@@ -23,19 +19,19 @@ static char *display_maxamps(const char *filename, int chans)
char *ampstr;
char fstr[16];
int i, len;
- mus_sample_t *vals;
+ mus_float_t *vals;
mus_long_t *times;
len = chans * 32;
ampstr = (char *)calloc(len, sizeof(char));
- vals = (mus_sample_t *)calloc(chans, sizeof(mus_sample_t));
+ vals = (mus_float_t *)calloc(chans, sizeof(mus_float_t));
times = (mus_long_t *)calloc(chans, sizeof(mus_long_t));
snprintf(ampstr, len, "\n max amp%s: ", (chans > 1) ? "s" : "");
mus_sound_maxamps(filename, chans, vals, times);
for (i = 0; i < chans; i++)
{
- snprintf(fstr, 16, "%.3f ", MUS_SAMPLE_TO_FLOAT(vals[i]));
+ snprintf(fstr, 16, "%.3f ", vals[i]);
strcat(ampstr, fstr);
}
free(vals);
@@ -45,13 +41,15 @@ static char *display_maxamps(const char *filename, int chans)
int main(int argc, char *argv[])
{
- int chans, srate, format, type, ctr;
+ int chans, srate, ctr;
+ mus_sample_t samp_type;
+ mus_header_t type;
mus_long_t samples;
float length = 0.0;
time_t date;
int *loops = NULL;
char *comment, *header_name;
- char *format_info = NULL, *format_name, *ampstr = NULL;
+ char *samp_type_info = NULL, *samp_type_name, *ampstr = NULL;
char timestr[64];
if (argc == 1) {printf("usage: sndinfo file\n"); exit(0);}
mus_sound_initialize();
@@ -74,30 +72,31 @@ int main(int argc, char *argv[])
loops = mus_sound_loop_info(argv[ctr]);
type = mus_sound_header_type(argv[ctr]);
header_name = (char *)mus_header_type_name(type);
- format = mus_sound_data_format(argv[ctr]);
- if (format != MUS_UNKNOWN)
- format_info = (char *)mus_data_format_name(format);
+ samp_type = mus_sound_sample_type(argv[ctr]);
+ if (samp_type != MUS_UNKNOWN_SAMPLE)
+ samp_type_info = (char *)mus_sample_type_name(samp_type);
else
{
- if (format_info == NULL) format_info = (char *)calloc(64, sizeof(char));
- format = mus_sound_original_format(argv[ctr]);
- format_name = (char *)mus_header_original_format_name(format, type);
- if (format_name)
- snprintf(format_info, 64, "%d (%s)", format, format_name);
- else snprintf(format_info, 64, "%d", format);
+ int orig_type;
+ if (samp_type_info == NULL) samp_type_info = (char *)calloc(64, sizeof(char));
+ orig_type = mus_sound_original_sample_type(argv[ctr]);
+ samp_type_name = (char *)mus_header_original_sample_type_name(orig_type, type);
+ if (samp_type_name)
+ snprintf(samp_type_info, 64, "%d (%s)", orig_type, samp_type_name);
+ else snprintf(samp_type_info, 64, "%d", orig_type);
}
fprintf(stdout, "%s:\n srate: %d\n chans: %d\n length: %f",
argv[ctr], srate, chans, length);
if (length < 10.0)
{
int samps;
- samps = mus_sound_frames(argv[ctr]);
+ samps = mus_sound_framples(argv[ctr]);
fprintf(stdout, " (%d sample%s)", samps, (samps != 1) ? "s" : "");
}
fprintf(stdout, "\n");
- fprintf(stdout, " type: %s\n format: %s\n ",
+ fprintf(stdout, " header type: %s\n sample type: %s\n ",
header_name,
- format_info);
+ samp_type_info);
strftime(timestr, 64, "%a %d-%b-%Y %H:%M %Z", localtime(&date));
fprintf(stdout, "written: %s", timestr);
diff --git a/sndins/COPYING.LIB b/sndins/COPYING.LIB
deleted file mode 100644
index c4792dd..0000000
--- a/sndins/COPYING.LIB
+++ /dev/null
@@ -1,515 +0,0 @@
-
- GNU LESSER GENERAL PUBLIC LICENSE
- Version 2.1, February 1999
-
- Copyright (C) 1991, 1999 Free Software Foundation, Inc.
- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-[This is the first released version of the Lesser GPL. It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-Licenses are intended to guarantee your freedom to share and change
-free software--to make sure the software is free for all its users.
-
- This license, the Lesser General Public License, applies to some
-specially designated software packages--typically libraries--of the
-Free Software Foundation and other authors who decide to use it. You
-can use it too, but we suggest you first think carefully about whether
-this license or the ordinary General Public License is the better
-strategy to use in any particular case, based on the explanations
-below.
-
- When we speak of free software, we are referring to freedom of use,
-not price. Our General Public Licenses are designed to make sure that
-you have the freedom to distribute copies of free software (and charge
-for this service if you wish); that you receive source code or can get
-it if you want it; that you can change the software and use pieces of
-it in new free programs; and that you are informed that you can do
-these things.
-
- To protect your rights, we need to make restrictions that forbid
-distributors to deny you these rights or to ask you to surrender these
-rights. These restrictions translate to certain responsibilities for
-you if you distribute copies of the library or if you modify it.
-
- For example, if you distribute copies of the library, whether gratis
-or for a fee, you must give the recipients all the rights that we gave
-you. You must make sure that they, too, receive or can get the source
-code. If you link other code with the library, you must provide
-complete object files to the recipients, so that they can relink them
-with the library after making changes to the library and recompiling
-it. And you must show them these terms so they know their rights.
-
- We protect your rights with a two-step method: (1) we copyright the
-library, and (2) we offer you this license, which gives you legal
-permission to copy, distribute and/or modify the library.
-
- To protect each distributor, we want to make it very clear that
-there is no warranty for the free library. Also, if the library is
-modified by someone else and passed on, the recipients should know
-that what they have is not the original version, so that the original
-author's reputation will not be affected by problems that might be
-introduced by others.
-^L
- Finally, software patents pose a constant threat to the existence of
-any free program. We wish to make sure that a company cannot
-effectively restrict the users of a free program by obtaining a
-restrictive license from a patent holder. Therefore, we insist that
-any patent license obtained for a version of the library must be
-consistent with the full freedom of use specified in this license.
-
- Most GNU software, including some libraries, is covered by the
-ordinary GNU General Public License. This license, the GNU Lesser
-General Public License, applies to certain designated libraries, and
-is quite different from the ordinary General Public License. We use
-this license for certain libraries in order to permit linking those
-libraries into non-free programs.
-
- When a program is linked with a library, whether statically or using
-a shared library, the combination of the two is legally speaking a
-combined work, a derivative of the original library. The ordinary
-General Public License therefore permits such linking only if the
-entire combination fits its criteria of freedom. The Lesser General
-Public License permits more lax criteria for linking other code with
-the library.
-
- We call this license the "Lesser" General Public License because it
-does Less to protect the user's freedom than the ordinary General
-Public License. It also provides other free software developers Less
-of an advantage over competing non-free programs. These disadvantages
-are the reason we use the ordinary General Public License for many
-libraries. However, the Lesser license provides advantages in certain
-special circumstances.
-
- For example, on rare occasions, there may be a special need to
-encourage the widest possible use of a certain library, so that it
-becomes
-a de-facto standard. To achieve this, non-free programs must be
-allowed to use the library. A more frequent case is that a free
-library does the same job as widely used non-free libraries. In this
-case, there is little to gain by limiting the free library to free
-software only, so we use the Lesser General Public License.
-
- In other cases, permission to use a particular library in non-free
-programs enables a greater number of people to use a large body of
-free software. For example, permission to use the GNU C Library in
-non-free programs enables many more people to use the whole GNU
-operating system, as well as its variant, the GNU/Linux operating
-system.
-
- Although the Lesser General Public License is Less protective of the
-users' freedom, it does ensure that the user of a program that is
-linked with the Library has the freedom and the wherewithal to run
-that program using a modified version of the Library.
-
- The precise terms and conditions for copying, distribution and
-modification follow. Pay close attention to the difference between a
-"work based on the library" and a "work that uses the library". The
-former contains code derived from the library, whereas the latter must
-be combined with the library in order to run.
-^L
- GNU LESSER GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser General Public License (also called "this License").
-Each licensee is addressed as "you".
-
- A "library" means a collection of software functions and/or data
-prepared so as to be conveniently linked with application programs
-(which use some of those functions and data) to form executables.
-
- The "Library", below, refers to any such software library or work
-which has been distributed under these terms. A "work based on the
-Library" means either the Library or any derivative work under
-copyright law: that is to say, a work containing the Library or a
-portion of it, either verbatim or with modifications and/or translated
-straightforwardly into another language. (Hereinafter, translation is
-included without limitation in the term "modification".)
-
- "Source code" for a work means the preferred form of the work for
-making modifications to it. For a library, complete source code means
-all the source code for all modules it contains, plus any associated
-interface definition files, plus the scripts used to control
-compilation
-and installation of the library.
-
- Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running a program using the Library is not restricted, and output from
-such a program is covered only if its contents constitute a work based
-on the Library (independent of the use of the Library in a tool for
-writing it). Whether that is true depends on what the Library does
-and what the program that uses the Library does.
-
- 1. You may copy and distribute verbatim copies of the Library's
-complete source code as you receive it, in any medium, provided that
-you conspicuously and appropriately publish on each copy an
-appropriate copyright notice and disclaimer of warranty; keep intact
-all the notices that refer to this License and to the absence of any
-warranty; and distribute a copy of this License along with the
-Library.
-
- You may charge a fee for the physical act of transferring a copy,
-and you may at your option offer warranty protection in exchange for a
-fee.
-
- 2. You may modify your copy or copies of the Library or any portion
-of it, thus forming a work based on the Library, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) The modified work must itself be a software library.
-
- b) You must cause the files modified to carry prominent notices
- stating that you changed the files and the date of any change.
-
- c) You must cause the whole of the work to be licensed at no
- charge to all third parties under the terms of this License.
-
- d) If a facility in the modified Library refers to a function or a
- table of data to be supplied by an application program that uses
- the facility, other than as an argument passed when the facility
- is invoked, then you must make a good faith effort to ensure that,
- in the event an application does not supply such function or
- table, the facility still operates, and performs whatever part of
- its purpose remains meaningful.
-
- (For example, a function in a library to compute square roots has
- a purpose that is entirely well-defined independent of the
- application. Therefore, Subsection 2d requires that any
- application-supplied function or table used by this function must
- be optional: if the application does not supply it, the square
- root function must still compute square roots.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Library,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Library, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote
-it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Library.
-
-In addition, mere aggregation of another work not based on the Library
-with the Library (or with a work based on the Library) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may opt to apply the terms of the ordinary GNU General Public
-License instead of this License to a given copy of the Library. To do
-this, you must alter all the notices that refer to this License, so
-that they refer to the ordinary GNU General Public License, version 2,
-instead of to this License. (If a newer version than version 2 of the
-ordinary GNU General Public License has appeared, then you can specify
-that version instead if you wish.) Do not make any other change in
-these notices.
-^L
- Once this change is made in a given copy, it is irreversible for
-that copy, so the ordinary GNU General Public License applies to all
-subsequent copies and derivative works made from that copy.
-
- This option is useful when you wish to copy part of the code of
-the Library into a program that is not a library.
-
- 4. You may copy and distribute the Library (or a portion or
-derivative of it, under Section 2) in object code or executable form
-under the terms of Sections 1 and 2 above provided that you accompany
-it with the complete corresponding machine-readable source code, which
-must be distributed under the terms of Sections 1 and 2 above on a
-medium customarily used for software interchange.
-
- If distribution of object code is made by offering access to copy
-from a designated place, then offering equivalent access to copy the
-source code from the same place satisfies the requirement to
-distribute the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being compiled or
-linked with it, is called a "work that uses the Library". Such a
-work, in isolation, is not a derivative work of the Library, and
-therefore falls outside the scope of this License.
-
- However, linking a "work that uses the Library" with the Library
-creates an executable that is a derivative of the Library (because it
-contains portions of the Library), rather than a "work that uses the
-library". The executable is therefore covered by this License.
-Section 6 states terms for distribution of such executables.
-
- When a "work that uses the Library" uses material from a header file
-that is part of the Library, the object code for the work may be a
-derivative work of the Library even though the source code is not.
-Whether this is true is especially significant if the work can be
-linked without the Library, or if the work is itself a library. The
-threshold for this to be true is not precisely defined by law.
-
- If such an object file uses only numerical parameters, data
-structure layouts and accessors, and small macros and small inline
-functions (ten lines or less in length), then the use of the object
-file is unrestricted, regardless of whether it is legally a derivative
-work. (Executables containing this object code plus portions of the
-Library will still fall under Section 6.)
-
- Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of Section 6.
-Any executables containing that work also fall under Section 6,
-whether or not they are linked directly with the Library itself.
-^L
- 6. As an exception to the Sections above, you may also combine or
-link a "work that uses the Library" with the Library to produce a
-work containing portions of the Library, and distribute that work
-under terms of your choice, provided that the terms permit
-modification of the work for the customer's own use and reverse
-engineering for debugging such modifications.
-
- You must give prominent notice with each copy of the work that the
-Library is used in it and that the Library and its use are covered by
-this License. You must supply a copy of this License. If the work
-during execution displays copyright notices, you must include the
-copyright notice for the Library among them, as well as a reference
-directing the user to the copy of this License. Also, you must do one
-of these things:
-
- a) Accompany the work with the complete corresponding
- machine-readable source code for the Library including whatever
- changes were used in the work (which must be distributed under
- Sections 1 and 2 above); and, if the work is an executable linked
- with the Library, with the complete machine-readable "work that
- uses the Library", as object code and/or source code, so that the
- user can modify the Library and then relink to produce a modified
- executable containing the modified Library. (It is understood
- that the user who changes the contents of definitions files in the
- Library will not necessarily be able to recompile the application
- to use the modified definitions.)
-
- b) Use a suitable shared library mechanism for linking with the
- Library. A suitable mechanism is one that (1) uses at run time a
- copy of the library already present on the user's computer system,
- rather than copying library functions into the executable, and (2)
- will operate properly with a modified version of the library, if
- the user installs one, as long as the modified version is
- interface-compatible with the version that the work was made with.
-
- c) Accompany the work with a written offer, valid for at
- least three years, to give the same user the materials
- specified in Subsection 6a, above, for a charge no more
- than the cost of performing this distribution.
-
- d) If distribution of the work is made by offering access to copy
- from a designated place, offer equivalent access to copy the above
- specified materials from the same place.
-
- e) Verify that the user has already received a copy of these
- materials or that you have already sent this user a copy.
-
- For an executable, the required form of the "work that uses the
-Library" must include any data and utility programs needed for
-reproducing the executable from it. However, as a special exception,
-the materials to be distributed need not include anything that is
-normally distributed (in either source or binary form) with the major
-components (compiler, kernel, and so on) of the operating system on
-which the executable runs, unless that component itself accompanies
-the executable.
-
- It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system. Such a contradiction means you cannot
-use both them and the Library together in an executable that you
-distribute.
-^L
- 7. You may place library facilities that are a work based on the
-Library side-by-side in a single library together with other library
-facilities not covered by this License, and distribute such a combined
-library, provided that the separate distribution of the work based on
-the Library and of the other library facilities is otherwise
-permitted, and provided that you do these two things:
-
- a) Accompany the combined library with a copy of the same work
- based on the Library, uncombined with any other library
- facilities. This must be distributed under the terms of the
- Sections above.
-
- b) Give prominent notice with the combined library of the fact
- that part of it is a work based on the Library, and explaining
- where to find the accompanying uncombined form of the same work.
-
- 8. You may not copy, modify, sublicense, link with, or distribute
-the Library except as expressly provided under this License. Any
-attempt otherwise to copy, modify, sublicense, link with, or
-distribute the Library is void, and will automatically terminate your
-rights under this License. However, parties who have received copies,
-or rights, from you under this License will not have their licenses
-terminated so long as such parties remain in full compliance.
-
- 9. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Library or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Library (or any work based on the
-Library), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Library or works based on it.
-
- 10. Each time you redistribute the Library (or any work based on the
-Library), the recipient automatically receives a license from the
-original licensor to copy, distribute, link with or modify the Library
-subject to these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties with
-this License.
-^L
- 11. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Library at all. For example, if a patent
-license would not permit royalty-free redistribution of the Library by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Library.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply, and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Library under this License
-may add an explicit geographical distribution limitation excluding those
-countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 13. The Free Software Foundation may publish revised and/or new
-versions of the Lesser General Public License from time to time.
-Such new versions will be similar in spirit to the present version,
-but may differ in detail to address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Library
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation. If the Library does not specify a
-license version number, you may choose any version ever published by
-the Free Software Foundation.
-^L
- 14. If you wish to incorporate parts of the Library into other free
-programs whose distribution conditions are incompatible with these,
-write to the author to ask for permission. For software which is
-copyrighted by the Free Software Foundation, write to the Free
-Software Foundation; we sometimes make exceptions for this. Our
-decision will be guided by the two goals of preserving the free status
-of all derivatives of our free software and of promoting the sharing
-and reuse of software generally.
-
- NO WARRANTY
-
- 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
- END OF TERMS AND CONDITIONS
-^L
- How to Apply These Terms to Your New Libraries
-
- If you develop a new library, and you want it to be of the greatest
-possible use to the public, we recommend making it free software that
-everyone can redistribute and change. You can do so by permitting
-redistribution under these terms (or, alternatively, under the terms
-of the ordinary General Public License).
-
- To apply these terms, attach the following notices to the library.
-It is safest to attach them to the start of each source file to most
-effectively convey the exclusion of warranty; and each file should
-have at least the "copyright" line and a pointer to where the full
-notice is found.
-
-
- <one line to give the library's name and a brief idea of what it
-does.>
- Copyright (C) <year> <name of author>
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Lesser General Public
- License as published by the Free Software Foundation; either
- version 2 of the License, or (at your option) any later version.
-
- This library 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
- Lesser General Public License for more details.
-
- You should have received a copy of the GNU Lesser General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-Also add information on how to contact you by electronic and paper
-mail.
-
-You should also get your employer (if you work as a programmer) or
-your
-school, if any, to sign a "copyright disclaimer" for the library, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the
- library `Frob' (a library for tweaking knobs) written by James
-Random Hacker.
-
- <signature of Ty Coon>, 1 April 1990
- Ty Coon, President of Vice
-
-That's all there is to it!
-
-
diff --git a/sndins/Makefile.in b/sndins/Makefile.in
index 5544a2c..976f2a0 100644
--- a/sndins/Makefile.in
+++ b/sndins/Makefile.in
@@ -1,44 +1,40 @@
# Makefile for libsndins.so
-prefix = @prefix@
-srcdir = @srcdir@
-libdir = $(prefix)/lib
-top_builddir = ..
-top_srcdir = @top_srcdir@
-VPATH = @srcdir@
-includedir = @includedir@
-SHELL = @SHELL@
-mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
-
-CC = @CC@
-DEFS = @DEFS@
-CFLAGS = @CFLAGS@ -fPIC
-LDFLAGS = @LDFLAGS@
-LIBS = @LIBS@
-XEN_CFLAGS = @XEN_CFLAGS@
-XEN_LIBS = @XEN_LIBS@
-GSL_FLAGS = @GSL_CFLAGS@
-GSL_LIBS = @GSL_LIBS@
-
-INSTALL = @INSTALL@
-SO_INSTALL = @SO_INSTALL@
-SO_LD = @SO_LD@
-A_LD = ar
-A_LD_FLAGS = cr
-LD_FLAGS = @LD_FLAGS@
-LDSO_FLAGS = @LDSO_FLAGS@
-
-OBJS = sndins.o $(top_builddir)/sndlib.a
-SO_TARGET = libsndins.so
-A_TARGET = libsndins.a
-LIB_TARGET = sndins.so
+prefix = @prefix@
+srcdir = @srcdir@
+libdir = $(prefix)/lib
+top_builddir = ..
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+includedir = @includedir@
+SHELL = @SHELL@
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+
+CC = @CC@
+DEFS = -DUSE_SND=0 @DEFS@
+LDFLAGS = @LDFLAGS@
+CFLAGS = @CFLAGS@ -fPIC @XEN_CFLAGS@ @GSL_CFLAGS@
+LIBS = @LIBS@ @XEN_LIBS@ @GSL_LIBS@
+
+INSTALL = @INSTALL@
+SO_INSTALL = @SO_INSTALL@
+SO_LD = @SO_LD@
+A_LD = ar
+A_LD_FLAGS = cr
+LD_FLAGS = @LD_FLAGS@
+LDSO_FLAGS = @LDSO_FLAGS@
+
+OBJS = sndins.o $(top_builddir)/sndlib.a
+SO_TARGET = libsndins.so
+A_TARGET = libsndins.a
+LIB_TARGET = sndins.so
.c.o:
- $(CC) -c $(DEFS) $(CFLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) -I$(top_builddir) -I$(top_srcdir) $<
+ $(CC) -c $(DEFS) $(CFLAGS) -I$(top_builddir) -I$(top_srcdir) $<
sndins: $(OBJS)
- $(SO_LD) $(LDSO_FLAGS) $(LDFLAGS) -o $(SO_TARGET) $(OBJS) $(XEN_LIBS) $(GSL_LIBS) $(LIBS)
- $(A_LD) $(A_LD_FLAGS) $(A_TARGET) $(OBJS)
+ $(SO_LD) $(LDSO_FLAGS) $(LDFLAGS) -o $(SO_TARGET) $(OBJS) $(LIBS)
+ $(A_LD) $(A_LD_FLAGS) $(A_TARGET) $(OBJS)
ranlib $(A_TARGET)
cp $(SO_TARGET) $(LIB_TARGET)
@@ -53,7 +49,7 @@ uninstall:
rm -f $(libdir)/$(SO_TARGET)
clean:
- rm -f *.so *.a *.o *.core core 0
+ rm -f *.so *.a *.o *.core core
distclean: clean
rm -f Makefile *~
diff --git a/sndins/README b/sndins/README
index 6e14f9b..86be4dd 100644
--- a/sndins/README
+++ b/sndins/README
@@ -1,21 +1,19 @@
--*- outline -*-
-
* Introduction
-The C/XEN library `libsndins.so' provides the instrument FM-VIOLIN and
-the reverberators JC-REVERB, NREV, and FREEVERB to use them in longer
-notelists in Snd/Scheme, Snd/Ruby, or Snd/Forth. They are not so fast
-as Lisp's FFI versions, at least not on my machine, but they run much
-faster than the Scheme, Ruby, or Forth variants. In addition I have
-added the FCOMB example from sndscm.html which is used in freeverb.
+The C/XEN library `libsndins.so' provides the instrument FM-VIOLIN
+and the reverberators JC-REVERB, NREV, and FREEVERB to use them in
+longer notelists in Snd/Ruby, or Snd/Forth. They are not so fast
+as Lisp's FFI versions, at least not on my machine, but they run
+much faster than Ruby or Forth variants. In addition I have added
+the FCOMB example from sndscm.html which is used in freeverb.
The library is based on Bill Schottstaedt's `xen' and `sndlib'
-libraries and the Snd editor itself. Thank you for these great music
-programs and libraries!
+libraries and the Snd editor itself. Thank you for these great
+music programs and libraries!
* XEN-Instruments
-The following generator and instruments are accessible from Scheme,
+The following generator and instruments are accessible from S7,
Ruby and Forth.
** make-fcomb, fcomb?, and fcomb
@@ -116,7 +114,7 @@ clm-ins.fs).
*** :doubled #f
*** :amp-env #f
-If more than one reverb channel exists, the values from them are
+If more than one reverb channel exist, the values from them are
collected together before computing the result.
** nrev
@@ -130,7 +128,7 @@ Keyword options for nrev (nrev.ins, clm-ins.scm, clm-ins.rb).
*** :amp-env '( 0 1 1 1 )
*** :volume 1.0
-If more than one reverb channel exists, the values from them are
+If more than one reverb channel exist, the values from them are
collected together before computing the result.
** freeverb
@@ -157,94 +155,94 @@ like output channels.
The following functions are accessible from C.
-** mus_any *mus_make_fcomb(Float scaler, int size, Float a0, Float a1);
+** mus_any *mus_make_fcomb(mus_float_t scaler, int size, mus_float_t a0, mus_float_t a1);
** int mus_fcomb_p(mus_any *ptr);
-** Float mus_fcomb(mus_any *ptr, Float input, Float ignored);
-
-** off_t ins_fm_violin(Float start,
- Float dur,
- Float freq,
- Float amp,
- Float fm_index,
- Float *amp_env,
+** mus_float_t mus_fcomb(mus_any *ptr, mus_float_t input, mus_float_t ignored);
+
+** mus_long_t ins_fm_violin(mus_float_t start,
+ mus_float_t dur,
+ mus_float_t freq,
+ mus_float_t amp,
+ mus_float_t fm_index,
+ mus_float_t *amp_env,
int amp_len,
- Float periodic_vibrato_rate,
- Float periodic_vibrato_amp,
- Float random_vibrato_rate,
- Float random_vibrato_amp,
- Float noise_freq,
- Float noise_amount,
- Float ind_noise_freq,
- Float ind_noise_amount,
- Float amp_noise_freq,
- Float amp_noise_amount,
- Float *gliss_env,
+ mus_float_t periodic_vibrato_rate,
+ mus_float_t periodic_vibrato_amp,
+ mus_float_t random_vibrato_rate,
+ mus_float_t random_vibrato_amp,
+ mus_float_t noise_freq,
+ mus_float_t noise_amount,
+ mus_float_t ind_noise_freq,
+ mus_float_t ind_noise_amount,
+ mus_float_t amp_noise_freq,
+ mus_float_t amp_noise_amount,
+ mus_float_t *gliss_env,
int gliss_len,
- Float gliss_amount,
- Float *fm1_env,
+ mus_float_t gliss_amount,
+ mus_float_t *fm1_env,
int fm1_len,
- Float *fm2_env,
+ mus_float_t *fm2_env,
int fm2_len,
- Float *fm3_env,
+ mus_float_t *fm3_env,
int fm3_len,
- Float fm1_rat,
- Float fm2_rat,
- Float fm3_rat,
- Float fm1_index,
- Float fm2_index,
- Float fm3_index,
- Float base,
- Float degree,
- Float distance,
- Float reverb_amount,
+ mus_float_t fm1_rat,
+ mus_float_t fm2_rat,
+ mus_float_t fm3_rat,
+ mus_float_t fm1_index,
+ mus_float_t fm2_index,
+ mus_float_t fm3_index,
+ mus_float_t base,
+ mus_float_t degree,
+ mus_float_t distance,
+ mus_float_t reverb_amount,
bool index_type,
bool no_waveshaping,
mus_any *out,
mus_any *rev,
mus_interp_t mode);
-** off_t ins_jc_reverb(Float start,
- Float dur,
- Float volume,
+** mus_long_t ins_jc_reverb(mus_float_t start,
+ mus_float_t dur,
+ mus_float_t volume,
bool low_pass,
bool doubled,
- Float delay1,
- Float delay2,
- Float delay3,
- Float delay4,
- Float *amp_env,
+ mus_float_t delay1,
+ mus_float_t delay2,
+ mus_float_t delay3,
+ mus_float_t delay4,
+ mus_float_t *amp_env,
int amp_len,
mus_any *out,
mus_any *rev);
-** off_t ins_nrev(Float start,
- Float dur,
- Float reverb_factor,
- Float lp_coeff,
- Float lp_out_coeff,
- Float output_scale,
- Float volume,
- Float *amp_env,
+** mus_long_t ins_nrev(mus_float_t start,
+ mus_float_t dur,
+ mus_float_t reverb_factor,
+ mus_float_t lp_coeff,
+ mus_float_t lp_out_coeff,
+ mus_float_t output_scale,
+ mus_float_t volume,
+ mus_float_t *amp_env,
int amp_len,
mus_any *out,
mus_any *rev);
-** off_t ins_freeverb(Float start,
- Float dur,
- Float room_decay,
- Float damping,
- Float global,
- Float predelay,
- Float output_gain,
- Float scale_room_decay,
- Float offset_room_decay,
- Float scale_damping,
- Float stereo_spread,
+** mus_long_t ins_freeverb(mus_float_t start,
+ mus_float_t dur,
+ mus_float_t room_decay,
+ mus_float_t damping,
+ mus_float_t global,
+ mus_float_t predelay,
+ mus_float_t output_gain,
+ mus_float_t scale_room_decay,
+ mus_float_t offset_room_decay,
+ mus_float_t scale_damping,
+ mus_float_t stereo_spread,
int *combtuning,
int comb_len,
int *allpasstuning,
int all_len,
- mus_any *output_mixer,
+ vct *output_mixer,
mus_any *out,
mus_any *rev);
@@ -254,22 +252,21 @@ Sndins depends on a configured and compiled, but not necessary
installed, libsndlib.a one directory in the hierarchy above sndins.
Configuring sndlib from sndlib.tar.gz creates a Makefile in
sndlib/sndins, sndlib's mus-config.h is needed as well and the
-compiled sndlib/libsndlib.a will be linked in
-sndlib/sndins/libsndins.*
+compiled sndlib/libsndlib.a will be linked in sndlib/sndins/libsndins.*
* Compilation
-Running Sndlib's configure script in sndlib path creates
-sndins/Makefile from sndins/Makefile.in so we can use the configured
-variables from Sndlib. Then one can cd to sndins and run make.
-Again: Sndlib must be configured before!
+Running Sndlib's configure script in sndlib path creates sndins/Makefile
+from sndins/Makefile.in so we can use the configured variables from
+Sndlib. Then one can cd to sndins and run make. Again: Sndlib
+must be configured before!
cd sndins
make
* Installation
-** Scheme
+** S7
You can install libsndlib.so and libsndins.so to ${prefix}/lib with
the usual `make install' command. Again: Sndlib must be configured
@@ -282,17 +279,16 @@ before!
make
make install
-The library path should be in your LD_LIBRARY_PATH, e.g. if you have
-installed the library in the unusual path /usr/gnu/lib., you can add
-it by:
-
- (csh) setenv LD_LIBRARY_PATH /usr/gnu/lib:${LD_LIBRARY_PATH}
+The library path should be in your LD_LIBRARY_PATH, e.g. if you
+have installed the library in the unusual path /usr/opt/lib., you
+can add it by:
- (sh) LD_LIBRARY_PATH=/usr/gnu/lib:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH
+ (csh) setenv LD_LIBRARY_PATH /usr/opt/lib:${LD_LIBRARY_PATH}
+ (sh) LD_LIBRARY_PATH=/usr/opt/lib:${LD_LIBRARY_PATH}
+ (sh) export LD_LIBRARY_PATH
-In Snd/Scheme one can add to the ~/.snd init file:
+In Snd/S7 one can add to the ~/.snd_s7 init file:
-(if (provided? 'snd)
(begin
(if (not (provided? 'sndlib))
(let ((hsndlib (dlopen "sndlib.so")))
@@ -304,17 +300,14 @@ In Snd/Scheme one can add to the ~/.snd init file:
(if (string? hsndins)
(snd-error (format #f "script needs the sndins module: ~A" hsndins))
(dlinit hsndins "Init_sndins")))))
- (begin
- (if (not (provided? 'sndlib)) (load-extension "libsndlib" "Init_sndlib"))
- (if (not (provided? 'sndins)) (load-extension "libsndins" "Init_sndins"))))
** Ruby
-You can install sndlib.so and sndins.so in the ruby library path, e.g.
+You can install sndlib.so and sndins.so in the ruby library path,
+e.g.
- (csh) setenv RUBYLIB ${HOME}/share/ruby/site-ruby:${HOME}/share/snd:${HOME}/lib/ruby/site-ruby
- (sh) RUBYLIB=${HOME}/share/ruby/site-ruby:${HOME}/share/snd:${HOME}/lib/ruby/site-ruby
- (sh) export RUBYLIB
+ (csh) setenv RUBYLIB ${HOME}/share/snd:${HOME}/lib/ruby/site-ruby
+ (sh) RUBYLIB=${HOME}/share/snd:${HOME}/lib/ruby/site-ruby; export RUBYLIB
cd ${compile_sndlib_dir}
make
install -c sndlib.so ~/lib/ruby/site-ruby/
@@ -322,7 +315,7 @@ You can install sndlib.so and sndins.so in the ruby library path, e.g.
make
install -c sndins.so ~/lib/ruby/site-ruby/
-So in Snd/Ruby one can add to the ~/.snd(_ruby) init file:
+In Snd/Ruby one can add to the ~/.snd_ruby init file:
require "sndlib"
require "sndins"
@@ -334,19 +327,19 @@ Installing so-libs in Forth is possible with these command lines:
(csh) setenv FTH_FTHPATH ${HOME}/share/fth/site-fth
(csh) setenv FTH_LIBPATH ${HOME}/lib/fth
(sh) FTH_FTHPATH=${HOME}/share/fth/site-fth; export FTH_FTHPATH
- (sh) FTH_LIBPATH=${HOME}/lib/fth; export FTH_LIBPATH
+ (sh) FTH_LIBPATH=${HOME}/lib/fth; export FTH_LIBPATH
cd ${compile_sndlib_dir}
make
- fth -Qve "install sndlib.so"
+ fth -e "install sndlib.so"
cd sndins
make
- fth -Qve "install sndins.so"
+ fth -e "install sndins.so"
These lines install the libraries in ~/lib/fth, the first user
-writeable path.
+writeable path in $FTH_LIBPATH.
-Then in Snd/Forth one can add to the ~/.snd(_forth) init file:
+Then in Snd/Forth one can add to the ~/.snd_forth init file:
dl-load sndlib Init_sndlib
dl-load sndins Init_sndins
@@ -357,16 +350,16 @@ You can load the sample files into Snd, with Ruby and Forth you can
test them in a shell too. One may set with-sound variables in agn.*
and fmviolin.* files.
-The agn.* files are translations of clm/clm-example.clm into Scheme,
+The agn.* files are translations of clm/clm-example.clm into S7,
Ruby, and Forth as a test case.
-The fmviolin.* files are translations of clm/fmviolin.clm into Scheme,
+The fmviolin.* files are translations of clm/fmviolin.clm into S7,
Ruby, and Forth as a test case.
-** Scheme
+** S7
You can load the *.scm scripts into Snd. If you have compiled and
-installed the Scheme sndlib and sndins libraries, you can type
+installed the S7 sndlib and sndins libraries, you can type
(do-agn) ;; agn.scm
(short-example) ;; fmviolin.scm
@@ -378,11 +371,12 @@ If you have compiled and installed the Ruby sndlib and sndins
libraries, you can type in a shell
./agn.rb [ outfile.rbm ]
- ./fmviolin.rb [ -s ]
+ ./fmviolin.rb [ /dev/null ]
The default outfile is agn.rbm. A different outfile name may end
-in *.rbm. The option -s can be everything, its only meaning is to
-choose the short_example, without an option long_example is chosen.
+in *.rbm. The option /dev/null can be everything, its only meaning
+is to choose the short_example, without an option long_example is
+chosen.
You can load these scripts into Snd too.
@@ -392,11 +386,12 @@ If you have compiled and installed the Forth sndlib and sndins
libraries, you can type
./agn.fth [ outfile.fsm ]
- ./fmviolin.fth [ -s ]
+ ./fmviolin.fth [ /dev/null ]
-The default outfile is agn.fsm. A different outfile name should end
-in *.fsm. The option -s can be everything, its only meaning is to
-choose the short-example, without an option long-example is chosen.
+The default outfile is agn.fsm. A different outfile name should
+end in *.fsm. The option /dev/null can be everything, its only
+meaning is to choose the short-example, without an option long-example
+is chosen.
You can load these scripts into Snd too.
diff --git a/sndins/samples/agn.fth b/sndins/samples/agn.fth
index 795dac5..2e03dd7 100755
--- a/sndins/samples/agn.fth
+++ b/sndins/samples/agn.fth
@@ -1,40 +1,54 @@
#! /usr/bin/env fth
-\ agn.fth -- Bill Schottstaedt's agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)
+\ agn.fth -- Bill Schottstaedt's agn.cl
+\ (see clm-2/clm-example.clm and clm-2/bess5.cl)
\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Wed Dec 15 23:30:43 CET 2004
-\ Changed: Thu May 28 19:02:04 CEST 2009
+\ Created: 04/12/15 23:30:43
+\ Changed: 14/11/17 23:06:11
-\ This file is part of Sndins.
-\
\ Type do-agn
\ or start the script in a shell.
+#t value *clm-c-version*
+
dl-load sndlib Init_sndlib
-dl-load sndins Init_sndins
+*clm-c-version* [if]
+ dl-load sndins Init_sndins
+[else]
+ require clm-ins
+[then]
require clm
require env
-*argc* 2 > [if] *argv* 2 array-ref [else] "agn.fsm" [then] value agn-test-file
+*argc* 2 > [if]
+ *argv* 2 array-ref
+[else]
+ "agn.fsm"
+[then] value agn-test-file
60.0 value agn-time
-#t to *clm-play*
-#t to *clm-statistics*
-#t to *clm-verbose*
-44100 to *clm-srate*
-2 to *clm-channels*
-' jc-reverb to *clm-reverb*
+#t to *clm-play*
+#t to *clm-statistics*
+#t to *clm-verbose*
+44100 to *clm-srate*
+2 to *clm-channels*
+<'> jc-reverb to *clm-reverb*
'( :volume 0.8 ) to *clm-reverb-data*
-2 to *clm-reverb-channels*
-#t to *clm-delete-reverb*
+2 to *clm-reverb-channels*
+#t to *clm-delete-reverb*
+mus-next to *clm-header-type*
+mus-bfloat to *clm-sample-type*
+
+: rbell ( x -- r )
+ 100 f* '( 0 0 10 0.25 90 1 100 1 ) 1.0 envelope-interp
+;
-: rbell ( x -- r ) 100 f* '( 0 0 10 0.25 90 1 100 1 ) 1.0 envelope-interp ;
: tune ( x -- r )
- { x }
- #( 1 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2 )
- x 12.0 fmod f>s array-ref
- 2.0 x 12.0 f/ floor f**
- f*
+ { x }
+ #( 1 256/243 9/8 32/27 81/64 4/3
+ 1024/729 3/2 128/81 27/16 16/9 243/128 2 ) x 12.0 fmod f>s array-ref
+ 2.0 x 12.0 f/ floor f**
+ f*
;
#( 0 0 2 4 11 11 5 6 7 9 2 0 0 ) constant agn-mode
@@ -47,81 +61,110 @@ require env
#f value agn-begs
: agn-init ( -- )
- agn-lim make-array map! 1.0 random rbell f2* 4.0 f+ floor end-map to agn-octs
- agn-lim make-array map! agn-mode 1.0 random 12.0 f* floor f>s array-ref end-map to agn-pits
- agn-lim make-array map! 1.0 random 6.0 f* 4.0 f+ end-map to agn-rhys
- agn-lim make-array map! 1.0 random rbell 8.0 f* 1.0 f+ end-map to agn-amps
- agn-lim make-array map!
- 1.0 random 0.9 f< if 1.0 random f2* 4.0 f+ else 4.0 random 6.0 f* then
- end-map to agn-begs
+ agn-lim make-array map!
+ 1.0 random rbell f2* 4.0 f+ floor
+ end-map to agn-octs
+ agn-lim make-array map!
+ agn-mode 1.0 random 12.0 f* floor f>s array-ref
+ end-map to agn-pits
+ agn-lim make-array map!
+ 1.0 random 6.0 f* 4.0 f+
+ end-map to agn-rhys
+ agn-lim make-array map!
+ 1.0 random rbell 8.0 f* 1.0 f+
+ end-map to agn-amps
+ agn-lim make-array map!
+ 1.0 random 0.9 f<
+ if
+ 1.0 random f2* 4.0 f+
+ else
+ 4.0 random 6.0 f*
+ then
+ end-map to agn-begs
;
: agn ( fname -- )
- ( fname ) io-open-write { io }
- io $" \\ -*- snd-forth -*-\n" io-write
- io $" \\ from agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)\n" io-write
- io $" \\\n" io-write
- io $" \\ %s\n\n" '( make-default-comment ) io-write-format
- #( '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
- '( 0 0 60 0.1 80 0.2 90 0.4 95 1 100 0 )
- '( 0 0 10 1 16 0 32 0.1 50 1 56 0 60 0 90 0.3 100 0 )
- '( 0 0 30 1 56 0 60 0 90 0.3 100 0 )
- '( 0 0 50 1 80 0.3 100 0 )
- '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
- '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
- '( 0 0 10 1 32 0.1 50 1 90 0.3 100 0 )
- '( 0 0 60 0.1 80 0.3 95 1 100 0 )
- '( 0 0 80 0.1 90 1 100 0 ) ) { wins }
- agn-init
- 4 1 do
- 0 4 0 { cellbeg cellsiz cellctr }
- 1 i s>f i 1- s>f 0.2 { whichway base mi mytempo }
- 0.0 0.0 { nextbeg beg }
- begin
- beg agn-time f< cellctr agn-lim < and
- while
- beg nextbeg f+ to beg
- 0.25 mytempo 1.0 random 0.2 f* 0.9 f+ f* agn-rhys cellctr array-ref f* fmax to nextbeg
- 16.352 2.0 mi f** f/ agn-pits cellctr array-ref tune f*
- 2.0 agn-octs cellctr array-ref f** f* { freq }
- freq 100.0 f< if nextbeg f2* else nextbeg then { dur }
- 0.003 agn-amps cellctr array-ref 60.0 base f* 1/f f* fmax { amp }
- 1.0 random 2.0 f* base f* { ind }
- base 0.1 f* { revamt }
- 10.0 beg beg floor f- f* floor f>s { winnum }
- 0.00001 freq 2.0 flogn 4.0 f- 4.0 f** f* { ranamt }
- io
- $" %f %f %f %f :fm-index %f :amp-env %S :reverb-amount %f :noise-amount %f fm-violin\n"
- '( beg dur freq amp ind wins winnum array-ref revamt ranamt ) io-write-format
- cellctr 1+ to cellctr
- cellctr cellsiz cellbeg + > if
- cellbeg 1+ to cellbeg
- 1.0 random 0.5 f> if cellsiz whichway + to cellsiz then
- cellsiz 16 > 1.0 random 0.99 f> and if
- -2 to whichway
- else
- cellsiz 12 > 1.0 random 0.999 f> and if
- -1 to whichway
- else
- cellsiz 4 < if
- 1 to whichway
- then
- then
- then
- cellbeg 3 + to cellbeg
- cellbeg to cellctr
- then
- repeat
- loop
- io $" \n\\ %s ends here\n" '( agn-test-file ) io-write-format
- io io-close
+ ( fname ) io-open-write { io }
+ io "\\ from agn.cl (clm-2/clm-example.clm, clm-2/bess5.cl)\n" io-write
+ io "\\\n" io-write
+ io "%s\n" '( make-default-comment ) io-write-format
+ #( '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
+ '( 0 0 60 0.1 80 0.2 90 0.4 95 1 100 0 )
+ '( 0 0 10 1 16 0 32 0.1 50 1 56 0 60 0 90 0.3 100 0 )
+ '( 0 0 30 1 56 0 60 0 90 0.3 100 0 )
+ '( 0 0 50 1 80 0.3 100 0 )
+ '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
+ '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
+ '( 0 0 10 1 32 0.1 50 1 90 0.3 100 0 )
+ '( 0 0 60 0.1 80 0.3 95 1 100 0 )
+ '( 0 0 80 0.1 90 1 100 0 ) ) { wins }
+ agn-init
+ 4 1 do
+ 0 4 0 { cellbeg cellsiz cellctr }
+ 1 i s>f i 1- s>f 0.2 { whichway base mi mytempo }
+ 0.0 0.0 { nextbeg beg }
+ begin
+ beg agn-time f< cellctr agn-lim < and
+ while
+ beg nextbeg f+ to beg
+ mytempo 1.0 random 0.2 f* 0.9 f+ f* ( r )
+ agn-rhys cellctr array-ref f* 0.25 fmax to nextbeg
+ 16.352 2.0 mi f** f/ ( r1 )
+ agn-pits cellctr array-ref tune f* ( r1 r2 )
+ 2.0 agn-octs cellctr array-ref f** f* { freq } ( r1 )
+ freq 100.0 f< if
+ nextbeg f2*
+ else
+ nextbeg
+ then { dur } ( r1 )
+ agn-amps cellctr array-ref 60.0 base f* 1/f f*
+ 0.003 fmax { amp } ( r1 )
+ 1.0 random f2* base f* { ind } ( r1 )
+ base 0.1 f* { revamt } ( r1 )
+ 10.0 beg beg floor f- f* floor f>s { winnum } ( r1 )
+ 0.00001 freq 2.0 flogn 4.0 f- 4.0 f**
+ ( r1 r2 ) f* { ranamt }
+ io
+ "
+%f %f %f %f :fm-index %f
+ :amp-env %S
+ :reverb-amount %f :noise-amount %f fm-violin"
+ '( beg dur freq amp ind
+ wins
+ winnum array-ref revamt ranamt ) io-write-format
+ cellctr 1+ to cellctr
+ cellctr cellsiz cellbeg + > if
+ cellbeg 1+ to cellbeg
+ 1.0 random 0.5 f> if
+ cellsiz whichway + to cellsiz
+ then
+ cellsiz 16 >
+ 1.0 random 0.99 f> && if
+ -2 to whichway
+ else
+ cellsiz 12 >
+ 1.0 random 0.999 f> && if
+ -1 to whichway
+ else
+ cellsiz 4 < if
+ 1 to whichway
+ then
+ then
+ then
+ cellbeg 3 + to cellbeg
+ cellbeg to cellctr
+ then
+ repeat
+ loop
+ io "\n\n\\ %s ends here\n" '( agn-test-file ) io-write-format
+ io io-close
;
: do-agn ( -- )
- agn-test-file undef file-basename ".snd" $+ { sndfile }
- $" \\ writing \"%s\"\n" '( agn-test-file ) fth-print
- agn-test-file agn
- :output sndfile agn-test-file clm-load
+ agn-test-file undef file-basename ".snd" $+ { sndfile }
+ "\\ writing \"%s\"\n" '( agn-test-file ) fth-print
+ agn-test-file agn
+ :output sndfile agn-test-file clm-load
;
'snd provided? [unless] do-agn [then]
diff --git a/sndins/samples/agn.rb b/sndins/samples/agn.rb
index 3dc0ef0..dbce6de 100755
--- a/sndins/samples/agn.rb
+++ b/sndins/samples/agn.rb
@@ -1,31 +1,38 @@
-#!/usr/bin/env ruby
-# -*- snd-ruby -*-
-# agn.rb -- Bill Schottstaedt's agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)
+#! /usr/bin/env ruby
+# agn.rb -- Bill Schottstaedt's agn.cl
+# (see clm-2/clm-example.clm and clm-2/bess5.cl)
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Sat May 24 20:35:03 CEST 2003
-# Changed: Thu May 28 17:30:09 CEST 2009
-
-# This file is part of Sndins.
+# Created: 03/05/24 20:35:03
+# Changed: 14/11/18 23:29:44
# Type do_agn
# or start the script in a shell.
+$clm_c_version = true
+
require "sndlib"
-require "sndins"
-require "examp"
+if $clm_c_version
+ require "sndins"
+else
+ require "v" # fm_violin, jc_reverb
+ require "clm-ins" # nrev
+end
+require "clm"
require "ws"
require "env"
-$clm_play = true
-$clm_statistics = true
-$clm_verbose = true
-$clm_srate = 44100
-$clm_channels = 2
-$clm_reverb = :jc_reverb
-$clm_reverb_data = [:volume, 0.8]
+$clm_play = true
+$clm_statistics = true
+$clm_verbose = true
+$clm_srate = 44100
+$clm_channels = 2
+$clm_reverb = :jc_reverb
+$clm_reverb_data = [:volume, 0.8]
$clm_reverb_channels = 2
-$clm_delete_reverb = true
+$clm_delete_reverb = true
+$clm_header_type = Mus_next
+$clm_sample_type = Mus_bfloat
class Agn
include Math
@@ -53,13 +60,12 @@ class Agn
def agn(file)
File.open(file, "w") do |f|
- f << "# -*- snd-ruby -*-\n"
- f << "# from agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)\n"
+ f << "# from agn.cl (clm-2/clm-example.clm, clm-2/bess5.cl)\n"
f << "#\n"
- f << "# " << make_default_comment() << "\n\n"
+ f << make_default_comment() << "\n\n"
wins = [[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
[0, 0, 60, 0.1, 80, 0.2, 90, 0.4, 95, 1, 100, 0],
- [0, 0, 10, 1, 16, 0, 32, 0.1, 50, 1, 56, 0, 60, 0, 90, 0.3, 100, 0],
+ [0, 0, 10, 1, 16, 0, 32, 0.1, 50, 1, 56, 0, 60, 0, 90, 0.3,100,0],
[0, 0, 30, 1, 56, 0, 60, 0, 90, 0.3, 100, 0],
[0, 0, 50, 1, 80, 0.3, 100, 0],
[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
@@ -73,7 +79,8 @@ class Agn
nextbeg = revamt = ranamt = beg = dur = freq = ampl = ind = 0.0
while beg < Time and cellctr < Limit
beg += nextbeg
- nextbeg = dur = [0.25, mytempo * (0.9 + 0.2 * random(1.0)) * @rhys[cellctr]].max
+ nextbeg = dur = [
+ 0.25, mytempo * (0.9 + 0.2 * random(1.0)) * @rhys[cellctr]].max
freq = (16.352 / 2 ** mi) * tune(@pits[cellctr]) * 2 ** @octs[cellctr]
dur += dur if freq < 100
ampl = [0.003, @amps[cellctr] * (1.0 / (60 * base))].max
@@ -81,10 +88,12 @@ class Agn
revamt = base * 0.1
winnum = (10 * (beg - beg.floor)).floor
ranamt = 0.00001 * (logn(freq, 2.0) - 4) ** 4
- f << format("fm_violin(%.2f, %.2f, %.3f, %.2f, " +
- ":fm_index, %.2f, :reverb_amount, %.2f, :noise_amount, %.2f, " +
- ":amp_env, %s)\n",
- beg, dur, freq, ampl, ind, revamt, ranamt, wins[winnum].inspect)
+ f << format("\
+fm_violin(%f, %f, %f, %f, :fm_index, %f,
+ :amp_env, %s,
+ :reverb_amount, %f, :noise_amount, %f)\n",
+ beg, dur, freq, ampl, ind,
+ wins[winnum].inspect, revamt, ranamt)
cellctr += 1
if cellctr > (cellsiz + cellbeg)
cellbeg += 1
@@ -105,6 +114,7 @@ class Agn
end
end
end
+ f << "\n# " + file + " ends here\n"
end
file
end
@@ -117,6 +127,8 @@ def do_agn(file = "agn.rbm")
clm_load(file, :clm, true, :output, sndfile)
end
-do_agn((ARGV[0] or "agn.rbm")) unless provided? :snd
+unless provided?(:snd)
+ do_agn((ARGV[0] or "agn.rbm"))
+end
# agn.rb ends here
diff --git a/sndins/samples/agn.scm b/sndins/samples/agn.scm
index 9ce6e78..481a83b 100644
--- a/sndins/samples/agn.scm
+++ b/sndins/samples/agn.scm
@@ -1,65 +1,70 @@
-;; -*- snd-scheme -*-
-;;; agn.scm -- Bill Schottstaedt's agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)
+#! /usr/opt/bin/snd-s7-nogui -noinit
+!#
+;;; agn.scm -- Bill Schottstaedt's agn.cl
+;;; (see clm-2/clm-example.clm and clm-2/bess5.cl)
;; Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-;; Created: Tue Jun 24 19:05:06 CEST 2003
-;; Changed: Sun Jul 26 04:46:55 CEST 2009
-
-;; This file is part of Sndins.
+;; Created: 03/06/24 19:05:06
+;; Changed: 14/11/18 22:59:13
;; Try (do-agn)
+(define *clm-c-version* #t)
+
+(if (not (provided? 'snd))
+ (begin
+ (define (snd-error . args)
+ (apply format #t args)
+ (exit 1))))
+
(if (not (provided? 'sndlib))
(let ((hsndlib (dlopen "libsndlib.so")))
(if (string? hsndlib)
(snd-error (format #f "script needs the sndlib module: ~A" hsndlib))
(dlinit hsndlib "Init_sndlib"))))
-(if (not (provided? 'sndins))
- (let ((hsndins (dlopen "libsndins.so")))
- (if (string? hsndins)
- (snd-error (format #f "script needs the sndins module: ~A" hsndins))
- (dlinit hsndins "Init_sndins"))))
-
-(if (not (provided? 'snd-ws.scm)) (load-from-path "ws"))
-(if (not (provided? 'snd-env.scm)) (load-from-path "env"))
-
-(define *clm-play* #t)
-(define *clm-statistics* #t)
-(define *clm-verbose* #t)
-(define *clm-srate* 44100)
-(define *clm-channels* 2)
-(define *clm-reverb* jc-reverb)
-(define *clm-reverb-data* '(:volume 0.8))
-(define *clm-reverb-channels* 2)
-(define *clm-delete-reverb* #t)
+(if *clm-c-version*
+ (if (not (provided? 'sndins))
+ (let ((hsndins (dlopen "libsndins.so")))
+ (if (string? hsndins)
+ (snd-error (format #f "script needs the sndins module: ~A" hsndins))
+ (dlinit hsndins "Init_sndins"))))
+ (load "v.scm"))
+
+(if (provided? 'snd)
+ (load "ws.scm")
+ (load "sndlib-ws.scm"))
+
+(set! *clm-play* #t)
+(set! *clm-statistics* #t)
+(set! *clm-verbose* #t)
+(set! *clm-srate* 44100)
+(set! *clm-channels* 2)
+(set! *clm-reverb* jc-reverb)
+(set! *clm-reverb-data* '(:volume 0.8))
+(set! *clm-reverb-channels* 2)
+(set! *clm-delete-reverb* #t)
+(set! *clm-header-type* mus-next)
+(set! *clm-sample-type* mus-bfloat)
+
+(define (snd-msg frm . args)
+ (snd-print (apply format (append (list #f frm) args))))
(define (main args)
(do-agn (if (= 2 (length args)) (cadr args) "agn.clm")))
-(define (my-basename file ext)
- (if (defined? 'gauche-version)
- (path-sans-extension (sys-basename file))
- (basename file ext)))
-
-(define* (do-agn :optional (file "agn.clm"))
- (let ((sndfile (format #f "~A.snd" (my-basename file ".clm"))))
+(define* (do-agn (file "agn.clm"))
+ (let ((sndfile (format #f "~A.snd" "agn")))
(snd-msg ";; Writing ~S~%" file)
(agn file)
(with-sound (:output sndfile)
(snd-msg ";; Loading ~S~%" file)
(load file))))
-(define (snd-msg frm . args)
- (let ((str (apply format (append (list #f frm) args))))
- (if (string? (getenv "EMACS"))
- (display str))
- (snd-print str)))
-
(define lim 256)
(define time 60)
(define mode (list->vector '(0 0 2 4 11 11 5 6 7 0 0 0 0)))
(define rats (list->vector '(1.0 256/243 9/8 32/27 81/64 4/3 1024/729
- 3/2 128/81 27/16 16/9 243/128 2.0)))
+ 3/2 128/81 27/16 16/9 243/128 2.0)))
(define bell '(0 0 10 0.25 90 1.0 100 1.0))
@@ -77,7 +82,7 @@
(define (rbell x)
(envelope-interp (* x 100) bell))
-(define* (glog r :optional b)
+(define* (glog r b)
(if (<= r 0) (error "r must be > 0"))
(if (and b (<= b 0)) (error "b must be > 0"))
(if b (/ (log r) (log b)) (log r)))
@@ -95,13 +100,18 @@
(0 0 80 0.1 90 1 100 0)))))
(do ((i 0 (1+ i)))
((= i (+ lim 1)))
- (vector-set! octs i (inexact->exact (floor (+ 4 (* 2 (rbell (random 1.0)))))))
- (vector-set! pits i (vector-ref mode (inexact->exact (floor (* 12 (random 1.0))))))
- (vector-set! rhys i (inexact->exact (floor (+ 4 (* 6 (random 1.0))))))
- (vector-set! amps i (inexact->exact (floor (+ 1 (* 8 (rbell (random 1.0))))))))
+ (vector-set! octs i
+ (inexact->exact (floor (+ 4 (* 2 (rbell (random 1.0)))))))
+ (vector-set! pits i
+ (vector-ref mode (inexact->exact (floor (* 12 (random 1.0))))))
+ (vector-set! rhys i
+ (inexact->exact (floor (+ 4 (* 6 (random 1.0))))))
+ (vector-set! amps i
+ (inexact->exact (floor (+ 1 (* 8 (rbell (random 1.0))))))))
(call-with-output-file file
(lambda (out-port)
- (format out-port ";; from agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)~%~%")
+ (format out-port
+ ";; from agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)~%")
(do ((i 1 (1+ i)))
((> i 3))
(let ((cellbeg 0)
@@ -122,28 +132,35 @@
(ind 0.0))
(while (and (< beg time) (< cellctr lim))
(set! beg (+ beg nextbeg))
- (set! nextbeg (max 0.25 (* mytempo (+ 0.9 (* 0.2 (random 0.1)))
- (vector-ref rhys cellctr))))
- (set! freq (* (/ 16.352 (expt 2 mi)) (tune (vector-ref pits cellctr))
- (expt 2 (vector-ref octs cellctr))))
+ (set! nextbeg (max 0.25
+ (* mytempo (+ 0.9 (* 0.2 (random 0.1)))
+ (vector-ref rhys cellctr))))
+ (set! freq (* (/ 16.352 (expt 2 mi))
+ (tune (vector-ref pits cellctr))
+ (expt 2 (vector-ref octs cellctr))))
(set! dur nextbeg)
(if (< freq 100) (set! dur (+ dur dur)))
- (set! ampl (max 0.003 (* (vector-ref amps cellctr) (/ (* 60 base)))))
+ (set! ampl (max 0.003
+ (* (vector-ref amps cellctr) (/ (* 60 base)))))
(set! ind (* (random 1.0) 2 base))
(set! cellctr (1+ cellctr))
(set! revamt (* base 0.1))
- (set! winnum (inexact->exact (floor (* 10 (- beg (floor beg))))))
+ (set! winnum (inexact->exact
+ (floor (* 10 (- beg (floor beg))))))
(set! ranamt (* 0.00001 (expt (- (glog freq 2.0) 4) 4)))
(format out-port
- (string-append "(fm-violin ~,2F ~,2F ~,3F ~,3F "
- ":fm-index ~,2F :reverb-amount ~,2F "
- ":noise-amount ~,2F :amp-env '~S)~%")
- beg dur freq ampl ind revamt ranamt (vector-ref wins winnum))
+ "
+(fm-violin ~F ~F ~F ~F :fm-index ~F
+ :amp-env '~S
+ :reverb-amount ~F :noise-amount ~F)"
+ beg dur freq ampl ind
+ (vector-ref wins winnum) revamt ranamt)
(set! cellctr (1+ cellctr))
(if (> cellctr (+ cellsiz cellbeg))
(begin
(set! cellbeg (1+ cellbeg))
- (if (> (random 1.0) 0.5) (set! cellsiz (+ cellsiz whichway)))
+ (if (> (random 1.0) 0.5)
+ (set! cellsiz (+ cellsiz whichway)))
(if (and (> cellsiz 16) (> (random 1.0) 0.99))
(begin
(set! whichway -2)
@@ -153,7 +170,11 @@
(if (< cellsiz 4)
(set! whichway 1))))))
(set! cellbeg (+ cellbeg 3))
- (set! cellctr cellbeg)))))))))
+ (set! cellctr cellbeg))))))
+ (format out-port "~%~%;; ~A ends here~%" file))))
file)
+(do-agn)
+(exit 0)
+
;; agn.scm ends here
diff --git a/sndins/samples/fmviolin.fth b/sndins/samples/fmviolin.fth
index 1c4bbe1..14c06fb 100755
--- a/sndins/samples/fmviolin.fth
+++ b/sndins/samples/fmviolin.fth
@@ -1,11 +1,9 @@
#! /usr/bin/env fth
-\ fmviolin.fth -- CLM fmviolin.clm -*- snd-forth -*-
+\ fmviolin.fth -- CLM fmviolin.clm
\ Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-\ Created: Mon Dec 06 17:23:22 CET 2004
-\ Changed: Sun Jul 26 04:49:29 CEST 2009
-
-\ Commentary:
+\ Created: 04/12/06 17:23:22
+\ Changed: 14/11/19 01:00:53
\ A translation of Bill Schottstaedt's clm/fmviolin.clm from Lisp
\ into Fth.
@@ -13,49 +11,56 @@
\ short-example
\ long-example
-\ Code:
+#t value *clm-c-version*
dl-load sndlib Init_sndlib
-dl-load sndins Init_sndins
+*clm-c-version* [if]
+ dl-load sndins Init_sndins
+[else]
+ require clm-ins
+ <'> noop alias freeverb
+[then]
require clm
-"test-ins-f.snd" to *clm-file-name*
-#t to *clm-play*
-#t to *clm-statistics*
-#t to *clm-verbose*
-44100 to *clm-srate*
-2 to *clm-channels*
-2 to *clm-reverb-channels*
-#t to *clm-delete-reverb*
-
-1.0 value fmv-fm-index
-'( 0 0 25 1 75 1 100 0 ) value fmv-amp-env
-5.0 value fmv-periodic-vibrato-rate
-0.0025 value fmv-periodic-vibrato-amp
-16.0 value fmv-random-vibrato-rate
-0.005 value fmv-random-vibrato-amp
-1000.0 value fmv-noise-freq
-0.0 value fmv-noise-amount
-10.0 value fmv-ind-noise-freq
-0.0 value fmv-ind-noise-amount
-20.0 value fmv-amp-noise-freq
-0.0 value fmv-amp-noise-amount
-'( 0 0 100 0 ) value fmv-gliss-env
-0.0 value fmv-glissando-amount
+"test-ins-f.snd" to *clm-file-name*
+#t to *clm-play*
+#t to *clm-statistics*
+#t to *clm-verbose*
+44100 to *clm-srate*
+2 to *clm-channels*
+2 to *clm-reverb-channels*
+#t to *clm-delete-reverb*
+mus-next to *clm-header-type*
+mus-bfloat to *clm-sample-type*
+
+1.0 value fmv-fm-index
+'( 0 0 25 1 75 1 100 0 ) value fmv-amp-env
+5.0 value fmv-periodic-vibrato-rate
+0.0025 value fmv-periodic-vibrato-amp
+16.0 value fmv-random-vibrato-rate
+0.005 value fmv-random-vibrato-amp
+1000.0 value fmv-noise-freq
+0.0 value fmv-noise-amount
+10.0 value fmv-ind-noise-freq
+0.0 value fmv-ind-noise-amount
+20.0 value fmv-amp-noise-freq
+0.0 value fmv-amp-noise-amount
+'( 0 0 100 0 ) value fmv-gliss-env
+0.0 value fmv-glissando-amount
'( 0 1 25 0.4 75 0.6 100 0 ) value fmv-fm1-env
'( 0 1 25 0.4 75 0.6 100 0 ) value fmv-fm2-env
'( 0 1 25 0.4 75 0.6 100 0 ) value fmv-fm3-env
-1.0 value fmv-fm1-rat
-3.0 value fmv-fm2-rat
-4.0 value fmv-fm3-rat
-#f value fmv-fm1-index
-#f value fmv-fm2-index
-#f value fmv-fm3-index
-0.0 value fmv-base
-0.01 value fmv-reverb-amount
-0.0 value fmv-degree
-1.0 value fmv-distance
-'violin value fmv-index-type
+1.0 value fmv-fm1-rat
+3.0 value fmv-fm2-rat
+4.0 value fmv-fm3-rat
+#f value fmv-fm1-index
+#f value fmv-fm2-index
+#f value fmv-fm3-index
+0.0 value fmv-base
+0.01 value fmv-reverb-amount
+0.0 value fmv-degree
+1.0 value fmv-distance
+'violin value fmv-index-type
: restore-fm-violin-defaults ( -- )
1.0 to fmv-fm-index
@@ -89,34 +94,34 @@ require clm
;
: old-fm-violin ( start dur freq amp keyword-args -- )
- :fm-index fmv-fm-index get-args { fm-index }
- :amp-env fmv-amp-env get-args { amp-env }
+ :fm-index fmv-fm-index get-args { fm-index }
+ :amp-env fmv-amp-env get-args { amp-env }
:periodic-vibrato-rate fmv-periodic-vibrato-rate get-args { pvrate }
:periodic-vibrato-amplitude fmv-periodic-vibrato-amp get-args { pvamp }
:random-vibrato-rate fmv-random-vibrato-rate get-args { rvrate }
:random-vibrato-amplitude fmv-random-vibrato-amp get-args { rvamp }
- :noise-freq fmv-noise-freq get-args { noise-freq }
- :noise-amount fmv-noise-amount get-args { noise-amount }
- :ind-noise-freq fmv-ind-noise-freq get-args { ind-noise-freq }
- :ind-noise-amount fmv-ind-noise-amount get-args { ind-noise-amount }
- :amp-noise-freq fmv-amp-noise-freq get-args { amp-noise-freq }
- :amp-noise-amount fmv-amp-noise-amount get-args { amp-noise-amount }
- :gliss-env fmv-gliss-env get-args { gliss-env }
- :glissando-amount fmv-glissando-amount get-args { gliss-amount }
- :fm1-env fmv-fm1-env get-args { fm1-env }
- :fm2-env fmv-fm2-env get-args { fm2-env }
- :fm3-env fmv-fm3-env get-args { fm3-env }
- :fm1-rat fmv-fm1-rat get-args { fm1-rat }
- :fm2-rat fmv-fm2-rat get-args { fm2-rat }
- :fm3-rat fmv-fm3-rat get-args { fm3-rat }
- :fm1-index fmv-fm1-index get-args { fm1-index }
- :fm2-index fmv-fm2-index get-args { fm2-index }
- :fm3-index fmv-fm3-index get-args { fm3-index }
- :base fmv-base get-args { base }
- :degree fmv-degree get-args { degree }
- :distance fmv-distance get-args { distance }
- :reverb-amount fmv-reverb-amount get-args { revamount }
- :index-type fmv-index-type get-args { index-type }
+ :noise-freq fmv-noise-freq get-args { noise-freq }
+ :noise-amount fmv-noise-amount get-args { noise-amount }
+ :ind-noise-freq fmv-ind-noise-freq get-args { ind-noise-freq }
+ :ind-noise-amount fmv-ind-noise-amount get-args { ind-noise-amount }
+ :amp-noise-freq fmv-amp-noise-freq get-args { amp-noise-freq }
+ :amp-noise-amount fmv-amp-noise-amount get-args { amp-noise-amount }
+ :gliss-env fmv-gliss-env get-args { gliss-env }
+ :glissando-amount fmv-glissando-amount get-args { gliss-amount }
+ :fm1-env fmv-fm1-env get-args { fm1-env }
+ :fm2-env fmv-fm2-env get-args { fm2-env }
+ :fm3-env fmv-fm3-env get-args { fm3-env }
+ :fm1-rat fmv-fm1-rat get-args { fm1-rat }
+ :fm2-rat fmv-fm2-rat get-args { fm2-rat }
+ :fm3-rat fmv-fm3-rat get-args { fm3-rat }
+ :fm1-index fmv-fm1-index get-args { fm1-index }
+ :fm2-index fmv-fm2-index get-args { fm2-index }
+ :fm3-index fmv-fm3-index get-args { fm3-index }
+ :base fmv-base get-args { base }
+ :degree fmv-degree get-args { degree }
+ :distance fmv-distance get-args { distance }
+ :reverb-amount fmv-reverb-amount get-args { revamount }
+ :index-type fmv-index-type get-args { index-type }
{ start dur freq amp }
start dur freq amp 0.125 f*
:fm-index fm-index
@@ -198,8 +203,10 @@ event: fth-short-example ( -- )
0.01 to fmv-random-vibrato-amp
0.01 to fmv-glissando-amount
0.002 to fmv-noise-amount
- 0 8.53 993.323 0.03 :fm-index 0.75 :reverb-amount 0.2 :amp-env amp-env violin-new
- 5 4.53 5/6 993.323 f* 0.02 :fm-index 0.55 :reverb-amount 0.2 :amp-env amp-env violin-new
+ 0 8.53 993.323 0.03 :fm-index 0.75 :reverb-amount 0.2 :amp-env amp-env
+ violin-new
+ 5 4.53 5/6 993.323 f* 0.02 :fm-index 0.55 :reverb-amount 0.2 :amp-env amp-env
+ violin-new
;event
0 value *counter*
@@ -208,7 +215,8 @@ event: fth-short-example ( -- )
: test-info { ctime -- }
*counter* 1+ to *counter*
*timer* stop-timer
- $" \\ %02d: score %3d utime %7.3f\n" '( *counter* ctime *timer* utime@ ) fth-print
+ "\\ %02d: score %3d utime %7.3f\n"
+ '( *counter* ctime *timer* user-time@ ) fth-print
;
event: fth-long-example ( -- )
@@ -290,378 +298,425 @@ event: fth-long-example ( -- )
restore-fm-violin-defaults
0.1 to fmv-noise-amount
beg 0.0000 f+ 5.4 116.5400 0.25 :fm-index 2.2822 :reverb-amount 0.0280
- :amp-env '( 0 0 0.0556 1 4.0937 0.6 9.1414 0.3 24.2845 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.0556 1 4.0937 0.6 9.1414 0.3 24.2845 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.0100 f+ 5.4 43.6538 0.25 :fm-index 2.0867 :reverb-amount 0.0202
- :amp-env '( 0 0 0.0556 1 4.0937 0.6 9.1414 0.3 24.2845 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.0556 1 4.0937 0.6 9.1414 0.3 24.2845 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.0200 f+ 5.4 130.8100 0.25 :fm-index 1.9652 :reverb-amount 0.0270
- :amp-env '( 0 0 0.0556 1 4.0937 0.6 9.1414 0.3 24.2845 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.0556 1 4.0937 0.6 9.1414 0.3 24.2845 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.0250 f+ 5.4 87.3075 0.25 :fm-index 2.1524 :reverb-amount 0.0260
- :amp-env '( 0 0 0.0556 1 4.0937 0.6 9.1414 0.3 24.2845 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.0556 1 4.0937 0.6 9.1414 0.3 24.2845 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.0300 f+ 4.5 261.6200 0.15 :fm-index 2.1384 :reverb-amount 0.0242
- :amp-env '( 0 0 0.0667 1 4.1044 0.6 9.1515 0.3 24.2929 0.1 100 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.0667 1 4.1044 0.6 9.1515 0.3 24.2929 0.1 100 0 )
+ vln-one-sin-ran
beg 0.0300 f+ 4.5 174.6150 0.15 :fm-index 2.1425 :reverb-amount 0.0265
- :amp-env '( 0 0 0.0667 1 4.1044 0.6 9.1515 0.3 24.2929 0.1 100 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.0667 1 4.1044 0.6 9.1515 0.3 24.2929 0.1 100 0 )
+ vln-one-sin-ran
beg 0.0300 f+ 4.5 130.8100 0.15 :fm-index 1.9805 :reverb-amount 0.0201
- :amp-env '( 0 0 0.0667 1 4.1044 0.6 9.1515 0.3 24.2929 0.1 100 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.0667 1 4.1044 0.6 9.1515 0.3 24.2929 0.1 100 0 )
+ vln-one-sin-ran
beg 0.0350 f+ 4.5 43.6538 0.15 :fm-index 2.4876 :reverb-amount 0.0329
- :amp-env '( 0 0 0.0667 1 4.1044 0.6 9.1515 0.3 24.2929 0.1 100 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.0667 1 4.1044 0.6 9.1515 0.3 24.2929 0.1 100 0 )
+ vln-one-sin-ran
beg 0.0400 f+ 3.6 220 0.15 :fm-index 1.8282 :reverb-amount 0.0244
- :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
- :noise-amount 0.15 vln-one-sin-ran
+ :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
+ :noise-amount 0.15 vln-one-sin-ran
beg 0.0400 f+ 3.6 174.6150 0.15 :fm-index 2.3479 :reverb-amount 0.0200
- :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
- :noise-amount 0.15 vln-one-sin-ran
+ :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
+ :noise-amount 0.15 vln-one-sin-ran
beg 0.0400 f+ 3.6 523.2400 0.15 :fm-index 1.6424 :reverb-amount 0.0286
- :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
- :noise-amount 0.15 vln-one-sin-ran
+ :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
+ :noise-amount 0.15 vln-one-sin-ran
beg 0.0450 f+ 3.6 349.2300 0.15 :fm-index 1.6449 :reverb-amount 0.0333
- :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
- :noise-amount 0.15 vln-one-sin-ran
- beg 0.0500 f+ 6 699.4600 0.15 :fm-index 1.5570 :reverb-amount 0.13 :amp-env tap vln-one-sin-ran
- beg 0.0500 f+ 6 1397.9200 0.15 :fm-index 1.5131 :reverb-amount 0.13 :amp-env tap vln-one-sin-ran
- beg 0.0500 f+ 6 783.9800 0.15 :fm-index 2.2031 :reverb-amount 0.13 :amp-env tap vln-one-sin-ran
- beg 0.0500 f+ 6 1046.4800 0.15 :fm-index 2.2724 :reverb-amount 0.13 :amp-env tap vln-one-sin-ran
- beg 0.0600 f+ 9 21.8269 0.15 :fm-index 2.1048 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0600 f+ 8 87.3075 0.15 :fm-index 1.8854 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0600 f+ 7 65.4050 0.15 :fm-index 1.6781 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0600 f+ 8 43.6538 0.15 :fm-index 1.7862 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0700 f+ 6 175.6150 0.15 :fm-index 2.2656 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0700 f+ 6 350.2300 0.15 :fm-index 2.4241 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0700 f+ 6 131.8100 0.15 :fm-index 2.4294 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0700 f+ 6 32.7025 0.15 :fm-index 1.5779 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0800 f+ 6 196.9950 0.15 :fm-index 1.8511 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0800 f+ 6 1047.4800 0.15 :fm-index 2.2148 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.0800 f+ 6 831.6200 0.15 :fm-index 1.9913 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.2700 f+ 6 784.9800 0.16 :fm-index 2.0693 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.2700 f+ 6 64.4050 0.16 :fm-index 1.6920 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.2700 f+ 6 208.6550 0.16 :fm-index 2.2597 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
- beg 0.2700 f+ 6 43.6538 0.16 :fm-index 2.2522 :reverb-amount 0.1 :amp-env tap vln-one-sin-ran
+ :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
+ :noise-amount 0.15 vln-one-sin-ran
+ beg 0.0500 f+ 6 699.4600 0.15 :fm-index 1.5570 :reverb-amount 0.13
+ :amp-env tap vln-one-sin-ran
+ beg 0.0500 f+ 6 1397.9200 0.15 :fm-index 1.5131 :reverb-amount 0.13
+ :amp-env tap vln-one-sin-ran
+ beg 0.0500 f+ 6 783.9800 0.15 :fm-index 2.2031 :reverb-amount 0.13
+ :amp-env tap vln-one-sin-ran
+ beg 0.0500 f+ 6 1046.4800 0.15 :fm-index 2.2724 :reverb-amount 0.13
+ :amp-env tap vln-one-sin-ran
+ beg 0.0600 f+ 9 21.8269 0.15 :fm-index 2.1048 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0600 f+ 8 87.3075 0.15 :fm-index 1.8854 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0600 f+ 7 65.4050 0.15 :fm-index 1.6781 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0600 f+ 8 43.6538 0.15 :fm-index 1.7862 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0700 f+ 6 175.6150 0.15 :fm-index 2.2656 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0700 f+ 6 350.2300 0.15 :fm-index 2.4241 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0700 f+ 6 131.8100 0.15 :fm-index 2.4294 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0700 f+ 6 32.7025 0.15 :fm-index 1.5779 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0800 f+ 6 196.9950 0.15 :fm-index 1.8511 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0800 f+ 6 1047.4800 0.15 :fm-index 2.2148 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.0800 f+ 6 831.6200 0.15 :fm-index 1.9913 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.2700 f+ 6 784.9800 0.16 :fm-index 2.0693 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.2700 f+ 6 64.4050 0.16 :fm-index 1.6920 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.2700 f+ 6 208.6550 0.16 :fm-index 2.2597 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
+ beg 0.2700 f+ 6 43.6538 0.16 :fm-index 2.2522 :reverb-amount 0.1
+ :amp-env tap vln-one-sin-ran
beg 12 + dup to beg test-info
\ 6, score 36
restore-fm-violin-defaults
beg 0.0000 f+ 1.8 349.2300 0.16 :fm-index 2.1541 :reverb-amount 0.0225
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0500 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0500 vln-one-sin-ran
beg 0.0100 f+ 2.7 146.8300 0.16 :fm-index 2.3335 :reverb-amount 0.0274
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0500 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0500 vln-one-sin-ran
beg 0.0200 f+ 1.8 880 0.16 :fm-index 2.1910 :reverb-amount 0.0279
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0500 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0500 vln-one-sin-ran
beg 0.0250 f+ 3.6 73.4150 0.16 :fm-index 2.1410 :reverb-amount 0.0223
- :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
- :noise-amount 0.0500 vln-one-sin-ran
+ :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
+ :noise-amount 0.0500 vln-one-sin-ran
beg 0.0300 f+ 2.7 87.3075 0.16 :fm-index 1.8491 :reverb-amount 0.0217
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0010 vln-one-sin-ran
beg 0.0300 f+ 2.7 75.5662 0.16 :fm-index 1.9191 :reverb-amount 0.0204
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0010 vln-one-sin-ran
beg 0.0400 f+ 3.6 52.3432 0.16 :fm-index 1.6090 :reverb-amount 0.0296
- :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
- :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
+ :noise-amount 0.0010 vln-one-sin-ran
beg 0.0450 f+ 1.8 73.4150 0.16 :fm-index 2.2201 :reverb-amount 0.0221
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0010 vln-one-sin-ran
beg 0.0500 f+ 4 116.5400 0.06 :fm-index 2.0230 :reverb-amount 0.1
- :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
beg 0.0500 f+ 4 97.9975 0.06 :fm-index 1.7284 :reverb-amount 0.1
- :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
beg 0.0600 f+ 4 36.7075 0.06 :fm-index 1.6845 :reverb-amount 0.1
- :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
beg 0.0650 f+ 4 97.9975 0.06 :fm-index 2.4616 :reverb-amount 0.1
- :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
beg 7 + dup to beg test-info
\ 7, score 43
beg 0.0000 f+ 1.8 261.6200 0.16 :fm-index 2.2576 :reverb-amount 0.0286
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0100 f+ 2.7 130.8100 0.16 :fm-index 2.1530 :reverb-amount 0.0330
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0200 f+ 1.8 523.2400 0.16 :fm-index 2.0608 :reverb-amount 0.0235
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0250 f+ 3.6 65.4050 0.16 :fm-index 2.2203 :reverb-amount 0.0234
- :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 2.7 65.4050 0.16 :fm-index 1.7089 :reverb-amount 0.0208
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0010 vln-one-sin-ran
beg 0.0300 f+ 2.7 130.8100 0.16 :fm-index 2.2948 :reverb-amount 0.0269
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0010 vln-one-sin-ran
beg 0.0400 f+ 3.6 32.7025 0.16 :fm-index 1.7677 :reverb-amount 0.0288
- :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
- :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env '( 0 0 0.0833 1 4.1204 0.6 9.1667 0.3 24.3056 0.1 100.0 0 )
+ :noise-amount 0.0010 vln-one-sin-ran
beg 0.0450 f+ 1.8 32.7025 0.16 :fm-index 1.9030 :reverb-amount 0.0209
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0010 vln-one-sin-ran
beg 0.0500 f+ 4 65.4050 0.06 :fm-index 2.2757 :reverb-amount 0.1
- :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
beg 0.0500 f+ 4 65.4050 0.06 :fm-index 2.2435 :reverb-amount 0.1
- :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
beg 0.0600 f+ 4 32.7025 0.06 :fm-index 1.9619 :reverb-amount 0.1
- :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
beg 0.0650 f+ 4 65.4050 0.06 :fm-index 2.0207 :reverb-amount 0.1
- :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
+ :amp-env tap :noise-amount 0.0010 vln-one-sin-ran
beg 6 + dup to beg test-info
\ 8, score 49
beg 0.0100 f+ 0.9 3135.9200 0.16 :fm-index 2.1204 :reverb-amount 0.0024
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0100 f+ 0.45 1567.96 0.16 :fm-index 2.0691 :reverb-amount 0.0025
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0200 f+ 0.9 6271.8400 0.16 :fm-index 2.2081 :reverb-amount 0.0022
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0250 f+ 0.9 783.9800 0.16 :fm-index 1.8719 :reverb-amount 0.0022
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 0.27 783.9800 0.16 :fm-index 1.9705 :reverb-amount 0.0020
- :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.1010 0.3 25.0842 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.1010 0.3 25.0842 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 0.63 1567.96 0.16 :fm-index 1.6778 :reverb-amount 0.0021
- :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0400 f+ 0.9 391.9900 0.16 :fm-index 1.9558 :reverb-amount 0.0023
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0450 f+ 0.45 195.9950 0.16 :fm-index 2.1344 :reverb-amount 0.0027
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
- beg 0.050 f+ 2 783.980 0.16 :reverb-amount 0.01 :amp-env tap :noise-amount 0.009 vln-one-sin-ran
- beg 0.050 f+ 1 1567.960 0.16 :reverb-amount 0.01 :amp-env tap :noise-amount 0.009 vln-one-sin-ran
- beg 0.060 f+ 2 391.990 0.16 :reverb-amount 0.01 :amp-env tap :noise-amount 0.009 vln-one-sin-ran
- beg 0.065 f+ 1 783.980 0.16 :reverb-amount 0.01 :amp-env tap :noise-amount 0.009 vln-one-sin-ran
- beg 0.070 f+ 2 195.995 0.16 :reverb-amount 0.01 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.070 f+ 1 1567.960 0.16 :reverb-amount 0.01 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.080 f+ 1 784.980 0.16 :reverb-amount 0.01 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.085 f+ 2 391.990 0.16 :reverb-amount 0.01 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
+ beg 0.050 f+ 2 783.980 0.16 :reverb-amount 0.01 :amp-env tap
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.050 f+ 1 1567.960 0.16 :reverb-amount 0.01 :amp-env tap
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.060 f+ 2 391.990 0.16 :reverb-amount 0.01 :amp-env tap
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.065 f+ 1 783.980 0.16 :reverb-amount 0.01 :amp-env tap
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.070 f+ 2 195.995 0.16 :reverb-amount 0.01 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.070 f+ 1 1567.960 0.16 :reverb-amount 0.01 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.080 f+ 1 784.980 0.16 :reverb-amount 0.01 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.085 f+ 2 391.990 0.16 :reverb-amount 0.01 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
beg 6 + dup to beg test-info
\ 9, score 55
beg 0.0100 f+ 0.9 97.9975 0.1 :fm-index 2.0885 :reverb-amount 0.0031
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0100 f+ 1.8 48.9988 0.1 :fm-index 2.2269 :reverb-amount 0.0026
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0200 f+ 0.9 195.9950 0.1 :fm-index 2.0305 :reverb-amount 0.0032
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0250 f+ 0.9 24.4994 0.1 :fm-index 2.4934 :reverb-amount 0.0025
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 1.8 97.9975 0.1 :fm-index 2.4039 :reverb-amount 0.0023
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0400 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0400 vln-one-sin-ran
beg 0.0300 f+ 0.9 195.9950 0.1 :fm-index 1.5159 :reverb-amount 0.0021
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0400 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0400 vln-one-sin-ran
beg 0.0300 f+ 0.9 392.9900 0.1 :fm-index 2.2122 :reverb-amount 0.0028
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0400 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0400 vln-one-sin-ran
beg 0.0300 f+ 1.8 784.9800 0.1 :fm-index 2.1574 :reverb-amount 0.0020
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0400 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0400 vln-one-sin-ran
beg 0.0300 f+ 2.7 24.4994 0.1 :fm-index 2.1963 :reverb-amount 0.0031
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 1.8 48.9988 0.1 :fm-index 1.9761 :reverb-amount 0.0032
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0400 f+ 2.7 12.2497 0.1 :fm-index 1.5088 :reverb-amount 0.0021
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0450 f+ 1.8 6.1248 0.1 :fm-index 1.7384 :reverb-amount 0.0021
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
- beg 0.050 f+ 2 24.4994 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.050 f+ 1 48.9988 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.060 f+ 2 12.2497 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.065 f+ 1 24.4994 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
+ beg 0.050 f+ 2 24.4994 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.050 f+ 1 48.9988 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.060 f+ 2 12.2497 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.065 f+ 1 24.4994 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
beg 0.070 f+ 2 6.1248 0.1 :fm-index 1.2474 :reverb-amount 0.1 :amp-env tap
- :noise-amount 0.004 vln-one-sin-ran
+ :noise-amount 0.004 vln-one-sin-ran
beg 0.070 f+ 1 48.9988 0.1 :fm-index 0.7526 :reverb-amount 0.1 :amp-env tap
- :noise-amount 0.004 vln-one-sin-ran
+ :noise-amount 0.004 vln-one-sin-ran
beg 0.080 f+ 1 25.4994 0.1 :fm-index 1.1080 :reverb-amount 0.1 :amp-env tap
- :noise-amount 0.004 vln-one-sin-ran
+ :noise-amount 0.004 vln-one-sin-ran
beg 0.085 f+ 2 12.2497 0.1 :fm-index 1.0859 :reverb-amount 0.1 :amp-env tap
- :noise-amount 0.004 vln-one-sin-ran
+ :noise-amount 0.004 vln-one-sin-ran
beg 0.090 f+ 4 97.9975 0.1 :fm-index 2.4788 :reverb-amount 0.1 :amp-env tap
- :noise-amount 0.004 vln-one-sin-ran
+ :noise-amount 0.004 vln-one-sin-ran
beg 0.090 f+ 3 48.9988 0.1 :fm-index 1.8980 :reverb-amount 0.1 :amp-env tap
- :noise-amount 0.004 vln-one-sin-ran
+ :noise-amount 0.004 vln-one-sin-ran
beg 0.090 f+ 3 25.4994 0.1 :fm-index 2.1151 :reverb-amount 0.1 :amp-env tap
- :noise-amount 0.004 vln-one-sin-ran
+ :noise-amount 0.004 vln-one-sin-ran
beg 0.095 f+ 5 12.2497 0.1 :fm-index 2.3224 :reverb-amount 0.1 :amp-env tap
- :noise-amount 0.004 vln-one-sin-ran
+ :noise-amount 0.004 vln-one-sin-ran
beg 6 + dup to beg test-info
\ 10, score 61
beg 0.2100 f+ 0.9 123.4725 0.1 :reverb-amount 0.0031
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.2100 f+ 1.8 61.7363 0.1 :reverb-amount 0.0023
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.2200 f+ 0.9 246.9450 0.1 :reverb-amount 0.0023
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.2250 f+ 0.9 30.8681 0.1 :reverb-amount 0.0026
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.2300 f+ 1.8 123.4725 0.1 :reverb-amount 0.0027
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0400 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0400 vln-one-sin-ran
beg 0.2300 f+ 0.9 246.9450 0.1 :reverb-amount 0.0026
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0400 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0400 vln-one-sin-ran
beg 0.2300 f+ 0.9 494.8900 0.1 :reverb-amount 0.0020
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0400 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0400 vln-one-sin-ran
beg 0.2300 f+ 1.8 988.7800 0.1 :reverb-amount 0.0025
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0400 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0400 vln-one-sin-ran
beg 0.2300 f+ 2.7 30.8681 0.1 :reverb-amount 0.0028
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.2300 f+ 1.8 61.7363 0.1 :reverb-amount 0.0023
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.2400 f+ 2.7 15.4341 0.1 :reverb-amount 0.0030
- :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.1111 1 4.1470 0.6 9.1919 0.3 24.3266 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.2450 f+ 1.8 20.5788 0.1 :reverb-amount 0.0023
- :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
- beg 0.250 f+ 2 30.8681 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.009 vln-one-sin-ran
- beg 0.250 f+ 1 61.7363 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.009 vln-one-sin-ran
- beg 0.260 f+ 2 15.4341 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.009 vln-one-sin-ran
- beg 0.265 f+ 1 30.8681 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.009 vln-one-sin-ran
- beg 0.271 f+ 2 30.8681 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.271 f+ 1 61.7363 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.281 f+ 1 31.8681 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
- beg 0.286 f+ 2 15.4341 0.1 :reverb-amount 0.1 :amp-env tap :noise-amount 0.004 vln-one-sin-ran
+ :amp-env '( 0 0 0.1667 1 4.2003 0.6 9.2424 0.3 24.3687 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
+ beg 0.250 f+ 2 30.8681 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.250 f+ 1 61.7363 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.260 f+ 2 15.4341 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.265 f+ 1 30.8681 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.271 f+ 2 30.8681 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.271 f+ 1 61.7363 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.281 f+ 1 31.8681 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.286 f+ 2 15.4341 0.1 :reverb-amount 0.1 :amp-env tap
+ :noise-amount 0.004 vln-one-sin-ran
beg 8 + dup to beg test-info
\ 11, score 69
'( 0 0 1 1 100 0 ) { yup }
beg 0.0100 f+ 0.9 3135.9200 0.16 :fm-index 1.7299 :reverb-amount 0.0026
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0100 f+ 0.45 1464.6987 0.16 :fm-index 1.9173 :reverb-amount 0.0027
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0200 f+ 0.9 6714.0048 0.16 :fm-index 2.4604 :reverb-amount 0.0032
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0250 f+ 0.9 684.1190 0.16 :fm-index 1.9969 :reverb-amount 0.0021
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 0.27 684.1190 0.16 :fm-index 2.0022 :reverb-amount 0.0026
- :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.1010 0.3 25.0842 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.1010 0.3 25.0842 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 0.63 1464.6987 0.16 :fm-index 2.1058 :reverb-amount 0.0027
- :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0400 f+ 0.9 319.5325 0.16 :fm-index 2.2293 :reverb-amount 0.0029
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0450 f+ 0.45 149.2445 0.16 :fm-index 1.5780 :reverb-amount 0.0025
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
- beg 0.050 f+ 1 684.1190 0.16 :reverb-amount 0.01 :amp-env yup :noise-amount 0.009 vln-one-sin-ran
- beg 0.050 f+ 1 1464.6987 0.16 :reverb-amount 0.01 :amp-env yup :noise-amount 0.009 vln-one-sin-ran
- beg 0.060 f+ 1 319.5325 0.16 :reverb-amount 0.01 :amp-env yup :noise-amount 0.009 vln-one-sin-ran
- beg 0.065 f+ 1 684.1190 0.16 :reverb-amount 0.01 :amp-env yup :noise-amount 0.009 vln-one-sin-ran
- beg 0.070 f+ 1 149.2445 0.16 :reverb-amount 0.01 :amp-env yup :noise-amount 0.004 vln-one-sin-ran
- beg 0.070 f+ 1 1464.6987 0.16 :reverb-amount 0.01 :amp-env yup :noise-amount 0.004 vln-one-sin-ran
- beg 0.080 f+ 1 561.6022 0.16 :reverb-amount 0.01 :amp-env yup :noise-amount 0.004 vln-one-sin-ran
- beg 0.085 f+ 1 319.5325 0.16 :reverb-amount 0.01 :amp-env yup :noise-amount 0.004 vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
+ beg 0.050 f+ 1 684.1190 0.16 :reverb-amount 0.01 :amp-env yup
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.050 f+ 1 1464.6987 0.16 :reverb-amount 0.01 :amp-env yup
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.060 f+ 1 319.5325 0.16 :reverb-amount 0.01 :amp-env yup
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.065 f+ 1 684.1190 0.16 :reverb-amount 0.01 :amp-env yup
+ :noise-amount 0.009 vln-one-sin-ran
+ beg 0.070 f+ 1 149.2445 0.16 :reverb-amount 0.01 :amp-env yup
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.070 f+ 1 1464.6987 0.16 :reverb-amount 0.01 :amp-env yup
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.080 f+ 1 561.6022 0.16 :reverb-amount 0.01 :amp-env yup
+ :noise-amount 0.004 vln-one-sin-ran
+ beg 0.085 f+ 1 319.5325 0.16 :reverb-amount 0.01 :amp-env yup
+ :noise-amount 0.004 vln-one-sin-ran
beg 3 + dup to beg test-info
\ 12, score 72
beg 0.0100 f+ 0.9 3135.9200 0.16 :fm-index 1.6329 :reverb-amount 0.0031
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0100 f+ 0.45 1810.5774 0.16 :fm-index 1.8298 :reverb-amount 0.0031
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0200 f+ 0.9 5431.4135 0.16 :fm-index 2.1640 :reverb-amount 0.0022
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0250 f+ 0.9 1045.3680 0.16 :fm-index 1.6971 :reverb-amount 0.0032
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 0.27 1045.3680 0.16 :fm-index 2.4855 :reverb-amount 0.0028
- :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.1010 0.3 25.0842 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.1010 0.3 25.0842 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0300 f+ 0.63 1810.5774 0.16 :fm-index 2.1604 :reverb-amount 0.0020
- :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0400 f+ 0.9 603.5612 0.16 :fm-index 2.4204 :reverb-amount 0.0031
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0450 f+ 0.4500 348.4765 0.16 :fm-index 2.3918 :reverb-amount 0.0026
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0460 f+ 0.9 201.1989 0.16 :fm-index 1.5205 :reverb-amount 0.0024
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0460 f+ 0.9 116.1656 0.16 :fm-index 2.3049 :reverb-amount 0.0028
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0500 f+ 0.9 3135.9200 0.16 :fm-index 2.4363 :reverb-amount 0.0021
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0500 f+ 0.45 1464.6987 0.16 :fm-index 2.3865 :reverb-amount 0.0027
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0600 f+ 0.9 6714.0048 0.16 :fm-index 1.7354 :reverb-amount 0.0021
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0650 f+ 0.9 684.1190 0.16 :fm-index 1.8282 :reverb-amount 0.0025
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0700 f+ 0.2700 684.1190 0.16 :fm-index 2.3923 :reverb-amount 0.0025
- :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.1010 0.3 25.0842 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.1010 0.3 25.0842 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0700 f+ 0.63 1464.6987 0.16 :fm-index 2.2789 :reverb-amount 0.0028
- :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0800 f+ 0.9 319.5325 0.16 :fm-index 1.5438 :reverb-amount 0.0027
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0850 f+ 0.4500 149.2445 0.16 :fm-index 2.4210 :reverb-amount 0.0028
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0860 f+ 0.9 69.7078 0.16 :fm-index 2.0288 :reverb-amount 0.0029
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 0.0860 f+ 0.9 32.5585 0.16 :fm-index 1.8254 :reverb-amount 0.0028
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- :noise-amount 0.0100 vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ :noise-amount 0.0100 vln-one-sin-ran
beg 3 + dup to beg test-info
@@ -669,65 +724,65 @@ event: fth-long-example ( -- )
0 to fmv-reverb-amount
0.01 to fmv-noise-amount
beg 0.0500 f+ 0.9 3135.9200 0.16 :fm-index 1.7334
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.0500 f+ 0.45 1810.5774 0.16 :fm-index 2.3629
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ vln-one-sin-ran
beg 0.0600 f+ 0.9 5431.4135 0.16 :fm-index 2.2744
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.0650 f+ 0.9 1045.3680 0.16 :fm-index 1.8722
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.1100 f+ 0.27 1045.3680 0.16 :fm-index 2.3139
- :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.101 0.3 25.0842 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.101 0.3 25.0842 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.1100 f+ 0.63 1810.5774 0.16 :fm-index 1.6216
- :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.1200 f+ 0.9 603.5612 0.16 :fm-index 1.5308
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.1650 f+ 0.45 348.4765 0.16 :fm-index 2.0346
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ vln-one-sin-ran
beg 0.1660 f+ 0.9 201.1989 0.16 :fm-index 1.8176
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.1660 f+ 0.9 116.1656 0.16 :fm-index 1.7145
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.1700 f+ 0.9 3135.9200 0.16 :fm-index 2.4459
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.1700 f+ 0.45 1464.6987 0.16 :fm-index 2.4644
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ vln-one-sin-ran
beg 0.1800 f+ 0.9 6714.0048 0.16 :fm-index 1.9985
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.1850 f+ 0.9 684.1190 0.16 :fm-index 2.4542
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.2900 f+ 0.27 684.1190 0.16 :fm-index 2.3391
- :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.101 0.3 25.0842 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 1.1111 1 5.1066 0.6 10.101 0.3 25.0842 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.2900 f+ 0.63 1464.6987 0.16 :fm-index 1.5138
- :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.4762 1 4.4974 0.6 9.5238 0.3 24.6032 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.3 f+ 0.9 319.5325 0.16 :fm-index 1.5440
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.3050 f+ 0.45 149.2445 0.16 :fm-index 2.2283
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ vln-one-sin-ran
beg 0.3060 f+ 0.9 69.7078 0.16 :fm-index 1.9498
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 0.3060 f+ 0.9 32.5585 0.16 :fm-index 2.2943
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
- vln-one-sin-ran
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100.0 0 )
+ vln-one-sin-ran
beg 3 + dup to beg test-info
@@ -1206,25 +1261,35 @@ event: fth-long-example ( -- )
\ 29, score 142
restore-fm-violin-defaults
beg 0.1200 f+ 0.4 2092.9600 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410
+ :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
beg 0.1200 f+ 0.5 2088.7820 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 0.1200 f+ 0.3 2097.1460 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 0.1200 f+ 0.5 2084.6130 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 0.1210 f+ 0.3 1048.5730 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 0.1220 f+ 0.3 1040.2260 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 0.1220 f+ 0.5 1034.0100 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 0.1230 f+ 0.5 1046.4800 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 0.1240 f+ 0.3 1044.3900 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 0.1240 f+ 0.5 1041.2630 0.16 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410
+ :fm1-rat 2.7180 vln-one-sin
beg 2 + dup to beg test-info
@@ -1235,169 +1300,170 @@ event: fth-long-example ( -- )
4.414 to fmv-fm2-rat
5.141 to fmv-fm3-rat
beg 0.4880 f+ 1.1770 416.6072 0.0110 :fm-index 1.1140 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.5050 f+ 2.4900 859.5863 0.0083 :fm-index 0.5890 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 1 + to beg
beg 0.0590 f+ 1.0550 1758.0816 0.0053 :fm-index 1.8640 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.0930 f+ 1.8580 229.0566 0.0110 :fm-index 1.9690 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.3490 f+ 3.3680 479.1994 0.0083 :fm-index 1.9970 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.5010 f+ 3.0680 411.8241 0.0110 :fm-index 1.5390 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.5200 f+ 2.8290 984.8456 0.0053 :fm-index 0.0560 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.6100 f+ 0.7040 1767.7444 0.0053 :fm-index 1.2620 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.8480 f+ 3.0510 859.7203 0.0083 :fm-index 1.6080 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 1 + to beg
beg 0.4880 f+ 3.2350 231.9431 0.0110 :fm-index 0.9690 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.5610 f+ 3.2810 475.2009 0.0083 :fm-index 0.3740 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.7970 f+ 2.8400 988.8375 0.0053 :fm-index 0.4200 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 1 + to beg
beg 0.0620 f+ 1.0210 411.7247 0.0110 :fm-index 0.1370 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.2130 f+ 1.1610 848.5959 0.0083 :fm-index 1.3120 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.4410 f+ 2.6160 390.0600 0.0110 :fm-index 1.9030 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.4490 f+ 0.7000 802.3538 0.0083 :fm-index 1.5940 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.5270 f+ 2.5080 1773.9366 0.0053 :fm-index 1.8030 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.7820 f+ 2.7990 232.4344 0.0110 :fm-index 0.0590 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.7830 f+ 2.7660 1650.1434 0.0053 :fm-index 0.4400 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.7890 f+ 3.1560 475.7231 0.0083 :fm-index 0.7370 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 1 + to beg
beg 0.1540 f+ 2.1290 976.0237 0.0053 :fm-index 1.2690 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.4890 f+ 3.3650 390.0525 0.0110 :fm-index 1.4580 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.7450 f+ 1.5070 1665.9722 0.0053 :fm-index 1.9330 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.8320 f+ 1.4430 798.1238 0.0083 :fm-index 0.8560 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.9440 f+ 3.1560 229.0528 0.0110 :fm-index 1.8300 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 1 + to beg
beg 0.3930 f+ 1.1100 473.7225 0.0083 :fm-index 1.6260 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.6970 f+ 1.6170 988.7953 0.0053 :fm-index 0.4230 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 1 + to beg
beg 0.0620 f+ 1.3190 390.9769 0.0110 :fm-index 0.4100 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.0840 f+ 3.3660 804.6413 0.0083 :fm-index 1.8760 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.1740 f+ 2.7210 418.6819 0.0110 :fm-index 0.0910 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.5700 f+ 3.4460 845.4019 0.0077 :fm-index 0.7660 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.6440 f+ 1.1790 1656.5756 0.0049 :fm-index 0.2960 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.6600 f+ 2.8520 1758.9788 0.0049 :fm-index 0.4520 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.8270 f+ 1.8840 387.0009 0.0099 :fm-index 1.3010 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.8870 f+ 3.4040 796.7213 0.0077 :fm-index 1.1820 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.9640 f+ 3.3230 416.3916 0.0099 :fm-index 0.6290 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 1 + to beg
beg 0.1320 f+ 1.7050 1637.2303 0.0049 :fm-index 1.0570 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.15 f+ 3.1250 1762.4906 0.0049 :fm-index 1.3170 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.3860 f+ 2.9670 852.0487 0.0077 :fm-index 1.4790 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.6670 f+ 0.6780 413.7094 0.0099 :fm-index 0.9470 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.8780 f+ 2.7490 1749.7509 0.0049 :fm-index 0.5040 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.9730 f+ 0.5990 848.1253 0.0077 :fm-index 1.9380 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 1 + to beg
beg 0.0880 f+ 3.3360 229.9144 0.0099 :fm-index 1.3930 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.1170 f+ 1.1300 984.0816 0.0049 :fm-index 0.3560 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.4640 f+ 1.7330 478.7184 0.0077 :fm-index 0.2840 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.5760 f+ 0.5680 413.4253 0.0099 :fm-index 1.5020 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.8200 f+ 1.2150 230.9588 0.0099 :fm-index 1.0990 :reverb-amount 0.1
- :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z1amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.8320 f+ 3.4590 473.8903 0.0077 :fm-index 0.7680 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 0.8320 f+ 0.7260 857.2875 0.0077 :fm-index 0.7520 :reverb-amount 0.1
- :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
+ :amp-env z2amp :noise-amount 0.0050 vln-one-sin-ran
beg 4 + dup to beg test-info
\ 31, score 156
'( 0 1 20 0 100 0 ) { indfunc }
'( 0 1 90 1 100 0 ) { indfunc2 }
- '( 0 1 6 1 10 0.5 20 0.3630 30 0.27 40 0.2 50 0.12 60 0.08 70 0.04 100 0 ) { ampfunc }
+ '( 0 1 6 1 10 0.5 20 0.3630 30 0.27
+ 40 0.2 50 0.12 60 0.08 70 0.04 100 0 ) { ampfunc }
'( 0 0 1 1 3 1 10 0.5 30 0.2 60 0.05 100 0 ) { ampfunc1 }
restore-fm-violin-defaults
beg 0.2600 f+ 0.0500 80 0.8 :fm-index 5 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
+ :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
beg 1 + to beg
beg 0.2610 f+ 0.2 80 0.8 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 1 + to beg
beg 0.2600 f+ 0.05 80 0.8 :fm-index 5 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
+ :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
beg 0.2620 f+ 0.2 80 0.8 :fm-index 5 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 1 + to beg
beg 0.2600 f+ 0.0500 80 0.8 :fm-index 6 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
+ :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
beg 0.2630 f+ 0.2 80 0.8 :fm-index 6 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 1 + to beg
beg 0.2600 f+ 0.0500 80 0.3 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
+ :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
beg 0.2620 f+ 0.1 160 0.3 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 0.2620 f+ 0.2500 80 0.8 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 1 + to beg
beg 0.2600 f+ 0.0500 80 0.5000 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
+ :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
beg 0.2610 f+ 0.1 210 0.3 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 0.2620 f+ 0.2 80 0.1 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 0.2630 f+ 0.2500 320 0.1 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 1 + to beg
beg 0.2600 f+ 0.0500 80 0.8 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
+ :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
beg 0.2610 f+ 0.1 210 0.1 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 0.2620 f+ 0.2 80 0.2 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 0.2630 f+ 0.2500 320 0.3 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 1 + to beg
beg 0.2600 f+ 0.0500 80 0.8 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
+ :amp-env ampfunc1 :fm1-env indfunc2 vln-one-sin
beg 0.2610 f+ 0.1 210 0.1 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 0.2620 f+ 0.2 80 0.2 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 0.2630 f+ 0.2500 320 0.3 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat 0.6875 vln-one-sin
beg 1 + dup to beg test-info
@@ -1408,66 +1474,66 @@ event: fth-long-example ( -- )
4.414 to fmv-fm2-rat
2.718 to fmv-fm3-rat
beg 0.2600 f+ 4 3286.9937 0.16 :fm-index 2.2165 :reverb-amount 0.01
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2603 f+ 4 1046.4800 0.16 :fm-index 2.3234 :reverb-amount 0.01
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2605 f+ 4 2844.3326 0.16 :fm-index 2.4790 :reverb-amount 0.1
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2608 f+ 4 821.7484 0.1 :fm-index 1.8667 :reverb-amount 0.01
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2610 f+ 4 261.6200 0.1 :fm-index 1.8523 :reverb-amount 0.01
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2613 f+ 4 711.0832 0.1 :fm-index 2.2300 :reverb-amount 0.1
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2615 f+ 4 205.4371 0.06 :fm-index 1.5187 :reverb-amount 0.01
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2618 f+ 4 65.4050 0.06 :fm-index 2.4074 :reverb-amount 0.01
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2620 f+ 4 177.7708 0.06 :fm-index 2.4481 :reverb-amount 0.1
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2623 f+ 4 51.3593 0.01 :fm-index 2.3069 :reverb-amount 0.01
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2625 f+ 4 16.3513 0.01 :fm-index 2.1008 :reverb-amount 0.01
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 0.2628 f+ 4 44.4427 0.01 :fm-index 2.4860 :reverb-amount 0.1
- :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
+ :amp-env n-amp :fm1-env n-amp vln-one-sin-ran
beg 8 + dup to beg test-info
\ 33, score 172
restore-fm-violin-defaults
beg 0.2603 f+ 1.2 88.8854 0.1 :fm-index 2.3144 :reverb-amount 0.2
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
beg 0.2603 f+ 4 88.8854 0.1 :fm-index 2.1690 :reverb-amount 0.2
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
beg 0.2605 f+ 2.8 168.1236 0.05 :fm-index 2.1850 :reverb-amount 0.2
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
beg 0.2608 f+ 1.2 168.1236 0.08 :fm-index 1.7743 :reverb-amount 0.2
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
beg 0.2610 f+ 2 32.7025 0.1 :fm-index 2.4925 :reverb-amount 0.2
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
beg 0.2633 f+ 2 32.7025 0.1 :fm-index 2.1325 :reverb-amount 0.2
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
beg 0.2643 f+ 4 32.7025 0.05 :fm-index 1.7578 :reverb-amount 0.2
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
+ :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180 vln-one-sin
beg 8 + dup to beg test-info
\ 34, score 180
beg 0.2600 f+ 6.6830 244.8160 0.0060 :fm-index 2 :reverb-amount 0.2
- :noise-amount 0.0040 vln-one-sin-ran
+ :noise-amount 0.0040 vln-one-sin-ran
beg 0.2600 f+ 5.5170 495.4040 0.0060 :fm-index 2 :reverb-amount 0.2
- :noise-amount 0.0040 vln-one-sin-ran
+ :noise-amount 0.0040 vln-one-sin-ran
beg 0.2600 f+ 7.5350 980.6190 0.0020 :fm-index 2 :reverb-amount 0.2
- :noise-amount 0.0040 vln-one-sin-ran
+ :noise-amount 0.0040 vln-one-sin-ran
beg 0.2600 f+ 7.1990 1965.4290 0.0020 :fm-index 0.8 :reverb-amount 0.2
- :noise-amount 0.0040 vln-one-sin-ran
+ :noise-amount 0.0040 vln-one-sin-ran
beg 0.2600 f+ 4.0790 3835.3170 0.0020 :fm-index 0.8 :reverb-amount 0.2
- :noise-amount 0.0040 vln-one-sin-ran
+ :noise-amount 0.0040 vln-one-sin-ran
beg 0.5170 f+ 4.7400 1320.9670 0.0020 :fm-index 0.8 :reverb-amount 0.2
- :noise-amount 0.0040 vln-one-sin-ran
+ :noise-amount 0.0040 vln-one-sin-ran
beg 0.7040 f+ 7.2080 655.5670 0.0040 :fm-index 2 :reverb-amount 0.2
- :noise-amount 0.0040 vln-one-sin-ran
+ :noise-amount 0.0040 vln-one-sin-ran
beg 9 + dup to beg test-info
@@ -1476,211 +1542,243 @@ event: fth-long-example ( -- )
0 to fmv-glissando-amount
0.9 to fmv-reverb-amount
beg 0.5450 f+ 6.4650 366.3330 0.0320 :fm-index 1.0480
- :amp-env '( 0 0 1.5468 1 2.0882 0.7 2.3202 1 98.4532 0.7500 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 1.5468 1 2.0882 0.7 2.3202 1 98.4532 0.7500 100 0 )
+ vln-one-sin-exp
beg 0.5950 f+ 8.4340 1172.5830 0.0180 :fm-index 1.1350
- :amp-env '( 0 0 1.1857 1.0 1.6007 0.7 1.7785 1 98.8143 0.5556 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 1.1857 1.0 1.6007 0.7 1.7785 1 98.8143 0.5556 100 0 )
+ vln-one-sin-exp
beg 0.7650 f+ 1.6210 369.9940 0.0170 :fm-index 0.0960
- :amp-env '( 0 0 6.1690 1.0 8.3282 0.7 9.2535 1 93.8310 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 6.1690 1.0 8.3282 0.7 9.2535 1 93.8310 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.8820 f+ 3.0640 246.9420 0.0170 :fm-index 0.0020
- :amp-env '( 0 0 3.2637 1 4.4060 0.7 4.8956 1.0 96.7363 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 3.2637 1 4.4060 0.7 4.8956 1.0 96.7363 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.9250 f+ 3.1170 123.4710 0.0380 :fm-index 0.2330
- :amp-env '( 0 0 3.2082 1 4.3311 0.7 4.8123 1 96.7918 0.7895 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 3.2082 1 4.3311 0.7 4.8123 1 96.7918 0.7895 100 0 )
+ vln-one-sin-exp
beg 0.9810 f+ 3.5670 123.4710 0.0420 :fm-index 0.2330
- :amp-env '( 0 0 2.8035 1 3.7847 0.7 4.2052 1.0 97.1965 0.8095 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 2.8035 1 3.7847 0.7 4.2052 1.0 97.1965 0.8095 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.1280 f+ 1.0450 246.9420 0.0170 :fm-index 1.2050
- :amp-env '( 0 0 9.5694 1 12.9187 0.7 14.3541 1 90.4306 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 9.5694 1 12.9187 0.7 14.3541 1 90.4306 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.2550 f+ 3.3870 374.1370 0.0170 :fm-index 0.1800
- :amp-env '( 0 0 2.9525 1.0 3.9858 0.7 4.4287 1 97.0475 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 2.9525 1.0 3.9858 0.7 4.4287 1 97.0475 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.2990 f+ 8.3050 1576.9120 0.0200 :fm-index 0.2990
- :amp-env '( 0 0 1.2041 1 1.6255 0.7 1.8061 1 98.7959 0.6 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 1.2041 1 1.6255 0.7 1.8061 1 98.7959 0.6 100 0 )
+ vln-one-sin-exp
beg 0.3300 f+ 4.4630 246.9420 0.0170 :fm-index 0.0020
- :amp-env '( 0 0 2.2406 1 3.0249 0.7 3.3610 1.0 97.7594 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 2.2406 1 3.0249 0.7 3.3610 1.0 97.7594 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.6600 f+ 8.9940 1576.9120 0.0200 :fm-index 0.2990
- :amp-env '( 0 0 1.1119 1 1.5010 0.7 1.6678 1 98.8881 0.6 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 1.1119 1 1.5010 0.7 1.6678 1 98.8881 0.6 100 0 )
+ vln-one-sin-exp
beg 0.9060 f+ 8.8360 1172.5830 0.0180 :fm-index 1.1350
- :amp-env '( 0 0 1.1317 1 1.5278 0.7 1.6976 1 98.8683 0.5556 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 1.1317 1 1.5278 0.7 1.6976 1 98.8683 0.5556 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.1510 f+ 4.9320 374.1370 0.0170 :fm-index 0.1800
- :amp-env '( 0 0 2.0276 1 2.7372 0.7 3.0414 1 97.9724 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 2.0276 1 2.7372 0.7 3.0414 1 97.9724 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.2720 f+ 2.3250 369.9940 0.0170 :fm-index 1.1030
- :amp-env '( 0 0 4.3011 1 5.8065 0.7 6.4516 1 95.6989 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 4.3011 1 5.8065 0.7 6.4516 1 95.6989 0.5294 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.6960 f+ 3.5540 366.3330 0.0310 :fm-index 1.0480
- :amp-env '( 0 0 2.8137 1 3.7985 0.7 4.2206 1 97.1863 0.7419 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 2.8137 1 3.7985 0.7 4.2206 1 97.1863 0.7419 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.7240 f+ 0.6040 246.9420 0.0170 :fm-index 1.2050
- :amp-env '( 0 0 16.5563 1 22.351 0.7 24.8344 1 83.4437 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 16.5563 1 22.351 0.7 24.8344 1 83.4437 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.9420 f+ 2.5010 123.4710 0.0330 :fm-index 0.2330
- :amp-env '( 0 0 3.9984 1 5.3978 0.7 5.9976 1 96.0016 0.7576 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 3.9984 1 5.3978 0.7 5.9976 1 96.0016 0.7576 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.0340 f+ 2.3860 246.9420 0.0170 :fm-index 0.0020
- :amp-env '( 0 0 4.1911 1 5.6580 0.7 6.2867 1 95.8089 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 4.1911 1 5.6580 0.7 6.2867 1 95.8089 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.3850 f+ 1.4510 369.9940 0.0170 :fm-index 1.1030
- :amp-env '( 0 0 6.8918 1 9.3039 0.7 10.3377 1 93.1082 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 6.8918 1 9.3039 0.7 10.3377 1 93.1082 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.5670 f+ 2.6550 374.1370 0.0170 :fm-index 0.1800
- :amp-env '( 0 0 3.7665 1 5.0847 0.7 5.6497 1 96.2335 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 3.7665 1 5.0847 0.7 5.6497 1 96.2335 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.9830 f+ 2.9860 123.4710 0.0380 :fm-index 0.2330
- :amp-env '( 0 0 3.3490 1 4.5211 0.7 5.0234 1 96.6510 0.7895 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 3.3490 1 4.5211 0.7 5.0234 1 96.6510 0.7895 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.4910 f+ 0.6110 123.9770 0.0170 :fm-index 0.7550
- :amp-env '( 0 0 16.3666 1 22.0949 0.7 24.55 1 83.6334 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 16.3666 1 22.0949 0.7 24.55 1 83.6334 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.7570 f+ 1.4440 123.4710 0.0170 :fm-index 0.0020
- :amp-env '( 0 0 6.9252 1 9.3490 0.7 10.3878 1 93.0748 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 6.9252 1 9.3490 0.7 10.3878 1 93.0748 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.7750 f+ 0.5370 92.4435 0.0330 :fm-index 0.9200
- :amp-env '( 0 0 18.622 1 25.1397 0.7 27.9330 1 81.3780 0.7576 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 18.622 1 25.1397 0.7 27.9330 1 81.3780 0.7576 100 0 )
+ vln-one-sin-exp
beg 0.7750 f+ 10.537 92.4435 0.0130 :fm-index 0.9200
- :amp-env '( 0 0 0.9490 1 1.2812 0.7 1.4236 1 99.0510 0.3846 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 0.9490 1 1.2812 0.7 1.4236 1 99.0510 0.3846 100 0 )
+ vln-one-sin-exp
beg 0.9380 f+ 0.6520 122.2995 0.0170 :fm-index 1.8380
- :amp-env '( 0 0 15.3374 1 20.706 0.7 23.0061 1 84.6626 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 15.3374 1 20.706 0.7 23.0061 1 84.6626 0.5294 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.2350 f+ 3.7250 586.2915 0.0180 :fm-index 1.1350
- :amp-env '( 0 0 2.6846 1 3.6242 0.7 4.0268 1 97.3154 0.5556 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 2.6846 1 3.6242 0.7 4.0268 1 97.3154 0.5556 100 0 )
+ vln-one-sin-exp
beg 0.2560 f+ 2.8900 183.1665 0.0260 :fm-index 1.0480
- :amp-env '( 0 0 3.4602 1 4.6713 0.7 5.1903 1 96.5398 0.6923 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 3.4602 1 4.6713 0.7 5.1903 1 96.5398 0.6923 100 0 )
+ vln-one-sin-exp
beg 0.2710 f+ 1.6210 187.0685 0.0170 :fm-index 0.1800
- :amp-env '( 0 0 6.169 1.0 8.3282 0.7 9.2535 1 93.8310 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 6.169 1.0 8.3282 0.7 9.2535 1 93.8310 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.2920 f+ 2.0160 183.1665 0.0290 :fm-index 1.0480
- :amp-env '( 0 0 4.9603 1 6.6964 0.7 7.4405 1 95.0397 0.7241 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 4.9603 1 6.6964 0.7 7.4405 1 95.0397 0.7241 100 0 )
+ vln-one-sin-exp
beg 0.2920 f+ 12.016 183.1665 0.0290 :fm-index 1.0480
- :amp-env '( 0 0 0.832 1 1.1235 0.7 1.248 1.0 99.1678 0.7241 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 0.832 1 1.1235 0.7 1.248 1.0 99.1678 0.7241 100 0 )
+ vln-one-sin-exp
beg 0.3300 f+ 0.7300 184.9970 0.0170 :fm-index 0.0960
- :amp-env '( 0 0 13.699 1 18.4932 0.7 20.548 1.0 86.3014 0.529 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 13.699 1 18.4932 0.7 20.548 1.0 86.3014 0.529 100 0 )
+ vln-one-sin-exp
beg 0.3570 f+ 1.9600 183.1665 0.0280 :fm-index 1.0480
- :amp-env '( 0 0 5.1020 1.0 6.8878 0.7 7.6531 1 94.8980 0.7143 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 5.1020 1.0 6.8878 0.7 7.6531 1 94.8980 0.7143 100 0 )
+ vln-one-sin-exp
beg 0.3820 f+ 2.2450 61.7355 0.0330 :fm-index 0.2330
- :amp-env '( 0 0 4.4543 1 6.0134 0.7 6.6815 1 95.5457 0.7576 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 4.4543 1 6.0134 0.7 6.6815 1 95.5457 0.7576 100 0 )
+ vln-one-sin-exp
beg 0.3820 f+ 12.2450 61.7355 0.0330 :fm-index 0.2330
- :amp-env '( 0 0 0.8167 1 1.1025 0.7 1.2250 1 99.1833 0.7576 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 0.8167 1 1.1025 0.7 1.2250 1 99.1833 0.7576 100 0 )
+ vln-one-sin-exp
beg 0.5410 f+ 3.0130 246.5050 0.0360 :fm-index 1.1350
- :amp-env '( 0 0 3.3190 1.0 4.4806 0.7 4.9784 1 96.6810 0.7778 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 3.3190 1.0 4.4806 0.7 4.9784 1 96.6810 0.7778 100 0 )
+ vln-one-sin-exp
beg 0.5570 f+ 2.322 1251.5960 0.0400 :fm-index 0.2990
- :amp-env '( 0 0 4.3066 1 5.8140 0.7 6.4599 1 95.6934 0.8 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 4.3066 1 5.8140 0.7 6.4599 1 95.6934 0.8 100 0 )
+ vln-one-sin-exp
beg 0.5570 f+ 18.322 1251.5960 0.020 :fm-index 0.2990
- :amp-env '( 0 0 0.5458 1.000 0.7368 0.7 0.8187 1 99.4542 0.6 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 0.5458 1.000 0.7368 0.7 0.8187 1 99.4542 0.6 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.1060 f+ 1.9900 183.1665 0.0230 :fm-index 1.0480
- :amp-env '( 0 0 5.0251 1.0 6.7839 0.7 7.5377 1 94.9749 0.6522 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 5.0251 1.0 6.7839 0.7 7.5377 1 94.9749 0.6522 100 0 )
+ vln-one-sin-exp
beg 0.2570 f+ 1.9180 61.7355 0.0330 :fm-index 0.2330
- :amp-env '( 0 0 5.2138 1 7.0386 0.7 7.8206 1 94.7862 0.7576 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 5.2138 1 7.0386 0.7 7.8206 1 94.7862 0.7576 100 0 )
+ vln-one-sin-exp
beg 0.6370 f+ 1.3090 183.1665 0.0310 :fm-index 1.0480
- :amp-env '( 0 0 7.6394 1 10.3132 0.7 11.4591 1 92.3606 0.7419 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 7.6394 1 10.3132 0.7 11.4591 1 92.3606 0.7419 100 0 )
+ vln-one-sin-exp
beg 1 + to beg
beg 0.0330 f+ 1.1590 183.1665 0.0250 :fm-index 1.0480
- :amp-env '( 0 0 8.6281 1 11.6480 0.7 12.9422 1 91.3719 0.6800 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 8.6281 1 11.6480 0.7 12.9422 1 91.3719 0.6800 100 0 )
+ vln-one-sin-exp
beg 0.0980 f+ 1.2400 30.8675 0.0330 :fm-index 0.2330
- :amp-env '( 0 0 8.0645 1 10.8871 0.7 12.0968 1 91.9355 0.7576 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 8.0645 1 10.8871 0.7 12.0968 1 91.9355 0.7576 100 0 )
+ vln-one-sin-exp
beg 0.0980 f+ 11.2400 30.8675 0.0130 :fm-index 0.2330
- :amp-env '( 0 0 0.8897 1 1.2011 0.7 1.3345 1 99.1103 0.3846 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 0.8897 1 1.2011 0.7 1.3345 1 99.1103 0.3846 100 0 )
+ vln-one-sin-exp
beg 0.1260 f+ 0.2600 123.4710 0.0170 :fm-index 1.2050
- :amp-env '( 0 0 38.462 1 51.9231 0.7 57.6923 1 61.5385 0.5294 100 0 )
- vln-one-sin-exp
+ :amp-env '( 0 0 38.462 1 51.9231 0.7 57.6923 1 61.5385 0.5294 100 0 )
+ vln-one-sin-exp
beg 0.1260 f+ 10.26 123.4710 0.0170 :fm-index 1.2050
- :amp-env '( 0 0 0.9747 1 1.3158 0.7 1.4620 1 99.0253 0.5294 100 0 )
- vln-one-sin-exp
- beg 0.0600 f+ 13.8770 3951.1200 0.0090 :amp-env updown vln-one-sin
- beg 0.2600 f+ 14.8770 123.4725 0.0170 :fm-index 1.5 :amp-env updown vln-one-sin
- beg 0.2600 f+ 13.8770 61.7363 0.0170 :fm-index 1.5 :amp-env updown vln-one-sin
- beg 0.2600 f+ 12.8770 30.8681 0.0170 :fm-index 1.5 :amp-env updown vln-one-sin
- beg 0.2600 f+ 11.8770 15.4341 0.0170 :fm-index 1.5 :amp-env updown vln-one-sin
+ :amp-env '( 0 0 0.9747 1 1.3158 0.7 1.4620 1 99.0253 0.5294 100 0 )
+ vln-one-sin-exp
+ beg 0.0600 f+ 13.877 3951.1200 0.009 :amp-env updown vln-one-sin
+ beg 0.2600 f+ 14.877 123.4725 0.017 :fm-index 1.5 :amp-env updown vln-one-sin
+ beg 0.2600 f+ 13.877 61.7363 0.017 :fm-index 1.5 :amp-env updown vln-one-sin
+ beg 0.2600 f+ 12.877 30.8681 0.017 :fm-index 1.5 :amp-env updown vln-one-sin
+ beg 0.2600 f+ 11.877 15.4341 0.017 :fm-index 1.5 :amp-env updown vln-one-sin
beg 19 + dup to beg test-info
\ 36, score 217
restore-fm-violin-defaults
beg 0.2620 f+ 0.3906 440 0.4500 :fm-index 1.2 :reverb-amount 0.0013
- :amp-env '( 0 0 0.7680 1 4.7774 0.6 9.7891 0.3 24.8243 0.1 100 0 ) cel-one-sum
+ :amp-env '( 0 0 0.7680 1 4.7774 0.6 9.7891 0.3 24.8243 0.1 100 0 )
+ cel-one-sum
beg 0.2640 f+ 0.5220 220 0.4500 :fm-index 1.2 :reverb-amount 0.0012
- :amp-env '( 0 0 0.5747 1.0 4.5919 0.6 9.6134 0.3 24.6778 0.1 100 0 ) cel-one-sum
+ :amp-env '( 0 0 0.5747 1.0 4.5919 0.6 9.6134 0.3 24.6778 0.1 100 0 )
+ cel-one-sum
beg 0.2660 f+ 1.5660 880 0.4500 :fm-index 1.2 :reverb-amount 0.0014
- :amp-env '( 0 0 0.1916 1.0 4.2242 0.6 9.2651 0.3 24.3876 0.1 100 0 ) cel-one-sum
+ :amp-env '( 0 0 0.1916 1.0 4.2242 0.6 9.2651 0.3 24.3876 0.1 100 0 )
+ cel-one-sum
beg 0.2680 f+ 1.5660 110 0.4500 :fm-index 1.2 :reverb-amount 0.0013
- :amp-env '( 0 0 0.1916 1.0 4.2242 0.6 9.2651 0.3 24.3876 0.1 100 0 ) cel-one-sum
+ :amp-env '( 0 0 0.1916 1.0 4.2242 0.6 9.2651 0.3 24.3876 0.1 100 0 )
+ cel-one-sum
beg 3 + dup to beg test-info
\ 37, score 220
- beg 0.8600 f+ 0.9 733.3330 0.1875 :fm-index 0.2 :distance 1.0 :reverb-amount 0.0012
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100 0 ) vln-one-sin
- beg 0.8600 f+ 0.225 550 0.1875 :fm-index 0.2 :distance 1.0 :reverb-amount 0.0015
- :amp-env '( 0 0 1.3333 1 5.3199 0.6 10.3030 0.3 25.2525 0.1 100 0 ) vln-one-sin
- beg 0.8600 f+ 0.45 586.6670 0.3750 :fm-index 0.2 :distance 1.0 :reverb-amount 0.0013
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 ) vln-one-sin
- beg 0.9020 f+ 0.9 733.3330 0.1875 :fm-index 0.4 :distance 1.0 :reverb-amount 0.0013
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100 0 ) vln-one-sin
- beg 0.9020 f+ 0.225 550 0.1875 :fm-index 0.4 :distance 1.0 :reverb-amount 0.0010
- :amp-env '( 0 0 1.3333 1 5.3199 0.6 10.3030 0.3 25.2525 0.1 100 0 ) vln-one-sin
- beg 0.9020 f+ 0.45 586.6670 0.3750 :fm-index 0.4 :distance 1.0 :reverb-amount 0.0015
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 ) vln-one-sin
- beg 0.9430 f+ 0.9 366.6670 0.1875 :fm-index 0.6 :distance 1.0 :reverb-amount 0.0016
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100 0 ) vln-one-sin
- beg 0.9430 f+ 0.225 275 0.1875 :fm-index 0.6 :distance 1.0 :reverb-amount 0.0015
- :amp-env '( 0 0 1.3333 1 5.3199 0.6 10.3030 0.3 25.2525 0.1 100 0 ) vln-one-sin
- beg 0.9430 f+ 0.45 293.3340 0.3750 :fm-index 0.6 :distance 1.0 :reverb-amount 0.0015
- :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 ) vln-one-sin
- beg 0.9850 f+ 0.9 733.3330 0.1875 :fm-index 0.8 :distance 1.0 :reverb-amount 0.0010
- :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100 0 ) vln-one-sin
- beg 0.9850 f+ 0.225 550 0.1875 :fm-index 0.8 :distance 1.0 :reverb-amount 0.0013
- :amp-env '( 0 0 1.3333 1 5.3199 0.6 10.3030 0.3 25.2525 0.1 100 0 ) vln-one-sin
+ beg 0.8600 f+ 0.9 733.3330 0.1875 :fm-index 0.2 :distance 1.0
+ :reverb-amount 0.0012
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100 0 )
+ vln-one-sin
+ beg 0.8600 f+ 0.225 550 0.1875 :fm-index 0.2 :distance 1.0
+ :reverb-amount 0.0015
+ :amp-env '( 0 0 1.3333 1 5.3199 0.6 10.3030 0.3 25.2525 0.1 100 0 )
+ vln-one-sin
+ beg 0.8600 f+ 0.45 586.6670 0.3750 :fm-index 0.2 :distance 1.0
+ :reverb-amount 0.0013
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ vln-one-sin
+ beg 0.9020 f+ 0.9 733.3330 0.1875 :fm-index 0.4 :distance 1.0
+ :reverb-amount 0.0013
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100 0 )
+ vln-one-sin
+ beg 0.9020 f+ 0.225 550 0.1875 :fm-index 0.4 :distance 1.0
+ :reverb-amount 0.0010
+ :amp-env '( 0 0 1.3333 1 5.3199 0.6 10.3030 0.3 25.2525 0.1 100 0 )
+ vln-one-sin
+ beg 0.9020 f+ 0.45 586.6670 0.3750 :fm-index 0.4 :distance 1.0
+ :reverb-amount 0.0015
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ vln-one-sin
+ beg 0.9430 f+ 0.9 366.6670 0.1875 :fm-index 0.6 :distance 1.0
+ :reverb-amount 0.0016
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100 0 )
+ vln-one-sin
+ beg 0.9430 f+ 0.225 275 0.1875 :fm-index 0.6 :distance 1.0
+ :reverb-amount 0.0015
+ :amp-env '( 0 0 1.3333 1 5.3199 0.6 10.3030 0.3 25.2525 0.1 100 0 )
+ vln-one-sin
+ beg 0.9430 f+ 0.45 293.3340 0.3750 :fm-index 0.6 :distance 1.0
+ :reverb-amount 0.0015
+ :amp-env '( 0 0 0.6667 1 4.6801 0.6 9.6970 0.3 24.7475 0.1 100 0 )
+ vln-one-sin
+ beg 0.9850 f+ 0.9 733.3330 0.1875 :fm-index 0.8 :distance 1.0
+ :reverb-amount 0.0010
+ :amp-env '( 0 0 0.3333 1 4.3603 0.6 9.3939 0.3 24.4950 0.1 100 0 )
+ vln-one-sin
+ beg 0.9850 f+ 0.225 550 0.1875 :fm-index 0.8 :distance 1.0
+ :reverb-amount 0.0013
+ :amp-env '( 0 0 1.3333 1 5.3199 0.6 10.3030 0.3 25.2525 0.1 100 0 )
+ vln-one-sin
;event
: long-example ( -- )
- ['] fth-long-example :reverb ['] freeverb :reverb-data '( :room-decay 0.8 ) with-sound
+ <'> fth-long-example
+ *clm-c-version* if \ we have only a C version of freeverb
+ :reverb <'> freeverb :reverb-data '( :room-decay 0.8 )
+ else
+ :reverb <'> nrev :reverb-data '( :lp-coeff 0.6 )
+ then with-sound
;
+
: short-example ( -- )
- ['] fth-short-example :reverb ['] nrev :reverb-data '( :lp-coeff 0.6 ) with-sound
+ <'> fth-short-example
+ :reverb <'> nrev :reverb-data '( :lp-coeff 0.6 ) with-sound
;
'snd provided? [unless]
*argc* 2 > [if]
- *argv* array-pop drop
- long-example
- [else]
short-example
+ [else]
+ long-example
[then]
[then]
diff --git a/sndins/samples/fmviolin.rb b/sndins/samples/fmviolin.rb
index 298d1ec..90206d1 100755
--- a/sndins/samples/fmviolin.rb
+++ b/sndins/samples/fmviolin.rb
@@ -1,14 +1,9 @@
-#!/usr/bin/env ruby
-# -*- snd-ruby -*-
+#! /usr/bin/env ruby
# fmviolin.rb -- CLM fmviolin.clm --> RBM fmviolin.rb
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Fri Oct 18 11:29:08 CEST 2002
-# Changed: Sun Jul 26 04:47:41 CEST 2009
-
-# This file is part of Sndins.
-
-# Commentary:
+# Created: 02/10/18 11:29:08
+# Changed: 14/11/18 23:51:41
# A translation of Bill Schottstaedt's clm/fmviolin.clm from Lisp
# into Ruby.
@@ -16,11 +11,17 @@
# short_example
# long_example
-# Code:
+$clm_c_version = true
require "sndlib"
-require "sndins"
-require "examp"
+if $clm_c_version
+ require "sndins"
+else
+ require "v" # fm_violin, jc_reverb
+ require "clm-ins" # nrev
+ require "freeverb" # freeverb
+end
+require "clm"
require "ws"
$clm_file_name = "test-ins-r.snd"
@@ -31,6 +32,8 @@ $clm_srate = 44100
$clm_channels = 2
$clm_reverb_channels = 2
$clm_delete_reverb = true
+$clm_header_type = Mus_next
+$clm_sample_type = Mus_bfloat
# show progress of long example
$show = true
@@ -77,37 +80,44 @@ end
def old_fm_violin(start, dur, freq, amp, *args)
fm_violin(start, dur, freq, amp,
- :fm_index, get_args(args, :fm_index, $fm_index),
- :amp_env, get_args(args, :amp_env, $amp_env),
- :periodic_vibrato_rate, get_args(args, :periodic_vibrato_rate, $periodic_vibrato_rate),
+ :fm_index, get_args(args, :fm_index, $fm_index),
+ :amp_env, get_args(args, :amp_env, $amp_env),
+ :periodic_vibrato_rate, get_args(args, :periodic_vibrato_rate,
+ $periodic_vibrato_rate),
:periodic_vibrato_amplitude,
- get_args(args, :periodic_vibrato_amplitude, $periodic_vibrato_amplitude),
- :random_vibrato_rate, get_args(args, :random_vibrato_rate, $random_vibrato_rate),
+ get_args(args, :periodic_vibrato_amplitude,
+ $periodic_vibrato_amplitude),
+ :random_vibrato_rate, get_args(args, :random_vibrato_rate,
+ $random_vibrato_rate),
:random_vibrato_amplitude,
- get_args(args, :random_vibrato_amplitude, $random_vibrato_amplitude),
- :noise_freq, get_args(args, :noise_freq, $noise_freq),
- :noise_amount, get_args(args, :noise_amount, $noise_amount),
- :ind_noise_freq, get_args(args, :ind_noise_freq, $ind_noise_freq),
- :ind_noise_amount, get_args(args, :ind_noise_amount, $ind_noise_amount),
- :amp_noise_freq, get_args(args, :amp_noise_freq, $amp_noise_freq),
- :amp_noise_amount, get_args(args, :amp_noise_amount, $amp_noise_amount),
- :gliss_env, get_args(args, :gliss_env, $gliss_env),
- :glissando_amount, get_args(args, :glissando_amount, $glissando_amount),
- :fm1_env, get_args(args, :fm1_env, $fm1_env),
- :fm2_env, get_args(args, :fm2_env, $fm2_env),
- :fm3_env, get_args(args, :fm3_env, $fm3_env),
- :fm1_rat, get_args(args, :fm1_rat, $fm1_rat),
- :fm2_rat, get_args(args, :fm2_rat, $fm2_rat),
- :fm3_rat, get_args(args, :fm3_rat, $fm3_rat),
- :fm1_index, get_args(args, :fm1_index, $fm1_index),
- :fm2_index, get_args(args, :fm2_index, $fm2_index),
- :fm3_index, get_args(args, :fm3_index, $fm3_index),
- :base, get_args(args, :base, $base),
- :degree, get_args(args, :degree, $degree),
- :distance, get_args(args, :distance, $distance),
- :reverb_amount, get_args(args, :reverb_amount, $reverb_amount),
- :index_type, get_args(args, :index_type, $index_type),
- :no_waveshaping, get_args(args, :no_waveshaping, $no_waveshaping))
+ get_args(args, :random_vibrato_amplitude,
+ $random_vibrato_amplitude),
+ :noise_freq, get_args(args, :noise_freq, $noise_freq),
+ :noise_amount, get_args(args, :noise_amount, $noise_amount),
+ :ind_noise_freq, get_args(args, :ind_noise_freq, $ind_noise_freq),
+ :ind_noise_amount, get_args(args, :ind_noise_amount,
+ $ind_noise_amount),
+ :amp_noise_freq, get_args(args, :amp_noise_freq, $amp_noise_freq),
+ :amp_noise_amount, get_args(args, :amp_noise_amount,
+ $amp_noise_amount),
+ :gliss_env, get_args(args, :gliss_env, $gliss_env),
+ :glissando_amount, get_args(args, :glissando_amount,
+ $glissando_amount),
+ :fm1_env, get_args(args, :fm1_env, $fm1_env),
+ :fm2_env, get_args(args, :fm2_env, $fm2_env),
+ :fm3_env, get_args(args, :fm3_env, $fm3_env),
+ :fm1_rat, get_args(args, :fm1_rat, $fm1_rat),
+ :fm2_rat, get_args(args, :fm2_rat, $fm2_rat),
+ :fm3_rat, get_args(args, :fm3_rat, $fm3_rat),
+ :fm1_index, get_args(args, :fm1_index, $fm1_index),
+ :fm2_index, get_args(args, :fm2_index, $fm2_index),
+ :fm3_index, get_args(args, :fm3_index, $fm3_index),
+ :base, get_args(args, :base, $base),
+ :degree, get_args(args, :degree, $degree),
+ :distance, get_args(args, :distance, $distance),
+ :reverb_amount, get_args(args, :reverb_amount, $reverb_amount),
+ :index_type, get_args(args, :index_type, $index_type),
+ :no_waveshaping, get_args(args, :no_waveshaping, $no_waveshaping))
end
def vln_one_sin(start, dur, freq, amp, *args)
@@ -127,7 +137,7 @@ alias violin vln_one_sin
def cel_one_sum(start, dur, freq, amp, *args)
old_fm_violin(start, dur, freq, amp * 0.125,
- *args + [:degree, random(90.0), :index_type, CELLO])
+ *args + [:degree, random(90.0), :index_type, CELLO])
end
restore_fm_violin_defaults()
@@ -158,9 +168,9 @@ end
def short_example
with_sound(:reverb, :nrev, :reverb_data, [:lp_coeff, 0.6]) do
violin_new(0, 8.53, 993.323, 0.03,
- :fm_index, 0.75, :reverb_amount, 0.2, :amp_env, [0, 0, 221, 1, 240, 0])
+ :fm_index, 0.75, :reverb_amount, 0.2, :amp_env, [0, 0, 221, 1, 240, 0])
violin_new(5, 4.53, 993.323 * 5.0 / 6.0, 0.02,
- :fm_index, 0.55, :reverb_amount, 0.2, :amp_env, [0, 0, 221, 1, 240, 0])
+ :fm_index, 0.55, :reverb_amount, 0.2, :amp_env, [0, 0, 221, 1, 240, 0])
end
end
@@ -177,7 +187,8 @@ def long_example
st = my_times
trace_var(:$t) do |t|
if $show
- message("%2d: score %3d utime %7.3f", i += 1, t, my_times.utime - st.utime)
+ message("%2d: score %3d utime %7.3f",
+ i += 1, t, my_times.utime - st.utime)
end
end
with_sound(:reverb, :freeverb, :reverb_data, [:room_decay, 0.8]) do
@@ -245,454 +256,565 @@ def long_example
$t += 6.0
restore_fm_violin_defaults()
$noise_amount = 0.1
- vln_one_sin_ran($t + 0, 5.4, 116.5400, 0.2500, :fm_index, 2.2822, :reverb_amount, 0.0280,
- :amp_env, [0, 0, 0.0556, 1, 4.0937, 0.6, 9.1414, 0.3, 24.2845, 0.1, 100.0, 0])
- vln_one_sin_ran($t + 0.0100, 5.4, 43.6538, 0.2500, :fm_index, 2.0867, :reverb_amount, 0.0202,
- :amp_env, [0, 0, 0.0556, 1, 4.0937, 0.6, 9.1414, 0.3, 24.2845, 0.1, 100.0, 0])
- vln_one_sin_ran($t + 0.0200, 5.4, 130.8100, 0.2500, :fm_index, 1.9652, :reverb_amount, 0.0270,
- :amp_env, [0, 0, 0.0556, 1, 4.0937, 0.6, 9.1414, 0.3, 24.2845, 0.1, 100.0, 0])
- vln_one_sin_ran($t + 0.0250, 5.4, 87.3075, 0.2500, :fm_index, 2.1524, :reverb_amount, 0.0260,
- :amp_env, [0, 0, 0.0556, 1, 4.0937, 0.6, 9.1414, 0.3, 24.2845, 0.1, 100.0, 0])
- vln_one_sin_ran($t + 0.0300, 4.5, 261.6200, 0.15, :fm_index, 2.1384, :reverb_amount, 0.0242,
- :amp_env, [0, 0, 0.0667, 1, 4.1044, 0.6, 9.1515, 0.3, 24.2929, 0.1, 100, 0])
- vln_one_sin_ran($t + 0.0300, 4.5, 174.6150, 0.15, :fm_index, 2.1425, :reverb_amount, 0.0265,
- :amp_env, [0, 0, 0.0667, 1, 4.1044, 0.6, 9.1515, 0.3, 24.2929, 0.1, 100, 0])
- vln_one_sin_ran($t + 0.0300, 4.5, 130.8100, 0.15, :fm_index, 1.9805, :reverb_amount, 0.0201,
- :amp_env, [0, 0, 0.0667, 1, 4.1044, 0.6, 9.1515, 0.3, 24.2929, 0.1, 100, 0])
- vln_one_sin_ran($t + 0.0350, 4.5, 43.6538, 0.15, :fm_index, 2.4876, :reverb_amount, 0.0329,
- :amp_env, [0, 0, 0.0667, 1, 4.1044, 0.6, 9.1515, 0.3, 24.2929, 0.1, 100, 0])
- vln_one_sin_ran($t + 0.0400, 3.6, 220, 0.15, :fm_index, 1.8282, :reverb_amount, 0.0244,
- :amp_env, [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0],
- :noise_amount, 0.15)
- vln_one_sin_ran($t + 0.0400, 3.6, 174.6150, 0.15, :fm_index, 2.3479, :reverb_amount, 0.0200,
- :amp_env, [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0],
- :noise_amount, 0.15)
- vln_one_sin_ran($t + 0.0400, 3.6, 523.2400, 0.15, :fm_index, 1.6424, :reverb_amount, 0.0286,
- :amp_env, [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0],
- :noise_amount, 0.15)
- vln_one_sin_ran($t + 0.0450, 3.6, 349.2300, 0.15, :fm_index, 1.6449, :reverb_amount, 0.0333,
- :amp_env, [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0],
- :noise_amount, 0.15)
- vln_one_sin_ran($t + 0.0500, 6, 699.4600, 0.15,
- :fm_index, 1.5570, :reverb_amount, 0.1300, :amp_env, tap)
+ vln_one_sin_ran($t + 0, 5.4, 116.5400, 0.2500, :fm_index, 2.2822,
+ :reverb_amount, 0.0280,
+ :amp_env,
+ [0, 0, 0.0556, 1, 4.0937, 0.6, 9.1414, 0.3, 24.2845, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0100, 5.4, 43.6538, 0.2500, :fm_index, 2.0867,
+ :reverb_amount, 0.0202,
+ :amp_env,
+ [0, 0, 0.0556, 1, 4.0937, 0.6, 9.1414, 0.3, 24.2845, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0200, 5.4, 130.8100, 0.2500, :fm_index, 1.9652,
+ :reverb_amount, 0.0270,
+ :amp_env,
+ [0, 0, 0.0556, 1, 4.0937, 0.6, 9.1414, 0.3, 24.2845, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0250, 5.4, 87.3075, 0.2500, :fm_index, 2.1524,
+ :reverb_amount, 0.0260,
+ :amp_env,
+ [0, 0, 0.0556, 1, 4.0937, 0.6, 9.1414, 0.3, 24.2845, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 4.5, 261.6200, 0.15, :fm_index, 2.1384,
+ :reverb_amount, 0.0242,
+ :amp_env,
+ [0, 0, 0.0667, 1, 4.1044, 0.6, 9.1515, 0.3, 24.2929, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0300, 4.5, 174.6150, 0.15, :fm_index, 2.1425,
+ :reverb_amount, 0.0265,
+ :amp_env,
+ [0, 0, 0.0667, 1, 4.1044, 0.6, 9.1515, 0.3, 24.2929, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0300, 4.5, 130.8100, 0.15, :fm_index, 1.9805,
+ :reverb_amount, 0.0201,
+ :amp_env,
+ [0, 0, 0.0667, 1, 4.1044, 0.6, 9.1515, 0.3, 24.2929, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0350, 4.5, 43.6538, 0.15, :fm_index, 2.4876,
+ :reverb_amount, 0.0329,
+ :amp_env,
+ [0, 0, 0.0667, 1, 4.1044, 0.6, 9.1515, 0.3, 24.2929, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0400, 3.6, 220, 0.15, :fm_index, 1.8282,
+ :reverb_amount, 0.0244, :noise_amount, 0.15,
+ :amp_env,
+ [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0400, 3.6, 174.6150, 0.15, :fm_index, 2.3479,
+ :reverb_amount, 0.0200, :noise_amount, 0.15,
+ :amp_env,
+ [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0400, 3.6, 523.2400, 0.15, :fm_index, 1.6424,
+ :reverb_amount, 0.0286, :noise_amount, 0.15,
+ :amp_env,
+ [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0450, 3.6, 349.2300, 0.15, :fm_index, 1.6449,
+ :reverb_amount, 0.0333, :noise_amount, 0.15,
+ :amp_env,
+ [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0])
+
+ vln_one_sin_ran($t + 0.0500, 6, 699.4600, 0.15,
+ :fm_index, 1.5570, :reverb_amount, 0.1300, :amp_env, tap)
vln_one_sin_ran($t + 0.0500, 6, 1397.9200, 0.15,
- :fm_index, 1.5131, :reverb_amount, 0.1300, :amp_env, tap)
+ :fm_index, 1.5131, :reverb_amount, 0.1300, :amp_env, tap)
vln_one_sin_ran($t + 0.0500, 6, 783.9800, 0.15,
- :fm_index, 2.2031, :reverb_amount, 0.1300, :amp_env, tap)
+ :fm_index, 2.2031, :reverb_amount, 0.1300, :amp_env, tap)
vln_one_sin_ran($t + 0.0500, 6, 1046.4800, 0.15,
- :fm_index, 2.2724, :reverb_amount, 0.1300, :amp_env, tap)
+ :fm_index, 2.2724, :reverb_amount, 0.1300, :amp_env, tap)
vln_one_sin_ran($t + 0.0600, 9, 21.8269, 0.15,
- :fm_index, 2.1048, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.1048, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0600, 8, 87.3075, 0.15,
- :fm_index, 1.8854, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 1.8854, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0600, 7, 65.4050, 0.15,
- :fm_index, 1.6781, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 1.6781, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0600, 8, 43.6538, 0.15,
- :fm_index, 1.7862, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 1.7862, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0700, 6, 175.6150, 0.15,
- :fm_index, 2.2656, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.2656, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0700, 6, 350.2300, 0.15,
- :fm_index, 2.4241, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.4241, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0700, 6, 131.8100, 0.15,
- :fm_index, 2.4294, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.4294, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0700, 6, 32.7025, 0.15,
- :fm_index, 1.5779, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 1.5779, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0800, 6, 196.9950, 0.15,
- :fm_index, 1.8511, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 1.8511, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0800, 6, 1047.4800, 0.15,
- :fm_index, 2.2148, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.2148, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0800, 6, 831.6200, 0.15,
- :fm_index, 1.9913, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 1.9913, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.0800, 6, 2793.8400, 0.15,
- :fm_index, 2.2607, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.2607, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.2700, 6, 784.9800, 0.16,
- :fm_index, 2.0693, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.0693, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.2700, 6, 64.4050, 0.16,
- :fm_index, 1.6920, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 1.6920, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.2700, 6, 208.6550, 0.16,
- :fm_index, 2.2597, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.2597, :reverb_amount, 0.1, :amp_env, tap)
vln_one_sin_ran($t + 0.2700, 6, 43.6538, 0.16,
- :fm_index, 2.2522, :reverb_amount, 0.1, :amp_env, tap)
+ :fm_index, 2.2522, :reverb_amount, 0.1, :amp_env, tap)
$t += 12.0
restore_fm_violin_defaults()
- vln_one_sin_ran($t + 0, 1.8, 349.2300, 0.16, :fm_index, 2.1541, :reverb_amount, 0.0225,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0500)
- vln_one_sin_ran($t + 0.0100, 2.7000, 146.8300, 0.16, :fm_index, 2.3335,
- :reverb_amount, 0.0274,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0500)
- vln_one_sin_ran($t + 0.0200, 1.8, 880, 0.16, :fm_index, 2.1910, :reverb_amount, 0.0279,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0500)
- vln_one_sin_ran($t + 0.0250, 3.6, 73.4150, 0.16, :fm_index, 2.1410, :reverb_amount, 0.0223,
- :amp_env, [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0],
- :noise_amount, 0.0500)
- vln_one_sin_ran($t + 0.0300, 2.7000, 87.3075, 0.16, :fm_index, 1.8491, :reverb_amount, 0.0217,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0300, 2.7000, 75.5662, 0.16, :fm_index, 1.9191, :reverb_amount, 0.0204,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0400, 3.6, 52.3432, 0.16, :fm_index, 1.6090, :reverb_amount, 0.0296,
- :amp_env, [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0],
- :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0450, 1.8, 73.4150, 0.16, :fm_index, 2.2201, :reverb_amount, 0.0221,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0500, 4, 116.5400, 0.0600, :fm_index, 2.0230, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0500, 4, 97.9975, 0.0600, :fm_index, 1.7284, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0600, 4, 36.7075, 0.0600, :fm_index, 1.6845, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0650, 4, 97.9975, 0.0600, :fm_index, 2.4616, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0010)
+ vln_one_sin_ran($t + 0, 1.8, 349.2300, 0.16, :fm_index, 2.1541,
+ :reverb_amount, 0.0225, :noise_amount, 0.0500,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0100, 2.7000, 146.8300, 0.16, :fm_index, 2.3335,
+ :reverb_amount, 0.0274, :noise_amount, 0.0500,
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0200, 1.8, 880, 0.16, :fm_index, 2.1910,
+ :reverb_amount, 0.0279, :noise_amount, 0.0500,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0250, 3.6, 73.4150, 0.16, :fm_index, 2.1410,
+ :reverb_amount, 0.0223, :noise_amount, 0.0500,
+ :amp_env,
+ [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 2.7000, 87.3075, 0.16, :fm_index, 1.8491,
+ :reverb_amount, 0.0217, :noise_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 2.7000, 75.5662, 0.16, :fm_index, 1.9191,
+ :reverb_amount, 0.0204, :noise_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0400, 3.6, 52.3432, 0.16, :fm_index, 1.6090,
+ :reverb_amount, 0.0296, :noise_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0450, 1.8, 73.4150, 0.16, :fm_index, 2.2201,
+ :reverb_amount, 0.0221, :noise_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0500, 4, 116.5400, 0.0600, :fm_index, 2.0230,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0010)
+ vln_one_sin_ran($t + 0.0500, 4, 97.9975, 0.0600, :fm_index, 1.7284,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0010)
+ vln_one_sin_ran($t + 0.0600, 4, 36.7075, 0.0600, :fm_index, 1.6845,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0010)
+ vln_one_sin_ran($t + 0.0650, 4, 97.9975, 0.0600, :fm_index, 2.4616,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0010)
$t += 7.0
- vln_one_sin_ran($t + 0, 1.8, 261.6200, 0.16, :fm_index, 2.2576, :reverb_amount, 0.0286,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0100)
+ vln_one_sin_ran($t + 0, 1.8, 261.6200, 0.16, :fm_index, 2.2576,
+ :reverb_amount, 0.0286, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
vln_one_sin_ran($t + 0.0100, 2.7000, 130.8100, 0.16, :fm_index, 2.1530,
- :reverb_amount, 0.0330,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
+ :reverb_amount, 0.0330, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.0200, 1.8, 523.2400, 0.16, :fm_index, 2.0608,
- :reverb_amount, 0.0235,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0250, 3.6, 65.4050, 0.16, :fm_index, 2.2203, :reverb_amount, 0.0234,
- :amp_env, [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 2.7000, 65.4050, 0.16, :fm_index, 1.7089, :reverb_amount, 0.0208,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0010)
+ :reverb_amount, 0.0235, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0250, 3.6, 65.4050, 0.16, :fm_index, 2.2203,
+ :reverb_amount, 0.0234, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 2.7000, 65.4050, 0.16, :fm_index, 1.7089,
+ :reverb_amount, 0.0208, :noise_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.0300, 2.7000, 130.8100, 0.16, :fm_index, 2.2948,
- :reverb_amount, 0.0269,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0400, 3.6, 32.7025, 0.16, :fm_index, 1.7677, :reverb_amount, 0.0288,
- :amp_env, [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0],
- :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0450, 1.8, 32.7025, 0.16, :fm_index, 1.9030, :reverb_amount, 0.0209,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0500, 4, 65.4050, 0.0600, :fm_index, 2.2757, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0500, 4, 65.4050, 0.0600, :fm_index, 2.2435, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0600, 4, 32.7025, 0.0600, :fm_index, 1.9619, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0010)
- vln_one_sin_ran($t + 0.0650, 4, 65.4050, 0.0600, :fm_index, 2.0207, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0010)
+ :reverb_amount, 0.0269, :noise_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0400, 3.6, 32.7025, 0.16, :fm_index, 1.7677,
+ :reverb_amount, 0.0288, :noise_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.0833, 1, 4.1204, 0.6, 9.1667, 0.3, 24.3056, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0450, 1.8, 32.7025, 0.16, :fm_index, 1.9030,
+ :reverb_amount, 0.0209, :noise_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0500, 4, 65.4050, 0.0600, :fm_index, 2.2757,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0010)
+ vln_one_sin_ran($t + 0.0500, 4, 65.4050, 0.0600, :fm_index, 2.2435,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0010)
+ vln_one_sin_ran($t + 0.0600, 4, 32.7025, 0.0600, :fm_index, 1.9619,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0010)
+ vln_one_sin_ran($t + 0.0650, 4, 65.4050, 0.0600, :fm_index, 2.0207,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0010)
$t += 6.0
- vln_one_sin_ran($t + 0.0100, 0.9, 3135.9200, 0.16, :fm_index, 2.1204, :reverb_amount, 0.0024,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0100, 0.4500, 1567.96, 0.16, :fm_index, 2.0691, :reverb_amount, 0.0025,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0200, 0.9, 6271.8400, 0.16, :fm_index, 2.2081, :reverb_amount, 0.0022,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0250, 0.9, 783.9800, 0.16, :fm_index, 1.8719, :reverb_amount, 0.0022,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 0.2700, 783.9800, 0.16, :fm_index, 1.9705, :reverb_amount, 0.0020,
- :amp_env, [0, 0, 1.1111, 1, 5.1066, 0.6, 10.1010, 0.3, 25.0842, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 0.6300, 1567.96, 0.16, :fm_index, 1.6778, :reverb_amount, 0.0021,
- :amp_env, [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0400, 0.9, 391.9900, 0.16, :fm_index, 1.9558, :reverb_amount, 0.0023,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0450, 0.4500, 195.9950, 0.16, :fm_index, 2.1344, :reverb_amount, 0.0027,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0],
- :noise_amount, 0.0100)
+ vln_one_sin_ran($t + 0.0100, 0.9, 3135.9200, 0.16, :fm_index, 2.1204,
+ :reverb_amount, 0.0024, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0100, 0.4500, 1567.96, 0.16, :fm_index, 2.0691,
+ :reverb_amount, 0.0025, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0200, 0.9, 6271.8400, 0.16, :fm_index, 2.2081,
+ :reverb_amount, 0.0022, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0250, 0.9, 783.9800, 0.16, :fm_index, 1.8719,
+ :reverb_amount, 0.0022, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 0.2700, 783.9800, 0.16, :fm_index, 1.9705,
+ :reverb_amount, 0.0020, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 1.1111, 1, 5.1066, 0.6, 10.1010, 0.3, 25.0842, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 0.6300, 1567.96, 0.16, :fm_index, 1.6778,
+ :reverb_amount, 0.0021, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0400, 0.9, 391.9900, 0.16, :fm_index, 1.9558,
+ :reverb_amount, 0.0023, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0450, 0.4500, 195.9950, 0.16, :fm_index, 2.1344,
+ :reverb_amount, 0.0027, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin_ran($t + 0.0500, 2, 783.9800, 0.16,
- :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0090)
+ :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.0500, 1, 1567.9600, 0.16,
- :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0090)
+ :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.0600, 2, 391.9900, 0.16,
- :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0090)
+ :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.0650, 1, 783.9800, 0.16,
- :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0090)
+ :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.0700, 2, 195.9950, 0.16,
- :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0700, 1, 1567.9600, 0.16,
- :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0800, 1, 784.9800, 0.16,
- :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0850, 2, 391.9900, 0.16,
- :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.0100, :amp_env, tap, :noise_amount, 0.0040)
$t += 6.0
- vln_one_sin_ran($t + 0.0100, 0.9, 97.9975, 0.1, :fm_index, 2.0885, :reverb_amount, 0.0031,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0100, 1.8, 48.9988, 0.1, :fm_index, 2.2269, :reverb_amount, 0.0026,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0200, 0.9, 195.9950, 0.1, :fm_index, 2.0305, :reverb_amount, 0.0032,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0250, 0.9, 24.4994, 0.1, :fm_index, 2.4934, :reverb_amount, 0.0025,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 1.8, 97.9975, 0.1, :fm_index, 2.4039, :reverb_amount, 0.0023,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0400)
- vln_one_sin_ran($t + 0.0300, 0.9, 195.9950, 0.1, :fm_index, 1.5159, :reverb_amount, 0.0021,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0400)
- vln_one_sin_ran($t + 0.0300, 0.9, 392.9900, 0.1, :fm_index, 2.2122, :reverb_amount, 0.0028,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0400)
- vln_one_sin_ran($t + 0.0300, 1.8, 784.9800, 0.1, :fm_index, 2.1574, :reverb_amount, 0.0020,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0400)
- vln_one_sin_ran($t + 0.0300, 2.7000, 24.4994, 0.1, :fm_index, 2.1963, :reverb_amount, 0.0031,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 1.8, 48.9988, 0.1, :fm_index, 1.9761, :reverb_amount, 0.0032,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0400, 2.7000, 12.2497, 0.1, :fm_index, 1.5088, :reverb_amount, 0.0021,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0450, 1.8, 6.1248, 0.1, :fm_index, 1.7384, :reverb_amount, 0.0021,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0100)
+ vln_one_sin_ran($t + 0.0100, 0.9, 97.9975, 0.1, :fm_index, 2.0885,
+ :reverb_amount, 0.0031, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0100, 1.8, 48.9988, 0.1, :fm_index, 2.2269,
+ :reverb_amount, 0.0026, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0200, 0.9, 195.9950, 0.1, :fm_index, 2.0305,
+ :reverb_amount, 0.0032, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0250, 0.9, 24.4994, 0.1, :fm_index, 2.4934,
+ :reverb_amount, 0.0025, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 1.8, 97.9975, 0.1, :fm_index, 2.4039,
+ :reverb_amount, 0.0023, :noise_amount, 0.0400,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0300, 0.9, 195.9950, 0.1, :fm_index, 1.5159,
+ :reverb_amount, 0.0021, :noise_amount, 0.0400,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 0.9, 392.9900, 0.1, :fm_index, 2.2122,
+ :reverb_amount, 0.0028, :noise_amount, 0.0400,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 1.8, 784.9800, 0.1, :fm_index, 2.1574,
+ :reverb_amount, 0.0020, :noise_amount, 0.0400,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0300, 2.7000, 24.4994, 0.1, :fm_index, 2.1963,
+ :reverb_amount, 0.0031, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 1.8, 48.9988, 0.1, :fm_index, 1.9761,
+ :reverb_amount, 0.0032, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0400, 2.7000, 12.2497, 0.1, :fm_index, 1.5088,
+ :reverb_amount, 0.0021, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0450, 1.8, 6.1248, 0.1, :fm_index, 1.7384,
+ :reverb_amount, 0.0021, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0])
vln_one_sin_ran($t + 0.0500, 2, 24.4994, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0500, 1, 48.9988, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0600, 2, 12.2497, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0650, 1, 24.4994, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
- vln_one_sin_ran($t + 0.0700, 2, 6.1248, 0.1, :fm_index, 1.2474, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0040)
- vln_one_sin_ran($t + 0.0700, 1, 48.9988, 0.1, :fm_index, 0.7526, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0040)
- vln_one_sin_ran($t + 0.0800, 1, 25.4994, 0.1, :fm_index, 1.1080, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0040)
- vln_one_sin_ran($t + 0.0850, 2, 12.2497, 0.1, :fm_index, 1.0859, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0040)
- vln_one_sin_ran($t + 0.0900, 4, 97.9975, 0.1, :fm_index, 2.4788, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0040)
- vln_one_sin_ran($t + 0.0900, 3, 48.9988, 0.1, :fm_index, 1.8980, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0040)
- vln_one_sin_ran($t + 0.0900, 3, 25.4994, 0.1, :fm_index, 2.1151, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0040)
- vln_one_sin_ran($t + 0.0950, 5, 12.2497, 0.1, :fm_index, 2.3224, :reverb_amount, 0.1,
- :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ vln_one_sin_ran($t + 0.0700, 2, 6.1248, 0.1, :fm_index, 1.2474,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ vln_one_sin_ran($t + 0.0800, 1, 25.4994, 0.1, :fm_index, 1.1080,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ vln_one_sin_ran($t + 0.0850, 2, 12.2497, 0.1, :fm_index, 1.0859,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ vln_one_sin_ran($t + 0.0900, 4, 97.9975, 0.1, :fm_index, 2.4788,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ vln_one_sin_ran($t + 0.0900, 3, 48.9988, 0.1, :fm_index, 1.8980,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ vln_one_sin_ran($t + 0.0900, 3, 25.4994, 0.1, :fm_index, 2.1151,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ vln_one_sin_ran($t + 0.0950, 5, 12.2497, 0.1, :fm_index, 2.3224,
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
$t += 6.0
vln_one_sin_ran($t + 0.2100, 0.9, 123.4725, 0.1, :reverb_amount, 0.0031,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
+ :noise_amount, 0.0100)
vln_one_sin_ran($t + 0.2100, 1.8, 61.7363, 0.1, :reverb_amount, 0.0023,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0100)
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
+ :noise_amount, 0.0100)
vln_one_sin_ran($t + 0.2200, 0.9, 246.9450, 0.1, :reverb_amount, 0.0023,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
+ :noise_amount, 0.0100)
vln_one_sin_ran($t + 0.2250, 0.9, 30.8681, 0.1, :reverb_amount, 0.0026,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
+ :noise_amount, 0.0100)
vln_one_sin_ran($t + 0.2300, 1.8, 123.4725, 0.1, :reverb_amount, 0.0027,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0400)
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
+ :noise_amount, 0.0400)
vln_one_sin_ran($t + 0.2300, 0.9, 246.9450, 0.1, :reverb_amount, 0.0026,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0400)
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
+ :noise_amount, 0.0400)
vln_one_sin_ran($t + 0.2300, 0.9, 494.8900, 0.1, :reverb_amount, 0.0020,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0400)
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
+ :noise_amount, 0.0400)
vln_one_sin_ran($t + 0.2300, 1.8, 988.7800, 0.1, :reverb_amount, 0.0025,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0400)
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
+ :noise_amount, 0.0400)
vln_one_sin_ran($t + 0.2300, 2.7000, 30.8681, 0.1, :reverb_amount, 0.0028,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
+ :noise_amount, 0.0100)
vln_one_sin_ran($t + 0.2300, 1.8, 61.7363, 0.1, :reverb_amount, 0.0023,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0100)
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
+ :noise_amount, 0.0100)
vln_one_sin_ran($t + 0.2400, 2.7000, 15.4341, 0.1, :reverb_amount, 0.0030,
- :amp_env, [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
+ :amp_env,
+ [0, 0, 0.1111, 1, 4.1470, 0.6, 9.1919, 0.3, 24.3266, 0.1, 100.0, 0],
+ :noise_amount, 0.0100)
vln_one_sin_ran($t + 0.2450, 1.8, 20.5788, 0.1, :reverb_amount, 0.0023,
- :amp_env, [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
- :noise_amount, 0.0100)
+ :amp_env,
+ [0, 0, 0.1667, 1, 4.2003, 0.6, 9.2424, 0.3, 24.3687, 0.1, 100, 0],
+ :noise_amount, 0.0100)
vln_one_sin_ran($t + 0.2500, 2, 30.8681, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0090)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.2500, 1, 61.7363, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0090)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.2600, 2, 15.4341, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0090)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.2650, 1, 30.8681, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0090)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.2710, 2, 30.8681, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.2710, 1, 61.7363, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.2810, 1, 31.8681, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.2860, 2, 15.4341, 0.1,
- :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
+ :reverb_amount, 0.1, :amp_env, tap, :noise_amount, 0.0040)
$t += 8.0
yup = [0, 0, 1, 1, 100, 0]
- vln_one_sin_ran($t + 0.0100, 0.9, 3135.9200, 0.16, :fm_index, 1.7299, :reverb_amount, 0.0026,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0100, 0.45, 1464.6987, 0.16, :fm_index, 1.9173, :reverb_amount, 0.0027,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0200, 0.9, 6714.0048, 0.16, :fm_index, 2.4604, :reverb_amount, 0.0032,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0250, 0.9, 684.1190, 0.16, :fm_index, 1.9969, :reverb_amount, 0.0021,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 0.2700, 684.1190, 0.16, :fm_index, 2.0022, :reverb_amount, 0.0026,
- :amp_env, [0, 0, 1.1111, 1, 5.1066, 0.6, 10.1010, 0.3, 25.0842, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 0.63, 1464.6987, 0.16, :fm_index, 2.1058, :reverb_amount, 0.0027,
- :amp_env, [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0400, 0.9, 319.5325, 0.16, :fm_index, 2.2293, :reverb_amount, 0.0029,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0450, 0.4500, 149.2445, 0.16, :fm_index, 1.5780, :reverb_amount, 0.0025,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0],
- :noise_amount, 0.0100)
+ vln_one_sin_ran($t + 0.0100, 0.9, 3135.9200, 0.16, :fm_index, 1.7299,
+ :reverb_amount, 0.0026, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0100, 0.45, 1464.6987, 0.16, :fm_index, 1.9173,
+ :reverb_amount, 0.0027, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0200, 0.9, 6714.0048, 0.16, :fm_index, 2.4604,
+ :reverb_amount, 0.0032, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0250, 0.9, 684.1190, 0.16, :fm_index, 1.9969,
+ :reverb_amount, 0.0021, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 0.2700, 684.1190, 0.16, :fm_index, 2.0022,
+ :reverb_amount, 0.0026, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 1.1111, 1, 5.1066, 0.6, 10.1010, 0.3, 25.0842, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 0.63, 1464.6987, 0.16, :fm_index, 2.1058,
+ :reverb_amount, 0.0027, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0400, 0.9, 319.5325, 0.16, :fm_index, 2.2293,
+ :reverb_amount, 0.0029, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0450, 0.4500, 149.2445, 0.16, :fm_index, 1.5780,
+ :reverb_amount, 0.0025, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin_ran($t + 0.0500, 1, 684.1190, 0.16,
- :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0090)
+ :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.0500, 1, 1464.6987, 0.16,
- :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0090)
+ :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.0600, 1, 319.5325, 0.16,
- :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0090)
+ :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.0650, 1, 684.1190, 0.16,
- :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0090)
+ :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0090)
vln_one_sin_ran($t + 0.0700, 1, 149.2445, 0.16,
- :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0040)
+ :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0700, 1, 1464.6987, 0.16,
- :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0040)
+ :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0800, 1, 561.6022, 0.16,
- :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0040)
+ :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.0850, 1, 319.5325, 0.16,
- :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0040)
+ :reverb_amount, 0.0100, :amp_env, yup, :noise_amount, 0.0040)
$t += 3.0
- vln_one_sin_ran($t + 0.0100, 0.9, 3135.9200, 0.16, :fm_index, 1.6329, :reverb_amount, 0.0031,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0100, 0.45, 1810.5774, 0.16, :fm_index, 1.8298, :reverb_amount, 0.0031,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0200, 0.9, 5431.4135, 0.16, :fm_index, 2.1640, :reverb_amount, 0.0022,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0250, 0.9, 1045.3680, 0.16, :fm_index, 1.6971, :reverb_amount, 0.0032,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 0.27, 1045.3680, 0.16, :fm_index, 2.4855, :reverb_amount, 0.0028,
- :amp_env, [0, 0, 1.1111, 1, 5.1066, 0.6, 10.1010, 0.3, 25.0842, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0300, 0.63, 1810.5774, 0.16, :fm_index, 2.1604, :reverb_amount, 0.0020,
- :amp_env, [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0400, 0.9, 603.5612, 0.16, :fm_index, 2.4204, :reverb_amount, 0.0031,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0450, 0.4500, 348.4765, 0.16, :fm_index, 2.3918, :reverb_amount, 0.0026,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0460, 0.9, 201.1989, 0.16, :fm_index, 1.5205, :reverb_amount, 0.0024,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0460, 0.9, 116.1656, 0.16, :fm_index, 2.3049, :reverb_amount, 0.0028,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0500, 0.9, 3135.9200, 0.16, :fm_index, 2.4363, :reverb_amount, 0.0021,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0500, 0.45, 1464.6987, 0.16, :fm_index, 2.3865, :reverb_amount, 0.0027,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0600, 0.9, 6714.0048, 0.16, :fm_index, 1.7354, :reverb_amount, 0.0021,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0650, 0.9, 684.1190, 0.16, :fm_index, 1.8282, :reverb_amount, 0.0025,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0700, 0.2700, 684.1190, 0.16, :fm_index, 2.3923, :reverb_amount, 0.0025,
- :amp_env, [0, 0, 1.1111, 1, 5.1066, 0.6, 10.1010, 0.3, 25.0842, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0700, 0.63, 1464.6987, 0.16, :fm_index, 2.2789, :reverb_amount, 0.0028,
- :amp_env, [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0800, 0.9, 319.5325, 0.16, :fm_index, 1.5438, :reverb_amount, 0.0027,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0850, 0.4500, 149.2445, 0.16, :fm_index, 2.4210, :reverb_amount, 0.0028,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0860, 0.9, 69.7078, 0.16, :fm_index, 2.0288, :reverb_amount, 0.0029,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
- vln_one_sin_ran($t + 0.0860, 0.9, 32.5585, 0.16, :fm_index, 1.8254, :reverb_amount, 0.0028,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0],
- :noise_amount, 0.0100)
+ vln_one_sin_ran($t + 0.0100, 0.9, 3135.9200, 0.16, :fm_index, 1.6329,
+ :reverb_amount, 0.0031, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0100, 0.45, 1810.5774, 0.16, :fm_index, 1.8298,
+ :reverb_amount, 0.0031, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0200, 0.9, 5431.4135, 0.16, :fm_index, 2.1640,
+ :reverb_amount, 0.0022, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0250, 0.9, 1045.3680, 0.16, :fm_index, 1.6971,
+ :reverb_amount, 0.0032, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 0.27, 1045.3680, 0.16, :fm_index, 2.4855,
+ :reverb_amount, 0.0028, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 1.1111, 1, 5.1066, 0.6, 10.1010, 0.3, 25.0842, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0300, 0.63, 1810.5774, 0.16, :fm_index, 2.1604,
+ :reverb_amount, 0.0020, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0400, 0.9, 603.5612, 0.16, :fm_index, 2.4204,
+ :reverb_amount, 0.0031, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0450, 0.4500, 348.4765, 0.16, :fm_index, 2.3918,
+ :reverb_amount, 0.0026, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0460, 0.9, 201.1989, 0.16, :fm_index, 1.5205,
+ :reverb_amount, 0.0024, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0460, 0.9, 116.1656, 0.16, :fm_index, 2.3049,
+ :reverb_amount, 0.0028, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0500, 0.9, 3135.9200, 0.16, :fm_index, 2.4363,
+ :reverb_amount, 0.0021, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0500, 0.45, 1464.6987, 0.16, :fm_index, 2.3865,
+ :reverb_amount, 0.0027, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0600, 0.9, 6714.0048, 0.16, :fm_index, 1.7354,
+ :reverb_amount, 0.0021, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0650, 0.9, 684.1190, 0.16, :fm_index, 1.8282,
+ :reverb_amount, 0.0025, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0700, 0.2700, 684.1190, 0.16, :fm_index, 2.3923,
+ :reverb_amount, 0.0025, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 1.1111, 1, 5.1066, 0.6, 10.1010, 0.3, 25.0842, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0700, 0.63, 1464.6987, 0.16, :fm_index, 2.2789,
+ :reverb_amount, 0.0028, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0800, 0.9, 319.5325, 0.16, :fm_index, 1.5438,
+ :reverb_amount, 0.0027, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0850, 0.4500, 149.2445, 0.16, :fm_index, 2.4210,
+ :reverb_amount, 0.0028, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ vln_one_sin_ran($t + 0.0860, 0.9, 69.7078, 0.16, :fm_index, 2.0288,
+ :reverb_amount, 0.0029, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ vln_one_sin_ran($t + 0.0860, 0.9, 32.5585, 0.16, :fm_index, 1.8254,
+ :reverb_amount, 0.0028, :noise_amount, 0.0100,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
$t += 3.0
$reverb_amount = 0.0
$noise_amount = 0.01
vln_one_sin_ran($t + 0.0500, 0.9, 3135.9200, 0.16, :fm_index, 1.7334,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.0500, 0.4500, 1810.5774, 0.16, :fm_index, 2.3629,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin_ran($t + 0.0600, 0.9, 5431.4135, 0.16, :fm_index, 2.2744,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.0650, 0.9, 1045.3680, 0.16, :fm_index, 1.8722,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.1100, 0.2700, 1045.3680, 0.16, :fm_index, 2.3139,
- :amp_env, [0, 0, 1.1111, 1, 5.1066, 0.6, 10.101, 0.3, 25.0842, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 1.1111, 1, 5.1066, 0.6, 10.101, 0.3, 25.0842, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.1100, 0.6300, 1810.5774, 0.16, :fm_index, 1.6216,
- :amp_env, [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.1200, 0.9, 603.5612, 0.16, :fm_index, 1.5308,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.1650, 0.4500, 348.4765, 0.16, :fm_index, 2.0346,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin_ran($t + 0.1660, 0.9, 201.1989, 0.16, :fm_index, 1.8176,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.1660, 0.9, 116.1656, 0.16, :fm_index, 1.7145,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.1700, 0.9, 3135.9200, 0.16, :fm_index, 2.4459,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.1700, 0.4500, 1464.6987, 0.16, :fm_index, 2.4644,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin_ran($t + 0.1800, 0.9, 6714.0048, 0.16, :fm_index, 1.9985,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.1850, 0.9, 684.1190, 0.16, :fm_index, 2.4542,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.2900, 0.2700, 684.1190, 0.16, :fm_index, 2.3391,
- :amp_env, [0, 0, 1.1111, 1, 5.1066, 0.6, 10.101, 0.3, 25.0842, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 1.1111, 1, 5.1066, 0.6, 10.101, 0.3, 25.0842, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.2900, 0.6300, 1464.6987, 0.16, :fm_index, 1.5138,
- :amp_env, [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.4762, 1, 4.4974, 0.6, 9.5238, 0.3, 24.6032, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.3, 0.9, 319.5325, 0.16, :fm_index, 1.5440,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.3050, 0.4500, 149.2445, 0.16, :fm_index, 2.2283,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin_ran($t + 0.3060, 0.9, 69.7078, 0.16, :fm_index, 1.9498,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
vln_one_sin_ran($t + 0.3060, 0.9, 32.5585, 0.16, :fm_index, 2.2943,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100.0, 0])
$t += 3.0
restore_fm_violin_defaults()
@@ -1140,32 +1262,32 @@ def long_example
$t += 4.0
restore_fm_violin_defaults()
vln_one_sin($t + 0.1200, 0.4, 2092.9600, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.1200, 0.5000, 2088.7820, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.1200, 0.3, 2097.1460, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.1200, 0.5000, 2084.6130, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.1210, 0.3, 1048.5730, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.1220, 0.3, 1040.2260, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.1220, 0.5000, 1034.0100, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.1230, 0.5000, 1046.4800, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.1240, 0.3, 1044.3900, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
z1amp = [0, 0, 20, 0.5000, 40, 0.1, 60, 0.2, 80, 1, 100, 0]
z2amp = [0, 0, 20, 1, 60, 0.1, 75, 0.3, 100, 0]
@@ -1173,107 +1295,107 @@ def long_example
$fm2_rat = 4.414
$fm3_rat = 5.141
vln_one_sin($t + 0.1240, 0.5000, 1041.2630, 0.16,
- :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
- :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
+ :fm_index, 3, :reverb_amount, 0, :amp_env, metalamp,
+ :fm2_rat, 1.1410, :fm3_rat, 3.1410, :fm1_rat, 2.7180)
$t += 2.0
- vln_one_sin_ran($t + 0.4880, 1.1770, 416.6072, 0.0110,
- :fm_index, 1.1140, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 0.5050, 2.4900, 859.5863, 0.0083,
- :fm_index, 0.5890, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 1.0590, 1.0550, 1758.0816, 0.0053,
- :fm_index, 1.8640, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 1.0930, 1.8580, 229.0566, 0.0110,
- :fm_index, 1.9690, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 1.3490, 3.3680, 479.1994, 0.0083,
- :fm_index, 1.9970, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 1.5010, 3.0680, 411.8241, 0.0110,
- :fm_index, 1.5390, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 1.5200, 2.8290, 984.8456, 0.0053,
- :fm_index, 0.0560, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 1.6100, 0.7040, 1767.7444, 0.0053,
- :fm_index, 1.2620, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 1.8480, 3.0510, 859.7203, 0.0083,
- :fm_index, 1.6080, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 2.4880, 3.2350, 231.9431, 0.0110,
- :fm_index, 0.9690, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 2.5610, 3.2810, 475.2009, 0.0083,
- :fm_index, 0.3740, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 2.7970, 2.8400, 988.8375, 0.0053,
- :fm_index, 0.4200, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 3.0620, 1.0210, 411.7247, 0.0110,
- :fm_index, 0.1370, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 3.2130, 1.1610, 848.5959, 0.0083,
- :fm_index, 1.3120, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 3.4410, 2.6160, 390.0600, 0.0110,
- :fm_index, 1.9030, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 3.4490, 0.7000, 802.3538, 0.0083,
- :fm_index, 1.5940, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 3.5270, 2.5080, 1773.9366, 0.0053,
- :fm_index, 1.8030, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 3.7820, 2.7990, 232.4344, 0.0110,
- :fm_index, 0.0590, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 3.7830, 2.7660, 1650.1434, 0.0053,
- :fm_index, 0.4400, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 3.7890, 3.1560, 475.7231, 0.0083,
- :fm_index, 0.7370, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 4.1540, 2.1290, 976.0237, 0.0053,
- :fm_index, 1.2690, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 4.4890, 3.3650, 390.0525, 0.0110,
- :fm_index, 1.4580, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 4.7450, 1.5070, 1665.9722, 0.0053,
- :fm_index, 1.9330, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 4.8320, 1.4430, 798.1238, 0.0083,
- :fm_index, 0.8560, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 4.9440, 3.1560, 229.0528, 0.0110,
- :fm_index, 1.8300, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 5.3930, 1.1100, 473.7225, 0.0083,
- :fm_index, 1.6260, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 5.6970, 1.6170, 988.7953, 0.0053,
- :fm_index, 0.4230, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.0620, 1.3190, 390.9769, 0.0110,
- :fm_index, 0.4100, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.0840, 3.3660, 804.6413, 0.0083,
- :fm_index, 1.8760, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.1740, 2.7210, 418.6819, 0.0110,
- :fm_index, 0.0910, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.5700, 3.4460, 845.4019, 0.0077,
- :fm_index, 0.7660, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.6440, 1.1790, 1656.5756, 0.0049,
- :fm_index, 0.2960, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.6600, 2.8520, 1758.9788, 0.0049,
- :fm_index, 0.4520, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.8270, 1.8840, 387.0009, 0.0099,
- :fm_index, 1.3010, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.8870, 3.4040, 796.7213, 0.0077,
- :fm_index, 1.1820, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 6.9640, 3.3230, 416.3916, 0.0099,
- :fm_index, 0.6290, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 7.1320, 1.7050, 1637.2303, 0.0049,
- :fm_index, 1.0570, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 7.15, 3.1250, 1762.4906, 0.0049,
- :fm_index, 1.3170, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 7.3860, 2.9670, 852.0487, 0.0077,
- :fm_index, 1.4790, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 7.6670, 0.6780, 413.7094, 0.0099,
- :fm_index, 0.9470, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 7.8780, 2.7490, 1749.7509, 0.0049,
- :fm_index, 0.5040, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 7.9730, 0.5990, 848.1253, 0.0077,
- :fm_index, 1.9380, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 8.0880, 3.3360, 229.9144, 0.0099,
- :fm_index, 1.3930, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 8.1170, 1.1300, 984.0816, 0.0049,
- :fm_index, 0.3560, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 8.4640, 1.7330, 478.7184, 0.0077,
- :fm_index, 0.2840, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 8.5760, 0.5680, 413.4253, 0.0099,
- :fm_index, 1.5020, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 8.8200, 1.2150, 230.9588, 0.0099,
- :fm_index, 1.0990, :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 8.8320, 3.4590, 473.8903, 0.0077,
- :fm_index, 0.7680, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
- vln_one_sin_ran($t + 8.8320, 0.7260, 857.2875, 0.0077,
- :fm_index, 0.7520, :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 0.4880, 1.1770, 416.6072, 0.0110, :fm_index, 1.1140,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 0.5050, 2.4900, 859.5863, 0.0083, :fm_index, 0.5890,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 1.0590, 1.0550, 1758.0816, 0.0053, :fm_index, 1.8640,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 1.0930, 1.8580, 229.0566, 0.0110, :fm_index, 1.9690,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 1.3490, 3.3680, 479.1994, 0.0083, :fm_index, 1.9970,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 1.5010, 3.0680, 411.8241, 0.0110, :fm_index, 1.5390,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 1.5200, 2.8290, 984.8456, 0.0053, :fm_index, 0.0560,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 1.6100, 0.7040, 1767.7444, 0.0053, :fm_index, 1.2620,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 1.8480, 3.0510, 859.7203, 0.0083, :fm_index, 1.6080,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 2.4880, 3.2350, 231.9431, 0.0110, :fm_index, 0.9690,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 2.5610, 3.2810, 475.2009, 0.0083, :fm_index, 0.3740,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 2.7970, 2.8400, 988.8375, 0.0053, :fm_index, 0.4200,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 3.0620, 1.0210, 411.7247, 0.0110, :fm_index, 0.1370,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 3.2130, 1.1610, 848.5959, 0.0083, :fm_index, 1.3120,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 3.4410, 2.6160, 390.0600, 0.0110, :fm_index, 1.9030,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 3.4490, 0.7000, 802.3538, 0.0083, :fm_index, 1.5940,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 3.5270, 2.5080, 1773.9366, 0.0053, :fm_index, 1.8030,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 3.7820, 2.7990, 232.4344, 0.0110, :fm_index, 0.0590,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 3.7830, 2.7660, 1650.1434, 0.0053, :fm_index, 0.4400,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 3.7890, 3.1560, 475.7231, 0.0083, :fm_index, 0.7370,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 4.1540, 2.1290, 976.0237, 0.0053, :fm_index, 1.2690,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 4.4890, 3.3650, 390.0525, 0.0110, :fm_index, 1.4580,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 4.7450, 1.5070, 1665.9722, 0.0053, :fm_index, 1.9330,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 4.8320, 1.4430, 798.1238, 0.0083, :fm_index, 0.8560,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 4.9440, 3.1560, 229.0528, 0.0110, :fm_index, 1.8300,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 5.3930, 1.1100, 473.7225, 0.0083, :fm_index, 1.6260,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 5.6970, 1.6170, 988.7953, 0.0053, :fm_index, 0.4230,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.0620, 1.3190, 390.9769, 0.0110, :fm_index, 0.4100,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.0840, 3.3660, 804.6413, 0.0083, :fm_index, 1.8760,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.1740, 2.7210, 418.6819, 0.0110, :fm_index, 0.0910,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.5700, 3.4460, 845.4019, 0.0077, :fm_index, 0.7660,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.6440, 1.1790, 1656.5756, 0.0049, :fm_index, 0.2960,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.6600, 2.8520, 1758.9788, 0.0049, :fm_index, 0.4520,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.8270, 1.8840, 387.0009, 0.0099, :fm_index, 1.3010,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.8870, 3.4040, 796.7213, 0.0077, :fm_index, 1.1820,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 6.9640, 3.3230, 416.3916, 0.0099, :fm_index, 0.6290,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 7.1320, 1.7050, 1637.2303, 0.0049, :fm_index, 1.0570,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 7.15, 3.1250, 1762.4906, 0.0049, :fm_index, 1.3170,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 7.3860, 2.9670, 852.0487, 0.0077, :fm_index, 1.4790,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 7.6670, 0.6780, 413.7094, 0.0099, :fm_index, 0.9470,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 7.8780, 2.7490, 1749.7509, 0.0049, :fm_index, 0.5040,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 7.9730, 0.5990, 848.1253, 0.0077, :fm_index, 1.9380,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 8.0880, 3.3360, 229.9144, 0.0099, :fm_index, 1.3930,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 8.1170, 1.1300, 984.0816, 0.0049, :fm_index, 0.3560,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 8.4640, 1.7330, 478.7184, 0.0077, :fm_index, 0.2840,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 8.5760, 0.5680, 413.4253, 0.0099, :fm_index, 1.5020,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 8.8200, 1.2150, 230.9588, 0.0099, :fm_index, 1.0990,
+ :reverb_amount, 0.1, :amp_env, z1amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 8.8320, 3.4590, 473.8903, 0.0077, :fm_index, 0.7680,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
+ vln_one_sin_ran($t + 8.8320, 0.7260, 857.2875, 0.0077, :fm_index, 0.7520,
+ :reverb_amount, 0.1, :amp_env, z2amp, :noise_amount, 0.0050)
$t += 12.0
indfunc = [0, 1, 20, 0, 100, 0]
@@ -1282,48 +1404,48 @@ def long_example
50, 0.1200, 60, 0.0800, 70, 0.0400, 100, 0]
ampfunc1 = [0, 0, 1, 1, 3, 1, 10, 0.5000, 30, 0.2, 60, 0.0500, 100, 0]
restore_fm_violin_defaults()
- violin($t + 0.2600, 0.0500, 80, 0.8,
- :fm_index, 5, :reverb_amount, 0, :amp_env, ampfunc1, :fm1_env, indfunc2)
- violin($t + 1.2610, 0.2, 80, 0.8,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 2.2600, 0.0500, 80, 0.8,
- :fm_index, 5, :reverb_amount, 0, :amp_env, ampfunc1, :fm1_env, indfunc2)
- violin($t + 2.2620, 0.2, 80, 0.8,
- :fm_index, 5, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 3.2600, 0.0500, 80, 0.8,
- :fm_index, 6, :reverb_amount, 0, :amp_env, ampfunc1, :fm1_env, indfunc2)
- violin($t + 3.2630, 0.2, 80, 0.8,
- :fm_index, 6, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 4.2600, 0.0500, 80, 0.3,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc1, :fm1_env, indfunc2)
- violin($t + 4.2620, 0.1, 160, 0.3,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 4.2620, 0.2500, 80, 0.8,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 5.2600, 0.0500, 80, 0.5000,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc1, :fm1_env, indfunc2)
- violin($t + 5.2610, 0.1, 210, 0.3,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 5.2620, 0.2, 80, 0.1,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 5.2630, 0.2500, 320, 0.1,
- :fm_index, 2, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 6.2600, 0.0500, 80, 0.8,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc1, :fm1_env, indfunc2)
- violin($t + 6.2610, 0.1, 210, 0.1,
- :fm_index, 2, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 6.2620, 0.2, 80, 0.2,
- :fm_index, 4, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 6.2630, 0.2500, 320, 0.3,
- :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 7.2600, 0.0500, 80, 0.8,
- :fm_index, 2, :reverb_amount, 0, :amp_env, ampfunc1, :fm1_env, indfunc2)
- violin($t + 7.2610, 0.1, 210, 0.1,
- :fm_index, 2, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 7.2620, 0.2, 80, 0.2,
- :fm_index, 2, :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
- violin($t + 7.2630, 0.2500, 320, 0.3,
- :reverb_amount, 0, :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 0.2600, 0.0500, 80, 0.8, :fm_index, 5, :reverb_amount, 0,
+ :amp_env, ampfunc1, :fm1_env, indfunc2)
+ vln_one_sin($t + 1.2610, 0.2, 80, 0.8, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 2.2600, 0.0500, 80, 0.8, :fm_index, 5, :reverb_amount, 0,
+ :amp_env, ampfunc1, :fm1_env, indfunc2)
+ vln_one_sin($t + 2.2620, 0.2, 80, 0.8, :fm_index, 5, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 3.2600, 0.0500, 80, 0.8, :fm_index, 6, :reverb_amount, 0,
+ :amp_env, ampfunc1, :fm1_env, indfunc2)
+ vln_one_sin($t + 3.2630, 0.2, 80, 0.8, :fm_index, 6, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 4.2600, 0.0500, 80, 0.3, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc1, :fm1_env, indfunc2)
+ vln_one_sin($t + 4.2620, 0.1, 160, 0.3, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 4.2620, 0.2500, 80, 0.8, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 5.2600, 0.0500, 80, 0.500, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc1, :fm1_env, indfunc2)
+ vln_one_sin($t + 5.2610, 0.1, 210, 0.3, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 5.2620, 0.2, 80, 0.1, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 5.2630, 0.2500, 320, 0.1, :fm_index, 2, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 6.2600, 0.0500, 80, 0.8, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc1, :fm1_env, indfunc2)
+ vln_one_sin($t + 6.2610, 0.1, 210, 0.1, :fm_index, 2, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 6.2620, 0.2, 80, 0.2, :fm_index, 4, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 6.2630, 0.2500, 320, 0.3, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 7.2600, 0.0500, 80, 0.8, :fm_index, 2, :reverb_amount, 0,
+ :amp_env, ampfunc1, :fm1_env, indfunc2)
+ vln_one_sin($t + 7.2610, 0.1, 210, 0.1, :fm_index, 2, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 7.2620, 0.2, 80, 0.2, :fm_index, 2, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
+ vln_one_sin($t + 7.2630, 0.2500, 320, 0.3, :reverb_amount, 0,
+ :amp_env, ampfunc, :fm1_env, indfunc, :fm2_rat, 0.6875)
$t += 8.0
$glissando_amount = 0.0
@@ -1331,221 +1453,293 @@ def long_example
$fm1_rat = 3.141
$fm2_rat = 4.414
$fm3_rat = 2.718
- vln_one_sin_ran($t + 0.2600, 4, 3286.9937, 0.16,
- :fm_index, 2.2165, :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2603, 4, 1046.4800, 0.16,
- :fm_index, 2.3234, :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2605, 4, 2844.3326, 0.16,
- :fm_index, 2.4790, :reverb_amount, 0.1, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2608, 4, 821.7484, 0.1,
- :fm_index, 1.8667, :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2610, 4, 261.6200, 0.1,
- :fm_index, 1.8523, :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2613, 4, 711.0832, 0.1,
- :fm_index, 2.2300, :reverb_amount, 0.1, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2615, 4, 205.4371, 0.0600,
- :fm_index, 1.5187, :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2618, 4, 65.4050, 0.0600,
- :fm_index, 2.4074, :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2620, 4, 177.7708, 0.0600,
- :fm_index, 2.4481, :reverb_amount, 0.1, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2623, 4, 51.3593, 0.0100,
- :fm_index, 2.3069, :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2625, 4, 16.3513, 0.0100,
- :fm_index, 2.1008, :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
- vln_one_sin_ran($t + 0.2628, 4, 44.4427, 0.0100,
- :fm_index, 2.4860, :reverb_amount, 0.1, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2600, 4, 3286.9937, 0.16, :fm_index, 2.2165,
+ :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2603, 4, 1046.4800, 0.16, :fm_index, 2.3234,
+ :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2605, 4, 2844.3326, 0.16, :fm_index, 2.4790,
+ :reverb_amount, 0.1, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2608, 4, 821.7484, 0.1, :fm_index, 1.8667,
+ :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2610, 4, 261.6200, 0.1, :fm_index, 1.8523,
+ :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2613, 4, 711.0832, 0.1, :fm_index, 2.2300,
+ :reverb_amount, 0.1, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2615, 4, 205.4371, 0.0600, :fm_index, 1.5187,
+ :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2618, 4, 65.4050, 0.0600, :fm_index, 2.4074,
+ :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2620, 4, 177.7708, 0.0600, :fm_index, 2.4481,
+ :reverb_amount, 0.1, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2623, 4, 51.3593, 0.0100, :fm_index, 2.3069,
+ :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2625, 4, 16.3513, 0.0100, :fm_index, 2.1008,
+ :reverb_amount, 0.0100, :amp_env, n_amp, :fm1_env, n_amp)
+ vln_one_sin_ran($t + 0.2628, 4, 44.4427, 0.0100, :fm_index, 2.4860,
+ :reverb_amount, 0.1, :amp_env, n_amp, :fm1_env, n_amp)
$t += 8.0
restore_fm_violin_defaults()
vln_one_sin($t + 0.2603, 1.2, 88.8854, 0.1,
- :fm_index, 2.3144, :reverb_amount, 0.2, :amp_env, mamp,
- :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
+ :fm_index, 2.3144, :reverb_amount, 0.2, :amp_env, mamp,
+ :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.2603, 4, 88.8854, 0.1,
- :fm_index, 2.1690, :reverb_amount, 0.2, :amp_env, mamp,
- :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
+ :fm_index, 2.1690, :reverb_amount, 0.2, :amp_env, mamp,
+ :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.2605, 2.8, 168.1236, 0.0500,
- :fm_index, 2.1850, :reverb_amount, 0.2, :amp_env, mamp,
- :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
+ :fm_index, 2.1850, :reverb_amount, 0.2, :amp_env, mamp,
+ :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.2608, 1.2, 168.1236, 0.0800,
- :fm_index, 1.7743, :reverb_amount, 0.2, :amp_env, mamp,
- :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
+ :fm_index, 1.7743, :reverb_amount, 0.2, :amp_env, mamp,
+ :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.2610, 2, 32.7025, 0.1,
- :fm_index, 2.4925, :reverb_amount, 0.2, :amp_env, mamp,
- :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
+ :fm_index, 2.4925, :reverb_amount, 0.2, :amp_env, mamp,
+ :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.2633, 2, 32.7025, 0.1,
- :fm_index, 2.1325, :reverb_amount, 0.2, :amp_env, mamp,
- :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
+ :fm_index, 2.1325, :reverb_amount, 0.2, :amp_env, mamp,
+ :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
vln_one_sin($t + 0.2643, 4, 32.7025, 0.0500,
- :fm_index, 1.7578, :reverb_amount, 0.2, :amp_env, mamp,
- :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
+ :fm_index, 1.7578, :reverb_amount, 0.2, :amp_env, mamp,
+ :fm2_rat, 4.4140, :fm3_rat, 5.1410, :fm1_rat, 2.7180)
$t += 8.0
vln_one_sin_ran($t + 0.2600, 6.6830, 244.8160, 0.0060,
- :fm_index, 2, :reverb_amount, 0.2, :noise_amount, 0.0040)
+ :fm_index, 2, :reverb_amount, 0.2, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.2600, 5.5170, 495.4040, 0.0060,
- :fm_index, 2, :reverb_amount, 0.2, :noise_amount, 0.0040)
+ :fm_index, 2, :reverb_amount, 0.2, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.2600, 7.5350, 980.6190, 0.0020,
- :fm_index, 2, :reverb_amount, 0.2, :noise_amount, 0.0040)
+ :fm_index, 2, :reverb_amount, 0.2, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.2600, 7.1990, 1965.4290, 0.0020,
- :fm_index, 0.8, :reverb_amount, 0.2, :noise_amount, 0.0040)
+ :fm_index, 0.8, :reverb_amount, 0.2, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.2600, 4.0790, 3835.3170, 0.0020,
- :fm_index, 0.8, :reverb_amount, 0.2, :noise_amount, 0.0040)
+ :fm_index, 0.8, :reverb_amount, 0.2, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.5170, 4.7400, 1320.9670, 0.0020,
- :fm_index, 0.8, :reverb_amount, 0.2, :noise_amount, 0.0040)
+ :fm_index, 0.8, :reverb_amount, 0.2, :noise_amount, 0.0040)
vln_one_sin_ran($t + 0.7040, 7.2080, 655.5670, 0.0040,
- :fm_index, 2, :reverb_amount, 0.2, :noise_amount, 0.0040)
+ :fm_index, 2, :reverb_amount, 0.2, :noise_amount, 0.0040)
$t += 9.0
updown = [0, 0, 15, 1, 100, 0]
$glissando_amount = 0.0
$reverb_amount = 0.9
vln_one_sin_exp($t + 0.5450, 6.4650, 366.3330, 0.0320, :fm_index, 1.0480,
- :amp_env, [0, 0, 1.5468, 1, 2.0882, 0.7, 2.3202, 1, 98.4532, 0.7500, 100, 0])
+ :amp_env,
+ [0, 0, 1.5468, 1, 2.0882, 0.7, 2.3202, 1, 98.4532, 0.7500, 100, 0])
vln_one_sin_exp($t + 0.5950, 8.4340, 1172.5830, 0.0180, :fm_index, 1.1350,
- :amp_env, [0, 0, 1.1857, 1.0, 1.6007, 0.7, 1.7785, 1, 98.8143, 0.5556, 100, 0])
+ :amp_env,
+ [0, 0, 1.1857, 1.0, 1.6007, 0.7, 1.7785, 1, 98.8143, 0.5556, 100, 0])
vln_one_sin_exp($t + 0.7650, 1.6210, 369.9940, 0.0170, :fm_index, 0.0960,
- :amp_env, [0, 0, 6.1690, 1.0, 8.3282, 0.7, 9.2535, 1, 93.8310, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 6.1690, 1.0, 8.3282, 0.7, 9.2535, 1, 93.8310, 0.5294, 100, 0])
vln_one_sin_exp($t + 0.8820, 3.0640, 246.9420, 0.0170, :fm_index, 0.0020,
- :amp_env, [0, 0, 3.2637, 1, 4.4060, 0.7, 4.8956, 1.0, 96.7363, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 3.2637, 1, 4.4060, 0.7, 4.8956, 1.0, 96.7363, 0.5294, 100, 0])
vln_one_sin_exp($t + 0.9250, 3.1170, 123.4710, 0.0380, :fm_index, 0.2330,
- :amp_env, [0, 0, 3.2082, 1, 4.3311, 0.7, 4.8123, 1, 96.7918, 0.7895, 100, 0])
+ :amp_env,
+ [0, 0, 3.2082, 1, 4.3311, 0.7, 4.8123, 1, 96.7918, 0.7895, 100, 0])
vln_one_sin_exp($t + 0.9810, 3.5670, 123.4710, 0.0420, :fm_index, 0.2330,
- :amp_env, [0, 0, 2.8035, 1, 3.7847, 0.7, 4.2052, 1.0, 97.1965, 0.8095, 100, 0])
+ :amp_env,
+ [0, 0, 2.8035, 1, 3.7847, 0.7, 4.2052, 1.0, 97.1965, 0.8095, 100, 0])
vln_one_sin_exp($t + 1.1280, 1.0450, 246.9420, 0.0170, :fm_index, 1.2050,
- :amp_env, [0, 0, 9.5694, 1, 12.9187, 0.7, 14.3541, 1, 90.4306, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 9.5694, 1, 12.9187, 0.7, 14.3541, 1, 90.4306, 0.5294, 100, 0])
vln_one_sin_exp($t + 1.2550, 3.3870, 374.1370, 0.0170, :fm_index, 0.1800,
- :amp_env, [0, 0, 2.9525, 1.0, 3.9858, 0.7, 4.4287, 1, 97.0475, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 2.9525, 1.0, 3.9858, 0.7, 4.4287, 1, 97.0475, 0.5294, 100, 0])
vln_one_sin_exp($t + 1.2990, 8.3050, 1576.9120, 0.0200, :fm_index, 0.2990,
- :amp_env, [0, 0, 1.2041, 1, 1.6255, 0.7, 1.8061, 1, 98.7959, 0.6, 100, 0])
+ :amp_env,
+ [0, 0, 1.2041, 1, 1.6255, 0.7, 1.8061, 1, 98.7959, 0.6, 100, 0])
vln_one_sin_exp($t + 1.3300, 4.4630, 246.9420, 0.0170, :fm_index, 0.0020,
- :amp_env, [0, 0, 2.2406, 1, 3.0249, 0.7, 3.3610, 1.0, 97.7594, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 2.2406, 1, 3.0249, 0.7, 3.3610, 1.0, 97.7594, 0.5294, 100, 0])
vln_one_sin_exp($t + 1.6600, 8.9940, 1576.9120, 0.0200, :fm_index, 0.2990,
- :amp_env, [0, 0, 1.1119, 1, 1.5010, 0.7, 1.6678, 1, 98.8881, 0.6, 100, 0])
+ :amp_env,
+ [0, 0, 1.1119, 1, 1.5010, 0.7, 1.6678, 1, 98.8881, 0.6, 100, 0])
vln_one_sin_exp($t + 1.9060, 8.8360, 1172.5830, 0.0180, :fm_index, 1.1350,
- :amp_env, [0, 0, 1.1317, 1, 1.5278, 0.7, 1.6976, 1, 98.8683, 0.5556, 100, 0])
+ :amp_env,
+ [0, 0, 1.1317, 1, 1.5278, 0.7, 1.6976, 1, 98.8683, 0.5556, 100, 0])
vln_one_sin_exp($t + 2.1510, 4.9320, 374.1370, 0.0170, :fm_index, 0.1800,
- :amp_env, [0, 0, 2.0276, 1, 2.7372, 0.7, 3.0414, 1, 97.9724, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 2.0276, 1, 2.7372, 0.7, 3.0414, 1, 97.9724, 0.5294, 100, 0])
vln_one_sin_exp($t + 2.2720, 2.3250, 369.9940, 0.0170, :fm_index, 1.1030,
- :amp_env, [0, 0, 4.3011, 1, 5.8065, 0.7, 6.4516, 1, 95.6989, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 4.3011, 1, 5.8065, 0.7, 6.4516, 1, 95.6989, 0.5294, 100, 0])
vln_one_sin_exp($t + 3.6960, 3.5540, 366.3330, 0.0310, :fm_index, 1.0480,
- :amp_env, [0, 0, 2.8137, 1, 3.7985, 0.7, 4.2206, 1, 97.1863, 0.7419, 100, 0])
+ :amp_env,
+ [0, 0, 2.8137, 1, 3.7985, 0.7, 4.2206, 1, 97.1863, 0.7419, 100, 0])
vln_one_sin_exp($t + 4.7240, 0.6040, 246.9420, 0.0170, :fm_index, 1.2050,
- :amp_env, [0, 0, 16.5563, 1, 22.351, 0.7, 24.8344, 1, 83.4437, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 16.5563, 1, 22.351, 0.7, 24.8344, 1, 83.4437, 0.5294, 100, 0])
vln_one_sin_exp($t + 4.9420, 2.5010, 123.4710, 0.0330, :fm_index, 0.2330,
- :amp_env, [0, 0, 3.9984, 1, 5.3978, 0.7, 5.9976, 1, 96.0016, 0.7576, 100, 0])
+ :amp_env,
+ [0, 0, 3.9984, 1, 5.3978, 0.7, 5.9976, 1, 96.0016, 0.7576, 100, 0])
vln_one_sin_exp($t + 5.0340, 2.3860, 246.9420, 0.0170, :fm_index, 0.0020,
- :amp_env, [0, 0, 4.1911, 1, 5.6580, 0.7, 6.2867, 1, 95.8089, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 4.1911, 1, 5.6580, 0.7, 6.2867, 1, 95.8089, 0.5294, 100, 0])
vln_one_sin_exp($t + 5.3850, 1.4510, 369.9940, 0.0170, :fm_index, 1.1030,
- :amp_env, [0, 0, 6.8918, 1, 9.3039, 0.7, 10.3377, 1, 93.1082, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 6.8918, 1, 9.3039, 0.7, 10.3377, 1, 93.1082, 0.5294, 100, 0])
vln_one_sin_exp($t + 5.5670, 2.6550, 374.1370, 0.0170, :fm_index, 0.1800,
- :amp_env, [0, 0, 3.7665, 1, 5.0847, 0.7, 5.6497, 1, 96.2335, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 3.7665, 1, 5.0847, 0.7, 5.6497, 1, 96.2335, 0.5294, 100, 0])
vln_one_sin_exp($t + 5.9830, 2.9860, 123.4710, 0.0380, :fm_index, 0.2330,
- :amp_env, [0, 0, 3.3490, 1, 4.5211, 0.7, 5.0234, 1, 96.6510, 0.7895, 100, 0])
+ :amp_env,
+ [0, 0, 3.3490, 1, 4.5211, 0.7, 5.0234, 1, 96.6510, 0.7895, 100, 0])
vln_one_sin_exp($t + 6.4910, 0.6110, 123.9770, 0.0170, :fm_index, 0.7550,
- :amp_env, [0, 0, 16.3666, 1, 22.0949, 0.7, 24.55, 1, 83.6334, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 16.3666, 1, 22.0949, 0.7, 24.55, 1, 83.6334, 0.5294, 100, 0])
vln_one_sin_exp($t + 6.7570, 1.4440, 123.4710, 0.0170, :fm_index, 0.0020,
- :amp_env, [0, 0, 6.9252, 1, 9.3490, 0.7, 10.3878, 1, 93.0748, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 6.9252, 1, 9.3490, 0.7, 10.3878, 1, 93.0748, 0.5294, 100, 0])
vln_one_sin_exp($t + 6.7750, 0.5370, 92.4435, 0.0330, :fm_index, 0.9200,
- :amp_env, [0, 0, 18.622, 1, 25.1397, 0.7, 27.9330, 1, 81.3780, 0.7576, 100, 0])
+ :amp_env,
+ [0, 0, 18.622, 1, 25.1397, 0.7, 27.9330, 1, 81.3780, 0.7576, 100, 0])
vln_one_sin_exp($t + 6.7750, 10.5370, 92.4435, 0.0130, :fm_index, 0.9200,
- :amp_env, [0, 0, 0.9490, 1, 1.2812, 0.7, 1.4236, 1, 99.0510, 0.3846, 100, 0])
+ :amp_env,
+ [0, 0, 0.9490, 1, 1.2812, 0.7, 1.4236, 1, 99.0510, 0.3846, 100, 0])
vln_one_sin_exp($t + 6.9380, 0.6520, 122.2995, 0.0170, :fm_index, 1.8380,
- :amp_env, [0, 0, 15.3374, 1, 20.706, 0.7, 23.0061, 1, 84.6626, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 15.3374, 1, 20.706, 0.7, 23.0061, 1, 84.6626, 0.5294, 100, 0])
vln_one_sin_exp($t + 7.2350, 3.7250, 586.2915, 0.0180, :fm_index, 1.1350,
- :amp_env, [0, 0, 2.6846, 1, 3.6242, 0.7, 4.0268, 1, 97.3154, 0.5556, 100, 0])
+ :amp_env,
+ [0, 0, 2.6846, 1, 3.6242, 0.7, 4.0268, 1, 97.3154, 0.5556, 100, 0])
vln_one_sin_exp($t + 7.2560, 2.8900, 183.1665, 0.0260, :fm_index, 1.0480,
- :amp_env, [0, 0, 3.4602, 1, 4.6713, 0.7, 5.1903, 1, 96.5398, 0.6923, 100, 0])
+ :amp_env,
+ [0, 0, 3.4602, 1, 4.6713, 0.7, 5.1903, 1, 96.5398, 0.6923, 100, 0])
vln_one_sin_exp($t + 7.2710, 1.6210, 187.0685, 0.0170, :fm_index, 0.1800,
- :amp_env, [0, 0, 6.169, 1.0, 8.3282, 0.7, 9.2535, 1, 93.8310, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 6.169, 1.0, 8.3282, 0.7, 9.2535, 1, 93.8310, 0.5294, 100, 0])
vln_one_sin_exp($t + 7.2920, 2.0160, 183.1665, 0.0290, :fm_index, 1.0480,
- :amp_env, [0, 0, 4.9603, 1, 6.6964, 0.7, 7.4405, 1, 95.0397, 0.7241, 100, 0])
+ :amp_env,
+ [0, 0, 4.9603, 1, 6.6964, 0.7, 7.4405, 1, 95.0397, 0.7241, 100, 0])
vln_one_sin_exp($t + 7.2920, 12.0160, 183.1665, 0.0290, :fm_index, 1.0480,
- :amp_env, [0, 0, 0.832, 1, 1.1235, 0.7, 1.248, 1.0, 99.1678, 0.7241, 100, 0])
+ :amp_env,
+ [0, 0, 0.832, 1, 1.1235, 0.7, 1.248, 1.0, 99.1678, 0.7241, 100, 0])
vln_one_sin_exp($t + 7.3300, 0.7300, 184.9970, 0.0170, :fm_index, 0.0960,
- :amp_env, [0, 0, 13.699, 1, 18.4932, 0.7, 20.548, 1.0, 86.3014, 0.529, 100, 0])
+ :amp_env,
+ [0, 0, 13.699, 1, 18.4932, 0.7, 20.548, 1.0, 86.3014, 0.529, 100, 0])
vln_one_sin_exp($t + 7.3570, 1.9600, 183.1665, 0.0280, :fm_index, 1.0480,
- :amp_env, [0, 0, 5.1020, 1.0, 6.8878, 0.7, 7.6531, 1, 94.8980, 0.7143, 100, 0])
+ :amp_env,
+ [0, 0, 5.1020, 1.0, 6.8878, 0.7, 7.6531, 1, 94.8980, 0.7143, 100, 0])
vln_one_sin_exp($t + 7.3820, 2.2450, 61.7355, 0.0330, :fm_index, 0.2330,
- :amp_env, [0, 0, 4.4543, 1, 6.0134, 0.7, 6.6815, 1, 95.5457, 0.7576, 100, 0])
+ :amp_env,
+ [0, 0, 4.4543, 1, 6.0134, 0.7, 6.6815, 1, 95.5457, 0.7576, 100, 0])
vln_one_sin_exp($t + 7.3820, 12.2450, 61.7355, 0.0330, :fm_index, 0.2330,
- :amp_env, [0, 0, 0.8167, 1, 1.1025, 0.7, 1.2250, 1, 99.1833, 0.7576, 100, 0])
+ :amp_env,
+ [0, 0, 0.8167, 1, 1.1025, 0.7, 1.2250, 1, 99.1833, 0.7576, 100, 0])
vln_one_sin_exp($t + 7.5410, 3.0130, 246.5050, 0.0360, :fm_index, 1.1350,
- :amp_env, [0, 0, 3.3190, 1.0, 4.4806, 0.7, 4.9784, 1, 96.6810, 0.7778, 100, 0])
+ :amp_env,
+ [0, 0, 3.3190, 1.0, 4.4806, 0.7, 4.9784, 1, 96.6810, 0.7778, 100, 0])
vln_one_sin_exp($t + 7.5570, 2.3220, 1251.5960, 0.0400, :fm_index, 0.2990,
- :amp_env, [0, 0, 4.3066, 1, 5.8140, 0.7, 6.4599, 1, 95.6934, 0.8, 100, 0])
+ :amp_env,
+ [0, 0, 4.3066, 1, 5.8140, 0.7, 6.4599, 1, 95.6934, 0.8, 100, 0])
vln_one_sin_exp($t + 7.5570, 18.3220, 1251.5960, 0.0200, :fm_index, 0.2990,
- :amp_env, [0, 0, 0.5458, 1.000, 0.7368, 0.7, 0.8187, 1, 99.4542, 0.6, 100, 0])
+ :amp_env,
+ [0, 0, 0.5458, 1.000, 0.7368, 0.7, 0.8187, 1, 99.4542, 0.6, 100, 0])
vln_one_sin_exp($t + 8.1060, 1.9900, 183.1665, 0.0230, :fm_index, 1.0480,
- :amp_env, [0, 0, 5.0251, 1.0, 6.7839, 0.7, 7.5377, 1, 94.9749, 0.6522, 100, 0])
+ :amp_env,
+ [0, 0, 5.0251, 1.0, 6.7839, 0.7, 7.5377, 1, 94.9749, 0.6522, 100, 0])
vln_one_sin_exp($t + 8.2570, 1.9180, 61.7355, 0.0330, :fm_index, 0.2330,
- :amp_env, [0, 0, 5.2138, 1, 7.0386, 0.7, 7.8206, 1, 94.7862, 0.7576, 100, 0])
+ :amp_env,
+ [0, 0, 5.2138, 1, 7.0386, 0.7, 7.8206, 1, 94.7862, 0.7576, 100, 0])
vln_one_sin_exp($t + 8.6370, 1.3090, 183.1665, 0.0310, :fm_index, 1.0480,
- :amp_env, [0, 0, 7.6394, 1, 10.3132, 0.7, 11.4591, 1, 92.3606, 0.7419, 100, 0])
+ :amp_env,
+ [0, 0, 7.6394, 1, 10.3132, 0.7, 11.4591, 1, 92.3606, 0.7419, 100, 0])
vln_one_sin_exp($t + 9.0330, 1.1590, 183.1665, 0.0250, :fm_index, 1.0480,
- :amp_env, [0, 0, 8.6281, 1, 11.6480, 0.7, 12.9422, 1, 91.3719, 0.6800, 100, 0])
+ :amp_env,
+ [0, 0, 8.6281, 1, 11.6480, 0.7, 12.9422, 1, 91.3719, 0.6800, 100, 0])
vln_one_sin_exp($t + 9.0980, 1.2400, 30.8675, 0.0330, :fm_index, 0.2330,
- :amp_env, [0, 0, 8.0645, 1, 10.8871, 0.7, 12.0968, 1, 91.9355, 0.7576, 100, 0])
+ :amp_env,
+ [0, 0, 8.0645, 1, 10.8871, 0.7, 12.0968, 1, 91.9355, 0.7576, 100, 0])
vln_one_sin_exp($t + 9.0980, 11.2400, 30.8675, 0.0130, :fm_index, 0.2330,
- :amp_env, [0, 0, 0.8897, 1, 1.2011, 0.7, 1.3345, 1, 99.1103, 0.3846, 100, 0])
+ :amp_env,
+ [0, 0, 0.8897, 1, 1.2011, 0.7, 1.3345, 1, 99.1103, 0.3846, 100, 0])
vln_one_sin_exp($t + 9.1260, 0.2600, 123.4710, 0.0170, :fm_index, 1.2050,
- :amp_env, [0, 0, 38.462, 1, 51.9231, 0.7, 57.6923, 1, 61.5385, 0.5294, 100, 0])
+ :amp_env,
+ [0, 0, 38.462, 1, 51.9231, 0.7, 57.6923, 1, 61.5385, 0.5294, 100, 0])
vln_one_sin_exp($t + 9.1260, 10.2600, 123.4710, 0.0170, :fm_index, 1.2050,
- :amp_env, [0, 0, 0.9747, 1, 1.3158, 0.7, 1.4620, 1, 99.0253, 0.5294, 100, 0])
- vln_one_sin($t + 0.0600, 13.8770, 3951.1200, 0.0090, :amp_env, updown)
- vln_one_sin($t + 0.2600, 14.8770, 123.4725, 0.0170, :fm_index, 1.5, :amp_env, updown)
- vln_one_sin($t + 0.2600, 13.8770, 61.7363, 0.0170, :fm_index, 1.5, :amp_env, updown)
- vln_one_sin($t + 0.2600, 12.8770, 30.8681, 0.0170, :fm_index, 1.5, :amp_env, updown)
- vln_one_sin($t + 0.2600, 11.8770, 15.4341, 0.0170, :fm_index, 1.5, :amp_env, updown)
+ :amp_env,
+ [0, 0, 0.9747, 1, 1.3158, 0.7, 1.4620, 1, 99.0253, 0.5294, 100, 0])
+ vln_one_sin($t + 0.0600, 13.8770, 3951.1200, 0.0090,
+ :amp_env, updown)
+ vln_one_sin($t + 0.2600, 14.8770, 123.4725, 0.0170, :fm_index, 1.5,
+ :amp_env, updown)
+ vln_one_sin($t + 0.2600, 13.8770, 61.7363, 0.0170, :fm_index, 1.5,
+ :amp_env, updown)
+ vln_one_sin($t + 0.2600, 12.8770, 30.8681, 0.0170, :fm_index, 1.5,
+ :amp_env, updown)
+ vln_one_sin($t + 0.2600, 11.8770, 15.4341, 0.0170, :fm_index, 1.5,
+ :amp_env, updown)
$t += 28.0
restore_fm_violin_defaults()
- cel_one_sum($t + 0.2620, 0.3906, 440, 0.4500, :fm_index, 1.2, :reverb_amount, 0.0013,
- :amp_env, [0, 0, 0.7680, 1, 4.7774, 0.6, 9.7891, 0.3, 24.8243, 0.1, 100, 0])
- cel_one_sum($t + 0.2640, 0.5220, 220, 0.4500, :fm_index, 1.2, :reverb_amount, 0.0012,
- :amp_env, [0, 0, 0.5747, 1.0, 4.5919, 0.6, 9.6134, 0.3, 24.6778, 0.1, 100, 0])
- cel_one_sum($t + 0.2660, 1.5660, 880, 0.4500, :fm_index, 1.2, :reverb_amount, 0.0014,
- :amp_env, [0, 0, 0.1916, 1.0, 4.2242, 0.6, 9.2651, 0.3, 24.3876, 0.1, 100, 0])
- cel_one_sum($t + 0.2680, 1.5660, 110, 0.4500, :fm_index, 1.2, :reverb_amount, 0.0013,
- :amp_env, [0, 0, 0.1916, 1.0, 4.2242, 0.6, 9.2651, 0.3, 24.3876, 0.1, 100, 0])
+ cel_one_sum($t + 0.2620, 0.3906, 440, 0.4500, :fm_index, 1.2,
+ :reverb_amount, 0.0013,
+ :amp_env,
+ [0, 0, 0.7680, 1, 4.7774, 0.6, 9.7891, 0.3, 24.8243, 0.1, 100, 0])
+ cel_one_sum($t + 0.2640, 0.5220, 220, 0.4500, :fm_index, 1.2,
+ :reverb_amount, 0.0012,
+ :amp_env,
+ [0, 0, 0.5747, 1.0, 4.5919, 0.6, 9.6134, 0.3, 24.6778, 0.1, 100, 0])
+ cel_one_sum($t + 0.2660, 1.5660, 880, 0.4500, :fm_index, 1.2,
+ :reverb_amount, 0.0014,
+ :amp_env,
+ [0, 0, 0.1916, 1.0, 4.2242, 0.6, 9.2651, 0.3, 24.3876, 0.1, 100, 0])
+ cel_one_sum($t + 0.2680, 1.5660, 110, 0.4500, :fm_index, 1.2,
+ :reverb_amount, 0.0013,
+ :amp_env,
+ [0, 0, 0.1916, 1.0, 4.2242, 0.6, 9.2651, 0.3, 24.3876, 0.1, 100, 0])
$t += 3.0
vln_one_sin($t + 0.8600, 0.9, 733.3330, 0.1875,
- :fm_index, 0.2, :distance, 1.0, :reverb_amount, 0.0012,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100, 0])
+ :fm_index, 0.2, :distance, 1.0, :reverb_amount, 0.0012,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100, 0])
vln_one_sin($t + 0.8600, 0.2250, 550, 0.1875,
- :fm_index, 0.2, :distance, 1.0, :reverb_amount, 0.0015,
- :amp_env, [0, 0, 1.3333, 1, 5.3199, 0.6, 10.3030, 0.3, 25.2525, 0.1, 100, 0])
+ :fm_index, 0.2, :distance, 1.0, :reverb_amount, 0.0015,
+ :amp_env,
+ [0, 0, 1.3333, 1, 5.3199, 0.6, 10.3030, 0.3, 25.2525, 0.1, 100, 0])
vln_one_sin($t + 0.8600, 0.4500, 586.6670, 0.3750,
- :fm_index, 0.2, :distance, 1.0, :reverb_amount, 0.0013,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ :fm_index, 0.2, :distance, 1.0, :reverb_amount, 0.0013,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin($t + 0.9020, 0.9, 733.3330, 0.1875,
- :fm_index, 0.4, :distance, 1.0, :reverb_amount, 0.0013,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100, 0])
+ :fm_index, 0.4, :distance, 1.0, :reverb_amount, 0.0013,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100, 0])
vln_one_sin($t + 0.9020, 0.2250, 550, 0.1875,
- :fm_index, 0.4, :distance, 1.0, :reverb_amount, 0.0010,
- :amp_env, [0, 0, 1.3333, 1, 5.3199, 0.6, 10.3030, 0.3, 25.2525, 0.1, 100, 0])
+ :fm_index, 0.4, :distance, 1.0, :reverb_amount, 0.0010,
+ :amp_env,
+ [0, 0, 1.3333, 1, 5.3199, 0.6, 10.3030, 0.3, 25.2525, 0.1, 100, 0])
vln_one_sin($t + 0.9020, 0.4500, 586.6670, 0.3750,
- :fm_index, 0.4, :distance, 1.0, :reverb_amount, 0.0015,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ :fm_index, 0.4, :distance, 1.0, :reverb_amount, 0.0015,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin($t + 0.9430, 0.9, 366.6670, 0.1875,
- :fm_index, 0.6, :distance, 1.0, :reverb_amount, 0.0016,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100, 0])
+ :fm_index, 0.6, :distance, 1.0, :reverb_amount, 0.0016,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100, 0])
vln_one_sin($t + 0.9430, 0.2250, 275, 0.1875,
- :fm_index, 0.6, :distance, 1.0, :reverb_amount, 0.0015,
- :amp_env, [0, 0, 1.3333, 1, 5.3199, 0.6, 10.3030, 0.3, 25.2525, 0.1, 100, 0])
+ :fm_index, 0.6, :distance, 1.0, :reverb_amount, 0.0015,
+ :amp_env,
+ [0, 0, 1.3333, 1, 5.3199, 0.6, 10.3030, 0.3, 25.2525, 0.1, 100, 0])
vln_one_sin($t + 0.9430, 0.4500, 293.3340, 0.3750,
- :fm_index, 0.6, :distance, 1.0, :reverb_amount, 0.0015,
- :amp_env, [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
+ :fm_index, 0.6, :distance, 1.0, :reverb_amount, 0.0015,
+ :amp_env,
+ [0, 0, 0.6667, 1, 4.6801, 0.6, 9.6970, 0.3, 24.7475, 0.1, 100, 0])
vln_one_sin($t + 0.9850, 0.9, 733.3330, 0.1875,
- :fm_index, 0.8, :distance, 1.0, :reverb_amount, 0.0010,
- :amp_env, [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100, 0])
+ :fm_index, 0.8, :distance, 1.0, :reverb_amount, 0.0010,
+ :amp_env,
+ [0, 0, 0.3333, 1, 4.3603, 0.6, 9.3939, 0.3, 24.4950, 0.1, 100, 0])
vln_one_sin($t + 0.9850, 0.2250, 550, 0.1875,
- :fm_index, 0.8, :distance, 1.0, :reverb_amount, 0.0013,
- :amp_env, [0, 0, 1.3333, 1, 5.3199, 0.6, 10.3030, 0.3, 25.2525, 0.1, 100, 0])
+ :fm_index, 0.8, :distance, 1.0, :reverb_amount, 0.0013,
+ :amp_env,
+ [0, 0, 1.3333, 1, 5.3199, 0.6, 10.3030, 0.3, 25.2525, 0.1, 100, 0])
untrace_var(:$t)
end
end
-main() unless provided? :snd
+unless provided?(:snd)
+ main()
+end
# fmviolin.rb ends here
diff --git a/sndins/samples/fmviolin.scm b/sndins/samples/fmviolin.scm
index e81f8be..f311999 100644
--- a/sndins/samples/fmviolin.scm
+++ b/sndins/samples/fmviolin.scm
@@ -1,38 +1,50 @@
-;; -*- snd-scheme -*-
+#! /usr/opt/bin/snd-s7-nogui -noinit
+!#
;;; Examples of the fm violin (see v.ins)
;;; This file semi-automatically translated from a sambox note list ca 1983.
;;;
-;;; Converted into Scheme by Michael Scholz <mi-scholz at users.sourceforge.net>
-
-;; This file is part of Sndins.
+;; Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
+;; Created: 03/06/24 19:05:06
+;; Changed: 14/11/18 23:54:35
;; Type (short-example)
;; or (long-example)
+(define *clm-c-version* #f)
+
(if (not (provided? 'sndlib))
(let ((hsndlib (dlopen "libsndlib.so")))
(if (string? hsndlib)
(snd-error (format #f "script needs the sndlib module: ~A" hsndlib))
(dlinit hsndlib "Init_sndlib"))))
-(if (not (provided? 'sndins))
- (let ((hsndins (dlopen "libsndins.so")))
- (if (string? hsndins)
- (snd-error (format #f "script needs the sndins module: ~A" hsndins))
- (dlinit hsndins "Init_sndins"))))
-
-(if (not (provided? 'snd-ws.scm)) (load-from-path "ws"))
-
-(define *clm-file-name* "test-ins-g.snd")
-(define *clm-play* #t)
-(define *clm-statistics* #t)
-(define *clm-verbose* #t)
-(define *clm-srate* 44100)
-(define *clm-channels* 2)
-(define *clm-reverb-channels* 2)
-(define *clm-delete-reverb* #t)
-
-(define (main args)
- (if (> (length args) 1)
+(if *clm-c-version*
+ (if (not (provided? 'sndins))
+ (let ((hsndins (dlopen "libsndins.so")))
+ (if (string? hsndins)
+ (snd-error (format #f "script needs the sndins module: ~A" hsndins))
+ (dlinit hsndins "Init_sndins"))))
+ (begin
+ (load "v.scm")
+ (load "freeverb.scm")))
+
+(if (provided? 'snd)
+ (load "ws.scm")
+ (load "sndlib-ws.scm"))
+
+(set! *clm-file-name* "test-ins-s.snd")
+(set! *clm-play* #t)
+(set! *clm-statistics* #t)
+(set! *clm-verbose* #t)
+(set! *clm-srate* 44100)
+(set! *clm-channels* 2)
+(set! *clm-reverb-channels* 2)
+(set! *clm-delete-reverb* #t)
+(set! *clm-header-type* mus-next)
+(set! *clm-sample-type* mus-bfloat)
+
+;; (script-args): ("-noinit" "./fmviolin.scm")
+(define (main)
+ (if (> (length (script-args)) 2)
(short-example)
(long-example)))
@@ -42,10 +54,7 @@
(define counter 0)
(define (snd-msg frm . args)
- (let ((str (apply format (append (list #f frm) args))))
- (if (string? (getenv "EMACS"))
- (display str))
- (snd-print str)))
+ (snd-print (apply format (append (list #f frm) args))))
(define (current-score-time time)
(set! counter (+ counter 1))
@@ -55,8 +64,8 @@
(- time 24)
(/ (- (get-internal-real-time) start-time) 100.0))))
-(definstrument (violin-new beg dur freq amp :key
- fm1-rat fm2-rat fm3-rat fm-index reverb-amount amp-env)
+(definstrument (violin-new beg dur freq amp fm1-rat fm2-rat fm3-rat fm-index
+ reverb-amount amp-env)
(do ((i 0 (1+ i)))
((= 5 i))
(fm-violin (+ beg (* i .05 (random 1.0)))
@@ -72,9 +81,9 @@
(define (short-example)
(with-sound (:reverb nrev :reverb-data '(:lp-coeff 0.6))
(violin-new 0 8.53 993.323 .03 :fm-index .75
- :reverb-amount .20 :amp-env (list 0 0 221.00 1 240.00 0))
- (violin-new 5 4.53 (* 5/6 993.323) .02 :fm-index
- .55 :reverb-amount .20 :amp-env (list 0 0 221.00 1 240.00 0))))
+ :reverb-amount .20 :amp-env (list 0 0 221.00 1 240.00 0))
+ (violin-new 5 4.53 (* 5/6 993.323) .02 :fm-index .55
+ :reverb-amount .20 :amp-env (list 0 0 221.00 1 240.00 0))))
(define pna '(0 0 1 1 10 .6000 25 .3 100 0))
(define ind2 '(0 1 25 .4 75 .6000 100 0))
@@ -126,7 +135,8 @@
(define updown '(0 0 15 1 100 0))
(define indfunc '(0 1 20 0 100 0))
(define indfunc2 '(0 1 90 1 100 0))
-(define ampfunc '(0 1 6 1 10 .5 20 .3630 30 .2700 40 .2000 50 .1200 60 .0800 70 .0400 100 0))
+(define ampfunc '(0 1 6 1 10 .5 20 .363 30 .27 40 .2 50 .12
+ 60 .08 70 .04 100 0))
(define ampfunc1 '(0 0 1 1 3 1 10 .5 30 .2000 60 .0500 100 0))
(define z1amp '(0 0 20 .5 40 .1 60 .2000 80 1 100 0))
(define z2amp '(0 0 20 1 60 .1 75 .3 100 0))
@@ -191,64 +201,93 @@
(set! fm-violin-index2 #f)
(set! fm-violin-index3 #f))
-(definstrument (old-fm-violin startime dur frequency amplitude :key
- (fm-index fm-violin-fm-index)
- (amp-env fm-violin-amp-env)
- (periodic-vibrato-rate fm-violin-periodic-vibrato-rate)
- (random-vibrato-rate fm-violin-random-vibrato-rate)
- (periodic-vibrato-amplitude fm-violin-periodic-vibrato-amplitude)
- (random-vibrato-amplitude fm-violin-random-vibrato-amplitude)
- (noise-amount fm-violin-noise-amount)
- (ind-noise-freq fm-violin-ind-noise-freq)
- (ind-noise-amount fm-violin-ind-noise-amount)
- (amp-noise-freq fm-violin-amp-noise-freq)
- (amp-noise-amount fm-violin-amp-noise-amount)
- (noise-freq fm-violin-noise-freq)
- (gliss-env fm-violin-gliss-env)
- (glissando-amount fm-violin-glissando-amount)
- (fm1-env fm-violin-fm1-env)
- (fm2-env fm-violin-fm2-env)
- (fm3-env fm-violin-fm3-env)
- (fm1-rat fm-violin-fm1-rat)
- (fm2-rat fm-violin-fm2-rat)
- (fm3-rat fm-violin-fm3-rat)
- (fm1-index fm-violin-index1)
- (fm2-index fm-violin-index2)
- (fm3-index fm-violin-index3)
- (base fm-violin-base)
- (reverb-amount fm-violin-reverb-amount)
- (index-type fm-violin-index-type)
- (degree 0.0)
- (distance 1.0))
- (fm-violin startime dur frequency amplitude
- :fm-index fm-index
- :amp-env amp-env
- :periodic-vibrato-rate periodic-vibrato-rate
- :random-vibrato-rate random-vibrato-rate
- :periodic-vibrato-amplitude periodic-vibrato-amplitude
- :random-vibrato-amplitude random-vibrato-amplitude
- :noise-amount noise-amount
- :ind-noise-freq ind-noise-freq
- :ind-noise-amount ind-noise-amount
- :amp-noise-freq amp-noise-freq
- :amp-noise-amount amp-noise-amount
- :noise-freq noise-freq
- :gliss-env gliss-env
- :glissando-amount glissando-amount
- :fm1-env fm1-env
- :fm2-env fm2-env
- :fm3-env fm3-env
- :fm1-rat fm1-rat
- :fm2-rat fm2-rat
- :fm3-rat fm3-rat
- :fm1-index fm1-index
- :fm2-index fm2-index
- :fm3-index fm3-index
- :base base
- :reverb-amount reverb-amount
- :index-type index-type
- :degree degree
- :distance distance))
+(definstrument (old-fm-violin startime dur frequency amplitude
+ (fm-index fm-violin-fm-index)
+ (amp-env fm-violin-amp-env)
+ (periodic-vibrato-rate fm-violin-periodic-vibrato-rate)
+ (random-vibrato-rate fm-violin-random-vibrato-rate)
+ (periodic-vibrato-amplitude fm-violin-periodic-vibrato-amplitude)
+ (random-vibrato-amplitude fm-violin-random-vibrato-amplitude)
+ (noise-amount fm-violin-noise-amount)
+ (noise-freq fm-violin-noise-freq)
+ (ind-noise-freq fm-violin-ind-noise-freq)
+ (ind-noise-amount fm-violin-ind-noise-amount)
+ (amp-noise-freq fm-violin-amp-noise-freq)
+ (amp-noise-amount fm-violin-amp-noise-amount)
+ (gliss-env fm-violin-gliss-env)
+ (glissando-amount fm-violin-glissando-amount)
+ (fm1-env fm-violin-fm1-env)
+ (fm2-env fm-violin-fm2-env)
+ (fm3-env fm-violin-fm3-env)
+ (fm1-rat fm-violin-fm1-rat)
+ (fm2-rat fm-violin-fm2-rat)
+ (fm3-rat fm-violin-fm3-rat)
+ (fm1-index fm-violin-index1)
+ (fm2-index fm-violin-index2)
+ (fm3-index fm-violin-index3)
+ (degree 0.0)
+ (distance 1.0)
+ (reverb-amount fm-violin-reverb-amount)
+ (base fm-violin-base)
+ (index-type fm-violin-index-type))
+ (if *clm-c-version*
+ (fm-violin startime dur frequency amplitude
+ :fm-index fm-index
+ :amp-env amp-env
+ :periodic-vibrato-rate periodic-vibrato-rate
+ :random-vibrato-rate random-vibrato-rate
+ :periodic-vibrato-amplitude periodic-vibrato-amplitude
+ :random-vibrato-amplitude random-vibrato-amplitude
+ :noise-amount noise-amount
+ :noise-freq noise-freq
+ :ind-noise-freq ind-noise-freq
+ :ind-noise-amount ind-noise-amount
+ :amp-noise-freq amp-noise-freq
+ :amp-noise-amount amp-noise-amount
+ :gliss-env gliss-env
+ :glissando-amount glissando-amount
+ :fm1-env fm1-env
+ :fm2-env fm2-env
+ :fm3-env fm3-env
+ :fm1-rat fm1-rat
+ :fm2-rat fm2-rat
+ :fm3-rat fm3-rat
+ :fm1-index fm1-index
+ :fm2-index fm2-index
+ :fm3-index fm3-index
+ :degree degree
+ :distance distance
+ :reverb-amount reverb-amount
+ :base base
+ :index-type index-type)
+ (fm-violin startime dur frequency amplitude
+ :fm-index fm-index
+ :amp-env amp-env
+ :periodic-vibrato-rate periodic-vibrato-rate
+ :random-vibrato-rate random-vibrato-rate
+ :periodic-vibrato-amplitude periodic-vibrato-amplitude
+ :random-vibrato-amplitude random-vibrato-amplitude
+ :noise-amount noise-amount
+ :noise-freq noise-freq
+ :ind-noise-freq ind-noise-freq
+ :ind-noise-amount ind-noise-amount
+ :amp-noise-freq amp-noise-freq
+ :amp-noise-amount amp-noise-amount
+ :gliss-env gliss-env
+ :glissando-amount glissando-amount
+ :fm1-env fm1-env
+ :fm2-env fm2-env
+ :fm3-env fm3-env
+ :fm1-rat fm1-rat
+ :fm2-rat fm2-rat
+ :fm3-rat fm3-rat
+ :fm1-index fm1-index
+ :fm2-index fm2-index
+ :fm3-index fm3-index
+ :degree degree
+ :distance distance
+ :reverb-amount reverb-amount
+ :base base)))
(define fullbeg 24.0)
@@ -350,582 +389,662 @@
(current-score-time 48)
(vln_one_sin_ran 48 5.4000 116.5400 .2500
- :fm-index 2.2822 :reverb-amount .0280
- :amp-env '(0 0 .0556 1 4.0937 .6000 9.1414 .3 24.2845 .1 100.0 0))
+ :fm-index 2.2822 :reverb-amount .0280
+ :amp-env
+ '(0 0 .0556 1 4.0937 .6000 9.1414 .3 24.2845 .1 100.0 0))
(vln_one_sin_ran 48.0100 5.4000 43.6538 .2500
- :fm-index 2.0867 :reverb-amount .0202
- :amp-env '(0 0 .0556 1 4.0937 .6000 9.1414 .3 24.2845 .1 100.0 0))
+ :fm-index 2.0867 :reverb-amount .0202
+ :amp-env
+ '(0 0 .0556 1 4.0937 .6000 9.1414 .3 24.2845 .1 100.0 0))
(vln_one_sin_ran 48.0200 5.4000 130.8100 .2500
- :fm-index 1.9652 :reverb-amount .0270
- :amp-env '(0 0 .0556 1 4.0937 .6000 9.1414 .3 24.2845 .1 100.0 0))
+ :fm-index 1.9652 :reverb-amount .0270
+ :amp-env
+ '(0 0 .0556 1 4.0937 .6000 9.1414 .3 24.2845 .1 100.0 0))
(vln_one_sin_ran 48.0250 5.4000 87.3075 .2500
- :fm-index 2.1524 :reverb-amount .0260
- :amp-env '(0 0 .0556 1 4.0937 .6000 9.1414 .3 24.2845 .1 100.0 0))
+ :fm-index 2.1524 :reverb-amount .0260
+ :amp-env
+ '(0 0 .0556 1 4.0937 .6000 9.1414 .3 24.2845 .1 100.0 0))
(vln_one_sin_ran 48.0300 4.5000 261.6200 .1500
- :fm-index 2.1384 :reverb-amount .0242
- :amp-env '(0 0 .0667 1 4.1044 .6000 9.1515 .3 24.2929 .1 100 0))
+ :fm-index 2.1384 :reverb-amount .0242
+ :amp-env
+ '(0 0 .0667 1 4.1044 .6000 9.1515 .3 24.2929 .1 100 0))
(vln_one_sin_ran 48.0300 4.5000 174.6150 .1500
- :fm-index 2.1425 :reverb-amount .0265
- :amp-env '(0 0 .0667 1 4.1044 .6000 9.1515 .3 24.2929 .1 100 0))
+ :fm-index 2.1425 :reverb-amount .0265
+ :amp-env
+ '(0 0 .0667 1 4.1044 .6000 9.1515 .3 24.2929 .1 100 0))
(vln_one_sin_ran 48.0300 4.5000 130.8100 .1500
- :fm-index 1.9805 :reverb-amount .0201
- :amp-env '(0 0 .0667 1 4.1044 .6000 9.1515 .3 24.2929 .1 100 0))
+ :fm-index 1.9805 :reverb-amount .0201
+ :amp-env
+ '(0 0 .0667 1 4.1044 .6000 9.1515 .3 24.2929 .1 100 0))
(vln_one_sin_ran 48.0350 4.5000 43.6538 .1500
- :fm-index 2.4876 :reverb-amount .0329
- :amp-env '(0 0 .0667 1 4.1044 .6000 9.1515 .3 24.2929 .1 100 0))
+ :fm-index 2.4876 :reverb-amount .0329
+ :amp-env
+ '(0 0 .0667 1 4.1044 .6000 9.1515 .3 24.2929 .1 100 0))
(vln_one_sin_ran 48.0400 3.6000 220 .1500
- :fm-index 1.8282 :reverb-amount .0244
- :amp-env '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
- :noise-amount .1500)
+ :fm-index 1.8282 :reverb-amount .0244
+ :amp-env
+ '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
+ :noise-amount .1500)
(vln_one_sin_ran 48.0400 3.6000 174.6150 .1500
- :fm-index 2.3479 :reverb-amount .0200
- :amp-env '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
- :noise-amount .1500)
+ :fm-index 2.3479 :reverb-amount .0200
+ :amp-env
+ '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
+ :noise-amount .1500)
(vln_one_sin_ran 48.0400 3.6000 523.2400 .1500
- :fm-index 1.6424 :reverb-amount .0286
- :amp-env '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
- :noise-amount .1500)
+ :fm-index 1.6424 :reverb-amount .0286
+ :amp-env
+ '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
+ :noise-amount .1500)
(vln_one_sin_ran 48.0450 3.6000 349.2300 .1500
- :fm-index 1.6449 :reverb-amount .0333
- :amp-env '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
- :noise-amount .1500)
+ :fm-index 1.6449 :reverb-amount .0333
+ :amp-env
+ '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
+ :noise-amount .1500)
(vln_one_sin_ran 48.0500 6 699.4600 .1500
- :fm-index 1.5570 :reverb-amount .1300 :amp-env tap)
+ :fm-index 1.5570 :reverb-amount .1300 :amp-env tap)
(vln_one_sin_ran 48.0500 6 1397.9200 .1500
- :fm-index 1.5131 :reverb-amount .1300 :amp-env tap)
+ :fm-index 1.5131 :reverb-amount .1300 :amp-env tap)
(vln_one_sin_ran 48.0500 6 783.9800 .1500
- :fm-index 2.2031 :reverb-amount .1300 :amp-env tap)
+ :fm-index 2.2031 :reverb-amount .1300 :amp-env tap)
(vln_one_sin_ran 48.0500 6 1046.4800 .1500
- :fm-index 2.2724 :reverb-amount .1300 :amp-env tap)
+ :fm-index 2.2724 :reverb-amount .1300 :amp-env tap)
(vln_one_sin_ran 48.0600 9 21.8269 .1500
- :fm-index 2.1048 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.1048 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0600 8 87.3075 .1500
- :fm-index 1.8854 :reverb-amount .1 :amp-env tap)
+ :fm-index 1.8854 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0600 7 65.4050 .1500
- :fm-index 1.6781 :reverb-amount .1 :amp-env tap)
+ :fm-index 1.6781 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0600 8 43.6538 .1500
- :fm-index 1.7862 :reverb-amount .1 :amp-env tap)
+ :fm-index 1.7862 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0700 6 175.6150 .1500
- :fm-index 2.2656 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.2656 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0700 6 350.2300 .1500
- :fm-index 2.4241 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.4241 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0700 6 131.8100 .1500
- :fm-index 2.4294 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.4294 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0700 6 32.7025 .1500
- :fm-index 1.5779 :reverb-amount .1 :amp-env tap)
+ :fm-index 1.5779 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0800 6 196.9950 .1500
- :fm-index 1.8511 :reverb-amount .1 :amp-env tap)
+ :fm-index 1.8511 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0800 6 1047.4800 .1500
- :fm-index 2.2148 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.2148 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0800 6 831.6200 .1500
- :fm-index 1.9913 :reverb-amount .1 :amp-env tap)
+ :fm-index 1.9913 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.0800 6 2793.8400 .1500
- :fm-index 2.2607 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.2607 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.2700 6 784.9800 .1600
- :fm-index 2.0693 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.0693 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.2700 6 64.4050 .1600
- :fm-index 1.6920 :reverb-amount .1 :amp-env tap)
+ :fm-index 1.6920 :reverb-amount .1 :amp-env tap)
(vln_one_sin_ran 48.2700 6 208.6550 .1600
- :fm-index 2.2597 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.2597 :reverb-amount .1 :amp-env tap)
; from lizard
(vln_one_sin_ran 48.2700 6 43.6538 .1600
- :fm-index 2.2522 :reverb-amount .1 :amp-env tap)
+ :fm-index 2.2522 :reverb-amount .1 :amp-env tap)
(current-score-time 60)
(restore-fm-violin-defaults)
(vln_one_sin_ran 60 1.8000 349.2300 .1600
- :fm-index 2.1541 :reverb-amount .0225
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0500)
+ :fm-index 2.1541 :reverb-amount .0225
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0500)
(vln_one_sin_ran 60.0100 2.7000 146.8300 .1600
- :fm-index 2.3335 :reverb-amount .0274
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0500)
+ :fm-index 2.3335 :reverb-amount .0274
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0500)
(vln_one_sin_ran 60.0200 1.8000 880 .1600
- :fm-index 2.1910 :reverb-amount .0279
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0500)
+ :fm-index 2.1910 :reverb-amount .0279
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0500)
(vln_one_sin_ran 60.0250 3.6000 73.4150 .1600
- :fm-index 2.1410 :reverb-amount .0223
- :amp-env '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
- :noise-amount .0500)
+ :fm-index 2.1410 :reverb-amount .0223
+ :amp-env
+ '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
+ :noise-amount .0500)
(vln_one_sin_ran 60.0300 2.7000 87.3075 .1600
- :fm-index 1.8491 :reverb-amount .0217
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0010)
+ :fm-index 1.8491 :reverb-amount .0217
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0010)
(vln_one_sin_ran 60.0300 2.7000 75.5662 .1600
- :fm-index 1.9191 :reverb-amount .0204
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0010)
+ :fm-index 1.9191 :reverb-amount .0204
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0010)
(vln_one_sin_ran 60.0400 3.6000 52.3432 .1600
- :fm-index 1.6090 :reverb-amount .0296
- :amp-env '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
- :noise-amount .0010)
+ :fm-index 1.6090 :reverb-amount .0296
+ :amp-env
+ '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
+ :noise-amount .0010)
(vln_one_sin_ran 60.0450 1.8000 73.4150 .1600
- :fm-index 2.2201 :reverb-amount .0221
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0010)
+ :fm-index 2.2201 :reverb-amount .0221
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0010)
(vln_one_sin_ran 60.0500 4 116.5400 .0600
- :fm-index 2.0230 :reverb-amount .1
- :amp-env tap :noise-amount .0010)
+ :fm-index 2.0230 :reverb-amount .1
+ :amp-env tap :noise-amount .0010)
(vln_one_sin_ran 60.0500 4 97.9975 .0600
- :fm-index 1.7284 :reverb-amount .1
- :amp-env tap :noise-amount .0010)
+ :fm-index 1.7284 :reverb-amount .1
+ :amp-env tap :noise-amount .0010)
(vln_one_sin_ran 60.0600 4 36.7075 .0600
- :fm-index 1.6845 :reverb-amount .1
- :amp-env tap :noise-amount .0010)
+ :fm-index 1.6845 :reverb-amount .1
+ :amp-env tap :noise-amount .0010)
(vln_one_sin_ran 60.0650 4 97.9975 .0600
- :fm-index 2.4616 :reverb-amount .1
- :amp-env tap :noise-amount .0010)
+ :fm-index 2.4616 :reverb-amount .1
+ :amp-env tap :noise-amount .0010)
(current-score-time 67)
(vln_one_sin_ran 67 1.8000 261.6200 .1600
- :fm-index 2.2576 :reverb-amount .0286
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0100)
+ :fm-index 2.2576 :reverb-amount .0286
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 67.0100 2.7000 130.8100 .1600
- :fm-index 2.1530 :reverb-amount .0330
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.1530 :reverb-amount .0330
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 67.0200 1.8000 523.2400 .1600
- :fm-index 2.0608 :reverb-amount .0235
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0100)
+ :fm-index 2.0608 :reverb-amount .0235
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 67.0250 3.6000 65.4050 .1600
- :fm-index 2.2203 :reverb-amount .0234
- :amp-env '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.2203 :reverb-amount .0234
+ :amp-env
+ '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 67.0300 2.7000 65.4050 .1600
- :fm-index 1.7089 :reverb-amount .0208
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0010)
+ :fm-index 1.7089 :reverb-amount .0208
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0010)
(vln_one_sin_ran 67.0300 2.7000 130.8100 .1600
- :fm-index 2.2948 :reverb-amount .0269
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0010)
+ :fm-index 2.2948 :reverb-amount .0269
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0010)
(vln_one_sin_ran 67.0400 3.6000 32.7025 .1600
- :fm-index 1.7677 :reverb-amount .0288
- :amp-env '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
- :noise-amount .0010)
+ :fm-index 1.7677 :reverb-amount .0288
+ :amp-env
+ '(0 0 .0833 1 4.1204 .6000 9.1667 .3 24.3056 .1 100.0 0)
+ :noise-amount .0010)
(vln_one_sin_ran 67.0450 1.8000 32.7025 .1600
- :fm-index 1.9030 :reverb-amount .0209
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0010)
+ :fm-index 1.9030 :reverb-amount .0209
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0010)
(vln_one_sin_ran 67.0500 4 65.4050 .0600
- :fm-index 2.2757 :reverb-amount .1
- :amp-env tap :noise-amount .0010)
+ :fm-index 2.2757 :reverb-amount .1
+ :amp-env tap :noise-amount .0010)
(vln_one_sin_ran 67.0500 4 65.4050 .0600
- :fm-index 2.2435 :reverb-amount .1
- :amp-env tap :noise-amount .0010)
+ :fm-index 2.2435 :reverb-amount .1
+ :amp-env tap :noise-amount .0010)
(vln_one_sin_ran 67.0600 4 32.7025 .0600
- :fm-index 1.9619 :reverb-amount .1
- :amp-env tap :noise-amount .0010)
+ :fm-index 1.9619 :reverb-amount .1
+ :amp-env tap :noise-amount .0010)
(vln_one_sin_ran 67.0650 4 65.4050 .0600
- :fm-index 2.0207 :reverb-amount .1
- :amp-env tap :noise-amount .0010)
+ :fm-index 2.0207 :reverb-amount .1
+ :amp-env tap :noise-amount .0010)
(current-score-time 73)
(vln_one_sin_ran 73.0100 .9000 3135.9200 .1600
- :fm-index 2.1204 :reverb-amount .0024
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.1204 :reverb-amount .0024
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 73.0100 .4500 1567.9600 .1600
- :fm-index 2.0691 :reverb-amount .0025
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
- :noise-amount .0100)
+ :fm-index 2.0691 :reverb-amount .0025
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 73.0200 .9000 6271.8400 .1600
- :fm-index 2.2081 :reverb-amount .0022
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.2081 :reverb-amount .0022
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 73.0250 .9000 783.9800 .1600
- :fm-index 1.8719 :reverb-amount .0022
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.8719 :reverb-amount .0022
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 73.0300 .2700 783.9800 .1600
- :fm-index 1.9705 :reverb-amount .0020
- :amp-env '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.9705 :reverb-amount .0020
+ :amp-env
+ '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 73.0300 .6300 1567.9600 .1600
- :fm-index 1.6778 :reverb-amount .0021
- :amp-env '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.6778 :reverb-amount .0021
+ :amp-env
+ '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 73.0400 .9000 391.9900 .1600
- :fm-index 1.9558 :reverb-amount .0023
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.9558 :reverb-amount .0023
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 73.0450 .4500 195.9950 .1600
- :fm-index 2.1344 :reverb-amount .0027
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
- :noise-amount .0100)
+ :fm-index 2.1344 :reverb-amount .0027
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 73.0500 2 783.9800 .1600
- :reverb-amount .0100 :amp-env tap :noise-amount .0090)
+ :reverb-amount .0100 :amp-env tap :noise-amount .0090)
(vln_one_sin_ran 73.0500 1 1567.9600 .1600
- :reverb-amount .0100 :amp-env tap :noise-amount .0090)
+ :reverb-amount .0100 :amp-env tap :noise-amount .0090)
(vln_one_sin_ran 73.0600 2 391.9900 .1600
- :reverb-amount .0100 :amp-env tap :noise-amount .0090)
+ :reverb-amount .0100 :amp-env tap :noise-amount .0090)
(vln_one_sin_ran 73.0650 1 783.9800 .1600
- :reverb-amount .0100 :amp-env tap :noise-amount .0090)
+ :reverb-amount .0100 :amp-env tap :noise-amount .0090)
(vln_one_sin_ran 73.0700 2 195.9950 .1600
- :reverb-amount .0100 :amp-env tap :noise-amount .0040)
+ :reverb-amount .0100 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 73.0700 1 1567.9600 .1600
- :reverb-amount .0100 :amp-env tap :noise-amount .0040)
+ :reverb-amount .0100 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 73.0800 1 784.9800 .1600
- :reverb-amount .0100 :amp-env tap :noise-amount .0040)
+ :reverb-amount .0100 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 73.0850 2 391.9900 .1600
- :reverb-amount .0100 :amp-env tap :noise-amount .0040)
+ :reverb-amount .0100 :amp-env tap :noise-amount .0040)
(current-score-time 79)
(vln_one_sin_ran 79.0100 .9000 97.9975 .1
- :fm-index 2.0885 :reverb-amount .0031
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.0885 :reverb-amount .0031
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 79.0100 1.8000 48.9988 .1
- :fm-index 2.2269 :reverb-amount .0026
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0100)
+ :fm-index 2.2269 :reverb-amount .0026
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 79.0200 .9000 195.9950 .1
- :fm-index 2.0305 :reverb-amount .0032
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.0305 :reverb-amount .0032
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 79.0250 .9000 24.4994 .1
- :fm-index 2.4934 :reverb-amount .0025
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.4934 :reverb-amount .0025
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 79.0300 1.8000 97.9975 .1
- :fm-index 2.4039 :reverb-amount .0023
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0400)
+ :fm-index 2.4039 :reverb-amount .0023
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0400)
(vln_one_sin_ran 79.0300 .9000 195.9950 .1
- :fm-index 1.5159 :reverb-amount .0021
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0400)
+ :fm-index 1.5159 :reverb-amount .0021
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0400)
(vln_one_sin_ran 79.0300 .9000 392.9900 .1
- :fm-index 2.2122 :reverb-amount .0028
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0400)
+ :fm-index 2.2122 :reverb-amount .0028
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0400)
(vln_one_sin_ran 79.0300 1.8000 784.9800 .1
- :fm-index 2.1574 :reverb-amount .0020
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0400)
+ :fm-index 2.1574 :reverb-amount .0020
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0400)
(vln_one_sin_ran 79.0300 2.7000 24.4994 .1
- :fm-index 2.1963 :reverb-amount .0031
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.1963 :reverb-amount .0031
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 79.0300 1.8000 48.9988 .1
- :fm-index 1.9761 :reverb-amount .0032
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0100)
+ :fm-index 1.9761 :reverb-amount .0032
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 79.0400 2.7000 12.2497 .1
- :fm-index 1.5088 :reverb-amount .0021
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.5088 :reverb-amount .0021
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 79.0450 1.8000 6.1248 .1
- :fm-index 1.7384 :reverb-amount .0021
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0100)
+ :fm-index 1.7384 :reverb-amount .0021
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 79.0500 2 24.4994 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0040)
+ :reverb-amount .1 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 79.0500 1 48.9988 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0040)
+ :reverb-amount .1 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 79.0600 2 12.2497 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0040)
+ :reverb-amount .1 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 79.0650 1 24.4994 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0040)
+ :reverb-amount .1 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 79.0700 2 6.1248 .1
- :fm-index 1.2474 :reverb-amount .1 :amp-env tap
- :noise-amount .0040)
+ :fm-index 1.2474 :reverb-amount .1 :amp-env tap
+ :noise-amount .0040)
(vln_one_sin_ran 79.0700 1 48.9988 .1
- :fm-index .7526 :reverb-amount .1 :amp-env tap
- :noise-amount .0040)
+ :fm-index .7526 :reverb-amount .1 :amp-env tap
+ :noise-amount .0040)
(vln_one_sin_ran 79.0800 1 25.4994 .1
- :fm-index 1.1080 :reverb-amount .1 :amp-env tap
- :noise-amount .0040)
+ :fm-index 1.1080 :reverb-amount .1 :amp-env tap
+ :noise-amount .0040)
(vln_one_sin_ran 79.0850 2 12.2497 .1
- :fm-index 1.0859 :reverb-amount .1 :amp-env tap
- :noise-amount .0040)
+ :fm-index 1.0859 :reverb-amount .1 :amp-env tap
+ :noise-amount .0040)
(vln_one_sin_ran 79.0900 4 97.9975 .1
- :fm-index 2.4788 :reverb-amount .1 :amp-env tap
- :noise-amount .0040)
+ :fm-index 2.4788 :reverb-amount .1 :amp-env tap
+ :noise-amount .0040)
(vln_one_sin_ran 79.0900 3 48.9988 .1
- :fm-index 1.8980 :reverb-amount .1 :amp-env tap
- :noise-amount .0040)
+ :fm-index 1.8980 :reverb-amount .1 :amp-env tap
+ :noise-amount .0040)
(vln_one_sin_ran 79.0900 3 25.4994 .1
- :fm-index 2.1151 :reverb-amount .1 :amp-env tap
- :noise-amount .0040)
+ :fm-index 2.1151 :reverb-amount .1 :amp-env tap
+ :noise-amount .0040)
(vln_one_sin_ran 79.0950 5 12.2497 .1
- :fm-index 2.3224 :reverb-amount .1 :amp-env tap
- :noise-amount .0040)
+ :fm-index 2.3224 :reverb-amount .1 :amp-env tap
+ :noise-amount .0040)
(current-score-time 85)
(vln_one_sin_ran 85.2100 .9000 123.4725 .1
- :reverb-amount .0031
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :reverb-amount .0031
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 85.2100 1.8000 61.7363 .1
- :reverb-amount .0023
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0100)
+ :reverb-amount .0023
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 85.2200 .9000 246.9450 .1
- :reverb-amount .0023
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :reverb-amount .0023
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 85.2250 .9000 30.8681 .1
- :reverb-amount .0026
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :reverb-amount .0026
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 85.2300 1.8000 123.4725 .1
- :reverb-amount .0027
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0400)
+ :reverb-amount .0027
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0400)
(vln_one_sin_ran 85.2300 .9000 246.9450 .1
- :reverb-amount .0026
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0400)
+ :reverb-amount .0026
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0400)
(vln_one_sin_ran 85.2300 .9000 494.8900 .1
- :reverb-amount .0020
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0400)
+ :reverb-amount .0020
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0400)
(vln_one_sin_ran 85.2300 1.8000 988.7800 .1
- :reverb-amount .0025
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0400)
+ :reverb-amount .0025
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0400)
(vln_one_sin_ran 85.2300 2.7000 30.8681 .1
- :reverb-amount .0028
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0100)
+ :reverb-amount .0028
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 85.2300 1.8000 61.7363 .1
- :reverb-amount .0023
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0100)
+ :reverb-amount .0023
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 85.2400 2.7000 15.4341 .1
- :reverb-amount .0030
- :amp-env '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
- :noise-amount .0100)
+ :reverb-amount .0030
+ :amp-env
+ '(0 0 .1111 1 4.1470 .6000 9.1919 .3 24.3266 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 85.2450 1.8000 20.5788 .1
- :reverb-amount .0023
- :amp-env '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
- :noise-amount .0100)
+ :reverb-amount .0023
+ :amp-env
+ '(0 0 .1667 1 4.2003 .6000 9.2424 .3 24.3687 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 85.2500 2 30.8681 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0090)
+ :reverb-amount .1 :amp-env tap :noise-amount .0090)
(vln_one_sin_ran 85.2500 1 61.7363 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0090)
+ :reverb-amount .1 :amp-env tap :noise-amount .0090)
(vln_one_sin_ran 85.2600 2 15.4341 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0090)
+ :reverb-amount .1 :amp-env tap :noise-amount .0090)
(vln_one_sin_ran 85.2650 1 30.8681 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0090)
+ :reverb-amount .1 :amp-env tap :noise-amount .0090)
(vln_one_sin_ran 85.2710 2 30.8681 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0040)
+ :reverb-amount .1 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 85.2710 1 61.7363 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0040)
+ :reverb-amount .1 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 85.2810 1 31.8681 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0040)
+ :reverb-amount .1 :amp-env tap :noise-amount .0040)
(vln_one_sin_ran 85.2860 2 15.4341 .1
- :reverb-amount .1 :amp-env tap :noise-amount .0040)
+ :reverb-amount .1 :amp-env tap :noise-amount .0040)
(current-score-time 93)
(vln_one_sin_ran 93.0100 .9000 3135.9200 .1600
- :fm-index 1.7299 :reverb-amount .0026
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.7299 :reverb-amount .0026
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 93.0100 .4500 1464.6987 .1600
- :fm-index 1.9173 :reverb-amount .0027
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
- :noise-amount .0100)
+ :fm-index 1.9173 :reverb-amount .0027
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 93.0200 .9000 6714.0048 .1600
- :fm-index 2.4604 :reverb-amount .0032
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.4604 :reverb-amount .0032
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 93.0250 .9000 684.1190 .1600
- :fm-index 1.9969 :reverb-amount .0021
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.9969 :reverb-amount .0021
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 93.0300 .2700 684.1190 .1600
- :fm-index 2.0022 :reverb-amount .0026
- :amp-env '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.0022 :reverb-amount .0026
+ :amp-env
+ '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 93.0300 .6300 1464.6987 .1600
- :fm-index 2.1058 :reverb-amount .0027
- :amp-env '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.1058 :reverb-amount .0027
+ :amp-env
+ '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 93.0400 .9000 319.5325 .1600
- :fm-index 2.2293 :reverb-amount .0029
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.2293 :reverb-amount .0029
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 93.0450 .4500 149.2445 .1600
- :fm-index 1.5780 :reverb-amount .0025
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
- :noise-amount .0100)
+ :fm-index 1.5780 :reverb-amount .0025
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 93.0500 1 684.1190 .1600
- :reverb-amount .0100 :amp-env yup :noise-amount .0090)
+ :reverb-amount .0100 :amp-env yup :noise-amount .0090)
(vln_one_sin_ran 93.0500 1 1464.6987 .1600
- :reverb-amount .0100 :amp-env yup :noise-amount .0090)
+ :reverb-amount .0100 :amp-env yup :noise-amount .0090)
(vln_one_sin_ran 93.0600 1 319.5325 .1600
- :reverb-amount .0100 :amp-env yup :noise-amount .0090)
+ :reverb-amount .0100 :amp-env yup :noise-amount .0090)
(vln_one_sin_ran 93.0650 1 684.1190 .1600
- :reverb-amount .0100 :amp-env yup :noise-amount .0090)
+ :reverb-amount .0100 :amp-env yup :noise-amount .0090)
(vln_one_sin_ran 93.0700 1 149.2445 .1600
- :reverb-amount .0100 :amp-env yup :noise-amount .0040)
+ :reverb-amount .0100 :amp-env yup :noise-amount .0040)
(vln_one_sin_ran 93.0700 1 1464.6987 .1600
- :reverb-amount .0100 :amp-env yup :noise-amount .0040)
+ :reverb-amount .0100 :amp-env yup :noise-amount .0040)
(vln_one_sin_ran 93.0800 1 561.6022 .160
- 0 :reverb-amount .0100 :amp-env yup :noise-amount .0040)
+ :reverb-amount .0100 :amp-env yup :noise-amount .0040)
(vln_one_sin_ran 93.0850 1 319.5325 .1600
- :reverb-amount .0100 :amp-env yup :noise-amount .0040)
+ :reverb-amount .0100 :amp-env yup :noise-amount .0040)
(current-score-time 96)
(vln_one_sin_ran 96.0100 .9000 3135.9200 .1600
- :fm-index 1.6329 :reverb-amount .0031
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.6329 :reverb-amount .0031
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0100 .4500 1810.5774 .1600
- :fm-index 1.8298 :reverb-amount .0031
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
- :noise-amount .0100)
+ :fm-index 1.8298 :reverb-amount .0031
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0200 .9000 5431.4135 .1600
- :fm-index 2.1640 :reverb-amount .0022
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.1640 :reverb-amount .0022
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0250 .9000 1045.3680 .1600
- :fm-index 1.6971 :reverb-amount .0032
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.6971 :reverb-amount .0032
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0300 .2700 1045.3680 .1600
- :fm-index 2.4855 :reverb-amount .0028
- :amp-env '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.4855 :reverb-amount .0028
+ :amp-env
+ '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0300 .6300 1810.5774 .1600
- :fm-index 2.1604 :reverb-amount .0020
- :amp-env '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.1604 :reverb-amount .0020
+ :amp-env
+ '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0400 .9000 603.5612 .1600
- :fm-index 2.4204 :reverb-amount .0031
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.4204 :reverb-amount .0031
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0450 .4500 348.4765 .1600
- :fm-index 2.3918 :reverb-amount .0026
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
- :noise-amount .0100)
+ :fm-index 2.3918 :reverb-amount .0026
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0460 .9000 201.1989 .1600
- :fm-index 1.5205 :reverb-amount .0024
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.5205 :reverb-amount .0024
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0460 .9000 116.1656 .1600
- :fm-index 2.3049 :reverb-amount .0028
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.3049 :reverb-amount .0028
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0500 .9000 3135.9200 .1600
- :fm-index 2.4363 :reverb-amount .0021
- :amp-env '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.4363 :reverb-amount .0021
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0500 .4500 1464.6987 .1600
- :fm-index 2.3865 :reverb-amount .0027
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
- :noise-amount .0100)
+ :fm-index 2.3865 :reverb-amount .0027
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0600 .9000 6714.0048 .1600
- :fm-index 1.7354 :reverb-amount .0021
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.7354 :reverb-amount .0021
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0650 .9000 684.1190 .1600
- :fm-index 1.8282 :reverb-amount .0025
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.8282 :reverb-amount .0025
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0700 .2700 684.1190 .1600
- :fm-index 2.3923 :reverb-amount .0025
- :amp-env
- '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.3923 :reverb-amount .0025
+ :amp-env
+ '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0700 .6300 1464.6987 .1600
- :fm-index 2.2789 :reverb-amount .0028
- :amp-env
- '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.2789 :reverb-amount .0028
+ :amp-env
+ '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0800 .9000 319.5325 .1600
- :fm-index 1.5438 :reverb-amount .0027
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.5438 :reverb-amount .0027
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0850 .4500 149.2445 .1600
- :fm-index 2.4210 :reverb-amount .0028
- :amp-env
- '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
- :noise-amount .0100)
+ :fm-index 2.4210 :reverb-amount .0028
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0860 .9000 69.7078 .1600
- :fm-index 2.0288 :reverb-amount .0029
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 2.0288 :reverb-amount .0029
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(vln_one_sin_ran 96.0860 .9000 32.5585 .1600
- :fm-index 1.8254 :reverb-amount .0028
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
- :noise-amount .0100)
+ :fm-index 1.8254 :reverb-amount .0028
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0)
+ :noise-amount .0100)
(set! fm-violin-reverb-amount 0.0)
(set! fm-violin-noise-amount 0.01)
(current-score-time 99)
(vln_one_sin_ran 99.0500 .9000 3135.9200 .1600 :fm-index 1.7334
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.0500 .4500 1810.5774 .1600 :fm-index 2.3629
- :amp-env
- '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
(vln_one_sin_ran 99.0600 .9000 5431.4135 .1600 :fm-index 2.2744
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.0650 .9000 1045.3680 .1600 :fm-index 1.8722
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.1100 .2700 1045.3680 .1600 :fm-index 2.3139
- :amp-env
- '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0))
+ :amp-env
+ '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0))
(vln_one_sin_ran 99.1100 .6300 1810.5774 .1600 :fm-index 1.6216
- :amp-env
- '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0))
+ :amp-env
+ '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0))
(vln_one_sin_ran 99.1200 .9000 603.5612 .1600 :fm-index 1.5308
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.1650 .4500 348.4765 .1600 :fm-index 2.0346
- :amp-env
- '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
(vln_one_sin_ran 99.1660 .9000 201.1989 .1600 :fm-index 1.8176
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.1660 .9000 116.1656 .1600 :fm-index 1.7145
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.1700 .9000 3135.9200 .1600 :fm-index 2.4459
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.1700 .4500 1464.6987 .1600 :fm-index 2.4644
- :amp-env
- '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
(vln_one_sin_ran 99.1800 .9000 6714.0048 .1600 :fm-index 1.9985
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.1850 .9000 684.1190 .1600 :fm-index 2.4542
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.2900 .2700 684.1190 .1600 :fm-index 2.3391
- :amp-env
- '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0))
+ :amp-env
+ '(0 0 1.1111 1 5.1066 .6000 10.1010 .3 25.0842 .1 100.0 0))
(vln_one_sin_ran 99.2900 .6300 1464.6987 .1600 :fm-index 1.5138
- :amp-env
- '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0))
+ :amp-env
+ '(0 0 .4762 1 4.4974 .6000 9.5238 .3 24.6032 .1 100.0 0))
(vln_one_sin_ran 99.3000 .9000 319.5325 .1600 :fm-index 1.5440
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.3050 .4500 149.2445 .1600 :fm-index 2.2283
- :amp-env
- '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
(vln_one_sin_ran 99.3060 .9000 69.7078 .1600 :fm-index 1.9498
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin_ran 99.3060 .9000 32.5585 .1600 :fm-index 2.2943
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(restore-fm-violin-defaults)
(set! fm-violin-amp-env metalamp)
@@ -1382,176 +1501,186 @@
(restore-fm-violin-defaults)
(current-score-time 166)
- (vln_one_sin 166.1200 .4 2092.9600 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
- (vln_one_sin 166.1200 .5 2088.7820 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
- (vln_one_sin 166.1200 .3 2097.1460 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
- (vln_one_sin 166.1200 .5 2084.6130 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
- (vln_one_sin 166.1210 .3 1048.5730 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
- (vln_one_sin 166.1220 .3 1040.2260 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
- (vln_one_sin 166.1220 .5 1034.0100 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
- (vln_one_sin 166.1230 .5 1046.4800 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
- (vln_one_sin 166.1240 .3 1044.3900 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1200 .4 2092.9600 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1200 .5 2088.7820 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1200 .3 2097.1460 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1200 .5 2084.6130 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1210 .3 1048.5730 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1220 .3 1040.2260 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1220 .5 1034.0100 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1230 .5 1046.4800 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1240 .3 1044.3900 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
(set! fm-violin-fm1-rat 2.718)
(set! fm-violin-fm2-rat 4.414)
(set! fm-violin-fm3-rat 5.141)
- (vln_one_sin 166.1240 .5 1041.2630 .1600 :fm-index 3 :reverb-amount 0
- :amp-env metalamp :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
+ (vln_one_sin 166.1240 .5 1041.2630 .1600 :fm-index 3
+ :reverb-amount 0 :amp-env metalamp
+ :fm2-rat 1.1410 :fm3-rat 3.1410 :fm1-rat 2.7180)
(current-score-time 168)
(vln_one_sin_ran 168.4880 1.1770 416.6072 .0110 :fm-index 1.1140
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 168.5050 2.4900 859.5863 .0083 :fm-index .5890
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 169.0590 1.0550 1758.0816 .0053 :fm-index 1.8640
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 169.0930 1.8580 229.0566 .0110 :fm-index 1.9690
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 169.3490 3.3680 479.1994 .0083 :fm-index 1.9970
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 169.5010 3.0680 411.8241 .0110 :fm-index 1.5390
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 169.5200 2.8290 984.8456 .0053 :fm-index .0560
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 169.6100 .7040 1767.7444 .0053 :fm-index 1.2620
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 169.8480 3.0510 859.7203 .0083 :fm-index 1.6080
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 170.4880 3.2350 231.9431 .0110 :fm-index .9690
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 170.5610 3.2810 475.2009 .0083 :fm-index .3740
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 170.7970 2.8400 988.8375 .0053 :fm-index .4200
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 171.0620 1.0210 411.7247 .0110 :fm-index .1370
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 171.2130 1.1610 848.5959 .0083 :fm-index 1.3120
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 171.4410 2.6160 390.0600 .0110 :fm-index 1.9030
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 171.4490 .7000 802.3538 .0083 :fm-index 1.5940
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 171.5270 2.5080 1773.9366 .0053 :fm-index 1.8030
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 171.7820 2.7990 232.4344 .0110 :fm-index .0590
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 171.7830 2.7660 1650.1434 .0053 :fm-index .4400
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 171.7890 3.1560 475.7231 .0083 :fm-index .7370
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 172.1540 2.1290 976.0237 .0053 :fm-index 1.2690
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 172.4890 3.3650 390.0525 .0110 :fm-index 1.4580
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 172.7450 1.5070 1665.9722 .0053 :fm-index 1.9330
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 172.8320 1.4430 798.1238 .0083 :fm-index .8560
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 172.9440 3.1560 229.0528 .0110 :fm-index 1.8300
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 173.3930 1.1100 473.7225 .0083 :fm-index 1.6260
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 173.6970 1.6170 988.7953 .0053 :fm-index .4230
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 174.0620 1.3190 390.9769 .0110 :fm-index .4100
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 174.0840 3.3660 804.6413 .0083 :fm-index 1.8760
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 174.1740 2.7210 418.6819 .0110 :fm-index .0910
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 174.5700 3.4460 845.4019 .0077 :fm-index .7660
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 174.6440 1.1790 1656.5756 .0049 :fm-index .2960
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 174.6600 2.8520 1758.9788 .0049 :fm-index .4520
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 174.8270 1.8840 387.0009 .0099 :fm-index 1.3010
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 174.8870 3.4040 796.7213 .0077 :fm-index 1.1820
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 174.9640 3.3230 416.3916 .0099 :fm-index .6290
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 175.1320 1.7050 1637.2303 .0049 :fm-index 1.0570
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 175.1500 3.1250 1762.4906 .0049 :fm-index 1.3170
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 175.3860 2.9670 852.0487 .0077 :fm-index 1.4790
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 175.6670 .6780 413.7094 .0099 :fm-index .9470
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 175.8780 2.7490 1749.7509 .0049 :fm-index .5040
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 175.9730 .5990 848.1253 .0077 :fm-index 1.9380
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 176.0880 3.3360 229.9144 .0099 :fm-index 1.3930
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 176.1170 1.1300 984.0816 .0049 :fm-index .3560
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 176.4640 1.7330 478.7184 .0077 :fm-index .2840
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 176.5760 .5680 413.4253 .0099 :fm-index 1.5020
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 176.8200 1.2150 230.9588 .0099 :fm-index 1.0990
- :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z1amp :noise-amount .0050)
(vln_one_sin_ran 176.8320 3.4590 473.8903 .0077 :fm-index .7680
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(vln_one_sin_ran 176.8320 .7260 857.2875 .0077 :fm-index .7520
- :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
+ :reverb-amount .1 :amp-env z2amp :noise-amount .0050)
(restore-fm-violin-defaults)
(current-score-time 180)
(violin 180.2600 .0500 80 .8000 :fm-index 5 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2)
+ :amp-env ampfunc1 :fm1-env indfunc2)
(violin 181.2610 .2000 80 .8000 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 182.2600 .0500 80 .8000 :fm-index 5 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2)
+ :amp-env ampfunc1 :fm1-env indfunc2)
(violin 182.2620 .2000 80 .8000 :fm-index 5 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 183.2600 .0500 80 .8000 :fm-index 6 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2)
+ :amp-env ampfunc1 :fm1-env indfunc2)
(violin 183.2630 .2000 80 .8000 :fm-index 6 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 184.2600 .0500 80 .3 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2)
+ :amp-env ampfunc1 :fm1-env indfunc2)
(violin 184.2620 .1 160 .3 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 184.2620 .2500 80 .8000 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 185.2600 .0500 80 .5 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2)
+ :amp-env ampfunc1 :fm1-env indfunc2)
(violin 185.2610 .1 210 .3 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 185.2620 .2000 80 .1 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 185.2630 .2500 320 .1 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 186.2600 .0500 80 .8000 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2)
+ :amp-env ampfunc1 :fm1-env indfunc2)
(violin 186.2610 .1 210 .1 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 186.2620 .2000 80 .2000 :fm-index 4 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 186.2630 .2500 320 .3 :reverb-amount 0 :amp-env ampfunc
- :fm1-env indfunc :fm2-rat .6875)
+ :fm1-env indfunc :fm2-rat .6875)
(violin 187.2600 .0500 80 .8000 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc1 :fm1-env indfunc2)
+ :amp-env ampfunc1 :fm1-env indfunc2)
(violin 187.2610 .1 210 .1 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 187.2620 .2000 80 .2000 :fm-index 2 :reverb-amount 0
- :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
+ :amp-env ampfunc :fm1-env indfunc :fm2-rat .6875)
(violin 187.2630 .2500 320 .3 :reverb-amount 0 :amp-env ampfunc
- :fm1-env indfunc :fm2-rat .6875)
+ :fm1-env indfunc :fm2-rat .6875)
(set! fm-violin-glissando-amount 0.0)
(set! fm-violin-noise-amount 0.004)
@@ -1561,270 +1690,299 @@
(current-score-time 188)
(vln_one_sin_ran 188.2600 4 3286.9937 .1600 :fm-index 2.2165
- :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2603 4 1046.4800 .1600 :fm-index 2.3234
- :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2605 4 2844.3326 .1600 :fm-index 2.4790
- :reverb-amount .1 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .1 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2608 4 821.7484 .1 :fm-index 1.8667
- :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2610 4 261.6200 .1 :fm-index 1.8523
- :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2613 4 711.0832 .1 :fm-index 2.2300
- :reverb-amount .1 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .1 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2615 4 205.4371 .0600 :fm-index 1.5187
- :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2618 4 65.4050 .0600 :fm-index 2.4074
- :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2620 4 177.7708 .0600 :fm-index 2.4481
- :reverb-amount .1 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .1 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2623 4 51.3593 .0100 :fm-index 2.3069
- :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2625 4 16.3513 .0100 :fm-index 2.1008
- :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .0100 :amp-env n_amp :fm1-env n_amp)
(vln_one_sin_ran 188.2628 4 44.4427 .0100 :fm-index 2.4860
- :reverb-amount .1 :amp-env n_amp :fm1-env n_amp)
+ :reverb-amount .1 :amp-env n_amp :fm1-env n_amp)
(restore-fm-violin-defaults)
(current-score-time 196)
- (vln_one_sin 196.2603 1.2000 88.8854 .1 :fm-index 2.3144 :reverb-amount .2000
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
- (vln_one_sin 196.2603 4 88.8854 .1 :fm-index 2.1690 :reverb-amount .2000
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
- (vln_one_sin 196.2605 2.8000 168.1236 .0500 :fm-index 2.1850 :reverb-amount .2000
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
- (vln_one_sin 196.2608 1.2000 168.1236 .0800 :fm-index 1.7743 :reverb-amount .2000
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
- (vln_one_sin 196.2610 2 32.7025 .1 :fm-index 2.4925 :reverb-amount .2000
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
- (vln_one_sin 196.2633 2 32.7025 .1 :fm-index 2.1325 :reverb-amount .2000
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
- (vln_one_sin 196.2643 4 32.7025 .0500 :fm-index 1.7578 :reverb-amount .2000
- :amp-env mamp :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
+ (vln_one_sin 196.2603 1.2000 88.8854 .1 :fm-index 2.3144
+ :reverb-amount .2000 :amp-env mamp
+ :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
+ (vln_one_sin 196.2603 4 88.8854 .1 :fm-index 2.1690
+ :reverb-amount .2000 :amp-env mamp
+ :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
+ (vln_one_sin 196.2605 2.8000 168.1236 .0500 :fm-index 2.1850
+ :reverb-amount .2000 :amp-env mamp
+ :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
+ (vln_one_sin 196.2608 1.2000 168.1236 .0800 :fm-index 1.7743
+ :reverb-amount .2000 :amp-env mamp
+ :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
+ (vln_one_sin 196.2610 2 32.7025 .1 :fm-index 2.4925
+ :reverb-amount .2000 :amp-env mamp
+ :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
+ (vln_one_sin 196.2633 2 32.7025 .1 :fm-index 2.1325
+ :reverb-amount .2000 :amp-env mamp
+ :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
+ (vln_one_sin 196.2643 4 32.7025 .0500 :fm-index 1.7578
+ :reverb-amount .2000 :amp-env mamp
+ :fm2-rat 4.4140 :fm3-rat 5.1410 :fm1-rat 2.7180)
(current-score-time 204)
(vln_one_sin_ran 204.2600 6.6830 244.8160 .0060 :fm-index 2
- :reverb-amount .2000 :noise-amount .0040)
+ :reverb-amount .2000 :noise-amount .0040)
(vln_one_sin_ran 204.2600 5.5170 495.4040 .0060 :fm-index 2
- :reverb-amount .2000 :noise-amount .0040)
+ :reverb-amount .2000 :noise-amount .0040)
(vln_one_sin_ran 204.2600 7.5350 980.6190 .0020 :fm-index 2
- :reverb-amount .2000 :noise-amount .0040)
+ :reverb-amount .2000 :noise-amount .0040)
(vln_one_sin_ran 204.2600 7.1990 1965.4290 .0020 :fm-index .8000
- :reverb-amount .2000 :noise-amount .0040)
+ :reverb-amount .2000 :noise-amount .0040)
(vln_one_sin_ran 204.2600 4.0790 3835.3170 .0020 :fm-index .8000
- :reverb-amount .2000 :noise-amount .0040)
+ :reverb-amount .2000 :noise-amount .0040)
(vln_one_sin_ran 204.5170 4.7400 1320.9670 .0020 :fm-index .8000
- :reverb-amount .2000 :noise-amount .0040)
+ :reverb-amount .2000 :noise-amount .0040)
(vln_one_sin_ran 204.7040 7.2080 655.5670 .0040 :fm-index 2
- :reverb-amount .2000 :noise-amount .0040)
+ :reverb-amount .2000 :noise-amount .0040)
(vln_one_sin_ran 205.0490 6.6530 169.4230 .0040 :fm-index 2
- :reverb-amount .2000 :noise-amount .0040)
+ :reverb-amount .2000 :noise-amount .0040)
(set! fm-violin-glissando-amount 0.0)
(set! fm-violin-reverb-amount .9)
(current-score-time 213)
(vln_one_sin_exp 213.5450 6.4650 366.3330 .0320 :fm-index 1.0480
- :amp-env
- '(0 0 1.5468 1 2.0882 .7000 2.3202 1 98.4532 .7500 100.0 0))
+ :amp-env
+ '(0 0 1.5468 1 2.0882 .7000 2.3202 1 98.4532 .7500 100.0 0))
(vln_one_sin_exp 213.5950 8.4340 1172.5830 .0180 :fm-index 1.1350
- :amp-env
- '(0 0 1.1857 1.0000 1.6007 .7000 1.7785 1 98.8143 .5556 100.0 0))
+ :amp-env
+ '(0 0 1.1857 1.0 1.6007 .7000 1.7785 1 98.8143 .5556 100.0 0))
(vln_one_sin_exp 213.7650 1.6210 369.9940 .0170 :fm-index .0960
- :amp-env
- '(0 0 6.1690 1.0000 8.3282 .7000 9.2535 1.0 93.8310 .5294 100.0 0))
+ :amp-env
+ '(0 0 6.1690 1.0 8.3282 .7000 9.2535 1.0 93.8310 .5294 100.0 0))
(vln_one_sin_exp 213.8820 3.0640 246.9420 .0170 :fm-index .0020
- :amp-env
- '(0 0 3.2637 1 4.4060 .7000 4.8956 1.0000 96.7363 .5294 100.0 0))
+ :amp-env
+ '(0 0 3.2637 1 4.4060 .7000 4.8956 1.0 96.7363 .5294 100.0 0))
(vln_one_sin_exp 213.9250 3.1170 123.4710 .0380 :fm-index .2330
- :amp-env
- '(0 0 3.2082 1 4.3311 .7000 4.8123 1 96.7918 .7895 100.0 0))
+ :amp-env
+ '(0 0 3.2082 1 4.3311 .7000 4.8123 1 96.7918 .7895 100.0 0))
(vln_one_sin_exp 213.9810 3.5670 123.4710 .0420 :fm-index .2330
- :amp-env
- '(0 0 2.8035 1 3.7847 .7000 4.2052 1.0000 97.1965 .8095 100.0 0))
+ :amp-env
+ '(0 0 2.8035 1 3.7847 .7 4.2052 1.0 97.1965 .8095 100.0 0))
(vln_one_sin_exp 214.1280 1.0450 246.9420 .0170 :fm-index 1.2050
- :amp-env
- '(0 0 9.5694 1 12.9187 .7000 14.3541 1 90.4306 .5294 100.0 0))
+ :amp-env
+ '(0 0 9.5694 1 12.9187 .7000 14.3541 1 90.4306 .5294 100.0 0))
(vln_one_sin_exp 214.2550 3.3870 374.1370 .0170 :fm-index .1800
- :amp-env
- '(0 0 2.9525 1.0000 3.9858 .7000 4.4287 1.0 97.0475 .5294 100.0 0))
+ :amp-env
+ '(0 0 2.9525 1.0 3.9858 .7000 4.4287 1.0 97.0475 .5294 100.0 0))
(vln_one_sin_exp 214.2990 8.3050 1576.9120 .0200 :fm-index .2990
- :amp-env
- '(0 0 1.2041 1 1.6255 .7000 1.8061 1 98.7959 .6000 100.0 0))
+ :amp-env
+ '(0 0 1.2041 1 1.6255 .7000 1.8061 1 98.7959 .6000 100.0 0))
(vln_one_sin_exp 214.3300 4.4630 246.9420 .0170 :fm-index .0020
- :amp-env
- '(0 0 2.2406 1 3.0249 .7000 3.3610 1.0000 97.7594 .5294 100.0 0))
+ :amp-env
+ '(0 0 2.2406 1 3.0249 .7 3.3610 1.0 97.7594 .5294 100.0 0))
(vln_one_sin_exp 214.6600 8.9940 1576.9120 .0200 :fm-index .2990
- :amp-env
- '(0 0 1.1119 1 1.5010 .7000 1.6678 1 98.8881 .6000 100.0 0))
+ :amp-env
+ '(0 0 1.1119 1 1.5010 .7000 1.6678 1 98.8881 .6000 100.0 0))
(vln_one_sin_exp 214.9060 8.8360 1172.5830 .0180 :fm-index 1.1350
- :amp-env
- '(0 0 1.1317 1 1.5278 .7000 1.6976 1 98.8683 .5556 100.0 0))
+ :amp-env
+ '(0 0 1.1317 1 1.5278 .7000 1.6976 1 98.8683 .5556 100.0 0))
(vln_one_sin_exp 215.1510 4.9320 374.1370 .0170 :fm-index .1800
- :amp-env
- '(0 0 2.0276 1 2.7372 .7000 3.0414 1 97.9724 .5294 100.0 0))
+ :amp-env
+ '(0 0 2.0276 1 2.7372 .7000 3.0414 1 97.9724 .5294 100.0 0))
(vln_one_sin_exp 215.2720 2.3250 369.9940 .0170 :fm-index 1.1030
- :amp-env
- '(0 0 4.3011 1 5.8065 .7000 6.4516 1 95.6989 .5294 100.0 0))
+ :amp-env
+ '(0 0 4.3011 1 5.8065 .7000 6.4516 1 95.6989 .5294 100.0 0))
(vln_one_sin_exp 216.6960 3.5540 366.3330 .0310 :fm-index 1.0480
- :amp-env
- '(0 0 2.8137 1 3.7985 .7000 4.2206 1 97.1863 .7419 100.0 0))
+ :amp-env
+ '(0 0 2.8137 1 3.7985 .7000 4.2206 1 97.1863 .7419 100.0 0))
(vln_one_sin_exp 217.7240 .6040 246.9420 .0170 :fm-index 1.2050
- :amp-env
- '(0 0 16.5563 1 22.3510 .7000 24.8344 1 83.4437 .5294 100 0))
+ :amp-env
+ '(0 0 16.5563 1 22.3510 .7000 24.8344 1 83.4437 .5294 100 0))
(vln_one_sin_exp 217.9420 2.5010 123.4710 .0330 :fm-index .2330
- :amp-env
- '(0 0 3.9984 1 5.3978 .7000 5.9976 1 96.0016 .7576 100.0 0))
+ :amp-env
+ '(0 0 3.9984 1 5.3978 .7000 5.9976 1 96.0016 .7576 100.0 0))
(vln_one_sin_exp 218.0340 2.3860 246.9420 .0170 :fm-index .0020
- :amp-env
- '(0 0 4.1911 1 5.6580 .7000 6.2867 1 95.8089 .5294 100.0 0))
+ :amp-env
+ '(0 0 4.1911 1 5.6580 .7000 6.2867 1 95.8089 .5294 100.0 0))
(vln_one_sin_exp 218.3850 1.4510 369.9940 .0170 :fm-index 1.1030
- :amp-env
- '(0 0 6.8918 1 9.3039 .7000 10.3377 1 93.1082 .5294 100.0 0))
+ :amp-env
+ '(0 0 6.8918 1 9.3039 .7000 10.3377 1 93.1082 .5294 100.0 0))
(vln_one_sin_exp 218.5670 2.6550 374.1370 .0170 :fm-index .1800
- :amp-env
- '(0 0 3.7665 1 5.0847 .7000 5.6497 1 96.2335 .5294 100.0 0))
+ :amp-env
+ '(0 0 3.7665 1 5.0847 .7000 5.6497 1 96.2335 .5294 100.0 0))
(vln_one_sin_exp 218.9830 2.9860 123.4710 .0380 :fm-index .2330
- :amp-env
- '(0 0 3.3490 1 4.5211 .7000 5.0234 1 96.6510 .7895 100.0 0))
+ :amp-env
+ '(0 0 3.3490 1 4.5211 .7000 5.0234 1 96.6510 .7895 100.0 0))
(vln_one_sin_exp 219.4910 .6110 123.9770 .0170 :fm-index .7550
- :amp-env
- '(0 0 16.3666 1 22.0949 .7000 24.5499 1 83.6334 .5294 100.0 0))
+ :amp-env
+ '(0 0 16.3666 1 22.0949 .7000 24.5499 1 83.6334 .5294 100.0 0))
(vln_one_sin_exp 219.7570 1.4440 123.4710 .0170 :fm-index .0020
- :amp-env
- '(0 0 6.9252 1 9.3490 .7000 10.3878 1 93.0748 .5294 100.0 0))
+ :amp-env
+ '(0 0 6.9252 1 9.3490 .7000 10.3878 1 93.0748 .5294 100.0 0))
(vln_one_sin_exp 219.7750 .5370 92.4435 .0330 :fm-index .9200
- :amp-env
- '(0 0 18.6220 1 25.1397 .7000 27.9330 1 81.3780 .7576 100.0 0))
+ :amp-env
+ '(0 0 18.6220 1 25.1397 .7000 27.9330 1 81.3780 .7576 100.0 0))
(vln_one_sin_exp 219.7750 10.5370 92.4435 .0130 :fm-index .9200
- :amp-env
- '(0 0 .9490 1 1.2812 .7000 1.4236 1 99.0510 .3846 100.0 0))
+ :amp-env
+ '(0 0 .9490 1 1.2812 .7000 1.4236 1 99.0510 .3846 100.0 0))
(vln_one_sin_exp 219.9380 .6520 122.2995 .0170 :fm-index 1.8380
- :amp-env
- '(0 0 15.3374 1 20.7055 .7 23.0061 1 84.6626 .5294 100.0 0))
+ :amp-env
+ '(0 0 15.3374 1 20.7055 .7 23.0061 1 84.6626 .5294 100.0 0))
(vln_one_sin_exp 220.2350 3.7250 586.2915 .0180 :fm-index 1.1350
- :amp-env '(0 0 2.6846 1 3.6242 .7 4.0268 1 97.3154 .5556 100.0 0))
+ :amp-env
+ '(0 0 2.6846 1 3.6242 .7 4.0268 1 97.3154 .5556 100.0 0))
(vln_one_sin_exp 220.2560 2.8900 183.1665 .0260 :fm-index 1.0480
- :amp-env
- '(0 0 3.4602 1 4.6713 .7000 5.1903 1 96.5398 .6923 100.0 0))
+ :amp-env
+ '(0 0 3.4602 1 4.6713 .7000 5.1903 1 96.5398 .6923 100.0 0))
(vln_one_sin_exp 220.2710 1.6210 187.0685 .0170 :fm-index .1800
- :amp-env
- '(0 0 6.1690 1.0000 8.3282 .7000 9.2535 1.0 93.8310 .5294 100.0 0))
+ :amp-env
+ '(0 0 6.1690 1.0 8.3282 .7 9.2535 1.0 93.8310 .5294 100.0 0))
(vln_one_sin_exp 220.2920 2.0160 183.1665 .0290 :fm-index 1.0480
- :amp-env
- '(0 0 4.9603 1 6.6964 .7000 7.4405 1 95.0397 .7241 100.0 0))
+ :amp-env
+ '(0 0 4.9603 1 6.6964 .7000 7.4405 1 95.0397 .7241 100.0 0))
(vln_one_sin_exp 220.2920 12.0160 183.1665 .0290 :fm-index 1.0480
- :amp-env
- '(0 0 .8322 1 1.1235 .7000 1.2483 1.0000 99.1678 .7241 100.0 0))
+ :amp-env
+ '(0 0 .8322 1 1.1235 .7000 1.2483 1.0000 99.1678 .7241 100.0 0))
(vln_one_sin_exp 220.3300 .7300 184.9970 .0170 :fm-index .0960
- :amp-env
- '(0 0 13.6986 1 18.4932 .7000 20.5479 1.0000 86.3014 .5294 100 0))
+ :amp-env
+ '(0 0 13.6986 1 18.4932 .7 20.5479 1.0 86.3014 .5294 100 0))
(vln_one_sin_exp 220.3570 1.9600 183.1665 .0280 :fm-index 1.0480
- :amp-env
- '(0 0 5.1020 1.0 6.8878 .7 7.6531 1.0 94.8980 .7143 100.0 0))
+ :amp-env
+ '(0 0 5.1020 1.0 6.8878 .7 7.6531 1.0 94.8980 .7143 100.0 0))
(vln_one_sin_exp 220.3820 2.2450 61.7355 .0330 :fm-index .2330
- :amp-env
- '(0 0 4.4543 1 6.0134 .7000 6.6815 1 95.5457 .7576 100.0 0))
+ :amp-env
+ '(0 0 4.4543 1 6.0134 .7000 6.6815 1 95.5457 .7576 100.0 0))
(vln_one_sin_exp 220.3820 12.2450 61.7355 .0330 :fm-index .2330
- :amp-env
- '(0 0 .8167 1 1.1025 .7000 1.2250 1 99.1833 .7576 100.0 0))
+ :amp-env
+ '(0 0 .8167 1 1.1025 .7000 1.2250 1 99.1833 .7576 100.0 0))
(vln_one_sin_exp 220.5410 3.0130 246.5050 .0360 :fm-index 1.1350
- :amp-env
- '(0 0 3.3190 1.0000 4.4806 .7000 4.9784 1.0 96.6810 .7778 100.0 0))
+ :amp-env
+ '(0 0 3.3190 1.0 4.4806 .7 4.9784 1.0 96.6810 .7778 100.0 0))
(vln_one_sin_exp 220.5570 2.3220 1251.5960 .0400 :fm-index .2990
- :amp-env
- '(0 0 4.3066 1 5.8140 .7000 6.4599 1 95.6934 .8000 100.0 0))
+ :amp-env
+ '(0 0 4.3066 1 5.8140 .7000 6.4599 1 95.6934 .8000 100.0 0))
(vln_one_sin_exp 220.5570 18.3220 1251.5960 .0200 :fm-index .2990
- :amp-env
- '(0 0 .5458 1.0000 .7368 .7000 .8187 1 99.4542 .6000 100.0 0))
- (vln_one_sin 220.5600 13.8770 3951.1200 .0060 :fm-index .5 :amp-env updown)
- (vln_one_sin 220.7600 17.8770 493.8900 .0170 :fm-index .5280 :amp-env updown)
+ :amp-env
+ '(0 0 .5458 1.0000 .7368 .7000 .8187 1 99.4542 .6000 100.0 0))
+ (vln_one_sin 220.5600 13.8770 3951.1200 .0060 :fm-index .5
+ :amp-env updown)
+ (vln_one_sin 220.7600 17.8770 493.8900 .0170 :fm-index .5280
+ :amp-env updown)
(vln_one_sin_exp 221.1060 1.9900 183.1665 .0230 :fm-index 1.0480
- :amp-env
- '(0 0 5.0251 1.0000 6.7839 .7000 7.5377 1 94.9749 .6522 100.0 0))
- (vln_one_sin 221.1600 13.8770 1975.5600 .0110 :fm-index 1.2000 :amp-env updown)
+ :amp-env
+ '(0 0 5.0251 1.0 6.7839 .7 7.5377 1 94.9749 .6522 100.0 0))
+ (vln_one_sin 221.1600 13.8770 1975.5600 .0110 :fm-index 1.2000
+ :amp-env updown)
(vln_one_sin_exp 221.2570 1.9180 61.7355 .0330 :fm-index .2330
- :amp-env
- '(0 0 5.2138 1 7.0386 .7000 7.8206 1 94.7862 .7576 100.0 0))
- (vln_one_sin 221.2600 15.8770 246.9450 .0170 :fm-index .5280 :amp-env updown)
+ :amp-env
+ '(0 0 5.2138 1 7.0386 .7000 7.8206 1 94.7862 .7576 100.0 0))
+ (vln_one_sin 221.2600 15.8770 246.9450 .0170 :fm-index .5280
+ :amp-env updown)
(vln_one_sin_exp 221.6370 1.3090 183.1665 .0310 :fm-index 1.0480
- :amp-env
- '(0 0 7.6394 1 10.3132 .7000 11.4591 1 92.3606 .7419 100.0 0))
- (vln_one_sin 221.8600 16.8770 987.7800 .0130 :fm-index 1.5000 :amp-env updown)
+ :amp-env
+ '(0 0 7.6394 1 10.3132 .7000 11.4591 1 92.3606 .7419 100.0 0))
+ (vln_one_sin 221.8600 16.8770 987.7800 .0130 :fm-index 1.5000
+ :amp-env updown)
(vln_one_sin_exp 222.0330 1.1590 183.1665 .0250 :fm-index 1.0480
- :amp-env '(0 0 8.6281 1 11.648 .7 12.9422 1.0 91.3719 .68 100.0 0))
+ :amp-env
+ '(0 0 8.6281 1 11.648 .7 12.9422 1.0 91.3719 .68 100.0 0))
(vln_one_sin 222.0600 13.8770 3951.1200 .0090 :amp-env updown)
(vln_one_sin_exp 222.0980 1.2400 30.8675 .0330 :fm-index .2330
- :amp-env
- '(0 0 8.0645 1 10.8871 .7000 12.0968 1 91.9355 .7576 100.0 0))
+ :amp-env
+ '(0 0 8.0645 1 10.8871 .7000 12.0968 1 91.9355 .7576 100.0 0))
(vln_one_sin_exp 222.0980 11.2400 30.8675 .0130 :fm-index .2330
- :amp-env
- '(0 0 .8897 1 1.2011 .7000 1.3345 1 99.1103 .3846 100.0 0))
+ :amp-env
+ '(0 0 .8897 1 1.2011 .7000 1.3345 1 99.1103 .3846 100.0 0))
(vln_one_sin_exp 222.1260 .2600 123.4710 .0170 :fm-index 1.2050
- :amp-env
- '(0 0 38.4615 1 51.9231 .7000 57.6923 1 61.5385 .5294 100.0 0))
+ :amp-env
+ '(0 0 38.4615 1 51.9231 .7000 57.6923 1 61.5385 .5294 100.0 0))
(vln_one_sin_exp 222.1260 10.2600 123.4710 .0170 :fm-index 1.2050
- :amp-env
- '(0 0 .9747 1 1.3158 .7000 1.4620 1 99.0253 .5294 100.0 0))
- (vln_one_sin 222.2600 14.8770 123.4725 .0170 :fm-index 1.5000 :amp-env updown)
- (vln_one_sin 222.2600 13.8770 61.7363 .0170 :fm-index 1.5000 :amp-env updown)
- (vln_one_sin 222.2600 12.8770 30.8681 .0170 :fm-index 1.5000 :amp-env updown)
- (vln_one_sin 222.2600 11.8770 15.4341 .0170 :fm-index 1.5000 :amp-env updown)
+ :amp-env
+ '(0 0 .9747 1 1.3158 .7000 1.4620 1 99.0253 .5294 100.0 0))
+ (vln_one_sin 222.2600 14.8770 123.4725 .0170 :fm-index 1.5000
+ :amp-env updown)
+ (vln_one_sin 222.2600 13.8770 61.7363 .0170 :fm-index 1.5000
+ :amp-env updown)
+ (vln_one_sin 222.2600 12.8770 30.8681 .0170 :fm-index 1.5000
+ :amp-env updown)
+ (vln_one_sin 222.2600 11.8770 15.4341 .0170 :fm-index 1.5000
+ :amp-env updown)
(restore-fm-violin-defaults)
(current-score-time 241)
- (cel_one_sum 241.2620 .3906 440 .4500 :fm-index 1.2000 :reverb-amount .0013
- :amp-env '(0 0 .7680 1 4.7774 .6000 9.7891 .3 24.8243 .1 100 0))
- (cel_one_sum 241.2640 .5220 220 .4500 :fm-index 1.2000 :reverb-amount .0012
- :amp-env
- '(0 0 .5747 1.0000 4.5919 .6000 9.6134 .3 24.6778 .1 100 0))
- (cel_one_sum 241.2660 1.5660 880 .4500 :fm-index 1.2000 :reverb-amount .0014
- :amp-env
- '(0 0 .1916 1.0000 4.2242 .6000 9.2651 .3 24.3876 .1 100.0 0))
- (cel_one_sum 241.2680 1.5660 110 .4500 :fm-index 1.2000 :reverb-amount .0013
- :amp-env
- '(0 0 .1916 1.0000 4.2242 .6000 9.2651 .3 24.3876 .1 100.0 0))
+ (cel_one_sum 241.2620 .3906 440 .4500 :fm-index 1.2000
+ :reverb-amount .0013
+ :amp-env
+ '(0 0 .7680 1 4.7774 .6000 9.7891 .3 24.8243 .1 100 0))
+ (cel_one_sum 241.2640 .5220 220 .4500 :fm-index 1.2000
+ :reverb-amount .0012
+ :amp-env
+ '(0 0 .5747 1.0000 4.5919 .6000 9.6134 .3 24.6778 .1 100 0))
+ (cel_one_sum 241.2660 1.5660 880 .4500 :fm-index 1.2000
+ :reverb-amount .0014
+ :amp-env
+ '(0 0 .1916 1.0000 4.2242 .6000 9.2651 .3 24.3876 .1 100.0 0))
+ (cel_one_sum 241.2680 1.5660 110 .4500 :fm-index 1.2000
+ :reverb-amount .0013
+ :amp-env
+ '(0 0 .1916 1.0000 4.2242 .6000 9.2651 .3 24.3876 .1 100.0 0))
(current-score-time 244)
(vln_one_sin 244.8600 .9000 733.3330 .1875
- :fm-index .2000 :distance 1 :reverb-amount .0012
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :fm-index .2000 :distance 1 :reverb-amount .0012
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin 244.8600 .2250 550 .1875
- :fm-index .2000 :distance 1 :reverb-amount .0015
- :amp-env
- '(0 0 1.3333 1 5.3199 .6000 10.3030 .3 25.2525 .1 100 0))
+ :fm-index .2000 :distance 1 :reverb-amount .0015
+ :amp-env
+ '(0 0 1.3333 1 5.3199 .6000 10.3030 .3 25.2525 .1 100 0))
(vln_one_sin 244.8600 .4500 586.6670 .3750
- :fm-index .2000 :distance 1 :reverb-amount .0013
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
+ :fm-index .2000 :distance 1 :reverb-amount .0013
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
(vln_one_sin 244.9020 .9000 733.3330 .1875
- :fm-index .4 :distance 1 :reverb-amount .0013
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :fm-index .4 :distance 1 :reverb-amount .0013
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin 244.9020 .2250 550 .1875
- :fm-index .4 :distance 1 :reverb-amount .0010
- :amp-env
- '(0 0 1.3333 1 5.3199 .6000 10.3030 .3 25.2525 .1 100 0))
+ :fm-index .4 :distance 1 :reverb-amount .0010
+ :amp-env
+ '(0 0 1.3333 1 5.3199 .6000 10.3030 .3 25.2525 .1 100 0))
(vln_one_sin 244.9020 .4500 586.6670 .3750
- :fm-index .4 :distance 1 :reverb-amount .0015
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
+ :fm-index .4 :distance 1 :reverb-amount .0015
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
(vln_one_sin 244.9430 .9000 366.6670 .1875
- :fm-index .6000 :distance 1 :reverb-amount .0016
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :fm-index .6000 :distance 1 :reverb-amount .0016
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin 244.9430 .2250 275 .1875
- :fm-index .6000 :distance 1 :reverb-amount .0015
- :amp-env
- '(0 0 1.3333 1 5.3199 .6000 10.3030 .3 25.2525 .1 100 0))
+ :fm-index .6000 :distance 1 :reverb-amount .0015
+ :amp-env
+ '(0 0 1.3333 1 5.3199 .6000 10.3030 .3 25.2525 .1 100 0))
(vln_one_sin 244.9430 .4500 293.3340 .3750
- :fm-index .6000 :distance 1 :reverb-amount .0015
- :amp-env '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
+ :fm-index .6000 :distance 1 :reverb-amount .0015
+ :amp-env
+ '(0 0 .6667 1 4.6801 .6000 9.6970 .3 24.7475 .1 100 0))
(vln_one_sin 244.9850 .9000 733.3330 .1875
- :fm-index .8000 :distance 1 :reverb-amount .0010
- :amp-env
- '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
+ :fm-index .8000 :distance 1 :reverb-amount .0010
+ :amp-env
+ '(0 0 .3333 1 4.3603 .6000 9.3939 .3 24.4950 .1 100.0 0))
(vln_one_sin 244.9850 .2250 550 .1875
- :fm-index .8000 :distance 1 :reverb-amount .0013
- :amp-env
- '(0 0 1.3333 1 5.3199 .6000 10.3030 .3 25.2525 .1 100 0))))
+ :fm-index .8000 :distance 1 :reverb-amount .0013
+ :amp-env
+ '(0 0 1.3333 1 5.3199 .6000 10.3030 .3 25.2525 .1 100 0))))
+
+(main)
+(exit 0)
;; fmviolin.scm ends here
diff --git a/sndins/samples/ws_s.scm b/sndins/samples/ws_s.scm
deleted file mode 100644
index da8f335..0000000
--- a/sndins/samples/ws_s.scm
+++ /dev/null
@@ -1,112 +0,0 @@
-;;; ws_s.scm -- simple with-sound for stand-alone execution (w/o Snd)
-;; it's mostly taken from snd/ws.scm
-
-;; This file is part of Sndins.
-
-(use-modules (ice-9 format) (ice-9 optargs))
-
-(if (not (provided? "sndlib")) (load-extension "libsndlib" "init_sndlib"))
-(if (not (provided? "sndins")) (load-extension "libsndins" "init_sndins"))
-
-(define *clm-srate* 22050)
-(define *clm-file-name* "test.snd")
-(define *clm-channels* 1)
-(define *clm-data-format* mus-bshort)
-(define *clm-header-type* mus-next)
-(define *clm-verbose* #f)
-(define *to-snd* #t)
-
-(define *reverb* #f) ; these are sample->file (outa) gens
-(define *output* #f)
-(define *clm-delete-reverb* #f) ; should with-sound clean up reverb stream
-
-(define *clm-play* #f)
-(define *clm-statistics* #f)
-(define *clm-reverb-channels* 1)
-(define *clm-reverb* jc-reverb)
-(define *clm-reverb-data* '())
-
-(if (not (defined? 'definstrument)) (define definstrument define*))
-
-(define* (with-sound-helper thunk
- #:key (srate *clm-srate*)
- (output *clm-file-name*)
- (channels *clm-channels*)
- (header-type *clm-header-type*)
- (data-format *clm-data-format*)
- (comment #f)
- (reverb *clm-reverb*)
- (revfile "test.rev")
- (reverb-data *clm-reverb-data*)
- (continue-old-file #f)
- (statistics *clm-statistics*)
- (scaled-to #f)
- (reverb-channels *clm-reverb-channels*)
- (play *clm-play*)
- (to-snd *to-snd*)
- (scaled-by #f))
- (let ((old-srate (mus-srate))
- (old-output *output*)
- (old-reverb *reverb*)
- (output-1 output)) ; protect during nesting
- (dynamic-wind
-
- (lambda ()
- (set! (mus-srate) srate))
-
- (lambda ()
-
- (if continue-old-file
- (begin
- (set! *output* (continue-sample->file output-1))
- (set! (mus-srate) (mus-sound-srate output-1))
- (if reverb (set! *reverb* (continue-sample->file revfile)))
- (let ((ind (find-sound output-1)))
- (if ind (close-sound ind))))
- (begin
- (if (file-exists? output-1) (delete-file output-1))
- (if (and reverb (file-exists? revfile)) (delete-file revfile))
- (set! *output* (make-sample->file output-1 channels data-format header-type comment))
- (if reverb (set! *reverb* (make-sample->file revfile reverb-channels data-format header-type)))))
- (let ((start (if statistics (get-internal-real-time)))
- (intp #f)
- (cycles 0))
- (catch 'interrupted
- thunk
- (lambda args
- (begin
- (set! intp #t)
- (format #t "interrupted!")
- args)))
- (if (and reverb (not intp))
- (begin
- (mus-close *reverb*)
- (set! *reverb* (make-file->sample revfile))
- (apply reverb reverb-data)
- (mus-close *reverb*)
- (if *clm-delete-reverb* (delete-file revfile))))
- (mus-close *output*)
- (if statistics
- (set! cycles (/ (- (get-internal-real-time) start) 100)))
- (if to-snd
- (let ((max-amp (mus-sound-maxamp output-1)))
- (if statistics
- (format #t "~A:~% maxamp: ~A~% compute time: ~A~%" output-1 max-amp cycles))
- (if play (system (format #f "sndplay ~A" output-1)))))
- output-1))
-
- (lambda ()
- (if *reverb*
- (begin
- (mus-close *reverb*)
- (set! *reverb* old-reverb)))
- (if *output*
- (begin
- (mus-close *output*)
- (set! *output* old-output)))
- (set! (mus-srate) old-srate)))))
-
-(defmacro with-sound (args . body)
- `(with-sound-helper (lambda () , at body) , at args))
-
-;; ws_s.scm ends here
diff --git a/sndins/sndins.c b/sndins/sndins.c
index 4b7fffa..78bae2c 100644
--- a/sndins/sndins.c
+++ b/sndins/sndins.c
@@ -1,6 +1,6 @@
/* sndins.c -- Sndins for Snd/CLM
*
- * Copyright (c) 2003--2009 Michael Scholz <mi-scholz at users.sourceforge.net>
+ * Copyright (c) 2003-2014 Michael Scholz <mi-scholz at users.sourceforge.net>
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -24,30 +24,29 @@
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*
- * Commentary:
- *
- * helper functions
- * fcomb functions (sndscm.html)
+ * @(#)sndins.c 1.11 11/18/14
+ */
+
+/*
* instruments: fm-violin, jc-reverb, nrev, freeverb
- *
- * mus_any *mus_make_fcomb(mus_float_t scaler, int size, mus_float_t a0, mus_float_t a1);
- * int mus_fcomb_p(mus_any *ptr);
+ *
+ * mus_any *mus_make_fcomb(mus_float_t scaler, int size,
+ * mus_float_t a0, mus_float_t a1);
+ * int mus_is_fcomb(mus_any *ptr);
* mus_float_t mus_fcomb(mus_any *ptr, mus_float_t input, mus_float_t ignored);
*
- * off_t ins_fm_violin(mus_float_t start, mus_float_t dur, [...]);
- * off_t ins_jc_reverb(mus_float_t start, mus_float_t dur, [...]);
- * off_t ins_nrev(mus_float_t start, mus_float_t dur, [...]);
- * off_t ins_freeverb(mus_float_t start, mus_float_t dur, [...]);
+ * mus_long_t ins_fm_violin(mus_float_t start, mus_float_t dur, [...]);
+ * mus_long_t ins_jc_reverb(mus_float_t start, mus_float_t dur, [...]);
+ * mus_long_t ins_nrev(mus_float_t start, mus_float_t dur, [...]);
+ * mus_long_t ins_freeverb(mus_float_t start, mus_float_t dur, [...]);
*
* void Init_sndins(void);
*/
-#if HAVE_CONFIG_H
-# include <mus-config.h>
-#endif
-#if HAVE_STRING_H
-# include <string.h>
+#if defined(HAVE_CONFIG_H)
+#include <mus-config.h>
#endif
+#include <string.h>
#include <stddef.h>
#include <stdio.h>
#include <stdlib.h>
@@ -61,1291 +60,1540 @@
#include "clm2xen.h"
#include "sndins.h"
-#define INS_NO_MEMORY XEN_ERROR_TYPE("sndins-no-memory-error")
-#define INS_MISC XEN_ERROR_TYPE("sndins-misc-error")
-
-#define INS_ERROR(error, caller, msg) \
- XEN_ERROR(error, XEN_LIST_2(C_TO_XEN_STRING(caller), C_TO_XEN_STRING(msg)))
-#define INS_MISC_ERROR(caller, msg) INS_ERROR(INS_MISC, caller, msg)
-#define INS_NO_MEMORY_ERROR(caller, msg) INS_ERROR(INS_NO_MEMORY, caller, msg)
-
-enum {C_startime, C_duration, C_frequency, C_amplitude, C_amp_env, C_fm_index, C_reverb_amount,
- C_degree, C_distance, C_periodic_vibrato_rate, C_periodic_vibrato_amplitude,
- C_random_vibrato_rate, C_random_vibrato_amplitude, C_noise_freq, C_noise_amount,
- C_ind_noise_freq, C_ind_noise_amount, C_amp_noise_freq, C_amp_noise_amount,
- C_gliss_env, C_glissando_amount, C_fm1_env, C_fm2_env, C_fm3_env, C_fm1_rat, C_fm2_rat,
- C_fm3_rat, C_fm1_index, C_fm2_index, C_fm3_index, C_base, C_index_type,
- C_no_waveshaping,
- C_low_pass, C_volume, C_delay1, C_delay2, C_delay3, C_delay4, C_doubled,
- C_reverb_factor, C_lp_coeff, C_lp_out_coeff, C_output_scale,
- C_room_decay, C_damping, C_global, C_predelay, C_output_gain, C_output_mixer,
- C_scale_room_decay, C_offset_room_decay, C_combtuning, C_allpasstuning, C_scale_damping,
- C_stereo_spread,
- C_scaler, C_size, C_a0, C_a1,
- NKEYS};
-
-static char *keywords[NKEYS] =
- {SC_startime, SC_duration, SC_frequency, SC_amplitude, SC_amp_env, SC_fm_index, SC_reverb_amount,
- SC_degree, SC_distance, SC_periodic_vibrato_rate, SC_periodic_vibrato_amplitude,
- SC_random_vibrato_rate, SC_random_vibrato_amplitude, SC_noise_freq, SC_noise_amount,
- SC_ind_noise_freq, SC_ind_noise_amount, SC_amp_noise_freq, SC_amp_noise_amount,
- SC_gliss_env, SC_glissando_amount, SC_fm1_env, SC_fm2_env, SC_fm3_env, SC_fm1_rat, SC_fm2_rat,
- SC_fm3_rat, SC_fm1_index, SC_fm2_index, SC_fm3_index, SC_base, SC_index_type,
- SC_no_waveshaping,
- SC_low_pass, SC_volume, SC_delay1, SC_delay2, SC_delay3, SC_delay4, SC_doubled,
- SC_reverb_factor, SC_lp_coeff, SC_lp_out_coeff, SC_output_scale,
- SC_room_decay, SC_damping, SC_global, SC_predelay, SC_output_gain, SC_output_mixer,
- SC_scale_room_decay, SC_offset_room_decay, SC_combtuning, SC_allpasstuning, SC_scale_damping,
- SC_stereo_spread,
- SC_scaler, SC_size, SC_a0, SC_a1};
-
-static XEN allkeys[NKEYS];
+#if !defined(Xen_is_provided)
+#if defined(HAVE_SCHEME)
+#define Xen_is_provided(feature) \
+ Xen_boolean_to_C_bool(Xen_member(C_string_to_Xen_symbol(feature),\
+ C_string_to_Xen_value("*features*")))
+#elif HAVE_RUBY
+#define Xen_is_provided(feature) Xen_boolean_to_C_bool(rb_provided(feature))
+#elif HAVE_FORTH
+#define Xen_is_provided(feature) fth_provided_p(feature)
+#else
+#define Xen_is_provided(feature) false
+#endif
+#endif /* Xen_is_provided */
+
+#define INS_NO_MEMORY Xen_make_error_type("sndins-no-memory-error")
+#define INS_MISC Xen_make_error_type("sndins-misc-error")
+
+#define INS_ERROR(Error, Caller, Msg) \
+ Xen_error(Error, \
+ Xen_list_2(C_string_to_Xen_string(Caller), \
+ C_string_to_Xen_string(Msg)))
+#define INS_MISC_ERROR(Caller, Msg) INS_ERROR(INS_MISC, Caller, Msg)
+#define INS_NO_MEMORY_ERROR(Caller) \
+ INS_ERROR(INS_NO_MEMORY, Caller, "cannot allocate memory")
+
+#define SC_startime "startime"
+#define SC_duration "duration"
+#define SC_frequency "frequency"
+#define SC_amplitude "amplitude"
+#define SC_degree "degree"
+#define SC_distance "distance"
+#define SC_volume "volume"
+#define SC_delay1 "delay1"
+#define SC_delay2 "delay2"
+#define SC_delay3 "delay3"
+#define SC_delay4 "delay4"
+#define SC_doubled "doubled"
+#define SC_base "base"
+#define SC_damping "damping"
+#define SC_global "global"
+#define SC_predelay "predelay"
+#define SC_combtuning "combtuning"
+#define SC_allpasstuning "allpasstuning"
+#define SC_scaler "scaler"
+#define SC_size "size"
+#define SC_a0 "a0"
+#define SC_a1 "a1"
+#if defined(HAVE_RUBY)
+#define SC_amp_env "amp_env"
+#define SC_fm_index "fm_index"
+#define SC_reverb_amount "reverb_amount"
+#define SC_low_pass "low_pass"
+#define SC_periodic_vibrato_rate "periodic_vibrato_rate"
+#define SC_periodic_vibrato_amplitude "periodic_vibrato_amplitude"
+#define SC_random_vibrato_rate "random_vibrato_rate"
+#define SC_random_vibrato_amplitude "random_vibrato_amplitude"
+#define SC_noise_freq "noise_freq"
+#define SC_noise_amount "noise_amount"
+#define SC_ind_noise_freq "ind_noise_freq"
+#define SC_ind_noise_amount "ind_noise_amount"
+#define SC_amp_noise_freq "amp_noise_freq"
+#define SC_amp_noise_amount "amp_noise_amount"
+#define SC_gliss_env "gliss_env"
+#define SC_glissando_amount "glissando_amount"
+#define SC_fm1_env "fm1_env"
+#define SC_fm2_env "fm2_env"
+#define SC_fm3_env "fm3_env"
+#define SC_fm1_rat "fm1_rat"
+#define SC_fm2_rat "fm2_rat"
+#define SC_fm3_rat "fm3_rat"
+#define SC_fm1_index "fm1_index"
+#define SC_fm2_index "fm2_index"
+#define SC_fm3_index "fm3_index"
+#define SC_index_type "index_type"
+#define SC_no_waveshaping "no_waveshaping"
+#define SC_reverb_factor "reverb_factor"
+#define SC_lp_coeff "lp_coeff"
+#define SC_lp_out_coeff "lp_out_coeff"
+#define SC_output_scale "output_scale"
+#define SC_room_decay "room_decay"
+#define SC_output_gain "output_gain"
+#define SC_output_mixer "output_mixer"
+#define SC_scale_room_decay "scale_room_decay"
+#define SC_offset_room_decay "offset_room_decay"
+#define SC_scale_damping "scale_dumping"
+#define SC_stereo_spread "stereo_spread"
+#else /* !HAVE_RUBY */
+#define SC_amp_env "amp-env"
+#define SC_fm_index "fm-index"
+#define SC_reverb_amount "reverb-amount"
+#define SC_low_pass "low-pass"
+#define SC_periodic_vibrato_rate "periodic-vibrato-rate"
+#define SC_periodic_vibrato_amplitude "periodic-vibrato-amplitude"
+#define SC_random_vibrato_rate "random-vibrato-rate"
+#define SC_random_vibrato_amplitude "random-vibrato-amplitude"
+#define SC_noise_freq "noise-freq"
+#define SC_noise_amount "noise-amount"
+#define SC_ind_noise_freq "ind-noise-freq"
+#define SC_ind_noise_amount "ind-noise-amount"
+#define SC_amp_noise_freq "amp-noise-freq"
+#define SC_amp_noise_amount "amp-noise-amount"
+#define SC_gliss_env "gliss-env"
+#define SC_glissando_amount "glissando-amount"
+#define SC_fm1_env "fm1-env"
+#define SC_fm2_env "fm2-env"
+#define SC_fm3_env "fm3-env"
+#define SC_fm1_rat "fm1-rat"
+#define SC_fm2_rat "fm2-rat"
+#define SC_fm3_rat "fm3-rat"
+#define SC_fm1_index "fm1-index"
+#define SC_fm2_index "fm2-index"
+#define SC_fm3_index "fm3-index"
+#define SC_index_type "index-type"
+#define SC_no_waveshaping "no-waveshaping"
+#define SC_reverb_factor "reverb-factor"
+#define SC_lp_coeff "lp-coeff"
+#define SC_lp_out_coeff "lp-out-coeff"
+#define SC_output_scale "output-scale"
+#define SC_room_decay "room-decay"
+#define SC_output_gain "output-gain"
+#define SC_output_mixer "output-mixer"
+#define SC_scale_room_decay "scale-room-decay"
+#define SC_offset_room_decay "offset-room-decay"
+#define SC_scale_damping "scale-dumping"
+#define SC_stereo_spread "stereo-spread"
+#endif /* HAVE_RUBY */
+
+enum {
+ C_startime,
+ C_duration,
+ C_frequency,
+ C_amplitude,
+ C_amp_env,
+ C_fm_index,
+ C_reverb_amount,
+ C_degree,
+ C_distance,
+ C_periodic_vibrato_rate,
+ C_periodic_vibrato_amplitude,
+ C_random_vibrato_rate,
+ C_random_vibrato_amplitude,
+ C_noise_freq,
+ C_noise_amount,
+ C_ind_noise_freq,
+ C_ind_noise_amount,
+ C_amp_noise_freq,
+ C_amp_noise_amount,
+ C_gliss_env,
+ C_glissando_amount,
+ C_fm1_env,
+ C_fm2_env,
+ C_fm3_env,
+ C_fm1_rat,
+ C_fm2_rat,
+ C_fm3_rat,
+ C_fm1_index,
+ C_fm2_index,
+ C_fm3_index,
+ C_base,
+ C_index_type,
+ C_no_waveshaping,
+ C_low_pass,
+ C_volume,
+ C_delay1,
+ C_delay2,
+ C_delay3,
+ C_delay4,
+ C_doubled,
+ C_reverb_factor,
+ C_lp_coeff,
+ C_lp_out_coeff,
+ C_output_scale,
+ C_room_decay,
+ C_damping,
+ C_global,
+ C_predelay,
+ C_output_gain,
+ C_output_mixer,
+ C_scale_room_decay,
+ C_offset_room_decay,
+ C_combtuning,
+ C_allpasstuning,
+ C_scale_damping,
+ C_stereo_spread,
+ C_scaler,
+ C_size,
+ C_a0,
+ C_a1,
+ NKEYS
+};
+
+static char *keywords[NKEYS] = {
+ SC_startime,
+ SC_duration,
+ SC_frequency,
+ SC_amplitude,
+ SC_amp_env,
+ SC_fm_index,
+ SC_reverb_amount,
+ SC_degree,
+ SC_distance,
+ SC_periodic_vibrato_rate,
+ SC_periodic_vibrato_amplitude,
+ SC_random_vibrato_rate,
+ SC_random_vibrato_amplitude,
+ SC_noise_freq,
+ SC_noise_amount,
+ SC_ind_noise_freq,
+ SC_ind_noise_amount,
+ SC_amp_noise_freq,
+ SC_amp_noise_amount,
+ SC_gliss_env,
+ SC_glissando_amount,
+ SC_fm1_env,
+ SC_fm2_env,
+ SC_fm3_env,
+ SC_fm1_rat,
+ SC_fm2_rat,
+ SC_fm3_rat,
+ SC_fm1_index,
+ SC_fm2_index,
+ SC_fm3_index,
+ SC_base,
+ SC_index_type,
+ SC_no_waveshaping,
+ SC_low_pass,
+ SC_volume,
+ SC_delay1,
+ SC_delay2,
+ SC_delay3,
+ SC_delay4,
+ SC_doubled,
+ SC_reverb_factor,
+ SC_lp_coeff,
+ SC_lp_out_coeff,
+ SC_output_scale,
+ SC_room_decay,
+ SC_damping,
+ SC_global,
+ SC_predelay,
+ SC_output_gain,
+ SC_output_mixer,
+ SC_scale_room_decay,
+ SC_offset_room_decay,
+ SC_combtuning,
+ SC_allpasstuning,
+ SC_scale_damping,
+ SC_stereo_spread,
+ SC_scaler,
+ SC_size,
+ SC_a0,
+ SC_a1
+};
+
+#if defined(HAVE_RUBY)
+#define INS_OUTPUT "output"
+#define INS_REVERB "reverb"
+#define INS_VERBOSE "clm_verbose"
+#define INS_LOCSIG_TYPE "clm_locsig_type"
+#define INS_DECAY_TIME "clm_decay_time"
+#define INS_LIST_BEG "["
+#define INS_LIST_END "]"
+#define INS_FALSE "false"
+#define INS_TRUE "true"
+#define INS_SYMBOL_PREFIX ":"
+#else
+#define INS_OUTPUT "*output*"
+#define INS_REVERB "*reverb*"
+#define INS_VERBOSE "*clm-verbose*"
+#define INS_LOCSIG_TYPE "*clm-locsig-type*"
+#define INS_DECAY_TIME "*clm-decay-time*"
+#define INS_LIST_BEG "'("
+#define INS_LIST_END ")"
+#define INS_FALSE "#f"
+#define INS_TRUE "#t"
+#define INS_SYMBOL_PREFIX "'"
+#endif
+
+/* utility functions */
+static mus_float_t *array2array(mus_float_t *list, int len);
+static bool array_equal_p(mus_float_t *env1, int len1,
+ mus_float_t *env2, int len2);
+static int feq(mus_float_t x, int i);
+static char *format_array(mus_float_t *line, int size);
+static bool get_global_boolean(const char *name, bool def);
+static mus_float_t get_global_float(const char *name, mus_float_t def);
+static int get_global_int(const char *name, int def);
+static mus_any *get_global_mus_gen(const char *name);
+static int ins_message(const char *fmt,...);
+static int *int_array2array(int *list, int len);
+static bool prime_p(int x);
+static mus_float_t *xen_list2array(Xen list);
+static int *xen_list2iarray(Xen list);
+static vct *mus_optkey_to_vct(Xen key, const char *caller, int n, vct *def);
+
+/* fcomb generator */
+static char *fcomb_describe(mus_any *ptr);
+static bool fcomb_equal_p(mus_any *p1, mus_any *p2);
+static int fcomb_free(mus_any *ptr);
+static mus_long_t fcomb_length(mus_any *ptr);
+static mus_float_t fcomb_scaler(mus_any *ptr);
+
+/* Xen fcomb */
+static Xen c_fcomb(Xen gen, Xen input);
+static Xen c_is_fcomb(Xen gen);
+static Xen c_make_fcomb(Xen args);
+
+/* instruments */
+#if defined(HAVE_FORTH)
+static void c_fm_violin(Xen args);
+static void c_freeverb(Xen args);
+static void c_jc_reverb(Xen args);
+static void c_nrev(Xen args);
+#else
+static Xen c_fm_violin(Xen args);
+static Xen c_freeverb(Xen args);
+static Xen c_jc_reverb(Xen args);
+static Xen c_nrev(Xen args);
+#endif
+
+static Xen allkeys[NKEYS];
static void
init_keywords(void)
{
- int i;
+ int i;
- for (i = 0; i < NKEYS; i++) allkeys[i] = XEN_MAKE_KEYWORD(keywords[i]);
+ for (i = 0; i < NKEYS; i++)
+ allkeys[i] = Xen_make_keyword(keywords[i]);
}
-#if HAVE_RUBY
-# define INS_OUTPUT "output"
-# define INS_REVERB "reverb"
-# define INS_VERBOSE "clm_verbose"
-# define INS_LOCSIG_TYPE "clm_locsig_type"
-# define INS_DECAY_TIME "clm_decay_time"
-# define INS_LIST_BEG "["
-# define INS_LIST_END "]"
-# define INS_FALSE "false"
-# define INS_SYMBOL_PREFIX ":"
-#else
-# define INS_OUTPUT "*output*"
-# define INS_REVERB "*reverb*"
-# define INS_VERBOSE "*clm-verbose*"
-# define INS_LOCSIG_TYPE "*clm-locsig-type*"
-# define INS_DECAY_TIME "*clm-decay-time*"
-# define INS_LIST_BEG "'("
-# define INS_LIST_END ")"
-# define INS_FALSE "#f"
-# define INS_SYMBOL_PREFIX "'"
-#endif
+/*
+ * from clm2xen.c
+ */
+static vct *
+mus_optkey_to_vct(Xen key, const char *caller, int n, vct *def)
+{
+ if (mus_is_vct(key))
+ return(Xen_to_vct(key));
+ if ((!(Xen_is_keyword(key))) && (!(Xen_is_false(key))))
+ Xen_check_type(false, key, n, caller, "a " S_vct);
+ return(def);
+}
+/*
+ * Required for getting $output|$reverb (Ruby) and *output*|*reverb* (Fth).
+ *
+ * XXX: *output*|*reverb* (S7)
+ * Doesn't work for S7. (Tue Nov 18 22:43:18 CET 2014)
+ */
static mus_any *
get_global_mus_gen(const char *name)
{
- if (XEN_DEFINED_P(name))
- {
- XEN value = XEN_NAME_AS_C_STRING_TO_VALUE(name);
-
- if (mus_xen_p(value))
- return XEN_TO_MUS_ANY(value);
- }
- return NULL;
+#if !defined(HAVE_SCHEME)
+ Xen value;
+
+ if (Xen_is_defined(name)) {
+ value = C_string_to_Xen_value(name);
+ if (mus_is_xen(value))
+ return (Xen_to_mus_any(value));
+ }
+#endif
+ return (NULL);
}
static bool
get_global_boolean(const char *name, bool def)
{
- if (XEN_DEFINED_P(name))
- {
- XEN value = XEN_NAME_AS_C_STRING_TO_VALUE(name);
-
- if (XEN_BOOLEAN_P(value))
- return XEN_TO_C_BOOLEAN(value);
- }
- return def;
+ if (Xen_is_defined(name)) {
+ Xen value;
+
+ value = C_string_to_Xen_value(name);
+ if (Xen_is_boolean(value))
+ return (Xen_boolean_to_C_bool(value));
+ }
+ return (def);
}
static int
get_global_int(const char *name, int def)
{
- if (XEN_DEFINED_P(name))
- {
- XEN value = XEN_NAME_AS_C_STRING_TO_VALUE(name);
-
- if (XEN_NUMBER_P(value))
- return XEN_TO_C_INT(value);
- }
- return def;
+ if (Xen_is_defined(name)) {
+ Xen value;
+
+ value = C_string_to_Xen_value(name);
+ if (Xen_is_number(value))
+ return (Xen_integer_to_C_int(value));
+ }
+ return (def);
}
static mus_float_t
get_global_float(const char *name, mus_float_t def)
{
- if (XEN_DEFINED_P(name))
- {
- XEN value = XEN_NAME_AS_C_STRING_TO_VALUE(name);
-
- if (XEN_NUMBER_P(value))
- return XEN_TO_C_DOUBLE(value);
- }
- return def;
+ if (Xen_is_defined(name)) {
+ Xen value;
+
+ value = C_string_to_Xen_value(name);
+ if (Xen_is_number(value))
+ return (Xen_real_to_C_double(value));
+ }
+ return (def);
}
/*
- * Returns a mus_float_t array initialized with contents of XEN list.
+ * Return mus_float_t array initialized with contents of Xen list.
* (mus_make_env())
*/
-
static mus_float_t *
-xen_list2array(XEN list)
+xen_list2array(Xen list)
{
- int i = 0;
- int len = XEN_LIST_LENGTH(list);
- mus_float_t *flist = NULL;
- XEN lst;
-
- if (len == 0) return NULL;
- if (!(flist = (mus_float_t *)malloc(len * sizeof(mus_float_t))))
- INS_NO_MEMORY_ERROR(c__FUNCTION__, "cannot allocate memory");
- for (i = 0, lst = XEN_COPY_ARG(list); i < len; i++, lst = XEN_CDR(lst))
- flist[i] = XEN_TO_C_DOUBLE_OR_ELSE(XEN_CAR(lst), 0.0);
- return flist;
+ int len, i = 0;
+ mus_float_t *flist;
+ Xen lst;
+
+ len = Xen_list_length(list);
+ if (len == 0)
+ return (NULL);
+ flist = malloc(len * sizeof(mus_float_t));
+ if (flist == NULL) {
+ INS_NO_MEMORY_ERROR("xen_list2array");
+ /* NOTREACHED */
+ return (NULL);
+ }
+ for (i = 0, lst = Xen_copy_arg(list); i < len; i++, lst = Xen_cdr(lst))
+ flist[i] = Xen_real_to_C_double(Xen_car(lst));
+ return (flist);
}
/*
- * Returns an int array initialized with contents of XEN list.
+ * Return int array initialized with contents of Xen list.
* (mus_make_mixer())
*/
-
static int *
-xen_list2iarray(XEN list)
+xen_list2iarray(Xen list)
{
- int i = 0;
- int len = XEN_LIST_LENGTH(list);
- int *ilist = NULL;
- XEN lst;
-
- if (len == 0) return NULL;
- if (!(ilist = (int *)malloc(len * sizeof(int))))
- INS_NO_MEMORY_ERROR(c__FUNCTION__, "cannot allocate memory");
- for (i = 0, lst = XEN_COPY_ARG(list); i < len; i++, lst = XEN_CDR(lst))
- ilist[i] = XEN_TO_C_INT_OR_ELSE(XEN_CAR(lst), 0);
- return ilist;
+ int len, i = 0;
+ int *ilist;
+ Xen lst;
+
+ len = Xen_list_length(list);
+ if (len == 0)
+ return (NULL);
+ ilist = malloc(len * sizeof(int));
+ if (ilist == NULL) {
+ INS_NO_MEMORY_ERROR("xen_list2iarray");
+ /* NOTREACHED */
+ return (NULL);
+ }
+ for (i = 0, lst = Xen_copy_arg(list); i < len; i++, lst = Xen_cdr(lst))
+ ilist[i] = Xen_integer_to_C_int(Xen_car(lst));
+ return (ilist);
}
/*
- * Returns a mus_float_t array initialized with contents of mus_float_t list.
+ * Return mus_float_t array initialized with contents of mus_float_t list.
* (mus_make_env())
*/
-
static mus_float_t *
array2array(mus_float_t *list, int len)
{
- int i = 0;
- mus_float_t *flist = NULL;
-
- if (len == 0) return NULL;
- if (!(flist = (mus_float_t *)malloc(len * sizeof(mus_float_t))))
- INS_NO_MEMORY_ERROR(c__FUNCTION__, "cannot allocate memory");
- for (i = 0; i < len; i++) flist[i] = (mus_float_t)list[i];
- return flist;
-}
-
-vct *
-array2vct(mus_float_t *list, int len)
-{
- int i = 0;
- vct *v = mus_vct_make(len);
-
- for (i = 0; i < len; i++) v->data[i] = (mus_float_t)list[i];
- return v;
+ int i = 0;
+ mus_float_t *flist;
+
+ if (len == 0)
+ return (NULL);
+ flist = malloc(len * sizeof(mus_float_t));
+ if (flist == NULL) {
+ INS_NO_MEMORY_ERROR("array2array");
+ /* NOTREACHED */
+ return (NULL);
+ }
+ for (i = 0; i < len; i++)
+ flist[i] = (mus_float_t)list[i];
+ return (flist);
}
/*
- * Returns an int array initialized with contents of int list.
+ * Return int array initialized with contents of int list.
* (mus_make_mixer())
*/
-
static int *
int_array2array(int *list, int len)
{
- int i = 0;
- int *ilist = NULL;
-
- if (len == 0) return NULL;
- if (!(ilist = (int *)malloc(len * sizeof(int))))
- INS_NO_MEMORY_ERROR(c__FUNCTION__, "cannot allocate memory");
- for (i = 0; i < len; i++) ilist[i] = (int)list[i];
- return ilist;
+ int i = 0;
+ int *ilist;
+
+ if (len == 0)
+ return (NULL);
+ ilist = malloc(len * sizeof(int));
+ if (ilist == NULL) {
+ INS_NO_MEMORY_ERROR("int_array2array");
+ /* NOTREACHED */
+ return (NULL);
+ }
+ for (i = 0; i < len; i++)
+ ilist[i] = (int)list[i];
+ return (ilist);
}
-/* ins_fm_violin: easy_case */
+/*
+ * ins_fm_violin: easy_case
+ */
static bool
array_equal_p(mus_float_t *env1, int len1, mus_float_t *env2, int len2)
{
- if (env1 && env2 && len1 == len2)
- {
- int i;
-
- for (i = 0; i < len1; i++)
- if (env1[i] != env2[i])
- return false;
- return true;
- }
- return false;
+ if (env1 != NULL && env2 != NULL && len1 == len2) {
+ int i;
+
+ for (i = 0; i < len1; i++)
+ if (env1[i] != env2[i])
+ return (false);
+ return (true);
+ }
+ return (false);
}
/*
- * To print a message in the listener or emacs buffer.
+ * Print message in listener.
*/
-
-#if HAVE_SCHEME
-# define INS_COMMENT_STRING ";;"
-#else
-# define INS_COMMENT_STRING XEN_COMMENT_STRING
-#endif
-
static int
-ins_message(const char *fmt, ...)
+ins_message(const char *fmt,...)
{
- int result;
- int len = strlen(fmt) + 100;
- va_list ap;
- char *str = (char *)malloc(len * sizeof(char));
-
- if (!str)
- INS_NO_MEMORY_ERROR(c__FUNCTION__, "cannot allocate memory");
-
- va_start(ap, fmt);
- result = vsnprintf(str, len, fmt, ap);
- va_end(ap);
-
- if (XEN_PROVIDED_P("snd") && !XEN_PROVIDED_P("snd-nogui"))
- {
- mus_print(INS_COMMENT_STRING " %s", str);
-
- if (getenv("EMACS"))
- fprintf(stdout, INS_COMMENT_STRING " %s", str);
- }
- else
- fprintf(stdout, INS_COMMENT_STRING " %s", str);
-
- free(str);
- return result;
+ int len, result;
+ va_list ap;
+ char *s;
+
+ len = strlen(fmt) + 128;
+ s = malloc(len * sizeof(char));
+ if (s == NULL) {
+ INS_NO_MEMORY_ERROR("ins_message");
+ /* NOTREACHED */
+ return (-1);
+ }
+ va_start(ap, fmt);
+ result = vsnprintf(s, len, fmt, ap);
+ va_end(ap);
+ if (Xen_is_provided("snd") && !Xen_is_provided("snd-nogui"))
+ mus_print(Xen_comment_mark " %s", s);
+ else
+ fprintf(stdout, Xen_comment_mark " %s", s);
+ free(s);
+ return (result);
}
static int
feq(mus_float_t x, int i)
{
- return(fabs(x - i) < 0.00001);
+ return (fabs(x - i) < 0.00001);
}
static bool
-prime_p(off_t x)
+prime_p(int x)
{
- int i = 0;
-
- if (x == 2)
- return true;
- else if (x % 2)
- {
- for (i = 3; i < sqrt(x); i += 2)
- if (!(x % i))
- return false;
- return true;
- }
- else
- return false;
+ if (x == 2)
+ return (true);
+ if (x % 2) {
+ int i;
+
+ for (i = 3; i < sqrt(x); i += 2)
+ if ((x % i) == 0)
+ return (false);
+ return (true);
+ }
+ return (false);
}
+#define INS_FMT_SIZE 128
+
static char *
format_array(mus_float_t *line, int size)
{
- int i, lim = size;
- char *str = (char *)calloc(2048, sizeof(char));
-
- if (lim > mus_array_print_length())
- lim = mus_array_print_length();
-
- if (line)
- {
- char *tmp = (char *)calloc(32, sizeof(char));
-
- strcpy(str, "[");
-
- for (i = 0; i < lim - 1; i++)
- {
- mus_snprintf(tmp, 32, "%.3f ", line[i]);
- strcat(str, tmp);
+ int i, lim;
+ char *s, *t;
+
+ lim = size;
+ s = NULL;
+ if (lim > mus_array_print_length())
+ lim = mus_array_print_length();
+ s = calloc(INS_FMT_SIZE * lim * 2, sizeof(char));
+ if (s == NULL) {
+ INS_NO_MEMORY_ERROR("format_array");
+ /* NOTREACHED */
+ return (NULL);
}
-
- mus_snprintf(tmp, 32, "%.3f%s]", line[i], (size > lim) ? "..." : "");
- strcat(str, tmp);
- free(tmp);
- }
- else
- strcpy(str, "nil");
-
- return str;
+ if (line == NULL)
+ return (strcpy(s, "nil"));
+ strcpy(s, "[");
+ for (i = 0; i < lim - 1; i++) {
+ t = mus_format("%.3f ", line[i]);
+ strcat(s, t);
+ free(t);
+ }
+ t = mus_format("%.3f%s]", line[i], (size > lim) ? "..." : "");
+ strcat(s, t);
+ free(t);
+ return (s);
}
/* --- fcomb --- */
-/* sndscm.html */
-static int MUS_FCOMB = 0; /* this will be our fcomb type identifier */
-
typedef struct {
- mus_any_class *core;
- int loc, size;
- mus_float_t *line;
- mus_float_t xs[3]; /* a0, a1 (mus_xcoeff(gen, idx)) */
- mus_float_t xscl, x1;
+ mus_any_class *core;
+ int loc;
+ int size; /* mus_length(gen) */
+ mus_float_t *line; /* mus_data(gen) */
+ mus_float_t xs[2]; /* a0, a1; mus_xcoeff(gen, 0 or 1) */
+ mus_float_t xscl; /* mus_scaler(gen) */
+ mus_float_t x1;
} fcomb;
-/* each CLM-in-C generator has mus_any_class *core as the first thing in its structure.
- * it defines most of the built-in "generic" functions like mus-describe.
- * The next set of functions implement the core functions/
- * The address of the function is stored in the class's core struct.
- * For example, the scaler method is defined as mus_float_t (*scaler)(void *ptr);
- * in the mus_any_class declaration (clm.h); for fcomb it will correspond
- * to the fcomb_scaler function below; it is invoked via mus_scaler(gen)
- * where gen is an fcomb generator (the actual call is (*((gen->core)->scaler))(gen)).
- * the core->scaler pointer (the function address) is set in the declaration
- * of mus_any_class FCOMB_CLASS below. If a method doesn't apply to a given
- * generator class, just set its slot to 0.
- */
+static int MUS_FCOMB = 0;
int
-mus_fcomb_p(mus_any *ptr)
+mus_is_fcomb(mus_any *ptr)
{
- return ((ptr) && ((ptr->core)->type == MUS_FCOMB));
+ return (ptr != NULL && mus_type(ptr) == MUS_FCOMB);
}
+#define INS_DESCRIBE_SIZE 2048
+
static char *
-describe_fcomb(mus_any *ptr)
+fcomb_describe(mus_any *ptr)
{
- char *desc = NULL, *s;
- fcomb *gen = (fcomb *)ptr;
-
- desc = (char *)calloc(1024, sizeof(char));
- if (desc)
- {
- if (mus_fcomb_p(ptr))
- {
- char *s = format_array(gen->line, gen->size);
-
- mus_snprintf(desc, 1024,
- "fcomb: scaler: %.3f, a0: %.3f, a1: %.3f, x1: %.3f, line[%d]: %s",
- gen->xscl, gen->xs[0], gen->xs[1], gen->x1, gen->size, s);
- free(s);
- }
- else
- mus_snprintf(desc, 1024, "not an fcomb gen");
- }
- return desc;
+ char *s, *t;
+ fcomb *gen;
+
+ gen = (fcomb *)ptr;
+ t = format_array(gen->line, gen->size);
+ s = mus_format("fcomb: scaler: "
+ "%.3f, a0: %.3f, a1: %.3f, x1: %.3f, line[%d]: %s",
+ gen->xscl, gen->xs[0], gen->xs[1], gen->x1, gen->size, t);
+ free(t);
+ return (s);
}
static bool
-fcomb_equalp(mus_any *p1, mus_any *p2)
+fcomb_equal_p(mus_any *p1, mus_any *p2)
{
- fcomb *g1 = (fcomb *)p1;
- fcomb *g2 = (fcomb *)p2;
-
- return (p1 == p2 ||
- ((g1->core->type == g2->core->type) &&
- (g1->xs[0] == g2->xs[0]) &&
- (g1->xs[1] == g2->xs[1]) &&
- (g1->x1 == g2->x1)));
+ fcomb *g1, *g2;
+
+ g1 = (fcomb *)p1;
+ g2 = (fcomb *)p2;
+ return (mus_is_fcomb(p1) && ((p1 == p2) ||
+ (mus_is_fcomb(p2) &&
+ g1->xs[0] == g2->xs[0] &&
+ g1->xs[1] == g2->xs[1] &&
+ g1->x1 == g2->x1)));
}
-static off_t
+static mus_long_t
fcomb_length(mus_any *ptr)
{
- return ((fcomb *)ptr)->size;
-}
+ fcomb *gen;
-static mus_float_t *
-fcomb_data(mus_any *ptr)
-{
- return ((fcomb *)ptr)->line;
+ gen = (fcomb *)ptr;
+ return ((mus_long_t)(gen->size));
}
static mus_float_t
fcomb_scaler(mus_any *ptr)
{
- return ((fcomb *)ptr)->xscl;
-}
-
-static mus_float_t
-set_fcomb_scaler(mus_any *ptr, mus_float_t val)
-{
- ((fcomb *)ptr)->xscl = val;
- return val;
-}
-
-static mus_float_t
-fcomb_xcoeff(mus_any *ptr, int index)
-{
- return ((fcomb *)ptr)->xs[index];
-}
-
-static mus_float_t
-set_fcomb_xcoeff(mus_any *ptr, int index, mus_float_t val)
-{
- ((fcomb *)ptr)->xs[index] = val;
- return val;
-}
-
-static mus_float_t *
-fcomb_xcoeffs(mus_any *ptr)
-{
- return ((fcomb *)ptr)->xs;
-}
+ fcomb *gen;
-static void
-fcomb_reset(mus_any *ptr)
-{
- ((fcomb *)ptr)->x1 = 0.0;
+ gen = (fcomb *)ptr;
+ return (gen->xscl);
}
static int
-free_fcomb(mus_any *uptr)
+fcomb_free(mus_any *ptr)
{
- fcomb *ptr = (fcomb *)uptr;
-
- if (ptr)
- {
- if (ptr->line) free(ptr->line);
- ptr->line = NULL;
- free(ptr);
- }
- return 0;
+ fcomb *gen;
+
+ gen = (fcomb *)ptr;
+ if (gen != NULL) {
+ if (gen->line != NULL)
+ free(gen->line);
+ gen->line = NULL;
+ free(gen);
+ }
+ return (0);
}
-/* now the actual run-time code executed by fcomb
- the extra "ignored" argument is for the run method */
-
+/*
+ * Now the actual run-time code executed by fcomb the extra "ignored"
+ * argument is for the run method
+ */
mus_float_t
-mus_fcomb(mus_any *ptr, mus_float_t input, mus_float_t ignored __attribute__ ((unused)))
+mus_fcomb(mus_any *ptr, mus_float_t input,
+ mus_float_t ignored __attribute__((unused)))
{
- fcomb *gen = (fcomb *)ptr;
- mus_float_t tap_result, filter_result;
-
- tap_result = gen->line[gen->loc];
- filter_result = (gen->xs[0] * tap_result) + (gen->xs[1] * gen->x1);
- gen->x1 = tap_result;
- gen->line[gen->loc] = input + filter_result * gen->xscl;
- gen->loc++;
- if (gen->loc >= gen->size)
- gen->loc = 0;
- return tap_result;
+ fcomb *gen;
+ mus_float_t tap_result, filter_result;
+
+ gen = (fcomb *)ptr;
+ tap_result = gen->line[gen->loc];
+ filter_result = (gen->xs[0] * tap_result) + (gen->xs[1] * gen->x1);
+ gen->x1 = tap_result;
+ gen->line[gen->loc] = input + filter_result * gen->xscl;
+ gen->loc++;
+ if (gen->loc >= gen->size)
+ gen->loc = 0;
+ return (tap_result);
}
-/* this is our core class descriptor */
-
-static mus_any_class FCOMB_CLASS = {
- -1, /* mus_type: this is assigned at run-time via mus_make_class_tag below */
- "fcomb", /* mus_name: class name (used in descriptive/error messages) */
- &free_fcomb, /* mus_free: free gen's struct etc */
- &describe_fcomb, /* mus_describe: user-friendly description */
- &fcomb_equalp, /* mus_equalp: check equality of fcomb gens */
- &fcomb_data, /* mus_data: the fcomb delay line, a float array */
- 0, /* mus_set_data: not implemented for fcomb */
- &fcomb_length, /* mus_length: delay line length */
- 0, /* mus_set_length: not implemented for fcomb */
- 0, 0, /* mus_frequency, mus_set_frequency */
- 0, 0, /* mus_phase, mus_set_phase */
- &fcomb_scaler, /* mus_scaler: the feedback term */
- &set_fcomb_scaler, /* mus_set_scaler */
- 0, 0,
- &mus_fcomb, /* mus_run: the run-time fcomb function, MUS_RUN(gen) for speed */
- MUS_NOT_SPECIAL, /* type extension */
- NULL, 0,
- 0, 0,
- 0, 0,
- &fcomb_xcoeff, &set_fcomb_xcoeff,
- 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0,
- 0, 0,
- &fcomb_xcoeffs,
- 0, 0,
- &fcomb_reset,
- 0
-};
-
-/* now a function to make a new generator */
-
-mus_any *
+/*
+ * Now a function to make a new generator.
+ */
+mus_any *
mus_make_fcomb(mus_float_t scaler, int size, mus_float_t a0, mus_float_t a1)
{
- fcomb *gen = NULL;
-
- gen = (fcomb *)calloc(1, sizeof(fcomb));
- if (gen == NULL)
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, "cannot allocate struct for mus_make_fcomb!");
- else
- {
- gen->core = &FCOMB_CLASS;
- if (MUS_FCOMB == 0)
- {
- MUS_FCOMB = mus_make_class_tag(); /* this gives us a unique fcomb type id */
- gen->core->type = MUS_FCOMB;
+ fcomb *gen;
+ int i;
+
+ gen = calloc(1, sizeof(fcomb));
+ if (gen == NULL) {
+ INS_NO_MEMORY_ERROR("mus_make_fcomb");
+ /* NOTREACHED */
+ return (NULL);
}
- gen->loc = 0;
- gen->xscl = scaler;
- gen->x1 = 0.0;
- gen->xs[0] = a0;
- gen->xs[1] = a1;
- gen->size = size;
- gen->line = (mus_float_t *)calloc(size, sizeof(mus_float_t));
- if (gen->line == NULL)
- mus_error(MUS_MEMORY_ALLOCATION_FAILED,
- "cannot allocate %d bytes for fcomb delay line in mus_make_fcomb!",
- (int)(size * sizeof(mus_float_t)));
- }
- return (mus_any *)gen;
+ gen->line = calloc(size, sizeof(mus_float_t));
+ if (gen->line == NULL) {
+ INS_NO_MEMORY_ERROR("mus_make_fcomb");
+ /* NOTREACHED */
+ return (NULL);
+ }
+ for (i = 0; i < size; i++)
+ gen->line[i] = 0.0;
+ MUS_FCOMB = mus_make_generator_type();
+ gen->core = mus_make_generator(MUS_FCOMB, "fcomb",
+ fcomb_free, fcomb_describe, fcomb_equal_p);
+ if (gen->core == NULL) {
+ INS_NO_MEMORY_ERROR("mus_make_fcomb");
+ /* NOTREACHED */
+ return (NULL);
+ }
+ gen->loc = 0;
+ gen->xscl = scaler;
+ gen->x1 = 0.0;
+ gen->xs[0] = a0;
+ gen->xs[1] = a1;
+ gen->size = size;
+ mus_generator_set_length(gen->core, fcomb_length);
+ mus_generator_set_scaler(gen->core, fcomb_scaler);
+ return ((mus_any *)gen);
}
-/* that is the end of the C side; the rest ties this generator into
- Scheme/Ruby/Forth via the Xen package
- in Snd's case, it's actually not needed because the generator is
- only called from C */
+/*
+ * That is the end of the C side; the rest ties this generator into
+ * Scheme/Ruby/Forth via the Xen package in Snd's case, it's actually
+ * not needed because the generator is only called from C.
+ */
#define h_make_fcomb_args "\
+keyword arguments with default values:\n\
:scaler 1.0\n\
:size 1\n\
:a0 0.0\n\
:a1 0.0\n\
-Returns a new fcomb generator."
+Return new fcomb generator."
-#if HAVE_RUBY
-# define S_make_fcomb "make_fcomb"
-# define H_make_fcomb S_make_fcomb "(*args)\n" h_make_fcomb_args
+#if defined(HAVE_RUBY)
+#define S_make_fcomb "make_fcomb"
#else
-# define S_make_fcomb "make-fcomb"
-# if HAVE_FORTH
-# define H_make_fcomb S_make_fcomb " ( args -- gen )\n" h_make_fcomb_args
-# else
-# define H_make_fcomb "(" S_make_fcomb " . args)\n" h_make_fcomb_args
-# endif
+#define S_make_fcomb "make-fcomb"
+#endif
+
+#if defined(HAVE_RUBY)
+#define H_make_fcomb S_make_fcomb "(*args)\n" h_make_fcomb_args
+#elif defined(HAVE_FORTH)
+#define H_make_fcomb S_make_fcomb " ( args -- gen )\n" h_make_fcomb_args
+#else /* HAVE_SCHEME */
+#define H_make_fcomb "(" S_make_fcomb " . args)\n" h_make_fcomb_args
#endif
#define MAX_TABLE_SIZE (1024 * 1024 * 20)
-static XEN
-c_make_fcomb(XEN args)
+static Xen
+c_make_fcomb(Xen args)
{
#define FCOMB_LAST_KEY 4
- int i, keyn, argn = 0, vals = 0, lst_len = XEN_LIST_LENGTH(args), size = 1;
- mus_float_t scaler = 1.0, a0 = 0.0, a1 = 0.0;
- XEN kargs[FCOMB_LAST_KEY * 2], keys[FCOMB_LAST_KEY];
- int orig_arg[FCOMB_LAST_KEY] = {0};
- mus_xen *gn = NULL;
-
- keys[argn++] = allkeys[C_scaler];
- keys[argn++] = allkeys[C_size];
- keys[argn++] = allkeys[C_a0];
- keys[argn++] = allkeys[C_a1];
-
- for (i = 0; i < FCOMB_LAST_KEY * 2; i++) kargs[i] = XEN_UNDEFINED;
- for (i = 0; i < lst_len; i++) kargs[i] = XEN_LIST_REF(args, i);
- vals = mus_optkey_unscramble(S_make_fcomb, argn, keys, kargs, orig_arg);
-
- if (vals > 0)
- {
- keyn = 0;
- scaler = mus_optkey_to_float(keys[keyn], S_make_fcomb, orig_arg[keyn], scaler);
- keyn++;
- size = mus_optkey_to_int(keys[keyn], S_make_fcomb, orig_arg[keyn], size);
- if (size < 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_fcomb, orig_arg[keyn], keys[keyn], "size < 0?");
- if (size > MAX_TABLE_SIZE)
- XEN_OUT_OF_RANGE_ERROR(S_make_fcomb, orig_arg[keyn], keys[keyn], "size too large");
- keyn++;
- a0 = mus_optkey_to_float(keys[keyn], S_make_fcomb, orig_arg[keyn], a0);
- keyn++;
- a1 = mus_optkey_to_float(keys[keyn], S_make_fcomb, orig_arg[keyn], a1);
- }
-
- if (!(gn = (mus_xen *)calloc(1, sizeof(mus_xen))))
- INS_NO_MEMORY_ERROR(c__FUNCTION__, "cannot allocate memory");
-
- gn->gen = mus_make_fcomb(scaler, size, a0, a1);
- gn->nvcts = 1;
- gn->vcts = (XEN *)malloc(1 * sizeof(XEN));
- gn->dont_free_gen = true;
- return mus_xen_to_object_with_vct(gn, xen_make_vct(size, ((fcomb *)gn->gen)->line));
+ int i, keyn, argn, vals, lst_len, size;
+ mus_float_t scaler, a0, a1;
+ Xen kargs[FCOMB_LAST_KEY * 2], keys[FCOMB_LAST_KEY];
+ int orig_arg[FCOMB_LAST_KEY] = {0};
+ mus_any *ge;
+
+ argn = 0;
+ lst_len = Xen_list_length(args);
+ size = 1;
+ scaler = 1.0;
+ a0 = a1 = 0.0;
+ keys[argn++] = allkeys[C_scaler];
+ keys[argn++] = allkeys[C_size];
+ keys[argn++] = allkeys[C_a0];
+ keys[argn++] = allkeys[C_a1];
+ for (i = 0; i < FCOMB_LAST_KEY * 2; i++)
+ kargs[i] = Xen_undefined;
+ for (i = 0; i < lst_len; i++)
+ kargs[i] = Xen_list_ref(args, i);
+ vals = mus_optkey_unscramble(S_make_fcomb, argn, keys, kargs, orig_arg);
+ if (vals > 0) {
+ keyn = 0;
+ scaler = mus_optkey_to_float(keys[keyn], S_make_fcomb,
+ orig_arg[keyn], scaler);
+ keyn++;
+ size = mus_optkey_to_int(keys[keyn], S_make_fcomb,
+ orig_arg[keyn], size);
+ if (size < 0)
+ Xen_out_of_range_error(S_make_fcomb, orig_arg[keyn],
+ keys[keyn], "size < 0?");
+ if (size > MAX_TABLE_SIZE)
+ Xen_out_of_range_error(S_make_fcomb, orig_arg[keyn],
+ keys[keyn], "size too large");
+ keyn++;
+ a0 = mus_optkey_to_float(keys[keyn], S_make_fcomb,
+ orig_arg[keyn], a0);
+ keyn++;
+ a1 = mus_optkey_to_float(keys[keyn], S_make_fcomb,
+ orig_arg[keyn], a1);
+ }
+ ge = mus_make_fcomb(scaler, size, a0, a1);
+ if (ge) {
+ fcomb *g;
+ mus_xen *fc;
+ Xen v1, v2;
+
+ g = (fcomb *)ge;
+ /* wrapper set v->dont_free = true */
+ v1 = xen_make_vct_wrapper(size, g->line);
+ v2 = xen_make_vct_wrapper(2, g->xs);
+ fc = mus_any_to_mus_xen_with_two_vcts(ge, v1, v2);
+ return (mus_xen_to_object(fc));
+ }
+ return (Xen_false);
}
-#define XEN_FCOMB_P(obj) (mus_xen_p(obj) && mus_fcomb_p(XEN_TO_MUS_ANY(obj)))
-
-#define S_fcomb_p "fcomb?"
-#define h_fcomb_p_doc "Returns #t if GEN is an fcomb generator, otherwise #f."
+#define S_is_fcomb "fcomb?"
+#define h_is_fcomb_doc "\
+Return " INS_TRUE " if GEN is an fcomb generator, otherwise " INS_FALSE "."
-#if HAVE_RUBY
-# define H_fcomb_p S_fcomb_p "(gen) " h_fcomb_p_doc
-#else
-# if HAVE_FORTH
-# define H_fcomb_p S_fcomb_p " ( gen -- f ) " h_fcomb_p_doc
-# else
-# define H_fcomb_p "(" S_fcomb_p " gen) " h_fcomb_p_doc
-# endif
+#if defined(HAVE_RUBY)
+#define H_is_fcomb S_is_fcomb "(gen) " h_is_fcomb_doc
+#elif defined(HAVE_FORTH)
+#define H_is_fcomb S_is_fcomb " ( gen -- f ) " h_is_fcomb_doc
+#else /* HAVE_SCHEME */
+#define H_is_fcomb "(" S_is_fcomb " gen) " h_is_fcomb_doc
#endif
-static XEN
-c_fcomb_p(XEN gen)
+#define Xen_is_fcomb(obj) \
+ (mus_is_xen(obj) && mus_is_fcomb(Xen_to_mus_any(obj)))
+
+static Xen
+c_is_fcomb(Xen obj)
{
- return C_TO_XEN_BOOLEAN(XEN_FCOMB_P(gen));
+ return (C_bool_to_Xen_boolean(Xen_is_fcomb(obj)));
}
-#define S_fcomb "fcomb"
-#define h_fcomb_doc "Returns result of running fcomb generator."
+#define S_fcomb "fcomb"
+#define h_fcomb_doc "Return result of running fcomb generator."
-#if HAVE_RUBY
-# define H_fcomb S_fcomb "(gen[, input=0.0]) " h_fcomb_doc
-#else
-# if HAVE_FORTH
-# define H_fcomb S_fcomb " ( gen input=0.0 -- res ) " h_fcomb_doc
-# else
-# define H_fcomb "(" S_fcomb " gen (input 0.0)) " h_fcomb_doc
-# endif
+#if defined(HAVE_RUBY)
+#define H_fcomb S_fcomb "(gen, input=0.0) " h_fcomb_doc
+#elif defined(HAVE_FORTH)
+#define H_fcomb S_fcomb " ( gen input=0.0 -- res ) " h_fcomb_doc
+#else /* HAVE_SCHEME */
+#define H_fcomb "(" S_fcomb " gen (input 0.0)) " h_fcomb_doc
#endif
-static XEN
-c_fcomb(XEN gen, XEN input)
+static Xen
+c_fcomb(Xen gen, Xen input)
{
- XEN_ASSERT_TYPE(XEN_FCOMB_P(gen), gen, XEN_ARG_1, S_fcomb, "an fcomb");
- return C_TO_XEN_DOUBLE(mus_fcomb(XEN_TO_MUS_ANY(gen), XEN_TO_C_DOUBLE_OR_ELSE(input, 0.0), 0.0));
+ mus_any *ge;
+ mus_float_t fm;
+
+ fm = 0.0;
+ ge = Xen_to_mus_any(gen);
+ Xen_check_type(mus_is_fcomb(ge), gen, 1, S_fcomb, "an fcomb");
+ if (Xen_is_bound(input))
+ fm = Xen_real_to_C_double(input);
+ return (C_double_to_Xen_real(mus_fcomb(ge, fm, 0.0)));
}
-/* sndscm.html */
/* --- instruments --- */
-#if HAVE_RUBY
-# define S_fm_violin "fm_violin"
-# define S_jc_reverb "jc_reverb"
+#if defined(HAVE_RUBY)
+#define S_fm_violin "fm_violin"
+#define S_jc_reverb "jc_reverb"
#else
-# define S_fm_violin "fm-violin"
-# define S_jc_reverb "jc-reverb"
+#define S_fm_violin "fm-violin"
+#define S_jc_reverb "jc-reverb"
#endif
-#define S_nrev "nrev"
-#define S_freeverb "freeverb"
-
-off_t
-ins_fm_violin(mus_float_t start,
- mus_float_t dur,
- mus_float_t freq,
- mus_float_t amp,
- mus_float_t fm_index,
- mus_float_t *amp_env,
- int amp_len,
- mus_float_t periodic_vibrato_rate,
- mus_float_t periodic_vibrato_amp,
- mus_float_t random_vibrato_rate,
- mus_float_t random_vibrato_amp,
- mus_float_t noise_freq,
- mus_float_t noise_amount,
- mus_float_t ind_noise_freq,
- mus_float_t ind_noise_amount,
- mus_float_t amp_noise_freq,
- mus_float_t amp_noise_amount,
- mus_float_t *gliss_env,
- int gliss_len,
- mus_float_t gliss_amount,
- mus_float_t *fm1_env,
- int fm1_len,
- mus_float_t *fm2_env,
- int fm2_len,
- mus_float_t *fm3_env,
- int fm3_len,
- mus_float_t fm1_rat,
- mus_float_t fm2_rat,
- mus_float_t fm3_rat,
- mus_float_t fm1_index,
- mus_float_t fm2_index,
- mus_float_t fm3_index,
- mus_float_t base,
- mus_float_t degree,
- mus_float_t distance,
- mus_float_t reverb_amount,
- bool index_type,
- bool no_waveshaping,
- mus_any *out,
- mus_any *rev,
- mus_interp_t mode)
+#define S_nrev "nrev"
+#define S_freeverb "freeverb"
+
+mus_long_t
+ins_fm_violin(mus_float_t start, mus_float_t dur, mus_float_t freq,
+ mus_float_t amp, mus_float_t fm_index, mus_float_t *amp_env,
+ int amp_len, mus_float_t periodic_vibrato_rate,
+ mus_float_t periodic_vibrato_amp, mus_float_t random_vibrato_rate,
+ mus_float_t random_vibrato_amp, mus_float_t noise_freq,
+ mus_float_t noise_amount, mus_float_t ind_noise_freq,
+ mus_float_t ind_noise_amount, mus_float_t amp_noise_freq,
+ mus_float_t amp_noise_amount, mus_float_t *gliss_env, int gliss_len,
+ mus_float_t gliss_amount, mus_float_t *fm1_env, int fm1_len,
+ mus_float_t *fm2_env, int fm2_len, mus_float_t *fm3_env, int fm3_len,
+ mus_float_t fm1_rat, mus_float_t fm2_rat, mus_float_t fm3_rat,
+ mus_float_t fm1_index, mus_float_t fm2_index, mus_float_t fm3_index,
+ mus_float_t base, mus_float_t degree, mus_float_t distance,
+ mus_float_t reverb_amount, bool index_type, bool no_waveshaping,
+ mus_any *out, mus_any *rev, mus_interp_t mode)
{
- off_t i, beg, len;
- int out_chans = 1, rev_chans = 0;
- bool vln = true, easy_case = false, modulate = false;
- mus_float_t frq_scl = 0.0, maxdev = 0.0, index1 = 0.0, index2 = 0.0, index3 = 0.0, vib = 0.0;
- mus_float_t logfrq = 0.0, sqrtfrq = 0.0, norm = 0.0, mod = 0.0;
- mus_float_t *partials = NULL;
- mus_float_t fuzz = 0.0, ind_fuzz = 1.0, amp_fuzz = 1.0;
- mus_any *carrier = NULL, *fmosc1 = NULL, *fmosc2 = NULL, *fmosc3 = NULL;
- mus_any *ampf = NULL, *indf1 = NULL, *indf2 = NULL, *indf3 = NULL, *pervib = NULL;
- mus_any *fm_noi = NULL, *ind_noi = NULL, *amp_noi = NULL, *ranvib = NULL, *frqf = NULL;
- mus_any *loc = NULL;
-
- beg = mus_seconds_to_samples(start);
- len = beg + mus_seconds_to_samples(dur);
- frq_scl = mus_hz_to_radians(freq);
- modulate = (fm_index != 0.0);
- maxdev = frq_scl * fm_index;
- logfrq = log(freq);
- sqrtfrq = sqrt(freq);
- vln = index_type; /* true: violin, false: cello */
-
- if (fm1_index != 0.0)
- index1 = fm1_index;
- else
- {
- index1 = vln ? (maxdev * 5.0 / logfrq) : (maxdev * 7.5 / logfrq);
- if (index1 > M_PI) index1 = M_PI;
- }
-
- if (fm2_index != 0.0)
- index2 = fm2_index;
- else
- {
- index2 = vln ? (maxdev * 3.0 * (8.5 - logfrq) / (3.0 + freq * 0.001)) :
- (maxdev * 3.0 * 15.0 / sqrtfrq);
- if (index2 > M_PI) index2 = M_PI;
- }
-
- if (fm3_index != 0.0)
- index3 = fm3_index;
- else
- {
- index3 = vln ? (maxdev * 4.0 / sqrtfrq) : (maxdev * 8.0 / sqrtfrq);
- if (index3 > M_PI) index3 = M_PI;
- }
-
- easy_case = ((noise_amount == 0.0) &&
- (!no_waveshaping) &&
- array_equal_p(fm1_env, fm1_len, fm2_env, fm2_len) &&
- array_equal_p(fm1_env, fm1_len, fm3_env, fm3_len) &&
- (feq(fm1_rat, (int)floor(fm1_rat))) &&
- (feq(fm2_rat, (int)floor(fm2_rat))) &&
- (feq(fm3_rat, (int)floor(fm3_rat))));
-
- if (easy_case && modulate)
- norm = 1.0;
- else
- norm = index1;
-
- carrier = mus_make_oscil(freq, 0.0);
-
- if (modulate)
- {
- if (easy_case)
- {
- int nparts = (int)floor(fm1_rat);
-
- if ((int)floor(fm2_rat) > nparts) nparts = (int)floor(fm2_rat);
- if ((int)floor(fm3_rat) > nparts) nparts = (int)floor(fm3_rat);
- nparts++;
- partials = (mus_float_t *)calloc(nparts, sizeof(mus_float_t));
- partials[(int)(fm1_rat)] = index1;
- partials[(int)(fm2_rat)] = index2;
- partials[(int)(fm3_rat)] = index3;
- fmosc1 = mus_make_polyshape(freq * fm1_rat, 0.0,
- mus_partials_to_polynomial(nparts, partials, 1),
- nparts, MUS_CHEBYSHEV_FIRST_KIND);
+ mus_long_t i, beg, len;
+ int out_chans, rev_chans;
+ bool vln, easy_case, modulate;
+ mus_float_t frq_scl, maxdev, index1, index2, index3, vib;
+ mus_float_t logfrq, sqrtfrq, norm, mod;
+ mus_float_t *partials = NULL;
+ mus_float_t fuzz, ind_fuzz, amp_fuzz;
+ mus_any *carrier, *fmosc1, *fmosc2 = NULL, *fmosc3 = NULL;
+ mus_any *ampf, *indf1, *indf2 = NULL, *indf3 = NULL, *pervib;
+ mus_any *fm_noi = NULL, *ind_noi = NULL, *amp_noi = NULL;
+ mus_any *ranvib, *frqf = NULL, *loc;
+
+ out_chans = 1;
+ rev_chans = 0;
+ vln = true;
+ easy_case = modulate = false;
+ frq_scl = maxdev = index1 = index2 = index3 = vib = 0.0;
+ logfrq = sqrtfrq = norm = mod = fuzz = 0.0;
+ ind_fuzz = amp_fuzz = 1.0;
+ beg = mus_seconds_to_samples(start);
+ len = beg + mus_seconds_to_samples(dur);
+ frq_scl = mus_hz_to_radians(freq);
+ modulate = (fm_index != 0.0);
+ maxdev = frq_scl * fm_index;
+ logfrq = log(freq);
+ sqrtfrq = sqrt(freq);
+ vln = index_type; /* true: violin, false: cello */
+ if (fm1_index != 0.0)
+ index1 = fm1_index;
+ else {
+ index1 = vln ?
+ (maxdev * 5.0 / logfrq) :
+ (maxdev * 7.5 / logfrq);
+ if (index1 > M_PI)
+ index1 = M_PI;
}
- else
- fmosc1 = mus_make_oscil(freq * fm1_rat, 0.0);
-
- indf1 = mus_make_env(fm1_env, fm1_len / 2, norm, 0.0, 1.0, dur, 0, NULL);
-
- if (!easy_case)
- {
- fmosc2 = mus_make_oscil(freq * fm2_rat, 0.0);
- fmosc3 = mus_make_oscil(freq * fm3_rat, 0.0);
- indf2 = mus_make_env(fm2_env, fm2_len / 2, index2, 0.0, 1.0, dur, 0, NULL);
- indf3 = mus_make_env(fm3_env, fm3_len / 2, index3, 0.0, 1.0, dur, 0, NULL);
+ if (fm2_index != 0.0)
+ index2 = fm2_index;
+ else {
+ index2 = vln ?
+ (maxdev * 3.0 * (8.5 - logfrq) / (3.0 + freq * 0.001)) :
+ (maxdev * 3.0 * 15.0 / sqrtfrq);
+ if (index2 > M_PI)
+ index2 = M_PI;
+ }
+ if (fm3_index != 0.0)
+ index3 = fm3_index;
+ else {
+ index3 = vln ? (maxdev * 4.0 / sqrtfrq) :
+ (maxdev * 8.0 / sqrtfrq);
+ if (index3 > M_PI)
+ index3 = M_PI;
}
- }
-
- ampf = mus_make_env(amp_env, amp_len / 2, amp, 0.0, base, dur, 0, NULL);
- frqf = mus_make_env(gliss_env, gliss_len / 2,
- gliss_amount * frq_scl, 0.0, 1.0, dur, 0, NULL);
- pervib = mus_make_triangle_wave(periodic_vibrato_rate, periodic_vibrato_amp * frq_scl, 0.0);
- ranvib = mus_make_rand_interp(random_vibrato_rate, random_vibrato_amp * frq_scl);
-
- if (noise_amount != 0.0)
- fm_noi = mus_make_rand(noise_freq, noise_amount * M_PI);
-
- if (ind_noise_amount != 0.0 && ind_noise_freq != 0.0)
- ind_noi = mus_make_rand_interp(ind_noise_freq, ind_noise_amount);
-
- if (amp_noise_amount != 0.0 && amp_noise_freq != 0.0)
- amp_noi = mus_make_rand_interp(amp_noise_freq, amp_noise_amount);
-
- if (degree == 0.0)
- degree = mus_random(90.0);
-
- if (out)
- out_chans = mus_channels(out);
- if (rev)
- rev_chans = mus_channels(rev);
-
- loc = mus_make_locsig(degree, distance, reverb_amount, out_chans, out, rev_chans, rev, mode);
-
- for (i = beg; i < len; i++)
- {
- if (fm_noi) fuzz = mus_rand(fm_noi, 0.0);
- vib = mus_env(frqf) + mus_triangle_wave(pervib, 0.0) + mus_rand_interp(ranvib, 0.0);
- if (ind_noi) ind_fuzz = 1.0 + mus_rand_interp(ind_noi, 0.0);
- if (amp_noi) amp_fuzz = 1.0 + mus_rand_interp(amp_noi, 0.0);
- if (modulate)
- {
- if (easy_case)
- mod = mus_env(indf1) * mus_polyshape_unmodulated(fmosc1, vib);
- else
- mod =
- mus_env(indf1) * mus_oscil(fmosc1, fuzz + fm1_rat * vib, 0.0) +
- mus_env(indf2) * mus_oscil(fmosc2, fuzz + fm2_rat * vib, 0.0) +
- mus_env(indf3) * mus_oscil(fmosc3, fuzz + fm3_rat * vib, 0.0);
+ easy_case = (noise_amount == 0.0 && !no_waveshaping &&
+ array_equal_p(fm1_env, fm1_len, fm2_env, fm2_len) &&
+ array_equal_p(fm1_env, fm1_len, fm3_env, fm3_len) &&
+ feq(fm1_rat, (int)floor(fm1_rat)) &&
+ feq(fm2_rat, (int)floor(fm2_rat)) &&
+ feq(fm3_rat, (int)floor(fm3_rat)));
+ if (easy_case && modulate)
+ norm = 1.0;
+ else
+ norm = index1;
+ carrier = mus_make_oscil(freq, 0.0);
+ if (modulate) {
+ if (easy_case) {
+ int nparts;
+
+ nparts = (int)floor(fm1_rat);
+ if ((int)floor(fm2_rat) > nparts)
+ nparts = (int)floor(fm2_rat);
+ if ((int)floor(fm3_rat) > nparts)
+ nparts = (int)floor(fm3_rat);
+ nparts++;
+ partials = calloc(nparts, sizeof(mus_float_t));
+ partials[(int)(fm1_rat)] = index1;
+ partials[(int)(fm2_rat)] = index2;
+ partials[(int)(fm3_rat)] = index3;
+ fmosc1 = mus_make_polyshape(freq * fm1_rat, 0.0,
+ mus_partials_to_polynomial(nparts, partials, 1),
+ nparts, MUS_CHEBYSHEV_FIRST_KIND);
+ } else
+ fmosc1 = mus_make_oscil(freq * fm1_rat, 0.0);
+ indf1 = mus_make_env(fm1_env, fm1_len / 2, norm, 0.0, 1.0,
+ dur, 0, NULL);
+ if (!easy_case) {
+ fmosc2 = mus_make_oscil(freq * fm2_rat, 0.0);
+ fmosc3 = mus_make_oscil(freq * fm3_rat, 0.0);
+ indf2 = mus_make_env(fm2_env, fm2_len / 2, index2,
+ 0.0, 1.0, dur, 0, NULL);
+ indf3 = mus_make_env(fm3_env, fm3_len / 2, index3,
+ 0.0, 1.0, dur, 0, NULL);
+ }
}
- mus_locsig(loc, i, mus_env(ampf) * amp_fuzz * mus_oscil(carrier, vib + ind_fuzz * mod, 0.0));
- }
-
- mus_free(pervib);
- mus_free(ranvib);
- mus_free(carrier);
- mus_free(fmosc1);
- mus_free(ampf);
- mus_free(indf1);
- mus_free(loc);
- if (fm_noi) mus_free(fm_noi);
- if (ind_noi) mus_free(ind_noi);
- if (amp_noi) mus_free(amp_noi);
- if (frqf) mus_free(frqf);
- if (fmosc2) mus_free(fmosc2);
- if (fmosc3) mus_free(fmosc3);
- if (indf2) mus_free(indf2);
- if (indf3) mus_free(indf3);
- if (partials) free(partials);
- return i;
+ ampf = mus_make_env(amp_env, amp_len / 2, amp, 0.0, base, dur, 0, NULL);
+ frqf = mus_make_env(gliss_env, gliss_len / 2, gliss_amount * frq_scl,
+ 0.0, 1.0, dur, 0, NULL);
+ pervib = mus_make_triangle_wave(periodic_vibrato_rate,
+ periodic_vibrato_amp * frq_scl, 0.0);
+ ranvib = mus_make_rand_interp(random_vibrato_rate,
+ random_vibrato_amp * frq_scl);
+ if (noise_amount != 0.0)
+ fm_noi = mus_make_rand(noise_freq, noise_amount * M_PI);
+ if (ind_noise_amount != 0.0 && ind_noise_freq != 0.0)
+ ind_noi = mus_make_rand_interp(ind_noise_freq,
+ ind_noise_amount);
+ if (amp_noise_amount != 0.0 && amp_noise_freq != 0.0)
+ amp_noi = mus_make_rand_interp(amp_noise_freq,
+ amp_noise_amount);
+ if (degree == 0.0)
+ degree = mus_random(90.0);
+ if (out)
+ out_chans = mus_channels(out);
+ if (rev)
+ rev_chans = mus_channels(rev);
+ loc = mus_make_locsig(degree, distance, reverb_amount,
+ out_chans, out, rev_chans, rev, mode);
+ for (i = beg; i < len; i++) {
+ if (fm_noi)
+ fuzz = mus_rand(fm_noi, 0.0);
+ vib = mus_env(frqf) + mus_triangle_wave(pervib, 0.0) +
+ mus_rand_interp(ranvib, 0.0);
+ if (ind_noi)
+ ind_fuzz = 1.0 + mus_rand_interp(ind_noi, 0.0);
+ if (amp_noi)
+ amp_fuzz = 1.0 + mus_rand_interp(amp_noi, 0.0);
+ if (modulate) {
+ if (easy_case)
+ mod = mus_env(indf1) *
+ mus_polyshape_unmodulated(fmosc1, vib);
+ else
+ mod = mus_env(indf1) * mus_oscil(fmosc1,
+ fuzz + fm1_rat * vib, 0.0) +
+ mus_env(indf2) * mus_oscil(fmosc2,
+ fuzz + fm2_rat * vib, 0.0) +
+ mus_env(indf3) * mus_oscil(fmosc3,
+ fuzz + fm3_rat * vib, 0.0);
+ }
+ mus_locsig(loc, i, mus_env(ampf) * amp_fuzz *
+ mus_oscil(carrier, vib + ind_fuzz * mod, 0.0));
+ }
+ mus_free(pervib);
+ mus_free(ranvib);
+ mus_free(carrier);
+ mus_free(fmosc1);
+ mus_free(ampf);
+ mus_free(indf1);
+ mus_free(loc);
+ if (fm_noi)
+ mus_free(fm_noi);
+ if (ind_noi)
+ mus_free(ind_noi);
+ if (amp_noi)
+ mus_free(amp_noi);
+ if (frqf)
+ mus_free(frqf);
+ if (fmosc2)
+ mus_free(fmosc2);
+ if (fmosc3)
+ mus_free(fmosc3);
+ if (indf2)
+ mus_free(indf2);
+ if (indf3)
+ mus_free(indf3);
+ if (partials)
+ free(partials);
+ return (i);
}
-off_t
-ins_jc_reverb(mus_float_t start,
- mus_float_t dur,
- mus_float_t volume,
- bool low_pass,
- bool doubled,
- mus_float_t delay1,
- mus_float_t delay2,
- mus_float_t delay3,
- mus_float_t delay4,
- mus_float_t *amp_env,
- int amp_len,
- mus_any *out,
- mus_any *rev)
+#define JC_WARN "is not set up for doubled reverb in quad"
+
+mus_long_t
+ins_jc_reverb(mus_float_t start, mus_float_t dur, mus_float_t volume,
+ bool low_pass, bool doubled, mus_float_t delay1, mus_float_t delay2,
+ mus_float_t delay3, mus_float_t delay4, mus_float_t *amp_env, int amp_len,
+ mus_any *out, mus_any *rev)
{
- off_t i, beg, len;
- int del_len = 0, chans = 0, rev_chans = 0;
- bool chan2 = false, chan4 = false;
- mus_float_t delA = 0.0, delB = 0.0;
- mus_float_t allpass_sum = 0.0, comb_sum = 0.0, comb_sum_1 = 0.0, comb_sum_2 = 0.0, all_sums = 0.0;
- mus_any *allpass1 = NULL, *allpass2 = NULL, *allpass3 = NULL;
- mus_any *comb1 = NULL, *comb2 = NULL, *comb3 = NULL, *comb4 = NULL;
- mus_any *outdel1 = NULL, *outdel2 = NULL, *outdel3 = NULL, *outdel4 = NULL;
- mus_any *env_a = NULL;
-
- beg = mus_seconds_to_samples(start);
-
- if (dur > 0.0)
- len = beg + mus_seconds_to_samples(dur);
- else
- len = beg + mus_seconds_to_samples(1.0) + mus_sound_frames(mus_file_name(rev));
-
- chans = mus_channels(out);
- rev_chans = mus_channels(rev);
- allpass1 = mus_make_all_pass(-0.7, 0.7, 1051, NULL, 1051, MUS_INTERP_LINEAR);
- allpass2 = mus_make_all_pass(-0.7, 0.7, 337, NULL, 337, MUS_INTERP_LINEAR);
- allpass3 = mus_make_all_pass(-0.7, 0.7, 113, NULL, 113, MUS_INTERP_LINEAR);
- comb1 = mus_make_comb(0.742, 4799, NULL, 4799, MUS_INTERP_LINEAR);
- comb2 = mus_make_comb(0.733, 4999, NULL, 4999, MUS_INTERP_LINEAR);
- comb3 = mus_make_comb(0.715, 5399, NULL, 5399, MUS_INTERP_LINEAR);
- comb4 = mus_make_comb(0.697, 5801, NULL, 5801, MUS_INTERP_LINEAR);
-
- if (chans > 1) chan2 = true;
- if (chans == 4) chan4 = true;
-
- del_len = mus_seconds_to_samples(delay1);
- outdel1 = mus_make_delay(del_len, NULL, del_len, MUS_INTERP_LINEAR);
-
- if (chan2)
- {
- del_len = mus_seconds_to_samples(delay2);
- outdel2 = mus_make_delay(del_len, NULL, del_len, MUS_INTERP_LINEAR);
- }
-
- if (doubled || chan4)
- {
- del_len = mus_seconds_to_samples(delay3);
- outdel3 = mus_make_delay(del_len, NULL, del_len, MUS_INTERP_LINEAR);
- }
-
- if (chan4 || (doubled && chan2))
- {
- del_len = mus_seconds_to_samples(delay4);
- outdel4 = mus_make_delay(del_len, NULL, del_len, MUS_INTERP_LINEAR);
- }
-
- if (amp_env)
- env_a = mus_make_env(amp_env, amp_len / 2, volume, 0.0, 1.0, dur, 0, NULL);
-
- if (doubled && chan4)
- INS_MISC_ERROR(S_jc_reverb, "is not set up for doubled reverb in quad");
-
- for (i = beg; i < len; i++)
- {
- int j;
- mus_float_t ho;
-
- for (j = 0, ho = 0.0; j < rev_chans; j++) ho += mus_in_any(i, j, rev);
- allpass_sum = mus_all_pass_unmodulated(allpass3,
- mus_all_pass_unmodulated(allpass2,
- mus_all_pass_unmodulated(allpass1, ho)));
- comb_sum_2 = comb_sum_1;
- comb_sum_1 = comb_sum;
- comb_sum =
- mus_comb_unmodulated(comb1, allpass_sum) +
- mus_comb_unmodulated(comb2, allpass_sum) +
- mus_comb_unmodulated(comb3, allpass_sum) +
- mus_comb_unmodulated(comb4, allpass_sum);
-
- if (low_pass)
- all_sums = 0.25 * (comb_sum + comb_sum_2) + 0.5 * comb_sum_1;
- else
- all_sums = comb_sum;
-
- delA = mus_delay_unmodulated(outdel1, all_sums);
- if (doubled) delA += mus_delay_unmodulated(outdel3, all_sums);
- if (env_a) volume = mus_env(env_a);
- mus_out_any(i, delA * volume, 0, out);
-
- if (chan2)
- {
- delB = mus_delay_unmodulated(outdel2, all_sums);
- if (doubled) delB += mus_delay_unmodulated(outdel4, all_sums);
- mus_out_any(i, delB * volume, 1, out);
-
- if (chan4)
- {
- mus_out_any(i, volume * mus_delay_unmodulated(outdel3, all_sums), 2, out);
- mus_out_any(i, volume * mus_delay_unmodulated(outdel4, all_sums), 3, out);
- }
+ mus_long_t i, beg, len;
+ int del_len, chans, rev_chans;
+ bool chan2, chan4;
+ mus_float_t delA, delB;
+ mus_float_t allpass_sum, comb_sum, comb_sum_1, comb_sum_2, all_sums;
+ mus_any *allpass1, *allpass2, *allpass3;
+ mus_any *comb1, *comb2, *comb3, *comb4;
+ mus_any *outdel1, *outdel2 = NULL, *outdel3 = NULL, *outdel4 = NULL;
+ mus_any *env_a = NULL;
+
+ del_len = chans = rev_chans = 0;
+ chan2 = chan4 = false;
+ delA = delB = 0.0;
+ allpass_sum = comb_sum = comb_sum_1 = comb_sum_2 = all_sums = 0.0;
+ beg = mus_seconds_to_samples(start);
+ if (dur > 0.0)
+ len = beg + mus_seconds_to_samples(dur);
+ else
+ len = beg + mus_seconds_to_samples(1.0) +
+ mus_sound_framples(mus_file_name(rev));
+ chans = mus_channels(out);
+ rev_chans = mus_channels(rev);
+ allpass1 = mus_make_all_pass(-0.7, 0.7, 1051, NULL, 1051,
+ MUS_INTERP_LINEAR);
+ allpass2 = mus_make_all_pass(-0.7, 0.7, 337, NULL, 337,
+ MUS_INTERP_LINEAR);
+ allpass3 = mus_make_all_pass(-0.7, 0.7, 113, NULL, 113,
+ MUS_INTERP_LINEAR);
+ comb1 = mus_make_comb(0.742, 4799, NULL, 4799, MUS_INTERP_LINEAR);
+ comb2 = mus_make_comb(0.733, 4999, NULL, 4999, MUS_INTERP_LINEAR);
+ comb3 = mus_make_comb(0.715, 5399, NULL, 5399, MUS_INTERP_LINEAR);
+ comb4 = mus_make_comb(0.697, 5801, NULL, 5801, MUS_INTERP_LINEAR);
+ if (chans > 1)
+ chan2 = true;
+ if (chans == 4)
+ chan4 = true;
+ del_len = mus_seconds_to_samples(delay1);
+ outdel1 = mus_make_delay(del_len, NULL, del_len, MUS_INTERP_LINEAR);
+ if (chan2) {
+ del_len = mus_seconds_to_samples(delay2);
+ outdel2 = mus_make_delay(del_len, NULL, del_len,
+ MUS_INTERP_LINEAR);
+ }
+ if (doubled || chan4) {
+ del_len = mus_seconds_to_samples(delay3);
+ outdel3 = mus_make_delay(del_len, NULL, del_len,
+ MUS_INTERP_LINEAR);
+ }
+ if (chan4 || (doubled && chan2)) {
+ del_len = mus_seconds_to_samples(delay4);
+ outdel4 = mus_make_delay(del_len, NULL, del_len,
+ MUS_INTERP_LINEAR);
+ }
+ if (amp_env)
+ env_a = mus_make_env(amp_env, amp_len / 2, volume, 0.0, 1.0,
+ dur, 0, NULL);
+ if (doubled && chan4)
+ INS_MISC_ERROR(S_jc_reverb, JC_WARN);
+ for (i = beg; i < len; i++) {
+ int j;
+ mus_float_t ho;
+
+ for (j = 0, ho = 0.0; j < rev_chans; j++)
+ ho += mus_in_any(i, j, rev);
+ allpass_sum = mus_all_pass_unmodulated(allpass3,
+ mus_all_pass_unmodulated(allpass2,
+ mus_all_pass_unmodulated(allpass1, ho)));
+ comb_sum_2 = comb_sum_1;
+ comb_sum_1 = comb_sum;
+ comb_sum = mus_comb_unmodulated(comb1, allpass_sum) +
+ mus_comb_unmodulated(comb2, allpass_sum) +
+ mus_comb_unmodulated(comb3, allpass_sum) +
+ mus_comb_unmodulated(comb4, allpass_sum);
+ if (low_pass)
+ all_sums = 0.25 * (comb_sum + comb_sum_2) +
+ 0.5 * comb_sum_1;
+ else
+ all_sums = comb_sum;
+ delA = mus_delay_unmodulated(outdel1, all_sums);
+ if (doubled)
+ delA += mus_delay_unmodulated(outdel3, all_sums);
+ if (env_a)
+ volume = mus_env(env_a);
+ mus_out_any(i, delA * volume, 0, out);
+ if (chan2) {
+ delB = mus_delay_unmodulated(outdel2, all_sums);
+ if (doubled)
+ delB += mus_delay_unmodulated(outdel4,
+ all_sums);
+ mus_out_any(i, delB * volume, 1, out);
+ if (chan4) {
+ mus_out_any(i, volume *
+ mus_delay_unmodulated(outdel3, all_sums),
+ 2, out);
+ mus_out_any(i, volume *
+ mus_delay_unmodulated(outdel4, all_sums),
+ 3, out);
+ }
+ }
}
- }
-
- mus_free(allpass1);
- mus_free(allpass2);
- mus_free(allpass3);
- mus_free(comb1);
- mus_free(comb2);
- mus_free(comb3);
- mus_free(comb4);
- mus_free(outdel1);
- if (outdel2) mus_free(outdel2);
- if (outdel3) mus_free(outdel3);
- if (outdel4) mus_free(outdel4);
- if (env_a) mus_free(env_a);
- return i;
+ mus_free(allpass1);
+ mus_free(allpass2);
+ mus_free(allpass3);
+ mus_free(comb1);
+ mus_free(comb2);
+ mus_free(comb3);
+ mus_free(comb4);
+ mus_free(outdel1);
+ if (outdel2)
+ mus_free(outdel2);
+ if (outdel3)
+ mus_free(outdel3);
+ if (outdel4)
+ mus_free(outdel4);
+ if (env_a)
+ mus_free(env_a);
+ return (i);
}
-off_t
-ins_nrev(mus_float_t start,
- mus_float_t dur,
- mus_float_t reverb_factor,
- mus_float_t lp_coeff,
- mus_float_t lp_out_coeff,
- mus_float_t output_scale,
- mus_float_t volume,
- mus_float_t *amp_env,
- int amp_len,
- mus_any *out,
- mus_any *rev)
+mus_long_t
+ins_nrev(mus_float_t start, mus_float_t dur, mus_float_t reverb_factor,
+ mus_float_t lp_coeff, mus_float_t lp_out_coeff, mus_float_t output_scale,
+ mus_float_t volume, mus_float_t *amp_env, int amp_len,
+ mus_any *out, mus_any *rev)
{
- off_t i, beg, len;
- int chans = 0, rev_chans = 0, val = 0;
- int dly_len[15] = {1433, 1601, 1867, 2053, 2251, 2399, 347, 113, 37, 59, 53, 43, 37, 29, 19};
- mus_float_t srscale = mus_srate() / 25641.0;
- mus_float_t sample_a = 0.0, sample_b = 0.0, sample_c = 0.0, sample_d = 0.0;
- mus_float_t inrev = 0.0, outrev = 0.0;
- mus_any *allpass1 = NULL, *allpass2 = NULL, *allpass3 = NULL, *allpass4 = NULL;
- mus_any *allpass5 = NULL, *allpass6 = NULL, *allpass7 = NULL, *allpass8 = NULL;
- mus_any *comb1 = NULL, *comb2 = NULL, *comb3 = NULL;
- mus_any *comb4 = NULL, *comb5 = NULL, *comb6 = NULL;
- mus_any *low = NULL, *low_a = NULL, *low_b = NULL, *low_c = NULL, *low_d = NULL;
- mus_any *env_a = NULL;
-
- beg = mus_seconds_to_samples(start);
-
- if (dur > 0.0)
- len = beg + mus_seconds_to_samples(dur);
- else
- len = beg + mus_seconds_to_samples(1.0) + mus_sound_frames(mus_file_name(rev));
-
- chans = mus_channels(out);
- rev_chans = mus_channels(rev);
- env_a = mus_make_env(amp_env, amp_len / 2, output_scale, 0.0, 1.0, dur, 0, NULL);
-
- for (i = 0; i < 14; i++)
- {
- int x = dly_len[i];
-
- val = (int)floor(srscale * x);
- if (!(val % 2)) val++;
- while (!prime_p(val)) val += 2;
- dly_len[i] = val;
- }
-
- i = 0;
- comb1 = mus_make_comb(reverb_factor * 0.822, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR);
- i++;
- comb2 = mus_make_comb(reverb_factor * 0.802, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR);
- i++;
- comb3 = mus_make_comb(reverb_factor * 0.773, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR);
- i++;
- comb4 = mus_make_comb(reverb_factor * 0.753, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR);
- i++;
- comb5 = mus_make_comb(reverb_factor * 0.753, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR);
- i++;
- comb6 = mus_make_comb(reverb_factor * 0.733, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR);
- i++;
- low = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
- low_a = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
- low_b = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
- low_c = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
- low_d = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
- allpass1 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR); i++;
- allpass2 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR); i++;
- allpass3 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR);
- i += 2;
- allpass4 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR); i++;
- allpass5 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR); i++;
- allpass6 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR); i++;
- allpass7 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR); i++;
- allpass8 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i], MUS_INTERP_LINEAR);
-
- for (i = beg; i < len; i++)
- {
- int j;
- mus_float_t ho;
-
- for (j = 0, ho = 0.0; j < rev_chans; j++) ho += mus_in_any(i, j, rev);
- inrev = volume * mus_env(env_a) * ho;
- outrev = mus_all_pass_unmodulated(allpass4,
- mus_one_pole(low,
- mus_all_pass_unmodulated(allpass3,
- mus_all_pass_unmodulated(allpass2,
- mus_all_pass_unmodulated(allpass1,
- mus_comb_unmodulated(comb1, inrev) +
- mus_comb_unmodulated(comb2, inrev) +
- mus_comb_unmodulated(comb3, inrev) +
- mus_comb_unmodulated(comb4, inrev) +
- mus_comb_unmodulated(comb5, inrev) +
- mus_comb_unmodulated(comb6, inrev))))));
- sample_a = output_scale * mus_one_pole(low_a, mus_all_pass_unmodulated(allpass5, outrev));
- sample_b = output_scale * mus_one_pole(low_b, mus_all_pass_unmodulated(allpass6, outrev));
- sample_c = output_scale * mus_one_pole(low_c, mus_all_pass_unmodulated(allpass7, outrev));
- sample_d = output_scale * mus_one_pole(low_d, mus_all_pass_unmodulated(allpass8, outrev));
-
- if (chans == 2)
- mus_out_any(i, (sample_a + sample_d) / 2.0, 0, out);
- else
- mus_out_any(i, sample_a, 0, out);
-
- if ((chans == 2) || (chans == 4))
- {
- if (chans == 2)
- mus_out_any(i, (sample_b + sample_c) / 2.0, 1, out);
- else
- mus_out_any(i, sample_b, 1, out);
+ mus_long_t i, beg, len;
+ int chans, rev_chans, val;
+ int dly_len[15] = {1433, 1601, 1867, 2053, 2251, 2399, 347, 113,
+ 37, 59, 53, 43, 37, 29, 19};
+ mus_float_t srscale;
+ mus_float_t sample_a, sample_b, sample_c, sample_d;
+ mus_float_t inrev, outrev;
+ mus_any *allpass1, *allpass2, *allpass3, *allpass4;
+ mus_any *allpass5, *allpass6, *allpass7, *allpass8;
+ mus_any *comb1, *comb2, *comb3, *comb4, *comb5, *comb6;
+ mus_any *low, *low_a, *low_b, *low_c, *low_d, *env_a;
+
+ chans = rev_chans = val = 0;
+ srscale = mus_srate() / 25641.0;
+ sample_a = sample_b = sample_c = sample_d = inrev = outrev = 0.0;
+ beg = mus_seconds_to_samples(start);
+ if (dur > 0.0)
+ len = beg + mus_seconds_to_samples(dur);
+ else
+ len = beg + mus_seconds_to_samples(1.0) +
+ mus_sound_framples(mus_file_name(rev));
+ chans = mus_channels(out);
+ rev_chans = mus_channels(rev);
+ env_a = mus_make_env(amp_env, amp_len / 2, output_scale, 0.0, 1.0,
+ dur, 0, NULL);
+ for (i = 0; i < 14; i++) {
+ int x;
+
+ x = dly_len[i];
+ val = (int)floor(srscale * x);
+ if ((val % 2) == 0)
+ val++;
+ while (!prime_p(val))
+ val += 2;
+ dly_len[i] = val;
}
-
- if (chans == 4)
- {
- mus_out_any(i, sample_c, 2, out);
- mus_out_any(i, sample_d, 3, out);
+ i = 0;
+ comb1 = mus_make_comb(reverb_factor * 0.822, dly_len[i], NULL,
+ dly_len[i], MUS_INTERP_LINEAR);
+ i++;
+ comb2 = mus_make_comb(reverb_factor * 0.802, dly_len[i], NULL,
+ dly_len[i], MUS_INTERP_LINEAR);
+ i++;
+ comb3 = mus_make_comb(reverb_factor * 0.773, dly_len[i], NULL,
+ dly_len[i], MUS_INTERP_LINEAR);
+ i++;
+ comb4 = mus_make_comb(reverb_factor * 0.753, dly_len[i], NULL,
+ dly_len[i], MUS_INTERP_LINEAR);
+ i++;
+ comb5 = mus_make_comb(reverb_factor * 0.753, dly_len[i], NULL,
+ dly_len[i], MUS_INTERP_LINEAR);
+ i++;
+ comb6 = mus_make_comb(reverb_factor * 0.733, dly_len[i], NULL,
+ dly_len[i], MUS_INTERP_LINEAR);
+ i++;
+ low = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
+ low_a = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
+ low_b = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
+ low_c = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
+ low_d = mus_make_one_pole(lp_out_coeff, lp_coeff - 1.0);
+ allpass1 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i],
+ MUS_INTERP_LINEAR);
+ i++;
+ allpass2 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i],
+ MUS_INTERP_LINEAR);
+ i++;
+ allpass3 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i],
+ MUS_INTERP_LINEAR);
+ i += 2;
+ allpass4 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i],
+ MUS_INTERP_LINEAR);
+ i++;
+ allpass5 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i],
+ MUS_INTERP_LINEAR);
+ i++;
+ allpass6 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i],
+ MUS_INTERP_LINEAR);
+ i++;
+ allpass7 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i],
+ MUS_INTERP_LINEAR);
+ i++;
+ allpass8 = mus_make_all_pass(-0.7, 0.7, dly_len[i], NULL, dly_len[i],
+ MUS_INTERP_LINEAR);
+ for (i = beg; i < len; i++) {
+ int j;
+ mus_float_t ho;
+
+ for (j = 0, ho = 0.0; j < rev_chans; j++)
+ ho += mus_in_any(i, j, rev);
+ inrev = volume * mus_env(env_a) * ho;
+ outrev = mus_all_pass_unmodulated(allpass4,
+ mus_one_pole(low, mus_all_pass_unmodulated(allpass3,
+ mus_all_pass_unmodulated(allpass2,
+ mus_all_pass_unmodulated(allpass1,
+ mus_comb_unmodulated(comb1, inrev) +
+ mus_comb_unmodulated(comb2, inrev) +
+ mus_comb_unmodulated(comb3, inrev) +
+ mus_comb_unmodulated(comb4, inrev) +
+ mus_comb_unmodulated(comb5, inrev) +
+ mus_comb_unmodulated(comb6, inrev))))));
+ sample_a = output_scale * mus_one_pole(low_a,
+ mus_all_pass_unmodulated(allpass5, outrev));
+ sample_b = output_scale * mus_one_pole(low_b,
+ mus_all_pass_unmodulated(allpass6, outrev));
+ sample_c = output_scale * mus_one_pole(low_c,
+ mus_all_pass_unmodulated(allpass7, outrev));
+ sample_d = output_scale * mus_one_pole(low_d,
+ mus_all_pass_unmodulated(allpass8, outrev));
+ if (chans == 2)
+ mus_out_any(i, (sample_a + sample_d) / 2.0, 0, out);
+ else
+ mus_out_any(i, sample_a, 0, out);
+ if (chans == 2 || chans == 4) {
+ if (chans == 2)
+ mus_out_any(i,
+ (sample_b + sample_c) / 2.0, 1, out);
+ else
+ mus_out_any(i, sample_b, 1, out);
+ }
+ if (chans == 4) {
+ mus_out_any(i, sample_c, 2, out);
+ mus_out_any(i, sample_d, 3, out);
+ }
}
- }
-
- mus_free(allpass1);
- mus_free(allpass2);
- mus_free(allpass3);
- mus_free(allpass4);
- mus_free(allpass5);
- mus_free(allpass6);
- mus_free(allpass7);
- mus_free(allpass8);
- mus_free(comb1);
- mus_free(comb2);
- mus_free(comb3);
- mus_free(comb4);
- mus_free(comb5);
- mus_free(comb6);
- mus_free(env_a);
- mus_free(low);
- mus_free(low_a);
- mus_free(low_b);
- mus_free(low_c);
- mus_free(low_d);
- return i;
+ mus_free(allpass1);
+ mus_free(allpass2);
+ mus_free(allpass3);
+ mus_free(allpass4);
+ mus_free(allpass5);
+ mus_free(allpass6);
+ mus_free(allpass7);
+ mus_free(allpass8);
+ mus_free(comb1);
+ mus_free(comb2);
+ mus_free(comb3);
+ mus_free(comb4);
+ mus_free(comb5);
+ mus_free(comb6);
+ mus_free(env_a);
+ mus_free(low);
+ mus_free(low_a);
+ mus_free(low_b);
+ mus_free(low_c);
+ mus_free(low_d);
+ return (i);
}
-off_t
-ins_freeverb(mus_float_t start,
- mus_float_t dur,
- mus_float_t room_decay,
- mus_float_t damping,
- mus_float_t global,
- mus_float_t predelay,
- mus_float_t output_gain,
- mus_float_t scale_room_decay,
- mus_float_t offset_room_decay,
- mus_float_t scale_damping,
- mus_float_t stereo_spread,
- int *combtuning,
- int comb_len,
- int *allpasstuning,
- int all_len,
- mus_any *output_mixer,
- mus_any *out,
- mus_any *rev)
+#define FV_WARN "input must be mono or in channels must equal out channels"
+#define ins_fcomb(Gen, Val) mus_fcomb(Gen, Val, 0.0)
+#define ins_delay(Gen, Val) mus_delay_unmodulated(Gen, Val)
+#define ins_all_pass(Gen, Val) mus_all_pass_unmodulated(Gen, Val)
+
+mus_long_t
+ins_freeverb(mus_float_t start, mus_float_t dur, mus_float_t room_decay,
+ mus_float_t damping, mus_float_t global, mus_float_t predelay,
+ mus_float_t output_gain, mus_float_t scale_room_decay,
+ mus_float_t offset_room_decay, mus_float_t scale_damping,
+ mus_float_t stereo_spread, int *combtuning, int comb_len,
+ int *allpasstuning, int all_len, vct *output_mixer,
+ mus_any *out, mus_any *rev)
{
- off_t i, beg, len;
- int out_chans = 0, in_chans = 0;
- mus_float_t srate_scale = mus_srate() / 44100.0;
- mus_float_t local_gain = 0.0, global_gain = 0.0;
- mus_float_t tmp;
- mus_any *out_mix = NULL, *out_buf = NULL, *f_out = NULL, *f_in = NULL;
-
- beg = mus_seconds_to_samples(start);
- if (dur > 0.0)
- len = beg + mus_seconds_to_samples(dur);
- else
- len = beg + mus_seconds_to_samples(1.0) + mus_sound_frames(mus_file_name(rev));
- out_chans = mus_channels(out);
- in_chans = mus_channels(rev);
- if (in_chans > 1 && in_chans != out_chans)
- INS_MISC_ERROR(S_freeverb, "input must be mono or in channels must equal out channels");
- out_buf = mus_make_empty_frame(out_chans);
- f_out = mus_make_empty_frame(out_chans);
- f_in = mus_make_empty_frame(in_chans);
- local_gain = (1.0 - global) * (1.0 - 1.0 / out_chans) + 1.0 / out_chans;
- tmp = (out_chans * out_chans - out_chans);
- if (tmp < 1.0) tmp = 1.0;
- global_gain = (out_chans - local_gain * out_chans) / tmp;
- if (mus_mixer_p(output_mixer))
- out_mix = output_mixer;
- else
- {
- out_mix = mus_make_empty_mixer(out_chans);
- for (i = 0; i < out_chans; i++)
- {
- int j;
-
- for (j = 0; j < out_chans; j++)
- mus_mixer_set(out_mix, i, j,
- (mus_float_t)((output_gain *
- ((i == j) ? local_gain : global_gain)) / out_chans));
- }
- }
- {
- mus_any **predelays = (mus_any **)malloc(in_chans * sizeof(mus_any *));
- mus_any ***allpasses = (mus_any ***)malloc(out_chans * sizeof(mus_any **));
- mus_any ***combs = (mus_any ***)malloc(out_chans * sizeof(mus_any **));
- mus_float_t room_decay_val = room_decay * scale_room_decay + offset_room_decay;
- int j, k, size;
-
- for (i = 0; i < out_chans; i++)
- {
- allpasses[i] = (mus_any **)malloc(all_len * sizeof(mus_any *));
- combs[i] = (mus_any **)malloc(comb_len * sizeof(mus_any *));
- }
-
- /* predelays */
- for (i = 0; i < in_chans; i++)
- {
- size = (int)floor(mus_srate() * predelay);
- predelays[i] = mus_make_delay(size, NULL, size, MUS_INTERP_LINEAR);
- }
-
- for (i = 0; i < out_chans; i++)
- {
- /* comb filters */
- for (j = 0; j < comb_len; j++)
- {
- mus_float_t dmp = scale_damping * damping;
-
- size = (int)floor(srate_scale * combtuning[j]);
- if (i % 2) size += (int)floor(srate_scale * stereo_spread);
- combs[i][j] = mus_make_fcomb(room_decay_val, size, 1.0 - dmp, dmp);
- }
- /* allpass filters */
- for (j = 0; j < all_len; j++)
- {
- size = (int)floor(srate_scale * allpasstuning[j]);
- if (i % 2) size += (int)floor(srate_scale * stereo_spread);
- allpasses[i][j] = mus_make_all_pass(0.5, -1.0, size, NULL, size, MUS_INTERP_LINEAR);
- }
- }
-
- /* run loop */
- for (i = beg; i < len; i++)
- {
- f_in = mus_file_to_frame(rev, i, f_in);
- if (in_chans > 1)
- for (j = 0; j < out_chans; j++)
- {
- mus_frame_set(f_in, j, mus_delay_unmodulated(predelays[j], mus_frame_ref(f_in, j)));
- mus_frame_set(f_out, j, 0.0);
- for (k = 0; k < comb_len; k++)
- mus_frame_set(f_out, j,
- mus_frame_ref(f_out, j) +
- mus_fcomb(combs[j][k], mus_frame_ref(f_in, j), 0.0));
- }
+ mus_long_t i, beg, len;
+ int out_chans, in_chans, j, k, size;
+ mus_float_t srate_scale;
+ mus_float_t local_gain, global_gain;
+ mus_float_t room_decay_val, tmp;
+ vct *out_mix = NULL, *out_buf = NULL, *f_out = NULL, *f_in = NULL;
+ mus_any **predelays, ***allpasses, ***combs;
+ mus_any *g;
+ mus_float_t *om, *ob, *fo;
+
+ out_chans = in_chans = 0;
+ srate_scale = mus_srate() / 44100.0;
+ local_gain = global_gain = 0.0;
+ beg = mus_seconds_to_samples(start);
+ if (dur > 0.0)
+ len = beg + mus_seconds_to_samples(dur);
else
- {
- mus_frame_set(f_in, 0, mus_delay_unmodulated(predelays[0], mus_frame_ref(f_in, 0)));
- for (j = 0; j < out_chans; j++)
- {
- mus_frame_set(f_out, j, 0.0);
- for (k = 0; k < comb_len; k++)
- mus_frame_set(f_out, j,
- mus_frame_ref(f_out, j) +
- mus_fcomb(combs[j][k], mus_frame_ref(f_in, 0), 0.0));
- }
- }
- for (j = 0; j < out_chans; j++)
- for (k = 0; k < all_len; k++)
- mus_frame_set(f_out, j,
- mus_all_pass_unmodulated(allpasses[j][k], mus_frame_ref(f_out, j)));
- mus_frame_to_file(out, i, mus_frame_to_frame(out_mix, f_out, out_buf));
- } /* run loop */
-
- for (i = 0; i < in_chans; i++)
- mus_free(predelays[i]);
-
- free(predelays);
-
- for (i = 0; i < out_chans; i++)
- {
- for (j = 0; j < comb_len; j++)
- mus_free(combs[i][j]);
- free(combs[i]);
- for (j = 0; j < all_len; j++)
- mus_free(allpasses[i][j]);
- free(allpasses[i]);
- }
- free(combs);
- free(allpasses);
- } /* block */
-
- if (!output_mixer) mus_free(out_mix);
- mus_free(out_buf);
- mus_free(f_out);
- mus_free(f_in);
- return i;
+ len = beg + mus_seconds_to_samples(1.0) +
+ mus_sound_framples(mus_file_name(rev));
+ out_chans = mus_channels(out);
+ in_chans = mus_channels(rev);
+ if (in_chans > 1 && in_chans != out_chans)
+ INS_MISC_ERROR(S_freeverb, FV_WARN);
+ out_buf = mus_vct_make(out_chans);
+ f_out = mus_vct_make(out_chans);
+ f_in = mus_vct_make(in_chans);
+ local_gain = (1.0 - global)*(1.0 - 1.0 / out_chans) + 1.0 / out_chans;
+ tmp = (out_chans * out_chans - out_chans);
+ if (tmp < 1.0)
+ tmp = 1.0;
+ global_gain = (out_chans - local_gain * out_chans) / tmp;
+ if (output_mixer != NULL)
+ out_mix = output_mixer;
+ else {
+ out_mix = mus_vct_make(out_chans * out_chans);
+ for (i = 0; i < out_chans; i++) {
+ int j;
+
+ for (j = 0; j < out_chans; j++) {
+ if (i == j)
+ tmp = output_gain * local_gain;
+ else
+ tmp = output_gain * global_gain;
+ mus_vct_data(out_mix)[i + j] = tmp / out_chans;
+ }
+ }
+ }
+ predelays = malloc(in_chans * sizeof(mus_any *));
+ if (predelays == NULL)
+ INS_NO_MEMORY_ERROR("ins_freeverb");
+ allpasses = malloc(out_chans * sizeof(mus_any **));
+ if (allpasses == NULL)
+ INS_NO_MEMORY_ERROR("ins_freeverb");
+ combs = malloc(out_chans * sizeof(mus_any **));
+ if (combs == NULL)
+ INS_NO_MEMORY_ERROR("ins_freeverb");
+ room_decay_val = room_decay * scale_room_decay +
+ offset_room_decay;
+ for (i = 0; i < out_chans; i++) {
+ allpasses[i] = malloc(all_len * sizeof(mus_any *));
+ if (allpasses[i] == NULL)
+ INS_NO_MEMORY_ERROR("ins_freeverb");
+ combs[i] = malloc(comb_len * sizeof(mus_any *));
+ if (combs[i] == NULL)
+ INS_NO_MEMORY_ERROR("ins_freeverb");
+ }
+ /* predelays */
+ for (i = 0; i < in_chans; i++) {
+ size = (int)floor(mus_srate() * predelay);
+ predelays[i] = mus_make_delay(size, NULL, size,
+ MUS_INTERP_LINEAR);
+ }
+ for (i = 0; i < out_chans; i++) {
+ /* comb filters */
+ for (j = 0; j < comb_len; j++) {
+ tmp = scale_damping * damping;
+ size = (int)floor(srate_scale * combtuning[j]);
+ if ((i % 2) != 0)
+ size += (int)floor(srate_scale * stereo_spread);
+ combs[i][j] = mus_make_fcomb(room_decay_val, size,
+ 1.0 - tmp, tmp);
+ }
+ /* allpass filters */
+ for (j = 0; j < all_len; j++) {
+ size = (int)floor(srate_scale * allpasstuning[j]);
+ if ((i % 2) != 0)
+ size += (int)floor(srate_scale * stereo_spread);
+ allpasses[i][j] = mus_make_all_pass(0.5, -1.0, size,
+ NULL, size, MUS_INTERP_LINEAR);
+ }
+ }
+ om = mus_vct_data(out_mix);
+ ob = mus_vct_data(out_buf);
+ fo = mus_vct_data(f_out);
+ /* run loop */
+ if (in_chans == 1) {
+ mus_float_t f;
+
+ for (i = beg; i < len; i++) {
+ f = mus_file_to_sample(rev, i, 0);
+ f = ins_delay(predelays[0], f);
+ for (j = 0; j < out_chans; j++) {
+ fo[j] = 0.0;
+ for (k = 0; k < comb_len; k++)
+ fo[j] += ins_fcomb(combs[j][k], f);
+ }
+ for (j = 0; j < out_chans; j++)
+ for (k = 0; k < all_len; k++) {
+ g = allpasses[j][k];
+ fo[j] = ins_all_pass(g, fo[j]);
+ }
+ ob = mus_frample_to_frample(om, out_chans,
+ fo, out_chans, ob, out_chans);
+ mus_frample_to_file(out, i, ob);
+ }
+ } else {
+ mus_float_t *fi, f;
+
+ fi = mus_vct_data(f_in);
+ for (i = beg; i < len; i++) {
+ fi = mus_file_to_frample(rev, i, fi);
+ for (j = 0; j < out_chans; j++) {
+ f = ins_delay(predelays[j], fi[j]);
+ fo[j] = 0.0;
+ for (k = 0; k < comb_len; k++)
+ fo[j] += ins_fcomb(combs[j][k], f);
+ }
+ for (j = 0; j < out_chans; j++)
+ for (k = 0; k < all_len; k++) {
+ g = allpasses[j][k];
+ fo[j] = ins_all_pass(g, fo[j]);
+ }
+ ob = mus_frample_to_frample(om, out_chans,
+ fo, out_chans, ob, out_chans);
+ mus_frample_to_file(out, i, ob);
+ }
+ } /* run loop */
+ for (i = 0; i < in_chans; i++)
+ mus_free(predelays[i]);
+ free(predelays);
+ for (i = 0; i < out_chans; i++) {
+ for (j = 0; j < comb_len; j++)
+ mus_free(combs[i][j]);
+ free(combs[i]);
+ for (j = 0; j < all_len; j++)
+ mus_free(allpasses[i][j]);
+ free(allpasses[i]);
+ }
+ free(combs);
+ free(allpasses);
+ if (!output_mixer)
+ mus_vct_free(out_mix);
+ mus_vct_free(out_buf);
+ mus_vct_free(f_out);
+ mus_vct_free(f_in);
+ return (i);
}
#define h_fm_violin_args "\
+keyword arguments with default values:\n\
:startime 0.0\n\
:duration 1.0\n\
:frequency 440.0\n\
@@ -1380,263 +1628,323 @@ ins_freeverb(mus_float_t start,
:index-type " INS_SYMBOL_PREFIX "violin (" INS_SYMBOL_PREFIX "cello or " INS_SYMBOL_PREFIX "violin)\n\
:no-waveshaping " INS_FALSE
-#if HAVE_RUBY
-# define H_fm_violin S_fm_violin "(*args)\n" h_fm_violin_args "\n\
+#if defined(HAVE_RUBY)
+#define H_fm_violin S_fm_violin "(*args)\n" h_fm_violin_args "\n\
require 'ws'\n\
require 'sndins'\n\
with_sound(:reverb, :jc_reverb, :reverb_data, [:volume, 0.8]) do\n\
fm_violin(0, 1, 440, 0.2, :fm_index, 1.3)\n\
end"
-#else /* !HAVE_RUBY */
-# if HAVE_FORTH
-# define H_fm_violin S_fm_violin " ( args -- )\n" h_fm_violin_args "\n\
+#elif defined(HAVE_FORTH)
+#define H_fm_violin S_fm_violin " ( args -- )\n" h_fm_violin_args "\n\
require clm\n\
dl-load sndins Init_sndins\n\
0 1 440 0.2 :fm-index 1.3 <'> fm-violin\n\
:reverb <'> jc-reverb :reverb-data #( :volume 0.8 ) with-sound"
-# else /* !HAVE_FORTH */
-# define H_fm_violin "(" S_fm_violin " . args)\n" h_fm_violin_args "\n\
- (load-from-path \"ws\")\n\
- (load-extension \"libsndins\" \"Init_sndins\")\n\
- (with-sound (:reverb jc-reverb :reverb-data '(:volume 0.8))\n\
- (fm-violin 0 1 440 0.2 :fm-index 1.3))"
-# endif /* !HAVE_FORTH */
-#endif /* !HAVE_RUBY */
-
-#if HAVE_FORTH
+#else /* HAVE_SCHEME */
+#define H_fm_violin "(" S_fm_violin " . args)\n" h_fm_violin_args "\n\
+(load \"ws.scm\")\n\
+(load-extension \"libsndins\" \"Init_sndins\")\n\
+(with-sound (:reverb jc-reverb :reverb-data '(:volume 0.8))\n\
+ (fm-violin 0 1 440 0.2 :fm-index 1.3))"
+#endif
+
+#if defined(HAVE_FORTH)
static void
#else
-static XEN
+static Xen
#endif
-c_fm_violin(XEN args)
+c_fm_violin(Xen args)
{
-#define V_LAST_KEY 33
-#define XEN_V_INS_VIOLIN 1
-#define XEN_V_INS_CELLO 0
- off_t result;
- int vals = 0, lst_len = XEN_LIST_LENGTH(args);
- int mode = MUS_INTERP_LINEAR;
- int amp_len = 8, gls_len = 4, fm1_len = 8, fm2_len = 8, fm3_len = 8;
- bool index_type = (bool)XEN_V_INS_VIOLIN, no_waveshaping = false;
- bool amp_del = false, gls_del = false, fm1_del = false, fm2_del = false, fm3_del = false;
- mus_float_t start = 0.0, dur = 1.0, freq = 440.0, amp = 0.5, fm_index = 1.0;
- mus_float_t tamp_env[8] = {0.0, 0.0, 25.0, 1.0, 75.0, 1.0, 100.0, 0.0};
- mus_float_t periodic_vibrato_rate = 5.0, periodic_vibrato_amp = 0.0025;
- mus_float_t random_vibrato_rate = 16.0, random_vibrato_amp = 0.005;
- mus_float_t noise_freq = 1000.0, noise_amount = 0.0;
- mus_float_t ind_noise_freq = 10.0, ind_noise_amount = 0.0;
- mus_float_t amp_noise_freq = 20.0, amp_noise_amount = 0.0;
- mus_float_t tgliss_env[4] = {0.0, 0.0, 100.0, 0.0}, gliss_amount = 0.0;
- mus_float_t tfm_env[8] = {0.0, 1.0, 25.0, 0.4, 75.0, 0.6, 100.0, 0.0};
- mus_float_t fm1_rat = 1.0, fm2_rat = 3.0, fm3_rat = 4.0;
- mus_float_t fm1_index = 0.0, fm2_index = 0.0, fm3_index = 0.0, base = 1.0;
- mus_float_t degree = 0.0, distance = 1.0, reverb_amount = 0.01;
- mus_float_t *amp_env = NULL, *gliss_env = NULL, *fm1_env = NULL, *fm2_env = NULL, *fm3_env = NULL;
- mus_any *out = NULL, *rev = NULL;
- XEN kargs[V_LAST_KEY * 2], keys[V_LAST_KEY];
- int orig_arg[V_LAST_KEY] = {0};
- int i = 0;
-
- keys[i++] = allkeys[C_startime];
- keys[i++] = allkeys[C_duration];
- keys[i++] = allkeys[C_frequency];
- keys[i++] = allkeys[C_amplitude];
- keys[i++] = allkeys[C_fm_index];
- keys[i++] = allkeys[C_amp_env];
- keys[i++] = allkeys[C_periodic_vibrato_rate];
- keys[i++] = allkeys[C_periodic_vibrato_amplitude];
- keys[i++] = allkeys[C_random_vibrato_rate];
- keys[i++] = allkeys[C_random_vibrato_amplitude];
- keys[i++] = allkeys[C_noise_freq];
- keys[i++] = allkeys[C_noise_amount];
- keys[i++] = allkeys[C_ind_noise_freq];
- keys[i++] = allkeys[C_ind_noise_amount];
- keys[i++] = allkeys[C_amp_noise_freq];
- keys[i++] = allkeys[C_amp_noise_amount];
- keys[i++] = allkeys[C_gliss_env];
- keys[i++] = allkeys[C_glissando_amount];
- keys[i++] = allkeys[C_fm1_env];
- keys[i++] = allkeys[C_fm2_env];
- keys[i++] = allkeys[C_fm3_env];
- keys[i++] = allkeys[C_fm1_rat];
- keys[i++] = allkeys[C_fm2_rat];
- keys[i++] = allkeys[C_fm3_rat];
- keys[i++] = allkeys[C_fm1_index];
- keys[i++] = allkeys[C_fm2_index];
- keys[i++] = allkeys[C_fm3_index];
- keys[i++] = allkeys[C_base];
- keys[i++] = allkeys[C_degree];
- keys[i++] = allkeys[C_distance];
- keys[i++] = allkeys[C_reverb_amount];
- keys[i++] = allkeys[C_index_type];
- keys[i++] = allkeys[C_no_waveshaping];
-
- for (i = 0; i < V_LAST_KEY * 2; i++) kargs[i] = XEN_UNDEFINED;
- for (i = 0; i < lst_len; i++) kargs[i] = XEN_LIST_REF(args, i);
- vals = mus_optkey_unscramble(S_fm_violin, V_LAST_KEY, keys, kargs, orig_arg);
-
- if (vals > 0)
- {
- i = 0;
- start = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], start); i++;
- dur = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], dur); i++;
- freq = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], freq); i++;
- amp = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], amp); i++;
- fm_index = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], fm_index); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_fm_violin, "a list");
- amp_env = xen_list2array(keys[i]);
- amp_len = XEN_LIST_LENGTH(keys[i]);
- }
- i++;
- periodic_vibrato_rate = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i],
- periodic_vibrato_rate); i++;
- periodic_vibrato_amp = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i],
- periodic_vibrato_amp); i++;
- random_vibrato_rate = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i],
- random_vibrato_rate); i++;
- random_vibrato_amp = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i],
- random_vibrato_amp); i++;
- noise_freq = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], noise_freq); i++;
- noise_amount = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], noise_amount); i++;
- ind_noise_freq = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i],
- ind_noise_freq); i++;
- ind_noise_amount = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i],
- ind_noise_amount); i++;
- amp_noise_freq = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i],
- amp_noise_freq); i++;
- amp_noise_amount = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i],
- amp_noise_amount); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_fm_violin, "a list");
- gliss_env = xen_list2array(keys[i]);
- gls_len = XEN_LIST_LENGTH(keys[i]);
+#define V_LAST_KEY 33
+#define V_INS_VIOLIN 1
+#define V_INS_CELLO 0
+ mus_long_t result;
+ int i, vals, lst_len, mode, amp_len, gls_len;
+ int fm1_len, fm2_len, fm3_len;
+ bool index_type, no_waveshaping;
+ bool amp_del, gls_del, fm1_del, fm2_del, fm3_del;
+ mus_float_t start, dur, freq, amp, fm_index;
+ mus_float_t tamp_env[8] = {0.0, 0.0, 25.0, 1.0, 75.0, 1.0, 100.0, 0.0};
+ mus_float_t periodic_vibrato_rate, periodic_vibrato_amp;
+ mus_float_t random_vibrato_rate, random_vibrato_amp;
+ mus_float_t noise_freq, noise_amount;
+ mus_float_t ind_noise_freq, ind_noise_amount;
+ mus_float_t amp_noise_freq, amp_noise_amount;
+ mus_float_t tgliss_env[4] = {0.0, 0.0, 100.0, 0.0};
+ mus_float_t gliss_amount;
+ mus_float_t tfm_env[8] = {0.0, 1.0, 25.0, 0.4, 75.0, 0.6, 100.0, 0.0};
+ mus_float_t fm1_rat, fm2_rat, fm3_rat;
+ mus_float_t fm1_index, fm2_index, fm3_index, base;
+ mus_float_t degree, distance, reverb_amount;
+ mus_float_t *amp_env = NULL, *gliss_env = NULL;
+ mus_float_t *fm1_env = NULL, *fm2_env = NULL, *fm3_env = NULL;
+ mus_any *out = NULL, *rev = NULL;
+ Xen kargs[V_LAST_KEY * 2], keys[V_LAST_KEY];
+ int orig_arg[V_LAST_KEY] = {0};
+
+ lst_len = Xen_list_length(args);
+ mode = MUS_INTERP_LINEAR;
+ amp_len = fm1_len = fm2_len = fm3_len = 8;
+ gls_len = 4;
+ index_type = (bool)V_INS_VIOLIN;
+ no_waveshaping = amp_del = gls_del = false;
+ fm1_del = fm2_del = fm3_del = false;
+ start = 0.0;
+ dur = 1.0;
+ freq = 440.0;
+ amp = 0.5;
+ fm_index = 1.0;
+ periodic_vibrato_rate = 5.0;
+ periodic_vibrato_amp = 0.0025;
+ random_vibrato_rate = 16.0;
+ random_vibrato_amp = 0.005;
+ noise_freq = 1000.0;
+ noise_amount = 0.0;
+ ind_noise_freq = 10.0;
+ ind_noise_amount = 0.0;
+ amp_noise_freq = 20.0;
+ amp_noise_amount = 0.0;
+ gliss_amount = 0.0;
+ fm1_rat = 1.0;
+ fm2_rat = 3.0;
+ fm3_rat = 4.0;
+ fm1_index = fm2_index = fm3_index = 0.0;
+ base = 1.0;
+ degree = 0.0;
+ distance = 1.0;
+ reverb_amount = 0.01;
+ i = 0;
+ keys[i++] = allkeys[C_startime];
+ keys[i++] = allkeys[C_duration];
+ keys[i++] = allkeys[C_frequency];
+ keys[i++] = allkeys[C_amplitude];
+ keys[i++] = allkeys[C_fm_index];
+ keys[i++] = allkeys[C_amp_env];
+ keys[i++] = allkeys[C_periodic_vibrato_rate];
+ keys[i++] = allkeys[C_periodic_vibrato_amplitude];
+ keys[i++] = allkeys[C_random_vibrato_rate];
+ keys[i++] = allkeys[C_random_vibrato_amplitude];
+ keys[i++] = allkeys[C_noise_freq];
+ keys[i++] = allkeys[C_noise_amount];
+ keys[i++] = allkeys[C_ind_noise_freq];
+ keys[i++] = allkeys[C_ind_noise_amount];
+ keys[i++] = allkeys[C_amp_noise_freq];
+ keys[i++] = allkeys[C_amp_noise_amount];
+ keys[i++] = allkeys[C_gliss_env];
+ keys[i++] = allkeys[C_glissando_amount];
+ keys[i++] = allkeys[C_fm1_env];
+ keys[i++] = allkeys[C_fm2_env];
+ keys[i++] = allkeys[C_fm3_env];
+ keys[i++] = allkeys[C_fm1_rat];
+ keys[i++] = allkeys[C_fm2_rat];
+ keys[i++] = allkeys[C_fm3_rat];
+ keys[i++] = allkeys[C_fm1_index];
+ keys[i++] = allkeys[C_fm2_index];
+ keys[i++] = allkeys[C_fm3_index];
+ keys[i++] = allkeys[C_base];
+ keys[i++] = allkeys[C_degree];
+ keys[i++] = allkeys[C_distance];
+ keys[i++] = allkeys[C_reverb_amount];
+ keys[i++] = allkeys[C_index_type];
+ keys[i++] = allkeys[C_no_waveshaping];
+ for (i = 0; i < V_LAST_KEY * 2; i++)
+ kargs[i] = Xen_undefined;
+ for (i = 0; i < lst_len; i++)
+ kargs[i] = Xen_list_ref(args, i);
+ vals = mus_optkey_unscramble(S_fm_violin, V_LAST_KEY, keys, kargs,
+ orig_arg);
+ if (vals > 0) {
+ i = 0;
+ start = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], start);
+ i++;
+ dur = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], dur);
+ i++;
+ freq = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], freq);
+ i++;
+ amp = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], amp);
+ i++;
+ fm_index = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], fm_index);
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_fm_violin, "a list");
+ amp_env = xen_list2array(keys[i]);
+ amp_len = Xen_list_length(keys[i]);
+ }
+ i++;
+ periodic_vibrato_rate = mus_optkey_to_float(keys[i],
+ S_fm_violin, orig_arg[i], periodic_vibrato_rate);
+ i++;
+ periodic_vibrato_amp = mus_optkey_to_float(keys[i],
+ S_fm_violin, orig_arg[i], periodic_vibrato_amp);
+ i++;
+ random_vibrato_rate = mus_optkey_to_float(keys[i],
+ S_fm_violin, orig_arg[i], random_vibrato_rate);
+ i++;
+ random_vibrato_amp = mus_optkey_to_float(keys[i],
+ S_fm_violin, orig_arg[i], random_vibrato_amp);
+ i++;
+ noise_freq = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], noise_freq);
+ i++;
+ noise_amount = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], noise_amount);
+ i++;
+ ind_noise_freq = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], ind_noise_freq);
+ i++;
+ ind_noise_amount = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], ind_noise_amount);
+ i++;
+ amp_noise_freq = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], amp_noise_freq);
+ i++;
+ amp_noise_amount = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], amp_noise_amount);
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_fm_violin, "a list");
+ gliss_env = xen_list2array(keys[i]);
+ gls_len = Xen_list_length(keys[i]);
+ }
+ i++;
+ gliss_amount = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], gliss_amount);
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_fm_violin, "a list");
+ fm1_env = xen_list2array(keys[i]);
+ fm1_len = Xen_list_length(keys[i]);
+ }
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_fm_violin, "a list");
+ fm2_env = xen_list2array(keys[i]);
+ fm2_len = Xen_list_length(keys[i]);
+ }
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_fm_violin, "a list");
+ fm3_env = xen_list2array(keys[i]);
+ fm3_len = Xen_list_length(keys[i]);
+ }
+ i++;
+ fm1_rat = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], fm1_rat);
+ i++;
+ fm2_rat = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], fm2_rat);
+ i++;
+ fm3_rat = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], fm3_rat);
+ i++;
+ if (!(Xen_is_keyword(keys[i])))
+ if (Xen_is_number(keys[i]))
+ fm1_index = Xen_real_to_C_double(keys[i]);
+ i++;
+ if (!(Xen_is_keyword(keys[i])))
+ if (Xen_is_number(keys[i]))
+ fm2_index = Xen_real_to_C_double(keys[i]);
+ i++;
+ if (!(Xen_is_keyword(keys[i])))
+ if (Xen_is_number(keys[i]))
+ fm3_index = Xen_real_to_C_double(keys[i]);
+ i++;
+ base = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], base);
+ i++;
+ degree = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], degree);
+ i++;
+ distance = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], distance);
+ i++;
+ reverb_amount = mus_optkey_to_float(keys[i], S_fm_violin,
+ orig_arg[i], reverb_amount);
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ /* cello == 0, violin == 1 */
+ if (Xen_is_symbol(keys[i])) {
+ if (Xen_is_eq(keys[i],
+ C_string_to_Xen_symbol("cello")))
+ index_type = V_INS_CELLO;
+ } else if (Xen_is_integer(keys[i]))
+ index_type = Xen_integer_to_C_int(keys[i]);
+ }
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_boolean(keys[i]), keys[i],
+ orig_arg[i], S_fm_violin, "a bool");
+ no_waveshaping = Xen_boolean_to_C_bool(keys[i]);
+ }
}
- i++;
- gliss_amount = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], gliss_amount); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_fm_violin, "a list");
- fm1_env = xen_list2array(keys[i]);
- fm1_len = XEN_LIST_LENGTH(keys[i]);
+ if (amp_env == NULL) {
+ amp_env = array2array(tamp_env, 8);
+ amp_del = true;
}
- i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_fm_violin, "a list");
- fm2_env = xen_list2array(keys[i]);
- fm2_len = XEN_LIST_LENGTH(keys[i]);
+ if (gliss_env == NULL) {
+ gliss_env = array2array(tgliss_env, 4);
+ gls_del = true;
}
- i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_fm_violin, "a list");
- fm3_env = xen_list2array(keys[i]);
- fm3_len = XEN_LIST_LENGTH(keys[i]);
+ if (fm1_env == NULL) {
+ fm1_env = array2array(tfm_env, 8);
+ fm1_del = true;
}
- i++;
- fm1_rat = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], fm1_rat); i++;
- fm2_rat = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], fm2_rat); i++;
- fm3_rat = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], fm3_rat); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- if (XEN_NUMBER_P(keys[i])) fm1_index = XEN_TO_C_DOUBLE(keys[i]);
- i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- if (XEN_NUMBER_P(keys[i])) fm2_index = XEN_TO_C_DOUBLE(keys[i]);
- i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- if (XEN_NUMBER_P(keys[i])) fm3_index = XEN_TO_C_DOUBLE(keys[i]);
- i++;
- base = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], base); i++;
- degree = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], degree); i++;
- distance = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], distance); i++;
- reverb_amount = mus_optkey_to_float(keys[i], S_fm_violin, orig_arg[i], reverb_amount); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- /* cello == 0, violin == 1 */
- if (XEN_SYMBOL_P(keys[i]))
- {
- if (XEN_EQ_P(keys[i], C_STRING_TO_XEN_SYMBOL("cello")))
- index_type = XEN_V_INS_CELLO;
- }
- else if (XEN_INTEGER_P(keys[i]))
- index_type = XEN_TO_C_INT(keys[i]);
+ if (fm2_env == NULL) {
+ fm2_env = array2array(tfm_env, 8);
+ fm2_del = true;
}
- i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(keys[i]), keys[i], orig_arg[i], S_fm_violin, "a bool");
- no_waveshaping = XEN_TO_C_BOOLEAN(keys[i]);
+ if (fm3_env == NULL) {
+ fm3_env = array2array(tfm_env, 8);
+ fm3_del = true;
}
- }
-
- if (!amp_env)
- {
- amp_env = array2array(tamp_env, 8);
- amp_del = true;
- }
- if (!gliss_env)
- {
- gliss_env = array2array(tgliss_env, 4);
- gls_del = true;
- }
- if (!fm1_env)
- {
- fm1_env = array2array(tfm_env, 8);
- fm1_del = true;
- }
- if (!fm2_env)
- {
- fm2_env = array2array(tfm_env, 8);
- fm2_del = true;
- }
- if (!fm3_env)
- {
- fm3_env = array2array(tfm_env, 8);
- fm3_del = true;
- }
-
- if (!mus_output_p(out = get_global_mus_gen(INS_OUTPUT)))
- INS_MISC_ERROR(S_fm_violin, "needs an output generator");
-
- rev = get_global_mus_gen(INS_REVERB);
- mode = get_global_int(INS_LOCSIG_TYPE, MUS_INTERP_LINEAR);
- result = ins_fm_violin(start, dur, freq, amp, fm_index,
- amp_env, amp_len,
- periodic_vibrato_rate, periodic_vibrato_amp,
- random_vibrato_rate, random_vibrato_amp,
- noise_freq, noise_amount,
- ind_noise_freq, ind_noise_amount,
- amp_noise_freq, amp_noise_amount,
- gliss_env, gls_len, gliss_amount,
- fm1_env, fm1_len,
- fm2_env, fm2_len,
- fm3_env, fm3_len,
- fm1_rat, fm2_rat, fm3_rat,
- fm1_index, fm2_index, fm3_index,
- base, degree, distance,
- reverb_amount, index_type, no_waveshaping,
- out, rev, mode);
-
- if (amp_del) free(amp_env);
- if (gls_del) free(gliss_env);
- if (fm1_del) free(fm1_env);
- if (fm2_del) free(fm2_env);
- if (fm3_del) free(fm3_env);
-#if !HAVE_FORTH
- return C_TO_XEN_INT(result);
+ out = get_global_mus_gen(INS_OUTPUT);
+ if (!mus_is_output(out))
+ INS_MISC_ERROR(S_fm_violin, "needs an output generator");
+ rev = get_global_mus_gen(INS_REVERB);
+ mode = get_global_int(INS_LOCSIG_TYPE, MUS_INTERP_LINEAR);
+ result = ins_fm_violin(start, dur, freq, amp, fm_index,
+ amp_env, amp_len, periodic_vibrato_rate, periodic_vibrato_amp,
+ random_vibrato_rate, random_vibrato_amp, noise_freq, noise_amount,
+ ind_noise_freq, ind_noise_amount, amp_noise_freq, amp_noise_amount,
+ gliss_env, gls_len, gliss_amount, fm1_env, fm1_len,
+ fm2_env, fm2_len, fm3_env, fm3_len, fm1_rat, fm2_rat, fm3_rat,
+ fm1_index, fm2_index, fm3_index, base, degree, distance,
+ reverb_amount, index_type, no_waveshaping, out, rev, mode);
+ if (amp_del)
+ free(amp_env);
+ if (gls_del)
+ free(gliss_env);
+ if (fm1_del)
+ free(fm1_env);
+ if (fm2_del)
+ free(fm2_env);
+ if (fm3_del)
+ free(fm3_env);
+#if !defined(HAVE_FORTH)
+ return (C_int_to_Xen_integer(result));
#endif
}
-#define INS_REVERB_MSG(caller, in_chans, out_chans) \
- ins_message("%s on %d in and %d out channels\n", caller, in_chans, out_chans)
-
-#define INS_REVERB_DUR(rev) \
- (mus_samples_to_seconds(mus_length(rev)) + get_global_float(INS_DECAY_TIME, 1.0))
+#define INS_REV_MSG(caller, in_chans, out_chans) \
+ ins_message("%s on %d in and %d out channels\n", \
+ caller, in_chans, out_chans)
+#define INS_REV_DUR(rev) \
+ (mus_samples_to_seconds(mus_length(rev)) + \
+ get_global_float(INS_DECAY_TIME, 1.0))
#define h_jc_reverb_args "\
+keyword arguments with default values:\n\
:volume 1.0\n\
:delay1 0.013\n\
:delay2 0.011\n\
@@ -1646,107 +1954,121 @@ c_fm_violin(XEN args)
:doubled " INS_FALSE "\n\
:amp-env " INS_FALSE
-#if HAVE_RUBY
-# define H_jc_reverb S_jc_reverb "(*args)\n" h_jc_reverb_args "\n\
+#if defined(HAVE_RUBY)
+#define H_jc_reverb S_jc_reverb "(*args)\n" h_jc_reverb_args "\n\
require 'ws'\n\
require 'sndins'\n\
with_sound(:reverb, :jc_reverb, :reverb_data, [:volume, 0.8]) do\n\
fm_violin(0, 1, 440, 0.2, :fm_index, 1.3)\n\
end"
-#else /* !HAVE_RUBY */
-# if HAVE_FORTH
-# define H_jc_reverb S_jc_reverb " ( args -- )\n" h_jc_reverb_args "\n\
+#elif defined(HAVE_FORTH)
+#define H_jc_reverb S_jc_reverb " ( args -- )\n" h_jc_reverb_args "\n\
require clm\n\
dl-load sndins Init_sndins\n\
0 1 440 0.2 :fm-index 1.3 <'> fm-violin\n\
:reverb <'> jc-reverb :reverb-data #( :volume 0.8 ) with-sound"
-# else /* !HAVE_FORTH */
-# define H_jc_reverb "(" S_jc_reverb " . args)\n" h_jc_reverb_args "\n\
- (load-from-path \"ws\")\n\
- (load-extension \"libsndins\" \"Init_sndins\")\n\
- (with-sound (:reverb jc-reverb :reverb-data '(:volume 0.8))\n\
- (fm-violin 0 1 440 0.2 :fm-index 1.3))"
-# endif /* !HAVE_FORTH */
-#endif /* !HAVE_RUBY */
-
-#if HAVE_FORTH
+#else /* HAVE_SCHEME */
+#define H_jc_reverb "(" S_jc_reverb " . args)\n" h_jc_reverb_args "\n\
+(load-from-path \"ws.scm\")\n\
+(load-extension \"libsndins\" \"Init_sndins\")\n\
+(with-sound (:reverb jc-reverb :reverb-data '(:volume 0.8))\n\
+ (fm-violin 0 1 440 0.2 :fm-index 1.3))"
+#endif
+
+#if defined(HAVE_FORTH)
static void
#else
-static XEN
+static Xen
#endif
-c_jc_reverb(XEN args)
+c_jc_reverb(Xen args)
{
#define JC_LAST_KEY 8
- off_t result;
- int vals = 0, lst_len = XEN_LIST_LENGTH(args), amp_len = 0;
- bool low_pass = false, doubled = false;
- mus_float_t volume = 1.0, delay1 = 0.013, delay2 = 0.011, delay3 = 0.015, delay4 = 0.017;
- mus_float_t *amp_env = NULL;
- mus_any *out = NULL, *rev = NULL;
- int orig_arg[JC_LAST_KEY] = {0};
- XEN kargs[JC_LAST_KEY * 2], keys[JC_LAST_KEY];
- int i = 0;
-
- keys[i++] = allkeys[C_low_pass];
- keys[i++] = allkeys[C_volume];
- keys[i++] = allkeys[C_doubled];
- keys[i++] = allkeys[C_delay1];
- keys[i++] = allkeys[C_delay2];
- keys[i++] = allkeys[C_delay3];
- keys[i++] = allkeys[C_delay4];
- keys[i++] = allkeys[C_amp_env];
-
- for (i = 0; i < JC_LAST_KEY * 2; i++) kargs[i] = XEN_UNDEFINED;
- for (i = 0; i < lst_len; i++) kargs[i] = XEN_LIST_REF(args, i);
- vals = mus_optkey_unscramble(S_jc_reverb, JC_LAST_KEY, keys, kargs, orig_arg);
-
- if (vals > 0)
- {
- i = 0;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(keys[i]), keys[i], orig_arg[i], S_jc_reverb, "a bool");
- low_pass = XEN_TO_C_BOOLEAN(keys[i]);
+ mus_long_t result;
+ int i, vals, lst_len, amp_len;
+ bool low_pass, doubled;
+ mus_float_t volume, delay1, delay2, delay3, delay4;
+ mus_float_t *amp_env = NULL;
+ mus_any *out = NULL, *rev = NULL;
+ int orig_arg[JC_LAST_KEY] = {0};
+ Xen kargs[JC_LAST_KEY * 2], keys[JC_LAST_KEY];
+
+ amp_len = 0;
+ lst_len = Xen_list_length(args);
+ low_pass = doubled = false;
+ volume = 1.0;
+ delay1 = 0.013;
+ delay2 = 0.011;
+ delay3 = 0.015;
+ delay4 = 0.017;
+ i = 0;
+ keys[i++] = allkeys[C_low_pass];
+ keys[i++] = allkeys[C_volume];
+ keys[i++] = allkeys[C_doubled];
+ keys[i++] = allkeys[C_delay1];
+ keys[i++] = allkeys[C_delay2];
+ keys[i++] = allkeys[C_delay3];
+ keys[i++] = allkeys[C_delay4];
+ keys[i++] = allkeys[C_amp_env];
+ for (i = 0; i < JC_LAST_KEY * 2; i++)
+ kargs[i] = Xen_undefined;
+ for (i = 0; i < lst_len; i++)
+ kargs[i] = Xen_list_ref(args, i);
+ vals = mus_optkey_unscramble(S_jc_reverb, JC_LAST_KEY, keys, kargs,
+ orig_arg);
+ if (vals > 0) {
+ i = 0;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_boolean(keys[i]), keys[i],
+ orig_arg[i], S_jc_reverb, "a bool");
+ low_pass = Xen_boolean_to_C_bool(keys[i]);
+ }
+ i++;
+ volume = mus_optkey_to_float(keys[i], S_jc_reverb,
+ orig_arg[i], volume);
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_boolean(keys[i]), keys[i],
+ orig_arg[i], S_jc_reverb, "a bool");
+ doubled = Xen_boolean_to_C_bool(keys[i]);
+ }
+ i++;
+ delay1 = mus_optkey_to_float(keys[i], S_jc_reverb,
+ orig_arg[i], delay1);
+ i++;
+ delay2 = mus_optkey_to_float(keys[i], S_jc_reverb,
+ orig_arg[i], delay2);
+ i++;
+ delay3 = mus_optkey_to_float(keys[i], S_jc_reverb,
+ orig_arg[i], delay3);
+ i++;
+ delay4 = mus_optkey_to_float(keys[i], S_jc_reverb,
+ orig_arg[i], delay4);
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_jc_reverb, "a list");
+ amp_env = xen_list2array(keys[i]);
+ amp_len = Xen_list_length(keys[i]);
+ }
}
- i++;
- volume = mus_optkey_to_float(keys[i], S_jc_reverb, orig_arg[i], volume); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(keys[i]), keys[i], orig_arg[i], S_jc_reverb, "a bool");
- doubled = XEN_TO_C_BOOLEAN(keys[i]);
- }
- i++;
- delay1 = mus_optkey_to_float(keys[i], S_jc_reverb, orig_arg[i], delay1); i++;
- delay2 = mus_optkey_to_float(keys[i], S_jc_reverb, orig_arg[i], delay2); i++;
- delay3 = mus_optkey_to_float(keys[i], S_jc_reverb, orig_arg[i], delay3); i++;
- delay4 = mus_optkey_to_float(keys[i], S_jc_reverb, orig_arg[i], delay4); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_jc_reverb, "a list");
- amp_env = xen_list2array(keys[i]);
- amp_len = XEN_LIST_LENGTH(keys[i]);
- }
- }
-
- if (!mus_output_p(out = get_global_mus_gen(INS_OUTPUT)))
- INS_MISC_ERROR(S_jc_reverb, "needs an output generator");
-
- if (!mus_input_p(rev = get_global_mus_gen(INS_REVERB)))
- INS_MISC_ERROR(S_jc_reverb, "needs an input (reverb) generator");
-
- if (get_global_boolean(INS_VERBOSE, false))
- INS_REVERB_MSG(S_jc_reverb, mus_channels(rev), mus_channels(out));
-
- result = ins_jc_reverb(0.0, INS_REVERB_DUR(rev),
- volume, low_pass, doubled,
- delay1, delay2, delay3, delay4,
- amp_env, amp_len, out, rev);
-#if !HAVE_FORTH
- return C_TO_XEN_INT(result);
+ out = get_global_mus_gen(INS_OUTPUT);
+ if (!mus_is_output(out))
+ INS_MISC_ERROR(S_jc_reverb, "needs an output generator");
+ rev = get_global_mus_gen(INS_REVERB);
+ if (!mus_is_input(rev))
+ INS_MISC_ERROR(S_jc_reverb, "needs an input generator");
+ if (get_global_boolean(INS_VERBOSE, false))
+ INS_REV_MSG(S_jc_reverb, mus_channels(rev), mus_channels(out));
+ result = ins_jc_reverb(0.0, INS_REV_DUR(rev), volume, low_pass,
+ doubled, delay1, delay2, delay3, delay4, amp_env, amp_len,
+ out, rev);
+#if !defined(HAVE_FORTH)
+ return (C_int_to_Xen_integer(result));
#endif
}
#define h_nrev_args "\
+keyword arguments with default values:\n\
:reverb-factor 1.09\n\
:lp-coeff 0.7\n\
:lp-out-coeff 0.85\n\
@@ -1754,102 +2076,113 @@ c_jc_reverb(XEN args)
:amp-env " INS_LIST_BEG " 0 1 1 1 " INS_LIST_END "\n\
:volume 1.0"
-#if HAVE_RUBY
-# define H_nrev S_nrev "(*args)\n" h_nrev_args "\n\
+#if defined(HAVE_RUBY)
+#define H_nrev S_nrev "(*args)\n" h_nrev_args "\n\
require 'ws'\n\
require 'sndins'\n\
with_sound(:reverb, :nrev, :reverb_data, [:lp_coeff, 0.6]) do\n\
fm_violin(0, 1, 440, 0.7, :fm_index, 1.3)\n\
end"
-#else /* !HAVE_RUBY */
-#if HAVE_FORTH
-# define H_nrev S_nrev " ( args -- )\n" h_nrev_args "\n\
+#elif defined(HAVE_FORTH)
+#define H_nrev S_nrev " ( args -- )\n" h_nrev_args "\n\
require clm\n\
dl-load sndins Init_sndins\n\
0 1 440 0.7 :fm-index 1.3 <'> fm-violin\n\
:reverb <'> nrev :reverb-data #( :lp-coeff 0.6 ) with-sound"
-# else /* !HAVE_FORTH */
-# define H_nrev "(" S_nrev " . args)\n" h_nrev_args "\n\
- (load-from-path \"ws\")\n\
- (load-extension \"libsndins\" \"Init_sndins\")\n\
- (with-sound (:reverb nrev :reverb-data '(:lp-coeff 0.6))\n\
- (fm-violin 0 1 440 0.7 :fm-index 1.3))"
-# endif /* !HAVE_FORTH */
-#endif /* !HAVE_RUBY */
-
-#if HAVE_FORTH
+#else /* HAVE_SCHEME */
+#define H_nrev "(" S_nrev " . args)\n" h_nrev_args "\n\
+(load \"ws.scm\")\n\
+(load-extension \"libsndins\" \"Init_sndins\")\n\
+(with-sound (:reverb nrev :reverb-data '(:lp-coeff 0.6))\n\
+ (fm-violin 0 1 440 0.7 :fm-index 1.3))"
+#endif
+
+#if defined(HAVE_FORTH)
static void
#else
-static XEN
+static Xen
#endif
-c_nrev(XEN args)
+c_nrev(Xen args)
{
#define N_LAST_KEY 6
- off_t result;
- int vals = 0, lst_len = XEN_LIST_LENGTH(args), amp_len = 4;
- bool amp_del = false;
- mus_float_t lp_coeff = 0.7, lp_out_coeff = 0.85;
- mus_float_t output_scale = 1.0, reverb_factor = 1.09, volume = 1.0;
- mus_float_t tamp_env[4] = {0, 1, 1, 1};
- mus_float_t *amp_env = NULL;
- mus_any *out = NULL, *rev = NULL;
- int orig_arg[N_LAST_KEY] = {0};
- XEN kargs[N_LAST_KEY * 2], keys[N_LAST_KEY];
- int i = 0;
-
- keys[i++] = allkeys[C_reverb_factor];
- keys[i++] = allkeys[C_lp_coeff];
- keys[i++] = allkeys[C_lp_out_coeff];
- keys[i++] = allkeys[C_output_scale];
- keys[i++] = allkeys[C_amp_env];
- keys[i++] = allkeys[C_volume];
-
- for (i = 0; i < N_LAST_KEY * 2; i++) kargs[i] = XEN_UNDEFINED;
- for (i = 0; i < lst_len; i++) kargs[i] = XEN_LIST_REF(args, i);
- vals = mus_optkey_unscramble(S_nrev, N_LAST_KEY, keys, kargs, orig_arg);
-
- if (vals > 0)
- {
- i = 0;
- reverb_factor = mus_optkey_to_float(keys[i], S_nrev, orig_arg[i], reverb_factor); i++;
- lp_coeff = mus_optkey_to_float(keys[i], S_nrev, orig_arg[i], lp_coeff); i++;
- lp_out_coeff = mus_optkey_to_float(keys[i], S_nrev, orig_arg[i], lp_out_coeff); i++;
- output_scale = mus_optkey_to_float(keys[i], S_nrev, orig_arg[i], output_scale); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_nrev, "a list");
- amp_env = xen_list2array(keys[i]);
- amp_len = XEN_LIST_LENGTH(keys[i]);
+ mus_long_t result;
+ int i, vals, lst_len, amp_len;
+ bool amp_del;
+ mus_float_t lp_coeff, lp_out_coeff;
+ mus_float_t output_scale, reverb_factor, volume;
+ mus_float_t tamp_env[4] = {0, 1, 1, 1};
+ mus_float_t *amp_env = NULL;
+ mus_any *out = NULL, *rev = NULL;
+ int orig_arg[N_LAST_KEY] = {0};
+ Xen kargs[N_LAST_KEY * 2], keys[N_LAST_KEY];
+
+ lst_len = Xen_list_length(args);
+ amp_len = 4;
+ amp_del = false;
+ lp_coeff = 0.7;
+ lp_out_coeff = 0.85;
+ output_scale = 1.0;
+ reverb_factor = 1.09;
+ volume = 1.0;
+ i = 0;
+ keys[i++] = allkeys[C_reverb_factor];
+ keys[i++] = allkeys[C_lp_coeff];
+ keys[i++] = allkeys[C_lp_out_coeff];
+ keys[i++] = allkeys[C_output_scale];
+ keys[i++] = allkeys[C_amp_env];
+ keys[i++] = allkeys[C_volume];
+ for (i = 0; i < N_LAST_KEY * 2; i++)
+ kargs[i] = Xen_undefined;
+ for (i = 0; i < lst_len; i++)
+ kargs[i] = Xen_list_ref(args, i);
+ vals = mus_optkey_unscramble(S_nrev, N_LAST_KEY, keys, kargs, orig_arg);
+ if (vals > 0) {
+ i = 0;
+ reverb_factor = mus_optkey_to_float(keys[i], S_nrev,
+ orig_arg[i], reverb_factor);
+ i++;
+ lp_coeff = mus_optkey_to_float(keys[i], S_nrev,
+ orig_arg[i], lp_coeff);
+ i++;
+ lp_out_coeff = mus_optkey_to_float(keys[i], S_nrev,
+ orig_arg[i], lp_out_coeff);
+ i++;
+ output_scale = mus_optkey_to_float(keys[i], S_nrev,
+ orig_arg[i], output_scale);
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_nrev, "a list");
+ amp_env = xen_list2array(keys[i]);
+ amp_len = Xen_list_length(keys[i]);
+ }
+ i++;
+ volume = mus_optkey_to_float(keys[i], S_nrev,
+ orig_arg[i], volume);
+ }
+ if (amp_env == NULL) {
+ amp_env = array2array(tamp_env, 4);
+ amp_del = true;
}
- i++;
- volume = mus_optkey_to_float(keys[i], S_nrev, orig_arg[i], volume);
- }
-
- if (!amp_env)
- {
- amp_env = array2array(tamp_env, 4);
- amp_del = true;
- }
- if (!mus_output_p(out = get_global_mus_gen(INS_OUTPUT)))
- INS_MISC_ERROR(S_nrev, "needs an output generator");
-
- if (!mus_input_p(rev = get_global_mus_gen(INS_REVERB)))
- INS_MISC_ERROR(S_nrev, "needs an input (reverb) generator");
-
- if (get_global_boolean(INS_VERBOSE, false))
- INS_REVERB_MSG(S_nrev, mus_channels(rev), mus_channels(out));
-
- result = ins_nrev(0.0, INS_REVERB_DUR(rev),
- reverb_factor, lp_coeff, lp_out_coeff,
- output_scale, volume, amp_env, amp_len, out, rev);
-
- if (amp_del) free(amp_env);
-#if !HAVE_FORTH
- return C_TO_XEN_INT(result);
+ out = get_global_mus_gen(INS_OUTPUT);
+ if (!mus_is_output(out))
+ INS_MISC_ERROR(S_nrev, "needs an output generator");
+ rev = get_global_mus_gen(INS_REVERB);
+ if (!mus_is_input(rev))
+ INS_MISC_ERROR(S_nrev, "needs an input generator");
+ if (get_global_boolean(INS_VERBOSE, false))
+ INS_REV_MSG(S_nrev, mus_channels(rev), mus_channels(out));
+ result = ins_nrev(0.0, INS_REV_DUR(rev), reverb_factor, lp_coeff,
+ lp_out_coeff, output_scale, volume, amp_env, amp_len, out, rev);
+ if (amp_del)
+ free(amp_env);
+#if !defined(HAVE_FORTH)
+ return (C_int_to_Xen_integer(result));
#endif
}
#define h_freeverb_args "\
+keyword arguments with default values:\n\
:room-decay 0.5\n\
:damping 0.5\n\
:global 0.3\n\
@@ -1863,171 +2196,208 @@ c_nrev(XEN args)
:scale-damping 0.4\n\
:stereo-spread 23.0"
-#if HAVE_RUBY
-# define H_freeverb S_freeverb "(*args)\n" h_freeverb_args "\n\
+#if defined(HAVE_RUBY)
+#define H_freeverb S_freeverb "(*args)\n" h_freeverb_args "\n\
require 'ws'\n\
require 'sndins'\n\
with_sound(:reverb, :freeverb, :reverb_data, [:room_decay, 0.8]) do\n\
fm_violin(0, 1, 440, 0.7)\n\
end"
-#else /* !HAVE_RUBY */
-#if HAVE_FORTH
-# define H_freeverb S_freeverb " ( args -- )\n" h_freeverb_args "\n\
+#elif defined(HAVE_FORTH)
+#define H_freeverb S_freeverb " ( args -- )\n" h_freeverb_args "\n\
require clm\n\
dl-load sndins Init_sndins\n\
-0 1 440 0.7 <'> fm-violin :reverb <'> freeverb\n\
+0 1 440 0.7 <'> fm-violin\n\
+ :reverb <'> freeverb\n\
:reverb-data #( :room-decay 0.8 ) with-sound"
-# else /* !HAVE_FORTH */
-# define H_freeverb "(" S_freeverb " . args)\n" h_freeverb_args "\n\
- (load-from-path \"ws\")\n\
- (load-extension \"libsndins\" \"Init_sndins\")\n\
- (with-sound (:reverb freeverb :reverb-data '(:room-decay 0.8))\n\
- (fm-violin 0 1 440 0.7))"
-# endif /* !HAVE_FORTH */
-#endif /* !HAVE_RUBY */
-
-#if HAVE_FORTH
+#else /* HAVE_SCHEME */
+#define H_freeverb "(" S_freeverb " . args)\n" h_freeverb_args "\n\
+(load \"ws.scm\")\n\
+(load-extension \"libsndins\" \"Init_sndins\")\n\
+(with-sound (:reverb freeverb :reverb-data '(:room-decay 0.8))\n\
+ (fm-violin 0 1 440 0.7))"
+#endif
+
+#if defined(HAVE_FORTH)
static void
#else
-static XEN
+static Xen
#endif
-c_freeverb(XEN args)
+c_freeverb(Xen args)
{
#define F_LAST_KEY 12
- off_t result;
- int vals = 0, lst_len = XEN_LIST_LENGTH(args);
- int numcombs = 8, numallpasses = 4;
- int tcombtun[8] = {1116, 1188, 1277, 1356, 1422, 1491, 1557, 1617};
- int tallpass[4] = {556, 441, 341, 225};
- int *combtuning = NULL, *allpasstuning = NULL;
- bool comb_del = false, allpass_del = false;
- mus_float_t room_decay = 0.5, global = 0.3, damping = 0.5;
- mus_float_t predelay = 0.03, output_gain = 1.0, scale_room_decay = 0.28;
- mus_float_t offset_room_decay = 0.7, scale_damping = 0.4, stereo_spread = 23.0;
- mus_any *output_mixer = NULL, *out = NULL, *rev = NULL;
- int orig_arg[F_LAST_KEY] = {0};
- XEN kargs[F_LAST_KEY * 2], keys[F_LAST_KEY];
- int i = 0;
-
- keys[i++] = allkeys[C_room_decay];
- keys[i++] = allkeys[C_damping];
- keys[i++] = allkeys[C_global];
- keys[i++] = allkeys[C_predelay];
- keys[i++] = allkeys[C_output_gain];
- keys[i++] = allkeys[C_output_mixer];
- keys[i++] = allkeys[C_scale_room_decay];
- keys[i++] = allkeys[C_offset_room_decay];
- keys[i++] = allkeys[C_combtuning];
- keys[i++] = allkeys[C_allpasstuning];
- keys[i++] = allkeys[C_scale_damping];
- keys[i++] = allkeys[C_stereo_spread];
-
- for (i = 0; i < F_LAST_KEY * 2; i++) kargs[i] = XEN_UNDEFINED;
- for (i = 0; i < lst_len; i++) kargs[i] = XEN_LIST_REF(args, i);
- vals = mus_optkey_unscramble(S_freeverb, F_LAST_KEY, keys, kargs, orig_arg);
-
- if (vals > 0)
- {
- i = 0;
- room_decay = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i], room_decay); i++;
- damping = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i], damping); i++;
- global = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i], global); i++;
- predelay = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i], predelay); i++;
- output_gain = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i], output_gain); i++;
- output_mixer = mus_optkey_to_mus_any(keys[i], S_freeverb, orig_arg[i], output_mixer); i++;
- scale_room_decay = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i],
- scale_room_decay); i++;
- offset_room_decay = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i],
- offset_room_decay); i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_freeverb, "a list");
- combtuning = xen_list2iarray(keys[i]);
- numcombs = XEN_LIST_LENGTH(keys[i]);
+ mus_long_t result;
+ int i, vals, lst_len, numcombs, numallpasses;
+ int tcombtun[8] = {1116, 1188, 1277, 1356, 1422, 1491, 1557, 1617};
+ int tallpass[4] = {556, 441, 341, 225};
+ int *combtuning = NULL, *allpasstuning = NULL;
+ bool comb_del, allpass_del;
+ mus_float_t room_decay, global, damping;
+ mus_float_t predelay, output_gain, scale_room_decay;
+ mus_float_t offset_room_decay, scale_damping, stereo_spread;
+ vct *output_mixer = NULL;
+ mus_any *out = NULL, *rev = NULL;
+ int orig_arg[F_LAST_KEY] = {0};
+ Xen kargs[F_LAST_KEY * 2], keys[F_LAST_KEY];
+
+ lst_len = Xen_list_length(args);
+ numcombs = 8;
+ numallpasses = 4;
+ comb_del = allpass_del = false;
+ room_decay = 0.5;
+ global = 0.3;
+ damping = 0.5;
+ predelay = 0.03;
+ output_gain = 1.0;
+ scale_room_decay = 0.28;
+ offset_room_decay = 0.7;
+ scale_damping = 0.4;
+ stereo_spread = 23.0;
+ i = 0;
+ keys[i++] = allkeys[C_room_decay];
+ keys[i++] = allkeys[C_damping];
+ keys[i++] = allkeys[C_global];
+ keys[i++] = allkeys[C_predelay];
+ keys[i++] = allkeys[C_output_gain];
+ keys[i++] = allkeys[C_output_mixer];
+ keys[i++] = allkeys[C_scale_room_decay];
+ keys[i++] = allkeys[C_offset_room_decay];
+ keys[i++] = allkeys[C_combtuning];
+ keys[i++] = allkeys[C_allpasstuning];
+ keys[i++] = allkeys[C_scale_damping];
+ keys[i++] = allkeys[C_stereo_spread];
+ for (i = 0; i < F_LAST_KEY * 2; i++)
+ kargs[i] = Xen_undefined;
+ for (i = 0; i < lst_len; i++)
+ kargs[i] = Xen_list_ref(args, i);
+ vals = mus_optkey_unscramble(S_freeverb, F_LAST_KEY, keys, kargs,
+ orig_arg);
+ if (vals > 0) {
+ i = 0;
+ room_decay = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], room_decay);
+ i++;
+ damping = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], damping);
+ i++;
+ global = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], global);
+ i++;
+ predelay = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], predelay);
+ i++;
+ output_gain = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], output_gain);
+ i++;
+ output_mixer = mus_optkey_to_vct(keys[i], S_freeverb,
+ orig_arg[i], output_mixer);
+ i++;
+ scale_room_decay = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], scale_room_decay);
+ i++;
+ offset_room_decay = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], offset_room_decay);
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_freeverb, "a list");
+ combtuning = xen_list2iarray(keys[i]);
+ numcombs = Xen_list_length(keys[i]);
+ }
+ i++;
+ if (!(Xen_is_keyword(keys[i]))) {
+ Xen_check_type(Xen_is_list(keys[i]), keys[i],
+ orig_arg[i], S_freeverb, "a list");
+ allpasstuning = xen_list2iarray(keys[i]);
+ numallpasses = Xen_list_length(keys[i]);
+ }
+ i++;
+ scale_damping = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], scale_damping);
+ i++;
+ stereo_spread = mus_optkey_to_float(keys[i], S_freeverb,
+ orig_arg[i], stereo_spread);
}
- i++;
- if (!(XEN_KEYWORD_P(keys[i])))
- {
- XEN_ASSERT_TYPE(XEN_LIST_P(keys[i]), keys[i], orig_arg[i], S_freeverb, "a list");
- allpasstuning = xen_list2iarray(keys[i]);
- numallpasses = XEN_LIST_LENGTH(keys[i]);
+ if (!combtuning) {
+ combtuning = int_array2array(tcombtun, 8);
+ comb_del = true;
}
- i++;
- scale_damping = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i], scale_damping); i++;
- stereo_spread = mus_optkey_to_float(keys[i], S_freeverb, orig_arg[i], stereo_spread);
- }
-
- if (!combtuning)
- {
- combtuning = int_array2array(tcombtun, 8);
- comb_del = true;
- }
- if (!allpasstuning)
- {
- allpasstuning = int_array2array(tallpass, 4);
- allpass_del = true;
- }
-
- if (!mus_output_p(out = get_global_mus_gen(INS_OUTPUT)))
- INS_MISC_ERROR(S_freeverb, "needs an output generator");
-
- if (!mus_input_p(rev = get_global_mus_gen(INS_REVERB)))
- INS_MISC_ERROR(S_freeverb, "needs an input (reverb) generator");
-
- if (get_global_boolean(INS_VERBOSE, false))
- INS_REVERB_MSG(S_freeverb, mus_channels(rev), mus_channels(out));
-
- result = ins_freeverb(0.0, INS_REVERB_DUR(rev),
- room_decay, damping, global,
- predelay, output_gain, scale_room_decay,
- offset_room_decay, scale_damping, stereo_spread,
- combtuning, numcombs, allpasstuning, numallpasses,
- output_mixer, out, rev);
-
- if (comb_del) free(combtuning);
- if (allpass_del) free(allpasstuning);
-#if !HAVE_FORTH
- return C_TO_XEN_INT(result);
+ if (!allpasstuning) {
+ allpasstuning = int_array2array(tallpass, 4);
+ allpass_del = true;
+ }
+ out = get_global_mus_gen(INS_OUTPUT);
+ if (!mus_is_output(out))
+ INS_MISC_ERROR(S_freeverb, "needs an output generator");
+ rev = get_global_mus_gen(INS_REVERB);
+ if (!mus_is_input(rev))
+ INS_MISC_ERROR(S_freeverb, "needs an input generator");
+ if (get_global_boolean(INS_VERBOSE, false))
+ INS_REV_MSG(S_freeverb, mus_channels(rev), mus_channels(out));
+ result = ins_freeverb(0.0, INS_REV_DUR(rev), room_decay, damping,
+ global, predelay, output_gain, scale_room_decay, offset_room_decay,
+ scale_damping, stereo_spread, combtuning, numcombs, allpasstuning,
+ numallpasses, output_mixer, out, rev);
+ if (comb_del)
+ free(combtuning);
+ if (allpass_del)
+ free(allpasstuning);
+#if !defined(HAVE_FORTH)
+ return (C_int_to_Xen_integer(result));
#endif
}
-#ifdef XEN_ARGIFY_1
-XEN_VARGIFY(x_make_fcomb, c_make_fcomb)
-XEN_ARGIFY_2(x_fcomb, c_fcomb)
-XEN_NARGIFY_1(x_fcomb_p, c_fcomb_p)
-XEN_VARGIFY(x_fm_violin, c_fm_violin)
-XEN_VARGIFY(x_jc_reverb, c_jc_reverb)
-XEN_VARGIFY(x_nrev, c_nrev)
-XEN_VARGIFY(x_freeverb, c_freeverb)
+#if defined(Xen_wrap_1_optional_arg)
+Xen_wrap_any_args(x_make_fcomb, c_make_fcomb)
+Xen_wrap_2_optional_args(x_fcomb, c_fcomb)
+Xen_wrap_1_arg(x_is_fcomb, c_is_fcomb)
+#if defined(HAVE_FORTH)
+/* these are void functions */
+#define x_fm_violin c_fm_violin
+#define x_jc_reverb c_jc_reverb
+#define x_nrev c_nrev
+#define x_freeverb c_freeverb
#else
-# define x_make_fcomb c_make_fcomb
-# define x_fcomb c_fcomb
-# define x_fcomb_p c_fcomb_p
-# define x_fm_violin c_fm_violin
-# define x_jc_reverb c_jc_reverb
-# define x_nrev c_nrev
-# define x_freeverb c_freeverb
+Xen_wrap_any_args(x_fm_violin, c_fm_violin)
+Xen_wrap_any_args(x_jc_reverb, c_jc_reverb)
+Xen_wrap_any_args(x_nrev, c_nrev)
+Xen_wrap_any_args(x_freeverb, c_freeverb)
#endif
+#else /* !Xen_wrap_1_optional_arg */
+#define x_make_fcomb c_make_fcomb
+#define x_fcomb c_fcomb
+#define x_is_fcomb c_is_fcomb
+#define x_fm_violin c_fm_violin
+#define x_jc_reverb c_jc_reverb
+#define x_nrev c_nrev
+#define x_freeverb c_freeverb
+#endif /* Xen_wrap_1_optional_arg */
void
Init_sndins(void)
{
- init_keywords();
- XEN_DEFINE_PROCEDURE(S_make_fcomb, x_make_fcomb, 0, 0, 1, H_make_fcomb);
- XEN_DEFINE_PROCEDURE(S_fcomb, x_fcomb, 1, 1, 0, H_fcomb);
- XEN_DEFINE_PROCEDURE(S_fcomb_p, x_fcomb_p, 1, 0, 0, H_fcomb_p);
-#if HAVE_FORTH
- fth_define_void_procedure(S_fm_violin, x_fm_violin, 0, 0, 1, H_fm_violin);
- fth_define_void_procedure(S_jc_reverb, x_jc_reverb, 0, 0, 1, H_jc_reverb);
- fth_define_void_procedure(S_nrev, x_nrev, 0, 0, 1, H_nrev);
- fth_define_void_procedure(S_freeverb, x_freeverb, 0, 0, 1, H_freeverb);
+#if defined(HAVE_SCHEME)
+ if (s7 == NULL)
+ s7 = s7_init();
+#endif
+ init_keywords();
+ Xen_define_procedure(S_make_fcomb, x_make_fcomb, 0, 0, 1, H_make_fcomb);
+ Xen_define_procedure(S_fcomb, x_fcomb, 1, 1, 0, H_fcomb);
+ Xen_define_procedure(S_is_fcomb, x_is_fcomb, 1, 0, 0, H_is_fcomb);
+#if defined(HAVE_FORTH)
+#define Xen_define_void_proc(Name, Func, Req, Opt, Rest, Help) \
+ fth_define_void_procedure(Name, Func, Req, Opt, Rest, Help)
+ Xen_define_void_proc(S_fm_violin, x_fm_violin, 0, 0, 1, H_fm_violin);
+ Xen_define_void_proc(S_jc_reverb, x_jc_reverb, 0, 0, 1, H_jc_reverb);
+ Xen_define_void_proc(S_nrev, x_nrev, 0, 0, 1, H_nrev);
+ Xen_define_void_proc(S_freeverb, x_freeverb, 0, 0, 1, H_freeverb);
#else
- XEN_DEFINE_PROCEDURE(S_fm_violin, x_fm_violin, 0, 0, 1, H_fm_violin);
- XEN_DEFINE_PROCEDURE(S_jc_reverb, x_jc_reverb, 0, 0, 1, H_jc_reverb);
- XEN_DEFINE_PROCEDURE(S_nrev, x_nrev, 0, 0, 1, H_nrev);
- XEN_DEFINE_PROCEDURE(S_freeverb, x_freeverb, 0, 0, 1, H_freeverb);
+ Xen_define_procedure(S_fm_violin, x_fm_violin, 0, 0, 1, H_fm_violin);
+ Xen_define_procedure(S_jc_reverb, x_jc_reverb, 0, 0, 1, H_jc_reverb);
+ Xen_define_procedure(S_nrev, x_nrev, 0, 0, 1, H_nrev);
+ Xen_define_procedure(S_freeverb, x_freeverb, 0, 0, 1, H_freeverb);
#endif
- XEN_YES_WE_HAVE("sndins");
+ Xen_provide_feature("sndins");
}
/*
diff --git a/sndins/sndins.h b/sndins/sndins.h
index b3c5b39..eb62078 100644
--- a/sndins/sndins.h
+++ b/sndins/sndins.h
@@ -1,6 +1,6 @@
/* sndins.h -- Sndins for Snd/CLM
*
- * Copyright (c) 2003--2009 Michael Scholz <mi-scholz at users.sourceforge.net>
+ * Copyright (c) 2003-2014 Michael Scholz <mi-scholz at users.sourceforge.net>
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -23,233 +23,76 @@
* 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.
- *
+ *
+ * @(#)sndins.h 1.6 11/18/14
*/
#ifndef _SNDINS_H_
#define _SNDINS_H_
-#ifndef XEN_PROVIDED_P
-# if HAVE_SCHEME
-# define XEN_PROVIDED_P(feature) \
- XEN_TO_C_BOOLEAN(XEN_MEMBER(C_STRING_TO_XEN_SYMBOL(feature), \
- XEN_NAME_AS_C_STRING_TO_VALUE("*features*")))
-# elif HAVE_RUBY
-# define XEN_PROVIDED_P(feature) XEN_TO_C_BOOLEAN(rb_provided(feature))
-# elif HAVE_FORTH
-# define XEN_PROVIDED_P(feature) fth_provided_p(feature)
-# else
-# define XEN_PROVIDED_P(feature) false
-# endif
-#endif
-
-#define SC_startime "startime"
-#define SC_duration "duration"
-#define SC_frequency "frequency"
-#define SC_amplitude "amplitude"
-#define SC_degree "degree"
-#define SC_distance "distance"
-#define SC_volume "volume"
-#define SC_delay1 "delay1"
-#define SC_delay2 "delay2"
-#define SC_delay3 "delay3"
-#define SC_delay4 "delay4"
-#define SC_doubled "doubled"
-#define SC_base "base"
-#define SC_damping "damping"
-#define SC_global "global"
-#define SC_predelay "predelay"
-#define SC_combtuning "combtuning"
-#define SC_allpasstuning "allpasstuning"
-#define SC_scaler "scaler"
-#define SC_size "size"
-#define SC_a0 "a0"
-#define SC_a1 "a1"
-#if HAVE_RUBY
-# define SC_amp_env "amp_env"
-# define SC_fm_index "fm_index"
-# define SC_reverb_amount "reverb_amount"
-# define SC_low_pass "low_pass"
-# define SC_periodic_vibrato_rate "periodic_vibrato_rate"
-# define SC_periodic_vibrato_amplitude "periodic_vibrato_amplitude"
-# define SC_random_vibrato_rate "random_vibrato_rate"
-# define SC_random_vibrato_amplitude "random_vibrato_amplitude"
-# define SC_noise_freq "noise_freq"
-# define SC_noise_amount "noise_amount"
-# define SC_ind_noise_freq "ind_noise_freq"
-# define SC_ind_noise_amount "ind_noise_amount"
-# define SC_amp_noise_freq "amp_noise_freq"
-# define SC_amp_noise_amount "amp_noise_amount"
-# define SC_gliss_env "gliss_env"
-# define SC_glissando_amount "glissando_amount"
-# define SC_fm1_env "fm1_env"
-# define SC_fm2_env "fm2_env"
-# define SC_fm3_env "fm3_env"
-# define SC_fm1_rat "fm1_rat"
-# define SC_fm2_rat "fm2_rat"
-# define SC_fm3_rat "fm3_rat"
-# define SC_fm1_index "fm1_index"
-# define SC_fm2_index "fm2_index"
-# define SC_fm3_index "fm3_index"
-# define SC_index_type "index_type"
-# define SC_no_waveshaping "no_waveshaping"
-# define SC_reverb_factor "reverb_factor"
-# define SC_lp_coeff "lp_coeff"
-# define SC_lp_out_coeff "lp_out_coeff"
-# define SC_output_scale "output_scale"
-# define SC_room_decay "room_decay"
-# define SC_output_gain "output_gain"
-# define SC_output_mixer "output_mixer"
-# define SC_scale_room_decay "scale_room_decay"
-# define SC_offset_room_decay "offset_room_decay"
-# define SC_scale_damping "scale_dumping"
-# define SC_stereo_spread "stereo_spread"
-#else /* !HAVE_RUBY */
-# define SC_amp_env "amp-env"
-# define SC_fm_index "fm-index"
-# define SC_reverb_amount "reverb-amount"
-# define SC_low_pass "low-pass"
-# define SC_periodic_vibrato_rate "periodic-vibrato-rate"
-# define SC_periodic_vibrato_amplitude "periodic-vibrato-amplitude"
-# define SC_random_vibrato_rate "random-vibrato-rate"
-# define SC_random_vibrato_amplitude "random-vibrato-amplitude"
-# define SC_noise_freq "noise-freq"
-# define SC_noise_amount "noise-amount"
-# define SC_ind_noise_freq "ind-noise-freq"
-# define SC_ind_noise_amount "ind-noise-amount"
-# define SC_amp_noise_freq "amp-noise-freq"
-# define SC_amp_noise_amount "amp-noise-amount"
-# define SC_gliss_env "gliss-env"
-# define SC_glissando_amount "glissando-amount"
-# define SC_fm1_env "fm1-env"
-# define SC_fm2_env "fm2-env"
-# define SC_fm3_env "fm3-env"
-# define SC_fm1_rat "fm1-rat"
-# define SC_fm2_rat "fm2-rat"
-# define SC_fm3_rat "fm3-rat"
-# define SC_fm1_index "fm1-index"
-# define SC_fm2_index "fm2-index"
-# define SC_fm3_index "fm3-index"
-# define SC_index_type "index-type"
-# define SC_no_waveshaping "no-waveshaping"
-# define SC_reverb_factor "reverb-factor"
-# define SC_lp_coeff "lp-coeff"
-# define SC_lp_out_coeff "lp-out-coeff"
-# define SC_output_scale "output-scale"
-# define SC_room_decay "room-decay"
-# define SC_output_gain "output-gain"
-# define SC_output_mixer "output-mixer"
-# define SC_scale_room_decay "scale-room-decay"
-# define SC_offset_room_decay "offset-room-decay"
-# define SC_scale_damping "scale-dumping"
-# define SC_stereo_spread "stereo-spread"
-#endif /* !HAVE_RUBY */
-
#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
-# define __BEGIN_DECLS extern "C" {
-# define __END_DECLS }
+#define __BEGIN_DECLS extern "C" {
+#define __END_DECLS }
#else
-# define __BEGIN_DECLS
-# define __END_DECLS
+#define __BEGIN_DECLS
+#define __END_DECLS
#endif
__BEGIN_DECLS
-mus_any *mus_make_fcomb (mus_float_t scaler, int size, mus_float_t a0, mus_float_t a1);
-int mus_fcomb_p (mus_any *ptr);
-mus_float_t mus_fcomb (mus_any *ptr, mus_float_t input, mus_float_t ignored);
+mus_any *mus_make_fcomb(mus_float_t scaler, int size,
+ mus_float_t a0, mus_float_t a1);
+int mus_fcomb_p(mus_any *ptr);
+mus_float_t mus_fcomb(mus_any *ptr, mus_float_t input, mus_float_t ignored);
-off_t ins_fm_violin (mus_float_t start,
- mus_float_t dur,
- mus_float_t freq,
- mus_float_t amp,
- mus_float_t fm_index,
- mus_float_t *amp_env,
- int amp_len,
- mus_float_t periodic_vibrato_rate,
- mus_float_t periodic_vibrato_amp,
- mus_float_t random_vibrato_rate,
- mus_float_t random_vibrato_amp,
- mus_float_t noise_freq,
- mus_float_t noise_amount,
- mus_float_t ind_noise_freq,
- mus_float_t ind_noise_amount,
- mus_float_t amp_noise_freq,
- mus_float_t amp_noise_amount,
- mus_float_t *gliss_env,
- int gliss_len,
- mus_float_t gliss_amount,
- mus_float_t *fm1_env,
- int fm1_len,
- mus_float_t *fm2_env,
- int fm2_len,
- mus_float_t *fm3_env,
- int fm3_len,
- mus_float_t fm1_rat,
- mus_float_t fm2_rat,
- mus_float_t fm3_rat,
- mus_float_t fm1_index,
- mus_float_t fm2_index,
- mus_float_t fm3_index,
- mus_float_t base,
- mus_float_t degree,
- mus_float_t distance,
- mus_float_t reverb_amount,
- bool index_type,
- bool no_waveshaping,
- mus_any *out,
- mus_any *rev,
- mus_interp_t mode);
-off_t ins_jc_reverb (mus_float_t start,
- mus_float_t dur,
- mus_float_t volume,
- bool low_pass,
- bool doubled,
- mus_float_t delay1,
- mus_float_t delay2,
- mus_float_t delay3,
- mus_float_t delay4,
- mus_float_t *amp_env,
- int amp_len,
- mus_any *out,
- mus_any *rev);
-off_t ins_nrev (mus_float_t start,
- mus_float_t dur,
- mus_float_t reverb_factor,
- mus_float_t lp_coeff,
- mus_float_t lp_out_coeff,
- mus_float_t output_scale,
- mus_float_t volume,
- mus_float_t *amp_env,
- int amp_len,
- mus_any *out,
- mus_any *rev);
-off_t ins_freeverb (mus_float_t start,
- mus_float_t dur,
- mus_float_t room_decay,
- mus_float_t damping,
- mus_float_t global,
- mus_float_t predelay,
- mus_float_t output_gain,
- mus_float_t scale_room_decay,
- mus_float_t offset_room_decay,
- mus_float_t scale_damping,
- mus_float_t stereo_spread,
- int *combtuning,
- int comb_len,
- int *allpasstuning,
- int all_len,
- mus_any *output_mixer,
- mus_any *out,
- mus_any *rev);
+mus_long_t ins_fm_violin(mus_float_t start, mus_float_t dur,
+ mus_float_t freq, mus_float_t amp, mus_float_t fm_index,
+ mus_float_t *amp_env, int amp_len,
+ mus_float_t periodic_vibrato_rate,
+ mus_float_t periodic_vibrato_amp,
+ mus_float_t random_vibrato_rate,
+ mus_float_t random_vibrato_amp, mus_float_t noise_freq,
+ mus_float_t noise_amount, mus_float_t ind_noise_freq,
+ mus_float_t ind_noise_amount, mus_float_t amp_noise_freq,
+ mus_float_t amp_noise_amount, mus_float_t *gliss_env,
+ int gliss_len, mus_float_t gliss_amount,
+ mus_float_t *fm1_env, int fm1_len,
+ mus_float_t *fm2_env, int fm2_len,
+ mus_float_t *fm3_env, int fm3_len,
+ mus_float_t fm1_rat, mus_float_t fm2_rat,
+ mus_float_t fm3_rat, mus_float_t fm1_index,
+ mus_float_t fm2_index, mus_float_t fm3_index,
+ mus_float_t base, mus_float_t degree,
+ mus_float_t distance, mus_float_t reverb_amount,
+ bool index_type, bool no_waveshaping, mus_any *out,
+ mus_any *rev, mus_interp_t mode);
+mus_long_t ins_jc_reverb(mus_float_t start, mus_float_t dur,
+ mus_float_t volume, bool low_pass, bool doubled,
+ mus_float_t delay1, mus_float_t delay2,
+ mus_float_t delay3, mus_float_t delay4,
+ mus_float_t *amp_env, int amp_len,
+ mus_any *out, mus_any *rev);
+mus_long_t ins_nrev(mus_float_t start, mus_float_t dur,
+ mus_float_t reverb_factor, mus_float_t lp_coeff,
+ mus_float_t lp_out_coeff, mus_float_t output_scale,
+ mus_float_t volume, mus_float_t *amp_env, int amp_len,
+ mus_any *out, mus_any *rev);
+mus_long_t ins_freeverb(mus_float_t start, mus_float_t dur,
+ mus_float_t room_decay, mus_float_t damping,
+ mus_float_t global, mus_float_t predelay,
+ mus_float_t output_gain, mus_float_t scale_room_decay,
+ mus_float_t offset_room_decay, mus_float_t scale_damping,
+ mus_float_t stereo_spread, int *combtuning, int comb_len,
+ int *allpasstuning, int all_len, vct *output_mixer,
+ mus_any *out, mus_any *rev);
-void Init_sndins(void);
+void Init_sndins(void);
__END_DECLS
-#endif /* _SNDINS_H_ */
+#endif /* _SNDINS_H_ */
/*
* sndins.h ends here
diff --git a/sndlib-strings.h b/sndlib-strings.h
index 37fe904..a8a7a69 100644
--- a/sndlib-strings.h
+++ b/sndlib-strings.h
@@ -3,7 +3,6 @@
#define S_array_to_file "array->file"
#define S_file_to_array "file->array"
-#define S_make_sound_data "make-sound-data"
#define S_mus_aifc "mus-aifc"
#define S_mus_aiff "mus-aiff"
#define S_mus_alaw "mus-alaw"
@@ -13,13 +12,6 @@
#define S_mus_alsa_device "mus-alsa-device"
#define S_mus_alsa_playback_device "mus-alsa-playback-device"
#define S_mus_alsa_squelch_warning "mus-alsa-squelch-warning"
-#define S_mus_audio_close "mus-audio-close"
-#define S_mus_audio_default "mus-audio-default"
-#define S_mus_audio_describe "mus-audio-describe"
-#define S_mus_audio_open_input "mus-audio-open-input"
-#define S_mus_audio_open_output "mus-audio-open-output"
-#define S_mus_audio_read "mus-audio-read"
-#define S_mus_audio_write "mus-audio-write"
#define S_mus_b24int "mus-b24int"
#define S_mus_bdouble "mus-bdouble"
#define S_mus_bdouble_unscaled "mus-bdouble-unscaled"
@@ -33,15 +25,15 @@
#define S_mus_bytes_per_sample "mus-bytes-per-sample"
#define S_mus_caff "mus-caff"
#define S_mus_clipping "mus-clipping"
-#define S_mus_data_format_name "mus-data-format-name"
-#define S_mus_data_format_to_string "mus-data-format->string"
+#define S_mus_sample_type_name "mus-sample-type-name"
+#define S_mus_sample_type_to_string "mus-sample-type->string"
#define S_mus_error_type_to_string "mus-error-type->string"
#define S_mus_expand_filename "mus-expand-filename"
#define S_mus_file_clipping "mus-file-clipping"
-#define S_mus_file_prescaler "mus-file-prescaler"
#define S_mus_header_raw_defaults "mus-header-raw-defaults"
#define S_mus_header_type_name "mus-header-type-name"
#define S_mus_header_type_to_string "mus-header-type->string"
+#define S_mus_header_writable "mus-header-writable"
#define S_mus_ircam "mus-ircam"
#define S_mus_l24int "mus-l24int"
#define S_mus_ldouble "mus-ldouble"
@@ -58,68 +50,38 @@
#define S_mus_nist "mus-nist"
#define S_mus_oss_set_buffers "mus-oss-set-buffers"
#define S_mus_out_format "mus-out-format"
-#define S_mus_prescaler "mus-prescaler"
#define S_mus_raw "mus-raw"
#define S_mus_rf64 "mus-rf64"
#define S_mus_riff "mus-riff"
#define S_mus_sound_chans "mus-sound-chans"
-#define S_mus_sound_close_input "mus-sound-close-input"
-#define S_mus_sound_close_output "mus-sound-close-output"
#define S_mus_sound_comment "mus-sound-comment"
-#define S_mus_sound_data_format "mus-sound-data-format"
+#define S_mus_sound_sample_type "mus-sound-sample-type"
#define S_mus_sound_data_location "mus-sound-data-location"
#define S_mus_sound_datum_size "mus-sound-datum-size"
#define S_mus_sound_duration "mus-sound-duration"
#define S_mus_sound_forget "mus-sound-forget"
-#define S_mus_sound_frames "mus-sound-frames"
+#define S_mus_sound_framples "mus-sound-framples"
#define S_mus_sound_header_type "mus-sound-header-type"
#define S_mus_sound_length "mus-sound-length"
#define S_mus_sound_loop_info "mus-sound-loop-info"
#define S_mus_sound_mark_info "mus-sound-mark-info"
#define S_mus_sound_maxamp "mus-sound-maxamp"
#define S_mus_sound_maxamp_exists "mus-sound-maxamp-exists?"
-#define S_mus_sound_open_input "mus-sound-open-input"
-#define S_mus_sound_open_output "mus-sound-open-output"
+#define S_mus_sound_path "mus-sound-path"
#define S_mus_sound_prune "mus-sound-prune"
-#define S_mus_sound_read "mus-sound-read"
-#define S_mus_sound_reopen_output "mus-sound-reopen-output"
#define S_mus_sound_report_cache "mus-sound-report-cache"
#define S_mus_sound_samples "mus-sound-samples"
-#define S_mus_sound_seek_frame "mus-sound-seek-frame"
#define S_mus_sound_srate "mus-sound-srate"
#define S_mus_sound_type_specifier "mus-sound-type-specifier"
-#define S_mus_sound_write "mus-sound-write"
#define S_mus_sound_write_date "mus-sound-write-date"
#define S_mus_soundfont "mus-soundfont"
#define S_mus_svx "mus-svx"
#define S_mus_ubshort "mus-ubshort"
#define S_mus_ubyte "mus-ubyte"
#define S_mus_ulshort "mus-ulshort"
-#define S_mus_unknown "mus-unknown"
-#define S_mus_unsupported "mus-unsupported"
+#define S_mus_unknown_header "mus-unknown-header"
+#define S_mus_unknown_sample "mus-unknown-sample"
#define S_mus_voc "mus-voc"
#define S_new_sound_hook "new-sound-hook"
-#define S_sound_data_addB "sound-data-add!"
-#define S_sound_data_chans "sound-data-chans"
-#define S_sound_data_copy "sound-data-copy"
-#define S_sound_data_fillB "sound-data-fill!"
-#define S_sound_data_length "sound-data-length"
-#define S_sound_data_maxamp "sound-data-maxamp"
-#define S_sound_data_multiplyB "sound-data-multiply!"
-#define S_sound_data_offsetB "sound-data-offset!"
-#define S_sound_data_p "sound-data?"
-#define S_sound_data_peak "sound-data-peak"
-#define S_sound_data_ref "sound-data-ref"
-#define S_sound_data_reverseB "sound-data-reverse!"
-#define S_sound_data_scaleB "sound-data-scale!"
-#define S_sound_data_setB "sound-data-set!"
-#define S_sound_data_to_vct "sound-data->vct"
-#define S_vct_to_sound_data "vct->sound-data"
-#if HAVE_RUBY
- #define S_sound_data_multiply "sound_data_multiply"
- #define S_sound_data_add "sound_data_add"
-#else
- #define S_sound_data_multiply "sound-data*"
- #define S_sound_data_add "sound-data+"
-#endif
+
#endif
diff --git a/sndlib-ws.scm b/sndlib-ws.scm
index c974c37..e49c3a2 100644
--- a/sndlib-ws.scm
+++ b/sndlib-ws.scm
@@ -1,32 +1,28 @@
;;; with-sound for a sndlib-only context (no Snd editor)
-(provide 'sndlib-ws.scm)
+(provide 'sndlib-ws.scm)
+
+(set! *clm-srate* 44100)
-(define *clm-srate* 44100)
(define *clm-file-name* "test.snd")
(define *clm-channels* 1)
-(define *clm-data-format* mus-lfloat)
+(define *clm-sample-type* mus-lfloat)
(define *clm-header-type* mus-next)
(define *clm-verbose* #f)
(define *clm-play* #f)
(define *clm-statistics* #f)
(define *clm-reverb* #f)
(define *clm-reverb-channels* 1)
-(define *clm-reverb-data* '())
-(define *clm-table-size* 512)
-(define *clm-file-buffer-size* 65536)
+(define *clm-reverb-data* ())
(define *clm-locsig-type* mus-interp-linear)
(define *clm-clipped* #t)
(define *clm-array-print-length* 12)
(define *clm-player* #f)
(define *clm-notehook* #f)
(define *clm-with-sound-depth* 0) ; for CM, not otherwise used
-(define *clm-default-frequency* 0.0)
-(define *clm-safety* 0)
(define *clm-delete-reverb* #f) ; should with-sound clean up reverb stream
-(define *clm-threads* 4)
-(define *clm-output-safety* 0) ; if 1, assume output buffers will not need to be flushed except at the very end
+(set! *clm-file-buffer-size* 65536)
(define (times->samples beg dur)
"(times->samples beg dur) converts beg and (+ beg dur) to samples, returning both in a list"
@@ -39,10 +35,10 @@
(define *definstrument-hook* #f) ; for CM
-(defmacro definstrument (args . body)
+(define-macro (definstrument args . body)
(let* ((name (car args))
(targs (cdr args))
- (utargs (let ((arg-names '()))
+ (utargs (let ((arg-names ()))
(for-each
(lambda (a)
(if (not (keyword? a))
@@ -50,19 +46,12 @@
(set! arg-names (cons a arg-names))
(set! arg-names (cons (car a) arg-names)))))
targs)
- (reverse arg-names)))
- (doc (if (string? (car body))
- (let ((val (car body)))
- (set! body (cdr body))
- val)
- "no help")))
+ (reverse arg-names))))
`(begin
(define* (,name , at targs)
- ,doc
(if *clm-notehook*
(*clm-notehook* (symbol->string ',name) , at utargs))
- ((lambda () ; for inner defines, if any
- , at body)))
+ , at body)
,@(if *definstrument-hook*
(list (*definstrument-hook* name targs))
(list)))))
@@ -72,11 +61,11 @@
;;; -------- with-sound --------
(define* (with-sound-helper thunk
- (srate *clm-srate*)
(output *clm-file-name*)
(channels *clm-channels*)
+ (srate *clm-srate*)
+ (sample-type *clm-sample-type*)
(header-type *clm-header-type*)
- (data-format *clm-data-format*)
(comment #f)
(verbose *clm-verbose*)
(reverb *clm-reverb*)
@@ -90,15 +79,11 @@
(play *clm-play*)
(clipped 'unset)
(notehook *clm-notehook*) ; (with-sound (:notehook (lambda args (display args))) (fm-violin 0 1 440 .1))
- (ignore-output #f)
- (thread-output #f)
- (thread-reverb #f)
- (output-safety *clm-output-safety*))
+ (ignore-output #f))
"with-sound-helper is the business portion of the with-sound macro"
- (let* ((old-srate (mus-srate))
+ (let* ((old-srate *clm-srate*)
(old-*output* *output*)
(old-*reverb* *reverb*)
- (in-debugger #f)
(old-notehook *clm-notehook*)
(old-verbose *clm-verbose*)
(output-to-file (string? output))
@@ -119,74 +104,47 @@
(lambda ()
(set! *clm-verbose* verbose)
(set! *clm-notehook* notehook)
- (set! (clm-table-size) *clm-table-size*)
- (set! (clm-default-frequency) *clm-default-frequency*)
- (set! (mus-file-buffer-size) *clm-file-buffer-size*)
(set! (locsig-type) *clm-locsig-type*)
(set! (mus-array-print-length) *clm-array-print-length*)
(if (equal? clipped 'unset)
(if (and (or scaled-by scaled-to)
- (member data-format (list mus-bfloat mus-lfloat mus-bdouble mus-ldouble)))
+ (member sample-type (list mus-bfloat mus-lfloat mus-bdouble mus-ldouble)))
(set! (mus-clipping) #f)
(set! (mus-clipping) *clm-clipped*))
(set! (mus-clipping) clipped))
- (set! (mus-srate) srate))
+ (set! *clm-srate* srate))
(lambda ()
- (if (not thread-output)
+ (if output-to-file
(begin
-
- (if output-to-file
+ (if continue-old-file
(begin
- (if continue-old-file
- (begin
- (set! *output* (continue-sample->file output-1))
- (set! (mus-srate) (mus-sound-srate output-1)))
- (begin
- (if (file-exists? output-1)
- (delete-file output-1))
- (set! *output* (make-sample->file output-1 channels data-format header-type comment))))
- (if *output*
- (set! (mus-safety *output*) output-safety)))
+ (set! *output* (continue-sample->file output-1))
+ (set! *clm-srate* (mus-sound-srate output-1)))
(begin
- (if (not continue-old-file)
- (if (vct? output-1)
- (vct-fill! output-1 0.0)
- (if (sound-data? output-1)
- (sound-data-fill! output-1 0.0))))
- (set! *output* output-1)))
-
- (if reverb
- (if reverb-to-file
- (begin
- (if continue-old-file
- (set! *reverb* (continue-sample->file reverb-1))
- (begin
- (if (file-exists? reverb-1)
- (delete-file reverb-1))
- (set! *reverb* (make-sample->file reverb-1 reverb-channels data-format header-type))))
- (if *reverb*
- (set! (mus-safety *reverb*) output-safety)))
- (begin
- (if (not continue-old-file)
- (if (vct? reverb-1)
- (vct-fill! reverb-1 0.0)
- (if (sound-data? reverb-1)
- (sound-data-fill! reverb-1 0.0))))
- (set! *reverb* reverb-1)))))
-
- ;; else thread-output
+ (if (file-exists? output-1)
+ (delete-file output-1))
+ (set! *output* (make-sample->file output-1 channels sample-type header-type comment)))))
(begin
- (if (file-exists? output-1)
- (delete-file output-1))
- (set! (thread-output) (make-sample->file output-1 channels data-format header-type comment))
- (if thread-reverb
- (begin
- (if (file-exists? reverb-1)
- (delete-file reverb-1))
- (set! (thread-reverb) (make-sample->file reverb-1 reverb-channels data-format header-type))))
- (set! statistics #f)
- ))
+ (if (and (not continue-old-file)
+ (vector? output-1))
+ (fill! output-1 0.0))
+ (set! *output* output-1)))
+
+ (if reverb
+ (if reverb-to-file
+ (begin
+ (if continue-old-file
+ (set! *reverb* (continue-sample->file reverb-1))
+ (begin
+ (if (file-exists? reverb-1)
+ (delete-file reverb-1))
+ (set! *reverb* (make-sample->file reverb-1 reverb-channels sample-type header-type)))))
+ (begin
+ (if (and (not continue-old-file)
+ (vector? reverb-1))
+ (fill! reverb-1 0.0))
+ (set! *reverb* reverb-1))))
(let ((start (if statistics (get-internal-real-time)))
(flush-reverb #f)
@@ -196,66 +154,52 @@
(catch 'mus-error
thunk
(lambda args
- (display (format #f ";~%with-sound mus-error: ~{~A~^ ~}~%" (cdr args)))
+ (format #t ";~%with-sound mus-error: ~{~A~^ ~}~%" (cdr args))
(set! flush-reverb #t)))
(if (and reverb
(not flush-reverb)) ; i.e. not interrupted by error and trying to jump out
(begin
- (if thread-reverb
- (mus-close (thread-reverb))
- (if reverb-to-file
- (mus-close *reverb*)))
+ (if reverb-to-file
+ (mus-close *reverb*))
(if statistics
(if reverb-to-file
(set! revmax (cadr (mus-sound-maxamp reverb-1)))
- (if (vct? reverb-1)
- (set! revmax (vct-peak reverb-1))
- (if (sound-data? reverb-1)
- (set! revmax (sound-data-peak reverb-1))))))
- (if (not thread-reverb)
- (begin
- (if reverb-to-file
- (set! *reverb* (make-file->sample reverb-1)))
- (apply reverb reverb-data)
- (if reverb-to-file
- (mus-close *reverb*))
- (if (and reverb-to-file *clm-delete-reverb*)
- (delete-file reverb-1))))))
-
- (if thread-output
- (mus-close (thread-output))
- (if output-to-file
- (mus-close *output*)))
+ (if (float-vector? reverb-1)
+ (set! revmax (float-vector-peak reverb-1)))))
+ (if reverb-to-file
+ (set! *reverb* (make-file->sample reverb-1)))
+ (apply reverb reverb-data) ; here is the reverb call(!)
+ (if reverb-to-file
+ (mus-close *reverb*))
+ ))
+
+ (if output-to-file
+ (mus-close *output*))
(if statistics
(begin
- (set! cycles (exact->inexact (/ (- (get-internal-real-time) start) internal-time-units-per-second)))
- (display (format #f "~%;~A:~% maxamp~A:~{ ~,4F~}~%~A compute time: ~,3F~%"
- (if output-to-file
- (if (or scaled-to scaled-by)
- (substring output-1 0 (- (string-length output-1) 5))
- output-1)
- (if (vct? output-1) "vct"
- (if (sound-data? output-1) "sound-data"
- (if (procedure? output-1) "function"
- "flush"))))
- (if (or scaled-to scaled-by)
- " (before scaling)"
- "")
- (if output-to-file
- (let ((lst (mus-sound-maxamp output-1)))
- (do ((i 0 (+ i 2)))
- ((>= i (length lst)))
- (list-set! lst i (/ (list-ref lst i) (mus-srate))))
- lst)
- (if (vct? output-1)
- (list (vct-peak output-1))
- (if (sound-data? output-1)
- (sound-data-maxamp output-1)
- 0.0)))
- (if revmax (format #f " rev max: ~,4F~%" revmax) "")
- cycles))))
+ (set! cycles (- (get-internal-real-time) start))
+ (format #t "~%;~A:~% maxamp~A:~{ ~,4F~}~%~A compute time: ~,3F~%"
+ (if output-to-file
+ (if (or scaled-to scaled-by)
+ (substring output-1 0 (- (length output-1) 5))
+ output-1)
+ (if (vector? output-1) "vector" "flush"))
+ (if (or scaled-to scaled-by)
+ " (before scaling)"
+ "")
+ (if output-to-file
+ (let ((lst (mus-sound-maxamp output-1)))
+ (do ((i 0 (+ i 2)))
+ ((>= i (length lst)))
+ (list-set! lst i (/ (list-ref lst i) *clm-srate*)))
+ lst)
+ (if (float-vector? output-1)
+ (list (float-vector-peak output-1))
+ '(0.0)))
+ (if revmax (format #f " rev max: ~,4F~%" revmax) "")
+ cycles)))
(if (or scaled-to scaled-by)
(if output-to-file
@@ -266,24 +210,23 @@
(do ((i 1 (+ i 2)))
((>= i (length mx-lst)) (/ scaled-to mx))
(set! mx (max mx (list-ref mx-lst i)))))))
- (out-file (substring output-1 0 (- (string-length output-1) 5))))
- (mus-sound-close-output (mus-sound-open-output out-file srate channels data-format header-type) 0)
- (mus-mix out-file output-1 0 (mus-sound-frames output-1) 0 (make-scalar-mixer channels scaling))
+ (out-file (substring output-1 0 (- (length output-1) 5))))
+ (let ((g (make-sample->file out-file channels sample-type header-type #f)))
+ (mus-close g))
+ (mus-file-mix out-file output-1 0 (mus-sound-framples output-1) 0
+ (let ((mx (make-float-vector (list channels channels) 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i channels) mx)
+ (set! (mx i i) scaling))))
(delete-file output-1)
- (set! output-1 (substring output-1 0 (- (string-length output-1) 5))))
+ (set! output-1 (substring output-1 0 (- (length output-1) 5))))
- (if (vct? output-1)
+ (if (float-vector? output-1)
(if scaled-to
- (let ((pk (vct-peak output-1)))
+ (let ((pk (float-vector-peak output-1)))
(if (> pk 0.0)
- (vct-scale! output-1 (/ scaled-to pk))))
- (vct-scale! output-1 scaled-by))
- (if (sound-data? output-1)
- (if scaled-to
- (let ((pk (sound-data-peak output-1)))
- (if (> pk 0.0)
- (sound-data-scale! output-1 (/ scaled-to pk))))
- (sound-data-scale! output-1 scaled-by))))))
+ (float-vector-scale! output-1 (/ scaled-to pk))))
+ (float-vector-scale! output-1 scaled-by)))))
(if (and *clm-player* play output-to-file)
(*clm-player* output-1)))
@@ -295,28 +238,24 @@
(set! *clm-notehook* old-notehook)
(if *reverb*
(begin
- (if thread-reverb
- (mus-close (thread-reverb))
- (mus-close *reverb*))
+ (mus-close *reverb*)
(set! *reverb* old-*reverb*)))
(if *output*
(begin
- (if thread-output
- (mus-close (thread-output))
- (if (mus-output? *output*)
- (mus-close *output*)))
+ (if (mus-output? *output*)
+ (mus-close *output*))
(set! *output* old-*output*)))
- (set! (mus-srate) old-srate)))))
+ (set! *clm-srate* old-srate)))))
-(defmacro with-sound (args . body)
+(define-macro (with-sound args . body)
`(with-sound-helper (lambda () , at body) , at args))
;;; -------- with-temp-sound --------
-(defmacro with-temp-sound (args . body)
+(define-macro (with-temp-sound args . body)
`(let ((old-file-name *clm-file-name*))
;; with-sound but using tempnam for output (can be over-ridden by explicit :output)
(dynamic-wind
@@ -338,10 +277,10 @@
;;; -------- sound-let --------
;;;
-;;; (with-sound () (sound-let ((a () (fm-violin 0 .1 440 .1))) (mus-mix "test.snd" a)))
+;;; (with-sound () (sound-let ((a () (fm-violin 0 .1 440 .1))) (mus-file-mix "test.snd" a)))
-(defmacro sound-let (snds . body)
- `(let ((temp-files '()))
+(define-macro (sound-let snds . body)
+ `(let ((temp-files ()))
(begin
(let ((val (let ,(map (lambda (arg)
(if (> (length arg) 2)
@@ -350,7 +289,7 @@
snds)
, at body))) ; sound-let body
(for-each (lambda (file) ; clean up all local temps
- (if (and (string? file) ; is it a file? (might be a vct or sound-data object)
+ (if (and (string? file) ; is it a file?
(file-exists? file))
(delete-file file)))
temp-files)
@@ -365,7 +304,8 @@
(output *clm-file-name*)
(channels *clm-channels*)
(header-type *clm-header-type*)
- (data-format *clm-data-format*)
+ data-format
+ (sample-type *clm-sample-type*)
(comment #f)
;(verbose *clm-verbose*) ; why is this commented out?
(reverb *clm-reverb*)
@@ -379,24 +319,24 @@
(scaled-by #f))
"(init-with-sound . args) is the first half of with-sound; it sets up the CLM output choices, reverb, etc. Use \
finish-with-sound to complete the process."
- (let ((old-srate (mus-srate))
+ (let ((old-srate *clm-srate*)
(start (if statistics (get-internal-real-time)))
(output-to-file (string? output))
(reverb-to-file (and reverb (string? revfile))))
+ (set! *clm-srate* srate)
(if output-to-file
(if continue-old-file
(begin
(set! *output* (continue-sample->file output))
- (set! (mus-srate) (mus-sound-srate output)))
+ (set! *clm-srate* (mus-sound-srate output)))
(begin
(if (file-exists? output)
(delete-file output))
- (set! *output* (make-sample->file output channels data-format header-type comment))))
+ (set! *output* (make-sample->file output channels (or data-format sample-type) header-type comment))))
(begin
- (if (not continue-old-file)
- (if (vct? output)
- (vct-fill! output 0.0)
- (sound-data-fill! output 0.0)))
+ (if (and (not continue-old-file)
+ (vector output))
+ (fill! output 0.0))
(set! *output* output)))
(if reverb
@@ -406,12 +346,11 @@ finish-with-sound to complete the process."
(begin
(if (file-exists? revfile)
(delete-file revfile))
- (set! *reverb* (make-sample->file revfile reverb-channels data-format header-type))))
+ (set! *reverb* (make-sample->file revfile reverb-channels (or data-format sample-type) header-type))))
(begin
- (if (not continue-old-file)
- (if (vct? revfile)
- (vct-fill! revfile 0.0)
- (sound-data-fill! revfile 0.0)))
+ (if (and (not continue-old-file)
+ (vector? revfile))
+ (fill! revfile 0.0))
(set! *reverb* revfile))))
(list 'with-sound-data
@@ -430,18 +369,18 @@ finish-with-sound to complete the process."
(define (finish-with-sound wsd)
"(finish-with-sound wsd) closes the notelist process started by init-with-sound"
(if (eq? (car wsd) 'with-sound-data)
- (let ((cycles 0)
- (output (list-ref wsd 1))
+ (let ((output (list-ref wsd 1))
(reverb (list-ref wsd 2))
(revfile (list-ref wsd 3))
(old-srate (list-ref wsd 4))
- (statistics (list-ref wsd 5))
+ ;(statistics (list-ref wsd 5))
;(to-snd (list-ref wsd 6))
- (scaled-to (list-ref wsd 7))
- (scaled-by (list-ref wsd 8))
- (play (list-ref wsd 9))
+ ;(scaled-to (list-ref wsd 7))
+ ;(scaled-by (list-ref wsd 8))
+ ;(play (list-ref wsd 9))
(reverb-data (list-ref wsd 10))
- (start (list-ref wsd 11)))
+ ;(start (list-ref wsd 11))
+ )
(if reverb
(begin
@@ -454,16 +393,14 @@ finish-with-sound to complete the process."
(if (mus-output? *output*)
(mus-close *output*))
- (if statistics
- (set! cycles (/ (- (get-internal-real-time) start) 100)))
- (set! (mus-srate) old-srate)
+ (set! *clm-srate* old-srate)
output)
(throw 'wrong-type-arg
(list "finish-with-sound" wsd))))
(define wsdat-play ; for cm
- (make-procedure-with-setter
+ (dilambda
(lambda (w)
"accessor for play field of init-with-sound struct"
(list-ref w 9))
@@ -475,22 +412,23 @@ finish-with-sound to complete the process."
(let ((main-pitch (/ 440.0 (expt 2.0 (/ 57 12)))) ; a4 = 440Hz is pitch 57 in our numbering
(last-octave 0) ; octave number can be omitted
(ratios (vector 1.0 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2.0)))
+
(lambda* (pitch pythagorean) ; pitch can be pitch name or actual frequency
"(->frequency pitch pythagorean) returns the frequency (Hz) of the 'pitch', a CLM/CM style note name as a \
symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small-integer ratios, rather than equal-tempered tuning."
(if (symbol? pitch)
(let* ((name (string-downcase (symbol->string pitch)))
- (base-char (string-ref name 0))
- (sign-char (and (> (string-length name) 1)
- (not (char-numeric? (string-ref name 1)))
- (not (char=? (string-ref name 1) #\n))
- (string-ref name 1)))
- (octave-char (if (and (> (string-length name) 1)
- (char-numeric? (string-ref name 1)))
- (string-ref name 1)
- (if (and (> (string-length name) 2)
- (char-numeric? (string-ref name 2)))
- (string-ref name 2)
+ (base-char (name 0))
+ (sign-char (and (> (length name) 1)
+ (not (char-numeric? (name 1)))
+ (not (char=? (name 1) #\n))
+ (name 1)))
+ (octave-char (if (and (> (length name) 1)
+ (char-numeric? (name 1)))
+ (name 1)
+ (if (and (> (length name) 2)
+ (char-numeric? (name 2)))
+ (name 2)
#f)))
(base (modulo (+ 5 (- (char->integer base-char) (char->integer #\a))) 7)) ; c-based (diatonic) octaves
(sign (if (not sign-char) 0 (if (char=? sign-char #\f) -1 1)))
@@ -506,38 +444,37 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
(define (->sample beg)
"(->sample time-in-seconds) -> time-in-samples"
- (round (* (if (not (null? (sounds))) (srate) (mus-srate)) beg)))
-
+ (round (* (if (not (null? (sounds))) (srate) *clm-srate*) beg)))
;;; -------- defgenerator --------
-;;; :(defgenerator (osc :make-wrapper (lambda (gen) (set! (osc-freq gen) (hz->radians (osc-freq gen))) gen)) freq phase)
-;;; #<unspecified>
-;;; :(define hi (make-osc 440.0 0.0))
-;;; #<unspecified>
-;;; :hi
-;;; (osc 0.125378749798983 0.0)
-
-;;; besides setting up the list accessors, the make function, and the type predicate, defgenerator
-;;; calls add-clm-field to tell run the type of each list element (only actually needed if
-;;; there are different types in use)
-;;; it also adds the built-in methods mus-name, mus-reset, mus-run, and mus-describe (if they don't already exist), and
-;;; mus-frequency if a "frequency" field exists (treated as radians)
-;;; mus-phase if a "phase" or "angle" field exists
-;;; mus-scaler if "r" or "amplitude",
-;;; mus-order if "n" or "order"
-;;; mus-offset if "ratio" (mimics nrxy*)
-
-(define (find-if pred l)
- (cond ((null? l) #f)
- ((pred (car l)) (car l))
- (else (find-if pred (cdr l)))))
-
-(defmacro defgenerator (struct-name . fields)
- (let* ((name (if (list? struct-name) (car struct-name) struct-name))
-
- (wrapper (or (and (list? struct-name)
+;;; (defgenerator osc a b)
+;;; (defgenerator (osc :methods (list (cons 'mus-frequency (lambda (obj) 100.0)))) a b)
+
+(define-macro (defgenerator struct-name . fields)
+
+ (define (list->bindings lst)
+ (let ((len (length lst)))
+ (let ((nlst (make-list (* len 2))))
+ (do ((old lst (cdr old))
+ (nsym nlst (cddr nsym)))
+ ((null? old) nlst)
+ (if (pair? (car old))
+ (begin
+ (set-car! (cdr nsym) (caar old))
+ (set-car! nsym (list 'quote (caar old))))
+ (begin
+ (set-car! (cdr nsym) (car old))
+ (set-car! nsym (list 'quote (car old)))))))))
+
+ (let* ((name (if (pair? struct-name)
+ (car struct-name)
+ struct-name))
+ (sname (if (string? name)
+ name
+ (symbol->string name)))
+ (wrapper (or (and (pair? struct-name)
(or (and (> (length struct-name) 2)
(equal? (struct-name 1) :make-wrapper)
(struct-name 2))
@@ -545,334 +482,35 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
(equal? (struct-name 3) :make-wrapper)
(struct-name 4))))
(lambda (gen) gen)))
-
- (sname (if (string? name) name (symbol->string name)))
-
- (field-names (map (lambda (n)
- (symbol->string (if (list? n) (car n) n)))
- fields))
-
- (field-types (map (lambda (n)
- (if (and (list? n) (cadr n) (eq? (cadr n) :type))
- (snd-error (format #f ":type indication for defgenerator (~A) field (~A) should be after the default value" name n)))
- (if (and (list? n)
- (= (length n) 4)
- (eq? (n 2) :type))
- (n 3)
- (if (and (list? n)
- (= (length n) 2))
- (if (number? (cadr n))
- (if (rational? (cadr n))
- 'int
- 'float)
- (if (string? (cadr n))
- 'string
- (if (char? (cadr n))
- 'char
- (if (or (equal? (cadr n) #t)
- (equal? (cadr n) #f))
- 'boolean
- 'float))))
- 'float)))
- fields))
-
- (original-methods (or (and (list? struct-name)
- (or (and (> (length struct-name) 2)
- (equal? (struct-name 1) :methods)
- (struct-name 2))
- (and (= (length struct-name) 5)
- (equal? (struct-name 3) :methods)
- (struct-name 4))))
- (list)))
-
- (method-exists? (lambda (method)
- (and (not (null? original-methods))
- (find-if (lambda (g)
- (and (list? g)
- (list? (cadr g))
- (eq? (car (cadr g)) method)))
- (cdr original-methods)))))
-
- (phase-field-name (and (not (method-exists? 'mus-phase))
- (let ((fld (find-if (lambda (name)
- (or (string=? name "phase")
- (string=? name "angle")))
- field-names)))
- (and fld (string-append "-" fld)))))
-
- (frequency-field-name (and (not (method-exists? 'mus-frequency))
- (find-if (lambda (name)
- (string=? name "frequency"))
- field-names)
- "-frequency"))
-
- (offset-field-name (and (not (method-exists? 'mus-offset))
- (find-if (lambda (name)
- (string=? name "ratio"))
- field-names)
- "-ratio"))
-
- (scaler-field-name (and (not (method-exists? 'mus-scaler))
- (let ((fld (find-if (lambda (name)
- (or (string=? name "r")
- (string=? name "amplitude")))
- field-names)))
- (and fld (string-append "-" fld)))))
-
- (order-field-name (and (not (method-exists? 'mus-order))
- (let ((fld (find-if (lambda (name)
- (or (string=? name "n")
- (string=? name "order")))
- field-names)))
- (and fld (string-append "-" fld)))))
-
- ;; using append to splice out unwanted entries
- (methods `(append ,original-methods
-
- (if ,phase-field-name
- (list
- (list 'mus-phase
- (lambda (g)
- (,(string->symbol (string-append sname (or phase-field-name "oops"))) g))
- (lambda (g val)
- (set! (,(string->symbol (string-append sname (or phase-field-name "oops"))) g) val))))
- (list))
-
- (if ,frequency-field-name
- (list
- (list 'mus-frequency
- (lambda (g)
- (radians->hz (,(string->symbol (string-append sname (or frequency-field-name "oops"))) g)))
- (lambda (g val)
- (set! (,(string->symbol (string-append sname (or frequency-field-name "oops"))) g) (hz->radians val))
- val)))
- (list))
-
- (if ,offset-field-name
- (list
- (list 'mus-offset
- (lambda (g)
- (,(string->symbol (string-append sname (or offset-field-name "oops"))) g))
- (lambda (g val)
- (set! (,(string->symbol (string-append sname (or offset-field-name "oops"))) g) val)
- val)))
- (list))
-
- (if ,order-field-name
- (list ; not settable -- maybe use mus-length?
- (list 'mus-order
- (lambda (g)
- (,(string->symbol (string-append sname (or order-field-name "oops"))) g))))
- (list))
-
- (if ,scaler-field-name
- (list
- (list 'mus-scaler
- (lambda (g)
- (,(string->symbol (string-append sname (or scaler-field-name "oops"))) g))
- (lambda (g val)
- (set! (,(string->symbol (string-append sname (or scaler-field-name "oops"))) g) val))))
- (list))
-
- (if ,(not (method-exists? 'mus-describe))
- (list
- (list 'mus-describe
- (lambda (g)
- (let ((desc (mus-name g))
- (first-time #t))
- (for-each
- (lambda (field)
- (set! desc (string-append desc
- (format #f "~A~A: ~A"
- (if first-time " " ", ")
- field
- (if (string=? field "frequency")
- (radians->hz ((symbol->value (string->symbol (string-append ,sname "-" field))) g))
- ((symbol->value (string->symbol (string-append ,sname "-" field))) g)))))
- (set! first-time #f))
- (list , at field-names))
- desc))))
- (list))
-
- (if ,(not (method-exists? 'mus-run))
- (list
- (list 'mus-run
- (lambda (g arg1 arg2)
- (,(string->symbol sname) g arg1)))) ; this assumes the run-time function takes two args
- (list))
-
- (if ,(not (method-exists? 'mus-reset))
- (list
- (list 'mus-reset
- (lambda (g)
- (for-each
- (lambda (name type orig)
- (if (or (not (string=? type "clm"))
- (not ((symbol->value (string->symbol (string-append ,sname "-" name))) g)))
- (set! ((string->symbol (string-append ,sname "-" name)) g) orig)
- (mus-reset ((symbol->value (string->symbol (string-append ,sname "-" name))) g))))
- (list , at field-names)
- (list ,@(map symbol->string field-types))
- (list ,@(map (lambda (n)
- (if (and (list? n)
- (>= (length n) 2))
- (cadr n)
- 0.0))
- fields))))))
- (list))
-
- (if ,(not (method-exists? 'mus-name))
- (list
- (list 'mus-name
- (lambda (g)
- ,sname)
- (lambda (g new-name)
- (set-car! (cdr (assoc 'mus-name (g (- (length g) 1))))
- (lambda (g)
- new-name))))) ; depend on closures?
- (list)))))
-
- `(begin
- (define ,(string->symbol (string-append sname "?"))
- (lambda (obj)
- (and (list? obj)
- (eq? (car obj) ',(string->symbol sname)))))
-
- (define ,(string->symbol (string-append sname "-methods"))
- (lambda ()
- ,methods))
-
- (define* (,(string->symbol (string-append "make-" sname))
- ,@(map (lambda (n)
- (if (and (list? n)
- (>= (length n) 2))
- (list (car n) (cadr n))
- (list n 0.0)))
- fields))
- (,wrapper (if (list? ,methods)
- (list ',(string->symbol sname)
- ,@(map string->symbol field-names)
- ,methods)
- (list ',(string->symbol sname)
- ,@(map string->symbol field-names)))))
-
- ,@(map (let ((ctr 1))
- (lambda (n type)
- (let ((val `(define ,(string->symbol (string-append sname "-" n))
- (make-procedure-with-setter
- (lambda (arg)
- "generator field accessor"
- (arg ,ctr))
- (lambda (arg val)
- (list-set! arg ,ctr val))))))
- (add-clm-field sname (string-append sname "-" n) ctr type)
- (set! ctr (+ 1 ctr))
- val)))
- field-names field-types))))
-
-
-(define def-clm-struct defgenerator)
-
-(define (ws-interrupt?) #f)
-
-
-
-;;; -------- with-threaded-sound --------
-
-(defmacro with-threaded-sound (args . body)
- (if (and (provided? 'threads)
- (not (= (optimization) 0)))
- (let ((split
- (lambda (l n k)
- (define (split-1 s l n i)
- (if (null? l)
- (reverse s)
- (if (= i n)
- (split-1 (cons (car l) s) (cdr l) n 1)
- (split-1 s (cdr l) n (+ i 1)))))
- (split-1 '() l n (- n k))))
-
- (remove-output-and-reverb-args
- (lambda (lst)
- (let ((badarg #f)
- (new-args '()))
- (for-each
- (lambda (arg)
- (if badarg
- (set! badarg #f)
- (if (not (member arg (list :output :reverb :revfile :reverb-data :reverb-channels)))
- (set! new-args (cons arg new-args))
- (set! badarg #t))))
- lst)
- (reverse new-args)))))
-
- (let ((lists '()))
- (do ((i 0 (+ 1 i)))
- ((= i *clm-threads*))
- (set! lists (cons (split body *clm-threads* i) lists)))
-
- (let ((new-args (remove-output-and-reverb-args args)))
-
- `(with-sound-helper
- (lambda ()
- (let ((threads '())
- (thread-output (make-thread-variable))
- (thread-reverb (and *reverb* (make-thread-variable)))
- (mix-lock (make-lock))
- (main-output *output*)
- (main-reverb *reverb*))
-
- (set! *output* thread-output)
- (if thread-reverb (set! *reverb* thread-reverb))
-
- ,@(map
- (lambda (expr)
- `(set! threads (cons (make-thread
- (lambda ()
- (let* ((reverb-tmp (and *reverb* (tmpnam)))
- (tmp (with-sound-helper
- (lambda ()
- , at expr
- #f)
- :thread-output thread-output
- :thread-reverb thread-reverb
- :output (tmpnam)
- :revfile reverb-tmp
- :to-snd #f
- , at new-args
- )))
- (grab-lock mix-lock)
- (display (format #f "mix ~S [~D]~%" tmp (mus-safety main-output)))
- (if (= (mus-safety main-output) 1)
- (begin
- (sample->file+ main-output (thread-output))
- (mus-close (thread-output)))
- (mus-mix main-output tmp))
- (if *reverb*
- (if (= (mus-safety main-output) 1)
- (begin
- (sample->file+ main-reverb (thread-reverb))
- (mus-close (thread-reverb)))
- (mus-mix main-reverb reverb-tmp)))
- (release-lock mix-lock)
- (delete-file tmp))))
- threads)))
- lists)
-
- (for-each
- (lambda (thread)
- (join-thread thread))
- threads)
-
- (if main-reverb (set! *reverb* main-reverb))
- (set! *output* main-output)))
-
- , at args))))
-
- `(with-sound-helper
- (lambda ()
- , at body)
- , at args)))
+ (methods (and (pair? struct-name)
+ (or (and (> (length struct-name) 2)
+ (equal? (struct-name 1) :methods)
+ (struct-name 2))
+ (and (= (length struct-name) 5)
+ (equal? (struct-name 3) :methods)
+ (struct-name 4))))))
+ `(begin
+ (define ,(string->symbol (string-append sname "?")) #f)
+ (define ,(string->symbol (string-append "make-" sname)) #f)
+
+ (let ((gen-type ',(string->symbol (string-append "+" sname "+")))
+ (gen-methods (and ,methods (apply inlet ,methods))))
+
+ (set! ,(string->symbol (string-append sname "?"))
+ (lambda (obj)
+ (and (let? obj)
+ (eq? (obj 'mus-generator-type) gen-type))))
+
+ (set! ,(string->symbol (string-append "make-" sname))
+ (lambda* ,(map (lambda (n)
+ (if (pair? n) n (list n 0.0)))
+ fields)
+ (,wrapper
+ (openlet
+ ,(if methods
+ `(sublet gen-methods
+ ,@(list->bindings (reverse fields)) 'mus-generator-type gen-type)
+ `(inlet 'mus-generator-type gen-type ,@(list->bindings fields)))))))))))
;;; --------------------------------------------------------------------------------
@@ -880,24 +518,26 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
;;; functions from Snd that are used in some instruments
;;; these replacements assume that the Snd functions are not present
-(define (file-name name)
+(define* (file-name name)
(if (string? name)
(mus-expand-filename name)
(mus-file-name name)))
(define srate mus-sound-srate)
-(define (channels obj)
- (if (string? obj)
- (mus-sound-chans obj)
- (mus-channels obj)))
+(define (channels . args)
+ (let ((obj (car args)))
+ (if (string? obj)
+ (mus-sound-chans obj)
+ (mus-channels obj))))
;;; I think length is handled by s7 for all types
-(define (frames obj)
- (if (string? obj)
- (mus-sound-frames obj)
- (length obj)))
+(define (framples . args)
+ (let ((obj (car args)))
+ (if (string? obj)
+ (mus-sound-framples obj)
+ (length obj))))
(define snd-print display)
diff --git a/sndlib.h b/sndlib.h
new file mode 100644
index 0000000..9c164b8
--- /dev/null
+++ b/sndlib.h
@@ -0,0 +1,435 @@
+#ifndef SNDLIB_H
+#define SNDLIB_H
+
+#define SNDLIB_VERSION 24
+#define SNDLIB_REVISION 4
+#define SNDLIB_DATE "1-Sep-15"
+
+#include <stdio.h>
+#include <time.h>
+#include <sys/types.h>
+
+/* not sure how to handle this one cleanly: */
+#ifndef __cplusplus
+#ifndef _MSC_VER
+ #include <stdbool.h>
+#else
+#ifndef true
+ #define bool unsigned char
+ #define true 1
+ #define false 0
+#endif
+#endif
+#endif
+
+typedef double mus_float_t;
+typedef long long int mus_long_t;
+
+#if defined(__sun) && defined(__SVR4)
+ #define HAVE_SUN 1
+#endif
+
+#ifdef _MSC_VER
+ /* I got these from gmp.h */
+ #if defined (__GNUC__)
+ #define MUS_EXPORT __declspec(__dllexport__)
+ #else
+ #define MUS_EXPORT __declspec(dllexport)
+ #endif
+#else
+ #define MUS_EXPORT
+#endif
+
+
+#ifndef MUS_LITTLE_ENDIAN
+ #if WORDS_BIGENDIAN
+ #define MUS_LITTLE_ENDIAN 0
+ #else
+ #define MUS_LITTLE_ENDIAN 1
+ #endif
+#endif
+
+typedef enum {MUS_UNKNOWN_HEADER, MUS_NEXT, MUS_AIFC, MUS_RIFF, MUS_RF64, MUS_BICSF, MUS_NIST, MUS_INRS, MUS_ESPS, MUS_SVX, MUS_VOC,
+ MUS_SNDT, MUS_RAW, MUS_SMP, MUS_AVR, MUS_IRCAM, MUS_SD1, MUS_SPPACK, MUS_MUS10, MUS_HCOM, MUS_PSION, MUS_MAUD,
+ MUS_IEEE, MUS_MATLAB, MUS_ADC, MUS_MIDI, MUS_SOUNDFONT, MUS_GRAVIS, MUS_COMDISCO, MUS_GOLDWAVE, MUS_SRFS,
+ MUS_MIDI_SAMPLE_DUMP, MUS_DIAMONDWARE, MUS_ADF, MUS_SBSTUDIOII, MUS_DELUSION,
+ MUS_FARANDOLE, MUS_SAMPLE_DUMP, MUS_ULTRATRACKER, MUS_YAMAHA_SY85, MUS_YAMAHA_TX16W, MUS_DIGIPLAYER,
+ MUS_COVOX, MUS_AVI, MUS_OMF, MUS_QUICKTIME, MUS_ASF, MUS_YAMAHA_SY99, MUS_KURZWEIL_2000,
+ MUS_AIFF, MUS_PAF, MUS_CSL, MUS_FILE_SAMP, MUS_PVF, MUS_SOUNDFORGE, MUS_TWINVQ, MUS_AKAI4,
+ MUS_IMPULSETRACKER, MUS_KORG, MUS_NVF, MUS_CAFF, MUS_MAUI, MUS_SDIF, MUS_OGG, MUS_FLAC, MUS_SPEEX, MUS_MPEG,
+ MUS_SHORTEN, MUS_TTA, MUS_WAVPACK, MUS_SOX,
+ MUS_NUM_HEADERS} mus_header_t;
+
+
+typedef enum {MUS_UNKNOWN_SAMPLE, MUS_BSHORT, MUS_MULAW, MUS_BYTE, MUS_BFLOAT, MUS_BINT, MUS_ALAW, MUS_UBYTE, MUS_B24INT,
+ MUS_BDOUBLE, MUS_LSHORT, MUS_LINT, MUS_LFLOAT, MUS_LDOUBLE, MUS_UBSHORT, MUS_ULSHORT, MUS_L24INT,
+ MUS_BINTN, MUS_LINTN, MUS_BFLOAT_UNSCALED, MUS_LFLOAT_UNSCALED, MUS_BDOUBLE_UNSCALED, MUS_LDOUBLE_UNSCALED,
+ MUS_NUM_SAMPLES} mus_sample_t;
+
+#ifndef MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE
+ #if WORDS_BIGENDIAN
+ #if __APPLE__
+ #define MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE MUS_BFLOAT
+ #else
+ #define MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE MUS_BSHORT
+ #endif
+ #else
+ #if __APPLE__
+ #define MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE MUS_LFLOAT
+ #else
+ #define MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE MUS_LSHORT
+ #endif
+ #endif
+#endif
+
+#ifndef MUS_OUT_SAMPLE_TYPE
+ #if WORDS_BIGENDIAN
+ #define MUS_OUT_SAMPLE_TYPE MUS_BDOUBLE
+ #else
+ #define MUS_OUT_SAMPLE_TYPE MUS_LDOUBLE
+ #endif
+#endif
+
+#define MUS_IGNORE_SAMPLE MUS_NUM_SAMPLES
+/* MUS_LINTN and MUS_BINTN refer to 32 bit ints with 31 bits of fraction -- the data is left justified */
+/* "unscaled" means the float value is used directly (i.e. not as -1.0 to 1.0, but (probably) -32768.0 to 32768.0) */
+
+
+#define MUS_NIST_SHORTPACK 2
+#define MUS_AIFF_IMA_ADPCM 99
+
+#define MUS_AUDIO_PACK_SYSTEM(n) ((n) << 16)
+#define MUS_AUDIO_SYSTEM(n) (((n) >> 16) & 0xffff)
+#define MUS_AUDIO_DEVICE(n) ((n) & 0xffff)
+
+
+#define MUS_AUDIO_DEFAULT 0
+#define MUS_ERROR -1
+
+enum {MUS_NO_ERROR, MUS_NO_FREQUENCY, MUS_NO_PHASE, MUS_NO_GEN, MUS_NO_LENGTH,
+ MUS_NO_DESCRIBE, MUS_NO_DATA, MUS_NO_SCALER,
+ MUS_MEMORY_ALLOCATION_FAILED,
+ MUS_CANT_OPEN_FILE, MUS_NO_SAMPLE_INPUT, MUS_NO_SAMPLE_OUTPUT,
+ MUS_NO_SUCH_CHANNEL, MUS_NO_FILE_NAME_PROVIDED, MUS_NO_LOCATION, MUS_NO_CHANNEL,
+ MUS_NO_SUCH_FFT_WINDOW, MUS_UNSUPPORTED_SAMPLE_TYPE, MUS_HEADER_READ_FAILED,
+ MUS_UNSUPPORTED_HEADER_TYPE,
+ MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, MUS_NOT_A_SOUND_FILE, MUS_FILE_CLOSED, MUS_WRITE_ERROR,
+ MUS_HEADER_WRITE_FAILED, MUS_CANT_OPEN_TEMP_FILE, MUS_INTERRUPTED, MUS_BAD_ENVELOPE,
+
+ MUS_AUDIO_CHANNELS_NOT_AVAILABLE, MUS_AUDIO_SRATE_NOT_AVAILABLE, MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE,
+ MUS_AUDIO_NO_INPUT_AVAILABLE, MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
+ MUS_AUDIO_WRITE_ERROR, MUS_AUDIO_SIZE_NOT_AVAILABLE, MUS_AUDIO_DEVICE_NOT_AVAILABLE,
+ MUS_AUDIO_CANT_CLOSE, MUS_AUDIO_CANT_OPEN, MUS_AUDIO_READ_ERROR,
+ MUS_AUDIO_CANT_WRITE, MUS_AUDIO_CANT_READ, MUS_AUDIO_NO_READ_PERMISSION,
+
+ MUS_CANT_CLOSE_FILE, MUS_ARG_OUT_OF_RANGE,
+ MUS_NO_CHANNELS, MUS_NO_HOP, MUS_NO_WIDTH, MUS_NO_FILE_NAME, MUS_NO_RAMP, MUS_NO_RUN,
+ MUS_NO_INCREMENT, MUS_NO_OFFSET,
+ MUS_NO_XCOEFF, MUS_NO_YCOEFF, MUS_NO_XCOEFFS, MUS_NO_YCOEFFS, MUS_NO_RESET, MUS_BAD_SIZE, MUS_CANT_CONVERT,
+ MUS_READ_ERROR,
+ MUS_NO_FEEDFORWARD, MUS_NO_FEEDBACK, MUS_NO_INTERP_TYPE, MUS_NO_POSITION, MUS_NO_ORDER, MUS_NO_COPY,
+ MUS_CANT_TRANSLATE,
+ MUS_NUM_ERRORS};
+
+/* keep this list in sync with mus_error_names in sound.c and snd-test.scm|rb */
+
+#define MUS_LOOP_INFO_SIZE 8
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* -------- sound.c -------- */
+
+#ifdef __GNUC__
+ MUS_EXPORT int mus_error(int error, const char *format, ...) __attribute__ ((format (printf, 2, 3)));
+ MUS_EXPORT void mus_print(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
+ MUS_EXPORT char *mus_format(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
+#else
+ MUS_EXPORT int mus_error(int error, const char *format, ...);
+ MUS_EXPORT void mus_print(const char *format, ...);
+ MUS_EXPORT char *mus_format(const char *format, ...);
+#endif
+
+typedef void mus_error_handler_t(int type, char *msg);
+MUS_EXPORT mus_error_handler_t *mus_error_set_handler(mus_error_handler_t *new_error_handler);
+MUS_EXPORT const char *mus_error_type_to_string(int err);
+
+typedef void mus_print_handler_t(char *msg);
+MUS_EXPORT mus_print_handler_t *mus_print_set_handler(mus_print_handler_t *new_print_handler);
+
+typedef mus_float_t mus_clip_handler_t(mus_float_t val);
+MUS_EXPORT mus_clip_handler_t *mus_clip_set_handler(mus_clip_handler_t *new_clip_handler);
+MUS_EXPORT mus_clip_handler_t *mus_clip_set_handler_and_checker(mus_clip_handler_t *new_clip_handler, bool (*checker)(void));
+
+MUS_EXPORT mus_long_t mus_sound_samples(const char *arg);
+MUS_EXPORT mus_long_t mus_sound_framples(const char *arg);
+MUS_EXPORT int mus_sound_datum_size(const char *arg);
+MUS_EXPORT mus_long_t mus_sound_data_location(const char *arg);
+MUS_EXPORT int mus_sound_chans(const char *arg);
+MUS_EXPORT int mus_sound_srate(const char *arg);
+MUS_EXPORT mus_header_t mus_sound_header_type(const char *arg);
+MUS_EXPORT mus_sample_t mus_sound_sample_type(const char *arg);
+MUS_EXPORT int mus_sound_original_sample_type(const char *arg);
+MUS_EXPORT mus_long_t mus_sound_comment_start(const char *arg);
+MUS_EXPORT mus_long_t mus_sound_comment_end(const char *arg);
+MUS_EXPORT mus_long_t mus_sound_length(const char *arg);
+MUS_EXPORT int mus_sound_fact_samples(const char *arg);
+MUS_EXPORT time_t mus_sound_write_date(const char *arg);
+MUS_EXPORT int mus_sound_type_specifier(const char *arg);
+MUS_EXPORT int mus_sound_block_align(const char *arg);
+MUS_EXPORT int mus_sound_bits_per_sample(const char *arg);
+
+MUS_EXPORT int mus_sound_set_chans(const char *arg, int val);
+MUS_EXPORT int mus_sound_set_srate(const char *arg, int val);
+MUS_EXPORT mus_header_t mus_sound_set_header_type(const char *arg, mus_header_t val);
+MUS_EXPORT mus_sample_t mus_sound_set_sample_type(const char *arg, mus_sample_t val);
+MUS_EXPORT int mus_sound_set_data_location(const char *arg, mus_long_t val);
+MUS_EXPORT int mus_sound_set_samples(const char *arg, mus_long_t val);
+
+MUS_EXPORT const char *mus_header_type_name(mus_header_t type);
+MUS_EXPORT const char *mus_header_type_to_string(mus_header_t type);
+MUS_EXPORT const char *mus_sample_type_name(mus_sample_t samp_type);
+MUS_EXPORT const char *mus_sample_type_to_string(mus_sample_t samp_type);
+MUS_EXPORT const char *mus_sample_type_short_name(mus_sample_t samp_type);
+
+MUS_EXPORT char *mus_sound_comment(const char *name);
+MUS_EXPORT int mus_bytes_per_sample(mus_sample_t samp_type);
+MUS_EXPORT float mus_sound_duration(const char *arg);
+MUS_EXPORT int mus_sound_initialize(void);
+MUS_EXPORT int mus_sound_override_header(const char *arg, int srate, int chans, mus_sample_t samp_type, mus_header_t type, mus_long_t location, mus_long_t size);
+MUS_EXPORT int mus_sound_forget(const char *name);
+MUS_EXPORT int mus_sound_prune(void);
+MUS_EXPORT void mus_sound_report_cache(FILE *fp);
+MUS_EXPORT int *mus_sound_loop_info(const char *arg);
+MUS_EXPORT void mus_sound_set_loop_info(const char *arg, int *loop);
+MUS_EXPORT int mus_sound_mark_info(const char *arg, int **mark_ids, int **mark_positions);
+
+MUS_EXPORT int mus_sound_open_input(const char *arg);
+MUS_EXPORT int mus_sound_open_output(const char *arg, int srate, int chans, mus_sample_t sample_type, mus_header_t header_type, const char *comment);
+MUS_EXPORT int mus_sound_reopen_output(const char *arg, int chans, mus_sample_t samp_type, mus_header_t type, mus_long_t data_loc);
+MUS_EXPORT int mus_sound_close_input(int fd);
+MUS_EXPORT int mus_sound_close_output(int fd, mus_long_t bytes_of_data);
+#define mus_sound_read(Fd, Beg, End, Chans, Bufs) mus_file_read(Fd, Beg, End, Chans, Bufs)
+#define mus_sound_write(Fd, Beg, End, Chans, Bufs) mus_file_write(Fd, Beg, End, Chans, Bufs)
+
+MUS_EXPORT mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mus_long_t *times);
+MUS_EXPORT int mus_sound_set_maxamps(const char *ifile, int chans, mus_float_t *vals, mus_long_t *times);
+MUS_EXPORT bool mus_sound_maxamp_exists(const char *ifile);
+MUS_EXPORT bool mus_sound_channel_maxamp_exists(const char *file, int chan);
+MUS_EXPORT mus_float_t mus_sound_channel_maxamp(const char *file, int chan, mus_long_t *pos);
+MUS_EXPORT void mus_sound_channel_set_maxamp(const char *file, int chan, mus_float_t mx, mus_long_t pos);
+MUS_EXPORT mus_long_t mus_file_to_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_float_t *array);
+MUS_EXPORT int mus_array_to_file(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels);
+MUS_EXPORT const char *mus_array_to_file_with_error(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels);
+MUS_EXPORT mus_long_t mus_file_to_float_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_float_t *array);
+MUS_EXPORT int mus_float_array_to_file(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels);
+
+MUS_EXPORT mus_float_t **mus_sound_saved_data(const char *arg);
+MUS_EXPORT void mus_sound_set_saved_data(const char *arg, mus_float_t **data);
+MUS_EXPORT void mus_file_save_data(int tfd, mus_long_t framples, mus_float_t **data);
+
+
+
+/* -------- audio.c -------- */
+
+MUS_EXPORT int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size);
+MUS_EXPORT int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size);
+MUS_EXPORT int mus_audio_write(int line, char *buf, int bytes);
+MUS_EXPORT int mus_audio_close(int line);
+MUS_EXPORT int mus_audio_read(int line, char *buf, int bytes);
+
+MUS_EXPORT int mus_audio_initialize(void);
+MUS_EXPORT char *mus_audio_moniker(void);
+MUS_EXPORT int mus_audio_api(void);
+MUS_EXPORT mus_sample_t mus_audio_compatible_sample_type(int dev);
+
+#if HAVE_OSS || HAVE_ALSA
+MUS_EXPORT void mus_oss_set_buffers(int num, int size);
+MUS_EXPORT char *mus_alsa_playback_device(void);
+MUS_EXPORT char *mus_alsa_set_playback_device(const char *name);
+MUS_EXPORT char *mus_alsa_capture_device(void);
+MUS_EXPORT char *mus_alsa_set_capture_device(const char *name);
+MUS_EXPORT char *mus_alsa_device(void);
+MUS_EXPORT char *mus_alsa_set_device(const char *name);
+MUS_EXPORT int mus_alsa_buffer_size(void);
+MUS_EXPORT int mus_alsa_set_buffer_size(int size);
+MUS_EXPORT int mus_alsa_buffers(void);
+MUS_EXPORT int mus_alsa_set_buffers(int num);
+MUS_EXPORT bool mus_alsa_squelch_warning(void);
+MUS_EXPORT bool mus_alsa_set_squelch_warning(bool val);
+#endif
+
+#if __APPLE__
+ MUS_EXPORT bool mus_audio_output_properties_mutable(bool mut);
+#endif
+
+MUS_EXPORT int mus_audio_device_channels(int dev);
+MUS_EXPORT mus_sample_t mus_audio_device_sample_type(int dev);
+
+
+
+/* -------- io.c -------- */
+
+MUS_EXPORT int mus_file_open_descriptors(int tfd, const char *arg, mus_sample_t df, int ds, mus_long_t dl, int dc, mus_header_t dt);
+MUS_EXPORT int mus_file_open_read(const char *arg);
+MUS_EXPORT bool mus_file_probe(const char *arg);
+MUS_EXPORT int mus_file_open_write(const char *arg);
+MUS_EXPORT int mus_file_create(const char *arg);
+MUS_EXPORT int mus_file_reopen_write(const char *arg);
+MUS_EXPORT int mus_file_close(int fd);
+MUS_EXPORT mus_long_t mus_file_seek_frample(int tfd, mus_long_t frample);
+MUS_EXPORT mus_long_t mus_file_read(int fd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs);
+MUS_EXPORT mus_long_t mus_file_read_chans(int fd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs, mus_float_t **cm);
+MUS_EXPORT int mus_file_write(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs);
+MUS_EXPORT mus_long_t mus_file_read_any(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs, mus_float_t **cm);
+MUS_EXPORT mus_long_t mus_file_read_file(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs);
+MUS_EXPORT mus_long_t mus_file_read_buffer(int charbuf_sample_type, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs, char *charbuf);
+MUS_EXPORT int mus_file_write_file(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs);
+MUS_EXPORT int mus_file_write_buffer(int charbuf_sample_type, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs, char *charbuf, bool clipped);
+MUS_EXPORT char *mus_expand_filename(const char *name);
+MUS_EXPORT char *mus_getcwd(void);
+
+MUS_EXPORT bool mus_clipping(void);
+MUS_EXPORT bool mus_set_clipping(bool new_value);
+MUS_EXPORT bool mus_file_clipping(int tfd);
+MUS_EXPORT int mus_file_set_clipping(int tfd, bool clipped);
+
+MUS_EXPORT int mus_file_set_header_type(int tfd, mus_header_t type);
+MUS_EXPORT mus_header_t mus_file_header_type(int tfd);
+MUS_EXPORT char *mus_file_fd_name(int tfd);
+MUS_EXPORT int mus_file_set_chans(int tfd, int chans);
+
+MUS_EXPORT int mus_iclamp(int lo, int val, int hi);
+MUS_EXPORT mus_long_t mus_oclamp(mus_long_t lo, mus_long_t val, mus_long_t hi);
+MUS_EXPORT mus_float_t mus_fclamp(mus_float_t lo, mus_float_t val, mus_float_t hi);
+
+/* for CLM */
+/* these are needed to clear a saved lisp image to the just-initialized state */
+MUS_EXPORT void mus_reset_io_c(void);
+MUS_EXPORT void mus_reset_headers_c(void);
+MUS_EXPORT void mus_reset_audio_c(void);
+
+MUS_EXPORT int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, mus_sample_t samp_type, mus_float_t *min_samp, mus_float_t *max_samp);
+
+MUS_EXPORT mus_long_t mus_max_malloc(void);
+MUS_EXPORT mus_long_t mus_set_max_malloc(mus_long_t new_max);
+MUS_EXPORT mus_long_t mus_max_table_size(void);
+MUS_EXPORT mus_long_t mus_set_max_table_size(mus_long_t new_max);
+
+MUS_EXPORT char *mus_strdup(const char *str);
+MUS_EXPORT int mus_strlen(const char *str);
+MUS_EXPORT bool mus_strcmp(const char *str1, const char *str2);
+MUS_EXPORT char *mus_strcat(char *errmsg, const char *str, int *err_size);
+
+
+
+/* -------- headers.c -------- */
+
+MUS_EXPORT bool mus_is_sample_type(int n);
+MUS_EXPORT bool mus_is_header_type(int n);
+
+MUS_EXPORT mus_long_t mus_header_samples(void);
+MUS_EXPORT mus_long_t mus_header_data_location(void);
+MUS_EXPORT int mus_header_chans(void);
+MUS_EXPORT int mus_header_srate(void);
+MUS_EXPORT mus_header_t mus_header_type(void);
+MUS_EXPORT mus_sample_t mus_header_sample_type(void);
+MUS_EXPORT mus_long_t mus_header_comment_start(void);
+MUS_EXPORT mus_long_t mus_header_comment_end(void);
+MUS_EXPORT int mus_header_type_specifier(void);
+MUS_EXPORT int mus_header_bits_per_sample(void);
+MUS_EXPORT int mus_header_fact_samples(void);
+MUS_EXPORT int mus_header_block_align(void);
+MUS_EXPORT int mus_header_loop_mode(int which);
+MUS_EXPORT int mus_header_loop_start(int which);
+MUS_EXPORT int mus_header_loop_end(int which);
+MUS_EXPORT int mus_header_mark_position(int id);
+MUS_EXPORT int mus_header_mark_info(int **marker_ids, int **marker_positions);
+MUS_EXPORT int mus_header_base_note(void);
+MUS_EXPORT int mus_header_base_detune(void);
+MUS_EXPORT void mus_header_set_raw_defaults(int sr, int chn, mus_sample_t frm);
+MUS_EXPORT void mus_header_raw_defaults(int *sr, int *chn, mus_sample_t *frm);
+MUS_EXPORT mus_long_t mus_header_true_length(void);
+MUS_EXPORT int mus_header_original_sample_type(void);
+MUS_EXPORT mus_long_t mus_samples_to_bytes(mus_sample_t samp_type, mus_long_t size);
+MUS_EXPORT mus_long_t mus_bytes_to_samples(mus_sample_t samp_type, mus_long_t size);
+MUS_EXPORT int mus_header_read(const char *name);
+MUS_EXPORT int mus_header_write(const char *name, mus_header_t type, int srate, int chans, mus_long_t loc, mus_long_t size_in_samples,
+ mus_sample_t samp_type, const char *comment, int len);
+MUS_EXPORT int mus_write_header(const char *name, mus_header_t type, int in_srate, int in_chans, mus_long_t size_in_samples,
+ mus_sample_t samp_type, const char *comment);
+MUS_EXPORT mus_long_t mus_header_aux_comment_start(int n);
+MUS_EXPORT mus_long_t mus_header_aux_comment_end(int n);
+MUS_EXPORT int mus_header_initialize(void);
+MUS_EXPORT bool mus_header_writable(mus_header_t type, mus_sample_t samp_type);
+MUS_EXPORT void mus_header_set_aiff_loop_info(int *data);
+MUS_EXPORT int mus_header_sf2_entries(void);
+MUS_EXPORT char *mus_header_sf2_name(int n);
+MUS_EXPORT int mus_header_sf2_start(int n);
+MUS_EXPORT int mus_header_sf2_end(int n);
+MUS_EXPORT int mus_header_sf2_loop_start(int n);
+MUS_EXPORT int mus_header_sf2_loop_end(int n);
+MUS_EXPORT const char *mus_header_original_sample_type_name(int samp_type, mus_header_t type);
+MUS_EXPORT bool mus_header_no_header(const char *name);
+
+MUS_EXPORT char *mus_header_riff_aux_comment(const char *name, mus_long_t *starts, mus_long_t *ends);
+MUS_EXPORT char *mus_header_aiff_aux_comment(const char *name, mus_long_t *starts, mus_long_t *ends);
+
+MUS_EXPORT int mus_header_change_chans(const char *filename, mus_header_t type, int new_chans);
+MUS_EXPORT int mus_header_change_srate(const char *filename, mus_header_t type, int new_srate);
+MUS_EXPORT int mus_header_change_type(const char *filename, mus_header_t new_type, mus_sample_t new_sample_type);
+MUS_EXPORT int mus_header_change_sample_type(const char *filename, mus_header_t type, mus_sample_t new_sample_type);
+MUS_EXPORT int mus_header_change_location(const char *filename, mus_header_t type, mus_long_t new_location);
+MUS_EXPORT int mus_header_change_comment(const char *filename, mus_header_t type, const char *new_comment);
+MUS_EXPORT int mus_header_change_data_size(const char *filename, mus_header_t type, mus_long_t bytes);
+
+typedef void mus_header_write_hook_t(const char *filename);
+MUS_EXPORT mus_header_write_hook_t *mus_header_write_set_hook(mus_header_write_hook_t *new_hook);
+
+
+ /* these are internal to sndlib */
+void mus_bint_to_char(unsigned char *j, int x);
+void mus_lint_to_char(unsigned char *j, int x);
+void mus_bfloat_to_char(unsigned char *j, float x);
+void mus_lfloat_to_char(unsigned char *j, float x);
+void mus_bshort_to_char(unsigned char *j, short x);
+void mus_lshort_to_char(unsigned char *j, short x);
+void mus_bdouble_to_char(unsigned char *j, double x);
+void mus_blong_to_char(unsigned char *j, mus_long_t x);
+void mus_llong_to_char(unsigned char *j, mus_long_t x);
+int mus_char_to_bint(const unsigned char *inp);
+int mus_char_to_lint(const unsigned char *inp);
+mus_long_t mus_char_to_llong(const unsigned char *inp);
+mus_long_t mus_char_to_blong(const unsigned char *inp);
+int mus_char_to_uninterpreted_int(const unsigned char *inp);
+float mus_char_to_bfloat(const unsigned char *inp);
+float mus_char_to_lfloat(const unsigned char *inp);
+short mus_char_to_bshort(const unsigned char *inp);
+short mus_char_to_lshort(const unsigned char *inp);
+unsigned short mus_char_to_ubshort(const unsigned char *inp);
+unsigned short mus_char_to_ulshort(const unsigned char *inp);
+double mus_char_to_ldouble(const unsigned char *inp);
+double mus_char_to_bdouble(const unsigned char *inp);
+unsigned int mus_char_to_ubint(const unsigned char *inp);
+unsigned int mus_char_to_ulint(const unsigned char *inp);
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#if (!DISABLE_DEPRECATED)
+#define mus_header_format mus_header_sample_type
+#define mus_header_original_format mus_header_original_sample_type
+#define mus_header_original_format_name mus_header_original_sample_type_name
+#define mus_header_change_format mus_header_change_sample_type
+#define mus_sound_original_format mus_sound_original_sample_type
+#define MUS_AUDIO_COMPATIBLE_FORMAT MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE
+#define MUS_OUT_FORMAT MUS_OUT_SAMPLE_TYPE
+#define MUS_AUDIO_FORMAT_NOT_AVAILABLE MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE
+#define mus_audio_compatible_format mus_audio_compatible_sample_type
+#define mus_audio_device_format mus_audio_device_sample_type
+#endif
+
+#endif
diff --git a/sndlib.h.in b/sndlib.h.in
deleted file mode 100644
index 44ab326..0000000
--- a/sndlib.h.in
+++ /dev/null
@@ -1,497 +0,0 @@
-#ifndef SNDLIB_H
-#define SNDLIB_H
-
-#define SNDLIB_VERSION 21
-#define SNDLIB_REVISION 2
-#define SNDLIB_DATE "11-Dec-09"
-
-
-/* these are picked up during configuration */
-
-#undef SNDLIB_USE_FLOATS
-#undef MUS_SAMPLE_BITS
-#undef mus_float_t
-#ifndef mus_long_t
- #define mus_long_t int64_t
-#endif
-
-#include <stdio.h>
-/* need FILE */
-
-#include <time.h>
-/* time_t used by mus_sound_write_date */
-#include <sys/types.h>
-
-
-/* not sure how to handle this one cleanly: */
-#ifndef __cplusplus
-#if HAVE_STDBOOL_H
- #include <stdbool.h>
-#else
-#ifndef true
- #define bool int
- #define true 1
- #define false 0
-#endif
-#endif
-#endif
-
-
-#if HAVE_WINDOZE
- /* I got these from gmp.h */
- #if defined (__GNUC__)
- #define MUS_EXPORT __declspec(__dllexport__)
- #else
- #define MUS_EXPORT __declspec(dllexport)
- #endif
-#else
- #define MUS_EXPORT
-#endif
-
-
-/* these used to be in configure.ac, but the 2.62 change to AC_C_BIGENDIAN ruins that */
-#ifndef MUS_LITTLE_ENDIAN
- #if WORDS_BIGENDIAN
- #define MUS_LITTLE_ENDIAN 0
- #else
- #define MUS_LITTLE_ENDIAN 1
- #endif
-#endif
-
-#ifndef MUS_AUDIO_COMPATIBLE_FORMAT
- #if WORDS_BIGENDIAN
- #if MUS_MAC_OSX
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_BFLOAT
- #else
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_BSHORT
- #endif
- #else
- #if MUS_MAC_OSX
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_LFLOAT
- #else
- #define MUS_AUDIO_COMPATIBLE_FORMAT MUS_LSHORT
- #endif
- #endif
-#endif
-
-#ifndef MUS_OUT_FORMAT
- #if WORDS_BIGENDIAN
- #if SNDLIB_USE_FLOATS
- #if WITH_DOUBLES
- #define MUS_OUT_FORMAT MUS_BDOUBLE
- #else
- #define MUS_OUT_FORMAT MUS_BFLOAT
- #endif
- #else
- #define MUS_OUT_FORMAT MUS_BINT
- #endif
- #else
- #if SNDLIB_USE_FLOATS
- #if WITH_DOUBLES
- #define MUS_OUT_FORMAT MUS_LDOUBLE
- #else
- #define MUS_OUT_FORMAT MUS_LFLOAT
- #endif
- #else
- #define MUS_OUT_FORMAT MUS_LINT
- #endif
- #endif
-#endif
-
-
-#if (!SNDLIB_USE_FLOATS)
- #define mus_sample_t int
- #ifndef MUS_SAMPLE_BITS
- #define MUS_SAMPLE_BITS 24
- #endif
- #define MUS_SAMPLE_0 0
- #define MUS_BYTE_TO_SAMPLE(n) ((mus_sample_t)((n) << (MUS_SAMPLE_BITS - 8)))
- #define MUS_SAMPLE_TO_BYTE(n) ((n) >> (MUS_SAMPLE_BITS - 8))
- #define MUS_SHORT_TO_SAMPLE(n) ((mus_sample_t)((n) << (MUS_SAMPLE_BITS - 16)))
- #define MUS_SAMPLE_TO_SHORT(n) ((short)((n) >> (MUS_SAMPLE_BITS - 16)))
- #if (MUS_SAMPLE_BITS < 24)
- #define MUS_INT24_TO_SAMPLE(n) ((mus_sample_t)((n) >> (24 - MUS_SAMPLE_BITS)))
- #define MUS_SAMPLE_TO_INT24(n) ((int)((n) << (24 - MUS_SAMPLE_BITS)))
- #else
- #define MUS_INT24_TO_SAMPLE(n) ((mus_sample_t)((n) << (MUS_SAMPLE_BITS - 24)))
- #define MUS_SAMPLE_TO_INT24(n) ((int)((n) >> (MUS_SAMPLE_BITS - 24)))
- #endif
- #define MUS_INT_TO_SAMPLE(n) ((mus_sample_t)(n))
- #define MUS_SAMPLE_TO_INT(n) ((int)(n))
- /* these are for direct read/write (no cross-image assumption is made about 32 bit int scaling) */
- #define MUS_FLOAT_TO_FIX ((MUS_SAMPLE_BITS < 32) ? (1 << (MUS_SAMPLE_BITS - 1)) : 0x7fffffff)
- #define MUS_FIX_TO_FLOAT (1.0 / (float)(MUS_FLOAT_TO_FIX))
- #define MUS_FLOAT_TO_SAMPLE(n) ((mus_sample_t)((n) * MUS_FLOAT_TO_FIX))
- #define MUS_SAMPLE_TO_FLOAT(n) ((float)((n) * MUS_FIX_TO_FLOAT))
- #define MUS_DOUBLE_TO_SAMPLE(n) ((mus_sample_t)((n) * MUS_FLOAT_TO_FIX))
- #define MUS_SAMPLE_TO_DOUBLE(n) ((double)((n) * MUS_FIX_TO_FLOAT))
- #define MUS_SAMPLE_MAX ((mus_sample_t)((MUS_SAMPLE_BITS < 32) ? (MUS_FLOAT_TO_FIX - 1) : 0x7fffffff))
- #define MUS_SAMPLE_MIN ((mus_sample_t)((MUS_SAMPLE_BITS < 32) ? (-(MUS_FLOAT_TO_FIX)) : -0x7fffffff))
- #define mus_sample_abs(Sample) abs(Sample)
-#else
- #define mus_sample_t mus_float_t
- #ifndef MUS_SAMPLE_BITS
- #define MUS_SAMPLE_BITS 24
- #endif
- #define MUS_SAMPLE_0 0.0
- #define MUS_BYTE_TO_SAMPLE(n) ((mus_sample_t)((mus_float_t)(n) / (mus_float_t)(1 << 7)))
- #define MUS_SHORT_TO_SAMPLE(n) ((mus_sample_t)((mus_float_t)(n) / (mus_float_t)(1 << 15)))
- #define MUS_INT_TO_SAMPLE(n) ((mus_sample_t)((mus_float_t)(n) / (mus_float_t)(1 << (MUS_SAMPLE_BITS - 1))))
- #define MUS_INT24_TO_SAMPLE(n) ((mus_sample_t)((mus_float_t)(n) / (mus_float_t)(1 << 23)))
- #define MUS_FLOAT_TO_FIX 1.0
- #define MUS_FIX_TO_FLOAT 1.0
- #define MUS_FLOAT_TO_SAMPLE(n) ((mus_sample_t)(n))
- #define MUS_DOUBLE_TO_SAMPLE(n) ((mus_sample_t)(n))
- #define MUS_SAMPLE_TO_FLOAT(n) ((mus_float_t)(n))
- #define MUS_SAMPLE_TO_DOUBLE(n) ((double)(n))
- #define MUS_SAMPLE_TO_INT(n) ((int)((n) * (1 << (MUS_SAMPLE_BITS - 1))))
- #define MUS_SAMPLE_TO_INT24(n) ((int)((n) * (1 << 23)))
- #define MUS_SAMPLE_TO_SHORT(n) ((short)((n) * (1 << 15)))
- #define MUS_SAMPLE_TO_BYTE(n) ((char)((n) * (1 << 7)))
- #define MUS_SAMPLE_MAX 0.99999
- #define MUS_SAMPLE_MIN (-1.0)
- #define mus_sample_abs(Sample) fabs(Sample)
-#endif
-
-
-enum {MUS_UNSUPPORTED, MUS_NEXT, MUS_AIFC, MUS_RIFF, MUS_RF64, MUS_BICSF, MUS_NIST, MUS_INRS, MUS_ESPS, MUS_SVX, MUS_VOC,
- MUS_SNDT, MUS_RAW, MUS_SMP, MUS_AVR, MUS_IRCAM, MUS_SD1, MUS_SPPACK, MUS_MUS10, MUS_HCOM, MUS_PSION, MUS_MAUD,
- MUS_IEEE, MUS_MATLAB, MUS_ADC, MUS_MIDI, MUS_SOUNDFONT, MUS_GRAVIS, MUS_COMDISCO, MUS_GOLDWAVE, MUS_SRFS,
- MUS_MIDI_SAMPLE_DUMP, MUS_DIAMONDWARE, MUS_ADF, MUS_SBSTUDIOII, MUS_DELUSION,
- MUS_FARANDOLE, MUS_SAMPLE_DUMP, MUS_ULTRATRACKER, MUS_YAMAHA_SY85, MUS_YAMAHA_TX16W, MUS_DIGIPLAYER,
- MUS_COVOX, MUS_AVI, MUS_OMF, MUS_QUICKTIME, MUS_ASF, MUS_YAMAHA_SY99, MUS_KURZWEIL_2000,
- MUS_AIFF, MUS_PAF, MUS_CSL, MUS_FILE_SAMP, MUS_PVF, MUS_SOUNDFORGE, MUS_TWINVQ, MUS_AKAI4,
- MUS_IMPULSETRACKER, MUS_KORG, MUS_NVF, MUS_CAFF, MUS_MAUI, MUS_SDIF, MUS_OGG, MUS_FLAC, MUS_SPEEX, MUS_MPEG,
- MUS_SHORTEN, MUS_TTA, MUS_WAVPACK, MUS_SOX,
- MUS_NUM_HEADER_TYPES};
-
-
-enum {MUS_UNKNOWN, MUS_BSHORT, MUS_MULAW, MUS_BYTE, MUS_BFLOAT, MUS_BINT, MUS_ALAW, MUS_UBYTE, MUS_B24INT,
- MUS_BDOUBLE, MUS_LSHORT, MUS_LINT, MUS_LFLOAT, MUS_LDOUBLE, MUS_UBSHORT, MUS_ULSHORT, MUS_L24INT,
- MUS_BINTN, MUS_LINTN, MUS_BFLOAT_UNSCALED, MUS_LFLOAT_UNSCALED, MUS_BDOUBLE_UNSCALED, MUS_LDOUBLE_UNSCALED,
- MUS_NUM_DATA_FORMATS};
-
-/* MUS_LINTN and MUS_BINTN refer to 32 bit ints with 31 bits of "fraction" -- the data is "left justified" */
-/* "unscaled" means the float value is used directly (i.e. not as -1.0 to 1.0, but (probably) -32768.0 to 32768.0) */
-
-
-#define MUS_NIST_SHORTPACK 2
-#define MUS_AIFF_IMA_ADPCM 99
-
-#define MUS_AUDIO_PACK_SYSTEM(n) ((n) << 16)
-#define MUS_AUDIO_SYSTEM(n) (((n) >> 16) & 0xffff)
-#define MUS_AUDIO_DEVICE(n) ((n) & 0xffff)
-
-
-#define MUS_AUDIO_DEFAULT 0
-#define MUS_ERROR -1
-
-enum {MUS_NO_ERROR, MUS_NO_FREQUENCY, MUS_NO_PHASE, MUS_NO_GEN, MUS_NO_LENGTH,
- MUS_NO_FREE, MUS_NO_DESCRIBE, MUS_NO_DATA, MUS_NO_SCALER,
- MUS_MEMORY_ALLOCATION_FAILED, MUS_UNSTABLE_TWO_POLE_ERROR,
- MUS_CANT_OPEN_FILE, MUS_NO_SAMPLE_INPUT, MUS_NO_SAMPLE_OUTPUT,
- MUS_NO_SUCH_CHANNEL, MUS_NO_FILE_NAME_PROVIDED, MUS_NO_LOCATION, MUS_NO_CHANNEL,
- MUS_NO_SUCH_FFT_WINDOW, MUS_UNSUPPORTED_DATA_FORMAT, MUS_HEADER_READ_FAILED,
- MUS_UNSUPPORTED_HEADER_TYPE,
- MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, MUS_NOT_A_SOUND_FILE, MUS_FILE_CLOSED, MUS_WRITE_ERROR,
- MUS_HEADER_WRITE_FAILED, MUS_CANT_OPEN_TEMP_FILE, MUS_INTERRUPTED, MUS_BAD_ENVELOPE,
-
- MUS_AUDIO_CHANNELS_NOT_AVAILABLE, MUS_AUDIO_SRATE_NOT_AVAILABLE, MUS_AUDIO_FORMAT_NOT_AVAILABLE,
- MUS_AUDIO_NO_INPUT_AVAILABLE, MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
- MUS_AUDIO_WRITE_ERROR, MUS_AUDIO_SIZE_NOT_AVAILABLE, MUS_AUDIO_DEVICE_NOT_AVAILABLE,
- MUS_AUDIO_CANT_CLOSE, MUS_AUDIO_CANT_OPEN, MUS_AUDIO_READ_ERROR,
- MUS_AUDIO_CANT_WRITE, MUS_AUDIO_CANT_READ, MUS_AUDIO_NO_READ_PERMISSION,
-
- MUS_CANT_CLOSE_FILE, MUS_ARG_OUT_OF_RANGE, MUS_WRONG_TYPE_ARG,
- MUS_NO_CHANNELS, MUS_NO_HOP, MUS_NO_WIDTH, MUS_NO_FILE_NAME, MUS_NO_RAMP, MUS_NO_RUN,
- MUS_NO_INCREMENT, MUS_NO_OFFSET,
- MUS_NO_XCOEFF, MUS_NO_YCOEFF, MUS_NO_XCOEFFS, MUS_NO_YCOEFFS, MUS_NO_RESET, MUS_BAD_SIZE, MUS_CANT_CONVERT,
- MUS_READ_ERROR, MUS_NO_SAFETY,
- MUS_INITIAL_ERROR_TAG};
-
-/* keep this list in sync with mus_error_names in sound.c and snd-test.scm|rb */
-
-#define MUS_LOOP_INFO_SIZE 8
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* -------- sound.c -------- */
-
-#ifdef __GNUC__
- MUS_EXPORT int mus_error(int error, const char *format, ...) __attribute__ ((format (printf, 2, 3)));
- MUS_EXPORT void mus_print(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
- MUS_EXPORT char *mus_format(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
- MUS_EXPORT void mus_snprintf(char *buffer, int buffer_len, const char *format, ...) __attribute__ ((format (printf, 3, 4)));
-#else
- MUS_EXPORT int mus_error(int error, const char *format, ...);
- MUS_EXPORT void mus_print(const char *format, ...);
- MUS_EXPORT char *mus_format(const char *format, ...);
- MUS_EXPORT void mus_snprintf(char *buffer, int buffer_len, const char *format, ...);
-#endif
-
-typedef void mus_error_handler_t(int type, char *msg);
-MUS_EXPORT mus_error_handler_t *mus_error_set_handler(mus_error_handler_t *new_error_handler);
-MUS_EXPORT int mus_make_error(const char *error_name);
-MUS_EXPORT const char *mus_error_type_to_string(int err);
-
-typedef void mus_print_handler_t(char *msg);
-MUS_EXPORT mus_print_handler_t *mus_print_set_handler(mus_print_handler_t *new_print_handler);
-
-typedef mus_sample_t mus_clip_handler_t(mus_sample_t val);
-MUS_EXPORT mus_clip_handler_t *mus_clip_set_handler(mus_clip_handler_t *new_clip_handler);
-
-MUS_EXPORT mus_long_t mus_sound_samples(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_frames(const char *arg);
-MUS_EXPORT int mus_sound_datum_size(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_data_location(const char *arg);
-MUS_EXPORT int mus_sound_chans(const char *arg);
-MUS_EXPORT int mus_sound_srate(const char *arg);
-MUS_EXPORT int mus_sound_header_type(const char *arg);
-MUS_EXPORT int mus_sound_data_format(const char *arg);
-MUS_EXPORT int mus_sound_original_format(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_comment_start(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_comment_end(const char *arg);
-MUS_EXPORT mus_long_t mus_sound_length(const char *arg);
-MUS_EXPORT int mus_sound_fact_samples(const char *arg);
-MUS_EXPORT time_t mus_sound_write_date(const char *arg);
-MUS_EXPORT int mus_sound_type_specifier(const char *arg);
-MUS_EXPORT int mus_sound_block_align(const char *arg);
-MUS_EXPORT int mus_sound_bits_per_sample(const char *arg);
-
-MUS_EXPORT int mus_sound_set_chans(const char *arg, int val);
-MUS_EXPORT int mus_sound_set_srate(const char *arg, int val);
-MUS_EXPORT int mus_sound_set_header_type(const char *arg, int val);
-MUS_EXPORT int mus_sound_set_data_format(const char *arg, int val);
-MUS_EXPORT int mus_sound_set_data_location(const char *arg, mus_long_t val);
-MUS_EXPORT int mus_sound_set_samples(const char *arg, mus_long_t val);
-
-MUS_EXPORT const char *mus_header_type_name(int type);
-MUS_EXPORT const char *mus_data_format_name(int format);
-MUS_EXPORT const char *mus_header_type_to_string(int type);
-MUS_EXPORT const char *mus_data_format_to_string(int format);
-MUS_EXPORT const char *mus_data_format_short_name(int format);
-MUS_EXPORT char *mus_sound_comment(const char *name);
-MUS_EXPORT int mus_bytes_per_sample(int format);
-MUS_EXPORT float mus_sound_duration(const char *arg);
-MUS_EXPORT int mus_sound_initialize(void);
-MUS_EXPORT int mus_sample_bits(void);
-MUS_EXPORT int mus_sound_override_header(const char *arg, int srate, int chans, int format, int type, mus_long_t location, mus_long_t size);
-MUS_EXPORT int mus_sound_forget(const char *name);
-MUS_EXPORT int mus_sound_prune(void);
-MUS_EXPORT void mus_sound_report_cache(FILE *fp);
-MUS_EXPORT int *mus_sound_loop_info(const char *arg);
-MUS_EXPORT void mus_sound_set_loop_info(const char *arg, int *loop);
-MUS_EXPORT int mus_sound_mark_info(const char *arg, int **mark_ids, int **mark_positions);
-
-MUS_EXPORT int mus_sound_open_input(const char *arg);
-MUS_EXPORT int mus_sound_open_output(const char *arg, int srate, int chans, int data_format, int header_type, const char *comment);
-MUS_EXPORT int mus_sound_reopen_output(const char *arg, int chans, int format, int type, mus_long_t data_loc);
-MUS_EXPORT int mus_sound_close_input(int fd);
-MUS_EXPORT int mus_sound_close_output(int fd, mus_long_t bytes_of_data);
-#define mus_sound_seek_frame(Ifd, Frm) mus_file_seek_frame(Ifd, Frm)
-#define mus_sound_read(Fd, Beg, End, Chans, Bufs) mus_file_read(Fd, Beg, End, Chans, Bufs)
-#define mus_sound_write(Fd, Beg, End, Chans, Bufs) mus_file_write(Fd, Beg, End, Chans, Bufs)
-
-MUS_EXPORT mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_long_t *times);
-MUS_EXPORT int mus_sound_set_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_long_t *times);
-MUS_EXPORT bool mus_sound_maxamp_exists(const char *ifile);
-MUS_EXPORT mus_long_t mus_file_to_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_sample_t *array);
-MUS_EXPORT int mus_array_to_file(const char *filename, mus_sample_t *ddata, mus_long_t len, int srate, int channels);
-MUS_EXPORT const char *mus_array_to_file_with_error(const char *filename, mus_sample_t *ddata, mus_long_t len, int srate, int channels);
-MUS_EXPORT mus_long_t mus_file_to_float_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_float_t *array);
-MUS_EXPORT int mus_float_array_to_file(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels);
-
-
-
-/* -------- audio.c -------- */
-
-MUS_EXPORT char *mus_audio_describe(void);
-MUS_EXPORT int mus_audio_open_output(int dev, int srate, int chans, int format, int size);
-MUS_EXPORT int mus_audio_open_input(int dev, int srate, int chans, int format, int size);
-MUS_EXPORT int mus_audio_write(int line, char *buf, int bytes);
-MUS_EXPORT int mus_audio_close(int line);
-MUS_EXPORT int mus_audio_read(int line, char *buf, int bytes);
-
-MUS_EXPORT int mus_audio_write_buffers(int line, int frames, int chans, mus_sample_t **bufs, int output_format, bool clipped);
-MUS_EXPORT int mus_audio_read_buffers(int line, int frames, int chans, mus_sample_t **bufs, int input_format);
-MUS_EXPORT int mus_audio_initialize(void);
-MUS_EXPORT int mus_audio_reinitialize(void); /* 29-Aug-01 for CLM/Snd bugfix? */
-MUS_EXPORT int mus_audio_systems(void);
-MUS_EXPORT char *mus_audio_moniker(void);
-MUS_EXPORT int mus_audio_api(void);
-MUS_EXPORT int mus_audio_compatible_format(int dev);
-
-MUS_EXPORT void mus_oss_set_buffers(int num, int size);
-
-MUS_EXPORT char *mus_alsa_playback_device(void);
-MUS_EXPORT char *mus_alsa_set_playback_device(const char *name);
-MUS_EXPORT char *mus_alsa_capture_device(void);
-MUS_EXPORT char *mus_alsa_set_capture_device(const char *name);
-MUS_EXPORT char *mus_alsa_device(void);
-MUS_EXPORT char *mus_alsa_set_device(const char *name);
-MUS_EXPORT int mus_alsa_buffer_size(void);
-MUS_EXPORT int mus_alsa_set_buffer_size(int size);
-MUS_EXPORT int mus_alsa_buffers(void);
-MUS_EXPORT int mus_alsa_set_buffers(int num);
-MUS_EXPORT bool mus_alsa_squelch_warning(void);
-MUS_EXPORT bool mus_alsa_set_squelch_warning(bool val);
-
-MUS_EXPORT int mus_audio_device_channels(int dev);
-MUS_EXPORT int mus_audio_device_format(int dev);
-
-
-
-/* -------- io.c -------- */
-
-MUS_EXPORT int mus_file_open_descriptors(int tfd, const char *arg, int df, int ds, mus_long_t dl, int dc, int dt);
-MUS_EXPORT int mus_file_open_read(const char *arg);
-MUS_EXPORT bool mus_file_probe(const char *arg);
-MUS_EXPORT int mus_file_open_write(const char *arg);
-MUS_EXPORT int mus_file_create(const char *arg);
-MUS_EXPORT int mus_file_reopen_write(const char *arg);
-MUS_EXPORT int mus_file_close(int fd);
-MUS_EXPORT mus_long_t mus_file_seek_frame(int tfd, mus_long_t frame);
-MUS_EXPORT mus_long_t mus_file_read(int fd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs);
-MUS_EXPORT mus_long_t mus_file_read_chans(int fd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs, mus_sample_t **cm);
-MUS_EXPORT int mus_file_write(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs);
-MUS_EXPORT mus_long_t mus_file_read_any(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs, mus_sample_t **cm);
-MUS_EXPORT mus_long_t mus_file_read_file(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs);
-MUS_EXPORT mus_long_t mus_file_read_buffer(int charbuf_data_format, mus_long_t beg, int chans, mus_long_t nints, mus_sample_t **bufs, char *charbuf);
-MUS_EXPORT int mus_file_write_file(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs);
-MUS_EXPORT int mus_file_write_buffer(int charbuf_data_format, mus_long_t beg, mus_long_t end, int chans, mus_sample_t **bufs, char *charbuf, bool clipped);
-MUS_EXPORT char *mus_expand_filename(const char *name);
-MUS_EXPORT char *mus_getcwd(void);
-
-MUS_EXPORT bool mus_clipping(void);
-MUS_EXPORT bool mus_set_clipping(bool new_value);
-MUS_EXPORT bool mus_file_clipping(int tfd);
-MUS_EXPORT int mus_file_set_clipping(int tfd, bool clipped);
-
-MUS_EXPORT int mus_file_set_header_type(int tfd, int type);
-MUS_EXPORT int mus_file_header_type(int tfd);
-MUS_EXPORT char *mus_file_fd_name(int tfd);
-MUS_EXPORT int mus_file_set_chans(int tfd, int chans);
-
-MUS_EXPORT mus_float_t mus_file_prescaler(int tfd);
-MUS_EXPORT mus_float_t mus_file_set_prescaler(int tfd, mus_float_t val);
-MUS_EXPORT mus_float_t mus_prescaler(void);
-MUS_EXPORT mus_float_t mus_set_prescaler(mus_float_t new_value);
-
-MUS_EXPORT int mus_iclamp(int lo, int val, int hi);
-MUS_EXPORT mus_long_t mus_oclamp(mus_long_t lo, mus_long_t val, mus_long_t hi);
-MUS_EXPORT mus_float_t mus_fclamp(mus_float_t lo, mus_float_t val, mus_float_t hi);
-
-/* for CLM */
-/* these are needed to clear a saved lisp image to the just-initialized state */
-MUS_EXPORT void mus_reset_io_c(void);
-MUS_EXPORT void mus_reset_headers_c(void);
-MUS_EXPORT void mus_reset_audio_c(void);
-
-MUS_EXPORT int mus_samples_peak(unsigned char *data, int bytes, int chans, int format, mus_float_t *maxes);
-MUS_EXPORT int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, int format, mus_float_t *min_samp, mus_float_t *max_samp);
-
-MUS_EXPORT mus_long_t mus_max_malloc(void);
-MUS_EXPORT mus_long_t mus_set_max_malloc(mus_long_t new_max);
-MUS_EXPORT mus_long_t mus_max_table_size(void);
-MUS_EXPORT mus_long_t mus_set_max_table_size(mus_long_t new_max);
-
-MUS_EXPORT char *mus_strdup(const char *str);
-MUS_EXPORT int mus_strlen(const char *str);
-MUS_EXPORT bool mus_strcmp(const char *str1, const char *str2);
-MUS_EXPORT char *mus_strcat(char *errmsg, const char *str, int *err_size);
-
-
-
-/* -------- run.c -------- */
-
-#include "xen.h"
-#include "vct.h"
-
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_1_b(XEN code);
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_1_f(XEN code);
-MUS_EXPORT mus_float_t mus_run_evaluate_ptree_1f2f(struct ptree *pt, mus_float_t arg);
-MUS_EXPORT int mus_run_evaluate_ptree_1f2b(struct ptree *pt, mus_float_t arg);
-MUS_EXPORT void mus_run_free_ptree(struct ptree *pt);
-MUS_EXPORT void mus_init_run(void);
-MUS_EXPORT XEN mus_run_ptree_code(struct ptree *pt);
-MUS_EXPORT mus_float_t mus_run_evaluate_ptree_1f1v1b2f(struct ptree *pt, mus_float_t arg, vct *v, bool dir);
-MUS_EXPORT mus_float_t mus_run_evaluate_ptreec(struct ptree *pt, mus_float_t arg, XEN object, bool dir, int type);
-MUS_EXPORT int mus_run_xen_to_run_type(XEN val);
-
-#if HAVE_SCHEME
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_1_b_without_env(XEN code);
-MUS_EXPORT mus_float_t mus_run_evaluate_ptree_0f2f(struct ptree *pt);
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_0_f(XEN code);
-MUS_EXPORT struct ptree *mus_run_form_to_ptree_3_f(XEN code);
-#endif
-
-
-
-/* -------- headers.c -------- */
-
-MUS_EXPORT bool mus_data_format_p(int n);
-MUS_EXPORT bool mus_header_type_p(int n);
-
-MUS_EXPORT mus_long_t mus_header_samples(void);
-MUS_EXPORT mus_long_t mus_header_data_location(void);
-MUS_EXPORT int mus_header_chans(void);
-MUS_EXPORT int mus_header_srate(void);
-MUS_EXPORT int mus_header_type(void);
-MUS_EXPORT int mus_header_format(void);
-MUS_EXPORT mus_long_t mus_header_comment_start(void);
-MUS_EXPORT mus_long_t mus_header_comment_end(void);
-MUS_EXPORT int mus_header_type_specifier(void);
-MUS_EXPORT int mus_header_bits_per_sample(void);
-MUS_EXPORT int mus_header_fact_samples(void);
-MUS_EXPORT int mus_header_block_align(void);
-MUS_EXPORT int mus_header_loop_mode(int which);
-MUS_EXPORT int mus_header_loop_start(int which);
-MUS_EXPORT int mus_header_loop_end(int which);
-MUS_EXPORT int mus_header_mark_position(int id);
-MUS_EXPORT int mus_header_mark_info(int **marker_ids, int **marker_positions);
-MUS_EXPORT int mus_header_base_note(void);
-MUS_EXPORT int mus_header_base_detune(void);
-MUS_EXPORT void mus_header_set_raw_defaults(int sr, int chn, int frm);
-MUS_EXPORT void mus_header_raw_defaults(int *sr, int *chn, int *frm);
-MUS_EXPORT mus_long_t mus_header_true_length(void);
-MUS_EXPORT int mus_header_original_format(void);
-MUS_EXPORT mus_long_t mus_samples_to_bytes(int format, mus_long_t size);
-MUS_EXPORT mus_long_t mus_bytes_to_samples(int format, mus_long_t size);
-MUS_EXPORT int mus_header_read(const char *name);
-MUS_EXPORT int mus_header_write(const char *name, int type, int srate, int chans, mus_long_t loc, mus_long_t size_in_samples, int format, const char *comment, int len);
-MUS_EXPORT int mus_write_header(const char *name, int type, int in_srate, int in_chans, mus_long_t size_in_samples, int format, const char *comment);
-MUS_EXPORT mus_long_t mus_header_aux_comment_start(int n);
-MUS_EXPORT mus_long_t mus_header_aux_comment_end(int n);
-MUS_EXPORT int mus_header_initialize(void);
-MUS_EXPORT bool mus_header_writable(int type, int format);
-MUS_EXPORT void mus_header_set_aiff_loop_info(int *data);
-MUS_EXPORT int mus_header_sf2_entries(void);
-MUS_EXPORT char *mus_header_sf2_name(int n);
-MUS_EXPORT int mus_header_sf2_start(int n);
-MUS_EXPORT int mus_header_sf2_end(int n);
-MUS_EXPORT int mus_header_sf2_loop_start(int n);
-MUS_EXPORT int mus_header_sf2_loop_end(int n);
-MUS_EXPORT const char *mus_header_original_format_name(int format, int type);
-MUS_EXPORT bool mus_header_no_header(const char *name);
-
-MUS_EXPORT char *mus_header_riff_aux_comment(const char *name, mus_long_t *starts, mus_long_t *ends);
-MUS_EXPORT char *mus_header_aiff_aux_comment(const char *name, mus_long_t *starts, mus_long_t *ends);
-
-MUS_EXPORT int mus_header_change_chans(const char *filename, int type, int new_chans);
-MUS_EXPORT int mus_header_change_srate(const char *filename, int type, int new_srate);
-MUS_EXPORT int mus_header_change_type(const char *filename, int new_type, int new_format);
-MUS_EXPORT int mus_header_change_format(const char *filename, int type, int new_format);
-MUS_EXPORT int mus_header_change_location(const char *filename, int type, mus_long_t new_location);
-MUS_EXPORT int mus_header_change_comment(const char *filename, int type, const char *new_comment);
-MUS_EXPORT int mus_header_change_data_size(const char *filename, int type, mus_long_t bytes);
-
-typedef void mus_header_write_hook_t(const char *filename);
-MUS_EXPORT mus_header_write_hook_t *mus_header_write_set_hook(mus_header_write_hook_t *new_hook);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif
diff --git a/sndlib.html b/sndlib.html
index 823c64c..c35b2a1 100644
--- a/sndlib.html
+++ b/sndlib.html
@@ -1,49 +1,86 @@
-<html>
+<!DOCTYPE html>
+
+<html lang="en">
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>The Sound Library</title>
<style type="text/css">
-<!--
EM.red {color:red; font-style:normal}
EM.def {font-style:italic; font-weight: bold}
H1 {text-align: center}
UL {list-style-type: none}
+ DIV.center {text-align: center}
A {text-decoration:none}
A:hover {text-decoration:underline}
A.quiet {color:black; text-decoration:none}
A.quiet:hover {text-decoration:underline}
A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black}
--->
+
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.innerheader {margin-top: 60px;
+ margin-bottom: 30px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #eefdee; /* lightgreen */
+ padding-left: 30px;
+ width: 50%;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.header {margin-top: 50px;
+ margin-bottom: 10px;
+ font-size: 20px;
+ font-weight: bold;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ text-align: center;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.related {text-align:center;
+ border: 1px solid lightgray;
+ margin-bottom: 1.0cm;
+ margin-top: 1.0cm;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ background-color: #f0f0f0;
+ }
+ TD.green {background-color: lightgreen;
+ padding-left: 1.0cm;}
+ TD.beige {background-color: beige}
+ BODY.body {background-color: #ffffff; /* white */
+ margin-left: 0.5cm;
+ }
</style>
</head>
-<body bgcolor=white>
-
-<script language=JavaScript type="text/javascript" src="wz_tooltip.js"></script>
-<script language=JavaScript type="text/javascript" src="wz_data.js"></script>
-
-<h1>SndLib</h1>
-<center>Bill Schottstaedt (bil at ccrma.stanford.edu)</center>
-<br>
-
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html">index.html</a></small></td>
-</tr></table>
-</center>
-
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>Contents</h2></td></tr></table>
-</td></tr></table>
+<body class="body">
+
+<div class="topheader">SndLib</div>
+<div class="center">Bill Schottstaedt (bil at ccrma.stanford.edu)</div>
+
+
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="extsnd.html">extsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
+
+<div class="header">Contents</div>
<ul>
<li><a href="#introduction">Introduction</a>
@@ -55,31 +92,27 @@
<ul>
<li><a href="#sndinfo">SndInfo</a>
<li><a href="#sndplay">SndPlay</a>
-<li><a href="#audinfo">AudInfo</a>
<li><a href="#sndsine">SndSine</a>
<li><a href="#clmosc">clmosc</a>
<li><a href="#otherexamples">Other Examples</a>
</ul>
<li><a href="#sndlibxen">Extension Languages</a>
</ul>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="introduction">Introduction</a></h2></td></tr></table>
-</td></tr></table>
-
-<p>sndlib is a collection of sound file and audio hardware
-handlers written in C and running currently on SGI (either
-audio library), Sun, OSS or ALSA (Linux and others), Mac OSX, and Windows systems.
-It provides relatively straightforward access to many sound file headers and data
-types, and most of the features of the audio hardware. </p>
-
-<p>To build sndlib (sndlib.so if possible, and sndlib.a):</p>
+
+
+
+<div class="header" id="introduction">Introduction</div>
+
+<p>sndlib is a collection of sound file and sound synthesis
+function written in C and running currently in various Unices
+via OSS or ALSA, Mac OSX, and on old Windows systems.
+To build sndlib (sndlib.so if possible, and sndlib.a):
+</p>
<pre>
./configure
make
</pre>
-<p>To install it, 'make install' — I've tested this process in Linux,
-SGI, and Sun. It could conceivably work elsewhere.
+<p>To install it, 'make install' — I've tested this process in Linux.
</p>
<p>The following files make up sndlib:</p>
@@ -92,28 +125,25 @@ SGI, and Sun. It could conceivably work elsewhere.
<li>sndlib2xen.c and sndlib-strings.h (tie preceding into s7, Ruby, or Forth)
<li>clm.c and clm.h (Music V implementation)
<li>clm2xen.c, vct.c and vct.h (tie clm.c into s7, Ruby, or Forth)
-<li>xen.h, xen.c, xen.html (the embedded language support)
-<li>run.c (the run macro to speed up scheme computations)
+<li>xen.h, xen.c (the embedded language support)
</ul>
<p>
The naming scheme is more as less as follows:
the sndlib prefix is "mus" so
-function names start with "mus_" and constants start with "MUS_". Audio hardware constants start with "MUS_AUDIO_",
-functions involving sound files referenced through the file name
+function names start with "mus_" and constants start with "MUS_".
+Functions involving sound files referenced through the file name
start with "mus_sound_", functions involving files at a lower level
with "mus_file_", functions involving header access with "mus_header_",
functions involving audio hardware access with "mus_audio_",
and various
others just with "mus_" (number translations, etc). Conversions use
-the word "to" as in "mus_samples_to_bytes". Booleans use "_p" (an ancient
-Common Lisp convention meaning "predicate" I think).
+the word "to" as in "mus_samples_to_bytes".
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="headers">Headers</a></h2></td></tr></table>
-</td></tr></table>
+
+
+<div class="header" id="headers">Headers</div>
<p>Sound files have built-in descriptors known as headers.
The following functions return the information in the header.
@@ -122,7 +152,7 @@ name of the sound file.
</p>
<pre>
mus_long_t mus_sound_samples (const char *arg) /* samples of sound according to header */
- mus_long_t mus_sound_frames (const char *arg) /* samples per channel */
+ mus_long_t mus_sound_framples (const char *arg) /* samples per channel */
float mus_sound_duration (const char *arg) /* sound duration in seconds */
mus_long_t mus_sound_length (const char *arg) /* true file length in bytes */
@@ -134,9 +164,9 @@ name of the sound file.
int mus_sound_chans (const char *arg) /* number of channels (samples are interleaved) */
int mus_sound_srate (const char *arg) /* sampling rate */
- int mus_sound_header_type (const char *arg) /* header type (aiff etc) */
- int mus_sound_data_format (const char *arg) /* data format (alaw etc) */
- int mus_sound_original_format (const char *arg) /* unmodified data format specifier */
+ mus_header_t mus_sound_header_type (const char *arg) /* header type (aiff etc) */
+ mus_sample_t mus_sound_sample_type (const char *arg) /* sample type (alaw etc) */
+ int mus_sound_original_format (const char *arg) /* unmodified sample type specifier */
int mus_sound_type_specifier (const char *arg) /* original header type identifier */
char *mus_sound_comment (const char *arg) /* comment if any */
@@ -145,18 +175,17 @@ name of the sound file.
int *mus_sound_loop_info(const char *arg) /* 8 loop vals (mode,start,end) then base-detune and base-note (empty list if no loop info found) */
int mus_sound_write_date (const char *arg) /* bare (uninterpreted) file write date */
-
int mus_sound_initialize(void) /* initialize everything */
</pre>
<p>The following can be used to provide user-understandable descriptions
-of the header type and the data format:</p>
+of the header type and the sample type:</p>
<pre>
- char *mus_header_type_name(int type) /* "AIFF" etc */
- char *mus_data_format_name(int format) /* "16-bit big endian linear" etc */
- char *mus_header_type_to_string(int type)
- char *mus_data_format_to_string(int format)
- const char *mus_data_format_short_name(int format)
+ char *mus_header_type_name(mus_header_t type) /* "AIFF" etc */
+ char *mus_sample_type_name(mus_sample_t samp_type) /* "16-bit big endian linear" etc */
+ char *mus_header_type_to_string(mus_header_t type)
+ char *mus_sample_type_to_string(mus_sample_t samp_type)
+ const char *mus_sample_type_short_name(mus_sample_t samp_type)
</pre>
<p>In all cases if an error occurs, -1 (MUS_ERROR) is returned, and some sort of error message
@@ -179,131 +208,117 @@ components that have been found can be read via functions such as
<b>mus_header_srate</b>.
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="data">Data</a></h2></td></tr></table>
-</td></tr></table>
+
+
+<div class="header" id="data">Data</div>
<p>The following functions provide access to
sound file data:</p>
<pre>
int mus_sound_open_input (const char *arg)
- int mus_sound_open_output (const char *arg, int srate, int chans, int data_format, int header_type, const char *comment)
- int mus_sound_reopen_output (const char *arg, int type, int format, mus_long_t data_loc)
+ int mus_sound_open_output (const char *arg, int srate, int chans, mus_sample_t sample_type, mus_header_t header_type, const char *comment)
+ int mus_sound_reopen_output (const char *arg, mus_header_t type, mus_sample_t format, mus_long_t data_loc)
int mus_sound_close_input (int fd)
int mus_sound_close_output (int fd, mus_long_t bytes_of_data)
- int mus_sound_read (int fd, int beg, int end, int chans, mus_sample_t **bufs)
- int mus_sound_write (int fd, int beg, int end, int chans, mus_sample_t **bufs)
- mus_long_t mus_sound_seek_frame (int fd, mus_long_t frame)
+ int mus_sound_read (int fd, int beg, int end, int chans, mus_float_t **bufs)
+ int mus_sound_write (int fd, int beg, int end, int chans, mus_float_t **bufs)
+ mus_long_t mus_sound_seek_frample (int fd, mus_long_t frample)
</pre>
-<p>mus_sample_t defaults to float, but can also be int. It is set when
+<p>mus_float_t defaults to double. It is set when
sndlib is built, and refers to Sndlib's internal representation of sample values.
-There are corresponding macros to convert from the
-sample type to C types (MUS_SAMPLE_TO_FLOAT, etc), and the reverse
-(MUS_FLOAT_TO_SAMPLE, etc).
</p>
-<p><i>mus_sound_open_input</i> opens <i>arg</i> for reading. Most standard
+<p>mus_sound_open_input opens arg for reading. Most standard
uncompressed formats are readable. This function returns the associated
file number, or -1 upon failure. </p>
-<p><i>mus_sound_close_input</i> closes an open sound file. Its argument is
+<p>mus_sound_close_input closes an open sound file. Its argument is
the integer returned by mus_sound_open_input.</p>
-<p><i>mus_sound_open_output</i> opens (creates) the file <i>arg</i>, setting its sampling rate
-to be <i>srate</i>, number of channels to <i>chans</i>, data format
-to <i>data_format</i> (see sndlib.h for these types: MUS_BSHORT,
+<p>mus_sound_open_output opens (creates) the file arg, setting its sampling rate
+to be srate, number of channels to chans, sample type
+to sample_type (see sndlib.h for these types: MUS_BSHORT,
means 16-bit 2's complement big endian fractions),
-header type to <i>header_type</i> (AIFF for example; the available
+header type to header_type (AIFF for example; the available
writable header types are MUS_AIFC (or AIFF), MUS_RIFF ('wave'), MUS_RF64,
MUS_NEXT, MUS_NIST, MUS_CAFF, and MUS_IRCAM), and comment (if any) to
-<i>comment</i>. The header is not considered complete without
+comment. The header is not considered complete without
an indication of the data size, but since this is rarely known
in advance, it is supplied when the sound file is closed. mus_sound_open_output
function returns the associated file number.</p>
-<p><i>mus_sound_close_output</i> first updates the file's header to
-reflect the final data size <i>bytes_of_data</i>, then closes
-the file. The argument <i>fd</i> is the integer returned by
+<p>mus_sound_close_output first updates the file's header to
+reflect the final data size bytes_of_data, then closes
+the file. The argument fd is the integer returned by
mus_sound_open_output.</p>
-<p><i>mus_sound_read</i> reads data from the file indicated by <i>fd</i>,
-placing data in the array <i>obufs</i> as mus_sample_t values (floats normally).
-<i>chans</i> determines how many arrays of
+<p>mus_sound_read reads data from the file indicated by fd,
+placing data in the array obufs as mus_float_t values (floats normally).
+chans determines how many arrays of
samples are in obufs, which is filled by mus_sound_read from its
-index <i>beg</i> to <i>end</i> with zero padding if necessary.
+index beg to end with zero padding if necessary.
</p>
-<p><i>mus_sound_write</i> writes samples to the file indicated by <i>fd</i>,
-starting for each of <i>chans</i> channels in <i>obufs</i> at
-<i>beg</i> and ending at <i>end</i>.</p>
+<p>mus_sound_write writes samples to the file indicated by fd,
+starting for each of chans channels in obufs at
+beg and ending at end.</p>
-<p><i>mus_sound_seek_frame</i> moves the read or write position for the
-file indicated by <i>fd</i> to the desired frame.
+<p>mus_sound_seek_frample moves the read or write position for the
+file indicated by fd to the desired frample.
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="hardware">Hardware</a></h2></td></tr></table>
-</td></tr></table>
+
+<div class="header" id="hardware">Hardware</div>
<p>The following functions provide access to audio harware. If an
error occurs, they return -1 (MUS_ERROR). </p>
<pre>
int mus_audio_initialize(void)
- char *mus_audio_describe(void)
- int mus_audio_open_output(int dev, int srate, int chans, int format, int size)
- int mus_audio_open_input(int dev, int srate, int chans, int format, int size)
+ int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t format, int size)
+ int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t format, int size)
int mus_audio_write(int line, char *buf, int bytes)
int mus_audio_close(int line)
int mus_audio_read(int line, char *buf, int bytes)
</pre>
-<p><i>mus_audio_initialize</i> takes care of any necessary initialization.</p>
+<p>mus_audio_initialize takes care of any necessary initialization.</p>
-<p>
-<i>mus_audio_describe</i>
-returns a description of the audio hardware state as a string.</p>
-
-<p><i>mus_audio_open_input</i> opens an audio port to read sound data (i.e. a microphone, line in, etc).
-The input device is <i>dev</i> (see sndlib.h for details; when in doubt, use MUS_AUDIO_DEFAULT).
-The input sampling rate is <i>srate</i> or as close as we
-can get to it. The number of input channels (if available) is <i>chans</i>.
-The input data format is <i>format</i> (when in doubt, use the macro MUS_AUDIO_COMPATIBLE_FORMAT).
-And the input buffer size (if settable at all) is <i>size</i> (bytes). This
+<p>mus_audio_open_input opens an audio port to read sound data (i.e. a microphone, line in, etc).
+The input device is dev (see sndlib.h for details; when in doubt, use MUS_AUDIO_DEFAULT).
+The input sampling rate is srate or as close as we
+can get to it. The number of input channels (if available) is chans.
+The input sample type is format (when in doubt, use the macro MUS_AUDIO_COMPATIBLE_FORMAT).
+And the input buffer size (if settable at all) is size (bytes). This
function returns an integer to distinguish its port from others that might be
in use.
</p>
-<p><i>mus_audio_open_output</i> opens an audio port to write data (i.e. speakers, line out, etc).
-The output device is <i>dev</i> (see sndlib.h). Its sampling rate is <i>srate</i>, number
-of channels <i>chans</i>, data format <i>format</i>, and buffer size <i>size</i>. This
+<p>mus_audio_open_output opens an audio port to write data (i.e. speakers, line out, etc).
+The output device is dev (see sndlib.h). Its sampling rate is srate, number
+of channels chans, sample type format, and buffer size size. This
function returns the associated line number of the output port.</p>
-<p><i>mus_audio_close</i> closes the port (input or output) associated with <i>line</i>.</p>
+<p>mus_audio_close closes the port (input or output) associated with line.</p>
-<p><i>mus_audio_read</i> reads sound data from <i>line</i>. The incoming <i>bytes</i> bytes of data are placed
-in <i>buf</i>. If no error was returned from mus_audio_open_input, the data is in the format requested
+<p>mus_audio_read reads sound data from line. The incoming 'bytes' bytes of data are placed
+in buf. If no error was returned from mus_audio_open_input, the data is in the format requested
by that function with channels interleaved.</p>
-<p><i>mus_audio_write</i> writes <i>bytes</i> bytes of data in <i>buf</i> to the output
-port associated with <i>line</i>. This data is assumed to be in the format
+<p>mus_audio_write writes 'bytes' bytes of data in buf to the output
+port associated with line. This data is assumed to be in the format
requested by mus_audio_open_output with channels interleaved.</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="music5">MusicV</a></h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="music5">Music V</div>
<p>clm.c and friends implement all the generators found in CLM, a
music V implementation, and clm2xen.c ties these into the languages supported by the
xen package (currently s7, Ruby, and Forth). The
primary clm documentation (which describes both the Scheme and Common Lisp implementations)
-is clm.html found in clm-4.tar.gz or sndclm.html in snd-12.tar.gz alongside sndlib at ccrma-ftp.
+is clm.html found in clm-5.tar.gz or sndclm.html in snd-16.tar.gz alongside sndlib at ccrma-ftp.
The simplest way to try these out is to load them into Snd; see extsnd.html,
-<a href="sndscm.html#exampdoc">examp.scm</a>, and <a href="sndscm.html#sndtestdoc">snd-test.scm</a> in snd-12.tar.gz for more details.
+<a href="sndscm.html#exampdoc">examp.scm</a>, and <a href="sndscm.html#sndtestdoc">snd-test.scm</a> in snd-16.tar.gz for more details.
The following briefly describes the C calls (see clm.h).
</p>
@@ -314,14 +329,7 @@ the generator, and the last examines some pointer to determine if it is
that kind of generator. In addition, there are a variety of generic
functions that generators respond to: mus_free, for example, frees a
generator, and mus_frequency returns its current frequency, if relevant.
-All generators are pointers to mus_any structs. Finally, CLM has two
-special data types: frame and mixer. A frame is an array that represents
-a multichannel sample (that is, in a stereo file, at time 0.0, there
-are two samples, one for each channel). A mixer is a array of arrays
-that represents a set of input and output scalers, as if it were the
-current state of a mixing console's volume controls. A frame (a multichannel
-input) can be mixed into a new frame (a multichannel output) by passing
-it through a mixer (a matrix, the operation being a matrix multiply).
+All generators are pointers to mus_any structs.
</p>
<ul>
@@ -360,8 +368,8 @@ it through a mixer (a matrix, the operation being a matrix multiply).
<li>wave_train: sequence of possibly overlapping waves
<li>env: envelopes
<li>polyshape, polywave: waveshaping
-<li>readin, file_to_sample, file_to_frame, in_any: file sample input
-<li>locsig, sample_to_file, frame_to_file, out_any: file sample output
+<li>readin, file_to_sample, file_to_frample, in_any: file sample input
+<li>locsig, sample_to_file, frample_to_file, out_any: file sample output
<li>src: sampling rate conversion
<li>granulate: granular synthesis
<li>convolve: convolution
@@ -420,13 +428,13 @@ it through a mixer (a matrix, the operation being a matrix multiply).
<p>Errors are reported
through mus_error which can be redirected or muffled. See clm2xen.c for an example.
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="examples">Examples</a></h2></td></tr></table>
-</td></tr></table>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndinfo">SndInfo</a></h3></td></tr></table>
+
+<div class="header" id="examples">Examples</div>
+
+<div class="innerheader" id="sndinfo">sndinfo</div>
+
<p>This program prints out a description of a sound file (sndinfo.c).</p>
<pre>
@@ -452,9 +460,9 @@ int main(int argc, char *argv[])
strftime(timestr, 64, "%a %d-%b-%y %H:%M %Z", localtime(&date));
fprintf(stdout, "%s:\n srate: %d\n chans: %d\n length: %f\n",
argv[1], srate, chans, length);
- fprintf(stdout, " type: %s\n format: %s\n written: %s\n comment: %s\n",
+ fprintf(stdout, " header: %s\n sample type: %s\n written: %s\n comment: %s\n",
mus_header_type_name(mus_sound_header_type(argv[1])),
- mus_data_format_name(mus_sound_data_format(argv[1])),
+ mus_sample_type_name(mus_sound_sample_type(argv[1])),
timestr, comment);
}
else
@@ -462,8 +470,9 @@ int main(int argc, char *argv[])
return(0);
}
</pre>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndplay">SndPlay</a></h3></td></tr></table>
+
+
+<div class="innerheader" id="sndplay">sndplay</div>
<p>This code plays a sound file (sndplay.c):</p>
@@ -472,8 +481,8 @@ int main(int argc, char *argv[])
int main(int argc, char *argv[])
{
int fd, afd, i, j, n, k, chans, srate, outbytes;
- mus_long_t frames;
- mus_sample_t **bufs;
+ mus_long_t framples;
+ mus_float_t **bufs;
short *obuf;
mus_sound_initialize();
fd = mus_sound_open_input(argv[1]);
@@ -481,16 +490,16 @@ int main(int argc, char *argv[])
{
chans = mus_sound_chans(argv[1]);
srate = mus_sound_srate(argv[1]);
- frames = mus_sound_frames(argv[1]);
+ framples = mus_sound_framples(argv[1]);
outbytes = BUFFER_SIZE * chans * 2;
- bufs = (mus_sample_t **)calloc(chans, sizeof(mus_sample_t *));
+ bufs = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
for (i=0;i<chans;i++)
- bufs[i] = (mus_sample_t *)calloc(BUFFER_SIZE, sizeof(mus_sample_t));
+ bufs[i] = (mus_float_t *)calloc(BUFFER_SIZE, sizeof(mus_float_t));
obuf = (short *)calloc(BUFFER_SIZE * chans, sizeof(short));
afd = mus_audio_open_output(MUS_AUDIO_DEFAULT, srate, chans, MUS_AUDIO_COMPATIBLE_FORMAT, outbytes);
if (afd != -1)
{
- for (i = 0; i < frames; i += BUFFER_SIZE)
+ for (i = 0; i < framples; i += BUFFER_SIZE)
{
mus_sound_read(fd, 0, BUFFER_SIZE - 1, chans, bufs);
for (k = 0, j = 0; k < BUFFER_SIZE; k++, j += chans)
@@ -509,23 +518,10 @@ int main(int argc, char *argv[])
}
</pre>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="audinfo">AudInfo</a></h3></td></tr></table>
-<p>This program describes the current audio harware state (audinfo.c):</p>
-<pre>
-int main(int argc, char *argv[])
-{
- mus_sound_initialize();
- fprintf(stdout, mus_audio_describe());
- return(0);
-}
-</pre>
-
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="sndsine">SndSine</a></h3></td></tr></table>
+<div class="innerheader" id="sndsine">sndsine</div>
<p>This program writes a one channel NeXT/Sun sound file
containing a sine wave at 440 Hz.</p>
@@ -533,19 +529,19 @@ containing a sine wave at 440 Hz.</p>
<pre>
int main(int argc, char *argv[])
{
- int fd, i, k, frames;
+ int fd, i, k, framples;
float phase, incr;
- mus_sample_t *obuf[1];
+ mus_float_t *obuf[1];
mus_sound_initialize();
fd = mus_sound_open_output(argv[1], 22050, 1, MUS_BSHORT, MUS_NEXT, "created by sndsine");
if (fd != -1)
{
- frames = 22050;
+ framples = 22050;
phase = 0.0;
incr = 2 * M_PI * 440.0 / 22050.0;
- obuf[0] = (mus_sample_t *)calloc(BUFFER_SIZE, sizeof(mus_sample_t));
+ obuf[0] = (mus_float_t *)calloc(BUFFER_SIZE, sizeof(mus_float_t));
k = 0;
- for (i = 0; i < frames; i++)
+ for (i = 0; i < framples; i++)
{
obuf[0][k] = MUS_FLOAT_TO_SAMPLE(0.1 * sin(phase)); /* amp = .1 */
phase += incr;
@@ -564,8 +560,9 @@ int main(int argc, char *argv[])
}
</pre>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="clmosc">clmosc</a></h3></td></tr></table>
+
+
+<div class="innerheader" id="clmosc">clmosc</div>
<p>This is program uses the clm.c oscillator and output functions to write the same sine wave
as we wrote in SndSine.</p>
@@ -610,7 +607,7 @@ void fm_violin(float start, float dur, float frequency, float amplitude, float f
int beg = 0, end, easy_case = 0, npartials, i;
float *coeffs, *partials;
float frq_scl, maxdev, logfrq, sqrtfrq, index1, index2, index3, norm;
- float vib = 0.0, modulation = 0.0, fuzz = 0.0, indfuzz = 1.0, ampfuzz = 1.0;
+ float vib = 0.0, modulation = 0.0, fuzz = 0.0, indfuzz = 1.0;
mus_any *carrier, *fmosc1, *fmosc2, *fmosc3, *ampf;
mus_any *indf1, *indf2, *indf3, *fmnoi = NULL, *pervib, *ranvib, *frqf = NULL, *loc;
beg = start * mus_srate();
@@ -636,7 +633,7 @@ void fm_violin(float start, float dur, float frequency, float amplitude, float f
if ((floor(fm2_rat)) > npartials) npartials = floor(fm2_rat);
if ((floor(fm3_rat)) > npartials) npartials = floor(fm3_rat);
npartials++;
- partials = (float *)CALLOC(npartials, sizeof(float));
+ partials = (float *)calloc(npartials, sizeof(float));
partials[(int)(fm1_rat)] = index1;
partials[(int)(fm2_rat)] = index2;
partials[(int)(fm3_rat)] = index3;
@@ -695,13 +692,13 @@ void fm_violin(float start, float dur, float frequency, float amplitude, float f
mus_free(fmosc3);
}
else
- FREE(partials);
+ free(partials);
mus_free(loc);
}
int main(int argc, char *argv[])
{
- mus_any *osc = NULL, *op = NULL;
+ mus_any *op = NULL;
mus_sound_initialize();
op = mus_make_sample_to_file("test.snd", 1, MUS_BSHORT, MUS_NEXT);
if (op)
@@ -735,41 +732,40 @@ static SCM call_phase-vocoder(void)
</pre>
<!--
-TODO: fill out sndlib.html
void src_file(const char *file, double ratio)
{
mus_any **rds, **srcs;
char *temp_out;
const char *comment;
- int k, chan, chans, width = 32, out_fd, data_format, header_type, buffer_size;
+ int k, chan, chans, width = 32, out_fd, sample_type, header_type, buffer_size;
mus_long_t samp, old_samps, new_samps;
mus_float_t old_srate, new_srate;
- mus_sample_t **obufs;
+ mus_float_t **obufs;
old_srate = mus_srate();
new_srate = mus_sound_srate(file); /* need have no connection with previous CLM srate setting */
mus_set_srate(new_srate);
chans = mus_sound_chans(file);
- data_format = mus_sound_data_format(file);
+ sample_type = mus_sound_sample_type(file);
header_type = mus_sound_header_type(file);
comment = mus_sound_comment(file);
buffer_size = mus_file_buffer_size();
- old_samps = mus_sound_frames(file);
+ old_samps = mus_sound_framples(file);
new_samps = old_samps / ratio; /* old-srate/new-srate in-coming */
temp_out = snd_tempnam();
- out_fd = mus_sound_open_output(temp_out, new_srate, chans, data_format, header_type, comment);
+ out_fd = mus_sound_open_output(temp_out, new_srate, chans, sample_type, header_type, comment);
srcs = (mus_any **)malloc(chans * sizeof(mus_any *));
rds = (mus_any **)malloc(chans * sizeof(mus_any *));
- obufs = (mus_sample_t **)malloc(chans * sizeof(mus_sample_t));
+ obufs = (mus_float_t **)malloc(chans * sizeof(mus_float_t));
for (chan = 0; chan < chans; chan++)
{
rds[chan] = mus_make_readin(file, chan, 0, 1);
srcs[chan] = mus_make_src(NULL, ratio, width, (void *)rds[chan]);
- obufs[chan] = (mus_sample_t *)malloc(buffer_size * sizeof(mus_sample_t));
+ obufs[chan] = (mus_float_t *)malloc(buffer_size * sizeof(mus_float_t));
}
for (k = 0, samp = 0; samp < new_samps; samp++)
@@ -786,7 +782,7 @@ void src_file(const char *file, double ratio)
if (k > 0)
mus_sound_write(out_fd, 0, k - 1, chans, obufs);
- mus_sound_close_output(out_fd, new_samps * chans * mus_bytes_per_sample(data_format));
+ mus_sound_close_output(out_fd, new_samps * chans * mus_bytes_per_sample(sample_type));
mus_sound_forget(file);
for (chan = 0; chan < chans; chan++)
@@ -811,18 +807,18 @@ has written a package using these functions, and several CLM instruments:
see the sndins directory, and in particular the README file, for details.
</p>
-<br>
-<table width="80%" border=0><tr><td bgcolor="lightsteelblue" valign="middle"><h3><A NAME="otherexamples">Other Examples</a></h3></td></tr></table>
+
+
+
+<div class="innerheader" id="otherexamples">Other examples</div>
<p>The primary impetus for the sound library was the development
of Snd and CLM, both of which are freely available.
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2><A NAME="sndlibxen"></a>Extension Languages</h2></td></tr></table>
-</td></tr></table>
+
+<div class="header" id="sndlibxen">Extension Languages</div>
<p>Much of sndlib is accessible at run time in any program that has one of
the languages supported by the xen package (s7, Ruby, Forth);
@@ -830,12 +826,15 @@ the modules sndlib2xen and clm2xen tie most of the library into that language
making it possible to call the library functions from its interpreter. The documentation
is scattered around, unfortunately: the clm side is in sndclm.html and extsnd.html with many
examples in Snd's <a href="sndscm.html#exampdoc">examp.scm</a>. Most of these are obvious translations of the
-constants and functions described above into Scheme. To initialize sndlib, call Init_sndlib.
+constants and functions described above into Scheme. To initialize sndlib, call Init_sndlib,
+or, at run time, use s7's loader and s7_init_sndlib:
</p>
<pre>
-(let ((sndlib (dynamic-link "libsndlib.so")))
- (dynamic-call (dynamic-func "Init_sndlib" sndlib) #f))
+(let ((sndlib (load "libsndlib.so"
+ (inlet (curlet)
+ (cons 'init_func 's7_init_sndlib)))))
+ ....)
</pre>
<p>Init_sndlib ties most of the functions mentioned above into the extension language (s7, Forth, or Ruby).
@@ -849,14 +848,14 @@ constants and functions described above into Scheme. To initialize sndlib, call
mus-ubshort mus-ulshort
mus-sound-samples (filename) samples of sound according to header (can be incorrect)
- mus-sound-frames (filename) frames of sound according to header (can be incorrect)
+ mus-sound-framples (filename) framples of sound according to header (can be incorrect)
mus-sound-duration (filename) duration of sound in seconds
mus-sound-datum-size (filename) bytes per sample
mus-sound-data-location (filename) location of first sample (bytes)
mus-sound-chans (filename) number of channels (samples are interleaved)
mus-sound-srate (filename) sampling rate
- mus-sound-header-type (filename) header type (e.g. <i>mus-aiff</i>)
- mus-sound-data-format (filename) data format (e.g. <i>mus-bshort</i>)
+ mus-sound-header-type (filename) header type (e.g. mus-aiff)
+ mus-sound-sample-type (filename) sample type (e.g. mus-bshort)
mus-sound-length (filename) true file length (bytes)
mus-sound-type-specifier (filename) original header type identifier
mus-sound-maxamp(filename) returns a list of max amps and locations thereof
@@ -864,86 +863,105 @@ constants and functions described above into Scheme. To initialize sndlib, call
the so-called id's), then base-note and base-detune
mus-header-type-name (type) e.g. "AIFF"
- mus-data-format-name (format) e.g. "16-bit big endian linear"
+ mus-sample-type-name (format) e.g. "16-bit big endian linear"
mus-sound-comment (filename) header comment, if any
mus-sound-write-date (filename) sound write date
- data-format-bytes-per-sample (format) bytes per sample
-
- mus-audio-describe () return audio hardware state as a string
- mus-audio-reinitialize force re-check of available audio devices
+ sample-type-bytes-per-sample (format) bytes per sample
mus-sound-open-input (filename) open filename (a sound file) returning an integer ("fd" below)
- mus-sound-open-output (filename srate chans data-format header-type comment)
+ mus-sound-open-output (filename srate chans sample-type header-type comment)
create a new sound file with the indicated attributes, return "fd"
- mus-sound-reopen-output (filename chans data-format header-type data-location)
+ mus-sound-reopen-output (filename chans sample-type header-type data-location)
reopen (without disturbing) filename, ready to be written
mus-sound-close-input (fd) close sound file
mus-sound-close-output (fd bytes) close sound file and update its length indication, if any
- mus-sound-read (fd beg end chans sdata) read data from sound file <i>fd</i> loading the data array from beg to end
- <i>sdata</i> is a sound-data object that should be able to accommodate the read
- mus-sound-write (fd beg end chans sdata) write data to sound file <i>fd</i>
- mus-sound-seek-frame (fd frame) move to <i>frame</i> in sound file <i>fd</i>
+ mus-sound-read (fd beg end chans sdata) read data from sound file fd loading the data array from beg to end
+ sdata is a float-vector that should be able to accommodate the read
+ mus-sound-write (fd beg end chans sdata) write data to sound file fd
+ mus-sound-seek-frample (fd frample) move to frample in sound file fd
mus-file-clipping (fd) whether output is clipped in file 'fd'
mus-clipping () global clipping choice
- mus-audio-open-output (device srate chans format bufsize)
- open audio port <i>device</i> ready for output with the indicated attributes
- mus-audio-open-input (device srate chans format bufsize)
- open audio port <i>device</i> ready for input with the indicated attributes
- mus-audio-write (line sdata frames) write <i>frames</i> of data from sound-data object <i>sdata</i> to port <i>line</i>
- mus-audio-read (line sdata frames) read <i>frames</i> of data into sound-data object <i>sdata</i> from port <i>line</i>
- mus-audio-close (line) close audio port <i>line</i>
-
mus-oss-set-buffers (num size) in Linux (OSS) sets the number and size of the OSS "fragments"
- make-sound-data (chans, frames) return a sound-data object with <i>chans</i> arrays, each of length <i>frames</i>
- sound-data-ref (obj chan frame) return (as a float) the sample in channel <i>chan</i> at location <i>frame</i>
- sound-data-set! (obj chan frame val) set <i>obj</i>'s sample at <i>frame</i> in <i>chan</i> to (the float) <i>val</i>
- sound-data? (obj) #t if <i>obj</i> is of type sound-data
- sound-data-length (obj) length of each channel of data in <i>obj</i>
- sound-data-chans (obj) number of channels of data in <i>obj</i>
- sound-data->vct (sdobj chan vobj) place sound-data channel data in vct
- vct->sound-data (vobj sdobj chan) place vct data in sound-data
-
;;; this function prints header information
(define info
(lambda (file)
(string-append
file
- ": chans: " (number->string (<a class=quiet href="extsnd.html#mussoundchans" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundchans_tip)">mus-sound-chans</a> file))
- ", srate: " (number->string (<a class=quiet href="extsnd.html#mussoundsrate" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundsrate_tip)">mus-sound-srate</a> file))
- ", " (<a class=quiet href="extsnd.html#musheadertypename" onmouseout="UnTip()" onmouseover="Tip(extsnd_musheadertypename_tip)">mus-header-type-name</a> (<a class=quiet href="extsnd.html#mussoundheadertype" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundheadertype_tip)">mus-sound-header-type</a> file))
- ", " (<a class=quiet href="extsnd.html#musdataformatname" onmouseout="UnTip()" onmouseover="Tip(extsnd_musdataformatname_tip)">mus-data-format-name</a> (<a class=quiet href="extsnd.html#mussounddataformat" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussounddataformat_tip)">mus-sound-data-format</a> file))
+ ": chans: " (number->string (mus-sound-chans file))
+ ", srate: " (number->string (mus-sound-srate file))
+ ", " (mus-header-type-name (mus-sound-header-type file))
+ ", " (mus-sample-type-name (mus-sound-sample-type file))
", len: " (number->string
- (/ (<a class=quiet href="extsnd.html#mussoundsamples" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundsamples_tip)">mus-sound-samples</a> file)
- (* (<a class=quiet href="extsnd.html#mussoundchans" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundchans_tip)">mus-sound-chans</a> file) (<a class=quiet href="extsnd.html#mussoundsrate" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundsrate_tip)">mus-sound-srate</a> file)))))))
+ (/ (mus-sound-samples file)
+ (* (mus-sound-chans file) (mus-sound-srate file)))))))
+</pre>
-;;; this function reads the first 32 samples of a file, returning the 30th in channel 0
-(define read-sample-30
- (lambda (file)
- (let* ((fd (<a class=quiet href="extsnd.html#mussoundopeninput" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundopeninput_tip)">mus-sound-open-input</a> file))
- (<a class=quiet href="extsnd.html#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">chans</a> (<a class=quiet href="extsnd.html#mussoundchans" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundchans_tip)">mus-sound-chans</a> file))
- (data (<a class=quiet href="extsnd.html#makesounddata" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesounddata_tip)">make-sound-data</a> chans 32)))
- (<a class=quiet href="extsnd.html#mussoundread" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundread_tip)">mus-sound-read</a> fd 0 31 chans data)
- ;; we could use sound-data->vct here to return all the samples
- (let ((val (<a class=quiet href="extsnd.html#sounddataref" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounddataref_tip)">sound-data-ref</a> data 0 29)))
- (<a class=quiet href="extsnd.html#mussoundcloseinput" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundcloseinput_tip)">mus-sound-close-input</a> fd)
- val))))
+
+<div class="innerheader">s7 repl and sndlib</div>
+
+<pre>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <unistd.h>
+
+#include "mus-config.h"
+#include "s7.h"
+#include "xen.h"
+#include "clm.h"
+#include "clm2xen.h"
+
+static void mus_error_to_s7(int type, char *msg)
+{
+ s7_error(s7, /* s7 is declared in xen.h, defined in xen.c */
+ s7_make_symbol(s7, "mus-error"),
+ s7_cons(s7, s7_make_string(s7, msg), s7_nil(s7)));
+}
+
+int main(int argc, char **argv)
+{
+ s7 = s7_init();
+
+ s7_xen_initialize(s7);
+ Init_sndlib();
+ mus_error_set_handler(mus_error_to_s7); /* catch low-level errors and pass them to s7-error */
+
+ if (argc == 2)
+ {
+ fprintf(stderr, "load %s\n", argv[1]);
+ s7_load(s7, argv[1]);
+ }
+ else
+ {
+ s7_load(s7, "repl.scm");
+ s7_eval_c_string(s7, "((*repl* 'run))");
+ }
+
+ return(0);
+}
+
+/* gcc -o sl sl.c /home/bil/test/sndlib/libsndlib.a -Wl,-export-dynamic -lasound -lm -I. -ldl -lgsl -lgslcblas -lfftw3
+ *
+ * (load "sndlib-ws.scm")
+ * (load "v.scm")
+ * (set! *clm-player* (lambda (file) (system (format #f "sndplay ~A" file))))
+ * (with-sound (:play #t) (fm-violin 0 1 330 .1))
+ */
</pre>
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="sndscm.html" onmouseout="UnTip()" onmouseover="Tip(sndscm_html_tip)">sndscm.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html">index.html</a></small></td>
-</tr></table>
-</center>
-
-</body></html>
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="extsnd.html">extsnd.html </a>
+<a href="sndscm.html">sndscm.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
+
+</body>
+</html>
diff --git a/sndlib2xen.c b/sndlib2xen.c
index 886cff9..1684b01 100644
--- a/sndlib2xen.c
+++ b/sndlib2xen.c
@@ -1,6 +1,6 @@
/* Tie sndlib into Xen */
-#include <mus-config.h>
+#include "mus-config.h"
#if USE_SND
#include "snd.h"
@@ -23,29 +23,36 @@
#include <string.h>
#include <errno.h>
+
+#ifdef _MSC_VER
+ #pragma warning(disable: 4244)
+#endif
+
#include "_sndlib.h"
#include "sndlib-strings.h"
-#include "sndlib2xen.h"
#include "vct.h"
#include "clm.h"
+#include "sndlib2xen.h"
+#include "clm2xen.h"
-#ifndef S_setB
+#ifndef S_set
#if HAVE_RUBY
- #define S_setB "set_"
+ #define S_set "set_"
#endif
#if HAVE_SCHEME
- #define S_setB "set! "
+ #define S_set "set! "
#endif
#if HAVE_FORTH
- #define S_setB "set-"
+ #define S_set "set-"
#endif
#endif
+
/* originally I tried to simplify C GC by using global static strings that were
* freed whenever the associated function was called again, on the assumption
* that the preceding value was now unused. In a multithread context, that
- * assumption is false, so I can't use code like this:
+ * assumption is false, so I didn't use code like this:
*
* static char *tmpstr = NULL;
*
@@ -57,214 +64,245 @@
* }
*/
-static XEN g_mus_sound_loop_info(XEN gfilename)
+static Xen g_mus_sound_loop_info(Xen gfilename)
{
#define H_mus_sound_loop_info "(" S_mus_sound_loop_info " filename): synth loop info for sound as a list: (start1 \
end1 start2 end2 base-note base-detune mode1 mode2)"
int *res;
- XEN sres = XEN_EMPTY_LIST;
+ Xen sres = Xen_empty_list;
char *str = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(gfilename), gfilename, XEN_ONLY_ARG, S_mus_sound_loop_info, "a string");
+ Xen_check_type(Xen_is_string(gfilename), gfilename, 1, S_mus_sound_loop_info, "a string");
- res = mus_sound_loop_info(str = mus_expand_filename(XEN_TO_C_STRING(gfilename)));
+ res = mus_sound_loop_info(str = mus_expand_filename(Xen_string_to_C_string(gfilename)));
if (str) free(str);
if (res)
{
- sres = XEN_LIST_8(C_TO_XEN_INT(res[0]), C_TO_XEN_INT(res[1]), C_TO_XEN_INT(res[2]),
- C_TO_XEN_INT(res[3]), C_TO_XEN_INT(res[4]), C_TO_XEN_INT(res[5]),
- C_TO_XEN_INT(res[6]), C_TO_XEN_INT(res[7]));
+ sres = Xen_list_8(C_int_to_Xen_integer(res[0]), C_int_to_Xen_integer(res[1]), C_int_to_Xen_integer(res[2]),
+ C_int_to_Xen_integer(res[3]), C_int_to_Xen_integer(res[4]), C_int_to_Xen_integer(res[5]),
+ C_int_to_Xen_integer(res[6]), C_int_to_Xen_integer(res[7]));
free(res);
}
return(sres);
}
-static XEN g_mus_sound_mark_info(XEN gfilename)
+static Xen g_mus_sound_mark_info(Xen gfilename)
{
#define H_mus_sound_mark_info "(" S_mus_sound_mark_info " filename): aifc header mark info as a list of lists: ((id pos)...)"
int *mark_ids, *mark_positions;
int marks = 0;
- XEN sres = XEN_EMPTY_LIST;
+ Xen sres = Xen_empty_list;
char *str = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(gfilename), gfilename, XEN_ONLY_ARG, S_mus_sound_mark_info, "a string");
+ Xen_check_type(Xen_is_string(gfilename), gfilename, 1, S_mus_sound_mark_info, "a string");
- marks = mus_sound_mark_info(str = mus_expand_filename(XEN_TO_C_STRING(gfilename)), &mark_ids, &mark_positions);
+ marks = mus_sound_mark_info(str = mus_expand_filename(Xen_string_to_C_string(gfilename)), &mark_ids, &mark_positions);
if (str) free(str);
if (marks > 0)
{
int i;
for (i = 0; i < marks; i++)
- sres = XEN_CONS(XEN_LIST_2(C_TO_XEN_INT(mark_ids[i]),
- C_TO_XEN_INT(mark_positions[i])),
+ sres = Xen_cons(Xen_list_2(C_int_to_Xen_integer(mark_ids[i]),
+ C_int_to_Xen_integer(mark_positions[i])),
sres);
}
return(sres);
}
-static XEN gmus_sound(const char *caller, int (*func)(const char *file), XEN gfilename)
+static Xen gmus_sound(const char *caller, int (*func)(const char *file), Xen gfilename)
{
char *str = NULL;
- XEN result;
+ Xen result;
- XEN_ASSERT_TYPE(XEN_STRING_P(gfilename), gfilename, XEN_ONLY_ARG, caller, "a string");
- str = mus_expand_filename(XEN_TO_C_STRING(gfilename));
- result = C_TO_XEN_INT((*func)(str));
+ Xen_check_type(Xen_is_string(gfilename), gfilename, 1, caller, "a string");
+ str = mus_expand_filename(Xen_string_to_C_string(gfilename));
+ result = C_int_to_Xen_integer((*func)(str));
if (str) free(str);
return(result);
}
-static XEN gmus_sound_set(const char *caller, int (*func)(const char *file, int newval), XEN gfilename, XEN val)
+static Xen gmus_sound_set(const char *caller, int (*func)(const char *file, int newval), Xen gfilename, Xen val)
{
char *str = NULL;
- XEN result;
+ Xen result;
- XEN_ASSERT_TYPE(XEN_STRING_P(gfilename), gfilename, XEN_ARG_1, caller, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, caller, "an integer");
- str = mus_expand_filename(XEN_TO_C_STRING(gfilename));
- result = C_TO_XEN_INT((*func)(str, XEN_TO_C_INT(val)));
+ Xen_check_type(Xen_is_string(gfilename), gfilename, 1, caller, "a string");
+ Xen_check_type(Xen_is_integer(val), val, 2, caller, "an integer");
+ str = mus_expand_filename(Xen_string_to_C_string(gfilename));
+ result = C_int_to_Xen_integer((*func)(str, Xen_integer_to_C_int(val)));
if (str) free(str);
return(result);
}
-static XEN glmus_sound(const char *caller, mus_long_t (*func)(const char *file), XEN gfilename)
+static Xen glmus_sound(const char *caller, mus_long_t (*func)(const char *file), Xen gfilename)
{
char *str = NULL;
- XEN result;
+ Xen result;
- XEN_ASSERT_TYPE(XEN_STRING_P(gfilename), gfilename, XEN_ONLY_ARG, caller, "a string");
- str = mus_expand_filename(XEN_TO_C_STRING(gfilename));
- result = C_TO_XEN_INT64_T((*func)(str));
+ Xen_check_type(Xen_is_string(gfilename), gfilename, 1, caller, "a string");
+ str = mus_expand_filename(Xen_string_to_C_string(gfilename));
+ result = C_llong_to_Xen_llong((*func)(str));
if (str) free(str);
return(result);
}
-static XEN glmus_sound_set(const char *caller, int (*func)(const char *file, mus_long_t newval), XEN gfilename, XEN val)
+static Xen glmus_sound_set(const char *caller, int (*func)(const char *file, mus_long_t newval), Xen gfilename, Xen val)
{
char *str = NULL;
- XEN result;
+ Xen result;
- XEN_ASSERT_TYPE(XEN_STRING_P(gfilename), gfilename, XEN_ARG_1, caller, "a string");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_2, caller, "a number");
- str = mus_expand_filename(XEN_TO_C_STRING(gfilename));
- result = C_TO_XEN_INT64_T((*func)(str, XEN_TO_C_INT64_T(val)));
+ Xen_check_type(Xen_is_string(gfilename), gfilename, 1, caller, "a string");
+ Xen_check_type(Xen_is_number(val), val, 2, caller, "a number");
+ str = mus_expand_filename(Xen_string_to_C_string(gfilename));
+ result = C_llong_to_Xen_llong((*func)(str, Xen_llong_to_C_llong(val)));
if (str) free(str);
return(result);
}
-static XEN g_mus_sound_samples(XEN filename)
+static Xen g_mus_sound_samples(Xen filename)
{
- #define H_mus_sound_samples "(" S_mus_sound_samples " filename): samples (frames * channels) in sound file"
+ #define H_mus_sound_samples "(" S_mus_sound_samples " filename): samples (framples * channels) in sound file"
return(glmus_sound(S_mus_sound_samples, mus_sound_samples, filename));
}
-static XEN g_mus_sound_set_samples(XEN filename, XEN val)
+static Xen g_mus_sound_set_samples(Xen filename, Xen val)
{
- return(glmus_sound_set(S_setB S_mus_sound_samples, mus_sound_set_samples, filename, val));
+ return(glmus_sound_set(S_set S_mus_sound_samples, mus_sound_set_samples, filename, val));
}
-XEN g_mus_sound_frames(XEN filename)
+Xen g_mus_sound_framples(Xen filename)
{
- #define H_mus_sound_frames "(" S_mus_sound_frames " filename): frames (samples / channel) in sound file"
- return(glmus_sound(S_mus_sound_frames, mus_sound_frames, filename));
+ #define H_mus_sound_framples "(" S_mus_sound_framples " filename): framples (samples / channel) in sound file"
+ return(glmus_sound(S_mus_sound_framples, mus_sound_framples, filename));
}
-static XEN g_mus_sound_datum_size(XEN filename)
+static Xen g_mus_sound_datum_size(Xen filename)
{
- #define H_mus_sound_datum_size "(" S_mus_sound_datum_size " filename): bytes per sample used by the data in sound file (data format dependent)"
+ #define H_mus_sound_datum_size "(" S_mus_sound_datum_size " filename): bytes per sample used by the data in sound file (sample type dependent)"
return(gmus_sound(S_mus_sound_datum_size, mus_sound_datum_size, filename));
}
-static XEN g_mus_sound_data_location(XEN filename)
+static Xen g_mus_sound_data_location(Xen filename)
{
#define H_mus_sound_data_location "(" S_mus_sound_data_location " filename): location (in bytes) of first sample of sound data"
return(glmus_sound(S_mus_sound_data_location, mus_sound_data_location, filename));
}
-static XEN g_mus_sound_set_data_location(XEN filename, XEN val)
+static Xen g_mus_sound_set_data_location(Xen filename, Xen val)
{
- return(glmus_sound_set(S_setB S_mus_sound_data_location, mus_sound_set_data_location, filename, val));
+ return(glmus_sound_set(S_set S_mus_sound_data_location, mus_sound_set_data_location, filename, val));
}
-XEN g_mus_sound_chans(XEN filename)
+Xen g_mus_sound_chans(Xen filename)
{
#define H_mus_sound_chans "(" S_mus_sound_chans " filename): channels of data in sound file"
return(gmus_sound(S_mus_sound_chans, mus_sound_chans, filename));
}
-static XEN g_mus_sound_set_chans(XEN filename, XEN val)
+static Xen g_mus_sound_set_chans(Xen filename, Xen val)
{
- return(gmus_sound_set(S_setB S_mus_sound_chans, mus_sound_set_chans, filename, val));
+ return(gmus_sound_set(S_set S_mus_sound_chans, mus_sound_set_chans, filename, val));
}
-XEN g_mus_sound_srate(XEN filename)
+Xen g_mus_sound_srate(Xen filename)
{
#define H_mus_sound_srate "(" S_mus_sound_srate " filename): sampling rate of sound file"
return(gmus_sound(S_mus_sound_srate, mus_sound_srate, filename));
}
-static XEN g_mus_sound_set_srate(XEN filename, XEN val)
+static Xen g_mus_sound_set_srate(Xen filename, Xen val)
{
- return(gmus_sound_set(S_setB S_mus_sound_srate, mus_sound_set_srate, filename, val));
+ return(gmus_sound_set(S_set S_mus_sound_srate, mus_sound_set_srate, filename, val));
}
-static XEN g_mus_sound_header_type(XEN filename)
+static Xen g_mus_sound_header_type(Xen filename)
{
#define H_mus_sound_header_type "(" S_mus_sound_header_type " filename): header type (e.g. " S_mus_aifc ") of sound file"
- return(gmus_sound(S_mus_sound_header_type, mus_sound_header_type, filename));
+
+ char *str = NULL;
+ Xen result;
+
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_mus_sound_header_type, "a string");
+ str = mus_expand_filename(Xen_string_to_C_string(filename));
+ result = C_int_to_Xen_integer((int)mus_sound_header_type(str));
+ if (str) free(str);
+ return(result);
}
-static XEN g_mus_sound_set_header_type(XEN filename, XEN val)
+static Xen g_mus_sound_set_header_type(Xen filename, Xen val)
{
- return(gmus_sound_set(S_setB S_mus_sound_header_type, mus_sound_set_header_type, filename, val));
+ char *str = NULL;
+ Xen result;
+
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_set S_mus_sound_header_type, "a string");
+ Xen_check_type(Xen_is_integer(val), val, 2, S_set S_mus_sound_header_type, "an integer");
+ str = mus_expand_filename(Xen_string_to_C_string(filename));
+ result = C_int_to_Xen_integer((int)mus_sound_set_header_type(str, (mus_header_t)Xen_integer_to_C_int(val)));
+ if (str) free(str);
+ return(result);
}
-static XEN g_mus_sound_data_format(XEN filename)
+static Xen g_mus_sound_sample_type(Xen filename)
{
- #define H_mus_sound_data_format "(" S_mus_sound_data_format " filename): data format (e.g. " S_mus_bshort ") of data in sound file"
- return(gmus_sound(S_mus_sound_data_format, mus_sound_data_format, filename));
+ #define H_mus_sound_sample_type "(" S_mus_sound_sample_type " filename): sample type (e.g. " S_mus_bshort ") of data in sound file"
+ char *str = NULL;
+ Xen result;
+
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_mus_sound_sample_type, "a string");
+ str = mus_expand_filename(Xen_string_to_C_string(filename));
+ result = C_int_to_Xen_integer((int)mus_sound_sample_type(str));
+ if (str) free(str);
+ return(result);
}
-static XEN g_mus_sound_set_data_format(XEN filename, XEN val)
+static Xen g_mus_sound_set_sample_type(Xen filename, Xen val)
{
- return(gmus_sound_set(S_setB S_mus_sound_data_format, mus_sound_set_data_format, filename, val));
+ char *str = NULL;
+ Xen result;
+
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_set S_mus_sound_sample_type, "a string");
+ Xen_check_type(Xen_is_integer(val), val, 2, S_set S_mus_sound_sample_type, "an integer");
+ str = mus_expand_filename(Xen_string_to_C_string(filename));
+ result = C_int_to_Xen_integer((int)mus_sound_set_sample_type(str, (mus_sample_t)Xen_integer_to_C_int(val)));
+ if (str) free(str);
+ return(result);
}
-static XEN g_mus_sound_length(XEN filename)
+static Xen g_mus_sound_length(Xen filename)
{
#define H_mus_sound_length "(" S_mus_sound_length " filename): sound file length in bytes"
return(glmus_sound(S_mus_sound_length, mus_sound_length, filename));
}
-static XEN g_mus_sound_type_specifier(XEN filename)
+static Xen g_mus_sound_type_specifier(Xen filename)
{
#define H_mus_sound_type_specifier "(" S_mus_sound_type_specifier " filename): original sound file header type identifier (e.g. 0x2e736e64)"
return(gmus_sound(S_mus_sound_type_specifier, mus_sound_type_specifier, filename));
}
-static XEN g_mus_sound_forget(XEN filename)
+static Xen g_mus_sound_forget(Xen filename)
{
#define H_mus_sound_forget "(" S_mus_sound_forget " filename): remove 'filename' from sound cache. If you create, then later \
delete a sound file, " S_mus_sound_forget " can be used to clear it from sndlib's cache of sound files"
@@ -272,305 +310,308 @@ delete a sound file, " S_mus_sound_forget " can be used to clear it from sndlib'
}
-static XEN g_mus_sound_prune(void)
+static Xen g_mus_sound_prune(void)
{
#define H_mus_sound_prune "(" S_mus_sound_prune "): remove all defunct entries from sndlib's sound file cache."
- return(C_TO_XEN_INT(mus_sound_prune()));
+ return(C_int_to_Xen_integer(mus_sound_prune()));
}
-static XEN g_mus_sound_comment(XEN gfilename)
+static Xen g_mus_sound_comment(Xen gfilename)
{
#define H_mus_sound_comment "(" S_mus_sound_comment " filename): comment (a string) found in sound file's header"
char *res = NULL, *str = NULL;
- XEN newstr;
+ Xen newstr;
- XEN_ASSERT_TYPE(XEN_STRING_P(gfilename), gfilename, XEN_ONLY_ARG, S_mus_sound_comment, "a string");
+ Xen_check_type(Xen_is_string(gfilename), gfilename, 1, S_mus_sound_comment, "a string");
- res = mus_sound_comment(str = mus_expand_filename(XEN_TO_C_STRING(gfilename)));
+ res = mus_sound_comment(str = mus_expand_filename(Xen_string_to_C_string(gfilename)));
if (str) free(str);
- newstr = C_TO_XEN_STRING(res);
+ newstr = C_string_to_Xen_string(res);
if (res) free(res);
return(newstr);
}
-static XEN g_mus_sound_write_date(XEN filename)
+static Xen g_mus_sound_write_date(Xen filename)
{
char *str = NULL;
- XEN result;
+ Xen result;
#define H_mus_sound_write_date "(" S_mus_sound_write_date " filename): write date of sound file"
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ONLY_ARG, S_mus_sound_write_date, "a string");
- str = mus_expand_filename(XEN_TO_C_STRING(filename));
- result = C_TO_XEN_ULONG((unsigned long)mus_sound_write_date(str)); /* actually time_t */
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_mus_sound_write_date, "a string");
+ str = mus_expand_filename(Xen_string_to_C_string(filename));
+ result = C_ulong_to_Xen_ulong((unsigned long)mus_sound_write_date(str)); /* actually time_t */
if (str) free(str);
return(result);
}
-static XEN g_mus_header_raw_defaults(void)
+static Xen g_mus_header_writable(Xen head, Xen data)
{
- #define H_mus_header_raw_defaults "(" S_mus_header_raw_defaults "): returns list '(srate chans format) of current raw sound default attributes"
- int srate, chans, data_format;
- mus_header_raw_defaults(&srate, &chans, &data_format);
- return(XEN_LIST_3(C_TO_XEN_INT(srate),
- C_TO_XEN_INT(chans),
- C_TO_XEN_INT(data_format)));
+ #define H_mus_header_writable "(" S_mus_header_writable " header-type sample-type) returns " PROC_TRUE " if the header can handle the sample type"
+ Xen_check_type(Xen_is_integer(head), head, 1, S_mus_header_writable, "a header type");
+ Xen_check_type(Xen_is_integer(data), data, 2, S_mus_header_writable, "a sample type");
+ return(C_bool_to_Xen_boolean(mus_header_writable((mus_header_t)Xen_integer_to_C_int(head), (mus_sample_t)Xen_integer_to_C_int(data))));
}
-
-static XEN g_mus_header_set_raw_defaults(XEN lst)
+static Xen g_mus_header_raw_defaults(void)
{
- XEN_ASSERT_TYPE((XEN_LIST_P(lst)) && (XEN_LIST_LENGTH(lst) == 3), lst, XEN_ONLY_ARG, S_mus_header_raw_defaults, "a list: '(srate chans data-format)");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(XEN_CAR(lst)), XEN_CAR(lst), XEN_ARG_1, S_mus_header_raw_defaults, "an integer = srate");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(XEN_CADR(lst)), XEN_CADR(lst), XEN_ARG_2, S_mus_header_raw_defaults, "an integer = chans");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(XEN_CADDR(lst)), XEN_CADDR(lst), XEN_ARG_3, S_mus_header_raw_defaults, "an integer = data-format");
- mus_header_set_raw_defaults(XEN_TO_C_INT(XEN_CAR(lst)),
- XEN_TO_C_INT(XEN_CADR(lst)),
- XEN_TO_C_INT(XEN_CADDR(lst)));
- return(lst);
+ #define H_mus_header_raw_defaults "(" S_mus_header_raw_defaults "): returns list '(srate chans sample-type) of current raw sound default attributes"
+ int srate, chans;
+ mus_sample_t sample_type;
+ mus_header_raw_defaults(&srate, &chans, &sample_type);
+ return(Xen_list_3(C_int_to_Xen_integer(srate),
+ C_int_to_Xen_integer(chans),
+ C_int_to_Xen_integer((int)sample_type)));
}
-static XEN g_mus_header_type_name(XEN type)
+static Xen g_mus_header_set_raw_defaults(Xen lst)
{
- #define H_mus_header_type_name "(" S_mus_header_type_name " type): header type (e.g. " S_mus_aiff ") as a string"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(type), type, XEN_ONLY_ARG, S_mus_header_type_name, "an integer (header-type id)");
- return(C_TO_XEN_STRING(mus_header_type_name(XEN_TO_C_INT(type))));
+ Xen_check_type((Xen_is_list(lst)) && (Xen_list_length(lst) == 3), lst, 1, S_mus_header_raw_defaults, "a list: '(srate chans sample-type)");
+ Xen_check_type(Xen_is_integer(Xen_car(lst)), Xen_car(lst), 1, S_mus_header_raw_defaults, "an integer = srate");
+ Xen_check_type(Xen_is_integer(Xen_cadr(lst)), Xen_cadr(lst), 2, S_mus_header_raw_defaults, "an integer = chans");
+ Xen_check_type(Xen_is_integer(Xen_caddr(lst)), Xen_caddr(lst), 3, S_mus_header_raw_defaults, "an integer = sample-type");
+ mus_header_set_raw_defaults(Xen_integer_to_C_int(Xen_car(lst)),
+ Xen_integer_to_C_int(Xen_cadr(lst)),
+ (mus_sample_t)Xen_integer_to_C_int(Xen_caddr(lst)));
+ return(lst);
}
-static XEN g_mus_header_type_to_string(XEN type)
+static Xen g_mus_header_type_name(Xen type)
{
- #define H_mus_header_type_to_string "(" S_mus_header_type_to_string " type): header type (e.g. " S_mus_aiff ") as a string"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(type), type, XEN_ONLY_ARG, S_mus_header_type_to_string, "an integer (header-type id)");
- return(C_TO_XEN_STRING(mus_header_type_to_string(XEN_TO_C_INT(type))));
+ #define H_mus_header_type_name "(" S_mus_header_type_name " type): header type (e.g. " S_mus_aiff ") as a string"
+ Xen_check_type(Xen_is_integer(type), type, 1, S_mus_header_type_name, "an integer (header-type id)");
+ return(C_string_to_Xen_string(mus_header_type_name((mus_header_t)Xen_integer_to_C_int(type))));
}
-static XEN g_mus_data_format_name(XEN format)
+static Xen g_mus_header_type_to_string(Xen type)
{
- #define H_mus_data_format_name "(" S_mus_data_format_name " format): data format (e.g. " S_mus_bshort ") as a string"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(format), format, XEN_ONLY_ARG, S_mus_data_format_name, "an integer (data-format id)");
- return(C_TO_XEN_STRING(mus_data_format_name(XEN_TO_C_INT(format))));
+ #define H_mus_header_type_to_string "(" S_mus_header_type_to_string " type): header type (e.g. " S_mus_aiff ") as a string"
+ Xen_check_type(Xen_is_integer(type), type, 1, S_mus_header_type_to_string, "an integer (header-type id)");
+ return(C_string_to_Xen_string(mus_header_type_to_string((mus_header_t)Xen_integer_to_C_int(type))));
}
-static XEN g_mus_data_format_to_string(XEN format)
+static Xen g_mus_sample_type_name(Xen samp_type)
{
- #define H_mus_data_format_to_string "(" S_mus_data_format_to_string " format): data format (e.g. " S_mus_bshort ") as a string"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(format), format, XEN_ONLY_ARG, S_mus_data_format_to_string, "an integer (data-format id)");
- return(C_TO_XEN_STRING(mus_data_format_to_string(XEN_TO_C_INT(format))));
+ #define H_mus_sample_type_name "(" S_mus_sample_type_name " samp_type): sample type (e.g. " S_mus_bshort ") as a string"
+ Xen_check_type(Xen_is_integer(samp_type), samp_type, 1, S_mus_sample_type_name, "an integer (sample-type id)");
+ return(C_string_to_Xen_string(mus_sample_type_name((mus_sample_t)Xen_integer_to_C_int(samp_type))));
}
-static XEN g_mus_bytes_per_sample(XEN format)
+static Xen g_mus_sample_type_to_string(Xen samp_type)
{
- #define H_mus_bytes_per_sample "(" S_mus_bytes_per_sample " format): number of bytes per sample in \
-format (e.g. " S_mus_bshort " = 2)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(format), format, XEN_ONLY_ARG, S_mus_bytes_per_sample, "an integer (data-format id)");
- return(C_TO_XEN_INT(mus_bytes_per_sample(XEN_TO_C_INT(format))));
+ #define H_mus_sample_type_to_string "(" S_mus_sample_type_to_string " samp_type): sample type (e.g. " S_mus_bshort ") as a string"
+ Xen_check_type(Xen_is_integer(samp_type), samp_type, 1, S_mus_sample_type_to_string, "an integer (sample-type id)");
+ return(C_string_to_Xen_string(mus_sample_type_to_string((mus_sample_t)Xen_integer_to_C_int(samp_type))));
}
-static XEN g_mus_audio_describe(void)
+static Xen g_mus_bytes_per_sample(Xen samp_type)
{
- #define H_mus_audio_describe "(" S_mus_audio_describe "): returns a string describing the current audio hardware setup"
- return(C_TO_XEN_STRING(mus_audio_describe()));
+ #define H_mus_bytes_per_sample "(" S_mus_bytes_per_sample " sample-type): number of bytes per sample in \
+sample-type (e.g. " S_mus_bshort " = 2)"
+ Xen_check_type(Xen_is_integer(samp_type), samp_type, 1, S_mus_bytes_per_sample, "an integer (sample-type id)");
+ return(C_int_to_Xen_integer(mus_bytes_per_sample((mus_sample_t)Xen_integer_to_C_int(samp_type))));
}
-static XEN g_mus_sound_duration(XEN gfilename)
+static Xen g_mus_sound_duration(Xen gfilename)
{
#define H_mus_sound_duration "(" S_mus_sound_duration " filename): duration (in seconds) of sound file"
float res;
char *str = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(gfilename), gfilename, XEN_ONLY_ARG, S_mus_sound_duration, "a string");
- res = mus_sound_duration(str = mus_expand_filename(XEN_TO_C_STRING(gfilename)));
+ Xen_check_type(Xen_is_string(gfilename), gfilename, 1, S_mus_sound_duration, "a string");
+ res = mus_sound_duration(str = mus_expand_filename(Xen_string_to_C_string(gfilename)));
if (str) free(str);
- return(C_TO_XEN_DOUBLE(res));
+ return(C_double_to_Xen_real(res));
}
-static XEN g_mus_oss_set_buffers(XEN num, XEN size)
+static Xen g_mus_oss_set_buffers(Xen num, Xen size)
{
#define H_mus_oss_set_buffers "(" S_mus_oss_set_buffers " num size): set Linux OSS 'fragment' number and size. \
If Snd's controls seem sluggish, try (" S_mus_oss_set_buffers " 4 12) or even (" S_mus_oss_set_buffers " 2 12). \
This reduces the on-card buffering, but may introduce clicks."
#if (HAVE_OSS || HAVE_ALSA)
- XEN_ASSERT_TYPE(XEN_INTEGER_P(num), num, XEN_ARG_1, S_mus_oss_set_buffers, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(size), size, XEN_ARG_2, S_mus_oss_set_buffers, "an integer");
- mus_oss_set_buffers(XEN_TO_C_INT(num),
- XEN_TO_C_INT(size));
+ Xen_check_type(Xen_is_integer(num), num, 1, S_mus_oss_set_buffers, "an integer");
+ Xen_check_type(Xen_is_integer(size), size, 2, S_mus_oss_set_buffers, "an integer");
+ mus_oss_set_buffers(Xen_integer_to_C_int(num),
+ Xen_integer_to_C_int(size));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_buffers(void)
+static Xen g_mus_alsa_buffers(void)
{
#define H_mus_alsa_buffers "(" S_mus_alsa_buffers "): current number of ALSA periods."
#if HAVE_ALSA
- return(C_TO_XEN_INT(mus_alsa_buffers()));
+ return(C_int_to_Xen_integer(mus_alsa_buffers()));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_set_buffers(XEN val)
+static Xen g_mus_alsa_set_buffers(Xen val)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_mus_alsa_buffers, "an integer");
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mus_alsa_buffers, "an integer");
#if HAVE_ALSA
- return(C_TO_XEN_INT(mus_alsa_set_buffers(XEN_TO_C_INT(val))));
+ return(C_int_to_Xen_integer(mus_alsa_set_buffers(Xen_integer_to_C_int(val))));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_buffer_size(void)
+static Xen g_mus_alsa_buffer_size(void)
{
#define H_mus_alsa_buffer_size "(" S_mus_alsa_buffer_size "): current size of ALSA buffers."
#if HAVE_ALSA
- return(C_TO_XEN_INT(mus_alsa_buffer_size()));
+ return(C_int_to_Xen_integer(mus_alsa_buffer_size()));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_set_buffer_size(XEN val)
+static Xen g_mus_alsa_set_buffer_size(Xen val)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ONLY_ARG, S_setB S_mus_alsa_buffer_size, "an integer");
+ Xen_check_type(Xen_is_integer(val), val, 1, S_set S_mus_alsa_buffer_size, "an integer");
#if HAVE_ALSA
- return(C_TO_XEN_INT(mus_alsa_set_buffer_size(XEN_TO_C_INT(val))));
+ return(C_int_to_Xen_integer(mus_alsa_set_buffer_size(Xen_integer_to_C_int(val))));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_device(void)
+static Xen g_mus_alsa_device(void)
{
#define H_mus_alsa_device "(" S_mus_alsa_device "): current ALSA device."
#if HAVE_ALSA
- return(C_TO_XEN_STRING(mus_alsa_device()));
+ return(C_string_to_Xen_string(mus_alsa_device()));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_set_device(XEN val)
+static Xen g_mus_alsa_set_device(Xen val)
{
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_mus_alsa_device, "a string (ALSA device name)");
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_mus_alsa_device, "a string (ALSA device name)");
#if HAVE_ALSA
- return(C_TO_XEN_STRING(mus_alsa_set_device(XEN_TO_C_STRING(val))));
+ return(C_string_to_Xen_string(mus_alsa_set_device(Xen_string_to_C_string(val))));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_playback_device(void)
+static Xen g_mus_alsa_playback_device(void)
{
#define H_mus_alsa_playback_device "(" S_mus_alsa_playback_device "): current ALSA playback device."
#if HAVE_ALSA
- return(C_TO_XEN_STRING(mus_alsa_playback_device()));
+ return(C_string_to_Xen_string(mus_alsa_playback_device()));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_set_playback_device(XEN val)
+static Xen g_mus_alsa_set_playback_device(Xen val)
{
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_mus_alsa_playback_device, "a string (ALSA device name)");
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_mus_alsa_playback_device, "a string (ALSA device name)");
#if HAVE_ALSA
- return(C_TO_XEN_STRING(mus_alsa_set_playback_device(XEN_TO_C_STRING(val))));
+ return(C_string_to_Xen_string(mus_alsa_set_playback_device(Xen_string_to_C_string(val))));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_capture_device(void)
+static Xen g_mus_alsa_capture_device(void)
{
#define H_mus_alsa_capture_device "(" S_mus_alsa_capture_device "): current ALSA capture device."
#if HAVE_ALSA
- return(C_TO_XEN_STRING(mus_alsa_capture_device()));
+ return(C_string_to_Xen_string(mus_alsa_capture_device()));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_set_capture_device(XEN val)
+static Xen g_mus_alsa_set_capture_device(Xen val)
{
- XEN_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ONLY_ARG, S_setB S_mus_alsa_capture_device, "a string (ALSA device name)");
+ Xen_check_type(Xen_is_string(val), val, 1, S_set S_mus_alsa_capture_device, "a string (ALSA device name)");
#if HAVE_ALSA
- return(C_TO_XEN_STRING(mus_alsa_set_capture_device(XEN_TO_C_STRING(val))));
+ return(C_string_to_Xen_string(mus_alsa_set_capture_device(Xen_string_to_C_string(val))));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_squelch_warning(void)
+static Xen g_mus_alsa_squelch_warning(void)
{
#define H_mus_alsa_squelch_warning "(" S_mus_alsa_squelch_warning "): whether to squelch ALSA srate mismatch warnings."
#if HAVE_ALSA
- return(C_TO_XEN_BOOLEAN(mus_alsa_squelch_warning()));
+ return(C_bool_to_Xen_boolean(mus_alsa_squelch_warning()));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_alsa_set_squelch_warning(XEN val)
+static Xen g_mus_alsa_set_squelch_warning(Xen val)
{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ONLY_ARG, S_setB S_mus_alsa_squelch_warning, "a boolean");
+ Xen_check_type(Xen_is_boolean(val), val, 1, S_set S_mus_alsa_squelch_warning, "a boolean");
#if HAVE_ALSA
- return(C_TO_XEN_BOOLEAN(mus_alsa_set_squelch_warning(XEN_TO_C_BOOLEAN(val))));
+ return(C_bool_to_Xen_boolean(mus_alsa_set_squelch_warning(Xen_boolean_to_C_bool(val))));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_mus_sound_maxamp_exists(XEN file)
+static Xen g_mus_sound_maxamp_exists(Xen file)
{
#define H_mus_sound_maxamp_exists "(" S_mus_sound_maxamp_exists " filename): " PROC_TRUE " if sound's maxamp data is available \
in the sound cache; if it isn't, a call on " S_mus_sound_maxamp " has to open and read the data to get the maxamp."
bool val;
char *str = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ONLY_ARG, S_mus_sound_maxamp_exists, "a string");
- val = mus_sound_maxamp_exists(str = mus_expand_filename(XEN_TO_C_STRING(file)));
+ Xen_check_type(Xen_is_string(file), file, 1, S_mus_sound_maxamp_exists, "a string");
+ val = mus_sound_maxamp_exists(str = mus_expand_filename(Xen_string_to_C_string(file)));
if (str) free(str);
- return(C_TO_XEN_BOOLEAN(val));
+ return(C_bool_to_Xen_boolean(val));
}
-XEN g_mus_sound_maxamp(XEN file)
+Xen g_mus_sound_maxamp(Xen file)
{
#define H_mus_sound_maxamp "(" S_mus_sound_maxamp " filename): maxamps in sound (a list of paired amps (floats) and locations (samples))"
int chans;
char *filename;
- XEN res = XEN_EMPTY_LIST;
+ Xen res = Xen_empty_list;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ONLY_ARG, S_mus_sound_maxamp, "a string");
+ Xen_check_type(Xen_is_string(file), file, 1, S_mus_sound_maxamp, "a string");
- filename = mus_expand_filename(XEN_TO_C_STRING(file));
+ filename = mus_expand_filename(Xen_string_to_C_string(file));
chans = mus_sound_chans(filename);
if (chans > 0)
{
mus_long_t rtn;
- int i;
- mus_sample_t *vals;
+ mus_float_t *vals;
mus_long_t *times;
- vals = (mus_sample_t *)calloc(chans, sizeof(mus_sample_t));
+ vals = (mus_float_t *)calloc(chans, sizeof(mus_float_t));
times = (mus_long_t *)calloc(chans, sizeof(mus_long_t));
rtn = mus_sound_maxamps(filename, chans, vals, times);
if (rtn != MUS_ERROR)
- for (i = chans - 1; i >= 0; i--)
- res = XEN_CONS(C_TO_XEN_INT64_T(times[i]),
- XEN_CONS(C_TO_XEN_DOUBLE(MUS_SAMPLE_TO_FLOAT(vals[i])), res));
+ {
+ int i;
+ for (i = chans - 1; i >= 0; i--)
+ res = Xen_cons(C_llong_to_Xen_llong(times[i]), Xen_cons(C_double_to_Xen_real(vals[i]), res));
+ }
free(vals);
free(times);
if (filename) free(filename);
@@ -578,22 +619,22 @@ XEN g_mus_sound_maxamp(XEN file)
else
{
if (filename) free(filename);
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_1(C_TO_XEN_STRING(S_mus_sound_maxamp ": chans <= 0")));
+ Xen_error(BAD_HEADER,
+ Xen_list_1(C_string_to_Xen_string(S_mus_sound_maxamp ": chans <= 0")));
}
return(res);
}
-static XEN g_mus_sound_set_maxamp(XEN file, XEN vals)
+static Xen g_mus_sound_set_maxamp(Xen file, Xen vals)
{
int chans;
char *filename;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ARG_1, S_setB S_mus_sound_maxamp, "a string");
- XEN_ASSERT_TYPE(XEN_LIST_P(vals), vals, XEN_ARG_2, S_setB S_mus_sound_maxamp, "a list");
+ Xen_check_type(Xen_is_string(file), file, 1, S_set S_mus_sound_maxamp, "a string");
+ Xen_check_type(Xen_is_list(vals), vals, 2, S_set S_mus_sound_maxamp, "a list");
- filename = mus_expand_filename(XEN_TO_C_STRING(file));
+ filename = mus_expand_filename(Xen_string_to_C_string(file));
chans = mus_sound_chans(filename);
/* presumably any actual error here will be trapped via mus-error (raised in mus_header_read via read_sound_file_header),
@@ -601,25 +642,26 @@ static XEN g_mus_sound_set_maxamp(XEN file, XEN vals)
*/
if (chans > 0)
{
- XEN lst;
+ Xen lst;
int i, j, len;
- mus_sample_t *mvals;
+ mus_float_t *mvals;
mus_long_t *times;
- len = XEN_LIST_LENGTH(vals);
+ len = Xen_list_length(vals);
if (len < (chans * 2))
- XEN_WRONG_TYPE_ARG_ERROR(S_setB S_mus_sound_maxamp, 2, vals, "max amp list length must = 2 * chans");
+ Xen_wrong_type_arg_error(S_set S_mus_sound_maxamp, 2, vals, "max amp list length must = 2 * chans");
if (len > chans * 2) len = chans * 2;
- mvals = (mus_sample_t *)calloc(chans, sizeof(mus_sample_t));
+ mvals = (mus_float_t *)calloc(chans, sizeof(mus_float_t));
times = (mus_long_t *)calloc(chans, sizeof(mus_long_t));
- for (i = 0, j = 0, lst = XEN_COPY_ARG(vals); i < len; i += 2, j++, lst = XEN_CDDR(lst))
+ for (i = 0, j = 0, lst = Xen_copy_arg(vals); i < len; i += 2, j++, lst = Xen_cddr(lst))
{
- times[j] = XEN_TO_C_INT64_T_OR_ELSE(XEN_CAR(lst), 0);
- mvals[j] = MUS_DOUBLE_TO_SAMPLE(XEN_TO_C_DOUBLE(XEN_CADR(lst)));
+ times[j] = Xen_llong_to_C_llong(Xen_car(lst));
+ mvals[j] = Xen_real_to_C_double(Xen_cadr(lst));
}
+ fprintf(stderr, "set in g_mus_sound_set_maxamp\n");
mus_sound_set_maxamps(filename, chans, mvals, times);
free(mvals);
free(times);
@@ -628,719 +670,151 @@ static XEN g_mus_sound_set_maxamp(XEN file, XEN vals)
else
{
if (filename) free(filename);
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_1(C_TO_XEN_STRING(S_setB S_mus_sound_maxamp ": chans <= 0")));
+ Xen_error(BAD_HEADER,
+ Xen_list_1(C_string_to_Xen_string(S_set S_mus_sound_maxamp ": chans <= 0")));
}
return(vals);
}
-static XEN g_mus_sound_open_input(XEN file)
-{
- #define H_mus_sound_open_input "(" S_mus_sound_open_input " filename): open filename for (low-level) sound input, \
-return file descriptor (an integer)"
- int fd;
- char *str = NULL;
-
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ONLY_ARG, S_mus_sound_open_input, "a string");
- fd = mus_sound_open_input(str = mus_expand_filename(XEN_TO_C_STRING(file)));
- if (str) free(str);
- return(C_TO_XEN_INT(fd));
-}
-
-
-static XEN g_mus_sound_open_output(XEN file, XEN srate, XEN chans, XEN data_format, XEN header_type, XEN comment)
-{
-
- #define H_mus_sound_open_output "(" S_mus_sound_open_output " filename :optional (srate 44100) (chans 1) data-format header-type (comment \"\")): \
-open filename for (low-level) sound output with the given srate and so on; return the file descriptor (an integer). \
-The file size is normally set later via " S_mus_sound_close_output ". srate is an integer, comment is a string, \
-data-format is a sndlib format indicator such as " S_mus_bshort ", if " PROC_FALSE " if defaults to a format compatible with sndlib, \
-header-type is a sndlib type indicator such as " S_mus_aiff "; sndlib currently only writes 5 or so header types."
-
- int fd = -1, df;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ARG_1, S_mus_sound_open_output, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(srate), srate, XEN_ARG_2, S_mus_sound_open_output, "an integer or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(chans), chans, XEN_ARG_3, S_mus_sound_open_output, "an integer or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(data_format), data_format, XEN_ARG_4, S_mus_sound_open_output, "a data-format or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(header_type), header_type, XEN_ARG_5, S_mus_sound_open_output, "a header-type or " PROC_FALSE);
- XEN_ASSERT_TYPE((XEN_STRING_P(comment) || (XEN_NOT_BOUND_P(comment))), comment, XEN_ARG_6, S_mus_sound_open_output, "a string");
-
- df = XEN_TO_C_INT_OR_ELSE(data_format, (int)MUS_OUT_FORMAT);
- if (mus_data_format_p(df))
- {
- int ht;
-#if MUS_LITTLE_ENDIAN
- ht = XEN_TO_C_INT_OR_ELSE(header_type, (int)MUS_RIFF);
-#else
- ht = XEN_TO_C_INT_OR_ELSE(header_type, (int)MUS_NEXT);
-#endif
- /* now check that data format and header type are ok together */
- if (mus_header_type_p(ht))
- {
- int chns;
-
- if (!mus_header_writable(ht, df))
- {
- if ((XEN_INTEGER_P(data_format)) &&
- (XEN_INTEGER_P(header_type)))
- XEN_ERROR(XEN_ERROR_TYPE("bad-data"),
- XEN_LIST_3(C_TO_XEN_STRING(S_mus_sound_open_output ": ~A header can't handle ~A data"),
- C_TO_XEN_STRING(mus_header_type_name(ht)),
- C_TO_XEN_STRING(mus_data_format_name(df))));
-
- if (!(XEN_INTEGER_P(data_format)))
- {
- switch (df)
- {
- case MUS_BFLOAT: df = MUS_LFLOAT; break;
- case MUS_BDOUBLE: df = MUS_LDOUBLE; break;
- case MUS_BINT: df = MUS_LINT; break;
- case MUS_LFLOAT: df = MUS_BFLOAT; break;
- case MUS_LDOUBLE: df = MUS_BDOUBLE; break;
- case MUS_LINT: df = MUS_BINT; break;
- }
- if (!mus_header_writable(ht, df))
- {
- int i;
- for (i = 1; i < MUS_NUM_DATA_FORMATS; i++) /* MUS_UNSUPPORTED is 0 */
- {
- df = i;
- if (mus_header_writable(ht, df))
- break;
- }
- }
- }
- else
- {
- ht = MUS_NEXT;
- }
-
- if (!mus_header_writable(ht, df))
- XEN_ERROR(XEN_ERROR_TYPE("bad-data"),
- XEN_LIST_3(C_TO_XEN_STRING(S_mus_sound_open_output ": ~A header can't handle ~A data"),
- C_TO_XEN_STRING(mus_header_type_name(ht)),
- C_TO_XEN_STRING(mus_data_format_name(df))));
- }
-
- chns = XEN_TO_C_INT_OR_ELSE(chans, 1);
- if (chns > 0)
- {
- const char *com = NULL;
- char *str = NULL;
- if (XEN_STRING_P(comment)) com = XEN_TO_C_STRING(comment);
- fd = mus_sound_open_output(str = mus_expand_filename(XEN_TO_C_STRING(file)),
- XEN_TO_C_INT_OR_ELSE(srate, 44100), /* not DEFAULT_OUTPUT_SRATE here because that depends on Snd */
- chns, df, ht, com);
- if (str) free(str);
- }
- else XEN_OUT_OF_RANGE_ERROR(S_mus_sound_open_output, 3, chans, "chans ~A <= 0?");
- }
- else XEN_OUT_OF_RANGE_ERROR(S_mus_sound_open_output, 5, header_type, "~A: invalid header type");
- }
- else XEN_OUT_OF_RANGE_ERROR(S_mus_sound_open_output, 4, data_format, "~A: invalid data format");
- return(C_TO_XEN_INT(fd));
-}
-
-static XEN g_mus_sound_reopen_output(XEN file, XEN chans, XEN data_format, XEN header_type, XEN data_loc)
+#define S_mus_sound_preload "mus-sound-preload"
+static Xen g_mus_sound_preload(Xen file)
{
+ #define H_mus_sound_preload "(" S_mus_sound_preload " filename): save filename's data in memory (faster opens and so on)."
+ char *str;
- #define H_mus_sound_reopen_output "(" S_mus_sound_reopen_output " filename :optional (chans 1) data-format header-type data-location): \
-reopen (without alteration) filename for output \
-data-format and header-type are sndlib indicators such as " S_mus_bshort " or " S_mus_aiff ". \
-data-location should be retrieved from a previous call to " S_mus_sound_data_location "."
+ Xen_check_type(Xen_is_string(file), file, 1, S_mus_sound_preload, "a string");
+ str = mus_expand_filename(Xen_string_to_C_string(file));
- int fd = -1, df;
- char *filename;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ARG_1, S_mus_sound_reopen_output, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(chans), chans, XEN_ARG_2, S_mus_sound_reopen_output, "an integer or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(data_format), data_format, XEN_ARG_3, S_mus_sound_reopen_output, "a data-format or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(header_type), header_type, XEN_ARG_4, S_mus_sound_reopen_output, "a header-type or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_INT64_T_P(data_loc) || XEN_FALSE_P(data_loc) || XEN_NOT_BOUND_P(data_loc),
- data_loc, XEN_ARG_5, S_mus_sound_reopen_output, "an integer or " PROC_FALSE);
-
- filename = mus_expand_filename(XEN_TO_C_STRING(file));
-
- /* use existing settings if unbound as args */
- if (XEN_INTEGER_P(data_format))
- df = XEN_TO_C_INT(data_format);
- else
+ if (str)
{
- df = mus_sound_data_format(filename);
- if (df == MUS_ERROR)
- df = MUS_OUT_FORMAT;
- }
- if (mus_data_format_p(df))
- {
- int ht;
- if (XEN_INTEGER_P(header_type))
- ht = XEN_TO_C_INT(header_type);
- else
- {
- ht = mus_sound_header_type(filename);
- if (ht == MUS_ERROR)
-#if MUS_LITTLE_ENDIAN
- ht = MUS_RIFF;
-#else
- ht = MUS_NEXT;
-#endif
- }
- if (mus_header_type_p(ht))
+ int ifd;
+ ifd = mus_sound_open_input(str);
+ if (ifd != MUS_ERROR)
{
- int chns;
- if (XEN_INTEGER_P(chans))
- chns = XEN_TO_C_INT(chans);
- else
- {
- chns = mus_sound_chans(filename);
- if (chns == MUS_ERROR)
- chns = 1;
- }
- if (chns > 0)
- {
- mus_long_t dloc;
- if (XEN_INT64_T_P(data_loc))
- dloc = XEN_TO_C_INT64_T(data_loc);
- else
- {
- dloc = mus_sound_data_location(filename);
- if (dloc == MUS_ERROR)
- dloc = 0;
- }
- fd = mus_sound_reopen_output(filename, chns, df, ht, dloc);
- if (filename) free(filename);
- }
- else XEN_OUT_OF_RANGE_ERROR(S_mus_sound_reopen_output, 2, chans, "chans <= 0?");
+ int i, chans;
+ mus_float_t **bufs;
+ mus_long_t framples;
+ chans = mus_sound_chans(str);
+ framples = mus_sound_framples(str) + 8; /* + 8 for readers than wander off the end */
+ bufs = (mus_float_t **)malloc(chans * sizeof(mus_float_t *));
+ for (i = 0; i < chans; i++)
+ bufs[i] = (mus_float_t *)malloc(framples * sizeof(mus_float_t));
+
+ mus_file_seek_frample(ifd, 0);
+ mus_file_read_file(ifd, 0, chans, framples, bufs);
+ mus_sound_set_saved_data(str, bufs);
+ mus_sound_close_input(ifd);
}
- else XEN_OUT_OF_RANGE_ERROR(S_mus_sound_reopen_output, 4, header_type, "~A: invalid header type");
- }
- else XEN_OUT_OF_RANGE_ERROR(S_mus_sound_reopen_output, 3, data_format, "~A: invalid data format");
- return(C_TO_XEN_INT(fd));
-}
-
-
-#if (!HAVE_UNISTD_H) || (_MSC_VER)
-#ifndef STDIN_FILENO
-#define STDIN_FILENO 0
-#endif
-#ifndef STDOUT_FILENO
-#define STDOUT_FILENO 1
-#endif
-#ifndef STDERR_FILENO
-#define STDERR_FILENO 2
-#endif
-#endif
-
-static XEN g_mus_sound_close_input(XEN fd)
-{
- #define H_mus_sound_close_input "(" S_mus_sound_close_input " fd): close (low-level) file fd that was opened \
-by " S_mus_sound_open_input "."
- int nfd;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ONLY_ARG, S_mus_sound_close_input, "an integer");
- nfd = XEN_TO_C_INT(fd);
- if ((nfd < 0) || (nfd == STDIN_FILENO) || (nfd == STDOUT_FILENO) || (nfd == STDERR_FILENO))
- XEN_OUT_OF_RANGE_ERROR(S_mus_sound_close_input, 1, fd, "~A: invalid file number");
- return(C_TO_XEN_INT(mus_sound_close_input(XEN_TO_C_INT(fd))));
-}
-
-
-static XEN g_mus_sound_close_output(XEN fd, XEN bytes)
-{
- #define H_mus_sound_close_output "(" S_mus_sound_close_output " fd bytes): close (low-level) file fd \
-that was opened by " S_mus_sound_open_output " after updating its header (if any) to reflect bytes, the new file data size"
-
- int nfd;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ARG_1, S_mus_sound_close_output, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(bytes), bytes, XEN_ARG_2, S_mus_sound_close_output, "a number");
- nfd = XEN_TO_C_INT(fd);
- if ((nfd < 0) || (nfd == STDIN_FILENO) || (nfd == STDOUT_FILENO) || (nfd == STDERR_FILENO))
- XEN_OUT_OF_RANGE_ERROR(S_mus_sound_close_output, 1, fd, "~A: invalid file number");
- return(C_TO_XEN_INT(mus_sound_close_output(XEN_TO_C_INT(fd),
- XEN_TO_C_INT64_T_OR_ELSE(bytes, 0))));
-}
-
-
-static XEN g_mus_sound_read(XEN fd, XEN beg, XEN end, XEN chans, XEN sv)
-{
- #define H_mus_sound_read "(" S_mus_sound_read " fd beg end chans sdata): read sound data from file fd, \
-filling sound-data sdata's buffers starting at beg (buffer location), going to end"
-
- sound_data *sd;
- mus_long_t bg, nd;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ARG_1, S_mus_sound_read, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(beg), beg, XEN_ARG_2, S_mus_sound_read, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(end), end, XEN_ARG_3, S_mus_sound_read, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chans), chans, XEN_ARG_4, S_mus_sound_read, "an integer");
- XEN_ASSERT_TYPE(sound_data_p(sv), sv, XEN_ARG_5, S_mus_sound_read, "a sound-data object");
-
- sd = XEN_TO_SOUND_DATA(sv);
- bg = XEN_TO_C_INT64_T(beg);
- nd = XEN_TO_C_INT64_T(end);
- if ((nd - bg) >= sd->length)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_4(C_TO_XEN_STRING(S_mus_sound_read ": end - beg (~A - ~A) >= sound-data array length, ~A"),
- end,
- beg,
- C_TO_XEN_INT64_T(sd->length)));
-
-#if SNDLIB_USE_FLOATS
- return(C_TO_XEN_INT(mus_file_read(XEN_TO_C_INT(fd), bg, nd, XEN_TO_C_INT(chans), sd->data)));
-#else
- {
- mus_sample_t **sdata;
- int i;
- mus_long_t j, result;
- sdata = (mus_sample_t **)calloc(sd->chans, sizeof(mus_sample_t *));
- for (i = 0; i < sd->chans; i++) sdata[i] = (mus_sample_t *)calloc(sd->length, sizeof(mus_sample_t));
- result = mus_file_read(XEN_TO_C_INT(fd), bg, nd, XEN_TO_C_INT(chans), sdata);
- for (i = 0; i < sd->chans; i++)
- for (j = 0; j < sd->length; j++)
- sd->data[i][j] = MUS_SAMPLE_TO_DOUBLE(sdata[i][j]);
- for (i = 0; i < sd->chans; i++)
- free(sdata[i]);
- free(sdata);
- return(C_TO_XEN_INT(result));
- }
-#endif
-}
-
-
-static XEN g_mus_sound_write(XEN fd, XEN beg, XEN end, XEN chans, XEN sv)
-{
- #define H_mus_sound_write "(" S_mus_sound_write " fd beg end chans sdata): write sound-data sdata's data to file fd, \
-starting at beg (buffer location), going to end"
-
- sound_data *sd;
- mus_long_t bg, nd;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ARG_1, S_mus_sound_write, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(beg), beg, XEN_ARG_2, S_mus_sound_write, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(end), end, XEN_ARG_3, S_mus_sound_write, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chans), chans, XEN_ARG_4, S_mus_sound_write, "an integer");
- XEN_ASSERT_TYPE(sound_data_p(sv), sv, XEN_ARG_5, S_mus_sound_write, "a sound-data object");
-
- /* even here we can write memory that doesn't belong to us if clipping */
- sd = XEN_TO_SOUND_DATA(sv);
- bg = XEN_TO_C_INT64_T(beg);
- nd = XEN_TO_C_INT64_T(end);
- if ((nd - bg) >= sd->length)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_4(C_TO_XEN_STRING(S_mus_sound_write ": end - beg (~A - ~A) >= sound-data array length, ~A"),
- end,
- beg,
- C_TO_XEN_INT64_T(sd->length)));
-
-#if SNDLIB_USE_FLOATS
- return(C_TO_XEN_INT(mus_file_write(XEN_TO_C_INT(fd), bg, nd, XEN_TO_C_INT(chans), sd->data)));
-#else
- {
- mus_sample_t **sdata;
- int i;
- mus_long_t j, result;
- sdata = (mus_sample_t **)calloc(sd->chans, sizeof(mus_sample_t *));
- for (i = 0; i < sd->chans; i++)
- sdata[i] = (mus_sample_t *)calloc(sd->length, sizeof(mus_sample_t));
- for (i = 0; i < sd->chans; i++)
- for (j = 0; j < sd->length; j++)
- sdata[i][j] = MUS_DOUBLE_TO_SAMPLE(sd->data[i][j]);
- result = mus_file_write(XEN_TO_C_INT(fd), bg, nd, XEN_TO_C_INT(chans), sdata);
- for (i = 0; i < sd->chans; i++)
- free(sdata[i]);
- free(sdata);
- return(C_TO_XEN_INT(result));
- }
-#endif
-}
-
-
-static XEN g_mus_sound_seek_frame(XEN fd, XEN offset)
-{
- #define H_mus_sound_seek_frame "(" S_mus_sound_seek_frame " fd frame): move the current read/write location in file fd \
-to the frame offset"
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ARG_1, S_mus_sound_seek_frame, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(offset), offset, XEN_ARG_2, S_mus_sound_seek_frame, "an integer");
- return(C_TO_XEN_INT64_T(mus_file_seek_frame(XEN_TO_C_INT(fd),
- XEN_TO_C_INT64_T(offset))));
-}
-
-
-/* since mus-audio-read|write assume sound-data vectors communicating with Scheme,
- * we can't assume that the user has had a chance to deal with type problems.
- * So, we keep track of each audio line's current read|write format and
- * translate in mus_audio_read|write if necessary
- */
-
-static int audio_io_size = 0;
-static int *audio_io_lines = NULL;
-static int *audio_io_formats = NULL;
-
-int mus_audio_io_format(int line);
-int mus_audio_io_format(int line)
-{
- int i;
- for (i = 0; i < audio_io_size; i++)
- if (audio_io_lines[i] == line)
- return(audio_io_formats[i]);
- return(MUS_UNKNOWN);
-}
-
-
-#define audio_io_read_format(Line) (mus_audio_io_format(Line) & 0xffff)
-#define audio_io_write_format(Line) (mus_audio_io_format(Line) >> 16)
-
-static void audio_io_set_format(int line, int format)
-{
- int i, old_size;
-
- for (i = 0; i < audio_io_size; i++)
- if (audio_io_lines[i] == line)
- {
- audio_io_formats[i] = format;
- return;
- }
-
- /* we get here if the table is not big enough */
- old_size = audio_io_size;
- audio_io_size += 8;
- if (old_size == 0)
- {
- audio_io_lines = (int *)malloc(audio_io_size * sizeof(int));
- audio_io_formats = (int *)malloc(audio_io_size * sizeof(int));
- }
- else
- {
- audio_io_lines = (int *)realloc(audio_io_lines, audio_io_size * sizeof(int));
- audio_io_formats = (int *)realloc(audio_io_formats, audio_io_size * sizeof(int));
- }
- for (i = old_size + 1; i < audio_io_size; i++)
- {
- audio_io_lines[i] = -1;
- audio_io_formats[i] = MUS_UNKNOWN;
+ free(str);
}
- audio_io_lines[old_size] = line;
- audio_io_formats[old_size] = format;
-}
-
-
-#define audio_io_set_read_format(Line, Format) audio_io_set_format(Line, ((mus_audio_io_format(Line) & 0xffff0000) | Format))
-#define audio_io_set_write_format(Line, Format) audio_io_set_format(Line, ((mus_audio_io_format(Line) & 0xffff) | (Format << 16)))
-
-
-static XEN g_mus_audio_open_output(XEN dev, XEN srate, XEN chans, XEN format, XEN size)
-{
- #if HAVE_SCHEME
- #define audio_open_example "(" S_mus_audio_open_output " " S_mus_audio_default " 22050 1 " S_mus_lshort " 256)"
- #endif
- #if HAVE_RUBY
- #define audio_open_example "mus_audio_open_output(Mus_audio_default, 22050, 1, Mus_lshort, 256)"
- #endif
- #if HAVE_FORTH
- #define audio_open_example "mus-audio-default 22050 1 mus-lshort 256 mus-audio-open-output"
- #endif
-
- #define H_mus_audio_open_output "(" S_mus_audio_open_output " device srate chans format bytes): \
-open the audio device ready for output at the given srate and so on; \
-return the audio line number:\n " audio_open_example
-
- int line, idev, ifmt, isize, israte, ichans;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(dev), dev, XEN_ARG_1, S_mus_audio_open_output, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(srate), srate, XEN_ARG_2, S_mus_audio_open_output, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chans), chans, XEN_ARG_3, S_mus_audio_open_output, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(format), format, XEN_ARG_4, S_mus_audio_open_output, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(size), size, XEN_ARG_5, S_mus_audio_open_output, "a number");
-
- idev = XEN_TO_C_INT(dev);
- israte = XEN_TO_C_INT_OR_ELSE(srate, 0);
- ichans = XEN_TO_C_INT(chans);
- ifmt = XEN_TO_C_INT(format);
- isize = XEN_TO_C_INT_OR_ELSE(size, 0);
-
- if (!(mus_data_format_p(ifmt)))
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_open_output, 4, format, "~A: invalid data format");
- if (isize < 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_open_output, 5, size, "size ~A < 0?");
- if (israte <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_open_output, 2, srate, "srate ~A <= 0?");
- if ((ichans <= 0) || (ichans > 256))
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_open_output, 3, chans, "chans ~A <= 0 or > 256?");
-
- line = mus_audio_open_output(idev, israte, ichans, ifmt, isize);
- audio_io_set_write_format(line, ifmt);
- return(C_TO_XEN_INT(line));
-}
-
-
-static XEN g_mus_audio_open_input(XEN dev, XEN srate, XEN chans, XEN format, XEN size)
-{
- #define H_mus_audio_open_input "(" S_mus_audio_open_input " (device srate chans format bufsize): \
-open the audio device ready for input with the indicated attributes; return the audio line number"
-
- int line, idev, ifmt, isize, israte, ichans;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(dev), dev, XEN_ARG_1, S_mus_audio_open_input, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(srate), srate, XEN_ARG_2, S_mus_audio_open_input, "a number");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chans), chans, XEN_ARG_3, S_mus_audio_open_input, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(format), format, XEN_ARG_4, S_mus_audio_open_input, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(size), size, XEN_ARG_5, S_mus_audio_open_input, "a number");
-
- idev = XEN_TO_C_INT(dev);
- israte = XEN_TO_C_INT_OR_ELSE(srate, 0);
- ichans = XEN_TO_C_INT(chans);
- ifmt = XEN_TO_C_INT(format);
- isize = XEN_TO_C_INT_OR_ELSE(size, 0);
-
- if (!(mus_data_format_p(ifmt)))
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_open_input, 4, format, "~A: invalid data format");
- if (isize < 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_open_input, 5, size, "size ~A < 0?");
- if (israte <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_open_input, 2, srate, "srate ~A <= 0?");
- if (ichans <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_open_input, 3, chans, "chans ~A <= 0?");
-
- line = mus_audio_open_input(idev, israte, ichans, ifmt, isize);
- audio_io_set_read_format(line, ifmt);
- return(C_TO_XEN_INT(line));
+ return(file);
}
-static XEN g_mus_audio_close(XEN line)
-{
- int res;
- #define H_mus_audio_close "(" S_mus_audio_close " line): close the audio hardware line"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(line), line, XEN_ONLY_ARG, S_mus_audio_close, "an integer");
- res = mus_audio_close(XEN_TO_C_INT(line));
- return(C_TO_XEN_INT(res));
-}
-
-
-/* these take a sndlib buffer (sound_data) and handle the conversion to the interleaved char* internally */
-/* so, they take "frames", not "bytes", and a sound_data object, not char* etc */
-
-static XEN g_mus_audio_write(XEN line, XEN sdata, XEN frames, XEN start)
-{
- #define H_mus_audio_write "(" S_mus_audio_write " line sdata frames (start 0)): write frames of data (channels * frames = samples) \
-to the audio line from sound-data sdata."
-
- char *obuf;
- sound_data *sd;
- int outbytes, val, fmt, fd;
- mus_long_t frms, beg = 0;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(line), line, XEN_ARG_1, S_mus_audio_write, "an integer");
- XEN_ASSERT_TYPE(sound_data_p(sdata), sdata, XEN_ARG_2, S_mus_audio_write, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(frames), frames, XEN_ARG_3, S_mus_audio_write, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(start) || XEN_NOT_BOUND_P(start), start, XEN_ARG_4, S_mus_audio_write, "an integer");
-
- sd = XEN_TO_SOUND_DATA(sdata);
- frms = XEN_TO_C_INT64_T(frames);
- if (frms > sd->length)
- XEN_OUT_OF_RANGE_ERROR(S_mus_audio_write, 3, frames, "frames ~A > sound-data buffer length");
- if (XEN_BOUND_P(start))
- beg = XEN_TO_C_INT64_T(start);
-
- fd = XEN_TO_C_INT(line);
- fmt = audio_io_write_format(fd);
- outbytes = frms * sd->chans * mus_bytes_per_sample(fmt);
- obuf = (char *)calloc(outbytes, sizeof(char));
-#if SNDLIB_USE_FLOATS
- mus_file_write_buffer(fmt, beg, beg + frms - 1, sd->chans, sd->data, obuf, true); /* true -> clipped */
-#else
- {
- mus_sample_t **sdata;
- int i;
- mus_long_t j;
- sdata = (mus_sample_t **)calloc(sd->chans, sizeof(mus_sample_t *));
- for (i = 0; i < sd->chans; i++)
- sdata[i] = (mus_sample_t *)calloc(sd->length, sizeof(mus_sample_t));
- for (i = 0; i < sd->chans; i++)
- for (j = 0; j < sd->length; j++)
- sdata[i][j] = MUS_DOUBLE_TO_SAMPLE(sd->data[i][j]);
- mus_file_write_buffer(fmt, 0, frms - 1, sd->chans, sdata, obuf, true);
- for (i = 0; i < sd->chans; i++)
- free(sdata[i]);
- free(sdata);
- }
-#endif
- val = mus_audio_write(fd, obuf, outbytes);
- free(obuf);
- return(C_TO_XEN_INT(val));
-}
-
+/* global default clipping values */
-static XEN g_mus_audio_read(XEN line, XEN sdata, XEN frames)
-{
- #define H_mus_audio_read "(" S_mus_audio_read " line sdata frames): read frames of data (channels * frames = samples) \
-from the audio line into sound-data sdata."
-
- char *inbuf;
- sound_data *sd;
- int val, inbytes, fd, fmt;
- mus_long_t frms;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(line), line, XEN_ARG_1, S_mus_audio_read, "an integer");
- XEN_ASSERT_TYPE(sound_data_p(sdata), sdata, XEN_ARG_2, S_mus_audio_read, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(frames), frames, XEN_ARG_3, S_mus_audio_read, "an integer");
-
- sd = XEN_TO_SOUND_DATA(sdata);
- frms = XEN_TO_C_INT64_T(frames);
- fd = XEN_TO_C_INT(line);
- fmt = audio_io_read_format(fd);
- inbytes = frms * sd->chans * mus_bytes_per_sample(fmt);
- inbuf = (char *)calloc(inbytes, sizeof(char));
- val = mus_audio_read(fd, inbuf, inbytes);
-#if SNDLIB_USE_FLOATS
- mus_file_read_buffer(fmt, 0, sd->chans, frms, sd->data, inbuf); /* frms here because this is "nints" not "end"! */
-#else
- {
- mus_sample_t **sdata;
- int i;
- mus_long_t j;
- sdata = (mus_sample_t **)calloc(sd->chans, sizeof(mus_sample_t *));
- for (i = 0; i < sd->chans; i++) sdata[i] = (mus_sample_t *)calloc(sd->length, sizeof(mus_sample_t));
- mus_file_read_buffer(fmt, 0, sd->chans, frms, sdata, inbuf);
- for (i = 0; i < sd->chans; i++)
- for (j = 0; j < sd->length; j++)
- sd->data[i][j] = MUS_SAMPLE_TO_DOUBLE(sdata[i][j]);
- for (i = 0; i < sd->chans; i++)
- free(sdata[i]);
- free(sdata);
- }
-#endif
- free(inbuf);
- return(C_TO_XEN_INT(val));
-}
-
-
-/* global default clipping and prescaler values */
-
-static XEN g_mus_clipping(void)
+static Xen g_mus_clipping(void)
{
#define H_mus_clipping "(" S_mus_clipping "): whether sound data written to a file should be clipped"
- return(C_TO_XEN_BOOLEAN(mus_clipping()));
-}
-
-
-static XEN g_mus_set_clipping(XEN clipped)
-{
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(clipped), clipped, XEN_ONLY_ARG, S_setB S_mus_clipping, "a boolean");
- return(C_TO_XEN_BOOLEAN(mus_set_clipping(XEN_TO_C_BOOLEAN(clipped))));
+ return(C_bool_to_Xen_boolean(mus_clipping()));
}
-static XEN g_mus_prescaler(void)
+static Xen g_mus_set_clipping(Xen clipped)
{
- #define H_mus_prescaler "(" S_mus_prescaler "): default prescaler (normally 1.0)"
- return(C_TO_XEN_DOUBLE(mus_prescaler()));
+ Xen_check_type(Xen_is_boolean(clipped), clipped, 1, S_set S_mus_clipping, "a boolean");
+ return(C_bool_to_Xen_boolean(mus_set_clipping(Xen_boolean_to_C_bool(clipped))));
}
-static XEN g_mus_set_prescaler(XEN val)
-{
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_mus_prescaler, "a number");
- return(C_TO_XEN_DOUBLE(mus_set_prescaler(XEN_TO_C_DOUBLE(val))));
-}
-
-
-/* file local clipping and prescaler values */
+/* file local clipping values */
-static XEN g_mus_file_clipping(XEN fd)
+static Xen g_mus_file_clipping(Xen fd)
{
#define H_mus_file_clipping "(" S_mus_file_clipping " fd): whether sound data written to file 'fd' should be clipped"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ONLY_ARG, S_mus_file_clipping, "an integer");
- return(C_TO_XEN_BOOLEAN(mus_file_clipping(XEN_TO_C_INT(fd))));
-}
-
-
-static XEN g_mus_file_set_clipping(XEN fd, XEN clipped)
-{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ARG_1, S_setB S_mus_file_clipping, "an integer");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(clipped), clipped, XEN_ARG_2, S_setB S_mus_file_clipping, "a boolean");
- return(C_TO_XEN_BOOLEAN(mus_file_set_clipping(XEN_TO_C_INT(fd), XEN_TO_C_BOOLEAN(clipped))));
+ Xen_check_type(Xen_is_integer(fd), fd, 1, S_mus_file_clipping, "an integer");
+ return(C_bool_to_Xen_boolean(mus_file_clipping(Xen_integer_to_C_int(fd))));
}
-static XEN g_mus_file_prescaler(XEN fd)
+static Xen g_mus_file_set_clipping(Xen fd, Xen clipped)
{
- #define H_mus_file_prescaler "(" S_mus_file_prescaler " fd): prescaler associated with file 'fd'"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ONLY_ARG, S_mus_file_prescaler, "an integer");
- return(C_TO_XEN_DOUBLE(mus_file_prescaler(XEN_TO_C_INT(fd))));
+ Xen_check_type(Xen_is_integer(fd), fd, 1, S_set S_mus_file_clipping, "an integer");
+ Xen_check_type(Xen_is_boolean(clipped), clipped, 2, S_set S_mus_file_clipping, "a boolean");
+ return(C_bool_to_Xen_boolean(mus_file_set_clipping(Xen_integer_to_C_int(fd), Xen_boolean_to_C_bool(clipped))));
}
-static XEN g_mus_file_set_prescaler(XEN fd, XEN val)
-{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(fd), fd, XEN_ARG_1, S_setB S_mus_file_prescaler, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_1, S_setB S_mus_prescaler, "a number");
- return(C_TO_XEN_DOUBLE(mus_file_set_prescaler(XEN_TO_C_INT(fd), XEN_TO_C_DOUBLE(val))));
-}
-
-XEN g_mus_expand_filename(XEN file)
+Xen g_mus_expand_filename(Xen file)
{
#define H_mus_expand_filename "(" S_mus_expand_filename " name): expand 'name' into a canonical or absolute filename, that is, \
one in which all directories in the path are explicit."
char *str = NULL;
- XEN result;
+ Xen result;
- XEN_ASSERT_TYPE(XEN_STRING_P(file), file, XEN_ONLY_ARG, S_mus_expand_filename, "a string");
- str = mus_expand_filename(XEN_TO_C_STRING(file));
- result = C_TO_XEN_STRING(str);
+ Xen_check_type(Xen_is_string(file), file, 1, S_mus_expand_filename, "a string");
+ str = mus_expand_filename(Xen_string_to_C_string(file));
+ result = C_string_to_Xen_string(str);
if (str) free(str);
return(result);
}
-static XEN g_mus_sound_report_cache(XEN file)
+static Xen g_mus_sound_report_cache(Xen file)
{
#define H_mus_sound_report_cache "(" S_mus_sound_report_cache " (name)): print the current sound \
cache info to the file given or stdout"
+ const char *name;
+
+ if (!Xen_is_bound(file))
+ {
+ mus_sound_report_cache(stdout);
+ return(Xen_false);
+ }
- XEN res = XEN_FALSE;
- if (XEN_NOT_BOUND_P(file))
- mus_sound_report_cache(stdout);
- else
+ Xen_check_type(Xen_is_string(file), file, 1, S_mus_sound_report_cache, "a string");
+ name = Xen_string_to_C_string(file);
+ if (name)
{
- FILE *fd;
- const char *name;
char *str = NULL;
- name = XEN_TO_C_STRING(file);
- fd = FOPEN(str = mus_expand_filename(name), "w");
- if (str) free(str);
- if (fd)
- {
- mus_sound_report_cache(fd);
- FCLOSE(fd, name);
- }
- else
+ str = mus_expand_filename(name);
+ if (str)
{
- XEN_ERROR(XEN_ERROR_TYPE("cannot-save"),
- XEN_LIST_3(C_TO_XEN_STRING(S_mus_sound_report_cache ": ~S ~A"),
- file,
- C_TO_XEN_STRING(STRERROR(errno))));
+ FILE *fd;
+ fd = FOPEN(str, "w");
+ free(str);
+ if (fd)
+ {
+ mus_sound_report_cache(fd);
+ FCLOSE(fd, name);
+ return(file);
+ }
}
- return(file);
}
- return(res);
+
+ Xen_error(Xen_make_error_type("cannot-save"),
+ Xen_list_3(C_string_to_Xen_string(S_mus_sound_report_cache ": ~S ~A"),
+ file,
+ C_string_to_Xen_string(STRERROR(errno))));
+ return(Xen_false);
}
-static XEN g_mus_error_type_to_string(XEN err)
+static Xen g_mus_error_type_to_string(Xen err)
{
#define H_mus_error_type_to_string "(" S_mus_error_type_to_string " err): string description of err (a sndlib error type)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(err), err, XEN_ONLY_ARG, S_mus_error_type_to_string, "an integer");
- return(C_TO_XEN_STRING((char *)mus_error_type_to_string(XEN_TO_C_INT(err))));
+ Xen_check_type(Xen_is_integer(err), err, 1, S_mus_error_type_to_string, "an integer");
+ return(C_string_to_Xen_string((char *)mus_error_type_to_string(Xen_integer_to_C_int(err))));
}
-static XEN g_array_to_file(XEN filename, XEN data, XEN len, XEN srate, XEN channels)
+static Xen g_array_to_file(Xen filename, Xen data, Xen len, Xen srate, Xen channels)
{
#define H_array_to_file "(" S_array_to_file " filename data len srate channels): write 'data', \
-a vct of interleaved samples, to the sound file 'filename' set up to have the given \
+a " S_vct " of interleaved samples, to the sound file 'filename' set up to have the given \
srate and channels. 'len' samples are written."
/* this exists for compatibility with the Common Lisp version of CLM. Ideally, we'd get rid
@@ -1351,1453 +825,446 @@ srate and channels. 'len' samples are written."
mus_long_t olen, samps;
vct *v;
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ARG_1, S_array_to_file, "a string");
- XEN_ASSERT_TYPE(MUS_VCT_P(data), data, XEN_ARG_2, S_array_to_file, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(len), len, XEN_ARG_3, S_array_to_file, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(srate), srate, XEN_ARG_4, S_array_to_file, "an integer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(channels), channels, XEN_ARG_5, S_array_to_file, "an integer");
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_array_to_file, "a string");
+ Xen_check_type(mus_is_vct(data), data, 2, S_array_to_file, "a " S_vct);
+ Xen_check_type(Xen_is_llong(len), len, 3, S_array_to_file, "an integer");
+ Xen_check_type(Xen_is_integer(srate), srate, 4, S_array_to_file, "an integer");
+ Xen_check_type(Xen_is_integer(channels), channels, 5, S_array_to_file, "an integer");
- v = XEN_TO_VCT(data);
- samps = XEN_TO_C_INT64_T(len);
+ v = Xen_to_vct(data);
+ samps = Xen_llong_to_C_llong(len);
if (samps <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_array_to_file, 3, len, "samples ~A <= 0?");
- if (samps > v->length)
- samps = v->length;
+ Xen_out_of_range_error(S_array_to_file, 3, len, "samples <= 0?");
+ if (samps > mus_vct_length(v))
+ samps = mus_vct_length(v);
- olen = mus_float_array_to_file(XEN_TO_C_STRING(filename),
- v->data,
+ olen = mus_float_array_to_file(Xen_string_to_C_string(filename),
+ mus_vct_data(v),
samps,
- XEN_TO_C_INT(srate),
- XEN_TO_C_INT(channels));
- return(C_TO_XEN_INT64_T(olen));
+ Xen_integer_to_C_int(srate),
+ Xen_integer_to_C_int(channels));
+ return(C_llong_to_Xen_llong(olen));
}
-static XEN g_file_to_array(XEN filename, XEN chan, XEN start, XEN samples, XEN data)
+static Xen g_file_to_array(Xen filename, Xen chan, Xen start, Xen samples, Xen data)
{
#define H_file_to_array "(" S_file_to_array " filename chan start samples data): read the sound file \
-'filename' placing samples from channel 'chan' into the vct 'data' starting in the file \
-at frame 'start' and reading 'samples' samples altogether."
+'filename' placing samples from channel 'chan' into the " S_vct " 'data' starting in the file \
+at frample 'start' and reading 'samples' samples altogether."
- int chn;
+ int chn, chans;
mus_long_t samps;
vct *v;
const char *name = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(filename), filename, XEN_ARG_1, S_file_to_array, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_2, S_file_to_array, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(start), start, XEN_ARG_3, S_file_to_array, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(samples), samples, XEN_ARG_4, S_file_to_array, "an integer");
- XEN_ASSERT_TYPE((MUS_VCT_P(data)), data, XEN_ARG_5, S_file_to_array, "a vct");
+ Xen_check_type(Xen_is_string(filename), filename, 1, S_file_to_array, "a string");
+ Xen_check_type(Xen_is_integer(chan), chan, 2, S_file_to_array, "an integer");
+ Xen_check_type(Xen_is_llong(start), start, 3, S_file_to_array, "an integer");
+ Xen_check_type(Xen_is_llong(samples), samples, 4, S_file_to_array, "an integer");
+ Xen_check_type((mus_is_vct(data)), data, 5, S_file_to_array, "a " S_vct);
- name = XEN_TO_C_STRING(filename);
+ name = Xen_string_to_C_string(filename);
if (!(mus_file_probe(name)))
- XEN_ERROR(NO_SUCH_FILE,
- XEN_LIST_3(C_TO_XEN_STRING(S_file_to_array ": ~S ~A"),
+ Xen_error(NO_SUCH_FILE,
+ Xen_list_3(C_string_to_Xen_string(S_file_to_array ": ~S ~A"),
filename,
- C_TO_XEN_STRING(STRERROR(errno))));
+ C_string_to_Xen_string(STRERROR(errno))));
- v = XEN_TO_VCT(data);
+ v = Xen_to_vct(data);
- samps = XEN_TO_C_INT64_T(samples);
+ samps = Xen_llong_to_C_llong(samples);
if (samps <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_file_to_array, 4, samples, "samples ~A <= 0?");
- if (samps > v->length)
- samps = v->length;
-
- chn = XEN_TO_C_INT(chan);
- if ((chn < 0) || (chn > mus_sound_chans(name)))
- XEN_ERROR(NO_SUCH_CHANNEL,
- XEN_LIST_4(C_TO_XEN_STRING(S_file_to_array ": invalid chan: ~A, ~S has ~A chans"),
+ Xen_out_of_range_error(S_file_to_array, 4, samples, "samples <= 0?");
+ if (samps > mus_vct_length(v))
+ samps = mus_vct_length(v);
+
+ chn = Xen_integer_to_C_int(chan);
+ chans = mus_sound_chans(name);
+ if ((chn < 0) || (chn > chans))
+ Xen_error(NO_SUCH_CHANNEL,
+ Xen_list_4(C_string_to_Xen_string(S_file_to_array ": invalid chan: ~A, ~S has ~A chans"),
chan,
filename,
- C_TO_XEN_INT(mus_sound_chans(name))));
+ C_int_to_Xen_integer(chans)));
- if (mus_sound_chans(name) <= 0)
- XEN_ERROR(BAD_HEADER,
- XEN_LIST_2(C_TO_XEN_STRING(S_file_to_array ": ~S chans <= 0"),
+ if (chans <= 0)
+ Xen_error(BAD_HEADER,
+ Xen_list_2(C_string_to_Xen_string(S_file_to_array ": ~S chans <= 0"),
filename));
- mus_file_to_float_array(name, chn, XEN_TO_C_INT64_T(start), samps, v->data);
+ mus_file_to_float_array(name, chn, Xen_llong_to_C_llong(start), samps, mus_vct_data(v));
return(data);
}
-static XEN new_sound_hook;
+static Xen new_sound_hook;
static void g_new_sound_hook(const char *filename)
{
- if (XEN_HOOKED(new_sound_hook))
+ if (Xen_hook_has_list(new_sound_hook))
{
#if HAVE_SCHEME
- int gc_loc;
+ s7_call(s7, new_sound_hook, s7_cons(s7, C_string_to_Xen_string(filename), Xen_empty_list));
+#else
+ Xen procs, fname;
+ fname = C_string_to_Xen_string(filename);
+ procs = Xen_hook_list(new_sound_hook);
+ while (!Xen_is_null(procs))
+ {
+ Xen_call_with_1_arg(Xen_car(procs), fname, S_new_sound_hook);
+ procs = Xen_cdr(procs);
+ }
#endif
- XEN procs = XEN_HOOK_PROCEDURES(new_sound_hook);
- XEN fname;
+ }
+}
+
+
+static Xen sound_path;
+Xen g_mus_sound_path(void)
+{
+ #define H_mus_sound_path "(" S_mus_sound_path "): a list of directories to search for sound files."
+ return(sound_path);
+}
- fname = C_TO_XEN_STRING(filename);
#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, fname);
+ static int sound_path_loc = -1;
+ static s7_pointer mus_sound_path_symbol;
#endif
- while (XEN_NOT_NULL_P(procs))
- {
- XEN_CALL_1(XEN_CAR(procs),
- fname,
- S_new_sound_hook);
- procs = XEN_CDR (procs);
- }
+static Xen g_mus_set_sound_path(Xen val)
+{
+ Xen_check_type(Xen_is_list(val), val, 1, S_set S_mus_sound_path, "a list");
#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
+ if (sound_path_loc != -1)
+ s7_gc_unprotect_at(s7, sound_path_loc);
+ sound_path = val;
+ sound_path_loc = s7_gc_protect(s7, sound_path);
+ s7_symbol_set_value(s7, mus_sound_path_symbol, val);
+#else
+ if (sound_path != Xen_empty_list)
+ Xen_GC_unprotect(sound_path);
+ Xen_GC_protect(val);
+ sound_path = val;
#endif
- }
+ return(val);
}
-#if HAVE_OSS
-#define S_mus_audio_reinitialize "mus-audio-reinitialize"
-static XEN g_mus_audio_reinitialize(void)
+static Xen g_mus_max_malloc(void)
{
- #define H_mus_audio_reinitialize "(" S_mus_audio_reinitialize "): force audio device re-initialization"
- return(C_TO_XEN_INT(mus_audio_reinitialize()));
+ #define H_mus_max_malloc "(" S_mus_max_malloc "): maximum number of bytes we will try to malloc."
+ return(C_llong_to_Xen_llong(mus_max_malloc()));
}
-#endif
-
+#if HAVE_SCHEME
+ static s7_pointer mus_max_malloc_symbol;
+#endif
-static XEN_OBJECT_TYPE sound_data_tag = 0;
+static Xen g_mus_set_max_malloc(Xen val)
+{
+ mus_long_t size;
+ Xen_check_type(Xen_is_llong(val), val, 1, S_set S_mus_max_malloc, "an integer");
+ size = Xen_llong_to_C_llong(val);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, mus_max_malloc_symbol, s7_make_integer(s7, size));
+#endif
+ return(C_llong_to_Xen_llong(mus_set_max_malloc(size)));
+}
-bool sound_data_p(XEN obj) {return(XEN_OBJECT_TYPE_P(obj, sound_data_tag));}
-#define SOUND_DATA_P(Obj) XEN_OBJECT_TYPE_P(Obj, sound_data_tag)
-static XEN g_sound_data_p(XEN obj)
+static Xen g_mus_max_table_size(void)
{
- #define H_sound_data_p "(" S_sound_data_p " obj): is 'obj' is a sound-data object"
- return(C_TO_XEN_BOOLEAN(sound_data_p(obj)));
+ #define H_mus_max_table_size "(" S_mus_max_table_size "): maximum table size."
+ return(C_llong_to_Xen_llong(mus_max_table_size()));
}
-void sound_data_free(sound_data *sd)
+#if HAVE_SCHEME
+ static s7_pointer mus_max_table_size_symbol;
+#endif
+
+static Xen g_mus_set_max_table_size(Xen val)
{
- if (sd)
- {
- if ((sd->data) && (!(sd->wrapped)))
- {
- int i;
- for (i = 0; i < sd->chans; i++) if (sd->data[i]) free(sd->data[i]);
- free(sd->data);
- }
- sd->data = NULL;
- sd->chans = 0;
- free(sd);
- }
+ mus_long_t size;
+ Xen_check_type(Xen_is_llong(val), val, 1, S_set S_mus_max_table_size, "an integer");
+ size = Xen_llong_to_C_llong(val);
+#if HAVE_SCHEME
+ s7_symbol_set_value(s7, mus_max_table_size_symbol, s7_make_integer(s7, size));
+#endif
+ return(C_llong_to_Xen_llong(mus_set_max_table_size(size)));
}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(sound_data, free_sound_data, sound_data_free)
+#if __APPLE__
+#define S_mus_audio_output_properties_mutable "mus-audio-output-properties-mutable"
+static Xen g_mus_audio_output_properties_mutable(Xen mut)
+{
+ #define H_mus_audio_output_properties_mutable "(" S_mus_audio_output_properties_mutable " val): can DAC settings be changed to match the current sound"
+ Xen_check_type(Xen_is_boolean(mut), mut, 1, S_mus_audio_output_properties_mutable, "a boolean");
+ return(C_bool_to_Xen_boolean(mus_audio_output_properties_mutable(Xen_boolean_to_C_bool(mut))));
+}
+#endif
-char *sound_data_to_string(sound_data *sd)
-{
- char *buf;
- int len, chans; /* len=print length */
- char flt[24];
+Xen_wrap_1_arg(g_mus_sound_samples_w, g_mus_sound_samples)
+Xen_wrap_2_args(g_mus_sound_set_samples_w, g_mus_sound_set_samples)
+Xen_wrap_1_arg(g_mus_sound_framples_w, g_mus_sound_framples)
+Xen_wrap_1_arg(g_mus_sound_duration_w, g_mus_sound_duration)
+Xen_wrap_1_arg(g_mus_sound_datum_size_w, g_mus_sound_datum_size)
+Xen_wrap_1_arg(g_mus_sound_data_location_w, g_mus_sound_data_location)
+Xen_wrap_2_args(g_mus_sound_set_data_location_w, g_mus_sound_set_data_location)
+Xen_wrap_1_arg(g_mus_sound_chans_w, g_mus_sound_chans)
+Xen_wrap_2_args(g_mus_sound_set_chans_w, g_mus_sound_set_chans)
+Xen_wrap_1_arg(g_mus_sound_srate_w, g_mus_sound_srate)
+Xen_wrap_2_args(g_mus_sound_set_srate_w, g_mus_sound_set_srate)
+Xen_wrap_1_arg(g_mus_sound_header_type_w, g_mus_sound_header_type)
+Xen_wrap_2_args(g_mus_sound_set_header_type_w, g_mus_sound_set_header_type)
+Xen_wrap_1_arg(g_mus_sound_sample_type_w, g_mus_sound_sample_type)
+Xen_wrap_2_args(g_mus_sound_set_sample_type_w, g_mus_sound_set_sample_type)
+Xen_wrap_1_arg(g_mus_sound_length_w, g_mus_sound_length)
+Xen_wrap_1_arg(g_mus_sound_type_specifier_w, g_mus_sound_type_specifier)
+Xen_wrap_1_arg(g_mus_header_type_name_w, g_mus_header_type_name)
+Xen_wrap_1_arg(g_mus_header_type_to_string_w, g_mus_header_type_to_string)
+Xen_wrap_1_arg(g_mus_sample_type_name_w, g_mus_sample_type_name)
+Xen_wrap_1_arg(g_mus_sample_type_to_string_w, g_mus_sample_type_to_string)
+Xen_wrap_1_arg(g_mus_sound_comment_w, g_mus_sound_comment)
+Xen_wrap_1_arg(g_mus_sound_write_date_w, g_mus_sound_write_date)
+Xen_wrap_1_arg(g_mus_bytes_per_sample_w, g_mus_bytes_per_sample)
+Xen_wrap_1_arg(g_mus_sound_loop_info_w, g_mus_sound_loop_info)
+Xen_wrap_1_arg(g_mus_sound_mark_info_w, g_mus_sound_mark_info)
+Xen_wrap_1_arg(g_mus_sound_maxamp_w, g_mus_sound_maxamp)
+Xen_wrap_2_args(g_mus_sound_set_maxamp_w, g_mus_sound_set_maxamp)
+Xen_wrap_1_arg(g_mus_sound_maxamp_exists_w, g_mus_sound_maxamp_exists)
+Xen_wrap_1_arg(g_mus_sound_preload_w, g_mus_sound_preload)
+
+Xen_wrap_no_args(g_mus_clipping_w, g_mus_clipping)
+Xen_wrap_1_arg(g_mus_set_clipping_w, g_mus_set_clipping)
+Xen_wrap_1_arg(g_mus_file_clipping_w, g_mus_file_clipping)
+Xen_wrap_2_args(g_mus_file_set_clipping_w, g_mus_file_set_clipping)
+Xen_wrap_no_args(g_mus_header_raw_defaults_w, g_mus_header_raw_defaults)
+Xen_wrap_1_arg(g_mus_header_set_raw_defaults_w, g_mus_header_set_raw_defaults)
+Xen_wrap_2_args(g_mus_header_writable_w, g_mus_header_writable)
+Xen_wrap_1_arg(g_mus_expand_filename_w, g_mus_expand_filename)
+Xen_wrap_1_optional_arg(g_mus_sound_report_cache_w, g_mus_sound_report_cache)
+Xen_wrap_1_arg(g_mus_sound_forget_w, g_mus_sound_forget)
+Xen_wrap_no_args(g_mus_sound_prune_w, g_mus_sound_prune)
+Xen_wrap_1_arg(g_mus_error_type_to_string_w, g_mus_error_type_to_string)
+Xen_wrap_2_args(g_mus_oss_set_buffers_w, g_mus_oss_set_buffers)
+Xen_wrap_5_args(g_array_to_file_w, g_array_to_file)
+Xen_wrap_5_args(g_file_to_array_w, g_file_to_array)
+Xen_wrap_no_args(g_mus_alsa_buffers_w, g_mus_alsa_buffers)
+Xen_wrap_1_arg(g_mus_alsa_set_buffers_w, g_mus_alsa_set_buffers)
+Xen_wrap_no_args(g_mus_alsa_buffer_size_w, g_mus_alsa_buffer_size)
+Xen_wrap_1_arg(g_mus_alsa_set_buffer_size_w, g_mus_alsa_set_buffer_size)
+Xen_wrap_no_args(g_mus_alsa_device_w, g_mus_alsa_device)
+Xen_wrap_1_arg(g_mus_alsa_set_device_w, g_mus_alsa_set_device)
+Xen_wrap_no_args(g_mus_alsa_playback_device_w, g_mus_alsa_playback_device)
+Xen_wrap_1_arg(g_mus_alsa_set_playback_device_w, g_mus_alsa_set_playback_device)
+Xen_wrap_no_args(g_mus_alsa_capture_device_w, g_mus_alsa_capture_device)
+Xen_wrap_1_arg(g_mus_alsa_set_capture_device_w, g_mus_alsa_set_capture_device)
+Xen_wrap_no_args(g_mus_alsa_squelch_warning_w, g_mus_alsa_squelch_warning)
+Xen_wrap_1_arg(g_mus_alsa_set_squelch_warning_w, g_mus_alsa_set_squelch_warning)
+
+#if __APPLE__
+Xen_wrap_1_arg(g_mus_audio_output_properties_mutable_w, g_mus_audio_output_properties_mutable)
+#endif
- if (sd == NULL) return(NULL);
+Xen_wrap_no_args(g_mus_max_malloc_w, g_mus_max_malloc)
+Xen_wrap_1_arg(g_mus_set_max_malloc_w, g_mus_set_max_malloc)
+Xen_wrap_no_args(g_mus_max_table_size_w, g_mus_max_table_size)
+Xen_wrap_1_arg(g_mus_set_max_table_size_w, g_mus_set_max_table_size)
+Xen_wrap_no_args(g_mus_sound_path_w, g_mus_sound_path)
+Xen_wrap_1_arg(g_mus_set_sound_path_w, g_mus_set_sound_path)
- len = mus_vct_print_length();
- if (len > sd->length) len = sd->length;
+#if HAVE_SCHEME
+ static s7_pointer acc_mus_max_table_size(s7_scheme *sc, s7_pointer args) {return(g_mus_set_max_table_size(s7_cadr(args)));}
+ static s7_pointer acc_mus_max_malloc(s7_scheme *sc, s7_pointer args) {return(g_mus_set_max_malloc(s7_cadr(args)));}
+ static s7_pointer acc_mus_sound_path(s7_scheme *sc, s7_pointer args) {return(g_mus_set_sound_path(s7_cadr(args)));}
+#endif
- chans = sd->chans;
- buf = (char *)calloc(64 + len * 24 * chans, sizeof(char));
- sprintf(buf, "#<sound-data[chans=%d, length=" MUS_LD "]:", sd->chans, sd->length);
- if (len > 0)
- {
- int i, chn;
- for (chn = 0; chn < chans; chn++)
- {
- mus_snprintf(flt, 24, "\n (%.3f", sd->data[chn][0]);
- strcat(buf, flt);
- for (i = 1; i < len; i++)
- {
- mus_snprintf(flt, 24, " %.3f", sd->data[chn][i]);
- strcat(buf, flt);
- }
- if (sd->length > mus_vct_print_length())
- strcat(buf, " ...");
- strcat(buf, ")");
- }
- }
- strcat(buf, ">");
- return(buf);
-}
-
-
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(sound_data, print_sound_data, sound_data_to_string)
-
-
-bool sound_data_equalp(sound_data *v1, sound_data *v2)
-{
- if (v1 == v2) return(true);
- if ((v1) && (v2) &&
- (v1->chans == v2->chans) &&
- (v1->length == v2->length))
- {
- int chn;
- for (chn = 0; chn < v1->chans; chn++)
- if (!(mus_arrays_are_equal(v1->data[chn], v2->data[chn],
- mus_float_equal_fudge_factor(),
- v1->length)))
- return(false);
- return(true);
- }
- return(false);
-}
-
-#if HAVE_SCHEME
-static bool s7_equalp_sound_data(void *s1, void *s2)
-{
- return(sound_data_equalp((sound_data *)s1, (sound_data *)s2));
-}
-#else
-
-static XEN equalp_sound_data(XEN obj1, XEN obj2)
-{
-#if HAVE_RUBY || HAVE_FORTH
- if ((!(SOUND_DATA_P(obj1))) || (!(SOUND_DATA_P(obj2)))) return(XEN_FALSE);
-#endif
- return(C_TO_XEN_BOOLEAN(sound_data_equalp(XEN_TO_SOUND_DATA(obj1), XEN_TO_SOUND_DATA(obj2))));
-}
-#endif
-
-static XEN g_sound_data_length(XEN obj)
-{
- #define H_sound_data_length "(" S_sound_data_length " sd): length (in samples) of each channel of sound-data sd"
- sound_data *sd;
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ONLY_ARG, S_sound_data_length, "a sound-data object");
- sd = XEN_TO_SOUND_DATA(obj);
- return(C_TO_XEN_INT64_T(sd->length));
-}
-
-
-static XEN g_sound_data_chans(XEN obj)
-{
- #define H_sound_data_chans "(" S_sound_data_chans " sd): number of channels in sound-data sd"
- sound_data *sd;
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ONLY_ARG, S_sound_data_chans, "a sound-data object");
- sd = XEN_TO_SOUND_DATA(obj);
- return(C_TO_XEN_INT(sd->chans));
-}
-
-
-sound_data *c_make_sound_data(int chans, mus_long_t frames)
-{
- int i;
- sound_data *sd;
-
- sd = (sound_data *)malloc(sizeof(sound_data));
- sd->length = frames;
- sd->chans = chans;
- sd->wrapped = false;
- sd->data = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
- for (i = 0; i < chans; i++)
- sd->data[i] = (mus_float_t *)calloc(frames, sizeof(mus_float_t));
- return(sd);
-}
-
-
-XEN make_sound_data(int chans, mus_long_t frames)
-{
- #define H_make_sound_data "(" S_make_sound_data " chans frames): return a new sound-data object with 'chans' channels, each having 'frames' samples"
- sound_data *sd;
- sd = c_make_sound_data(chans, frames);
- XEN_MAKE_AND_RETURN_OBJECT(sound_data_tag, sd, 0, free_sound_data);
-}
-
-
-XEN wrap_sound_data(int chans, mus_long_t frames, mus_float_t **data)
-{
- sound_data *sd;
- sd = (sound_data *)malloc(sizeof(sound_data));
- sd->length = frames;
- sd->chans = chans;
- sd->wrapped = true;
- sd->data = data;
- XEN_MAKE_AND_RETURN_OBJECT(sound_data_tag, sd, 0, free_sound_data);
-}
-
-
-static XEN g_make_sound_data(XEN chans, XEN frames)
-{
- int chns;
- mus_long_t frms;
-
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chans), chans, XEN_ARG_1, S_make_sound_data, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(frames), frames, XEN_ARG_2, S_make_sound_data, "an integer");
-
- chns = XEN_TO_C_INT(chans);
- if (chns <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_sound_data, 1, chans, "chans ~A <= 0?");
- if (chns > (1 << 26))
- XEN_OUT_OF_RANGE_ERROR(S_make_sound_data, 1, chans, "chans arg ~A too large");
-
- frms = XEN_TO_C_INT64_T(frames);
- if (frms <= 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_sound_data, 2, frames, "frames ~A <= 0?");
- if ((frms > mus_max_malloc()) ||
- (((mus_long_t)(frms * sizeof(mus_float_t))) > mus_max_malloc()))
- XEN_OUT_OF_RANGE_ERROR(S_make_sound_data, 2, frames, "frames arg ~A too large (see mus-max-malloc)");
-
- return(make_sound_data(chns, frms));
-
-}
-
-
-static XEN g_sound_data_ref(XEN obj, XEN chan, XEN frame_num)
-{
- #define H_sound_data_ref "(" S_sound_data_ref " sd chan i): sample in channel chan at location i of sound-data sd: sd[chan][i]"
- sound_data *sd;
- mus_long_t loc;
- int chn;
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ARG_1, S_sound_data_ref, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_2, S_sound_data_ref, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(frame_num), frame_num, XEN_ARG_3, S_sound_data_ref, "an integer");
-
- sd = XEN_TO_SOUND_DATA(obj);
-
- chn = XEN_TO_C_INT(chan);
- if (chn < 0)
- XEN_OUT_OF_RANGE_ERROR(S_sound_data_ref, 2, chan, "~A: invalid channel");
- if (chn >= sd->chans)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_3(C_TO_XEN_STRING(S_sound_data_ref ": chan: ~A >= sound-data chans, ~A"),
- chan,
- C_TO_XEN_INT(sd->chans)));
-
- loc = XEN_TO_C_INT64_T(frame_num);
- if (loc < 0)
- XEN_OUT_OF_RANGE_ERROR(S_sound_data_ref, 3, frame_num, "~A: invalid frame");
- if (loc >= sd->length)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_3(C_TO_XEN_STRING(S_sound_data_ref ": frame: ~A >= sound-data length, ~A"),
- frame_num,
- C_TO_XEN_INT64_T(sd->length)));
-
- return(C_TO_XEN_DOUBLE(sd->data[chn][loc]));
-}
-
-
-XEN g_sound_data_maxamp(XEN obj)
-{
- #define H_sound_data_maxamp "(" S_sound_data_maxamp " sd): list of maxamps of data in sd"
- sound_data *sd;
- int i, chans;
- mus_long_t j, len;
-
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ARG_1, S_sound_data_maxamp, "a sound-data object");
-
- sd = XEN_TO_SOUND_DATA(obj);
- chans = sd->chans;
- len = sd->length;
-
- for (i = chans - 1; i >= 0; i--)
- {
- mus_float_t mx;
- mus_float_t *buf;
- mx = -10000.0;
- buf = sd->data[i];
- for (j = 0; j < len; j++)
- {
- if (buf[j] > mx)
- mx = buf[j];
- else
- if (-buf[j] > mx)
- mx = -buf[j];
- }
- lst = XEN_CONS(C_TO_XEN_DOUBLE(mx), lst);
- }
- return(lst);
-}
-
-
-mus_float_t sound_data_peak(sound_data *sd)
-{
- int chn;
- mus_long_t i;
- mus_float_t mx = 0.0;
- for (chn = 0; chn < sd->chans; chn++)
- for (i = 0; i < sd->length; i++)
- if (fabs(sd->data[chn][i]) > mx)
- mx = fabs(sd->data[chn][i]);
- return(mx);
-}
-
-
-static XEN g_sound_data_peak(XEN obj)
-{
- #define H_sound_data_peak "(" S_sound_data_peak " sd): overall maxamp of data in sd"
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ARG_1, S_sound_data_maxamp, "a sound-data object");
- return(C_TO_XEN_DOUBLE(sound_data_peak(XEN_TO_SOUND_DATA(obj))));
-}
-
-
-#if HAVE_FORTH
-static XEN sound_data_apply(XEN obj, XEN chan, XEN i)
+void mus_sndlib_xen_initialize(void)
{
- return(g_sound_data_ref(obj, chan, i));
-}
-#endif
-
#if HAVE_SCHEME
-static XEN g_sound_data_set(XEN obj, XEN chan, XEN frame_num, XEN val);
-static XEN g_sound_data_copy(XEN obj);
-static XEN g_sound_data_fillB(XEN sdobj, XEN scl);
-
-static XEN sound_data_apply(s7_scheme *sc, XEN obj, XEN args)
-{
- return(g_sound_data_ref(obj, XEN_CAR(args), XEN_CADR(args)));
-}
-
-static XEN s7_sound_data_set(s7_scheme *sc, XEN obj, XEN args)
-{
- return(g_sound_data_set(obj, XEN_CAR(args), XEN_CADR(args), XEN_CADDR(args)));
-}
-
-static XEN s7_sound_data_length(s7_scheme *sc, XEN obj)
-{
- return(g_sound_data_length(obj));
-}
-
-static XEN s7_sound_data_copy(s7_scheme *sc, XEN obj)
-{
- return(g_sound_data_copy(obj));
-}
-
-static XEN s7_sound_data_fill(s7_scheme *sc, XEN obj, XEN val)
-{
- return(g_sound_data_fillB(obj, val));
-}
-#endif
-
-
-static XEN g_sound_data_set(XEN obj, XEN chan, XEN frame_num, XEN val)
-{
- #define H_sound_data_setB "(" S_sound_data_setB " sd chan i val): set sound-data sd's i-th element in channel chan to val: sd[chan][i] = val"
- sound_data *sd;
- int chn;
- mus_long_t loc;
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ARG_1, S_sound_data_setB, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(chan), chan, XEN_ARG_2, S_sound_data_setB, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(frame_num), frame_num, XEN_ARG_3, S_sound_data_setB, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_4, S_sound_data_setB, "a number");
-
- sd = XEN_TO_SOUND_DATA(obj);
- chn = XEN_TO_C_INT(chan);
- if (chn < 0)
- XEN_OUT_OF_RANGE_ERROR(S_sound_data_setB, 2, chan, "~A: invalid channel");
- if (chn >= sd->chans)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_3(C_TO_XEN_STRING(S_sound_data_setB ": chan: ~A >= sound-data chans, ~A"),
- chan,
- C_TO_XEN_INT(sd->chans)));
-
- loc = XEN_TO_C_INT64_T(frame_num);
- if (loc < 0)
- XEN_OUT_OF_RANGE_ERROR(S_sound_data_setB, 3, frame_num, "~A: invalid frame");
- if (loc >= sd->length)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_3(C_TO_XEN_STRING(S_sound_data_setB ": frame: ~A >= sound-data length, ~A"),
- frame_num,
- C_TO_XEN_INT64_T(sd->length)));
-
- sd->data[chn][loc] = XEN_TO_C_DOUBLE(val);
- return(val);
-}
-
-
-sound_data *sound_data_scale(sound_data *sd, mus_float_t scaler)
-{
- int chn;
- mus_long_t i;
- if (scaler == 0.0)
- {
- for (chn = 0; chn < sd->chans; chn++)
- mus_clear_array(sd->data[chn], sd->length);
- }
- else
- {
- if (scaler != 1.0)
- for (chn = 0; chn < sd->chans; chn++)
- for (i = 0; i < sd->length; i++)
- sd->data[chn][i] *= scaler;
- }
- return(sd);
-}
-
-
-static XEN g_sound_data_scaleB(XEN sdobj, XEN scl)
-{
- #define H_sound_data_scaleB "(" S_sound_data_scaleB " sd scl): scales (multiplies) sound-data sd's data by scl"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(sdobj), sdobj, XEN_ARG_1, S_sound_data_scaleB, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(scl), scl, XEN_ARG_2, S_sound_data_scaleB, "a number");
-
- sound_data_scale(XEN_TO_SOUND_DATA(sdobj), XEN_TO_C_DOUBLE(scl));
- return(sdobj);
-}
-
-
-sound_data *sound_data_fill(sound_data *sd, mus_float_t scaler)
-{
- int chn;
- mus_long_t i;
- if (scaler == 0.0)
- {
- for (chn = 0; chn < sd->chans; chn++)
- mus_clear_array(sd->data[chn], sd->length);
- }
- else
- {
- for (chn = 0; chn < sd->chans; chn++)
- for (i = 0; i < sd->length; i++)
- sd->data[chn][i] = scaler;
- }
- return(sd);
-}
-
-
-static XEN g_sound_data_fillB(XEN sdobj, XEN scl)
-{
- #define H_sound_data_fillB "(" S_sound_data_fillB " sd value): fills the sound-data object sd with value"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(sdobj), sdobj, XEN_ARG_1, S_sound_data_fillB, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(scl), scl, XEN_ARG_2, S_sound_data_fillB, "a number");
-
- sound_data_fill(XEN_TO_SOUND_DATA(sdobj), XEN_TO_C_DOUBLE(scl));
- return(sdobj);
-}
-
-
-sound_data *sound_data_copy(sound_data *sd)
-{
- int i;
- sound_data *sdnew;
- sdnew = c_make_sound_data(sd->chans, sd->length);
- for (i = 0; i < sd->chans; i++)
- memcpy((void *)(sdnew->data[i]), (void *)(sd->data[i]), sd->length * sizeof(mus_float_t));
- return(sdnew);
-}
-
-
-static XEN g_sound_data_copy(XEN obj)
-{
- sound_data *sdnew;
- #define H_sound_data_copy "(" S_sound_data_copy " sd): returns a copy of the sound-data object sd"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ONLY_ARG, S_sound_data_copy, "a sound-data object");
-
- sdnew = sound_data_copy(XEN_TO_SOUND_DATA(obj));
- XEN_MAKE_AND_RETURN_OBJECT(sound_data_tag, sdnew, 0, free_sound_data);
-}
-
-
-sound_data *sound_data_reverse(sound_data *sd)
-{
- int chn;
- mus_long_t i, j;
-
- for (chn = 0; chn < sd->chans; chn++)
- for (i = 0, j = sd->length - 1; i < j; i++, j--)
- {
- mus_float_t tmp;
- tmp = sd->data[chn][i];
- sd->data[chn][i] = sd->data[chn][j];
- sd->data[chn][j] = tmp;
- }
- return(sd);
-}
-
-
-static XEN g_sound_data_reverseB(XEN obj)
-{
- #define H_sound_data_reverseB "(" S_sound_data_reverseB " sd): reverses the elements (within each channel) of sound-data object sd"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ONLY_ARG, S_sound_data_reverseB, "a sound-data object");
-
- sound_data_reverse(XEN_TO_SOUND_DATA(obj));
- return(obj);
-}
-
-
-sound_data *sound_data_add(sound_data *sd1, sound_data *sd2)
-{
- int i, chns;
- mus_long_t j, len;
-
- chns = sd1->chans;
- if (chns > sd2->chans) chns = sd2->chans;
- len = sd1->length;
- if (len > sd2->length) len = sd2->length;
-
- for (i = 0; i < chns; i++)
- for (j = 0; j < len; j++)
- sd1->data[i][j] += sd2->data[i][j];
-
- return(sd1);
-}
-
-
-static XEN g_sound_data_addB(XEN obj1, XEN obj2)
-{
- #define H_sound_data_addB "(" S_sound_data_addB " sd1 sd2): adds (element-wise) sd2 to sd1, returning sd1"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj1), obj1, XEN_ARG_1, S_sound_data_addB, "a sound-data object");
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj2), obj2, XEN_ARG_2, S_sound_data_addB, "a sound-data object");
-
- sound_data_add(XEN_TO_SOUND_DATA(obj1), XEN_TO_SOUND_DATA(obj2));
- return(obj1);
-}
-
-
-sound_data *sound_data_multiply(sound_data *sd1, sound_data *sd2)
-{
- int i, chns;
- mus_long_t j, len;
-
- chns = sd1->chans;
- if (chns > sd2->chans) chns = sd2->chans;
- len = sd1->length;
- if (len > sd2->length) len = sd2->length;
-
- for (i = 0; i < chns; i++)
- for (j = 0; j < len; j++)
- sd1->data[i][j] *= sd2->data[i][j];
-
- return(sd1);
-}
-
-
-static XEN g_sound_data_multiplyB(XEN obj1, XEN obj2)
-{
- #define H_sound_data_multiplyB "(" S_sound_data_multiplyB " sd1 sd2): multiplies (element-wise) sd1 by sd2, returning sd1"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj1), obj1, XEN_ARG_1, S_sound_data_multiplyB, "a sound-data object");
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj2), obj2, XEN_ARG_2, S_sound_data_multiplyB, "a sound-data object");
-
- sound_data_multiply(XEN_TO_SOUND_DATA(obj1), XEN_TO_SOUND_DATA(obj2));
- return(obj1);
-}
-
-
-sound_data *sound_data_offset(sound_data *sd, mus_float_t off)
-{
- if (off != 0.0)
- {
- int i;
- mus_long_t j;
- for (i = 0; i < sd->chans; i++)
- for (j = 0; j < sd->length; j++)
- sd->data[i][j] += off;
- }
- return(sd);
-}
-
-
-static XEN g_sound_data_offsetB(XEN obj, XEN offset)
-{
- #define H_sound_data_offsetB "(" S_sound_data_offsetB " sd val): adds val to each element of sd, returning sd"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj), obj, XEN_ARG_1, S_sound_data_offsetB, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(offset), offset, XEN_ARG_2, S_sound_data_offsetB, "a number");
-
- sound_data_offset(XEN_TO_SOUND_DATA(obj), XEN_TO_C_DOUBLE(offset));
- return(obj);
-}
-
-
-static XEN g_sound_data_add(XEN obj1, XEN obj2)
-{
- #define H_sound_data_add "(" S_sound_data_add " obj1 obj2): adds obj1 to obj2, either or both of which can be sound-data objects"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj1) || XEN_NUMBER_P(obj1), obj1, XEN_ARG_1, S_sound_data_add, "a sound-data object or a number");
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj2) || XEN_NUMBER_P(obj2), obj2, XEN_ARG_2, S_sound_data_add, "a sound-data object or a number");
-
- if (SOUND_DATA_P(obj1))
- {
- if (SOUND_DATA_P(obj2))
- return(g_sound_data_addB(obj1, obj2));
- return(g_sound_data_offsetB(obj1, obj2));
- }
- if (SOUND_DATA_P(obj2))
- return(g_sound_data_offsetB(obj2, obj1));
- return(C_TO_XEN_DOUBLE(XEN_TO_C_DOUBLE(obj1) + XEN_TO_C_DOUBLE(obj2)));
-}
-
-
-static XEN g_sound_data_multiply(XEN obj1, XEN obj2)
-{
- #define H_sound_data_multiply "(" S_sound_data_multiply " obj1 obj2): multiplies obj1 by obj2, either or both of which can be sound-data objects"
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj1) || XEN_NUMBER_P(obj1), obj1, XEN_ARG_1, S_sound_data_multiply, "a sound-data object or a number");
- XEN_ASSERT_TYPE(SOUND_DATA_P(obj2) || XEN_NUMBER_P(obj2), obj2, XEN_ARG_2, S_sound_data_multiply, "a sound-data object or a number");
-
- if (SOUND_DATA_P(obj1))
- {
- if (SOUND_DATA_P(obj2))
- return(g_sound_data_multiplyB(obj1, obj2));
- return(g_sound_data_scaleB(obj1, obj2));
- }
- if (SOUND_DATA_P(obj2))
- return(g_sound_data_scaleB(obj2, obj1));
- return(C_TO_XEN_DOUBLE(XEN_TO_C_DOUBLE(obj1) * XEN_TO_C_DOUBLE(obj2)));
-}
-
-
-
-static XEN g_sound_data_to_vct(XEN sdobj, XEN chan, XEN vobj)
-{
- #define H_sound_data_to_vct "(" S_sound_data_to_vct " sd chan v): copies sound-data sd's channel chan data into vct v"
- vct *v;
- sound_data *sd;
- int chn;
- mus_long_t len;
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(sdobj), sdobj, XEN_ARG_1, S_sound_data_to_vct, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chan), chan, XEN_ARG_2, S_sound_data_to_vct, "an integer");
- XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(vobj) || MUS_VCT_P(vobj), vobj, XEN_ARG_3, S_sound_data_to_vct, "a vct");
-
- sd = XEN_TO_SOUND_DATA(sdobj);
- chn = XEN_TO_C_INT_OR_ELSE(chan, 0);
- if (chn < 0)
- XEN_OUT_OF_RANGE_ERROR(S_sound_data_to_vct, 2, chan, "~A: invalid channel");
- if (chn >= sd->chans)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_3(C_TO_XEN_STRING(S_sound_data_to_vct ": chan: ~A >= sound-data chans, ~A"),
- chan,
- C_TO_XEN_INT(sd->chans)));
-
- if (!(MUS_VCT_P(vobj)))
- vobj = xen_make_vct(sd->length, (mus_float_t *)calloc(sd->length, sizeof(mus_float_t)));
- v = XEN_TO_VCT(vobj);
-
- if (sd->length < v->length)
- len = sd->length;
- else len = v->length;
-
- memcpy((void *)(v->data), (void *)(sd->data[chn]), len * sizeof(mus_float_t));
-
- return(vobj);
-}
-
-
-static XEN g_vct_to_sound_data(XEN vobj, XEN sdobj, XEN chan)
-{
- #define H_vct_to_sound_data "(" S_vct_to_sound_data " v sd chan): copies vct v's data into sound-data sd's channel chan"
- vct *v;
- sound_data *sd;
- XEN obj = XEN_FALSE;
- int chn;
- mus_long_t len;
-
- XEN_ASSERT_TYPE(MUS_VCT_P(vobj), vobj, XEN_ARG_1, S_vct_to_sound_data, "a vct");
- XEN_ASSERT_TYPE(XEN_NOT_BOUND_P(sdobj) || SOUND_DATA_P(sdobj), sdobj, XEN_ARG_2, S_vct_to_sound_data, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(chan), chan, XEN_ARG_3, S_vct_to_sound_data, "an integer");
-
- v = XEN_TO_VCT(vobj);
- chn = XEN_TO_C_INT_OR_ELSE(chan, 0);
- if (chn < 0)
- XEN_OUT_OF_RANGE_ERROR(S_vct_to_sound_data, 3, chan, "~A: invalid channel");
- if (!(SOUND_DATA_P(sdobj)))
- {
- if (chn > 0)
- XEN_OUT_OF_RANGE_ERROR(S_vct_to_sound_data, 3, chan, "~A: invalid channel");
- obj = make_sound_data(1, v->length);
- sd = XEN_TO_SOUND_DATA(obj);
- }
- else
- {
- sd = XEN_TO_SOUND_DATA(sdobj);
- if (chn >= sd->chans)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_3(C_TO_XEN_STRING(S_vct_to_sound_data ": chan: ~A >= sound-data chans, ~A"),
- chan,
- C_TO_XEN_INT(sd->chans)));
- obj = sdobj;
- }
- if (sd->length < v->length)
- len = sd->length;
- else len = v->length;
- memcpy((void *)(sd->data[chn]), (void *)(v->data), len * sizeof(mus_float_t));
- return(obj);
-}
-
-
-static void *mus_long_t_memmove(char *dest, const char *source, mus_long_t length)
-{
- /* not void, as in gnulib, because that makes C++ unhappy! */
- char *d0 = dest;
- if (source < dest)
- /* Moving from low mem to hi mem; start at end. */
- for (source += length, dest += length; length; --length)
- *--dest = *--source;
- else
- if (source != dest)
- {
- /* Moving from hi mem to low mem; start at beginning. */
- for (; length; --length)
- *dest++ = *source++;
- }
- return((void *)d0);
-}
-
-
-#define S_sound_data_to_sound_data "sound-data->sound-data"
-
-static XEN g_sound_data_to_sound_data(XEN sd_in, XEN sd_out, XEN start, XEN frames, XEN cycle_length)
-{
- #define H_sound_data_to_sound_data "(" S_sound_data_to_sound_data " sd-in sd-out start frames cycle-length): \
-copies sound-data sd-in's data from 0 for 'frames' frames into 'sd-out' starting at 'start', wrapping around if sd-out's end (or cycle-length) is reached."
-
- sound_data *sdi, *sdo;
- int i, chans;
- mus_long_t j = 0, len, beg, olen, ilen, cycle;
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(sd_in), sd_in, XEN_ARG_1, S_sound_data_to_sound_data, "a sound-data object");
- XEN_ASSERT_TYPE(SOUND_DATA_P(sd_out), sd_out, XEN_ARG_2, S_sound_data_to_sound_data, "a sound-data object");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(start), start, XEN_ARG_3, S_sound_data_to_sound_data, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(frames), frames, XEN_ARG_4, S_sound_data_to_sound_data, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(cycle_length), cycle_length, XEN_ARG_5, S_sound_data_to_sound_data, "an integer");
-
- sdi = XEN_TO_SOUND_DATA(sd_in);
- sdo = XEN_TO_SOUND_DATA(sd_out);
-
- ilen = sdi->length;
- olen = sdo->length;
-
- beg = XEN_TO_C_INT64_T(start);
- if (beg < 0)
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_2(C_TO_XEN_STRING(S_sound_data_to_sound_data ": start: ~A < 0"),
- start));
- if (beg >= olen) beg = 0;
-
- len = XEN_TO_C_INT64_T(frames);
- if ((len < 0) || (len > ilen))
- XEN_ERROR(XEN_ERROR_TYPE("out-of-range"),
- XEN_LIST_2(C_TO_XEN_STRING(S_sound_data_to_sound_data ": frames: ~A?"),
- frames));
-
- cycle = XEN_TO_C_INT64_T(cycle_length);
- if (beg >= cycle) beg = 0;
- if (cycle > olen) cycle = olen;
-
- chans = sdo->chans;
- if (chans > sdi->chans)
- chans = sdi->chans;
-
- if ((beg + len) < cycle)
- {
- for (i = 0; i < chans; i++)
- mus_long_t_memmove((char *)(sdo->data[i] + beg), (const char *)(sdi->data[i]), len * sizeof(mus_float_t));
- j = beg + len;
- }
- else
- {
- for (i = 0; i < chans; i++)
- {
- mus_long_t k;
- j = beg;
- for (k = 0; k < len; k++)
- {
- sdo->data[i][j++] = sdi->data[i][k];
- if (j == cycle) j = 0;
- }
- }
- }
- return(C_TO_XEN_INT64_T(j));
-}
-
-
-#if HAVE_FORTH
-#define S_sound_data_to_vector "sound-data->vector"
-
-static XEN g_sound_data_to_vector(XEN sdata)
-{
-#define H_sound_data_to_vector "(" S_sound_data_to_vector " sd): \
-returns a vector of length sd->chans containing all channels of sound-data sd as vct."
- long chn;
- sound_data *sd;
- FTH vec;
-
- XEN_ASSERT_TYPE(SOUND_DATA_P(sdata), sdata, XEN_ONLY_ARG, S_sound_data_to_vector, "a sound-data object");
- sd = XEN_TO_SOUND_DATA(sdata);
- vec = XEN_MAKE_VECTOR(sd->chans, FTH_NIL);
-
- for (chn = 0; chn < sd->chans; chn++)
- XEN_VECTOR_SET(vec, chn, g_sound_data_to_vct(sdata, C_TO_XEN_INT(chn), XEN_UNDEFINED));
- return vec;
-}
+ s7_pointer pl_is, pl_isi, pl_si, pl_ss, pl_ps, pl_psp, pl_i, pl_bii, pl_p, pl_rs, pl_bi, pl_bib, pl_b;
+ s7_pointer pl_l, pl_isfiii, pl_fsiiif, pl_bs, pl_ts;
#endif
+ mus_sound_initialize();
+ sound_path = Xen_empty_list;
#if HAVE_RUBY
-static XEN sound_data_each(XEN obj)
-{
- int j;
- mus_long_t i;
- sound_data *sd;
- sd = XEN_TO_SOUND_DATA(obj);
- for (j = 0; j < sd->chans; j++)
- for (i = 0; i < sd->length; i++)
- rb_yield(C_TO_XEN_DOUBLE(sd->data[j][i]));
- return(obj);
-}
-
-
-static XEN sound_data_compare(XEN vr1, XEN vr2)
-{
- mus_long_t i, len;
- int j;
- sound_data *v1, *v2;
- if ((SOUND_DATA_P(vr1)) && (SOUND_DATA_P(vr2)))
- {
- v1 = XEN_TO_SOUND_DATA(vr1);
- v2 = XEN_TO_SOUND_DATA(vr2);
- if (v1->chans > v2->chans)
- return(C_TO_XEN_INT(1));
- if (v1->chans < v2->chans)
- return(C_TO_XEN_INT(-1));
- len = v1->length;
- if (len > v2->length) len = v2->length;
- for (j = 0; j < v1->chans; j++)
- for (i = 0; i < len; i++)
- if (v1->data[j][i] < v2->data[j][i])
- return(C_TO_XEN_INT(-1));
- else
- if (v1->data[j][i] > v2->data[j][i])
- return(C_TO_XEN_INT(1));
- len = v1->length - v2->length;
- if (len == 0) return(XEN_ZERO);
- if (len > 0) return(C_TO_XEN_INT(1));
- }
- return(C_TO_XEN_INT(-1));
-}
-
-
-static XEN sound_data_size(XEN obj)
-{
- sound_data *sd;
- sd = XEN_TO_SOUND_DATA(obj);
- return(C_TO_XEN_INT64_T(sd->length * sd->chans));
-}
-
-
-static XEN sound_data_chans(XEN obj)
-{
- sound_data *sd;
- sd = XEN_TO_SOUND_DATA(obj);
- return(C_TO_XEN_INT(sd->chans));
-}
-
-
-static XEN g_rb_sound_data_fill(XEN obj, XEN val)
-{
- sound_data_fill(XEN_TO_SOUND_DATA(obj), XEN_TO_C_DOUBLE(val));
- return(val);
-}
-
-
-static XEN g_rb_make_sound_data(XEN self, XEN chans, XEN frames)
-{
- return(g_make_sound_data(chans, frames));
-}
-#endif
-
-
-
-static XEN g_mus_max_malloc(void)
-{
- #define H_mus_max_malloc "(" S_mus_max_malloc "): maximum number of bytes we will try to malloc."
- return(C_TO_XEN_INT64_T(mus_max_malloc()));
-}
-
-
-static XEN g_mus_set_max_malloc(XEN val)
-{
- XEN_ASSERT_TYPE(XEN_INT64_T_P(val), val, XEN_ONLY_ARG, S_setB S_mus_max_malloc, "an integer");
- return(C_TO_XEN_INT64_T(mus_set_max_malloc(XEN_TO_C_INT64_T(val))));
-}
-
-
-
-static XEN g_mus_max_table_size(void)
-{
- #define H_mus_max_table_size "(" S_mus_max_table_size "): maximum table size."
- return(C_TO_XEN_INT64_T(mus_max_table_size()));
-}
-
-
-static XEN g_mus_set_max_table_size(XEN val)
-{
- XEN_ASSERT_TYPE(XEN_INT64_T_P(val), val, XEN_ONLY_ARG, S_setB S_mus_max_table_size, "an integer");
- return(C_TO_XEN_INT64_T(mus_set_max_table_size(XEN_TO_C_INT64_T(val))));
-}
-
-
-#if MUS_MAC_OSX
-#define S_mus_audio_output_properties_mutable "mus-audio-output-properties-mutable"
-static XEN g_mus_audio_output_properties_mutable(XEN mut)
-{
- #define H_mus_audio_output_properties_mutable "(" S_mus_audio_output_properties_mutable " val): can DAC settings be changed to match the current sound"
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(mut), mut, XEN_ONLY_ARG, S_mus_audio_output_properties_mutable, "a boolean");
- return(C_TO_XEN_BOOLEAN(mus_audio_output_properties_mutable(XEN_TO_C_BOOLEAN(mut))));
-}
-#endif
-
-
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_1(g_sound_data_length_w, g_sound_data_length)
-XEN_NARGIFY_1(g_sound_data_chans_w, g_sound_data_chans)
-XEN_NARGIFY_1(g_sound_data_copy_w, g_sound_data_copy)
-XEN_NARGIFY_2(g_sound_data_addB_w, g_sound_data_addB)
-XEN_NARGIFY_2(g_sound_data_add_w, g_sound_data_add)
-XEN_NARGIFY_2(g_sound_data_offsetB_w, g_sound_data_offsetB)
-XEN_NARGIFY_2(g_sound_data_multiplyB_w, g_sound_data_multiplyB)
-XEN_NARGIFY_2(g_sound_data_multiply_w, g_sound_data_multiply)
-XEN_NARGIFY_3(g_sound_data_ref_w, g_sound_data_ref)
-XEN_NARGIFY_4(g_sound_data_set_w, g_sound_data_set)
-XEN_NARGIFY_2(g_make_sound_data_w, g_make_sound_data)
-XEN_NARGIFY_1(g_sound_data_p_w, g_sound_data_p)
-XEN_NARGIFY_1(g_sound_data_maxamp_w, g_sound_data_maxamp)
-XEN_NARGIFY_1(g_sound_data_peak_w, g_sound_data_peak)
-XEN_NARGIFY_2(g_sound_data_scaleB_w, g_sound_data_scaleB)
-XEN_NARGIFY_2(g_sound_data_fillB_w, g_sound_data_fillB)
-XEN_NARGIFY_1(g_sound_data_reverseB_w, g_sound_data_reverseB)
-XEN_ARGIFY_3(g_sound_data_to_vct_w, g_sound_data_to_vct)
-XEN_NARGIFY_5(g_sound_data_to_sound_data_w, g_sound_data_to_sound_data)
-XEN_ARGIFY_3(g_vct_to_sound_data_w, g_vct_to_sound_data)
-XEN_NARGIFY_1(g_mus_sound_samples_w, g_mus_sound_samples)
-XEN_NARGIFY_2(g_mus_sound_set_samples_w, g_mus_sound_set_samples)
-XEN_NARGIFY_1(g_mus_sound_frames_w, g_mus_sound_frames)
-XEN_NARGIFY_1(g_mus_sound_duration_w, g_mus_sound_duration)
-XEN_NARGIFY_1(g_mus_sound_datum_size_w, g_mus_sound_datum_size)
-XEN_NARGIFY_1(g_mus_sound_data_location_w, g_mus_sound_data_location)
-XEN_NARGIFY_2(g_mus_sound_set_data_location_w, g_mus_sound_set_data_location)
-XEN_NARGIFY_1(g_mus_sound_chans_w, g_mus_sound_chans)
-XEN_NARGIFY_2(g_mus_sound_set_chans_w, g_mus_sound_set_chans)
-XEN_NARGIFY_1(g_mus_sound_srate_w, g_mus_sound_srate)
-XEN_NARGIFY_2(g_mus_sound_set_srate_w, g_mus_sound_set_srate)
-XEN_NARGIFY_1(g_mus_sound_header_type_w, g_mus_sound_header_type)
-XEN_NARGIFY_2(g_mus_sound_set_header_type_w, g_mus_sound_set_header_type)
-XEN_NARGIFY_1(g_mus_sound_data_format_w, g_mus_sound_data_format)
-XEN_NARGIFY_2(g_mus_sound_set_data_format_w, g_mus_sound_set_data_format)
-XEN_NARGIFY_1(g_mus_sound_length_w, g_mus_sound_length)
-XEN_NARGIFY_1(g_mus_sound_type_specifier_w, g_mus_sound_type_specifier)
-XEN_NARGIFY_1(g_mus_header_type_name_w, g_mus_header_type_name)
-XEN_NARGIFY_1(g_mus_header_type_to_string_w, g_mus_header_type_to_string)
-XEN_NARGIFY_1(g_mus_data_format_name_w, g_mus_data_format_name)
-XEN_NARGIFY_1(g_mus_data_format_to_string_w, g_mus_data_format_to_string)
-XEN_NARGIFY_1(g_mus_sound_comment_w, g_mus_sound_comment)
-XEN_NARGIFY_1(g_mus_sound_write_date_w, g_mus_sound_write_date)
-XEN_NARGIFY_1(g_mus_bytes_per_sample_w, g_mus_bytes_per_sample)
-XEN_NARGIFY_1(g_mus_sound_loop_info_w, g_mus_sound_loop_info)
-XEN_NARGIFY_1(g_mus_sound_mark_info_w, g_mus_sound_mark_info)
-XEN_NARGIFY_1(g_mus_sound_maxamp_w, g_mus_sound_maxamp)
-XEN_NARGIFY_2(g_mus_sound_set_maxamp_w, g_mus_sound_set_maxamp)
-XEN_NARGIFY_1(g_mus_sound_maxamp_exists_w, g_mus_sound_maxamp_exists)
-XEN_NARGIFY_1(g_mus_sound_open_input_w, g_mus_sound_open_input)
-XEN_NARGIFY_1(g_mus_sound_close_input_w, g_mus_sound_close_input)
-
-XEN_NARGIFY_0(g_mus_audio_describe_w, g_mus_audio_describe)
-XEN_NARGIFY_1(g_mus_audio_close_w, g_mus_audio_close)
-XEN_ARGIFY_4(g_mus_audio_write_w, g_mus_audio_write)
-XEN_NARGIFY_3(g_mus_audio_read_w, g_mus_audio_read)
-XEN_NARGIFY_5(g_mus_audio_open_output_w, g_mus_audio_open_output)
-XEN_NARGIFY_5(g_mus_audio_open_input_w, g_mus_audio_open_input)
-
-XEN_NARGIFY_0(g_mus_clipping_w, g_mus_clipping)
-XEN_NARGIFY_1(g_mus_set_clipping_w, g_mus_set_clipping)
-XEN_NARGIFY_1(g_mus_file_clipping_w, g_mus_file_clipping)
-XEN_NARGIFY_2(g_mus_file_set_clipping_w, g_mus_file_set_clipping)
-XEN_NARGIFY_0(g_mus_prescaler_w, g_mus_prescaler)
-XEN_NARGIFY_1(g_mus_set_prescaler_w, g_mus_set_prescaler)
-XEN_NARGIFY_1(g_mus_file_prescaler_w, g_mus_file_prescaler)
-XEN_NARGIFY_2(g_mus_file_set_prescaler_w, g_mus_file_set_prescaler)
-XEN_NARGIFY_0(g_mus_header_raw_defaults_w, g_mus_header_raw_defaults)
-XEN_NARGIFY_1(g_mus_header_set_raw_defaults_w, g_mus_header_set_raw_defaults)
-XEN_NARGIFY_1(g_mus_expand_filename_w, g_mus_expand_filename)
-XEN_ARGIFY_6(g_mus_sound_open_output_w, g_mus_sound_open_output)
-XEN_ARGIFY_5(g_mus_sound_reopen_output_w, g_mus_sound_reopen_output)
-XEN_NARGIFY_2(g_mus_sound_close_output_w, g_mus_sound_close_output)
-XEN_NARGIFY_5(g_mus_sound_read_w, g_mus_sound_read)
-XEN_NARGIFY_5(g_mus_sound_write_w, g_mus_sound_write)
-XEN_NARGIFY_2(g_mus_sound_seek_frame_w, g_mus_sound_seek_frame)
-XEN_ARGIFY_1(g_mus_sound_report_cache_w, g_mus_sound_report_cache)
-XEN_NARGIFY_1(g_mus_sound_forget_w, g_mus_sound_forget)
-XEN_NARGIFY_0(g_mus_sound_prune_w, g_mus_sound_prune)
-XEN_NARGIFY_1(g_mus_error_type_to_string_w, g_mus_error_type_to_string)
-XEN_NARGIFY_2(g_mus_oss_set_buffers_w, g_mus_oss_set_buffers)
-XEN_NARGIFY_5(g_array_to_file_w, g_array_to_file)
-XEN_NARGIFY_5(g_file_to_array_w, g_file_to_array)
-XEN_NARGIFY_0(g_mus_alsa_buffers_w, g_mus_alsa_buffers)
-XEN_NARGIFY_1(g_mus_alsa_set_buffers_w, g_mus_alsa_set_buffers)
-XEN_NARGIFY_0(g_mus_alsa_buffer_size_w, g_mus_alsa_buffer_size)
-XEN_NARGIFY_1(g_mus_alsa_set_buffer_size_w, g_mus_alsa_set_buffer_size)
-XEN_NARGIFY_0(g_mus_alsa_device_w, g_mus_alsa_device)
-XEN_NARGIFY_1(g_mus_alsa_set_device_w, g_mus_alsa_set_device)
-XEN_NARGIFY_0(g_mus_alsa_playback_device_w, g_mus_alsa_playback_device)
-XEN_NARGIFY_1(g_mus_alsa_set_playback_device_w, g_mus_alsa_set_playback_device)
-XEN_NARGIFY_0(g_mus_alsa_capture_device_w, g_mus_alsa_capture_device)
-XEN_NARGIFY_1(g_mus_alsa_set_capture_device_w, g_mus_alsa_set_capture_device)
-XEN_NARGIFY_0(g_mus_alsa_squelch_warning_w, g_mus_alsa_squelch_warning)
-XEN_NARGIFY_1(g_mus_alsa_set_squelch_warning_w, g_mus_alsa_set_squelch_warning)
-
-#if HAVE_OSS
- XEN_NARGIFY_0(g_mus_audio_reinitialize_w, g_mus_audio_reinitialize)
-#endif
-
-#if MUS_MAC_OSX
-XEN_NARGIFY_1(g_mus_audio_output_properties_mutable_w, g_mus_audio_output_properties_mutable)
-#endif
-
-XEN_NARGIFY_0(g_mus_max_malloc_w, g_mus_max_malloc)
-XEN_NARGIFY_1(g_mus_set_max_malloc_w, g_mus_set_max_malloc)
-XEN_NARGIFY_0(g_mus_max_table_size_w, g_mus_max_table_size)
-XEN_NARGIFY_1(g_mus_set_max_table_size_w, g_mus_set_max_table_size)
-
-#else
-#define g_sound_data_length_w g_sound_data_length
-#define g_sound_data_chans_w g_sound_data_chans
-#define g_sound_data_copy_w g_sound_data_copy
-#define g_sound_data_addB_w g_sound_data_addB
-#define g_sound_data_add_w g_sound_data_add
-#define g_sound_data_offsetB_w g_sound_data_offsetB
-#define g_sound_data_multiplyB_w g_sound_data_multiplyB
-#define g_sound_data_multiply_w g_sound_data_multiply
-#define g_sound_data_ref_w g_sound_data_ref
-#define g_sound_data_set_w g_sound_data_set
-#define g_make_sound_data_w g_make_sound_data
-#define g_sound_data_p_w g_sound_data_p
-#define g_sound_data_maxamp_w g_sound_data_maxamp
-#define g_sound_data_peak_w g_sound_data_peak
-#define g_sound_data_scaleB_w g_sound_data_scaleB
-#define g_sound_data_fillB_w g_sound_data_fillB
-#define g_sound_data_reverseB_w g_sound_data_reverseB
-#define g_sound_data_to_vct_w g_sound_data_to_vct
-#define g_sound_data_to_sound_data_w g_sound_data_to_sound_data
-#define g_vct_to_sound_data_w g_vct_to_sound_data
-#define g_mus_sound_samples_w g_mus_sound_samples
-#define g_mus_sound_set_samples_w g_mus_sound_set_samples
-#define g_mus_sound_frames_w g_mus_sound_frames
-#define g_mus_sound_duration_w g_mus_sound_duration
-#define g_mus_sound_datum_size_w g_mus_sound_datum_size
-#define g_mus_sound_data_location_w g_mus_sound_data_location
-#define g_mus_sound_set_data_location_w g_mus_sound_set_data_location
-#define g_mus_sound_chans_w g_mus_sound_chans
-#define g_mus_sound_set_chans_w g_mus_sound_set_chans
-#define g_mus_sound_srate_w g_mus_sound_srate
-#define g_mus_sound_set_srate_w g_mus_sound_set_srate
-#define g_mus_sound_header_type_w g_mus_sound_header_type
-#define g_mus_sound_set_header_type_w g_mus_sound_set_header_type
-#define g_mus_sound_data_format_w g_mus_sound_data_format
-#define g_mus_sound_set_data_format_w g_mus_sound_set_data_format
-#define g_mus_sound_length_w g_mus_sound_length
-#define g_mus_sound_type_specifier_w g_mus_sound_type_specifier
-#define g_mus_header_type_name_w g_mus_header_type_name
-#define g_mus_data_format_name_w g_mus_data_format_name
-#define g_mus_header_type_to_string_w g_mus_header_type_to_string
-#define g_mus_data_format_to_string_w g_mus_data_format_to_string
-#define g_mus_sound_comment_w g_mus_sound_comment
-#define g_mus_sound_write_date_w g_mus_sound_write_date
-#define g_mus_bytes_per_sample_w g_mus_bytes_per_sample
-#define g_mus_sound_loop_info_w g_mus_sound_loop_info
-#define g_mus_sound_mark_info_w g_mus_sound_mark_info
-#define g_mus_sound_maxamp_w g_mus_sound_maxamp
-#define g_mus_sound_set_maxamp_w g_mus_sound_set_maxamp
-#define g_mus_sound_maxamp_exists_w g_mus_sound_maxamp_exists
-#define g_mus_sound_open_input_w g_mus_sound_open_input
-#define g_mus_sound_close_input_w g_mus_sound_close_input
-
-#define g_mus_audio_describe_w g_mus_audio_describe
-#define g_mus_audio_close_w g_mus_audio_close
-#define g_mus_audio_write_w g_mus_audio_write
-#define g_mus_audio_read_w g_mus_audio_read
-#define g_mus_audio_open_output_w g_mus_audio_open_output
-#define g_mus_audio_open_input_w g_mus_audio_open_input
-
-#define g_mus_clipping_w g_mus_clipping
-#define g_mus_set_clipping_w g_mus_set_clipping
-#define g_mus_file_clipping_w g_mus_file_clipping
-#define g_mus_file_set_clipping_w g_mus_file_set_clipping
-#define g_mus_prescaler_w g_mus_prescaler
-#define g_mus_set_prescaler_w g_mus_set_prescaler
-#define g_mus_file_prescaler_w g_mus_file_prescaler
-#define g_mus_file_set_prescaler_w g_mus_file_set_prescaler
-#define g_mus_header_raw_defaults_w g_mus_header_raw_defaults
-#define g_mus_header_set_raw_defaults_w g_mus_header_set_raw_defaults
-#define g_mus_expand_filename_w g_mus_expand_filename
-#define g_mus_sound_open_output_w g_mus_sound_open_output
-#define g_mus_sound_reopen_output_w g_mus_sound_reopen_output
-#define g_mus_sound_close_output_w g_mus_sound_close_output
-#define g_mus_sound_read_w g_mus_sound_read
-#define g_mus_sound_write_w g_mus_sound_write
-#define g_mus_sound_seek_frame_w g_mus_sound_seek_frame
-#define g_mus_sound_report_cache_w g_mus_sound_report_cache
-#define g_mus_sound_forget_w g_mus_sound_forget
-#define g_mus_sound_prune_w g_mus_sound_prune
-#define g_mus_error_type_to_string_w g_mus_error_type_to_string
-#define g_mus_oss_set_buffers_w g_mus_oss_set_buffers
-#define g_array_to_file_w g_array_to_file
-#define g_file_to_array_w g_file_to_array
-#define g_mus_alsa_buffers_w g_mus_alsa_buffers
-#define g_mus_alsa_set_buffers_w g_mus_alsa_set_buffers
-#define g_mus_alsa_buffer_size_w g_mus_alsa_buffer_size
-#define g_mus_alsa_set_buffer_size_w g_mus_alsa_set_buffer_size
-#define g_mus_alsa_device_w g_mus_alsa_device
-#define g_mus_alsa_set_device_w g_mus_alsa_set_device
-#define g_mus_alsa_playback_device_w g_mus_alsa_playback_device
-#define g_mus_alsa_set_playback_device_w g_mus_alsa_set_playback_device
-#define g_mus_alsa_capture_device_w g_mus_alsa_capture_device
-#define g_mus_alsa_set_capture_device_w g_mus_alsa_set_capture_device
-#define g_mus_alsa_squelch_warning_w g_mus_alsa_squelch_warning
-#define g_mus_alsa_set_squelch_warning_w g_mus_alsa_set_squelch_warning
-#if HAVE_OSS
- #define g_mus_audio_reinitialize_w g_mus_audio_reinitialize
-#endif
-#if MUS_MAC_OSX
- #define g_mus_audio_output_properties_mutable_w g_mus_audio_output_properties_mutable
-#endif
-
-#define g_mus_max_malloc_w g_mus_max_malloc
-#define g_mus_set_max_malloc_w g_mus_set_max_malloc
-#define g_mus_max_table_size_w g_mus_max_table_size
-#define g_mus_set_max_table_size_w g_mus_set_max_table_size
-
+ Init_Hook();
#endif
-
-void mus_sndlib_xen_initialize(void)
-{
- mus_sound_initialize();
+ Xen_define_constant(S_mus_out_format, MUS_OUT_SAMPLE_TYPE, "sample type for fastest IO");
+ Xen_define_constant(S_mus_unknown_header, MUS_UNKNOWN_HEADER, "unknown header type");
+ Xen_define_constant(S_mus_next, MUS_NEXT, "NeXT (Sun) sound header id");
+ Xen_define_constant(S_mus_aifc, MUS_AIFC, "AIFC sound header id");
+ Xen_define_constant(S_mus_rf64, MUS_RF64, "RF64 sound header id");
+ Xen_define_constant(S_mus_riff, MUS_RIFF, "RIFF (MS wave) sound header id");
+ Xen_define_constant(S_mus_nist, MUS_NIST, "NIST (Sphere) sound header id");
+ Xen_define_constant(S_mus_raw, MUS_RAW, "raw (headerless) sound header id");
+ Xen_define_constant(S_mus_ircam, MUS_IRCAM, "IRCAM sound header id");
+ Xen_define_constant(S_mus_aiff, MUS_AIFF, "AIFF (old-style) sound header id");
+ Xen_define_constant(S_mus_bicsf, MUS_BICSF, "BICSF header id");
+ Xen_define_constant(S_mus_voc, MUS_VOC, "VOC header id");
+ Xen_define_constant(S_mus_svx, MUS_SVX, "SVX (IFF) header id");
+ Xen_define_constant(S_mus_soundfont, MUS_SOUNDFONT, "soundfont header id");
+ Xen_define_constant(S_mus_caff, MUS_CAFF, "Apple Core Audio File Format header id");
+
+ Xen_define_constant(S_mus_unknown_sample, MUS_UNKNOWN_SAMPLE, "unknown sample type");
+ Xen_define_constant(S_mus_bshort, MUS_BSHORT, "big-endian short sample type id");
+ Xen_define_constant(S_mus_lshort, MUS_LSHORT, "little-endian short sample type id");
+ Xen_define_constant(S_mus_mulaw, MUS_MULAW, "mulaw (8-bit) sample type id");
+ Xen_define_constant(S_mus_alaw, MUS_ALAW, "alaw (8-bit) sample type id");
+ Xen_define_constant(S_mus_byte, MUS_BYTE, "signed byte sample type id");
+ Xen_define_constant(S_mus_ubyte, MUS_UBYTE, "unsigned byte sample type id");
+ Xen_define_constant(S_mus_bfloat, MUS_BFLOAT, "big-endian float sample type id");
+ Xen_define_constant(S_mus_lfloat, MUS_LFLOAT, "little-endian float sample type id");
+ Xen_define_constant(S_mus_bint, MUS_BINT, "big-endian int sample type id");
+ Xen_define_constant(S_mus_lint, MUS_LINT, "little-endian int sample type id");
+ Xen_define_constant(S_mus_bintn, MUS_BINTN, "normalized big-endian int sample type id");
+ Xen_define_constant(S_mus_lintn, MUS_LINTN, "normalized little-endian int sample type id");
+ Xen_define_constant(S_mus_b24int, MUS_B24INT, "big-endian 24-bit sample type id");
+ Xen_define_constant(S_mus_l24int, MUS_L24INT, "little-endian 24-bit sample type id");
+ Xen_define_constant(S_mus_bdouble, MUS_BDOUBLE, "big-endian double sample type id");
+ Xen_define_constant(S_mus_ldouble, MUS_LDOUBLE, "little-endian double sample type id");
+ Xen_define_constant(S_mus_ubshort, MUS_UBSHORT, "unsigned big-endian short sample type id");
+ Xen_define_constant(S_mus_ulshort, MUS_ULSHORT, "unsigned little-endian short sample type id");
+ Xen_define_constant(S_mus_bdouble_unscaled, MUS_BDOUBLE_UNSCALED, "unscaled big-endian double sample type id");
+ Xen_define_constant(S_mus_ldouble_unscaled, MUS_LDOUBLE_UNSCALED, "unscaled little-endian double sample type id");
+ Xen_define_constant(S_mus_bfloat_unscaled, MUS_BFLOAT_UNSCALED, "unscaled big-endian float sample type id");
+ Xen_define_constant(S_mus_lfloat_unscaled, MUS_LFLOAT_UNSCALED, "unscaled little-endian float sample type id");
#if HAVE_SCHEME
- sound_data_tag = XEN_MAKE_OBJECT_TYPE("<sound-data>", print_sound_data, free_sound_data, s7_equalp_sound_data, NULL,
- sound_data_apply, s7_sound_data_set, s7_sound_data_length, s7_sound_data_copy, s7_sound_data_fill);
-#else
- sound_data_tag = XEN_MAKE_OBJECT_TYPE("SoundData", sizeof(sound_data));
+ {
+ s7_pointer s, i, p, b, r, f, t, l;
+ s = s7_make_symbol(s7, "string?");
+ i = s7_make_symbol(s7, "integer?");
+ p = s7_make_symbol(s7, "pair?");
+ l = s7_make_symbol(s7, "list?");
+ b = s7_make_symbol(s7, "boolean?");
+ r = s7_make_symbol(s7, "real?");
+ f = s7_make_symbol(s7, "float-vector?");
+ t = s7_t(s7);
+ pl_is = s7_make_signature(s7, 2, i, s);
+ pl_isi = s7_make_signature(s7, 3, i, s, i);
+ pl_si = s7_make_signature(s7, 2, s, i);
+ pl_ss = s7_make_signature(s7, 2, s, s);
+ pl_ts = s7_make_signature(s7, 2, t, s);
+ pl_ps = s7_make_signature(s7, 2, p, s);
+ pl_psp = s7_make_signature(s7, 3, p, s, p);
+ pl_i = s7_make_circular_signature(s7, 0, 1, i);
+ pl_bii = s7_make_signature(s7, 3, b, i, i);
+ pl_p = s7_make_circular_signature(s7, 0, 1, p);
+ pl_l = s7_make_circular_signature(s7, 0, 1, l);
+ pl_rs = s7_make_signature(s7, 2, r, s);
+ pl_bi = s7_make_signature(s7, 2, b, i);
+ pl_bib = s7_make_signature(s7, 3, b, i, b);
+ pl_b = s7_make_circular_signature(s7, 0, 1, b);
+ pl_bs = s7_make_signature(s7, 2, b, s);
+ pl_isfiii = s7_make_signature(s7, 6, i, s, f, i, i, i);
+ pl_fsiiif = s7_make_signature(s7, 6, f, s, i, i, i, f);
+ }
#endif
-#if HAVE_FORTH
- fth_set_object_inspect(sound_data_tag, print_sound_data);
- fth_set_object_equal(sound_data_tag, equalp_sound_data);
- fth_set_object_to_array(sound_data_tag, g_sound_data_to_vector);
- fth_set_object_length(sound_data_tag, g_sound_data_length);
- fth_set_object_free(sound_data_tag, free_sound_data);
- fth_set_object_apply(sound_data_tag, XEN_PROCEDURE_CAST sound_data_apply, 2, 0, 0);
-#endif
+ Xen_define_typed_dilambda(S_mus_sound_samples, g_mus_sound_samples_w, H_mus_sound_samples,
+ S_set S_mus_sound_samples, g_mus_sound_set_samples_w, 1, 0, 2, 0, pl_is, pl_isi);
+ Xen_define_typed_dilambda(S_mus_sound_data_location, g_mus_sound_data_location_w, H_mus_sound_data_location,
+ S_set S_mus_sound_data_location, g_mus_sound_set_data_location_w, 1, 0, 2, 0, pl_is, pl_isi);
+ Xen_define_typed_dilambda(S_mus_sound_chans, g_mus_sound_chans_w, H_mus_sound_chans,
+ S_set S_mus_sound_chans, g_mus_sound_set_chans_w, 1, 0, 2, 0, pl_is, pl_isi);
+ Xen_define_typed_dilambda(S_mus_sound_srate, g_mus_sound_srate_w, H_mus_sound_srate,
+ S_set S_mus_sound_srate, g_mus_sound_set_srate_w, 1, 0, 2, 0, pl_is, pl_isi);
+ Xen_define_typed_dilambda(S_mus_sound_header_type, g_mus_sound_header_type_w, H_mus_sound_header_type,
+ S_set S_mus_sound_header_type, g_mus_sound_set_header_type_w, 1, 0, 2, 0, pl_is, pl_isi);
+ Xen_define_typed_dilambda(S_mus_sound_sample_type, g_mus_sound_sample_type_w, H_mus_sound_sample_type,
+ S_set S_mus_sound_sample_type, g_mus_sound_set_sample_type_w, 1, 0, 2, 0, pl_is, pl_isi);
+
+ Xen_define_typed_procedure(S_mus_sound_framples, g_mus_sound_framples_w, 1, 0, 0, H_mus_sound_framples, pl_is);
+ Xen_define_typed_procedure("mus-sound-frames", g_mus_sound_framples_w, 1, 0, 0, H_mus_sound_framples, pl_is);
+ Xen_define_typed_procedure(S_mus_sound_duration, g_mus_sound_duration_w, 1, 0, 0, H_mus_sound_duration, pl_rs);
+ Xen_define_typed_procedure(S_mus_sound_datum_size, g_mus_sound_datum_size_w, 1, 0, 0, H_mus_sound_datum_size, pl_is);
+ Xen_define_typed_procedure(S_mus_sound_length, g_mus_sound_length_w, 1, 0, 0, H_mus_sound_length, pl_is);
+ Xen_define_typed_procedure(S_mus_sound_type_specifier, g_mus_sound_type_specifier_w, 1, 0, 0, H_mus_sound_type_specifier, pl_is);
+ Xen_define_typed_procedure(S_mus_header_type_name, g_mus_header_type_name_w, 1, 0, 0, H_mus_header_type_name, pl_si);
+ Xen_define_typed_procedure(S_mus_header_type_to_string,g_mus_header_type_to_string_w, 1, 0, 0, H_mus_header_type_to_string, pl_si);
+ Xen_define_typed_procedure(S_mus_header_writable, g_mus_header_writable_w, 2, 0, 0, H_mus_header_writable, pl_bii);
+ Xen_define_typed_procedure(S_mus_sample_type_name, g_mus_sample_type_name_w, 1, 0, 0, H_mus_sample_type_name, pl_si);
+ Xen_define_typed_procedure(S_mus_sample_type_to_string,g_mus_sample_type_to_string_w, 1, 0, 0, H_mus_sample_type_to_string, pl_si);
+ Xen_define_typed_procedure(S_mus_sound_comment, g_mus_sound_comment_w, 1, 0, 0, H_mus_sound_comment, pl_ts);
+ Xen_define_typed_procedure(S_mus_sound_write_date, g_mus_sound_write_date_w, 1, 0, 0, H_mus_sound_write_date, pl_is);
+ Xen_define_typed_procedure(S_mus_bytes_per_sample, g_mus_bytes_per_sample_w, 1, 0, 0, H_mus_bytes_per_sample, pl_i);
+ Xen_define_typed_procedure(S_mus_sound_loop_info, g_mus_sound_loop_info_w, 1, 0, 0, H_mus_sound_loop_info, pl_ps);
+ Xen_define_typed_procedure(S_mus_sound_mark_info, g_mus_sound_mark_info_w, 1, 0, 0, H_mus_sound_mark_info, pl_ps);
+ Xen_define_typed_procedure(S_mus_sound_maxamp_exists, g_mus_sound_maxamp_exists_w, 1, 0, 0, H_mus_sound_maxamp_exists, pl_bs);
+ Xen_define_typed_procedure(S_mus_sound_forget, g_mus_sound_forget_w, 1, 0, 0, H_mus_sound_forget, pl_is);
+ Xen_define_typed_procedure(S_mus_sound_prune, g_mus_sound_prune_w, 0, 0, 0, H_mus_sound_prune, pl_i);
+
+ Xen_define_typed_procedure(S_mus_expand_filename, g_mus_expand_filename_w, 1, 0, 0, H_mus_expand_filename, pl_ss);
+ Xen_define_typed_procedure(S_mus_sound_report_cache, g_mus_sound_report_cache_w, 0, 1, 0, H_mus_sound_report_cache, NULL);
+ Xen_define_typed_procedure(S_mus_error_type_to_string, g_mus_error_type_to_string_w, 1, 0, 0, H_mus_error_type_to_string, pl_si);
+ Xen_define_typed_procedure(S_mus_oss_set_buffers, g_mus_oss_set_buffers_w, 2, 0, 0, H_mus_oss_set_buffers, pl_bii);
+ Xen_define_typed_procedure(S_array_to_file, g_array_to_file_w, 5, 0, 0, H_array_to_file, pl_isfiii);
+ Xen_define_typed_procedure(S_file_to_array, g_file_to_array_w, 5, 0, 0, H_file_to_array, pl_fsiiif);
+
+ Xen_define_typed_procedure(S_mus_sound_preload, g_mus_sound_preload_w, 1, 0, 0, H_mus_sound_preload, pl_ss);
+
+ Xen_define_typed_dilambda(S_mus_header_raw_defaults, g_mus_header_raw_defaults_w, H_mus_header_raw_defaults,
+ S_set S_mus_header_raw_defaults, g_mus_header_set_raw_defaults_w, 0, 0, 1, 0, pl_p, pl_p);
+
+ Xen_define_typed_dilambda(S_mus_clipping, g_mus_clipping_w, H_mus_clipping,
+ S_set S_mus_clipping, g_mus_set_clipping_w, 0, 0, 1, 0, pl_b, pl_b);
+ Xen_define_typed_dilambda(S_mus_file_clipping, g_mus_file_clipping_w, H_mus_file_clipping,
+ S_set S_mus_file_clipping, g_mus_file_set_clipping_w, 1, 0, 2, 0, pl_bi, pl_bib);
+ Xen_define_typed_dilambda(S_mus_sound_maxamp, g_mus_sound_maxamp_w, H_mus_sound_maxamp,
+ S_set S_mus_sound_maxamp, g_mus_sound_set_maxamp_w, 1, 0, 2, 0, pl_ps, pl_psp);
-#if HAVE_RUBY
- Init_Hook();
- rb_include_module(sound_data_tag, rb_mComparable);
- rb_include_module(sound_data_tag, rb_mEnumerable);
- rb_define_method(sound_data_tag, "to_s", XEN_PROCEDURE_CAST print_sound_data, 0);
- rb_define_method(sound_data_tag, "eql?", XEN_PROCEDURE_CAST equalp_sound_data, 1);
- rb_define_method(sound_data_tag, "==", XEN_PROCEDURE_CAST equalp_sound_data, 1);
- rb_define_method(sound_data_tag, "each", XEN_PROCEDURE_CAST sound_data_each, 0);
- rb_define_method(sound_data_tag, "<=>", XEN_PROCEDURE_CAST sound_data_compare, 1);
- rb_define_method(sound_data_tag, "[]", XEN_PROCEDURE_CAST g_sound_data_ref, 2);
- rb_define_method(sound_data_tag, "[]=", XEN_PROCEDURE_CAST g_sound_data_set, 3);
- rb_define_method(sound_data_tag, "length", XEN_PROCEDURE_CAST sound_data_size, 0);
- rb_define_method(sound_data_tag, "size", XEN_PROCEDURE_CAST sound_data_size, 0);
- rb_define_method(sound_data_tag, "fill", XEN_PROCEDURE_CAST g_rb_sound_data_fill, 1);
- rb_define_method(sound_data_tag, "dup", XEN_PROCEDURE_CAST g_sound_data_copy, 0);
- rb_define_method(sound_data_tag, "chans", XEN_PROCEDURE_CAST sound_data_chans, 0);
- rb_define_method(sound_data_tag, "peak", XEN_PROCEDURE_CAST g_sound_data_peak, 0);
- rb_define_method(sound_data_tag, "offset!", XEN_PROCEDURE_CAST g_sound_data_offsetB, 1);
- rb_define_method(sound_data_tag, "multiply!", XEN_PROCEDURE_CAST g_sound_data_multiplyB, 1);
-
- rb_define_method(sound_data_tag, "add!", XEN_PROCEDURE_CAST g_sound_data_addB, 1);
- rb_define_method(sound_data_tag, "scale!", XEN_PROCEDURE_CAST g_sound_data_scaleB, 1);
- rb_define_method(sound_data_tag, "reverse!", XEN_PROCEDURE_CAST g_sound_data_reverseB, 0);
-
- rb_define_singleton_method(sound_data_tag, "new", XEN_PROCEDURE_CAST g_rb_make_sound_data, 2);
-#endif
+ /* these are no-ops if not ALSA, but that makes it easier to maintain global initialization files */
+ Xen_define_typed_dilambda(S_mus_alsa_buffers, g_mus_alsa_buffers_w, H_mus_alsa_buffers, S_set
+ S_mus_alsa_buffers, g_mus_alsa_set_buffers_w, 0, 0, 1, 0, NULL, NULL);
+ Xen_define_typed_dilambda(S_mus_alsa_buffer_size, g_mus_alsa_buffer_size_w, H_mus_alsa_buffer_size,
+ S_set S_mus_alsa_buffer_size, g_mus_alsa_set_buffer_size_w, 0, 0, 1, 0, NULL, NULL);
+ Xen_define_typed_dilambda(S_mus_alsa_device, g_mus_alsa_device_w, H_mus_alsa_device,
+ S_set S_mus_alsa_device, g_mus_alsa_set_device_w, 0, 0, 1, 0, NULL, NULL);
+ Xen_define_typed_dilambda(S_mus_alsa_playback_device, g_mus_alsa_playback_device_w, H_mus_alsa_playback_device,
+ S_set S_mus_alsa_playback_device, g_mus_alsa_set_playback_device_w, 0, 0, 1, 0, NULL, NULL);
+ Xen_define_typed_dilambda(S_mus_alsa_capture_device, g_mus_alsa_capture_device_w, H_mus_alsa_capture_device,
+ S_set S_mus_alsa_capture_device, g_mus_alsa_set_capture_device_w, 0, 0, 1, 0, NULL, NULL);
+ Xen_define_typed_dilambda(S_mus_alsa_squelch_warning, g_mus_alsa_squelch_warning_w, H_mus_alsa_squelch_warning,
+ S_set S_mus_alsa_squelch_warning, g_mus_alsa_set_squelch_warning_w, 0, 0, 1, 0, NULL, NULL);
+
+ Xen_define_typed_dilambda(S_mus_max_malloc, g_mus_max_malloc_w, H_mus_max_malloc,
+ S_set S_mus_max_malloc, g_mus_set_max_malloc_w, 0, 0, 1, 0, pl_i, pl_i);
+ Xen_define_typed_dilambda(S_mus_max_table_size, g_mus_max_table_size_w, H_mus_max_table_size,
+ S_set S_mus_max_table_size, g_mus_set_max_table_size_w, 0, 0, 1, 0, pl_i, pl_i);
+ Xen_define_typed_dilambda(S_mus_sound_path, g_mus_sound_path_w, H_mus_sound_path,
+ S_set S_mus_sound_path, g_mus_set_sound_path_w, 0, 0, 1, 0, pl_l, pl_l);
- XEN_DEFINE_CONSTANT(S_mus_out_format, MUS_OUT_FORMAT, "sample format for fastest IO");
- XEN_DEFINE_CONSTANT(S_mus_unsupported, MUS_UNSUPPORTED, "unsupported header id");
- XEN_DEFINE_CONSTANT(S_mus_next, MUS_NEXT, "NeXT (Sun) sound header id");
- XEN_DEFINE_CONSTANT(S_mus_aifc, MUS_AIFC, "AIFC sound header id");
- XEN_DEFINE_CONSTANT(S_mus_rf64, MUS_RF64, "RF64 sound header id");
- XEN_DEFINE_CONSTANT(S_mus_riff, MUS_RIFF, "RIFF (MS wave) sound header id");
- XEN_DEFINE_CONSTANT(S_mus_nist, MUS_NIST, "NIST (Sphere) sound header id");
- XEN_DEFINE_CONSTANT(S_mus_raw, MUS_RAW, "raw (headerless) sound header id");
- XEN_DEFINE_CONSTANT(S_mus_ircam, MUS_IRCAM, "IRCAM sound header id");
- XEN_DEFINE_CONSTANT(S_mus_aiff, MUS_AIFF, "AIFF (old-style) sound header id");
- XEN_DEFINE_CONSTANT(S_mus_bicsf, MUS_BICSF, "BICSF header id");
- XEN_DEFINE_CONSTANT(S_mus_voc, MUS_VOC, "VOC header id");
- XEN_DEFINE_CONSTANT(S_mus_svx, MUS_SVX, "SVX (IFF) header id");
- XEN_DEFINE_CONSTANT(S_mus_soundfont, MUS_SOUNDFONT, "soundfont header id");
- XEN_DEFINE_CONSTANT(S_mus_caff, MUS_CAFF, "Apple Core Audio File Format header id");
-
- XEN_DEFINE_CONSTANT(S_mus_unknown, MUS_UNKNOWN, "unknown data format");
- XEN_DEFINE_CONSTANT(S_mus_bshort, MUS_BSHORT, "big-endian short data format id");
- XEN_DEFINE_CONSTANT(S_mus_lshort, MUS_LSHORT, "little-endian short data format id");
- XEN_DEFINE_CONSTANT(S_mus_mulaw, MUS_MULAW, "mulaw (8-bit) data format id");
- XEN_DEFINE_CONSTANT(S_mus_alaw, MUS_ALAW, "alaw (8-bit) data format id");
- XEN_DEFINE_CONSTANT(S_mus_byte, MUS_BYTE, "signed byte data format id");
- XEN_DEFINE_CONSTANT(S_mus_ubyte, MUS_UBYTE, "unsigned byte data format id");
- XEN_DEFINE_CONSTANT(S_mus_bfloat, MUS_BFLOAT, "big-endian float data format id");
- XEN_DEFINE_CONSTANT(S_mus_lfloat, MUS_LFLOAT, "little-endian float data format id");
- XEN_DEFINE_CONSTANT(S_mus_bint, MUS_BINT, "big-endian int data format id");
- XEN_DEFINE_CONSTANT(S_mus_lint, MUS_LINT, "little-endian int data format id");
- XEN_DEFINE_CONSTANT(S_mus_bintn, MUS_BINTN, "normalized big-endian int data format id");
- XEN_DEFINE_CONSTANT(S_mus_lintn, MUS_LINTN, "normalized little-endian int data format id");
- XEN_DEFINE_CONSTANT(S_mus_b24int, MUS_B24INT, "big-endian 24-bit data format id");
- XEN_DEFINE_CONSTANT(S_mus_l24int, MUS_L24INT, "little-endian 24-bit data format id");
- XEN_DEFINE_CONSTANT(S_mus_bdouble, MUS_BDOUBLE, "big-endian double data format id");
- XEN_DEFINE_CONSTANT(S_mus_ldouble, MUS_LDOUBLE, "little-endian double data format id");
- XEN_DEFINE_CONSTANT(S_mus_ubshort, MUS_UBSHORT, "unsigned big-endian short data format id");
- XEN_DEFINE_CONSTANT(S_mus_ulshort, MUS_ULSHORT, "unsigned little-endian short data format id");
- XEN_DEFINE_CONSTANT(S_mus_bdouble_unscaled, MUS_BDOUBLE_UNSCALED, "unscaled big-endian double data format id");
- XEN_DEFINE_CONSTANT(S_mus_ldouble_unscaled, MUS_LDOUBLE_UNSCALED, "unscaled little-endian double data format id");
- XEN_DEFINE_CONSTANT(S_mus_bfloat_unscaled, MUS_BFLOAT_UNSCALED, "unscaled big-endian float data format id");
- XEN_DEFINE_CONSTANT(S_mus_lfloat_unscaled, MUS_LFLOAT_UNSCALED, "unscaled little-endian float data format id");
-
- XEN_DEFINE_CONSTANT(S_mus_audio_default, MUS_AUDIO_DEFAULT, "default audio device");
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_sound_samples, g_mus_sound_samples_w, H_mus_sound_samples,
- S_setB S_mus_sound_samples, g_mus_sound_set_samples_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_sound_data_location, g_mus_sound_data_location_w, H_mus_sound_data_location,
- S_setB S_mus_sound_data_location, g_mus_sound_set_data_location_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_sound_chans, g_mus_sound_chans_w, H_mus_sound_chans,
- S_setB S_mus_sound_chans, g_mus_sound_set_chans_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_sound_srate, g_mus_sound_srate_w, H_mus_sound_srate,
- S_setB S_mus_sound_srate, g_mus_sound_set_srate_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_sound_header_type, g_mus_sound_header_type_w, H_mus_sound_header_type,
- S_setB S_mus_sound_header_type, g_mus_sound_set_header_type_w, 1, 0, 2, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_sound_data_format, g_mus_sound_data_format_w, H_mus_sound_data_format,
- S_setB S_mus_sound_data_format, g_mus_sound_set_data_format_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE(S_sound_data_length, g_sound_data_length_w, 1, 0, 0, H_sound_data_length);
- XEN_DEFINE_PROCEDURE(S_sound_data_chans, g_sound_data_chans_w, 1, 0, 0, H_sound_data_chans);
- XEN_DEFINE_PROCEDURE(S_sound_data_copy, g_sound_data_copy_w, 1, 0, 0, H_sound_data_copy);
- XEN_DEFINE_PROCEDURE(S_sound_data_addB, g_sound_data_addB_w, 2, 0, 0, H_sound_data_addB);
- XEN_DEFINE_PROCEDURE(S_sound_data_add, g_sound_data_add_w, 2, 0, 0, H_sound_data_add);
- XEN_DEFINE_PROCEDURE(S_sound_data_offsetB, g_sound_data_offsetB_w, 2, 0, 0, H_sound_data_offsetB);
- XEN_DEFINE_PROCEDURE(S_sound_data_multiplyB, g_sound_data_multiplyB_w, 2, 0, 0, H_sound_data_multiplyB);
- XEN_DEFINE_PROCEDURE(S_sound_data_multiply, g_sound_data_multiply_w, 2, 0, 0, H_sound_data_multiply);
- XEN_DEFINE_PROCEDURE(S_make_sound_data, g_make_sound_data_w, 2, 0, 0, H_make_sound_data);
- XEN_DEFINE_PROCEDURE(S_sound_data_p, g_sound_data_p_w, 1, 0, 0, H_sound_data_p);
- XEN_DEFINE_PROCEDURE(S_sound_data_maxamp, g_sound_data_maxamp_w, 1, 0, 0, H_sound_data_maxamp);
- XEN_DEFINE_PROCEDURE(S_sound_data_peak, g_sound_data_peak_w, 1, 0, 0, H_sound_data_peak);
- XEN_DEFINE_PROCEDURE(S_sound_data_setB, g_sound_data_set_w, 4, 0, 0, H_sound_data_setB);
- XEN_DEFINE_PROCEDURE(S_sound_data_scaleB, g_sound_data_scaleB_w, 2, 0, 0, H_sound_data_scaleB);
- XEN_DEFINE_PROCEDURE(S_sound_data_fillB, g_sound_data_fillB_w, 2, 0, 0, H_sound_data_fillB);
- XEN_DEFINE_PROCEDURE(S_sound_data_reverseB, g_sound_data_reverseB_w, 1, 0, 0, H_sound_data_reverseB);
- XEN_DEFINE_PROCEDURE(S_sound_data_to_vct, g_sound_data_to_vct_w, 1, 2, 0, H_sound_data_to_vct);
- XEN_DEFINE_PROCEDURE(S_sound_data_to_sound_data, g_sound_data_to_sound_data_w, 5, 0, 0, H_sound_data_to_sound_data);
- XEN_DEFINE_PROCEDURE(S_vct_to_sound_data, g_vct_to_sound_data_w, 1, 2, 0, H_vct_to_sound_data);
-
- XEN_DEFINE_PROCEDURE(S_mus_sound_frames, g_mus_sound_frames_w, 1, 0, 0, H_mus_sound_frames);
- XEN_DEFINE_PROCEDURE(S_mus_sound_duration, g_mus_sound_duration_w, 1, 0, 0, H_mus_sound_duration);
- XEN_DEFINE_PROCEDURE(S_mus_sound_datum_size, g_mus_sound_datum_size_w, 1, 0, 0, H_mus_sound_datum_size);
- XEN_DEFINE_PROCEDURE(S_mus_sound_length, g_mus_sound_length_w, 1, 0, 0, H_mus_sound_length);
- XEN_DEFINE_PROCEDURE(S_mus_sound_type_specifier, g_mus_sound_type_specifier_w, 1, 0, 0, H_mus_sound_type_specifier);
- XEN_DEFINE_PROCEDURE(S_mus_header_type_name, g_mus_header_type_name_w, 1, 0, 0, H_mus_header_type_name);
- XEN_DEFINE_PROCEDURE(S_mus_header_type_to_string,g_mus_header_type_to_string_w, 1, 0, 0, H_mus_header_type_to_string);
- XEN_DEFINE_PROCEDURE(S_mus_data_format_name, g_mus_data_format_name_w, 1, 0, 0, H_mus_data_format_name);
- XEN_DEFINE_PROCEDURE(S_mus_data_format_to_string,g_mus_data_format_to_string_w, 1, 0, 0, H_mus_data_format_to_string);
- XEN_DEFINE_PROCEDURE(S_mus_sound_comment, g_mus_sound_comment_w, 1, 0, 0, H_mus_sound_comment);
- XEN_DEFINE_PROCEDURE(S_mus_sound_write_date, g_mus_sound_write_date_w, 1, 0, 0, H_mus_sound_write_date);
- XEN_DEFINE_PROCEDURE(S_mus_bytes_per_sample, g_mus_bytes_per_sample_w, 1, 0, 0, H_mus_bytes_per_sample);
- XEN_DEFINE_PROCEDURE(S_mus_sound_loop_info, g_mus_sound_loop_info_w, 1, 0, 0, H_mus_sound_loop_info);
- XEN_DEFINE_PROCEDURE(S_mus_sound_mark_info, g_mus_sound_mark_info_w, 1, 0, 0, H_mus_sound_mark_info);
- XEN_DEFINE_PROCEDURE(S_mus_sound_maxamp_exists, g_mus_sound_maxamp_exists_w, 1, 0, 0, H_mus_sound_maxamp_exists);
- XEN_DEFINE_PROCEDURE(S_mus_sound_forget, g_mus_sound_forget_w, 1, 0, 0, H_mus_sound_forget);
- XEN_DEFINE_PROCEDURE(S_mus_sound_prune, g_mus_sound_prune_w, 0, 0, 0, H_mus_sound_prune);
- XEN_DEFINE_PROCEDURE(S_mus_sound_open_input, g_mus_sound_open_input_w, 1, 0, 0, H_mus_sound_open_input);
- XEN_DEFINE_PROCEDURE(S_mus_sound_close_input, g_mus_sound_close_input_w, 1, 0, 0, H_mus_sound_close_input);
-
- XEN_DEFINE_PROCEDURE(S_mus_audio_describe, g_mus_audio_describe_w, 0, 0, 0, H_mus_audio_describe);
- XEN_DEFINE_PROCEDURE(S_mus_audio_close, g_mus_audio_close_w, 1, 0, 0, H_mus_audio_close);
- XEN_DEFINE_PROCEDURE(S_mus_audio_write, g_mus_audio_write_w, 3, 1, 0, H_mus_audio_write);
- XEN_DEFINE_PROCEDURE(S_mus_audio_read, g_mus_audio_read_w, 3, 0, 0, H_mus_audio_read);
- XEN_DEFINE_PROCEDURE(S_mus_audio_open_output, g_mus_audio_open_output_w, 5, 0, 0, H_mus_audio_open_output);
- XEN_DEFINE_PROCEDURE(S_mus_audio_open_input, g_mus_audio_open_input_w, 5, 0, 0, H_mus_audio_open_input);
-
- XEN_DEFINE_PROCEDURE(S_mus_expand_filename, g_mus_expand_filename_w, 1, 0, 0, H_mus_expand_filename);
- XEN_DEFINE_PROCEDURE(S_mus_sound_open_output, g_mus_sound_open_output_w, 1, 5, 0, H_mus_sound_open_output);
- XEN_DEFINE_PROCEDURE(S_mus_sound_reopen_output, g_mus_sound_reopen_output_w, 1, 4, 0, H_mus_sound_reopen_output);
- XEN_DEFINE_PROCEDURE(S_mus_sound_close_output, g_mus_sound_close_output_w, 2, 0, 0, H_mus_sound_close_output);
- XEN_DEFINE_PROCEDURE(S_mus_sound_read, g_mus_sound_read_w, 5, 0, 0, H_mus_sound_read);
- XEN_DEFINE_PROCEDURE(S_mus_sound_write, g_mus_sound_write_w, 5, 0, 0, H_mus_sound_write);
- XEN_DEFINE_PROCEDURE(S_mus_sound_seek_frame, g_mus_sound_seek_frame_w, 2, 0, 0, H_mus_sound_seek_frame);
- XEN_DEFINE_PROCEDURE(S_mus_sound_report_cache, g_mus_sound_report_cache_w, 0, 1, 0, H_mus_sound_report_cache);
- XEN_DEFINE_PROCEDURE(S_mus_error_type_to_string, g_mus_error_type_to_string_w, 1, 0, 0, H_mus_error_type_to_string);
- XEN_DEFINE_PROCEDURE(S_mus_oss_set_buffers, g_mus_oss_set_buffers_w, 2, 0, 0, H_mus_oss_set_buffers);
- XEN_DEFINE_PROCEDURE(S_array_to_file, g_array_to_file_w, 5, 0, 0, H_array_to_file);
- XEN_DEFINE_PROCEDURE(S_file_to_array, g_file_to_array_w, 5, 0, 0, H_file_to_array);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_header_raw_defaults, g_mus_header_raw_defaults_w, H_mus_header_raw_defaults,
- S_setB S_mus_header_raw_defaults, g_mus_header_set_raw_defaults_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_prescaler, g_mus_prescaler_w, H_mus_prescaler,
- S_setB S_mus_prescaler, g_mus_set_prescaler_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_file_prescaler, g_mus_file_prescaler_w, H_mus_file_prescaler,
- S_setB S_mus_file_prescaler, g_mus_file_set_prescaler_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_clipping, g_mus_clipping_w, H_mus_clipping,
- S_setB S_mus_clipping, g_mus_set_clipping_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_file_clipping, g_mus_file_clipping_w, H_mus_file_clipping,
- S_setB S_mus_file_clipping, g_mus_file_set_clipping_w, 1, 0, 2, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_sound_data_ref, g_sound_data_ref_w, H_sound_data_ref,
- S_setB S_sound_data_ref, g_sound_data_set_w, 3, 0, 4, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_sound_maxamp, g_mus_sound_maxamp_w, H_mus_sound_maxamp,
- S_setB S_mus_sound_maxamp, g_mus_sound_set_maxamp_w, 1, 0, 2, 0);
+#if HAVE_SCHEME
+ mus_max_table_size_symbol = s7_define_variable(s7, "*" S_mus_max_table_size "*", s7_make_integer(s7, MUS_MAX_TABLE_SIZE_DEFAULT));
+ s7_symbol_set_documentation(s7, mus_max_table_size_symbol, "*mus-max-table-size*: maximum table size.");
+ s7_symbol_set_access(s7, mus_max_table_size_symbol, s7_make_function(s7, "[acc-mus-max-table-size]" "]", acc_mus_max_table_size, 2, 0, false, "accessor"));
- /* these are no-ops if not ALSA, but that makes it easier to maintain global initialization files */
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_alsa_buffers, g_mus_alsa_buffers_w, H_mus_alsa_buffers,
- S_setB S_mus_alsa_buffers, g_mus_alsa_set_buffers_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_alsa_buffer_size, g_mus_alsa_buffer_size_w, H_mus_alsa_buffer_size,
- S_setB S_mus_alsa_buffer_size, g_mus_alsa_set_buffer_size_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_alsa_device, g_mus_alsa_device_w, H_mus_alsa_device,
- S_setB S_mus_alsa_device, g_mus_alsa_set_device_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_alsa_playback_device, g_mus_alsa_playback_device_w, H_mus_alsa_playback_device,
- S_setB S_mus_alsa_playback_device, g_mus_alsa_set_playback_device_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_alsa_capture_device, g_mus_alsa_capture_device_w, H_mus_alsa_capture_device,
- S_setB S_mus_alsa_capture_device, g_mus_alsa_set_capture_device_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_alsa_squelch_warning, g_mus_alsa_squelch_warning_w, H_mus_alsa_squelch_warning,
- S_setB S_mus_alsa_squelch_warning, g_mus_alsa_set_squelch_warning_w, 0, 0, 1, 0);
-
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_max_malloc, g_mus_max_malloc_w, H_mus_max_malloc,
- S_setB S_mus_max_malloc, g_mus_set_max_malloc_w, 0, 0, 1, 0);
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_mus_max_table_size, g_mus_max_table_size_w, H_mus_max_table_size,
- S_setB S_mus_max_table_size, g_mus_set_max_table_size_w, 0, 0, 1, 0);
-
-#if HAVE_OSS
- XEN_DEFINE_PROCEDURE(S_mus_audio_reinitialize, g_mus_audio_reinitialize_w, 0, 0, 0, H_mus_audio_reinitialize);
-#endif
+ mus_max_malloc_symbol = s7_define_variable(s7, "*" S_mus_max_malloc "*", s7_make_integer(s7, MUS_MAX_MALLOC_DEFAULT));
+ s7_symbol_set_documentation(s7, mus_max_malloc_symbol, "*mus-max-malloc*: maximum number of bytes we will try to malloc.");
+ s7_symbol_set_access(s7, mus_max_malloc_symbol, s7_make_function(s7, "[acc-mus-max-malloc]" "]", acc_mus_max_malloc, 2, 0, false, "accessor"));
-#if HAVE_FORTH
- XEN_DEFINE_PROCEDURE(S_sound_data_to_vector, g_sound_data_to_vector /* no _w! */, 1, 0, 0, H_sound_data_to_vector);
+ mus_sound_path_symbol = s7_define_variable(s7, "*" S_mus_sound_path "*", s7_nil(s7));
+ s7_symbol_set_documentation(s7, mus_sound_path_symbol, "*" S_mus_sound_path "* is a list of directories to search for sound files");
+ s7_symbol_set_access(s7, mus_sound_path_symbol, s7_make_function(s7, "[acc-mus-sound-path]" "]", acc_mus_sound_path, 2, 0, false, "accessor"));
#endif
-#if MUS_MAC_OSX
- XEN_DEFINE_PROCEDURE(S_mus_audio_output_properties_mutable, g_mus_audio_output_properties_mutable_w, 1, 0, 0, H_mus_audio_output_properties_mutable);
+#if __APPLE__
+ Xen_define_procedure(S_mus_audio_output_properties_mutable, g_mus_audio_output_properties_mutable_w, 1, 0, 0, H_mus_audio_output_properties_mutable);
#endif
-
- #define H_new_sound_hook S_new_sound_hook "(filename): called when a new sound file is being created"
- new_sound_hook = XEN_DEFINE_HOOK(S_new_sound_hook, 1, H_new_sound_hook); /* arg = filename */
+ #define H_new_sound_hook S_new_sound_hook "(name): called when a new sound file is being created"
+ new_sound_hook = Xen_define_hook(S_new_sound_hook, "(make-hook 'name)", 1, H_new_sound_hook);
mus_header_write_set_hook(g_new_sound_hook);
- XEN_YES_WE_HAVE("sndlib");
+ Xen_provide_feature("sndlib");
}
diff --git a/sndlib2xen.h b/sndlib2xen.h
index d6458eb..907fe88 100644
--- a/sndlib2xen.h
+++ b/sndlib2xen.h
@@ -5,48 +5,24 @@
/* error indications */
-#define NO_SUCH_CHANNEL XEN_ERROR_TYPE("no-such-channel")
-#define NO_SUCH_FILE XEN_ERROR_TYPE("no-such-file")
-#define BAD_TYPE XEN_ERROR_TYPE("bad-type")
-#define NO_DATA XEN_ERROR_TYPE("no-data")
-#define BAD_HEADER XEN_ERROR_TYPE("bad-header")
-
-typedef struct {
- mus_long_t length;
- int chans;
- mus_float_t **data;
- bool wrapped;
-} sound_data;
+#define NO_SUCH_CHANNEL Xen_make_error_type("no-such-channel")
+#define NO_SUCH_FILE Xen_make_error_type("no-such-file")
+#define BAD_TYPE Xen_make_error_type("bad-type")
+#define NO_DATA Xen_make_error_type("no-data")
+#define BAD_HEADER Xen_make_error_type("bad-header")
#ifdef __cplusplus
extern "C" {
#endif
-MUS_EXPORT bool sound_data_p(XEN obj);
-MUS_EXPORT char *sound_data_to_string(sound_data *v);
-MUS_EXPORT void sound_data_free(sound_data *v);
-MUS_EXPORT bool sound_data_equalp(sound_data *v1, sound_data *v2);
-MUS_EXPORT sound_data *c_make_sound_data(int chans, mus_long_t frames);
-MUS_EXPORT XEN make_sound_data(int chans, mus_long_t frames);
MUS_EXPORT void mus_sndlib_xen_initialize (void);
-MUS_EXPORT XEN wrap_sound_data(int chans, mus_long_t frames, mus_float_t **data);
-MUS_EXPORT sound_data *sound_data_scale(sound_data *sd, mus_float_t scaler);
-MUS_EXPORT sound_data *sound_data_fill(sound_data *sd, mus_float_t scaler);
-MUS_EXPORT mus_float_t sound_data_peak(sound_data *sd);
-MUS_EXPORT sound_data *sound_data_copy(sound_data *sd);
-MUS_EXPORT sound_data *sound_data_reverse(sound_data *sd);
-MUS_EXPORT sound_data *sound_data_add(sound_data *sd1, sound_data *sd2);
-MUS_EXPORT sound_data *sound_data_multiply(sound_data *sd1, sound_data *sd2);
-MUS_EXPORT sound_data *sound_data_offset(sound_data *sd, mus_float_t off);
-
-#define XEN_TO_SOUND_DATA(Obj) (sound_data *)XEN_OBJECT_REF(Obj)
-
-MUS_EXPORT XEN g_mus_sound_srate(XEN filename);
-MUS_EXPORT XEN g_mus_sound_chans(XEN filename);
-MUS_EXPORT XEN g_mus_sound_frames(XEN filename);
-MUS_EXPORT XEN g_mus_expand_filename(XEN file);
-MUS_EXPORT XEN g_sound_data_maxamp(XEN obj);
-MUS_EXPORT XEN g_mus_sound_maxamp(XEN file);
+MUS_EXPORT Xen g_mus_sound_srate(Xen filename); /* snd-snd.c */
+MUS_EXPORT Xen g_mus_sound_chans(Xen filename); /* snd-snd.c */
+MUS_EXPORT Xen g_mus_sound_framples(Xen filename); /* snd-chn.c */
+MUS_EXPORT Xen g_mus_expand_filename(Xen file); /* snd-snd.c */
+MUS_EXPORT Xen g_mus_sound_maxamp(Xen file); /* snd-chn.c */
+
+MUS_EXPORT Xen g_mus_sound_path(void);
#ifdef __cplusplus
}
diff --git a/sndplay.c b/sndplay.c
index bada283..6bc0d49 100644
--- a/sndplay.c
+++ b/sndplay.c
@@ -1,6 +1,6 @@
/* sndplay plays sounds */
-#include <mus-config.h>
+#include "mus-config.h"
#include <math.h>
#include <stdio.h>
@@ -8,19 +8,15 @@
#include "_sndlib.h"
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
-#else
- #if (!(defined(_MSC_VER)))
- #include <unistd.h>
- #endif
- #include <string.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
#endif
+#include <string.h>
-#if MUS_MAC_OSX
+#if __APPLE__
#define BUFFER_SIZE 256
#else
-#if MUS_WINDOZE
+#ifdef _MSC_VER
/* this setting from Scott Middleton (actually used 8096) */
#define BUFFER_SIZE 8192
#else
@@ -28,132 +24,115 @@
#endif
#endif
-#if MUS_MAC_OSX
+#if __APPLE__
#define OutSample float
- #define MUS_CONVERT(samp) MUS_SAMPLE_TO_FLOAT(samp)
+ #define MUS_CONVERT(samp) (float)(samp)
#else
#define OutSample short
+ #define MUS_SAMPLE_TO_SHORT(n) ((short)((n) * (1 << 15)))
#define MUS_CONVERT(samp) MUS_SAMPLE_TO_SHORT(samp)
#endif
-static void set_buffers(char *bufs)
-{
-#if (HAVE_OSS || HAVE_ALSA)
-static char x_string[2] = {'x','\0'};
- char *arg;
- int a, b;
- arg = strtok(bufs, x_string);
- a = atoi(arg);
- arg = strtok(NULL, x_string);
- b = atoi(arg);
- mus_oss_set_buffers(a, b);
-#endif
-}
-
-static void set_volume(mus_sample_t **buf, int chans, int length, double volume)
-{
- int n, ch;
- for (ch = 0; ch < chans; ch++)
- for (n = 0; n < length; n++)
- buf[ch][n] *= volume;
-}
/* 22-Nov-00: moved alsa support to separate block */
/* 8-Apr-04: added start/end (seconds-based) args */
-/* 2-Nov-05: added -volume arg */
+/* 2-Nov-05: added -volume arg (removed later) */
/* 22-July-08: added -mutable arg */
+/* 1-May-12: removed alsa special case */
+
-static int main_not_alsa(int argc, char *argv[])
+int main(int argc, char *argv[])
{
int fd, afd, i, j, n, k, chans, srate;
- mus_long_t frames, m;
- mus_sample_t **bufs;
+ mus_long_t framples, m;
+ mus_float_t **bufs;
OutSample *obuf;
- int use_volume = 0;
- int afd0, afd1, buffer_size = BUFFER_SIZE, curframes, sample_size, out_chans, outbytes;
+ int buffer_size = BUFFER_SIZE, curframples, sample_size, out_chans, outbytes;
char *name = NULL;
mus_long_t start = 0, end = 0;
- double begin_time = 0.0, end_time = 0.0, volume = 1.0;
+ double begin_time = 0.0, end_time = 0.0;
int mutate = 1, include_mutate = 0;
+ if (argc == 1)
+ {
+ printf("usage: sndplay file [-start 1.0] [-end 1.0] [-bufsize %d] [-buffers 2x12] [-describe]\n", BUFFER_SIZE);
+ exit(0);
+ }
+ mus_sound_initialize();
+
for (i = 1; i < argc; i++)
{
- if (strcmp(argv[i], "-describe") == 0)
+ if (strcmp(argv[i], "-buffers") == 0)
{
- fprintf(stdout, "%s", mus_audio_describe());
- exit(0);
+#if (HAVE_OSS || HAVE_ALSA)
+ static char x_string[2] = {'x','\0'};
+ char *arg;
+ int a, b;
+ arg = strtok(argv[i + 1], x_string);
+ a = atoi(arg);
+ arg = strtok(NULL, x_string);
+ b = atoi(arg);
+ mus_oss_set_buffers(a, b);
+#endif
+ i++;
}
else
{
- if (strcmp(argv[i], "-buffers") == 0)
+ if (strcmp(argv[i], "-bufsize") == 0)
{
- set_buffers(argv[i + 1]);
+ buffer_size = atoi(argv[i + 1]);
i++;
}
else
{
- if (strcmp(argv[i], "-bufsize") == 0)
+ if (strcmp(argv[i], "-start") == 0)
{
- buffer_size = atoi(argv[i + 1]);
+ begin_time = atof(argv[i + 1]);
i++;
}
else
{
- if (strcmp(argv[i], "-start") == 0)
+ if (strcmp(argv[i], "-end") == 0)
{
- begin_time = atof(argv[i + 1]);
+ end_time = atof(argv[i + 1]);
i++;
}
- else
+ else
{
- if (strcmp(argv[i], "-end") == 0)
+ if (strcmp(argv[i], "-mutable") == 0)
{
- end_time = atof(argv[i + 1]);
+ mutate = atoi(argv[i + 1]);
+ include_mutate = 1;
i++;
}
- else
- {
- if (strcmp(argv[i], "-mutable") == 0)
- {
- mutate = atoi(argv[i + 1]);
- include_mutate = 1;
- i++;
- }
- else
- {
- if (strcmp(argv[i], "-volume") == 0)
- {
- volume = atof(argv[i + 1]);
- use_volume = 1;
- i++;
- }
- else name = argv[i];
- }}}}}}}
+ else name = argv[i];
+ }}}}}
+
if (name == NULL)
{
- printf("usage: sndplay file [-start 1.0] [-end 1.0] [-bufsize %d] [-buffers 2x12] [-volume 1.0] [-mutable 1] [-describe]\n", BUFFER_SIZE);
+ printf("usage: sndplay file [-start 1.0] [-end 1.0] [-bufsize %d] [-buffers 2x12] [-mutable 1]\n", BUFFER_SIZE);
exit(0);
}
afd = -1;
- afd0 = -1;
- afd1 = -1;
- if (!(mus_header_type_p(mus_sound_header_type(name))))
+
+ if (!(mus_is_header_type(mus_sound_header_type(name))))
{
fprintf(stderr, "can't play %s (header type: %s?)\n",
name,
mus_header_type_name(mus_header_type()));
exit(0);
}
- if (!(mus_data_format_p(mus_sound_data_format(name))))
+
+ if (!(mus_is_sample_type(mus_sound_sample_type(name))))
{
- fprintf(stderr, "can't play %s (data format: %s (%s)?)\n",
+ fprintf(stderr, "can't play %s (sample type: %s (%s)?)\n",
name,
- mus_data_format_name(mus_sound_data_format(name)),
- mus_header_original_format_name(mus_sound_original_format(name),
- mus_sound_header_type(name)));
+ mus_sample_type_name(mus_sound_sample_type(name)),
+ mus_header_original_sample_type_name(mus_sound_original_sample_type(name), mus_sound_header_type(name)));
exit(0);
}
+
fd = mus_sound_open_input(name);
if (fd != -1)
{
@@ -171,41 +150,41 @@ static int main_not_alsa(int argc, char *argv[])
out_chans = chans;
srate = mus_sound_srate(name);
- frames = mus_sound_frames(name);
- sample_size = mus_bytes_per_sample(MUS_AUDIO_COMPATIBLE_FORMAT);
+ framples = mus_sound_framples(name);
+ sample_size = mus_bytes_per_sample(MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE);
start = (mus_long_t)(begin_time * srate);
if (start > 0)
- mus_file_seek_frame(fd, start);
+ mus_file_seek_frample(fd, start);
if (end_time > 0.0)
end = (mus_long_t)(end_time * srate);
- else end = frames;
- if ((end - start) < frames)
- frames = end - start;
+ else end = framples;
+ if ((end - start) < framples)
+ framples = end - start;
- bufs = (mus_sample_t **)calloc(chans, sizeof(mus_sample_t *));
- for (i = 0; i < chans; i++) bufs[i] = (mus_sample_t *)calloc(buffer_size, sizeof(mus_sample_t));
+ bufs = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
+ for (i = 0; i < chans; i++) bufs[i] = (mus_float_t *)calloc(buffer_size, sizeof(mus_float_t));
obuf = (OutSample *)calloc(buffer_size * out_chans, sizeof(OutSample));
outbytes = buffer_size * out_chans * sample_size;
- for (m = 0; m < frames; m += buffer_size)
+
+ for (m = 0; m < framples; m += buffer_size)
{
- if ((m + buffer_size) <= frames)
- curframes = buffer_size;
- else curframes = frames - m;
- mus_file_read(fd, 0, curframes - 1, chans, bufs);
+ if ((m + buffer_size) <= framples)
+ curframples = buffer_size;
+ else curframples = framples - m;
+ mus_file_read(fd, start + m, curframples, chans, bufs);
/* some systems are happier if we read the file before opening the dac */
/* at this point the data is in separate arrays of mus_sample_t's */
- if (use_volume)
- set_volume(bufs, chans, curframes, volume);
+
if (chans == 1)
{
- for (k = 0; k < curframes; k++)
+ for (k = 0; k < curframples; k++)
obuf[k] = MUS_CONVERT(bufs[0][k]);
}
else
{
if (chans == 2)
{
- for (k = 0, n = 0; k < curframes; k++, n += 2)
+ for (k = 0, n = 0; k < curframples; k++, n += 2)
{
obuf[n] = MUS_CONVERT(bufs[0][k]);
obuf[n + 1] = MUS_CONVERT(bufs[1][k]);
@@ -213,27 +192,23 @@ static int main_not_alsa(int argc, char *argv[])
}
else
{
- for (k = 0, j = 0; k < curframes; k++, j += chans)
+ for (k = 0, j = 0; k < curframples; k++, j += chans)
{
for (n = 0; n < chans; n++)
obuf[j + n] = MUS_CONVERT(bufs[n][k]);
}
}
}
-#if MUS_MAC_OSX
+#if __APPLE__
if (include_mutate == 1)
mus_audio_output_properties_mutable(mutate);
#endif
if (afd == -1)
{
-#if defined(MUS_LINUX) && defined(PPC)
- afd = mus_audio_open_output(MUS_AUDIO_DEFAULT, srate, chans, MUS_AUDIO_COMPATIBLE_FORMAT, 0);
-#else
- afd = mus_audio_open_output(MUS_AUDIO_DEFAULT, srate, out_chans, MUS_AUDIO_COMPATIBLE_FORMAT, outbytes);
-#endif
+ afd = mus_audio_open_output(MUS_AUDIO_DEFAULT, srate, out_chans, MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE, outbytes);
if (afd == -1) break;
}
- outbytes = curframes * out_chans * sample_size;
+ outbytes = curframples * out_chans * sample_size;
mus_audio_write(afd, (char *)obuf, outbytes);
}
if (afd != -1) mus_audio_close(afd);
@@ -244,330 +219,3 @@ static int main_not_alsa(int argc, char *argv[])
}
return(0);
}
-
-#if HAVE_ALSA
-
-/* HAVE_ALSA here
- there should be a command line argument to control this,
- set to 0 to enable using more than one device. */
-
-static int use_one_device = 1;
-
-void mus_audio_alsa_channel_info(int dev, int *info);
-int mus_audio_alsa_samples_per_channel(int dev);
-void mus_audio_alsa_device_list(int sys, int size, int *val);
-int mus_audio_alsa_device_direction(int dev);
-
-#define MAX_SLOTS 64
-
-static int main_alsa(int argc, char *argv[])
-{
- int fd, i, chans, srate;
- mus_long_t frames, ioff;
- mus_sample_t **read_bufs;
- int afd[MAX_SLOTS];
- short *out_buf[MAX_SLOTS];
- int val[MAX_SLOTS];
- int afd0, afd1;
- char *name = NULL;
- int base, curframes;
- int allocated;
- int out_devs[MAX_SLOTS];
- int out_chans[MAX_SLOTS];
- int out_format[MAX_SLOTS];
- int out_bytes[MAX_SLOTS];
- int samples_per_chan = 0;
- int last_device;
- int devices[MAX_SLOTS];
- int available_chans[MAX_SLOTS];
- int min_chans[MAX_SLOTS];
- int max_chans[MAX_SLOTS];
- int alloc_chans;
- mus_long_t start = 0, end = 0;
- double begin_time = 0.0, end_time = 0.0, volume = 1.0;
- int use_volume = 0;
-
- /* -describe => call mus_audio_describe and exit
- * -buffers axb => set OSS fragment numbers
- */
- for (i = 1; i < argc; i++)
- {
- if (strcmp(argv[i], "-describe") == 0)
- {
- fprintf(stdout, "%s", mus_audio_describe());
- exit(0);
- }
- else
- {
- if (strcmp(argv[i], "-buffers") == 0)
- {
- set_buffers(argv[i+1]);
- i++;
- }
- else
- {
- if (strcmp(argv[i], "-start") == 0)
- {
- begin_time = atof(argv[i + 1]);
- i++;
- }
- else
- {
- if (strcmp(argv[i], "-end") == 0)
- {
- end_time = atof(argv[i + 1]);
- i++;
- }
- else
- {
- if (strcmp(argv[i], "-volume") == 0)
- {
- volume = atof(argv[i + 1]);
- use_volume = 1;
- i++;
- }
- else name = argv[i];
- }}}}}
- afd0 = -1;
- afd1 = -1;
- if (!(mus_header_type_p(mus_sound_header_type(name))))
- {
- fprintf(stderr, "can't play %s (header type: %s?)\n",
- name,
- mus_header_type_name(mus_header_type()));
- exit(0);
- }
- if (!(mus_data_format_p(mus_sound_data_format(name))))
- {
- fprintf(stderr, "can't play %s (data format: %s (%s)?)\n",
- name,
- mus_data_format_name(mus_sound_data_format(name)),
- mus_header_original_format_name(mus_sound_original_format(name),
- mus_sound_header_type(name)));
- exit(0);
- }
- fd = mus_sound_open_input(name);
- if (fd != -1)
- {
- /* try to select proper device */
- int dir = 0;
- int cards, card;
- int sysdev, devs, dev, d, i, im;
- int first_samples_per_chan = -1;
- cards = mus_audio_systems();
- /* deselect all devices */
- for (d = 0; d < MAX_SLOTS; d++)
- {
- out_devs[d] = -1;
- afd[d] = -1;
- }
- /* Scan all cards and build a list of available output devices.
- This is evil because it second guesses the intentions of the
- user, best would be to have a command line parameter that
- points to the device or devices to be used. For things to
- work under alsa .5 and multichannel cards it has to be here.
- Hopefully the need will go away (in alsa .6 it will definitely
- not be needed).
- */
- i = 0;
- im = 0;
- for (card = 0; card < cards; card++)
- {
- /* get the list of all available devices */
- mus_audio_alsa_device_list(MUS_AUDIO_PACK_SYSTEM(card), MAX_SLOTS, val);
- devs = val[0];
- for (d = 0; d < devs; d++)
- {
- dev = val[d + 1];
- sysdev = MUS_AUDIO_PACK_SYSTEM(card)|dev;
- dir = mus_audio_alsa_device_direction(sysdev);
-
- /* only consider output devices */
- if (dir == 0)
- {
- int ch[4];
- /* get the number of channels the device supports */
- mus_audio_alsa_channel_info(sysdev, ch);
- available_chans[i] = ch[0];
- if (ch[2] != 0) /* alsa also sets min and max channels */
- {
- min_chans[i] = ch[1];
- max_chans[i] = ch[2];
- }
- if (max_chans[i] > max_chans[im]) im = i;
-
- /* find out what format we can use with the device */
- out_format[i] = mus_audio_compatible_format(sysdev);
-
- /* find out what buffer size the device wants */
- samples_per_chan = mus_audio_alsa_samples_per_channel(sysdev);
-
- /* skip device if it has different buffer size, all must match */
- if (first_samples_per_chan == -1)
- first_samples_per_chan = samples_per_chan;
- else
- if (samples_per_chan != first_samples_per_chan)
- continue;
- devices[i++] = sysdev;
- if (i >= MAX_SLOTS)
- goto NO_MORE_DEVICES;
- }
- }
- }
- NO_MORE_DEVICES:
- last_device = i;
- chans = mus_sound_chans(name);
- allocated = 0;
- if (available_chans[im] >= chans)
- {
- /* the widest device is wide enough to play all channels so we use it */
- out_devs[allocated] = im;
- out_chans[allocated] = chans;
- if (chans < min_chans[im])
- out_chans[allocated] = min_chans[im];
- alloc_chans = out_chans[allocated];
- allocated++;
- }
- else
- {
- alloc_chans = 0;
- if (use_one_device == 0)
- {
- /* allocate devices until all channels can be played */
- for (i = 0; i < last_device; i++)
- {
- out_devs[allocated] = i;
- out_chans[allocated] = available_chans[i];
- alloc_chans += available_chans[out_devs[allocated]];
- allocated++;
- if (alloc_chans >= chans)
- break;
- }
- }
- if (alloc_chans < chans)
- {
- /* FOR NOW, fail the program, not enough channels... */
-
- fprintf(stderr, "not enough channels, %d available, %d needed\n",
- available_chans[0], chans);
- exit(1);
-
- /* either not enough channels found or have to use just
- one device and the widest can't do it, so fold all of
- them into whatever the first device can do */
- allocated = 0;
- out_devs[allocated] = 0;
- out_chans[allocated] = available_chans[0];
- alloc_chans = out_chans[allocated];
- allocated++;
- }
- }
- srate = mus_sound_srate(name);
- frames = mus_sound_frames(name);
- base = 0;
- start = (mus_long_t)(begin_time * srate);
- if (start > 0)
- mus_file_seek_frame(fd, start);
- if (end_time > 0.0)
- end = (mus_long_t)(end_time * srate);
- else end = frames;
- if ((end - start) < frames)
- frames = end - start;
- /* allocate the list of read buffers, each buffer will hold one channel
- of the input soundfile, each sample is going to be mus_sample_t
- */
- read_bufs = (mus_sample_t **)calloc(alloc_chans, sizeof(mus_sample_t *));
- for (d = 0; d < allocated; d++)
- {
- int dev = out_devs[d];
- for (i = 0; i < out_chans[d]; i++)
- read_bufs[base + i] = (mus_sample_t *)calloc(samples_per_chan, sizeof(mus_sample_t));
- base += out_chans[d];
- out_bytes[dev] = samples_per_chan * out_chans[d] * mus_bytes_per_sample(out_format[dev]);
- out_buf[dev] = (short *)calloc(out_bytes[dev], 1);
- }
- for (ioff = 0; ioff < frames; ioff += samples_per_chan)
- {
- mus_sample_t **dev_bufs = read_bufs;
- if ((ioff + samples_per_chan) <= frames)
- curframes = samples_per_chan;
- else
- {
- curframes = frames - ioff;
- for (d = 0; d < allocated; d++)
- {
- int f, dev = out_devs[d];
-#if 1
- /* try to kludge around an ALSA bug... */
- for (f = 0; f < chans; f++)
- memset(read_bufs[f], 0, samples_per_chan * sizeof(mus_sample_t));
-#endif
- out_bytes[dev] = curframes * out_chans[d] * mus_bytes_per_sample(out_format[dev]);
- }
- }
- mus_file_read(fd, 0, curframes - 1, chans, read_bufs);
- if (use_volume)
- set_volume(read_bufs, chans, curframes, volume);
- /* some systems are happier if we read the file before opening the dac */
- /* at this point the data is in separate arrays of mus_sample_t */
- for (d = 0; d < allocated; d++)
- {
- int dev = out_devs[d];
- mus_file_write_buffer(out_format[dev],
- 0, curframes - 1,
- out_chans[d],
- dev_bufs,
- (char *)(out_buf[dev]),
- 0);
- if (afd[dev] == -1)
- {
-#if defined(PPC)
- afd[dev] = mus_audio_open_output(devices[dev], srate, out_chans[d], out_format[dev], 0);
-#else
- afd[dev] = mus_audio_open_output(devices[dev], srate, out_chans[d], out_format[dev], out_bytes[dev]);
-#endif
- if (afd[dev] == -1) break;
- }
- mus_audio_write(afd[dev], (char *)out_buf[dev], out_bytes[dev]);
- dev_bufs += out_chans[d];
- }
- }
- for (d = 0; d < allocated; d++)
- {
- int dev = out_devs[d];
- if (afd[dev] != -1) mus_audio_close(afd[dev]);
- }
- mus_sound_close_input(fd);
- for (i = 0; i < alloc_chans; i++) free(read_bufs[i]);
- free(read_bufs);
- for (d = 0; d < allocated; d++)
- {
- int dev = out_devs[d];
- free(out_buf[dev]);
- }
- }
- return(0);
-}
-
-#endif
-
-int main(int argc, char *argv[])
-{
- if (argc == 1)
- {
- printf("usage: sndplay file [-start 1.0] [-end 1.0] [-bufsize %d] [-buffers 2x12] [-volume 1.0] [-describe]\n", BUFFER_SIZE);
- exit(0);
- }
- mus_sound_initialize();
-
-#if HAVE_ALSA
- if (mus_audio_api() == MUS_ALSA_API)
- {
- main_alsa(argc, argv);
- return(0);
- }
-#endif
- main_not_alsa(argc, argv);
- return(0);
-}
-
diff --git a/sndscm.html b/sndscm.html
index 393a94b..6cff621 100644
--- a/sndscm.html
+++ b/sndscm.html
@@ -1,341 +1,444 @@
-<html>
+<!DOCTYPE html>
+
+<html lang="en">
<!-- documentation for some of the Scheme/Ruby/Forth code included with Snd -->
<head>
+<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>Scheme, Ruby, and Forth Functions included with Snd</title>
<style type="text/css">
-<!--
EM.red {color:red; font-style:normal}
EM.error {color:chocolate; font-style:normal}
- EM.typing {color:maroon; font-style: normal}
- EM.listener {color:darkblue; font-style: normal}
EM.emdef {font-weight: bold; font-style: normal; padding-right: 0.2cm}
H1 {text-align: center}
UL {list-style-type: none}
+ DIV.greencenter {text-align: center; background-color: lightgreen; padding-top: 0.1cm; padding-bottom: 0.1cm;}
A {text-decoration:none}
A:hover {text-decoration:underline}
A.quiet {color:black; text-decoration:none}
A.quiet:hover {text-decoration:underline}
A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black; padding-right: 0.2cm}
--->
-
+ EM.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black; padding-right: 0.2cm}
+
+ TD.center {text-align: center}
+ PRE.indented {padding-left: 1.0cm}
+ IMG.indented {padding-left: 1.0cm}
+ IMG.noborder {border: none; padding-left: 1.0cm}
+
+ DIV.center {text-align: center}
+ BODY.body {background-color: #ffffff; /* white */
+ margin-left: 0.5cm;
+ margin-right: 0.5cm;
+ }
+ TABLE.grayborder {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 1.0cm;
+ border: 8px solid gray;
+ padding-left: 0.1cm;
+ padding-right: 0.1cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ DIV.header {margin-top: 50px;
+ margin-bottom: 10px;
+ font-size: 20px;
+ font-weight: bold;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ text-align: center;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.innerheader {margin-top: 60px;
+ margin-bottom: 30px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #eefdee; /* lightgreen */
+ padding-left: 30px;
+ width: 50%;
+ padding-top: 20px;
+ padding-bottom: 20px;
+ }
+ DIV.related {text-align:center;
+ border: 1px solid lightgray;
+ margin-bottom: 1.0cm;
+ margin-top: 1.0cm;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ background-color: #f0f0f0;
+ }
+ DIV.inset {margin-left: 2.0cm;
+ margin-right: 2.0cm;
+ margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ background-color: #f0f0f0;
+ padding-left: 0.25cm;
+ padding-right: 0.25cm;
+ padding-top: 0.25cm;
+ padding-bottom: 0.25cm;
+ }
+ DIV.seealso {border: 1px solid lightgray;
+ margin-bottom: 0.5cm;
+ margin-top: 0.5cm;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ padding-left: 0.5cm;
+ background-color: #f0f0f0;
+ }
+ DIV.simple {margin-left: 1cm;
+ margin-bottom: 0.5cm;
+ }
+ #contents_table tbody tr:nth-child(odd) { background-color: #f2f4ff; }
+ TABLE.method {margin-top: 0.5cm;
+ margin-bottom: 0.5cm;
+ margin-left: 1.0cm;
+ border: 1px solid gray;
+ padding-left: 0.1cm;
+ padding-right: 0.1cm;
+ padding-top: 0.1cm;
+ padding-bottom: 0.1cm;
+ }
+ TH.title {background-color: lightgreen;
+ border: 1px solid gray;
+ padding-top: 0.2cm;
+ padding-bottom: 0.2cm;
+ text-align: center;
+ }
+ TD.methodtitle {background-color: beige;
+ border: 1px solid gray;
+ padding-top: 0.2cm;
+ padding-bottom: 0.2cm;
+ text-align: center;
+ }
+ DIV.separator {margin-top: 40px;
+ margin-bottom: 15px;
+ border: 2px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ padding-top: 4px;
+ width: 30%;
+ border-radius: 4px;
+ -moz-border-radius: 4px;
+ -webkit-border-radius: 4px;
+ }
+ DIV.scheme {background-color: #f2f4ff;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.ruby {background-color: #fbfbf0;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.forth {background-color: #eefdee;
+ border: 1px solid gray;
+ padding-right: 1.0cm;
+ margin-bottom: 0.2cm;
+ }
+ DIV.spacer {margin-top: 1.0cm;
+ }
</style>
</head>
-<body bgcolor=white>
-
-<script language=JavaScript type="text/javascript" src="wz_tooltip.js"></script>
-<script language=JavaScript type="text/javascript" src="wz_data.js"></script>
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h1>Scheme, Ruby, and Forth Functions included with Snd</h1></td></tr></table>
-</td></tr></table>
-<br>
-
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
-
+<body class="body">
-<br>
+<div class="topheader" id="introduction">Scheme, Ruby, and Forth Functions included with Snd</div>
-<!-- I'm using A NAME (i.e caps) where the entity should be ignored by the indexer (make-index.scm) -->
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="extsnd.html">extsnd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="fm.html">fm.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
-<A NAME="introduction"></a>
<p>This file describes the Scheme, Ruby, and Forth code included with Snd.
To use this code, load the relevant file:
</p>
-<pre>
- Scheme: (load "dsp.scm") or (load-from-path "dsp.scm")
- Ruby: load "dsp.rb"
- Forth: "dsp.fs" file-eval
+
+<pre class="indented">
+Scheme: (load "dsp.scm") or (load-from-path "dsp.scm")
+Ruby: load "dsp.rb"
+Forth: "dsp.fs" file-eval
</pre>
+
<p>
To start Snd with
-the file already loaded, <code>snd -l v.scm</code>, or put the load statement in your initialization file.
+the file already loaded, snd -l v.scm, or put the load statement in your initialization file.
For help with Forth and Snd/CLM, see the Forth documentation section "Snd, CLM, and Fth".
</p>
-<br>
-
-<table border=8 bordercolor="lightsteelblue" cellpadding=6 hspace=20><tr><td>
-<table border=0 cellspacing=0 cellpadding=2>
-<tr><th colspan=2 bgcolor="beige">Contents</th></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#analogfilterdoc">analog-filter</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(analog_filter_doc_tip)">standard IIR filters (Butterworth, Chebyshev, Bessel, Elliptic)</td></tr>
+<table class="grayborder"><tr><td>
+<table id="contents_table">
+<tr><th colspan=2 class="title">Contents</th></tr>
+<tbody>
+<tr><td><a href="#analogfilterdoc">analog-filter</a></td>
+ <td>standard IIR filters (Butterworth, Chebyshev, Bessel, Elliptic)</td></tr>
<tr><td><a href="#animalsdoc">animals</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(animals_doc_tip)">a bunch of animals</td></tr>
+ <td>a bunch of animals</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#autosavedoc">autosave</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(autosave_doc_tip)">auto-save (edit backup) support</td></tr>
+<tr><td><a href="#autosavedoc">autosave</a></td>
+ <td>auto-save (edit backup) support</td></tr>
<tr><td><a href="#bessdoc">bess</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(bess_doc_tip)">FM demo</td></tr>
+ <td>FM demo</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#binaryiodoc">binary-io</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(binary_io_doc_tip)">binary files</td></tr>
+<tr><td><a href="#binaryiodoc">binary-io</a></td>
+ <td>binary files</td></tr>
<tr><td><a href="#birddoc">bird</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(bird_doc_tip)">North-American birds</td></tr>
+ <td>North-American birds</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#cleandoc">clean</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(clean_doc_tip)">noise reduction</td></tr>
+<tr><td><a href="#cleandoc">clean</a></td>
+ <td>noise reduction</td></tr>
<tr><td><a href="#clminsdoc">clm-ins, clm23, jcvoi</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(clm_ins_doc_tip)">various CLM instruments</td></tr>
+ <td>various CLM instruments</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#dlocsigdoc">dlocsig</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(dlocsig_doc_tip)">moving sounds (Michael Scholz)</td></tr>
+<tr><td><a href="#dlocsigdoc">dlocsig</a></td>
+ <td>moving sounds (Michael Scholz)</td></tr>
<tr><td><a href="#drawdoc">draw</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(draw_doc_tip)">graphics additions</td></tr>
+ <td>graphics additions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#dspdoc">dsp</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(dsp_doc_tip)">various DSP-related procedures</td></tr>
+<tr><td><a href="#dspdoc">dsp</a></td>
+ <td>various DSP-related procedures</td></tr>
<tr><td><a href="#envdoc">env</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(env_doc_tip)">envelope functions</td></tr>
+ <td>envelope functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#enveddoc">enved</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(enved_doc_tip)">envelope editor</td></tr>
+<tr><td><a href="#enveddoc">enved</a></td>
+ <td>envelope editor</td></tr>
<tr><td><a href="#exampdoc">examp</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(examp_doc_tip)">many examples</td></tr>
+ <td>many examples</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#extensionsdoc">extensions</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(extensions_doc_tip)">various generally useful Snd extensions</td></tr>
+<tr><td><a href="#extensionsdoc">extensions</a></td>
+ <td>various generally useful Snd extensions</td></tr>
<tr><td><a href="#fadedoc">fade</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(fade_doc_tip)">frequency-domain cross-fades</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="#framedoc">frame</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(frame_doc_tip)">frames, vcts, sound-data objects</td></tr>
+ <td>frequency-domain cross-fades</td></tr>
<tr><td><a href="#freeverbdoc">freeverb</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(freeverb_doc_tip)">a reverb</td></tr>
+ <td>a reverb</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="sndclm.html#othergenerators">generators.scm</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(generators_doc_tip)">a bunch of generators</td></tr>
+<tr><td><a href="sndclm.html#othergenerators">generators.scm</a></td>
+ <td>a bunch of generators</td></tr>
<tr><td><a href="#granidoc">grani</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(grani_doc_tip)">CLM's grani (Fernando Lopez-Lezcano) translated by Mike Scholz</td></tr>
+ <td>CLM's grani (Fernando Lopez-Lezcano) translated by Mike Scholz</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#heartdoc">heart</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(heart_doc_tip)">use Snd with non-sound (arbitrary range) data</td></tr>
+<tr><td><a href="#heartdoc">heart</a></td>
+ <td>use Snd with non-sound (arbitrary range) data</td></tr>
<tr><td><a href="#hooksdoc">hooks</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(hooks_doc_tip)">functions related to hooks</td></tr>
+ <td >functions related to hooks</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#indexdoc">index</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(index_doc_tip)">snd-help extension</td></tr>
+<tr><td><a href="#indexdoc">index</a></td>
+ <td>snd-help extension</td></tr>
<tr><td><a href="#dotemacs">inf-snd.el, DotEmacs</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(inf_snd_doc_tip)">Emacs subjob support (Michael Scholz, Fernando Lopez-Lezcano)</td></tr>
+ <td>Emacs subjob support (Michael Scholz, Fernando Lopez-Lezcano)</td></tr>
+
+<tr><td><a href="#jcrevdoc">jcrev</a></td>
+ <td>John Chowning's ancient reverb</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#jcrevdoc">jcrev</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(jcrev_doc_tip)">John Chowning's ancient reverb</td></tr>
+<tr><td><a href="#lintdoc">lint</a></td>
+ <td>A lint program for scheme code</td></tr>
<tr><td><a href="#maracadoc">maraca</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(maraca_doc_tip)">Perry Cook's maraca physical model</td></tr>
+ <td>Perry Cook's maraca physical model</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#marksdoc">marks</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(marks_doc_tip)">functions related to marks</td></tr>
+<tr><td><a href="#marksdoc">marks</a></td>
+ <td>functions related to marks</td></tr>
<tr><td><a href="#maxfdoc">maxf</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(maxf_doc_tip)">Max Mathews resonator</td></tr>
+ <td>Max Mathews resonator</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#menusdoc">menus</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(menus_doc_tip)">additional menus</td></tr>
+<tr><td><a href="#menusdoc">menus</a></td>
+ <td>additional menus</td></tr>
<tr><td><a href="#mixdoc">mix</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(mix_doc_tip)">functions related to mixes</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="#mixerdoc">mixer</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(mixer_doc_tip)">functions related to linear algebra</td></tr>
+ <td>functions related to mixes</td></tr>
<tr><td><a href="#moogdoc">moog</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(moog_doc_tip)">Moog filter</td></tr>
+ <td>Moog filter</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#musglyphs">musglyphs</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(musglyphs_doc_tip)">Music notation symbols (from CMN)</td></tr>
+<tr><td><a href="#musglyphs">musglyphs</a></td>
+ <td>Music notation symbols (from CMN)</td></tr>
<tr><td><a href="#nbdoc">nb</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(nb_doc_tip)">Popup File info etc</td></tr>
+ <td>Popup File info etc</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#noisedoc">noise</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(noise_doc_tip)">noise maker</td></tr>
+<tr><td><a href="#noisedoc">noise</a></td>
+ <td>noise maker</td></tr>
<tr><td><a href="#numericsdoc">numerics</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(numerics_doc_tip)">various numerical functions</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="#oscopedoc">oscope</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(oscope_doc_tip)">an oscilloscope/spectrum analysis dialog</td></tr>
+ <td>various numerical functions</td></tr>
<tr><td><a href="#peakphasesdoc">peak-phases</a></td>
<td>phases for the unpulse-train</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#pianodoc">piano</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(piano_doc_tip)">piano physical model</td></tr>
+<tr><td><a href="#pianodoc">piano</a></td>
+ <td>piano physical model</td></tr>
<tr><td><a href="#playdoc">play</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(play_doc_tip)">play-related functions</td></tr>
+ <td>play-related functions</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#polydoc">poly</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(poly_doc_tip)">polynomial-related stuff</td></tr>
+<tr><td><a href="#polydoc">poly</a></td>
+ <td>polynomial-related stuff</td></tr>
<tr><td><a href="#prc95doc">prc95</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(prc95_doc_tip)">Perry Cook's physical model examples</td></tr>
+ <td>Perry Cook's physical model examples</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#pvocdoc">pvoc</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(pvoc_doc_tip)">phase-vocoder</td></tr>
+<tr><td><a href="#pvocdoc">pvoc</a></td>
+ <td>phase-vocoder</td></tr>
<tr><td><a href="#rgbdoc">rgb</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(rgb_doc_tip)">color names</td></tr>
-
-<tr><td bgcolor="#f2f4ff"><a href="#rtiodoc">rtio</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(rtio_doc_tip)">real-time stuff</td></tr>
+ <td>color names</td></tr>
<tr><td><a href="#rubberdoc">rubber</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(rubber_doc_tip)">rubber-sound</td></tr>
+ <td>rubber-sound</td></tr>
+
+<tr><td><a href="#s7testdoc">s7test</a></td>
+ <td>s7 regression tests</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#selectiondoc">selection</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(selection_doc_tip)">functions acting on the current selection</td></tr>
+<tr><td><a href="#selectiondoc">selection</a></td>
+ <td>functions acting on the current selection</td></tr>
<tr><td><a href="#singerdoc">singer</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(singer_doc_tip)">Perry Cook's vocal-tract physical model</td></tr>
+ <td>Perry Cook's vocal-tract physical model</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#sndolddoc">snd9|10|11.scm</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(sndold_doc_tip)">Backwards compatibility</td></tr>
+<tr><td><a href="#sndolddoc">snd13|14|15.scm</a></td>
+ <td>Backwards compatibility</td></tr>
<tr><td><a href="#snddiffdoc">snddiff</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(snddiff_doc_tip)">sound difference detection</td></tr>
+ <td>sound difference detection</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#sndgldoc">snd-gl</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snd_gl_doc_tip)">OpenGL examples (gl.c)</td></tr>
+<tr><td><a href="#sndgldoc">snd-gl</a></td>
+ <td>OpenGL examples (gl.c)</td></tr>
<tr><td><a href="#sndmotifdoc">snd-motif, snd-gtk, snd-xm</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(snd_motif_doc_tip)">Motif/Gtk module (xm.c, xg.c)</td></tr>
+ <td>Motif/Gtk module (xm.c, xg.c)</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#sndtestdoc">snd-test</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(snd_test_doc_tip)">Snd regression tests</td></tr>
+<tr><td><a href="#sndtestdoc">snd-test</a></td>
+ <td>Snd regression tests</td></tr>
<tr><td><a href="#sndwarpdoc">sndwarp</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(sndwarp_doc_tip)">Bret Battey's sndwarp instrument</td></tr>
+ <td>Bret Battey's sndwarp instrument</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#spectrdoc">spectr</a></td>
- <td bgcolor="#f2f4ff">instrument steady state spectra</td></tr>
+<tr><td><a href="#spectrdoc">spectr</a></td>
+ <td>instrument steady state spectra</td></tr>
<tr><td><a href="#stochasticdoc">stochastic</a></td>
<td>Bill Sack's dynamic stochastic synthesis</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#straddoc">strad</a></td>
- <td bgcolor="#f2f4ff">string physical model (from CLM)</td></tr>
+<tr><td><a href="#straddoc">strad</a></td>
+ <td>string physical model (from CLM)</td></tr>
<tr><td><a href="#vdoc">v</a></td>
<td>fm-violin</td></tr>
-<tr><td bgcolor="#f2f4ff"><a href="#wsdoc">ws</a></td>
- <td bgcolor="#f2f4ff" onmouseout="UnTip()" onmouseover="Tip(ws_doc_tip)">with-sound</td></tr>
+<tr><td><a href="#wsdoc">ws</a></td>
+ <td>with-sound</td></tr>
<tr><td><a href="#zipdoc">zip</a></td>
- <td onmouseout="UnTip()" onmouseover="Tip(zip_doc_tip)">the zipper (the anti-cross-fader)</td></tr>
-
+ <td>the zipper (the anti-cross-fader)</td></tr>
+</tbody>
</table>
</td></tr></table>
-<br><br>
-<!-- ---------------------------------------- FILE: analog-filter ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="analogfilterdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>analog-filter</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: analog-filter -->
+
+<div class="header" id="analogfilterdoc">analog-filter</div>
<!-- main-index |analogfilterdoc:butterworth filters -->
<!-- main-index |analogfilterdoc:bessel filters -->
<!-- main-index |analogfilterdoc:elliptic filters -->
<!-- main-index |analogfilterdoc:chebyshev filters -->
-<table border=0><tr><td bgcolor="#f2f3ff">
-
-<em class=emdef>make-butterworth-lowpass</em> <code>order fcut</code><br>
-<em class=emdef>make-butterworth-highpass</em> <code>order fcut</code><br>
-<em class=emdef>make-butterworth-bandpass</em> <code>order flo fhi</code><br>
-<em class=emdef>make-butterworth-bandstop</em> <code>order flo fhi</code><br>
-<br>
-<em class=emdef>make-chebyshev-lowpass</em> <code>order fcut (ripple-dB 1.0)</code><br>
-<em class=emdef>make-chebyshev-highpass</em> <code>order fcut (ripple-dB 1.0)</code><br>
-<em class=emdef>make-chebyshev-bandpass</em> <code>order flo fhi (ripple-dB 1.0)</code><br>
-<em class=emdef>make-chebyshev-bandstop</em> <code>order flo fhi (ripple-dB 1.0)</code><br>
-<br>
-<em class=emdef>make-inverse-chebyshev-lowpass</em> <code>order fcut (loss-dB 60.0)</code><br>
-<em class=emdef>make-inverse-chebyshev-highpass</em> <code>order fcut (loss-dB 60.0)</code><br>
-<em class=emdef>make-inverse-chebyshev-bandpass</em> <code>order flo fhi (loss-dB 60.0)</code><br>
-<em class=emdef>make-inverse-chebyshev-bandstop</em> <code>order flo fhi (loss-dB 60.0)</code><br>
-<br>
-<em class=emdef>make-bessel-lowpass</em> <code>order fcut</code><br>
-<em class=emdef>make-bessel-highpass</em> <code>order fcut</code><br>
-<em class=emdef>make-bessel-bandpass</em> <code>order flo fh</code><br>
-<em class=emdef>make-bessel-bandstop</em> <code>order flo fh</code><br>
-<br>
-<em class=emdef>make-elliptic-lowpass</em> <code>order fcut (ripple-dB 1.0) (loss-dB 60.0)</code><br>
-<em class=emdef>make-elliptic-highpass</em> <code>order fcut (ripple-dB 1.0) (loss-dB 60.0)</code><br>
-<em class=emdef>make-elliptic-bandpass</em> <code>order flo fhi (ripple-dB 1.0) (loss-dB 60.0)</code><br>
-<em class=emdef>make-elliptic-bandstop</em> <code>order flo fhi (ripple-dB 1.0) (loss-dB 60.0)</code><br>
-</td></tr>
-<tr><td>
-<pre>
+<pre class="indented">
+<em class=emdef>make-butterworth-lowpass</em> order fcut
+<em class=emdef>make-butterworth-highpass</em> order fcut
+<em class=emdef>make-butterworth-bandpass</em> order flo fhi
+<em class=emdef>make-butterworth-bandstop</em> order flo fhi
+
+<em class=emdef>make-chebyshev-lowpass</em> order fcut (ripple-dB 1.0)
+<em class=emdef>make-chebyshev-highpass</em> order fcut (ripple-dB 1.0)
+<em class=emdef>make-chebyshev-bandpass</em> order flo fhi (ripple-dB 1.0)
+<em class=emdef>make-chebyshev-bandstop</em> order flo fhi (ripple-dB 1.0)
+
+<em class=emdef>make-inverse-chebyshev-lowpass</em> order fcut (loss-dB 60.0)
+<em class=emdef>make-inverse-chebyshev-highpass</em> order fcut (loss-dB 60.0)
+<em class=emdef>make-inverse-chebyshev-bandpass</em> order flo fhi (loss-dB 60.0)
+<em class=emdef>make-inverse-chebyshev-bandstop</em> order flo fhi (loss-dB 60.0)
+
+<em class=emdef>make-bessel-lowpass</em> order fcut
+<em class=emdef>make-bessel-highpass</em> order fcut
+<em class=emdef>make-bessel-bandpass</em> order flo fh
+<em class=emdef>make-bessel-bandstop</em> order flo fh
+
+<em class=emdef>make-elliptic-lowpass</em> order fcut (ripple-dB 1.0) (loss-dB 60.0)
+<em class=emdef>make-elliptic-highpass</em> order fcut (ripple-dB 1.0) (loss-dB 60.0)
+<em class=emdef>make-elliptic-bandpass</em> order flo fhi (ripple-dB 1.0) (loss-dB 60.0)
+<em class=emdef>make-elliptic-bandstop</em> order flo fhi (ripple-dB 1.0) (loss-dB 60.0)
+
+;; fcut = cutoff frequency in terms of srate = 1.0,
+;; flo = low freq of band, fhi = high freq of band
- ;; fcut = cutoff frequency in terms of srate = 1.0,
- ;; flo = low freq of band, fhi = high freq of band
</pre>
-</td></tr>
-</table>
<p>analog-filter.scm has the usual IIR filters: Butterworth, Chebyshev, inverse Chebyshev, Bessel,
and Elliptic filters in lowpass, highpass, bandpass, and bandstop versions. Each of the lowpass and highpass
"make" functions returns a filter generator, whereas the bandstop and bandpass make functions
return a function of one argument, the current input (the filter generators are built-in in these cases).
-The filter order should be an even number; very high orders can cause numerical disaster! If you
-want to push these guys, be sure to build Snd with the --with-doubles configuration switch. The
+The filter order should be an even number; very high orders can cause numerical disaster!
+The
elliptic filters depend on GSL, so you'll also need GSL (Snd's configure script includes it by default, if possible).
</p>
-<pre>
- (let* ((flt (make-elliptic-lowpass 8 .1))) ; 8th order elliptic with cutoff at .1 * srate
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> flt)) ; flt is a clm filter generator
+
+<pre class="indented">
+(let ((flt (make-elliptic-lowpass 8 .1))) ; 8th order elliptic with cutoff at .1 * srate
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> flt)) ; flt is a clm filter generator
</pre>
+
<p>
One quick way to see the frequency response of your filter is to create a sound that sweeps a sinewave upward
in frequency, run it through the filter, then view the entire sound, treating the x axis as frequency
in terms of srate = 1.0 (for convenience):
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define (filter-sweep flt chan)
(let ((phase 0.0)
(freq 0.0)
(incr (/ (* 2 pi) 44100.0))
- (samps (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> 0.5)))
- (do ((i 0 (+ 1 i)))
+ (samps (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> 0.5)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(let ((sval (* .8 (sin phase))))
(set! phase (+ phase freq))
(set! freq (+ freq incr))
- (<a class=quiet href="sndclm.html#out-any" onmouseout="UnTip()" onmouseover="Tip(sndclm_out_any_tip)">out-any</a> i (flt sval) chan)))))
+ (<a class=quiet href="sndclm.html#out-any">out-any</a> i (flt sval) chan)))))
(with-sound (:channels 5 :output "test.snd")
(filter-sweep (make-butterworth-lowpass 8 .1) 0)
@@ -343,10 +446,11 @@ in terms of srate = 1.0 (for convenience):
(filter-sweep (make-chebyshev-lowpass 8 .1) 2)
(filter-sweep (make-inverse-chebyshev-lowpass 8 .1) 3)
(filter-sweep (make-elliptic-lowpass 8 .1) 4))
-</pre></td></tr></table>
+</pre>
-<table border=1 hspace=20 vspace=10 cellspacing=6 cellpadding=6>
-<tr><td bgcolor="#f2f4ff"><center>IIR filters, order=8, low cutoff at .1 (4410Hz), high cutoff at .3 (13230Hz)</center></td></tr>
+
+<table class="method">
+<tr><td class="methodtitle">IIR filters, order=8, low cutoff at .1 (4410Hz), high cutoff at .3 (13230Hz)</td></tr>
<tr><td>
<img src="pix/iir.png" alt="iir filters">
</td></tr>
@@ -359,7 +463,7 @@ in terms of srate = 1.0 (for convenience):
(incr (/ (* 2 pi) 44100.0))
(samps (seconds->samples 0.5)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i samps))
(let ((sval (* .8 (sin phase))))
@@ -399,11 +503,11 @@ in terms of srate = 1.0 (for convenience):
(filter-sweep (make-inverse-chebyshev-bandstop 8 low-cut high-cut) 3)
(filter-sweep (make-elliptic-bandstop 8 low-cut high-cut) 4))
-(set! (selected-graph-color) (make-color 1 1 1))
-(set! (selected-data-color) (make-color 0 0 0))
-(set! (axis-label-font) "9x15")
+(set! *selected-graph-color* (make-color 1 1 1))
+(set! *selected-data-color* (make-color 0 0 0))
+(set! *axis-label-font* "9x15")
-(do ((i 0 (+ 1 i)))
+(do ((i 0 (+ i 1)))
((= i 4))
(do ((k 0 (+ 1 k)))
((= k 5))
@@ -421,30 +525,24 @@ in terms of srate = 1.0 (for convenience):
-->
-<table bgcolor="aliceblue" border=0 vspace=20><tr><td>
-<pre>see also: <a href="#dspdoc" onmouseout="UnTip()" onmouseover="Tip('many more filters')">dsp</a> <a href="#exampdoc" onmouseout="UnTip()" onmouseover="Tip('comb-filter, time-varying filters, etc')">examp</a> <a href="#moogdoc" onmouseout="UnTip()" onmouseover="Tip('Moog filter')">moog</a> <a href="#maxfdoc" onmouseout="UnTip()" onmouseover="Tip('Mathews resonator')">maxf</a> <a href="#prc95doc" onmouseout="UnTip()" onmouseover="Tip('DC block')">prc95</a> <a href="#grapheqdoc" onmouseout="UnTip()" onmouseover="Tip('graphic equalizer instrument')">graphEq</a> <a href="sndclm.html#filter" onmouseout="UnTip()" onmouseover="Tip('CLM filter generators')">clm</a>
-</pre></td>
-</tr></table>
-<br>
+<div class="seealso">
+see also: <a href="#dspdoc">dsp</a> <a href="#exampdoc">examp</a> <a href="#moogdoc">moog</a> <a href="#maxfdoc">maxf</a> <a href="#prc95doc">prc95</a> <a href="#grapheq">graphEq</a> <a href="sndclm.html#filter">clm</a>
+</div>
-<!-- ---------------------------------------- FILE: animals ---------------------------------------- -->
+<!-- FILE: animals -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="animalsdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>animals</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="animalsdoc">animals</div>
<p>
People paint birds; why not bird songs? Check out a Hermit Thrush song down 2 or 3 octaves and slowed down as well (via
granular synthesis, for example) — incredibly beautiful 2-part microtonal counterpoint.
animals.scm contains several synthesized animal sounds: frogs, birds, insects, and one mammal.
-To hear them all, <code>(calling-all-animals)</code>.
+To hear them all, (calling-all-animals).
</p>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>How to Paint a Bird Song</h4></td></tr></table>
-</td></tr></table>
+<div class="innerheader">How to Paint a Bird Song</div>
<p>Back in 1980, I wanted some bird songs for "Colony", but my stabs at
a fake bird song were completely unconvincing. So I went to
@@ -454,13 +552,12 @@ of lots of bird songs. Unfortunately, the graphs were so tiny that I could bare
read them:
</p>
-<table border=0 hspace=40>
+<table>
<tr><td>
<img src="pix/golden.png" alt="Lincoln's Sparrow, approximately original size">
-</td><td width=40></td>
-<td><small>
-Lincoln's Sparrow approximately original size,<br>
-but blurrier due to incredibly bad scanner software.<br>
+</td><td>
+<small>Lincoln's Sparrow approximately original size,
+but blurrier due to incredibly bad scanner software.
</small>
</td></tr></table>
@@ -475,61 +572,61 @@ a Hairy Woodpecker call (hairy-woodpecker in animals.scm).
<p>
Open the Hairy Woodpecker. Find a squawk that seems within reach, and select it.
</p>
-<img src="pix/hairy1.png" alt="selecting a squawk" hspace=40>
+<img class="indented" src="pix/hairy1.png" alt="selecting a squawk">
<p>
Zoom onto the first channel (the vertical slider on the right — we don't care about stereo here), and center the squawk in the time domain window (C-x v).
Get the selection duration in seconds. Start the envelope editor dialog (under the Edit menu). Choose "selection"
and "wave" in that dialog.
</p>
-<img src="pix/hairy2.png" alt="zoom in" hspace=40>
+
+<img class="indented" src="pix/hairy2.png" alt="zoom in">
<p>Since the goal is a CLM instrument that synthesizes this sound, get a "blank bird", and fill
in the duration.
</p>
-<pre>
+<pre class="indented">
(definstrument (hairy-woodpecker beg amp)
- (let* ((start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
+ (let* ((start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> beg))
(dur 0.08) ; filled in from the selection duration
- (stop (+ start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (ampf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> ' ; left blank for the moment
+ (stop (+ start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> dur)))
+ (ampf (<a class=quiet href="sndclm.html#make-env">make-env</a> ' ; left blank for the moment
:duration dur :scaler amp))
- (gen1 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a>))
- (frqf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> ' ; ditto
- :duration dur :scaler (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 1.0))))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i stop))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) ; just a first guess at the synthesis algorithm
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> gen1 (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf))))))))
+ (gen1 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a>))
+ (frqf (<a class=quiet href="sndclm.html#make-env">make-env</a> ' ; ditto
+ :duration dur :scaler (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> 1.0))))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (<a class=quiet href="sndclm.html#outa">outa</a> i (* (<a class=quiet href="sndclm.html#env">env</a> ampf) ; just a first guess at the synthesis algorithm
+ (<a class=quiet href="sndclm.html#oscil">oscil</a> gen1 (<a class=quiet href="sndclm.html#env">env</a> frqf)))))))
</pre>
<p>Now to get an amplitude envelope, set the y axis limits to be from 0.0 to the selection maxamp:
</p>
-<pre>
- (set! (<a class=quiet href="extsnd.html#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a> (<a class=quiet href="extsnd.html#selectedsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedsound_tip)">selected-sound</a>) (<a class=quiet href="extsnd.html#selectedchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedchannel_tip)">selected-channel</a>)) (list 0 (<a class=quiet href="extsnd.html#selectionmaxamp" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionmaxamp_tip)">selection-maxamp</a>)))
+
+<pre class="indented">
+(set! (<a class=quiet href="extsnd.html#ybounds">y-bounds</a> (<a class=quiet href="extsnd.html#selectedsound">selected-sound</a>) (<a class=quiet href="extsnd.html#selectedchannel">selected-channel</a>)) (list 0 (<a class=quiet href="extsnd.html#selectionmaxamp">selection-maxamp</a>)))
</pre>
+
<p>
I have this action bound to the "m" key in my ~/.snd initialization file. The change is reflected in
the envelope editor. We can define the amplitude envelope by approximating the shape. Call it "hairy-amp".
</p>
-<img src="pix/hairy3.png" alt="get amp env" hspace=40>
+<img class="indented" src="pix/hairy3.png" alt="get amp env">
<p>Now go to the listener and get the value of hairy-amp as a list of breakpoints.
I usually use this function to get the breakpoints:
</p>
-<pre>
-<em class=listener>></em><em class=typing>(define (clean-string e)
- (string-concatenate (append (list "(")
- (map (lambda (n) (format #f "~,3F " n)) e)
- (list ")"))))</em>
-<em class=listener>#<unspecified></em>
-<em class=listener>></em><em class=typing>(clean-string hairy-amp)</em>
-<em class=listener>"(0.000 0.000 0.099 0.188 0.152 0.148 0.211 0.558 0.242 0.267 0.278 0.519 0.434 0.472 0.527 0.543 0.612 0.479
- 0.792 0.941 0.831 0.523 0.854 1.000 0.913 0.422 0.927 0.200 0.946 0.430 0.971 0.304 1.000 0.000 )"</em>
+<pre class="indented">
+> (define (clean-string e)
+ (format #f "(~{~,3F~^ ~})" e))
+
+> (clean-string hairy-amp)
+"(0.000 0.000 0.099 0.188 0.152 0.148 0.211 0.558 0.242 0.267 0.278 0.519 0.434 0.472 0.527 0.543 0.612 0.479
+ 0.792 0.941 0.831 0.523 0.854 1.000 0.913 0.422 0.927 0.200 0.946 0.430 0.971 0.304 1.000 0.000 )"
</pre>
<p>Plug this list into the bird instrument (ampf). Now switch to the FFT view (click "f" and "w"), open the
@@ -541,7 +638,7 @@ envelope and the spectrum match (bright spots at loud spots and so on). I bind
movements for this reason (in my ~/.snd file, see <a href="extsnd.html#moveonepixel">move-one-pixel</a>).
</p>
-<img src="pix/hairy4.png" alt="preapring to get freq env" hspace=40>
+<img class="indented" src="pix/hairy4.png" alt="preapring to get freq env">
<p>Reset the envelope editor (to erase the amp envelope), and press "flt" and "wave" again.
Now zoom in to the main spectral component (drag the FFT y axis up), and
@@ -551,27 +648,26 @@ into the bird instrument. The "scaler" for the frequency envelope is
the top of the FFT graph in Hz; it is 10KHz in this case.
</p>
-<img src="pix/hairy5.png" alt="get freq env" hspace=40>
+<img class="indented" src="pix/hairy5.png" alt="get freq env">
-<pre>
+<pre class="indented">
(definstrument (hairy-woodpecker beg amp)
- (let* ((start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
+ (let* ((start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> beg))
(dur 0.08)
- (stop (+ start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (ampf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0.000 0.000 0.099 0.188 0.152 0.148 0.211 0.558 0.242 0.267 0.278 0.519 0.434 0.472
+ (stop (+ start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> dur)))
+ (ampf (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0.000 0.000 0.099 0.188 0.152 0.148 0.211 0.558 0.242 0.267 0.278 0.519 0.434 0.472
0.527 0.543 0.612 0.479 0.792 0.941 0.831 0.523 0.854 1.000 0.913 0.422 0.927 0.200
0.946 0.430 0.971 0.304 1.000 0.000 )
:duration dur :scaler amp))
- (frqf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0.000 0.180 0.056 0.213 0.135 0.241 0.167 0.305 0.191 0.396 0.212 0.402 0.242 0.485
+ (frqf (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0.000 0.180 0.056 0.213 0.135 0.241 0.167 0.305 0.191 0.396 0.212 0.402 0.242 0.485
0.288 0.506 0.390 0.524 0.509 0.530 0.637 0.537 0.732 0.530 0.770 0.503 0.808 0.503
0.826 0.427 0.848 0.366 0.889 0.345 0.913 0.232 1.000 0.198)
- :duration dur :scaler (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 10000.0)))
- (gen1 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a>)))
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i stop))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> gen1 (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf))))))))
+ :duration dur :scaler (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> 10000.0)))
+ (gen1 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a>)))
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (<a class=quiet href="sndclm.html#outa">outa</a> i (* (<a class=quiet href="sndclm.html#env">env</a> ampf)
+ (<a class=quiet href="sndclm.html#oscil">oscil</a> gen1 (<a class=quiet href="sndclm.html#env">env</a> frqf)))))))
</pre>
<p>This squawk has more than one component (it is not just a sine wave), and the components follow more or less
@@ -582,52 +678,51 @@ components and their relative amplitudes (concentrating for now on the steady st
to "make-polywave" and give some first stab at the steady-state spectrum:
</p>
-<pre>
- ...
- (gen1 (<a class=quiet href="sndclm.html#make-polywave" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_polywave_tip)">make-polywave</a> :partials (list 1 .9 2 .1 3 .01)))
- ...
- (<a class=quiet href="sndclm.html#polywave" onmouseout="UnTip()" onmouseover="Tip(sndclm_polywave_tip)">polywave</a> gen1 (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf))
+<pre class="indented">
+...
+(gen1 (<a class=quiet href="sndclm.html#make-polywave">make-polywave</a> :partials (list 1 .9 2 .1 3 .01)))
...
+(<a class=quiet href="sndclm.html#polywave">polywave</a> gen1 (<a class=quiet href="sndclm.html#env">env</a> frqf))
+...
</pre>
<p>Load ws.scm, load the current woodpecker code, and
-listen to the squawk: <code>(with-sound (:play #t) (hairy-woodpecker 0.0 0.5))</code>.
+listen to the squawk: (with-sound (:play #t) (hairy-woodpecker 0.0 0.5)).
Not terrible. If it's cut off during playback, add a dummy silent call to the end:
-<code>(with-sound (:play #t) (hairy-woodpecker 0.0 0.5) (hairy-woodpecker 0.5 0.0))</code>.
+(with-sound (:play #t) (hairy-woodpecker 0.0 0.5) (hairy-woodpecker 0.5 0.0)).
We're happy at this stage if it's in the right ballpark.
</p>
-<img src="pix/hairy6.png" alt="first take" hspace=40>
+<img class="indented" src="pix/hairy6.png" alt="first take">
<p>
The attack and decay sections need work. Returning to either FFT view, it's clear
there's a set of components moving together at half the steady state frequency, so add another polywave with its own amplitude envelope:
</p>
-<pre>
+<pre class="indented">
(definstrument (hairy-woodpecker beg amp)
- (let* ((start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> beg))
+ (let* ((start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> beg))
(dur 0.08)
- (stop (+ start (<a class=quiet href="sndclm.html#secondstosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_secondstosamples_tip)">seconds->samples</a> dur)))
- (ampf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0.000 0.000 0.099 0.188 0.152 0.148 0.211 0.558 0.242 0.267 0.278 0.519 0.434 0.472
+ (stop (+ start (<a class=quiet href="sndclm.html#secondstosamples">seconds->samples</a> dur)))
+ (ampf (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0.000 0.000 0.099 0.188 0.152 0.148 0.211 0.558 0.242 0.267 0.278 0.519 0.434 0.472
0.527 0.543 0.612 0.479 0.792 0.941 0.831 0.523 0.854 1.000 0.913 0.422 0.927 0.200
0.946 0.430 0.971 0.304 1.000 0.000 )
:duration dur :scaler amp))
- (frqf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0.000 0.180 0.056 0.213 0.135 0.241 0.167 0.305 0.191 0.396 0.212 0.402 0.242 0.485
+ (frqf (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0.000 0.180 0.056 0.213 0.135 0.241 0.167 0.305 0.191 0.396 0.212 0.402 0.242 0.485
0.288 0.506 0.390 0.524 0.509 0.530 0.637 0.537 0.732 0.530 0.770 0.503 0.808 0.503
0.826 0.427 0.848 0.366 0.889 0.345 0.913 0.232 1.000 0.198)
- :duration dur :scaler (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 10000.0)))
- (gen1 (<a class=quiet href="sndclm.html#make-polywave" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_polywave_tip)">make-polywave</a> :partials (list 1 .9 2 .09 3 .01)))
- (gen2 (<a class=quiet href="sndclm.html#make-polywave" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_polywave_tip)">make-polywave</a> :partials (list 1 .2 2 .1 3 .1 4 .1 5 .1 6 .05 7 .01))) ; attack and decay
- (ampf2 (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 1 .3 1 .4 0 .75 0 .8 1 1 1) :duration dur :scaler 1.0))) ; its amplitude
- (<a class=quiet href="extsnd.html#run" onmouseout="UnTip()" onmouseover="Tip(extsnd_run_tip)">run</a>
- (do ((i start (+ 1 i)))
- ((= i stop))
- (let ((frq (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf)))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)
- (+ (<a class=quiet href="sndclm.html#polywave" onmouseout="UnTip()" onmouseover="Tip(sndclm_polywave_tip)">polywave</a> gen1 frq)
- (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf2)
- (<a class=quiet href="sndclm.html#polywave" onmouseout="UnTip()" onmouseover="Tip(sndclm_polywave_tip)">polywave</a> gen2 (* 0.5 frq)))))))))))
+ :duration dur :scaler (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> 10000.0)))
+ (gen1 (<a class=quiet href="sndclm.html#make-polywave">make-polywave</a> :partials (list 1 .9 2 .09 3 .01)))
+ (gen2 (<a class=quiet href="sndclm.html#make-polywave">make-polywave</a> :partials (list 1 .2 2 .1 3 .1 4 .1 5 .1 6 .05 7 .01))) ; attack and decay
+ (ampf2 (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 1 .3 1 .4 0 .75 0 .8 1 1 1) :duration dur :scaler 1.0))) ; its amplitude
+ (do ((i start (+ i 1)))
+ ((= i stop))
+ (let ((frq (<a class=quiet href="sndclm.html#env">env</a> frqf)))
+ (<a class=quiet href="sndclm.html#outa">outa</a> i (* (<a class=quiet href="sndclm.html#env">env</a> ampf)
+ (+ (<a class=quiet href="sndclm.html#polywave">polywave</a> gen1 frq)
+ (* (<a class=quiet href="sndclm.html#env">env</a> ampf2)
+ (<a class=quiet href="sndclm.html#polywave">polywave</a> gen2 (* 0.5 frq))))))))))
</pre>
<p>Now patience is the key.
@@ -637,37 +732,29 @@ Keep tweaking the envelopes and spectral amplitudes until it sounds right!
Total elapsed time? Two or three hours probably.
</p>
-<img src="pix/hairy7.png" alt="the end" hspace=40>
-
+<img class="indented" src="pix/hairy7.png" alt="the end">
<p>animals.scm has all the functions, key bindings, and dialog variable settings mentioned here.
They can save you a ton of time.
</p>
+<div class="seealso">
+see also: <a href="#birddoc">birds</a>
+</div>
-<table bgcolor="aliceblue" border=0 vspace=20><tr><td>
-<pre>
-see also: <a href="#birddoc" onmouseout="UnTip()" onmouseover="Tip('older (and simpler) versions of some of the birds')">birds</a>
-</pre></td>
-</tr></table>
-<br>
+<!-- FILE: autosave -->
-<!-- ---------------------------------------- FILE: autosave ---------------------------------------- -->
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="autosavedoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>autosave</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="autosavedoc">autosave</div>
<!-- main-index |autosavedoc:auto-save -->
-<A NAME="autosave"></A>
-<table border=0><tr><td bgcolor="#f2f3ff">
-<em class=emdef>auto-save</em> <br>
-<em class=emdef>cancel-auto-save</em> <br>
-</td></tr></table>
+<pre class="indented">
+<em class=emdef>auto-save</em>
+<em class=emdef>cancel-auto-save</em>
+</pre>
<!-- I(auto save):L(auto-save)(exautosave) -->
<!-- I(auto save):A(exautosave) -->
@@ -676,18 +763,17 @@ see also: <a href="#birddoc" onmouseout="UnTip()" onmouseover="Tip('older (and s
unsaved edits, and if any are found it saves them in a temporary file (the name is the base file name enclosed in "#...#" and placed in
the <a href="extsnd.html#tempdir">temp-dir</a> directory).
The time between checks
-is set by the variable <i>auto-save-interval</i> which defaults to 60.0 seconds.
-To start auto-saving, <code>(load "autosave.scm")</code>. Thereafter <code>(cancel-auto-save)</code>
-stops autosaving, and <code>(auto-save)</code> restarts it.
+is set by the variable auto-save-interval which defaults to 60.0 seconds.
+To start auto-saving, (load "autosave.scm"). Thereafter (cancel-auto-save)
+stops autosaving, and (auto-save) restarts it.
</p>
-<br>
-<!-- ---------------------------------------- FILE: bess ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="bessdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>bess</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: bess -->
+
+<div class="header" id="bessdoc">bess</div>
<p>bess.scm creates a dialog (named "FM Forever!"),
opens the DAC, puts up a bunch of scale widgets, and starts two CLM oscils doing
@@ -697,23 +783,16 @@ Michael Scholz has contributed a Ruby translation of this with many improvements
bess.rb.
</p>
-<table border=0 hspace=20>
-<tr><td>
-<img src="pix/fm.png" alt="fm dialog" hspace=40>
-</td>
-</tr>
-<tr><td>
-<pre>
+<img class="indented" src="pix/fm.png" alt="fm dialog">
- ;; bess opens the DAC and continuously sends the following:
- (* amp
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> carosc
- (+ (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency)
- (* index (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> modosc
- (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (* ratio frequency)))))))
+<pre class="indented">
+;; bess opens the DAC and continuously sends the following:
+(* amp
+ (<a class=quiet href="sndclm.html#oscil">oscil</a> carosc
+ (+ (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> frequency)
+ (* index (<a class=quiet href="sndclm.html#oscil">oscil</a> modosc
+ (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> (* ratio frequency)))))))
</pre>
-</td></tr></table>
-<br>
<p>bess1.scm and bess1.rb
give you real-time GUI-based control over the fm-violin while it cycles around in a simple
@@ -721,52 +800,44 @@ compositional algorithm. Both were written by
Michael Scholz, based on CLM's bess5.cl and rt.lisp.
</p>
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="fm.html#fmintro" onmouseout="UnTip()" onmouseover="Tip('introduction to FM')">fm</a>
-</pre></td>
-</tr></table>
+<div class="seealso">
+see also: <a href="fm.html#fmintro">fm</a>
+</div>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: binary-io ---------------------------------------- -->
+<!-- FILE: binary-io -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="binaryiodoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>binary-io</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="binaryiodoc">binary-io</div>
<!-- main-index |binaryiodoc:binary files -->
-<A NAME="binaryio"></A>
-<table border=0><tr><td bgcolor="#f2f3ff">
-<em class=emdef>read|write-l|bint16|32|64</em><br>
-<em class=emdef>read|write-l|bfloat32|64</em><br>
-<em class=emdef>read|write-chars|string</em><br>
+<pre class="indented">
+<em class=emdef>read|write-l|bint16|32|64</em>
+<em class=emdef>read|write-l|bfloat32|64</em>
+<em class=emdef>read|write-chars|string</em>
<em class=emdef>read|write-au-header</em>
-</td></tr></table>
+</pre>
<p>This file has functions to read and write numbers and strings to and from binary files.
-The function names are similar to those used for data-format names, so for example,
+The function names are similar to those used for sample-type names, so for example,
read-bint32 reads the next 4 bytes from the current input port,
interpreting them as a big-endian 32-bit integer.
</p>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: bird ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="birddoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>bird</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: bird -->
+
+<div class="header" id="birddoc">bird</div>
+
+<pre class="indented">
+<em class=def id="bird">bird</em> start dur frequency freqskew amplitude freq-envelope amp-envelope
+<em class=def id="bigbird">bigbird</em> start dur frequency freqskew amplitude freq-envelope amp-envelope partials
+<em class=emdef>one-bird</em> beg maxdur func birdname
+<em class=def id="makebirds">make-birds</em> (output-file "test.snd")
+</pre>
-<table border=0><tr><td bgcolor="#f2f3ff">
-<a class=def name="bird">bird</a> <code>start dur frequency freqskew amplitude freq-envelope amp-envelope</code><br>
-<a class=def name="bigbird">bigbird</a> <code>start dur frequency freqskew amplitude freq-envelope amp-envelope partials</code><br>
-<em class=emdef>one-bird</em> <code>beg maxdur func birdname</code><br>
-<a class=def name="makebirds">make-birds</a> <code>(output-file "test.snd")</code><br>
-</td></tr></table>
<p>
bird.scm is a translation of the Sambox/CLM bird songs. The two instruments set
up a sine wave (bird) and waveshaping synthesis (bigbird). Use a
@@ -774,22 +845,23 @@ low-pass filter for distance effects (a bird song sounds really silly
reverberated). All the real information is in the amplitude and frequency
envelopes. These were transcribed from sonograms found in some bird guides and articles from
the Cornell Ornithology Lab.
-
Many of these birds were used in "Colony". To hear all the
-birds, <code>(make-birds)</code>. This writes the sequence out as "test.snd" using with-sound.
+birds, (make-birds). This writes the sequence out as "test.snd" using with-sound.
Waveshaping is described in Le Brun, "Digital Waveshaping Synthesis", JAES 1979 April, vol 27, no 4, p250.
The lines
</p>
-<pre>
- ...
- (coeffs (<a class=quiet href="sndclm.html#partialstopolynomial" onmouseout="UnTip()" onmouseover="Tip(sndclm_partialstopolynomial_tip)">partials->polynomial</a> (normalize-partials partials)))
- ...
- (<a class=quiet href="sndclm.html#polynomial" onmouseout="UnTip()" onmouseover="Tip(sndclm_polynomial_tip)">polynomial</a> coeffs
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> gls-env))))))
- <!-- ((( -->
+
+<pre class="indented">
+...
+(coeffs (<a class=quiet href="sndclm.html#partialstopolynomial">partials->polynomial</a> (normalize-partials partials)))
+...
+ (<a class=quiet href="sndclm.html#polynomial">polynomial</a> coeffs
+ (<a class=quiet href="sndclm.html#oscil">oscil</a> os (<a class=quiet href="sndclm.html#env">env</a> gls-env))))))
+ <!-- ((( -->
</pre>
+
<p>setup and run the waveshaping synthesis (in this case it's just a fast
-additive synthesis). <b>partials->polynomial</b> calculates the Chebyshev
+additive synthesis). partials->polynomial calculates the Chebyshev
polynomial coefficients given the desired spectrum; the spectrum then
results from driving that polynomial with an oscillator. Besides the
bird guides, there are now numerous recordings of birds that can
@@ -797,29 +869,23 @@ be turned into sonograms and transcribed as envelopes. <a href="sndclm.html#osci
code for the bird instrument in several languages.
</p>
-<table bgcolor="aliceblue" border=0 vspace=10><tr><td>
-<pre>
-see also: <a href="#animalsdoc" onmouseout="UnTip()" onmouseover="Tip('new versions of some of these birds')">animals</a>
-</pre></td>
-</tr></table>
-
-<br>
+<div class="seealso">
+see also: <a href="#animalsdoc">animals</a>
+</div>
-<!-- ---------------------------------------- FILE: clean ---------------------------------------- -->
+<!-- FILE: clean -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="cleandoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>clean</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="cleandoc">clean</div>
<p>This file provides a set of noise reduction functions packaged up in:
</p>
-<table border=0><tr><td bgcolor="#f2f3ff">
-<a class=def name="cleanchannel">clean-channel</a> <code>snd chn</code><br>
-<a class=def name="cleansound">clean-sound</a> <code>snd</code><br>
-</td></tr></table>
+<pre class="indented">
+<em class=def id="cleanchannel">clean-channel</em> snd chn
+<em class=def id="cleansound">clean-sound</em> snd
+</pre>
<p>
clean-channel tries to fix up clicks, pops, hum, DC offset, clipped portions, and hiss using a
@@ -827,11 +893,10 @@ variety of functions from dsp.scm. The final low-pass filter is relatively cons
it's not a very intense filter), so you may want to run another filter over the data after calling
clean-channel.
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>A Noisy Story</h4></td></tr></table>
-</td></tr></table>
+
+
+<div class="innerheader">A Noisy Story</div>
<!-- INDEX cleandoc:Noise Reduction -->
<p>There is no built-in noise reduction function in Snd.
@@ -849,8 +914,8 @@ otherwise have been safe. I hoped to reconstruct the signal at the clipped
points, but these would be hard to find once the DC was removed. A quick check:
</p>
-<pre>
- (<a class=quiet href="extsnd.html#countmatches" onmouseout="UnTip()" onmouseover="Tip(extsnd_countmatches_tip)">count-matches</a> (lambda (y) (or (> y .9999) (< y -.9999))))
+<pre class="indented">
+(count-matches (lambda (y) (or (> y .9999) (< y -.9999))))
</pre>
<p>
@@ -858,18 +923,16 @@ returned 5437 (in 18 minutes of sound). That seemed high, and I thought "maybe
those are just one sample clicks that can easily be smoothed over", so
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td>
-<pre>
+<pre class="indented">
(define* (count-clips snd chn)
(let ((y0 0.0))
- (<a class=quiet href="extsnd.html#countmatches" onmouseout="UnTip()" onmouseover="Tip(extsnd_countmatches_tip)">count-matches</a>
+ (count-matches
(lambda (y) (let ((val (and (or (> y0 .9999) (< y0 -.9999))
(or (> y .9999) (< y -.9999)))))
(set! y0 y)
val))
0 snd chn)))
</pre>
-</td></tr></table>
<p>
But this returned 4768! I made a list of clipped
@@ -877,7 +940,7 @@ portions (this function has at least one bug, but I plowed past it — no
time for perfection...):
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define* (list-clips snd chn)
(let* ((max-clips (count-clips snd chn))
(clip-data (make-vector (* 2 max-clips) 0))
@@ -887,7 +950,7 @@ time for perfection...):
(clip-max-len 0)
(in-clip #f)
(samp 0))
- (<a class=quiet href="extsnd.html#scanchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_scanchannel_tip)">scan-channel</a>
+ (<a class=quiet href="extsnd.html#scanchannel">scan-channel</a>
(lambda (y)
(if (or (> y .9999) (< y -.9999))
(if in-clip
@@ -906,17 +969,19 @@ time for perfection...):
(set! samp (+ 1 samp))
#f)) ; make sure scan doesn't quit prematurely
(list clip-ctr clip-max-len clip-data)))
-</pre></td></tr></table>
+</pre>
<p>
which returned a vector of 669 clipped portions, the worst being 42 samples long!
I saved that data in a separate file, just in case of disaster:
</p>
-<pre>
- (with-output-to-file "clips" (display (list-clips)))
+
+<pre class="indented">
+(with-output-to-file "clips" (lambda () (display (list-clips))))
</pre>
+
<p>
I decided to try to reconstruct the clipped portions before
filtering them.
@@ -925,22 +990,24 @@ produced sample values outside -1.0 to 1.0,
so I reset the graph y bounds:
</p>
-<pre>
- (set! (<a class=quiet href="extsnd.html#ybounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_ybounds_tip)">y-bounds</a>) (list -1.5 1.5))
+
+<pre class="indented">
+(set! (<a class=quiet href="extsnd.html#ybounds">y-bounds</a>) (list -1.5 1.5))
</pre>
+
<p>
Now to conjure up a plausible sine wave between the clip begin and
end points. (This is also "just-good-enough" software).
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(if (not (defined? 'pi)) (define pi 3.141592653589793))
(define (fix-clip clip-beg-1 clip-end-1)
(if (> clip-end-1 clip-beg-1)
(let* ((dur (+ 1 (- clip-end-1 clip-beg-1)))
- (samps (<a class=quiet href="extsnd.html#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> (- clip-beg-1 4) (+ dur 9)))
+ (samps (channel->float-vector (- clip-beg-1 4) (+ dur 9)))
(clip-beg 3)
(clip-end (+ dur 4)))
(let ((samp0 (samps clip-beg))
@@ -972,47 +1039,47 @@ end points. (This is also "just-good-enough" software).
(amp (* .125 (+ (abs (- samp0 samp00)) (abs (- samp1 samp11))) dist)))
(if (> samp0 0.0)
;; clipped at 1.0
- (do ((i (+ 1 clip-beg) (+ 1 i))
+ (do ((i (+ 1 clip-beg) (+ i 1))
(angle incr (+ angle incr)))
((= i clip-end))
(set! (samps i) (+ 1.0 (* amp (sin angle)))))
;; clipped at -1.0
- (do ((i (+ 1 clip-beg) (+ 1 i))
+ (do ((i (+ 1 clip-beg) (+ i 1))
(angle incr (+ angle incr)))
((= i clip-end))
(set! (samps i) (- -1.0 (* amp (sin angle))))))
- (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> samps (- clip-beg-1 4))))
+ (float-vector->channel samps (- clip-beg-1 4))))
#t) ; return values so I can tell when I hit a 1-sample section during testing
#f))
(define (fix-it n)
;; turn off graphics and fix all the clipped sections
- (set! (<a class=quiet href="extsnd.html#squelchupdate" onmouseout="UnTip()" onmouseover="Tip(extsnd_squelchupdate_tip)">squelch-update</a>) #t)
- (do ((i 0 (+ 1 i)))
+ (set! (<a class=quiet href="extsnd.html#squelchupdate">squelch-update</a>) #t)
+ (do ((i 0 (+ i 1)))
((= i n))
;; "clips" here is a list form of the earlier vector of clip locations
- (fix-clip (list-ref clips (* i 2))
- (list-ref clips (+ 1 (* i 2)))))
- (set! (<a class=quiet href="extsnd.html#squelchupdate" onmouseout="UnTip()" onmouseover="Tip(extsnd_squelchupdate_tip)">squelch-update</a>) #f))
+ (fix-clip (clips (* i 2))
+ (clips (+ 1 (* i 2)))))
+ (set! (<a class=quiet href="extsnd.html#squelchupdate">squelch-update</a>) #f))
(fix-it 669)
-</pre></td></tr></table>
+</pre>
-<p>
+<p id="notchoutrumbleandhiss">
This produced 418 edits, with a maxamp of 2.26. So scale it back down:
-<code>(<a class=quiet href="extsnd.html#scaleto" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleto_tip)">scale-to</a> .9)</code>.
+(<a class=quiet href="extsnd.html#scaleto">scale-to</a> .9).
Next I ran some large ffts to see what sort of overall spectrum I had:
-<code>(set! (<a class=quiet href="extsnd.html#transformsize" onmouseout="UnTip()" onmouseover="Tip(extsnd_transformsize_tip)">transform-size</a>) (expt 2 23))</code>.
+(set! (<a class=quiet href="extsnd.html#transformsize">transform-size</a>) (expt 2 23)).
This showed a massive DC component, and numerous harmonics of 60 Hz.
I decided to get rid of the portions that were clearly noise. Since I was dealing with
telephone recordings, I assumed anything under 40 Hz or above
4000 Hz was extraneous:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define* (<a name="notchoutrumbleandhiss">notch-out-rumble-and-hiss</a> snd chn)
- (let* ((cur-srate (exact->inexact (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd))))
- (<a class=quiet href="extsnd.html#filtersound" onmouseout="UnTip()" onmouseover="Tip(extsnd_filtersound_tip)">filter-sound</a>
+<pre class="indented">
+(define* (notch-out-rumble-and-hiss snd chn)
+ (let ((cur-srate (exact->inexact (<a class=quiet href="extsnd.html#srate">srate</a> snd))))
+ (<a class=quiet href="extsnd.html#filtersound">filter-sound</a>
(list 0.0 0.0 ; get rid of DC
(/ 80.0 cur-srate) 0.0 ; get rid of anything under 40 Hz (1.0=srate/2 here)
(/ 90.0 cur-srate) 1.0 ; now the passband
@@ -1022,11 +1089,11 @@ telephone recordings, I assumed anything under 40 Hz or above
;; since I'm assuming the minimum band is 10 Hz here,
;; cur-srate/10 rounded up to next power of 2 seems a safe filter size
;; filter-sound will actually use overlap-add convolution in this case
- (floor (expt 2 (ceiling (/ (log (/ cur-srate 10.0)) (log 2.0)))))
+ (floor (expt 2 (ceiling (log (/ cur-srate 10.0) 2))))
snd chn)))
(notch-out-rumble-and-hiss)
-</pre></td></tr></table>
+</pre>
<p>
By now it was obvious I needed a simple way to play portions of the
@@ -1034,29 +1101,29 @@ sound before and after an edit, sometimes with a tracking cursor.
So I bound a few keys:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define (play-from-cursor current)
- (<a class=quiet href="extsnd.html#play" onmouseout="UnTip()" onmouseover="Tip(extsnd_play_tip)">play</a> (<a class=quiet href="extsnd.html#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) #f #f #f #f (if current #f (- (<a class=quiet href="extsnd.html#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a>) 1))))
+ (<a class=quiet href="extsnd.html#play">play</a> (<a class=quiet href="extsnd.html#cursor">cursor</a>) #f #f #f #f (and (not current) (- (<a class=quiet href="extsnd.html#editposition">edit-position</a>) 1))))
(define (play-from-cursor-with-tracking current)
;; patterned after pfc in extsnd.html
- (let ((old-tracking (<a class=quiet href="extsnd.html#withtrackingcursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_withtrackingcursor_tip)">with-tracking-cursor</a>)))
- (set! (<a class=quiet href="extsnd.html#withtrackingcursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_withtrackingcursor_tip)">with-tracking-cursor</a>) #t)
- (hook-push <a class=quiet href="extsnd.html#stopplayinghook" onmouseout="UnTip()" onmouseover="Tip(extsnd_stopplayinghook_tip)">stop-playing-hook</a>
- (lambda (snd)
- (set! (<a class=quiet href="extsnd.html#withtrackingcursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_withtrackingcursor_tip)">with-tracking-cursor</a>) old-tracking)))
- (<a class=quiet href="extsnd.html#play" onmouseout="UnTip()" onmouseover="Tip(extsnd_play_tip)">play</a> (<a class=quiet href="extsnd.html#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) #f #f #f #f (if current #f (- (<a class=quiet href="extsnd.html#editposition" onmouseout="UnTip()" onmouseover="Tip(extsnd_editposition_tip)">edit-position</a>) 1)))))
-
-(<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\p 0 (lambda ()
+ (let ((old-tracking (<a class=quiet href="extsnd.html#withtrackingcursor">with-tracking-cursor</a>)))
+ (set! (<a class=quiet href="extsnd.html#withtrackingcursor">with-tracking-cursor</a>) #t)
+ (hook-push <a class=quiet href="extsnd.html#stopplayinghook">stop-playing-hook</a>
+ (lambda (hook)
+ (set! (<a class=quiet href="extsnd.html#withtrackingcursor">with-tracking-cursor</a>) old-tracking)))
+ (<a class=quiet href="extsnd.html#play">play</a> (<a class=quiet href="extsnd.html#cursor">cursor</a>) #f #f #f #f (and (not current) (- (<a class=quiet href="extsnd.html#editposition">edit-position</a>) 1)))))
+
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> #\p 0 (lambda ()
"play from cursor"
- (play-from-cursor #t) <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_keyboard_no_action_tip)">keyboard-no-action</a>))
-(<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\P 0 (lambda ()
+ (play-from-cursor #t) <a class=quiet>keyboard-no-action</a>))
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> #\P 0 (lambda ()
"play previous from cursor"
- (play-from-cursor #f) <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_keyboard_no_action_tip)">keyboard-no-action</a>))
-(<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\p 4 (lambda ()
+ (play-from-cursor #f) <a class=quiet>keyboard-no-action</a>))
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> #\p 4 (lambda ()
"play from cursor with tracking"
- (play-from-cursor-with-tracking #t) <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_keyboard_no_action_tip)">keyboard-no-action</a>))
-</pre></td></tr></table>
+ (play-from-cursor-with-tracking #t) <a class=quiet>keyboard-no-action</a>))
+</pre>
<p>
In words, if the mouse is in the channel graph, 'p' plays from the cursor,
@@ -1067,18 +1134,22 @@ separate conversations), there was a loud mid-range tone. To figure out what it
I FFT'd a portion containing only that noise and got this spectrum
(plus a zillion other peaks that didn't look interesting):
</p>
-<pre>
- ((425 .05) (450 .01) (546 .02) (667 .01) (789 .034) (910 .032) (470 .01))
+
+<pre class="indented">
+((425 .05) (450 .01) (546 .02) (667 .01) (789 .034) (910 .032) (470 .01))
</pre>
+
<p>To hear that, I passed this list to <a href="#playsines">play-sines</a>:
</p>
-<pre>
- (play-sines '((425 .05) (450 .01) (546 .02) (667 .01) (789 .034) (910 .032) (470 .01)))
+
+<pre class="indented">
+(play-sines '((425 .05) (450 .01) (546 .02) (667 .01) (789 .034) (910 .032) (470 .01)))
</pre>
+
<p>
And to my surprise, the result was close to the main portion of the hum.
So now to notch out those frequencies,
-and see what is left: <code>(notch-sound (list 425 450 470 546 667 789 910) #f 1 10)</code>.
+and see what is left: (notch-sound (list 425 450 470 546 667 789 910) #f 1 10).
This erased most of the hum, but it also
changed the timbre of the voices which wasn't acceptable.
I goofed around with the notch-width and filter-size parameters, looking
@@ -1090,7 +1161,7 @@ individual characteristics of each voice were.
<p>
The next step was to take out noisy sections between snippets, mostly
-using <code>(<a class=quiet href="extsnd.html#envselection" onmouseout="UnTip()" onmouseover="Tip(extsnd_envselection_tip)">env-selection</a> '(0 1 1 0 10 0 11 1))</code>
+using (<a class=quiet href="extsnd.html#envselection">env-selection</a> '(0 1 1 0 10 0 11 1))
and equalizing each snippet, more or less, with scale-selection-by.
There were a few "you-are-being-recorded" beeps which I deleted (via the Edit
menu delete selection option).
@@ -1099,32 +1170,26 @@ between sections of speech the background hum would gradually increase, then
the voice would abruptly start with a large peak amplitude. These
were fixed mostly with small-section scale-by's and envelopes.
In the female voice sections, it seemed to help to:
-<code>(<a class=quiet href="extsnd.html#filterselection" onmouseout="UnTip()" onmouseover="Tip(extsnd_filterselection_tip)">filter-selection</a> '(0 0 .01 0 .02 1 1 1) 1024)</code>
+(<a class=quiet href="extsnd.html#filterselection">filter-selection</a> '(0 0 .01 0 .02 1 1 1) 1024)
which got rid of some of the rumble without noticeably affecting
the vocal timbre.
</p>
-<TABLE border=3 bordercolor="tan" hspace=40><tr><td>
-<blockquote><small>
-<br>
-clicks: <a href="extsnd.html#smoothchannel">smooth-channel</a>, <a href="#removeclicks">remove-clicks</a>, <a href="#fftsmoother">fft-smoother</a><br>
-rumble, hiss: <a href="#notchoutrumbleandhiss">notch-out-rumble-and-hiss</a>, <a href="#fftsquelch">fft-squelch</a>, <a href="#fftcancel">fft-cancel</a><br>
-hum: <a href="#notchchannel">notch-channel</a><br>
-via CLM ins: <a href="#anoi">anoi</a><br>
-<br>
-</small></blockquote>
-</td></tr></TABLE>
-<br>
+<div class="seealso">
+see also: <a href="extsnd.html#smoothchannel">smooth-channel</a> <a href="#removeclicks">remove-clicks</a> <a href="#fftsmoother">fft-smoother</a>
+<a href="#notchoutrumbleandhiss">notch-out-rumble-and-hiss</a> <a href="#fftsquelch">fft-squelch</a>
+<a href="#fftcancel">fft-cancel</a>
+<a href="#notchchannel">notch-channel</a> <a href="#anoi">anoi</a>
+</div>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: clm-ins ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="clminsdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>clm-ins</h2></td></tr></table>
-</td></tr></table>
+
+
+<!-- FILE: clm-ins -->
+
+<div class="header" id="clminsdoc">clm-ins</div>
<p>These are instruments from CLM translated for use in Snd. All expect to be called within <a href="#wsdoc">with-sound</a>
or some equivalent environment. This set of instruments is a bit of a grab-bag; some are just examples of synthesis techniques;
@@ -1135,72 +1200,93 @@ and combine several other parameters to reflect the desired output, rather than
But, it is an historical artifact, so I'm reluctant to change it.
</p>
-<p>To try out any of these instruments, start Snd, set optimization to 6, load ws.scm and clm-ins.scm, then
+<p>To try out any of these instruments, start Snd, load ws.scm and clm-ins.scm, then
paste the with-sound call into the listener. It will automatically write the
new sound file and open it in Snd.
</p>
-<table border=0 hspace=20 cellspacing=4 cellpadding=6>
-
+<div class="separator"></div>
<!-- anoi -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="anoi">anoi</a> <code>file start dur (fftsize 128) (amp-scaler 1.0) (r 6.28)</code>
-</td></tr><tr><td width=30></td><td>
+<pre class="indented">
+<em class=def id="anoi">anoi</em> file start dur (fftsize 128) (amp-scaler 1.0) (r 6.28)
+</pre>
+
+<p>
anoi is a stab at noise reduction
based on Perry Cook's Scrubber.m. It tracks an on-going average spectrum, then tries
to squelch that, obviously aimed at reducing background noise in an intermittent signal.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (anoi "now.snd" 0 2))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (anoi "now.snd" 0 2))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- attract -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>attract</em> <code>beg dur amp c</code>
-</td></tr><tr><td></td><td>
-attract is a translation to CLM of an instrument developed by James McCartney (CMJ vol 21 no 3 p 6),
+<pre class="indented">
+<em class=emdef>attract</em> beg dur amp c
+</pre>
+
+<p>attract is a translation to CLM of an instrument developed by James McCartney (CMJ vol 21 no 3 p 6),
based on a "chaotic" equation.
'c' should be between 1 and 10 or thereabouts.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (attract 0 1 .1 1) (attract 1 1 .1 5))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (attract 0 1 .1 1) (attract 1 1 .1 5))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
<!-- bes-fm -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>bes-fm</em> <code>beg dur freq amp ratio index</code>
-</td></tr><tr><td></td><td>
-bes-fm is J1(J1): <code>(bes-j1 (* index (bes-j1 phase)))</code>; it uses the Bessel functions where FM uses sinusoids. J0 is also good in this context,
+<pre class="indented">
+<em class=emdef>bes-fm</em> beg dur freq amp ratio index
+</pre>
+
+<p>bes-fm is J1(J1): <code>(bes-j1 (* index (bes-j1 phase)))</code>; it uses the Bessel functions where FM uses sinusoids. J0 is also good in this context,
and the few other Jn options that I've tried were ok.
-<pre>
- Scheme: (with-sound () (bes-fm 0 1 440 10.0 1.0 4.0))
- Ruby: with_sound() do bes_fm(0, 0.5, 440, 5, 1, 8) end
+</p>
+
+<pre class="indented">
+Scheme: (with-sound () (bes-fm 0 1 440 10.0 1.0 4.0))
+Ruby: with_sound() do bes_fm(0, 0.5, 440, 5, 1, 8) end
</pre>
-So why does this work? My "back-of-the-envelope" guess is that the Bessel functions
+
+<p>So why does this work? My "back-of-the-envelope" guess is that the Bessel functions
are basically a bump at the start followed by a decaying sinusoid, so
the bump
gives us a percussive attack, and the damped sinusoid gives us
a dynamic spectrum, mimicking FM more or less.
-
The Bessel functions I0, Jn, and Yn are built-in; Kn and In are implemented in Scheme in snd-test.scm. See <a href="sndclm.html#bess">bess</a> and friends
for many more examples.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
+
+
<!-- main-index |bagpipe:bagpipe -->
<!-- canter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="bagpipe">canter</a> <code>beg dur freq amp ...</code>
-</td></tr><tr><td></td><td>
-canter is half of a bagpipe instrument developed by Peter Commons (the other portion is <a href="#drone">drone</a> below).
+<pre class="indented">
+<em class=def id="bagpipe">canter</em> beg dur freq amp ...
+</pre>
+
+<p>canter is half of a bagpipe instrument developed by Peter Commons (the other portion is <a href="#drone">drone</a> below).
The (required) trailing parameters are:
-<pre>
- deg dis pcrev ampfun ranfun skewfun skewpc ranpc ranfreq indexfun atdr dcdr
- ampfun1 indfun1 fmtfun1 ampfun2 indfun2 fmtfun2 ampfun3 indfun3 fmtfun3 ampfun4 indfun4 fmtfun4
+</p>
+
+<pre class="indented">
+deg dis pcrev ampfun ranfun skewfun skewpc ranpc ranfreq indexfun atdr dcdr
+ampfun1 indfun1 fmtfun1 ampfun2 indfun2 fmtfun2 ampfun3 indfun3 fmtfun3 ampfun4 indfun4 fmtfun4
</pre>
-Here is a portion of a bagpipe tune:
-<pre>
+
+<p>Here is a portion of a bagpipe tune:
+</p>
+
+<pre class="indented">
(let ((fmt1 '(0 1200 100 1000))
(fmt2 '(0 2250 100 1800))
(fmt3 '(0 4500 100 4500))
@@ -1221,7 +1307,7 @@ Here is a portion of a bagpipe tune:
(bassdr2 '(.5 .06 1 .62 1.5 .07 2.0 .6 2.5 .08 3.0 .56 4.0 .24 5 .98 6 .53 7
.16 8 .33 9 .62 10 .12 12 .14 14 .86 16 .12 23 .14 24 .17))
(tenordr '(.3 .04 1 .81 2 .27 3 .2 4 .21 5 .18 6 .35 7 .03 8 .07 9 .02 10 .025 11 .035)))
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb nrev)
+ (<a class=quiet href="#wsdoc">with-sound</a> (:reverb nrev)
(drone .000 4.000 115.000 (* .25 .500) solid bassdr2 .100 .500 .030 45.000 1 .010 10)
(drone .000 4.000 229.000 (* .25 .500) solid tenordr .100 .500 .030 45.000 1 .010 11)
(drone .000 4.000 229.500 (* .25 .500) solid tenordr .100 .500 .030 45.000 1 .010 9)
@@ -1258,75 +1344,98 @@ Here is a portion of a bagpipe tune:
(canter 3.940 .260 459 (* .25 .700) 45.000 1 .050 ampf ranf skwf
.050 .010 10 index .005 .005 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4)))
</pre>
-It is not easy to keep track of all these arguments in a long note-list; hence the
+
+<p>It is not easy to keep track of all these arguments in a long note-list; hence the
development of programs such as Score (Leland Smith), Pla (yers truly), and Common Music (Rick Taube).
The full note list is bag.clm in the CLM tarball.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+
+<div class="separator"></div>
<!-- main-index |cellon:feedback fm -->
<!-- cellon -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="cellon">cellon</a> <code>beg dur freq amp ...</code>
-</td></tr><tr><td></td><td>
-cellon, developed by Stanislaw Krupowiecz, uses feedback FM as in some old synthesizers. There's a brief discussion of it in <a href="fm.html">fm.html</a>.
+<pre class="indented">
+<em class=def id="cellon">cellon</em> beg dur freq amp ...
+</pre>
+
+<p>cellon, developed by Stanislaw Krupowiecz, uses feedback FM as in some old synthesizers. There's a brief discussion of it in <a href="fm.html">fm.html</a>.
The trailing parameters are:
-<pre>
- ampfun betafun beta0 beta1 betaat betadc ampat ampdc dis pcrev deg pitch1 glissfun glissat
- glissdc pvibfreq pvibpc pvibfun pvibat pvibdc rvibfreq rvibpc rvibfun
+</p>
+
+<pre class="indented">
+ampfun betafun beta0 beta1 betaat betadc ampat ampdc dis pcrev deg pitch1 glissfun glissat
+glissdc pvibfreq pvibpc pvibfun pvibat pvibdc rvibfreq rvibpc rvibfun
</pre>
-and I actually don't know what they all do. I think they're dealing with attack and decay portions
+
+<p>and I actually don't know what they all do. I think they're dealing with attack and decay portions
of envelopes; in the old days we felt we had to store one envelope, then kludge around with attack and decay
timings to bash that envelope into the correct shape; this made instruments needlessly messy.
Here's a call:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (cellon 0 2 220 .1 '(0 0 25 1 75 1 100 0) '(0 0 25 1 75 1 100 0) .75 1.0 0 0 0 0 1 0 0 220
- '(0 0 25 1 75 1 100 0) 0 0 0 0 '(0 0 100 0) 0 0 0 0 '(0 0 100 0)))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (cellon 0 2 220 .1 '(0 0 25 1 75 1 100 0) '(0 0 25 1 75 1 100 0) .75 1.0 0 0 0 0 1 0 0 220
+ '(0 0 25 1 75 1 100 0) 0 0 0 0 '(0 0 100 0) 0 0 0 0 '(0 0 100 0)))
</pre>
-The use of x axis values between 0 and 100, rather than 0.0 and 1.0 is a dead give-away that
+
+<p>The use of x axis values between 0 and 100, rather than 0.0 and 1.0 is a dead give-away that
this is really ancient stuff.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+
+<div class="separator"></div>
<!-- clm-expsrc -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="clmexpsrc">clm-expsrc</a> <code>beg dur input-file exp-ratio src-ratio amp rev start-in-file</code>
-</td></tr><tr><td></td><td>
-clm-expsrc can stretch or compress a sound (using granular synthesis) while optionally changing its sampling rate.
+<pre class="indented">
+<em class=def id="clmexpsrc">clm-expsrc</em> beg dur input-file exp-ratio src-ratio amp rev start-in-file
+</pre>
+
+<p>clm-expsrc can stretch or compress a sound (using granular synthesis) while optionally changing its sampling rate.
'exp-ratio' sets the expansion amount (greater than 1.0 makes the sound longer), and
'src-ratio' sets the sampling rate change (greater than 1.0 makes it higher in pitch).
So to make a sound twice as long, but keep the pitch the same:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (clm-expsrc 0 4 "oboe.snd" 2.0 1.0 1.0))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (clm-expsrc 0 4 "oboe.snd" 2.0 1.0 1.0))
</pre>
-'start-in-file' sets where we start reading the input file (in seconds); it defaults to 0.0.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>'start-in-file' sets where we start reading the input file (in seconds); it defaults to 0.0.
+</p>
+<div class="separator"></div>
+
<!-- drone -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="drone">drone</a> <code>beg dur freq amp ampfun synth ampat ampdc amtrev deg dis rvibamt rvibfreq</code>
-</td></tr><tr><td></td><td>
-This is the other half of Peter Common's bagpipe — see canter above.
+<pre class="indented">
+<em class=def id="drone">drone</em> beg dur freq amp ampfun synth ampat ampdc amtrev deg dis rvibamt rvibfreq
+</pre>
+
+<p>This is the other half of Peter Common's bagpipe — see canter above.
'synth' is a list of partials loaded into a table and read via <a href="sndclm.html#table-lookup">table-lookup</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
<!-- expandn -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>expandn</em> <code>time duration file amp ...</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef>expandn</em> time duration file amp ...
+</pre>
+
<p>
Here is the documentation from Rick Taube's granular synthesis page, edited slightly for the Scheme CLM.
</p>
+
<p>
The expandn instrument by Michael Klingbeil performs granular syntheisis by time-stretching (expanding/compressing) an input file.
This effect is achieved by chopping up the input sound into very small segments (grains) that are then overlayed in the ouput stream.
The larger the segments, the more the output sound is smeared, an effect approaching reverberation.
The expandn instrument parameters are:
</p>
-<pre>
+
+<pre class="indented">
time duration filename amplitude
(expand 1.0)
(matrix #f)
@@ -1339,11 +1448,12 @@ The expandn instrument parameters are:
(grain-amp 0.8)
(reverb #f)
</pre>
+
<p>
'time' is the start time of the sound in the output file.
'duration' is the duration of expanded sound. To expand an entire sound, set this to the expansion factor times the input sound's duration.
'filename' is the input file to expand.
-'amplitude' is a scaler on the ampitude of the input file. Since the output is created by overlaying many copies of the intput this value is generally less than 1.
+'amplitude' is a scaler on the amplitude of the input file. Since the output is created by overlaying many copies of the intput this value is generally less than 1.
'hop' can be a number or an envelope. It is the average length in time between segments (grains) in the output.
'expand' can be a number or an envelope. It sets the amount of expansion to produce in the output file.
'seglen'can be a number or an envelope. It is the length in time of the sound segments (grains).
@@ -1354,91 +1464,109 @@ The expandn instrument parameters are:
'matrix' is a list, a mixing matrix.
'reverb' is the reverb amount.
</p>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="separator"></div>
<!-- expfil -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>expfil</em> <code>start duration hopsecs rampsecs steadysecs file1 file2</code>
-</td></tr><tr><td></td><td>
-expfile interleaves two granular synthesis processes (two readers pasting in tiny sections
+<pre class="indented">
+<em class=emdef>expfil</em> start duration hopsecs rampsecs steadysecs file1 file2
+</pre>
+
+<p>expfile interleaves two granular synthesis processes (two readers pasting in tiny sections
of their file, one after the other).
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (expfil 0 2 .2 .01 .1 "oboe.snd" "fyow.snd")
- (expfil 2 2 .01 .01 .02 "oboe.snd" "fyow.snd"))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (expfil 0 2 .2 .01 .1 "oboe.snd" "fyow.snd")
+ (expfil 2 2 .01 .01 .02 "oboe.snd" "fyow.snd"))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
<!-- exp-snd -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>exp-snd</em> <code>file beg dur amp (exp-amt 1.0) (ramp .4) (seglen .15) (sr 1.0) (hop .05) ampenv</code>
-</td></tr><tr><td></td><td>
-exp-snd is a granular synthesis instrument with envelopes on
+<pre class="indented">
+<em class=emdef>exp-snd</em> file beg dur amp (exp-amt 1.0) (ramp .4) (seglen .15) (sr 1.0) (hop .05) ampenv
+</pre>
+
+<p>exp-snd is a granular synthesis instrument with envelopes on
the expansion amount ('exp-amt' as a list), segment ramp steepness ('ramp' as a list),
segment length ('seglen' as a list), hop length ('hop' as a list), amplitude ('ampenv'),
and resampling rate ('sr' as a list).
In the next example, the expansion amount in both calls goes from 1 to 3 over the course of the note,
the ramp time and segment lengths stay the same, the sampling rate changes from 2 to 0.5, and the hop
stays the same (.05 in the first, and .2 in the second).
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (exp-snd "fyow.snd" 0 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05)
- (exp-snd "oboe.snd" 1 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.2))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (exp-snd "fyow.snd" 0 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05)
+ (exp-snd "oboe.snd" 1 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.2))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
-<!-- main-index |fmbell:fm-bell -->
<!-- fm-bell -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fmbell">fm-bell</a> <code>beg dur frequency amplitude amp-env index-env index</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="fmbell">fm-bell</em> beg dur frequency amplitude amp-env index-env index
+</pre>
fm-bell is an <a href="fm.html#fmintro">FM</a> instrument developed by Michael McNabb in Mus10 in the late '70s. It is intended
for low bell sounds (say middle C or so). The lines
-<pre>
- (mod1 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* frequency 2)))
- (mod2 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* frequency 1.41)))
- (mod3 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* frequency 2.82)))
- (mod4 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* frequency 2.4)))
- (car1 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frequency))
- (car2 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frequency))
- (car3 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* frequency 2.4)))
+
+<pre class="indented">
+ (mod1 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* frequency 2)))
+ (mod2 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* frequency 1.41)))
+ (mod3 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* frequency 2.82)))
+ (mod4 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* frequency 2.4)))
+ (car1 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> frequency))
+ (car2 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> frequency))
+ (car3 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* frequency 2.4)))
</pre>
+
set up three FM pairs, car1 and mod1 handling the basic harmonic spectra,
car2 and mod2 creating inharmonic spectra (using the square root of 2 more or less
at random), and car3 and mod3 putting a sort of formant at the minor third
(2.4 = a ratio of 12/5 = octave+6/5 = minor tenth).
-<pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
(let ((fbell '(0 1 2 1.1000 25 .7500 75 .5000 100 .5000))
(abell '(0 0 .1000 1 10 .6000 25 .3000 50 .1500 90 .1000 100 0)))
(fm-bell 0.0 2.0 220.0 .5 abell fbell 0.5)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
-<!-- main-index |fmdrum:fm-drum -->
<!-- fm-drum -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fmdrum">fm-drum</a> <code>beg dur freq amp ind (high #f) (deg 0.0) (dist 1.0) (rev-amount 0.01)</code>
-</td></tr><tr><td></td><td>
-The fm-drum uses "cascade FM" (see <a href="fm.html">fm.html</a>); it was developed by Jan Mattox.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fm-drum 0 1.5 55 .3 5 #f) (fm-drum 1.5 1.5 66 .3 4 #t))
+<pre class="indented">
+<em class=def id="fmdrum">fm-drum</em> beg dur freq amp ind (high #f) (deg 0.0) (dist 1.0) (rev-amount 0.01)
+</pre>
+
+<p>The fm-drum uses "cascade FM" (see <a href="fm.html">fm.html</a>); it was developed by Jan Mattox.
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (fm-drum 0 1.5 55 .3 5 #f) (fm-drum 1.5 1.5 66 .3 4 #t))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- fm-insect -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>fm-insect</em> <code>beg dur freq amp ampenv modfreq modskew modenv index indexenv fmindex ratio deg dist rev</code>
-</td></tr><tr><td></td><td>
-The fm-insect started as an attempt to get cicada sounds from FM (for the 5th movement of "Colony"), but
+<pre class="indented">
+<em class=emdef>fm-insect</em> beg dur freq amp ampenv modfreq modskew modenv index indexenv fmindex ratio deg dist rev
+</pre>
+
+<p>The fm-insect started as an attempt to get cicada sounds from FM (for the 5th movement of "Colony"), but
ended with:
-<pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 22050)
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:srate 22050)
(let ((locust '(0 0 40 1 95 1 100 .5))
(bug_hi '(0 1 25 .7 75 .78 100 1))
(amp '(0 0 25 1 75 .7 100 0)))
@@ -1452,22 +1580,28 @@ ended with:
(fm-insect 4.300 1.500 900.627 .09 amp 40 -20.707 locust 300.866 bug_hi .246 .500)))
</pre>
-See <a href="#animalsdoc">animals.scm</a> for much more convincing insect calls.
+<p>See <a href="#animalsdoc">animals.scm</a> for much more convincing insect calls.
+</p>
+<div class="separator"></div>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-<!-- main-index |fmtrumpet:fm-trumpet -->
<!-- fm-trumpet -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fmtrumpet">fm-trumpet</a> <code>beg dur ...</code>
-</td></tr><tr><td></td><td>
-This is Dexter Morrill's FM-trumpet; see CMJ feb 77 p51.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fm-trumpet 0 .25))
+<pre class="indented">
+<em class=def id="fmtrumpet">fm-trumpet</em> beg dur ...
</pre>
-As with many instruments from that era, it has a million parameters:
-<pre>
+
+<p>This is Dexter Morrill's FM-trumpet; see CMJ feb 77 p51.
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (fm-trumpet 0 .25))
+</pre>
+
+<p>As with many instruments from that era, it has a million parameters:
+</p>
+
+<pre class="indented">
beg dur (frq1 250.0) (frq2 1500.0) (amp1 0.5) (amp2 0.1)
(ampatt1 0.03) (ampdec1 0.35) (ampatt2 0.03) (ampdec2 0.3)
(modfrq1 250.0) (modind11 0.0) (modind12 2.66)
@@ -1478,44 +1612,50 @@ As with many instruments from that era, it has a million parameters:
(indenv1 '(0 0 25 1 75 .9 100 0)) (indenv2 '(0 0 25 1 75 .9 100 0))
(degree 0.0) (distance 1.0) (reverb-amount 0.005)
</pre>
-The pitch depends on the 'modfrq1' and 'modfrq2' parameters, as well as 'frq1' and 'frq2':
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fm-trumpet 0 1 :frq1 400 :frq2 1600 :modfrq1 400 :modfrq2 400))
+
+<p>The pitch depends on the 'modfrq1' and 'modfrq2' parameters, as well as 'frq1' and 'frq2':
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (fm-trumpet 0 1 :frq1 400 :frq2 1600 :modfrq1 400 :modfrq2 400))
</pre>
-</td></tr>
-<tr><td colspan=2 height=16></td></tr>
+<div class="separator"></div>
-<!-- fm-voice -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fmvoice">fm-voice</a> <code>beg dur ...</code>
-</td></tr><tr><td></td><td>
-This is John Chowning's FM voice instrument, used in "Phone" I think.
+<pre class="indented">
+<em class=def id="fmvoice">fm-voice</em> beg dur ...
+</pre>
+
+<p>This is John Chowning's FM voice instrument, used in "Phone" I think.
It is in jcvoi.scm, not clm-ins.scm. Its parameters are:
-<pre>
- beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3
- indxfun skewfun vibfun ranfun
- dis pcrev deg vibscl pcran skewscl ranpower glissfun glissamt
+</p>
+
+<pre class="indented">
+beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3
+indxfun skewfun vibfun ranfun
+dis pcrev deg vibscl pcran skewscl ranpower glissfun glissamt
</pre>
-Here's an example:
-<pre>
+
+<p>Here's an example:</p>
+
+<pre class="indented">
(let ((ampf '(0 0 1 1 2 1 3 0)))
(with-sound (:play #t)
- (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 1 .01 0 ampf .01)))
+ (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 .01 0 ampf .01)))
</pre>
-</td></tr>
-<tr><td colspan=2 height=16></td></tr>
+<div class="separator"></div>
+
<!-- main-index |fofins:FOF synthesis -->
<!-- fofins -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fofins">fofins</a> <code>beg dur frq amp uvib f0 a0 f1 a1 f2 a2 (amp-env '(0 0 1 1 2 1 3 0))</code>
-</td></tr>
-<tr><td></td><td>
-fofins is an implementation of <A HREF="http://www-ccrma.stanford.edu/~serafin/320/lab3/FOF_synthesis.html">FOF synthesis</A>, taken originally from
+<pre class="indented">
+<em class=def id="fofins">fofins</em> beg dur frq amp uvib f0 a0 f1 a1 f2 a2 (amp-env '(0 0 1 1 2 1 3 0))
+</pre>
+
+<p>fofins is an implementation of <A HREF="http://www-ccrma.stanford.edu/~serafin/320/lab3/FOF_synthesis.html">FOF synthesis</A>, taken originally from
fof.c of Perry Cook and the article
"Synthesis of the Singing Voice" by Bennett and Rodet in
"Current Directions in Computer Music Research" (MIT Press).
@@ -1523,8 +1663,10 @@ FOF synthesis sets up a wave with the desired spectrum (to mimic vocal formats,
then calls <a href="sndclm.html#wave-train">wave-train</a> to turn that into a tone.
fofins just adds an amplitude envelope and vibrato.
In the Scheme version, there is also an optional trailing vibrato envelope argument (this is slightly different from the CL version):
-<pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () ; slowly ramp up the vibrato
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () ; slowly ramp up the vibrato
(fofins 0 4 270 .1 0.005 730 .6 1090 .3 2440 .1
'(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0)
'(0 0 40 0 75 .2 100 1) )
@@ -1535,255 +1677,350 @@ In the Scheme version, there is also an optional trailing vibrato envelope argum
'(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0)
'(0 0 40 0 75 .2 100 1)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
-<!-- main-index |fullmix:fullmix -->
<!-- fullmix -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fullmix">fullmix</a> <code>infile beg outdur inbeg matrix srate reverb-amount</code>
-</td></tr><tr><td></td><td>
-fullmix is a complicated way to mix stuff. It's built into the CL version of CLM, so there was clamor for some sort
+<pre class="indented">
+<em class=def id="fullmix">fullmix</em> infile beg outdur inbeg matrix srate reverb-amount
+</pre>
+
+<p>fullmix is a complicated way to mix stuff. It's built into the CL version of CLM, so there was clamor for some sort
of replacement in other versions of CLM.
-fullmix provides a mixer that can handle any number
+fullmix provides a sound file mixer that can handle any number
of channels of data in and out with scalers and envelopes on any path, sampling rate conversion,
reverb — you name it!
'infile' is the file to be mixed:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fullmix "pistol.snd")) ; this places pistol.snd at time 0
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (fullmix "pistol.snd")) ; this places pistol.snd at time 0
</pre>
-'beg' is the start time of the mix in the output sound;
+
+<p>'beg' is the start time of the mix in the output sound;
'outdur' is the duration of the mixed-in portion in the output;
'inbeg' is where to start the mix in the input file:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fullmix "pistol.snd" 1.0 2.0 0.25))
- ;; start at 0.25 in pistol.snd, include next 2 secs, put at time 1.0 in output
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (fullmix "pistol.snd" 1.0 2.0 0.25))
+;; start at 0.25 in pistol.snd, include next 2 secs, put at time 1.0 in output
</pre>
-'srate' is the amount of sampling rate conversion to apply, and
+
+<p>'srate' is the amount of sampling rate conversion to apply, and
'reverb' is the amount of the signal to send to the reverberator:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb nrev) (fullmix "pistol.snd" 1.0 2.0 0.25 #f 2.0 0.1)) ; up an octave, lots of reverb!
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:reverb nrev) (fullmix "pistol.snd" 1.0 2.0 0.25 #f 2.0 0.1)) ; up an octave, lots of reverb!
</pre>
-The 'matrix' parameter is much harder to describe. It is either a number or a list of lists.
+
+<p>The 'matrix' parameter is much harder to describe. It is either a number or a list of lists.
In the first case, that number is the amplitude scaler on the output:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb nrev) (fullmix "pistol.snd" 1.0 2.0 0.25 0.2 2.0 0.1)) ; same but much softer (0.2 amp)
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:reverb nrev) (fullmix "pistol.snd" 1.0 2.0 0.25 0.2 2.0 0.1)) ; same but much softer (0.2 amp)
</pre>
-If 'matrix' is a list of lists, each element of the inner lists can be either a number or list a breakpoints (an envelope).
+
+<p>If 'matrix' is a list of lists, each element of the inner lists can be either a number or list a breakpoints (an envelope).
If a number, it is treated as an amplitude scaler for that input and output channel combination. Each inner list
represents an input channel, so if we have a stereo input file going to a stereo output file and we want
the channels to be mixed straight, but channel 0 at .5 amp and channel 1 at .75:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2) (fullmix "2a.snd" #f #f #f '((0.5 0.0) (0.0 0.75))))
- ;; ^ ^ ^ ^
- ;; | | | |
- ;; 0->0 | 1->0 |
- ;; 0->1 1->1
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:channels 2) (fullmix "2a.snd" #f #f #f '((0.5 0.0) (0.0 0.75))))
+;; ^ ^ ^ ^
+;; | | | |
+;; 0->0 | 1->0 |
+;; 0->1 1->1
</pre>
-So, 2a.snd's first channel gets mixed into the output's first channel, scaled by 0.5,
+
+<p>So, 2a.snd's first channel gets mixed into the output's first channel, scaled by 0.5,
and its second channel goes to the output second channel scaled by 0.75.
If we have four channels in and are writing a mono file, and want to mix in
only the second channel of the input:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 1) (fullmix "4.aiff" #f #f #f '((0.0) (1.0) (0.0) (0.0))))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:channels 1) (fullmix "4.aiff" #f #f #f '((0.0) (1.0) (0.0) (0.0))))
</pre>
-The next complication is that each entry in the inner lists can also be a list of
+
+<p>The next complication is that each entry in the inner lists can also be a list of
envelope breakpoints. In that case, an envelope is applied to that portion of the
mix, rather than just a scaler:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2) (fullmix "oboe.snd" #f #f #f (list (list (list 0 0 1 1 2 0) 0.5))))
- ;; mono input so one list, envelope output chan 0, scale output chan 1 (two copies of input)
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:channels 2) (fullmix "oboe.snd" #f #f #f (list (list (list 0 0 1 1 2 0) 0.5))))
+;; mono input so one list, envelope output chan 0, scale output chan 1 (two copies of input)
</pre>
-And finally(!) each inner list element can also be a CLM env generator:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2)
- (fullmix "oboe.snd" 1 2 0 (list (list .1 (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :duration 2 :scaler .5)))))
+
+<p>And finally(!) each inner list element can also be a CLM env generator:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:channels 2)
+ (fullmix "oboe.snd" 1 2 0 (list (list .1 (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 0 1 1) :duration 2 :scaler .5)))))
</pre>
-Here's a Ruby example:
-<pre>
- with_sound(:channels, 2, :statistics, true) do
- fullmix("pistol.snd")
- fullmix("oboe.snd", 1, 2, 0, [[0.1, make_env([0, 0, 1, 1], :duration, 2, :scaler, 0.5)]])
- end
+
+<p>Here's a Ruby example:
+</p>
+
+<pre class="indented">
+with_sound(:channels, 2, :statistics, true) do
+ fullmix("pistol.snd")
+ fullmix("oboe.snd", 1, 2, 0, [[0.1, make_env([0, 0, 1, 1], :duration, 2, :scaler, 0.5)]])
+end
</pre>
-"srate" can be negative (meaning read in reverse) or a list or breakpoints (an src envelope).
+
+<p>"srate" can be negative (meaning read in reverse) or a list or breakpoints (an src envelope).
Now we need filters!
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+
+<div class="separator"></div>
+
<!-- gong -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>gong</em> <code>beg dur freq amp (degree 0.0) (distance 1.0) (reverb-amount 0.005)</code>
-</td></tr><tr><td></td><td>
-gong is an FM instrument developed by Paul Weineke.
-<pre>
- Scheme: (with-sound () (gong 0 3 261.61 .3))
- Ruby: with_sound() do gong(0, 3, 261.61, 0.6) end
+<pre class="indented">
+<em class=emdef>gong</em> beg dur freq amp (degree 0.0) (distance 1.0) (reverb-amount 0.005)
+</pre>
+
+<p>gong is an FM instrument developed by Paul Weineke.
+</p>
+
+<pre class="indented">
+Scheme: (with-sound () (gong 0 3 261.61 .3))
+Ruby: with_sound() do gong(0, 3, 261.61, 0.6) end
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
<!-- gran-synth -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>gran-synth</em> <code>beg dur freq grain-dur grain-hop amp</code>
-</td></tr><tr><td></td><td>
-gran-synth sets up a <a href="sndclm.html#wave-train">wave-train</a> playing an enveloped
+<pre class="indented">
+<em class=emdef>gran-synth</em> beg dur freq grain-dur grain-hop amp
+</pre>
+
+<p>gran-synth sets up a <a href="sndclm.html#wave-train">wave-train</a> playing an enveloped
sinusoid (the "grain" in this case). 'grain-dur' sets the grain's length (in seconds),
'grain-hop' sets the frequency of the <a href="sndclm.html#wave-train">wave-train</a> generator (how quickly the grain is
repeated), and 'freq' sets the grain sinusoid's frequency.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (gran-synth 0 1 300 .0189 .03 .4)) ; grain freq 300Hz, repetition rate 33Hz
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (gran-synth 0 1 300 .0189 .03 .4)) ; grain freq 300Hz, repetition rate 33Hz
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
<!-- main-index |grapheq:graphic equalizer -->
<!-- graphEq -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="grapheq">graphEq</a> <code>file beg dur or-beg amp (amp-env '(0 1.0 0.8 1.0 1.0 0.0)) (amp-base 1.0) ...</code>
-</td></tr><tr><td></td><td>
-<A NAME="grapheqdoc">graphEq</A> is a sort of non-graphical graphical equalizer, developed by Marco Trevisani. It sets up a bank of formant
+<pre>
+<A class=def>graphEq</A> file beg dur or-beg amp (amp-env '(0 1.0 0.8 1.0 1.0 0.0)) (amp-base 1.0) ...
+</pre>
+
+<p id="grapheq">graphEq is a sort of non-graphical graphical equalizer, developed by Marco Trevisani. It sets up a bank of formant
generators with an optional envelope on each formant, then filters and envelopes the input file.
Its trailing parameters are:
-<pre>
- (offset-gain 0)
- (gain-freq-list '((0 1 1 0) 440 (0 0 1 1) 660))
- (filt-gain-scale 1)
- (filt-gain-base 1)
- (a1 .99)
- (stats #t)
-</pre>
-'a1' is the formant radius.
+</p>
+
+<pre class="indented">
+(offset-gain 0)
+(gain-freq-list '((0 1 1 0) 440 (0 0 1 1) 660))
+(filt-gain-scale 1)
+(filt-gain-base 1)
+(a1 .99)
+(stats #t)
+</pre>
+
+
+<p>'a1' is the formant radius.
'gain-freq-list' is a list of gains and frequencies to
filter
The gains can be either numbers or envelopes (one or the other, not a mixture).
'offset-gain' is an offset (addition) to all the gains.
'filt-gain-scale' and 'filt-gain-base' are similar, but apply to the envelopes, if any.
'stats' prints encouraging numbers if #t.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (graphEq "oboe.snd")) ; accept all the defaults (Scheme is case sensitive)
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (graphEq "oboe.snd")) ; accept all the defaults (Scheme is case sensitive)
</pre>
-If we want just steady bands:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (graphEq "oboe.snd" 0 0 0 1.0 '(0 1 1 0) 1.0 0 '(.1 440 .3 1500 .2 330)))
+
+
+<p>If we want just steady bands:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (graphEq "oboe.snd" 0 0 0 1.0 '(0 1 1 0) 1.0 0 '(.1 440 .3 1500 .2 330)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- hammondoid -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>hammondoid</em> <code>beg dur freq amp</code>
-</td></tr><tr><td></td><td>
-hammondoid is Perry Cook's additive-synthesis Hammond organ.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (hammondoid 0 1 440 .1))
+<pre class="indented">
+<em class=emdef>hammondoid</em> beg dur freq amp
+</pre>
+
+<p>hammondoid is Perry Cook's additive-synthesis Hammond organ.
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (hammondoid 0 1 440 .1))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- jl-reverb -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>jl-reverb</em> <code>(decay 3.0)</code>
-</td></tr><tr><td></td><td>
-jl-reverb is a cavernous version of John Chowning's ancient reverberator. You can never get enough reverb!
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb jl-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .1))
+<pre class="indented">
+<em class=emdef>jl-reverb</em> (decay 3.0)
+</pre>
+
+<p>jl-reverb is a cavernous version of John Chowning's ancient reverberator. You can never get enough reverb!
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:reverb jl-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .1))
</pre>
-'decay' is the reverb decay time tacked onto the end of the output sound.
+
+
+<p>'decay' is the reverb decay time tacked onto the end of the output sound.
To pass parameters to a reverberator, use the with-sound parameter :reverb-data. So, if we want
5 seconds of decay:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb jl-reverb :reverb-data '(5.0)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
- ;; ^ this is passed as (jl-reverb 5.0)
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:reverb jl-reverb :reverb-data '(5.0)) (fm-violin 0 .1 440 .1 :reverb-amount .1))
+;; ^ this is passed as (jl-reverb 5.0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- lbj-piano -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def NAME="lbjpiano">lbj-piano</a> <code>beg dur freq amp (pfreq frequency) (degree 45) (reverb-amount 0) (distance 1)</code>
-</td></tr><tr><td></td><td>
-lbj-piano, developed by Doug Fulton, uses James A Moorer's piano spectra and
+<pre class="indented">
+<em class=def id="lbjpiano">lbj-piano</em> beg dur freq amp (pfreq frequency) (degree 45) (reverb-amount 0) (distance 1)
+</pre>
+
+<p>lbj-piano, developed by Doug Fulton, uses James A Moorer's piano spectra and
additive synthesis to mimic a piano.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (lbj-piano 0 2 110.0 .2))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (lbj-piano 0 2 110.0 .2))
</pre>
-Doug says, "The high notes sound pretty rotten" and thinks perhaps
+
+
+<p>Doug says, "The high notes sound pretty rotten" and thinks perhaps
one major problem is the lack of mechanical noise.
'pfreq' sets which spectrum to use; it defaults to whatever matches 'freq'.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (lbj-piano 0 2 110.0 .2 :pfreq 550))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (lbj-piano 0 2 110.0 .2 :pfreq 550))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- metal -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>metal</em> <code>beg dur freq amp</code>
-</td></tr><tr><td></td><td>
-metal is another Perry Cook creation (HeavyMtl); it's an FM instrument:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (metal 0 1 440 .2))
+<pre class="indented">
+<em class=emdef>metal</em> beg dur freq amp
+</pre>
+
+<p>metal is another Perry Cook creation (HeavyMtl); it's an FM instrument:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (metal 0 1 440 .2))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
-<!-- main-index |nrev:nrev -->
<!-- nrev -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="nrev">nrev</a> <code>(reverb-factor 1.09) (lp-coeff 0.7) (volume-1 1.0)</code>
-</td></tr><tr><td></td><td>
-nrev, developed by Michael McNabb, is one of the more popular old-style reverbs.
+<pre class="indented">
+<em class=def id="nrev">nrev</em> (reverb-factor 1.09) (lp-coeff 0.7) (volume-1 1.0)
+</pre>
+
+<p>nrev, developed by Michael McNabb, is one of the more popular old-style reverbs.
It is much cleaner than jc-reverb.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb nrev) (fm-violin 0 .1 440 .1 :reverb-amount .1))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:reverb nrev) (fm-violin 0 .1 440 .1 :reverb-amount .1))
</pre>
-'reverb-factor' controls the length of the decay — it should not exceed 1.21 or so.
+
+
+<p>'reverb-factor' controls the length of the decay — it should not exceed 1.21 or so.
'lp-coeff' controls the strength of the low pass filter inserted in the feedback loop.
'volume-1' can be used to boost the reverb output.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb nrev :reverb-data '(:lp-coeff 0.9 :volume-1 2.0))
- (fm-violin 0 .1 440 .1 :reverb-amount .1))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:reverb nrev :reverb-data '(:lp-coeff 0.9 :volume-1 2.0))
+ (fm-violin 0 .1 440 .1 :reverb-amount .1))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- main-index |pins:SMS synthesis -->
<!-- pins -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="pins">pins</a> <code>beg dur file amp ...</code>
-</td></tr><tr><td></td><td>
-pins is a simple implementation of the spectral modeling synthesis
+<pre class="indented">
+<em class=def id="pins">pins</em> beg dur file amp ...
+</pre>
+
+<p>pins is a simple implementation of the spectral modeling synthesis
of Xavier Serra and Julius Smith (sometimes known as "Sansy" or "SMS"). See
Serra, X., J. O. Smith. 1990. "Spectral Modeling Synthesis:A Sound Analysis/Synthesis Based on a Deterministic plus Stochastic Decomposition". Computer Music Journal, vol. 14(4), 1990.
The idea behind SMS is similar to the phase vocoder,
but tracks spectral peaks so that its resynthesis options are much more sophisticated.
The trailing parameters are:
-<pre>
- (transposition 1.0) (time-scaler 1.0) (fft-size 256)
- (highest-bin 128) (max-peaks 16) printit attack
+</p>
+
+<pre class="indented">
+(transposition 1.0) (time-scaler 1.0) (fft-size 256)
+ (highest-bin 128) (max-peaks 16) printit attack
</pre>
-'transposition' can be used to transpose a sound;
+
+<p>'transposition' can be used to transpose a sound;
'time-scaler' changes the sound's duration;
'fft-size' may need to be larger if your sampling rate is 44100, or the input sound's
fundamental is below 300 Hz;
'highest-bin' sets how many fft bins we search for spectral peaks;
'max-peaks' sets how many peaks we track (at a maximum) through the sound;
'printit', if set to #t, causes the peak envelopes to be printied;
-'attack' is an optional vct containing the attack portion of the new sound.
-<pre>
- Scheme: (with-sound () (pins 0.0 1.0 "now.snd" 1.0 :time-scaler 2.0))
- Ruby: with_sound() do pins(0, 1, "now.snd", 1, :time_scaler, 2) end
+'attack' is an optional float-vector containing the attack portion of the new sound.
+</p>
+
+<pre class="indented">
+Scheme: (with-sound () (pins 0.0 1.0 "now.snd" 1.0 :time-scaler 2.0))
+Ruby: with_sound() do pins(0, 1, "now.snd", 1, :time_scaler, 2) end
</pre>
-Xavier has a website devoted to this system, but it seems to move; search for CLAM or SMS.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>Xavier has a website devoted to this system, but it seems to move; search for CLAM or SMS.
+</p>
+
+<div class="separator"></div>
-<!-- main-index |pluck:pluck -->
<!-- pluck -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="pluck">pluck</a> <code>beg dur freq amp (weighting .5) (lossfact .9)</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="pluck">pluck</em> beg dur freq amp (weighting .5) (lossfact .9)
+</pre>
<p>
pluck is based on
the <A HREF="http://ccrma.stanford.edu/~jos/SimpleStrings/Karplus_Strong_Algorithm.html">Karplus-Strong</A>
@@ -1798,80 +2035,105 @@ makes great use of this instrument.
anything other than .5 produces a longer decay. It should be between 0.0 and 1.0.
'lossfact' can be used to shorten decays. The most useful values are between .8 and 1.0.
</p>
-<pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
(pluck 0 1 330 .3 .95 .95)
(pluck .3 2 330 .3 .9 .9999)
(pluck .7 2 330 .3 .8 .99))
</pre>
+
<p>
In Ruby:
</p>
-<pre>
- with_sound() do pluck(0.05, 0.1, 330, 0.1, 0.95, 0.95) end
+
+<pre class="indented">
+with_sound() do pluck(0.05, 0.1, 330, 0.1, 0.95, 0.95) end
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- main-index |pqwvox:waveshaping voice -->
<!-- pqw-vox -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="pqwvox">pqw-vox</a> <code>beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes</code>
-</td></tr><tr><td></td><td>
-pqw-vox is an extension of Marc LeBrun's instrument vox (described below) to use phase-quadrature (single-sideband)
+<pre class="indented">
+<em class=def id="pqwvox">pqw-vox</em> beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes
+</pre>
+
+<p>pqw-vox is an extension of Marc LeBrun's instrument vox (described below) to use phase-quadrature (single-sideband)
waveshaping. It uses both Chebyshev polynomial kinds to set up spectra-producing pairs of waveshapers that will
add in such a way as to cancel either the upper or lower set of sidebands. These are then ganged together as in
the vox instrument to mimic moving formants.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (pqw-vox 0 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 1) .3 '(0 L 100 L) '(.5 .25 .1)
- '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5))))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (pqw-vox 0 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 1) .3 '(0 L 100 L) '(.5 .25 .1)
+ '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5))))
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (pqw-vox 0 2 200 200 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05)
- '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5)))
- (pqw-vox 2 2 200 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 UH 100 ER) '(.8 .15 .05)
- '((1 1 2 .5) (1 1 4 .1) (1 1 2 .1 4 .05)))
- (pqw-vox 4 2 100 414 .2 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 OW 50 E 100 ER) '(.8 .15 .05)
- '((1 1 2 .5 3 .1 4 .01) (1 1 4 .1) (1 1 2 .1 4 .05))))
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (pqw-vox 0 2 200 200 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05)
+ '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5)))
+ (pqw-vox 2 2 200 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 UH 100 ER) '(.8 .15 .05)
+ '((1 1 2 .5) (1 1 4 .1) (1 1 2 .1 4 .05)))
+ (pqw-vox 4 2 100 414 .2 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 OW 50 E 100 ER) '(.8 .15 .05)
+ '((1 1 2 .5 3 .1 4 .01) (1 1 4 .1) (1 1 2 .1 4 .05))))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- pqw -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def NAME="pqw">pqw</a> <code>beg dur freq spacing-freq carrier-freq amplitude ampfun indexfun partials ...</code>
-</td></tr><tr><td></td><td>
-pqw is a phase-quadrature waveshaping instrument which produces asymmetric spectra.
+<pre class="indented">
+<em class=def id="pqw">pqw</em> beg dur freq spacing-freq carrier-freq amplitude ampfun indexfun partials ...
+</pre>
+
+<p>pqw is a phase-quadrature waveshaping instrument which produces asymmetric spectra.
The trailing parameters just set the usual degree, distance, and reverb values.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (pqw 0 .5 200 1000 .2 '(0 0 25 1 100 0) '(0 1 100 0) '(2 .1 3 .3 6 .5)))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (pqw 0 .5 200 1000 .2 '(0 0 25 1 100 0) '(0 1 100 0) '(2 .1 3 .3 6 .5)))
</pre>
-To see the asymmetric spectrum most clearly, set the index function above to '(0 1 100 1).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>To see the asymmetric spectrum most clearly, set the index function above to '(0 1 100 1).
+</p>
+<div class="separator"></div>
+
<!-- resflt -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>resflt</em> <code>beg dur driver ...</code>
-</td></tr><tr><td></td><td>
-resflt, developed by Richard Karpen and Xavier Serra, sets up three resonators (two-pole filters),
+<pre class="indented">
+<em class=emdef>resflt</em> beg dur driver ...
+</pre>
+
+<p>resflt, developed by Richard Karpen and Xavier Serra, sets up three resonators (two-pole filters),
then drives them with either white noise or an <a href="sndclm.html#ncos">ncos</a> pulse train.
Both can be used for vocal effects:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (resflt 0 1.0 0 0 0 #f .1 200 230 10 '(0 0 50 1 100 0) '(0 0 100 1)
- 500 .995 .1 1000 .995 .1 2000 .995 .1)
- (resflt 1 1.0 1 10000 .01 '(0 0 50 1 100 0) 0 0 0 0 #f #f
- 500 .995 .1 1000 .995 .1 2000 .995 .1))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (resflt 0 1.0 0 0 0 #f .1 200 230 10 '(0 0 50 1 100 0) '(0 0 100 1)
+ 500 .995 .1 1000 .995 .1 2000 .995 .1)
+ (resflt 1 1.0 1 10000 .01 '(0 0 50 1 100 0) 0 0 0 0 #f #f
+ 500 .995 .1 1000 .995 .1 2000 .995 .1))
</pre>
-The trailing parameters are:
-<pre>
- ranfreq noiamp noifun cosamp cosfreq1 cosfreq0 cosnum ampcosfun freqcosfun
- frq1 r1 g1 frq2 r2 g2 frq3 r3 g3
- (degree 0.0) (distance 1.0)(reverb-amount 0.005)
+
+
+<p>The trailing parameters are:
+</p>
+
+<pre class="indented">
+ranfreq noiamp noifun cosamp cosfreq1 cosfreq0 cosnum ampcosfun freqcosfun
+frq1 r1 g1 frq2 r2 g2 frq3 r3 g3
+(degree 0.0) (distance 1.0)(reverb-amount 0.005)
</pre>
-Set 'driver' to 0 to get the pulse train, or to 1 to get white noise.
+
+
+<p>Set 'driver' to 0 to get the pulse train, or to 1 to get white noise.
In the latter case, 'ranfreq' is the random number generator frequency, 'noiamp' is its amplitude,
and 'noifun' is an amplitude envelope on its output (filter input)
In the pulse case, 'cosamp' is the pulse train amplitude, 'ampcosfun' the amplitude envelope,
@@ -1880,63 +2142,85 @@ and 'cosnum' sets the number of cosines in the pulse.
The three resonators are centered at 'frq1', 'frq2', 'frq3',
with pole-radius 'r1', 'r2', and 'r3' respectively, and
with gains of 'g1', 'g2', and 'g3'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
-<!-- main-index |reson:fm-voice -->
<!-- reson -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="reson">reson</a> <code>beg dur freq amp ...</code>
-</td></tr><tr><td></td><td>
-reson is a vocal simulator developed by John Chowning. Its trailing parameters are:
-<pre>
- numformants indxfun skewfun pcskew skewat skewdc vibfreq vibpc ranvibfreq ranvibpc
- degree distance reverb-amount data
+<pre class="indented">
+<em class=def id="reson">reson</em> beg dur freq amp ...
+</pre>
+
+<p>reson is a vocal simulator developed by John Chowning. Its trailing parameters are:
+</p>
- 'data' is a list of lists of form
- '(ampf resonfrq resonamp ampat ampdc dev0 dev1 indxat indxdc)
+<pre class="indented">
+numformants indxfun skewfun pcskew skewat skewdc vibfreq vibpc ranvibfreq ranvibpc
+degree distance reverb-amount data
+
+'data' is a list of lists of form
+ '(ampf resonfrq resonamp ampat ampdc dev0 dev1 indxat indxdc)
</pre>
-Needless to say, no one has ever written out these parameters by hand, so here's an all-time first:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (reson 0.0 1.0 440 .1 2 '(0 0 100 1) '(0 0 100 1) .1 .1 .1 5 .01 5 .01 0 1.0 0.01
- '(((0 0 100 1) 1200 .5 .1 .1 0 1.0 .1 .1) ((0 1 100 0) 2400 .5 .1 .1 0 1.0 .1 .1))))
+
+<p>Needless to say, no one has ever written out these parameters by hand, so here's an all-time first:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (reson 0.0 1.0 440 .1 2 '(0 0 100 1) '(0 0 100 1) .1 .1 .1 5 .01 5 .01 0 1.0 0.01
+ '(((0 0 100 1) 1200 .5 .1 .1 0 1.0 .1 .1) ((0 1 100 0) 2400 .5 .1 .1 0 1.0 .1 .1))))
</pre>
-But JC got very nice vocal sounds from this — I must have mistyped somewhere...
+
+
+<p>But JC got very nice vocal sounds from this — I must have mistyped somewhere...
Here's another stab at it:
-<pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
(reson 0.0 1.0 440 .1 2 '(0 1 100 0) '(0 0 100 1) .01 .1 .1 5 .01 5 .01 0 1.0 0.01
'(((0 1 100 1) 1000 .65 .1 .1 0 1.0 .1 .1) ((0 0 100 1) 2400 .15 .1 .1 0 1.0 .1 .1))))
</pre>
-If you find a good example, please send me it!
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+
+<p>If you find a good example, please send me it!
+</p>
+<div class="separator"></div>
<!-- rhodey -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>rhodey</em> <code>beg dur freq amp (base .5)</code>
-</td></tr><tr><td></td><td>
-rhodey is another of Perry Cook's instruments (an electric piano), based on a pair of FM generators.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (rhodey 0 1 440 .2))
+<pre class="indented">
+<em class=emdef>rhodey</em> beg dur freq amp (base .5)
</pre>
-One of the oscillators is set to a frequency 15 times the requested 'freq', so for higher notes, you'll need to set the srate higher:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100) (rhodey 0 1 880 .2))
+
+<p>rhodey is another of Perry Cook's instruments (an electric piano), based on a pair of FM generators.
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (rhodey 0 1 440 .2))
+</pre>
+
+<p>One of the oscillators is set to a frequency 15 times the requested 'freq', so for higher notes, you'll need to set the srate higher:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:srate 44100) (rhodey 0 1 880 .2))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- main-index |rmsgain:rms, gain, balance gens -->
<!-- rms gain balance -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="rmsgain">rms</a> <code>gen sig</code><br>
-<em class=emdef>balance</em> <code>gen sig comparison</code><br>
-<em class=emdef>gain</em> <code>gen sig rsmval</code><br>
-<em class=emdef>make-rmsgain</em> <code>(hp 10.0)</code>
-</td></tr><tr><td></td><td>
-rms, balance, and gain are an implementation of the balance generators of CLM (based
+<pre class="indented">
+<em class=def id="rmsgain">rms</em> gen sig
+<em class=emdef>balance</em> gen sig comparison
+<em class=emdef>gain</em> gen sig rsmval
+<em class=emdef>make-rmsgain</em> (hp 10.0)
+</pre>
+
+<p>rms, balance, and gain are an implementation of the balance generators of CLM (based
on CSound originals, Scheme versions originally provided by Fabio Furlanete).
This section is a paraphrase of balance.html in the CLM tarball which was
written by Sam Hiesz.
@@ -1947,57 +2231,70 @@ value; balance packages gain and rms into one function call.
make-rmsgain returns the generator used by rms, gain, and balance.
The 'hp' parameter sets the speed with which the balance process
tracks the RMS signal. An example is worth a zillion words:
+</p>
-<table border=0 cellpadding=5 hspace=10 vspace=10><tr><td><pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 3)
- (let ((rg (make-rmsgain))
- (rg1 (make-rmsgain 40))
- (rg2 (make-rmsgain 2))
- (e (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 0) :length 10000))
- (e1 (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :length 10000))
- (e2 (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1 2 0 10 0) :length 10000))
- (o (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 440.0)))
- (do ((i 0 (+ 1 i)))
- ((= i 10000))
- (let ((sig (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> e)))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (balance rg sig (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> e2)))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outb</a> i (balance rg1 sig (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> e1)))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outc</a> i (balance rg2 (* .1 (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> o)) (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> e2)))))))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+ (<a class=quiet href="#wsdoc">with-sound</a> (:channels 3)
+ (let ((rg (make-rmsgain))
+ (rg1 (make-rmsgain 40))
+ (rg2 (make-rmsgain 2))
+ (e (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 0 1 1 2 0) :length 10000))
+ (e1 (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 0 1 1) :length 10000))
+ (e2 (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 0 1 1 2 0 10 0) :length 10000))
+ (o (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> 440.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (let ((sig (<a class=quiet href="sndclm.html#env">env</a> e)))
+ (<a class=quiet href="sndclm.html#outa">outa</a> i (balance rg sig (<a class=quiet href="sndclm.html#env">env</a> e2)))
+ (<a class=quiet href="sndclm.html#outa">outb</a> i (balance rg1 sig (<a class=quiet href="sndclm.html#env">env</a> e1)))
+ (<a class=quiet href="sndclm.html#outa">outc</a> i (balance rg2 (* .1 (<a class=quiet href="sndclm.html#oscil">oscil</a> o)) (<a class=quiet href="sndclm.html#env">env</a> e2)))))))
+</pre>
+<div class="separator"></div>
<!-- scratch -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="scratch">scratch</a> <code>beg file src-ratio turnlist</code>
-</td></tr><tr><td></td><td>
-scratch moves back and forth in a sound file according to
+<pre class="indented">
+<em class=def id="scratch">scratch</em> beg file src-ratio turnlist
+</pre>
+
+<p>scratch moves back and forth in a sound file according to
a list of turn times much like <a href="#envsoundinterp">env-sound-interp</a>.
With voice input, we can create a "Remembrance of Bugs Bunny":
-<pre>
- Scheme: (with-sound () (scratch 0.0 "now.snd" 1.5 '(0.0 .5 .25 1.0)))
- Ruby: with_sound() do scratch(0, "now.snd", 1.5, [0.0, 0.5, 0.25, 1.0]) end
+</p>
+
+<pre class="indented">
+Scheme: (with-sound () (scratch 0.0 "now.snd" 1.5 '(0.0 .5 .25 1.0)))
+Ruby: with_sound() do scratch(0, "now.snd", 1.5, [0.0, 0.5, 0.25, 1.0]) end
</pre>
-I translate this as: "go forward from 0.0 to 0.5 secs, backwards to 0.25 secs, then forward to 1.0 secs".
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+
+<p>I translate this as: "go forward from 0.0 to 0.5 secs, backwards to 0.25 secs, then forward to 1.0 secs".
+</p>
+<div class="separator"></div>
<!-- main-index |spectra:additive synthesis -->
<!-- spectra -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="spectra">spectra</a> <code>beg dur freq amp ...</code>
-</td></tr><tr><td></td><td>
-spectra is an additive-synthesis instrument with vibrato and an amplitude envelope. It was intended originally
+<pre class="indented">
+<em class=def id="spectra">spectra</em> beg dur freq amp ...
+</pre>
+
+<p>spectra is an additive-synthesis instrument with vibrato and an amplitude envelope. It was intended originally
to be used with the spectra in spectra.scm (information laboriously gathered at the dawn of the computer era
by James A Moorer). One such spectrum is labelled "p-a4", so we can hear it via:
-<pre>
- (load "spectr.scm")
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (spectra 0 1 440.0 .1 p-a4 '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0)))
+</p>
+
+<pre class="indented">
+(load "spectr.scm")
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (spectra 0 1 440.0 .1 p-a4 '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0)))
</pre>
-The trailing parameters are:
-<pre>
+
+<p>The trailing parameters are:
+</p>
+
+<pre class="indented">
(partials '(1 1 2 0.5))
(amp-envelope '(0 0 50 1 100 0))
(vibrato-amplitude 0.005)
@@ -2006,44 +2303,57 @@ The trailing parameters are:
(distance 1.0)
(reverb-amount 0.005)
</pre>
-We can pass our own partials:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (spectra 0 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1)
- '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0)))
+
+
+<p>We can pass our own partials:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (spectra 0 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1)
+ '(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- ssb-fm -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="ssbfm">ssb-fm</a> gen <code>modsig</code><br>
-<em class=emdef>make-ssb-fm</em> <code>freq</code>
-</td></tr><tr><td></td><td>
-These two functions implement
+<pre class="indented">
+<em class=def id="ssbfm">ssb-fm</em> gen modsig
+<em class=emdef>make-ssb-fm</em> freq
+</pre>
+
+<p>These two functions implement
a sort of asymmetric FM using ideas similar to those used in <a href="sndclm.html#ssb-am">ssb-am</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
+
<!-- main-index |stereoflute:flute model -->
<!-- stereo-flute -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="stereoflute">stereo-flute</a> <code>beg dur freq flow ...</code>
-</td></tr><tr><td></td><td>
-This is a physical model of a flute developed by Nicky Hind.
-<pre>
- Scheme:
- (with-sound (:channels 2)
- (stereo-flute 0 1 440 0.55 :flow-envelope '(0 0 1 1 2 1 3 0))
- (stereo-flute 1 3 220 0.55 :flow-envelope '(0 0 1 1 2 1 3 0)))
+<pre class="indented">
+<em class=def id="stereoflute">stereo-flute</em> beg dur freq flow ...
+</pre>
+
+<p>This is a physical model of a flute developed by Nicky Hind.
+</p>
+
+<pre class="indented">
+Scheme:
+(with-sound (:channels 2)
+ (stereo-flute 0 1 440 0.55 :flow-envelope '(0 0 1 1 2 1 3 0))
+ (stereo-flute 1 3 220 0.55 :flow-envelope '(0 0 1 1 2 1 3 0)))
- Ruby:
- with_sound() do stereo_flute(0, 2, 440, 0.55, :flow_envelope, [0, 0, 1, 1, 2, 1, 3, 0]) end
+Ruby:
+with_sound() do stereo_flute(0, 2, 440, 0.55, :flow_envelope, [0, 0, 1, 1, 2, 1, 3, 0]) end
</pre>
-The trailing parameters are:
+<p>The trailing parameters are:
+</p>
-<pre>
+<pre class="indented">
(flow-envelope '(0 1 100 1))
(decay 0.01) ; additional time for instrument to decay
(noise 0.0356)
@@ -2058,68 +2368,95 @@ The trailing parameters are:
(ran-rate 5)
(ran-amount 0.03)
</pre>
-As with physical models in general, you may need to experiment a bit to find
+
+<p>As with physical models in general, you may need to experiment a bit to find
parameters that work.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
+
<!-- main-index |telephone:telephone -->
<!-- touch-tone -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="telephone">touch-tone</a> <code>beg number</code>
-</td></tr><tr><td></td><td>
-This instrument produces telephone tones:
-<pre>
- Scheme: (with-sound () (touch-tone 0.0 '(7 2 3 4 9 7 1)))
- Ruby: with_sound() do touch_tone(0, [7, 2, 3, 4, 9, 7, 1]) end
+<pre class="indented">
+<em class=def id="telephone">touch-tone</em> beg number
</pre>
-It is just two sine waves whose frequencies are chosen based on the number pressed.
-<pre>
+
+<p>This instrument produces telephone tones:
+</p>
+
+<pre class="indented">
+Scheme: (with-sound () (touch-tone 0.0 '(7 2 3 4 9 7 1)))
+Ruby: with_sound() do touch_tone(0, [7, 2, 3, 4, 9, 7, 1]) end
+</pre>
+
+<p>It is just two sine waves whose frequencies are chosen based on the number pressed.
+</p>
+
+<pre class="indented">
1 2 3 697 Hz
4 5 6 770 Hz
7 8 9 852 Hz
0 941 Hz
1209 1336 1477 Hz
</pre>
-For more than you really want to know about other such sounds, see
+
+
+<p>For more than you really want to know about other such sounds, see
<A HREF="http://www.tech-faq.com/telephone-tone-frequencies.shtml">Telephone Tone Frequencies</A>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
+
<!-- main-index |tubebell:tubular bell -->
<!-- tubebell -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="tubebell">tubebell</A> <code>beg dur freq amp (base 32.0)</code>
-</td></tr><tr><td></td><td>
-Perry Cook's tubular bell:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (tubebell 0 2 440 .1 32.0)
- (tubebell 2 2 220 .1 64.0)
- (tubebell 4 2 660 .1 .032))
-</pre>
-'base' is the envelope base:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (tubebell 0 2 440 .1 32.0)
- (tubebell 2 2 220 .1 2048.0)
- (tubebell 4 3 660 .1 .032))
+<pre class="indented">
+<em class=def id="tubebell">tubebell</em> beg dur freq amp (base 32.0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>Perry Cook's tubular bell:
+</p>
-<!-- main-index |twotab:spectral interpolation -->
-<!-- two-tab -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="twotab">two-tab</A> <code>beg dur freq amp ...</code>
-</td></tr><tr><td></td><td>
-two-tab interpolates between two spectra.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (two-tab 0 2 440 .1 '(1.0 1.0) '(3.0 1.0)))
- ;; go from harmonic 1 to harmonic 3
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (tubebell 0 2 440 .1 32.0)
+ (tubebell 2 2 220 .1 64.0)
+ (tubebell 4 2 660 .1 .032))
</pre>
-The trailing parameters are:
-<pre>
+
+<p>'base' is the envelope base:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (tubebell 0 2 440 .1 32.0)
+ (tubebell 2 2 220 .1 2048.0)
+ (tubebell 4 3 660 .1 .032))
+</pre>
+
+<div class="separator"></div>
+
+
+
+<!-- main-index |twotab:spectral interpolation -->
+<!-- two-tab -->
+<pre class="indented">
+<em class=def id="twotab">two-tab</em> beg dur freq amp ...
+</pre>
+
+<p>two-tab interpolates between two spectra.
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (two-tab 0 2 440 .1 '(1.0 1.0) '(3.0 1.0)))
+;; go from harmonic 1 to harmonic 3
+</pre>
+
+<p>The trailing parameters are:
+</p>
+
+<pre class="indented">
(partial-1 '(1.0 1.0 2.0 0.5))
(partial-2 '(1.0 0.0 3.0 1.0))
(amp-envelope '(0 0 50 1 100 0))
@@ -2130,24 +2467,34 @@ The trailing parameters are:
(distance 1.0)
(reverb-amount 0.005)
</pre>
-'interp-func' determines how we interpolate between the two spectra. When
+
+<p>'interp-func' determines how we interpolate between the two spectra. When
it is at 1.0, we get only the first, at 0.0 only the second.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (two-tab 0 2 440 .1 '(1.0 1.0) '(3.0 1.0) '(0 0 1 1 2 0) '(0 0 1 1)))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (two-tab 0 2 440 .1 '(1.0 1.0) '(3.0 1.0) '(0 0 1 1 2 0) '(0 0 1 1)))
</pre>
-is the reverse of the earlier sound. To go out and back:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (two-tab 0 2 440 .1 '(1.0 1.0) '(3.0 1.0) '(0 0 1 1 2 0) '(0 0 1 1 2 0)))
+
+
+<p>is the reverse of the earlier sound. To go out and back:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (two-tab 0 2 440 .1 '(1.0 1.0) '(3.0 1.0) '(0 0 1 1 2 0) '(0 0 1 1 2 0)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- main-index |fmvox:fm-talker -->
<!-- vox -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fmvox">vox</a> <code>beg dur freq amp ampfun freqfun freqscl voxfun index vibscl</code>
-</td></tr><tr><td></td><td>
-vox is a translation of Marc LeBrun's MUS10 waveshaping voice instrument
+<pre class="indented">
+<em class=def id="fmvox">vox</em> beg dur freq amp ampfun freqfun freqscl voxfun index vibscl
+</pre>
+
+<p>vox is a translation of Marc LeBrun's MUS10 waveshaping voice instrument
using FM in this case.
The basic idea is that each of the three vocal formants is created by two
sets of waveshapers (or oscils producing FM), one centered on the even multiple of the base frequency closest to the desired formant frequency,
@@ -2160,8 +2507,10 @@ down to its new center. The male-speaker formant table was provided by Robert Po
for the complete table of formants).
For details on waveshaping, see Le Brun, "Digital Waveshaping Synthesis", JAES 1979 April, vol 27, no 4, p250.
I used vox in the 5th movement of "Colony" and in "The New Music Liberation Army".
-<pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
(let ((amp-env '(0 0 25 1 75 1 100 0))
(frq-env '(0 0 5 .5 10 0 100 1)))
(vox 0 2 170 .4 amp-env frq-env .1
@@ -2172,8 +2521,10 @@ I used vox in the 5th movement of "Colony" and in "The New Music Liberation Army
'(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .15 .05) '(.05 .0125 .025) .02 .1)))
</pre>
-Or in Ruby:
-<pre>
+<p>Or in Ruby:
+</p>
+
+<pre class="indented">
with_sound() do
amp_env = [0, 0, 25, 1, 75, 1, 100, 0]
frq_env = [0, 0, 5, 0.5, 10, 0, 100, 1]
@@ -2188,44 +2539,53 @@ end
<p>vox can also be use for less vocal effects:
</p>
-<pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:play #t :scaled-to .5)
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:play #t :scaled-to .5)
(vox 0 .25 500 .4 '(0 0 .1 1 1 1 2 .5 3 .25 10 0) '(0 0 5 .5 10 0 100 1) .1
'(0 E 25 OW 35 ER 105 ER) '(.13 .15 .15) '(.005 .005 .015) .05 .1))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
<!-- wurley -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>wurley</em> <code>beg dur freq amp</code>
-</td></tr><tr><td></td><td>
-Perry Cook's Wurlitzer (I assume).
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (wurley 0 1 440 .1))
+<pre class="indented">
+<em class=emdef>wurley</em> beg dur freq amp
+</pre>
+
+<p>Perry Cook's Wurlitzer (I assume).
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (wurley 0 1 440 .1))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="separator"></div>
+
<!-- za, zc, zn -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>za</em> <code>time dur freq amp length1 length2 feedback feedforward</code><br>
-<em class=emdef>zc</em> <code>time dur freq amp length1 length2 feedback</code><br>
-<em class=emdef>zn</em> <code>time dur freq amp length1 length2 feedforward</code>
-</td></tr><tr><td></td><td>
-The "z" instruments demonstrate "zdelay" effects — interpolating
+<pre class="indented">
+<em class=emdef>za</em> time dur freq amp length1 length2 feedback feedforward
+<em class=emdef>zc</em> time dur freq amp length1 length2 feedback
+<em class=emdef>zn</em> time dur freq amp length1 length2 feedforward
+</pre>
+
+<p>The "z" instruments demonstrate "zdelay" effects — interpolating
<a href="sndclm.html#comb">comb</a>, <a href="sndclm.html#notch">notch</a>, and <a href="sndclm.html#all-pass">all-pass</a> filters.
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (zn 0 1 100 .1 20 100 .995)
- (zn 1.5 1 100 .1 100 20 .995)
- (zc 3 1 100 .1 20 100 .95)
- (zc 4.5 1 100 .1 100 20 .95)
- (za 6 1 100 .1 20 100 .95 .95)
- (za 7.5 1 100 .1 100 20 .95 .95))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (zn 0 1 100 .1 20 100 .995)
+ (zn 1.5 1 100 .1 100 20 .995)
+ (zc 3 1 100 .1 20 100 .95)
+ (zc 4.5 1 100 .1 100 20 .95)
+ (za 6 1 100 .1 20 100 .95 .95)
+ (za 7.5 1 100 .1 100 20 .95 .95))
</pre>
-</td></tr>
-</table>
+<div class="separator"></div>
<p>snd-test.scm has examples of calling all these instruments. For more examples of instruments,
there are a variety of separate files such as v.scm, and
@@ -2234,24 +2594,18 @@ the CLM test instruments. It also has some comments about
the differences between the CL and Scheme instruments.
</p>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="#birddoc" onmouseout="UnTip()" onmouseover="Tip('bird and bigbird')">bird</a> <a href="sndclm.html#sndclmtop" onmouseout="UnTip()" onmouseover="Tip('many examples')">clm</a> <a href="#dlocsigdoc" onmouseout="UnTip()" onmouseover="Tip('moving sounds')">dlocsig</a> <a href="#exampdoc" onmouseout="UnTip()" onmouseover="Tip('sound effects')">examp</a> <a href="#fadedoc" onmouseout="UnTip()" onmouseover="Tip('frequency domain cross fade')">fade</a> <a href="fm.html#fmintro" onmouseout="UnTip()" onmouseover="Tip('FM examples')">fm</a> <a href="#vdoc" onmouseout="UnTip()" onmouseover="Tip('realtime fm-violin controls')">fmv</a> <a href="#freeverbdoc" onmouseout="UnTip()" onmouseover="Tip('a reverberator')">freeverb</a> <a href="#grapheqdoc" onmouseout="UnTip()" onmouseover="Tip('graphic equalizer')">graphEq</a> <a href="#granidoc" onmouseout="UnTip()" onmouseover="Tip('granular synthesis')">grani</a> <a href="#jcrevdoc" onmouseout="UnTip()" onmouseover="Tip('an old reverberator')">jcrev</a> <a href="#maracadoc" onmouseout="UnTip()" onmouseover="Tip('maraca physical models')">maraca</a>
- <a href="#maxfdoc" onmouseout="UnTip()" onmouseover="Tip('a resonator')">maxf</a> <a href="#noisedoc" onmouseout="UnTip()" onmouseover="Tip('noise-maker')">noise</a> <a href="#pianodoc" onmouseout="UnTip()" onmouseover="Tip('piano physical model')">piano</a> <a href="#prc95doc" onmouseout="UnTip()" onmouseover="Tip('several physical models')">prc95</a> <a href="#pvocdoc" onmouseout="UnTip()" onmouseover="Tip('phase-vocoder')">pvoc</a> <a href="#singerdoc" onmouseout="UnTip()" onmouseover="Tip('singer physical model')">singer</a> <a href="#sndwarpdoc" onmouseout="UnTip()" onmouseover="Tip('sound effect')">sndwarp</a> <a href="#stochasticdoc" onmouseout="UnTip()" onmouseover="Tip('dynamic stochastic synthesis')">stochastic</a> <a href="#straddoc" onmouseout="UnTip()" onmouseover="Tip('violin physical model')">strad</a> <a href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip('with-sound')">ws</a>
-</pre>
-</td></tr></table>
+<div class="seealso">
+see also: <a href="#birddoc">bird</a> <a href="sndclm.html#sndclmtop">clm</a> <a href="#dlocsigdoc">dlocsig</a> <a href="#exampdoc">examp</a> <a href="#fadedoc">fade</a> <a href="fm.html#fmintro">fm</a> <a href="#vdoc">fmv</a> <a href="#freeverbdoc">freeverb</a> <a href="#grapheq">graphEq</a> <a href="#granidoc">grani</a> <a href="#jcrevdoc">jcrev</a> <a href="#maracadoc">maraca</a>
+ <a href="#maxfdoc">maxf</a> <a href="#noisedoc">noise</a> <a href="#pianodoc">piano</a> <a href="#prc95doc">prc95</a> <a href="#pvocdoc">pvoc</a> <a href="#singerdoc">singer</a> <a href="#sndwarpdoc">sndwarp</a> <a href="#stochasticdoc">stochastic</a> <a href="#straddoc">strad</a> <a href="#wsdoc">ws</a>
+</div>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: dlocsig ---------------------------------------- -->
+<!-- FILE: dlocsig -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="dlocsigdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>dlocsig</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="dlocsigdoc">dlocsig</div>
-<p><a name="dlocsig">dlocsig</a> is a CLM generator developed by Fernando Lopez-Lezcano that can move sounds in two or three dimensions.
+<p id="dlocsig">dlocsig is a CLM generator developed by Fernando Lopez-Lezcano that can move sounds in two or three dimensions.
Fernando's CLM/lisp-oriented documentation can be found in
dlocsig.html.
dlocsig.rb is Michael Scholz's translation of dlocsig to Ruby.
@@ -2262,109 +2616,115 @@ currently selected sound. Click "Gnuplot" to get a pretty picture of the path (
An instrument that uses dlocsig is:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define* (sinewave start-time duration freq amp (amp-env '(0 1 1 1))
(path (make-path :path '(-10 10 0 5 10 10))))
(let* ((vals (<em class=red>make-dlocsig</em> :start-time start-time :duration duration :path path))
(dloc (car vals))
(beg (cadr vals))
(end (caddr vals)))
- (let* ((osc (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> freq))
- (aenv (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> amp-env :scaler amp :duration duration)))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (<em class=red>dlocsig</em> dloc i (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> aenv) (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc))))))))
+ (let ((osc (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> freq))
+ (aenv (<a class=quiet href="sndclm.html#make-env">make-env</a> amp-env :scaler amp :duration duration)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (<em class=red>dlocsig</em> dloc i (* (<a class=quiet href="sndclm.html#env">env</a> aenv) (<a class=quiet href="sndclm.html#oscil">oscil</a> osc)))))))
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2) (sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
+(<a class=quiet href="#wsdoc">with-sound</a> (:channels 2) (sinewave 0 1.0 440 .5 :path (make-path '((-10 10) (0.5 0.5) (10 10)) :3d #f)))
</pre>
-</td></tr></table>
-<br><br>
-<!-- ---------------------------------------- FILE: draw ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="drawdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>draw</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: draw -->
+
+<div class="header" id="drawdoc">draw</div>
<p>draw.scm has examples of graphics-oriented extensions.
</p>
-<table border=0 hspace=20 cellspacing=4 cellpadding=6>
+<div class="spacer"></div>
<!-- color-samples -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>color-samples</em> <code>color beg dur snd chn</code><br>
-<em class=emdef>uncolor-samples</em> <code>snd chn</code>
-</td></tr><tr><td width=30></td><td>
+<pre class="indented">
+<em class=emdef>color-samples</em> color beg dur snd chn
+<em class=emdef>uncolor-samples</em> snd chn
+</pre>
+
+<p>
color-samples displays the samples from sample 'beg' for 'dur' samples in 'color'
whenever they're in the current time domain view. uncolor-samples cancels this action.
To activate this, add it to <a href="extsnd.html#aftergraphhook">after-graph-hook</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- display-previous-edits -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>display-previous-edits</em> <code>snd chn</code>
-</td></tr><tr><td width=30></td><td>
+<pre class="indented">
+<em class=emdef>display-previous-edits</em> snd chn
+</pre>
+
+<p>
display-previous-edits displays all the edits of the current sound, with older edits gradually fading away.
To activate this, add it to <a href="extsnd.html#aftergraphhook">after-graph-hook</a>:
-<pre>
- (hook-push <a class=quiet href="extsnd.html#aftergraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftergraphhook_tip)">after-graph-hook</a> display-previous-edits)
+</p>
+
+<pre class="indented">
+(hook-push <a class=quiet href="extsnd.html#aftergraphhook">after-graph-hook</a> display-previous-edits)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- overlay-rms-env -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="overlayrmsenv">overlay-rms-env</a> <code>snd chn</code>
-</td></tr><tr><td width=30></td><td>
-overlay-rms-env displays the running rms value of the currently displayed data in red, overlayed upon the
+<pre class="indented">
+<em class=def id="overlayrmsenv">overlay-rms-env</em> snd chn
+</pre>
+
+<p>overlay-rms-env displays the running rms value of the currently displayed data in red, overlayed upon the
normal graph. To activate it, add it to the <a href="extsnd.html#aftergraphhook">after-graph-hook</a>:
-<pre>
- (hook-push <a class=quiet href="extsnd.html#aftergraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftergraphhook_tip)">after-graph-hook</a> overlay-rms-env)
+</p>
+
+<pre class="indented">
+(hook-push <a class=quiet href="extsnd.html#aftergraphhook">after-graph-hook</a> overlay-rms-env)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- overlay-sounds -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>overlay-sounds</em> <code>:rest sounds</code>
-</td></tr><tr><td width=30></td><td>
-overlay-sounds overlays onto its first argument (a sound) all subsequent arguments: <code>(overlay-sounds 1 0 3)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>overlay-sounds</em> :rest sounds
+</pre>
+
+<p>overlay-sounds overlays onto its first argument (a sound) all subsequent arguments: (overlay-sounds 1 0 3).
+</p>
+
+<div class="spacer"></div>
<!-- samples-via-colormap -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>samples-via-colormap</em> <code>snd chn</code>
-</td></tr><tr><td width=30></td><td>
-<table border=0><tr>
-<td>
-samples-via-colormap displays the time domain graph using the current colormap (it is really just an example of
+<pre class="indented">
+<em class=emdef>samples-via-colormap</em> snd chn
+</pre>
+
+<p>samples-via-colormap displays the time domain graph using the current colormap (it is really just an example of
<a href="extsnd.html#colormapref">colormap-ref</a>).
To activate this, add it to <a href="extsnd.html#aftergraphhook">after-graph-hook</a>:
-<pre>
- (hook-push <a class=quiet href="extsnd.html#aftergraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftergraphhook_tip)">after-graph-hook</a> samples-via-colormap)
+</p>
+
+<pre class="indented">
+(hook-push <a class=quiet href="extsnd.html#aftergraphhook">after-graph-hook</a> samples-via-colormap)
</pre>
-</td><td>
-<img src="pix/samplesviacolormap.png" alt="samples-via-colormap" hspace=10>
-</td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-</table>
+<img class="indented" src="pix/samplesviacolormap.png" alt="samples-via-colormap">
-<br><br>
-<!-- ---------------------------------------- FILE: dsp ---------------------------------------- -->
+<!-- FILE: dsp -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="dspdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>dsp</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="dspdoc">dsp</div>
<p>dsp.scm is a DSP grabbag, mostly filters. There are more than 100 functions to describe here, so
an alphabetical list is just a jumble of names. Instead, I've tried to divide them into several vague
@@ -2377,7 +2737,8 @@ categories:
and <a href="#dspdocscanned">scanned synthesis</a>.
</p>
-<p><small><blockquote>If you're new to DSP, I recommend Lyons' "Understanding Digital Signal Processing" and Steiglitz, "A
+
+<div class="inset"><p>If you're new to DSP, I recommend Lyons' "Understanding Digital Signal Processing" and Steiglitz, "A
Digital Signal Processing Primer";
there are many good books
on advanced calculus — I especially liked Hildebrand, "Advanced Calculus for Applications", but it may
@@ -2387,488 +2748,582 @@ introduction; also Halmos, "Linear Algebra Problem Book"; the most enjoyable
Fourier Analysis book is by Körner, but you don't want to start with it.
For the ambitious, there is the encyclopedic set of books by Julius Smith.
His "Mathematics of the DFT" and "Introduction to Digital Filters" are very clear.
-</blockquote></small></p>
-<br>
+</p></div>
+
+
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
-<!-- ---------------------------------------- dsp FFT ---------------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="dspdocfft">FFTs</A></center></td><td></td></tr>
+<!-- dsp FFT -->
+
+<div class="innerheader" id="dspdocfft">FFTs</div>
+
<!-- main-index |dht:Hartley transform -->
<!-- dht -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="dht">dht</a> <code>data</code>
-</td></tr><tr><td width=30></td><td>
-dht is the slow form of the Hartley transform,
+<pre class="indented">
+<em class=def id="dht">dht</em> data
+</pre>
+
+<p>dht is the slow form of the Hartley transform,
taken from Perry Cook's SignalProcessor.m.
The Hartley transform is a kind of Fourier transform.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- display-bark-fft -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="displaybarkfft">display-bark-fft</a> <code>off color1 color2 color3</code><br>
+<pre class="indented">
+<em class=def id="displaybarkfft">display-bark-fft</em> off color1 color2 color3
<em class=emdef>undisplay-bark-fft</em>
-</td></tr><tr><td></td><td>
-display-bark-fft shows the current spectrum in the "lisp" graph in three
+</pre>
+
+<p>display-bark-fft shows the current spectrum in the "lisp" graph in three
different frequency scales: bark, mel, and erb, each in a different color.
The default ticks follow the bark scale; click anywhere in the lisp graph
to switch to a different tick scale choice. undisplay-bark-fft turns this
graph off. Here we've used rgb.scm for some color names:
-<pre>
- (display-bark-fft #f sea-green orange alice-blue)
- (set! (<a class=quiet href="extsnd.html#selectedgraphcolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectedgraphcolor_tip)">selected-graph-color</a>) gray30)
- (set! (<a class=quiet href="extsnd.html#selecteddatacolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_selecteddatacolor_tip)">selected-data-color</a>) light-green)
+</p>
+
+<pre class="indented">
+(display-bark-fft #f sea-green orange alice-blue)
+(set! (<a class=quiet href="extsnd.html#selectedgraphcolor">selected-graph-color</a>) gray30)
+(set! (<a class=quiet href="extsnd.html#selecteddatacolor">selected-data-color</a>) light-green)
</pre>
-<img src="pix/bark.png" alt="bark display" vspace=10>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<img class="indented" src="pix/bark.png" alt="bark display">
+<div class="spacer"></div>
+
<!-- dolph -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="dolph">dolph</a> <code>n gamma</code>
-</td></tr><tr><td></td><td>
-dolph is the Dolph-Chebyshev fft data window, taken
+<pre class="indented">
+<em class=def id="dolph">dolph</em> n gamma
+</pre>
+
+<p>dolph is the Dolph-Chebyshev fft data window, taken
from Richard Lyons, "Understanding DSP". The C version used by Snd/CLM is in clm.c.
Another version of the same function,
taken (with a few minor changes) from Julius Smith's "Spectral Audio", is named dolph-1.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- down-oct and stretch-sound-via-dft -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="downoct">down-oct</a> <code>n snd chn</code><br>
-<A class=def NAME="stretchsoundviadft">stretch-sound-via-dft</a> <code>factor snd chn</code>
-</td></tr><tr><td></td><td>
-down-oct
+<pre class="indented">
+<em class=def id="downoct">down-oct</em> n snd chn
+<em class=def id="stretchsoundviadft">stretch-sound-via-dft</em> factor snd chn
+</pre>
+
+<p>down-oct
tries to move a sound down by a factor of n (assumed to be a power of 2, 1 = no change) by goofing with the fft data,
then inverse ffting.
I think this is "stretch" in DSP jargon; to interpolate in the time domain we're squeezing the frequency domain.
The power-of-2 limitation is based on the underlying fft function's insistence on power-of-2 data sizes.
A more general version of this is stretch-sound-via-dft, but it's
extremely slow.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- goertzel and find-sine -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="goertzel">goertzel</a> <code>freq beg dur snd</code><br>
-<em class=emdef>find-sine</em> <code>freq beg dur snd</code>
-</td></tr><tr><td></td><td>
-goertzel and find-sine find the amplitude of a single component of a spectrum ('freq').
-<pre>
- :<em class=typing>(find-sine 550.0 0.0 (frames))</em>
- <em class=listener>(0.00116420908413177 0.834196665512423)</em> ; car is amplitude, cadr is phase in radians
- :<em class=typing>(* (goertzel 550.0 0.0 (frames)) (/ 2.0 (frames)))</em>
- <em class=listener>0.00116630805062827</em>
+<pre class="indented">
+<em class=def id="goertzel">goertzel</em> freq beg dur snd
+<em class=emdef>find-sine</em> freq beg dur snd
+</pre>
+
+<p>goertzel and find-sine find the amplitude of a single component of a spectrum ('freq').
+</p>
+
+<pre class="indented">
+> (find-sine 550.0 0.0 (framples))
+(0.00116420908413177 0.834196665512423) ; car is amplitude, cadr is phase in radians
+> (* (goertzel 550.0 0.0 (framples)) (/ 2.0 (framples)))
+0.00116630805062827
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- periodogram -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>periodogram</em> <code>N</code>
-</td></tr><tr><td></td><td>
-periodogram (the "Bartlett" version, I think) runs over an entire file, piling up 'N' sized junks of data,
+<pre class="indented">
+<em class=emdef>periodogram</em> N
+</pre>
+
+<p>periodogram (the "Bartlett" version, I think) runs over an entire file, piling up 'N' sized chunks of data,
then displays the results in the "lisp graph" area; this needs a lot of work to be useful!
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- scentroid -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="scentroid">scentroid</a> <code>file (beg 0.0) dur (db-floor -40.0) (rfreq 100.0) (fftsize 4096)</code>
-</td></tr><tr><td></td><td>
-scentroid is Brett Battey's CLM scentroid instrument, translated to Snd/Scheme.
+<pre class="indented">
+<em class=def id="scentroid">scentroid</em> file (beg 0.0) dur (db-floor -40.0) (rfreq 100.0) (fftsize 4096)
+</pre>
+<p>scentroid is Brett Battey's CLM scentroid instrument, translated to Snd/Scheme.
To paraphrase Brett:
-scentroid returns (in a vct) the continuous spectral centroid envelope of a sound.
+scentroid returns (in a float-vector) the continuous spectral centroid envelope of a sound.
The spectral centroid is the "center of gravity" of the spectrum, and it
has a rough correlation to our sense of "brightness" of a sound.
-'db-floor' sets a lower limit on which frames are included in the analysis.
+'db-floor' sets a lower limit on which framples are included in the analysis.
'rfreq' sets the number of measurements per second.
'fftsize' sets the fft window size (a power of 2).
See also the <a href="sndclm.html#moving-scentroid">moving-scentroid</a> generator in generators.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- spot-freq -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="spotfreq">spot-freq</a> <code>samp snd chn</code>
-</td></tr><tr><td></td><td>
-spot-freq is a first-pass at using autocorrelation for
+<pre class="indented">
+<em class=def id="spotfreq">spot-freq</em> samp snd chn
+</pre>
+
+<p>spot-freq is a first-pass at using autocorrelation for
pitch tracking; it's easily fooled, but could probably be made relatively robust.
-<pre>
- :<em class=typing>(spot-freq 10000)</em> ; this is oboe.snd, in about .5 secs
- <em class=listener>555.262096862931</em> ; 555Hz is correct(!)
+</p>
+
+<pre class="indented">
+> (spot-freq 10000) ; this is oboe.snd, in about .5 secs
+555.262096862931 ; 555Hz is correct(!)
</pre>
-In the next example, we add spot-freq to the <a href="extsnd.html#mouseclickhook">mouse-click-hook</a> (in Ruby),
+
+<p>In the next example, we add spot-freq to the <a href="extsnd.html#mouseclickhook">mouse-click-hook</a> (in Ruby),
so that each time we click somewhere in the graph, the pitch at that point is reported:
-<pre>
- $mouse_click_hook.add_hook!("examp-cursor-hook") do |snd, chn, button, state, x, y, axis|
- if axis == Time_graph
- report_in_minibuffer(format("(freq: %.3f)", spot_freq(cursor(snd, chn))))
- end
- end
+</p>
+
+<pre class="indented">
+$mouse_click_hook.add_hook!("examp-cursor-hook") do |snd, chn, button, state, x, y, axis|
+ if axis == Time_graph
+ status_report(format("(freq: %.3f)", spot_freq(cursor(snd, chn))))
+ end
+end
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- rotate-phase and zero-phase -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>rotate-phase</em> <code>func snd chn</code><br>
-<A class=def NAME="zerophase">zero-phase</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-These are fft phase manipulators taken from the phazor package of Scott McNab.
+<pre class="indented">
+<em class=emdef>rotate-phase</em> func snd chn
+<em class=def id="zerophase">zero-phase</em> snd chn
+</pre>
+
+<p>These are fft phase manipulators taken from the phazor package of Scott McNab.
zero-phase takes ffts, sets all phases to 0.0, then unffts. rotate-phase
is similar, but applies 'func' to the phases.
-<pre>
- (rotate-phase (lambda (x) 0.0)) ; same as (zero-phase)
- (rotate-phase (lambda (x) (random 3.1415))) ; randomizes phases
- (rotate-phase (lambda (x) x)) ; returns original
- (rotate-phase (lambda (x) (- x))) ; reverses original
+</p>
+
+<pre class="indented">
+(rotate-phase (lambda (x) 0.0)) ; same as (zero-phase)
+(rotate-phase (lambda (x) (random 3.1415))) ; randomizes phases
+(rotate-phase (lambda (x) x)) ; returns original
+(rotate-phase (lambda (x) (- x))) ; reverses original
</pre>
-or in Ruby:
-<pre>
- rotate_phase(lambda {|x| random(PI) }) # randomizes phases
+
+<p>or in Ruby:
+</p>
+
+<pre class="indented">
+rotate_phase(lambda {|x| random(PI) }) # randomizes phases
</pre>
-and Forth:
-<pre>
- lambda: <{ x }> pi random ; #f #f rotate-phase \ randomizes phases
+
+<p>and Forth:
+</p>
+
+<pre class="indented">
+lambda: <{ x }> pi random ; #f #f rotate-phase \ randomizes phases
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- z-transform and fractional-fourier-transform -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="ztransform">z-transform</a> <code>rl size z</code><br>
-<a class=def name="fractionalfouriertransform">fractional-fourier-transform</a> <code>rl im size angle</code>
-</td></tr><tr><td></td><td>
-z-transform performs a z-transform returning a vector (to accommodate complex results):
-<pre>
- :<em class=typing>(define d0 (make-vct 8))</em>
- <em class=listener>#<unspecified></em>
- ;; and similarly for d1 and d2 ...
- :<em class=typing>(set! (d0 2) 1.0)</em>
- <em class=listener>1.0</em>
- :<em class=typing>(set! (d1 2) 1.0)</em>
- <em class=listener>1.0</em>
- :<em class=typing>(z-transform d0 8 (exp (make-rectangular 0.0 (* .25 pi))))</em>
- ;; Ruby: z_transform(d0, 8, exp(Complex(0.0, (2.0 / 8) * PI)))
- <em class=listener>#(1.0 0.0+1.0i -1.0 0.0-1.0i 1.0 0.0+1.0i -1.0 0.0-1.0i)</em>
- :<em class=typing>(mus-fft d1 d2 8)</em>
- <em class=listener>#<vct[len=8]: 1.000 0.000 -1.000 -0.000 1.000 0.000 -1.000 -0.000></em>
- :<em class=typing>d2</em>
- <em class=listener>#<vct[len=8]: 0.000 1.000 0.000 -1.000 0.000 1.000 0.000 -1.000></em>
-</pre>
-which is a complicated way of showing that if 'z' is e^2*pi*i/n, you get a fourier transform.
+<pre class="indented">
+<em class=def id="ztransform">z-transform</em> rl size z
+<em class=def id="fractionalfouriertransform">fractional-fourier-transform</em> rl im size angle
+</pre>
+
+<p>z-transform performs a z-transform returning a vector (to accommodate complex results):
+</p>
+
+<pre class="indented">
+> (define d0 (make-float-vector 8 0.0))
+d0
+;; and similarly for d1 and d2 ...
+> (set! (d0 2) 1.0)
+1.0
+> (set! (d1 2) 1.0)
+1.0
+> (z-transform d0 8 (exp (make-rectangular 0.0 (* .25 pi))))
+;; Ruby: z_transform(d0, 8, exp(Complex(0.0, (2.0 / 8) * PI)))
+#(1.0 0.0+1.0i -1.0 0.0-1.0i 1.0 0.0+1.0i -1.0 0.0-1.0i)
+> (mus-fft d1 d2 8)
+#(1.0 0.0 -1.0 -0.0 1.0 0.0 -1.0 -0.0)
+> d2
+#(0.0 1.0 0.0 -1.0 0.0 1.0 0.0 -1.0)
+</pre>
+
+<p>which is a complicated way of showing that if 'z' is e^2*pi*i/n, you get a fourier transform.
fractional-fourier-transform is the slow (DFT) version
of the fractional Fourier Transform. If 'angle' is 1.0, you get a fourier transform.
-</td></tr><tr><td colspan=2 height=32></td></tr>
+</p>
+
-<!-- ---------------------------------------- dsp FIR ---------------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="dspdocfir">FIR filters</A></center></td><td></td></tr>
+
+<!-- dsp FIR -->
+
+<div class="innerheader" id="dspdocfir">FIR filters</div>
<!-- FIR filters -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makehighpass">make-highpass</a> <code>fc length</code>, <em class=emdef>highpass</em> <code>f in</code><br>
-<a class=def name="makelowpass">make-lowpass</a> <code>fc length</code>, <em class=emdef>lowpass</em> <code>f in</code><br>
-<a class=def name="makebandpass">make-bandpass</a> <code>flo fhi length</code>, <em class=emdef>bandpass</em> <code>f in</code><br>
-<a class=def name="makebandstop">make-bandstop</a> <code>flo fhi length</code>, <em class=emdef>bandstop</em> <code>f in</code><br>
-<a class=def name="makedifferentiator">make-differentiator</a> <code>length</code>, <em class=emdef>differentiator</em> <code>f in</code><br>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="makehighpass">make-highpass</em> fc length, <em class=emdef>highpass</em> f in
+<em class=def id="makelowpass">make-lowpass</em> fc length, <em class=emdef>lowpass</em> f in
+<em class=def id="makebandpass">make-bandpass</em> flo fhi length, <em class=emdef>bandpass</em> f in
+<em class=def id="makebandstop">make-bandstop</em> flo fhi length, <em class=emdef>bandstop</em> f in
+<em class=def id="makedifferentiator">make-differentiator</em> length, <em class=emdef>differentiator</em> f in
+</pre>
-make-lowpass and lowpass provide FIR low pass filtering, and similarly for the other four choices.
+<p>make-lowpass and lowpass provide FIR low pass filtering, and similarly for the other four choices.
The order chosen is twice the 'length'; 'fc', 'flo', and 'fhi' are
the edge frequencies in terms of srate = 2 * pi.
-<pre>
- (let ((hp (make-bandpass (* .1 pi) (* .2 pi))))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y)
- (bandpass hp y))))
+</p>
+
+<pre class="indented">
+(let ((hp (make-bandpass (* .1 pi) (* .2 pi))))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y)
+ (bandpass hp y))))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- hilbert-transform -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makehilberttransform">make-hilbert-transform</a> <code>length</code><br>
-<a class=def name="hilberttransform">hilbert-transform</a> <code>f in</code><br>
-<em class=emdef>hilbert-transform-via-fft</em> <code>snd chn</code><br>
-<a class=def name="soundtoamp_env">sound->amp-env</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-These functions perform the hilbert transform using either an FIR filter (the first two) or an FFT.
+<pre class="indented">
+<em class=def id="makehilberttransform">make-hilbert-transform</em> length
+<em class=def id="hilberttransform">hilbert-transform</em> f in
+<em class=emdef>hilbert-transform-via-fft</em> snd chn
+<em class=def id="soundtoamp_env">sound->amp-env</em> snd chn
+</pre>
+
+<p>These functions perform the hilbert transform using either an FIR filter (the first two) or an FFT.
One example of its use is sound->amp-env (from R Lyons). Another is the <a href="sndclm.html#ssb-am">ssb-am</a> generator in CLM.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- invert-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="invertfilter">invert-filter</a> <code>coeffs</code>
-</td></tr><tr><td></td><td>
-invert-filter inverts an FIR filter.
+<pre class="indented">
+<em class=def id="invertfilter">invert-filter</em> coeffs
+</pre>
+
+<p>invert-filter inverts an FIR filter.
Say we previously filtered a sound via
-<pre>
- (<a class=quiet href="extsnd.html#filterchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_filterchannel_tip)">filter-channel</a> (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> .5 .25 .125))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#filterchannel">filter-channel</a> (float-vector .5 .25 .125))
</pre>
-and our mouse is broken so we can't use the Undo menu, and we've forgotten that
-we could type <code>(undo)</code>. Nothing daunted, we use:
-<pre>
- (<a class=quiet href="extsnd.html#filterchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_filterchannel_tip)">filter-channel</a> (invert-filter (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> .5 .25 .125)))
+
+<p>and our mouse is broken so we can't use the Undo menu, and we've forgotten that
+we could type (undo). Nothing daunted, we use:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#filterchannel">filter-channel</a> (invert-filter (float-vector .5 .25 .125)))
</pre>
-There are a million gotchas here. The primary one is that the inverse filter
+
+<p>There are a million gotchas here. The primary one is that the inverse filter
can "explode" — the coefficients can grow without bound. For example, any
filter returned by <a href="#spectrumtocoeffs">spectrum->coeffs</a> will be problematic.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- make-spencer-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="makespencerfilter">make-spencer-filter</a>
-</td></tr><tr><td></td><td>
-This returns a CLM <a href="sndclm.html#fir-filter">fir-filter</a> generator with the standard "Spencer Filter" coefficients.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="makespencerfilter">make-spencer-filter</em>
+</pre>
+
+<p>This returns a CLM <a href="sndclm.html#fir-filter">fir-filter</a> generator with the standard "Spencer Filter" coefficients.
+</p>
+<div class="spacer"></div>
<!-- notch -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="notchsound">notch-sound</a> <code>freqs order s c width</code><br>
-<a class=def name="notchchannel">notch-channel</a> <code>freqs order beg dur s c e trunc width</code><br>
-<a class=def name="notchselection">notch-selection</a> <code>freqs order width</code>
-</td></tr><tr><td></td><td>
-notch-channel, notch-selection, and notch-sound are aimed at noise reduction.
+<pre class="indented">
+<em class=def id="notchsound">notch-sound</em> freqs order s c width
+<em class=def id="notchchannel">notch-channel</em> freqs order beg dur s c e trunc width
+<em class=def id="notchselection">notch-selection</em> freqs order width
+</pre>
+
+<p>notch-channel, notch-selection, and notch-sound are aimed at noise reduction.
Each takes a list of frequencies (in Hz), and an optional filter order, and
notches out each frequency. The sharpness of the notch is settable
explicitly via the 'width' argument, and implicitly via the
filter 'order'. A common application cancels 60 Hz hum:
-<pre>
- (notch-channel (let ((freqs '()))
- (do ((i 60 (+ i 60)))
- ((= i 3000))
- (set! freqs (cons i freqs))) (reverse freqs)))
+</p>
+
+<pre class="indented">
+(notch-channel (let ((freqs ()))
+ (do ((i 60 (+ i 60)))
+ ((= i 3000))
+ (set! freqs (cons i freqs))) (reverse freqs)))
</pre>
-Here we've built a list of multiples of 60 and passed it to notch-channel. Its default notch
+
+<p>Here we've built a list of multiples of 60 and passed it to notch-channel. Its default notch
width is 2 Hz, and its default order tries to maintain that width given the channel's sampling rate,
so the default filter order can be very high (65536). The filtering is normally done via
convolution (by CLM's convolve generator), so a high filter order is not a big deal. In ideal
cases, this can reduce the hum and its harmonics by about 90%.
But, if the hum is not absolutely stable, you'll probably want wider notches:
-<pre>
- (notch-channel (let ((freqs '()))
- (do ((i 60 (+ i 60)))
- ((= i 3000))
- (set! freqs (cons i freqs))) (reverse freqs)) 1024)
+</p>
+
+<pre class="indented">
+(notch-channel (let ((freqs ()))
+ (do ((i 60 (+ i 60)))
+ ((= i 3000))
+ (set! freqs (cons i freqs))) (reverse freqs)) 1024)
</pre>
-The order of 1024 means we get 20 Hz width minima (44100 Hz srate), so this
+
+<p>The order of 1024 means we get 20 Hz width minima (44100 Hz srate), so this
notches out much bigger chunks of the spectrum. You get 98% cancellation, but
also lose more of the original signal.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- savitzky-golay-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>make-savitzky-golay-filter</em> <code>size (order 2)</code><br>
-<a class=def name="sgfilter">savitzky-golay-filter</a> <code>f in</code>
-</td></tr><tr><td></td><td>
-This the Savitzky-Golay filter, assuming symmetrical positioning. It is an FIR smoothing filter;
+<pre class="indented">
+<em class=emdef>make-savitzky-golay-filter</em> size (order 2)
+<em class=def id="sgfilter">savitzky-golay-filter</em> f in
+</pre>
+
+<p>This the Savitzky-Golay filter, assuming symmetrical positioning. It is an FIR smoothing filter;
perhaps it could be useful in noise reduction.
+</p>
-<pre>
- (define (unnoise order)
- (let ((flt (make-savitzky-golay-filter order 2)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (savitzky-golay-filter flt y)))))
+<pre class="indented">
+(define (unnoise order)
+ (let ((flt (make-savitzky-golay-filter order 2)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y) (savitzky-golay-filter flt y)))))
</pre>
-This filter uses <a href="#mixer-solve">mixer-solve</a> from mixer.scm, so you need
-to load that file as well as dsp.scm.
+<p>
For more info on this filter, See "Numerical Recipes in C".
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- spectrum->coeffs and fltit -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="spectrumtocoeffs">spectrum->coeffs</a> <code>order spectrum</code><br>
-<em class=emdef>fltit-1</em> <code>order spectr</code>
-</td></tr><tr><td></td><td>
-spectrum->coeffs is a
+<pre class="indented">
+<em class=def id="spectrumtocoeffs">spectrum->coeffs</em> order spectrum
+<em class=emdef>fltit-1</em> order spectr
+</pre>
+
+<p>spectrum->coeffs is a
version of Snd's very simple spectrum->coefficients procedure ("frequency sampling").
-It returns the FIR filter coefficients given the filter 'order' and desired 'spectrum' (a vct).
+It returns the FIR filter coefficients given the filter 'order' and desired 'spectrum' (a float-vector).
An example of its use is fltit-1.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (fltit-1 10 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 1.0 0 0 0 0 0 0 1.0 0)))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (fltit-1 10 (float-vector 0 1.0 0 0 0 0 0 0 1.0 0)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- volterra-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>make-volterra-filter</em> <code>acoeffs bcoeffs</code><br>
-<a class=def name="volterrafilter">volterra-filter</a> <code>flt x</code>
-</td></tr><tr><td></td><td>
-volterra-filter and
+<pre class="indented">
+<em class=emdef>make-volterra-filter</em> acoeffs bcoeffs
+<em class=def id="volterrafilter">volterra-filter</em> flt x
+</pre>
+
+<p>volterra-filter and
make-volterra-filter implement one form
of a common non-linear FIR filter.
This version is taken from Monson Hayes "Statistical DSP and Modeling";
it is a slight specialization of the form mentioned by J O Smith and others.
The 'acoeffs' apply to the linear terms, and the 'bcoeffs' to the quadratic.
-<pre>
- (let ((flt (make-volterra-filter (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> .5 .1) (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> .3 .2 .1))))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (x) (volterra-filter flt x))))
+</p>
+
+<pre class="indented">
+(let ((flt (make-volterra-filter (float-vector .5 .1) (float-vector .3 .2 .1))))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (x) (volterra-filter flt x))))
</pre>
-</td></tr><tr><td colspan=2 height=32></td></tr>
-<!-- ---------------------------------------- dsp IIR ---------------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="dspdociir">IIR filters</A></center></td><td></td></tr>
+
+<!-- dsp IIR -->
+<div class="innerheader" id="dspdociir">IIR filters</div>
<!-- make-biquad -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makebiquad">make-biquad</a> <code>a0 a1 a2 b1 b2</code>
-</td></tr><tr><td></td><td>
-make-biquad is a wrapper for <a href="sndclm.html#make-filter">make-filter</a>
+<pre class="indented">
+<em class=def id="makebiquad">make-biquad</em> a0 a1 a2 b1 b2
+</pre>
+
+<p>make-biquad is a wrapper for <a href="sndclm.html#make-filter">make-filter</a>
to return a biquad filter section.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- cascade->canonical -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="cascadetocanonical">cascade->canonical</a> <code>coeffs</code>
-</td></tr><tr><td></td><td>
-cascade->canonical
+<pre class="indented">
+<em class=def id="cascadetocanonical">cascade->canonical</em> coeffs
+</pre>
+
+<p>cascade->canonical
converts cascade coefficients to canonical form (the form used by CLM's <a href="sndclm.html#filter">filter</a> generator).
-'coeffs' is a list of filter coefficients; the function returns a vct, ready for
+'coeffs' is a list of filter coefficients; the function returns a float-vector, ready for
<a href="sndclm.html#make-filter">make-filter</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- kalman-filter-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="kalmanfilterchannel">kalman-filter-channel</a> <code>(Q 1.0e-5)</code>
-</td></tr><tr><td></td><td>
-This is an experimental function aimed at noise reduction using a Kalman filter.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="kalmanfilterchannel">kalman-filter-channel</em> (Q 1.0e-5)
+</pre>
+
+<p>This is an experimental function aimed at noise reduction using a Kalman filter.
+</p>
+<div class="spacer"></div>
<!-- make-butter* -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A NAME="makebutter"></A>
-<em class=emdef>make-butter-high-pass</em> <code>fq</code>, <em class=emdef>make-butter-hp</em> <code>M fc</code><br>
-<em class=emdef>make-butter-low-pass</em> <code>fq</code>, <em class=emdef>make-butter-lp</em> <code>M fc</code><br>
-<em class=emdef>make-butter-band-pass</em> <code>fq bw</code>, <em class=emdef>make-butter-bp</em> <code>M f1 f2</code><br>
-<em class=emdef>make-butter-band-reject</em> <code>fq bw</code>, <em class=emdef>make-butter-bs</em> <code>M f1 f2</code>
-</td></tr><tr><td></td><td>
-These functions produce Butterworth filters, returning a CLM <a href="sndclm.html#filter">filter</a> generator.
+<pre class="indented">
+<em class=emdef id="makebutter">make-butter-high-pass</em> fq, <em class=emdef>make-butter-hp</em> M fc
+<em class=emdef>make-butter-low-pass</em> fq, <em class=emdef>make-butter-lp</em> M fc
+<em class=emdef>make-butter-band-pass</em> fq bw, <em class=emdef>make-butter-bp</em> M f1 f2
+<em class=emdef>make-butter-band-reject</em> fq bw, <em class=emdef>make-butter-bs</em> M f1 f2
+</pre>
+
+<p>These functions produce Butterworth filters, returning a CLM <a href="sndclm.html#filter">filter</a> generator.
The first named ones (make-butter-high-pass et al) are taken from Sam Heisz's CLM version
of Paris Smaragdis's Csound version of Charles Dodge's code from "Computer Music: synthesis, composition, and performance".
The second set (make-butter-lp et al) provide arbitrary order Butterworths.
'M' * 2 is the filter order, 'f1' and 'f2' are the band edges in Hz.
-<pre>
- (<a class=quiet href="extsnd.html#clmchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_clmchannel_tip)">clm-channel</a> (make-butter-bp 3 1000 2000))
- (<a class=quiet href="extsnd.html#filtersound" onmouseout="UnTip()" onmouseover="Tip(extsnd_filtersound_tip)">filter-sound</a> (make-butter-low-pass 500.0))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#clmchannel">clm-channel</a> (make-butter-bp 3 1000 2000))
+(<a class=quiet href="extsnd.html#filtersound">filter-sound</a> (make-butter-low-pass 500.0))
</pre>
-See also the notch filter in new-effects.scm, and of course <a href="#analogfilterdoc">analog-filter.scm</a>: the latter renders this section obsolete.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>See also the notch filter in new-effects.scm, and of course <a href="#analogfilterdoc">analog-filter.scm</a>: the latter renders this section obsolete.
+</p>
+<div class="spacer"></div>
-<A NAME="IIRfilters"></A>
<!-- IIR filters -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>make-iir-high-pass-2</em> <code>fc din</code><br>
-<em class=emdef>make-iir-low-pass-2</em> <code>fc din</code><br>
-<em class=emdef>make-iir-band-pass-2</em> <code>f1 f2</code><br>
-<em class=emdef>make-iir-band-stop-2</em> <code>f1 f2</code><br>
-<em class=emdef>make-eliminate-hum </em> <code>(hum-freq 60.0) (hum-harmonics 5) (bandwidth 10)</code><br>
-<em class=emdef>eliminate-hum</em> <code>gen x0</code><br>
-<em class=emdef>make-peaking-2</em> <code>f1 f2 m</code>
-</td></tr><tr><td></td><td>
-More IIR filters. Except for make-peaking-2, each function returns a CLM <a href="sndclm.html#filter">filter</a> generator.
-<pre>
- (let ((hummer (make-eliminate-hum)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (x) (eliminate-hum hummer x))))
+<pre class="indented">
+<em class=emdef id="IIRfilters">make-iir-high-pass-2</em> fc din
+<em class=emdef>make-iir-low-pass-2</em> fc din
+<em class=emdef>make-iir-band-pass-2</em> f1 f2
+<em class=emdef>make-iir-band-stop-2</em> f1 f2
+<em class=emdef>make-eliminate-hum </em> (hum-freq 60.0) (hum-harmonics 5) (bandwidth 10)
+<em class=emdef>make-peaking-2</em> f1 f2 m
+</pre>
+
+<p>More IIR filters.
+</p>
+
+<pre class="indented">
+(map-channel (make-eliminate-hum))
</pre>
-make-peaking (a bandpass filter) returns a function suitable for map-channel (it takes one argument, the current sample,
+
+<p>make-peaking (a bandpass filter) returns a function suitable for map-channel (it takes one argument, the current sample,
and returns a sample):
-<pre>
- (let ((peaker (make-peaking-2 500 1000 1.0)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> peaker))
+</p>
+
+<pre class="indented">
+(let ((peaker (make-peaking-2 500 1000 1.0)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> peaker))
</pre>
-In this case 'm' is the gain in the pass band.
+
+<p>In this case 'm' is the gain in the pass band.
Use the functions in <a href="#analogfilterdoc">analog-filter.scm</a>, rather than this group.
-</td></tr><tr><td colspan=2 height=32></td></tr>
+</p>
-<!-- ---------------------------------------- dsp generators ---------------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="dspdocgens">synthesis</A></center></td><td></td></tr>
-<tr><td colspan=2>
-Most of this section has been moved to generators.scm.
-</td></tr>
-<tr><td colspan=2 height=32></td></tr>
+<!-- dsp generators -->
+<div class="innerheader" id="dspdocgens">synthesis</div>
<!-- cheby-hka -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="chebyhka">cheby-hka</a> <code>k a coeffs</code>
-</td></tr><tr><td></td><td>
-This returns the amplitude of the kth harmonic (0=DC) in the waveshaping output
+<pre class="indented">
+<em class=def id="chebyhka">cheby-hka</em> k a coeffs
+</pre>
+
+<p>This returns the amplitude of the kth harmonic (0=DC) in the waveshaping output
given the index 'a', and harmonic coefficients 'coeffs' (the 0th element is DC amplitude).
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (let ((gen (<a class=quiet href="sndclm.html#make-polyshape" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_polyshape_tip)">make-polyshape</a> 1000.0 :partials (list 1 .5 2 .25 3 .125 4 .125))))
- (do ((i 0 (+ 1 i)))
- ((= i 88200))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* .5 (<a class=quiet href="sndclm.html#polyshape" onmouseout="UnTip()" onmouseover="Tip(sndclm_polyshape_tip)">polyshape</a> gen 0.25))))))
+</p>
- (<em class=red>cheby-hka</em> 1 0.25 (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 .5 .25 .125 .125)) ; returns 1st partial (fundamental) amplitude
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (let ((gen (<a class=quiet href="sndclm.html#make-polyshape">make-polyshape</a> 1000.0 :partials (list 1 .5 2 .25 3 .125 4 .125))))
+ (do ((i 0 (+ i 1)))
+ ((= i 88200))
+ (<a class=quiet href="sndclm.html#outa">outa</a> i (* .5 (<a class=quiet href="sndclm.html#polyshape">polyshape</a> gen 0.25))))))
+(<em class=red>cheby-hka</em> 1 0.25 (float-vector 0 .5 .25 .125 .125)) ; returns first partial (fundamental) amplitude
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- flatten-partials -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="flattenpartials">flatten-partials</a> <code>partials (tries 32)</code>
-</td></tr><tr><td></td><td>
-flatten-partials takes a list or vct of partial numbers and amplitudes, as passed to <a href="sndclm.html#make-polywave">make-polywave</a>,
+<pre class="indented">
+<em class=def id="flattenpartials">flatten-partials</em> partials (tries 32)
+</pre>
+
+<p>flatten-partials takes a list or float-vector of partial numbers and amplitudes, as passed to <a href="sndclm.html#make-polywave">make-polywave</a>,
and tries to find an equivalent set of amplitudes that produces a less spikey waveform. The difference is primarily one of loudness until
you have a lot of partials.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- fm-parallel-component -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fmparallelcomponent">fm-parallel-component</a> <code>freq-we-want wc wms inds ns bs using-sine</code><br>
-<em class=emdef>fm-cascade-component</em> <code>freq-we-want wc wm1 a wm2 b</code><br>
-<em class=emdef>fm-complex-component</em> <code>freq-we-want wc wm a b interp sine</code> ; "sine" arg currently ignored
+<pre class="indented">
+<em class=def id="fmparallelcomponent">fm-parallel-component</em> freq-we-want wc wms inds ns bs using-sine
+<em class=emdef>fm-cascade-component</em> freq-we-want wc wm1 a wm2 b
+<em class=emdef>fm-complex-component</em> freq-we-want wc wm a b interp sine ; "sine" arg currently ignored
+</pre>
-</td></tr><tr><td></td><td>
-This returns the amplitude of "freq-we-want" in parallel (complex) FM, where
+<p>This returns the amplitude of "freq-we-want" in parallel (complex) FM, where
"wc" is the carrier, "wms" is a list of modulator frequencies, "inds" is a list of the
corresponding indices, "ns" and "bs" are null (used internally), and using-sine is #t if
the modulators are set up to produce a spectrum of sines, as opposed to cosines (we
need to know whether to add or subtract the components that foldunder 0.0).
-<pre>
- (fm-parallel-component 200 2000.0 (list 2000.0 200.0) (list 0.5 1.0) '() '() #t)
-</pre>
+</p>
+
+<pre class="indented">
+(fm-parallel-component 200 2000.0 (list 2000.0 200.0) (list 0.5 1.0) () () #t)
+</pre>
-To get the same information for FM with a complex index, use fm-compex-component:
-<code>(fm-compex-component 1200 1000 100 1.0 3.0 0.0 #f)</code>.
+<p>To get the same information for FM with a complex index, use fm-compex-component:
+(fm-compex-component 1200 1000 100 1.0 3.0 0.0 #f).
For cascade FM (two levels only), use fm-cascade-component.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- ssb-bank -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="ssbbank">ssb-bank</a> <code>old-freq new-freq pairs-1 (order 40) (bw 50.0) (beg 0) dur snd chn edpos</code><br>
-<a class=def name="ssbbankenv">ssb-bank-env</a> <code>old-freq new-freq freq-env pairs-1 (order 40) (bw 50.0) (beg 0) dur snd chn edpos</code><br>
-<em class=emdef>shift-channel-pitch</em> <code>freq (order 40) (beg 0) dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-The
+<pre class="indented">
+<em class=def id="ssbbank">ssb-bank</em> old-freq new-freq pairs-1 (order 40) (bw 50.0) (beg 0) dur snd chn edpos
+<em class=def id="ssbbankenv">ssb-bank-env</em> old-freq new-freq freq-env pairs-1 (order 40) (bw 50.0) (beg 0) dur snd chn edpos
+<em class=emdef>shift-channel-pitch</em> freq (order 40) (beg 0) dur snd chn edpos
+</pre>
+
+<p>The
ssb-bank functions provide single-sideband amplitude modulation, and pitch/time changes
based on the <a href="sndclm.html#ssb-am">ssb-am</a> generator.
If you run ssb-am on some input signal, the signal is shifted in pitch by
@@ -2880,346 +3335,395 @@ the ssb-am generators do the pitch
shift, and the filters pick out successive harmonics,
so each harmonic gets shifted individually (i.e. harmonic relations are maintained despite the pitch shift).
For an oboe at 557 Hz, good values are:
-<code>(ssb-bank 557 new-freq 6 40 50)</code>.
+(ssb-bank 557 new-freq 6 40 50).
For a person talking at ca. 150 Hz:
-<code>(ssb-bank 150 300 30 100 30)</code> or
-<code>(ssb-bank 150 100 40 100 20)</code>.
+(ssb-bank 150 300 30 100 30) or
+(ssb-bank 150 100 40 100 20).
To get a duration change without a pitch change, use this function
followed by sampling rate conversion back to the original pitch:
-<pre>
- (define (stretch-oboe factor)
- (ssb-bank 557 (* factor 557) 7 40 40)
- (<a class=quiet href="extsnd.html#srcsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_srcsound_tip)">src-sound</a> (/ 1.0 factor)))
+</p>
+
+<pre class="indented">
+(define (stretch-oboe factor)
+ (ssb-bank 557 (* factor 557) 7 40 40)
+ (<a class=quiet href="extsnd.html#srcsound">src-sound</a> (/ 1.0 factor)))
</pre>
-ssb-bank-env is the same as ssb-bank, but includes a frequency envelope:
-<code>(ssb-bank-env 557 880 '(0 0 1 100.0) 7)</code>.
+
+<p>ssb-bank-env is the same as ssb-bank, but includes a frequency envelope:
+(ssb-bank-env 557 880 '(0 0 1 100.0) 7).
shift-channel-pitch applies an <a href="sndclm.html#ssb-am">ssb-am</a> generator to a sound's channel (this
is a variant of amplitude modulation).
'freq' and 'order' are the corresponding arguments to <a href="sndclm.html#make-ssb-am">make-ssb-am</a>.
There is a dialog that runs ssb-bank in snd-motif.scm: create-ssb-dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- any-random -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="anyrandom">any-random</a> <code>e</code><br>
-<a class=def name="gaussiandistribution">gaussian-distribution</a> <code>s</code><br>
-<em class=emdef>pareto-distribution</em> <code>a</code><br>
-<em class=emdef>gaussian-envelope</em> <code>s</code>
-</td></tr><tr><td></td><td>
-any-random provides the same output as <a href="sndclm.html#rand">rand</a> if the latter's
+<pre class="indented">
+<em class=def id="anyrandom">any-random</em> e
+<em class=def id="gaussiandistribution">gaussian-distribution</em> s
+<em class=emdef>pareto-distribution</em> a
+<em class=emdef>gaussian-envelope</em> s
+</pre>
+
+<p>any-random provides the same output as <a href="sndclm.html#rand">rand</a> if the latter's
envelope (distribution function) argument is used, but using a slightly different method
to generate the numbers.
gaussian-envelope makes a gaussian distribution envelope suitable for rand.
Also included is inverse-integrate, a version of
CLM's distribution-to-weighting function.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (any-random 1.0 '(0 1 1 1)))) ; uniform distribution
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (any-random 1.0 '(0 0 0.95 0.1 1 1)))) ; mostly toward 1.0
- (let ((g (gaussian-distribution 1.0))) (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (any-random 1.0 g))))
- (let ((g (pareto-distribution 1.0))) (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (any-random 1.0 g))))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y) (any-random 1.0 '(0 1 1 1)))) ; uniform distribution
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y) (any-random 1.0 '(0 0 0.95 0.1 1 1)))) ; mostly toward 1.0
+(let ((g (gaussian-distribution 1.0))) (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y) (any-random 1.0 g))))
+(let ((g (pareto-distribution 1.0))) (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y) (any-random 1.0 g))))
</pre>
-In Ruby:
-<pre>
- map_channel(lambda do |y| any_random(1.0, [0, 1, 1, 1])) # uniform distribution
- map_channel(lambda do |y| any_random(1.0, [0, 0, 0.95, 0.1, 1, 1])) # mostly toward 1.0
- let(gaussian-distribution(1.0)) do |g| map_channel(lambda do |y| any_random(1.0, g)) end
- let(pareto-distribution(1.0)) do |g| map_channel(lambda do |y| any_random(1.0, g)) end
+
+<p>In Ruby:
+</p>
+
+<pre class="indented">
+map_channel(lambda do |y| any_random(1.0, [0, 1, 1, 1])) # uniform distribution
+map_channel(lambda do |y| any_random(1.0, [0, 0, 0.95, 0.1, 1, 1])) # mostly toward 1.0
+let(gaussian-distribution(1.0)) do |g| map_channel(lambda do |y| any_random(1.0, g)) end
+let(pareto-distribution(1.0)) do |g| map_channel(lambda do |y| any_random(1.0, g)) end
</pre>
-<!-- INDEX allrandomnumbers:Random Numbers --><a name="allrandomnumbers"></a>
-<TABLE border=3 bordercolor="tan" hspace=20 vspace=10><tr><td>
-<blockquote><small>
-<br>
-Random Numbers in Snd/CLM:<br>
+
+
+
+<!-- INDEX allrandomnumbers:Random Numbers -->
+
+<TABLE class="method">
+<tr><td class="methodtitle">Random Numbers in Snd/CLM</td></tr>
+<tr><td>
+<blockquote id="allrandomnumbers"><small>
generators, arbitrary distributions, fractals, 1/f: <a href="sndclm.html#randdoc">rand and rand-interp</a><br>
dithering: <a href="#ditherchannel">dither-channel</a>, <a href="#dithersound">dither-sound</a><br>
noise-making instrument: <a href="#noisedoc">noise.scm, noise.rb</a><br>
physical modeling of noisy instruments: <a href="#maracadoc">maraca.scm, maraca.rb</a><br>
arbitrary distribution via rejection method: <a href="#anyrandom">any-random</a><br>
-CL: random, *random-state*, make-random-state*: random number between 0 and arg, arg can't be 0!<br>
+s7: random, random-state: random number between 0 and arg<br>
Ruby: kernel_rand (alias for Ruby's rand), srand: random integer between 0 and arg, or float between 0 and 1<br>
<a href="sndclm.html#mus-random">mus-random, mus_random</a>: random float between -arg and arg<br>
mus-rand-seed (settable)<br>
bounded brownian noise: <a href="sndclm.html#green-noise">green-noise</a><br>
-brown and pink noise: <a href="sndclm.html#brown-noise">brown-noise</a><br>
-<br>
+brown and pink noise: <a href="sndclm.html#brown-noise">brown-noise</a>
</small></blockquote>
</td></tr></TABLE>
-</td></tr><tr><td colspan=2 height=32></td></tr>
-<!-- ---------------------------------------- dsp effects ---------------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="dspdoceffects">effects</A></center></td><td></td></tr>
+<!-- dsp effects -->
+<div class="innerheader" id="dspdoceffects">effects</div>
<!-- adsat, freqdiv -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>adsat</em> <code>size beg dur snd chn</code><br>
-<em class=emdef>freqdiv</em> <code>n snd chn</code>
-</td></tr><tr><td></td><td>
-These two functions come from a package of effects developed by sed_sed at my-dejanews.com.
+<pre class="indented">
+<em class=emdef>adsat</em> size beg dur snd chn
+<em class=emdef>freqdiv</em> n snd chn
+</pre>
+
+<p>These two functions come from a package of effects developed by sed_sed at my-dejanews.com.
adsat is "adaptive saturation", and freqdiv is "frequency division".
-<code>(freqdiv n)</code> repeats each nth sample 'n' times, clobbering the intermediate samples: <code>(freqdiv 8)</code>.
+(freqdiv n) repeats each nth sample 'n' times, clobbering the intermediate samples: (freqdiv 8).
It turns your sound into a bunch of square waves.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- brighten-slightly -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>brighten-slightly</em> <code>amount snd chn</code>
-</td></tr><tr><td></td><td>
-brighten-slightly is a slight simplification of <a href="sndclm.html#contrast-enhancement">contrast-enhancement</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>brighten-slightly</em> amount snd chn
+</pre>
+
+<p>brighten-slightly is a slight simplification of <a href="sndclm.html#contrast-enhancement">contrast-enhancement</a>.
+</p>
+
+<div class="spacer"></div>
<!-- chordalize -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="chordalize">chordalize</a>
-</td></tr><tr><td></td><td>
-chordalize uses harmonically-related comb-filters to bring out a chord in a sound.
-The comb filters are controled by <code>chordalize-amount</code> (the default is .95),
-<code>chordalize-base</code> (the default is 100 Hz), and <code>chordalize-chord</code>
-(the default is <code>(list 1 3/4 5/4)</code>). chordalize returns a function suitable
+<pre class="indented">
+<em class=def id="chordalize">chordalize</em>
+</pre>
+
+<p>chordalize uses harmonically-related comb-filters to bring out a chord in a sound.
+The comb filters are controled by chordalize-amount (the default is .95),
+chordalize-base (the default is 100 Hz), and chordalize-chord
+(the default is (list 1 3/4 5/4)). chordalize returns a function suitable
for map-channel:
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (chordalize))
+</p>
+
+<pre class="indented">
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (chordalize))
</pre>
-chordalize seems to work best with vocal sounds.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>chordalize seems to work best with vocal sounds.
+</p>
+<div class="spacer"></div>
<!-- chorus -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def NAME="chorus">chorus</a>
-</td></tr><tr><td></td><td>
-chorus tries to produce the chorus sound effect, but it needs work.
+<pre class="indented">
+<em class=def id="chorus">chorus</em>
+</pre>
+
+<p>chorus tries to produce the chorus sound effect, but it needs work.
It is controlled by the following variables:
-<pre>
- chorus-size (5) ; number of flangers
- chorus-time (.05) ; scales delay line length (flanger)
- chorus-amount (20.0) ; amp of <a href="sndclm.html#rand-interp">rand-interp</a> (flanger)
- chorus-speed (10.0) ; freq of rand-interp (flanger)
+</p>
+
+<pre class="indented">
+chorus-size (5) ; number of flangers
+chorus-time (.05) ; scales delay line length (flanger)
+chorus-amount (20.0) ; amp of <a href="sndclm.html#rand-interp">rand-interp</a> (flanger)
+chorus-speed (10.0) ; freq of rand-interp (flanger)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- harmonicizer -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="harmonicizer">harmonicizer</a> <code>freq coeffs pairs (order 40) (bw 50.0) (beg 0) dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-harmonicizer splits a sound into separate sinusoids, then splits each resultant harmonic
+<pre class="indented">
+<em class=def id="harmonicizer">harmonicizer</em> freq coeffs pairs (order 40) (bw 50.0) (beg 0) dur snd chn edpos
+</pre>
+
+<p>harmonicizer splits a sound into separate sinusoids, then splits each resultant harmonic
into a set of harmonics, then reassembles the sound. The basic idea is very similar to
<a href="#ssbbank">ssb-bank</a>, but harmonicizer splits harmonics, rather than pitch-shifting them.
The result can be a brighter or richer sound.
-<pre>
- (harmonicizer 550.0 (list 1 .5 2 .3 3 .2) 10)
+</p>
+
+<pre class="indented">
+(harmonicizer 550.0 (list 1 .5 2 .3 3 .2) 10)
</pre>
-'coeffs' is a list of harmonic-number and amplitude pairs, describing the spectrum
+
+<p>'coeffs' is a list of harmonic-number and amplitude pairs, describing the spectrum
produced by each harmonic. 'pairs' controls how many bands are used to split the original sound.
'order' is the bandpass filter's order in each such pair, and 'bw' controls its bandwidth.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- lpc-coeffs -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="lpccoeffs">lpc-coeffs</a> <code>data n m</code>
-</td></tr><tr><td></td><td>
-lpc-coeffs returns 'm' LPC coeffients (in a vector) given 'n' data points in the vct 'data'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="lpccoeffs">lpc-coeffs</em> data n m
+</pre>
+
+<p>lpc-coeffs returns 'm' LPC coeffients (in a vector) given 'n' data points in the float-vector 'data'.
+</p>
+<div class="spacer"></div>
<!-- lpc-predict -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="lpcpredict">lpc-predict</a> <code>data n coeffs m nf clipped</code>
-</td></tr><tr><td></td><td>
-lpc-predict takes the output of lpc-coeffs ('coeffs') and the length thereof ('m'),
-'n' data points 'data', and produces 'nf' new data points (in a vct) as its prediction.
+<pre class="indented">
+<em class=def id="lpcpredict">lpc-predict</em> data n coeffs m nf clipped
+</pre>
+
+<p>lpc-predict takes the output of lpc-coeffs ('coeffs') and the length thereof ('m'),
+'n' data points 'data', and produces 'nf' new data points (in a float-vector) as its prediction.
If 'clipped' is #t, the new data is assumed to be outside -1.0 to 1.0.
-<pre>
- :<em class=typing>(lpc-predict (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 0 1 2 3 4 5 6 7) 8 4) 4 2)</em>
- <em class=listener>#<vct[len=2]: 7.906 8.557></em>
+</p>
+
+<pre class="indented">
+> (lpc-predict (float-vector 0 1 2 3 4 5 6 7) 8 (lpc-coeffs (float-vector 0 1 2 3 4 5 6 7) 8 4) 4 2)
+#(7.906 8.557)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- spike -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>spike</em> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-spike returns a product (rather than the more usual sum) of succesive samples, with the current sample's sign;
+<pre class="indented">
+<em class=emdef>spike</em> snd chn
+</pre>
+
+<p>spike returns a product (rather than the more usual sum) of succesive samples, with the current sample's sign;
this normally produces a more spikey output.
The more successive samples we include in the product, the more we
limit the output to pulses placed at (just after) wave peaks.
In spike's case, just three samples are multiplied.
See also the <a href="#volterrafilter">volterra filter</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- unclip-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="unclipchannel">unclip-channel</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-unclip-channel tries to reconstruct clipped portions of a sound by using LPC to predict (backwards and forwards)
+<pre class="indented">
+<em class=def id="unclipchannel">unclip-channel</em> snd chn
+</pre>
+
+<p>unclip-channel tries to reconstruct clipped portions of a sound by using LPC to predict (backwards and forwards)
the lost samples.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- unclip-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>unclip-sound</em> <code>snd</code>
-</td></tr><tr><td></td><td>
-unclip-sound calls unclip-channel on each channel in the sound 'snd'.
-</td></tr><tr><td colspan=2 height=32></td></tr>
+<pre class="indented">
+<em class=emdef>unclip-sound</em> snd
+</pre>
+<p>unclip-sound calls unclip-channel on each channel in the sound 'snd'.
+</p>
-<!-- ---------------------------------------- dsp src ---------------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="dspdocsrc">sampling rate conversion</A></center></td><td></td></tr>
+<!-- dsp src -->
+<div class="innerheader" id="dspdocsrc">sampling rate conversion</div>
<!-- linear-src-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="linearsrcchannel">linear-src-channel</a> <code>srinc snd chn</code>
-</td></tr><tr><td></td><td>
-linear-src-channel performs sampling rate conversion using linear interpolation;
+<pre class="indented">
+<em class=def id="linearsrcchannel">linear-src-channel</em> srinc snd chn
+</pre>
+
+<p>linear-src-channel performs sampling rate conversion using linear interpolation;
this can sometimes be a nice effect.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- src-duration -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="srcduration">src-duration</a> <code>env</code>
-</td></tr><tr><td></td><td>
-src-duration
+<pre class="indented">
+<em class=def id="srcduration">src-duration</em> env
+</pre>
+
+<p>src-duration
takes an envelope representing the
input (src change) to <a href="sndclm.html#src">src</a>, and returns the resultant sound
length.
-<pre>
- (src-duration '(0 1 1 2)) ; -> 0.693147180559945
+</p>
+
+<pre class="indented">
+(src-duration '(0 1 1 2)) ; -> 0.693147180559945
</pre>
-which means that if the original sound was 2 seconds long, and we apply the envelope <code>'(0 1 1 2)</code>
+
+<p>which means that if the original sound was 2 seconds long, and we apply the envelope '(0 1 1 2)
(via <a href="extsnd.html#srcchannel">src-channel</a>, for example) to that sound, the result will be
.693 * 2 seconds long. To scale an src envelope to return a given duration, see src-fit-envelope below.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- src-fit-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="srcfitenvelope">src-fit-envelope</a> <code>env target-dur</code>
-</td></tr><tr><td></td><td>
-src-fit-envelope returns a version of "env" scaled so that its duration as an src envelope is "target-dur".
-<pre>
- <em class=listener>></em><em class=typing>(src-duration (src-fit-envelope '(0 1 1 2) 2.0))</em>
- <em class=listener>2.0</em>
+<pre class="indented">
+<em class=def id="srcfitenvelope">src-fit-envelope</em> env target-dur
+</pre>
+
+<p>src-fit-envelope returns a version of "env" scaled so that its duration as an src envelope is "target-dur".
+</p>
+
+<pre class="indented">
+> (src-duration (src-fit-envelope '(0 1 1 2) 2.0))
+2.0
</pre>
-</td></tr><tr><td colspan=2 height=32></td></tr>
-<!-- ---------------------------------------- dsp algebra ---------------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="dspdocalgebra">stats, linear algebra, etc</A></center></td><td></td></tr>
+<!-- dsp algebra -->
+<div class="innerheader" id="dspdocalgebra">stats, linear algebra, etc</div>
<!-- JOS -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<br>
-<table border=0 cellpadding=0 cellspacing=0>
-<tr><td><em class=emdef>channel-mean</em> <code>snd chn</code></td> <td><code>; <f, 1> / n</code></td></tr>
-<tr><td><em class=emdef>channel-total-energy</em> <code>snd chn</code></td> <td><code>; <f, f></code></td></tr>
-<tr><td><em class=emdef>channel-average-power</em> <code>snd chn</code></td> <td><code>; <f, f> / n</code></td></tr>
-<tr><td><em class=emdef>channel-norm</em> <code>snd chn</code></td> <td><code>; sqrt(<f, f>)</code></td></tr>
-<tr><td><a class=def name="channelrms">channel-rms</a> <code>snd chn</code></td> <td><code>; sqrt(<f, f> / n)</code></td></tr>
-<tr><td><em class=emdef>channel-variance</em> <code>snd chn</code></td> <td><code>; <f, f> - ((<f, 1> / n) ^ 2) with quibbles</code></td></tr>
-<tr><td><em class=emdef>channel-lp</em> u-p <code>snd chn</code></td> <td></td></tr>
-<tr><td><em class=emdef>channel-lp-inf</em> <code>snd chn</code></td> <td><code>; max abs f</code></td></tr>
-<tr><td><em class=emdef>channel2-inner-product</em> <code>s1 c1 s2 c2</code></td> <td><code>; <f, g></code></td></tr>
-<tr><td><em class=emdef>channel2-orthogonal?</em> <code>s1 c1 s2 c2</code></td> <td><code>; <f, g> == 0</code></td></tr>
-<tr><td><em class=emdef>channel2-angle</em> <code>s1 c1 s2 c2</code></td> <td><code>; acos(<f, g> / (sqrt(<f, f>) * sqrt(<g, g>)))</code></td></tr>
-<tr><td><em class=emdef>channel2-coefficient-of-projection</em> <code>s1 c1 s2 c2</code></td><td><code>; <f, g> / <f, f></code></td></tr>
-<tr><td><em class=emdef>channel-distance</em> <code>s1 c1 s2 c2</code></td> <td><code>; sqrt(<f - g, f - g>)</code></td></tr>
-</table>
-</td></tr><tr><td></td><td>
-These functions are taken from (or at least inspired by) Julius Smith's "Mathematics of the
+<pre class="indented">
+<em class=emdef>channel-mean</em> snd chn ; <f, 1> / n
+<em class=emdef>channel-total-energy</em> snd chn ; <f, f>
+<em class=emdef>channel-average-power</em> snd chn ; <f, f> / n
+<em class=emdef>channel-norm</em> snd chn ; sqrt(<f, f>)
+<em class=def id="channelrms">channel-rms</em> snd chn ; sqrt(<f, f> / n)
+<em class=emdef>channel-variance</em> snd chn ; <f, f> - ((<f, 1> / n) ^ 2) with quibbles
+<em class=emdef>channel-lp</em> u-p snd chn
+<em class=emdef>channel-lp-inf</em> snd chn ; max abs f
+<em class=emdef>channel2-inner-product</em> s1 c1 s2 c2 ; <f, g>
+<em class=emdef>channel2-orthogonal?</em> s1 c1 s2 c2 ; <f, g> == 0
+<em class=emdef>channel2-angle</em> s1 c1 s2 c2 ; acos(<f, g> / (sqrt(<f, f>) * sqrt(<g, g>)))
+<em class=emdef>channel2-coefficient-of-projection</em> s1 c1 s2 c2 ; <f, g> / <f, f>
+<em class=emdef>channel-distance</em> (s1 0) (c1 0) (s2 1) (c2 0) ; sqrt(<f - g, f - g>)
+</pre>
+
+<p>These functions are taken from (or at least inspired by) Julius Smith's "Mathematics of the
DFT". Many are standard ways of describing a signal in statistics; others treat a signal
as a vector (channel-distance, for example, returns the Euclidean distance between two
sounds). The 's1' and 's2' parameters refer to sound objects, and the 'c1' and 'c2'
parameters refer to channel numbers.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- channel-polynomial -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="channelpolynomial">channel-polynomial</a> <code>coeffs snd chn</code><br>
-<a class=def name="spectralpolynomial">spectral-polynomial</a> <code>coeffs snd chn</code><br>
-<a class=def name="vctpolynomial">vct-polynomial</a> <code>v coeffs</code>
-</td></tr><tr><td></td><td>
-vct-polynomial returns the evaluation of the polynomial (given its coefficients) over an entire
-vct, each element being treated as "x".
+<pre class="indented">
+<em class=def id="channelpolynomial">channel-polynomial</em> coeffs snd chn
+<em class=def id="spectralpolynomial">spectral-polynomial</em> coeffs snd chn
+<em class=def id="vctpolynomial">float-vector-polynomial</em> v coeffs
+</pre>
+
+<p>float-vector-polynomial returns the evaluation of the polynomial (given its coefficients) over an entire
+float-vector, each element being treated as "x".
channel-polynomial performs the same operation over
a sound channel.
spectral-polynomial is similar, but operates in the frequency domain (each
multiply being a convolution).
-<pre>
- <em class=listener>:</em><em class=typing>(vct-polynomial (vct 0.0 2.0) (vct 1.0 2.0))</em> ; x*2 + 1
- <em class=listener>#<vct[len=2]: 1.000 5.000></em>
- <em class=listener>:</em><em class=typing>(channel-polynomial (vct 0.0 1.0 1.0 1.0))</em> ; x*x*x + x*x + x
+</p>
+
+<pre class="indented">
+> (float-vector-polynomial (float-vector 0.0 2.0) (float-vector 1.0 2.0)) ; x*2 + 1
+#(1.0 5.0)
+> (channel-polynomial (float-vector 0.0 1.0 1.0 1.0)) ; x*x*x + x*x + x
</pre>
-The "constant" (0-th coefficient) term in spectral polynomial is treated as a dither amount (that is,
+
+<p>The "constant" (0-th coefficient) term in spectral polynomial is treated as a dither amount (that is,
it has the given magnitude, but its phase is randomized, rather than being simple DC).
See also <a href="#polydoc">poly.scm</a>.
In channel-poynomial,
if you have an nth-order polynomial, the resultant spectrum is n times as wide as the original,
so aliasing is a possibility, and even powers create energy at 0Hz.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
-<!-- ---------------------------------------- scanned synthesis ---------------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="dspdocscanned">scanned synthesis</A></center></td><td></td></tr>
+
+<!-- scanned synthesis -->
+<div class="innerheader" id="dspdocscanned">scanned synthesis</div>
<!-- main-index |dspdocscanned:scanned synthesis -->
<!-- scanned synthesis -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="computeuniformcircularstring">compute-uniform-circular-string</a> <code>size x0 x1 x2 mass xspring damp</code><br>
-<em class=emdef>compute-string</em> <code>size x0 x1 x2 masses xsprings esprings damps haptics</code>
-</td></tr><tr><td></td><td>
-These functions implement
+<pre class="indented">
+<em class=def id="computeuniformcircularstring">compute-uniform-circular-string</em> size x0 x1 x2 mass xspring damp
+<em class=emdef>compute-string</em> size x0 x1 x2 masses xsprings esprings damps haptics
+</pre>
+
+<p>These functions implement
scanned synthesis of Bill Verplank and Max Mathews.
To watch the wave, open some sound (so Snd has some place to put the graph), turn off
the time domain display (to give our graph all the window)
then
-<pre>
- (let* ((size 128)
- (x0 (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (x1 (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size))
- (x2 (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> size)))
- (do ((i 0 (+ 1 i)))
- ((= i 12))
- (let ((val (sin (/ (* 2 pi i) 12.0))))
- (set! (x1 (+ i (- (/ size 4) 6))) val)))
- (do ((i 0 (+ 1 i)))
- ((= i 1024))
- (<em class=red>compute-uniform-circular-string</em> size x0 x1 x2 1.0 0.1 0.0)
- (<a class=quiet href="extsnd.html#graph" onmouseout="UnTip()" onmouseover="Tip(extsnd_graph_tip)">graph</a> x0 "string" 0 1.0 -10.0 10.0)))
-</pre>
-There's also a dialog to experiment with this:
-<a href="#displayscannedsynthesis">display-scanned-synthesis</a> in snd-motif.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
-</table>
+<pre class="indented">
+(let* ((size 128)
+ (x0 (make-float-vector size 0.0))
+ (x1 (make-float-vector size 0.0))
+ (x2 (make-float-vector size 0.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i 12))
+ (let ((val (sin (/ (* 2 pi i) 12.0))))
+ (set! (x1 (+ i (- (/ size 4) 6))) val)))
+ (do ((i 0 (+ i 1)))
+ ((= i 1024))
+ (<em class=red>compute-uniform-circular-string</em> size x0 x1 x2 1.0 0.1 0.0)
+ (<a class=quiet href="extsnd.html#graph">graph</a> x0 "string" 0 1.0 -10.0 10.0)))
+</pre>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: env ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="envdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>env</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: env -->
+
+<div class="header" id="envdoc">env</div>
<p>
env.scm provides a variety envelope functions.
@@ -3229,356 +3733,374 @@ a CLM env structure passed to the <a href="sndclm.html#env">env</a> generator.
In an envelope,
the x axis extent
is arbitrary, though it's simplest to use 0.0 to 1.0.
-(In this file, envelopes are assumed to be flat lists, not vcts or lists of lists).
+(In this file, envelopes are assumed to be flat lists, not float-vectors or lists of lists).
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
+<div class="spacer"></div>
<!-- add-envelopes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>add-envelopes</em> <code>env1 env2</code>
-</td></tr><tr><td width=30></td><td>
-add-envelopes adds two envelopes together:
-<pre>
- :<em class=typing>(add-envelopes '(0 0 1 1) '(0 0 1 1 2 0))</em>
- <em class=listener>(0 0 1/2 3/2 1 1)</em> ; i.e. (0 0 1 1.5 2 1) in the 2nd env's terms
+<pre class="indented">
+<em class=emdef>add-envelopes</em> env1 env2
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>add-envelopes adds two envelopes together:
+</p>
+
+<pre class="indented">
+> (add-envelopes '(0 0 1 1) '(0 0 1 1 2 0))
+(0 0 1/2 3/2 1 1) ; i.e. (0 0 1 1.5 2 1) in the second env's terms
+</pre>
+
+<div class="spacer"></div>
<!-- concatenate-envelopes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="concatenateenvelopes">concatenate-envelopes</a> <code>:rest envs</code>
-</td></tr><tr><td></td><td>
-concatenate-envelopes concatenates its arguments:
-<pre>
- :<em class=typing>(concatenate-envelopes '(0 1 1 0) '(0 0 1 1))</em>
- <em class=listener>(0.0 1 1.0 0 2.0 1)</em>
+<pre class="indented">
+<em class=def id="concatenateenvelopes">concatenate-envelopes</em> :rest envs
+</pre>
+<p>concatenate-envelopes concatenates its arguments:
+</p>
+
+<pre class="indented">
+> (concatenate-envelopes '(0 1 1 0) '(0 0 1 1))
+(0.0 1 1.0 0 2.0 1)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- envelope-exp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>envelope-exp</em> <code>e (power 1.0) (xgrid 100)</code>
-</td></tr><tr><td></td><td>
-envelope-exp interpolates segments into envelope to approximate exponential curves.
-<pre>
- :<em class=typing>(<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~{~,3F ~}" (envelope-exp '(0 0 1 1) 3.0 6))</em>
- <em class=listener>"0.000 0.000 0.167 0.005 0.333 0.037 0.500 0.125 0.667 0.296 0.833 0.579 1.000 1.000 "</em>
+<pre class="indented">
+<em class=emdef>envelope-exp</em> e (power 1.0) (xgrid 100)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>envelope-exp interpolates segments into envelope to approximate exponential curves.
+</p>
-<!-- envelope-interp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="envelopeinterp">envelope-interp</a> <code>x env (base 1.0)</code>
-</td></tr><tr><td></td><td>
-<code>(envelope-interp x env base)</code> returns value of 'env' at 'x'.
-If 'base' is 0, 'env' is treated as a step function; if 'base' is 1.0 (the
-default), the breakpoints of 'env' are connected by a straight line, and
-any other 'base' connects the breakpoints with a kind of exponential
-curve:
-<pre>
- :<em class=typing>(envelope-interp .1 '(0 0 1 1))</em>
- <em class=listener>0.1</em>
- :<em class=typing>(envelope-interp .1 '(0 0 1 1) 32.0)</em>
- <em class=listener>0.0133617278184869</em>
- :<em class=typing>(envelope-interp .1 '(0 0 1 1) .012)</em>
- <em class=listener>0.361774730775292</em>
+<pre class="indented">
+> (<a class=quiet>format</a> #f "~{~,3F ~}" (envelope-exp '(0 0 1 1) 3.0 6))
+"0.000 0.000 0.167 0.005 0.333 0.037 0.500 0.125 0.667 0.296 0.833 0.579 1.000 1.000 "
</pre>
-The corresponding function for a CLM env generator is <a href="sndclm.html#env-interp">env-interp</a>.
-If you'd rather think in terms of e^-kt, set the 'base' to (exp k).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- envelope-last-x -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>envelope-last-x</em> <code>env</code>
-</td></tr><tr><td></td><td>
-envelope-last-x returns the maximum x value:
-<pre>
- :<em class=typing>(envelope-last-x '(0 1 1 0 2 0))</em>
- <em class=listener>2</em>
+<pre class="indented">
+<em class=emdef>envelope-last-x</em> env
+</pre>
+
+<p>envelope-last-x returns the maximum x value:
+</p>
+
+<pre class="indented">
+> (envelope-last-x '(0 1 1 0 2 0))
+2
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- integrate-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="integrateenvelope">integrate-envelope</a> <code>env</code>
-</td></tr><tr><td></td><td>
-integrate-envelope returns the area under the envelope.
-<pre>
- :<em class=typing>(integrate-envelope '(0 0 1 1))</em>
- <em class=listener>0.5</em>
- :<em class=typing>(integrate-envelope '(0 1 1 1))</em>
- <em class=listener>1.0</em>
- :<em class=typing>(integrate-envelope '(0 0 1 1 2 .5))</em>
- <em class=listener>1.25</em>
+<pre class="indented">
+<em class=def id="integrateenvelope">integrate-envelope</em> env
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>integrate-envelope returns the area under the envelope.
+</p>
+
+<pre class="indented">
+> (integrate-envelope '(0 0 1 1))
+0.5
+> (integrate-envelope '(0 1 1 1))
+1.0
+> (integrate-envelope '(0 0 1 1 2 .5))
+1.25
+</pre>
+
+<div class="spacer"></div>
<!-- make-power-env -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>make-power-env</em> <code>e (scaler 1.0) (offset 0.0) duration</code><br>
-<a class=def name="powerenv">power-env</a> <code>e</code><br>
-<em class=emdef>power-env-channel</em> <code>pe (beg 0) dur snd chn edpos (edname "power-env-channel")</code><br>
-<em class=emdef>powenv-channel</em> <code>envelope (beg 0) dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-make-power-env and power-env implement an extension of exponential
+<pre class="indented">
+<em class=emdef>make-power-env</em> e (scaler 1.0) (offset 0.0) duration
+<em class=def id="powerenv">power-env</em> e
+<em class=emdef>power-env-channel</em> pe (beg 0) snd chn edpos (edname "power-env-channel")
+<em class=emdef id="powenvchannel">powenv-channel</em> envelope (beg 0) dur snd chn edpos
+</pre>
+
+<p>make-power-env and power-env implement an extension of exponential
envelopes; each segment has its own base. power-env-channel uses the same
mechanism as an extension of env-channel.
-<pre>
- (let ((pe (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1) :duration 1.0)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (* y (power-env pe)))))
-
- (let ((pe1 (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1.0 3 .5 3.0 4 0 0) :duration 1.0)))
- (power-env-channel pe1))
+</p>
+
+<pre class="indented">
+(let ((pe (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1) :duration 1.0)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y) (* y (power-env pe)))))
+
+(let ((pe1 (make-power-env '(0 0 32.0 1 1 0.0312 2 0 1.0 3 .5 3.0 4 0 0) :duration 1.0)))
+ (power-env-channel pe1))
</pre>
-powenv-channel is a simplification of power-env-channel; it takes a breakpoint list rather
+
+<p>powenv-channel is a simplification of power-env-channel; it takes a breakpoint list rather
than a power-env structure:
-<pre>
- (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))
+</p>
+
+<pre class="indented">
+(powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- map-envelopes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>map-envelopes</em> <code>func env1 env2</code>
-</td></tr><tr><td></td><td>
-map-envelopes applies 'func' to the breakpoints in the two
+<pre class="indented">
+<em class=emdef>map-envelopes</em> func env1 env2
+</pre>
+
+<p>map-envelopes applies 'func' to the breakpoints in the two
envelope arguments, returning a new envelope.
-<pre>
- :<em class=typing>(map-envelopes + '(0 0 1 1 2 0) '(0 1 2 0))</em>
- <em class=listener>(0 1 1/2 3/2 1 0)</em> ; i.e. '(0 1 1 1.5 2 0) in the original x-axis bounds
+</p>
+
+<pre class="indented">
+> (map-envelopes + '(0 0 1 1 2 0) '(0 1 2 0))
+(0 1 1/2 3/2 1 0) ; i.e. '(0 1 1 1.5 2 0) in the original x-axis bounds
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- max-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>min-envelope</em> <code>env</code><br>
-<a class=def name="maxenvelope">max-envelope</a> <code>env</code>
-</td></tr><tr><td></td><td>
-max-envelope returns the maximum y value in 'env', and min-envelope returns the minimum y value:
-<pre>
- :<em class=typing>(max-envelope '(0 0 1 1 2 3 4 0))</em>
- <em class=listener>3.0</em>
+<pre class="indented">
+<em class=emdef>min-envelope</em> env
+<em class=def id="maxenvelope">max-envelope</em> env
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>max-envelope returns the maximum y value in 'env', and min-envelope returns the minimum y value:
+</p>
+
+<pre class="indented">
+> (max-envelope '(0 0 1 1 2 3 4 0))
+3.0
+</pre>
+
+<div class="spacer"></div>
<!-- multiply-envelopes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>multiply-envelopes</em> <code>env1 env2</code>
-</td></tr><tr><td></td><td>
-<b>multiply-envelopes</b> uses map-envelopes to multiply two envelopes:
-<pre>
- Scheme:
- :<em class=typing>(multiply-envelopes '(0 0 1 1) '(0 0 1 1 2 0))</em>
- <em class=listener>(0 0 0.5 0.5 1 0)</em>
+<pre class="indented">
+<em class=emdef>multiply-envelopes</em> env1 env2
+</pre>
+
+<p>multiply-envelopes uses map-envelopes to multiply two envelopes:
+</p>
+
+<pre class="indented">
+Scheme:
+> (multiply-envelopes '(0 0 1 1) '(0 0 1 1 2 0))
+(0 0 0.5 0.5 1 0)
- Ruby:
- :<em class=typing>multiply_envelopes([0, 0, 1, 1], [0, 0, 1, 1, 2, 0])</em>
- <em class=listener>[0.0, 0.0, 0.5, 0.5, 1.0, 0.0]</em>
+Ruby:
+> multiply_envelopes([0, 0, 1, 1], [0, 0, 1, 1, 2, 0])
+[0.0, 0.0, 0.5, 0.5, 1.0, 0.0]
- Forth:
- <em class=listener>snd></em><em class=typing> '( 0e 0e 1.0 1.0 ) '( 0e 0e 1.0 1.0 2.0 0.0 ) multiply-envelopes</em>
- <em class=listener>'( 0.0 0.0 0.5 0.5 1.0 0.0 )</em>
+Forth:
+snd> '( 0e 0e 1.0 1.0 ) '( 0e 0e 1.0 1.0 2.0 0.0 ) multiply-envelopes
+'( 0.0 0.0 0.5 0.5 1.0 0.0 )
</pre>
-The new envelope goes from 0.0 to 1.0 along
+
+<p>The new envelope goes from 0.0 to 1.0 along
the X axis; the multiplied envelopes are stretched or contracted to
fit 0.0 to 1.0, and wherever one has a breakpoint, the corresponding
point in the other envelope is interpolated, if necessary.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- normalize-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="normalizeenvelope">normalize-envelope</a> <code>env (new-max 1.0)</code>
-</td></tr><tr><td></td><td>
-normalize-envelope returns a version of 'env' scaled so that its maximum y value is 'new-max'.
-<pre>
- :<em class=typing>(normalize-envelope '(0 0 1 1 2 3 4 0) .5)</em>
- <em class=listener>(0 0.0 1 0.167 2 0.5 4 0.0)</em>
+<pre class="indented">
+<em class=def id="normalizeenvelope">normalize-envelope</em> env (new-max 1.0)
+</pre>
+
+<p>normalize-envelope returns a version of 'env' scaled so that its maximum y value is 'new-max'.
+</p>
+
+<pre class="indented">
+> (normalize-envelope '(0 0 1 1 2 3 4 0) .5)
+(0 0.0 1 0.167 2 0.5 4 0.0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- repeat-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>repeat-envelope</em> <code>env repeats reflected normalized</code>
-</td></tr><tr><td></td><td>
-repeat-envelope repeats an envelope (concatenates copies of itself).
+<pre class="indented">
+<em class=emdef>repeat-envelope</em> env repeats reflected normalized
+</pre>
+
+<p>repeat-envelope repeats an envelope (concatenates copies of itself).
It's usually easier to use <a href="sndclm.html#mus-reset">mus-reset</a> to restart an envelope over and over (see <a href="sndclm.html#pulsedenv">pulsed-env</a>).
+</p>
-<table border=0><tr><td>
-<pre>
- :<em class=typing>(repeat-envelope '(0 0 .1 .9 1 1 1.3 .2 2 0) 2)</em>
- <em class=listener>(0 0 0.1 0.9 1.0 1 1.3 0.2 2.0 0 2.1 0.9 3.0 1 3.3 0.2 4.0 0)</em>
+<pre class="indented">
+> (repeat-envelope '(0 0 .1 .9 1 1 1.3 .2 2 0) 2)
+(0 0 0.1 0.9 1.0 1 1.3 0.2 2.0 0 2.1 0.9 3.0 1 3.3 0.2 4.0 0)
</pre>
-</td></tr><tr>
-<td><img src="pix/repenv.png" alt="repeated envelope" hspace=20>
-</td></tr></table>
-If the final y value is different from the first y value (as above), a quick ramp is
+<img class="indented" src="pix/repenv.png" alt="repeated envelope">
+
+
+<p>If the final y value is different from the first y value (as above), a quick ramp is
inserted between repeats. 'normalized' causes the new envelope's x axis
to have the same extent as the original's. 'reflected' causes every other
repetition to be in reverse.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- reverse-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="reverseenvelope">reverse-envelope</a> <code>env</code>
-</td></tr><tr><td></td><td>
-reverse-envelope reverses an envelope.
-<pre>
- :<em class=typing>(reverse-envelope '(0 0 1 1 2 1))</em>
- <em class=listener>(0 1 1 1 2 0)</em>
+<pre class="indented">
+<em class=def id="reverseenvelope">reverse-envelope</em> env
+</pre>
+
+<p>reverse-envelope reverses an envelope.
+</p>
+
+<pre class="indented">
+> (reverse-envelope '(0 0 1 1 2 1))
+(0 1 1 1 2 0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
+
<!-- rms-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="rmsenvelope">rms-envelope</a> <code>file (beg 0.0) dur (rfreq 30.0) db</code>
-</td></tr><tr><td></td><td>
-rms-envelope returns an rms envelope of a file; it is based on rmsenv.ins in the CLM package.
-<pre>
- :<em class=typing>(<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~{~,3F ~}" (rms-envelope "1a.snd"))</em>
- <em class=listener>"0.000 0.049 0.033 0.069 0.067 0.049 0.100 0.000 0.133 0.000 0.167 0.000 0.200 0.000 "</em>
+<pre class="indented">
+<em class=def id="rmsenvelope">rms-envelope</em> file (beg 0.0) dur (rfreq 30.0) db
+</pre>
+
+<p>rms-envelope returns an rms envelope of a file; it is based on rmsenv.ins in the CLM package.
+</p>
+
+<pre class="indented">
+> (<a class=quiet>format</a> #f "~{~,3F ~}" (rms-envelope "1a.snd"))
+"0.000 0.049 0.033 0.069 0.067 0.049 0.100 0.000 0.133 0.000 0.167 0.000 0.200 0.000 "
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
+
<!-- scale-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="scaleenvelope">scale-envelope</a> <code>env scl (offset 0.0)</code>
-</td></tr><tr><td></td><td>
-scale-envelope scales the y values of an envelope by 'scl', and optionally adds 'offset'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="scaleenvelope">scale-envelope</em> env scl (offset 0.0)
+</pre>
+
+<p>scale-envelope scales the y values of an envelope by 'scl', and optionally adds 'offset'.
+</p>
+<div class="spacer"></div>
<!-- stretch-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="stretchenvelope">stretch-envelope</a> <code>env old-attack new-attack (old-decay #f) (new-decay #f)</code>
-</td></tr><tr><td></td><td>
-stretch-envelope applies attack and optionally decay times
+<pre class="indented">
+<em class=def id="stretchenvelope">stretch-envelope</em> env old-attack new-attack (old-decay #f) (new-decay #f)
+</pre>
+
+<p>stretch-envelope applies attack and optionally decay times
to an envelope, much like divseg in clm-1.
-<pre>
- :<em class=typing>(stretch-envelope '(0 0 1 1) .1 .2)</em>
- <em class=listener>(0 0 0.2 0.1 1.0 1)</em>
- :<em class=typing>(stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6)</em>
- <em class=listener>(0 0 0.2 0.1 1.1 1 1.6 0.5 2.0 0)</em>
+</p>
+
+<pre class="indented">
+> (stretch-envelope '(0 0 1 1) .1 .2)
+(0 0 0.2 0.1 1.0 1)
+> (stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6)
+(0 0 0.2 0.1 1.1 1 1.6 0.5 2.0 0)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- window-envelope -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>window-envelope</em> <code>beg end env</code>
-</td></tr><tr><td></td><td>
-window-envelope returns (as an envelope) the portion of its envelope argument that lies
+<pre class="indented">
+<em class=emdef>window-envelope</em> beg end env
+</pre>
+
+<p>window-envelope returns (as an envelope) the portion of its envelope argument that lies
between the x axis values 'beg' and 'end'. This is useful when you're treating an
envelope as a phrase-level control, applying successive portions of it to many underlying
notes.
-<pre>
- :<em class=typing>(window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0))</em>
- <em class=listener>(1.0 0.2 3.0 0.6)</em>
+</p>
+
+<pre class="indented">
+> (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0))
+(1.0 0.2 3.0 0.6)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-</table>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="sndclm.html#envdoc" onmouseout="UnTip()" onmouseover="Tip('env and make-env: envelopes in CLM')">make-env</a> <a href="extsnd.html#envchannel" onmouseout="UnTip()" onmouseover="Tip('the main Snd enveloping function')">env-channel</a> <a href="snd.html#editenvelope" onmouseout="UnTip()" onmouseover="Tip('the envelope editor dialog')">Enved</a> <a href="#envexptchannel">env-expt-channel</a>
-</pre>
-</td></tr></table>
-<br>
-<br>
+<div class="seealso">
+see also: <a href="sndclm.html#envdoc">make-env</a> <a href="extsnd.html#envchannel">env-channel</a> <a href="snd.html#editenvelope">Enved</a> <a href="#envexptchannel">env-expt-channel</a>
+</div>
-<!-- ---------------------------------------- FILE: enved ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="enveddoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>enved, xm-enved</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: enved -->
+
+<div class="header" id="enveddoc">enved, xm-enved</div>
<p>enved.scm implements an independent envelope editor in each channel.
</p>
-<table border=0><tr><td bgcolor="#f2f3ff">
-<em class=emdef>start-enveloping</em> <br>
-<em class=emdef>stop-enveloping</em> <br>
-<a class=def name="channelenvelope">channel-envelope</a> <code>snd chn</code><br>
-<A class=def NAME="playwithenvs">play-with-envs</a> <code>snd</code><br>
-<A class=def NAME="playpanned">play-panned</a> <code>snd</code>
-</td></tr></table>
+<pre class="indented">
+<em class=emdef>start-enveloping</em>
+<em class=emdef>stop-enveloping</em>
+<em class=def id="channelenvelope">channel-envelope</em> snd chn
+<em class=def id="playwithenvs">play-with-envs</em> snd
+</pre>
<p>
-<code>(start-enveloping)</code> opens an envelope editor for each subsequently opened sound.
-<code>(stop-enveloping)</code> turns this off.
-Each envelope can be read or written via <code>(channel-envelope snd chn)</code>.
-There are also two examples that use these envelopes: play-with-envs and
-play-panned. The former sets the channel's amplitude from its envelope
-during playback (it should be obvious how to apply the envelope to any of the
-control panel fields); the latter pans a mono sound into stereo following
-the envelope.
-</p>
-
-<img src="pix/envs.png" alt="channel enveds" hspace=20 vspace=10>
-<br>
+(start-enveloping) opens an envelope editor for each subsequently opened sound.
+(stop-enveloping) turns this off.
+Each envelope can be read or written via (channel-envelope snd chn).
+An example use is play-with-envs which
+sets the channel's amplitude from its envelope
+during playback
+</p>
+
+<img class="indented" src="pix/envs.png" alt="channel enveds">
+
+<div class="spacer"></div>
+
<p>
Closely related to this is xm-enved.scm which implements a separate envelope editor widget.
</p>
-<table border=0><tr><td bgcolor="#f2f3ff">
-<em class=emdef>xe-create-enved</em> <code>name parent args axis</code><br>
-<em class=emdef>xe-envelope</em> <code>xe-editor</code>
-</td></tr></table>
+<pre class="indented">
+<em class=emdef>xe-create-enved</em> name parent args axis
+<em class=emdef>xe-envelope</em> xe-editor
+</pre>
<p>
xe-create-enved returns a new envelope editor whose x axis label is 'name', the x and y axis bounds
are in the list 'axis', the editor's parent widget is 'parent', and the Xt-style
resource argument list is 'args'. The editor's current envelope is accessible
-(read and write) as 'xe-envelope':
-</p>
-
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define outer (add-main-pane "hiho" xmFormWidgetClass '()))
-(define editor (<em class=red>xe-create-enved</em> "a name" outer
- (list XmNleftAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM)
- '(0.0 1.0 0.0 1.0)))
-(set! (<em class=red>xe-envelope</em> editor) (list 0.0 1.0 1.0 0.5))
-</pre></td></tr>
-</table>
-<br>
+as 'xe-envelope'.
+</p>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="sndclm.html#envdoc" onmouseout="UnTip()" onmouseover="Tip('env and make-env: envelopes in CLM')">make-env</a> <a href="extsnd.html#envchannel" onmouseout="UnTip()" onmouseover="Tip('the main Snd enveloping function')">env-channel</a> <a href="snd.html#editenvelope" onmouseout="UnTip()" onmouseover="Tip('the envelope editor dialog')">Enved</a> <a href="#envdoc">functions</a> <a href="#envexptchannel">env-expt-channel</a>
-</pre>
-</td></tr></table>
-<br>
-<br>
+<div class="seealso">
+see also: <a href="sndclm.html#envdoc">make-env</a> <a href="extsnd.html#envchannel">env-channel</a> <a href="snd.html#editenvelope">Enved</a> <a href="#envdoc">functions</a> <a href="#envexptchannel">env-expt-channel</a>
+</div>
-<!-- ---------------------------------------- FILE: examp ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="exampdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>examp</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: examp -->
+
+<div class="header" id="exampdoc">examp</div>
<p>examp.scm has become a bit of a mess; rather than get organized, I just
appended new stuff as it came to mind. In this documentation, I'll divide the functions into the following non-orthogonal categories:
@@ -3591,372 +4113,448 @@ appended new stuff as it came to mind. In this documentation, I'll divide the f
<a href="#ssmisc">miscellaneous stuff</a>
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20 vspace=10>
+<!-- examp FFTS -->
-<!-- -------------------------------- examp FFTS -------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="ssffts">FFTs</A></center></td><td></td></tr>
+<div class="innerheader" id="ssffts">FFTs</div>
<!-- display-correlation -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="displaycorrelation">display-correlation</a> <code>snd chn y0 y1</code>
-</td></tr><tr><td width=30></td><td>
-display-correlation graphs the correlation of the 2 channels of the sound 'snd'.
+<pre class="indented">
+<em class=def id="displaycorrelation">display-correlation</em> snd chn y0 y1
+</pre>
+
+<p>display-correlation graphs the correlation of the 2 channels of the sound 'snd'.
To make this happen automatically as you move the time domain position
-slider: <code>(hook-push <a class=quiet href="extsnd.html#graphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphhook_tip)">graph-hook</a> display-correlation)</code>.
+slider: (hook-push <a class=quiet href="extsnd.html#graphhook">graph-hook</a> display-correlation).
The last three parameters are unused; they are just for compatibility with graph-hook.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- fft-cancel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fftcancel">fft-cancel</a> <code>lo-freq hi-freq snd chn</code>
-</td></tr><tr><td></td><td>
-fft-cancel ffts an entire channel, zeroes the bins between 'lo-freq' and 'hi-freq' (in Hz), then inverse ffts,
+<pre class="indented">
+<em class=def id="fftcancel">fft-cancel</em> lo-freq hi-freq snd chn
+</pre>
+
+<p>fft-cancel ffts an entire channel, zeroes the bins between 'lo-freq' and 'hi-freq' (in Hz), then inverse ffts,
giving a good notch filter.
-<pre>
- (fft-cancel 500 1000) ; squelch frequencies between 500 and 1000 Hz
+</p>
+
+<pre class="indented">
+(fft-cancel 500 1000) ; squelch frequencies between 500 and 1000 Hz
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- fft-edit -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="fftedit">fft-edit</a> <code>low-freq high-freq snd chn</code>
-</td></tr><tr><td></td><td>
-fft-edit takes an fft of the entire sound, removes all energy below 'low-freq' and above 'high-freq' (in Hz),
+<pre class="indented">
+<em class=def id="fftedit">fft-edit</em> low-freq high-freq snd chn
+</pre>
+
+<p>fft-edit takes an fft of the entire sound, removes all energy below 'low-freq' and above 'high-freq' (in Hz),
then inverse fft's. This is the complement of fft-cancel.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- fft-env-edit -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fftenvedit">fft-env-edit</a> <code>env snd chn</code>
-</td></tr><tr><td></td><td>
-fft-env-edit is similar to fft-edit, but applies an envelope to the spectral magnitudes.
-<pre>
- (fft-env-edit '(0 0 .1 1 .2 1 .3 0 .5 1 1.0 0)) ; 1.0 = srate / 2 here
+<pre class="indented">
+<em class=def id="fftenvedit">fft-env-edit</em> env snd chn
+</pre>
+
+<p>fft-env-edit is similar to fft-edit, but applies an envelope to the spectral magnitudes.
+</p>
+
+<pre class="indented">
+(fft-env-edit '(0 0 .1 1 .2 1 .3 0 .5 1 1.0 0)) ; 1.0 = srate / 2 here
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- fft-env-interp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fftenvinterp">fft-env-interp</a> <code>env1 env2 interp snd chn</code>
-</td></tr><tr><td></td><td>
-fft-env-interp performs fft-env-edit twice (using 'env1' and 'env2'), then mixes the two results following the interpolation
+<pre class="indented">
+<em class=def id="fftenvinterp">fft-env-interp</em> env1 env2 interp snd chn
+</pre>
+
+<p>fft-env-interp performs fft-env-edit twice (using 'env1' and 'env2'), then mixes the two results following the interpolation
envelope 'interp'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- fft-peak -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>fft-peak</em> <code>snd chn scale</code>
-</td></tr><tr><td></td><td>
-fft-peak is an <a href="extsnd.html#aftertransformhook">after-transform-hook</a> function that reports the peak spectral magnitude in the minibuffer.
-<pre>
- Scheme: (hook-push <a class=quiet href="extsnd.html#aftertransformhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_aftertransformhook_tip)">after-transform-hook</a> fft-peak)
+<pre class="indented">
+<em class=emdef>fft-peak</em> snd chn scale
+</pre>
+
+<p>fft-peak is an <a href="extsnd.html#aftertransformhook">after-transform-hook</a> function that reports the peak spectral magnitude in the status area.
+</p>
+
+<pre class="indented">
+Scheme: (hook-push <a class=quiet href="extsnd.html#aftertransformhook">after-transform-hook</a> fft-peak)
- Ruby: $after_transform_hook.add_hook!(\"fft-peak\") do |snd, chn, scale|
- fft_peak(snd, chn, scale)
- end
+Ruby: $after_transform_hook.add_hook!(\"fft-peak\") do |snd, chn, scale|
+ fft_peak(snd, chn, scale)
+ end
</pre>
-This can be helpful if you're scanning a sound with the fft graph displayed; since it normalizes
+
+<p>This can be helpful if you're scanning a sound with the fft graph displayed; since it normalizes
to 1.0 (to keep the graph from jumping around simply because the amplitude is changing), it's nice to know what the current peak
actually represents. You can, of course, turn off the normalization:
-<pre>
- (set! (<a class=quiet href="extsnd.html#normalizefft" onmouseout="UnTip()" onmouseover="Tip(extsnd_normalizefft_tip)">transform-normalization</a>) dont-normalize)
+</p>
+
+<pre class="indented">
+(set! (<a class=quiet href="extsnd.html#normalizefft">transform-normalization</a>) dont-normalize)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- fft-smoother -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="fftsmoother">fft-smoother</a> <code>cutoff start samps snd chn</code>
-</td></tr><tr><td></td><td>
-fft-smoother uses fft filtering to
-smooth a portion of a sound, returning a vct with the smoothed data. 'cutoff' sets where we starting zeroing out high frequencies.
-<pre>
- Scheme: (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (fft-smoother .1 (<a class=quiet href="extsnd.html#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) 400 0 0) (<a class=quiet href="extsnd.html#cursor" onmouseout="UnTip()" onmouseover="Tip(extsnd_cursor_tip)">cursor</a>) 400)
- Ruby: vct2channel(fft_smoother(0.1, cursor, 400, 0, 0), cursor, 400)
+<pre class="indented">
+<em class=def id="fftsmoother">fft-smoother</em> cutoff start samps snd chn
+</pre>
+
+<p>fft-smoother uses fft filtering to
+smooth a portion of a sound, returning a float-vector with the smoothed data. 'cutoff' sets where we starting zeroing out high frequencies.
+</p>
+
+<pre class="indented">
+Scheme: (float-vector->channel (fft-smoother .1 (<a class=quiet href="extsnd.html#cursor">cursor</a>) 400 0 0) (<a class=quiet href="extsnd.html#cursor">cursor</a>) 400)
+Ruby: vct2channel(fft_smoother(0.1, cursor, 400, 0, 0), cursor, 400)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- fft-squelch -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="fftsquelch">fft-squelch</a> <code>squelch snd chn</code>
-</td></tr><tr><td></td><td>
-fft-squelch is similar to fft-edit; any fft bin whose (normalized) magnitude is below 'squelch' is set to 0.0.
+<pre class="indented">
+<em class=def id="fftsquelch">fft-squelch</em> squelch snd chn
+</pre>
+
+<p>fft-squelch is similar to fft-edit; any fft bin whose (normalized) magnitude is below 'squelch' is set to 0.0.
This is sometimes useful for noise-reduction.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- filter-fft -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="filterfft">filter-fft</a> <code>func (normalize #t) snd chn</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="filterfft">filter-fft</em> func (normalize #t) snd chn
+</pre>
+
<p>
This a sort of generalization of the preceding functions. It gets the spectrum of all the data in the given channel,
applies the function 'func' to each element of the spectrum, then inverse ffts. 'func' should take one argument, the
current spectrum value.
</p>
-<table border=0 cellpadding=5 hspace=20>
-<tr><td><pre>
-(define (brfft lofrq hifrq)
- "(brfft lofrq hifrq) removes all frequencies between lofrq and hifrq: (brfft 1000.0 2000.0)"
- (let* ((len (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (fsize (expt 2 (ceiling (/ (log len) (log 2.0)))))
- (ctr -1)
- (lo (round (/ (* fsize lofrq) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>))))
- (hi (round (/ (* fsize hifrq) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>)))))
- (<em class=red>filter-fft</em> (lambda (y)
- (set! ctr (+ 1 ctr))
- (if (and (>= ctr lo)
- (<= ctr hi))
- 0.0
- y)))))
-</pre></td></tr>
-</table>
+
+<pre class="indented">
+(define brfft
+ (let ((documentation "(brfft lofrq hifrq) removes all frequencies between lofrq and hifrq: (brfft 1000.0 2000.0)"))
+ (lambda (lofrq hifrq)
+ (let* ((len (<a class=quiet href="extsnd.html#framples">framples</a>))
+ (fsize (expt 2 (ceiling (log len 2))))
+ (ctr -1)
+ (lo (round (/ (* fsize lofrq) (<a class=quiet href="extsnd.html#srate">srate</a>))))
+ (hi (round (/ (* fsize hifrq) (<a class=quiet href="extsnd.html#srate">srate</a>)))))
+ (<em class=red>filter-fft</em> (lambda (y)
+ (set! ctr (+ 1 ctr))
+ (if (>= hi ctr lo)
+ 0.0
+ y)))))))
+</pre>
+
<p>Here are some sillier examples...
</p>
-<pre>
- (let ((op (<a class=quiet href="sndclm.html#make-one-zero" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_one_zero_tip)">make-one-zero</a> .5 .5))) (filter-fft op))
- (let ((op (<a class=quiet href="sndclm.html#make-one-pole" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_one_pole_tip)">make-one-pole</a> .05 .95))) (filter-fft op))
- (filter-fft (lambda (y) (if (< y .1) 0.0 y))) ; like fft-squelch
- (let ((rd (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0 0 0 1 0)))
- (<a class=quiet href="extsnd.html#scaleby" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleby_tip)">scale-by</a> 0)
- (filter-fft (lambda (y) (rd)))) ; treat sound as spectrum
- (filter-fft <a class=quiet href="sndclm.html#contrast-enhancement" onmouseout="UnTip()" onmouseover="Tip(sndclm_contrast_enhancement_tip)">contrast-enhancement</a>)
- (filter-fft (lambda (y) (* y y y))) ; extreme low pass
+
+<pre class="indented">
+(let ((op (<a class=quiet href="sndclm.html#make-one-zero">make-one-zero</a> .5 .5))) (filter-fft op))
+(let ((op (<a class=quiet href="sndclm.html#make-one-pole">make-one-pole</a> .05 .95))) (filter-fft op))
+(filter-fft (lambda (y) (if (< y .1) 0.0 y))) ; like fft-squelch
+(let ((rd (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0 0 0 1 0)))
+ (<a class=quiet href="extsnd.html#scaleby">scale-by</a> 0)
+ (filter-fft (lambda (y) (rd)))) ; treat sound as spectrum
+(filter-fft <a class=quiet href="sndclm.html#contrast-enhancement">contrast-enhancement</a>)
+(filter-fft (lambda (y) (* y y y))) ; extreme low pass
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- squelch-vowels -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="squelchvowels">squelch-vowels</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-squelch-vowels uses fft data to try to distinguish a steady state portion (a vowel in speech) from
+<pre class="indented">
+<em class=def id="squelchvowels">squelch-vowels</em> snd chn
+</pre>
+
+<p>squelch-vowels uses fft data to try to distinguish a steady state portion (a vowel in speech) from
noise (a consonant, sometimes), then tries to remove (set to 0.0) the vowel-like portions.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- superimpose-ffts -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="superimposeffts">superimpose-ffts</a> <code>snd chn y0 y1</code>
-</td></tr><tr><td></td><td>
-superimpose-ffts is a graph-hook function that
+<pre class="indented">
+<em class=def id="superimposeffts">superimpose-ffts</em> snd chn y0 y1
+</pre>
+
+<p>superimpose-ffts is a graph-hook function that
superimposes the ffts of multiple (sync'd) sounds.
-<code>(hook-push <a class=quiet href="extsnd.html#graphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphhook_tip)">graph-hook</a> superimpose-ffts)</code>
+(hook-push <a class=quiet href="extsnd.html#graphhook">graph-hook</a> superimpose-ffts)
This function needs some work...
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- zoom-spectrum -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>zoom-spectrum</em> <code>snd chn y0 y1</code>
-</td></tr><tr><td></td><td>
-zoom-spectrum sets the transform size to correspond to the time-domain window size.
-<code>(hook-push <a class=quiet href="extsnd.html#graphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphhook_tip)">graph-hook</a> zoom-spectrum)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>zoom-spectrum</em> snd chn y0 y1
+</pre>
+
+<p>zoom-spectrum sets the transform size to correspond to the time-domain window size.
+(hook-push <a class=quiet href="extsnd.html#graphhook">graph-hook</a> zoom-spectrum).
+</p>
-<!-- -------------------------------- examp FILTERS -------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="ssfilters">filters</A></center></td><td></td></tr>
+
+<!-- examp FILTERS -->
+
+<div class="innerheader" id="ssfilters">filters</div>
<!-- comb-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>comb-filter</em> <code>scaler size</code><br>
-<em class=emdef>zcomb</em> <code>scaler size pm</code>
-</td></tr><tr><td></td><td>
-comb-filter is an example of using the CLM <a href="sndclm.html#comb">comb</a> generator.
-<pre>
- Scheme: (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (comb-filter .8 32))
- Ruby: map_channel(comb_filter(0.8, 32))
- Forth: 0.8 32 comb-filter-1 map-channel
+<pre class="indented">
+<em class=emdef>comb-filter</em> scaler size
+<em class=emdef>zcomb</em> scaler size pm
</pre>
-it would be faster to use the comb filter directly:
-<pre>
- (<a class=quiet href="extsnd.html#clmchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_clmchannel_tip)">clm-channel</a> (<a class=quiet href="sndclm.html#make-comb" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_comb_tip)">make-comb</a> .8 32))
+
+<p>comb-filter is an example of using the CLM <a href="sndclm.html#comb">comb</a> generator.
+</p>
+
+<pre class="indented">
+Scheme: (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (comb-filter .8 32))
+Ruby: map_channel(comb_filter(0.8, 32))
+Forth: 0.8 32 comb-filter-1 map-channel
+</pre>
+
+<p>it would be faster to use the comb filter directly:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#clmchannel">clm-channel</a> (<a class=quiet href="sndclm.html#make-comb">make-comb</a> .8 32))
</pre>
-zcomb is a time-varying comb
+
+<p>zcomb is a time-varying comb
filter using the envelope 'pm' (the envelope is applied to the comb filter delay length).
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (zcomb .8 32 '(0 0 1 10)))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (zcomb .8 32 '(0 0 1 10)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- comb-chord -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>comb-chord</em> <code>scaler size amp</code>
-</td></tr><tr><td></td><td>
-comb-chord uses comb filters at harmonically
+<pre class="indented">
+<em class=emdef>comb-chord</em> scaler size amp
+</pre>
+
+<p>comb-chord uses comb filters at harmonically
related sizes to create a chord (see also <a href="#chordalize">chordalize</a> in dsp.scm).
'amp' is an overall amplitude scaler.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (comb-chord .95 100 .3))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (comb-chord .95 60 .3))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (comb-chord .95 100 .3))
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (comb-chord .95 60 .3))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- filtered-env -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>filtered-env</em> <code>e snd chn</code>
-</td></tr><tr><td></td><td>
-filtered-env takes an amplitude envelope 'e' and creates a one-pole
+<pre class="indented">
+<em class=emdef>filtered-env</em> e snd chn
+</pre>
+
+<p>filtered-env takes an amplitude envelope 'e' and creates a one-pole
filter, and moves them in parallel over a sound;
as the sound gets softer, the low-pass filter's cutoff frequency
gets lower, a sort of poor-man's distance effect. When 'e'
is at 1.0, no filtering takes place.
-<pre>
- (filtered-env '(0 1 1 0)) ; fade out
+</p>
+
+<pre class="indented">
+(filtered-env '(0 1 1 0)) ; fade out
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- formant-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>formant-filter</em> <code>radius frequency</code>
-</td></tr><tr><td></td><td>
-formant-filter applies a formant to its input.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (formant-filter .99 2400))
+<pre class="indented">
+<em class=emdef>formant-filter</em> radius frequency
</pre>
-It's probably faster to use the CLM filter directly:
-<pre>
- (<a class=quiet href="extsnd.html#filtersound" onmouseout="UnTip()" onmouseover="Tip(extsnd_filtersound_tip)">filter-sound</a> (<a class=quiet href="sndclm.html#make-formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_formant_tip)">make-formant</a> 2400 .99))
+
+<p>formant-filter applies a formant to its input.
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (formant-filter .99 2400))
+</pre>
+
+<p>It's probably faster to use the CLM filter directly:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#filtersound">filter-sound</a> (<a class=quiet href="sndclm.html#make-formant">make-formant</a> 2400 .99))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- formants -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>formants</em> <code>r1 f1 r2 f2 r3 f3</code>
-</td></tr><tr><td></td><td>
-formants applies three formants in parallel.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (formants .99 900 .98 1800 .99 2700))
+<pre class="indented">
+<em class=emdef>formants</em> r1 f1 r2 f2 r3 f3
+</pre>
+
+<p>formants applies three formants in parallel.
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (formants .99 900 .98 1800 .99 2700))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- moving-formant -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>moving-formant</em> <code>radius move-envelope</code>
-</td></tr><tr><td></td><td>
-moving-formant moves a formant according to an envelope (the envelope y value is in Hz).
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (moving-formant .99 '(0 1200 1 2400)))
+<pre class="indented">
+<em class=emdef>moving-formant</em> radius move-envelope
+</pre>
+
+<p>moving-formant moves a formant according to an envelope (the envelope y value is in Hz).
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (moving-formant .99 '(0 1200 1 2400)))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- notch-filter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>notch-filter</em> <code>scaler size</code>
-</td></tr><tr><td></td><td>
-This is an example of calling the CLM <a href="sndclm.html#notch">notch</a> filter.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (notch-filter .8 32))
+<pre class="indented">
+<em class=emdef>notch-filter</em> scaler size
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This is an example of calling the CLM <a href="sndclm.html#notch">notch</a> filter.
+</p>
-<!-- osc-formants -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>osc-formants</em> <code>radius bases amounts freqs</code>
-</td></tr><tr><td></td><td>
-osc-formants sets up any number of independently oscillating formants, then calls map-channel.
-<pre>
- Scheme: (osc-formants .99 (vct 400.0 800.0 1200.0) (vct 80.0 80.0 120.0) (vct 4.0 2.0 3.0))
- Ruby: osc_formants(0.99, vct(400, 800, 1200), vct(80, 80, 120), vct(4, 2, 3))
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (notch-filter .8 32))
</pre>
-'bases' are the formant center frequencies; 'freqs' are the oscillator frequencies;
-'amounts' are "deviations" — they scale the oscillator outputs which set the runtime
-formant frequencies (thereby setting the width of the warbling).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
-<!-- virtual-filter-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def NAME="virtualfilterchannel">virtual-filter-channnel</a> <code>coeffs beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-This is a virtual edit version of <a href="extsnd.html#filterchannel">filter-channel</a>.
-<pre>
- (virtual-filter-channel (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 1.0 .5 .25) 0 10 0 0 1)
+
+<!-- osc-formants -->
+<pre class="indented">
+<em class=emdef>osc-formants</em> radius bases amounts freqs
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+<p>osc-formants sets up any number of independently oscillating formants, then calls map-channel.
+</p>
+
+<pre class="indented">
+Scheme: (osc-formants .99 (float-vector 400.0 800.0 1200.0) (float-vector 80.0 80.0 120.0) (float-vector 4.0 2.0 3.0))
+Ruby: osc_formants(0.99, vct(400, 800, 1200), vct(80, 80, 120), vct(4, 2, 3))
+</pre>
+<p>'bases' are the formant center frequencies; 'freqs' are the oscillator frequencies;
+'amounts' are "deviations" — they scale the oscillator outputs which set the runtime
+formant frequencies (thereby setting the width of the warbling).
+</p>
+<div class="spacer"></div>
-<!-- -------------------------------- examp SOUND EFFECTS -------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="sseffects">sound effects</A></center></td><td></td></tr>
+<!-- examp SOUND EFFECTS -->
+<div class="innerheader" id="sseffects">sound effects</div>
<!-- add-notes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>add-notes</em> <code>notes snd chn</code>
-</td></tr><tr><td></td><td>
-add-notes adds (mixes) 'notes' starting at the cursor in the currently selected channel.
-'notes' is a list of lists of the form: <code>(list file offset amp)</code>.
-<pre>
- Scheme: (add-notes '(("oboe.snd")
- ("pistol.snd" 1.0 2.0)))
+<pre class="indented">
+<em class=emdef>add-notes</em> notes snd chn
+</pre>
+
+<p>add-notes adds (mixes) 'notes' starting at the cursor in the currently selected channel.
+'notes' is a list of lists of the form: (list file offset amp).
+</p>
+
+<pre class="indented">
+Scheme: (add-notes '(("oboe.snd")
+ ("pistol.snd" 1.0 2.0)))
- Ruby: add_notes([["oboe.snd"],
- ["pistol.snd", 1.0, 2.0]])
+Ruby: add_notes([["oboe.snd"],
+ ["pistol.snd", 1.0, 2.0]])
</pre>
-This mixes "oboe.snd" at time 0.0,
+
+<p>This mixes "oboe.snd" at time 0.0,
then "pistol.snd" at 1.0 (second) scaled by 2.0.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- am -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>am</em> <code>freq</code><br>
-<em class=emdef>ring-mod</em> <code>freq gliss-env</code><br>
-<em class=emdef>ring-modulate-channel</em> <code>freq beg dur snd chn edpos</code><br>
-<em class=emdef>vibro</em> <code>speed depth</code>
-</td></tr><tr><td></td><td>
-These functions perform amplitude modulation and ring-modulation. 'freq' is the modulation frequency.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (am 440))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (ring-mod 10 (list 0 0 1 (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> 100))))
- (ring-modulate-channel 100.0)
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (vibro 440 0.5))
+<pre class="indented">
+<em class=emdef>am</em> freq
+<em class=emdef>ring-mod</em> freq gliss-env
+<em class=emdef>ring-modulate-channel</em> freq beg dur snd chn edpos
+<em class=emdef>vibro</em> speed depth
+</pre>
+
+<p>These functions perform amplitude modulation and ring-modulation. 'freq' is the modulation frequency.
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (am 440))
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (ring-mod 10 (list 0 0 1 (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> 100))))
+(ring-modulate-channel 100.0)
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (vibro 440 0.5))
</pre>
-am uses the CLM <a href="sndclm.html#amplitude-modulate">amplitude-modulate</a> generator;
+
+<p>am uses the CLM <a href="sndclm.html#amplitude-modulate">amplitude-modulate</a> generator;
the others are little more than <a href="sndclm.html#oscil">oscil</a> and a multiply.
'gliss-env' in ring-mod controls the frequency of the modulation.
-ring-modulate-channel uses <a href="extsnd.html#ptreechannel">ptree-channel</a> for maximum speed and efficiency.
See also <a href="sndclm.html#ssb-am">ssb-am</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- chain-dsps -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="chaindsps">chain-dsps</a> <code>beg dur :rest dsps</code>
-</td></tr><tr><td></td><td>
-chain-dsps creates a patch of chained generators from its arguments.
+<pre class="indented">
+<em class=def id="chaindsps">chain-dsps</em> beg dur :rest dsps
+</pre>
+
+<p>chain-dsps creates a patch of chained generators from its arguments.
Someone wanted to set up generator patches in a note list:
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (chain-dsps 0 1.0 '(0 0 1 .25 2 0) (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 440))
- (chain-dsps 1.0 1.0 '(0 0 1 1 2 0) (<a class=quiet href="sndclm.html#make-one-zero" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_one_zero_tip)">make-one-zero</a> .5) (<a class=quiet href="sndclm.html#make-readin" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_readin_tip)">make-readin</a> "oboe.snd"))
- (chain-dsps 2.0 1.0 '(0 0 1 .125 2 0) (let ((osc1 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 220))
- (osc2 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 440)))
- (lambda (val) (+ (osc1 val)
- (osc2 (* 2 val)))))))
-</pre>
-The 'dsps' is a sequence of breakpoint lists and generators; the breakpoint lists
+</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (chain-dsps 0 1.0 '(0 0 1 .25 2 0) (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> 440))
+ (chain-dsps 1.0 1.0 '(0 0 1 1 2 0) (<a class=quiet href="sndclm.html#make-one-zero">make-one-zero</a> .5) (<a class=quiet href="sndclm.html#make-readin">make-readin</a> "oboe.snd"))
+ (chain-dsps 2.0 1.0 '(0 0 1 .125 2 0) (let ((osc1 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> 220))
+ (osc2 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> 440)))
+ (lambda (val) (+ (osc1 val)
+ (osc2 (* 2 val)))))))
+</pre>
+
+<p>The 'dsps' is a sequence of breakpoint lists and generators; the breakpoint lists
are treated as envelopes, and the generators are connected (previous) output to (current) input in the reverse of the order
received. <a href="sndclm.html#readin">readin</a> is an exception; since its input comes
from a file, it is added to the current output.
@@ -3964,303 +4562,348 @@ So, the first call is an <a href="sndclm.html#oscil">oscil</a> multiplied
by an envelope. The second filters and envelopes readin input.
The third sets up an additive synthesis patch.
In Ruby, this example is:
-<pre>
- with_sound() do
- chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0], make_oscil(:frequency, 440))
- chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0], make_one_pole(0.5), make_readin("oboe.snd"))
- chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0],
- let(make_oscil(:frequency, 220),
- make_oscil(:frequency, 440))
- do |osc1, osc2|
- lambda do |val|
- osc1.run(val) + osc2.run(2.0 * val)
- end
- end)
- end
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+
+<pre class="indented">
+with_sound() do
+ chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0], make_oscil(:frequency, 440))
+ chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0], make_one_pole(0.5), make_readin("oboe.snd"))
+ chain_dsps(0, 1.0, [0, 0, 1, 1, 2, 0],
+ let(make_oscil(:frequency, 220),
+ make_oscil(:frequency, 440))
+ do |osc1, osc2|
+ lambda do |val|
+ osc1.run(val) + osc2.run(2.0 * val)
+ end
+ end)
+end
+</pre>
+
+<div class="spacer"></div>
<!-- compand -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>compand</em> <br>
-<a class=def name="compandchannel">compand-channel</a> <code>beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-These functions lookup a table value based on the current sample amplitude; the table is set up
-so that soft portions are slightly amplified. compand-channel is the same as compand except
-that it uses <a href="extsnd.html#ptreechannel">ptree-channel</a>. The companding curve is
-taken from Steiglitz "A DSP Primer".
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (compand))
- (compand-channel)
+<pre class="indented">
+<em class=emdef>compand</em>
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- compand-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="compandsound">compand-sound</a> <code>(beg 0) dur snd</code>
-</td></tr><tr><td width=30></td><td>
-compand-sound applies companding to every channel of the sound 'snd'.
-It is the multichannel version of <a href="#compandchannel">compand-channel</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>These functions lookup a table value based on the current sample amplitude; the table is set up
+so that soft portions are slightly amplified.
+The companding curve is
+taken from Steiglitz "A DSP Primer".
+</p>
+<div class="spacer"></div>
<!-- cnvtest -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>cnvtest</em> <code>snd0 snd1 amp</code>
-</td></tr><tr><td></td><td>
-This is an example of using convolution.
+<pre class="indented">
+<em class=emdef>cnvtest</em> snd0 snd1 amp
+</pre>
+
+<p>This is an example of using convolution.
It convolves 'snd0' and 'snd1' (using the CLM <a href="sndclm.html#convolve">convolve</a> generator),
then scales by 'amp'. It returns the new maximum amplitude.
-<pre>
- (cnvtest 0 1 .1)
+</p>
+
+<pre class="indented">
+(cnvtest 0 1 .1)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- cross-synthesis -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="crosssynthesis">cross-synthesis</a> <code>cross-snd amp fftsize radius</code>
-</td></tr><tr><td></td><td>
-cross-synthesis performs cross-synthesis between 'cross-snd' (a sound) and the currently
+<pre class="indented">
+<em class=def id="crosssynthesis">cross-synthesis</em> cross-snd amp fftsize radius
+</pre>
+
+<p>cross-synthesis performs cross-synthesis between 'cross-snd' (a sound) and the currently
selected sound.
'cross-snd' is the sound that controls the spectra.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (cross-synthesis 1 .5 128 6.0))
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (cross-synthesis 1 .5 128 6.0))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- echo -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>echo</em> <code>scaler secs</code><br>
-<em class=emdef>flecho</em> <code>scaler secs</code><br>
-<a class=def NAME="zecho">zecho</a> <code>scaler secs frq amp</code>
-</td></tr><tr><td></td><td>
-These are delay-based sound effects.
+<pre class="indented">
+<em class=emdef>echo</em> scaler secs
+<em class=emdef>flecho</em> scaler secs
+<em class=def id="zecho">zecho</em> scaler secs frq amp
+</pre>
+
+<p>These are delay-based sound effects.
echo returns an echo maker ('secs' is the delay in seconds between echos, 'scaler' is
the amplitude ratio between successive echoes).
zecho is similar, but also modulates the echoes.
flecho is a low-pass filtered echo maker.
See <a href="grfsnd.html#sndwithclm">Snd with CLM</a> for
a discussion.
-<pre>
- Scheme:
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (echo .5 .5) 0 44100)
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (zecho .5 .75 6 10.0) 0 65000)
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (flecho .5 .9) 0 75000)
+</p>
+
+<pre class="indented">
+Scheme:
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (echo .5 .5) 0 44100)
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (zecho .5 .75 6 10.0) 0 65000)
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (flecho .5 .9) 0 75000)
- Ruby:
- map_channel(echo(0.5, 0.5), 0 44100)
- map_channel(zecho(0.5, 0.75, 6, 10.0), 0, 65000)
- map_channel(flecho(0.5, 0.9), 0, 75000)
+Ruby:
+map_channel(echo(0.5, 0.5), 0 44100)
+map_channel(zecho(0.5, 0.75, 6, 10.0), 0, 65000)
+map_channel(flecho(0.5, 0.9), 0, 75000)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- expsrc -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="expsrc">expsrc</a> <code>rate snd chn</code>
-</td></tr><tr><td></td><td>
-expsrc uses sampling rate conversion (the <a href="sndclm.html#src">src</a> generator) and granular synthesis (the <a href="sndclm.html#granulate">granulate</a> generator)
+<pre class="indented">
+<em class=def id="expsrc">expsrc</em> rate snd chn
+</pre>
+
+<p>expsrc uses sampling rate conversion (the <a href="sndclm.html#src">src</a> generator) and granular synthesis (the <a href="sndclm.html#granulate">granulate</a> generator)
to change the pitch of a sound without changing its duration.
-<pre>
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (expsrc 2.0)) ; up an octave
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (expsrc 2.0)) ; up an octave
</pre>
-There are lots of other related examples: see for example <a href="#clmexpsrc">clm-expsrc</a>, expsnd below,
+
+<p>There are lots of other related examples: see for example <a href="#clmexpsrc">clm-expsrc</a>, expsnd below,
<a href="#ssbbank">ssb-bank</a>, or the <a href="sndclm.html#phase-vocoder">phase-vocoder</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- expsnd -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="expsnd">expsnd</a> <code>rate-envelope snd chn</code>
-</td></tr><tr><td></td><td>
-expsnd uses the same technique as expsrc, but uses it to change the tempo according to an envelope while
+<pre class="indented">
+<em class=def id="expsnd">expsnd</em> rate-envelope snd chn
+</pre>
+
+<p>expsnd uses the same technique as expsrc, but uses it to change the tempo according to an envelope while
maintaining the original pitch.
expsnd needs dsp.scm (but doesn't check that it is loaded).
-<pre>
- (expsnd '(0 1 2 .4)) ; speed up
- (expsnd '(0 .5 2 2.0)) ; start fast, end slow
+</p>
+
+<pre class="indented">
+(expsnd '(0 1 2 .4)) ; speed up
+(expsnd '(0 .5 2 2.0)) ; start fast, end slow
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- main-index |fp:Forbidden Planet -->
<!-- fp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fp">fp</a> <code>sr osamp osfrq snd chn</code>
-</td></tr><tr><td></td><td>
-fp drives an <a href="sndclm.html#src">src</a> generator with an oscillator, modulating
+<pre class="indented">
+<em class=def id="fp">fp</em> sr osamp osfrq snd chn
+</pre>
+
+<p>fp drives an <a href="sndclm.html#src">src</a> generator with an oscillator, modulating
a sound. 'sr' is the base sampling rate; 'osamp' is the modulation depth; 'osfrq' is
the modulation frequency. hello-dentist below is a randomized version of this. The name "fp"
refers to "Forbidden Planet" which used this kind of sound effect a lot.
-<pre>
- (fp 1.0 .3 20)
+</p>
+
+<pre class="indented">
+(fp 1.0 .3 20)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- hello-dentist -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="hellodentist">hello-dentist</a> <code>frq amp snd chn</code>
-</td></tr><tr><td></td><td>
-hello-dentist drives n <a href="sndclm.html#src">src</a> generator with a <a href="sndclm.html#rand-interp">rand-interp</a>
+<pre class="indented">
+<em class=def id="hellodentist">hello-dentist</em> frq amp snd chn
+</pre>
+
+<p>hello-dentist drives n <a href="sndclm.html#src">src</a> generator with a <a href="sndclm.html#rand-interp">rand-interp</a>
generator, producing a random quavering effect, hence the name.
-<pre>
- (hello-dentist 40.0 .1)
+</p>
+
+<pre class="indented">
+(hello-dentist 40.0 .1)
</pre>
-'frq' is the random number frequency; 'amp' sets the depth of the modulation.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>'frq' is the random number frequency; 'amp' sets the depth of the modulation.
+</p>
+<div class="spacer"></div>
<!-- place-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="placesound">place-sound</a> <code>mono-snd stereo-snd panning-envelope-or-degree</code>
-</td></tr><tr><td></td><td>
-place-sound mixes a mono sound ('mono-snd', an index) into a stereo sound ('stereo-snd')
+<pre class="indented">
+<em class=def id="placesound">place-sound</em> mono-snd stereo-snd panning-envelope-or-degree
+</pre>
+
+<p>place-sound mixes a mono sound ('mono-snd', an index) into a stereo sound ('stereo-snd')
with panning determined by 'panning-envelope-or-degree'.
If 'panning-envelope-or-degree' is a number (in degrees),
the place-sound function has the same effect as using
CLM's <a href="sndclm.html#locsig">locsig</a> generator; it mixes a mono sound into a stereo sound, splitting
it into two copies whose amplitudes depend on the desired location.
0 degrees: all in channel 0, 90: all in channel 1.
-<pre>
- (place-sound 0 1 45.0)
- ;; 0=sound 0 (mono), 1=sound 1 (stereo), 45 deg, so outa * 0.5 and outb * 0.5
+</p>
+
+<pre class="indented">
+(place-sound 0 1 45.0)
+;; 0=sound 0 (mono), 1=sound 1 (stereo), 45 deg, so outa * 0.5 and outb * 0.5
</pre>
-If 'panning-envelope-or-degree' is an envelope,
+
+<p>If 'panning-envelope-or-degree' is an envelope,
the split depends on the panning envelope (0 = all in chan 0, etc).
-<pre>
- (place-sound 0 1 '(0 0 1 1)) ; mix goes from all in outa to all in outb
+</p>
+
+<pre class="indented">
+(place-sound 0 1 '(0 0 1 1)) ; mix goes from all in outa to all in outb
</pre>
-This function could use at least a start time parameter.
-<table border=3 bordercolor="tan" hspace=20 vspace=20><tr><td>
+<p>This function could use at least a start time parameter.
+</p>
+
+<table class="method">
+<tr><td class="methodtitle">Panning or Sound Placement</td></tr>
+<tr><td>
<blockquote><small>
-<br>
-Panning or Sound Placement<br>
Place sound: <a href="#placesound">place-sound</a> above.<br>
-Place mix: <a href="#musmix">mus-mix</a><br>
-Play sound with panning: <a href="#playpanned">play-panned</a><br>
+Place mix: <a href="#musfilemix">mus-file-mix</a><br>
CLM placement generator: <a href="sndclm.html#locsig">locsig</a><br>
CLM moving sound generator: <a href="#dlocsigdoc">dlocsig</a><br>
Move sound via flanging: see flanging effect in new-effects.scm<br>
-Cross fade in frequency domain: <a href="#fadedoc">fade.scm</a><br>
-<br>
+Cross fade in frequency domain: <a href="#fadedoc">fade.scm</a>
</small></blockquote>
</td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
+
<!-- pulse-voice -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>pulse-voice</em> <code>cosines (freq 440.0) (amp 1.0) (fftsize 256) (r 2.0) snd chn</code>
-</td></tr><tr><td></td><td>
-This function is a form of cross-synthesis which drives the resynthesis with a <a href="sndclm.html#ncos">ncos</a> pulse train.
+<pre class="indented">
+<em class=emdef>pulse-voice</em> cosines (freq 440.0) (amp 1.0) (fftsize 256) (r 2.0) snd chn
+</pre>
+
+<p>This function is a form of cross-synthesis which drives the resynthesis with a <a href="sndclm.html#ncos">ncos</a> pulse train.
'freq' is the <a href="sndclm.html#ncos">ncos</a> frequency; 'amp' is an overall amplitude scaler;
'cosines' is the number of cosines in the pulse (the more the spikier);
'fftsize' and 'r' (radius) control the <a href="sndclm.html#formant">formant</a> bank
used to get the current spectrum.
-<pre>
- (pulse-voice 80 20.0 1.0 1024 0.01)
- (pulse-voice 80 120.0 1.0 1024 0.2)
- (pulse-voice 30 240.0 1.0 1024 0.1)
- (pulse-voice 6 1000.0 1.0 512)
+</p>
+
+<pre class="indented">
+(pulse-voice 80 20.0 1.0 1024 0.01)
+(pulse-voice 80 120.0 1.0 1024 0.2)
+(pulse-voice 30 240.0 1.0 1024 0.1)
+(pulse-voice 6 1000.0 1.0 512)
</pre>
-See also voice->unvoiced below.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>See also voice->unvoiced below.
+</p>
+<div class="spacer"></div>
+
<!-- ramp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="makeramp">make-ramp</a> <code>(size 128)</code><br>
-<em class=emdef>ramp</em> <code>gen up</code><br>
-</td></tr><tr><td></td><td>
-ramp is a generator that produces a ramp of a given length, then sticks at 0.0 or 1.0 until the 'up' argument changes.
+<pre class="indented">
+<em class=def id="makeramp">make-ramp</em> (size 128)
+<em class=emdef>ramp</em> gen up
+</pre>
+
+<p>ramp is a generator that produces a ramp of a given length, then sticks at 0.0 or 1.0 until the 'up' argument changes.
The idea here is that we want to ramp in or out a portion of a sound based on some
factor of the sound data; the ramp generator produces a ramp up when 'up' is #t, sticking
at 1.0, and a ramp down when 'up' is #f, sticking at 0.0.
'size' sets the steepness of the ramp.
A similar, less bumpy effect uses the <a href="sndclm.html#moving-average">moving-average</a> generator.
The following produces a very jittery, wandering amplitude envelope (brownian motion):
-<pre>
- (let ((ramper (make-ramp 1000))) ; ramp via increments of .001
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y)
- (* y (ramp ramper (< (random 1.0) .5))))))
+</p>
+
+<pre class="indented">
+(let ((ramper (make-ramp 1000))) ; ramp via increments of .001
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y)
+ (* y (ramp ramper (< (random 1.0) .5))))))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- reverse-by-blocks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="reversebyblocks">reverse-by-blocks</a> <code>block-len snd chn</code><br>
-<em class=emdef>reverse-within-blocks</em> <code>block-len snd chn</code>
-</td></tr><tr><td></td><td>
-reverse-by-blocks and reverse-within-blocks work best with
+<pre class="indented">
+<em class=def id="reversebyblocks">reverse-by-blocks</em> block-len snd chn
+<em class=emdef>reverse-within-blocks</em> block-len snd chn
+</pre>
+
+<p>reverse-by-blocks and reverse-within-blocks work best with
speech. reverse-by-blocks divides a sound into blocks, then recombines those blocks in reverse order.
reverse-within-blocks divides a sound into blocks, then recombines them in order, but with each block internally reversed.
'block-len' is the block length in seconds.
-<pre>
- (reverse-by-blocks .1)
- (reverse-within-blocks .1) ; .5 is also good
+</p>
+
+<pre class="indented">
+(reverse-by-blocks .1)
+(reverse-within-blocks .1) ; .5 is also good
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- scramble-channels -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>scramble-channels</em> <code>:rest new-order</code><br>
-<em class=emdef>scramble-channel</em> <code>silence</code>
-</td></tr><tr><td></td><td>
-scramble-channels uses <a href="extsnd.html#swapchannels">swap-channels</a>
+<pre class="indented">
+<em class=emdef>scramble-channels</em> :rest new-order
+<em class=emdef>scramble-channel</em> silence
+</pre>
+
+<p>scramble-channels uses <a href="extsnd.html#swapchannels">swap-channels</a>
to arbitrarily reorder the current sound's channels. The new channel order
is 'new-order' so
-<pre>
- (scramble-channels 3 2 0 1)
+</p>
+
+<pre class="indented">
+(scramble-channels 3 2 0 1)
</pre>
-replaces chan0 with chan3, chan1 with chan2 and so on.
+
+<p>replaces chan0 with chan3, chan1 with chan2 and so on.
scramble-channel searches for silences, sets up a list of segments based on
those silences, and randomly re-orders the segments.
'silence' determines the background level that is treated as silence.
-<pre>
- (scramble-channel .01)
-</pre>
-This function needs cleaner splices between the sections.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<pre class="indented">
+(scramble-channel .01)
+</pre>
-<!-- smooth-channel-via-ptree -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>smooth-channel-via-ptree</em> <code>beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-This function is a "virtual edit" (<a href="extsnd.html#ptreechannel">ptree-channel</a>) version of
-<a href="extsnd.html#smoothchannel">smooth-channel</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This function needs cleaner splices between the sections.
+</p>
+<div class="spacer"></div>
<!-- sound-interp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="soundinterp">sound-interp</a> <code>reader loc</code><br>
-<em class=emdef>make-sound-interp</em> <code>start snd chn</code><br>
-<a class=def name="envsoundinterp">env-sound-interp</a> <code>envelope (time-scale 1.0) snd chn</code><br>
-<table border=0><tr><td colspan=2><a class=def name="granulatedsoundinterp">granulated-sound-interp</a> <code>envelope (time-scale 1.0) (grain-length 0.10)</code></td></tr><tr><td width=180></td><td><code>(grain-envelope '(0 0 1 1 2 1 3 0)) (output-hop 0.05) snd chn</code></td></tr></table>
-</td></tr><tr><td></td><td>
-make-sound-interp returns an interpolating reader for the given channel.
+<pre class="indented">
+<em class=def id="soundinterp">sound-interp</em> reader loc
+<em class=emdef>make-sound-interp</em> start snd chn
+<em class=def id="envsoundinterp">env-sound-interp</em> envelope (time-scale 1.0) snd chn
+<em class=def id="granulatedsoundinterp">granulated-sound-interp</em> envelope (time-scale 1.0) (grain-length 0.10)
+ (grain-envelope '(0 0 1 1 2 1 3 0)) (output-hop 0.05) snd chn
+</pre>
+
+<p>make-sound-interp returns an interpolating reader for the given channel.
The interpolating reader reads a channel at an arbitary location,
interpolating between samples if necessary. The corresponding generator is sound-interp.
Here we use a sine wave to lookup the current sound:
+</p>
-<pre>
- (let ((osc (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> :frequency 0.5 :initial-phase (+ pi (/ pi 2))))
- (reader (make-sound-interp 0 0 0))
- (len (- (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> 0 0) 1)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (val)
- (sound-interp reader (* len (+ 0.5 (* 0.5 (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> osc))))))))
+<pre class="indented">
+ (let ((osc (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> :frequency 0.5 :initial-phase (+ pi (/ pi 2))))
+ (reader (make-sound-interp 0 0 0))
+ (len (- (<a class=quiet href="extsnd.html#framples">framples</a> 0 0) 1)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (val)
+ (sound-interp reader (* len (+ 0.5 (* 0.5 (<a class=quiet href="sndclm.html#oscil">oscil</a> osc))))))))
</pre>
-This is effectively phase-modulation with an index of length-of-file-in-samples * 0.5 * hz->radians(oscil-frequency),
+<p>This is effectively phase-modulation with an index of length-of-file-in-samples * 0.5 * hz->radians(oscil-frequency),
or equivalently duration-in-seconds * frequency-in-Hz * pi.
env-sound-interp reads the given channel (via a sound-interp generator)
according to 'envelope' and 'time-scale',
@@ -4268,296 +4911,360 @@ returning a new version of the data in the specified channel
that follows that envelope; that is, when the envelope is 0.0 we get sample 0, when the
envelope is 1.0 we get the last sample, when it is 0.5 we get the middle sample of the
sound and so on.
-<pre>
- Scheme: (env-sound-interp '(0 0 1 1))
- Ruby: env_sound_interp([0, 0, 1, 1])
-</pre>
-returns an unchanged copy of the
+</p>
+
+<pre class="indented">
+Scheme: (env-sound-interp '(0 0 1 1))
+Ruby: env_sound_interp([0, 0, 1, 1])
+</pre>
+
+<p>returns an unchanged copy of the
current sound. To get the entire sound in reverse:
-<pre>
- Scheme: (env-sound-interp '(0 1 1 0))
- Ruby: env_sound_interp([0, 1, 1, 0])
+</p>
+
+<pre class="indented">
+Scheme: (env-sound-interp '(0 1 1 0))
+Ruby: env_sound_interp([0, 1, 1, 0])
</pre>
-And to go forward then backward, taking twice the original duration:
-<pre>
- Scheme: (env-sound-interp '(0 0 1 1 2 0) 2.0)
- Ruby: env_sound_interp([0, 0, 1, 1, 2, 0], 2.0)
+
+<p>And to go forward then backward, taking twice the original duration:
+</p>
+
+<pre class="indented">
+Scheme: (env-sound-interp '(0 0 1 1 2 0) 2.0)
+Ruby: env_sound_interp([0, 0, 1, 1, 2, 0], 2.0)
</pre>
-<a href="extsnd.html#srcsound">src-sound</a> with an
+
+<p><a href="extsnd.html#srcsound">src-sound</a> with an
envelope could be used for this effect, but it is much more direct to apply the
envelope to sound sample positions. A similar function is <a href="#scratch">scratch</a> in clm-ins.scm.
-<br><br>
-granulated-sound-interp is similar to env-sound-interp, but uses granular synthesis rather than
+</p>
+
+<p>granulated-sound-interp is similar to env-sound-interp, but uses granular synthesis rather than
sampling rate conversion to recreate the sound, so the effect is one of changing tempo rather
than changing speed (pitch). Here we dawdle for awhile, then race at the end to get the whole sound in:
-<pre>
- (granulated-sound-interp '(0 0 1 .1 2 1) 1.0 0.2 '(0 0 1 1 2 0))
+</p>
+
+<pre class="indented">
+(granulated-sound-interp '(0 0 1 .1 2 1) 1.0 0.2 '(0 0 1 1 2 0))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
+
<!-- voiced->unvoiced -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="voicedtounvoiced">voiced->unvoiced</a> <code>amp fftsize r tempo snd chn</code>
-</td></tr><tr><td></td><td>
-This function is a form of cross-synthesis which drives the resynthesis with white noise (see also pulse-voice above).
-<pre>
- (voiced->unvoiced 1.0 256 2.0 2.0) ; whispered, twice as fast as original
+<pre class="indented">
+<em class=def id="voicedtounvoiced">voiced->unvoiced</em> amp fftsize r tempo snd chn
+</pre>
+
+<p>This function is a form of cross-synthesis which drives the resynthesis with white noise (see also pulse-voice above).
+</p>
+
+<pre class="indented">
+ (voiced->unvoiced 1.0 256 2.0 2.0) ; whispered, twice as fast as original
</pre>
-'tempo' is the speed of the resynthesis.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+
+<p>'tempo' is the speed of the resynthesis.
+</p>
+
-<!-- -------------------------------- examp MARKS -------------------------------- -->
+<!-- examp MARKS -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="ssmarks">marks</A></center></td><td></td></tr>
+<div class="innerheader" id="ssmarks">marks</div>
<!-- first-mark-in-window-at-left -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>first-mark-in-window-at-left</em>
-</td></tr><tr><td></td><td>
-first-mark-in-window-at-left moves the (time domain)
+</pre>
+
+<p>first-mark-in-window-at-left moves the (time domain)
graph so that the leftmost visible mark is at the left edge.
In large sounds it can be pain to get the left edge of the window
-aligned with a specific spot in the sound. In the following code, we assume
+aligned with a specific spot in the sound. In the following example, we assume
the desired left edge has a mark, and the 'l' key (without control)
will move the window left edge to that mark.
-<pre>
- (<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\l 0
- (lambda ()
- "move window to align with mark"
- (first-mark-in-window-at-left)))
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> #\l 0 first-mark-in-window-at-left)
+</pre>
+
+<div class="spacer"></div>
+
<!-- mark-loops -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="markloops">mark-loops</a>
-</td></tr><tr><td></td><td>
-mark-loops places marks at any loop points found in the current sound's header.
+<pre class="indented">
+<em class=def id="markloops">mark-loops</em>
+</pre>
+
+<p>mark-loops places marks at any loop points found in the current sound's header.
Only a few headers support loop points which are apparently used in synthesizers
to mark portions of a waveform that can be looped without causing clicks, thereby lengthening
a sound as a key is held down.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+</p>
-<!-- -------------------------------- examp SELECTIONS -------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="ssselections">selections</A></center></td><td></td></tr>
+<!-- examp SELECTIONS -->
+
+<div class="innerheader" id="ssselections">selections</div>
<!-- region-play-list -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="regionplaylist">region-play-list</a> <code>data</code><br>
-<em class=emdef>region-play-sequence</em> <code>data</code>
-</td></tr><tr><td></td><td>
-region-play-list plays a list of regions. 'data' is list of lists:
-<code>(list (list reg time)...)</code>; region 'reg' is played at time 'time' (in seconds).
-<pre>
- (region-play-list (list (list reg0 0.0) (list reg1 0.5) (list reg2 1.0) (list reg0 1.0)))
+<pre class="indented">
+<em class=def id="regionplaylist">region-play-list</em> data
+<em class=emdef>region-play-sequence</em> data
+</pre>
+
+<p>region-play-list plays a list of regions. 'data' is list of lists:
+(list (list reg time)...); region 'reg' is played at time 'time' (in seconds).
+</p>
+
+<pre class="indented">
+(region-play-list (list (list reg0 0.0) (list reg1 0.5) (list reg2 1.0) (list reg0 1.0)))
</pre>
-which plays region reg0 at time 0.0 and 1.0, region reg1 at 0.5, and region reg2 at 1.0.
+
+<p>which plays region reg0 at time 0.0 and 1.0, region reg1 at 0.5, and region reg2 at 1.0.
Similarly, region-play-sequence plays a sequence of regions, one after the other:
-<pre>
- (region-play-sequence (list reg0 reg1 reg2 reg0)) ; play in same order as before, but one after the other
+</p>
+
+<pre class="indented">
+(region-play-sequence (list reg0 reg1 reg2 reg0)) ; play in same order as before, but one after the other
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- region-rms -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="regionrms">region-rms</a> <code>reg</code>
-</td></tr><tr><td></td><td>
-region-rms returns the rms value of the region's data (in chan 0).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="regionrms">region-rms</em> reg
+</pre>
+
+<p>region-rms returns the rms value of the region's data (in chan 0).
+</p>
+
+<div class="spacer"></div>
<!-- selection-rms -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="selectionrms">selection-rms</a>
-</td></tr><tr><td></td><td>
-selection-rms returns the rms value of the selection's data (in chan 0).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="selectionrms">selection-rms</em>
+</pre>
+<p>selection-rms returns the rms value of the selection's data (in chan 0).
+</p>
-<!-- -------------------------------- examp GRAPHICS -------------------------------- -->
+<!-- examp GRAPHICS -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="ssgraphics">graphics</A></center></td><td></td></tr>
+<div class="innerheader" id="ssgraphics">graphics</div>
<!-- auto-dot -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>auto-dot</em> <code>snd chn y0 y1</code>
-</td></tr><tr><td></td><td>
-auto-dot sets the dot size (when you're using dots in the time domain) based on
+<pre class="indented">
+<em class=emdef>auto-dot</em> snd chn y0 y1
+</pre>
+
+<p>auto-dot sets the dot size (when you're using dots in the time domain) based on
the current graph size.
-<pre>
- (hook-push <a class=quiet href="extsnd.html#graphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_graphhook_tip)">graph-hook</a> auto-dot)
+</p>
+
+<pre class="indented">
+(hook-push <a class=quiet href="extsnd.html#graphhook">graph-hook</a> auto-dot)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- display-db -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="displaydb">display-db</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-display-db is a <a href="extsnd.html#lispgraphhook">lisp-graph-hook</a> function to display the time domain data in dB.
-<pre>
- (hook-push <a class=quiet href="extsnd.html#lispgraphhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_lispgraphhook_tip)">lisp-graph-hook</a> display-db)
+<pre class="indented">
+<em class=def id="displaydb">display-db</em> snd chn
</pre>
-I just noticed that its y axis is labelled upside down.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>display-db is a <a href="extsnd.html#lispgraphhook">lisp-graph-hook</a> function to display the time domain data in dB.
+</p>
+
+<pre class="indented">
+(hook-push <a class=quiet href="extsnd.html#lispgraphhook">lisp-graph-hook</a> display-db)
+</pre>
+
+<p>I just noticed that its y axis is labelled upside down.
+</p>
+<div class="spacer"></div>
+
<!-- display-energy -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="displayenergy">display-energy</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-display-energy is a <a href="extsnd.html#lispgraphhook">lisp-graph-hook</a> function to display the time domain data squared.
+<pre class="indented">
+<em class=def id="displayenergy">display-energy</em> snd chn
+</pre>
+
+<p>display-energy is a <a href="extsnd.html#lispgraphhook">lisp-graph-hook</a> function to display the time domain data squared.
<a href="extsnd.html#xdisplayenergy">Here</a> is a picture of it in action.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- flash-selected-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>flash-selected-data</em> <code>time-interval</code>
-</td></tr><tr><td></td><td>
-flash-selected-data causes the selected channel's graph to
+<pre class="indented">
+<em class=emdef>flash-selected-data</em> time-interval
+</pre>
+
+<p>flash-selected-data causes the selected channel's graph to
flash red and green. 'time-interval' is in milliseconds:
-<pre>
- (flash-selected-data 100)
+</p>
+
+<pre class="indented">
+(flash-selected-data 100)
</pre>
-Not sure why anyone would want such a thing...
+
+<p>Not sure why anyone would want such a thing...
examp.scm also has (commented out) functions to display colored text
in rxvt:
-<pre>
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~Athis is red!~Abut this is not" red-text normal-text))
- (display (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~A~Ahiho~Ahiho" yellow-bg red-fg normal-text))
+</p>
+
+<pre class="indented">
+(<a class=quiet>format</a> #t "~Athis is red!~Abut this is not" red-text normal-text)
+(<a class=quiet>format</a> #t "~A~Ahiho~Ahiho" yellow-bg red-fg normal-text)
</pre>
-It's possible to use the same escape sequences in a normal shell script, of course:
-<pre>
- echo '\e[41m This is red! \e[0m'
+
+<p>It's possible to use the same escape sequences in a normal shell script, of course:
+</p>
+
+<pre class="indented">
+echo '\e[41m This is red! \e[0m'
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-<!-- -------------------------------- examp MISCELLANEOUS EXTENSIONS -------------------------------- -->
-<tr><td colspan=2 bgcolor="lightgreen"><center><A NAME="ssmisc">miscellaneous stuff</A></center></td><td></td></tr>
+<!-- examp MISCELLANEOUS EXTENSIONS -->
+
+<div class="innerheader" id="ssmisc">miscellaneous stuff</div>
<!-- all-chans -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="allchans">all-chans</a>
-</td></tr><tr><td></td><td>
-all-chans returns two parallel lists, the first a list of sound objects, the second of channel numbers. If we have
-two sounds open (indices 0 and 1 for example), and the second has two channels, <code>(all-chans)</code> returns
-<code>'((#<sound 0> #<sound 1> #<sound 1>) (0 0 1))</code>.
-The interpretation is: <code>'((sound-with-index0 sound-with-index1 sound-with-index1) (chan0 chan0 chan1))</code>,
-so if we're mapping some function with the usual <code>snd chn</code> parameters over all the current channels,
+<pre class="indented">
+<em class=def id="allchans">all-chans</em>
+</pre>
+
+<p>all-chans returns two parallel lists, the first a list of sound objects, the second of channel numbers. If we have
+two sounds open (indices 0 and 1 for example), and the second has two channels, (all-chans) returns
+'((#<sound 0> #<sound 1> #<sound 1>) (0 0 1)).
+The interpretation is: '((sound-with-index0 sound-with-index1 sound-with-index1) (chan0 chan0 chan1)),
+so if we're mapping some function with the usual snd chn parameters over all the current channels,
we can get the sound and channel values from these lists.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- channel-clipped? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>channel-clipped?</em> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-channel-clipped? returns #t and a sample number if it finds clipping in the given channel.
+<pre class="indented">
+<em class=emdef>channel-clipped?</em> snd chn
+</pre>
+
+<p>channel-clipped? returns #t and a sample number if it finds clipping in the given channel.
examp.scm also has commented out code that places a mark at the start of each clipped
section in a sound, and adds a menu item ("Show Clipping") under the View menu.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
+
<!-- do-chans -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>do-chans</em> <code>func origin</code><br>
-<em class=emdef>do-all-chans</em> <code>func origin</code><br>
-<em class=emdef>do-sound-chans</em> <code>func origin</code>
-</td></tr><tr><td></td><td>
-do-chans applies 'func' to all the sync'd channels using 'origin' as the edit history indication.
+<pre class="indented">
+<em class=emdef>do-chans</em> func origin
+<em class=emdef>do-all-chans</em> func origin
+<em class=emdef>do-sound-chans</em> func origin
+</pre>
+
+<p>do-chans applies 'func' to all the sync'd channels using 'origin' as the edit history indication.
do-all-chans is the same but applies 'func' to all channels of all sounds.
do-sound-chans applies 'func' to all channels in the currently selected sound.
-<pre>
- (do-all-chans (lambda (val) (* 2.0 val))) ; double all samples
+</p>
+
+<pre class="indented">
+(do-all-chans (lambda (val) (* 2.0 val))) ; double all samples
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- every-sample? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="everysample">every-sample?</a> <code>func</code>
-</td></tr><tr><td></td><td>
-every-sample? applies 'func' to each sample in the current channel and returns
+<pre class="indented">
+<em class=def id="everysample">every-sample?</em> func
+</pre>
+
+<p>every-sample? applies 'func' to each sample in the current channel and returns
#t if 'func' is not #f for all samples; otherwise it moves the cursor to the first offending sample.
-<pre>
- :<em class=typing>(every-sample? (lambda (y) (< (abs y) .1)))</em>
- <em class=listener>#f</em>
- :<em class=typing>(cursor)</em>
- <em class=listener>4423</em>
- :<em class=typing>(sample (cursor))</em>
- <em class=listener>0.101104736328125</em>
+</p>
+
+<pre class="indented">
+> (every-sample? (lambda (y) (< (abs y) .1)))
+#f
+> (cursor)
+4423
+> (sample (cursor))
+0.101104736328125
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- explode-sf2 -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="explodesf2">explode-sf2</a>
-</td></tr><tr><td></td><td>
-explode-sf2 turns a soundfont file (assuming it
+<pre class="indented">
+<em class=def id="explodesf2">explode-sf2</em>
+</pre>
+
+<p>explode-sf2 turns a soundfont file (assuming it
is the currently selected sound) into a bunch of files of the form sample-name.aif.
It is based on <a href="extsnd.html#soundfontinfo">soundfont-info</a>; that documentation
includes a function, mark-sf2, that places a named mark at start of each new member of the font
and unnamed marks at the various loop points.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- find-click -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>find-click</em> <code>loc</code>
-</td></tr><tr><td></td><td>
-find-click finds the next click, starting its search at 'loc'.
+<pre class="indented">
+<em class=emdef>find-click</em> loc
+</pre>
+
+<p>find-click finds the next click, starting its search at 'loc'.
It returns #f if it can't find a click.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- finfo -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="finfo">finfo</a> <code>filename</code>
-</td></tr><tr><td></td><td>
-finfo returns a description of the file 'filename'.
-<pre>
- :<em class=typing>(finfo "oboe.snd")</em>
- <em class=listener>"oboe.snd: chans: 1, srate: 22050, Sun/Next, big endian short (16 bits), len: 2.305"</em>
+<pre class="indented">
+<em class=def id="finfo">finfo</em> filename
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>finfo returns a description of the file 'filename'.
+</p>
+
+<pre class="indented">
+> (finfo "oboe.snd")
+"oboe.snd: chans: 1, srate: 22050, Sun/Next, big endian short (16 bits), len: 2.305"
+</pre>
-<!-- if-cursor-follows-play-it-stays-where-play-stopped -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>if-cursor-follows-play-it-stays-where-play-stopped</em> <code>(enable #t)</code>
-</td></tr><tr><td></td><td>
-If you want the cursor to travel along in the waveform while playing, then stay wherever you stop the
-playback, call this function after setting <a href="extsnd.html#withtrackingcursor">with-tracking-cursor</a> to #t.
-To disable this choice, call it again with #f as the 'enable' argument.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- locate-zero -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>find-pitch</em> <code>pitch</code><br>
-<A class=def NAME="locatezero">locate-zero</a> <code>limit</code><br>
-<em class=emdef>next-peak</em> <br>
-<A class=def NAME="searchforclick">search-for-click</a> <br>
-<A class=def NAME="zeroplus">zero+</a>
-</td></tr><tr><td></td><td>
-locate-zero looks for the next sample where adjacent samples together are less than 'limit'
+<pre class="indented">
+<em class=emdef>find-pitch</em> pitch
+<em class=def id="locatezero">locate-zero</em> limit
+<em class=emdef>next-peak</em>
+<em class=def id="searchforclick">search-for-click</em>
+<em class=def id="zeroplus">zero+</em>
+</pre>
+
+<p>locate-zero looks for the next sample where adjacent samples together are less than 'limit'
and moves the cursor to that sample.
The others are
examples of searching procedures (to be used with <a href="snd.html#menufind">C-s</a> and friends):
@@ -4568,312 +5275,348 @@ the next maximum or minimum in the waveform.
search-for-click looks for a click.
find-pitch finds the next
place where 'pitch' (in Hz) is predominate.
-For example, type C-s (in the graph), then in the minibuffer:
-<code>(find-pitch 600)</code>, and if the function finds some place in the sound
+For example, type C-s (in the graph), then in the status area:
+(find-pitch 600), and if the function finds some place in the sound
where 600 Hz seems to be the basic pitch, it moves the cursor there and
-reports the time in the minibuffer text window.
-See also the multichannel case: <a href="#simultaneouszerocrossing">simultaneous-zero-crossing</a> in frame.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+reports the time in the status area text window.
+</p>
+<div class="spacer"></div>
<!-- mpg -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mpg">mpg</a> <code>mpgfile rawfile</code>
-</td></tr><tr><td></td><td>
-mpg uses the "system" function to call mpg123 to translate an MPEG
+<pre class="indented">
+<em class=def id="mpg">mpg</em> mpgfile rawfile
+</pre>
+
+<p>mpg uses the "system" function to call mpg123 to translate an MPEG
format sound file to a headerless ("raw") file containing 16-bit samples.
-<pre>
- (mpg "mpeg.mpg" "mpeg.raw")
-</pre>
-This is now built-in if the Snd configuration process can find mpg123.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- open-buffer -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="openbuffer">open-buffer</a> <code>filename</code><br>
-<em class=emdef>close-buffer</em> <code>snd</code>
-</td></tr><tr><td></td><td>
-These two function implement a "Buffers" menu
-which provides a list of currently open sounds; select one
-in the menu to make it the selected sound; open-buffer
-adds a menu item that selects a file, close-buffer removes it.
-To activate this, we need
-to:
-<pre>
- (hook-push <a class=quiet href="extsnd.html#openhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_openhook_tip)">open-hook</a> open-buffer)
- (hook-push <a class=quiet href="extsnd.html#closehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_closehook_tip)">close-hook</a> close-buffer)
+</p>
+
+<pre class="indented">
+(mpg "mpeg.mpg" "mpeg.raw")
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>This is now built-in if the Snd configuration process can find mpg123.
+</p>
+<div class="spacer"></div>
<!-- open-next-file-in-directory -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="opennextfileindirectory">open-next-file-in-directory</a> <br>
+<pre class="indented">
+<em class=def id="opennextfileindirectory">open-next-file-in-directory</em>
<em class=emdef>click-middle-button-to-open-next-file-in-directory</em>
-</td></tr><tr><td></td><td>
-click-middle-button-to-open-next-file-in-directory sets up the mouse-click-hook and open-hook so that clicking the middle
+</pre>
+
+<p>click-middle-button-to-open-next-file-in-directory sets up the mouse-click-hook and open-hook so that clicking the middle
mouse button closes the current file and opens the next (alphabetical
by filename) in the current directory. These are used in edit123.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- play-ac3 -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>play-ac3</em> <code>name</code>
-</td></tr><tr><td></td><td>
-play-ac3 tries to play an AC3 encoded sound file by calling a52dec.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>play-ac3</em> name
+</pre>
+
+<p>play-ac3 tries to play an AC3 encoded sound file by calling a52dec.
+</p>
+<div class="spacer"></div>
<!-- read-ascii -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>read-ascii</em> <code>file (out-filename "test.snd") (out-type mus-next) (out-format mus-bshort) (out-srate 44100)</code>
-</td></tr><tr><td></td><td>
-read-ascii tries to turn a text file into a sound file.
+<pre class="indented">
+<em class=emdef>read-ascii</em> file (out-filename "test.snd") (out-type mus-next) (out-format mus-bshort) (out-srate 44100)
+</pre>
+
+<p>read-ascii tries to turn a text file into a sound file.
Octave or perhaps WaveLab produce these files; each line has one integer (as text), apparently a signed short.
The read-ascii parameters describe the output file.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- read-flac -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>read-flac</em> <code>file</code><br>
-<em class=emdef>write-flac</em> <code>snd</code>
-</td></tr><tr><td></td><td>
-read-flac and write-flac deal with FLAC files. This is now built into Snd if the flac
+<pre class="indented">
+<em class=emdef>read-flac</em> file
+<em class=emdef>write-flac</em> snd
+</pre>
+
+<p>read-flac and write-flac deal with FLAC files. This is now built into Snd if the flac
program can be found at configuration time.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- read-ogg -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>read-ogg</em> <code>file</code><br>
-<em class=emdef>write-ogg</em> <code>snd</code>
-</td></tr><tr><td></td><td>
-read-ogg and write-ogg deal with OGG files. This is now built into Snd if the oggdec and offenc
+<pre class="indented">
+<em class=emdef>read-ogg</em> file
+<em class=emdef>write-ogg</em> snd
+</pre>
+
+<p>read-ogg and write-ogg deal with OGG files. This is now built into Snd if the oggdec and offenc
programs can be found at configuration time.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- read-speex -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>read-speex</em> <code>file</code><br>
-<em class=emdef>write-speex</em> <code>snd</code>
-</td></tr><tr><td></td><td>
-read-speex and write-speex deal with SPEEX files. This is now built into Snd if speexdec and speexenc
+<pre class="indented">
+<em class=emdef>read-speex</em> file
+<em class=emdef>write-speex</em> snd
+</pre>
+
+<p>read-speex and write-speex deal with SPEEX files. This is now built into Snd if speexdec and speexenc
can be found at configuration time.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- remove-clicks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="removeclicks">remove-clicks</a>
-</td></tr><tr><td></td><td>
-remove-clicks looks for obvious clicks and uses smooth-sound to remove them.
+<pre class="indented">
+<em class=def id="removeclicks">remove-clicks</em>
+</pre>
+
+<p>remove-clicks looks for obvious clicks and uses smooth-sound to remove them.
See also remove-single-sample-clicks and remove-pops in clean.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- sounds->segment-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def NAME="soundstosegmentdata">sounds->segment-data</a> <code>main-dir (output-file "sounds.data")</code>
-</td></tr><tr><td></td><td>
-This function takes a directory name, and runs through all the sounds in the embedded
+<pre class="indented">
+<em class=def id="soundstosegmentdata">sounds->segment-data</em> main-dir (output-file "sounds.data")
+</pre>
+
+<p>This function takes a directory name, and runs through all the sounds in the embedded
directories, returning a text file with segment start and end times, and segment maxamps.
-<pre>
- (sounds->segment-data "/home/bil/test/iowa/sounds/" "iowa.data")
+</p>
+
+<pre class="indented">
+(sounds->segment-data "/home/bil/test/iowa/sounds/" "iowa.data")
</pre>
-It was written to find the note boundaries in the Iowa musical instrument sound library.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>It was written to find the note boundaries in the Iowa musical instrument sound library.
+</p>
+<div class="spacer"></div>
<!-- sort-samples -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>sort-samples</em> <code>bins</code>
-</td></tr><tr><td></td><td>
-sort-samples provides a histogram of the samples (by amplitude) in 'bins' bins.
-<pre>
- :<em class=typing>(sort-samples 20)</em> ; bins go by 0.05
- <em class=listener>:#(129017 90569 915 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)</em>
- ;; so 915 samples were > 0.1 in absolute value
+<pre class="indented">
+<em class=emdef>sort-samples</em> bins
+</pre>
+
+<p>sort-samples provides a histogram of the samples (by amplitude) in 'bins' bins.
+</p>
+
+<pre class="indented">
+> (sort-samples 20) ; bins go by 0.05
+#(129017 90569 915 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
+;; so 915 samples were > 0.1 in absolute value
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- sync-everything -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="sync-everything">sync-everything</a>
-</td></tr><tr><td></td><td>
-sync-everything sets the sync fields of all currently open sounds to the same unique value.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="sync-everything">sync-everything</em>
+</pre>
+
+<p>sync-everything sets the sync fields of all currently open sounds to the same unique value.
+</p>
+<div class="spacer"></div>
<!-- update-graphs -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="updategraphs">update-graphs</a>
-</td></tr><tr><td></td><td>
-update-graphs updates (redraws) all graphs.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="updategraphs">update-graphs</em>
+</pre>
+
+<p>update-graphs updates (redraws) all graphs.
+</p>
+<div class="spacer"></div>
<!-- window-rms -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>window-rms</em>
-</td></tr><tr><td></td><td>
-window-rms returns the rms of the data in currently selected graph window.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+
+<p>window-rms returns the rms of the data in currently selected graph window.
+</p>
+<div class="spacer"></div>
<!-- window-samples -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="windowsamples">window-samples</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-window-samples returns (in a vct) the samples
+<pre class="indented">
+<em class=def id="windowsamples">window-samples</em> snd chn
+</pre>
+
+<p>window-samples returns (in a float-vector) the samples
displayed in the current window for the given channel.
-This is just a trivial wrapper for <a href="extsnd.html#channeltovct">channel->vct</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+This is just a trivial wrapper for <a href="extsnd.html#channeltovct">channel->float-vector</a>.
+</p>
+<div class="spacer"></div>
<!-- xb-open -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="xbopen">xb-open</a> <code>snd</code><br>
-<em class=emdef>xb-close</em> <code>snd</code><br>
+<pre class="indented">
+<em class=def id="xbopen">xb-open</em> snd
+<em class=emdef>xb-close</em> snd
<em class=emdef>switch-to-buf</em>
-</td></tr><tr><td></td><td>
-These provide Emacs-like C-x b support where only one sound is visible at a time.
-To activate it:
-<pre>
- (<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\b 0 switch-to-buf #t)
- (hook-push <a class=quiet href="extsnd.html#closehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_closehook_tip)">close-hook</a> xb-close)
- (hook-push <a class=quiet href="extsnd.html#afteropenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afteropenhook_tip)">after-open-hook</a> xb-open)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>These provide Emacs-like C-x b support where only one sound is visible at a time.
+To activate it:
+</p>
-</table>
-<br>
-<br>
+<pre class="indented">
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> #\b 0 switch-to-buf #t)
+(hook-push <a class=quiet href="extsnd.html#closehook">close-hook</a> xb-close)
+(hook-push <a class=quiet href="extsnd.html#afteropenhook">after-open-hook</a> xb-open)
+</pre>
-<!-- ---------------------------------------- FILE: extensions ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="extensionsdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>extensions</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: extensions -->
+
+<div class="header" id="extensionsdoc">extensions</div>
<p>These were originally scattered around examp.scm; I thought it would be more
convenient if they were in one file.
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
+<div class="spacer"></div>
<!-- channels-equal? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="channelsequal">channels-equal?</a> <code>snd1 chn1 snd2 chn2 (allowable-difference 0.0)</code><br>
-<a class=def name="channels=">channels=?</a> <code>snd1 chn1 snd2 chn2 (allowable-difference 0.0)</code>
-</td></tr><tr><td width=30></td><td>
-channels=? returns #t if the two specified channels are the same within the
+<pre class="indented">
+<em class=def id="channelsequal">channels-equal?</em> snd1 chn1 snd2 chn2 (allowable-difference 0.0)
+<em class=def id="channelseq">channels=?</em> snd1 chn1 snd2 chn2 (allowable-difference 0.0)
+</pre>
+
+<p>channels=? returns #t if the two specified channels are the same within the
given 'allowable-difference'.
The 'allowable-difference' is checked on each sample, so any sample-wise difference
larger than that causes the comparison to return #f.
channels-equal? returns #t if channels=?
and the channels are the same length. In channels=? one the other hand, the trailing (extra) samples
in one channel are compared with 0.0 (that is, the shorter channel is padded out with zeros).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- channel-sync -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="channelsync">channel-sync</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
-channel-sync uses the channel-properties list to implement a channel-local sync field. (This property is currently
+<pre class="indented">
+<em class=def id="channelsync">channel-sync</em> snd chn
+</pre>
+
+<p>channel-sync uses the channel-properties list to implement a channel-local sync field. (This property is currently
not used anywhere).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- contrast-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="contrastchannel">contrast-channel</a> <code>index beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-contrast-channel applies the CLM <a href="sndclm.html#contrast-enhancement">contrast-enhancement</a> function to a channel;
+<pre class="indented">
+<em class=def id="contrastchannel">contrast-channel</em> index beg dur snd chn edpos
+</pre>
+
+<p>contrast-channel applies the CLM <a href="sndclm.html#contrast-enhancement">contrast-enhancement</a> function to a channel;
this is largely equivalent to the control panel Contrast slider.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- contrast-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="contrastsound">contrast-sound</a> <code>index (beg 0) dur snd</code>
-</td></tr><tr><td width=30></td><td>
-contrast-sound applies <a href="sndclm.html#contrast-enhancement">contrast-enhancement</a> to every channel of the sound 'snd'.
+<pre class="indented">
+<em class=def id="contrastsound">contrast-sound</em> index (beg 0) dur snd
+</pre>
+
+<p>contrast-sound applies <a href="sndclm.html#contrast-enhancement">contrast-enhancement</a> to every channel of the sound 'snd'.
It is the multichannel version of <a href="#contrastchannel">contrast-channel</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- dither-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="ditherchannel">dither-channel</a> <code>(amount .00006) beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-dither-channel adds "dithering" (noise) to a channel; some experts insist this makes everything copacetic.
+<pre class="indented">
+<em class=def id="ditherchannel">dither-channel</em> (amount .00006) beg dur snd chn edpos
+</pre>
+
+<p>dither-channel adds "dithering" (noise) to a channel; some experts insist this makes everything copacetic.
The noise consists of two white noise generators adding together.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- dither-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="dithersound">dither-sound</a> <code>(amount .00006) (beg 0) dur snd</code>
-</td></tr><tr><td width=30></td><td>
-dither-sound adds dithering to every channel of the sound 'snd'.
+<pre class="indented">
+<em class=def id="dithersound">dither-sound</em> (amount .00006) (beg 0) dur snd
+</pre>
+
+<p>dither-sound adds dithering to every channel of the sound 'snd'.
It is the multichannel version of <a href="#ditherchannel">dither-channel</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- enveloped-mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="envelopedmix">enveloped-mix</a> <code>filename beg env</code><br>
-</td></tr><tr><td></td><td>
-enveloped-mix is like <a href="#mixsound">mix-sound</a>, but includes an
+<pre class="indented">
+<em class=def id="envelopedmix">enveloped-mix</em> filename beg env
+</pre>
+
+<p>enveloped-mix is like <a href="#mixsound">mix-sound</a>, but includes an
amplitude envelope over the mixed-in data.
-<pre>
- (enveloped-mix "pistol.snd" 0 '(0 0 1 1 2 0))
+</p>
+
+<pre class="indented">
+(enveloped-mix "pistol.snd" 0 '(0 0 1 1 2 0))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- env-expt-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="envexptchannel">env-expt-channel</a> <code>env exponent (symmetric #t) beg dur snd chn edpos</code><br>
-<a class=def name="anyenvchannel">any-env-channel</a> <code>env func beg dur snd chn edpos</code><br>
-<em class=emdef>ramp-expt</em> <code>a0 a1 exponent (symmetric #t) beg dur snd chn edpos</code><br>
-<a class=def name="sineenvchannel">sine-env-channel</a> <code>env beg dur snd chn edpos</code><br>
-<a class=def name="sineramp">sine-ramp</a> <code>a0 a1 beg dur snd chn edpos</code><br>
-<A class=def NAME="blackman4envchannel">blackman4-env-channel</a> <code>env beg dur snd chn edpos</code><br>
-<em class=emdef>blackman4-ramp</em> <code>a0 a1 beg dur snd chn edpos</code><br>
-<A class=def NAME="envsquaredchannel">env-squared-channel</a> <code>env (symmetric #t) beg dur snd chn edpos</code><br>
-<em class=emdef>ramp-squared</em> <code>a0 a1 (symmetric #t) beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-These functions goof around with envelopes in various amusing ways.
+<pre class="indented">
+<em class=def id="envexptchannel">env-expt-channel</em> env exponent (symmetric #t) beg dur snd chn edpos
+<em class=def id="anyenvchannel">any-env-channel</em> env func beg dur snd chn edpos
+<em class=emdef>ramp-expt</em> a0 a1 exponent (symmetric #t) beg dur snd chn edpos
+<em class=def id="sineenvchannel">sine-env-channel</em> env beg dur snd chn edpos
+<em class=def id="sineramp">sine-ramp</em> a0 a1 beg dur snd chn edpos
+<em class=def id="blackman4envchannel">blackman4-env-channel</em> env beg dur snd chn edpos
+<em class=emdef>blackman4-ramp</em> a0 a1 beg dur snd chn edpos
+<em class=def id="envsquaredchannel">env-squared-channel</em> env (symmetric #t) beg dur snd chn edpos
+<em class=emdef>ramp-squared</em> a0 a1 (symmetric #t) beg dur snd chn edpos
+</pre>
+
+<p>These functions goof around with envelopes in various amusing ways.
any-env-channel takes an envelope and a function to produce the connection between successive
breakpoints, and applies the two to the current channel as an envelope. This packages up most of
the "boilerplate" associated with applying an envelope to a sound. It is used by the other
enveloping functions: sine-env-channel, blackman4-env-channel, and env-squared-channel.
sine-ramp and sine-env-channel are the sinusoidal versions of <a href="extsnd.html#rampchannel">ramp-channel</a>
and <a href="extsnd.html#envchannel">env-channel</a>.
-<pre>
- (sine-env-channel '(0 0 1 1 2 -.5 3 1))
+</p>
+
+<pre class="indented">
+(sine-env-channel '(0 0 1 1 2 -.5 3 1))
</pre>
-applies the given envelope to the current channel,
+
+<p>applies the given envelope to the current channel,
connecting the points with a sinusoidal curve.
Similarly, blackman4-env-channel connects the dots with
a sum of cosines, and env-squared-channel connects the dots with an x^2 curve. To get any other positive exponent,
use env-expt-channel. The 'symmetric' argument determines whether the
up and down moving ramps look symmetrical around a break point.
+</p>
-<table border=0 vspace=10>
+<table>
<tr><td><img src="pix/exptenvs.png" alt="exponential envelopes"></td><td>
-<pre>
+
+<pre class="indented">
(env-channel '(0 0 1 1 2 -.75 3 0))
(env-sound '(0 0 1 1 2 -.75 3 0) 0 100 32.0)
(env-sound '(0 0 1 1 2 -.75 3 0) 0 100 .032)
@@ -4888,175 +5631,186 @@ up and down moving ramps look symmetrical around a break point.
(env-expt-channel '(0 0 1 1 2 -.75 3 0) .3)
</pre>
</td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- for-each-sound-file -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="foreachsoundfile">for-each-sound-file</a> <code>func dir</code><br>
-<a class=def name="mapsoundfiles">map-sound-files</a> <code>func dir</code><br>
-<a class=def name="matchsoundfiles">match-sound-files</a> <code>func dir</code>
-</td></tr><tr><td></td><td>
-for-each-sound-file and
+<pre class="indented">
+<em class=def id="foreachsoundfile">for-each-sound-file</em> func dir
+<em class=def id="mapsoundfiles">map-sound-files</em> func dir
+<em class=def id="matchsoundfiles">match-sound-files</em> func dir
+</pre>
+
+<p>for-each-sound-file and
map-sound-files apply 'func' to each sound file in 'dir'.
The 'func' is passed one argument, the sound file name.
map-sound-files returns a list of the results, if any, returned from 'func'.
match-sound-files applies 'func' to each sound file in 'dir' and returns a list of files for which func does not return #f.
+</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(for-each-sound-file
(lambda (n)
- (if (> (<a class=quiet href="extsnd.html#mussoundduration" onmouseout="UnTip()" onmouseover="Tip(extsnd_mussoundduration_tip)">mus-sound-duration</a> n) 10.0)
- (<a class=quiet href="extsnd.html#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> n)))
- (<a class=quiet href="extsnd.html#soundfilesindirectory" onmouseout="UnTip()" onmouseover="Tip(extsnd_soundfilesindirectory_tip)">sound-files-in-directory</a> "."))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+ (if (> (<a class=quiet href="extsnd.html#mussoundduration">mus-sound-duration</a> n) 10.0)
+ (<a class=quiet href="extsnd.html#sndprint">snd-print</a> n)))
+ (<a class=quiet href="extsnd.html#soundfilesindirectory">sound-files-in-directory</a> "."))
+</pre>
+<div class="spacer"></div>
<!-- insert-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="insertchannel">insert-channel</a> <code>filedat beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-insert-channel inserts the specified data ('filedat') in the given channel at the given location.
+<pre class="indented">
+<em class=def id="insertchannel">insert-channel</em> filedat beg dur snd chn edpos
+</pre>
+
+<p>insert-channel inserts the specified data ('filedat') in the given channel at the given location.
See <a href="#mixchannel">mix-channel</a> for a description of 'filedat'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mix-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mixchannel">mix-channel</a> <code>filedat beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-mix-channel is a "regularized" version of the file mixing functions (<a class=quiet href="extsnd.html#mix" onmouseout="UnTip()" onmouseover="Tip(extsnd_mix_tip)">mix</a> and
+<pre class="indented">
+<em class=def id="mixchannel">mix-channel</em> filedat beg dur snd chn edpos
+</pre>
+
+<p>mix-channel is a "regularized" version of the file mixing functions (<a class=quiet href="extsnd.html#mix">mix</a> and
<a href="#mixsound">mix-sound</a>).
Its first argument can be either a filename (a string), a sound, or a list containing the filename (or index), the
start point in the file, and (optionally) the channel of the file to mix:
-<pre>
- (mix-channel "pistol.snd") ; mixing starts at sample 0, entire sound is mixed
- (mix-channel "pistol.snd" 10000) ; mixing starts at sample 10000 in current sound
- (mix-channel (list "pistol.snd" 1000)) ; mixed data starts at sample 1000 in pistol.snd
- (mix-channel (list "2.snd" 0 1)) ; mixed data reads channel 1 in 2.snd
+</p>
+
+<pre class="indented">
+(mix-channel "pistol.snd") ; mixing starts at sample 0, entire sound is mixed
+(mix-channel "pistol.snd" 10000) ; mixing starts at sample 10000 in current sound
+(mix-channel (list "pistol.snd" 1000)) ; mixed data starts at sample 1000 in pistol.snd
+(mix-channel (list "2.snd" 0 1)) ; mixed data reads channel 1 in 2.snd
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- mono->stereo -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="monotostereo">mono->stereo</a> <code>new-name snd1 chn1 snd2 chn2</code><br>
-<a class=def name="stereotomono">stereo->mono</a> <code>orig-snd chan1-name chan2-name</code><br>
-<em class=emdef>mono-files->stereo</em> <code>new-name chan1-file chan2-file</code>
-</td></tr><tr><td></td><td>
-mono->stereo combines two mono sounds (currently open in Snd) into one (new) stereo file.
+<pre class="indented">
+<em class=def id="monotostereo">mono->stereo</em> new-name snd1 chn1 snd2 chn2
+<em class=def id="stereotomono">stereo->mono</em> orig-snd chan1-name chan2-name
+<em class=emdef>mono-files->stereo</em> new-name chan1-file chan2-file
+</pre>
+
+<p>mono->stereo combines two mono sounds (currently open in Snd) into one (new) stereo file.
mono-files->stereo
is the same, but the source sounds are files, not necessarily already open in Snd.
stereo->mono takes a stereo sound and produces two new mono sounds.
(The corresponding stereo->mono-files can be based on the existing
<a href="extsnd.html#extractchannel">extract-channel</a> function).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- normalized-mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="normalizedmix">normalized-mix</a> <code>filename beg in-chan snd chn</code>
-</td></tr><tr><td></td><td>
-normalized-mix is like <a href="extsnd.html#mix">mix</a> but the mixed result has same peak amplitude as the
+<pre class="indented">
+<em class=def id="normalizedmix">normalized-mix</em> filename beg in-chan snd chn
+</pre>
+
+<p>normalized-mix is like <a href="extsnd.html#mix">mix</a> but the mixed result has same peak amplitude as the
original data.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- normalize-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="normalizesound">normalize-sound</a> <code>amp (beg 0) dur snd</code>
-</td></tr><tr><td width=30></td><td>
-normalize-sound scales the sound 'snd' to peak amplitude 'amp'.
+<pre class="indented">
+<em class=def id="normalizesound">normalize-sound</em> amp (beg 0) dur snd
+</pre>
+
+<p>normalize-sound scales the sound 'snd' to peak amplitude 'amp'.
It is the multichannel version of <a href="extsnd.html#normalizechannel">normalize-channel</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- offset-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="offsetchannel">offset-channel</a> <code>amount beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-offset-channel adds a constant (DC offset) to a channel.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="offsetchannel">offset-channel</em> amount beg dur snd chn edpos
+</pre>
+
+<p>offset-channel adds a constant (DC offset) to a channel.
+</p>
+<div class="spacer"></div>
<!-- offset-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="offsetsound">offset-sound</a> <code>off (beg 0) dur snd</code>
-</td></tr><tr><td width=30></td><td>
-offset-sound adds 'off' to every sample in the sound 'snd'.
+<pre class="indented">
+<em class=def id="offsetsound">offset-sound</em> off (beg 0) dur snd
+</pre>
+
+<p>offset-sound adds 'off' to every sample in the sound 'snd'.
It is the multichannel version of <a href="#offsetchannel">offset-channel</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- pad-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="padsound">pad-sound</a> <code>beg dur snd</code>
-</td></tr><tr><td width=30></td><td>
-pad-sound places a block of 'dur' zeros in every channel of the sound 'snd' starting at 'beg'.
-It is the multichannel version of <a href="extsnd.html#padchannel">pad-channel</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
+<pre class="indented">
+<em class=def id="padsound">pad-sound</em> beg dur snd
+</pre>
-<!-- profile -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="profile">profile</a> <code>(file "sort.data")</code>
-</td></tr><tr><td width=30></td><td>
-In s7, if profiling has been enabled (via --with-profiling in configure or
-WITH_PROFILING in mus-config.h), the profile function writes to its output file
-the names of all the functions it knows about, and the number of times each has
-been called.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>pad-sound places a block of 'dur' zeros in every channel of the sound 'snd' starting at 'beg'.
+It is the multichannel version of <a href="extsnd.html#padchannel">pad-channel</a>.
+</p>
+<div class="spacer"></div>
<!-- redo-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>redo-channel</em> <code>(edits 1) snd chn</code>
-</td></tr><tr><td></td><td>
-redo-channel is a "regularized" version of <a href="extsnd.html#redo">redo</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>redo-channel</em> (edits 1) snd chn
+</pre>
+
+<p>redo-channel is a "regularized" version of <a href="extsnd.html#redo">redo</a>.
+</p>
+<div class="spacer"></div>
<!-- scale-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="scalesound">scale-sound</a> <code>scl (beg 0) dur snd</code>
-</td></tr><tr><td width=30></td><td>
-scale-sound multiplies every sample in the sound 'snd' by 'scl'.
+<pre class="indented">
+<em class=def id="scalesound">scale-sound</em> scl (beg 0) dur snd
+</pre>
+
+<p>scale-sound multiplies every sample in the sound 'snd' by 'scl'.
It is the multichannel version of <a href="extsnd.html#scalechannel">scale-channel</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- undo-channel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>undo-channel</em> <code>(edits 1) snd chn</code>
-</td></tr><tr><td></td><td>
-undo-channel is a "regularized" version of <a href="extsnd.html#undo">undo</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>undo-channel</em> (edits 1) snd chn
+</pre>
-</table>
+<p>undo-channel is a "regularized" version of <a href="extsnd.html#undo">undo</a>.
+</p>
-<br><br>
-<!-- ---------------------------------------- FILE: fade ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="fadedoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>fade</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: fade -->
+
+<div class="header" id="fadedoc">fade</div>
<!-- main-index |fadedoc:cross-fade (frequency domain) -->
<p>
The two functions in fade.scm perform frequency-domain cross-fades, that is, the
-cross-fade is handled by a bank of bandpass filters (<a class=quiet href="sndclm.html#formant" onmouseout="UnTip()" onmouseover="Tip(sndclm_formant_tip)">formant</a> generators). The effect
+cross-fade is handled by a bank of bandpass filters (<a class=quiet href="sndclm.html#formant">formant</a> generators). The effect
is sometimes only slightly different from a normal (time-domain) cross-fade, but
there are some interesting possibilities ("sound evaporation", etc).
</p>
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>cross-fade</em> <code>beg dur amp file1 file2 ramp-beg ramp-dur ramp-type bank-dur fs fwidth</code>
-</td></tr></table>
+<pre class="indented">
+<em class=emdef>cross-fade</em> beg dur amp file1 file2 ramp-beg ramp-dur ramp-type bank-dur fs fwidth
+</pre>
<p>
cross-fade stitches 'file1' to 'file2' using filtering to provide the
@@ -5068,19 +5822,22 @@ set up; 'fwidth' is the formant resonance width control; 'ramp-beg' and
controls how much time is spent in the formant bank before starting or after ending
the ramp.
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2))
- (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (cross-fade 0 1.5 1.0 0 1 0.5 .5 0 1.0 256 2))
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2))
+(float-vector->channel (cross-fade 0 1.5 1.0 0 1 0.5 .5 0 1.0 256 2))
</pre>
+
<p>
These fades seem more successful to me when done relatively quickly (the opposite of the dissolve-fade below
which is best if done as slowly as possible). With any luck the "sweep up" case can produce a sort of "evaporation" effect.
A similar idea is behind dissolve-fade:
</p>
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<a class=def name="dissolvefade">dissolve-fade</a> <code>beg dur amp file1 file2 fsize r lo hi</code>
-</td></tr></table>
+<div class="spacer"></div>
+<pre class="indented">
+<em class=def id="dissolvefade">dissolve-fade</em> beg dur amp file1 file2 fsize r lo hi
+</pre>
<p>It ramps in and out frequency bands chosen at random. The original hope was to get something like a graphical dissolve,
but it turns out to be better to let the random changes float along with no overall
@@ -5089,517 +5846,123 @@ and a suitably noisy original, strange pitches emerge and submerge. 'fsize' is
'r' is the same as 'fwidth' in cross-fade (resonance width) modulo a factor of 2 (sigh...).
'lo' and 'hi' set the portion of the formant bank that is active during the dissolve.
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (dissolve-fade 0 1 1.0 "oboe.snd" "trumpet.snd" 256 2 0 128))
- (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (dissolve-fade 0 2 1 0 1 1024 2 2 #f))
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (dissolve-fade 0 1 1.0 "oboe.snd" "trumpet.snd" 256 2 0 128))
+(float-vector->channel (dissolve-fade 0 2 1 0 1 1024 2 2 #f))
</pre>
-<br>
-<!-- ---------------------------------------- FILE: frame ---------------------------------------- -->
+<!-- FILE: freeverb -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="framedoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>frame</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="freeverbdoc">freeverb</div>
-<p>This file implements a bunch of functions using frames, vcts, and sound-data objects: primarily multichannel sound operations
-where we want to handle all channels in parallel. I may
-move some of these into C.
+<p>freeverb is Jezar Wakefield's reverberator, translated by Michael Scholz from CLM's freeverb.ins (written by Fernando Lopez-Lezcano), and documented
+in freeverb.html in the CLM tarball.
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
-
-<!-- file->sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="filetosounddata">file->sound-data</a> <code>file</code>
-</td></tr><tr><td width=30></td><td>
-file->sound-data returns the data of the file 'file' in a sound-data object.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="freeverb">freeverb</em>
+ (room-decay 0.5)
+ (damping 0.5)
+ (global 0.3)
+ (predelay 0.03)
+ (output-gain 1.0)
+ (output-mixer #f)
+ (scale-room-decay 0.28)
+ (offset-room-decay 0.7)
+ (combtuning '(1116 1188 1277 1356 1422 1491 1557 1617))
+ (allpasstuning '(556 441 341 225))
+ (scale-damping 0.4)
+ (stereo-spread 23)
+ (verbose #f)
+</pre>
-<!-- file->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="filetovct">file->vct</a> <code>file</code>
-</td></tr><tr><td width=30></td><td>
-file->vct returns the data of the file 'file' (channel 0 anyway) in a vct.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>Here is a paraphrase of some of Fernando's documentation.
+'room-decay'
+determines the decay time of the reverberation.
+'damping' set the high frequency damping; this parameter can be a number, or an array or a list (with same number of elements as output channels). It is possible to control the damping for each output channel.
+'global'
+controls how the outputs of all reverbs (one per channel) are mixed into the output stream. Specifying "0" will connect each reverberator directly to each output channel, "1" will mix all reverberated channels equally into all output channels. Intermediate values will allow for an arbitrary balance between local and global reverberation. The overall gain of the mixing matrix is kept constant. 'output-mixer' overrides this parameter.
+'predelay'
+sets the predelay that is applied to the input streams. An array or list lets you specify the individual predelays for all chanenels.
+'output-gain'
+is the overall gain multiplier for the output streams.
+'output-mixer'
+sets the output mixing matrix directly (rather than through 'global').
+</p>
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:reverb freeverb :reverb-data '(:output-gain 3.0))
+ (fm-violin 0 .1 440 .1 :reverb-amount .1))
+</pre>
-<!-- frame-copy -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="framecopy">frame-copy</a> <code>frame</code>
-</td></tr><tr><td></td><td>
-frame-copy returns a copy of its argument.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="seealso">
+see also: <a href="#jcrevdoc">jcrev</a> <a href="#nrev">nrev</a> <a href="extsnd.html#convolvewith">convolution</a>
+</div>
-<!-- frame-reverse! -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="framereverse">frame-reverse!</a> <code>frame</code>
-</td></tr><tr><td></td><td>
-frame-reverse! reverses the entries in the given frame.
-<pre>
- :<em class=typing>(frame-reverse (make-frame 2 .1 .2))</em>
- <em class=listener>#<frame[2]: [0.200 0.100]></em>
-</pre>
-</td></tr><tr><td colspan=2></td></tr>
-<!-- frame->sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="frametosound">frame->sound</a> <code>fr pos snd</code>
-</td></tr><tr><td></td><td>
-frame->sound places the contents of frame fr into sound snd at position pos.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- FILE: grani -->
-<!-- frame->sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="frametosounddata">frame->sound-data</a> <code>fr sd possd</code>
-</td></tr><tr><td></td><td>
-frame->sound-data places the contents of its frame argument in its sound-data argument at position pos.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="header" id="granidoc">grani</div>
-
-<!-- frame->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="frametovct">frame->vct</a> <code>frame vct</code>
-</td></tr><tr><td></td><td>
-frame->vct places the contents of its frame argument in its vct argument, or in a newly created vct
-if the vct argument is omitted.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- insert-frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="insertframe">insert-frame</a> <code>fr beg snd edpos</code>
-</td></tr><tr><td></td><td>
-insert-frame inserts the frame of samples into sound snd (one sample in each channel) at beg.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- insert-sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="insertsounddata">insert-sound-data</a> <code>sd beg dur snd edpos</code>
-</td></tr><tr><td></td><td>
-insert-sound-data inserts the sound-data (sd) contents into sound snd at beg. This provides a sound
-insertion function that automatically handles multichannel possibilities (unlike <a href="extsnd.html#insertsamples">insert-samples</a>).
-<pre>
-(insert-sound-data
- (<a class=quiet href="#withtempsound" onmouseout="UnTip()" onmouseover="Tip(sndscm_withtempsound_tip)">with-temp-sound</a> (:output (<a class=quiet href="extsnd.html#makesounddata" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesounddata_tip)">make-sound-data</a> 2 (* 44100 2.0))
- :srate 44100
- :channels 2)
- (do ((i 0 (+ 1 i))) ; 20 fm-violin notes moving from channel 0 to channel 1
- ((= i 20))
- (<a class=quiet href="#vdoc">fm-violin</a> (* i .1) .1 440 .1 :degree (* i (/ 90 20))))))
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- insert-vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="insertvct">insert-vct</a> <code>v beg dur snd chn edpos</code>
-</td></tr><tr><td></td><td>
-insert-vct inserts the vct data into sound snd at beg. It is just a wrapper
-for <a href="extsnd.html#insertsamples">insert-samples</a> that puts the vct argument first.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- map-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mapsound">map-sound</a> <code>func beg dur snd</code>
-</td></tr><tr><td></td><td>
-map-sound is a version of <a href="extsnd.html#mapchannel">map-channel</a> that passes func a frame on each call, rather than a sample.
-<pre>
- (map-sound (lambda (fr) (<a class=quiet href="sndclm.html#frame*" onmouseout="UnTip()" onmouseover="Tip(sndclm_frame_times_tip)">frame*</a> fr 2.0)))
-</pre>
-is another way to scale a sound by 2.0.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- mix-frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mixframe">mix-frame</a> <code>fr beg snd</code>
-</td></tr><tr><td></td><td>
-mix-frame mixes the frame (fr) of samples into sound snd (one sample in each channel) at beg.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- mix-sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mixsounddata">mix-sound-data</a> <code>sd beg dur snd tagged</code>
-</td></tr><tr><td></td><td>
-mix-sound-data mixes the contents of sound-data sd into sound snd at beg. tagged determines whether
-the resulting mixes have tags.
-See <a href="#insertsounddata">insert-sound-data</a> for an example that could easily be changed to use mixing instead.
-As with mix-vct, we can use <a href="#wsdoc">with-sound</a> to add notelist output as an edit:
-<pre>
- (mix-sound-data
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:output (<a class=quiet href="extsnd.html#makesounddata" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesounddata_tip)">make-sound-data</a> 2 22050))
- (<a class=quiet href="#fmviolin" onmouseout="UnTip()" onmouseover="Tip(sndscm_fmviolin_tip)">fm-violin</a> 0 1 440 .1 :degrees 45)))
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- region->frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="regiontoframe">region->frame</a> <code>reg pos</code>
-</td></tr><tr><td></td><td>
-region->frame returns a frame containing the contents of the region ref at position pos.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- region->sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="regiontosounddata">region->sound-data</a> <code>reg</code>
-</td></tr><tr><td></td><td>
-region->sound-data returns a sound-data object containing the contents of the region 'reg'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- scan-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="scansound">scan-sound</a> <code>func beg dur snd with-sync</code>
-</td></tr><tr><td></td><td>
-scan-sound is a version of <a href="extsnd.html#scanchannel">scan-channel</a> that passes func a frame on each call, rather than a sample.
-If 'with-sync' is #t, the frame read includes all channels currently sync'd to the sound 'snd'.
-<pre>
-(define* (simultaneous-zero-crossing (beg 0) dur snd)
- (let ((last-fr (<a class=quiet href="sndclm.html#make-frame" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_frame_tip)">make-frame</a> (<a class=quiet href="extsnd.html#chans" onmouseout="UnTip()" onmouseover="Tip(extsnd_chans_tip)">channels</a> snd))))
- (<em class=red>scan-sound</em> (lambda (fr)
- (let ((result #t))
- (do ((chn 0 (+ 1 chn)))
- ((= chn (channels fr)))
- (set! result (and result
- (< (* (<a class=quiet href="sndclm.html#frame-ref" onmouseout="UnTip()" onmouseover="Tip(sndclm_frame_ref_tip)">frame-ref</a> fr chn) (<a class=quiet href="sndclm.html#frame-ref" onmouseout="UnTip()" onmouseover="Tip(sndclm_frame_ref_tip)">frame-ref</a> last-fr chn)) 0.0)))
- (<a class=quiet href="sndclm.html#frame-set!" onmouseout="UnTip()" onmouseover="Tip(sndclm_frame_set_tip)">frame-set!</a> last-fr chn (<a class=quiet href="sndclm.html#frame-ref" onmouseout="UnTip()" onmouseover="Tip(sndclm_frame_ref_tip)">frame-ref</a> fr chn)))
- result))
- beg dur snd)))
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- selection->sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="selectiontosounddata">selection->sound-data</a> <code>beg</code>
-</td></tr><tr><td></td><td>
-selection->sound-data returns a sound-data object containing the contents of the current selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- simultaneous-zero-crossing -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="simultaneouszerocrossing">simultaneous-zero-crossing</a> <code>(beg 0) dur snd</code>
-</td></tr><tr><td></td><td>
-simultaneous-zero-crossing looks through all channels of the sound 'snd' for a zero crossing that happens on the
-same sample in all channels.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data->file -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="sounddatatofile">sound-data->file</a> <code>sd file (srate 44100) (comment "")</code>
-</td></tr><tr><td></td><td>
-sound-data->file places the contents of its sound-data argument 'sd' in the newly created sound file 'file'.
-<pre>
- (sound-data->file (sound->sound-data 44100 44100) "test.snd" 44100)
-</pre>
-writes the sound data in the currently selected sound between seconds 1 and 2 to "test.snd".
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data->frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="sounddatatoframe">sound-data->frame</a> <code>sd pos fr</code>
-</td></tr><tr><td></td><td>
-sound-data->frame places the contents of its sound-data argument at position pos into its frame argument.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound-data->sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="sounddatatosound">sound-data->sound</a> <code>sd beg dur snd</code>
-</td></tr><tr><td></td><td>
-sound-data->sound places the contents of its sound-data argument sd into the sound snd starting at beg and going for dur frames.
-dur defaults to the sound-data object's length.
-See <a href="#insertsounddata">insert-sound-data</a> for an example that could easily be changed to use this
-function (and replacement, of course, rather than insertion).
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound->sound-data -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="soundtosounddata">sound->sound-data</a> <code>beg dur snd</code>
-</td></tr><tr><td></td><td>
-sound->sound-data returns a sound-data object containing the contents of the sound snd starting from beg for dur frames.
-<pre>
- (sound-data->sound (sound-data* (sound->sound-data) 2.0))
-</pre>
-is yet another way to scale a sound by 2.0.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- sound->frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="soundtoframe">sound->frame</a> <code>pos snd</code>
-</td></tr><tr><td></td><td>
-sound->frame returns a frame containing the contents of the sound snd at position pos.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- vct->file -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="vcttofile">vct->file</a> <code>vct file (srate 44100) (comment "")</code>
-</td></tr><tr><td></td><td>
-vct->file places the contents of its vct argument in the newly created (mono) sound file 'file'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- vct->frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="vcttoframe">vct->frame</a> <code>vct frame</code>
-</td></tr><tr><td></td><td>
-vct->frame places the contents of its vct argument in its frame argument, or in a newly created frame
-if the frame argument is omitted.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-</table>
-
-
-<A NAME="framereaders"></a>
-<p>To read sound data as an array of frames, there is a set of functions that are parallel
-to the sampler functions, but which deal in frames. I will probably move these to C
-once the dust settles.
-</p>
-
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
-
-<!-- copy-frame-reader -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="copyframereader">copy-frame-reader</a> <code>obj</code></td></tr>
-<tr><td width=30><br></td><td>
-copy-frame-reader returns a copy of the frame-reader 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- frame-reader-at-end? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="framereaderatendQ">frame-reader-at-end?</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-frame-reader-at-end? returns #t if the frame-reader 'obj' is at the end of the sound.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- frame-reader-chans -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="framereaderchans">frame-reader-chans</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-frame-reader-chans returns the number of channels read by the frame-reader 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- frame-reader-home -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="framereaderhome">frame-reader-home</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-frame-reader-home returns the sound associated with the frame-reader 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- frame-reader-position -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="framereaderposition">frame-reader-position</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-frame-reader-position returns the current (frame-wise) location of the frame-reader 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- frame-reader? -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="framereaderQ">frame-reader?</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-frame-reader? returns #t if 'obj' is a frame-reader.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- free-frame-reader -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="freeframereader">free-frame-reader</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-free-frame-reader releases the frame-reader 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- make-frame-reader -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makeframereader">make-frame-reader</a> <code>start snd dir pos</code></td></tr>
-<tr><td></td><td>
-make-frame-reader creates a frame-reader reading the sound 'snd'
-starting at frame 'start' with initial read direction 'dir'
-(1=forward, -1=backward). 'pos' is the edit history position to read
-(it defaults to current position).
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- make-region-frame-reader -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makeregionframereader">make-region-frame-reader</a> <code>reg start dir</code></td></tr>
-<tr><td></td><td>
-make-region-frame-reader creates a frame-reader reading region 'reg'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- make-selection-frame-reader -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makeselectionframereader">make-selection-frame-reader</a> <code>start</code></td></tr>
-<tr><td></td><td>
-make-selection-frame-reader returns a frame reader that reads all channels of the current selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- make-sync-frame-reader -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makesyncframereader">make-sync-frame-reader</a> <code>start snd dir edpos</code></td></tr>
-<tr><td></td><td>
-make-sync-frame-reader returns a frame reader that reads all channels sync'd to the sound 'snd'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- next-frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="nextframe">next-frame</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-next-frame returns the next frame (reading forward) read by the frame-reader 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- previous-frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="previousframe">previous-frame</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-previous-frame returns the previous frame in the stream read by the frame-reader 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-<!-- read-frame -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="readframe">read-frame</a> <code>obj</code></td></tr>
-<tr><td></td><td>
-read-frame returns the next frame (reading in the direction set by <a class=quiet href="#makeframereader" onmouseout="UnTip()" onmouseover="Tip(sndscm_makeframereader_tip)">make-frame-reader</a>)
-from the frame-reader 'obj'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-</table>
-
-<br>
-
-
-
-<!-- ---------------------------------------- FILE: freeverb ---------------------------------------- -->
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="freeverbdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>freeverb</h2></td></tr></table>
-</td></tr></table>
-
-<p>freeverb is Jezar Wakefield's reverberator, translated by Michael Scholz from CLM's freeverb.ins (written by Fernando Lopez-Lezcano), and documented
-in freeverb.html in the CLM tarball.
-</p>
-<pre>
- <a class=def name="freeverb">freeverb</a>
- (room-decay 0.5)
- (damping 0.5)
- (global 0.3)
- (predelay 0.03)
- (output-gain 1.0)
- (output-mixer #f)
- (scale-room-decay 0.28)
- (offset-room-decay 0.7)
- (combtuning '(1116 1188 1277 1356 1422 1491 1557 1617))
- (allpasstuning '(556 441 341 225))
- (scale-damping 0.4)
- (stereo-spread 23)
- (verbose #f)
-</pre>
-
-<p>Here is a paraphrase of some of Fernando's documentation.
-'room-decay'
-determines the decay time of the reverberation.
-'damping' set the high frequency damping; this parameter can be a number, or an array or a list (with same number of elements as output channels). It is possible to control the damping for each output channel.
-'global'
-controls how the outputs of all reverbs (one per channel) are mixed into the output stream. Specifying "0" will connect each reverberator directly to each output channel, "1" will mix all reverberated channels equally into all output channels. Intermediate values will allow for an arbitrary balance between local and global reverberation. The overall gain of the mixing matrix is kept constant. 'output-mixer' overrides this parameter.
-'predelay'
-sets the predelay that is applied to the input streams. An array or list lets you specify the individual predelays for all chanenels.
-'output-gain'
-is the overall gain multiplier for the output streams.
-'output-mixer'
-sets the output mixing matrix directly (rather than through 'global').
+<p>This is Fernando Lopez-Lezcano's CLM <A HREF="http://ccrma.stanford.edu/~nando/clm/grani/">grani</A>
+granular synthesis instrument translated to Scheme by Mike Scholz.
+The Ruby version is in clm-ins.rb.
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb freeverb :reverb-data '(:output-gain 3.0))
- (fm-violin 0 .1 440 .1 :reverb-amount .1))
-</pre>
-
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="#jcrevdoc" onmouseout="UnTip()" onmouseover="Tip('an old reverberator')">jcrev</a> <a href="#nrev">nrev</a> <a href="extsnd.html#convolvewith">convolution</a>
-</pre>
-</td></tr></table>
-
-<br>
-
-
-<!-- ---------------------------------------- FILE: grani ---------------------------------------- -->
+<pre class="indented">
+<em class=def id="grani">grani</em> start-time duration amplitude file
+ (input-channel 0) ; input file channel from which samples are read
+ (grains 0) ; if not 0, total number of grains to be generated
+ (amp-envelope '(0 0 0.3 1 0.7 1 1 0)) ; overall amplitude envelope for note
+ (grain-envelope '(0 0 0.3 1 0.7 1 1 0)) ; env for each individual grain
+ (grain-envelope-end #f) ; if not #f, a second grain env
+ (grain-envelope-transition '(0 0 1 1)) ; interp 0: use grain-envelope, 1: use grain-envelope-end
+ (grain-envelope-array-size 512) ; <a href="sndclm.html#make-table-lookup">make-table-lookup</a> table size
+ (grain-duration 0.1) ; number or envelope setting grain duration (in seconds)
+ (grain-duration-spread 0.0) ; random spread around 'grain-duration'
+ (grain-duration-limit 0.002) ; minimum grain duration (in seconds)
+ (srate 0.0) ; number or envelope setting sampling rate conversion
+ (srate-spread 0.0) ; random spread of src around 'srate'
+ (srate-linear #f) ; if #f, srate (envelope) is exponential
+ (srate-base (expt 2 (/ 12))) ; srate env base if exponential
+ (srate-error 0.01) ; error bound for exponential conversion
+ (grain-start '(0 0 1 1)) ; env that sets input file read point of current grain
+ (grain-start-spread 0.0) ; random spread around 'grain-start'
+ (grain-start-in-seconds #f) ; if #f, treat 'grain-start' as a percentage
+ (grain-density 10.0) ; env on number of grains / second in output
+ (grain-density-spread 0.0) ; random spread around 'grain-density'
+ (reverb-amount 0.01)
+ (reverse #f) ; if #t, input is read backwards
+ (where-to 0) ; locsig stuff — see the full documentation
+ (where-bins ())
+ (grain-distance 1.0) ; distance of sound source (<a href="sndclm.html#locsig">locsig</a>)
+ (grain-distance-spread 0.0) ; random spread around 'grain-distance'
+ (grain-degree 45.0)
+ (grain-degree-spread 0.0)
+ (verbose #t)
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="granidoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>grani</h2></td></tr></table>
-</td></tr></table>
+(<a class=quiet href="#wsdoc">with-sound</a> (:channels 2 :reverb jc-reverb :reverb-channels 1)
+ (grani 0 1 .5 "oboe.snd" :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)))
+</pre>
-<p>This is Fernando Lopez-Lezcano's CLM <A HREF="http://ccrma.stanford.edu/~nando/clm/grani/">grani</a>
-granular synthesis instrument translated to Scheme by Mike Scholz.
-The Ruby version is in clm-ins.rb.
-</p>
-<pre>
- <a class=def name="grani">grani</a> start-time duration amplitude file
- (input-channel 0) ; input file channel from which samples are read
- (grains 0) ; if not 0, total number of grains to be generated
- (amp-envelope '(0 0 0.3 1 0.7 1 1 0)) ; overall amplitude envelope for note
- (grain-envelope '(0 0 0.3 1 0.7 1 1 0)) ; env for each individual grain
- (grain-envelope-end #f) ; if not #f, a 2nd grain env
- (grain-envelope-transition '(0 0 1 1)) ; interp 0: use grain-envelope, 1: use grain-envelope-end
- (grain-envelope-array-size 512) ; <a href="sndclm.html#make-table-lookup">make-table-lookup</a> table size
- (grain-duration 0.1) ; number or envelope setting grain duration (in seconds)
- (grain-duration-spread 0.0) ; random spread around 'grain-duration'
- (grain-duration-limit 0.002) ; minimum grain duration (in seconds)
- (srate 0.0) ; number or envelope setting sampling rate conversion
- (srate-spread 0.0) ; random spread of src around 'srate'
- (srate-linear #f) ; if #f, srate (envelope) is exponential
- (srate-base (expt 2 (/ 12))) ; srate env base if exponential
- (srate-error 0.01) ; error bound for exponential conversion
- (grain-start '(0 0 1 1)) ; env that sets input file read point of current grain
- (grain-start-spread 0.0) ; random spread around 'grain-start'
- (grain-start-in-seconds #f) ; if #f, treat 'grain-start' as a percentage
- (grain-density 10.0) ; env on number of grains / second in output
- (grain-density-spread 0.0) ; random spread around 'grain-density'
- (reverb-amount 0.01)
- (reverse #f) ; if #t, input is read backwards
- (where-to 0) ; locsig stuff — see the full documentation
- (where-bins '())
- (grain-distance 1.0) ; distance of sound source (<a href="sndclm.html#locsig">locsig</a>)
- (grain-distance-spread 0.0) ; random spread around 'grain-distance'
- (grain-degree 45.0)
- (grain-degree-spread 0.0)
- (verbose #t)
-
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:channels 2 :reverb jc-reverb :reverb-channels 1)
- (grani 0 1 .5 "oboe.snd" :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)))
-</pre>
-
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="sndclm.html#granulate" onmouseout="UnTip()" onmouseover="Tip('CLM granular synthesis generator')">granulate</a> <a href="#expsrc" onmouseout="UnTip()" onmouseover="Tip('granular synthesis to stretch sound')">expsrc</a> <a href="extsnd.html#customcontrols" onmouseout="UnTip()" onmouseover="Tip('expand in the control panel')">expand</a>
-</pre></td>
-</tr></table>
+<div class="seealso">
+see also: <a href="sndclm.html#granulate">granulate</a> <a href="#expsrc">expsrc</a> <a href="extsnd.html#customcontrols">expand</a>
+</div>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: heart ---------------------------------------- -->
+<!-- FILE: heart -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="heartdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>heart</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="heartdoc">heart</div>
<p>
Snd can be used with non-sound data, and <a href="#wsdoc">with-sound</a> makes it easy to
@@ -5609,117 +5972,103 @@ sound file (the sphygmometer readings are between 70 and 150), then open that fi
clipping features turned off. We also tell Snd to skip the data file in its start-up load process (since it
is an uninterpretable text file) by incrementing script-arg.
</p>
-<img src="pix/usync.png" alt="heart picture" hspace=40>
+<img class="indented" src="pix/usync.png" alt="heart picture">
-<br>
-<br>
-<!-- ---------------------------------------- FILE: hooks ---------------------------------------- -->
+<!-- FILE: hooks -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="hooksdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>hooks</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="hooksdoc">hooks</div>
<p>hooks.scm and hooks.rb have various <a href="extsnd.html#sndhooks">hook</a>-related functions.
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
-
<!-- describe-hook -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="describehook">describe-hook</a> <code>hook</code>
-</td></tr><tr><td width=30></td><td>
-describe-hook tries to decipher the functions on the hook list; this is almost identical to hook-functions.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="describehook">describe-hook</em> hook
+</pre>
+
+<p>describe-hook tries to decipher the functions on the hook list; this is almost identical to hook-functions.
+</p>
+<div class="spacer"></div>
<!-- hook-member -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="hookmember">hook-member</a> <code>func hook</code>
-</td></tr><tr><td></td><td>
-hook-member returns #t if 'func' is already on the hook list, equivalent to
-<code>(member value (hook-functions hook))</code>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="hookmember">hook-member</em> func hook
+</pre>
+
+<p>hook-member returns #t if 'func' is already on the hook list, equivalent to
+(member value (hook-functions hook))
+</p>
+<div class="spacer"></div>
+
<!-- reset-all-hooks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="resetallhooks">reset-all-hooks</a>
-</td></tr><tr><td></td><td>
-reset-all-hooks resets all of Snd's built-in hooks.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="resetallhooks">reset-all-hooks</em>
+</pre>
+
+<p>reset-all-hooks resets all of Snd's built-in hooks.
+</p>
+<div class="spacer"></div>
<!-- snd-hooks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="sndscmhooks">snd-hooks</a>
-</td></tr><tr><td></td><td>
-snd-hooks returns a list of all Snd built-in non-channel hooks.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="sndscmhooks">snd-hooks</em>
+</pre>
+
+<p>snd-hooks returns a list of all Snd built-in non-channel hooks.
+</p>
+<div class="spacer"></div>
<!-- with-local-hook -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="withlocalhook">with-local-hook</a> <code>hook local-hook-procs thunk</code>
-</td></tr><tr><td></td><td>
-with-local-hook is a kind of "let" for hooks;
+<pre class="indented">
+<em class=def id="withlocalhook">with-local-hook</em> hook local-hook-procs thunk
+</pre>
+
+<p>with-local-hook is a kind of "let" for hooks;
it evaluates 'thunk' with 'hook' set to 'local-hook-procs' (a list which can be nil), then restores 'hook' to its previous state upon exit.
The result returned by 'thunk' is returned by with-local-hook.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-</table>
+</p>
-<br><br>
-<!-- ---------------------------------------- FILE: index ---------------------------------------- -->
+<!-- FILE: index -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="indexdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>index</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="indexdoc">index</div>
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<A class=def NAME="html">html</a> <code>obj</code><br>
-<em class=emdef>?</em> <code>obj</code>
-</td></tr></table>
+<pre class="indented">
+<em class=def id="html">html</em> obj
+</pre>
-<p>index.scm provides a connection between firefox, mozilla or netscape
+<p>index.scm provides a connection between firefox
and the Snd documentation. The index itself is
-built by make-index.scm, then accessed through the functions html and ?.
-<code>(html arg)</code>, where 'arg' can be a string, a symbol, or a procedure sends the html reader to the corresponding url
+built by make-index.scm, then accessed through the function html.
+(html arg), where 'arg' can be a string, a symbol, or a procedure sends the html reader to the corresponding url
in the Snd documents.
-<code>(? obj)</code> prints out any help it can find for 'obj', and tries to find 'obj' in the documentation.
</p>
-<pre>
- :<em class=typing>(html "open-sound")</em> ; mozilla starts (if necessary), and goes to the open-sound documentation
- <em class=listener>#t</em>
- :<em class=typing>(? "open-sound")</em>
- <em class=listener>(open-sound filename): open filename (as if opened from File:Open menu option),
- and return the new sound's index</em>
-</pre>
+<div class="seealso">
+see also: <a href="extsnd.html#htmlprogram">html-program</a> <a href="extsnd.html#sndhelp">snd-help</a> <a href="extsnd.html#sndurls">snd-urls</a>
+</div>
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="extsnd.html#htmlprogram" onmouseout="UnTip()" onmouseover="Tip('name of html reader')">html-program</a> <a href="extsnd.html#sndhelp" onmouseout="UnTip()" onmouseover="Tip('main Snd help function')">snd-help</a> <a href="extsnd.html#sndurls" onmouseout="UnTip()" onmouseover="Tip('table of Snd documentation urls')">snd-urls</a>
-</pre></td>
-</tr></table>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: inf-snd.el, DotEmacs ---------------------------------------- -->
+<!-- FILE: inf-snd.el, DotEmacs -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="dotemacs"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>inf-snd.el, DotEmacs</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="dotemacs">inf-snd.el, DotEmacs</div>
<p>These two files provide support for Snd as an Emacs subjob. inf-snd.el is by Michael Scholz,
and DotEmacs is by Fernando Lopez-Lezcano. Both can be loaded in your ~/.emacs file (or ~/.xemacs/init.el if you're
using xemacs).
-
+</p>
+<p>
DotEmacs sets up "dialects" for various versions of Common Lisp and for Snd, then
binds C-x C-l to run ACL. This is intended for CCRMA'S 220 class, but it might
be of interest to others. Much fancier is inf-snd.el. What follows is taken almost
@@ -5730,16 +6079,17 @@ verbatim from Mike Scholz's comments in that file:
inf-snd.el defines a snd-in-a-buffer package for Emacs.
It includes a Snd-Ruby mode (snd-ruby-mode), a Snd-Scheme mode
(snd-scheme-mode), and a Snd-Forth mode (snd-forth-mode) for editing source files.
-The commands <b>inf-snd-help</b> and <b>snd-help</b>
+The commands inf-snd-help and snd-help
access the description which Snd provides for many functions.
Using the prefix key C-u you get the HTML version of Snd's help.
-With tab-completion in the minibuffer you can scan all functions at
+With tab-completion in the status area you can scan all functions at
a glance.
A menu "Snd/Ruby" is placed in the Emacs menu bar. Entries in this
menu are disabled if no inferior Snd process exists.
These variables may need to be customized to fit your system:
</p>
-<pre>
+
+<pre class="indented">
inf-snd-ruby-program-name "snd-ruby" Snd-Ruby program name
inf-snd-scheme-program-name "snd-s7" Snd-Scheme program name using s7
inf-snd-forth-program-name "snd-forth" Snd-Forth program name
@@ -5750,6 +6100,7 @@ snd-ruby-mode-hook nil to customize snd-ruby-mode
snd-scheme-mode-hook nil to customize snd-scheme-mode
snd-forth-mode-hook nil to customize inf-snd-forth-mode
</pre>
+
<p>
You can start inf-snd-ruby-mode either with the prefix-key
(C-u M-x run-snd-ruby) — you will be asked for program name and
@@ -5759,7 +6110,8 @@ inf-snd-scheme-mode and inf-snd-forth-mode are handled in the same way.
Here's an example for your ~/.emacs file:
</p>
-<pre>
+
+<pre class="indented">
(autoload 'run-snd-ruby "inf-snd" "Start inferior Snd-Ruby process" t)
(autoload 'run-snd-scheme "inf-snd" "Start inferior Snd-Scheme process" t)
(autoload 'run-snd-forth "inf-snd" "Start inferior Snd-Forth process" t)
@@ -5774,6 +6126,7 @@ Here's an example for your ~/.emacs file:
(setq inf-snd-index-path "~/Snd/snd/")
</pre>
+
<p>
See inf-snd.el for more info and examples of specializing these modes.
You can change the mode while editing a Snd-Ruby, Snd-Scheme, or Snd-Forth source file with
@@ -5783,13 +6136,15 @@ file-extensions. I use file-extension ".rbs" for Snd-Ruby source
files, ".cms" for Snd-Scheme, and ".fth" for Snd-Forth.
</p>
-<pre>
+
+<pre class="indented">
(set-default 'auto-mode-alist
(append '(("\\.rbs$" . snd-ruby-mode)
("\\.cms$" . snd-scheme-mode))
auto-mode-alist))
</pre>
+
<p>
Or you can use the local mode variable in source files, e.g. by
"-*- snd-ruby -*-" or "-*- snd-scheme -*-" in first line.
@@ -5798,14 +6153,17 @@ Or you can use the local mode variable in source files, e.g. by
<p>
Key bindings for inf-* and snd-*-modes
</p>
-<pre>
+
+<pre class="indented">
\e\TAB snd-completion symbol completion at point
C-h m describe-mode describe current major mode
</pre>
+
<p>
Key bindings of inf-snd-ruby|scheme|forth-mode:
</p>
-<pre>
+
+<pre class="indented">
C-c C-s inf-snd-run-snd (Snd-Ruby|Scheme|Forth from a dead Snd process buffer)
M-C-l inf-snd-load load script in current working directory
C-c C-f inf-snd-file open view-files-dialog of Snd
@@ -5816,11 +6174,13 @@ C-u C-c C-i inf-snd-help-html help on Snd-function (html)
C-c C-q inf-snd-quit send exit to Snd process
C-c C-k inf-snd-kill kill Snd process and buffer
</pre>
+
<p>
Key bindings of snd-ruby|scheme|forth-mode editing source
files:
</p>
-<pre>
+
+<pre class="indented">
C-c C-s snd-run-snd
M-C-x snd-send-definition
C-x C-e snd-send-last-sexp
@@ -5844,6 +6204,7 @@ C-c C-q snd-quit send exit to Snd process
C-c C-k snd-kill kill Snd process and buffer
</pre>
+
<p>If xemacs complains that comint-snapshot-last-prompt is not defined,
get the latest comint.el; I had to go to the xemacs CVS site since
Fedora Core 5's xemacs (21.4) had an obsolete copy. Then scrounge
@@ -5858,7 +6219,8 @@ the line (require 'forth-mode "gforth") in inf-snd.el). Finally, if temporary-f
is undefined, you can set it alongside the rest of the variables.
So, for example, I (Bill S) have the following in my ~/.xemacs/init.el:
</p>
-<pre>
+
+<pre class="indented">
(setq load-path
(append (list nil
"/home/bil/cl"
@@ -5883,23 +6245,20 @@ So, for example, I (Bill S) have the following in my ~/.xemacs/init.el:
(setq temporary-file-directory "~/zap/")
</pre>
+
<p>If emacs complains about ruby-mode or something similar, you
probably need to get ruby-mode.el and inf-ruby.el from
ftp://ftp.ruby-lang.org/pub/ruby/ruby-*.tar.gz, or gforth.el from
ftp://ftp.gnu.org/pub/gnu/gforth/gforth-0.[67].*.tar.gz.
</p>
-<br>
-
-<!-- ---------------------------------------- FILE: jcrev ---------------------------------------- -->
+<!-- FILE: jcrev -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="jcrevdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>jcrev</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="jcrevdoc">jcrev</div>
-<p>
+<p id="reverbexamples">
jc-reverb is a reverberator developed by John Chowning a long time ago
(I can't actually remember when — before 1976 probably), based
on <a href="http://ccrma.stanford.edu/~jos/pasp/Schroeder_Reverberator_called_JCRev.html">ideas</a>
@@ -5910,361 +6269,363 @@ but I liked the effect a lot. new-effects.scm has a version of jc-reverb
that runs as a normal snd editing function (via <a href="extsnd.html#mapchannel">map-channel</a>), whereas the
jcrev.scm version assumes it is being called within with-sound:
</p>
-<pre>
- Scheme:
- (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .1))
- Ruby:
- with_sound(:reverb, :jc_reverb) do fm_violin_rb(0, 0.1, 440, 0.1) end
+<pre class="indented">
+Scheme:
+ (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .1))
+
+Ruby:
+ with_sound(:reverb, :jc_reverb) do fm_violin_rb(0, 0.1, 440, 0.1) end
- Forth:
- 0 1 440 0.2 ' fm-violin :reverb ' jc-reverb with-sound
+Forth:
+ 0 1 440 0.2 ' fm-violin :reverb ' jc-reverb with-sound
</pre>
+
<p>jc-reverb has three parameters:
</p>
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<a class=def name="jcreverb">jc-reverb</a> <code>low-pass (volume 1.0) amp-env</code>
-</td></tr></table>
+
+<pre class="indented">
+<em class=def id="jcreverb">jc-reverb</em> low-pass (volume 1.0) amp-env
+</pre>
<p>
if 'low-pass' if #t, a low pass filter is inserted before the output;
'volume' can be used to boost the output;
'amp-env' is an amplitude envelope that can be used to squelch the reverb ringing at the end of a piece.
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:reverb jc-reverb :reverb-data '(#t 1.5 (0 0 1 1 2 1 3 0))) (fm-violin 0 .1 440 .1))
-</pre>
-
-<p>It is possible to use the CLM/with-sound reverbs (or any such instrument) as
-an ordinary editing function:
-</p>
-
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(if (not (provided? 'snd-ws.scm)) (load-from-path "ws.scm"))
-(define* (clm-reverb-sound reverb-amount reverb (reverb-data '()) snd)
- (let ((output (<a class=quiet href="extsnd.html#sndtempnam" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndtempnam_tip)">snd-tempnam</a>))
- (revout (<a class=quiet href="extsnd.html#sndtempnam" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndtempnam_tip)">snd-tempnam</a>))
- (len (+ (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> snd) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd))))
- (<a class=quiet href="extsnd.html#scaleby" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleby_tip)">scale-by</a> (- 1.0 reverb-amount) snd)
- (<a class=quiet href="extsnd.html#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a> output snd)
- (<a class=quiet href="extsnd.html#undo" onmouseout="UnTip()" onmouseover="Tip(extsnd_undo_tip)">undo</a> 1 snd)
- (<a class=quiet href="extsnd.html#scaleby" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleby_tip)">scale-by</a> reverb-amount snd)
- (<a class=quiet href="extsnd.html#savesoundas" onmouseout="UnTip()" onmouseover="Tip(extsnd_savesoundas_tip)">save-sound-as</a> revout snd)
- (<a class=quiet href="extsnd.html#undo" onmouseout="UnTip()" onmouseover="Tip(extsnd_undo_tip)">undo</a> 1 snd)
- (dynamic-wind
- (lambda ()
- (set! *output* (<a class=quiet href="sndclm.html#continue-sampletofile" onmouseout="UnTip()" onmouseover="Tip(sndclm_continue_sampletofile_tip)">continue-sample->file</a> output))
- (set! (<a class=quiet href="sndclm.html#mussrate" onmouseout="UnTip()" onmouseover="Tip(sndclm_mussrate_tip)">mus-srate</a>) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> snd))
- (set! *reverb* (<a class=quiet href="sndclm.html#make-filetosample" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_filetosample_tip)">make-file->sample</a> revout)))
- (lambda ()
- (apply reverb reverb-data))
- (lambda ()
- (<a class=quiet href="sndclm.html#mus-close" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_close_tip)">mus-close</a> *reverb*)
- (<a class=quiet href="sndclm.html#mus-close" onmouseout="UnTip()" onmouseover="Tip(sndclm_mus_close_tip)">mus-close</a> *output*)
- (set! *reverb* #f)
- (set! *output* #f)
- (delete-file revout)
- (set! (<a class=quiet href="extsnd.html#samples" onmouseout="UnTip()" onmouseover="Tip(extsnd_samples_tip)">samples</a> 0 len snd #f #f #f 0 #f #t) output)))))
-
-(clm-reverb-sound .1 jc-reverb)
-</pre></td></tr></table>
-
-<p>Another approach to this problem would be to use <a href="extsnd.html#sndtosample">snd->sample</a> to
-redirect the *reverb* input (without any change to the reverberator),
-getting its data from the current sound (probably after scaling it
-by the reverb amount).
-</p>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:reverb jc-reverb :reverb-data '(#t 1.5 (0 0 1 1 2 1 3 0))) (fm-violin 0 .1 440 .1))
+</pre>
+
<!-- INDEX reverbexamples:Reverb -->
-<A NAME="reverbexamples"></a>
-<TABLE border=3 bordercolor="tan" hspace=40>
-<tr><td width="50%">
+
+<TABLE class="method">
+<tr><td class="methodtitle">Reverbs in Snd</td></tr>
+<tr><td>
<blockquote><small>
-<br>
-Reverbs in Snd<br>
freeverb: <a href="#freeverbdoc">freeverb.scm, freeverb.rb</a><br>
jc-reverb: <a href="#jcrevdoc">jcrev.scm</a><br>
jl-reverb: <a href="#clminsdoc">clm-ins.scm</a><br>
nrev: <a href="#clminsdoc">clm-ins.scm</a><br>
control panel reverb: <a href="snd.html#reverb">Reverb</a>, <a href="extsnd.html#reverbdecay">control variables</a><br>
convolution reverb: <a href="extsnd.html#convolvewith">conrev</a><br>
-*reverb*: <a href="#wsdoc">with-sound</a><br>
-<br>
+*reverb*: <a href="#wsdoc">with-sound</a>
</small></blockquote>
</td></tr></TABLE>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: maraca ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="maracadoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>maraca</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: lint -->
+
+<div class="header" id="lintdoc">lint</div>
+
+<!-- main-index |lintdoc:lint for scheme -->
+
+<p>lint.scm is a lint program for Scheme. It tries to find errors or infelicities in your code.
+To try it:
+</p>
+
+<pre class="indented">
+(lint "some-code.scm")
+</pre>
+
+
+<p>lint tries to reduce false positives, so its default is somewhat laconic. There are several
+variables at the start of lint.scm to control additional output:
+</p>
+
+
+<pre class="indented">
+*report-unused-parameters* ; if #t, report unused function/macro parameters
+*report-unused-top-level-functions* ; if #t, report unused functions
+*report-undefined-variables* ; if #t, report undefined identifiers
+*report-shadowed-variables* ; if #t, report function parameters that are shadowed
+*report-minor-stuff* ; if #t, report all sorts of other stuff
+</pre>
+
+
+<p>lint is not real smart about functions defined outside the current file, so *report-undefined-variables*
+sometimes is confused. *report-minor-stuff* adds output about overly complicated boolean and numerical
+expressions, dangerous floating point operations, bad docstrings (this check is easily confused), and
+whatever else it finds that it thinks is odd.
+</p>
+
+
+
+
+<!-- FILE: maraca -->
+
+<div class="header" id="maracadoc">maraca</div>
<!-- main-index |maracadoc:maracas -->
<p>The maracas are physical models developed by Perry Cook (CMJ, vol 21 no 3 Fall 97, p 44).
</p>
-<pre>
- <em class=emdef>maraca</em> beg dur
+
+<pre class="indented">
+<em class=emdef>maraca</em> beg dur
+ (amp .1)
+ (sound-decay 0.95)
+ (system-decay 0.999)
+ (probability .0625)
+ (shell-freq 3200.0)
+ (shell-reso 0.96)
+
+maraca: (<a class=quiet href="#wsdoc">with-sound</a> () (maraca 0 5 .5))
+cabasa: (<a class=quiet href="#wsdoc">with-sound</a> () (maraca 0 5 .5 0.95 0.997 0.5 3000.0 0.7))
+
+<em class=emdef>big-maraca</em> beg dur
(amp .1)
(sound-decay 0.95)
(system-decay 0.999)
(probability .0625)
- (shell-freq 3200.0)
- (shell-reso 0.96)
-
- maraca: (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (maraca 0 5 .5))
- cabasa: (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (maraca 0 5 .5 0.95 0.997 0.5 3000.0 0.7))
-
- <em class=emdef>big-maraca</em> beg dur
- (amp .1)
- (sound-decay 0.95)
- (system-decay 0.999)
- (probability .0625)
- (shell-freqs '(3200.0))
- (shell-resos '(0.96))
- (randiff .01)
- (with-filters #t)
-
- tambourine:
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (big-maraca 0 1 .25 0.95 0.9985 .03125 '(2300 5600 8100) '(0.96 0.995 0.995) .01))
-
- sleighbells:
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (big-maraca 0 2 .15 0.97 0.9994 0.03125 '(2500 5300 6500 8300 9800)
- '(0.999 0.999 0.999 0.999 0.999)))
-
- sekere:
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (big-maraca 0 2 .5 0.96 0.999 .0625 '(5500) '(0.6)))
-
- windchimes:
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (big-maraca 0 4 .5 0.99995 0.95 .001 '(2200 2800 3400) '(0.995 0.995 0.995) .01 #f))
+ (shell-freqs '(3200.0))
+ (shell-resos '(0.96))
+ (randiff .01)
+ (with-filters #t)
+
+tambourine:
+ (<a class=quiet href="#wsdoc">with-sound</a> ()
+ (big-maraca 0 1 .25 0.95 0.9985 .03125 '(2300 5600 8100) '(0.96 0.995 0.995) .01))
+
+sleighbells:
+ (<a class=quiet href="#wsdoc">with-sound</a> ()
+ (big-maraca 0 2 .15 0.97 0.9994 0.03125 '(2500 5300 6500 8300 9800)
+ '(0.999 0.999 0.999 0.999 0.999)))
+
+sekere:
+ (<a class=quiet href="#wsdoc">with-sound</a> ()
+ (big-maraca 0 2 .5 0.96 0.999 .0625 '(5500) '(0.6)))
+
+windchimes:
+ (<a class=quiet href="#wsdoc">with-sound</a> ()
+ (big-maraca 0 4 .5 0.99995 0.95 .001 '(2200 2800 3400) '(0.995 0.995 0.995) .01 #f))
</pre>
+
<p>
big-maraca is like maraca, but takes a list of resonances and includes low-pass filter (or no filter).
</p>
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="#noisedoc" onmouseout="UnTip()" onmouseover="Tip('FM noise instrument')">noise</a> <a href="sndclm.html#randdoc" onmouseout="UnTip()" onmouseover="Tip('random number generators')">rand</a>
-</pre></td>
-</tr></table>
+<div class="seealso">
+see also: <a href="#noisedoc">noise</a> <a href="sndclm.html#randdoc">rand</a>
+</div>
-<br>
-<!-- ---------------------------------------- FILE: marks ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="marksdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>marks</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: marks -->
+
+<div class="header" id="marksdoc">marks</div>
<p>marks.scm/rb is a collection of mark-related functions.
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
<!-- define-selection-via-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="defineselectionviamarks">define-selection-via-marks</a> <code>m1 m2</code>
-</td></tr><tr><td width=30></td><td>
-define-selection-via-marks selects the portion between the given marks, then returns the selection length.
+<pre class="indented">
+<em class=def id="defineselectionviamarks">define-selection-via-marks</em> m1 m2
+</pre>
+
+<p>define-selection-via-marks selects the portion between the given marks, then returns the selection length.
The marks defining the selection bounds must be in the same channel.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- describe-mark -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
- <a class=def name="describemark">describe-mark</a> <code>mark</code>
-</td></tr><tr><td></td><td>
-describe-mark returns a description of the movements of the mark over the channel's edit history:
-<pre>
- :<em class=typing>(define m (add-mark 1234))</em>
- <em class=listener>m</em>
- :<em class=typing>(describe-mark m)</em>
- <em class=listener>((#<mark 1> sound: 0 "oboe.snd" channel: 0) 1234 478)</em>
+<pre class="indented">
+<em class=def id="describemark">describe-mark</em> mark
</pre>
-Here I placed a mark in oboe.snd at sample 1234, then deleted a few samples
-before it, causing it to move to sample 478.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>describe-mark returns a description of the movements of the mark over the channel's edit history:
+</p>
-<!-- eval-bewteen-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
- <a class=def name="evalbetweenmarks">eval-between-marks</a> <code>func</code>
-</td></tr><tr><td></td><td>
-eval-between-marks evaluates 'func'
-between the leftmost marks in the currently selected channel.
-'func' should take one argument, a sample, and return the new sample value.
-<pre>
- (eval-between-marks (lambda (y) (* y 2)))
-</pre>
-doubles the samples between the two chosen marks, then returns a vct with the new data (I can't
-remember why this is returned — it doesn't seem necessary).
-<pre>
- (<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\m 0
- (lambda () "eval between marks"
- (<a class=quiet href="extsnd.html#promptinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_promptinminibuffer_tip)">prompt-in-minibuffer</a> "mark eval:" eval-between-marks)))
+<pre class="indented">
+> (define m (add-mark 1234))
+m
+> (describe-mark m)
+((#<mark 1> sound: 0 "oboe.snd" channel: 0) 1234 478)
</pre>
-prompts for a function in the minibuffer, then evaluates it between the marks.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>Here I placed a mark in oboe.snd at sample 1234, then deleted a few samples
+before it, causing it to move to sample 478.
+</p>
+<div class="spacer"></div>
<!-- fit-selection-between-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="fitselectionbetweenmarks">fit-selection-between-marks</a> <code>m1 m2</code>
-</td></tr><tr><td></td><td>
-fit-selection-between-marks tries to squeeze the current selection between two marks,
+<pre class="indented">
+<em class=def id="fitselectionbetweenmarks">fit-selection-between-marks</em> m1 m2
+</pre>
+
+<p>fit-selection-between-marks tries to squeeze the current selection between two marks,
using the granulate generator to fix up the selection duration (it currently does a less than perfect job).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mark-click-info -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="markclickinfo">mark-click-info</a> <code>mark</code>
-</td></tr><tr><td></td><td>
-mark-click-info is a <a href="extsnd.html#markclickhook">mark-click-hook</a> function that describes a mark and its properties. It
+<pre class="indented">
+<em class=def id="markclickinfo">mark-click-info</em> mark
+</pre>
+
+<p>mark-click-info is a <a href="extsnd.html#markclickhook">mark-click-hook</a> function that describes a mark and its properties. It
is used by <a href="#withmarkedsound">with-marked-sound</a> in ws.scm.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mark-explode -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="markexplode">mark-explode</a> <code>(htype mus-next) (dformat mus-bfloat)</code>
-</td></tr><tr><td></td><td>
-mark-explode splits a sound into a bunch of separate files based on mark placements. Each mark becomes the
+<pre class="indented">
+<em class=def id="markexplode">mark-explode</em> (htype mus-next) (dformat mus-bfloat)
+</pre>
+
+<p>mark-explode splits a sound into a bunch of separate files based on mark placements. Each mark becomes the
first sample of a separate sound.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mark-name->id -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="marknametoid">mark-name->id</a> <code>name</code>
-</td></tr><tr><td></td><td>
-mark-name->id is like <a href="extsnd.html#findmark">find-mark</a>, but searches all currently accessible channels.
-If a such a mark doesn't exist, it returns <code>'no-such-mark</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="marknametoid">mark-name->id</em> name
+</pre>
+
+<p>mark-name->id is like <a href="extsnd.html#findmark">find-mark</a>, but searches all currently accessible channels.
+If a such a mark doesn't exist, it returns 'no-such-mark.
+</p>
+<div class="spacer"></div>
<!-- move-syncd-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="movesyncdmarks">move-syncd-marks</a> <code>sync samples-to-move</code>
-</td></tr><tr><td></td><td>
-move-syncd-marks moves any marks sharing the <a href="extsnd.html#marksync">mark-sync</a> value 'sync' by
+<pre class="indented">
+<em class=def id="movesyncdmarks">move-syncd-marks</em> sync samples-to-move
+</pre>
+
+<p>move-syncd-marks moves any marks sharing the <a href="extsnd.html#marksync">mark-sync</a> value 'sync' by
'samples-to-move' samples.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- pad-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="padmarks">pad-marks</a> <code>marks secs</code>
-</td></tr><tr><td></td><td>
-pad-marks inserts 'secs' seconds of silence before each in a list of marks.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="padmarks">pad-marks</em> marks secs
+</pre>
+
+<p>pad-marks inserts 'secs' seconds of silence before each in a list of marks.
+</p>
+<div class="spacer"></div>
<!-- play-between-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="playbetweenmarks">play-between-marks</a> <code>snd m1 m2</code>
-</td></tr><tr><td></td><td>
-play-between-marks
+<pre class="indented">
+<em class=def id="playbetweenmarks">play-between-marks</em> snd m1 m2
+</pre>
+
+<p>play-between-marks
plays the portion in the sound 'snd' between the given marks.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- play-syncd-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="playsyncdmarks">play-syncd-marks</a> <code>sync</code>
-</td></tr><tr><td></td><td>
-play-syncd-marks starts
+<pre class="indented">
+<em class=def id="playsyncdmarks">play-syncd-marks</em> sync
+</pre>
+
+<p>play-syncd-marks starts
playing from all the marks sharing its 'sync' argument (see <a href="extsnd.html#marksync">mark-sync</a>).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- report-mark-names -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="reportmarknames">report-mark-names</a>
-</td></tr><tr><td></td><td>
-report-mark-names causes a named mark to display its name in the minibuffer when
+<pre class="indented">
+<em class=def id="reportmarknames">report-mark-names</em>
+</pre>
+
+<p>report-mark-names causes a named mark to display its name in the status area when
its sample happens to be played.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- save-mark-properties -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="savemarkproperties">save-mark-properties</a>
-</td></tr><tr><td></td><td>
-save-mark-properties sets up an <a href="extsnd.html#aftersavestatehook">after-save-state-hook</a> function to save any mark-properties.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="savemarkproperties">save-mark-properties</em>
+</pre>
+
+<p>save-mark-properties sets up an <a href="extsnd.html#aftersavestatehook">after-save-state-hook</a> function to save any mark-properties.
+</p>
+<div class="spacer"></div>
<!-- snap-mark-to-beat -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="snapmarktobeat">snap-mark-to-beat</a>
-</td></tr><tr><td></td><td>
-snap-mark-to-beat forces a dragged mark to end up on a beat.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="snapmarktobeat">snap-mark-to-beat</em>
+</pre>
+
+<p>snap-mark-to-beat forces a dragged mark to end up on a beat.
+</p>
+<div class="spacer"></div>
<!-- snap-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="snapmarks">snap-marks</a>
-</td></tr><tr><td></td><td>
-snap-marks places marks at the start and end of the current selection in all its portions (i.e. in every channel that
+<pre class="indented">
+<em class=def id="snapmarks">snap-marks</em>
+</pre>
+
+<p>snap-marks places marks at the start and end of the current selection in all its portions (i.e. in every channel that
has selected data).
It returns a list of all the marks it has added.
-<pre>
- :<em class=typing>(selection-position)</em>
- <em class=listener>360</em>
- :<em class=typing>(selection-frames)</em>
- <em class=listener>259</em>
- :<em class=typing>(snap-marks)</em>
- <em class=listener>(#<mark 0> #<mark 1>)</em>
- :<em class=typing>(mark-sample (integer->mark 0))</em>
- <em class=listener>360</em>
- :<em class=typing>(mark-sample (integer->mark 1))</em>
- <em class=listener>619</em>
+</p>
+
+<pre class="indented">
+> (selection-position)
+360
+> (selection-framples)
+259
+> (snap-marks)
+(#<mark 0> #<mark 1>)
+> (mark-sample (integer->mark 0))
+360
+> (mark-sample (integer->mark 1))
+619
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- syncup -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="syncup">syncup</a> <code>marks</code>
-</td></tr><tr><td></td><td>
-syncup synchronizes a list of marks (positions them all at the same sample number) by inserting silences as needed.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="syncup">syncup</em> marks
+</pre>
-</table>
+<p>syncup synchronizes a list of marks (positions them all at the same sample number) by inserting silences as needed.
+</p>
<p>marks.scm also has code that tries to make it simpler to sync marks together —
you just click the marks that should share a <a href="extsnd.html#marksync">mark-sync</a> field,
rather than laboriously setting each one in the listener;
-see <b>start-sync</b> and <b>stop-sync</b>.
+see start-sync and stop-sync.
There is also some code (look for "eval-header" toward the end of the file) that saves mark info in a
sound file header, and reads it when the file is subsequently reopened.
</p>
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="#addmarkpane" onmouseout="UnTip()" onmouseover="Tip('channel pane describing marks')">add-mark-pane</a> <a href="extsnd.html#sndmarks" onmouseout="UnTip()" onmouseover="Tip('general discussion of marks in Snd')">Marks</a> <a href="#markloops" onmouseout="UnTip()" onmouseover="Tip('place marks at loop points')">mark-loops</a> <a href="#menusdoc" onmouseout="UnTip()" onmouseover="Tip('add a top-level Marks menu')">marks-menu</a>
-</pre></td>
-</tr></table>
+<div class="seealso">
+see also: <a href="#addmarkpane">add-mark-pane</a> <a href="extsnd.html#sndmarks">Marks</a> <a href="#markloops">mark-loops</a> <a href="#menusdoc">marks-menu</a>
+</div>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: maxf ---------------------------------------- -->
+<!-- FILE: maxf -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="maxfdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>maxf</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="maxfdoc">maxf</div>
<p>These files are translations (thanks to Michael Scholz!) of CLM's maxf.ins
(thanks to Juan Reyes!). They implement a variant of the CLM <a href="sndclm.html#formant">formant</a> generator developed
@@ -6273,128 +6634,129 @@ For a version of the filter closer to the paper, see the <a href="sndclm.html#fi
maxf.scm and maxf.rb provide a kind of demo instrument showing various ways to
use the filter (banks tuned to different sets of frequencies, etc).
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (maxfilter "dog.snd" 0))
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100) (maxfilter "dog.snd" 0 :numf 12))
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100) (maxfilter "dog.snd" 0 :numf 13 :att 0.75))
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100) (maxfilter "dog.snd" 0 :numf 2 :att 0.25 :freqfactor 0.5))
-</pre>
-<pre>
+<pre class="indented">
<em class=emdef>maxfilter</em> file beg (att 1.0) (numf 1) (freqfactor 1.0) (amplitude 1.0)
(amp-env '(0 1 100 1)) (degree (random 90.0)) (distance 1.0) (reverb-amount 0.2)
</pre>
-<br><br>
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (maxfilter "dog.snd" 0))
+(<a class=quiet href="#wsdoc">with-sound</a> (:srate 44100) (maxfilter "dog.snd" 0 :numf 12))
+(<a class=quiet href="#wsdoc">with-sound</a> (:srate 44100) (maxfilter "dog.snd" 0 :numf 13 :att 0.75))
+(<a class=quiet href="#wsdoc">with-sound</a> (:srate 44100) (maxfilter "dog.snd" 0 :numf 2 :att 0.25 :freqfactor 0.5))
+</pre>
+
-<!-- ---------------------------------------- FILE: menus ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="menusdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>menus</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: menus -->
+
+<div class="header" id="menusdoc">menus</div>
<!-- main-index |menusdoc:menus, optional -->
<p>The files described in this section either add new top-level menus to Snd, or
-modify existing ones. Most were written by Dave Phillips; see his tutorial for
-pictures and a more complete discussion.
+modify existing ones. Most were written by Dave Phillips.
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20 vspace=10>
<!-- edit-menu -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>edit-menu.scm</em>
-</td></tr><tr><td width=30></td><td>
-edit-menu.scm adds some useful options to the Edit menu:
-<pre>
- Selection->new ; save selection in a new file, open that file
- Cut selection->new ; save selection in a new file, delete selection, open the file
- Append selection ; append selection to end of selected sound
- Make stereofile ; make a new 2-chan file, copy currently selected sound to it
- Trim front ; find first mark in each sync'd channel and remove all samples before it
- Trim back ; find last mark in each sync'd channel and remove all samples after it
- Crop ; find first and last mark in each sync'd channel and remove all samples outside them
</pre>
-<!-- I(trim sound):M(Edit: Trim)(menusdoc) -->
-<!-- I(trim sound):A(menusdoc) -->
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>edit-menu.scm adds some useful options to the Edit menu:
+</p>
+
+<pre class="indented">
+Selection->new ; save selection in a new file, open that file
+Cut selection->new ; save selection in a new file, delete selection, open the file
+Append selection ; append selection to end of selected sound
+Make stereofile ; make a new 2-chan file, copy currently selected sound to it
+Trim front ; find first mark in each sync'd channel and remove all samples before it
+Trim back ; find last mark in each sync'd channel and remove all samples after it
+Crop ; find first and last mark in each sync'd channel and remove all samples outside them
+</pre>
+
+<!-- I(trim sound):M(Edit: Trim)(menusdoc) -->
+<!-- I(trim sound):A(menusdoc) -->
+<div class="separator"></div>
<!-- fft-menu.scm -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>fft-menu.scm</em>
-</td></tr><tr><td></td><td>
-fft-menu.scm adds an "FFT Edits" top-level menu. It has entries for:
-<pre>
- FFT notch filter ; use FFT to notch out a portion of the spectrum
- FFT squelch ; use FFT to squelch low-level noise
- Squelch vowels ; use FFT to squelch vowel-like portions of speech
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>fft-menu.scm adds an "FFT Edits" top-level menu. It has entries for:
+</p>
+<pre class="indented">
+FFT notch filter ; use FFT to notch out a portion of the spectrum
+FFT squelch ; use FFT to squelch low-level noise
+Squelch vowels ; use FFT to squelch vowel-like portions of speech
+</pre>
-<!-- kmenu.scm -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>kmenu.scm</em>
-</td></tr><tr><td></td><td>
-kmenu.scm adds a bunch of mnemonics to the Gtk main menus.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="separator"></div>
<!-- marks-menu.scm -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>marks-menu.scm</em>
-</td></tr><tr><td></td><td>
-marks-menu.scm adds a "Marks" top-level menu with entries:
-<pre>
- Play between marks ; play samples between marks
- Loop play between marks ; continuous play looping between marks
- Trim before mark ; remove samples before mark
- Trim behind mark ; remove samples after mark
- Crop around marks ; remove samples outside marks
- Fit selection to marks ; squeeze selection to fit between marks
- Define selection by marks ; define selection based on marks
- Mark sync ; if on, click mark to sync with other marks
- Mark sample loop points ; place marks at header loop points, if any
- Show loop editor ; edit loop points; this dialog is not really functional yet
- Delete all marks ; delete all marks
- Explode marks to files ; writes a separate file for each set of marks
-</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<A NAME="neweffectsdoc"></A>
+</pre>
+
+<p>marks-menu.scm adds a "Marks" top-level menu with entries:
+</p>
+
+<pre class="indented">
+Play between marks ; play samples between marks
+Loop play between marks ; continuous play looping between marks
+Trim before mark ; remove samples before mark
+Trim behind mark ; remove samples after mark
+Crop around marks ; remove samples outside marks
+Fit selection to marks ; squeeze selection to fit between marks
+Define selection by marks ; define selection based on marks
+Mark sync ; if on, click mark to sync with other marks
+Mark sample loop points ; place marks at header loop points, if any
+Show loop editor ; edit loop points; this dialog is not really functional yet
+Delete all marks ; delete all marks
+Explode marks to files ; writes a separate file for each set of marks
+</pre>
+
+<div class="separator"></div>
+
+
<!-- new-effects.scm -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>new-effects.scm, effects-utils.scm, gtk-effects.scm, gtk-effects-utils.scm, effects.rb, effects.fs</em>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef id="neweffectsdoc">new-effects.scm, effects-utils.scm, gtk-effects.scm, gtk-effects-utils.scm, effects.rb, effects.fs</em>
+</pre>
-new-effects.scm (effects.rb, effects.fs) implements an Effects menu.
+<p>new-effects.scm (effects.rb, effects.fs) implements an Effects menu.
Use gtk-effects.scm with Gtk. There are a ton of choices, most of them
presented in separate dialogs. The gain dialog is illustrated below.
Some of the outer menu items are:
+</p>
-<table border=0 cellpadding=10><tr><td>
-<pre>
- Amplitude effects (gain, normalize)
- Delay effects (various echos)
- Filter effects (various filters)
- Frequency effects (src, expsrc)
- Modulation effects (AM)
- Reverbs (nrev, jcrev, convolution)
- Various (flange, locsig, etc)
- Octave down
- Remove clicks
- Remove DC
- Compand
- Reverse
+<table><tr><td>
+<pre class="indented">
+Amplitude effects (gain, normalize)
+Delay effects (various echos)
+Filter effects (various filters)
+Frequency effects (src, expsrc)
+Modulation effects (AM)
+Reverbs (nrev, jcrev, convolution)
+Various (flange, locsig, etc)
+Octave down
+Remove clicks
+Remove DC
+Compand
+Reverse
</pre>
+
</td><td>
-<img src="pix/gain.png" alt="gain effect dialog">
+<img class="indented" src="pix/gain.png" alt="gain effect dialog">
</td></tr></table>
<!-- I(reverse samples):M(Effects: Reverse)(menusdoc) -->
@@ -6405,40 +6767,42 @@ Some of the outer menu items are:
<!-- I(insert zeros):M(Effects: Add Silence)(menusdoc) -->
<!-- I(change tempo):M(Effects: Expsrc)(menusdoc) -->
-Most of these are either simple calls on Snd functions ("invert" is <code>(<a class=quiet href="extsnd.html#scaleby" onmouseout="UnTip()" onmouseover="Tip(extsnd_scaleby_tip)">scale-by</a> -1)</code>),
-or use functions in the other scm files. The actual operations follow the <a class=quiet href="extsnd.html#sync" onmouseout="UnTip()" onmouseover="Tip(extsnd_sync_tip)">sync</a> chain of the
+<p>Most of these are either simple calls on Snd functions ("invert" is (<a class=quiet href="extsnd.html#scaleby">scale-by</a> -1)),
+or use functions in the other scm files. The actual operations follow the <a class=quiet href="extsnd.html#sync">sync</a> chain of the
currently active channel.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="separator"></div>
<!-- special-menu.scm -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>special-menu.scm</em>
-</td></tr><tr><td></td><td>
-special-menu.scm adds a "Special" menu with entries:
-<pre>
- Append file
- MIDI to WAV (using Timidity)
- Record input channel
- Envelope new file (see <a href="#enveddoc">start-enveloping</a>)
- Play panned
- Save as MP3 (using bladeenc)
- Save as Ogg (using oggenc)
- Explode SF2 (using the code <a href="#explodesf2">explode-sf2</a> in examp.scm)
</pre>
-</td></tr>
-</table>
+<p>special-menu.scm adds a "Special" menu with entries:
+</p>
+
+<pre class="indented">
+Append file
+MIDI to WAV (using Timidity)
+Record input channel
+Envelope new file (see <a href="#enveddoc">start-enveloping</a>)
+Play panned
+Save as MP3 (using bladeenc)
+Save as Ogg (using oggenc)
+Explode SF2 (using the code <a href="#explodesf2">explode-sf2</a> in examp.scm)
+</pre>
+
<p>Associated with these menus is a group of files that change Snd's overall appearance, add a box of
handy icons, and so on: misc.scm, and new-backgrounds.scm.
-<b>new-backgrounds.scm</b> defines some background pictures that can be applied to all the
+new-backgrounds.scm defines some background pictures that can be applied to all the
Snd widgets: wood, granite, rough, blueish, and smoke. I think "rough" is the
default used by misc.scm.
</p>
<p>
-<b>misc.scm</b> loads these menus and interface improvements, adds several sound file extensions,
+misc.scm loads these menus and interface improvements, adds several sound file extensions,
makes sure all the widget backgrounds
reflect the current background choice (metal, granite, wood, etc),
adds some hook functions for mpeg files etc,
@@ -6446,439 +6810,338 @@ and
includes a number of options such as show-disk-space.
It then adds these menu items:
</p>
-<pre>
- File:Delete ; delete the selected file
- File:Rename ; rename the selected file
- Edit:Append selection ; append selection to end of current sound
- Edit:Replace with selection ; put copy of selection at cursor
+
+<pre class="indented">
+File:Delete ; delete the selected file
+File:Rename ; rename the selected file
+Edit:Append selection ; append selection to end of current sound
+Edit:Replace with selection ; put copy of selection at cursor
</pre>
+
<p>I think Dave expects you to customize this to suit yourself, perhaps even moving the stuff
you want to your initialization file.
</p>
+<div class="seealso">
+see also: <a href="extsnd.html#addtomainmenu">add-to-main-menu</a>.
+</div>
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="extsnd.html#addtomainmenu" onmouseout="UnTip()" onmouseover="Tip('add-to-main-menu and add-to-menu documentation')">add-to-main-menu</a> <a href="#openbuffer">Buffers menu</a>
-</pre></td>
-</tr></table>
-
-<br>
-<br>
-<!-- ---------------------------------------- FILE: mix ---------------------------------------- -->
+<!-- FILE: mix -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="mixdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>mix</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="mixdoc">mix</div>
<!-- main-index |mixdoc:cross-fade (amplitude) -->
<p>mix.scm provides various mix utilities.
</p>
-<table width="60%" border=0><tr><td bgcolor="lightgreen" align="center" valign="middle"><h3>mixes</h3></td></tr></table>
-
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
-
<!-- check-mix-tags -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="checkmixtags">check-mix-tags</a> <code>snd chn</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="checkmixtags">check-mix-tags</em> snd chn
+</pre>
check-mix-tags looks at the current mix tags in the given channel, and if any are
found that appear to be overlapping, it moves one of them down a ways.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- color-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="colormixes">color-mixes</a> <code>mix-list new-color</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="colormixes">color-mixes</em> mix-list new-color
+</pre>
color-mixes sets the color of each mix in 'mix-list' to 'new-color'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- delay-channel-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="delaychannelmixes">delay-channel-mixes</a> <code>beg dur snd chn</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="delaychannelmixes">delay-channel-mixes</em> beg dur snd chn
+</pre>
delay-channel-mixes adds dur (which can be negative) to the
begin time of each mix that starts after beg in the given channel.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- env-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="envmixes">env-mixes</a> <code>mix-list envelope</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="envmixes">env-mixes</em> mix-list envelope
+</pre>
env-mixes applies 'envelope' as an overall amplitude envelope to the mixes in 'mix-list'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- find-mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="findmix">find-mix</a> <code>sample snd chn</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="findmix">find-mix</em> sample snd chn
+</pre>
find-mix returns the identifier of the mix at sample 'sample' (or anywhere in the given channel if
'sample' is not specified), or #f if no mix is found.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-click-info -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="mixclickinfo">mix-click-info</a> <code>mix</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="mixclickinfo">mix-click-info</em> mix
+</pre>
mix-click-info is a <a href="extsnd.html#mixclickhook">mix-click-hook</a> function that posts a description of the
clicked mix in the help dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-click-sets-amp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="mixclicksetsamp">mix-click-sets-amp</a>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="mixclicksetsamp">mix-click-sets-amp</em>
+</pre>
mix-click-sets-amp adds a <a href="extsnd.html#mixclickhook">mix-click-hook</a> function so that
if you click a mix, it is removed (its amplitude is set to 0.0);
a subsequent click resets it to its previous value.
This is intended to make it easy to compare renditions with and without a given mix.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-maxamp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mixmaxamp">mix-maxamp</a> <code>mix</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="mixmaxamp">mix-maxamp</em> mix
+</pre>
mix-maxamp returns the maxamp in the given mix.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-name->id -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mixnametoid">mix-name->id</a> <code>name</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="mixnametoid">mix-name->id</em> name
+</pre>
mix-name->id returns the mix with the given name, or 'no-such-mix if none can be found.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mix-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mixsound">mix-sound</a> <code>file start</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="mixsound">mix-sound</em> file start
+</pre>
mix-sound mixes 'file' (all chans) into the currently selected sound at 'start'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
-<!-- mix->vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="mixtovct">mix->vct</a> <code>mix</code>
-</td></tr><tr><td></td><td>
-mix->vct returns a mix's samples in a vct.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- mix->float-vector -->
+<pre class="indented">
+<em class=def id="mixtovct">mix->float-vector</em> mix
+</pre>
+mix->float-vector returns a mix's samples in a float-vector.
+<div class="spacer"></div>
<!-- mixes-length -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>mixes-length</em> <code>mix-list</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef>mixes-length</em> mix-list
+</pre>
mixes-length returns the number of samples between the start of the first mix in 'mix-list' and
the last end point.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- mixes-maxamp -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>mixes-maxamp</em> <code>mix-list</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef>mixes-maxamp</em> mix-list
+</pre>
mixes-maxamp returns the maxamp of the mixes in 'mix-list'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- move-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="movemixes">move-mixes</a> <code>mix-list samps</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="movemixes">move-mixes</em> mix-list samps
+</pre>
move-mixes moves each mix in 'mix-list' by 'samps' samples. To move all sync'd mixes together whenever one of them is dragged:
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(hook-push <a class=quiet href="extsnd.html#mixreleasehook" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixreleasehook_tip)">mix-release-hook</a>
- (lambda (id samps-moved)
- (let ((result (= (<a class=quiet href="extsnd.html#mixsync" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixsync_tip)">mix-sync</a> id) 0)))
+<pre class="indented">
+(hook-push <a class=quiet href="extsnd.html#mixreleasehook">mix-release-hook</a>
+ (lambda (hook)
+ (let* ((id (hook 'id))
+ (samps-moved (hook 'samples))
+ (result (= (<a class=quiet href="extsnd.html#mixsync">mix-sync</a> id) 0)))
(if (not result)
- (<em class=red>move-mixes</em> (<a class=quiet href="#syncdmixes" onmouseout="UnTip()" onmouseover="Tip(sndscm_syncdmixes_tip)">syncd-mixes</a> (<a class=quiet href="extsnd.html#mixsync" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixsync_tip)">mix-sync</a> id)) samps-moved))
- result))
- #t) ; add this function to the end of the hook function list (this is a progn hook)
-</pre></td></tr></table>
-See also <a href="#snapmixtobeat">snap-syncd-mixes-to-beat</a>.
-</td></tr><tr><td colspan=2></td></tr>
+ (<em class=red>move-mixes</em> (<a class=quiet href="#syncdmixes">syncd-mixes</a> (<a class=quiet href="extsnd.html#mixsync">mix-sync</a> id)) samps-moved))
+ (set! (hook 'result) result))))
+</pre>
+
+<p>See also <a href="#snapmixtobeat">snap-syncd-mixes-to-beat</a>. </p>
+
<!-- pan-mix -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="panmix">pan-mix</a> <code>file beg env snd chn auto-delete</code>
-</td></tr><tr><td></td><td>
-pan-mix
+<pre class="indented">
+<em class=def id="panmix">pan-mix</em> file beg env snd auto-delete
+</pre>
+<p>pan-mix
mixes 'file' into the current sound starting at 'beg' using the envelope 'env'
to pan the mixed samples (0: all chan 1, 1: all chan 0).
So,
-<pre>
- (pan-mix \"oboe.snd\" 1000 '(0 0 1 1))
+</p>
+
+<pre class="indented">
+(pan-mix "oboe.snd" 1000 '(0 0 1 1))
</pre>
-goes from all chan 0 to all chan 1.
+
+<p>goes from all chan 0 to all chan 1.
'auto-delete' determines
whether the in-coming file should be treated as a temporary file and deleted when the mix
is no longer accessible.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- pan-mix-region -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>pan-mix-region</em> <code>region beg env snd chn</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef>pan-mix-region</em> region beg env snd
+</pre>
pan-mix-region is similar to pan-mix above, but mixes a region, rather than a file.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- pan-mix-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>pan-mix-selection</em> <code>beg env snd chn</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef>pan-mix-selection</em> beg env snd
+</pre>
pan-mix-selection is similar to pan-mix above, but mixes the current selection, rather than a file.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
-<!-- pan-mix-vct -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="panmixvct">pan-mix-vct</a> <code>vct beg env snd chn</code>
-</td></tr><tr><td></td><td>
-pan-mix-vct is similar to pan-mix above, but mixes a vct, rather than a file.
-The vct data represents one channel of sound.
+<!-- pan-mix-float-vector -->
+<pre class="indented">
+<em class=def id="panmixvct">pan-mix-float-vector</em> data beg env snd
+</pre>
+pan-mix-float-vector is similar to pan-mix above, but mixes a float-vector, rather than a file.
+The argument 'data' represents one channel of sound.
To sync all the panned mixes together:
-<pre>
- (let ((new-sync (+ 1 (<a class=quiet href="extsnd.html#mixsyncmax" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixsyncmax_tip)">mix-sync-max</a>))))
- (for-each
- (lambda (id)
- (set! (<a class=quiet href="extsnd.html#mixsync" onmouseout="UnTip()" onmouseover="Tip(extsnd_mixsync_tip)">mix-sync</a> id) new-sync))
- (<em class=red>pan-mix-vct</em> (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 10 .5) 100 '(0 0 1 1))))
+
+<pre class="indented">
+(let ((new-sync (+ 1 (<a class=quiet href="extsnd.html#mixsyncmax">mix-sync-max</a>))))
+ (for-each
+ (lambda (id)
+ (set! (<a class=quiet href="extsnd.html#mixsync">mix-sync</a> id) new-sync))
+ (<em class=red>pan-mix-float-vector</em> (make-float-vector 10 0.5) 100 '(0 0 1 1))))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- play-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="playmixes">play-mixes</a> <code>mix-list</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="playmixes">play-mixes</em> mix-list
+</pre>
play-mixes plays the mixes in 'mix-list'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- save-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="savemixes">save-mixes</a> <code>mix-list filename</code>
-</td></tr><tr><td></td><td>
-save-mixes saves the given mixes in the file 'filename'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- scale-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="scalemixes">scale-mixes</a> <code>mix-list scl</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="scalemixes">scale-mixes</em> mix-list scl
+</pre>
scale-mixes scales the amplitude of each mix in 'mix-list' by 'scl'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- scale-tempo -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="scaletempo">scale-tempo</a> <code>mix-list scl</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="scaletempo">scale-tempo</em> mix-list scl
+</pre>
scale-tempo changes the positions of the mixes in 'mix-list' to reflect a tempo change of 'scl'.
-<code>(scale-tempo (mixes 0 0) 2.0)</code> makes the mixes in snd 0, chan 0 happen twice as slowly.
-To reverse the order of the mixes: <code>(scale-tempo (mixes 0 0) -1)</code>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+(scale-tempo (mixes 0 0) 2.0) makes the mixes in snd 0, chan 0 happen twice as slowly.
+To reverse the order of the mixes: (scale-tempo (mixes 0 0) -1).
+<div class="spacer"></div>
<!-- set-mixes-tag-y -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>set-mixes-tag-y</em> <code>mix-list new-y</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef>set-mixes-tag-y</em> mix-list new-y
+</pre>
set-mixes-tag-y sets the tag y location of each mix in 'mix-list' to 'new-y'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- silence-all-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="silenceallmixes">silence-all-mixes</a>
-</td></tr><tr><td width=30></td><td>
+<pre class="indented">
+<em class=def id="silenceallmixes">silence-all-mixes</em>
+</pre>
This sets all mix amplitudes to 0.0.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- silence-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="silencemixes">silence-mixes</a> <code>mix-list</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="silencemixes">silence-mixes</em> mix-list
+</pre>
silence-mixes sets the amplitude of each mix in 'mix-list' to 0.0.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- snap-mix-to-beat -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="snapmixtobeat">snap-mix-to-beat</a>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="snapmixtobeat">snap-mix-to-beat</em>
+</pre>
snap-mix-to-beat forces a dragged mix to end up on a beat (see <a href="extsnd.html#xaxisstyle">x-axis-in-beats</a>).
-To turn this off, <code>(hook-remove mix-release-hook snap-mix-1)</code>. To snap the dragged mix,
-and every other mix syncd to it, use <b>snap-syncd-mixes-to-beat</b>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+To turn this off, (hook-remove mix-release-hook snap-mix-1). To snap the dragged mix,
+and every other mix syncd to it, use snap-syncd-mixes-to-beat.
+<div class="spacer"></div>
<!-- src-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="srcmixes">src-mixes</a> <code>mix-list scl</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="srcmixes">src-mixes</em> mix-list scl
+</pre>
src-mixes scales the speed (resampling ratio) of each mix in 'mix-list' by 'scl'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- sync-all-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>sync-all-mixes</em> <code>(new-sync 1)</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef>sync-all-mixes</em> (new-sync 1)
+</pre>
sync-all-mixes sets the mix-sync field of every active mix to 'new-sync'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- syncd-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def NAME="syncdmixes">syncd-mixes</a> <code>sync</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="syncdmixes">syncd-mixes</em> sync
+</pre>
syncd-mixes returns a list (possibly null) of all mixes whose mix-sync field is set to 'sync'.
Most of the functions in mix.scm take a 'mix-list'; to form that list based on a given
mix-sync value, use syncd-mixes:
-<pre>
- (<a class=quiet href="#scalemixes" onmouseout="UnTip()" onmouseover="Tip(sndscm_scalemixes_tip)">scale-mixes</a> (syncd-mixes 2) 2.0)
+
+<pre class="indented">
+(<a class=quiet href="#scalemixes">scale-mixes</a> (syncd-mixes 2) 2.0)
</pre>
+
which scales the amplitude by 2.0 of any mix whose mix-sync field is 2.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- transpose-mixes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="transposemixes">transpose-mixes</a> <code>mix-list semitones</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=def id="transposemixes">transpose-mixes</em> mix-list semitones
+</pre>
transpose-mixes sets the speed of mix in 'mix-list' to cause a transposition by the given number of semitones.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-</table>
-
-<br>
-
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="extsnd.html#sndmixes">Mixes</a> <a href="snd.html#mixingfiles">View:Mix</a> <a href="#mixchannel">mix-channel</a> <a href="#fadedoc">dissolve-fade</a> <a href="#musmix">mus-mix</a>
-</pre></td>
-</tr></table>
+<div class="spacer"></div>
+<div class="seealso">
+see also: <a href="extsnd.html#sndmixes">Mixes</a> <a href="snd.html#mixingfiles">View:Mix</a> <a href="#mixchannel">mix-channel</a> <a href="#fadedoc">dissolve-fade</a> <a href="#musfilemix">mus-file-mix</a>
+</div>
-<br>
-<!-- INDEX mixerdoc:Matrices -->
-<br>
-<!-- ---------------------------------------- FILE: mixer ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="mixerdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>mixer</h2></td></tr></table>
-</td></tr></table>
-
-<!-- main-index |mixerdoc:mixer as matrix -->
-
-<p>mixer.scm has functions related to mixers and frames (linear algebra). There are some
-others in the relevant section of snd-test. (In Ruby, see mix.rb).
-</p>
+<!-- FILE: moog -->
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>make-zero-mixer</em> <code>size</code><br>
-<em class=emdef>mixer-diagonal?</em> <code>mixer</code><br>
-<a class=def name="mixer-transpose">mixer-transpose</a> <code>mixer</code><br>
-<a class=def name="mixer-determinant">mixer-determinant</a> <code>mixer</code><br>
-<em class=emdef>mixer-trace</em> <code>mixer</code><br>
-<a class=def name="mixer-poly">mixer-poly</a> <code>mixer coeffs</code><br>
-<a class=def name="mixer-inverse">mixer-inverse</a> <code>mixer</code><br>
-<a class=def name="mixer-solve">mixer-solve</a> <code>mixer frame</code><br>
-<a class=def name="mixercopy">mixer-copy</a> <code>mixer</code><br>
-<a class=def NAME="invertmatrix">invert-matrix</a> <code>mixer (b #f) (zero 1e-7)</code><br>
-</td></tr></table>
+<div class="header" id="moogdoc">moog</div>
-<p>
-mixer-solve is probably the most useful of these functions.
-If passed a mixer representing the coefficients of a set of simultaneous
-linear equations, and a frame representing the values thereof, it
-returns (in the original frame) the values of the independent
-variables, and (in the original mixer) the inverse of the matrix
-of coefficients.
-</p>
-<pre>
- :<em class=typing>(mixer-inverse (make-mixer 2 2.0 0.0 0.0 1.4))</em>
- <em class=listener>#<mixer: chans: 2, vals: [
- 0.500 0.000
- 0.000 0.714
- ]></em>
- :<em class=typing>(mixer-solve (make-mixer 2 1.0 1.0 2.0 1.0) (make-frame 2 4.0 5.0))</em>
- <em class=listener>#<frame[2]: [1.000 3.000]></em>
- ;; that is, x+y=4, 2x+y=5, so x=1, y=3
+<pre class="indented">
+<em class=emdef>make-moog-filter</em> frequency Q
+<em class=def id="moogfilter">moog-filter</em> gen input
</pre>
-<p>
-The rest should be obvious — these are mostly
-treating mixers as square matrices, and frames as row or column
-vectors, then performing the usual tricks upon them. There are
-more such functions in snd-test.
-</p>
-<pre>
- :<em class=typing>(mixer-determinant (make-mixer 2 1.0 0.0 2.0 1.0))</em>
- <em class=listener>1.0</em>
- :<em class=typing>(mixer-trace (make-mixer 2 1.0 0.0 2.0 1.5))</em>
- <em class=listener>2.5</em>
- :<em class=typing>(mixer-transpose (make-mixer 2 1.0 0.0 2.0 1.5))</em>
- <em class=listener>#<mixer: chans: 2, vals: [
- 1.000 2.000
- 0.000 1.500
- ]></em>
- :<em class=typing>(mixer-diagonal? (make-mixer 2 1.0 0.0 2.0 1.5))</em>
- <em class=listener>#f</em>
- :<em class=typing>(mixer-poly (make-mixer 2 1.0 0.0 0.0 1.0) 0.5 2.0)</em>
- <em class=listener>#<mixer: chans: 2, vals: [
- 2.500 0.000
- 0.000 2.500
- ]></em>
-</pre>
-<p>mixer-poly treats its mixer argument as the variable in a polynomial.
-The rest of the arguments are the polynomial coefficients starting with the constant term,
-so the example above computes
-</p>
-<pre>
- 2.0 * <b>M</b> + 0.5 * <b>I</b>
-</pre>
-
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="sndclm.html#polynomial">polynomial</a> <a href="#polydoc" onmouseout="UnTip()" onmouseover="Tip('polynomial stuff')">poly</a> <a href="sndclm.html#framedoc" onmouseout="UnTip()" onmouseover="Tip('frames and mixers in CLM')">mixers</a>
-</pre></td>
-</tr></table>
-
-<br>
-
-
-
-<!-- ---------------------------------------- FILE: moog ---------------------------------------- -->
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="moogdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>moog</h2></td></tr></table>
-</td></tr></table>
-
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>make-moog-filter</em> <code>frequency Q</code><br>
-<a class=def name="moogfilter">moog-filter</a> <code>gen input</code><br>
-</td></tr></table>
<p>moog is a translation of CLM's moog.lisp (written by Fernando Lopez-Lezcano —
http://ccrma.stanford.edu/~nando/clm/moog),
@@ -6891,42 +7154,40 @@ in Hz (more or less) and 'Q' controls the resonance: 0.0 = no resonance, whereas
1.0 causes the filter to oscillate at 'frequency'.
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
- (define (moog freq Q)
- (let ((gen (<em class=red>make-moog-filter</em> freq Q)))
- (lambda (inval)
- (<em class=red>moog-filter</em> gen inval))))
+<pre class="indented">
+(define (moog freq Q)
+ (let ((gen (<em class=red>make-moog-filter</em> freq Q)))
+ (lambda (inval)
+ (<em class=red>moog-filter</em> gen inval))))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (moog 1200.0 .7))
-</pre></td></tr></table>
+(<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (moog 1200.0 .7))
+</pre>
<p>The Ruby version of this is in examp.rb, and the Forth version is in examp.fs.
</p>
-<br>
-<!-- ---------------------------------------- FILE: musglyphs ---------------------------------------- -->
+<!-- FILE: musglyphs -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="musglyphs"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>musglyphs</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="musglyphs">musglyphs</div>
<p>musglyphs.scm provides Scheme/Snd wrappers to load CMN's cmn-glyphs.lisp (directly!),
thereby defining most of the standard music notation symbols. Each of the original
functions (e.g. draw-bass-clef) becomes a Snd/Scheme procedure of the form
-<code>(name x y size style snd chn context)</code>.
-<code>(draw-bass-clef 100 100 50)</code> draws a bass clef in the current graph
+(name x y size style snd chn context).
+(draw-bass-clef 100 100 50) draws a bass clef in the current graph
at position (100 100) of size 50; since the 'style' argument defaults to
#f, the clef is displayed as a filled polygon; use #t to get an outline of
the clef instead.
</p>
-<img src="pix/sndcmn.png" alt="Snd with music symbols" hspace=20>
-<br>
+<img class="indented" src="pix/sndcmn.png" alt="Snd with music symbols">
+
<p>This was created with:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (fm-violin 0 1 440 .1))
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (fm-violin 0 1 440 .1))
(define (draw-staff x0 y0 width line-sep)
(let ((cr (make-cairo (car (channel-widgets 0 0)))))
@@ -6934,7 +7195,7 @@ the clef instead.
(x x0)
(y y0 (+ y line-sep)))
((= line 5))
- (<a class=quiet href="extsnd.html#drawline" onmouseout="UnTip()" onmouseover="Tip(extsnd_drawline_tip)">draw-line</a> x y (+ x width) y 0 0 time-graph cr))
+ (<a class=quiet href="extsnd.html#drawline">draw-line</a> x y (+ x width) y 0 0 time-graph cr))
(free-cairo cr)))
(define (draw-a-440 x0 y0 size)
@@ -6945,11 +7206,12 @@ the clef instead.
(draw-treble-clef x0 (+ y0 (* size 61)) qsize)
(draw-quarter-note (+ x0 (* 70 size)) (+ y0 (* size 52)) qsize)
(let ((cr (make-cairo (car (channel-widgets 0 0)))))
- (<a class=quiet href="extsnd.html#fillrectangle" onmouseout="UnTip()" onmouseover="Tip(extsnd_fillrectangle_tip)">fill-rectangle</a> (+ x0 (* 90 size)) (- y0 (* size 10)) (* size 3) (* size 60) 0 0 time-graph #f cr)
+ (<a class=quiet href="extsnd.html#fillrectangle">fill-rectangle</a> (+ x0 (* 90 size)) (- y0 (* size 10)) (* size 3) (* size 60) 0 0 time-graph #f cr)
(free-cairo cr))))
(draw-a-440 50 80 1.0)
-</pre></td></tr></table>
+</pre>
+
<p>
A fancier <a href="extsnd.html#waltzexample">example</a> is included in musglyphs.scm. It takes a list of notes, each mixed as a virtual mix,
and displays the note pitches as music notation on two staves at the top of the graph. The two main
@@ -6963,14 +7225,11 @@ The note list data is passed into these functions by setting various <a href="ex
changes the mix pitch if you drag the note up or down.
</p>
-<br>
-<!-- ---------------------------------------- FILE: nb ---------------------------------------- -->
+<!-- FILE: nb -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="nbdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>nb</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="nbdoc">nb</div>
<p>nb.scm provides popup help for files in the View:Files dialog. As you move
the mouse through the file list, the help dialog posts information about the file
@@ -6979,37 +7238,35 @@ than <a href="#finfo">finfo</a> in examp.scm.
</p>
<!-- main-index |nbdoc:file database -->
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>nb</em> <code>file note</code><br>
-<em class=emdef>unb</em> <code>file</code><br>
+<pre class="indented">
+<em class=emdef>nb</em> file note
+<em class=emdef>unb</em> file
<em class=emdef>prune-db</em>
-</td></tr></table>
+</pre>
-<p>nb adds 'note' to the info associated with a file: <code>(nb "test.snd" "test's info")</code>.
-unb erases any info pertaining to a file: <code>(unb "test.snd")</code>.
+<p>nb adds 'note' to the info associated with a file: (nb "test.snd" "test's info").
+unb erases any info pertaining to a file: (unb "test.snd").
prune-db removes any info associated with defunct files.
The Ruby version of nb (written by Mike Scholz) has several other features — see nb.rb
for details.
</p>
-<br>
-<!-- ---------------------------------------- FILE: noise ---------------------------------------- -->
+<!-- FILE: noise -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="noisedoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>noise</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="noisedoc">noise</div>
<p>The noise files are translations (thanks to Michael Scholz) of CLM's noise.ins.
noise.ins has a very long pedigree; I think it dates back to about 1978. It can produce
those all-important whooshing sounds.
</p>
-<pre>
- <a class=def name="fmnoise">fm-noise</a> <code>startime dur freq0 amp ampfun ampat ampdc
- freq1 glissfun freqat freqdc rfreq0 rfreq1 rfreqfun rfreqat rfreqdc
- dev0 dev1 devfun devat devdc
- (degree 0.0) (distance 1.0) (reverb-amount 0.005)</code>
+
+<pre class="indented">
+<em class=def id="fmnoise">fm-noise</em> startime dur freq0 amp ampfun ampat ampdc
+ freq1 glissfun freqat freqdc rfreq0 rfreq1 rfreqfun rfreqat rfreqdc
+ dev0 dev1 devfun devat devdc
+ (degree 0.0) (distance 1.0) (reverb-amount 0.005)
</pre>
<p>
@@ -7028,59 +7285,60 @@ you start to get noise. Well, you get a different kind of noise.
whistle, very broad more of a whoosh. This is simple FM
where the modulating signal is white noise.
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (fm-noise 0 2.0 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1 1000 '(0 0 100 1) 0.1 0.1
- 10 1000 '(0 0 100 1) 0 0 100 500 '(0 0 100 1) 0 0))
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (fm-noise 0 2.0 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1 1000 '(0 0 100 1) 0.1 0.1
+ 10 1000 '(0 0 100 1) 0 0 100 500 '(0 0 100 1) 0 0))
</pre>
+
<p>
There is also a generator-like version of the instrument:
</p>
-<pre>
- <em class=emdef>make-fm-noise</em> <code>len freq (amp 0.25) (ampfun '(0 0 25 1 75 1 100 0)) (ampat 0.1)
- (ampdc 0.1) (freq1 1000) (glissfun '(0 0 100 1)) (freqat 0.1) (freqdc 0.1)
- (rfreq0 10) (rfreq1 1000) (rfreqfun '(0 0 100 1)) (rfreqat 0) (rfreqdc 0)
- (dev0 100) (dev1 500) (devfun '(0 0 100 1)) (devat 0) (devdc 0)
- (degree (random 90.0)) (distance 1.0) (reverb-amount 0.005)</code>
+
+<pre class="indented">
+<em class=emdef>make-fm-noise</em> len freq (amp 0.25) (ampfun '(0 0 25 1 75 1 100 0)) (ampat 0.1)
+ (ampdc 0.1) (freq1 1000) (glissfun '(0 0 100 1)) (freqat 0.1) (freqdc 0.1)
+ (rfreq0 10) (rfreq1 1000) (rfreqfun '(0 0 100 1)) (rfreqat 0) (rfreqdc 0)
+ (dev0 100) (dev1 500) (devfun '(0 0 100 1)) (devat 0) (devdc 0)
+ (degree (random 90.0)) (distance 1.0) (reverb-amount 0.005)
</pre>
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="#maracadoc" onmouseout="UnTip()" onmouseover="Tip('noisy physical models')">maraca</a> <a href="sndclm.html#randdoc" onmouseout="UnTip()" onmouseover="Tip('random number generators')">rand</a>
-</pre></td>
-</tr></table>
-<br>
+<div class="seealso">
+see also: <a href="#maracadoc">maraca</a> <a href="sndclm.html#randdoc">rand</a>
+</div>
-<!-- ---------------------------------------- FILE: numerics ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="numericsdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>numerics</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: numerics -->
+
+<div class="header" id="numericsdoc">numerics</div>
<p>This file has a variety of functions oriented toward some experiments that
so far haven't panned out.
</p>
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>factorial</em> <code>n</code><br>
-<em class=emdef>binomial</em> <code>n k</code><br>
-<em class=emdef>n-choose-k</em> <code>n k</code><br>
-<em class=emdef>plgndr</em> <code>l m x</code><br>
-<em class=emdef>legendre-polynomial</em> <code>a x</code><br>
-<em class=emdef>legendre</em> <code>n x</code><br>
-<em class=emdef>gegenbauer</em> <code>n x (alpha 0.0)</code><br>
-<em class=emdef>chebyshev-polynomial</em> <code>a x (kind 1)</code><br>
-<em class=emdef>chebyshev</em> <code>n x (kind 1)</code><br>
-<em class=emdef>hermite-polynomial</em> <code>a x</code><br>
-<em class=emdef>hermite</em> <code>n x</code><br>
-<em class=emdef>laguerre-polynomial</em> <code>a x (alpha 0.0)</code><br>
-<em class=emdef>laguerre</em> <code>n x (alpha 0.0)</code><br>
-<em class=emdef>Si</em> <code>x</code><br>
-<em class=emdef>Ci</em> <code>x</code><br>
-<em class=emdef>sin-m*pi/n</em> <code>m n</code><br>
-<em class=emdef>show-digits-of-pi-starting-at-digit</em> <code>start</code><br>
-</td></tr></table>
+<pre class="indented">
+<em class=emdef>factorial</em> n
+<em class=emdef>binomial</em> n k
+<em class=emdef>n-choose-k</em> n k
+<em class=emdef>plgndr</em> l m x
+<em class=emdef>legendre-polynomial</em> a x
+<em class=emdef>legendre</em> n x
+<em class=emdef>gegenbauer</em> n x (alpha 0.0)
+<em class=emdef>chebyshev-polynomial</em> a x (kind 1)
+<em class=emdef>chebyshev</em> n x (kind 1)
+<em class=emdef>hermite-polynomial</em> a x
+<em class=emdef>hermite</em> n x
+<em class=emdef>laguerre-polynomial</em> a x (alpha 0.0)
+<em class=emdef>laguerre</em> n x (alpha 0.0)
+<em class=emdef>Si</em> x
+<em class=emdef>Ci</em> x
+<em class=emdef>sin-m*pi/n</em> m n
+<em class=emdef>show-digits-of-pi-starting-at-digit</em> start
+</pre>
<p>In this case, "the code is the documentation" — these functions
are informal, experimental, etc.
@@ -7090,68 +7348,45 @@ if we can handle n. Currently n can be anything of the form 2^a 3^b 5^c 7^d 11^
so (sin-m*pi/n 1 60) returns an exact expression for sin(pi/60). The expression is not reduced
much.
</p>
-<pre>
- <em class=listener>:</em><em class=typing>(sin-m*pi/n 1 9)</em>
- <em class=listener>(/ (- (expt (+ (sqrt 1/4) (* 0+1i (sqrt 3/4))) 1/3) (expt (- (sqrt 1/4) (* 0+1i (sqrt 3/4))) 1/3)) 0+2i)</em>
- <em class=listener>:</em><em class=typing>(eval (sin-m*pi/n 1 9))</em>
- <em class=listener>0.34202014332567</em>
- <em class=listener>:</em><em class=typing>(sin (/ pi 9))</em>
- <em class=listener>0.34202014332567</em>
- <em class=listener>:</em><em class=typing>(sin (/ pi (* 257 17)))</em>
- <em class=listener>0.00071906440440859</em>
- <em class=listener>:</em><em class=typing>(eval (sin-m*pi/n 1 (* 17 257)))</em>
- <em class=listener>0.00071906440440875</em>
+
+<pre class="indented">
+> (sin-m*pi/n 1 9)
+(/ (- (expt (+ (sqrt 1/4) (* 0+1i (sqrt 3/4))) 1/3) (expt (- (sqrt 1/4) (* 0+1i (sqrt 3/4))) 1/3)) 0+2i)
+> (eval (sin-m*pi/n 1 9))
+0.34202014332567
+> (sin (/ pi 9))
+0.34202014332567
+> (sin (/ pi (* 257 17)))
+0.00071906440440859
+> (eval (sin-m*pi/n 1 (* 17 257)))
+0.00071906440440875
</pre>
+
<p>Another amusing function is show-digits-of-pi-starting-at-digit, translated from a C program
written by David Bailey. It shows 10 (hex) digits of the expansion of pi starting from any
point in that expansion.
</p>
-<br>
-
-
-<!-- ---------------------------------------- FILE: oscope ---------------------------------------- -->
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="oscopedoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>oscope</h2></td></tr></table>
-</td></tr></table>
-
-<!-- main-index |oscopedoc:oscilloscope dialog -->
-
-<p>oscope.scm sets up a dialog with a standard Snd channel window (time domain, fft etc) that
-displays the data read from the microphone in "real time".
-</p>
-
-<table border=0 cellpadding=10 hspace=20><tr><td>
-<img src="pix/sndosc.png" alt="oscilloscope dialog">
-</td><td>
-This is a snapshot of the oscope display (I'm singing "eeahhee" into the microphone); in normal operation, it's constantly updating both the
-waveform and the FFT. Eventually I hope to add a "waterfall" FFT display.
-</td></tr></table>
-
-<br>
-<!-- ---------------------------------------- FILE: peak-phases ---------------------------------------- -->
+<!-- FILE: peak-phases -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="peakphasesdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>peak-phases</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="peakphasesdoc">peak-phases</div>
-<p>This file contains the phases that produce a minimum peak amplitude ("low peak-factor") sum of sinusoids,
+<p>peak-phases.scm contains the phases that produce a minimum peak amplitude ("low peak-factor") sum of sinusoids,
the unpulse-train, so to speak. I started with the questions: given a sum of
n equal amplitude harmonically related sinusoids, what set of initial phases minimizes
the peak amplitude? What is that peak as a function of n? Can we find any pattern
to the initial phases so that a tiresome search is unnecessary? For the second question,
there are several simple cases. If all harmonics are cosines, the peak amplitude is
n (they all are 1 at the start). If we have 2 harmonics, and vary the initial phase of
-the 2nd from 0.0 to 2*pi, graphing the resulting peak amplitude, we get:
+the second from 0.0 to 2*pi, graphing the resulting peak amplitude, we get:
</p>
-<img src="pix/noid2.png" hspace=20 alt="n=2 case">
-<img src="pix/sum2.png" hspace=20 alt="n=2 case">
+<img class="indented" src="pix/noid2.png" alt="n=2 case">
+<img class="indented" src="pix/sum2.png" alt="n=2 case">
-<p>The graph on the left is the 2nd harmonic's initial phase vs the peak amplitude. Since 0.0
+<p>The graph on the left is the second harmonic's initial phase vs the peak amplitude. Since 0.0
appears to be a minimum (we can show that it is via simultaneous non-linear equations; see peak-phases.scm),
we can solve for the peak at that point using calculus: differentiate
sin(x) + sin(2x) to get cos(x) + 2cos(2x) = 4cos^2(x) + cos(x) -2, a quadratic equation
@@ -7163,7 +7398,8 @@ If we graph the peak location, we see that it is moving (nearly) linearly with t
then the two peaks cross, and the other one predominates from pi to 2*pi. So the peak amplitude as
a function of the initial-phase ("phi" below) is (very nearly):
</p>
-<pre>
+
+<pre class="indented">
(let* ((a (acos (/ (- (sqrt 33) 1) 8)))
(b (acos (/ (- 1 (sqrt 33)) 8)))
(ap (- (* 2 pi) a)) ; start location of peak 1 (the peak when phi is 0..pi)
@@ -7172,11 +7408,11 @@ a function of the initial-phase ("phi" below) is (very nearly):
(bx (+ ap (* phi (/ (- bp ap) pi))))) ; the 2 peaks move in opposite directions
(max (abs (+ (sin ax) (sin (+ (* 2 ax) phi)))) ; plug in the 2 locations and
(abs (+ (sin bx) (sin (+ (* 2 bx) phi)))))) ; return the max
-</pre>
+</pre>
+
<!--
(with-full-sound (:clipped #f :channels 2 :statistics #t :output "n2a.snd")
(let ((size 10000))
- (run
(let ((i 0)
(incr (/ (* 2 pi) size)))
(do ((phi1 0.0 (+ phi1 incr))
@@ -7202,12 +7438,13 @@ a function of the initial-phase ("phi" below) is (very nearly):
(bx (+ ap (* phi1 (/ (- bp ap) pi)))))
(outb i (max (abs (+ (sin ax) (sin (+ (* 2 ax) phi1))))
(abs (+ (sin bx) (sin (+ (* 2 bx) phi1)))))))
- (set! i (+ i 1))))))))
+ (set! i (+ i 1)))))))
-->
<p>
We can reduce the peak difference below .00000002 by using:
</p>
-<pre>
+
+<pre class="indented">
(let* ((waver (+ (* .002565 (sin (* 2 phi)))
(* .0003645 (sin (* 4 phi)))
(* .0001 (sin (* 6 phi)))
@@ -7217,8 +7454,9 @@ We can reduce the peak difference below .00000002 by using:
(* .0000035 (sin (* 14 phi)))))
(ax (- (+ b (* (- phi pi) (/ (- a b) pi))) waver))
(bx (- (+ ap (* phi (/ (- bp ap) pi))) waver)))
- ....)
+ ...)
</pre>
+
<p>
Similarly sin(x)+sin(3x) differentiated is cos(x)+3cos(3x) = 12cos^3(x)-8cos(x). cos(x)=0
is a minimum of the original, but the other case is acos(sqrt(2/3)) = 0.61547970867039,
@@ -7227,7 +7465,8 @@ initial phase, we get approximately 1.5396 + 0.4604 * sin(initial-phase).
As before, the location of the peak varies nearly linearly with the initial-phase, the end point
now being acos(-(sqrt(2/3))):
</p>
-<pre>
+
+<pre class="indented">
(let* ((a (acos (sqrt 2/3)))
(b (acos (- (sqrt 2/3))))
(ap (- (* 2 pi) a)) ; start loc peak 1
@@ -7238,10 +7477,10 @@ now being acos(-(sqrt(2/3))):
(abs (+ (sin bx) (sin (+ (* 3 bx) phi)))))) ; and return the max
</pre>
+
<!--
(with-full-sound (:clipped #f :channels 2 :statistics #t :output "n2b.snd")
(let ((size 10000))
- (run
(let ((i 0)
(incr (/ (* 2 pi) size)))
(do ((phi1 0.0 (+ phi1 incr))
@@ -7267,13 +7506,14 @@ now being acos(-(sqrt(2/3))):
(bx (- ax pi))) ; peak 2 (the two interleave)
(outb i (max (abs (+ (sin ax) (sin (+ (* 3 ax) phi1))))
(abs (+ (sin bx) (sin (+ (* 3 bx) phi1)))))))
- (set! i (+ i 1))))))))
+ (set! i (+ i 1)))))))
-->
<p>
sin(x)+sin(5x+a) becomes a quadratic in cos^2(x), so we can find the peak location as a function
of the initial-phase:
</p>
-<pre>
+
+<pre class="indented">
(let* ((a0 (* pi 1/2))
(a1 (acos (sqrt (/ (- 25 (sqrt 145)) 40))))
(ax (+ a0 (/ (* (- a1 a0) phi) pi)))
@@ -7285,10 +7525,10 @@ of the initial-phase:
(abs (+ (sin cx) (sin (+ (* 5 cx) phi))))
(abs (+ (sin dx) (sin (+ (* 5 dx) phi))))))
</pre>
+
<!--
(with-full-sound (:clipped #f :channels 3 :statistics #t :output "n2e.snd")
(let ((size 10000))
- (run
(let ((i 0)
(incr (/ (* 2 pi) size)))
(do ((phi1 0.0 (+ phi1 incr))
@@ -7317,17 +7557,10 @@ of the initial-phase:
(abs (+ (sin cx) (sin (+ (* 5 cx) phi1))))
(abs (+ (sin dx) (sin (+ (* 5 dx) phi1)))))))
(outc i loc)
- (set! i (+ i 1))))))))
-
-(%i29) -80*x^2+100*x-24;
- 2
-(%o29) - 80 x + 100 x - 24
-(%i30) solve(%, x);
- sqrt(145) - 25 sqrt(145) + 25
-(%o30) [x = - --------------, x = --------------]
- 40 40
+ (set! i (+ i 1)))))))
-->
+
<p>but now we have four peaks to track. The minimum peak is at initial-phase of pi,
and is 1.81571610422.
sin(x)+sin(4x+a) is much messier to handle in this manner when a=0 because it ends up in a quartic equation in cos(x).
@@ -7336,32 +7569,36 @@ A glance at the derivative, cos(x)+4*cos(4x+a), shows there is a 0 at (x=0, a=ac
A brute force search finds that the minimum peak (which is at initial-phase of 0) is at 1.940859829001 and is 1.9282082241513.
We could also use poly-roots in poly.scm:
</p>
-<pre>
- :(map (lambda (y)
+
+<pre class="indented">
+ > (map (lambda (y)
(+ (sin y) (sin (* 4 y))))
- (map acos (poly-roots (vct 4 1 -32 0 32)))) ; 4 + cos(x) - 32cos^2(x) + 32cos^4(x)
+ (map acos (poly-roots (float-vector 4 1 -32 0 32)))) ; 4 + cos(x) - 32cos^2(x) + 32cos^4(x)
(... 1.928208224151313892413267491649096952858E0 ...)
</pre>
+
<p>
I think in the sin(x)+sin(nx+a) case there's a minimum at a=pi, except when n=4k+3,
and the peak itself (at either pi/2 or 3pi/2) approaches 2 as n increases.
sin-nx-peak in numerics.scm searches for this peak, and for reasonable "n"
it can be compared to the equivalent search using poly-roots in poly.scm:
</p>
-<pre>
- :(sin-nx-peak 6)
+
+<pre class="indented">
+ > (sin-nx-peak 6)
(1.966832009581999989057660894590273760791E0 ...)
(map (lambda (y)
(+ (sin y) (sin (* 6 y))))
- (map acos (poly-roots (vct -6 1 108 0 -288 0 192)))) ; n*Tn + cos(x)
+ (map acos (poly-roots (float-vector -6 1 108 0 -288 0 192)))) ; n*Tn + cos(x)
(1.966832009581999989057661205729776550611E0 ...)
</pre>
+
<p>
Another case that is not too hard involves a sum of
n sines all at 0 initial phase. This can be expressed as:
</p>
-<img src="pix/sceq1.png" alt="sum of sines" hspace=40>
+<img class="indented" src="pix/sceq1.png" alt="sum of sines">
<p>which is the nsin generator in clm. Since the waveform is a two-sided
pulse with the first local maximum at the peak, we can easily search for that peak as n increases.
@@ -7373,29 +7610,107 @@ A sum of n odd harmonics behaves similarly (the peak comes half as far from the
but has the same max). A sum of n sines of alternating sign also has the same peak amp,
but now the peak is at pi-(3*pi)/(4*n).
Those are the easy cases. The next case involves 3 harmonics,
-where we vary the 2nd and 3rd harmonic's initial phase, looking for the minimum peak amplitude.
-One view of this terrain has the 2nd harmonic's initial phase on the Y axis, the 3rd's on the X axis,
+where we vary the second and third harmonic's initial phase, looking for the minimum peak amplitude.
+One view of this terrain has the second harmonic's initial phase on the Y axis, the third's on the X axis,
and the color for the height of the corresponding peak:
</p>
-<table border=0 hspace=40>
+<!--
+(define (deriv n x)
+ (+ (- (/ (* (cos (/ x 2))
+ (sin (/ (* n x) 2))
+ (sin (/ (* (+ n 1) x) 2)))
+ (* 2 (sin (/ x 2)) (sin (/ x 2)))))
+ (/ (* n
+ (cos (/ (* n x) 2))
+ (sin (/ (* (+ n 1) x) 2)))
+ (* 2 (sin (/ x 2))))
+ (/ (* (+ n 1)
+ (sin (/ (* n x) 2))
+ (cos (/ (* (+ n 1) x) 2)))
+ (* 2 (sin (/ x 2))))))
+
+which is hard to nail down; the zero crossing is 3pi/4n, I think, but numerically this is not anywhere near 0!
+
+:(deriv 10000 (- (/ (* 3 pi) 40000) .00001))
+2230252.363045
+:(deriv 10000 (+ (/ (* 3 pi) 40000) .00001))
+-3641295.807378
+:(deriv 10000 (+ (/ (* 3 pi) 40000) 0.0))
+-742517.21842268
+which is also the case in gmp
+
+The curve of the derivative looks very much like the two-sided sine pulse coming from n/2? down, crossing near 3pi/4n
+
+lim n->inf sum k=1 to n kcos(3kpi/4n) = 0
+at n = 1e9, the actual peak is at (- x 2.507212094348349975027e-11)
+i.e.
+ :(let* ((n 1e9) (x (/ (* 3 pi) (* 4 n)))) (deriv n (- x 2.507212094348349975027e-11)))
+ 3.725127687918788793358833288937859151702E-6
+or using
+(define (peak-at n)
+ (let* ((x (/ (* 3 pi) (* 4 n)))
+ (range (* x .8))
+ (err 1e-20))
+ (do ()
+ ((< (abs (deriv n x)) err)
+ (list (- x (/ (* 3 pi) (* 4 n)))
+ (deriv n x)))
+ (let ((lo (deriv n (- x range)))
+ (hi (deriv n (+ x range))))
+ (if (< (abs lo) (abs hi))
+ (set! x (- x (/ range 10)))
+ (set! x (+ x (/ range 10))))
+ (set! range (* range .9))))))
+
+or:
+2: -2.421677894348464908163819163773325479774E-1 -2.542109530109137315348541607895395692012E-21
+3: -1.181070918729755631206093082385937638842E-1 -3.493089933018897636165472895997622659429E-21
+4: -7.043276098568086392007563576860101749568E-2 -4.800338790899243746899352912973818251532E-21
+5: -4.707669254042527294644510729991788644279E-2 3.462251514314290744891714859502503645785E-21
+6: -3.387015497518456023533786854922157878053E-2 -5.550551819638322580161104253852648704675E-21
+7: -2.565623507080912890636745657363494539749E-2 5.667521137336683171337058660707235960645E-21
+8: -2.018765171370880262166473632066821173556E-2 -2.60075875807278930669457906973394842712E-21
+9: -1.635581204680970730391053813339506919918E-2 -2.49691060642061379906356071454917335827E-21
+10: -1.356168411128330953565403940042769994662E-2 3.806266181586793878107841906576959486354E-21
+11: -1.145811507171758934905894436740180168887E-2 -3.500075183808578156580231318788510376355E-21
+12: -9.83243017119212501337362936727640738345E-3 1.01480660438814124456364140502400386379E-22
+13: -8.548312956055249881979809501119340017916E-3 -7.239313585107067341837994688198940392904E-21
+14: -7.515046477014091277001818997621777552805E-3 -4.077646144271174537876436960403702130689E-21
+15: -6.670315400525027347449871935335883744278E-3 -2.405976623505729548206548219351450204594E-22
+16: -5.97013703538091639991154748789103345287E-3 -1.045882818863667721861763771430143995709E-21
+17: -5.382730445871958442467339348911179502178E-3 3.993689578581470072273709565896866011558E-21
+18: -4.88465508788404790507044492948019033614E-3 5.907366932923666851660865434938467677364E-21
+19: -4.4583061453239883124546788791877625504E-3 9.452118583104181906394835659535495032207E-21
+
+1e2: -3.666449064510999452172534004805209932E-4 -6.7133569632029478217918235054413664011649197E-21
+1e3: -2.623704523377842468822594954231187534E-5 -4.9923846428498028980296129156343442708035258E-21
+1e4: -2.518866953580949081116055241339673507E-6 -3.7781433570837640130110185268814176373422622E-21
+1e5: -2.508377532616470973577582856419671127E-7 4.5623432062101773657294017611973375042290476E-21
+1e6: -2.507328533847142227258073649062622639E-8 -4.6914838629061987833884085483344193742264034E-21
+1e7: -2.507223633403447489575620917160615658E-9 5.2291911761872083246687386421454377310046409E-22
+1e8: -2.507213143353410364121109699301712442E-10 8.2234860381608642958612200025313809610775802E-21
+1e9: -2.507212094348349975025739950520586963E-11 -4.7782070016528057029294375412260845056787478E-21
+1e10: -2.50721198944784336935067073338431120E-12 6.9107383981769940658781617913229048114198940E-21
+1e11: -2.50721197895779270311550845619211172E-13 1.6127270311176948101129176357022786397177201E-21
+1e12: -2.50721197790878763643531567488505006E-14 -1.455476537343183418317173409749413112473485E-21
+-->
+
+<table>
<tr><td>
-<table border=1>
+<table>
<tr><td>
-<img src="pix/n3a1.png" alt="3 harmonics in 3D">
-</td></tr><tr><td>
-<center>3 harmonics</center></td></tr></table>
+<img class="indented" src="pix/n3a1.png" alt="3 harmonics in 3D">
+</td></tr><tr><td class="center">3 harmonics</td></tr></table>
</td><td>
-<table border=1 hspace=40>
+<table>
<tr><td>
-<img src="pix/n3a2.png" alt="4 harmonics in 3D">
-</td></tr><tr><td>
-<center>4 harmonics</center></td></tr></table>
+<img class="indented" src="pix/n3a2.png" alt="4 harmonics in 3D">
+</td></tr><tr><td class="center">4 harmonics</td></tr></table>
</td></tr></table>
<!--
(with-sound (:clipped #f :channels 1 :statistics #t :output "n3.snd")
- (run
(let ((i 0)
(incr (/ (* 2 pi) 1000)))
(do ((phi1 0.0 (+ phi1 incr))
@@ -7417,14 +7732,13 @@ and the color for the height of the corresponding peak:
(set! pk (abs val))
(set! tpk val)))))
(outa i tpk)
- (set! i (+ i 1))))))))
+ (set! i (+ i 1)))))))
(with-sound (:clipped #f :channels 8 :statistics #t :output "n4.snd")
(let* ((size 200)
(incr (/ (* 2 pi) size))
(i 0))
- (run
(do ((phi1 0.0 (+ phi1 incr))
(j 0 (+ j 1)))
((= j size))
@@ -7445,28 +7759,28 @@ and the color for the height of the corresponding peak:
(if (> (abs val) pk)
(set! pk (abs val)))))
(out-any i pk m)))
- (set! i (+ i 1)))))))
+ (set! i (+ i 1))))))
(define (gad4)
(do ((i 0 (+ i 1)))
((= i 8))
- (map-channel (lambda (y) (/ (- (abs y) 2) 2)) 0 (frames) 0 i))
- (set! (selected-graph-color) (make-color 1 1 1))
- (set! (wavo-trace) 200)
- (set! (wavo-hop) 1)
- (set! (spectro-x-angle) 0)
- (set! (spectro-y-angle) 0)
- (set! (spectro-z-angle) 0)
- (set! (spectro-x-scale) 0.9)
- (set! (spectro-y-scale) 0.9)
- (set! (spectro-z-scale) 1.0)
- (set! (time-graph-type) graph-as-wavogram))
+ (map-channel (lambda (y) (/ (- (abs y) 2) 2)) 0 (framples) 0 i))
+ (set! *selected-graph-color* (make-color 1 1 1))
+ (set! *wavo-trace* 200)
+ (set! *wavo-hop* 1)
+ (set! *spectro-x-angle* 0)
+ (set! *spectro-y-angle* 0)
+ (set! *spectro-z-angle* 0)
+ (set! *spectro-x-scale* 0.9)
+ (set! *spectro-y-scale* 0.9)
+ (set! *spectro-z-scale* 1.0)
+ (set! *time-graph-type* graph-as-wavogram))
-->
<p>
I tilted the graph slightly to try to show how the colors match the peaks.
-If we set the 2nd component's phase to (a+pi)/2 where "a" is the 3rd one's initial phase,
+If we set the second component's phase to (a+pi)/2 where "a" is the third one's initial phase,
we travel along the minimum going diagonally through the middle of the graph (I think the
graph got truncated slightly: the top should match the bottom).
The graph on the right is
@@ -7478,54 +7792,56 @@ can be applied to any number
of dimensions (until we run out of disk space and patience), is to move through the possibilities
in much the way you'd count to 100; before each 10's digit increments, you'd count diligently
through all the 1's. Similarly, in the next set of graphs, we go from 0 to 2pi completely
-on one component before incrementing the next lower component. So, we get the 2nd component
+on one component before incrementing the next lower component. So, we get the second component
moving slowly from 0 to 2pi, and, in the n=3 case, at each step it takes, it waits until the
-3rd component has gone from 0 to 2pi. This way we get all possible initial phases graphed
+third component has gone from 0 to 2pi. This way we get all possible initial phases graphed
in a normal 2D picture. Here is the n=3 case. The top level looks a bit like the n=2 case, but
zooming in shows more complexity (each graph on the right is the selected portion of the one
on its left). (The complexity in this case is mostly due to the slice-at-a-time approach).
</p>
-<img src="pix/noid3.png" hspace=20 alt="n=3 case">
+<img class="indented" src="pix/noid3.png" alt="n=3 case">
<p>We're trying to pinpoint the minima (there appear to be 4 black areas in the 3D graph,
corresponding (I hope!) to the four minima in the second graph).
-A laborious search finds these values:
+A multiprecision search finds these values:
</p>
-<pre>
- 1.9798054823226 #(0.0 0.58972511242747172044431636095396243035 0.3166675693251937984129540382127743214)
- 1.9798054823226 #(0.0 1.58972511242745917492413809668505564332 0.3166675693251493894919690319511573761)
- 1.9798054823222 #(0.0 0.41027488757208596670267297668033279478 1.68333243067326587816268101960304193198)
- 1.9798054823222 #(0.0 1.41027488757208596670267297668033279478 1.68333243067326587816268101960304193198)
+
+<pre class="indented">
+ 1.9798054823226 #(0.0 0.58972511242747172044431636095396243035 0.3166675693251937984129540382127743214)
+ 1.9798054823226 #(0.0 1.58972511242745917492413809668505564332 0.3166675693251493894919690319511573761)
+ 1.9798054823222 #(0.0 0.41027488757208596670267297668033279478 1.68333243067326587816268101960304193198)
+ 1.9798054823222 #(0.0 1.41027488757208596670267297668033279478 1.68333243067326587816268101960304193198)
</pre>
+
<p>which shows that the minima are essentially at (23/39 19/60), (16/39 101/60), (1 + 23/39, 19/60), and (1 + 16/39, 101/60),
-all numbers multiplied by pi of course. (Our labor was mostly wasted; once we find one such point, the other 3
-can easily be calculated; see find-other-mins in peak-phases.scm).
+all numbers multiplied by pi of course. (Our labor was mostly wasted; once we find one such point, the symmetries of the
+sinusoids hand us the other three for free. See find-other-mins in peak-phases.scm).
</p>
<!--
(set! (srate 2) (round (/ 1000000 (* 2 pi))))
-(set! (axis-label-font) "9x15")
+(set! *axis-label-font* "9x15")
(define (window-bounds losamp hisamp snd chn)
(set! (left-sample snd chn) losamp)
- (set! (x-zoom-slider snd chn) (exact->inexact (/ (- hisamp losamp) (frames snd chn)))))
+ (set! (x-zoom-slider snd chn) (exact->inexact (/ (- hisamp losamp) (framples snd chn)))))
(window-bounds 283820 310346 1 0)
(set! (x-axis-label 0 0) "2's phase")
(set! (y-zoom-slider 1 0) (y-zoom-slider 0 0))
(set! (y-zoom-slider 2 0) (y-zoom-slider 0 0))
(set! (selection-member? 0 0) #t)
(set! (selection-position 0 0) 283820)
-(set! (selection-frames 0 0) (- 310346 283820))
+(set! (selection-framples 0 0) (- 310346 283820))
(set! (selection-member? 1 0) #t)
(set! (selection-position 1 0) 294528)
-(set! (selection-frames 1 0) (- 297881 294528))
+(set! (selection-framples 1 0) (- 297881 294528))
(set! (x-axis-label 1 0) "2's phase")
-->
<p>Here is n=4 graphed in the same way:
</p>
-<img src="pix/noid4.png" hspace=20 alt="n=4 case">
+<img class="indented" src="pix/noid4.png" alt="n=4 case">
<!--
(set! (srate 0) (round (/ 1000000 (* 2 pi))))
@@ -7535,17 +7851,17 @@ can easily be calculated; see find-other-mins in peak-phases.scm).
(window-bounds (- 436349 500) (+ 436349 500) 2 0)
(set! (selection-member? 0 0) #t)
(set! (selection-position 0 0) (- 436349 12000))
-(set! (selection-frames 0 0) 24000)
+(set! (selection-framples 0 0) 24000)
(set! (selection-member? 1 0) #t)
(set! (selection-position 1 0)(- 436349 500))
-(set! (selection-frames 1 0) 1000)
+(set! (selection-framples 1 0) 1000)
-->
<p>One of those minima might be the one we found near 2.04.
n=5:
</p>
-<img src="pix/noid5.png" hspace=20 alt="n=5 case">
+<img class="indented" src="pix/noid5.png" alt="n=5 case">
<!--
899171, 40000 2000
@@ -7556,7 +7872,7 @@ through the 5-D landscape, each 4-D case being 8 3-D slices as before (I forgot
here also, so despite appearances, blue is a maximum, and we're looking for the reddest point, the global minimum):
</p>
-<img src="pix/n5-all.png" alt="all" hspace=20>
+<img class="indented" src="pix/n5-all.png" alt="all">
<!-- montage -tile 8X1 n51a.png n52a.png n53a.png n54a.png n55a.png n56a.png n57a.png n58a.png n5-all.png -->
@@ -7564,12 +7880,11 @@ here also, so despite appearances, blue is a maximum, and we're looking for the
<p>And just for grins, here is the n=6 case:
</p>
-<img src="pix/n6.png" alt="n=6 case" hspace=20>
+<img class="indented" src="pix/n6.png" alt="n=6 case">
-->
<!--
(with-sound (:clipped #f :channels 64 :statistics #t :output "n5a.snd")
- (run
(let* ((i 0)
(size 400)
(incr (/ (* 2 pi) size))) ; n5=100 here
@@ -7600,18 +7915,18 @@ here also, so despite appearances, blue is a maximum, and we're looking for the
(set! pk (abs val))
(set! tpk val)))))
(out-any i tpk (+ (* 8 m) p)))))
- (set! i (+ i 1)))))))
+ (set! i (+ i 1))))))
(define (gad5)
- (do ((i 0 (+ i 1))) ((= i 64)) (map-channel (lambda (y) (/ (- (abs y) 2.3) (- 5.0 2.3))) 0 (frames) 0 i))
- (set! (wavo-trace) 400)
- (set! (wavo-hop) 1)
- (set! (spectro-x-angle) 10)
- (set! (spectro-y-angle) 0)
- (set! (spectro-x-scale) 0.75)
- (set! (spectro-y-scale) 0.9)
- (set! (spectro-z-scale) 0.9)
- (set! (time-graph-type) graph-as-wavogram))
+ (do ((i 0 (+ i 1))) ((= i 64)) (map-channel (lambda (y) (/ (- (abs y) 2.3) (- 5.0 2.3))) 0 (framples) 0 i))
+ (set! *wavo-trace* 400)
+ (set! *wavo-hop* 1)
+ (set! *spectro-x-angle* 10)
+ (set! *spectro-y-angle* 0)
+ (set! *spectro-x-scale* 0.75)
+ (set! *spectro-y-scale* 0.9)
+ (set! *spectro-z-scale* 0.9)
+ (set! *time-graph-type* graph-as-wavogram))
(do ((snd 0 (+ snd 1)))
((= snd 8))
@@ -7621,7 +7936,6 @@ here also, so despite appearances, blue is a maximum, and we're looking for the
(size 100)
(incr (/ (* 2 pi) size)))
(with-sound (:clipped #f :channels 8 :statistics #t :output outfile)
- (run
(let* ((i 0))
(do ((phi1 0.0 (+ phi1 incr))
(j 0 (+ j 1)))
@@ -7647,496 +7961,130 @@ here also, so despite appearances, blue is a maximum, and we're looking for the
(if (> (abs val) pk)
(set! pk (abs val)))))
(out-any i pk m)))
- (set! i (+ i 1))))))))))
+ (set! i (+ i 1)))))))))
(define (gad6)
- (do ((i 0 (+ i 1))) ((= i 8)) (map-channel (lambda (y) (/ (- (abs y) 2.5) (- 6.0 2.5))) 0 (frames) 0 i))
- (set! (selected-graph-color) (make-color 1 1 1))
- (set! (wavo-trace) 100)
- (set! (wavo-hop) 1)
- (set! (spectro-x-angle) 15) ; was 10
- (set! (spectro-y-angle) 0)
- (set! (spectro-x-scale) 0.9) ; was .75
- (set! (spectro-y-scale) 0.9)
- (set! (spectro-z-scale) 1.0) ; was .9
- (set! (colormap) jet-colormap)
- (set! (color-cutoff) 0.001)
- (set! (color-scale) 1.0) ; 50%
- (set! (time-graph-type) graph-as-wavogram))
+ (do ((i 0 (+ i 1))) ((= i 8)) (map-channel (lambda (y) (/ (- (abs y) 2.5) (- 6.0 2.5))) 0 (framples) 0 i))
+ (set! *selected-graph-color* (make-color 1 1 1))
+ (set! *wavo-trace* 100)
+ (set! *wavo-hop* 1)
+ (set! *spectro-x-angle* 15) ; was 10
+ (set! *spectro-y-angle* 0)
+ (set! *spectro-x-scale* 0.9) ; was .75
+ (set! *spectro-y-scale* 0.9)
+ (set! *spectro-z-scale* 1.0) ; was .9
+ (set! *colormap* jet-colormap)
+ (set! *color-cutoff* 0.001)
+ (set! *color-scale* 1.0) ; 50%
+ (set! *time-graph-type* graph-as-wavogram))
-->
-<p>
-Here are the results I have so far. In each set, the first number is the number
-of harmonics, then the minimum peak amplitude, then <code>(log peak n)</code>.
-</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
------------------------------------------------------------------------------------------------
- all odd even prime
------------------------------------------------------------------------------------------------
-
-20 4.290 0.4861 | 11 3.177 0.4821 | 99 10.432 0.5103 | 24 5.649 0.5448
-14 3.613 0.4868 | 9 2.886 0.4824 | 100 10.495 0.5105 | 18 4.857 0.5468
-23 4.608 0.4872 | 17 3.928 0.4829 | 117 11.389 0.5108 | 25 5.814 0.5468
-11 3.218 0.4875 | 10 3.054 0.4848 | 121 11.598 0.5110 | 28 6.194 0.5473
-17 3.981 0.4877 | 19 4.174 0.4853 | 93 10.139 0.5111 | 23 5.566 0.5475
-16 3.875 0.4886 | 14 3.599 0.4853 | 128 11.947 0.5112 | 19 5.017 0.5477
-24 4.731 0.4890 | 13 3.475 0.4857 | 113 11.216 0.5114 | 17 4.720 0.5477
-19 4.224 0.4893 | 18 4.071 0.4857 | 127 11.914 0.5115 | 30 6.455 0.5483
-15 3.769 0.4899 | 16 3.858 0.4870 | 85 9.711 0.5117 | 22 5.447 0.5484
-25 4.856 0.4909 | 15 3.740 0.4871 | 125 11.841 0.5119 | 39 7.463 0.5486
-13 3.525 0.4912 | 12 3.363 0.4880 | 115 11.358 0.5121 | 86 11.538 0.5491
-12 3.389 0.4912 | 28 5.093 0.4885 | 104 10.802 0.5124 | 51 8.663 0.5491
-10 3.103 0.4917 | 21 4.450 0.4904 | 123 11.772 0.5124 | 63 9.730 0.5491
-18 4.145 0.4920 | 23 4.664 0.4911 | 86 9.818 0.5128 | 21 5.330 0.5496
-29 5.245 0.4922 | 20 4.360 0.4915 | 106 10.938 0.5130 | 20 5.190 0.5497
-27 5.066 0.4923 | 31 5.423 0.4924 | 108 11.044 0.5130 | 29 6.369 0.5498
-28 5.161 0.4925 | 22 4.583 0.4925 | 114 11.357 0.5130 | 77 10.897 0.5499
-22 4.588 0.4929 | 24 4.789 0.4929 | 109 11.099 0.5130 | 38 7.403 0.5503
-21 4.484 0.4929 | 25 4.889 0.4930 | 87 9.889 0.5131 | 37 7.298 0.5504
-35 5.770 0.4929 | 33 5.607 0.4931 | 78 9.350 0.5131 | 33 6.853 0.5505
-37 5.934 0.4931 | 29 5.267 0.4934 | 124 11.863 0.5131 | 27 6.138 0.5505
-32 5.530 0.4934 | 30 5.357 0.4935 | 107 11.006 0.5133 | 16 4.603 0.5506
-30 5.367 0.4940 | 8 2.791 0.4936 | 97 10.474 0.5134 | 59 9.461 0.5511
-9 2.962 0.4942 | 27 5.092 0.4938 | 81 9.558 0.5137 | 74 10.722 0.5512
-8 2.795 0.4942 | 26 5.008 0.4945 | 119 11.647 0.5137 | 52 8.830 0.5513
-26 5.008 0.4945 | 7 2.618 0.4947 | 112 11.293 0.5138 | 12 3.937 0.5515
-33 5.635 0.4945 | 32 5.568 0.4954 | 72 9.000 0.5138 | 45 8.165 0.5516
-34 5.721 0.4946 | 52 7.087 0.4956 | 118 11.601 0.5138 | 34 6.998 0.5517
-39 6.131 0.4950 | 50 6.955 0.4958 | 122 11.801 0.5138 | 46 8.272 0.5519
-70 8.197 0.4952 | 34 5.745 0.4958 | 98 10.548 0.5138 | 64 9.929 0.5519
-31 5.484 0.4956 | 35 5.838 0.4963 | 126 12.002 0.5138 | 72 10.603 0.5521
-60 7.610 0.4957 | 82 8.910 0.4963 | 88 9.985 0.5139 | 92 12.142 0.5521
-56 7.361 0.4959 | 48 6.835 0.4965 | 105 10.942 0.5141 | 48 8.478 0.5522
-83 8.962 0.4963 | 41 6.328 0.4968 | 84 9.762 0.5142 | 53 8.963 0.5524
-44 6.553 0.4968 | 43 6.481 0.4969 | 63 8.424 0.5144 | 70 10.457 0.5525
-36 5.931 0.4968 | 45 6.631 0.4970 | 120 11.739 0.5144 | 50 8.684 0.5525
-46 6.700 0.4968 | 42 6.408 0.4970 | 103 10.852 0.5145 | 55 9.156 0.5526
-43 6.482 0.4969 | 72 8.378 0.4970 | 91 10.185 0.5145 | 84 11.574 0.5527
-84 9.045 0.4970 | 74 8.499 0.4972 | 75 9.221 0.5145 | 15 4.468 0.5528
-49 6.922 0.4971 | 78 8.729 0.4973 | 92 10.250 0.5147 | 85 11.658 0.5528
-95 9.619 0.4971 | 37 6.025 0.4974 | 64 8.510 0.5148 | 62 9.804 0.5531
-54 7.266 0.4972 | 46 6.717 0.4975 | 82 9.677 0.5151 | 26 6.063 0.5532
-41 6.336 0.4972 | 39 6.187 0.4975 | 116 11.576 0.5152 | 90 12.057 0.5533
-45 6.639 0.4973 | 105 10.132 0.4976 | 77 9.375 0.5152 | 83 11.531 0.5533
-73 8.446 0.4973 | 47 6.793 0.4976 | 102 10.851 0.5155 | 78 11.144 0.5534
-55 7.341 0.4974 | 89 9.347 0.4979 | 110 11.283 0.5155 | 91 12.141 0.5535
-53 7.209 0.4975 | 40 6.278 0.4980 | 58 8.113 0.5156 | 128 14.667 0.5535
-51 7.073 0.4975 | 56 7.431 0.4983 | 95 10.463 0.5156 | 71 10.589 0.5536
-71 8.343 0.4977 | 57 7.498 0.4983 | 68 8.809 0.5157 | 69 10.424 0.5536
-80 8.854 0.4977 | 59 7.628 0.4983 | 62 8.401 0.5157 | 40 7.709 0.5537
-38 6.113 0.4977 | 51 7.097 0.4984 | 83 9.767 0.5158 | 47 8.431 0.5537
-52 7.146 0.4977 | 106 10.220 0.4984 | 89 10.126 0.5158 | 79 11.240 0.5537
-78 8.744 0.4977 | 81 8.938 0.4984 | 80 9.585 0.5158 | 105 13.162 0.5538
-98 9.800 0.4978 | 91 9.472 0.4984 | 69 8.882 0.5158 | 106 13.240 0.5539
-74 8.523 0.4978 | 62 7.827 0.4986 | 101 10.816 0.5159 | 36 7.280 0.5540
-50 7.012 0.4979 | 77 8.721 0.4986 | 53 7.760 0.5161 | 94 12.390 0.5540
-48 6.871 0.4979 | 101 9.985 0.4986 | 59 8.204 0.5161 | 35 7.170 0.5541
-69 8.234 0.4979 | 55 7.376 0.4987 | 111 11.371 0.5162 | 73 10.775 0.5541
-76 8.643 0.4980 | 76 8.667 0.4987 | 44 7.056 0.5163 | 82 11.493 0.5541
-62 7.812 0.4981 | 67 8.140 0.4987 | 47 7.300 0.5163 | 60 9.668 0.5541
-112 10.494 0.4982 | 110 10.429 0.4988 | 38 6.542 0.5164 | 31 6.706 0.5542
-68 8.188 0.4983 | 90 9.437 0.4988 | 79 9.552 0.5165 | 54 9.123 0.5542
-85 9.155 0.4984 | 60 7.710 0.4989 | 96 10.566 0.5165 | 49 8.647 0.5543
-77 8.716 0.4984 | 44 6.605 0.4989 | 94 10.453 0.5166 | 93 12.337 0.5543
-96 9.732 0.4985 | 86 9.230 0.4989 | 73 9.173 0.5166 | 11 3.779 0.5544
-99 9.886 0.4986 | 108 10.344 0.4990 | 54 7.854 0.5167 | 58 9.506 0.5546
-116 10.701 0.4987 | 88 9.340 0.4990 | 61 8.367 0.5167 | 9 3.382 0.5546
-89 9.377 0.4987 | 64 7.969 0.4991 | 74 9.264 0.5172 | 43 8.053 0.5546
-57 7.509 0.4987 | 83 9.074 0.4991 | 90 10.257 0.5174 | 14 4.325 0.5549
-90 9.431 0.4987 | 85 9.187 0.4992 | 60 8.322 0.5175 | 97 12.664 0.5550
-66 8.079 0.4987 | 36 5.983 0.4992 | 70 9.014 0.5175 | 66 10.231 0.5550
-7 2.639 0.4988 | 61 7.786 0.4992 | 45 7.172 0.5176 | 32 6.846 0.5551
-94 9.644 0.4988 | 114 10.640 0.4993 | 65 8.676 0.5176 | 88 12.006 0.5551
-61 7.775 0.4989 | 102 10.065 0.4993 | 76 9.408 0.5176 | 95 12.530 0.5552
-40 6.299 0.4989 | 125 11.143 0.4993 | 40 6.754 0.5178 | 68 10.413 0.5553
-122 10.988 0.4989 | 38 6.150 0.4994 | 51 7.663 0.5179 | 13 4.155 0.5553
-108 10.341 0.4990 | 70 8.344 0.4994 | 57 8.125 0.5182 | 87 11.941 0.5553
-86 9.231 0.4990 | 63 7.917 0.4994 | 67 8.835 0.5182 | 76 11.082 0.5554
-91 9.496 0.4990 | 53 7.263 0.4994 | 56 8.052 0.5182 | 42 7.977 0.5556
-92 9.548 0.4990 | 118 10.833 0.4994 | 71 9.115 0.5184 | 67 10.341 0.5556
-103 10.102 0.4990 | 69 8.287 0.4994 | 46 7.284 0.5186 | 44 8.186 0.5556
-105 10.199 0.4990 | 58 7.599 0.4994 | 42 6.948 0.5186 | 41 7.873 0.5557
-104 10.152 0.4990 | 92 9.569 0.4995 | 34 6.227 0.5187 | 104 13.214 0.5558
-127 11.217 0.4990 | 103 10.129 0.4996 | 39 6.689 0.5188 | 81 11.514 0.5561
-88 9.343 0.4991 | 115 10.703 0.4996 | 66 8.797 0.5190 | 75 11.032 0.5561
-59 7.656 0.4992 | 94 9.678 0.4996 | 55 8.016 0.5194 | 10 3.602 0.5566
-100 9.965 0.4992 | 107 10.326 0.4996 | 50 7.631 0.5195 | 96 12.686 0.5566
-75 8.632 0.4992 | 96 9.783 0.4997 | 48 7.474 0.5196 | 61 9.858 0.5566
-126 11.184 0.4992 | 54 7.340 0.4997 | 36 6.437 0.5196 | 80 11.467 0.5567
-120 10.916 0.4993 | 68 8.238 0.4998 | 41 6.888 0.5197 | 56 9.417 0.5571
-107 10.309 0.4993 | 95 9.737 0.4998 | 52 7.794 0.5197 | 111 13.789 0.5571
-121 10.963 0.4993 | 128 11.303 0.4998 | 43 7.062 0.5197 | 101 13.088 0.5572
-63 7.916 0.4993 | 120 10.945 0.4998 | 32 6.066 0.5201 | 123 14.629 0.5575
-42 6.465 0.4993 | 116 10.761 0.4998 | 33 6.168 0.5203 | 112 13.886 0.5576
-64 7.979 0.4994 | 65 8.057 0.4998 | 29 5.770 0.5205 | 89 12.236 0.5579
-67 8.164 0.4994 | 49 6.998 0.4999 | 35 6.368 0.5207 | 125 14.797 0.5580
-47 6.839 0.4994 | 113 10.629 0.5000 | 26 5.455 0.5207 | 98 12.920 0.5581
-118 10.831 0.4994 | 104 10.198 0.5000 | 49 7.595 0.5210 | 109 13.714 0.5581
-106 10.268 0.4994 | 100 10.000 0.5000 | 31 5.992 0.5214 | 107 13.579 0.5582
-79 8.867 0.4994 | 117 10.818 0.5000 | 37 6.586 0.5220 | 119 14.409 0.5582
-81 8.981 0.4995 | 109 10.447 0.5001 | 24 5.256 0.5221 | 65 10.286 0.5583
-124 11.113 0.4996 | 97 9.856 0.5002 | 30 5.911 0.5224 | 110 13.806 0.5585
-65 8.050 0.4996 | 79 8.896 0.5002 | 23 5.150 0.5227 | 121 14.576 0.5587
-58 7.605 0.4997 | 75 8.668 0.5002 | 21 4.922 0.5235 | 127 14.991 0.5589
-117 10.804 0.4998 | 80 8.967 0.5006 | 27 5.624 0.5240 | 108 13.693 0.5589
-114 10.667 0.4998 | 93 9.671 0.5006 | 28 5.735 0.5242 | 57 9.581 0.5589
-97 9.840 0.4998 | 112 10.616 0.5007 | 25 5.406 0.5242 | 120 14.525 0.5589
-111 10.528 0.4999 | 122 11.088 0.5008 | 22 5.058 0.5244 | 113 14.057 0.5591
-115 10.718 0.4999 | 73 8.574 0.5008 | 18 4.571 0.5258 | 115 14.196 0.5591
-113 10.629 0.5000 | 66 8.153 0.5008 | 20 4.841 0.5265 | 126 14.942 0.5591
-72 8.485 0.5000 | 119 10.953 0.5009 | 17 4.464 0.5280 | 100 13.135 0.5592
-102 10.106 0.5001 | 127 11.323 0.5010 | 16 4.326 0.5283 | 99 13.113 0.5601
-119 10.924 0.5003 | 98 9.947 0.5010 | 19 4.743 0.5287 | 124 14.906 0.5605
-125 11.196 0.5003 | 99 10.006 0.5012 | 15 4.194 0.5294 | 114 14.237 0.5607
-109 10.469 0.5006 | 84 9.216 0.5012 | 14 4.098 0.5344 | 103 13.449 0.5607
-123 11.127 0.5007 | 121 11.074 0.5014 | 12 3.788 0.5359 | 102 13.420 0.5615
-128 11.352 0.5007 | 87 9.390 0.5015 | 13 3.973 0.5378 | 118 14.570 0.5615
-87 9.358 0.5007 | 123 11.174 0.5016 | 11 3.657 0.5407 | 122 14.899 0.5623
-101 10.090 0.5009 | 71 8.494 0.5019 | 10 3.559 0.5513 | 116 14.491 0.5624
-82 9.092 0.5009 | 126 11.342 0.5021 | 8 3.198 0.5590 | 117 14.627 0.5634
-110 10.540 0.5010 | 111 10.652 0.5023 | 9 3.454 0.5641 | 5 2.477 0.5635
-93 9.693 0.5011 | 124 11.269 0.5025 | 7 3.047 0.5726 | 4 2.192 0.5662
-4 2.039 0.5139 | 3 1.739 0.5035 | 6 2.837 0.5820 | 8 3.263 0.5687
-6 2.549 0.5223 | 4 2.045 0.5161 | 5 2.605 0.5948 | 7 3.062 0.5751
-5 2.343 0.5292 | 6 2.523 0.5164 | 3 2.021 0.6406 | 6 2.805 0.5757
-3 1.980 0.6217 | 5 2.307 0.5195 | 4 2.431 0.6406 | 3 1.980 0.6217
-2 1.760 0.8156 | 2 1.539 0.6220 | 2 1.760 0.8157 | 2 1.760 0.8156
-</pre>
-</td></tr></table>
-
-<p>These values
-represent about 400 GHz years of computing,
-possible only at an enlightened institution like CCRMA.
-Here is a graph of the peaks (as of January, 2011), followed by a graph of
-the exponent vs n (n^y = peak amp).
+<p>n=6 is even more beautiful and complex, but the graph is too large to include here.
</p>
-<img src="pix/sqrt.png" alt="sqrt n" hspace=40>
-<br>
-<img src="pix/sqrt1.png" alt="n^y" hspace=40>
-<p>The "even" cases are not independent of the "all" cases; each even-harmonics set can be at worst 1.0 above
-its corresponding (n-1) all-harmonics set (shift the current "all" choices right to multiply each by 2, then set the new fundamental
-phase to 0.0). If you then search around this set of phases, you'll find very good values. Using Snd's fpsap (a version
-of the genetic algorithm):
-</p>
+<pre class="indented">
+;;; use mix and with-temp-sound to create a draggable mix object for each component.
-<pre>
- (let ((all (cadr (get-best :all (- n 1))))) ; get the best all-harmonic phases for n - 1
- (let ((new-phases (make-vector n 0.0))) ; place in new phase vector shifted up
- (do ((k 0 (+ k 1)))
- ((= k (- n 1)))
- (set! (new-phases (+ k 1)) (all k)))
- (set! (new-phases 0) 0.0)
- (fpsap 2 n new-phases))) ; search that vicinity for a good set (2 = even harmonics)
-</pre>
+(load "peak-phases.scm")
+(set! *with-mix-tags* #t) ; drag the tag to change the harmonic's initial phase
+(set! *show-mix-waveforms* #f)
+(set! *with-inset-graph* #f)
-<p>fpsap here was using 6000 starting points and an initial increment (search radius) of .06 (times pi of course). These are the best
-values I've found so far. When I started this search more than a year ago, I tried random phases
-and evenly spaced phases (brute force), but that led to nothing useful.
-Next, due to the very good results reported in
-Horner and Beauchamp, "a genetic algorithm-based method
-for synthesis of low peak amplitude signals", J. Acoustic. Soc. Am Vol 99 No 1 Jan 96, online
-at ems.music.uiuc.edu/beaucham/papers/JASA.01.96.pdf,
-<!--
-(In both this paper, and Schroeder's earlier
-one, much fuss is made of the RMS value, but that value is independent of the
-initial phases, so it is obviously irrelevant).
--->
-I tried the genetic algorithm. I started with
-2000 or so randomly chosen initial points and a search radius
-of 1.0 (= pi). These are pretty good choices, but after a few months of searching, I reached a point of almost no
-returns. I tried variants of the basic algorithm and other search methods, but the results were not very good until
-I noticed that in the
-graphs of the peaks, the good values are more or less clustered together. So I tried centering
-the genetic search on the best phases I had found to that point, then iterating
-the search each time from the new best point, slowly reducing the search radius.
-In code:
-</p>
+(define (show choice n) ; (show :all 14) for example
+ (definstrument (sine-wave start dur freq phase) ; make one harmonic
+ (let* ((beg (seconds->samples start))
+ (end (+ beg (seconds->samples dur)))
+ (osc (make-oscil freq phase)))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (outa i (oscil osc)))))
-<pre>
-(define (iterated-peak choice n)
- (let ((phases (make-vector n 0.0))
- (cur-best n)
- (cur-incr 1.0))
- (do ((i 1 (+ i 1)))
+ (if (null? (sounds))
+ (new-sound))
+ (let ((phases (cadr (get-best choice n))))
+ (do ((i 0 (+ i 1)))
((= i n))
- (set! (phases i) (random 1.0)))
- (do ()
- ((< cur-incr .001))
- (let ((vals (fpsap (if (eq? choice :all) 0
- (if (eq? choice :odd) 1
- (if (eq? choice :even) 2 3)))
- n phases 5000 cur-incr)))
- (let ((pk (car vals))
- (new-phases (cadr vals)))
- (let ((down (- cur-best pk)))
- (if (< down (/ cur-best 10))
- (set! cur-incr (* 0.5 cur-incr))))
- (if (< pk cur-best)
- (begin
- (set! cur-best pk)
- (set! phases (vct->vector new-phases)))))))
- (list cur-best phases)))
+ (let* ((freq (case choice
+ ((:all) (+ i 1))
+ ((:even) (max (* 2 i) 1))
+ ((:odd) (+ (* 2 i) 1))
+ ((:prime) (primes i))))
+ (snd (<em class=red>with-temp-sound</em> (:ignore-output #t :clipped #f)
+ (sine-wave 0 2 (* 10 freq) (* pi (phases i))))))
+ (let ((mx (car (<em class=red>mix</em> snd 400)))) ; give some space after the axis
+ (set! (mix-tag-y mx) (+ 10 (* 40 i)))))))
+ (let ((mx (+ 2.0 (maxamp))))
+ (set! (y-bounds) (list (- mx) mx)))
+ (set! (x-bounds) (list 0.0 0.2)))
+
+(hook-push mix-drag-hook ; report the current maxamp as we drag a component
+ (lambda (hook)
+ (let ((beg 0)
+ (end (framples))
+ (mx 0.0))
+ (for-each
+ (lambda (sine)
+ (set! beg (max beg (mix-position sine)))
+ (set! end (min end (+ (mix-position sine) (mix-length sine)))))
+ (caar (mixes)))
+ (let ((rd (make-sampler beg)))
+ (do ((i beg (+ i 1)))
+ ((> i end))
+ (set! mx (max mx (abs (rd))))))
+ (status-report (format #f "maxamp: ~A" mx)))))
</pre>
-<!--
-(if (not (provided? 'snd-rgb.scm)) (load "rgb.scm"))
-(define (draw-sqrt-label xg yg exponent) ; 20 3 ".59"
- (let* ((snd 0)
- (chn 0)
- (axinf (axis-info snd chn))
- (x (list-ref axinf 10))
- (y (list-ref axinf 13))
- (grf-width (- (list-ref axinf 12) x))
- (grf-height (- (list-ref axinf 11) y))
- (width 278)
- (height 115)
+<p>It's curious that the "min-peak-amplitude versus n" graphs look continuous; what
+happens to the minima as we slowly add the next higher harmonic? In the n=2 case,
+each minimum splits in two, then smoothly moves to its next minimum location (where the
+third harmonic has amplitude 1.0). Here's a graph of the moving minima,
+showing also the resultant peak amplitude:
+</p>
- (red (make-color 1 0 0))
- (blue (make-color 0 0 1))
- (green (make-color 0 1 0))
- (black (make-color 0 0 0))
- (chocolate (make-color 0.82 0.41 0.12))
- )
+<img class="indented" src="pix/phase-paths.png" alt="moving minima">
+<img class="indented" src="pix/peak-path.png" alt="moving minima">
- (set! (foreground-color snd chn) black)
- (let ((x1 (+ x xg))
- (y1 (+ y yg))
- (yoff 20)
- (yinit 15)
- (ytext -7))
-
- (fill-rectangle x1 y1 width 1 snd chn)
- (fill-rectangle x1 (+ y1 height) width 1 snd chn)
- (fill-rectangle x1 y1 1 height snd chn)
- (fill-rectangle (+ x1 width -1) y1 1 height snd chn)
-
- (set! (foreground-color snd chn) black)
- (fill-rectangle (+ x1 10) (+ y1 yinit) 30 3 snd chn)
- (set! (foreground-color snd chn) black)
- (draw-string "all harmonics" (+ x1 50) (+ y1 yinit ytext) snd chn)
-
- (set! (foreground-color snd chn) red)
- (fill-rectangle (+ x1 10) (+ y1 yinit yoff) 30 3 snd chn)
- (set! (foreground-color snd chn) black)
- (draw-string "odd-numbered harmonics" (+ x1 50) (+ y1 yinit yoff ytext) snd chn)
-
- (set! (foreground-color snd chn) chocolate)
- (fill-rectangle (+ x1 10) (+ y1 yinit (* 2 yoff)) 30 3 snd chn)
- (set! (foreground-color snd chn) black)
- (draw-string "even-numbered harmonics" (+ x1 50) (+ y1 yinit (* 2 yoff) ytext) snd chn)
-
- (set! (foreground-color snd chn) blue)
- (fill-rectangle (+ x1 10) (+ y1 yinit (* 3 yoff)) 30 3 snd chn)
- (set! (foreground-color snd chn) black)
- (draw-string "prime-numbered harmonics" (+ x1 50) (+ y1 yinit (* 3 yoff) ytext) snd chn)
-
- (set! (foreground-color snd chn) green)
- (fill-rectangle (+ x1 10) (+ y1 yinit (* 4 yoff)) 30 3 snd chn)
- (set! (foreground-color snd chn) black)
- (draw-string (format #f "n^~A" exponent) (+ x1 50) (+ y1 yinit (* 4 yoff) ytext) snd chn)
- )))
-
-
-(define* (make-sqrt-png (xp 0.59))
- (set! (with-inset-graph) #f)
- ;; see tmp26...
- (with-sound (:channels 5 :clipped #f)
-
- (do ((i 1 (1+ i)))
- ((> i 128))
- (let ((n-min-val (vector-find-if (lambda (val)
- (and val
- (vector? val)
- (= (val 0) i)
- (let ((a-val (val 1))
- (a-len (length val)))
- (do ((k 2 (1+ k)))
- ((= k a-len))
- (if (and (number? (val k))
- (< (val k) a-val))
- (set! a-val (val k))))
- a-val)))
- noid-min-peak-phases)))
-
- (let ((odd-min-val (vector-find-if (lambda (val)
- (and val
- (vector? val)
- (= (val 0) i)
- (let ((a-val (val 1))
- (a-len (length val)))
- (do ((k 2 (1+ k)))
- ((= k a-len))
- (if (and (number? (val k))
- (< (val k) a-val))
- (set! a-val (val k))))
- a-val)))
- nodd-min-peak-phases)))
-
- (let ((prime-min-val (vector-find-if (lambda (val)
- (and val
- (vector? val)
- (= (val 0) i)
- (let ((a-val (val 1))
- (a-len (length val)))
- (do ((k 2 (1+ k)))
- ((= k a-len))
- (if (and (number? (val k))
- (< (val k) a-val))
- (set! a-val (val k))))
- a-val)))
- primoid-min-peak-phases)))
-
- (let ((even-min-val (vector-find-if (lambda (val)
- (and val
- (vector? val)
- (= (val 0) i)
- (let ((a-val (val 1))
- (a-len (length val)))
- (do ((k 2 (1+ k)))
- ((= k a-len))
- (if (and (number? (val k))
- (< (val k) a-val))
- (set! a-val (val k))))
- a-val)))
- neven-min-peak-phases)))
-
- (outa i (or n-min-val 0.0))
- (outb i (or odd-min-val 0.0))
- (outc i (or prime-min-val 0.0))
- (outd i (expt (exact->inexact i) xp)) ; or (log pk n)?
- (out-any i (or even-min-val 0.0) 4)
- ))))))
-
- (set! (y-bounds) (list 0 21))
- (set! (channel-style) channels-superimposed)
- (set! (axis-color) (make-color 0 0 0))
- (set! (x-axis-style) x-axis-in-samples)
- (do ((i 0 (1+ i)))
- ((= i 5))
- (set! (x-axis-label 0 i) "n"))
- (set! (selected-graph-color) (make-color 1 1 1))
- (set! (axis-label-font) "9x15")
- )
-
--->
-
-
-<p>Here is the time domain view of one of the n=5 cases when the minimum peak phases are chosen; the sum of the 5 components is in black.
+<p>In the first graph, each dot is at the phase location of the minimum peak amplitude as the
+third harmonic is increased in amplitude by 0.025. The turning points are just before the third harmonic
+reaches an amplitude of 0.5. The n=2 minima are at (0, 0), (red and green, with
+the green x=2 rather than 0), and (0, 1), (black and blue). Each splits and wanders eventually to
+the n=3 global minima at (0.41 1.68), (1.41, 1.68), (1.59, 0.32), and (0.59, 0.32).
+Each of the n=2 global minima ends up at 2 of the 4 n=3 global minima! How lucky can we be?
+If this worked in general, we could use it to speed up our search by following a minimum of n harmonics as it meanders to a minimum of n+1 harmonics:
</p>
-<img src="pix/sum5.png" hspace=20 alt="n=5 case">
+<pre class="indented">
+;; this starts at the current min and marches to an n+1 min
+(let ((n 3))
+ (let ((phases (vector 0.0 0.0 1.0)))
+ (do ((x 0.1 (+ x .1)))
+ ((>= x 1.0))
+ (let ((p (fpsap x 0 n 1000 0.1 50 #f #t phases))) ; args may change without warning.
+ (format #t ";~A: ~A~%" x p)
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! (phases k) (modulo (p k) 2.0)))))))
+</pre>
-<p>And a few others:
+<p>
+Since we can restrict our search to 0.1 (maybe less) in each direction (rather than 2.0), we
+get a reduction of 20^n in the size of the space we are searching. But, as usual, there's
+a problem. The search works for n=2 -> 3 -> 4 -> 5, but going from 5 to 6, I seem to fall into a
+non-optimal path.
</p>
-<table border=0 hspace=20>
-<tr>
-<td><img src="pix/all57.png" alt="57 harmonics"></td>
-<td width=20></td>
-<td><img src="pix/odd57.png" alt="57 odd harmonics"></td>
-</tr></table>
-
-<table border=0 hspace=20 vspace=10>
-<tr>
-<td><img src="pix/all99.png" alt="99 harmonics"></td>
-</tr></table>
-
-<!-- all57:
-
-(define phases '#(0.000000 0.402544 0.873914 0.824224 1.710182 0.183023 0.378574 0.128782 1.816255 1.249608 1.030253 1.030831 0.184699 0.677473 1.528003 1.262679 1.840809 0.082787 1.487290 1.579585 0.150833 0.308197 0.183834 1.435443 0.452047 0.800416 1.697556 1.103318 1.169502 1.438166 1.765331 0.875181 1.049248 1.321068 0.824424 0.599899 1.694664 0.504547 1.583285 1.657047 0.940116 1.788668 1.529808 0.367904 1.371253 0.572088 1.370961 1.371348 0.244247 1.592370 0.135712 0.911345 0.228778 1.543468 1.190091 1.504171 1.491159))
-
-(define (make-all-57)
- (set! (with-inset-graph) #f)
- (let* ((samples 1000)
- (incr (/ (* 2 pi) samples)))
- (with-sound (:channels 1 :clipped #f)
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x incr)))
- ((= i samples))
- (let ((sum 0.0))
- (do ((k 1 (+ k 1)))
- ((= k 58))
- (let ((val (sin (+ (* k x) (* pi (phases (- k 1)))))))
- (set! sum (+ sum val))))
- (outa i sum)))))
-
- (set! (y-bounds) (list -8.0 8.0))
- (set! (channel-style) channels-superimposed)
- (set! (axis-color) (make-color 0 0 0))
- (set! (x-axis-style) x-axis-in-samples)
- (set! (selected-graph-color) (make-color 1 1 1))
- (set! (selected-data-color) (make-color 0 0 0))
- (set! (axis-label-font) "9x15")
- (set! (x-axis-label) "57 harmonics with peak at 7.546")
- )
-
-(define odd-phases '#(0.000000 -0.095905 1.360419 0.638244 0.752436 0.060307 1.680434 0.892474 1.556627 1.342822 1.202039 0.989766 0.747386 1.502768 1.484789 1.280575 -0.299617 0.648918 1.386594 0.570314 0.971680 0.602106 1.411224 0.349887 1.776881 0.686211 -0.138570 0.102115 0.187653 1.480790 0.475407 0.080540 0.078971 0.288194 0.529704 0.929207 1.248880 1.402125 0.332857 1.263541 0.757496 0.254501 0.084949 1.308375 0.041441 0.288389 1.222780 0.362725 1.537117 1.518618 0.267187 0.845609 0.722902 0.451852 0.582589 0.839423 1.817054))
-
-(define (make-odd-57)
- (set! (with-inset-graph) #f)
- (let* ((samples 1000)
- (incr (/ (* 2 pi) samples)))
- (with-sound (:channels 1 :clipped #f)
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x incr)))
- ((= i samples))
- (let ((sum 0.0))
- (do ((k 1 (+ k 1))
- (j 1 (+ j 2)))
- ((= k 58))
- (let ((val (sin (+ (* j x) (* pi (odd-phases (- k 1)))))))
- (set! sum (+ sum val))))
- (outa i sum)))))
-
- (set! (y-bounds) (list -8.0 8.0))
- (set! (channel-style) channels-superimposed)
- (set! (axis-color) (make-color 0 0 0))
- (set! (x-axis-style) x-axis-in-samples)
- (set! (selected-graph-color) (make-color 1 1 1))
- (set! (selected-data-color) (make-color 0 0 0))
- (set! (axis-label-font) "9x15")
- (set! (x-axis-label) "57 odd harmonics with peak at 7.564")
- )
-
-(define all-99 '#(0.000000 0.597494 1.146001 -0.056648 1.705293 0.247794 1.067079 1.589758 1.638162 1.207186 0.711609 0.710553 -0.195687 0.350442 0.679684 1.653746 -0.460484 -0.156879 1.629420 1.730071 1.077540 0.075860 0.435827 1.574017 0.450715 1.581154 -0.027175 1.502323 1.501097 0.855975 1.269118 1.563924 1.244477 0.428054 1.250656 0.668151 0.672807 0.481658 1.215020 0.229865 0.052263 -0.265466 0.722697 0.484686 1.525745 -0.088395 1.682325 1.764438 0.384531 0.550629 -0.009864 1.443840 0.844832 1.132436 -0.107693 0.137994 0.009887 1.832991 0.076907 0.020473 0.102198 0.283702 1.246352 0.965046 0.026752 1.471014 0.126851 0.144964 0.731028 -0.335345 0.712331 0.471273 1.705158 0.467571 1.388009 0.875431 0.986268 1.669037 0.667955 0.887678 1.688981 -0.459336 1.461469 1.135012 0.449583 0.176052 1.407825 1.801166 0.208742 1.880027 0.895566 1.761286 1.021896 0.520239 1.466186 0.733284 1.188215 1.584263 1.296521))
-
-(define (make-all-99)
- (set! (with-inset-graph) #f)
- (let* ((samples 1200)
- (incr (/ (* 2 pi) samples)))
- (with-sound (:channels 1 :clipped #f)
- (do ((i 0 (+ i 1))
- (x 0.0 (+ x incr)))
- ((= i samples))
- (let ((sum 0.0))
- (do ((k 1 (+ k 1)))
- ((= k 100))
- (let ((val (sin (+ (* k x) (* pi (all-99 (- k 1)))))))
- (set! sum (+ sum val))))
- (outa i sum)))))
-
- (set! (y-bounds) (list -10.0 10.0))
- (set! (channel-style) channels-superimposed)
- (set! (axis-color) (make-color 0 0 0))
- (set! (x-axis-style) x-axis-in-samples)
- (set! (selected-graph-color) (make-color 1 1 1))
- (set! (selected-data-color) (make-color 0 0 0))
- (set! (axis-label-font) "9x15")
- (set! (x-axis-label) "99 harmonics with peak at 9.9431")
- )
--->
-
-
-<p>I wonder if minimizing the peak amplitude maximizes the length of the curve. (In the 57 harmonics case, the cosine
-version (peak=57) has a length of 485.45, whereas the sqrt version (peak=7.547) has a length of 909.52).
+<p>
+The other short-cut that immediately comes to mind is to look for the zeros of
+the derivative, then plug those into the original to get the maxima. But it is just as hard to
+find those zeros as to find the peaks of the original. Or we could minimize the length
+of the curve. In the 57 harmonics case, for example, the cosine version (peak=57.0) has a length of
+485.45, whereas the minimized peak version (peak=7.547) has a length of 909.52.
+But this also doesn't save us any time over the original search.
</p>
<!--
@@ -8146,7 +8094,6 @@ version (peak=57) has a length of 485.45, whereas the sqrt version (peak=7.547)
(last-sum 0.0)
(sum 0.0)
(mx 0.0))
- (run
(do ((i 0 (+ i 1))
(x 0.0 (+ x incr)))
((= i samples))
@@ -8159,93 +8106,18 @@ version (peak=57) has a length of 485.45, whereas the sqrt version (peak=7.547)
;(set! len (+ len (abs (- sum last-sum))))
(set! len (+ len (sqrt (+ (* (- sum last-sum) (- sum last-sum)) (* incr incr)))))
(set! last-sum sum)
- (if (< mx (abs sum)) (set! mx (abs sum)))))
+ (if (< mx (abs sum)) (set! mx (abs sum))))
(list len mx))
-->
-<p>
-We can also use <a href="#withmixedsound">with-mixed-sound</a> to watch the waveforms "in real-time":
-</p>
-
-<table border=0 hspace=40><tr><td>
-<pre>
-(definstrument (sine-wave start dur freq phase)
- (let* ((beg (seconds->samples start))
- (end (+ beg (seconds->samples dur)))
- (osc (make-oscil freq phase)))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (outa i (oscil osc))))))
-
-;; #(0.000 1.410 1.684) is one of the minima
-
-(with-mixed-sound ()
- (sine-wave 0 1 10.0 0.0)
- (sine-wave 0 1 20.0 (* pi 1.410))
- (sine-wave 0 1 30.0 (* pi 1.684)))
-
-(hook-push mix-drag-hook ; report the current maxamp as we drag a component
- (lambda (id x y)
- (report-in-minibuffer (format #f "maxamp: ~A" (maxamp)))))
-</pre>
-</td></tr></table>
-
-<p>Now the resultant waveform is displayed as you drag any of the mix tags (which corresponds to
-changing the initial phase).
-As you increase "n", the minimum peak amplitude waveform approaches
-white noise (in sound as well as appearance); here is a small portion of one period when n=65536 (the prescaling peak was 704):
-</p>
-
-
-<table hspace=40 border=0><tr><td>
-<img src="pix/s65536.png" alt="65536 harmonics">
-</td></tr></table>
-<br>
-
-
-<p>It's curious that the "min-peak-amplitude versus n" graphs look continuous; what
-happens to the minima as we slowly add the next higher harmonic? In the n=2 case,
-each minimum splits in two, then smoothly moves to its next minimum location (where the
-3rd harmonic has amplitude 1.0). Here's a graph of the moving minima,
-showing also the resultant peak amplitude:
-</p>
-
-<img src="pix/phase-paths.png">
-<img src="pix/peak-path.png">
-
-<p>In the first graph, each dot is at the phase location of the minimum peak amplitude as the
-3rd harmonic is increased in amplitude by 0.025. The turning points are just before the 3rd harmonic
-reaches an amplitude of 0.5. The n=2 minima are at (0, 0), (red and green, with
-the green x=2 rather than 0), and (0, 1), (black and blue). Each splits and wanders eventually to
-the n=3 global minima at (0.41 1.68), (1.41, 1.68), (1.59, 0.32), and (0.59, 0.32).
-Each of the n=2 global minima ends up at 2 of the 4 n=3 global minima! How lucky can we be?
-If this worked in general, we could use it to speed up our search by following a minimum of n harmonics as it meanders to a minimum of n+1 harmonics:
-</p>
-<pre>
-;; this starts at the current min and marches to an n+1 min
-(let ((n 3))
- (let ((phases (vector 0.0 0.0 1.0)))
- (do ((x 0.1 (+ x .1)))
- ((>= x 1.0))
- (let ((p (fpsaf x 0 n 1000 0.1 50 #f #t phases)))
- (format #t ";~A: ~A~%" x p)
- (do ((k 0 (+ k 1)))
- ((= k n))
- (set! (phases k) (modulo (p k) 2.0)))))))
-</pre>
-<p>
-Since we can restrict our search to 0.1 (maybe less) in each direction (rather than 2.0), we
-get a reduction of 20^n in the size of the space we are searching. But, as usual, there's
-a problem. The search works for n=2 -> 3 -> 4 -> 5, but going from 5 to 6, I seem to fall into a
-non-optimal (but still very good) path.
-</p>
-
<p>
-Since all the compute time (more than 99%) is spent in the FFT,
-we obviously want to know how big the FFT needs to be
-to give a reasonably accurate peak (say
+So we're resigned to a laborious search. The first thing we need is a fast way to
+produce a sum of sinusoids. Up to n=25 or 30, the Chebyshev polynomials are
+just as fast as an inverse FFT, but why stop at 30!
+Since we'll be doing an inverse FFT for every test case, we need to make
+the FFT size as small as possible while
+still giving a reasonably accurate peak (say
within 0.001 of the true peak).
According to N Higham in "Accuracy and Stability of Numerical Algorithms",
the FFT is stable and very accurate. He has a graph showing accumulated
@@ -8265,7 +8137,8 @@ multiply "mult" by the number of harmonics to get the FFT size):
(let ((fftval (fft-all 8 i phases)))
(format #t "~D: ~A -> ~A~%" i fftval (abs (- fftval correct))))))
-->
-<pre>
+
+<pre class="indented">
8 harmonics 128 harmonics
mult reported peak error reported peak error
@@ -8286,16 +8159,18 @@ mult reported peak error reported peak error
</pre>
+
<p>
128 seems pretty good. Those are spikey cases. If we try the
best minimum-peak case, the errors are much smaller. Here are graphs of both
the 0.0 phase and minimum phase cases for 8 harmonics:
</p>
-<table border=0 hspace=20 vspace=10>
+<table>
<tr><td>
-<img src="pix/8.png"></td><td width=20></td><td>
-<img src="pix/88.png">
+<img src="pix/8.png" alt="8 case">
+</td><td></td><td>
+<img class="indented" src="pix/88.png" alt="8 case">
</td></tr></table>
@@ -8350,7 +8225,7 @@ to a good candidate, but that seems like asking for trouble.
(close-sound old)))
(let ((ns (new-sound "test.snd" :channels 5))
- (data (make-vct dur)))
+ (data (make-float-vector dur 0.0)))
(let ((phases (make-vector 8 0.0))
(correct 6.1442))
@@ -8362,8 +8237,8 @@ to a good candidate, but that seems like asking for trouble.
((> n 512))
(let* ((size (expt 2 (ceiling (/ (log (* 8 n)) (log 2)))))
- (fft-rl (make-vct size))
- (fft-im (make-vct size))
+ (fft-rl (make-float-vector size 0.0))
+ (fft-im (make-float-vector size 0.0))
(pi2 (/ pi 2)))
(do ((m 0 (+ m 1)))
@@ -8386,7 +8261,7 @@ to a good candidate, but that seems like asking for trouble.
(set! k (+ k 1))
(set! step-ctr (- step-ctr step)))))
- (vct->channel data 0 dur ns chan)))
+ (float-vector->channel data 0 dur ns chan)))
(let ((len 8)
(incr (/ (* 2 pi) dur)))
@@ -8399,10 +8274,10 @@ to a good candidate, but that seems like asking for trouble.
((= k len))
(set! val (+ val (sin (+ (* j x) (* pi (phases k)))))))
(set! (data i) val)))
- (vct->channel data 0 dur ns 4))
+ (float-vector->channel data 0 dur ns 4))
- (set! (selected-graph-color) (make-color 1 1 1))
- (set! (selected-data-color) (make-color 0 0 0))
+ (set! *selected-graph-color* (make-color 1 1 1))
+ (set! *selected-data-color* (make-color 0 0 0))
(set! (x-axis-label ns 0) "fft size: 32")
(set! (x-axis-label ns 1) "fft size: 128")
@@ -8415,16 +8290,823 @@ to a good candidate, but that seems like asking for trouble.
-->
-<br><br>
-
+<p>Ok, we have a fast way to make test cases. Off we go...
+When I started this search more than two years ago, I had no idea what a long and winding
+path I was headed down! My initial guess was that I could find minimum peaks close to
+the square root of n. This was based on nothing more than the breezy idea that the initial phases give you enough
+freedom that you're approaching the behavior of a sum of n random signals.
+I thought these minima could not be very hard to find; simply use
+a brute force grid. The first such grid used initial phases of 0 and pi, and I
+actually ran every possible such case, up to n=45 or so. Since each harmonic can be
+positive or negative, this is 2^44 cases to check, which is starting to be a pain.
+The results were discouraging; I did not get close to the square root of n.
+I also tried smaller grids (down to pi/32) for small n (say n < 8), without
+any success.
+</p>
+<p>Next great idea: try random initial phases. This actually works better than it has
+any right to, but again the results are disappointing. You can run random phases until
+hell freezes over and only get to n^.6 or slightly less. And the long term trend of
+this process can dampen one's optimism. Here's a graph where we've taken 100 stabs
+at each case of N harmonics, N from 3 to 2000, using randomly chosen initial phases, and tracked the
+minimum, maximum, and average peaks. The graph is logarithmic (that is we show
+(log minimum N) and so on):
+</p>
-<!-- ---------------------------------------- FILE: piano ---------------------------------------- -->
+<img class="indented" src="pix/averages.png" alt="average peaks from n=3 to 2000">
+
+<!--
+(define pi2 (/ pi 2))
+(define data-file "test.data")
+(set! *print-length* 1000000)
+
+(define (get-fft-size choice n1 mult)
+ (let ((n (if (eq? choice :all) n1
+ (if (not (eq? choice :prime)) (* 2 n1)
+ (vector-ref primes n1)))))
+ (min (expt 2 21)
+ (expt 2 (ceiling (/ (log (* n mult)) (log 2)))))))
+
+(define (get-peak choice n cur-phases)
+ (let* ((fft-mult 128)
+ (size (get-fft-size choice n fft-mult))
+ (fft-rl (make-float-vector size 0.0))
+ (fft-im (make-float-vector size 0.0))
+ (nc (if (eq? choice :all) 0
+ (if (eq? choice :odd) 1
+ (if (eq? choice :even) 2 3)))))
+
+ (fill! fft-rl 0.0)
+ (fill! fft-im 0.0)
+
+ (do ((m 0 (+ m 1)))
+ ((= m n))
+ (let ((phi (+ (* pi (vector-ref cur-phases m)) pi2))
+ (bin (if (= nc 0) (+ m 1)
+ (if (= nc 1) (+ 1 (* m 2))
+ (if (= nc 2) (max 1 (* m 2))
+ (vector-ref primes m))))))
+ (float-vector-set! fft-rl bin (cos phi))
+ (float-vector-set! fft-im bin (sin phi))))
+ (float-vector-peak (mus-fft fft-rl fft-im size -1))))
+
+
+(let ((tries 100)
+ (file (open-output-file data-file "w")))
+ (do ((n 2000 (+ n 1)))
+ ((= n 3000))
+ (let ((phases (make-vector n 0.0))
+ (sqrt-n (sqrt n)))
+ (let ((min-peak n)
+ (max-peak 0.0)
+ (sum 0.0))
+ (do ((try 0 (+ try 1)))
+ ((= try tries))
+ (fill! phases 0.0)
+ (do ((k 1 (+ k 1)))
+ ((= k n))
+ (vector-set! phases k (random pi)))
+ (let ((pk (get-peak :all n phases)))
+
+ (if (> pk n)
+ (format #t " ;oops: n: ~D, pk: ~F~%" n pk))
+ (if (< pk sqrt-n)
+ (begin
+ (format file " ;;~D: ~F (~F) from ~A~%" n pk sqrt-n phases)
+ (format #t " ;~D: ~F (~F) from ~A~%" n pk sqrt-n phases)))
+
+ (set! sum (+ sum pk))
+ (if (< pk min-peak)
+ (set! min-peak pk))
+ (if (> pk max-peak)
+ (set! max-peak pk))))
+ (set! sum (/ sum tries))
+ (format file "(~D ~,3F ~,3F ~,3F (~,3F ~,3F ~,3F))~%" n (log min-peak n) (log sum n) (log max-peak n) min-peak sum max-peak)
+ (if (zero? (modulo n 10))
+ (format #t "~A: ~,3F ~,3F ~,3F (~,3F ~,3F ~,3F)~%" n (log min-peak n) (log sum n) (log max-peak n) min-peak sum max-peak))
+ )))
+ (close-output-port file))
+
+(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
+
+(define white (make-color 1 1 1))
+
+;;; turn off clipping
+(set! (mus-clipping) #f)
+(set! *clm-clipped* #f)
+(set! *with-inset-graph* #f)
+
+;;; these hooks may be drawing the graph in the upper right corner, which we don't want for now
+(set! (hook-functions after-graph-hook) ())
+(set! (hook-functions mouse-click-hook) ())
+(set! (hook-functions update-hook) ())
+
+;;; tell Snd not to try to load the data file
+(set! (script-arg) (+ 1 (script-arg)))
+
+(let ((ind (find-sound
+ (with-sound (:channels 3 :sample-type mus-lfloat)
+ (let ((samp 0))
+ (call-with-input-file
+ (list-ref (script-args) 1) ; invocation arg = text file of data ("snd graph-averages.scm peaks.data")
+ (lambda (file)
+ (let loop ((data (read file)))
+ (if (pair? data)
+ (begin
+ (out-any samp (list-ref data 1) 0)
+ (out-any samp (list-ref data 2) 1)
+ (out-any samp (list-ref data 3) 2)
+ (set! samp (+ 1 samp))
+ (loop (read file))))))))))))
+
+ (set! (channel-style ind) channels-superimposed)
+ (set! *selected-graph-color* white)
+ (set! *graph-color* white)
+
+ (do ((chan 0 (+ 1 chan)))
+ ((= chan 3))
+ (set! (x-axis-style ind chan) x-axis-in-samples)
+ (set! (x-axis-label ind chan) "N")
+ (set! (y-bounds ind chan) (list .5 1.0))))
+
+-->
+
+<p>The trend continues upwards as N goes to 100000; it probably approaches 1 in the limit.
+But we can always do better than n^.6 by using phases 0.0938*i*i - 0.35*i
+where "i" is the harmonic number counting from 0.
+This little formula gives results as low as n^.541 (at n=2076), and it is always below n^.6 if n is large enough.
+Lots of such formulas get us down to n^.53 or, as n gets larger, .52:
+in the all harmonic case, if n=65536,
+4.5547029e-05*i*i + 0.640075398*i gives a peak of 309.9, and
+-4.697190e-05*i*i + 1.357080536*i peaks at 303.6 (n^.515). If n=131072,
+2.09440276*i*i + 1.4462367*i peaks at 438.7 (n^.516).
+</p>
+
+<p>
+A good quadratic for each n, in the all harmonics case,
+is (pi/n)*i*i - i*pi/2.
+Except for the pi/n term, the rest just marches through the quadrants in order, so this is the
+same as (pi*(((mod(i,4)/2)+(i*i/n)))).
+This is similar to the formula suggested by M. Schroeder,
+but the addition of the "mod(i,4)/2" term improves its performance. If N=100, for example, Schroeder's
+peak is 13.49, whereas the mod peak is 11.90. There are better choices of quadrant than mod(i,4);
+if N=14, the mod(i,4) formula gives a peak of 4.89 (Schroeder's formula's peak is 5.1),
+but an exhaustive search of all quadrant choices
+finds #(0 0 0 1 3 3 0 1 2 3 1 3 2 3) with a peak of 4.28.
+Since the search involves approximately 4^n FFTs,
+there's not much hope of going above N=20 or thereabouts.
+I can't see any pattern in the lists of ideal quadrants.
+</p>
+
+<p>
+The corresponding even harmonics version is (-pi/n)*(i+1)*(i+1) - (i+1)*pi/2.
+These sorts of formulas do better as n increases, but I don't think they reach n^.5. If n=4000000,
+the peak is at 2408.9 (n^.512).
+A linear equation in "i" here is simply phase offset in the sum of sines formula mentioned
+earlier, so given an initial phase of x*i, as x goes from 0 to pi/2, the peak goes from .7245*n to n.
+Another good variant is (pi*i*i)/n using cos rather than sin.
+</p>
+
+
+<p>I haven't found any functions that get all the way to the square root. In the next graph,
+the y axis is the peak value with n=100, the x axis is the number of tests, and we've
+sorted the tests by peak. Each test is centered around a known excellent minimum
+peak, and the separate curves are showing the peaks when the initial phases can vary
+around that best value by pi/4, then pi/8 etc. It's hard to read at first, but
+take the black top curve. This is what you'd get if you randomly sampled a hypercube whose side length is pi/2 centered on that minimum.
+Nearly all the values are between 18 (100^.63) and 23 (100^.68).
+Each successive curve divides the space we sample by 2 in all 100 dimensions,
+so by the time we get to the bottom curve, we've reduced our search space by
+a factor of 2^800 (we're down to .006 on a side), and we still don't see the actual minimum
+even once in 50000 tries!
+Imagine trying to set up a grid to catch this point.
+</p>
+
+<img class="indented" src="pix/8way.png" alt="histogram of 100 reduced 8 times">
+
+<p>What to do?
+There are a bunch of papers on this subject, but the best I found was:
+Horner and Beauchamp, "a genetic algorithm-based method
+for synthesis of low peak amplitude signals", J. Acoustic. Soc. Am Vol 99 No 1 Jan 96, online
+at ems.music.uiuc.edu/beaucham/papers/JASA.01.96.pdf,
+<!--
+(In both this paper, and Schroeder's earlier
+one, much fuss is made of the RMS value, but that value is independent of the
+initial phases, so it is obviously irrelevant).
+-->
+They report good results using the genetic algorithm, so it tried it.
+I started with 2000 randomly chosen initial points and a search radius
+of 1.0 (= pi). These are pretty good choices, but after a few months of searching, I reached a point of almost no
+returns. I tried variants of the basic algorithm and other search methods, but the results were not very good until
+I noticed that in the
+graphs of the peaks, the good values are more or less clustered together. So I tried centering
+the genetic search on the best phases I had found to that point, then repeating
+the search each time from the new best point, slowly reducing the search radius ("simulated annealing" is the jargon for this).
+</p>
+
+<pre class="indented">
+(define (iterated-peak choice n)
+ (let ((phases (make-vector n 0.0))
+ (cur-best n)
+ (cur-incr 1.0))
+ (do ((i 1 (+ i 1)))
+ ((= i n))
+ (set! (phases i) (random 1.0)))
+ (do ()
+ ((< cur-incr .001))
+ (let ((vals (<em class=red>fpsap</em> (if (eq? choice :all) 0
+ (if (eq? choice :odd) 1
+ (if (eq? choice :even) 2 3)))
+ n phases 5000 cur-incr)))
+ (let ((pk (car vals))
+ (new-phases (cadr vals)))
+ (let ((down (- cur-best pk)))
+ (if (< down (/ cur-best 10))
+ (set! cur-incr (* 0.5 cur-incr))))
+ (if (< pk cur-best)
+ (begin
+ (set! cur-best pk)
+ (set! phases (float-vector->vector new-phases)))))))
+ (list cur-best phases)))
+</pre>
+
+<p>The "fpsap" function is the genetic algorithm mentioned earlier, written in C.
+Here is the GA code used to find the initial-phase polynomials mentioned above:
+</p>
+
+<pre class="indented">
+(define (piterate choice n) ; (piterate :all 4096)
+ (let* ((size 1000)
+ (pop (make-vector size))
+ (phases (make-vector n 0.0)))
+ ;; initialize our set of choices
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (let ((f1 (random 1.0)) ; or (- 1.0 (random 2.0)) and also below
+ (f2 (random 1.0)))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! (phases k) (modulo (/ (+ (* f2 k k) (* f1 k)) pi) 2.0)))
+ (set! (pop i) (list (get-peak choice n phases) f1 f2))))
+ ;; now do the GA search with annealing
+ (do ((try 0 (+ try 1))
+ (increment .3 (* increment .98)))
+ ((= try 1000))
+ (sort! pop (lambda (a b) (< (car a) (car b))))
+ (format #t "~A ~D ~A ~A~%" choice n (pop 0) (log (car (pop 0)) n))
+ (do ((i 0 (+ i 1))
+ (j (/ size 2) (+ j 1)))
+ ((= i (/ size 2)))
+ (let ((f1 (+ (list-ref (pop i) 1) (random increment)))
+ (f2 (+ (list-ref (pop i) 2) (random increment))))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! (phases k) (modulo (/ (+ (* f2 k k) (* f1 k)) pi) 2.0)))
+ (set! (pop j) (list (get-peak choice n phases) f1 f2)))))))
+</pre>
+
+<!--
+(if (not (provided? 'snd-rgb.scm)) (load "rgb.scm"))
+
+(define (draw-sqrt-label xg yg exponent) ; 20 3 ".59"
+ (let* ((snd 0)
+ (chn 0)
+ (axinf (axis-info snd chn))
+ (x (axinf 10))
+ (y (axinf 13))
+ (grf-width (- (axinf 12) x))
+ (grf-height (- (axinf 11) y))
+
+ (width 278)
+ (height 115)
+
+ (red (make-color 1 0 0))
+ (blue (make-color 0 0 1))
+ (green (make-color 0 1 0))
+ (black (make-color 0 0 0))
+ (chocolate (make-color 0.82 0.41 0.12))
+ )
+
+ (set! (foreground-color snd chn) black)
+ (let ((x1 (+ x xg))
+ (y1 (+ y yg))
+ (yoff 20)
+ (yinit 15)
+ (ytext -7))
+
+ (fill-rectangle x1 y1 width 1 snd chn)
+ (fill-rectangle x1 (+ y1 height) width 1 snd chn)
+ (fill-rectangle x1 y1 1 height snd chn)
+ (fill-rectangle (+ x1 width -1) y1 1 height snd chn)
+
+ (set! (foreground-color snd chn) black)
+ (fill-rectangle (+ x1 10) (+ y1 yinit) 30 3 snd chn)
+ (set! (foreground-color snd chn) black)
+ (draw-string "all harmonics" (+ x1 50) (+ y1 yinit ytext) snd chn)
+
+ (set! (foreground-color snd chn) red)
+ (fill-rectangle (+ x1 10) (+ y1 yinit yoff) 30 3 snd chn)
+ (set! (foreground-color snd chn) black)
+ (draw-string "odd-numbered harmonics" (+ x1 50) (+ y1 yinit yoff ytext) snd chn)
+
+ (set! (foreground-color snd chn) chocolate)
+ (fill-rectangle (+ x1 10) (+ y1 yinit (* 2 yoff)) 30 3 snd chn)
+ (set! (foreground-color snd chn) black)
+ (draw-string "even-numbered harmonics" (+ x1 50) (+ y1 yinit (* 2 yoff) ytext) snd chn)
+
+ (set! (foreground-color snd chn) blue)
+ (fill-rectangle (+ x1 10) (+ y1 yinit (* 3 yoff)) 30 3 snd chn)
+ (set! (foreground-color snd chn) black)
+ (draw-string "prime-numbered harmonics" (+ x1 50) (+ y1 yinit (* 3 yoff) ytext) snd chn)
+
+ (set! (foreground-color snd chn) green)
+ (fill-rectangle (+ x1 10) (+ y1 yinit (* 4 yoff)) 30 3 snd chn)
+ (set! (foreground-color snd chn) black)
+ (draw-string (format #f "n^~A" exponent) (+ x1 50) (+ y1 yinit (* 4 yoff) ytext) snd chn)
+ )))
+
+
+(define* (make-sqrt-png (xp 0.59))
+ (set! *with-inset-graph* #f)
+ ;; see tmp26...
+ (with-sound (:channels 5 :clipped #f)
+
+ (do ((i 1 (1+ i)))
+ ((> i 128))
+ (let ((n-min-val (vector-find-if (lambda (val)
+ (and val
+ (vector? val)
+ (= (val 0) i)
+ (let ((a-val (val 1))
+ (a-len (length val)))
+ (do ((k 2 (1+ k)))
+ ((= k a-len))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
+ a-val)))
+ noid-min-peak-phases)))
+
+ (let ((odd-min-val (vector-find-if (lambda (val)
+ (and val
+ (vector? val)
+ (= (val 0) i)
+ (let ((a-val (val 1))
+ (a-len (length val)))
+ (do ((k 2 (1+ k)))
+ ((= k a-len))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
+ a-val)))
+ nodd-min-peak-phases)))
+
+ (let ((prime-min-val (vector-find-if (lambda (val)
+ (and val
+ (vector? val)
+ (= (val 0) i)
+ (let ((a-val (val 1))
+ (a-len (length val)))
+ (do ((k 2 (1+ k)))
+ ((= k a-len))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
+ a-val)))
+ primoid-min-peak-phases)))
+
+ (let ((even-min-val (vector-find-if (lambda (val)
+ (and val
+ (vector? val)
+ (= (val 0) i)
+ (let ((a-val (val 1))
+ (a-len (length val)))
+ (do ((k 2 (1+ k)))
+ ((= k a-len))
+ (if (and (number? (val k))
+ (< (val k) a-val))
+ (set! a-val (val k))))
+ a-val)))
+ neven-min-peak-phases)))
+
+ (outa i (or n-min-val 0.0))
+ (outb i (or odd-min-val 0.0))
+ (outc i (or prime-min-val 0.0))
+ (outd i (expt (exact->inexact i) xp)) ; or (log pk n)?
+ (out-any i (or even-min-val 0.0) 4)
+ ))))))
+
+ (set! (y-bounds) (list 0 21))
+ (set! *channel-style* channels-superimposed)
+ (set! *axis-color* (make-color 0 0 0))
+ (set! *x-axis-style* x-axis-in-samples)
+ (do ((i 0 (1+ i)))
+ ((= i 5))
+ (set! (x-axis-label 0 i) "n"))
+ (set! *selected-graph-color* (make-color 1 1 1))
+ (set! *axis-label-font* "9x15")
+ )
+
+-->
+
+
+
+<p>
+Here are the results I have so far. In each set, the first number is the number
+of harmonics, then the minimum peak amplitude, then (log peak n).
+</p>
+
+<div class="simple">
+
+<pre class="indented">
+=============================================================================================
+ all odd even prime
+=============================================================================================
+
+20 4.288 0.4860 | 11 3.177 0.4820 | 115 11.164 0.5085 | 24 5.643 0.5445
+14 3.612 0.4867 | 9 2.886 0.4824 | 113 11.086 0.5089 | 18 4.855 0.5467
+23 4.604 0.4870 | 17 3.926 0.4827 | 126 11.729 0.5091 | 25 5.811 0.5467
+11 3.218 0.4874 | 10 3.053 0.4848 | 114 11.157 0.5093 | 19 5.001 0.5467
+17 3.980 0.4876 | 19 4.172 0.4851 | 127 11.792 0.5094 | 28 6.191 0.5471
+16 3.874 0.4884 | 14 3.598 0.4852 | 117 11.317 0.5095 | 93 11.942 0.5472
+24 4.728 0.4888 | 13 3.475 0.4856 | 124 11.657 0.5095 | 23 5.562 0.5473
+19 4.218 0.4889 | 18 4.070 0.4856 | 99 10.395 0.5095 | 22 5.434 0.5476
+22 4.540 0.4894 | 16 3.857 0.4869 | 120 11.467 0.5096 | 17 4.719 0.5476
+21 4.443 0.4898 | 15 3.738 0.4869 | 121 11.520 0.5096 | 95 12.115 0.5478
+15 3.768 0.4899 | 12 3.362 0.4879 | 128 11.857 0.5097 | 40 7.543 0.5478
+25 4.853 0.4907 | 28 5.089 0.4883 | 256 16.896 0.5098 | 77 10.803 0.5479
+13 3.524 0.4911 | 21 4.448 0.4902 | 96 10.249 0.5099 | 30 6.452 0.5481
+12 3.389 0.4911 | 23 4.662 0.4909 | 125 11.726 0.5099 | 39 7.452 0.5482
+18 4.140 0.4915 | 20 4.358 0.4914 | 102 10.574 0.5099 | 102 12.631 0.5484
+10 3.102 0.4917 | 31 5.419 0.4921 | 104 10.682 0.5100 | 86 11.518 0.5487
+29 5.241 0.4920 | 22 4.581 0.4924 | 123 11.636 0.5100 | 47 8.268 0.5487
+27 5.064 0.4922 | 24 4.786 0.4927 | 111 11.044 0.5100 | 63 9.713 0.5487
+28 5.157 0.4923 | 33 5.603 0.4929 | 100 10.472 0.5100 | 51 8.653 0.5488
+37 5.918 0.4924 | 25 4.887 0.4929 | 88 9.812 0.5100 | 94 12.115 0.5490
+35 5.762 0.4926 | 29 5.263 0.4932 | 116 11.309 0.5103 | 87 11.613 0.5491
+26 4.982 0.4929 | 30 5.353 0.4933 | 122 11.609 0.5104 | 109 13.144 0.5491
+33 5.608 0.4931 | 8 2.791 0.4935 | 109 10.962 0.5104 | 20 5.183 0.5492
+32 5.526 0.4932 | 27 5.089 0.4937 | 94 10.168 0.5105 | 21 5.324 0.5492
+30 5.361 0.4937 | 26 5.006 0.4944 | 103 10.655 0.5105 | 74 10.650 0.5496
+31 5.453 0.4939 | 7 2.618 0.4946 | 105 10.762 0.5105 | 89 11.788 0.5496
+36 5.872 0.4940 | 32 5.563 0.4952 | 83 9.549 0.5106 | 29 6.365 0.5496
+9 2.962 0.4941 | 52 7.080 0.4954 | 93 10.121 0.5107 | 96 12.293 0.5497
+8 2.795 0.4942 | 50 6.947 0.4955 | 119 11.483 0.5107 | 101 12.654 0.5499
+34 5.715 0.4943 | 34 5.741 0.4956 | 112 11.133 0.5107 | 114 13.530 0.5500
+70 8.177 0.4946 | 82 8.895 0.4960 | 108 10.929 0.5108 | 38 7.396 0.5501
+39 6.124 0.4946 | 35 5.833 0.4960 | 1024 34.487 0.5108 | 57 9.246 0.5501
+93 9.413 0.4947 | 48 6.828 0.4962 | 106 10.831 0.5109 | 59 9.424 0.5502
+41 6.278 0.4947 | 41 6.322 0.4966 | 97 10.354 0.5109 | 33 6.846 0.5502
+60 7.589 0.4950 | 43 6.474 0.4966 | 101 10.578 0.5111 | 37 7.292 0.5502
+38 6.056 0.4951 | 72 8.366 0.4967 | 85 9.691 0.5112 | 31 6.616 0.5502
+69 8.144 0.4953 | 45 6.625 0.4967 | 84 9.634 0.5113 | 97 12.398 0.5503
+48 6.804 0.4953 | 42 6.403 0.4968 | 95 10.275 0.5116 | 27 6.134 0.5503
+58 7.475 0.4954 | 74 8.488 0.4969 | 82 9.531 0.5116 | 41 7.720 0.5504
+56 7.349 0.4955 | 78 8.715 0.4970 | 118 11.484 0.5117 | 36 7.188 0.5504
+42 6.374 0.4956 | 37 6.019 0.4971 | 110 11.084 0.5117 | 16 4.600 0.5504
+64 7.856 0.4956 | 46 6.709 0.4972 | 91 10.063 0.5118 | 108 13.162 0.5505
+40 6.224 0.4956 | 39 6.182 0.4972 | 86 9.779 0.5119 | 122 14.078 0.5505
+83 8.939 0.4957 | 105 10.116 0.4972 | 107 10.937 0.5119 | 43 7.936 0.5507
+63 7.800 0.4958 | 47 6.785 0.4973 | 92 10.124 0.5119 | 54 8.998 0.5508
+59 7.557 0.4960 | 38 6.108 0.4975 | 90 10.013 0.5120 | 52 8.817 0.5509
+92 9.420 0.4960 | 89 9.332 0.4976 | 71 8.877 0.5122 | 66 10.066 0.5512
+50 6.967 0.4962 | 111 10.417 0.4976 | 79 9.381 0.5123 | 70 10.403 0.5513
+47 6.757 0.4962 | 40 6.272 0.4978 | 75 9.137 0.5124 | 106 13.080 0.5513
+45 6.613 0.4962 | 56 7.419 0.4979 | 98 10.481 0.5124 | 45 8.157 0.5514
+100 9.828 0.4962 | 106 10.198 0.4980 | 78 9.336 0.5127 | 62 9.734 0.5514
+44 6.544 0.4964 | 59 7.618 0.4980 | 87 9.875 0.5128 | 12 3.936 0.5514
+46 6.691 0.4965 | 57 7.489 0.4980 | 512 24.510 0.5128 | 34 6.991 0.5515
+57 7.443 0.4965 | 91 9.457 0.4981 | 77 9.278 0.5128 | 85 11.589 0.5515
+84 9.023 0.4965 | 51 7.088 0.4981 | 89 9.998 0.5129 | 125 14.336 0.5515
+94 9.544 0.4965 | 80 8.870 0.4981 | 81 9.529 0.5130 | 88 11.815 0.5515
+95 9.595 0.4966 | 81 8.926 0.4981 | 70 8.849 0.5132 | 64 9.912 0.5515
+49 6.908 0.4966 | 101 9.965 0.4982 | 61 8.247 0.5132 | 46 8.261 0.5515
+43 6.475 0.4966 | 119 10.815 0.4982 | 72 8.986 0.5134 | 72 10.580 0.5516
+67 8.073 0.4967 | 77 8.707 0.4982 | 80 9.493 0.5136 | 92 12.112 0.5516
+54 7.254 0.4968 | 76 8.651 0.4982 | 73 9.061 0.5137 | 60 9.568 0.5516
+68 8.135 0.4968 | 62 7.817 0.4982 | 74 9.134 0.5139 | 124 14.280 0.5516
+71 8.312 0.4968 | 55 7.364 0.4982 | 63 8.414 0.5141 | 103 12.892 0.5516
+114 10.518 0.4968 | 67 8.128 0.4983 | 68 8.755 0.5142 | 123 14.218 0.5516
+85 9.093 0.4969 | 110 10.408 0.4984 | 57 7.998 0.5143 | 56 9.213 0.5517
+91 9.407 0.4969 | 90 9.422 0.4985 | 76 9.274 0.5143 | 98 12.555 0.5518
+87 9.201 0.4969 | 60 7.700 0.4985 | 64 8.501 0.5146 | 48 8.469 0.5519
+73 8.433 0.4969 | 86 9.213 0.4985 | 67 8.715 0.5149 | 128 14.551 0.5519
+88 9.256 0.4970 | 108 10.325 0.4986 | 58 8.103 0.5153 | 120 14.042 0.5519
+55 7.328 0.4970 | 44 6.599 0.4986 | 2048 50.887 0.5154 | 116 13.783 0.5519
+98 9.767 0.4971 | 88 9.324 0.4986 | 62 8.391 0.5154 | 110 13.386 0.5519
+86 9.154 0.4971 | 64 7.957 0.4987 | 69 8.870 0.5155 | 32 6.772 0.5519
+80 8.832 0.4971 | 83 9.061 0.4988 | 65 8.610 0.5157 | 84 11.537 0.5519
+78 8.722 0.4971 | 68 8.204 0.4988 | 66 8.679 0.5158 | 42 7.870 0.5520
+74 8.497 0.4971 | 102 10.046 0.4988 | 53 7.750 0.5158 | 76 10.919 0.5520
+82 8.942 0.4971 | 85 9.173 0.4989 | 59 8.195 0.5159 | 104 12.987 0.5521
+53 7.198 0.4971 | 114 10.621 0.4989 | 51 7.602 0.5159 | 61 9.674 0.5521
+51 7.062 0.4972 | 61 7.775 0.4989 | 55 7.908 0.5160 | 105 13.058 0.5521
+90 9.369 0.4972 | 125 11.122 0.4989 | 44 7.048 0.5160 | 53 8.953 0.5521
+75 8.558 0.4973 | 70 8.328 0.4989 | 47 7.293 0.5160 | 75 10.845 0.5521
+52 7.133 0.4973 | 36 5.978 0.4990 | 38 6.537 0.5161 | 115 13.732 0.5521
+99 9.827 0.4973 | 98 9.853 0.4990 | 54 7.845 0.5164 | 71 10.523 0.5521
+61 7.725 0.4973 | 63 7.904 0.4990 | 60 8.297 0.5168 | 81 11.319 0.5522
+65 7.973 0.4973 | 107 10.296 0.4990 | 50 7.554 0.5169 | 100 12.717 0.5522
+97 9.734 0.4974 | 103 10.102 0.4990 | 56 8.011 0.5169 | 73 10.689 0.5522
+79 8.789 0.4974 | 118 10.812 0.4990 | 52 7.716 0.5171 | 107 13.202 0.5522
+76 8.623 0.4975 | 115 10.674 0.4990 | 48 7.407 0.5173 | 50 8.676 0.5523
+62 7.793 0.4975 | 58 7.586 0.4990 | 45 7.165 0.5173 | 80 11.248 0.5523
+112 10.460 0.4975 | 128 11.261 0.4990 | 40 6.748 0.5176 | 113 13.613 0.5523
+101 9.935 0.4975 | 53 7.253 0.4990 | 46 7.276 0.5184 | 55 9.146 0.5523
+109 10.322 0.4976 | 94 9.654 0.4991 | 42 6.941 0.5184 | 49 8.583 0.5524
+72 8.398 0.4976 | 69 8.275 0.4991 | 34 6.223 0.5184 | 111 13.484 0.5524
+81 8.909 0.4977 | 92 9.553 0.4991 | 39 6.683 0.5185 | 91 12.084 0.5524
+96 9.699 0.4978 | 120 10.909 0.4991 | 49 7.532 0.5188 | 121 14.145 0.5524
+77 8.694 0.4979 | 113 10.586 0.4991 | 41 6.881 0.5194 | 79 11.178 0.5525
+116 10.667 0.4980 | 96 9.759 0.4991 | 36 6.432 0.5194 | 69 10.373 0.5525
+115 10.622 0.4980 | 66 8.095 0.4992 | 43 7.055 0.5195 | 119 14.019 0.5525
+66 8.057 0.4980 | 73 8.515 0.4992 | 37 6.533 0.5198 | 117 13.889 0.5525
+102 10.008 0.4980 | 84 9.133 0.4992 | 32 6.061 0.5199 | 118 13.956 0.5525
+89 9.351 0.4980 | 116 10.733 0.4993 | 33 6.163 0.5201 | 112 13.561 0.5525
+113 10.533 0.4981 | 100 9.968 0.4993 | 29 5.766 0.5203 | 127 14.536 0.5525
+128 11.210 0.4981 | 54 7.328 0.4993 | 35 6.362 0.5205 | 78 11.104 0.5526
+111 10.443 0.4981 | 95 9.717 0.4993 | 26 5.452 0.5206 | 68 10.294 0.5526
+122 10.950 0.4982 | 121 10.965 0.4993 | 31 5.988 0.5212 | 58 9.429 0.5526
+127 11.176 0.4983 | 122 11.011 0.4993 | 24 5.253 0.5220 | 15 4.466 0.5526
+108 10.313 0.4984 | 117 10.783 0.4994 | 30 5.907 0.5222 | 65 10.042 0.5526
+105 10.170 0.4984 | 104 10.169 0.4994 | 23 5.148 0.5226 | 99 12.671 0.5526
+103 10.073 0.4984 | 79 8.865 0.4994 | 21 4.920 0.5233 | 83 11.495 0.5526
+104 10.124 0.4984 | 65 8.042 0.4994 | 27 5.620 0.5238 | 126 14.478 0.5526
+117 10.740 0.4985 | 71 8.407 0.4995 | 28 5.732 0.5240 | 90 12.023 0.5526
+126 11.145 0.4985 | 109 10.414 0.4995 | 25 5.403 0.5241 | 44 8.096 0.5527
+120 10.878 0.4985 | 99 9.928 0.4995 | 22 5.055 0.5242 | 26 6.060 0.5530
+107 10.274 0.4985 | 49 6.989 0.4996 | 18 4.569 0.5257 | 82 11.463 0.5535
+110 10.417 0.4985 | 97 9.832 0.4996 | 20 4.839 0.5264 | 35 7.164 0.5538
+121 10.925 0.4986 | 93 9.629 0.4997 | 17 4.463 0.5280 | 67 10.270 0.5540
+118 10.790 0.4986 | 75 8.650 0.4997 | 16 4.325 0.5282 | 11 3.778 0.5544
+124 11.060 0.4986 | 124 11.120 0.4997 | 19 4.741 0.5286 | 9 3.382 0.5546
+119 10.836 0.4986 | 87 9.317 0.4998 | 15 4.192 0.5292 | 14 4.324 0.5548
+123 11.016 0.4986 | 126 11.217 0.4999 | 14 4.097 0.5344 | 13 4.154 0.5553
+125 11.105 0.4986 | 123 11.088 0.4999 | 12 3.787 0.5359 | 10 3.602 0.5565
+106 10.234 0.4987 | 127 11.268 0.5000 | 13 3.973 0.5378 | 5 2.477 0.5635
+7 2.639 0.4988 | 112 10.582 0.5000 | 11 3.656 0.5406 | 4 2.192 0.5662
+256 16.061 0.5007 | 3 1.739 0.5035 | 10 3.559 0.5513 | 8 3.263 0.5687
+1024 33.411 0.5062 | 512 23.717 0.5075 | 8 3.198 0.5590 | 256 23.955 0.5728
+512 23.664 0.5072 | 256 16.933 0.5102 | 9 3.454 0.5641 | 7 3.062 0.5750
+2048 50.205 0.5136 | 1024 34.393 0.5104 | 7 3.047 0.5726 | 6 2.805 0.5757
+4 2.039 0.5139 | 2048 49.287 0.5112 | 6 2.837 0.5820 | 512 38.603 0.5856
+6 2.549 0.5223 | 4 2.045 0.5161 | 5 2.605 0.5948 | 2048 95.904 0.5985
+5 2.343 0.5292 | 6 2.523 0.5164 | 3 2.021 0.6406 | 1024 65.349 0.6030
+3 1.980 0.6217 | 5 2.307 0.5195 | 4 2.431 0.6406 | 3 1.980 0.6217
+2 1.760 0.8156 | 2 1.539 0.6220 | 2 1.760 0.8157 | 2 1.760 0.8156
+</pre>
+
+</div>
+
+<!-- from gad125.scm -->
+
+<p>
+Here is a graph of the peaks (as of February, 2015), followed by a graph of
+the exponent vs n (n^y = peak amp).
+</p>
+
+<img class="indented" src="pix/sqrt.png" alt="sqrt n">
+
+<img class="indented" src="pix/sqrt1.png" alt="n^y">
+
+<!-- from tmp26.scm -->
+
+<p>The "even" cases are not independent of the "all" cases; each even-harmonics case can be at worst 1.0 above
+the corresponding (n-1) all-harmonics case (shift the current "all" choices right to multiply each by 2, then set the new fundamental
+phase to 0.0). If you then search around this set of phases, you'll find very good values. Using Snd's fpsap (a version
+of the genetic algorithm):
+</p>
+
+
+<pre class="indented">
+(let ((all (cadr (get-best :all (- n 1))))) ; get the best all-harmonic phases for n - 1
+ (let ((new-phases (make-vector n 0.0))) ; place in new phase vector shifted up
+ (do ((k 0 (+ k 1)))
+ ((= k (- n 1)))
+ (set! (new-phases (+ k 1)) (all k)))
+ (set! (new-phases 0) 0.0)
+ (fpsap 2 n new-phases))) ; search that vicinity for a good set (2 = even harmonics)
+</pre>
+
+
+
+<p>Here is the time domain view of one of the n=5 cases when the minimum peak phases are chosen; the sum of the 5 components is in black.
+</p>
+
+<img class="indented" src="pix/sum5.png" alt="n=5 case">
+
+<p>The next graph compares the 100 harmonic minimum peak case in blue with the
+case where all the initial phases are 0.0 in black:
+</p>
+
+<img class="indented" src="pix/100twice.png" alt="100 harmonics">
+
+<p>And a few others:
+</p>
+
+<table>
+<tr>
+<td><img class="indented" src="pix/all57.png" alt="57 harmonics"></td>
+<td><img class="indented" src="pix/odd57.png" alt="57 odd harmonics"></td>
+</tr></table>
+
+<img class="indented" src="pix/all99.png" alt="99 harmonics">
+
+<!-- all57:
+
+(define phases #(0.000000 0.402544 0.873914 0.824224 1.710182 0.183023 0.378574 0.128782 1.816255 1.249608 1.030253 1.030831 0.184699 0.677473 1.528003 1.262679 1.840809 0.082787 1.487290 1.579585 0.150833 0.308197 0.183834 1.435443 0.452047 0.800416 1.697556 1.103318 1.169502 1.438166 1.765331 0.875181 1.049248 1.321068 0.824424 0.599899 1.694664 0.504547 1.583285 1.657047 0.940116 1.788668 1.529808 0.367904 1.371253 0.572088 1.370961 1.371348 0.244247 1.592370 0.135712 0.911345 0.228778 1.543468 1.190091 1.504171 1.491159))
+
+(define (make-all-57)
+ (set! *with-inset-graph* #f)
+ (let* ((samples 1000)
+ (incr (/ (* 2 pi) samples)))
+ (with-sound (:channels 1 :clipped #f)
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x incr)))
+ ((= i samples))
+ (let ((sum 0.0))
+ (do ((k 1 (+ k 1)))
+ ((= k 58))
+ (let ((val (sin (+ (* k x) (* pi (phases (- k 1)))))))
+ (set! sum (+ sum val))))
+ (outa i sum)))))
+
+ (set! (y-bounds) (list -8.0 8.0))
+ (set! *channel-style* channels-superimposed)
+ (set! *axis-color* (make-color 0 0 0))
+ (set! *x-axis-style* x-axis-in-samples)
+ (set! *selected-graph-color* (make-color 1 1 1))
+ (set! *selected-data-color* (make-color 0 0 0))
+ (set! *axis-label-font* "9x15")
+ (set! (x-axis-label) "57 harmonics with peak at 7.546")
+ )
+
+(define odd-phases #(0.000000 -0.095905 1.360419 0.638244 0.752436 0.060307 1.680434 0.892474 1.556627 1.342822 1.202039 0.989766 0.747386 1.502768 1.484789 1.280575 -0.299617 0.648918 1.386594 0.570314 0.971680 0.602106 1.411224 0.349887 1.776881 0.686211 -0.138570 0.102115 0.187653 1.480790 0.475407 0.080540 0.078971 0.288194 0.529704 0.929207 1.248880 1.402125 0.332857 1.263541 0.757496 0.254501 0.084949 1.308375 0.041441 0.288389 1.222780 0.362725 1.537117 1.518618 0.267187 0.845609 0.722902 0.451852 0.582589 0.839423 1.817054))
+
+(define (make-odd-57)
+ (set! *with-inset-graph* #f)
+ (let* ((samples 1000)
+ (incr (/ (* 2 pi) samples)))
+ (with-sound (:channels 1 :clipped #f)
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x incr)))
+ ((= i samples))
+ (let ((sum 0.0))
+ (do ((k 1 (+ k 1))
+ (j 1 (+ j 2)))
+ ((= k 58))
+ (let ((val (sin (+ (* j x) (* pi (odd-phases (- k 1)))))))
+ (set! sum (+ sum val))))
+ (outa i sum)))))
+
+ (set! (y-bounds) (list -8.0 8.0))
+ (set! *channel-style* channels-superimposed)
+ (set! *axis-color* (make-color 0 0 0))
+ (set! *x-axis-style* x-axis-in-samples)
+ (set! *selected-graph-color* (make-color 1 1 1))
+ (set! *selected-data-color* (make-color 0 0 0))
+ (set! *axis-label-font* "9x15")
+ (set! (x-axis-label) "57 odd harmonics with peak at 7.564")
+ )
+
+(define all-99 #(0.000000 0.597494 1.146001 -0.056648 1.705293 0.247794 1.067079 1.589758 1.638162 1.207186 0.711609 0.710553 -0.195687 0.350442 0.679684 1.653746 -0.460484 -0.156879 1.629420 1.730071 1.077540 0.075860 0.435827 1.574017 0.450715 1.581154 -0.027175 1.502323 1.501097 0.855975 1.269118 1.563924 1.244477 0.428054 1.250656 0.668151 0.672807 0.481658 1.215020 0.229865 0.052263 -0.265466 0.722697 0.484686 1.525745 -0.088395 1.682325 1.764438 0.384531 0.550629 -0.009864 1.443840 0.844832 1.132436 -0.107693 0.137994 0.009887 1.832991 0.076907 0.020473 0.102198 0.283702 1.246352 0.965046 0.026752 1.471014 0.126851 0.144964 0.731028 -0.335345 0.712331 0.471273 1.705158 0.467571 1.388009 0.875431 0.986268 1.669037 0.667955 0.887678 1.688981 -0.459336 1.461469 1.135012 0.449583 0.176052 1.407825 1.801166 0.208742 1.880027 0.895566 1.761286 1.021896 0.520239 1.466186 0.733284 1.188215 1.584263 1.296521))
+
+(define (make-all-99)
+ (set! *with-inset-graph* #f)
+ (let* ((samples 1200)
+ (incr (/ (* 2 pi) samples)))
+ (with-sound (:channels 1 :clipped #f)
+ (do ((i 0 (+ i 1))
+ (x 0.0 (+ x incr)))
+ ((= i samples))
+ (let ((sum 0.0))
+ (do ((k 1 (+ k 1)))
+ ((= k 100))
+ (let ((val (sin (+ (* k x) (* pi (all-99 (- k 1)))))))
+ (set! sum (+ sum val))))
+ (outa i sum)))))
+
+ (set! (y-bounds) (list -10.0 10.0))
+ (set! *channel-style* channels-superimposed)
+ (set! *axis-color* (make-color 0 0 0))
+ (set! *x-axis-style* x-axis-in-samples)
+ (set! *selected-graph-color* (make-color 1 1 1))
+ (set! *selected-data-color* (make-color 0 0 0))
+ (set! *axis-label-font* "9x15")
+ (set! (x-axis-label) "99 harmonics with peak at 9.9431")
+ )
+-->
+
+
+<p>
+As N increases, the minimum peak amplitude waveform can approach
+white noise (in sound as well as appearance); here is a small portion of one period when n=65536 (the prescaling peak was 704):
+</p>
+
+
+<img class="indented" src="pix/s65536.png" alt="65536 harmonics">
+
+
+<p>but the waveforms generated from the initial-phase polynomials look more regular (this is with n=64):
+</p>
+
+<img class="indented" src="pix/s64pi.png" alt="64 harmonics using pi/n formula">
+
+
+<!--
+(define (try n a b)
+ (let ((gens (make-vector n #f))
+ (sr (if (< n 1000) 44100 (* n 128))))
+ (with-sound (:statistics #t :srate sr)
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (set! (gens i) (make-oscil (+ 1 (* i 1))
+ (+ (* a i i) (* b i)))))
+ (do ((i 0 (+ i 1)))
+ ((= i sr))
+ (let ((sum 0.0))
+ (do ((k 0 (+ k 1)))
+ ((= k n))
+ (set! sum (+ sum (oscil (gens k)))))
+ (outa i (* 1.0 sum)))))
+ (list (log (maxamp) n) (* 1.0 (/ (maxamp-position) sr)))))
+
+ (try 100 (+ pi (/ pi 100)) (/ pi -2.0))
+ same settings as above but
+ (set! (x-axis-label) "n=64, initial-phase: (pi+pi/64)*i*i - pi*i/2")
+-->
+
+<!-- this moves from cosines to the minimum amp phases:
+
+(let ((93-phases #(0.000000 0.102641 0.679230 0.798388 0.598526 0.445036 1.682481 1.416478 1.010866 0.838753 0.518866 0.185140 -0.260801 1.643327 1.645133 1.587871 1.510095 1.367190 1.252764 1.075109 0.997402 1.226792 1.097666 1.109286 1.266675 1.142806 1.396415 1.366757 1.323435 -0.151657 0.110933 0.254314 0.125232 0.426419 0.874355 1.227943 1.386454 1.437438 0.183960 0.673205 0.896736 1.317085 1.421345 0.557215 0.650544 0.979705 1.599286 -0.027664 0.967924 1.389243 -0.027060 0.800953 1.098758 1.686133 0.493843 1.257456 0.105617 0.800125 0.006765 0.139250 1.353019 -0.059007 1.198209 0.066444 0.431719 1.470864 0.547882 1.294688 0.757592 1.690943 0.714913 1.735237 0.542409 1.804533 0.779629 -0.296056 1.090213 0.178123 1.832019 1.000948 -0.131923 1.161644 0.360890 0.065736 1.232224 0.792139 0.176636 1.688866 1.432871 0.734257 0.042563 1.592538 0.764029)))
+ (let ((freq 30.0)
+ (dur 3.0)
+ (n 93))
+ (with-sound ()
+ (let ((samps (floor (* dur 44100))))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((off (/ (* pi (- 0.5 (93-phases i))) (* dur 44100)))
+ (h (hz->radians (* freq (+ i 1)))))
+ (do ((k 0 (+ k 1))
+ (phase (* pi 0.5) (+ phase h off)))
+ ((= k samps))
+ (outa k (* .01 (sin phase))))))))))
+
+or much faster and using 1024:
+ (let ((freq 15.0)
+ (dur 5.0)
+ (n 1024))
+ (with-sound ()
+ (let ((samps (floor (* dur 44100)))
+ (1/n (/ 1.0 n))
+ (freqs (make-float-vector n))
+ (phases (make-float-vector n (* pi 0.5))))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((off (/ (* pi (- 0.5 (1024-phases i))) (* dur 44100)))
+ (h (hz->radians (* freq (+ i 1)))))
+ (set! (freqs i) (+ h off))))
+ (let ((ob (make-oscil-bank freqs phases)))
+ (do ((k 0 (+ k 1)))
+ ((= k samps))
+ (outa k (* 1/n (oscil-bank ob))))))))
+
+but that is dominated by the "fm-sweep" effect.
+
+(let ((98-phases #(0.000000 -0.183194 0.674802 1.163820 -0.147489 1.666302 0.367236 0.494059 0.191339 0.714980 1.719816 0.382307 1.017937 0.548019 0.342322 1.541035 0.966484 0.936993 -0.115147 1.638513 1.644277 0.036575 1.852586 1.211701 1.300475 1.231282 0.026079 0.393108 1.208123 1.645585 -0.152499 0.274978 1.281084 1.674451 1.147440 0.906901 1.137155 1.467770 0.851985 0.437992 0.762219 -0.417594 1.884062 1.725160 -0.230688 0.764342 0.565472 0.612443 0.222826 -0.016453 1.527577 -0.045196 0.585089 0.031829 0.486579 0.557276 -0.040985 1.257633 1.345950 0.061737 0.281650 -0.231535 0.620583 0.504202 0.817304 -0.010580 0.584809 1.234045 0.840674 1.222939 0.685333 1.651765 0.299738 1.890117 0.740013 0.044764 1.547307 0.169892 1.452239 0.352220 0.122254 1.524772 1.183705 0.507801 1.419950 0.851259 0.008092 1.483245 0.608598 0.212267 0.545906 0.255277 1.784889 0.270552 1.164997 -0.083981 0.200818 1.204088)))
+
+ (let ((freq 10.0)
+ (dur 5.0)
+ (n 98))
+ (with-sound ()
+ (let ((samps (floor (* dur 44100)))
+ (1/n (/ 1.0 n))
+ (freqs (make-float-vector n))
+ (phases (make-float-vector n (* pi 0.5))))
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (let ((off (/ (* pi (- 0.5 (98-phases i))) (* dur 44100)))
+ (h (hz->radians (* freq (+ i 1)))))
+ (set! (freqs i) (+ h off))))
+ (let ((ob (make-oscil-bank freqs phases)))
+ (do ((i 0 (+ i 1))) ; get rid of the distracting initial click
+ ((= i 1000))
+ (oscil-bank ob))
+ (do ((k 0 (+ k 1)))
+ ((= k samps))
+ (outa k (* 1/n (oscil-bank ob)))))))))
+
+-->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="pianodoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>piano</h2></td></tr></table>
-</td></tr></table>
+
+
+
+
+<!-- FILE: piano -->
+
+<div class="header" id="pianodoc">piano</div>
<!-- main-index |pianodoc:piano model -->
@@ -8433,278 +9115,206 @@ Julius O. Smith and Scott A. Van Duyne, "Commuted piano synthesis," in Proc. Int
To paraphrase, the model includes multiple coupled strings, a nonlinear hammer, and an arbitrarily large soundboard and enclosure.
The actual instrument name is 'p':
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (do ((i 0 (+ 1 i))) ((= i 7))
- (p (* i .5) :duration .5 ; generate a sequence of 1/2 second tones
- :keyNum (+ 24 (* 12 i)) ; jump by octaves
- :strike-velocity .5 ; 0 to 1, 0 is softest played note, 1 is loud note
- :amp .4 ; overall volume level
- :DryPedalResonanceFactor .25))) ; 0 no open string resonance
- ; 1.0 is about full resonance of dampers raised
- ; can be greater than 1.0
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (do ((i 0 (+ i 1))) ((= i 7))
+ (p (* i .5) :duration .5 ; generate a sequence of 1/2 second tones
+ :keyNum (+ 24 (* 12 i)) ; jump by octaves
+ :strike-velocity .5 ; 0 to 1, 0 is softest played note, 1 is loud note
+ :amp .4 ; overall volume level
+ :DryPedalResonanceFactor .25))) ; 0 no open string resonance
+ ; 1.0 is about full resonance of dampers raised
+ ; can be greater than 1.0
</pre>
+
<p>"p" has lots of parameters, and I really don't know what they do. The interested reader should
goof around with them.
</p>
-<pre>
- <em class=emdef>p</em> (start
- (duration 1.0)
- (keyNum 60.0) ; middleC=60: can use fractional part to detune
- (strike-velocity 0.5) ; corresponding normalized velocities (range: 0.0--1.0)
- (pedal-down #f) ; set to t for sustain pedal down...pedal-down-times not yet impl.
- (release-time-margin 0.75) ; extra compute time allowed beyond duration
- (amp .5) ; amp scale of noise inputs...
- (detuningFactor 1.0)
- (detuningFactor-table '())
- (stiffnessFactor 1.0)
- (stiffnessFactor-table '())
- (pedalPresenceFactor .3)
- (longitudinalMode 10.5)
- (StrikePositionInvFac -0.9)
- (singleStringDecayRateFactor 1.0)
-
- ;; parameter tables indexed by keyNum
- ;; you can override the loudPole-table by directly setting :loudPole to a value
-
- loudPole (loudPole-table default-loudPole-table)
- softPole (softPole-table default-softPole-table)
- loudGain (loudGain-table default-loudGain-table)
- softGain (softGain-table default-softGain-table)
- strikePosition (strikePosition-table default-strikePosition-table)
- detuning2 (detuning2-table default-detuning2-table)
- detuning3 (detuning3-table default-detuning3-table)
- stiffnessCoefficient (stiffnessCoefficient-table default-stiffnessCoefficient-table)
- singleStringDecayRate (singleStringDecayRate-table default-singleStringDecayRate-table)
- singleStringZero (singleStringZero-table default-singleStringZero-table)
- singleStringPole (singleStringPole-table default-singleStringPole-table)
- releaseLoopGain (releaseLoopGain-table default-releaseLoopGain-table)
- DryTapFiltCoeft60 (DryTapFiltCoeft60-table default-DryTapFiltCoeft60-table)
- DryTapFiltCoefTarget (DryTapFiltCoefTarget-table default-DryTapFiltCoefTarget-table)
- DryTapFiltCoefCurrent (DryTapFiltCoefCurrent-table default-DryTapFiltCoefCurrent-table)
- DryTapAmpt60 (DryTapAmpt60-table default-DryTapAmpt60-table)
- sustainPedalLevel (sustainPedalLevel-table default-sustainPedalLevel-table)
- pedalResonancePole (pedalResonancePole-table default-pedalResonancePole-table)
- pedalEnvelopet60 (pedalEnvelopet60-table default-pedalEnvelopet60-table)
- soundboardCutofft60 (soundboardCutofft60-table default-soundboardCutofft60-table)
- DryPedalResonanceFactor (DryPedalResonanceFactor-table default-DryPedalResonanceFactor-table)
- unaCordaGain (unaCordaGain-table default-unaCordaGain-table))
+
+<pre class="indented">
+<em class=emdef>p</em> (start
+ (duration 1.0)
+ (keyNum 60.0) ; middleC=60: can use fractional part to detune
+ (strike-velocity 0.5) ; corresponding normalized velocities (range: 0.0--1.0)
+ (pedal-down #f) ; set to t for sustain pedal down...pedal-down-times not yet impl.
+ (release-time-margin 0.75) ; extra compute time allowed beyond duration
+ (amp .5) ; amp scale of noise inputs...
+ (detuningFactor 1.0)
+ (detuningFactor-table ())
+ (stiffnessFactor 1.0)
+ (stiffnessFactor-table ())
+ (pedalPresenceFactor .3)
+ (longitudinalMode 10.5)
+ (StrikePositionInvFac -0.9)
+ (singleStringDecayRateFactor 1.0)
+
+ ;; parameter tables indexed by keyNum
+ ;; you can override the loudPole-table by directly setting :loudPole to a value
+
+ loudPole (loudPole-table default-loudPole-table)
+ softPole (softPole-table default-softPole-table)
+ loudGain (loudGain-table default-loudGain-table)
+ softGain (softGain-table default-softGain-table)
+ strikePosition (strikePosition-table default-strikePosition-table)
+ detuning2 (detuning2-table default-detuning2-table)
+ detuning3 (detuning3-table default-detuning3-table)
+ stiffnessCoefficient (stiffnessCoefficient-table default-stiffnessCoefficient-table)
+ singleStringDecayRate (singleStringDecayRate-table default-singleStringDecayRate-table)
+ singleStringZero (singleStringZero-table default-singleStringZero-table)
+ singleStringPole (singleStringPole-table default-singleStringPole-table)
+ releaseLoopGain (releaseLoopGain-table default-releaseLoopGain-table)
+ DryTapFiltCoeft60 (DryTapFiltCoeft60-table default-DryTapFiltCoeft60-table)
+ DryTapFiltCoefTarget (DryTapFiltCoefTarget-table default-DryTapFiltCoefTarget-table)
+ DryTapFiltCoefCurrent (DryTapFiltCoefCurrent-table default-DryTapFiltCoefCurrent-table)
+ DryTapAmpt60 (DryTapAmpt60-table default-DryTapAmpt60-table)
+ sustainPedalLevel (sustainPedalLevel-table default-sustainPedalLevel-table)
+ pedalResonancePole (pedalResonancePole-table default-pedalResonancePole-table)
+ pedalEnvelopet60 (pedalEnvelopet60-table default-pedalEnvelopet60-table)
+ soundboardCutofft60 (soundboardCutofft60-table default-soundboardCutofft60-table)
+ DryPedalResonanceFactor (DryPedalResonanceFactor-table default-DryPedalResonanceFactor-table)
+ unaCordaGain (unaCordaGain-table default-unaCordaGain-table))
</pre>
+
<p>Here is another example; there are a couple other examples at the end of piano.scm:
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (do ((i 0 (+ 1 i))) ((= i 8))
- (p (* i .5) :duration .5 :keyNum (+ 24 (* 12 i)) :strike-velocity .5 :amp .4 :DryPedalResonanceFactor .25
- :detuningFactor-table '(24 5 36 7.0 48 7.5 60 12.0 72 20 84 30 96 100 108 300)
- ; scales the above detuning values so 1.0 is nominal detuning,
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (do ((i 0 (+ i 1))) ((= i 8))
+ (p (* i .5) :duration .5 :keyNum (+ 24 (* 12 i)) :strike-velocity .5 :amp .4 :DryPedalResonanceFactor .25
+ :detuningFactor-table '(24 5 36 7.0 48 7.5 60 12.0 72 20 84 30 96 100 108 300)
+ ; scales the above detuning values so 1.0 is nominal detuning,
; 0.0 is exactly in tune, > 1.0 is out of tune
- :stiffnessFactor-table '(21 1.5 24 1.5 36 1.5 48 1.5 60 1.4 72 1.3 84 1.2 96 1.0 108 1.0))))
- ; 0.0 to 1.0 is less stiff, 1.0 to 2.0 is more stiff
+ :stiffnessFactor-table '(21 1.5 24 1.5 36 1.5 48 1.5 60 1.4 72 1.3 84 1.2 96 1.0 108 1.0))))
+ ; 0.0 to 1.0 is less stiff, 1.0 to 2.0 is more stiff
</pre>
+
<p>In Ruby:
</p>
-<pre>
- include Piano
- with_sound(:clm, false, :channels, 1) do
- 7.times do |i|
- p(i * 0.5,
- :duration, 0.5,
- :keyNum, 24 + 12.0 * i,
- :strike_velocity, 0.5,
- :amp, 0.4,
- :dryPedalResonanceFactor, 0.25)
- end
- end
-</pre>
-
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="#stereoflute" onmouseout="UnTip()" onmouseover="Tip('flute physical model')">flute</a> <a href="#maracadoc" onmouseout="UnTip()" onmouseover="Tip('maraca physical models')">maraca</a> <a href="#pluck" onmouseout="UnTip()" onmouseover="Tip('plucked string physical model')">pluck</a> <a href="#prc95doc" onmouseout="UnTip()" onmouseover="Tip('several physical models')">prc95</a> <a href="#singerdoc" onmouseout="UnTip()" onmouseover="Tip('singer physical model')">singer</a> <a href="#straddoc" onmouseout="UnTip()" onmouseover="Tip('violin physical model')">strad</a>
-</pre>
-</td></tr></table>
-<br>
+<pre class="indented">
+include Piano
+with_sound(:clm, false, :channels, 1) do
+ 7.times do |i|
+ p(i * 0.5,
+ :duration, 0.5,
+ :keyNum, 24 + 12.0 * i,
+ :strike_velocity, 0.5,
+ :amp, 0.4,
+ :dryPedalResonanceFactor, 0.25)
+ end
+end
+</pre>
-<br>
+<div class="seealso">
+see also: <a href="#stereoflute">flute</a> <a href="#maracadoc">maraca</a> <a href="#pluck">pluck</a> <a href="#prc95doc">prc95</a> <a href="#singerdoc">singer</a> <a href="#straddoc">strad</a>
+</div>
-<!-- ---------------------------------------- FILE: play ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="playdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>play</h2></td></tr></table>
-</td></tr></table>
-<p>This file has a variety of "real-time" audio output examples.
-</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
+<!-- FILE: play -->
+<div class="header" id="playdoc">play</div>
-<!-- loop-between-marks -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="loopbetweenmarks">loop-between-marks</a> <code>mark1 mark2 buffer-size</code>
-</td></tr><tr><td width=30></td><td>
-loop-between-marks loops continuously between the two specified marks.
-The marks can be moved as the sound is played; C-g stops loop-between-marks.
-<code>(loop-between-marks 0 1 512)</code>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- open-play-output -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="openplayoutput">open-play-output</a> <code>chans srate format buffer-size</code>
-</td></tr><tr><td></td><td>
-open-play-output opens an output audio port. It
-takes the desired number of channels, sampling rate, data format, and DAC buffer size (in samples),
-and returns a list containing the audio port (-1 on failure), the opened output channels,
-and the actual DAC buffer size (these can differ from the requested amounts in various hardware
-situations).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>This file has a variety of "real-time" audio output examples. It is almost entirely obsolete.
+</p>
<!-- play-with-amps -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>play-with-amps</em> <code>snd :rest amps</code>
-</td></tr><tr><td></td><td>
-play-with-amps plays the sound 'snd' with each channel scaled by the corresponding
-amp: <code>(play-with-amps 0 1.0 0.5)</code> plays sound 0's
+<pre class="indented">
+<em class=emdef>play-with-amps</em> snd :rest amps
+</pre>
+
+<p>play-with-amps plays the sound 'snd' with each channel scaled by the corresponding
+amp: (play-with-amps 0 1.0 0.5) plays sound 0's
channel 1 at full amplitude, and
channel 2 at half amplitude.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- play-often -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="playoften">play-often</a> <code>n</code><br>
-<A class=def NAME="playuntilcg">play-until-c-g</a> <br>
-<A class=def NAME="playregionforever">play-region-forever</a> <code>reg</code>
-</td></tr><tr><td></td><td>
-play-often plays the selected sound 'n' times.
+<pre class="indented">
+<em class=def id="playoften">play-often</em> n
+<em class=def id="playuntilcg">play-until-c-g</em>
+<em class=def id="playregionforever">play-region-forever</em> reg
+</pre>
+<p>play-often plays the selected sound 'n' times.
play-until-c-g plays the selected sound until you interrupt it via C-g.
Similarly, play-region-forever plays region 'reg' until you interrupt it with C-g.
+</p>
-<table border=0 cellpadding=5><tr><td><pre>
- (<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\p 0
- (lambda (n)
- "play often"
- (play-often (max 1 n))))
+<pre class="indented">
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> #\p 0
+ (lambda (n)
+ "play often"
+ (play-often (max 1 n))))
- (<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\r 0
- (lambda (n)
- "play region forever"
- (play-region-forever n)))
-</pre></td></tr></table>
-Now <code>C-u 31 p</code> plays the current sound 31 times; <code>C-u 3 r</code> plays region 3 until we type C-g.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> #\r 0
+ (lambda (n)
+ "play region forever"
+ (play-region-forever n)))
+</pre>
+
+<p>Now C-u 31 p plays the current sound 31 times; C-u 3 r plays region 3 until we type C-g.
+</p>
+<div class="spacer"></div>
<!-- play-sines -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="playsine">play-sine</a> <code>freq amp</code><br>
-<a class=def name="playsines">play-sines</a> <code>freqs-and-amps</code>
-</td></tr><tr><td></td><td>
-play-sine plays a one-second sine wave at the given frequency and amplitude: <code>(play-sine 440 .1)</code>.
-play-sines produces a spectrum given a list of lists of frequency and amplitude:
-<pre>
- (play-sines '((425 .05) (450 .01) (470 .01) (546 .02) (667 .01) (789 .034) (910 .032)))
+<pre class="indented">
+<em class=def id="playsine">play-sine</em> freq amp
+<em class=def id="playsines">play-sines</em> freqs-and-amps
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>play-sine plays a one-second sine wave at the given frequency and amplitude: (play-sine 440 .1).
+play-sines produces a spectrum given a list of lists of frequency and amplitude:
+</p>
-<!-- play-sound -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="playsound">play-sound</a> <code>func</code>
-</td></tr><tr><td></td><td>
-play-sound plays the current sound, calling <code>(func data)</code> on each buffer if 'func' is passed.
-The following doubles each sample in channel 0 during playback:
+<pre class="indented">
+(play-sines '((425 .05) (450 .01) (470 .01) (546 .02) (667 .01) (789 .034) (910 .032)))
+</pre>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(<em class=red>play-sound</em>
- (lambda (data)
- (let ((len (length data)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (<a class=quiet href="extsnd.html#sounddataset" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounddataset_tip)">sound-data-set!</a> data 0 i (* 2.0 (<a class=quiet href="extsnd.html#sounddataref" onmouseout="UnTip()" onmouseover="Tip(extsnd_sounddataref_tip)">sound-data-ref</a> data 0 i)))))))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- start-dac -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="startdac">start-dac</a> <br>
-<em class=emdef>stop-dac</em>
-</td></tr><tr><td></td><td>
-start-dac opens the DAC ready for sound output, and stop-dac closes it.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- vector-synthesis -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>vector-synthesis</em> <code>driver files read-even-when-not-playing</code>
-</td></tr><tr><td></td><td>
-vector-synthesis cycles through a collection of incoming audio streams, playing whatever
-happens to be on the chosen one, with fade-ins and fade-outs to avoid clicks.
-It uses 'driver', a
-function of two arguments (the number of files, and the number of samples between calls) to decide which file to play. If
-'read-even-when-not-playing' is #t (the default is #f), the input files are constantly
-read, even if not playing. 'files' is a list of files to be played.
-
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(vector-synthesis
- (let ((ctr 0) (file 0))
- (lambda (files bufsize)
- (if (> ctr 4)
- (begin
- (set! file (+ 1 file))
- (set! ctr 0)
- (if (>= file files)
- (set! file 0)))
- (set! ctr (+ 1 ctr)))
- file))
- (list "oboe.snd" "pistol.snd") #t)
-</pre></td></tr></table>
-The vector-synthesis
-idea (and the weird name) came from a linux-audio-development mailing list.
-Apparently some commercial synths (or software?) provide this.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-</table>
-
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="extsnd.html#playexamples">Playing</a> <a href="extsnd.html#extsndlib">Sndlib</a>
+<pre class="indented">
+<em class=def id="startdac">start-dac</em>
+<em class=emdef>stop-dac</em>
</pre>
-</td></tr></table>
-<br>
-<br>
+<p>start-dac opens the DAC ready for sound output, and stop-dac closes it.
+</p>
+<div class="spacer"></div>
-<!-- ---------------------------------------- FILE: poly ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="polydoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>poly</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: poly -->
+
+<div class="header" id="polydoc">poly</div>
<p>This file contains various functions related to the CLM polynomial function. A polynomial here
-is a vct or a vector (for complex coefficients) holding the polynomial coefficients from lowest
-to highest (i.e. the constant is vct[0], x+2 is (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 2 1), etc).
+is a vector (for complex coefficients) holding the polynomial coefficients from lowest
+to highest (i.e. the constant is (v 0), x+2 is (float-vector 2 1), etc).
</p>
<!-- main-index |polydoc:polynomial operations -->
-<table border=0 hspace=20>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly+</em> <code>p1 p2</code></td><td>; new poly = p1 + p2</td></tr>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly*</em> <code>p1 p2</code></td><td>; new poly = p1 * p2</td></tr>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly/</em> <code>p1 p2</code></td><td>; (list quotient-poly remainder-poly) = p1 / p2</td></tr>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly-derivative</em> <code>p1</code></td><td>; new poly = Dp1</td></tr>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly-reduce</em> <code>p1</code></td><td>; new poly = p1 without high zeros</td></tr>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly-gcd</em> <code>p1 p2</code></td><td>; new poly = gcd(p1, p2)</td></tr>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly-roots</em> <code>p1</code></td><td>; list of roots of p1</td></tr>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly-resultant</em> <code>p1 p2</code></td><td>; resultant of p1 and p2</td></tr>
-<tr><td bgcolor="#f2f3ff"><em class=emdef>poly-discriminant</em> <code>p1</code></td><td>; discriminant of p1</td></tr>
-</table>
+<pre class="indented">
+<em class=emdef>poly+</em> p1 p2 ; new poly = p1 + p2
+<em class=emdef>poly*</em> p1 p2 ; new poly = p1 * p2
+<em class=emdef>poly/</em> p1 p2 ; (list quotient-poly remainder-poly) = p1 / p2
+<em class=emdef>poly-derivative</em> p1 ; new poly = Dp1
+<em class=emdef>poly-reduce</em> p1 ; new poly = p1 without high zeros
+<em class=emdef>poly-gcd</em> p1 p2 ; new poly = gcd(p1, p2)
+<em class=emdef>poly-roots</em> p1 ; list of roots of p1
+<em class=emdef>poly-resultant</em> p1 p2 ; resultant of p1 and p2
+<em class=emdef>poly-discriminant</em> p1 ; discriminant of p1
+</pre>
<p>
poly+ adds two polynomials, and poly* multiplies two polynomials.
@@ -8720,23 +9330,22 @@ just for fun.
<p>You can treat a sound as a set of polynomial coefficients; then, for example,
convolution the infinitely slow way is poly*:
</p>
-<pre>
- (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> (poly* (<a class=quiet href="extsnd.html#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> 0 (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>)) (<a class=quiet href="extsnd.html#vct" onmouseout="UnTip()" onmouseover="Tip(extsnd_vct_tip)">vct</a> 2.0))) ; no, this is not serious
+
+<pre class="indented">
+(float-vector->channel (poly* (channel->float-vector 0 (<a class=quiet href="extsnd.html#framples">framples</a>)) (float-vector 2.0))) ; no, this is not serious
</pre>
-<table bgcolor="aliceblue" border=0><tr><td>
-<pre>see also: <a href="sndclm.html#polynomial">polynomial</a> <a href="#mixerdoc" onmouseout="UnTip()" onmouseover="Tip('linear algebra stuff')">mixer</a> <a href="extsnd.html#Vcts" onmouseout="UnTip()" onmouseover="Tip('array processing')">vcts</a>
-</pre></td>
-</tr></table>
-<br><br>
+<div class="seealso">
+see also: <a href="sndclm.html#polynomial">polynomial</a>
+</div>
-<!-- ---------------------------------------- FILE: prc95 ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="prc95doc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>prc95</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: prc95 -->
+
+<div class="header" id="prc95doc">prc95</div>
<!-- INDEX prc95doc:Physical Models -->
<p>prc95.scm is a translation to Snd of Perry Cook's (1995) physical modelling toolkit; prc-toolkit95.lisp
@@ -8746,49 +9355,39 @@ any of several classic papers also by Julius Smith. Perry's own version of this
found in <A HREF="http://ccrma.stanford.edu/CCRMA/Software/STK/">STK</A>.
The example instruments are:
</p>
-<table border=0 hspace=20>
-<tr><td>
-<pre>
- <em class=emdef>plucky</em> beg dur freq amplitude maxa ; plucked string
- <em class=emdef>bow</em> beg dur frq amplitude maxa ; bowed string
- <em class=emdef>brass</em> beg dur freq amplitude maxa
- <em class=emdef>clarinet</em> beg dur freq amplitude maxa
- <em class=emdef>flute</em> beg dur freq amplitude maxa
-
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (plucky 0 .3 440 .2 1.0)
- (bow .5 .3 220 .2 1.0)
- (brass 1 .3 440 .2 1.0)
- (clarinet 1.5 .3 440 .2 1.0)
- (flute 2 .3 440 .2 1.0))
+
+<pre class="indented">
+<em class=emdef>plucky</em> beg dur freq amplitude maxa ; plucked string
+<em class=emdef>bow</em> beg dur frq amplitude maxa ; bowed string
+<em class=emdef>brass</em> beg dur freq amplitude maxa
+<em class=emdef>clarinet</em> beg dur freq amplitude maxa
+<em class=emdef>flute</em> beg dur freq amplitude maxa
+
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (plucky 0 .3 440 .2 1.0)
+ (bow .5 .3 220 .2 1.0)
+ (brass 1 .3 440 .2 1.0)
+ (clarinet 1.5 .3 440 .2 1.0)
+ (flute 2 .3 440 .2 1.0))
</pre>
-</td>
-<td>
-<table border=3 bordercolor="tan" hspace=40><tr><td>
-<blockquote><small>
-<br>
-See also:<br>
-maraca: <a href="#maracadoc">maraca.scm, maraca.rb</a><br>
-piano: <a href="#pianodoc">piano.scm, piano.rb</a><br>
-singer: <a href="#singerdoc">singer.scm, singer.rb</a><br>
-bowed string: <a href="#straddoc">strad.scm, strad.rb</a><br>
-flute: <a href="#clminsdoc">clm-ins.scm</a><br>
-string: <a href="#computeuniformcircularstring">compute-string</a><br>
-plucked string: pluck in clm-ins.scm<br>
-<br>
-</small></blockquote>
-</td></tr></table>
-</td></tr></table>
-<br>
-<br>
+<div class="seealso">
+see also:
+maraca: <a href="#maracadoc">maraca.scm, maraca.rb</a>
+piano: <a href="#pianodoc">piano.scm, piano.rb</a>
+singer: <a href="#singerdoc">singer.scm, singer.rb</a>
+bowed string: <a href="#straddoc">strad.scm, strad.rb</a>
+flute: <a href="#clminsdoc">clm-ins.scm</a>
+string: <a href="#computeuniformcircularstring">compute-string</a>
+plucked string: pluck in clm-ins.scm
+</div>
-<!-- ---------------------------------------- FILE: pvoc ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="pvocdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>pvoc</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: pvoc -->
+
+<div class="header" id="pvocdoc">pvoc</div>
<p>
This is the same as the CLM <a href="sndclm.html#phase-vocoder">phase-vocoder</a> generator, but implemented in Scheme. If you're interested
@@ -8796,45 +9395,48 @@ in how the thing works, I think the Scheme version is easiest to understand; the
is in mus.lisp, and the C version is in clm.c.
</p>
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>make-pvocoder</em> <code>fftsize overlap interp analyze edit synthesize</code><br>
-<em class=emdef>pvocoder</em> <code>gen input</code><br>
-<em class=emdef>pvoc</em> <code>(fftsize 512) (overlap 4) (time 1.0) (pitch 1.0) (gate 0.0) (hoffset 0.0) (snd 0) (chn 0)</code><br>
-</td></tr></table>
+<pre class="indented">
+<em class=emdef>make-pvocoder</em> fftsize overlap interp analyze edit synthesize
+<em class=emdef>pvocoder</em> gen input
+<em class=emdef>pvoc</em> (fftsize 512) (overlap 4) (time 1.0) (pitch 1.0) (gate 0.0) (hoffset 0.0) (snd 0) (chn 0)
+</pre>
<p>The 'analyze', 'edit', and 'synthesize' arguments to make-pvocoder are
functions that are applied as needed during pvocoder processing; similarly, the 'input'
argument to pvocoder can be a function.
</p>
-<pre>
- (let* ((ind (<a class=quiet href="extsnd.html#opensound" onmouseout="UnTip()" onmouseover="Tip(extsnd_opensound_tip)">open-sound</a> "oboe.snd"))
- (pv (<em class=red>make-pvocoder</em> 256 4 64))
- (rd (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (y) (<em class=red>pvocoder</em> pv rd))))
+
+<pre class="indented">
+(let ((ind (<a class=quiet href="extsnd.html#opensound">open-sound</a> "oboe.snd"))
+ (pv (<em class=red>make-pvocoder</em> 256 4 64))
+ (rd (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (y) (<em class=red>pvocoder</em> pv rd))))
</pre>
+
<p>
pvoc.scm also contains a few examples of using the CLM phase-vocoder generator:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+
+<pre class="indented">
(define test-pv-4
(lambda (gate)
- (let ((pv (<a class=quiet href="sndclm.html#make-phase-vocoder" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_phase_vocoder_tip)">make-phase-vocoder</a> #f
+ (let* ((reader (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0))
+ (pv (<a class=quiet href="sndclm.html#make-phase-vocoder">make-phase-vocoder</a>
+ (lambda (dir) (reader))
512 4 128 1.0
#f ;no change to analysis
(lambda (v)
(let ((N (length v)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i N))
- (if (< (<a class=quiet href="extsnd.html#vctref" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctref_tip)">vct-ref</a> (phase-vocoder-amp-increments v) i) gate)
- (<a class=quiet href="extsnd.html#vctset" onmouseout="UnTip()" onmouseover="Tip(extsnd_vctset_tip)">vct-set!</a> (phase-vocoder-amp-increments v) i 0.0)))
+ (if (< ((phase-vocoder-amp-increments v) i) gate)
+ (set! ((phase-vocoder-amp-increments v) i) 0.0)))
#t))
- #f ;no change to synthesis))
- (reader (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (val)
- (<a class=quiet href="sndclm.html#phase-vocoder" onmouseout="UnTip()" onmouseover="Tip(sndclm_phase_vocoder_tip)">phase-vocoder</a> pv (lambda (dir)
- (reader)))))
- (<a class=quiet href="extsnd.html#freesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_freesampler_tip)">free-sampler</a> reader))))
-</pre></td></tr></table>
+ #f))) ;no change to synthesis
+
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (val)
+ (<a class=quiet href="sndclm.html#phase-vocoder">phase-vocoder</a> pv))))))
+</pre>
<p>This sets up a phase-vocoder generator whose edit function is squelching soft partials.
In this case, the input function is reading the currently selected channel.
@@ -8847,36 +9449,37 @@ to the current sound; 'pitch' specifies the pitch transposition ratio,
'gate' specifies a resynthesis gate in dB (partials with amplitudes lower than
the gate value will not be synthesized), 'hoffset' is a pitch offset in Hz.
</p>
-<pre>
- (pvoc :time 2.0)
-</pre>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="sndclm.html#phase-vocoder" onmouseout="UnTip()" onmouseover="Tip('CLM phase-vocoder generator')">phase-vocoder</a> <a href="#pins" onmouseout="UnTip()" onmouseover="Tip('SMS instrument, an extension of the phase-vocoder')">pins</a>
+<pre class="indented">
+(pvoc :time 2.0)
</pre>
-</td></tr></table>
-<br>
-<br>
+
+<div class="seealso">
+see also: <a href="sndclm.html#phase-vocoder">phase-vocoder</a> <a href="#pins">pins</a>
+</div>
-<!-- ---------------------------------------- FILE: rgb ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="rgbdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>rgb</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: rgb -->
+
+<div class="header" id="rgbdoc">rgb</div>
<p>rgb.scm (rgb.rb) is a translation of the standard X11 color names into Snd
color objects.
</p>
-<pre>
- (define snow (<a class=quiet href="extsnd.html#makecolor" onmouseout="UnTip()" onmouseover="Tip(extsnd_makecolor_tip)">make-color</a> 1.00 0.98 0.98))
+
+<pre class="indented">
+(define snow (<a class=quiet href="extsnd.html#makecolor">make-color</a> 1.00 0.98 0.98))
</pre>
+
<p>is taken from the line</p>
-<pre>
- 255 250 250 snow
+
+<pre class="indented">
+255 250 250 snow
</pre>
+
<p>/usr/lib/X11/rgb.txt. The choice of a float between 0.0 and 1.0 (rather
than an integer between 0 and 255) mimics PostScript;
as video hardware has improved over the years, there's
@@ -8886,65 +9489,16 @@ There is one gotcha in this file — X11 defines a color named "tan"
which is already used by Scheme, so (at the suggestion of Dave Phillips)
this color is named "tawny" in rgb.scm.
</p>
-<br>
-<!-- ---------------------------------------- FILE: rtio ---------------------------------------- -->
+<!-- FILE: rubber -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="rtiodoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>rtio</h2></td></tr></table>
-</td></tr></table>
-
-<p>rtio.scm has a collection of functions oriented loosely around
-"real-time" operations.
-</p>
-
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>show-input</em> <code>(in-sys 0)</code><br>
-<A class=def NAME="showinputfft">show-input-fft</a> <code>(in-sys 0)</code><br>
-<A class=def NAME="showdraggableinputfft">show-draggable-input-fft</a> <code>(in-sys 0)</code><br>
-<em class=emdef>in-out</em> <code>func in-sys out-sys</code><br>
-</td></tr></table>
-
-<p>These functions show how to read incoming data (from the adc),
-write data (to the dac), and interpose a function while reading and
-writing data. There are several example functions (for the 'func' argument) that filter the data or
-change its amplitude. show-input-fft displays the input data's
-spectrum. show-draggable-input-fft is the same, but the X axis
-(the frequency axis in this case) is draggable, as in Snd's FFT display.
-See <a href="#oscopedoc">oscope</a> for a fancier version of the fft stuff.
-</p>
-<p>Here's some info from Michael Scholz about the Ruby version of rtio:
-</p>
+<div class="header" id="rubberdoc">rubber</div>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-rt = make_rtio
-rt.show_input
-rt.show_input_fft
-rt.chans = 2
-rt.show_drag
-rt.amplify(1.5).in_out(1, 0)
-rt.lp.in_out
-rt.hp(1150).in_out
-rt.close
+<pre class="indented">
+<em class=def id="rubbersound">rubber-sound</em> stretch-factor snd chn
</pre>
-</td></tr></table>
-
-
-<br>
-<br>
-
-
-<!-- ---------------------------------------- FILE: rubber ---------------------------------------- -->
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="rubberdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>rubber</h2></td></tr></table>
-</td></tr></table>
-
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<a class=def name="rubbersound">rubber-sound</a> <code>stretch-factor snd chn</code><br>
-</td></tr></table>
<p>
rubber-sound tries to stretch or contract a sound (in time); it scans the sound
@@ -8963,124 +9517,106 @@ rubber-sound is incredibly slow, and almost never works. The idea seems good ho
<!-- ((((((( --><!-- this matches the preceding open parens for make-index.scm's benefit -->
</p>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="#clmexpsrc" onmouseout="UnTip()" onmouseover="Tip('clm-ins version of expsrc')">clm-expsrc</a> <a href="#expsrc" onmouseout="UnTip()" onmouseover="Tip('granular synthesis to stretch sound')">expsrc</a> <a href="#pvocdoc" onmouseout="UnTip()" onmouseover="Tip('phase-vocoder')">pvoc</a> <a href="#ssbbank" onmouseout="UnTip()" onmouseover="Tip('use ssb-am for time stretch')">ssb-bank</a>
-</pre>
-</td></tr></table>
+<div class="seealso">
+see also: <a href="#clmexpsrc">clm-expsrc</a> <a href="#expsrc">expsrc</a> <a href="#pvocdoc">pvoc</a> <a href="#ssbbank">ssb-bank</a>
+</div>
-<br>
-<!-- ---------------------------------------- FILE: selection ---------------------------------------- -->
+<!-- FILE: s7test -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="selectiondoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>selection</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="s7testdoc">s7test</div>
-<p>selection.scm has functions related to selections.
+<p>s7test.scm is a regression test for s7. Any additional tests are most welcome!
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20 vspace=10>
-
-
-<!-- eval-over-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="evaloverselection">eval-over-selection</a> <code>func snd</code>
-</td></tr><tr><td></td><td>
-eval-over-selection evaluates 'func' on each sample in the current selection. A better
-name might be map-selection.
-The code:
-
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> #\x 4
- (lambda () "eval over selection"
- (if (<a class=quiet href="extsnd.html#selectionok" onmouseout="UnTip()" onmouseover="Tip(extsnd_selectionok_tip)">selection?</a>)
- (<a class=quiet href="extsnd.html#promptinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_promptinminibuffer_tip)">prompt-in-minibuffer</a> "selection eval:" <em class=red>eval-over-selection</em>)
- (<a class=quiet href="extsnd.html#reportinminibuffer" onmouseout="UnTip()" onmouseover="Tip(extsnd_reportinminibuffer_tip)">report-in-minibuffer</a> "no selection")))
- #t)
-</pre></td></tr></table>
+<!-- FILE: selection -->
-binds the key sequence C-x x to a function that checks for an active selection,
-then prompts (in the minibuffer) for the function to apply, and when
-you eventually reply with a function, applies that function
-to each sample in the selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="header" id="selectiondoc">selection</div>
<!-- filter-selection-and-smooth -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="filterselectionandsmooth">filter-selection-and-smooth</a> <code>ramp-dur flt order</code>
-</td></tr><tr><td></td><td>
-filter-selection-and-smooth filters the current selection with flt, then mixes it back into the original using
+<pre class="indented">
+<em class=def id="filterselectionandsmooth">filter-selection-and-smooth</em> ramp-dur flt order
+</pre>
+
+<p>filter-selection-and-smooth filters the current selection with flt, then mixes it back into the original using
ramp-dur to set how long the cross-fade ramps are.
-<pre>
- (filter-selection-and-smooth .01 (vct .25 .5 .5 .5 .25))
+</p>
+
+<pre class="indented">
+(filter-selection-and-smooth .01 (float-vector .25 .5 .5 .5 .25))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- make-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makeselection">make-selection</a> <code>beg end snd chn</code>
-</td></tr><tr><td></td><td>
-make-selection makes a selection, like <a href="extsnd.html#makeregion">make-region</a> but without creating
+<pre class="indented">
+<em class=def id="makeselection">make-selection</em> beg end snd chn
+</pre>
+
+<p>make-selection makes a selection, like <a href="extsnd.html#makeregion">make-region</a> but without creating
a region. make-selection follows snd's sync field, and applies to all snd's channels if chn is not specified. end defaults
to end of channel, beg defaults to 0, and snd defaults to the currently selected sound.
-<pre>
- (make-selection 1000 2000)
+</p>
+
+<pre class="indented">
+(make-selection 1000 2000)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- replace-with-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="replacewithselection">replace-with-selection</a>
-</td></tr><tr><td width=30></td><td>
-replace-with-selection replaces any data at the cursor with the
+<pre class="indented">
+<em class=def id="replacewithselection">replace-with-selection</em>
+</pre>
+
+<p>replace-with-selection replaces any data at the cursor with the
current selection.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- selection-members -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="selectionmembers">selection-members</a>
-</td></tr><tr><td></td><td>
-selection-members returns a list of lists of <code>'(snd chn)</code> indicating the channels participating in the current selection.
+<pre class="indented">
+<em class=def id="selectionmembers">selection-members</em>
+</pre>
+
+<p>selection-members returns a list of lists of '(snd chn) indicating the channels participating in the current selection.
It is the selection-oriented version of <a href="#allchans">all-chans</a>.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- swap-selection-channels -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="swapselectionchannels">swap-selection-channels</a>
-</td></tr><tr><td></td><td>
-swap-selection-channels swaps the current selection's channels.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-<tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="swapselectionchannels">swap-selection-channels</em>
+</pre>
+
+<p>swap-selection-channels swaps the current selection's channels.
+</p>
+<div class="spacer"></div>
+
<!-- with-temporary-selection -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="withtemporaryselection">with-temporary-selection</a> <code>thunk beg dur snd chn</code>
-</td></tr><tr><td></td><td>
-with-temporary selection saves the current selection placement, makes a new selection
+<pre class="indented">
+<em class=def id="withtemporaryselection">with-temporary-selection</em> thunk beg dur snd chn
+</pre>
+
+<p>with-temporary selection saves the current selection placement, makes a new selection
of the data from sample 'beg' to beg + dur in the given channel, calls 'thunk', then
restores the previous selection (if any). It returns whatever 'thunk' returned.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
+</p>
-</table>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: singer ---------------------------------------- -->
+<!-- FILE: singer -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="singerdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>singer</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="singerdoc">singer</div>
<!-- main-index |singerdoc:singer -->
<!-- main-index |singerdoc:voice physical model -->
@@ -9088,7 +9624,8 @@ restores the previous selection (if any). It returns whatever 'thunk' returned.
<p>singer.scm is an implementation of Perry Cook's
physical model of the vocal tract as described in:
</p>
-<pre>
+
+<pre class="indented">
Cook, Perry R. "Synthesis of the Singing Voice Using a Physically Parameterized Model of the Human Vocal Tract"
Published in the Proceedings of the International Computer Music Conference, Ohio 1989
and as Stanford University Department of Music Technical Report Stan-M-57, August 1989.
@@ -9100,6 +9637,7 @@ physical model of the vocal tract as described in:
---- "SPASM, a Real-time Vocal Tract Physical Model Controller; and Singer, the Companion Software
Synthesis System", Computer Music Journal, vol 17 no 1 Spring 1993.
</pre>
+
<p>
singer.scm is a translation of Perry's singer.c.
I think that Perry's code assumes a sampling rate of 22050; you'll need to fix up lots of
@@ -9107,138 +9645,133 @@ lengths in the code to run at 44100.
The singer instrument looks deceptively simple:
</p>
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>singer</em> <code>beg amp data</code>
-</td></tr></table>
+<pre class="indented">
+<em class=emdef>singer</em> beg amp data
+</pre>
<p>
but all the complexity is hidden in the 'data' parameter.
-'data' is a list of lists; each imbedded list has the form: <code>'(dur shape glot pitch glotamp noiseamps vibramt)</code>.
+'data' is a list of lists; each imbedded list has the form: '(dur shape glot pitch glotamp noiseamps vibramt).
The 'shape' and 'glot' entries are themselves lists; I think the 'glot'
list describes the glottal pulse. I wish I could fully explain all these lists, but
I translated this code a very long time ago, and can't remember any details. You'll
have to read the code, or perhaps find something in Perry's publications.
In any case, here's an example:
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (singer 0 .1 (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01)
- (list .6 oo.shp test.glt 523.0 .7 .1 .01))))
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (singer 0 .1 (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01)
+ (list .6 oo.shp test.glt 523.0 .7 .1 .01))))
</pre>
+
<p>
The *.shp and *.glt data is defined at the end of singer.scm. For example:
</p>
-<pre>
- (define test.glt (list 10 .65 .65))
- (define ee.shp (list 8 1.02 1.637 1.67 1.558 0.952 0.501 0.681 0.675 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
+
+<pre class="indented">
+(define test.glt (list 10 .65 .65))
+(define ee.shp (list 8 1.02 1.637 1.67 1.558 0.952 0.501 0.681 0.675 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
</pre>
+
<p>
A more complex example is singer's attempt to say "requiem":
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
- (singer 0 .1 (list (list .05 ehh.shp test.glt 523.0 0.8 0.0 .01)
- (list .15 ehh.shp test.glt 523.0 0.8 0.0 .01)
- (list .05 kkk.shp test.glt 523.0 0.0 0.0 .01)
- (list .05 kkk.shp test.glt 523.0 0.0 0.0 .01)
- (list .02 kk+.shp test.glt 523.0 0.0 1.0 .01)
- (list .08 kk+.shp test.glt 523.0 0.0 0.2 .01)
- (list .05 ooo.shp test.glt 523.0 0.8 0.0 .01)
- (list .15 ooo.shp test.glt 523.0 0.8 0.0 .01)
- (list .05 eee.shp test.glt 523.0 0.8 0.0 .01)
- (list .15 eee.shp test.glt 523.0 0.8 0.0 .01)
- (list .05 ehh.shp test.glt 523.0 0.8 0.0 .01)
- (list .15 ehh.shp test.glt 523.0 0.8 0.0 .01)
- (list .05 mmm.shp test.glt 523.0 0.8 0.0 .01)
- (list .15 mmm.shp test.glt 523.0 0.8 0.0 .01)
- (list .10 mmm.shp test.glt 523.0 0.0 0.0 .01))))
-</pre>
-
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="#fofins" onmouseout="UnTip()" onmouseover="Tip('FOF synthesis')">fofins</a> <a href="#reson" onmouseout="UnTip()" onmouseover="Tip('FM voice via formants')">reson</a> <a href="#pqwvox" onmouseout="UnTip()" onmouseover="Tip('waveshaping voice')">pqw-vox</a> <a href="#fmvox" onmouseout="UnTip()" onmouseover="Tip('FM voice with movable formants')">vox</a>
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
+ (singer 0 .1 (list (list .05 ehh.shp test.glt 523.0 0.8 0.0 .01)
+ (list .15 ehh.shp test.glt 523.0 0.8 0.0 .01)
+ (list .05 kkk.shp test.glt 523.0 0.0 0.0 .01)
+ (list .05 kkk.shp test.glt 523.0 0.0 0.0 .01)
+ (list .02 kk+.shp test.glt 523.0 0.0 1.0 .01)
+ (list .08 kk+.shp test.glt 523.0 0.0 0.2 .01)
+ (list .05 ooo.shp test.glt 523.0 0.8 0.0 .01)
+ (list .15 ooo.shp test.glt 523.0 0.8 0.0 .01)
+ (list .05 eee.shp test.glt 523.0 0.8 0.0 .01)
+ (list .15 eee.shp test.glt 523.0 0.8 0.0 .01)
+ (list .05 ehh.shp test.glt 523.0 0.8 0.0 .01)
+ (list .15 ehh.shp test.glt 523.0 0.8 0.0 .01)
+ (list .05 mmm.shp test.glt 523.0 0.8 0.0 .01)
+ (list .15 mmm.shp test.glt 523.0 0.8 0.0 .01)
+ (list .10 mmm.shp test.glt 523.0 0.0 0.0 .01))))
</pre>
-</td></tr></table>
-<br>
-<br>
+<div class="seealso">
+see also: <a href="#fofins">fofins</a> <a href="#reson">reson</a> <a href="#pqwvox">pqw-vox</a> <a href="#fmvox">vox</a>
+</div>
-<!-- ---------------------------------------- FILE: snd9|10|11 ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="sndolddoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>snd9|10|11</h2></td></tr></table>
-</td></tr></table>
+
+
+<!-- FILE: snd13|14|15 -->
+
+<div class="header" id="sndolddoc">snd13|14|15</div>
<p>These files contain several procedures
that were removed from or renamed in earlier versions of Snd (in Ruby, look in extensions.rb).
-snd10.scm, for example, has the old sine-summation, make-sum-of-cosines, and make-sum-of-sines generators.
+snd13.scm, for example, has the old sine-summation, make-sum-of-cosines, and make-sum-of-sines generators.
</p>
-<br><br>
-<!-- ---------------------------------------- FILE: snd-gl ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="snddiffdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>snddiff</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: snddiff -->
+
+<div class="header" id="snddiffdoc">snddiff</div>
<p>The snddiff function tries to detect how one sound differs from another.
</p>
-<table border=0 cellspacing=0 hspace=20>
<!-- snddiff -->
-<tr><td colspan=2 bgcolor="#f2f4ff"><a class=def>snddiff</a> <code>snd0 chn0 snd1 chn1</code>
-</td></tr><tr><td width=30></td><td>
-This could use about a lifetime's work, but it does find some differences:
-<pre>
- ;; start with two identical sounds:
- <em class=listener>:</em><em class=typing>(map short-file-name (sounds))</em>
- <em class=listener>("oboe.snd" "oboe.snd")</em>
- <em class=listener>:</em><em class=typing>(snddiff 0 0 1 0)</em>
- <em class=listener>no-difference</em>
- ;; snddiff can find individual sample differences:
- <em class=listener>:</em><em class=typing>(set! (sample 1000 0 0) 0.5)</em>
- <em class=listener>0.5</em>
- <em class=listener>:</em><em class=typing>(snddiff 0 0 1 0)</em>
- <em class=listener>(differences ((1000 0.5 0.0328369140625)))</em>
- ;; and scaling changes (we reverted the previous change):
- <em class=listener>:</em><em class=typing>(scale-channel 2.0)</em>
- <em class=listener>2.0</em>
- <em class=listener>:</em><em class=typing>(snddiff 0 0 1 0)</em>
- <em class=listener>(scale 2.0)</em>
- ;; and some initial delays:
- <em class=listener>:</em><em class=typing>(pad-channel 0 200 0 0)</em>
- <em class=listener>0</em>
- <em class=listener>:</em><em class=typing>(snddiff 0 0 1 0)</em>
- <em class=listener>(lag 200 no-difference 0.0 #f #f #f)</em>
-</pre>
-
-</td></tr><tr><td colspan=2 height=16></td></tr>
-</table>
+<pre class="indented"><a class=def>snddiff</a> snd0 chn0 snd1 chn1
+</pre>
-<br><br>
+<p>This could use about a lifetime's work, but it does find some differences:
+</p>
+
+<pre class="indented">
+ ;; start with two identical sounds:
+> (map short-file-name (sounds))
+("oboe.snd" "oboe.snd")
+> (snddiff 0 0 1 0)
+no-difference
+ ;; snddiff can find individual sample differences:
+> (set! (sample 1000 0 0) 0.5)
+0.5
+> (snddiff 0 0 1 0)
+(differences ((1000 0.5 0.0328369140625)))
+ ;; and scaling changes (we reverted the previous change):
+> (scale-channel 2.0)
+2.0
+> (snddiff 0 0 1 0)
+(scale 2.0)
+ ;; and some initial delays:
+> (pad-channel 0 200 0 0)
+0
+> (snddiff 0 0 1 0)
+(lag 200 no-difference 0.0 #f #f #f)
+</pre>
-<!-- ---------------------------------------- FILE: snd-gl ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="sndgldoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>snd-gl</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: snd-gl -->
+
+<div class="header" id="sndgldoc">snd-gl</div>
<p>snd-gl.scm has examples of using <A HREF="http://www.mesa3d.org/">OpenGL</A>. To try out these functions, build Snd
-with GL: <code>configure --with-gl</code>. You can tell if your current Snd has OpenGL loaded by checking the
-*features* list for 'gl: <code>(provided? 'gl)</code>.
+with GL: configure --with-gl. You can tell if your current Snd has OpenGL loaded by checking the
+*features* list for 'gl: (provided? 'gl).
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
-
<!-- complexify -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="complexify">complexify</a>
-</td></tr><tr><td width=30></td><td>
-complexify displays FFT data in the complex plane; each bin is
+<pre class="indented">
+<em class=def id="complexify">complexify</em>
+</pre>
+
+<p>complexify displays FFT data in the complex plane; each bin is
rotated so that they all stack along the x axis, with
a line drawn from the x axis to the current real/imaginary
point (as (z, y)), so as you move (slowly) through a
@@ -9247,296 +9780,251 @@ the vectors whirl around in each slice of the complex
plane. Use the View:Orientation dialog to change the
viewing angle. To move one sample at a time through a sound,
you could bind the arrow keys:
+</p>
+
+<pre class="indented">
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> "Left" 0 (lambda ()
+ (set! (<a class=quiet href="extsnd.html#leftsample">left-sample</a>) (max 0 (- (<a class=quiet href="extsnd.html#leftsample">left-sample</a>) 1)))
+ <a class=quiet>keyboard-no-action</a>))
+(<a class=quiet href="extsnd.html#bindkey">bind-key</a> "Right" 0 (lambda ()
+ (set! (<a class=quiet href="extsnd.html#leftsample">left-sample</a>) (min (<a class=quiet href="extsnd.html#framples">framples</a>) (+ 1 (<a class=quiet href="extsnd.html#leftsample">left-sample</a>))))
+ <a class=quiet>keyboard-no-action</a>))
+</pre>
-<table border=0 cellpadding=5 hspace=20 vspace=10><tr><td><pre>
-(<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> "Left" 0 (lambda ()
- (set! (<a class=quiet href="extsnd.html#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) (max 0 (- (<a class=quiet href="extsnd.html#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) 1)))
- <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_keyboard_no_action_tip)">keyboard-no-action</a>))
-(<a class=quiet href="extsnd.html#bindkey" onmouseout="UnTip()" onmouseover="Tip(extsnd_bindkey_tip)">bind-key</a> "Right" 0 (lambda ()
- (set! (<a class=quiet href="extsnd.html#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>) (min (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>) (+ 1 (<a class=quiet href="extsnd.html#leftsample" onmouseout="UnTip()" onmouseover="Tip(extsnd_leftsample_tip)">left-sample</a>))))
- <a class=quiet onmouseout="UnTip()" onmouseover="Tip(extsnd_keyboard_no_action_tip)">keyboard-no-action</a>))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- gl-dump-state -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>gl-dump-state</em>
-</td></tr><tr><td></td><td>
-gl-dump-state displays much of the current GL graphics state.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+
+<p>gl-dump-state displays much of the current GL graphics state.
+</p>
+<div class="spacer"></div>
<!-- gl-info -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>gl-info</em>
-</td></tr><tr><td></td><td>
-gl-info prints out information about the current GL system setup.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- start-waterfall -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="startwaterfall">start-waterfall</a> <code>(scl 1.0) (pc-spectrum 0.2) (fft-size 512)</code>
-</td></tr><tr><td></td><td>
-start-waterfall starts a
-waterfall spectrum display of the incoming audio data.
-'pc-spectrum' determines how much of the spectrum is displayed (very often the high portions are not interesting; we'd
-rather zoom in on the stuff we can hear).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+<p>gl-info prints out information about the current GL system setup.
+</p>
+<div class="spacer"></div>
-<!-- stop-waterfall -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>stop-waterfall</em>
-</td></tr><tr><td></td><td>
-stop-waterfall turns off the waterfall spectrum display.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-</table>
+<div class="seealso">
+see also: <a href="extsnd.html#glspectrogram">glSpectrogram</a> <a href="grfsnd.html#sndandgl">OpenGL</a>
+</div>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="extsnd.html#glspectrogram">glSpectrogram</a> <a href="grfsnd.html#sndandgl" onmouseout="UnTip()" onmouseover="Tip('OpenGL (Mesa) extensions via gl.c')">OpenGL</a>
-</pre>
-</td></tr></table>
-<br>
-<br>
<!-- INDEX variabledisplay:Debugging (instruments) -->
<!-- main-index |sndmotifdoc:user interface extensions -->
-<!-- ---------------------------------------- FILE: snd-motif, snd-xm ---------------------------------------- -->
+<!-- FILE: snd-motif, snd-xm -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="sndmotifdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>snd-motif, snd-xm</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="sndmotifdoc">snd-motif, snd-xm</div>
<p>snd-motif.scm has a variety of user-interface extensions that rely on the Motif module (xm.c).
Some of these have been translated to Gtk and xg.c — snd-gtk.scm. In Ruby, see snd-xm.rb.
</p>
-<table border=0 cellspacing=4 cellpadding=6 hspace=20>
+<div class="spacer"></div>
<!-- add-amp-controls -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="addampcontrols">add-amp-controls</a>
-</td></tr><tr><td width=30></td><td>
-<table border=0 cellspacing=10><tr>
-<td>
-add-amp-controls adds amplitude sliders to the control panel
+<pre class="indented">
+<em class=def id="addampcontrols">add-amp-controls</em>
+</pre>
+
+<p>add-amp-controls adds amplitude sliders to the control panel
for multichannel sounds so that each channel gets its own amplitude control slider.
-To make this the default, add <code>(add-amp-controls)</code> to your initialization file.
+To make this the default, add (add-amp-controls) to your initialization file.
Here is a 4-channel control panel after adding the channel-specific amp controls.
-</td><td>
-<img src="pix/addamps.png" alt="added amp controls">
-</td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+
+<img class="indented" src="pix/addamps.png" alt="added amp controls">
+
+<div class="spacer"></div>
<!-- add-delete-option -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="adddeleteoption">add-delete-option</a>
-</td></tr><tr><td></td><td>
-add-delete-option adds a "Delete" (file) option to the File menu.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=def id="adddeleteoption">add-delete-option</em>
+</pre>
+
+<p>add-delete-option adds a "Delete" (file) option to the File menu.
+</p>
+<div class="spacer"></div>
<!-- add-find-to-listener -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>add-find-to-listener</em>
-</td></tr><tr><td></td><td>
-add-find-to-listener causes C-s and C-r in the listener to start a separate "Find" dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+
+<p>add-find-to-listener causes C-s and C-r in the listener to start a separate "Find" dialog.
+</p>
+<div class="spacer"></div>
<!-- add-mark-pane -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="addmarkpane">add-mark-pane</a>
-</td></tr><tr><td></td><td>
-add-mark-pane adds a pane to each channel giving the current mark locations (sample values).
+<pre class="indented">
+<em class=def id="addmarkpane">add-mark-pane</em>
+</pre>
+
+<p>add-mark-pane adds a pane to each channel giving the current mark locations (sample values).
These can be edited to move the mark, or deleted to delete the mark. (If you add-mark-pane to a channel having marks,
you need to make some change to them to force it to be displayed).
Here's a picture (it also shows <a href="extsnd.html#withsmptelabel">with-smpte-label</a>,
<a href="extsnd.html#withinsetgraph">with-inset-graph</a>, and <a href="#showdiskspace">show-disk-space</a>).
-<br>
-<img src="pix/markpane.png" alt="mark pane" hspace=20 vspace=10 usemap="#markpanemap" border=0>
+</p>
+
+<img class="noborder" src="pix/markpane.png" alt="mark pane" usemap="#markpanemap">
<map name="markpanemap">
- <area shape=rect coords="70,30,150,50" alt="SMPTE label" onmouseout="UnTip()" onmouseover="Tip('this is the SMPTE label showing the time of the left edge')">
- <area shape=rect coords="240,33,245,120" alt="SMPTE label" onmouseout="UnTip()" onmouseover="Tip('this is mark at sample 8001: <code>(add-mark 8001)</code>')">
- <area shape=rect coords="337,33,343,120" alt="SMPTE label" onmouseout="UnTip()" onmouseover="Tip('this is mark at sample 9400: <code>(add-mark 9400)</code>')">
- <area shape=rect coords="539,33,545,120" alt="SMPTE label" onmouseout="UnTip()" onmouseover="Tip('this is mark at sample 12345: <code>(add-mark 12345)</code>')">
- <area shape=rect coords="570,25,710,45" alt="SMPTE label" onmouseout="UnTip()" onmouseover="Tip('this is the graph produced by <code>(set! (with-inset-graph) #t)</code>')">
- <area shape=rect coords="725,25,800,155" alt="SMPTE label" onmouseout="UnTip()" onmouseover="Tip('this is the mark pane from <code>(add-mark-pane)</code>')">
- <area shape=rect coords="590,155,700,170" alt="SMPTE label" onmouseout="UnTip()" onmouseover="Tip('this is the amount of free disk space I have.<br>In the bad old days, disk space was a constant problem.')">
+ <area shape=rect coords="70,30,150,50" alt="SMPTE label" href="extsnd.html#withsmptelabel">
+ <area shape=rect coords="240,33,245,120" alt="SMPTE label" href="extsnd.html#addmark">
+ <area shape=rect coords="337,33,343,120" alt="SMPTE label" href="extsnd.html#addmark">
+ <area shape=rect coords="539,33,545,120" alt="SMPTE label" href="extsnd.html#addmark">
+ <area shape=rect coords="570,25,710,45" alt="SMPTE label" href="extsnd.html#withinsetgraph">
+ <area shape=rect coords="725,25,800,155" alt="SMPTE label" href="#addmarkpane">
+ <area shape=rect coords="590,155,700,170" alt="SMPTE label" href="#showdiskspace">
</map>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- add-rename-option -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>add-rename-option</em>
-</td></tr><tr><td></td><td>
-add-rename-option adds a "Rename" (file) option to the File menu.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+
+<p>add-rename-option adds a "Rename" (file) option to the File menu.
+</p>
+<div class="spacer"></div>
<!-- add-text-to-status-area -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>add-text-to-status-area</em>
-</td></tr><tr><td></td><td>
-add-text-to-status-area puts a text widget in the notebook's status area
+</pre>
+
+<p>add-text-to-status-area puts a text widget in the notebook's status area
(the lower left portion of the main Snd window when using the -notebook invocation switch).
It returns the widget; you can write to it via XmTextFieldSetString.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- add-tooltip -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="addtooltip">add-tooltip</a> <code>widget tip</code>
-</td></tr><tr><td></td><td>
-add-tooltip adds a tooltip (also known as bubble-help) to a widget. Once added,
-set the variable with-tooltips to #f to turn it off.
-<pre>
- (add-tooltip (cadr (<a class=quiet href="extsnd.html#channelwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_channelwidgets_tip)">channel-widgets</a>)) "show the time domain waveform")
+<pre class="indented">
+<em class=def id="addtooltip">add-tooltip</em> widget tip
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- create-audit-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>create-audit-dialog</em>
-</td></tr><tr><td></td><td>
-create-audit-dialog sets up a frequency and an amplitude
-slider, the frequency running up to 20 KHz. Be careful with this thing! If you push the
-amplitude way up trying to hear some high frequency, you'll end up with a very unpleasant
-after-effect in your ears, a sort of deaf feeling (which thankfully does wear off).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>add-tooltip adds a tooltip (also known as bubble-help) to a widget. Once added,
+set the variable with-tooltips to #f to turn it off.
+</p>
-<!-- create-fmv-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="createfmvdialog">create-fmv-dialog</a>
-</td></tr><tr><td></td><td>
-create-fmv-dialog sets up a very simple dialog with amplitude, frequency, and fm-index controls on
-the fm-violin (fmv.scm) running (interpreted!) in "real-time".
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
+<pre class="indented">
+(add-tooltip (cadr (<a class=quiet href="extsnd.html#channelwidgets">channel-widgets</a>)) "show the time domain waveform")
+</pre>
-<!-- create-ssb-dialog -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="createssbdialog">create-ssb-dialog</a>
-</td></tr><tr><td></td><td>
-create-ssb-dialog sets up an <a href="sndclm.html#ssb-am">ssb-am</a> + bandpass filter bank (like <a href="#ssbbank">ssb-bank</a> in dsp.scm) that can
-change the pitch of a (well-behaved) sound without changing its duration.
-It is important to get the "old freq" setting as close as possible to the
-actual original frequency. If this were slightly faster and smarter, I'd
-replace the control panel expand option (which currently uses granular synthesis) with
-this idea.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- disable-control-panel -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="disablecontrolpanel">disable-control-panel</a> <code>snd</code>
-</td></tr><tr><td></td><td>
-disable-control-panel does away with the control panel.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- display-scanned-synthesis -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="displayscannedsynthesis">display-scanned-synthesis</a>
-</td></tr><tr><td></td><td>
-display-scanned-synthesis opens a pane for experimenting with
-scanned synthesis developed by Bill Verplank and Max Mathews.
-It is not impossible that you can close this pane via <code>close-scanned-synthesis-pane</code>.
-The synthesis code is also in <a href="#dspdocscanned">dsp.scm</a>.
-<table border=0 hspace=20 vspace=10><tr><td>
-<img src="pix/scanned.png" alt="scanned synthesis dialog"></td><td>
-<pre>
- top slider = mass,
- 2nd slider = spring,
- 3rd slider = damping,
- lower two are frequency and amplitude
- see <A HREF="http://www.billverplank.com/ScannedSynthesis.PDF">Bill Verplank's paper</A>
+<pre class="indented">
+<em class=def id="disablecontrolpanel">disable-control-panel</em> snd
</pre>
-</td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<p>disable-control-panel does away with the control panel.
+</p>
+<div class="spacer"></div>
+
<!-- display-widget-tree -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>display-widget-tree</em> <code>widget</code>
-</td></tr><tr><td></td><td>
-display-widget-tree displays the hierarchy of widgets beneath 'widget'.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>display-widget-tree</em> widget
+</pre>
+
+<p>display-widget-tree displays the hierarchy of widgets beneath 'widget'.
+</p>
+<div class="spacer"></div>
<!-- equalize-panes -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>equalize-panes</em> <code>snd</code>
-</td></tr><tr><td></td><td>
-This equalizes multichannel sound panes (tries to make them the same size),
+<pre class="indented">
+<em class=emdef>equalize-panes</em> snd
+</pre>
+
+<p>This equalizes multichannel sound panes (tries to make them the same size),
It is specific to Motif since Gtk paned window widgets are too simple-minded to get into this predicament.
If the 'snd' argument is given, only that sound's panes are affected.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- for-each-child -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="foreachchild">for-each-child</a> <code>w func</code><br>
-<em class=emdef>find-child</em> <code>w name</code>
-</td></tr><tr><td></td><td>
-for-each-child applies 'func' to the widget 'w' and to each widget in the hierarchy of widgets below it.
+<pre class="indented">
+<em class=def id="foreachchild">for-each-child</em> w func
+<em class=emdef>find-child</em> w name
+</pre>
+
+<p>for-each-child applies 'func' to the widget 'w' and to each widget in the hierarchy of widgets below it.
'func' takes one argument, the child widget. for-each-child is used by find-child which searches
for a widget named 'name' belonging to 'w'.
-<pre>
- (for-each-child
- (list-ref (<a class=quiet href="extsnd.html#soundwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_soundwidgets_tip)">sound-widgets</a>) 2) ; control panel
- (lambda (w)
- (<a class=quiet href="extsnd.html#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~%~A" (XtName w)))))
+</p>
+
+<pre class="indented">
+(for-each-child
+ ((<a class=quiet href="extsnd.html#soundwidgets">sound-widgets</a>) 2) ; control panel
+ (lambda (w)
+ (<a class=quiet href="extsnd.html#sndprint">snd-print</a> (<a class=quiet>format</a> #f "~%~A" (XtName w)))))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
-<!-- install-searcher -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>install-searcher</em> <code>proc</code>
-</td></tr><tr><td></td><td>
-install-searcher places
+
+<!-- install-searcher-with-colors -->
+<pre class="indented">
+<em class=emdef>install-searcher-with-colors</em> proc
+</pre>
+
+<p>install-searcher-with-colors places
our own search procedure into the filter mechanism in the File:Open
dialog. This has been superseded by the <a href="extsnd.html#addfilefilter">file-filter</a> mechanism now built into Snd.
-<pre>
- (install-searcher (lambda (file) (= (srate file) 44100)))
- (install-searcher (lambda (file) (= (channels file) 4)))
-</pre>
-There's a fancier version, install-searcher-with-colors, that distinguishes between categories
-of files by using different colors.
-<pre>
- (install-searcher-with-colors (lambda (file) #t))
+</p>
+
+<pre class="indented">
+(install-searcher-with-colors (lambda (file) #t))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- keep-file-dialog-open-upon-ok -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>keep-file-dialog-open-upon-ok</em>
-</td></tr><tr><td></td><td>
-keep-file-dialog-open-upon-ok changes File:Open so that clicking "ok" does not unmanage (dismiss) the dialog.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+
+<p>keep-file-dialog-open-upon-ok changes File:Open so that clicking "ok" does not unmanage (dismiss) the dialog.
+</p>
+<div class="spacer"></div>
<!-- load-font -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>load-font</em> <code>font-name</code>
-</td></tr><tr><td></td><td>
+<pre class="indented">
+<em class=emdef>load-font</em> font-name
+</pre>
+
+<p>
load-font loads a font and returns a handle for it.
+</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define new-font (<em class=red>load-font</em> "-*-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*"))
(define* (show-greeting (snd 0) (chn 0))
@@ -9555,237 +10043,236 @@ load-font loads a font and returns a handle for it.
(draw-string "hi!" (+ pos 5) 12 snd chn time-graph cr)
(set! (foreground-color) old-color)
(free-cairo cr)))))
-</pre></td></tr></table>
+</pre>
+
+<div class="spacer"></div>
-</td></tr><tr><td colspan=2 height=16></td></tr>
<!-- main-index |makedropsite:drop sites -->
<!-- make-channel-drop-site -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="makedropsite">make-channel-drop-site</a> <code>snd chn</code><br>
-<em class=emdef>set-channel-drop</em> <code>drop snd chn</code>
-</td></tr><tr><td></td><td>
-make-channel-drop-site shows how to add a drop site panel to a channel.
+<pre class="indented">
+<em class=def id="makedropsite">make-channel-drop-site</em> snd chn
+<em class=emdef>set-channel-drop</em> drop snd chn
+</pre>
+
+<p>make-channel-drop-site shows how to add a drop site panel to a channel.
set-channel-drop changes the channel's graph's drop function to 'drop', a
function of 3 arguments, the dropped filename (a string) and the current sound and
channel number.
-</td></tr><tr><td colspan=2 height=16></td></tr>
-
-
-<!-- main-index |makelevelmeter:level meters -->
-<!-- make-level-meter -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="makelevelmeter">make-level-meter</a> <code>parent width height args (resizable #t)</code><br>
-<A class=def NAME="withlevelmeters">with-level-meters</a> <code>n</code><br>
-<em class=emdef>display-level</em> <code>meter-data</code>
-</td></tr><tr><td></td><td>
-make-level-meter creates a VU meter of any width and height, returning
-a list of information associated with that meter. Pass that list to
-display-level to move the needle and the red bubble. This meter
-assumes you'll call it periodically so that the momentum of the needle and the viscosity of
-the bubble will appear to behave naturally. with-level-meters adds 'n'
-of these meters to the topmost pane in the Snd main window,
-then adds various <a href="extsnd.html#dachook">dac-hook</a> functions to display the current playback volume
-in the respective meter.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- make-pixmap -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makepixmap">make-pixmap</a> <code>widget strs</code>
-</td></tr><tr><td></td><td>
-make-pixmap turns an XPM-style description into pixmap. Briefly an XPM pixmap description
+<pre class="indented">
+<em class=def id="makepixmap">make-pixmap</em> widget strs
+</pre>
+
+<p>make-pixmap turns an XPM-style description into pixmap. Briefly an XPM pixmap description
is an array of strings; the first gives the size in pixels of the pixmap, and the number of colors;
the next set give characters followed by the color desired for that character; then comes the
pixmap itself using those characters. The following defines a 16 X 12 arrow using 6 colors:
-<pre>
- (define arrow-strs (list
- "16 12 6 1"
- " c None s None"
- ". c gray50"
- "X c black"
- "o c white"
- "O c yellow"
- "- c ivory2 s basiccolor"
- "--------X---------"
- "---------X--------"
- "----------X-------"
- "-----------X------"
- "------------X-----"
- "XXXXXXXXXXXXXX----"
- "------------X-----"
- "-----------X------"
- "----------X-------"
- "---------X--------"
- "--------X---------"
- "-------X----------"))
-</pre>
-<code>(make-pixmap (cadr (<a class=quiet href="extsnd.html#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>)) arrow-strs)</code> then creates the actual pixmap.
+</p>
+
+<pre class="indented">
+(define arrow-strs (list
+ "16 12 6 1"
+ " c None s None"
+ ". c gray50"
+ "X c black"
+ "o c white"
+ "O c yellow"
+ "- c ivory2 s basiccolor"
+ "--------X---------"
+ "---------X--------"
+ "----------X-------"
+ "-----------X------"
+ "------------X-----"
+ "XXXXXXXXXXXXXX----"
+ "------------X-----"
+ "-----------X------"
+ "----------X-------"
+ "---------X--------"
+ "--------X---------"
+ "-------X----------"))
+</pre>
+
+<p><code>(make-pixmap (cadr (<a class=quiet href="extsnd.html#mainwidgets">main-widgets</a>)) arrow-strs)</code> then creates the actual pixmap.
The 'widget' argument is needed to give us access to the current colormap and so on.
-<code>(cadr (main-widgets))</code> is just Snd's outer shell, which will do the trick in most cases.
+(cadr (main-widgets)) is just Snd's outer shell, which will do the trick in most cases.
See new-backgrounds.scm for many examples. The following example paints all of Snd's widgets using the
same background:
-<pre>
- (for-each-child
- (cadr (<a class=quiet href="extsnd.html#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>))
- (lambda (w)
- (XtSetValues w (list XmNbackgroundPixmap wd))
- (if (XmIsLabel w)
- (let ((val (cadr (XtVaGetValues w (list XmNlabelType 0)))))
- (if (= val XmPIXMAP)
- (XtVaSetValues w (list XmNlabelPixmap wd)))))))
-</pre>
-You can also use bitmaps:
-<pre>
- (define right-arrow (list
- #x00 #x04 #x10 #x08 #x00 #x10 #x04 #x20 #x00 #x40 #xa5 #xbf
- #x00 #x40 #x04 #x20 #x00 #x10 #x10 #x08 #x00 #x04 #x00 #x00))
+</p>
+
+<pre class="indented">
+(for-each-child
+ (cadr (<a class=quiet href="extsnd.html#mainwidgets">main-widgets</a>))
+ (lambda (w)
+ (XtSetValues w (list XmNbackgroundPixmap wd))
+ (if (XmIsLabel w)
+ (let ((val (cadr (XtVaGetValues w (list XmNlabelType 0)))))
+ (if (= val XmPIXMAP)
+ (XtVaSetValues w (list XmNlabelPixmap wd)))))))
+</pre>
+
+<p>You can also use bitmaps:
+</p>
+
+<pre class="indented">
+(define right-arrow (list
+ #x00 #x04 #x10 #x08 #x00 #x10 #x04 #x20 #x00 #x40 #xa5 #xbf
+ #x00 #x40 #x04 #x20 #x00 #x10 #x10 #x08 #x00 #x04 #x00 #x00))
- (define (bitmap->pixmap widget bits width height)
- (XCreateBitmapFromData (XtDisplay widget) (XtWindow widget) bits width height))
+(define (bitmap->pixmap widget bits width height)
+ (XCreateBitmapFromData (XtDisplay widget) (XtWindow widget) bits width height))
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+
+<div class="spacer"></div>
<!-- make-variable-display -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makevariabledisplay">make-variable-display</a> <code>page-name variable-name (type 'text) (range (list 0.0 1.0))</code><br>
-<a class=def name="variabledisplay">variable-display</a> <code>val widget</code>
-</td></tr><tr><td></td><td>
-make-variable-display sets up a display point (a dialog) for an arbitrary expression which
+<pre class="indented">
+<em class=def id="makevariabledisplay">make-variable-display</em> page-name variable-name (type 'text) (range (list 0.0 1.0))
+<em class=def id="variabledisplay">variable-display</em> val widget
+</pre>
+
+<p>make-variable-display sets up a display point (a dialog) for an arbitrary expression which
is updated via variable-display. The latter returns its argument, so it acts as a sort of
probe, picking out any arbitrary point in an instrument and displaying it as the
instrument is running. Display points can be organized as pages in a notebook
widget:
+</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define wid (make-variable-display "do-loop" "i*2" 'text))
(define wid1 (make-variable-display "do-loop" "i" 'text))
-(do ((i 0 (+ 1 i)))
+(do ((i 0 (+ i 1)))
((= i 10))
(variable-display (* (variable-display i wid1) 2) wid))
-</pre></td></tr></table>
+</pre>
-The 'type' argument to make-variable-display can be one of <code>'text</code>
-<code>'scale</code>, <code>'graph</code>, <code>'spectrum</code>, or <code>'meter</code>.
+<p>The 'type' argument to make-variable-display can be one of 'text
+'scale, 'graph, 'spectrum, or 'meter.
It determines the kind of widget(s) used to display that variable.
-The <code>'graph</code> and <code>'spectrum</code> cases create Snd channel displays,
+The 'graph and 'spectrum cases create Snd channel displays,
accessible via a sound (and channel 0); these respond to the
various channel-related functions such as <a href="extsnd.html#showtransformpeaks">show-transform-peaks</a>,
although you have to give the sound explicitly:
+</p>
-<pre>
- (define wid2 (make-variable-display "do-loop" "x" 'spectrum))
- (set! (<a class=quiet href="extsnd.html#showtransformpeaks" onmouseout="UnTip()" onmouseover="Tip(extsnd_showtransformpeaks_tip)">show-transform-peaks</a> (car wid2)) #t)
+<pre class="indented">
+(define wid2 (make-variable-display "do-loop" "x" 'spectrum))
+(set! (<a class=quiet href="extsnd.html#showtransformpeaks">show-transform-peaks</a> (car wid2)) #t)
</pre>
-Each graph or spectrum display is placed in its own pane (this is a desperate
+<p>Each graph or spectrum display is placed in its own pane (this is a desperate
kludge), whereas all the others are ordered vertically in a single pane.
-The <code>'scale</code> choice has an additional argument that gives the range of the
+The 'scale choice has an additional argument that gives the range of the
scale as a list (low high):
+</p>
-<pre>
- (define wid2 (make-variable-display "do-loop" "i*2" 'scale '(-1.0 1.0)))
+<pre class="indented">
+(define wid2 (make-variable-display "do-loop" "i*2" 'scale '(-1.0 1.0)))
</pre>
-You can watch a generator's state on a sample-by-sample basis by
+<p>You can watch a generator's state on a sample-by-sample basis by
putting it in a text display:
+</p>
-<table border=0 cellpadding=10><tr><td>
-<pre>
+<pre class="indented">
(define wid1 (make-variable-display "simp" "beg" 'text))
(define wid2 (make-variable-display "simp" "oscil" 'text))
(define wid3 (make-variable-display "simp" "outa" 'graph))
-(<a class=quiet href="#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> (simp)
+(<a class=quiet href="#definstrument">definstrument</a> (simp)
(let* ((beg 0)
(dur 1000)
(end (+ beg dur))
- (osc (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> 440.0)))
- (do ((i beg (+ 1 i)))
+ (osc (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> 440.0)))
+ (do ((i beg (+ i 1)))
((= i end))
(variable-display i wid1)
(variable-display
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> (variable-display osc wid2) 0.0)
+ (<a class=quiet href="sndclm.html#oscil">oscil</a> (variable-display osc wid2) 0.0)
wid3))))
(simp)
</pre>
-</td><td>
-<img src="pix/vardpy.png" alt="variable display">
-</td></tr></table>
-variable-display doesn't work within the run macro, but if you're debugging
-an instrument, you're presumably not primarily concerned with optimization.
+<img class="indented" src="pix/vardpy.png" alt="variable display">
+
+<p>
To clear display state, there's also variable-display-reset.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- mark-sync-color -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="marksynccolor">mark-sync-color</a> <code>new-color</code>
-</td></tr><tr><td></td><td>
-mark-sync-color uses the <a href="extsnd.html#drawmarkhook">draw-mark-hook</a> to set the color of sync'd marks.
+<pre class="indented">
+<em class=def id="marksynccolor">mark-sync-color</em> new-color
+</pre>
+
+<p>mark-sync-color uses the <a href="extsnd.html#drawmarkhook">draw-mark-hook</a> to set the color of sync'd marks.
(This is a no-op in Gtk+Cairo).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- menu-option -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>menu-option</em> <code>menu-name</code>
-</td></tr><tr><td></td><td>
-menu-option returns the widget associated with a given menu item name ("Print" for example).
+<pre class="indented">
+<em class=emdef>menu-option</em> menu-name
+</pre>
+
+<p>menu-option returns the widget associated with a given menu item name ("Print" for example).
This is actually a bad idea since the menu names can change without warning.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
-<!-- select-file -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>select-file</em> <code>func title dir filter help</code>
-</td></tr><tr><td></td><td>
-select-file starts a file selection dialog, running 'func' if a file is selected:
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
- (<a class=quiet href="extsnd.html#addtomenu" onmouseout="UnTip()" onmouseover="Tip(extsnd_addtomenu_tip)">add-to-menu</a> 0 "Insert File"
+<!-- select-file -->
+<pre class="indented">
+<em class=emdef>select-file</em> func title dir filter help
+</pre>
+<p>select-file starts a file selection dialog, running 'func' if a file is selected:
+</p>
+
+<pre class="indented">
+ (<a class=quiet href="extsnd.html#addtomenu">add-to-menu</a> 0 "Insert File"
(lambda ()
(<em class=red>select-file</em>
- (lambda (filename)
- (<a class=quiet href="extsnd.html#insertsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_insertsound_tip)">insert-sound</a> filename))
+ <a class=quiet href="extsnd.html#insertsound">insert-sound</a>
"Insert File" "." "*" "file will be inserted at cursor")))
-</pre></td></tr></table>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+
+<div class="spacer"></div>
<!-- show-all-atoms -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>show-all-atoms</em>
-</td></tr><tr><td></td><td>
-show-all-atoms displays all current X atom names (there are several hundred of these atoms normally).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</pre>
+<p>show-all-atoms displays all current X atom names (there are several hundred of these atoms normally).
+</p>
+<div class="spacer"></div>
-<!-- show-disk-space -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="showdiskspace">show-disk-space</a>
-</td></tr><tr><td></td><td>
-show-disk-space adds a label in the
-minibuffer area which shows the current amount of disk space available
-on the partition of the associated sound. There's a picture of it in action above (add-mark-pane).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<!-- show-disk-space -->
+<pre class="indented">
+<em class=def id="showdiskspace">show-disk-space</em>
+</pre>
-<!-- show-font-name -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>show-font-name</em> <code>font</code><br>
-</td></tr><tr><td></td><td>
-show-font-name shows the Snd-related name and the X-related name of each font in a font list
-(it searches for the XA_FULL_NAME associated with an XFontStruct).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>show-disk-space adds a label in the
+status area which shows the current amount of disk space available
+on the partition of the associated sound. There's a picture of it in action above (add-mark-pane).
+</p>
+<div class="spacer"></div>
<!-- show-sounds-in-directory -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<a class=def name="makesoundbox">make-sound-box</a> <code>name parent select-func peak-func sounds args</code><br>
-<em class=emdef>show-sounds-in-directory</em> <code>(dir ".")</code>
-</td></tr><tr><td></td><td>
-make-sound-box makes a container of sound file icons, each icon
+<pre class="indented">
+<em class=def id="makesoundbox">make-sound-box</em> name parent select-func peak-func sounds args
+<em class=emdef>show-sounds-in-directory</em> (dir ".")
+</pre>
+<p>make-sound-box makes a container of sound file icons, each icon
containing a little sketch of the waveform, the length of the
file, and the filename. What happens when an icon is selected
is up to 'select-func'. However, if you drag (via
@@ -9796,142 +10283,148 @@ mouse location in that channel.
'peak-func' (if any) tells the soundbox code where to find any associated peak env files.
'sounds' is list of sound file names.
'args' is list of resource settings for each icon.
+</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(make-sound-box "sounds"
- (list-ref (<a class=quiet href="extsnd.html#mainwidgets" onmouseout="UnTip()" onmouseover="Tip(extsnd_mainwidgets_tip)">main-widgets</a>) 3)
- (lambda (file)
- (<a class=quiet href="extsnd.html#sndprint" onmouseout="UnTip()" onmouseover="Tip(extsnd_sndprint_tip)">snd-print</a> file))
- (peak-env-dir)
+ ((<a class=quiet href="extsnd.html#mainwidgets">main-widgets</a>) 3)
+ <a class=quiet href="extsnd.html#sndprint">snd-print</a>
+ *peak-env-dir*
(list "oboe.snd" "pistol.snd" "cardinal.snd" "storm.snd")
- '())
-</pre></td></tr></table>
+ ())
+</pre>
-show-sounds-in-directory calls make-sound-box, filling it with
+<p>show-sounds-in-directory calls make-sound-box, filling it with
any sounds found in the directory passed as its argument (which defaults to
the current directory).
-<br>
-<img src="pix/soundbox.png" alt="show-sounds-in-directory" hspace=20 vspace=10>
+</p>
+
+<img class="indented" src="pix/soundbox.png" alt="show-sounds-in-directory">
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<div class="spacer"></div>
<!-- snd-clock-icon -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>snd-clock-icon</em> <code>snd hour</code>
-</td></tr><tr><td></td><td>
-snd-clock-icon replaces Snd's hourglass with a (very primitive) clock.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<pre class="indented">
+<em class=emdef>snd-clock-icon</em> snd hour
+</pre>
+
+<p>snd-clock-icon replaces Snd's hourglass with a (very primitive) clock.
+</p>
+<div class="spacer"></div>
<!-- upon-save-yourself -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<A class=def NAME="uponsaveyourself">upon-save-yourself</a> <code>thunk</code>
-</td></tr><tr><td></td><td>
-upon-save-yourself causes 'thunk' (a function of no arguments) to be called if the window
+<pre class="indented">
+<em class=def id="uponsaveyourself">upon-save-yourself</em> thunk
+</pre>
+
+<p>upon-save-yourself causes 'thunk' (a function of no arguments) to be called if the window
manager sends a SAVE_YOURSELF message.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- upon-take-focus -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>upon-take-focus</em> <code>thunk</code>
-</td></tr><tr><td></td><td>
-upon-take-focus causes 'thunk' (a function of no arguments) to be called
+<pre class="indented">
+<em class=emdef>upon-take-focus</em> thunk
+</pre>
+
+<p>upon-take-focus causes 'thunk' (a function of no arguments) to be called
whenever Snd receives focus from the window manager.
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
+<div class="spacer"></div>
<!-- with-minmax-button -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
+<pre class="indented">
<em class=emdef>with-minmax-button</em>
-</td></tr><tr><td></td><td>
-with-minmax-button adds an open/close button to each sound's pane. To activate it:
-<pre>
- (hook-push <a class=quiet href="extsnd.html#afteropenhook" onmouseout="UnTip()" onmouseover="Tip(extsnd_afteropenhook_tip)">after-open-hook</a> with-minmax-button)
</pre>
-</td></tr><tr><td colspan=2 height=16></td></tr>
+<p>with-minmax-button adds an open/close button to each sound's pane. To activate it:
+</p>
+
+<pre class="indented">
+(hook-push <a class=quiet href="extsnd.html#afteropenhook">after-open-hook</a> with-minmax-button)
+</pre>
+
+<div class="spacer"></div>
<!-- zync -->
-<tr><td colspan=2 bgcolor="#f2f4ff">
-<em class=emdef>unzync</em> <br>
+<pre class="indented">
+<em class=emdef>unzync</em>
<em class=emdef>zync</em>
-</td></tr><tr><td></td><td>
-The pair zync and unzync cause the
+</pre>
+
+<p>The pair zync and unzync cause the
y-axis zoom sliders of a multichannel file to move together (zync) or separately (unzync, the default).
-</td></tr><tr><td colspan=2 height=16></td></tr>
+</p>
-</table>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="grfsnd.html#sndwithmotif" onmouseout="UnTip()" onmouseover="Tip('Motif extensions from xm.c')">motif</a> <a href="grfsnd.html#sndwithgtk" onmouseout="UnTip()" onmouseover="Tip('Gtk extensions from xg.c')">gtk</a> <a href="extsnd.html#snddialogs" onmouseout="UnTip()" onmouseover="Tip('customizing the built-in dialogs, etc')">dialogs</a> <a href="extsnd.html#graphics" onmouseout="UnTip()" onmouseover="Tip('write your own sound display functions or customize Snd\'s')">graphics</a> <a href="#menusdoc" onmouseout="UnTip()" onmouseover="Tip('various dialogs')">menus</a> <a href="#enveddoc" onmouseout="UnTip()" onmouseover="Tip('envelope editors')">enved</a> <a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip('library that ties Motif and Gtk into Snd')">libxm</a>
-</pre>
-</td></tr></table>
+<div class="seealso">
+see also: <a href="grfsnd.html#sndwithmotif">motif</a> <a href="grfsnd.html#sndwithgtk">gtk</a> <a href="extsnd.html#snddialogs">dialogs</a> <a href="extsnd.html#graphics">graphics</a> <a href="#menusdoc">menus</a> <a href="#enveddoc">enved</a>
+</div>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: snd-test and event ---------------------------------------- -->
+<!-- FILE: snd-test -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="sndtestdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>snd-test and event</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="sndtestdoc">snd-test</div>
<p>
snd-test.scm and snd-test.rb are test suites for Snd. The simplest use is:
</p>
-<pre>
- snd -l snd-test
+
+<pre class="indented">
+snd -l snd-test
</pre>
+
<p>
which will run all the tests, assuming you have the various sound files it is expecting to find.
You can run a particular test with:
</p>
-<pre>
- snd -l snd-test 23
+
+<pre class="indented">
+snd -l snd-test 23
</pre>
+
<p>which runs test 23.
snd-test is primarily useful to non-developers as a source of
a huge number of examples.
</p>
-<br><br>
+<!-- FILE: sndwarp -->
-<!-- ---------------------------------------- FILE: sndwarp ---------------------------------------- -->
-
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="sndwarpdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>sndwarp</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="sndwarpdoc">sndwarp</div>
<p>
This is a translation from CLM of Bret Battey's sndwarp instrument, itself based on Richard Karpen's sndwarp csound generator.
It is similar to <a href="#expsrc">expsrc</a>.
</p>
-<pre>
- <a class=def name="sndwarp">sndwarp</a> beg dur file
- (amp 1.0)
- (amp-env '(0 1 100 1)) ; amplitude envelope
- (stretch 1.0) ; time stretch — 2.0 -> twice as long
- (srate 1.0) ; src — 0.5 -> octave down
- (inputbeg 0.0) ; source file start point
- (wsize 0.1) ; size of windows in seconds
- (randw 0.02) ; randomness of wsize
- (overlaps 15) ; window overlaps per sec
- (time-ptr #f) ; #f=stretch mode, #t=time-ptr mode
- (scale-time-ptr #f) ; #f=absolute, #t=rescale
- (zero-start-time-ptr #f); #t=start at 0
- (window-offset #f) ; #f=spread windows evenly
- (loc 0.5) ; stereo loc, 0=left, 1=right
- (rev 0.1) ; reverb amount
- (srcwidth 5) ; src interpolation width
+
+<pre class="indented">
+<em class=def id="sndwarp">sndwarp</em> beg dur file
+ (amp 1.0)
+ (amp-env '(0 1 100 1)) ; amplitude envelope
+ (stretch 1.0) ; time stretch — 2.0 -> twice as long
+ (srate 1.0) ; src — 0.5 -> octave down
+ (inputbeg 0.0) ; source file start point
+ (wsize 0.1) ; size of windows in seconds
+ (randw 0.02) ; randomness of wsize
+ (overlaps 15) ; window overlaps per sec
+ (time-ptr #f) ; #f=stretch mode, #t=time-ptr mode
+ (scale-time-ptr #f) ; #f=absolute, #t=rescale
+ (zero-start-time-ptr #f); #t=start at 0
+ (window-offset #f) ; #f=spread windows evenly
+ (loc 0.5) ; stereo loc, 0=left, 1=right
+ (rev 0.1) ; reverb amount
+ (srcwidth 5) ; src interpolation width
</pre>
+
<p>
Many of the parameters can also be envelopes. The source has commentary
which I'll slightly paraphrase here for convenience.
@@ -9953,27 +10446,23 @@ time-ptr = 0.
'window-offset' is a flag that determines how the windows are offset
in time.
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (sndwarp 0 1 "oboe.snd"))
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (sndwarp 0 4 "oboe.snd" :stretch 2.0 :srate 0.5))
-</pre>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="#clmexpsrc" onmouseout="UnTip()" onmouseover="Tip('clm-ins version of expsrc')">clm-expsrc</a> <a href="#expsrc" onmouseout="UnTip()" onmouseover="Tip('granular synthesis to stretch sound')">expsrc</a> <a href="#pvocdoc" onmouseout="UnTip()" onmouseover="Tip('phase-vocoder')">pvoc</a> <a href="#rubberdoc" onmouseout="UnTip()" onmouseover="Tip('phase-locked time stretch')">rubber</a> <a href="#ssbbank" onmouseout="UnTip()" onmouseover="Tip('use ssb-am for time stretch')">ssb-bank</a>
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (sndwarp 0 1 "oboe.snd"))
+(<a class=quiet href="#wsdoc">with-sound</a> () (sndwarp 0 4 "oboe.snd" :stretch 2.0 :srate 0.5))
</pre>
-</td></tr></table>
-<br>
-<br>
+<div class="seealso">
+see also: <a href="#clmexpsrc">clm-expsrc</a> <a href="#expsrc">expsrc</a> <a href="#pvocdoc">pvoc</a> <a href="#rubberdoc">rubber</a> <a href="#ssbbank">ssb-bank</a>
+</div>
-<!-- ---------------------------------------- FILE: spectr ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="spectrdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>spectr</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: spectr -->
+
+<div class="header" id="spectrdoc">spectr</div>
<p>The spectr files were translated by Michael Scholz from CLM's spectr.clm. They contain a large
set of instrument steady-state spectra, gathered many years ago (before 1976) by James A Moorer.
@@ -9982,84 +10471,81 @@ rescuing the data from mouldering magtapes, he had long since moved on, so I don
know what instrument some of the labels refer to. The data is in the form of a bunch of lists,
each given a name:
</p>
-<pre>
- (define trp-gs5 '( 1.02 .0114 2.02 .0346 3.02 .0045 4.04 .0013 5.06 .0002))
+
+<pre class="indented">
+(define trp-gs5 '( 1.02 .0114 2.02 .0346 3.02 .0045 4.04 .0013 5.06 .0002))
</pre>
+
<p>
which (I think) refers to a trumpet playing the note gs5. The first number is the harmonic,
the second its amplitude, the third the next harmonic, then its amplitude, and so on.
These spectra can be used directly in the instrument <a href="#spectra">spectra</a> in clm-ins.scm.
</p>
-<table bgcolor="aliceblue" border=0><tr>
-<td>
-<pre>see also: <a href="#twotab" onmouseout="UnTip()" onmouseover="Tip('interpolate between spectra')">two-tab</a>
-</pre>
-</td></tr></table>
+<div class="seealso">
+see also: <a href="#twotab">two-tab</a>
+</div>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: stochastic ---------------------------------------- -->
+<!-- FILE: stochastic -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="stochasticdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>stochastic</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="stochasticdoc">stochastic</div>
<p>stochastic is Bill Sack's implementation of Xenakis' Dynamic Stochastic Synthesis as heard in his GENDY3, S.709, Legende d'Eer, etc.
</p>
-<pre>
- <em class=emdef>stochastic</em> start dur
- (amp .9) ; overall amplitude
- (bits 16) ; resolution of the wave's amplitude dimension
- (xmin 1) ; minimum number of samples between time breakpoints, must be >= 1
- (xmax 20) ; maximum number of samples between time breakpoints
- (xwig 0) ; amplitude applied to random walk function in time dimension
- (xstep 1) ; quantization of freedom in time dimension, in samples, minimum: 1
- (ywig 0) ; amplitude applied to random walk function in amplitude dimension, as %amp
- (xfb 0) ; FIR filter
- (init-array '((10 0) (10 1) (10 0) (10 -.7) (10 0) (10 .5)
- (10 0) (10 -.3) (10 0) (10 .2) (10 0) (10 -.1)))
- ; initial x and y breakpoints for wave,
- ; x values must be integers >= 1, y values between -1.0 and 1.0
+
+<pre class="indented">
+<em class=emdef>stochastic</em> start dur
+ (amp .9) ; overall amplitude
+ (bits 16) ; resolution of the wave's amplitude dimension
+ (xmin 1) ; minimum number of samples between time breakpoints, must be >= 1
+ (xmax 20) ; maximum number of samples between time breakpoints
+ (xwig 0) ; amplitude applied to random walk function in time dimension
+ (xstep 1) ; quantization of freedom in time dimension, in samples, minimum: 1
+ (ywig 0) ; amplitude applied to random walk function in amplitude dimension, as %amp
+ (xfb 0) ; FIR filter
+ (init-array '((10 0) (10 1) (10 0) (10 -.7) (10 0) (10 .5)
+ (10 0) (10 -.3) (10 0) (10 .2) (10 0) (10 -.1)))
+ ; initial x and y breakpoints for wave,
+ ; x values must be integers >= 1, y values between -1.0 and 1.0
</pre>
+
<p>stochastic.ins in the CLM tarball has an elaborate Common Music-based example.
Here is one that is much simpler, but very loud:
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () (stochastic 0 10 :xwig .25 :ywig 10.0))
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> () (stochastic 0 10 :xwig .25 :ywig 10.0))
</pre>
-<br>
-<!-- ---------------------------------------- FILE: strad ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="straddoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>strad</h2></td></tr></table>
-</td></tr></table>
+
+<!-- FILE: strad -->
+
+<div class="header" id="straddoc">strad</div>
<p>strad.scm is a translation (by Michael Scholz) of CLM's strad.ins (by Juan Reyes).
It implements a physical model of a bowed string with stiffness.
</p>
-<br>
-<!-- ---------------------------------------- FILE: v and fmv ---------------------------------------- -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="vdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>v and fmv</h2></td></tr></table>
-</td></tr></table>
+<!-- FILE: v and fmv -->
+
+<div class="header" id="vdoc">v and fmv</div>
<!-- main-index |vdoc:fm-violin -->
-<p>The <A NAME="fmviolin">fm violin</A> was my favorite instrument while working in the 70's and 80's,
+<p>The fm violin was my favorite instrument while working in the 70's and 80's,
primarily on the Samson box. It was developed in Mus10 (ca 1977) based on ideas of John Chowning.
</p>
-<pre>
-<em class=emdef>fm-violin</em> startime dur frequency amplitude
+
+<pre class="indented">
+<em class=emdef id="fmviolin">fm-violin</em> startime dur frequency amplitude
(fm-index 1.0) ; scales all indices
(amp-env '(0 0 25 1 75 1 100 0)) ; amplitude envelope
(periodic-vibrato-rate 5.0)
@@ -10088,12 +10574,15 @@ primarily on the Samson box. It was developed in Mus10 (ca 1977) based on ideas
(reverb-amount 0.01)
(base 1.0) ; amp env base (1.0 = line segments)
</pre>
+
<p>Most of these parameters are for special cases; normally you need only:
</p>
-<pre>
- Scheme: (with-sound () (fm-violin 0 1 440 .1))
- Ruby: with_sound() do fm_violin_rb(0, 1, 440, .1, [[:fm_index, 2.0]]) end
+
+<pre class="indented">
+Scheme: (with-sound () (fm-violin 0 1 440 .1))
+Ruby: with_sound() do fm_violin_rb(0, 1, 440, .1, [[:fm_index, 2.0]]) end
</pre>
+
<p>
fm-violin sets up several parallel modulators of one carrier (see <A HREF="fm.html">fm.html</A>
for details, or (ah nostalgia...)
@@ -10116,8 +10605,8 @@ to call in "real-time" situations. Any other CLM-style instrument could
be rewritten in the same form.
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
- <em class=emdef>make-fm-violin</em>
+<pre class="indented">
+<em class=emdef>make-fm-violin</em>
frequency amplitude (fm-index 1.0) (amp-env #f)
(periodic-vibrato-rate 5.0) (random-vibrato-rate 16.0)
(periodic-vibrato-amplitude 0.0025) (random-vibrato-amplitude 0.005)
@@ -10128,9 +10617,9 @@ be rewritten in the same form.
(fm1-rat 1.0) (fm2-rat 3.0) (fm3-rat 4.0)
(fm1-index #f) (fm2-index #f) (fm3-index #f) (base 1.0)
- <em class=emdef>fm-violin</em> gen
- <em class=emdef>fm-violin-ins</em> [same args as original violin in v.scm]
-</pre></td></tr></table>
+<em class=emdef>fm-violin</em> gen
+<em class=emdef>fm-violin-ins</em> [same args as original violin in v.scm]
+</pre>
<p>fm-violin-ins shows how this generator can be fitted into the original fm-violin code.
The plethora of arguments is an historical artifact;
@@ -10138,26 +10627,26 @@ normally only a few of them are used at a time. There are two examples of calli
in fmv.scm, the simpler one being:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define test-v
(lambda (beg dur freq amp amp-env)
(let ((v (<em class=red>make-fm-violin</em>
freq amp
- :amp-env (let ((e (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (or amp-env '(0 0 1 1 2 0))
+ :amp-env (let ((e (<a class=quiet href="sndclm.html#make-env">make-env</a> (or amp-env '(0 0 1 1 2 0))
:scaler amp
:length dur)))
- (lambda () (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> e)))))
- (data (<a class=quiet href="extsnd.html#channeltovct" onmouseout="UnTip()" onmouseover="Tip(extsnd_channeltovct_tip)">channel->vct</a> beg dur)))
- (do ((i 0 (+ 1 i)))
+ (lambda () (<a class=quiet href="sndclm.html#env">env</a> e)))))
+ (data (channel->float-vector beg dur)))
+ (do ((i 0 (+ i 1)))
((= i dur))
(set! (data i) (+ (data i)
(<em class=red>v</em>))))
- (<a class=quiet href="extsnd.html#setsamples" onmouseout="UnTip()" onmouseover="Tip(extsnd_setsamples_tip)">set-samples</a> beg dur data))))
-</pre></td></tr></table>
+ (<a class=quiet href="extsnd.html#setsamples">set-samples</a> beg dur data))))
+</pre>
<p>Here we are setting up an fm-violin generator (via make-fm-violin), then
calling it 'dur' times, mixing its output into the current data (this could
-also use mix-vct and so on). The generator is called via <code>(v)</code>.
+also use mix-float-vector and so on). The generator is called via (v).
As can be seen here, each envelope is treated as a function called on each sample
very much like the "as-needed" input in src or granulate; the envelopes could actually be any
arbitrary function you like (see test-v1 in fmv.scm which uses an oscillator as one of
@@ -10166,7 +10655,6 @@ you don't know in advance how long a note will be; in this case, the envelope
generating functions should have attack and decay ramps, triggered by note-on and
note-off; once the ramp has reached its end point, the end value should be held;
the note itself should be called until it has had time to ramp off.
-Another example is <a href="#createfmvdialog">create-fmv-dialog</a> in snd-motif.
</p>
<p>
@@ -10174,7 +10662,8 @@ I can't resist including an historical digression.
Here is a Mus10 version of fm-violin (in this code ":=" is used in place of the original SAIL left arrow character,
and so on):
</p>
-<table border=0 hspace=20><tr><td><pre>
+
+<pre class="indented">
ARRAY GlissFunc, DecayFunc, AttackFunc, SineWave, AmpFunc(512);
SYNTH(Sinewave); 1,1 999;
SEG(AmpFunc); 0,0 1,25 1,50 0,75 0,100;
@@ -10284,15 +10773,15 @@ Mod3:=NOSCIL(Decay*ScFreq*(Att+Index3),3*NewMag,Sinewave);
Snd:=ZOSCIL(Decay*ENV*Ramp,NewMag+Mod1+Mod2+Mod3,Sinewave);
OUTA:=OUTA+Snd*0.5;
END;
-</pre></td></tr></table>
+</pre>
-<table border=1 hspace=20 cellpadding=10>
+<table class="method">
<tr><td>
<img src="pix/early.png" alt="at the park, copyright Patte Wood">
</td><td>
<img src="pix/later.png" alt="at home">
</td></tr>
-<tr><td>then</td><td>now</td></tr>
+<tr><td class="center">then</td><td class="center">now</td></tr>
</table>
<p>
@@ -10306,7 +10795,7 @@ To give a feel for how one worked in those days, here's a brief quote from the M
Leland Smith, May 1977):
</p>
-<table border=0 hspace=20><tr><td><pre>
+<pre class="indented">
The following generates 1 second of a 440 Hz sine wave followed by
1/2 sec. of a 660Hz sine wave. The output goes to a file, MUSIC.MSB,
which is written on DSKM.
@@ -10325,7 +10814,7 @@ PLAY ;
SIMP 0, 1, 440, 1000;
SIMP 1, 1/2, 660, 1000;
FINISH;
-</pre></td></tr></table>
+</pre>
<p>
The computation involved was considered so burdensome, that the names of
@@ -10335,7 +10824,7 @@ of going away.
In the Samson box world, this (in its initial "chorus" version) was:
</p>
-<table border=0 hspace=20><tr><td><pre>
+<pre class="indented">
Instrument(Violin);
RECORD_POINTER(seg) nullfunc;
INTEGER ARRAY gens[1:4],indgens[1:6], GensA[1:4],AmpGens[1:2];
@@ -10394,7 +10883,7 @@ AddArrEnv(Pns,Gens,4,"F",freq,Freq*skewmult,skewfunc,ratsA,
AddArrEnv(Pns,GensA,4,"F",freq,Freq*skewmult,skewfunc,ratsA,
6,.010,.010,nullfunc,5,.017,.017,nullfunc,1,0);
End!Instrument(Pns); ! deallocation;
-</pre></td></tr></table>
+</pre>
<p>
The Sambox version eventually became incredibly complicated, mainly to
@@ -10405,64 +10894,64 @@ The parallel in the Sambox world to the SIMP example above is (this is
taken from SAMBOX.BIL, November 1984):
</p>
-<table border=0 hspace=20><tr><td><pre>
+<pre class="indented">
Instrument(Simp);
Integer Gen1;
Gen1:=Osc(Pns,OutA,Zero,SineMode,0,0,Pn[3]);
AddEnv(Pns,Gen1,"A",0,Pn[4],Pf[5]);
End_Instrument(Pns);
-</pre></td></tr></table>
+</pre>
-<p>The CLM version of this is:</p>
+<p>The Common Lisp version of this is:</p>
-<table border=0 hspace=20><tr><td><pre>
-(<a class=quiet href="#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> simp (start-time duration frequency amplitude
+<pre class="indented">
+(<a class=quiet href="#definstrument">definstrument</a> simp (start-time duration frequency amplitude
&optional (amp-env '(0 0 50 1 100 0)))
- (multiple-value-bind (beg end) (<a class=quiet href="sndclm.html#timestosamples" onmouseout="UnTip()" onmouseover="Tip(sndclm_timestosamples_tip)">times->samples</a> start-time duration)
- (let ((s (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frequency))
- (amp (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> amp-env :scaler amplitude :duration duration)))
+ (multiple-value-bind (beg end) (<a class=quiet href="sndclm.html#timestosamples">times->samples</a> start-time duration)
+ (let ((s (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> frequency))
+ (amp (<a class=quiet href="sndclm.html#make-env">make-env</a> amp-env :scaler amplitude :duration duration)))
(run
(loop for i from beg below end do
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> amp) (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> s))))))))
-</pre></td></tr></table>
+ (<a class=quiet href="sndclm.html#outa">outa</a> i (* (<a class=quiet href="sndclm.html#env">env</a> amp) (<a class=quiet href="sndclm.html#oscil">oscil</a> s))))))))
+</pre>
<p>
-In CLM, the fm-violin became (fm.html, 1989):
+In Common Lisp, the fm-violin became (fm.html, 1989):
</p>
-<table border=0 hspace=20><tr><td><pre>
-(<a class=quiet href="#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> violin (beg end frequency amplitude fm-index)
- (let* ((frq-scl (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency))
+<pre class="indented">
+(<a class=quiet href="#definstrument">definstrument</a> violin (beg end frequency amplitude fm-index)
+ (let* ((frq-scl (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> frequency))
(maxdev (* frq-scl fm-index))
(index1 (* maxdev (/ 5.0 (log frequency))))
(index2 (* maxdev 3.0 (/ (- 8.5 (log frequency)) (+ 3.0 (/ frequency 1000)))))
(index3 (* maxdev (/ 4.0 (sqrt frequency))))
- (carrier (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frequency))
- (fmosc1 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frequency))
- (fmosc2 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* 3 frequency)))
- (fmosc3 (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* 4 frequency)))
- (ampf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 25 1 75 1 100 0) :scaler amplitude))
- (indf1 (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 1 25 .4 75 .6 100 0) :scaler index1))
- (indf2 (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 1 25 .4 75 .6 100 0) :scaler index2))
- (indf3 (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 1 25 .4 75 .6 100 0) :scaler index3))
- (pervib (<a class=quiet href="sndclm.html#make-triangle-wave" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_triangle_wave_tip)">make-triangle-wave</a> :frequency 5 :amplitude (* .0025 frq-scl)))
+ (carrier (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> frequency))
+ (fmosc1 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> frequency))
+ (fmosc2 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* 3 frequency)))
+ (fmosc3 (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* 4 frequency)))
+ (ampf (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 0 25 1 75 1 100 0) :scaler amplitude))
+ (indf1 (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 1 25 .4 75 .6 100 0) :scaler index1))
+ (indf2 (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 1 25 .4 75 .6 100 0) :scaler index2))
+ (indf3 (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 1 25 .4 75 .6 100 0) :scaler index3))
+ (pervib (<a class=quiet href="sndclm.html#make-triangle-wave">make-triangle-wave</a> :frequency 5 :amplitude (* .0025 frq-scl)))
(ranvib (make-randi :frequency 16 :amplitude (* .005 frq-scl)))
(vib 0.0))
(run
(loop for i from beg to end do
- (setf vib (+ (<a class=quiet href="sndclm.html#triangle-wave" onmouseout="UnTip()" onmouseover="Tip(sndclm_triangle_wave_tip)">triangle-wave</a> pervib) (randi ranvib)))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf)
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> carrier
+ (setf vib (+ (<a class=quiet href="sndclm.html#triangle-wave">triangle-wave</a> pervib) (randi ranvib)))
+ (<a class=quiet href="sndclm.html#outa">outa</a> i (* (<a class=quiet href="sndclm.html#env">env</a> ampf)
+ (<a class=quiet href="sndclm.html#oscil">oscil</a> carrier
(+ vib
- (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf1) (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> fmosc1 vib))
- (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf2) (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> fmosc2 (* 3.0 vib)))
- (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf3) (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> fmosc3 (* 4.0 vib)))))))))))
-</pre></td></tr></table>
+ (* (<a class=quiet href="sndclm.html#env">env</a> indf1) (<a class=quiet href="sndclm.html#oscil">oscil</a> fmosc1 vib))
+ (* (<a class=quiet href="sndclm.html#env">env</a> indf2) (<a class=quiet href="sndclm.html#oscil">oscil</a> fmosc2 (* 3.0 vib)))
+ (* (<a class=quiet href="sndclm.html#env">env</a> indf3) (<a class=quiet href="sndclm.html#oscil">oscil</a> fmosc3 (* 4.0 vib)))))))))))
+</pre>
<p>or in its actual (non-simplified) form:
</p>
-<table border=0 hspace=20><tr><td><pre>
+<pre class="indented">
(defun bit20 (x) ;Samson box modifier got 20 bit int interpreted as fraction
(if (>= x (expt 2 19)) ;(keep fm-violin compatible with old note lists)
(float (/ (- x (expt 2 20)) (expt 2 19)))
@@ -10483,7 +10972,7 @@ In CLM, the fm-violin became (fm.html, 1989):
(push val result)
(nreverse result)))
-(<a class=quiet href="#definstrument" onmouseout="UnTip()" onmouseover="Tip(sndscm_definstrument_tip)">definstrument</a> fm-violin
+(<a class=quiet href="#definstrument">definstrument</a> fm-violin
(startime dur frequency amplitude &key
(fm-index 1.0)
(amp-env '(0 0 25 1 75 1 100 0))
@@ -10513,7 +11002,7 @@ In CLM, the fm-violin became (fm.html, 1989):
(setf frequency (clm-cerror "440.0?" 440.0 #'numberp "frequency = ~A?" frequency)))
(let* ((beg (floor (* startime *srate*)))
(end (+ beg (floor (* dur *srate*))))
- (frq-scl (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> frequency))
+ (frq-scl (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> frequency))
(modulate (not (zerop fm-index)))
(maxdev (* frq-scl fm-index))
(vln (not (eq index-type :cello)))
@@ -10544,34 +11033,34 @@ In CLM, the fm-violin became (fm.html, 1989):
(norm (or (and easy-case modulate 1.0) index1))
- (carrier (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> frequency))
- (fmosc1 (and modulate (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* fm1-rat frequency))))
- (fmosc2 (and modulate (or easy-case (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* fm2-rat frequency)))))
- (fmosc3 (and modulate (or easy-case (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> (* fm3-rat frequency)))))
- (ampf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a>
+ (carrier (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> frequency))
+ (fmosc1 (and modulate (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* fm1-rat frequency))))
+ (fmosc2 (and modulate (or easy-case (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* fm2-rat frequency)))))
+ (fmosc3 (and modulate (or easy-case (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> (* fm3-rat frequency)))))
+ (ampf (<a class=quiet href="sndclm.html#make-env">make-env</a>
(if denoise
(reduce-amplitude-quantization-noise amp-env dur amplitude denoise-dur denoise-amp)
amp-env)
amplitude :base base :duration dur))
- (indf1 (and modulate (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> fm1-env norm :duration dur)))
- (indf2 (and modulate (or easy-case (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> fm2-env index2 :duration dur))))
- (indf3 (and modulate (or easy-case (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> fm3-env index3 :duration dur))))
- (frqf (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> gliss-env (* glissando-amount frq-scl) :duration dur))
- (pervib (<a class=quiet href="sndclm.html#make-triangle-wave" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_triangle_wave_tip)">make-triangle-wave</a> periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
- (ranvib (<a class=quiet href="sndclm.html#make-rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_interp_tip)">make-rand-interp</a> random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
+ (indf1 (and modulate (<a class=quiet href="sndclm.html#make-env">make-env</a> fm1-env norm :duration dur)))
+ (indf2 (and modulate (or easy-case (<a class=quiet href="sndclm.html#make-env">make-env</a> fm2-env index2 :duration dur))))
+ (indf3 (and modulate (or easy-case (<a class=quiet href="sndclm.html#make-env">make-env</a> fm3-env index3 :duration dur))))
+ (frqf (<a class=quiet href="sndclm.html#make-env">make-env</a> gliss-env (* glissando-amount frq-scl) :duration dur))
+ (pervib (<a class=quiet href="sndclm.html#make-triangle-wave">make-triangle-wave</a> periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
+ (ranvib (<a class=quiet href="sndclm.html#make-rand-interp">make-rand-interp</a> random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
(fm-noi (if (and (/= 0.0 noise-amount)
(null frobber))
- (<a class=quiet href="sndclm.html#make-rand" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_tip)">make-rand</a> noise-freq (* pi noise-amount))))
+ (<a class=quiet href="sndclm.html#make-rand">make-rand</a> noise-freq (* pi noise-amount))))
(ind-noi (if (and (/= 0.0 ind-noise-amount) (/= 0.0 ind-noise-freq))
- (<a class=quiet href="sndclm.html#make-rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_interp_tip)">make-rand-interp</a> ind-noise-freq ind-noise-amount)))
+ (<a class=quiet href="sndclm.html#make-rand-interp">make-rand-interp</a> ind-noise-freq ind-noise-amount)))
(amp-noi (if (and (/= 0.0 amp-noise-amount) (/= 0.0 amp-noise-freq))
- (<a class=quiet href="sndclm.html#make-rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_rand_interp_tip)">make-rand-interp</a> amp-noise-freq amp-noise-amount)))
+ (<a class=quiet href="sndclm.html#make-rand-interp">make-rand-interp</a> amp-noise-freq amp-noise-amount)))
(frb-env (if (and (/= 0.0 noise-amount) frobber)
- (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (make-frobber-function startime (+ startime dur) frobber) :duration dur
+ (<a class=quiet href="sndclm.html#make-env">make-env</a> (make-frobber-function startime (+ startime dur) frobber) :duration dur
:base 0 :scaler (* two-pi noise-amount))))
(vib 0.0)
(modulation 0.0)
- (loc (<a class=quiet href="sndclm.html#make-locsig" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_locsig_tip)">make-locsig</a> :degree (or degree degrees (random 90.0))
+ (loc (<a class=quiet href="sndclm.html#make-locsig">make-locsig</a> :degree (or degree degrees (random 90.0))
:reverb reverb-amount :distance distance))
(fuzz 0.0)
(ind-fuzz 1.0)
@@ -10580,30 +11069,30 @@ In CLM, the fm-violin became (fm.html, 1989):
(loop for i from beg to end do
(if (/= 0.0 noise-amount)
(if (null frobber)
- (setf fuzz (<a class=quiet href="sndclm.html#rand" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_tip)">rand</a> fm-noi))
- (setf fuzz (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frb-env))))
- (setf vib (+ (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> frqf) (<a class=quiet href="sndclm.html#triangle-wave" onmouseout="UnTip()" onmouseover="Tip(sndclm_triangle_wave_tip)">triangle-wave</a> pervib) (<a class=quiet href="sndclm.html#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand_interp</a> ranvib)))
- (if ind-noi (setf ind-fuzz (+ 1.0 (<a class=quiet href="sndclm.html#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand-interp</a> ind-noi))))
- (if amp-noi (setf amp-fuzz (+ 1.0 (<a class=quiet href="sndclm.html#rand-interp" onmouseout="UnTip()" onmouseover="Tip(sndclm_rand_interp_tip)">rand-interp</a> amp-noi))))
+ (setf fuzz (<a class=quiet href="sndclm.html#rand">rand</a> fm-noi))
+ (setf fuzz (<a class=quiet href="sndclm.html#env">env</a> frb-env))))
+ (setf vib (+ (<a class=quiet href="sndclm.html#env">env</a> frqf) (<a class=quiet href="sndclm.html#triangle-wave">triangle-wave</a> pervib) (<a class=quiet href="sndclm.html#rand-interp">rand_interp</a> ranvib)))
+ (if ind-noi (setf ind-fuzz (+ 1.0 (<a class=quiet href="sndclm.html#rand-interp">rand-interp</a> ind-noi))))
+ (if amp-noi (setf amp-fuzz (+ 1.0 (<a class=quiet href="sndclm.html#rand-interp">rand-interp</a> amp-noi))))
(if modulate
(if easy-case
(setf modulation
- (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf1)
- (<a class=quiet href="sndclm.html#polynomial" onmouseout="UnTip()" onmouseover="Tip(sndclm_polynomial_tip)">polynomial</a> coeffs (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> fmosc1 vib)))) ;(* vib fm1-rat)??
+ (* (<a class=quiet href="sndclm.html#env">env</a> indf1)
+ (<a class=quiet href="sndclm.html#polynomial">polynomial</a> coeffs (<a class=quiet href="sndclm.html#oscil">oscil</a> fmosc1 vib)))) ;(* vib fm1-rat)??
(setf modulation
- (+ (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf1) (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> fmosc1 (+ (* fm1-rat vib) fuzz)))
- (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf2) (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> fmosc2 (+ (* fm2-rat vib) fuzz)))
- (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> indf3) (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> fmosc3 (+ (* fm3-rat vib) fuzz)))))))
- (<a class=quiet href="sndclm.html#locsig" onmouseout="UnTip()" onmouseover="Tip(sndclm_locsig_tip)">locsig</a> loc i
- (* (<a class=quiet href="sndclm.html#env" onmouseout="UnTip()" onmouseover="Tip(sndclm_env_tip)">env</a> ampf) amp-fuzz
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> carrier (+ vib (* ind-fuzz modulation)))))))))
-</pre></td></tr></table>
+ (+ (* (<a class=quiet href="sndclm.html#env">env</a> indf1) (<a class=quiet href="sndclm.html#oscil">oscil</a> fmosc1 (+ (* fm1-rat vib) fuzz)))
+ (* (<a class=quiet href="sndclm.html#env">env</a> indf2) (<a class=quiet href="sndclm.html#oscil">oscil</a> fmosc2 (+ (* fm2-rat vib) fuzz)))
+ (* (<a class=quiet href="sndclm.html#env">env</a> indf3) (<a class=quiet href="sndclm.html#oscil">oscil</a> fmosc3 (+ (* fm3-rat vib) fuzz)))))))
+ (<a class=quiet href="sndclm.html#locsig">locsig</a> loc i
+ (* (<a class=quiet href="sndclm.html#env">env</a> ampf) amp-fuzz
+ (<a class=quiet href="sndclm.html#oscil">oscil</a> carrier (+ vib (* ind-fuzz modulation)))))))))
+</pre>
<p>which is very similar to the Scheme version (v.scm).
And I just found this out on the net; I'm no csound expert, so I merely quote what I find:
</p>
-<table border=0 hspace=20><tr><td><pre>
+<pre class="indented">
;ORC
; edited by R. Pinkston, modified for use with MIDI2CS by R. Borrmann
;
@@ -10663,13 +11152,13 @@ continue:
; endin
aright = asig
aleft = asig
-</pre></td></tr></table>
+</pre>
<p>There's a C/CLM version of this instrument in <a href="sndlib.html">sndlib.html</a>. The body of the fm-violin
in C/CLM is:
</p>
-<table border=0 hspace=20><tr><td><pre>
+<pre class="indented">
if (noise_amount != 0.0) fuzz = mus_rand(fmnoi,0.0);
if (frqf) vib = mus_env(frqf); else vib = 0.0;
vib += mus_triangle_wave(pervib, 0.0) +
@@ -10683,12 +11172,12 @@ in C/CLM is:
mus_env(indf3) * mus_oscil(fmosc3, (fuzz + fm3_rat * vib), 0.0);
mus_locsig(loc, i, mus_env(ampf) *
mus_oscil(carrier, vib + indfuzz * modulation, 0.0));
-</pre></td></tr></table>
+</pre>
<p>And here is the Ruby version, written by Michael Scholz (see examp.rb):</p>
-<table border=0 hspace=20><tr><td><pre>
+<pre class="indented">
#
# fm_violin([start=0.0[, dur=1.0[, freq=440.0[, amp=0.3[, *args]]]]])
#
@@ -10843,396 +11332,416 @@ rescue
die(usage + "fm_violin()");
end
-</pre></td></tr></table>
+</pre>
-<br>
-<br>
-<!-- ---------------------------------------- FILE: ws ---------------------------------------- -->
+<!-- FILE: ws -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="wsdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>ws (with-sound)</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="wsdoc">ws</div>
<p>
with-sound provides a way to package up a bunch of instrument calls into a new
sound file, and open that file in Snd when the computation is complete.
To hear (and see) the fm-violin, for example, we first load with-sound and the instrument:
</p>
-<table border=0 cellspacing=0 hspace=20>
-<tr>
-<td bgcolor="#fbfbff">
-<pre>
+
+
+<table><tr><td>
+<div class="scheme">
+<pre class="indented">
;; Scheme:
(load "ws.scm")
(load "v.scm")
-</pre></td><td width=30></td>
+</pre>
+</div>
+</td>
-<td bgcolor="#FdFdf2">
-<pre>
+<td>
+<div class="ruby">
+<pre class="indented">
# Ruby:
load("ws.rb")
load("v.rb")
-</pre></td><td width=30></td>
+</pre>
+</div>
+</td>
-<td bgcolor="#EefdEe">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
\ Forth:
"clm.fs" file-eval
"clm-ins.fs" file-eval
-</pre></td>
-</tr></table>
+</pre>
+</div>
+</td></tr></table>
<p>Then call with-sound, accepting the default sound file settings, with one fm-violin note at A4 (440 Hz):
</p>
-<table border=0 cellspacing=0 hspace=20>
-<tr>
-<td bgcolor="#fbfbff">
-<pre>
+<table><tr><td>
+
+<div class="scheme">
+<pre class="indented">
(with-sound ()
(fm-violin 0 1 440 .1))
-</pre></td><td width=30></td>
-<td bgcolor="#FdFdf2">
-<pre>
+</pre>
+</div></td>
+
+<td>
+<div class="ruby">
+<pre class="indented">
with_sound() do
fm_violin_rb(0, 1, 440, 0.1)
end
-</pre></td><td width=30></td>
+</pre>
+</div></td>
-<td bgcolor="#EefdEe">
-<pre>
+<td>
+<div class="forth">
+<pre class="indented">
0 1 440 0.1 ' fm-violin with-sound
-</pre></td>
+
+
+</pre>
+</div>
+</td>
</tr></table>
<p>The body of with-sound can hold any number of notes, or any arbitrary code. For example, say
we want to hear an arpeggio from the fm-violin:
</p>
-<pre>
- (with-sound ()
- (do ((i 0 (+ 1 i)))
- ((= i 4)) ; 4 notes in all
- (fm-violin (* i 0.25) ; notes 1/4 secs apart
- 0.25 ; each note 1/4 sec long
- (* 220.0 (+ 1 i)); go up by 220 Hz on each note
- .1))) ; all notes .1 amp
+
+<pre class="indented">
+(with-sound ()
+ (do ((i 0 (+ i 1)))
+ ((= i 4)) ; 4 notes in all
+ (fm-violin (* i 0.25) ; notes 1/4 secs apart
+ 0.25 ; each note 1/4 sec long
+ (* 220.0 (+ i 1)); go up by 220 Hz on each note
+ .1))) ; all notes .1 amp
</pre>
+
<p>
-with-sound opens an output object, either a sound file, a vct, a vector, or a sound-data object: (*output*), and
+with-sound opens an output object, either a sound file, or a vector: (*output*), and
optionally a reverb output object: *reverb*. Each instrument uses <a href="sndclm.html#out-any">out-any</a> to add its sounds to the
*output* results. with-sound next sets up a variety of variables describing the current
output, and establishes an environment where various problems can be handled nicely (in Scheme,
a dynamic-wind with various debugging hooks). Then the with-sound body is evaluated, presumably
producing sound. Once evaluated, the outputs are closed, and if reverb is requested, the reverberator
-is run. Once complete, with-sound print out statistics (if :statistics is #t), scales the result (if :scale-to),
-and plays it (if :play is #t). Then, if the output is a sound file, with-sound opens it in Snd, first closing any previous sound with
+is run. Once complete, with-sound prints out statistics (if :statistics is #t), scales the result (if :scale-to),
+and plays it (if :play is #t). Then, if the output is a sound file (and :to-snd is #t), with-sound opens it in Snd, first closing any previous sound with
the same name (this makes it easier to call with-sound over and over while trying out some patch).
with-sound returns its :output argument.
</p>
-<pre>
- <a class=def name="withsound">with-sound</a>
- (srate *clm-srate*) ; output sampling rate (44100)
+
+<pre class="indented">
+ <em class=def id="withsound">with-sound</em>
(output *clm-file-name*) ; output file name ("test.snd")
(channels *clm-channels*) ; channels in output (1)
+ (srate *clm-srate*) ; output sampling rate (44100)
+ (sample-type *clm-sample-type*) ; output sample data type (mus-bfloat or mus-lshort)
(header-type *clm-header-type*) ; output header type (mus-next or mus-aifc)
- (data-format *clm-data-format*) ; output sample data type (mus-bfloat or mus-lshort)
(comment #f) ; any comment to store in the header (a string)
(verbose *clm-verbose*) ; if #t, print out some info
(reverb *clm-reverb*) ; reverb instrument (jc-reverb)
- (revfile "test.rev") ; reverb intermediate output file name ("test.rev")
(reverb-data *clm-reverb-data*) ; arguments passed to the reverb
(reverb-channels *clm-reverb-channels*); chans in the reverb intermediate file
+ (revfile *clm-reverb-file-name*) ; reverb intermediate output file name ("test.rev")
(continue-old-file #f) ; if #t, continue a previous computation
(statistics *clm-statistics*) ; if #t, print info at end of with-sound (compile time, maxamps)
(scaled-by #f) ; is a number, scale output by that amp
(scaled-to #f) ; if a number, scale the output to peak at that amp
(play *clm-play*) ; if #t, play the sound automatically
(to-snd *to-snd*) ; if #t, open the output file in Snd
- (output-safety *clm-output-safety*) ; see with-threaded-sound below
</pre>
+
<p>The with-sound syntax may look sightly odd; we include the arguments in the first list, then
everything after that is evaluated as a note list.
</p>
-<pre>
- (with-sound (:srate 44100 :channels 2 :output "test.snd")
- (fm-violin 0 1 440 .1)
- (fm-violin 1 1 660 .1))
+
+<pre class="indented">
+(with-sound (:srate 44100 :channels 2 :output "test.snd")
+ (fm-violin 0 1 440 .1)
+ (fm-violin 1 1 660 .1))
</pre>
+
<p>produces a sound file with two fm-violin notes; the sound file is named "test.snd", is stero, and has a sampling rate of 44100.
</p>
-<pre>
- (with-sound (:reverb jc-reverb :statistics #t :play #t)
- (fm-violin 0 1 440 .1 :reverb-amount .3))
+
+<pre class="indented">
+(with-sound (:reverb jc-reverb :statistics #t :play #t)
+ (fm-violin 0 1 440 .1 :reverb-amount .3))
</pre>
+
<p>produces one fm-violin note, heavily reverberated, and plays it, printing this info:
</p>
-<pre>
- <em class=listener>></em><em class=typing>(with-sound (:reverb jc-reverb :statistics #t :play #t)
- (fm-violin 0 1 440 .1 :reverb-amount .3))</em>
- <em class=listener>test.snd:
- maxamp: 0.3038
- rev max: 0.0300
- compute time: 0.030</em>
+
+<pre class="indented">
+> (with-sound (:reverb jc-reverb :statistics #t :play #t)
+ (fm-violin 0 1 440 .1 :reverb-amount .3))
+test.snd:
+maxamp: 0.3038
+rev max: 0.0300
+compute time: 0.030
</pre>
+
<p>It's often hard to predict how loud a set of notes is going to be, so we can use
"scaled-to" to set its final amplitude:
</p>
-<pre>
- (with-sound (:scale-to .5)
- (do ((i 0 (+ 1 i))) ((= i 10)) (fm-violin 0 i (random) 440.0)))
+
+<pre class="indented">
+(with-sound (:scale-to .5)
+ (do ((i 0 (+ i 1))) ((= i 10)) (fm-violin 0 i 440.0 (random 1.0))))
</pre>
+
<p>Here are examples in Ruby and Forth:
</p>
-<pre>
- :<em class=typing>with_sound(:channels, 2, :play, false, :statistics, true) do
- fm_violin_rb(0, 1, 440, 0.1);
- fm_violin_rb(1, 1, 660, 0.1);
- end</em>
- <em class=listener># filename: "test.snd"
- # chans: 2, srate: 22050
- # length: 2.000 (44100 frames)
- # format: big endian short (16 bits) [Sun/Next]
- # real: 2.248 (utime 2.240, stime 0.000)
- # ratio: 1.12 (uratio 1.12)
- # max out: [0.098, 0.024]
- #<With_Snd: output: "test.snd", channels: 2, srate: 22050></em>
+
+<pre class="indented">
+:with_sound(:channels, 2, :play, false, :statistics, true) do
+ fm_violin_rb(0, 1, 440, 0.1);
+ fm_violin_rb(1, 1, 660, 0.1);
+ end
+# filename: "test.snd"
+# chans: 2, srate: 22050
+# length: 2.000 (44100 framples)
+# format: big endian short (16 bits) [Sun/Next]
+# real: 2.248 (utime 2.240, stime 0.000)
+# ratio: 1.12 (uratio 1.12)
+# max out: [0.098, 0.024]
+#<With_Snd: output: "test.snd", channels: 2, srate: 22050>
</pre>
+
<p>and in Forth:
</p>
-<pre>
- snd> <em class=typing>0.0 1.0 330.0 0.5 ' simp :play #f :channels 2 with-sound</em>
- <em class=listener>\ filename: test.snd
- \ chans: 2, srate: 22050
- \ format: little endian float (32 bits) [Sun/Next]
- \ length: 1.000 (22050 frames)
- \ real: 0.162 (utime 0.267, stime 0.000)
- \ ratio: 0.16 (uratio 0.27)
- \ maxamp A: 0.500 (near 0.680 secs)
- \ maxamp B: 0.000 (near 0.000 secs)
- \ comment: Written on Fri Jul 14 07:41:47 PDT 2006 by bil at cat using clm (fth) of 30-Jun-06</em>
+
+<pre class="indented">
+snd> 0.0 1.0 330.0 0.5 ' simp :play #f :channels 2 with-sound
+\ filename: test.snd
+\ chans: 2, srate: 22050
+\ format: little endian float (32 bits) [Sun/Next]
+\ length: 1.000 (22050 framples)
+\ real: 0.162 (utime 0.267, stime 0.000)
+\ ratio: 0.16 (uratio 0.27)
+\ maxamp A: 0.500 (near 0.680 secs)
+\ maxamp B: 0.000 (near 0.000 secs)
+\ comment: Written on Fri Jul 14 07:41:47 PDT 2006 by bil at cat using clm (fth) of 30-Jun-06
</pre>
+
<p>The default values listed above (*clm-srate* and friends) are set in ws.scm:
</p>
-<pre>
- (define *clm-file-name* "test.snd")
- (define *clm-srate* (default-output-srate)) ; 44100
- (define *clm-channels* (default-output-chans)) ; 1
- (define *clm-data-format* (default-output-data-format)) ; mus-lfloat
- (define *clm-header-type* (default-output-header-type)) ; mus-next
- (define *clm-verbose* #f)
- (define *clm-play* #f)
- (define *clm-statistics* #f)
- (define *clm-reverb* #f)
- (define *clm-reverb-channels* 1)
- (define *clm-reverb-data* '())
- (define *clm-table-size* 512)
- (define *clm-default-frequency* 0.0)
- (define *clm-file-buffer-size* 65536)
- (define *clm-locsig-type* mus-interp-linear)
- (define *clm-clipped* #t)
- (define *clm-array-print-length* (print-length)) ; 12
- (define *clm-player* #f)
- (define *clm-notehook* #f)
- (define *to-snd* #t)
- (define *reverb* #f)
- (define *output* #f)
- (define *clm-delete-reverb* #f)
- (define *clm-threads* 4)
- (define *clm-output-safety* 0)
+
+<pre class="indented">
+(define *clm-file-name* "test.snd")
+(define *clm-srate* *default-output-srate*) ; 44100
+(define *clm-channels* *default-output-chans*) ; 1
+(define *clm-sample-type* *default-output-sample-type*) ; mus-lfloat
+(define *clm-header-type* *default-output-header-type*) ; mus-next
+(define *clm-verbose* #f)
+(define *clm-play* #f)
+(define *clm-statistics* #f)
+(define *clm-reverb* #f)
+(define *clm-reverb-channels* 1)
+(define *clm-reverb-data* ())
+(define *clm-reverb-file-name* "test.rev")
+(define *clm-table-size* 512)
+(define *clm-default-frequency* 0.0)
+(define *clm-file-buffer-size* 65536)
+(define *clm-locsig-type* mus-interp-linear)
+(define *clm-clipped* #t)
+(define *clm-array-print-length* *print-length*) ; 12
+(define *clm-player* #f)
+(define *clm-notehook* #f)
+(define *to-snd* #t)
+(define *reverb* #f)
+(define *output* #f)
+(define *clm-delete-reverb* #f)
</pre>
+
<p>You can set any of these to permanently change with-sound's defaults
</p>
-<pre>
- <em class=listener>></em><em class=typing>(set! *clm-file-name* "test.aif")</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(set! *clm-srate* 44100)</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(set! *clm-channels* 2)</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(set! *clm-header-type* mus-aifc)</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(set! *clm-data-format* mus-bfloat)</em>
- <em class=listener>#<unspecified></em>
- <em class=listener>></em><em class=typing>(with-sound () (fm-violin 0 1 440 .1))test.aif:</em>
- <em class=listener>"test.aif"</em>
- <em class=listener>></em><em class=typing>(srate "test.aif")</em>
- <em class=listener>44100</em>
- <em class=listener>></em><em class=typing>(channels "test.aif")</em>
- <em class=listener>2</em>
+
+<pre class="indented">
+> (set! *clm-file-name* "test.aif")
+#<unspecified>
+> (set! *clm-srate* 44100)
+#<unspecified>
+> (set! *clm-channels* 2)
+#<unspecified>
+> (set! *clm-header-type* mus-aifc)
+#<unspecified>
+> (set! *clm-sample-type* mus-bfloat)
+#<unspecified>
+> (with-sound () (fm-violin 0 1 440 .1))test.aif:
+"test.aif"
+> (srate "test.aif")
+44100
+> (channels "test.aif")
+2
</pre>
+
<p>
To display the entire sound automatically (independent of <a href="extsnd.html#afteropenhook">after-open-hook</a>),
use with-full-sound:
</p>
-<pre>
- (defmacro with-full-sound (args . body)
- `(let ((snd (with-sound-helper (lambda () , at body) , at args)))
- (set! (<a class=quiet href="extsnd.html#xbounds" onmouseout="UnTip()" onmouseover="Tip(extsnd_xbounds_tip)">x-bounds</a> *snd-opened-sound*) (list 0.0 (/ (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a> *snd-opened-sound*) (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a> *snd-opened-sound*))))
- snd))
+
+<pre class="indented">
+(define-macro (with-full-sound args . body)
+ `(let ((snd (with-sound-helper (lambda () , at body) , at args)))
+ (set! (<a class=quiet href="extsnd.html#xbounds">x-bounds</a> *snd-opened-sound*) (list 0.0 (/ (<a class=quiet href="extsnd.html#framples">framples</a> *snd-opened-sound*) (<a class=quiet href="extsnd.html#srate">srate</a> *snd-opened-sound*))))
+ snd))
</pre>
+
<p>Since with-sound returns the new sound's file name, we save that, get the new sound's index (<a href="extsnd.html#sndopenedsound">*snd-opened-sound*</a>),
and set the <a href="extsnd.html#xbounds">x-bounds</a> to display the full sound, then return the file name. You could obviously customize this any way
you like.
To continue adding notes to an existing file, set 'continue-old-file':
</p>
-<pre>
- (with-sound (:continue-old-file #t) (fm-violin 0 1 440 .1))
+
+<pre class="indented">
+(with-sound (:continue-old-file #t) (fm-violin 0 1 440 .1))
</pre>
+
<p>The "notehook" argument is a function called each time an instrument is called:
</p>
-<pre>
- <em class=listener>></em><em class=typing>(with-sound (:notehook (lambda (name . args)
- (snd-print (<a class=quiet onmouseout="UnTip()" onmouseover="Tip(scheme_format_tip)">format</a> #f "~%;~A: ~A" name (caddr args)))))
- (fm-violin 0 1 440 .1)
- (fm-violin 1 1 660 .1))</em>
- <em class=listener>;fm-violin: 440
- ;fm-violin: 660
- "test.snd"</em>
+
+<pre class="indented">
+> (with-sound (:notehook (lambda (name . args)
+ (snd-print (<a class=quiet>format</a> #f "~%;~A: ~A" name (caddr args)))))
+ (fm-violin 0 1 440 .1)
+ (fm-violin 1 1 660 .1))
+;fm-violin: 440
+;fm-violin: 660
+"test.snd"
</pre>
-<p>
+
+<p id="definstrument">
The arguments passed to the notehook function are the current instrument name (a string) and all its
-arguments. <a name="definstrument">definstrument</a> implements the notehook feature.
-The "output" argument can be a vct, a vector, or a sound-data object, as well as a filename:
+arguments. definstrument implements the notehook feature.
+The "output" argument can be a vector as well as a filename:
</p>
-<pre>
- (with-sound (:output (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 44100)) (fm-violin 0 1 440 .1))
+
+<pre class="indented">
+(with-sound (:output (make-float-vector 44100 0.0)) (fm-violin 0 1 440 .1))
</pre>
-<p>See <a href="#fadedoc">fade.scm</a>, snd-test.scm,
-<a href="#insertsounddata">insert-sound-data</a>, <a href="#mixsounddata">mix-sound-data</a> for more examples.
+
+<p>See <a href="#fadedoc">fade.scm</a>, snd-test.scm.
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>definstrument</h4></td></tr></table>
-</td></tr></table>
+
+<div class="innerheader">definstrument</div>
<p>
definstrument
is very much like define*, but with added code to support notehook and (for Common Music) *definstrument-hook*.
-So, an instrument that wants to cooperate fully with with-sound and Common Music has the form:
+It uses old CL-style documentation strings.
+An instrument that wants to cooperate fully with with-sound and Common Music has the form:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(definstrument (ins args)
(let ...
- (run ; run is optional, but speeds up computation
- (do ((i start (+ 1 i)))
- ((= i end))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> i ...)))))
-</pre></td></tr></table>
+ (do ((i start (+ i 1)))
+ ((= i end))
+ (<a class=quiet href="sndclm.html#outa">outa</a> i ...))))
+</pre>
<p>definstrument is an extension of define*, so its arguments are handled as optional keyword arguments:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(definstrument (simp beg dur (frequency 440.0) (amplitude 0.1))
- (let* ((os (make-oscil frequency)))
- (run
- (do ((i 0 (+ 1 i))) ((= i dur))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> (+ i beg) (* amplitude (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> os)))))))
+ (let ((os (make-oscil frequency)))
+ (do ((i 0 (+ i 1))) ((= i dur))
+ (<a class=quiet href="sndclm.html#outa">outa</a> (+ i beg) (* amplitude (<a class=quiet href="sndclm.html#oscil">oscil</a> os))))))
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+(<a class=quiet href="#wsdoc">with-sound</a> ()
(simp 0 10000)
(simp 10000 10000 550.0 :amplitude 0.1)
(simp 20000 10000 :amplitude 0.2))
-</pre></td></tr></table>
+</pre>
<p>You don't have to use definstrument; in the next example we make a Shepard tone
by calling the oscils and whatnot directly in the with-sound body:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(define (<a name="shepardtone">shepard-tone</a>)
- (let* ((x 0.0)
- (incr .000001) ; sets speed of glissandoes
- (oscs (make-vector 12)))
- (do ((i 0 (+ 1 i)))
+<pre class="indented">
+(define (shepard-tone)
+ (let ((x 0.0)
+ (incr .000001) ; sets speed of glissandoes
+ (oscs (make-vector 12)))
+ (do ((i 0 (+ i 1)))
((= i 12))
- (set! (oscs i) (<a class=quiet href="sndclm.html#make-oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_oscil_tip)">make-oscil</a> :frequency 0.0)))
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:srate 44100)
- (run ; use "run" to speed up computation by about a factor of 10
- (do ((samp 0 (+ 1 samp)))
- ((= samp 300000))
- (let ((sum 0.0))
- (do ((i 0 (+ 1 i)))
- ((= i 12))
- (let ((loc (+ x (/ i 12.0)))) ; location of current oscil in overall trajectory
- (if (> loc 1.0) (set! loc (- loc 1.0)))
- (set! sum (+ sum (* (let ((y (- 4.0 (* 8.0 loc))))
- (exp (* -0.5 y y))) ; Gaussian normal curve as amplitude envelope
- (<a class=quiet href="sndclm.html#oscil" onmouseout="UnTip()" onmouseover="Tip(sndclm_oscil_tip)">oscil</a> (oscs i)
- (<a class=quiet href="sndclm.html#hztoradians" onmouseout="UnTip()" onmouseover="Tip(sndclm_hztoradians_tip)">hz->radians</a> (expt 2.0 (+ 2 (* loc 12.0))))))))))
- ;; (- 1.0 loc) to go down
- (set! x (+ x incr))
- (<a class=quiet href="sndclm.html#outa" onmouseout="UnTip()" onmouseover="Tip(sndclm_outa_tip)">outa</a> samp (* .1 sum))))))))
-</pre></td></tr></table>
-<img src="pix/shepard.png" alt="shepard tone spectrum" vspace=10 hspace=40>
-
-<p>In all these cases, the "run time" portion of the sound computation is wrapped up
-in <code>(run ... )</code>. <a href="extsnd.html#run">run</a> (the name predates me!),
-tries to optimize its argument using a sort of byte compiler. When successful, it
-can speed up computation by about a factor of 10. When unsuccessful, it falls back
-on Scheme, so you always get a sound. The body of the run can be anything; in this
-document, primarily for historical reasons, all the bodies seem to be do loops, but
-just about any other choice is ok. See run.c for a list of what's optimizable:
-avoid lists, if possible, and fancy stuff like map or apply, and you should be fine.
-</p>
-
-
-<br>
-
-<p>There are several other versions of with-sound: with-temp-sound, with-threaded-sound, with-mixed-sound, sound-let, clm-load, and the Common Music
+ (set! (oscs i) (<a class=quiet href="sndclm.html#make-oscil">make-oscil</a> :frequency 0.0)))
+ (<a class=quiet href="#wsdoc">with-sound</a> (:srate 44100)
+ (do ((samp 0 (+ 1 samp)))
+ ((= samp 300000))
+ (let ((sum 0.0))
+ (do ((i 0 (+ i 1)))
+ ((= i 12))
+ (let ((loc (+ x (/ i 12.0)))) ; location of current oscil in overall trajectory
+ (if (> loc 1.0) (set! loc (- loc 1.0)))
+ (set! sum (+ sum (* (let ((y (- 4.0 (* 8.0 loc))))
+ (exp (* -0.5 y y))) ; Gaussian normal curve as amplitude envelope
+ (<a class=quiet href="sndclm.html#oscil">oscil</a> (oscs i)
+ (<a class=quiet href="sndclm.html#hztoradians">hz->radians</a> (expt 2.0 (+ 2 (* loc 12.0))))))))))
+ ;; (- 1.0 loc) to go down
+ (set! x (+ x incr))
+ (<a class=quiet href="sndclm.html#outa">outa</a> samp (* .1 sum)))))))
+</pre>
+
+<img class="indented" src="pix/shepard.png" alt="shepard tone spectrum" >
+
+<p>There are several other versions of with-sound: with-temp-sound, with-mixed-sound, sound-let, clm-load, and the Common Music
handles, init-with-sound and finish-with-sound.
-<a name="withtempsound">with-temp-sound</a> and <a name="sound-let">sound-let</a> set up temporary bindings for embedded with-sounds.
+with-temp-sound and sound-let set up temporary bindings for embedded with-sounds.
</p>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>sound-let</h4></td></tr></table>
-</td></tr></table>
-<p>sound-let is a form of let* that creates temporary sound files
+
+<div class="innerheader">sound-let</div>
+
+<p id="sound-let">sound-let is a form of let* that creates temporary sound files
within with-sound. Its syntax is a combination of let* and with-sound:
with-sound:</p>
-<table border=0 hspace=40 cellpadding=8 cellspacing=3><tr><td>
-<pre>
+<pre class="indented">
(<em class=red>sound-let</em> ((temp-1 () (fm-violin 0 1 440 .1))
(temp-2 () (fm-violin 0 2 660 .1)
(fm-violin .125 .5 880 .1)))
(granulate-sound temp-1 0 2 0 2) ;temp-1's value is the name of the temporary file
(granulate-sound temp-2 1 1 0 2))
</pre>
-</td></tr></table>
<p>This creates two temporary files and passes them along to the subsequent calls
on granulate-sound. The first list after the sound file identifier (i.e. after
@@ -11247,29 +11756,32 @@ its explicitly named output intact (and tries to open it in Snd, which can be co
Here's another example:
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+ (<a class=quiet href="#wsdoc">with-sound</a> ()
(<em class=red>sound-let</em> ((temp-sound () (fm-violin 0 1 440 .1))) ; create temp-sound with an fm-violin note
(pins 0.0 2.0 temp-sound 1.0 :time-scaler 2.0)) ; stretch it with the pins instrument (clm-ins.scm)
(fm-violin 1 1 550 .1)) ; add another fm-violin note
</pre>
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>with-temp-sound</h4></td></tr></table>
-</td></tr></table>
-<p>with-temp-sound is like sound-let, but does not delete its output file:
+
+
+<div class="innerheader">with-temp-sound</div>
+
+<p id="withtempsound">with-temp-sound is like sound-let, but does not delete its output file:
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+
+<pre class="indented">
+ (<a class=quiet href="#wsdoc">with-sound</a> ()
(let ((temp-sound (<em class=red>with-temp-sound</em> () (fm-violin 0 1 440 .1))))
(clm-expsrc 0 2 temp-sound 2.0 1.0 1.0)))
</pre>
+
<p>Here are Ruby examples:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+
+<pre class="indented">
with_sound() do
clm_mix(with_sound(:output, "hiho.snd") do
fm_violin_rb(0, 1, 440, 0.1)
@@ -11283,208 +11795,138 @@ with_sound() do
end
}
end
-</pre></td></tr></table>
-
-
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>with-threaded-sound</h4></td></tr></table>
-</td></tr></table>
-
-<p><a name="withthreadedsound">with-threaded-sound</a> looks (and, I hope, behaves) exactly like with-sound, but
-the notes in the with-sound body are handled by separate threads. It is currently restricted to versions of Snd
-running s7.
-</p>
-
-<pre>
- (with-threaded-sound ()
- (fm-violin 0 1 440 .1)
- (fm-violin 0 1 660 .1))
-</pre>
-
-<p>If you start a thread for each note, then join them all at once, the computation slows down a lot due to
-the fact that all the threads are jostling each other trying to write output to the output file,
-so *clm-threads* sets the number of threads running
-through the note list at any one time. It defaults to 4. You can speed up
-with-threaded-sound if you set *clm-file-buffer-size* large enough to accommodate
-the entire output, then pass :output-safety 1 to with-threaded-sound.
-You may also have to set <a href="extsnd.html#musmaxmalloc">mus-max-malloc</a> to tell Snd that the huge allocation is intentional.
-</p>
-
-<pre>
-(set! *clm-threads* 8) ; we're running on a machine with 8 "cores"
-(set! *clm-file-buffer-size* (* 30 65536)) ; big enough to hold all our output in RAM
-(set! *clm-output-safety* 1) ; assure CLM that output buffers never get flushed
-(set! (optimization) 6) ; make sure "run" is turned on
-
-(with-threaded-sound (:statistics #t :output "thread.snd")
- (pins 0 20 "oboe.snd" 1.0 1.5 10.0) ; from clm-ins.scm
- (pins 1 20 "oboe.snd" 1.0 1.5 10.0)
- (pins 2 20 "oboe.snd" 1.0 1.5 10.0)
- (pins 3 20 "oboe.snd" 1.0 1.5 10.0)
- (pins 4 20 "oboe.snd" 1.0 1.5 10.0)
- (pins 5 20 "oboe.snd" 1.0 1.5 10.0)
- (pins 6 20 "oboe.snd" 1.0 1.5 10.0)
- (pins 7 20 "oboe.snd" 1.0 1.5 10.0))
-</pre>
-
-<p>
-If the notelist is made up of very short notes (so that most the time is in the instrument setup, and
-not in the run macro), there's little gained by using threads; since the threads share one heap,
-cell allocations become a bottleneck. I have used with-threaded-sound on 2, 8, and 16 core machines.
-In the best cases, I see speed up factors of more or less n - 1 (14.8 times faster in the 16-core case, for example,
-where the process monitor program shows all 16 cores running at better than 95%). Now for 32...
-</p>
-
-<br>
-<table border=0 bordercolor="lightgreen" width=20% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
- <table width=100% border=0><tr><td bgcolor="#EEFDEE"><h5>with-threaded-channels</h5></td></tr></table>
-</td></tr></table>
-
-<p><a name="withthreadedchannels">with-threaded-channels</a>
-is a related experiment in multithreading. It applies 'func', a function
-of two arguments (the sound and the channel number), to each channel in the sound 'snd',
-using a separate thread for each call.
-</p>
-<pre>
- (with-threaded-channels snd
- (lambda (snd chn)
- (src-channel 2.0 0 #f snd chn)))
</pre>
-<p>Snd does not always handle threads with aplomb. The primary problem is that
-neither Motif nor Gtk is thread-safe, so you have to squelch updates during any
-threaded operation (see with-threaded-channels itself).
-</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>with-mixed-sound</h4></td></tr></table>
-</td></tr></table>
+<div class="innerheader">with-mixed-sound</div>
-<p><a name="withmixedsound">with-mixed-sound</a> is a variant of with-sound that creates a
+<p id="withmixedsound">with-mixed-sound is a variant of with-sound that creates a
<a href="extsnd.html#sndmixes">"mix"</a> for each note in the notelist. If you move the
-mixes around, you can write out the new note list via <a name="withmixedsoundtonotelist">with-mixed-sound->notelist</a>.
+mixes around, you can write out the new note list via with-mixed-sound->notelist.
In multichannel files, all the channels associated with a note are sync'd together, so if you drag one,
the others follow. Also, if you click a mix tag, the corresponding note in the notelist is displayed
-in the minibuffer.
+in the status area.
</p>
-<pre>
- (with-mixed-sound ()
- (fm-violin 0 .1 440 .1)
- (fm-violin 1 .1 660 .1))
- (with-mixed-sound (:channels 2)
- (fm-violin 0 .1 440 .1 :degree 0)
- (fm-violin 1 .1 660 .1 :degree 45))
+<pre class="indented">
+(with-mixed-sound ()
+ (fm-violin 0 .1 440 .1)
+ (fm-violin 1 .1 660 .1))
+
+(with-mixed-sound (:channels 2)
+ (fm-violin 0 .1 440 .1 :degree 0)
+ (fm-violin 1 .1 660 .1 :degree 45))
</pre>
-<p>There's also a quick sound file mixer named mus-mix:
+
+<p>There's also a quick sound file mixer named mus-file-mix:
</p>
-<pre>
- <a class=def name="musmix">mus-mix</a> outfile infile (outloc 0) (frames) (inloc 0) mixer envs
+
+<pre class="indented">
+<em class=def id="musfilemix">mus-file-mix</em> outfile infile (outloc 0) (framples) (inloc 0) mixer envs
</pre>
+
<p>This function
mixes 'infile' into 'outfile' starting at 'outloc' in 'outfile' and 'inloc' in 'infile',
-mixing 'frames' frames into 'outfile'. 'frames' defaults to the length of 'infile'. If 'mixer',
+mixing 'framples' framples into 'outfile'. 'framples' defaults to the length of 'infile'. If 'mixer',
use it to scale the various channels; if 'envs' (an array of envelope generators), use
it in conjunction with mixer to scale and envelope all the various ins and outs.
-'outfile' can also be a <a href="sndclm.html#frametofile">frame->file</a> generator, and 'infile' can be a
-<a href="sndclm.html#filetoframe">file->frame</a> generator.
+'outfile' can also be a <a href="sndclm.html#frampletofile">frample->file</a> generator, and 'infile' can be a
+<a href="sndclm.html#filetoframple">file->frample</a> generator.
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
-(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> ()
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> ()
(fm-violin 0 .1 440 .1)
- (<a class=quiet href="#musmix" onmouseout="UnTip()" onmouseover="Tip(sndscm_musmix_tip)">mus-mix</a> <a class=quiet onmouseout="UnTip()" onmouseover="Tip(sndclm_output_tip)">*output*</a> "oboe.snd")
+ (<a class=quiet href="#musfilemix">mus-file-mix</a> <a class=quiet>*output*</a> "oboe.snd")
(fm-violin .1 .1 660 .1))
-</pre></td></tr></table>
+</pre>
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>with-marked-sound</h4></td></tr></table>
-</td></tr></table>
-<p><a name="withmarkedsound">with-marked-sound</a> is yet another version of with-sound that
+<div class="innerheader">with-marked-sound</div>
+
+<p id="withmarkedsound">with-marked-sound is yet another version of with-sound that
adds a mark at the start of each note.
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>clm-load</h4></td></tr></table>
-</td></tr></table>
+<div class="innerheader">clm-load</div>
-<p><a name="clmload">clm-load</a> provides a slightly different way to load a notelist. Its first argument is a filename, assumed to
+<p>clm-load provides a slightly different way to load a notelist. Its first argument is a filename, assumed to
be a text file containing notes (equivalent to the body of with-sound). The rest of the arguments to clm-load are the usual with-sound arguments, if any.
For example, if we have a file named clm-load-test.clm with these contents:
</p>
-<pre>
- (fm-violin 0 1 440 .1)
- (fm-violin 1 1 660 .1)
+
+<pre class="indented">
+(fm-violin 0 1 440 .1)
+(fm-violin 1 1 660 .1)
</pre>
+
<p>
-then <code>(clm-load "clm-load-test.clm")</code> is the same as <code>(with-sound () (fm-violin 0 1 440 .1) (fm-violin 1 1 660 .1))</code>.
-Similarly for, <code>(clm-load "clm-load-test.clm" :srate 44100 :channels 2)</code> and so on.
+then (clm-load "clm-load-test.clm") is the same as (with-sound () (fm-violin 0 1 440 .1) (fm-violin 1 1 660 .1)).
+Similarly for, (clm-load "clm-load-test.clm" :srate 44100 :channels 2) and so on.
</p>
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>init-with-sound</h4></td></tr></table>
-</td></tr></table>
+<div class="innerheader">init-with-sound</div>
-<p><b>init-with-sound</b> and <b>finish-with-sound</b>
+<p>init-with-sound and finish-with-sound
split with-sound into two pieces, primarily for Common Music's benefit.
</p>
-<pre>
- (define w (init-with-sound :scaled-to .5))
- (fm-violin 0 1 440 .1)
- (finish-with-sound w)
+
+<pre class="indented">
+(define w (init-with-sound :scaled-to .5))
+(fm-violin 0 1 440 .1)
+(finish-with-sound w)
</pre>
+
<p>is equivalent to
</p>
-<pre>
- (<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> (:scaled-to .5)
- (fm-violin 0 1 440 .1))
+
+<pre class="indented">
+(<a class=quiet href="#wsdoc">with-sound</a> (:scaled-to .5)
+ (fm-violin 0 1 440 .1))
</pre>
-<br>
-<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
-<table width="100%" border=0><tr><td bgcolor="#EEFDEE"><h4>other stuff associated with with-sound</h4></td></tr></table>
-</td></tr></table>
-<p>
+<div class="innerheader">other stuff associated with with-sound</div>
+
+<p id="wssavestate">
The *clm-* variables are saved in the save-state
-file by <A NAME="wssavestate">ws-save-state</A>, which may not be a good idea — feedback welcome!
-Two more convenience functions are <b>->frequency</b> and <b>->sample</b>.
-<A NAME="tofrequency">->frequency</A> takes either a number or a common-music pitch symbol ('c4 is middle C),
+file by ws-save-state, which may not be a good idea — feedback welcome!
+Two more convenience functions are ->frequency and ->sample.
+<em class="noem" id="tofrequency">->frequency</em> takes either a number or a common-music pitch symbol ('c4 is middle C),
and returns either the number or the frequency associated with that pitch:
</p>
-<pre>
- <em class=listener>></em> <em class=typing>(->frequency 'cs5)</em>
- <em class=listener>554.365261953744</em>
+
+<pre class="indented">
+> (->frequency 'cs5)
+554.365261953744
</pre>
-<p>It's optional second argument can be #t to get integer ratios, rather than
+
+<p id="tosample">It's optional second argument can be #t to get integer ratios, rather than
the default equal temperment.
-<A NAME="tosample">->sample</A> returns a sample number given a time in seconds:
+->sample returns a sample number given a time in seconds:
</p>
-<pre>
- <em class=listener>></em> <em class=typing>(->sample 1.0)</em>
- <em class=listener>44100</em>
+
+<pre class="indented">
+> (->sample 1.0)
+44100
</pre>
-<p><b>mix-notelists</b> takes any number of notelist arguments,
+
+<p>mix-notelists takes any number of notelist arguments,
and returns a new notelist with all the input notes sorted by begin time.
</p>
-<pre>
+
+<pre class="indented">
(mix-notelists '((fm-violin 0 1 440 .1)
(fm-violin 1 1 550 .1))
'((bird 0 .1 )
@@ -11494,22 +11936,20 @@ and returns a new notelist with all the input notes sorted by begin time.
((bird 0 0.1) (fm-violin 0 1 440 0.1) (bird 0.2 0.1) (bird 0.5 0.5) (fm-violin 1 1 550 0.1) (bird 1.2 0.3))
</pre>
+
-<br>
-<!-- ---------------------------------------- FILE: zip ---------------------------------------- -->
+<!-- FILE: zip -->
-<table border=0 bordercolor="lightgreen" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor="lightgreen">
-<A NAME="zipdoc"></a><table width="100%" border=0><tr><td bgcolor="beige" align="center" valign="middle"><h2>zip</h2></td></tr></table>
-</td></tr></table>
+<div class="header" id="zipdoc">zip</div>
-<table border=0 hspace=20><tr><td bgcolor="#f2f3ff">
-<em class=emdef>make-zipper</em> <code>ramp-env frame-size frame-env</code><br>
-<a class=def name="zipper">zipper</a> <code>gen in1 in2</code><br>
-<a class=def name="zipsound">zip-sound</a> <code>beg dur file1 file2 ramp size</code>
-</td></tr></table>
+<pre class="indented">
+<em class=emdef>make-zipper</em> ramp-env frame-size frame-env
+<em class=def id="zipper">zipper</em> gen in1 in2
+<em class=def id="zipsound">zip-sound</em> beg dur file1 file2 ramp size
+</pre>
<p>The zipper generator performs a kind of cross fade, but not one that
tries to be smooth! It marches through the two sounds taking equal short
@@ -11523,55 +11963,53 @@ The following function sets up two sounds,
an upward ramp and a downward ramp, then zips them together:
</p>
-<table border=0 cellpadding=5 hspace=20><tr><td><pre>
+<pre class="indented">
(define (ramp-test)
- (let ((data (<a class=quiet href="extsnd.html#makevct" onmouseout="UnTip()" onmouseover="Tip(extsnd_makevct_tip)">make-vct</a> 10000)))
- (<a class=quiet href="extsnd.html#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "new-0.snd")
- (do ((i 0 (+ 1 i))) ((= i 10000))
+ (let ((data (make-float-vector 10000 0.0)))
+ (<a class=quiet href="extsnd.html#newsound">new-sound</a> "new-0.snd")
+ (do ((i 0 (+ i 1))) ((= i 10000))
(set! (data i) (* i .0001)))
- (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> data 0 10000 0)
- (<a class=quiet href="extsnd.html#newsound" onmouseout="UnTip()" onmouseover="Tip(extsnd_newsound_tip)">new-sound</a> "new-1.snd")
- (do ((i 0 (+ 1 i))) ((= i 10000))
+ (float-vector->channel data 0 10000 0)
+ (<a class=quiet href="extsnd.html#newsound">new-sound</a> "new-1.snd")
+ (do ((i 0 (+ i 1))) ((= i 10000))
(set! (data i) (- 1.0 (* i .0001))))
- (<a class=quiet href="extsnd.html#vcttochannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_vcttochannel_tip)">vct->channel</a> data 0 10000 1)
- (let* ((dur (<a class=quiet href="extsnd.html#frames" onmouseout="UnTip()" onmouseover="Tip(extsnd_frames_tip)">frames</a>))
- (zp (<em class=red>make-zipper</em> (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> '(0 0 1 1) :length dur)
+ (float-vector->channel data 0 10000 1)
+ (let* ((dur (<a class=quiet href="extsnd.html#framples">framples</a>))
+ (zp (<em class=red>make-zipper</em> (<a class=quiet href="sndclm.html#make-env">make-env</a> '(0 0 1 1) :length dur)
0.05
- (<a class=quiet href="sndclm.html#make-env" onmouseout="UnTip()" onmouseover="Tip(sndclm_make_env_tip)">make-env</a> (list 0 (* (<a class=quiet href="extsnd.html#srate" onmouseout="UnTip()" onmouseover="Tip(extsnd_srate_tip)">srate</a>) 0.05)) :length dur)))
- (reader0 (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0 0 0))
- (reader1 (<a class=quiet href="extsnd.html#makesampler" onmouseout="UnTip()" onmouseover="Tip(extsnd_makesampler_tip)">make-sampler</a> 0 1 0)))
- (<a class=quiet href="extsnd.html#mapchannel" onmouseout="UnTip()" onmouseover="Tip(extsnd_mapchannel_tip)">map-channel</a> (lambda (val) (<em class=red>zipper</em> zp reader0 reader1))))))
-</pre></td></tr></table>
-
-<br>
-<img src="pix/zramp.png" alt="zipper ramp output" hspace=20>
+ (<a class=quiet href="sndclm.html#make-env">make-env</a> (list 0 (* (<a class=quiet href="extsnd.html#srate">srate</a>) 0.05)) :length dur)))
+ (reader0 (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0 0 0))
+ (reader1 (<a class=quiet href="extsnd.html#makesampler">make-sampler</a> 0 1 0)))
+ (<a class=quiet href="extsnd.html#mapchannel">map-channel</a> (lambda (val) (<em class=red>zipper</em> zp reader0 reader1))))))
+</pre>
+
+
+<img class="indented" src="pix/zramp.png" alt="zipper ramp output">
<p>Needless to say, this is not intended to be a suave, romantic gesture!
</p>
<p>zip-sound applies the zipper to a pair of sounds:
</p>
-<pre>
- (zip-sound 0 1 "fyow.snd" "now.snd" '(0 0 1 1) .05)
- (zip-sound 0 3 "mb.snd" "fyow.snd" '(0 0 1.0 0 1.5 1.0 3.0 1.0) .025)
+
+<pre class="indented">
+(zip-sound 0 1 "fyow.snd" "now.snd" '(0 0 1 1) .05)
+(zip-sound 0 3 "mb.snd" "fyow.snd" '(0 0 1.0 0 1.5 1.0 3.0 1.0) .025)
</pre>
-<br>
-<center>
-<table bgcolor="aliceblue" border=0 cellspacing=8><tr>
-<td><small>related documentation:</small></td>
-<td><small><a href="snd.html" onmouseout="UnTip()" onmouseover="Tip(snd_html_tip)">snd.html</a></small></td>
-<td><small><a href="extsnd.html" onmouseout="UnTip()" onmouseover="Tip(extsnd_html_tip)">extsnd.html</a></small></td>
-<td><small><a href="grfsnd.html" onmouseout="UnTip()" onmouseover="Tip(grfsnd_html_tip)">grfsnd.html</a></small></td>
-<td><small><a href="sndclm.html" onmouseout="UnTip()" onmouseover="Tip(sndclm_html_tip)">sndclm.html</a></small></td>
-<td><small><a href="sndlib.html" onmouseout="UnTip()" onmouseover="Tip(sndlib_html_tip)">sndlib.html</a></small></td>
-<td><small><a href="libxm.html" onmouseout="UnTip()" onmouseover="Tip(libxm_html_tip)">libxm.html</a></small></td>
-<td><small><a href="fm.html" onmouseout="UnTip()" onmouseover="Tip(fm_html_tip)">fm.html</a></small></td>
-<td><small><a href="s7.html" onmouseout="UnTip()" onmouseover="Tip(s7_html_tip)">s7.html</a></small></td>
-<td><small><a href="index.html" onmouseout="UnTip()" onmouseover="Tip(index_html_tip)">index.html</a></small></td>
-</tr></table>
-</center>
+
+<div class="related">
+related documentation:
+<a href="snd.html">snd.html </a>
+<a href="extsnd.html">extsnd.html </a>
+<a href="grfsnd.html">grfsnd.html </a>
+<a href="sndclm.html">sndclm.html </a>
+<a href="sndlib.html">sndlib.html </a>
+<a href="fm.html">fm.html </a>
+<a href="s7.html">s7.html </a>
+<a href="index.html">index.html</a>
+</div>
</body>
</html>
diff --git a/sndwarp.scm b/sndwarp.scm
index e43458e..f71de0a 100644
--- a/sndwarp.scm
+++ b/sndwarp.scm
@@ -1,6 +1,7 @@
;;; SNDWARP
(provide 'snd-sndwarp.scm)
+(if (not (provided? 'snd-env.scm)) (load "env.scm")) ; normalize-envelope
;;;
;;; CLM 3 implementation of Richard Karpen's SNDWARP Csound Ugen.
@@ -151,9 +152,9 @@
(let* ((stereo-i (= (mus-sound-chans file) 2))
(stereo-o #f) ; (= (channels *output*) 2))
(f-a (make-readin file :channel 0))
- (f-b (if stereo-i (make-readin file :channel 1) #f)) ; explicit #f needed here for optimizer
+ (f-b (and stereo-i (make-readin file :channel 1)))
(fsr (mus-sound-srate file))
- ;; (fsize (frames file))
+ ;; (fsize (framples file))
(fdur (mus-sound-duration file))
(rev-val rev)
(loc-env (clmsw-envelope-or-number loc))
@@ -161,7 +162,7 @@
(time-env (clmsw-envelope-or-number stretch))
(wsize-env (clmsw-envelope-or-number wsize))
(rdA (make-src :input (lambda (dir) (readin f-a)) :srate 0.0 :width srcwidth))
- (rdB (if stereo-i (make-src :input (lambda (dir) (readin f-b)) :srate 0.0 :width srcwidth) #f))
+ (rdB (and stereo-i (make-src :input (lambda (dir) (readin f-b)) :srate 0.0 :width srcwidth)))
(windf (make-oscil))
(wsizef (make-env wsize-env :duration dur))
(ampf (make-env amp-env :scaler amp :duration dur))
@@ -178,7 +179,7 @@
(overlap-ratio-compl 0.0)
(outa-val 0.0)
(outb-val 0.0))
- (run
+
(do ((overlap 0 (+ 1 overlap)))
((or eow-flag (= overlap overlaps)))
(set! overlap-ratio (/ overlap overlaps))
@@ -193,7 +194,7 @@
(set! (mus-location sratef) writestart)
(set! (mus-location wsizef) writestart)
(set! wsize (env wsizef))
- (let* ((winlen (if (and (= overlap 0) (= section 0)) ; first section of first overlap isn't randomized
+ (let* ((winlen (if (= overlap 0 section) ; first section of first overlap isn't randomized
wsize
(+ wsize (random randw))))
(winsamps (seconds->samples winlen))
@@ -242,9 +243,8 @@
(round (* winlen overlap-ratio-compl)))
;; Alternative style - start each overlap series at 0
0)))
- (begin
- (set! readstart (round (* fsr (+ inputbeg init-read-start))))
- (if (not (= overlap 0)) (set! winsamps (floor (* winsamps overlap-ratio))))))
+ (set! readstart (round (* fsr (+ inputbeg init-read-start))))
+ (if (not (= overlap 0)) (set! winsamps (floor (* winsamps overlap-ratio)))))
;; remaining sections
(set! readstart (round (+ readstart (* fsr (/ winlen time-val)))))))
;; Set readin position and sampling rate
@@ -258,7 +258,7 @@
(mus-reset rdB)))
;; Write window out
(do ((k 0 (+ 1 k))
- (i writestart (+ 1 i)))
+ (i writestart (+ i 1)))
((or eow-flag (= k winsamps)))
(if (> i end)
(begin
@@ -293,12 +293,12 @@
(begin
(outb i outb-val)
(if *reverb* (outa i (* rev-val outa-val) *reverb*)))))))
- (if (not eow-flag )
- (begin
- ;; For first section, have to backup readstart
- (if (and (= section 0) (> overlap 0) (not time-ptr))
- (set! readstart (- readstart (round (* fsr winlen overlap-ratio-compl)))))))
- (set! writestart (+ writestart winsamps)))))))))
+ (if (and (not eow-flag) ;; For first section, have to backup readstart
+ (= section 0)
+ (> overlap 0)
+ (not time-ptr))
+ (set! readstart (- readstart (round (* fsr winlen overlap-ratio-compl)))))
+ (set! writestart (+ writestart winsamps))))))))
diff --git a/sound.c b/sound.c
index 770c599..ea557fb 100644
--- a/sound.c
+++ b/sound.c
@@ -1,4 +1,4 @@
-#include <mus-config.h>
+#include "mus-config.h"
#if USE_SND
#include "snd.h"
@@ -14,73 +14,32 @@
#include <time.h>
#include <stdarg.h>
-#if (HAVE_LIBC_H && (!HAVE_UNISTD_H))
- #include <libc.h>
+#ifndef _MSC_VER
+ #include <unistd.h>
#else
- #if (!(defined(_MSC_VER)))
- #include <unistd.h>
- #endif
- #if HAVE_STRING_H
- #include <string.h>
- #endif
-#endif
-#if HAVE_PTHREAD_H
- #include <pthread.h>
+ #include <io.h>
+ #pragma warning(disable: 4244)
#endif
+#include <string.h>
#include "_sndlib.h"
#include "sndlib-strings.h"
-/* mus_error handling is tricky enough without threads! We have to keep the previous handlers
- * intact within each thread, then in mus_error itself, ask the thread what its current
- * error handler is.
- */
-
-#if HAVE_PTHREADS
-static pthread_key_t mus_thread_error_handler;
-static pthread_key_t mus_thread_previous_error_handler;
-#else
static mus_error_handler_t *mus_error_handler = NULL;
-#endif
mus_error_handler_t *mus_error_set_handler(mus_error_handler_t *new_error_handler)
{
mus_error_handler_t *old_handler;
-#if HAVE_PTHREADS
- old_handler = (mus_error_handler_t *)pthread_getspecific(mus_thread_error_handler);
- pthread_setspecific(mus_thread_error_handler, (void *)new_error_handler);
- pthread_setspecific(mus_thread_previous_error_handler, (void *)old_handler);
-#else
old_handler = mus_error_handler;
mus_error_handler = new_error_handler;
-#endif
return(old_handler);
}
-#if HAVE_PTHREADS
-
-void mus_thread_restore_error_handler(void)
-{
- pthread_setspecific(mus_thread_error_handler, (void *)mus_error_set_handler((mus_error_handler_t *)pthread_getspecific(mus_thread_previous_error_handler)));
-}
-
-
-mus_error_handler_t *mus_thread_get_previous_error_handler(void)
-{
- return((mus_error_handler_t *)pthread_getspecific(mus_thread_previous_error_handler));
-}
-#endif
-
-
static char *mus_error_buffer = NULL;
static int mus_error_buffer_size = 1024;
-#if HAVE_PTHREADS
- static mus_lock_t sound_error_lock = MUS_LOCK_INITIALIZER;
-#endif
-
int mus_error(int error, const char *format, ...)
{
int bytes_needed = 0;
@@ -89,8 +48,6 @@ int mus_error(int error, const char *format, ...)
if (format == NULL)
return(MUS_ERROR); /* else bus error in Mac OSX */
- MUS_LOCK(&sound_error_lock);
-
if (mus_error_buffer == NULL)
mus_error_buffer = (char *)calloc(mus_error_buffer_size, sizeof(char));
@@ -99,12 +56,7 @@ int mus_error(int error, const char *format, ...)
/* can't use vasprintf here or below because the error handler may jump anywhere,
* leaving unfreed memory behind.
*/
-
-#if HAVE_VSNPRINTF
bytes_needed = vsnprintf(mus_error_buffer, mus_error_buffer_size, format, ap);
-#else
- bytes_needed = vsprintf(mus_error_buffer, format, ap);
-#endif
va_end(ap);
if (bytes_needed >= mus_error_buffer_size)
@@ -112,39 +64,20 @@ int mus_error(int error, const char *format, ...)
mus_error_buffer_size = bytes_needed * 2;
free(mus_error_buffer);
mus_error_buffer = (char *)calloc(mus_error_buffer_size, sizeof(char));
+
va_start(ap, format);
-#if HAVE_VSNPRINTF
vsnprintf(mus_error_buffer, mus_error_buffer_size, format, ap);
-#else
- vsprintf(mus_error_buffer, format, ap);
-#endif
va_end(ap);
}
-#if HAVE_PTHREADS
- MUS_UNLOCK(&sound_error_lock);
- {
- mus_error_handler_t *mus_error_handler;
- mus_error_handler = (mus_error_handler_t *)pthread_getspecific(mus_thread_error_handler);
-#endif
-
if (mus_error_handler)
(*mus_error_handler)(error, mus_error_buffer);
else
{
-#if USE_SND && HAVE_PTHREADS
- /* thread local error handler isn't set up with the default error handler so... */
- mus_error_to_snd(error, mus_error_buffer);
-#else
fprintf(stderr, "%s", mus_error_buffer);
fputc('\n', stderr);
-#endif
}
-#if HAVE_PTHREADS
- }
-#endif
-
return(MUS_ERROR);
}
@@ -160,11 +93,6 @@ mus_print_handler_t *mus_print_set_handler(mus_print_handler_t *new_print_handle
}
-#if HAVE_PTHREADS
- static mus_lock_t sound_print_lock = MUS_LOCK_INITIALIZER;
-#endif
-
-
void mus_print(const char *format, ...)
{
va_list ap;
@@ -173,34 +101,24 @@ void mus_print(const char *format, ...)
{
int bytes_needed = 0;
- MUS_LOCK(&sound_print_lock);
-
if (mus_error_buffer == NULL)
mus_error_buffer = (char *)calloc(mus_error_buffer_size, sizeof(char));
va_start(ap, format);
-#if HAVE_VSNPRINTF
bytes_needed = vsnprintf(mus_error_buffer, mus_error_buffer_size, format, ap);
-#else
- bytes_needed = vsprintf(mus_error_buffer, format, ap);
-#endif
va_end(ap);
+
if (bytes_needed >= mus_error_buffer_size)
{
mus_error_buffer_size = bytes_needed * 2;
free(mus_error_buffer);
mus_error_buffer = (char *)calloc(mus_error_buffer_size, sizeof(char));
+
va_start(ap, format);
-#if HAVE_VSNPRINTF
vsnprintf(mus_error_buffer, mus_error_buffer_size, format, ap);
-#else
- vsprintf(mus_error_buffer, format, ap);
-#endif
va_end(ap);
}
- MUS_UNLOCK(&sound_print_lock);
-
(*mus_print_handler)(mus_error_buffer);
}
else
@@ -212,77 +130,37 @@ void mus_print(const char *format, ...)
}
-static const char *mus_initial_error_names[MUS_INITIAL_ERROR_TAG] = {
+static const char *mus_error_names[MUS_NUM_ERRORS] = {
"no error", "no frequency method", "no phase method", "null gen arg to method", "no length method",
- "no free method", "no describe method", "no data method", "no scaler method",
- "memory allocation failed", "unstable two pole error",
+ "no describe method", "no data method", "no scaler method",
+ "memory allocation failed",
"can't open file", "no sample input", "no sample output",
"no such channel", "no file name provided", "no location method", "no channel method",
- "no such fft window", "unsupported data format", "header read failed",
- "unsupported header type", "file descriptors not initialized", "not a sound file", "file closed", "write error",
+ "no such fft window", "unknown sample type", "header read failed",
+ "unknown header type", "file descriptors not initialized", "not a sound file", "file closed", "write error",
"header write failed", "can't open temp file", "interrupted", "bad envelope",
- "audio channels not available", "audio srate not available", "audio format not available",
+ "audio channels not available", "audio srate not available", "audio sample type not available",
"no audio input available", "audio configuration not available",
"audio write error", "audio size not available", "audio device not available",
"can't close audio", "can't open audio", "audio read error",
"can't write audio", "can't read audio", "no audio read permission",
- "can't close file", "arg out of range", "wrong type arg",
+ "can't close file", "arg out of range",
"no channels method", "no hop method", "no width method", "no file-name method", "no ramp method", "no run method",
"no increment method", "no offset method",
"no xcoeff method", "no ycoeff method", "no xcoeffs method", "no ycoeffs method", "no reset", "bad size", "can't convert",
- "read error", "no safety method"
+ "read error",
+ "no feedforward method", "no feedback method", "no interp-type method", "no position method", "no order method", "no copy method",
+ "can't translate"
};
-static char **mus_error_names = NULL;
-static int mus_error_names_size = 0;
-static int mus_error_tag = MUS_INITIAL_ERROR_TAG;
-
-int mus_make_error(const char *error_name)
-{
- int new_error, err;
- new_error = mus_error_tag++;
- err = new_error - MUS_INITIAL_ERROR_TAG;
- if (error_name)
- {
- int len, i;
- if (err >= mus_error_names_size)
- {
- if (mus_error_names_size == 0)
- {
- mus_error_names_size = 8;
- mus_error_names = (char **)calloc(mus_error_names_size, sizeof(char *));
- }
- else
- {
- len = mus_error_names_size;
- mus_error_names_size += 8;
- mus_error_names = (char **)realloc(mus_error_names, mus_error_names_size * sizeof(char *));
- for (i = len; i < mus_error_names_size; i++) mus_error_names[i] = NULL;
- }
- }
- len = strlen(error_name);
- mus_error_names[err] = (char *)calloc(len + 1, sizeof(char));
- strcpy(mus_error_names[err], error_name);
- }
- return(new_error);
-}
-
const char *mus_error_type_to_string(int err)
{
- if (err >= 0)
- {
- if (err < MUS_INITIAL_ERROR_TAG)
- return(mus_initial_error_names[err]);
- else
- {
- err -= MUS_INITIAL_ERROR_TAG;
- if ((mus_error_names) && (err < mus_error_names_size))
- return(mus_error_names[err]);
- }
- }
+ if ((err >= 0) &&
+ (err < MUS_NUM_ERRORS))
+ return(mus_error_names[err]);
return("unknown mus error");
}
@@ -304,48 +182,59 @@ static time_t local_file_write_date(const char *filename)
}
-int mus_sample_bits(void)
-{
- /* this to check for inconsistent loads */
-#if SNDLIB_USE_FLOATS
- return(sizeof(mus_float_t));
-#else
- return(MUS_SAMPLE_BITS);
-#endif
-}
-
/* -------- sound file table -------- */
-typedef struct {
+typedef struct sound_file {
char *file_name; /* full path -- everything is keyed to this name */
- int table_pos;
+ int table_pos, file_name_length, table_index;
mus_long_t *aux_comment_start, *aux_comment_end;
int *loop_modes, *loop_starts, *loop_ends;
int markers, base_detune, base_note;
int *marker_ids, *marker_positions;
mus_long_t samples, true_file_length;
mus_long_t data_location;
- int srate, chans, header_type, data_format, original_sound_format, datum_size;
+ int srate, chans, original_sound_samp_type, datum_size;
+ mus_header_t header_type;
+ mus_sample_t sample_type;
mus_long_t comment_start, comment_end;
int type_specifier, bits_per_sample, block_align, fact_samples;
time_t write_date;
- mus_sample_t *maxamps;
+ mus_float_t *maxamps;
mus_long_t *maxtimes;
+ int maxamps_size; /* we can't depend on sf->chans here because the user could set chans to some bogus value */
+ mus_float_t **saved_data;
+ struct sound_file *next;
} sound_file;
-static int sound_table_size = 0;
-static sound_file **sound_table = NULL;
-#if HAVE_PTHREADS
- static mus_lock_t sound_table_lock = MUS_LOCK_INITIALIZER;
-#endif
+static int *sound_table_sizes = NULL;
+static sound_file ***sound_tables = NULL;
+#define NUM_SOUND_TABLES 64
+
+/* it's not enough to hash on the file name length -- they're nearly all the same length!
+ * I think I'll try taking the last few chars instead (the first 15-20 chars are
+ * also always the same: the tmp directory, eg: /home/bil/zap/tmp/snd_16687_632.snd).
+ */
+
+static int sound_file_hash_index(const char *name, int len)
+{
+ unsigned char *s;
+ if (!name) return(0);
+ if (len < 8) return(len);
+ s = (unsigned char *)(name + len - 8);
+ return((s[0] + s[1] + s[2] + s[3]) % NUM_SOUND_TABLES);
+}
+
+void scan_io_fds_for_saved_data(mus_float_t **data);
+
+static sound_file *sf_free_list = NULL;
static void free_sound_file(sound_file *sf)
{
if (sf)
{
- sound_table[sf->table_pos] = NULL;
+ sound_tables[sf->table_index][sf->table_pos] = NULL;
if (sf->aux_comment_start) free(sf->aux_comment_start);
if (sf->aux_comment_end) free(sf->aux_comment_end);
if (sf->file_name) free(sf->file_name);
@@ -356,15 +245,34 @@ static void free_sound_file(sound_file *sf)
if (sf->marker_positions) free(sf->marker_positions);
if (sf->maxamps) free(sf->maxamps);
if (sf->maxtimes) free(sf->maxtimes);
- free(sf);
+ sf->maxamps_size = 0;
+ if (sf->saved_data)
+ {
+ int i;
+ scan_io_fds_for_saved_data(sf->saved_data);
+ for (i = 0; i < sf->chans; i++)
+ if (sf->saved_data[i])
+ free(sf->saved_data[i]);
+ free(sf->saved_data);
+ sf->saved_data = NULL;
+ }
+ /* free(sf); */
+ sf->next = sf_free_list;
+ sf_free_list = sf;
}
}
static sound_file *add_to_sound_table(const char *name)
{
- int i, pos = -1;
+ int i, len, pos = -1, index, sound_table_size;
+ sound_file **sound_table;
+ sound_file *sf;
- /* this is already within sound_table_lock */
+ len = strlen(name);
+ index = sound_file_hash_index(name, len);
+
+ sound_table = sound_tables[index];
+ sound_table_size = sound_table_sizes[index];
for (i = 0; i < sound_table_size; i++)
if (sound_table[i] == NULL)
@@ -378,39 +286,58 @@ static sound_file *add_to_sound_table(const char *name)
pos = sound_table_size;
sound_table_size += 16;
if (sound_table == NULL)
- sound_table = (sound_file **)calloc(sound_table_size, sizeof(sound_file *));
+ {
+ sound_table = (sound_file **)calloc(sound_table_size, sizeof(sound_file *));
+ }
else
{
sound_table = (sound_file **)realloc(sound_table, sound_table_size * sizeof(sound_file *));
for (i = pos; i < sound_table_size; i++) sound_table[i] = NULL;
}
+ sound_tables[index] = sound_table;
+ sound_table_sizes[index] = sound_table_size;
}
- sound_table[pos] = (sound_file *)calloc(1, sizeof(sound_file));
- sound_table[pos]->table_pos = pos;
- sound_table[pos]->file_name = (char *)calloc(strlen(name) + 1, sizeof(char));
- strcpy(sound_table[pos]->file_name, name);
-
- return(sound_table[pos]);
+ if (sf_free_list)
+ {
+ sf = sf_free_list;
+ sf_free_list = sf->next;
+ memset((void *)sf, 0, sizeof(sound_file));
+ }
+ else sf = (sound_file *)calloc(1, sizeof(sound_file));
+ sound_table[pos] = sf;
+ sf->table_pos = pos;
+ sf->table_index = index;
+ sf->file_name = (char *)malloc((len + 1) * sizeof(char));
+ strcpy(sf->file_name, name);
+ sf->file_name[len] = 0;
+ sf->file_name_length = len;
+ sf->saved_data = NULL;
+ return(sf);
}
int mus_sound_prune(void)
{
- int i, pruned = 0;
+ int j, pruned = 0;
- MUS_LOCK(&sound_table_lock);
+ for (j = 0; j < NUM_SOUND_TABLES; j++)
+ {
+ int i, sound_table_size;
+ sound_file **sound_table;
- for (i = 0; i < sound_table_size; i++)
- if ((sound_table[i]) &&
- (!(mus_file_probe(sound_table[i]->file_name))))
- {
- free_sound_file(sound_table[i]);
- sound_table[i] = NULL;
- pruned++;
- }
+ sound_table = sound_tables[j];
+ sound_table_size = sound_table_sizes[j];
- MUS_UNLOCK(&sound_table_lock);
+ for (i = 0; i < sound_table_size; i++)
+ if ((sound_table[i]) &&
+ (!(mus_file_probe(sound_table[i]->file_name))))
+ {
+ free_sound_file(sound_table[i]);
+ sound_table[i] = NULL;
+ pruned++;
+ }
+ }
return(pruned);
}
@@ -418,13 +345,23 @@ int mus_sound_prune(void)
int mus_sound_forget(const char *name)
{
- int i, len;
+ /* apparently here we want to forget either name or the expanded or contracted forms of name -- as many as we find! */
+ int i, len, len2, short_len = 0;
bool free_name = false;
char *short_name = NULL;
+ sound_file **sound_table;
+ int sound_table_size, index;
+ char c;
+
if (name == NULL) return(MUS_ERROR);
+ len = strlen(name);
+ if (len > 6)
+ len2 = len - 6;
+ else len2 = len / 2;
+ c = name[len2];
+
if (name[0] == '/')
{
- len = strlen(name);
for (i = 0; i < len; i++)
if (name[i] == '/')
short_name = (char *)(name + i + 1);
@@ -434,22 +371,43 @@ int mus_sound_forget(const char *name)
short_name = mus_expand_filename(name);
free_name = true;
}
+ if (short_name)
+ short_len = strlen(short_name);
- if (name)
+ index = sound_file_hash_index(name, len);
+ sound_table = sound_tables[index];
+ sound_table_size = sound_table_sizes[index];
+
+ for (i = 0; i < sound_table_size; i++)
+ if ((sound_table[i]) &&
+ (sound_table[i]->file_name_length == len) &&
+ (sound_table[i]->file_name[len2] == c) &&
+ (mus_strcmp(name, sound_table[i]->file_name)))
+ {
+ free_sound_file(sound_table[i]);
+ sound_table[i] = NULL;
+ }
+
+ if (short_name)
{
- MUS_LOCK(&sound_table_lock);
+ if (short_len > 6)
+ len2 = short_len - 6;
+ else len2 = short_len / 2;
+ c = short_name[len2];
+
+ index = sound_file_hash_index(short_name, short_len);
+ sound_table = sound_tables[index];
+ sound_table_size = sound_table_sizes[index];
for (i = 0; i < sound_table_size; i++)
if ((sound_table[i]) &&
- ((strcmp(name, sound_table[i]->file_name) == 0) ||
- ((short_name) &&
- (strcmp(short_name, sound_table[i]->file_name) == 0))))
+ (sound_table[i]->file_name_length == short_len) &&
+ (sound_table[i]->file_name[len2] == c) &&
+ (mus_strcmp(short_name, sound_table[i]->file_name)))
{
free_sound_file(sound_table[i]);
sound_table[i] = NULL;
}
-
- MUS_UNLOCK(&sound_table_lock);
}
if (free_name) free(short_name);
@@ -463,30 +421,28 @@ static sound_file *check_write_date(const char *name, sound_file *sf)
{
time_t date;
date = local_file_write_date(name);
-
if (date == sf->write_date)
return(sf);
- else
+
+ if ((sf->header_type == MUS_RAW) && (mus_header_no_header(name)))
{
- if ((sf->header_type == MUS_RAW) && (mus_header_no_header(name)))
- {
- int chan;
- mus_long_t data_size;
- /* sound has changed since we last read it, but it has no header, so
- * the only sensible thing to check is the new length (i.e. caller
- * has set other fields by hand)
- */
- sf->write_date = date;
- chan = mus_file_open_read(name);
- data_size = lseek(chan, 0L, SEEK_END);
- sf->true_file_length = data_size;
- sf->samples = mus_bytes_to_samples(sf->data_format, data_size);
- CLOSE(chan, name);
- return(sf);
- }
- /* otherwise our data base is out-of-date, so clear it out */
- free_sound_file(sf);
+ int chan;
+ mus_long_t data_size;
+ /* sound has changed since we last read it, but it has no header, so
+ * the only sensible thing to check is the new length (i.e. caller
+ * has set other fields by hand)
+ */
+ sf->write_date = date;
+ chan = mus_file_open_read(name);
+ data_size = lseek(chan, 0L, SEEK_END);
+ sf->true_file_length = data_size;
+ sf->samples = mus_bytes_to_samples(sf->sample_type, data_size);
+ CLOSE(chan, name);
+
+ return(sf);
}
+ /* otherwise our data base is out-of-date, so clear it out */
+ free_sound_file(sf);
}
return(NULL);
}
@@ -494,18 +450,32 @@ static sound_file *check_write_date(const char *name, sound_file *sf)
static sound_file *find_sound_file(const char *name)
{
- int i;
-
- if (!name) return(NULL);
-
- for (i = 0; i < sound_table_size; i++)
- if ((sound_table[i]) &&
- (strcmp(name, sound_table[i]->file_name) == 0))
- {
- check_write_date(name, sound_table[i]);
- return(sound_table[i]);
- }
+ /* assume name != NULL */
+ int i, len, len2;
+ sound_file **sound_table;
+ int sound_table_size, index;
+ char c;
+
+ len = strlen(name);
+ if (len > 6)
+ len2 = len - 6; /* the names probably all start with '/' and end with ".snd", so try to find a changing character... */
+ else len2 = len / 2;
+ c = name[len2];
+
+ index = sound_file_hash_index(name, len);
+ sound_table = sound_tables[index];
+ sound_table_size = sound_table_sizes[index];
+ for (i = 0; i < sound_table_size; i++)
+ {
+ sound_file *sf;
+ sf = sound_table[i];
+ if ((sf) &&
+ (sf->file_name_length == len) &&
+ (c == sf->file_name[len2]) &&
+ (strcmp(name, sf->file_name) == 0))
+ return(check_write_date(name, sf));
+ }
return(NULL);
}
@@ -513,29 +483,21 @@ static sound_file *find_sound_file(const char *name)
static void display_sound_file_entry(FILE *fp, const char *name, sound_file *sf)
{
#define TIME_BUFFER_SIZE 64
- int i, lim;
time_t date;
char timestr[TIME_BUFFER_SIZE];
- char *comment;
date = sf->write_date;
if (date != 0)
- {
-#if HAVE_STRFTIME
- strftime(timestr, TIME_BUFFER_SIZE, "%a %d-%b-%Y %H:%M:%S", localtime(&date));
-#else
- snprintf(timestr, TIME_BUFFER_SIZE, "%d", (int)date);
-#endif
- }
+ strftime(timestr, TIME_BUFFER_SIZE, "%a %d-%b-%Y %H:%M:%S", localtime(&date));
else snprintf(timestr, TIME_BUFFER_SIZE, "(date cleared)");
- fprintf(fp, " %s: %s, chans: %d, srate: %d, type: %s, format: %s, samps: " MUS_LD,
+ fprintf(fp, " %s: %s, chans: %d, srate: %d, header: %s, data: %s, samps: %lld",
name,
timestr,
sf->chans,
sf->srate,
mus_header_type_name(sf->header_type),
- mus_data_format_name(sf->data_format),
+ mus_sample_type_name(sf->sample_type),
sf->samples);
if (sf->loop_modes)
@@ -549,16 +511,19 @@ static void display_sound_file_entry(FILE *fp, const char *name, sound_file *sf)
if (sf->maxamps)
{
- lim = sf->chans;
+ int lim;
+ lim = sf->maxamps_size;
if (lim > 0)
{
+ int i;
if (lim > 64)
lim = 64;
+ fprintf(fp, ", maxamp:");
for (i = 0; i < lim; i++)
{
if (i > 1) fprintf(fp, ", ");
fprintf(fp, " %.3f at %.3f ",
- MUS_SAMPLE_TO_FLOAT(sf->maxamps[i]),
+ sf->maxamps[i],
(sf->srate > 0) ? (float)((double)(sf->maxtimes[i]) / (double)(sf->srate)) : (float)(sf->maxtimes[i]));
}
}
@@ -566,6 +531,7 @@ static void display_sound_file_entry(FILE *fp, const char *name, sound_file *sf)
if (mus_file_probe(name))
{
+ char *comment;
comment = mus_sound_comment(name);
if (comment)
{
@@ -582,18 +548,30 @@ void mus_sound_report_cache(FILE *fp)
{
sound_file *sf;
int entries = 0;
- int i;
- fprintf(fp, "sound table:\n");
- for (i = 0; i < sound_table_size; i++)
+ int i, j;
+ sound_file **sound_table;
+
+ fprintf(fp, "sound table:");
+ for (j = 0; j < NUM_SOUND_TABLES; j++)
{
- sf = sound_table[i];
- if (sf)
+ int sound_table_size;
+ sound_table = sound_tables[j];
+ sound_table_size = sound_table_sizes[j];
+
+ for (i = 0; i < sound_table_size; i++)
{
- display_sound_file_entry(fp, sf->file_name, sf);
- entries++;
+ sf = sound_table[i];
+ if (sf)
+ {
+ if (entries == 0) fprintf(fp, "\n");
+ display_sound_file_entry(fp, sf->file_name, sf);
+ entries++;
+ }
}
}
- fprintf(fp, "\nentries: %d\n", entries);
+ if (entries > 0)
+ fprintf(fp, "\nentries: %d\n", entries);
+ else fprintf(fp, " empty");
fflush(fp);
}
@@ -602,18 +580,16 @@ static sound_file *fill_sf_record(const char *name, sound_file *sf)
{
int i;
- /* already locked */
-
sf->data_location = mus_header_data_location();
sf->samples = mus_header_samples();
- sf->data_format = mus_header_format();
+ sf->sample_type = mus_header_sample_type();
sf->srate = mus_header_srate();
/* if (sf->srate < 0) sf->srate = 0; */
sf->chans = mus_header_chans();
/* if (sf->chans < 0) sf->chans = 0; */
- sf->datum_size = mus_bytes_per_sample(sf->data_format);
+ sf->datum_size = mus_bytes_per_sample(sf->sample_type);
sf->header_type = mus_header_type();
- sf->original_sound_format = mus_header_original_format();
+ sf->original_sound_samp_type = mus_header_original_sample_type();
sf->true_file_length = mus_header_true_length();
sf->comment_start = mus_header_comment_start();
@@ -681,268 +657,159 @@ static sound_file *fill_sf_record(const char *name, sound_file *sf)
}
-#if HAVE_PTHREADS
-static mus_error_handler_t *old_header_read_error_handler; /* this should be safe -- only one thread can hold sound_table_lock */
-static mus_error_handler_t *old_previous_header_read_error_handler;
-
-static void sound_table_lock_error_handler(int type, char *msg)
-{
- /* hit error during header read, so reset current error handler to the one we started with, unlock sound_table_lock, pass error to original handler */
-
- /* fprintf(stderr, "hit header error: %d (%s) %s\n", type, mus_error_type_to_string(type), msg); */
-
- pthread_setspecific(mus_thread_error_handler, (void *)old_header_read_error_handler);
- pthread_setspecific(mus_thread_previous_error_handler, (void *)old_previous_header_read_error_handler);
- MUS_UNLOCK(&sound_table_lock);
- mus_error(type, "%s", msg);
-}
-#endif
-
-
static sound_file *read_sound_file_header(const char *name) /* 2 calls on this: mus_sound_open_input and get_sf */
{
int result;
mus_sound_initialize();
-
- /* if threads, sound_table_lock is set at this point, and the header read can throw an error, so
- * we need to unlock while spinning back up the error handler stack. But there are only two
- * levels of error handler saved in the thread-specific data, so we need to make sure to
- * save and restore the current handler by hand, while not messing with the previous handler.
- */
-
-#if HAVE_PTHREADS
- /* save current error handler, reset to sound_table_unlock case... (save both just in case) */
- old_header_read_error_handler = (mus_error_handler_t *)pthread_getspecific(mus_thread_error_handler);
- old_previous_header_read_error_handler = (mus_error_handler_t *)pthread_getspecific(mus_thread_previous_error_handler);
- pthread_setspecific(mus_thread_error_handler, (void *)sound_table_lock_error_handler);
-#endif
-
result = mus_header_read(name);
-
-#if HAVE_PTHREADS
- /* no error, reset current error handler to the one we started with */
- pthread_setspecific(mus_thread_error_handler, (void *)old_header_read_error_handler);
- pthread_setspecific(mus_thread_previous_error_handler, (void *)old_previous_header_read_error_handler);
-#endif
-
/* this portion won't trigger mus_error */
if (result != MUS_ERROR)
return(fill_sf_record(name, add_to_sound_table(name))); /* only call on fill_sf_record and add_to_sound_table */
return(NULL);
}
-
static sound_file *get_sf(const char *arg)
{
sound_file *sf = NULL;
if (arg == NULL) return(NULL);
sf = find_sound_file(arg);
- if (sf) return(sf);
- return(read_sound_file_header(arg));
+ return((sf) ? sf : read_sound_file_header(arg));
}
mus_long_t mus_sound_samples(const char *arg)
{
sound_file *sf;
- mus_long_t result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->samples;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->samples : (mus_long_t)MUS_ERROR);
}
-mus_long_t mus_sound_frames(const char *arg)
+mus_long_t mus_sound_framples(const char *arg)
{
sound_file *sf;
- mus_long_t result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = (sf->chans > 0) ? (sf->samples / sf->chans) : 0;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? ((sf->chans > 0) ? (sf->samples / sf->chans) : 0) : (mus_long_t)MUS_ERROR);
}
int mus_sound_datum_size(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->datum_size;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->datum_size : MUS_ERROR);
}
mus_long_t mus_sound_data_location(const char *arg)
{
sound_file *sf;
- mus_long_t result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->data_location;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->data_location : MUS_ERROR);
}
int mus_sound_chans(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->chans;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->chans : MUS_ERROR);
}
int mus_sound_srate(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->srate;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->srate : MUS_ERROR);
}
-int mus_sound_header_type(const char *arg)
+mus_header_t mus_sound_header_type(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->header_type;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->header_type : MUS_UNKNOWN_HEADER);
}
-int mus_sound_data_format(const char *arg)
+mus_sample_t mus_sound_sample_type(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->data_format;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->sample_type : MUS_UNKNOWN_SAMPLE);
}
-int mus_sound_original_format(const char *arg)
+int mus_sound_original_sample_type(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->original_sound_format;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->original_sound_samp_type : MUS_ERROR);
}
mus_long_t mus_sound_comment_start(const char *arg)
{
sound_file *sf;
- mus_long_t result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->comment_start;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->comment_start : (mus_long_t)MUS_ERROR);
}
mus_long_t mus_sound_comment_end(const char *arg)
{
sound_file *sf;
- mus_long_t result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->comment_end;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->comment_end : (mus_long_t)MUS_ERROR);
}
mus_long_t mus_sound_length(const char *arg)
{
sound_file *sf;
- mus_long_t result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->true_file_length;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->true_file_length : (mus_long_t)MUS_ERROR);
}
int mus_sound_fact_samples(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->fact_samples;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->fact_samples : MUS_ERROR);
}
time_t mus_sound_write_date(const char *arg)
{
sound_file *sf;
- time_t result = (time_t)(MUS_ERROR);
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->write_date;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->write_date : (time_t)MUS_ERROR);
}
int mus_sound_type_specifier(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->type_specifier;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->type_specifier : MUS_ERROR);
}
int mus_sound_block_align(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->block_align;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->block_align : MUS_ERROR);
}
int mus_sound_bits_per_sample(const char *arg)
{
sound_file *sf;
- int result = MUS_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
- if (sf) result = sf->bits_per_sample;
- MUS_UNLOCK(&sound_table_lock);
- return(result);
+ return((sf) ? sf->bits_per_sample : MUS_ERROR);
}
@@ -950,7 +817,6 @@ float mus_sound_duration(const char *arg)
{
float val = -1.0;
sound_file *sf;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
if (sf)
{
@@ -958,15 +824,33 @@ float mus_sound_duration(const char *arg)
val = (float)((double)(sf->samples) / ((float)(sf->chans) * (float)(sf->srate)));
else val = 0.0;
}
- MUS_UNLOCK(&sound_table_lock);
return(val);
}
+mus_float_t **mus_sound_saved_data(const char *arg)
+{
+ /* slightly tricky -- we don't want to trigger a sound_file table entry here!
+ */
+ sound_file *sf;
+ if (arg == NULL) return(NULL);
+ sf = find_sound_file(arg); /* not get_sf which will make an entry in the table */
+ return((sf) ? sf->saved_data : NULL);
+}
+
+
+void mus_sound_set_saved_data(const char *arg, mus_float_t **data)
+{
+ sound_file *sf;
+ sf = get_sf(arg);
+ if (sf)
+ sf->saved_data = data;
+}
+
+
int *mus_sound_loop_info(const char *arg)
{
sound_file *sf;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
if ((sf) && (sf->loop_modes))
{
@@ -986,10 +870,8 @@ int *mus_sound_loop_info(const char *arg)
}
info[4] = sf->base_note;
info[5] = sf->base_detune;
- MUS_UNLOCK(&sound_table_lock);
return(info);
}
- MUS_UNLOCK(&sound_table_lock);
return(NULL);
}
@@ -997,7 +879,6 @@ int *mus_sound_loop_info(const char *arg)
void mus_sound_set_loop_info(const char *arg, int *loop)
{
sound_file *sf;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
if (sf)
{
@@ -1032,7 +913,6 @@ void mus_sound_set_loop_info(const char *arg, int *loop)
sf->base_note = loop[4];
sf->base_detune = loop[5];
}
- MUS_UNLOCK(&sound_table_lock);
}
@@ -1040,7 +920,6 @@ int mus_sound_mark_info(const char *arg, int **mark_ids, int **mark_positions)
{
sound_file *sf;
int result = 0;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
if (sf)
{
@@ -1048,22 +927,18 @@ int mus_sound_mark_info(const char *arg, int **mark_ids, int **mark_positions)
(*mark_positions) = sf->marker_positions;
result = sf->markers;
}
- MUS_UNLOCK(&sound_table_lock);
return(result);
}
char *mus_sound_comment(const char *name)
{
- mus_long_t start, end, len;
char *sc = NULL;
sound_file *sf = NULL;
-
- MUS_LOCK(&sound_table_lock);
-
sf = get_sf(name);
if (sf)
{
+ mus_long_t start, end;
start = sf->comment_start;
end = sf->comment_end;
if (end == 0)
@@ -1086,13 +961,13 @@ char *mus_sound_comment(const char *name)
{
if (end <= sf->true_file_length)
{
+ int len;
len = end - start + 1;
if (len > 0)
{
/* open and get the comment */
ssize_t bytes;
int fd;
- char *auxcom;
fd = mus_file_open_read(name);
if (fd == -1) return(NULL);
lseek(fd, start, SEEK_SET);
@@ -1104,6 +979,7 @@ char *mus_sound_comment(const char *name)
(sf->aux_comment_start) &&
(bytes != 0))
{
+ char *auxcom;
auxcom = mus_header_aiff_aux_comment(name,
sf->aux_comment_start,
sf->aux_comment_end);
@@ -1120,7 +996,6 @@ char *mus_sound_comment(const char *name)
}
}
}
- MUS_UNLOCK(&sound_table_lock);
return(sc);
}
@@ -1129,39 +1004,44 @@ int mus_sound_open_input(const char *arg)
{
int fd = -1;
if (!(mus_file_probe(arg)))
- mus_error(MUS_CANT_OPEN_FILE, S_mus_sound_open_input " can't open %s: %s", arg, STRERROR(errno));
+ mus_error(MUS_CANT_OPEN_FILE, "mus_sound_open_input: can't open %s: %s", arg, STRERROR(errno));
else
{
sound_file *sf = NULL;
mus_sound_initialize();
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
if (sf)
{
fd = mus_file_open_read(arg);
- mus_file_open_descriptors(fd, arg, sf->data_format, sf->datum_size, sf->data_location, sf->chans, sf->header_type);
- lseek(fd, sf->data_location, SEEK_SET);
+ if (fd == -1)
+ mus_error(MUS_CANT_OPEN_FILE, "mus_sound_open_input: can't open %s: %s", arg, STRERROR(errno));
+ else
+ {
+ mus_file_open_descriptors(fd, arg, sf->sample_type, sf->datum_size, sf->data_location, sf->chans, sf->header_type);
+ lseek(fd, sf->data_location, SEEK_SET);
+ if (sf->saved_data)
+ mus_file_save_data(fd, sf->samples / sf->chans, sf->saved_data);
+ }
}
- MUS_UNLOCK(&sound_table_lock);
}
return(fd);
}
-int mus_sound_open_output(const char *arg, int srate, int chans, int data_format, int header_type, const char *comment)
+int mus_sound_open_output(const char *arg, int srate, int chans, mus_sample_t sample_type, mus_header_t header_type, const char *comment)
{
int fd = MUS_ERROR, err;
mus_sound_initialize();
mus_sound_forget(arg);
- err = mus_write_header(arg, header_type, srate, chans, 0, data_format, comment);
+ err = mus_write_header(arg, header_type, srate, chans, 0, sample_type, comment);
if (err != MUS_ERROR)
{
fd = mus_file_open_write(arg);
if (fd != -1)
mus_file_open_descriptors(fd,
arg,
- data_format,
- mus_bytes_per_sample(data_format),
+ sample_type,
+ mus_bytes_per_sample(sample_type),
mus_header_data_location(),
chans,
header_type);
@@ -1170,13 +1050,13 @@ int mus_sound_open_output(const char *arg, int srate, int chans, int data_format
}
-int mus_sound_reopen_output(const char *arg, int chans, int format, int type, mus_long_t data_loc)
+int mus_sound_reopen_output(const char *arg, int chans, mus_sample_t samp_type, mus_header_t type, mus_long_t data_loc)
{
int fd;
mus_sound_initialize();
fd = mus_file_reopen_write(arg);
if (fd != -1)
- mus_file_open_descriptors(fd, arg, format, mus_bytes_per_sample(format), data_loc, chans, type);
+ mus_file_open_descriptors(fd, arg, samp_type, mus_bytes_per_sample(samp_type), data_loc, chans, type);
return(fd);
}
@@ -1193,7 +1073,8 @@ int mus_sound_close_output(int fd, mus_long_t bytes_of_data)
name = mus_file_fd_name(fd);
if (name)
{
- int err = MUS_ERROR, old_type;
+ int err;
+ mus_header_t old_type;
char *fname;
fname = mus_strdup(name);
old_type = mus_file_header_type(fd);
@@ -1208,14 +1089,13 @@ int mus_sound_close_output(int fd, mus_long_t bytes_of_data)
}
-typedef enum {SF_CHANS, SF_SRATE, SF_TYPE, SF_FORMAT, SF_LOCATION, SF_SIZE} sf_field_t;
+typedef enum {SF_CHANS, SF_SRATE, SF_TYPE, SF_SAMP_TYPE, SF_LOCATION, SF_SIZE} sf_field_t;
static int mus_sound_set_field(const char *arg, sf_field_t field, int val)
{
sound_file *sf;
int result = MUS_NO_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
if (sf)
{
@@ -1230,12 +1110,12 @@ static int mus_sound_set_field(const char *arg, sf_field_t field, int val)
break;
case SF_TYPE:
- sf->header_type = val;
+ sf->header_type = (mus_header_t)val;
break;
- case SF_FORMAT:
- sf->data_format = val;
- sf->datum_size = mus_bytes_per_sample(val);
+ case SF_SAMP_TYPE:
+ sf->sample_type = (mus_sample_t)val;
+ sf->datum_size = mus_bytes_per_sample(sf->sample_type);
break;
default:
@@ -1244,7 +1124,6 @@ static int mus_sound_set_field(const char *arg, sf_field_t field, int val)
}
}
else result = MUS_ERROR;
- MUS_UNLOCK(&sound_table_lock);
return(result);
}
@@ -1254,7 +1133,6 @@ static int mus_sound_set_mus_long_t_field(const char *arg, sf_field_t field, mus
sound_file *sf;
int result = MUS_NO_ERROR;
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
if (sf)
{
@@ -1274,43 +1152,40 @@ static int mus_sound_set_mus_long_t_field(const char *arg, sf_field_t field, mus
}
}
else result = MUS_ERROR;
- MUS_UNLOCK(&sound_table_lock);
return(result);
}
-int mus_sound_set_chans(const char *arg, int val) {return(mus_sound_set_field(arg, SF_CHANS, val));}
-int mus_sound_set_srate(const char *arg, int val) {return(mus_sound_set_field(arg, SF_SRATE, val));}
-int mus_sound_set_header_type(const char *arg, int val) {return(mus_sound_set_field(arg, SF_TYPE, val));}
-int mus_sound_set_data_format(const char *arg, int val) {return(mus_sound_set_field(arg, SF_FORMAT, val));}
+int mus_sound_set_chans(const char *arg, int val) {return(mus_sound_set_field(arg, SF_CHANS, val));}
+int mus_sound_set_srate(const char *arg, int val) {return(mus_sound_set_field(arg, SF_SRATE, val));}
+mus_header_t mus_sound_set_header_type(const char *arg, mus_header_t val) {return((mus_header_t)mus_sound_set_field(arg, SF_TYPE, val));}
+mus_sample_t mus_sound_set_sample_type(const char *arg, mus_sample_t val) {return((mus_sample_t)mus_sound_set_field(arg, SF_SAMP_TYPE, val));}
int mus_sound_set_data_location(const char *arg, mus_long_t val) {return(mus_sound_set_mus_long_t_field(arg, SF_LOCATION, val));}
int mus_sound_set_samples(const char *arg, mus_long_t val) {return(mus_sound_set_mus_long_t_field(arg, SF_SIZE, val));}
-int mus_sound_override_header(const char *arg, int srate, int chans, int format, int type, mus_long_t location, mus_long_t size)
+int mus_sound_override_header(const char *arg, int srate, int chans, mus_sample_t samp_type, mus_header_t type, mus_long_t location, mus_long_t size)
{
sound_file *sf;
int result = MUS_NO_ERROR;
/* perhaps once a header has been over-ridden, we should not reset the relevant fields upon re-read? */
- MUS_LOCK(&sound_table_lock);
sf = get_sf(arg);
if (sf)
{
if (location != -1) sf->data_location = location;
if (size != -1) sf->samples = size;
- if (format != -1)
+ if (samp_type != MUS_UNKNOWN_SAMPLE)
{
- sf->data_format = format;
- sf->datum_size = mus_bytes_per_sample(format);
+ sf->sample_type = samp_type;
+ sf->datum_size = mus_bytes_per_sample(samp_type);
}
if (srate != -1) sf->srate = srate;
if (chans != -1) sf->chans = chans;
- if (type != -1) sf->header_type = type;
+ if (type != MUS_UNKNOWN_HEADER) sf->header_type = (mus_header_t)type;
}
else result = MUS_ERROR;
- MUS_UNLOCK(&sound_table_lock);
return(result);
}
@@ -1319,89 +1194,84 @@ int mus_sound_override_header(const char *arg, int srate, int chans, int format,
bool mus_sound_maxamp_exists(const char *ifile)
{
sound_file *sf;
- bool val = false;
-
- MUS_LOCK(&sound_table_lock);
sf = get_sf(ifile);
- val = ((sf) && (sf->maxamps));
- MUS_UNLOCK(&sound_table_lock);
-
- return(val);
+ if ((sf) && (sf->maxtimes))
+ {
+ int i;
+ for (i = 0; i < sf->maxamps_size; i++)
+ if (sf->maxtimes[i] == -1)
+ return(false);
+ return(true);
+ }
+ return(false);
}
-mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_long_t *times)
+mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mus_long_t *times)
{
- mus_long_t frames;
- int i, ichans, chn;
+ mus_long_t framples;
+ int ichans, chn;
sound_file *sf;
- MUS_LOCK(&sound_table_lock);
-
sf = get_sf(ifile);
if (sf->chans <= 0)
- {
- MUS_UNLOCK(&sound_table_lock);
- return(MUS_ERROR);
- }
+ return(MUS_ERROR);
if ((sf) && (sf->maxamps))
{
- if (chans > sf->chans)
- ichans = sf->chans;
+ if (chans > sf->maxamps_size)
+ ichans = sf->maxamps_size;
else ichans = chans;
for (chn = 0; chn < ichans; chn++)
{
times[chn] = sf->maxtimes[chn];
vals[chn] = sf->maxamps[chn];
}
- frames = sf->samples / sf->chans;
- MUS_UNLOCK(&sound_table_lock);
- return(frames);
+ framples = sf->samples / sf->chans;
+ return(framples);
}
- MUS_UNLOCK(&sound_table_lock);
-
{
int j, bufnum, ifd;
- mus_long_t n, curframes;
- mus_sample_t *buffer, *samp;
+ mus_long_t n, curframples;
+ mus_float_t *buffer, *samp;
mus_long_t *time;
- mus_sample_t **ibufs;
+ mus_float_t **ibufs;
ifd = mus_sound_open_input(ifile);
if (ifd == MUS_ERROR) return(MUS_ERROR);
ichans = mus_sound_chans(ifile);
- frames = mus_sound_frames(ifile);
- if (frames == 0)
+ framples = mus_sound_framples(ifile);
+ if (framples == 0)
{
mus_sound_close_input(ifd);
return(0);
}
- mus_file_seek_frame(ifd, 0);
+ mus_file_seek_frample(ifd, 0);
- ibufs = (mus_sample_t **)calloc(ichans, sizeof(mus_sample_t *));
+ ibufs = (mus_float_t **)calloc(ichans, sizeof(mus_float_t *));
bufnum = 8192;
for (j = 0; j < ichans; j++)
- ibufs[j] = (mus_sample_t *)calloc(bufnum, sizeof(mus_sample_t));
+ ibufs[j] = (mus_float_t *)calloc(bufnum, sizeof(mus_float_t));
time = (mus_long_t *)calloc(ichans, sizeof(mus_long_t));
- samp = (mus_sample_t *)calloc(ichans, sizeof(mus_sample_t));
+ samp = (mus_float_t *)calloc(ichans, sizeof(mus_float_t));
- for (n = 0; n < frames; n += bufnum)
+ for (n = 0; n < framples; n += bufnum)
{
- if ((n + bufnum) < frames)
- curframes = bufnum;
- else curframes = (frames - n);
- mus_file_read(ifd, 0, curframes - 1, ichans, ibufs);
+ if ((n + bufnum) < framples)
+ curframples = bufnum;
+ else curframples = (framples - n);
+ mus_file_read(ifd, n, curframples, ichans, ibufs);
for (chn = 0; chn < ichans; chn++)
{
- buffer = (mus_sample_t *)(ibufs[chn]);
- for (i = 0; i < curframes; i++)
+ int i;
+ buffer = (mus_float_t *)(ibufs[chn]);
+ for (i = 0; i < curframples; i++)
{
- mus_sample_t abs_samp;
- abs_samp = mus_sample_abs(buffer[i]);
+ mus_float_t abs_samp;
+ abs_samp = fabs(buffer[i]);
if (abs_samp > samp[chn])
{
time[chn] = i + n;
@@ -1412,6 +1282,7 @@ mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_sample_t *vals, m
}
mus_sound_close_input(ifd);
+ /* fprintf(stderr, "set in mus_sound_maxamps\n"); */
mus_sound_set_maxamps(ifile, ichans, samp, time); /* save the complete set */
if (ichans > chans) ichans = chans;
@@ -1420,31 +1291,30 @@ mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_sample_t *vals, m
times[chn] = time[chn];
vals[chn] = samp[chn];
}
-
free(time);
free(samp);
for (j = 0; j < ichans; j++) free(ibufs[j]);
free(ibufs);
- return(frames);
+ return(framples);
}
}
-int mus_sound_set_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_long_t *times)
+int mus_sound_set_maxamps(const char *ifile, int chans, mus_float_t *vals, mus_long_t *times)
{
sound_file *sf;
int result = MUS_NO_ERROR;
- MUS_LOCK(&sound_table_lock);
-
+ /* fprintf(stderr, "set %s maxamps: %d %.3f %lld\n", ifile, chans, vals[0], times[0]); */
sf = get_sf(ifile);
if (sf)
{
int i, ichans = 0;
+
if (sf->maxamps)
{
- if (chans > sf->chans)
- ichans = sf->chans;
+ if (chans > sf->maxamps_size)
+ ichans = sf->maxamps_size;
else ichans = chans;
for (i = 0; i < ichans; i++)
{
@@ -1454,7 +1324,7 @@ int mus_sound_set_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_
}
else
{
- ichans = sf->chans; /* mus_sound_chans(ifile) */
+ ichans = sf->chans;
if (sf->maxamps == NULL)
{
/* here we need to use the max, since the caller may be confused */
@@ -1463,10 +1333,13 @@ int mus_sound_set_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_
if (max_chans < chans)
max_chans = chans;
- sf->maxamps = (mus_sample_t *)calloc(max_chans, sizeof(mus_sample_t));
+ sf->maxamps = (mus_float_t *)calloc(max_chans, sizeof(mus_float_t));
sf->maxtimes = (mus_long_t *)calloc(max_chans, sizeof(mus_long_t));
+ sf->maxamps_size = max_chans;
}
-
+ if (ichans > sf->maxamps_size)
+ ichans = sf->maxamps_size;
+
if (ichans > chans)
ichans = chans;
for (i = 0; i < ichans; i++)
@@ -1477,33 +1350,83 @@ int mus_sound_set_maxamps(const char *ifile, int chans, mus_sample_t *vals, mus_
}
}
else result = MUS_ERROR;
- MUS_UNLOCK(&sound_table_lock);
-
return(result);
}
-mus_long_t mus_file_to_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_sample_t *array)
+bool mus_sound_channel_maxamp_exists(const char *file, int chan)
+{
+ sound_file *sf;
+ sf = get_sf(file);
+ return((sf) &&
+ (sf->maxtimes) &&
+ (sf->maxamps_size > chan) &&
+ (sf->maxtimes[chan] != -1));
+}
+
+
+mus_float_t mus_sound_channel_maxamp(const char *file, int chan, mus_long_t *pos)
+{
+ sound_file *sf;
+ sf = get_sf(file);
+ if ((chan < sf->maxamps_size) &&
+ (sf->maxtimes))
+ {
+ (*pos) = sf->maxtimes[chan];
+ return(sf->maxamps[chan]);
+ }
+ return(-1.0);
+}
+
+
+void mus_sound_channel_set_maxamp(const char *file, int chan, mus_float_t mx, mus_long_t pos)
+{
+ sound_file *sf;
+ /* fprintf(stderr, "set %s maxamp: %.3f %lld\n", file, mx, pos); */
+ sf = get_sf(file);
+ if ((sf) &&
+ (sf->chans > chan))
+ {
+ if (!(sf->maxamps))
+ {
+ int i;
+ sf->maxamps = (mus_float_t *)malloc(sf->chans * sizeof(mus_float_t));
+ sf->maxtimes = (mus_long_t *)malloc(sf->chans * sizeof(mus_long_t));
+ sf->maxamps_size = sf->chans;
+ for (i = 0; i < sf->chans; i++)
+ {
+ sf->maxamps[i] = -1.0;
+ sf->maxtimes[i] = -1;
+ }
+ }
+ sf->maxamps[chan] = mx;
+ sf->maxtimes[chan] = pos;
+ }
+}
+
+
+mus_long_t mus_file_to_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_float_t *array)
{
int ifd, chans;
mus_long_t total_read;
- mus_sample_t **bufs;
+ mus_float_t **bufs;
ifd = mus_sound_open_input(filename);
if (ifd == MUS_ERROR) return(MUS_ERROR);
chans = mus_sound_chans(filename);
- if (chan >= chans)
+ if ((chan >= chans) ||
+ (chan < 0))
{
mus_sound_close_input(ifd);
return(mus_error(MUS_NO_SUCH_CHANNEL, "mus_file_to_array can't read %s channel %d (file has %d chans)", filename, chan, chans));
}
- bufs = (mus_sample_t **)calloc(chans, sizeof(mus_sample_t *));
+ bufs = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
bufs[chan] = array;
- mus_file_seek_frame(ifd, start);
- total_read = mus_file_read_any(ifd, 0, chans, samples, bufs, bufs);
+ mus_file_seek_frample(ifd, start);
+ total_read = mus_file_read_any(ifd, start, chans, samples, bufs, bufs);
mus_sound_close_input(ifd);
free(bufs);
@@ -1512,27 +1435,27 @@ mus_long_t mus_file_to_array(const char *filename, int chan, mus_long_t start, m
}
-const char *mus_array_to_file_with_error(const char *filename, mus_sample_t *ddata, mus_long_t len, int srate, int channels)
+const char *mus_array_to_file_with_error(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels)
{
/* put ddata into a sound file, taking byte order into account */
/* assume ddata is interleaved already if more than one channel */
int fd, err = MUS_NO_ERROR;
mus_long_t oloc;
- mus_sample_t *bufs[1];
mus_sound_forget(filename);
- err = mus_write_header(filename, MUS_NEXT, srate, channels, len * channels, MUS_OUT_FORMAT, "array->file");
+ err = mus_write_header(filename, MUS_NEXT, srate, channels, len * channels, MUS_OUT_SAMPLE_TYPE, "array->file");
if (err != MUS_NO_ERROR)
return("mus_array_to_file can't create output file");
oloc = mus_header_data_location();
fd = mus_file_reopen_write(filename);
lseek(fd, oloc, SEEK_SET);
err = mus_file_open_descriptors(fd, filename,
- MUS_OUT_FORMAT,
- mus_bytes_per_sample(MUS_OUT_FORMAT),
+ MUS_OUT_SAMPLE_TYPE,
+ mus_bytes_per_sample(MUS_OUT_SAMPLE_TYPE),
oloc, channels, MUS_NEXT);
if (err != MUS_ERROR)
{
+ mus_float_t *bufs[1];
bufs[0] = ddata;
err = mus_file_write(fd, 0, len - 1, 1, bufs); /* 1 = chans?? */
}
@@ -1542,7 +1465,7 @@ const char *mus_array_to_file_with_error(const char *filename, mus_sample_t *dda
return(NULL);
}
-int mus_array_to_file(const char *filename, mus_sample_t *ddata, mus_long_t len, int srate, int channels)
+int mus_array_to_file(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels)
{
const char *errmsg;
errmsg = mus_array_to_file_with_error(filename, ddata, len, srate, channels);
@@ -1554,39 +1477,14 @@ int mus_array_to_file(const char *filename, mus_sample_t *ddata, mus_long_t len,
mus_long_t mus_file_to_float_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_float_t *array)
{
-#if SNDLIB_USE_FLOATS
return(mus_file_to_array(filename, chan, start, samples, array));
-#else
- mus_sample_t *idata;
- mus_long_t i, len;
-
- idata = (mus_sample_t *)calloc(samples, sizeof(mus_sample_t));
- len = mus_file_to_array(filename, chan, start, samples, idata);
- if (len != -1)
- for (i = 0; i < samples; i++)
- array[i] = MUS_SAMPLE_TO_FLOAT(idata[i]);
- free(idata);
-
- return(len);
-#endif
}
int mus_float_array_to_file(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels)
{
const char *errmsg;
-#if SNDLIB_USE_FLOATS
errmsg = mus_array_to_file_with_error(filename, ddata, len, srate, channels);
-#else
- mus_sample_t *idata;
- mus_long_t i;
-
- idata = (mus_sample_t *)calloc(len, sizeof(mus_sample_t));
- for (i = 0; i < len; i++)
- idata[i] = MUS_FLOAT_TO_SAMPLE(ddata[i]);
- errmsg = mus_array_to_file_with_error(filename, idata, len, srate, channels);
- free(idata);
-#endif
if (errmsg)
return(mus_error(MUS_CANT_OPEN_FILE, "%s", errmsg));
@@ -1601,16 +1499,12 @@ int mus_sound_initialize(void)
{
int err = MUS_NO_ERROR;
sndlib_initialized = true;
-#if HAVE_PTHREADS
- pthread_key_create(&mus_thread_previous_error_handler, NULL);
- pthread_key_create(&mus_thread_error_handler, NULL);
- pthread_setspecific(mus_thread_error_handler, (void *)default_mus_error);
-#else
mus_error_handler = default_mus_error;
-#endif
err = mus_header_initialize();
if (err == MUS_NO_ERROR)
err = mus_audio_initialize();
+ sound_tables = (sound_file ***)calloc(NUM_SOUND_TABLES, sizeof(sound_file **));
+ sound_table_sizes = (int *)calloc(NUM_SOUND_TABLES, sizeof(int));
return(err);
}
return(MUS_NO_ERROR);
diff --git a/special-menu.scm b/special-menu.scm
index ec399d3..a2f762b 100644
--- a/special-menu.scm
+++ b/special-menu.scm
@@ -1,18 +1,25 @@
(provide 'snd-special-menu.scm)
(if (provided? 'xm)
- (if (not (provided? 'snd-effects-utils.scm))
- (load "effects-utils.scm")))
+ (require snd-effects-utils.scm snd-snd-motif.scm snd-edit-menu.scm))
(if (provided? 'xg)
- (if (not (provided? 'snd-gtk-effects-utils.scm))
- (load "gtk-effects-utils.scm")))
+ (require snd-gtk-effects-utils.scm snd-snd-gtk.scm))
-(if (not (provided? 'snd-edit-menu.scm)) (load "edit-menu.scm"))
+(define *e* (if (provided? 'snd-motif) *motif* *gtk*))
+(define update-label (*e* 'update-label))
+(define change-label (*e* 'change-label))
+(define make-effect-dialog (*e* 'make-effect-dialog))
+(define add-sliders (*e* 'add-sliders))
+(define activate-dialog (*e* 'activate-dialog))
+(define select-file (*e* 'select-file))
+
+
+(require snd-edit-menu.scm)
(if (not (defined? 'start-enveloping)) (load "enved.scm"))
(if (not (defined? 'explode-sf2)) (load "examp.scm"))
-(define special-list '()) ; menu labels are updated to show current default settings
+(define special-list ()) ; menu labels are updated to show current default settings
(define special-menu (add-to-main-menu "Special" (lambda ()
(update-label special-list))))
@@ -24,7 +31,7 @@
(lambda ()
(select-file
(lambda (filename)
- (insert-sound filename (frames))))))
+ (insert-sound filename (framples))))))
(add-to-menu special-menu #f #f)
@@ -87,7 +94,7 @@ See the TiMidity home page at http://www.onicos.com/staff/iz/timidity/ for more
(define (post-play-panned-dialog)
(if (not play-panned-dialog)
(let ((initial-play-panned-file 1)
- (sliders '()))
+ (sliders ()))
(set! play-panned-dialog
(make-effect-dialog
@@ -108,12 +115,11 @@ See the TiMidity home page at http://www.onicos.com/staff/iz/timidity/ for more
(if (provided? 'snd-gtk)
(lambda (w data)
(set! play-panned-file initial-play-panned-file)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) play-panned-file)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (car sliders)) play-panned-file)
)
(lambda (w c i)
(set! play-panned-file initial-play-panned-file)
- (XtSetValues (car sliders) (list XmNvalue play-panned-file))))))
+ ((*motif* 'XtSetValues) (car sliders) (list (*motif* 'XmNvalue) play-panned-file))))))
(set! sliders
(add-sliders
@@ -122,14 +128,14 @@ See the TiMidity home page at http://www.onicos.com/staff/iz/timidity/ for more
(if (provided? 'snd-gtk)
(lambda (w context)
- (set! play-panned-file (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
+ (set! play-panned-file ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
(lambda (w context info)
- (set! play-panned-file (.value info))))
+ (set! play-panned-file ((*motif* '.value) info))))
1))))))
(activate-dialog play-panned-dialog))
- (set! play-panned-menu-label (add-to-menu special-menu "Play panned" (lambda () (post-play-panned-dialog)))))
+ (set! play-panned-menu-label (add-to-menu special-menu "Play panned" post-play-panned-dialog)))
(set! play-panned-menu-label (add-to-menu special-menu play-panned-label cp-play-panned)))
@@ -152,7 +158,7 @@ See the TiMidity home page at http://www.onicos.com/staff/iz/timidity/ for more
(define save-as-mp3-menu-label #f)
(define (cp-save-as-mp3)
- (save-sound-as "tmp.wav" save-as-mp3-wav-file-number mus-riff)
+ (save-sound-as "tmp.wav" save-as-mp3-wav-file-number :header-type mus-riff)
(system (format #f "bladeenc tmp.wav tmp-~D.mp3" save-as-mp3-wav-file-number)))
(if (or (provided? 'xm)
@@ -163,7 +169,7 @@ See the TiMidity home page at http://www.onicos.com/staff/iz/timidity/ for more
(if (not save-as-mp3-dialog)
(let ((initial-save-as-mp3-wav-file-number 0)
- (sliders '()))
+ (sliders ()))
(set! save-as-mp3-dialog
(make-effect-dialog
save-as-mp3-label
@@ -187,12 +193,11 @@ Please see the Web page at bladeenc.mp3.no for details regarding Bladeenc.")))
(if (provided? 'snd-gtk)
(lambda (w data)
(set! save-as-mp3-wav-file-number initial-save-as-mp3-wav-file-number)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) save-as-mp3-wav-file-number)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (car sliders)) save-as-mp3-wav-file-number)
)
(lambda (w c i)
(set! save-as-mp3-wav-file-number initial-save-as-mp3-wav-file-number)
- (XtSetValues (car sliders) (list XmNvalue save-as-mp3-wav-file-number))))))
+ ((*motif* 'XtSetValues) (car sliders) (list (*motif* 'XmNvalue) save-as-mp3-wav-file-number))))))
(set! sliders
(add-sliders
@@ -200,13 +205,13 @@ Please see the Web page at bladeenc.mp3.no for details regarding Bladeenc.")))
(list (list "soundfile number" 0 initial-save-as-mp3-wav-file-number 250
(if (provided? 'snd-gtk)
(lambda (w data)
- (set! save-as-mp3-wav-file-number (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
+ (set! save-as-mp3-wav-file-number ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
(lambda (w context info)
- (set! save-as-mp3-wav-file-number (.value info))))
+ (set! save-as-mp3-wav-file-number ((*motif* '.value) info))))
1))))))
(activate-dialog save-as-mp3-dialog))
- (set! save-as-mp3-menu-label (add-to-menu special-menu "Save as MP3" (lambda () (post-save-as-mp3-dialog)))))
+ (set! save-as-mp3-menu-label (add-to-menu special-menu "Save as MP3" post-save-as-mp3-dialog)))
(set! save-as-mp3-menu-label (add-to-menu special-menu save-as-mp3-label cp-save-as-mp3)))
@@ -227,7 +232,7 @@ Please see the Web page at bladeenc.mp3.no for details regarding Bladeenc.")))
(define save-as-ogg-menu-label #f)
(define (cp-save-as-ogg)
- (save-sound-as "tmp.wav" save-as-ogg-wav-file-number mus-riff)
+ (save-sound-as "tmp.wav" save-as-ogg-wav-file-number :header-type mus-riff)
(system (format #f "oggenc tmp.wav -o tmp-~D.ogg" save-as-ogg-wav-file-number)))
(if (or (provided? 'xm)
@@ -238,7 +243,7 @@ Please see the Web page at bladeenc.mp3.no for details regarding Bladeenc.")))
(if (not save-as-ogg-dialog)
(let ((initial-save-as-ogg-wav-file-number 0)
- (sliders '()))
+ (sliders ()))
(set! save-as-ogg-dialog
(make-effect-dialog
@@ -263,12 +268,11 @@ Please see the Web page at www.xiphophorus.org for details regarding the Ogg/Vor
(if (provided? 'snd-gtk)
(lambda (w data)
(set! save-as-ogg-wav-file-number initial-save-as-ogg-wav-file-number)
- (gtk_adjustment_set_value (GTK_ADJUSTMENT (car sliders)) save-as-ogg-wav-file-number)
- ;;; (gtk_adjustment_value_changed (GTK_ADJUSTMENT (car sliders)))
+ ((*gtk* 'gtk_adjustment_set_value) ((*gtk* 'GTK_ADJUSTMENT) (car sliders)) save-as-ogg-wav-file-number)
)
(lambda (w c i)
(set! save-as-ogg-wav-file-number initial-save-as-ogg-wav-file-number)
- (XtSetValues (car sliders) (list XmNvalue save-as-ogg-wav-file-number))))))
+ ((*motif* 'XtSetValues) (car sliders) (list (*motif* 'XmNvalue) save-as-ogg-wav-file-number))))))
(set! sliders
(add-sliders
@@ -276,13 +280,13 @@ Please see the Web page at www.xiphophorus.org for details regarding the Ogg/Vor
(list (list "soundfile number" 0 initial-save-as-ogg-wav-file-number 250
(if (provided? 'snd-gtk)
(lambda (w data)
- (set! save-as-ogg-wav-file-number (gtk_adjustment_get_value (GTK_ADJUSTMENT w))))
+ (set! save-as-ogg-wav-file-number ((*gtk* 'gtk_adjustment_get_value) ((*gtk* 'GTK_ADJUSTMENT) w))))
(lambda (w context info)
- (set! save-as-ogg-wav-file-number (.value info))))
+ (set! save-as-ogg-wav-file-number ((*motif* '.value) info))))
1))))))
(activate-dialog save-as-ogg-dialog))
- (set! save-as-ogg-menu-label (add-to-menu special-menu "Save as Ogg file" (lambda () (post-save-as-ogg-dialog)))))
+ (set! save-as-ogg-menu-label (add-to-menu special-menu "Save as Ogg file" post-save-as-ogg-dialog)))
(set! save-as-ogg-menu-label (add-to-menu special-menu save-as-ogg-label cp-save-as-ogg)))
diff --git a/spectr.fs b/spectr.fs
index 360ff01..352adf3 100644
--- a/spectr.fs
+++ b/spectr.fs
@@ -1,9 +1,8 @@
-\ spectr.fs -- spectr.cl --> spectr.fs -*- snd-forth -*-
-
+\ spectr.fs -- spectr.cl --> spectr.fs
\ Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
\ Created: Thu Nov 18 15:26:46 CET 2004
-\ Changed: Fri Dec 12 00:57:33 CET 2008
+\ Changed: Fri Mar 23 22:51:31 CET 2012
\ Commentary:
diff --git a/spokenword.scm b/spokenword.scm
index b590ac3..1c15d19 100644
--- a/spokenword.scm
+++ b/spokenword.scm
@@ -24,7 +24,7 @@
(define secs->samples
(lambda (time)
- (define* sr 44100)
+ (define sr 44100)
(round (* sr time))))
(define size (secs->samples 0.10)) ;length of the window for rms and peak calculations
@@ -40,17 +40,17 @@
(define local-data
(lambda (position)
- (channel->vct (max 0 (- position (* size .5))) size)))
+ (channel->float-vector (max 0 (- position (* size .5))) size)))
(define local-rms
(lambda (position)
- (let* ((data (local-data position)))
- (sqrt (/ (dot-product data data) size)))))
+ (let ((data (local-data position)))
+ (sqrt (/ (dot-product data data) size)))))
(define local-peak
(lambda (position)
- (let* ((data (local-data position)))
- (vct-peak data))))
+ (let ((data (local-data position)))
+ (float-vector-peak data))))
(define local-smooth
(lambda (position)
@@ -58,204 +58,143 @@
(define silence?
(lambda (position)
- (if (< (local-rms position) rms-threshold)
- #t
- #f)))
+ (< (local-rms position) rms-threshold)))
(define phrase?
(lambda (position)
- (if (and (> (local-peak position) peak-threshold)
- (> (local-rms position) rms-threshold))
- #t
- #f)))
+ (and (> (local-peak position) peak-threshold)
+ (> (local-rms position) rms-threshold))))
(define phrase-start?
(lambda (position)
- (if (and (silence? position)
- (phrase? (+ position phrase-look-offset)))
- #t
- #f)))
+ (and (silence? position)
+ (phrase? (+ position phrase-look-offset)))))
(define next-phrase
(lambda (position)
(do ((i 0 (+ i 1)) (found #f))
- ((or (eq? i 100) (eq? found #t) (eq? position (frames))) position)
- (set! position (min (frames) (+ position jump-length)))
+ ((or (= i 100) found (= position (framples))) position)
+ (set! position (min (framples) (+ position jump-length)))
(set! found (phrase-start? position)))))
(define previous-phrase
(lambda (position)
(do ((i 0 (+ i 1)) (found #f))
- ((or (eq? i 100) (eq? found #t) (eq? position 0)) position)
+ ((or (= i 100) found (= position 0)) position)
(set! position (max 0 (- position jump-length)))
(set! found (phrase-start? position)))))
(define mark-out
(lambda (position)
- (let* ((in-mark (find-mark "In"))
- (out-mark (find-mark "Out")))
- (if (not (eq? in-mark #f))
- (if (<= (mark-sample in-mark) position)
- (delete-mark in-mark)))
- (if (eq? out-mark #f)
+ (let ((in-mark (find-mark "In"))
+ (out-mark (find-mark "Out")))
+ (if (and in-mark
+ (<= (mark-sample in-mark) position))
+ (delete-mark in-mark))
+ (if (not out-mark)
(add-mark position 0 0 "Out")
(set! (mark-sample out-mark) position)))))
(define mark-in
(lambda (position)
- (let* ((in-mark (find-mark "In"))
- (out-mark (find-mark "Out")))
- (if (not (eq? out-mark #f))
- (if (>= (mark-sample out-mark) position)
- (delete-mark out-mark)))
- (if (eq? in-mark #f)
+ (let ((in-mark (find-mark "In"))
+ (out-mark (find-mark "Out")))
+ (if (and out-mark
+ (>= (mark-sample out-mark) position))
+ (delete-mark out-mark))
+ (if (not in-mark)
(add-mark position 0 0 "In")
(set! (mark-sample in-mark) position)))))
(define delete-from-out-to-in
(lambda ()
- (let* ((in-mark (find-mark "In"))
- (out-mark (find-mark "Out")))
- (if (and
- (not (eq? in-mark #f))
- (not (eq? out-mark #f)))
- (if (< (mark-sample out-mark) (mark-sample in-mark))
- (begin
- (set! (cursor) (mark-sample out-mark))
- (as-one-edit
- (lambda()
- (delete-samples (mark-sample out-mark) (- (+ (mark-sample in-mark) 1) (mark-sample out-mark)))
- (local-smooth (cursor))))))))))
+ (let ((in-mark (find-mark "In"))
+ (out-mark (find-mark "Out")))
+ (if (and in-mark
+ out-mark
+ (< (mark-sample out-mark) (mark-sample in-mark)))
+ (begin
+ (set! (cursor) (mark-sample out-mark))
+ (as-one-edit
+ (lambda()
+ (delete-samples (mark-sample out-mark) (- (+ (mark-sample in-mark) 1) (mark-sample out-mark)))
+ (local-smooth (cursor)))))))))
(define (play-preview)
(let* ((in-mark (find-mark "In"))
(out-mark (find-mark "Out"))
- (in-position (if (not (eq? in-mark #f)) (mark-sample in-mark) 0))
- (out-position (if (not (eq? out-mark #f)) (mark-sample out-mark) 0)))
+ (in-position (if in-mark (mark-sample in-mark) 0))
+ (out-position (if out-mark (mark-sample out-mark) 0)))
(define (play-next reason)
(if (= reason 0)
(begin
(play (selected-sound) in-position (+ in-position preview-length)))))
(if (and
- (not (eq? in-mark #f))
- (not (eq? out-mark #f)))
+ in-mark
+ out-mark)
(if (< out-position in-position)
(play (max 0 (- out-position preview-length)) #f #f #f out-position #f play-next))
(play (selected-sound) (cursor) (+ (cursor) preview-length)))))
-; Copied from examp.scm
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define* (if-cursor-follows-play-it-stays-where-play-stopped (enable #t))
- ; call with #t or no args to enable this, with #f to disable
- (let ()
- (define current-cursor
- (make-procedure-with-setter
- (lambda (snd chn) (channel-property 'cursor snd chn))
- (lambda (snd chn val) (set! (channel-property 'cursor snd chn) val))))
-
- (define original-cursor
- (make-procedure-with-setter
- (lambda (snd chn) (channel-property 'original-cursor snd chn))
- (lambda (snd chn val) (set! (channel-property 'original-cursor snd chn) val))))
-
- (define (local-dac-func data)
- (for-each
- (lambda (snd)
- (do ((i 0 (+ 1 i)))
- ((= i (channels snd)))
- (if (not (= (cursor snd i) (original-cursor snd i)))
- (set! (current-cursor snd i) (cursor snd i)))))
- (sounds)))
-
- (define (local-start-playing-func snd)
- (do ((i 0 (+ 1 i)))
- ((= i (channels snd)))
- (set! (original-cursor snd i) (cursor snd i))
- (set! (current-cursor snd i) (cursor snd i))))
-
- (define (local-stop-playing-func snd)
- (set! (cursor snd #t) (current-cursor snd 0)))
-
- (if enable
- (begin
- (hook-push dac-hook local-dac-func)
- (hook-push start-playing-hook local-start-playing-func)
- (hook-push stop-playing-hook local-stop-playing-func))
- (begin
- (hook-remove dac-hook local-dac-func)
- (hook-remove start-playing-hook local-start-playing-func)
- (hook-remove stop-playing-hook local-stop-playing-func)))))
+(set! *with-tracking-cursor* :track-and-stay)
-; Default to if-cursor-follows-play-it-stays-where-play-stopped #t.
-(if-cursor-follows-play-it-stays-where-play-stopped)
; Key bindings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(bind-key #\i 0
- (lambda ()
- "Mark an in-position"
+ (lambda () ; Mark an in-position
(mark-in (cursor))
cursor-in-view))
(bind-key #\o 0
- (lambda ()
- "Mark an out-position"
+ (lambda () ; Mark an out-position
(mark-out (cursor))
cursor-in-view))
(bind-key #\c 4
- (lambda ()
- "Clear all marks"
+ (lambda () ; Clear all marks
(delete-marks)
cursor-in-view))
(bind-key "BackSpace" 4
- (lambda ()
- "Commit delete from mark Out to mark In"
+ (lambda () ; Commit delete from mark Out to mark In
(delete-from-out-to-in)
cursor-in-view))
(bind-key #\p 0
- (lambda ()
- "Play from cursor"
- (set! (with-tracking-cursor) #t)
+ (lambda () ; Play from cursor
+ (set! *with-tracking-cursor* #t)
(if (playing)
(stop-playing)
(play (selected-sound) (cursor)))
cursor-in-view))
(bind-key #\l 0
- (lambda ()
- "Listen to a preview before commiting delete or listen from cursor"
- (set! (with-tracking-cursor) #f)
+ (lambda () ; Listen to a preview before commiting delete or listen from cursor
+ (set! *with-tracking-cursor* #f)
(if (playing)
(stop-playing)
(play-preview))
cursor-in-view))
(bind-key "Right" 0
- (lambda ()
- "Move cursor to the right"
+ (lambda () ; Move cursor to the right
(set! (cursor) (+ (cursor) some-size))
cursor-in-view))
(bind-key "Right" 4
- (lambda ()
- "Move cursor to next interesting position"
+ (lambda () ; Move cursor to next interesting position
(set! (cursor) (next-phrase (cursor)))
cursor-in-view))
(bind-key "Left" 0
- (lambda ()
- "Move cursor to the left"
+ (lambda () ; Move cursor to the left
(set! (cursor) (- (cursor) some-size))
cursor-in-view))
(bind-key "Left" 4
- (lambda ()
- "Move cursor to previous interesting position"
+ (lambda () ; Move cursor to previous interesting position
(set! (cursor) (previous-phrase (cursor)))
cursor-in-view))
\ No newline at end of file
diff --git a/stochastic.scm b/stochastic.scm
index 3ddae8e..fac3001 100644
--- a/stochastic.scm
+++ b/stochastic.scm
@@ -6,8 +6,10 @@
;; revised slightly to accommodate the run macro, Bill 13-Jun-06
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-(if (not (provided? 'snd-env.scm)) (load "env.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(require snd-env.scm)
(definstrument
(stochastic start dur
@@ -34,40 +36,38 @@
(end (+ beg (seconds->samples dur)))
(d-click (make-env (list 0 1 (- end 100) 1 end 0) :duration dur))
(b (expt 2 (- bits 1))); because we use signed ints - see (- b) below
- ;;make vct to hold x,y breakpoints
- (xy-array (make-vct (* (length init-array) 2)))
+ ;;make float-vector to hold x,y breakpoints
+ (xy-array (make-float-vector (* (length init-array) 2)))
(xy-array-l (floor (length xy-array)))
)
;;fill xy-array with values from init-array
(do ((iy 0 (+ iy 2));;index for reading values from init-array (a 2-dimensional list)
- (jy 0 (+ jy 1)));;index for writing to xy-array (a 1-dimensional vct)
+ (jy 0 (+ jy 1)));;index for writing to xy-array (a 1-dimensional float-vector)
((= iy xy-array-l) xy-array)
- (vct-set! xy-array iy
- (list-ref (list-ref init-array jy) 0))
- (vct-set! xy-array (+ iy 1)
- ;;convert signed float y values into signed integers
- (floor (* b
- (list-ref (list-ref init-array jy) 1)
- ))))
- (run
- (do ((i beg (+ 1 i)))
+ (set! (xy-array iy) ((init-array jy) 0))
+ (set! (xy-array (+ iy 1))
+ ;;convert signed float y values into signed integers
+ (floor (* b
+ ((init-array jy) 1)))))
+
+ (do ((i beg (+ i 1)))
((= i end))
(if (= dx dt);;when current sample is a breakpoint
(begin
- (set! dx (floor (vct-ref xy-array (modulo m xy-array-l))))
- (set! y (vct-ref xy-array (+ (modulo m xy-array-l) 1)))
- (set! prev-dx (floor (vct-ref xy-array (modulo (- m 2) xy-array-l))))
+ (set! dx (floor (xy-array (modulo m xy-array-l))))
+ (set! y (xy-array (+ (modulo m xy-array-l) 1)))
+ (set! prev-dx (floor (xy-array (modulo (- m 2) xy-array-l))))
(set! dy (- y oldy))
(set! oldy y)
;;straight uniform distribution for y
- (set! ydev (round (* (- 1.0 (random 2.0)) (* .01 b ywig))))
+ (set! ydev (round (mus-random (* .01 b ywig))))
;;gaussian distribution for x
(set! xdev
(* xstep (round
(* xwig
- (* (sqrt (* -2.0 (log (- 1 (random 1.0)))))
- (cos (* 6.283185307179586 (random 1.0))))))))
- (vct-set! xy-array (modulo m xy-array-l)
+ (sqrt (* -2.0 (log (- 1 (random 1.0))))) ; ??
+ (cos (random 6.283185307179586))))))
+ (set! (xy-array (modulo m xy-array-l))
;;mirror stuff for x
(cond ((or (< (round xmax) (+ dx xdev))
(> (round xmin)(+ dx xdev)))
@@ -77,17 +77,17 @@
(round xmin)))
(else (round (+ (* xfb prev-dx)
(* (- 1 xfb) (+ dx xdev)))))))
- (vct-set! xy-array (+ (modulo m xy-array-l) 1)
+ (set! (xy-array (+ (modulo m xy-array-l) 1))
;;mirror stuff for y
(cond ((or (< b (+ y ydev)) (> (- b) (+ y ydev)))
(max (min (+ y (- ydev)) b) (- b)))
(else (+ y ydev))))
(set! m (+ m 2))
(set! dt 0)))
- (set! dt (+ 1 dt))
+ (set! dt (+ dt 1))
(set! j (+ j (/ dy dx)));linear interpolation
(set! output (/ j b));normalization -1 to 1
- (outa i (* amp output (env d-click)))))))
+ (outa i (* amp output (env d-click))))))
;(with-sound (:statistics #t)(stochastic 0 10 :xwig .25 :ywig 10.0))
\ No newline at end of file
diff --git a/strad.scm b/strad.scm
index ab2042b..5cf02ec 100644
--- a/strad.scm
+++ b/strad.scm
@@ -9,9 +9,16 @@
;; revised by Bill to suit the run macro
(provide 'snd-strad.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-;;; (if (not (provided? 'snd-jcrev.scm)) (load "jcrev.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(define make-biquad
+ (let ((documentation "(make-biquad a0 a1 a2 b1 b2) returns a biquad filter (use with the CLM filter gen)"))
+ (lambda (a0 a1 a2 b1 b2)
+ (make-filter 3
+ (float-vector a0 a1 a2)
+ (float-vector 0.0 b1 b2)))))
(definstrument (bow beg dur frq amplitude
(bufsize 2205)
@@ -21,270 +28,269 @@
(inharm 0.1) ;; inharmonicity: 0.0 harmonic; 1.0 not harmonico
(ampenv '(0 1 15 1 95 1 100 0))
(degree 45) (dist 0.0025) (reverb 0))
- (let* ((beg (seconds->samples beg))
- (len (seconds->samples dur))
- (end (+ beg len))
- (ampf (make-env :envelope ampenv :scaler amplitude :duration dur))
- (loc (make-locsig degree dist reverb))
- (vinut (make-vct bufsize))
- (vinbridge (make-vct bufsize))
- (vinutt (make-vct bufsize))
- (vinbridget (make-vct bufsize))
- (vib 0.0) (vin 0.0) (vibt 0.0) (vint 0.0)
- (freq frq)
- (mus 0.8)
- (twavespeedfactor 5.2)
- (posl 0) (posr 0)
- (poslt 0) (posrt 0)
- (indexl 0) (indexr 0)
- (indexlt 0) (indexrt 0)
- (indexl_1 0) (indexr_1 0)
- (indexlt_1 0) (indexrt_1 0)
- (indexl_2 0) (indexr_2 0)
- (indexlt_2 0) (indexrt_2 0)
- (updl 0) (updr 0)
- (updlt 0) (updrt 0)
- (b0b 0.859210)
- (b1b -0.704922)
- (b2b 0.022502)
- (a1b -0.943639)
- (a2b 0.120665)
- (b0n 7.0580050e-001)
- (b1n -5.3168461e-001)
- (b2n 1.4579750e-002)
- (a1n -9.9142489e-001)
- (a2n 1.8012052e-001)
- (b0bt 9.9157155e-001)
- (b1bt -8.2342890e-001)
- (b2bt 8.8441749e-002)
- (a1bt -8.3628218e-001)
- (a2bt 9.2866585e-002)
- (b0nt 4.3721359e-001)
- (b1nt -2.7034968e-001)
- (b2nt -5.7147560e-002)
- (a1nt -1.2158343e+000)
- (a2nt 3.2555068e-001)
- (xm1bt 0.0e0) (xm2bt 0.0e0)
- (xm1nt 0.0e0)(xm2nt 0.0e0)
- (ym1bt 0.0e0) (ym2bt 0.0e0)
- (ym1nt 0.0e0) (ym2nt 0.0e0)
- (xm1b 0.0e0) (xm2b 0.0e0)(ym1b 0.0e0) (ym2b 0.0e0)
- (xm1n 0.0e0) (xm2n 0.0e0)(ym1n 0.0e0) (ym2n 0.0e0)
- (ynb 0.0e0) (ynbt 0.0e0)
- (ynn 0.0e0) (ynnt 0.0e0)
- (ya1nb 0.0e0) (ynba1 0.0e0)
- (y1nb 0.0e0)
- (vh 0.0e0)
- (aa 0.0e0) (bb1 0.0e0) (cc1 0.0e0) (delta1 0.0e0)
- (bb2 0.0e0) (cc2 0.0e0) (delta2 0.0e0)
- (v 0.0e0) (v1 0.0e0) (v2 0.0e0)
- (rhs #f) (lhs #f)
- (vtemp 0.0e0)
- (f 0.0e0)
- (stringImpedance 0.55)
- (stringImpedancet 1.8)
- (stick 0)
- (zslope (/ 1 (+ (/ 1 (* 2 stringImpedance)) (/ 1 (* 2 stringImpedancet)))))
- (xnn 0.0e0) (xnb 0.0e0)
- (xnnt 0.0e0) (xnbt 0.0e0)
- (alphar 0) (alphal 0)
- (alphart 0) (alphalt 0)
- (len (- (/ (mus-srate) freq ) 2))
- (lent (/ (- (/ (mus-srate) freq) 2) twavespeedfactor))
- (del_right (* len bp))
- (del_left (* len (- 1 bp)))
- (del_leftt (* lent (- 1 bp)))
- (del_rightt (* lent bp))
- (samp_rperiod (floor del_right))
- (samp_lperiod (floor del_left))
- (samp_lperiodt (floor del_leftt))
- (samp_rperiodt (floor del_rightt)))
+ (let ((beg (seconds->samples beg))
+ (len-1 (seconds->samples dur))
+ (freq frq)
+ (len (- (/ *clm-srate* frq ) 2))
+ (twavespeedfactor 5.2)
+ (stringImpedance 0.55)
+ (stringImpedancet 1.8))
+ (let ((lent (/ (- (/ *clm-srate* freq) 2) twavespeedfactor)))
+ (let ((ampf (make-env :envelope ampenv :scaler amplitude :duration dur))
+ (end (+ beg len-1))
+ (loc (make-locsig degree dist reverb))
+ (vinut (make-float-vector bufsize))
+ (vinbridge (make-float-vector bufsize))
+ (vinutt (make-float-vector bufsize))
+ (vinbridget (make-float-vector bufsize))
+ (vib 0.0) (vin 0.0) (vibt 0.0) (vint 0.0)
+ (mus 0.8)
+ (posl 0) (posr 0)
+ (poslt 0) (posrt 0)
+ (indexl 0) (indexr 0)
+ (indexlt 0) (indexrt 0)
+ (indexl_1 0) (indexr_1 0)
+ (indexlt_1 0) (indexrt_1 0)
+ (indexl_2 0) (indexr_2 0)
+ (indexlt_2 0) (indexrt_2 0)
+ (updl 0) (updr 0)
+ (updlt 0) (updrt 0)
+ (b0b 0.859210)
+ (b1b -0.704922)
+ (b2b 0.022502)
+ (a1b -0.943639)
+ (a2b 0.120665)
+ (b0n 7.0580050e-001)
+ (b1n -5.3168461e-001)
+ (b2n 1.4579750e-002)
+ (a1n -9.9142489e-001)
+ (a2n 1.8012052e-001)
+ (b0bt 9.9157155e-001)
+ (b1bt -8.2342890e-001)
+ (b2bt 8.8441749e-002)
+ (a1bt -8.3628218e-001)
+ (a2bt 9.2866585e-002)
+ (b0nt 4.3721359e-001)
+ (b1nt -2.7034968e-001)
+ (b2nt -5.7147560e-002)
+ (a1nt -1.2158343e+000)
+ (a2nt 3.2555068e-001)
+ (ynb 0.0e0) (ynbt 0.0e0)
+ (ynn 0.0e0) (ynnt 0.0e0)
+ (ya1nb 0.0e0) (ynba1 0.0e0)
+ (y1nb 0.0e0)
+ (vh 0.0e0)
+ (aa 0.0e0) (bb1 0.0e0) (cc1 0.0e0) (delta1 0.0e0)
+ (bb2 0.0e0) (cc2 0.0e0) (delta2 0.0e0)
+ (v 0.0e0) (v1 0.0e0) (v2 0.0e0)
+ (rhs #f) (lhs #f)
+ (vtemp 0.0e0)
+ (f 0.0e0)
+ (stick 0)
+ ;;(zslope (/ 1 (+ (/ 1 (* 2 stringImpedance)) (/ 1 (* 2 stringImpedancet)))))
+ (zslope (/ (* 2 stringImpedance stringImpedancet) (+ stringImpedance stringImpedancet)))
+ (xnn 0.0e0) (xnb 0.0e0)
+ (xnnt 0.0e0) (xnbt 0.0e0)
+ (alphar 0) (alphal 0)
+ (alphart 0) (alphalt 0)
+ (del_right (* len bp))
+ (del_left (* len (- 1 bp)))
+ (del_leftt (* lent (- 1 bp)))
+ (del_rightt (* lent bp)))
+ (let ((samp_rperiod (floor del_right))
+ (samp_lperiod (floor del_left))
+ (samp_lperiodt (floor del_leftt))
+ (samp_rperiodt (floor del_rightt)))
- (define (bowfilt inharmon)
- (set! ynb (- (- (+ (* b0b vib) (* b1b xm1b) (* b2b xm2b)) (* a1b ym1b)) (* a2b ym2b)))
- (set! xm2b xm1b)
- (set! xm1b vib)
- (set! ym2b ym1b)
- (set! ym1b ynb)
- (set! ynn (- (- (+ (* b0n vin) (* b1n xm1n) (* b2n xm2n)) (* a1n ym1n)) (* a2n ym2n)))
- (set! xm2n xm1n)
- (set! xm1n vin)
- (set! ym2n ym1n)
- (set! ym1n ynn)
- (set! ynbt (- (- (+ (* b0bt vibt) (* b1bt xm1bt) (* b2bt xm2bt))
- (* a1bt ym1bt)) (* a2bt ym2bt)))
- (set! xm2bt xm1bt)
- (set! xm1bt vibt)
- (set! ym2bt ym1bt)
- (set! ym1bt ynbt)
- (set! ynnt (- (- (+ (* b0nt vint) (* b1nt xm1nt) (* b2nt xm2nt))
- (* a1nt ym1nt)) (* a2nt ym2nt)))
- (set! xm2nt xm1nt)
- (set! xm1nt vint)
- (set! ym2nt ym1nt)
- (set! ym1nt ynnt)
- (if (<= inharmon 0.00001) (set! inharmon 0.00001))
- (if (>= inharmon 0.9999) (set! inharmon 0.9999))
- (set! y1nb (+ (* -1 (* inharmon ynb)) ynba1 (* inharmon ya1nb)))
- (set! ya1nb y1nb)
- (set! ynba1 ynb)
- (set! y1nb (* -1 y1nb))
- (set! ynn (* -1 ynn))
- (set! ynbt (* -1 ynbt)))
-
- (if (< samp_rperiod 0) (set! samp_rperiod 0))
- (if (> samp_rperiod (- bufsize 1)) (set! samp_rperiod (- bufsize 1)))
- (if (< samp_lperiod 0) (set! samp_lperiod 0))
- (if (> samp_lperiod (- bufsize 1)) (set! samp_lperiod (- bufsize 1)))
- (set! alphar (exact->inexact (- del_right samp_rperiod)))
- (set! alphal (exact->inexact (- del_left samp_lperiod)))
- (if (< samp_rperiodt 0)(set! samp_rperiodt 0))
- (if (> samp_rperiodt (- bufsize 1)) (set! samp_rperiodt (- bufsize 1)))
- (if (< samp_lperiodt 0) (set! samp_lperiodt 0))
- (if (> samp_lperiodt (- bufsize 1)) (set! samp_lperiodt (- bufsize 1)))
- (set! alphart (exact->inexact (- del_rightt samp_rperiodt)))
- (set! alphalt (exact->inexact (- del_leftt samp_lperiodt)))
- (set! posr (modulo (inexact->exact (+ end posr)) bufsize))
- (set! posl (modulo (inexact->exact (+ end posl)) bufsize))
- (set! posrt (modulo (inexact->exact (+ end posrt)) bufsize))
- (set! poslt (modulo (inexact->exact (+ end poslt)) bufsize))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (set! indexl (modulo (inexact->exact (- (+ i posl bufsize) samp_lperiod)) bufsize))
- (set! indexr (modulo (inexact->exact (- (+ i posr bufsize) samp_rperiod)) bufsize))
- (set! indexlt (modulo (inexact->exact (- (+ i poslt bufsize) samp_lperiodt)) bufsize))
- (set! indexrt (modulo (inexact->exact (- (+ i posrt bufsize) samp_rperiodt)) bufsize))
- (set! indexl_1 (modulo
- (inexact->exact (- (- (+ i posl bufsize) samp_lperiod) 1)) bufsize))
- (set! indexr_1 (modulo
- (inexact->exact (- (- (+ i posr bufsize) samp_rperiod) 1)) bufsize))
- (set! indexlt_1 (modulo
- (inexact->exact (- (- (+ i poslt bufsize) samp_lperiodt) 1)) bufsize))
- (set! indexrt_1 (modulo
- (inexact->exact (- (- (+ i posrt bufsize) samp_rperiodt) 1)) bufsize))
- (set! indexl_2 (modulo
- (inexact->exact (- (- (+ i posl bufsize) samp_lperiod) 2)) bufsize))
- (set! indexr_2 (modulo
- (inexact->exact (- (- (+ i posr bufsize) samp_rperiod) 2)) bufsize))
- (set! indexlt_2 (modulo
- (inexact->exact (- (- (+ i poslt bufsize) samp_lperiodt) 2)) bufsize))
- (set! indexrt_2 (modulo
- (inexact->exact (- (- (+ i posrt bufsize) samp_rperiodt) 2)) bufsize))
- (set! vib (+ (/ (* (vct-ref vinbridge indexl_2) (- alphal 1)(- alphal 2)) 2)
- (* (vct-ref vinbridge indexl_1) (* alphal -1) (- alphal 2))
- (/ (* (vct-ref vinbridge indexl) alphal (- alphal 1)) 2)))
- (set! vin (+ (/ (* (vct-ref vinut indexr_2) (- alphar 1)(- alphar 2)) 2)
- (* (vct-ref vinut indexr_1) (* alphar -1) (- alphar 2))
- (/ (* (vct-ref vinut indexr) (- alphar 1) alphar) 2)))
- (set! vibt (+ (/ (* (vct-ref vinbridget indexlt_2) (- alphalt 1)(- alphalt 2)) 2)
- (* (vct-ref vinbridget indexlt_1) (* alphalt -1) (- alphalt 2))
- (/ (* (vct-ref vinbridget indexlt) alphalt (- alphalt 1)) 2)))
- (set! vint (+ (/ (* (vct-ref vinutt indexrt_2) (- alphart 1)(- alphart 2)) 2)
- (* (vct-ref vinutt indexrt_1) (* alphart -1) (- alphart 2))
- (/ (* (vct-ref vinutt indexrt) (- alphart 1) alphart) 2)))
- (bowfilt inharm)
- (set! vh (+ (+ ynn y1nb) (+ ynnt ynbt)))
-
- (set! aa zslope)
- (set! bb1 (- (- (+ (* 0.2 zslope) (* 0.3 fb)) (* zslope vb)) (* zslope vh)))
- (set! cc1 (- (- (+ (* 0.06 fb) (* (* zslope vh) vb)) (* 0.2 zslope vh)) (* 0.3 vb fb)))
- (set! delta1 (- (* bb1 bb1) (* 4 aa cc1)))
- (set! bb2 (- (- (- (* -0.2 zslope) (* 0.3 fb)) (* zslope vb)) (* zslope vh)))
- (set! cc2 (+ (+ (+ (+ (* 0.06 fb) (* zslope vh vb))
- (* 0.2 zslope vh)) (* 0.3 vb fb)) (* 0.1 fb)))
- (set! delta2 (- (* bb2 bb2) (* 4 aa cc2)))
- (if (or (= vb 0) (= fb 0))
- (set! v vh)
- (begin
- (if (= vh vb)
- (begin
- (set! v vb)
- (set! stick 1))
- (begin
- (if (> vh vb)
- (begin
- (set! lhs #f)
- (set! rhs #t))
- (begin
- (set! rhs #f)
- (set! lhs #t)))
- (if rhs
- (begin
- (if (< delta1 0)
- (begin
- (set! v vb)
- (set! stick 1))
- (begin
- (if (= stick 1)
- (begin
- (set! vtemp vb)
- (set! f (* (* 2 zslope) (- vtemp vh)))
- (if (>= f (* -1 (* mus fb)))
- (set! v vtemp)
- (begin
- (set! v1 (/ (+ (* -1 bb1 ) (sqrt delta1)) (* 2 aa)))
- (set! v2 (/ (- (* -1 bb1) (sqrt delta1)) (* 2 aa)))
- (set! v (min v1 v2))
- (set! stick 0))))
- (begin
- (set! v1 (/ (+ (* -1 bb1 ) (sqrt delta1)) (* 2 aa)))
- (set! v2 (/ (- (* -1 bb1) (sqrt delta1)) (* 2 aa)))
- (set! v (min v1 v2))
- (set! stick 0))))))
- (if lhs
- (begin
- (if (< delta2 0)
- (begin
- (set! v vb)
- (set! stick 1))
- (begin
- (if (= stick 1)
- (begin
- (set! vtemp vb)
- (set! f (* zslope (- vtemp vh)))
- (if (and (<= f (* mus fb)) (> f 0))
- (begin
- (set! v vtemp))
- (begin
- (set! v1 (/ (- (* -1 bb2 ) (sqrt delta2)) (* 2 aa)))
- (set! v2 (/ (+ (* -1 bb2) (sqrt delta2)) (* 2 aa)))
- (set! vtemp (min v1 v2))
- (set! stick 0)
- (if (> vtemp vb)
- (begin
- (set! v vb)
- (set! stick 1))
- (begin
- (set! v vtemp)
- (set! f (* zslope (- v vh) )))))))
- (begin
- (set! v1 (/ (- (* -1 bb2 ) (sqrt delta2)) (* 2 aa)))
- (set! v2 (/ (+ (* -1 bb2) (sqrt delta2)) (* 2 aa)))
- (set! v (min v1 v2))
- (set! stick 0)))))
- (if (> v vb)
- (begin
- (set! v vb)
- (set! stick 1))))))))
- (set! f (* zslope (- v vh)))
- (set! xnn (+ y1nb (/ f (* 2 stringImpedance))))
- (set! xnb (+ ynn (/ f (* 2 stringImpedance))))))
-
- (set! f (* zslope (- v vh)))
- (set! xnnt (+ ynbt (/ f (* 2 stringImpedancet))))
- (set! xnbt (+ ynnt (/ f (* 2 stringImpedancet))))
- (set! updl (modulo (inexact->exact (+ i posl bufsize)) bufsize))
- (set! updr (modulo (inexact->exact (+ i posr bufsize)) bufsize))
- (set! updlt (modulo (inexact->exact (+ i poslt bufsize)) bufsize))
- (set! updrt (modulo (inexact->exact (+ i posrt bufsize)) bufsize))
- (vct-set! vinbridge updl xnb)
- (vct-set! vinut updr xnn)
- (vct-set! vinbridget updlt xnbt)
- (vct-set! vinutt updrt xnnt)
- (locsig loc i (* xnb (env ampf)))
- (set! lhs #f)
- (set! rhs #f)))))
+ (let ((g1 (make-biquad b0b b1b b2b a1b a2b))
+ (g2 (make-biquad b0n b1n b2n a1n a2n))
+ (g3 (make-biquad b0bt b1bt b2bt a1bt a2bt))
+ (g4 (make-biquad b0nt b1nt b2nt a1nt a2nt)))
+
+ (define (bowfilt inharmon)
+ (set! ynb (filter g1 vib))
+ (set! ynn (filter g2 vin))
+ (set! ynbt (filter g3 vibt))
+ (set! ynnt (filter g4 vint))
+ (if (<= inharmon 0.00001) (set! inharmon 0.00001))
+ (if (>= inharmon 0.9999) (set! inharmon 0.9999))
+ (set! y1nb (+ (* -1 inharmon ynb) ynba1 (* inharmon ya1nb)))
+ (set! ya1nb y1nb)
+ (set! ynba1 ynb)
+ (set! y1nb (- y1nb))
+ (set! ynn (- ynn))
+ (set! ynbt (- ynbt)))
+
+ (if (< samp_rperiod 0) (set! samp_rperiod 0))
+ (if (> samp_rperiod (- bufsize 1)) (set! samp_rperiod (- bufsize 1)))
+ (if (< samp_lperiod 0) (set! samp_lperiod 0))
+ (if (> samp_lperiod (- bufsize 1)) (set! samp_lperiod (- bufsize 1)))
+ (set! alphar (* 1.0 (- del_right samp_rperiod)))
+ (set! alphal (* 1.0 (- del_left samp_lperiod)))
+ (if (< samp_rperiodt 0)(set! samp_rperiodt 0))
+ (if (> samp_rperiodt (- bufsize 1)) (set! samp_rperiodt (- bufsize 1)))
+ (if (< samp_lperiodt 0) (set! samp_lperiodt 0))
+ (if (> samp_lperiodt (- bufsize 1)) (set! samp_lperiodt (- bufsize 1)))
+ (set! alphart (* 1.0 (- del_rightt samp_rperiodt)))
+ (set! alphalt (* 1.0 (- del_leftt samp_lperiodt)))
+ (set! posr (modulo (floor (+ end posr)) bufsize))
+ (set! posl (modulo (floor (+ end posl)) bufsize))
+ (set! posrt (modulo (floor (+ end posrt)) bufsize))
+ (set! poslt (modulo (floor (+ end poslt)) bufsize))
+
+ (set! indexl (modulo (floor (- (+ beg posl bufsize) samp_lperiod)) bufsize))
+ (set! indexr (modulo (floor (- (+ beg posr bufsize) samp_rperiod)) bufsize))
+ (set! indexlt (modulo (floor (- (+ beg poslt bufsize) samp_lperiodt)) bufsize))
+ (set! indexrt (modulo (floor (- (+ beg posrt bufsize) samp_rperiodt)) bufsize))
+ (set! indexl_1 (modulo (floor (- (+ beg posl bufsize) samp_lperiod 1)) bufsize))
+ (set! indexr_1 (modulo (floor (- (+ beg posr bufsize) samp_rperiod 1)) bufsize))
+ (set! indexlt_1 (modulo (floor (- (+ beg poslt bufsize) samp_lperiodt 1)) bufsize))
+ (set! indexrt_1 (modulo (floor (- (+ beg posrt bufsize) samp_rperiodt 1)) bufsize))
+ (set! indexl_2 (modulo (floor (- (+ beg posl bufsize) samp_lperiod 2)) bufsize))
+ (set! indexr_2 (modulo (floor (- (+ beg posr bufsize) samp_rperiod 2)) bufsize))
+ (set! indexlt_2 (modulo (floor (- (+ beg poslt bufsize) samp_lperiodt 2)) bufsize))
+ (set! indexrt_2 (modulo (floor (- (+ beg posrt bufsize) samp_rperiodt 2)) bufsize))
+
+ (set! updl (modulo (floor (+ beg posl bufsize)) bufsize))
+ (set! updr (modulo (floor (+ beg posr bufsize)) bufsize))
+ (set! updlt (modulo (floor (+ beg poslt bufsize)) bufsize))
+ (set! updrt (modulo (floor (+ beg posrt bufsize)) bufsize))
+
+ (do ((i beg (+ i 1)))
+ ((= i end))
+
+ (set! vib (+ (/ (* (vinbridge indexl_2) (- alphal 1) (- alphal 2)) 2)
+ (* (vinbridge indexl_1) alphal -1 (- alphal 2))
+ (/ (* (vinbridge indexl) alphal (- alphal 1)) 2)))
+ (set! vin (+ (/ (* (vinut indexr_2) (- alphar 1) (- alphar 2)) 2)
+ (* (vinut indexr_1) alphar -1 (- alphar 2))
+ (/ (* (vinut indexr) (- alphar 1) alphar) 2)))
+ (set! vibt (+ (/ (* (vinbridget indexlt_2) (- alphalt 1)(- alphalt 2)) 2)
+ (* (vinbridget indexlt_1) alphalt -1 (- alphalt 2))
+ (/ (* (vinbridget indexlt) alphalt (- alphalt 1)) 2)))
+ (set! vint (+ (/ (* (vinutt indexrt_2) (- alphart 1) (- alphart 2)) 2)
+ (* (vinutt indexrt_1) alphart -1 (- alphart 2))
+ (/ (* (vinutt indexrt) (- alphart 1) alphart) 2)))
+ (bowfilt inharm)
+ (set! vh (+ ynn y1nb ynnt ynbt))
+
+ (set! aa zslope)
+ (set! bb1 (- (+ (* 0.2 zslope) (* 0.3 fb)) (* zslope vb) (* zslope vh)))
+ (set! cc1 (- (+ (* 0.06 fb) (* zslope vh vb)) (* 0.2 zslope vh) (* 0.3 vb fb)))
+ (set! delta1 (- (* bb1 bb1) (* 4 aa cc1)))
+ (set! bb2 (- (- (* -0.2 zslope) (* 0.3 fb)) (* zslope vb) (* zslope vh)))
+ (set! cc2 (+ (* 0.06 fb)
+ (* zslope vh vb)
+ (* 0.2 zslope vh)
+ (* 0.3 vb fb)
+ (* 0.1 fb)))
+ (set! delta2 (- (* bb2 bb2) (* 4 aa cc2)))
+ (if (or (= vb 0) (= fb 0))
+ (set! v vh)
+ (begin
+ (if (= vh vb)
+ (begin
+ (set! v vb)
+ (set! stick 1))
+ (begin
+ (if (> vh vb)
+ (begin
+ (set! lhs #f)
+ (set! rhs #t))
+ (begin
+ (set! rhs #f)
+ (set! lhs #t)))
+ (if rhs
+ (begin
+ (if (< delta1 0)
+ (begin
+ (set! v vb)
+ (set! stick 1))
+ (begin
+ (if (= stick 1)
+ (begin
+ (set! vtemp vb)
+ (set! f (* 2 zslope (- vtemp vh)))
+ (if (>= f (* -1 mus fb))
+ (set! v vtemp)
+ (begin
+ (set! v1 (/ (+ (- bb1) (sqrt delta1)) (* 2 aa)))
+ (set! v2 (/ (- (- bb1) (sqrt delta1)) (* 2 aa)))
+ (set! v (min v1 v2))
+ (set! stick 0))))
+ (begin
+ (set! v1 (/ (+ (- bb1) (sqrt delta1)) (* 2 aa)))
+ (set! v2 (/ (- (- bb1) (sqrt delta1)) (* 2 aa)))
+ (set! v (min v1 v2))
+ (set! stick 0))))))
+ (if lhs
+ (begin
+ (if (< delta2 0)
+ (begin
+ (set! v vb)
+ (set! stick 1))
+ (begin
+ (if (= stick 1)
+ (begin
+ (set! vtemp vb)
+ (set! f (* zslope (- vtemp vh)))
+ (if (and (<= f (* mus fb)) (> f 0))
+ (set! v vtemp)
+ (begin
+ (set! v1 (/ (- (- bb2) (sqrt delta2)) (* 2 aa)))
+ (set! v2 (/ (+ (- bb2) (sqrt delta2)) (* 2 aa)))
+ (set! vtemp (min v1 v2))
+ (set! stick 0)
+ (if (> vtemp vb)
+ (begin
+ (set! v vb)
+ (set! stick 1))
+ (begin
+ (set! v vtemp)
+ (set! f (* zslope (- v vh) )))))))
+ (begin
+ (set! v1 (/ (- (- bb2) (sqrt delta2)) (* 2 aa)))
+ (set! v2 (/ (+ (- bb2) (sqrt delta2)) (* 2 aa)))
+ (set! v (min v1 v2))
+ (set! stick 0)))))
+ (if (> v vb)
+ (begin
+ (set! v vb)
+ (set! stick 1))))))))
+ (set! f (* zslope (- v vh)))
+ (set! xnn (+ y1nb (/ f (* 2 stringImpedance))))
+ (set! xnb (+ ynn (/ f (* 2 stringImpedance))))))
+
+ (set! f (* zslope (- v vh)))
+ (set! xnnt (+ ynbt (/ f (* 2 stringImpedancet))))
+ (set! xnbt (+ ynnt (/ f (* 2 stringImpedancet))))
+
+ (set! (vinbridge updl) xnb)
+ (set! (vinut updr) xnn)
+ (set! (vinbridget updlt) xnbt)
+ (set! (vinutt updrt) xnnt)
+
+ (set! indexl (+ indexl 1)) (if (>= indexl bufsize) (set! indexl 0))
+ (set! indexr (+ indexr 1)) (if (>= indexr bufsize) (set! indexr 0))
+ (set! indexlt (+ indexlt 1)) (if (>= indexlt bufsize) (set! indexlt 0))
+ (set! indexrt (+ indexrt 1)) (if (>= indexrt bufsize) (set! indexrt 0))
+ (set! indexl_1 (+ indexl_1 1)) (if (>= indexl_1 bufsize) (set! indexl_1 0))
+ (set! indexr_1 (+ indexr_1 1)) (if (>= indexr_1 bufsize) (set! indexr_1 0))
+ (set! indexlt_1 (+ indexlt_1 1)) (if (>= indexlt_1 bufsize) (set! indexlt_1 0))
+ (set! indexrt_1 (+ indexrt_1 1)) (if (>= indexrt_1 bufsize) (set! indexrt_1 0))
+ (set! indexl_2 (+ indexl_2 1)) (if (>= indexl_2 bufsize) (set! indexl_2 0))
+ (set! indexr_2 (+ indexr_2 1)) (if (>= indexr_2 bufsize) (set! indexr_2 0))
+ (set! indexlt_2 (+ indexlt_2 1)) (if (>= indexlt_2 bufsize) (set! indexlt_2 0))
+ (set! indexrt_2 (+ indexrt_2 1)) (if (>= indexrt_2 bufsize) (set! indexrt_2 0))
+
+ (set! updl (+ updl 1)) (if (>= updl bufsize) (set! updl 0))
+ (set! updr (+ updr 1)) (if (>= updr bufsize) (set! updr 0))
+ (set! updlt (+ updlt 1)) (if (>= updlt bufsize) (set! updlt 0))
+ (set! updrt (+ updrt 1)) (if (>= updrt bufsize) (set! updrt 0))
+
+ (locsig loc i (* xnb (env ampf)))
+ (set! lhs #f)
+ (set! rhs #f))))))))
;(with-sound (:channels 2) (bow 0 3 400 0.5 :vb 0.15 :fb 0.1 :inharm 0.25))
;(with-sound (:channels 2) (bow 0 2 440 0.5 :fb 0.25))
diff --git a/stuff.scm b/stuff.scm
new file mode 100644
index 0000000..7747b81
--- /dev/null
+++ b/stuff.scm
@@ -0,0 +1,2028 @@
+;; some useful (or at least amusing) functions and macros
+
+(provide 'stuff.scm)
+
+(when (provided? 'pure-s7)
+ (define (let->list e) (reverse! (map values e)))
+ (define (memq a b) (member a b eq?))
+ (define (assq a b) (assoc a b eq?)))
+
+
+;;; ----------------
+(define empty?
+ (let ((documentation "(empty? obj) returns #t if obj is an empty sequence"))
+ (lambda (obj)
+ (if (hash-table? obj)
+ (zero? (hash-table-entries obj)) ; length here is table size
+ (eqv? (length obj) 0)))))
+
+(define applicable? arity)
+
+;(define sequence? length) -- now built-in for procedure-signatures
+
+(define indexable?
+ (let ((documentation "(indexable? obj) returns #t if obj can be applied to an index: (obj 0)"))
+ (lambda (obj)
+ (and (sequence? obj)
+ (applicable? obj)))))
+
+(define (ow!)
+ (call-with-output-string
+ (lambda (p)
+ (do ((e (outlet (owlet)) (outlet e)))
+ ((eq? e (rootlet)))
+ (format p "~{~A ~}~%" e)))))
+
+#|
+(set! (hook-functions *error-hook*)
+ (list (lambda (hook)
+ (apply format *stderr* (hook 'data))
+ (newline *stderr*)
+ (when ((owlet) 'error-line)
+ (format *stderr* "~S line ~A~%" ((owlet) 'error-file) ((owlet) 'error-line)))
+ (do ((e (outlet (owlet)) (outlet e)))
+ ((eq? e (rootlet)))
+ (format *stderr* "~{ ~A~%~}~%" e))
+ (format *stderr* "~%~A~%" (stacktrace)))))
+|#
+
+
+;;; ----------------
+(define (first obj) (if (sequence? obj) (obj 0) (error "first argument, ~S, is not a sequence" obj)))
+(define (second obj) (if (sequence? obj) (obj 1) (error "second argument, ~S, is not a sequence" obj)))
+(define (third obj) (if (sequence? obj) (obj 2) (error "third argument, ~S, is not a sequence" obj)))
+(define (fourth obj) (if (sequence? obj) (obj 3) (error "fourth argument, ~S, is not a sequence" obj)))
+(define (fifth obj) (if (sequence? obj) (obj 4) (error "fifth argument, ~S, is not a sequence" obj)))
+(define (sixth obj) (if (sequence? obj) (obj 5) (error "sixth argument, ~S, is not a sequence" obj)))
+(define (seventh obj)(if (sequence? obj) (obj 6) (error "seventh argument, ~S, is not a sequence" obj)))
+(define (eighth obj) (if (sequence? obj) (obj 7) (error "eighthment, ~S, is not a sequence" obj)))
+(define (ninth obj) (if (sequence? obj) (obj 8) (error "ninth argument, ~S, is not a sequence" obj)))
+(define (tenth obj) (if (sequence? obj) (obj 9) (error "tenth argument, ~S, is not a sequence" obj)))
+
+
+(define iota
+ (let ((documentation "(iota n (start 0) (incr 1)) returns a list counting from start for n:\n\
+ (iota 3) -> '(0 1 2)"))
+ (lambda* (n (start 0) (incr 1))
+ (if (or (not (integer? n))
+ (< n 0))
+ (error 'wrong-type-arg "iota length ~A should be a non-negative integer" n))
+ (let ((lst (make-list n)))
+ (do ((p lst (cdr p))
+ (i start (+ i incr)))
+ ((null? p) lst)
+ (set! (car p) i))))))
+
+(define (cdr* lst n)
+ (do ((i n (- i 1))
+ (result lst (cdr result)))
+ ((or (null? result)
+ (zero? i))
+ result)))
+
+(define make-circular-list
+ (let ((documentation "(make-circular-list n init) returns a circular list with n entries initialized to init:\n\
+ (make-circular-list 3 #f) -> #1=(#f #f #f . #1#)"))
+ (lambda* (n init)
+ (let ((l (make-list n init)))
+ (set-cdr! (list-tail l (- n 1)) l)))))
+
+(define circular-list
+ (let ((documentation "(circular-list . objs) returns a circular list with objs:\n\
+ (circular-list 1 2) -> #1=(1 2 . #1#)"))
+ (lambda objs
+ (let ((lst (copy objs)))
+ (set-cdr! (list-tail lst (- (length lst) 1)) lst)))))
+
+(define circular-list?
+ (let ((documentation "(circular-list? obj) returns #t if obj is a circular list"))
+ (lambda (obj)
+ (catch #t
+ (lambda () (infinite? (length obj)))
+ (lambda args #f)))))
+
+(define linearize
+ (let ((documentation " (linearize lst) turns a circular list into normal list:\n\
+ (linearize (circular-list 1 2)) -> '(1 2)"))
+ (lambda (lst)
+ (define (lin-1 lst result sofar)
+ (if (or (not (pair? lst))
+ (memq lst sofar))
+ (reverse! result)
+ (lin-1 (cdr lst)
+ (cons (car lst) result)
+ (cons lst sofar))))
+ (lin-1 lst () ()))))
+
+(define cyclic?
+ (let ((documentation "(cyclic obj) returns #t if the sequence obj contains any cycles"))
+ (lambda (obj)
+ (pair? (cyclic-sequences obj)))))
+
+
+(define copy-tree
+ (let ((documentation "(copy-tree lst) returns a full copy of lst"))
+ (lambda (lis)
+ (if (pair? lis)
+ (cons (copy-tree (car lis))
+ (copy-tree (cdr lis)))
+ lis))))
+
+(define tree-member
+ (let ((documentation "(tree-member sym tree) returns #t if sym is found anywhere in tree:\n\
+ (tree-member 'a '(1 (2 a))) -> #t"))
+ (lambda (sym tree)
+ (and (pair? tree)
+ (or (eq? (car tree) sym)
+ (and (pair? (car tree))
+ (tree-member sym (car tree)))
+ (tree-member sym (cdr tree)))))))
+
+(define adjoin
+ (let ((documentation "(adjoin obj lst) adds obj to lst if it is not already in lst, returning the new list"))
+ (lambda (obj lst)
+ (if (member obj lst) lst (cons obj lst)))))
+
+(define (cdr-assoc obj lst)
+ (cond ((assoc obj lst) => cdr)
+ (else #f)))
+
+
+
+;;; ----------------
+(define-macro (fully-macroexpand form)
+ (define (expand form)
+ (if (pair? form)
+ (if (and (symbol? (car form))
+ (macro? (symbol->value (car form))))
+ (expand (apply macroexpand (list form)))
+ (if (and (eq? (car form) 'set!) ; look for (set! (mac ...) ...) and use mac's procedure-setter
+ (pair? (cdr form))
+ (pair? (cadr form))
+ (macro? (symbol->value (caadr form))))
+ (expand (apply (eval (procedure-source (procedure-setter (symbol->value (caadr form)))))
+ (append (cdadr form) (cddr form))))
+ (cons (expand (car form))
+ (expand (cdr form)))))
+ form))
+ (list 'quote (expand form)))
+
+(define-macro (define-with-macros name&args . body)
+ `(apply define ',name&args (list (fully-macroexpand `(begin ,, at body)))))
+
+(define setf
+ (let ((args (gensym))
+ (name (gensym)))
+ (apply define-bacro `((,name . ,args)
+ (unless (null? ,args)
+ (apply set! (car ,args) (cadr ,args) ())
+ (apply setf (cddr ,args)))))))
+
+
+(define-macro* (incf sym (inc 1))
+ `(set! ,sym (+ ,sym ,inc))) ; or ({list} set! sym ({list} + sym inc))
+
+;; (define-bacro* (incf-1 sym (inc 1)) (apply set! sym (list + sym inc) ()))
+
+(define-macro* (decf sym (dec 1))
+ `(set! ,sym (- ,sym ,dec)))
+
+(define-macro (shiftf . places)
+ (let ((tmp (gensym)))
+ `(let ((,tmp ,(car places)))
+ ,@(map (lambda (a b)
+ `(set! ,a ,b))
+ places
+ (cdr places))
+ ,tmp)))
+
+(define-macro (rotatef . places)
+ (let ((tmp (gensym))
+ (last (car (list-tail places (- (length places) 1)))))
+ `(let ((,tmp ,(car places)))
+ ,@(map (lambda (a b)
+ `(set! ,a ,b))
+ places
+ (cdr places))
+ (set! ,last ,tmp))))
+
+(define-macro (progv vars vals . body)
+ `(apply (apply lambda ,vars ',body) ,vals))
+
+(define-macro (symbol-set! var val) ; like CL's set
+ `(apply set! ,var ',val ()))
+
+(define-macro (value->symbol expr)
+ `(let ((val ,expr)
+ (e1 (curlet)))
+ (call-with-exit
+ (lambda (return)
+ (do ((e e1 (outlet e))) ()
+ (for-each
+ (lambda (slot)
+ (if (equal? val (cdr slot))
+ (return (car slot))))
+ e)
+ (if (eq? e (rootlet))
+ (return #f)))))))
+
+(define-macro (enum . args)
+ `(for-each define ',args (iota (length ',args))))
+
+(define-macro (destructuring-bind lst expr . body) ; if only there were some use for this!
+ `(let ,(letrec ((flatten (lambda (lst1 lst2 args)
+ (cond ((null? lst1) args)
+ ((not (pair? lst1))
+ (cons (list lst1 lst2) args))
+ (#t (flatten (car lst1) (car lst2)
+ (flatten (cdr lst1) (cdr lst2) args)))))))
+ (flatten lst (eval expr) ()))
+ , at body))
+
+(define-macro (and-let* vars . body)
+ `(let () ; bind vars, if any is #f stop, else evaluate body with those bindings
+ (and ,@(map (lambda (var)
+ `(begin
+ (apply define ',var)
+ ,(car var)))
+ vars)
+ (begin , at body))))
+
+(define-macro (while test . body) ; while loop with predefined break and continue
+ `(call-with-exit
+ (lambda (break)
+ (letrec ((continue (lambda ()
+ (if (let () ,test)
+ (begin
+ (let () , at body)
+ (continue))
+ (break)))))
+ (continue)))))
+
+(define-macro (do* spec end . body)
+ `(let* (,@(map (lambda (var)
+ (list (car var) (cadr var)))
+ spec))
+ (do () ,end
+ , at body
+ ,@(map (lambda (var)
+ (if (pair? (cddr var))
+ `(set! ,(car var) ,(caddr var))
+ (values)))
+ spec))))
+
+(define-macro (string-case selector . clauses)
+ `(case (symbol ,selector) ; case with string constant keys
+ ,@(map (lambda (clause)
+ (if (pair? (car clause))
+ `(,(map symbol (car clause)) ,@(cdr clause))
+ clause))
+ clauses)))
+
+(define-macro (eval-case key . clauses) ; case with evaluated key-lists
+ (let ((select (gensym)))
+ `(let ((,select ,key))
+ (cond ,@(map (lambda (lst)
+ (if (pair? (car lst))
+ (cons `(member ,select (list ,@(car lst)))
+ (cdr lst))
+ lst))
+ clauses)))))
+
+
+
+;;; ----------------
+(define hash-table->alist
+ (let ((documentation "(hash-table->alist table) returns the contents of table as an association list:\n\
+ (hash-table->alist (hash-table '(a . 1))) -> '((a . 1))"))
+ (lambda (table)
+ (if (hash-table? table)
+ (map values table)
+ (error "hash-table->alist argument, ~A, is not a hash-table" table)))))
+
+(define merge-hash-tables
+ (let ((documentation "(merge-hash-tables . tables) returns a new hash-table with the contents of all the tables"))
+ (lambda tables
+ (apply hash-table
+ (apply append
+ (map hash-table->alist tables))))))
+
+
+
+;;; ----------------
+(define-macro (c?r path)
+ (define (X-marks-the-spot accessor tree)
+ (if (pair? tree)
+ (or (X-marks-the-spot (cons 'car accessor) (car tree))
+ (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))
+ (and (eq? tree 'X) accessor)))
+ (let ((body 'lst))
+ (for-each
+ (lambda (f)
+ (set! body (list f body)))
+ (reverse (X-marks-the-spot () path)))
+ `(dilambda
+ (lambda (lst)
+ ,body)
+ (lambda (lst val)
+ (set! ,body val)))))
+
+
+
+;;; ----------------
+(define find-if
+ (let ((documentation "(find-if func sequence) applies func to each member of sequence.\n\
+If func approves of one, find-if returns that member of the sequence"))
+ (lambda (f sequence)
+ (call-with-exit
+ (lambda (return)
+ (for-each (lambda (arg)
+ (if (f arg)
+ (return arg)))
+ sequence)
+ #f)))))
+
+(define member?
+ (let ((documentation "(member? obj sequence) returns #t if obj is an element of sequence"))
+ (lambda (obj sequence)
+ (find-if (lambda (x) (equal? x obj)) sequence))))
+
+
+(define index-if
+ (let ((documentation "(index-if func sequence) applies func to each member of sequence.\n\
+If func approves of one, index-if returns the index that gives that element's position.\n\
+ (index-if (lambda (x) (= x 32)) #(0 1 32 4)) -> 2\n\
+ (index-if (lambda (x) (= (cdr x) 32)) (hash-table '(a . 1) '(b . 32))) -> 'b"))
+ (lambda (f sequence)
+ (call-with-exit
+ (lambda (return)
+ (if (or (hash-table? sequence)
+ (let? sequence))
+ (for-each (lambda (arg)
+ (if (f arg) (return (car arg))))
+ sequence)
+ (let ((position 0))
+ (for-each (lambda (arg)
+ (if (f arg) (return position))
+ (set! position (+ position 1)))
+ sequence)))
+ #f)))))
+
+(define count-if
+ (let ((documentation "(count-if func sequence) applies func to each member of sequence, returning the number of times func approves."))
+ (lambda (f sequence)
+ (let ((count 0))
+ (for-each (lambda (arg)
+ (if (f arg)
+ (set! count (+ count 1))))
+ sequence)
+ count))))
+
+(define every?
+ (let ((documentation "(every? func sequence) returns #t if func approves of every member of sequence"))
+ (lambda (f sequence)
+ (not (member #f sequence (lambda (a b) (not (f b))))))))
+
+(define any?
+ (let ((documentation "(any? func sequence) returns #t if func approves of any member of sequence"))
+ (lambda (f sequence)
+ (member #f sequence (lambda (a b) (f b))))))
+
+(define collect-if
+ (let ((documentation "(collect-if type func sequence) gathers the elements of sequence that satisfy func, and returns them via type:\n\
+ (collect-if list integer? #(1.4 2/3 1 1+i 2)) -> '(1 2)"))
+ (lambda (type f sequence)
+ (apply type (map (lambda (arg) (if (f arg) arg (values))) sequence)))))
+
+;;; if type=list, this is slightly wasteful because list currently copies its args, so:
+;;; ((if (eq? type list) values (values apply type)) ...) would work
+;;;
+;;; to return (f arg) rather than arg, (apply type (map f sequence))
+
+(define remove-if
+ (let ((documentation "(remove-if type f sequence) returns via type the elements of sequence that do not satisfy func:\n\
+ (remove-if list integer? #(1.4 2/3 1 1+i 2)) -> '(1.4 2/3 1+1i)"))
+ (lambda (type f sequence)
+ (collect-if type (lambda (obj) (not (f obj))) sequence))))
+
+(define nonce
+ (let ((documentation "(nonce type sequence) returns via type the elements of sequence that occur only once"))
+ (lambda (type sequence)
+ (collect-if type (lambda (obj) (= (count-if (lambda (x) (equal? x obj)) sequence) 1)) sequence))))
+
+
+(define full-find-if
+ (let ((documentation "(full-find-if func sequence) searches sequence, and recursively any sequences it contains, for an element that satisfies func"))
+ (lambda (f sequence)
+ (if (and (procedure? f)
+ (aritable? f 1))
+ (if (sequence? sequence)
+ (call-with-exit
+ (lambda (return)
+ (letrec ((full-find-if-1
+ (lambda (seq)
+ (for-each (lambda (x)
+ (if (f x)
+ (return x)
+ (if (sequence? x)
+ (full-find-if-1 x))))
+ seq))))
+ (full-find-if-1 sequence))
+ #f))
+ (error "full-find-if second argument, ~A, is not a sequence" sequence))
+ (error "full-find-if first argument, ~A, is not a procedure of one argument" f)))))
+
+(define full-count-if
+ (let ((documentation "(full-count-if func sequence) searches sequence, and recursively any sequences it contains, returning the number of elements that satisfy func"))
+ (lambda (f sequence)
+ (let ((count 0))
+ (full-find-if (lambda (x) (if (f x) (set! count (+ count 1))) #f) sequence)
+ count))))
+
+(define full-index-if
+ (let ((documentation "(full-index-if func sequence) searches sequence, and recursively any sequences it contains, returning the indices of the first element that satisfies func:\n\
+ (full-index-if (lambda (x) (and (integer? x) (= x 3))) '(1 (2 3))) -> '(1 1)"))
+ (lambda (f sequence)
+ (call-with-exit
+ (lambda (return)
+ (letrec ((full-index-if-1
+ (lambda (f seq path)
+ (if (or (hash-table? seq)
+ (let? seq))
+ (for-each (lambda (arg)
+ (if (f arg)
+ (return (reverse (cons (car arg) path)))
+ (if (indexable? (cdr arg))
+ (full-index-if-1 f (cdr arg) (cons (car arg) path)))))
+ seq)
+ (let ((position 0))
+ (for-each (lambda (arg)
+ (if (f arg)
+ (return (reverse (cons position path)))
+ (if (indexable? arg)
+ (full-index-if-1 f arg (cons position path))))
+ (set! position (+ position 1)))
+ seq))))))
+ (full-index-if-1 f sequence ())
+ #f))))))
+
+
+(define (make-complete-iterator obj)
+ (make-iterator
+ (let ((iters ())
+ (cycles (cyclic-sequences obj))
+ (seen-cycles ()))
+
+ (define (iter-memq p q)
+ (and (pair? q)
+ (or (eq? p (iterator-sequence (car q)))
+ (iter-memq p (cdr q)))))
+
+ (define (make-careful-iterator p)
+ (if (not (pair? p))
+ (make-iterator p)
+ (let ((len (length p)))
+ (if (infinite? len) ; circular list
+ (make-iterator
+ (let ((cur p)
+ (iterator? #t))
+ (lambda ()
+ (if (memq cur seen-cycles)
+ #<eof>
+ (let ((result (car cur)))
+ (if (memq cur cycles)
+ (set! seen-cycles (cons cur seen-cycles)))
+ (set! cur (cdr cur))
+ result)))))
+ (if (positive? len) ; normal list
+ (make-iterator p)
+ (make-iterator ; dotted list
+ (let ((cur p)
+ (iterator? #t))
+ (lambda ()
+ (if (pair? cur)
+ (let ((result (car cur)))
+ (set! cur (cdr cur))
+ result)
+ (let ((result cur))
+ (set! cur #<eof>)
+ result))))))))))
+
+ (let ((iter (make-careful-iterator obj)))
+ (let ((iterator? #t))
+ (define (iterloop) ; define returns the new value
+ (let ((result (iter)))
+ (if (length result)
+ (if (or (memq result seen-cycles) ; we've dealt with it already, so skip it
+ (eq? result (iterator-sequence iter))
+ (iter-memq result iters)) ; we're dealing with it the right now
+ (iterloop) ; this means the outermost sequence is ignored if encountered during the traversal
+ (begin
+ (set! iters (cons iter iters))
+ (set! iter (make-careful-iterator result))
+ result))
+ (if (eq? result #<eof>)
+ (if (null? iters)
+ #<eof>
+ (begin
+ (set! seen-cycles (cons (iterator-sequence iter) seen-cycles))
+ (set! iter (car iters))
+ (set! iters (cdr iters))
+ (iterloop)))
+ result)))))))))
+
+
+(define safe-find-if
+ (let ((documentation "(safe-find-if func sequence) searches sequence, and recursively any sequences it contains, for an element that satisfies func.\
+Unlike full-find-if, safe-find-if can handle any circularity in the sequences."))
+ (lambda (f sequence)
+ (let ((iter (make-complete-iterator sequence)))
+ (let loop ((x (iter)))
+ (if (f x) x
+ (if (and (eq? x #<eof>)
+ (iterator-at-end? iter))
+ #f
+ (loop (iter)))))))))
+
+(define (safe-count-if f sequence)
+ ;; currently the complete-iterator above skips repetitions, including the outer sequence,
+ ;; so this count will be off if there are repeated cycles?
+ ;; Perhaps make an iterator that returns everything.
+ (if (sequence? sequence)
+ (if (procedure? f)
+ (let ((count 0))
+ (safe-find-if (lambda (x) (if (f x) (set! count (+ count 1))) #f) sequence)
+ count)
+ (error "safe-count-if first argument, ~A, should be a function" f))
+ (error "safe-count-if second argument, ~A, should be a sequence" sequence)))
+
+
+
+
+;;; ----------------
+(define sequences->list
+ (let ((documentation "(sequences->list . sequences) returns a list of elements of all the sequences:\n\
+ (sequences->list \"hi\" #(0 1) (hash-table '(a . 2))) -> '(#\\h #\\i 0 1 (a . 2))"))
+ (lambda sequences
+ (apply append
+ (map (lambda (sequence)
+ (map values sequence))
+ sequences)))))
+
+(define concatenate
+ (let ((documentation "(concatenate type . sequences) concatenates sequences returning an object of type:\n\
+ (concatenate vector '(1 2) #(3 4)) -> #(1 2 3 4)"))
+ (lambda (type . sequences)
+ (apply type (apply sequences->list sequences)))))
+
+(define intersection
+ (let ((documentation "(intersection type . sequences) returns via type the intersection of the sequences:\n\
+ (intersection vector '(1 2 3) #(2 3 4)) -> #(2 3)"))
+ (lambda (type . sequences)
+ (if (every? sequence? sequences)
+ (apply type (let ((lst ()))
+ (if (pair? sequences)
+ (for-each (lambda (obj)
+ (if (every? (lambda (seq)
+ (find-if (lambda (x)
+ (equal? x obj))
+ seq))
+ (cdr sequences))
+ (set! lst (cons obj lst))))
+ (car sequences)))
+ (reverse lst)))
+ (error "intersection arguments should be sequences: ~A" sequences)))))
+
+(define union
+ (let ((documentation "(union type . sequences) returns via type the union of the sequences:\n\
+ (union vector '(1 2 3) #(2 3 4)) -> #(1 2 3 4)"))
+ (lambda (type . sequences)
+ (apply type (let ((lst ()))
+ (for-each (lambda (obj)
+ (if (not (member obj lst))
+ (set! lst (cons obj lst))))
+ (apply sequences->list sequences))
+ (reverse lst))))))
+
+(define asymmetric-difference
+ (let ((documentation "(asymmetric-difference type . sequences) returns the elements in the rest of the sequences that are not in the first:\n\
+ (asymmetric-difference vector '(1 2 3) #(2 3 4) '(1 5)) -> #(4 5)"))
+ (lambda (type . sequences) ; complement, elements in B's not in A
+ (if (and (pair? sequences)
+ (pair? (cdr sequences)))
+ (collect-if type (lambda (obj)
+ (not (member obj (car sequences))))
+ (apply union list (cdr sequences)))
+ (apply type ())))))
+
+(define cl-set-difference
+ (let ((documentation "(cl-set-difference type .sequences) returns the elements in the first sequence that are not in the rest of the sequences:\n\
+ (cl-set-difference vector '(1 2 3) #(2 3 4) '(1 5)) -> #()"))
+ (lambda (type . sequences) ; CL: elements in A not in B's
+ (if (and (pair? sequences)
+ (pair? (cdr sequences)))
+ (let ((others (apply union list (cdr sequences))))
+ (collect-if type (lambda (obj)
+ (not (member obj others)))
+ (car sequences)))
+ (apply type ())))))
+
+(define symmetric-difference
+ (let ((documentation "(symmetric-difference type .sequences) returns the elements that are in an odd number of the sequences:\n\
+ (symmetric-difference vector '(1 2 3) #(2 3 4) '(5)) -> #(1 4 5)"))
+ (lambda (type . sequences) ; xor, elements in an odd number of sequences (logxor A B...)
+ (let ((all (apply sequences->list sequences)))
+ (collect-if type (lambda (obj)
+ (odd? (count-if (lambda (x)
+ (equal? x obj))
+ all)))
+ (apply union list sequences))))))
+
+(define power-set
+ (let ((documentation "(power-set type . sequences) returns the power set of the union of the elements in the sequences."))
+ (lambda (type . sequences) ; ignoring repeats
+ (letrec ((pset (lambda (set)
+ (if (null? set)
+ '(())
+ (let ((rest (pset (cdr set))))
+ (append rest (map (lambda (subset)
+ (cons (car set) subset))
+ rest)))))))
+ (apply type (pset (apply union list sequences)))))))
+
+
+
+;;; ----------------
+(define ->predicate
+ (let ((predicates (list integer? rational? real? complex? number?
+ byte-vector? string?
+ float-vector? int-vector? vector?
+ null? proper-list? pair? list?
+ keyword? gensym? symbol?
+ char? string?
+ hash-table?
+ iterator?
+ continuation?
+ input-port? output-port?
+ let?
+ dilambda? procedure? macro?
+ boolean?
+ random-state?
+ eof-object?
+ c-object?
+ c-pointer?
+ (lambda (obj)
+ (eq? obj #<unspecified>))
+ (lambda (obj)
+ (eq? obj #<undefined>))
+ (lambda (obj)
+ (memq obj (list quote if when unless begin set! let let* letrec letrec* cond and or case do
+ lambda lambda* define define* define-macro define-macro* define-bacro define-bacro*
+ define-constant with-baffle macroexpand with-let)))))
+ (documentation "(->predicate obj) returns the type predicate function for obj: (->predicate 31) -> integer?"))
+ (lambda (obj)
+ (find-if (lambda (pred) (pred obj)) predicates))))
+
+(define add-predicate
+ (let ((documentation "(add-predicate p) adds p (a boolean function of one argument) to the list of predicates used by ->predicate"))
+ (lambda (p)
+ (if (and (procedure? p)
+ (aritable? p 1))
+ (let ((e (funclet ->predicate)))
+ (set! (e 'predicates) (cons p (e 'predicates))))
+ (error "add-predicate argument, ~A, is not a procedure of one argument" p)))))
+
+(define typeq?
+ (let ((documentation "(typeq? . objs) returns #t if all objs have the same type (as determined by ->predicate)"))
+ (lambda objs
+ (or (null? objs)
+ (every? (->predicate (car objs)) (cdr objs))))))
+
+(define-macro (typecase expr . clauses) ; actually type=any boolean func
+ (let ((obj (gensym)))
+ `(begin ; normally this would be (let ((,obj ,expr)) ...)
+ (define ,obj ,expr) ; but use begin so that internal defines are not blocked
+ (cond ,@(map (lambda (clause)
+ (if (memq (car clause) '(#t else))
+ clause
+ (if (= (length (car clause)) 1)
+ `((,(caar clause) ,obj) ,@(cdr clause))
+ `((or ,@(map (lambda (type)
+ `(,type ,obj))
+ (car clause)))
+ ,@(cdr clause)))))
+ clauses)))))
+
+
+
+;;; ----------------
+(define 2^n?
+ (let ((documentation "(2^n? x) returns #t if x is a power of 2"))
+ (lambda (x)
+ (and (integer> x)
+ (not (zero? x))
+ (zero? (logand x (- x 1)))))))
+
+(define (2^n-1? x)
+ (and (integer? x)
+ (zero? (logand x (+ x 1)))))
+
+(define (lognand . ints)
+ (lognot (apply logand ints)))
+
+(define (lognor . ints)
+ (lognot (apply logior ints)))
+
+(define (logeqv . ints)
+ (if (odd? (length ints))
+ (lognot (apply logxor -1 ints)) ; Clisp does it this way
+ (lognot (apply logxor ints))))
+
+(define (log-none-of . ints) ; bits on in none of ints
+ (lognot (apply logior ints)))
+
+(define (log-all-of . ints) ; bits on in all of ints
+ (apply logand ints))
+
+(define (log-any-of . ints) ; bits on in at least 1 of ints
+ (apply logior ints))
+
+(define (log-n-of n . ints) ; return the bits on in exactly n of ints
+ (if (integer? n)
+ (if (every? integer? ints)
+ (let ((len (length ints)))
+ (cond ((= len 0) (if (= n 0) -1 0))
+ ((= n 0) (lognot (apply logior ints)))
+ ((= n len) (apply logand ints))
+ ((> n len) 0)
+ (#t
+ (do ((1s 0)
+ (prev ints)
+ (i 0 (+ i 1)))
+ ((= i len) 1s)
+ (let ((cur (ints i)))
+ (if (= i 0)
+ (set! 1s (logior 1s (logand cur (apply log-n-of (- n 1) (cdr ints)))))
+ (let* ((mid (cdr prev))
+ (nxt (if (= i (- len 1)) () (cdr mid))))
+ (set! (cdr prev) nxt)
+ (set! 1s (logior 1s (logand cur (apply log-n-of (- n 1) ints))))
+ (set! (cdr prev) mid)
+ (set! prev mid))))))))
+ (error "log-n-of ints arguments, ~A, should all be integers" ints))
+ (error "log-n-of first argument, ~A, should be an integer" n)))
+
+;; from Rick
+(define (byte siz pos) ;; -> cache size, position and mask.
+ (list siz pos (ash (- (ash 1 siz) 1) pos)))
+
+(define byte-size car)
+(define byte-position cadr)
+(define byte-mask caddr)
+
+(define (ldb bytespec integer)
+ (ash (logand integer (byte-mask bytespec))
+ (- (byte-position bytespec))))
+
+(define (dpb integer bytespec into)
+ (logior (ash (logand integer (- (ash 1 (byte-size bytespec)) 1)) (byte-position bytespec))
+ (logand into (lognot (byte-mask bytespec)))))
+
+
+;;; ----------------
+(define-macro* (define-class class-name inherited-classes (slots ()) (methods ()))
+ `(let ((outer-env (outlet (curlet)))
+ (new-methods ())
+ (new-slots ()))
+
+ (for-each
+ (lambda (class)
+ ;; each class is a set of nested environments, the innermost (first in the list)
+ ;; holds the local slots which are copied each time an instance is created,
+ ;; the next holds the class slots (global to all instances, not copied);
+ ;; these hold the class name and other such info. The remaining environments
+ ;; hold the methods, with the localmost method first. So in this loop, we
+ ;; are gathering the local slots and all the methods of the inherited
+ ;; classes, and will splice them together below as a new class.
+
+ (set! new-slots (append (let->list class) new-slots))
+ (do ((e (outlet (outlet class)) (outlet e)))
+ ((or (not (let? e))
+ (eq? e (rootlet))))
+ (set! new-methods (append (let->list e) new-methods))))
+ ,inherited-classes)
+
+ (let ((remove-duplicates
+ (lambda (lst) ; if multiple local slots with same name, take the localmost
+ (letrec ((rem-dup
+ (lambda (lst nlst)
+ (cond ((null? lst) nlst)
+ ((assq (caar lst) nlst) (rem-dup (cdr lst) nlst))
+ (else (rem-dup (cdr lst) (cons (car lst) nlst)))))))
+ (reverse (rem-dup lst ()))))))
+ (set! new-slots
+ (remove-duplicates
+ (append (map (lambda (slot)
+ (if (pair? slot)
+ (cons (car slot) (cadr slot))
+ (cons slot #f)))
+ ,slots) ; the incoming new slots, #f is the default value
+ new-slots)))) ; the inherited slots
+
+ (set! new-methods
+ (append (map (lambda (method)
+ (if (pair? method)
+ (cons (car method) (cadr method))
+ (cons method #f)))
+ ,methods) ; the incoming new methods
+
+ ;; add an object->string method for this class (this is already a generic function).
+ (list (cons 'object->string
+ (lambda* (obj (use-write #t))
+ (if (eq? use-write :readable) ; write readably
+ (format #f "(make-~A~{ :~A ~W~^~})"
+ ',class-name
+ (map (lambda (slot)
+ (values (car slot) (cdr slot)))
+ obj))
+ (format #f "#<~A: ~{~A~^ ~}>"
+ ',class-name
+ (map (lambda (slot)
+ (list (car slot) (cdr slot)))
+ obj))))))
+ (reverse! new-methods))) ; the inherited methods, shadowed automatically
+
+ (let ((new-class (openlet
+ (apply sublet ; the local slots
+ (sublet ; the global slots
+ (apply inlet ; the methods
+ (reverse new-methods))
+ 'class-name ',class-name ; class-name slot
+ 'inherited ,inherited-classes
+ 'inheritors ()) ; classes that inherit from this class
+ new-slots))))
+
+ (varlet outer-env
+ ',class-name new-class ; define the class as class-name in the calling environment
+
+ ;; define class-name? type check
+ (string->symbol (string-append (symbol->string ',class-name) "?"))
+ (lambda (obj)
+ (and (let? obj)
+ (eq? (obj 'class-name) ',class-name))))
+
+ (varlet outer-env
+ ;; define the make-instance function for this class.
+ ;; Each slot is a keyword argument to the make function.
+ (string->symbol (string-append "make-" (symbol->string ',class-name)))
+ (apply lambda* (map (lambda (slot)
+ (if (pair? slot)
+ (list (car slot) (cdr slot))
+ (list slot #f)))
+ new-slots)
+ `((let ((new-obj (copy ,,class-name)))
+ ,@(map (lambda (slot)
+ `(set! (new-obj ',(car slot)) ,(car slot)))
+ new-slots)
+ new-obj))))
+
+ ;; save inheritance info for this class for subsequent define-method
+ (letrec ((add-inheritor (lambda (class)
+ (for-each add-inheritor (class 'inherited))
+ (if (not (memq new-class (class 'inheritors)))
+ (set! (class 'inheritors) (cons new-class (class 'inheritors)))))))
+ (for-each add-inheritor ,inherited-classes))
+
+ ',class-name)))
+
+(define-macro (define-generic name) ; (define (genfun any) ((any 'genfun) any))
+ `(define ,name
+ (lambda args
+ (let ((gf ((car args) ',name))) ; get local definition
+ (if (not (eq? gf ,name)) ; avoid infinite recursion
+ (apply gf args)
+ (error "attempt to call generic function wrapper recursively"))))))
+
+(define-macro (define-slot-accessor name slot)
+ `(define ,name (dilambda
+ (lambda (obj) (obj ',slot))
+ (lambda (obj val) (set! (obj ',slot) val)))))
+
+(define-macro (define-method name-and-args . body)
+ `(let* ((outer-env (outlet (curlet)))
+ (method-name (car ',name-and-args))
+ (method-args (cdr ',name-and-args))
+ (object (caar method-args))
+ (class (symbol->value (cadar method-args)))
+ (old-method (class method-name))
+ (method (apply lambda* method-args ',body)))
+
+ ;; define the method as a normal-looking function
+ ;; s7test.scm has define-method-with-next-method that implements call-next-method here
+ ;; it also has make-instance
+ (varlet outer-env
+ method-name (apply lambda* method-args
+ `(((,object ',method-name)
+ ,@(map (lambda (arg)
+ (if (pair? arg) (car arg) arg))
+ method-args)))))
+
+ ;; add the method to the class
+ (varlet (outlet (outlet class)) method-name method)
+
+ ;; if there are inheritors, add it to them as well, but not if they have a shadowing version
+ (for-each
+ (lambda (inheritor)
+ (if (not (eq? (inheritor method-name) #<undefined>)) ; defined? goes to the global env
+ (if (eq? (inheritor method-name) old-method)
+ (set! (inheritor method-name) method))
+ (varlet (outlet (outlet inheritor)) method-name method)))
+ (class 'inheritors))
+
+ method-name))
+
+(define (all-methods obj method)
+ ;; for arbitrary method combinations: this returns a list of all the methods of a given name
+ ;; in obj's class and the classes it inherits from (see example below)
+ (if (symbol? method)
+ (let* ((base-method (obj method))
+ (methods (if (procedure? base-method) (list base-method) ())))
+ (for-each
+ (lambda (ancestor)
+ (let ((next-method (ancestor method)))
+ (if (and (procedure? next-method)
+ (not (memq next-method methods)))
+ (set! methods (cons next-method methods)))))
+ (obj 'inherited))
+ (reverse methods))
+ (error "all-methods 'method argument should be a symbol: ~A" method)))
+
+
+
+;;; ----------------
+(define for-each-subset
+ (let ((documentation "(for-each-subset func args) forms each subset of args, then applies func to the subsets that fit its arity"))
+ (lambda (func args)
+ (define (subset source dest len)
+ (if (null? source)
+ (if (aritable? func len) ; does this subset fit?
+ (apply func dest))
+ (begin
+ (subset (cdr source) (cons (car source) dest) (+ len 1))
+ (subset (cdr source) dest len))))
+ (subset args () 0))))
+
+(define for-each-permutation
+ (let ((documentation "(for-each-permutation func vals) applies func to every permutation of vals:\n\
+ (for-each-permutation (lambda args (format #t \"~{~A~^ ~}~%\" args)) '(1 2 3))"))
+ (lambda (func vals)
+ (define (pinner cur nvals len)
+ (if (= len 1)
+ (apply func (cons (car nvals) cur))
+ (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish
+ ((= i len))
+ (let ((start nvals))
+ (set! nvals (cdr nvals))
+ (let ((cur1 (cons (car nvals) cur))) ; add (car nvals) to our arg list
+ (set! (cdr start) (cdr nvals)) ; splice out that element and
+ (pinner cur1 (cdr start) (- len 1)) ; pass a smaller circle on down, "wheels within wheels"
+ (set! (cdr start) nvals)))))) ; restore original circle
+ (let ((len (length vals)))
+ (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle
+ (pinner () vals len)
+ (set-cdr! (list-tail vals (- len 1)) ()))))) ; restore its original shape
+
+
+
+;;; ----------------
+(define (clamp minimum x maximum)
+ (min maximum (max x minimum)))
+
+(define (1- x) (- x 1))
+(define (1+ x) (+ x 1))
+
+(define n-choose-k
+ (let ((documentation "(n-choose-k n k) returns the binomial coefficient C(N,K)"))
+ (lambda (n k)
+ (if (integer? n)
+ (if (integer? k)
+ (let ((mn (min k (- n k))))
+ (if (or (negative? mn)
+ (negative? n))
+ 0
+ (if (= mn 0)
+ 1
+ (let* ((mx (max k (- n k)))
+ (cnk (+ 1 mx)))
+ (do ((i 2 (+ i 1)))
+ ((> i mn) cnk)
+ (set! cnk (/ (* cnk (+ mx i)) i)))))))
+ (error "n-choose-k 'k argument, ~A, should be an integer" k))
+ (error "n-choose-k 'n argument, ~A, should be an integer" n)))))
+
+
+
+;;; ----------------
+
+(define continuable-error
+ (let ((documentation "(continuable-error . args) is (apply error args) wrapped in a continuation named 'continue."))
+ (lambda args
+ (call/cc
+ (lambda (continue)
+ (apply error args))))))
+
+(define continue-from-error ; maybe arg for value to pass back
+ (let ((documentation "(continue-from-error) tries to continue from the point of the earlier continuable-error"))
+ (lambda ()
+ (if (continuation? ((owlet) 'continue))
+ (((owlet) 'continue))))))
+
+(define (call-with-input-vector v proc)
+ (if (vector? v)
+ (let ((i -1))
+ (proc (openlet
+ (inlet 'read (lambda (p)
+ (v (set! i (+ i 1))))))))
+ (error "call-with-input-vector first argument, ~A, should be a vector" v)))
+
+(define (call-with-output-vector proc)
+ (let* ((size 1)
+ (v (make-vector size #f))
+ (i 0)
+ (write-to-vector (lambda (obj p)
+ (when (= i size) ; make the vector bigger to accommodate the output
+ (set! v (copy v (make-vector (set! size (* size 2)) #f))))
+ (set! (v i) obj)
+ (set! i (+ i 1))
+ #<unspecified>))) ; that's what write/display return!
+ (proc (openlet
+ (inlet 'write (lambda* (obj p)
+ ((if (not (let? p)) write write-to-vector) obj p))
+ 'display (lambda* (obj p)
+ ((if (not (let? p)) display write-to-vector) obj p))
+ 'format (lambda (p . args)
+ (if (not (let? p))
+ (apply format p args)
+ (write (apply format #f args) p))))))
+ (make-shared-vector v (list i)))) ; ignore extra trailing elements
+
+
+
+;;; ----------------
+
+(define* (flatten-let e (n -1))
+ (if (let? e)
+ (let ((slots ()))
+ (do ((pe e (outlet pe))
+ (i 0 (+ i 1)))
+ ((or (eq? pe (rootlet))
+ (= i n))
+ (apply inlet slots))
+ (for-each (lambda (slot)
+ (if (and (not (assq (car slot) slots))
+ (not (constant? (car slot)))) ; immutable symbol
+ (set! slots (cons slot slots))))
+ pe)))
+ (error "flatten-let argument, ~A, is not a let" e)))
+
+(define* (owlets (ows 1)) (flatten-let (owlet) ows))
+
+
+
+;;; ----------------
+
+(define-macro (reflective-let vars . body)
+ `(let ,vars
+ ,@(map (lambda (vr)
+ `(set! (symbol-access ',(car vr))
+ (lambda (s v)
+ (format *stderr* "~S -> ~S~%" s v)
+ v)))
+ vars)
+ , at body))
+
+#|
+(define-bacro (reflective-probe)
+ (with-let (inlet 'e (outlet (curlet)))
+ (for-each (lambda (var)
+ (format *stderr* "~S: ~S~%" (car var) (cdr var)))
+ e)))
+|#
+;; ideally this would simply vanish, and make no change in the run-time state, but (values) here returns #<unspecified>
+;; (let ((a 1) (b 2)) (list (set! a 3) (reflective-probe) b)) -> '(3 2) not '(3 #<unspecified> 2)
+;; I was too timid when I started s7 and thought (then) that (abs -1 (values)) should be an error
+;; perhaps if we want it to disappear:
+
+(define-bacro (reflective-probe . body)
+ (with-let (inlet :e (outlet (curlet))
+ :body body)
+ (for-each (lambda (var)
+ (format *stderr* "~S: ~S~%" (car var) (cdr var)))
+ e)
+ `(begin , at body)))
+
+;; now (let ((a 1) (b 2)) (list (set! a 3) (reflective-probe b))) -> '(3 2)
+;; and (let ((a 1) (b 2)) (list (set! a 3) (reflective-probe) b)) -> '(3 () 2)
+;; or use it to print function args: (define (f a b) (reflective-probe) (+ a b))
+
+;; could this use reactive-lambda* to show changes as well?
+
+
+;;; ----------------
+
+(define (gather-symbols expr ce lst ignore)
+ (define (symbol->let sym ce)
+ (if (defined? sym ce #t)
+ ce
+ (and (not (eq? ce (rootlet)))
+ (symbol->let sym (outlet ce)))))
+ (if (symbol? expr)
+ (if (and (not (memq expr lst))
+ (not (memq expr ignore))
+ (not (procedure? (symbol->value expr ce)))
+ (not (eq? (symbol->let expr ce) (rootlet))))
+ (cons expr lst)
+ lst)
+ (if (pair? expr)
+ (if (and (pair? (cdr expr))
+ (pair? (cddr expr)))
+ (if (pair? (cadr expr))
+ (if (memq (car expr) '(let let* letrec letrec* do))
+ (gather-symbols (cddr expr) ce lst (append ignore (map car (cadr expr))))
+ (if (eq? (car expr) 'lambda)
+ (gather-symbols (cddr expr) ce lst (append ignore (cadr expr)))
+ (if (eq? (car expr) 'lambda*)
+ (gather-symbols (cddr expr) ce lst (append ignore (map (lambda (a) (if (pair? a) (car a) a)) (cadr expr))))
+ (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore))))
+ (if (and (eq? (car expr) 'lambda)
+ (symbol? (cadr expr)))
+ (gather-symbols (cddr expr) ce lst (append ignore (list (cadr expr))))
+ (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore)))
+ (if (eq? (car expr) '_)
+ (cons expr lst)
+ (gather-symbols (cdr expr) ce (gather-symbols (car expr) ce lst ignore) ignore)))
+ lst)))
+
+(define-bacro (reactive-set! place value)
+ (with-let (inlet 'place place ; with-let here gives us control over the names
+ 'value value
+ 'e (outlet (curlet))) ; the run-time (calling) environment
+ (let ((nv (gensym))
+ (ne (gensym)))
+ `(begin
+ (define ,ne ,e)
+ ,@(map (lambda (sym)
+ (if (symbol? sym)
+ `(set! (symbol-access ',sym)
+ (lambda (s v)
+ (let ((,nv ,(if (with-let (sublet e 'sym sym)
+ (symbol-access sym))
+ `(begin (,(procedure-source (with-let (sublet e 'sym sym)
+ (symbol-access sym)))
+ s v))
+ 'v)))
+ (with-let (sublet ,ne ',sym ,nv)
+ (set! ,place ,value))
+ ,nv)))
+ (if (or (not (eq? (car sym) '_))
+ (not (pair? (cdr sym)))
+ (not (integer? (cadr sym)))
+ (not (null? (cddr sym))))
+ (error 'wrong-type-arg "reactive-vector can't handle: ~S~%" sym)
+ (let ((index (cadr sym)))
+ `(set! (_ 'local-set!)
+ (apply lambda '(obj i val)
+ (append (cddr (procedure-source (_ 'local-set!)))
+ `((if (= i ,,index) (set! ,',place ,',value))))))))))
+ (gather-symbols value e () ()))
+ (set! ,place ,value)))))
+
+#|
+(let ((a 1)
+ (b 2)
+ (c 3))
+ (reactive-set! b (+ c 4)) ; order matters!
+ (reactive-set! a (+ b c))
+ (set! c 5)
+ a)
+
+(let ((a 1) (v (vector 1 2 3))) (reactive-set! (v 1) (* a 3)) (set! a 4) v)
+|#
+
+;; just a first stab at this:
+
+(define reactive-vector
+ (let ()
+ (require mockery.scm)
+ (define make-mock-vector (*mock-vector* 'make-mock-vector))
+
+ (define (reactive-vector-1 e . args)
+ ;; set up accessors for any element that has an expression as its initial value
+ ;; if any element depends on some other element, return a mock-vector with setter fixed up
+
+ (let ((code `(let ((_ (,(if (any? (lambda (a)
+ (tree-member '_ a))
+ args)
+ '((funclet reactive-vector) 'make-mock-vector)
+ 'make-vector)
+ ,(length args)))))))
+ (let ((ctr 0))
+ (for-each
+ (lambda (arg)
+ (set! code (append code `((reactive-set! (_ ,ctr) ,arg))))
+ (set! ctr (+ ctr 1)))
+ args))
+ (append code `(_))))
+
+ (define-bacro (reactive-vector . args)
+ (apply ((funclet reactive-vector) 'reactive-vector-1) (outlet (curlet)) args))))
+
+
+#|
+(let ((a 1)) (let ((v (reactive-vector a (+ a 1) 2))) (set! a 4) v)) -> #(4 5 2)
+(let* ((a 1) (v (reactive-vector a (+ a 1) 2))) (set! a 4) v) -> #(4 5 2)
+(let* ((a 1) (v (reactive-vector a (+ a 1) (* 2 (_ 0))))) (set! a 4) v) -> #(4 5 8)
+;;; mock-vector could also be used for constant or reflective vectors, etc -- just like symbol-access but element-wise
+|#
+
+;; another experiment:
+
+(define-bacro (reactive-format port ctrl . args)
+ (with-let (inlet 'e (outlet (curlet))
+ 'args args
+ 'port port
+ 'ctrl ctrl)
+ (let* ((syms (gather-symbols args e () ()))
+ (sa's (map symbol-access syms)))
+ `(begin
+ ,@(map (lambda (sym sa)
+ `(set! (symbol-access ',sym)
+ (lambda (s v)
+ (let ((result (if ,sa (apply ,sa s v ()) v)))
+ (with-let (sublet ,e ',sym result)
+ (format ,port ,ctrl , at args)) ; is this equivalent to an exported closure in the GC?
+ result))))
+ syms sa's)
+ (format ,port ,ctrl , at args)))))
+
+
+;;; this is not pretty
+;;; part of the complexity comes from the hope to be tail-callable, but even a version
+;;; using dynamic-wind is complicated because of shadowing
+;;; what I think we want here is a globally accessible way to see set! that does not
+;;; require non-local state (not a hook with its list of functions, or symbol-access)
+;;; and that doesn't bring s7 to a halt. Perhaps a symbol-access function that
+;;; traverses the let-chain (like *features*) looking for something?? But the relevant
+;;; chain is on the stack (is it?), so it won't be quick. And weak refs are asking for trouble.
+;;; (let ((a 1)) (define (set-a x) (set! a x)) (let ((b 2)) (reactive-set! b (+ a 1)) (set-a 3) b))
+;;; Perhaps a way to share the original's slot? No slow down, transparent, local setter can
+;;; run its own accessor, set -> shared slot so all sharers see the new value,
+;;; but how to trigger all accessors?
+;;; (set! (symbol-slot 'a e1) (symbol-slot 'a e2))
+;;; this isn't currently doable -- object.slt.val is a pointer, not a pointer to a pointer
+;;; there is the symbol's extra slot, but it is global. I wonder how much slower s7 would be
+;;; with a pointer to a pointer here -- are there any other places this would be useful?
+;;; even with this, the entire accessor chain is not triggered.
+;;; so, use with-accessors and reactive-set! for complex cases
+
+(define unique-reactive-let-name ; the alternative is (apply define-bacro ...) with a top-level gensym
+ (let ((name #f))
+ (lambda ()
+ (if (gensym? name)
+ name
+ (set! name (gensym "v"))))))
+
+(define-bacro (reactive-let vars . body)
+ (with-let (inlet 'vars vars 'body body 'e (outlet (curlet)))
+ (let ((bindings ())
+ (accessors ())
+ (setters ())
+ (gs (gensym))
+ (v (unique-reactive-let-name)))
+
+ (define (rlet-symbol sym)
+ (string->symbol (string-append "{" (symbol->string sym) "}-rlet")))
+
+ (for-each
+ (lambda (bd)
+ (let ((syms (gather-symbols (cadr bd) e () ())))
+ (for-each
+ (lambda (sym)
+ (let ((fname (gensym (symbol->string sym))))
+ (set! bindings (cons `(,fname (lambda (,sym) ,(copy (cadr bd)))) bindings))
+ (if (not (memq sym setters))
+ (set! setters (cons sym setters)))
+ (let ((prev (assq sym accessors)))
+ (if (not prev)
+ (set! accessors (cons (cons sym `((set! ,(car bd) (,fname ,v)))) accessors))
+ (set-cdr! prev (append `((set! ,(car bd) (,fname ,v))) (cdr prev)))))))
+ syms)
+ (set! bindings (cons bd bindings))))
+ vars)
+
+ (let ((bsyms (gather-symbols body e () ()))
+ (nsyms ()))
+ (for-each (lambda (s)
+ (if (and (with-let (sublet e (quote gs) s)
+ (symbol-access gs))
+ (not (assq s bindings)))
+ (if (not (memq s setters))
+ (begin
+ (set! setters (cons s setters))
+ (set! nsyms (cons (cons s (cdr (procedure-source (with-let (sublet e (quote gs) s)
+ (symbol-access gs)))))
+ nsyms)))
+ (let ((prev (assq s accessors)))
+ (if prev ; merge the two functions
+ (set-cdr! prev (append (cdddr (procedure-source (with-let (sublet e (quote gs) s)
+ (symbol-access gs))))
+ (cdr prev))))))))
+ bsyms)
+
+ `(let ,(map (lambda (sym)
+ (values
+ `(,(rlet-symbol sym) (lambda (,v) (set! ,sym ,v)))
+ `(,sym ,sym)))
+ setters)
+ (let ,(reverse bindings)
+ ,@(map (lambda (sa)
+ (if (not (assq (car sa) bindings))
+ `(set! (symbol-access ',(car sa))
+ (lambda (,(gensym) ,v)
+ (,(rlet-symbol (car sa)) ,v)
+ ,@(cdr sa)
+ ,v))
+ (values)))
+ accessors)
+ ,@(map (lambda (ns)
+ `(set! (symbol-access ',(car ns))
+ (apply lambda ',(cdr ns))))
+ nsyms)
+ , at body))))))
+
+
+(define-macro (reactive-let* vars . body)
+ (define (add-let v)
+ (if (pair? v)
+ `(reactive-let ((,(caar v) ,(cadar v)))
+ ,(add-let (cdr v)))
+ `(begin , at body)))
+ (add-let vars))
+
+;; reactive-letrec is not useful: lambdas already react and anything else is an error (use of #<undefined>)
+
+(define-macro (reactive-lambda* args . body)
+ `(let ((f (lambda* ,args , at body))
+ (e (curlet)))
+ (unless (eq? e (rootlet))
+
+ (define (one-access s1 v)
+ (let* ((syms (map car e))
+ (sa's (map (lambda (s) (symbol-access s e)) syms)))
+ (dynamic-wind
+ (lambda () (for-each (lambda (s) (if (not (eq? s s1)) (set! (symbol-access s e) #f))) syms))
+ (lambda () (f s1 v))
+ (lambda () (for-each (lambda (s a) (set! (symbol-access s e) a)) syms sa's)))))
+
+ (for-each (lambda (s) (set! (symbol-access s e) one-access)) (map car e)))
+ f))
+
+
+(define-macro (with-accessors vars . body)
+ `(let ((accessors ()))
+ (dynamic-wind
+ (lambda ()
+ (set! accessors (map symbol-access ',vars)))
+ (lambda ()
+ , at body)
+ (lambda ()
+ (for-each
+ (lambda (var accessor)
+ (set! (symbol-access var) accessor))
+ ',vars accessors)))))
+
+;; (let ((a 1) (b 2)) (with-accessors (a b) (let ((c 3)) (reactive-set! c (+ (* 2 a) (* 3 b))) (set! a 4) c)))
+
+#|
+(let ((x 0.0)) (reactive-let ((y (sin x))) (set! x 1.0) y)) -- so "lifting" comes for free?
+
+(map (lambda (s) (symbol-access (car s) e)) e)
+
+(let ((a 1))
+ (reactive-let ((b (+ a 1))
+ (c (* a 2)))
+ (set! a 3)
+ (+ c b)))
+
+(let ((a 1)
+ (d 2))
+ (reactive-let ((b (+ a d))
+ (c (* a d))
+ (d 0))
+ (set! a 3)
+ (+ b c)))
+
+(let ((a 1))
+ (reactive-let* ((b (+ a 1))
+ (c (* b 2)))
+ (set! a 3)
+ (+ c b)))
+
+(let ((a 1))
+ (reactive-let* ((b (+ a 1)))
+ (set! a 3)
+ b))
+
+(define rl (let ((a 1)
+ (b 2)
+ (c 3))
+ (reactive-lambda* (s v)
+ (format *stderr* "~S changed: ~S~%" s v))))
+
+;; constant env:
+;; (define e (let ((a 1) (b 2)) (reactive-lambda* (s v) ((curlet) s)) (curlet)))
+|#
+
+;;; what about (reactive-vector (v 0)) -- can we watch some other vector's contents?
+;;; if v were a mock-vector, we could use the same vector-set! stuff as now but with any name (how to distinguish?)
+;;; we can distinguish because this is happening at run-time where (v 0) has an ascertainable meaning
+;;; how would reactive-hash-table work? (hash 'a (+ b 1)) and update 'a's value whenever b changes?
+;;; reactive-string? (reactive-string #\a c (integer->char a) (str 0) (_ 0))
+;;; reactive-eval reactive-if(expr changes)--reactive-assert for example
+
+
+#|
+;; this tests a bacro for independence of any runtime names
+;; (bacro-shaker reactive-set! '(let ((a 21) (b 1)) (reactive-set! a (* b 2)) (set! b 3) a))
+
+(define (bacro-shaker bac example)
+
+ (define (swap-symbols old-code syms)
+ (if (null? old-code)
+ ()
+ (if (symbol? old-code)
+ (let ((x (assq old-code syms)))
+ (if x
+ (cdr x)
+ (copy old-code)))
+ (if (pair? old-code)
+ (cons (swap-symbols (car old-code) syms)
+ (swap-symbols (cdr old-code) syms))
+ (copy old-code)))))
+
+ (let ((e (outlet (curlet)))
+ (source (cddr (cadr (caddr (procedure-source bac))))))
+ (let ((symbols (gather-symbols source (rootlet) () ()))
+ (exsyms (gather-symbols (cadr example) (rootlet) () ())))
+ ;; now try each symbol at each position in exsyms, in all combinations
+
+ (let ((syms ()))
+ (for-each
+ (lambda (s)
+ (set! syms (cons (cons s s) syms)))
+ exsyms)
+ (let ((result (eval example e)))
+
+ (define (g . new-args)
+ (for-each (lambda (a b)
+ (set-cdr! a b))
+ syms new-args)
+ (let ((code (swap-symbols example syms)))
+ (let ((new-result (catch #t
+ (lambda ()
+ (eval code e))
+ (lambda args
+ args))))
+ (if (not (equal? result new-result))
+ (format *stderr* "~A -> ~A~%~A -> ~A~%"
+ example result
+ code new-result)))))
+
+ (define (f . args)
+ (for-each-permutation g args))
+
+ (let ((subsets ())
+ (func f)
+ (num-args (length exsyms))
+ (args symbols))
+ (define (subset source dest len)
+ (if (null? source)
+ (begin
+ (set! subsets (cons dest subsets))
+ (if (= len num-args)
+ (apply func dest)))
+ (begin
+ (subset (cdr source) (cons (car source) dest) (+ len 1))
+ (subset (cdr source) dest len))))
+ (subset args () 0)))))))
+|#
+
+
+
+;;; ----------------
+
+(define-macro (catch* clauses . error)
+ (define (builder lst)
+ (if (null? lst)
+ (apply values error)
+ `(catch #t (lambda () ,(car lst)) (lambda args ,(builder (cdr lst))))))
+ (builder clauses))
+
+
+(define* (subsequence obj (start 0) end)
+ (let* ((len (length obj))
+ (new-len (- (min len (or end len)) start)))
+ (if (negative? new-len)
+ (error 'out-of-range "end: ~A should be greater than start: ~A" end start))
+
+ (cond ((vector? obj)
+ (make-shared-vector obj (list new-len) start))
+
+ ((string? obj)
+ (if end
+ (substring obj start end)
+ (substring obj start)))
+
+ ((pair? obj)
+ (if (not end)
+ (cdr* obj start)
+ (let ((lst (make-list new-len #f)))
+ (do ((i 0 (+ i 1)))
+ ((= i new-len) lst)
+ (set! (lst i) (obj (+ i start)))))))
+
+ (else ; (subsequence (inlet 'subsequence (lambda* (obj start end) "subseq")))
+ (catch*
+ (((obj 'subsequence) obj start end)
+ (subsequence (obj 'value) start end))
+ #f)))))
+
+
+(define (sequence->string val)
+ (if (or (not (sequence? val))
+ (empty? val))
+ (format #f "~S" val)
+ (cond ((vector? val)
+ (format #f "#(~{~A~| ~})" val))
+ ((let? val)
+ (format #f "(inlet ~{'~A~| ~})" val))
+ ((hash-table? val)
+ (format #f "(hash-table ~{'~A~| ~})" val))
+ ((string? val)
+ (format #f (if (byte-vector? val) "#u8(~{~D~| ~})" "\"~{~A~|~}\"") val))
+ (else
+ (format #f "(~{~A~| ~})" val)))))
+
+
+;;; ----------------
+
+(define-macro (elambda args . body) ; lambda but pass extra arg "*env*" = run-time env
+ `(define-bacro (,(gensym) , at args)
+ `((lambda* ,(append ',args `((*env* (curlet))))
+ ,'(begin , at body))
+ ,, at args)))
+
+(define-macro* (rlambda args . body) ; lambda* but eval arg defaults in run-time env
+ (let ((arg-names (map (lambda (arg) (if (pair? arg) (car arg) arg)) args))
+ (arg-defaults (map (lambda (arg) (if (pair? arg) `(,(car arg) (eval ,(cadr arg))) arg)) args)))
+ `(define-bacro* (,(gensym) , at arg-defaults)
+ `((lambda ,',arg-names ,'(begin , at body)) ,, at arg-names))))
+
+
+;;; ----------------
+
+(if (and (not (defined? 'apropos))
+ (not (provided? 'snd)))
+ (define* (apropos name (port *stdout*) (e (rootlet)))
+ (let ((ap-name (if (string? name)
+ name
+ (if (symbol? name)
+ (symbol->string name)
+ (error 'wrong-type-arg "apropos argument 1 should be a string or a symbol"))))
+ (ap-env (if (let? e)
+ e
+ (error 'wrong-type-arg "apropos argument 3 should be an environment")))
+ (ap-port (if (output-port? port)
+ port
+ (error 'wrong-type-arg "apropos argument 2 should be an output port"))))
+ (for-each
+ (lambda (binding)
+ (if (and (pair? binding)
+ (string-position ap-name (symbol->string (car binding))))
+ (format ap-port "~A: ~A~%"
+ (car binding)
+ (if (procedure? (cdr binding))
+ (procedure-documentation (cdr binding))
+ (cdr binding)))))
+ ap-env))))
+
+
+;;; ----------------
+
+;; these need to be globally accessible since they're inserted in arbitrary source
+(define Display #f)
+(define Display-port #f)
+
+(let ((spaces 0)
+ (*display-spacing* 2) ; (set! ((funclet Display) '*display-spacing*) 1) etc
+ (*display-print-length* 6)
+ (*display* *stderr*) ; exported via Display-port
+ (e (gensym))
+ (result (gensym))
+ (vlp (gensym)))
+
+ ;; local symbol access -- this does not affect any other uses of these symbols
+ (set! (symbol-access '*display-spacing* (curlet))
+ (lambda (s v) (if (and (integer? v) (not (negative? v))) v *display-spacing*)))
+
+ (set! (symbol-access '*display-print-length* (curlet))
+ (lambda (s v) (if (and (integer? v) (not (negative? v))) v *display-print-length*)))
+
+ ;; export *display* -- just a convenience
+ (set! Display-port (dilambda
+ (lambda () *display*)
+ (lambda (val) (set! *display* val))))
+
+ (define (prepend-spaces)
+ (format *display* (format #f "~~~DC" spaces) #\space))
+
+ (define (display-format str . args)
+ `(let ((,vlp (*s7* 'print-length)))
+ (with-let (funclet Display)
+ (set! (*s7* 'print-length) *display-print-length*)
+ (prepend-spaces))
+ (format (Display-port) ,str , at args)
+ (set! (*s7* 'print-length) ,vlp)))
+
+ (define (display-let le e)
+ (let ((vlp (*s7* 'print-length)))
+ (for-each
+ (lambda (slot)
+ (unless (or (gensym? (car slot))
+ (eq? (cdr slot) e))
+ (set! (*s7* 'print-length) *display-print-length*)
+ (let ((str (sequence->string (cdr slot))))
+ (set! (*s7* 'print-length) 30)
+ (format (Display-port) " :~A ~{~A~|~}" (car slot) str))))
+ le)
+ (set! (*s7* 'print-length) vlp)))
+
+ (define (last lst)
+ (let ((len (length lst)))
+ (let ((end (list-tail lst (if (negative? len) (abs len) (- len 1)))))
+ (if (pair? end)
+ (car end)
+ end))))
+
+ (define* (butlast lst (result ()))
+ (if (or (not (pair? lst))
+ (null? (cdr lst)))
+ (reverse result)
+ (butlast (cdr lst) (cons (car lst) result))))
+
+ (define* (remove-keys args (lst ()))
+ (if (pair? args)
+ (remove-keys (cdr args)
+ (if (or (not (keyword? (car args)))
+ (eq? (car args) :rest))
+ (cons (car args) lst)
+ lst))
+ (if (null? args)
+ (reverse lst)
+ (append (reverse lst) args))))
+
+ (define (walk-let-body source)
+ (let ((previous (butlast source))
+ (end (last source)))
+ `(begin
+ , at previous
+ (let ((,result ,end))
+ (with-let (funclet Display)
+ (prepend-spaces))
+ (format (Display-port) " ~A~A) -> ~A~%"
+ ,(if (pair? previous) " ... " "")
+ ',end
+ ,result)
+ ,result))))
+
+ (define (proc-walk source)
+
+ (if (pair? source)
+ (case (car source)
+
+ ((let let* letrec letrec*)
+ ;; show local variables, (let vars . body) -> (let vars print-vars . body)
+ (if (symbol? (cadr source)) ; named let?
+ (append
+ (list (car source) ; let
+ (cadr source) ; name
+ (caddr source) ; vars
+ (display-format "(let ~A (~{~A~| ~})~%" (cadr source) '(outlet (curlet))))
+ (walk-let-body (cdddr source))) ; body
+ (append
+ (list (car source) ; let
+ (cadr source) ; vars
+ (display-format "(~A (~{~A~| ~})~%" (car source) '(outlet (curlet))))
+ (walk-let-body (cddr source))))) ; body
+
+ ((or and)
+ ;; report form that short-circuits the evaluation
+ (append (list (car source))
+ (let ((ctr -1)
+ (len (- (length (cdr source)) 1))
+ (eob (if (eq? (car source) 'or) 'when 'unless)))
+ (map (lambda (expr)
+ (set! ctr (+ ctr 1))
+ `(let ((,result ,expr))
+ (,eob ,result
+ (format (Display-port) " (~A ~A~A~A) -> ~A~%"
+ ',(car source)
+ ,(if (> ctr 0) " ... " "")
+ ',expr
+ ,(if (< ctr len) " ... " "")
+ ,result))
+ ,result))
+ (cdr source)))))
+
+ ((begin with-let with-baffle)
+ ;; report last form
+ (let ((previous (butlast (cdr source)))
+ (end (last source)))
+ `(,(car source)
+ , at previous
+ (let ((,result ,end))
+ (format (Display-port) "(~A ~A~A) -> ~A~%"
+ ',(car source)
+ ,(if (pair? previous) " ... " "")
+ ',end
+ ,result)
+ ,result))))
+
+ ((when unless)
+ ;; report expr if body not walked, else report last form of body
+ (let ((previous (butlast (cddr source)))
+ (end (last (cddr source))))
+ `(,(car source) (let ((,result ,(cadr source)))
+ (,(car source) (not ,result)
+ (format (Display-port) "(~A ~A -> ~A ...)~%"
+ ',(car source)
+ ',(cadr source)
+ ,result))
+ ,result)
+ , at previous
+ (let ((,result ,end))
+ (format (Display-port) "(~A ... ~A) -> ~A~%"
+ ',(car source)
+ ',end
+ ,result)
+ ,result))))
+
+ ((quote)
+ source)
+
+ ((cond)
+ ;; report form that satisifies cond
+ (let ((ctr -1)
+ (len (- (length (cdr source)) 1)))
+ `(cond ,@(map (lambda (clause)
+ (let ((test (car clause))
+ (body (cdr clause)))
+ (set! ctr (+ ctr 1))
+ (if (eq? (car body) '=>)
+ `(,test => (lambda (,result)
+ (let ((,result (,@(cdr body) ,result)))
+ (format (Display-port) " (cond ~A~A~A) -> ~A~%"
+ ,(if (> ctr 0) " ... " "")
+ ',clause
+ ,(if (< ctr len) " ... " "")
+ ,result)
+ ,result)))
+ `(,test (let ((,result (begin , at body)))
+ (format (Display-port) " (cond ~A~A~A) -> ~A~%"
+ ,(if (> ctr 0) " ... " "")
+ ',clause
+ ,(if (< ctr len) " ... " "")
+ ,result)
+ ,result)))))
+ (cdr source)))))
+
+ ((case)
+ ;; as in cond but include selector value in [] and report fall throughs
+ (let ((ctr -1)
+ (len (- (length (cddr source)) 1))
+ (default (member '(else #t) (cddr source) (lambda (a b)
+ (memq (car b) a)))))
+ `(case ,(cadr source)
+ ,@(append
+ (map (lambda (clause)
+ (let ((test (car clause))
+ (body (cdr clause)))
+ (set! ctr (+ ctr 1))
+ (if (eq? (car body) '=>)
+ `(,test => (lambda (,result)
+ (let ((,result (,@(cdr body) ,result)))
+ (format (Display-port) " (case [~A] ~A~A~A) -> ~A~%"
+ ,(cadr source)
+ ,(if (> ctr 0) " ... " "")
+ ',clause
+ ,(if (< ctr len) " ... " "")
+ ,result)
+ ,result)))
+ `(,test (let ((,result (begin , at body)))
+ (format (Display-port) " (case [~A] ~A~A~A) -> ~A~%"
+ ,(cadr source)
+ ,(if (> ctr 0) " ... " "")
+ ',clause
+ ,(if (< ctr len) " ... " "")
+ ,result)
+ ,result)))))
+ (cddr source))
+ (if (not default)
+ `((else
+ (format (Display-port) " (case [~A] falls through~%" ,(cadr source))
+ #<unspecified>))
+ ())))))
+
+ ((dynamic-wind)
+ ;; here we want to ignore the first and last clauses, and report the last of the second
+ (let ((l2 (caddr source)))
+ (let* ((body (and (eq? (car l2) 'lambda)
+ (cddr l2)))
+ (previous (and body (butlast body)))
+ (end (and body (last body))))
+ (if (not body)
+ source
+ `(dynamic-wind
+ ,(cadr source)
+ (lambda ()
+ , at previous
+ (let ((,result ,end))
+ (format (Display-port) "(dynamic-wind ... ~A) -> ~A~%" ',end ,result)
+ ,result))
+ ,(cadddr source))))))
+
+ (else
+ (cons (proc-walk (car source))
+ (proc-walk (cdr source)))))
+ source))
+
+ (define-macro (Display-1 definition)
+ (if (and (pair? definition)
+ (memq (car definition) '(define define*))
+ (pair? (cdr definition))
+ (pair? (cadr definition)))
+
+ ;; (Display (define (f ...) ...)
+ (let ((func (caadr definition))
+ (args (cdadr definition))
+ (body `(begin ,@(proc-walk (cddr definition)))))
+ ;(format *stderr* "~A ~A ~A~%" func args body)
+ (let* ((no-noise-args (remove-keys args)) ; omit noise words like :optional
+ (arg-names (if (null? args)
+ ()
+ (if (proper-list? args) ; handle (f x ...), (f (x 1) ...), (f . x), and (f x . z)
+ (map (lambda (a)
+ (if (symbol? a) a (car a))) ; omit the default values
+ no-noise-args)
+ (if (pair? args)
+ (append (butlast no-noise-args) (list :rest (last args)))
+ (list :rest args)))))
+ (call-args (if (null? args)
+ ()
+ (if (proper-list? args)
+ (if (memq :rest args)
+ (append (butlast (butlast no-noise-args)) ; also omit the :rest
+ (list (list '{apply_values} (last args))))
+ arg-names) ; (... y x)
+ (if (pair? args)
+ (append (butlast no-noise-args) ; (... y ({apply_values} x))
+ (list (list '{apply_values} (last args))))
+ (list (list '{apply_values} args))))))) ; (... ({apply_values} x))
+ `(define ,func
+ (define-macro* ,(cons (gensym) args) ; args might be a symbol etc
+ `((lambda* ,(cons ',e ',arg-names) ; prepend added env arg because there might be a rest arg
+ (let ((,',result '?))
+ (dynamic-wind
+ (lambda () ; when function called, show args and caller
+ (with-let (funclet Display) ; indent
+ (prepend-spaces)
+ (set! spaces (+ spaces *display-spacing*)))
+ (format (Display-port) "(~A" ',',func) ; show args, ruthlessly abbreviated
+ (((funclet Display) 'display-let) (outlet (outlet (curlet))) ,',e)
+ (format (Display-port) ")")
+ (let ((caller (eval '__func__ ,',e))) ; show caller
+ (if (not (eq? caller #<undefined>))
+ (format (Display-port) " ;called from ~A" caller)))
+ (newline (Display-port)))
+ (lambda () ; the original function body
+ (set! ,',result ,',body)) ; but annotated by proc-walk
+ (lambda () ; at the end, show the result
+ (with-let (funclet Display)
+ (set! spaces (- spaces *display-spacing*)) ; unindent
+ (prepend-spaces))
+ (format (Display-port) " -> ~S~%" ,',result)))))
+ (curlet) ,, at call-args))))) ; pass in the original args and the curlet
+
+ ;; (Display <anything-else>)
+ (proc-walk definition))) ; (Display (+ x 1)) etc
+
+ (set! Display Display-1)) ; make Display-1 globally accessible
+
+
+
+;;; --------------------------------------------------------------------------------
+
+
+(define (*s7*->list)
+ (list
+ :print-length (*s7* 'print-length)
+ :safety (*s7* 'safety)
+ :cpu-time (*s7* 'cpu-time)
+ :heap-size (*s7* 'heap-size)
+ :free-heap-size (*s7* 'free-heap-size)
+ :gc-freed (*s7* 'gc-freed)
+ :gc-protected-objects (*s7* 'gc-protected-objects)
+ :gc-stats (*s7* 'gc-stats)
+ :max-string-length (*s7* 'max-string-length)
+ :max-list-length (*s7* 'max-list-length)
+ :max-vector-length (*s7* 'max-vector-length)
+ :max-vector-dimensions (*s7* 'max-vector-dimensions)
+ :default-hash-table-length (*s7* 'default-hash-table-length)
+ :initial-string-port-length (*s7* 'initial-string-port-length)
+ :default-rationalize-error (*s7* 'default-rationalize-error)
+ :default-random-state (*s7* 'default-random-state)
+ :morally-equal-float-epsilon (*s7* 'morally-equal-float-epsilon)
+ :hash-table-float-epsilon (*s7* 'hash-table-float-epsilon)
+ :float-format-precision (*s7* 'float-format-precision)
+ :bignum-precision (*s7* 'bignum-precision)
+ :file-names (*s7* 'file-names)
+ :rootlet-size (*s7* 'rootlet-size)
+ :c-types (*s7* 'c-types)
+ :stack-top (*s7* 'stack-top)
+ :stack-size (*s7* 'stack-size)
+ :stacktrace-defaults (*s7* 'stacktrace-defaults)
+ :max-stack-size (*s7* 'max-stack-size)
+ :symbol-table-locked? (*s7* 'symbol-table-locked?)
+ :undefined-identifier-warnings (*s7* 'undefined-identifier-warnings)
+ :catches (*s7* 'catches)
+ :exits (*s7* 'exits)))
+
+
+
+;;; --------------------------------------------------------------------------------
+
+(define* (make-directory-iterator name (recursive #t))
+ (if (not (string? name))
+ (error "directory name should be a string: ~S" name)
+ (make-iterator
+ (with-let (sublet *libc* :name name :recursive recursive)
+ (let ((dir (opendir name)))
+ (if (equal? dir NULL)
+ (error "can't open ~S: ~S" name (strerror (errno)))
+ (let ((iterator? #t)
+ (dirs ())
+ (dir-names ())
+ (dir-name name))
+ (define* (reader quit) ; returned from with-let
+ (if (eq? quit #<eof>) ; caller requests cleanup and early exit
+ (begin ; via ((iterator-sequence iter) #<eof>)
+ (closedir dir)
+ (for-each closedir dirs)
+ (set! dirs ())
+ quit)
+ (let ((file (read_dir dir)))
+ (if (zero? (length file)) ; null filename => all done
+ (begin
+ (closedir dir)
+ (if (null? dirs)
+ #<eof>
+ (begin ; else pop back to outer dir
+ (set! dir (car dirs))
+ (set! dirs (cdr dirs))
+ (set! dir-name (car dir-names))
+ (set! dir-names (cdr dir-names))
+ (reader))))
+ (if (not (member file '("." "..") string=?))
+ (let ((full-dir-name (string-append dir-name "/" file)))
+ (if (and recursive
+ (reader-cond
+ ((defined? 'directory?)
+ (directory? full-dir-name))
+ (#t (let ((buf (stat.make)))
+ (let ((result (and (stat full-dir-name buf)
+ (S_ISDIR (stat.st_mode buf)))))
+ (free buf)
+ result)))))
+ (let ((new-dir (opendir full-dir-name)))
+ (if (equal? new-dir NULL) ; inner directory is unreadable?
+ (begin
+ (format *stderr* "can't read ~S: ~S" file (strerror (errno)))
+ (reader))
+ (begin
+ (set! dirs (cons dir dirs))
+ (set! dir new-dir)
+ (set! dir-names (cons dir-name dir-names))
+ (set! dir-name full-dir-name)
+ (reader))))
+ (string-append dir-name "/" file)))
+ (reader)))))))))))))
\ No newline at end of file
diff --git a/test.snd b/test.snd
deleted file mode 100644
index 4a17081..0000000
Binary files a/test.snd and /dev/null differ
diff --git a/tools/README b/tools/README
index a3b682b..f937182 100644
--- a/tools/README
+++ b/tools/README
@@ -20,5 +20,4 @@ make-index.scm Build index.html, snd-xref.c, elaborate html error chec
snd.supp Valgrind suppressions
make-snd-diffs
exs7.c some s7 examples (extracted from s7.h)
-check-help.scm bug checks for help strings
sam.c Samson box emulator
diff --git a/tools/check-help.scm b/tools/check-help.scm
deleted file mode 100644
index eb6146e..0000000
--- a/tools/check-help.scm
+++ /dev/null
@@ -1,84 +0,0 @@
-;;; check procedure help strings
-
-(let ((names (snd-urls)))
- (for-each
- (lambda (biname)
- (let ((name (catch #t (lambda () (string->symbol(car biname))) (lambda args #f))))
- (if (and (symbol? name)
- (defined? name)
- (procedure? (symbol->value name)))
- (let* ((help (snd-help name))
- (arity (procedure-arity (symbol->value name))))
- (if (and (string? help)
- (char=? (string-ref help 0) #\()
- (not (caddr arity))) ; rest args
- (let ((args (+ (car arity) (cadr arity)))
- (counted-args 0)
- (len (string-length help))
- (got-args #f)
- (got-name #f)
- (cur-start -1)
- (paren-ctr 0))
- (do ((i 1 (1+ i)))
- ((or got-args
- (>= i len)))
- (let ((chr (string-ref help i)))
- (if (char=? chr #\))
- (begin
- (set! paren-ctr (- paren-ctr 1))
- (if (and (= paren-ctr 0)
- (> cur-start 0))
- (begin
- (set! counted-args (1+ counted-args))
- (set! cur-start -1)))
- (if (< paren-ctr 0)
- (begin
- (if (and (not got-name)
- (> cur-start 0))
- (begin
- (set! got-name (substring help cur-start i))
- (set! cur-start -1)))
- (if (and got-name
- (> cur-start 0))
- (set! counted-args (1+ counted-args)))
- (let ((str-name (symbol->string name)))
- (if (and (not (= counted-args args))
- (not (member str-name (list "save-region")))
- (or (< (string-length str-name) 6)
- (not (and (string=? (substring str-name 0 5) "make-")
- (= args (* 2 counted-args ))))))
- (display (format #f "~%;~A: ~A doc but ~A help" name args counted-args)))
- (if (and (not (member str-name (list "undo-edit" "redo-edit" "chans" "read-region-sample")))
- (or (not (string? got-name))
- (not (string=? str-name got-name))))
- (display (format #f "~%;~A: help name: ~A" name got-name))))
- (set! got-args #t))))
- (if (char=? chr #\()
- (set! paren-ctr (1+ paren-ctr))
- (if (or (char-alphabetic? chr)
- (char-numeric? chr)
- (char=? chr #\-)
- (char=? chr #\!)
- (char=? chr #\?)
- (char=? chr #\:)
- (char=? chr #\+)
- (char=? chr #\*)
- (char=? chr #\>))
- (if (= cur-start -1)
- (set! cur-start i))
- (begin
- (if (> cur-start 0)
- (if (not got-name)
- (set! got-name (substring help cur-start i))
- (if (= paren-ctr 0)
- (let ((arg (substring help cur-start i)))
- (if (and (not (string=? arg ":optional"))
- (not (string=? arg ":rest"))
- (not (string=? arg ":optional-key"))
- (not (string=? arg ":key")))
- (set! counted-args (1+ counted-args)))))))
- (if (= paren-ctr 0)
- (set! cur-start -1))))))))))))))
- names))
-
-(exit)
diff --git a/tools/compare-calls.scm b/tools/compare-calls.scm
new file mode 100644
index 0000000..354003e
--- /dev/null
+++ b/tools/compare-calls.scm
@@ -0,0 +1,213 @@
+;; find where two callgrind runs differ, also combine n callgrind runs
+
+(define (compare-calls f1 f2)
+ (let ((h1 (with-input-from-file f1 read-calls))
+ (total-diff 0)
+ (diffs ())
+ (scl 1e-6))
+
+ (let ((h2 (with-input-from-file f2 read-calls)))
+ (for-each
+ (lambda (kv1)
+ (let ((kv2 (h2 (car kv1))))
+ (let ((diff (if kv2 (- kv2 (cdr kv1)) (- (cdr kv1)))))
+ (if (> (abs diff) 3e6)
+ (begin
+ (set! diffs (cons (list diff (car kv1) (cdr kv1) (or kv2 0)) diffs))
+ (set! total-diff (+ total-diff diff)))))))
+ h1)
+ (for-each
+ (lambda (kv2)
+ (let ((kv1 (h1 (car kv2))))
+ (if (not kv1)
+ (let ((diff (cdr kv2)))
+ (if (> (abs diff) 3e6)
+ (begin
+ (set! diffs (cons (list diff (car kv2) 0 (cdr kv2)) diffs))
+ (set! total-diff (+ total-diff diff))))))))
+ h2))
+
+ (let ((vals (sort! diffs (lambda (a b) (> (car a) (car b))))))
+ (format *stderr* "total: ~,3F~%" (* scl total-diff))
+ (for-each
+ (lambda (entry)
+ (format *stderr* "~A~,3F~12T(~,3F~24T~,3F)~40T~A~%"
+ (if (negative? (entry 0)) "" " ")
+ (* scl (entry 0))
+ (* scl (entry 2))
+ (* scl (entry 3))
+ (entry 1)))
+ vals)))
+ (exit))
+
+(define (string->number-ignoring-commas str)
+ (let ((num 0)
+ (tens 1)
+ (len (length str)))
+ (do ((i (- len 1) (- i 1)))
+ ((< i 0) num)
+ (if (char-numeric? (str i))
+ (begin
+ (set! num (+ num (* tens (- (char->integer (str i)) 48))))
+ (set! tens (* 10 tens)))))))
+
+(define (read-calls)
+ ;; throw away the header
+ (do ((i 0 (+ i 1)))
+ ((= i 25))
+ (read-line))
+ ;; read about 500 lines and store in a hash table as (func . timing)
+ (let ((h (make-hash-table)))
+ (call-with-exit
+ (lambda (quit)
+ (do ((i 0 (+ i 1)))
+ ((= i 500))
+ (let ((line (read-line)))
+ (if (eof-object? line)
+ (quit))
+ (let ((len (length line)))
+ (do ((k 0 (+ k 1)))
+ ((or (= k len)
+ (not (char-whitespace? (line k))))
+ (if (< k len)
+ (let ((end (char-position #\space line k)))
+ (if end
+ (let ((num (string->number-ignoring-commas (substring line k end))))
+ (when num
+ (let ((func-end (char-position #\space line (+ end 2))))
+ (when (and (number? func-end)
+ (> func-end (+ end 2)))
+ (let ((func (string->symbol (substring line (+ end 2) func-end))))
+ (set! (h func) num))))))))))))))))
+ h))
+
+
+(define (get-overheads file)
+ (with-input-from-file file
+ (lambda ()
+ (let ((overheads ())
+ (total 0))
+
+ (define (get-overheads-1 file line)
+ (let ((len (min 20 (length line))))
+ (do ((i 0 (+ i 1)))
+ ((or (= i len)
+ (not (char-whitespace? (line i))))
+ (if (and (< i (- len 4))
+ (char=? (line i) #\.)
+ (char=? (line (+ i 1)) #\space)
+ (char=? (line (+ i 2)) #\space)
+ (char-alphabetic? (line (+ i 3))))
+ (let ((next-line (read-line)))
+ (let ((nlen (length next-line)))
+ (if (char=? (next-line (- nlen 1)) #\{)
+ (do ((j 0 (+ j 1)))
+ ((or (= j nlen)
+ (and (char-numeric? (next-line j))
+ (let ((cost (string->number-ignoring-commas (substring next-line j (- nlen 3)))))
+ (set! total (+ total cost))
+ (set! overheads (cons (list cost (substring line (+ i 3) (min 80 (length line)))) overheads)))))))
+ (get-overheads-1 file next-line)))))))))
+
+ (do ((line (read-line) (read-line)))
+ ((eof-object? line) overheads)
+ (get-overheads-1 file line))
+
+ (set! overheads (sort! overheads (lambda (a b) (< (car a) (car b)))))
+ (format *stderr* "~{~^~A~%~}" (list-tail overheads (max 10 (- (length overheads) 40))))
+ (format *stderr* "total: ~A~%" total)))))
+
+
+
+
+(define (read-all-calls)
+ ;; throw away the header
+ (do ((i 0 (+ i 1)))
+ ((= i 25))
+ (read-line))
+ (let ((h (make-hash-table)))
+ (call-with-exit
+ (lambda (quit)
+ (do () ()
+ (let ((line (read-line)))
+ (if (or (eof-object? line)
+ (and (= (length line) 80)
+ (char=? (line 0) #\-)))
+ (quit))
+ (let ((len (length line)))
+ (do ((k 0 (+ k 1)))
+ ((or (= k len)
+ (not (char-whitespace? (line k))))
+ (if (< k len)
+ (let ((end (char-position #\space line k)))
+ (if end
+ (let ((num (string->number-ignoring-commas (substring line k end))))
+ (when num
+ (let ((func-end (char-position #\space line (+ end 2))))
+ (when (and (number? func-end)
+ (> func-end (+ end 2)))
+ (let* ((name (substring line (+ end 2) func-end))
+ (len (length name)))
+ (if (and ;(not (char=? (name 0) #\?))
+ (not (char=? (name 0) #\/))
+ (or (< len 3)
+ (not (char=? (name (- len 2)) #\')))
+ (or (< len 8)
+ (not (string=? "libgsl_" (substring name 0 7)))))
+ (set! (h (string->symbol name)) num)))))))))))))))))
+ h))
+
+(define (combine . files)
+ (let ((tables (map (lambda (file)
+ (with-input-from-file file
+ read-all-calls))
+ files)))
+ (let ((h (make-hash-table)))
+ (for-each
+ (lambda (file table)
+ (for-each
+ (lambda (entry)
+ (let ((current-entry (h (car entry))))
+ (if current-entry
+ (set! (h (car entry))
+ (cons (max (cdr entry)
+ (car current-entry))
+ (cons (list file (cdr entry))
+ (cdr current-entry))))
+ (set! (h (car entry))
+ (cons (cdr entry)
+ (list (list file (cdr entry))))))))
+ table))
+ files tables)
+
+ (let ((v (copy h (make-vector (hash-table-entries h)))))
+ (set! v (sort! v (lambda (a b) (> (cadr a) (cadr b)))))
+ (call-with-output-file "test.table"
+ (lambda (p)
+ (for-each
+ (lambda (entry)
+ (format p "~A: ~A ~{~%~16T~{~A~32T ~A~}~}~%" (car entry) (cadr entry) (cddr entry)))
+ v)))))))
+
+(define (combine-latest)
+ (let ((file-names (list "v-eq" "v-iter" "v-map" "v-form" "v-hash" "v-cop"
+ "v-lg" "v-gen" "v-auto" "v-index" "v-call" "v-all"
+ "v-test" "/home/bil/test/bench/src/v-b")))
+
+ (define (next-file f)
+ (let ((name (system (format #f "ls -t ~A*" f) #t)))
+ (let ((len (length name)))
+ (do ((i 0 (+ i 1)))
+ ((or (= i len)
+ (and (char-numeric? (name i))
+ (char-numeric? (name (+ i 1)))))
+ (string-append f (substring name i (+ i 2))))))))
+
+ (apply combine (map next-file file-names))))
+
+
+#|
+(combine "v-call53" "v-map52" "v-all98" "v-hash31" "v-gen72" "v-auto51"
+ "v-lg73" "v-cop55" "v-form66" "v-eq46" "v-test57" "v-iter70" "v-index22"
+ "/home/bil/test/bench/src/v-b28")
+|#
diff --git a/tools/compsnd b/tools/compsnd
index d4cf2a5..27963f3 100755
--- a/tools/compsnd
+++ b/tools/compsnd
@@ -13,7 +13,6 @@ fgrep maake *.html
fgrep accomoda *.c
fgrep decrip *.scm
fgrep accomoda *.scm
-# fgrep -e " #(" *.scm
fgrep -e "the the " *.c
fgrep -e "the the " *.html
fgrep udpate *.c
@@ -27,80 +26,126 @@ fgrep -e "off_t* " *.[ch]
fgrep -e " long* " *.[ch]
grep ' \-\-$' *.html
/home/bil/cl/snd tools/va.scm
-# tools/check-gtk.scm
+echo ' '
+echo ' '
rm -f snd
rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
echo ' ---- basic configure test ----- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
-make allclean
+
+./configure --quiet --with-motif CFLAGS="-O3 -Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
make
echo ' '
echo ' '
-make xm
-echo ' '
-echo ' '
./snd --version
./snd -noinit --features "'clm 'snd-s7 'snd-motif 'sndlib"
-./snd tools/check-help.scm
-# ./snd generators.scm peak-phases.scm -e "(begin (test-peak-phases) (exit))"
+./snd -e '(begin (load "cload.scm") (set! *cload-cflags* "-Wall"))' libm.scm libc.scm libgdbm.scm libdl.scm libgsl.scm -e '(exit)'
-echo ' -------------------------------- no strftime -------------------------------- '
+echo ' -------------------------------------------------------------------------------- '
+echo ' ---- ffitest ----- '
+echo ' -------------------------------------------------------------------------------- '
-sed mus-config.h -e 's/#define HAVE_STRFTIME 1/#define HAVE_STRFTIME 0/' > tmp
-mv tmp mus-config.h
-make
+cp tools/ffitest.c .
+gcc -o ffitest ffitest.c -g3 -Wall s7.o -lm -I. -ldl
+ffitest
+
+gcc s7.c -o repl -Wall -DWITH_MAIN -DUSE_SND=0 -I. -O2 -g3 -Wl,-export-dynamic -ldl -lm
-echo ' -------------------------------- no readlink -------------------------------- '
+echo '#define WITH_SYSTEM_EXTRAS 0' >mus-config.h
+cc -c s7.c -o s7.o -Wall
+rm s7.o
+echo '#define WITH_QUASIQUOTE_VECTOR 1' >mus-config.h
+cc -c s7.c -o s7.o -Wall
+rm s7.o
+echo '#define WITH_C_LOADER 0' >mus-config.h
+cc -c s7.c -o s7.o -Wall
+rm s7.o
+echo '#define WITH_EXTRA_EXPONENT_MARKERS 1' >mus-config.h
+cc -c s7.c -o s7.o -Wall
+rm s7.o
-sed mus-config.h -e 's/#define HAVE_READLINK 1/#define HAVE_READLINK 0/' > tmp
-mv tmp mus-config.h
+make clmclean
+make sndinfo
+make sndplay
+make allclean
+
+./configure --quiet --with-motif CFLAGS="-Wall -I/usr/X11R6/include -Wdeclaration-after-statement" LDFLAGS="-L/usr/X11R6/lib"
+make allclean
make
+echo ' '
+echo ' '
-echo ' -------------------------------- no lstat -------------------------------- '
+make clmclean
+make sndinfo
+make sndplay
+make allclean
-sed mus-config.h -e 's/#define HAVE_LSTAT 1/#define HAVE_LSTAT 0/' > tmp
-mv tmp mus-config.h
+echo ' '
+echo ' '
+echo ' -------------------------------------------------------------------------------- '
+echo ' ---- g++ ---- '
+echo ' -------------------------------------------------------------------------------- '
+./configure --quiet CC=g++ CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
make
+./snd --version
+./snd -noinit --features "'clm"
-echo ' -------------------------------- no access -------------------------------- '
+make allclean
+rm -f snd
+rm -f config.cache
-sed mus-config.h -e 's/#define HAVE_ACCESS 1/#define HAVE_ACCESS 0/' > tmp
-mv tmp mus-config.h
+echo ' '
+echo ' '
+echo ' -------------------------------------------------------------------------------- '
+echo ' ---- clang ---- '
+echo ' -------------------------------------------------------------------------------- '
+./configure --quiet CC=/home/bil/test/llvm-3.1.src/build/Release+Asserts/bin/clang CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
make
+./snd --version
+./snd -noinit --features "'clm"
-echo ' -------------------------------- no strcasecmp -------------------------------- '
+make allclean
+rm -f snd
+rm -f config.cache
-sed mus-config.h -e 's/#define HAVE_STRCASECMP 1/#define HAVE_STRCASECMP 0/' > tmp
-mv tmp mus-config.h
+./configure --quiet CC=clang CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
make
+make allclean
+rm -f snd
+rm -f config.cache
-echo ' -------------------------------- no snprintf -------------------------------- '
-sed mus-config.h -e 's/#define HAVE_SNPRINTF 1/#define HAVE_SNPRINTF 0/' > tmp
-mv tmp mus-config.h
+echo ' '
+echo ' '
+echo ' -------------------------------------------------------------------------------- '
+echo ' ----- --without-gui ---- '
+echo ' -------------------------------------------------------------------------------- '
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-gui
make
+echo ' '
+echo ' '
+./snd --version
+./snd -noinit --features "'clm 'snd-nogui"
-make clmclean
-make sndinfo
-make audinfo
-make sndplay
make allclean
+rm -f snd
+rm -f config.cache
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --enable-snd-debug g++ ---- '
+echo ' ----- --without-gui --- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --enable-snd-debug CC=g++ CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DWITH_MAIN" --without-gui
make
-make xm
+echo ' '
+echo ' '
./snd --version
-./snd -noinit --features "'clm 'snd-debug"
+./snd -noinit --features "'clm 'snd-nogui"
make allclean
rm -f snd
@@ -109,14 +154,14 @@ rm -f config.cache
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-no-gui ---- '
+echo ' ----- --without-audio ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-no-gui
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-audio
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features "'clm 'snd-nogui"
+./snd -noinit --features "'clm"
make allclean
rm -f snd
@@ -125,14 +170,14 @@ rm -f config.cache
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-no-gui --with-oss ---- '
+echo ' ----- --without-audio C++ ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-no-gui --with-oss
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-audio CC=g++
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features "'clm 'snd-nogui 'oss"
+./snd -noinit --features "'clm"
make allclean
rm -f snd
@@ -141,23 +186,23 @@ rm -f config.cache
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-no-gui --with-esd ---- '
+echo ' ----- --without-gui --with-oss ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-no-gui --with-esd
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-gui --with-oss
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features "'clm 'snd-nogui 'esd"
+./snd -noinit --features "'clm 'snd-nogui 'oss"
make allclean
rm -f snd
rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-no-gui --with-gmp ---- '
+echo ' ----- --without-gui --with-gmp ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-no-gui --with-gmp
+./configure --quiet --without-gui --with-gmp --with-ladspa CFLAGS="-Wall -I/usr/local/include"
make
echo ' '
echo ' '
@@ -171,9 +216,9 @@ rm -f config.cache
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- -with-no-gui --without-ladspa ---- '
+echo ' ---- -without-gui --with-ladspa ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-no-gui --without-ladspa
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -I/usr/local/include" --without-gui --with-ladspa
make
echo ' '
echo ' '
@@ -189,20 +234,24 @@ echo ' '
echo ' -------------------------------------------------------------------------------- '
echo ' ---- --with-gtk ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-gtk
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-O3 -Wall -I/usr/X11R6/include" --with-gtk
make
echo ' '
echo ' '
./snd --version
+/home/bil/cl/snd tools/va.scm
./snd -noinit --features "'clm 'snd-gtk 'snd-s7"
+make allclean
+rm -f snd
+rm -f config.cache
+
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
echo ' ---- g++ --with-gtk --disable-deprecated ---- '
echo ' -------------------------------------------------------------------------------- '
./configure --quiet CC=g++ CFLAGS="-Wall -I/usr/X11R6/include" --with-gtk --disable-deprecated
-make xg
make allclean
make
./snd --version
@@ -212,9 +261,9 @@ make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- g++ --with-gtk --- '
+echo ' ----- g++ --with-gtk --std=c++11 --- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet CC=g++ --with-gtk CFLAGS="-Wall -I/usr/X11R6/include"
+./configure --quiet CC=g++ --with-gtk CFLAGS="-std=c++11 -Wall -I/usr/X11R6/include"
make
./snd --version
./snd -noinit --features "'clm 'snd-gtk"
@@ -223,7 +272,7 @@ make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- g++ --with-gtk --with-gsl --- '
+echo ' ----- g++ --with-gtk --with-gsl --- '
echo ' -------------------------------------------------------------------------------- '
./configure --quiet CC=g++ --with-gtk --with-gsl CFLAGS="-Wall -I/usr/X11R6/include"
make
@@ -236,7 +285,7 @@ echo ' '
echo ' -------------------------------------------------------------------------------- '
echo ' ----- --with-forth ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --quiet --with-forth
+./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --quiet --with-motif --with-forth
make
./snd --version
./snd -noinit --features "'clm 'snd-forth 'snd-motif"
@@ -245,9 +294,9 @@ make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-forth --enable-snd-debug --with-static-xm --with-editres --with-gl ---- '
+echo ' ----- --with-forth --with-motif --with-editres --with-gl ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-forth --enable-snd-debug --with-static-xm --with-editres --with-gl LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
+./configure --quiet --with-forth --with-motif --with-editres --with-gl LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
make
./snd --version
./snd -noinit --features "'clm 'snd-forth 'xm 'gl"
@@ -256,9 +305,9 @@ make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-forth --with-gtk --with-static-xg --- '
+echo ' ----- --with-forth --with-gtk --- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-forth --with-gtk --with-static-xg LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
+./configure --quiet --with-forth --with-gtk LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
make
./snd --version
./snd -noinit --features "'clm 'snd-gtk 'xg 'gl"
@@ -267,9 +316,9 @@ make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-forth --with-no-gui --- '
+echo ' ----- --with-forth --without-gui --- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-forth --with-no-gui LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
+./configure --quiet --with-forth --without-gui LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
make
./snd --version
./snd -noinit --features "'clm 'snd-forth 'snd-nogui"
@@ -278,7 +327,7 @@ make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --without-extension-language ---- '
+echo ' ---- --without-extension-language ---- '
echo ' -------------------------------------------------------------------------------- '
./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --quiet --without-extension-language
make
@@ -288,9 +337,9 @@ echo ' '
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --without-extension-language --with-gtk ---- '
+echo ' ----- --without-extension-language --with-gtk ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --without-extension-language --with-gtk --with-static-xg
+./configure --quiet --without-extension-language --with-gtk
make
echo ' '
echo ' '
@@ -301,9 +350,9 @@ make sndinfo
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --without-extension-language --with-gtk ------ '
+echo ' ---- --without-extension-language --with-gl ------ '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --without-extension-language --with-gtk
+./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --quiet --without-extension-language --with-motif --with-gl
make
echo ' '
echo ' '
@@ -311,147 +360,15 @@ echo ' '
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --without-extension-language --with-just-gl ------ '
-echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --quiet --without-extension-language --with-just-gl
-make
-echo ' '
-echo ' '
-./snd --version
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --without-extension-language g++ ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --without-extension-language --with-static-xm CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include"
-make
-echo ' '
-echo ' '
-./snd --version
-make allclean
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-doubles ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-doubles
-make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm 'snd-s7"
-
-echo ' '
-make allclean
-rm -f snd
-rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --with-doubles but int samples ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-doubles --without-float-samples
-make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm 'snd-s7"
-
-echo ' '
-echo ' '
-make allclean
-rm -f snd
-rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --without-float-samples --without-ladspa --with-gl --with-gl2ps --without-gsl '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-float-samples --without-ladspa --with-gl --with-gl2ps --without-gsl
-make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm 'gl 'gl2ps"
-make clmclean
-
-echo ' '
-echo ' '
-make allclean
-rm -f snd
-rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --without-float-samples --with-sample-width=32 --with-just-gl --with-static-motif --without-fftw '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-float-samples --with-sample-width=32 --with-just-gl --with-static-motif --without-fftw
-make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm 'snd-motif"
-
-echo ' '
-echo ' '
-make allclean
-rm -f snd
-rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --without-float-samples --with-sample-width=28 ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-float-samples --with-sample-width=28
-make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm"
-
-echo ' '
-echo ' '
-make allclean
-rm -f snd
-rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --without-float-samples --with-sample-width=16 ---- '
+echo ' ----- --without-extension-language g++ ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-float-samples --with-sample-width=16
+./configure --quiet --without-extension-language CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include"
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features "'clm"
-
-echo ' '
-echo ' '
make allclean
-rm -f snd
-rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --without-float-samples --with-sample-width=24 g++ ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-float-samples --with-sample-width=24
-make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm"
-make allclean
rm -f snd
rm -f config.cache
@@ -469,20 +386,9 @@ rm -f snd
rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-gtk --with-static-xm ---- '
+echo ' ----- GTK_DISABLE_DEPRECATED G_DISABLE_DEPRECATED GDK_DISABLE_DEPRECATED --with-gtk '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-gtk --with-static-xm
-make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm 'snd-gtk 'xg"
-make allclean
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- GTK_DISABLE_DEPRECATED G_DISABLE_DEPRECATED GDK_DISABLE_DEPRECATED --with-gtk --with-static-xm '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --disable-deprecated CFLAGS="-Wall -I/usr/X11R6/include -D_FORTIFY_SOURCE" --with-gtk --with-static-xm
+./configure --quiet --disable-deprecated CFLAGS="-Wall -I/usr/X11R6/include -D_FORTIFY_SOURCE=2" --with-gtk
make
echo ' '
echo ' '
@@ -492,18 +398,17 @@ echo ' '
make allclean
rm -f snd
rm -f sndinfo
-rm -f audinfo
rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --enable-snd-debug --with-gsl ---- '
+echo ' ---- --with-gsl ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DXEN_DEBUGGING" --enable-snd-debug --with-gsl
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DDEBUGGING" --with-motif --with-gsl
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features "'clm 'gsl 'snd-debug 'snd-motif"
+./snd -noinit --features "'clm 'gsl 'snd-motif"
make allclean
echo ' -------------------------------------------------------------------------------- '
@@ -514,52 +419,34 @@ make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features "'clm 'snd-debug 'snd-motif 'gmp"
+./snd -noinit --features "'clm 'snd-motif 'gmp"
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-static-xm editres ---- '
+echo ' ---- WITH_PURE_S7 --- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-static-xm --with-editres --disable-deprecated
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DWITH_PURE_S7=1"
make
-make allclean
-
echo ' '
echo ' '
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- g++ --with-static-xm ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" --quiet CC=g++ --with-static-xm CFLAGS="-I/usr/X11R6/include"
-make
-
+./snd --version
+./snd -noinit --features "'clm 'snd-motif"
make allclean
-rm -f snd
-rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --with-snd-as-widget ---- '
+echo ' ----- editres ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-snd-as-widget
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-motif --with-editres --disable-deprecated
make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm"
-
make allclean
-rm -f snd
-rm -f config.cache
+echo ' '
+echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --enable-snd-debug --with-gtk --with-gsl '
+echo ' ----- g++ ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DXEN_DEBUGGING" --enable-snd-debug --with-gtk --with-gsl
+./configure --with-motif LDFLAGS="-L/usr/X11R6/lib" --quiet CC=g++ CFLAGS="-Wall -I/usr/X11R6/include"
make
-echo ' '
-echo ' '
-./snd --version
-./snd -noinit --features "'clm 'snd-gtk 'gsl 'gl 'snd-debug 'snd-s7"
-
make allclean
rm -f snd
@@ -568,7 +455,7 @@ rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
echo ' ---- --with-gtk --with-gmp ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-gtk --with-gmp
+./configure --quiet --with-gtk --with-gmp CFLAGS="-Wall"
make
echo ' '
echo ' '
@@ -584,13 +471,10 @@ rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
echo ' ----- --with-ruby ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby --with-motif
make
echo ' '
echo ' '
-make xm
-echo ' '
-echo ' '
./snd --version
./snd -noinit --features ":clm, :snd_ruby, :snd_motif"
make allclean
@@ -605,14 +489,14 @@ make
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-ruby --with-static-xm --with-gl --enable-snd-debug --with-alsa '
+echo ' ----- --with-ruby --with-gl --with-alsa '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DXEN_DEBUGGING" --with-ruby --with-static-xm --with-gl --enable-snd-debug --with-alsa
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DDEBUGGING" --with-ruby --with-motif --with-gl --with-alsa
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features ":clm, :alsa, :snd_ruby, :xm, :gl, :snd_debug"
+./snd -noinit --features ":clm, :alsa, :snd_ruby, :gl"
make allclean
rm -f snd
@@ -630,15 +514,6 @@ echo ' '
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- g++ --with-ruby sample-width=24 ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby --without-float-samples --with-sample-width=24
-make
-./snd --version
-./snd -noinit --features ":clm, :snd_ruby"
-make allclean
-
-echo ' -------------------------------------------------------------------------------- '
echo ' ----- g++ --with-ruby --with-gtk --with-alsa ---- '
echo ' -------------------------------------------------------------------------------- '
./configure --quiet CC=g++ --with-ruby --with-gtk --with-alsa
@@ -650,34 +525,34 @@ echo ' '
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --with-ruby --with-static-xm --with-gtk --enable-snd-debug --without-gsl '
+echo ' ---- --with-ruby --with-gtk --without-gsl '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DXEN_DEBUGGING" --with-ruby --with-static-xm --with-gtk --enable-snd-debug --without-gsl
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DDEBUGGING" --with-ruby --with-gtk --without-gsl
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features ":clm, :snd_ruby, :xg, :snd_gtk, :snd_debug"
+./snd -noinit --features ":clm, :snd_ruby, :snd_gtk"
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- GTK_DISABLE_DEPRECATED G_DISABLE_DEPRECATED GDK_DISABLE_DEPRECATED --with-ruby --with-static-xm --with-gtk '
+echo ' ---- GTK_DISABLE_DEPRECATED G_DISABLE_DEPRECATED GDK_DISABLE_DEPRECATED --with-ruby --with-gtk '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --disable-deprecated LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -D_FORTIFY_SOURCE" --with-ruby --with-static-xm --with-gtk
+./configure --quiet --disable-deprecated LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -D_FORTIFY_SOURCE=2" --with-ruby --with-gtk
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features "'clm 'snd-gtk 'xg 'gl"
+./snd -noinit --features ":clm, :snd-gtk, :xg"
make allclean
rm -f snd
rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --with-ruby --with-no-gui --without-fftw --- '
+echo ' ---- --with-ruby --without-gui --without-fftw --- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby --with-no-gui --without-fftw
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby --without-gui --without-fftw
make
echo ' '
echo ' '
@@ -686,25 +561,25 @@ echo ' '
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-ruby --with-no-gui --enable-snd-debug ---- '
+echo ' ----- --with-ruby --without-gui ----- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DXEN_DEBUGGING" --with-ruby --with-no-gui --enable-snd-debug
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DDEBUGGING" --with-ruby --without-gui
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features ":clm, :snd_nogui, :snd_debug, :snd_ruby"
+./snd -noinit --features ":clm, :snd_nogui, :snd_ruby"
make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- g++ --with-ruby --with-no-gui --enable-snd-debug ---- '
+echo ' ---- g++ --with-ruby --without-gui ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DXEN_DEBUGGING" --with-ruby --with-no-gui --enable-snd-debug
+./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -DDEBUGGING" --with-ruby --without-gui
make
echo ' '
echo ' '
./snd --version
-./snd -noinit --features ":clm, :snd_nogui, :snd_ruby, :snd_debug"
+./snd -noinit --features ":clm, :snd_nogui, :snd_ruby"
make allclean
rm -f snd
@@ -713,14 +588,12 @@ rm -f config.cache
echo ' -------------------------------------------------------------------------------- '
echo ' ---- g++ --- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -Wextra -I/usr/X11R6/include"
+./configure --quiet --with-motif --with-ladspa CC=g++ LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include -I/usr/local/include"
make
./snd --version
./snd -noinit --features "'clm 'snd-s7 'snd-motif 'snd-ladspa 'sndlib"
make sndinfo
-make audinfo
make sndplay
-./audinfo
./sndinfo test.snd
make allclean
@@ -729,7 +602,7 @@ echo ' '
echo ' -------------------------------------------------------------------------------- '
echo ' ---- g++ --with-gtk ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet CC=g++ --with-gtk
+./configure --quiet CC=g++ --with-gtk CFLAGS="-Wall"
make
./snd --version
./snd -noinit --features "'clm 'snd-gtk"
@@ -738,9 +611,9 @@ make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- g++ --with-no-gui ---- '
+echo ' ---- g++ --without-gui ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --quiet CC=g++ --with-no-gui
+./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --quiet CC=g++ --without-gui
make
./snd --version
./snd -noinit --features "'clm 'snd-nogui 'snd-s7"
@@ -757,9 +630,9 @@ echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- g++ --with-static-xm --without-gsl --with-alsa '
+echo ' ----- g++ --without-gsl --with-alsa '
echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --quiet CC=g++ --with-static-xm --without-gsl --with-alsa
+./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --quiet CC=g++ --without-gsl --with-alsa
make
./snd --version
./snd -noinit --features "'clm 'alsa 'xm"
@@ -771,7 +644,6 @@ make allclean
rm -f snd
rm -f config.cache
rm -f sndinfo
-rm -f audinfo
echo ' -------------------------------------------------------------------------------- '
echo ' ----- sndlib ---- '
@@ -779,30 +651,15 @@ echo ' -------------------------------------------------------------------------
./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include"
make sndinfo
sndinfo oboe.snd
-make audinfo
-audinfo
sndinfo test.snd
-
-echo ' '
-echo ' '
make allclean
-echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --with-shared-sndlib ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --quiet --with-shared-sndlib
-make
-./snd --version
-./snd -noinit --features "'clm"
-
echo ' '
echo ' '
-echo ' -------------------------------- no-gui test -------------------------------- '
-make allclean
-rm -f snd
+
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --with-no-gui ---- '
+echo ' ---- --without-gui ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-no-gui
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --without-gui
make
echo ' '
echo ' '
@@ -818,9 +675,9 @@ rm -f mus-config.h
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-static-xm -DXM_DISABLE_DEPRECATED ----- '
+echo ' ----- -DXM_DISABLE_DEPRECATED ----- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-static-xm LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-DXM_DISABLE_DEPRECATED -Wall -I/usr/X11R6/include"
+./configure --quiet LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -DXM_DISABLE_DEPRECATED -Wall -I/usr/X11R6/include"
make
./snd --version
./snd -noinit --features "'clm 'xm"
@@ -829,20 +686,20 @@ echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-static-xm --with-ruby -DXM_DISABLE_DEPRECATED ---- '
+echo ' ----- --with-ruby -DXM_DISABLE_DEPRECATED ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-static-xm --with-ruby LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-DXM_DISABLE_DEPRECATED -Wall -I/usr/X11R6/include"
+./configure --quiet --with-ruby LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -DXM_DISABLE_DEPRECATED -Wall -I/usr/X11R6/include"
make
./snd --version
-./snd -noinit --features ":clm, :xm, :snd_ruby"
+./snd -noinit --features ":clm, :snd_ruby"
make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-no-gui --without-extension-language ----- '
+echo ' ----- --without-gui --without-extension-language ----- '
echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --with-no-gui --without-extension-language --quiet
+./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --without-gui --without-extension-language --quiet
make
./snd --version
make allclean
@@ -850,9 +707,9 @@ echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --without-extension-language --with-static-xm --with-gl - '
+echo ' ---- --without-extension-language --with-gl '
echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --without-extension-language --with-static-xm --with-gl --quiet
+./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --without-extension-language --with-motif --with-gl --quiet
make
./snd --version
make allclean
@@ -860,9 +717,9 @@ echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --with-static-xm --with-just-gl --with-gl2ps ------ '
+echo ' ----- --with-gl --with-gl2ps ------ '
echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --with-static-xm --with-just-gl --quiet --with-gl2ps
+./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-Wall -I/usr/X11R6/include" --with-motif --with-gl --quiet --with-gl2ps
make
./snd --version
./snd -noinit --features "'clm 'xm 'gl2ps"
@@ -871,70 +728,16 @@ echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --without-extension-language --with-gtk --with-static-xg '
-echo ' -------------------------------------------------------------------------------- '
-./configure --without-extension-language --with-gtk --with-static-xg --quiet
-make
-./snd --version
-make allclean
-echo ' '
-echo ' '
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --without-fam ---- '
+echo ' ----- --without-extension-language --with-gtk ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --without-fam --quiet
+./configure --without-extension-language --with-gtk --quiet
make
./snd --version
-./snd -noinit --features "'clm 'snd-s7 'snd-motif 'sndlib"
-make allclean
make allclean
echo ' '
echo ' '
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --without-fam --with-gtk ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --without-fam --with-gtk --quiet
-make
-./snd --version
-./snd -noinit --features "'clm 'snd-gtk"
-make allclean
-
-echo ' '
-echo ' '
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --enable-threads ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --enable-threads --quiet
-make
-./snd --version
-./snd -noinit --features "'clm 'snd-s7 'snd-motif 'snd-threads"
-make allclean
-
-echo ' '
-echo ' '
-echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --enable-threads g++ ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure LDFLAGS="-L/usr/X11R6/lib" CFLAGS="-I/usr/X11R6/include" --enable-threads --quiet CC=g++
-make
-./snd --version
-./snd -noinit --features "'clm 'snd-s7 'snd-threads"
-make allclean
-
-echo ' '
-echo ' '
-echo ' -------------------------------------------------------------------------------- '
-echo ' ----- --enable-threads --with-gtk --with-ruby ---- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --enable-threads --with-gtk --with-ruby --quiet
-make
-./snd --version
-./snd -noinit --features ":clm, :snd-gtk, :snd_ruby"
-make allclean
-
-echo ' -------------------------------------------------------------------------------- '
echo ' ---- --with-portaudio ---- '
echo ' -------------------------------------------------------------------------------- '
./configure --with-portaudio --quiet
@@ -946,9 +749,9 @@ make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --with-pulseaudio ---- '
+echo ' ---- --with-jack ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --with-pulseaudio --quiet
+./configure --with-jack --with-alsa --quiet
make
./snd --version
./snd -noinit --features "'clm 'snd-gtk"
@@ -957,9 +760,9 @@ make allclean
echo ' -------------------------------------------------------------------------------- '
-echo ' ---- --with-portaudio ---- '
+echo ' ---- --with-pulseaudio ---- '
echo ' -------------------------------------------------------------------------------- '
-./configure --with-portaudio --quiet
+./configure --with-pulseaudio --quiet
make
./snd --version
./snd -noinit --features "'clm 'snd-gtk"
@@ -978,40 +781,34 @@ cp tools/exs7.c .
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 1 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-gcc -o exs7 exs7.c s7.o -lm -DEX1
+gcc -o exs7 exs7.c s7.o -lm -DEX1 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 2 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-gcc -o exs7 exs7.c s7.o -lm -DEX2
+gcc -o exs7 exs7.c s7.o -lm -DEX2 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 3 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-gcc -o exs7 exs7.c s7.o -lm -DEX3
+gcc -o exs7 exs7.c s7.o -lm -DEX3 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 4 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-gcc -o exs7 exs7.c s7.o -lm -DEX4
+gcc -o exs7 exs7.c s7.o -lm -DEX4 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 5 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-gcc -o exs7 exs7.c s7.o -lm -DEX5
+gcc -o exs7 exs7.c s7.o -lm -DEX5 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 6 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-gcc -o exs7 exs7.c s7.o -lm -DEX6
+gcc -o exs7 exs7.c s7.o -lm -DEX6 -ldl
-make clean
-echo ' -------------------------------------------------------------------------------- '
-echo ' -------------------------------- sndlib threads -------------------------------- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --enable-threads
-make
-make clean
-echo ' -------------------------------------------------------------------------------- '
-echo ' -------------------------------- sndlib ruby -------------------------------- '
-echo ' -------------------------------------------------------------------------------- '
-./configure --quiet --with-ruby
-make
+# make clean
+# echo ' -------------------------------------------------------------------------------- '
+# echo ' -------------------------------- sndlib ruby -------------------------------- '
+# echo ' -------------------------------------------------------------------------------- '
+# ./configure --quiet --with-ruby
+# make
make clean
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- sndlib forth -------------------------------- '
@@ -1027,53 +824,27 @@ make
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 1 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-g++ -o exs7 exs7.c s7.o -lm -DEX1
+g++ -o exs7 exs7.c s7.o -lm -DEX1 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 2 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-g++ -o exs7 exs7.c s7.o -lm -DEX2
+g++ -o exs7 exs7.c s7.o -lm -DEX2 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 3 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-g++ -o exs7 exs7.c s7.o -lm -DEX3
+g++ -o exs7 exs7.c s7.o -lm -DEX3 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 4 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-g++ -o exs7 exs7.c s7.o -lm -DEX4 /home/bil/test/sndlib/libsndlib.a -lgsl -lgslcblas -lasound
+g++ -o exs7 exs7.c s7.o -lm -DEX4 -ldl /home/bil/test/sndlib/libsndlib.a -lgsl -lgslcblas -lasound
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 5 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-g++ -o exs7 exs7.c s7.o -lm -DEX5
+g++ -o exs7 exs7.c s7.o -lm -DEX5 -ldl
echo ' -------------------------------------------------------------------------------- '
echo ' -------------------------------- ex 6 -------------------------------- '
echo ' -------------------------------------------------------------------------------- '
-g++ -o exs7 exs7.c s7.o -lm -DEX6
+g++ -o exs7 exs7.c s7.o -lm -DEX6 -ldl
rm exs7
rm exs7.o
make clean
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' -------------------------------- no read-line -------------------------------- '
-echo ' -------------------------------------------------------------------------------- '
-sed s7.c -e 's/#define WITH_READ_LINE 1/#define WITH_READ_LINE 0/' > tmp
-mv tmp s7.c
-make
-make clean
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' -------------------------------- with debugging -------------------------------- '
-echo ' -------------------------------------------------------------------------------- '
-sed s7.c -e 's/#define S7_DEBUGGING 0/#define S7_DEBUGGING 1/' > tmp
-mv tmp s7.c
-make
-make clean
-
-echo ' -------------------------------------------------------------------------------- '
-echo ' -------------------------------- with int s7_Int -------------------------------- '
-echo ' -------------------------------------------------------------------------------- '
-sed s7.h -e 's/#define s7_Int long long int/#define s7_Int int/' > tmp
-mv tmp s7.c
-sed s7.h -e 's/#define s7_Int_d "%lld"/#define s7_Int_d "%d"/' > tmp
-mv tmp s7.c
-make
-make clean
diff --git a/tools/crossref.c b/tools/crossref.c
index accc102..5768b68 100644
--- a/tools/crossref.c
+++ b/tools/crossref.c
@@ -1,4 +1,4 @@
-/* gcc -o crossref crossref.c -O2 */
+/* gcc -o crossref crossref.c -O2 -Wall */
#include <ctype.h>
#include <stddef.h>
@@ -8,7 +8,25 @@
#include <fcntl.h>
#include <string.h>
#include <stdbool.h>
+#include <unistd.h>
+#if 1
+/* this is almost four times faster */
+static bool local_strcmp(const char *s1, const char *s2)
+{
+ unsigned char c1, c2;
+ while (true)
+ {
+ c1 = (unsigned char) *s1++;
+ c2 = (unsigned char) *s2++;
+ if (c1 != c2) return(false);
+ if (c1 == '\0') break;
+ }
+ return(true);
+}
+#else
+#define local_strcmp(S1, S2) (strcmp(S1, S2) == 0)
+#endif
char **names;
char **hnames;
@@ -59,11 +77,11 @@ int add_name(char *name, char *hdr)
*/
if (name[0] == '_') return(-1);
- if ((strcmp(hdr, "snd-nogui0.h") == 0) ||
- (strcmp(hdr, "snd-nogui1.h") == 0))
+ if ((local_strcmp(hdr, "snd-nogui0.h")) ||
+ (local_strcmp(hdr, "snd-nogui1.h")))
nnames[nname_ctr++] = name;
for (i = 0; i < names_ctr; i++)
- if (strcmp(names[i], name) == 0) return(-1);
+ if (local_strcmp(names[i], name)) return(-1);
hnames[names_ctr] = hdr;
names[names_ctr++] = name;
if (names_ctr == names_size) fprintf(stderr,"oops names");
@@ -74,15 +92,15 @@ int in_nogui_h(char *name)
{
int i;
for (i = 0; i < nname_ctr; i++)
- if (strcmp(name, nnames[i]) == 0)
+ if (local_strcmp(name, nnames[i]))
return(1);
return(0);
}
void add_file(char *name)
{
- if (strcmp(name,"snd-xen.c") == 0) snd_xen_c = files_ctr;
- if (strcmp(name,"snd-nogui.c") == 0) snd_nogui_c = files_ctr;
+ if (local_strcmp(name,"snd-xen.c")) snd_xen_c = files_ctr;
+ if (local_strcmp(name,"snd-nogui.c")) snd_nogui_c = files_ctr;
files[files_ctr++] = mus_strdup(name);
if (files_ctr == files_size) fprintf(stderr,"oops files");
}
@@ -91,7 +109,7 @@ static int add_count(char *name, int curfile)
{
int i;
for (i = 0; i < names_ctr; i++)
- if (strcmp(names[i], name) == 0)
+ if (local_strcmp(names[i], name))
{
if (counts[i] == NULL) counts[i] = (int *)calloc(files_size, sizeof(int));
counts[i][curfile] += 1;
@@ -104,7 +122,7 @@ static void add_def(char *name, int curfile)
{
int i;
for (i = 0; i < names_ctr; i++)
- if (strcmp(names[i], name) == 0)
+ if (local_strcmp(names[i], name))
{
if (!(defs[i]))
defs[i] = strdup(files[curfile]);
@@ -199,11 +217,11 @@ static int greater_compare(const void *a, const void *b)
}
#define NAME_SIZE 8192
-#define ID_SIZE 8192
+#define ID_SIZE 16384
int main(int argc, char **argv)
{
- int i, j, fd, curfile, chars, k, in_comment = 0, in_white = 0, calls = 0, in_parens = 0, in_quotes = 0, in_define = 0, in_curly = 0, in_enum = 0;
+ int i, j, fd, chars, k, in_comment = 0, in_cpp_comment = 0, in_white = 0, calls = 0, in_parens = 0, in_quotes = 0, in_define = 0, in_curly = 0, in_enum = 0;
int maxc[NAME_SIZE], maxf[NAME_SIZE], maxg[NAME_SIZE], mcalls[NAME_SIZE];
qdata **qs;
char input[MAX_CHARS];
@@ -231,6 +249,7 @@ int main(int argc, char **argv)
add_header("sndlib2xen.h");
add_header("clm2xen.h");
add_header("snd.h");
+ add_header("glistener.h");
#if 1
add_header("snd-strings.h");
add_header("sndlib-strings.h");
@@ -244,8 +263,6 @@ int main(int argc, char **argv)
add_header("snd-g1.h");
add_header("snd-nogui0.h");
add_header("snd-nogui1.h");
- add_header("xen.h");
- add_header("mus-config.h.in");
add_header("libclm.def");
add_header("snd-menu.h");
add_header("snd-file.h");
@@ -256,6 +273,11 @@ int main(int argc, char **argv)
/* add_file("xen.h"); */
/* add_file("snd.h"); */
+ /* these need to be last */
+ add_header("xen.h");
+ add_header("mus-config.h.in");
+
+ add_file("glistener.c");
add_file("headers.c");
add_file("audio.c");
add_file("io.c");
@@ -266,7 +288,6 @@ int main(int argc, char **argv)
add_file("clm2xen.c");
add_file("snd-io.c");
add_file("snd-utils.c");
- add_file("snd-error.c");
add_file("snd-completion.c");
add_file("snd-menu.c");
add_file("snd-draw.c");
@@ -293,28 +314,11 @@ int main(int argc, char **argv)
add_file("snd-env.c");
add_file("snd-xen.c");
add_file("snd-ladspa.c");
- add_file("run.c");
- add_file("snd-xutils.c");
- add_file("snd-xhelp.c");
- add_file("snd-xfind.c");
- add_file("snd-xmenu.c");
- add_file("snd-xdraw.c");
- add_file("snd-xlistener.c");
+ add_file("snd-motif.c");
add_file("snd-listener.c");
- add_file("snd-xchn.c");
- add_file("snd-xsnd.c");
- add_file("snd-xregion.c");
- add_file("snd-xdrop.c");
- add_file("snd-xmain.c");
- add_file("snd-xmix.c");
- add_file("snd-xrec.c");
- add_file("snd-xenv.c");
+ add_file("snd-xref.c");
add_file("snd-gxbitmaps.c");
add_file("snd-gxcolormaps.c");
- add_file("snd-xfft.c");
- add_file("snd-xprint.c");
- add_file("snd-xfile.c");
- add_file("snd-xprefs.c");
add_file("snd-gutils.c");
add_file("snd-ghelp.c");
add_file("snd-gfind.c");
@@ -324,13 +328,10 @@ int main(int argc, char **argv)
add_file("snd-gchn.c");
add_file("snd-gsnd.c");
add_file("snd-gregion.c");
- add_file("snd-gdrop.c");
add_file("snd-gmain.c");
add_file("snd-gmix.c");
- add_file("snd-grec.c");
add_file("snd-genv.c");
add_file("snd-gfft.c");
- add_file("snd-gprint.c");
add_file("snd-gfile.c");
add_file("snd-gprefs.c");
add_file("snd-prefs.c");
@@ -347,6 +348,24 @@ int main(int argc, char **argv)
add_file("clm1.lisp");
add_file("sndins/sndins.c");
+ add_file("ffitest.c");
+ add_file("tools/gcall.c");
+
+ add_file("/home/bil/test/s7webserver/s7webserver.cpp");
+ add_file("/home/bil/test/radium-3.4.2/embedded_scheme/scheme.cpp");
+
+ add_file("/home/bil/test/cm308/cm-3.8.0/src/CmSupport.cpp");
+ add_file("/home/bil/test/cm308/cm-3.8.0/src/Scheme.cpp");
+ add_file("/home/bil/test/cm308/cm-3.8.0/src/SndLib.cpp");
+ add_file("/home/bil/test/cm308/cm-3.8.0/src/SndLibBridge.cpp");
+
+ add_file("/home/bil/test/cm390/cm/src/CmSupport.cpp");
+ add_file("/home/bil/test/cm390/cm/src/Scheme.cpp");
+ add_file("/home/bil/test/cm390/cm/src/SndLib.cpp");
+ add_file("/home/bil/test/cm390/cm/src/SndLibBridge.cpp");
+ add_file("/home/bil/test/cm390/cm/src/s7.cpp");
+ add_file("/home/bil/test/cm390/cm/src/Osc.cpp");
+ add_file("/home/bil/test/cm390/cm/src/SchemeSources.cpp");
for (i = 0; i < headers_ctr; i++)
{
@@ -355,6 +374,7 @@ int main(int argc, char **argv)
in_white = 0;
in_parens = 0;
in_comment = 0;
+ in_cpp_comment = 0;
fd = open(headers[i], O_RDONLY, 0);
if (fd == -1)
fprintf(stderr, "can't find %s\n", headers[i]);
@@ -365,7 +385,7 @@ int main(int argc, char **argv)
chars = read(fd, input, MAX_CHARS);
for (j = 0; j < chars; j++)
{
- if ((in_comment == 0) && (in_curly == 0))
+ if ((in_comment == 0) && (in_cpp_comment == 0) && (in_curly == 0))
{
if ((isalpha(input[j])) || (isdigit(input[j])) || (input[j] == '_'))
{
@@ -380,6 +400,9 @@ int main(int argc, char **argv)
if (k < ID_SIZE)
curname[k] = 0;
else fprintf(stderr, "1: curname overflow: %s[%d]: %s\n", headers[i], j, curname);
+
+ /* fprintf(stderr, "%s name: %s %d %d %d\n", headers[i], curname, k, in_parens, in_quotes); */
+
if ((k > 0) && (in_parens == 0) && (in_quotes == 0))
{
int loc;
@@ -415,22 +438,27 @@ int main(int argc, char **argv)
in_comment = 1;
else
{
- if (input[j] == '#')
- in_define = 1;
- else
+ if ((input[j] == '/') && (input[j + 1] == '/'))
+ in_cpp_comment = 1;
+ else
{
- if ((input[j] == '{') &&
- ((j < 6) || (strncmp((input + (j - 5)), "enum", 4) != 0)))
- in_curly = 1;
+ if (input[j] == '#')
+ in_define = 1;
else
{
- if (input[j] == '(') in_parens++;
- if (input[j] == ')') in_parens--;
- if (input[j] == '"')
+ if ((input[j] == '{') &&
+ ((j < 6) || (strncmp((input + (j - 5)), "enum", 4) != 0)))
+ in_curly = 1;
+ else
{
- if (in_quotes == 1)
- in_quotes = 0;
- else in_quotes = 1;
+ if (input[j] == '(') in_parens++;
+ if (input[j] == ')') in_parens--;
+ if (input[j] == '"')
+ {
+ if (in_quotes == 1)
+ in_quotes = 0;
+ else in_quotes = 1;
+ }
}
}
}
@@ -449,6 +477,11 @@ int main(int argc, char **argv)
{
if (input[j] == ';')
in_curly = 0;
+ else
+ {
+ if (input[j] == '\n')
+ in_cpp_comment = 0;
+ }
}
}
}
@@ -468,6 +501,7 @@ int main(int argc, char **argv)
k = 0;
in_comment = 0;
+ in_cpp_comment = 0;
in_white = 0;
in_define = 0;
in_enum = 0;
@@ -487,8 +521,8 @@ int main(int argc, char **argv)
bool got_macro = false;
in_define = 0;
- if ((strcmp(files[i], "sndlib2clm.lisp") == 0) ||
- (strcmp(files[i], "ffi.lisp") == 0))
+ if ((local_strcmp(files[i], "sndlib2clm.lisp")) ||
+ (local_strcmp(files[i], "ffi.lisp")))
curly_ctr = 1;
do
@@ -498,7 +532,7 @@ int main(int argc, char **argv)
for (j = 0; j < chars; j++)
{
- if (in_comment == 0)
+ if ((in_comment == 0) && (in_cpp_comment == 0))
{
if ((isalpha(input[j])) || (isdigit(input[j])) || (input[j] == '_'))
{
@@ -512,35 +546,42 @@ int main(int argc, char **argv)
in_comment = 1;
else
{
- if ((input[j] == '#') && ((input[j + 1] == 'd') || (input[j + 1] == 'u')))
- {
- in_define = 1;
- got_macro = false;
- }
+ if ((input[j] == '/') && (input[j + 1] == '/'))
+ in_cpp_comment = 1;
else
{
- if ((in_define == 1) && (input[j] == '\n') && (j > 0) && (input[j - 1] != '\\'))
+ if ((input[j] == '#') &&
+ (((input[j + 1] == 'd') && (input[j + 2] == 'e')) ||
+ ((input[j + 1] == 'u') && (input[j + 2] == 'n'))))
{
- cancel_define = 1;
+ in_define = 1;
+ got_macro = false;
}
- }
- if ((in_define == 0) &&
- (j < (chars - 1)) &&
- ((input[j - 1] != '\'') || (input[j + 1] != '\'')))
- {
- if (input[j] == '{')
+ else
{
- curly_ctr++;
- if ((j > 4) &&
- (strncmp((input + (j - 5)), "enum", 4) == 0))
- in_enum = true;
+ if ((in_define == 1) && (input[j] == '\n') && (j > 0) && (input[j - 1] != '\\'))
+ {
+ cancel_define = 1;
+ }
}
- else
+ if ((in_define == 0) &&
+ (j < (chars - 1)) &&
+ ((input[j - 1] != '\'') || (input[j + 1] != '\'')))
{
- if (input[j] == '}')
+ if (input[j] == '{')
{
- curly_ctr--;
- if (in_enum) in_enum = false;
+ curly_ctr++;
+ if ((j > 4) &&
+ (strncmp((input + (j - 5)), "enum", 4) == 0))
+ in_enum = true;
+ }
+ else
+ {
+ if (input[j] == '}')
+ {
+ curly_ctr--;
+ if (in_enum) in_enum = false;
+ }
}
}
}
@@ -572,7 +613,7 @@ int main(int argc, char **argv)
}
for (m = 0; m < all_names_top; m++)
- if (strcmp(curname, all_names[m]) == 0)
+ if (local_strcmp(curname, all_names[m]))
{
happy = true;
all_names_counts[m]++;
@@ -580,8 +621,8 @@ int main(int argc, char **argv)
if (((!got_macro) &&
(in_define == 1) &&
- (strcmp(curname, "define") != 0) &&
- (strcmp(curname, "undef") != 0)) ||
+ (!local_strcmp(curname, "define")) &&
+ (!local_strcmp(curname, "undef"))) ||
(in_enum))
{
got_macro = true;
@@ -650,6 +691,11 @@ int main(int argc, char **argv)
{
if ((input[j] == '*') && (input[j + 1] == '/'))
in_comment = 0;
+ else
+ {
+ if (input[j] == '\n')
+ in_cpp_comment = 0;
+ }
}
}
}
@@ -661,7 +707,9 @@ int main(int argc, char **argv)
bool name_printed = false;
for (m = 0; m < all_names_top; m++)
if ((all_names_counts[m] == 0) &&
- (all_names[m][0] != '_'))
+ (all_names[m][0] != '_') &&
+ (((all_names[m][0] != 'Q') && (all_names[m][0] != 'H')) || (all_names[m][1] != '_')))
+
{
if (!name_printed)
{
@@ -722,17 +770,17 @@ int main(int argc, char **argv)
qsort((void *)qs, names_ctr, sizeof(qdata *), greater_compare);
for (i = 0; i < names_ctr; i++)
{
- bool menu_case = false, file_case = false, nonogui_case = false, static_case = false, x_case = true;
+ bool menu_case, file_case, nonogui_case, static_case, x_case = true, ffitest_case;
int menu_count = 0, file_count = 0, rec_count = 0, x_count = 0;
int nfiles;
nfiles = 0;
/* try to get rid of a bunch of annoying false positives */
- if ((strcmp(qs[i]->hname, "xen.h") == 0) ||
- (strcmp(qs[i]->hname, "mus-config.h.in") == 0) ||
+ if ((local_strcmp(qs[i]->hname, "xen.h")) ||
+ (local_strcmp(qs[i]->hname, "mus-config.h.in")) ||
(qs[i]->name[0] == '_') ||
((qs[i]->name[strlen(qs[i]->name) - 2] == '_') &&
((qs[i]->name[strlen(qs[i]->name) - 1] == 't') ||
- (qs[i]->name[strlen(qs[i]->name) - 1] == 'H'))))
+ (qs[i]->name[strlen(qs[i]->name) - 1] == 'H')))) /* SND_0_H etc */
{
}
else
@@ -751,10 +799,28 @@ int main(int argc, char **argv)
(strncmp(qs[i]->name, "in_set_", 7) != 0))
fprintf(FD, " (not void but result not used?)");
}
+ if (qs[i]->calls == 0)
+ {
+ char buf1[512], buf2[512];
+ snprintf(buf1, 512, "fgrep -q %s xen.h", qs[i]->name);
+ snprintf(buf2, 512, "fgrep -q %s s7.html", qs[i]->name);
+ if (system((const char *)buf1) == 0)
+ {
+ if (system((const char *)buf2) == 0)
+ fprintf(FD, " (used in xen.h and s7.html)");
+ else fprintf(FD, " (used in xen.h)");
+ }
+ else
+ {
+ if (system((const char *)buf2) == 0)
+ fprintf(FD, " (used in s7.html)");
+ }
+ }
- menu_case = (strcmp(qs[i]->hname, "snd-menu.h") != 0);
- file_case = (strcmp(qs[i]->hname, "snd-file.h") != 0);
+ menu_case = (!local_strcmp(qs[i]->hname, "snd-menu.h"));
+ file_case = (!local_strcmp(qs[i]->hname, "snd-file.h"));
static_case = ((qs[i]->def != NULL) && (qs[i]->calls > 0));
+ ffitest_case = ((qs[i]->def != NULL) && (qs[i]->calls > 0));
menu_count = 0;
file_count = 0;
@@ -766,9 +832,9 @@ int main(int argc, char **argv)
/* fprintf(stderr, "%s...", qs[i]->name); */
for (j = 0; j < files_ctr; j++)
if ((counts[qs[i]->i][j] > 0) &&
- ((strcmp(files[j], "snd-xen.c") == 0) ||
- ((strcmp(files[j], "snd-nogui.c") != 0) &&
- (strncmp(files[j], "snd-x", 5) != 0) &&
+ ((local_strcmp(files[j], "snd-xen.c")) ||
+ ((!local_strcmp(files[j], "snd-nogui.c")) &&
+ (!local_strcmp(files[j], "snd-motif.c")) &&
(strncmp(files[j], "snd-g", 5) != 0))))
{
/* fprintf(stderr,"in %s\n", files[j]); */
@@ -782,13 +848,17 @@ int main(int argc, char **argv)
{
if ((counts[qs[i]->i]) && (counts[qs[i]->i][j] > 0))
{
+ if ((ffitest_case) &&
+ (!local_strcmp(files[j], "ffitest.c")))
+ ffitest_case = false;
+
if (menu_case)
{
- if ((strcmp(files[j], "snd-menu.c") != 0) &&
- (strcmp(files[j], "snd-xmenu.c") != 0) &&
- (strcmp(files[j], "snd-gmenu.c") != 0))
+ if ((!local_strcmp(files[j], "snd-menu.c")) &&
+ (!local_strcmp(files[j], "snd-motif.c")) &&
+ (!local_strcmp(files[j], "snd-gmenu.c")))
{
- if (strcmp(files[j], "snd-nogui.c") != 0)
+ if (!local_strcmp(files[j], "snd-nogui.c"))
menu_case = false;
}
else menu_count++;
@@ -796,34 +866,34 @@ int main(int argc, char **argv)
if (x_case)
{
- if (((strncmp(files[j], "snd-x", 5) != 0) &&
+ if (((!local_strcmp(files[j], "snd-motif.c")) &&
(strncmp(files[j], "snd-g", 5) != 0)) ||
- (strcmp(files[j], "snd-xen.c") == 0))
+ (local_strcmp(files[j], "snd-xen.c")))
x_case = false;
else x_count++;
}
if (file_case)
{
- if ((strcmp(files[j], "snd-file.c") != 0) &&
- (strcmp(files[j], "snd-xfile.c") != 0) &&
- (strcmp(files[j], "snd-gfile.c") != 0))
+ if ((!local_strcmp(files[j], "snd-file.c")) &&
+ (!local_strcmp(files[j], "snd-motif.c")) &&
+ (!local_strcmp(files[j], "snd-gfile.c")))
{
- if (strcmp(files[j], "snd-nogui.c") != 0)
+ if (!local_strcmp(files[j], "snd-nogui.c"))
file_case = false;
}
else file_count++;
}
if ((static_case) &&
- (strcmp(files[j], qs[i]->def) != 0) &&
- (strcmp(files[j], "snd-nogui.c") != 0))
+ (!local_strcmp(files[j], qs[i]->def)) &&
+ (!local_strcmp(files[j], "snd-nogui.c")))
{
- if (((strncmp(files[j], "snd-x", 5) == 0) ||
+ if (((local_strcmp(files[j], "snd-motif.c")) ||
(strncmp(files[j], "snd-g", 5) == 0)) &&
- ((strncmp(qs[i]->def, "snd-x", 5) == 0) ||
+ ((local_strcmp(qs[i]->def, "snd-motif.c")) ||
(strncmp(qs[i]->def, "snd-g", 5) == 0)) &&
- (strcmp((const char *)(files[j] + 5), (const char *)(qs[i]->def + 5)) == 0))
+ (local_strcmp((const char *)(files[j] + 5), (const char *)(qs[i]->def + 5))))
{
}
else static_case = false;
@@ -834,27 +904,38 @@ int main(int argc, char **argv)
}
}
+ if (ffitest_case)
+ {
+ char buf1[512], buf2[512];
+ snprintf(buf1, 512, "fgrep -q %s xen.h", qs[i]->name);
+ snprintf(buf2, 512, "fgrep -q %s s7.html", qs[i]->name);
+ if ((system((const char *)buf1) != 0) &&
+ (system((const char *)buf2) != 0))
+ fprintf(FD, "\njust ffitest!");
+ }
+
if ((menu_case) &&
(menu_count > 0) &&
((!(qs[i]->def)) ||
- (strcmp(qs[i]->def, "snd-menu.c") == 0) ||
- (strcmp(qs[i]->def, "snd-xmenu.c") == 0) ||
- (strcmp(qs[i]->def, "snd-gmenu.c") == 0)))
+ (local_strcmp(qs[i]->def, "snd-menu.c")) ||
+ (local_strcmp(qs[i]->def, "snd-motif.c")) ||
+ (local_strcmp(qs[i]->def, "snd-gmenu.c"))))
fprintf(FD, "\n->SND-MENU.H\n");
if ((file_case) &&
(file_count > 0) &&
((!(qs[i]->def)) ||
- (strcmp(qs[i]->def, "snd-file.c") == 0) ||
- (strcmp(qs[i]->def, "snd-xfile.c") == 0) ||
- (strcmp(qs[i]->def, "snd-gfile.c") == 0)))
+ (local_strcmp(qs[i]->def, "snd-file.c")) ||
+ (local_strcmp(qs[i]->def, "snd-motif.c")) ||
+ (local_strcmp(qs[i]->def, "snd-gfile.c"))))
fprintf(FD, "\n->SND-FILE.H\n");
if ((x_case) &&
(x_count > 0) &&
(qs[i]->def) &&
- (strcmp(qs[i]->def, "snd-xen.c") != 0) &&
- ((strncmp(qs[i]->def, "snd-x", 5) == 0) ||
+ (local_strcmp(qs[i]->hname, "snd-1.h")) &&
+ (!local_strcmp(qs[i]->def, "snd-xen.c")) &&
+ ((local_strcmp(qs[i]->def, "snd-motif.c")) ||
(strncmp(qs[i]->def, "snd-g", 5) == 0)))
fprintf(FD, "\n (all within gui)\n");
diff --git a/tools/exs7.c b/tools/exs7.c
deleted file mode 100644
index eb8604a..0000000
--- a/tools/exs7.c
+++ /dev/null
@@ -1,561 +0,0 @@
-
-/* -------------------------------- examples --------------------------------
- *
- * a read-eval-print loop using S7:
- */
-
-#if EX1
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "s7.h"
-
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
-{ /* all added functions have this form, args is a list,
- * s7_car(args) is the 1st arg, etc
- */
- exit(1);
- return(s7_NIL(sc)); /* just to be pedantic */
-}
-
-int main(int argc, char **argv)
-{
- s7_scheme *s7;
- char buffer[512];
- char response[1024];
-
- s7 = s7_init(); /* initialize the interpreter */
-
- s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program");
-
- /* add the function "exit" to the interpreter.
- * 0, 0, false -> no required args,
- * no optional args,
- * no "rest" arg
- */
- while (1) /* fire up a "repl" */
- {
- fprintf(stdout, "\n> "); /* prompt for input */
- fgets(buffer, 512, stdin);
-
- if ((buffer[0] != '\n') ||
- (strlen(buffer) > 1))
- {
- sprintf(response, "(write %s)", buffer);
- s7_eval_c_string(s7, response); /* evaluate input and write the result */
- }
- }
-}
-
-/* make mus-config.h (it can be empty), then
- *
- * gcc -c s7.c -I.
- * gcc -o doc7 doc7.c s7.o -lm -I.
- *
- * run it:
- *
- * > (+ 1 2)
- * 3
- * > (define (add1 x) (+ 1 x))
- * add1
- * > (add1 2)
- * 3
- * > (exit)
- */
-
-#endif
-
-
-
-/* --------------------------------------------------------------------------------
- *
- * define a function with arguments and a returned value, and a variable
- */
-
-#if EX2
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "s7.h"
-
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
-{
- exit(1);
- return(s7_NIL(sc));
-}
-
-static s7_pointer add1(s7_scheme *sc, s7_pointer args)
-{
- if (s7_is_integer(s7_car(args)))
- return(s7_make_integer(sc, 1 + s7_integer(s7_car(args))));
- return(s7_wrong_type_arg_error(sc, "add1", 1, s7_car(args), "an integer"));
-}
-
-int main(int argc, char **argv)
-{
- s7_scheme *s7;
- char buffer[512];
- char response[1024];
-
- s7 = s7_init(); /* initialize the interpreter */
-
- s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program");
- s7_define_function(s7, "add1", add1, 1, 0, false, "(add1 int) adds 1 to int");
-
- s7_define_variable(s7, "my-pi", s7_make_real(s7, 3.14159265));
-
- while (1) /* fire up a "repl" */
- {
- fprintf(stdout, "\n> "); /* prompt for input */
- fgets(buffer, 512, stdin);
-
- if ((buffer[0] != '\n') ||
- (strlen(buffer) > 1))
- {
- sprintf(response, "(write %s)", buffer);
- s7_eval_c_string(s7, response); /* evaluate input and write the result */
- }
- }
-}
-
-/*
- * /home/bil/cl/ doc7
- * > my-pi
- * 3.14159265
- * > (+ 1 (add1 1))
- * 3
- * > (exit)
- */
-
-#endif
-
-
-
-/* --------------------------------------------------------------------------------
- *
- * call a scheme-defined function from C, and get/set scheme variable values in C:
- */
-
-#if EX3
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "s7.h"
-
-int main(int argc, char **argv)
-{
- s7_scheme *s7;
- s7 = s7_init();
-
- s7_define_variable(s7, "an-integer", s7_make_integer(s7, 1));
-
- s7_eval_c_string(s7, "(define (add1 a) (+ a 1))");
-
- fprintf(stderr, "an-integer: %d\n",
- s7_integer(s7_name_to_value(s7, "an-integer")));
-
- s7_symbol_set_value(s7, s7_make_symbol(s7, "an-integer"), s7_make_integer(s7, 32));
-
- fprintf(stderr, "now an-integer: %d\n",
- s7_integer(s7_name_to_value(s7, "an-integer")));
-
- fprintf(stderr, "(add1 2): %d\n",
- s7_integer(s7_call(s7,
- s7_name_to_value(s7, "add1"),
- s7_cons(s7, s7_make_integer(s7, 2), s7_NIL(s7)))));
-}
-
-/*
- * /home/bil/cl/ doc7
- * an-integer: 1
- * now an-integer: 32
- * (add1 2): 3
- */
-
-#endif
-
-
-/* --------------------------------------------------------------------------------
- *
- * here's an example using C++ and Juce that Rick sent me:
- */
-
-#if 0
-
-int main(int argc, const char* argv[])
-{
- initialiseJuce_NonGUI();
-
- s7_scheme *s7=s7_init();
- if (!s7)
- {
- std::cout << "Can't start S7!\n";
- return -1;
- }
-
- s7_pointer val;
- std::string str;
- while (true)
- {
- std::cout << "\ns7> ";
- std::getline(std::cin, str);
- val=s7_eval_c_string(s7, str.c_str());
- std::cout << s7_object_to_c_string(s7, val);
- }
-
- free(s7);
- std::cout << "Bye!\n";
- return 0;
-}
-
-#endif
-
-
-/* --------------------------------------------------------------------------------
- *
- * here's an example that loads sndlib using the XEN functions and macros into an s7 repl:
- */
-
-#if EX4
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <unistd.h>
-
-/* assume we've configured and built sndlib, so it has created a mus-config.h file */
-
-#include "mus-config.h"
-#include "s7.h"
-#include "xen.h"
-#include "clm.h"
-#include "clm2xen.h"
-
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
-{
- exit(1);
- return(s7_NIL(sc));
-}
-
-/* the next functions are needed for either with-sound or many standard instruments, like fm-violin */
-/* (these are in the xen-style FFI) */
-
-static XEN g_file_exists_p(XEN name)
-{
- #define H_file_exists_p "(file-exists? filename): #t if the file exists"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, "file-exists?", "a string");
- return(C_TO_XEN_BOOLEAN(mus_file_probe(XEN_TO_C_STRING(name))));
-}
-
-XEN_NARGIFY_1(g_file_exists_p_w, g_file_exists_p)
-
-static XEN g_delete_file(XEN name)
-{
- #define H_delete_file "(delete-file filename): deletes the file"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, "delete-file", "a string");
- return(C_TO_XEN_BOOLEAN(unlink(XEN_TO_C_STRING(name))));
-}
-
-XEN_NARGIFY_1(g_delete_file_w, g_delete_file)
-
-static XEN g_random(XEN val)
-{
- if (XEN_INTEGER_P(val))
- return(C_TO_XEN_INT(mus_irandom(XEN_TO_C_INT(val))));
- return(C_TO_XEN_DOUBLE(mus_frandom(XEN_TO_C_DOUBLE(val))));
-}
-
-XEN_NARGIFY_1(g_random_w, g_random)
-
-
-
-int main(int argc, char **argv)
-{
- char buffer[512];
- char response[1024];
-
-
- s7 = s7_init(); /* initialize the interpreter; s7 is declared in xen.h */
- xen_initialize(); /* initialize the xen stuff (hooks and the xen s7 FFI used by sndlib) */
- Init_sndlib(); /* initialize sndlib with all the functions linked into s7 */
-
- XEN_EVAL_C_STRING("(define load-from-path load)");
-
- XEN_DEFINE_PROCEDURE("file-exists?", g_file_exists_p_w, 1, 0, 0, H_file_exists_p);
- XEN_DEFINE_PROCEDURE("delete-file", g_delete_file_w, 1, 0, 0, H_delete_file);
- XEN_DEFINE_PROCEDURE("random", g_random_w, 1, 0, 0, "(random arg): random number between 0 and arg ");
- XEN_EVAL_C_STRING("(define (run-safety) 0)"); /* for the run macro and CLM */
- XEN_EVAL_C_STRING("(define (1+ x) (+ x 1))"); /* lots of the CLM instruments use this macro */
-
- s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program");
-
- while (1) /* fire up a "repl" */
- {
- fprintf(stdout, "\n> "); /* prompt for input */
- fgets(buffer, 512, stdin);
-
- if ((buffer[0] != '\n') ||
- (strlen(buffer) > 1))
- {
- sprintf(response, "(write %s)", buffer);
- s7_eval_c_string(s7, response); /* evaluate input and write the result */
- }
- }
-}
-
-/* gcc -o doc7 doc7.c -lm -I. /home/bil/test/sndlib/sndlib.a -lgsl -lgslcblas
- *
- * gsl and gslcblas are the Gnu Scientific Library that the configure script found -- those
- * may not be necessary on other systems
- *
- * run a CLM instrument:
- *
- * (load "sndlib-ws.scm")
- * (with-sound () (outa 10 .1))
- * (load "v.scm")
- * (with-sound () (fm-violin 0 .1 440 .1))
- */
-
-#endif
-
-
-/* --------------------------------------------------------------------------------
- *
- * an example of adding a new type and procedure-with-setters:
- */
-
-#if EX5
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "s7.h"
-
-static s7_pointer our_exit(s7_scheme *sc, s7_pointer args)
-{
- exit(1);
- return(s7_NIL(sc));
-}
-
-
-/* define *listener-prompt* in scheme, add two accessors for C get/set */
-
-static const char *listener_prompt(s7_scheme *sc)
-{
- return(s7_string(s7_name_to_value(sc, "*listener-prompt*")));
-}
-
-static void set_listener_prompt(s7_scheme *sc, const char *new_prompt)
-{
- s7_symbol_set_value(sc, s7_make_symbol(sc, "*listener-prompt*"), s7_make_string(sc, new_prompt));
-}
-
-
-/* now add a new type, a struct named "dax" with two fields, a real "x" and a list "data" */
-/* since the data field is an s7 object, we'll need to mark it to protect it from the GC */
-
-typedef struct {
- s7_Double x;
- s7_pointer data;
-} dax;
-
-static char *print_dax(s7_scheme *sc, void *val)
-{
- char *data_str, *str;
- int data_str_len;
- dax *o = (dax *)val;
- data_str = s7_object_to_c_string(sc, o->data);
- data_str_len = strlen(data_str);
- str = (char *)calloc(data_str_len + 32, sizeof(char));
- snprintf(str, data_str_len + 32, "#<dax %.3f %s>", o->x, data_str);
- free(data_str);
- return(str);
-}
-
-static void free_dax(void *val)
-{
- if (val) free(val);
-}
-
-static bool equal_dax(void *val1, void *val2)
-{
- return(val1 == val2);
-}
-
-static void mark_dax(void *val)
-{
- dax *o = (dax *)val;
- if (o)
- s7_mark_object(o->data);
-}
-
-static int dax_type_tag = 0;
-
-static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
-{
- dax *o;
- o = (dax *)malloc(sizeof(dax));
- o->x = s7_real(s7_car(args));
- if (s7_cdr(args) != s7_NIL(sc))
- o->data = s7_car(s7_cdr(args));
- else o->data = s7_NIL(sc);
- return(s7_make_object(sc, dax_type_tag, (void *)o));
-}
-
-static s7_pointer is_dax(s7_scheme *sc, s7_pointer args)
-{
- return(s7_make_boolean(sc,
- s7_is_object(s7_car(args)) &&
- s7_object_type(s7_car(args)) == dax_type_tag));
-}
-
-static s7_pointer dax_x(s7_scheme *sc, s7_pointer args)
-{
- dax *o;
- o = (dax *)s7_object_value(s7_car(args));
- return(s7_make_real(sc, o->x));
-}
-
-static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
-{
- dax *o;
- o = (dax *)s7_object_value(s7_car(args));
- o->x = s7_real(s7_car(s7_cdr(args)));
- return(s7_car(s7_cdr(args)));
-}
-
-static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
-{
- dax *o;
- o = (dax *)s7_object_value(s7_car(args));
- return(o->data);
-}
-
-static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
-{
- dax *o;
- o = (dax *)s7_object_value(s7_car(args));
- o->data = s7_car(s7_cdr(args));
- return(o->data);
-}
-
-
-int main(int argc, char **argv)
-{
- s7_scheme *s7;
- char buffer[512];
- char response[1024];
-
- s7 = s7_init();
-
- s7_define_function(s7, "exit", our_exit, 0, 0, false, "(exit) exits the program");
- s7_define_variable(s7, "*listener-prompt*", s7_make_string(s7, ">"));
-
- dax_type_tag = s7_new_type("dax", print_dax, free_dax, equal_dax, mark_dax, NULL, NULL);
- s7_define_function(s7, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
- s7_define_function(s7, "dax?", is_dax, 1, 0, false, "(dax? anything) returns #t if its argument is a dax object");
-
- s7_define_variable(s7, "dax-x",
- s7_make_procedure_with_setter(s7, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field"));
-
- s7_define_variable(s7, "dax-data",
- s7_make_procedure_with_setter(s7, "dax-data", dax_data, 1, 0, set_dax_data, 2, 0, "dax data field"));
-
- while (1)
- {
- fprintf(stdout, "\n%s ", listener_prompt(s7));
- fgets(buffer, 512, stdin);
-
- if ((buffer[0] != '\n') ||
- (strlen(buffer) > 1))
- {
- sprintf(response, "(write %s)", buffer);
- s7_eval_c_string(s7, response); /* evaluate input and write the result */
- }
- }
-}
-
-/*
- * gcc -o doc7 doc7.c s7.o -lm
- * > *listener-prompt*
- * ">"
- * > (set! *listener-prompt* ":")
- * ":"
- * : (define obj (make-dax 1.0 (list 1 2 3)))
- * obj
- * : obj
- * #<dax 1.000 (1 2 3)>
- * : (dax-x obj)
- * 1.0
- * : (dax-data obj)
- * (1 2 3)
- * : (set! (dax-x obj) 123.0)
- * 123.0
- * : obj
- * #<dax 123.000 (1 2 3)>
- * : (dax? obj)
- * #t
- * : (exit)
- */
-#endif
-
-
-
-/* --------------------------------------------------------------------------------
- *
- * call scheme with catch from C (debugging...)
- */
-
-#if EX6
-
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
-#include "s7.h"
-
-int main(int argc, char **argv)
-{
- s7_scheme *s7;
- s7_pointer call_no_error, call_with_error;
-
- s7 = s7_init();
-
- s7_eval_c_string(s7, "\
-(define callback-no-error \
- (lambda (x) \
- (catch #t \
- (lambda () (display \"Hiho!\") -1) \
- (lambda args -2))))\
-\
-(define callback-with-error \
- (lambda (x) \
- (catch #t \
- (lambda () (display \"Hiho!\") (set! foo bar) -1) \
- (lambda args -2))))");
-
- call_no_error = s7_name_to_value(s7, "callback-no-error");
- call_with_error = s7_name_to_value(s7, "callback-with-error");
-
- fprintf(stderr, "%f %f\n",
- s7_number_to_real(s7_call(s7,
- call_no_error,
- s7_cons(s7,
- s7_make_real(s7, 1.0),
- s7_NIL(s7)))),
- s7_number_to_real(s7_call(s7,
- call_with_error,
- s7_cons(s7,
- s7_make_real(s7, 1.0),
- s7_NIL(s7)))));
-}
-
-#endif
diff --git a/tools/ffitest.c b/tools/ffitest.c
new file mode 100644
index 0000000..09b3442
--- /dev/null
+++ b/tools/ffitest.c
@@ -0,0 +1,1509 @@
+/* s7 ffi tester
+ *
+ * gcc -o ffitest ffitest.c -g3 -Wall s7.o -lm -I. -ldl
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdarg.h>
+
+#include "s7.h"
+
+#define TO_STR(x) s7_object_to_c_string(sc, x)
+#define TO_S7_INT(x) s7_make_integer(sc, x)
+
+static s7_pointer a_function(s7_scheme *sc, s7_pointer args)
+{
+ return(s7_car(args));
+}
+
+static s7_pointer test_hook_function(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer val;
+ val = s7_symbol_local_value(sc, s7_make_symbol(sc, "a"), s7_car(args));
+ if ((!s7_is_integer(val)) ||
+ (s7_integer(val) != 1))
+ {
+ char *s1;
+ s1 = TO_STR(val);
+ fprintf(stderr, "%d: (hook 'a) is %s\n", __LINE__, s1);
+ free(s1);
+ }
+ return(val);
+}
+
+static char last_c;
+static void my_print(s7_scheme *sc, unsigned char c, s7_pointer port)
+{
+ last_c = c;
+}
+
+static s7_pointer my_read(s7_scheme *sc, s7_read_t peek, s7_pointer port)
+{
+ return(s7_make_character(sc, '0'));
+}
+
+
+static bool tested_begin_hook = false;
+static void test_begin_hook(s7_scheme *sc, bool *val)
+{
+ tested_begin_hook = true;
+}
+
+static s7_pointer test_error_handler(s7_scheme *sc, s7_pointer args)
+{
+ s7_display(sc, s7_make_symbol(sc, "error!"), s7_current_error_port(sc));
+ return(s7_f(sc));
+}
+
+static s7_pointer set_sym, set_val;
+static s7_pointer scheme_set_notification(s7_scheme *sc, s7_pointer args)
+{
+ set_sym = s7_car(args);
+ set_val = s7_cadr(args);
+ return(set_val);
+}
+
+
+typedef struct {
+ s7_double x;
+ s7_pointer data;
+} dax;
+
+static char *print_dax(s7_scheme *sc, void *val)
+{
+ char *data_str, *str;
+ int data_str_len;
+ dax *o = (dax *)val;
+ data_str = s7_object_to_c_string(sc, o->data);
+ data_str_len = strlen(data_str);
+ str = (char *)calloc(data_str_len + 32, sizeof(char));
+ snprintf(str, data_str_len + 32, "#<dax %.3f %s>", o->x, data_str);
+ free(data_str);
+ return(str);
+}
+
+static void free_dax(void *val)
+{
+ if (val) free(val);
+}
+
+static bool equal_dax(void *val1, void *val2)
+{
+ return(val1 == val2);
+}
+
+static void mark_dax(void *val)
+{
+ dax *o = (dax *)val;
+ if (o) s7_mark_object(o->data);
+}
+
+static int dax_type_tag = 0;
+
+static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
+{
+ dax *o;
+ o = (dax *)malloc(sizeof(dax));
+ o->x = s7_real(s7_car(args));
+ if (s7_cdr(args) != s7_nil(sc))
+ o->data = s7_car(s7_cdr(args));
+ else o->data = s7_nil(sc);
+ return(s7_make_object(sc, dax_type_tag, (void *)o));
+}
+
+static s7_pointer is_dax(s7_scheme *sc, s7_pointer args)
+{
+ return(s7_make_boolean(sc,
+ s7_is_object(s7_car(args)) &&
+ s7_object_type(s7_car(args)) == dax_type_tag));
+}
+
+static s7_pointer dax_x(s7_scheme *sc, s7_pointer args)
+{
+ dax *o;
+ o = (dax *)s7_object_value(s7_car(args));
+ return(s7_make_real(sc, o->x));
+}
+
+static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
+{
+ dax *o;
+ o = (dax *)s7_object_value(s7_car(args));
+ o->x = s7_real(s7_car(s7_cdr(args)));
+ return(s7_car(s7_cdr(args)));
+}
+
+static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
+{
+ dax *o;
+ o = (dax *)s7_object_value(s7_car(args));
+ return(o->data);
+}
+
+static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
+{
+ dax *o;
+ o = (dax *)s7_object_value(s7_car(args));
+ o->data = s7_car(s7_cdr(args));
+ return(o->data);
+}
+
+static s7_pointer plus(s7_scheme *sc, s7_pointer args)
+{
+ /* (define* (plus (red 32) blue) (+ (* 2 red) blue)) */
+ return(TO_S7_INT(2 * s7_integer(s7_car(args)) + s7_integer(s7_car(s7_cdr(args)))));
+}
+
+static s7_pointer mac_plus(s7_scheme *sc, s7_pointer args)
+{
+ /* (define-macro (plus a b) `(+ ,a ,b)) */
+ s7_pointer a, b;
+ a = s7_car(args);
+ b = s7_cadr(args);
+ return(s7_list(sc, 3, s7_make_symbol(sc, "+"), a, b));
+}
+
+static s7_pointer mac_plus_mv(s7_scheme *sc, s7_pointer args)
+{
+ /* (define-macro (plus-mv a b) (values `(define a ,a) `(define b ,b))) */
+ return(s7_values(sc, args));
+}
+
+static s7_pointer open_plus(s7_scheme *sc, s7_pointer args)
+{
+ #define plus_help "(plus obj ...) applies obj's plus method to obj and any trailing arguments."
+ s7_pointer obj, method;
+ obj = s7_car(args);
+ if (s7_is_openlet(obj))
+ {
+ method = s7_method(sc, obj, s7_make_symbol(sc, "plus"));
+ if (s7_is_procedure(method))
+ return(s7_apply_function(sc, method, s7_cdr(args)));
+ }
+ return(s7_f(sc));
+}
+
+static s7_pointer multivector_ref(s7_scheme *sc, s7_pointer vector, int indices, ...)
+{
+ /* multivector_ref returns an element of a multidimensional vector */
+ int ndims;
+ ndims = s7_vector_rank(vector);
+
+ if (ndims == indices)
+ {
+ va_list ap;
+ s7_int index = 0;
+ va_start(ap, indices);
+
+ if (ndims == 1)
+ {
+ index = va_arg(ap, s7_int);
+ va_end(ap);
+ return(s7_vector_ref(sc, vector, index));
+ }
+ else
+ {
+ int i;
+ s7_pointer *elements;
+ s7_int *offsets, *dimensions;
+
+ elements = s7_vector_elements(vector);
+ dimensions = s7_vector_dimensions(vector);
+ offsets = s7_vector_offsets(vector);
+
+ for (i = 0; i < indices; i++)
+ {
+ int ind;
+ ind = va_arg(ap, int);
+ if ((ind < 0) ||
+ (ind >= dimensions[i]))
+ {
+ va_end(ap);
+ return(s7_out_of_range_error(sc,
+ "multivector_ref", i,
+ s7_make_integer(sc, ind),
+ "index should be between 0 and the dimension size"));
+ }
+ index += (ind * offsets[i]);
+ }
+ va_end(ap);
+ return(elements[index]);
+ }
+ }
+ return(s7_wrong_number_of_args_error(sc,
+ "multivector_ref: wrong number of indices: ~A",
+ s7_make_integer(sc, indices)));
+}
+
+
+typedef struct {
+ size_t size;
+ double *data;
+} g_block;
+
+static int g_block_type = 0;
+static s7_pointer g_block_methods;
+
+static s7_pointer g_make_block(s7_scheme *sc, s7_pointer args)
+{
+ #define g_make_block_help "(make-block size) returns a new block of the given size"
+ g_block *g;
+ s7_pointer new_g;
+ g = (g_block *)calloc(1, sizeof(g_block));
+ g->size = (size_t)s7_integer(s7_car(args));
+ g->data = (double *)calloc(g->size, sizeof(double));
+ new_g = s7_make_object(sc, g_block_type, (void *)g);
+ s7_object_set_let(new_g, g_block_methods);
+ s7_openlet(sc, new_g);
+ return(new_g);
+}
+
+static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args)
+{
+ #define g_block_help "(block ...) returns a block object with the arguments as its contents."
+ s7_pointer p, b;
+ size_t i, len;
+ g_block *gb;
+ len = s7_list_length(sc, args);
+ b = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
+ gb = (g_block *)s7_object_value(b);
+ for (i = 0, p = args; i < len; i++, p = s7_cdr(p))
+ gb->data[i] = s7_number_to_real(sc, s7_car(p));
+ return(b);
+}
+
+static char *g_block_display(s7_scheme *sc, void *value)
+{
+ return(strdup("#<block>"));
+}
+
+static void g_block_free(void *value)
+{
+ g_block *g = (g_block *)value;
+ free(g->data);
+ free(g);
+}
+
+static bool g_block_is_equal(void *val1, void *val2)
+{
+ return(val1 == val2);
+}
+
+static void g_block_mark(void *val)
+{
+ /* nothing to mark */
+}
+
+static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ g_block *g = (g_block *)s7_object_value(obj);
+ size_t index;
+ index = (size_t)s7_integer(s7_car(args));
+ if (index < g->size)
+ return(s7_make_real(sc, g->data[index]));
+ return(s7_out_of_range_error(sc, "block-ref", 2, s7_car(args), "should be less than block length"));
+}
+
+static s7_pointer g_block_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
+{
+ g_block *g = (g_block *)s7_object_value(obj);
+ s7_int index;
+ index = s7_integer(s7_car(args));
+ if ((index >= 0) && (index < g->size))
+ {
+ g->data[index] = s7_number_to_real(sc, s7_cadr(args));
+ return(s7_cadr(args));
+ }
+ return(s7_out_of_range_error(sc, "block-set", 2, s7_car(args), "should be less than block length"));
+}
+
+static s7_pointer g_block_length(s7_scheme *sc, s7_pointer obj)
+{
+ g_block *g = (g_block *)s7_object_value(obj);
+ return(s7_make_integer(sc, g->size));
+}
+
+static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer obj, new_g;
+ g_block *g, *g1;
+ obj = s7_car(args);
+ g = (g_block *)s7_object_value(obj);
+ new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
+ g1 = (g_block *)s7_object_value(new_g);
+ memcpy((void *)(g1->data), (void *)(g->data), g->size * sizeof(double));
+ return(new_g);
+}
+
+static s7_pointer g_block_reverse(s7_scheme *sc, s7_pointer obj)
+{
+ size_t i, j;
+ g_block *g = (g_block *)s7_object_value(obj);
+ g_block *g1;
+ s7_pointer new_g;
+ new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
+ g1 = (g_block *)s7_object_value(new_g);
+ for (i = 0, j = g->size - 1; i < g->size; i++, j--)
+ g1->data[i] = g->data[j];
+ return(new_g);
+}
+
+static s7_pointer g_block_fill(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer obj;
+ size_t i;
+ double fill_val;
+ g_block *g;
+ obj = s7_car(args);
+ g = (g_block *)s7_object_value(obj);
+ fill_val = s7_number_to_real(sc, s7_cadr(args));
+ for (i = 0; i < g->size; i++)
+ g->data[i] = fill_val;
+ return(obj);
+}
+
+
+int main(int argc, char **argv)
+{
+ s7_scheme *sc;
+ s7_pointer p, p1;
+ int i, gc_loc;
+ char *s1, *s2;
+
+ sc = s7_init();
+
+ /* try each straight (no errors) case */
+
+ if (!s7_is_null(sc, s7_nil(sc)))
+ {fprintf(stderr, "%d: %s is not null?\n", __LINE__, s1 = TO_STR(s7_nil(sc))); free(s1);}
+
+ if (s7_is_pair(s7_nil(sc)))
+ {fprintf(stderr, "%d: %s is a pair?\n", __LINE__, s1 = TO_STR(s7_nil(sc))); free(s1);}
+
+ if (!s7_is_boolean(s7_t(sc)))
+ {fprintf(stderr, "%d: %s is not boolean?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+ if (!s7_is_boolean(s7_f(sc)))
+ {fprintf(stderr, "%d: %s is not boolean?\n", __LINE__, s1 = TO_STR(s7_f(sc))); free(s1);}
+
+ if (s7_boolean(sc, s7_f(sc)))
+ {fprintf(stderr, "%d: %s is #t?\n", __LINE__, s1 = TO_STR(s7_f(sc))); free(s1);}
+
+ if (!s7_boolean(sc, s7_t(sc)))
+ {fprintf(stderr, "%d: %s is #f?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+ p = s7_make_boolean(sc, true);
+ if (p != s7_t(sc))
+ {fprintf(stderr, "%d: %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_make_boolean(sc, false);
+ if (p != s7_f(sc))
+ {fprintf(stderr, "%d: %s is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_eq(s7_f(sc), s7_f(sc)))
+ {fprintf(stderr, "%d: (eq? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+ if (!s7_is_eqv(s7_f(sc), s7_f(sc)))
+ {fprintf(stderr, "%d: (eqv? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+ if (!s7_is_equal(sc, s7_f(sc), s7_f(sc)))
+ {fprintf(stderr, "%d: (equal? %s %s) -> #f?\n", __LINE__, s1 = TO_STR(s7_f(sc)), s2 = TO_STR(s7_f(sc))); free(s1); free(s2);}
+
+ if (!s7_is_unspecified(sc, s7_unspecified(sc)))
+ {fprintf(stderr, "%d: %s is not #<unspecified>?\n", __LINE__, s1 = TO_STR(s7_unspecified(sc))); free(s1);}
+
+ if (s7_is_eq(s7_eof_object(sc), s7_undefined(sc)))
+ {fprintf(stderr, "%d: (eq? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+ if (s7_is_eqv(s7_eof_object(sc), s7_undefined(sc)))
+ {fprintf(stderr, "%d: (eqv? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+ if (s7_is_equal(sc, s7_eof_object(sc), s7_undefined(sc)))
+ {fprintf(stderr, "%d: (equal? %s %s) -> #t?\n", __LINE__, s1 = TO_STR(s7_eof_object(sc)), s2 = TO_STR(s7_undefined(sc))); free(s1); free(s2);}
+
+ if (!s7_is_valid(sc, s7_t(sc)))
+ {fprintf(stderr, "%d: %s is not valid?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+ if (s7_is_c_pointer(s7_t(sc)))
+ {fprintf(stderr, "%d: %s is a raw c pointer?\n", __LINE__, s1 = TO_STR(s7_t(sc))); free(s1);}
+
+ i = 32;
+ p = s7_make_c_pointer(sc, (void *)(&i));
+ if (!s7_is_c_pointer(p))
+ {fprintf(stderr, "%d: %s is not a raw c pointer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ i = (*((int *)s7_c_pointer(p)));
+ if (i != 32)
+ fprintf(stderr, "%d: 32 -> %d via raw c pointer?\n", __LINE__, i);
+
+ s7_provide(sc, "ffitest");
+ if (!s7_is_provided(sc, "ffitest"))
+ {fprintf(stderr, "%d: *features* %s doesn't provide 'ffitest?\n", __LINE__, s1 = TO_STR(s7_name_to_value(sc, "*features*"))); free(s1);}
+
+ p = s7_cons(sc, s7_f(sc), s7_t(sc));
+ gc_loc = s7_gc_protect(sc, p);
+ if (p != s7_gc_protected_at(sc, gc_loc))
+ {fprintf(stderr, "%d: %s is not gc protected at %d: %s?\n", __LINE__, s1 = TO_STR(p), gc_loc, s2 = TO_STR(s7_gc_protected_at(sc, gc_loc))); free(s1); free(s2);}
+
+ if (s7_car(p) != s7_f(sc))
+ {fprintf(stderr, "%d: (car %s) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_cdr(p) != s7_t(sc))
+ {fprintf(stderr, "%d: (cdr %s) is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_pair(p))
+ {fprintf(stderr, "%d: %s is not a pair?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_set_car(p, s7_eof_object(sc));
+ if (s7_car(p) != s7_eof_object(sc))
+ {fprintf(stderr, "%d: (car %s) is not #<eof>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_set_cdr(p, s7_unspecified(sc));
+ if (s7_cdr(p) != s7_unspecified(sc))
+ {fprintf(stderr, "%d: (cdr %s) is not #<unspecified>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+
+ p = TO_S7_INT(123);
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_integer(p))
+ {fprintf(stderr, "%d: %s is not integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_rational(p))
+ {fprintf(stderr, "%d: %s is not rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_is_ratio(p))
+ {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_real(p))
+ {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_complex(p))
+ {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_number(p))
+ {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p) != 123)
+ {fprintf(stderr, "%d: %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s2 = s7_number_to_string(sc, p, 10);
+ if (strcmp(s2, "123") != 0)
+ {fprintf(stderr, "%d: (number->string %s) is not \"123\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ free(s2);
+
+ if (s7_number_to_integer(sc, p) != 123)
+ {fprintf(stderr, "%d: s7_number_to_integer %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_make_ratio(sc, 123, 5);
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (s7_is_integer(p))
+ {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_rational(p))
+ {fprintf(stderr, "%d: %s is not rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_ratio(p))
+ {fprintf(stderr, "%d: %s is not a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_real(p))
+ {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_complex(p))
+ {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_number(p))
+ {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_numerator(p) != 123)
+ {fprintf(stderr, "%d: (numerator %s) is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_denominator(p) != 5)
+ {fprintf(stderr, "%d: (denominator %s) is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s2 = s7_number_to_string(sc, p, 10);
+ if (strcmp(s2, "123/5") != 0)
+ {fprintf(stderr, "%d: (number->string %s) is not \"123/5\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ free(s2);
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_make_real(sc, 1.5);
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (s7_is_integer(p))
+ {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_is_rational(p))
+ {fprintf(stderr, "%d: %s is rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_is_ratio(p))
+ {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_real(p))
+ {fprintf(stderr, "%d: %s is not real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_complex(p))
+ {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_number(p))
+ {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_real(p) != 1.5)
+ {fprintf(stderr, "%d: %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s2 = s7_number_to_string(sc, p, 10);
+ if (strcmp(s2, "1.5") != 0)
+ {fprintf(stderr, "%d: (number->string %s) is not \"1.5\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ free(s2);
+
+ if (s7_number_to_real(sc, p) != 1.5)
+ {fprintf(stderr, "%d: s7_number_to_real %s is not 1.5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_make_complex(sc, 1.0, 1.0);
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (s7_is_integer(p))
+ {fprintf(stderr, "%d: %s is integral?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_is_rational(p))
+ {fprintf(stderr, "%d: %s is rational?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_is_ratio(p))
+ {fprintf(stderr, "%d: %s is a ratio?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_is_real(p))
+ {fprintf(stderr, "%d: %s is real?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_complex(p))
+ {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_number(p))
+ {fprintf(stderr, "%d: %s is not complex?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_real_part(p) != 1.0)
+ {fprintf(stderr, "%d: (real-part %s) is not 1.0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_imag_part(p) != 1.0)
+ {fprintf(stderr, "%d: (imag-part %s) is not 1.0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s2 = s7_number_to_string(sc, p, 10);
+ if (strcmp(s2, "1+1i") != 0)
+ {fprintf(stderr, "%d: (number->string %s) is not \"1+1i\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ free(s2);
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_rationalize(sc, 1.5, 1e-12);
+ gc_loc = s7_gc_protect(sc, p);
+ s1 = TO_STR(p);
+ if (strcmp(s1, "3/2") != 0)
+ fprintf(stderr, "%d: ratio is %s?\n", __LINE__, s1);
+ free(s1);
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_make_vector(sc, 12);
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_vector(p))
+ {fprintf(stderr, "%d: %s is not a vector?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_vector_rank(p) != 1)
+ {fprintf(stderr, "%d: (dimensions %s) is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_vector_set(sc, p, 1, s7_t(sc));
+ if (s7_vector_ref(sc, p, 1) != s7_t(sc))
+ {fprintf(stderr, "%d: (%s 1) is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_vector_fill(sc, p, TO_S7_INT(123));
+ if (s7_integer(s7_vector_ref(sc, p, 1)) != 123)
+ {fprintf(stderr, "%d: (%s 1) is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ p = s7_make_and_fill_vector(sc, 3, TO_S7_INT(3));
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (s7_integer(s7_vector_ref(sc, p, 1)) != 3)
+ {fprintf(stderr, "%d: (%s 1) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p1 = s7_vector_copy(sc, p);
+ if ((p == p1) ||
+ (!s7_is_vector(p1)))
+ {fprintf(stderr, "%d: copied vector: %s\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_make_string(sc, "1234");
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_string(p))
+ {fprintf(stderr, "%d: %s is not a string?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_string_length(p) != 4)
+ {fprintf(stderr, "%d: (length %s) is 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (strcmp(s7_string(p), "1234") != 0)
+ {fprintf(stderr, "%d: %s is \"1234\"?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_make_character(sc, 65);
+ if (!s7_is_character(p))
+ {fprintf(stderr, "%d: %s is not a character?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_character(p) != 'A')
+ {fprintf(stderr, "%d: %s is not #\\A?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+ p = s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3));
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_list(sc, p))
+ {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_list_length(sc, p) != 3)
+ {fprintf(stderr, "%d: (length %s) is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(s7_list_ref(sc, p, 1)) != 2)
+ {fprintf(stderr, "%d: (%s 1) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(s7_car(p)) != 1)
+ {fprintf(stderr, "%d: (car %s) is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(s7_cadr(p)) != 2)
+ {fprintf(stderr, "%d: (cadr %s) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(s7_caddr(p)) != 3)
+ {fprintf(stderr, "%d: (caddr %s) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(s7_car(s7_cddr(p))) != 3)
+ {fprintf(stderr, "%d: (car (cddr %s)) is not 2?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_list_set(sc, p, 1, s7_f(sc));
+ if (s7_list_ref(sc, p, 1) != s7_f(sc))
+ {fprintf(stderr, "%d: (%s 1) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ {
+ s7_pointer c1, c2, c3, c12, c23, c123, c1234, c1d2, c2d3, c3d4, c12d3, c23d4, c123d4, c1234d5;
+ s7_gc_on(sc, false);
+ c1 = s7_list(sc, 1, TO_S7_INT(1)); /* (1) */
+ c2 = s7_list(sc, 1, TO_S7_INT(2)); /* (2) */
+ c3 = s7_list(sc, 1, TO_S7_INT(3)); /* (3) */
+ c12 = s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2)); /* (1 2) */
+ c23 = s7_list(sc, 2, TO_S7_INT(2), TO_S7_INT(3)); /* (2 3) */
+ c123 = s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3)); /* (1 2 3) */
+ c1234 = s7_list(sc, 4, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3), TO_S7_INT(4)); /* (1 2 3 4) */
+ c1d2 = s7_cons(sc, TO_S7_INT(1), TO_S7_INT(2)); /* (1 . 2) */
+ c2d3 = s7_cons(sc, TO_S7_INT(2), TO_S7_INT(3)); /* (2 . 3) */
+ c3d4 = s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4)); /* (3 . 4) */
+ c12d3 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), TO_S7_INT(3))); /* (1 2 . 3) */
+ c23d4 = s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4))); /* (2 3 . 4) */
+ c123d4 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), TO_S7_INT(4)))); /* (1 2 3 . 4) */
+ c1234d5 = s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_cons(sc, TO_S7_INT(3), s7_cons(sc, TO_S7_INT(4), TO_S7_INT(5))))); /* (1 2 3 4 . 5) */
+
+ if (s7_integer(p = s7_caar(s7_list(sc, 1, c1))) != 1)
+ {fprintf(stderr, "%d: caar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cadr(c12)) != 2)
+ {fprintf(stderr, "%d: cadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdar(s7_list(sc, 1, c1d2))) != 2)
+ {fprintf(stderr, "%d: cdar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cddr(c12d3)) != 3)
+ {fprintf(stderr, "%d: cddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_caaar(s7_list(sc, 1, s7_list(sc, 1, c1)))) != 1)
+ {fprintf(stderr, "%d: caaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_caadr(s7_list(sc, 2, TO_S7_INT(1), c2))) != 2)
+ {fprintf(stderr, "%d: caadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cadar(s7_list(sc, 1, c12))) != 2)
+ {fprintf(stderr, "%d: cadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdaar(s7_list(sc, 1, s7_list(sc, 1, c1d2)))) != 2)
+ {fprintf(stderr, "%d: cdaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_caddr(c123)) != 3)
+ {fprintf(stderr, "%d: caddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdddr(c123d4)) != 4)
+ {fprintf(stderr, "%d: cdddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdadr(s7_list(sc, 2, TO_S7_INT(1), c2d3))) != 3)
+ {fprintf(stderr, "%d: cdadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cddar(s7_list(sc, 1, c12d3))) != 3)
+ {fprintf(stderr, "%d: cddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_caaaar(s7_list(sc, 1, s7_list(sc, 1, s7_list(sc, 1, c1))))) != 1)
+ {fprintf(stderr, "%d: caaaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_caaadr(s7_list(sc, 2, TO_S7_INT(1), s7_list(sc, 1, c2)))) != 2)
+ {fprintf(stderr, "%d: caaadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_caadar(s7_list(sc, 1, s7_list(sc, 2, TO_S7_INT(1), c2)))) != 2)
+ {fprintf(stderr, "%d: caadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cadaar(s7_list(sc, 1, s7_list(sc, 1, c12)))) != 2)
+ {fprintf(stderr, "%d: cadaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_caaddr(s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), c3))) != 3)
+ {fprintf(stderr, "%d: caaddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cadddr(c1234)) != 4)
+ {fprintf(stderr, "%d: cadddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cadadr(s7_list(sc, 2, TO_S7_INT(1), c23))) != 3)
+ {fprintf(stderr, "%d: cadadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_caddar(s7_list(sc, 1, c123))) != 3)
+ {fprintf(stderr, "%d: caddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdaaar(s7_list(sc, 1, s7_list(sc, 1, s7_list(sc, 1, c1d2))))) != 2)
+ {fprintf(stderr, "%d: cdaaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdaadr(s7_list(sc, 2, TO_S7_INT(1), s7_list(sc, 1, c2d3)))) != 3)
+ {fprintf(stderr, "%d: cdaadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdadar(s7_list(sc, 1, s7_list(sc, 2, TO_S7_INT(1), c2d3)))) != 3)
+ {fprintf(stderr, "%d: cdadar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cddaar(s7_list(sc, 1, s7_list(sc, 1, c12d3)))) != 3)
+ {fprintf(stderr, "%d: cddaar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdaddr(s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), c3d4))) != 4)
+ {fprintf(stderr, "%d: cdaddr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cddddr(c1234d5)) != 5)
+ {fprintf(stderr, "%d: cdddd is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cddadr(s7_list(sc, 2, TO_S7_INT(1), c23d4))) != 4)
+ {fprintf(stderr, "%d: cddadr is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p = s7_cdddar(s7_list(sc, 1, c123d4))) != 4)
+ {fprintf(stderr, "%d: cdddar is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_reverse(sc, c123);
+ s1 = TO_STR(p);
+ if (strcmp(s1, "(3 2 1)") != 0)
+ {fprintf(stderr, "%d: (reverse '(1 2 3)) is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ p = s7_append(sc, c1, c2);
+ s1 = TO_STR(p);
+ if (strcmp(s1, "(1 2)") != 0)
+ {fprintf(stderr, "%d: (append '(1) '(2)) is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ p = s7_list(sc, 2, s7_cons(sc, s7_make_symbol(sc, "a"), TO_S7_INT(32)), s7_cons(sc, s7_make_symbol(sc, "b"), TO_S7_INT(1)));
+ p1 = s7_assq(sc, s7_make_symbol(sc, "a"), p);
+ s1 = TO_STR(p1);
+ if (strcmp(s1, "(a . 32)") != 0)
+ {fprintf(stderr, "%d: (assq 'a '((a . 32) (b . 1)))) is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ p1 = s7_assoc(sc, s7_make_symbol(sc, "b"), p);
+ s1 = TO_STR(p1);
+ if (strcmp(s1, "(b . 1)") != 0)
+ {fprintf(stderr, "%d: (assoc 'b '((a . 32) (b . 1))) is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ p = s7_member(sc, TO_S7_INT(2), c1234);
+ s1 = TO_STR(p);
+ if (strcmp(s1, "(2 3 4)") != 0)
+ {fprintf(stderr, "%d: (member 2 '(1 2 3 4)) is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ p = s7_list(sc, 2, s7_make_symbol(sc, "a"), s7_make_symbol(sc, "b"));
+ p1 = s7_memq(sc, s7_make_symbol(sc, "b"), p);
+ s1 = TO_STR(p1);
+ if (strcmp(s1, "(b)") != 0)
+ {fprintf(stderr, "%d: (memq 'b '(a b)) is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ s7_set_car(c1234, s7_make_symbol(sc, "+"));
+ p = s7_eval(sc, s7_list(sc, 2, s7_make_symbol(sc, "quote"), c1234), s7_sublet(sc, s7_rootlet(sc), s7_nil(sc)));
+ if (s7_integer(p) != 9)
+ {fprintf(stderr, "%d: (eval '(+ 2 3 4)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ p = s7_eval_form(sc, c1234, s7_sublet(sc, s7_rootlet(sc), s7_nil(sc)));
+ if (s7_integer(p) != 9)
+ {fprintf(stderr, "%d: (eval(form) '(+ 2 3 4)) is %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_gc_on(sc, true);
+ }
+
+
+ p = s7_make_ulong(sc, 123);
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_ulong(p))
+ {fprintf(stderr, "%d: %s is not a ulong?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_ulong(p) != (unsigned long)123)
+ {fprintf(stderr, "%d: %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_make_ulong_long(sc, 123);
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_ulong_long(p))
+ {fprintf(stderr, "%d: %s is not a ulong_long?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_ulong_long(p) != (unsigned long long)123)
+ {fprintf(stderr, "%d: %s is not 123?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ p = s7_make_hash_table(sc, 255);
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_hash_table(p))
+ {fprintf(stderr, "%d: %s is not a hash-table?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_hash_table_ref(sc, p, s7_eof_object(sc)) != s7_f(sc))
+ {fprintf(stderr, "%d: (hash-table-ref %s #<eof>) is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_hash_table_set(sc, p, s7_eof_object(sc), s7_unspecified(sc));
+ if (s7_hash_table_ref(sc, p, s7_eof_object(sc)) != s7_unspecified(sc))
+ {fprintf(stderr, "%d: (hash-table-ref %s #<eof>) is not #<unspecified>?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ p = s7_current_input_port(sc);
+ if (!s7_is_input_port(sc, p))
+ {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_current_output_port(sc);
+ if (!s7_is_output_port(sc, p))
+ {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_name_to_value(sc, "abs");
+ if (!s7_is_procedure(p))
+ {fprintf(stderr, "%d: %s is not a procedure?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_make_symbol(sc, "abs");
+ if (!s7_is_symbol(p))
+ {fprintf(stderr, "%d: %s is not a symbol?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_gensym(sc, "abs");
+ if (!s7_is_symbol(p))
+ {fprintf(stderr, "%d: %s is not a symbol?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_make_keyword(sc, "key");
+ if (!s7_is_keyword(p))
+ {fprintf(stderr, "%d: %s is not a keyword?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (!s7_is_eq(p, p))
+ {fprintf(stderr, "%d: %s is not a self-eq??\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_rootlet(sc);
+ if (!s7_is_let(p))
+ {fprintf(stderr, "%d: %s is not an environment?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_curlet(sc);
+ if ((!s7_is_null(sc, p)) && (!s7_is_let(p)))
+ {fprintf(stderr, "%d: %s is not an environment?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_define_constant(sc, "a_constant", s7_t(sc));
+ if (!s7_is_constant(s7_name_to_value(sc, "a_constant")))
+ {fprintf(stderr, "%d: a_constant is not a constant?\n", __LINE__);}
+ if (!s7_is_defined(sc, "a_constant"))
+ {fprintf(stderr, "%d: a_constant is not defined?\n", __LINE__);}
+
+ s7_define_function(sc, "a_function", a_function, 1, 0, false, "a function");
+ if (!s7_is_defined(sc, "a_function"))
+ {fprintf(stderr, "%d: a_function is not defined?\n", __LINE__);}
+ if (!s7_is_function(s7_name_to_value(sc, "a_function")))
+ {fprintf(stderr, "%d: a_function is not a function?\n", __LINE__);}
+
+ p = s7_apply_function(sc, s7_name_to_value(sc, "a_function"), s7_cons(sc, TO_S7_INT(32), s7_nil(sc)));
+ if (!s7_is_integer(p))
+ {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ if (s7_integer(p) != 32)
+ {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+ dax_type_tag = s7_new_type("dax", print_dax, free_dax, equal_dax, mark_dax, NULL, NULL);
+ s7_define_function(sc, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
+ s7_define_function(sc, "dax?", is_dax, 1, 0, false, "(dax? anything) returns #t if its argument is a dax object");
+
+ s7_define_variable(sc, "dax-x",
+ s7_dilambda(sc, "dax-x", dax_x, 1, 0, set_dax_x, 2, 0, "dax x field (a real)"));
+
+ s7_define_variable(sc, "dax-data",
+ s7_dilambda(sc, "dax-data", dax_data, 1, 0, set_dax_data, 2, 0, "dax data field"));
+
+ if (!s7_is_procedure_with_setter(s7_name_to_value(sc, "dax-x")))
+ {fprintf(stderr, "%d: dax-x is not a pws?\n", __LINE__);}
+
+ p = make_dax(sc, s7_cons(sc, s7_make_real(sc, 1.0), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_object(p))
+ {fprintf(stderr, "%d: %s is not an object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax?"), s7_cons(sc, p, s7_nil(sc)));
+ if (p1 != s7_t(sc))
+ {fprintf(stderr, "%d: %s is not a dax object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s1 = TO_STR(p);
+ if (strcmp(s1, "#<dax 1.000 2>") != 0)
+ {fprintf(stderr, "%d: dax prints as %s?\n", __LINE__, s2 = TO_STR(p)); free(s2);}
+ free(s1);
+
+ p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax-data"), s7_cons(sc, p, s7_nil(sc)));
+ if (!s7_is_integer(p1))
+ {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+ if (s7_integer(p1) != 2)
+ {fprintf(stderr, "%d: %s is not 2?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+ s7_apply_function(sc, s7_procedure_setter(sc, s7_name_to_value(sc, "dax-data")), s7_cons(sc, p, s7_cons(sc, TO_S7_INT(32), s7_nil(sc))));
+ p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax-data"), s7_cons(sc, p, s7_nil(sc)));
+ if (!s7_is_integer(p1))
+ {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+ if (s7_integer(p1) != 32)
+ {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+
+ s7_define_function_star(sc, "plus", plus, "(red 32) blue", "an example of define* from C");
+ if (!s7_is_procedure(s7_name_to_value(sc, "plus")))
+ {fprintf(stderr, "%d: plus is not a function?\n", __LINE__);}
+
+ p = s7_apply_function(sc, s7_name_to_value(sc, "plus"), s7_cons(sc, TO_S7_INT(1), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+ if (!s7_is_integer(p))
+ {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ if (s7_integer(p) != 4)
+ {fprintf(stderr, "%d: %s is not 4?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_apply_function(sc, s7_name_to_value(sc, "plus"), s7_cons(sc, s7_make_keyword(sc, "blue"), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
+ if (!s7_is_integer(p))
+ {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ if (s7_integer(p) != 66)
+ {fprintf(stderr, "%d: %s is not 66?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_define_variable(sc, "my-1", s7_make_integer(sc, 1));
+ p = s7_name_to_value(sc, "my-1");
+ if (!s7_is_integer(p))
+ {fprintf(stderr, "%d: %s is not an integer?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_integer(p) != 1)
+ {fprintf(stderr, "%d: %s is not 1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_symbol_set_value(sc, s7_make_symbol(sc, "my-1"), s7_make_integer(sc, 32));
+ p = s7_name_to_value(sc, "my-1");
+ if (s7_integer(p) != 32)
+ {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+ s7_define_macro(sc, "mac-plus", mac_plus, 2, 0, false, "plus adds its two arguments");
+ p = s7_eval_c_string(sc, "(mac-plus 2 3)");
+ if (s7_integer(p) != 5)
+ {fprintf(stderr, "%d: %s is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ p1 = s7_apply_function(sc,
+ s7_name_to_value(sc, "mac-plus"),
+ s7_list(sc, 2, s7_make_integer(sc, 3), s7_make_integer(sc, 4)));
+ p = s7_eval_form(sc, p1, s7_rootlet(sc));
+ if ((!s7_is_integer(p)) ||
+ (s7_integer(p) != 7))
+ {char *s2; fprintf(stderr, "%d: %s -> %s is not 7?\n", __LINE__, s1 = TO_STR(p1), s2 = TO_STR(p)); free(s1); free(s2);}
+
+ s7_define_macro(sc, "mac-plus-mv", mac_plus_mv, 2, 0, false, "macro values test");
+ p = s7_eval_c_string(sc, "(let () (+ (mac-plus-mv 2 3)))");
+ if (s7_integer(p) != 5)
+ {fprintf(stderr, "%d: %s is not 5?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+ s7_define_function(sc, "open-plus", open_plus, 1, 0, true, plus_help);
+ p = s7_sublet(sc, s7_nil(sc), s7_cons(sc, s7_cons(sc, s7_make_symbol(sc, "plus"), s7_name_to_value(sc, "plus")), s7_nil(sc)));
+ s7_openlet(sc, p);
+ p1 = s7_apply_function(sc, s7_name_to_value(sc, "open-plus"), s7_list(sc, 3, p, s7_make_integer(sc, 2), s7_make_integer(sc, 3)));
+ if ((!s7_is_integer(p1)) ||
+ (s7_integer(p1) != 7))
+ {fprintf(stderr, "%d: %s is not 7?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+
+ s7_eval_c_string(sc, "(define my-vect (make-vector '(2 3 4) 0))");
+ s7_eval_c_string(sc, "(set! (my-vect 1 1 1) 32)");
+ p1 = s7_name_to_value(sc, "my-vect");
+
+ p = multivector_ref(sc, p1, 3, 0, 0, 0);
+ if (s7_integer(p) != 0)
+ {fprintf(stderr, "%d: %s is not 0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_vector_ref_n(sc, p1, 3, 0, 0, 0);
+ if (s7_integer(p) != 0)
+ {fprintf(stderr, "%d: %s is not 0?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = multivector_ref(sc, p1, 3, 1, 1, 1);
+ if (s7_integer(p) != 32)
+ {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_vector_ref_n(sc, p1, 3, 1, 1, 1);
+ if (s7_integer(p) != 32)
+ {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_vector_set_n(sc, p1, TO_S7_INT(12), 3, 1, 1, 2);
+ p = s7_vector_ref_n(sc, p1, 3, 1, 1, 2);
+ if (s7_integer(p) != 12)
+ {fprintf(stderr, "%d: %s is not 12?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_vector_length(p1) != 24)
+ {fprintf(stderr, "%d: (length %s) is not 24?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+ if (s7_vector_rank(p1) != 3)
+ {fprintf(stderr, "%d: (vector-dimensions %s) is not 3?\n", __LINE__, s1 = TO_STR(p1)); free(s1);}
+
+ {
+ s7_int *dims, *offs;
+ s7_pointer *els;
+ dims = s7_vector_dimensions(p1);
+ offs = s7_vector_offsets(p1);
+ els = s7_vector_elements(p1);
+ if (dims[0] != 2) fprintf(stderr, "%d: dims[0]: %lld?\n", __LINE__, dims[0]);
+ if (dims[1] != 3) fprintf(stderr, "%d: dims[1]: %lld?\n", __LINE__, dims[1]);
+ if (dims[2] != 4) fprintf(stderr, "%d: dims[2]: %lld?\n", __LINE__, dims[2]);
+ if (offs[0] != 12) fprintf(stderr, "%d: offs[0]: %lld?\n", __LINE__, offs[0]);
+ if (offs[1] != 4) fprintf(stderr, "%d: offs[1]: %lld?\n", __LINE__, offs[1]);
+ if (s7_integer(p = els[12 + 4 + 1]) != 32)
+ {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ }
+
+ s7_vector_fill(sc, p1, s7_t(sc));
+ p = s7_vector_ref_n(sc, p1, 3, 1, 1, 1);
+ if (p != s7_t(sc))
+ {fprintf(stderr, "%d: %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+ {
+ s7_pointer new_env, old_env;
+ new_env = s7_sublet(sc, old_env = s7_curlet(sc), s7_nil(sc));
+ gc_loc = s7_gc_protect(sc, new_env);
+
+ s7_define(sc, new_env, s7_make_symbol(sc, "var1"), s7_make_integer(sc, 32));
+
+ if (new_env == s7_curlet(sc))
+ {fprintf(stderr, "%d: %s is the current env?\n", __LINE__, s1 = TO_STR(new_env)); free(s1);}
+
+ s1 = TO_STR(s7_let_to_list(sc, new_env));
+ if (strcmp(s1, "((var1 . 32))") != 0)
+ {fprintf(stderr, "%d: new-env is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+ if (s7_integer(p) != 32)
+ {fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_let_set(sc, new_env, s7_make_symbol(sc, "var1"), TO_S7_INT(3));
+ p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+ if (s7_integer(p) != 3)
+ {fprintf(stderr, "%d: %s is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_set_curlet(sc, new_env);
+ p = s7_slot(sc, s7_make_symbol(sc, "var1"));
+ if (s7_integer(s7_slot_value(p)) != 3)
+ {fprintf(stderr, "%d: slot-value %s is not 3?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_slot_set_value(sc, p, s7_f(sc));
+ p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var1"));
+ if (p != s7_f(sc))
+ {fprintf(stderr, "%d: set slot-value %s is not #f?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ if (s7_outlet(sc, new_env) != old_env)
+ {fprintf(stderr, "%d: outer-env %s?\n", __LINE__, s1 = TO_STR(old_env)); free(s1);}
+
+ s7_make_slot(sc, new_env, s7_make_symbol(sc, "var2"), TO_S7_INT(-1));
+ p = s7_let_ref(sc, new_env, s7_make_symbol(sc, "var2"));
+ if (s7_integer(p) != -1)
+ {fprintf(stderr, "%d: make_slot %s is not -1?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s7_symbol_set_value(sc, s7_make_symbol(sc, "var2"), s7_t(sc));
+ p = s7_symbol_local_value(sc, s7_make_symbol(sc, "var2"), new_env);
+ if (p != s7_t(sc))
+ {fprintf(stderr, "%d: set symbol-value %s is not #t?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ p = s7_let_to_list(sc, new_env);
+ {
+ int gloc;
+ gloc = s7_gc_protect(sc, p);
+ s1 = TO_STR(p);
+ if (strcmp(s1, "((var1 . #f) (var2 . #t))") != 0)
+ {fprintf(stderr, "%d: env->list: %s\n", __LINE__, s1);}
+ free(s1);
+ s7_gc_unprotect_at(sc, gloc);
+ }
+ s7_set_curlet(sc, old_env);
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+
+ if (!s7_is_list(sc, p = s7_load_path(sc)))
+ {fprintf(stderr, "%d: %s is not a list?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+
+ {
+ s7_pointer port;
+ port = s7_open_output_file(sc, "ffitest.scm", "w");
+
+ if (!s7_is_output_port(sc, port))
+ {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+ else
+ {
+ /* (define loaded_var 321) hopefully */
+ gc_loc = s7_gc_protect(sc, port);
+ s7_write_char(sc, (int)'(', port);
+ s7_write(sc, s7_make_symbol(sc, "define"), port);
+ s7_write_char(sc, (int)' ', port);
+ s7_display(sc, s7_make_symbol(sc, "loaded_var"), port);
+ s7_write_char(sc, (int)' ', port);
+ s7_format(sc, s7_list(sc, 3, port, s7_make_string(sc, "~A)"), TO_S7_INT(321)));
+ s7_newline(sc, port);
+ s7_flush_output_port(sc, port);
+ s7_close_output_port(sc, port);
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ s7_load(sc, "ffitest.scm");
+ if (!s7_is_defined(sc, "loaded_var"))
+ {fprintf(stderr, "%d: load unhappy?\n", __LINE__);}
+ else
+ {
+ int c;
+ if (s7_integer(p = s7_name_to_value(sc, "loaded_var")) != 321)
+ {fprintf(stderr, "%d: %s is not 321?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ port = s7_open_input_file(sc, "ffitest.scm", "r");
+ if (!s7_is_input_port(sc, port))
+ {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+ else
+ {
+ gc_loc = s7_gc_protect(sc, port);
+ c = s7_peek_char(sc, port);
+ if (c != (int)'(')
+ {fprintf(stderr, "%d: peek-char sees %c?\n", __LINE__, (unsigned char)c);}
+
+ c = s7_read_char(sc, port);
+ if (c != (int)'(')
+ {fprintf(stderr, "%d: read-char sees %c?\n", __LINE__, (unsigned char)c);}
+
+ s7_close_input_port(sc, port);
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ port = s7_open_input_file(sc, "ffitest.scm", "r");
+ gc_loc = s7_gc_protect(sc, port);
+
+ p = s7_read(sc, port);
+ s1 = TO_STR(p);
+ if (strcmp(s1, "(define loaded_var 321)") != 0)
+ {fprintf(stderr, "%d: read file sees %s?\n", __LINE__, s1);}
+ free(s1);
+
+ s7_close_input_port(sc, port);
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+ }
+ }
+
+ port = s7_open_input_string(sc, "(+ 1 2)");
+ if (!s7_is_input_port(sc, port))
+ {fprintf(stderr, "%d: %s is not an input port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+ gc_loc = s7_gc_protect(sc, port);
+ p = s7_read(sc, port);
+ s1 = TO_STR(p);
+ if (strcmp(s1, "(+ 1 2)") != 0)
+ {fprintf(stderr, "%d: read string sees %s?\n", __LINE__, s1);}
+ free(s1);
+ s7_close_input_port(sc, port);
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ port = s7_open_output_string(sc);
+ if (!s7_is_output_port(sc, port))
+ {fprintf(stderr, "%d: %s is not an output port?\n", __LINE__, s1 = TO_STR(port)); free(s1);}
+ gc_loc = s7_gc_protect(sc, port);
+ s7_display(sc, s7_make_string(sc, "(+ 2 3)"), port);
+ {
+ const char *s2;
+ s2 = s7_get_output_string(sc, port);
+ if (strcmp(s2, "(+ 2 3)") != 0)
+ {fprintf(stderr, "%d: read output string sees %s?\n", __LINE__, s2);}
+ }
+ s7_close_output_port(sc, port);
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ p = s7_set_current_output_port(sc, s7_open_output_function(sc, my_print));
+ p1 = s7_open_input_function(sc, my_read);
+ gc_loc = s7_gc_protect(sc, p1);
+
+ s7_display(sc, s7_make_character(sc, '3'), s7_current_output_port(sc));
+ if (last_c != '3')
+ {fprintf(stderr, "%d: last_c: %c, c: %c\n", __LINE__, last_c, '3');}
+ last_c = s7_read_char(sc, p1);
+ if (last_c != '0')
+ {fprintf(stderr, "%d: last_c: %c\n", __LINE__, last_c);}
+ s7_set_current_output_port(sc, p);
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+
+ {
+ s7_pointer port, val;
+ s7_autoload(sc, s7_make_symbol(sc, "auto_var"), s7_make_string(sc, "ffitest.scm"));
+ port = s7_open_output_file(sc, "ffitest.scm", "w");
+ gc_loc = s7_gc_protect(sc, port);
+ s7_display(sc, s7_make_string(sc, "(define auto_var 123)"), port);
+ s7_newline(sc, port);
+ s7_close_output_port(sc, port);
+ s7_gc_unprotect_at(sc, gc_loc);
+ val = s7_eval_c_string(sc, "(+ auto_var 1)");
+ if ((!s7_is_integer(val)) ||
+ (s7_integer(val) != 124))
+ {fprintf(stderr, "%d: auto_var+1 = %s?\n", __LINE__, s1 = TO_STR(val)); free(s1);}
+ }
+
+ {
+ s7_pointer test_hook;
+ test_hook = s7_eval_c_string(sc, "(make-hook 'a 'b)");
+ s7_define_constant(sc, "test-hook", test_hook);
+ s7_hook_set_functions(sc, test_hook,
+ s7_cons(sc, s7_make_function(sc, "test-hook-function", test_hook_function, 1, 0, false, "a test-hook function"),
+ s7_hook_functions(sc, test_hook)));
+ s7_call(sc, test_hook, s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2)));
+ s7_call_with_location(sc, test_hook, s7_list(sc, 2, TO_S7_INT(1), TO_S7_INT(2)), "ffitest", "ffitest.c", __LINE__);
+ }
+
+ {
+ s7_pointer x, y, funcs;
+ funcs = s7_eval_c_string(sc, "(let ((x 0)) (list (lambda () (set! x 1)) (lambda () (set! x (+ x 1))) (lambda () (set! x (+ x 1))) (lambda () x)))");
+ gc_loc = s7_gc_protect(sc, funcs);
+ y = s7_dynamic_wind(sc, s7_car(funcs), s7_cadr(funcs), s7_caddr(funcs));
+ x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+ if ((!s7_is_integer(x)) ||
+ (!s7_is_integer(y)) ||
+ (s7_integer(x) != 3) ||
+ (s7_integer(y) != 2))
+ fprintf(stderr, "s7_dynamic_wind: x: %s, y: %s\n", s7_object_to_c_string(sc, x), s7_object_to_c_string(sc, y));
+ y = s7_dynamic_wind(sc, s7_f(sc), s7_car(funcs), s7_cadr(funcs));
+ x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+ if ((!s7_is_integer(x)) ||
+ (!s7_is_integer(y)) ||
+ (s7_integer(x) != 2) ||
+ (s7_integer(y) != 1))
+ fprintf(stderr, "s7_dynamic_wind (init #f): x: %s, y: %s\n", s7_object_to_c_string(sc, x), s7_object_to_c_string(sc, y));
+ y = s7_dynamic_wind(sc, s7_f(sc), s7_cadr(funcs), s7_f(sc));
+ x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+ if ((!s7_is_integer(x)) ||
+ (!s7_is_integer(y)) ||
+ (s7_integer(x) != 3) ||
+ (s7_integer(y) != 3))
+ fprintf(stderr, "s7_dynamic_wind (init #f, finish #f): x: %s, y: %s\n", s7_object_to_c_string(sc, x), s7_object_to_c_string(sc, y));
+ y = s7_dynamic_wind(sc, s7_cadr(funcs), s7_cadr(funcs), s7_f(sc));
+ x = s7_call(sc, s7_cadddr(funcs), s7_nil(sc));
+ if ((!s7_is_integer(x)) ||
+ (!s7_is_integer(y)) ||
+ (s7_integer(x) != 5) ||
+ (s7_integer(y) != 5))
+ fprintf(stderr, "s7_dynamic_wind (finish #f): x: %s, y: %s\n", s7_object_to_c_string(sc, x), s7_object_to_c_string(sc, y));
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+
+ if (s7_begin_hook(sc) != NULL)
+ {fprintf(stderr, "%d: begin_hook is not null?\n", __LINE__);}
+ tested_begin_hook = false;
+ s7_set_begin_hook(sc, test_begin_hook);
+ s7_eval_c_string(sc, "(begin (+ 1 2))");
+ if (!tested_begin_hook)
+ {fprintf(stderr, "%d: begin_hook not called?\n", __LINE__);}
+ if (s7_begin_hook(sc) != test_begin_hook)
+ {fprintf(stderr, "%d: begin_hook was not set?\n", __LINE__);}
+ s7_set_begin_hook(sc, NULL);
+
+
+ p1 = s7_name_to_value(sc, "abs");
+ if (!s7_is_procedure(p1))
+ {fprintf(stderr, "%d: (procedure? abs) = #f?\n", __LINE__);}
+ if (s7_is_macro(sc, p1))
+ {fprintf(stderr, "%d: (macro? abs) = #t?\n", __LINE__);}
+
+ if (!s7_is_aritable(sc, p1, 1))
+ {fprintf(stderr, "%d: (aritable? abs 1) = #f?\n", __LINE__);}
+ if (s7_is_aritable(sc, p1, 2))
+ {fprintf(stderr, "%d: (aritable? abs 2) = #t?\n", __LINE__);}
+
+ p = s7_funclet(sc, p1);
+ if (p != s7_rootlet(sc))
+ {fprintf(stderr, "%d: (funclet abs) = %s?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ {
+ const char *s3;
+ s3 = s7_procedure_documentation(sc, p1);
+ if (strcmp(s3, "(abs x) returns the absolute value of the real number x") != 0)
+ {fprintf(stderr, "%d: (procedure-documentation abs) = %s?\n", __LINE__, s3);}
+
+ s3 = s7_help(sc, p1);
+ if (strcmp(s3, "(abs x) returns the absolute value of the real number x") != 0)
+ {fprintf(stderr, "%d: (help abs) = %s?\n", __LINE__, s3);}
+ }
+
+ p = s7_eval_c_string(sc, "(lambda (a b . c) (+ a b (apply * c)))");
+ gc_loc = s7_gc_protect(sc, p);
+
+ if (!s7_is_procedure(p))
+ {fprintf(stderr, "%d: %s is not a procedure?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+
+ s1 = TO_STR(s7_closure_body(sc, p));
+ if (strcmp(s1, "((+ a b (apply * c)))") != 0)
+ {fprintf(stderr, "%d: s7_closure_body is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ s1 = TO_STR(s7_closure_args(sc, p));
+ if (strcmp(s1, "(a b . c)") != 0)
+ {fprintf(stderr, "%d: s7_closure_args is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ s1 = TO_STR(s7_closure_let(sc, p));
+ if (strcmp(s1, "()") != 0)
+ {fprintf(stderr, "%d: s7_closure_let is %s?\n", __LINE__, s1);}
+ free(s1);
+
+ if (!s7_is_aritable(sc, p, 2))
+ {fprintf(stderr, "%d: aritable? lambda 2 = #f?\n", __LINE__);}
+ if (s7_is_aritable(sc, p, 1))
+ {fprintf(stderr, "%d: aritable? lambda 1 = #t?\n", __LINE__);}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ {
+ /* iterators */
+ s7_pointer iter, x;
+ iter = s7_make_iterator(sc, s7_list(sc, 3, TO_S7_INT(1), TO_S7_INT(2), TO_S7_INT(3)));
+ if (!s7_is_iterator(iter))
+ fprintf(stderr, "%d: %s is not an interator\n", __LINE__, TO_STR(iter));
+ if (s7_iterator_is_at_end(iter))
+ fprintf(stderr, "%d: %s is prematurely done\n", __LINE__, TO_STR(iter));
+ x = s7_iterate(sc, iter);
+ if ((!s7_is_integer(x)) || (s7_integer(x) != 1))
+ fprintf(stderr, "%d: %s should be 1\n", __LINE__, TO_STR(x));
+ x = s7_iterate(sc, iter);
+ if ((!s7_is_integer(x)) || (s7_integer(x) != 2))
+ fprintf(stderr, "%d: %s should be 2\n", __LINE__, TO_STR(x));
+ x = s7_iterate(sc, iter);
+ if ((!s7_is_integer(x)) || (s7_integer(x) != 3))
+ fprintf(stderr, "%d: %s should be 3\n", __LINE__, TO_STR(x));
+ x = s7_iterate(sc, iter);
+ if ((x != s7_eof_object(sc)) || (!s7_iterator_is_at_end(iter)))
+ fprintf(stderr, "%d: %s should be #<eof> and iter should be done\n", __LINE__, TO_STR(x));
+ }
+
+ g_block_type = s7_new_type_x(sc, "#<block>",
+ g_block_display, g_block_free,
+ g_block_is_equal, g_block_mark,
+ g_block_ref, g_block_set, g_block_length,
+ g_block_copy, g_block_reverse, g_block_fill);
+
+ s7_define_function(sc, "make-block", g_make_block, 1, 0, false, g_make_block_help);
+ s7_define_function(sc, "block", g_to_block, 0, 0, true, g_block_help);
+
+ g_block_methods = s7_eval_c_string(sc, "(inlet (cons 'vector? (lambda (p) #t)))");
+ s7_gc_protect(sc, g_block_methods);
+
+ {
+ g_block *g;
+ s7_pointer gp;
+
+ gp = g_make_block(sc, s7_list(sc, 1, TO_S7_INT(32)));
+ gc_loc = s7_gc_protect(sc, gp);
+ if (!s7_is_object(gp))
+ {fprintf(stderr, "%d: g_block %s is not an object?\n", __LINE__, s1 = TO_STR(gp)); free(s1);}
+ g = (g_block *)s7_object_value(gp);
+ if (s7_object_type(gp) != g_block_type)
+ {fprintf(stderr, "%d: g_block types: %d %d\n", __LINE__, g_block_type, s7_object_type(gp));}
+ if (s7_object_value_checked(gp, g_block_type) != g)
+ {fprintf(stderr, "%d: checked g_block types: %d %d\n", __LINE__, g_block_type, s7_object_type(gp));}
+
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+
+ {
+ s7_pointer old_port;
+ const char *errmsg = NULL;
+
+ old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+ gc_loc = s7_gc_protect(sc, old_port);
+
+ s7_eval_c_string(sc, "(+ 1 #\\c)");
+ errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+ if (!errmsg)
+ fprintf(stderr, "%d: no error!\n", __LINE__);
+
+ s7_close_output_port(sc, s7_current_error_port(sc));
+ s7_set_current_error_port(sc, old_port);
+ s7_gc_unprotect_at(sc, gc_loc);
+ }
+
+ {
+ s7_pointer old_port, result;
+ const char *errmsg = NULL;
+
+ s7_define_function(sc, "error-handler", test_error_handler, 1, 0, false, "our error handler");
+
+ s7_eval_c_string(sc, "(set! (hook-functions *error-hook*) \n\
+ (list (lambda (hook) \n\
+ (error-handler \n\
+ (string-append \"hook: \" (apply format #f (hook 'data)))) \n\
+ (set! (hook 'result) 'our-error))))");
+
+ old_port = s7_set_current_error_port(sc, s7_open_output_string(sc));
+ gc_loc = s7_gc_protect(sc, old_port);
+
+ result = s7_eval_c_string(sc, "(+ 1 #\\c)");
+ if (result != s7_make_symbol(sc, "our-error"))
+ {fprintf(stderr, "%d: error hook result: %s\n", __LINE__, s1 = TO_STR(result)); free(s1);}
+ errmsg = s7_get_output_string(sc, s7_current_error_port(sc));
+ if ((errmsg) && (*errmsg))
+ {
+ if (strcmp(errmsg, "error!") != 0)
+ fprintf(stderr, "%d: error: %s\n", __LINE__, errmsg);
+ }
+ else fprintf(stderr, "%d: no error!\n", __LINE__);
+
+ s7_close_output_port(sc, s7_current_error_port(sc));
+ s7_set_current_error_port(sc, old_port);
+ s7_gc_unprotect_at(sc, gc_loc);
+
+ s7_eval_c_string(sc, "(set! (hook-functions *error-hook*) ())");
+ }
+
+ s7_define_function(sc, "notify-C", scheme_set_notification, 2, 0, false, "called if notified-var is set!");
+ s7_define_variable(sc, "notified-var", s7_make_integer(sc, 0));
+ s7_symbol_set_access(sc, s7_make_symbol(sc, "notified-var"), s7_name_to_value(sc, "notify-C"));
+ s7_eval_c_string(sc, "(set! notified-var 32)");
+ p = s7_name_to_value(sc, "notified-var");
+ if (s7_integer(p) != 32)
+ {fprintf(stderr, "%d: sym set: %s\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ if (s7_integer(set_val) != 32)
+ {fprintf(stderr, "%d: sym val: %s\n", __LINE__, s1 = TO_STR(set_val)); free(s1);}
+ if (set_sym != s7_make_symbol(sc, "notified-var"))
+ {fprintf(stderr, "%d: sym: %s\n", __LINE__, s1 = TO_STR(set_sym)); free(s1);}
+
+ return(0);
+}
+
diff --git a/tools/gcall.c b/tools/gcall.c
new file mode 100644
index 0000000..a1f1886
--- /dev/null
+++ b/tools/gcall.c
@@ -0,0 +1,245 @@
+/* example main program that calls glistener/s7
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdbool.h>
+
+#include <gtk/gtk.h>
+
+#include "s7.h"
+#include "glistener.h"
+
+static s7_scheme *s7;
+
+static s7_pointer wrap_glistener(glistener *g)
+{
+ return(s7_make_c_pointer(s7, (void *)g));
+}
+
+static glistener *unwrap_glistener(s7_pointer p)
+{
+ return((glistener *)s7_c_pointer(p));
+}
+
+static s7_pointer g_evaluate(s7_scheme *sc, s7_pointer args)
+{
+ char *str;
+ s7_pointer result;
+ str = glistener_evaluate(unwrap_glistener(s7_car(args)));
+ result = s7_make_string(s7, str);
+ if (str) g_free(str);
+ return(result);
+}
+
+static s7_pointer g_complete(s7_scheme *sc, s7_pointer args)
+{
+ char *str;
+ s7_pointer result;
+ str = glistener_complete(unwrap_glistener(s7_car(args)));
+ result = s7_make_string(s7, str);
+ if (str) g_free(str);
+ return(result);
+}
+
+static s7_pointer g_append_text(s7_scheme *sc, s7_pointer args)
+{
+ glistener_append_text(unwrap_glistener(s7_car(args)), s7_string(s7_cadr(args)));
+ return(s7_cadr(args));
+}
+
+static s7_pointer g_insert_text(s7_scheme *sc, s7_pointer args)
+{
+ glistener_insert_text(unwrap_glistener(s7_car(args)), s7_string(s7_cadr(args)));
+ return(s7_cadr(args));
+}
+
+static s7_pointer g_scroll_to_end(s7_scheme *sc, s7_pointer args)
+{
+ glistener_scroll_to_end(unwrap_glistener(s7_car(args)));
+ return(s7_car(args));
+}
+
+static s7_pointer g_append_prompt(s7_scheme *sc, s7_pointer args)
+{
+ glistener_append_prompt(unwrap_glistener(s7_car(args)));
+ return(s7_car(args));
+}
+
+static s7_pointer g_prompt_position(s7_scheme *sc, s7_pointer args)
+{
+ return(s7_make_integer(s7, glistener_prompt_position(unwrap_glistener(s7_car(args)))));
+}
+
+static s7_pointer g_cursor_position(s7_scheme *sc, s7_pointer args)
+{
+ return(s7_make_integer(s7, glistener_cursor_position(unwrap_glistener(s7_car(args)))));
+}
+
+static s7_pointer g_set_cursor_position(s7_scheme *sc, s7_pointer args)
+{
+ glistener_set_cursor_position(unwrap_glistener(s7_car(args)), s7_integer(s7_cadr(args)));
+ return(s7_cadr(args));
+}
+
+static s7_pointer g_text(s7_scheme *sc, s7_pointer args)
+{
+ char *str;
+ s7_pointer result;
+ str = glistener_text(unwrap_glistener(s7_car(args)), s7_integer(s7_cadr(args)), s7_integer(s7_caddr(args)));
+ result = s7_make_string(s7, str);
+ if (str) g_free(str);
+ return(result);
+}
+
+static s7_pointer g_clear(s7_scheme *sc, s7_pointer args)
+{
+ glistener_clear(unwrap_glistener(s7_car(args)));
+ return(s7_car(args));
+}
+
+static s7_pointer g_set_prompt(s7_scheme *sc, s7_pointer args)
+{
+ glistener_set_prompt(unwrap_glistener(s7_car(args)), s7_string(s7_cadr(args)));
+ return(s7_cadr(args));
+}
+
+static void glistener_init(glistener *g1, glistener *g2)
+{
+ s7_define_function(s7, "append-text", g_append_text, 2, 0, false, "(append-text g txt)");
+ s7_define_function(s7, "insert-text", g_insert_text, 2, 0, false, "(insert-text g txt)");
+ s7_define_function(s7, "cursor-position", g_cursor_position, 1, 0, false, "(cursor-position g)");
+ s7_define_function(s7, "set-cursor-position", g_set_cursor_position, 2, 0, false, "(set-cursor-position g pos)");
+ s7_define_function(s7, "text", g_text, 3, 0, false, "(text g start end)");
+ s7_define_function(s7, "append-prompt", g_append_prompt, 1, 0, false, "(append-prompt g)");
+ s7_define_function(s7, "prompt-position", g_prompt_position, 1, 0, false, "(prompt-position g)");
+ s7_define_function(s7, "set-prompt", g_set_prompt, 2, 0, false, "(set-prompt g str)");
+ s7_define_function(s7, "evaluate", g_evaluate, 1, 0, false, "(evaluate g)");
+ s7_define_function(s7, "complete", g_complete, 1, 0, false, "(complete g)");
+ s7_define_function(s7, "scroll", g_scroll_to_end, 1, 0, false, "(scroll g)");
+ s7_define_function(s7, "clear", g_clear, 1, 0, false, "(clear g)");
+ s7_define_variable(s7, "*g1*", wrap_glistener(g1));
+ s7_define_variable(s7, "*g2*", wrap_glistener(g2));
+}
+
+static GdkCursor *arrow_cursor;
+static glistener *g1, *g2;
+
+static gint quit_repl(GtkWidget *w, GdkEvent *event, gpointer context) {exit(0);}
+
+static void evaluator(glistener *g, const char *text)
+{
+ int gc_loc;
+ s7_pointer old_port, result;
+ const char *errmsg = NULL;
+ char *msg = NULL;
+
+ old_port = s7_set_current_error_port(s7, s7_open_output_string(s7));
+ gc_loc = s7_gc_protect(s7, old_port);
+
+ result = s7_eval_c_string(s7, text);
+ errmsg = s7_get_output_string(s7, s7_current_error_port(s7));
+ if ((errmsg) && (*errmsg))
+ {
+ msg = (char *)calloc(strlen(errmsg) + 1, sizeof(char));
+ strcpy(msg, errmsg);
+ glistener_set_cursor_shape(g1, arrow_cursor); /* make sure we undo the wait cursor if an error occurred */
+ glistener_set_cursor_shape(g2, arrow_cursor);
+ }
+
+ s7_close_output_port(s7, s7_current_error_port(s7));
+ s7_set_current_error_port(s7, old_port);
+ s7_gc_unprotect_at(s7, gc_loc);
+
+ glistener_append_text(g, "\n");
+ if (msg)
+ glistener_append_text(g, msg);
+ else
+ {
+ msg = s7_object_to_c_string(s7, result);
+ glistener_append_text(g, msg);
+ }
+ if (msg) free(msg);
+ glistener_append_prompt(g);
+}
+
+static void listener_init(glistener *g, GtkWidget *w)
+{
+ unsigned char prompt[4] = {0xce, 0xbb, '>', '\0'}; /* lambda as prompt */
+ GtkTextBuffer *buffer;
+
+ buffer = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
+ glistener_set_font(g, pango_font_description_from_string("Monospace 10"));
+ glistener_set_prompt_tag(g, gtk_text_buffer_create_tag(buffer, "glistener_prompt_tag",
+ "weight", PANGO_WEIGHT_BOLD,
+ "foreground", "red",
+ NULL));
+ glistener_set_prompt(g, prompt);
+}
+
+static const char *helper(glistener *g, const char *text)
+{
+ s7_pointer sym;
+ sym = s7_symbol_table_find_name(s7, text);
+ if (sym)
+ return(s7_help(s7, sym));
+ glistener_clear_status(g);
+ return(NULL);
+}
+
+static void completer(glistener *g, bool (*symbol_func)(const char *symbol_name, void *data), void *data)
+{
+ s7_for_each_symbol_name(s7, symbol_func, data);
+}
+
+int main(int argc, char **argv)
+{
+ GtkWidget *shell, *frame1, *frame2, *vb;
+
+ s7 = s7_init();
+
+ gtk_init(&argc, &argv);
+ shell = gtk_window_new(GTK_WINDOW_TOPLEVEL);
+ g_signal_connect(G_OBJECT(shell), "delete_event", G_CALLBACK(quit_repl), NULL);
+
+#if (!GTK_CHECK_VERSION(3, 0, 0))
+ vb = gtk_vbox_new(false, 0);
+#else
+ vb = gtk_box_new(GTK_ORIENTATION_VERTICAL, 0);
+#endif
+ gtk_container_add(GTK_CONTAINER(shell), vb);
+ gtk_widget_show(vb);
+
+ frame1 = gtk_frame_new(NULL);
+ gtk_frame_set_shadow_type(GTK_FRAME(frame1), GTK_SHADOW_ETCHED_IN);
+ gtk_widget_show(frame1);
+ gtk_container_add(GTK_CONTAINER(vb), frame1);
+
+ frame2 = gtk_frame_new(NULL);
+ gtk_frame_set_shadow_type(GTK_FRAME(frame2), GTK_SHADOW_ETCHED_IN);
+ gtk_widget_show(frame2);
+ gtk_container_add(GTK_CONTAINER(vb), frame2);
+
+ g1 = glistener_new(frame1, listener_init);
+ glistener_set_evaluator(g1, evaluator);
+ glistener_set_helper(g1, helper);
+ glistener_set_completer(g1, completer);
+
+ g2 = glistener_new(frame2, listener_init);
+ glistener_set_evaluator(g2, evaluator);
+ glistener_set_helper(g2, helper);
+ glistener_set_completer(g2, completer);
+
+ glistener_init(g1, g2);
+ arrow_cursor = GDK_CURSOR_NEW(GDK_LEFT_PTR);
+
+ gtk_widget_show(shell);
+ gdk_window_resize(gtk_widget_get_window(shell), 500, 700);
+ gtk_main();
+}
+
+/* in gtk-2: gcc gcall.c -o gcall s7.o glistener.o `pkg-config --libs gtk+-2.0 --cflags` -lm -ldl
+ in gtk-3: gcc gcall.c -o gcall s7.o glistener.o `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl
+*/
+
diff --git a/tools/gdbinit b/tools/gdbinit
new file mode 100644
index 0000000..f4ea14e
--- /dev/null
+++ b/tools/gdbinit
@@ -0,0 +1,268 @@
+define s7print
+print s7_object_to_c_string(sc, $arg0)
+end
+document s7print
+interpret the argument as an s7 value and display it
+end
+
+# the current expression is sc->cur_code
+# the current environment is sc->envir
+# the error environment is sc->owlet
+# so for example, to see the current local variables, s7p sc->envir
+# source ~/.gdbinit reloads
+
+
+define s7eval
+print s7_object_to_c_string(sc, s7_eval_c_string(sc, $arg0))
+end
+document s7eval
+eval the argument (a string)
+end
+
+
+define s7stack
+print s7_object_to_c_string(sc, s7_stacktrace(sc))
+end
+document s7stack
+display the currently active local environments
+end
+
+
+define s7value
+print s7_object_to_c_string(sc, s7_name_to_value(sc, $arg0))
+end
+document s7value
+print the value of the variable passed by its print name: s7v "*features*"
+end
+
+
+define s7bt
+set logging overwrite on
+set logging redirect on
+set logging on
+bt
+set logging off
+# now gdb.txt has the backtrace
+print s7_decode_bt()
+end
+document s7bt
+print a backtrace with s7 objects decoded as much as possible
+end
+
+define s7btfull
+set logging overwrite on
+set logging redirect on
+set logging on
+bt full
+set logging off
+print s7_decode_bt()
+end
+document s7btfull
+print a full backtrace with s7 objects decoded as much as possible
+end
+
+
+# this requires -g3 compilation
+define s7cell
+ set $escape = 27
+ set $cell = (s7_cell *)$arg0
+ set $type = $cell.tf.type_field
+ set $is_bad_type = (($type <= T_FREE) || ($type >= NUM_TYPES))
+
+ printf "%s\n", describe_type_bits(sc, $cell)
+ printf "hloc: %d, ", $cell.hloc
+
+ printf "fields: %p %p %p %p %p\n",\
+ $cell.object.cons.car, $cell.object.cons.cdr, $cell.object.cons.opt1, $cell.object.cons.opt2, $cell.object.cons.opt3
+
+ if (($type == T_NIL) || ($type == T_BOOLEAN) || ($type == T_UNIQUE))
+ printf "constant: %s\n", $cell.object.unq.name
+ end
+
+ if (($type == T_INTEGER) || ($is_bad_type))
+ printf "integer_value: %lld\n", $cell.object.number.integer_value
+ end
+
+ if (($type == T_REAL) || ($is_bad_type))
+ printf "real_value: %f\n", $cell.object.number.real_value
+ end
+
+ if (($type == T_RATIO) || ($is_bad_type))
+ printf "fraction_value: %lld / %lld\n", $cell.object.number.fraction_value.numerator, $cell.object.number.fraction_value.denominator
+ end
+
+ if (($type == T_COMPLEX) || ($is_bad_type))
+ printf "complex_value: %f + %fi\n", $cell.object.number.complex_value.rl, $cell.object.number.complex_value.im
+ end
+
+ if ($type == T_BIG_INTEGER)
+ if (WITH_GMP)
+ printf "big integer: %p\n", $cell.object.number.big_integer
+ else
+ printf "big integer??\n"
+ end
+ end
+
+ if ($type == T_BIG_RATIO)
+ if (WITH_GMP)
+ printf "big ratio: %p\n", $cell.object.number.big_ratio
+ else
+ printf "big ratio??\n"
+ end
+ end
+
+ if ($type == T_BIG_REAL)
+ if (WITH_GMP)
+ printf "big real: %p\n", $cell.object.number.big_real
+ else
+ printf "big real??\n"
+ end
+ end
+
+ if ($type == T_BIG_COMPLEX)
+ if (WITH_GMP)
+ printf "big complex: %p\n", $cell.object.number.big_complex
+ else
+ printf "big complex??\n"
+ end
+ end
+
+ if (($is_bad_type) || (($cell.tf.flag & T_PRINT_NAME) != 0))
+ printf "pval: padding: %s, name: %s\n", $cell.object.number.pval.padding, $cell.object.number.pval.name
+ end
+
+ if ($is_bad_type)
+ printf "ul_value: %ld, %lld\n", $cell.object.number.ul_value, $cell.object.number.ull_value
+ end
+
+ if ($type == T_BAFFLE)
+ printf "baffle: %d\n", $cell.object.baffle_key
+ end
+
+ if ($type == T_C_POINTER)
+ printf "c_pointer: %p\n", $cell.object.c_pointer
+ end
+
+ if ($type == T_RANDOM_STATE)
+ if (WITH_GMP)
+ printf "random-state\n"
+ else
+ printf "random-state: seed: %lld, carry: %lld\n", $cell.object.rng.seed, $cell.object.rng.carry
+ end
+ end
+
+ if (($type == T_PAIR) || ($is_bad_type))
+ printf "cons: car: %p, cdr: %p, opt1: %p, opt2: %p, opt3: %p\n", \
+ $cell.object.cons.car, $cell.object.cons.cdr, $cell.object.cons.opt1, $cell.object.cons.opt2, $cell.object.cons.opt3
+ printf " line: %d, op: %d\n", \
+ $cell.object.sym_cons.line, $cell.object.sym_cons.op
+ end
+
+ if (($type == T_CHARACTER) || ($is_bad_type))
+ printf "chr: c: %c, up_c: %c, alpha_c: %d, digit_c: %d, space_c: %d, upper_c: %d, lower_c: %d", \
+ $cell.object.chr.c, $cell.object.chr.up_c, \
+ $cell.object.chr.alpha_c, $cell.object.chr.digit_c, $cell.object.chr.space_c, $cell.object.chr.upper_c, $cell.object.chr.lower_c
+ if ($type == T_CHARACTER)
+ printf ", c_name: %s, length: %d", $cell.object.chr.c_name, $cell.object.chr.length
+ end
+ end
+
+ if ($type == T_SLOT)
+ printf "slt: sym: %p, val: %p, nxt: %p, pending_value: %p, expr: %p\n", \
+ $cell.object.slt.sym, $cell.object.slt.val, $cell.object.slt.nxt, $cell.object.slt.pending_value, $cell.object.slt.expr
+ end
+
+ if ($type == T_LET)
+ printf "envr: slots: %p, nxt: %p, id: %lld\n", $cell.object.envr.slots, $cell.object.envr.nxt, $cell.object.envr.id
+ end
+
+ if ($type == T_ITERATOR)
+ printf "iter: obj: %p, cur: %p, loc: %lld\n", $cell.object.iter.obj, $cell.object.iter.cur, $cell.object.iter.lc.loc
+ end
+
+ if ($type == T_COUNTER)
+ printf "ctr: result: %p, list: %p, env: %p, cap: %lld, len: %lld\n", \
+ $cell.object.ctr.result, $cell.object.ctr.list, $cell.object.ctr.env, $cell.object.ctr.cap, $cell.object.ctr.len
+ end
+
+ if ($type == T_C_OBJECT)
+ if (num_types >= $cell.object.c_obj.type)
+ printf "c_obj: %c[31mtype: %d%c[0m, value: %p, e: %p\n", $escape, $cell.object.c_obj.type, $escape, $cell.object.c_obj.value ,$cell.object.c_obj.e
+ else
+ printf "c_obj: type: %d, value: %p, e: %p\n", $cell.object.c_obj.type, $cell.object.c_obj.value ,$cell.object.c_obj.e
+ end
+ end
+
+ if (($type == T_STRING) || ($is_bad_type))
+ if (($cell.tf.type_field & T_BYTE_VECTOR) != 0)
+ printf "byte-vector: "
+ else
+ printf "string: "
+ end
+ printf "length: %d, hash: %d, needs_free: %d, initial_slot: %p", \
+ $cell.object.string.length, $cell.object.string.hash, $cell.object.string.str_ext.needs_free, $cell.object.string.initial_slot
+ if ($type == T_STRING)
+ printf ", svalue: %s", $cell.object.string.svalue
+ end
+ printf "\n"
+ end
+
+ if (($type == T_SYMBOL) || ($is_bad_type))
+ printf "sym: name: %p, global_slot: %p, local_slot: %p, \n id: %d, tag: %d, accessor: %d\n", \
+ $cell.object.sym.name, $cell.object.sym.global_slot, $cell.object.sym.local_slot, $cell.object.sym.id, $cell.object.sym.tag, $cell.object.string.str_ext.accessor
+ end
+
+ if (($type == T_SYNTAX) || ($is_bad_type))
+ printf "syn: symbol: %p, op: %d\n", $cell.object.syn.symbol, $cell.object.syn.op
+ end
+
+ if (($type == T_CONTINUATION) || ($is_bad_type))
+ printf "continuation: continuation: %p, stack: %p, start_start: %p, stack_end: %p, op_stack: %p, key: %d\n", \
+ $cell.object.cwcc.continuation, $cell.object.cwcc.stack, $cell.object.cwcc.stack_start, $cell.object.cwcc.stack_end, $cell.object.cwcc.op_stack, \
+ $cell.object.cwcc.continuation->local_key
+ end
+
+ if (($type == T_VECTOR) || ($is_bad_type) || ($type == T_INT_VECTOR) || ($type == T_FLOAT_VECTOR))
+ printf "\nvector: length: %lld, dim_info: %p, vget: %p, vset: %p, objects: %p\n", \
+ $cell.object.vector.length, $cell.object.vector.dim_info, $cell.object.vector.vget, $cell.object.vector.vset, $cell.object.vector.elements.objects
+ end
+
+ if (($type == T_HASH_TABLE) || ($is_bad_type))
+ printf "hasher: mask: %lld, elements: %p, entries: %d,\n hash_func: %p, loc: %p, dproc: %p\n", \
+ $cell.object.hasher.mask, $cell.object.hasher.elements, $cell.object.hasher.entries, $cell.object.hasher.hash_func, $cell.object.hasher.loc, $cell.object.hasher.dproc
+ end
+
+ if (($type == T_INPUT_PORT) || ($type == T_OUTPUT_PORT))
+ printf "prt: port: %p, data: %p, size: %d, point: %d,\n line_number: %d, file_number: %d, is_closed: %d, ptype: %d\n", \
+ $cell.object.prt.port, $cell.object.prt.data, $cell.object.prt.size, $cell.object.prt.point, \
+ $cell.object.prt.line_number, $cell.object.prt.file_number, $cell.object.prt.is_closed, $cell.object.prt.ptype
+ end
+
+ if (($type == T_CATCH) || ($is_bad_type))
+ printf "rcatch: goto_loc: %d, op_stack_loc: %d, tag: %p, handler: %p\n", \
+ $cell.object.rcatch.goto_loc, $cell.object.rcatch.op_stack_loc, $cell.object.rcatch.tag, $cell.object.rcatch.handler
+ end
+
+ if (($type == T_GOTO) || ($is_bad_type))
+ printf "rexit: goto_loc: %d, op_stack_loc: %d, active: %d\n", $cell.object.rexit.goto_loc, $cell.object.rexit.op_stack_loc, $cell.object.rexit.active
+ end
+
+ if (($type == T_DYNAMIC_WIND) || ($is_bad_type))
+ printf "winder: in: %p, out: %p, body: %p, state: %d\n", \
+ $cell.object.winder.in, $cell.object.winder.out, $cell.object.winder.body, $cell.object.winder.state
+ end
+
+ if (($type == T_CLOSURE) || ($type == T_CLOSURE_STAR) || ($type == T_MACRO) || ($type == T_BACRO) || ($is_bad_type))
+ printf "func: args: %p, body: %p, env: %p, setter: %p, arity: %d\n", \
+ $cell.object.func.args, $cell.object.func.body, $cell.object.func.env, $cell.object.func.setter, $cell.object.func.arity
+ end
+
+ if (($type >= T_C_FUNCTION_STAR) || ($is_bad_type))
+ printf "c-fnc: c_proc: %p, ff: %p, setter: %p,\n required_args: %d, optional_args: %d, all_args: %d, rest_arg: %d\n", \
+ $cell.object.fnc.c_proc, $cell.object.fnc.ff, $cell.object.fnc.setter, \
+ $cell.object.fnc.required_args, $cell.object.fnc.optional_args, $cell.object.fnc.all_args, $cell.object.fnc.rest_arg
+ if ((!$is_bad_type) && ($cell.object.fnc.c_proc != 0))
+ printf " name: %s\n", $cell.object.fnc.c_proc->name
+ end
+
+end
diff --git a/tools/gldata.scm b/tools/gldata.scm
index eb817d4..8a07875 100644
--- a/tools/gldata.scm
+++ b/tools/gldata.scm
@@ -39,11 +39,6 @@
;(CFNC-X "int glXQueryContext Display* dpy GLXContext ctx int attribute int* value")
;(CFNC-X "void glXSelectEvent Display* dpy Window draw ulong event_mask")
;(CFNC-X "void glXGetSelectedEvent Display* dpy Window draw ulong* event_mask")
-;(CFNC-X "GLXContextID glXGetContextIDEXT GLXContext ctx")
-;(CFNC-X "Window glXGetCurrentDrawableEXT void")
-;(CFNC-X "GLXContext glXImportContextEXT Display* dpy GLXContextID contextID")
-;(CFNC-X "void glXFreeContextEXT Display* dpy GLXContext ctx")
-;(CFNC-X "int glXQueryContextInfoEXT Display* dpy GLXContext ctx int attribute int* value")
(CFNC "void glClearIndex GLfloat c")
(CFNC "void glClearColor GLclampf red GLclampf green GLclampf blue GLclampf alpha")
(CFNC "void glClear GLbitfield mask")
@@ -451,7 +446,6 @@
(CFNC "void gluNextContour GLUtesselator* tess GLenum type")
(CFNC "void gluNurbsCallback GLUnurbs* nurb GLenum which _GLUfuncptr CallBackFunc")
(CFNC "void gluNurbsCallbackData GLUnurbs* nurb GLvoid* userData")
-(CFNC "void gluNurbsCallbackDataEXT GLUnurbs* nurb GLvoid* userData")
(CFNC "void gluNurbsCurve GLUnurbs* nurb GLint knotCount GLfloat* knots GLint stride GLfloat* control GLint order GLenum type")
(CFNC "void gluNurbsProperty GLUnurbs* nurb GLenum property GLfloat value")
(CFNC "void gluNurbsSurface GLUnurbs* nurb GLint sKnotCount GLfloat* sKnots GLint tKnotCount GLfloat* tKnots GLint sStride GLint tStride GLfloat* control GLint sOrder GLint tOrder GLenum type")
@@ -512,63 +506,6 @@
(CFNC-multi "void glMultiTexCoord4ivARB GLenum target GLint* v")
(CFNC-multi "void glMultiTexCoord4sARB GLenum target GLshort s GLshort t GLshort r GLshort q")
(CFNC-multi "void glMultiTexCoord4svARB GLenum target GLshort* v")
-;;;(CFNC "void glLockArraysEXT GLint first GLsizei count")
-;;;(CFNC "void glUnlockArraysEXT void")
-;;;(CFNC "void glBlendColorEXT GLclampf red GLclampf green GLclampf blue GLclampf alpha")
-;;;(CFNC-blend "void glPolygonOffsetEXT GLfloat factor GLfloat bias")
-;;;(CFNC-texture "void glTexImage3DEXT GLenum target GLint level GLenum internalFormat GLsizei width GLsizei height GLsizei depth GLint border GLenum format GLenum type GLvoid* pixels")
-;;;(CFNC-texture "void glTexSubImage3DEXT GLenum target GLint level GLint xoffset GLint yoffset GLint zoffset GLsizei width GLsizei height GLsizei depth GLenum format GLenum type GLvoid* pixels")
-;;;(CFNC-texture "void glCopyTexSubImage3DEXT GLenum target GLint level GLint xoffset GLint yoffset GLint zoffset GLint x GLint y GLsizei width GLsizei height")
-;;;(CFNC-object "void glGenTexturesEXT GLsizei n GLuint* textures")
-;;;(CFNC-object "void glDeleteTexturesEXT GLsizei n GLuint* textures")
-;;;(CFNC-object "void glBindTextureEXT GLenum target GLuint texture")
-;(CFNC-object "void glPrioritizeTexturesEXT GLsizei n GLuint* textures GLclampf* priorities")
-;;;(CFNC-object "GLboolean glAreTexturesResidentEXT GLsizei n GLuint* textures GLboolean* residences")
-;;;(CFNC-object "GLboolean glIsTextureEXT GLuint texture")
-;;;(CFNC-vertex "void glVertexPointerEXT GLint size GLenum type GLsizei stride GLsizei count GLvoid* ptr")
-;;;(CFNC-vertex "void glNormalPointerEXT GLenum type GLsizei stride GLsizei count GLvoid* ptr")
-;;;(CFNC-vertex "void glColorPointerEXT GLint size GLenum type GLsizei stride GLsizei count GLvoid* ptr")
-;;;(CFNC-vertex "void glIndexPointerEXT GLenum type GLsizei stride GLsizei count GLvoid* ptr")
-;;;(CFNC-vertex "void glTexCoordPointerEXT GLint size GLenum type GLsizei stride GLsizei count GLvoid* ptr")
-;;;(CFNC-vertex "void glEdgeFlagPointerEXT GLsizei stride GLsizei count GLboolean* ptr")
-;;;(CFNC-vertex "void glGetPointervEXT GLenum pname void** [params]")
-;;;(CFNC-vertex "void glArrayElementEXT GLint i")
-;;;(CFNC-vertex "void glDrawArraysEXT GLenum mode GLint first GLsizei count")
-;;;(CFNC "void glBlendEquationEXT GLenum mode")
-;;;(CFNC "void glPointParameterfEXT GLenum pname GLfloat param")
-;;;(CFNC "void glPointParameterfvEXT GLenum pname GLfloat* params")
-;(CFNC "void glPointParameterfSGIS GLenum pname GLfloat param")
-;(CFNC "void glPointParameterfvSGIS GLenum pname GLfloat* params")
-;;;(CFNC "void glColorTableEXT GLenum target GLenum internalformat GLsizei width GLenum format GLenum type GLvoid* table")
-;;;(CFNC "void glColorSubTableEXT GLenum target GLsizei start GLsizei count GLenum format GLenum type GLvoid* data")
-;(CFNC "void glGetColorTableEXT GLenum target GLenum format GLenum type GLvoid* [table]")
-;;;(CFNC "void glGetColorTableParameterfvEXT GLenum target GLenum pname GLfloat* [params]")
-;;;(CFNC "void glGetColorTableParameterivEXT GLenum target GLenum pname GLint* [params]")
-;(CFNC "void glWindowPos2iMESA GLint x GLint y")
-;(CFNC "void glWindowPos2sMESA GLshort x GLshort y")
-;(CFNC "void glWindowPos2fMESA GLfloat x GLfloat y")
-;(CFNC "void glWindowPos2dMESA GLdouble x GLdouble y")
-;(CFNC "void glWindowPos2ivMESA GLint* p")
-;(CFNC "void glWindowPos2svMESA GLshort* p")
-;(CFNC "void glWindowPos2fvMESA GLfloat* p")
-;(CFNC "void glWindowPos2dvMESA GLdouble* p")
-;(CFNC "void glWindowPos3iMESA GLint x GLint y GLint z")
-;(CFNC "void glWindowPos3sMESA GLshort x GLshort y GLshort z")
-;(CFNC "void glWindowPos3fMESA GLfloat x GLfloat y GLfloat z")
-;(CFNC "void glWindowPos3dMESA GLdouble x GLdouble y GLdouble z")
-;(CFNC "void glWindowPos3ivMESA GLint* p")
-;(CFNC "void glWindowPos3svMESA GLshort* p")
-;(CFNC "void glWindowPos3fvMESA GLfloat* p")
-;(CFNC "void glWindowPos3dvMESA GLdouble* p")
-;(CFNC "void glWindowPos4iMESA GLint x GLint y GLint z GLint w")
-;(CFNC "void glWindowPos4sMESA GLshort x GLshort y GLshort z GLshort w")
-;(CFNC "void glWindowPos4fMESA GLfloat x GLfloat y GLfloat z GLfloat w")
-;(CFNC "void glWindowPos4dMESA GLdouble x GLdouble y GLdouble z GLdouble w")
-;(CFNC "void glWindowPos4ivMESA GLint* p")
-;(CFNC "void glWindowPos4svMESA GLshort* p")
-;(CFNC "void glWindowPos4fvMESA GLfloat* p")
-;(CFNC "void glWindowPos4dvMESA GLdouble* p")
-;(CFNC "void glResizeBuffersMESA void")
(CINT-X "GLX_USE_GL")
(CINT-X "GLX_BUFFER_SIZE")
@@ -650,31 +587,9 @@
;(CINT-X "GLX_DEPTH_BUFFER_BIT")
;(CINT-X "GLX_STENCIL_BUFFER_BIT")
;(CINT-X "GLX_ACCUM_BUFFER_BIT")
-;(CINT-X "GLX_X_VISUAL_TYPE_EXT")
-;(CINT-X "GLX_TRANSPARENT_TYPE_EXT")
-;(CINT-X "GLX_TRANSPARENT_INDEX_VALUE_EXT")
-;(CINT-X "GLX_TRANSPARENT_RED_VALUE_EXT")
-;(CINT-X "GLX_TRANSPARENT_GREEN_VALUE_EXT")
-;(CINT-X "GLX_TRANSPARENT_BLUE_VALUE_EXT")
-;(CINT-X "GLX_TRANSPARENT_ALPHA_VALUE_EXT")
-;(CINT-X "GLX_TRUE_COLOR_EXT")
-;(CINT-X "GLX_DIRECT_COLOR_EXT")
-;(CINT-X "GLX_PSEUDO_COLOR_EXT")
-;(CINT-X "GLX_STATIC_COLOR_EXT")
-;(CINT-X "GLX_GRAY_SCALE_EXT")
-;(CINT-X "GLX_STATIC_GRAY_EXT")
-;(CINT-X "GLX_NONE_EXT")
-;(CINT-X "GLX_TRANSPARENT_RGB_EXT")
-;(CINT-X "GLX_TRANSPARENT_INDEX_EXT")
-;;(CINT-X "GLX_VISUAL_CAVEAT_EXT")
-;;(CINT-X "GLX_SLOW_VISUAL_EXT")
-;(CINT-X "GLX_NON_CONFORMANT_VISUAL_EXT")
(CINT-X "GLX_VENDOR")
(CINT-X "GLX_VERSION")
(CINT-X "GLX_EXTENSIONS")
-;(CINT-X "GLX_SHARE_CONTEXT_EXT")
-;(CINT-X "GLX_VISUAL_ID_EXT")
-;(CINT-X "GLX_SCREEN_EXT")
(CINT "GL_FALSE")
(CINT "GL_TRUE")
(CINT "GL_BYTE")
@@ -1354,100 +1269,6 @@
(CINT-multi "GL_ACTIVE_TEXTURE_ARB")
(CINT-multi "GL_CLIENT_ACTIVE_TEXTURE_ARB")
(CINT-multi "GL_MAX_TEXTURE_UNITS_ARB")
-;(CINT "GL_CONSTANT_COLOR_EXT")
-;(CINT "GL_ONE_MINUS_CONSTANT_COLOR_EXT")
-;(CINT "GL_CONSTANT_ALPHA_EXT")
-;(CINT "GL_ONE_MINUS_CONSTANT_ALPHA_EXT")
-;(CINT "GL_BLEND_COLOR_EXT")
-;(CINT-blend "GL_POLYGON_OFFSET_EXT")
-;(CINT-blend "GL_POLYGON_OFFSET_FACTOR_EXT")
-;(CINT-blend "GL_POLYGON_OFFSET_BIAS_EXT")
-;(CINT-texture "GL_PACK_SKIP_IMAGES_EXT")
-;(CINT-texture "GL_PACK_IMAGE_HEIGHT_EXT")
-;(CINT-texture "GL_UNPACK_SKIP_IMAGES_EXT")
-;(CINT-texture "GL_UNPACK_IMAGE_HEIGHT_EXT")
-;(CINT-texture "GL_TEXTURE_3D_EXT")
-;(CINT-texture "GL_PROXY_TEXTURE_3D_EXT")
-;(CINT-texture "GL_TEXTURE_DEPTH_EXT")
-;(CINT-texture "GL_TEXTURE_WRAP_R_EXT")
-;(CINT-texture "GL_MAX_3D_TEXTURE_SIZE_EXT")
-;(CINT-texture "GL_TEXTURE_3D_BINDING_EXT")
-;(CINT-object "GL_TEXTURE_PRIORITY_EXT")
-;(CINT-object "GL_TEXTURE_RESIDENT_EXT")
-;(CINT-object "GL_TEXTURE_1D_BINDING_EXT")
-;(CINT-object "GL_TEXTURE_2D_BINDING_EXT")
-;(CINT-rescale "GL_RESCALE_NORMAL_EXT")
-;(CINT-vertex "GL_VERTEX_ARRAY_EXT")
-;(CINT-vertex "GL_NORMAL_ARRAY_EXT")
-;(CINT-vertex "GL_COLOR_ARRAY_EXT")
-;(CINT-vertex "GL_INDEX_ARRAY_EXT")
-;(CINT-vertex "GL_TEXTURE_COORD_ARRAY_EXT")
-;(CINT-vertex "GL_EDGE_FLAG_ARRAY_EXT")
-;(CINT-vertex "GL_VERTEX_ARRAY_SIZE_EXT")
-;(CINT-vertex "GL_VERTEX_ARRAY_TYPE_EXT")
-;(CINT-vertex "GL_VERTEX_ARRAY_STRIDE_EXT")
-;(CINT-vertex "GL_VERTEX_ARRAY_COUNT_EXT")
-;(CINT-vertex "GL_NORMAL_ARRAY_TYPE_EXT")
-;(CINT-vertex "GL_NORMAL_ARRAY_STRIDE_EXT")
-;(CINT-vertex "GL_NORMAL_ARRAY_COUNT_EXT")
-;(CINT-vertex "GL_COLOR_ARRAY_SIZE_EXT")
-;(CINT-vertex "GL_COLOR_ARRAY_TYPE_EXT")
-;(CINT-vertex "GL_COLOR_ARRAY_STRIDE_EXT")
-;(CINT-vertex "GL_COLOR_ARRAY_COUNT_EXT")
-;(CINT-vertex "GL_INDEX_ARRAY_TYPE_EXT")
-;(CINT-vertex "GL_INDEX_ARRAY_STRIDE_EXT")
-;(CINT-vertex "GL_INDEX_ARRAY_COUNT_EXT")
-;(CINT-vertex "GL_TEXTURE_COORD_ARRAY_SIZE_EXT")
-;(CINT-vertex "GL_TEXTURE_COORD_ARRAY_TYPE_EXT")
-;(CINT-vertex "GL_TEXTURE_COORD_ARRAY_STRIDE_EXT")
-;(CINT-vertex "GL_TEXTURE_COORD_ARRAY_COUNT_EXT")
-;(CINT-vertex "GL_EDGE_FLAG_ARRAY_STRIDE_EXT")
-;(CINT-vertex "GL_EDGE_FLAG_ARRAY_COUNT_EXT")
-;(CINT-vertex "GL_VERTEX_ARRAY_POINTER_EXT")
-;(CINT-vertex "GL_NORMAL_ARRAY_POINTER_EXT")
-;(CINT-vertex "GL_COLOR_ARRAY_POINTER_EXT")
-;(CINT-vertex "GL_INDEX_ARRAY_POINTER_EXT")
-;(CINT-vertex "GL_TEXTURE_COORD_ARRAY_POINTER_EXT")
-;(CINT-vertex "GL_EDGE_FLAG_ARRAY_POINTER_EXT")
-;(CINT "GL_CLAMP_TO_EDGE_SGIS")
-;(CINT "GL_FUNC_ADD_EXT")
-;(CINT "GL_MIN_EXT")
-;(CINT "GL_MAX_EXT")
-;(CINT "GL_BLEND_EQUATION_EXT")
-;(CINT "GL_FUNC_SUBTRACT_EXT")
-;(CINT "GL_FUNC_REVERSE_SUBTRACT_EXT")
-;(CINT "GL_POINT_SIZE_MIN_EXT")
-;(CINT "GL_POINT_SIZE_MAX_EXT")
-;(CINT "GL_POINT_FADE_THRESHOLD_SIZE_EXT")
-;(CINT "GL_DISTANCE_ATTENUATION_EXT")
-;(CINT "GL_TABLE_TOO_LARGE_EXT")
-;(CINT "GL_COLOR_TABLE_FORMAT_EXT")
-;(CINT "GL_COLOR_TABLE_WIDTH_EXT")
-;(CINT "GL_COLOR_TABLE_RED_SIZE_EXT")
-;(CINT "GL_COLOR_TABLE_GREEN_SIZE_EXT")
-;(CINT "GL_COLOR_TABLE_BLUE_SIZE_EXT")
-;(CINT "GL_COLOR_TABLE_ALPHA_SIZE_EXT")
-;(CINT "GL_COLOR_TABLE_LUMINANCE_SIZE_EXT")
-;(CINT "GL_COLOR_TABLE_INTENSITY_SIZE_EXT")
-;(CINT "GL_TEXTURE_INDEX_SIZE_EXT")
-;(CINT "GL_COLOR_INDEX1_EXT")
-;(CINT "GL_COLOR_INDEX2_EXT")
-;(CINT "GL_COLOR_INDEX4_EXT")
-;(CINT "GL_COLOR_INDEX8_EXT")
-;(CINT "GL_COLOR_INDEX12_EXT")
-;(CINT "GL_COLOR_INDEX16_EXT")
-;(CINT "GL_CLIP_VOLUME_CLIPPING_HINT_EXT")
-;;(CINT "GL_ARRAY_ELEMENT_LOCK_FIRST_EXT")
-;;(CINT "GL_ARRAY_ELEMENT_LOCK_COUNT_EXT")
-;;(CINT "GL_OCCLUSION_TEST_HP")
-;;(CINT "GL_OCCLUSION_TEST_RESULT_HP")
-;(CINT "GL_SHARED_TEXTURE_PALETTE_EXT")
-;(CINT "GL_INCR_WRAP_EXT")
-;(CINT "GL_DECR_WRAP_EXT")
-;(CINT "GL_NORMAL_MAP_NV")
-;;(CINT "GL_DOT3_RGB_EXT")
-;;(CINT "GL_DOT3_RGBA_EXT")
-;(CINT "GL_REFLECTION_MAP_NV")
(CINT "GLU_FALSE")
(CINT "GLU_TRUE")
;(CINT "GLU_VERSION_1_1")
@@ -1464,29 +1285,17 @@
(CINT "GLU_NURBS_ERROR")
(CINT "GLU_ERROR")
(CINT "GLU_NURBS_BEGIN")
-(CINT "GLU_NURBS_BEGIN_EXT")
(CINT "GLU_NURBS_VERTEX")
-(CINT "GLU_NURBS_VERTEX_EXT")
(CINT "GLU_NURBS_NORMAL")
-(CINT "GLU_NURBS_NORMAL_EXT")
(CINT "GLU_NURBS_COLOR")
-(CINT "GLU_NURBS_COLOR_EXT")
(CINT "GLU_NURBS_TEXTURE_COORD")
-(CINT "GLU_NURBS_TEX_COORD_EXT")
(CINT "GLU_NURBS_END")
-(CINT "GLU_NURBS_END_EXT")
(CINT "GLU_NURBS_BEGIN_DATA")
-(CINT "GLU_NURBS_BEGIN_DATA_EXT")
(CINT "GLU_NURBS_VERTEX_DATA")
-(CINT "GLU_NURBS_VERTEX_DATA_EXT")
(CINT "GLU_NURBS_NORMAL_DATA")
-(CINT "GLU_NURBS_NORMAL_DATA_EXT")
(CINT "GLU_NURBS_COLOR_DATA")
-(CINT "GLU_NURBS_COLOR_DATA_EXT")
(CINT "GLU_NURBS_TEXTURE_COORD_DATA")
-(CINT "GLU_NURBS_TEX_COORD_DATA_EXT")
(CINT "GLU_NURBS_END_DATA")
-(CINT "GLU_NURBS_END_DATA_EXT")
(CINT "GLU_NURBS_ERROR1")
(CINT "GLU_NURBS_ERROR2")
(CINT "GLU_NURBS_ERROR3")
@@ -1533,15 +1342,10 @@
(CINT "GLU_U_STEP")
(CINT "GLU_V_STEP")
(CINT "GLU_NURBS_MODE")
-(CINT "GLU_NURBS_MODE_EXT")
(CINT "GLU_NURBS_TESSELLATOR")
-(CINT "GLU_NURBS_TESSELLATOR_EXT")
(CINT "GLU_NURBS_RENDERER")
-(CINT "GLU_NURBS_RENDERER_EXT")
(CINT "GLU_OBJECT_PARAMETRIC_ERROR")
-(CINT "GLU_OBJECT_PARAMETRIC_ERROR_EXT")
(CINT "GLU_OBJECT_PATH_LENGTH")
-(CINT "GLU_OBJECT_PATH_LENGTH_EXT")
(CINT "GLU_PATH_LENGTH")
(CINT "GLU_PARAMETRIC_ERROR")
(CINT "GLU_DOMAIN_DISTANCE")
diff --git a/tools/gtest.scm b/tools/gtest.scm
new file mode 100644
index 0000000..b0693fe
--- /dev/null
+++ b/tools/gtest.scm
@@ -0,0 +1,128 @@
+;;; glistener test suite
+;;; see gcall.c
+
+(set-prompt *g2* "!!")
+
+(define (simple-test expr rtn)
+ (clear *g2*)
+ (let ((bpos (cursor-position *g2*))
+ (len (length expr)))
+ (append-text *g2* expr)
+
+ (if (char-whitespace? (expr 0))
+ (begin
+ (set-cursor-position *g2* bpos)
+ (evaluate *g2*)))
+
+ (do ((i bpos (+ i 1)))
+ ((> i (+ bpos len)))
+ (set-cursor-position *g2* i)
+ (let ((result (evaluate *g2*)))
+ (if (not (string=? result rtn))
+ (append-text *g1* (format #f "~%~S, cursor at ~D:~%~S~%~S~%" expr i result rtn)))))))
+
+(simple-test "(+ 1 2)" "(+ 1 2)\n3")
+(simple-test "#\\a" "#\\a\n#\\a")
+(simple-test "#\\x12" "#\\x12\n#\\x12")
+(simple-test "123" "123\n123")
+(simple-test "1.5+i" "1.5+i\n1.5+1i")
+(simple-test "\"asdf\"" "\"asdf\"\n\"asdf\"")
+(simple-test "\"as df\"" "\"as df\"\n\"as df\"")
+(simple-test "1/2" "1/2\n1/2")
+(simple-test "'(+ 1 2)" "'(+ 1 2)\n(+ 1 2)")
+(simple-test "\"12;34\"" "\"12;34\"\n\"12;34\"")
+(simple-test "#(1 2)" "#(1 2)\n#(1 2)")
+(simple-test ":hi" ":hi\n:hi")
+(simple-test "\"\"" "\"\"\n\"\"")
+(simple-test "()" "()\n()")
+(simple-test "( )" "( )\n()")
+(simple-test "'()" "'()\n()")
+(simple-test "(eqv? #i3/5 #i3/5)" "(eqv? #i3/5 #i3/5)\n#t")
+(simple-test "*gc-stats*" "*gc-stats*\n#f")
+(simple-test "#<eof>" "#<eof>\n#<eof>")
+(simple-test "(cons 1 2)" "(cons 1 2)\n(1 . 2)")
+(simple-test "(+ 1 (* 2 3))" "(+ 1 (* 2 3))\n7")
+(simple-test "(char? #\\a)" "(char? #\\a)\n#t")
+(simple-test "(char? #\\))" "(char? #\\))\n#t")
+(simple-test "(char? #\\()" "(char? #\\()\n#t")
+(simple-test "(char? #\\;)" "(char? #\\;)\n#t")
+(simple-test "(char? #\\\")" "(char? #\\\")\n#t")
+(simple-test "(char? #\\#)" "(char? #\\#)\n#t")
+(simple-test "#2d((1 2) (3 4))" "#2d((1 2) (3 4))\n#2D((1 2) (3 4))")
+(simple-test "`(1 2)" "`(1 2)\n(1 2)")
+(simple-test "((if (< 3 2) * +) 3 2)" "((if (< 3 2) * +) 3 2)\n5")
+(simple-test "(if (char? #\\\") 0 1)" "(if (char? #\\\") 0 1)\n0")
+(simple-test " (+ 1 2) " "(+ 1 2)\n3")
+(simple-test "(+ #| 1 2 3 |# 4 5)" "(+ #| 1 2 3 |# 4 5)\n9")
+(simple-test "(char? \"\")" "(char? \"\")\n#f")
+(simple-test "(equal? \"\" \"\")" "(equal? \"\" \"\")\n#t")
+(simple-test "\"\"" "\"\"\n\"\"")
+(simple-test "(#||#)" "(#||#)\n()")
+(simple-test "(#|()|#)" "(#|()|#)\n()")
+(simple-test "(#|#\\a|#)" "(#|#\\a|#)\n()")
+(simple-test "(#|\"\"|#)" "(#|\"\"|#)\n()")
+(simple-test "(+ 1 #|\"\"|# 2 3)" "(+ 1 #|\"\"|# 2 3)\n6")
+(simple-test "(char?\n #\\a\n)" "(char?\n #\\a\n)\n#t")
+(simple-test "(+ 1 2 ; a test\n3)" "(+ 1 2 ; a test\n3)\n6")
+(simple-test "(+ 1 2 #| a test\n|#3)" "(+ 1 2 #| a test\n|#3)\n6")
+(simple-test "\"a;b\"" "\"a;b\"\n\"a;b\"")
+(simple-test "\"a)b\"" "\"a)b\"\n\"a)b\"")
+(simple-test "\"a(b\"" "\"a(b\"\n\"a(b\"")
+(simple-test "'(a #|foo|||||# b)" "'(a #|foo|||||# b)\n(a b)")
+(simple-test "(let ((@,@'[1] 1) (\\,| 2)) (+ @,@'[1] \\,|))" "(let ((@,@'[1] 1) (\\,| 2)) (+ @,@'[1] \\,|))\n3")
+(simple-test "(length \";\")" "(length \";\")\n1")
+(simple-test "(cons \";\" 1)" "(cons \";\" 1)\n(\";\" . 1)")
+(simple-test "(length \")\")" "(length \")\")\n1")
+(simple-test "\"a\\\"b\"" "\"a\\\"b\"\n\"a\\\"b\"")
+(simple-test "(length \"#|\")" "(length \"#|\")\n2")
+(simple-test "(length \"(\")" "(length \"(\")\n1") ; works outside this test??
+(simple-test "(length '(#xA\"\"#(1)))" "(length '(#xA\"\"#(1)))\n3")
+(simple-test "(+ #| 1 ( 2 3 |# 4 5)" "(+ #| 1 ( 2 3 |# 4 5)\n9")
+(simple-test "(+ #| 1 ; 2 3 |# 4 5)" "(+ #| 1 ; 2 3 |# 4 5)\n9")
+(simple-test "(map /\"\"'(123))" "(map /\"\"'(123))\n()")
+(simple-test "(eq? ()#())" "(eq? ()#())\n#f")
+(simple-test "(eq? \"\"1)" "(eq? \"\"1)\n#f")
+(simple-test "(eq? #()#())" "(eq? #()#())\n#f")
+(simple-test "#(#(1) #((1 2)))" "#(#(1) #((1 2)))\n#(#(1) #((1 2)))")
+(simple-test "'''3" "'''3\n''3")
+
+(define (multi-test exprs pos rtn0 rtn1 rtn2)
+ (clear *g2*)
+ (let ((bpos (cursor-position *g2*))
+ (len (length exprs)))
+ (append-text *g2* exprs)
+
+ (set-cursor-position *g2* bpos)
+ (let ((result (evaluate *g2*)))
+ (if (not (string=? result rtn0))
+ (append-text *g1* (format #f "~%~S, cursor at ~D (pos: ~D): ~S~%" exprs bpos pos result))))
+
+ (do ((i (+ bpos 1) (+ i 1)))
+ ((> i (+ bpos len)))
+ (set-cursor-position *g2* i)
+ (let ((result (evaluate *g2*)))
+ (if (not (string=? result (if (< (- i bpos) pos) rtn1 rtn2)))
+ (append-text *g1* (format #f "~%~S, cursor at ~D (pos: ~D): ~S~%" exprs i pos result)))))))
+
+(multi-test "123 432" 4 "123 432\n123" "123\n123" "432\n432")
+(multi-test "123 #\\a" 4 "123 #\\a\n123" "123\n123" "#\\a\n#\\a")
+(multi-test "123 \"a\"" 4 "123 \"a\"\n123" "123\n123" "\"a\"\n\"a\"")
+(multi-test "(+ 1 2) 123" 9 "(+ 1 2) 123\n3" "(+ 1 2)\n3" "123\n123")
+(multi-test "(+ 1 2)123" 8 "(+ 1 2)123\n3" "(+ 1 2)\n3" "123\n123")
+(multi-test "(+ 1 2)(* 2 3)" 8 "(+ 1 2)(* 2 3)\n3" "(+ 1 2)\n3" "(* 2 3)\n6")
+
+
+
+;;; gtk_text_buffer_backspace -- try at start and make sure pos unchanged
+
+
+(define (completion-test text rtn)
+ (clear *g2*)
+ (append-text *g2* text)
+ (let ((result (complete *g2*)))
+ (if (not (string=? result rtn))
+ (append-text *g1* (format #f "~S -> ~S~%" text result)))))
+
+(completion-test "(trunc" "(truncate")
+(completion-test "\"card" "\"cardinal.snd\"")
+
diff --git a/tools/gtk-header-diffs b/tools/gtk-header-diffs
index 593d88f..7457f24 100755
--- a/tools/gtk-header-diffs
+++ b/tools/gtk-header-diffs
@@ -1,9 +1,14 @@
#!/bin/csh -f
-set gtkolddir = /home/bil/test/gtk+-2.5.0
-set gtknewdir = /home/bil/test/gtk+-2.5.1
-set pangoolddir = /home/bil/test/pango-1.5.2
-set pangonewdir = /home/bil/test/pango-1.5.2
+set gtkolddir = /home/bil/test/gtk+-3.19.2
+set gtknewdir = /home/bil/test/gtk+-3.19.3
+set pangoolddir = /home/bil/test/pango-1.36.8
+set pangonewdir = /home/bil/test/pango-1.36.8
+set glibolddir = /home/bil/test/glib-2.39.3
+set glibnewdir = /home/bil/test/glib-2.39.3
+set cairoolddir = /home/bil/test/cairo-1.14.0
+set caironewdir = /home/bil/test/cairo-1.14.0
+
set curdir = $cwd
date > $curdir/hi
@@ -39,3 +44,53 @@ foreach file (*.h)
endif
end
+chdir $glibnewdir/glib
+foreach file (*.h)
+ echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+ if (-e $glibolddir/glib/$file) then
+ diff -bcw $glibolddir/glib/$file $glibnewdir/glib/$file >> $curdir/hi
+ else
+ echo '(new)' >> $curdir/hi
+ endif
+end
+
+chdir $glibnewdir/gio
+foreach file (*.h)
+ echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+ if (-e $glibolddir/gio/$file) then
+ diff -bcw $glibolddir/gio/$file $glibnewdir/gio/$file >> $curdir/hi
+ else
+ echo '(new)' >> $curdir/hi
+ endif
+end
+
+chdir $glibnewdir/gobject
+foreach file (*.h)
+ echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+ if (-e $glibolddir/gobject/$file) then
+ diff -bcw $glibolddir/gobject/$file $glibnewdir/gobject/$file >> $curdir/hi
+ else
+ echo '(new)' >> $curdir/hi
+ endif
+end
+
+chdir $glibnewdir/gmodule
+foreach file (*.h)
+ echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+ if (-e $glibolddir/gmodule/$file) then
+ diff -bcw $glibolddir/gmodule/$file $glibnewdir/gmodule/$file >> $curdir/hi
+ else
+ echo '(new)' >> $curdir/hi
+ endif
+end
+
+chdir $caironewdir/src
+foreach file (*.h)
+ echo '--------------------------------- ' $file ' --------------------------------' >> $curdir/hi
+ if (-e $cairoolddir/src/$file) then
+ diff -bcw $cairoolddir/src/$file $caironewdir/src/$file >> $curdir/hi
+ else
+ echo '(new)' >> $curdir/hi
+ endif
+end
+
diff --git a/tools/make-config-pc.rb b/tools/make-config-pc.rb
new file mode 100755
index 0000000..fdcd04d
--- /dev/null
+++ b/tools/make-config-pc.rb
@@ -0,0 +1,33 @@
+#! /usr/bin/env ruby
+
+# ruby make-config-pc.rb > ruby.pc
+
+require "rbconfig"
+if RUBY_VERSION < "1.9"
+ include Config
+else
+ include RbConfig
+end
+version = CONFIG["ruby_version"]
+arch = CONFIG["arch"]
+rubyhdrdir = CONFIG["rubyhdrdir"]
+if rubyhdrdir.nil?
+ rubyhdrdir = CONFIG["rubylibdir"]
+else
+ rubyhdrdir.chomp("/")
+end
+dldflags = CONFIG["DLDFLAGS"]
+librubyarg = CONFIG["LIBRUBYARG"]
+libs = CONFIG["LIBS"]
+rubylibdir = CONFIG["libdir"]
+
+print <<OUT
+Name: Ruby
+Description: Object Oriented Script Language
+Version: #{version}
+URL: http://www.ruby-lang.org
+Cflags: -I#{rubyhdrdir}/#{arch} -I#{rubyhdrdir}
+# Libs: #{dldflags} #{librubyarg} #{libs}
+Libs: -L#{rubylibdir} #{dldflags} #{librubyarg} #{libs}
+Requires:
+OUT
diff --git a/tools/make-index.scm b/tools/make-index.scm
index a827dcc..40551e0 100644
--- a/tools/make-index.scm
+++ b/tools/make-index.scm
@@ -1,320 +1,88 @@
;;; make-index.scm translated from index.cl
+;;; run this -noinit so that loads in ~/.snd_s7 don't confuse matters
-;(set! (hook-functions *load-hook*) (list (lambda (filename) (format #t "loading ~S~%" filename))))
-(set! (hook-functions *unbound-variable-hook*) '())
+(if (provided? 'pure-s7)
+ (define (char-ci=? . chars) (apply char=? (map char-upcase chars))))
+;(set! (hook-functions *load-hook*) (list (lambda (hook) (format #t "loading ~S~%" (hook 'name)))))
+(set! (hook-functions *unbound-variable-hook*) ())
-;;; --------------------------------------------------------------------------------
-;;; get indexer.data
-
-(load "ws.scm")
- ;(load "clm23.scm")
- ;(load "edit123.scm")
- ;(load "snd7.scm")
-(load "snd11.scm")
- ;(load "snd6.scm")
-(load "snd9.scm")
- ;(load "snd8.scm")
-(load "snd10.scm")
-(load "analog-filter.scm")
- ; (load "new-backgrounds.scm")
-(load "animals.scm")
- ; (load "new-effects.scm")
-(load "autosave.scm")
-(load "noise.scm")
-(load "binary-io.scm")
- ;(load "bess1.scm")
-(load "nrev.scm")
- ;(load "bess.scm")
-(load "numerics.scm")
-(load "big-gens.scm")
- ;(load "oscope.scm")
-(load "bird.scm")
-(load "clean.scm")
-(load "peak-phases.scm")
-(load "piano.scm")
-(load "clm-ins.scm")
-(load "play.scm")
-(load "dlocsig.scm")
-(load "poly.scm")
-(load "draw.scm")
- ;(load "popup.scm")
-(load "dsp.scm")
-(load "prc95.scm")
-(load "pretty-print.scm")
- ; (load "edit-menu.scm")
-(load "primes.scm")
- ; (load "effects-utils.scm")
-(load "pvoc.scm")
-(load "enved.scm")
-(load "rgb.scm")
-(load "env.scm")
-(load "rtio.scm")
-(load "examp.scm")
-(load "rubber.scm")
-(load "expandn.scm")
- ;(load "s7-slib-init.scm")
-(load "extensions.scm")
- ;(load "s7test.scm")
-(load "fade.scm")
-(load "selection.scm")
- ; (load "fft-menu.scm")
-(load "singer.scm")
- ; (load "fmv.scm")
-(load "frame.scm")
-(load "freeverb.scm")
-(load "fullmix.scm")
-(load "generators.scm")
-(load "grani.scm")
- ; (load "gtk-effects.scm")
-(load "snddiff.scm")
- ; (load "gtk-effects-utils.scm")
- ; (load "snd-gl.scm")
- ; (load "gtk-popup.scm")
- ; (load "snd-gtk.scm")
-(load "hooks.scm")
- ;(load "sndlib-ws.scm")
-(load "index.scm")
- ; (load "snd-motif.scm")
-(load "jcrev.scm")
- ;(load "snd-test.scm")
-(load "jcvoi.scm")
-(load "sndwarp.scm")
-
- ; (load "kmenu.scm")
-
- ; (load "special-menu.scm")
-(load "maraca.scm")
-(load "spectr.scm")
- ; (load "marks-menu.scm")
-(load "spokenword.scm")
-(load "marks.scm")
-(load "stochastic.scm")
-(load "maxf.scm")
-(load "strad.scm")
- ; (load "misc.scm")
-(load "mixer.scm")
-(load "v.scm")
-(load "mix.scm")
-(load "moog.scm")
- ; (load "xm-enved.scm")
-(load "musglyphs.scm")
-(load "zip.scm")
-(load "nb.scm")
+(define scheme-variable-names
+ (let ((h (make-hash-table)))
+ (for-each
+ (lambda (name)
+ (set! (h name) #t))
+ (list "after-graph-hook" "lisp-graph-hook" "before-transform-hook" "mix-release-hook" "stop-playing-channel-hook" "save-hook" "mus-error-hook"
+ "mouse-enter-graph-hook" "mouse-leave-graph-hook" "open-raw-sound-hook" "select-channel-hook" "after-open-hook" "close-hook" "drop-hook" "update-hook"
+ "just-sounds-hook" "mark-click-hook" "mark-drag-hook" "name-click-hook" "open-hook" "help-hook"
+ "output-comment-hook" "play-hook" "snd-error-hook" "snd-warning-hook" "start-playing-hook" "stop-playing-hook"
+ "stop-playing-region-hook" "mouse-enter-listener-hook" "mouse-leave-listener-hook" "window-property-changed-hook" "select-sound-hook"
+ "print-hook" "exit-hook" "during-open-hook" "transform-hook" "mouse-enter-label-hook" "mouse-leave-label-hook" "initial-graph-hook"
+ "graph-hook" "key-press-hook" "mouse-drag-hook" "mouse-press-hook" "enved-hook" "read-hook" "mouse-click-hook" "new-widget-hook"
+ "mark-hook" "previous-files-select-hook" "dac-hook" "stop-dac-hook" "stop-playing-selection-hook" "after-apply-controls-hook"
+ "draw-mark-hook" "bad-header-hook" "save-state-hook" "new-sound-hook" "color-hook" "orientation-hook" "listener-click-hook"
+ "mix-click-hook" "after-save-state-hook" "mouse-enter-text-hook" "mouse-leave-text-hook" "mix-drag-hook"
+ "start-playing-selection-hook" "selection-changed-hook" "*current-sound*"
+ "before-save-state-hook" "after-save-as-hook" "after-transform-hook" "before-save-as-hook"))
+ h))
-(let ()
- (define (report-places)
- (let ((names ())
- (places ()))
-
- (define (where-is func)
- (let* ((e (procedure-environment func))
- (binding (and (pair? e)
- (pair? (car e))
- (assoc '__func__ (car e))))
- (addr (and (pair? binding)
- (cdr binding))))
- (if (pair? addr)
- (cadr addr)
- #f)))
-
- (define (apropos-1 alist)
- (for-each
- (lambda (binding)
- (let ((symbol (car binding))
- (value (cdr binding)))
- (if (procedure? value)
- (let ((file (where-is value)))
- (if (and file
- (not (string=? file "~/.snd_s7"))
- (not (string=? file "/home/bil/.snd_s7"))
- (not (string=? file "t.scm"))
- (not (string=? file "/home/bil/cl/t.scm"))
- )
- (begin
- (set! names (cons (cons symbol file) names))
- (if (not (member file places))
- (set! places (cons file places)))))))))
- alist))
-
- ;; handle the main macros by hand
- (for-each
- (lambda (symbol-and-file)
- (let ((symbol (car symbol-and-file))
- (file (cadr symbol-and-file)))
- (set! names (cons (cons symbol file) names))
- (if (not (member file places))
- (set! places (cons file places)))))
- (list
- (list 'with-sound "ws.scm")
- (list 'with-mixed-sound "ws.scm")
- (list 'with-full-sound "ws.scm")
- (list 'with-threaded-sound "ws.scm")
- (list 'with-temp-sound "ws.scm")
- (list 'with-marked-sound "ws.scm")
- (list 'with-simple-sound "ws.scm")
- (list 'sound-let "ws.scm")
- (list 'def-clm-struct "ws.scm")
- (list 'definstrument "ws.scm")
- (list 'defgenerator "generators.scm")
- ))
-
- ;; and some of the main variables
- (for-each
- (lambda (symbol-and-file)
- (let ((symbol (car symbol-and-file))
- (file (cadr symbol-and-file)))
- (set! names (cons (cons symbol file) names))
- (if (not (member file places))
- (set! places (cons file places)))))
-
- (list
- (list '*clm-srate* "ws.scm")
- (list '*clm-file-name* "ws.scm")
- (list '*clm-channels* "ws.scm")
- (list '*clm-data-format* "ws.scm")
- (list '*clm-header-type* "ws.scm")
- (list '*clm-verbose* "ws.scm")
- (list '*clm-play* "ws.scm")
- (list '*clm-statistics* "ws.scm")
- (list '*clm-reverb* "ws.scm")
- (list '*clm-reverb-channels* "ws.scm")
- (list '*clm-reverb-data* "ws.scm")
- (list '*clm-table-size* "ws.scm")
- (list '*clm-file-buffer-size* "ws.scm")
- (list '*clm-locsig-type* "ws.scm")
- (list '*clm-clipped* "ws.scm")
- (list '*clm-array-print-length* "ws.scm")
- (list '*clm-player* "ws.scm")
- (list '*clm-notehook* "ws.scm")
- (list '*clm-with-sound-depth* "ws.scm")
- (list '*clm-default-frequency* "ws.scm")
-; (list '*clm-safety* "ws.scm")
- (list '*clm-delete-reverb* "ws.scm")
- (list '*clm-threads* "ws.scm")
- (list '*clm-output-safety* "ws.scm")
- (list '*to-snd* "ws.scm")
- (list '*clm-search-list* "ws.scm")
- (list '*definstrument-hook* "ws.scm")))
-
- (for-each
- (lambda (frame)
- (if (vector? frame)
- (let ((len (vector-length frame)))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (apropos-1 (frame i))))
- (apropos-1 frame)))
- (global-environment))
-
- (let ((name-len (length names))
- (file-len (length places)))
- (do ((i 0 (+ i 1)))
- ((= i file-len))
- (let* ((pos -1)
- (place (list-ref places i))
- (slen (length place)))
- (do ((k 0 (+ k 1)))
- ((= k slen))
- (if (char=? (string-ref place k) #\/)
- (set! pos k)))
- (if (> pos -1)
- (list-set! places i (substring place pos)))))
-
- (set! places (sort! places string<?))
- (set! names (sort! names (lambda (a b)
- (string<? (symbol->string (car a))
- (symbol->string (car b))))))
-
- (call-with-output-file "indexer.data"
- (lambda (p)
-
- (define (find-file name)
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ i 1)))
- ((= i file-len) (format #t "oops! ~A~%" name) 0)
- (if (string=? name (places i))
- (return i))))))
-
- (format p "#define AUTOLOAD_FILES ~D~%~%" file-len)
- (format p "static const char *autoload_files[AUTOLOAD_FILES] = {~% ")
- (do ((i 0 (+ i 1)))
- ((= i (- file-len 1)))
- (if (and (> i 0)
- (= (modulo i 6) 0))
- (format p "~S, ~% " (places i))
- (format p "~S, " (places i))))
- (format p "~S};~%~%" (places (- file-len 1)))
-
- (format p "#define AUTOLOAD_NAMES ~D~%~%" name-len)
- (format p "static const char *autoload_names[AUTOLOAD_NAMES] = {~% ")
- (do ((i 0 (+ i 1)))
- ((= i (- name-len 1)))
- (if (and (> i 0)
- (= (modulo i 4) 0))
- (format p "~S, ~% " (symbol->string (car (names i))))
- (format p "~S, " (symbol->string (car (names i))))))
- (format p "~S};~%~%" (symbol->string (car (names (- name-len 1)))))
-
- (format p "static int autoload_indices[AUTOLOAD_NAMES] = {~% ")
- (do ((i 0 (+ i 1)))
- ((= i (- name-len 1)))
- (if (and (> i 0)
- (= (modulo i 24) 0))
- (format p "~D, ~% " (find-file (cdr (names i))))
- (format p "~D, " (find-file (cdr (names i))))))
- (format p "~D};~%~%" (find-file (cdr (names (- name-len 1))))))))))
-
- (report-places))
+(define scheme-constant-names
+ (let ((h (make-hash-table)))
+ (for-each
+ (lambda (name)
+ (set! (h name) #t))
+ (list "mus-out-format" "mus-unsupported" "mus-next" "mus-aifc" "mus-riff" "mus-rf64" "mus-nist" "mus-raw" "mus-ircam" "mus-aiff" "mus-bicsf"
+ "mus-voc" "mus-svx" "mus-soundfont" "mus-unknown" "mus-bshort" "mus-lshort" "mus-mulaw" "mus-alaw" "mus-byte" "mus-ubyte"
+ "mus-bfloat" "mus-lfloat" "mus-bint" "mus-lint" "mus-bintn" "mus-lintn" "mus-b24int" "mus-l24int" "mus-bdouble" "mus-ldouble"
+ "mus-ubshort" "mus-ulshort" "mus-bdouble-unscaled" "mus-ldouble-unscaled" "mus-bfloat-unscaled" "mus-lfloat-unscaled"
+ "mus-audio-default"
+ "rectangular-window" "hann-window" "welch-window"
+ "parzen-window" "bartlett-window" "hamming-window" "blackman2-window" "blackman3-window" "blackman4-window" "exponential-window"
+ "riemann-window" "kaiser-window" "cauchy-window" "poisson-window" "gaussian-window" "tukey-window" "dolph-chebyshev-window"
+ "samaraki-window" "ultraspherical-window" "blackman5-window" "blackman6-window" "blackman7-window" "blackman8-window"
+ "blackman9-window" "blackman10-window" "rv2-window" "rv3-window" "rv4-window"
+ "zoom-focus-left" "zoom-focus-right" "zoom-focus-active" "zoom-focus-middle" "graph-once"
+ "graph-as-wavogram" "graph-as-sonogram" "graph-as-spectrogram" "cursor-cross" "cursor-line" "graph-lines" "graph-dots"
+ "graph-filled" "graph-dots-and-lines" "graph-lollipops" "x-axis-in-seconds" "x-axis-in-samples" "x-axis-in-beats" "x-axis-in-measures"
+ "x-axis-as-percentage" "show-all-axes" "show-all-axes-unlabelled" "show-no-axes" "show-x-axis" "show-x-axis-unlabelled"
+ "cursor-in-view" "cursor-on-left" "cursor-on-right" "cursor-in-middle" "keyboard-no-action" "fourier-transform"
+ "wavelet-transform" "haar-transform" "cepstrum" "hadamard-transform" "walsh-transform" "autocorrelation" "dont-normalize"
+ "normalize-by-channel" "normalize-by-sound" "normalize-globally" "current-edit-position" "channels-separate"
+ "channels-combined" "channels-superimposed" "speed-control-as-float" "speed-control-as-ratio" "speed-control-as-semitone"
+ "enved-amplitude" "enved-spectrum" "enved-srate" "envelope-linear" "envelope-exponential" "enved-add-point"
+ "enved-delete-point" "enved-move-point" "time-graph" "transform-graph" "lisp-graph" "copy-context" "cursor-context"
+ "selection-context" "mark-context" "mus-interp-all-pass" "mus-interp-bezier" "mus-interp-hermite" "mus-interp-lagrange"
+ "mus-interp-linear" "mus-interp-none" "mus-interp-sinusoidal"
+ "sync-none" "sync-all" "sync-by-sound"
+ ))
+ h))
+(define (without-dollar-sign str)
+ (if (char=? (string-ref str 0) #\$)
+ (substring str 1)
+ str))
-;;; --------------------------------------------------------------------------------
-;;; make-index
+(define (creation-date)
+ (strftime "%d-%b-%y %H:%M %Z" (localtime (current-time))))
(define (alphanumeric? c) (or (char-alphabetic? c) (char-numeric? c)))
-(defmacro incf (sym) `(let () (set! ,sym (+ ,sym 1)) ,sym))
-(defmacro decf (sym) `(let () (set! ,sym (- ,sym 1)) ,sym))
-(defmacro when (test . forms) `(if ,test (begin , at forms)))
-(defmacro push (val sym) `(let () (set! ,sym (cons ,val ,sym)) ,sym))
-(defmacro pop (sym) (let ((v (gensym))) `(let ((,v (car ,sym))) (set! ,sym (cdr ,sym)) ,v)))
(define (find-if pred l)
(cond ((null? l) #f)
((pred (car l)) (car l))
(else (find-if pred (cdr l)))))
-(define (string-downcase str)
- (let ((len (length str)))
- (do ((i 0 (+ i 1)))
- ((= i len) str)
- (set! (str i) (char-downcase (str i))))))
-
-
-(define array-length 4096)
-
-(define names (make-vector array-length #f))
-(define files (make-vector array-length #f))
-(define gfiles (make-vector array-length #f))
-(define generals (make-vector array-length #f))
-(define xrefs (make-vector array-length #f))
-(define topics (make-vector array-length #f))
-
-
(define* (make-ind name sortby topic file general indexed char)
(vector name sortby topic file general indexed char))
-(define ind-name (make-procedure-with-setter (lambda (obj) (obj 0)) (lambda (obj val) (set! (obj 0) val))))
-(define ind-sortby (make-procedure-with-setter (lambda (obj) (obj 1)) (lambda (obj val) (set! (obj 1) val))))
-(define ind-topic (make-procedure-with-setter (lambda (obj) (obj 2)) (lambda (obj val) (set! (obj 2) val))))
-(define ind-file (make-procedure-with-setter (lambda (obj) (obj 3)) (lambda (obj val) (set! (obj 3) val))))
-(define ind-general (make-procedure-with-setter (lambda (obj) (obj 4)) (lambda (obj val) (set! (obj 4) val))))
-(define ind-indexed (make-procedure-with-setter (lambda (obj) (obj 5)) (lambda (obj val) (set! (obj 5) val))))
-(define ind-char (make-procedure-with-setter (lambda (obj) (obj 6)) (lambda (obj val) (set! (obj 6) val))))
-
-(define (write-line line file)
- (format file "~A~%" line))
+(define-expansion (ind-name obj) `(vector-ref ,obj 0))
+(define-expansion (ind-sortby obj) `(vector-ref ,obj 1))
+(define-expansion (ind-topic obj) `(vector-ref ,obj 2))
+(define-expansion (ind-file obj) `(vector-ref ,obj 3))
+(define-expansion (ind-general obj) `(vector-ref ,obj 4))
+(define-expansion (ind-char obj) `(vector-ref ,obj 6))
+(define ind-indexed (dilambda (lambda (obj) (vector-ref obj 5)) (lambda (obj val) (vector-set! obj 5 val))))
(define (html-length str)
@@ -323,43 +91,54 @@
(length str)))
-(define* (checked-substring str start end)
- (let ((len (length str)))
- (if (>= start len)
- ""
- (if end
- (substring str start (min end len))
- (substring str start)))))
-
-
-(define* (remove item sequence count)
- (let* ((len (length sequence))
- (num (if (number? count) count len))
- (changed 0))
- (if (not (positive? num))
- sequence
- (let ((result '()))
- (do ((i 0 (+ i 1)))
- ((= i len))
- (if (or (>= changed num)
- (not (string-ci=? item (sequence i))))
- (set! result (cons (sequence i) result))
- (set! changed (+ changed 1))))
- (reverse result)))))
-
+(define (remove-all item sequence)
+ (map (lambda (x)
+ (if (eq? x item)
+ (values)
+ x))
+ sequence))
+
+(define (remove-one item sequence)
+ (let ((got-it #f))
+ (map (lambda (x)
+ (if (and (not got-it)
+ (eq? x item))
+ (begin
+ (set! got-it #t)
+ (values))
+ x))
+ sequence)))
+
+#|
+(define (count-table commands)
+ (do ((count 0 (+ count 1))
+ (c (memq 'table commands) (memq 'table (cdr c))))
+ ((not c) count)))
+;;; but sadly the for-each version below is faster.
+|#
+
+(define (count-table commands)
+ (let ((count 0))
+ (for-each
+ (lambda (c)
+ (if (eq? c 'table)
+ (set! count (+ count 1))))
+ commands)
+ count))
-(define (count str strs)
- (do ((pos (string-ci-list-position str strs 0) (string-ci-list-position str strs (+ pos 1)))
- (count 0 (+ count 1)))
- ((not pos) count)))
(define (string</* a b)
(and (not (= (length b) 0))
(or (= (length a) 0)
(string=? a b)
- (string<? (if (char=? (a 0) #\*) (substring a 1) a)
- (if (char=? (b 0) #\*) (substring b 1) b)))))
+ (if (char=? (string-ref a 0) #\*)
+ (if (char=? (string-ref b 0) #\*)
+ (string<? a b) ; both start with *
+ (string<? (substring a 1) b))
+ (if (char=? (string-ref b 0) #\*)
+ (string<? a (substring b 1))
+ (string<? a b)))))) ; neither starts with *
(define (clean-and-downcase-first-char str caps topic file)
@@ -372,18 +151,21 @@
"#"
(substring str 1 colonpos)
"\">"
- (substring str (+ 1 colonpos))
+ (substring str (+ colonpos 1))
"</a>")))
(make-ind :name line
:topic topic
:file file
- :sortby (string-downcase (substring str (+ 1 colonpos)))))
+ :sortby (string-downcase (substring str (+ colonpos 1)))))
(begin
(let ((def-pos (string-position " class=def" str)))
(when def-pos
- (set! str (string-append (checked-substring str 0 def-pos)
- (checked-substring str (+ def-pos 10))))))
+ ;(format #t "str: ~S, def-pos: ~A~%" str def-pos)
+ (set! str (string-append "<a "
+ (if (char=? (str (+ def-pos 10)) #\n)
+ (substring str (+ def-pos 10))
+ (values "name=" (substring str (+ def-pos 14))))))))
(let* ((line (string-append "<a href=\""
(or file "")
@@ -392,9 +174,9 @@
(ipos (string-position "<em" line)))
(when ipos
(let ((ispos (string-position "</em>" line)))
- (set! line (string-append (checked-substring line 0 ipos)
- (checked-substring line (+ ipos 14) ispos)
- (checked-substring line (+ ispos 5))))
+ (set! line (string-append (substring line 0 ipos)
+ (substring line (+ ipos 14) ispos)
+ (substring line (+ ispos 5))))
(if (not line)
(format #t "<em...> but no </em> for ~A~%" str))))
@@ -411,91 +193,47 @@
(string-position "</h1>" line start)
(string-position "</h3>" line start)
(string-position "</h4>" line start))))))
- (set! line (string-append (checked-substring line 0 hpos)
- (checked-substring line (+ hpos 4) hspos)
- (checked-substring line (+ hspos 5))))
+ (set! line (string-append (substring line 0 hpos)
+ (substring line (+ hpos 4) hspos)
+ (substring line (+ hspos 5))))
(if (not line)
(format #t "<hn> but no </hn> for ~A~%" str)))))
(letrec ((search-caps ; caps is the list of names with upper case chars from the make-index-1 invocation ("AIFF" for example)
(lambda (ln)
- (call-with-exit
- (lambda (return)
- (when caps
- (for-each
- (lambda (cap)
- (when (string-position cap ln)
- (return #t)))
- caps)))))))
- (when (not (search-caps line))
- ;; now the hard part -- find the first character of the >name< business and downcase it
- (let* ((bpos (char-position #\> line)))
- (set! (line (+ 1 bpos)) (char-downcase (line (+ 1 bpos)))))))
+ (and caps
+ (do ((cap caps (cdr cap)))
+ ((or (null? cap)
+ (string-position (car cap) ln))
+ (pair? cap)))))))
+ (if (not (search-caps line))
+ ;; find the first character of the >name< business and downcase it
+ (let ((bpos (char-position #\> line)))
+ (set! (line (+ bpos 1)) (char-downcase (line (+ bpos 1)))))))
(let ((bpos (char-position #\> line))
(epos (or (string-position "</a>" line)
+ (string-position "</em>" line)
(string-position "</A>" line))))
(make-ind :name line
:topic topic
:file file
- :sortby (string-downcase (checked-substring line (+ 1 bpos) epos))))))))
+ :sortby (string-downcase (substring line (+ bpos 1) epos))))))))
(define (create-general str file)
- (let* ((mid (char-position #\: str)))
+ (let ((mid (char-position #\: str)))
(make-ind :name (string-append "<a href=\""
(or file "")
"#"
- (checked-substring str 0 mid)
+ (substring str 0 mid)
"\"><b>"
- (checked-substring str (+ 1 mid))
+ (substring str (+ mid 1))
"</b></a>")
:topic #f
:file file
:general #t
- :sortby (string-downcase (checked-substring str (+ 1 mid))))))
-
-
-(define scheme-variable-names
- (list "after-graph-hook" "lisp-graph-hook" "before-transform-hook" "mix-release-hook" "stop-playing-channel-hook" "save-hook" "mus-error-hook"
- "mouse-enter-graph-hook" "mouse-leave-graph-hook" "open-raw-sound-hook" "select-channel-hook" "after-open-hook" "close-hook" "drop-hook" "update-hook"
- "just-sounds-hook" "mark-click-hook" "mark-drag-hook" "name-click-hook" "open-hook" "help-hook"
- "output-comment-hook" "play-hook" "snd-error-hook" "snd-warning-hook" "start-hook" "start-playing-hook" "stop-playing-hook"
- "stop-playing-region-hook" "mouse-enter-listener-hook" "mouse-leave-listener-hook" "window-property-changed-hook" "select-sound-hook"
- "print-hook" "exit-hook" "output-name-hook" "during-open-hook" "transform-hook" "mouse-enter-label-hook" "mouse-leave-label-hook" "initial-graph-hook"
- "graph-hook" "key-press-hook" "mouse-drag-hook" "mouse-press-hook" "enved-hook" "read-hook" "mouse-click-hook" "new-widget-hook"
- "mark-hook" "previous-files-select-hook" "dac-hook" "stop-dac-hook" "stop-playing-selection-hook" "after-apply-controls-hook"
- "draw-mark-hook" "bad-header-hook" "save-state-hook" "new-sound-hook" "color-hook" "orientation-hook" "listener-click-hook"
- "mix-click-hook" "after-save-state-hook" "mouse-enter-text-hook" "mouse-leave-text-hook" "optimization-hook" "mix-drag-hook"
- "start-playing-selection-hook" "recorder-file-hook" "selection-changed-hook" "*current-sound*"
- "before-save-state-hook" "after-save-as-hook" "after-transform-hook" "before-save-as-hook"))
-
-
-(define scheme-constant-names
- (list "mus-out-format" "mus-unsupported" "mus-next" "mus-aifc" "mus-riff" "mus-rf64" "mus-nist" "mus-raw" "mus-ircam" "mus-aiff" "mus-bicsf"
- "mus-voc" "mus-svx" "mus-soundfont" "mus-unknown" "mus-bshort" "mus-lshort" "mus-mulaw" "mus-alaw" "mus-byte" "mus-ubyte"
- "mus-bfloat" "mus-lfloat" "mus-bint" "mus-lint" "mus-bintn" "mus-lintn" "mus-b24int" "mus-l24int" "mus-bdouble" "mus-ldouble"
- "mus-ubshort" "mus-ulshort" "mus-bdouble-unscaled" "mus-ldouble-unscaled" "mus-bfloat-unscaled" "mus-lfloat-unscaled"
- "mus-audio-default"
- "rectangular-window" "hann-window" "welch-window"
- "parzen-window" "bartlett-window" "hamming-window" "blackman2-window" "blackman3-window" "blackman4-window" "exponential-window"
- "riemann-window" "kaiser-window" "cauchy-window" "poisson-window" "gaussian-window" "tukey-window" "dolph-chebyshev-window"
- "samaraki-window" "ultraspherical-window" "blackman5-window" "blackman6-window" "blackman7-window" "blackman8-window"
- "blackman9-window" "blackman10-window" "rv2-window" "rv3-window" "rv4-window"
- "zoom-focus-left" "zoom-focus-right" "zoom-focus-active" "zoom-focus-middle" "graph-once"
- "graph-as-wavogram" "graph-as-sonogram" "graph-as-spectrogram" "cursor-cross" "cursor-line" "graph-lines" "graph-dots"
- "graph-filled" "graph-dots-and-lines" "graph-lollipops" "x-axis-in-seconds" "x-axis-in-samples" "x-axis-in-beats" "x-axis-in-measures"
- "x-axis-as-percentage" "show-all-axes" "show-all-axes-unlabelled" "show-no-axes" "show-x-axis" "show-x-axis-unlabelled"
- "cursor-in-view" "cursor-on-left" "cursor-on-right" "cursor-in-middle" "keyboard-no-action" "fourier-transform"
- "wavelet-transform" "haar-transform" "cepstrum" "hadamard-transform" "walsh-transform" "autocorrelation" "dont-normalize"
- "normalize-by-channel" "normalize-by-sound" "normalize-globally" "current-edit-position" "channels-separate"
- "channels-combined" "channels-superimposed" "speed-control-as-float" "speed-control-as-ratio" "speed-control-as-semitone"
- "enved-amplitude" "enved-spectrum" "enved-srate" "envelope-linear" "envelope-exponential" "enved-add-point"
- "enved-delete-point" "enved-move-point" "time-graph" "transform-graph" "lisp-graph" "copy-context" "cursor-context"
- "selection-context" "mark-context" "mus-interp-all-pass" "mus-interp-bezier" "mus-interp-hermite" "mus-interp-lagrange"
- "mus-interp-linear" "mus-interp-none" "mus-interp-sinusoidal"
- "sync-none" "sync-all" "sync-by-sound"
- ))
+ :sortby (string-downcase (substring str (+ mid 1))))))
(define (scheme->ruby scheme-name)
@@ -503,10 +241,10 @@
"frame_multiply"
(if (string=? scheme-name "frame+")
"frame_add"
- (if (string=? scheme-name "vct*")
- "vct_multiply"
- (if (string=? scheme-name "vct+")
- "vct_add"
+ (if (string=? scheme-name "float-vector*")
+ "float-vector_multiply"
+ (if (string=? scheme-name "float-vector+")
+ "float-vector_add"
(if (string=? scheme-name "mixer*")
"mixer_multiply"
(if (string=? scheme-name "mixer+")
@@ -516,8 +254,8 @@
(if (string=? scheme-name "in")
"call_in"
(let* ((len (length scheme-name))
- (var-case (string-list-position scheme-name scheme-variable-names))
- (strlen (if var-case (+ 1 len) len))
+ (var-case (hash-table-ref scheme-variable-names scheme-name))
+ (strlen (if var-case (+ len 1) len))
(rb-name (make-string strlen #\space))
(i 0)
(j 0))
@@ -525,7 +263,7 @@
(begin
(set! (rb-name 0) #\$)
(set! j 1))
- (if (string-list-position scheme-name scheme-constant-names)
+ (if (hash-table-ref scheme-constant-names scheme-name)
(begin
(set! (rb-name 0) (char-upcase (scheme-name 0)))
(set! i 1)
@@ -538,35 +276,32 @@
(char=? c #\!))
(begin
(set! (rb-name j) c)
- (incf i)
- (incf j))
+ (set! i (+ i 1))
+ (set! j (+ j 1)))
(if (and (char=? c #\-)
(char=? (scheme-name (+ i 1)) #\>))
(begin
(set! (rb-name j) #\2)
- (incf j)
+ (set! j (+ j 1))
(set! i (+ i 2)))
(begin
(set! (rb-name j) #\_)
- (incf i)
- (incf j))))))
+ (set! i (+ i 1))
+ (set! j (+ j 1)))))))
(if (not (= j strlen))
(substring rb-name 0 j)
rb-name)))))))))))
(define (clean-up-xref xref file)
(let* ((len (length xref))
- (outstr (make-string (* len 2) #\space))
- (url-str "")
- (i 0)
- (j 0)
- (need-start #f)
- (in-bracket #f)
- (in-href #f)
- (in-name #f))
-
- (let ((loc 0))
- (do ()
+ (outstr (make-string (* len 2) #\space)))
+ (let ((url-str "")
+ (j 0)
+ (need-start #f)
+ (in-bracket #f)
+ (in-href #f)
+ (in-name #f))
+ (do ((loc 0))
((>= loc len))
(let* ((leof (or (char-position #\newline xref loc)
len))
@@ -578,222 +313,729 @@
(href-len (if href-normal-start 8 20))
(href-end (and href-start
(< href-start leof)
- (char-position #\> xref (+ 1 href-start))))
- (href (and href-start href-end (checked-substring xref (+ href-start href-len) href-end))))
+ (char-position #\> xref (+ href-start 1))))
+ (href (and href-start href-end (substring xref (+ href-start href-len) href-end))))
(if href
(if (char=? (href 1) #\#)
- (set! url-str (string-append url-str (string #\") file (checked-substring href 1) (format #f ",~% ")))
+ (set! url-str (string-append url-str (string #\") file (substring href 1) (format #f ",~% ")))
(set! url-str (string-append url-str href (format #f ",~% "))))
(set! url-str (string-append url-str (format #f "NULL,~% "))))
- (set! loc (+ 1 leof))
+ (set! loc (+ leof 1))
))
- )
- (set! (outstr j) #\")
- (incf j)
- (do ()
- ((>= i len))
- (let ((c (xref i)))
- (if in-bracket
- (if (char=? c #\>)
- (begin
- (set! in-bracket #f)
- (if in-href
- (set! in-name #t))
- (set! in-href #f)))
- (if (char=? c #\<)
- (begin
+
+ (set! (outstr j) #\")
+ (set! j (+ j 1))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (let ((c (xref i)))
+ (if in-bracket
+ (if (char=? c #\>)
+ (begin
+ (set! in-bracket #f)
+ (if in-href
+ (set! in-name #t))
+ (set! in-href #f)))
+ (case c
+ ((#\<)
(if in-name
(begin
- (set! (outstr j) #\})
- (incf j)
- (set! in-name #f)))
+ (set! (outstr j) #\})
+ (set! j (+ j 1))
+ (set! in-name #f)))
(set! in-bracket #t)
(if (or (and (< (+ i 7) len)
- (string=? "<a href" (checked-substring xref i (+ i 7))))
+ (string=? "<a href" (substring xref i (+ i 7))))
(and (< (+ i 17) len)
- (string=? "<a class=def href" (checked-substring xref i (+ i 17))))
+ (string=? "<a class=def href" (substring xref i (+ i 17))))
(and (< (+ i 19) len)
- (string=? "<a class=quiet href" (checked-substring xref i (+ i 19)))))
+ (string=? "<a class=quiet href" (substring xref i (+ i 19)))))
(begin
- (if need-start
- (begin
- (set! (outstr j) #\,)
- (incf j)
- (set! (outstr j) #\newline)
- (incf j)
- (set! (outstr j) #\space)
- (incf j)
- (set! (outstr j) #\space)
- (incf j)
- (set! (outstr j) #\")
- (incf j)
- (set! need-start #f)))
- (set! in-href #t)
- (set! (outstr j) #\{)
- (incf j))))
- (if (char=? c #\&)
- (if (and (< (+ i 4) len)
- (string=? (substring xref i (+ i 4)) ">"))
- (begin
- (set! (outstr j) #\>)
- (incf j)
- (set! i (+ i 3)))) ; incf'd again below
- (if (char=? c #\newline)
- (begin
- (set! (outstr j) #\")
- (incf j)
- (set! need-start #t))
- (if (char=? c #\")
- (begin
- (set! (outstr j) #\\)
- (incf j)
- (set! (outstr j) c)
- (incf j))
- (begin
- (if need-start
- (begin
- (set! (outstr j) #\,)
- (incf j)
- (set! (outstr j) #\newline)
- (incf j)
- (set! (outstr j) #\space)
- (incf j)
- (set! (outstr j) #\space)
- (incf j)
- (set! (outstr j) #\")
- (incf j)
- (set! need-start #f)))
- (set! (outstr j) c)
- (incf j))))))))
- (incf i))
- (list
- (checked-substring outstr 0 j)
- url-str)))
+ (if need-start
+ (begin
+ (set! (outstr j) #\,)
+ (set! (outstr (+ j 1)) #\newline)
+ (set! (outstr (+ j 2)) #\space)
+ (set! (outstr (+ j 3)) #\space)
+ (set! (outstr (+ j 4)) #\")
+ (set! j (+ j 5))
+ (set! need-start #f)))
+ (set! in-href #t)
+ (set! (outstr j) #\{)
+ (set! j (+ j 1)))))
+
+ ((#\")
+ (set! (outstr j) #\\)
+ (set! j (+ j 1))
+ (set! (outstr j) c)
+ (set! j (+ j 1)))
+
+ ((#\&)
+ (if (and (< (+ i 4) len)
+ (string=? (substring xref i (+ i 4)) ">"))
+ (begin
+ (set! (outstr j) #\>)
+ (set! j (+ j 1))
+ (set! i (+ i 3))))) ; incf'd again below
+
+ ((#\newline)
+ (set! (outstr j) #\")
+ (set! j (+ j 1))
+ (set! need-start #t))
+
+ (else
+ (if need-start
+ (begin
+ (set! (outstr j) #\,)
+ (set! (outstr (+ j 1)) #\newline)
+ (set! (outstr (+ j 2)) #\space)
+ (set! (outstr (+ j 3)) #\space)
+ (set! (outstr (+ j 4)) #\")
+ (set! j (+ j 5))
+ (set! need-start #f)))
+ (set! (outstr j) c)
+ (set! j (+ j 1))))
+ )))
+ (list
+ (substring outstr 0 j)
+ url-str))))
+
+
+
+;;; --------------------------------------------------------------------------------
+;;; get indexer.data
+(define-macro (provide sym) ; this picks up most of the (provide ...) statements for the autoloader
+ `(define (,(cadr sym)) ,sym))
-(define (without-dollar-sign str)
- (if (char=? (str 0) #\$)
- (substring str 1)
- str))
+(load "ws.scm")
+ ;(load "clm23.scm")
+ ;(load "edit123.scm")
+ ;(load "snd11.scm")
+(load "analog-filter.scm")
+ ; (load "new-backgrounds.scm")
+(load "animals.scm")
+ ; (load "new-effects.scm")
+(load "autosave.scm")
+(load "noise.scm")
+(load "binary-io.scm")
+ ;(load "bess1.scm")
+(load "nrev.scm")
+ ;(load "bess.scm")
+(load "numerics.scm")
+(load "big-gens.scm")
+(load "bird.scm")
+(load "clean.scm")
+(load "peak-phases.scm")
+(load "piano.scm")
+(load "clm-ins.scm")
+(load "play.scm")
+(load "dlocsig.scm")
+(load "poly.scm")
+(load "draw.scm")
+(load "dsp.scm")
+(load "prc95.scm")
+ ; (load "edit-menu.scm")
+(load "primes.scm")
+ ; (load "effects-utils.scm")
+(load "pvoc.scm")
+(load "enved.scm")
+(load "rgb.scm")
+(load "env.scm")
+(load "examp.scm")
+(load "rubber.scm")
+(load "expandn.scm")
+ ;(load "s7-slib-init.scm")
+(load "extensions.scm")
+ ;(load "s7test.scm")
+(load "fade.scm")
+(load "selection.scm")
+ ; (load "fft-menu.scm")
+(load "singer.scm")
+ ; (load "fmv.scm")
+(load "freeverb.scm")
+(load "fullmix.scm")
+(load "generators.scm")
+(load "grani.scm")
+ ; (load "gtk-effects.scm")
+(load "snddiff.scm")
+ ; (load "gtk-effects-utils.scm")
+ ; (load "snd-gl.scm")
+ ; (load "snd-gtk.scm")
+(load "hooks.scm")
+ ;(load "sndlib-ws.scm")
+(load "index.scm")
+ ; (load "snd-motif.scm")
+(load "jcrev.scm")
+ ;(load "snd-test.scm")
+(load "jcvoi.scm")
+(load "sndwarp.scm")
+
+ ; (load "special-menu.scm")
+(load "maraca.scm")
+(load "spectr.scm")
+ ; (load "marks-menu.scm")
+(load "spokenword.scm")
+(load "marks.scm")
+(load "stochastic.scm")
+(load "maxf.scm")
+(load "strad.scm")
+ ; (load "misc.scm")
+(load "v.scm")
+(load "mix.scm")
+(load "moog.scm")
+ ; (load "xm-enved.scm")
+(load "musglyphs.scm")
+(load "zip.scm")
+(load "nb.scm")
+(load "write.scm")
+;(load "lint.scm")
+(load "r7rs.scm")
+(load "cload.scm")
+(load "stuff.scm")
+(load "mockery.scm")
+;(load "repl.scm")
-(define (creation-date)
- (strftime "%d-%b-%y %H:%M %Z" (localtime (current-time))))
+(let ((names (make-hash-table)))
+
+ (define (where-is func)
+ (let ((addr (with-let (funclet func) __func__)))
+ ;; this misses scheme-side pws because their environment is (probably) the global env
+ (and (pair? addr)
+ (cadr addr))))
+
+ (define (apropos-1 e)
+ (for-each
+ (lambda (binding)
+ (if (pair? binding)
+ (let ((symbol (car binding))
+ (value (cdr binding)))
+ (if (procedure? value)
+ (let ((file (where-is value)))
+ (if (and file
+ (not (member file '("~/.snd_s7" "/home/bil/.snd_s7" "t.scm" "/home/bil/cl/t.scm" "make-index.scm" "/home/bil/cl/make-index.scm"))))
+ (let ((pos (char-position #\/ file)))
+ (if pos
+ (do ((k (char-position #\/ file (+ pos 1)) (char-position #\/ file (+ pos 1))))
+ ((not k)
+ (set! file (substring file (+ pos 1))))
+ (set! pos k)))
+ (let ((cur-names (hash-table-ref names file)))
+ (if cur-names
+ (if (not (memq symbol cur-names))
+ (hash-table-set! names file (cons symbol cur-names)))
+ (hash-table-set! names file (list symbol)))))))))))
+ e))
+
+ ;; handle the main macros by hand
+ (for-each
+ (lambda (symbol-and-file)
+ (let ((symbol (car symbol-and-file))
+ (file (cadr symbol-and-file)))
+ (if (not (file-exists? file))
+ (format *stderr* ";~S says it is in ~S which does not exist~%" symbol file))
+
+ (let ((cur-names (hash-table-ref names file)))
+ (if cur-names
+ (hash-table-set! names file (cons symbol cur-names))
+ (hash-table-set! names file (list symbol))))))
+ (list
+ (list '*libm* "libm.scm")
+ (list '*libgdbm* "libgdbm.scm")
+ (list '*libdl* "libdl.scm")
+ (list '*libc* "libc.scm")
+ (list '*libgsl* "libgsl.scm")
+ (list '*repl* "repl.scm")
+
+ (list 'with-sound "ws.scm")
+ (list 'with-mixed-sound "ws.scm")
+ (list 'with-full-sound "ws.scm")
+ (list 'with-temp-sound "ws.scm")
+ (list 'with-marked-sound "ws.scm")
+ (list 'with-simple-sound "ws.scm")
+ (list 'sound-let "ws.scm")
+ (list 'definstrument "ws.scm")
+ (list 'defgenerator "generators.scm")
+
+ (list 'channel-sync "extensions.scm")
+ (list 'xe-envelope "xm-enved.scm")
+ (list '*clm-srate* "ws.scm")
+ (list '*clm-file-name* "ws.scm")
+ (list '*clm-channels* "ws.scm")
+ (list '*clm-sample-type* "ws.scm")
+ (list '*clm-header-type* "ws.scm")
+ (list '*clm-verbose* "ws.scm")
+ (list '*clm-play* "ws.scm")
+ (list '*clm-statistics* "ws.scm")
+ (list '*clm-reverb* "ws.scm")
+ (list '*clm-reverb-channels* "ws.scm")
+ (list '*clm-reverb-data* "ws.scm")
+ (list '*clm-table-size* "ws.scm")
+ (list '*clm-file-buffer-size* "ws.scm")
+ (list '*clm-locsig-type* "ws.scm")
+ (list '*clm-clipped* "ws.scm")
+ (list '*clm-array-print-length* "ws.scm")
+ (list '*clm-player* "ws.scm")
+ (list '*clm-notehook* "ws.scm")
+ (list '*clm-with-sound-depth* "ws.scm")
+ (list '*clm-default-frequency* "ws.scm")
+ (list '*clm-delete-reverb* "ws.scm")
+ (list '*to-snd* "ws.scm")
+ (list '*clm-search-list* "ws.scm")
+ (list '*definstrument-hook* "ws.scm")
+
+ ;; these are hidden in defgenerator
+ (list 'make-abcos "generators.scm")
+ (list 'make-absin "generators.scm")
+ (list 'make-adjustable-oscil "generators.scm")
+ (list 'make-adjustable-sawtooth-wave "generators.scm")
+ (list 'make-adjustable-square-wave "generators.scm")
+ (list 'make-adjustable-triangle-wave "generators.scm")
+ (list 'make-asyfm "generators.scm")
+ (list 'make-bess "generators.scm")
+ (list 'make-blackman "generators.scm")
+ (list 'make-brown-noise "generators.scm")
+ (list 'make-dblsum "generators.scm")
+ (list 'make-eoddcos "generators.scm")
+ (list 'make-ercos "generators.scm")
+ (list 'make-erssb "generators.scm")
+ (list 'make-exponentially-weighted-moving-average "generators.scm")
+ (list 'make-flocsig "generators.scm")
+ (list 'make-fmssb "generators.scm")
+ (list 'make-green-noise "generators.scm")
+ (list 'make-green-noise-interp "generators.scm")
+ (list 'make-izcos "generators.scm")
+ (list 'make-j0evencos "generators.scm")
+ (list 'make-j0j1cos "generators.scm")
+ (list 'make-j2cos "generators.scm")
+ (list 'make-jjcos "generators.scm")
+ (list 'make-jncos "generators.scm")
+ (list 'make-jpcos "generators.scm")
+ (list 'make-jycos "generators.scm")
+ (list 'make-k2cos "generators.scm")
+ (list 'make-k2sin "generators.scm")
+ (list 'make-k2ssb "generators.scm")
+ (list 'make-k3sin "generators.scm")
+ (list 'make-krksin "generators.scm")
+ (list 'make-moving-autocorrelation "generators.scm")
+ (list 'make-moving-fft "generators.scm")
+ (list 'make-moving-length "generators.scm")
+ (list 'make-moving-pitch "generators.scm")
+ (list 'make-moving-rms "generators.scm")
+ (list 'make-moving-scentroid "generators.scm")
+ (list 'make-moving-spectrum "generators.scm")
+ (list 'make-moving-sum "generators.scm")
+ (list 'make-moving-variance "generators.scm")
+ (list 'make-n1cos "generators.scm")
+ (list 'make-nchoosekcos "generators.scm")
+ (list 'make-ncos2 "generators.scm")
+ (list 'make-ncos4 "generators.scm")
+ (list 'make-nkssb "generators.scm")
+ (list 'make-noddcos "generators.scm")
+ (list 'make-noddsin "generators.scm")
+ (list 'make-noddssb "generators.scm")
+ (list 'make-noid "generators.scm")
+ (list 'make-npcos "generators.scm")
+ (list 'make-nrcos "generators.scm")
+ (list 'make-nrsin "generators.scm")
+ (list 'make-nrssb "generators.scm")
+ (list 'make-nsincos "generators.scm")
+ (list 'make-nssb "generators.scm")
+ (list 'make-nxy1cos "generators.scm")
+ (list 'make-nxy1sin "generators.scm")
+ (list 'make-nxycos "generators.scm")
+ (list 'make-nxysin "generators.scm")
+ (list 'make-pink-noise "generators.scm")
+ (list 'make-polyoid "generators.scm")
+ (list 'make-r2k!cos "generators.scm")
+ (list 'make-r2k2cos "generators.scm")
+ (list 'make-rcos "generators.scm")
+ (list 'make-rk!cos "generators.scm")
+ (list 'make-rk!ssb "generators.scm")
+ (list 'make-rkcos "generators.scm")
+ (list 'make-rkoddssb "generators.scm")
+ (list 'make-rksin "generators.scm")
+ (list 'make-rkssb "generators.scm")
+ (list 'make-round-interp "generators.scm")
+ (list 'make-rssb "generators.scm")
+ (list 'make-rxycos "generators.scm")
+ (list 'make-rxysin "generators.scm")
+ (list 'make-safe-rxycos "generators.scm")
+ (list 'make-sinc-train "generators.scm")
+ (list 'make-table-lookup-with-env "generators.scm")
+ (list 'make-tanhsin "generators.scm")
+ (list 'make-wave-train-with-env "generators.scm")
+ (list 'make-waveshape "generators.scm")
+ (list 'make-weighted-moving-average "generators.scm")
+ (list 'nssb? "generators.scm")
+ (list 'nxysin? "generators.scm")
+ (list 'nxycos? "generators.scm")
+ (list 'nxy1cos? "generators.scm")
+ (list 'nxy1sin? "generators.scm")
+ (list 'noddsin? "generators.scm")
+ (list 'noddcos? "generators.scm")
+ (list 'noddssb? "generators.scm")
+ (list 'ncos2? "generators.scm")
+ (list 'npcos? "generators.scm")
+ (list 'nrsin? "generators.scm")
+ (list 'nrcos? "generators.scm")
+ (list 'nrssb? "generators.scm")
+ (list 'nkssb? "generators.scm")
+ (list 'nsincos? "generators.scm")
+ (list 'n1cos? "generators.scm")
+ (list 'rcos? "generators.scm")
+ (list 'rssb? "generators.scm")
+ (list 'rxysin? "generators.scm")
+ (list 'rxycos? "generators.scm")
+ (list 'safe-rxycos? "generators.scm")
+ (list 'ercos? "generators.scm")
+ (list 'erssb? "generators.scm")
+ (list 'eoddcos? "generators.scm")
+ (list 'rkcos? "generators.scm")
+ (list 'rksin? "generators.scm")
+ (list 'rkssb? "generators.scm")
+ (list 'rk!cos? "generators.scm")
+ (list 'rk!ssb? "generators.scm")
+ (list 'r2k!cos? "generators.scm")
+ (list 'k2sin? "generators.scm")
+ (list 'k2cos? "generators.scm")
+ (list 'k2ssb? "generators.scm")
+ (list 'dblsum? "generators.scm")
+ (list 'rkoddssb? "generators.scm")
+ (list 'krksin? "generators.scm")
+ (list 'abcos? "generators.scm")
+ (list 'absin? "generators.scm")
+ (list 'r2k2cos? "generators.scm")
+ (list 'asyfm? "generators.scm")
+ (list 'bess? "generators.scm")
+ (list 'jjcos? "generators.scm")
+ (list 'j0evencos? "generators.scm")
+ (list 'j2cos? "generators.scm")
+ (list 'jpcos? "generators.scm")
+ (list 'jncos? "generators.scm")
+ (list 'j0j1cos? "generators.scm")
+ (list 'jycos? "generators.scm")
+ (list 'blackman "generators.scm")
+ (list 'blackman? "generators.scm")
+ (list 'fmssb? "generators.scm")
+ (list 'k3sin? "generators.scm")
+ (list 'izcos? "generators.scm")
+ (list 'adjustable-square-wave? "generators.scm")
+ (list 'adjustable-triangle-wave? "generators.scm")
+ (list 'adjustable-sawtooth-wave? "generators.scm")
+ (list 'adjustable-oscil? "generators.scm")
+ (list 'round-interp? "generators.scm")
+ (list 'nchoosekcos? "generators.scm")
+ (list 'sinc-train? "generators.scm")
+ (list 'pink-noise? "generators.scm")
+ (list 'brown-noise? "generators.scm")
+ (list 'green-noise? "generators.scm")
+ (list 'green-noise-interp? "generators.scm")
+ (list 'moving-sum? "generators.scm")
+ (list 'moving-variance? "generators.scm")
+ (list 'moving-rms? "generators.scm")
+ (list 'moving-length? "generators.scm")
+ (list 'weighted-moving-average? "generators.scm")
+ (list 'exponentially-weighted-moving-average? "generators.scm")
+ (list 'polyoid "generators.scm")
+ (list 'polyoid-tn "generators.scm")
+ (list 'polyoid-un "generators.scm")
+ (list 'noid "generators.scm")
+ (list 'waveshape? "generators.scm")
+ (list 'waveshape "generators.scm")
+ (list 'tanhsin? "generators.scm")
+ (list 'moving-fft? "generators.scm")
+ (list 'moving-spectrum? "generators.scm")
+ (list 'moving-scentroid? "generators.scm")
+ (list 'moving-autocorrelation? "generators.scm")
+ (list 'moving-pitch? "generators.scm")
+ (list 'flocsig? "generators.scm")
+
+ (list 'vector-for-each "r7rs.scm")
+ (list 'string-for-each "r7rs.scm")
+ (list 'list-copy "r7rs.scm")
+ (list 'r7rs-string-fill! "r7rs.scm")
+ (list 'char-foldcase "r7rs.scm")
+ (list 'exact-integer? "r7rs.scm")
+ (list 'inexact "r7rs.scm")
+ (list 'exact "r7rs.scm")
+ (list 'truncate-quotient "r7rs.scm")
+ (list 'truncate-remainder "r7rs.scm")
+ (list 'floor-remainder "r7rs.scm")
+ (list 'open-binary-input-file "r7rs.scm")
+ (list 'open-binary-output-file "r7rs.scm")
+ (list 'bytevector-length "r7rs.scm")
+ (list 'write-bytevector "r7rs.scm")
+ (list 'open-input-bytevector "r7rs.scm")
+ (list 'open-output-bytevector "r7rs.scm")
+ (list 'read-u8 "r7rs.scm")
+ (list 'write-u8 "r7rs.scm")
+ (list 'u8-ready? "r7rs.scm")
+ (list 'peek-u8 "r7rs.scm")
+ (list 'write-simple "r7rs.scm")
+ (list 'raise "r7rs.scm")
+ (list 'raise-continuable "r7rs.scm")
+ (list 'interaction-environment "r7rs.scm")
+ (list 'jiffies-per-second "r7rs.scm")
+ (list 'current-jiffy "r7rs.scm")
+ (list 'current-second "r7rs.scm")
+ (list 'get-environment-variable "r7rs.scm")
+ (list 'get-environment-variables "r7rs.scm")
+ (list 'r7rs-file-exists? "r7rs.scm")
+ (list 'os-type "r7rs.scm")
+ (list 'cpu-architecture "r7rs.scm")
+ (list 'machine-name "r7rs.scm")
+ (list 'os-version "r7rs.scm")
+ (list 'implementation-name "r7rs.scm")
+ (list 'implementation-version "r7rs.scm")
+ (list 'box-type? "r7rs.scm")
+ (list 'make-box-type "r7rs.scm")
+ (list 'define-library "r7rs.scm")
+ (list 'define-record-type "r7rs.scm")
+
+ (list 'c?r "stuff.scm")
+ (list 'do* "stuff.scm")
+ (list 'typecase "stuff.scm")
+ (list 'enum "stuff.scm")
+ (list 'while "stuff.scm")
+ (list 'define-class "stuff.scm")
+ (list 'elambda "stuff.scm")
+ (list 'reflective-let "stuff.scm")
+ (list 'reflective-probe "stuff.scm")
+ (list 'reactive-let "stuff.scm")
+ (list 'reactive-let* "stuff.scm")
+ (list 'reactive-lambda* "stuff.scm")
+ (list 'pretty-print "write.scm")
+ (list 'fully-macroexpand "stuff.scm")
+ (list '*mock-vector* "mockery.scm")
+ (list '*mock-port* "mockery.scm")
+ (list '*mock-symbol* "mockery.scm")
+ (list '*mock-pair* "mockery.scm")
+ (list '*mock-number* "mockery.scm")
+ (list '*mock-char* "mockery.scm")
+ (list '*mock-string* "mockery.scm")
+ (list '*mock-hash-table* "mockery.scm")
+
+ (list 'lint "lint.scm")
+ (list 'html-lint "lint.scm")
+
+ (list 'moog? "moog.scm")
+ (list 'make-moog "moog.scm")
+
+ (list 'snd-clm23.scm "clm23.scm")
+ (list 'snd-edit123.scm "edit123.scm")
+; (list 'snd-snd11.scm "snd11.scm")
+ (list 'snd-new-backgrounds.scm "new-backgrounds.scm")
+ (list 'snd-new-effects.scm "new-effects.scm")
+ (list 'snd-bess1.scm "bess1.scm")
+ (list 'snd-bess.scm "bess.scm")
+ (list 'snd-edit-menu.scm "edit-menu.scm")
+ (list 'snd-effects-utils.scm "effects-utils.scm")
+ (list 'snd-fft-menu.scm "fft-menu.scm")
+ (list 'snd-fmv.scm "fmv.scm")
+ (list 'snd-gtk-effects.scm "gtk-effects.scm")
+ (list 'snd-gtk-effects-utils.scm "gtk-effects-utils.scm")
+ (list 'snd-snd-gl.scm "snd-gl.scm")
+ (list 'snd-snd-gtk.scm "snd-gtk.scm")
+ (list 'snd-snd-motif.scm "snd-motif.scm")
+ (list 'snd-special-menu.scm "special-menu.scm")
+ (list 'snd-marks-menu.scm "marks-menu.scm")
+ (list 'snd-misc.scm "misc.scm")
+ (list 'snd-xm-enved.scm "xm-enved.scm")
+
+ (list 'snd-ws.scm "ws.scm")
+ (list 'sndlib-ws.scm "sndlib-ws.scm")
+
+ ))
+
+ ;; still missing (if not above):
+ ;; copy-sample-reader free-sample-reader make-mix-sample-reader make-region-sample-reader make-sample-reader
+ ;; mix-sample-reader? region-sample-reader? sample-reader-at-end? sample-reader-home sample-reader? sample-reader-position
+ ;; spectro-cutoff spectro-end clear-selection cursor-follows-play
+ ;; penv? make-penv
+ ;; big-ring-modulate big-oscil? make-big-oscil big-ncos? make-big-ncos big-nsin? make-big-nsin big-table-lookup?
+ ;; make-big-table-lookup big-one-zero? make-big-one-zero big-one-pole? make-big-one-pole
+ ;; hilbert-transform highpass lowpass bandpass bandstop differentiator butter channel-lp-inf savitzky-golay-filter
+ ;; stop-dac dlocsig array-ref sound-comment
+
+
+ ;; alternate: (autoload sym (lambda (e) (let ((m (load file))) (varlet (rootlet) (cons sym (m sym))))))
+ (for-each
+ (lambda (sym&file)
+ (let ((e (car sym&file))
+ (file (cadr sym&file)))
+ (let ((ce (if (not (defined? e)) (load file) (symbol->value e))))
+ (let ((flst (or (hash-table-ref names file) ())))
+ (for-each
+ (lambda (slot)
+ (let ((name (car slot)))
+ (if (not (defined? name))
+ (set! flst (cons name flst)))))
+ ce)
+ (hash-table-set! names file flst)))))
+ (list
+ (list '*libm* "libm.scm")
+ (list '*libgdbm* "libgdbm.scm")
+ (list '*libdl* "libdl.scm")
+ (list '*libc* "libc.scm")
+ (list '*libgsl* "libgsl.scm")
+ ))
+
+ (apropos-1 (rootlet))
+
+ (let ((syms ())
+ (size 0))
+ (call-with-output-file "indexer.data"
+ (lambda (p)
+ (let ((hti (make-iterator names)))
+ (do ((ns (iterate hti) (iterate hti)))
+ ((eof-object? ns))
+ (let ((file (car ns))
+ (symbols (cdr ns)))
+ (set! size (+ size (length symbols)))
+ (for-each
+ (lambda (symbol)
+ (set! syms (cons (cons (symbol->string symbol) file) syms)))
+ symbols)))
+ (set! syms (sort! syms (lambda (a b) (string<? (car a) (car b)))))
+ (format p "~%static const char *snd_names[~D] = {" (* size 2))
+ (for-each
+ (lambda (sf)
+ (format p "~% ~S, ~S," (car sf) (cdr sf)))
+ syms)
+ (format p "~%};~%"))
+ (format p "~%static void autoload_info(s7_scheme *sc)~%{~% s7_autoload_set_names(sc, snd_names, ~D);~%}~%" size)))
+ ))
-(define (make-vector-name str)
- (do ((i 0 (+ 1 i)))
- ((= i (length str)) str)
- (if (char=? (str i) #\space)
- (set! (str i) #\_))))
+
+;;; --------------------------------------------------------------------------------
+;;; make-index
-(define* (make-index-1 file-names (output "test.html") (cols 3) (capitalized #f) no-bold with-scm with-clm-locals)
+(define (make-vector-name str)
+ (let ((pos (char-position #\space str)))
+ (if pos
+ (let ((len (length str)))
+ (string-set! str pos #\_)
+ (do ((i (+ pos 1) (+ i 1)))
+ ((= i len) str)
+ (if (char=? (string-ref str i) #\space)
+ (string-set! str i #\_))))
+ str)))
+
+(define ids (make-hash-table))
+(define n-array-length 2048)
+(define g-array-length 128)
+
+(define* (make-index-1 file-names (output "test.html") (cols 3) capitalized no-bold with-scm)
;; read html file, gather all names, create index (in lower-case, *=space in sort)
(let ((n 0)
(g 0)
(xrefing #f)
(current-general 0)
(got-tr #f)
- (topic #f))
-
- (fill! names #f)
- (fill! files #f)
- (fill! topics #f)
- (fill! gfiles #f)
- (fill! generals #f)
+ (topic #f)
+ (xrefs (make-vector g-array-length #f))
+ (generals (make-vector g-array-length #f))
+ (topics (make-vector n-array-length #f))
+ (gfiles (make-vector g-array-length #f))
+ (files (make-vector n-array-length #f))
+ (names (make-vector n-array-length #f))
+ (local-ids ())
+ )
+ (fill! ids ())
- (do ((file file-names (cdr file))
- (file-ctr 0 (+ file-ctr 1)))
+ (do ((file file-names (cdr file)))
((null? file))
+ (set! local-ids ())
(call-with-input-file (car file)
(lambda (f)
- (let line-loop ((line (read-line f)))
- (if (not (eof-object? line))
- (let ((len (length line)))
- (when (and line (positive? len))
- (let* ((dline line)
- (compos (string-position "<!-- INDEX" dline))
- (indpos (string-position "<!-- main-index" dline))
- (xpos (string-position "<TABLE " dline))
- (unxpos (string-position "</TABLE>" dline))
- (pos-simple (and (not compos)
- (not indpos)
- (or (string-position "<a name=" dline)
- (and with-clm-locals
- (string-position "<a Name=" dline)))))
- (pos-def (and (not compos)
- (not indpos)
- (or (string-position "<a class=def name=" dline)
- (and with-clm-locals
- (string-position "<a class=def Name=" dline)))))
- (pos (or pos-simple pos-def))
- (tpos (and (not pos)
- (string-position "<!-- TOPIC " line))))
- (if unxpos
- (set! xrefing #f))
- (if tpos
- (let ((epos (string-position " -->" dline)))
- (if (not epos)
- (format #t "<!-- TOPIC but no --> for ~A~%" dline)
- (set! topic (checked-substring dline (+ tpos 11) epos))))
- (if compos
- (let ((epos (string-position " -->" dline)))
- (if (not epos)
- (format #t "<!-- INDEX but no --> for ~A~%" dline)
- (when (or (not no-bold)
- with-scm)
- (set! current-general g)
- (set! (generals g) (checked-substring dline (+ compos 11) epos))
- (set! (gfiles g) (car file))
- (set! (xrefs g) "")
- (incf g))))
- (if indpos
- (let ((epos (string-position " -->" dline)))
+ (do ((line (read-line f) (read-line f)))
+ ((eof-object? line))
+ (when (char-position #\< line)
+ (let* ((dline line)
+ (compos (string-position "<!-- INDEX" dline))
+ (indpos (string-position "<!-- main-index" dline))
+ (xpos (string-position "<TABLE " dline))
+ (unxpos (string-position "</TABLE>" dline))
+ (pos (and (not compos)
+ (not indpos)
+ (string-position "<em class=def id=" dline)
+ ))
+ (id-pos (string-position " id=" dline))
+ (tpos (and (not pos)
+ (string-position "<!-- TOPIC " line))))
+ (if unxpos
+ (set! xrefing #f))
+
+ (if id-pos
+ (let* ((start (- (char-position #\" dline id-pos) id-pos)) ; (substring dline id-pos)))
+ (end-start (+ id-pos start 2))
+ (end (- (char-position #\" dline end-start) end-start)) ; (substring dline (+ id-pos start 2))))
+ (name (substring dline (+ id-pos start 1) (+ id-pos start 2 end))))
+ (let ((sym-name (string->symbol name)))
+ (if (not (hash-table-ref ids sym-name))
+ (hash-table-set! ids sym-name 0)
+ (if (memq sym-name local-ids)
+ (format #t "~S: id ~S is set twice~%" file sym-name)))
+ (set! local-ids (cons sym-name local-ids)))))
+
+ (if tpos
+ (let ((epos (string-position " -->" dline)))
+ (if (not epos)
+ (format #t "<!-- TOPIC but no --> for ~A~%" dline)
+ (set! topic (substring dline (+ tpos 11) epos))))
+ (if compos
+ (let ((epos (string-position " -->" dline)))
+ (if (not epos)
+ (format #t "<!-- INDEX but no --> for ~A~%" dline)
+ (when (or (not no-bold)
+ with-scm)
+ (set! current-general g)
+ (set! (generals g) (substring dline (+ compos 11) epos))
+ (set! (gfiles g) (car file))
+ (set! (xrefs g) "")
+ (set! g (+ g 1)))))
+ (if indpos
+ (let ((epos (string-position " -->" dline)))
+ (if (not epos)
+ (format #t "<!-- main-index but no --> for ~A~%" dline)
+ (when (or (not no-bold)
+ with-scm)
+ (set! (names n) (substring dline (+ indpos 16) epos))
+ (set! (files n) (car file))
+ (set! n (+ n 1)))))
+ (if xpos
+ (set! xrefing #t)
+ (do ()
+ ((not pos))
+ (set! dline (substring dline pos))
+ (let ((epos (or (string-position "</a>" dline)
+ (string-position "</em>" dline)
+ (string-position "</A>" dline))))
(if (not epos)
- (format #t "<!-- main-index but no --> for ~A~%" dline)
- (when (or (not no-bold)
- with-scm)
- (set! (names n) (checked-substring dline (+ indpos 16) epos))
+ (format #t "<a> but no </a> for ~A~%" dline)
+ (begin
+ (set! (names n) (string-append (substring dline 0 epos) "</a>"))
(set! (files n) (car file))
- (incf n))))
- (if xpos
- (set! xrefing #t)
- (do ()
- ((not pos))
- (set! dline (checked-substring dline pos))
- (let ((epos (or (string-position "</a>" dline)
- (string-position "</A>" dline))))
- (if (not epos)
- (format #t "<a> but no </a> for ~A~%" dline)
- (begin
- (set! (names n) (checked-substring dline 0 (+ epos 4)))
- (set! (files n) (car file))
- (set! (topics n) topic)
- (incf n)
- (set! dline (checked-substring dline (+ epos 4)))
- (set! pos-simple (or (string-position "<a name=" dline)
- (and with-clm-locals
- (string-position "<a Name=" dline))))
- (set! pos-def (or (string-position "<a class=def name=" dline)
- (string-position "<A class=def name=" dline)
- (and with-clm-locals
- (string-position "<a class=def Name=" dline))))
- (set! pos (or pos-simple pos-def))
- ))))))))
- (if (and xrefing
- (or (not (char=? (dline 0) #\<))
- (string-position "<a href" dline)
- (string-position "<a class=quiet href" dline)
- (string-position "<a class=def href" dline)))
- (set! (xrefs current-general) (string-append (xrefs current-general) dline (format #f "~%"))))
- (when topic
- (let ((hpos (string-position "<hr>" dline)))
- (when hpos
- (set! topic #f))))))
- (line-loop (read-line f))))))))
-
- ;; end call-with-input-file loop
+ (set! (topics n) topic)
+ (set! n (+ n 1))
+ (set! dline (substring dline (+ epos 4)))
+ (set! pos (string-position "<em class=def id=" dline))
+ )))))
+ )))
+ (if (and xrefing
+ (or (not (char=? (dline 0) #\<))
+ (string-position "<a href" dline)
+ (string-position "<a class=quiet href" dline)
+ (string-position "<a class=def href" dline)))
+ (set! (xrefs current-general) (string-append (xrefs current-general) dline (format #f "~%"))))
+ (when topic
+ (let ((hpos (string-position "<hr>" dline)))
+ (when hpos
+ (set! topic #f))))))))))
+ ;; end call-with-input-file loop
(let ((tnames (make-vector (+ n g)))
(ctr 0))
@@ -801,24 +1043,17 @@
((= i n))
(set! (tnames ctr)
(clean-and-downcase-first-char (names i) capitalized (topics i) (files i)))
- (if (> (length (ind-sortby (tnames ctr))) 0)
- (incf ctr)))
+ (if (positive? (length (ind-sortby (tnames ctr))))
+ (set! ctr (+ ctr 1))))
- (when (not (= ctr n))
+ (unless (= ctr n)
(set! n ctr)
- (let ((temp (make-vector n)))
- (do ((i 0 (+ i 1)))
- ((= i n))
- (set! (temp i) (tnames i)))
- (set! tnames temp)))
+ (set! tnames (copy tnames (make-vector n))))
- (when (> g 0)
+ (when (positive? g)
(if (< (length tnames) (+ g n))
- (let ((temp (make-vector (+ g n) #f)))
- (do ((i 0 (+ i 1)))
- ((= i n))
- (set! (temp i) (tnames i)))
- (set! tnames temp)))
+ (set! tnames (copy tnames (make-vector (+ g n) #f))))
+
(do ((i 0 (+ i 1)))
((= i g))
(set! (tnames (+ i n))
@@ -830,7 +1065,7 @@
(ind-sortby b)))))
(let ((len (length tnames)))
- (let ((new-names (make-vector (+ len 80)))
+ (let ((new-names (make-vector (+ len 100)))
(j 0)
(last-char #f))
(do ((i 0 (+ i 1)))
@@ -839,7 +1074,7 @@
(if (and name
(ind-sortby name))
(let ((this-char ((ind-sortby name) 0)))
- (if (char-ci=? this-char #\*)
+ (if (char=? this-char #\*)
(set! this-char ((ind-sortby name) 1)))
(if (and last-char
(not (char-ci=? last-char this-char)))
@@ -861,11 +1096,12 @@
(call-with-output-file output
(lambda (ofil)
- (format ofil "<html>
+ (format ofil "<!DOCTYPE html>
+<html lang=\"en\">
<head>
+<meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" >
<title>Snd Index</title>
<style type=\"text/css\">
-<!--
EM.red {color:red; font-style:normal}
EM.typing {color:maroon; font-style: normal}
EM.listener {color:darkblue; font-style: normal}
@@ -873,31 +1109,42 @@
EM.def {font-weight: bold; font-style: normal}
H1 {text-align: center}
UL {list-style-type: none}
+ DIV.centered {text-align: center}
A {text-decoration:none}
A:hover {text-decoration:underline}
A.quiet {color:black; text-decoration:none}
A.quiet:hover {text-decoration:underline}
--->
+
+ TD.green {background-color: lightgreen}
+ TD.beige {background-color: beige}
+ DIV.topheader {margin-top: 10px;
+ margin-bottom: 40px;
+ border: 4px solid #00ff00; /* green */
+ background-color: #f5f5dc; /* beige */
+ font-family: 'Helvetica';
+ font-size: 30px;
+ text-align: center;
+ padding-top: 10px;
+ padding-bottom: 10px;
+ }
+ BODY.body {background-color: #ffffff; /* white */
+ /* margin-left: 0.5cm; */
+ }
</style>
</head>
-<body bgcolor=white>
-
-<table border=0 bordercolor=\"lightgreen\" width=100% cellpadding=2 cellspacing=0><tr><td bgcolor=\"lightgreen\">
-<table width=100% border=0><tr><td bgcolor=\"beige\" align=\"center\" valign=\"middle\"><h1>Index</h1></td></tr></table>
-</td></tr></table>
-
-<br>
+<body class=\"body\">
+<div class=\"topheader\">Index</div>
<!-- created ~A -->~%" (creation-date))
- (format ofil "<table cellspacing=0 cellpadding=1>~% <tr>")
+ (format ofil "<table>~% <tr>")
(set! got-tr #t)
(let ((row 0)
(ctr 0)
(offset (ceiling (/ n cols))))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((>= row offset))
- (let* ((x (+ row (* ctr offset))))
+ (let ((x (+ row (* ctr offset))))
(if (< x n)
(let ((name (tnames x)))
(format ofil
@@ -905,16 +1152,14 @@
(if (not (ind-name name))
""
(if (not (ind-sortby name))
- " bgcolor=\"lightgreen\""
+ " class=\"green\""
""))
(if (ind-char name)
- "<center>"
+ "<div class=\"centered\">"
"<em class=tab>")
- (if (ind-char name)
- (ind-char name)
- (if (ind-name name)
- (ind-name name)
- " "))
+ (or (ind-char name)
+ (ind-name name)
+ " ")
; (if (and (not (ind-char name))
; (string? (ind-file name))
; (string=? (ind-file name) "s7.html"))
@@ -922,7 +1167,7 @@
; "")
;; this looks kinda dumb
(if (ind-char name)
- "</center>"
+ "</div>"
"</em>")
)
(if (ind-indexed name)
@@ -930,15 +1175,13 @@
(set! (ind-indexed name) #t))
(format ofil "~%")))
- (incf ctr)
+ (set! ctr (+ ctr 1))
(when (< ctr cols)
- (if (= row 0)
- (format ofil "<td width=20></td>")
- (format ofil "<td></td>")))
+ (format ofil "<td></td>"))
(when (= ctr cols)
(if got-tr (begin (format ofil "</tr>~%") (set! got-tr #f)))
- (incf row)
+ (set! row (+ row 1))
(if (< i n) (begin (format ofil " <tr>") (set! got-tr #t)))
(set! ctr 0))))
(format ofil "~%</table>~%</body></html>~%")))
@@ -955,35 +1198,36 @@
(n2 (tnames (+ i 1))))
(if (and (string? (ind-sortby n1))
(string? (ind-sortby n2))
- (string=? (ind-sortby n1) (ind-sortby n2)))
+ (string=? (ind-sortby n1) (ind-sortby n2))
+ (string=? (ind-name n1) (ind-name n2)))
(format #t "duplicated name: ~A (~A ~A)~%" (ind-sortby n1) (ind-name n1) (ind-name n2)))))
(if with-scm
(begin
(call-with-output-file "test.c"
(lambda (sfil)
- (let ((help-names '())
- (help-urls '()))
+ (let ((help-names ())
+ (help-urls ()))
(format sfil "/* Snd help index (generated by make-index.scm) */~%")
(do ((i 0 (+ i 1)))
((= i n))
(if (and (tnames i)
(ind-sortby (tnames i)))
- (let* ((line (checked-substring (ind-name (tnames i)) 8))
+ (let* ((line (substring (ind-name (tnames i)) 8))
(dpos (char-position #\> line))
- (url (checked-substring line 1 (- dpos 1)))
+ (url (substring line 1 (- dpos 1)))
(epos (char-position #\< line))
- (ind (checked-substring line (+ 1 dpos) epos))
+ (ind (substring line (+ dpos 1) epos))
(gpos (string-position ">" ind)))
(if gpos
- (set! ind (string-append (checked-substring ind 0 gpos)
+ (set! ind (string-append (substring ind 0 gpos)
">"
- (checked-substring ind (+ gpos 4)))))
+ (substring ind (+ gpos 4)))))
(when (and ind
(string? ind)
- (> (length ind) 0))
- (push ind help-names)
- (push url help-urls)))))
+ (positive? (length ind)))
+ (set! help-names (cons ind help-names))
+ (set! help-urls (cons url help-urls))))))
(set! help-names (reverse help-names))
(set! help-urls (reverse help-urls))
@@ -1035,31 +1279,23 @@
(format sfil "~%static const char *~A_xrefs[] = {~% ~A,~% NULL};~%"
(let* ((str (generals i))
(mid (char-position #\: str)))
- (make-vector-name (checked-substring str (+ 1 mid))))
+ (make-vector-name (substring str (+ mid 1))))
(car vals))
(format sfil "~%static const char *~A_urls[] = {~% ~ANULL};~%"
(let* ((str (generals i))
(mid (char-position #\: str)))
- (make-vector-name (checked-substring str (+ 1 mid))))
+ (make-vector-name (substring str (+ mid 1))))
(cadr vals))
))
)
(format sfil "~%~%#if HAVE_SCHEME~%")
+ )))
- ;(run-indexer)
+ (system "cat indexer.data >> test.c")
+ (system "echo '#endif\n\n' >> test.c")
- (call-with-input-file "indexer.data"
- (lambda (pfil)
- (let line-loop ((line (read-line pfil)))
- (if (not (eof-object? line))
- (begin
- (write-line line sfil)
- (line-loop (read-line pfil)))))))
-
- (format sfil "#endif~%~%")
- ))
- ))))))
+ )))))
;;; --------------------------------------------------------------------------------
@@ -1072,16 +1308,13 @@
(define (html-check files)
(let ((name 0)
(href 0)
- (names (make-vector array-size #f))
- (hrefs (make-vector array-size #f))
- (refs (make-vector array-size #f))
- (lines (make-vector array-size #f))
- (commands '()))
+ (names (make-hash-table 2048)))
(for-each
(lambda (file)
(call-with-input-file file
(lambda (f)
(let ((linectr -1)
+ (commands ())
(comments 0)
(openctr 0)
(warned #f)
@@ -1090,336 +1323,354 @@
(p-curlys 0)
(in-comment #f)
(scripting #f))
- (let line-loop ((line (read-line f)))
- (if (not (eof-object? line))
- (begin
- (incf linectr)
- (let ((len (length line)))
- (when (and line
- (positive? len))
- ;; open/close html entities
- (do ((i 0 (+ i 1)))
- ((>= i len))
- (let ((c (line i)))
-
- (if (char=? c #\<)
- (begin
- (if (and (not (= openctr 0))
- (not (> p-quotes 0)))
- (if (not in-comment)
- (format #t "~A[~D]: ~A has unclosed <?~%" file linectr line)))
- (incf openctr)
- (if (and (< i (- len 3))
- (char=? (line (+ i 1)) #\!)
- (char=? (line (+ i 2)) #\-)
- (char=? (line (+ i 3)) #\-))
- (begin
- (incf comments)
- (if (> comments 1)
- (begin
- (format #t "~A[~D]: nested <!--?~%" file linectr)
- (decf comments)))
- (set! in-comment #t)))
- (if (and (not in-comment)
- (< i (- len 1))
- (char=? (line (+ i 1)) #\space))
- (format #t "~A[~D]: '< ' in ~A?~%" file linectr line)))
-
- ;; else c != <
+ (do ((line (read-line f) (read-line f)))
+ ((eof-object? line))
+ (set! linectr (+ linectr 1))
+ (let* ((len (length line))
+ (opos (and (positive? len)
+ (char-position "<>\"(){}&" line)))
+ (cpos (and (not opos)
+ in-comment
+ (string-position " -- " line))))
+ (when cpos
+ (format #t "~A[~D]: possible -- in comment: ~A~%" file linectr line))
+ (when opos
+ ;; open/close html entities
+ (do ((i opos (or (char-position "<>\"(){}&" line (+ i 1)) len)))
+ ((>= i len))
+ (case (string-ref line i)
+ ((#\<)
+ (unless scripting
+ (if (and (not (zero? openctr))
+ (not (positive? p-quotes))
+ (not in-comment))
+ (format #t "~A[~D]: ~A has unclosed <?~%" file linectr line))
+ (set! openctr (+ openctr 1))
+ (if (and (< i (- len 3))
+ (char=? (line (+ i 1)) #\!)
+ (char=? (line (+ i 2)) #\-)
+ (char=? (line (+ i 3)) #\-))
+ (begin
+ (set! comments (+ comments 1))
+ (if (> comments 1)
+ (begin
+ (format #t "~A[~D]: nested <!--?~%" file linectr)
+ (set! comments (- comments 1))))
+ (set! in-comment #t)))
+ (if (and (not in-comment)
+ (< i (- len 1))
+ (char=? (line (+ i 1)) #\space))
+ (format #t "~A[~D]: '< ' in ~A?~%" file linectr line))))
+ ;; else c != <
+
+ ((#\>)
+ (unless scripting
+ (set! openctr (- openctr 1))
+ (if (and (>= i 2)
+ (char=? (line (- i 1)) #\-)
+ (char=? (line (- i 2)) #\-))
+ (begin
+ (set! in-comment #f)
+ (set! comments (- comments 1))
+ (if (< comments 0)
+ (begin
+ (format #t "~A[~D]: extra -->?~%" file linectr)
+ (set! comments 0))))
+ (if (and (not (zero? openctr))
+ (not (positive? p-quotes))
+ (not in-comment))
+ (format #t "~A[~D]: ~A has unmatched >?~%" file linectr line)))
+ (set! openctr 0)
+ (if (and (not in-comment)
+ (>= i 2)
+ (char=? (line (- i 1)) #\-)
+ (not (char=? (line (- i 2)) #\-))
+ (< i (- len 1))
+ (alphanumeric? (line (+ i 1))))
+ (format #t "~A[~D]: untranslated '>': ~A~%" file linectr line))))
+ ;; else c != < or >
+
+ ((#\()
+ (set! p-parens (+ p-parens 1)))
+
+ ((#\))
+ (set! p-parens (- p-parens 1)))
+
+ ((#\")
+ (if (or (= i 0)
+ (not (char=? (line (- i 1)) #\\)))
+ (set! p-quotes (+ p-quotes 1))))
+
+ ((#\&)
+ (if (and (not in-comment)
+ (case (string-ref line (+ i 1))
+ ((#\g) (not (string=? ">" (substring line i (min len (+ i 4))))))
+ ((#\l) (and (not (string=? "<" (substring line i (min len (+ i 4)))))
+ (not (string=? "λ" (substring line i (min len (+ i 8)))))))
+ ((#\a) (not (string=? "&" (substring line i (min len (+ i 5))))))
+ ((#\q) (not (string=? """ (substring line i (min len (+ i 6))))))
+ ((#\o) (not (string=? "ö" (substring line i (min len (+ i 6))))))
+ ((#\m) (and (not (string=? "—" (substring line i (min len (+ i 7)))))
+ (not (string=? "µ" (substring line i (min len (+ i 7)))))))
+ ((#\n) (not (string=? " " (substring line i (min len (+ i 6))))))
+ ((#\&) (not (string=? "&&" (substring line i (min len (+ i 2))))))
+ ((#\space) (not (string=? "& " (substring line i (min len (+ i 2)))))) ; following char -- should skip this
+ (else #t)))
+ (format #t "~A[~D]: unknown escape sequence: ~A~%" file linectr line)))
+
+ ((#\{)
+ (set! p-curlys (+ p-curlys 1)))
+
+ ((#\})
+ (set! p-curlys (- p-curlys 1)))))
+
+ ;; end line scan
+ (if (not in-comment)
+ (let ((start #f)
+ (closing #f)
+ (pos (char-position #\< line)))
+ (if pos
+ (do ((i pos (or (char-position "</! >" line (+ i 1)) len)))
+ ((>= i len))
+ (case (string-ref line i)
+ ((#\space #\>)
+ (if start
+ (begin
+ (if closing
+ (let ((closer (string->symbol (substring line (+ start 2) i))))
+ (if (eq? closer 'TABLE) (set! closer 'table))
+ (if (memq closer '(center big font))
+ (format #t "~A[~D]: ~A is obsolete, ~A~%" file linectr closer line)
+ (if (eq? closer 'script)
+ (set! scripting #f)
+ (if (not scripting)
+ (if (not (memq closer commands))
+ (format #t "~A[~D]: ~A without start? ~A from [~D:~D] (commands: ~A)~%"
+ file linectr closer line (+ start 2) i commands)
+
+ (if (memq closer '(ul tr td table small sub blockquote p details summary
+ a A i b title pre span h1 h2 h3 code body html
+ em head h4 sup map smaller bigger th tbody div))
+ (begin
+ (if (not (eq? (car commands) closer))
+ (format #t "~A[~D]: ~A -> ~A?~%" file linectr closer commands))
+
+ (if (memq closer '(p td pre))
+ (begin
+ (if (odd? p-quotes)
+ (format #t "~A[~D]: unmatched quote~%" file linectr))
+ (set! p-quotes 0)
+ (if (= p-curlys 1)
+ (format #t "~A[~D]: extra '{'~%" file linectr)
+ (if (= p-curlys -1)
+ (format #t "~A[~D]: extra '}'~%" file linectr)
+ (if (not (= p-curlys 0))
+ (format #t "~A[~D]: curlys: ~D~%" file linectr p-curlys))))
+ (set! p-curlys 0)
+ (if (= p-parens 1)
+ (format #t "~A[~D]: extra '('~%" file linectr)
+ (if (= p-parens -1)
+ (format #t "~A[~D]: extra ')'~%" file linectr)
+ (if (not (= p-parens 0))
+ (format #t "~A[~D]: parens: ~D~%" file linectr p-parens))))
+ (set! p-parens 0)))
+ (set! commands (remove-one closer commands))
+ (if (not warned)
+ (begin
+ (if (and (eq? closer 'table)
+ (not (memq 'table commands)))
+ (begin
+ (if (memq 'tr commands)
+ (begin
+ (set! warned #t)
+ (set! commands (remove-all 'tr commands))
+ (format #t "~A[~D]: unclosed tr at table (~A)~%" file linectr commands)))
+ (if (memq 'td commands)
+ (begin
+ (set! warned #t)
+ (set! commands (remove-all 'td commands))
+ (format #t "~A[~D]: unclosed td at table (~A)~%" file linectr commands))))))))
+ (set! commands (remove-all closer commands)))))))
+ (set! closing #f))
+
+ ;; not closing
+ (if (not scripting)
+ (let ((opener (string->symbol (substring line (+ start 1) i))))
+ (if (eq? opener 'TABLE) (set! opener 'table))
+ (if (memq opener '(center big font))
+ (format #t "~A[~D]: ~A is obsolete, ~A~%" file linectr opener line)
+
+ (if (eq? opener 'script)
+ (set! scripting #t)
+
+ (if (eq? opener 'img)
+ (let* ((rest-line (substring line (+ start 4)))
+ (alt-pos (string-position "alt=" rest-line))
+ (src-pos (string-position "src=" rest-line)))
+ (if (not alt-pos)
+ (format #t "~A[~D]: img but no alt: ~A~%" file linectr line))
+ (if src-pos
+ (let ((png-pos (string-position ".png" rest-line)))
+ (if png-pos
+ (let ((file (substring rest-line (+ src-pos 5) (+ png-pos 4))))
+ (if (not (file-exists? file))
+ (format #t "~A[~D]: src not found: ~S~%" file linectr file)))))))
+
+ (if (and (not (memq opener '(br spacer li hr area
+ ul tr td table small sub blockquote)))
+ (memq opener commands)
+ (= p-quotes 0))
+ (format #t "~A[~D]: nested ~A? ~A from: ~A~%" file linectr opener line commands)
+ (begin
+ (case opener
+ ((td)
+ (if (not (eq? 'tr (car commands)))
+ (format #t "~A[~D]: td without tr?~%" file linectr))
+ (if (and (not warned)
+ (memq 'td commands)
+ (< (count-table commands) 2))
+ (begin
+ (set! warned #t)
+ (set! commands (remove-one 'td commands))
+ (format #t "~A[~D]: unclosed td at table~%" file linectr))))
+ ((tr)
+ (if (and (not (eq? (car commands) 'table))
+ (not (eq? (cadr commands) 'table)))
+ (format #t "~A[~D]: tr without table?~%" file linectr))
+ (if (and (not warned)
+ (memq 'tr commands)
+ (< (count-table commands) 2))
+ (begin
+ (set! warned #t)
+ (set! commands (remove-one 'tr commands))
+ (format #t "~A[~D]: unclosed tr at table~%" file linectr))))
+ ((p)
+ (if (eq? (car commands) 'table)
+ (format #t "~A[~D]: unclosed table?~%" file linectr)))
+
+ ((pre br table hr img ul)
+ (if (memq 'p commands)
+ (format #t "~A[~D]: ~A within <p>?~%" file linectr opener)))
+ ((li)
+ (if (not (memq 'ul commands))
+ (format #t "~A[~D]: li without ul~%" file linectr)))
+ ((small)
+ (if (memq (car commands) '(pre code))
+ (format #t "~A[~D]: small shouldn't follow ~A~%" file linectr (car commands))))
+ ((--)
+ (format #t "~A[~D]: <-- missing !?~%" file linectr)))
+ (if (not (memq opener '(br meta spacer li hr area)))
+ (set! commands (cons opener commands)))))))))))
+ ;; end if closing
+ (set! start #f))))
+
+ ((#\<)
+ (if start
+ (if (and (not scripting)
+ (not (positive? p-quotes)))
+ (format #t "~A[~D]: nested < ~A~%" file linectr line))
+ (set! start i)))
+ ((#\/)
+ (if (and start (= start (- i 1)))
+ (set! closing #t)))
- (if (char=? c #\>)
- (begin
- (decf openctr)
- (if (and (>= i 2)
- (char=? (line (- i 1)) #\-)
- (char=? (line (- i 2)) #\-))
- (begin
- (set! in-comment #f)
- (decf comments)
- (if (< comments 0)
- (begin
- (format #t "~A[~D]: extra -->?~%" file linectr)
- (set! comments 0))))
- (if (and (not (= openctr 0))
- (not (> p-quotes 0)))
- (if (not in-comment)
- (format #t "~A[~D]: ~A has unmatched >?~%" file linectr line))))
- (set! openctr 0)
- (if (and (not in-comment)
- (>= i 2)
- (char=? (line (- i 1)) #\-)
- (not (char=? (line (- i 2)) #\-))
- (< i (- len 1))
- (alphanumeric? (line (+ i 1))))
- (format #t "~A[~D]: untranslated '>': ~A~%" file linectr line)))
-
- ;; else c != < or >
-
- (if (char=? c #\&)
- (if (and (not in-comment)
- (not (string-ci=? ">" (checked-substring line i (+ i 4))))
- (not (string-ci=? "<" (checked-substring line i (+ i 4))))
- (not (string-ci=? "&" (checked-substring line i (+ i 5))))
- (not (string-ci=? "µ" (checked-substring line i (+ i 7))))
- (not (string-ci=? """ (checked-substring line i (+ i 6))))
- (not (string-ci=? "ö" (checked-substring line i (+ i 6))))
- (not (string-ci=? "—" (checked-substring line i (+ i 7))))
- (not (string-ci=? "&&" (checked-substring line i (+ i 2))))
- (not (string-ci=? "& " (checked-substring line i (+ i 2))))) ; following char -- should skip this
- (format #t "~A[~D]: unknown escape sequence: ~A~%" file linectr line))
-
- (if (char=? c #\()
- (incf p-parens)
-
- (if (char=? c #\))
- (decf p-parens)
-
- (if (char=? c #\{)
- (incf p-curlys)
-
- (if (char=? c #\})
- (decf p-curlys)
-
- (if (and (char=? c #\")
- (or (= i 0)
- (not (char=? (line (- i 1)) #\\))))
- (incf p-quotes)))))))))))
- ;; end line scan
- (if (not in-comment)
- (let ((start #f)
- (closing #f))
- (do ((i 0 (+ i 1)))
- ((>= i len))
- (let ((c (line i)))
-
- (if (char=? c #\<)
- (if start
- (if (and (not scripting)
- (not (> p-quotes 0)))
- (format #t "~A[~D]: nested < ~A~%" file linectr line))
- (set! start i))
-
- (if (char=? c #\/)
- (if (and start (= start (- i 1)))
- (set! closing #t))
-
- (if (char=? c #\!)
- (if (and start (= start (- i 1)))
- (set! start #f))
-
- (if (or (char=? c #\space)
- (char=? c #\>))
- (if start
- (begin
- (if closing
- (let ((closer (checked-substring line (+ start 2) i)))
- (if (string-ci=? closer "script")
- (set! scripting #f)
- (if (not scripting)
- (if (not (string-ci-list-position closer commands))
- (format #t "~A[~D]: ~A without start? ~A from [~D:~D] (commands: ~A)~%" file linectr closer line (+ start 2) i commands)
- (if (string-ci-list-position closer
- (list "ul" "tr" "td" "table" "small" "big" "sub" "blockquote" "center" "p"
- "a" "i" "b" "title" "pre" "span" "h1" "h2" "h3" "code" "body" "html"
- "em" "head" "h4" "sup" "font" "map" "smaller" "bigger" "th"))
- (begin
- (if (not (string-ci=? (car commands) closer))
- (format #t "~A[~D]: ~A -> ~A?~%" file linectr closer commands))
-
- (if (or (string-ci=? closer "p")
- (string-ci=? closer "td")
- (string-ci=? closer "pre"))
- (begin
- (if (not (even? p-quotes))
- (format #t "~A[~D]: unmatched quote~%" file linectr))
- (set! p-quotes 0)
- (if (= p-curlys 1)
- (format #t "~A[~D]: extra '{'~%" file linectr)
- (if (= p-curlys -1)
- (format #t "~A[~D]: extra '}'~%" file linectr)
- (if (not (= p-curlys 0))
- (format #t "~A[~D]: curlys: ~D~%" file linectr p-curlys))))
- (set! p-curlys 0)
- (if (= p-parens 1)
- (format #t "~A[~D]: extra '('~%" file linectr)
- (if (= p-parens -1)
- (format #t "~A[~D]: extra ')'~%" file linectr)
- (if (not (= p-parens 0))
- (format #t "~A[~D]: parens: ~D~%" file linectr p-parens))))
- (set! p-parens 0)))
- (set! commands (remove closer commands :count 1))
- (if (not warned)
- (begin
-
- (if (and (string-ci=? closer "table")
- (not (string-ci-list-position "table" commands)))
- (begin
- (if (string-ci-list-position "tr" commands)
- (begin
- (set! warned #t)
- (set! commands (remove "tr" commands))
- (format #t "~A[~D]: unclosed tr at table~%" file linectr)))
- (if (string-ci-list-position "td" commands)
- (begin
- (set! warned #t)
- (set! commands (remove "td" commands))
- (format #t "~A[~D]: unclosed td at table~%" file linectr))))))))
- (set! commands (remove closer commands))))))
- (set! closing #f))
-
- ;; not closing
- (if (not scripting)
- (let ((opener (checked-substring line (+ start 1) i)))
- (if (string-ci=? opener "script")
- (set! scripting #t)
- (if (not (string-ci-list-position opener (list "br" "spacer" "li" "img" "hr" "area")))
- (if (and (string-ci-list-position opener commands)
- (= p-quotes 0)
- (not (string-ci-list-position opener (list "ul" "tr" "td" "table" "small" "big" "sub" "blockquote"))))
- (format #t "~A[~D]: nested ~A? ~A from: ~A~%" file linectr opener line commands)
- (begin
- (if (and (string-ci=? opener "td")
- (not (string-ci-list-position "tr" commands)))
- (format #t "~A[~D]: td without tr?~%" file linectr))
-
- (if (and (string-ci=? opener "td")
- (not (string-ci=? "tr" (car commands))))
- (format #t "~A[~D]: td without tr?~%" file linectr))
- (if (and (string-ci=? opener "tr")
- (not (string-ci=? "table" (car commands))))
- (format #t "~A[~D]: tr without table?~%" file linectr))
- (if (and (string-ci=? opener "p")
- (string-ci=? "table" (car commands)))
- (format #t "~A[~D]: unclosed table?~%" file linectr))
-
- (if (and (string-ci=? opener "tr")
- (not (string-ci-list-position "table" commands)))
- (format #t "~A[~D]: tr without table~%" file linectr))
- (if (and (string-ci-list-position opener (list "pre" "br" "table" "hr" "img" "ul"))
- (string-ci-list-position "p" commands))
- (format #t "~A[~D]: ~A within <p>?~%" file linectr opener))
- (if (and (string-ci=? opener "li")
- (not (string-ci-list-position "ul" commands)))
- (format #t "~A[~D]: li without ul~%" file linectr))
-
- (if (and (string-ci=? opener "small")
- (or (string-ci=? "pre" (car commands))
- (string-ci=? "code" (car commands))))
- (format #t "~A[~D]: small shouldn't follow ~A~%" file linectr (car commands)))
-
- (if (not warned)
- (begin
- (if (and (string-ci=? opener "tr")
- (string-ci-list-position "tr" commands)
- (< (count "table" commands) 2))
- (begin
- (set! warned #t)
- (set! commands (remove "tr" commands :count 1))
- (format #t "~A[~D]: unclosed tr at table~%" file linectr)))
- (if (and (string-ci=? opener "td")
- (string-ci-list-position "td" commands)
- (< (count "table" commands) 2))
- (begin
- (set! warned #t)
- (set! commands (remove "td" commands :count 1))
- (format #t "~A[~D]: unclosed td at table~%" file linectr)))))
- (if (string-ci=? opener "--")
- (format #t "~A[~D]: <-- missing !?~%" file linectr))
- (set! commands (push opener commands)))))))))
- ;; end if closing
- (set! start #f))))))))))
- ) ; if not in-comment...
-
- ;; search for name
- (let* ((dline line)
- (pos-simple (string-ci-position "<a name=" dline))
- (pos-def (string-ci-position "<a class=def name=" dline))
- (pos (or pos-simple pos-def))
- (pos-len (if pos-simple 9 19)))
- (do ()
- ((not pos))
- (set! dline (checked-substring dline (+ pos pos-len)))
- (let ((epos (or (string-position "</a>" dline)
- (string-position "</A>" dline))))
- ;;actually should look for close double quote
- (if (not epos)
- (format #t "~A[~D]: <a name but no </a> for ~A~%" file linectr dline)
- (let ((min-epos (char-position #\space dline)))
- (set! epos (char-position #\> dline))
- (if (and (number? min-epos)
- (< min-epos epos))
- (set! epos min-epos))
- (set! (names name) (string-append file "#" (checked-substring dline 0 (- epos 1))))
- (do ((i 0 (+ i 1)))
- ((= i name))
- (if (string=? (names i) (names name))
- (format #t "~A[~D]: ambiguous name: ~A~%" file linectr (names i))))
- (incf name)
- (set! dline (checked-substring dline epos))
- (set! pos-simple (string-ci-position "<a name=" dline))
- (set! pos-def (string-ci-position "<a class=def name=" dline))
- (set! pos (or pos-simple pos-def))
- (set! pos-len (if pos-simple 9 19)))))))
-
- ;; search for href
- (let* ((dline line)
- (pos-norm (string-position "<a href=" dline)) ; ignore A HREF
- (pos-quiet (string-position "<a class=quiet href=" dline))
- (pos-def (string-position "<a class=def href=" dline))
- (pos (or pos-norm pos-quiet pos-def))
- (pos-len (if pos-norm 9 (if pos-def 19 21))))
- (do ()
- ((not pos))
- (set! dline (checked-substring dline (+ pos pos-len)))
- (let ((epos (or (string-position "</a>" dline)
- (string-position "</A>" dline))))
- (if (not epos)
- (format #t "~A[~D]: <a href but no </a> for ~A~%" file linectr dline)
+ ((#\!)
+ (if (and start (= start (- i 1)))
+ (set! start #f)))))))
+ ) ; if not in-comment...
+
+ ;; search for name
+ (let* ((dline line)
+ (pos (string-position "<em class=def id=" dline))
+ (pos-len 18))
+
+ (do ()
+ ((not pos))
+ (set! dline (substring dline (+ pos pos-len)))
+ (let ((epos (or (string-position "</a>" dline)
+ (string-position "</em>" dline)
+ (string-position "</A>" dline))))
+ ;;actually should look for close double quote
+ (if (not epos)
+ (begin (format #t "~A[~D]: <em...> but no </em> for ~A~%" file linectr dline) (abort))
+ (let ((min-epos (char-position #\space dline)))
+ (set! epos (char-position #\> dline))
+ (if (and (number? min-epos)
+ (< min-epos epos))
+ (set! epos min-epos))
+
+ (let ((new-name (string-append file "#" (substring dline 0 (- epos 1)))))
+ (if (hash-table-ref names new-name)
+ (format #t "~A[~D]: ambiguous name: ~A~%" file linectr new-name))
+ (hash-table-set! names new-name file))
+
+ (set! name (+ name 1))
+ (set! dline (substring dline epos))
+ (set! pos (string-position "<em class=def id=" dline))
+ (set! pos-len 18))))))
+
+ ;; search for href
+ (let* ((dline line)
+ (pos (string-position " href=" dline)) ; ignore A HREF
+ (pos-len 7))
+ (do ()
+ ((not pos))
+ ;; (format #t "~A dline: ~A~%" pos dline)
+ (if (zero? (length dline)) (exit))
+ (set! dline (substring dline (+ pos pos-len)))
+ (let ((epos (char-position #\> dline)))
+ (if (not epos)
+ (format #t "~A[~D]: <a href but no </a> for ~A~%" file linectr dline)
+ (let ((cur-href #f))
+ (set! epos (char-position #\" dline 1))
+ (if (char=? (dline 0) #\#)
+ (set! cur-href (string-append file (substring dline 0 epos)))
(begin
- (set! epos (char-position #\" dline 1))
- (if (char=? (dline 0) #\#)
- (set! (hrefs href) (string-append file (checked-substring dline 0 epos)))
- (begin
- (set! (hrefs href) (checked-substring dline 0 epos))
- (let ((pos (char-position #\# (hrefs href))))
- (if (and (not pos)
- (not (string-ci=? (checked-substring (hrefs href) 0 4) "ftp:"))
- (not (string-ci=? (checked-substring (hrefs href) 0 5) "http:"))
- (not (file-exists? (hrefs href))))
- (format #t "~A[~D]: reference to missing file ~S~%" file linectr (hrefs href))))))
-
- (set! (lines href) linectr)
- (set! (refs href) file)
- (incf href)
- (set! dline (checked-substring dline epos))
- (set! pos-norm (string-position "<a href=" dline))
- (set! pos-quiet (string-position "<a class=quiet href=" dline))
- (set! pos-def (string-position "<a class=def href=" dline))
- (set! pos (or pos-norm pos-quiet pos-def))
- (set! pos-len (if pos-norm 9 (if pos-def 19 21))))))))))
- (line-loop (read-line f))))))))
-
- (if (not (null? commands)) (format #t "open directives at end of ~A: ~A~%" file commands))
- (set! commands '()))
+ (set! cur-href (substring dline 0 epos))
+ (let ((pos (char-position #\# cur-href)))
+ (if (and (not pos)
+ (> epos 5)
+ (not (file-exists? cur-href))
+ (not (string=? (substring cur-href 0 4) "ftp:"))
+ (not (string=? (substring cur-href 0 5) "http:")))
+ (format #t "~A[~D]: reference to missing file ~S~%" file linectr cur-href)))))
+
+ ;; cur-href here is the full link: sndclm.html#make-filetosample for example
+ ;; it can also be a bare file name
+ (let* ((start (char-position #\# cur-href))
+ (name (and (number? start)
+ (string->symbol (substring cur-href (+ start 1)))))
+ (data (and (symbol? name)
+ (hash-table-ref ids name))))
+ (if name
+ (if (not data)
+ (format #t ";can't find id ~A~%" name)
+ (hash-table-set! ids name (+ data 1)))))
+
+ (set! href (+ href 1))
+ (set! dline (substring dline epos))
+ (set! pos (string-position " href=" dline))
+ (set! pos-len 7))))))))
+ )
+ (if (pair? commands)
+ (format #t "open directives at end of ~A: ~A~%" file commands))))))
files)
;; end file scan
(format #t "found ~D names and ~D references~%" name href)
- (do ((h 0 (+ h 1)))
- ((= h href))
- (if (and (string? (hrefs h))
- (not (string-vector-position (hrefs h) names))
- (char-position #\# (hrefs h)))
- (format #t "undef'd: ~A (~A: ~A)~%" (hrefs h) (refs h) (lines h))))))
-
+ (for-each
+ (lambda (data)
+ (if (zero? (cdr data))
+ (format #t ";~A unref'd~%" (car data))))
+ ids)
+ ))
-(html-check '("sndlib.html" "snd.html" "extsnd.html" "grfsnd.html" "sndclm.html"
- "sndscm.html" "fm.html" "quick.html" "s7.html"
- "xen.html" "libxm.html" "index.html"))
-(make-index-1 '("snd.html" "extsnd.html" "grfsnd.html" "sndscm.html" "sndlib.html" "sndclm.html" "fm.html" "quick.html" "s7.html")
+(make-index-1 '("snd.html" "extsnd.html" "grfsnd.html" "sndscm.html" "sndlib.html" "sndclm.html" "fm.html" "s7.html")
"test.html" 5 '("AIFF" "NeXT" "Sun" "RIFF" "IRCAM" "FIR" "IIR" "Hilbert" "AIFC") #t #t)
-(exit)
+(html-check '("sndlib.html" "snd.html" "extsnd.html" "grfsnd.html" "sndclm.html" "sndscm.html" "fm.html" "s7.html" "index.html"))
+(s7-version)
+(exit)
diff --git a/tools/makegl.scm b/tools/makegl.scm
index dee5e49..2c47bec 100755
--- a/tools/makegl.scm
+++ b/tools/makegl.scm
@@ -2,25 +2,25 @@
(define gl-file (open-output-file "gl.c"))
-(define (hey . args)
- (display (apply format #f args) gl-file))
+(define-expansion (hey . args)
+ `(format gl-file , at args))
(define (heyc arg)
(display arg gl-file))
-(define names '())
-(define types '())
-(define ints '())
-(define funcs '())
+(define names ())
+(define types ())
+(define ints ())
+(define funcs ())
-(define x-types '())
-(define x-funcs '())
-(define x-ints '())
-;(define g-types '())
-;(define g-funcs '())
-;(define g-ints '())
-;(define g5-funcs '())
-;(define g5-ints '())
+(define x-types ())
+(define x-funcs ())
+(define x-ints ())
+;(define g-types ())
+;(define g-funcs ())
+;(define g-ints ())
+;(define g5-funcs ())
+;(define g5-ints ())
(define in-glu #f)
@@ -42,57 +42,31 @@
(set! in-glu #f))))
(define (cadr-str data)
- (let ((sp1 -1)
- (len (string-length data)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) (substring data sp1))
- (if (char=? (string-ref data i) #\space)
- (if (= sp1 -1)
- (set! sp1 i)
- (return (substring data (+ 1 sp1) i)))))))))
+ (let ((sp1 (char-position #\space data)))
+ (let ((sp2 (char-position #\space data (+ sp1 1))))
+ (if sp2
+ (substring data (+ sp1 1) sp2)
+ (substring data sp1)))))
(define (caddr-str data)
- (let ((sp1 -1)
- (sp2 -1)
- (len (string-length data)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) (substring data sp2))
- (if (char=? (string-ref data i) #\space)
- (if (= sp1 -1)
- (set! sp1 i)
- (if (= sp2 -1)
- (set! sp2 i)
- (return (substring data (+ 1 sp2)))))))))))
+ (let ((sp1 (char-position #\space data)))
+ (let ((sp2 (char-position #\space data (+ sp1 1))))
+ (let ((sp3 (char-position #\space data (+ sp2 1))))
+ (if sp3
+ (substring data (+ sp2 1))
+ (substring data sp2))))))
(define (car-str data)
- (let ((len (string-length data)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) data)
- (if (char=? (string-ref data i) #\space)
- (return (substring data 0 i))))))))
+ (let ((sp (char-position #\space data)))
+ (if sp
+ (substring data 0 sp)
+ data)))
(define (cdr-str data)
- (let ((len (string-length data)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) data)
- (if (char=? (string-ref data i) #\space)
- (return (substring data (+ 1 i)))))))))
-
-(define (string-upcase name)
- (let* ((len (string-length name))
- (str (make-string len)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (string-set! str i (char-upcase (string-ref name i))))
- str))
+ (let ((sp (char-position #\space data)))
+ (if sp
+ (substring data (+ sp 1))
+ data)))
(define (ref-arg? arg)
(and (= (length arg) 3)
@@ -126,30 +100,29 @@
(define (deref-type arg)
(let ((type (car arg)))
- (substring type 0 (- (string-length type) 1))))
+ (substring type 0 (- (length type) 1))))
(define (deref-name arg)
- (let* ((name (cadr arg)))
+ (let ((name (cadr arg)))
(string-append "ref_" name)))
(define (derefable type)
- (let ((len (string-length type)))
+ (let ((len (length type)))
(call-with-exit
(lambda (return)
(do ((i (- len 1) (- i 1))
(ctr 0 (+ 1 ctr)))
((= i 0) #f)
- (if (not (char=? (string-ref type i) #\*))
+ (if (not (char=? (type i) #\*))
(return (> ctr 1))))))))
(define (has-stars type)
- (let ((len (string-length type)))
+ (let ((len (length type)))
(call-with-exit
(lambda (return)
- (do ((i (- len 1) (- i 1))
- (ctr 0 (+ 1 ctr)))
+ (do ((i (- len 1) (- i 1)))
((= i 0) #f)
- (if (char=? (string-ref type i) #\*)
+ (if (char=? (type i) #\*)
(return #t)))
#f))))
@@ -158,54 +131,54 @@
"Display"
(if (string=? type "XVisualInfo*")
"XVisualInfo"
- (let ((len (string-length type))
+ (let ((len (length type))
(val (string-copy type)))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len) val)
- (if (char=? (string-ref val i) #\*)
- (string-set! val i #\_)))))))
+ (if (char=? (val i) #\*)
+ (set! (val i) #\_)))))))
(define (no-arg-or-stars name)
- (let ((len (string-length name)))
+ (let ((len (length name)))
(call-with-exit
(lambda (return)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len) name)
- (if (or (char=? (string-ref name i) #\()
- (char=? (string-ref name i) #\*))
+ (if (or (char=? (name i) #\()
+ (char=? (name i) #\*))
(return (substring name 0 i))))))))
(define* (parse-args args x)
- (let ((data '())
+ (let ((data ())
(sp -1)
(type #f)
- (len (string-length args)))
+ (len (length args)))
(if (string=? args "void")
- '()
- (do ((i 0 (+ 1 i)))
+ ()
+ (do ((i 0 (+ i 1)))
((= i len) (reverse data))
- (let ((ch (string-ref args i)))
+ (let ((ch (args i)))
(if (or (char=? ch #\space)
(= i (- len 1)))
(begin
(if type
- (let* ((given-name (substring args (+ 1 sp) (if (= i (- len 1)) (+ 1 i) i)))
- (reftype #f))
- (if (char=? (string-ref given-name 0) #\@)
+ (let ((given-name (substring args (+ 1 sp) (if (= i (- len 1)) (+ i 1) i)))
+ (reftype #f))
+ (if (char=? (given-name 0) #\@)
(set! data (cons (list type
- (substring given-name 1 (string-length given-name))
+ (substring given-name 1 (length given-name))
'null)
data))
- (if (char=? (string-ref given-name 0) #\#)
+ (if (char=? (given-name 0) #\#)
(set! data (cons (list type
- (substring given-name 1 (string-length given-name))
+ (substring given-name 1 (length given-name))
'opt)
data))
- (if (char=? (string-ref given-name 0) #\[)
+ (if (char=? (given-name 0) #\[)
(begin
(set! reftype (deref-type (list type)))
(set! data (cons (list type
- (substring given-name 1 (- (string-length given-name) 1))
+ (substring given-name 1 (- (length given-name) 1))
given-name)
data)))
(set! data (cons (list type given-name) data)))))
@@ -213,11 +186,9 @@
(if (eq? x 'x)
(if (not (member type x-types))
(set! x-types (cons type x-types)))
- (if (eq? x 'g)
- (if (not (member type g-types))
- (set! g-types (cons type g-types)))
- (if (not (member type types))
- (set! types (cons type types)))))
+ (if (and (not (eq? x 'g))
+ (not (member type types)))
+ (set! types (cons type types))))
(set! type #f))
(if (> i (+ 1 sp))
(set! type (substring args (+ 1 sp) i))))
@@ -225,14 +196,14 @@
(define (helpify name type args)
(let* ((initial (format #f " #define H_~A \"~A ~A(" name type name))
- (line-len (string-length initial))
- (len (string-length args))
+ (line-len (length initial))
+ (len (length args))
(typed #f)
(help-max 100))
(hey initial)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((ch (string-ref args i)))
+ (let ((ch (args i)))
(if (char=? ch #\space)
(if typed
(begin
@@ -290,9 +261,28 @@
"gluGetTessProperty" "gluTessBeginContour" "gluTessBeginPolygon" "gluTessEndContour" "gluTessEndPolygon"
"gluTessNormal" "gluTessProperty" "gluNewTess"))
+(define (c-to-xen-macro-name typ str)
+ (if (string=? str "INT") "C_int_to_Xen_integer"
+ (if (string=? str "DOUBLE") "C_double_to_Xen_real"
+ (if (string=? str "BOOLEAN") "C_bool_to_Xen_boolean"
+ (if (string=? str "ULONG") "C_ulong_to_Xen_ulong"
+ (if (string-ci=? str "String")
+ (if (string=? (car typ) "guchar*")
+ "C_to_Xen_String"
+ "C_string_to_Xen_string")
+ (format #f "~A unknown" str)))))))
+
+(define (xen-to-c-macro-name str)
+ (if (string=? str "INT") "Xen_integer_to_C_int"
+ (if (string=? str "DOUBLE") "Xen_real_to_C_double"
+ (if (string=? str "BOOLEAN") "Xen_boolean_to_C_bool"
+ (if (string=? str "ULONG") "Xen_ulong_to_C_ulong"
+ (if (string-ci=? str "String")
+ "Xen_string_to_C_string"
+ (format #f "~A unknown" str)))))))
+
(define (type-it type)
- (let ((typ (assoc type direct-types))
- (g2 '()))
+ (let ((typ (assoc type direct-types)))
(if typ
(if (cdr typ)
(begin
@@ -302,38 +292,42 @@
(list "Display*" "XVisualInfo*" "int*" "Pixmap" "Font" "GLubyte*"
"GLdouble*" "GLfloat*" "GLvoid*" "GLuint*"
"GLboolean*" "void*" "GLint*" "GLshort*"
- "GLsizei" "GLclampd" "GLclampf" "GLbitfield" "GLshort" "GLubyte" "GLbyte"
+ "GLsizei" "GLclampd" "GLclampf" "GLbitfield" "GLshort" "GLbyte"
"unsigned_long"
"void**")))
(if (string=? (car typ) "constchar*")
- (hey "#define C_TO_XEN_~A(Arg) C_TO_XEN_~A((char *)(Arg))~%" (no-stars (car typ)) (cdr typ))
- (hey "#define C_TO_XEN_~A(Arg) C_TO_XEN_~A(Arg)~%" (no-stars (car typ)) (cdr typ))))
- (if (not (member (car typ)
- (list "constchar*")))
- (hey "#define XEN_TO_C_~A(Arg) (~A)(XEN_TO_C_~A(Arg))~%"
- (no-stars (car typ)) (car typ) (cdr typ)))
- (if (not (member (car typ)
- (list "constchar*")))
- (hey "#define XEN_~A_P(Arg) XEN_~A_P(Arg)~%"
+ (hey "#define C_to_Xen_~A(Arg) C_string_to_Xen_string((char *)(Arg))~%" (no-stars (car typ)))
+ (hey "#define C_to_Xen_~A(Arg) ~A(Arg)~%" (no-stars (car typ)) (c-to-xen-macro-name typ (cdr typ)))))
+
+ (if (not (string=? (car typ) "constchar*"))
+ (hey "#define Xen_to_C_~A(Arg) (~A)(~A(Arg))~%" (no-stars (car typ)) (car typ) (xen-to-c-macro-name (cdr typ))))
+
+ (if (not (string=? (car typ) "constchar*"))
+ (hey "#define Xen_is_~A(Arg) Xen_is_~A(Arg)~%"
(no-stars (car typ))
(if (string=? (cdr typ) "INT")
- "INTEGER"
- (if (string=? (cdr typ) "DOUBLE")
- "NUMBER"
- (cdr typ))))))
+ "integer"
+ (if (string=? (cdr typ) "ULONG")
+ "ulong"
+ (if (string=? (cdr typ) "DOUBLE")
+ "number"
+ (apply string (map char-downcase (cdr typ)))))))))
(begin
- (hey "#define XEN_~A_P(Arg) 1~%" (no-stars (car typ)))
- (hey "#define XEN_TO_C_~A(Arg) ((gpointer)Arg)~%" (no-stars (car typ)))))))
+ (hey "#define Xen_is_~A(Arg) 1~%" (no-stars (car typ)))
+ (hey "#define Xen_to_C_~A(Arg) ((gpointer)Arg)~%" (no-stars (car typ)))))))
(if (not (or (string=? type "Display*") ; why are these 2 handled specially?
(string=? type "XVisualInfo*")
- (string=? type "GLXContext"))) ; Snd g_snd_glx_context (snd-xmain.c) calls this a pointer
+ (string=? type "GLXContext"))) ; Snd g_snd_gl_context (snd-motif.c) calls this a pointer
(begin
- (if (member type glu-1-2) (hey "#ifdef GLU_VERSION_1_2~%"))
+ (if (member type glu-1-2)
+ (hey "#ifdef GLU_VERSION_1_2~%")
+ (if (member type (list "GLUnurbs*" "GLUtesselator*" "GLUquadric*" "_GLUfuncptr"))
+ (hey "#if HAVE_GLU~%")))
(hey "XL_TYPE~A~A(~A, ~A)~%"
(if (has-stars type) "_PTR" "")
(if (member type (list "int*" "Pixmap" "Font" "GLubyte*"
- "GLubyte*" "GLdouble*" "GLfloat*" "GLvoid*"
+ "GLdouble*" "GLfloat*" "GLvoid*"
"GLuint*" "GLboolean*" "GLint*" "GLshort*"
"PangoFontDescription*" "GtkWidget*" "GdkGLConfigMode"
))
@@ -343,7 +337,9 @@
""))
(no-stars type)
type)
- (if (member type glu-1-2) (hey "#endif~%")))
+ (if (or (member type glu-1-2)
+ (member type (list "GLUnurbs*" "GLUtesselator*" "GLUquadric*" "_GLUfuncptr")))
+ (hey "#endif~%")))
(if (string=? type "Display*")
(hey "XL_TYPE_PTR(Display, Display*)~%")
(if (string=? type "XVisualInfo*")
@@ -355,7 +351,7 @@
(let ((name (cadr-str data))
(args (caddr-str data)))
(if (assoc name names)
- (display (format #f "~A CFNC~%" name))
+ (format #t "~A CFNC~%" name)
(let ((type (car-str data)))
(if (not (member type types))
(set! types (cons type types)))
@@ -367,7 +363,7 @@
(define* (CINT name type)
(if (assoc name names)
- (display (format #f "~A CINT~%" name))
+ (format #t "~A CINT~%" name)
(begin
(set! ints (cons name ints))
(set! names (cons (cons name 'int) names)))))
@@ -376,7 +372,7 @@
(let ((name (cadr-str data))
(args (caddr-str data)))
(if (assoc name names)
- (display (format #f "~A CFNC-X~%" name))
+ (format #t "~A CFNC-X~%" name)
(let ((type (car-str data)))
(if (not (member type x-types))
(set! x-types (cons type x-types)))
@@ -388,18 +384,18 @@
(define* (CINT-X name type)
(if (assoc name names)
- (display (format #f "~A CINT-X~%" name))
+ (format #t "~A CINT-X~%" name)
(begin
(set! x-ints (cons name x-ints))
(set! names (cons (cons name 'int) names)))))
(define (no-arg name)
- (let ((len (string-length name)))
+ (let ((len (length name)))
(call-with-exit
(lambda (return)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len) name)
- (if (char=? (string-ref name i) #\()
+ (if (char=? (name i) #\()
(return (substring name 0 i))))))))
;;; ---------------------------------------- read data ----------------------------------------
@@ -416,6 +412,8 @@
(hey " * 'gl is added to *features*~%")
(hey " *~%")
(hey " * HISTORY:~%")
+(hey " *~%")
+(hey " * 16-Apr-14: changed max-args to 8.~%")
(hey " * --------~%")
(hey " * 16-Dec-09: removed Guile support.~%")
(hey " * --------~%")
@@ -436,7 +434,7 @@
(hey " * 20-May-02: initial version.~%")
(hey " */~%~%")
-(hey "#include <mus-config.h>~%~%")
+(hey "#include \"mus-config.h\"~%~%")
(hey "#if HAVE_EXTENSION_LANGUAGE~%")
@@ -477,33 +475,33 @@
(hey "#endif~%")
(hey "~%")
-(hey "#define WRAP_FOR_XEN(Name, Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(Name), XEN_WRAP_C_POINTER(Value))~%")
-(hey "#define WRAP_P(Name, Value) (XEN_LIST_P(Value) && \\~%")
-(hey " (XEN_LIST_LENGTH(Value) >= 2) && \\~%")
-(hey " (XEN_SYMBOL_P(XEN_CAR(Value))) && \\~%")
-(hey " (strcmp(Name, XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))~%")
+(hey "#define wrap_for_Xen(Name, Value) Xen_list_2(C_string_to_Xen_symbol(Name), Xen_wrap_C_pointer(Value))~%")
+(hey "#define is_wrapped(Name, Value) (Xen_is_list(Value) && \\~%")
+(hey " (Xen_list_length(Value) >= 2) && \\~%")
+(hey " (Xen_is_symbol(Xen_car(Value))) && \\~%")
+(hey " (strcmp(Name, Xen_symbol_to_C_string(Xen_car(Value))) == 0))~%")
(hey "~%")
;;; these have to match the choices in xm.c
(hey "#define XL_TYPE(Name, XType) \\~%")
-(hey " static XEN C_TO_XEN_ ## Name (XType val) {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(#Name), C_TO_XEN_ULONG(val)));} \\~%")
-(hey " static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \\~%")
-(hey " static int XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}~%")
+(hey " static Xen C_to_Xen_ ## Name (XType val) {return(Xen_list_2(C_string_to_Xen_symbol(#Name), C_ulong_to_Xen_ulong(val)));} \\~%")
+(hey " static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));}~%")
(hey "#define XL_TYPE_1(Name, XType) \\~%")
-(hey " static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \\~%")
-(hey " static int XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}~%")
+(hey " static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));}~%")
(hey "~%")
(hey "#define XL_TYPE_PTR(Name, XType) \\~%")
-(hey " static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \\~%")
-(hey " static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \\~%")
-(hey " static int XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} /* if NULL ok, should be explicit */~%")
+(hey " static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(#Name, val)); return(Xen_false);} \\~%")
+(hey " static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} /* if NULL ok, should be explicit */~%")
(hey "#define XL_TYPE_PTR_1(Name, XType) \\~%")
-(hey " static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \\~%")
-(hey " static int XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} /* if NULL ok, should be explicit */~%")
+(hey " static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} /* if NULL ok, should be explicit */~%")
;XL_TYPE_PTR_2 was for "GdkVisual*" "PangoFont*" "GdkColormap*"
;(hey "#define XL_TYPE_PTR_2(Name, XType) \\~%")
-;(hey " static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);}~%")
+;(hey " static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(#Name, val)); return(Xen_false);}~%")
(hey "~%~%/* ---------------------------------------- types ---------------------------------------- */~%~%")
@@ -561,6 +559,7 @@
(define need-vals-check (list "glGetIntegerv" "glGetFloatv" "glGetMaterialfv" "glGetLightfv" "glGetBooleanv"))
+(define max-args 8)
(hey "~%~%/* ---------------------------------------- functions ---------------------------------------- */~%~%")
@@ -573,11 +572,10 @@
(refargs (ref-args args))
(xgargs (- cargs refargs))
(argstr (cadddr data))
- (lambda-type (cdr (assoc name names)))
+ ;(lambda-type (cdr (assoc name names)))
(arg-start 0)
(line-len 0)
- (line-max 120)
- (max-args 10))
+ (line-max 120))
(define (hey-start)
;; start of checked line
@@ -590,17 +588,17 @@
(define (hey-on . args)
;; no cr -- just append
(let ((line (apply format #f args)))
- (set! line-len (+ line-len (string-length line)))
+ (set! line-len (+ line-len (length line)))
(heyc line)))
(define (hey-ok arg)
;; cr ok after arg
- (set! line-len (+ line-len (string-length arg)))
+ (set! line-len (+ line-len (length arg)))
(heyc arg)
(if (> line-len line-max)
(begin
(hey "~%")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i arg-start))
(heyc " "))
(set! line-len arg-start))))
@@ -609,22 +607,22 @@
(if (member name glu-1-2) (hey "#ifdef GLU_VERSION_1_2~%"))
(if (and (> (length data) 4)
- (eq? (list-ref data 4) 'if))
- (hey "#if HAVE_~A~%" (string-upcase (symbol->string (list-ref data 5)))))
- (hey "static XEN gxg_~A(" name)
+ (eq? (data 4) 'if))
+ (hey "#if HAVE_~A~%" (string-upcase (symbol->string (data 5)))))
+ (hey "static Xen gxg_~A(" name)
(if (= (length args) 0)
(heyc "void")
(if (>= (length args) max-args)
- (begin
- (heyc "XEN arglist"))
+ (heyc "Xen arglist")
(let ((previous-arg #f))
(for-each
(lambda (arg)
(let ((argname (cadr arg))
- (argtype (car arg)))
+ ;(argtype (car arg))
+ )
(if previous-arg (heyc ", "))
(set! previous-arg #t)
- (hey "XEN ~A" argname)))
+ (hey "Xen ~A" argname)))
args))))
(hey ")~%{~%")
(helpify name return-type argstr)
@@ -639,7 +637,7 @@
(if (and (>= (length args) max-args)
(> xgargs 0))
(let ((previous-arg #f))
- (heyc " XEN ")
+ (heyc " Xen ")
(for-each
(lambda (arg)
(if (not (ref-arg? arg)) ;(< (length arg) 3)
@@ -653,7 +651,7 @@
(for-each
(lambda (arg)
(if (not (ref-arg? arg))
- (hey " ~A = XEN_LIST_REF(arglist, ~D);~%" (cadr arg) ctr))
+ (hey " ~A = Xen_list_ref(arglist, ~D);~%" (cadr arg) ctr))
(set! ctr (+ 1 ctr)))
args))))
(if (> (length args) 0)
@@ -664,30 +662,29 @@
(argtype (car arg)))
(if (not (ref-arg? arg))
(if (null-arg? arg)
- (hey " XEN_ASSERT_TYPE(XEN_~A_P(~A) || XEN_FALSE_P(~A), ~A, ~D, ~S, ~S);~%"
+ (hey " Xen_check_type(Xen_is_~A(~A) || Xen_is_false(~A), ~A, ~D, ~S, ~S);~%"
(no-stars argtype) argname argname argname ctr name argtype)
(if (opt-arg? arg)
(begin
- (hey " if (XEN_NOT_BOUND_P(~A)) ~A = XEN_FALSE; ~%" argname argname)
- (hey " else XEN_ASSERT_TYPE(XEN_~A_P(~A), ~A, ~D, ~S, ~S);~%"
+ (hey " if (!Xen_is_bound(~A)) ~A = Xen_false; ~%" argname argname)
+ (hey " else Xen_check_type(Xen_is_~A(~A), ~A, ~D, ~S, ~S);~%"
(no-stars argtype) argname argname ctr name argtype))
- (hey " XEN_ASSERT_TYPE(XEN_~A_P(~A), ~A, ~D, ~S, ~S);~%"
+ (hey " Xen_check_type(Xen_is_~A(~A), ~A, ~D, ~S, ~S);~%"
(no-stars argtype) argname argname ctr name argtype))))
(set! ctr (+ 1 ctr))))
args)))
- (let ((using-result #f)
- (using-loc #f))
+ (let ((using-result #f))
(set! using-result (and (> refargs 0)
(not (string=? return-type "void"))))
(if using-result
(begin
(hey " {~%")
- (hey " XEN result = XEN_FALSE;~%")))
+ (hey " Xen result;~%")))
(hey-start)
(if (not (string=? return-type "void"))
(if (= refargs 0)
- (hey-on " return(C_TO_XEN_~A(" (no-stars return-type))
- (hey-on " result = C_TO_XEN_~A(" (no-stars return-type)))
+ (hey-on " return(C_to_Xen_~A(" (no-stars return-type))
+ (hey-on " result = C_to_Xen_~A(" (no-stars return-type)))
(hey-on " "))
(hey-on "~A(" name)
@@ -701,16 +698,16 @@
(if previous-arg (hey-ok ", "))
(if (and (not previous-arg)
(> (length data) 4)
- (eq? (list-ref data 4) 'const))
+ (eq? (data 4) 'const))
(hey "(const ~A)" argtype))
(set! previous-arg #t)
(if (ref-arg? arg)
(hey-on "~A" (deref-name arg))
- (hey-on "XEN_TO_C_~A(~A)" (no-stars argtype) argname))))
+ (hey-on "Xen_to_C_~A(~A)" (no-stars argtype) argname))))
args)))
(if (> refargs 0)
- (let* ((previous-arg using-result))
+ (let ((previous-arg using-result))
(if (not (string=? return-type "void"))
(heyc ")"))
(hey ");~%")
@@ -719,25 +716,25 @@
(begin
(hey " {~%")
(if (not using-result)
- (hey " XEN result;~%"))
+ (hey " Xen result;~%"))
(hey " int i, vals;~%")
- (hey " vals = how_many_vals(XEN_TO_C_GLenum(pname));~%")
- (hey " result = XEN_EMPTY_LIST;~%")
+ (hey " vals = how_many_vals(Xen_to_C_GLenum(pname));~%")
+ (hey " result = Xen_empty_list;~%")
(hey " for (i = 0; i < vals; i++)~%")
- (hey " result = XEN_CONS(C_TO_XEN_~A(~A[i]), result);~%"
- (no-stars (deref-type (list-ref args (- (length args) 1))))
- (deref-name (list-ref args (- (length args) 1))))
+ (hey " result = Xen_cons(C_to_Xen_~A(~A[i]), result);~%"
+ (no-stars (deref-type (args (- (length args) 1))))
+ (deref-name (args (- (length args) 1))))
(hey " return(result);~%")
(hey " }~%"))
(begin
- (hey " return(XEN_LIST_~D(" (+ refargs (if using-result 1 0)))
+ (hey " return(Xen_list_~D(" (+ refargs (if using-result 1 0)))
(if using-result (heyc "result"))
(for-each
(lambda (arg)
(if (ref-arg? arg)
(begin
(if previous-arg (heyc ", "))
- (hey "C_TO_XEN_~A(~A[0])" (no-stars (deref-type arg)) (deref-name arg))
+ (hey "C_to_Xen_~A(~A[0])" (no-stars (deref-type arg)) (deref-name arg))
(set! previous-arg #t))))
args)
(hey "));~%")))
@@ -745,7 +742,7 @@
(if (string=? return-type "void")
(begin
(hey ");~%")
- (hey " return(XEN_FALSE);~%"))
+ (hey " return(Xen_false);~%"))
(hey ")));~%")))
)
@@ -764,23 +761,23 @@
;;; ---------------- argify linkages
-(hey "#ifdef XEN_ARGIFY_1~%")
(define (argify-func func)
- (let* ((cargs (length (caddr func)))
- (name (car func))
- (refargs (+ (ref-args (caddr func)) (opt-args (caddr func))))
- (args (- cargs refargs))
- (if-fnc (and (> (length func) 4)
- (eq? (list-ref func 4) 'if))))
+ (let ((cargs (length (caddr func)))
+ (name (car func))
+ (refargs (+ (ref-args (caddr func)) (opt-args (caddr func))))
+ ;(args (- cargs refargs))
+ (if-fnc (and (> (length func) 4)
+ (eq? (func 4) 'if))))
(check-glu name)
(if (member name glu-1-2) (hey "#ifdef GLU_VERSION_1_2~%"))
(if if-fnc
- (hey "#if HAVE_~A~%" (string-upcase (symbol->string (list-ref func 5)))))
- (hey "XEN_~A(gxg_~A_w, gxg_~A)~%"
- (if (>= cargs 10) "VARGIFY"
+ (hey "#if HAVE_~A~%" (string-upcase (symbol->string (func 5)))))
+ (hey "Xen_wrap_~A(gxg_~A_w, gxg_~A)~%"
+ (if (>= cargs max-args)
+ "any_args"
(if (> refargs 0)
- (format #f "ARGIFY_~D" cargs)
- (format #f "NARGIFY_~D" cargs)))
+ (format #f "~D_optional_arg~A" cargs (if (= cargs 1) "" "s"))
+ (format #f "~A_arg~A" (if (zero? cargs) "no" (number->string cargs)) (if (= cargs 1) "" "s"))))
(car func) (car func))
(if if-fnc
(hey "#endif~%"))
@@ -793,41 +790,121 @@
(for-each argify-func (reverse funcs))
(uncheck-glu)
-(hey "~%#else~%~%")
-
-(define (unargify-func func)
- (let* ((cargs (length (caddr func)))
- (name (car func))
- (refargs (+ (ref-args (caddr func)) (opt-args (caddr func))))
- (args (- cargs refargs))
- (if-fnc (and (> (length func) 4)
- (eq? (list-ref func 4) 'if))))
-
- (check-glu name)
- (if (member name glu-1-2) (hey "#ifdef GLU_VERSION_1_2~%"))
-
- (if if-fnc
- (hey "#if HAVE_~A~%" (string-upcase (symbol->string (list-ref func 5)))))
- (hey "#define gxg_~A_w gxg_~A~%"
- (car func) (car func))
- (if if-fnc
- (hey "#endif~%"))
- (if (member (car func) glu-1-2) (hey "#endif~%"))))
-
-(hey "#if USE_MOTIF~%")
-(for-each unargify-func (reverse x-funcs))
-(hey "#endif~%")
-(for-each unargify-func (reverse funcs))
-(uncheck-glu)
-(hey "#endif~%")
+;;; ---------------- procedure linkages
+(define (gtk-type->s7-type gtk)
+ (let ((dt (assoc gtk direct-types)))
+ (if (and (pair? dt)
+ (string? (cdr dt)))
+ (let ((direct (cdr dt)))
+ (cond ((member direct '("INT" "ULONG") string=?) 'integer?)
+ ((string=? direct "BOOLEAN") 'boolean?)
+ ((string=? direct "DOUBLE") 'real?)
+ ((string=? direct "CHAR") 'char?)
+ ((string=? direct "String") 'string?)
+ (#t #t)))
+ #t)))
+
+(define (make-signature fnc)
+ (define (compress sig)
+ (if (and (pair? sig)
+ (pair? (cdr sig))
+ (or (not (eq? (car sig) 'pair?))
+ (not (null? (cddr sig))))
+ (eq? (car sig) (cadr sig)))
+ (compress (cdr sig))
+ sig))
+ (let ((sig (list (gtk-type->s7-type (cadr fnc)))))
+ (for-each
+ (lambda (arg)
+ (set! sig (cons (gtk-type->s7-type (car arg)) sig)))
+ (caddr fnc))
+ (reverse (compress sig))))
+
+(define signatures (make-hash-table))
+(define (make-signatures lst)
+ (for-each
+ (lambda (f)
+ (let ((sig (make-signature f)))
+ (if (pair? sig)
+ (let ((count (signatures sig)))
+ (if (not count)
+ (set! (signatures sig) 0)
+ (set! (signatures sig) (+ count 1)))))))
+ lst))
+
+(make-signatures funcs)
+(make-signatures x-funcs)
+;(format *stderr* "~D entries, ~D funcs~%" (hash-table-entries signatures) (length funcs))
-;;; ---------------- procedure linkages
(hey "static void define_functions(void)~%")
(hey "{~%")
-(hey " #define GL_DEFINE_PROCEDURE(Name, Value, A1, A2, A3, Help) XEN_DEFINE_PROCEDURE(XL_PRE #Name XL_POST, Value, A1, A2, A3, Help)~%")
+
+(hey "#if HAVE_SCHEME~%")
+(hey "static s7_pointer s_boolean, s_integer, s_real, s_any;~%")
+(hey "static s7_pointer ")
+
+(define (sig-name sig)
+ (call-with-output-string
+ (lambda (p)
+ (display "pl_" p)
+ (for-each
+ (lambda (typ)
+ (display (case typ
+ ((integer?) "i")
+ ((boolean?) "b")
+ ((real?) "r")
+ (else "t"))
+ p))
+ sig))))
+
+(for-each
+ (lambda (sigc)
+ (let ((sig (car sigc)))
+ (hey (sig-name sig))
+ (hey ", ")))
+ signatures)
+(hey "pl_unused;~%")
+
+(hey " s_boolean = s7_make_symbol(s7, \"boolean?\");~%")
+(hey " s_integer = s7_make_symbol(s7, \"integer?\");~%")
+(hey " s_real = s7_make_symbol(s7, \"real?\");~%")
+(hey " s_any = s7_t(s7);~%~%")
+
+(for-each
+ (lambda (sigc)
+ (let ((sig (car sigc)))
+ (hey " ")
+ (hey (sig-name sig))
+ (hey " = s7_make_circular_signature(s7, ")
+ (let ((len (length sig)))
+ (hey (number->string (- len 1)))
+ (hey ", ")
+ (hey (number->string len))
+ (hey ", ")
+ (do ((i 0 (+ i 1))
+ (s sig (cdr s)))
+ ((= i len))
+ (let ((typ (car s)))
+ (hey (case typ
+ ((integer?) "s_integer")
+ ((boolean?) "s_boolean")
+ ((real?) "s_real")
+ (else "s_any"))))
+ (if (< i (- len 1)) (hey ", "))))
+ (hey ");~%")))
+ signatures)
+(hey "pl_unused = NULL;~%")
+(hey "#endif~%~%")
+
+(hey "#if HAVE_SCHEME~%")
+(hey " #define gl_define_procedure(Name, Value, A1, A2, A3, Help, Sig) s7_define_typed_function(s7, XL_PRE #Name XL_POST, Value, A1, A2, A3, Help, Sig)~%")
+(hey "#else~%")
+(hey " #define gl_define_procedure(Name, Value, A1, A2, A3, Help, Sig) Xen_define_safe_procedure(XL_PRE #Name XL_POST, Value, A1, A2, A3, Help)~%")
+(hey "#endif~%")
+(hey "~%")
(define (defun func)
(let* ((cargs (length (caddr func)))
@@ -837,12 +914,14 @@
(check-glu name)
(if (member name glu-1-2) (hey "#ifdef GLU_VERSION_1_2~%"))
- (hey " GL_DEFINE_PROCEDURE(~A, gxg_~A_w, ~D, ~D, ~D, H_~A);~%"
+ (hey " gl_define_procedure(~A, gxg_~A_w, ~D, ~D, ~D, H_~A, ~A);~%"
(car func) (car func)
- (if (>= cargs 10) 0 args)
- (if (>= cargs 10) 0 refargs) ; optional ignored
- (if (>= cargs 10) 1 0)
- (car func))
+ (if (>= cargs max-args) 0 args)
+ (if (>= cargs max-args) 0 refargs) ; optional ignored
+ (if (>= cargs max-args) 1 0)
+ (car func)
+ (sig-name (make-signature func)))
+
(if (member (car func) glu-1-2) (hey "#endif~%"))
))
@@ -859,11 +938,7 @@
(hey "/* ---------------------------------------- constants ---------------------------------------- */~%~%")
(hey "static void define_integers(void)~%")
(hey "{~%~%")
-(hey "#if HAVE_SCHEME~%")
-(hey "#define DEFINE_INTEGER(Name) s7_define_constant(s7, XL_PRE #Name XL_POST, C_TO_XEN_INT(Name))~%")
-(hey "#else~%")
-(hey "#define DEFINE_INTEGER(Name) XEN_DEFINE(XL_PRE #Name XL_POST, C_TO_XEN_INT(Name))~%")
-(hey "#endif~%")
+(hey "#define DEFINE_INTEGER(Name) Xen_define(XL_PRE #Name XL_POST, C_int_to_Xen_integer(Name))~%")
(hey "~%")
(hey "#if USE_MOTIF~%")
@@ -878,7 +953,7 @@
(if in-glu
(if (not (string=? "GLU" (substring val 0 3)))
- (BEGIN
+ (begin
(set! in-glu #f)
(hey "#endif~%")))
(if (string=? "GLU" (substring val 0 3))
@@ -906,8 +981,8 @@
(hey " {~%")
(hey " define_integers();~%")
(hey " define_functions();~%")
-(hey " XEN_YES_WE_HAVE(\"gl\");~%")
-(hey " XEN_DEFINE(\"gl-version\", C_TO_XEN_STRING(\"~A\"));~%" (strftime "%d-%b-%y" (localtime (current-time))))
+(hey " Xen_provide_feature(\"gl\");~%")
+(hey " Xen_define(\"gl-version\", C_string_to_Xen_string(\"~A\"));~%" (strftime "%d-%b-%y" (localtime (current-time))))
(hey " gl_already_inited = true;~%")
(hey " }~%")
(hey "}~%")
diff --git a/tools/makexg.scm b/tools/makexg.scm
index e758e4a..a33444c 100755
--- a/tools/makexg.scm
+++ b/tools/makexg.scm
@@ -2,126 +2,34 @@
(define xg-file (open-output-file "xg.c"))
-(define (hey . args)
- (display (apply format #f args) xg-file))
+(define-macro (hey . args)
+ `(format xg-file , at args))
(define (heyc arg)
(display arg xg-file))
-(define names '())
-(define types '())
-(define ints '())
-(define ulongs '())
-(define dbls '())
-(define funcs '())
-(define casts '())
-(define checks '())
-(define atoms '())
-(define strings '())
-
-(define structs '())
-(define make-structs '()) ; these have a xg-specific make function
-(define cairo-make-structs '())
-(define struct-fields '())
-(define settable-struct-fields '())
-
-(define funcs-213 '())
-(define strings-213 '())
-(define ints-213 '())
-(define names-213 '())
-(define types-213 '())
-(define casts-213 '())
-(define checks-213 '())
-(define ulongs-213 '())
-
-(define funcs-2134 '())
-(define strings-2134 '())
-(define ints-2134 '())
-(define names-2134 '())
-(define types-2134 '())
-(define casts-2134 '())
-(define checks-2134 '())
-(define ulongs-2134 '())
-
-(define funcs-2150 '())
-(define strings-2150 '())
-(define ints-2150 '())
-(define names-2150 '())
-(define types-2150 '())
-(define casts-2150 '())
-(define checks-2150 '())
-(define ulongs-2150 '())
-
-(define funcs-2172 '())
-(define ints-2172 '())
-(define names-2172 '())
-(define types-2172 '())
-(define casts-2172 '())
-(define checks-2172 '())
-
-(define funcs-2173 '())
-(define ints-2173 '())
-(define names-2173 '())
-(define types-2173 '())
-(define casts-2173 '())
-(define checks-2173 '())
-(define ulongs-2173 '())
-
-(define funcs-2177 '())
-(define ints-2177 '())
-(define names-2177 '())
-(define types-2177 '())
-
-(define funcs-2190 '())
-(define casts-2190 '())
-(define checks-2190 '())
-(define names-2190 '())
-(define types-2190 '())
-
-(define funcs-300 '())
-(define casts-300 '())
-(define checks-300 '())
-(define names-300 '())
-(define types-300 '())
-(define ints-300 '())
-(define strings-300 '())
-(define make-structs-300 '()) ; these have a xg-specific make function
-
-(define funcs-gtk2 '())
-(define casts-gtk2 '())
-(define checks-gtk2 '())
-(define names-gtk2 '())
-(define types-gtk2 '())
-(define ints-gtk2 '())
-(define ulongs-gtk2 '())
-
-(define cairo-funcs '())
-(define cairo-png-funcs '())
-(define cairo-ints '())
-(define cairo-types '())
-
-(define cairo-funcs-810 '())
-(define cairo-ints-810 '())
-(define cairo-types-810 '())
-
-(define cairo-funcs-912 '())
-(define cairo-ints-912 '())
-(define cairo-types-912 '())
-(define cairo-strings-912 '())
-(define cairo-names-912 '())
-
-
-(define all-types '())
+(define names (make-hash-table))
+(define types ())
+(define ints ())
+(define dbls ())
+(define funcs ())
+(define casts ())
+(define checks ())
+(define atoms ())
+(define strings ())
+
+(define all-types ())
;;; preset some types that are getting confused
-(set! types (list "GdkEventMotion*" "GtkColorSelectionDialog*" "gdouble*" "GdkEventAny*" "GdkEvent*" "gboolean*"
+(set! types (list "GdkEventMotion*" "gdouble*" "GdkEventAny*" "GdkEvent*" "gboolean*"
"cairo_t*" "cairo_font_options_t*" "PangoFontDescription*"))
-(set! all-types (list "GdkEventMotion*" "GtkColorSelectionDialog*" "gdouble*" "GdkEventAny*" "GdkEvent*"
+(set! all-types (list "GdkEventMotion*" "gdouble*" "GdkEventAny*" "GdkEvent*"
"cairo_t*" "cairo_font_options_t*" "PangoFontDescription*"))
(define idlers (list "g_source_remove" "g_idle_remove_by_data"
"gtk_quit_remove" "gtk_quit_remove_by_data"
- "gtk_key_snooper_remove"))
+ ;"gtk_key_snooper_remove"
+ ))
(define no-c-to-xen
(list "CellLayoutDataFunc" "GClosureNotify" "GDestroyNotify" "GError**" "GParamSpec*" "GQuark*" "GSignalAccumulator"
@@ -133,7 +41,7 @@
"GdkWMDecoration*" "GdkWindowAttr*" "GtkAccelLabel*" "GtkAccelMapForeach" "GtkAccessible*" "GtkActionEntry*"
"GtkAlignment*" "GtkAllocation*" "GtkArrow*" "GtkAspectFrame*" "GtkBin*" "GtkBox*" "GtkButton*" "GtkButtonBox*"
"GtkCalendar*" "GtkCellLayout*" "GtkCellLayoutDataFunc" "GtkCellRendererPixbuf*" "GtkCellRendererText*" "GtkCellRendererToggle*"
- "GtkCheckMenuItem*" "GtkClipboardTargetsReceivedFunc" "GtkColorButton*" "GtkColorSelection*" "GtkColorSelectionDialog*"
+ "GtkCheckMenuItem*" "GtkClipboardTargetsReceivedFunc"
"GtkCombo*" "GtkComboBox*" "GtkComboBoxEntry*" "GtkContainer*" "GtkCurve*" "GtkDialog*" "GtkDrawingArea*" "GtkEditable*"
"GtkEventBox*" "GtkExpander*" "GtkFileChooser*" "GtkFileFilterFunc"
"GtkFileSelection*" "GtkFixed*" "GtkFontButton*" "GtkFontSelection*" "GtkFontSelectionDialog*" "GtkFrame*" "GtkGammaCurve*"
@@ -142,19 +50,19 @@
"GtkMessageDialog*" "GtkMisc*" "GtkNotebook*" "GtkOptionMenu*" "GtkPackType*" "GtkPaned*" "GtkPlug*"
"GtkProgressBar*" "GtkRadioButton*" "GtkRadioMenuItem*" "GtkRadioToolButton*" "GtkRange*" "GtkRcPropertyParser" "GtkRuler*"
"GtkScale*" "GtkScrolledWindow*" "GtkSeparatorToolItem*" "GtkSettingsValue*" "GtkSocket*" "GtkSortType*" "GtkSpinButton*"
- "GtkStateType*" "GtkStatusbar*" "GtkTable*" "GtkTextCharPredicate" "GtkTextTagTableForeach" "GtkTextView*"
+ "GtkStatusbar*" "GtkTable*" "GtkTextCharPredicate" "GtkTextTagTableForeach" "GtkTextView*"
"GtkToggleActionEntry*" "GtkToggleButton*" "GtkToggleToolButton*" "GtkToolButton*" "GtkToolbar*" "GtkTreeDragDest*"
"GtkTreeDragSource*" "GtkTreeModel**" "GtkTreeModelFilter*" "GtkTreeModelSort*" "GtkTreeSortable*" "GtkUIManagerItemType"
- "GtkViewport*" "PangoAnalysis*" "PangoAttrList**" "PangoFontDescription**" "PangoFontMap*" "PangoRectangle*"
+ "GtkViewport*" "PangoAnalysis*" "PangoAttrList**" "PangoFontDescription**" "PangoRectangle*"
"gchar***" "gfloat*" "gint8*" "gssize" "guint16*" "gunichar*" "GtkFileChooserButton*" "GtkPathPriorityType"
"GtkCellView*" "GValue*" "GtkAboutDialog*" "PangoAttrFilterFunc" "PangoScript*" "GtkMenuToolButton*"
"GtkClipboardImageReceivedFunc" "PangoMatrix*" "GdkTrapezoid*" "GdkPangoRenderer*" "PangoRenderPart"
- "GLogFunc" "GError*" "guint32*" ;"GtkRecentFilterInfo*"
+ "GLogFunc" "GError*" "guint32*"
"GConnectFlags" "GSignalFlags" "GSignalMatchType"
;"GdkAxisUse"
"GdkFillRule" "GdkGCValuesMask"
- "GdkPropMode" "GdkRgbDither" "GdkWMFunction" "GdkWindowEdge" "GdkWindowHints" "GtkAccelFlags" "GtkArrowType"
+ "GdkPropMode" "GdkRgbDither" "GdkWMFunction" "GdkWindowEdge" "GdkWindowHints" "GtkAccelFlags" ; "GtkArrowType"
"GtkAttachOptions" "GtkCellRendererState" "GtkCurveType" "GtkDestDefaults" "GtkDestroyNotify" "GtkDialogFlags"
"GtkDirectionType" "GtkExpanderStyle" "GtkIconLookupFlags" ;"GtkMenuPositionFunc"
"GtkPathType" "GtkSpinType"
@@ -190,6 +98,22 @@
"GtkContainerClass*" "GtkComboBoxText*" "GtkGrid*" "GtkScrollable*" "GtkSwitch*"
"cairo_text_cluster_flags_t" "cairo_text_cluster_flags_t*" "cairo_rectangle_int_t*"
+
+ "GtkOverlay*" "cairo_pattern_t**" "GtkStyleProperties*" "GtkSymbolicColor*" "GtkWidgetPath*"
+ "GtkFontChooser*" "GtkFontChooserDialog*"
+ "GdkModifierIntent" "guint**" "GtkApplication*" "GVariant*" "GtkApplicationWindow*"
+ "GdkEventKey*" "GtkColorChooser*"
+
+ "GtkLevelBar*" "GtkMenuButton*" "GNormalizeMode"
+; "GIcon*"
+
+ "GBytes" "GtkPlacesSidebar*" "GtkStackSwitcher*" "GtkRevealer*" "GtkHeaderBar*" "GtkListBox*" "GtkSearchBar*"
+
+ "GtkFlowBox*" "GtkActionBar*" "GtkPopover*"
+ "GtkGestureDrag*" "GtkGesturePan*" "GtkGestureMultiPress*" "GtkGestureRotate*" "GtkGestureSingle*"
+ "GtkGestureSwipe*" "GtkGestureZoom*" "GtkGestureController*" "GtkEventController*"
+
+ "GtkGLArea*" "GtkStyleContext*" "GtkPopoverMenu*" "GtkSearchEntry*" "GtkStackSidebar*"
))
(define no-xen-p
@@ -210,6 +134,8 @@
"GtkPrintOperationResult" "GtkPrintStatus" "GtkSizeRequestMode"
"GdkEventAny*" "GdkDeviceManager*"
"cairo_font_type_t" "cairo_pattern_type_t" "cairo_surface_type_t" "cairo_bool_t" "cairo_region_overlap_t"
+
+ "glong" "double"
))
(define no-xen-to-c
@@ -232,60 +158,42 @@
"cairo_surface_type_t" "cairo_pattern_type_t" "cairo_font_type_t" "cairo_bool_t"
"cairo_region_overlap_t" "cairo_device_type_t"
+
+ "glong"
))
(define (cadr-str data)
- (let ((sp1 -1)
- (len (string-length data)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) (substring data sp1))
- (if (char=? (string-ref data i) #\space)
- (if (= sp1 -1)
- (set! sp1 i)
- (return (substring data (+ 1 sp1) i)))))))))
+ (let ((sp1 (char-position #\space data)))
+ (let ((sp2 (char-position #\space data (+ sp1 1))))
+ (if sp2
+ (substring data (+ sp1 1) sp2)
+ (substring data sp1)))))
(define (caddr-str data)
- (let ((sp1 -1)
- (sp2 -1)
- (len (string-length data)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) (substring data sp2))
- (if (char=? (string-ref data i) #\space)
- (if (= sp1 -1)
- (set! sp1 i)
- (if (= sp2 -1)
- (set! sp2 i)
- (return (substring data (+ 1 sp2)))))))))))
+ (let ((sp1 (char-position #\space data)))
+ (let ((sp2 (char-position #\space data (+ sp1 1))))
+ (let ((sp3 (char-position #\space data (+ sp2 1))))
+ (if sp3
+ (substring data (+ sp2 1))
+ (substring data sp2))))))
(define (car-str data)
- (let ((len (string-length data)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) data)
- (if (char=? (string-ref data i) #\space)
- (return (substring data 0 i))))))))
+ (let ((sp (char-position #\space data)))
+ (if sp
+ (substring data 0 sp)
+ data)))
(define (cdr-str data)
- (let ((len (string-length data)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) data)
- (if (char=? (string-ref data i) #\space)
- (return (substring data (+ 1 i)))))))))
-
-(define (string-upcase name)
- (let* ((len (string-length name))
- (str (make-string len)))
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (string-set! str i (char-upcase (string-ref name i))))
- str))
+ (let ((sp (char-position #\space data)))
+ (if sp
+ (substring data (+ sp 1))
+ data)))
+
+(define (remove-if p l)
+ (cond ((null? l) ())
+ ((p (car l)) (remove-if p (cdr l)))
+ (else (cons (car l)
+ (remove-if p (cdr l))))))
(define (ref-arg? arg)
(and (= (length arg) 3)
@@ -323,93 +231,75 @@
(define (deref-type arg)
(let ((type (car arg)))
- (substring type 0 (- (string-length type) 1))))
+ (substring type 0 (- (length type) 1))))
(define (deref-element-type arg)
(let ((type (car arg)))
- (substring type 0 (- (string-length type) 2))))
+ (substring type 0 (- (length type) 2))))
(define (deref-name arg)
- (let* ((name (cadr arg)))
+ (let ((name (cadr arg)))
(string-append "ref_" name)))
(define (derefable type)
- (let ((len (string-length type)))
- (call-with-exit
- (lambda (return)
- (do ((i (- len 1) (- i 1))
- (ctr 0 (+ ctr 1)))
- ((= i 0) #f)
- (if (not (char=? (string-ref type i) #\*))
- (return (> ctr 1))))))))
+ (let ((st (char-position #\* type)))
+ (and st (char-position #\* type (+ st 1)))))
(define (has-stars type)
- (let ((len (string-length type)))
- (call-with-exit
- (lambda (return)
- (do ((i (- len 1) (- i 1))
- (ctr 0 (+ ctr 1)))
- ((= i 0) #f)
- (if (char=? (string-ref type i) #\*)
- (return #t)))
- #f))))
+ (char-position #\* type))
(define (no-stars type)
- (let ((len (string-length type))
- (val (string-copy type)))
- (do ((i 0 (+ 1 i)))
+ (let ((len (length type))
+ (val (copy type)))
+ (do ((i 0 (+ i 1)))
((= i len) val)
- (if (char=? (string-ref val i) #\*)
- (string-set! val i #\_)))))
+ (if (char=? (val i) #\*)
+ (set! (val i) #\_)))))
(define (no-arg-or-stars name)
- (let ((len (string-length name)))
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len) name)
- (if (or (char=? (string-ref name i) #\()
- (char=? (string-ref name i) #\*))
- (return (substring name 0 i))))))))
+ (let ((pos (char-position "(*" name)))
+ (if pos
+ (substring name 0 pos)
+ name)))
(define (parse-args args extra)
- (let ((data '())
+ (let ((data ())
(sp -1)
(type #f)
- (len (string-length args)))
+ (len (length args)))
(if (string=? args "void")
- '()
- (do ((i 0 (+ 1 i)))
+ ()
+ (do ((i 0 (+ i 1)))
((= i len) (reverse data))
- (let ((ch (string-ref args i)))
+ (let ((ch (args i)))
(if (or (char=? ch #\space)
(= i (- len 1)))
(begin
(if type
- (let* ((given-name (substring args (+ 1 sp) (if (= i (- len 1)) (+ 1 i) i)))
- (reftype #f))
- (if (char=? (string-ref given-name 0) #\@)
+ (let ((given-name (substring args (+ 1 sp) (if (= i (- len 1)) (+ i 1) i)))
+ (reftype #f))
+ (if (char=? (given-name 0) #\@)
(set! data (cons (list type
- (substring given-name 1 (string-length given-name))
+ (substring given-name 1 (length given-name))
'null)
data))
- (if (char=? (string-ref given-name 0) #\#)
+ (if (char=? (given-name 0) #\#)
(set! data (cons (list type
- (substring given-name 1 (string-length given-name))
+ (substring given-name 1 (length given-name))
'opt)
data))
- (if (or (char=? (string-ref given-name 0) #\[)
- (char=? (string-ref given-name 0) #\{)
- (char=? (string-ref given-name 0) #\|))
+ (if (or (char=? (given-name 0) #\[)
+ (char=? (given-name 0) #\{)
+ (char=? (given-name 0) #\|))
(begin
(set! reftype (deref-type (list type)))
(set! data (cons (list type
- (substring given-name 1 (- (string-length given-name) 1))
+ (substring given-name 1 (- (length given-name) 1))
given-name)
data)))
- (if (char=? (string-ref given-name 0) #\&)
+ (if (char=? (given-name 0) #\&)
(set! data (cons (list type
- (substring given-name 1 (string-length given-name))
+ (substring given-name 1 (length given-name))
'set)
data))
(set! data (cons (list type given-name) data))))))
@@ -419,20 +309,26 @@
(begin
(set! all-types (cons type all-types))
(case extra
- ((213 callback-213) (set! types-213 (cons type types-213)))
- ((2134 callback-2134) (set! types-2134 (cons type types-2134)))
- ((2150 callback-2150) (set! types-2150 (cons type types-2150)))
- ((2172 callback-2172) (set! types-2172 (cons type types-2172)))
- ((2173 callback-2173) (set! types-2173 (cons type types-2173)))
- ((2177 callback-2177) (set! types-2177 (cons type types-2177)))
- ((2190) (set! types-2190 (cons type types-2190)))
- ((300) (set! types-300 (cons type types-300)))
- ((gtk2) (set! types-gtk2 (cons type types-gtk2)))
- ((cairo) (set! cairo-types (cons type cairo-types)))
- ((cairo-810) (set! cairo-types-810 (cons type cairo-types-810)))
- ((cairo-912) (set! cairo-types-912 (cons type cairo-types-912)))
- (else (if (not (member type types))
- (set! types (cons type types)))))))
+ ((g-2.14) (set! types-2.14 (cons type types-2.14)))
+ ((g-2.16) (set! types-2.16 (cons type types-2.16)))
+ ((g-2.18) (set! types-2.18 (cons type types-2.18)))
+ ((g-2.20) (set! types-2.20 (cons type types-2.20)))
+ ((g-3.0) (set! types-3.0 (cons type types-3.0)))
+ ((g-3.2) (set! types-3.2 (cons type types-3.2)))
+ ((g-3.4) (set! types-3.4 (cons type types-3.4)))
+ ((g-3.6) (set! types-3.6 (cons type types-3.6)))
+ ((g-3.8) (set! types-3.8 (cons type types-3.8)))
+ ((g-3.10) (set! types-3.10 (cons type types-3.10)))
+ ((g-3.12) (set! types-3.12 (cons type types-3.12)))
+ ((g-3.14) (set! types-3.14 (cons type types-3.14)))
+ ((g-3.16) (set! types-3.16 (cons type types-3.16)))
+ ((g-3.18) (set! types-3.18 (cons type types-3.18)))
+ ((g-3.20) (set! types-3.20 (cons type types-3.20)))
+ ((cairo) (set! cairo-types (cons type cairo-types)))
+ ((cairo-810) (set! cairo-types-810 (cons type cairo-types-810)))
+ ((cairo-912) (set! cairo-types-912 (cons type cairo-types-912)))
+ (else (if (not (member type types))
+ (set! types (cons type types)))))))
(set! type #f))
(if (> i (+ 1 sp))
(set! type (substring args (+ 1 sp) i))))
@@ -484,11 +380,11 @@
; "func1"
; (parse-args "lambda_data func_info" 'callback)
; 'semi-permanent)
- (list 'GtkKeySnoopFunc
- "gint"
- "snoop_func"
- (parse-args "GtkWidget* widget GdkEventKey* event lambda_data func_info" 'callback)
- 'semi-permanent)
+ ; (list 'GtkKeySnoopFunc
+ ; "gint"
+ ; "snoop_func"
+ ; (parse-args "GtkWidget* widget GdkEventKey* event lambda_data func_info" 'callback)
+ ; 'semi-permanent)
(list 'GtkMenuPositionFunc
"void"
"menu_position_func"
@@ -627,12 +523,12 @@
(parse-args "GtkClipboard* clipboard GdkAtom format guint8* text gsize length lambda_data func_info" 'callback); 'callback)
;; guint8* is const
'permanent-gcc)
- (list 'GtkRecentFilterFunc
- "gboolean"
- "recent_filter"
- (parse-args "GtkRecentFilterInfo* filter_info lambda_data func_info" 'callback)
- ;; const filter info
- 'permanent-gcc)
+; (list 'GtkRecentFilterFunc
+; "gboolean"
+; "recent_filter"
+; (parse-args "GtkRecentFilterInfo* filter_info lambda_data func_info" 'callback)
+; ;; const filter info
+; 'permanent-gcc)
(list 'GtkTreeViewSearchPositionFunc
"void"
"search_position"
@@ -657,15 +553,15 @@
))
-(define (callback-name func) (car func))
-(define (callback-type func) (cadr func))
-(define (callback-func func) (caddr func))
-(define (callback-args func) (cadddr func))
-(define (callback-gc func) (list-ref func 4))
+(define callback-name car)
+(define callback-type cadr)
+(define callback-func caddr)
+(define callback-args cadddr)
+(define (callback-gc func) (func 4))
(define (find-callback test)
(define (find-callback-1 test funcs)
- (and (not (null? funcs))
+ (and (pair? funcs)
(or (test (car funcs))
(find-callback-1 test (cdr funcs)))))
(find-callback-1 test callbacks))
@@ -689,6 +585,7 @@
(cons "char*" "String")
(cons "gchar*" "String")
(cons "guchar*" "String") ; added 30-Jul-02 then removed then put back... -- this is a real mess!
+
(cons "guint" "ULONG")
(cons "guint16" "INT")
(cons "gint" "INT")
@@ -758,9 +655,9 @@
(cons "GtkDestDefaults" "INT")
(cons "GtkPositionType" "INT")
(cons "GtkTextDirection" "INT")
- (cons "GtkStateType" "INT")
+ (cons "GtkStateFlags" "INT")
(cons "GtkImageType" "INT")
- (cons "GtkIconSize" "INT")
+; (cons "GtkIconSize" "INT")
(cons "GtkJustification" "INT")
(cons "GtkMessageType" "INT")
(cons "GtkButtonsType" "INT")
@@ -845,12 +742,34 @@
(cons "GtkRecentFilterFlags" "INT")
(cons "GtkRecentManagerError" "INT")
(cons "GtkTreeViewGridLines" "INT")
-
+
+ (cons "GNormalizeMode" "INT")
+ (cons "gunichar" "INT")
+ (cons "gunichar*" "String")
;(cons "GtkPrintCapabilities" "INT")
(cons "GtkPrintStatus" "INT")
(cons "GtkPrintOperationResult" "INT")
(cons "GtkPrintOperationAction" "INT")
(cons "GtkPrintError" "INT")
+
+ (cons "GtkRevealerTransitionType" "INT")
+ (cons "GtkStackTransitionType" "INT")
+ (cons "GtkTextViewLayer" "INT")
+ (cons "GdkTouchpadGesturePhase" "INT")
+ (cons "GtkLevelBarMode" "INT")
+ (cons "GdkWindowClass" "INT")
+ (cons "GdkColorspace" "INT")
+ (cons "GtkNotebookTab" "INT")
+ (cons "GdkPixbufError" "INT")
+ (cons "PangoRenderPart" "INT")
+ (cons "GtkDragResult" "INT")
+ (cons "GtkToolPaletteDragTargets" "INT")
+ (cons "GtkInputPurpose" "INT")
+ (cons "GtkInputHints" "INT")
+ (cons "GdkFullscreenMode" "INT")
+ (cons "GtkBaselinePosition" "INT")
+ (cons "GtkPlacesOpenFlags" "INT")
+ (cons "GtkRegionFlags" "INT")
(cons "cairo_status_t" "INT")
(cons "cairo_content_t" "INT")
@@ -880,6 +799,7 @@
(cons "GtkWidgetHelpType" "INT")
(cons "GtkWidgetFlags" "INT")
(cons "GtkRcTokenType" "INT")
+ (cons "GtkTextExtendSelection" "INT")
;(cons "GtkNotebookTab" "INT")
(cons "GtkScrollType" "INT")
(cons "GtkMovementStep" "INT")
@@ -896,43 +816,65 @@
(cons "GdkPropertyState" "INT")
(cons "GtkScrollablePolicy" "INT")
+ (cons "GdkModifierIntent" "INT")
+ (cons "GtkAlign" "INT")
+ (cons "GdkGLFlags" "INT")
+ (cons "GtkShortcutType" "INT")
))
+(define (c-to-xen-macro-name typ str)
+ (if (string=? str "INT") "C_int_to_Xen_integer"
+ (if (string=? str "DOUBLE") "C_double_to_Xen_real"
+ (if (string=? str "BOOLEAN") "C_bool_to_Xen_boolean"
+ (if (string=? str "ULONG") "C_ulong_to_Xen_ulong"
+ (if (string=? str "String")
+ (if (string=? (car typ) "guchar*")
+ "C_to_Xen_String"
+ "C_string_to_Xen_string")
+ (format #f "~A unknown" str)))))))
+
+(define (xen-to-c-macro-name str)
+ (if (string=? str "INT") "Xen_integer_to_C_int"
+ (if (string=? str "DOUBLE") "Xen_real_to_C_double"
+ (if (string=? str "BOOLEAN") "Xen_boolean_to_C_bool"
+ (if (string=? str "ULONG") "Xen_ulong_to_C_ulong"
+ (if (string=? str "String") "Xen_string_to_C_string"
+ (format #f "~A unknown" str)))))))
+
(define (type-it type)
- (let ((typ (assoc type direct-types))
- (g2 '()))
+ (let ((typ (assoc type direct-types)))
(if typ
- (if (cdr typ)
- (begin
- (if (string? (cdr typ))
+ (when (cdr typ)
+ (if (string? (cdr typ))
+ (begin
+ (if (not (member type no-c-to-xen))
+ (hey "#define C_to_Xen_~A(Arg) ~A(Arg)~%" (no-stars (car typ)) (c-to-xen-macro-name typ (cdr typ))))
+ (if (not (member type no-xen-to-c))
+ (hey "#define Xen_to_C_~A(Arg) (~A)(~A(Arg))~%" (no-stars (car typ)) (car typ) (xen-to-c-macro-name (cdr typ))))
+ (if (not (member type no-xen-p))
+ (hey "#define Xen_is_~A(Arg) Xen_is_~A(Arg)~%"
+ (no-stars (car typ))
+ (if (string=? (cdr typ) "INT")
+ "integer"
+ (if (string=? (cdr typ) "DOUBLE")
+ "number"
+ (if (string=? (cdr typ) "ULONG")
+ "ulong"
+ (apply string (map char-downcase (cdr typ)))))))))
+ (if (not (cdr typ)) ; void special case
(begin
- (if (not (member type no-c-to-xen))
- (hey "#define C_TO_XEN_~A(Arg) C_TO_XEN_~A(Arg)~%" (no-stars (car typ)) (cdr typ)))
- (if (not (member type no-xen-to-c))
- (hey "#define XEN_TO_C_~A(Arg) (~A)(XEN_TO_C_~A(Arg))~%" (no-stars (car typ)) (car typ) (cdr typ)))
(if (not (member type no-xen-p))
- (hey "#define XEN_~A_P(Arg) XEN_~A_P(Arg)~%"
- (no-stars (car typ))
- (if (string=? (cdr typ) "INT")
- "INTEGER"
- (if (string=? (cdr typ) "DOUBLE")
- "NUMBER"
- (cdr typ))))))
- (begin
- (if (not (cdr typ)) ; void special case
- (begin
- (if (not (member type no-xen-p))
- (hey "#define XEN_~A_P(Arg) 1~%" (no-stars (car typ))))
- (if (not (member type no-xen-to-c))
- (hey "#define XEN_TO_C_~A(Arg) ((gpointer)Arg)~%" (no-stars (car typ)))))
- (begin ; xen special case
- (if (string=? type "etc")
- (hey "#define XEN_etc_P(Arg) (XEN_LIST_P(Arg))~%")
- (begin
- (if (not (member type no-xen-p))
- (hey "#define XEN_~A_P(Arg) ((XEN_LIST_P(Arg)) && (XEN_LIST_LENGTH(Arg) > 2))~%" (no-stars (car typ))))
- (if (not (member type no-xen-to-c))
- (hey "#define XEN_TO_C_~A(Arg) ((gpointer)Arg)~%" (no-stars (car typ))))))))))))
+ (hey "#define Xen_is_~A(Arg) 1~%" (no-stars (car typ))))
+ (if (not (member type no-xen-to-c))
+ (hey "#define Xen_to_C_~A(Arg) ((gpointer)Arg)~%" (no-stars (car typ)))))
+ (if (string=? type "etc") ; xen special case
+ (hey "#define Xen_is_etc(Arg) (Xen_is_list(Arg))~%")
+ (begin
+ (if (not (member type no-xen-p))
+ (hey "#define Xen_is_~A(Arg) ((Xen_is_list(Arg)) && (Xen_list_length(Arg) > 2))~%" (no-stars (car typ))))
+ (if (not (member type no-xen-to-c))
+ (hey "#define Xen_to_C_~A(Arg) ((gpointer)Arg)~%" (no-stars (car typ)))))))))
+
(if (and (not (string=? type "lambda"))
(not (string=? type "lambda_data"))
(not (string=? type "GError*"))
@@ -940,30 +882,29 @@
(lambda (func)
(string=? type (symbol->string (car func))))))
(not (string=? type "GCallback")))
- (begin
- (hey "XM_TYPE~A(~A, ~A)~%"
- (if (or (has-stars type)
- (string=? type "gpointer")
- (string=? type "GClosureNotify"))
- (if (member type no-c-to-xen)
- "_PTR_1"
- (if (member type no-xen-p)
- (if (member type no-xen-to-c)
- "_PTR_2"
- "_PTR_NO_P")
- (if (or (string=? type "guint8*")
- (string=? type "GtkRecentFilterInfo*"))
- "_PTR_CONST"
- "_PTR")))
- (if (member type no-c-to-xen)
- "_1"
- (if (member type no-xen-p)
- (if (member type no-xen-to-c)
- "_NO_P_2"
- "_NO_P")
- "")))
- (no-stars type)
- type))))))
+ (hey "Xm_type~A(~A, ~A)~%"
+ (if (or (has-stars type)
+ (string=? type "gpointer")
+ (string=? type "GClosureNotify"))
+ (if (member type no-c-to-xen)
+ "_Ptr_1"
+ (if (member type no-xen-p)
+ (if (member type no-xen-to-c)
+ "_Ptr_2"
+ "_Ptr_no_P")
+ (if (or (string=? type "guint8*")
+ (string=? type "GtkRecentFilterInfo*"))
+ "_Ptr_const"
+ "_Ptr")))
+ (if (member type no-c-to-xen)
+ "_1"
+ (if (member type no-xen-p)
+ (if (member type no-xen-to-c)
+ "_no_p_2"
+ "_no_p")
+ "")))
+ (no-stars type)
+ type)))))
(define (func-type strs)
(call-with-exit
@@ -984,12 +925,125 @@
'fnc)))
(define (no-way str arg)
- (display (format #f str arg)))
+ (format #t str arg))
+
+
+(define-macro (make-fnc vname)
+ (let* ((cfnc-name (string-append "CFNC-" vname))
+ (cfnc (string->symbol cfnc-name))
+ (g-fnc (string->symbol (string-append "g-" vname)))
+ (types (string->symbol (string-append "types-" vname)))
+ (funcs (string->symbol (string-append "funcs-" vname)))
+ (strfnc (string->symbol (string-append "CSTR-" vname)))
+ (strings (string->symbol (string-append "strings-" vname)))
+ (names (string->symbol (string-append "names-" vname)))
+ (intfnc (string->symbol (string-append "CINT-" vname)))
+ (ints (string->symbol (string-append "ints-" vname)))
+ (castfnc (string->symbol (string-append "CCAST-" vname)))
+ (casts (string->symbol (string-append "casts-" vname)))
+ (chkfnc (string->symbol (string-append "CCHK-" vname)))
+ (checks (string->symbol (string-append "checks-" vname)))
+ (withfnc (string->symbol (string-append "with-" vname)))
+ )
+ `(begin
+ (define ,funcs ())
+ (define ,strings ())
+ (define ,ints ())
+ (define ,names ())
+ (define ,types ())
+ (define ,casts ())
+ (define ,checks ())
+
+ (define* (,cfnc data spec) ; CFNC-2.12
+ (let ((name (cadr-str data))
+ (args (caddr-str data)))
+ (if (hash-table-ref names name)
+ (format #t "~A: ~A ~A~%" ',cfnc name data)
+ (let ((type (car-str data)))
+ (if (not (member type all-types))
+ (begin
+ (set! all-types (cons type all-types))
+ (set! ,types (cons type ,types))))
+ (let ((strs (parse-args args ',g-fnc)))
+ (if spec
+ (set! ,funcs (cons (list name type strs args spec) ,funcs))
+ (set! ,funcs (cons (list name type strs args) ,funcs)))
+ (hash-table-set! names name (func-type strs)))))))
+
+ (define (,strfnc name) ; CSTR-2.12
+ (if (assoc name ,names)
+ (format #t "~A ~A~%" name ',strfnc)
+ (begin
+ (set! ,strings (cons name ,strings))
+ (set! ,names (cons (cons name 'string) ,names)))))
+
+ (define* (,intfnc name type) ; CINT-2.12
+ (save-declared-type type)
+ (if (and type (not (assoc type direct-types)))
+ (format *stderr* "could be direct int: ~S (~S)~%" type name))
+ (if (hash-table-ref names name)
+ (format #t "~A ~A~%" name ',intfnc)
+ (begin
+ (set! ,ints (cons name ,ints))
+ (hash-table-set! names name 'int))))
+
+ (define (,castfnc name type) ; CCAST-2.12
+ (if (hash-table-ref names name)
+ (format #t "~A ~A~%" name ',castfnc)
+ (begin
+ (set! ,casts (cons (list name type) ,casts))
+ (hash-table-set! names name 'def))))
+
+ (define (,chkfnc name type) ; CCHK-2.12
+ (if (hash-table-ref names name)
+ (format #t "~A ~A~%" name ',chkfnc)
+ (begin
+ (set! ,checks (cons (list name type) ,checks))
+ (hash-table-set! names name 'def))))
+
+ (define (,withfnc dpy thunk) ; with-2.12
+ (dpy (string-append "#if GTK_CHECK_VERSION(" (substring ,vname 0 1) ", " (substring ,vname 2) ", 0)~%"))
+ (thunk)
+ (dpy "#endif~%~%"))
+
+ )))
+
+
+(make-fnc "2.14")
+(make-fnc "2.16")
+(make-fnc "2.18")
+(make-fnc "2.20")
+(make-fnc "3.0")
+(make-fnc "3.2")
+(make-fnc "3.4")
+(make-fnc "3.6")
+(make-fnc "3.8")
+(make-fnc "3.10")
+(make-fnc "3.12")
+(make-fnc "3.14")
+(make-fnc "3.16")
+(make-fnc "3.18")
+(make-fnc "3.20")
+
+(define cairo-funcs ())
+(define cairo-png-funcs ())
+(define cairo-ints ())
+(define cairo-types ())
+
+(define cairo-funcs-810 ())
+(define cairo-ints-810 ())
+(define cairo-types-810 ())
+
+(define cairo-funcs-912 ())
+(define cairo-ints-912 ())
+(define cairo-types-912 ())
+(define cairo-strings-912 ())
+(define cairo-names-912 ())
(define* (CFNC data spec spec-data) ; 'const -> const for arg cast, 'etc for ... args, 'free -> must free C val before return
(let ((name (cadr-str data))
(args (caddr-str data)))
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CFNC~%" name)
(let ((type (car-str data)))
(if (not (member type all-types)) (set! all-types (cons type all-types)))
@@ -999,181 +1053,18 @@
(if spec
(set! funcs (cons (list name type strs args spec spec-data) funcs))
(set! funcs (cons (list name type strs args) funcs)))
- (set! names (cons (cons name (func-type strs)) names)))))))
+ (hash-table-set! names name (func-type strs)))))))
(define (CFNC-PA data min-len max-len types)
- (let ((step (length types)))
- (CFNC data 'etc (list min-len max-len types))))
+ (CFNC data 'etc (list min-len max-len types)))
(define (CFNC-23-PA data min-len max-len types)
- (let ((step (length types)))
- (CFNC data 'etc (list min-len max-len types))))
-
-(define* (CFNC-22 data)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- (if (assoc name names)
- (no-way "~A CFNC-22~%" name)
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-22 (cons type types-22))))
- (let ((strs (parse-args args '22)))
- (set! funcs-22 (cons (list name type strs args) funcs-22))
- (set! names (cons (cons name (func-type strs)) names)))))))
-
-(define* (CFNC-213 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- (if (assoc name names)
- (no-way "CFNC-213: ~A~%" (list name data))
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-213 (cons type types-213))))
- (let ((strs (parse-args args '213)))
- (if spec
- (set! funcs-213 (cons (list name type strs args spec) funcs-213))
- (set! funcs-213 (cons (list name type strs args) funcs-213)))
- (set! names (cons (cons name (func-type strs)) names)))))))
-
-(define* (CFNC-2134 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- (if (assoc name names)
- (no-way "CFNC-2134: ~A~%" (list name data))
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-2134 (cons type types-2134))))
- (let ((strs (parse-args args '2134)))
- (if spec
- (set! funcs-2134 (cons (list name type strs args spec) funcs-2134))
- (set! funcs-2134 (cons (list name type strs args) funcs-2134)))
- (set! names (cons (cons name (func-type strs)) names)))))))
-
-(define* (CFNC-2150 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- (if (assoc name names)
- (no-way "CFNC-2150: ~A~%" (list name data))
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-2150 (cons type types-2150))))
- (let ((strs (parse-args args '2150)))
- (if spec
- (set! funcs-2150 (cons (list name type strs args spec) funcs-2150))
- (set! funcs-2150 (cons (list name type strs args) funcs-2150)))
- (set! names (cons (cons name (func-type strs)) names)))))))
-
-(define* (CFNC-2172 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- (if (assoc name names)
- (no-way "CFNC-2172: ~A~%" (list name data))
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-2172 (cons type types-2172))))
- (let ((strs (parse-args args '2172)))
- (if spec
- (set! funcs-2172 (cons (list name type strs args spec) funcs-2172))
- (set! funcs-2172 (cons (list name type strs args) funcs-2172)))
- (set! names (cons (cons name (func-type strs)) names)))))))
-
-(define* (CFNC-2173 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- (if (assoc name names)
- (no-way "CFNC-2173: ~A~%" (list name data))
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-2173 (cons type types-2173))))
- (let ((strs (parse-args args '2173)))
- (if spec
- (set! funcs-2173 (cons (list name type strs args spec) funcs-2173))
- (set! funcs-2173 (cons (list name type strs args) funcs-2173)))
- (set! names (cons (cons name (func-type strs)) names)))))))
-
-(define* (CFNC-2177 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- (if (assoc name names)
- (no-way "CFNC-2177: ~A~%" (list name data))
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-2177 (cons type types-2177))))
- (let ((strs (parse-args args '2177)))
- (if spec
- (set! funcs-2177 (cons (list name type strs args spec) funcs-2177))
- (set! funcs-2177 (cons (list name type strs args) funcs-2177)))
- (set! names (cons (cons name (func-type strs)) names)))))))
-
-(define* (CFNC-2190 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- (if (assoc name names)
- (no-way "CFNC-2190: ~A~%" (list name data))
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-2190 (cons type types-2190))))
- (let ((strs (parse-args args '2190)))
- (if spec
- (set! funcs-2190 (cons (list name type strs args spec) funcs-2190))
- (set! funcs-2190 (cons (list name type strs args) funcs-2190)))
- (set! names (cons (cons name (func-type strs)) names)))))))
-
-(define* (CFNC-300 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- ; (if (assoc name names)
- ; (no-way "CFNC-300: ~A~%" (list name data))
- ; this does not apply because gtk2-only funcs may be on the list
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-300 (cons type types-300))))
- (let ((strs (parse-args args '300)))
- (if spec
- (set! funcs-300 (cons (list name type strs args spec) funcs-300))
- (set! funcs-300 (cons (list name type strs args) funcs-300)))
- (set! names (cons (cons name (func-type strs)) names))))))
-
-(define* (CFNC-gtk2 data spec)
- (let ((name (cadr-str data))
- (args (caddr-str data)))
- ; (if (assoc name names)
- ; (no-way "CFNC-gtk2: ~A~%" (list name data))
- ; this does not apply because gtk3 funcs may be on the list
- (let ((type (car-str data)))
- (if (not (member type all-types))
- (begin
- (set! all-types (cons type all-types))
- (set! types-gtk2 (cons type types-gtk2))))
- (let ((strs (parse-args args 'gtk2)))
- (if spec
- (set! funcs-gtk2 (cons (list name type strs args spec) funcs-gtk2))
- (set! funcs-gtk2 (cons (list name type strs args) funcs-gtk2)))
- (set! names (cons (cons name (func-type strs)) names))))))
-
+ (CFNC data 'etc (list min-len max-len types)))
(define* (CAIRO-FUNC data spec)
(let ((name (cadr-str data))
(args (caddr-str data)))
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "CAIRO-FUNC: ~A~%" (list name data))
(let ((type (car-str data)))
(if (not (member type all-types))
@@ -1184,12 +1075,12 @@
(if spec
(set! cairo-funcs (cons (list name type strs args spec) cairo-funcs))
(set! cairo-funcs (cons (list name type strs args) cairo-funcs)))
- (set! names (cons (cons name (func-type strs)) names)))))))
+ (hash-table-set! names name (func-type strs)))))))
(define* (CAIRO-PNG-FUNC data spec)
(let ((name (cadr-str data))
(args (caddr-str data)))
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "CAIRO-PNG-FUNC: ~A~%" (list name data))
(let ((type (car-str data)))
(if (not (member type all-types))
@@ -1200,12 +1091,12 @@
(if spec
(set! cairo-png-funcs (cons (list name type strs args spec) cairo-png-funcs))
(set! cairo-png-funcs (cons (list name type strs args) cairo-png-funcs)))
- (set! names (cons (cons name (func-type strs)) names)))))))
+ (hash-table-set! names name (func-type strs)))))))
(define* (CAIRO-FUNC-810 data spec)
(let ((name (cadr-str data))
(args (caddr-str data)))
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "CAIRO-FUNC-810: ~A~%" (list name data))
(let ((type (car-str data)))
(if (not (member type all-types))
@@ -1216,12 +1107,12 @@
(if spec
(set! cairo-funcs-810 (cons (list name type strs args spec) cairo-funcs-810))
(set! cairo-funcs-810 (cons (list name type strs args) cairo-funcs-810)))
- (set! names (cons (cons name (func-type strs)) names)))))))
+ (hash-table-set! names name (func-type strs)))))))
(define* (CAIRO-FUNC-912 data spec)
(let ((name (cadr-str data))
(args (caddr-str data)))
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "CAIRO-FUNC-912: ~A~%" (list name data))
(let ((type (car-str data)))
(if (not (member type all-types))
@@ -1232,19 +1123,19 @@
(if spec
(set! cairo-funcs-912 (cons (list name type strs args spec) cairo-funcs-912))
(set! cairo-funcs-912 (cons (list name type strs args) cairo-funcs-912)))
- (set! names (cons (cons name (func-type strs)) names)))))))
+ (hash-table-set! names name (func-type strs)))))))
(define (helpify name type args)
(let* ((initial (format #f " #define H_~A \"~A ~A(" name type name))
- (line-len (string-length initial))
- (len (string-length args))
+ (line-len (length initial))
+ (len (length args))
(typed #f)
(help-max 100))
(hey initial)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len))
- (let ((ch (string-ref args i)))
+ (let ((ch (args i)))
(if (char=? ch #\space)
(if typed
(begin
@@ -1267,409 +1158,123 @@
(hey ")\"~%")))
(define (CATOM name)
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CATOM~%" name)
(begin
(set! atoms (cons name atoms))
- (set! names (cons (cons name 'atom) names)))))
+ (hash-table-set! names name 'atom))))
(define (CSTR name)
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CSTR~%" name)
(begin
(set! strings (cons name strings))
- (set! names (cons (cons name 'string) names)))))
-
-(define (CSTR-213 name)
- (if (assoc name names-213)
- (no-way "~A CSTR-213~%" name)
- (begin
- (set! strings-213 (cons name strings-213))
- (set! names-213 (cons (cons name 'string) names-213)))))
-
-(define (CSTR-2150 name)
- (if (assoc name names-2150)
- (no-way "~A CSTR-2150~%" name)
- (begin
- (set! strings-2150 (cons name strings-2150))
- (set! names-2150 (cons (cons name 'string) names-2150)))))
-
-(define (CSTR-300 name)
- (if (assoc name names-300)
- (no-way "~A CSTR-300~%" name)
- (begin
- (set! strings-300 (cons name strings-300))
- (set! names-300 (cons (cons name 'string) names-300)))))
+ (hash-table-set! names name 'string))))
(define (CDBL name)
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CDBL~%" name)
(begin
(set! dbls (cons name dbls))
- (set! names (cons (cons name 'dbl) names)))))
+ (hash-table-set! names name 'dbl))))
-(define declared-types '())
+(define declared-types ())
(define (save-declared-type type)
(if (and type
(not (member type declared-types)))
(set! declared-types (cons type declared-types))))
-(define* (CLNG name type spec-name)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CLNG~%" name)
- (begin
- (set! ulongs (cons (list name type spec-name) ulongs))
- (set! names (cons (cons name 'ulong) names)))))
-
-(define* (CLNG-gtk2 name type spec-name)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CLNG-gtk2~%" name)
- (begin
- (set! ulongs-gtk2 (cons (list name type spec-name) ulongs-gtk2))
- (set! names (cons (cons name 'ulong) names)))))
-
-(define* (CLNG-213 name type spec-name)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CLNG-213~%" name)
- (begin
- (set! ulongs-213 (cons (list name type spec-name) ulongs-213))
- (set! names (cons (cons name 'ulong) names)))))
-
-(define* (CLNG-2173 name type spec-name)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CLNG-2173~%" name)
- (begin
- (set! ulongs-2173 (cons (list name type spec-name) ulongs-2173))
- (set! names (cons (cons name 'ulong) names)))))
-
(define* (CINT name type)
(save-declared-type type)
- (if (assoc name names)
+ (if (and type (not (assoc type direct-types)))
+ (format *stderr* "could be direct int: ~S (~S)~%" type name))
+ (if (hash-table-ref names name)
(no-way "~A CINT~%" name)
(begin
(set! ints (cons name ints))
- (set! names (cons (cons name 'int) names)))))
+ (hash-table-set! names name 'int))))
-(define* (CINT-213 name type)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CINT-213~%" name)
- (begin
- (set! ints-213 (cons name ints-213))
- (set! names (cons (cons name 'int) names)))))
-
-(define* (CINT-2134 name type)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CINT-2134~%" name)
- (begin
- (set! ints-2134 (cons name ints-2134))
- (set! names (cons (cons name 'int) names)))))
-
-(define* (CINT-2150 name type)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CINT-2150~%" name)
- (begin
- (set! ints-2150 (cons name ints-2150))
- (set! names (cons (cons name 'int) names)))))
-
-(define* (CINT-2172 name type)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CINT-2172~%" name)
- (begin
- (set! ints-2172 (cons name ints-2172))
- (set! names (cons (cons name 'int) names)))))
-
-(define* (CINT-2173 name type)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CINT-2173~%" name)
- (begin
- (set! ints-2173 (cons name ints-2173))
- (set! names (cons (cons name 'int) names)))))
-
-(define* (CINT-2177 name type)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CINT-2177~%" name)
- (begin
- (set! ints-2177 (cons name ints-2177))
- (set! names (cons (cons name 'int) names)))))
-
-(define* (CINT-300 name type)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CINT-300~%" name)
- (begin
- (set! ints-300 (cons name ints-300))
- (set! names (cons (cons name 'int) names)))))
-
-(define* (CINT-gtk2 name type)
- (save-declared-type type)
- (if (assoc name names)
- (no-way "~A CINT-gtk2~%" name)
- (begin
- (set! ints-gtk2 (cons name ints-gtk2))
- (set! names (cons (cons name 'int) names)))))
(define* (CAIRO-INT name type)
(save-declared-type type)
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CAIRO-INT~%" name)
(begin
(set! cairo-ints (cons name cairo-ints))
- (set! names (cons (cons name 'int) names)))))
+ (hash-table-set! names name 'int))))
(define* (CAIRO-INT-810 name type)
(save-declared-type type)
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CAIRO-INT-810~%" name)
(begin
(set! cairo-ints-810 (cons name cairo-ints-810))
- (set! names (cons (cons name 'int) names)))))
+ (hash-table-set! names name 'int))))
(define* (CAIRO-INT-912 name type)
(save-declared-type type)
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CAIRO-INT-912~%" name)
(begin
(set! cairo-ints-912 (cons name cairo-ints-912))
- (set! names (cons (cons name 'int) names)))))
+ (hash-table-set! names name 'int))))
(define (CAIRO-STRING-912 name)
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CAIRO-STRING-912~%" name)
(begin
(set! cairo-strings-912 (cons name cairo-strings-912))
- (set! names (cons (cons name 'string) names)))))
+ (hash-table-set! names name 'string))))
(define (CCAST name type) ; this is the cast (type *)obj essentially but here it's (list type* (cadr obj))
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CCAST~%" name)
(begin
;;(if (not (member type types))
;; (set! types (cons type types)))
(set! casts (cons (list name type) casts))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCAST-213 name type)
- (if (assoc name names)
- (no-way "~A CCAST-213~%" name)
- (begin
- (set! casts-213 (cons (list name type) casts-213))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCAST-2172 name type)
- (if (assoc name names)
- (no-way "~A CCAST-2172~%" name)
- (begin
- (set! casts-2172 (cons (list name type) casts-2172))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCAST-2173 name type)
- (if (assoc name names)
- (no-way "~A CCAST-2173~%" name)
- (begin
- (set! casts-2173 (cons (list name type) casts-2173))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCAST-2190 name type)
- (if (assoc name names)
- (no-way "~A CCAST-2190~%" name)
- (begin
- (set! casts-2190 (cons (list name type) casts-2190))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCAST-300 name type)
- (if (assoc name names)
- (no-way "~A CCAST-300~%" name)
- (begin
- (set! casts-300 (cons (list name type) casts-300))
- (set! names (cons (cons name 'def) names)))))
+ (hash-table-set! names name 'def))))
-(define (CCAST-gtk2 name type)
- (if (assoc name names)
- (no-way "~A CCAST-gtk2~%" name)
- (begin
- (set! casts-gtk2 (cons (list name type) casts-gtk2))
- (set! names (cons (cons name 'def) names)))))
(define (CCHK name type)
- (if (assoc name names)
+ (if (hash-table-ref names name)
(no-way "~A CCHK~%" name)
(begin
(set! checks (cons (list name type) checks))
- (set! names (cons (cons name 'def) names)))))
+ (hash-table-set! names name 'def))))
-(define (CCHK-213 name type)
- (if (assoc name names)
- (no-way "~A CCHK-213~%" name)
- (begin
- (set! checks-213 (cons (list name type) checks-213))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCHK-2172 name type)
- (if (assoc name names)
- (no-way "~A CCHK-2172~%" name)
- (begin
- (set! checks-2172 (cons (list name type) checks-2172))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCHK-2173 name type)
- (if (assoc name names)
- (no-way "~A CCHK-2173~%" name)
- (begin
- (set! checks-2173 (cons (list name type) checks-2173))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCHK-2190 name type)
- (if (assoc name names)
- (no-way "~A CCHK-2190~%" name)
- (begin
- (set! checks-2190 (cons (list name type) checks-2190))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCHK-300 name type)
- (if (assoc name names)
- (no-way "~A CCHK-300~%" name)
- (begin
- (set! checks-300 (cons (list name type) checks-300))
- (set! names (cons (cons name 'def) names)))))
-
-(define (CCHK-gtk2 name type)
- (if (assoc name names)
- (no-way "~A CCHK-gtk2~%" name)
- (begin
- (set! checks-gtk2 (cons (list name type) checks-gtk2))
- (set! names (cons (cons name 'def) names)))))
-
-(define (STRUCT data)
- (let ((name (car-str data)) ; struct name (type)
- (args (cdr-str data)))
- (if (assoc name names)
- (no-way "~A STRUCT~%" name)
- (let ((strs (parse-args args 'ok))
- (type-name (string-append name "*")))
- (if (not (member type-name all-types))
- (begin
- (set! all-types (cons type-name all-types))
- (set! types (cons type-name types))))
- (for-each
- (lambda (field)
- (if (settable-field? field)
- (if (not (member (cadr field) settable-struct-fields))
- (set! settable-struct-fields (cons (cadr field) settable-struct-fields)))
- (if (not (member (cadr field) struct-fields))
- (set! struct-fields (cons (cadr field) struct-fields)))))
- strs)
- (set! structs (cons (list name strs args) structs))))))
-
-(define (STRUCT-make data)
- (STRUCT data)
- (set! make-structs (cons (car-str data) make-structs)))
-
-(define (STRUCT-300-make data)
- (STRUCT data)
- (set! make-structs-300 (cons (car-str data) make-structs-300)))
-
-(define (CAIRO-STRUCT-make data)
- (STRUCT data) ; fields not needed currently
- (set! cairo-make-structs (cons (car-str data) cairo-make-structs)))
-
-(define (find-struct name)
- (call-with-exit
- (lambda (return)
- (for-each
- (lambda (struct)
- (if (string=? name (car struct))
- (return struct)))
- structs))))
(define (no-arg name)
- (let ((len (string-length name)))
+ (let ((len (length name)))
(call-with-exit
(lambda (return)
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i len) name)
- (if (char=? (string-ref name i) #\()
+ (if (char=? (name i) #\()
(return (substring name 0 i))))))))
;;; ---------------------------------------- read data ----------------------------------------
(load "xgdata.scm")
;(define listable-types (list "gint8*" "int*" "gint*" "gdouble*"))
-(define listable-types '())
+(define listable-types ())
(for-each
(lambda (type)
- (let* ((len (string-length type))
- (dereftype (if (and (char=? (string-ref type (- len 1)) #\*)
- (not (string=? type "char*")) ; these are surely strings (and set would need XEN_TO_C_gchar etc)
- (not (string=? type "GError*"))
- (not (string=? type "GError**"))
- (not (string=? type "gchar*")))
- (substring type 0 (- len 1))
- #f)))
+ (let* ((len (length type))
+ (dereftype (and (char=? (type (- len 1)) #\*)
+ (not (string=? type "char*")) ; these are surely strings (and set would need Xen_to_C_gchar etc)
+ (not (string=? type "GError*"))
+ (not (string=? type "GError**"))
+ (not (string=? type "gchar*"))
+ (substring type 0 (- len 1)))))
(if (and dereftype
(assoc dereftype direct-types))
(set! listable-types (cons type listable-types)))))
types)
-
-(define (with-213 dpy thunk)
- (dpy "#if HAVE_GTK_TEST_WIDGET_CLICK~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-(define (with-2134 dpy thunk)
- (dpy "#if HAVE_GTK_ADJUSTMENT_GET_UPPER~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-(define (with-2150 dpy thunk)
- (dpy "#if HAVE_GTK_SCALE_ADD_MARK~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-(define (with-2172 dpy thunk)
- (dpy "#if HAVE_GTK_INFO_BAR_NEW~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-(define (with-2173 dpy thunk)
- (dpy "#if HAVE_GTK_STATUS_ICON_GET_TITLE~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-(define (with-2177 dpy thunk)
- (dpy "#if HAVE_GTK_WIDGET_GET_VISIBLE~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-(define (with-2190 dpy thunk)
- (dpy "#if HAVE_GTK_WIDGET_GET_MAPPED~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-(define (with-300 dpy thunk)
- (dpy "#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-(define (with-gtk2 dpy thunk)
- (dpy "#if (!HAVE_GTK_3)~%")
- (thunk)
- (dpy "#endif~%~%"))
-
-
(define (with-cairo dpy thunk)
(thunk)
)
@@ -1679,43 +1284,58 @@
)
(define (with-cairo-810 dpy thunk)
- (dpy "#if HAVE_CAIRO_GLYPH_ALLOCATE~%")
+ (dpy "#if HAVE_CAIRO_1_8~%")
(thunk)
(dpy "#endif~%~%"))
(define (with-cairo-912 dpy thunk)
- (dpy "#if HAVE_CAIRO_REGION_XOR~%")
+ (dpy "#if HAVE_CAIRO_1_9_12 && GTK_CHECK_VERSION(3, 0, 0)~%")
(thunk)
(dpy "#endif~%~%"))
-(define all-types (list types-213 types-2134 types-2150 types-2172 types-2173 types-2177 types-2190 types-300 types-gtk2
+(define all-ntypes (list types-2.14 types-2.16 types-2.18 types-2.20
+ types-3.0 types-3.2 types-3.4 types-3.6 types-3.8 types-3.10 types-3.12 types-3.14 types-3.16 types-3.18 types-3.20
cairo-types cairo-types-810 cairo-types-912))
-(define all-type-withs (list with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190 with-300 with-gtk2
+(define all-ntype-withs (list with-2.14 with-2.16 with-2.18 with-2.20
+ with-3.0 with-3.2 with-3.4 with-3.6 with-3.8 with-3.10 with-3.12 with-3.14 with-3.16 with-3.18 with-3.20
with-cairo with-cairo-810 with-cairo-912))
-(define all-funcs (list funcs-213 funcs-2134 funcs-2150 funcs-2172 funcs-2173 funcs-2177 funcs-2190 funcs-300 funcs-gtk2
+(define all-funcs (list funcs-2.14 funcs-2.16 funcs-2.18 funcs-2.20
+ funcs-3.0 funcs-3.2 funcs-3.4 funcs-3.6 funcs-3.8 funcs-3.10 funcs-3.12 funcs-3.14 funcs-3.16 funcs-3.18 funcs-3.20
cairo-funcs cairo-png-funcs cairo-funcs-810 cairo-funcs-912))
-(define all-func-withs (list with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-2190 with-300 with-gtk2
+(define all-func-withs (list with-2.14 with-2.16 with-2.18 with-2.20
+ with-3.0 with-3.2 with-3.4 with-3.6 with-3.8 with-3.10 with-3.12 with-3.14 with-3.16 with-3.18 with-3.20
with-cairo with-cairo-png with-cairo-810 with-cairo-912))
-(define all-ints (list ints-213 ints-2134 ints-2150 ints-2172 ints-2173 ints-2177 ints-300 ints-gtk2
+(define all-ints (list ints-2.14 ints-2.16 ints-2.18
+ ints-3.0 ints-3.2 ints-3.4 ints-3.6 ints-3.8 ints-3.10 ints-3.12 ints-3.14 ints-3.16 ints-3.18 ints-3.20
cairo-ints cairo-ints-810 cairo-ints-912))
-(define all-int-withs (list with-213 with-2134 with-2150 with-2172 with-2173 with-2177 with-300 with-gtk2
+(define all-int-withs (list with-2.14 with-2.16 with-2.18
+ with-3.0 with-3.2 with-3.4 with-3.6 with-3.8 with-3.10 with-3.12 with-3.14 with-3.16 with-3.18 with-3.20
with-cairo with-cairo-810 with-cairo-912))
-(define all-casts (list casts-213 casts-2134 casts-2150 casts-2172 casts-2173 casts-2190 casts-300 casts-gtk2))
-(define all-cast-withs (list with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-300 with-gtk2))
-
-(define all-checks (list checks-213 checks-2134 checks-2150 checks-2172 checks-2173 checks-2190 checks-300 checks-gtk2))
-(define all-check-withs (list with-213 with-2134 with-2150 with-2172 with-2173 with-2190 with-300 with-gtk2))
+(define all-casts (list casts-2.14 casts-2.16 casts-2.18 casts-2.20
+ casts-3.0 casts-3.2 casts-3.4 casts-3.6 casts-3.8 casts-3.10 casts-3.12 casts-3.14 casts-3.16 casts-3.18 casts-3.20
+ ))
+(define all-cast-withs (list with-2.14 with-2.16 with-2.18 with-2.20
+ with-3.0 with-3.2 with-3.4 with-3.6 with-3.8 with-3.10 with-3.12 with-3.14 with-3.16 with-3.18 with-3.20
+ ))
-(define all-strings (list strings-213 strings-2134 strings-2150 strings-300 cairo-strings-912))
-(define all-string-withs (list with-213 with-2134 with-2150 with-300 with-cairo-912))
+(define all-checks (list checks-2.14 checks-2.16 checks-2.18 checks-2.20
+ checks-3.0 checks-3.2 checks-3.4 checks-3.6 checks-3.8 checks-3.10 checks-3.12 checks-3.14 checks-3.16 checks-3.18 checks-3.20
+ ))
+(define all-check-withs (list with-2.14 with-2.16 with-2.18 with-2.20
+ with-3.0 with-3.2 with-3.4 with-3.6 with-3.8 with-3.10 with-3.12 with-3.14 with-3.16 with-3.18 with-3.20
+ ))
-(define all-ulongs (list ulongs-213 ulongs-2134 ulongs-2150 ulongs-2173 ulongs-gtk2))
-(define all-ulong-withs (list with-213 with-2134 with-2150 with-2173 with-gtk2))
+(define all-strings (list strings-2.14 strings-2.16
+ strings-3.0 strings-3.2 strings-3.4 strings-3.6 strings-3.8 strings-3.10 strings-3.12 strings-3.14 strings-3.16 strings-3.18 strings-3.20
+ cairo-strings-912))
+(define all-string-withs (list with-2.14 with-2.16
+ with-3.0 with-3.2 with-3.4 with-3.6 with-3.8 with-3.10 with-3.12 with-3.14 with-3.16 with-3.18 with-3.20
+ with-cairo-912))
@@ -1731,38 +1351,13 @@
(hey " *~%")
(hey " * added funcs:~%")
(hey " * (xg-version): date string.~%")
-(hey " * (->string val) interprets 'val' as a string.~%")
(hey " * (c-array->list arr len) derefs each member of arr, returning lisp list, len=#f: null terminated array~%")
(hey " * (list->c-array lst ctype) packages each member of list as c-type \"type\" returning (wrapped) c array~%")
(hey " * (make-target-entry lst) returns a GtkTargetEntry table, each member of 'lst' should be (list target flags info)~%")
-
-(for-each
- (lambda (name)
- (let ((args (cadr (find-struct name))))
- (if (> (length args) 0)
- (hey " * (~A" name)
- (hey " * (~A" name))
- (for-each
- (lambda (str)
- (hey " ~A" (cadr str)))
- args)
- (hey "): ~A struct~%" name)))
- (reverse make-structs))
-
-(if (not (null? cairo-make-structs))
- (for-each
- (lambda (name)
- (let ((args (cadr (find-struct name))))
- (if (> (length args) 0)
- (hey " * (~A" name)
- (hey " * (~A" name))
- (for-each
- (lambda (str)
- (hey " ~A" (cadr str)))
- args)
- (hey "): ~A struct (if cairo)~%" name)))
- (reverse cairo-make-structs)))
-
+(hey " * (GtkTextIter): GtkTextIter struct~%")
+(hey " * (GtkTreeIter): GtkTreeIter struct~%")
+(hey " * (PangoRectangle): PangoRectangle struct~%")
+(hey " * (cairo_matrix_t): cairo_matrix_t struct (if cairo)~%")
(hey " *~%")
(hey " * omitted functions and macros:~%")
(hey " * anything with a va_list or GtkArg* argument.~%")
@@ -1771,6 +1366,19 @@
(hey " * win32-specific functions~%")
(hey " *~%")
(hey " * HISTORY:~%")
+(hey " *~%")
+(hey " * 29-Oct: removed ->string.~%")
+(hey " * 21-Aug-15: procedure-signature changes.~%")
+(hey " * --------~%")
+(hey " * 27-Dec: integer procedure stuff.~%")
+(hey " * 16-Apr: changed max-args to 8.~%")
+(hey " * 6-Mar: changed most macros.~%")
+(hey " * 21-Feb-14: changed _p to _is_.~%")
+(hey " * --------~%")
+(hey " * 3-Sep: use symbol directly in type checks, not the symbol name.~%")
+(hey " * 18-Aug: changed the gtk version macros to reflect the version number.~%")
+(hey " * 7-Jun-13: added mixed arg types to the ... arg lists.~%")
+(hey " * --------~%")
(hey " * 19-Aug-10: removed lots of Gdk stuff -- we assume Gtk 2.9 and cairo now.~%")
(hey " * 28-Jan-10: removed the rest of the struct accessors.~%")
(hey " * --------~%")
@@ -1795,7 +1403,7 @@
(hey " * 13-Jun: folded xg-ruby.c into xg.c.~%")
(hey " * 21-Feb: changed libxm to libxg, xm-version to xg-version.~%")
(hey " * 10-Jan: plugged some memory leaks.~%")
-(hey " * 4-Jan-05: removed deprecated XEN_VECTOR_ELEMENTS.~%")
+(hey " * 4-Jan-05: removed deprecated Xen_VECTOR_ELEMENTS.~%")
(hey " * --------~%")
(hey " * 8-Dec: added some g_log handler funcs.~%")
(hey " * 6-Dec: check for lost callback context.~%")
@@ -1823,27 +1431,33 @@
(hey " * 19-Jul: XG_FIELD_PRE for change from using vertical-bar (reserved in R5RS)~%")
(hey " * 2-Jun: removed deprecated and broken stuff~%")
(hey " * 12-Mar: support for GtkDestroyNotify callbacks~%")
-(hey " * 25-Feb: dialog example in libxm.html~%")
(hey " * Ruby support via xg-ruby.c~%")
(hey " * 21-Feb: #f=NULL throughout, gdk-pixbuf, GTypes.~%")
(hey " * 11-Feb-02: initial version.~%")
(hey " */~%~%")
-(hey "#include <mus-config.h>~%~%")
+(hey "#include \"mus-config.h\"~%~%")
+
+(hey "#define HAVE_CAIRO_1_8 ((CAIRO_VERSION_MAJOR >= 1) && (CAIRO_VERSION_MINOR >= 8))~%")
+(hey "#define HAVE_CAIRO_1_9_12 ((CAIRO_VERSION_MAJOR >= 1) && (CAIRO_VERSION_MINOR >= 9) && (CAIRO_VERSION_MICRO >= 12))~%~%")
+
+(hey "#if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L))))~%")
+(hey " #define __func__ __FUNCTION__~%")
+(hey "#endif~%~%")
(hey "#if HAVE_EXTENSION_LANGUAGE~%~%")
-(hey "#if UNDEF_USE_SND~% #undef USE_SND~% #define USE_SND 0~%#endif~%~%")
+;(hey "#if UNDEF_USE_SND~% #undef USE_SND~% #define USE_SND 0~%#endif~%~%")
(hey "#include <string.h>~%")
(hey "#include <stdlib.h>~%~%")
(hey "#include <glib.h>~%")
(hey "#include <gdk/gdk.h>~%")
-(hey "#if (!HAVE_GTK_3)~%")
+(hey "#include <gtk/gtk.h>~%")
+(hey "#if (!GTK_CHECK_VERSION(3, 0, 0))~%")
(hey " #include <gdk/gdkkeysyms.h>~%")
(hey "#endif~%")
-(hey "#include <gtk/gtk.h>~%")
(hey "#include <glib-object.h>~%")
(hey "#include <pango/pango.h>~%")
(with-cairo hey (lambda () (hey "#include <cairo/cairo.h>~%")))
@@ -1866,10 +1480,10 @@
(hey " #endif~%")
(hey "#endif~%~%")
-(hey "/* -------------------------------- smob for GC -------------------------------- */~%")
-(hey "static XEN_OBJECT_TYPE xm_obj_tag;~%")
+(hey "/* -------------------------------- GC -------------------------------- */~%")
+(hey "static Xen_object_type_t xm_obj_tag;~%")
(hey "#if HAVE_RUBY~%")
-(hey "static void *xm_obj_free(XEN obj)~%")
+(hey "static void *xm_obj_free(Xen obj)~%")
(hey "{~%")
(hey " void *xobj;~%")
(hey " xobj = (void *)obj;~%")
@@ -1878,10 +1492,10 @@
(hey "}~%")
(hey "#endif~%")
(hey "#if HAVE_FORTH~%")
-(hey "static void xm_obj_free(XEN obj)~%")
+(hey "static void xm_obj_free(Xen obj)~%")
(hey "{~%")
(hey " void *val;~%")
-(hey " val = (void *)XEN_OBJECT_REF(obj);~%")
+(hey " val = (void *)Xen_object_ref(obj);~%")
(hey " free(val);~%")
(hey "}~%")
(hey "#endif~%")
@@ -1895,16 +1509,16 @@
(hey " return(x1 == x2);~%")
(hey "}~%")
(hey "#endif~%")
-(hey "static XEN make_xm_obj(void *ptr)~%")
+(hey "static Xen make_xm_obj(void *ptr)~%")
(hey "{~%")
-(hey " XEN_MAKE_AND_RETURN_OBJECT(xm_obj_tag, ptr, 0, xm_obj_free);~%")
+(hey " return(Xen_make_object(xm_obj_tag, ptr, 0, xm_obj_free));~%")
(hey "}~%")
(hey "static void define_xm_obj(void)~%")
(hey "{~%")
(hey "#if HAVE_SCHEME~%")
-(hey " xm_obj_tag = XEN_MAKE_OBJECT_TYPE(\"<XmObj>\", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL);~%")
+(hey " xm_obj_tag = s7_new_type_x(s7, \"<XmObj>\", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL, NULL);~%")
(hey "#else~%")
-(hey " xm_obj_tag = XEN_MAKE_OBJECT_TYPE(\"XmObj\", sizeof(void *));~%")
+(hey " xm_obj_tag = Xen_make_object_type(\"XmObj\", sizeof(void *));~%")
(hey "#endif~%")
(hey "#if HAVE_FORTH~%")
(hey " fth_set_object_free(xm_obj_tag, xm_obj_free);~%")
@@ -1914,112 +1528,133 @@
(hey "/* prefix for all names */~%")
(hey "#if HAVE_SCHEME~%")
-(hey " #define XG_PRE \"\"~%")
-(hey " #define XG_FIELD_PRE \".\"~%")
-(hey " #define XG_POST \"\"~%")
+(hey " #define Xg_pre \"\"~%")
+(hey " #define Xg_field_pre \".\"~%")
+(hey " #define Xg_post \"\"~%")
(hey "#endif~%")
(hey "#if HAVE_RUBY~%")
(hey "/* for Ruby, XG PRE needs to be uppercase */~%")
-(hey " #define XG_PRE \"R\"~%")
-(hey " #define XG_POST \"\"~%")
-(hey " #define XG_FIELD_PRE \"R\"~%")
+(hey " #define Xg_pre \"R\"~%")
+(hey " #define Xg_post \"\"~%")
+(hey " #define Xg_field_pre \"R\"~%")
(hey "#endif~%")
(hey "#if HAVE_FORTH~%")
-(hey " #define XG_PRE \"F\"~%")
-(hey " #define XG_POST \"\"~%")
-(hey " #define XG_FIELD_PRE \"F\"~%")
+(hey " #define Xg_pre \"F\"~%")
+(hey " #define Xg_post \"\"~%")
+(hey " #define Xg_field_pre \"F\"~%")
(hey "#endif~%")
(hey "~%")
-(hey "#define WRAP_FOR_XEN(Name, Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(Name), XEN_WRAP_C_POINTER(Value))~%")
-(hey "#define WRAP_P(Name, Value) (XEN_LIST_P(Value) && \\~%")
-(hey " (XEN_LIST_LENGTH(Value) >= 2) && \\~%")
-(hey " (XEN_SYMBOL_P(XEN_CAR(Value))) && \\~%")
-(hey " (strcmp(Name, XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))~%")
+(hey "static Xen xg_~A_symbol" (no-stars (car all-types)))
+(for-each
+ (lambda (typ)
+ (hey ", xg_~A_symbol" (no-stars typ)))
+ (cdr all-types))
+
+(define other-types
+ (list 'idler 'GtkCellRendererPixbuf_ 'GtkCheckButton_ 'GtkDrawingArea_ 'GtkScrollbar_ 'GtkSeparator_ 'GtkSeparatorMenuItem_
+ 'GdkEventExpose_ 'GdkEventNoExpose_ 'GdkEventVisibility_ 'GdkEventButton_ 'GdkEventScroll_ 'GdkEventCrossing_
+ 'GdkEventFocus_ 'GdkEventConfigure_ 'GdkEventProperty_ 'GdkEventSelection_ 'GdkEventProximity_ 'GdkEventSetting_
+ 'GdkEventWindowState_ 'GdkEventDND_ 'GtkFileChooserDialog_ 'GtkFileChooserWidget_ 'GtkColorButton_ 'GtkAccelMap
+ 'GtkCellRendererCombo_ 'GtkCellRendererProgress_ 'GtkCellRendererAccel_ 'GtkCellRendererSpin_ 'GtkRecentChooserDialog_
+ 'GtkRecentChooserWidget_ 'GtkCellRendererSpinner_ 'gboolean_
+ 'GtkFontChooserDialog_ 'GtkFontChooserWidget_ 'GtkColorChooserDialog_ 'GtkColorChooserWidget_ 'GtkColorWidget_
+ 'GtkGestureLongPress_
+ ))
+
+(for-each
+ (lambda (typ)
+ (hey ", xg_~A_symbol" typ))
+ other-types)
+
+(hey ";~%~%")
+
+
+(hey "#define wrap_for_Xen(Name, Value) Xen_list_2(xg_ ## Name ## _symbol, Xen_wrap_C_pointer(Value))~%")
+(hey "#define is_wrapped(Name, Value) (Xen_is_pair(Value) && (Xen_car(Value) == xg_ ## Name ## _symbol))~%")
(hey "~%")
-(hey "#define XM_TYPE(Name, XType) \\~%")
+(hey "#define Xm_type(Name, XType) \\~%")
;; these are not pointers, so should not use wrap_c_pointer and friends
-(hey " static XEN C_TO_XEN_ ## Name (XType val) {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(#Name), C_TO_XEN_ULONG(val)));} \\~%")
-(hey " static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \\~%")
-(hey " static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}~%")
+(hey " static Xen C_to_Xen_ ## Name (XType val) {return(Xen_list_2(xg_ ## Name ## _symbol, C_ulong_to_Xen_ulong(val)));} \\~%")
+(hey " static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}~%")
(hey "~%")
-(hey "#define XM_TYPE_1(Name, XType) \\~%")
-(hey " static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \\~%")
-(hey " static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}~%")
+(hey "#define Xm_type_1(Name, XType) \\~%")
+(hey " static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}~%")
(hey "~%")
- ;(hey "#define XM_TYPE_NO_P(Name, XType) \\~%")
- ;(hey " static XEN C_TO_XEN_ ## Name (XType val) {return(WRAP_FOR_XEN(#Name, val));} \\~%")
- ;(hey " static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \\~%")
+ ;(hey "#define Xm_type_no_P(Name, XType) \\~%")
+ ;(hey " static Xen C_to_Xen_ ## Name (XType val) {return(wrap_for_Xen(Name, val));} \\~%")
+ ;(hey " static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \\~%")
;(hey "~%")
-(hey "#define XM_TYPE_NO_P_2(Name, XType) \\~%")
-(hey " static XEN C_TO_XEN_ ## Name (XType val) {return(WRAP_FOR_XEN(#Name, val));}~%")
+(hey "#define Xm_type_no_p_2(Name, XType) \\~%")
+(hey " static Xen C_to_Xen_ ## Name (XType val) {return(wrap_for_Xen(Name, val));}~%")
(hey "~%")
-(hey "#define XM_TYPE_PTR(Name, XType) \\~%")
-(hey " static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \\~%")
-(hey " static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \\~%")
-(hey " static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}~%")
+(hey "#define Xm_type_Ptr(Name, XType) \\~%")
+(hey " static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(Name, val)); return(Xen_false);} \\~%")
+(hey " static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}~%")
(hey "~%")
-(hey "#define XM_TYPE_PTR_CONST(Name, XType) \\~%")
-(hey " static XEN C_TO_XEN_ ## Name (const XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \\~%")
-(hey " static const XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((const XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \\~%")
-(hey " static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}~%")
+(hey "#define Xm_type_Ptr_const(Name, XType) \\~%")
+(hey " static Xen C_to_Xen_ ## Name (const XType val) {if (val) return(wrap_for_Xen(Name, val)); return(Xen_false);} \\~%")
+(hey " static const XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((const XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}~%")
(hey "~%")
-(hey "#define XM_TYPE_PTR_1(Name, XType) \\~%")
-(hey " static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \\~%")
-(hey " static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}~%")
+(hey "#define Xm_type_Ptr_1(Name, XType) \\~%")
+(hey " static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \\~%")
+(hey " static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}~%")
(hey "~%")
-(hey "#define XM_TYPE_PTR_2(Name, XType) \\~%")
-(hey " static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \\~%")
+(hey "#define Xm_type_Ptr_2(Name, XType) \\~%")
+(hey " static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(Name, val)); return(Xen_false);} \\~%")
(hey "~%")
(hey "/* type checks for callback wrappers */~%")
(define (callback-p func)
- (hey "#define XEN_~A_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, ~D)))~%"
+ (hey "#define Xen_is_~A(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, ~D)))~%"
(symbol->string (callback-name func))
(length (callback-args func))))
(for-each callback-p callbacks)
- ;(hey "#define XEN_lambda_P(Arg) XEN_PROCEDURE_P(Arg)~%")
-(hey "#define XEN_GCallback_P(Arg) (XEN_PROCEDURE_P(Arg) && ((XEN_REQUIRED_ARGS_OK(Arg, 2)) || (XEN_REQUIRED_ARGS_OK(Arg, 3)) || (XEN_REQUIRED_ARGS_OK(Arg, 4))))~%")
+ ;(hey "#define Xen_is_lambda(Arg) Xen_is_procedure(Arg)~%")
+(hey "#define Xen_is_GCallback(Arg) (Xen_is_procedure(Arg) && ((Xen_is_aritable(Arg, 2)) || (Xen_is_aritable(Arg, 3)) || (Xen_is_aritable(Arg, 4))))~%")
(define (xen-callback func)
- (hey "#define XEN_TO_C_~A(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_~A~%"
+ (hey "#define Xen_to_C_~A(Arg) Xen_is_false(Arg) ? NULL : gxg_~A~%"
(symbol->string (callback-name func))
(callback-func func)))
(for-each xen-callback callbacks)
-(hey "#define XEN_TO_C_GCallback(Arg) ((XEN_REQUIRED_ARGS_OK(Arg, 4)) ? (GCallback)gxg_func4 : ((XEN_REQUIRED_ARGS_OK(Arg, 3)) ? (GCallback)gxg_func3 : (GCallback)gxg_func2))~%")
-;; (hey "#define XEN_TO_C_GCallback(Arg) ((XEN_REQUIRED_ARGS_OK(Arg, 3)) ? (GCallback)gxg_func3 : (GCallback)gxg_func2)~%")
+(hey "#define Xen_to_C_GCallback(Arg) ((Xen_is_aritable(Arg, 4)) ? (GCallback)gxg_func4 : ((Xen_is_aritable(Arg, 3)) ? (GCallback)gxg_func3 : (GCallback)gxg_func2))~%")
+;; (hey "#define Xen_to_C_GCallback(Arg) ((Xen_is_aritable(Arg, 3)) ? (GCallback)gxg_func3 : (GCallback)gxg_func2)~%")
-(hey "#define XEN_TO_C_lambda_data(Arg) (gpointer)gxg_ptr~%")
-(hey "#define XEN_lambda_data_P(Arg) 1~%")
+(hey "#define Xen_to_C_lambda_data(Arg) (gpointer)gxg_ptr~%")
+(hey "#define Xen_is_lambda_data(Arg) 1~%")
;; needed if func returns func of this type
-(hey "#define C_TO_XEN_GtkTreeViewSearchPositionFunc(Arg) WRAP_FOR_XEN(\"GtkTreeViewSearchPositionFunc\", Arg)~%")
-(hey "#define C_TO_XEN_GtkTreeViewSearchEqualFunc(Arg) WRAP_FOR_XEN(\"GtkTreeViewSearchEqualFunc\", Arg)~%")
- ;(hey "#define C_TO_XEN_GtkLinkButtonUriFunc(Arg) WRAP_FOR_XEN(\"GtkLinkButtonUriFunc\", Arg)~%")
- ;(hey "#define C_TO_XEN_GtkTreeIterCompareFunc(Arg) WRAP_FOR_XEN(\"GtkTreeViewSearchEqualFunc\", Arg)~%")
- ;(hey "#define C_TO_XEN_GtkTreeSelectionFunc(Arg) WRAP_FOR_XEN(\"GtkTreeSelectionFunc\", Arg)~%")
- ;(hey "#define C_TO_XEN_GtkMenuPositionFunc(Arg) WRAP_FOR_XEN(\"GtkMenuPositionFunc\", Arg)~%")
- ;(hey "#define C_TO_XEN_GtkDestroyNotify(Arg) WRAP_FOR_XEN(\"GtkDestroyNotify\", Arg)~%")
-(hey "#define XEN_TO_C_GdkFilterReturn(Arg) (GdkFilterReturn)XEN_TO_C_INT(Arg)~%")
-
-(hey "#define XEN_TO_C_String(Arg) ((XEN_STRING_P(Arg)) ? XEN_TO_C_STRING(Arg) : NULL)~%")
-(hey "#define C_TO_XEN_String(Arg) ((Arg != NULL) ? C_TO_XEN_STRING((char *)Arg) : XEN_FALSE)~%")
-(hey "#define XEN_String_P(Arg) ((XEN_FALSE_P(Arg)) || (XEN_STRING_P(Arg)))~%")
-
-(hey "static XEN C_TO_XEN_GError_(GError *err)~%")
+(hey "#define C_to_Xen_GtkTreeViewSearchPositionFunc(Arg) wrap_for_Xen(GtkTreeViewSearchPositionFunc, Arg)~%")
+(hey "#define C_to_Xen_GtkTreeViewSearchEqualFunc(Arg) wrap_for_Xen(GtkTreeViewSearchEqualFunc, Arg)~%")
+ ;(hey "#define C_to_Xen_GtkLinkButtonUriFunc(Arg) wrap_for_Xen(GtkLinkButtonUriFunc, Arg)~%")
+ ;(hey "#define C_to_Xen_GtkTreeIterCompareFunc(Arg) wrap_for_Xen(GtkTreeViewSearchEqualFunc, Arg)~%")
+ ;(hey "#define C_to_Xen_GtkTreeSelectionFunc(Arg) wrap_for_Xen(GtkTreeSelectionFunc, Arg)~%")
+ ;(hey "#define C_to_Xen_GtkMenuPositionFunc(Arg) wrap_for_Xen(GtkMenuPositionFunc, Arg)~%")
+ ;(hey "#define C_to_Xen_GtkDestroyNotify(Arg) wrap_for_Xen(GtkDestroyNotify, Arg)~%")
+(hey "#define Xen_to_C_GdkFilterReturn(Arg) (GdkFilterReturn)Xen_integer_to_C_int(Arg)~%")
+
+;(hey "#define Xen_to_C_String(Arg) Xen_string_to_C_string(Arg)~%")
+(hey "#define C_to_Xen_String(Arg) C_string_to_Xen_string((char *)Arg)~%")
+
+(hey "static Xen C_to_Xen_GError_(GError *err)~%")
(hey "{~%")
(hey " if (err)~%")
(hey " {~%")
-(hey " XEN msg;~%")
-(hey " msg = C_TO_XEN_STRING(err->message);~%")
+(hey " Xen msg;~%")
+(hey " msg = C_string_to_Xen_string(err->message);~%")
(hey " g_error_free(err);~%")
(hey " return(msg);~%")
(hey " }~%")
-(hey " return(XEN_FALSE);~%")
+(hey " return(Xen_false);~%")
(hey "}~%")
@@ -2028,96 +1663,72 @@
(for-each type-it (reverse types))
(for-each
(lambda (type-list with-func)
- (if (not (null? type-list))
+ (if (pair? type-list)
(with-func hey (lambda ()
(for-each type-it (reverse type-list))))))
- all-types all-type-withs)
+ all-ntypes all-ntype-withs)
-(hey "#define XLS(a, b) XEN_TO_C_gchar_(XEN_LIST_REF(a, b))~%")
-(hey "#define XLI(a, b) ((int)XEN_TO_C_INT(XEN_LIST_REF(a, b)))~%")
-(hey "#define XLG(a, b) XEN_TO_C_GType(XEN_LIST_REF(a, b))~%")
-(hey "#define XLT(a, b) XEN_TO_C_GtkTextTag_(XEN_LIST_REF(a, b))~%~%")
-
-(hey "static XEN c_to_xen_string(XEN str)~%")
-(hey "{~%")
-(hey " return(C_TO_XEN_STRING((char *)XEN_UNWRAP_C_POINTER(str)));~%")
-(hey "}~%~%")
+(hey "#define XLS(a, b) Xen_to_C_gchar_(Xen_list_ref(a, b))~%")
+(hey "#define XLI(a, b) ((int)Xen_integer_to_C_int(Xen_list_ref(a, b)))~%")
+(hey "#define XLL(a, b) (Xen_llong_to_C_llong(Xen_list_ref(a, b)))~%")
+(hey "#define XLG(a, b) Xen_to_C_GType(Xen_list_ref(a, b))~%")
+(hey "#define XLT(a, b) Xen_to_C_GtkTextTag_(Xen_list_ref(a, b))~%")
+(hey "#define XLA(a, b) ((Xen_is_integer(Xen_list_ref(a, b))) ? ((gpointer)XLL(a, b)) : ((Xen_is_string(Xen_list_ref(a, b))) ? ((gpointer)XLS(a, b)) : ((gpointer)XLG(a, b))))~%~%")
(hey "/* -------------------------------- gc protection -------------------------------- */~%")
(hey "~%")
-(hey "static XEN xm_protected;~%")
+(hey "static Xen xm_protected;~%")
(hey "static int xm_protected_size = 0;~%")
-(hey "static XEN xm_gc_table;~%")
+(hey "static Xen xm_gc_table;~%")
(hey "static int last_xm_unprotect = NOT_A_GC_LOC;~%")
(hey "~%")
-(hey "static int xm_protect(XEN obj)~%")
+(hey "static int xm_protect(Xen obj)~%")
(hey "{~%")
(hey " int i, new_size;~%")
-(hey " XEN new_table;~%")
+(hey " Xen new_table;~%")
(hey " if (last_xm_unprotect >= 0)~%")
(hey " {~%")
(hey " i = last_xm_unprotect;~%")
-(hey " if (XEN_FALSE_P(XEN_VECTOR_REF(xm_protected, i)))~%")
+(hey " if (Xen_is_false(Xen_vector_ref(xm_protected, i)))~%")
(hey " {~%")
-(hey " XEN_VECTOR_SET(xm_protected, i, obj);~%")
+(hey " Xen_vector_set(xm_protected, i, obj);~%")
(hey " last_xm_unprotect = NOT_A_GC_LOC;~%")
(hey " return(i);~%")
(hey " }~%")
(hey " last_xm_unprotect = NOT_A_GC_LOC;~%")
(hey " }~%")
(hey " for (i = 0; i < xm_protected_size; i++)~%")
-(hey " if (XEN_FALSE_P(XEN_VECTOR_REF(xm_protected, i)))~%")
+(hey " if (Xen_is_false(Xen_vector_ref(xm_protected, i)))~%")
(hey " {~%")
-(hey " XEN_VECTOR_SET(xm_protected, i, obj);~%")
+(hey " Xen_vector_set(xm_protected, i, obj);~%")
(hey " return(i);~%")
(hey " }~%")
(hey " new_size = xm_protected_size * 2;~%")
-(hey " new_table = XEN_MAKE_VECTOR(new_size, XEN_FALSE);~%")
+(hey " new_table = Xen_make_vector(new_size, Xen_false);~%")
(hey " for (i = 0; i < xm_protected_size; i++)~%")
(hey " {~%")
-(hey " XEN_VECTOR_SET(new_table, i, XEN_VECTOR_REF(xm_protected, i));~%")
-(hey " XEN_VECTOR_SET(xm_protected, i, XEN_FALSE);~%")
+(hey " Xen_vector_set(new_table, i, Xen_vector_ref(xm_protected, i));~%")
+(hey " Xen_vector_set(xm_protected, i, Xen_false);~%")
(hey " }~%")
-(hey " XEN_VECTOR_SET(new_table, xm_protected_size, obj);~%")
-(hey " XEN_VECTOR_SET(xm_gc_table, 0, new_table);~%")
+(hey " Xen_vector_set(new_table, xm_protected_size, obj);~%")
+(hey " Xen_vector_set(xm_gc_table, 0, new_table);~%")
(hey " i = xm_protected_size;~%")
(hey " xm_protected_size = new_size;~%")
(hey " xm_protected = new_table;~%")
(hey " return(i);~%")
(hey "}~%")
(hey "~%")
-(hey "#if 0~%")
-(hey "static void xm_unprotect_idler(guint id)~%")
-(hey "{~%")
-(hey " int i;~%")
-(hey " XEN cur, idler;~%")
-(hey " for (i = 0; i < xm_protected_size; i++)~%")
-(hey " {~%")
-(hey " cur = XEN_VECTOR_REF(xm_protected, i);~%")
-(hey " if ((XEN_LIST_P(cur)) && (XEN_LIST_LENGTH(cur) == 3) && (XEN_LIST_P(XEN_CADDR(cur))))~%")
-(hey " {~%")
-(hey " idler = XEN_CADDR(cur);~%")
-(hey " if ((XEN_SYMBOL_P(XEN_CAR(idler))) &&~%")
-(hey " (strcmp(\"idler\", XEN_SYMBOL_TO_C_STRING(XEN_CAR(idler))) == 0) &&~%")
-(hey " (id == (guint)(XEN_TO_C_INT(XEN_CADR(idler)))))~%")
-(hey " {~%")
-(hey " velts[i] = XEN_FALSE;~%")
-(hey " last_xm_unprotect = i;~%")
-(hey " return;~%")
-(hey " }}}~%")
-(hey "}~%")
-(hey "#endif~%")
(hey "static void xm_unprotect_at(int ind)~%")
(hey "{~%")
-(hey " XEN_VECTOR_SET(xm_protected, ind, XEN_FALSE);~%")
+(hey " Xen_vector_set(xm_protected, ind, Xen_false);~%")
(hey " last_xm_unprotect = ind;~%")
(hey "}~%~%")
(hey "~%~%/* ---------------------------------------- callback handlers ---------------------------------------- */~%~%")
-(let ((funcs-done '()))
+(let ((funcs-done ()))
(let ((xc (lambda (func)
(let* ((name (callback-func func))
(type (callback-type func))
@@ -2137,19 +1748,11 @@
(lambda (arg)
(if previous-arg (hey ", "))
;; ctr is 0-based here
- (if (or (and (or (eq? fname 'GtkClipboardTextReceivedFunc)
- (eq? fname 'GtkAccelMapForeach)
- (eq? fname 'GtkEntryCompletionMatchFunc)
- ;(eq? fname 'GtkLinkButtonUriFunc)
- )
- (= ctr 1))
- (and (or (eq? fname 'GtkTreeViewSearchEqualFunc)
- (eq? fname 'GLogFunc)
- (eq? fname 'GtkClipboardRichTextReceivedFunc))
- (= ctr 2))
- (and (or (eq? fname 'GtkFileFilterFunc)
- (eq? fname 'GtkRecentFilterFunc)
- (eq? fname 'GLogFunc))
+ (if (or (and (memq fname '(GtkClipboardTextReceivedFunc GtkAccelMapForeach GtkEntryCompletionMatchFunc))
+ (= ctr 1))
+ (and (memq fname '(GtkTreeViewSearchEqualFunc GLogFunc GtkClipboardRichTextReceivedFunc))
+ (= ctr 2))
+ (and (memq fname '(GtkFileFilterFunc GtkRecentFilterFunc GLogFunc))
(= ctr 0)))
(hey "const "))
(set! ctr (+ ctr 1))
@@ -2162,40 +1765,41 @@
args)
(hey ")~%"))
(hey "{~% ")
- ;; I tried to use XEN_ERROR here but it was a no-op for some reason??
- (hey "if (!XEN_LIST_P((XEN)func_info)) return~A;~% "
+ ;; I tried to use Xen_error here but it was a no-op for some reason??
+ (hey "if (!Xen_is_list((Xen)func_info)) return~A;~% "
(if void?
""
(format #f "((~A)0)" (no-stars type))))
(if (eq? gctype 'permanent-gcc)
(hey "#if (!(defined(__cplusplus)))~% ")) ; const arg conversion causes trouble if g++
(let ((castlen (+ 12 (if (not void?)
- (+ 2 (string-length (format #f "return(XEN_TO_C_~A" (no-stars type))))
+ (+ 2 (length (format #f "return(Xen_to_C_~A" (no-stars type))))
1))))
(if (not void?)
- (hey "return(XEN_TO_C_~A("
+ (hey "return(Xen_to_C_~A("
(no-stars type)))
- (hey "XEN_CALL_~D(~A((XEN)func_info),~%"
- (length args)
+ (hey "Xen_call_with_~A_arg~A(~A((Xen)func_info),~%"
+ (if (zero? (length args)) "no" (length args))
+ (if (= (length args) 1) "" "s")
(if (eq? fname 'GtkClipboardClearFunc)
- "XEN_CADDR"
+ "Xen_caddr"
(if (eq? fname 'GtkDestroyNotify)
- "XEN_CADDDR"
- "XEN_CAR")))
+ "Xen_cadddr"
+ "Xen_car")))
(for-each
(lambda (arg)
(hey (substring " " 0 castlen))
(if (not (string=? (car arg) "lambda_data"))
- (hey "C_TO_XEN_~A(~A~A),~%"
+ (hey "C_to_Xen_~A(~A~A),~%"
(no-stars (car arg))
(if (string=? (car arg) "GtkFileFilterInfo*")
"(GtkFileFilterInfo *)"
"")
(cadr arg))
- (hey "XEN_CADR((XEN)func_info),~%")))
+ (hey "Xen_cadr((Xen)func_info),~%")))
args)
(hey (substring " " 0 castlen))
- (hey "c__FUNCTION__)")
+ (hey "__func__)")
(if void?
(hey ";~%")
(hey "));~%")))
@@ -2212,25 +1816,27 @@
(hey "~%static gboolean gxg_func3(GtkWidget *w, GdkEventAny *ev, gpointer data)~%")
(hey "{~%")
-(hey " return(XEN_TO_C_BOOLEAN(XEN_CALL_3(XEN_CAR((XEN)data),~%")
-(hey " C_TO_XEN_GtkWidget_(w),~%")
-(hey " C_TO_XEN_GdkEventAny_(ev),~%")
-(hey " XEN_CADR((XEN)data),~%")
-(hey " c__FUNCTION__)));~%")
+(hey " return(Xen_boolean_to_C_bool(Xen_call_with_3_args(Xen_car((Xen)data),~%")
+(hey " C_to_Xen_GtkWidget_(w),~%")
+(hey " C_to_Xen_GdkEventAny_(ev),~%")
+(hey " Xen_cadr((Xen)data),~%")
+(hey " __func__)));~%")
(hey "}~%")
(hey "~%static gboolean gxg_func4(GtkPrintOperation *op, GtkPrintContext *context, gint page_nr, gpointer data)~%")
(hey "{~%")
-(hey " return(XEN_TO_C_BOOLEAN(XEN_CALL_4(XEN_CAR((XEN)data),~%")
-(hey " C_TO_XEN_GtkPrintOperation_(op),~%")
-(hey " C_TO_XEN_GtkPrintContext_(context),~%")
-(hey " C_TO_XEN_INT(page_nr),~%")
-(hey " XEN_CADR((XEN)data),~%")
-(hey " c__FUNCTION__)));~%")
+(hey " return(Xen_boolean_to_C_bool(Xen_call_with_4_args(Xen_car((Xen)data),~%")
+(hey " C_to_Xen_GtkPrintOperation_(op),~%")
+(hey " C_to_Xen_GtkPrintContext_(context),~%")
+(hey " C_int_to_Xen_integer(page_nr),~%")
+(hey " Xen_cadr((Xen)data),~%")
+(hey " __func__)));~%")
(hey "}~%~%")
(hey "~%~%/* ---------------------------------------- functions ---------------------------------------- */~%~%")
+(define max-args 8)
+
(define handle-func
(lambda (data)
(let* ((name (car data))
@@ -2240,18 +1846,17 @@
(refargs (ref-args args))
(xgargs (- cargs refargs))
(argstr (cadddr data))
- (lambda-type (cdr (assoc name names)))
+ (lambda-type (hash-table-ref names name))
(callback-data (and (not (eq? lambda-type 'fnc))
(find-callback
(lambda (func)
(and (eq? (callback-name func) lambda-type)
func)))))
- (spec (and (> (length data) 4) (list-ref data 4)))
- (spec-data (and (> (length data) 5) (list-ref data 5)))
+ (spec (and (> (length data) 4) (data 4)))
+ (spec-data (and (> (length data) 5) (data 5)))
(arg-start 0)
(line-len 0)
- (line-max 120)
- (max-args 10))
+ (line-max 120))
(define (hey-start)
;; start of checked line
@@ -2264,38 +1869,38 @@
(define (hey-on . args)
;; no cr -- just append
(let ((line (apply format #f args)))
- (set! line-len (+ line-len (string-length line)))
+ (set! line-len (+ line-len (length line)))
(heyc line)))
(define (hey-ok arg)
;; cr ok after arg
- (set! line-len (+ line-len (string-length arg)))
+ (set! line-len (+ line-len (length arg)))
(heyc arg)
(if (> line-len line-max)
(begin
(hey "~%")
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i arg-start))
(heyc " "))
(set! line-len arg-start))))
- (hey "static XEN gxg_~A(" name)
+ (hey "static Xen gxg_~A(" name)
(if (= (length args) 0)
(heyc "void")
(if (>= (length args) max-args)
- (begin
- (heyc "XEN arglist"))
+ (heyc "Xen arglist")
(let ((previous-arg #f))
(for-each
(lambda (arg)
(let ((argname (cadr arg))
- (argtype (car arg)))
+ ;(argtype (car arg))
+ )
(if previous-arg (heyc ", "))
(set! previous-arg #t)
(if (and (ref-arg? arg)
(not (member name (list "gdk_init" "gdk_init_check" "gtk_init" "gtk_init_check" "gtk_parse_args"))))
- (hey "XEN ignore_~A" argname)
- (hey "XEN ~A" argname))))
+ (hey "Xen ignore_~A" argname)
+ (hey "Xen ~A" argname))))
args))))
(hey ")~%{~%")
(helpify name return-type argstr)
@@ -2310,7 +1915,7 @@
(if (and (>= (length args) max-args)
(> xgargs 0))
(let ((previous-arg #f))
- (heyc " XEN ")
+ (heyc " Xen ")
(for-each
(lambda (arg)
(if (not (ref-arg? arg)) ;(< (length arg) 3)
@@ -2324,7 +1929,7 @@
(for-each
(lambda (arg)
(if (not (ref-arg? arg))
- (hey " ~A = XEN_LIST_REF(arglist, ~D);~%" (cadr arg) ctr))
+ (hey " ~A = Xen_list_ref(arglist, ~D);~%" (cadr arg) ctr))
(set! ctr (+ ctr 1)))
args))))
(if (> (length args) 0)
@@ -2336,29 +1941,29 @@
(argtype (car arg)))
(if (not (ref-arg? arg))
(if (null-arg? arg)
- (hey " XEN_ASSERT_TYPE(XEN_~A_P(~A) || XEN_FALSE_P(~A), ~A, ~D, ~S, ~S);~%"
+ (hey " Xen_check_type(Xen_is_~A(~A) || Xen_is_false(~A), ~A, ~D, ~S, ~S);~%"
(no-stars argtype) argname argname argname ctr name argtype)
(if (opt-arg? arg)
(begin
- (hey " if (XEN_NOT_BOUND_P(~A)) ~A = XEN_FALSE; ~%" argname argname)
- (hey " else XEN_ASSERT_TYPE(XEN_~A_P(~A), ~A, ~D, ~S, ~S);~%"
+ (hey " if (!Xen_is_bound(~A)) ~A = Xen_false; ~%" argname argname)
+ (hey " else Xen_check_type(Xen_is_~A(~A), ~A, ~D, ~S, ~S);~%"
(no-stars argtype) argname argname ctr name argtype))
- (hey " XEN_ASSERT_TYPE(XEN_~A_P(~A), ~A, ~D, ~S, ~S);~%"
+ (hey " Xen_check_type(Xen_is_~A(~A), ~A, ~D, ~S, ~S);~%"
(no-stars argtype) argname argname ctr name argtype)))
(if (>= (length arg) 3)
- (if (char=? (string-ref (list-ref arg 2) 0) #\{)
+ (if (char=? ((arg 2) 0) #\{)
(begin
(set! argc (deref-name arg))
- (hey " ~A = XEN_TO_C_~A(~A);~%" (deref-name arg) (deref-type arg) argname))
- (if (char=? (string-ref (list-ref arg 2) 0) #\|)
+ (hey " ~A = Xen_to_C_~A(~A);~%" (deref-name arg) (deref-type arg) argname))
+ (if (char=? ((arg 2) 0) #\|)
(begin
(hey " ~A = (~A)calloc(~A, sizeof(~A));~%"
(deref-name arg)
(deref-type arg)
argc
(deref-element-type arg))
- (hey " {~% int i;~% XEN lst;~% lst = XEN_COPY_ARG(~A);~%" argname)
- (hey " for (i = 0; i < ~A; i++, lst = XEN_CDR(lst)) ~A[i] = XEN_TO_C_~A(XEN_CAR(lst));~%"
+ (hey " {~% int i;~% Xen lst;~% lst = Xen_copy_arg(~A);~%" argname)
+ (hey " for (i = 0; i < ~A; i++, lst = Xen_cdr(lst)) ~A[i] = Xen_to_C_~A(Xen_car(lst));~%"
argc
(deref-name arg)
(no-stars (deref-element-type arg)))
@@ -2376,36 +1981,37 @@
(set! using-result (and (not (string=? return-type "void"))
(not (eq? lambda-type 'lambda))))
(hey " {~%")
- (if using-result (hey " XEN result = XEN_FALSE;~%"))
+ (if using-result (hey " Xen result;~%"))
(if using-loc (hey " int loc;~%"))
- (hey " XEN gxg_ptr = XEN_LIST_5(~A, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);~%"
+ (hey " Xen gxg_ptr = Xen_list_5(~A, func_info, Xen_false, Xen_false, Xen_false);~%"
(call-with-exit
(lambda (name-it)
(for-each
(lambda (arg)
(let ((argname (cadr arg))
- (argtype (car arg)))
+ ;(argtype (car arg))
+ )
(if (string=? argname "func")
(name-it "func"))))
args)
- "XEN_FALSE")))
+ "Xen_false")))
(if using-loc
(hey " loc = xm_protect(gxg_ptr);~%")
(hey " xm_protect(gxg_ptr);~%"))
(if using-loc
- (hey " XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));~%")
+ (hey " Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));~%")
(if (eq? lambda-type 'GtkClipboardGetFunc)
- (hey " XEN_LIST_SET(gxg_ptr, 2, clear_func);~%")))
+ (hey " Xen_list_set(gxg_ptr, 2, clear_func);~%")))
(for-each
(lambda (arg)
(let ((argname (cadr arg))
(argtype (car arg)))
(if (string=? argtype "GtkDestroyNotify")
- (hey " XEN_LIST_SET(gxg_ptr, 3, ~A);~%" argname))))
+ (hey " Xen_list_set(gxg_ptr, 3, ~A);~%" argname))))
args)
(hey-start)
(if using-result
- (hey-on " result = C_TO_XEN_~A(" (no-stars return-type))
+ (hey-on " result = C_to_Xen_~A(" (no-stars return-type))
(heyc " ")))
(begin ; lambda-type = 'fnc
(set! using-result (and (> refargs 0)
@@ -2413,24 +2019,31 @@
(if using-result
(begin
(hey " {~%")
- (hey " XEN result = XEN_FALSE;~%")))
+ (hey " Xen result;~%")))
(hey-start)
+
(if (not (eq? spec 'etc))
(if (not (string=? return-type "void"))
(if (= refargs 0)
(if (eq? spec 'free)
- (hey-on " {~% ~A result;~% XEN rtn;~% result = " return-type)
+ (hey-on " {~% ~A result;~% Xen rtn;~% result = " return-type)
(if (eq? spec 'const-return)
- (hey " return(C_TO_XEN_~A((~A)" (no-stars return-type) return-type)
- (hey-on " return(C_TO_XEN_~A(" (no-stars return-type))))
- (hey-on " result = C_TO_XEN_~A(" (no-stars return-type)))
+ (hey " return(C_to_Xen_~A((~A)" (no-stars return-type) return-type)
+ (begin
+ (if (member name idlers)
+ (begin
+ (hey " xm_unprotect_at(Xen_integer_to_C_int(Xen_caddr(~A)));~%" (cadar args))
+ (set! idlers (remove-if (lambda (x) (string=? x name)) idlers))))
+ (hey-on " return(C_to_Xen_~A(" (no-stars return-type)))))
+ (hey-on " result = C_to_Xen_~A(" (no-stars return-type)))
(hey-on " ")))))
+
;; pass args
(if (eq? spec 'etc)
(begin
;; goes to end
;; need to check ... list, set up locals, send out switch, return result
- (let* ((list-name (cadr (list-ref args (- cargs 1))))
+ (let* ((list-name (cadr (args (- cargs 1))))
(min-len (car spec-data))
(max-len (cadr spec-data))
(types (caddr spec-data))
@@ -2444,23 +2057,23 @@
(hey " int etc_len = 0;~%")
(if (not (string=? return-type "void"))
(hey " ~A result = ~A;~%" return-type (if (has-stars return-type) "NULL" "0")))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (- cargs 1)))
- (let ((arg (list-ref args i)))
+ (let ((arg (args i)))
(hey " ~A p_arg~D;~%" (car arg) i)))
- (hey " if (XEN_LIST_P(~A)) etc_len = XEN_LIST_LENGTH(~A);~%" list-name list-name)
+ (hey " if (Xen_is_list(~A)) etc_len = Xen_list_length(~A);~%" list-name list-name)
(if (> min-len 0)
- (hey " if (etc_len < ~D) XEN_OUT_OF_RANGE_ERROR(~S, ~A, ~A, \"... list must have at least ~D entr~A\");~%"
+ (hey " if (etc_len < ~D) Xen_out_of_range_error(~S, ~A, ~A, \"... list must have at least ~D entr~A\");~%"
min-len name (- cargs 1) list-name min-len (if (= min-len 1) "y" "ies")))
- (hey " if (etc_len > ~D) XEN_OUT_OF_RANGE_ERROR(~S, ~A, ~A, \"... list too long (max len: ~D)\");~%"
+ (hey " if (etc_len > ~D) Xen_out_of_range_error(~S, ~A, ~A, \"... list too long (max len: ~D)\");~%"
max-len name (- cargs 1) list-name max-len)
(if (not (= modlen 1))
- (hey " if ((etc_len % ~D) != 0) XEN_OUT_OF_RANGE_ERROR(~S, ~A, ~A, \"... list len must be multiple of ~D\");~%"
+ (hey " if ((etc_len % ~D) != 0) Xen_out_of_range_error(~S, ~A, ~A, \"... list len must be multiple of ~D\");~%"
modlen name (- cargs 1) list-name modlen))
- (do ((i 0 (+ 1 i)))
+ (do ((i 0 (+ i 1)))
((= i (- cargs 1)))
- (let ((arg (list-ref args i)))
- (hey " p_arg~D = XEN_TO_C_~A(~A);~%" i (no-stars (car arg)) (cadr arg))))
+ (let ((arg (args i)))
+ (hey " p_arg~D = Xen_to_C_~A(~A);~%" i (no-stars (car arg)) (cadr arg))))
(hey " switch (etc_len)~%")
(hey " {~%")
(do ((i min-len (+ i modlen)))
@@ -2470,13 +2083,13 @@
(hey " case ~D: ~A(" i name))
(do ((j 0 (+ 1 j)))
((= j (- cargs 1)))
- (let ((arg (list-ref args j)))
+ (let () ;(arg (args j)))
(hey "p_arg~D, " j)))
;; assume ending null for now
(let ((modctr 0))
(do ((j 0 (+ 1 j)))
((= j i))
- (let ((type (list-ref types modctr)))
+ (let ((type (types modctr)))
(set! modctr (+ 1 modctr))
(if (>= modctr modlen) (set! modctr 0))
(if (string=? type "int")
@@ -2487,7 +2100,7 @@
(hey "XLT(")
(if (string=? type "GType")
(hey "XLG(")
- (display (format #f "unknown etc element type: ~A~%" type)))))))
+ (hey "XLA("))))))
(hey "~A, ~D)" list-name j)
(if (or with-null with-minus-one (< j (- i 1)))
(hey ", "))))
@@ -2500,9 +2113,10 @@
(hey "-1); break;~%")
(hey "); break;~%"))))
(hey " }~%")
+
(if (not (string=? return-type "void"))
- (hey " return(C_TO_XEN_~A(result));~%" (no-stars return-type))
- (hey " return(XEN_FALSE);~%"))
+ (hey " return(C_to_Xen_~A(result));~%" (no-stars return-type))
+ (hey " return(Xen_false);~%"))
(hey " }~%")
))
(begin
@@ -2518,16 +2132,12 @@
(argtype (car arg)))
(if previous-arg (hey-ok ", "))
(if (and (eq? spec 'const)
- (or (string=? argtype "char**")
- (string=? argtype "gchar**")
- (string=? argtype "gchar*")
- (string=? argtype "char*")
- (string=? argtype "GValue*")))
+ (member argtype '("char**" "gchar**" "gchar*" "char*" "GValue*") string=?))
(hey "(const ~A)" argtype))
(set! previous-arg #t)
(if (ref-arg? arg)
(hey-on "&~A" (deref-name arg))
- (hey-on "XEN_TO_C_~A(~A)" (no-stars argtype) argname))))
+ (hey-on "Xen_to_C_~A(~A)" (no-stars argtype) argname))))
args)))
(if (not (eq? lambda-type 'fnc))
(if (not (string=? return-type "void"))
@@ -2544,36 +2154,36 @@
(hey " xm_unprotect_at(loc);~%"))
(if (and callback-data
(eq? (callback-gc callback-data) 'semi-permanent))
- (hey " XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL(\"idler\"), ~A, C_TO_XEN_INT(loc)));~%"
- (if (string=? return-type "void") "XEN_FALSE" "result")))
+ (hey " Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, ~A, C_int_to_Xen_integer(loc)));~%"
+ (if (string=? return-type "void") "Xen_false" "result")))
(if using-result
(hey " return(result);~%")
- (hey " return(XEN_FALSE);~%"))
+ (hey " return(Xen_false);~%"))
(hey " }~%"))
(begin ;'fnc
(if (> refargs 0)
- (let* ((previous-arg using-result))
+ (let ((previous-arg using-result))
(if using-result (heyc " "))
(if (string=? name "gdk_property_get")
(begin
;; special case -- type returned is dependent to some extent on atom
- (hey " {~% XEN data_val = XEN_FALSE;~%\
+ (hey " {~% Xen data_val = Xen_false;~%\
if (ref_actual_property_type == GDK_TARGET_STRING)~%\
- data_val = C_TO_XEN_STRING((char *)ref_data);~%\
- else if (ref_actual_length > 0) data_val = C_TO_XEN_STRINGN((char *)ref_data, ref_actual_length * ref_actual_format / 8);~%\
- return(XEN_LIST_5(result, C_TO_XEN_GdkAtom(ref_actual_property_type), C_TO_XEN_gint(ref_actual_format), ~%\
- C_TO_XEN_gint(ref_actual_length), data_val));~%\
+ data_val = C_string_to_Xen_string((char *)ref_data);~%\
+ else if (ref_actual_length > 0) data_val = C_string_to_Xen_string_with_length((char *)ref_data, ref_actual_length * ref_actual_format / 8);~%\
+ return(Xen_list_5(result, C_to_Xen_GdkAtom(ref_actual_property_type), C_to_Xen_gint(ref_actual_format), ~%\
+ C_to_Xen_gint(ref_actual_length), data_val));~%\
}~% }~%")
)
(begin
- (hey " return(XEN_LIST_~D(" (+ refargs (if using-result 1 0)))
+ (hey " return(Xen_list_~D(" (+ refargs (if using-result 1 0)))
(if using-result (heyc "result"))
(for-each
(lambda (arg)
(if (ref-arg? arg)
(begin
(if previous-arg (heyc ", "))
- (hey "C_TO_XEN_~A(~A)" (no-stars (deref-type arg)) (deref-name arg))
+ (hey "C_to_Xen_~A(~A)" (no-stars (deref-type arg)) (deref-name arg))
(set! previous-arg #t))))
args)
(hey "));~%")
@@ -2581,16 +2191,14 @@
;; refargs = 0
(begin
(if (member name idlers)
- (if (string=? name "gtk_idle_remove")
- (hey " xm_unprotect_idler(XEN_TO_C_guint(~A));~%" (cadr (car args)))
- (hey " xm_unprotect_at(XEN_TO_C_INT(XEN_CADDR(~A)));~%" (cadr (car args)))))
+ (hey " xm_unprotect_at(Xen_integer_to_C_int(Xen_caddr(~A)));~%" (cadar args)))
(if (string=? return-type "void")
- (hey " return(XEN_FALSE);~%")))))))
+ (hey " return(Xen_false);~%")))))))
(begin ; 'lambda (see line 1846)
- (hey "if (XEN_REQUIRED_ARGS_OK(func, 2))~%")
+ (hey "if (Xen_is_aritable(func, 2))~%")
(hey-start)
(if (not (string=? return-type "void"))
- (hey-on " return(C_TO_XEN_~A(~A(" (no-stars return-type) name)
+ (hey-on " return(C_to_Xen_~A(~A(" (no-stars return-type) name)
(hey-on " ~A(" name))
(hey-mark)
(let ((previous-arg #f))
@@ -2600,7 +2208,7 @@
(argtype (car arg)))
(if previous-arg (hey-ok ", "))
(set! previous-arg #t)
- (hey-on "XEN_TO_C_~A(~A)" (no-stars argtype) argname)))
+ (hey-on "Xen_to_C_~A(~A)" (no-stars argtype) argname)))
args))
(if (not (string=? return-type "void"))
(hey ")));~%")
@@ -2608,7 +2216,7 @@
(hey " else~%")
(hey-start)
(if (not (string=? return-type "void"))
- (hey-on " return(C_TO_XEN_~A(~A(" (no-stars return-type) name)
+ (hey-on " return(C_to_Xen_~A(~A(" (no-stars return-type) name)
(hey-on " ~A(" name))
(hey-mark)
(let ((previous-arg #f))
@@ -2618,17 +2226,17 @@
(argtype (car arg)))
(if previous-arg (hey-ok ", "))
(set! previous-arg #t)
- (hey-on "XEN_TO_C_~A(~A)" (no-stars argtype) argname)))
+ (hey-on "Xen_to_C_~A(~A)" (no-stars argtype) argname)))
args))
(if (string=? return-type "void")
(begin
(hey ");~%")
- (hey " return(XEN_FALSE);~%"))
+ (hey " return(Xen_false);~%"))
(hey ")));~%"))
(hey " }~%")) ;'lambda
))) ; 'begin
(if (eq? spec 'free)
- (hey " rtn = C_TO_XEN_~A(result);~% g_free(result);~% return(rtn);~% }~%" (no-stars return-type)))
+ (hey " rtn = C_to_Xen_~A(result);~% g_free(result);~% return(rtn);~% }~%" (no-stars return-type)))
(hey "}~%~%")
))))
@@ -2636,28 +2244,28 @@
(for-each handle-func (reverse funcs))
(for-each
(lambda (func-list with-func)
- (if (not (null? func-list))
+ (if (pair? func-list)
(with-func hey (lambda ()
(for-each handle-func (reverse func-list))))))
all-funcs all-func-withs)
-(hey "#define WRAPPED_OBJECT_P(Obj) (XEN_LIST_P(Obj) && (XEN_LIST_LENGTH(Obj) >= 2) && (XEN_SYMBOL_P(XEN_CAR(Obj))))~%~%")
+(hey "#define Xen_is_wrapped_object(Obj) (Xen_is_list(Obj) && (Xen_list_length(Obj) >= 2) && (Xen_is_symbol(Xen_car(Obj))))~%~%")
(define cast-it
(lambda (cast)
(let ((cast-name (car cast))
(cast-type (cadr cast)))
- (hey "static XEN gxg_~A(XEN obj)" (no-arg cast-name))
- (hey " {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(~S), XEN_CADR(obj)) : XEN_FALSE);}~%" (no-stars cast-type)))))
+ (hey "static Xen gxg_~A(Xen obj)" (no-arg cast-name))
+ (hey " {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_~A_symbol, Xen_cadr(obj)) : Xen_false);}~%" (no-stars cast-type)))))
-(hey "static XEN gxg_GPOINTER(XEN obj)")
-(hey " {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(\"gpointer\"), (WRAPPED_OBJECT_P(obj)) ? XEN_CADR(obj) : XEN_WRAP_C_POINTER(obj)));}~%")
+(hey "static Xen gxg_GPOINTER(Xen obj)")
+(hey " {return(Xen_list_2(xg_gpointer_symbol, (Xen_is_wrapped_object(obj)) ? Xen_cadr(obj) : Xen_wrap_C_pointer(obj)));}~%")
(for-each cast-it (reverse casts))
(for-each
(lambda (cast-list cast-func)
- (if (not (null? cast-list))
+ (if (pair? cast-list)
(cast-func hey (lambda ()
(for-each cast-it (reverse cast-list))))))
all-casts all-cast-withs)
@@ -2665,142 +2273,126 @@
;;; checks have to use the built-in macros, not local symbol-based type checks
(define (make-check func)
- (hey "static XEN gxg_~A(XEN obj)" (no-arg (car func)))
- (hey " {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && ~A((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}~%" (no-arg (car func))))
+ (hey "static Xen gxg_~A(Xen obj)" (no-arg (car func)))
+ (hey " {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && ~A((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}~%" (no-arg (car func))))
(for-each make-check (reverse checks))
(for-each
(lambda (check-list check-func)
- (if (not (null? check-list))
+ (if (pair? check-list)
(check-func hey (lambda ()
(for-each make-check (reverse check-list))))))
all-checks all-check-withs)
+
(hey "~%~%/* ---------------------------------------- special functions ---------------------------------------- */~%~%")
;;; from Mike Scholz -- improve the error checking
-(hey "static XEN gxg_gtk_init(XEN argc, XEN argv) ~%")
+(hey "static Xen gxg_gtk_init(Xen argc, Xen argv) ~%")
(hey "{ ~%")
(hey " #define H_gtk_init \"void gtk_init(int* argc, char*** argv)\" ~%")
(hey " int ref_argc = 0; ~%")
(hey " char** ref_argv = NULL; ~%")
-(hey " if (XEN_BOUND_P(argv)) ~%")
+(hey " if (Xen_is_bound(argv)) ~%")
(hey " { ~%")
-(hey " if (XEN_BOUND_P(argc) && XEN_INTEGER_P(argc) && XEN_TO_C_int(argc) <= XEN_LIST_LENGTH(argv)) ~%")
-(hey " ref_argc = XEN_TO_C_int(argc); ~%")
-(hey " else ref_argc = XEN_LIST_LENGTH(argv); ~%")
+(hey " if (Xen_is_bound(argc) && Xen_is_integer(argc) && Xen_to_C_int(argc) <= Xen_list_length(argv)) ~%")
+(hey " ref_argc = Xen_to_C_int(argc); ~%")
+(hey " else ref_argc = Xen_list_length(argv); ~%")
(hey " } ~%")
(hey " ref_argv = (char**)calloc(ref_argc, sizeof(char*)); ~%")
(hey " { ~%")
(hey " int i; ~%")
-(hey " XEN lst; ~%")
-(hey " lst = XEN_COPY_ARG(argv); ~%")
-(hey " for (i = 0; i < ref_argc; i++, lst = XEN_CDR(lst)) ref_argv[i] = XEN_TO_C_char_(XEN_CAR(lst));~%")
+(hey " Xen lst; ~%")
+(hey " lst = Xen_copy_arg(argv); ~%")
+(hey " for (i = 0; i < ref_argc; i++, lst = Xen_cdr(lst)) ref_argv[i] = Xen_to_C_char_(Xen_car(lst));~%")
(hey " }~%")
(hey " gtk_init(&ref_argc, &ref_argv);~%")
-(hey " return(XEN_LIST_2(C_TO_XEN_int(ref_argc), C_TO_XEN_char__(ref_argv)));~%")
+(hey " return(Xen_list_2(C_to_Xen_int(ref_argc), C_to_Xen_char__(ref_argv)));~%")
(hey "} ~%")
(hey "~%")
-(hey "static XEN gxg_gtk_init_check(XEN argc, XEN argv) ~%")
+(hey "static Xen gxg_gtk_init_check(Xen argc, Xen argv) ~%")
(hey "{ ~%")
(hey " #define H_gtk_init_check \"gboolean gtk_init_check(int* argc, char*** argv)\" ~%")
(hey " int ref_argc = 0; ~%")
(hey " char** ref_argv = NULL; ~%")
-(hey " if (XEN_BOUND_P(argc) && XEN_LIST_P(argc)) ~%")
+(hey " if (Xen_is_bound(argc) && Xen_is_list(argc)) ~%")
(hey " { ~%")
(hey " argv = argc; ~%")
-(hey " ref_argc = XEN_LIST_LENGTH(argv); ~%")
+(hey " ref_argc = Xen_list_length(argv); ~%")
(hey " } ~%")
(hey " else ~%")
(hey " {~%")
-(hey " if (XEN_BOUND_P(argv)) ~%")
+(hey " if (Xen_is_bound(argv)) ~%")
(hey " { ~%")
(hey " int len; ~%")
-(hey " XEN_ASSERT_TYPE(XEN_INTEGER_P(argc), argc, 1, \"gtk_init_check\", \"int argc\"); ~%")
-(hey " XEN_ASSERT_TYPE(XEN_LIST_P(argv), argv, 2, \"gtk_init_check\", \"char *argv[]\"); ~%")
-(hey " len = XEN_LIST_LENGTH(argv); ~%")
-(hey " ref_argc = XEN_TO_C_int(argc); ~%")
+(hey " Xen_check_type(Xen_is_integer(argc), argc, 1, \"gtk_init_check\", \"int argc\"); ~%")
+(hey " Xen_check_type(Xen_is_list(argv), argv, 2, \"gtk_init_check\", \"char *argv[]\"); ~%")
+(hey " len = Xen_list_length(argv); ~%")
+(hey " ref_argc = Xen_to_C_int(argc); ~%")
(hey " if (ref_argc > len) ref_argc = len; ~%")
(hey " }~%")
(hey " }~%")
(hey " ref_argv = (char**)calloc(ref_argc, sizeof(char*)); ~%")
(hey " { ~%")
(hey " int i; ~%")
-(hey " XEN lst; ~%")
-(hey " lst = XEN_COPY_ARG(argv); ~%")
-(hey " for (i = 0; i < ref_argc; i++, lst = XEN_CDR(lst)) ref_argv[i] = XEN_TO_C_char_(XEN_CAR(lst));~%")
+(hey " Xen lst; ~%")
+(hey " lst = Xen_copy_arg(argv); ~%")
+(hey " for (i = 0; i < ref_argc; i++, lst = Xen_cdr(lst)) ref_argv[i] = Xen_to_C_char_(Xen_car(lst));~%")
(hey " }~%")
(hey " {~%")
-(hey " XEN result = XEN_FALSE;~%")
-(hey " result = C_TO_XEN_gboolean(gtk_init_check(&ref_argc, &ref_argv));~%")
-(hey " return(XEN_LIST_3(result, C_TO_XEN_int(ref_argc), C_TO_XEN_char__(ref_argv)));~%")
+(hey " Xen result;~%")
+(hey " result = C_to_Xen_gboolean(gtk_init_check(&ref_argc, &ref_argv));~%")
+(hey " return(Xen_list_3(result, C_to_Xen_int(ref_argc), C_to_Xen_char__(ref_argv)));~%")
(hey " }~%")
(hey "}~%~%")
-(hey "static XEN gxg_make_target_entry(XEN lst)~%")
+(hey "static Xen gxg_make_target_entry(Xen lst)~%")
(hey "{~%")
(hey " GtkTargetEntry* targets;~%")
-(hey " XEN val;~%")
(hey " int i, len;~%")
(hey " #define H_make_target_entry \"(make-target-entry lst): GtkTargetEntry*, each member of 'lst' should be (list target flags info)\"~%")
-(hey " XEN_ASSERT_TYPE(XEN_LIST_P(lst), lst, XEN_ONLY_ARG, \"make-target-entry\", \"a list of lists describing each target\");~%")
-(hey " len = XEN_LIST_LENGTH(lst);~%")
-(hey " if (len == 0) return(XEN_FALSE);~%")
+(hey " Xen_check_type(Xen_is_list(lst), lst, 1, \"make-target-entry\", \"a list of lists describing each target\");~%")
+(hey " len = Xen_list_length(lst);~%")
+(hey " if (len == 0) return(Xen_false);~%")
(hey " targets = (GtkTargetEntry *)calloc(len, sizeof(GtkTargetEntry));~%")
(hey " for (i = 0; i < len; i++)~%")
(hey " {~%")
-(hey " val = XEN_LIST_REF(lst, i);~%")
-(hey " targets[i].target = xen_strdup(XEN_TO_C_STRING(XEN_LIST_REF(val, 0)));~%")
-(hey " targets[i].flags = (guint)XEN_TO_C_ULONG(XEN_LIST_REF(val, 1));~%")
-(hey " targets[i].info = (guint)XEN_TO_C_ULONG(XEN_LIST_REF(val, 2));~%")
+(hey " Xen val;~%")
+(hey " val = Xen_list_ref(lst, i);~%")
+(hey " targets[i].target = xen_strdup(Xen_string_to_C_string(Xen_list_ref(val, 0)));~%")
+(hey " targets[i].flags = (guint)Xen_ulong_to_C_ulong(Xen_list_ref(val, 1));~%")
+(hey " targets[i].info = (guint)Xen_ulong_to_C_ulong(Xen_list_ref(val, 2));~%")
(hey " }~%")
-(hey " return(C_TO_XEN_GtkTargetEntry_(targets));~%")
+(hey " return(C_to_Xen_GtkTargetEntry_(targets));~%")
(hey "}~%")
-(hey "/* ---------------------------------------- structs ---------------------------------------- */~%~%")
-
-;;; (hey " #define XG_DEFINE_READER(Name, Value, A1, A2, A3) XEN_DEFINE_PROCEDURE(XG_FIELD_PRE #Name XG_POST, Value, A1, A2, A3, #Name \" field reader\")~%")
-(hey " #if HAVE_RUBY~%")
-(hey " #define XG_DEFINE_ACCESSOR(Name, Value, SetValue, A1, A2, A3, A4) \\~%")
-(hey " XEN_DEFINE_PROCEDURE_WITH_SETTER(XG_FIELD_PRE #Name XG_POST, Value, #Name \" field accessor\", XG_FIELD_PRE \"set_\" #Name XG_POST, SetValue, A1, A2, A3, A4)~%")
-(hey " #endif~%")
-(hey " #if HAVE_SCHEME~%")
-(hey " #define XG_DEFINE_ACCESSOR(Name, Value, SetValue, A1, A2, A3, A4) \\~%")
-(hey " XEN_DEFINE_PROCEDURE_WITH_SETTER(XG_FIELD_PRE #Name XG_POST, Value, #Name \" field accessor\", \"set! \" XG_FIELD_PRE #Name XG_POST, SetValue, A1, A2, A3, A4)~%")
-(hey " #endif~%~%")
-(hey " #if HAVE_FORTH~%")
-(hey " #define XG_DEFINE_ACCESSOR(Name, Value, SetValue, A1, A2, A3, A4) \\~%")
-(hey " XEN_DEFINE_PROCEDURE_WITH_SETTER(XG_FIELD_PRE #Name XG_POST, Value, #Name \" field accessor\", \"set-\" XG_FIELD_PRE #Name XG_POST, SetValue, A1, A2, A3, A4)~%")
-(hey " #endif~%")
-
(define (array->list type)
- (hey " if (strcmp(ctype, ~S) == 0)~%" (no-stars type))
+ (hey " if (ctype == xg_~A_symbol)~%" (no-stars type))
(hey " {~%")
- (hey " ~A arr; arr = (~A)XEN_UNWRAP_C_POINTER(XEN_CADR(val)); ~%" type type)
+ (hey " ~A arr; arr = (~A)Xen_unwrap_C_pointer(Xen_cadr(val)); ~%" type type)
(hey " if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}~%")
- (hey " for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_~A(arr[i]), result);~%" (no-stars (deref-type (list type))))
+ (hey " for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_~A(arr[i]), result);~%" (no-stars (deref-type (list type))))
(hey " }~%"))
(define (list->array type)
- (hey " if (strcmp(ctype, ~S) == 0)~%" type)
+ (hey " if (type == xg_~A_symbol)~%" (no-stars type))
(hey " {~%")
(hey " ~A arr; arr = (~A)calloc(len + 1, sizeof(~A));~%" type type (deref-type (list type)))
- (hey " for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_~A(XEN_CAR(val));~%" (no-stars (deref-type (list type))))
- (hey " return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL(~S), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));~%" (no-stars type))
+ (hey " for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_~A(Xen_car(val));~%" (no-stars (deref-type (list type))))
+ (hey " return(Xen_list_3(xg_~A_symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));~%" (no-stars type))
(hey " }~%"))
(hey "/* conversions */~%")
-(hey "static XEN c_array_to_xen_list(XEN val_1, XEN clen)~%")
+(hey "static Xen c_array_to_xen_list(Xen val_1, Xen clen)~%")
(hey "{~%")
-(hey " XEN result = XEN_EMPTY_LIST;~%")
-(hey " XEN val;~%")
+(hey " Xen result = Xen_empty_list;~%")
+(hey " Xen val, ctype;~%")
(hey " int i, len = -1;~%")
-(hey " const char *ctype;~%")
-(hey " if (XEN_INTEGER_P(clen))~%")
-(hey " len = XEN_TO_C_INT(clen);~%")
-(hey " if (!(XEN_LIST_P(val_1))) return(XEN_FALSE); /* type:location cons */~%")
-(hey " val = XEN_COPY_ARG(val_1); /* protect Ruby arg */~%")
-(hey " ctype = XEN_SYMBOL_TO_C_STRING(XEN_CAR(val));~%")
+(hey " if (Xen_is_integer(clen))~%")
+(hey " len = Xen_integer_to_C_int(clen);~%")
+(hey " if (!(Xen_is_list(val_1))) return(Xen_false); /* type:location cons */~%")
+(hey " val = Xen_copy_arg(val_1); /* protect Ruby arg */~%")
+(hey " ctype = Xen_car(val);~%")
(for-each array->list listable-types)
(for-each
(lambda (type)
@@ -2813,39 +2405,55 @@
types)
;;; gotta handle GList* by hand
-(hey " if (strcmp(ctype, \"GList_\") == 0)~%")
+(hey " if (ctype == xg_GList__symbol)~%")
(hey " { /* tagging these pointers is currently up to the caller */~%")
(hey " GList* lst;~%")
-(hey " lst = (GList*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));~%")
+(hey " lst = (GList*)Xen_unwrap_C_pointer(Xen_cadr(val));~%")
(hey " len = g_list_length(lst);~%")
-(hey " for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_ULONG(g_list_nth_data(lst, i)), result);~%")
+(hey " for (i = len - 1; i >= 0; i--) result = Xen_cons(C_ulong_to_Xen_ulong(g_list_nth_data(lst, i)), result);~%")
(hey " }~%")
(hey " return(result);~%")
(hey "}~%~%")
-(hey "static XEN xg_object_get(XEN val, XEN name, XEN string_type)~%")
+(hey "static Xen xg_object_get(Xen val, Xen name, Xen string_type)~%")
(hey "{~%")
(hey " gint temp; gchar *str;~%")
-(hey " XEN_ASSERT_TYPE(XEN_gpointer_P(val), val, 1, \"g_object_get\", \"gpointer\");~%")
-(hey " XEN_ASSERT_TYPE(XEN_STRING_P(name), name, 2, \"g_object_get\", \"string\");~%")
-(hey " if (XEN_FALSE_P(string_type))~%")
-(hey " {g_object_get(XEN_TO_C_gpointer(val), (const gchar *)(XEN_TO_C_STRING(name)), &temp, NULL); return(C_TO_XEN_INT(temp));}~%")
-(hey " else {g_object_get(XEN_TO_C_gpointer(val), (const gchar *)(XEN_TO_C_STRING(name)), &str, NULL); return(C_TO_XEN_STRING(str));}~%")
+(hey " Xen_check_type(Xen_is_gpointer(val), val, 1, \"g_object_get\", \"gpointer\");~%")
+(hey " Xen_check_type(Xen_is_string(name), name, 2, \"g_object_get\", \"string\");~%")
+(hey " if (Xen_is_false(string_type))~%")
+(hey " {g_object_get(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), &temp, NULL); return(C_int_to_Xen_integer(temp));}~%")
+(hey " else {g_object_get(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), &str, NULL); return(C_string_to_Xen_string(str));}~%")
+(hey "}~%~%")
+
+;;; (g_object_get (GPOINTER (gtk_settings_get_default)) "gtk-enable-tooltips" #f)
+
+(hey "static Xen xg_object_set(Xen val, Xen name, Xen new_val)~%")
+(hey "{~%")
+(hey " Xen_check_type(Xen_is_gpointer(val), val, 1, \"g_object_set\", \"gpointer\");~%")
+(hey " Xen_check_type(Xen_is_string(name), name, 2, \"g_object_set\", \"string\");~%")
+(hey " if (Xen_is_boolean(new_val))~%")
+(hey " g_object_set(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), Xen_boolean_to_C_bool(new_val), NULL);~%")
+(hey " else~%")
+(hey " {~%")
+(hey " if (Xen_is_number(new_val))~%")
+(hey " g_object_set(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), Xen_integer_to_C_int(new_val), NULL);~%")
+(hey " else g_object_set(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), Xen_string_to_C_string(new_val), NULL);~%")
+(hey " }~%")
+(hey " return(new_val);~%")
(hey "}~%~%")
-(hey "static XEN xg_gtk_event_keyval(XEN event)~%")
+(hey "static Xen xg_gtk_event_keyval(Xen event)~%")
(hey "{~%")
(hey " GdkEventKey *e;~%")
-(hey " e = XEN_TO_C_GdkEventKey_(event);~%")
-(hey " return(C_TO_XEN_INT((int)(e->keyval)));~%")
+(hey " e = Xen_to_C_GdkEventKey_(event);~%")
+(hey " if (e) return(C_int_to_Xen_integer((int)(e->keyval))); return(XEN_ZERO);~%")
(hey "}~%~%")
-(hey "static XEN xen_list_to_c_array(XEN val, XEN type)~%")
+(hey "static Xen xen_list_to_c_array(Xen val, Xen type)~%")
(hey "{~%")
(hey " int i, len;~%")
-(hey " const char *ctype;~%")
-(hey " len = XEN_LIST_LENGTH(val);~%")
-(hey " ctype = XEN_TO_C_STRING(type);~%")
+(hey " len = Xen_list_length(val);~%")
+
(for-each list->array listable-types)
(for-each
(lambda (type)
@@ -2856,388 +2464,330 @@
(member (deref-type (list type)) types))
(list->array type)))
types)
-(hey " return(XEN_FALSE);~%")
-(hey "}~%~%")
-
-(define (make-reader field)
- ;; gather structs that share field
- ;; if 1 or 2 assert type, if and return,
- ;; else if on each, assert 0 at end and xen false
- (hey "~%")
- (hey "static XEN gxg_~A(XEN ptr)~%" field)
- (hey "{~%")
- (let ((vals '()))
- (for-each
- (lambda (struct)
- (let ((strs (cadr struct)))
- ;; cadr of each inner list is field name, car is field type
- (for-each
- (lambda (str)
- (if (string=? (cadr str) field)
- (set! vals (cons (list (car struct) (car str)) vals))))
- strs)))
- structs)
- ;; now vals is list of (struct-type field-type)
- (if (null? vals)
- (hey "~A: not found" field)
- (begin
- (if (= (length vals) 1)
- (hey " XEN_ASSERT_TYPE(XEN_~A__P(ptr), ptr, XEN_ONLY_ARG, ~S, ~S);~%"
- (caar vals) field
- (caar vals))
- (if (= (length vals) 2)
- (hey " XEN_ASSERT_TYPE(XEN_~A__P(ptr) || XEN_~A__P(ptr), ptr, XEN_ONLY_ARG, ~S, ~S \" or \" ~S);~%"
- (caar vals) (car (cadr vals)) field
- (caar vals) (car (cadr vals)))))))
- (let ((ctr 0))
- (for-each
- (lambda (val)
- (if (or (> (length vals) 2)
- (and (= (length vals) 2)
- (= ctr 0)))
- (hey " if (XEN_~A__P(ptr)) " (car val))
- (heyc " "))
- (set! ctr (+ ctr 1))
- (hey "return(C_TO_XEN_~A((~A)((XEN_TO_C_~A_(ptr))->~A)));~%"
- (no-stars (cadr val)) (cadr val) (car val) field))
- vals))
- (if (> (length vals) 2)
- (hey " XEN_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, ~S, \"pointer to struct with ~A field\");~% return(XEN_FALSE);~%"
- field field))
- (hey "}~%")
- ))
-
-(define (make-writer field)
- (hey "~%")
- (hey "static XEN gxg_set_~A(XEN ptr, XEN val)~%" field)
- (hey "{~%")
- (let ((vals '()))
- (for-each
- (lambda (struct)
- (let ((strs (cadr struct)))
- ;; cadr of each inner list is field name, car is field type
- (for-each
- (lambda (str)
- (if (string=? (cadr str) field)
- (set! vals (cons (list (car struct) (car str)) vals))))
- strs)))
- structs)
- (if (null? vals)
- (display (format #f "(writer) ~A: not found" field))
- (begin
- (if (= (length vals) 1)
- (hey " XEN_ASSERT_TYPE(XEN_~A__P(ptr), ptr, XEN_ARG_1, ~S, ~S);~%"
- (caar vals) field
- (caar vals))
- (if (= (length vals) 2)
- (hey " XEN_ASSERT_TYPE(XEN_~A__P(ptr) || XEN_~A__P(ptr), ptr, XEN_ARG_1, ~S, ~S \" or \" ~S);~%"
- (caar vals) (car (cadr vals)) field
- (caar vals) (car (cadr vals)))))))
- (let ((ctr 0))
- (for-each
- (lambda (val)
- (if (or (> (length vals) 2)
- (and (= (length vals) 2)
- (= ctr 0)))
- (hey " if (XEN_~A__P(ptr)) " (car val))
- (heyc " "))
- (set! ctr (+ ctr 1))
- (hey "(XEN_TO_C_~A_(ptr))->~A = XEN_TO_C_~A(val);~%"
- (car val) field (no-stars (cadr val))))
- vals))
- (if (> (length vals) 2)
- (hey " XEN_ASSERT_TYPE(0, ptr, XEN_ARG_1, \"set! ~A\", \"pointer to struct with ~A field\");~% return(XEN_FALSE);~%"
- field field))
- (hey " return(val);~%}~%")
- ))
+(hey " return(Xen_false);~%")
+(hey "}~%")
-(for-each make-reader (reverse struct-fields))
-(for-each make-reader (reverse settable-struct-fields))
-(for-each make-writer (reverse settable-struct-fields))
-
-(define (define-struct name)
- (let* ((struct (find-struct name))
- (strs (cadr struct)))
- ;; cadr of each inner list is field name, car is field type
- (if (= (length strs) 0)
- (begin
- (hey "static XEN gxg_make_~A(void)~%" name)
- (hey "{~%")
- (hey " ~A* result;~%" name)
- (hey " result = (~A*)calloc(1, sizeof(~A));~%" name name)
- (hey " return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL(~S), XEN_WRAP_C_POINTER(result), make_xm_obj(result)));~%"
- (string-append name "_"))
- (hey "}~%~%"))
- (begin
- (hey "static XEN gxg_make_~A(XEN arglist)~%" name)
- (hey "{~%")
- (hey " ~A* result;~%" name)
- (hey " int i, len;~%")
- (hey " result = (~A*)calloc(1, sizeof(~A));~%" name name)
- (hey " len = XEN_LIST_LENGTH(arglist);~%")
- (hey " for (i = 0; i < len; i++)~%")
- (hey " switch (i)~%")
- (hey " {~%")
- (let ((ctr 0))
- (for-each
- (lambda (str)
- (let ((field-name (cadr str))
- (field-type (car str)))
- (hey " case ~D: result->~A = XEN_TO_C_~A(XEN_LIST_REF(arglist, ~D));~%"
- ctr field-name (no-stars field-type) ctr)
- (set! ctr (+ ctr 1))))
- strs))
- (hey " }~%")
- (hey " return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL(~S), XEN_WRAP_C_POINTER(result), make_xm_obj(result)));~%"
- (string-append name "_"))
- (hey "}~%~%")))))
-(for-each define-struct (reverse make-structs))
-(if (not (null? cairo-make-structs))
- (with-cairo hey
- (lambda ()
- (for-each define-struct (reverse cairo-make-structs)))))
+(hey "static Xen gxg_make_GtkTextIter(void)~%")
+(hey "{~%")
+(hey " GtkTextIter* result;~%")
+(hey " result = (GtkTextIter*)calloc(1, sizeof(GtkTextIter));~%")
+(hey " return(Xen_list_3(C_string_to_Xen_symbol(\"GtkTextIter_\"), Xen_wrap_C_pointer(result), make_xm_obj(result)));~%")
+(hey "}~%")
+(hey "~%")
+(hey "static Xen gxg_make_GtkTreeIter(void)~%")
+(hey "{~%")
+(hey " GtkTreeIter* result;~%")
+(hey " result = (GtkTreeIter*)calloc(1, sizeof(GtkTreeIter));~%")
+(hey " return(Xen_list_3(C_string_to_Xen_symbol(\"GtkTreeIter_\"), Xen_wrap_C_pointer(result), make_xm_obj(result)));~%")
+(hey "}~%")
+(hey "~%")
+(hey "static Xen gxg_make_PangoRectangle(void)~%")
+(hey "{~%")
+(hey " PangoRectangle* result;~%")
+(hey " result = (PangoRectangle*)calloc(1, sizeof(PangoRectangle));~%")
+(hey " return(Xen_list_3(C_string_to_Xen_symbol(\"PangoRectangle_\"), Xen_wrap_C_pointer(result), make_xm_obj(result)));~%")
+(hey "}~%")
+(hey "~%")
+(hey "static Xen gxg_make_cairo_matrix_t(void)~%")
+(hey "{~%")
+(hey " cairo_matrix_t* result;~%")
+(hey " result = (cairo_matrix_t*)calloc(1, sizeof(cairo_matrix_t));~%")
+(hey " return(Xen_list_3(C_string_to_Xen_symbol(\"cairo_matrix_t_\"), Xen_wrap_C_pointer(result), make_xm_obj(result)));~%")
+(hey "}~%~%")
+(hey "#if GTK_CHECK_VERSION(3, 0, 0)~%")
+(hey "static Xen gxg_make_GdkRGBA(void)~%")
+(hey "{~%")
+(hey " GdkRGBA* result;~%")
+(hey " result = (GdkRGBA*)calloc(1, sizeof(GdkRGBA));~%")
+(hey " return(Xen_list_3(C_string_to_Xen_symbol(\"GdkRGBA_\"), Xen_wrap_C_pointer(result), make_xm_obj(result)));~%")
+(hey "}~%")
+(hey "#endif~%~%")
-(with-300 hey (lambda ()
- (for-each define-struct (reverse make-structs-300))))
+(hey "#if HAVE_SCHEME~%")
+(hey " #define Xg_define_procedure(Name, Value, A1, A2, A3, Help, Sig) s7_define_typed_function(s7, Xg_pre #Name Xg_post, Value, A1, A2, A3, Help, Sig)~%")
+(hey "#else~%")
+(hey " #define Xg_define_procedure(Name, Value, A1, A2, A3, Help, Sig) Xen_define_safe_procedure(Xg_pre #Name Xg_post, Value, A1, A2, A3, Help)~%")
+(hey "#endif~%")
+(hey "~%")
+(hey "Xen_wrap_no_args(gxg_make_GtkTextIter_w, gxg_make_GtkTextIter)~%")
+(hey "Xen_wrap_no_args(gxg_make_GtkTreeIter_w, gxg_make_GtkTreeIter)~%")
+(hey "Xen_wrap_no_args(gxg_make_PangoRectangle_w, gxg_make_PangoRectangle)~%")
+(hey "Xen_wrap_no_args(gxg_make_cairo_matrix_t_w, gxg_make_cairo_matrix_t)~%")
+(hey "#if GTK_CHECK_VERSION(3, 0, 0)~%")
+(hey "Xen_wrap_no_args(gxg_make_GdkRGBA_w, gxg_make_GdkRGBA)~%")
+(hey "#endif~%")
+(hey "~%~%")
+(hey "static void define_structs(void)~%")
+(hey "{~%")
+(hey " Xg_define_procedure(GtkTextIter, gxg_make_GtkTextIter_w, 0, 0, 0, \"(GtkTextIter): a new GtkTextIter struct\", NULL);~%")
+(hey " Xg_define_procedure(GtkTreeIter, gxg_make_GtkTreeIter_w, 0, 0, 0, \"(GtkTreeIter): a new GtkTreeIter struct\", NULL);~%")
+(hey " Xg_define_procedure(PangoRectangle, gxg_make_PangoRectangle_w, 0, 0, 0, \"(PangoRectangle): a new PangoRectangle struct\", NULL);~%")
+(hey " Xg_define_procedure(cairo_matrix_t, gxg_make_cairo_matrix_t_w, 0, 0, 0, \"(cairo_matrix_t): a new cairo_matrix_t struct\", NULL);~%")
+(hey "#if GTK_CHECK_VERSION(3, 0, 0)~%")
+(hey " Xg_define_procedure(GdkRGBA, gxg_make_GdkRGBA_w, 0, 0, 0, \"(GdkRGBA): a new GdkRGBA struct\", NULL);~%")
+(hey "#endif~%")
+(hey "}~%~%")
+
;;; ---------------- argify ----------------
(define (argify-func func)
- (let* ((cargs (length (caddr func)))
+ (let ((cargs (length (caddr func)))
(refargs (+ (ref-args (caddr func)) (opt-args (caddr func))))
- (args (- cargs refargs)))
- (hey "XEN_~A(gxg_~A_w, gxg_~A)~%"
- (if (>= cargs 10) "VARGIFY"
+ ;(args (- cargs refargs))
+ )
+ (hey "Xen_wrap_~A(gxg_~A_w, gxg_~A)~%"
+ (if (>= cargs max-args)
+ "any_args"
(if (> refargs 0)
- (format #f "ARGIFY_~D" cargs)
- (format #f "NARGIFY_~D" cargs)))
+ (format #f "~D_optional_arg~A" cargs (if (= cargs 1) "" "s"))
+ (format #f "~A_arg~A" (if (zero? cargs) "no" (number->string cargs)) (if (= cargs 1) "" "s"))))
(car func) (car func))))
(define (unargify-func func)
- (let* ((cargs (length (caddr func)))
- (refargs (+ (ref-args (caddr func)) (opt-args (caddr func))))
- (args (- cargs refargs)))
+ (let (;(cargs (length (caddr func)))
+ ;(refargs (+ (ref-args (caddr func)) (opt-args (caddr func))))
+ ;(args (- cargs refargs))
+ )
(hey "#define gxg_~A_w gxg_~A~%"
(car func) (car func))))
-(hey "~%#ifdef XEN_ARGIFY_1~%")
-
(for-each argify-func (reverse funcs))
(for-each
(lambda (func-list with-func)
- (if (not (null? func-list))
+ (if (pair? func-list)
(with-func hey (lambda ()
(for-each argify-func (reverse func-list))))))
all-funcs all-func-withs)
-(hey "XEN_NARGIFY_1(gxg_GPOINTER_w, gxg_GPOINTER)~%")
-(hey "XEN_NARGIFY_2(c_array_to_xen_list_w, c_array_to_xen_list)~%")
-(hey "XEN_NARGIFY_2(xen_list_to_c_array_w, xen_list_to_c_array)~%")
-(hey "XEN_NARGIFY_1(gxg_make_target_entry_w, gxg_make_target_entry)~%")
-(hey "XEN_NARGIFY_1(c_to_xen_string_w, c_to_xen_string)~%")
-(hey "XEN_NARGIFY_3(xg_object_get_w, xg_object_get)~%")
-(hey "XEN_NARGIFY_1(xg_gtk_event_keyval_w, xg_gtk_event_keyval)~%")
+(hey "Xen_wrap_1_arg(gxg_GPOINTER_w, gxg_GPOINTER)~%")
+(hey "Xen_wrap_2_args(c_array_to_xen_list_w, c_array_to_xen_list)~%")
+(hey "Xen_wrap_2_args(xen_list_to_c_array_w, xen_list_to_c_array)~%")
+(hey "Xen_wrap_1_arg(gxg_make_target_entry_w, gxg_make_target_entry)~%")
+(hey "Xen_wrap_3_args(xg_object_get_w, xg_object_get)~%")
+(hey "Xen_wrap_3_args(xg_object_set_w, xg_object_set)~%")
+(hey "Xen_wrap_1_arg(xg_gtk_event_keyval_w, xg_gtk_event_keyval)~%")
-(hey "XEN_ARGIFY_2(gxg_gtk_init_w, gxg_gtk_init)~%")
-(hey "XEN_ARGIFY_2(gxg_gtk_init_check_w, gxg_gtk_init_check)~%")
+(hey "Xen_wrap_2_optional_args(gxg_gtk_init_w, gxg_gtk_init)~%")
+(hey "Xen_wrap_2_optional_args(gxg_gtk_init_check_w, gxg_gtk_init_check)~%")
-(define (ruby-cast func) (hey "XEN_NARGIFY_1(gxg_~A_w, gxg_~A)~%" (no-arg (car func)) (no-arg (car func))))
+(define (ruby-cast func) (hey "Xen_wrap_1_arg(gxg_~A_w, gxg_~A)~%" (no-arg (car func)) (no-arg (car func))))
(for-each ruby-cast (reverse casts))
(for-each
(lambda (cast-list cast-func)
- (if (not (null? cast-list))
+ (if (pair? cast-list)
(cast-func hey (lambda ()
(for-each ruby-cast (reverse cast-list))))))
all-casts all-cast-withs)
-(define (ruby-check func) (hey "XEN_NARGIFY_1(gxg_~A_w, gxg_~A)~%" (no-arg (car func)) (no-arg (car func))))
+(define (ruby-check func) (hey "Xen_wrap_1_arg(gxg_~A_w, gxg_~A)~%" (no-arg (car func)) (no-arg (car func))))
(for-each ruby-check (reverse checks))
(for-each
(lambda (check-list check-func)
- (if (not (null? check-list))
+ (if (pair? check-list)
(check-func hey (lambda ()
(for-each ruby-check (reverse check-list))))))
all-checks all-check-withs)
-(for-each (lambda (field) (hey "XEN_NARGIFY_1(gxg_~A_w, gxg_~A)~%" field field)) struct-fields)
-(for-each (lambda (field) (hey "XEN_NARGIFY_1(gxg_~A_w, gxg_~A)~%" field field)) settable-struct-fields)
-(for-each (lambda (field) (hey "XEN_NARGIFY_2(gxg_set_~A_w, gxg_set_~A)~%" field field)) settable-struct-fields)
-
-(for-each (lambda (struct)
- (let* ((s (find-struct struct)))
- (if (> (length (cadr s)) 0)
- (hey "XEN_VARGIFY(gxg_make_~A_w, gxg_make_~A)~%" struct struct)
- (hey "XEN_NARGIFY_0(gxg_make_~A_w, gxg_make_~A)~%" struct struct))))
- (reverse make-structs))
-(hey "~%")
-
-(with-cairo hey
- (lambda ()
- (for-each
- (lambda (struct)
- (let* ((s (find-struct struct)))
- (if (> (length (cadr s)) 0)
- (hey "XEN_VARGIFY(gxg_make_~A_w, gxg_make_~A)~%" struct struct)
- (hey "XEN_NARGIFY_0(gxg_make_~A_w, gxg_make_~A)~%" struct struct))))
- (reverse cairo-make-structs))))
-(hey "~%")
-
-(with-300 hey (lambda ()
- (for-each (lambda (struct)
- (let* ((s (find-struct struct)))
- (if (> (length (cadr s)) 0)
- (hey "XEN_VARGIFY(gxg_make_~A_w, gxg_make_~A)~%" struct struct)
- (hey "XEN_NARGIFY_0(gxg_make_~A_w, gxg_make_~A)~%" struct struct))))
- (reverse make-structs-300))
- (hey "~%")))
-
-
-(hey "~%#else~%")
-(hey "/* not XEN_ARGIFY_1 */~%")
-
-(for-each unargify-func (reverse funcs))
-(for-each
- (lambda (func-list with-func)
- (if (not (null? func-list))
- (with-func hey (lambda ()
- (for-each unargify-func (reverse func-list))))))
- all-funcs all-func-withs)
-
-
-(hey "#define gxg_GPOINTER_w gxg_GPOINTER~%")
-(hey "#define c_array_to_xen_list_w c_array_to_xen_list~%")
-(hey "#define xen_list_to_c_array_w xen_list_to_c_array~%")
-(hey "#define gxg_make_target_entry_w gxg_make_target_entry~%")
-(hey "#define c_to_xen_string_w c_to_xen_string~%")
-(hey "#define xg_object_get_w xg_object_get~%")
-(hey "#define xg_gtk_event_keyval_w xg_gtk_event_keyval~%")
-
-(hey "#define gxg_gtk_init_w gxg_gtk_init~%")
-(hey "#define gxg_gtk_init_check_w gxg_gtk_init_check~%")
-
-(define (ruby-uncast func) (hey "#define gxg_~A_w gxg_~A~%" (no-arg (car func)) (no-arg (car func))))
-(for-each ruby-uncast (reverse casts))
-(for-each
- (lambda (cast-list cast-func)
- (if (not (null? cast-list))
- (cast-func hey (lambda ()
- (for-each ruby-uncast (reverse cast-list))))))
- all-casts all-cast-withs)
-
+;;; --------------------------------------------------------------------------------
+(hey "#if HAVE_SCHEME~%")
-(define (ruby-uncheck func) (hey "#define gxg_~A_w gxg_~A~%" (no-arg (car func)) (no-arg (car func))))
-(for-each ruby-uncheck (reverse checks))
+(define (gtk-type->s7-type gtk)
+ (let ((dt (assoc gtk direct-types)))
+ (if (and (pair? dt)
+ (string? (cdr dt)))
+ (let ((direct (cdr dt)))
+ (cond ((member direct '("INT" "ULONG") string=?) 'integer?)
+ ((string=? direct "BOOLEAN") 'boolean?)
+ ((string=? direct "DOUBLE") 'real?)
+ ((string=? direct "String") 'string?)
+ (#t #t)))
+ (or (not (has-stars gtk)) 'pair?))))
+
+(define (make-signature fnc)
+ (define (compress sig)
+ (if (and (pair? sig)
+ (pair? (cdr sig))
+ (or (not (eq? (car sig) 'pair?))
+ (not (null? (cddr sig))))
+ (eq? (car sig) (cadr sig)))
+ (compress (cdr sig))
+ sig))
+ (let ((sig (list (gtk-type->s7-type (cadr fnc)))))
+ (for-each
+ (lambda (arg)
+ (set! sig (cons (gtk-type->s7-type (car arg)) sig)))
+ (caddr fnc))
+ (reverse (compress sig))))
+
+(define signatures (make-hash-table))
+(define (make-signatures lst)
+ (for-each
+ (lambda (f)
+ (let ((sig (make-signature f)))
+ (if (pair? sig)
+ (let ((count (signatures sig)))
+ (if (not count)
+ (set! (signatures sig) 0)
+ (set! (signatures sig) (+ count 1)))))))
+ lst))
+
+(make-signatures funcs)
+(for-each make-signatures all-funcs)
+
+;(format *stderr* "~D entries, ~D funcs~%" (hash-table-entries signatures) (length funcs))
+
+(hey "static s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_pair_false;~%")
+(hey "static s7_pointer ")
+
+(define (sig-name sig)
+ (call-with-output-string
+ (lambda (p)
+ (display "pl_" p)
+ (display (case (car sig)
+ ((integer?) "i")
+ ((boolean?) "b")
+ ((real?) "d")
+ ((string?) "s")
+ ((pair?) "p")
+ (else "t"))
+ p)
+ (for-each
+ (lambda (typ)
+ (display (case typ
+ ((integer?) "i")
+ ((boolean?) "b")
+ ((real?) "r")
+ ((string?) "s")
+ ((pair?) "u") ; because we're stupidly using #f=null
+ (else "t"))
+ p))
+ (cdr sig)))))
+
(for-each
- (lambda (check-list check-func)
- (if (not (null? check-list))
- (check-func hey (lambda ()
- (for-each ruby-uncheck (reverse check-list))))))
- all-checks all-check-withs)
-
-(for-each (lambda (field) (hey "#define gxg_~A_w gxg_~A~%" field field)) struct-fields)
-(for-each (lambda (field) (hey "#define gxg_~A_w gxg_~A~%" field field)) settable-struct-fields)
-(for-each (lambda (field) (hey "#define gxg_set_~A_w gxg_set_~A~%" field field)) settable-struct-fields)
-
-(for-each (lambda (struct)
- (let* ((s (find-struct struct)))
- (if (> (length (cadr s)) 0)
- (hey "#define gxg_make_~A_w gxg_make_~A~%" struct struct)
- (hey "#define gxg_make_~A_w gxg_make_~A~%" struct struct))))
- (reverse make-structs))
-(hey "~%")
-
-(if (not (null? cairo-make-structs))
- (with-cairo hey
- (lambda ()
- (for-each
- (lambda (struct)
- (let* ((s (find-struct struct)))
- (if (> (length (cadr s)) 0)
- (hey "#define gxg_make_~A_w gxg_make_~A~%" struct struct)
- (hey "#define gxg_make_~A_w gxg_make_~A~%" struct struct))))
- (reverse cairo-make-structs)))))
-(hey "~%")
-
-(with-300 hey (lambda ()
- (for-each (lambda (struct)
- (let* ((s (find-struct struct)))
- (if (> (length (cadr s)) 0)
- (hey "#define gxg_make_~A_w gxg_make_~A~%" struct struct)
- (hey "#define gxg_make_~A_w gxg_make_~A~%" struct struct))))
- (reverse make-structs-300))
- (hey "~%")))
-
-
-
-(hey "~%#endif~%")
+ (lambda (sigc)
+ (let ((sig (car sigc)))
+ (hey (sig-name sig))
+ (hey ", ")))
+ signatures)
+(hey "pl_unused;~%")
+(hey "#endif~%~%")
;;; --------------------------------------------------------------------------------
-(hey " #define XG_DEFINE_PROCEDURE(Name, Value, A1, A2, A3, Help) XEN_DEFINE_PROCEDURE(XG_PRE #Name XG_POST, Value, A1, A2, A3, Help)~%")
-
(hey "static void define_functions(void)~%")
(hey "{~%")
-(hey " xm_gc_table = XEN_MAKE_VECTOR(1, XEN_FALSE);~%")
-(hey " XEN_PROTECT_FROM_GC(xm_gc_table);~%")
+(hey " xm_gc_table = Xen_make_vector(1, Xen_false);~%")
+(hey " Xen_GC_protect(xm_gc_table);~%")
(hey " xm_protected_size = 512;~%")
-(hey " xm_protected = XEN_MAKE_VECTOR(xm_protected_size, XEN_FALSE);~%")
-(hey " XEN_VECTOR_SET(xm_gc_table, 0, xm_protected);~%")
+(hey " xm_protected = Xen_make_vector(xm_protected_size, Xen_false);~%")
+(hey " Xen_vector_set(xm_gc_table, 0, xm_protected);~%~%")
+
+(hey "#if HAVE_SCHEME~%")
+(hey " s_boolean = s7_make_symbol(s7, \"boolean?\");~%")
+(hey " s_integer = s7_make_symbol(s7, \"integer?\");~%")
+(hey " s_real = s7_make_symbol(s7, \"real?\");~%")
+(hey " s_float = s7_make_symbol(s7, \"float?\");~%")
+(hey " s_string = s7_make_symbol(s7, \"string?\");~%")
+(hey " s_pair = s7_make_symbol(s7, \"pair?\");~%")
+(hey " s_pair_false = s7_make_signature(s7, 2, s_pair, s_boolean);~%")
+(hey " s_any = s7_t(s7);~%~%")
+
+(for-each
+ (lambda (sigc)
+ (let ((sig (car sigc)))
+ (hey " ")
+ (hey (sig-name sig))
+ (hey " = s7_make_circular_signature(s7, ")
+ (let ((len (length sig)))
+ (hey (number->string (- len 1)))
+ (hey ", ")
+ (hey (number->string len))
+ (hey ", ")
+ (hey (case (car sig)
+ ((integer?) "s_integer")
+ ((boolean?) "s_boolean")
+ ((real?) "s_float")
+ ((string?) "s_string")
+ ((pair?) "s_pair")
+ (else "s_any")))
+ (if (> len 1) (hey ", "))
+ (do ((i 1 (+ i 1))
+ (s (cdr sig) (cdr s)))
+ ((= i len))
+ (let ((typ (car s)))
+ (hey (case typ
+ ((integer?) "s_integer")
+ ((boolean?) "s_boolean")
+ ((real?) "s_real")
+ ((string?) "s_string")
+ ((pair?) "s_pair_false")
+ (else "s_any"))))
+ (if (< i (- len 1)) (hey ", "))))
+ (hey ");~%")))
+ signatures)
+(hey "pl_unused = NULL;~%")
+(hey "#endif~%~%")
(define (defun func)
(let* ((cargs (length (caddr func)))
(refargs (+ (ref-args (caddr func)) (opt-args (caddr func))))
- (args (- cargs refargs)))
-
- (hey " XG_DEFINE_PROCEDURE(~A, gxg_~A_w, ~D, ~D, ~D, H_~A);~%"
+ (args (- cargs refargs))
+ ;(return-type (cadr func))
+ ;(typ (assoc return-type direct-types))
+ )
+ (hey " Xg_define_procedure(~A, gxg_~A_w, ~D, ~D, ~D, H_~A, ~A);~%"
(car func) (car func)
- (if (>= cargs 10) 0 args)
- (if (>= cargs 10) 0 refargs)
- (if (>= cargs 10) 1 0)
- (car func))))
+ (if (>= cargs max-args) 0 args)
+ (if (>= cargs max-args) 0 refargs)
+ (if (>= cargs max-args) 1 0)
+ (car func)
+ (sig-name (make-signature func)))))
+
(for-each defun (reverse funcs))
(for-each
(lambda (func-list with-func)
- (if (not (null? func-list))
+ (if (pair? func-list)
(with-func hey (lambda ()
(for-each defun (reverse func-list))))))
all-funcs all-func-withs)
(define (cast-out func)
- (hey " XG_DEFINE_PROCEDURE(~A, gxg_~A_w, 1, 0, 0, \"(~A obj) casts obj to ~A\");~%"
+ (hey " Xg_define_procedure(~A, gxg_~A_w, 1, 0, 0, \"(~A obj) casts obj to ~A\", NULL);~%"
(no-arg (car func))
(no-arg (car func))
(no-arg (car func))
(no-arg (car func))))
-(hey " XG_DEFINE_PROCEDURE(GPOINTER, gxg_GPOINTER_w, 1, 0, 0, \"(GPOINTER obj) casts obj to GPOINTER\");~%")
+(hey " Xg_define_procedure(GPOINTER, gxg_GPOINTER_w, 1, 0, 0, \"(GPOINTER obj) casts obj to GPOINTER\", NULL);~%")
(for-each cast-out (reverse casts))
(for-each
(lambda (cast-list cast-func)
- (if (not (null? cast-list))
+ (if (pair? cast-list)
(cast-func hey (lambda ()
(for-each cast-out (reverse cast-list))))))
all-casts all-cast-withs)
-(hey " XG_DEFINE_PROCEDURE(c-array->list, c_array_to_xen_list_w, 2, 0, 0, NULL);~%")
-(hey " XG_DEFINE_PROCEDURE(list->c-array, xen_list_to_c_array_w, 2, 0, 0, NULL);~%")
-(hey " XG_DEFINE_PROCEDURE(->string, c_to_xen_string_w, 1, 0, 0, NULL);~%")
-(hey " XG_DEFINE_PROCEDURE(make-target-entry, gxg_make_target_entry_w, 1, 0, 0, H_make_target_entry);~%")
-(hey " XG_DEFINE_PROCEDURE(g_object_get, xg_object_get_w, 3, 0, 0, NULL);~%")
-(hey " XG_DEFINE_PROCEDURE(gtk_event_keyval, xg_gtk_event_keyval_w, 1, 0, 0, NULL);~%")
+(hey " Xg_define_procedure(c-array->list, c_array_to_xen_list_w, 2, 0, 0, NULL, NULL);~%")
+(hey " Xg_define_procedure(list->c-array, xen_list_to_c_array_w, 2, 0, 0, NULL, NULL);~%")
+(hey " Xg_define_procedure(make-target-entry, gxg_make_target_entry_w, 1, 0, 0, H_make_target_entry, NULL);~%")
+(hey " Xg_define_procedure(g_object_get, xg_object_get_w, 3, 0, 0, NULL, NULL);~%")
+(hey " Xg_define_procedure(g_object_set, xg_object_set_w, 3, 0, 0, NULL, NULL);~%")
+(hey " Xg_define_procedure(gtk_event_keyval, xg_gtk_event_keyval_w, 1, 0, 0, NULL, NULL);~%")
-(hey " XG_DEFINE_PROCEDURE(gtk_init, gxg_gtk_init_w, 0, 2, 0, H_gtk_init);~%")
-(hey " XG_DEFINE_PROCEDURE(gtk_init_check, gxg_gtk_init_check_w, 0, 2, 0, H_gtk_init_check);~%")
+(hey " Xg_define_procedure(gtk_init, gxg_gtk_init_w, 0, 2, 0, H_gtk_init, NULL);~%")
+(hey " Xg_define_procedure(gtk_init_check, gxg_gtk_init_check_w, 0, 2, 0, H_gtk_init_check, NULL);~%")
(define (check-out func)
- (hey " XG_DEFINE_PROCEDURE(~A, gxg_~A_w, 1, 0, 0, \"(~A obj): \" PROC_TRUE \" if obj is a ~A\");~%"
+ (hey " Xg_define_procedure(~A, gxg_~A_w, 1, 0, 0, \"(~A obj): \" PROC_TRUE \" if obj is a ~A\", NULL);~%"
(no-arg (car func))
(no-arg (car func))
(no-arg (car func))
@@ -3246,7 +2796,7 @@
(for-each check-out (reverse checks))
(for-each
(lambda (check-list check-func)
- (if (not (null? check-list))
+ (if (pair? check-list)
(check-func hey (lambda ()
(for-each check-out (reverse check-list))))))
all-checks all-check-withs)
@@ -3254,111 +2804,40 @@
(hey "}~%~%")
-(hey "static void define_structs(void)~%")
-(hey "{~%")
-
-(for-each (lambda (field) (hey " XG_DEFINE_READER(~A, gxg_~A_w, 1, 0, 0);~%" field field)) struct-fields)
-(for-each (lambda (field) (hey " XG_DEFINE_ACCESSOR(~A, gxg_~A_w, gxg_set_~A_w, 1, 0, 2, 0);~%" field field field)) settable-struct-fields)
-
-(for-each (lambda (struct)
- (let* ((s (find-struct struct)))
- (hey " XG_DEFINE_PROCEDURE(~A, gxg_make_~A_w, 0, 0, ~D, \"(~A~A): a new ~A struct\");~%"
- struct
- struct
- (if (> (length (cadr s)) 0) 1 0)
- struct
- (if (> (length (cadr s)) 0) " ..." "")
- struct)))
- (reverse make-structs))
-
-(if (not (null? cairo-make-structs))
- (with-cairo hey
- (lambda ()
- (for-each
- (lambda (struct)
- (let* ((s (find-struct struct)))
- (hey " XG_DEFINE_PROCEDURE(~A, gxg_make_~A_w, 0, 0, ~D, \"(~A~A): a new ~A struct\");~%"
- struct
- struct
- (if (> (length (cadr s)) 0) 1 0)
- struct
- (if (> (length (cadr s)) 0) " ..." "")
- struct)))
- (reverse cairo-make-structs)))))
-(with-300 hey (lambda ()
- (for-each (lambda (struct)
- (let* ((s (find-struct struct)))
- (hey " XG_DEFINE_PROCEDURE(~A, gxg_make_~A_w, 0, 0, ~D, \"(~A~A): a new ~A struct\");~%"
- struct
- struct
- (if (> (length (cadr s)) 0) 1 0)
- struct
- (if (> (length (cadr s)) 0) " ..." "")
- struct)))
- (reverse make-structs-300))))
-
-(hey "}~%~%")
-
-
(hey "/* ---------------------------------------- constants ---------------------------------------- */~%~%")
(hey "static void define_integers(void)~%")
(hey "{~%")
-(hey "#if HAVE_SCHEME~%")
-(hey " #define DEFINE_INTEGER(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, C_TO_XEN_INT(Name))~%")
-(hey " #define DEFINE_ULONG(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, C_TO_XEN_ULONG(Name))~%")
-(hey "#else~%")
-(hey " #define DEFINE_INTEGER(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_INT(Name))~%")
-(hey " #define DEFINE_ULONG(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_ULONG(Name))~%")
-(hey "#endif~%")
+(hey "#define define_integer(Name) Xen_define(Xg_pre #Name Xg_post, C_int_to_Xen_integer(Name))~%")
(hey "~%")
+(hey "#if !GLIB_CHECK_VERSION(2,35,0)~%")
(hey " g_type_init();~%")
+(hey "#endif~%")
(for-each
(lambda (val)
- (hey " DEFINE_INTEGER(~A);~%" val))
+ (hey " define_integer(~A);~%" val))
(reverse ints))
(for-each
(lambda (ints-list with-ints)
- (if (not (null? ints-list))
+ (if (pair? ints-list)
(with-ints hey (lambda ()
(for-each (lambda (val)
- (hey " DEFINE_INTEGER(~A);~%" val))
+ (hey " define_integer(~A);~%" val))
(reverse ints-list))))))
all-ints all-int-withs)
-
-(for-each
- (lambda (vals)
- (let ((val (car vals)))
- (hey " DEFINE_ULONG(~A);~%" val)))
- (reverse ulongs))
-
-(for-each
- (lambda (ulongs-list with-ulongs)
- (if (not (null? ulongs-list))
- (with-ulongs hey (lambda ()
- (for-each (lambda (vals)
- (let ((val (car vals)))
- (hey " DEFINE_ULONG(~A);~%" val)))
- (reverse ulongs-list))))))
- all-ulongs all-ulong-withs)
-
(hey "}~%~%")
(hey "static void define_doubles(void)~%")
(hey "{~%")
-(hey "#if HAVE_SCHEME~%")
-(hey " #define DEFINE_DOUBLE(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, C_TO_XEN_DOUBLE(Name))~%")
-(hey "#else~%")
-(hey " #define DEFINE_DOUBLE(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_DOUBLE(Name))~%")
-(hey "#endif~%")
+(hey "#define define_double(Name) Xen_define(Xg_pre #Name Xg_post, C_double_to_Xen_real(Name))~%")
(hey "~%")
(for-each
(lambda (val)
- (hey " DEFINE_DOUBLE(~A);~%" val))
+ (hey " define_double(~A);~%" val))
(reverse dbls))
(hey "}~%~%")
@@ -3367,38 +2846,46 @@
(hey "~%")
(hey "static void define_atoms(void)~%")
(hey "{~%")
-(hey "#if HAVE_SCHEME~%")
-(hey " #define DEFINE_ATOM(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, C_TO_XEN_GdkAtom(Name))~%")
-(hey "#else~%")
-(hey " #define DEFINE_ATOM(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_GdkAtom(Name))~%")
-(hey "#endif~%")
+(hey "#define define_atom(Name) Xen_define(Xg_pre #Name Xg_post, C_to_Xen_GdkAtom(Name))~%")
(hey "~%")
(for-each
(lambda (atom)
- (hey " DEFINE_ATOM(~A);~%" atom))
+ (hey " define_atom(~A);~%" atom))
(reverse atoms))
(hey "}~%~%")
+(hey "/* -------------------------------- symbols -------------------------------- */~%")
+(hey "~%")
+(hey "static void define_symbols(void)~%")
+(hey "{~%")
+
+(for-each
+ (lambda (typ)
+ (hey " xg_~A_symbol = C_string_to_Xen_symbol(\"~A\");~%" (no-stars typ) (no-stars typ)))
+ all-types)
+(for-each
+ (lambda (typ)
+ (hey " xg_~A_symbol = C_string_to_Xen_symbol(\"~A\");~%" typ typ))
+ other-types)
+(hey "}~%~%")
+
+
(hey "/* -------------------------------- strings -------------------------------- */~%")
(hey "~%")
(hey "static void define_strings(void)~%")
(hey "{~%")
(hey " ~%")
-(hey "#if HAVE_SCHEME~%")
-(hey " #define DEFINE_STRING(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, s7_make_permanent_string(Name))~%")
-(hey "#else~%")
-(hey " #define DEFINE_STRING(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_STRING(Name))~%")
-(hey "#endif~%")
+(hey "#define define_string(Name) Xen_define(Xg_pre #Name Xg_post, C_string_to_Xen_string(Name))~%")
-(for-each (lambda (str) (hey " DEFINE_STRING(~A);~%" str)) (reverse strings))
+(for-each (lambda (str) (hey " define_string(~A);~%" str)) (reverse strings))
(for-each
(lambda (strings-list with-strings)
- (if (not (null? strings-list))
+ (if (pair? strings-list)
(with-strings hey (lambda ()
(for-each (lambda (str)
- (hey " DEFINE_STRING(~A);~%" str))
+ (hey " define_string(~A);~%" str))
(reverse strings-list))))))
all-strings all-string-withs)
@@ -3411,31 +2898,43 @@
(hey "{~%")
(hey " if (!xg_already_inited)~%")
(hey " {~%")
+(hey " define_symbols();~%")
(hey " define_xm_obj();~%")
(hey " define_integers();~%")
(hey " define_doubles();~%")
(hey " define_functions();~%")
-(hey " define_structs();~%")
(hey " define_atoms();~%")
(hey " define_strings();~%")
-(hey " XEN_YES_WE_HAVE(\"xg\");~%")
-(hey " XEN_DEFINE(\"xg-version\", C_TO_XEN_STRING(\"~A\"));~%" (strftime "%d-%b-%y" (localtime (current-time))))
+(hey " define_structs();~%")
+(hey " Xen_provide_feature(\"xg\");~%")
+(hey " #if GTK_CHECK_VERSION(3, 0, 0)~%")
+(hey " Xen_provide_feature(\"gtk3\");~%")
+(hey " #else~%")
+(hey " Xen_provide_feature(\"gtk2\");~%")
+(hey " #endif~%")
+(hey " Xen_define(\"xg-version\", C_string_to_Xen_string(\"~A\"));~%" (strftime "%d-%b-%y" (localtime (current-time))))
(hey " xg_already_inited = true;~%")
(hey "#if HAVE_SCHEME~%")
+(hey "#if USE_SND~%")
(hey " /* these are macros in glib/gobject/gsignal.h, but we want the types handled in some convenient way in the extension language */~%")
-(hey " XEN_EVAL_C_STRING(\"(define (g_signal_connect obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (not (null? data)) (car data)) #f 0))\");~%")
-(hey " XEN_EVAL_C_STRING(\"(define (g_signal_connect_after obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (not (null? data)) (car data)) #f G_CONNECT_AFTER))\");~%")
-(hey " XEN_EVAL_C_STRING(\"(define (g_signal_connect_swapped obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (not (null? data)) (car data)) #f G_CONNECT_SWAPPED))\");~%")
+(hey " s7_define(s7, s7_nil(s7), s7_make_symbol(s7, \"g_signal_connect\"),\n Xen_eval_C_string(\"(lambda (obj name func . data)\\\n ((*gtk* 'g_signal_connect_data) ((*gtk* 'GPOINTER) obj) name func (and (pair? data) (car data)) #f 0))\"));~%")
+(hey " s7_define(s7, s7_nil(s7), s7_make_symbol(s7, \"g_signal_connect_after\"),\n Xen_eval_C_string(\"(lambda (obj name func . data)\\\n ((*gtk* 'g_signal_connect_data) ((*gtk* 'GPOINTER) obj) name func (and (pair? data) (car data)) #f (*gtk* 'G_CONNECT_AFTER)))\"));~%")
+(hey " s7_define(s7, s7_nil(s7), s7_make_symbol(s7, \"g_signal_connect_swapped\"),\n Xen_eval_C_string(\"(lambda (obj name func . data)\\\n ((*gtk* 'g_signal_connect_data) ((*gtk* 'GPOINTER) obj) name func (and (pair? data) (car data)) #f (*gtk* 'G_CONNECT_SWAPPED)))\"));~%")
+(hey "#else~%")
+(hey " Xen_eval_C_string(\"(define (g_signal_connect obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (pair? data) (car data)) #f 0))\");~%")
+(hey " Xen_eval_C_string(\"(define (g_signal_connect_after obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (pair? data) (car data)) #f G_CONNECT_AFTER))\");~%")
+(hey " Xen_eval_C_string(\"(define (g_signal_connect_swapped obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (pair? data) (car data)) #f G_CONNECT_SWAPPED))\");~%")
+(hey "#endif~%")
(hey "#endif~%")
(hey "#if HAVE_RUBY ~%")
-(hey " XEN_EVAL_C_STRING(\"def Rg_signal_connect(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, 0); end\"); ~%")
-(hey " XEN_EVAL_C_STRING(\"def Rg_signal_connect_after(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, RG_CONNECT_AFTER); end\"); ~%")
-(hey " XEN_EVAL_C_STRING(\"def Rg_signal_connect_swapped(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, RG_CONNECT_SWAPPED); end\"); ~%")
+(hey " Xen_eval_C_string(\"def Rg_signal_connect(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, 0); end\"); ~%")
+(hey " Xen_eval_C_string(\"def Rg_signal_connect_after(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, RG_CONNECT_AFTER); end\"); ~%")
+(hey " Xen_eval_C_string(\"def Rg_signal_connect_swapped(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, RG_CONNECT_SWAPPED); end\"); ~%")
(hey "#endif ~%")
(hey "#if HAVE_FORTH ~%")
-(hey " XEN_EVAL_C_STRING(\": Fg_signal_connect <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f 0 Fg_signal_connect_data ;\"); ~%")
-(hey " XEN_EVAL_C_STRING(\": Fg_signal_connect_after <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f FG_CONNECT_AFTER Fg_signal_connect_data ;\"); ~%")
-(hey " XEN_EVAL_C_STRING(\": Fg_signal_connect_swapped <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f FG_CONNECT_SWAPPED Fg_signal_connect_data ;\"); ~%")
+(hey " Xen_eval_C_string(\": Fg_signal_connect <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f 0 Fg_signal_connect_data ;\"); ~%")
+(hey " Xen_eval_C_string(\": Fg_signal_connect_after <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f FG_CONNECT_AFTER Fg_signal_connect_data ;\"); ~%")
+(hey " Xen_eval_C_string(\": Fg_signal_connect_swapped <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f FG_CONNECT_SWAPPED Fg_signal_connect_data ;\"); ~%")
(hey "#endif ~%")
(hey " }~%")
(hey "}~%")
@@ -3448,18 +2947,18 @@
(close-output-port xg-file)
-#!
+#|
(for-each
(lambda (type)
(if (not (assoc type direct-types))
- (display (format #f ";not direct: ~A~%" type))))
+ (format #t ";not direct: ~A~%" type)))
declared-types)
(for-each
(lambda (v)
(if (not (member (car v) declared-types))
- (display (format #f "~A " (car v)))))
+ (format #t "~A " (car v))))
direct-types)
-!#
+|#
(exit)
diff --git a/tools/profile.h b/tools/profile.h
new file mode 100644
index 0000000..a054ff8
--- /dev/null
+++ b/tools/profile.h
@@ -0,0 +1,218 @@
+#if 0
+#if 1
+#define NUM_COUNTS 65536
+static int counts[NUM_COUNTS];
+static void clear_counts(void) {int i; for (i = 0; i < NUM_COUNTS; i++) counts[i] = 0;}
+void tick(int this) {counts[this]++;}
+static void report_counts(s7_scheme *sc)
+{
+ int i, mx, mxi, total = 0;
+ bool happy = true;
+
+ for (i = 0; i < NUM_COUNTS; i++)
+ total += counts[i];
+
+ fprintf(stderr, "total: %d\n", total);
+ while (happy)
+ {
+ mx = 0;
+ for (i = 0; i < NUM_COUNTS; i++)
+ {
+ if (counts[i] > mx)
+ {
+ mx = counts[i];
+ mxi = i;
+ }
+ }
+ if (mx > 0)
+ {
+ /* if (mx > total/100) */
+ fprintf(stderr, "%d: %d (%f)\n", mxi, mx, 100.0*mx/(float)total);
+ counts[mxi] = 0;
+ }
+ else happy = false;
+ }
+}
+#else
+
+#if 1
+#define NUM_COUNTS 500
+static int counts[70000][NUM_COUNTS];
+static void clear_counts(void) {int i, j; for (i = 0; i < NUM_COUNTS; i++) for (j = 0; j < NUM_COUNTS; j++) counts[i][j] = 0;}
+static void tick(int line, int op) {counts[line][op]++; }
+
+static void report_counts(s7_scheme *sc)
+{
+ int j, mx, mxi, mxj;
+ fprintf(stderr, "\n");
+
+ for (mxi = 0; mxi < 70000; mxi++)
+ {
+ int k, ctotal = 0;
+ for (k = 0; k < 500; k++) ctotal += counts[mxi][k];
+ if (ctotal > 0)
+ {
+ mx = 0;
+ for (j = 0; j < NUM_COUNTS; j++)
+ {
+ if (counts[mxi][j] > mx)
+ {
+ mx = counts[mxi][j];
+ mxj = j;
+ }
+ }
+ fprintf(stderr, "%d: %d %d of %d\n", mxi, mxj, counts[mxi][mxj], ctotal);
+ }
+ }
+#if 0
+ {
+ int i;
+ bool happy = true;
+ while (happy)
+ {
+ mx = 0;
+ for (i = 0; i < 70000; i++)
+ for (j = 0; j < NUM_COUNTS; j++)
+ {
+ if (counts[i][j] > mx)
+ {
+ mx = counts[i][j];
+ mxi = i;
+ mxj = j;
+ }
+ }
+ if (mx > 0)
+ {
+ int k, ctotal = 0;
+ for (k = 0; k < 500; k++) ctotal += counts[mxi][k];
+
+ fprintf(stderr, "%d: %d %d of %d\n", mxi, mxj, counts[mxi][mxj], ctotal);
+ counts[mxi][mxj] = 0;
+ }
+ else happy = false;
+ }
+ }
+#endif
+}
+
+#else
+#define NUM_COUNTS 1000
+static int counts[NUM_COUNTS];
+static void clear_counts(void) {int i; for (i = 0; i < NUM_COUNTS; i++) counts[i] = 0;}
+static void tick(int op) {counts[op]++;}
+static void report_counts(s7_scheme *sc)
+{
+ int k, i, mx;
+ bool happy = true;
+ fprintf(stderr, "\n");
+ while (happy)
+ {
+ mx = 0;
+ for (k = 0; k < OP_MAX_DEFINED; k++)
+ {
+ if (counts[k] > mx)
+ {
+ mx = counts[k];
+ i = k;
+ }
+ }
+ if (mx > 0)
+ {
+ fprintf(stderr, "%d: %d\n", i, counts[i]);
+ counts[i] = 0;
+ }
+ else happy = false;
+ }
+ /* fprintf(stderr, "\n"); */
+}
+#endif
+#endif
+
+static void init_hashes(s7_scheme *sc) {}
+
+#else
+
+void clear_counts(void) {}
+static s7_pointer hashes;
+void add_expr(s7_scheme *sc, s7_pointer expr);
+void add_expr(s7_scheme *sc, s7_pointer expr)
+{
+ s7_pointer val;
+ /* expr = sc->cur_code; */
+ val = s7_hash_table_ref(sc, hashes, expr);
+ if (val == sc->F)
+ {
+ if (!is_any_closure(expr))
+ s7_hash_table_set(sc, hashes, expr, s7_make_integer(sc, 1));
+ }
+ else
+ {
+ s7_hash_table_set(sc, hashes, expr, s7_make_integer(sc, 1 + s7_integer(val)));
+ }
+}
+static void init_hashes(s7_scheme *sc)
+{
+ hashes = s7_make_hash_table(sc, 65536);
+ s7_gc_protect(sc, hashes);
+}
+
+typedef struct {
+ s7_int count;
+ s7_pointer expr;
+} datum;
+
+static datum *new_datum(s7_int ctr, s7_pointer e)
+{
+ datum *d;
+ d = calloc(1, sizeof(datum));
+ d->count = ctr;
+ d->expr = e;
+ return(d);
+}
+static int sort_data(const void *v1, const void *v2)
+{
+ datum *d1 = *(datum **)v1;
+ datum *d2 = *(datum **)v2;
+ if (d1->count > d2->count)
+ return(-1);
+ return(1);
+}
+static void report_counts(s7_scheme *sc)
+{
+ int len, i, loc = 0, entries;
+ hash_entry_t **elements;
+ datum **data;
+
+ len = hash_table_length(hashes);
+ elements = hash_table_elements(hashes);
+ entries = hash_table_entries(hashes);
+ if (entries == 0)
+ {
+ fprintf(stderr, "no counts\n");
+ return;
+ }
+ data = (datum **)calloc(entries, sizeof(datum *));
+
+ for (i = 0; i < len; i++)
+ {
+ hash_entry_t *x;
+ for (x = elements[i]; x; x = x->next)
+ data[loc++] = new_datum(s7_integer(x->value), x->key);
+ }
+
+ qsort((void *)data, loc, sizeof(datum *), sort_data);
+ if (loc > 400) loc = 400;
+ fprintf(stderr, "\n");
+ for (i = 0; i < loc; i++)
+ if (data[i]->count > 0)
+ fprintf(stderr, "%lld: %s\n", data[i]->count, DISPLAY_80(data[i]->expr));
+
+ free(data);
+}
+void add_code(s7_scheme *sc);
+void add_code(s7_scheme *sc)
+{
+ add_expr(sc, sc->code);
+}
+/* use xen.h and s7 here */
+#endif
diff --git a/tools/sam.c b/tools/sam.c
index 2938ea4..7fe04a6 100644
--- a/tools/sam.c
+++ b/tools/sam.c
@@ -24,7 +24,7 @@
:srate (srate snd)
:size (frames snd)
:header-type (header-type snd)
- :data-format (data-format snd))))
+ :sample-type (sample-type snd))))
(map-channel (lambda (y)
(+ (next-sample r0) (next-sample r3)))
0 (frames snd) new-snd 0)
diff --git a/tools/sarchive b/tools/sarchive
index e38963e..583fc28 100755
--- a/tools/sarchive
+++ b/tools/sarchive
@@ -3,12 +3,22 @@
date > /home/bil/cl/hi
echo ' ' >> /home/bil/cl/hi
+chdir /home/bil/s7
+foreach file (*.h *.c *.html *.scm gdbinit)
+ if (-e /home/bil/cl/$file) then
+ find /home/bil/cl/$file -newer /home/bil/s7/$file -exec echo ' updating ' $file \;
+ find /home/bil/cl/$file -newer /home/bil/s7/$file -exec cp /home/bil/cl/$file /home/bil/s7 \;
+ else
+ echo $file 'does not exist in /home/bil/cl'
+ endif
+end
+
chdir /home/bil/dist/snd
foreach file (*.h *.c *.cl *.el *.clm *.html makefile.* make.* *.in *.scm *.lisp *.fs *.fsm *.js *.Snd snd.1 configure.ac *.rb *.m4 config.guess config.sub NEWS *.tex COPYING DotEmacs *.f music5-examples)
if (-e /home/bil/cl/$file) then
diff -bcw /home/bil/cl/$file /home/bil/dist/snd/$file >> /home/bil/cl/hi
find /home/bil/cl/$file -newer /home/bil/dist/snd/$file -exec echo ' updating ' $file \;
- find /home/bil/cl/$file -newer /home/bil/dist/snd/$file -exec cp /home/bil/dist/snd/$file /home/bil/mov \;
+ find /home/bil/cl/$file -newer /home/bil/dist/snd/$file -exec cp /home/bil/dist/snd/$file /home/bil/old-dist \;
find /home/bil/cl/$file -newer /home/bil/dist/snd/$file -exec cp /home/bil/cl/$file /home/bil/dist/snd \;
else
echo $file 'does not exist in /home/bil/cl'
@@ -19,7 +29,7 @@ chdir /home/bil/dist/snd/pix
foreach file (*.png)
if (-e /home/bil/cl/pix/$file) then
find /home/bil/cl/pix/$file -newer /home/bil/dist/snd/pix/$file -exec echo ' updating ' pix/$file \;
- find /home/bil/cl/pix/$file -newer /home/bil/dist/snd/pix/$file -exec cp /home/bil/dist/snd/pix/$file /home/bil/mov \;
+ find /home/bil/cl/pix/$file -newer /home/bil/dist/snd/pix/$file -exec cp /home/bil/dist/snd/pix/$file /home/bil/old-dist \;
find /home/bil/cl/pix/$file -newer /home/bil/dist/snd/pix/$file -exec cp /home/bil/cl/pix/$file /home/bil/dist/snd/pix \;
else
echo pix/$file 'does not exist in /home/bil/cl/pix'
@@ -30,10 +40,8 @@ chdir /home/bil/cl/tools
foreach file (*)
if (-e /home/bil/cl/$file) then
find /home/bil/cl/$file -newer /home/bil/cl/tools/$file -exec echo ' updating ' cl/tools/$file \;
- find /home/bil/cl/$file -newer /home/bil/cl/tools/$file -exec cp /home/bil/cl/tools/$file /home/bil/mov \;
+ find /home/bil/cl/$file -newer /home/bil/cl/tools/$file -exec cp /home/bil/cl/tools/$file /home/bil/old-dist \;
find /home/bil/cl/$file -newer /home/bil/cl/tools/$file -exec cp /home/bil/cl/$file /home/bil/cl/tools \;
- else
- echo $file '(tools) does not exist in /home/bil/cl'
endif
end
@@ -42,7 +50,7 @@ foreach file (*)
if (-e /home/bil/cl/tools/$file) then
diff -bcw /home/bil/cl/tools/$file /home/bil/dist/snd/tools/$file >> /home/bil/cl/hi
find /home/bil/cl/tools/$file -newer /home/bil/dist/snd/tools/$file -exec echo ' updating ' snd/tools/$file \;
- find /home/bil/cl/tools/$file -newer /home/bil/dist/snd/tools/$file -exec cp /home/bil/dist/snd/tools/$file /home/bil/mov \;
+ find /home/bil/cl/tools/$file -newer /home/bil/dist/snd/tools/$file -exec cp /home/bil/dist/snd/tools/$file /home/bil/old-dist \;
find /home/bil/cl/tools/$file -newer /home/bil/dist/snd/tools/$file -exec cp /home/bil/cl/tools/$file /home/bil/dist/snd/tools \;
else
echo $file '(snd tools) does not exist in /home/bil/cl/tools'
@@ -51,11 +59,11 @@ end
chdir /home/bil/dist/snd/sndins
-foreach file (*.h *.c *.in)
+foreach file (*.h *.c *.in README)
if (-e /home/bil/cl/sndins/$file) then
diff -bcw /home/bil/cl/sndins/$file /home/bil/dist/snd/sndins/$file >> /home/bil/cl/hi
find /home/bil/cl/sndins/$file -newer /home/bil/dist/snd/sndins/$file -exec echo ' updating ' sndins/$file \;
- find /home/bil/cl/sndins/$file -newer /home/bil/dist/snd/sndins/$file -exec cp /home/bil/dist/snd/sndins/$file /home/bil/mov \;
+ find /home/bil/cl/sndins/$file -newer /home/bil/dist/snd/sndins/$file -exec cp /home/bil/dist/snd/sndins/$file /home/bil/old-dist \;
find /home/bil/cl/sndins/$file -newer /home/bil/dist/snd/sndins/$file -exec cp /home/bil/cl/sndins/$file /home/bil/dist/snd/sndins \;
else
echo $file '(snd sndins) does not exist in /home/bil/cl/sndins'
@@ -68,7 +76,7 @@ foreach file (*.rb *.scm *.fth *.fs)
if (-e /home/bil/cl/sndins/samples/$file) then
diff -bcw /home/bil/cl/sndins/samples/$file /home/bil/dist/snd/sndins/samples/$file >> /home/bil/cl/hi
find /home/bil/cl/sndins/samples/$file -newer /home/bil/dist/snd/sndins/samples/$file -exec echo ' updating ' sndins/samples/$file \;
- find /home/bil/cl/sndins/samples/$file -newer /home/bil/dist/snd/sndins/samples/$file -exec cp /home/bil/dist/snd/sndins/samples/$file /home/bil/mov \;
+ find /home/bil/cl/sndins/samples/$file -newer /home/bil/dist/snd/sndins/samples/$file -exec cp /home/bil/dist/snd/sndins/samples/$file /home/bil/old-dist \;
find /home/bil/cl/sndins/samples/$file -newer /home/bil/dist/snd/sndins/samples/$file -exec cp /home/bil/cl/sndins/samples/$file /home/bil/dist/snd/sndins/samples \;
else
echo $file '(snd sndins/samples) does not exist in /home/bil/cl/sndins/samples'
diff --git a/tools/sed.scm b/tools/sed.scm
new file mode 100644
index 0000000..e26e609
--- /dev/null
+++ b/tools/sed.scm
@@ -0,0 +1,18 @@
+
+(define (sed in-file out-file source-text dest-text)
+ (let ((source-len (length source-text)))
+ (call-with-output-file out-file
+ (lambda (p)
+ (call-with-input-file in-file
+ (lambda (file)
+ (let loop ((line (read-line file)))
+ (or (eof-object? line)
+ (let ((pos (string-position source-text line)))
+ (if pos
+ (format p "~A~A~A~%" (substring line 0 pos) dest-text (substring line (+ pos source-len)))
+ (format p "~A~%" line))
+ (loop (read-line file)))))))))
+ (exit)))
+
+
+
diff --git a/tools/snd.supp b/tools/snd.supp
index 10c90fc..885dc0e 100644
--- a/tools/snd.supp
+++ b/tools/snd.supp
@@ -2,8 +2,8 @@
# valgrind --error-limit=no -v --gen-suppressions=yes --suppressions=/home/bil/cl/snd.supp snd
# valgrind --error-limit=no -v --gen-suppressions=yes --suppressions=/home/bil/cl/snd.supp --leak-check=yes --show-reachable=no --num-callers=6 snd
# valgrind --error-limit=no -v --gen-suppressions=no --suppressions=/home/bil/cl/snd.supp --leak-check=yes --leak-resolution=high --show-reachable=no --num-callers=12 snd
+# valgrind --error-limit=no -v --gen-suppressions=no --suppressions=/home/bil/cl/snd.supp --leak-check=yes --show-reachable=no --track-origins=yes --track-fds=yes --read-var-info=yes snd -l snd-test
# valgrind --error-limit=no -v --gen-suppressions=no --suppressions=/home/bil/cl/snd.supp --leak-check=yes --show-reachable=no --track-origins=yes snd -l snd-test
-# /usr/local/bin/valgrind --error-limit=no -v --gen-suppressions=no --suppressions=/home/bil/cl/snd.supp --leak-check=yes --show-reachable=no --track-origins=yes snd -l snd-test
#
# --tool=exp-ptrcheck
#
@@ -681,26 +681,6 @@
# --------------------------------------------------------------------------------
-{
- OSS-1
- Memcheck:Param
- ioctl(SNDCTL_XXX|SOUND_XXX (SIOWR, int))
- fun:__GI___ioctl
- fun:describe_audio_state_1
- fun:mus_audio_report
- fun:g_mus_audio_describe
-}
-
-{
- OSS-2
- Memcheck:Param
- ioctl(SNDCTL_XXX|SOUND_XXX (SIOWR, int))
- fun:__GI___ioctl
- fun:describe_audio_state_1
- fun:mus_audio_report
- fun:g_mus_audio_report
-}
-
# I don't think any of these are actually my bugs -- everything is initialized and so forth in my code
{
snd-1
@@ -1762,6 +1742,168 @@
}
{
+ s71a
+ Memcheck:Leak
+ fun:alloc_pointer
+ fun:s7_make_permanent_string
+ fun:*
+}
+
+{
+ s71a1
+ Memcheck:Leak
+ fun:malloc
+ fun:s7_init
+ fun:*
+}
+
+{
+ s71a11
+ Memcheck:Leak
+ fun:malloc
+ fun:new_symbol
+ fun:*
+}
+
+{
+ s71ab
+ Memcheck:Leak
+ fun:calloc
+ fun:alloc_pointer
+ fun:*
+}
+
+{
+ s71af
+ Memcheck:Leak
+ fun:calloc
+ fun:store_choices
+ fun:*
+}
+
+{
+ s71abcd
+ Memcheck:Leak
+ fun:calloc
+ fun:s7_make_function
+ fun:*
+}
+
+{
+ s71abcd1
+ Memcheck:Leak
+ fun:malloc
+ fun:s7_make_function
+ fun:*
+}
+
+{
+ s71abcde
+ Memcheck:Leak
+ fun:calloc
+ fun:make_permanent_string
+ fun:*
+}
+
+{
+ s71abcde
+ Memcheck:Leak
+ fun:malloc
+ fun:make_permanent_string
+ fun:*
+}
+
+{
+ s71abcde1
+ Memcheck:Leak
+ fun:malloc
+ fun:s7_make_permanent_string
+ fun:*
+}
+
+{
+ s71abcde1
+ Memcheck:Leak
+ fun:calloc
+ fun:init_ctables
+ fun:*
+}
+
+{
+ s71abcde1
+ Memcheck:Leak
+ fun:malloc
+ fun:copy_string_with_length
+ fun:copy_string
+ fun:s7_define_constant_with_documentation
+ fun:*
+}
+
+{
+ s71abcde2
+ Memcheck:Leak
+ fun:malloc
+ fun:make_permanent_string_with_length
+ fun:*
+}
+
+{
+ s71abcde3
+ Memcheck:Leak
+ fun:malloc
+ fun:make_permanent_string_with_length_and_hash
+ fun:*
+}
+
+{
+ s71abcdef
+ Memcheck:Leak
+ fun:calloc
+ fun:s7_make_permanent_string
+ fun:*
+}
+
+{
+ s71abc
+ Memcheck:Leak
+ fun:calloc
+ fun:make_choices
+ fun:*
+}
+
+{
+ s71abcd
+ Memcheck:Leak
+ fun:malloc
+ fun:copy_string_with_len
+ fun:*
+}
+
+{
+ s71ac
+ Memcheck:Leak
+ fun:malloc
+ fun:alloc_pointer
+ fun:*
+}
+
+{
+ s71aa
+ Memcheck:Leak
+ fun:calloc
+ fun:make_permanent_integer
+ fun:*
+}
+
+{
+ s71b
+ Memcheck:Leak
+ fun:alloc_pointer
+ fun:s7_remove_from_heap
+ fun:*
+}
+
+{
s71
Memcheck:Leak
fun:calloc
@@ -1826,7 +1968,7 @@
fun:malloc
fun:copy_string_with_len
fun:copy_string
- fun:s7_make_procedure_with_setter
+ fun:s7_dilambda
fun:*
}
@@ -1834,7 +1976,7 @@
pws-2
Memcheck:Leak
fun:calloc
- fun:s7_make_procedure_with_setter
+ fun:s7_dilambda
fun:*
}
@@ -1862,6 +2004,14 @@
}
{
+ run-1a
+ Memcheck:Leak
+ fun:calloc
+ fun:clm_make_function
+ fun:*
+}
+
+{
run-2
Memcheck:Leak
fun:calloc
diff --git a/tools/t101.scm b/tools/t101.scm
new file mode 100644
index 0000000..f58afb4
--- /dev/null
+++ b/tools/t101.scm
@@ -0,0 +1,118 @@
+;;; try each s7test test macro (using repl, not snd)
+
+(system "make-repl")
+
+(for-each
+ (lambda (test-case)
+ (call-with-output-file "t101-aux.scm"
+ (lambda (p)
+ (format p "(define-macro (test tst expected) ~A)~%(load \"s7test.scm\")~%(exit)~%" test-case)))
+ (format *stderr* "test: ~S~%" test-case)
+ (system "./repl t101-aux.scm"))
+ (list
+ "`(ok? ',tst (lambda () (eval ',tst)) ,expected)"
+ "`(ok? ',tst (lambda () ,tst) ,expected)"
+ "`(ok? ',tst (let () (define (_s7_) ,tst)) ,expected)"
+ "`(ok? ',tst (lambda () (let ((_s7_ #f)) (set! _s7_ ,tst))) ,expected)"
+ "`(ok? ',tst (lambda () (let ((_s7_ ,tst)) _s7_)) ,expected)"
+ "`(ok? ',tst (catch #t (lambda () (lambda* ((_a_ ,tst)) _a_)) (lambda any (lambda () 'error))) ,expected)"
+ "`(ok? ',tst (lambda () (do ((_a_ ,tst)) (#t _a_))) ,expected)"
+ "`(ok? ',tst (lambda () (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) ,expected) ,tst)) ,expected)"
+ "`(ok? ',tst (lambda () (define ($f$) (let (($v$ (vector #f))) (do (($i$ 0 (+ $i$ 1))) ((= $i$ 1) ($v$ 0)) (vector-set! $v$ 0 ,tst)))) ($f$)) ,expected)"
+ "`(ok? ',tst (lambda () (define ($f$) (let (($v$ #f)) (do (($i$ 0 (+ $i$ 1))) ((= $i$ 1) $v$) (set! $v$ ,tst)))) ($f$)) ,expected)"
+ "`(ok? ',tst (lambda () (define ($f$) (let ((x (map (lambda (a) ,tst) '(0)))) (car x))) ($f$)) ,expected)"
+ "`(ok? ',tst (lambda () (call-with-exit (lambda (_a_) (_a_ ,tst)))) ,expected)"
+ "`(ok? ',tst (lambda () (call/cc (lambda (_a_) (_a_ ,tst)))) ,expected)"
+ "`(ok? ',tst (lambda () (values ,tst)) ,expected)"
+ "`(ok? ',tst (lambda () ((lambda (a b) b) (values #f ,tst))) ,expected)"
+ "`(ok? ',tst (lambda () (define (_s7_ _a_) _a_) (_s7_ ,tst)) ,expected)"
+ "`(ok? ',tst (lambda () (let ((___x #f)) (set! ___x ,tst))) ,expected)"
+ "`(ok? ',tst (lambda () (let ((___x #(#f))) (set! (___x 0) ,tst))) ,expected)"
+ "`(ok? ',tst (lambda () (let ((___x #(#f))) (vector-set! ___x 0 ,tst))) ,expected)"
+ "`(ok? ',tst (lambda () (define* (_s7_ (_a_ #f)) (or _a_)) (_s7_ ,tst)) ,expected)"
+ "`(ok? ',tst (lambda () (dynamic-wind (lambda () #f) (lambda () ,tst) (lambda () #f))) ,expected)"
+ "({list} 'ok? ({list} quote tst) ({list} lambda () tst) expected)"
+ ))
+
+(format *stderr* "~NC ffitest ~NC~%" 20 #\- 20 #\-)
+(if (provided? 'linux)
+ (begin
+ (system "gcc -o ffitest ffitest.c -g -Wall s7.o -lm -I. -ldl")
+ (system "ffitest"))
+ (if (provided? 'freebsd)
+ (begin
+ (system "cc -o ffitest ffitest.c -g -Wall s7.o -lm -I. -ldl")
+ (system "ffitest"))
+ (if (provided? 'osx)
+ (begin
+ (system "gcc -o ffitest ffitest.c -g -Wall s7.o -lm -I.")
+ (system "ffitest"))
+ )))
+
+
+(format *stderr* "~%~NC lint ~NC~%" 20 #\- 20 #\-)
+(catch #t (lambda () (lint "s7test.scm" #f)) (lambda args #f))
+
+;; lint clobbers reader-cond
+(define-expansion (reader-cond . clauses)
+ (call-with-exit
+ (lambda (return)
+ (for-each
+ (lambda (clause)
+ (let ((val (eval (car clause))))
+ (if val
+ (if (null? (cdr clause)) (return val)
+ (if (null? (cddr clause)) (return (cadr clause))
+ (return (apply values (map quote (cdr clause)))))))))
+ clauses)
+ (values))))
+
+(format *stderr* "~%~NC local s7test ~NC~%" 20 #\- 20 #\-)
+(system "./snd -e '(let () (catch #t (lambda () (load \"s7test.scm\" (curlet))) (lambda args #f)) (exit))'")
+
+(format *stderr* "~NC tcopy ~NC~%" 20 #\- 20 #\-)
+(system "./repl tcopy.scm")
+
+(format *stderr* "~NC tmap ~NC~%" 20 #\- 20 #\-)
+(system "./repl tmap.scm")
+
+(format *stderr* "~NC teq ~NC~%" 20 #\- 20 #\-)
+(system "./repl teq.scm")
+
+(format *stderr* "~NC titer ~NC~%" 20 #\- 20 #\-)
+(system "./repl titer.scm")
+
+(format *stderr* "~%~NC tform ~NC~%" 20 #\- 20 #\-)
+(system "./repl tform.scm")
+
+(format *stderr* "~%~NC thash ~NC~%" 20 #\- 20 #\-)
+(system "./repl thash.scm")
+
+(format *stderr* "~NC tauto ~NC~%" 20 #\- 20 #\-)
+(system "./repl tauto.scm")
+
+(format *stderr* "~NC index ~NC~%" 20 #\- 20 #\-)
+(system "./snd make-index.scm")
+
+(format *stderr* "~NC makexg ~NC~%" 20 #\- 20 #\-)
+(system "./snd makexg.scm")
+
+(format *stderr* "~NC makegl ~NC~%" 20 #\- 20 #\-)
+(system "./snd makegl.scm")
+
+(format *stderr* "~NC lg ~NC~%" 20 #\- 20 #\-)
+(system "./snd lg.scm")
+
+(format *stderr* "~NC tgen ~NC~%" 20 #\- 20 #\-)
+(system "./snd tgen.scm")
+
+(format *stderr* "~NC tall ~NC~%" 20 #\- 20 #\-)
+(system "./snd tall.scm")
+
+(format *stderr* "~NC snd-test ~NC~%" 20 #\- 20 #\-)
+(system "./snd -l snd-test.scm")
+
+(format *stderr* "~NC bench ~NC~%" 20 #\- 20 #\-)
+(system "(cd /home/bil/test/bench/src ; /home/bil/cl/snd test-all.scm)")
+
+(exit)
diff --git a/tools/table.scm b/tools/table.scm
index f3e8ff3..11abd53 100755
--- a/tools/table.scm
+++ b/tools/table.scm
@@ -1,10 +1,9 @@
(define (no-dashes-or-cr str)
- (let* ((len (string-length str))
- (newstr (make-string 0))
- (colons 0)
- (last-ch #\-))
- (do ((i 0 (1+ i)))
- ((= i (1- len)))
+ (let ((len (length str))
+ (newstr (make-string 0))
+ (last-ch #\-))
+ (do ((i 0 (+ i 1)))
+ ((= i (- len 1)))
(let ((ch (string-ref str i)))
(if (and (or (not (char=? ch #\-))
(char-alphabetic? last-ch))
@@ -18,13 +17,13 @@
"snd-test.scm"
(lambda (file)
(let loop ((line (read-line file #t)))
- (set! ctr (1+ ctr))
+ (set! ctr (+ ctr 1))
(or (eof-object? line)
- (let ((len (string-length line)))
+ (let ((len (length line)))
(if (and (> len 30)
(string=? ";;; ---------------- test "
(substring line 0 26)))
- (display (format #f "~A ~48,1T[~D]~%" (no-dashes-or-cr line) ctr)))
+ (format #t "~A ~48,1T[~D]~%" (no-dashes-or-cr line) ctr))
(loop (read-line file #t))))))))
(exit)
diff --git a/tools/tauto.scm b/tools/tauto.scm
new file mode 100644
index 0000000..e531fe7
--- /dev/null
+++ b/tools/tauto.scm
@@ -0,0 +1,217 @@
+(set! (hook-functions *unbound-variable-hook*) ())
+(set! (*s7* 'print-length) 6)
+;(set! (*s7* 'gc-stats) #t)
+
+(if (provided? 'snd)
+ (begin
+ (format *stderr* "this won't work in Snd!~%") ; see t705.scm
+ (exit)))
+
+;(load "stuff.scm")
+;(load "r7rs.scm")
+(require mockery.scm)
+
+(define max-args 3)
+(define-constant one 1)
+
+(define mock-number (*mock-number* 'mock-number))
+(define mock-pair (*mock-pair* 'mock-pair))
+(define mock-string (*mock-string* 'mock-string))
+(define mock-char (*mock-char* 'mock-char))
+(define mock-vector (*mock-vector* 'mock-vector))
+(define mock-symbol (*mock-symbol* 'mock-symbol))
+(define mock-hash-table* (*mock-hash-table* 'mock-hash-table*))
+
+(define np (list 0 1 2 3 4))
+(define mp (mock-pair '(0 1 2 3 4)))
+(define nv (vector 0 1 2 3 4))
+(define mv (mock-vector 0 1 2 3 4))
+(define ns "01234")
+(define ms (mock-string #\0 #\1 #\2 #\3 #\4))
+
+;(define value 1) ; this causes an infinite loop somewhere
+;(openlet (inlet 'i 0 'list-set! (lambda (l . args) (apply #_list-set! l ((car args) 'i) (cdr args))))))
+
+(define-constant constants (list #f #t () #\a (/ most-positive-fixnum) (/ -1 most-positive-fixnum) 1.5+i
+ "hi455" :key hi: 'hi (list 1) (list 1 2) (cons 1 2) (list (list 1 2)) (list (list 1)) (list ()) #()
+ 1/0+i 0+0/0i 0+1/0i 1+0/0i 0/0+0i 0/0+0/0i 1+1/0i 0/0+i cons ''2
+ 1+i 1+1e10i 1e15+1e15i 0+1e18i 1e18 (integer->char 255) (string (integer->char 255)) 1e308
+ most-positive-fixnum most-negative-fixnum (- most-positive-fixnum 1) (+ most-negative-fixnum 1)
+ -1 0 0.0 1 1.5 1.0-1.0i 3/4 #\null -63 (make-hash-table) (hash-table '(a . 2) '(b . 3))
+ '((1 2) (3 4)) '((1 (2)) (((3) 4))) "" (list #(1) "1") '(1 2 . 3) (list (cons 'a 2) (cons 'b 3))
+ #(1 2) (vector 1 '(3)) (let ((x 3)) (lambda (y) (+ x y))) abs 'a 'b one
+ (lambda args args) (lambda* ((a 3) (b 2)) (+ a b)) (lambda () 3)
+ (sublet () 'a 1) (rootlet)
+ *load-hook* *error-hook* (random-state 123)
+ quasiquote macroexpand begin let letrec* if case cond (call-with-exit (lambda (goto) goto))
+ (with-baffle (call/cc (lambda (cc) cc)))
+ (string #\a #\null #\b) #2d((1 2) (3 4)) (inlet 'a 2 'b 3)
+ #<undefined> #<unspecified> (make-int-vector 3 0) (make-float-vector 3 -1.4)
+ (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (make-shared-vector (make-int-vector '(2 3) 1) '(6))
+ (make-shared-vector (make-shared-vector (make-float-vector '(2 3) 1.0) '(6)) '(2 2))
+ (vector-ref #2d((#(1 2 3)) (#(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1))
+ (c-pointer 0) (c-pointer -1) :readable :else (define-bacro* (m (a 1)) `(+ ,a 1))
+ (byte-vector 0 1 2) (byte-vector) (byte-vector 255 0 127) (make-iterator (vector '(a . 2)))
+ (lambda (dir) 1.0) (float-vector) (make-float-vector '(2 32))
+ '((a . 1)) #(1) '((((A . B) C . D) (E . F) G . H) ((I . J) K . L) (M . N) O . P)
+
+ (mock-number 0) (mock-number 1-i) (mock-number 4/3) (mock-number 2.0)
+ (mock-string #\h #\o #\h #\o)
+ (mock-pair '(2 3 4))
+ (mock-char #\b)
+ (mock-symbol 'c)
+ (mock-vector 1 2 3 4)
+ (mock-hash-table* 'b 2)
+ np mp nv mv ns ms (gensym)
+ ))
+
+(define car-constants (car constants))
+(define-constant cdr-constants (cdr constants))
+
+(define low 0)
+(define-constant arglists (vector (make-list 1) (make-list 2) (make-list 3) (make-list 4) (make-list 5) (make-list 6)))
+
+(define-constant (autotest func args args-now args-left sig)
+ ;; args-left is at least 1, args-now starts at 0, args starts at ()
+ ;; (format *stderr* "~A: ~D ~D (~D ~D): ~A~%" func (length args) args-now low args-left args)
+ ;(if (pair? args) (format *stderr* "~A " (car args)))
+
+ (call-with-exit
+ (lambda (quit)
+ (if (>= args-now low)
+ (catch #t
+ (lambda ()
+ ;(format *stderr* "args: ~A~%" args)
+ (apply func args))
+ (lambda any
+ (if (and (positive? args-now)
+ (memq (car any) '(wrong-type-arg wrong-number-of-args syntax-error)))
+ (quit)))))
+
+ (let ((c-args (vector-ref arglists args-now)))
+ (copy args c-args)
+
+ (let ((p (list-tail c-args args-now)))
+ (if (= args-left 1)
+ (call-with-exit
+ (lambda (quit)
+ (set-car! p car-constants)
+ (catch #t
+ (lambda ()
+ (apply func c-args))
+ (lambda any
+ (if (and (memq (car any) '(wrong-type-arg wrong-number-of-args syntax-error))
+ (pair? (cdadr any))
+ (pair? (cddadr any))
+ (integer? (caddr (cadr any))) ; if just 1 arg, arg num can be omitted
+ (< (caddr (cadr any)) low))
+ (quit))))
+
+ (let ((checker (and (pair? sig) (car sig))))
+ (if checker
+ (for-each
+ (lambda (c)
+ (when (checker c)
+ (catch #t
+ (lambda ()
+ (set-car! p c)
+ (apply func c-args))
+ (lambda any
+ 'error))))
+ cdr-constants)
+ (for-each
+ (lambda (c)
+ (catch #t
+ (lambda ()
+ (set-car! p c)
+ (apply func c-args))
+ (lambda any
+ 'error)))
+ cdr-constants)))))
+
+ (let ((checker (and (pair? sig) (car sig))))
+ (if checker
+ (for-each
+ (lambda (c)
+ (when (checker c)
+ (set-car! p c)
+ (autotest func c-args (+ args-now 1) (- args-left 1) (if (pair? sig) (cdr sig) ()))))
+ constants)
+ (for-each
+ (lambda (c)
+ (set-car! p c)
+ (autotest func c-args (+ args-now 1) (- args-left 1) (if (pair? sig) (cdr sig) ())))
+ constants)))))))))
+
+(define safe-fill!
+ (let ((signature '(#t sequence? #t)))
+ (lambda (obj arg)
+ (if (not (let? obj))
+ (fill! obj arg)))))
+
+(define (map-values lst)
+ (if (or (not (pair? lst))
+ (not (car lst))
+ (procedure? (car lst)))
+ lst
+ (begin
+ (if (symbol? (car lst))
+ (set-car! lst (symbol->value (car lst)))
+ (if (pair? (car lst))
+ (set-car! lst (apply lambda '(x) `((or (,(caar lst) x) (,(cadar lst) x)))))
+ (set-car! lst #f)))
+ (map-values (cdr lst)))))
+
+(define baddies '(exit emergency-exit abort autotest
+ all delete-file system set-cdr! stacktrace test-sym
+ cutlet varlet gc cond-expand reader-cond
+ openlet coverlet eval vector list cons hash-table* hash-table values
+ throw symbol-table load
+ global-environment current-environment make-procedure-with-setter procedure-with-setter? make-rectangular
+
+ copy fill! hash-table-set! vector-set! let-set! hash-table-size
+
+ mock-number mock-pair mock-string mock-char mock-vector
+ mock-symbol mock-port mock-hash-table m
+ *mock-number* *mock-pair* *mock-string* *mock-char* *mock-vector*
+ *mock-symbol* *mock-port* *mock-hash-table*
+
+ c-define-1 apropos map-values ;set-current-output-port
+ outlet-member make-method make-object))
+
+(define (test-sym sym)
+ (if (and (not (memq sym baddies))
+ (defined? sym))
+ (let ((f (symbol->value sym)))
+ (let ((argn (and (or (procedure? f) (let? f)) (arity f))))
+ (if argn
+ (let ((bottom (car argn))
+ (top (min (cdr argn) max-args))
+ (strname (symbol->string sym)))
+ (if (not (memq (strname 0) '(#\{ #\[ #\()))
+ (begin
+ (if (< top bottom)
+ (format *stderr* ";~A (bottom: ~A, top: ~A)...~%" sym bottom top))
+ ;(format *stderr* ";~A...~%" sym)
+ (set! low bottom)
+ (if (positive? (cdr argn))
+ (let ((sig (if (eq? sym 'append)
+ (let ((lst (list 'list?)))
+ (set-cdr! lst lst))
+ (copy (procedure-signature f)))))
+ (map-values sig)
+ (autotest f () 0 top (if (pair? sig) (cdr sig) ()))))))))))))
+
+(define (all)
+ (let ((st (symbol-table)))
+ (for-each test-sym st)
+ ;(do ((i 0 (+ i 1)) (len (length st))) ((= i 1000)) (test-sym (st (random len))))
+ ;(test-sym 'object->string)
+ ;(test-sym 'for-each)
+ (format *stderr* "~%all done~%")
+ (s7-version)
+ ))
+
+;(test-sym 'write)
+(all)
+(exit)
diff --git a/tools/tcopy.scm b/tools/tcopy.scm
new file mode 100644
index 0000000..e81b269
--- /dev/null
+++ b/tools/tcopy.scm
@@ -0,0 +1,255 @@
+(let ((new-env (sublet (curlet) (cons 'init_func 'block_init)))) ; load calls init_func if possible
+ (load "s7test-block.so" new-env))
+
+(define (test-copy size)
+ (let ((old-string (make-string size #\a))
+ (old-bvect (make-byte-vector size 1))
+ (old-pair (make-list size #\a))
+ (old-vector (make-vector size #\a))
+ (old-vectorf (make-vector size 1.0))
+ (old-vectori (make-vector size 1))
+ (old-fvect (make-float-vector size 1.0))
+ (old-ivect (make-int-vector size 1))
+ (old-hash (make-hash-table size))
+ (old-let #f)
+ (old-block (make-block size)))
+ (set! old-let (inlet))
+
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! old-hash i #\a))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (varlet old-let (string->symbol (number->string i)) #\a))
+
+ (let ((new-string (make-string size #\space))
+ (new-bvect (make-byte-vector size 0))
+ (new-pair (make-list size 1))
+ (new-vector (make-vector size 1))
+ (new-fvect (make-float-vector size 1.0))
+ (new-ivect (make-int-vector size 1))
+ (new-hash (make-hash-table (* size 2)))
+ (new-let (inlet))
+ (new-block (make-block size)))
+
+ (copy old-string)
+ (copy old-pair)
+ (copy old-vector)
+ (copy old-fvect)
+ (copy old-ivect)
+ (copy old-hash)
+ (copy old-let)
+ (copy old-bvect)
+ (copy old-block)
+
+ (length old-string)
+ (length old-pair)
+ (length old-vector)
+ (length old-fvect)
+ (length old-ivect)
+ (length old-hash)
+ (length old-let)
+ (length old-bvect)
+ (length old-block)
+
+ (fill! old-string #\a)
+ (fill! new-string #\space)
+ (fill! old-pair #\a)
+ (fill! new-pair 1)
+ (fill! old-vector #\a)
+ (fill! new-vector 1)
+ (fill! old-fvect 1.0)
+ (fill! new-fvect 1.0)
+ (fill! old-ivect 1)
+ (fill! new-ivect 1)
+ (fill! old-bvect 1)
+ (fill! new-bvect 0)
+ (fill! old-block 0.0)
+ (fill! new-block 1.0)
+
+ (copy old-string new-string)
+ (copy old-vector new-string)
+ (copy old-pair new-string)
+ (copy old-bvect new-string)
+
+ (copy old-bvect new-bvect)
+ (copy old-ivect new-bvect)
+ (copy old-vectori new-bvect)
+ (copy old-string new-bvect)
+
+ (copy old-pair new-pair)
+ (copy old-string new-pair)
+ (copy old-vector new-pair)
+ (copy old-hash new-pair)
+ (copy old-fvect new-pair)
+ (copy old-ivect new-pair)
+ (copy old-let new-pair)
+ (copy old-block new-pair)
+
+ (copy old-vector new-vector)
+ (copy old-pair new-vector)
+ (copy old-string new-vector)
+ (copy old-fvect new-vector)
+ (copy old-ivect new-vector)
+ (copy old-hash new-vector)
+ (copy old-let new-vector)
+ (copy old-block new-vector)
+
+ (copy old-fvect new-fvect)
+ (copy old-ivect new-fvect)
+ (copy old-vectorf new-fvect)
+ (copy old-block new-fvect)
+
+ (copy old-ivect new-ivect)
+ (copy old-fvect new-ivect)
+ (copy old-vectori new-ivect)
+ (copy old-bvect new-ivect)
+
+ (copy old-hash new-hash)
+ (copy old-let new-hash)
+
+ (copy old-let new-let)
+
+ (copy old-fvect new-block)
+ (copy old-block new-block))
+
+ (let ((nsize (/ size 2))
+ (start (/ size 4)))
+ (let ((new-string (make-string size #\space))
+ (new-pair (make-list size 1))
+ (new-vector (make-vector size 1))
+ (new-fvect (make-float-vector size 1.0))
+ (new-ivect (make-int-vector size 1))
+ (new-hash (make-hash-table (* size 2)))
+ (new-let (inlet))
+ (new-bvect (make-byte-vector size 255))
+ (new-block (make-block size)))
+
+ (copy old-string new-string start (+ start nsize))
+ (copy old-vector new-string start (+ start nsize))
+ (copy old-pair new-string start (+ start nsize))
+
+ (copy old-bvect new-bvect start (+ start nsize))
+ (copy old-vectori new-bvect start (+ start nsize))
+ (copy old-ivect new-bvect start (+ start nsize))
+ (copy old-string new-bvect start (+ start nsize))
+
+ (copy old-pair new-pair start (+ start nsize))
+ (copy old-string new-pair start (+ start nsize))
+ (copy old-vector new-pair start (+ start nsize))
+ (copy old-hash new-pair start (+ start nsize))
+ (copy old-fvect new-pair start (+ start nsize))
+ (copy old-ivect new-pair start (+ start nsize))
+ (copy old-let new-pair start (+ start nsize))
+ (copy old-block new-pair start (+ start nsize))
+
+ (copy old-vector new-vector start (+ start nsize))
+ (copy old-pair new-vector start (+ start nsize))
+ (copy old-string new-vector start (+ start nsize))
+ (copy old-fvect new-vector start (+ start nsize))
+ (copy old-ivect new-vector start (+ start nsize))
+ (copy old-hash new-vector start (+ start nsize))
+ (copy old-let new-vector start (+ start nsize))
+ (copy old-block new-vector start (+ start nsize))
+
+ (copy old-fvect new-fvect start (+ start nsize))
+ (copy old-ivect new-fvect start (+ start nsize))
+ (copy old-vectorf new-fvect start (+ start nsize))
+ (copy old-block new-fvect start (+ start nsize))
+
+ (copy old-ivect new-ivect start (+ start nsize))
+ (copy old-fvect new-ivect start (+ start nsize))
+ (copy old-vectori new-ivect start (+ start nsize))
+ (copy old-bvect new-ivect start (+ start nsize))
+
+ (copy old-hash new-hash start (+ start nsize))
+ (copy old-let new-hash start (+ start nsize))
+
+ (copy old-let new-let start (+ start nsize))
+
+ (copy old-fvect new-block start (+ start nsize))
+ (copy old-block new-block start (+ start nsize))))
+
+ (reverse old-string)
+ (reverse old-pair)
+ (reverse old-vector)
+ (reverse old-fvect)
+ (reverse old-ivect)
+ (reverse old-hash)
+ (reverse old-bvect)
+ (reverse old-block)
+
+ (reverse! old-string)
+ (reverse! old-pair)
+ (reverse! old-vector)
+ (reverse! old-fvect)
+ (reverse! old-ivect)
+ (reverse! old-bvect)
+ (reverse! old-block)
+ ))
+
+(define-expansion (test tst expected)
+ `(let ((val ,tst))
+ (if (not (equal? val ,expected))
+ (format *stderr* "~S: ~S but expected ~S~%" ',tst val ,expected))))
+
+(define (test-append size)
+ (let ((strs ())
+ (vecs ())
+ (fvecs ())
+ (ivecs ())
+ (ifvecs ())
+ (allvecs ())
+ (bvecs ())
+ (lsts ()))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! strs (cons (make-string size (integer->char (+ 1 (random 255)))) strs))
+ (set! bvecs (cons (->byte-vector (make-string size (integer->char (random 256)))) bvecs))
+ (set! vecs (cons (make-vector size i) vecs))
+ (set! ivecs (cons (make-int-vector size i) ivecs))
+ (set! fvecs (cons (make-float-vector size (* i 1.0)) fvecs))
+ (set! ifvecs (cons (make-vector size (if (even? i) (* i 1.0) i) #t) ifvecs))
+ (set! allvecs (cons (make-vector size (if (even? i) (* i 1.0) i) (not (zero? (modulo i 3)))) allvecs))
+ (set! lsts (cons (make-list size i) lsts)))
+ (let ((lst (apply append lsts))
+ (vec (apply vector-append vecs))
+ (fvec (apply vector-append fvecs))
+ (ivec (apply vector-append ivecs))
+ (ifvec (apply vector-append ifvecs))
+ (allvec (apply vector-append allvecs))
+ (str (apply string-append strs))
+ (bvec (->byte-vector (apply string-append bvecs))))
+ (test (vector? vec) #t)
+ (test (length vec) (* size size))
+ (test (float-vector? fvec) #t)
+ (test (length fvec) (* size size))
+ (test (int-vector? ivec) #t)
+ (test (length ivec) (* size size))
+ (test (vector? allvec) #t)
+ (test (length allvec) (* size size))
+ (test (vector? ifvec) #t)
+ (test (length ifvec) (* size size))
+; (test (float-vector? ifvec) #t)
+; (test (int-vector? ifvec) #f)
+ (test (pair? lst) #t)
+ (test (length lst) (* size size))
+ (test (string? str) #t)
+ (test (length str) (* size size))
+ (test (byte-vector? bvec) #t)
+ (test (length bvec) (* size size))
+ )))
+
+
+(define (t)
+ (do ((i 0 (+ i 1)))
+ ((= i 10000))
+ (test-copy 100))
+ (do ((i 1 (* i 10)))
+ ((> i 1000))
+ (test-append i)))
+
+(t)
+
+(s7-version)
+(exit)
diff --git a/tools/teq.scm b/tools/teq.scm
new file mode 100644
index 0000000..3e62f13
--- /dev/null
+++ b/tools/teq.scm
@@ -0,0 +1,155 @@
+;;; cyclic/shared timing tests
+
+;;; equal? write/object->string/format cyclic-sequences
+
+;(set! (*s7* 'default-hash-table-length) 15)
+
+(define* (make-circular-list n init)
+ (let ((l (make-list n init)))
+ (set-cdr! (list-tail l (- n 1)) l)))
+
+(define list-0 (list 1 2 3 4))
+(define vect-0 (vector 1 2 3 4))
+(define let-0 (inlet :a 1 :b 2))
+(define hash-0 (hash-table* :a 1 :b 2))
+
+(define list-1 (make-circular-list 1))
+(set-car! list-1 #t)
+(define hash-1 (hash-table* :a list-1))
+(define vect-1 (vector list-1))
+(define let-1 (inlet :a list-1))
+(define list-2 (list list-1 list-1))
+(define list-3 (make-circular-list 3))
+(define vect-2 (let ((z (vector 1 2)))
+ (let ((y (list 1 z 2)))
+ (let ((x (hash-table (cons 'x y))))
+ (set! (z 1) x)
+ z))))
+(define vect-3 (let ((x '(1 2)))
+ (let ((y (list x x)))
+ (let ((z (vector x y)))
+ z))))
+(define vect-4 (let ((v (vector 1 2 3 4)))
+ (let ((lst (list 1 2)))
+ (set-cdr! (cdr lst) lst)
+ (set! (v 0) v)
+ (set! (v 3) lst))))
+(define hash-2 (let ((h1 (make-hash-table 11)))
+ (hash-table-set! h1 "hi" h1)))
+(define list-4 (let ()
+ (define make-node list)
+ (define prev (dilambda (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val))))
+ (define next (dilambda (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val))))
+ ;(define data (dilambda (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val))))
+ (let* ((head (make-node () 0 ()))
+ (cur head))
+ (do ((i 1 (+ i 1)))
+ ((= i 8))
+ (let ((next-node (make-node cur i ())))
+ (set! (next cur) next-node)
+ (set! cur (next cur))))
+ (set! (next cur) head)
+ (set! (prev head) cur)
+ head)))
+
+(define let-2 (let ((hi 3))
+ (let ((e (curlet)))
+ (set! hi (curlet))
+ e)))
+(define let-3 (let ((e (inlet 'a 0 'b 1)))
+ (let ((e1 (inlet 'a e)))
+ (set! (e 'b) e1)
+ e)))
+(define let-4 (inlet :a vect-0 :b list-0))
+(define hash-3 (hash-table* :a vect-0 :b list-0))
+(define hash-4 (hash-table* :a hash-1))
+
+(define-constant vars (vector list-0 list-1 list-2 list-3 list-4
+ vect-0 vect-1 vect-2 vect-3 vect-4
+ hash-0 hash-1 hash-2 hash-3 hash-4
+ let-0 let-1 let-2 let-3 let-4))
+
+;(format *stderr* "~A ~A ~A ~A ~A~%" (length hash-0) (length hash-1) (length hash-2) (length hash-3) (length hash-4))
+
+(set! (*s7* 'initial-string-port-length) 64)
+
+(define (tests size)
+ (let ((str #f)
+ (p (open-output-string))
+ (iter #f))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! iter (make-iterator vars))
+ (do ((j 0 (+ j 1))
+ (vj (iterate iter) (iterate iter)))
+ ((= j 20))
+ (do ((k 0 (+ k 1)))
+ ((= k 20))
+ (if (equal? vj (vector-ref vars k))
+ (if (not (= j k))
+ (format *stderr* "oops! (~D ~D): ~A ~A~%" j k vj (vector-ref vars k)))))
+ ;;(display "oops"))))
+ (write vj p)
+ (set! str (get-output-string p #t))
+ (set! str (object->string vj))
+ (set! str (format #f "~A~%" vj))
+ (set! str (cyclic-sequences vj))))
+ (close-output-port p)))
+
+#|
+(define (tests size)
+ (let ((str #f)
+ (vj #f)
+ (p (open-output-string)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (do ((a vars (cdr a)))
+ ((null? a))
+ (set! vj (car a))
+ (do ((b vars (cdr b)))
+ ((null? b))
+ (if (equal? vj (car b))
+ (if (not (eq? a b))
+ (format *stderr* "oops!: ~A ~A~%" a b))))
+ (write vj p)
+ (set! str (get-output-string p #t))
+ (set! str (object->string vj))
+ (set! str (format #f "~A~%" vj))
+ (set! str (cyclic-sequences vj))))
+ (close-output-port p)))
+
+;; almost as fast
+(define (tests size)
+ (let ((str #f)
+ (p (open-output-string))
+ (k 0) (j 0))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (set! k 0)
+ (for-each
+ (lambda (vj)
+ (set! j 0)
+ (for-each
+ (lambda (w)
+ (if (equal? vj w)
+ (if (not (= j k))
+ (format *stderr* "oops! (~D ~D): ~A ~A~%" j k vj w)))
+ (set! j (+ j 1)))
+ vars)
+ (set! k (+ k 1))
+ (write vj p)
+ (set! str (get-output-string p #t))
+ (set! str (object->string vj))
+ (set! str (format #f "~A~%" vj))
+ (set! str (cyclic-sequences vj)))
+ vars))
+ (close-output-port p)))
+|#
+
+
+(tests 10000)
+
+(s7-version)
+(exit)
+
+
diff --git a/tools/testsnd b/tools/testsnd
index f4f038f..bc50f22 100755
--- a/tools/testsnd
+++ b/tools/testsnd
@@ -1,462 +1,455 @@
#!/bin/csh -f
-echo ' -------------------------------- basic configure test -------------------------------- '
+cp tools/ffitest.c .
+
+echo ' -------------------------------- without-gui -------------------------------- '
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall" '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
-make allclean
+./configure --quiet CFLAGS="-Wall -I/usr/local/include" --without-gui
make
echo ' '
echo ' '
-make xm
+./snd --version
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test without-gui (also s7test) -------------------------------- '
echo ' '
echo ' '
-./snd --version
-./snd -l snd-test 0
-make clmclean
-make sndinfo
-./sndinfo oboe.snd
-make audinfo
-./audinfo
-make sndplay
-./sndplay oboe.snd
+./snd -noinit s7test.scm
+./snd lint.scm -e '(begin (lint "s7test.scm" #f) (exit))'
-echo ' -------------------------------- basic configure -------------------------------- '
-make allclean
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
+valgrind ./snd -noinit -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was valgrind without-gui (also s7test) -------------------------------- '
+echo ' '
+echo ' '
+
+gcc s7.c -o repl -DWITH_MAIN -DUSE_SND=0 -I. -O2 -g -Wl,-export-dynamic -ldl -lm
+./repl tools/tauto.scm
+
+echo ' '
+echo ' '
+echo ' -------------------------------- that was s7 tauto -------------------------------- '
+echo ' '
+echo ' '
+
+echo ' -------------------------------- without-gui sanitized -------------------------------- '
+rm -f snd
+rm -f config.cache
+./configure --quiet CFLAGS="-g3 -Wall -I/usr/local/include -Wbool-compare -Wsign-compare -fsanitize=bounds -fsanitize=address -fsanitize=undefined" --without-gui
make
-make xm
+echo ' '
+echo ' '
./snd --version
-./snd -l snd-test 0
-make allclean
+./snd s7test.scm
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test without-gui sanitized?? -------------------------------- '
+echo ' '
+echo ' '
-echo ' -------------------------------- with-no-gui -------------------------------- '
+echo ' -------------------------------- without-gui DEBUGGING=1 -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-no-gui '
-./configure --quiet CFLAGS="-Wall" --with-no-gui
+./configure --quiet CFLAGS="-Wall -I/usr/local/include -DDEBUGGING" --without-gui --disable-deprecated
make
echo ' '
echo ' '
./snd --version
-make xm
-./snd -l snd-test 2
-./snd -l snd-test 28
+./snd -l snd-test
+./snd lint.scm -e '(begin (lint "s7test.scm" #f) (exit))'
+
+cp s7test.scm tmptest.scm
+./snd tools/sed.scm -e '(sed "tmptest.scm" "tmp" "(define full-test #f)" "(define full-test #t)")'
+mv tmp tmptest.scm
+./snd tmptest.scm
-echo ' -------------------------------- with-no-gui/ladspa -------------------------------- '
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test without-gui debugging disable deprecated -------------------------------- '
+echo ' '
+echo ' '
+
+echo ' -------------------------------- pure-s7 -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall" --with-no-gui --without-ladspa '
-./configure --quiet CFLAGS="-Wall" --with-no-gui --without-ladspa
+./configure --quiet CFLAGS="-Wall -I/usr/local/include -DWITH_PURE_S7=1" --without-gui --disable-deprecated
make
echo ' '
echo ' '
./snd --version
-./snd -l snd-test 3
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test pure-s7 -------------------------------- '
+echo ' '
+echo ' '
-echo ' -------------------------------- gtk -------------------------------- '
+echo ' -------------------------------- no opt -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall" --with-gtk '
-./configure --quiet CFLAGS="-Wall" --with-gtk
+./configure --quiet CFLAGS="-Wall -I/usr/local/include -DWITH_OPTIMIZATION=0" --without-gui --disable-deprecated
make
-make xg
echo ' '
echo ' '
-./snd --version 2
-./snd --version 8
-make xg
-./snd -l snd-test 10
-rm xg.o
-echo ' CC=g++ CFLAGS="-Wall" --with-gtk '
-./configure --quiet CC=g++ CFLAGS="-Wall" --with-gtk --disable-deprecated
-make xg
-make allclean
-echo ' CC=g++ --with-gtk CFLAGS="-Wall" '
-./configure --quiet CC=g++ --with-gtk CFLAGS="-Wall"
-make
-make xg
./snd --version
-./snd -l snd-test 9
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test without optimization -------------------------------- '
+echo ' '
+echo ' '
-echo ' -------------------------------- static gsl -------------------------------- '
+echo ' -------------------------------- no choosers -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-static-gsl '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-static-gsl LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet CFLAGS="-Wall -I/usr/local/include -DWITHOUT_CHOOSERS=1" --without-gui --disable-deprecated
make
-make xm
echo ' '
echo ' '
./snd --version
-./snd -l snd-test 6
-
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test without choosers -------------------------------- '
echo ' '
-date
-echo ' -------------------------------- configure --with-doubles test -------------------------------- '
+echo ' '
+
+echo ' -------------------------------- without-gui CC=g++ --disable-deprecated -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-doubles '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-doubles LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet CFLAGS="-Wall -DWITH_EXTRA_EXPONENT_MARKERS=1 -DWITH_QUASIQUOTE_VECTOR=1" --without-gui --disable-deprecated CC=g++
make
-make xm
echo ' '
echo ' '
./snd --version
./snd -l snd-test
-echo ' -------------------------------- that was full snd-test with-doubles -------------------------------- '
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test g++/disable-deprecated -------------------------------- '
+echo ' '
+echo ' '
+valgrind ./snd -l snd-test
+echo ' '
echo ' '
+echo ' -------------------------------- that was valgrind g++ -------------------------------- '
echo ' '
-date
-echo ' -------------------------------- configure --with-float-samples test -------------------------------- '
+echo ' '
+
+echo ' -------------------------------- without-gui --with-gmp -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-float-samples --without-ladspa --with-gl --without-gsl '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-float-samples --without-ladspa --with-gl --without-gsl LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet CFLAGS="-Wall" --without-gui --with-gmp --disable-deprecated
make
-make xm
echo ' '
echo ' '
./snd --version
-./snd -l snd-test 9
-./snd -l snd-test 20
-make clmclean
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test --with-gmp -------------------------------- '
+echo ' '
+echo ' '
+
+# valgrind ./snd -l snd-test
+# echo ' '
+# echo ' '
+# echo ' -------------------------------- that was valgrind --with-gmp -------------------------------- '
+# echo ' '
+# echo ' '
+
+# gcc s7.c -o repl -DWITH_MAIN -I. -O2 -g -Wl,-export-dynamic -ldl -lm -lgmp -lmpfr -lmpc
+# ./repl tools/tauto.scm
+
-echo ' -------------------------------- configure --with-sample-width=32 test -------------------------------- '
+echo ' -------------------------------- without-gui --with-gmp debugging -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-sample-width=32 --with-just-gl --with-static-motif --without-fftw '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-sample-width=32 --with-just-gl --with-static-motif --without-fftw LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet CFLAGS="-Wall -DDEBUGGING=1" --without-gui --with-gmp --disable-deprecated
make
-make xm
echo ' '
echo ' '
./snd --version
-./snd -l snd-test 3
-
+./snd -l snd-test
+echo ' '
echo ' '
+echo ' -------------------------------- that was snd-test --with-gmp debugging -------------------------------- '
echo ' '
-date
-echo ' -------------------------------- configure --with-sample-width=28 test -------------------------------- '
+echo ' '
+
+
+echo ' -------------------------------- motif -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-sample-width=28 '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-sample-width=28 LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet --with-motif CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
make
-make xm
echo ' '
echo ' '
./snd --version
-./snd -l snd-test 9
+./snd -l snd-test 23
+./snd -noinit -l snd-test
+make clmclean
+make sndinfo
+./sndinfo oboe.snd
+make sndplay
+./sndplay oboe.snd
+echo ' '
+echo ' '
+echo ' -------------------------------- that was motif? and test 23 -------------------------------- '
+echo ' '
+echo ' '
+valgrind ./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was valgrind --with-motif? -------------------------------- '
echo ' '
echo ' '
-date
-echo ' -------------------------------- configure --with-sample-width=16 test -------------------------------- '
+
+echo ' -------------------------------- motif + gl -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-rm -f makefile
-rm -f mus-config.h
-rm -f sndinfo
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-sample-width=16 '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-sample-width=16 LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet --with-gl --with-motif CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
make
-make xm
echo ' '
echo ' '
./snd --version
-./snd -l snd-test 10
+./snd -l snd-test 24
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was motif? and gl -------------------------------- '
+echo ' '
+echo ' '
+
+valgrind ./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was valgrind --with-motif and gl -------------------------------- '
+echo ' '
+echo ' '
-echo ' -------------------------------- configure --with-gtk test -------------------------------- '
+echo ' -------------------------------- motif + gl + debug -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall" --with-gtk '
-./configure --quiet CFLAGS="-Wall" --with-gtk
+./configure --quiet --with-gl --with-motif CFLAGS="-DDEBUGGING -Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
make
-make xg
echo ' '
echo ' '
./snd --version
-./snd -l snd-test 7
+./snd -l snd-test 24
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was motif? and gl and debugging -------------------------------- '
+echo ' '
+echo ' '
+
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall" --with-gtk '
-./configure --quiet CFLAGS="-Wall" --with-gtk
+./configure --without-gui --quiet CC=/home/bil/test/llvm-3.1.src/build/Release+Asserts/bin/clang CFLAGS="-Wall" LDFLAGS="-Wl,-export-dynamic"
make
-make xg
+./snd --version
+./snd -l snd-test
echo ' '
echo ' '
-./snd --version
-./snd -l snd-test 8
+echo ' -------------------------------- that was clang? -------------------------------- '
+echo ' '
+echo ' '
+
+
+echo ' -------------------------------- with-gtk -------------------------------- '
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall" --with-gtk --with-static-xm '
-./configure --quiet CFLAGS="-Wall" --with-gtk --with-static-xm
+./configure --quiet CFLAGS="-Wall" --with-gtk --disable-deprecated
make
echo ' '
echo ' '
./snd --version
-./snd -l snd-test
-echo ' -------------------------------- that was full snd-test with-gtk -------------------------------- '
-make allclean
-echo ' CFLAGS="-Wall -DGTK_DISABLE_DEPRECATED -DG_DISABLE_DEPRECATED -DGDK_DISABLE_DEPRECATED" --with-gtk --with-static-xm '
-./configure --quiet --disable-deprecated CFLAGS="-Wall" --with-gtk --with-static-xm
-make
-./snd --version
-./snd -l snd-test 11
+./snd tools/va.scm
+./snd -noinit -l snd-test
+echo ' '
echo ' '
+echo ' -------------------------------- that was snd-test --with-gtk -------------------------------- '
echo ' '
-date
-echo ' -------------------------------- motif test -------------------------------- '
+echo ' '
+
+# echo ' -------------------------------- valgrind --with-gtk takes forever! -------------------------------- '
+# valgrind ./snd -l snd-test
+# echo ' '
+# echo ' '
+# echo ' -------------------------------- that was valgrind --with-gtk -------------------------------- '
+# echo ' '
+# echo ' '
+
+echo ' -------------------------------- with-gtk + debug -------------------------------- '
make allclean
rm -f snd
-rm -f sndinfo
-rm -f audinfo
rm -f config.cache
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --enable-snd-debug --with-gsl '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --enable-snd-debug --with-gsl LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet CFLAGS="-DDEBUGGING -Wall" --with-gtk --disable-deprecated
make
-make xm
echo ' '
echo ' '
-./snd --version
-./snd -l snd-test 2
-make allclean
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-static-xm '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-static-xm LDFLAGS="-L/usr/X11R6/lib"
-make
-./snd --version
./snd -l snd-test
-echo ' -------------------------------- that was full snd-test with-motif -------------------------------- '
-rm xm.o
-echo ' CC=g++ --with-static-xm '
-./configure --quiet CC=g++ --with-static-xm CFLAGS="-I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
-make xm
-./snd --version
-./snd -l snd-test 12
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test --with-gtk + debug -------------------------------- '
+echo ' '
+echo ' '
+
+cp snd-test.scm orig-snd-test.scm
+./snd tools/sed.scm -e '(sed "snd-test.scm" "tmp" "(define tests 1)" "(define tests 5)")'
+# sed snd-test.scm -e 's/(define tests 1)/(define tests 5)/g' > tmp
+# sed differs so much between systems that it is useless
+mv tmp snd-test.scm
+echo ' -------------------------------- without-gui -------------------------------- '
make allclean
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-static-xm '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-static-xm LDFLAGS="-L/usr/X11R6/lib"
+rm -f snd
+rm -f config.cache
+./configure --quiet CFLAGS="-Wall" --without-gui
make
+echo ' '
+echo ' '
./snd --version
-./snd -l snd-test 8
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test mult without-gui -------------------------------- '
+echo ' '
+echo ' '
+valgrind ./snd -l snd-test
echo ' '
echo ' '
-date
-echo ' -------------------------------- snd-as-widget test -------------------------------- '
-make allclean
-rm -f snd
-rm -f config.cache
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-snd-as-widget '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-snd-as-widget --without-fam --without-gsl LDFLAGS="-L/usr/X11R6/lib"
-make
-make xm
-gcc -c saw.c -I. -g -O2 -I/usr/local/include -I/usr/X11R6/include -o saw.o
-gcc saw.o snd_widget.o -o saw -L/usr/X11R6/lib -lSM -lICE -lXm -lXt -lXp -lX11 -lXext -lXpm -L/usr/local/lib -lfftw3 -lm
+echo ' -------------------------------- that was valgrind mult -------------------------------- '
echo ' '
echo ' '
-date
-echo ' -------------------------------- gtk test -------------------------------- '
-make allclean
-rm -f snd
-rm -f config.cache
-echo ' CFLAGS="-Wall" --enable-snd-debug --with-gtk --with-gsl '
-./configure --quiet CFLAGS="-Wall" --enable-snd-debug --with-gtk --with-gsl
-make
-make xg
+
+
+cp orig-snd-test.scm snd-test.scm
+./snd tools/sed.scm -e '(sed "snd-test.scm" "tmp" "(define test-at-random 0)" "(define test-at-random 100)")'
+# sed snd-test.scm -e 's/(define test-at-random 0)/(define test-at-random 100)/g' > tmp
+mv tmp snd-test.scm
+
echo ' '
echo ' '
./snd --version
-./snd -l snd-test 14
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test at-random without-gui -------------------------------- '
+echo ' '
+echo ' '
+valgrind ./snd -l snd-test
echo ' '
echo ' '
-date
-echo ' -------------------------------- ruby test (Motif) -------------------------------- '
-make allclean
-rm -f snd
-rm -f config.cache
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby LDFLAGS="-L/usr/X11R6/lib"
-make
-make xm
+echo ' -------------------------------- that was valgrind at-random -------------------------------- '
echo ' '
echo ' '
-make xm
+
+
+cp orig-snd-test.scm snd-test.scm
+./snd tools/sed.scm -e '(sed "snd-test.scm" "tmp" "(define all-args #f)" "(define all-args #t)")'
+# sed snd-test.scm -e 's/(define all-args #f)/(define all-args #t)/g' > tmp
+mv tmp snd-test.scm
+
echo ' '
echo ' '
./snd --version
-# ./snd -l snd-test.rb -- libxm problem here stops entire sequence
-make allclean
-echo ' CC=g++ CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby '
-./configure --quiet CC=g++ CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby LDFLAGS="-L/usr/X11R6/lib"
-make
-make xm
-make allclean
-echo ' CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby --with-static-xm --with-gl --enable-snd-debug '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" --with-ruby --with-static-xm --with-gl --enable-snd-debug LDFLAGS="-L/usr/X11R6/lib"
-make
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test full without-gui -------------------------------- '
+echo ' '
+echo ' '
+
+valgrind ./snd -l snd-test
+echo ' '
echo ' '
+echo ' -------------------------------- that was valgrind full -------------------------------- '
echo ' '
-echo ' -------------------------------- ruby test (Gtk) -------------------------------- '
+echo ' '
+
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall" --with-ruby --with-gtk '
-./configure --quiet CFLAGS="-Wall" --with-ruby --with-gtk
+./configure --quiet CFLAGS="-Wall" CC=g++
make
-make xg
echo ' '
echo ' '
./snd --version
-make allclean
-echo ' CC=g++ --with-ruby --with-gtk '
-./configure --quiet CC=g++ --with-ruby --with-gtk
-make
-make xg
-echo ' '
+./snd -l snd-test
echo ' '
-make allclean
-echo ' CFLAGS="-Wall" --with-ruby --with-static-xm --with-gtk --enable-snd-debug --without-gsl '
-./configure --quiet CFLAGS="-Wall" --with-ruby --with-static-xm --with-gtk --enable-snd-debug --without-gsl
-make
echo ' '
+echo ' -------------------------------- that was snd-test full g++ -------------------------------- '
echo ' '
-./snd --version
-make allclean
-echo ' CFLAGS="-Wall -DGTK_DISABLE_DEPRECATED -DG_DISABLE_DEPRECATED -DGDK_DISABLE_DEPRECATED" --with-ruby --with-static-xm --with-gtk '
-./configure --quiet --disable-deprecated CFLAGS="-Wall" --with-ruby --with-static-xm --with-gtk
-make
echo ' '
-echo ' -------------------------------- ruby test (no gui) -------------------------------- '
+
make allclean
rm -f snd
rm -f config.cache
-echo ' CFLAGS="-Wall" --with-ruby --with-no-gui --without-fftw '
-./configure --quiet CFLAGS="-Wall" --with-ruby --with-no-gui --without-fftw
+./configure --quiet CFLAGS="-Wall" --with-gtk --with-ladspa --without-audio
make
echo ' '
echo ' '
./snd --version
-make allclean
-echo ' CFLAGS="-Wall" --with-ruby --with-no-gui --enable-snd-debug '
-./configure --quiet CFLAGS="-Wall" --with-ruby --with-no-gui --enable-snd-debug
-make
+./snd -l snd-test
echo ' '
echo ' '
-./snd --version
-make allclean
-echo ' CC=g++ CFLAGS="-Wall" --with-ruby --with-no-gui --enable-snd-debug '
-./configure --quiet CC=g++ CFLAGS="-Wall" --with-ruby --with-no-gui --enable-snd-debug
-make
-
+echo ' -------------------------------- that was snd-test full gtk ladspa-------------------------------- '
echo ' '
echo ' '
-date
-echo ' -------------------------------- g++ test -------------------------------- '
+
make allclean
rm -f snd
rm -f config.cache
-echo ' CC=g++ CFLAGS="-Wall -I/usr/X11R6/include" '
-./configure --quiet CC=g++ CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
+./configure --quiet CFLAGS="-Wall" --with-gmp --without-gui
make
-make xm
-make sndinfo
-make audinfo
-make sndplay
-./audinfo
-./sndinfo test.snd
-./snd --version
-./snd -l snd-test 16
-make allclean
echo ' '
echo ' '
-echo ' CC=g++ --with-gtk '
-./configure --quiet CC=g++ --with-gtk
-make
-make xg
./snd --version
-./snd -l snd-test 17
-./snd -l snd-test 20
-make allclean
+./snd -l snd-test
echo ' '
echo ' '
-echo ' CC=g++ --with-no-gui '
-./configure --quiet CC=g++ --with-no-gui
-make
-./snd --version
-./snd -l snd-test 6
-make allclean
+echo ' -------------------------------- that was snd-test full gmp -------------------------------- '
echo ' '
echo ' '
-date
-echo ' -------------------------------- sndlib test -------------------------------- '
+
+./snd tools/sed.scm -e '(sed "snd-test.scm" "tmp" "(define tests 1)" "(define tests 7)")'
+# sed snd-test.scm -e 's/(define tests 1)/(define tests 7)/g' > tmp
+mv tmp snd-test.scm
+
make allclean
rm -f snd
rm -f config.cache
-rm -f sndinfo
-rm -f audinfo
-echo ' CFLAGS="-Wall" '
-./configure --quiet CFLAGS="-Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
-make sndinfo
-./sndinfo oboe.snd
-make audinfo
-./audinfo
-
+./configure --quiet CFLAGS="-Wall" --without-gui
+make
echo ' '
echo ' '
-date
-echo ' -------------------------------- no-gui test -------------------------------- '
-make allclean
-rm -f snd
-echo ' CFLAGS="-Wall" --with-no-gui '
-./configure --quiet CFLAGS="-Wall" --with-no-gui
-make
-./snd --version
-./snd -l snd-test 20
-./snd -l snd-test 8
+./snd -l snd-test
+echo ' '
+echo ' '
+echo ' -------------------------------- that was snd-test full mult no-gui -------------------------------- '
echo ' '
echo ' '
-date
-make allclean
-echo ' --with-static-xm CFLAGS="-DXM_DISABLE_DEPRECATED -Wall -I/usr/X11R6/include" '
-./configure --quiet --with-static-xm CFLAGS="-DXM_DISABLE_DEPRECATED -Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
-./snd --version
-./snd -l snd-test 28
-make
-make allclean
-echo ' --with-static-xm --with-ruby CFLAGS="-DXM_DISABLE_DEPRECATED -Wall -I/usr/X11R6/include" '
-./configure --quiet --with-static-xm --with-ruby CFLAGS="-DXM_DISABLE_DEPRECATED -Wall -I/usr/X11R6/include" LDFLAGS="-L/usr/X11R6/lib"
-make
-make allclean
+cp orig-snd-test.scm snd-test.scm
diff --git a/tools/tform.scm b/tools/tform.scm
new file mode 100644
index 0000000..e2cc8b3
--- /dev/null
+++ b/tools/tform.scm
@@ -0,0 +1,126 @@
+(let ((new-env (sublet (curlet) (cons 'init_func 'block_init)))) ; load calls init_func if possible
+ (load "s7test-block.so" new-env))
+
+(load "mockery.scm")
+
+(define-constant one 1)
+
+(define mock-number (*mock-number* 'mock-number))
+(define mock-pair (*mock-pair* 'mock-pair))
+(define mock-string (*mock-string* 'mock-string))
+(define mock-char (*mock-char* 'mock-char))
+(define mock-vector (*mock-vector* 'mock-vector))
+(define mock-symbol (*mock-symbol* 'mock-symbol))
+(define mock-hash-table* (*mock-hash-table* 'mock-hash-table*))
+
+(define np (list 0 1 2 3 4))
+(define mp (mock-pair '(0 1 2 3 4)))
+(define nv (vector 0 1 2 3 4))
+(define mv (mock-vector 0 1 2 3 4))
+(define ns "01234")
+(define ms (mock-string #\0 #\1 #\2 #\3 #\4))
+
+;;(openlet (inlet 'i 0 'list-set! (lambda (l . args) (apply #_list-set! l ((car args) 'i) (cdr args))))))
+
+(define-constant constants (vector #f #t () #\a (/ most-positive-fixnum) (/ -1 most-positive-fixnum) 1.5+i
+ "hi455" :key hi: 'hi (list 1) (list 1 2) (cons 1 2) (list (list 1 2)) (list (list 1)) (list ()) #()
+ 1/0+i 0+0/0i 0+1/0i 1+0/0i 0/0+0i 0/0+0/0i 1+1/0i 0/0+i cons ''2
+ 1+i 1+1e10i 1e15+1e15i 0+1e18i 1e18 (integer->char 255) (string (integer->char 255)) 1e308
+ most-positive-fixnum most-negative-fixnum (- most-positive-fixnum 1) (+ most-negative-fixnum 1)
+ -1 0 0.0 1 1.5 1.0-1.0i 3/4 #\null -63 (make-hash-table) (hash-table '(a . 2) '(b . 3))
+ '((1 2) (3 4)) '((1 (2)) (((3) 4))) "" (list #(1) "1") '(1 2 . 3) (list (cons 'a 2) (cons 'b 3))
+ #(1 2) (vector 1 '(3)) (let ((x 3)) (lambda (y) (+ x y))) abs 'a 'b one apply
+ (lambda args args) (lambda* ((a 3) (b 2)) (+ a b)) (lambda () 3)
+ (sublet () (cons 'a 1)) (rootlet)
+ *load-hook* *error-hook* (random-state 123)
+ quasiquote macroexpand cond-expand begin let letrec* if case cond (call-with-exit (lambda (goto) goto))
+ (with-baffle (call/cc (lambda (cc) cc)))
+ (string #\a #\null #\b) #2d((1 2) (3 4)) (inlet 'a 2 'b 3)
+ #<undefined> #<unspecified> (make-vector 3 0 #t) (make-vector 3 -1.4 #t)
+ (make-vector '(2 3) "hi") #("hiho" "hi" "hoho") (make-shared-vector (make-vector '(2 3) 1 #t) '(6))
+ (make-shared-vector (make-shared-vector (make-vector '(2 3) 1.0 #t) '(6)) '(2 2))
+ (vector-ref #2d((#(1 2 3)) (#(3 4 5))) 0 0) (define-macro (m a) `(+ ,a 1))
+ (c-pointer 0) (c-pointer -1) :readable *s7* else (define-bacro* (m (a 1)) `(+ ,a 1))
+ (byte-vector 0 1 2) (byte-vector) (byte-vector 255 0 127) (make-iterator (vector '(a . 2)))
+ (lambda (dir) 1.0) (float-vector) (make-float-vector '(2 32)) (int-vector 1 2 3) (int-vector)
+ (inlet 'value 1 '+ (lambda args 1)) (inlet) (make-iterator (inlet 'a 1 'b 2) (cons #f #f))
+ (make-iterator "123456") (make-iterator '(1 2 3)) (make-iterator (hash-table* 'a 1 'b 2) (cons #f #f))
+ (open-input-string "123123") (open-input-file "/home/bil/cl/4.aiff")
+ (open-output-file "test.test") (open-output-string)
+
+ (mock-number 0) (mock-number 2) (mock-number 1-i) (mock-number 4/3) (mock-number 2.0)
+ (mock-string #\h #\o #\h #\o)
+ (mock-pair '(2 3 4))
+ (mock-char #\b)
+ (mock-symbol 'c)
+ (mock-vector 1 2 3 4)
+ (mock-hash-table* 'b 2)
+
+ (make-block 32) (block) (make-iterator (block 1 2 3 4 5 6))
+ ))
+(define-constant constants-len (length constants))
+
+(define-constant ctrl-chars (string ;#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\W
+ #\, #\{ #\} #\@ #\P #\*
+ #\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\n #\w
+ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+ #\~ #\T #\& #\% #\^ #\|
+ #\~ #\~ #\~ #\~
+ #\, #\, #\, #\, #\" #\" #\\ #\'
+ #\+ #\- #\@ #\. #\/ #\; #\:
+ ))
+(define-constant ctrl-chars-len (length ctrl-chars))
+
+(define (test-chars)
+ (let ((op (open-output-string))
+ (x #f) (y #f) (z #f))
+ (do ((size 2 (+ size 1)))
+ ((= size 15))
+ (let ((tries (* size 2000))
+ (size1 (+ size 1)))
+ (format *stderr* "~D " size)
+ (let ((ctrl-str (make-string size1))
+ (pos 0))
+ (string-set! ctrl-str 0 #\~)
+ (do ((i 0 (+ i 1)))
+ ((= i tries))
+ (do ((j 1 (+ j 1)))
+ ((= j size1))
+ (string-set! ctrl-str j (string-ref ctrl-chars (random ctrl-chars-len))))
+
+ (set! x (constants (random constants-len)))
+ (set! y (constants (random constants-len)))
+ (set! z (constants (random constants-len)))
+
+ (object->string x)
+ (display x op)
+
+ (catch #t (lambda () (format #f "~{~^~S ~} ~{~|~S ~} ~W" x y z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str x)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str y)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str z)) (lambda arg 'error))
+ (set! pos (char-position #\~ ctrl-str 1))
+ (when pos
+ (catch #t (lambda () (format #f ctrl-str x z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str x y)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str y z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str z x)) (lambda arg 'error))
+ (when (char-position #\~ ctrl-str (+ pos 1))
+ (catch #t (lambda () (format #f ctrl-str x y z)) (lambda arg 'error))
+ (catch #t (lambda () (format #f ctrl-str z y x)) (lambda arg 'error))))))
+ (get-output-string op #t)))
+ (close-output-port op)))
+
+(test-chars)
+
+(s7-version)
+
+(exit)
+
+#|
+valgrind --vgdb=yes --vgdb-error=0 repl
+gdb repl
+ target remote | /usr/local/lib/valgrind/../../bin/vgdb
+ continue
+|#
diff --git a/tools/tgen.scm b/tools/tgen.scm
new file mode 100644
index 0000000..57efa4a
--- /dev/null
+++ b/tools/tgen.scm
@@ -0,0 +1,711 @@
+(if (and (not (provided? 'snd))
+ (not (provided? 'sndlib)))
+ (begin
+ (format *stderr* "tgen depends on sndlib...~%")
+ (system "./snd -noinit tgen.scm")
+ (exit)))
+
+(if (provided? 'snd)
+ (begin
+ (load "ws.scm")
+ (load "hooks.scm")
+ (reset-all-hooks)
+ (set! (auto-update) #f)
+ (set! (auto-update-interval) 0.0)
+ (set! *to-snd* #f))
+ (load "sndlib-ws.scm"))
+
+(load "generators.scm")
+
+(set! *clm-file-buffer-size* 16)
+(set! *clm-table-size* 16)
+(set! *clm-clipped* #f)
+;(set! (*s7* 'gc-stats) #t)
+
+(define start-run (get-internal-real-time))
+(define M (float-vector 0 0 1 10))
+(define P (float-vector 0 0 1 1))
+
+(set! (*s7* 'initial-string-port-length) 8192)
+
+(mus-sound-preload "1a.snd")
+
+(define* (env-1 g f) (env g))
+(define (make-env-1 size) (make-env M :length 10))
+
+(define pulsed-env-1 pulsed-env)
+(define (make-pulsed-env-1 size) (make-pulsed-env P .01 1000.0))
+
+(define delay-1 delay)
+(define (make-delay-1 size) (make-delay 4))
+
+(define comb-1 comb)
+(define (make-comb-1 size) (make-comb .9 4))
+
+(define filtered-comb-1 filtered-comb)
+(define (make-filtered-comb-1 size) (make-filtered-comb .9 4))
+
+(define notch-1 notch)
+(define (make-notch-1 size) (make-notch .9 4))
+
+(define all-pass-1 all-pass)
+(define (make-all-pass-1 size) (make-all-pass .9 .4 4))
+
+(define one-pole-all-pass-1 one-pole-all-pass)
+(define (make-one-pole-all-pass-1 size) (make-one-pole-all-pass 4 .5))
+
+(define moving-average-1 moving-average)
+(define (make-moving-average-1 size) (make-moving-average 4))
+
+(define moving-max-1 moving-max)
+(define (make-moving-max-1 size) (make-moving-max 3))
+
+(define moving-norm-1 moving-norm)
+(define (make-moving-norm-1 size) (make-moving-norm 3))
+
+(define one-pole-1 one-pole)
+(define (make-one-pole-1 size) (make-one-pole .9 .4))
+
+(define two-pole-1 two-pole)
+(define (make-two-pole-1 size) (make-two-pole .9 .4 .1))
+
+(define one-zero-1 one-zero)
+(define (make-one-zero-1 size) (make-one-zero .9 .4))
+
+(define two-zero-1 two-zero)
+(define (make-two-zero-1 size) (make-two-zero .9 .4 .1))
+
+(define table-lookup-1 table-lookup)
+(define table-lookup-table (partials->wave '(1 1.0)))
+(define (make-table-lookup-1 size) (make-table-lookup 16 :wave table-lookup-table))
+
+(define formant-1 formant)
+(define (make-formant-1 size) (make-formant size .1))
+
+(define firmant-1 firmant)
+(define (make-firmant-1 size) (make-firmant size .1))
+
+(define fx (float-vector .1 -.2 .3))
+(define fy (float-vector -.1 .02 -.3))
+
+(define filter-1 filter)
+(define (make-filter-1 size) (make-filter 3 fx fy))
+
+(define fir-filter-1 fir-filter)
+(define (make-fir-filter-1 size) (make-fir-filter 3 fx))
+
+(define iir-filter-1 iir-filter)
+(define (make-iir-filter-1 size) (make-iir-filter 3 fx))
+
+(define readin-1 readin)
+(define (make-readin-1 size) (make-readin "1a.snd"))
+
+(define (io dir) .1)
+(define src-1 src)
+(define (make-src-1 size) (make-src io 2.0))
+
+(define granulate-1 granulate)
+(define (make-granulate-1 size) (make-granulate io 2.0 0.001 0.6 0.001 .4 0.0))
+
+(define phase-vocoder-1 phase-vocoder)
+(define (make-phase-vocoder-1 size) (make-phase-vocoder io 16))
+
+(define ssb-am-1 ssb-am)
+(define (make-ssb-am-1 size) (make-ssb-am 100.0 20))
+
+(define wave-train-1 wave-train)
+(define wt-train (make-float-vector 20 0.1))
+(define (make-wave-train-1 size) (make-wave-train 1000.0 0.0 wt-train))
+
+(define convolve-1 convolve)
+(define (make-convolve-1 size) (make-convolve io (make-float-vector 16 .2) 16))
+
+(define oscil-bank-1 oscil-bank)
+(define ob-freqs (float-vector 100.0 200.0))
+(define ob-amps (float-vector 0.5 0.5))
+(define (make-oscil-bank-1 size) (make-oscil-bank ob-freqs (float-vector 0.0 0.0) ob-amps))
+
+(define formant-bank-1 formant-bank)
+(define (make-formant-bank-1 size) (make-formant-bank (vector (make-formant 440.0 .95))))
+
+(define comb-bank-1 comb-bank)
+(define (make-comb-bank-1 size) (make-comb-bank (vector (make-comb .5 6))))
+
+(define filtered-comb-bank-1 filtered-comb-bank)
+(define (make-filtered-comb-bank-1 size) (make-filtered-comb-bank (vector (make-filtered-comb .5 6))))
+
+(define all-pass-bank-1 all-pass-bank)
+(define (make-all-pass-bank-1 size) (make-all-pass-bank (vector (make-all-pass .5 .4 6))))
+
+(define rand-1 rand)
+(define (make-rand-1 size) (set! (mus-rand-seed) 12345) (make-rand 5.0 0.1))
+
+(define rand-interp-1 rand-interp)
+(define (make-rand-interp-1 size) (set! (mus-rand-seed) 12345) (make-rand-interp 5.0 0.1))
+
+
+;;; we are creating millions of functions here, so we need to keep them from
+;;; being removed from the heap, and make sure they're GC'd -- *safety*=1
+;;; keeps them in the heap, but s7 continues to allocate space for each redefinition,
+;;; hence the extra let below.
+
+
+(define-constant (vequal v1 v2)
+ (or (morally-equal? v1 v2)
+ (float-vector-equal? v1 v2 1e-5))) ; "relative" equality: diff/mx
+
+;(set! (*s7* 'morally-equal-float-epsilon) 1e-5)
+;(define vequal morally-equal?)
+
+(define-constant (checkout str V v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12)
+ (if (or (not (vequal V v1))
+ (not (vequal v1 v2))
+ (not (vequal v1 v3))
+ (not (vequal v1 v4)))
+ (format *stderr* "~S:~% no do: ~A~% fv-set: ~A~% outa->v:~A~% outa: ~A~% list: ~A~%" str V v1 v2 v3 v4))
+ (if (not (vequal v5 v6)) (format *stderr* "dox ~S:~% fv-set: ~A~% outa->v:~A~%" str v5 v6))
+ (if (not (vequal v7 v8)) (format *stderr* "let ~S:~% ~A~% ~A~%" str v7 v8))
+ (if (not (vequal v9 v10)) (format *stderr* "env let ~S:~% ~A~% ~A~%" str v9 v10))
+ (if (not (vequal v11 v12)) (format *stderr* "letx ~S:~% ~A~% ~A~%" str v11 v12)))
+
+(define-constant (checkout-1 str V v1 v2 v3 v4 v5 v6 v11 v12)
+ (if (or (not (vequal V v1))
+ (not (vequal v1 v2))
+ (not (vequal v1 v3))
+ (not (vequal v1 v4)))
+ (format *stderr* "~S:~% no do: ~A~% fv-set: ~A~% outa->v:~A~% outa: ~A~% list: ~A~%" str V v1 v2 v3 v4))
+ (if (not (vequal v5 v6)) (format *stderr* "dox ~S:~% fv-set: ~A~% outa->v:~A~%" str v5 v6))
+ (if (not (vequal v11 v12)) (format *stderr* "letx ~S:~% ~A~% ~A~%" str v11 v12)))
+
+(define-constant F (make-env (float-vector 0.0 .1 1.0 1.0) :length 100))
+(define-constant K (float-vector 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0))
+(define-constant V (make-float-vector 10))
+
+(define (try1 form gen)
+ (let ((make-gen (string->symbol (string-append "make-" (symbol->string gen)))))
+ (let ((body
+ `(let ()
+ (define G (,make-gen 1000))
+ (define I (,make-gen 500))
+ (define (O) (vector #f (mus-copy I) #f))
+ (define (Q) (mus-copy G))
+ (define (Z) (mus-copy F))
+
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (set! (V i) ,(copy form))))
+
+ (define (tester-1)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (float-vector-set! v i ,(copy form)))))
+
+ (define (tester-2)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (outa i ,(copy form)))))
+
+ (define (tester-3)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (out-any i ,(copy form) 0))))
+
+ (define (tester-4)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (do ((i 0 (+ i 1)) (lst ())) ((= i 10) (apply float-vector (reverse! lst)))
+ (set! lst (cons ,(copy form) lst)))))
+
+ (define (tester-5)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v (make-float-vector 10)))
+ (set! *output* (make-sample->file "test.snd" 1 mus-ldouble mus-next "t816"))
+ (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10))
+ (outa i ,(copy form)))
+ (mus-close *output*)
+ (file->array "test.snd" 0 0 10 v)))
+
+ (define (tester-6)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1)) (y -0.5) (x 0.0 (+ x 0.1))) ((= i 10) v)
+ (float-vector-set! v i ,(copy form)))))
+
+ (define (tester-11)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (let ((x (,gen o)))
+ (set! (v i) ,(copy form))))))
+
+ (define (tester-12)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (let ((x (,gen o)))
+ (outa i ,(copy form))))))
+
+ (checkout-1 ',form V (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) (tester-11) (tester-12))
+ )))
+ (define the-body (apply lambda () (list (copy body :readable))))
+ (the-body))))
+
+(define (try2 form gen)
+ (let ((make-gen (string->symbol (string-append "make-" (symbol->string gen)))))
+ (let ((body
+ `(let ()
+ (define G (,make-gen 1000))
+ (define I (,make-gen 500))
+ (define (O) (vector #f (mus-copy I) #f))
+ (define (Q) (mus-copy G))
+ (define (Z) (mus-copy F))
+
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (set! (V i) ,(copy form))))
+
+ (define (tester-1)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (float-vector-set! v i ,(copy form)))))
+
+ (define (tester-2)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (outa i ,(copy form)))))
+
+ (define (tester-3)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (out-any i ,(copy form) 0))))
+
+ (define (tester-4)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (do ((i 0 (+ i 1)) (lst ())) ((= i 10) (apply float-vector (reverse! lst)))
+ (set! lst (cons ,(copy form) lst)))))
+
+ (define (tester-5)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v (make-float-vector 10)))
+ (set! *output* (make-sample->file "test.snd" 1 mus-ldouble mus-next "t816"))
+ (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10))
+ (outa i ,(copy form)))
+ (mus-close *output*)
+ (file->array "test.snd" 0 0 10 v)))
+
+ (define (tester-6)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1)) (y -0.5) (x 0.0 (+ x 0.1))) ((= i 10) v)
+ (float-vector-set! v i ,(copy form)))))
+
+ (define (tester-7)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (let ((z ,(copy form)))
+ (float-vector-set! v i (,gen o z))))))
+
+ (define (tester-8)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (let ((z ,(copy form)))
+ (outa i (,gen o z))))))
+
+ (define (tester-9)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (let ((z ,(copy form)))
+ (float-vector-set! v i (* (env a) (,gen o z)))))))
+
+ (define (tester-10)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (x 3.14) (y -0.5) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (let ((z ,(copy form)))
+ (outa i (* (env a) (,gen o z)))))))
+
+ (define (tester-11)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (let ((x (,gen o)))
+ (set! (v i) ,(copy form))))))
+
+ (define (tester-12)
+ (let ((o (Q)) (p (Q)) (q (Q)) (oscs (O)) (a (Z)) (b (Z)) (y -0.5) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (let ((x (,gen o)))
+ (outa i ,(copy form))))))
+
+ (checkout ',form V
+ (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6)
+ (tester-7) (tester-8) (tester-9) (tester-10) (tester-11) (tester-12))
+ )))
+
+ (define the-body (apply lambda () (list (copy body :readable))))
+ (the-body))))
+
+(define (try34 form gen args)
+ (let ((make-gen (string->symbol (string-append "make-" (symbol->string gen)))))
+ (let ((body
+ `(let ()
+ (define G (,make-gen 1000))
+ (define I (,make-gen 500))
+ (define (O) (vector #f (mus-copy I) #f))
+ (define (Q) (mus-copy G))
+ (define (Z) (mus-copy F))
+
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
+ (do ((i 0 (+ i 1))) ((= i 10))
+ (float-vector-set! V i ,(copy form))))
+
+ (define (tester-1)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (float-vector-set! v i ,(copy form)))))
+
+ (define (tester-2)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (outa i ,(copy form)))))
+
+ (define (tester-3)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (out-any i ,(copy form) 0))))
+
+ (define (tester-4)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (k 1) (z 0.1))
+ (do ((i 0 (+ i 1)) (lst ())) ((= i 10) (apply float-vector (reverse! lst)))
+ (set! lst (cons ,(copy form) lst)))))
+
+ (define (tester-5)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (y -0.5) (k 1) (z 0.1) (v (make-float-vector 10)))
+ (set! *output* (make-sample->file "test.snd" 1 mus-ldouble mus-next "t816"))
+ (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10))
+ (outa i ,(copy form)))
+ (mus-close *output*)
+ (file->array "test.snd" 0 0 10 v)))
+
+ (define (tester-6)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1)) (y -0.5) (z 0.1) (x 0.0 (+ x 0.1))) ((= i 10) v)
+ (set! (v i) ,(copy form)))))
+
+ (define (tester-7)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (k 1) (z 0.1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (let ((zz ,(copy form)))
+ (float-vector-set! v i (,gen o zz))))))
+
+ (define (tester-8)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (let ((zz ,(copy form)))
+ (outa i (,gen o zz))))))
+
+ (define (tester-9)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (let ((zz ,(copy form)))
+ (float-vector-set! v i (* (env a) (,gen o zz)))))))
+
+ (define (tester-10)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (x 3.14) (y -0.5) (z 0.1) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (let ((zz ,(copy form)))
+ (outa i (* (env a) (,gen o zz)))))))
+
+ (define (tester-11)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (y -0.5) (z 0.1) (k 1) (v (make-float-vector 10)))
+ (do ((i 0 (+ i 1))) ((= i 10) v)
+ (let ((x (,gen o)))
+ (float-vector-set! v i ,(copy form))))))
+
+ (define (tester-12)
+ (let ((o (Q)) (p (Q)) (q (Q)) (s (Q)) (t (Q)) (oscs (O)) (a (Z)) (b (Z)) (c (Z)) (d (Z)) (y -0.5) (z 0.1) (k 1))
+ (set! *output* (make-float-vector 10))
+ (do ((i 0 (+ i 1))) ((= i 10) *output*)
+ (let ((x (,gen o)))
+ (outa i ,(copy form))))))
+
+ (if (= args 1)
+ (checkout-1 ',form V (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6) (tester-11) (tester-12))
+ (checkout ',form V
+ (tester-1) (tester-2) (tester-3) (tester-4) (tester-5) (tester-6)
+ (tester-7) (tester-8) (tester-9) (tester-10) (tester-11) (tester-12))
+ ))))
+
+ (define the-body (apply lambda () (list (copy body :readable))))
+ (the-body))))
+
+(define (test-gen gen nargs)
+ (define args1 (list 1.5 (list gen 'p) '(env a) 'x 'i (list gen 'o) '(- 1.0 x) (list gen '(vector-ref oscs k))))
+ (define args2 (list 1.5 (list gen 'q) '(env b) 'y 'i '(ina i K)))
+ (define args3 (list 1.5 (list gen 's) '(env c) 'z 'i '(cos x)))
+ (define args4 (list 1.5 (list gen 't) '(env d) 'x 'i))
+
+ (if (= nargs 1)
+ (begin
+ (for-each
+ (lambda (a)
+ (try1 a gen)
+ (when (> nargs 1)
+ (try1 `(,gen o ,a) gen)
+ (try1 `(abs (,gen o ,a)) gen)))
+ args1)
+
+ (for-each
+ (lambda (a)
+ (for-each
+ (lambda (b)
+ (try1 `(+ ,a ,b) gen)
+ (try1 `(- ,a ,b) gen)
+ (try1 `(* ,a ,b) gen)
+ (try1 `(cos (+ ,a ,b)) gen)
+ (try1 `(sin (* ,a ,b)) gen)
+ (try1 `(abs (* ,a ,b)) gen)
+ (try1 `(* ,a (abs ,b)) gen)
+ (when (> nargs 1)
+ (try1 `(,gen o (+ ,a ,b)) gen)
+ (try1 `(,gen o (* ,a ,b)) gen)
+ (try1 `(+ ,a (,gen o ,b)) gen)
+ (try1 `(* ,a (,gen o ,b)) gen)
+ (try1 `(+ (,gen o ,a) ,b) gen)
+ (try1 `(* (,gen o ,a) ,b) gen)
+ (try1 `(* (abs (,gen o ,a)) ,b) gen)))
+ args2))
+ args1))
+
+ (begin
+ (for-each
+ (lambda (a)
+ (try2 a gen)
+ (when (> nargs 1)
+ (try2 `(,gen o ,a) gen)
+ (try2 `(abs (,gen o ,a)) gen)))
+ args1)
+
+ (for-each
+ (lambda (a)
+ (for-each
+ (lambda (b)
+ (try2 `(+ ,a ,b) gen)
+ (try2 `(- ,a ,b) gen)
+ (try2 `(* ,a ,b) gen)
+ (try2 `(cos (+ ,a ,b)) gen)
+ (try2 `(sin (* ,a ,b)) gen)
+ (try2 `(abs (* ,a ,b)) gen)
+ (try2 `(* ,a (abs ,b)) gen)
+ (when (> nargs 1)
+ (try2 `(,gen o (+ ,a ,b)) gen)
+ (try2 `(,gen o (* ,a ,b)) gen)
+ (try2 `(+ ,a (,gen o ,b)) gen)
+ (try2 `(* ,a (,gen o ,b)) gen)
+ (try2 `(+ (,gen o ,a) ,b) gen)
+ (try2 `(* (,gen o ,a) ,b) gen)
+ (try2 `(* (abs (,gen o ,a)) ,b) gen)))
+ args2))
+ args1)))
+#|
+ (for-each
+ (lambda (c)
+ (for-each
+ (lambda (b)
+ (for-each
+ (lambda (a)
+ (try34 `(+ ,a ,b ,c) gen nargs)
+ (try34 `(+ (* ,a ,b) ,c) gen nargs)
+ (try34 `(+ ,a (* ,b ,c)) gen nargs)
+ (try34 `(* ,a ,b ,c) gen nargs)
+ (try34 `(* ,a (+ ,b ,c)) gen nargs)
+ (try34 `(* (+ ,a ,b) ,c) gen nargs)
+ (when (> nargs 1)
+ (try34 `(,gen o (+ ,a ,b ,c)) gen nargs)
+ (try34 `(,gen o (* ,a ,b ,c)) gen nargs)
+ (try34 `(,gen o (* ,a (+ ,b ,c))) gen nargs)
+ (try34 `(,gen o (+ ,a (* ,b ,c))) gen nargs)
+ (try34 `(,gen o (* (+ ,a ,b) ,c)) gen nargs)
+ (try34 `(,gen o (+ (* ,a ,b) ,c)) gen nargs)
+ (try34 `(+ ,a (,gen o (+ ,b ,c))) gen nargs)
+ (try34 `(+ ,a (,gen o (* ,b ,c))) gen nargs)
+ (try34 `(* ,a (,gen o (+ ,b ,c))) gen nargs)
+ (try34 `(* ,a (,gen o (* ,b ,c))) gen nargs)
+
+ (try34 `(+ ,a ,b (,gen o ,c)) gen nargs)
+ (try34 `(* ,a ,b (,gen o ,c)) gen nargs)
+ (try34 `(+ (* ,a ,b) (,gen o ,c)) gen nargs)
+ (try34 `(* (+ ,a ,b) (,gen o ,c)) gen nargs)
+ (try34 `(+ ,a (* ,b (,gen o ,c))) gen nargs)
+ (try34 `(* ,a (+ ,b (,gen o ,c))) gen nargs)
+
+ (try34 `(+ ,a (,gen o ,b) ,c) gen nargs)
+ (try34 `(* ,a (,gen o ,b) ,c) gen nargs)
+ (try34 `(+ (* ,a (,gen o ,b)) ,c) gen nargs)
+ (try34 `(* (+ ,a (,gen o ,b)) ,c) gen nargs)
+ (try34 `(+ ,a (* (,gen o ,b) ,c)) gen nargs)
+ (try34 `(* ,a (+ (,gen o ,b) ,c)) gen nargs)
+
+ (try34 `(+ (,gen o ,a) ,b ,c) gen nargs)
+ (try34 `(+ (,gen o ,a) (* ,b ,c)) gen nargs)
+ (try34 `(* (,gen o ,a) (+ ,b ,c)) gen nargs)
+ (try34 `(* (,gen o ,a) ,b ,c) gen nargs))
+
+ (try34 `(+ ,a (abs ,b) ,c) gen nargs)
+ (try34 `(+ ,a (sin ,b) ,c) gen nargs)
+ (try34 `(+ ,a (cos ,b) ,c) gen nargs))
+ args3))
+ args2))
+ args1)
+
+ (for-each
+ (lambda (d)
+ (for-each
+ (lambda (c)
+ (for-each
+ (lambda (b)
+ (for-each
+ (lambda (a)
+ (try34 `(+ ,a ,b ,c ,d) gen nargs)
+ (try34 `(* ,a ,b ,c ,d) gen nargs)
+ (try34 `(+ (* ,a ,b) (* ,c ,d)) gen nargs)
+ (try34 `(* (+ ,a ,b) (+ ,c ,d)) gen nargs)
+ (try34 `(+ ,a (* ,b ,c ,d)) gen nargs)
+ (try34 `(* ,a (+ ,b ,c ,d)) gen nargs)
+ (try34 `(+ ,a (* ,b (+ ,c ,d))) gen nargs)
+ (try34 `(* ,a (+ ,b (* ,c ,d))) gen nargs)
+ (try34 `(+ (* ,a ,b ,c) ,d) gen nargs)
+ (try34 `(* (+ ,a ,b ,c) ,d) gen nargs)
+ (try34 `(+ (* ,a (+ ,b ,c)) ,d) gen nargs)
+ (try34 `(* (+ ,a (* ,b ,c)) ,d) gen nargs)
+
+ (when (> nargs 1)
+ (try34 `(+ (,gen o ,a) ,b ,c ,d) gen nargs)
+ (try34 `(* (,gen o ,a) ,b ,c ,d) gen nargs)
+ (try34 `(+ (* (,gen o ,a) ,b) (* ,c ,d)) gen nargs)
+ (try34 `(* (+ (,gen o ,a) ,b) (+ ,c ,d)) gen nargs)
+ (try34 `(+ (,gen o ,a) (* ,b ,c ,d)) gen nargs)
+ (try34 `(* (,gen o ,a) (+ ,b ,c ,d)) gen nargs)
+ (try34 `(+ (,gen o ,a) (* ,b (+ ,c ,d))) gen nargs)
+ (try34 `(* (,gen o ,a) (+ ,b (* ,c ,d))) gen nargs)
+ (try34 `(+ (* (,gen o ,a) ,b ,c) ,d) gen nargs)
+ (try34 `(* (+ (,gen o ,a) ,b ,c) ,d) gen nargs)
+ (try34 `(+ (* (,gen o ,a) (+ ,b ,c)) ,d) gen nargs)
+ (try34 `(* (+ (,gen o ,a) (* ,b ,c)) ,d) gen nargs)
+
+ (try34 `(+ ,a (,gen o ,b) ,c ,d) gen nargs)
+ (try34 `(* ,a (,gen o ,b) ,c ,d) gen nargs)
+ (try34 `(+ (* ,a (,gen o ,b)) (* ,c ,d)) gen nargs)
+ (try34 `(* (+ ,a (,gen o ,b)) (+ ,c ,d)) gen nargs)
+ (try34 `(+ ,a (* (,gen o ,b) ,c ,d)) gen nargs)
+ (try34 `(* ,a (+ (,gen o ,b) ,c ,d)) gen nargs)
+ (try34 `(+ ,a (* (,gen o ,b) (+ ,c ,d))) gen nargs)
+ (try34 `(* ,a (+ (,gen o ,b) (* ,c ,d))) gen nargs)
+ (try34 `(+ (* ,a (,gen o ,b) ,c) ,d) gen nargs)
+ (try34 `(* (+ ,a (,gen o ,b) ,c) ,d) gen nargs)
+ (try34 `(+ (* ,a (+ (,gen o ,b) ,c)) ,d) gen nargs)
+ (try34 `(* (+ ,a (* (,gen o ,b) ,c)) ,d) gen nargs)
+
+ (try34 `(+ ,a ,b (,gen o ,c) ,d) gen nargs)
+ (try34 `(* ,a ,b (,gen o ,c) ,d) gen nargs)
+ (try34 `(+ (* ,a ,b) (* (,gen o ,c) ,d)) gen nargs)
+ (try34 `(* (+ ,a ,b) (+ (,gen o ,c) ,d)) gen nargs)
+ (try34 `(+ ,a (* ,b (,gen o ,c) ,d)) gen nargs)
+ (try34 `(* ,a (+ ,b (,gen o ,c) ,d)) gen nargs)
+ (try34 `(+ ,a (* ,b (+ (,gen o ,c) ,d))) gen nargs)
+ (try34 `(* ,a (+ ,b (* (,gen o ,c) ,d))) gen nargs)
+ (try34 `(+ (* ,a ,b (,gen o ,c)) ,d) gen nargs)
+ (try34 `(* (+ ,a ,b (,gen o ,c)) ,d) gen nargs)
+ (try34 `(+ (* ,a (+ ,b (,gen o ,c))) ,d) gen nargs)
+ (try34 `(* (+ ,a (* ,b (,gen o ,c))) ,d) gen nargs)
+
+ (try34 `(+ ,a ,b ,c (,gen o ,d)) gen nargs)
+ (try34 `(* ,a ,b ,c (,gen o ,d)) gen nargs)
+ (try34 `(+ (* ,a ,b) (* ,c (,gen o ,d))) gen nargs)
+ (try34 `(* (+ ,a ,b) (+ ,c (,gen o ,d))) gen nargs)
+ (try34 `(+ ,a (* ,b ,c (,gen o ,d))) gen nargs)
+ (try34 `(* ,a (+ ,b ,c (,gen o ,d))) gen nargs)
+ (try34 `(+ ,a (* ,b (+ ,c (,gen o ,d)))) gen nargs)
+ (try34 `(* ,a (+ ,b (* ,c (,gen o ,d)))) gen nargs)
+ (try34 `(+ (* ,a ,b ,c) (,gen o ,d)) gen nargs)
+ (try34 `(* (+ ,a ,b ,c) (,gen o ,d)) gen nargs)
+ (try34 `(+ (* ,a (+ ,b ,c)) (,gen o ,d)) gen nargs)
+ (try34 `(* (+ ,a (* ,b ,c)) (,gen o ,d)) gen nargs)
+
+ (try34 `(,gen o (+ ,a ,b ,c ,d)) gen nargs)
+ (try34 `(,gen o (* ,a ,b ,c ,d)) gen nargs)
+ (try34 `(,gen o (+ (* ,a ,b) (* ,c ,d))) gen nargs)
+ (try34 `(,gen o (* (+ ,a ,b) (+ ,c ,d))) gen nargs)
+ (try34 `(,gen o (+ ,a (* ,b ,c ,d))) gen nargs)
+ (try34 `(,gen o (* ,a (+ ,b ,c ,d))) gen nargs)
+ (try34 `(,gen o (+ ,a (* ,b (+ ,c ,d)))) gen nargs)
+ (try34 `(,gen o (* ,a (+ ,b (* ,c ,d)))) gen nargs)
+ (try34 `(,gen o (+ (* ,a ,b ,c) ,d)) gen nargs)
+ (try34 `(,gen o (* (+ ,a ,b ,c) ,d)) gen nargs)
+ (try34 `(,gen o (+ (* ,a (+ ,b ,c)) ,d)) gen nargs)
+ (try34 `(,gen o (* (+ ,a (* ,b ,c)) ,d)) gen nargs)
+
+ (try34 `(+ (,gen o (* ,a ,b)) (* ,c ,d)) gen nargs)
+ (try34 `(* (,gen o (+ ,a ,b)) (+ ,c ,d)) gen nargs)
+ (try34 `(,gen o (+ (* ,a ,b) (* ,c ,d))) gen nargs)
+ (try34 `(+ ,a (* ,b (,gen o (+ ,c ,d)))) gen nargs)
+ (try34 `(* ,a (+ ,b (,gen o (* ,c ,d)))) gen nargs)
+ (try34 `(+ (* ,a (,gen o (+ ,b ,c))) ,d) gen nargs)
+ (try34 `(* (+ ,a (,gen o (* ,b ,c))) ,d) gen nargs))
+
+ (try34 `(+ ,a ,b ,c ,d (,gen o)) gen nargs)
+ (try34 `(* ,a ,b ,c ,d (,gen o)) gen nargs))
+ args4))
+ args3))
+ args2))
+ args1)
+|#
+ )
+
+(for-each
+ (lambda (gen nargs)
+ ;(gc)
+ (set! start-run (get-internal-real-time))
+ (test-gen gen nargs)
+ (format *stderr* "~A: ~20T~,3F~%" gen (* 1.0 (/ (- (get-internal-real-time) start-run) internal-time-units-per-second))))
+; '(adjustable-oscil)
+; '(2)
+
+ '(;rand-1 rand-interp-1 ; the y-as-fm case will be different (ignore printout)
+ r2k!cos filter-1 fir-filter-1 iir-filter-1 oscil
+ one-pole-all-pass-1 env-1 pulsed-env-1
+ formant-1 firmant-1
+ polywave polyshape ncos nsin nrxycos nrxysin rxyk!sin rxyk!cos asymmetric-fm square-wave triangle-wave pulse-train sawtooth-wave
+ one-pole-1 one-zero-1 two-pole-1 two-zero-1
+ oscil-bank-1
+ delay-1 comb-1 notch-1 all-pass-1 filtered-comb-1
+ moving-max-1 moving-norm-1 moving-average-1
+ table-lookup-1 wave-train-1
+ formant-bank-1 comb-bank-1 filtered-comb-bank-1 all-pass-bank-1
+ adjustable-oscil
+ readin-1 convolve-1 src-1 granulate-1 ssb-am-1 phase-vocoder-1
+ )
+
+ '(;2 2
+ 2 2 2 2 2
+ 2 1 1
+ 2 2
+ 2 2 2 2 2 2 2 2 2 2 2 2 2
+ 2 2 2 2
+ 1
+ 2 2 2 2 2
+ 2 2 2
+ 2 2
+ 2 2 2 2
+ 2
+ 1 1 2 1 2 1
+ )
+
+ )
+
+;(gc)
+(s7-version)
+(exit)
diff --git a/tools/thash.scm b/tools/thash.scm
new file mode 100644
index 0000000..94e8628
--- /dev/null
+++ b/tools/thash.scm
@@ -0,0 +1,184 @@
+;(set! (*s7* 'gc-stats) 6)
+;heap ca 30*size!
+
+(define-constant symbols (make-vector 1000000))
+(define-constant strings (make-vector 1000000))
+
+(define (test-hash size)
+
+ (format *stderr* "~D " size)
+
+ (let ((int-hash (make-hash-table size))
+ (p (cons #f #f)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! int-hash i i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= (hash-table-ref int-hash i) i))
+ (display "oops")))
+ (for-each (lambda (key&value)
+ (if (not (= (car key&value) (cdr key&value)))
+ (display "oops"))) ;(format *stderr* "hash iter ~A~%" key&value)))
+ (make-iterator int-hash p))
+ (fill! int-hash #f))
+
+ (let ((int-hash (make-hash-table size =)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! int-hash i i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= (hash-table-ref int-hash i) i))
+ (display "oops")))
+ (fill! int-hash #f))
+
+
+ (let ((flt-hash (make-hash-table size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! flt-hash (* i 2.0) i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= (hash-table-ref flt-hash (* 2.0 i)) i))
+ (display "oops")))
+ (fill! flt-hash #f))
+
+
+ (let ((sym-hash (make-hash-table size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! sym-hash (vector-set! symbols i (string->symbol (vector-set! strings i (number->string i)))) i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= (hash-table-ref sym-hash (vector-ref symbols i)) i))
+ (display "oops")))
+ (fill! sym-hash #f))
+
+
+ (let ((str-hash (make-hash-table size eq?)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! str-hash (vector-ref strings i) i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= (hash-table-ref str-hash (vector-ref strings i)) i))
+ (display "oops")))
+ (fill! str-hash #f))
+
+
+ (let ((sym-hash (make-hash-table size eq?)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! sym-hash (vector-ref symbols i) i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= (hash-table-ref sym-hash (vector-ref symbols i)) i))
+ (display "oops")))
+ (fill! sym-hash #f))
+
+
+ (let ((chr-hash (make-hash-table 256)))
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (hash-table-set! chr-hash (integer->char i) i))
+ (do ((i 0 (+ i 1)))
+ ((= i 256))
+ (if (not (= (hash-table-ref chr-hash (integer->char i)) i))
+ (display "oops")))
+ (fill! chr-hash #f))
+
+
+ (let ((any-hash (make-hash-table size eq?)))
+ (if (= size 1)
+ (hash-table-set! any-hash (vector-set! strings 0 (list 0)) 0)
+ (do ((i 0 (+ i 2))
+ (j 1 (+ j 2)))
+ ((= i size))
+ (hash-table-set! any-hash (vector-set! strings i (list i)) i)
+ (hash-table-set! any-hash (vector-set! strings j (int-vector j)) j)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= i (hash-table-ref any-hash (vector-ref strings i))))
+ (display "oops")))
+ (fill! any-hash #f))
+
+
+ (let ((any-hash1 (make-hash-table size eq?)))
+ (if (= size 1)
+ (hash-table-set! any-hash1 (vector-set! strings 0 (inlet :a 0)) 0)
+ (do ((i 0 (+ i 2))
+ (j 1 (+ j 2))
+ (x 0.0 (+ x 2.0)))
+ ((= i size))
+ (hash-table-set! any-hash1 (vector-set! strings i (inlet :a i)) i)
+ (hash-table-set! any-hash1 (vector-set! strings j (float-vector x)) j)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= i (hash-table-ref any-hash1 (vector-ref strings i))))
+ (display "oops")))
+ (vector-fill! strings #f)
+ (fill! any-hash1 #f))
+
+
+ (let ((cmp-hash (make-hash-table size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (hash-table-set! cmp-hash (complex i i) i))
+ (do ((i 0 (+ i 1)))
+ ((= i size))
+ (if (not (= (hash-table-ref cmp-hash (complex i i)) i))
+ (display "oops")))
+ (fill! cmp-hash #f))
+
+ )
+
+
+(for-each test-hash (list 1 10 100 1000 10000 100000 1000000))
+
+;;; ----------------------------------------
+(format *stderr* "reader~%")
+
+(define data "/home/bil/test/bench/src/bib")
+(define counts (make-hash-table (expt 2 18) string=?))
+
+(define (reader)
+ (let ((port (open-input-file data))
+ (new-pos 0))
+ (do ((line (read-line port) (read-line port)))
+ ((eof-object? line))
+ (set! new-pos 0)
+ (do ((pos (char-position #\space line) (char-position #\space line (+ pos 1))))
+ ((not pos))
+ (unless (= pos new-pos)
+ (let* ((start (do ((k new-pos (+ k 1))) ; char-position here is slower!
+ ((or (= k pos)
+ (char-alphabetic? (string-ref line k)))
+ k)))
+ (end (do ((k (- pos 1) (- k 1)))
+ ((or (= k start)
+ (char-alphabetic? (string-ref line k)))
+ (+ k 1)))))
+ (when (> end start)
+ (let ((word (substring line start end)))
+ (let ((refs (or (hash-table-ref counts word) 0)))
+ (hash-table-set! counts word (+ refs 1)))))))
+ (set! new-pos (+ pos 1))))
+
+ (close-input-port port)
+ (sort! (copy counts (make-vector (hash-table-entries counts)))
+ (lambda (a b) (> (cdr a) (cdr b))))))
+
+(set! counts (reader))
+
+(if (or (not (string=? (car (counts 0)) "the"))
+ (not (= (cdr (counts 0)) 62063)))
+ (do ((i 0 (+ i 1)))
+ ((= i 40))
+ (format *stderr* "~A: ~A~%" (car (counts i)) (cdr (counts i)))))
+;;; ----------------------------------------
+
+;(gc)
+(s7-version)
+
+(exit)
diff --git a/tools/timing-info b/tools/timing-info
deleted file mode 100644
index baabf2a..0000000
--- a/tools/timing-info
+++ /dev/null
@@ -1,221 +0,0 @@
-I tried the bird and the fm-violin in Scheme using run, and
-in C and got the following times:
-
-bird: 0.04 in C, 0.05 in Scheme
-violin: 2.40 in C, 2.83 in Scheme
-
-Similarly the Gabriel FFT benchmark (fft.sch), in s7 runs
-the fft 1000 times in 7.23 secs, whereas Guile 1.9.5 compiles it,
-then runs it in 9.89 (Guile 1.8.6 (no compiler): 56.5 secs compared
-to s7 no run: 41.2 secs). If I were allowed to rewrite the
-benchmark slightly to avoid recursion, s7 would do even better.
-
-
-
-
-
-The Scheme calls were using the standard instruments with
-
-(time (with-sound () (bird 0 10 440.0 10.0 0.5 '(0 0 1 1) '(0 0 1 1 2 1 3 0))))
-(time (with-sound () (fm-violin 0 200 440 .1)))
-
-The bird in C is:
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <unistd.h>
-
-/* assume we've configured and built sndlib, so it has created a mus-config.h file */
-
-#include "mus-config.h"
-#include "s7.h"
-#include "xen.h"
-#include "clm.h"
-#include "clm2xen.h"
-
-void c_bird(double start, double dur, double frequency, double freqskew, double amplitude,
- mus_float_t *freqdata, int freqpts, mus_float_t *ampdata, int amppts, mus_any *output)
-{
- mus_long_t beg, end, i;
- mus_any *amp_env, *freq_env, *osc;
- beg = start * mus_srate();
- end = start + dur * mus_srate();
- osc = mus_make_oscil(frequency, 0.0);
- amp_env = mus_make_env(ampdata, amppts, amplitude, 0.0, 1.0, dur, 0, NULL);
- freq_env = mus_make_env(freqdata, freqpts, mus_hz_to_radians(freqskew), 0.0, 1.0, dur, 0, NULL);
- for (i = beg; i < end; i++)
- mus_out_any_to_file(output, i, 0,
- mus_env(amp_env) *
- mus_oscil(osc, mus_env(freq_env), 0.0));
- mus_free(osc);
- mus_free(amp_env);
- mus_free(freq_env);
-}
-
-int main(int argc, char **argv)
-{
- mus_any *out;
- int i;
- mus_float_t freq_points[4] = {0.0, 0.0, 1.0, 1.0};
- mus_float_t amp_points[8] = {0.0, 0.0, 0.25, 1.0, 0.75, 1.0, 1.0, 0.0};
-
- mus_sound_initialize();
- out = mus_make_sample_to_file("test.snd", 1, MUS_LFLOAT, MUS_NEXT);
- c_bird(0.0, 10.0, 440.0, 10.0, 0.5, freq_points, 2, amp_points, 4, out);
- mus_close_file(out);
-
- return(0);
-}
-
-/* gcc -o time-bird time-bird.c -lm -I. /home/bil/test/sndlib/libsndlib.a -lasound -lgsl -lgslcblas -O2 */
-/* time time-bird: 0.046u 0.003s 0:00.08 50.0% 0+0k 0+3448io 0pf+0w */
-/* (time (with-sound () (bird 0 10 440.0 10.0 0.5 '(0 0 1 1) '(0 0 1 1 2 1 3 0)))): 0.05230 */
---------------------------------------------------------------------------------
-
-The violin in C is:
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <unistd.h>
-#include <math.h>
-
-/* assume we've configured and built sndlib, so it has created a mus-config.h file */
-
-#include "mus-config.h"
-#include "s7.h"
-#include "xen.h"
-#include "clm.h"
-#include "clm2xen.h"
-
-static int feq(float x, int i) {return(fabs(x-i)<.00001);}
-
-void fm_violin(float start, float dur, float frequency, float amplitude, float fm_index, mus_any *op)
-{
- float pervibfrq = 5.0,
- ranvibfrq = 16.0,
- pervibamp = .0025,
- ranvibamp = .005,
- noise_amount = 0.0,
- noise_frq = 1000.0,
- gliss_amp = 0.0,
- fm1_rat = 1.0,
- fm2_rat = 3.0,
- fm3_rat = 4.0,
- reverb_amount = 0.0,
- degree = 0.0,
- distance = 1.0;
- float fm_env[] = {0.0, 1.0, 25.0, 0.4, 75.0, 0.6, 100.0, 0.0};
- float amp_env[] = {0.0, 0.0, 25.0, 1.0, 75.0, 1.0, 100.0, 0.0};
- float frq_env[] = {0.0, -1.0, 15.0, 1.0, 25.0, 0.0, 100.0, 0.0};
- int beg = 0, end, easy_case = 0, npartials, i;
- float *coeffs, *partials;
- float frq_scl, maxdev, logfrq, sqrtfrq, index1, index2, index3, norm;
- float vib = 0.0, modulation = 0.0, fuzz = 0.0, indfuzz = 1.0, ampfuzz = 1.0;
- mus_any *carrier, *fmosc1, *fmosc2, *fmosc3, *ampf;
- mus_any *indf1, *indf2, *indf3, *fmnoi = NULL, *pervib, *ranvib, *frqf = NULL, *loc;
- beg = start * mus_srate();
- end = beg + dur * mus_srate();
- frq_scl = mus_hz_to_radians(frequency);
- maxdev = frq_scl * fm_index;
- if ((noise_amount == 0.0) &&
- (feq(fm1_rat, floor(fm1_rat))) &&
- (feq(fm2_rat, floor(fm2_rat))) &&
- (feq(fm3_rat, floor(fm3_rat))))
- easy_case = 1;
- logfrq = log(frequency);
- sqrtfrq = sqrt(frequency);
- index1 = maxdev * 5.0 / logfrq;
- if (index1 > M_PI) index1 = M_PI;
- index2 = maxdev * 3.0 * (8.5 - logfrq) / (3.0 + frequency * .001);
- if (index2 > M_PI) index2 = M_PI;
- index3 = maxdev * 4.0 / sqrtfrq;
- if (index3 > M_PI) index3 = M_PI;
- if (easy_case)
- {
- npartials = floor(fm1_rat);
- if ((floor(fm2_rat)) > npartials) npartials = floor(fm2_rat);
- if ((floor(fm3_rat)) > npartials) npartials = floor(fm3_rat);
- npartials++;
- partials = (float *)calloc(npartials, sizeof(float));
- partials[(int)(fm1_rat)] = index1;
- partials[(int)(fm2_rat)] = index2;
- partials[(int)(fm3_rat)] = index3;
- coeffs = mus_partials_to_polynomial(npartials, partials, 1);
- norm = 1.0;
- }
- else norm = index1;
- carrier = mus_make_oscil(frequency, 0.0);
- if (easy_case == 0)
- {
- fmosc1 = mus_make_oscil(frequency * fm1_rat, 0.0);
- fmosc2 = mus_make_oscil(frequency * fm2_rat, 0.0);
- fmosc3 = mus_make_oscil(frequency * fm3_rat, 0.0);
- }
- else fmosc1 = mus_make_oscil(frequency, 0.0);
- ampf = mus_make_env(amp_env, 4, amplitude, 0.0, 1.0, dur, 0, NULL);
- indf1 = mus_make_env(fm_env, 4, norm, 0.0, 1.0, dur, 0, NULL);
- if (gliss_amp != 0.0)
- frqf = mus_make_env(frq_env, 4, gliss_amp * frq_scl, 0.0, 1.0, dur, 0, NULL);
- if (easy_case == 0)
- {
- indf2 = mus_make_env(fm_env, 4, index2, 0.0, 1.0, dur, 0, NULL);
- indf3 = mus_make_env(fm_env, 4, index3, 0.0, 1.0, dur, 0, NULL);
- }
- pervib = mus_make_triangle_wave(pervibfrq, frq_scl * pervibamp, 0.0);
- ranvib = mus_make_rand_interp(ranvibfrq, frq_scl * ranvibamp);
- if (noise_amount != 0.0) fmnoi = mus_make_rand(noise_frq, noise_amount * M_PI);
- loc = mus_make_locsig(degree, distance, reverb_amount, 1, (mus_any *)op, 0, NULL, MUS_INTERP_LINEAR);
- for (i = beg; i < end; i++)
- {
- if (noise_amount != 0.0) fuzz = mus_rand(fmnoi, 0.0);
- if (frqf) vib = mus_env(frqf); else vib = 0.0;
- vib += mus_triangle_wave(pervib, 0.0) + mus_rand_interp(ranvib, 0.0);
- if (easy_case)
- modulation = mus_env(indf1) *
- mus_polynomial(coeffs, mus_oscil(fmosc1, vib, 0.0), npartials);
- else
- modulation = mus_env(indf1) * mus_oscil(fmosc1, (fuzz + fm1_rat * vib), 0.0) +
- mus_env(indf2) * mus_oscil(fmosc2, (fuzz + fm2_rat * vib), 0.0) +
- mus_env(indf3) * mus_oscil(fmosc3, (fuzz + fm3_rat * vib), 0.0);
- mus_locsig(loc, i, mus_env(ampf) * mus_oscil(carrier, vib + indfuzz * modulation, 0.0));
- }
- mus_free(pervib);
- mus_free(ranvib);
- mus_free(carrier);
- mus_free(fmosc1);
- mus_free(ampf);
- mus_free(indf1);
- if (fmnoi) mus_free(fmnoi);
- if (frqf) mus_free(frqf);
- if (!(easy_case))
- {
- mus_free(indf2);
- mus_free(indf3);
- mus_free(fmosc2);
- mus_free(fmosc3);
- }
- else
- free(partials);
- mus_free(loc);
-}
-
-int main(int argc, char *argv[])
-{
- mus_any *osc = NULL, *op = NULL;
- mus_sound_initialize();
-
- op = mus_make_sample_to_file("test.snd", 1, MUS_BSHORT, MUS_NEXT);
- if (op)
- {
- fm_violin(0.0, 200.0, 440.0, .3, 1.0, op);
- mus_free(op);
- }
- return(0);
-}
-
-/* time time-violin: 1.641u 0.060s 0:02.49 68.2% 0+0k 0+34456io 0pf+0w */
-/* (time (with-sound () (fm-violin 0 200 440 .1))): 2.826584 */
-
---------------------------------------------------------------------------------
diff --git a/tools/titer.scm b/tools/titer.scm
new file mode 100644
index 0000000..38fb5ef
--- /dev/null
+++ b/tools/titer.scm
@@ -0,0 +1,102 @@
+;; iteration tests
+
+;(set! (*s7* 'gc-stats) 2)
+
+;;; do/let/rec/tc/iter
+
+(define with-blocks #f)
+(when with-blocks
+ (let ((new-env (sublet (curlet) (cons 'init_func 'block_init)))) ; load calls init_func if possible
+ (load "s7test-block.so" new-env)))
+
+(define-constant (find-if-a iter)
+ (or (string? (iterate iter))
+ (and (not (iterator-at-end? iter))
+ (find-if-a iter))))
+
+(define-constant (find-if-b iter)
+ (call-with-exit
+ (lambda (return)
+ (for-each (lambda (arg)
+ (if (string? arg) (return #t)))
+ iter)
+ #f)))
+
+(define-constant (find-if-c iter)
+ (let loop ()
+ (or (string? (iterate iter))
+ (and (not (iterator-at-end? iter))
+ (loop)))))
+
+(define-constant (find-if-d iter)
+ (do ()
+ ((or (string? (iterate iter)) (iterator-at-end? iter))
+ (not (iterator-at-end? iter)))))
+
+(define (test)
+ (for-each
+ (lambda (size)
+ (format *stderr* "~D: " size)
+ (let ((a (let ((lst (make-list size #f)))
+ (list (find-if-a (make-iterator lst))
+ (find-if-b (make-iterator lst))
+ (find-if-c (make-iterator lst))
+ (find-if-d (make-iterator lst)))))
+ (b (let ((str (make-string size #\space)))
+ (list (find-if-a (make-iterator str))
+ (find-if-b (make-iterator str))
+ (find-if-c (make-iterator str))
+ (find-if-d (make-iterator str)))))
+ (c (let ((vc (make-vector size #f)))
+ (list (find-if-a (make-iterator vc))
+ (find-if-b (make-iterator vc))
+ (find-if-c (make-iterator vc))
+ (find-if-d (make-iterator vc)))))
+ (d (let ((fv (make-float-vector size 0.0)))
+ (list (find-if-a (make-iterator fv))
+ (find-if-b (make-iterator fv))
+ (find-if-c (make-iterator fv))
+ (find-if-d (make-iterator fv)))))
+ (e (let ((iv (make-int-vector size 0)))
+ (list (find-if-a (make-iterator iv))
+ (find-if-b (make-iterator iv))
+ (find-if-c (make-iterator iv))
+ (find-if-d (make-iterator iv)))))
+ (f (let ((ht (let ((ht1 (make-hash-table size)))
+ (do ((i 0 (+ i 1)))
+ ((= i size) ht1)
+ (hash-table-set! ht1 i i))))
+ (p (cons #f #f)))
+ (list (find-if-a (make-iterator ht p))
+ (find-if-b (make-iterator ht p))
+ (find-if-c (make-iterator ht p))
+ (find-if-d (make-iterator ht p)))))
+ (g (let ((lt (apply inlet (make-list (* 2 size) 'abc)))
+ (p (cons #f #f)))
+ (list (find-if-a (make-iterator lt p))
+ (find-if-b (make-iterator lt p))
+ (find-if-c (make-iterator lt p))
+ (find-if-d (make-iterator lt p)))))
+ (h (if with-blocks
+ (let ((blk (make-block size)))
+ (list (find-if-a (make-iterator blk))
+ (find-if-b (make-iterator blk))
+ (find-if-c (make-iterator blk))
+ (find-if-d (make-iterator blk))))
+ #f)))
+
+ (if (not (equal? a '(#f #f #f #f))) (format *stderr* "a: ~A " a))
+ (if (not (equal? b '(#f #f #f #f))) (format *stderr* "b: ~A " b))
+ (if (not (equal? c '(#f #f #f #f))) (format *stderr* "c: ~A " c))
+ (if (not (equal? d '(#f #f #f #f))) (format *stderr* "d: ~A " d))
+ (if (not (equal? e '(#f #f #f #f))) (format *stderr* "e: ~A " e))
+ (if (not (equal? f '(#f #f #f #f))) (format *stderr* "f: ~A " f))
+ (if (not (equal? g '(#f #f #f #f))) (format *stderr* "g: ~A " g))
+ (if (and with-blocks (not (equal? h '(#f #f #f #f)))) (format *stderr* "h: ~A " h))
+ ))
+ (list 1 10 100 1000 10000 100000 1000000)))
+
+(test)
+
+(s7-version)
+(exit)
diff --git a/tools/tmap.scm b/tools/tmap.scm
new file mode 100644
index 0000000..b75e2fd
--- /dev/null
+++ b/tools/tmap.scm
@@ -0,0 +1,319 @@
+;;; sequence tests
+
+(define (less-than a b)
+ (or (< a b) #f))
+
+(define (less-than-2 a b)
+ (if (not (real? a)) (display "oops"))
+ (cond ((< a b) #t) (#t #f)))
+
+(define (char-less-than a b)
+ (cond ((char<? a b) #t) (#t #f)))
+
+
+(define (fv-tst len)
+ (let ((fv (make-float-vector len)))
+ (if (not (= (length fv) len))
+ (format *stderr* "float-vector length ~A: ~A~%" fv (length fv)))
+ (fill! fv 0.0)
+ (let ((fv-orig (copy fv)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (float-vector-set! fv i (- (random 1000.0) 500.0)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (- (random 1000.0) 500.0)))
+ (let ((fv-ran (copy fv))
+ (fv-ran1 (copy fv)))
+ (sort! fv <)
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (if (> (float-vector-ref fv (- i 1)) (float-vector-ref fv i))
+ (display "oops")))
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (if (> (fv (- i 1)) (fv i))
+ (display "oops")))
+ ;(format *stderr* "float-vector: ~A > ~A at ~D~%" (float-vector-ref fv (- i 1)) (float-vector-ref fv i) i)))
+ (sort! fv-ran (lambda (a b) (< a b)))
+ (if (not (morally-equal? fv fv-ran))
+ (format *stderr* "float-vector closure not equal~%"))
+ (sort! fv-ran1 less-than)
+ (if (not (morally-equal? fv fv-ran1))
+ (format *stderr* "float-vector cond closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (reverse! fv)
+ (if (and (not (morally-equal? fv-copy fv))
+ (morally-equal? fv fv-orig))
+ (format *stderr* "float-vector reverse!: ~A ~A~%" fv fv-orig))
+ (reverse! fv)
+ (if (not (morally-equal? fv-copy fv))
+ (format *stderr* "float-vector reverse! twice: ~A ~A~%" fv fv-copy))
+ (let ((fv1 (apply float-vector (make-list len 1.0))))
+ (if (or (not (= (length fv1) len))
+ (not (= (fv1 (- len 1)) 1.0)))
+ (format *stderr* "float-vector apply: ~A ~A~%" len (fv (- len 1)))))
+ ))))
+
+(define (iv-tst len)
+ (let ((fv (make-int-vector len 0)))
+ (if (not (= (length fv) len))
+ (format *stderr* "int-vector length ~A: ~A~%" fv (length fv)))
+ (fill! fv 0)
+ (let ((fv-orig (copy fv)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (int-vector-set! fv i (- (random 1000000) 500000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (- (random 1000000) 500000)))
+ (let ((fv-ran (copy fv))
+ (fv-ran1 (copy fv)))
+ (sort! fv <)
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (if (> (int-vector-ref fv (- i 1)) (int-vector-ref fv i))
+ (display "oops")))
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (if (> (fv (- i 1)) (fv i))
+ (display "oops")))
+ (sort! fv-ran (lambda (a b) (< a b)))
+ (if (not (equal? fv fv-ran))
+ (format *stderr* "int-vector closure not equal~%"))
+ (sort! fv-ran1 less-than)
+ (if (not (equal? fv fv-ran1))
+ (format *stderr* "int-vector cond closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (reverse! fv)
+ (if (and (not (equal? fv-copy fv))
+ (equal? fv fv-orig))
+ (format *stderr* "int-vector reverse!: ~A ~A~%" fv fv-orig))
+ (reverse! fv)
+ (if (not (equal? fv-copy fv))
+ (format *stderr* "int-vector reverse! twice: ~A ~A~%" fv fv-copy))
+ ))))
+
+(define (v-tst len)
+ (let ((fv (make-vector len)))
+ (if (not (= (length fv) len))
+ (format *stderr* "vector length ~A: ~A~%" fv (length fv)))
+ (fill! fv 0)
+ (let ((fv-orig (copy fv)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (vector-set! fv i (- (random 1000000) 500000)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (- (random 1000000) 500000)))
+ (let ((fv-ran (copy fv))
+ (fv-ran1 (copy fv)))
+ (sort! fv <)
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (if (> (vector-ref fv (- i 1)) (vector-ref fv i))
+ (display "oops")))
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (if (> (fv (- i 1)) (fv i))
+ (display "oops")))
+ (sort! fv-ran (lambda (a b) (< a b)))
+ (if (not (equal? fv fv-ran))
+ (format *stderr* "vector closure not equal~%"))
+ (sort! fv-ran1 less-than-2)
+ (if (not (equal? fv fv-ran1))
+ (format *stderr* "vector cond closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (reverse! fv)
+ (if (and (not (equal? fv-copy fv))
+ (equal? fv fv-orig))
+ (format *stderr* "vector reverse!: ~A ~A~%" fv fv-orig))
+ (reverse! fv)
+ (if (not (equal? fv-copy fv))
+ (format *stderr* "vector reverse! twice: ~A ~A~%" fv fv-copy))
+ (let ((fv1 (apply vector (make-list len 1))))
+ (if (or (not (= (length fv1) len))
+ (not (= (fv1 (- len 1)) 1)))
+ (format *stderr* "vector apply: ~A ~A~%" len (fv (- len 1)))))
+ ))))
+
+(define (s-tst len)
+ (let ((fv (make-string len)))
+ (if (not (= (length fv) len))
+ (format *stderr* "string length ~A: ~A~%" fv (length fv)))
+ (fill! fv #\a)
+ (let ((fv-orig (copy fv)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (string-set! fv i (integer->char (+ 20 (random 100)))))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (fv i) (integer->char (+ 20 (random 100)))))
+ (let ((fv-ran (copy fv))
+ (fv-ran1 (copy fv)))
+ (sort! fv char<?)
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (if (char>? (string-ref fv (- i 1)) (string-ref fv i))
+ (display "oops")))
+ (do ((i 1 (+ i 1)))
+ ((= i len))
+ (if (char>? (fv (- i 1)) (fv i))
+ (display "oops")))
+ (sort! fv-ran (lambda (a b) (char<? a b)))
+ (if (not (string=? fv fv-ran))
+ (format *stderr* "string closure not equal~%"))
+ (sort! fv-ran1 char-less-than)
+ (if (not (string=? fv fv-ran))
+ (format *stderr* "string cond closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (reverse! fv)
+ (if (and (not (string=? fv-copy fv))
+ (string=? fv fv-orig))
+ (format *stderr* "string reverse!: ~A ~A~%" fv fv-orig))
+ (reverse! fv)
+ (if (not (string=? fv-copy fv))
+ (format *stderr* "string reverse! twice: ~A ~A~%" fv fv-copy))
+ (let ((fv1 (apply string (make-list len #\a))))
+ (if (or (not (= (length fv1) len))
+ (not (char=? (fv1 (- len 1)) #\a)))
+ (format *stderr* "string apply: ~A ~A~%" len (fv (- len 1)))))
+ ))))
+
+(define (p-tst len)
+ (let ((fv (make-list len)))
+ (if (not (= (length fv) len))
+ (format *stderr* "list length ~A: ~A~%" fv (length fv)))
+ (fill! fv 0)
+ (let ((fv-orig (copy fv)))
+ (do ((p fv (cdr p)))
+ ((null? p))
+ (set-car! p (- (random 100000) 50000)))
+ (let ((fv-ran (copy fv)))
+ (sort! fv <)
+ (call-with-exit
+ (lambda (quit)
+ (do ((p0 fv (cdr p0))
+ (p1 (cdr fv) (cdr p1))
+ (i 1 (+ i 1)))
+ ((null? p1))
+ (when (> (car p0) (car p1))
+ (format *stderr* "list: ~A > ~A at ~D~%" (car p0) (car p1) i)
+ (quit)))))
+ (sort! fv-ran (lambda (a b) (< a b)))
+ (if (not (equal? fv fv-ran))
+ (format *stderr* "pair closure not equal~%")))
+
+ (let ((fv-copy (copy fv)))
+ (set! fv (reverse! fv))
+ (if (and (not (equal? fv-copy fv))
+ (equal? fv fv-orig))
+ (format *stderr* "list reverse!: ~A ~A~%" fv fv-orig))
+ (set! fv (reverse! fv))
+ (if (not (equal? fv-copy fv))
+ (format *stderr* "list reverse! twice: ~A ~A~%" fv fv-copy))
+ ))))
+
+(define (e-tst len)
+ (let ((ht (make-hash-table len))
+ (lst (make-list len)))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (list-set! lst i i))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (if (not (= (list-ref lst i) i)) (display "oops")))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (lst i) i))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (if (not (= (lst i) i)) (display "oops")))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (hash-table-set! ht i i))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (if (not (= (hash-table-ref ht i) i)) (display "oops")))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (set! (ht i) i))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (if (not (= (ht i) i)) (display "oops")))))
+
+
+
+(define (test-it)
+ (for-each
+ (lambda (b p)
+ (do ((k 0 (+ k 1)))
+ ((= k 1000))
+ (fv-tst b)
+ (iv-tst b)
+ (v-tst b)
+ (s-tst b)
+ (p-tst b)
+ (e-tst b))
+ (do ((i 0 (+ i 1)))
+ ((= i p))
+ (format *stderr* "~D " (expt b i))
+ (fv-tst (expt b i))
+ (iv-tst (expt b i))
+ (v-tst (expt b i))
+ (s-tst (expt b i))
+ (p-tst (expt b i))))
+ (list 2 3 4 7 10)
+ (list 12 4 3 6 6)))
+
+(test-it)
+
+(newline *stderr*)
+
+(let ((size 1000000))
+ (define (fe1 x) (if (not (char=? x #\1)) (display x)))
+ (define (fe2) (for-each fe1 (make-string size #\1)))
+ (define (fe20) (for-each char-upcase (make-string size #\1)))
+ (fe2) (fe20)
+
+ (define (fe3 x) (if (not (char=? x #\1)) (display x)))
+ (define (fe4) (for-each fe3 (make-list size #\1)))
+ (define (fe40) (for-each char? (make-list size #\1)))
+ (fe4) (fe40)
+
+ (define (fe5 x) (if (not (char=? x #\1)) (display x)))
+ (define (fe6) (for-each fe5 (make-vector size #\1)))
+ (define (fe60) (for-each char-alphabetic? (make-vector size #\1)))
+ (fe6) (fe60)
+
+ (define (fe7 x) (if (not (= x 1)) (display x)))
+ (define (fe8) (for-each fe7 (make-int-vector size 1)))
+ (define (fe80) (for-each abs (make-int-vector size 1)))
+ (fe8) (fe80)
+
+ (define (fe9 x) (if (not (= x 1.0)) (display x)))
+ (define (fe10) (for-each fe9 (make-float-vector size 1.0)))
+ (define (fe100) (for-each real? (make-float-vector size 1.0)))
+ (fe10) (fe100)
+
+ (define (fe11 p) (if (member 1 (make-list p 2) >) (display "oops")))
+ (fe11 size)
+ (fe11 1)
+ (define (less a b) (> a b))
+ (define (fe12 p) (if (member 1 (make-list p 2) less) (display "oops")))
+ (fe12 size)
+ (fe12 1)
+ (define (fe13 p) (if (member 1 (make-list p 2) (lambda (a b) (cond ((> a b) #t) (#t #f)))) (display "oops")))
+ (fe13 size)
+ (fe13 1))
+
+(s7-version)
+(exit)
+
+
+
+;;; unsafe, strings, precheck types in vect cases
\ No newline at end of file
diff --git a/tools/va.scm b/tools/va.scm
index 337fc8a..53931c4 100755
--- a/tools/va.scm
+++ b/tools/va.scm
@@ -1,305 +1,281 @@
-;;; a script to search for allocation mismatches and unterminated XtVa args
+;;; various lint-like checks
-(define xtva-ctr 0)
-
-(define (for-each-file func files)
- (if (not (null? files))
- (let ((count 1))
- ;(display (format #f "~%~A" (car files)))
- (call-with-input-file
- (car files)
- (lambda (file)
- (let loop ((line (read-line file #t)))
- (or (eof-object? line)
- (begin
- (func line (car files) count)
- (set! count (+ 1 count))
- (loop (read-line file #t)))))))
- (for-each-file func (cdr files)))))
+(define (find-if pred l)
+ (cond ((null? l) #f)
+ ((pred (car l)) (car l))
+ (else (find-if pred (cdr l)))))
+
+(define (va)
+ (for-each
+ (lambda (func)
+ (system (format #f "fgrep ~A *.c > vahi" func))
+ (call-with-input-file "vahi"
+ (lambda (file)
+ (let loop ((line (read-line file #t)))
+ (or (eof-object? line)
+ (let ((len (length line))
+ (precount 0)
+ (ok #f)
+ (count 0)
+ (flen (length func)))
+ ;; look for * miscounts
+ (call-with-exit
+ (lambda (return)
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (case (string-ref line i)
+ ((#\*)
+ (set! count (+ 1 count)))
+ ((#\=)
+ (set! count 0))
+ (else
+ (if (and (< i (- len 2))
+ (string=? (substring line i (+ i 2)) "/*"))
+ (return #f)
+ (if (and (< i (- len flen))
+ (string=? (substring line i (+ i flen)) func))
+ (begin
+ (set! precount count)
+ (set! count 0))
+ (if (and (< i (- len 6))
+ (string=? (substring line i (+ i 6)) "sizeof"))
+ (begin
+ (set! ok #t)
+ (set! count 0))))))))))
+ (if (and ok
+ (not (= precount count 0))
+ (not (= count (- precount 1))))
+ (format #t "calloc ~D->~D: ~A~%" precount count line))
+ (loop (read-line file #t))))))))
+ (list "calloc" "malloc" "realloc"))
+
+
+ (load "lint.scm")
+
+ (for-each
+ (lambda (filename)
+ (if (and (provided? 'gtk3)
+ (provided? 'xg))
+ (call-with-input-file filename
+ (lambda (file)
+ (let ((line-number 0))
+ (let loop ((line (read-line file #t)))
+ (or (eof-object? line)
+ (let ((len (length line)))
+ (set! line-number (+ line-number 1))
+ (if (> len 8)
+ (let ((start 0))
+ (do ((i 1 (+ i 1)))
+ ((>= i len))
+ (let ((chr (line i)))
+ (if (or (char-whitespace? chr)
+ (char=? chr #\)))
+ (let* ((name (substring line (+ 1 start) i))
+ (name-len (length name)))
+ (if (and (or (and (> name-len 4)
+ (or (string-ci=? "gtk_" (substring name 0 4))
+ (string-ci=? "gdk_" (substring name 0 4))))
+ (and (> name-len 6)
+ (or (string-ci=? "pango_" (substring name 0 6))
+ (string-ci=? "cairo_" (substring name 0 6)))))
+ (not (defined? (string->symbol name) *gtk*)))
+ (format #t "~A (~A[~D]) is not defined~%" name filename line-number))))
+ (if (and (not (char=? chr #\_))
+ (not (char-alphabetic? chr))
+ (not (char-numeric? chr)))
+ (set! start i))))))
+ (loop (read-line file #t)))))))))
-(for-each-file
- (let ((va-state 'before))
- (lambda (line file count)
- (let ((len (string-length line)))
- ;; look for "XtVa..." then NULL);
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let ((ch (string-ref line i)))
- (if (char=? ch (integer->char #o015))
- (display (format #f "~A has /r (~A)~%" file count)))
- (if (char=? ch #\X)
- (if (and (< i (- len 4))
- (string=? (substring line i (+ i 4)) "XtVa"))
- (set! va-state 'within))
- (if (char=? ch #\N)
- (if (and (< i (- len 6))
- (string=? (substring line i (+ i 6)) "NULL);"))
- (begin
- (if (eq? va-state 'within) (set! xtva-ctr (+ xtva-ctr 1)))
- (set! va-state 'before)))
- (if (char=? ch #\;)
- (if (eq? va-state 'within)
- (begin
- (display (format #f "~A[~A]: ~A~%" file count line))
- (set! va-state 'before)))))))))))
+ ; (if (string=? (substring filename (- (length filename) 3)) "scm")
+ ; (lint filename))
+ )
+ (list
+ "analog-filter.scm"
+ "animals.scm"
+ "autosave.scm"
+ "bess.scm"
+ "bess1.scm"
+ "big-gens.scm"
+ "binary-io.scm"
+ "bird.scm"
+ "clean.scm"
+ "clm-ins.scm"
+ "clm23.scm"
+ "dlocsig.scm"
+ "draw.scm"
+ "dsp.scm"
+ "edit-menu.scm"
+ "edit123.scm"
+ "effects-utils.scm"
+ "env.scm"
+ "enved.scm"
+ "examp.scm"
+ "expandn.scm"
+ "extensions.scm"
+ "fade.scm"
+ "fft-menu.scm"
+ "fmv.scm"
+ ; "frame.scm"
+ "freeverb.scm"
+ "fullmix.scm"
+ "generators.scm"
+ "grani.scm"
+ "gtk-effects-utils.scm"
+ "gtk-effects.scm"
+ "hooks.scm"
+ "index.scm"
+ "jcrev.scm"
+ "jcvoi.scm"
+ "lint.scm"
+ "maraca.scm"
+ "marks-menu.scm"
+ "marks.scm"
+ "maxf.scm"
+ "misc.scm"
+ "mix.scm"
+ ; "mixer.scm"
+ "moog.scm"
+ "musglyphs.scm"
+ "nb.scm"
+ "new-backgrounds.scm"
+ "new-effects.scm"
+ "noise.scm"
+ "nrev.scm"
+ "numerics.scm"
+ "peak-phases.scm"
+ "piano.scm"
+ "play.scm"
+ "poly.scm"
+ "prc95.scm"
+ "primes.scm"
+ "pvoc.scm"
+ "rgb.scm"
+ ; "rtio.scm"
+ "rubber.scm"
+ "s7-slib-init.scm"
+ "s7test.scm"
+ "selection.scm"
+ "singer.scm"
+ "snd-gl.scm"
+ "snd-gtk.scm"
+ "snd-motif.scm"
+ "snd-test.scm"
+; "snd11.scm"
+; "snd12.scm"
+ "snddiff.scm"
+ "sndlib-ws.scm"
+ "sndwarp.scm"
+ "special-menu.scm"
+ "spectr.scm"
+ "spokenword.scm"
+ "stochastic.scm"
+ "strad.scm"
+ "v.scm"
+ "write.scm"
+ "ws.scm"
+ "xm-enved.scm"
+ "zip.scm"
+
+ "snd.html"
+ "sndscm.html"
+ "grfsnd.html"
+ "extsnd.html"
+ "sndclm.html"
+ "fm.html"
+ "s7.html"
+ "sndlib.html"
+ )))
- (list "snd-xutils.c" "snd-xhelp.c" "snd-xfind.c" "snd-xmenu.c" "snd-xdraw.c" "snd-xlistener.c" "snd-xchn.c"
- "snd-xsnd.c" "snd-xregion.c" "snd-xdrop.c" "snd-xmain.c" "snd-xmix.c" "snd-xrec.c" "snd-xenv.c"
- "snd-gxbitmaps.c" "snd-gxcolormaps.c" "snd-xfft.c" "snd-xprint.c" "snd-xfile.c" "snd-xen.c"
- "snd-data.c" "snd-draw.c" "snd-xprefs.c" ))
+(va)
+#|
(for-each
- (lambda (func)
- (system (format #f "fgrep ~A *.c > vahi" func))
- (call-with-input-file "vahi"
+ (lambda (filename)
+ (call-with-input-file filename
(lambda (file)
- (let loop ((line (read-line file #t)))
- (or (eof-object? line)
- (let ((len (string-length line))
- (precount 0)
- (ok #f)
- (count 0)
- (flen (string-length func)))
- ;; look for * miscounts
- (call-with-exit
- (lambda (return)
- (do ((i 0 (+ 1 i)))
- ((= i len))
- (let ((ch (string-ref line i)))
- (if (char=? ch #\*)
- (set! count (+ 1 count))
- (if (char=? ch #\=)
- (set! count 0)
- (if (and (< i (- len 2))
- (string=? (substring line i (+ i 2)) "/*"))
- (return #f)
- (if (and (< i (- len flen))
- (string=? (substring line i (+ i flen)) func))
- (begin
- (set! precount count)
- (set! count 0))
- (if (and (< i (- len 6))
- (string=? (substring line i (+ i 6)) "sizeof"))
- (begin
- (set! ok #t)
- (set! count 0)))))))))))
- (if (and ok
- (not (= precount count 0))
- (not (= count (- precount 1))))
- (display (format #f "calloc ~D->~D: ~A~%" precount count line)))
- (loop (read-line file #t))))))))
- (list "CALLOC" "MALLOC" "REALLOC" "calloc" "malloc" "realloc"))
-
-
-;;; look for missing or unused tips
-
-(if (not (defined? 'find-if))
- (define (find-if pred l)
- "(find-if func lst) scans 'lst' for any element that 'func' likes"
- (cond ((null? l) #f)
- ((pred (car l)) (car l))
- (else (find-if pred (cdr l))))))
-
-(let ((tip-list '())
- (new-tip-list '())
- (warned-list '()))
-
- (call-with-input-file "wz_data.js"
- (lambda (file)
- (let loop ((line (read-line file #t))) ; concat means leave the final crlf in place
- (or (eof-object? line)
- (let ((len (string-length line)))
- (if (and (> len 8)
- (string=? "var " (substring line 0 4)))
- (let ((end (do ((i 4 (+ 1 i)))
- ((or (>= i len)
- (char=? (string-ref line i) #\space))
- i))))
- (if (< end len)
- (set! tip-list (cons (substring line 4 end) tip-list)))))
- (loop (read-line file #t)))))))
-
- (for-each
- (lambda (filename)
- (call-with-input-file filename
- (lambda (file)
+ (let ((line-number 0)
+ (last-name ""))
(let loop ((line (read-line file #t)))
(or (eof-object? line)
- (let ((len (string-length line)))
- (if (> len 8)
- (let ((start 0))
- (do ((i 0 (+ 1 i)))
+ (let ((len (length line)))
+ (set! line-number (+ line-number 1))
+ (if (> len 0)
+ (let ((start #f))
+ (do ((i 0 (+ i 1)))
((>= i len))
- (let ((chr (string-ref line i)))
- (if (char=? chr #\))
- (let* ((name (substring line (+ 1 start) i))
- (len (string-length name)))
- (if (and (> len 4)
- (string=? "_tip" (substring name (- len 4) len)))
- (begin
- (if (and (not (find-if (lambda (str)
- (string=? str name))
- tip-list))
- (not (find-if (lambda (str)
- (string=? str name))
- warned-list)))
- (begin
- (set! warned-list (cons name warned-list))
- (display (format #f ";can't find ~A in wz_data.js~%" name))))
- (if (not (find-if (lambda (str)
- (string=? str name))
- new-tip-list))
- (set! new-tip-list (cons name new-tip-list))))))
- (if (and (not (char=? chr #\_))
- (not (char-alphabetic? chr))
- (not (char-numeric? chr)))
- (set! start i)))))))
- (loop (read-line file #t))))))))
- (list "snd.html" "extsnd.html" "sndlib.html" "grfsnd.html" "sndclm.html" "sndscm.html"))
+ (let ((chr (line i)))
+ (if (not (char-whitespace? chr))
+ (if (not start)
+ (set! start i))
+ (if start
+ (let* ((name (substring line start i))
+ (name-len (length name)))
+ ;(format #t "~C: ~A~%" chr name)
+ (if (and (> name-len 0)
+ (char-alphabetic? (name 0))
+ (string=? name last-name))
+ (format #t ";~A[~D]: ~A repeats in ~A~%" filename line-number name line))
+ (set! last-name name)
+ (set! start #f))))))))
+ (loop (read-line file #t)))))))))
+ (list
+ "snd.html"
+ "sndscm.html"
+ "grfsnd.html"
+ "extsnd.html"
+ "sndclm.html"
+ "fm.html"
+ "s7.html"
+ "sndlib.html"
+ ))
+|#
+
+#|
+(format #t "--------------------------------------------------------------------------------~%")
+(let ((png-files (directory->list "/home/bil/cl/pix"))
+ (baddies ()))
(for-each
- (lambda (name)
- (if (not (find-if (lambda (str)
- (string=? str name))
- new-tip-list))
- (display (format #f ";defined in wz_data.js but not used: ~A~%" name))))
- tip-list))
+ (lambda (file)
+ (if (and (not (directory? file))
+ (not (zero? (system (format #f "fgrep ~A *.html" file)))))
+ (set! baddies (cons file baddies))))
+ png-files)
+ (if (not (null? baddies))
+ (begin
+ (format #t "--------------------------------------------------------------------------------~%")
+ (format #t ";unused pix/png: ~{~A ~}~%" baddies)
+ (format #t "--------------------------------------------------------------------------------~%"))))
+|#
+#|
+;;; check for incorrect port_write_string lengths -- is confused by \"
+(call-with-input-file "s7.c"
+ (lambda (file)
+ (let ((count 0))
+ (let loop ((line (read-line file #t)))
+ (or (eof-object? line)
+ (let ((pos (string-position "port_write_string(" line)))
+ (set! count (+ count 1))
+ (if pos
+ (let ((qpos (char-position #\" (substring line (+ pos 1)))))
+ (if qpos
+ (let ((npos (char-position #\, (substring line (+ pos qpos 2)))))
+ (if npos
+ (let ((len (- npos 1))
+ (new-line (substring line (+ pos qpos 2 npos))))
+ (let ((ccpos (char-position #\, (substring new-line 1))))
+ (if ccpos
+ (let ((clen (string->number (substring new-line 2 (+ ccpos 1)))))
+ (if (and clen
+ (not (= clen len)))
+ (format *stderr* "[~D]: ~A: length ~A ~A~%" count
+ (substring line (char-position #\p line) (char-position #\; line))
+ len clen)))))))))))
+ (loop (read-line file #t))))))))
+|#
-;;; look for untranslated gtk2 stuff
+(exit)
-(if (and (provided? 'gtk3)
- (provided? 'xg))
- (for-each
- (lambda (filename)
- (call-with-input-file filename
- (lambda (file)
- (let ((line-number 0))
- (let loop ((line (read-line file #t)))
- (or (eof-object? line)
- (let ((len (string-length line)))
- (set! line-number (+ line-number 1))
- (if (> len 8)
- (let ((start 0))
- (do ((i 1 (+ 1 i)))
- ((>= i len))
- (let ((chr (string-ref line i)))
- (if (or (char-whitespace? chr)
- (char=? chr #\)))
- (let* ((name (substring line (+ 1 start) i))
- (name-len (string-length name)))
- (if (or (and (> name-len 4)
- (or (string=? "gtk_" (substring name 0 4))
- (string=? "GTK_" (substring name 0 4))
- (string=? "gdk_" (substring name 0 4))
- (string=? "GDK_" (substring name 0 4))))
- (and (> name-len 6)
- (or (string=? "pango_" (substring name 0 6))
- (string=? "PANGO_" (substring name 0 6))
- (string=? "cairo_" (substring name 0 6))
- (string=? "CAIRO_" (substring name 0 6)))))
- (if (not (defined? (string->symbol name)))
- (format #t "~A (~A[~D]) is not defined~%" name filename line-number)))))
- (if (and (not (char=? chr #\_))
- (not (char-alphabetic? chr))
- (not (char-numeric? chr)))
- (set! start i))))))
- (loop (read-line file #t)))))))))
- (list
- "analog-filter.scm"
- "animals.scm"
- "autosave.scm"
- "bess.scm"
- "bess1.scm"
- "big-gens.scm"
- "binary-io.scm"
- "bird.scm"
- "clean.scm"
- "clm-ins.scm"
- "clm23.scm"
- "dlocsig.scm"
- "draw.scm"
- "dsp.scm"
- "edit-menu.scm"
- "edit123.scm"
- "effects-utils.scm"
- "env.scm"
- "enved.scm"
- "examp.scm"
- "expandn.scm"
- "extensions.scm"
- "fade.scm"
- "fft-menu.scm"
- "fmv.scm"
- "frame.scm"
- "freeverb.scm"
- "fullmix.scm"
- "generators.scm"
- "grani.scm"
- "gtk-effects-utils.scm"
- "gtk-effects.scm"
- "hooks.scm"
- "index.scm"
- "jcrev.scm"
- "jcvoi.scm"
- "kmenu.scm"
- "maraca.scm"
- "marks-menu.scm"
- "marks.scm"
- "maxf.scm"
- "misc.scm"
- "mix.scm"
- "mixer.scm"
- "moog.scm"
- "musglyphs.scm"
- "nb.scm"
- "new-backgrounds.scm"
- "new-effects.scm"
- "noise.scm"
- "nrev.scm"
- "numerics.scm"
- "oscope.scm"
- "peak-phases.scm"
- "piano.scm"
- "play.scm"
- "poly.scm"
- "prc95.scm"
- "pretty-print.scm"
- "primes.scm"
- "pvoc.scm"
- "rgb.scm"
- "rtio.scm"
- "rubber.scm"
- "s7-slib-init.scm"
- "s7test.scm"
- "selection.scm"
- "singer.scm"
- "snd-gl.scm"
- "snd-gtk.scm"
- "snd-motif.scm"
- "snd-test.scm"
- "snd10.scm"
- "snd11.scm"
- "snd9.scm"
- "snddiff.scm"
- "sndlib-ws.scm"
- "sndwarp.scm"
- "special-menu.scm"
- "spectr.scm"
- "spokenword.scm"
- "stochastic.scm"
- "strad.scm"
- "v.scm"
- "ws.scm"
- "xm-enved.scm"
- "zip.scm"
-
- "snd.html"
- "sndscm.html"
- "grfsnd.html"
- "extsnd.html"
- "libxm.html"
- )))
-(exit)
diff --git a/tools/valcall.scm b/tools/valcall.scm
new file mode 100644
index 0000000..aa237d1
--- /dev/null
+++ b/tools/valcall.scm
@@ -0,0 +1,67 @@
+(define file-names '(("teq.scm" . "v-eq")
+ ("titer.scm" . "v-iter")
+ ("tmap.scm" . "v-map")
+ ("tform.scm" . "v-form")
+ ("thash.scm" . "v-hash")
+ ("tcopy.scm" . "v-cop")
+ ("lg.scm" . "v-lg")
+ ("tgen.scm" . "v-gen")
+ ("tauto.scm" . "v-auto")
+ ("make-index.scm" . "v-index")
+ ("snd-test.scm" . "v-call")
+ ("tall.scm" . "v-all")
+ ("s7test.scm" . "v-test")
+ ))
+
+(define (last-callg)
+ (let ((name (system "ls callg*" #t)))
+ (let ((len (length name)))
+ (do ((i 0 (+ i 1)))
+ ((or (= i len)
+ (char-whitespace? (name i)))
+ (substring name 0 i))))))
+
+(define (next-file f)
+ (let ((name (system (format #f "ls -t ~A*" f) #t)))
+ (let ((len (length name)))
+ (do ((i 0 (+ i 1)))
+ ((or (= i len)
+ (and (char-numeric? (name i))
+ (char-numeric? (name (+ i 1)))))
+ (+ 1 (string->number (substring name i (+ i 2)))))))))
+
+(define (call-valgrind)
+ (for-each
+ (lambda (caller+file)
+ (system "rm callg*")
+ (format *stderr* "~%~NC~%~NC ~A ~NC~%~NC~%" 40 #\- 16 #\- (cadr caller+file) 16 #\- 40 #\-)
+ (system (format #f "valgrind --tool=callgrind ./~A ~A" (car caller+file) (cadr caller+file)))
+ (let ((outfile (cdr (assoc (cadr caller+file) file-names))))
+ (let ((next (next-file outfile)))
+ (system (format #f "callgrind_annotate --auto=yes --threshold=100 ~A > ~A~D" (last-callg) outfile next))
+ (format *stderr* "~NC ~A~D -> ~A~D: ~NC~%" 8 #\space outfile (- next 1) outfile next 8 #\space)
+ (system (format #f "./snd compare-calls.scm -e '(compare-calls \"~A~D\" \"~A~D\")'" outfile (- next 1) outfile next)))))
+ (list (list "repl" "teq.scm")
+ (list "repl" "s7test.scm")
+ (list "snd -noinit" "make-index.scm")
+ (list "repl" "tmap.scm")
+ (list "repl" "tform.scm")
+ (list "repl" "tcopy.scm")
+ (list "repl" "tauto.scm")
+ (list "repl" "titer.scm")
+ (list "repl" "lg.scm")
+ (list "repl" "thash.scm")
+ (list "snd -noinit" "tgen.scm") ; repl here + cload sndlib was slower
+ (list "snd -noinit" "tall.scm")
+ (list "snd -l" "snd-test.scm")
+ )))
+
+
+(call-valgrind)
+
+(when (file-exists? "test.table")
+ (system "mv test.table old-test.table")
+ (load "compare-calls.scm")
+ (combine-latest))
+
+(exit)
\ No newline at end of file
diff --git a/tools/xgdata.scm b/tools/xgdata.scm
index e58cb88..6dd207d 100644
--- a/tools/xgdata.scm
+++ b/tools/xgdata.scm
@@ -1,13 +1,75 @@
;;; [] for ref args, @ for ptr args that can be null, # are optional (default #f)
;;; || for ref arg list, {} for ref arg int as list len
;;; & in struct for settable field
-;;; 4 semicolon comments = removed because I can't see any use for it
-(CFNC "gchar* g_type_name GType type")
-(CFNC "GQuark g_type_qname GType type")
-(CFNC "GType g_type_from_name gchar* name")
-(CFNC "GType g_type_parent GType type")
-(CFNC "gboolean g_type_is_a GType type GType is_a_type")
+(CFNC "gboolean g_unichar_validate gunichar ch")
+(CFNC "gboolean g_unichar_isalnum gunichar c")
+(CFNC "gboolean g_unichar_isalpha gunichar c")
+(CFNC "gboolean g_unichar_iscntrl gunichar c")
+(CFNC "gboolean g_unichar_isdefined gunichar c")
+(CFNC "gboolean g_unichar_isdigit gunichar c")
+(CFNC "gboolean g_unichar_isgraph gunichar c")
+(CFNC "gboolean g_unichar_islower gunichar c")
+(CFNC "gboolean g_unichar_ismark gunichar c")
+(CFNC "gboolean g_unichar_isprint gunichar c")
+(CFNC "gboolean g_unichar_ispunct gunichar c")
+(CFNC "gboolean g_unichar_isspace gunichar c")
+(CFNC "gboolean g_unichar_istitle gunichar c")
+(CFNC "gboolean g_unichar_isupper gunichar c")
+(CFNC "gboolean g_unichar_isxdigit gunichar c")
+(CFNC "gboolean g_unichar_iswide gunichar c")
+(CFNC "gboolean g_unichar_iswide_cjk gunichar c")
+(CFNC "gboolean g_unichar_iszerowidth gunichar c")
+(CFNC "gunichar g_unichar_toupper gunichar c")
+(CFNC "gunichar g_unichar_tolower gunichar c")
+(CFNC "gunichar g_unichar_totitle gunichar c")
+(CFNC "gint g_unichar_digit_value gunichar c")
+(CFNC "gint g_unichar_xdigit_value gunichar c")
+;(CFNC "gboolean g_unichar_compose gunichar a gunichar b gunichar* [ch]")
+;(CFNC "gboolean g_unichar_decompose gunichar ch gunichar* a gunichar* [b]")
+;(CFNC "gsize g_unichar_fully_decompose gunichar ch gboolean compat gunichar* [result] gsize result_len")
+(CFNC "gint g_unichar_combining_class gunichar uc")
+(CFNC "void g_unicode_canonical_ordering gunichar* string gsize len")
+;(CFNC "gunichar* g_unicode_canonical_decomposition gunichar ch gsize* [result_len]")
+;(CFNC "gboolean g_unichar_get_mirror_char gunichar ch gunichar* mirrored_ch")
+
+(CFNC "gunichar g_utf8_get_char gchar* p" 'const)
+(CFNC "gunichar g_utf8_get_char_validated gchar* p gssize max_len" 'const)
+(CFNC "gchar* g_utf8_prev_char gchar* p" 'const)
+(CFNC "gchar* g_utf8_find_next_char gchar* p gchar* end" 'const)
+(CFNC "gchar* g_utf8_find_prev_char gchar* str gchar* p" 'const)
+(CFNC "glong g_utf8_strlen gchar* p gssize max" 'const)
+;(CFNC "gchar* g_utf8_strncpy gchar* dest gchar* src gsize n" 'const)
+(CFNC "gchar* g_utf8_strchr gchar* p gssize len gunichar c" 'const)
+(CFNC "gchar* g_utf8_strrchr gchar* p gssize len gunichar c" 'const)
+(CFNC "gchar* g_utf8_strreverse gchar* str gssize len" 'const)
+;(CFNC "gchar* g_utf8_substring gchar* str glong start_pos glong end_pos" 'const)
+(CFNC "gboolean g_utf8_validate gchar* str gssize max_len gchar** [end]" 'const)
+(CFNC "gchar* g_utf8_strup gchar* str gssize len" 'const)
+(CFNC "gchar* g_utf8_strdown gchar* str gssize len" 'const)
+(CFNC "gchar* g_utf8_casefold gchar* str gssize len" 'const)
+(CFNC "gchar* g_utf8_normalize gchar* str gssize len GNormalizeMode mode" 'const)
+(CFNC "gint g_utf8_collate gchar* str1 gchar* str2" 'const)
+(CFNC "gchar* g_utf8_collate_key gchar* str gssize len" 'const)
+(CFNC "gchar* g_utf8_collate_key_for_filename gchar* str gssize len" 'const)
+
+
+(CINT "G_NORMALIZE_DEFAULT" "GNormalizeMode")
+(CINT "G_NORMALIZE_NFD" "GNormalizeMode")
+(CINT "G_NORMALIZE_DEFAULT_COMPOSE" "GNormalizeMode")
+(CINT "G_NORMALIZE_NFC" "GNormalizeMode")
+(CINT "G_NORMALIZE_ALL" "GNormalizeMode")
+(CINT "G_NORMALIZE_NFKD" "GNormalizeMode")
+(CINT "G_NORMALIZE_ALL_COMPOSE" "GNormalizeMode")
+(CINT "G_NORMALIZE_NFKC" "GNormalizeMode")
+
+;gunichar is int
+
+;(CFNC "gchar* g_type_name GType type")
+;(CFNC "GQuark g_type_qname GType type")
+;(CFNC "GType g_type_from_name gchar* name")
+;(CFNC "GType g_type_parent GType type")
+;(CFNC "gboolean g_type_is_a GType type GType is_a_type")
(CINT "G_SIGNAL_RUN_FIRST" "GSignalFlags")
(CINT "G_SIGNAL_RUN_LAST" "GSignalFlags")
(CINT "G_SIGNAL_RUN_CLEANUP" "GSignalFlags")
@@ -70,26 +132,26 @@
;(CFNC "void _g_signals_destroy GType itype")
(CFNC "gpointer g_object_ref gpointer object")
(CFNC "void g_object_unref gpointer object")
-(CCAST-gtk2 "GDK_COLORMAP(object)" "GdkColormap*")
-(CCHK-gtk2 "GDK_IS_COLORMAP(object)" "GdkColormap*")
+;;; (CCAST-gtk2 "GDK_COLORMAP(object)" "GdkColormap*")
+;;; (CCHK-gtk2 "GDK_IS_COLORMAP(object)" "GdkColormap*")
;;;;(CFNC "GType gdk_colormap_get_type void")
(CFNC "GdkVisual* gdk_visual_get_system void") ; -- moved ahead of the gtk2 stuff
-(CFNC "GdkColor* gdk_color_copy GdkColor* color")
+;;; (CFNC-gtk2 "GdkColor* gdk_color_copy GdkColor* color")
-(CFNC-gtk2 "GdkColormap* gdk_colormap_new GdkVisual* visual gboolean allocate")
-(CFNC-gtk2 "GdkColormap* gdk_colormap_get_system void")
-(CFNC-gtk2 "gint gdk_colormap_alloc_colors GdkColormap* colormap GdkColor* colors gint ncolors gboolean writeable gboolean best_match gboolean* [success]")
-(CFNC-gtk2 "gboolean gdk_colormap_alloc_color GdkColormap* colormap GdkColor* color gboolean writeable gboolean best_match")
+;;; (CFNC-gtk2 "GdkColormap* gdk_colormap_new GdkVisual* visual gboolean allocate")
+;;; (CFNC-gtk2 "GdkColormap* gdk_colormap_get_system void")
+;;; (CFNC-gtk2 "gint gdk_colormap_alloc_colors GdkColormap* colormap GdkColor* colors gint ncolors gboolean writeable gboolean best_match gboolean* [success]")
+;;; (CFNC-gtk2 "gboolean gdk_colormap_alloc_color GdkColormap* colormap GdkColor* color gboolean writeable gboolean best_match")
;;; 2.91.0 ;(CFNC "void gdk_colormap_free_colors GdkColormap* colormap GdkColor* colors gint ncolors")
;can't currently pass the color struct as array element
;;; 2.90.6 (CFNC "void gdk_colormap_query_color GdkColormap* colormap gulong pixel GdkColor* result")
-(CFNC-gtk2 "GdkVisual* gdk_colormap_get_visual GdkColormap* colormap")
+;;; (CFNC-gtk2 "GdkVisual* gdk_colormap_get_visual GdkColormap* colormap")
-(CFNC "void gdk_color_free GdkColor* color")
-(CFNC "gint gdk_color_parse gchar* spec GdkColor* color")
-(CFNC "guint gdk_color_hash GdkColor* colora")
-(CFNC "gboolean gdk_color_equal GdkColor* colora GdkColor* colorb")
+;;; (CFNC-gtk2 "void gdk_color_free GdkColor* color")
+;;; (CFNC-gtk2 "gint gdk_color_parse gchar* spec GdkColor* color")
+;;; (CFNC-gtk2 "guint gdk_color_hash GdkColor* colora")
+;;; (CFNC-gtk2 "gboolean gdk_color_equal GdkColor* colora GdkColor* colorb")
;;;;(CFNC "GType gdk_color_get_type void")
(CINT "GDK_X_CURSOR" "GdkCursorType")
(CINT "GDK_ARROW" "GdkCursorType")
@@ -170,11 +232,16 @@
(CINT "GDK_XTERM" "GdkCursorType")
(CINT "GDK_LAST_CURSOR " "GdkCursorType")
;;; 2.91.0 (CINT "GDK_CURSOR_IS_PIXMAP" "GdkCursorType")
+
+;;; these were missed at some point:
+(CFNC "GdkCursor* gdk_cursor_new_for_display GdkDisplay* display GdkCursorType cursor_type")
+(CFNC "GdkDisplay* gdk_cursor_get_display GdkCursor* cursor")
+
;;;;(CFNC "GType gdk_cursor_get_type void")
-(CFNC "GdkCursor* gdk_cursor_new GdkCursorType cursor_type")
+;;; 3.15.2 (CFNC "GdkCursor* gdk_cursor_new GdkCursorType cursor_type")
;;; 2.91.0 (CFNC "GdkCursor* gdk_cursor_new_from_pixmap GdkPixmap* source GdkPixmap* mask GdkColor* fg GdkColor* bg gint x gint y")
-(CFNC-gtk2 "GdkCursor* gdk_cursor_ref GdkCursor* cursor")
-(CFNC-gtk2 "void gdk_cursor_unref GdkCursor* cursor")
+;;; (CFNC-gtk2 "GdkCursor* gdk_cursor_ref GdkCursor* cursor")
+;;; (CFNC-gtk2 "void gdk_cursor_unref GdkCursor* cursor")
(CINT "GDK_ACTION_DEFAULT" "GdkDragAction")
(CINT "GDK_ACTION_COPY" "GdkDragAction")
(CINT "GDK_ACTION_MOVE" "GdkDragAction")
@@ -182,13 +249,13 @@
(CINT "GDK_ACTION_PRIVATE" "GdkDragAction")
(CINT "GDK_ACTION_ASK" "GdkDragAction")
-(CINT-gtk2 "GDK_DRAG_PROTO_MOTIF" "GdkDragProtocol")
-(CINT-gtk2 "GDK_DRAG_PROTO_XDND" "GdkDragProtocol")
-(CINT-gtk2 "GDK_DRAG_PROTO_ROOTWIN" "GdkDragProtocol")
-(CINT-gtk2 "GDK_DRAG_PROTO_NONE" "GdkDragProtocol")
-(CINT-gtk2 "GDK_DRAG_PROTO_WIN32_DROPFILES" "GdkDragProtocol")
-(CINT-gtk2 "GDK_DRAG_PROTO_OLE2" "GdkDragProtocol")
-(CINT-gtk2 "GDK_DRAG_PROTO_LOCAL" "GdkDragProtocol")
+;;; ;;; 3.9.0 (CINT-gtk2 "GDK_DRAG_PROTO_MOTIF" "GdkDragProtocol")
+;;; (CINT-gtk2 "GDK_DRAG_PROTO_XDND" "GdkDragProtocol")
+;;; (CINT-gtk2 "GDK_DRAG_PROTO_ROOTWIN" "GdkDragProtocol")
+;;; (CINT-gtk2 "GDK_DRAG_PROTO_NONE" "GdkDragProtocol")
+;;; (CINT-gtk2 "GDK_DRAG_PROTO_WIN32_DROPFILES" "GdkDragProtocol")
+;;; (CINT-gtk2 "GDK_DRAG_PROTO_OLE2" "GdkDragProtocol")
+;;; (CINT-gtk2 "GDK_DRAG_PROTO_LOCAL" "GdkDragProtocol")
(CCAST "GDK_DRAG_CONTEXT(object)" "GdkDragContext*")
(CCHK "GDK_IS_DRAG_CONTEXT(object)" "GdkDragContext*")
@@ -198,24 +265,24 @@
(CFNC "void gdk_drop_finish GdkDragContext* context gboolean success guint32 time")
(CFNC "GdkAtom gdk_drag_get_selection GdkDragContext* context")
(CFNC "GdkDragContext* gdk_drag_begin GdkWindow* window GList* targets")
-(CFNC-gtk2 "GdkDragContext* gdk_drag_context_new void")
-(CFNC-gtk2 "guint32 gdk_drag_get_protocol guint32 xid GdkDragProtocol* [protocol]")
-(CFNC-gtk2 "void gdk_drag_find_window GdkDragContext* context GdkWindow* drag_window gint x_root gint y_root GdkWindow** [dest_window] GdkDragProtocol* [protocol]")
-(CFNC-gtk2 "gboolean gdk_drag_motion GdkDragContext* context GdkWindow* dest_window GdkDragProtocol protocol gint x_root gint y_root GdkDragAction suggested_action GdkDragAction possible_actions guint32 time")
+;;; (CFNC-gtk2 "GdkDragContext* gdk_drag_context_new void")
+;;; (CFNC-gtk2 "guint32 gdk_drag_get_protocol guint32 xid GdkDragProtocol* [protocol]")
+;;; (CFNC-gtk2 "void gdk_drag_find_window GdkDragContext* context GdkWindow* drag_window gint x_root gint y_root GdkWindow** [dest_window] GdkDragProtocol* [protocol]")
+;;; (CFNC-gtk2 "gboolean gdk_drag_motion GdkDragContext* context GdkWindow* dest_window GdkDragProtocol protocol gint x_root gint y_root GdkDragAction suggested_action GdkDragAction possible_actions guint32 time")
(CFNC "void gdk_drag_drop GdkDragContext* context guint32 time")
(CFNC "void gdk_drag_abort GdkDragContext* context guint32 time")
-(CCAST-gtk2 "GDK_DRAWABLE(object)" "GdkDrawable*")
-(CCHK-gtk2 "GDK_IS_DRAWABLE(object)" "GdkDrawable*")
+;;; (CCAST-gtk2 "GDK_DRAWABLE(object)" "GdkDrawable*")
+;;; (CCHK-gtk2 "GDK_IS_DRAWABLE(object)" "GdkDrawable*")
-(CFNC-300 "cairo_t* gdk_cairo_create GdkWindow* window") ;-- moved up
-(CFNC-gtk2 "cairo_t* gdk_cairo_create GdkDrawable* drawable") ;-- moved up
+(CFNC-3.0 "cairo_t* gdk_cairo_create GdkWindow* window") ;-- moved up
+;;; (CFNC-gtk2 "cairo_t* gdk_cairo_create GdkDrawable* drawable") ;-- moved up
;;;;(CFNC "GType gdk_drawable_get_type void")
-(CFNC-gtk2 "void gdk_drawable_get_size GdkDrawable* drawable gint* [width] gint* [height]")
-(CFNC-gtk2 "void gdk_drawable_set_colormap GdkDrawable* drawable GdkColormap* colormap")
-(CFNC-gtk2 "GdkColormap* gdk_drawable_get_colormap GdkDrawable* drawable")
-(CFNC-gtk2 "GdkVisual* gdk_drawable_get_visual GdkDrawable* drawable")
-(CFNC-gtk2 "gint gdk_drawable_get_depth GdkDrawable* drawable")
+;;; (CFNC-gtk2 "void gdk_drawable_get_size GdkDrawable* drawable gint* [width] gint* [height]")
+;;; (CFNC-gtk2 "void gdk_drawable_set_colormap GdkDrawable* drawable GdkColormap* colormap")
+;;; (CFNC-gtk2 "GdkColormap* gdk_drawable_get_colormap GdkDrawable* drawable")
+;;; (CFNC-gtk2 "GdkVisual* gdk_drawable_get_visual GdkDrawable* drawable")
+;;; (CFNC-gtk2 "gint gdk_drawable_get_depth GdkDrawable* drawable")
;;; 2.90.6 (CFNC "void gdk_draw_point GdkDrawable* drawable GdkGC* gc gint x gint y")
;;; 2.90.6 (CFNC "void gdk_draw_line GdkDrawable* drawable GdkGC* gc gint x1 gint y1 gint x2 gint y2")
;;; 2.90.6 (CFNC "void gdk_draw_rectangle GdkDrawable* drawable GdkGC* gc gboolean filled gint x gint y gint width gint height")
@@ -318,7 +385,7 @@
(CINT "GDK_DROP_FINISHED" "GdkEventType")
(CINT "GDK_CLIENT_EVENT" "GdkEventType")
(CINT "GDK_VISIBILITY_NOTIFY" "GdkEventType")
-(CINT-gtk2 "GDK_NO_EXPOSE" "GdkEventType")
+;;; (CINT-gtk2 "GDK_NO_EXPOSE" "GdkEventType")
(CINT "GDK_SCROLL" "GdkEventType")
(CINT "GDK_WINDOW_STATE" "GdkEventType")
(CINT "GDK_SETTING" "GdkEventType")
@@ -328,7 +395,7 @@
;;; these may be out 2.90.1
(CINT "GDK_EXPOSURE_MASK" "GdkEventMask")
(CINT "GDK_POINTER_MOTION_MASK" "GdkEventMask")
-(CINT "GDK_POINTER_MOTION_HINT_MASK" "GdkEventMask")
+;;; 3.12 (CINT "GDK_POINTER_MOTION_HINT_MASK" "GdkEventMask")
(CINT "GDK_BUTTON_MOTION_MASK" "GdkEventMask")
(CINT "GDK_BUTTON1_MOTION_MASK" "GdkEventMask")
(CINT "GDK_BUTTON2_MOTION_MASK" "GdkEventMask")
@@ -350,9 +417,9 @@
(CINT "GDK_ALL_EVENTS_MASK" "GdkEventMask")
-(CINT "GDK_VISIBILITY_UNOBSCURED " "GdkVisibilityState")
-(CINT "GDK_VISIBILITY_PARTIAL " "GdkVisibilityState")
-(CINT "GDK_VISIBILITY_FULLY_OBSCURED" "GdkVisibilityState")
+;;; 3.11.8 (CINT "GDK_VISIBILITY_UNOBSCURED " "GdkVisibilityState")
+;;; 3.11.8 (CINT "GDK_VISIBILITY_PARTIAL " "GdkVisibilityState")
+;;; 3.11.8 (CINT "GDK_VISIBILITY_FULLY_OBSCURED" "GdkVisibilityState")
(CINT "GDK_SCROLL_UP" "GdkScrollDirection")
(CINT "GDK_SCROLL_DOWN" "GdkScrollDirection")
(CINT "GDK_SCROLL_LEFT" "GdkScrollDirection")
@@ -475,12 +542,12 @@
;;; 2.90.6 (CFNC "void gdk_gc_set_rgb_bg_color GdkGC* gc GdkColor* color")
(CFNC "void gdk_init gint* {argc} gchar*** |argv|")
(CFNC "gboolean gdk_init_check gint* {argc} gchar*** |argv|")
-(CFNC-gtk2 "gchar* gdk_set_locale void")
+;;; (CFNC-gtk2 "gchar* gdk_set_locale void")
(CFNC "char* gdk_get_program_class void")
(CFNC "void gdk_set_program_class char* program_class")
(CFNC "void gdk_error_trap_push void")
(CFNC "gint gdk_error_trap_pop void")
-(CFNC "gchar* gdk_get_display void" 'free)
+;;; 3.9.0 (CFNC "gchar* gdk_get_display void" 'free)
(CFNC "gchar* gdk_get_display_arg_name void")
(CFNC "void gdk_notify_startup_complete void")
;;; 2.99.0 (CFNC "GdkGrabStatus gdk_pointer_grab GdkWindow* window gboolean owner_events GdkEventMask event_mask GdkWindow* confine_to GdkCursor* cursor guint32 time")
@@ -502,9 +569,9 @@
;;; out 2.3 (CFNC "gint gdk_mbstowcs GdkWChar* dest gchar* src gint dest_max")
;;; 2.99.3 (CFNC "void gdk_event_send_clientmessage_toall GdkEvent* event")
;;; 2.99.3 (CFNC "gboolean gdk_event_send_client_message GdkEvent* event guint32 xid")
-(CFNC "void gdk_threads_enter void")
-(CFNC "void gdk_threads_leave void")
-(CFNC "void gdk_threads_init void")
+;;; 3.5.10 (CFNC "void gdk_threads_enter void")
+;;; 3.5.10 (CFNC "void gdk_threads_leave void")
+;;; 3.5.10 (CFNC "void gdk_threads_init void")
;;; 2.90.6 (CINT "GDK_IMAGE_NORMAL" "GdkImageType")
;;; 2.90.6 (CINT "GDK_IMAGE_SHARED" "GdkImageType")
;;; 2.90.6 (CINT "GDK_IMAGE_FASTEST" "GdkImageType")
@@ -572,488 +639,488 @@
(CFNC "guint gdk_unicode_to_keyval guint32 wc")
;;; these all changed 2.90.7
-(CINT-300 "GDK_KEY_VoidSymbol")
-(CINT-300 "GDK_KEY_BackSpace")
-(CINT-300 "GDK_KEY_Tab")
-(CINT-300 "GDK_KEY_Linefeed")
-(CINT-300 "GDK_KEY_Clear")
-(CINT-300 "GDK_KEY_Return")
-(CINT-300 "GDK_KEY_Pause")
-(CINT-300 "GDK_KEY_Scroll_Lock")
-(CINT-300 "GDK_KEY_Sys_Req")
-(CINT-300 "GDK_KEY_Escape")
-(CINT-300 "GDK_KEY_Delete")
-(CINT-300 "GDK_KEY_Home")
-(CINT-300 "GDK_KEY_Left")
-(CINT-300 "GDK_KEY_Up")
-(CINT-300 "GDK_KEY_Right")
-(CINT-300 "GDK_KEY_Down")
-(CINT-300 "GDK_KEY_Prior")
-(CINT-300 "GDK_KEY_Page_Up")
-(CINT-300 "GDK_KEY_Next")
-(CINT-300 "GDK_KEY_Page_Down")
-(CINT-300 "GDK_KEY_End")
-(CINT-300 "GDK_KEY_Begin")
-(CINT-300 "GDK_KEY_Select")
-(CINT-300 "GDK_KEY_Print")
-(CINT-300 "GDK_KEY_Execute")
-(CINT-300 "GDK_KEY_Insert")
-(CINT-300 "GDK_KEY_Undo")
-(CINT-300 "GDK_KEY_Redo")
-(CINT-300 "GDK_KEY_Menu")
-(CINT-300 "GDK_KEY_Find")
-(CINT-300 "GDK_KEY_Cancel")
-(CINT-300 "GDK_KEY_Help")
-(CINT-300 "GDK_KEY_Break")
-(CINT-300 "GDK_KEY_Mode_switch")
-(CINT-300 "GDK_KEY_script_switch")
-(CINT-300 "GDK_KEY_Num_Lock")
-(CINT-300 "GDK_KEY_KP_Space")
-(CINT-300 "GDK_KEY_KP_Tab")
-(CINT-300 "GDK_KEY_KP_Enter")
-(CINT-300 "GDK_KEY_KP_F1")
-(CINT-300 "GDK_KEY_KP_F2")
-(CINT-300 "GDK_KEY_KP_F3")
-(CINT-300 "GDK_KEY_KP_F4")
-(CINT-300 "GDK_KEY_KP_Home")
-(CINT-300 "GDK_KEY_KP_Left")
-(CINT-300 "GDK_KEY_KP_Up")
-(CINT-300 "GDK_KEY_KP_Right")
-(CINT-300 "GDK_KEY_KP_Down")
-(CINT-300 "GDK_KEY_KP_Prior")
-(CINT-300 "GDK_KEY_KP_Page_Up")
-(CINT-300 "GDK_KEY_KP_Next")
-(CINT-300 "GDK_KEY_KP_Page_Down")
-(CINT-300 "GDK_KEY_KP_End")
-(CINT-300 "GDK_KEY_KP_Begin")
-(CINT-300 "GDK_KEY_KP_Insert")
-(CINT-300 "GDK_KEY_KP_Delete")
-(CINT-300 "GDK_KEY_KP_Equal")
-(CINT-300 "GDK_KEY_KP_Multiply")
-(CINT-300 "GDK_KEY_KP_Add")
-(CINT-300 "GDK_KEY_KP_Separator")
-(CINT-300 "GDK_KEY_KP_Subtract")
-(CINT-300 "GDK_KEY_KP_Decimal")
-(CINT-300 "GDK_KEY_KP_Divide")
-(CINT-300 "GDK_KEY_KP_0")
-(CINT-300 "GDK_KEY_KP_1")
-(CINT-300 "GDK_KEY_KP_2")
-(CINT-300 "GDK_KEY_KP_3")
-(CINT-300 "GDK_KEY_KP_4")
-(CINT-300 "GDK_KEY_KP_5")
-(CINT-300 "GDK_KEY_KP_6")
-(CINT-300 "GDK_KEY_KP_7")
-(CINT-300 "GDK_KEY_KP_8")
-(CINT-300 "GDK_KEY_KP_9")
-(CINT-300 "GDK_KEY_F1")
-(CINT-300 "GDK_KEY_F2")
-(CINT-300 "GDK_KEY_F3")
-(CINT-300 "GDK_KEY_F4")
-(CINT-300 "GDK_KEY_F5")
-(CINT-300 "GDK_KEY_F6")
-(CINT-300 "GDK_KEY_F7")
-(CINT-300 "GDK_KEY_F8")
-(CINT-300 "GDK_KEY_F9")
-(CINT-300 "GDK_KEY_F10")
-(CINT-300 "GDK_KEY_F11")
-(CINT-300 "GDK_KEY_L1")
-(CINT-300 "GDK_KEY_F12")
-(CINT-300 "GDK_KEY_L2")
-(CINT-300 "GDK_KEY_F13")
-(CINT-300 "GDK_KEY_L3")
-(CINT-300 "GDK_KEY_F14")
-(CINT-300 "GDK_KEY_L4")
-(CINT-300 "GDK_KEY_F15")
-(CINT-300 "GDK_KEY_L5")
-(CINT-300 "GDK_KEY_F16")
-(CINT-300 "GDK_KEY_L6")
-(CINT-300 "GDK_KEY_F17")
-(CINT-300 "GDK_KEY_L7")
-(CINT-300 "GDK_KEY_F18")
-(CINT-300 "GDK_KEY_L8")
-(CINT-300 "GDK_KEY_F19")
-(CINT-300 "GDK_KEY_L9")
-(CINT-300 "GDK_KEY_F20")
-(CINT-300 "GDK_KEY_L10")
-(CINT-300 "GDK_KEY_F21")
-(CINT-300 "GDK_KEY_R1")
-(CINT-300 "GDK_KEY_F22")
-(CINT-300 "GDK_KEY_R2")
-(CINT-300 "GDK_KEY_F23")
-(CINT-300 "GDK_KEY_R3")
-(CINT-300 "GDK_KEY_F24")
-(CINT-300 "GDK_KEY_R4")
-(CINT-300 "GDK_KEY_F25")
-(CINT-300 "GDK_KEY_R5")
-(CINT-300 "GDK_KEY_F26")
-(CINT-300 "GDK_KEY_R6")
-(CINT-300 "GDK_KEY_F27")
-(CINT-300 "GDK_KEY_R7")
-(CINT-300 "GDK_KEY_F28")
-(CINT-300 "GDK_KEY_R8")
-(CINT-300 "GDK_KEY_F29")
-(CINT-300 "GDK_KEY_R9")
-(CINT-300 "GDK_KEY_F30")
-(CINT-300 "GDK_KEY_R10")
-(CINT-300 "GDK_KEY_F31")
-(CINT-300 "GDK_KEY_R11")
-(CINT-300 "GDK_KEY_F32")
-(CINT-300 "GDK_KEY_R12")
-(CINT-300 "GDK_KEY_F33")
-(CINT-300 "GDK_KEY_R13")
-(CINT-300 "GDK_KEY_F34")
-(CINT-300 "GDK_KEY_R14")
-(CINT-300 "GDK_KEY_F35")
-(CINT-300 "GDK_KEY_R15")
-(CINT-300 "GDK_KEY_Shift_L")
-(CINT-300 "GDK_KEY_Shift_R")
-(CINT-300 "GDK_KEY_Control_L")
-(CINT-300 "GDK_KEY_Control_R")
-(CINT-300 "GDK_KEY_Caps_Lock")
-(CINT-300 "GDK_KEY_Shift_Lock")
-(CINT-300 "GDK_KEY_Meta_L")
-(CINT-300 "GDK_KEY_Meta_R")
-(CINT-300 "GDK_KEY_Alt_L")
-(CINT-300 "GDK_KEY_Alt_R")
-(CINT-300 "GDK_KEY_space")
-(CINT-300 "GDK_KEY_exclam")
-(CINT-300 "GDK_KEY_quotedbl")
-(CINT-300 "GDK_KEY_numbersign")
-(CINT-300 "GDK_KEY_dollar")
-(CINT-300 "GDK_KEY_percent")
-(CINT-300 "GDK_KEY_ampersand")
-(CINT-300 "GDK_KEY_apostrophe")
-(CINT-300 "GDK_KEY_quoteright")
-(CINT-300 "GDK_KEY_parenleft")
-(CINT-300 "GDK_KEY_parenright")
-(CINT-300 "GDK_KEY_asterisk")
-(CINT-300 "GDK_KEY_plus")
-(CINT-300 "GDK_KEY_comma")
-(CINT-300 "GDK_KEY_minus")
-(CINT-300 "GDK_KEY_period")
-(CINT-300 "GDK_KEY_slash")
-(CINT-300 "GDK_KEY_0")
-(CINT-300 "GDK_KEY_1")
-(CINT-300 "GDK_KEY_2")
-(CINT-300 "GDK_KEY_3")
-(CINT-300 "GDK_KEY_4")
-(CINT-300 "GDK_KEY_5")
-(CINT-300 "GDK_KEY_6")
-(CINT-300 "GDK_KEY_7")
-(CINT-300 "GDK_KEY_8")
-(CINT-300 "GDK_KEY_9")
-(CINT-300 "GDK_KEY_colon")
-(CINT-300 "GDK_KEY_semicolon")
-(CINT-300 "GDK_KEY_less")
-(CINT-300 "GDK_KEY_equal")
-(CINT-300 "GDK_KEY_greater")
-(CINT-300 "GDK_KEY_question")
-(CINT-300 "GDK_KEY_at")
-(CINT-300 "GDK_KEY_A")
-(CINT-300 "GDK_KEY_B")
-(CINT-300 "GDK_KEY_C")
-(CINT-300 "GDK_KEY_D")
-(CINT-300 "GDK_KEY_E")
-(CINT-300 "GDK_KEY_F")
-(CINT-300 "GDK_KEY_G")
-(CINT-300 "GDK_KEY_H")
-(CINT-300 "GDK_KEY_I")
-(CINT-300 "GDK_KEY_J")
-(CINT-300 "GDK_KEY_K")
-(CINT-300 "GDK_KEY_L")
-(CINT-300 "GDK_KEY_M")
-(CINT-300 "GDK_KEY_N")
-(CINT-300 "GDK_KEY_O")
-(CINT-300 "GDK_KEY_P")
-(CINT-300 "GDK_KEY_Q")
-(CINT-300 "GDK_KEY_R")
-(CINT-300 "GDK_KEY_S")
-(CINT-300 "GDK_KEY_T")
-(CINT-300 "GDK_KEY_U")
-(CINT-300 "GDK_KEY_V")
-(CINT-300 "GDK_KEY_W")
-(CINT-300 "GDK_KEY_X")
-(CINT-300 "GDK_KEY_Y")
-(CINT-300 "GDK_KEY_Z")
-(CINT-300 "GDK_KEY_bracketleft")
-(CINT-300 "GDK_KEY_backslash")
-(CINT-300 "GDK_KEY_bracketright")
-(CINT-300 "GDK_KEY_asciicircum")
-(CINT-300 "GDK_KEY_underscore")
-(CINT-300 "GDK_KEY_grave")
-(CINT-300 "GDK_KEY_quoteleft")
-(CINT-300 "GDK_KEY_a")
-(CINT-300 "GDK_KEY_b")
-(CINT-300 "GDK_KEY_c")
-(CINT-300 "GDK_KEY_d")
-(CINT-300 "GDK_KEY_e")
-(CINT-300 "GDK_KEY_f")
-(CINT-300 "GDK_KEY_g")
-(CINT-300 "GDK_KEY_h")
-(CINT-300 "GDK_KEY_i")
-(CINT-300 "GDK_KEY_j")
-(CINT-300 "GDK_KEY_k")
-(CINT-300 "GDK_KEY_l")
-(CINT-300 "GDK_KEY_m")
-(CINT-300 "GDK_KEY_n")
-(CINT-300 "GDK_KEY_o")
-(CINT-300 "GDK_KEY_p")
-(CINT-300 "GDK_KEY_q")
-(CINT-300 "GDK_KEY_r")
-(CINT-300 "GDK_KEY_s")
-(CINT-300 "GDK_KEY_t")
-(CINT-300 "GDK_KEY_u")
-(CINT-300 "GDK_KEY_v")
-(CINT-300 "GDK_KEY_w")
-(CINT-300 "GDK_KEY_x")
-(CINT-300 "GDK_KEY_y")
-(CINT-300 "GDK_KEY_z")
-(CINT-300 "GDK_KEY_braceleft")
-(CINT-300 "GDK_KEY_bar")
-(CINT-300 "GDK_KEY_braceright")
-(CINT-300 "GDK_KEY_asciitilde")
+(CINT-3.0 "GDK_KEY_VoidSymbol")
+(CINT-3.0 "GDK_KEY_BackSpace")
+(CINT-3.0 "GDK_KEY_Tab")
+(CINT-3.0 "GDK_KEY_Linefeed")
+(CINT-3.0 "GDK_KEY_Clear")
+(CINT-3.0 "GDK_KEY_Return")
+(CINT-3.0 "GDK_KEY_Pause")
+(CINT-3.0 "GDK_KEY_Scroll_Lock")
+(CINT-3.0 "GDK_KEY_Sys_Req")
+(CINT-3.0 "GDK_KEY_Escape")
+(CINT-3.0 "GDK_KEY_Delete")
+(CINT-3.0 "GDK_KEY_Home")
+(CINT-3.0 "GDK_KEY_Left")
+(CINT-3.0 "GDK_KEY_Up")
+(CINT-3.0 "GDK_KEY_Right")
+(CINT-3.0 "GDK_KEY_Down")
+(CINT-3.0 "GDK_KEY_Prior")
+(CINT-3.0 "GDK_KEY_Page_Up")
+(CINT-3.0 "GDK_KEY_Next")
+(CINT-3.0 "GDK_KEY_Page_Down")
+(CINT-3.0 "GDK_KEY_End")
+(CINT-3.0 "GDK_KEY_Begin")
+(CINT-3.0 "GDK_KEY_Select")
+(CINT-3.0 "GDK_KEY_Print")
+(CINT-3.0 "GDK_KEY_Execute")
+(CINT-3.0 "GDK_KEY_Insert")
+(CINT-3.0 "GDK_KEY_Undo")
+(CINT-3.0 "GDK_KEY_Redo")
+(CINT-3.0 "GDK_KEY_Menu")
+(CINT-3.0 "GDK_KEY_Find")
+(CINT-3.0 "GDK_KEY_Cancel")
+(CINT-3.0 "GDK_KEY_Help")
+(CINT-3.0 "GDK_KEY_Break")
+(CINT-3.0 "GDK_KEY_Mode_switch")
+(CINT-3.0 "GDK_KEY_script_switch")
+(CINT-3.0 "GDK_KEY_Num_Lock")
+(CINT-3.0 "GDK_KEY_KP_Space")
+(CINT-3.0 "GDK_KEY_KP_Tab")
+(CINT-3.0 "GDK_KEY_KP_Enter")
+(CINT-3.0 "GDK_KEY_KP_F1")
+(CINT-3.0 "GDK_KEY_KP_F2")
+(CINT-3.0 "GDK_KEY_KP_F3")
+(CINT-3.0 "GDK_KEY_KP_F4")
+(CINT-3.0 "GDK_KEY_KP_Home")
+(CINT-3.0 "GDK_KEY_KP_Left")
+(CINT-3.0 "GDK_KEY_KP_Up")
+(CINT-3.0 "GDK_KEY_KP_Right")
+(CINT-3.0 "GDK_KEY_KP_Down")
+(CINT-3.0 "GDK_KEY_KP_Prior")
+(CINT-3.0 "GDK_KEY_KP_Page_Up")
+(CINT-3.0 "GDK_KEY_KP_Next")
+(CINT-3.0 "GDK_KEY_KP_Page_Down")
+(CINT-3.0 "GDK_KEY_KP_End")
+(CINT-3.0 "GDK_KEY_KP_Begin")
+(CINT-3.0 "GDK_KEY_KP_Insert")
+(CINT-3.0 "GDK_KEY_KP_Delete")
+(CINT-3.0 "GDK_KEY_KP_Equal")
+(CINT-3.0 "GDK_KEY_KP_Multiply")
+(CINT-3.0 "GDK_KEY_KP_Add")
+(CINT-3.0 "GDK_KEY_KP_Separator")
+(CINT-3.0 "GDK_KEY_KP_Subtract")
+(CINT-3.0 "GDK_KEY_KP_Decimal")
+(CINT-3.0 "GDK_KEY_KP_Divide")
+(CINT-3.0 "GDK_KEY_KP_0")
+(CINT-3.0 "GDK_KEY_KP_1")
+(CINT-3.0 "GDK_KEY_KP_2")
+(CINT-3.0 "GDK_KEY_KP_3")
+(CINT-3.0 "GDK_KEY_KP_4")
+(CINT-3.0 "GDK_KEY_KP_5")
+(CINT-3.0 "GDK_KEY_KP_6")
+(CINT-3.0 "GDK_KEY_KP_7")
+(CINT-3.0 "GDK_KEY_KP_8")
+(CINT-3.0 "GDK_KEY_KP_9")
+(CINT-3.0 "GDK_KEY_F1")
+(CINT-3.0 "GDK_KEY_F2")
+(CINT-3.0 "GDK_KEY_F3")
+(CINT-3.0 "GDK_KEY_F4")
+(CINT-3.0 "GDK_KEY_F5")
+(CINT-3.0 "GDK_KEY_F6")
+(CINT-3.0 "GDK_KEY_F7")
+(CINT-3.0 "GDK_KEY_F8")
+(CINT-3.0 "GDK_KEY_F9")
+(CINT-3.0 "GDK_KEY_F10")
+(CINT-3.0 "GDK_KEY_F11")
+(CINT-3.0 "GDK_KEY_L1")
+(CINT-3.0 "GDK_KEY_F12")
+(CINT-3.0 "GDK_KEY_L2")
+(CINT-3.0 "GDK_KEY_F13")
+(CINT-3.0 "GDK_KEY_L3")
+(CINT-3.0 "GDK_KEY_F14")
+(CINT-3.0 "GDK_KEY_L4")
+(CINT-3.0 "GDK_KEY_F15")
+(CINT-3.0 "GDK_KEY_L5")
+(CINT-3.0 "GDK_KEY_F16")
+(CINT-3.0 "GDK_KEY_L6")
+(CINT-3.0 "GDK_KEY_F17")
+(CINT-3.0 "GDK_KEY_L7")
+(CINT-3.0 "GDK_KEY_F18")
+(CINT-3.0 "GDK_KEY_L8")
+(CINT-3.0 "GDK_KEY_F19")
+(CINT-3.0 "GDK_KEY_L9")
+(CINT-3.0 "GDK_KEY_F20")
+(CINT-3.0 "GDK_KEY_L10")
+(CINT-3.0 "GDK_KEY_F21")
+(CINT-3.0 "GDK_KEY_R1")
+(CINT-3.0 "GDK_KEY_F22")
+(CINT-3.0 "GDK_KEY_R2")
+(CINT-3.0 "GDK_KEY_F23")
+(CINT-3.0 "GDK_KEY_R3")
+(CINT-3.0 "GDK_KEY_F24")
+(CINT-3.0 "GDK_KEY_R4")
+(CINT-3.0 "GDK_KEY_F25")
+(CINT-3.0 "GDK_KEY_R5")
+(CINT-3.0 "GDK_KEY_F26")
+(CINT-3.0 "GDK_KEY_R6")
+(CINT-3.0 "GDK_KEY_F27")
+(CINT-3.0 "GDK_KEY_R7")
+(CINT-3.0 "GDK_KEY_F28")
+(CINT-3.0 "GDK_KEY_R8")
+(CINT-3.0 "GDK_KEY_F29")
+(CINT-3.0 "GDK_KEY_R9")
+(CINT-3.0 "GDK_KEY_F30")
+(CINT-3.0 "GDK_KEY_R10")
+(CINT-3.0 "GDK_KEY_F31")
+(CINT-3.0 "GDK_KEY_R11")
+(CINT-3.0 "GDK_KEY_F32")
+(CINT-3.0 "GDK_KEY_R12")
+(CINT-3.0 "GDK_KEY_F33")
+(CINT-3.0 "GDK_KEY_R13")
+(CINT-3.0 "GDK_KEY_F34")
+(CINT-3.0 "GDK_KEY_R14")
+(CINT-3.0 "GDK_KEY_F35")
+(CINT-3.0 "GDK_KEY_R15")
+(CINT-3.0 "GDK_KEY_Shift_L")
+(CINT-3.0 "GDK_KEY_Shift_R")
+(CINT-3.0 "GDK_KEY_Control_L")
+(CINT-3.0 "GDK_KEY_Control_R")
+(CINT-3.0 "GDK_KEY_Caps_Lock")
+(CINT-3.0 "GDK_KEY_Shift_Lock")
+(CINT-3.0 "GDK_KEY_Meta_L")
+(CINT-3.0 "GDK_KEY_Meta_R")
+(CINT-3.0 "GDK_KEY_Alt_L")
+(CINT-3.0 "GDK_KEY_Alt_R")
+(CINT-3.0 "GDK_KEY_space")
+(CINT-3.0 "GDK_KEY_exclam")
+(CINT-3.0 "GDK_KEY_quotedbl")
+(CINT-3.0 "GDK_KEY_numbersign")
+(CINT-3.0 "GDK_KEY_dollar")
+(CINT-3.0 "GDK_KEY_percent")
+(CINT-3.0 "GDK_KEY_ampersand")
+(CINT-3.0 "GDK_KEY_apostrophe")
+(CINT-3.0 "GDK_KEY_quoteright")
+(CINT-3.0 "GDK_KEY_parenleft")
+(CINT-3.0 "GDK_KEY_parenright")
+(CINT-3.0 "GDK_KEY_asterisk")
+(CINT-3.0 "GDK_KEY_plus")
+(CINT-3.0 "GDK_KEY_comma")
+(CINT-3.0 "GDK_KEY_minus")
+(CINT-3.0 "GDK_KEY_period")
+(CINT-3.0 "GDK_KEY_slash")
+(CINT-3.0 "GDK_KEY_0")
+(CINT-3.0 "GDK_KEY_1")
+(CINT-3.0 "GDK_KEY_2")
+(CINT-3.0 "GDK_KEY_3")
+(CINT-3.0 "GDK_KEY_4")
+(CINT-3.0 "GDK_KEY_5")
+(CINT-3.0 "GDK_KEY_6")
+(CINT-3.0 "GDK_KEY_7")
+(CINT-3.0 "GDK_KEY_8")
+(CINT-3.0 "GDK_KEY_9")
+(CINT-3.0 "GDK_KEY_colon")
+(CINT-3.0 "GDK_KEY_semicolon")
+(CINT-3.0 "GDK_KEY_less")
+(CINT-3.0 "GDK_KEY_equal")
+(CINT-3.0 "GDK_KEY_greater")
+(CINT-3.0 "GDK_KEY_question")
+(CINT-3.0 "GDK_KEY_at")
+(CINT-3.0 "GDK_KEY_A")
+(CINT-3.0 "GDK_KEY_B")
+(CINT-3.0 "GDK_KEY_C")
+(CINT-3.0 "GDK_KEY_D")
+(CINT-3.0 "GDK_KEY_E")
+(CINT-3.0 "GDK_KEY_F")
+(CINT-3.0 "GDK_KEY_G")
+(CINT-3.0 "GDK_KEY_H")
+(CINT-3.0 "GDK_KEY_I")
+(CINT-3.0 "GDK_KEY_J")
+(CINT-3.0 "GDK_KEY_K")
+(CINT-3.0 "GDK_KEY_L")
+(CINT-3.0 "GDK_KEY_M")
+(CINT-3.0 "GDK_KEY_N")
+(CINT-3.0 "GDK_KEY_O")
+(CINT-3.0 "GDK_KEY_P")
+(CINT-3.0 "GDK_KEY_Q")
+(CINT-3.0 "GDK_KEY_R")
+(CINT-3.0 "GDK_KEY_S")
+(CINT-3.0 "GDK_KEY_T")
+(CINT-3.0 "GDK_KEY_U")
+(CINT-3.0 "GDK_KEY_V")
+(CINT-3.0 "GDK_KEY_W")
+(CINT-3.0 "GDK_KEY_X")
+(CINT-3.0 "GDK_KEY_Y")
+(CINT-3.0 "GDK_KEY_Z")
+(CINT-3.0 "GDK_KEY_bracketleft")
+(CINT-3.0 "GDK_KEY_backslash")
+(CINT-3.0 "GDK_KEY_bracketright")
+(CINT-3.0 "GDK_KEY_asciicircum")
+(CINT-3.0 "GDK_KEY_underscore")
+(CINT-3.0 "GDK_KEY_grave")
+(CINT-3.0 "GDK_KEY_quoteleft")
+(CINT-3.0 "GDK_KEY_a")
+(CINT-3.0 "GDK_KEY_b")
+(CINT-3.0 "GDK_KEY_c")
+(CINT-3.0 "GDK_KEY_d")
+(CINT-3.0 "GDK_KEY_e")
+(CINT-3.0 "GDK_KEY_f")
+(CINT-3.0 "GDK_KEY_g")
+(CINT-3.0 "GDK_KEY_h")
+(CINT-3.0 "GDK_KEY_i")
+(CINT-3.0 "GDK_KEY_j")
+(CINT-3.0 "GDK_KEY_k")
+(CINT-3.0 "GDK_KEY_l")
+(CINT-3.0 "GDK_KEY_m")
+(CINT-3.0 "GDK_KEY_n")
+(CINT-3.0 "GDK_KEY_o")
+(CINT-3.0 "GDK_KEY_p")
+(CINT-3.0 "GDK_KEY_q")
+(CINT-3.0 "GDK_KEY_r")
+(CINT-3.0 "GDK_KEY_s")
+(CINT-3.0 "GDK_KEY_t")
+(CINT-3.0 "GDK_KEY_u")
+(CINT-3.0 "GDK_KEY_v")
+(CINT-3.0 "GDK_KEY_w")
+(CINT-3.0 "GDK_KEY_x")
+(CINT-3.0 "GDK_KEY_y")
+(CINT-3.0 "GDK_KEY_z")
+(CINT-3.0 "GDK_KEY_braceleft")
+(CINT-3.0 "GDK_KEY_bar")
+(CINT-3.0 "GDK_KEY_braceright")
+(CINT-3.0 "GDK_KEY_asciitilde")
;; gtk2 versions
-(CINT-gtk2 "GDK_VoidSymbol")
-(CINT-gtk2 "GDK_BackSpace")
-(CINT-gtk2 "GDK_Tab")
-(CINT-gtk2 "GDK_Linefeed")
-(CINT-gtk2 "GDK_Clear")
-(CINT-gtk2 "GDK_Return")
-(CINT-gtk2 "GDK_Pause")
-(CINT-gtk2 "GDK_Scroll_Lock")
-(CINT-gtk2 "GDK_Sys_Req")
-(CINT-gtk2 "GDK_Escape")
-(CINT-gtk2 "GDK_Delete")
-(CINT-gtk2 "GDK_Home")
-(CINT-gtk2 "GDK_Left")
-(CINT-gtk2 "GDK_Up")
-(CINT-gtk2 "GDK_Right")
-(CINT-gtk2 "GDK_Down")
-(CINT-gtk2 "GDK_Prior")
-(CINT-gtk2 "GDK_Page_Up")
-(CINT-gtk2 "GDK_Next")
-(CINT-gtk2 "GDK_Page_Down")
-(CINT-gtk2 "GDK_End")
-(CINT-gtk2 "GDK_Begin")
-(CINT-gtk2 "GDK_Select")
-(CINT-gtk2 "GDK_Print")
-(CINT-gtk2 "GDK_Execute")
-(CINT-gtk2 "GDK_Insert")
-(CINT-gtk2 "GDK_Undo")
-(CINT-gtk2 "GDK_Redo")
-(CINT-gtk2 "GDK_Menu")
-(CINT-gtk2 "GDK_Find")
-(CINT-gtk2 "GDK_Cancel")
-(CINT-gtk2 "GDK_Help")
-(CINT-gtk2 "GDK_Break")
-(CINT-gtk2 "GDK_Mode_switch")
-(CINT-gtk2 "GDK_script_switch")
-(CINT-gtk2 "GDK_Num_Lock")
-(CINT-gtk2 "GDK_KP_Space")
-(CINT-gtk2 "GDK_KP_Tab")
-(CINT-gtk2 "GDK_KP_Enter")
-(CINT-gtk2 "GDK_KP_F1")
-(CINT-gtk2 "GDK_KP_F2")
-(CINT-gtk2 "GDK_KP_F3")
-(CINT-gtk2 "GDK_KP_F4")
-(CINT-gtk2 "GDK_KP_Home")
-(CINT-gtk2 "GDK_KP_Left")
-(CINT-gtk2 "GDK_KP_Up")
-(CINT-gtk2 "GDK_KP_Right")
-(CINT-gtk2 "GDK_KP_Down")
-(CINT-gtk2 "GDK_KP_Prior")
-(CINT-gtk2 "GDK_KP_Page_Up")
-(CINT-gtk2 "GDK_KP_Next")
-(CINT-gtk2 "GDK_KP_Page_Down")
-(CINT-gtk2 "GDK_KP_End")
-(CINT-gtk2 "GDK_KP_Begin")
-(CINT-gtk2 "GDK_KP_Insert")
-(CINT-gtk2 "GDK_KP_Delete")
-(CINT-gtk2 "GDK_KP_Equal")
-(CINT-gtk2 "GDK_KP_Multiply")
-(CINT-gtk2 "GDK_KP_Add")
-(CINT-gtk2 "GDK_KP_Separator")
-(CINT-gtk2 "GDK_KP_Subtract")
-(CINT-gtk2 "GDK_KP_Decimal")
-(CINT-gtk2 "GDK_KP_Divide")
-(CINT-gtk2 "GDK_KP_0")
-(CINT-gtk2 "GDK_KP_1")
-(CINT-gtk2 "GDK_KP_2")
-(CINT-gtk2 "GDK_KP_3")
-(CINT-gtk2 "GDK_KP_4")
-(CINT-gtk2 "GDK_KP_5")
-(CINT-gtk2 "GDK_KP_6")
-(CINT-gtk2 "GDK_KP_7")
-(CINT-gtk2 "GDK_KP_8")
-(CINT-gtk2 "GDK_KP_9")
-(CINT-gtk2 "GDK_F1")
-(CINT-gtk2 "GDK_F2")
-(CINT-gtk2 "GDK_F3")
-(CINT-gtk2 "GDK_F4")
-(CINT-gtk2 "GDK_F5")
-(CINT-gtk2 "GDK_F6")
-(CINT-gtk2 "GDK_F7")
-(CINT-gtk2 "GDK_F8")
-(CINT-gtk2 "GDK_F9")
-(CINT-gtk2 "GDK_F10")
-(CINT-gtk2 "GDK_F11")
-(CINT-gtk2 "GDK_L1")
-(CINT-gtk2 "GDK_F12")
-(CINT-gtk2 "GDK_L2")
-(CINT-gtk2 "GDK_F13")
-(CINT-gtk2 "GDK_L3")
-(CINT-gtk2 "GDK_F14")
-(CINT-gtk2 "GDK_L4")
-(CINT-gtk2 "GDK_F15")
-(CINT-gtk2 "GDK_L5")
-(CINT-gtk2 "GDK_F16")
-(CINT-gtk2 "GDK_L6")
-(CINT-gtk2 "GDK_F17")
-(CINT-gtk2 "GDK_L7")
-(CINT-gtk2 "GDK_F18")
-(CINT-gtk2 "GDK_L8")
-(CINT-gtk2 "GDK_F19")
-(CINT-gtk2 "GDK_L9")
-(CINT-gtk2 "GDK_F20")
-(CINT-gtk2 "GDK_L10")
-(CINT-gtk2 "GDK_F21")
-(CINT-gtk2 "GDK_R1")
-(CINT-gtk2 "GDK_F22")
-(CINT-gtk2 "GDK_R2")
-(CINT-gtk2 "GDK_F23")
-(CINT-gtk2 "GDK_R3")
-(CINT-gtk2 "GDK_F24")
-(CINT-gtk2 "GDK_R4")
-(CINT-gtk2 "GDK_F25")
-(CINT-gtk2 "GDK_R5")
-(CINT-gtk2 "GDK_F26")
-(CINT-gtk2 "GDK_R6")
-(CINT-gtk2 "GDK_F27")
-(CINT-gtk2 "GDK_R7")
-(CINT-gtk2 "GDK_F28")
-(CINT-gtk2 "GDK_R8")
-(CINT-gtk2 "GDK_F29")
-(CINT-gtk2 "GDK_R9")
-(CINT-gtk2 "GDK_F30")
-(CINT-gtk2 "GDK_R10")
-(CINT-gtk2 "GDK_F31")
-(CINT-gtk2 "GDK_R11")
-(CINT-gtk2 "GDK_F32")
-(CINT-gtk2 "GDK_R12")
-(CINT-gtk2 "GDK_F33")
-(CINT-gtk2 "GDK_R13")
-(CINT-gtk2 "GDK_F34")
-(CINT-gtk2 "GDK_R14")
-(CINT-gtk2 "GDK_F35")
-(CINT-gtk2 "GDK_R15")
-(CINT-gtk2 "GDK_Shift_L")
-(CINT-gtk2 "GDK_Shift_R")
-(CINT-gtk2 "GDK_Control_L")
-(CINT-gtk2 "GDK_Control_R")
-(CINT-gtk2 "GDK_Caps_Lock")
-(CINT-gtk2 "GDK_Shift_Lock")
-(CINT-gtk2 "GDK_Meta_L")
-(CINT-gtk2 "GDK_Meta_R")
-(CINT-gtk2 "GDK_Alt_L")
-(CINT-gtk2 "GDK_Alt_R")
-(CINT-gtk2 "GDK_space")
-(CINT-gtk2 "GDK_exclam")
-(CINT-gtk2 "GDK_quotedbl")
-(CINT-gtk2 "GDK_numbersign")
-(CINT-gtk2 "GDK_dollar")
-(CINT-gtk2 "GDK_percent")
-(CINT-gtk2 "GDK_ampersand")
-(CINT-gtk2 "GDK_apostrophe")
-(CINT-gtk2 "GDK_quoteright")
-(CINT-gtk2 "GDK_parenleft")
-(CINT-gtk2 "GDK_parenright")
-(CINT-gtk2 "GDK_asterisk")
-(CINT-gtk2 "GDK_plus")
-(CINT-gtk2 "GDK_comma")
-(CINT-gtk2 "GDK_minus")
-(CINT-gtk2 "GDK_period")
-(CINT-gtk2 "GDK_slash")
-(CINT-gtk2 "GDK_0")
-(CINT-gtk2 "GDK_1")
-(CINT-gtk2 "GDK_2")
-(CINT-gtk2 "GDK_3")
-(CINT-gtk2 "GDK_4")
-(CINT-gtk2 "GDK_5")
-(CINT-gtk2 "GDK_6")
-(CINT-gtk2 "GDK_7")
-(CINT-gtk2 "GDK_8")
-(CINT-gtk2 "GDK_9")
-(CINT-gtk2 "GDK_colon")
-(CINT-gtk2 "GDK_semicolon")
-(CINT-gtk2 "GDK_less")
-(CINT-gtk2 "GDK_equal")
-(CINT-gtk2 "GDK_greater")
-(CINT-gtk2 "GDK_question")
-(CINT-gtk2 "GDK_at")
-(CINT-gtk2 "GDK_A")
-(CINT-gtk2 "GDK_B")
-(CINT-gtk2 "GDK_C")
-(CINT-gtk2 "GDK_D")
-(CINT-gtk2 "GDK_E")
-(CINT-gtk2 "GDK_F")
-(CINT-gtk2 "GDK_G")
-(CINT-gtk2 "GDK_H")
-(CINT-gtk2 "GDK_I")
-(CINT-gtk2 "GDK_J")
-(CINT-gtk2 "GDK_K")
-(CINT-gtk2 "GDK_L")
-(CINT-gtk2 "GDK_M")
-(CINT-gtk2 "GDK_N")
-(CINT-gtk2 "GDK_O")
-(CINT-gtk2 "GDK_P")
-(CINT-gtk2 "GDK_Q")
-(CINT-gtk2 "GDK_R")
-(CINT-gtk2 "GDK_S")
-(CINT-gtk2 "GDK_T")
-(CINT-gtk2 "GDK_U")
-(CINT-gtk2 "GDK_V")
-(CINT-gtk2 "GDK_W")
-(CINT-gtk2 "GDK_X")
-(CINT-gtk2 "GDK_Y")
-(CINT-gtk2 "GDK_Z")
-(CINT-gtk2 "GDK_bracketleft")
-(CINT-gtk2 "GDK_backslash")
-(CINT-gtk2 "GDK_bracketright")
-(CINT-gtk2 "GDK_asciicircum")
-(CINT-gtk2 "GDK_underscore")
-(CINT-gtk2 "GDK_grave")
-(CINT-gtk2 "GDK_quoteleft")
-(CINT-gtk2 "GDK_a")
-(CINT-gtk2 "GDK_b")
-(CINT-gtk2 "GDK_c")
-(CINT-gtk2 "GDK_d")
-(CINT-gtk2 "GDK_e")
-(CINT-gtk2 "GDK_f")
-(CINT-gtk2 "GDK_g")
-(CINT-gtk2 "GDK_h")
-(CINT-gtk2 "GDK_i")
-(CINT-gtk2 "GDK_j")
-(CINT-gtk2 "GDK_k")
-(CINT-gtk2 "GDK_l")
-(CINT-gtk2 "GDK_m")
-(CINT-gtk2 "GDK_n")
-(CINT-gtk2 "GDK_o")
-(CINT-gtk2 "GDK_p")
-(CINT-gtk2 "GDK_q")
-(CINT-gtk2 "GDK_r")
-(CINT-gtk2 "GDK_s")
-(CINT-gtk2 "GDK_t")
-(CINT-gtk2 "GDK_u")
-(CINT-gtk2 "GDK_v")
-(CINT-gtk2 "GDK_w")
-(CINT-gtk2 "GDK_x")
-(CINT-gtk2 "GDK_y")
-(CINT-gtk2 "GDK_z")
-(CINT-gtk2 "GDK_braceleft")
-(CINT-gtk2 "GDK_bar")
-(CINT-gtk2 "GDK_braceright")
-(CINT-gtk2 "GDK_asciitilde")
+;;; (CINT-gtk2 "GDK_VoidSymbol")
+;;; (CINT-gtk2 "GDK_BackSpace")
+;;; (CINT-gtk2 "GDK_Tab")
+;;; (CINT-gtk2 "GDK_Linefeed")
+;;; (CINT-gtk2 "GDK_Clear")
+;;; (CINT-gtk2 "GDK_Return")
+;;; (CINT-gtk2 "GDK_Pause")
+;;; (CINT-gtk2 "GDK_Scroll_Lock")
+;;; (CINT-gtk2 "GDK_Sys_Req")
+;;; (CINT-gtk2 "GDK_Escape")
+;;; (CINT-gtk2 "GDK_Delete")
+;;; (CINT-gtk2 "GDK_Home")
+;;; (CINT-gtk2 "GDK_Left")
+;;; (CINT-gtk2 "GDK_Up")
+;;; (CINT-gtk2 "GDK_Right")
+;;; (CINT-gtk2 "GDK_Down")
+;;; (CINT-gtk2 "GDK_Prior")
+;;; (CINT-gtk2 "GDK_Page_Up")
+;;; (CINT-gtk2 "GDK_Next")
+;;; (CINT-gtk2 "GDK_Page_Down")
+;;; (CINT-gtk2 "GDK_End")
+;;; (CINT-gtk2 "GDK_Begin")
+;;; (CINT-gtk2 "GDK_Select")
+;;; (CINT-gtk2 "GDK_Print")
+;;; (CINT-gtk2 "GDK_Execute")
+;;; (CINT-gtk2 "GDK_Insert")
+;;; (CINT-gtk2 "GDK_Undo")
+;;; (CINT-gtk2 "GDK_Redo")
+;;; (CINT-gtk2 "GDK_Menu")
+;;; (CINT-gtk2 "GDK_Find")
+;;; (CINT-gtk2 "GDK_Cancel")
+;;; (CINT-gtk2 "GDK_Help")
+;;; (CINT-gtk2 "GDK_Break")
+;;; (CINT-gtk2 "GDK_Mode_switch")
+;;; (CINT-gtk2 "GDK_script_switch")
+;;; (CINT-gtk2 "GDK_Num_Lock")
+;;; (CINT-gtk2 "GDK_KP_Space")
+;;; (CINT-gtk2 "GDK_KP_Tab")
+;;; (CINT-gtk2 "GDK_KP_Enter")
+;;; (CINT-gtk2 "GDK_KP_F1")
+;;; (CINT-gtk2 "GDK_KP_F2")
+;;; (CINT-gtk2 "GDK_KP_F3")
+;;; (CINT-gtk2 "GDK_KP_F4")
+;;; (CINT-gtk2 "GDK_KP_Home")
+;;; (CINT-gtk2 "GDK_KP_Left")
+;;; (CINT-gtk2 "GDK_KP_Up")
+;;; (CINT-gtk2 "GDK_KP_Right")
+;;; (CINT-gtk2 "GDK_KP_Down")
+;;; (CINT-gtk2 "GDK_KP_Prior")
+;;; (CINT-gtk2 "GDK_KP_Page_Up")
+;;; (CINT-gtk2 "GDK_KP_Next")
+;;; (CINT-gtk2 "GDK_KP_Page_Down")
+;;; (CINT-gtk2 "GDK_KP_End")
+;;; (CINT-gtk2 "GDK_KP_Begin")
+;;; (CINT-gtk2 "GDK_KP_Insert")
+;;; (CINT-gtk2 "GDK_KP_Delete")
+;;; (CINT-gtk2 "GDK_KP_Equal")
+;;; (CINT-gtk2 "GDK_KP_Multiply")
+;;; (CINT-gtk2 "GDK_KP_Add")
+;;; (CINT-gtk2 "GDK_KP_Separator")
+;;; (CINT-gtk2 "GDK_KP_Subtract")
+;;; (CINT-gtk2 "GDK_KP_Decimal")
+;;; (CINT-gtk2 "GDK_KP_Divide")
+;;; (CINT-gtk2 "GDK_KP_0")
+;;; (CINT-gtk2 "GDK_KP_1")
+;;; (CINT-gtk2 "GDK_KP_2")
+;;; (CINT-gtk2 "GDK_KP_3")
+;;; (CINT-gtk2 "GDK_KP_4")
+;;; (CINT-gtk2 "GDK_KP_5")
+;;; (CINT-gtk2 "GDK_KP_6")
+;;; (CINT-gtk2 "GDK_KP_7")
+;;; (CINT-gtk2 "GDK_KP_8")
+;;; (CINT-gtk2 "GDK_KP_9")
+;;; (CINT-gtk2 "GDK_F1")
+;;; (CINT-gtk2 "GDK_F2")
+;;; (CINT-gtk2 "GDK_F3")
+;;; (CINT-gtk2 "GDK_F4")
+;;; (CINT-gtk2 "GDK_F5")
+;;; (CINT-gtk2 "GDK_F6")
+;;; (CINT-gtk2 "GDK_F7")
+;;; (CINT-gtk2 "GDK_F8")
+;;; (CINT-gtk2 "GDK_F9")
+;;; (CINT-gtk2 "GDK_F10")
+;;; (CINT-gtk2 "GDK_F11")
+;;; (CINT-gtk2 "GDK_L1")
+;;; (CINT-gtk2 "GDK_F12")
+;;; (CINT-gtk2 "GDK_L2")
+;;; (CINT-gtk2 "GDK_F13")
+;;; (CINT-gtk2 "GDK_L3")
+;;; (CINT-gtk2 "GDK_F14")
+;;; (CINT-gtk2 "GDK_L4")
+;;; (CINT-gtk2 "GDK_F15")
+;;; (CINT-gtk2 "GDK_L5")
+;;; (CINT-gtk2 "GDK_F16")
+;;; (CINT-gtk2 "GDK_L6")
+;;; (CINT-gtk2 "GDK_F17")
+;;; (CINT-gtk2 "GDK_L7")
+;;; (CINT-gtk2 "GDK_F18")
+;;; (CINT-gtk2 "GDK_L8")
+;;; (CINT-gtk2 "GDK_F19")
+;;; (CINT-gtk2 "GDK_L9")
+;;; (CINT-gtk2 "GDK_F20")
+;;; (CINT-gtk2 "GDK_L10")
+;;; (CINT-gtk2 "GDK_F21")
+;;; (CINT-gtk2 "GDK_R1")
+;;; (CINT-gtk2 "GDK_F22")
+;;; (CINT-gtk2 "GDK_R2")
+;;; (CINT-gtk2 "GDK_F23")
+;;; (CINT-gtk2 "GDK_R3")
+;;; (CINT-gtk2 "GDK_F24")
+;;; (CINT-gtk2 "GDK_R4")
+;;; (CINT-gtk2 "GDK_F25")
+;;; (CINT-gtk2 "GDK_R5")
+;;; (CINT-gtk2 "GDK_F26")
+;;; (CINT-gtk2 "GDK_R6")
+;;; (CINT-gtk2 "GDK_F27")
+;;; (CINT-gtk2 "GDK_R7")
+;;; (CINT-gtk2 "GDK_F28")
+;;; (CINT-gtk2 "GDK_R8")
+;;; (CINT-gtk2 "GDK_F29")
+;;; (CINT-gtk2 "GDK_R9")
+;;; (CINT-gtk2 "GDK_F30")
+;;; (CINT-gtk2 "GDK_R10")
+;;; (CINT-gtk2 "GDK_F31")
+;;; (CINT-gtk2 "GDK_R11")
+;;; (CINT-gtk2 "GDK_F32")
+;;; (CINT-gtk2 "GDK_R12")
+;;; (CINT-gtk2 "GDK_F33")
+;;; (CINT-gtk2 "GDK_R13")
+;;; (CINT-gtk2 "GDK_F34")
+;;; (CINT-gtk2 "GDK_R14")
+;;; (CINT-gtk2 "GDK_F35")
+;;; (CINT-gtk2 "GDK_R15")
+;;; (CINT-gtk2 "GDK_Shift_L")
+;;; (CINT-gtk2 "GDK_Shift_R")
+;;; (CINT-gtk2 "GDK_Control_L")
+;;; (CINT-gtk2 "GDK_Control_R")
+;;; (CINT-gtk2 "GDK_Caps_Lock")
+;;; (CINT-gtk2 "GDK_Shift_Lock")
+;;; (CINT-gtk2 "GDK_Meta_L")
+;;; (CINT-gtk2 "GDK_Meta_R")
+;;; (CINT-gtk2 "GDK_Alt_L")
+;;; (CINT-gtk2 "GDK_Alt_R")
+;;; (CINT-gtk2 "GDK_space")
+;;; (CINT-gtk2 "GDK_exclam")
+;;; (CINT-gtk2 "GDK_quotedbl")
+;;; (CINT-gtk2 "GDK_numbersign")
+;;; (CINT-gtk2 "GDK_dollar")
+;;; (CINT-gtk2 "GDK_percent")
+;;; (CINT-gtk2 "GDK_ampersand")
+;;; (CINT-gtk2 "GDK_apostrophe")
+;;; (CINT-gtk2 "GDK_quoteright")
+;;; (CINT-gtk2 "GDK_parenleft")
+;;; (CINT-gtk2 "GDK_parenright")
+;;; (CINT-gtk2 "GDK_asterisk")
+;;; (CINT-gtk2 "GDK_plus")
+;;; (CINT-gtk2 "GDK_comma")
+;;; (CINT-gtk2 "GDK_minus")
+;;; (CINT-gtk2 "GDK_period")
+;;; (CINT-gtk2 "GDK_slash")
+;;; (CINT-gtk2 "GDK_0")
+;;; (CINT-gtk2 "GDK_1")
+;;; (CINT-gtk2 "GDK_2")
+;;; (CINT-gtk2 "GDK_3")
+;;; (CINT-gtk2 "GDK_4")
+;;; (CINT-gtk2 "GDK_5")
+;;; (CINT-gtk2 "GDK_6")
+;;; (CINT-gtk2 "GDK_7")
+;;; (CINT-gtk2 "GDK_8")
+;;; (CINT-gtk2 "GDK_9")
+;;; (CINT-gtk2 "GDK_colon")
+;;; (CINT-gtk2 "GDK_semicolon")
+;;; (CINT-gtk2 "GDK_less")
+;;; (CINT-gtk2 "GDK_equal")
+;;; (CINT-gtk2 "GDK_greater")
+;;; (CINT-gtk2 "GDK_question")
+;;; (CINT-gtk2 "GDK_at")
+;;; (CINT-gtk2 "GDK_A")
+;;; (CINT-gtk2 "GDK_B")
+;;; (CINT-gtk2 "GDK_C")
+;;; (CINT-gtk2 "GDK_D")
+;;; (CINT-gtk2 "GDK_E")
+;;; (CINT-gtk2 "GDK_F")
+;;; (CINT-gtk2 "GDK_G")
+;;; (CINT-gtk2 "GDK_H")
+;;; (CINT-gtk2 "GDK_I")
+;;; (CINT-gtk2 "GDK_J")
+;;; (CINT-gtk2 "GDK_K")
+;;; (CINT-gtk2 "GDK_L")
+;;; (CINT-gtk2 "GDK_M")
+;;; (CINT-gtk2 "GDK_N")
+;;; (CINT-gtk2 "GDK_O")
+;;; (CINT-gtk2 "GDK_P")
+;;; (CINT-gtk2 "GDK_Q")
+;;; (CINT-gtk2 "GDK_R")
+;;; (CINT-gtk2 "GDK_S")
+;;; (CINT-gtk2 "GDK_T")
+;;; (CINT-gtk2 "GDK_U")
+;;; (CINT-gtk2 "GDK_V")
+;;; (CINT-gtk2 "GDK_W")
+;;; (CINT-gtk2 "GDK_X")
+;;; (CINT-gtk2 "GDK_Y")
+;;; (CINT-gtk2 "GDK_Z")
+;;; (CINT-gtk2 "GDK_bracketleft")
+;;; (CINT-gtk2 "GDK_backslash")
+;;; (CINT-gtk2 "GDK_bracketright")
+;;; (CINT-gtk2 "GDK_asciicircum")
+;;; (CINT-gtk2 "GDK_underscore")
+;;; (CINT-gtk2 "GDK_grave")
+;;; (CINT-gtk2 "GDK_quoteleft")
+;;; (CINT-gtk2 "GDK_a")
+;;; (CINT-gtk2 "GDK_b")
+;;; (CINT-gtk2 "GDK_c")
+;;; (CINT-gtk2 "GDK_d")
+;;; (CINT-gtk2 "GDK_e")
+;;; (CINT-gtk2 "GDK_f")
+;;; (CINT-gtk2 "GDK_g")
+;;; (CINT-gtk2 "GDK_h")
+;;; (CINT-gtk2 "GDK_i")
+;;; (CINT-gtk2 "GDK_j")
+;;; (CINT-gtk2 "GDK_k")
+;;; (CINT-gtk2 "GDK_l")
+;;; (CINT-gtk2 "GDK_m")
+;;; (CINT-gtk2 "GDK_n")
+;;; (CINT-gtk2 "GDK_o")
+;;; (CINT-gtk2 "GDK_p")
+;;; (CINT-gtk2 "GDK_q")
+;;; (CINT-gtk2 "GDK_r")
+;;; (CINT-gtk2 "GDK_s")
+;;; (CINT-gtk2 "GDK_t")
+;;; (CINT-gtk2 "GDK_u")
+;;; (CINT-gtk2 "GDK_v")
+;;; (CINT-gtk2 "GDK_w")
+;;; (CINT-gtk2 "GDK_x")
+;;; (CINT-gtk2 "GDK_y")
+;;; (CINT-gtk2 "GDK_z")
+;;; (CINT-gtk2 "GDK_braceleft")
+;;; (CINT-gtk2 "GDK_bar")
+;;; (CINT-gtk2 "GDK_braceright")
+;;; (CINT-gtk2 "GDK_asciitilde")
(CFNC "PangoContext* gdk_pango_context_get void")
;;; out 2.5.6 (CFNC "void gdk_pango_context_set_colormap PangoContext* context GdkColormap* colormap")
@@ -1061,15 +1128,15 @@
;;; (CFNC "GdkRegion* gdk_pango_layout_get_clip_region PangoLayout* layout gint x_origin gint y_origin gint* index_ranges gint n_ranges")
;;; 2.90.6 (CFNC "PangoAttribute* gdk_pango_attr_stipple_new GdkBitmap* stipple")
;;; 2.90.6 (CFNC "PangoAttribute* gdk_pango_attr_embossed_new gboolean embossed")
-(CFNC-gtk2 "void gdk_pixbuf_render_threshold_alpha GdkPixbuf* pixbuf GdkBitmap* bitmap int src_x int src_y int dest_x int dest_y int width int height int alpha_threshold")
+;;; (CFNC-gtk2 "void gdk_pixbuf_render_threshold_alpha GdkPixbuf* pixbuf GdkBitmap* bitmap int src_x int src_y int dest_x int dest_y int width int height int alpha_threshold")
;;; 2.90.6 ;;; out 2.3 (CFNC "void gdk_pixbuf_render_to_drawable GdkPixbuf* pixbuf GdkDrawable* drawable GdkGC* gc int src_x int src_y int dest_x int dest_y int width int height GdkRgbDither dither int x_dither int y_dither")
;;; out 2.3 (CFNC "void gdk_pixbuf_render_to_drawable_alpha GdkPixbuf* pixbuf GdkDrawable* drawable int src_x int src_y int dest_x int dest_y int width int height GdkPixbufAlphaMode alpha_mode int alpha_threshold GdkRgbDither dither int x_dither int y_dither")
-(CFNC-gtk2 "void gdk_pixbuf_render_pixmap_and_mask_for_colormap GdkPixbuf* pixbuf GdkColormap* colormap GdkPixmap** [pixmap_return] GdkBitmap** [mask_return] int alpha_threshold")
-(CFNC-gtk2 "void gdk_pixbuf_render_pixmap_and_mask GdkPixbuf* pixbuf GdkPixmap** [pixmap_return] GdkBitmap** [mask_return] int alpha_threshold")
-(CFNC-gtk2 "GdkPixbuf* gdk_pixbuf_get_from_drawable GdkPixbuf* @dest GdkDrawable* src GdkColormap* @cmap int src_x int src_y int dest_x int dest_y int width int height")
+;;; (CFNC-gtk2 "void gdk_pixbuf_render_pixmap_and_mask_for_colormap GdkPixbuf* pixbuf GdkColormap* colormap GdkPixmap** [pixmap_return] GdkBitmap** [mask_return] int alpha_threshold")
+;;; (CFNC-gtk2 "void gdk_pixbuf_render_pixmap_and_mask GdkPixbuf* pixbuf GdkPixmap** [pixmap_return] GdkBitmap** [mask_return] int alpha_threshold")
+;;; (CFNC-gtk2 "GdkPixbuf* gdk_pixbuf_get_from_drawable GdkPixbuf* @dest GdkDrawable* src GdkColormap* @cmap int src_x int src_y int dest_x int dest_y int width int height")
;;; 2.90.6 (CFNC "GdkPixbuf* gdk_pixbuf_get_from_image GdkPixbuf* @dest GdkImage* src GdkColormap* @cmap int src_x int src_y int dest_x int dest_y int width int height")
-(CCAST-gtk2 "GDK_PIXMAP(object)" "GdkPixmap*")
-(CCHK-gtk2 "GDK_IS_PIXMAP(object)" "GdkPixmap*")
+;;; (CCAST-gtk2 "GDK_PIXMAP(object)" "GdkPixmap*")
+;;; (CCHK-gtk2 "GDK_IS_PIXMAP(object)" "GdkPixmap*")
;;; 2.91.0 ;(CCAST2 "GDK_PIXMAP_OBJECT(object)")
;;;;(CFNC "GType gdk_pixmap_get_type void")
@@ -1092,13 +1159,13 @@
(CFNC "gboolean gdk_property_get GdkWindow* window GdkAtom property GdkAtom type gulong offset gulong length gint pdelete GdkAtom* [actual_property_type] gint* [actual_format] gint* [actual_length] guchar** [data]")
(CFNC "void gdk_property_change GdkWindow* window GdkAtom property GdkAtom type gint format GdkPropMode mode guchar* data gint nelements")
(CFNC "void gdk_property_delete GdkWindow* window GdkAtom property")
-;(CFNC-gtk2 "gint gdk_text_property_to_text_list GdkAtom encoding gint format guchar* text gint length gchar*** list")
-;(CFNC-gtk2 "gint gdk_text_property_to_utf8_list GdkAtom encoding gint format guchar* text gint length gchar*** list")
+;;; ;(CFNC-gtk2 "gint gdk_text_property_to_text_list GdkAtom encoding gint format guchar* text gint length gchar*** list")
+;;; ;(CFNC-gtk2 "gint gdk_text_property_to_utf8_list GdkAtom encoding gint format guchar* text gint length gchar*** list")
(CFNC "gchar* gdk_utf8_to_string_target gchar* str" 'free)
-;(CFNC-gtk2 "gboolean gdk_utf8_to_compound_text gchar* str GdkAtom* encoding gint* format guchar** [ctext] gint* [length]")
-;(CFNC-gtk2 "void gdk_free_text_list gchar** list")
-;(CFNC-gtk2 "gint gdk_string_to_compound_text gchar* str GdkAtom* encoding gint* format guchar** [ctext] gint* [length]")
-;(CFNC-gtk2 "void gdk_free_compound_text guchar* ctext")
+;;; ;(CFNC-gtk2 "gboolean gdk_utf8_to_compound_text gchar* str GdkAtom* encoding gint* format guchar** [ctext] gint* [length]")
+;;; ;(CFNC-gtk2 "void gdk_free_text_list gchar** list")
+;;; ;(CFNC-gtk2 "gint gdk_string_to_compound_text gchar* str GdkAtom* encoding gint* format guchar** [ctext] gint* [length]")
+;;; ;(CFNC-gtk2 "void gdk_free_compound_text guchar* ctext")
;;; 2.90.5
;;; (CFNC "GdkRegion* gdk_region_new void")
;;; (CFNC "GdkRegion* gdk_region_polygon GdkPoint* points gint npoints GdkFillRule fill_rule")
@@ -1119,7 +1186,7 @@
;;; (CFNC "void gdk_region_subtract GdkRegion* source1 GdkRegion* source2")
;;; (CFNC "void gdk_region_xor GdkRegion* source1 GdkRegion* source2")
;;; ;(CFNC "void gdk_region_spans_intersect_foreach GdkRegion* region GdkSpan* spans int n_spans gboolean sorted GdkSpanFunc func lambda_data #func_info")
-(CFNC-gtk2 "void gdk_rgb_find_color GdkColormap* colormap GdkColor* color")
+;;; (CFNC-gtk2 "void gdk_rgb_find_color GdkColormap* colormap GdkColor* color")
;;; 2.90.6 (CINT "GDK_RGB_DITHER_NONE" "GdkRgbDither")
;;; 2.90.6 (CINT "GDK_RGB_DITHER_NORMAL" "GdkRgbDither")
;;; 2.90.6 (CINT "GDK_RGB_DITHER_MAX" "GdkRgbDither")
@@ -1286,7 +1353,7 @@
(CFNC "GdkWindow* gdk_window_new GdkWindow* parent GdkWindowAttr* attributes gint attributes_mask")
(CFNC "void gdk_window_destroy GdkWindow* window")
(CFNC "GdkWindowType gdk_window_get_window_type GdkWindow* window")
-(CFNC "GdkWindow* gdk_window_at_pointer gint* [win_x] gint* [win_y]")
+;;; 3.3.2 (CFNC "GdkWindow* gdk_window_at_pointer gint* [win_x] gint* [win_y]")
(CFNC "void gdk_window_show GdkWindow* window")
(CFNC "void gdk_window_hide GdkWindow* window")
(CFNC "void gdk_window_withdraw GdkWindow* window")
@@ -1295,9 +1362,9 @@
(CFNC "void gdk_window_resize GdkWindow* window gint width gint height")
(CFNC "void gdk_window_move_resize GdkWindow* window gint x gint y gint width gint height")
(CFNC "void gdk_window_reparent GdkWindow* window GdkWindow* new_parent gint x gint y")
-(CFNC-gtk2 "void gdk_window_clear GdkWindow* window")
-(CFNC-gtk2 "void gdk_window_clear_area GdkWindow* window gint x gint y gint width gint height")
-(CFNC-gtk2 "void gdk_window_clear_area_e GdkWindow* window gint x gint y gint width gint height")
+;;; (CFNC-gtk2 "void gdk_window_clear GdkWindow* window")
+;;; (CFNC-gtk2 "void gdk_window_clear_area GdkWindow* window gint x gint y gint width gint height")
+;;; (CFNC-gtk2 "void gdk_window_clear_area_e GdkWindow* window gint x gint y gint width gint height")
(CFNC "void gdk_window_raise GdkWindow* window")
(CFNC "void gdk_window_lower GdkWindow* window")
(CFNC "void gdk_window_focus GdkWindow* window guint32 timestamp")
@@ -1306,19 +1373,19 @@
(CFNC "void gdk_window_add_filter GdkWindow* window GdkFilterFunc func lambda_data #func_info")
(CFNC "void gdk_window_remove_filter GdkWindow* window GdkFilterFunc func lambda_data #func_info")
(CFNC "void gdk_window_scroll GdkWindow* window gint dx gint dy")
-(CFNC-gtk2 "void gdk_window_shape_combine_mask GdkWindow* window GdkBitmap* mask gint x gint y")
+;;; (CFNC-gtk2 "void gdk_window_shape_combine_mask GdkWindow* window GdkBitmap* mask gint x gint y")
;;; (CFNC "void gdk_window_shape_combine_region GdkWindow* window GdkRegion* shape_region gint offset_x gint offset_y")
(CFNC "void gdk_window_set_child_shapes GdkWindow* window")
(CFNC "void gdk_window_merge_child_shapes GdkWindow* window")
(CFNC "gboolean gdk_window_is_visible GdkWindow* window")
(CFNC "gboolean gdk_window_is_viewable GdkWindow* window")
(CFNC "GdkWindowState gdk_window_get_state GdkWindow* window")
-(CFNC "gboolean gdk_window_set_static_gravities GdkWindow* window gboolean use_static")
-(CFNC-gtk2 "GdkWindow* gdk_window_foreign_new GdkNativeWindow anid")
-(CFNC-gtk2 "GdkWindow* gdk_window_lookup GdkNativeWindow anid")
+;;; 3.15 (CFNC "gboolean gdk_window_set_static_gravities GdkWindow* window gboolean use_static")
+;;; (CFNC-gtk2 "GdkWindow* gdk_window_foreign_new GdkNativeWindow anid")
+;;; (CFNC-gtk2 "GdkWindow* gdk_window_lookup GdkNativeWindow anid")
(CFNC "void gdk_window_get_root_origin GdkWindow* window gint* [x] gint* [y]")
(CFNC "void gdk_window_get_frame_extents GdkWindow* window GdkRectangle* rect")
-(CFNC "GdkWindow* gdk_window_get_pointer GdkWindow* window gint* [x] gint* [y] GdkModifierType* [mask]")
+;;; 3.3.2 (CFNC "GdkWindow* gdk_window_get_pointer GdkWindow* window gint* [x] gint* [y] GdkModifierType* [mask]")
(CFNC "GdkWindow* gdk_window_get_parent GdkWindow* window")
(CFNC "GdkWindow* gdk_window_get_toplevel GdkWindow* window")
(CFNC "GList* gdk_window_get_children GdkWindow* window")
@@ -1326,7 +1393,7 @@
(CFNC "GdkEventMask gdk_window_get_events GdkWindow* window")
(CFNC "void gdk_window_set_events GdkWindow* window GdkEventMask event_mask")
(CFNC "void gdk_window_set_icon_list GdkWindow* window GList* pixbufs")
-(CFNC-gtk2 "void gdk_window_set_icon GdkWindow* window GdkWindow* icon_window GdkPixmap* pixmap GdkBitmap* mask")
+;;; (CFNC-gtk2 "void gdk_window_set_icon GdkWindow* window GdkWindow* icon_window GdkPixmap* pixmap GdkBitmap* mask")
(CFNC "void gdk_window_set_icon_name GdkWindow* window gchar* name")
(CFNC "void gdk_window_set_group GdkWindow* window GdkWindow* leader")
(CFNC "void gdk_window_set_decorations GdkWindow* window GdkWMDecoration decorations")
@@ -1351,24 +1418,24 @@
(CFNC "void gdk_window_process_all_updates void")
(CFNC "void gdk_window_process_updates GdkWindow* window gboolean update_children")
(CFNC "void gdk_window_set_debug_updates gboolean setting")
-(CFNC "void gdk_window_constrain_size GdkGeometry* geometry guint flags gint width gint height gint* [new_width] gint* [new_height]")
-(CFNC-gtk2 "void gdk_window_get_internal_paint_info GdkWindow* window GdkDrawable** [real_drawable] gint* [x_offset] gint* [y_offset]")
+(CFNC "void gdk_window_constrain_size GdkGeometry* geometry GdkWindowHints flags gint width gint height gint* [new_width] gint* [new_height]")
+;;; (CFNC-gtk2 "void gdk_window_get_internal_paint_info GdkWindow* window GdkDrawable** [real_drawable] gint* [x_offset] gint* [y_offset]")
(CFNC "void gdk_window_set_type_hint GdkWindow* window GdkWindowTypeHint hint")
(CFNC "void gdk_window_set_modal_hint GdkWindow* window gboolean modal")
(CFNC "void gdk_window_set_geometry_hints GdkWindow* window GdkGeometry* geometry GdkWindowHints geom_mask")
-(CFNC-gtk2 "void gdk_set_sm_client_id gchar* sm_client_id")
+;;; (CFNC-gtk2 "void gdk_set_sm_client_id gchar* sm_client_id")
(CFNC "void gdk_window_begin_paint_rect GdkWindow* window GdkRectangle* rectangle")
;;; (CFNC "void gdk_window_begin_paint_region GdkWindow* window GdkRegion* region")
(CFNC "void gdk_window_end_paint GdkWindow* window")
(CFNC "void gdk_window_set_title GdkWindow* window gchar* title")
(CFNC "void gdk_window_set_role GdkWindow* window gchar* role")
(CFNC "void gdk_window_set_transient_for GdkWindow* window GdkWindow* parent")
-(CFNC "void gdk_window_set_background GdkWindow* window GdkColor* color")
-(CFNC-gtk2 "void gdk_window_set_back_pixmap GdkWindow* window GdkPixmap* pixmap gboolean parent_relative")
+;;; (CFNC-gtk2 "void gdk_window_set_background GdkWindow* window GdkColor* color")
+;;; (CFNC-gtk2 "void gdk_window_set_back_pixmap GdkWindow* window GdkPixmap* pixmap gboolean parent_relative")
(CFNC "void gdk_window_set_cursor GdkWindow* window GdkCursor* cursor")
(CFNC "void gdk_window_get_user_data GdkWindow* window gpointer* [data]")
-(CFNC-gtk2 "void gdk_window_get_geometry GdkWindow* window gint* [x] gint* [y] gint* [width] gint* [height] gint* [depth]")
-(CFNC-300 "void gdk_window_get_geometry GdkWindow* window gint* [x] gint* [y] gint* [width] gint* [height]")
+;;; (CFNC-gtk2 "void gdk_window_get_geometry GdkWindow* window gint* [x] gint* [y] gint* [width] gint* [height] gint* [depth]")
+(CFNC-3.0 "void gdk_window_get_geometry GdkWindow* window gint* [x] gint* [y] gint* [width] gint* [height]")
(CFNC "void gdk_window_get_position GdkWindow* window gint* [x] gint* [y]")
(CFNC "gint gdk_window_get_origin GdkWindow* window gint* [x] gint* [y]")
;;; 2.99.0 ;(CFNC "GdkPointerHooks* gdk_set_pointer_hooks GdkPointerHooks* @new_hooks")
@@ -1391,7 +1458,7 @@
(CFNC "GdkPixbuf* gdk_pixbuf_new_from_file char* filename GError** [error]")
(CFNC "GdkPixbuf* gdk_pixbuf_new_from_data guchar* data GdkColorspace colorspace gboolean has_alpha int bits_per_sample int width int height int rowstride GdkPixbufDestroyNotify destroy_fn gpointer destroy_fn_data")
(CFNC "GdkPixbuf* gdk_pixbuf_new_from_xpm_data char** data" 'const)
-(CFNC "GdkPixbuf* gdk_pixbuf_new_from_inline gint data_length guint8* data gboolean copy_pixels GError** [error]")
+;;; 3.16.0 (CFNC "GdkPixbuf* gdk_pixbuf_new_from_inline gint data_length guint8* data gboolean copy_pixels GError** [error]")
(CFNC "void gdk_pixbuf_fill GdkPixbuf* pixbuf guint32 pixel")
;;; (CFNC "gboolean gdk_pixbuf_save GdkPixbuf* pixbuf char* filename char* type GError** [error] ...")
(CFNC "gboolean gdk_pixbuf_savev GdkPixbuf* pixbuf char* filename char* type char** option_keys char** option_values GError** [error]")
@@ -1442,7 +1509,7 @@
;;; 2.91.6 (CLNG "GDK_TYPE_PIXBUF_ANIMATION_ITER")
(CCAST "GDK_PIXBUF_ANIMATION_ITER(object)" "GdkPixbufAnimationIter*")
(CCHK "GDK_IS_PIXBUF_ANIMATION_ITER(object)" "GdkPixbufAnimationIter*")
-(CLNG "GDK_PIXBUF_ERROR")
+;;; (CLNG "GDK_PIXBUF_ERROR")
(CINT "GDK_PIXBUF_ERROR_CORRUPT_IMAGE" "GdkPixbufError")
(CINT "GDK_PIXBUF_ERROR_INSUFFICIENT_MEMORY" "GdkPixbufError")
(CINT "GDK_PIXBUF_ERROR_BAD_OPTION" "GdkPixbufError")
@@ -1467,10 +1534,10 @@
;;; 2.91.6 (CLNG "GDK_TYPE_INTERP_TYPE")
-(CCAST "GTK_VBOX(obj)" "GtkVBox*")
-(CCHK "GTK_IS_VBOX(obj)" "GtkVBox*")
-;;;;(CFNC "GType gtk_vbox_get_type void")
-(CFNC "GtkWidget* gtk_vbox_new gboolean homogeneous gint spacing")
+;;; 3.1.6 (CCAST "GTK_VBOX(obj)" "GtkVBox*")
+;;; 3.1.6 (CCHK "GTK_IS_VBOX(obj)" "GtkVBox*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_vbox_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_vbox_new gboolean homogeneous gint spacing")
(CCAST "GTK_ACCEL_GROUP(object)" "GtkAccelGroup*")
(CCHK "GTK_IS_ACCEL_GROUP(object)" "GtkAccelGroup*")
(CINT "GTK_ACCEL_VISIBLE" "GtkAccelFlags")
@@ -1518,28 +1585,28 @@
(CCAST "GTK_ACCESSIBLE(obj)" "GtkAccessible*")
(CCHK "GTK_IS_ACCESSIBLE(obj)" "GtkAccessible*")
;;;;(CFNC "GType gtk_accessible_get_type void")
-(CFNC "void gtk_accessible_connect_widget_destroyed GtkAccessible* accessible")
+;;; 3.3.6 (CFNC "void gtk_accessible_connect_widget_destroyed GtkAccessible* accessible")
(CCAST "GTK_ADJUSTMENT(obj)" "GtkAdjustment*")
(CCHK "GTK_IS_ADJUSTMENT(obj)" "GtkAdjustment*")
;;;;(CFNC "GType gtk_adjustment_get_type void")
-(CFNC-gtk2 "GtkObject* gtk_adjustment_new gdouble value gdouble lower gdouble upper gdouble step_increment gdouble page_increment gdouble page_size")
+;;; (CFNC-gtk2 "GtkObject* gtk_adjustment_new gdouble value gdouble lower gdouble upper gdouble step_increment gdouble page_increment gdouble page_size")
-(CFNC "void gtk_adjustment_changed GtkAdjustment* adjustment")
-(CFNC "void gtk_adjustment_value_changed GtkAdjustment* adjustment")
+;;; 3.18.0 (CFNC "void gtk_adjustment_changed GtkAdjustment* adjustment")
+;;; 3.18.0 (CFNC "void gtk_adjustment_value_changed GtkAdjustment* adjustment")
(CFNC "void gtk_adjustment_clamp_page GtkAdjustment* adjustment gdouble lower gdouble upper")
(CFNC "gdouble gtk_adjustment_get_value GtkAdjustment* adjustment")
(CFNC "void gtk_adjustment_set_value GtkAdjustment* adjustment gdouble value")
-(CCAST "GTK_ALIGNMENT(obj)" "GtkAlignment*")
-(CCHK "GTK_IS_ALIGNMENT(obj)" "GtkAlignment*")
-;;;;(CFNC "GType gtk_alignment_get_type void")
-(CFNC "GtkWidget* gtk_alignment_new gfloat xalign gfloat yalign gfloat xscale gfloat yscale")
-(CFNC "void gtk_alignment_set GtkAlignment* alignment gfloat xalign gfloat yalign gfloat xscale gfloat yscale")
-(CCAST "GTK_ARROW(obj)" "GtkArrow*")
-(CCHK "GTK_IS_ARROW(obj)" "GtkArrow*")
+;;; 3.13.2 (CCAST "GTK_ALIGNMENT(obj)" "GtkAlignment*")
+;;; 3.13.2 (CCHK "GTK_IS_ALIGNMENT(obj)" "GtkAlignment*")
+;;; 3.13.2 ;;;;(CFNC "GType gtk_alignment_get_type void")
+;;; 3.13.2 (CFNC "GtkWidget* gtk_alignment_new gfloat xalign gfloat yalign gfloat xscale gfloat yscale")
+;;; 3.13.2 (CFNC "void gtk_alignment_set GtkAlignment* alignment gfloat xalign gfloat yalign gfloat xscale gfloat yscale")
+;;; 3.13.2 (CCAST "GTK_ARROW(obj)" "GtkArrow*")
+;;; 3.13.2 (CCHK "GTK_IS_ARROW(obj)" "GtkArrow*")
;;;;(CFNC "GType gtk_arrow_get_type void")
-(CFNC "GtkWidget* gtk_arrow_new GtkArrowType arrow_type GtkShadowType shadow_type")
-(CFNC "void gtk_arrow_set GtkArrow* arrow GtkArrowType arrow_type GtkShadowType shadow_type")
+;;; 3.13.2 (CFNC "GtkWidget* gtk_arrow_new GtkArrowType arrow_type GtkShadowType shadow_type")
+;;; 3.13.2 (CFNC "void gtk_arrow_set GtkArrow* arrow GtkArrowType arrow_type GtkShadowType shadow_type")
(CCAST "GTK_ASPECT_FRAME(obj)" "GtkAspectFrame*")
(CCHK "GTK_IS_ASPECT_FRAME(obj)" "GtkAspectFrame*")
;;;;(CFNC "GType gtk_aspect_frame_get_type void")
@@ -1555,8 +1622,8 @@
(CFNC "GtkBindingSet* gtk_binding_set_new gchar* set_name")
(CFNC "GtkBindingSet* gtk_binding_set_by_class gpointer object_class")
(CFNC "GtkBindingSet* gtk_binding_set_find gchar* set_name")
-(CFNC-gtk2 "gboolean gtk_bindings_activate GtkObject* object guint keyval GdkModifierType modifiers")
-(CFNC-gtk2 "gboolean gtk_binding_set_activate GtkBindingSet* binding_set guint keyval GdkModifierType modifiers GtkObject* object")
+;;; (CFNC-gtk2 "gboolean gtk_bindings_activate GtkObject* object guint keyval GdkModifierType modifiers")
+;;; (CFNC-gtk2 "gboolean gtk_binding_set_activate GtkBindingSet* binding_set guint keyval GdkModifierType modifiers GtkObject* object")
;;; (CFNC "void gtk_binding_entry_clear GtkBindingSet* binding_set guint keyval GdkModifierType modifiers") ; out 2.11.0
;;; (CFNC "void gtk_binding_entry_add_signal GtkBindingSet* binding_set guint keyval GdkModifierType modifiers gchar* signal_name guint n_args ...")
@@ -1587,7 +1654,7 @@
;;;;(CFNC "GType gtk_button_get_type void")
(CFNC "GtkWidget* gtk_button_new void")
(CFNC "GtkWidget* gtk_button_new_with_label gchar* label")
-(CFNC "GtkWidget* gtk_button_new_from_stock gchar* stock_id")
+;;; 3.9.8 (CFNC "GtkWidget* gtk_button_new_from_stock gchar* stock_id")
(CFNC "GtkWidget* gtk_button_new_with_mnemonic gchar* label")
;;; out 2.19.0 (CFNC "void gtk_button_pressed GtkButton* button")
;;; (CFNC "void gtk_button_released GtkButton* button")
@@ -1600,8 +1667,8 @@
(CFNC "gchar* gtk_button_get_label GtkButton* button")
(CFNC "void gtk_button_set_use_underline GtkButton* button gboolean use_underline")
(CFNC "gboolean gtk_button_get_use_underline GtkButton* button")
-(CFNC "void gtk_button_set_use_stock GtkButton* button gboolean use_stock")
-(CFNC "gboolean gtk_button_get_use_stock GtkButton* button")
+;;; 3.9.8 (CFNC "void gtk_button_set_use_stock GtkButton* button gboolean use_stock")
+;;; 3.9.8 (CFNC "gboolean gtk_button_get_use_stock GtkButton* button")
(CCAST "GTK_CALENDAR(obj)" "GtkCalendar*")
(CCHK "GTK_IS_CALENDAR(obj)" "GtkCalendar*")
(CINT "GTK_CALENDAR_SHOW_HEADING" "GtkCalendarDisplayOptions")
@@ -1640,8 +1707,8 @@
;;;;(CFNC "GType gtk_cell_renderer_get_type void")
(CFNC "gboolean gtk_cell_renderer_activate GtkCellRenderer* cell GdkEvent* event GtkWidget* widget gchar* path GdkRectangle* background_area GdkRectangle* cell_area GtkCellRendererState flags")
-(CFNC-gtk2 "void gtk_cell_renderer_get_size GtkCellRenderer* cell GtkWidget* widget GdkRectangle* @cell_area gint* [x_offset] gint* [y_offset] gint* [width] gint* [height]")
-(CFNC-gtk2 "void gtk_cell_renderer_render GtkCellRenderer* cell GdkWindow* window GtkWidget* widget GdkRectangle* background_area GdkRectangle* cell_area GdkRectangle* expose_area GtkCellRendererState flags")
+;;; (CFNC-gtk2 "void gtk_cell_renderer_get_size GtkCellRenderer* cell GtkWidget* widget GdkRectangle* @cell_area gint* [x_offset] gint* [y_offset] gint* [width] gint* [height]")
+;;; (CFNC-gtk2 "void gtk_cell_renderer_render GtkCellRenderer* cell GdkWindow* window GtkWidget* widget GdkRectangle* background_area GdkRectangle* cell_area GdkRectangle* expose_area GtkCellRendererState flags")
(CFNC "GtkCellEditable* gtk_cell_renderer_start_editing GtkCellRenderer* cell GdkEvent* @event GtkWidget* widget gchar* path GdkRectangle* background_area GdkRectangle* cell_area GtkCellRendererState flags")
(CFNC "void gtk_cell_renderer_set_fixed_size GtkCellRenderer* cell gint width gint height")
@@ -1691,29 +1758,29 @@
(CFNC "GtkSelectionData* gtk_clipboard_wait_for_contents GtkClipboard* clipboard GdkAtom target")
(CFNC "gchar* gtk_clipboard_wait_for_text GtkClipboard* clipboard" 'free)
(CFNC "gboolean gtk_clipboard_wait_is_text_available GtkClipboard* clipboard")
-(CCAST "GTK_COLOR_SELECTION_DIALOG(obj)" "GtkColorSelectionDialog*")
-(CCHK "GTK_IS_COLOR_SELECTION_DIALOG(obj)" "GtkColorSelectionDialog*")
-;;;;(CFNC "GType gtk_color_selection_dialog_get_type void")
-(CFNC "GtkWidget* gtk_color_selection_dialog_new gchar* title")
-(CCAST "GTK_COLOR_SELECTION(obj)" "GtkColorSelection*")
-(CCHK "GTK_IS_COLOR_SELECTION(obj)" "GtkColorSelection*")
-;;;;(CFNC "GType gtk_color_selection_get_type void")
-(CFNC "GtkWidget* gtk_color_selection_new void")
-(CFNC "gboolean gtk_color_selection_get_has_opacity_control GtkColorSelection* colorsel")
-(CFNC "void gtk_color_selection_set_has_opacity_control GtkColorSelection* colorsel gboolean has_opacity")
-(CFNC "gboolean gtk_color_selection_get_has_palette GtkColorSelection* colorsel")
-(CFNC "void gtk_color_selection_set_has_palette GtkColorSelection* colorsel gboolean has_palette")
-(CFNC "void gtk_color_selection_set_current_color GtkColorSelection* colorsel GdkColor* color")
-(CFNC "void gtk_color_selection_set_current_alpha GtkColorSelection* colorsel guint16 alpha")
-(CFNC "void gtk_color_selection_get_current_color GtkColorSelection* colorsel GdkColor* color")
-(CFNC "guint16 gtk_color_selection_get_current_alpha GtkColorSelection* colorsel")
-(CFNC "void gtk_color_selection_set_previous_color GtkColorSelection* colorsel GdkColor* color")
-(CFNC "void gtk_color_selection_set_previous_alpha GtkColorSelection* colorsel guint16 alpha")
-(CFNC "void gtk_color_selection_get_previous_color GtkColorSelection* colorsel GdkColor* color")
-(CFNC "guint16 gtk_color_selection_get_previous_alpha GtkColorSelection* colorsel")
-(CFNC "gboolean gtk_color_selection_is_adjusting GtkColorSelection* colorsel")
-(CFNC "gboolean gtk_color_selection_palette_from_string gchar* str GdkColor** [colors] gint* [n_colors]")
-(CFNC "gchar* gtk_color_selection_palette_to_string GdkColor* colors gint n_colors" 'free)
+;;; 3.3.16 (CCAST "GTK_COLOR_SELECTION_DIALOG(obj)" "GtkColorSelectionDialog*")
+;;; 3.3.16 (CCHK "GTK_IS_COLOR_SELECTION_DIALOG(obj)" "GtkColorSelectionDialog*")
+;;; 3.3.16 ;;;;(CFNC "GType gtk_color_selection_dialog_get_type void")
+;;; 3.3.16 (CFNC "GtkWidget* gtk_color_selection_dialog_new gchar* title")
+;;; 3.3.16 (CCAST "GTK_COLOR_SELECTION(obj)" "GtkColorSelection*")
+;;; 3.3.16 (CCHK "GTK_IS_COLOR_SELECTION(obj)" "GtkColorSelection*")
+;;; 3.3.16 ;;;;(CFNC "GType gtk_color_selection_get_type void")
+;;; 3.3.16 (CFNC "GtkWidget* gtk_color_selection_new void")
+;;; 3.3.16 (CFNC "gboolean gtk_color_selection_get_has_opacity_control GtkColorSelection* colorsel")
+;;; 3.3.16 (CFNC "void gtk_color_selection_set_has_opacity_control GtkColorSelection* colorsel gboolean has_opacity")
+;;; 3.3.16 (CFNC "gboolean gtk_color_selection_get_has_palette GtkColorSelection* colorsel")
+;;; 3.3.16 (CFNC "void gtk_color_selection_set_has_palette GtkColorSelection* colorsel gboolean has_palette")
+;;; ;;; 3.3.16 (CFNC-gtk2 "void gtk_color_selection_set_current_color GtkColorSelection* colorsel GdkColor* color")
+;;; 3.3.16 (CFNC "void gtk_color_selection_set_current_alpha GtkColorSelection* colorsel guint16 alpha")
+;;; ;;; 3.3.16 (CFNC-gtk2 "void gtk_color_selection_get_current_color GtkColorSelection* colorsel GdkColor* color")
+;;; 3.3.16 (CFNC "guint16 gtk_color_selection_get_current_alpha GtkColorSelection* colorsel")
+;;; ;;; 3.3.16 (CFNC-gtk2 "void gtk_color_selection_set_previous_color GtkColorSelection* colorsel GdkColor* color")
+;;; 3.3.16 (CFNC "void gtk_color_selection_set_previous_alpha GtkColorSelection* colorsel guint16 alpha")
+;;; ;;; 3.3.16 (CFNC-gtk2 "void gtk_color_selection_get_previous_color GtkColorSelection* colorsel GdkColor* color")
+;;; 3.3.16 (CFNC "guint16 gtk_color_selection_get_previous_alpha GtkColorSelection* colorsel")
+;;; 3.3.16 (CFNC "gboolean gtk_color_selection_is_adjusting GtkColorSelection* colorsel")
+;;; ;;; 3.3.16 (CFNC-gtk2 "gboolean gtk_color_selection_palette_from_string gchar* str GdkColor** [colors] gint* [n_colors]")
+;;; ;;; 3.3.16 (CFNC-gtk2 "gchar* gtk_color_selection_palette_to_string GdkColor* colors gint n_colors" 'free)
;;; out 2.3 (CFNC "GtkColorSelectionChangePaletteFunc gtk_color_selection_set_change_palette_hook GtkColorSelectionChangePaletteFunc func")
;;; out 2.3 (CCAST "GTK_COMBO(obj)" "GtkCombo*")
;;; out 2.3 (CCHK "GTK_IS_COMBO(obj)" "GtkCombo*")
@@ -1734,8 +1801,8 @@
(CFNC "guint gtk_container_get_border_width GtkContainer* container")
(CFNC "void gtk_container_add GtkContainer* container GtkWidget* widget")
(CFNC "void gtk_container_remove GtkContainer* container GtkWidget* widget")
-(CFNC "void gtk_container_set_resize_mode GtkContainer* container GtkResizeMode resize_mode")
-(CFNC "GtkResizeMode gtk_container_get_resize_mode GtkContainer* container")
+;;; 3.12.0 (CFNC "void gtk_container_set_resize_mode GtkContainer* container GtkResizeMode resize_mode")
+;;; 3.12.0 (CFNC "GtkResizeMode gtk_container_get_resize_mode GtkContainer* container")
(CFNC "void gtk_container_check_resize GtkContainer* container")
(CFNC "void gtk_container_foreach GtkContainer* container GtkCallback func lambda_data #func_info")
(CFNC "GList* gtk_container_get_children GtkContainer* container") ; FREE (g_list_free)
@@ -1772,7 +1839,7 @@
(CCHK "GTK_IS_DIALOG(obj)" "GtkDialog*")
;;;;(CFNC "GType gtk_dialog_get_type void")
(CFNC "GtkWidget* gtk_dialog_new void")
-(CFNC-PA "GtkWidget* gtk_dialog_new_with_buttons gchar* title GtkWindow* @parent GtkDialogFlags flags etc #buttons" 0 10 '("gchar*" "int"))
+;;; in 3.3.4 this is generating a warning (CFNC-PA "GtkWidget* gtk_dialog_new_with_buttons gchar* title GtkWindow* @parent GtkDialogFlags flags etc #buttons" 0 10 '("gchar*" "int"))
;;; ... at init arg, then list arg name, min len, max len, step, then types within step
(CFNC "void gtk_dialog_add_action_widget GtkDialog* dialog GtkWidget* child gint response_id")
(CFNC "GtkWidget* gtk_dialog_add_button GtkDialog* dialog gchar* button_text gint response_id")
@@ -1795,21 +1862,21 @@
(CFNC "void gtk_drag_highlight GtkWidget* widget")
(CFNC "void gtk_drag_unhighlight GtkWidget* widget")
(CFNC "void gtk_drag_dest_set GtkWidget* widget GtkDestDefaults flags GtkTargetEntry* targets gint n_targets GdkDragAction actions")
-(CFNC-gtk2 "void gtk_drag_dest_set_proxy GtkWidget* widget GdkWindow* proxy_window GdkDragProtocol protocol gboolean use_coordinates")
+;;; (CFNC-gtk2 "void gtk_drag_dest_set_proxy GtkWidget* widget GdkWindow* proxy_window GdkDragProtocol protocol gboolean use_coordinates")
(CFNC "void gtk_drag_dest_unset GtkWidget* widget")
(CFNC "GdkAtom gtk_drag_dest_find_target GtkWidget* widget GdkDragContext* context GtkTargetList* @target_list")
(CFNC "GtkTargetList* gtk_drag_dest_get_target_list GtkWidget* widget")
(CFNC "void gtk_drag_dest_set_target_list GtkWidget* widget GtkTargetList* @target_list")
(CFNC "void gtk_drag_source_set GtkWidget* widget GdkModifierType start_button_mask GtkTargetEntry* targets gint n_targets GdkDragAction actions")
(CFNC "void gtk_drag_source_unset GtkWidget* widget")
-(CFNC-gtk2 "void gtk_drag_source_set_icon GtkWidget* widget GdkColormap* colormap GdkPixmap* pixmap GdkBitmap* mask")
+;;; (CFNC-gtk2 "void gtk_drag_source_set_icon GtkWidget* widget GdkColormap* colormap GdkPixmap* pixmap GdkBitmap* mask")
(CFNC "void gtk_drag_source_set_icon_pixbuf GtkWidget* widget GdkPixbuf* pixbuf")
-(CFNC "void gtk_drag_source_set_icon_stock GtkWidget* widget gchar* stock_id")
-(CFNC "GdkDragContext* gtk_drag_begin GtkWidget* widget GtkTargetList* targets GdkDragAction actions gint button GdkEvent* event")
+;;; 3.9.8 (CFNC "void gtk_drag_source_set_icon_stock GtkWidget* widget gchar* stock_id")
+;;; (CFNC "GdkDragContext* gtk_drag_begin GtkWidget* widget GtkTargetList* targets GdkDragAction actions gint button GdkEvent* event")
(CFNC "void gtk_drag_set_icon_widget GdkDragContext* context GtkWidget* widget gint hot_x gint hot_y")
-(CFNC-gtk2 "void gtk_drag_set_icon_pixmap GdkDragContext* context GdkColormap* colormap GdkPixmap* pixmap GdkBitmap* mask gint hot_x gint hot_y")
+;;; (CFNC-gtk2 "void gtk_drag_set_icon_pixmap GdkDragContext* context GdkColormap* colormap GdkPixmap* pixmap GdkBitmap* mask gint hot_x gint hot_y")
(CFNC "void gtk_drag_set_icon_pixbuf GdkDragContext* context GdkPixbuf* pixbuf gint hot_x gint hot_y")
-(CFNC "void gtk_drag_set_icon_stock GdkDragContext* context gchar* stock_id gint hot_x gint hot_y")
+;;; (CFNC "void gtk_drag_set_icon_stock GdkDragContext* context gchar* stock_id gint hot_x gint hot_y")
(CFNC "void gtk_drag_set_icon_default GdkDragContext* context")
(CFNC "gboolean gtk_drag_check_threshold GtkWidget* widget gint start_x gint start_y gint current_x gint current_y")
(CCAST "GTK_DRAWING_AREA(obj)" "GtkDrawingArea*")
@@ -1872,13 +1939,13 @@
;(CINT "GTK_ANCHOR_W" "GtkAnchorType")
;(CINT "GTK_ANCHOR_E" "GtkAnchorType")
-(CINT "GTK_ARROW_UP" "GtkArrowType")
-(CINT "GTK_ARROW_DOWN" "GtkArrowType")
-(CINT "GTK_ARROW_LEFT" "GtkArrowType")
-(CINT "GTK_ARROW_RIGHT" "GtkArrowType")
-(CINT "GTK_EXPAND" "GtkAttachOptions")
-(CINT "GTK_SHRINK" "GtkAttachOptions")
-(CINT "GTK_FILL" "GtkAttachOptions")
+;;; 3.13.2 (CINT "GTK_ARROW_UP" "GtkArrowType")
+;;; 3.13.2 (CINT "GTK_ARROW_DOWN" "GtkArrowType")
+;;; 3.13.2 (CINT "GTK_ARROW_LEFT" "GtkArrowType")
+;;; 3.13.2 (CINT "GTK_ARROW_RIGHT" "GtkArrowType")
+;;; 3.15.0 (CINT "GTK_EXPAND" "GtkAttachOptions")
+;;; 3.15.0 (CINT "GTK_SHRINK" "GtkAttachOptions")
+;;; 3.15.0 (CINT "GTK_FILL" "GtkAttachOptions")
;;; 2.90.6 (CINT "GTK_BUTTONBOX_DEFAULT_STYLE" "GtkButtonBoxStyle")
(CINT "GTK_BUTTONBOX_SPREAD" "GtkButtonBoxStyle")
(CINT "GTK_BUTTONBOX_EDGE" "GtkButtonBoxStyle")
@@ -1902,17 +1969,19 @@
(CINT "GTK_DIR_DOWN" "GtkDirectionType")
(CINT "GTK_DIR_LEFT" "GtkDirectionType")
(CINT "GTK_DIR_RIGHT" "GtkDirectionType")
-(CINT "GTK_EXPANDER_COLLAPSED" "GtkExpanderStyle")
-(CINT "GTK_EXPANDER_SEMI_COLLAPSED" "GtkExpanderStyle")
-(CINT "GTK_EXPANDER_SEMI_EXPANDED" "GtkExpanderStyle")
-(CINT "GTK_EXPANDER_EXPANDED" "GtkExpanderStyle")
-(CINT "GTK_ICON_SIZE_INVALID" "GtkIconSize")
-(CINT "GTK_ICON_SIZE_MENU" "GtkIconSize")
-(CINT "GTK_ICON_SIZE_SMALL_TOOLBAR" "GtkIconSize")
-(CINT "GTK_ICON_SIZE_LARGE_TOOLBAR" "GtkIconSize")
-(CINT "GTK_ICON_SIZE_BUTTON" "GtkIconSize")
-(CINT "GTK_ICON_SIZE_DND" "GtkIconSize")
-(CINT "GTK_ICON_SIZE_DIALOG" "GtkIconSize")
+;;; 3.15.0 (CINT "GTK_EXPANDER_COLLAPSED" "GtkExpanderStyle")
+;;; 3.15.0 (CINT "GTK_EXPANDER_SEMI_COLLAPSED" "GtkExpanderStyle")
+;;; 3.15.0 (CINT "GTK_EXPANDER_SEMI_EXPANDED" "GtkExpanderStyle")
+;;; 3.15.0 (CINT "GTK_EXPANDER_EXPANDED" "GtkExpanderStyle")
+
+;;; 3.9.8
+;;; (CINT "GTK_ICON_SIZE_INVALID" "GtkIconSize")
+;;; (CINT "GTK_ICON_SIZE_MENU" "GtkIconSize")
+;;; (CINT "GTK_ICON_SIZE_SMALL_TOOLBAR" "GtkIconSize")
+;;; (CINT "GTK_ICON_SIZE_LARGE_TOOLBAR" "GtkIconSize")
+;;; (CINT "GTK_ICON_SIZE_BUTTON" "GtkIconSize")
+;;; (CINT "GTK_ICON_SIZE_DND" "GtkIconSize")
+;;; (CINT "GTK_ICON_SIZE_DIALOG" "GtkIconSize")
(CINT "GTK_TEXT_DIR_NONE" "GtkTextDirection")
(CINT "GTK_TEXT_DIR_LTR" "GtkTextDirection")
(CINT "GTK_TEXT_DIR_RTL" "GtkTextDirection")
@@ -1944,16 +2013,16 @@
(CINT "GTK_CORNER_BOTTOM_RIGHT" "GtkCornerType")
(CINT "GTK_PACK_START" "GtkPackType")
(CINT "GTK_PACK_END" "GtkPackType")
-(CINT "GTK_PATH_PRIO_LOWEST" "GtkPathPriorityType")
-(CINT "GTK_PATH_PRIO_GTK")
-(CINT "GTK_PATH_PRIO_APPLICATION" "GtkPathPriorityType")
-(CINT "GTK_PATH_PRIO_THEME" "GtkPathPriorityType")
-(CINT "GTK_PATH_PRIO_RC" "GtkPathPriorityType")
-(CINT "GTK_PATH_PRIO_HIGHEST" "GtkPathPriorityType")
-(CINT "GTK_PATH_PRIO_MASK")
-(CINT "GTK_PATH_WIDGET" "GtkPathType")
-(CINT "GTK_PATH_WIDGET_CLASS" "GtkPathType")
-(CINT "GTK_PATH_CLASS" "GtkPathType")
+;;; 3.15.0 (CINT "GTK_PATH_PRIO_LOWEST" "GtkPathPriorityType")
+;;; 3.15.0 (CINT "GTK_PATH_PRIO_GTK")
+;;; 3.15.0 (CINT "GTK_PATH_PRIO_APPLICATION" "GtkPathPriorityType")
+;;; 3.15.0 (CINT "GTK_PATH_PRIO_THEME" "GtkPathPriorityType")
+;;; 3.15.0 (CINT "GTK_PATH_PRIO_RC" "GtkPathPriorityType")
+;;; 3.15.0 (CINT "GTK_PATH_PRIO_HIGHEST" "GtkPathPriorityType")
+;;; 3.15.0 (CINT "GTK_PATH_PRIO_MASK")
+;;; 3.15.0 (CINT "GTK_PATH_WIDGET" "GtkPathType")
+;;; 3.15.0 (CINT "GTK_PATH_WIDGET_CLASS" "GtkPathType")
+;;; 3.15.0 (CINT "GTK_PATH_CLASS" "GtkPathType")
(CINT "GTK_POLICY_ALWAYS" "GtkPolicyType")
(CINT "GTK_POLICY_AUTOMATIC" "GtkPolicyType")
(CINT "GTK_POLICY_NEVER" "GtkPolicyType")
@@ -1993,22 +2062,21 @@
(CINT "GTK_SHADOW_OUT" "GtkShadowType")
(CINT "GTK_SHADOW_ETCHED_IN" "GtkShadowType")
(CINT "GTK_SHADOW_ETCHED_OUT" "GtkShadowType")
-(CINT "GTK_STATE_NORMAL" "GtkStateType")
-(CINT "GTK_STATE_ACTIVE" "GtkStateType")
-(CINT "GTK_STATE_PRELIGHT" "GtkStateType")
-(CINT "GTK_STATE_SELECTED" "GtkStateType")
-(CINT "GTK_STATE_INSENSITIVE" "GtkStateType")
-
-(CINT-300 "GTK_STATE_INCONSISTENT" "GtkStateType")
-(CINT-300 "GTK_STATE_FOCUSED" "GtkStateType")
+;(CINT "GTK_STATE_NORMAL" "GtkStateType")
+;(CINT "GTK_STATE_ACTIVE" "GtkStateType")
+;(CINT "GTK_STATE_PRELIGHT" "GtkStateType")
+;(CINT "GTK_STATE_SELECTED" "GtkStateType")
+;(CINT "GTK_STATE_INSENSITIVE" "GtkStateType")
+;(CINT-3.0 "GTK_STATE_INCONSISTENT" "GtkStateType")
+;(CINT-3.0 "GTK_STATE_FOCUSED" "GtkStateType")
(CINT "GTK_TOOLBAR_ICONS" "GtkToolbarStyle")
(CINT "GTK_TOOLBAR_TEXT" "GtkToolbarStyle")
(CINT "GTK_TOOLBAR_BOTH" "GtkToolbarStyle")
(CINT "GTK_TOOLBAR_BOTH_HORIZ" "GtkToolbarStyle")
-(CINT-gtk2 "GTK_UPDATE_CONTINUOUS" "GtkUpdateType")
-(CINT-gtk2 "GTK_UPDATE_DISCONTINUOUS" "GtkUpdateType")
-(CINT-gtk2 "GTK_UPDATE_DELAYED" "GtkUpdateType")
+;;; (CINT-gtk2 "GTK_UPDATE_CONTINUOUS" "GtkUpdateType")
+;;; (CINT-gtk2 "GTK_UPDATE_DISCONTINUOUS" "GtkUpdateType")
+;;; (CINT-gtk2 "GTK_UPDATE_DELAYED" "GtkUpdateType")
;(CINT "GTK_VISIBILITY_NONE" "GtkVisibility")
;(CINT "GTK_VISIBILITY_PARTIAL" "GtkVisibility")
;(CINT "GTK_VISIBILITY_FULL" "GtkVisibility")
@@ -2071,22 +2139,22 @@
(CFNC "void gtk_fixed_move GtkFixed* fixed GtkWidget* widget gint x gint y")
;;; out 2.19.3 (CFNC "void gtk_fixed_set_has_window GtkFixed* fixed gboolean has_window")
;;; (CFNC "gboolean gtk_fixed_get_has_window GtkFixed* fixed")
-(CCAST "GTK_FONT_SELECTION(obj)" "GtkFontSelection*")
-(CCHK "GTK_IS_FONT_SELECTION(obj)" "GtkFontSelection*")
-(CCAST "GTK_FONT_SELECTION_DIALOG(obj)" "GtkFontSelectionDialog*")
-(CCHK "GTK_IS_FONT_SELECTION_DIALOG(obj)" "GtkFontSelectionDialog*")
-;;;;(CFNC "GType gtk_font_selection_get_type void")
-(CFNC "GtkWidget* gtk_font_selection_new void")
-(CFNC "gchar* gtk_font_selection_get_font_name GtkFontSelection* fontsel" 'free)
-(CFNC "gboolean gtk_font_selection_set_font_name GtkFontSelection* fontsel gchar* fontname")
-(CFNC "gchar* gtk_font_selection_get_preview_text GtkFontSelection* fontsel")
-(CFNC "void gtk_font_selection_set_preview_text GtkFontSelection* fontsel gchar* text")
-;;;;(CFNC "GType gtk_font_selection_dialog_get_type void")
-(CFNC "GtkWidget* gtk_font_selection_dialog_new gchar* title")
-(CFNC "gchar* gtk_font_selection_dialog_get_font_name GtkFontSelectionDialog* fsd" 'free)
-(CFNC "gboolean gtk_font_selection_dialog_set_font_name GtkFontSelectionDialog* fsd gchar* fontname")
-(CFNC "gchar* gtk_font_selection_dialog_get_preview_text GtkFontSelectionDialog* fsd")
-(CFNC "void gtk_font_selection_dialog_set_preview_text GtkFontSelectionDialog* fsd gchar* text")
+
+;;; (CCAST-gtk2 "GTK_FONT_SELECTION(obj)" "GtkFontSelection*")
+;;; (CCHK-gtk2 "GTK_IS_FONT_SELECTION(obj)" "GtkFontSelection*")
+;;; (CCAST-gtk2 "GTK_FONT_SELECTION_DIALOG(obj)" "GtkFontSelectionDialog*")
+;;; (CCHK-gtk2 "GTK_IS_FONT_SELECTION_DIALOG(obj)" "GtkFontSelectionDialog*")
+;;; (CFNC-gtk2 "GtkWidget* gtk_font_selection_new void")
+;;; (CFNC-gtk2 "gchar* gtk_font_selection_get_font_name GtkFontSelection* fontsel" 'free)
+;;; (CFNC-gtk2 "gboolean gtk_font_selection_set_font_name GtkFontSelection* fontsel gchar* fontname")
+;;; (CFNC-gtk2 "gchar* gtk_font_selection_get_preview_text GtkFontSelection* fontsel")
+;;; (CFNC-gtk2 "void gtk_font_selection_set_preview_text GtkFontSelection* fontsel gchar* text")
+;;; (CFNC-gtk2 "GtkWidget* gtk_font_selection_dialog_new gchar* title")
+;;; (CFNC-gtk2 "gchar* gtk_font_selection_dialog_get_font_name GtkFontSelectionDialog* fsd" 'free)
+;;; (CFNC-gtk2 "gboolean gtk_font_selection_dialog_set_font_name GtkFontSelectionDialog* fsd gchar* fontname")
+;;; (CFNC-gtk2 "gchar* gtk_font_selection_dialog_get_preview_text GtkFontSelectionDialog* fsd")
+;;; (CFNC-gtk2 "void gtk_font_selection_dialog_set_preview_text GtkFontSelectionDialog* fsd gchar* text")
+
(CCAST "GTK_FRAME(obj)" "GtkFrame*")
(CCHK "GTK_IS_FRAME(obj)" "GtkFrame*")
;;;;(CFNC "GType gtk_frame_get_type void")
@@ -2105,86 +2173,90 @@
;;; (CFNC "GtkWidget* gtk_gamma_curve_new void")
;;; 2.90.6 (CFNC "GdkGC* gtk_gc_get gint depth GdkColormap* colormap GdkGCValues* values GdkGCValuesMask values_mask")
;;; 2.90.6 (CFNC "void gtk_gc_release GdkGC* gc")
-(CCAST "GTK_HANDLE_BOX(obj)" "GtkHandleBox*")
-(CCHK "GTK_IS_HANDLE_BOX(obj)" "GtkHandleBox*")
+;;; 3.3.2 (CCAST "GTK_HANDLE_BOX(obj)" "GtkHandleBox*")
+;;; 3.3.2 (CCHK "GTK_IS_HANDLE_BOX(obj)" "GtkHandleBox*")
;;;;(CFNC "GType gtk_handle_box_get_type void")
-(CFNC "GtkWidget* gtk_handle_box_new void")
-(CFNC "void gtk_handle_box_set_shadow_type GtkHandleBox* handle_box GtkShadowType type")
-(CFNC "GtkShadowType gtk_handle_box_get_shadow_type GtkHandleBox* handle_box")
-(CFNC "void gtk_handle_box_set_handle_position GtkHandleBox* handle_box GtkPositionType position")
-(CFNC "GtkPositionType gtk_handle_box_get_handle_position GtkHandleBox* handle_box")
-(CFNC "void gtk_handle_box_set_snap_edge GtkHandleBox* handle_box GtkPositionType edge")
-(CFNC "GtkPositionType gtk_handle_box_get_snap_edge GtkHandleBox* handle_box")
-(CCAST "GTK_HBUTTON_BOX(obj)" "GtkHButtonBox*")
-(CCHK "GTK_IS_HBUTTON_BOX(obj)" "GtkHButtonBox*")
-;;;;(CFNC "GType gtk_hbutton_box_get_type void")
-(CFNC "GtkWidget* gtk_hbutton_box_new void")
-(CCAST "GTK_HBOX(obj)" "GtkHBox*")
-(CCHK "GTK_IS_HBOX(obj)" "GtkHBox*")
-;;;;(CFNC "GType gtk_hbox_get_type void")
-(CFNC "GtkWidget* gtk_hbox_new gboolean homogeneous gint spacing")
-(CCAST "GTK_HPANED(obj)" "GtkHPaned*")
-(CCHK "GTK_IS_HPANED(obj)" "GtkHPaned*")
-;;;;(CFNC "GType gtk_hpaned_get_type void")
-(CFNC "GtkWidget* gtk_hpaned_new void")
+;;; 3.3.2 (CFNC "GtkWidget* gtk_handle_box_new void")
+;;; 3.3.2 (CFNC "void gtk_handle_box_set_shadow_type GtkHandleBox* handle_box GtkShadowType type")
+;;; 3.3.2 (CFNC "GtkShadowType gtk_handle_box_get_shadow_type GtkHandleBox* handle_box")
+;;; 3.3.2 (CFNC "void gtk_handle_box_set_handle_position GtkHandleBox* handle_box GtkPositionType position")
+;;; 3.3.2 (CFNC "GtkPositionType gtk_handle_box_get_handle_position GtkHandleBox* handle_box")
+;;; 3.3.2 (CFNC "void gtk_handle_box_set_snap_edge GtkHandleBox* handle_box GtkPositionType edge")
+;;; 3.3.2 (CFNC "GtkPositionType gtk_handle_box_get_snap_edge GtkHandleBox* handle_box")
+;;; 3.1.6 (CCAST "GTK_HBUTTON_BOX(obj)" "GtkHButtonBox*")
+;;; 3.1.6 (CCHK "GTK_IS_HBUTTON_BOX(obj)" "GtkHButtonBox*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_hbutton_box_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_hbutton_box_new void")
+;;; 3.1.6 (CCAST "GTK_HBOX(obj)" "GtkHBox*")
+;;; 3.1.6 (CCHK "GTK_IS_HBOX(obj)" "GtkHBox*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_hbox_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_hbox_new gboolean homogeneous gint spacing")
+;;; 3.1.6 (CCAST "GTK_HPANED(obj)" "GtkHPaned*")
+;;; 3.1.6 (CCHK "GTK_IS_HPANED(obj)" "GtkHPaned*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_hpaned_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_hpaned_new void")
;;; 2.91.5 (CCAST "GTK_HRULER(obj)" "GtkHRuler*")
;;; 2.91.5 (CCHK "GTK_IS_HRULER(obj)" "GtkHRuler*")
;;;;(CFNC "GType gtk_hruler_get_type void")
;;; 2.91.5 (CFNC "GtkWidget* gtk_hruler_new void")
-(CCAST "GTK_HSCALE(obj)" "GtkHScale*")
-(CCHK "GTK_IS_HSCALE(obj)" "GtkHScale*")
-;;;;(CFNC "GType gtk_hscale_get_type void")
-(CFNC "GtkWidget* gtk_hscale_new GtkAdjustment* @adjustment")
-(CFNC "GtkWidget* gtk_hscale_new_with_range gdouble min gdouble max gdouble step")
-(CCAST "GTK_HSCROLLBAR(obj)" "GtkHScrollbar*")
-(CCHK "GTK_IS_HSCROLLBAR(obj)" "GtkHScrollbar*")
-;;;;(CFNC "GType gtk_hscrollbar_get_type void")
-(CFNC "GtkWidget* gtk_hscrollbar_new GtkAdjustment* @adjustment")
-(CCAST "GTK_HSEPARATOR(obj)" "GtkHSeparator*")
-(CCHK "GTK_IS_HSEPARATOR(obj)" "GtkHSeparator*")
-;;;;(CFNC "GType gtk_hseparator_get_type void")
-(CFNC "GtkWidget* gtk_hseparator_new void")
-(CCAST "GTK_ICON_FACTORY(object)" "GtkIconFactory*")
-(CCHK "GTK_IS_ICON_FACTORY(object)" "GtkIconFactory*")
+;;; 3.1.6 (CCAST "GTK_HSCALE(obj)" "GtkHScale*")
+;;; 3.1.6 (CCHK "GTK_IS_HSCALE(obj)" "GtkHScale*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_hscale_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_hscale_new GtkAdjustment* @adjustment")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_hscale_new_with_range gdouble min gdouble max gdouble step")
+;;; 3.1.6 (CCAST "GTK_HSCROLLBAR(obj)" "GtkHScrollbar*")
+;;; 3.1.6 (CCHK "GTK_IS_HSCROLLBAR(obj)" "GtkHScrollbar*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_hscrollbar_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_hscrollbar_new GtkAdjustment* @adjustment")
+;;; 3.1.6 (CCAST "GTK_HSEPARATOR(obj)" "GtkHSeparator*")
+;;; 3.1.6 (CCHK "GTK_IS_HSEPARATOR(obj)" "GtkHSeparator*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_hseparator_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_hseparator_new void")
+
+;;; all of these deprecated 3.9.8
+;;; (CCAST "GTK_ICON_FACTORY(object)" "GtkIconFactory*")
+;;; (CCHK "GTK_IS_ICON_FACTORY(object)" "GtkIconFactory*")
;;;;(CFNC "GType gtk_icon_factory_get_type void")
-(CFNC "GtkIconFactory* gtk_icon_factory_new void")
-(CFNC "void gtk_icon_factory_add GtkIconFactory* factory gchar* stock_id GtkIconSet* icon_set")
-(CFNC "GtkIconSet* gtk_icon_factory_lookup GtkIconFactory* factory gchar* stock_id")
-(CFNC "void gtk_icon_factory_add_default GtkIconFactory* factory")
-(CFNC "void gtk_icon_factory_remove_default GtkIconFactory* factory")
-(CFNC "GtkIconSet* gtk_icon_factory_lookup_default gchar* stock_id")
-(CFNC "gboolean gtk_icon_size_lookup GtkIconSize size gint* [width] gint* [height]")
-(CFNC "GtkIconSize gtk_icon_size_register gchar* name gint width gint height")
-(CFNC "void gtk_icon_size_register_alias gchar* alias GtkIconSize target")
-(CFNC "GtkIconSize gtk_icon_size_from_name gchar* name") ; null = segfault
-(CFNC "gchar* gtk_icon_size_get_name GtkIconSize size")
-(CFNC "GtkIconSet* gtk_icon_set_new void")
-(CFNC "GtkIconSet* gtk_icon_set_new_from_pixbuf GdkPixbuf* pixbuf")
-(CFNC "GtkIconSet* gtk_icon_set_ref GtkIconSet* icon_set")
-(CFNC "void gtk_icon_set_unref GtkIconSet* icon_set")
-(CFNC "GtkIconSet* gtk_icon_set_copy GtkIconSet* icon_set")
-(CFNC-gtk2 "GdkPixbuf* gtk_icon_set_render_icon GtkIconSet* icon_set GtkStyle* @style GtkTextDirection direction GtkStateType state GtkIconSize size GtkWidget* @widget char* detail")
-(CFNC "void gtk_icon_set_add_source GtkIconSet* icon_set GtkIconSource* source")
-(CFNC "void gtk_icon_set_get_sizes GtkIconSet* icon_set GtkIconSize** [sizes] gint* [n_sizes]")
-(CFNC "GtkIconSource* gtk_icon_source_new void")
-(CFNC "GtkIconSource* gtk_icon_source_copy GtkIconSource* source")
-(CFNC "void gtk_icon_source_free GtkIconSource* source")
-(CFNC "void gtk_icon_source_set_filename GtkIconSource* source gchar* filename")
-(CFNC "void gtk_icon_source_set_pixbuf GtkIconSource* source GdkPixbuf* @pixbuf")
-(CFNC "gchar* gtk_icon_source_get_filename GtkIconSource* source")
-(CFNC "GdkPixbuf* gtk_icon_source_get_pixbuf GtkIconSource* source")
-(CFNC "void gtk_icon_source_set_direction_wildcarded GtkIconSource* source gboolean setting")
-(CFNC "void gtk_icon_source_set_state_wildcarded GtkIconSource* source gboolean setting")
-(CFNC "void gtk_icon_source_set_size_wildcarded GtkIconSource* source gboolean setting")
-(CFNC "gboolean gtk_icon_source_get_size_wildcarded GtkIconSource* source")
-(CFNC "gboolean gtk_icon_source_get_state_wildcarded GtkIconSource* source")
-(CFNC "gboolean gtk_icon_source_get_direction_wildcarded GtkIconSource* source")
-(CFNC "void gtk_icon_source_set_direction GtkIconSource* source GtkTextDirection direction")
-(CFNC "void gtk_icon_source_set_state GtkIconSource* source GtkStateType state")
-(CFNC "void gtk_icon_source_set_size GtkIconSource* source GtkIconSize size")
-(CFNC "GtkTextDirection gtk_icon_source_get_direction GtkIconSource* source")
-(CFNC "GtkStateType gtk_icon_source_get_state GtkIconSource* source")
-(CFNC "GtkIconSize gtk_icon_source_get_size GtkIconSource* source")
+;;; (CFNC "GtkIconFactory* gtk_icon_factory_new void")
+;;; (CFNC "void gtk_icon_factory_add GtkIconFactory* factory gchar* stock_id GtkIconSet* icon_set")
+;;; (CFNC "GtkIconSet* gtk_icon_factory_lookup GtkIconFactory* factory gchar* stock_id")
+;;; (CFNC "void gtk_icon_factory_add_default GtkIconFactory* factory")
+;;; (CFNC "void gtk_icon_factory_remove_default GtkIconFactory* factory")
+;;; (CFNC "GtkIconSet* gtk_icon_factory_lookup_default gchar* stock_id")
+;;; (CFNC "gboolean gtk_icon_size_lookup GtkIconSize size gint* [width] gint* [height]")
+;;; (CFNC "GtkIconSize gtk_icon_size_register gchar* name gint width gint height")
+;;; (CFNC "void gtk_icon_size_register_alias gchar* alias GtkIconSize target")
+;;; (CFNC "GtkIconSize gtk_icon_size_from_name gchar* name") ; null = segfault
+;;; (CFNC "gchar* gtk_icon_size_get_name GtkIconSize size")
+;;; (CFNC "GtkIconSet* gtk_icon_set_new void")
+;;; (CFNC "GtkIconSet* gtk_icon_set_new_from_pixbuf GdkPixbuf* pixbuf")
+;;; (CFNC "GtkIconSet* gtk_icon_set_ref GtkIconSet* icon_set")
+;;; (CFNC "void gtk_icon_set_unref GtkIconSet* icon_set")
+;;; (CFNC "GtkIconSet* gtk_icon_set_copy GtkIconSet* icon_set")
+;;; ;;; (CFNC-gtk2 "GdkPixbuf* gtk_icon_set_render_icon GtkIconSet* icon_set GtkStyle* @style GtkTextDirection direction GtkStateType state GtkIconSize size GtkWidget* @widget char* detail")
+;;; (CFNC "void gtk_icon_set_add_source GtkIconSet* icon_set GtkIconSource* source")
+;;; (CFNC "void gtk_icon_set_get_sizes GtkIconSet* icon_set GtkIconSize** [sizes] gint* [n_sizes]")
+;;; (CFNC "GtkIconSource* gtk_icon_source_new void")
+;;; (CFNC "GtkIconSource* gtk_icon_source_copy GtkIconSource* source")
+;;; (CFNC "void gtk_icon_source_free GtkIconSource* source")
+;;; (CFNC "void gtk_icon_source_set_filename GtkIconSource* source gchar* filename")
+;;; (CFNC "void gtk_icon_source_set_pixbuf GtkIconSource* source GdkPixbuf* @pixbuf")
+;;; (CFNC "gchar* gtk_icon_source_get_filename GtkIconSource* source")
+;;; (CFNC "GdkPixbuf* gtk_icon_source_get_pixbuf GtkIconSource* source")
+;;; (CFNC "void gtk_icon_source_set_direction_wildcarded GtkIconSource* source gboolean setting")
+;;; (CFNC "void gtk_icon_source_set_state_wildcarded GtkIconSource* source gboolean setting")
+;;; (CFNC "void gtk_icon_source_set_size_wildcarded GtkIconSource* source gboolean setting")
+;;; (CFNC "gboolean gtk_icon_source_get_size_wildcarded GtkIconSource* source")
+;;; (CFNC "gboolean gtk_icon_source_get_state_wildcarded GtkIconSource* source")
+;;; (CFNC "gboolean gtk_icon_source_get_direction_wildcarded GtkIconSource* source")
+;;; (CFNC "void gtk_icon_source_set_direction GtkIconSource* source GtkTextDirection direction")
+;;; (CFNC "void gtk_icon_source_set_state GtkIconSource* source GtkStateType state")
+;;; (CFNC "void gtk_icon_source_set_size GtkIconSource* source GtkIconSize size")
+;;; (CFNC "GtkTextDirection gtk_icon_source_get_direction GtkIconSource* source")
+;;; (CFNC "GtkStateType gtk_icon_source_get_state GtkIconSource* source")
+;;; (CFNC "GtkIconSize gtk_icon_source_get_size GtkIconSource* source")
+;;; !!
+
(CCAST "GTK_IMAGE(obj)" "GtkImage*")
(CCHK "GTK_IS_IMAGE(obj)" "GtkImage*")
(CINT "GTK_IMAGE_EMPTY" "GtkImageType")
@@ -2200,32 +2272,35 @@
;;; 2.90.6 (CFNC "GtkWidget* gtk_image_new_from_image GdkImage* @image GdkBitmap* @mask")
(CFNC "GtkWidget* gtk_image_new_from_file gchar* filename")
(CFNC "GtkWidget* gtk_image_new_from_pixbuf GdkPixbuf* @pixbuf")
-(CFNC "GtkWidget* gtk_image_new_from_stock gchar* stock_id GtkIconSize size")
-(CFNC "GtkWidget* gtk_image_new_from_icon_set GtkIconSet* icon_set GtkIconSize size")
+;;; (CFNC "GtkWidget* gtk_image_new_from_stock gchar* stock_id GtkIconSize size")
+;;; (CFNC "GtkWidget* gtk_image_new_from_icon_set GtkIconSet* icon_set GtkIconSize size")
(CFNC "GtkWidget* gtk_image_new_from_animation GdkPixbufAnimation* animation")
;;; 2.91.0 (CFNC "void gtk_image_set_from_pixmap GtkImage* image GdkPixmap* @pixmap GdkBitmap* @mask")
;;; 2.90.6 (CFNC "void gtk_image_set_from_image GtkImage* image GdkImage* @gdk_image GdkBitmap* @mask")
(CFNC "void gtk_image_set_from_file GtkImage* image gchar* filename")
(CFNC "void gtk_image_set_from_pixbuf GtkImage* image GdkPixbuf* @pixbuf")
-(CFNC "void gtk_image_set_from_stock GtkImage* image gchar* stock_id GtkIconSize size")
-(CFNC "void gtk_image_set_from_icon_set GtkImage* image GtkIconSet* icon_set GtkIconSize size")
+;;; (CFNC "void gtk_image_set_from_stock GtkImage* image gchar* stock_id GtkIconSize size")
+;;; (CFNC "void gtk_image_set_from_icon_set GtkImage* image GtkIconSet* icon_set GtkIconSize size")
(CFNC "void gtk_image_set_from_animation GtkImage* image GdkPixbufAnimation* @animation")
(CFNC "GtkImageType gtk_image_get_storage_type GtkImage* image")
;;; 2.91.0 (CFNC "void gtk_image_get_pixmap GtkImage* image GdkPixmap** [pixmap] GdkBitmap** [mask]")
;;; 2.90.6 (CFNC "void gtk_image_get_image GtkImage* image GdkImage** [gdk_image] GdkBitmap** [mask]")
(CFNC "GdkPixbuf* gtk_image_get_pixbuf GtkImage* image")
-(CFNC "void gtk_image_get_stock GtkImage* image gchar** [stock_id] GtkIconSize* [size]")
-(CFNC "void gtk_image_get_icon_set GtkImage* image GtkIconSet** [icon_set] GtkIconSize* [size]")
+;;; (CFNC "void gtk_image_get_stock GtkImage* image gchar** [stock_id] GtkIconSize* [size]")
+;;; (CFNC "void gtk_image_get_icon_set GtkImage* image GtkIconSet** [icon_set] GtkIconSize* [size]")
(CFNC "GdkPixbufAnimation* gtk_image_get_animation GtkImage* image")
-(CCAST "GTK_IMAGE_MENU_ITEM(obj)" "GtkImageMenuItem*")
-(CCHK "GTK_IS_IMAGE_MENU_ITEM(obj)" "GtkImageMenuItem*")
-;;;;(CFNC "GType gtk_image_menu_item_get_type void")
-(CFNC "GtkWidget* gtk_image_menu_item_new void")
-(CFNC "GtkWidget* gtk_image_menu_item_new_with_label gchar* label") ; null = segfault
-(CFNC "GtkWidget* gtk_image_menu_item_new_with_mnemonic gchar* label")
-(CFNC "GtkWidget* gtk_image_menu_item_new_from_stock gchar* stock_id GtkAccelGroup* @accel_group")
-(CFNC "void gtk_image_menu_item_set_image GtkImageMenuItem* image_menu_item GtkWidget* image")
-(CFNC "GtkWidget* gtk_image_menu_item_get_image GtkImageMenuItem* image_menu_item")
+
+;;; out 3.9.8
+;;; (CCAST "GTK_IMAGE_MENU_ITEM(obj)" "GtkImageMenuItem*")
+;;; (CCHK "GTK_IS_IMAGE_MENU_ITEM(obj)" "GtkImageMenuItem*")
+;;; ;;;;(CFNC "GType gtk_image_menu_item_get_type void")
+;;; (CFNC "GtkWidget* gtk_image_menu_item_new void")
+;;; (CFNC "GtkWidget* gtk_image_menu_item_new_with_label gchar* label") ; null = segfault
+;;; (CFNC "GtkWidget* gtk_image_menu_item_new_with_mnemonic gchar* label")
+;;; (CFNC "GtkWidget* gtk_image_menu_item_new_from_stock gchar* stock_id GtkAccelGroup* @accel_group")
+;;; (CFNC "void gtk_image_menu_item_set_image GtkImageMenuItem* image_menu_item GtkWidget* image")
+;;; (CFNC "GtkWidget* gtk_image_menu_item_get_image GtkImageMenuItem* image_menu_item")
+
(CCAST "GTK_IM_CONTEXT(obj)" "GtkIMContext*")
(CCHK "GTK_IS_IM_CONTEXT(obj)" "GtkIMContext*")
;;;;(CFNC "GType gtk_im_context_get_type void")
@@ -2246,11 +2321,11 @@
;;;;(CFNC "GType gtk_im_context_simple_get_type void")
(CFNC "GtkIMContext* gtk_im_context_simple_new void")
(CFNC "void gtk_im_context_simple_add_table GtkIMContextSimple* context_simple guint16* data gint max_seq_len gint n_seqs")
-(CCAST "GTK_IM_MULTICONTEXT(obj)" "GtkIMMulticontext*")
-(CCHK "GTK_IS_IM_MULTICONTEXT(obj)" "GtkIMMulticontext*")
+;;; (CCAST "GTK_IM_MULTICONTEXT(obj)" "GtkIMMulticontext*")
+;;; (CCHK "GTK_IS_IM_MULTICONTEXT(obj)" "GtkIMMulticontext*")
;;;;(CFNC "GType gtk_im_multicontext_get_type void")
-(CFNC "GtkIMContext* gtk_im_multicontext_new void")
-(CFNC "void gtk_im_multicontext_append_menuitems GtkIMMulticontext* context GtkMenuShell* menushell")
+;;; (CFNC "GtkIMContext* gtk_im_multicontext_new void")
+;;; 3.11 (CFNC "void gtk_im_multicontext_append_menuitems GtkIMMulticontext* context GtkMenuShell* menushell")
;;; (CCAST "GTK_INPUT_DIALOG(obj)" "GtkInputDialog*")
;;; (CCHK "GTK_IS_INPUT_DIALOG(obj)" "GtkInputDialog*")
;;;;(CFNC "GType gtk_input_dialog_get_type void")
@@ -2359,7 +2434,7 @@
;(CFNC "void gtk_init_abi_check int* argc char*** argv int num_checks size_t sizeof_GtkWindow")
;(CFNC "gboolean gtk_init_check_abi_check int* argc char*** argv int num_checks size_t sizeof_GtkWindow")
(CFNC "void gtk_disable_setlocale void")
-(CFNC-gtk2 "gchar* gtk_set_locale void")
+;;; (CFNC-gtk2 "gchar* gtk_set_locale void")
(CFNC "PangoLanguage* gtk_get_default_language void")
(CFNC "gint gtk_events_pending void")
(CFNC "void gtk_main_do_event GdkEvent* event")
@@ -2389,8 +2464,8 @@
;;; out 2.3 (CFNC "void gtk_idle_remove_by_data xen data")
;;; out 2.3 ;(CFNC "guint gtk_input_add_full gint source GdkInputCondition condition GdkInputFunction func GtkCallbackMarshal marshal lambda_data func_info GtkDestroyNotify destroy")
;;; out 2.3 (CFNC "void gtk_input_remove guint input_handler_id")
-(CFNC "guint gtk_key_snooper_install GtkKeySnoopFunc func lambda_data #func_info")
-(CFNC "void gtk_key_snooper_remove guint snooper_handler_id")
+;;; 3.3.8 (CFNC "guint gtk_key_snooper_install GtkKeySnoopFunc func lambda_data #func_info")
+;;; 3.3.8 (CFNC "void gtk_key_snooper_remove guint snooper_handler_id")
(CFNC "GdkEvent* gtk_get_current_event void")
(CFNC "guint32 gtk_get_current_event_time void")
(CFNC "gboolean gtk_get_current_event_state GdkModifierType* [state]")
@@ -2416,10 +2491,10 @@
;; see note in makexg.scm -- no user data here, so this requires special handling
(CFNC "void gtk_menu_detach GtkMenu* menu")
(CFNC "GtkWidget* gtk_menu_get_attach_widget GtkMenu* menu")
-(CFNC "void gtk_menu_set_tearoff_state GtkMenu* menu gboolean torn_off")
-(CFNC "gboolean gtk_menu_get_tearoff_state GtkMenu* menu")
-(CFNC "void gtk_menu_set_title GtkMenu* menu gchar* title")
-(CFNC "gchar* gtk_menu_get_title GtkMenu* menu")
+;;; 3.3.2 (CFNC "void gtk_menu_set_tearoff_state GtkMenu* menu gboolean torn_off")
+;;; 3.3.2 (CFNC "gboolean gtk_menu_get_tearoff_state GtkMenu* menu")
+;;; 3.10 (CFNC "void gtk_menu_set_title GtkMenu* menu gchar* title")
+;;; 3.10 (CFNC "gchar* gtk_menu_get_title GtkMenu* menu")
(CFNC "void gtk_menu_reorder_child GtkMenu* menu GtkWidget* child gint position")
(CFNC "void gtk_menu_set_monitor GtkMenu* menu gint monitor_num")
(CCAST "GTK_MENU_ITEM(obj)" "GtkMenuItem*")
@@ -2436,8 +2511,8 @@
(CFNC "void gtk_menu_item_activate GtkMenuItem* menu_item")
(CFNC "void gtk_menu_item_toggle_size_request GtkMenuItem* menu_item gint* requisition")
(CFNC "void gtk_menu_item_toggle_size_allocate GtkMenuItem* menu_item gint allocation")
-(CFNC "void gtk_menu_item_set_right_justified GtkMenuItem* menu_item gboolean right_justified")
-(CFNC "gboolean gtk_menu_item_get_right_justified GtkMenuItem* menu_item")
+;;; 3.1.4 (CFNC "void gtk_menu_item_set_right_justified GtkMenuItem* menu_item gboolean right_justified")
+;;; 3.1.4 (CFNC "gboolean gtk_menu_item_get_right_justified GtkMenuItem* menu_item")
(CFNC "void gtk_menu_item_set_accel_path GtkMenuItem* menu_item gchar* accel_path")
(CCAST "GTK_MENU_SHELL(obj)" "GtkMenuShell*")
(CCHK "GTK_IS_MENU_SHELL(obj)" "GtkMenuShell*")
@@ -2464,13 +2539,13 @@
;;;;(CFNC "GType gtk_message_dialog_get_type void")
;;;(CFNC "GtkWidget* gtk_message_dialog_new GtkWindow* parent GtkDialogFlags flags GtkMessageType type GtkButtonsType buttons gchar* message_format ...")
;;; the ... arg here would have to be a vnprintf style arg
-(CCAST "GTK_MISC(obj)" "GtkMisc*")
-(CCHK "GTK_IS_MISC(obj)" "GtkMisc*")
-;;;;(CFNC "GType gtk_misc_get_type void")
-(CFNC "void gtk_misc_set_alignment GtkMisc* misc gfloat xalign gfloat yalign")
-(CFNC "void gtk_misc_get_alignment GtkMisc* misc gfloat* [xalign] gfloat* [yalign]")
-(CFNC "void gtk_misc_set_padding GtkMisc* misc gint xpad gint ypad")
-(CFNC "void gtk_misc_get_padding GtkMisc* misc gint* [xpad] gint* [ypad]")
+;;; 3.13.2 (CCAST "GTK_MISC(obj)" "GtkMisc*")
+;;; 3.13.2 (CCHK "GTK_IS_MISC(obj)" "GtkMisc*")
+;;; 3.13.2 ;;;;(CFNC "GType gtk_misc_get_type void")
+;;; 3.13.2 (CFNC "void gtk_misc_set_alignment GtkMisc* misc gfloat xalign gfloat yalign")
+;;; 3.13.2 (CFNC "void gtk_misc_get_alignment GtkMisc* misc gfloat* [xalign] gfloat* [yalign]")
+;;; 3.13.2 (CFNC "void gtk_misc_set_padding GtkMisc* misc gint xpad gint ypad")
+;;; 3.13.2 (CFNC "void gtk_misc_get_padding GtkMisc* misc gint* [xpad] gint* [ypad]")
(CCAST "GTK_NOTEBOOK(obj)" "GtkNotebook*")
(CCHK "GTK_IS_NOTEBOOK(obj)" "GtkNotebook*")
(CINT "GTK_NOTEBOOK_TAB_FIRST" "GtkNotebookTab")
@@ -2516,8 +2591,8 @@
;;; 2.91.0 (CCAST "GTK_OBJECT(object)" "GtkObject*")
;;; 2.91.0 (CCHK "GTK_IS_OBJECT(object)" "GtkObject*")
-(CCAST-gtk2 "GTK_OBJECT(object)" "GtkObject*")
-(CCHK-gtk2 "GTK_IS_OBJECT(object)" "GtkObject*")
+;;; (CCAST-gtk2 "GTK_OBJECT(object)" "GtkObject*")
+;;; (CCHK-gtk2 "GTK_IS_OBJECT(object)" "GtkObject*")
;;; 2.91.0 ;(CCAST2 "GTK_OBJECT_TYPE(object)")
;;; 2.19.3 (CFNC "char* GTK_OBJECT_TYPE_NAME GtkObject* object")
@@ -2609,8 +2684,8 @@
(CFNC "void gtk_range_set_range GtkRange* range gdouble min gdouble max")
(CFNC "void gtk_range_set_value GtkRange* range gdouble value")
(CFNC "gdouble gtk_range_get_value GtkRange* range")
-(CFNC-gtk2 "void gtk_range_set_update_policy GtkRange* range GtkUpdateType policy")
-(CFNC-gtk2 "GtkUpdateType gtk_range_get_update_policy GtkRange* range")
+;;; (CFNC-gtk2 "void gtk_range_set_update_policy GtkRange* range GtkUpdateType policy")
+;;; (CFNC-gtk2 "GtkUpdateType gtk_range_get_update_policy GtkRange* range")
;(CINT "GTK_RBNODE_BLACK")
;(CINT "GTK_RBNODE_RED")
;(CINT "GTK_RBNODE_IS_PARENT")
@@ -2630,31 +2705,31 @@
;(CCAST2 "GTK_RBNODE_FLAG_SET(node")
;;; (CCAST "GTK_RC_STYLE(object)" "GtkRcStyle*")
;;; this collides with GTK_RC_STYLE defined in gtkwidget.h!
-(CCHK-gtk2 "GTK_IS_RC_STYLE(object)" "GtkRcStyle*")
-(CINT-gtk2 "GTK_RC_FG")
-(CINT-gtk2 "GTK_RC_BG")
-(CINT-gtk2 "GTK_RC_TEXT")
-(CINT-gtk2 "GTK_RC_BASE")
-(CFNC-gtk2 "void gtk_rc_add_default_file gchar* filename")
-(CFNC-gtk2 "void gtk_rc_set_default_files gchar** filenames")
-(CFNC-gtk2 "gchar** gtk_rc_get_default_files void")
-(CFNC-gtk2 "GtkStyle* gtk_rc_get_style GtkWidget* widget")
+;;; (CCHK-gtk2 "GTK_IS_RC_STYLE(object)" "GtkRcStyle*")
+;;; (CINT-gtk2 "GTK_RC_FG")
+;;; (CINT-gtk2 "GTK_RC_BG")
+;;; (CINT-gtk2 "GTK_RC_TEXT")
+;;; (CINT-gtk2 "GTK_RC_BASE")
+;;; (CFNC-gtk2 "void gtk_rc_add_default_file gchar* filename")
+;;; (CFNC-gtk2 "void gtk_rc_set_default_files gchar** filenames")
+;;; (CFNC-gtk2 "gchar** gtk_rc_get_default_files void")
+;;; (CFNC-gtk2 "GtkStyle* gtk_rc_get_style GtkWidget* widget")
;(CFNC "GtkStyle* gtk_rc_get_style_by_paths GtkSettings* settings char* widget_path char* class_path GType type")
;(CFNC "gboolean gtk_rc_reparse_all_for_settings GtkSettings* settings gboolean force_load")
;(CFNC "gchar* gtk_rc_find_pixmap_in_path GtkSettings* settings GScanner* @scanner gchar* pixmap_file")
-(CFNC-gtk2 "void gtk_rc_parse gchar* filename")
-(CFNC-gtk2 "void gtk_rc_parse_string gchar* rc_string")
-(CFNC-gtk2 "gboolean gtk_rc_reparse_all void")
-;;;;(CFNC-gtk2 "GType gtk_rc_style_get_type void")
-(CFNC-gtk2 "GtkRcStyle* gtk_rc_style_new void")
-(CFNC-gtk2 "GtkRcStyle* gtk_rc_style_copy GtkRcStyle* orig")
-;;;-gtk2 (CFNC "void gtk_rc_style_ref GtkRcStyle* rc_style") ; out 2.11.0
-;;;-gtk2 (CFNC "void gtk_rc_style_unref GtkRcStyle* rc_style")
-(CFNC-gtk2 "gchar* gtk_rc_find_module_in_path gchar* module_file" 'free)
-(CFNC-gtk2 "gchar* gtk_rc_get_theme_dir void" 'free)
-(CFNC-gtk2 "gchar* gtk_rc_get_module_dir void" 'free)
-(CFNC-gtk2 "gchar* gtk_rc_get_im_module_path void" 'free)
-(CFNC-gtk2 "gchar* gtk_rc_get_im_module_file void" 'free)
+;;; (CFNC-gtk2 "void gtk_rc_parse gchar* filename")
+;;; (CFNC-gtk2 "void gtk_rc_parse_string gchar* rc_string")
+;;; (CFNC-gtk2 "gboolean gtk_rc_reparse_all void")
+;;; ;;;;(CFNC-gtk2 "GType gtk_rc_style_get_type void")
+;;; (CFNC-gtk2 "GtkRcStyle* gtk_rc_style_new void")
+;;; (CFNC-gtk2 "GtkRcStyle* gtk_rc_style_copy GtkRcStyle* orig")
+;;; ;;;-gtk2 (CFNC "void gtk_rc_style_ref GtkRcStyle* rc_style") ; out 2.11.0
+;;; ;;;-gtk2 (CFNC "void gtk_rc_style_unref GtkRcStyle* rc_style")
+;;; (CFNC-gtk2 "gchar* gtk_rc_find_module_in_path gchar* module_file" 'free)
+;;; (CFNC-gtk2 "gchar* gtk_rc_get_theme_dir void" 'free)
+;;; (CFNC-gtk2 "gchar* gtk_rc_get_module_dir void" 'free)
+;;; (CFNC-gtk2 "gchar* gtk_rc_get_im_module_path void" 'free)
+;;; (CFNC-gtk2 "gchar* gtk_rc_get_im_module_file void" 'free)
;; these are for "theme engines" -- I can't see any use for them in this context (deprecated 2.91.6)
;(CINT "GTK_RC_TOKEN_INVALID" "GtkRcTokenType")
@@ -2706,8 +2781,8 @@
;;;;(CFNC "GType gtk_ruler_get_type void")
;;; 2.91.5 (CFNC "void gtk_ruler_set_metric GtkRuler* ruler GtkMetricType metric")
;;; 2.91.5 (CFNC "void gtk_ruler_set_range GtkRuler* ruler gdouble lower gdouble upper gdouble position gdouble max_size")
-;;; 2.91.5 (CFNC-gtk2 "void gtk_ruler_draw_ticks GtkRuler* ruler")
-;;; 2.91.5 (CFNC-gtk2 "void gtk_ruler_draw_pos GtkRuler* ruler")
+;;; ;;; 2.91.5 (CFNC-gtk2 "void gtk_ruler_draw_ticks GtkRuler* ruler")
+;;; ;;; 2.91.5 (CFNC-gtk2 "void gtk_ruler_draw_pos GtkRuler* ruler")
;;; 2.91.5 (CFNC "GtkMetricType gtk_ruler_get_metric GtkRuler* ruler")
;;; 2.91.5 (CFNC "void gtk_ruler_get_range GtkRuler* ruler gdouble* [lower] gdouble* [upper] gdouble* [position] gdouble* [max_size]")
(CCAST "GTK_SCALE(obj)" "GtkScale*")
@@ -2736,7 +2811,7 @@
(CFNC "GtkCornerType gtk_scrolled_window_get_placement GtkScrolledWindow* scrolled_window")
(CFNC "void gtk_scrolled_window_set_shadow_type GtkScrolledWindow* scrolled_window GtkShadowType type")
(CFNC "GtkShadowType gtk_scrolled_window_get_shadow_type GtkScrolledWindow* scrolled_window")
-(CFNC "void gtk_scrolled_window_add_with_viewport GtkScrolledWindow* scrolled_window GtkWidget* child")
+;;; 3.8 (CFNC "void gtk_scrolled_window_add_with_viewport GtkScrolledWindow* scrolled_window GtkWidget* child")
(CFNC "GtkTargetList* gtk_target_list_new GtkTargetEntry* @targets guint ntargets")
;;; return type changed 290
;;;(CFNC "void gtk_target_list_ref GtkTargetList* list")
@@ -2770,10 +2845,10 @@
(CCHK "GTK_IS_SEPARATOR_MENU_ITEM(obj)" "GtkSeparatorMenuItem*")
;;;;(CFNC "GType gtk_separator_menu_item_get_type void")
(CFNC "GtkWidget* gtk_separator_menu_item_new void")
-;(CCAST "GTK_SETTINGS(obj)" "GtkSettings*")
-;(CCHK "GTK_IS_SETTINGS(obj)" "GtkSettings*")
+(CCAST "GTK_SETTINGS(obj)" "GtkSettings*")
+(CCHK "GTK_IS_SETTINGS(obj)" "GtkSettings*")
;;;;;(CFNC "GType gtk_settings_get_type void")
-;(CFNC "GtkSettings* gtk_settings_get_default void")
+(CFNC "GtkSettings* gtk_settings_get_default void")
;(CFNC "void gtk_settings_install_property GParamSpec* pspec")
;(CFNC "void gtk_settings_install_property_parser GParamSpec* pspec GtkRcPropertyParser parser")
;(CFNC "gboolean gtk_rc_property_parse_color GParamSpec* pspec GString* gstring GValue* property_value")
@@ -2850,170 +2925,172 @@
(CFNC "void gtk_statusbar_remove GtkStatusbar* statusbar guint context_id guint message_id")
;;; 2.91.1 (CFNC "void gtk_statusbar_set_has_resize_grip GtkStatusbar* statusbar gboolean setting")
;;; 2.91.1 (CFNC "gboolean gtk_statusbar_get_has_resize_grip GtkStatusbar* statusbar")
-(CFNC "void gtk_stock_add GtkStockItem* items guint n_items")
-(CFNC "void gtk_stock_add_static GtkStockItem* items guint n_items")
-(CFNC "gboolean gtk_stock_lookup gchar* stock_id GtkStockItem* item")
-(CFNC "GSList* gtk_stock_list_ids void")
-(CFNC "GtkStockItem* gtk_stock_item_copy GtkStockItem* item")
-(CFNC "void gtk_stock_item_free GtkStockItem* item")
-(CSTR "GTK_STOCK_DIALOG_INFO")
-(CSTR "GTK_STOCK_DIALOG_WARNING")
-(CSTR "GTK_STOCK_DIALOG_ERROR")
-(CSTR "GTK_STOCK_DIALOG_QUESTION")
-(CSTR "GTK_STOCK_DND")
-(CSTR "GTK_STOCK_DND_MULTIPLE")
-(CSTR "GTK_STOCK_ADD")
-(CSTR "GTK_STOCK_APPLY")
-(CSTR "GTK_STOCK_BOLD")
-(CSTR "GTK_STOCK_CANCEL")
-(CSTR "GTK_STOCK_CDROM")
-(CSTR "GTK_STOCK_CLEAR")
-(CSTR "GTK_STOCK_CLOSE")
-(CSTR "GTK_STOCK_COLOR_PICKER")
-(CSTR "GTK_STOCK_CONVERT")
-(CSTR "GTK_STOCK_COPY")
-(CSTR "GTK_STOCK_CUT")
-(CSTR "GTK_STOCK_DELETE")
-(CSTR "GTK_STOCK_EXECUTE")
-(CSTR "GTK_STOCK_FIND")
-(CSTR "GTK_STOCK_FIND_AND_REPLACE")
-(CSTR "GTK_STOCK_FLOPPY")
-(CSTR "GTK_STOCK_GOTO_BOTTOM")
-(CSTR "GTK_STOCK_GOTO_FIRST")
-(CSTR "GTK_STOCK_GOTO_LAST")
-(CSTR "GTK_STOCK_GOTO_TOP")
-(CSTR "GTK_STOCK_GO_BACK")
-(CSTR "GTK_STOCK_GO_DOWN")
-(CSTR "GTK_STOCK_GO_FORWARD")
-(CSTR "GTK_STOCK_GO_UP")
-(CSTR "GTK_STOCK_HARDDISK")
-(CSTR "GTK_STOCK_HELP")
-(CSTR "GTK_STOCK_HOME")
-(CSTR "GTK_STOCK_INDEX")
-(CSTR "GTK_STOCK_ITALIC")
-(CSTR "GTK_STOCK_INDENT")
-(CSTR "GTK_STOCK_UNINDENT")
-(CSTR "GTK_STOCK_NETWORK")
-(CSTR "GTK_STOCK_JUMP_TO")
-(CSTR "GTK_STOCK_JUSTIFY_CENTER")
-(CSTR "GTK_STOCK_JUSTIFY_FILL")
-(CSTR "GTK_STOCK_JUSTIFY_LEFT")
-(CSTR "GTK_STOCK_JUSTIFY_RIGHT")
-(CSTR "GTK_STOCK_MISSING_IMAGE")
-(CSTR "GTK_STOCK_NEW")
-(CSTR "GTK_STOCK_NO")
-(CSTR "GTK_STOCK_OK")
-(CSTR "GTK_STOCK_OPEN")
-(CSTR "GTK_STOCK_PASTE")
-(CSTR "GTK_STOCK_PREFERENCES")
-(CSTR "GTK_STOCK_PRINT")
-(CSTR "GTK_STOCK_PRINT_PREVIEW")
-(CSTR "GTK_STOCK_PROPERTIES")
-(CSTR "GTK_STOCK_QUIT")
-(CSTR "GTK_STOCK_REDO")
-(CSTR "GTK_STOCK_REFRESH")
-(CSTR "GTK_STOCK_REMOVE")
-(CSTR "GTK_STOCK_REVERT_TO_SAVED")
-(CSTR "GTK_STOCK_SAVE")
-(CSTR "GTK_STOCK_SAVE_AS")
-(CSTR "GTK_STOCK_SELECT_COLOR")
-(CSTR "GTK_STOCK_SELECT_FONT")
-(CSTR "GTK_STOCK_SORT_ASCENDING")
-(CSTR "GTK_STOCK_SORT_DESCENDING")
-(CSTR "GTK_STOCK_SPELL_CHECK")
-(CSTR "GTK_STOCK_STOP")
-(CSTR "GTK_STOCK_STRIKETHROUGH")
-(CSTR "GTK_STOCK_UNDELETE")
-(CSTR "GTK_STOCK_UNDERLINE")
-(CSTR "GTK_STOCK_UNDO")
-(CSTR "GTK_STOCK_YES")
-(CSTR "GTK_STOCK_ZOOM_100")
-(CSTR "GTK_STOCK_ZOOM_FIT")
-(CSTR "GTK_STOCK_ZOOM_IN")
-(CSTR "GTK_STOCK_ZOOM_OUT")
-
-;(CSTR "GTK_STOCK_DIALOG_AUTHENTICATION")
-(CSTR "GTK_STOCK_ABOUT")
-(CSTR "GTK_STOCK_CONNECT")
-(CSTR "GTK_STOCK_DIRECTORY")
-(CSTR "GTK_STOCK_DISCONNECT")
-(CSTR "GTK_STOCK_EDIT")
-(CSTR "GTK_STOCK_FILE")
-(CSTR "GTK_STOCK_MEDIA_FORWARD")
-(CSTR "GTK_STOCK_MEDIA_NEXT")
-(CSTR "GTK_STOCK_MEDIA_PAUSE")
-(CSTR "GTK_STOCK_MEDIA_PLAY")
-(CSTR "GTK_STOCK_MEDIA_PREVIOUS")
-(CSTR "GTK_STOCK_MEDIA_RECORD")
-(CSTR "GTK_STOCK_MEDIA_REWIND")
-(CSTR "GTK_STOCK_MEDIA_STOP")
-
-(CSTR "GTK_STOCK_FULLSCREEN")
-(CSTR "GTK_STOCK_INFO")
-(CSTR "GTK_STOCK_LEAVE_FULLSCREEN")
-
-(CSTR "GTK_STOCK_ORIENTATION_PORTRAIT")
-(CSTR "GTK_STOCK_ORIENTATION_LANDSCAPE")
-(CSTR "GTK_STOCK_ORIENTATION_REVERSE_LANDSCAPE")
-(CSTR "GTK_STOCK_SELECT_ALL")
-
-(CSTR "GTK_STOCK_ORIENTATION_REVERSE_PORTRAIT")
-
-(CCAST-gtk2 "GTK_STYLE(object)" "GtkStyle*")
-(CCHK-gtk2 "GTK_IS_STYLE(object)" "GtkStyle*")
-;(CCAST2-gtk2 "GTK_STYLE_ATTACHED(style)")
-;;;;(CFNC-gtk2 "GType gtk_style_get_type void")
-(CFNC-gtk2 "GtkStyle* gtk_style_new void")
-(CFNC-gtk2 "GtkStyle* gtk_style_copy GtkStyle* style")
-(CFNC-gtk2 "GtkStyle* gtk_style_attach GtkStyle* style GdkWindow* window")
-(CFNC-gtk2 "void gtk_style_detach GtkStyle* style")
-(CFNC-gtk2 "void gtk_style_set_background GtkStyle* style GdkWindow* window GtkStateType state_type")
-(CFNC-gtk2 "void gtk_style_apply_default_background GtkStyle* style GdkWindow* window gboolean set_bg GtkStateType state_type GdkRectangle* area gint x gint y gint width gint height")
-(CFNC-gtk2 "GtkIconSet* gtk_style_lookup_icon_set GtkStyle* style gchar* stock_id")
-(CFNC-gtk2 "GdkPixbuf* gtk_style_render_icon GtkStyle* style GtkIconSource* source GtkTextDirection direction GtkStateType state GtkIconSize size GtkWidget* widget gchar* detail")
-;(CFNC-gtk2 "void gtk_paint_hline GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail gint x1 gint x2 gint y")
-;(CFNC-gtk2 "void gtk_paint_vline GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail gint y1 gint y2 gint x")
-;(CFNC-gtk2 "void gtk_paint_shadow GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+
+;;; all out 3.9.8
+;;; (CFNC "void gtk_stock_add GtkStockItem* items guint n_items")
+;;; (CFNC "void gtk_stock_add_static GtkStockItem* items guint n_items")
+;;; (CFNC "gboolean gtk_stock_lookup gchar* stock_id GtkStockItem* item")
+;;; (CFNC "GSList* gtk_stock_list_ids void")
+;;; (CFNC "GtkStockItem* gtk_stock_item_copy GtkStockItem* item")
+;;; (CFNC "void gtk_stock_item_free GtkStockItem* item")
+;;; (CSTR "GTK_STOCK_DIALOG_INFO")
+;;; (CSTR "GTK_STOCK_DIALOG_WARNING")
+;;; (CSTR "GTK_STOCK_DIALOG_ERROR")
+;;; (CSTR "GTK_STOCK_DIALOG_QUESTION")
+;;; (CSTR "GTK_STOCK_DND")
+;;; (CSTR "GTK_STOCK_DND_MULTIPLE")
+;;; (CSTR "GTK_STOCK_ADD")
+;;; (CSTR "GTK_STOCK_APPLY")
+;;; (CSTR "GTK_STOCK_BOLD")
+;;; (CSTR "GTK_STOCK_CANCEL")
+;;; (CSTR "GTK_STOCK_CDROM")
+;;; (CSTR "GTK_STOCK_CLEAR")
+;;; (CSTR "GTK_STOCK_CLOSE")
+;;; (CSTR "GTK_STOCK_COLOR_PICKER")
+;;; (CSTR "GTK_STOCK_CONVERT")
+;;; (CSTR "GTK_STOCK_COPY")
+;;; (CSTR "GTK_STOCK_CUT")
+;;; (CSTR "GTK_STOCK_DELETE")
+;;; (CSTR "GTK_STOCK_EXECUTE")
+;;; (CSTR "GTK_STOCK_FIND")
+;;; (CSTR "GTK_STOCK_FIND_AND_REPLACE")
+;;; (CSTR "GTK_STOCK_FLOPPY")
+;;; (CSTR "GTK_STOCK_GOTO_BOTTOM")
+;;; (CSTR "GTK_STOCK_GOTO_FIRST")
+;;; (CSTR "GTK_STOCK_GOTO_LAST")
+;;; (CSTR "GTK_STOCK_GOTO_TOP")
+;;; (CSTR "GTK_STOCK_GO_BACK")
+;;; (CSTR "GTK_STOCK_GO_DOWN")
+;;; (CSTR "GTK_STOCK_GO_FORWARD")
+;;; (CSTR "GTK_STOCK_GO_UP")
+;;; (CSTR "GTK_STOCK_HARDDISK")
+;;; (CSTR "GTK_STOCK_HELP")
+;;; (CSTR "GTK_STOCK_HOME")
+;;; (CSTR "GTK_STOCK_INDEX")
+;;; (CSTR "GTK_STOCK_ITALIC")
+;;; (CSTR "GTK_STOCK_INDENT")
+;;; (CSTR "GTK_STOCK_UNINDENT")
+;;; (CSTR "GTK_STOCK_NETWORK")
+;;; (CSTR "GTK_STOCK_JUMP_TO")
+;;; (CSTR "GTK_STOCK_JUSTIFY_CENTER")
+;;; (CSTR "GTK_STOCK_JUSTIFY_FILL")
+;;; (CSTR "GTK_STOCK_JUSTIFY_LEFT")
+;;; (CSTR "GTK_STOCK_JUSTIFY_RIGHT")
+;;; (CSTR "GTK_STOCK_MISSING_IMAGE")
+;;; (CSTR "GTK_STOCK_NEW")
+;;; (CSTR "GTK_STOCK_NO")
+;;; (CSTR "GTK_STOCK_OK")
+;;; (CSTR "GTK_STOCK_OPEN")
+;;; (CSTR "GTK_STOCK_PASTE")
+;;; (CSTR "GTK_STOCK_PREFERENCES")
+;;; (CSTR "GTK_STOCK_PRINT")
+;;; (CSTR "GTK_STOCK_PRINT_PREVIEW")
+;;; (CSTR "GTK_STOCK_PROPERTIES")
+;;; (CSTR "GTK_STOCK_QUIT")
+;;; (CSTR "GTK_STOCK_REDO")
+;;; (CSTR "GTK_STOCK_REFRESH")
+;;; (CSTR "GTK_STOCK_REMOVE")
+;;; (CSTR "GTK_STOCK_REVERT_TO_SAVED")
+;;; (CSTR "GTK_STOCK_SAVE")
+;;; (CSTR "GTK_STOCK_SAVE_AS")
+;;; (CSTR "GTK_STOCK_SELECT_COLOR")
+;;; (CSTR "GTK_STOCK_SELECT_FONT")
+;;; (CSTR "GTK_STOCK_SORT_ASCENDING")
+;;; (CSTR "GTK_STOCK_SORT_DESCENDING")
+;;; (CSTR "GTK_STOCK_SPELL_CHECK")
+;;; (CSTR "GTK_STOCK_STOP")
+;;; (CSTR "GTK_STOCK_STRIKETHROUGH")
+;;; (CSTR "GTK_STOCK_UNDELETE")
+;;; (CSTR "GTK_STOCK_UNDERLINE")
+;;; (CSTR "GTK_STOCK_UNDO")
+;;; (CSTR "GTK_STOCK_YES")
+;;; (CSTR "GTK_STOCK_ZOOM_100")
+;;; (CSTR "GTK_STOCK_ZOOM_FIT")
+;;; (CSTR "GTK_STOCK_ZOOM_IN")
+;;; (CSTR "GTK_STOCK_ZOOM_OUT")
+;;;
+;;; ;(CSTR "GTK_STOCK_DIALOG_AUTHENTICATION")
+;;; (CSTR "GTK_STOCK_ABOUT")
+;;; (CSTR "GTK_STOCK_CONNECT")
+;;; (CSTR "GTK_STOCK_DIRECTORY")
+;;; (CSTR "GTK_STOCK_DISCONNECT")
+;;; (CSTR "GTK_STOCK_EDIT")
+;;; (CSTR "GTK_STOCK_FILE")
+;;; (CSTR "GTK_STOCK_MEDIA_FORWARD")
+;;; (CSTR "GTK_STOCK_MEDIA_NEXT")
+;;; (CSTR "GTK_STOCK_MEDIA_PAUSE")
+;;; (CSTR "GTK_STOCK_MEDIA_PLAY")
+;;; (CSTR "GTK_STOCK_MEDIA_PREVIOUS")
+;;; (CSTR "GTK_STOCK_MEDIA_RECORD")
+;;; (CSTR "GTK_STOCK_MEDIA_REWIND")
+;;; (CSTR "GTK_STOCK_MEDIA_STOP")
+;;;
+;;; (CSTR "GTK_STOCK_FULLSCREEN")
+;;; (CSTR "GTK_STOCK_INFO")
+;;; (CSTR "GTK_STOCK_LEAVE_FULLSCREEN")
+;;;
+;;; (CSTR "GTK_STOCK_ORIENTATION_PORTRAIT")
+;;; (CSTR "GTK_STOCK_ORIENTATION_LANDSCAPE")
+;;; (CSTR "GTK_STOCK_ORIENTATION_REVERSE_LANDSCAPE")
+;;; (CSTR "GTK_STOCK_SELECT_ALL")
+;;;
+;;; (CSTR "GTK_STOCK_ORIENTATION_REVERSE_PORTRAIT")
+
+;;; (CCAST-gtk2 "GTK_STYLE(object)" "GtkStyle*")
+;;; (CCHK-gtk2 "GTK_IS_STYLE(object)" "GtkStyle*")
+;;; ;(CCAST2-gtk2 "GTK_STYLE_ATTACHED(style)")
+;;; ;;;;(CFNC-gtk2 "GType gtk_style_get_type void")
+;;; (CFNC-gtk2 "GtkStyle* gtk_style_new void")
+;;; (CFNC-gtk2 "GtkStyle* gtk_style_copy GtkStyle* style")
+;;; (CFNC-gtk2 "GtkStyle* gtk_style_attach GtkStyle* style GdkWindow* window")
+;;; (CFNC-gtk2 "void gtk_style_detach GtkStyle* style")
+;;; (CFNC-gtk2 "void gtk_style_set_background GtkStyle* style GdkWindow* window GtkStateType state_type")
+;;; (CFNC-gtk2 "void gtk_style_apply_default_background GtkStyle* style GdkWindow* window gboolean set_bg GtkStateType state_type GdkRectangle* area gint x gint y gint width gint height")
+;;; ;;; (CFNC-gtk2 "GtkIconSet* gtk_style_lookup_icon_set GtkStyle* style gchar* stock_id")
+;;; ;;; (CFNC-gtk2 "GdkPixbuf* gtk_style_render_icon GtkStyle* style GtkIconSource* source GtkTextDirection direction GtkStateType state GtkIconSize size GtkWidget* widget gchar* detail")
+;;; ;(CFNC-gtk2 "void gtk_paint_hline GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail gint x1 gint x2 gint y")
+;;; ;(CFNC-gtk2 "void gtk_paint_vline GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail gint y1 gint y2 gint x")
+;;; ;(CFNC-gtk2 "void gtk_paint_shadow GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
;;;; 2.90.6 (CFNC "void gtk_paint_polygon GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail GdkPoint* points gint npoints gboolean fill")
-;(CFNC-gtk2 "void gtk_paint_arrow GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail GtkArrowType arrow_type gboolean fill gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_diamond GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_box GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_flat_box GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_check GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_option GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_tab GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_shadow_gap GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width")
-;(CFNC-gtk2 "void gtk_paint_box_gap GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width")
-;(CFNC-gtk2 "void gtk_paint_extension GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side")
-;(CFNC-gtk2 "void gtk_paint_focus GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_slider GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkOrientation orientation")
-;(CFNC-gtk2 "void gtk_paint_handle GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkOrientation orientation")
-;;(CFNC-gtk2 "void gtk_paint_expander GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y GtkExpanderStyle expander_style")
-;(CFNC-gtk2 "void gtk_paint_layout GtkStyle* style GdkWindow* window GtkStateType state_type gboolean use_text GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y PangoLayout* layout")
-;(CFNC-gtk2 "void gtk_paint_resize_grip GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail GdkWindowEdge edge gint x gint y gint width gint height")
-;;; (CFNC-gtk2 "GtkBorder* gtk_border_copy GtkBorder* border")
-;;; (CFNC-gtk2 "void gtk_border_free GtkBorder* border")
-(CCAST "GTK_TABLE(obj)" "GtkTable*")
-(CCHK "GTK_IS_TABLE(obj)" "GtkTable*")
-;;;;(CFNC "GType gtk_table_get_type void")
-(CFNC "GtkWidget* gtk_table_new guint rows guint columns gboolean homogeneous")
-(CFNC "void gtk_table_resize GtkTable* table guint rows guint columns")
-(CFNC "void gtk_table_attach GtkTable* table GtkWidget* child guint left_attach guint right_attach guint top_attach guint bottom_attach GtkAttachOptions xoptions GtkAttachOptions yoptions guint xpadding guint ypadding")
-(CFNC "void gtk_table_attach_defaults GtkTable* table GtkWidget* widget guint left_attach guint right_attach guint top_attach guint bottom_attach")
-(CFNC "void gtk_table_set_row_spacing GtkTable* table guint row guint spacing")
-(CFNC "guint gtk_table_get_row_spacing GtkTable* table guint row")
-(CFNC "void gtk_table_set_col_spacing GtkTable* table guint column guint spacing")
-(CFNC "guint gtk_table_get_col_spacing GtkTable* table guint column")
-(CFNC "void gtk_table_set_row_spacings GtkTable* table guint spacing")
-(CFNC "guint gtk_table_get_default_row_spacing GtkTable* table")
-(CFNC "void gtk_table_set_col_spacings GtkTable* table guint spacing")
-(CFNC "guint gtk_table_get_default_col_spacing GtkTable* table")
-(CFNC "void gtk_table_set_homogeneous GtkTable* table gboolean homogeneous")
-(CFNC "gboolean gtk_table_get_homogeneous GtkTable* table")
-(CCAST "GTK_TEAROFF_MENU_ITEM(obj)" "GtkTearoffMenuItem*")
-(CCHK "GTK_IS_TEAROFF_MENU_ITEM(obj)" "GtkTearoffMenuItem*")
-;;;;(CFNC "GType gtk_tearoff_menu_item_get_type void")
-(CFNC "GtkWidget* gtk_tearoff_menu_item_new void")
+;;; ;(CFNC-gtk2 "void gtk_paint_arrow GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail GtkArrowType arrow_type gboolean fill gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_diamond GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_box GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_flat_box GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_check GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_option GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_tab GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_shadow_gap GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width")
+;;; ;(CFNC-gtk2 "void gtk_paint_box_gap GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width")
+;;; ;(CFNC-gtk2 "void gtk_paint_extension GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side")
+;;; ;(CFNC-gtk2 "void gtk_paint_focus GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_slider GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkOrientation orientation")
+;;; ;(CFNC-gtk2 "void gtk_paint_handle GtkStyle* style GdkWindow* window GtkStateType state_type GtkShadowType shadow_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkOrientation orientation")
+;;; ;;(CFNC-gtk2 "void gtk_paint_expander GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y GtkExpanderStyle expander_style")
+;;; ;(CFNC-gtk2 "void gtk_paint_layout GtkStyle* style GdkWindow* window GtkStateType state_type gboolean use_text GdkRectangle* area GtkWidget* widget gchar* detail gint x gint y PangoLayout* layout")
+;;; ;(CFNC-gtk2 "void gtk_paint_resize_grip GtkStyle* style GdkWindow* window GtkStateType state_type GdkRectangle* area GtkWidget* widget gchar* detail GdkWindowEdge edge gint x gint y gint width gint height")
+;;; ;;; (CFNC-gtk2 "GtkBorder* gtk_border_copy GtkBorder* border")
+;;; ;;; (CFNC-gtk2 "void gtk_border_free GtkBorder* border")
+;;; 3.3.2 (CCAST "GTK_TABLE(obj)" "GtkTable*")
+;;; 3.3.2 (CCHK "GTK_IS_TABLE(obj)" "GtkTable*")
+;;; 3.3.2 ;;;;(CFNC "GType gtk_table_get_type void")
+;;; 3.3.2 (CFNC "GtkWidget* gtk_table_new guint rows guint columns gboolean homogeneous")
+;;; 3.3.2 (CFNC "void gtk_table_resize GtkTable* table guint rows guint columns")
+;;; 3.3.2 (CFNC "void gtk_table_attach GtkTable* table GtkWidget* child guint left_attach guint right_attach guint top_attach guint bottom_attach GtkAttachOptions xoptions GtkAttachOptions yoptions guint xpadding guint ypadding")
+;;; 3.3.2 (CFNC "void gtk_table_attach_defaults GtkTable* table GtkWidget* widget guint left_attach guint right_attach guint top_attach guint bottom_attach")
+;;; 3.3.2 (CFNC "void gtk_table_set_row_spacing GtkTable* table guint row guint spacing")
+;;; 3.3.2 (CFNC "guint gtk_table_get_row_spacing GtkTable* table guint row")
+;;; 3.3.2 (CFNC "void gtk_table_set_col_spacing GtkTable* table guint column guint spacing")
+;;; 3.3.2 (CFNC "guint gtk_table_get_col_spacing GtkTable* table guint column")
+;;; 3.3.2 (CFNC "void gtk_table_set_row_spacings GtkTable* table guint spacing")
+;;; 3.3.2 (CFNC "guint gtk_table_get_default_row_spacing GtkTable* table")
+;;; 3.3.2 (CFNC "void gtk_table_set_col_spacings GtkTable* table guint spacing")
+;;; 3.3.2 (CFNC "guint gtk_table_get_default_col_spacing GtkTable* table")
+;;; 3.3.2 (CFNC "void gtk_table_set_homogeneous GtkTable* table gboolean homogeneous")
+;;; 3.3.2 (CFNC "gboolean gtk_table_get_homogeneous GtkTable* table")
+;;; 3.3.2 (CCAST "GTK_TEAROFF_MENU_ITEM(obj)" "GtkTearoffMenuItem*")
+;;; 3.3.2 (CCHK "GTK_IS_TEAROFF_MENU_ITEM(obj)" "GtkTearoffMenuItem*")
+;;; 3.3.2 ;;;;(CFNC "GType gtk_tearoff_menu_item_get_type void")
+;;; 3.3.2 (CFNC "GtkWidget* gtk_tearoff_menu_item_new void")
(CCAST "GTK_TEXT_BUFFER(obj)" "GtkTextBuffer*")
(CCHK "GTK_IS_TEXT_BUFFER(obj)" "GtkTextBuffer*")
;;;;(CFNC "GType gtk_text_buffer_get_type void")
@@ -3051,7 +3128,7 @@
(CFNC "void gtk_text_buffer_apply_tag_by_name GtkTextBuffer* buffer gchar* name GtkTextIter* start GtkTextIter* end")
(CFNC "void gtk_text_buffer_remove_tag_by_name GtkTextBuffer* buffer gchar* name GtkTextIter* start GtkTextIter* end")
(CFNC "void gtk_text_buffer_remove_all_tags GtkTextBuffer* buffer GtkTextIter* start GtkTextIter* end")
-(CFNC-PA "GtkTextTag* gtk_text_buffer_create_tag GtkTextBuffer* buffer gchar* tag_name etc #tags" 0 6 '("gchar*" "int"))
+(CFNC-PA "GtkTextTag* gtk_text_buffer_create_tag GtkTextBuffer* buffer gchar* tag_name etc #tags" 0 6 '("gchar*" "any"))
(CFNC "void gtk_text_buffer_get_iter_at_line_offset GtkTextBuffer* buffer GtkTextIter* iter gint line_number gint char_offset")
(CFNC "void gtk_text_buffer_get_iter_at_line_index GtkTextBuffer* buffer GtkTextIter* iter gint line_number gint byte_index")
(CFNC "void gtk_text_buffer_get_iter_at_offset GtkTextBuffer* buffer GtkTextIter* iter gint char_offset")
@@ -3259,7 +3336,7 @@
;(CCHK "GTK_IS_THEME_ENGINE(theme_engine)" "GtkThemeEngine*")
;;;;;(CFNC "GType gtk_theme_engine_get_type void")
;(CFNC "GtkThemeEngine* gtk_theme_engine_get gchar* name")
-;(CFNC-gtk2 "GtkRcStyle* gtk_theme_engine_create_rc_style GtkThemeEngine* engine")
+;;; ;(CFNC-gtk2 "GtkRcStyle* gtk_theme_engine_create_rc_style GtkThemeEngine* engine")
(CCAST "GTK_TOGGLE_BUTTON(obj)" "GtkToggleButton*")
(CCHK "GTK_IS_TOGGLE_BUTTON(obj)" "GtkToggleButton*")
;;;;(CFNC "GType gtk_toggle_button_get_type void")
@@ -3306,7 +3383,7 @@
;;; out 2.3 (CFNC "void gtk_toolbar_unset_icon_size GtkToolbar* toolbar")
;;; out 2.15.0 (CFNC "GtkOrientation gtk_toolbar_get_orientation GtkToolbar* toolbar")
(CFNC "GtkToolbarStyle gtk_toolbar_get_style GtkToolbar* toolbar")
-(CFNC "GtkIconSize gtk_toolbar_get_icon_size GtkToolbar* toolbar")
+;;; (CFNC "GtkIconSize gtk_toolbar_get_icon_size GtkToolbar* toolbar")
;;; out 2.13.4 (CFNC "gboolean gtk_toolbar_get_tooltips GtkToolbar* toolbar")
;;; out 2.13.4 (CFNC "void gtk_toolbar_set_tooltips GtkToolbar* toolbar gboolean enable")
@@ -3529,8 +3606,8 @@
(CFNC "void gtk_tree_view_set_headers_visible GtkTreeView* tree_view gboolean headers_visible")
(CFNC "void gtk_tree_view_columns_autosize GtkTreeView* tree_view")
(CFNC "void gtk_tree_view_set_headers_clickable GtkTreeView* tree_view gboolean setting")
-(CFNC "void gtk_tree_view_set_rules_hint GtkTreeView* tree_view gboolean setting")
-(CFNC "gboolean gtk_tree_view_get_rules_hint GtkTreeView* tree_view")
+;;; 3.13.6 (CFNC "void gtk_tree_view_set_rules_hint GtkTreeView* tree_view gboolean setting")
+;;; 3.13.6 (CFNC "gboolean gtk_tree_view_get_rules_hint GtkTreeView* tree_view")
(CFNC "gint gtk_tree_view_append_column GtkTreeView* tree_view GtkTreeViewColumn* column")
(CFNC "gint gtk_tree_view_remove_column GtkTreeView* tree_view GtkTreeViewColumn* column")
(CFNC "gint gtk_tree_view_insert_column GtkTreeView* tree_view GtkTreeViewColumn* column gint position")
@@ -3569,7 +3646,7 @@
(CFNC "void gtk_tree_view_set_drag_dest_row GtkTreeView* tree_view GtkTreePath* path GtkTreeViewDropPosition pos")
(CFNC "void gtk_tree_view_get_drag_dest_row GtkTreeView* tree_view GtkTreePath** [path] GtkTreeViewDropPosition* [pos]")
(CFNC "gboolean gtk_tree_view_get_dest_row_at_pos GtkTreeView* tree_view gint drag_x gint drag_y GtkTreePath** [path] GtkTreeViewDropPosition* [pos]")
-(CFNC-gtk2 "GdkPixmap* gtk_tree_view_create_row_drag_icon GtkTreeView* tree_view GtkTreePath* path")
+;;; (CFNC-gtk2 "GdkPixmap* gtk_tree_view_create_row_drag_icon GtkTreeView* tree_view GtkTreePath* path")
(CFNC "void gtk_tree_view_set_enable_search GtkTreeView* tree_view gboolean enable_search")
(CFNC "gboolean gtk_tree_view_get_enable_search GtkTreeView* tree_view")
(CFNC "gint gtk_tree_view_get_search_column GtkTreeView* tree_view")
@@ -3593,10 +3670,10 @@
;(CFNC "GtkFlagValue* gtk_type_flags_get_values GType flags_type")
;(CFNC "GtkEnumValue* gtk_type_enum_find_value GType enum_type gchar* value_name")
;(CFNC "GtkFlagValue* gtk_type_flags_find_value GType flags_type gchar* value_name")
-(CCAST "GTK_VBUTTON_BOX(obj)" "GtkVButtonBox*")
-(CCHK "GTK_IS_VBUTTON_BOX(obj)" "GtkVButtonBox*")
-;;;;(CFNC "GType gtk_vbutton_box_get_type void")
-(CFNC "GtkWidget* gtk_vbutton_box_new void")
+;;; 3.1.6 (CCAST "GTK_VBUTTON_BOX(obj)" "GtkVButtonBox*")
+;;; 3.1.6 (CCHK "GTK_IS_VBUTTON_BOX(obj)" "GtkVButtonBox*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_vbutton_box_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_vbutton_box_new void")
;;;; (CINT "GTK_MAJOR_VERSION")
;;;; (CINT "GTK_MINOR_VERSION")
;;;; (CINT "GTK_MICRO_VERSION")
@@ -3612,27 +3689,27 @@
;;; 2.91.2 (CFNC "void gtk_viewport_set_vadjustment GtkViewport* viewport GtkAdjustment* @adjustment")
(CFNC "void gtk_viewport_set_shadow_type GtkViewport* viewport GtkShadowType type")
(CFNC "GtkShadowType gtk_viewport_get_shadow_type GtkViewport* viewport")
-(CCAST "GTK_VPANED(obj)" "GtkVPaned*")
-(CCHK "GTK_IS_VPANED(obj)" "GtkVPaned*")
-;;;;(CFNC "GType gtk_vpaned_get_type void")
-(CFNC "GtkWidget* gtk_vpaned_new void")
+;;; 3.1.6 (CCAST "GTK_VPANED(obj)" "GtkVPaned*")
+;;; 3.1.6 (CCHK "GTK_IS_VPANED(obj)" "GtkVPaned*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_vpaned_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_vpaned_new void")
;;; 2.91.5 (CCAST "GTK_VRULER(obj)" "GtkVRuler*")
;;; 2.91.5 (CCHK "GTK_IS_VRULER(obj)" "GtkVRuler*")
;;;;(CFNC "GType gtk_vruler_get_type void")
;;; 2.91.5 (CFNC "GtkWidget* gtk_vruler_new void")
-(CCAST "GTK_VSCALE(obj)" "GtkVScale*")
-(CCHK "GTK_IS_VSCALE(obj)" "GtkVScale*")
-;;;;(CFNC "GType gtk_vscale_get_type void")
-(CFNC "GtkWidget* gtk_vscale_new GtkAdjustment* @adjustment")
-(CFNC "GtkWidget* gtk_vscale_new_with_range gdouble min gdouble max gdouble step")
-(CCAST "GTK_VSCROLLBAR(obj)" "GtkVScrollbar*")
-(CCHK "GTK_IS_VSCROLLBAR(obj)" "GtkVScrollbar*")
-;;;;(CFNC "GType gtk_vscrollbar_get_type void")
-(CFNC "GtkWidget* gtk_vscrollbar_new GtkAdjustment* @adjustment")
-(CCAST "GTK_VSEPARATOR(obj)" "GtkVSeparator*")
-(CCHK "GTK_IS_VSEPARATOR(obj)" "GtkVSeparator*")
+;;; 3.1.6 (CCAST "GTK_VSCALE(obj)" "GtkVScale*")
+;;; 3.1.6 (CCHK "GTK_IS_VSCALE(obj)" "GtkVScale*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_vscale_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_vscale_new GtkAdjustment* @adjustment")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_vscale_new_with_range gdouble min gdouble max gdouble step")
+;;; 3.1.6 (CCAST "GTK_VSCROLLBAR(obj)" "GtkVScrollbar*")
+;;; 3.1.6 (CCHK "GTK_IS_VSCROLLBAR(obj)" "GtkVScrollbar*")
+;;; 3.1.6 ;;;;(CFNC "GType gtk_vscrollbar_get_type void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_vscrollbar_new GtkAdjustment* @adjustment")
+;;; 3.1.6 (CCAST "GTK_VSEPARATOR(obj)" "GtkVSeparator*")
+;;; 3.1.6 (CCHK "GTK_IS_VSEPARATOR(obj)" "GtkVSeparator*")
;;;;(CFNC "GType gtk_vseparator_get_type void")
-(CFNC "GtkWidget* gtk_vseparator_new void")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_vseparator_new void")
;;; all out 2.90.3 ?
@@ -3698,7 +3775,7 @@
(CFNC "void gtk_widget_show_now GtkWidget* widget")
(CFNC "void gtk_widget_hide GtkWidget* widget")
(CFNC "void gtk_widget_show_all GtkWidget* widget")
-(CFNC-gtk2 "void gtk_widget_hide_all GtkWidget* widget")
+;;; (CFNC-gtk2 "void gtk_widget_hide_all GtkWidget* widget")
(CFNC "void gtk_widget_map GtkWidget* widget")
(CFNC "void gtk_widget_unmap GtkWidget* widget")
(CFNC "void gtk_widget_realize GtkWidget* widget")
@@ -3706,9 +3783,9 @@
(CFNC "void gtk_widget_queue_draw GtkWidget* widget")
(CFNC "void gtk_widget_queue_draw_area GtkWidget* widget gint x gint y gint width gint height")
(CFNC "void gtk_widget_queue_resize GtkWidget* widget")
-(CFNC-gtk2 "void gtk_widget_size_request GtkWidget* widget GtkRequisition* requisition")
+;;; (CFNC-gtk2 "void gtk_widget_size_request GtkWidget* widget GtkRequisition* requisition")
(CFNC "void gtk_widget_size_allocate GtkWidget* widget GtkAllocation* allocation")
-(CFNC-gtk2 "void gtk_widget_get_child_requisition GtkWidget* widget GtkRequisition* requisition")
+;;; (CFNC-gtk2 "void gtk_widget_get_child_requisition GtkWidget* widget GtkRequisition* requisition")
(CFNC "void gtk_widget_add_accelerator GtkWidget* widget gchar* accel_signal GtkAccelGroup* accel_group guint accel_key GdkModifierType accel_mods GtkAccelFlags accel_flags")
(CFNC "gboolean gtk_widget_remove_accelerator GtkWidget* widget GtkAccelGroup* accel_group guint accel_key GdkModifierType accel_mods")
(CFNC "GList* gtk_widget_list_accel_closures GtkWidget* widget") ; FREE (g_list_free)
@@ -3717,9 +3794,9 @@
(CFNC "gint gtk_widget_send_expose GtkWidget* widget GdkEvent* event")
(CFNC "gboolean gtk_widget_activate GtkWidget* widget")
;;; 2.91.2 (CFNC "gboolean gtk_widget_set_scroll_adjustments GtkWidget* widget GtkAdjustment* @hadjustment GtkAdjustment* @vadjustment")
-(CFNC "void gtk_widget_reparent GtkWidget* widget GtkWidget* new_parent")
+;;; 3.13.2 (CFNC "void gtk_widget_reparent GtkWidget* widget GtkWidget* new_parent")
(CFNC "gboolean gtk_widget_intersect GtkWidget* widget GdkRectangle* area GdkRectangle* @intersection")
-;;; (CFNC "GdkRegion* gtk_widget_region_intersect GtkWidget* widget GdkRegion* region") ; FREE
+;;; 3.13.2 ;;; (CFNC "GdkRegion* gtk_widget_region_intersect GtkWidget* widget GdkRegion* region") ; FREE
(CFNC "void gtk_widget_freeze_child_notify GtkWidget* widget")
(CFNC "void gtk_widget_child_notify GtkWidget* widget gchar* child_property")
(CFNC "void gtk_widget_thaw_child_notify GtkWidget* widget")
@@ -3728,10 +3805,10 @@
(CFNC "void gtk_widget_grab_default GtkWidget* widget")
(CFNC "void gtk_widget_set_name GtkWidget* widget gchar* name")
(CFNC "gchar* gtk_widget_get_name GtkWidget* widget")
-(CFNC "void gtk_widget_set_state GtkWidget* widget GtkStateType state")
+;;; (CFNC "void gtk_widget_set_state GtkWidget* widget GtkStateType state")
(CFNC "void gtk_widget_set_sensitive GtkWidget* widget gboolean sensitive")
(CFNC "void gtk_widget_set_app_paintable GtkWidget* widget gboolean app_paintable")
-(CFNC "void gtk_widget_set_double_buffered GtkWidget* widget gboolean double_buffered")
+;;; 3.13.3 (CFNC "void gtk_widget_set_double_buffered GtkWidget* widget gboolean double_buffered")
(CFNC "void gtk_widget_set_redraw_on_allocate GtkWidget* widget gboolean redraw_on_allocate")
(CFNC "void gtk_widget_set_parent GtkWidget* widget GtkWidget* parent")
(CFNC "void gtk_widget_set_parent_window GtkWidget* widget GdkWindow* parent_window")
@@ -3749,57 +3826,57 @@
;;;; (CFNC "GdkExtensionMode gtk_widget_get_extension_events GtkWidget* widget")
(CFNC "GtkWidget* gtk_widget_get_toplevel GtkWidget* widget")
(CFNC "GtkWidget* gtk_widget_get_ancestor GtkWidget* widget GType widget_type")
-(CFNC-gtk2 "GdkColormap* gtk_widget_get_colormap GtkWidget* widget")
+;;; (CFNC-gtk2 "GdkColormap* gtk_widget_get_colormap GtkWidget* widget")
(CFNC "GdkVisual* gtk_widget_get_visual GtkWidget* widget")
-;(CFNC "GtkSettings* gtk_widget_get_settings GtkWidget* widget")
+(CFNC "GtkSettings* gtk_widget_get_settings GtkWidget* widget")
(CFNC "AtkObject* gtk_widget_get_accessible GtkWidget* widget")
-(CFNC-gtk2 "void gtk_widget_set_colormap GtkWidget* widget GdkColormap* colormap")
+;;; (CFNC-gtk2 "void gtk_widget_set_colormap GtkWidget* widget GdkColormap* colormap")
(CFNC "gint gtk_widget_get_events GtkWidget* widget")
-(CFNC "void gtk_widget_get_pointer GtkWidget* widget gint* [x] gint* [y]")
+;;; (CFNC-gtk2 "void gtk_widget_get_pointer GtkWidget* widget gint* [x] gint* [y]")
(CFNC "gboolean gtk_widget_is_ancestor GtkWidget* widget GtkWidget* ancestor")
(CFNC "gboolean gtk_widget_translate_coordinates GtkWidget* src_widget GtkWidget* dest_widget gint src_x gint src_y gint* [dest_x] gint* [dest_y]")
(CFNC "gboolean gtk_widget_hide_on_delete GtkWidget* widget")
-(CFNC-gtk2 "void gtk_widget_set_style GtkWidget* widget GtkStyle* @style")
-(CFNC-gtk2 "void gtk_widget_ensure_style GtkWidget* widget")
-(CFNC-gtk2 "GtkStyle* gtk_widget_get_style GtkWidget* widget")
-(CFNC-gtk2 "void gtk_widget_modify_style GtkWidget* widget GtkRcStyle* style")
-(CFNC-gtk2 "GtkRcStyle* gtk_widget_get_modifier_style GtkWidget* widget")
-(CFNC-gtk2 "void gtk_widget_modify_fg GtkWidget* widget GtkStateType state GdkColor* color")
-(CFNC-gtk2 "void gtk_widget_modify_bg GtkWidget* widget GtkStateType state GdkColor* color")
-(CFNC-gtk2 "void gtk_widget_modify_text GtkWidget* widget GtkStateType state GdkColor* color")
-(CFNC-gtk2 "void gtk_widget_modify_base GtkWidget* widget GtkStateType state GdkColor* color")
-(CFNC-gtk2 "void gtk_widget_modify_font GtkWidget* widget PangoFontDescription* font_desc")
+;;; (CFNC-gtk2 "void gtk_widget_set_style GtkWidget* widget GtkStyle* @style")
+;;; (CFNC-gtk2 "void gtk_widget_ensure_style GtkWidget* widget")
+;;; (CFNC-gtk2 "GtkStyle* gtk_widget_get_style GtkWidget* widget")
+;;; (CFNC-gtk2 "void gtk_widget_modify_style GtkWidget* widget GtkRcStyle* style")
+;;; (CFNC-gtk2 "GtkRcStyle* gtk_widget_get_modifier_style GtkWidget* widget")
+;;; (CFNC-gtk2 "void gtk_widget_modify_fg GtkWidget* widget GtkStateType state GdkColor* color")
+;;; (CFNC-gtk2 "void gtk_widget_modify_bg GtkWidget* widget GtkStateType state GdkColor* color")
+;;; (CFNC-gtk2 "void gtk_widget_modify_text GtkWidget* widget GtkStateType state GdkColor* color")
+;;; (CFNC-gtk2 "void gtk_widget_modify_base GtkWidget* widget GtkStateType state GdkColor* color")
+;;; (CFNC-gtk2 "void gtk_widget_modify_font GtkWidget* widget PangoFontDescription* font_desc")
(CFNC "PangoContext* gtk_widget_create_pango_context GtkWidget* widget")
(CFNC "PangoContext* gtk_widget_get_pango_context GtkWidget* widget")
(CFNC "PangoLayout* gtk_widget_create_pango_layout GtkWidget* widget gchar* text")
-(CFNC-gtk2 "GdkPixbuf* gtk_widget_render_icon GtkWidget* widget gchar* stock_id GtkIconSize size gchar* detail")
-(CFNC "void gtk_widget_set_composite_name GtkWidget* widget gchar* name")
-(CFNC "gchar* gtk_widget_get_composite_name GtkWidget* widget")
-(CFNC-gtk2 "void gtk_widget_reset_rc_styles GtkWidget* widget")
-(CFNC-gtk2 "void gtk_widget_push_colormap GdkColormap* cmap")
-(CFNC "void gtk_widget_push_composite_child void")
-(CFNC "void gtk_widget_pop_composite_child void")
-(CFNC-gtk2 "void gtk_widget_pop_colormap void")
+;;; ;;; (CFNC-gtk2 "GdkPixbuf* gtk_widget_render_icon GtkWidget* widget gchar* stock_id GtkIconSize size gchar* detail")
+;;; 3.9.0 (CFNC "void gtk_widget_set_composite_name GtkWidget* widget gchar* name")
+;;; 3.9.0 (CFNC "gchar* gtk_widget_get_composite_name GtkWidget* widget")
+;;; (CFNC-gtk2 "void gtk_widget_reset_rc_styles GtkWidget* widget")
+;;; (CFNC-gtk2 "void gtk_widget_push_colormap GdkColormap* cmap")
+;;; 3.9.0 (CFNC "void gtk_widget_push_composite_child void")
+;;; 3.9.0 (CFNC "void gtk_widget_pop_composite_child void")
+;;; (CFNC-gtk2 "void gtk_widget_pop_colormap void")
;(CFNC "void gtk_widget_class_install_style_property GtkWidgetClass* klass GParamSpec* pspec")
;(CFNC "void gtk_widget_class_install_style_property_parser GtkWidgetClass* klass GParamSpec* pspec GtkRcPropertyParser parser")
;(CFNC "void gtk_widget_style_get_property GtkWidget* widget gchar* property_name GValue* value")
;;;;(CFNC "void gtk_widget_style_get_valist GtkWidget* widget gchar* first_property_name va_list var_args")
;;; (CFNC "void gtk_widget_style_get GtkWidget* widget gchar* first_property_name ...")
;;; gtype vals
-(CFNC-gtk2 "void gtk_widget_set_default_colormap GdkColormap* colormap")
-(CFNC-gtk2 "GtkStyle* gtk_widget_get_default_style void")
-(CFNC-gtk2 "GdkColormap* gtk_widget_get_default_colormap void")
-(CFNC-gtk2 "GdkVisual* gtk_widget_get_default_visual void")
+;;; (CFNC-gtk2 "void gtk_widget_set_default_colormap GdkColormap* colormap")
+;;; (CFNC-gtk2 "GtkStyle* gtk_widget_get_default_style void")
+;;; (CFNC-gtk2 "GdkColormap* gtk_widget_get_default_colormap void")
+;;; (CFNC-gtk2 "GdkVisual* gtk_widget_get_default_visual void")
(CFNC "void gtk_widget_set_direction GtkWidget* widget GtkTextDirection dir")
(CFNC "GtkTextDirection gtk_widget_get_direction GtkWidget* widget")
(CFNC "void gtk_widget_set_default_direction GtkTextDirection dir")
(CFNC "GtkTextDirection gtk_widget_get_default_direction void")
-(CFNC-gtk2 "void gtk_widget_shape_combine_mask GtkWidget* widget GdkBitmap* @shape_mask gint offset_x gint offset_y")
-(CFNC-gtk2 "void gtk_widget_reset_shapes GtkWidget* widget")
-;;; (CFNC-gtk2 "void gtk_widget_path GtkWidget* widget guint* path_length gchar** [path] gchar** [path_reversed]")
-;;; (CFNC-gtk2 "void gtk_widget_class_path GtkWidget* widget guint* path_length gchar** [path] gchar** [path_reversed]")
-(CFNC-gtk2 "GtkRequisition* gtk_requisition_copy GtkRequisition* requisition")
-(CFNC-gtk2 "void gtk_requisition_free GtkRequisition* requisition")
+;;; (CFNC-gtk2 "void gtk_widget_shape_combine_mask GtkWidget* widget GdkBitmap* @shape_mask gint offset_x gint offset_y")
+;;; (CFNC-gtk2 "void gtk_widget_reset_shapes GtkWidget* widget")
+;;; ;;; (CFNC-gtk2 "void gtk_widget_path GtkWidget* widget guint* path_length gchar** [path] gchar** [path_reversed]")
+;;; ;;; (CFNC-gtk2 "void gtk_widget_class_path GtkWidget* widget guint* path_length gchar** [path] gchar** [path_reversed]")
+;;; (CFNC-gtk2 "GtkRequisition* gtk_requisition_copy GtkRequisition* requisition")
+;;; (CFNC-gtk2 "void gtk_requisition_free GtkRequisition* requisition")
;;;(CFNC "GtkWidgetAuxInfo* _gtk_widget_get_aux_info GtkWidget* widget gboolean create")
;(CFNC "void gtk_decorated_window_init GtkWindow* window")
;(CFNC "void gtk_decorated_window_calculate_frame_size GtkWindow* window")
@@ -3837,10 +3914,10 @@
(CFNC "void gtk_window_set_gravity GtkWindow* window GdkGravity gravity")
(CFNC "GdkGravity gtk_window_get_gravity GtkWindow* window")
(CFNC "void gtk_window_set_geometry_hints GtkWindow* window GtkWidget* geometry_widget GdkGeometry* geometry GdkWindowHints geom_mask")
-(CFNC-gtk2 "void gtk_window_set_has_frame GtkWindow* window gboolean setting")
-(CFNC-gtk2 "gboolean gtk_window_get_has_frame GtkWindow* window")
-(CFNC-gtk2 "void gtk_window_set_frame_dimensions GtkWindow* window gint left gint top gint right gint bottom")
-(CFNC-gtk2 "void gtk_window_get_frame_dimensions GtkWindow* window gint* [left] gint* [top] gint* [right] gint* [bottom]")
+;;; (CFNC-gtk2 "void gtk_window_set_has_frame GtkWindow* window gboolean setting")
+;;; (CFNC-gtk2 "gboolean gtk_window_get_has_frame GtkWindow* window")
+;;; (CFNC-gtk2 "void gtk_window_set_frame_dimensions GtkWindow* window gint left gint top gint right gint bottom")
+;;; (CFNC-gtk2 "void gtk_window_get_frame_dimensions GtkWindow* window gint* [left] gint* [top] gint* [right] gint* [bottom]")
(CFNC "void gtk_window_set_decorated GtkWindow* window gboolean setting")
(CFNC "gboolean gtk_window_get_decorated GtkWindow* window")
(CFNC "void gtk_window_set_icon_list GtkWindow* window GList* @list")
@@ -3873,10 +3950,10 @@
(CFNC "void gtk_window_move GtkWindow* window gint x gint y")
(CFNC "void gtk_window_get_position GtkWindow* window gint* [root_x] gint* [root_y]")
(CFNC "gboolean gtk_window_parse_geometry GtkWindow* window gchar* geometry")
-(CFNC "void gtk_window_reshow_with_initial_size GtkWindow* window")
+;;; (CFNC "void gtk_window_reshow_with_initial_size GtkWindow* window")
-(CFNC-gtk2 "void gtk_window_remove_embedded_xid GtkWindow* window guint xid")
-(CFNC-gtk2 "void gtk_window_add_embedded_xid GtkWindow* window guint xid")
+;;; (CFNC-gtk2 "void gtk_window_remove_embedded_xid GtkWindow* window guint xid")
+;;; (CFNC-gtk2 "void gtk_window_add_embedded_xid GtkWindow* window guint xid")
;;;;(CFNC "GType pango_color_get_type void")
(CFNC "PangoColor* pango_color_copy PangoColor* src")
@@ -4293,7 +4370,7 @@
;;; 2.91.6 (CLNG "GTK_TYPE_TREE_VIEW_COLUMN")
;;; 2.91.6 (CLNG "GTK_TYPE_TREE_VIEW")
;;; 2.91.6 (CLNG "GTK_TYPE_VBUTTON_BOX")
-;;; 2.91.6 (CLNG "GTK_TYPE_VBOX")
+;;; 3.1.6 ;;; 2.91.6 (CLNG "GTK_TYPE_VBOX")
;;; 2.91.6 (CLNG "GTK_TYPE_VIEWPORT")
;;; 2.91.6 (CLNG "GTK_TYPE_VPANED")
;;; 2.91.6 ;;; 2.91.5 (CLNG "GTK_TYPE_VRULER")
@@ -4367,6 +4444,8 @@
(CFNC "GType G_OBJECT_TYPE GObject* object")
(CCHK "G_IS_OBJECT(object)" "GObject*")
+#|
+;;; where are these used? gtk_binding_entry_add_signal, but that is commented out
(CLNG "G_TYPE_IO_CONDITION")
;(CLNG "G_TYPE_FUNDAMENTAL(type)")
;(CLNG "G_TYPE_FUNDAMENTAL_MAX")
@@ -4391,132 +4470,8 @@
(CLNG "G_TYPE_BOXED")
(CLNG "G_TYPE_PARAM")
(CLNG "G_TYPE_OBJECT")
-
-#|
-(CLNG "G_UNICODE_CONTROL")
-(CLNG "G_UNICODE_FORMAT")
-(CLNG "G_UNICODE_UNASSIGNED")
-(CLNG "G_UNICODE_PRIVATE_USE")
-(CLNG "G_UNICODE_SURROGATE")
-(CLNG "G_UNICODE_LOWERCASE_LETTER")
-(CLNG "G_UNICODE_MODIFIER_LETTER")
-(CLNG "G_UNICODE_OTHER_LETTER")
-(CLNG "G_UNICODE_TITLECASE_LETTER")
-(CLNG "G_UNICODE_UPPERCASE_LETTER")
-(CLNG "G_UNICODE_COMBINING_MARK")
-(CLNG "G_UNICODE_ENCLOSING_MARK")
-(CLNG "G_UNICODE_NON_SPACING_MARK")
-(CLNG "G_UNICODE_DECIMAL_NUMBER")
-(CLNG "G_UNICODE_LETTER_NUMBER")
-(CLNG "G_UNICODE_OTHER_NUMBER")
-(CLNG "G_UNICODE_CONNECT_PUNCTUATION")
-(CLNG "G_UNICODE_DASH_PUNCTUATION")
-(CLNG "G_UNICODE_CLOSE_PUNCTUATION")
-(CLNG "G_UNICODE_FINAL_PUNCTUATION")
-(CLNG "G_UNICODE_INITIAL_PUNCTUATION")
-(CLNG "G_UNICODE_OTHER_PUNCTUATION")
-(CLNG "G_UNICODE_OPEN_PUNCTUATION")
-(CLNG "G_UNICODE_CURRENCY_SYMBOL")
-(CLNG "G_UNICODE_MODIFIER_SYMBOL")
-(CLNG "G_UNICODE_MATH_SYMBOL")
-(CLNG "G_UNICODE_OTHER_SYMBOL")
-(CLNG "G_UNICODE_LINE_SEPARATOR")
-(CLNG "G_UNICODE_PARAGRAPH_SEPARATOR")
-(CLNG "G_UNICODE_SPACE_SEPARATOR")
-(CLNG "G_UNICODE_BREAK_MANDATORY")
-(CLNG "G_UNICODE_BREAK_CARRIAGE_RETURN")
-(CLNG "G_UNICODE_BREAK_LINE_FEED")
-(CLNG "G_UNICODE_BREAK_COMBINING_MARK")
-(CLNG "G_UNICODE_BREAK_SURROGATE")
-(CLNG "G_UNICODE_BREAK_ZERO_WIDTH_SPACE")
-(CLNG "G_UNICODE_BREAK_INSEPARABLE")
-(CLNG "G_UNICODE_BREAK_NON_BREAKING_GLUE")
-(CLNG "G_UNICODE_BREAK_CONTINGENT")
-(CLNG "G_UNICODE_BREAK_SPACE")
-(CLNG "G_UNICODE_BREAK_AFTER")
-(CLNG "G_UNICODE_BREAK_BEFORE")
-(CLNG "G_UNICODE_BREAK_BEFORE_AND_AFTER")
-(CLNG "G_UNICODE_BREAK_HYPHEN")
-(CLNG "G_UNICODE_BREAK_NON_STARTER")
-(CLNG "G_UNICODE_BREAK_OPEN_PUNCTUATION")
-(CLNG "G_UNICODE_BREAK_CLOSE_PUNCTUATION")
-(CLNG "G_UNICODE_BREAK_QUOTATION")
-(CLNG "G_UNICODE_BREAK_EXCLAMATION")
-(CLNG "G_UNICODE_BREAK_IDEOGRAPHIC")
-(CLNG "G_UNICODE_BREAK_NUMERIC")
-(CLNG "G_UNICODE_BREAK_INFIX_SEPARATOR")
-(CLNG "G_UNICODE_BREAK_SYMBOL")
-(CLNG "G_UNICODE_BREAK_ALPHABETIC")
-(CLNG "G_UNICODE_BREAK_PREFIX")
-(CLNG "G_UNICODE_BREAK_POSTFIX")
-(CLNG "G_UNICODE_BREAK_COMPLEX_CONTEXT")
-(CLNG "G_UNICODE_BREAK_AMBIGUOUS")
-(CLNG "G_UNICODE_BREAK_UNKNOWN")
-(CINT "G_NORMALIZE_DEFAULT")
-(CINT "G_NORMALIZE_NFD")
-(CINT "G_NORMALIZE_DEFAULT_COMPOSE")
-(CINT "G_NORMALIZE_NFC")
-(CINT "G_NORMALIZE_ALL")
-(CINT "G_NORMALIZE_NFKD")
-(CINT "G_NORMALIZE_ALL_COMPOSE")
-(CINT "G_NORMALIZE_NFKC")
-
-(CFNC "gboolean g_get_charset char** charset")
-(CFNC "gboolean g_unichar_isalnum gunichar c")
-(CFNC "gboolean g_unichar_isalpha gunichar c")
-(CFNC "gboolean g_unichar_iscntrl gunichar c")
-(CFNC "gboolean g_unichar_isdigit gunichar c")
-(CFNC "gboolean g_unichar_isgraph gunichar c")
-(CFNC "gboolean g_unichar_islower gunichar c")
-(CFNC "gboolean g_unichar_isprint gunichar c")
-(CFNC "gboolean g_unichar_ispunct gunichar c")
-(CFNC "gboolean g_unichar_isspace gunichar c")
-(CFNC "gboolean g_unichar_isupper gunichar c")
-(CFNC "gboolean g_unichar_isxdigit gunichar c")
-(CFNC "gboolean g_unichar_istitle gunichar c")
-(CFNC "gboolean g_unichar_isdefined gunichar c")
-(CFNC "gboolean g_unichar_iswide gunichar c")
-(CFNC "gunichar g_unichar_toupper gunichar c")
-(CFNC "gunichar g_unichar_tolower gunichar c")
-(CFNC "gunichar g_unichar_totitle gunichar c")
-(CFNC "gint g_unichar_digit_value gunichar c")
-(CFNC "gint g_unichar_xdigit_value gunichar c")
-(CFNC "GUnicodeType g_unichar_type gunichar c")
-(CFNC "GUnicodeBreakType g_unichar_break_type gunichar c")
-(CFNC "void g_unicode_canonical_ordering gunichar* string gsize len")
-(CFNC "gunichar* g_unicode_canonical_decomposition gunichar ch gsize* result_len")
-(CFNC "gchar* g_utf8_next_char gchar* p") ;??
-(CFNC "gunichar g_utf8_get_char gchar* p")
-(CFNC "gunichar g_utf8_get_char_validated gchar* p gssize max_len")
-(CFNC "gchar* g_utf8_offset_to_pointer gchar* str glong offset")
-(CFNC "glong g_utf8_pointer_to_offset gchar* str gchar* pos")
-(CFNC "gchar* g_utf8_prev_char gchar* p")
-(CFNC "gchar* g_utf8_find_next_char gchar* p gchar* end")
-(CFNC "gchar* g_utf8_find_prev_char gchar* str gchar* p")
-(CFNC "glong g_utf8_strlen gchar* p gssize max")
-(CFNC "gchar* g_utf8_strncpy gchar* dest gchar* src gsize n")
-(CFNC "gchar* g_utf8_strchr gchar* p gssize len gunichar c")
-(CFNC "gchar* g_utf8_strrchr gchar* p gssize len gunichar c")
-(CFNC "gunichar2* g_utf8_to_utf16 gchar* str glong len glong* [items_read] glong* [items_written] GError** [error]")
-(CFNC "gunichar* g_utf8_to_ucs4 gchar* str glong len glong* [items_read] glong* [items_written] GError** [error]")
-(CFNC "gunichar* g_utf8_to_ucs4_fast gchar* str glong len glong* [items_written]")
-(CFNC "gunichar* g_utf16_to_ucs4 gunichar2* str glong len glong* [items_read] glong* [items_written] GError** [error]")
-(CFNC "gchar* g_utf16_to_utf8 gunichar2* str glong len glong* [items_read] glong* [items_written] GError** [error]")
-(CFNC "gunichar2* g_ucs4_to_utf16 gunichar* str glong len glong* [items_read] glong* [items_written] GError** [error]")
-(CFNC "gchar* g_ucs4_to_utf8 gunichar* str glong len glong* [items_read] glong* [items_written] GError** [error]")
-(CFNC "gint g_unichar_to_utf8 gunichar c gchar* outbuf")
-(CFNC "gboolean g_unichar_validate gunichar ch")
-(CFNC "gchar* g_utf8_strup gchar* str gssize len")
-(CFNC "gchar* g_utf8_strdown gchar* str gssize len")
-(CFNC "gchar* g_utf8_casefold gchar* str gssize len")
-(CFNC "gchar* g_utf8_normalize gchar* str gssize len GNormalizeMode mode")
-(CFNC "gint g_utf8_collate gchar* str1 gchar* str2")
-(CFNC "gchar* g_utf8_collate_key gchar* str gssize len")
|#
-(CFNC "gboolean g_utf8_validate gchar* str gssize max_len gchar** [end]" 'const)
-;;; and gobject/gtype.h type creation functions
-
;;; 2.90.6 (CFNC "void gdk_draw_pixbuf GdkDrawable* drawable GdkGC* gc GdkPixbuf* pixbuf int src_x int src_y int dest_x int dest_y int width int height GdkRgbDither dither int x_dither int y_dither")
(CFNC "gchar* gtk_tree_model_get_string_from_iter GtkTreeModel* tree_model GtkTreeIter* iter" 'free)
@@ -4537,7 +4492,7 @@
;;;;(CFNC "GType gdk_display_get_type void")
(CFNC "GdkDisplay* gdk_display_open gchar* display_name")
(CFNC "gchar* gdk_display_get_name GdkDisplay* display")
-(CFNC "int gdk_display_get_n_screens GdkDisplay* display")
+;;; 3.9.0 (CFNC "int gdk_display_get_n_screens GdkDisplay* display")
(CFNC "GdkScreen* gdk_display_get_screen GdkDisplay* display int screen_num")
(CFNC "GdkScreen* gdk_display_get_default_screen GdkDisplay* display")
;;; 2.99.0 (CFNC "void gdk_display_pointer_ungrab GdkDisplay* display guint32 time")
@@ -4558,9 +4513,9 @@
;;; 2.99.0 (CFNC "GdkWindow* gdk_display_get_window_at_pointer GdkDisplay* display int* [win_x] int* [win_y]")
;;; 2.99.0 (CFNC "GdkDisplayPointerHooks* gdk_display_set_pointer_hooks GdkDisplay* display GdkDisplayPointerHooks* new_hooks")
;;;;(CFNC "GType gdk_screen_get_type void")
-(CFNC-gtk2 "GdkColormap* gdk_screen_get_default_colormap GdkScreen* screen")
-(CFNC-gtk2 "void gdk_screen_set_default_colormap GdkScreen* screen GdkColormap* colormap")
-(CFNC-gtk2 "GdkColormap* gdk_screen_get_system_colormap GdkScreen* screen")
+;;; (CFNC-gtk2 "GdkColormap* gdk_screen_get_default_colormap GdkScreen* screen")
+;;; (CFNC-gtk2 "void gdk_screen_set_default_colormap GdkScreen* screen GdkColormap* colormap")
+;;; (CFNC-gtk2 "GdkColormap* gdk_screen_get_system_colormap GdkScreen* screen")
(CFNC "GdkVisual* gdk_screen_get_system_visual GdkScreen* screen")
;;; 2.90.6 (CFNC "GdkColormap* gdk_screen_get_rgb_colormap GdkScreen* screen")
;;; 2.90.6 (CFNC "GdkVisual* gdk_screen_get_rgb_visual GdkScreen* screen")
@@ -4600,7 +4555,7 @@
(CFNC "GdkScreen* gtk_widget_get_screen GtkWidget* widget")
(CFNC "gboolean gtk_widget_has_screen GtkWidget* widget")
(CFNC "GdkDisplay* gtk_widget_get_display GtkWidget* widget")
-(CFNC "GdkWindow* gtk_widget_get_root_window GtkWidget* widget")
+;;; 3.11.5 (CFNC "GdkWindow* gtk_widget_get_root_window GtkWidget* widget")
(CFNC "GtkClipboard* gtk_widget_get_clipboard GtkWidget* widget GdkAtom selection")
;;; -------- end gtk 2.1 additions
@@ -4651,11 +4606,11 @@
(CFNC "void gdk_display_get_maximal_cursor_size GdkDisplay* display guint* [width] guint* [height]")
(CFNC "void gdk_window_set_keep_above GdkWindow* window gboolean setting")
(CFNC "void gdk_window_set_keep_below GdkWindow* window gboolean setting")
-(CFNC "void gtk_alignment_set_padding GtkAlignment* alignment guint padding_top guint padding_bottom guint padding_left guint padding_right")
-(CFNC "void gtk_alignment_get_padding GtkAlignment* alignment guint* [padding_top] guint* [padding_bottom] guint* [padding_left] guint* [padding_right]")
+;;; (CFNC "void gtk_alignment_set_padding GtkAlignment* alignment guint padding_top guint padding_bottom guint padding_left guint padding_right")
+;;; (CFNC "void gtk_alignment_get_padding GtkAlignment* alignment guint* [padding_top] guint* [padding_bottom] guint* [padding_left] guint* [padding_right]")
(CFNC "gboolean gtk_button_box_get_child_secondary GtkButtonBox* widget GtkWidget* child")
-(CFNC "void gtk_button_set_focus_on_click GtkButton* button gboolean focus_on_click")
-(CFNC "gboolean gtk_button_get_focus_on_click GtkButton* button")
+;;; 3.19.2 (CFNC "void gtk_button_set_focus_on_click GtkButton* button gboolean focus_on_click")
+;;; 3.19.2 (CFNC "gboolean gtk_button_get_focus_on_click GtkButton* button")
(CFNC "void gtk_calendar_set_display_options GtkCalendar* calendar GtkCalendarDisplayOptions flags")
(CFNC "GtkCalendarDisplayOptions gtk_calendar_get_display_options GtkCalendar* calendar")
(CFNC "void gtk_check_menu_item_set_draw_as_radio GtkCheckMenuItem* check_menu_item gboolean draw_as_radio")
@@ -4667,7 +4622,7 @@
(CFNC "gboolean gtk_event_box_get_above_child GtkEventBox* event_box")
(CFNC "void gtk_event_box_set_above_child GtkEventBox* event_box gboolean above_child")
;;; (CFNC "void gtk_icon_source_set_icon_name GtkIconSource* source gchar* icon_name")
-(CFNC "gchar* gtk_icon_source_get_icon_name GtkIconSource* source") ;const return
+;;; (CFNC "gchar* gtk_icon_source_get_icon_name GtkIconSource* source") ;const return
(CFNC "void gtk_menu_attach GtkMenu* menu GtkWidget* child guint left_attach guint right_attach guint top_attach guint bottom_attach")
(CFNC "void gtk_text_buffer_select_range GtkTextBuffer* buffer GtkTextIter* ins GtkTextIter* bound")
(CFNC "void gtk_text_view_set_overwrite GtkTextView* text_view gboolean overwrite")
@@ -4738,10 +4693,10 @@
(CCHK "GTK_IS_FILE_CHOOSER_WIDGET(obj)" "GtkFileChooserWidget*")
(CCAST "GTK_TREE_MODEL_FILTER(obj)" "GtkTreeModelFilter*")
(CCHK "GTK_IS_TREE_MODEL_FILTER(obj)" "GtkTreeModelFilter*")
-(CCAST "GTK_ACTION(obj)" "GtkAction*")
-(CCHK "GTK_IS_ACTION(obj)" "GtkAction*")
-(CCAST "GTK_ACTION_GROUP(obj)" "GtkActionGroup*")
-(CCHK "GTK_IS_ACTION_GROUP(obj)" "GtkActionGroup*")
+;;; 3.9.8 (CCAST "GTK_ACTION(obj)" "GtkAction*")
+;;; (CCHK "GTK_IS_ACTION(obj)" "GtkAction*")
+;;; (CCAST "GTK_ACTION_GROUP(obj)" "GtkActionGroup*")
+;;; (CCHK "GTK_IS_ACTION_GROUP(obj)" "GtkActionGroup*")
(CCAST "GTK_COMBO_BOX(obj)" "GtkComboBox*")
(CCHK "GTK_IS_COMBO_BOX(obj)" "GtkComboBox*")
;;; 2.91.1 (CCAST "GTK_COMBO_BOX_ENTRY(obj)" "GtkComboBoxEntry*")
@@ -4758,12 +4713,12 @@
;(CCHK "GTK_IS_UI_MANAGER(obj)" "GtkUIManager*")
(CCAST "GTK_RADIO_TOOL_BUTTON(obj)" "GtkRadioToolButton*")
(CCHK "GTK_IS_RADIO_TOOL_BUTTON(obj)" "GtkRadioToolButton*")
-(CCAST "GTK_RADIO_ACTION(obj)" "GtkRadioAction*")
-(CCHK "GTK_IS_RADIO_ACTION(obj)" "GtkRadioAction*")
+;;; (CCAST "GTK_RADIO_ACTION(obj)" "GtkRadioAction*")
+;;; (CCHK "GTK_IS_RADIO_ACTION(obj)" "GtkRadioAction*")
(CCAST "GTK_SEPARATOR_TOOL_ITEM(obj)" "GtkSeparatorToolItem*")
(CCHK "GTK_IS_SEPARATOR_TOOL_ITEM(obj)" "GtkSeparatorToolItem*")
-(CCAST "GTK_TOGGLE_ACTION(obj)" "GtkToggleAction*")
-(CCHK "GTK_IS_TOGGLE_ACTION(obj)" "GtkToggleAction*")
+;;; (CCAST "GTK_TOGGLE_ACTION(obj)" "GtkToggleAction*")
+;;; (CCHK "GTK_IS_TOGGLE_ACTION(obj)" "GtkToggleAction*")
(CCAST "GTK_TOGGLE_TOOL_BUTTON(obj)" "GtkToggleToolButton*")
(CCHK "GTK_IS_TOGGLE_TOOL_BUTTON(obj)" "GtkToggleToolButton*")
(CCAST "GTK_FILE_FILTER(obj)" "GtkFileFilter*")
@@ -4781,6 +4736,7 @@
(CCAST "GTK_TOOL_ITEM(o)" "GtkToolItem*")
(CCHK "GTK_IS_TOOL_ITEM(o)" "GtkToolItem*")
+;;; out 3.9.8
;(CINT "GTK_UI_MANAGER_AUTO" "GtkUIManagerItemType")
;(CINT "GTK_UI_MANAGER_MENUBAR" "GtkUIManagerItemType")
;(CINT "GTK_UI_MANAGER_MENU" "GtkUIManagerItemType")
@@ -4823,32 +4779,35 @@
(CFNC "GtkTreePath* gtk_tree_model_filter_convert_path_to_child_path GtkTreeModelFilter* path GtkTreePath* filter_path") ; FREE
(CFNC "void gtk_tree_model_filter_refilter GtkTreeModelFilter* filter")
(CFNC "void gtk_tree_model_filter_clear_cache GtkTreeModelFilter* filter")
+
+;;; 3.9.8
;;;;(CFNC "GType gtk_action_get_type void")
-(CFNC "gchar* gtk_action_get_name GtkAction* action")
-(CFNC "void gtk_action_activate GtkAction* action")
-(CFNC "GtkWidget* gtk_action_create_icon GtkAction* action GtkIconSize icon_size")
-(CFNC "GtkWidget* gtk_action_create_menu_item GtkAction* action")
-(CFNC "GtkWidget* gtk_action_create_tool_item GtkAction* action")
+;;; (CFNC "gchar* gtk_action_get_name GtkAction* action")
+;;; (CFNC "void gtk_action_activate GtkAction* action")
+;;; (CFNC "GtkWidget* gtk_action_create_icon GtkAction* action GtkIconSize icon_size")
+;;; (CFNC "GtkWidget* gtk_action_create_menu_item GtkAction* action")
+;;; (CFNC "GtkWidget* gtk_action_create_tool_item GtkAction* action")
;;; out 2.15.1 (CFNC "void gtk_action_connect_proxy GtkAction* action GtkWidget* proxy")
;;; (CFNC "void gtk_action_disconnect_proxy GtkAction* action GtkWidget* proxy")
-(CFNC "GSList* gtk_action_get_proxies GtkAction* action")
-(CFNC "void gtk_action_connect_accelerator GtkAction* action")
-(CFNC "void gtk_action_disconnect_accelerator GtkAction* action")
+;;; (CFNC "GSList* gtk_action_get_proxies GtkAction* action")
+;;; (CFNC "void gtk_action_connect_accelerator GtkAction* action")
+;;; (CFNC "void gtk_action_disconnect_accelerator GtkAction* action")
;;;;(CFNC "GType gtk_action_group_get_type void")
-(CFNC "GtkActionGroup* gtk_action_group_new gchar* name")
-(CFNC "gchar* gtk_action_group_get_name GtkActionGroup* action_group")
-(CFNC "GtkAction* gtk_action_group_get_action GtkActionGroup* action_group gchar* action_name")
-(CFNC "GList* gtk_action_group_list_actions GtkActionGroup* action_group")
-(CFNC "void gtk_action_group_add_action GtkActionGroup* action_group GtkAction* action")
-(CFNC "void gtk_action_group_remove_action GtkActionGroup* action_group GtkAction* action")
-(CFNC "void gtk_action_group_add_actions GtkActionGroup* action_group GtkActionEntry* entries guint n_entries gpointer user_data")
-(CFNC "void gtk_action_group_add_toggle_actions GtkActionGroup* action_group GtkToggleActionEntry* entries guint n_entries gpointer user_data")
-;(CFNC "void gtk_action_group_add_radio_actions GtkActionGroup* action_group GtkRadioActionEntry* entries guint n_entries gint value GCallback on_change gpointer user_data")
-;(CFNC "void gtk_action_group_add_actions_full GtkActionGroup* action_group GtkActionEntry* entries guint n_entries lambda_data func_info GtkDestroyNotify destroy")
-(CFNC "void gtk_action_group_add_toggle_actions_full GtkActionGroup* action_group GtkToggleActionEntry* entries guint n_entries lambda_data func_info GtkDestroyNotify destroy")
-;(CFNC "void gtk_action_group_add_radio_actions_full GtkActionGroup* action_group GtkRadioActionEntry* entries guint n_entries gint value GCallback on_change gpointer user_data GtkDestroyNotify destroy")
-;(CFNC "void gtk_action_group_set_translate_func GtkActionGroup* action_group GtkTranslateFunc func lambda_data func_info GtkDestroyNotify notify")
-(CFNC "void gtk_action_group_set_translation_domain GtkActionGroup* action_group gchar* domain")
+;;; (CFNC "GtkActionGroup* gtk_action_group_new gchar* name")
+;;; (CFNC "gchar* gtk_action_group_get_name GtkActionGroup* action_group")
+;;; (CFNC "GtkAction* gtk_action_group_get_action GtkActionGroup* action_group gchar* action_name")
+;;; (CFNC "GList* gtk_action_group_list_actions GtkActionGroup* action_group")
+;;; (CFNC "void gtk_action_group_add_action GtkActionGroup* action_group GtkAction* action")
+;;; (CFNC "void gtk_action_group_remove_action GtkActionGroup* action_group GtkAction* action")
+;;; (CFNC "void gtk_action_group_add_actions GtkActionGroup* action_group GtkActionEntry* entries guint n_entries gpointer user_data")
+;;; (CFNC "void gtk_action_group_add_toggle_actions GtkActionGroup* action_group GtkToggleActionEntry* entries guint n_entries gpointer user_data")
+;;; ;(CFNC "void gtk_action_group_add_radio_actions GtkActionGroup* action_group GtkRadioActionEntry* entries guint n_entries gint value GCallback on_change gpointer user_data")
+;;; ;(CFNC "void gtk_action_group_add_actions_full GtkActionGroup* action_group GtkActionEntry* entries guint n_entries lambda_data func_info GtkDestroyNotify destroy")
+;;; (CFNC "void gtk_action_group_add_toggle_actions_full GtkActionGroup* action_group GtkToggleActionEntry* entries guint n_entries lambda_data func_info GtkDestroyNotify destroy")
+;;; ;(CFNC "void gtk_action_group_add_radio_actions_full GtkActionGroup* action_group GtkRadioActionEntry* entries guint n_entries gint value GCallback on_change gpointer user_data GtkDestroyNotify destroy")
+;;; ;(CFNC "void gtk_action_group_set_translate_func GtkActionGroup* action_group GtkTranslateFunc func lambda_data func_info GtkDestroyNotify notify")
+;;; (CFNC "void gtk_action_group_set_translation_domain GtkActionGroup* action_group gchar* domain")
+
;;;;(CFNC "GType gtk_combo_box_get_type void")
;;; (CFNC "GtkWidget* gtk_combo_box_new GtkTreeModel* model")
;;; changed 2.3.1
@@ -4906,16 +4865,16 @@
(CFNC "gboolean gtk_font_button_get_show_size GtkFontButton* font_button")
(CFNC "void gtk_font_button_set_show_size GtkFontButton* font_button gboolean show_size")
;;;;(CFNC "GType gtk_color_button_get_type void")
-(CFNC "GtkWidget* gtk_color_button_new void")
-(CFNC "GtkWidget* gtk_color_button_new_with_color GdkColor* color")
-(CFNC "void gtk_color_button_set_color GtkColorButton* color_button GdkColor* color")
-(CFNC "void gtk_color_button_set_alpha GtkColorButton* color_button guint16 alpha")
-(CFNC "void gtk_color_button_get_color GtkColorButton* color_button GdkColor* color")
-(CFNC "guint16 gtk_color_button_get_alpha GtkColorButton* color_button")
-(CFNC "void gtk_color_button_set_use_alpha GtkColorButton* color_button gboolean use_alpha")
-(CFNC "gboolean gtk_color_button_get_use_alpha GtkColorButton* color_button")
-(CFNC "void gtk_color_button_set_title GtkColorButton* color_button gchar* title")
-(CFNC "gchar* gtk_color_button_get_title GtkColorButton* color_button")
+;;; ;;; 3.3.16 (CFNC-gtk2 "GtkWidget* gtk_color_button_new void")
+;;; ;;; 3.3.16 (CFNC-gtk2 "GtkWidget* gtk_color_button_new_with_color GdkColor* color")
+;;; 3.3.16 (CFNC "void gtk_color_button_set_alpha GtkColorButton* color_button guint16 alpha")
+;;; ;;; 3.3.16 (CFNC-gtk2 "void gtk_color_button_set_color GtkColorButton* color_button GdkColor* color")
+;;; ;;; 3.3.16 (CFNC-gtk2 "void gtk_color_button_get_color GtkColorButton* color_button GdkColor* color")
+;;; 3.3.16 (CFNC "guint16 gtk_color_button_get_alpha GtkColorButton* color_button")
+;;; 3.3.16 (CFNC "void gtk_color_button_set_use_alpha GtkColorButton* color_button gboolean use_alpha")
+;;; 3.3.16 (CFNC "gboolean gtk_color_button_get_use_alpha GtkColorButton* color_button")
+;;; ;;; 3.3.16 (CFNC-gtk2 "void gtk_color_button_set_title GtkColorButton* color_button gchar* title")
+;;; ;;; 3.3.16 (CFNC-gtk2 "gchar* gtk_color_button_get_title GtkColorButton* color_button")
;;;;(CFNC "GType gtk_entry_completion_get_type void")
(CFNC "GtkEntryCompletion* gtk_entry_completion_new void")
(CFNC "GtkWidget* gtk_entry_completion_get_entry GtkEntryCompletion* entry")
@@ -4931,8 +4890,8 @@
(CFNC "void gtk_entry_completion_set_text_column GtkEntryCompletion* completion gint column")
;;;;(CFNC "GType gtk_ui_manager_get_type void")
;(CFNC "GtkUIManager* gtk_ui_manager_new void")
-;(CFNC "void gtk_ui_manager_set_add_tearoffs GtkUIManager* self gboolean add_tearoffs")
-;(CFNC "gboolean gtk_ui_manager_get_add_tearoffs GtkUIManager* self")
+;;; 3.3.2 ;(CFNC "void gtk_ui_manager_set_add_tearoffs GtkUIManager* self gboolean add_tearoffs")
+;;; 3.3.2 ;(CFNC "gboolean gtk_ui_manager_get_add_tearoffs GtkUIManager* self")
;(CFNC "void gtk_ui_manager_insert_action_group GtkUIManager* self GtkActionGroup* action_group gint pos")
;(CFNC "void gtk_ui_manager_remove_action_group GtkUIManager* self GtkActionGroup* action_group")
;(CFNC "GList* gtk_ui_manager_get_action_groups GtkUIManager* self")
@@ -4948,31 +4907,31 @@
;(CFNC "guint gtk_ui_manager_new_merge_id GtkUIManager* self")
;;;;(CFNC "GType gtk_radio_tool_button_get_type void")
(CFNC "GtkToolItem* gtk_radio_tool_button_new GSList* @group")
-(CFNC "GtkToolItem* gtk_radio_tool_button_new_from_stock GSList* @group gchar* stock_id")
+;;; (CFNC "GtkToolItem* gtk_radio_tool_button_new_from_stock GSList* @group gchar* stock_id")
;;; (CFNC "GtkToolItem* gtk_radio_tool_button_new_from_widget GtkWidget* group")
;;; changed 2.3.1
(CFNC "GtkToolItem* gtk_radio_tool_button_new_from_widget GtkRadioToolButton* group")
-(CFNC "GtkToolItem* gtk_radio_tool_button_new_with_stock_from_widget GtkRadioToolButton* group gchar* stock_id")
+;;; (CFNC "GtkToolItem* gtk_radio_tool_button_new_with_stock_from_widget GtkRadioToolButton* group gchar* stock_id")
;;; arg1 type changed 2.3.2
(CFNC "GSList* gtk_radio_tool_button_get_group GtkRadioToolButton* button")
(CFNC "void gtk_radio_tool_button_set_group GtkRadioToolButton* button GSList* @group")
;;;;(CFNC "GType gtk_radio_action_get_type void")
-(CFNC "GSList* gtk_radio_action_get_group GtkRadioAction* action")
-(CFNC "void gtk_radio_action_set_group GtkRadioAction* action GSList* @group")
-(CFNC "gint gtk_radio_action_get_current_value GtkRadioAction* action")
+;;; (CFNC "GSList* gtk_radio_action_get_group GtkRadioAction* action")
+;;; (CFNC "void gtk_radio_action_set_group GtkRadioAction* action GSList* @group")
+;;; (CFNC "gint gtk_radio_action_get_current_value GtkRadioAction* action")
;;;;(CFNC "GType gtk_separator_tool_item_get_type void")
(CFNC "GtkToolItem* gtk_separator_tool_item_new void")
(CFNC "gboolean gtk_separator_tool_item_get_draw GtkSeparatorToolItem* item")
(CFNC "void gtk_separator_tool_item_set_draw GtkSeparatorToolItem* tool_item gboolean draw")
;;;;(CFNC "GType gtk_toggle_action_get_type void")
-(CFNC "void gtk_toggle_action_toggled GtkToggleAction* action")
-(CFNC "void gtk_toggle_action_set_active GtkToggleAction* action gboolean is_active")
-(CFNC "gboolean gtk_toggle_action_get_active GtkToggleAction* action")
-(CFNC "void gtk_toggle_action_set_draw_as_radio GtkToggleAction* action gboolean draw_as_radio")
-(CFNC "gboolean gtk_toggle_action_get_draw_as_radio GtkToggleAction* action")
-;;;;(CFNC "GType gtk_toggle_tool_button_get_type void")
+;;; (CFNC "void gtk_toggle_action_toggled GtkToggleAction* action")
+;;; (CFNC "void gtk_toggle_action_set_active GtkToggleAction* action gboolean is_active")
+;;; (CFNC "gboolean gtk_toggle_action_get_active GtkToggleAction* action")
+;;; (CFNC "void gtk_toggle_action_set_draw_as_radio GtkToggleAction* action gboolean draw_as_radio")
+;;; (CFNC "gboolean gtk_toggle_action_get_draw_as_radio GtkToggleAction* action")
+;;; ;;;;(CFNC "GType gtk_toggle_tool_button_get_type void")
(CFNC "GtkToolItem* gtk_toggle_tool_button_new void")
-(CFNC "GtkToolItem* gtk_toggle_tool_button_new_from_stock gchar* stock_id")
+;;; (CFNC "GtkToolItem* gtk_toggle_tool_button_new_from_stock gchar* stock_id")
(CFNC "void gtk_toggle_tool_button_set_active GtkToggleToolButton* button gboolean is_active")
(CFNC "gboolean gtk_toggle_tool_button_get_active GtkToggleToolButton* button")
(CFNC "guint g_timeout_add_full gint priority guint interval GSourceFunc func lambda_data func_info GtkDestroyNotify notify")
@@ -5060,27 +5019,27 @@
(CFNC "GList* gtk_icon_theme_list_icons GtkIconTheme* icon_theme gchar* context")
(CFNC "char* gtk_icon_theme_get_example_icon_name GtkIconTheme* icon_theme")
(CFNC "gboolean gtk_icon_theme_rescan_if_needed GtkIconTheme* icon_theme")
-(CFNC "void gtk_icon_theme_add_builtin_icon gchar* icon_name gint size GdkPixbuf* pixbuf")
+;;; 3.13.4 (CFNC "void gtk_icon_theme_add_builtin_icon gchar* icon_name gint size GdkPixbuf* pixbuf")
;;;;(CFNC "GType gtk_icon_info_get_type void")
-(CFNC "GtkIconInfo* gtk_icon_info_copy GtkIconInfo* icon_info")
-(CFNC "void gtk_icon_info_free GtkIconInfo* icon_info")
+;;; 3.7.10 (CFNC "GtkIconInfo* gtk_icon_info_copy GtkIconInfo* icon_info")
+;;; 3.7.10 (CFNC "void gtk_icon_info_free GtkIconInfo* icon_info")
(CFNC "gint gtk_icon_info_get_base_size GtkIconInfo* icon_info")
(CFNC "gchar* gtk_icon_info_get_filename GtkIconInfo* icon_info")
-(CFNC "GdkPixbuf* gtk_icon_info_get_builtin_pixbuf GtkIconInfo* icon_info")
+;;; 3.13.4 (CFNC "GdkPixbuf* gtk_icon_info_get_builtin_pixbuf GtkIconInfo* icon_info")
(CFNC "GdkPixbuf* gtk_icon_info_load_icon GtkIconInfo* icon_info GError** [error]")
-(CFNC "void gtk_icon_info_set_raw_coordinates GtkIconInfo* icon_info gboolean raw_coordinates")
-(CFNC "gboolean gtk_icon_info_get_embedded_rect GtkIconInfo* icon_info GdkRectangle* rectangle")
-;;; (CFNC "gboolean gtk_icon_info_get_attach_points GtkIconInfo* icon_info GdkPoint** [points] gint* [n_points]")
-(CFNC "gchar* gtk_icon_info_get_display_name GtkIconInfo* icon_info")
+;;; 3.13.3 (CFNC "void gtk_icon_info_set_raw_coordinates GtkIconInfo* icon_info gboolean raw_coordinates")
+;;; 3.13.3 (CFNC "gboolean gtk_icon_info_get_embedded_rect GtkIconInfo* icon_info GdkRectangle* rectangle")
+;;; 3.13.3 ;;; (CFNC "gboolean gtk_icon_info_get_attach_points GtkIconInfo* icon_info GdkPoint** [points] gint* [n_points]")
+;;; 3.13.3 (CFNC "gchar* gtk_icon_info_get_display_name GtkIconInfo* icon_info")
;;;;(CFNC "GType gtk_tool_button_get_type void")
(CFNC "GtkToolItem* gtk_tool_button_new GtkWidget* @icon_widget gchar* label")
-(CFNC "GtkToolItem* gtk_tool_button_new_from_stock gchar* stock_id")
+;;; (CFNC "GtkToolItem* gtk_tool_button_new_from_stock gchar* stock_id")
(CFNC "void gtk_tool_button_set_label GtkToolButton* button gchar* label")
(CFNC "gchar* gtk_tool_button_get_label GtkToolButton* button")
(CFNC "void gtk_tool_button_set_use_underline GtkToolButton* button gboolean use_underline")
(CFNC "gboolean gtk_tool_button_get_use_underline GtkToolButton* button")
-(CFNC "void gtk_tool_button_set_stock_id GtkToolButton* button gchar* stock_id")
-(CFNC "gchar* gtk_tool_button_get_stock_id GtkToolButton* button")
+;;; (CFNC "void gtk_tool_button_set_stock_id GtkToolButton* button gchar* stock_id")
+;;; (CFNC "gchar* gtk_tool_button_get_stock_id GtkToolButton* button")
(CFNC "void gtk_tool_button_set_icon_widget GtkToolButton* button GtkWidget* @icon_widget")
(CFNC "GtkWidget* gtk_tool_button_get_icon_widget GtkToolButton* button")
(CFNC "void gtk_tool_button_set_label_widget GtkToolButton* button GtkWidget* @label_widget")
@@ -5102,7 +5061,7 @@
(CFNC "gboolean gtk_tool_item_get_visible_vertical GtkToolItem* toolitem")
(CFNC "gboolean gtk_tool_item_get_is_important GtkToolItem* tool_item")
(CFNC "void gtk_tool_item_set_is_important GtkToolItem* tool_item gboolean is_important")
-(CFNC "GtkIconSize gtk_tool_item_get_icon_size GtkToolItem* tool_item")
+;;; (CFNC "GtkIconSize gtk_tool_item_get_icon_size GtkToolItem* tool_item")
(CFNC "GtkOrientation gtk_tool_item_get_orientation GtkToolItem* tool_item")
(CFNC "GtkToolbarStyle gtk_tool_item_get_toolbar_style GtkToolItem* tool_item")
(CFNC "GtkReliefStyle gtk_tool_item_get_relief_style GtkToolItem* tool_item")
@@ -5117,26 +5076,29 @@
(CFNC "GdkWindow* gdk_display_get_default_group GdkDisplay* display")
;;; changed return type 2.90.1 (CFNC "void gdk_window_set_accept_focus GdkWindow* window gboolean accept_focus")
(CFNC "GdkWindow* gdk_window_get_group GdkWindow* window")
-(CFNC "gboolean gtk_action_group_get_sensitive GtkActionGroup* action_group")
-(CFNC "void gtk_action_group_set_sensitive GtkActionGroup* action_group gboolean sensitive")
-(CFNC "gboolean gtk_action_group_get_visible GtkActionGroup* action_group")
-(CFNC "void gtk_action_group_set_visible GtkActionGroup* action_group gboolean visible")
-(CFNC "void gtk_action_group_add_action_with_accel GtkActionGroup* action_group GtkAction* action gchar* accelerator")
-(CFNC "GtkAction* gtk_action_new gchar* name gchar* label gchar* tooltip gchar* stock_id")
-(CFNC "gboolean gtk_action_is_sensitive GtkAction* action")
-(CFNC "gboolean gtk_action_get_sensitive GtkAction* action")
-(CFNC "gboolean gtk_action_is_visible GtkAction* action")
-(CFNC "gboolean gtk_action_get_visible GtkAction* action")
-(CFNC "void gtk_button_set_alignment GtkButton* button gfloat xalign gfloat yalign")
-(CFNC "void gtk_button_get_alignment GtkButton* button gfloat* [xalign] gfloat* [yalign]")
+
+;;; 3.9.8
+;;; (CFNC "gboolean gtk_action_group_get_sensitive GtkActionGroup* action_group")
+;;; (CFNC "void gtk_action_group_set_sensitive GtkActionGroup* action_group gboolean sensitive")
+;;; (CFNC "gboolean gtk_action_group_get_visible GtkActionGroup* action_group")
+;;; (CFNC "void gtk_action_group_set_visible GtkActionGroup* action_group gboolean visible")
+;;; (CFNC "void gtk_action_group_add_action_with_accel GtkActionGroup* action_group GtkAction* action gchar* accelerator")
+;;; (CFNC "GtkAction* gtk_action_new gchar* name gchar* label gchar* tooltip gchar* stock_id")
+;;; (CFNC "gboolean gtk_action_is_sensitive GtkAction* action")
+;;; (CFNC "gboolean gtk_action_get_sensitive GtkAction* action")
+;;; (CFNC "gboolean gtk_action_is_visible GtkAction* action")
+;;; (CFNC "gboolean gtk_action_get_visible GtkAction* action")
+
+;;; 3.13.2 (CFNC "void gtk_button_set_alignment GtkButton* button gfloat xalign gfloat yalign")
+;;; 3.13.2 (CFNC "void gtk_button_get_alignment GtkButton* button gfloat* [xalign] gfloat* [yalign]")
(CFNC "void gtk_cell_layout_reorder GtkCellLayout* cell_layout GtkCellRenderer* cell gint position")
(CFNC "void gtk_clipboard_request_targets GtkClipboard* clipboard GtkClipboardTargetsReceivedFunc func lambda_data #func_info")
(CFNC "gboolean gtk_clipboard_wait_for_targets GtkClipboard* clipboard GdkAtom** [targets] gint* [n_targets]") ; FREE (targets)
(CFNC "void gtk_menu_shell_cancel GtkMenuShell* menu_shell")
(CFNC "GtkWidget* gtk_paned_get_child1 GtkPaned* paned")
(CFNC "GtkWidget* gtk_paned_get_child2 GtkPaned* paned")
-(CFNC "GtkRadioAction* gtk_radio_action_new gchar* name gchar* label gchar* tooltip gchar* stock_id gint value")
-(CFNC "GtkToggleAction* gtk_toggle_action_new gchar* name gchar* label gchar* tooltip gchar* stock_id")
+;;; (CFNC "GtkRadioAction* gtk_radio_action_new gchar* name gchar* label gchar* tooltip gchar* stock_id gint value")
+;;; (CFNC "GtkToggleAction* gtk_toggle_action_new gchar* name gchar* label gchar* tooltip gchar* stock_id")
(CFNC "void gtk_window_set_accept_focus GtkWindow* window gboolean setting")
(CFNC "gboolean gtk_window_get_accept_focus GtkWindow* window")
@@ -5168,7 +5130,7 @@
(CFNC "void gtk_file_chooser_set_use_preview_label GtkFileChooser* chooser gboolean use_label")
(CFNC "gboolean gtk_file_chooser_get_use_preview_label GtkFileChooser* chooser")
;;; 2.13.6. (CFNC "GtkWidget* gtk_file_chooser_widget_new_with_backend GtkFileChooserAction action gchar* backend")
-;(CFNC-gtk2 "void gtk_rc_reset_styles GtkSettings* settings")
+;;; ;(CFNC-gtk2 "void gtk_rc_reset_styles GtkSettings* settings")
;;;(CFNC "void gtk_text_layout_set_keyboard_direction GtkTextLayout* layout GtkTextDirection keyboard_dir")
;;;GtkTextLayout is buggy
(CFNC "GList* gtk_widget_list_mnemonic_labels GtkWidget* widget") ; FREE (g_list_free)
@@ -5214,21 +5176,21 @@
(CFNC "void gtk_cell_view_set_model GtkCellView* cell_view GtkTreeModel* @model")
(CFNC "void gtk_cell_view_set_displayed_row GtkCellView* cell_view GtkTreePath* path")
(CFNC "GtkTreePath* gtk_cell_view_get_displayed_row GtkCellView* cell_view")
-(CFNC-gtk2 "gboolean gtk_cell_view_get_size_of_row GtkCellView* cell_view GtkTreePath* path GtkRequisition* requisition") ; assumes requisition is alloc'd
-(CFNC "void gtk_cell_view_set_background_color GtkCellView* cell_view GdkColor* color")
+;;; (CFNC-gtk2 "gboolean gtk_cell_view_get_size_of_row GtkCellView* cell_view GtkTreePath* path GtkRequisition* requisition") ; assumes requisition is alloc'd
+;;; (CFNC-gtk2 "void gtk_cell_view_set_background_color GtkCellView* cell_view GdkColor* color")
;;; out 2.5.6 (CFNC "void gtk_cell_view_set_cell_data GtkCellView* cellview")
;;; out 2.17.2 (CFNC "GList* gtk_cell_view_get_cell_renderers GtkCellView* cellview") ; FREE (g_list_free)
;;; changed return type 2.90.1 (CFNC "void gdk_window_set_focus_on_map GdkWindow* window gboolean focus_on_map")
-(CFNC "void gdk_window_enable_synchronized_configure GdkWindow* window")
-(CFNC "void gdk_window_configure_finished GdkWindow* window")
+;;; 3.7.10 (CFNC "void gdk_window_enable_synchronized_configure GdkWindow* window")
+;;; 3.7.10 (CFNC "void gdk_window_configure_finished GdkWindow* window")
;;;(CFNC "gchar* gtk_action_group_translate_string GtkActionGroup* action_group gchar* string") -- out 2.5.2
(CFNC "gint gtk_combo_box_get_wrap_width GtkComboBox* combo_box")
(CFNC "gint gtk_combo_box_get_row_span_column GtkComboBox* combo_box")
(CFNC "gint gtk_combo_box_get_column_span_column GtkComboBox* combo_box")
-(CFNC "gboolean gtk_combo_box_get_add_tearoffs GtkComboBox* combo_box")
-(CFNC "void gtk_combo_box_set_add_tearoffs GtkComboBox* combo_box gboolean add_tearoffs")
+;;; 3.3.2 (CFNC "gboolean gtk_combo_box_get_add_tearoffs GtkComboBox* combo_box")
+;;; 3.3.2 (CFNC "void gtk_combo_box_set_add_tearoffs GtkComboBox* combo_box gboolean add_tearoffs")
;;; (CFNC "void gtk_combo_box_set_row_separator_column GtkComboBox* combo_box gint column")
;;; (CFNC "gint gtk_combo_box_get_row_separator_column GtkComboBox* combo_box")
;;; changed in 2.5.1
@@ -5267,8 +5229,8 @@
(CFNC "void gtk_about_dialog_set_copyright GtkAboutDialog* about gchar* copyright")
(CFNC "gchar* gtk_about_dialog_get_comments GtkAboutDialog* about")
(CFNC "void gtk_about_dialog_set_comments GtkAboutDialog* about gchar* comments")
-(CFNC "gchar* gtk_about_dialog_get_license GtkAboutDialog* about")
-(CFNC "void gtk_about_dialog_set_license GtkAboutDialog* about gchar* license")
+;(CFNC "gchar* gtk_about_dialog_get_license GtkAboutDialog* about")
+;(CFNC "void gtk_about_dialog_set_license GtkAboutDialog* about gchar* license")
(CFNC "gchar* gtk_about_dialog_get_website GtkAboutDialog* about")
(CFNC "void gtk_about_dialog_set_website GtkAboutDialog* about gchar* website")
(CFNC "gchar* gtk_about_dialog_get_website_label GtkAboutDialog* about")
@@ -5448,10 +5410,10 @@
;;; ditto (CFNC "void gtk_file_chooser_button_set_active GtkFileChooserButton* button gboolean is_active")
(CFNC "gboolean gdk_drag_drop_succeeded GdkDragContext* context")
;;; 2.90.6 (CFNC "gboolean gdk_rgb_colormap_ditherable GdkColormap* cmap")
-(CFNC "void gtk_action_set_sensitive GtkAction* action gboolean sensitive")
-(CFNC "void gtk_action_set_visible GtkAction* action gboolean visible")
-(CFNC "gboolean gtk_combo_box_get_focus_on_click GtkComboBox* combo")
-(CFNC "void gtk_combo_box_set_focus_on_click GtkComboBox* combo gboolean focus_on_click")
+;;; (CFNC "void gtk_action_set_sensitive GtkAction* action gboolean sensitive")
+;;; (CFNC "void gtk_action_set_visible GtkAction* action gboolean visible")
+;;; 3.19.2 (CFNC "gboolean gtk_combo_box_get_focus_on_click GtkComboBox* combo")
+;;; 3.19.2 (CFNC "void gtk_combo_box_set_focus_on_click GtkComboBox* combo gboolean focus_on_click")
;;; already included? (CFNC "PangoLayout* gtk_entry_get_layout GtkEntry* entry")
(CFNC "gint gtk_entry_layout_index_to_text_index GtkEntry* entry gint layout_index")
(CFNC "gint gtk_entry_text_index_to_layout_index GtkEntry* entry gint text_index")
@@ -5474,7 +5436,7 @@
;;;;(CFNC "GType gtk_menu_tool_button_get_type void")
(CFNC "GtkToolItem* gtk_menu_tool_button_new GtkWidget* @icon_widget gchar* label")
-(CFNC "GtkToolItem* gtk_menu_tool_button_new_from_stock gchar* stock_id")
+;;; (CFNC "GtkToolItem* gtk_menu_tool_button_new_from_stock gchar* stock_id")
(CFNC "void gtk_menu_tool_button_set_menu GtkMenuToolButton* button GtkWidget* menu")
(CFNC "GtkWidget* gtk_menu_tool_button_get_menu GtkMenuToolButton* button")
;;; out 2.11.6 (CFNC "void gtk_menu_tool_button_set_arrow_tooltip GtkMenuToolButton* button GtkTooltips* tooltips gchar* tip_text gchar* tip_private")
@@ -5486,7 +5448,7 @@
(CFNC "gboolean gtk_clipboard_wait_is_target_available GtkClipboard* clipboard GdkAtom target")
(CFNC "void gtk_clipboard_set_can_store GtkClipboard* clipboard GtkTargetEntry* @targets gint n_targets")
(CFNC "void gtk_clipboard_store GtkClipboard* clipboard")
-(CFNC "gboolean gtk_alternative_dialog_button_order GdkScreen* @screen")
+;;; 3.12? (CFNC "gboolean gtk_alternative_dialog_button_order GdkScreen* @screen")
;;;(CFNC "void gtk_dialog_set_alternative_button_order GtkDialog* dialog gint first_response_id ...")
(CFNC "void gtk_drag_dest_add_image_targets GtkWidget* widget")
(CFNC "void gtk_drag_dest_add_uri_targets GtkWidget* widget")
@@ -5494,8 +5456,8 @@
(CFNC "void gtk_drag_source_add_uri_targets GtkWidget* widget")
(CFNC "gint gtk_file_chooser_button_get_width_chars GtkFileChooserButton* button")
(CFNC "void gtk_file_chooser_button_set_width_chars GtkFileChooserButton* button gint n_chars")
-(CFNC "GtkWidget* gtk_image_new_from_icon_name gchar* icon_name GtkIconSize size")
-(CFNC "void gtk_image_set_from_icon_name GtkImage* image gchar* icon_name GtkIconSize size")
+;;; (CFNC "GtkWidget* gtk_image_new_from_icon_name gchar* icon_name GtkIconSize size")
+;;; (CFNC "void gtk_image_set_from_icon_name GtkImage* image gchar* icon_name GtkIconSize size")
(CFNC "void gtk_image_set_pixel_size GtkImage* image gint pixel_size")
;;;(CFNC "void gtk_image_get_icon_name GtkImage* image gchar** [icon_name] GtkIconSize* [size]" 'const) ;; no free here -- need const
(CFNC "gint gtk_image_get_pixel_size GtkImage* image")
@@ -5547,7 +5509,7 @@
(CFNC "void gtk_button_set_image GtkButton* button GtkWidget* image")
(CFNC "GtkWidget* gtk_button_get_image GtkButton* button")
-(CFNC "void gtk_dialog_set_alternative_button_order_from_array GtkDialog* dialog gint n_params gint* new_order")
+;;; 3.12? (CFNC "void gtk_dialog_set_alternative_button_order_from_array GtkDialog* dialog gint n_params gint* new_order")
(CFNC "void gtk_label_set_angle GtkLabel* label gdouble angle")
(CFNC "gdouble gtk_label_get_angle GtkLabel* label")
@@ -5645,7 +5607,7 @@
;;; 2.91.0 (CFNC "GdkColormap* gdk_screen_get_rgba_colormap GdkScreen* screen")
(CFNC "GdkVisual* gdk_screen_get_rgba_visual GdkScreen* screen")
(CFNC "void gdk_window_set_urgency_hint GdkWindow* window gboolean urgent")
-(CFNC "GClosure* gtk_action_get_accel_closure GtkAction* action")
+;;; (CFNC "GClosure* gtk_action_get_accel_closure GtkAction* action")
(CFNC "gint gtk_dialog_get_response_for_widget GtkDialog* dialog GtkWidget* widget")
(CFNC "void gtk_drag_source_set_icon_name GtkWidget* widget gchar* icon_name" 'const)
(CFNC "void gtk_drag_set_icon_name GdkDragContext* context gchar* icon_name gint hot_x gint hot_y" 'const)
@@ -5675,8 +5637,8 @@
(CFNC "void gtk_menu_bar_set_child_pack_direction GtkMenuBar* menubar GtkPackDirection child_pack_dir")
(CFNC "gboolean gtk_menu_shell_get_take_focus GtkMenuShell* menu_shell")
(CFNC "void gtk_menu_shell_set_take_focus GtkMenuShell* menu_shell gboolean take_focus")
-(CFNC "GtkWidget* gtk_scrolled_window_get_hscrollbar GtkScrolledWindow* scrolled_window")
-(CFNC "GtkWidget* gtk_scrolled_window_get_vscrollbar GtkScrolledWindow* scrolled_window")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_scrolled_window_get_hscrollbar GtkScrolledWindow* scrolled_window")
+;;; 3.1.6 (CFNC "GtkWidget* gtk_scrolled_window_get_vscrollbar GtkScrolledWindow* scrolled_window")
(CFNC "void gtk_size_group_set_ignore_hidden GtkSizeGroup* size_group gboolean ignore_hidden")
(CFNC "gboolean gtk_size_group_get_ignore_hidden GtkSizeGroup* size_group")
;(CFNC "void gtk_stock_set_translate_func gchar* domain GtkTranslateFunc func lambda_data func_info GtkDestroyNotify notify" 'const)
@@ -5701,8 +5663,8 @@
;;; gtk 2.7.2
-(CFNC "gboolean gtk_about_dialog_get_wrap_license GtkAboutDialog* about")
-(CFNC "void gtk_about_dialog_set_wrap_license GtkAboutDialog* about gboolean wrap_license")
+;(CFNC "gboolean gtk_about_dialog_get_wrap_license GtkAboutDialog* about")
+;(CFNC "void gtk_about_dialog_set_wrap_license GtkAboutDialog* about gboolean wrap_license")
;;; 2.7.3
@@ -5741,8 +5703,8 @@
(CINT "PANGO_SCRIPT_OLD_PERSIAN" "PangoScript")
(CINT "PANGO_SCRIPT_KHAROSHTHI" "PangoScript")
-(CLNG "PANGO_TYPE_ITEM")
-(CLNG "PANGO_TYPE_LAYOUT_LINE")
+;;; (CLNG "PANGO_TYPE_ITEM")
+;;; (CLNG "PANGO_TYPE_LAYOUT_LINE")
;; 11.2: + double pango_matrix_get_font_scale_factor (PangoMatrix *matrix);
@@ -5786,8 +5748,8 @@
(CCHK "GTK_IS_RECENT_FILTER(obj)" "GtkRecentFilter*")
(CCAST "GTK_RECENT_MANAGER(obj)" "GtkRecentManager*")
(CCHK "GTK_IS_RECENT_MANAGER(obj)" "GtkRecentManager*")
-(CCAST "GTK_STATUS_ICON(obj)" "GtkStatusIcon*")
-(CCHK "GTK_IS_STATUS_ICON(obj)" "GtkStatusIcon*")
+;;; 3.14.0 (CCAST "GTK_STATUS_ICON(obj)" "GtkStatusIcon*")
+;;; 3.14.0 (CCHK "GTK_IS_STATUS_ICON(obj)" "GtkStatusIcon*")
(CFNC "GtkTargetList* gtk_target_list_ref GtkTargetList* list")
@@ -5813,12 +5775,12 @@
(CINT "GTK_RECENT_SORT_CUSTOM" "GtkRecentSortType")
(CINT "GTK_RECENT_CHOOSER_ERROR_NOT_FOUND" "GtkRecentChooserError")
(CINT "GTK_RECENT_CHOOSER_ERROR_INVALID_URI" "GtkRecentChooserError")
-(CINT "GTK_RECENT_FILTER_URI" "GtkRecentFilterFlags")
-(CINT "GTK_RECENT_FILTER_DISPLAY_NAME" "GtkRecentFilterFlags")
-(CINT "GTK_RECENT_FILTER_MIME_TYPE" "GtkRecentFilterFlags")
-(CINT "GTK_RECENT_FILTER_APPLICATION" "GtkRecentFilterFlags")
-(CINT "GTK_RECENT_FILTER_GROUP" "GtkRecentFilterFlags")
-(CINT "GTK_RECENT_FILTER_AGE" "GtkRecentFilterFlags")
+;(CINT "GTK_RECENT_FILTER_URI" "GtkRecentFilterFlags")
+;(CINT "GTK_RECENT_FILTER_DISPLAY_NAME" "GtkRecentFilterFlags")
+;(CINT "GTK_RECENT_FILTER_MIME_TYPE" "GtkRecentFilterFlags")
+;(CINT "GTK_RECENT_FILTER_APPLICATION" "GtkRecentFilterFlags")
+;(CINT "GTK_RECENT_FILTER_GROUP" "GtkRecentFilterFlags")
+;(CINT "GTK_RECENT_FILTER_AGE" "GtkRecentFilterFlags")
(CINT "GTK_RECENT_MANAGER_ERROR_NOT_FOUND" "GtkRecentManagerError")
(CINT "GTK_RECENT_MANAGER_ERROR_INVALID_URI" "GtkRecentManagerError")
;out 2.9.1 (CINT "GTK_RECENT_MANAGER_ERROR_INVALID_MIME" "GtkRecentManagerError")
@@ -5842,14 +5804,14 @@
(CFNC "void gtk_clipboard_request_rich_text GtkClipboard* clipboard GtkTextBuffer* buffer GtkClipboardRichTextReceivedFunc func lambda_data #func_info")
(CFNC "guint8* gtk_clipboard_wait_for_rich_text GtkClipboard* clipboard GtkTextBuffer* buffer GdkAtom* format gsize* [length]")
(CFNC "gboolean gtk_clipboard_wait_is_rich_text_available GtkClipboard* clipboard GtkTextBuffer* buffer")
-(CFNC "gchar* gtk_combo_box_get_title GtkComboBox* combo_box") ; 'const
-(CFNC "void gtk_combo_box_set_title GtkComboBox* combo_box gchar* title")
+;;; 3.10 (CFNC "gchar* gtk_combo_box_get_title GtkComboBox* combo_box") ; 'const
+;;; 3.10 (CFNC "void gtk_combo_box_set_title GtkComboBox* combo_box gchar* title")
(CFNC "void gtk_drag_dest_set_track_motion GtkWidget* widget gboolean track_motion")
(CFNC "gboolean gtk_drag_dest_get_track_motion GtkWidget* widget")
;(CFNC "GtkBorder* gtk_entry_get_inner_border GtkEntry* entry") ; 'const
;(CFNC "void gtk_entry_set_inner_border GtkEntry* entry GtkBorder* border") ; arg is const
-(CFNC "gboolean gtk_file_chooser_button_get_focus_on_click GtkFileChooserButton* button")
-(CFNC "void gtk_file_chooser_button_set_focus_on_click GtkFileChooserButton* button gboolean focus_on_click")
+;;; 3.19.2 (CFNC "gboolean gtk_file_chooser_button_get_focus_on_click GtkFileChooserButton* button")
+;;; 3.19.2 (CFNC "void gtk_file_chooser_button_set_focus_on_click GtkFileChooserButton* button gboolean focus_on_click")
;(CFNC "void gtk_file_info_set_icon_name GtkFileInfo* info gchar* con_name")
;(CFNC "gchar* gtk_file_info_get_icon_name GtkFileInfo* info") ; 'const
;(CFNC "GdkPixbuf* gtk_file_info_render_icon GtkFileInfo* info GtkWidget* widget gint pixel_size GError** [error]")
@@ -5863,7 +5825,7 @@
(CFNC "void gtk_notebook_set_tab_reorderable GtkNotebook* notebook GtkWidget* child gboolean reorderable")
(CFNC "gboolean gtk_notebook_get_tab_detachable GtkNotebook* notebook GtkWidget* child")
(CFNC "void gtk_notebook_set_tab_detachable GtkNotebook* notebook GtkWidget* child gboolean detachable")
-(CFNC "void gtk_radio_action_set_current_value GtkRadioAction* action gint current_value")
+;;; (CFNC "void gtk_radio_action_set_current_value GtkRadioAction* action gint current_value")
(CFNC "void gtk_range_set_lower_stepper_sensitivity GtkRange* range GtkSensitivityType sensitivity")
(CFNC "GtkSensitivityType gtk_range_get_lower_stepper_sensitivity GtkRange* range")
(CFNC "void gtk_range_set_upper_stepper_sensitivity GtkRange* range GtkSensitivityType sensitivity")
@@ -5880,7 +5842,7 @@
(CFNC "gboolean gtk_targets_include_uri GdkAtom* targets gint n_targets")
;;;;(CFNC "GType gtk_target_list_get_type void")
(CFNC "GSList* gtk_size_group_get_widgets GtkSizeGroup* size_group")
-(CFNC-gtk2 "gboolean gtk_style_lookup_color GtkStyle* style gchar* color_name GdkColor* color")
+;;; (CFNC-gtk2 "gboolean gtk_style_lookup_color GtkStyle* style gchar* color_name GdkColor* color")
(CFNC "gboolean gtk_text_buffer_get_has_selection GtkTextBuffer* buffer")
(CFNC "GtkTargetList* gtk_text_buffer_get_copy_target_list GtkTextBuffer* buffer")
(CFNC "GtkTargetList* gtk_text_buffer_get_paste_target_list GtkTextBuffer* buffer")
@@ -5910,10 +5872,10 @@
(CFNC "GtkAssistantPageType gtk_assistant_get_page_type GtkAssistant* assistant GtkWidget* page")
(CFNC "void gtk_assistant_set_page_title GtkAssistant* assistant GtkWidget* page gchar* title")
(CFNC "gchar* gtk_assistant_get_page_title GtkAssistant* assistant GtkWidget* page") ; 'const
-(CFNC "void gtk_assistant_set_page_header_image GtkAssistant* assistant GtkWidget* page GdkPixbuf* pixbuf")
-(CFNC "GdkPixbuf* gtk_assistant_get_page_header_image GtkAssistant* assistant GtkWidget* page")
-(CFNC "void gtk_assistant_set_page_side_image GtkAssistant* assistant GtkWidget* page GdkPixbuf* pixbuf")
-(CFNC "GdkPixbuf* gtk_assistant_get_page_side_image GtkAssistant* assistant GtkWidget* page")
+;;; 3.1.4 (CFNC "void gtk_assistant_set_page_header_image GtkAssistant* assistant GtkWidget* page GdkPixbuf* pixbuf")
+;;; 3.1.4 (CFNC "GdkPixbuf* gtk_assistant_get_page_header_image GtkAssistant* assistant GtkWidget* page")
+;;; 3.1.4 (CFNC "void gtk_assistant_set_page_side_image GtkAssistant* assistant GtkWidget* page GdkPixbuf* pixbuf")
+;;; 3.1.4 (CFNC "GdkPixbuf* gtk_assistant_get_page_side_image GtkAssistant* assistant GtkWidget* page")
(CFNC "void gtk_assistant_set_page_complete GtkAssistant* assistant GtkWidget* page gboolean complete")
(CFNC "gboolean gtk_assistant_get_page_complete GtkAssistant* assistant GtkWidget* page")
(CFNC "void gtk_assistant_add_action_widget GtkAssistant* assistant GtkWidget* child")
@@ -5986,9 +5948,9 @@
(CFNC "void gtk_recent_filter_add_application GtkRecentFilter* filter gchar* application")
(CFNC "void gtk_recent_filter_add_group GtkRecentFilter* filter gchar* group")
(CFNC "void gtk_recent_filter_add_age GtkRecentFilter* filter gint days")
-(CFNC "void gtk_recent_filter_add_custom GtkRecentFilter* filter GtkRecentFilterFlags needed GtkRecentFilterFunc func lambda_data #func_info GDestroyNotify data_destroy")
-(CFNC "GtkRecentFilterFlags gtk_recent_filter_get_needed GtkRecentFilter* filter")
-(CFNC "gboolean gtk_recent_filter_filter GtkRecentFilter* filter GtkRecentFilterInfo* filter_info")
+;(CFNC "void gtk_recent_filter_add_custom GtkRecentFilter* filter GtkRecentFilterFlags needed GtkRecentFilterFunc func lambda_data #func_info GDestroyNotify data_destroy")
+;(CFNC "GtkRecentFilterFlags gtk_recent_filter_get_needed GtkRecentFilter* filter")
+;(CFNC "gboolean gtk_recent_filter_filter GtkRecentFilter* filter GtkRecentFilterInfo* filter_info")
(CFNC "GQuark gtk_recent_manager_error_quark void")
;;;;(CFNC "GType gtk_recent_manager_get_type void")
(CFNC "GtkRecentManager* gtk_recent_manager_new void")
@@ -6028,27 +5990,27 @@
(CFNC "gboolean gtk_recent_info_exists GtkRecentInfo* info")
(CFNC "gboolean gtk_recent_info_match GtkRecentInfo* info_a GtkRecentInfo* info_b")
;;;;(CFNC "GType gtk_status_icon_get_type void")
-(CFNC "GtkStatusIcon* gtk_status_icon_new void")
-(CFNC "GtkStatusIcon* gtk_status_icon_new_from_pixbuf GdkPixbuf* pixbuf")
-(CFNC "GtkStatusIcon* gtk_status_icon_new_from_file gchar* filename")
-(CFNC "GtkStatusIcon* gtk_status_icon_new_from_stock gchar* stock_id")
-(CFNC "GtkStatusIcon* gtk_status_icon_new_from_icon_name gchar* icon_name")
-(CFNC "void gtk_status_icon_set_from_pixbuf GtkStatusIcon* status_icon GdkPixbuf* pixbuf")
-(CFNC "void gtk_status_icon_set_from_file GtkStatusIcon* status_icon gchar* filename")
-(CFNC "void gtk_status_icon_set_from_stock GtkStatusIcon* status_icon gchar* stock_id")
-(CFNC "void gtk_status_icon_set_from_icon_name GtkStatusIcon* status_icon gchar* icon_name")
-(CFNC "GtkImageType gtk_status_icon_get_storage_type GtkStatusIcon* status_icon")
-(CFNC "GdkPixbuf* gtk_status_icon_get_pixbuf GtkStatusIcon* status_icon")
-(CFNC "gchar* gtk_status_icon_get_stock GtkStatusIcon* status_icon") ; 'const
-(CFNC "gchar* gtk_status_icon_get_icon_name GtkStatusIcon* status_icon") ; 'const
-(CFNC "gint gtk_status_icon_get_size GtkStatusIcon* status_icon")
-;;; out 2.15.0 (CFNC "void gtk_status_icon_set_tooltip GtkStatusIcon* status_icon gchar* tooltip_text")
-(CFNC "void gtk_status_icon_set_visible GtkStatusIcon* status_icon gboolean visible")
-(CFNC "gboolean gtk_status_icon_get_visible GtkStatusIcon* status_icon")
-;;; 2.90.7 (CFNC "void gtk_status_icon_set_blinking GtkStatusIcon* status_icon gboolean blinking")
-;;; 2.90.7 (CFNC "gboolean gtk_status_icon_get_blinking GtkStatusIcon* status_icon")
-(CFNC "gboolean gtk_status_icon_is_embedded GtkStatusIcon* status_icon")
-(CFNC "void gtk_status_icon_position_menu GtkMenu* menu gint* [x] gint* [y] gboolean* [push_in] gpointer user_data")
+;;; 3.14.0 (CFNC "GtkStatusIcon* gtk_status_icon_new void")
+;;; 3.14.0 (CFNC "GtkStatusIcon* gtk_status_icon_new_from_pixbuf GdkPixbuf* pixbuf")
+;;; 3.14.0 (CFNC "GtkStatusIcon* gtk_status_icon_new_from_file gchar* filename")
+;;; 3.14.0 ;;; (CFNC "GtkStatusIcon* gtk_status_icon_new_from_stock gchar* stock_id")
+;;; 3.14.0 (CFNC "GtkStatusIcon* gtk_status_icon_new_from_icon_name gchar* icon_name")
+;;; 3.14.0 (CFNC "void gtk_status_icon_set_from_pixbuf GtkStatusIcon* status_icon GdkPixbuf* pixbuf")
+;;; 3.14.0 (CFNC "void gtk_status_icon_set_from_file GtkStatusIcon* status_icon gchar* filename")
+;;; 3.14.0 ;;; (CFNC "void gtk_status_icon_set_from_stock GtkStatusIcon* status_icon gchar* stock_id")
+;;; 3.14.0 (CFNC "void gtk_status_icon_set_from_icon_name GtkStatusIcon* status_icon gchar* icon_name")
+;;; 3.14.0 (CFNC "GtkImageType gtk_status_icon_get_storage_type GtkStatusIcon* status_icon")
+;;; 3.14.0 (CFNC "GdkPixbuf* gtk_status_icon_get_pixbuf GtkStatusIcon* status_icon")
+;;; 3.14.0 ;;; (CFNC "gchar* gtk_status_icon_get_stock GtkStatusIcon* status_icon") ; 'const
+;;; 3.14.0 (CFNC "gchar* gtk_status_icon_get_icon_name GtkStatusIcon* status_icon") ; 'const
+;;; 3.14.0 (CFNC "gint gtk_status_icon_get_size GtkStatusIcon* status_icon")
+;;; 3.14.0 ;;; out 2.15.0 (CFNC "void gtk_status_icon_set_tooltip GtkStatusIcon* status_icon gchar* tooltip_text")
+;;; 3.14.0 (CFNC "void gtk_status_icon_set_visible GtkStatusIcon* status_icon gboolean visible")
+;;; 3.14.0 (CFNC "gboolean gtk_status_icon_get_visible GtkStatusIcon* status_icon")
+;;; 3.14.0 ;;; 2.90.7 (CFNC "void gtk_status_icon_set_blinking GtkStatusIcon* status_icon gboolean blinking")
+;;; 3.14.0 ;;; 2.90.7 (CFNC "gboolean gtk_status_icon_get_blinking GtkStatusIcon* status_icon")
+;;; 3.14.0 (CFNC "gboolean gtk_status_icon_is_embedded GtkStatusIcon* status_icon")
+;;; 3.14.0 (CFNC "void gtk_status_icon_position_menu GtkMenu* menu gint* [x] gint* [y] gboolean* [push_in] gpointer user_data")
(CFNC "GdkAtom gtk_text_buffer_register_serialize_format GtkTextBuffer* buffer gchar* mime_type GtkTextBufferSerializeFunc function gpointer user_data GDestroyNotify user_data_destroy")
(CFNC "GdkAtom gtk_text_buffer_register_serialize_tagset GtkTextBuffer* buffer gchar* tagset_name")
(CFNC "GdkAtom gtk_text_buffer_register_deserialize_format GtkTextBuffer* buffer gchar* mime_type GtkTextBufferDeserializeFunc function gpointer user_data GDestroyNotify user_data_destroy")
@@ -6699,7 +6661,7 @@
(CAIRO-FUNC "void cairo_matrix_transform_distance cairo_matrix_t* matrix gdouble* [dx] gdouble* [dy]")
(CAIRO-FUNC "void cairo_matrix_transform_point cairo_matrix_t* matrix gdouble* [x] gdouble* [y]")
-(CAIRO-STRUCT-make "cairo_matrix_t")
+;(CAIRO-STRUCT-make "cairo_matrix_t")
(CAIRO-PNG-FUNC "cairo_surface_t* cairo_image_surface_create_from_png char* filename" 'const)
@@ -6722,7 +6684,7 @@
(CFNC "void pango_cairo_error_underline_path cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
;(CFNC "cairo_t* gdk_cairo_create GdkDrawable* drawable") -- moved up
-(CFNC "void gdk_cairo_set_source_color cairo_t* cr GdkColor* color")
+;;; (CFNC-gtk2 "void gdk_cairo_set_source_color cairo_t* cr GdkColor* color")
(CFNC "void gdk_cairo_set_source_pixbuf cairo_t* cr GdkPixbuf* pixbuf gdouble pixbuf_x gdouble pixbuf_y")
;;; 2.91.0 (CFNC "void gdk_cairo_set_source_pixmap cairo_t* cr GdkPixmap* pixmap double pixmap_x double pixmap_y")
(CFNC "void gdk_cairo_rectangle cairo_t* cr GdkRectangle* rectangle")
@@ -6765,7 +6727,7 @@
(CINT "GTK_DRAG_RESULT_ERROR" "GtkDragResult")
-(CFNC "gchar* gdk_color_to_string GdkColor* color")
+;;; (CFNC-gtk2 "gchar* gdk_color_to_string GdkColor* color")
(CFNC "void gdk_event_request_motions GdkEventMotion* event")
(CFNC "void gdk_notify_startup_complete_with_id gchar* startup_id")
@@ -6777,7 +6739,7 @@
(CFNC "void gdk_window_set_startup_id GdkWindow* window gchar* startup_id")
(CFNC "void gdk_window_beep GdkWindow* window")
(CFNC "void gdk_window_set_opacity GdkWindow* window gdouble opacity")
-(CFNC "GtkWidget* gtk_action_create_menu GtkAction* action")
+;;; (CFNC "GtkWidget* gtk_action_create_menu GtkAction* action")
(CFNC "void gtk_binding_entry_skip GtkBindingSet* binding_set guint keyval GdkModifierType modifiers")
(CFNC "GList* gtk_cell_layout_get_cells GtkCellLayout* cell_layout")
(CFNC "void gtk_entry_completion_set_inline_selection GtkEntryCompletion* completion gboolean inline_selection")
@@ -6786,8 +6748,8 @@
(CFNC "void gtk_entry_set_cursor_hadjustment GtkEntry* entry GtkAdjustment* adjustment")
(CFNC "GtkAdjustment* gtk_entry_get_cursor_hadjustment GtkEntry* entry")
(CFNC "GList* gtk_icon_theme_list_contexts GtkIconTheme* icon_theme")
-(CFNC "GtkPageSetup* gtk_page_setup_new_from_file gchar* file_name GError** [error]")
-(CFNC "gboolean gtk_page_setup_to_file GtkPageSetup* setup char* file_name GError** [error]")
+;(CFNC "GtkPageSetup* gtk_page_setup_new_from_file gchar* file_name GError** [error]")
+;(CFNC "gboolean gtk_page_setup_to_file GtkPageSetup* setup char* file_name GError** [error]")
;(CFNC "GtkPageSetup* gtk_page_setup_new_from_key_file GKeyFile* key_file gchar* group_name GError** [error]")
;(CFNC "void gtk_page_setup_to_key_file GtkPageSetup* setup GKeyFile* key_file gchar* group_name")
;(CFNC "GtkPaperSize* gtk_paper_size_new_from_key_file GKeyFile* key_file gchar* group_name GError** [error]")
@@ -6806,8 +6768,8 @@
(CFNC "gboolean gtk_range_get_restrict_to_fill_level GtkRange* range")
(CFNC "void gtk_range_set_fill_level GtkRange* range gdouble fill_level")
(CFNC "gdouble gtk_range_get_fill_level GtkRange* range")
-(CFNC "void gtk_status_icon_set_screen GtkStatusIcon* status_icon GdkScreen* screen")
-(CFNC "GdkScreen* gtk_status_icon_get_screen GtkStatusIcon* status_icon")
+;;; 3.14.0 (CFNC "void gtk_status_icon_set_screen GtkStatusIcon* status_icon GdkScreen* screen")
+;;; 3.14.0 (CFNC "GdkScreen* gtk_status_icon_get_screen GtkStatusIcon* status_icon")
(CFNC "void gtk_tree_view_set_show_expanders GtkTreeView* tree_view gboolean enabled")
(CFNC "gboolean gtk_tree_view_get_show_expanders GtkTreeView* tree_view")
(CFNC "void gtk_tree_view_set_level_indentation GtkTreeView* tree_view gint indentation")
@@ -6818,14 +6780,14 @@
(CFNC "GtkWindow* gtk_widget_get_tooltip_window GtkWidget* widget")
(CFNC "void gtk_widget_trigger_tooltip_query GtkWidget* widget")
(CFNC "void gtk_window_set_startup_id GtkWindow* window gchar* startup_id")
-(CFNC "void gtk_window_set_opacity GtkWindow* window gdouble opacity")
-(CFNC "gdouble gtk_window_get_opacity GtkWindow* window")
+;;; 3.7.10 (CFNC "void gtk_window_set_opacity GtkWindow* window gdouble opacity")
+;;; 3.7.10 (CFNC "gdouble gtk_window_get_opacity GtkWindow* window")
;;; for 2.11.1:
-(CFNC "gboolean gdk_display_supports_composite GdkDisplay* display")
-(CFNC "void gdk_window_set_composited GdkWindow* window gboolean composited")
+;;; 3.15 (CFNC "gboolean gdk_display_supports_composite GdkDisplay* display")
+;;; 3.15 (CFNC "void gdk_window_set_composited GdkWindow* window gboolean composited")
(CFNC "void gtk_text_buffer_add_mark GtkTextBuffer* buffer GtkTextMark* mark GtkTextIter* where")
;;;(CFNC "void gtk_text_layout_invalidate_cursors GtkTextLayout* layout GtkTextIter* start GtkTextIter* end")
;;;(CFNC "void gtk_text_layout_cursors_changed GtkTextLayout* layout gint y gint old_height gint new_height")
@@ -6841,7 +6803,7 @@
;;; for 2.11.3
;;; new headers gtkbuildable builder (XML UI builder -- not important)
-(CSTR "GTK_STOCK_DISCARD")
+;;; (CSTR "GTK_STOCK_DISCARD")
;;;(CFNC "void gtk_text_layout_set_overwrite_mode GtkTextLayout* layout gboolean overwrite")
(CFNC "void gtk_tooltip_set_text GtkTooltip* tooltip gchar* text" 'const)
(CFNC "void gtk_tree_view_convert_widget_to_tree_coords GtkTreeView* tree_view gint wx gint wy gint* [tx] gint* [ty]")
@@ -6850,7 +6812,7 @@
(CFNC "void gtk_tree_view_convert_bin_window_to_widget_coords GtkTreeView* tree_view gint bx gint by gint* [wx] gint* [wy]")
(CFNC "void gtk_tree_view_convert_tree_to_bin_window_coords GtkTreeView* tree_view gint tx gint ty gint* [bx] gint* [by]")
(CFNC "void gtk_tree_view_convert_bin_window_to_tree_coords GtkTreeView* tree_view gint bx gint by gint* [tx] gint* [ty]")
-;this could be added when 211 is required (CFNC-gtk2 "void gtk_widget_modify_cursor GtkWidget* widget GdkColor* primary GdkColor* secondary")
+;;; ;this could be added when 211 is required (CFNC-gtk2 "void gtk_widget_modify_cursor GtkWidget* widget GdkColor* primary GdkColor* secondary")
(CFNC "void gtk_widget_set_tooltip_text GtkWidget* widget gchar* text" 'const)
(CFNC "gchar* gtk_widget_get_tooltip_text GtkWidget* widget")
(CFNC "void gtk_widget_set_tooltip_markup GtkWidget* widget gchar* markup" 'const)
@@ -6884,30 +6846,30 @@
(CCHK "GTK_IS_TOOLTIP(obj)" "GtkTooltip*")
-;;; for 2.13.0
-(CINT-213 "GTK_CALENDAR_SHOW_DETAILS" "GtkCalendarDisplayOptions")
-(CFNC-213 "void gtk_calendar_set_detail_func GtkCalendar* calendar GtkCalendarDetailFunc func gpointer data GDestroyNotify destroy")
-(CFNC-213 "void gtk_calendar_set_detail_width_chars GtkCalendar* calendar gint chars")
-(CFNC-213 "void gtk_calendar_set_detail_height_rows GtkCalendar* calendar gint rows")
-(CFNC-213 "gint gtk_calendar_get_detail_width_chars GtkCalendar* calendar")
-(CFNC-213 "gint gtk_calendar_get_detail_height_rows GtkCalendar* calendar")
-(CFNC-213 "gint gdk_screen_get_monitor_width_mm GdkScreen* screen gint monitor_num")
-(CFNC-213 "gint gdk_screen_get_monitor_height_mm GdkScreen* screen gint monitor_num")
-(CFNC-213 "gchar* gdk_screen_get_monitor_plug_name GdkScreen* screen gint monitor_num")
-(CFNC-213 "void gtk_tooltip_set_icon_from_icon_name GtkTooltip* tooltip gchar* icon_name GtkIconSize size" 'const)
-
-;(CFNC-213 "void gtk_test_init int* argcp char*** argvp ...")
-;(CFNC-213 "GtkWidget* gtk_test_find_widget GtkWidget* widget gchar* label_pattern GType widget_type" 'const)
-;(CFNC-213 "GtkWidget* gtk_test_create_widget GType widget_type gchar* first_property_name ..." 'const)
-;(CFNC-213 "GtkWidget* gtk_test_create_simple_window gchar* window_title gchar* dialog_text" 'const)
-;(CFNC-213 "GtkWidget* gtk_test_display_button_window gchar* window_title gchar* dialog_text ..." 'const)
-;(CFNC-213 "void gtk_test_slider_set_perc GtkWidget* widget double percentage")
-;(CFNC-213 "double gtk_test_slider_get_value GtkWidget* widget")
-;(CFNC-213 "gboolean gtk_test_spin_button_click GtkSpinButton* widget guint button gboolean upwards")
-;(CFNC-213 "gboolean gtk_test_widget_click GtkWidget* widget guint button GdkModifierType modifiers")
-;(CFNC-213 "gboolean gtk_test_widget_send_key GtkWidget* widget guint keyval GdkModifierType modifiers")
-;(CFNC-213 "void gtk_test_text_set GtkWidget* widget gchar* string" 'const)
-;(CFNC-213 "gchar* gtk_test_text_get GtkWidget* widget")
+;;; for 2.13.0, mostly deprecated in 3.19
+(CINT-2.14 "GTK_CALENDAR_SHOW_DETAILS" "GtkCalendarDisplayOptions")
+(CFNC-2.14 "void gtk_calendar_set_detail_func GtkCalendar* calendar GtkCalendarDetailFunc func gpointer data GDestroyNotify destroy")
+(CFNC-2.14 "void gtk_calendar_set_detail_width_chars GtkCalendar* calendar gint chars")
+(CFNC-2.14 "void gtk_calendar_set_detail_height_rows GtkCalendar* calendar gint rows")
+(CFNC-2.14 "gint gtk_calendar_get_detail_width_chars GtkCalendar* calendar")
+(CFNC-2.14 "gint gtk_calendar_get_detail_height_rows GtkCalendar* calendar")
+(CFNC-2.14 "gint gdk_screen_get_monitor_width_mm GdkScreen* screen gint monitor_num")
+(CFNC-2.14 "gint gdk_screen_get_monitor_height_mm GdkScreen* screen gint monitor_num")
+(CFNC-2.14 "gchar* gdk_screen_get_monitor_plug_name GdkScreen* screen gint monitor_num")
+;;; (CFNC-2.14 "void gtk_tooltip_set_icon_from_icon_name GtkTooltip* tooltip gchar* icon_name GtkIconSize size" 'const)
+
+;(CFNC-2.14 "void gtk_test_init int* argcp char*** argvp ...")
+;(CFNC-2.14 "GtkWidget* gtk_test_find_widget GtkWidget* widget gchar* label_pattern GType widget_type" 'const)
+;(CFNC-2.14 "GtkWidget* gtk_test_create_widget GType widget_type gchar* first_property_name ..." 'const)
+;(CFNC-2.14 "GtkWidget* gtk_test_create_simple_window gchar* window_title gchar* dialog_text" 'const)
+;(CFNC-2.14 "GtkWidget* gtk_test_display_button_window gchar* window_title gchar* dialog_text ..." 'const)
+;(CFNC-2.14 "void gtk_test_slider_set_perc GtkWidget* widget double percentage")
+;(CFNC-2.14 "double gtk_test_slider_get_value GtkWidget* widget")
+;(CFNC-2.14 "gboolean gtk_test_spin_button_click GtkSpinButton* widget guint button gboolean upwards")
+;(CFNC-2.14 "gboolean gtk_test_widget_click GtkWidget* widget guint button GdkModifierType modifiers")
+;(CFNC-2.14 "gboolean gtk_test_widget_send_key GtkWidget* widget guint keyval GdkModifierType modifiers")
+;(CFNC-2.14 "void gtk_test_text_set GtkWidget* widget gchar* string" 'const)
+;(CFNC-2.14 "gchar* gtk_test_text_get GtkWidget* widget")
(CAIRO-FUNC "void cairo_path_extents cairo_t* cr double* [x1] double* [y1] double* [x2] double* [y2]")
@@ -6941,538 +6903,542 @@
;;; gtk 2.13.4
-(CFNC-2134 "gboolean gtk_accel_group_get_is_locked GtkAccelGroup* accel_group")
-(CFNC-2134 "GtkWidget* gtk_color_selection_dialog_get_color_selection GtkColorSelectionDialog* colorsel")
-(CFNC-2134 "GtkWidget* gtk_container_get_focus_child GtkContainer* container")
-(CFNC-2134 "GtkWidget* gtk_dialog_get_action_area GtkDialog* dialog")
-(CFNC-2134 "GtkWidget* gtk_dialog_get_content_area GtkDialog* dialog")
-(CFNC-2134 "void gtk_entry_set_overwrite_mode GtkEntry* entry gboolean overwrite")
-(CFNC-2134 "gboolean gtk_entry_get_overwrite_mode GtkEntry* entry")
-(CFNC-2134 "guint16 gtk_entry_get_text_length GtkEntry* entry")
-;;; out 2.13.7 (CFNC-2134 "GtkWidget* gtk_font_selection_get_family_entry GtkFontSelection* fontsel")
-(CFNC-2134 "GtkWidget* gtk_font_selection_get_family_list GtkFontSelection* fontsel")
-;;; out 2.13.7 (CFNC-2134 "GtkWidget* gtk_font_selection_get_face_entry GtkFontSelection* fontsel")
-(CFNC-2134 "GtkWidget* gtk_font_selection_get_face_list GtkFontSelection* fontsel")
-(CFNC-2134 "GtkWidget* gtk_font_selection_get_size_entry GtkFontSelection* fontsel")
-(CFNC-2134 "GtkWidget* gtk_font_selection_get_size_list GtkFontSelection* fontsel")
-(CFNC-2134 "GtkWidget* gtk_font_selection_get_preview_entry GtkFontSelection* fontsel")
-(CFNC-2134 "PangoFontFamily* gtk_font_selection_get_family GtkFontSelection* fontsel")
-(CFNC-2134 "PangoFontFace* gtk_font_selection_get_face GtkFontSelection* fontsel")
-(CFNC-2134 "gint gtk_font_selection_get_size GtkFontSelection* fontsel")
-(CFNC-2134 "GtkWidget* gtk_font_selection_dialog_get_ok_button GtkFontSelectionDialog* fsd")
-;;; out 2.15.0 (CFNC-2134 "GtkWidget* gtk_font_selection_dialog_get_apply_button GtkFontSelectionDialog* fsd")
-(CFNC-2134 "GtkWidget* gtk_font_selection_dialog_get_cancel_button GtkFontSelectionDialog* fsd")
-(CFNC-2134 "gboolean gtk_handle_box_get_child_detached GtkHandleBox* handle_box")
-(CFNC-2134 "GdkWindow* gtk_layout_get_bin_window GtkLayout* layout")
-(CFNC-2134 "gchar* gtk_menu_get_accel_path GtkMenu* menu" 'const)
-(CFNC-2134 "gint gtk_menu_get_monitor GtkMenu* menu")
-(CFNC-2134 "gchar* gtk_menu_item_get_accel_path GtkMenuItem* menu_item" 'const)
-;(CFNC-2134 "GtkWidget* gtk_message_dialog_get_image GtkMessageDialog* dialog")
-;;; 2.99.3 (CFNC-2134 "gboolean gtk_plug_get_embedded GtkPlug* plug")
-;;; 2.99.3 (CFNC-2134 "GdkWindow* gtk_plug_get_socket_window GtkPlug* plug")
-;;; out 2.15.1 (CFNC-2134 "GtkOrientation gtk_scale_button_get_orientation GtkScaleButton* button")
-;;; (CFNC-2134 "void gtk_scale_button_set_orientation GtkScaleButton* button GtkOrientation orientation")
-(CFNC-2134 "GtkWidget* gtk_scale_button_get_plus_button GtkScaleButton* button")
-(CFNC-2134 "GtkWidget* gtk_scale_button_get_minus_button GtkScaleButton* button")
-(CFNC-2134 "GtkWidget* gtk_scale_button_get_popup GtkScaleButton* button")
-(CFNC-2134 "GdkAtom gtk_selection_data_get_target GtkSelectionData* selection_data")
-(CFNC-2134 "GdkAtom gtk_selection_data_get_data_type GtkSelectionData* selection_data")
-(CFNC-2134 "gint gtk_selection_data_get_format GtkSelectionData* selection_data")
-;;; changed 2.14.1 (CFNC-2134 "guchar* gtk_selection_data_get_data GtkSelectionData* selection_data guint* length" 'const)
-(CFNC-2134 "GdkDisplay* gtk_selection_data_get_display GtkSelectionData* selection_data")
-;;; 2.99.3 (CFNC-2134 "GdkWindow* gtk_socket_get_plug_window GtkSocket* socket_")
-;;out 2.14.1 ;(CFNC-2134 "GtkAllocation gtk_widget_get_allocation GtkWidget* widget")
-(CFNC-2134 "GdkWindow* gtk_widget_get_window GtkWidget* widget")
-;;; (CFNC-2134 "GtkWidget* gtk_window_get_default GtkWindow* window")
-(CFNC-2134 "GdkModifierType gtk_accel_group_get_modifier_mask GtkAccelGroup* accel_group")
-
-
-(STRUCT-make "GdkColor guint32 &pixel guint16 &red guint16 &green guint16 &blue")
+(CFNC-2.14 "gboolean gtk_accel_group_get_is_locked GtkAccelGroup* accel_group")
+;;; 3.3.16 (CFNC-2.14 "GtkWidget* gtk_color_selection_dialog_get_color_selection GtkColorSelectionDialog* colorsel")
+(CFNC-2.14 "GtkWidget* gtk_container_get_focus_child GtkContainer* container")
+;;; 3.12? (CFNC-2.14 "GtkWidget* gtk_dialog_get_action_area GtkDialog* dialog")
+(CFNC-2.14 "GtkWidget* gtk_dialog_get_content_area GtkDialog* dialog")
+(CFNC-2.14 "void gtk_entry_set_overwrite_mode GtkEntry* entry gboolean overwrite")
+(CFNC-2.14 "gboolean gtk_entry_get_overwrite_mode GtkEntry* entry")
+(CFNC-2.14 "guint16 gtk_entry_get_text_length GtkEntry* entry")
+
+;;; out 2.13.7 (CFNC-2.14 "GtkWidget* gtk_font_selection_get_family_entry GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "GtkWidget* gtk_font_selection_get_family_list GtkFontSelection* fontsel")
+;;; out 2.13.7 (CFNC-2.14 "GtkWidget* gtk_font_selection_get_face_entry GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "GtkWidget* gtk_font_selection_get_face_list GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "GtkWidget* gtk_font_selection_get_size_entry GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "GtkWidget* gtk_font_selection_get_size_list GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "GtkWidget* gtk_font_selection_get_preview_entry GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "PangoFontFamily* gtk_font_selection_get_family GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "PangoFontFace* gtk_font_selection_get_face GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "gint gtk_font_selection_get_size GtkFontSelection* fontsel")
+;;; 3.1.12 (CFNC-2.14 "GtkWidget* gtk_font_selection_dialog_get_ok_button GtkFontSelectionDialog* fsd")
+;;; out 2.15.0 (CFNC-2.14 "GtkWidget* gtk_font_selection_dialog_get_apply_button GtkFontSelectionDialog* fsd")
+;;; 3.1.12 (CFNC-2.14 "GtkWidget* gtk_font_selection_dialog_get_cancel_button GtkFontSelectionDialog* fsd")
+
+;;; 3.3.2 (CFNC-2.14 "gboolean gtk_handle_box_get_child_detached GtkHandleBox* handle_box")
+(CFNC-2.14 "GdkWindow* gtk_layout_get_bin_window GtkLayout* layout")
+(CFNC-2.14 "gchar* gtk_menu_get_accel_path GtkMenu* menu" 'const)
+(CFNC-2.14 "gint gtk_menu_get_monitor GtkMenu* menu")
+(CFNC-2.14 "gchar* gtk_menu_item_get_accel_path GtkMenuItem* menu_item" 'const)
+;(CFNC-2.14 "GtkWidget* gtk_message_dialog_get_image GtkMessageDialog* dialog")
+;;; 2.99.3 (CFNC-2.14 "gboolean gtk_plug_get_embedded GtkPlug* plug")
+;;; 2.99.3 (CFNC-2.14 "GdkWindow* gtk_plug_get_socket_window GtkPlug* plug")
+;;; out 2.15.1 (CFNC-2.14 "GtkOrientation gtk_scale_button_get_orientation GtkScaleButton* button")
+;;; (CFNC-2.14 "void gtk_scale_button_set_orientation GtkScaleButton* button GtkOrientation orientation")
+(CFNC-2.14 "GtkWidget* gtk_scale_button_get_plus_button GtkScaleButton* button")
+(CFNC-2.14 "GtkWidget* gtk_scale_button_get_minus_button GtkScaleButton* button")
+(CFNC-2.14 "GtkWidget* gtk_scale_button_get_popup GtkScaleButton* button")
+(CFNC-2.14 "GdkAtom gtk_selection_data_get_target GtkSelectionData* selection_data")
+(CFNC-2.14 "GdkAtom gtk_selection_data_get_data_type GtkSelectionData* selection_data")
+(CFNC-2.14 "gint gtk_selection_data_get_format GtkSelectionData* selection_data")
+;;; changed 2.14.1 (CFNC-2.14 "guchar* gtk_selection_data_get_data GtkSelectionData* selection_data guint* length" 'const)
+(CFNC-2.14 "GdkDisplay* gtk_selection_data_get_display GtkSelectionData* selection_data")
+;;; 2.99.3 (CFNC-2.14 "GdkWindow* gtk_socket_get_plug_window GtkSocket* socket_")
+;;out 2.14.1 ;(CFNC-2.14 "GtkAllocation gtk_widget_get_allocation GtkWidget* widget")
+(CFNC-2.14 "GdkWindow* gtk_widget_get_window GtkWidget* widget")
+;;; (CFNC-2.14 "GtkWidget* gtk_window_get_default GtkWindow* window")
+(CFNC-2.14 "GdkModifierType gtk_accel_group_get_modifier_mask GtkAccelGroup* accel_group")
+
+
+;;; 3.3.8 (STRUCT-make "GdkColor guint32 &pixel guint16 &red guint16 &green guint16 &blue")
;;; out 2.90.4 (STRUCT-make "GdkCursor GdkCursorType type guint ref_count")
;;; (STRUCT-make "GdkPoint gint x gint y")
;;; (STRUCT-make "GdkRectangle gint x gint y gint width gint height")
;;; (STRUCT-make "GtkRequisition gint width gint height")
;;; (STRUCT-make "GtkStockItem")
-(STRUCT-make "GtkTextIter")
-(STRUCT-make "GtkTreeIter")
+;(STRUCT-make "GtkTextIter")
+;(STRUCT-make "GtkTreeIter")
;;; (STRUCT-make "PangoColor")
-(STRUCT-make "PangoRectangle")
+;(STRUCT-make "PangoRectangle")
;;; (STRUCT-make "PangoLogAttr")
;;; (STRUCT "GdkEventKey GdkEventType type GdkWindow* window guint32 time guint state guint keyval")
;;; gtk 1.13.6
-(CINT-2134 "GDK_CROSSING_GTK_GRAB" "GdkCrossingMode")
-(CINT-2134 "GDK_CROSSING_GTK_UNGRAB" "GdkCrossingMode")
-(CINT-2134 "GDK_CROSSING_STATE_CHANGED" "GdkCrossingMode")
-
-
-(CFNC-2134 "guint gdk_threads_add_timeout_seconds_full gint priority guint interval GSourceFunc function lambda_data func_info GDestroyNotify notify")
-(CFNC-2134 "guint gdk_threads_add_timeout_seconds guint interval GSourceFunc function lambda_data #func_info")
-(CFNC-2134 "gdouble gtk_adjustment_get_lower GtkAdjustment* adjustment")
-(CFNC-2134 "void gtk_adjustment_set_lower GtkAdjustment* adjustment gdouble lower")
-(CFNC-2134 "gdouble gtk_adjustment_get_upper GtkAdjustment* adjustment")
-(CFNC-2134 "void gtk_adjustment_set_upper GtkAdjustment* adjustment gdouble upper")
-(CFNC-2134 "gdouble gtk_adjustment_get_step_increment GtkAdjustment* adjustment")
-(CFNC-2134 "void gtk_adjustment_set_step_increment GtkAdjustment* adjustment gdouble step_increment")
-(CFNC-2134 "gdouble gtk_adjustment_get_page_increment GtkAdjustment* adjustment")
-(CFNC-2134 "void gtk_adjustment_set_page_increment GtkAdjustment* adjustment gdouble page_increment")
-(CFNC-2134 "gdouble gtk_adjustment_get_page_size GtkAdjustment* adjustment")
-(CFNC-2134 "void gtk_adjustment_set_page_size GtkAdjustment* adjustment gdouble page_size")
-(CFNC-2134 "void gtk_adjustment_configure GtkAdjustment* adjustment gdouble value gdouble lower gdouble upper gdouble step_increment gdouble page_increment gdouble page_size")
-(CFNC-2134 "void gtk_combo_box_set_button_sensitivity GtkComboBox* combo_box GtkSensitivityType sensitivity")
-(CFNC-2134 "GtkSensitivityType gtk_combo_box_get_button_sensitivity GtkComboBox* combo_box")
-(CFNC-2134 "GFile* gtk_file_chooser_get_file GtkFileChooser* chooser")
-(CFNC-2134 "gboolean gtk_file_chooser_set_file GtkFileChooser* chooser GFile* file GError** [error]")
-(CFNC-2134 "gboolean gtk_file_chooser_select_file GtkFileChooser* chooser GFile* file GError** [error]")
-(CFNC-2134 "void gtk_file_chooser_unselect_file GtkFileChooser* chooser GFile* file")
-(CFNC-2134 "GSList* gtk_file_chooser_get_files GtkFileChooser* chooser")
-(CFNC-2134 "gboolean gtk_file_chooser_set_current_folder_file GtkFileChooser* chooser GFile* file GError** [error]")
-(CFNC-2134 "GFile* gtk_file_chooser_get_current_folder_file GtkFileChooser* chooser")
-(CFNC-2134 "GFile* gtk_file_chooser_get_preview_file GtkFileChooser* chooser")
-
-(CFNC-2134 "GtkWidget* gtk_window_get_default_widget GtkWindow* window")
+(CINT-2.14 "GDK_CROSSING_GTK_GRAB" "GdkCrossingMode")
+(CINT-2.14 "GDK_CROSSING_GTK_UNGRAB" "GdkCrossingMode")
+(CINT-2.14 "GDK_CROSSING_STATE_CHANGED" "GdkCrossingMode")
+
+
+(CFNC-2.14 "guint gdk_threads_add_timeout_seconds_full gint priority guint interval GSourceFunc function lambda_data func_info GDestroyNotify notify")
+(CFNC-2.14 "guint gdk_threads_add_timeout_seconds guint interval GSourceFunc function lambda_data #func_info")
+(CFNC-2.14 "gdouble gtk_adjustment_get_lower GtkAdjustment* adjustment")
+(CFNC-2.14 "void gtk_adjustment_set_lower GtkAdjustment* adjustment gdouble lower")
+(CFNC-2.14 "gdouble gtk_adjustment_get_upper GtkAdjustment* adjustment")
+(CFNC-2.14 "void gtk_adjustment_set_upper GtkAdjustment* adjustment gdouble upper")
+(CFNC-2.14 "gdouble gtk_adjustment_get_step_increment GtkAdjustment* adjustment")
+(CFNC-2.14 "void gtk_adjustment_set_step_increment GtkAdjustment* adjustment gdouble step_increment")
+(CFNC-2.14 "gdouble gtk_adjustment_get_page_increment GtkAdjustment* adjustment")
+(CFNC-2.14 "void gtk_adjustment_set_page_increment GtkAdjustment* adjustment gdouble page_increment")
+(CFNC-2.14 "gdouble gtk_adjustment_get_page_size GtkAdjustment* adjustment")
+(CFNC-2.14 "void gtk_adjustment_set_page_size GtkAdjustment* adjustment gdouble page_size")
+(CFNC-2.14 "void gtk_adjustment_configure GtkAdjustment* adjustment gdouble value gdouble lower gdouble upper gdouble step_increment gdouble page_increment gdouble page_size")
+(CFNC-2.14 "void gtk_combo_box_set_button_sensitivity GtkComboBox* combo_box GtkSensitivityType sensitivity")
+(CFNC-2.14 "GtkSensitivityType gtk_combo_box_get_button_sensitivity GtkComboBox* combo_box")
+(CFNC-2.14 "GFile* gtk_file_chooser_get_file GtkFileChooser* chooser")
+(CFNC-2.14 "gboolean gtk_file_chooser_set_file GtkFileChooser* chooser GFile* file GError** [error]")
+(CFNC-2.14 "gboolean gtk_file_chooser_select_file GtkFileChooser* chooser GFile* file GError** [error]")
+(CFNC-2.14 "void gtk_file_chooser_unselect_file GtkFileChooser* chooser GFile* file")
+(CFNC-2.14 "GSList* gtk_file_chooser_get_files GtkFileChooser* chooser")
+(CFNC-2.14 "gboolean gtk_file_chooser_set_current_folder_file GtkFileChooser* chooser GFile* file GError** [error]")
+(CFNC-2.14 "GFile* gtk_file_chooser_get_current_folder_file GtkFileChooser* chooser")
+(CFNC-2.14 "GFile* gtk_file_chooser_get_preview_file GtkFileChooser* chooser")
+
+(CFNC-2.14 "GtkWidget* gtk_window_get_default_widget GtkWindow* window")
;;; gtkdestroynotify -> gdestroynotify
-(CINT-2150 "GTK_ENTRY_ICON_PRIMARY" "GtkEntryIconPosition")
-(CINT-2150 "GTK_ENTRY_ICON_SECONDARY" "GtkEntryIconPosition")
-
-(CINT-2150 "GTK_ARROWS_BOTH" "GtkArrowPlacement")
-(CINT-2150 "GTK_ARROWS_START" "GtkArrowPlacement")
-(CINT-2150 "GTK_ARROWS_END" "GtkArrowPlacement")
-
-(CFNC-2150 "gboolean gtk_link_button_get_visited GtkLinkButton* link_button")
-(CFNC-2150 "void gtk_link_button_set_visited GtkLinkButton* link_button bool visited")
-(CFNC-2150 "gboolean gdk_keymap_get_caps_lock_state GdkKeymap* keymap")
-(CFNC-2150 "GtkTreeModel* gtk_cell_view_get_model GtkCellView* cell_view")
-(CFNC-2150 "void gtk_entry_unset_invisible_char GtkEntry* entry")
-(CFNC-2150 "void gtk_entry_set_progress_fraction GtkEntry* entry gdouble fraction")
-(CFNC-2150 "gdouble gtk_entry_get_progress_fraction GtkEntry* entry")
-(CFNC-2150 "void gtk_entry_set_progress_pulse_step GtkEntry* entry gdouble fraction")
-(CFNC-2150 "gdouble gtk_entry_get_progress_pulse_step GtkEntry* entry")
-(CFNC-2150 "void gtk_entry_progress_pulse GtkEntry* entry")
-(CFNC-2150 "void gtk_entry_set_icon_from_pixbuf GtkEntry* entry GtkEntryIconPosition icon_pos GdkPixbuf* pixbuf")
-(CFNC-2150 "void gtk_entry_set_icon_from_stock GtkEntry* entry GtkEntryIconPosition icon_pos gchar* stock_id")
-(CFNC-2150 "void gtk_entry_set_icon_from_icon_name GtkEntry* entry GtkEntryIconPosition icon_pos gchar* icon_name")
-(CFNC-2150 "void gtk_entry_set_icon_from_gicon GtkEntry* entry GtkEntryIconPosition icon_pos GIcon* icon")
-;??? (CFNC-2150 "GtkImageType gtk_entry_get_storage_type GtkEntry* entry GtkEntryIconPosition icon_pos")
-;??? (CFNC-2150 "GdkPixbuf* gtk_entry_get_pixbuf GtkEntry* entry GtkEntryIconPosition icon_pos")
-;??? (CFNC-2150 "gchar* gtk_entry_get_stock GtkEntry* entry GtkEntryIconPosition icon_pos" 'const)
-(CFNC-2150 "gchar* gtk_entry_get_icon_name GtkEntry* entry GtkEntryIconPosition icon_pos" 'const)
-;??? (CFNC-2150 "GIcon* gtk_entry_get_gicon GtkEntry* entry GtkEntryIconPosition icon_pos")
-(CFNC-2150 "void gtk_entry_set_icon_activatable GtkEntry* entry GtkEntryIconPosition icon_pos gboolean activatable")
-(CFNC-2150 "gboolean gtk_entry_get_icon_activatable GtkEntry* entry GtkEntryIconPosition icon_pos")
-(CFNC-2150 "void gtk_entry_set_icon_sensitive GtkEntry* entry GtkEntryIconPosition icon_pos gboolean sensitive")
-(CFNC-2150 "gboolean gtk_entry_get_icon_sensitive GtkEntry* entry GtkEntryIconPosition icon_pos")
-(CFNC-2150 "gint gtk_entry_get_icon_at_pos GtkEntry* entry gint x gint y")
-(CFNC-2150 "void gtk_entry_set_icon_tooltip_text GtkEntry* entry GtkEntryIconPosition icon_pos gchar* tooltip")
-(CFNC-2150 "void gtk_entry_set_icon_tooltip_markup GtkEntry* entry GtkEntryIconPosition icon_pos gchar* tooltip")
-(CFNC-2150 "void gtk_entry_set_icon_drag_source GtkEntry* entry GtkEntryIconPosition icon_pos GtkTargetList* target_list GdkDragAction actions")
-(CFNC-2150 "gint gtk_entry_get_current_icon_drag_source GtkEntry* entry")
-(CFNC-2150 "void gtk_image_menu_item_set_use_stock GtkImageMenuItem* image_menu_item gboolean use_stock")
-(CFNC-2150 "gboolean gtk_image_menu_item_get_use_stock GtkImageMenuItem* image_menu_item")
-(CFNC-2150 "void gtk_image_menu_item_set_accel_group GtkImageMenuItem* image_menu_item GtkAccelGroup* accel_group")
-(CFNC-2150 "void gtk_menu_item_set_label GtkMenuItem* menu_item gchar* label")
-(CFNC-2150 "gchar* gtk_menu_item_get_label GtkMenuItem* menu_item" 'const)
-(CFNC-2150 "void gtk_menu_item_set_use_underline GtkMenuItem* menu_item gboolean setting")
-(CFNC-2150 "gboolean gtk_menu_item_get_use_underline GtkMenuItem* menu_item")
-(CFNC-2150 "GdkAtom gtk_selection_data_get_selection GtkSelectionData* selection_data")
+(CINT-2.16 "GTK_ENTRY_ICON_PRIMARY" "GtkEntryIconPosition")
+(CINT-2.16 "GTK_ENTRY_ICON_SECONDARY" "GtkEntryIconPosition")
+
+;;; 3.13.2 (CINT-2.16 "GTK_ARROWS_BOTH" "GtkArrowPlacement")
+;;; 3.13.2 (CINT-2.16 "GTK_ARROWS_START" "GtkArrowPlacement")
+;;; 3.13.2 (CINT-2.16 "GTK_ARROWS_END" "GtkArrowPlacement")
+
+(CFNC-2.16 "gboolean gtk_link_button_get_visited GtkLinkButton* link_button")
+(CFNC-2.16 "void gtk_link_button_set_visited GtkLinkButton* link_button bool visited")
+(CFNC-2.16 "gboolean gdk_keymap_get_caps_lock_state GdkKeymap* keymap")
+(CFNC-2.16 "GtkTreeModel* gtk_cell_view_get_model GtkCellView* cell_view")
+(CFNC-2.16 "void gtk_entry_unset_invisible_char GtkEntry* entry")
+(CFNC-2.16 "void gtk_entry_set_progress_fraction GtkEntry* entry gdouble fraction")
+(CFNC-2.16 "gdouble gtk_entry_get_progress_fraction GtkEntry* entry")
+(CFNC-2.16 "void gtk_entry_set_progress_pulse_step GtkEntry* entry gdouble fraction")
+(CFNC-2.16 "gdouble gtk_entry_get_progress_pulse_step GtkEntry* entry")
+(CFNC-2.16 "void gtk_entry_progress_pulse GtkEntry* entry")
+(CFNC-2.16 "void gtk_entry_set_icon_from_pixbuf GtkEntry* entry GtkEntryIconPosition icon_pos GdkPixbuf* pixbuf")
+;;; 3.9.8 (CFNC-2.16 "void gtk_entry_set_icon_from_stock GtkEntry* entry GtkEntryIconPosition icon_pos gchar* stock_id")
+(CFNC-2.16 "void gtk_entry_set_icon_from_icon_name GtkEntry* entry GtkEntryIconPosition icon_pos gchar* icon_name")
+(CFNC-2.16 "void gtk_entry_set_icon_from_gicon GtkEntry* entry GtkEntryIconPosition icon_pos GIcon* icon")
+;??? (CFNC-2.16 "GtkImageType gtk_entry_get_storage_type GtkEntry* entry GtkEntryIconPosition icon_pos")
+;??? (CFNC-2.16 "GdkPixbuf* gtk_entry_get_pixbuf GtkEntry* entry GtkEntryIconPosition icon_pos")
+;??? (CFNC-2.16 "gchar* gtk_entry_get_stock GtkEntry* entry GtkEntryIconPosition icon_pos" 'const)
+(CFNC-2.16 "gchar* gtk_entry_get_icon_name GtkEntry* entry GtkEntryIconPosition icon_pos" 'const)
+;??? (CFNC-2.16 "GIcon* gtk_entry_get_gicon GtkEntry* entry GtkEntryIconPosition icon_pos")
+(CFNC-2.16 "void gtk_entry_set_icon_activatable GtkEntry* entry GtkEntryIconPosition icon_pos gboolean activatable")
+(CFNC-2.16 "gboolean gtk_entry_get_icon_activatable GtkEntry* entry GtkEntryIconPosition icon_pos")
+(CFNC-2.16 "void gtk_entry_set_icon_sensitive GtkEntry* entry GtkEntryIconPosition icon_pos gboolean sensitive")
+(CFNC-2.16 "gboolean gtk_entry_get_icon_sensitive GtkEntry* entry GtkEntryIconPosition icon_pos")
+(CFNC-2.16 "gint gtk_entry_get_icon_at_pos GtkEntry* entry gint x gint y")
+(CFNC-2.16 "void gtk_entry_set_icon_tooltip_text GtkEntry* entry GtkEntryIconPosition icon_pos gchar* tooltip")
+(CFNC-2.16 "void gtk_entry_set_icon_tooltip_markup GtkEntry* entry GtkEntryIconPosition icon_pos gchar* tooltip")
+(CFNC-2.16 "void gtk_entry_set_icon_drag_source GtkEntry* entry GtkEntryIconPosition icon_pos GtkTargetList* target_list GdkDragAction actions")
+(CFNC-2.16 "gint gtk_entry_get_current_icon_drag_source GtkEntry* entry")
+;;; (CFNC-2.16 "void gtk_image_menu_item_set_use_stock GtkImageMenuItem* image_menu_item gboolean use_stock")
+;;; (CFNC-2.16 "gboolean gtk_image_menu_item_get_use_stock GtkImageMenuItem* image_menu_item")
+;;; (CFNC-2.16 "void gtk_image_menu_item_set_accel_group GtkImageMenuItem* image_menu_item GtkAccelGroup* accel_group")
+(CFNC-2.16 "void gtk_menu_item_set_label GtkMenuItem* menu_item gchar* label")
+(CFNC-2.16 "gchar* gtk_menu_item_get_label GtkMenuItem* menu_item" 'const)
+(CFNC-2.16 "void gtk_menu_item_set_use_underline GtkMenuItem* menu_item gboolean setting")
+(CFNC-2.16 "gboolean gtk_menu_item_get_use_underline GtkMenuItem* menu_item")
+(CFNC-2.16 "GdkAtom gtk_selection_data_get_selection GtkSelectionData* selection_data")
;;; 2.15.1
-(CINT-2150 "GDK_BLANK_CURSOR " "GdkCursorType")
-(CSTR-2150 "GTK_STOCK_CAPS_LOCK_WARNING")
-
-(CFNC-2150 "void gtk_action_set_label GtkAction* action gchar* label")
-(CFNC-2150 "gchar* gtk_action_get_label GtkAction* action")
-(CFNC-2150 "void gtk_action_set_short_label GtkAction* action gchar* short_label")
-(CFNC-2150 "gchar* gtk_action_get_short_label GtkAction* action")
-(CFNC-2150 "void gtk_action_set_tooltip GtkAction* action gchar* tooltip")
-(CFNC-2150 "gchar* gtk_action_get_tooltip GtkAction* action")
-(CFNC-2150 "void gtk_action_set_stock_id GtkAction* action gchar* stock_id")
-(CFNC-2150 "gchar* gtk_action_get_stock_id GtkAction* action")
-(CFNC-2150 "void gtk_action_set_gicon GtkAction* action GIcon* icon")
-(CFNC-2150 "GIcon* gtk_action_get_gicon GtkAction* action")
-(CFNC-2150 "void gtk_action_set_icon_name GtkAction* action gchar* icon_name")
-(CFNC-2150 "gchar* gtk_action_get_icon_name GtkAction* action")
-(CFNC-2150 "void gtk_action_set_visible_horizontal GtkAction* action gboolean visible_horizontal")
-(CFNC-2150 "gboolean gtk_action_get_visible_horizontal GtkAction* action")
-(CFNC-2150 "void gtk_action_set_visible_vertical GtkAction* action gboolean visible_vertical")
-(CFNC-2150 "gboolean gtk_action_get_visible_vertical GtkAction* action")
-(CFNC-2150 "void gtk_action_set_is_important GtkAction* action gboolean is_important")
-(CFNC-2150 "gboolean gtk_action_get_is_important GtkAction* action")
-(CFNC-2150 "gchar* gtk_entry_get_icon_tooltip_text GtkEntry* entry GtkEntryIconPosition icon_pos")
-(CFNC-2150 "gchar* gtk_entry_get_icon_tooltip_markup GtkEntry* entry GtkEntryIconPosition icon_pos")
-(CFNC-2150 "void gtk_scale_add_mark GtkScale* scale gdouble value GtkPositionType position gchar* markup")
-(CFNC-2150 "void gtk_scale_clear_marks GtkScale* scale")
+(CINT-2.16 "GDK_BLANK_CURSOR " "GdkCursorType")
+;;; (CSTR-2.16 "GTK_STOCK_CAPS_LOCK_WARNING")
+
+;;; 3.9.8
+;;; (CFNC-2.16 "void gtk_action_set_label GtkAction* action gchar* label")
+;;; (CFNC-2.16 "gchar* gtk_action_get_label GtkAction* action")
+;;; (CFNC-2.16 "void gtk_action_set_short_label GtkAction* action gchar* short_label")
+;;; (CFNC-2.16 "gchar* gtk_action_get_short_label GtkAction* action")
+;;; (CFNC-2.16 "void gtk_action_set_tooltip GtkAction* action gchar* tooltip")
+;;; (CFNC-2.16 "gchar* gtk_action_get_tooltip GtkAction* action")
+;;; (CFNC-2.16 "void gtk_action_set_stock_id GtkAction* action gchar* stock_id")
+;;; (CFNC-2.16 "gchar* gtk_action_get_stock_id GtkAction* action")
+;;; (CFNC-2.16 "void gtk_action_set_gicon GtkAction* action GIcon* icon")
+;;; (CFNC-2.16 "GIcon* gtk_action_get_gicon GtkAction* action")
+;;; (CFNC-2.16 "void gtk_action_set_icon_name GtkAction* action gchar* icon_name")
+;;; (CFNC-2.16 "gchar* gtk_action_get_icon_name GtkAction* action")
+;;; (CFNC-2.16 "void gtk_action_set_visible_horizontal GtkAction* action gboolean visible_horizontal")
+;;; (CFNC-2.16 "gboolean gtk_action_get_visible_horizontal GtkAction* action")
+;;; (CFNC-2.16 "void gtk_action_set_visible_vertical GtkAction* action gboolean visible_vertical")
+;;; (CFNC-2.16 "gboolean gtk_action_get_visible_vertical GtkAction* action")
+;;; (CFNC-2.16 "void gtk_action_set_is_important GtkAction* action gboolean is_important")
+;;; (CFNC-2.16 "gboolean gtk_action_get_is_important GtkAction* action")
+
+(CFNC-2.16 "gchar* gtk_entry_get_icon_tooltip_text GtkEntry* entry GtkEntryIconPosition icon_pos")
+(CFNC-2.16 "gchar* gtk_entry_get_icon_tooltip_markup GtkEntry* entry GtkEntryIconPosition icon_pos")
+(CFNC-2.16 "void gtk_scale_add_mark GtkScale* scale gdouble value GtkPositionType position gchar* markup")
+(CFNC-2.16 "void gtk_scale_clear_marks GtkScale* scale")
;;; 2.15.2 (these on 2.17.2)
-(CFNC-2172 "void gtk_image_menu_item_set_always_show_image GtkImageMenuItem* image_menu_item gboolean always_show")
-(CFNC-2172 "gboolean gtk_image_menu_item_get_always_show_image GtkImageMenuItem* image_menu_item")
+;;; (CFNC-2.18 "void gtk_image_menu_item_set_always_show_image GtkImageMenuItem* image_menu_item gboolean always_show")
+;;; (CFNC-2.18 "gboolean gtk_image_menu_item_get_always_show_image GtkImageMenuItem* image_menu_item")
-(CINT-2172 "PANGO_WEIGHT_THIN" "PangoWeight")
-(CINT-2172 "PANGO_WEIGHT_BOOK" "PangoWeight")
-(CINT-2172 "PANGO_WEIGHT_MEDIUM" "PangoWeight")
+(CINT-2.18 "PANGO_WEIGHT_THIN" "PangoWeight")
+(CINT-2.18 "PANGO_WEIGHT_BOOK" "PangoWeight")
+(CINT-2.18 "PANGO_WEIGHT_MEDIUM" "PangoWeight")
;;; 2.15.5
-(CFNC-2172 "gchar* gtk_window_get_default_icon_name void" 'const)
+(CFNC-2.18 "gchar* gtk_window_get_default_icon_name void" 'const)
;;; 2.17.1
-(CFNC-2172 "gchar* gtk_label_get_current_uri GtkLabel* label" 'const)
+(CFNC-2.18 "gchar* gtk_label_get_current_uri GtkLabel* label" 'const)
;;; 2.17.2
-(CCAST-2172 "GTK_INFO_BAR(obj)" "GtkInfoBar*")
-(CCHK-2172 "GTK_IS_INFO_BAR(obj)" "GtkInfoBar*")
-
-(CFNC-2172 "GtkWidget* gtk_info_bar_new void")
-;(CFNC-2172 "GtkWidget* gtk_info_bar_new_with_buttons gchar* first_button_text ...")
-(CFNC-2172 "GtkWidget* gtk_info_bar_get_action_area GtkInfoBar* info_bar")
-(CFNC-2172 "GtkWidget* gtk_info_bar_get_content_area GtkInfoBar* info_bar")
-(CFNC-2172 "void gtk_info_bar_add_action_widget GtkInfoBar* info_bar GtkWidget* child gint response_id")
-(CFNC-2172 "GtkWidget* gtk_info_bar_add_button GtkInfoBar* info_bar gchar* button_text gint response_id")
-;(CFNC-2172 "void gtk_info_bar_add_buttons GtkInfoBar* info_bar gchar* first_button_text ...")
-(CFNC-2172 "void gtk_info_bar_set_response_sensitive GtkInfoBar* info_bar gint response_id gboolean setting") ; const arg
-(CFNC-2172 "void gtk_info_bar_set_default_response GtkInfoBar* info_bar gint response_id")
-(CFNC-2172 "void gtk_info_bar_response GtkInfoBar* info_bar gint response_id")
-(CFNC-2172 "void gtk_info_bar_set_message_type GtkInfoBar* info_bar GtkMessageType message_type")
-(CFNC-2172 "GtkMessageType gtk_info_bar_get_message_type GtkInfoBar* info_bar")
+(CCAST-2.18 "GTK_INFO_BAR(obj)" "GtkInfoBar*")
+(CCHK-2.18 "GTK_IS_INFO_BAR(obj)" "GtkInfoBar*")
+
+(CFNC-2.18 "GtkWidget* gtk_info_bar_new void")
+;(CFNC-2.18 "GtkWidget* gtk_info_bar_new_with_buttons gchar* first_button_text ...")
+(CFNC-2.18 "GtkWidget* gtk_info_bar_get_action_area GtkInfoBar* info_bar")
+(CFNC-2.18 "GtkWidget* gtk_info_bar_get_content_area GtkInfoBar* info_bar")
+(CFNC-2.18 "void gtk_info_bar_add_action_widget GtkInfoBar* info_bar GtkWidget* child gint response_id")
+(CFNC-2.18 "GtkWidget* gtk_info_bar_add_button GtkInfoBar* info_bar gchar* button_text gint response_id")
+;(CFNC-2.18 "void gtk_info_bar_add_buttons GtkInfoBar* info_bar gchar* first_button_text ...")
+(CFNC-2.18 "void gtk_info_bar_set_response_sensitive GtkInfoBar* info_bar gint response_id gboolean setting") ; const arg
+(CFNC-2.18 "void gtk_info_bar_set_default_response GtkInfoBar* info_bar gint response_id")
+(CFNC-2.18 "void gtk_info_bar_response GtkInfoBar* info_bar gint response_id")
+(CFNC-2.18 "void gtk_info_bar_set_message_type GtkInfoBar* info_bar GtkMessageType message_type")
+(CFNC-2.18 "GtkMessageType gtk_info_bar_get_message_type GtkInfoBar* info_bar")
;;; 2.17.3
-(CINT-2173 "GDK_WINDOW_OFFSCREEN" "GdkWindowType")
+(CINT-2.18 "GDK_WINDOW_OFFSCREEN" "GdkWindowType")
-;;; (CFNC-2173 "gboolean gdk_region_rect_equal GdkRegion* region GdkRectangle* rectangle" 'const)
-(CFNC-2173 "gboolean gdk_window_ensure_native GdkWindow* window")
-(CFNC-2173 "void gdk_window_get_root_coords GdkWindow* window gint x gint y gint* [root_x] gint* [root_y]")
-;;; 2.91.0 (CFNC-2173 "GdkPixmap* gdk_offscreen_window_get_pixmap GdkWindow* window")
-(CFNC-2173 "void gdk_offscreen_window_set_embedder GdkWindow* window GdkWindow* embedder")
-(CFNC-2173 "GdkWindow* gdk_offscreen_window_get_embedder GdkWindow* window")
-(CFNC-2173 "void gdk_window_geometry_changed GdkWindow* window")
-(CFNC-2173 "void gtk_menu_set_reserve_toggle_size GtkMenu* menu gboolean reserve_toggle_size")
-(CFNC-2173 "gboolean gtk_menu_get_reserve_toggle_size GtkMenu* menu")
-(CFNC-2173 "void gtk_status_icon_set_title GtkStatusIcon* status_icon gchar* title")
-(CFNC-2173 "gchar* gtk_status_icon_get_title GtkStatusIcon* status_icon")
+;;; (CFNC-2.18 "gboolean gdk_region_rect_equal GdkRegion* region GdkRectangle* rectangle" 'const)
+(CFNC-2.18 "gboolean gdk_window_ensure_native GdkWindow* window")
+(CFNC-2.18 "void gdk_window_get_root_coords GdkWindow* window gint x gint y gint* [root_x] gint* [root_y]")
+;;; 2.91.0 (CFNC-2.18 "GdkPixmap* gdk_offscreen_window_get_pixmap GdkWindow* window")
+(CFNC-2.18 "void gdk_offscreen_window_set_embedder GdkWindow* window GdkWindow* embedder")
+(CFNC-2.18 "GdkWindow* gdk_offscreen_window_get_embedder GdkWindow* window")
+(CFNC-2.18 "void gdk_window_geometry_changed GdkWindow* window")
+(CFNC-2.18 "void gtk_menu_set_reserve_toggle_size GtkMenu* menu gboolean reserve_toggle_size")
+(CFNC-2.18 "gboolean gtk_menu_get_reserve_toggle_size GtkMenu* menu")
+;;; 3.14.0 (CFNC-2.18 "void gtk_status_icon_set_title GtkStatusIcon* status_icon gchar* title")
+;;; 3.14.0 (CFNC-2.18 "gchar* gtk_status_icon_get_title GtkStatusIcon* status_icon")
;;; 2.17.4
-(CLNG-2173 "GTK_ENTRY_BUFFER_MAX_SIZE")
-;;; 2.91.6 (CLNG-2173 "GTK_TYPE_ENTRY_BUFFER")
-(CCAST-2173 "GTK_ENTRY_BUFFER(obj)" "GtkEntryBuffer*")
-(CCHK-2173 "GTK_IS_ENTRY_BUFFER(obj)" "GtkEntryBuffer*")
-
-(CFNC-2173 "GtkWidget* gtk_entry_new_with_buffer GtkEntryBuffer* buffer")
-(CFNC-2173 "GtkEntryBuffer* gtk_entry_get_buffer GtkEntry* entry")
-(CFNC-2173 "void gtk_entry_set_buffer GtkEntry* entry GtkEntryBuffer* buffer")
-(CFNC-2173 "void gtk_label_set_track_visited_links GtkLabel* label gboolean track_links")
-(CFNC-2173 "gboolean gtk_label_get_track_visited_links GtkLabel* label")
-(CFNC-2173 "void gtk_print_operation_set_embed_page_setup GtkPrintOperation* op gboolean embed")
-(CFNC-2173 "gboolean gtk_print_operation_get_embed_page_setup GtkPrintOperation* op")
-(CFNC-2173 "GtkEntryBuffer* gtk_entry_buffer_new gchar* initial_chars gint n_initial_chars")
-(CFNC-2173 "gsize gtk_entry_buffer_get_bytes GtkEntryBuffer* buffer")
-(CFNC-2173 "guint gtk_entry_buffer_get_length GtkEntryBuffer* buffer")
-(CFNC-2173 "gchar* gtk_entry_buffer_get_text GtkEntryBuffer* buffer" 'const)
-(CFNC-2173 "void gtk_entry_buffer_set_text GtkEntryBuffer* buffer gchar* chars gint n_chars")
-(CFNC-2173 "void gtk_entry_buffer_set_max_length GtkEntryBuffer* buffer guint max_length")
-(CFNC-2173 "guint gtk_entry_buffer_get_max_length GtkEntryBuffer* buffer")
-(CFNC-2173 "guint gtk_entry_buffer_insert_text GtkEntryBuffer* buffer guint position gchar* chars gint n_chars")
-(CFNC-2173 "guint gtk_entry_buffer_delete_text GtkEntryBuffer* buffer guint position gint n_chars")
-(CFNC-2173 "void gtk_entry_buffer_emit_inserted_text GtkEntryBuffer* buffer guint position gchar* chars guint n_chars")
-(CFNC-2173 "void gtk_entry_buffer_emit_deleted_text GtkEntryBuffer* buffer guint position guint n_chars")
+(CINT-2.18 "GTK_ENTRY_BUFFER_MAX_SIZE") ; maxushort in gtk_entry_buffer.h (gint)
+;;; 2.91.6 (CLNG-2.18 "GTK_TYPE_ENTRY_BUFFER")
+(CCAST-2.18 "GTK_ENTRY_BUFFER(obj)" "GtkEntryBuffer*")
+(CCHK-2.18 "GTK_IS_ENTRY_BUFFER(obj)" "GtkEntryBuffer*")
+
+(CFNC-2.18 "GtkWidget* gtk_entry_new_with_buffer GtkEntryBuffer* buffer")
+(CFNC-2.18 "GtkEntryBuffer* gtk_entry_get_buffer GtkEntry* entry")
+(CFNC-2.18 "void gtk_entry_set_buffer GtkEntry* entry GtkEntryBuffer* buffer")
+(CFNC-2.18 "void gtk_label_set_track_visited_links GtkLabel* label gboolean track_links")
+(CFNC-2.18 "gboolean gtk_label_get_track_visited_links GtkLabel* label")
+(CFNC-2.18 "void gtk_print_operation_set_embed_page_setup GtkPrintOperation* op gboolean embed")
+(CFNC-2.18 "gboolean gtk_print_operation_get_embed_page_setup GtkPrintOperation* op")
+(CFNC-2.18 "GtkEntryBuffer* gtk_entry_buffer_new gchar* initial_chars gint n_initial_chars")
+(CFNC-2.18 "gsize gtk_entry_buffer_get_bytes GtkEntryBuffer* buffer")
+(CFNC-2.18 "guint gtk_entry_buffer_get_length GtkEntryBuffer* buffer")
+(CFNC-2.18 "gchar* gtk_entry_buffer_get_text GtkEntryBuffer* buffer" 'const)
+(CFNC-2.18 "void gtk_entry_buffer_set_text GtkEntryBuffer* buffer gchar* chars gint n_chars")
+(CFNC-2.18 "void gtk_entry_buffer_set_max_length GtkEntryBuffer* buffer guint max_length")
+(CFNC-2.18 "guint gtk_entry_buffer_get_max_length GtkEntryBuffer* buffer")
+(CFNC-2.18 "guint gtk_entry_buffer_insert_text GtkEntryBuffer* buffer guint position gchar* chars gint n_chars")
+(CFNC-2.18 "guint gtk_entry_buffer_delete_text GtkEntryBuffer* buffer guint position gint n_chars")
+(CFNC-2.18 "void gtk_entry_buffer_emit_inserted_text GtkEntryBuffer* buffer guint position gchar* chars guint n_chars")
+(CFNC-2.18 "void gtk_entry_buffer_emit_deleted_text GtkEntryBuffer* buffer guint position guint n_chars")
;;; 2.17.5
-(CFNC-2173 "void gtk_cell_renderer_set_alignment GtkCellRenderer* cell gfloat xalign gfloat yalign")
-(CFNC-2173 "void gtk_cell_renderer_get_alignment GtkCellRenderer* cell gfloat* [xalign] gfloat* [yalign]")
-(CFNC-2173 "void gtk_cell_renderer_set_padding GtkCellRenderer* cell gint xpad gint ypad")
-(CFNC-2173 "void gtk_cell_renderer_get_padding GtkCellRenderer* cell gint* [xpad] gint* [ypad]")
-(CFNC-2173 "void gtk_cell_renderer_set_visible GtkCellRenderer* cell gboolean visible")
-(CFNC-2173 "gboolean gtk_cell_renderer_get_visible GtkCellRenderer* cell")
-(CFNC-2173 "void gtk_cell_renderer_set_sensitive GtkCellRenderer* cell gboolean sensitive")
-(CFNC-2173 "gboolean gtk_cell_renderer_get_sensitive GtkCellRenderer* cell")
-(CFNC-2173 "gboolean gtk_cell_renderer_toggle_get_activatable GtkCellRendererToggle* toggle")
-(CFNC-2173 "void gtk_cell_renderer_toggle_set_activatable GtkCellRendererToggle* toggle gboolean setting")
-(CFNC-2173 "void gtk_widget_set_can_focus GtkWidget* widget gboolean can_focus")
-(CFNC-2173 "gboolean gtk_widget_get_can_focus GtkWidget* widget")
-(CFNC-2173 "gboolean gtk_widget_has_focus GtkWidget* widget")
-(CFNC-2173 "void gtk_widget_set_can_default GtkWidget* widget gboolean can_default")
-(CFNC-2173 "gboolean gtk_widget_get_can_default GtkWidget* widget")
-(CFNC-2173 "gboolean gtk_widget_has_default GtkWidget* widget")
-(CFNC-2173 "GtkStateType gtk_widget_get_state GtkWidget* widget")
-(CFNC-2173 "gboolean gtk_widget_get_sensitive GtkWidget* widget")
-(CFNC-2173 "gboolean gtk_widget_is_sensitive GtkWidget* widget")
-(CFNC-2173 "void gtk_widget_set_has_window GtkWidget* widget gboolean has_window")
-(CFNC-2173 "gboolean gtk_widget_get_has_window GtkWidget* widget")
-(CFNC-2173 "gboolean gtk_widget_get_app_paintable GtkWidget* widget")
-(CFNC-2173 "gboolean gtk_widget_get_double_buffered GtkWidget* widget")
+(CFNC-2.18 "void gtk_cell_renderer_set_alignment GtkCellRenderer* cell gfloat xalign gfloat yalign")
+(CFNC-2.18 "void gtk_cell_renderer_get_alignment GtkCellRenderer* cell gfloat* [xalign] gfloat* [yalign]")
+(CFNC-2.18 "void gtk_cell_renderer_set_padding GtkCellRenderer* cell gint xpad gint ypad")
+(CFNC-2.18 "void gtk_cell_renderer_get_padding GtkCellRenderer* cell gint* [xpad] gint* [ypad]")
+(CFNC-2.18 "void gtk_cell_renderer_set_visible GtkCellRenderer* cell gboolean visible")
+(CFNC-2.18 "gboolean gtk_cell_renderer_get_visible GtkCellRenderer* cell")
+(CFNC-2.18 "void gtk_cell_renderer_set_sensitive GtkCellRenderer* cell gboolean sensitive")
+(CFNC-2.18 "gboolean gtk_cell_renderer_get_sensitive GtkCellRenderer* cell")
+(CFNC-2.18 "gboolean gtk_cell_renderer_toggle_get_activatable GtkCellRendererToggle* toggle")
+(CFNC-2.18 "void gtk_cell_renderer_toggle_set_activatable GtkCellRendererToggle* toggle gboolean setting")
+(CFNC-2.18 "void gtk_widget_set_can_focus GtkWidget* widget gboolean can_focus")
+(CFNC-2.18 "gboolean gtk_widget_get_can_focus GtkWidget* widget")
+(CFNC-2.18 "gboolean gtk_widget_has_focus GtkWidget* widget")
+(CFNC-2.18 "void gtk_widget_set_can_default GtkWidget* widget gboolean can_default")
+(CFNC-2.18 "gboolean gtk_widget_get_can_default GtkWidget* widget")
+(CFNC-2.18 "gboolean gtk_widget_has_default GtkWidget* widget")
+;;; (CFNC-2.18 "GtkStateType gtk_widget_get_state GtkWidget* widget")
+(CFNC-2.18 "gboolean gtk_widget_get_sensitive GtkWidget* widget")
+(CFNC-2.18 "gboolean gtk_widget_is_sensitive GtkWidget* widget")
+(CFNC-2.18 "void gtk_widget_set_has_window GtkWidget* widget gboolean has_window")
+(CFNC-2.18 "gboolean gtk_widget_get_has_window GtkWidget* widget")
+(CFNC-2.18 "gboolean gtk_widget_get_app_paintable GtkWidget* widget")
+;;; 3.13.3 (CFNC-2.18 "gboolean gtk_widget_get_double_buffered GtkWidget* widget")
;;; 2.17.7
-(CFNC-2177 "GdkCursor* gdk_window_get_cursor GdkWindow* window")
-(CFNC-2177 "void gtk_file_chooser_set_create_folders GtkFileChooser* chooser gboolean create_folders")
-(CFNC-2177 "gboolean gtk_file_chooser_get_create_folders GtkFileChooser* chooser")
-(CFNC-2177 "void gtk_icon_view_set_item_padding GtkIconView* icon_view gint item_padding")
-(CFNC-2177 "gint gtk_icon_view_get_item_padding GtkIconView* icon_view")
-(CFNC-2177 "gboolean gtk_widget_has_grab GtkWidget* widget")
-(CFNC-2177 "void gtk_widget_set_visible GtkWidget* widget gboolean visible")
-(CFNC-2177 "gboolean gtk_widget_get_visible GtkWidget* widget")
-;(CFNC-2177 "void gtk_widget_get_allocation GtkWidget* widget GtkAllocation* [allocation]")
+(CFNC-2.18 "GdkCursor* gdk_window_get_cursor GdkWindow* window")
+(CFNC-2.18 "void gtk_file_chooser_set_create_folders GtkFileChooser* chooser gboolean create_folders")
+(CFNC-2.18 "gboolean gtk_file_chooser_get_create_folders GtkFileChooser* chooser")
+(CFNC-2.18 "void gtk_icon_view_set_item_padding GtkIconView* icon_view gint item_padding")
+(CFNC-2.18 "gint gtk_icon_view_get_item_padding GtkIconView* icon_view")
+(CFNC-2.18 "gboolean gtk_widget_has_grab GtkWidget* widget")
+(CFNC-2.18 "void gtk_widget_set_visible GtkWidget* widget gboolean visible")
+(CFNC-2.18 "gboolean gtk_widget_get_visible GtkWidget* widget")
+;(CFNC-2.18 "void gtk_widget_get_allocation GtkWidget* widget GtkAllocation* [allocation]")
; the struct arg is a problem for makexg.scm
-;;; (CINT-2177 "GTK_FILE_CHOOSER_PROP_CREATE_FOLDERS" "GtkFileChooserProp")
+;;; (CINT-2.18 "GTK_FILE_CHOOSER_PROP_CREATE_FOLDERS" "GtkFileChooserProp")
;;; 2.17.8
-;(CFNC-2177 "void gtk_widget_set_allocation GtkWidget* widget GtkAllocation* allocation")
+;(CFNC-2.18 "void gtk_widget_set_allocation GtkWidget* widget GtkAllocation* allocation")
;;; 2.17.10
-(CFNC-2177 "void gtk_range_set_flippable GtkRange* range gboolean flippable")
-(CFNC-2177 "gboolean gtk_range_get_flippable GtkRange* range")
-(CFNC-2177 "gboolean gtk_widget_is_toplevel GtkWidget* widget")
-(CFNC-2177 "gboolean gtk_widget_is_drawable GtkWidget* widget")
-(CFNC-2177 "void gtk_widget_set_window GtkWidget* widget GdkWindow* window")
+(CFNC-2.18 "void gtk_range_set_flippable GtkRange* range gboolean flippable")
+(CFNC-2.18 "gboolean gtk_range_get_flippable GtkRange* range")
+(CFNC-2.18 "gboolean gtk_widget_is_toplevel GtkWidget* widget")
+(CFNC-2.18 "gboolean gtk_widget_is_drawable GtkWidget* widget")
+(CFNC-2.18 "void gtk_widget_set_window GtkWidget* widget GdkWindow* window")
;;; 2.17.11
-(CFNC-2177 "gboolean gdk_window_is_destroyed GdkWindow* window")
-(CFNC-2177 "void gdk_window_restack GdkWindow* window GdkWindow* sibling gboolean above")
-(CFNC-2177 "void gtk_widget_set_receives_default GtkWidget* widget gboolean receives_default")
-(CFNC-2177 "gboolean gtk_widget_get_receives_default GtkWidget* widget")
+(CFNC-2.18 "gboolean gdk_window_is_destroyed GdkWindow* window")
+(CFNC-2.18 "void gdk_window_restack GdkWindow* window GdkWindow* sibling gboolean above")
+(CFNC-2.18 "void gtk_widget_set_receives_default GtkWidget* widget gboolean receives_default")
+(CFNC-2.18 "gboolean gtk_widget_get_receives_default GtkWidget* widget")
;;; 2.18.0
-(CFNC-2177 "void gdk_window_flush GdkWindow* window")
+;;; 3.13.3 (CFNC-2.18 "void gdk_window_flush GdkWindow* window")
;;; 2.19.0
-(CFNC-2190 "GtkWidget* gtk_dialog_get_widget_for_response GtkDialog* dialog gint response_id")
-(CFNC-2190 "void gtk_tooltip_set_icon_from_gicon GtkTooltip* tooltip GIcon* gicon GtkIconSize size")
-(CFNC-2190 "GdkWindow* gtk_viewport_get_bin_window GtkViewport* viewport")
-(CFNC-2190 "GtkWidget* gtk_spinner_new void")
-(CFNC-2190 "void gtk_spinner_start GtkSpinner* spinner")
-(CFNC-2190 "void gtk_spinner_stop GtkSpinner* spinner")
-(CFNC-2190 "GtkCellRenderer* gtk_cell_renderer_spinner_new void") ; surely they mean GtkCellRendererSpinner?
+(CFNC-2.20 "GtkWidget* gtk_dialog_get_widget_for_response GtkDialog* dialog gint response_id")
+;;; (CFNC-2.20 "void gtk_tooltip_set_icon_from_gicon GtkTooltip* tooltip GIcon* gicon GtkIconSize size")
+(CFNC-2.20 "GdkWindow* gtk_viewport_get_bin_window GtkViewport* viewport")
+(CFNC-2.20 "GtkWidget* gtk_spinner_new void")
+(CFNC-2.20 "void gtk_spinner_start GtkSpinner* spinner")
+(CFNC-2.20 "void gtk_spinner_stop GtkSpinner* spinner")
+(CFNC-2.20 "GtkCellRenderer* gtk_cell_renderer_spinner_new void") ; surely they mean GtkCellRendererSpinner?
-(CCAST-2190 "GTK_SPINNER(obj)" "GtkSpinner*")
-(CCHK-2190 "GTK_IS_SPINNER(obj)" "GtkSpinner*")
+(CCAST-2.20 "GTK_SPINNER(obj)" "GtkSpinner*")
+(CCHK-2.20 "GTK_IS_SPINNER(obj)" "GtkSpinner*")
-(CCAST-2190 "GTK_CELL_RENDERER_SPINNER(obj)" "GtkCellRendererSpinner*")
-(CCHK-2190 "GTK_IS_CELL_RENDERER_SPINNER(obj)" "GtkCellRendererSpinner*")
+(CCAST-2.20 "GTK_CELL_RENDERER_SPINNER(obj)" "GtkCellRendererSpinner*")
+(CCHK-2.20 "GTK_IS_CELL_RENDERER_SPINNER(obj)" "GtkCellRendererSpinner*")
;;; 2.19.1
-(CCAST-2190 "GTK_TOOL_PALETTE(obj)" "GtkToolPalette*")
-(CCHK-2190 "GTK_IS_TOOL_PALETTE(obj)" "GtkToolPalette*")
-(CCAST-2190 "GTK_TOOL_ITEM_GROUP(obj)" "GtkToolItemGroup*")
-(CCHK-2190 "GTK_IS_TOOL_ITEM_GROUP(obj)" "GtkToolItemGroup*")
-
-(CFNC-2190 "void gtk_action_set_always_show_image GtkAction* action gboolean always_show")
-(CFNC-2190 "gboolean gtk_action_get_always_show_image GtkAction* action")
-(CFNC-2190 "GtkWidget* gtk_notebook_get_action_widget GtkNotebook* notebook GtkPackType pack_type")
-(CFNC-2190 "void gtk_notebook_set_action_widget GtkNotebook* notebook GtkWidget* widget GtkPackType pack_type")
-(CFNC-2190 "GtkWidget* gtk_statusbar_get_message_area GtkStatusbar* statusbar")
-(CFNC-2190 "PangoEllipsizeMode gtk_tool_item_get_ellipsize_mode GtkToolItem* tool_item")
-(CFNC-2190 "gfloat gtk_tool_item_get_text_alignment GtkToolItem* tool_item")
-(CFNC-2190 "GtkOrientation gtk_tool_item_get_text_orientation GtkToolItem* tool_item")
-(CFNC-2190 "GtkSizeGroup* gtk_tool_item_get_text_size_group GtkToolItem* tool_item")
-;;; (CFNC-2190 "GtkWindowType gtk_window_get_window_type GtkWindow* window")
-(CFNC-2190 "GtkWidget* gtk_tool_palette_new void")
-(CFNC-2190 "void gtk_tool_palette_set_group_position GtkToolPalette* palette GtkToolItemGroup* group gint position") ; these changed GtkWidget* to GtkToolItemGroup*
-(CFNC-2190 "void gtk_tool_palette_set_exclusive GtkToolPalette* palette GtkToolItemGroup* group gboolean exclusive")
-(CFNC-2190 "void gtk_tool_palette_set_expand GtkToolPalette* palette GtkToolItemGroup* group gboolean expand")
-(CFNC-2190 "gint gtk_tool_palette_get_group_position GtkToolPalette* palette GtkToolItemGroup* group")
-(CFNC-2190 "gboolean gtk_tool_palette_get_exclusive GtkToolPalette* palette GtkToolItemGroup* group")
-(CFNC-2190 "gboolean gtk_tool_palette_get_expand GtkToolPalette* palette GtkToolItemGroup* group")
-(CFNC-2190 "void gtk_tool_palette_set_icon_size GtkToolPalette* palette GtkIconSize icon_size")
-(CFNC-2190 "void gtk_tool_palette_unset_icon_size GtkToolPalette* palette")
-(CFNC-2190 "void gtk_tool_palette_set_style GtkToolPalette* palette GtkToolbarStyle style")
-(CFNC-2190 "void gtk_tool_palette_unset_style GtkToolPalette* palette")
-(CFNC-2190 "GtkIconSize gtk_tool_palette_get_icon_size GtkToolPalette* palette")
-(CFNC-2190 "GtkToolbarStyle gtk_tool_palette_get_style GtkToolPalette* palette")
-(CFNC-2190 "GtkToolItem* gtk_tool_palette_get_drop_item GtkToolPalette* palette gint x gint y")
-(CFNC-2190 "GtkToolItemGroup* gtk_tool_palette_get_drop_group GtkToolPalette* palette gint x gint y")
-(CFNC-2190 "GtkWidget* gtk_tool_palette_get_drag_item GtkToolPalette* palette GtkSelectionData* selection")
-(CFNC-2190 "void gtk_tool_palette_set_drag_source GtkToolPalette* palette GtkToolPaletteDragTargets targets")
-(CFNC-2190 "void gtk_tool_palette_add_drag_dest GtkToolPalette* palette GtkWidget* widget GtkDestDefaults flags GtkToolPaletteDragTargets targets GdkDragAction actions")
-;;; 2.91.2 (CFNC-2190 "GtkAdjustment* gtk_tool_palette_get_hadjustment GtkToolPalette* palette")
-;;; 2.91.2 (CFNC-2190 "GtkAdjustment* gtk_tool_palette_get_vadjustment GtkToolPalette* palette")
-(CFNC-2190 "GtkTargetEntry* gtk_tool_palette_get_drag_target_item void" 'const-return)
-(CFNC-2190 "GtkTargetEntry* gtk_tool_palette_get_drag_target_group void" 'const-return)
-(CFNC-2190 "GtkWidget* gtk_tool_item_group_new gchar* label" 'const)
-(CFNC-2190 "void gtk_tool_item_group_set_label GtkToolItemGroup* group gchar* label" 'const)
-(CFNC-2190 "void gtk_tool_item_group_set_label_widget GtkToolItemGroup* group GtkWidget* label_widget")
-(CFNC-2190 "void gtk_tool_item_group_set_collapsed GtkToolItemGroup* group gboolean collapsed")
-(CFNC-2190 "void gtk_tool_item_group_set_ellipsize GtkToolItemGroup* group PangoEllipsizeMode ellipsize")
-(CFNC-2190 "void gtk_tool_item_group_set_header_relief GtkToolItemGroup* group GtkReliefStyle style")
-(CFNC-2190 "gchar* gtk_tool_item_group_get_label GtkToolItemGroup* group")
-(CFNC-2190 "GtkWidget* gtk_tool_item_group_get_label_widget GtkToolItemGroup* group")
-(CFNC-2190 "gboolean gtk_tool_item_group_get_collapsed GtkToolItemGroup* group")
-(CFNC-2190 "PangoEllipsizeMode gtk_tool_item_group_get_ellipsize GtkToolItemGroup* group")
-(CFNC-2190 "GtkReliefStyle gtk_tool_item_group_get_header_relief GtkToolItemGroup* group")
-(CFNC-2190 "void gtk_tool_item_group_insert GtkToolItemGroup* group GtkToolItem* item gint position")
-(CFNC-2190 "void gtk_tool_item_group_set_item_position GtkToolItemGroup* group GtkToolItem* item gint position")
-(CFNC-2190 "gint gtk_tool_item_group_get_item_position GtkToolItemGroup* group GtkToolItem* item")
-(CFNC-2190 "guint gtk_tool_item_group_get_n_items GtkToolItemGroup* group")
-(CFNC-2190 "GtkToolItem* gtk_tool_item_group_get_nth_item GtkToolItemGroup* group guint index")
-(CFNC-2190 "GtkToolItem* gtk_tool_item_group_get_drop_item GtkToolItemGroup* group gint x gint y")
+(CCAST-2.20 "GTK_TOOL_PALETTE(obj)" "GtkToolPalette*")
+(CCHK-2.20 "GTK_IS_TOOL_PALETTE(obj)" "GtkToolPalette*")
+(CCAST-2.20 "GTK_TOOL_ITEM_GROUP(obj)" "GtkToolItemGroup*")
+(CCHK-2.20 "GTK_IS_TOOL_ITEM_GROUP(obj)" "GtkToolItemGroup*")
+
+;;; (CFNC-2.20 "void gtk_action_set_always_show_image GtkAction* action gboolean always_show")
+;;; (CFNC-2.20 "gboolean gtk_action_get_always_show_image GtkAction* action")
+(CFNC-2.20 "GtkWidget* gtk_notebook_get_action_widget GtkNotebook* notebook GtkPackType pack_type")
+(CFNC-2.20 "void gtk_notebook_set_action_widget GtkNotebook* notebook GtkWidget* widget GtkPackType pack_type")
+(CFNC-2.20 "GtkWidget* gtk_statusbar_get_message_area GtkStatusbar* statusbar")
+(CFNC-2.20 "PangoEllipsizeMode gtk_tool_item_get_ellipsize_mode GtkToolItem* tool_item")
+(CFNC-2.20 "gfloat gtk_tool_item_get_text_alignment GtkToolItem* tool_item")
+(CFNC-2.20 "GtkOrientation gtk_tool_item_get_text_orientation GtkToolItem* tool_item")
+(CFNC-2.20 "GtkSizeGroup* gtk_tool_item_get_text_size_group GtkToolItem* tool_item")
+;;; (CFNC-2.20 "GtkWindowType gtk_window_get_window_type GtkWindow* window")
+(CFNC-2.20 "GtkWidget* gtk_tool_palette_new void")
+(CFNC-2.20 "void gtk_tool_palette_set_group_position GtkToolPalette* palette GtkToolItemGroup* group gint position") ; these changed GtkWidget* to GtkToolItemGroup*
+(CFNC-2.20 "void gtk_tool_palette_set_exclusive GtkToolPalette* palette GtkToolItemGroup* group gboolean exclusive")
+(CFNC-2.20 "void gtk_tool_palette_set_expand GtkToolPalette* palette GtkToolItemGroup* group gboolean expand")
+(CFNC-2.20 "gint gtk_tool_palette_get_group_position GtkToolPalette* palette GtkToolItemGroup* group")
+(CFNC-2.20 "gboolean gtk_tool_palette_get_exclusive GtkToolPalette* palette GtkToolItemGroup* group")
+(CFNC-2.20 "gboolean gtk_tool_palette_get_expand GtkToolPalette* palette GtkToolItemGroup* group")
+;;; (CFNC-2.20 "void gtk_tool_palette_set_icon_size GtkToolPalette* palette GtkIconSize icon_size")
+(CFNC-2.20 "void gtk_tool_palette_unset_icon_size GtkToolPalette* palette")
+(CFNC-2.20 "void gtk_tool_palette_set_style GtkToolPalette* palette GtkToolbarStyle style")
+(CFNC-2.20 "void gtk_tool_palette_unset_style GtkToolPalette* palette")
+;;; (CFNC-2.20 "GtkIconSize gtk_tool_palette_get_icon_size GtkToolPalette* palette")
+(CFNC-2.20 "GtkToolbarStyle gtk_tool_palette_get_style GtkToolPalette* palette")
+(CFNC-2.20 "GtkToolItem* gtk_tool_palette_get_drop_item GtkToolPalette* palette gint x gint y")
+(CFNC-2.20 "GtkToolItemGroup* gtk_tool_palette_get_drop_group GtkToolPalette* palette gint x gint y")
+(CFNC-2.20 "GtkWidget* gtk_tool_palette_get_drag_item GtkToolPalette* palette GtkSelectionData* selection")
+(CFNC-2.20 "void gtk_tool_palette_set_drag_source GtkToolPalette* palette GtkToolPaletteDragTargets targets")
+(CFNC-2.20 "void gtk_tool_palette_add_drag_dest GtkToolPalette* palette GtkWidget* widget GtkDestDefaults flags GtkToolPaletteDragTargets targets GdkDragAction actions")
+;;; 2.91.2 (CFNC-2.20 "GtkAdjustment* gtk_tool_palette_get_hadjustment GtkToolPalette* palette")
+;;; 2.91.2 (CFNC-2.20 "GtkAdjustment* gtk_tool_palette_get_vadjustment GtkToolPalette* palette")
+(CFNC-2.20 "GtkTargetEntry* gtk_tool_palette_get_drag_target_item void" 'const-return)
+(CFNC-2.20 "GtkTargetEntry* gtk_tool_palette_get_drag_target_group void" 'const-return)
+(CFNC-2.20 "GtkWidget* gtk_tool_item_group_new gchar* label" 'const)
+(CFNC-2.20 "void gtk_tool_item_group_set_label GtkToolItemGroup* group gchar* label" 'const)
+(CFNC-2.20 "void gtk_tool_item_group_set_label_widget GtkToolItemGroup* group GtkWidget* label_widget")
+(CFNC-2.20 "void gtk_tool_item_group_set_collapsed GtkToolItemGroup* group gboolean collapsed")
+(CFNC-2.20 "void gtk_tool_item_group_set_ellipsize GtkToolItemGroup* group PangoEllipsizeMode ellipsize")
+(CFNC-2.20 "void gtk_tool_item_group_set_header_relief GtkToolItemGroup* group GtkReliefStyle style")
+(CFNC-2.20 "gchar* gtk_tool_item_group_get_label GtkToolItemGroup* group")
+(CFNC-2.20 "GtkWidget* gtk_tool_item_group_get_label_widget GtkToolItemGroup* group")
+(CFNC-2.20 "gboolean gtk_tool_item_group_get_collapsed GtkToolItemGroup* group")
+(CFNC-2.20 "PangoEllipsizeMode gtk_tool_item_group_get_ellipsize GtkToolItemGroup* group")
+(CFNC-2.20 "GtkReliefStyle gtk_tool_item_group_get_header_relief GtkToolItemGroup* group")
+(CFNC-2.20 "void gtk_tool_item_group_insert GtkToolItemGroup* group GtkToolItem* item gint position")
+(CFNC-2.20 "void gtk_tool_item_group_set_item_position GtkToolItemGroup* group GtkToolItem* item gint position")
+(CFNC-2.20 "gint gtk_tool_item_group_get_item_position GtkToolItemGroup* group GtkToolItem* item")
+(CFNC-2.20 "guint gtk_tool_item_group_get_n_items GtkToolItemGroup* group")
+(CFNC-2.20 "GtkToolItem* gtk_tool_item_group_get_nth_item GtkToolItemGroup* group guint index")
+(CFNC-2.20 "GtkToolItem* gtk_tool_item_group_get_drop_item GtkToolItemGroup* group gint x gint y")
;;; 2.19.2
-;; (CFNC-2190 "gboolean gdk_keymap_map_virtual_modifiers GdkKeymap* keymap GdkModifierType *state")
+;; (CFNC-2.20 "gboolean gdk_keymap_map_virtual_modifiers GdkKeymap* keymap GdkModifierType *state")
;; there is no code for this!
-(CFNC-2190 "gint gdk_screen_get_primary_monitor GdkScreen* screen")
-(CFNC-2190 "void gtk_window_set_mnemonics_visible GtkWindow* window gboolean setting")
-(CFNC-2190 "gboolean gtk_window_get_mnemonics_visible GtkWindow* window")
+(CFNC-2.20 "gint gdk_screen_get_primary_monitor GdkScreen* screen")
+(CFNC-2.20 "void gtk_window_set_mnemonics_visible GtkWindow* window gboolean setting")
+(CFNC-2.20 "gboolean gtk_window_get_mnemonics_visible GtkWindow* window")
;;; 2.19.4
-;;; 2.91.2 (CFNC-2190 "GdkWindow* gtk_entry_get_text_window GtkEntry* entry")
-;;; 2.91.2 (CFNC-2190 "GdkWindow* gtk_entry_get_icon_window GtkEntry* entry GtkEntryIconPosition icon_pos")
-(CFNC-2190 "void gtk_range_set_slider_size_fixed GtkRange* range gboolean size_fixed")
-(CFNC-2190 "gboolean gtk_range_get_slider_size_fixed GtkRange* range")
-(CFNC-2190 "void gtk_range_set_min_slider_size GtkRange* range gboolean min_size")
-(CFNC-2190 "gint gtk_range_get_min_slider_size GtkRange* range")
-(CFNC-2190 "void gtk_range_get_range_rect GtkRange* range GdkRectangle* range_rect")
-(CFNC-2190 "void gtk_range_get_slider_range GtkRange* range gint* [slider_start] gint* [slider_end]")
-(CFNC-2190 "void gtk_status_icon_set_name GtkStatusIcon* status_icon gchar* name") ; const gchar
-;;; 2.91.6 (CFNC-2190 "gboolean gtk_widget_has_rc_style GtkWidget* widget")
+;;; 2.91.2 (CFNC-2.20 "GdkWindow* gtk_entry_get_text_window GtkEntry* entry")
+;;; 2.91.2 (CFNC-2.20 "GdkWindow* gtk_entry_get_icon_window GtkEntry* entry GtkEntryIconPosition icon_pos")
+(CFNC-2.20 "void gtk_range_set_slider_size_fixed GtkRange* range gboolean size_fixed")
+(CFNC-2.20 "gboolean gtk_range_get_slider_size_fixed GtkRange* range")
+(CFNC-2.20 "void gtk_range_set_min_slider_size GtkRange* range gboolean min_size")
+(CFNC-2.20 "gint gtk_range_get_min_slider_size GtkRange* range")
+(CFNC-2.20 "void gtk_range_get_range_rect GtkRange* range GdkRectangle* range_rect")
+(CFNC-2.20 "void gtk_range_get_slider_range GtkRange* range gint* [slider_start] gint* [slider_end]")
+;;; 3.14.0 (CFNC-2.20 "void gtk_status_icon_set_name GtkStatusIcon* status_icon gchar* name") ; const gchar
+;;; 2.91.6 (CFNC-2.20 "gboolean gtk_widget_has_rc_style GtkWidget* widget")
;;; 2.19.5
-(CFNC-2190 "GdkWindow* gtk_paned_get_handle_window GtkPaned* paned")
-;;; 2.99.1 (CFNC-2190 "void gtk_widget_style_attach GtkWidget* style")
-(CFNC-2190 "void gtk_widget_set_realized GtkWidget* widget gboolean realized")
-(CFNC-2190 "gboolean gtk_widget_get_realized GtkWidget* widget")
-(CFNC-2190 "void gtk_widget_set_mapped GtkWidget* widget gboolean mapped")
-(CFNC-2190 "gboolean gtk_widget_get_mapped GtkWidget* widget")
+(CFNC-2.20 "GdkWindow* gtk_paned_get_handle_window GtkPaned* paned")
+;;; 2.99.1 (CFNC-2.20 "void gtk_widget_style_attach GtkWidget* style")
+(CFNC-2.20 "void gtk_widget_set_realized GtkWidget* widget gboolean realized")
+(CFNC-2.20 "gboolean gtk_widget_get_realized GtkWidget* widget")
+(CFNC-2.20 "void gtk_widget_set_mapped GtkWidget* widget gboolean mapped")
+(CFNC-2.20 "gboolean gtk_widget_get_mapped GtkWidget* widget")
;;; 2.19.6
-(CFNC-300 "void gdk_keymap_add_virtual_modifiers GdkKeymap* keymap GdkModifierType* state")
-;(CFNC-300 "void gtk_widget_get_requisition GtkWidget* widget GtkRequisition* [requisition]")
+(CFNC-3.0 "void gdk_keymap_add_virtual_modifiers GdkKeymap* keymap GdkModifierType* state")
+;(CFNC-3.0 "void gtk_widget_get_requisition GtkWidget* widget GtkRequisition* [requisition]")
;;; 2.21.0
-(CFNC-300 "void gdk_window_coords_to_parent GdkWindow* window gdouble x gdouble y gdouble* [parent_x] gdouble* [parent_y]")
-(CFNC-300 "void gdk_window_coords_from_parent GdkWindow* window gdouble parent_x gdouble parent_y gdouble* [x] gdouble* [y]")
-(CFNC-300 "GdkWindow* gdk_window_get_effective_parent GdkWindow* window")
-(CFNC-300 "GdkWindow* gdk_window_get_effective_toplevel GdkWindow* window")
-(CFNC-300 "GtkWidget* gtk_accessible_get_widget GtkAccessible* accessible")
-;;; 2.91.2 (CFNC-300 "GtkAdjustment* gtk_text_view_get_hadjustment GtkTextView* text_view")
-;;; 2.91.2 (CFNC-300 "GtkAdjustment* gtk_text_view_get_vadjustment GtkTextView* text_view")
-(CFNC-300 "gboolean gtk_widget_send_focus_change GtkWidget* widget GdkEvent* event")
+(CFNC-3.0 "void gdk_window_coords_to_parent GdkWindow* window gdouble x gdouble y gdouble* [parent_x] gdouble* [parent_y]")
+(CFNC-3.0 "void gdk_window_coords_from_parent GdkWindow* window gdouble parent_x gdouble parent_y gdouble* [x] gdouble* [y]")
+(CFNC-3.0 "GdkWindow* gdk_window_get_effective_parent GdkWindow* window")
+(CFNC-3.0 "GdkWindow* gdk_window_get_effective_toplevel GdkWindow* window")
+(CFNC-3.0 "GtkWidget* gtk_accessible_get_widget GtkAccessible* accessible")
+;;; 2.91.2 (CFNC-3.0 "GtkAdjustment* gtk_text_view_get_hadjustment GtkTextView* text_view")
+;;; 2.91.2 (CFNC-3.0 "GtkAdjustment* gtk_text_view_get_vadjustment GtkTextView* text_view")
+(CFNC-3.0 "gboolean gtk_widget_send_focus_change GtkWidget* widget GdkEvent* event")
;;; 2.90.1
-;;; 2.99.0 (CFNC-300 "void gdk_display_get_device_state GdkDisplay* display GdkDevice* device GdkScreen** [screen] gint* [x] gint* [y] GdkModifierType* [mask]")
-;;; 2.99.0 (CFNC-300 "GdkWindow* gdk_display_get_window_at_device_position GdkDisplay* display GdkDevice* device gint* [win_x] gint* [win_y]")
-;;; 2.91.7 (CFNC-300 "void gdk_display_warp_device GdkDisplay* display GdkDevice* device GdkScreen* screen gint x gint y")
-(CFNC-300 "GdkDeviceManager* gdk_display_get_device_manager GdkDisplay* display")
-(CFNC-300 "void gdk_drag_context_set_device GdkDragContext* context GdkDevice* device")
-(CFNC-300 "GdkDevice* gdk_drag_context_get_device GdkDragContext* context")
-(CFNC-300 "GList* gdk_drag_context_list_targets GdkDragContext* context")
-
-(CFNC-300 "void gdk_event_set_device GdkEvent* event GdkDevice* device")
-(CFNC-300 "GdkDevice* gdk_event_get_device GdkEvent* event")
-(CFNC-300 "gboolean gdk_events_get_distance GdkEvent* event1 GdkEvent* event2 gdouble* [distance]")
-(CFNC-300 "gboolean gdk_events_get_angle GdkEvent* event1 GdkEvent* event2 gdouble* [angle]")
-(CFNC-300 "gboolean gdk_events_get_center GdkEvent* event1 GdkEvent* event2 gdouble* [x] gdouble* [y]")
-;;; 2.90.6 (CFNC-300 "GdkVisual* gdk_image_get_visual GdkImage* image")
-;;; 2.90.6 (CFNC-300 "GdkByteOrder gdk_image_get_byte_order GdkImage* image")
-;;; 2.90.6 (CFNC-300 "gint gdk_image_get_width GdkImage* image")
-;;; 2.90.6 (CFNC-300 "gint gdk_image_get_height GdkImage* image")
-;;; 2.90.6 (CFNC-300 "guint16 gdk_image_get_depth GdkImage* image")
-;;; 2.90.6 (CFNC-300 "guint16 gdk_image_get_bytes_per_pixel GdkImage* image")
-;;; 2.90.6 (CFNC-300 "guint16 gdk_image_get_bytes_per_line GdkImage* image")
-;;; 2.90.6 (CFNC-300 "guint16 gdk_image_get_bits_per_pixel GdkImage* image")
-(CFNC-300 "gboolean gdk_window_get_accept_focus GdkWindow* window")
-(CFNC-300 "gboolean gdk_window_get_focus_on_map GdkWindow* window")
-(CFNC-300 "gboolean gdk_window_get_composited GdkWindow* window")
-(CFNC-300 "gboolean gdk_window_is_input_only GdkWindow* window")
-(CFNC-300 "gboolean gdk_window_is_shaped GdkWindow* window")
-(CFNC-300 "gboolean gdk_window_get_modal_hint GdkWindow* window")
-;;; 2.90.6 (CFNC-300 "void gdk_window_get_background GdkWindow* window GdkColor* color")
-;;; 2.90.6 (CFNC-300 "void gdk_window_get_back_pixmap GdkWindow* window GdkPixmap** [pixmap] gboolean* [parent_relative]")
-(CFNC-300 "void gdk_window_set_device_cursor GdkWindow* window GdkDevice* device GdkCursor* cursor")
-(CFNC-300 "GdkCursor* gdk_window_get_device_cursor GdkWindow* window GdkDevice* device")
-(CFNC-300 "GdkWindow* gdk_window_get_device_position GdkWindow* window GdkDevice* device gint* [x] gint* [y] GdkModifierType* [mask]")
-(CFNC-300 "void gdk_window_set_device_events GdkWindow* window GdkDevice* device GdkEventMask event_mask")
-(CFNC-300 "GdkEventMask gdk_window_get_device_events GdkWindow* window GdkDevice* device")
-(CFNC-300 "void gtk_combo_box_popup_for_device GtkComboBox* combo_box GdkDevice* device")
-(CFNC-300 "void gtk_device_grab_add GtkWidget* widget GdkDevice* device gboolean block_others")
-(CFNC-300 "void gtk_device_grab_remove GtkWidget* widget GdkDevice* device")
-(CFNC-300 "GdkDevice* gtk_get_current_event_device void")
-;;; 2.90.1 (CFNC-300 "void gtk_menu_popup_for_device GtkMenu* menu GdkDevice* device GtkWidget* parent_menu_shell GtkWidget* parent_menu_item GtkMenuPositionFunc func lambda_data #func_info guint button guint32 activate_time")
-(CFNC-300 "GtkWidget* gtk_paned_new GtkOrientation orientation")
-(CFNC-300 "void gtk_radio_action_join_group GtkRadioAction* action GtkRadioAction* group_source")
-;;; 2.91.5 (CFNC-300 "GtkWidget* gtk_ruler_new GtkOrientation orientation")
-(CFNC-300 "GtkWidget* gtk_scale_new GtkOrientation orientation GtkAdjustment* adjustment")
-(CFNC-300 "GtkWidget* gtk_scale_new_with_range GtkOrientation orientation gdouble min gdouble max gdouble step")
-(CFNC-300 "GtkWidget* gtk_scrollbar_new GtkOrientation orientation GtkAdjustment* adjustment")
-(CFNC-300 "GtkWidget* gtk_separator_new GtkOrientation orientation")
-(CFNC-300 "gboolean gtk_widget_device_is_shadowed GtkWidget* widget GdkDevice* device")
-(CFNC-300 "void gtk_widget_set_device_events GtkWidget* widget GdkDevice* device GdkEventMask events")
-(CFNC-300 "void gtk_widget_add_device_events GtkWidget* widget GdkDevice* device GdkEventMask events")
-(CFNC-300 "gboolean gtk_widget_get_support_multidevice GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_support_multidevice GtkWidget* widget gboolean support_multidevice")
-(CFNC-300 "GdkEventMask gtk_widget_get_device_events GtkWidget* widget GdkDevice* device")
-
-;;; 2.91.0 (CINT-300 "GTK_MULTIDEVICE" "GtkWidgetFlags")
+;;; 2.99.0 (CFNC-3.0 "void gdk_display_get_device_state GdkDisplay* display GdkDevice* device GdkScreen** [screen] gint* [x] gint* [y] GdkModifierType* [mask]")
+;;; 2.99.0 (CFNC-3.0 "GdkWindow* gdk_display_get_window_at_device_position GdkDisplay* display GdkDevice* device gint* [win_x] gint* [win_y]")
+;;; 2.91.7 (CFNC-3.0 "void gdk_display_warp_device GdkDisplay* display GdkDevice* device GdkScreen* screen gint x gint y")
+(CFNC-3.0 "GdkDeviceManager* gdk_display_get_device_manager GdkDisplay* display")
+(CFNC-3.0 "void gdk_drag_context_set_device GdkDragContext* context GdkDevice* device")
+(CFNC-3.0 "GdkDevice* gdk_drag_context_get_device GdkDragContext* context")
+(CFNC-3.0 "GList* gdk_drag_context_list_targets GdkDragContext* context")
+
+(CFNC-3.0 "void gdk_event_set_device GdkEvent* event GdkDevice* device")
+(CFNC-3.0 "GdkDevice* gdk_event_get_device GdkEvent* event")
+(CFNC-3.0 "gboolean gdk_events_get_distance GdkEvent* event1 GdkEvent* event2 gdouble* [distance]")
+(CFNC-3.0 "gboolean gdk_events_get_angle GdkEvent* event1 GdkEvent* event2 gdouble* [angle]")
+(CFNC-3.0 "gboolean gdk_events_get_center GdkEvent* event1 GdkEvent* event2 gdouble* [x] gdouble* [y]")
+;;; 2.90.6 (CFNC-3.0 "GdkVisual* gdk_image_get_visual GdkImage* image")
+;;; 2.90.6 (CFNC-3.0 "GdkByteOrder gdk_image_get_byte_order GdkImage* image")
+;;; 2.90.6 (CFNC-3.0 "gint gdk_image_get_width GdkImage* image")
+;;; 2.90.6 (CFNC-3.0 "gint gdk_image_get_height GdkImage* image")
+;;; 2.90.6 (CFNC-3.0 "guint16 gdk_image_get_depth GdkImage* image")
+;;; 2.90.6 (CFNC-3.0 "guint16 gdk_image_get_bytes_per_pixel GdkImage* image")
+;;; 2.90.6 (CFNC-3.0 "guint16 gdk_image_get_bytes_per_line GdkImage* image")
+;;; 2.90.6 (CFNC-3.0 "guint16 gdk_image_get_bits_per_pixel GdkImage* image")
+(CFNC-3.0 "gboolean gdk_window_get_accept_focus GdkWindow* window")
+(CFNC-3.0 "gboolean gdk_window_get_focus_on_map GdkWindow* window")
+;;; 3.15 (CFNC-3.0 "gboolean gdk_window_get_composited GdkWindow* window")
+(CFNC-3.0 "gboolean gdk_window_is_input_only GdkWindow* window")
+(CFNC-3.0 "gboolean gdk_window_is_shaped GdkWindow* window")
+(CFNC-3.0 "gboolean gdk_window_get_modal_hint GdkWindow* window")
+;;; 2.90.6 (CFNC-3.0 "void gdk_window_get_background GdkWindow* window GdkColor* color")
+;;; 2.90.6 (CFNC-3.0 "void gdk_window_get_back_pixmap GdkWindow* window GdkPixmap** [pixmap] gboolean* [parent_relative]")
+(CFNC-3.0 "void gdk_window_set_device_cursor GdkWindow* window GdkDevice* device GdkCursor* cursor")
+(CFNC-3.0 "GdkCursor* gdk_window_get_device_cursor GdkWindow* window GdkDevice* device")
+(CFNC-3.0 "GdkWindow* gdk_window_get_device_position GdkWindow* window GdkDevice* device gint* [x] gint* [y] GdkModifierType* [mask]")
+(CFNC-3.0 "void gdk_window_set_device_events GdkWindow* window GdkDevice* device GdkEventMask event_mask")
+(CFNC-3.0 "GdkEventMask gdk_window_get_device_events GdkWindow* window GdkDevice* device")
+(CFNC-3.0 "void gtk_combo_box_popup_for_device GtkComboBox* combo_box GdkDevice* device")
+(CFNC-3.0 "void gtk_device_grab_add GtkWidget* widget GdkDevice* device gboolean block_others")
+(CFNC-3.0 "void gtk_device_grab_remove GtkWidget* widget GdkDevice* device")
+(CFNC-3.0 "GdkDevice* gtk_get_current_event_device void")
+;;; 2.90.1 (CFNC-3.0 "void gtk_menu_popup_for_device GtkMenu* menu GdkDevice* device GtkWidget* parent_menu_shell GtkWidget* parent_menu_item GtkMenuPositionFunc func lambda_data #func_info guint button guint32 activate_time")
+(CFNC-3.0 "GtkWidget* gtk_paned_new GtkOrientation orientation")
+;;; (CFNC-3.0 "void gtk_radio_action_join_group GtkRadioAction* action GtkRadioAction* group_source")
+;;; 2.91.5 (CFNC-3.0 "GtkWidget* gtk_ruler_new GtkOrientation orientation")
+(CFNC-3.0 "GtkWidget* gtk_scale_new GtkOrientation orientation GtkAdjustment* adjustment")
+(CFNC-3.0 "GtkWidget* gtk_scale_new_with_range GtkOrientation orientation gdouble min gdouble max gdouble step")
+(CFNC-3.0 "GtkWidget* gtk_scrollbar_new GtkOrientation orientation GtkAdjustment* adjustment")
+(CFNC-3.0 "GtkWidget* gtk_separator_new GtkOrientation orientation")
+(CFNC-3.0 "gboolean gtk_widget_device_is_shadowed GtkWidget* widget GdkDevice* device")
+(CFNC-3.0 "void gtk_widget_set_device_events GtkWidget* widget GdkDevice* device GdkEventMask events")
+(CFNC-3.0 "void gtk_widget_add_device_events GtkWidget* widget GdkDevice* device GdkEventMask events")
+(CFNC-3.0 "gboolean gtk_widget_get_support_multidevice GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_support_multidevice GtkWidget* widget gboolean support_multidevice")
+(CFNC-3.0 "GdkEventMask gtk_widget_get_device_events GtkWidget* widget GdkDevice* device")
+
+;;; 2.91.0 (CINT-3.0 "GTK_MULTIDEVICE" "GtkWidgetFlags")
;;; 2.90.2
-(CFNC-300 "gint gtk_icon_view_get_item_row GtkIconView* icon_view GtkTreePath* path")
-(CFNC-300 "gint gtk_icon_view_get_item_column GtkIconView* icon_view GtkTreePath* path")
-(CFNC-300 "void gtk_statusbar_remove_all GtkStatusbar* statusbar guint context_id")
-(CFNC-300 "gboolean gtk_window_has_group GtkWindow* window")
+(CFNC-3.0 "gint gtk_icon_view_get_item_row GtkIconView* icon_view GtkTreePath* path")
+(CFNC-3.0 "gint gtk_icon_view_get_item_column GtkIconView* icon_view GtkTreePath* path")
+(CFNC-3.0 "void gtk_statusbar_remove_all GtkStatusbar* statusbar guint context_id")
+(CFNC-3.0 "gboolean gtk_window_has_group GtkWindow* window")
;;; 2.90.3
-(CFNC-300 "void gtk_calendar_select_month GtkCalendar* calendar guint month guint year")
-(CFNC-300 "void gtk_calendar_mark_day GtkCalendar* calendar guint day")
-(CFNC-300 "void gtk_calendar_unmark_day GtkCalendar* calendar guint day")
-(CFNC-300 "GdkWindow* gdk_drag_context_get_source_window GdkDragContext* context")
-(CFNC-300 "GdkWindow* gtk_viewport_get_view_window GtkViewport* viewport")
+(CFNC-3.0 "void gtk_calendar_select_month GtkCalendar* calendar guint month guint year")
+(CFNC-3.0 "void gtk_calendar_mark_day GtkCalendar* calendar guint day")
+(CFNC-3.0 "void gtk_calendar_unmark_day GtkCalendar* calendar guint day")
+(CFNC-3.0 "GdkWindow* gdk_drag_context_get_source_window GdkDragContext* context")
+(CFNC-3.0 "GdkWindow* gtk_viewport_get_view_window GtkViewport* viewport")
;;; 2.90.4
-;;; 2.90.6 (CFNC-300 "gpointer gdk_image_get_pixels GdkImage* image")
-;(CFNC-300 "GdkDevice* gdk_device_manager_get_client_pointer GdkDeviceManager* device_manager")
-(CFNC-300 "void gtk_accessible_set_widget GtkAccessible* accessible GtkWidget* widget")
-(CFNC-300 "GdkWindow* gtk_button_get_event_window GtkButton* button")
-(CFNC-300 "GtkWidget* gtk_font_selection_dialog_get_font_selection GtkFontSelectionDialog* fsd")
-(CFNC-300 "GtkWidget* gtk_message_dialog_get_message_area GtkMessageDialog* message_dialog")
-(CFNC-300 "void gtk_table_get_size GtkTable* table guint* [rows] guint* [columns]")
+;;; 2.90.6 (CFNC-3.0 "gpointer gdk_image_get_pixels GdkImage* image")
+;(CFNC-3.0 "GdkDevice* gdk_device_manager_get_client_pointer GdkDeviceManager* device_manager")
+(CFNC-3.0 "void gtk_accessible_set_widget GtkAccessible* accessible GtkWidget* widget")
+(CFNC-3.0 "GdkWindow* gtk_button_get_event_window GtkButton* button")
+;;; 3.1.12 (CFNC-3.0 "GtkWidget* gtk_font_selection_dialog_get_font_selection GtkFontSelectionDialog* fsd")
+(CFNC-3.0 "GtkWidget* gtk_message_dialog_get_message_area GtkMessageDialog* message_dialog")
+;;; 3.3.2 (CFNC-3.0 "void gtk_table_get_size GtkTable* table guint* [rows] guint* [columns]")
-(CINT-300 "GTK_SIZE_REQUEST_HEIGHT_FOR_WIDTH" "GtkSizeRequestMode")
-(CINT-300 "GTK_SIZE_REQUEST_WIDTH_FOR_HEIGHT" "GtkSizeRequestMode")
+(CINT-3.0 "GTK_SIZE_REQUEST_HEIGHT_FOR_WIDTH" "GtkSizeRequestMode")
+(CINT-3.0 "GTK_SIZE_REQUEST_WIDTH_FOR_HEIGHT" "GtkSizeRequestMode")
-(CFNC-300 "gint gtk_selection_data_get_length GtkSelectionData* selection_data")
+(CFNC-3.0 "gint gtk_selection_data_get_length GtkSelectionData* selection_data")
;;; 2.90.5 removed all GdkRegion stuff
-;;; (CFNC-300 "cairo_region_t* gdk_drawable_get_clip_region GdkDrawable* drawable")
-;;; (CFNC-300 "cairo_region_t* gdk_drawable_get_visible_region GdkDrawable* drawable")
-;;; 2.90.6 (CFNC-300 "void gdk_gc_set_clip_region GdkGC* gc cairo_region_t* region")
-(CFNC-300 "cairo_region_t* gdk_pango_layout_line_get_clip_region PangoLayoutLine* line gint x_origin gint y_origin gint* index_ranges gint n_ranges")
-(CFNC-300 "cairo_region_t* gdk_pango_layout_get_clip_region PangoLayout* layout gint x_origin gint y_origin gint* index_ranges gint n_ranges")
-
-(CFNC-300 "void gdk_window_shape_combine_region GdkWindow* window cairo_region_t* shape_region gint offset_x gint offset_y")
-(CFNC-300 "void gdk_window_invalidate_region GdkWindow* window cairo_region_t* region gboolean invalidate_children")
-;(CFNC-300 "void gdk_window_invalidate_maybe_recurse GdkWindow* window cairo_region_t* region lambda2 func lambda_data #func_info")
-(CFNC-300 "cairo_region_t* gdk_window_get_update_area GdkWindow* window")
-(CFNC-300 "void gdk_window_begin_paint_region GdkWindow* window cairo_region_t* region")
-(CFNC-300 "cairo_region_t* gtk_widget_region_intersect GtkWidget* widget cairo_region_t* region") ; FREE
-(CFNC-300 "void gdk_window_move_region GdkWindow* window cairo_region_t* region gint dx gint dy")
-(CFNC-300 "gboolean gdk_keymap_get_num_lock_state GdkKeymap* keymap")
-(CFNC-300 "gboolean gdk_window_has_native GdkWindow* window")
-(CFNC-300 "GdkCursorType gdk_cursor_get_cursor_type GdkCursor* cursor")
-(CFNC-300 "gboolean gdk_display_is_closed GdkDisplay* display")
-(CFNC-300 "cairo_pattern_t* gdk_window_get_background_pattern GdkWindow* window")
-(CFNC-300 "cairo_surface_t* gdk_window_create_similar_surface GdkWindow* window cairo_content_t content int width int height")
-(CFNC-300 "void gtk_expander_set_label_fill GtkExpander* expander gboolean label_fill")
-(CFNC-300 "gboolean gtk_expander_get_label_fill GtkExpander* expander")
-(CFNC-300 "guint16 gtk_notebook_get_tab_hborder GtkNotebook* notebook")
-(CFNC-300 "guint16 gtk_notebook_get_tab_vborder GtkNotebook* notebook")
+;;; (CFNC-3.0 "cairo_region_t* gdk_drawable_get_clip_region GdkDrawable* drawable")
+;;; (CFNC-3.0 "cairo_region_t* gdk_drawable_get_visible_region GdkDrawable* drawable")
+;;; 2.90.6 (CFNC-3.0 "void gdk_gc_set_clip_region GdkGC* gc cairo_region_t* region")
+(CFNC-3.0 "cairo_region_t* gdk_pango_layout_line_get_clip_region PangoLayoutLine* line gint x_origin gint y_origin gint* index_ranges gint n_ranges")
+(CFNC-3.0 "cairo_region_t* gdk_pango_layout_get_clip_region PangoLayout* layout gint x_origin gint y_origin gint* index_ranges gint n_ranges")
+
+(CFNC-3.0 "void gdk_window_shape_combine_region GdkWindow* window cairo_region_t* shape_region gint offset_x gint offset_y")
+(CFNC-3.0 "void gdk_window_invalidate_region GdkWindow* window cairo_region_t* region gboolean invalidate_children")
+;(CFNC-3.0 "void gdk_window_invalidate_maybe_recurse GdkWindow* window cairo_region_t* region lambda2 func lambda_data #func_info")
+(CFNC-3.0 "cairo_region_t* gdk_window_get_update_area GdkWindow* window")
+(CFNC-3.0 "void gdk_window_begin_paint_region GdkWindow* window cairo_region_t* region")
+;;; (CFNC-3.0 "cairo_region_t* gtk_widget_region_intersect GtkWidget* widget cairo_region_t* region") ; FREE
+(CFNC-3.0 "void gdk_window_move_region GdkWindow* window cairo_region_t* region gint dx gint dy")
+(CFNC-3.0 "gboolean gdk_keymap_get_num_lock_state GdkKeymap* keymap")
+(CFNC-3.0 "gboolean gdk_window_has_native GdkWindow* window")
+(CFNC-3.0 "GdkCursorType gdk_cursor_get_cursor_type GdkCursor* cursor")
+(CFNC-3.0 "gboolean gdk_display_is_closed GdkDisplay* display")
+(CFNC-3.0 "cairo_pattern_t* gdk_window_get_background_pattern GdkWindow* window")
+(CFNC-3.0 "cairo_surface_t* gdk_window_create_similar_surface GdkWindow* window cairo_content_t content int width int height")
+(CFNC-3.0 "void gtk_expander_set_label_fill GtkExpander* expander gboolean label_fill")
+(CFNC-3.0 "gboolean gtk_expander_get_label_fill GtkExpander* expander")
+;;; (CFNC-3.0 "guint16 gtk_notebook_get_tab_hborder GtkNotebook* notebook")
+;;; (CFNC-3.0 "guint16 gtk_notebook_get_tab_vborder GtkNotebook* notebook")
;;; 2.90.6: HAVE_GTK_EXPANDER_GET_LABEL_FILL
@@ -7600,1233 +7566,1689 @@
(CAIRO-FUNC-912 "cairo_status_t cairo_region_xor_rectangle cairo_region_t* dst cairo_rectangle_int_t* rectangle")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_ALLOCATE_FREE" "GtkWrapAllocationMode")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_ALLOCATE_ALIGNED" "GtkWrapAllocationMode")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_ALLOCATE_HOMOGENEOUS" "GtkWrapAllocationMode")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_BOX_SPREAD_START" "GtkWrapBoxSpreading")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_BOX_SPREAD_END" "GtkWrapBoxSpreading")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_BOX_SPREAD_EVEN" "GtkWrapBoxSpreading")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_BOX_SPREAD_EXPAND" "GtkWrapBoxSpreading")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_BOX_H_EXPAND" "GtkWrapBoxPacking")
-;;; 2.91.1 ;;; 2.91.0 (CINT-300 "GTK_WRAP_BOX_H_FILL" "GtkWrapBoxPacking")
-;;; 2.91.1 (CINT-300 "GTK_WRAP_BOX_V_EXPAND" "GtkWrapBoxPacking")
-;;; 2.91.1 ;;; 2.91.0 (CINT-300 "GTK_WRAP_BOX_V_FILL" "GtkWrapBoxPacking")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_ALLOCATE_FREE" "GtkWrapAllocationMode")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_ALLOCATE_ALIGNED" "GtkWrapAllocationMode")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_ALLOCATE_HOMOGENEOUS" "GtkWrapAllocationMode")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_BOX_SPREAD_START" "GtkWrapBoxSpreading")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_BOX_SPREAD_END" "GtkWrapBoxSpreading")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_BOX_SPREAD_EVEN" "GtkWrapBoxSpreading")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_BOX_SPREAD_EXPAND" "GtkWrapBoxSpreading")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_BOX_H_EXPAND" "GtkWrapBoxPacking")
+;;; 2.91.1 ;;; 2.91.0 (CINT-3.0 "GTK_WRAP_BOX_H_FILL" "GtkWrapBoxPacking")
+;;; 2.91.1 (CINT-3.0 "GTK_WRAP_BOX_V_EXPAND" "GtkWrapBoxPacking")
+;;; 2.91.1 ;;; 2.91.0 (CINT-3.0 "GTK_WRAP_BOX_V_FILL" "GtkWrapBoxPacking")
-(CFNC-300 "gboolean gtk_calendar_get_day_is_marked GtkCalendar* calendar guint day")
-;;; 2.99.0 (CFNC-300 "void gtk_cell_view_get_desired_width_of_row GtkCellView* cell_view GtkTreePath* path gint* [minimum_size] gint* [natural_size]")
-;;; 2.99.0 (CFNC-300 "void gtk_cell_view_get_desired_height_for_width_of_row GtkCellView* cell_view GtkTreePath* path gint avail_size gint* [minimum_size] gint* [natural_size]")
-(CFNC-300 "void gtk_progress_bar_set_inverted GtkProgressBar* pbar gboolean inverted")
-(CFNC-300 "gboolean gtk_progress_bar_get_inverted GtkProgressBar* pbar")
-(CFNC-300 "void gtk_radio_button_join_group GtkRadioButton* radio_button GtkRadioButton* group_source")
+(CFNC-3.0 "gboolean gtk_calendar_get_day_is_marked GtkCalendar* calendar guint day")
+;;; 2.99.0 (CFNC-3.0 "void gtk_cell_view_get_desired_width_of_row GtkCellView* cell_view GtkTreePath* path gint* [minimum_size] gint* [natural_size]")
+;;; 2.99.0 (CFNC-3.0 "void gtk_cell_view_get_desired_height_for_width_of_row GtkCellView* cell_view GtkTreePath* path gint avail_size gint* [minimum_size] gint* [natural_size]")
+(CFNC-3.0 "void gtk_progress_bar_set_inverted GtkProgressBar* pbar gboolean inverted")
+(CFNC-3.0 "gboolean gtk_progress_bar_get_inverted GtkProgressBar* pbar")
+(CFNC-3.0 "void gtk_radio_button_join_group GtkRadioButton* radio_button GtkRadioButton* group_source")
;;; 2.91.0
-;;; 2.91.1 (CCAST-300 "GTK_WRAP_BOX(obj)" "GtkWrapBox*")
-;;; 2.91.1 (CCHK-300 "GTK_IS_WRAP_BOX(obj)" "GtkWrapBox*")
-
-(CFNC-300 "GtkAdjustment* gtk_adjustment_new gdouble value gdouble lower gdouble upper gdouble step_increment gdouble page_increment gdouble page_size")
-(CFNC-300 "gboolean gtk_binding_set_activate GtkBindingSet* binding_set guint keyval GdkModifierType modifiers GObject* object")
-(CFNC-300 "gboolean gtk_bindings_activate GObject* object guint keyval GdkModifierType modifiers")
-(CFNC-300 "cairo_surface_t* gtk_icon_view_create_drag_icon GtkIconView* icon_view GtkTreePath* path")
-;;; 2.91.1 (CFNC-300 "void gtk_quit_add_destroy guint main_level GtkWidget* object")
-;;; (CFNC-300 "cairo_surface_t* gdk_offscreen_window_get_pixmap GdkOffscreenWindow* window")
-;;; 2.91.6 (CFNC-300 "void gtk_style_apply_default_background GtkStyle* style cairo_t* cr GdkWindow* window GtkStateType state_type gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_hline GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail gint x1 gint x2 gint y")
-;(CFNC-gtk2 "void gtk_paint_vline GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail gint y1 gint y2 gint x")
-;(CFNC-gtk2 "void gtk_paint_shadow GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_arrow GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail GtkArrowType arrow_type gboolean fill gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_diamond GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_box GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_flat_box GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_check GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_option GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_tab GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_shadow_gap GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width")
-;(CFNC-gtk2 "void gtk_paint_box_gap GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width")
-;(CFNC-gtk2 "void gtk_paint_extension GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side")
-;(CFNC-gtk2 "void gtk_paint_focus GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
-;(CFNC-gtk2 "void gtk_paint_slider GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkOrientation orientation")
-;(CFNC-gtk2 "void gtk_paint_handle GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkOrientation orientation")
-;(CFNC-gtk2 "void gtk_paint_expander GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail gint x gint y GtkExpanderStyle expander_style")
-;(CFNC-gtk2 "void gtk_paint_layout GtkStyle* style cairo_t* cr GtkStateType state_type gboolean use_text GtkWidget* widget gchar* detail gint x gint y PangoLayout* layout")
-;(CFNC-gtk2 "void gtk_paint_resize_grip GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail GdkWindowEdge edge gint x gint y gint width gint height")
-(CFNC-300 "cairo_surface_t* gtk_tree_view_create_row_drag_icon GtkTreeView* tree_view GtkTreePath* path")
-
-(CFNC-300 "gboolean gdk_cairo_get_clip_rectangle cairo_t* cr GdkRectangle* rect")
-(CFNC-300 "cairo_region_t* gdk_cairo_region_create_from_surface cairo_surface_t* surface")
-(CFNC-300 "GdkVisual* gdk_window_get_visual GdkWindow* window")
-(CFNC-300 "GdkScreen* gdk_window_get_screen GdkWindow* window")
-(CFNC-300 "GdkDisplay* gdk_window_get_display GdkWindow* window")
-(CFNC-300 "int gdk_window_get_width GdkWindow* window")
-(CFNC-300 "int gdk_window_get_height GdkWindow* window")
-(CFNC-300 "GtkSizeRequestMode gtk_cell_renderer_get_request_mode GtkCellRenderer* cell")
-(CFNC-300 "void gtk_cell_renderer_get_preferred_width GtkCellRenderer* cell GtkWidget* widget gint* [minimum_size] gint* [natural_size]")
-(CFNC-300 "void gtk_cell_renderer_get_preferred_height_for_width GtkCellRenderer* cell GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_cell_renderer_get_preferred_height GtkCellRenderer* cell GtkWidget* widget gint* [minimum_size] gint* [natural_size]")
-(CFNC-300 "void gtk_cell_renderer_get_preferred_width_for_height GtkCellRenderer* cell GtkWidget* widget gint height gint* [minimum_width] gint* [natural_width]")
-;(CFNC-300 "void gtk_cell_renderer_get_preferred_size GtkCellRenderer* cell GtkWidget* widget GtkRequisition* [minimum_size] GtkRequisition* [natural_size]")
-(CFNC-300 "void gtk_container_class_handle_border_width GtkContainerClass* klass")
-(CFNC-300 "void gtk_drag_set_icon_surface GdkDragContext* context cairo_surface_t* surface")
-(CFNC-300 "void gtk_notebook_set_group_name GtkNotebook* notebook gchar* group_name" 'const)
-(CFNC-300 "gchar* gtk_notebook_get_group_name GtkNotebook* notebook" 'const-return)
-(CFNC-300 "void gtk_widget_draw GtkWidget* widget cairo_t* cr")
-(CFNC-300 "GtkSizeRequestMode gtk_widget_get_request_mode GtkWidget* widget")
-(CFNC-300 "void gtk_widget_get_preferred_width GtkWidget* widget gint* [minimum_width] gint* [natural_width]")
-(CFNC-300 "void gtk_widget_get_preferred_height_for_width GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_widget_get_preferred_height GtkWidget* widget gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_widget_get_preferred_width_for_height GtkWidget* widget gint height gint* [minimum_width] gint* [natural_width]")
-;(CFNC-300 "void gtk_widget_get_preferred_size GtkWidget* widget GtkRequisition* [minimum_size] GtkRequisition* [natural_size]")
-(CFNC-300 "int gtk_widget_get_allocated_width GtkWidget* widget")
-(CFNC-300 "int gtk_widget_get_allocated_height GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_visual GtkWidget* widget GdkVisual* visual")
-(CFNC-300 "GtkAlign gtk_widget_get_halign GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_halign GtkWidget* widget GtkAlign align")
-(CFNC-300 "GtkAlign gtk_widget_get_valign GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_valign GtkWidget* widget GtkAlign align")
-(CFNC-300 "gint gtk_widget_get_margin_left GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_margin_left GtkWidget* widget gint margin")
-(CFNC-300 "gint gtk_widget_get_margin_right GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_margin_right GtkWidget* widget gint margin")
-(CFNC-300 "gint gtk_widget_get_margin_top GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_margin_top GtkWidget* widget gint margin")
-(CFNC-300 "gint gtk_widget_get_margin_bottom GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_margin_bottom GtkWidget* widget gint margin")
-(CFNC-300 "void gtk_widget_shape_combine_region GtkWidget* widget cairo_region_t* region")
-(CFNC-300 "void gtk_widget_input_shape_combine_region GtkWidget* widget cairo_region_t* region")
-(CFNC-300 "gboolean gtk_cairo_should_draw_window cairo_t* cr GdkWindow* window")
-(CFNC-300 "void gtk_cairo_transform_to_window cairo_t* cr GtkWidget* widget GdkWindow* window")
-;;; 2.91.1 (CFNC-300 "GtkWidget* gtk_wrap_box_new GtkWrapAllocationMode mode GtkWrapBoxSpreading horizontal_spreading GtkWrapBoxSpreading vertical_spreading guint horizontal_spacing guint vertical_spacing")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_set_allocation_mode GtkWrapBox* box GtkWrapAllocationMode mode")
-;;; 2.91.1 (CFNC-300 "GtkWrapAllocationMode gtk_wrap_box_get_allocation_mode GtkWrapBox* box")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_set_horizontal_spreading GtkWrapBox* box GtkWrapBoxSpreading spreading")
-;;; 2.91.1 (CFNC-300 "GtkWrapBoxSpreading gtk_wrap_box_get_horizontal_spreading GtkWrapBox* box")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_set_vertical_spreading GtkWrapBox* box GtkWrapBoxSpreading spreading")
-;;; 2.91.1 (CFNC-300 "GtkWrapBoxSpreading gtk_wrap_box_get_vertical_spreading GtkWrapBox* box")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_set_vertical_spacing GtkWrapBox* box guint spacing")
-;;; 2.91.1 (CFNC-300 "guint gtk_wrap_box_get_vertical_spacing GtkWrapBox* box")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_set_horizontal_spacing GtkWrapBox* box guint spacing")
-;;; 2.91.1 (CFNC-300 "guint gtk_wrap_box_get_horizontal_spacing GtkWrapBox* box")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_set_minimum_line_children GtkWrapBox* box guint n_children")
-;;; 2.91.1 (CFNC-300 "guint gtk_wrap_box_get_minimum_line_children GtkWrapBox* box")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_set_natural_line_children GtkWrapBox* box guint n_children")
-;;; 2.91.1 (CFNC-300 "guint gtk_wrap_box_get_natural_line_children GtkWrapBox* box")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_insert_child GtkWrapBox* box GtkWidget* widget gint index GtkWrapBoxPacking packing")
-;;; 2.91.1 (CFNC-300 "void gtk_wrap_box_reorder_child GtkWrapBox* box GtkWidget* widget guint index")
-
-
-(CFNC-300 "GtkWidget* gtk_combo_box_new_with_entry void")
-(CFNC-300 "gboolean gtk_combo_box_get_has_entry GtkComboBox* combo_box")
-(CFNC-300 "void gtk_combo_box_set_entry_text_column GtkComboBox* combo_box gint text_column")
-(CFNC-300 "gint gtk_combo_box_get_entry_text_column GtkComboBox* combo_box")
-(CFNC-300 "GtkTargetEntry* gtk_target_entry_new char* target guint flags guint info" 'const)
-(CFNC-300 "GtkTargetEntry* gtk_target_entry_copy GtkTargetEntry* data")
-(CFNC-300 "void gtk_target_entry_free GtkTargetEntry* data")
-(CFNC-300 "gboolean gtk_widget_get_hexpand GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_hexpand GtkWidget* widget gboolean expand")
-(CFNC-300 "gboolean gtk_widget_get_hexpand_set GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_hexpand_set GtkWidget* widget gboolean set")
-(CFNC-300 "gboolean gtk_widget_get_vexpand GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_vexpand GtkWidget* widget gboolean expand")
-(CFNC-300 "gboolean gtk_widget_get_vexpand_set GtkWidget* widget")
-(CFNC-300 "void gtk_widget_set_vexpand_set GtkWidget* widget gboolean set")
-(CFNC-300 "void gtk_widget_queue_compute_expand GtkWidget* widget")
-(CFNC-300 "gboolean gtk_widget_compute_expand GtkWidget* widget GtkOrientation orientation")
-(CFNC-300 "void gtk_window_set_default_geometry GtkWindow* window gint width gint height")
-(CFNC-300 "void gtk_window_resize_to_geometry GtkWindow* window gint width gint height")
-(CFNC-300 "void gtk_window_set_has_resize_grip GtkWindow* window gboolean value")
-(CFNC-300 "gboolean gtk_window_get_has_resize_grip GtkWindow* window")
-(CFNC-300 "gboolean gtk_window_resize_grip_is_visible GtkWindow* window")
-(CFNC-300 "gboolean gtk_window_get_resize_grip_area GtkWindow* window GdkRectangle* rect")
-
-(CCAST-300 "GTK_COMBO_BOX_TEXT(obj)" "GtkComboBoxText*")
-(CCHK-300 "GTK_IS_COMBO_BOX_TEXT(obj)" "GtkComboBoxText*")
-
-(CFNC-300 "GtkWidget* gtk_combo_box_text_new void")
-(CFNC-300 "GtkWidget* gtk_combo_box_text_new_with_entry void")
-(CFNC-300 "void gtk_combo_box_text_append_text GtkComboBoxText* combo_box gchar* text" 'const)
-(CFNC-300 "void gtk_combo_box_text_insert_text GtkComboBoxText* combo_box gint position gchar* text" 'const)
-(CFNC-300 "void gtk_combo_box_text_prepend_text GtkComboBoxText* combo_box gchar* text" 'const)
-(CFNC-300 "void gtk_combo_box_text_remove GtkComboBoxText* combo_box gint position")
-(CFNC-300 "gchar* gtk_combo_box_text_get_active_text GtkComboBoxText* combo_box")
+;;; 2.91.1 (CCAST-3.0 "GTK_WRAP_BOX(obj)" "GtkWrapBox*")
+;;; 2.91.1 (CCHK-3.0 "GTK_IS_WRAP_BOX(obj)" "GtkWrapBox*")
+
+(CFNC-3.0 "GtkAdjustment* gtk_adjustment_new gdouble value gdouble lower gdouble upper gdouble step_increment gdouble page_increment gdouble page_size")
+(CFNC-3.0 "gboolean gtk_binding_set_activate GtkBindingSet* binding_set guint keyval GdkModifierType modifiers GObject* object")
+(CFNC-3.0 "gboolean gtk_bindings_activate GObject* object guint keyval GdkModifierType modifiers")
+(CFNC-3.0 "cairo_surface_t* gtk_icon_view_create_drag_icon GtkIconView* icon_view GtkTreePath* path")
+;;; 2.91.1 (CFNC-3.0 "void gtk_quit_add_destroy guint main_level GtkWidget* object")
+;;; (CFNC-3.0 "cairo_surface_t* gdk_offscreen_window_get_pixmap GdkOffscreenWindow* window")
+;;; 2.91.6 (CFNC-3.0 "void gtk_style_apply_default_background GtkStyle* style cairo_t* cr GdkWindow* window GtkStateType state_type gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_hline GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail gint x1 gint x2 gint y")
+;;; ;(CFNC-gtk2 "void gtk_paint_vline GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail gint y1 gint y2 gint x")
+;;; ;(CFNC-gtk2 "void gtk_paint_shadow GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_arrow GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail GtkArrowType arrow_type gboolean fill gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_diamond GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_box GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_flat_box GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_check GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_option GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_tab GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_shadow_gap GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width")
+;;; ;(CFNC-gtk2 "void gtk_paint_box_gap GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side gint gap_x gint gap_width")
+;;; ;(CFNC-gtk2 "void gtk_paint_extension GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkPositionType gap_side")
+;;; ;(CFNC-gtk2 "void gtk_paint_focus GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail gint x gint y gint width gint height")
+;;; ;(CFNC-gtk2 "void gtk_paint_slider GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkOrientation orientation")
+;;; ;(CFNC-gtk2 "void gtk_paint_handle GtkStyle* style cairo_t* cr GtkStateType state_type GtkShadowType shadow_type GtkWidget* widget gchar* detail gint x gint y gint width gint height GtkOrientation orientation")
+;;; ;(CFNC-gtk2 "void gtk_paint_expander GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail gint x gint y GtkExpanderStyle expander_style")
+;;; ;(CFNC-gtk2 "void gtk_paint_layout GtkStyle* style cairo_t* cr GtkStateType state_type gboolean use_text GtkWidget* widget gchar* detail gint x gint y PangoLayout* layout")
+;;; ;(CFNC-gtk2 "void gtk_paint_resize_grip GtkStyle* style cairo_t* cr GtkStateType state_type GtkWidget* widget gchar* detail GdkWindowEdge edge gint x gint y gint width gint height")
+(CFNC-3.0 "cairo_surface_t* gtk_tree_view_create_row_drag_icon GtkTreeView* tree_view GtkTreePath* path")
+
+(CFNC-3.0 "gboolean gdk_cairo_get_clip_rectangle cairo_t* cr GdkRectangle* rect")
+(CFNC-3.0 "cairo_region_t* gdk_cairo_region_create_from_surface cairo_surface_t* surface")
+(CFNC-3.0 "GdkVisual* gdk_window_get_visual GdkWindow* window")
+(CFNC-3.0 "GdkScreen* gdk_window_get_screen GdkWindow* window")
+(CFNC-3.0 "GdkDisplay* gdk_window_get_display GdkWindow* window")
+(CFNC-3.0 "int gdk_window_get_width GdkWindow* window")
+(CFNC-3.0 "int gdk_window_get_height GdkWindow* window")
+(CFNC-3.0 "GtkSizeRequestMode gtk_cell_renderer_get_request_mode GtkCellRenderer* cell")
+(CFNC-3.0 "void gtk_cell_renderer_get_preferred_width GtkCellRenderer* cell GtkWidget* widget gint* [minimum_size] gint* [natural_size]")
+(CFNC-3.0 "void gtk_cell_renderer_get_preferred_height_for_width GtkCellRenderer* cell GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height]")
+(CFNC-3.0 "void gtk_cell_renderer_get_preferred_height GtkCellRenderer* cell GtkWidget* widget gint* [minimum_size] gint* [natural_size]")
+(CFNC-3.0 "void gtk_cell_renderer_get_preferred_width_for_height GtkCellRenderer* cell GtkWidget* widget gint height gint* [minimum_width] gint* [natural_width]")
+;(CFNC-3.0 "void gtk_cell_renderer_get_preferred_size GtkCellRenderer* cell GtkWidget* widget GtkRequisition* [minimum_size] GtkRequisition* [natural_size]")
+(CFNC-3.0 "void gtk_container_class_handle_border_width GtkContainerClass* klass")
+(CFNC-3.0 "void gtk_drag_set_icon_surface GdkDragContext* context cairo_surface_t* surface")
+(CFNC-3.0 "void gtk_notebook_set_group_name GtkNotebook* notebook gchar* group_name" 'const)
+(CFNC-3.0 "gchar* gtk_notebook_get_group_name GtkNotebook* notebook" 'const-return)
+(CFNC-3.0 "void gtk_widget_draw GtkWidget* widget cairo_t* cr")
+(CFNC-3.0 "GtkSizeRequestMode gtk_widget_get_request_mode GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_get_preferred_width GtkWidget* widget gint* [minimum_width] gint* [natural_width]")
+(CFNC-3.0 "void gtk_widget_get_preferred_height_for_width GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height]")
+(CFNC-3.0 "void gtk_widget_get_preferred_height GtkWidget* widget gint* [minimum_height] gint* [natural_height]")
+(CFNC-3.0 "void gtk_widget_get_preferred_width_for_height GtkWidget* widget gint height gint* [minimum_width] gint* [natural_width]")
+;(CFNC-3.0 "void gtk_widget_get_preferred_size GtkWidget* widget GtkRequisition* [minimum_size] GtkRequisition* [natural_size]")
+(CFNC-3.0 "int gtk_widget_get_allocated_width GtkWidget* widget")
+(CFNC-3.0 "int gtk_widget_get_allocated_height GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_visual GtkWidget* widget GdkVisual* visual")
+(CFNC-3.0 "GtkAlign gtk_widget_get_halign GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_halign GtkWidget* widget GtkAlign align")
+(CFNC-3.0 "GtkAlign gtk_widget_get_valign GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_valign GtkWidget* widget GtkAlign align")
+;;; 3.12 (CFNC-3.0 "gint gtk_widget_get_margin_left GtkWidget* widget")
+;;; 3.12 (CFNC-3.0 "void gtk_widget_set_margin_left GtkWidget* widget gint margin")
+;;; 3.12 (CFNC-3.0 "gint gtk_widget_get_margin_right GtkWidget* widget")
+;;; 3.12 (CFNC-3.0 "void gtk_widget_set_margin_right GtkWidget* widget gint margin")
+(CFNC-3.0 "gint gtk_widget_get_margin_top GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_margin_top GtkWidget* widget gint margin")
+(CFNC-3.0 "gint gtk_widget_get_margin_bottom GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_margin_bottom GtkWidget* widget gint margin")
+(CFNC-3.0 "void gtk_widget_shape_combine_region GtkWidget* widget cairo_region_t* region")
+(CFNC-3.0 "void gtk_widget_input_shape_combine_region GtkWidget* widget cairo_region_t* region")
+(CFNC-3.0 "gboolean gtk_cairo_should_draw_window cairo_t* cr GdkWindow* window")
+(CFNC-3.0 "void gtk_cairo_transform_to_window cairo_t* cr GtkWidget* widget GdkWindow* window")
+;;; 2.91.1 (CFNC-3.0 "GtkWidget* gtk_wrap_box_new GtkWrapAllocationMode mode GtkWrapBoxSpreading horizontal_spreading GtkWrapBoxSpreading vertical_spreading guint horizontal_spacing guint vertical_spacing")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_set_allocation_mode GtkWrapBox* box GtkWrapAllocationMode mode")
+;;; 2.91.1 (CFNC-3.0 "GtkWrapAllocationMode gtk_wrap_box_get_allocation_mode GtkWrapBox* box")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_set_horizontal_spreading GtkWrapBox* box GtkWrapBoxSpreading spreading")
+;;; 2.91.1 (CFNC-3.0 "GtkWrapBoxSpreading gtk_wrap_box_get_horizontal_spreading GtkWrapBox* box")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_set_vertical_spreading GtkWrapBox* box GtkWrapBoxSpreading spreading")
+;;; 2.91.1 (CFNC-3.0 "GtkWrapBoxSpreading gtk_wrap_box_get_vertical_spreading GtkWrapBox* box")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_set_vertical_spacing GtkWrapBox* box guint spacing")
+;;; 2.91.1 (CFNC-3.0 "guint gtk_wrap_box_get_vertical_spacing GtkWrapBox* box")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_set_horizontal_spacing GtkWrapBox* box guint spacing")
+;;; 2.91.1 (CFNC-3.0 "guint gtk_wrap_box_get_horizontal_spacing GtkWrapBox* box")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_set_minimum_line_children GtkWrapBox* box guint n_children")
+;;; 2.91.1 (CFNC-3.0 "guint gtk_wrap_box_get_minimum_line_children GtkWrapBox* box")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_set_natural_line_children GtkWrapBox* box guint n_children")
+;;; 2.91.1 (CFNC-3.0 "guint gtk_wrap_box_get_natural_line_children GtkWrapBox* box")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_insert_child GtkWrapBox* box GtkWidget* widget gint index GtkWrapBoxPacking packing")
+;;; 2.91.1 (CFNC-3.0 "void gtk_wrap_box_reorder_child GtkWrapBox* box GtkWidget* widget guint index")
+
+
+(CFNC-3.0 "GtkWidget* gtk_combo_box_new_with_entry void")
+(CFNC-3.0 "gboolean gtk_combo_box_get_has_entry GtkComboBox* combo_box")
+(CFNC-3.0 "void gtk_combo_box_set_entry_text_column GtkComboBox* combo_box gint text_column")
+(CFNC-3.0 "gint gtk_combo_box_get_entry_text_column GtkComboBox* combo_box")
+(CFNC-3.0 "GtkTargetEntry* gtk_target_entry_new char* target guint flags guint info" 'const)
+(CFNC-3.0 "GtkTargetEntry* gtk_target_entry_copy GtkTargetEntry* data")
+(CFNC-3.0 "void gtk_target_entry_free GtkTargetEntry* data")
+(CFNC-3.0 "gboolean gtk_widget_get_hexpand GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_hexpand GtkWidget* widget gboolean expand")
+(CFNC-3.0 "gboolean gtk_widget_get_hexpand_set GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_hexpand_set GtkWidget* widget gboolean set")
+(CFNC-3.0 "gboolean gtk_widget_get_vexpand GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_vexpand GtkWidget* widget gboolean expand")
+(CFNC-3.0 "gboolean gtk_widget_get_vexpand_set GtkWidget* widget")
+(CFNC-3.0 "void gtk_widget_set_vexpand_set GtkWidget* widget gboolean set")
+(CFNC-3.0 "void gtk_widget_queue_compute_expand GtkWidget* widget")
+(CFNC-3.0 "gboolean gtk_widget_compute_expand GtkWidget* widget GtkOrientation orientation")
+(CFNC-3.0 "void gtk_window_set_default_geometry GtkWindow* window gint width gint height")
+(CFNC-3.0 "void gtk_window_resize_to_geometry GtkWindow* window gint width gint height")
+;;; 3.13.4 (CFNC-3.0 "void gtk_window_set_has_resize_grip GtkWindow* window gboolean value")
+;;; 3.13.4 (CFNC-3.0 "gboolean gtk_window_get_has_resize_grip GtkWindow* window")
+;;; 3.13.4 (CFNC-3.0 "gboolean gtk_window_resize_grip_is_visible GtkWindow* window")
+;;; 3.13.4 (CFNC-3.0 "gboolean gtk_window_get_resize_grip_area GtkWindow* window GdkRectangle* rect")
+
+(CCAST-3.0 "GTK_COMBO_BOX_TEXT(obj)" "GtkComboBoxText*")
+(CCHK-3.0 "GTK_IS_COMBO_BOX_TEXT(obj)" "GtkComboBoxText*")
+
+(CFNC-3.0 "GtkWidget* gtk_combo_box_text_new void")
+(CFNC-3.0 "GtkWidget* gtk_combo_box_text_new_with_entry void")
+(CFNC-3.0 "void gtk_combo_box_text_append_text GtkComboBoxText* combo_box gchar* text" 'const)
+(CFNC-3.0 "void gtk_combo_box_text_insert_text GtkComboBoxText* combo_box gint position gchar* text" 'const)
+(CFNC-3.0 "void gtk_combo_box_text_prepend_text GtkComboBoxText* combo_box gchar* text" 'const)
+(CFNC-3.0 "void gtk_combo_box_text_remove GtkComboBoxText* combo_box gint position")
+(CFNC-3.0 "gchar* gtk_combo_box_text_get_active_text GtkComboBoxText* combo_box")
;;; gtkapplication.h
;;; 2.91.2
-(CCAST-300 "GTK_GRID(obj)" "GtkGrid*")
-(CCHK-300 "GTK_IS_GRID(obj)" "GtkGrid*")
-(CCAST-300 "GTK_SCROLLABLE(obj)" "GtkScrollable*")
-(CCHK-300 "GTK_IS_SCROLLABLE(obj)" "GtkScrollable*")
-
-(CFNC-300 "void gdk_cairo_set_source_rgba cairo_t* cr GdkRGBA* rgba" 'const)
-(CFNC-300 "void gdk_window_set_background_rgba GdkWindow* window GdkRGBA* rgba")
-(CFNC-300 "void gtk_cell_view_set_background_rgba GtkCellView* cell_view GdkRGBA* rgba" 'const)
-(CFNC-300 "GtkWidget* gtk_color_button_new_with_rgba GdkRGBA* rgba" 'const)
-(CFNC-300 "void gtk_color_button_set_rgba GtkColorButton* color_button GdkRGBA* rgba" 'const)
-;(CFNC-300 "void gtk_color_button_get_rgba GtkColorButton* color_button GdkRGBA* [rgba]")
-(CFNC-300 "void gtk_color_selection_set_current_rgba GtkColorSelection* colorsel GdkRGBA* rgba" 'const)
-;(CFNC-300 "void gtk_color_selection_get_current_rgba GtkColorSelection* colorsel GdkRGBA* [rgba]")
-(CFNC-300 "void gtk_color_selection_set_previous_rgba GtkColorSelection* colorsel GdkRGBA* rgba" 'const)
-;(CFNC-300 "void gtk_color_selection_get_previous_rgba GtkColorSelection* colorsel GdkRGBA* [rgba]")
-(CFNC-300 "void gtk_combo_box_text_remove_all GtkComboBoxText* combo_box")
-(CFNC-300 "void gtk_combo_box_set_popup_fixed_width GtkComboBox* combo_box gboolean fixed")
-(CFNC-300 "gboolean gtk_combo_box_get_popup_fixed_width GtkComboBox* combo_box")
-;(CFNC-300 "GAppInfo* gtk_recent_info_create_app_info GtkRecentInfo* info gchar* app_name GError** [error]" 'const)
-;(CFNC-300 "GIcon* gtk_recent_info_get_gicon GtkRecentInfo* info")
-(CFNC-300 "gint gtk_scrolled_window_get_min_content_width GtkScrolledWindow* scrolled_window")
-(CFNC-300 "void gtk_scrolled_window_set_min_content_width GtkScrolledWindow* scrolled_window gint width")
-(CFNC-300 "gint gtk_scrolled_window_get_min_content_height GtkScrolledWindow* scrolled_window")
-(CFNC-300 "void gtk_scrolled_window_set_min_content_height GtkScrolledWindow* scrolled_window gint height")
-;(CFNC-300 "void gtk_widget_queue_draw_region GtkWidget* widget cairo_region_t* [region]")
-(CFNC-300 "GtkWidget* gtk_grid_new void")
-(CFNC-300 "void gtk_grid_attach GtkGrid* grid GtkWidget* child gint left gint top gint width gint height")
-(CFNC-300 "void gtk_grid_attach_next_to GtkGrid* grid GtkWidget* child GtkWidget* sibling GtkPositionType side gint width gint height")
-(CFNC-300 "void gtk_grid_set_row_homogeneous GtkGrid* grid gboolean homogeneous")
-(CFNC-300 "gboolean gtk_grid_get_row_homogeneous GtkGrid* grid")
-(CFNC-300 "void gtk_grid_set_row_spacing GtkGrid* grid guint spacing")
-(CFNC-300 "guint gtk_grid_get_row_spacing GtkGrid* grid")
-(CFNC-300 "void gtk_grid_set_column_homogeneous GtkGrid* grid gboolean homogeneous")
-(CFNC-300 "gboolean gtk_grid_get_column_homogeneous GtkGrid* grid")
-(CFNC-300 "void gtk_grid_set_column_spacing GtkGrid* grid guint spacing")
-(CFNC-300 "guint gtk_grid_get_column_spacing GtkGrid* grid")
-(CFNC-300 "GtkAdjustment* gtk_scrollable_get_hadjustment GtkScrollable* scrollable")
-(CFNC-300 "void gtk_scrollable_set_hadjustment GtkScrollable* scrollable GtkAdjustment* hadjustment")
-(CFNC-300 "GtkAdjustment* gtk_scrollable_get_vadjustment GtkScrollable* scrollable")
-(CFNC-300 "void gtk_scrollable_set_vadjustment GtkScrollable* scrollable GtkAdjustment* vadjustment")
+(CCAST-3.0 "GTK_GRID(obj)" "GtkGrid*")
+(CCHK-3.0 "GTK_IS_GRID(obj)" "GtkGrid*")
+(CCAST-3.0 "GTK_SCROLLABLE(obj)" "GtkScrollable*")
+(CCHK-3.0 "GTK_IS_SCROLLABLE(obj)" "GtkScrollable*")
+
+(CCAST-3.0 "GDK_RGBA(object)" "GdkRGBA*")
+
+(CFNC-3.0 "void gdk_cairo_set_source_rgba cairo_t* cr GdkRGBA* rgba" 'const)
+(CFNC-3.0 "void gdk_window_set_background_rgba GdkWindow* window GdkRGBA* rgba")
+(CFNC-3.0 "void gtk_cell_view_set_background_rgba GtkCellView* cell_view GdkRGBA* rgba" 'const)
+;;; 3.3.16 (CFNC-3.0 "GtkWidget* gtk_color_button_new_with_rgba GdkRGBA* rgba" 'const)
+;;; 3.3.16 (CFNC-3.0 "void gtk_color_button_set_rgba GtkColorButton* color_button GdkRGBA* rgba" 'const)
+;;; 3.3.16 ;(CFNC-3.0 "void gtk_color_button_get_rgba GtkColorButton* color_button GdkRGBA* [rgba]")
+;;; 3.3.16 (CFNC-3.0 "void gtk_color_selection_set_current_rgba GtkColorSelection* colorsel GdkRGBA* rgba" 'const)
+;;; 3.3.16 ;(CFNC-3.0 "void gtk_color_selection_get_current_rgba GtkColorSelection* colorsel GdkRGBA* [rgba]")
+;;; 3.3.16 (CFNC-3.0 "void gtk_color_selection_set_previous_rgba GtkColorSelection* colorsel GdkRGBA* rgba" 'const)
+;;; 3.3.16 ;(CFNC-3.0 "void gtk_color_selection_get_previous_rgba GtkColorSelection* colorsel GdkRGBA* [rgba]")
+(CFNC-3.0 "void gtk_combo_box_text_remove_all GtkComboBoxText* combo_box")
+(CFNC-3.0 "void gtk_combo_box_set_popup_fixed_width GtkComboBox* combo_box gboolean fixed")
+(CFNC-3.0 "gboolean gtk_combo_box_get_popup_fixed_width GtkComboBox* combo_box")
+;(CFNC-3.0 "GAppInfo* gtk_recent_info_create_app_info GtkRecentInfo* info gchar* app_name GError** [error]" 'const)
+;(CFNC-3.0 "GIcon* gtk_recent_info_get_gicon GtkRecentInfo* info")
+(CFNC-3.0 "gint gtk_scrolled_window_get_min_content_width GtkScrolledWindow* scrolled_window")
+(CFNC-3.0 "void gtk_scrolled_window_set_min_content_width GtkScrolledWindow* scrolled_window gint width")
+(CFNC-3.0 "gint gtk_scrolled_window_get_min_content_height GtkScrolledWindow* scrolled_window")
+(CFNC-3.0 "void gtk_scrolled_window_set_min_content_height GtkScrolledWindow* scrolled_window gint height")
+;(CFNC-3.0 "void gtk_widget_queue_draw_region GtkWidget* widget cairo_region_t* [region]")
+(CFNC-3.0 "GtkWidget* gtk_grid_new void")
+(CFNC-3.0 "void gtk_grid_attach GtkGrid* grid GtkWidget* child gint left gint top gint width gint height")
+(CFNC-3.0 "void gtk_grid_attach_next_to GtkGrid* grid GtkWidget* child GtkWidget* sibling GtkPositionType side gint width gint height")
+(CFNC-3.0 "void gtk_grid_set_row_homogeneous GtkGrid* grid gboolean homogeneous")
+(CFNC-3.0 "gboolean gtk_grid_get_row_homogeneous GtkGrid* grid")
+(CFNC-3.0 "void gtk_grid_set_row_spacing GtkGrid* grid guint spacing")
+(CFNC-3.0 "guint gtk_grid_get_row_spacing GtkGrid* grid")
+(CFNC-3.0 "void gtk_grid_set_column_homogeneous GtkGrid* grid gboolean homogeneous")
+(CFNC-3.0 "gboolean gtk_grid_get_column_homogeneous GtkGrid* grid")
+(CFNC-3.0 "void gtk_grid_set_column_spacing GtkGrid* grid guint spacing")
+(CFNC-3.0 "guint gtk_grid_get_column_spacing GtkGrid* grid")
+(CFNC-3.0 "GtkAdjustment* gtk_scrollable_get_hadjustment GtkScrollable* scrollable")
+(CFNC-3.0 "void gtk_scrollable_set_hadjustment GtkScrollable* scrollable GtkAdjustment* hadjustment")
+(CFNC-3.0 "GtkAdjustment* gtk_scrollable_get_vadjustment GtkScrollable* scrollable")
+(CFNC-3.0 "void gtk_scrollable_set_vadjustment GtkScrollable* scrollable GtkAdjustment* vadjustment")
;;; (CAIRO-INT-110 "CAIRO_SURFACE_TYPE_SUBSURFACE" "cairo_surface_t")
;;; 2.91.3
-(CINT-300 "GTK_ASSISTANT_PAGE_CUSTOM" "GtkAssistantPageType")
-(CINT-300 "GTK_TEXT_SEARCH_CASE_INSENSITIVE" "GtkTextSearchFlags")
-(CINT-300 "GTK_SCROLL_MINIMUM" "GtkScrollablePolicy")
-(CINT-300 "GTK_SCROLL_NATURAL" "GtkScrollablePolicy")
-
-(CFNC-300 "void gtk_assistant_next_page GtkAssistant* assistant")
-(CFNC-300 "void gtk_assistant_previous_page GtkAssistant* assistant")
-(CFNC-300 "GtkWidget* gtk_combo_box_new_with_model_and_entry GtkTreeModel* model")
-(CFNC-300 "GtkScrollablePolicy gtk_scrollable_get_hscroll_policy GtkScrollable* scrollable")
-(CFNC-300 "void gtk_scrollable_set_hscroll_policy GtkScrollable* scrollable GtkScrollablePolicy policy")
-(CFNC-300 "GtkScrollablePolicy gtk_scrollable_get_vscroll_policy GtkScrollable* scrollable")
-(CFNC-300 "void gtk_scrollable_set_vscroll_policy GtkScrollable* scrollable GtkScrollablePolicy policy")
+(CINT-3.0 "GTK_ASSISTANT_PAGE_CUSTOM" "GtkAssistantPageType")
+(CINT-3.0 "GTK_TEXT_SEARCH_CASE_INSENSITIVE" "GtkTextSearchFlags")
+(CINT-3.0 "GTK_SCROLL_MINIMUM" "GtkScrollablePolicy")
+(CINT-3.0 "GTK_SCROLL_NATURAL" "GtkScrollablePolicy")
+
+(CFNC-3.0 "void gtk_assistant_next_page GtkAssistant* assistant")
+(CFNC-3.0 "void gtk_assistant_previous_page GtkAssistant* assistant")
+(CFNC-3.0 "GtkWidget* gtk_combo_box_new_with_model_and_entry GtkTreeModel* model")
+(CFNC-3.0 "GtkScrollablePolicy gtk_scrollable_get_hscroll_policy GtkScrollable* scrollable")
+(CFNC-3.0 "void gtk_scrollable_set_hscroll_policy GtkScrollable* scrollable GtkScrollablePolicy policy")
+(CFNC-3.0 "GtkScrollablePolicy gtk_scrollable_get_vscroll_policy GtkScrollable* scrollable")
+(CFNC-3.0 "void gtk_scrollable_set_vscroll_policy GtkScrollable* scrollable GtkScrollablePolicy policy")
;;; 2.91.5
-(CCAST-300 "GTK_SWITCH(obj)" "GtkSwitch*")
-(CCHK-300 "GTK_IS_SWITCH(obj)" "GtkSwitch*")
-(CFNC-300 "GtkWidget* gtk_switch_new void")
-(CFNC-300 "void gtk_switch_set_active GtkSwitch* sw gboolean is_active")
-(CFNC-300 "gboolean gtk_switch_get_active GtkSwitch* sw")
+(CCAST-3.0 "GTK_SWITCH(obj)" "GtkSwitch*")
+(CCHK-3.0 "GTK_IS_SWITCH(obj)" "GtkSwitch*")
+(CFNC-3.0 "GtkWidget* gtk_switch_new void")
+(CFNC-3.0 "void gtk_switch_set_active GtkSwitch* sw gboolean is_active")
+(CFNC-3.0 "gboolean gtk_switch_get_active GtkSwitch* sw")
;;; 2.91.6
;;; a lot of this seems unnecessary -- also omitted the chooseapplication stuff and whatnot
-(CFNC-300 "cairo_region_t* gdk_window_get_clip_region GdkWindow* window")
-(CFNC-300 "cairo_region_t* gdk_window_get_visible_region GdkWindow* window")
-(CFNC-300 "GtkBorder* gtk_border_new void")
-(CFNC-300 "GtkBorder* gtk_border_copy GtkBorder* border_" 'const)
-(CFNC-300 "void gtk_border_free GtkBorder* border_")
-(CFNC-300 "gint gtk_combo_box_get_id_column GtkComboBox* combo_box")
-(CFNC-300 "void gtk_combo_box_set_id_column GtkComboBox* combo_box gint id_column")
-(CFNC-300 "gchar* gtk_combo_box_get_active_id GtkComboBox* combo_box" 'const)
-(CFNC-300 "void gtk_combo_box_set_active_id GtkComboBox* combo_box gchar* active_id" 'const)
-(CFNC-300 "void gtk_combo_box_text_insert GtkComboBoxText* combo_box gint position gchar* id gchar* text" 'const)
-(CFNC-300 "void gtk_combo_box_text_append GtkComboBoxText* combo_box gchar* id gchar* text" 'const)
-(CFNC-300 "void gtk_combo_box_text_prepend GtkComboBoxText* combo_box gchar* id gchar* text" 'const)
+(CFNC-3.0 "cairo_region_t* gdk_window_get_clip_region GdkWindow* window")
+(CFNC-3.0 "cairo_region_t* gdk_window_get_visible_region GdkWindow* window")
+(CFNC-3.0 "GtkBorder* gtk_border_new void")
+(CFNC-3.0 "GtkBorder* gtk_border_copy GtkBorder* border_" 'const)
+(CFNC-3.0 "void gtk_border_free GtkBorder* border_")
+(CFNC-3.0 "gint gtk_combo_box_get_id_column GtkComboBox* combo_box")
+(CFNC-3.0 "void gtk_combo_box_set_id_column GtkComboBox* combo_box gint id_column")
+(CFNC-3.0 "gchar* gtk_combo_box_get_active_id GtkComboBox* combo_box" 'const)
+;;; 3.1.4 changed type (CFNC-3.0 "void gtk_combo_box_set_active_id GtkComboBox* combo_box gchar* active_id" 'const)
+(CFNC-3.0 "void gtk_combo_box_text_insert GtkComboBoxText* combo_box gint position gchar* id gchar* text" 'const)
+(CFNC-3.0 "void gtk_combo_box_text_append GtkComboBoxText* combo_box gchar* id gchar* text" 'const)
+(CFNC-3.0 "void gtk_combo_box_text_prepend GtkComboBoxText* combo_box gchar* id gchar* text" 'const)
;; forgotten?
-(CFNC-300 "GtkWidget* gtk_button_box_new GtkOrientation orientation")
-(CFNC-300 "GtkWidget* gtk_box_new GtkOrientation orientation gint spacing")
+(CFNC-3.0 "GtkWidget* gtk_button_box_new GtkOrientation orientation")
+(CFNC-3.0 "GtkWidget* gtk_box_new GtkOrientation orientation gint spacing")
; are these leftovers?
-;(CCAST-300 "GTK_VOLUME_BUTTON" "GtkVolumeButton*")
-;(CCHK-300 "GTK_IS_VOLUME_BUTTON" "GtkVolumeButton*")
-;(CFNC-300 "GtkWidget* gtk_volume_button_new void")
-;(CCAST-300 "GTK_SCALE_BUTTON" "GtkScaleButton*")
-;(CCHK-300 "GTK_IS_SCALE_BUTTON" "GtkScaleButton*")
-;(CFNC-300 "GtkWidget* gtk_scale_button_new GtkIconSize size gdouble min gdouble max gdouble step gchar** icons" 'const)
-;(CFNC-300 "void gtk_scale_button_set_icons GtkScaleButton* button gchar** icons" 'const)
-;(CFNC-300 "gdouble gtk_scale_button_get_value GtkScaleButton* button")
-;(CFNC-300 "void gtk_scale_button_set_value GtkScaleButton* button gdouble value")
-;(CFNC-300 "GtkAdjustment* gtk_scale_button_get_adjustment GtkScaleButton* button")
-;(CFNC-300 "void gtk_scale_button_set_adjustment GtkScaleButton* button GtkAdjustment* adjustment")
-;(CFNC-300 "GtkWidget* gtk_scale_button_get_plus_button GtkScaleButton* button")
-;(CFNC-300 "GtkWidget* gtk_scale_button_get_minus_button GtkScaleButton* button")
-;(CFNC-300 "GtkWidget* gtk_scale_button_get_popup GtkScaleButton* button")
+;(CCAST-3.0 "GTK_VOLUME_BUTTON" "GtkVolumeButton*")
+;(CCHK-3.0 "GTK_IS_VOLUME_BUTTON" "GtkVolumeButton*")
+;(CFNC-3.0 "GtkWidget* gtk_volume_button_new void")
+;(CCAST-3.0 "GTK_SCALE_BUTTON" "GtkScaleButton*")
+;(CCHK-3.0 "GTK_IS_SCALE_BUTTON" "GtkScaleButton*")
+;;; ;(CFNC-3.0 "GtkWidget* gtk_scale_button_new GtkIconSize size gdouble min gdouble max gdouble step gchar** icons" 'const)
+;(CFNC-3.0 "void gtk_scale_button_set_icons GtkScaleButton* button gchar** icons" 'const)
+;(CFNC-3.0 "gdouble gtk_scale_button_get_value GtkScaleButton* button")
+;(CFNC-3.0 "void gtk_scale_button_set_value GtkScaleButton* button gdouble value")
+;(CFNC-3.0 "GtkAdjustment* gtk_scale_button_get_adjustment GtkScaleButton* button")
+;(CFNC-3.0 "void gtk_scale_button_set_adjustment GtkScaleButton* button GtkAdjustment* adjustment")
+;(CFNC-3.0 "GtkWidget* gtk_scale_button_get_plus_button GtkScaleButton* button")
+;(CFNC-3.0 "GtkWidget* gtk_scale_button_get_minus_button GtkScaleButton* button")
+;(CFNC-3.0 "GtkWidget* gtk_scale_button_get_popup GtkScaleButton* button")
;; message dialog depends completely on va lists
-(CCAST-300 "GTK_ACTIVATABLE" "GtkActivatable*")
-(CCHK-300 "GTK_IS_ACTIVATABLE" "GtkActivatable*")
-(CFNC-300 "void gtk_activatable_sync_action_properties GtkActivatable* activatable GtkAction* action")
-(CFNC-300 "void gtk_activatable_set_related_action GtkActivatable* activatable GtkAction* action")
-(CFNC-300 "GtkAction* gtk_activatable_get_related_action GtkActivatable* activatable")
-(CFNC-300 "void gtk_activatable_set_use_action_appearance GtkActivatable* activatable gboolean use_appearance")
-(CFNC-300 "gboolean gtk_activatable_get_use_action_appearance GtkActivatable* activatable")
+;;; (CCAST-3.0 "GTK_ACTIVATABLE" "GtkActivatable*")
+;;; (CCHK-3.0 "GTK_IS_ACTIVATABLE" "GtkActivatable*")
+;;; (CFNC-3.0 "void gtk_activatable_sync_action_properties GtkActivatable* activatable GtkAction* action")
+;;; (CFNC-3.0 "void gtk_activatable_set_related_action GtkActivatable* activatable GtkAction* action")
+;;; (CFNC-3.0 "GtkAction* gtk_activatable_get_related_action GtkActivatable* activatable")
+;;; (CFNC-3.0 "void gtk_activatable_set_use_action_appearance GtkActivatable* activatable gboolean use_appearance")
+;;; (CFNC-3.0 "gboolean gtk_activatable_get_use_action_appearance GtkActivatable* activatable")
-(CINT-300 "GTK_TARGET_SAME_APP" "GtkTargetFlags")
-(CINT-300 "GTK_TARGET_SAME_WIDGET" "GtkTargetFlags")
-(CINT-300 "GTK_TARGET_OTHER_APP" "GtkTargetFlags")
-(CINT-300 "GTK_TARGET_OTHER_WIDGET" "GtkTargetFlags")
+(CINT-3.0 "GTK_TARGET_SAME_APP" "GtkTargetFlags")
+(CINT-3.0 "GTK_TARGET_SAME_WIDGET" "GtkTargetFlags")
+(CINT-3.0 "GTK_TARGET_OTHER_APP" "GtkTargetFlags")
+(CINT-3.0 "GTK_TARGET_OTHER_WIDGET" "GtkTargetFlags")
-(CINT-300 "GTK_ALIGN_FILL" "GtkAlign")
-(CINT-300 "GTK_ALIGN_START" "GtkAlign")
-(CINT-300 "GTK_ALIGN_END" "GtkAlign")
-(CINT-300 "GTK_ALIGN_CENTER" "GtkAlign")
+(CINT-3.0 "GTK_ALIGN_FILL" "GtkAlign")
+(CINT-3.0 "GTK_ALIGN_START" "GtkAlign")
+(CINT-3.0 "GTK_ALIGN_END" "GtkAlign")
+(CINT-3.0 "GTK_ALIGN_CENTER" "GtkAlign")
-(CINT-300 "GTK_ARROW_NONE" "GtkArrowType")
+;;; 3.13.2 (CINT-3.0 "GTK_ARROW_NONE" "GtkArrowType")
-;(CINT-300 "GTK_IM_PREEDIT_NOTHING" "GtkIMPreeditStyle")
-;(CINT-300 "GTK_IM_PREEDIT_CALLBACK" "GtkIMPreeditStyle")
-;(CINT-300 "GTK_IM_PREEDIT_NONE" "GtkIMPreeditStyle")
+;(CINT-3.0 "GTK_IM_PREEDIT_NOTHING" "GtkIMPreeditStyle")
+;(CINT-3.0 "GTK_IM_PREEDIT_CALLBACK" "GtkIMPreeditStyle")
+;(CINT-3.0 "GTK_IM_PREEDIT_NONE" "GtkIMPreeditStyle")
-;(CINT-300 "GTK_IM_STATUS_NOTHING" "GtkIMStatusStyle")
-;(CINT-300 "GTK_IM_STATUS_CALLBACK" "GtkIMStatusStyle")
-;(CINT-300 "GTK_IM_STATUS_NONE" "GtkIMStatusStyle")
+;(CINT-3.0 "GTK_IM_STATUS_NOTHING" "GtkIMStatusStyle")
+;(CINT-3.0 "GTK_IM_STATUS_CALLBACK" "GtkIMStatusStyle")
+;(CINT-3.0 "GTK_IM_STATUS_NONE" "GtkIMStatusStyle")
;; printer stuff
-;(CINT-300 "GTK_PRINT_PAGES_ALL" "GtkPrintPages")
-;(CINT-300 "GTK_PRINT_PAGES_CURRENT" "GtkPrintPages")
-;(CINT-300 "GTK_PRINT_PAGES_RANGES" "GtkPrintPages")
-
-;(CINT-300 "GTK_PRINT_PAGES_SELECTION" "GtkPrintPages")
-;(CINT-300 "GTK_PAGE_SET_ALL" "GtkPageSet")
-;(CINT-300 "GTK_PAGE_SET_EVEN" "GtkPageSet")
-;(CINT-300 "GTK_PAGE_SET_ODD" "GtkPageSet")
-
-;(CINT-300 "GTK_NUMBER_UP_LAYOUT_LEFT_TO_RIGHT_TOP_TO_BOTTOM" "GtkNumberUpLayout")
-;(CINT-300 "GTK_NUMBER_UP_LAYOUT_LEFT_TO_RIGHT_BOTTOM_TO_TOP" "GtkNumberUpLayout")
-;(CINT-300 "GTK_NUMBER_UP_LAYOUT_RIGHT_TO_LEFT_TOP_TO_BOTTOM" "GtkNumberUpLayout")
-;(CINT-300 "GTK_NUMBER_UP_LAYOUT_RIGHT_TO_LEFT_BOTTOM_TO_TOP" "GtkNumberUpLayout")
-;(CINT-300 "GTK_NUMBER_UP_LAYOUT_TOP_TO_BOTTOM_LEFT_TO_RIGHT" "GtkNumberUpLayout")
-;(CINT-300 "GTK_NUMBER_UP_LAYOUT_TOP_TO_BOTTOM_RIGHT_TO_LEFT" "GtkNumberUpLayout")
-;(CINT-300 "GTK_NUMBER_UP_LAYOUT_BOTTOM_TO_TOP_LEFT_TO_RIGHT" "GtkNumberUpLayout")
-;(CINT-300 "GTK_NUMBER_UP_LAYOUT_BOTTOM_TO_TOP_RIGHT_TO_LEFT" "GtkNumberUpLayout")
-
-;(CINT-300 "GTK_PAGE_ORIENTATION_PORTRAIT" "GtkPageOrientation")
-;(CINT-300 "GTK_PAGE_ORIENTATION_LANDSCAPE" "GtkPageOrientation")
-;(CINT-300 "GTK_PAGE_ORIENTATION_REVERSE_PORTRAIT" "GtkPageOrientation")
-;(CINT-300 "GTK_PAGE_ORIENTATION_REVERSE_LANDSCAPE" "GtkPageOrientation")
-
-;(CINT-300 "GTK_PRINT_QUALITY_LOW" "GtkPrintQuality")
-;(CINT-300 "GTK_PRINT_QUALITY_NORMAL" "GtkPrintQuality")
-;(CINT-300 "GTK_PRINT_QUALITY_HIGH" "GtkPrintQuality")
-;(CINT-300 "GTK_PRINT_QUALITY_DRAFT" "GtkPrintQuality")
-
-;(CINT-300 "GTK_PRINT_DUPLEX_SIMPLEX" "GtkPrintDuplex")
-;(CINT-300 "GTK_PRINT_DUPLEX_HORIZONTAL" "GtkPrintDuplex")
-;(CINT-300 "GTK_PRINT_DUPLEX_VERTICAL" "GtkPrintDuplex")
-
-;(CINT-300 "GTK_UNIT_PIXEL" "GtkUnit")
-;(CINT-300 "GTK_UNIT_POINTS" "GtkUnit")
-;(CINT-300 "GTK_UNIT_INCH" "GtkUnit")
-;(CINT-300 "GTK_UNIT_MM" "GtkUnit")
-
-;; these are still undeprecated?
-;(CINT-300 "GTK_STATE_FLAG_ACTIVE" "GtkStateFlags")
-;(CINT-300 "GTK_STATE_FLAG_PRELIGHT" "GtkStateFlags")
-;(CINT-300 "GTK_STATE_FLAG_SELECTED" "GtkStateFlags")
-;(CINT-300 "GTK_STATE_FLAG_INSENSITIVE" "GtkStateFlags")
-;(CINT-300 "GTK_STATE_FLAG_INCONSISTENT" "GtkStateFlags")
-;(CINT-300 "GTK_STATE_FLAG_FOCUSED" "GtkStateFlags")
-
-(CINT-300 "GTK_TOOL_PALETTE_DRAG_ITEMS" "GtkToolPaletteDragTargets")
-(CINT-300 "GTK_TOOL_PALETTE_DRAG_GROUPS" "GtkToolPaletteDragTargets")
-
-(CSTR-300 "GTK_STOCK_DIALOG_AUTHENTICATION")
-(CSTR-300 "GTK_STOCK_PAGE_SETUP")
-(CSTR-300 "GTK_STOCK_PRINT_ERROR")
-(CSTR-300 "GTK_STOCK_PRINT_PAUSED")
-(CSTR-300 "GTK_STOCK_PRINT_REPORT")
-(CSTR-300 "GTK_STOCK_PRINT_WARNING")
-
-(CFNC-300 "void gtk_tree_view_set_cursor_on_cell GtkTreeView* tree_view GtkTreePath* path GtkTreeViewColumn* focus_column GtkCellRenderer* focus_cell gboolean start_editing")
-(CFNC-300 "void gtk_tree_view_set_rubber_banding GtkTreeView* tree_view gboolean enable")
-(CFNC-300 "gboolean gtk_tree_view_get_rubber_banding GtkTreeView* tree_view")
-(CFNC-300 "void gtk_tooltip_set_markup GtkTooltip* tooltip gchar* markup" 'const)
-(CFNC-300 "void gtk_tooltip_set_icon GtkTooltip* tooltip GdkPixbuf* pixbuf")
-(CFNC-300 "void gtk_tooltip_set_icon_from_stock GtkTooltip* tooltip gchar* stock_id GtkIconSize size" 'const)
-(CFNC-300 "void gtk_tooltip_set_custom GtkTooltip* tooltip GtkWidget* custom_widget")
-(CFNC-300 "void gtk_tooltip_trigger_tooltip_query GdkDisplay* display")
-(CFNC-300 "void gtk_button_set_image_position GtkButton* button GtkPositionType position")
-(CFNC-300 "GtkPositionType gtk_button_get_image_position GtkButton* button")
-(CFNC-300 "gboolean gtk_show_uri GdkScreen* screen gchar* uri guint32 timestamp GError** [error]" 'const)
-(CFNC-300 "GtkTreeViewColumn* gtk_tree_view_column_new_with_area GtkCellArea* area")
-(CFNC-300 "GtkWidget* gtk_tree_view_column_get_button GtkTreeViewColumn* tree_column")
-(CFNC-300 "void gtk_tree_view_column_focus_cell GtkTreeViewColumn* tree_column GtkCellRenderer* cell")
-
-;(CFNC-300 "AtkObject* gtk_combo_box_get_popup_accessible GtkComboBox* combo_box")
-
-;(CFNC-300 "void gtk_clipboard_request_uris GtkClipboard* clipboard GtkClipboardURIReceivedFunc callback gpointer user_data")
-;(CFNC-300 "gchar** gtk_clipboard_wait_for_uris GtkClipboard* clipboard")
-(CFNC-300 "gboolean gtk_clipboard_wait_is_uris_available GtkClipboard* clipboard")
-
-(CFNC-300 "void gtk_toolbar_set_drop_highlight_item GtkToolbar* toolbar GtkToolItem* tool_item gint index")
-(CFNC-300 "void gtk_tool_item_toolbar_reconfigured GtkToolItem* tool_item")
-
-(CCAST-300 "GTK_ORIENTABLE" "GtkOrientable*")
-(CCHK-300 "GTK_IS_ORIENTABLE" "GtkOrientable*")
-(CFNC-300 "void gtk_orientable_set_orientation GtkOrientable* orientable GtkOrientation orientation")
-(CFNC-300 "GtkOrientation gtk_orientable_get_orientation GtkOrientable* orientable")
-
-(CFNC-300 "void gtk_parse_args int* {argc} char*** |argv|")
-(CFNC-300 "guint gtk_get_major_version void" 'const-return)
-(CFNC-300 "guint gtk_get_minor_version void" 'const-return)
-(CFNC-300 "guint gtk_get_micro_version void" 'const-return)
-(CFNC-300 "guint gtk_get_binary_age void" 'const-return)
-(CFNC-300 "guint gtk_get_interface_age void" 'const-return)
-;(CFNC-300 "GOptionGroup* gtk_get_option_group gboolean open_default_display")
-
-(CINT-300 "GTK_IMAGE_GICON" "GtkImageType")
-(CFNC-300 "GtkWidget* gtk_image_new_from_gicon GIcon* icon GtkIconSize size")
-(CFNC-300 "void gtk_image_set_from_gicon GtkImage* image GIcon* icon GtkIconSize size")
-(CFNC-300 "void gtk_image_get_gicon GtkImage* image GIcon** [gicon] GtkIconSize* [size]")
-
-(CFNC-300 "void gtk_progress_bar_set_show_text GtkProgressBar* pbar gboolean show_text")
-(CFNC-300 "gboolean gtk_progress_bar_get_show_text GtkProgressBar* pbar")
+;(CINT-3.0 "GTK_PRINT_PAGES_ALL" "GtkPrintPages")
+;(CINT-3.0 "GTK_PRINT_PAGES_CURRENT" "GtkPrintPages")
+;(CINT-3.0 "GTK_PRINT_PAGES_RANGES" "GtkPrintPages")
+
+;(CINT-3.0 "GTK_PRINT_PAGES_SELECTION" "GtkPrintPages")
+;(CINT-3.0 "GTK_PAGE_SET_ALL" "GtkPageSet")
+;(CINT-3.0 "GTK_PAGE_SET_EVEN" "GtkPageSet")
+;(CINT-3.0 "GTK_PAGE_SET_ODD" "GtkPageSet")
+
+;(CINT-3.0 "GTK_NUMBER_UP_LAYOUT_LEFT_TO_RIGHT_TOP_TO_BOTTOM" "GtkNumberUpLayout")
+;(CINT-3.0 "GTK_NUMBER_UP_LAYOUT_LEFT_TO_RIGHT_BOTTOM_TO_TOP" "GtkNumberUpLayout")
+;(CINT-3.0 "GTK_NUMBER_UP_LAYOUT_RIGHT_TO_LEFT_TOP_TO_BOTTOM" "GtkNumberUpLayout")
+;(CINT-3.0 "GTK_NUMBER_UP_LAYOUT_RIGHT_TO_LEFT_BOTTOM_TO_TOP" "GtkNumberUpLayout")
+;(CINT-3.0 "GTK_NUMBER_UP_LAYOUT_TOP_TO_BOTTOM_LEFT_TO_RIGHT" "GtkNumberUpLayout")
+;(CINT-3.0 "GTK_NUMBER_UP_LAYOUT_TOP_TO_BOTTOM_RIGHT_TO_LEFT" "GtkNumberUpLayout")
+;(CINT-3.0 "GTK_NUMBER_UP_LAYOUT_BOTTOM_TO_TOP_LEFT_TO_RIGHT" "GtkNumberUpLayout")
+;(CINT-3.0 "GTK_NUMBER_UP_LAYOUT_BOTTOM_TO_TOP_RIGHT_TO_LEFT" "GtkNumberUpLayout")
+
+;(CINT-3.0 "GTK_PAGE_ORIENTATION_PORTRAIT" "GtkPageOrientation")
+;(CINT-3.0 "GTK_PAGE_ORIENTATION_LANDSCAPE" "GtkPageOrientation")
+;(CINT-3.0 "GTK_PAGE_ORIENTATION_REVERSE_PORTRAIT" "GtkPageOrientation")
+;(CINT-3.0 "GTK_PAGE_ORIENTATION_REVERSE_LANDSCAPE" "GtkPageOrientation")
+
+;(CINT-3.0 "GTK_PRINT_QUALITY_LOW" "GtkPrintQuality")
+;(CINT-3.0 "GTK_PRINT_QUALITY_NORMAL" "GtkPrintQuality")
+;(CINT-3.0 "GTK_PRINT_QUALITY_HIGH" "GtkPrintQuality")
+;(CINT-3.0 "GTK_PRINT_QUALITY_DRAFT" "GtkPrintQuality")
+
+;(CINT-3.0 "GTK_PRINT_DUPLEX_SIMPLEX" "GtkPrintDuplex")
+;(CINT-3.0 "GTK_PRINT_DUPLEX_HORIZONTAL" "GtkPrintDuplex")
+;(CINT-3.0 "GTK_PRINT_DUPLEX_VERTICAL" "GtkPrintDuplex")
+
+;(CINT-3.0 "GTK_UNIT_PIXEL" "GtkUnit")
+;(CINT-3.0 "GTK_UNIT_POINTS" "GtkUnit")
+;(CINT-3.0 "GTK_UNIT_INCH" "GtkUnit")
+;(CINT-3.0 "GTK_UNIT_MM" "GtkUnit")
+
+(CINT-3.0 "GTK_TOOL_PALETTE_DRAG_ITEMS" "GtkToolPaletteDragTargets")
+(CINT-3.0 "GTK_TOOL_PALETTE_DRAG_GROUPS" "GtkToolPaletteDragTargets")
+
+;;; (CSTR-3.0 "GTK_STOCK_DIALOG_AUTHENTICATION")
+;;; (CSTR-3.0 "GTK_STOCK_PAGE_SETUP")
+;;; (CSTR-3.0 "GTK_STOCK_PRINT_ERROR")
+;;; (CSTR-3.0 "GTK_STOCK_PRINT_PAUSED")
+;;; (CSTR-3.0 "GTK_STOCK_PRINT_REPORT")
+;;; (CSTR-3.0 "GTK_STOCK_PRINT_WARNING")
+
+(CFNC-3.0 "void gtk_tree_view_set_cursor_on_cell GtkTreeView* tree_view GtkTreePath* path GtkTreeViewColumn* focus_column GtkCellRenderer* focus_cell gboolean start_editing")
+(CFNC-3.0 "void gtk_tree_view_set_rubber_banding GtkTreeView* tree_view gboolean enable")
+(CFNC-3.0 "gboolean gtk_tree_view_get_rubber_banding GtkTreeView* tree_view")
+(CFNC-3.0 "void gtk_tooltip_set_markup GtkTooltip* tooltip gchar* markup" 'const)
+(CFNC-3.0 "void gtk_tooltip_set_icon GtkTooltip* tooltip GdkPixbuf* pixbuf")
+;;; (CFNC-3.0 "void gtk_tooltip_set_icon_from_stock GtkTooltip* tooltip gchar* stock_id GtkIconSize size" 'const)
+(CFNC-3.0 "void gtk_tooltip_set_custom GtkTooltip* tooltip GtkWidget* custom_widget")
+(CFNC-3.0 "void gtk_tooltip_trigger_tooltip_query GdkDisplay* display")
+(CFNC-3.0 "void gtk_button_set_image_position GtkButton* button GtkPositionType position")
+(CFNC-3.0 "GtkPositionType gtk_button_get_image_position GtkButton* button")
+(CFNC-3.0 "gboolean gtk_show_uri GdkScreen* screen gchar* uri guint32 timestamp GError** [error]" 'const)
+(CFNC-3.0 "GtkTreeViewColumn* gtk_tree_view_column_new_with_area GtkCellArea* area")
+(CFNC-3.0 "GtkWidget* gtk_tree_view_column_get_button GtkTreeViewColumn* tree_column")
+(CFNC-3.0 "void gtk_tree_view_column_focus_cell GtkTreeViewColumn* tree_column GtkCellRenderer* cell")
+
+;(CFNC-3.0 "AtkObject* gtk_combo_box_get_popup_accessible GtkComboBox* combo_box")
+
+;(CFNC-3.0 "void gtk_clipboard_request_uris GtkClipboard* clipboard GtkClipboardURIReceivedFunc callback gpointer user_data")
+;(CFNC-3.0 "gchar** gtk_clipboard_wait_for_uris GtkClipboard* clipboard")
+(CFNC-3.0 "gboolean gtk_clipboard_wait_is_uris_available GtkClipboard* clipboard")
+
+(CFNC-3.0 "void gtk_toolbar_set_drop_highlight_item GtkToolbar* toolbar GtkToolItem* tool_item gint index")
+(CFNC-3.0 "void gtk_tool_item_toolbar_reconfigured GtkToolItem* tool_item")
+
+(CCAST-3.0 "GTK_ORIENTABLE" "GtkOrientable*")
+(CCHK-3.0 "GTK_IS_ORIENTABLE" "GtkOrientable*")
+(CFNC-3.0 "void gtk_orientable_set_orientation GtkOrientable* orientable GtkOrientation orientation")
+(CFNC-3.0 "GtkOrientation gtk_orientable_get_orientation GtkOrientable* orientable")
+
+(CFNC-3.0 "void gtk_parse_args int* {argc} char*** |argv|")
+(CFNC-3.0 "guint gtk_get_major_version void" 'const-return)
+(CFNC-3.0 "guint gtk_get_minor_version void" 'const-return)
+(CFNC-3.0 "guint gtk_get_micro_version void" 'const-return)
+(CFNC-3.0 "guint gtk_get_binary_age void" 'const-return)
+(CFNC-3.0 "guint gtk_get_interface_age void" 'const-return)
+;(CFNC-3.0 "GOptionGroup* gtk_get_option_group gboolean open_default_display")
+
+(CINT-3.0 "GTK_IMAGE_GICON" "GtkImageType")
+;;; (CFNC-3.0 "GtkWidget* gtk_image_new_from_gicon GIcon* icon GtkIconSize size")
+;;; (CFNC-3.0 "void gtk_image_set_from_gicon GtkImage* image GIcon* icon GtkIconSize size")
+;;; (CFNC-3.0 "void gtk_image_get_gicon GtkImage* image GIcon** [gicon] GtkIconSize* [size]")
+
+(CFNC-3.0 "void gtk_progress_bar_set_show_text GtkProgressBar* pbar gboolean show_text")
+(CFNC-3.0 "gboolean gtk_progress_bar_get_show_text GtkProgressBar* pbar")
-(CFNC-300 "GtkWidget* gtk_invisible_new_for_screen GdkScreen* screen")
-(CFNC-300 "void gtk_invisible_set_screen GtkInvisible* invisible GdkScreen* screen")
-(CFNC-300 "GdkScreen* gtk_invisible_get_screen GtkInvisible* invisible")
-
-(CFNC-300 "GtkImageType gtk_entry_get_icon_storage_type GtkEntry* entry GtkEntryIconPosition icon_pos")
-(CFNC-300 "GdkPixbuf* gtk_entry_get_icon_pixbuf GtkEntry* entry GtkEntryIconPosition icon_pos")
-(CFNC-300 "gchar* gtk_entry_get_icon_stock GtkEntry* entry GtkEntryIconPosition icon_pos" 'const-return)
-(CFNC-300 "GIcon* gtk_entry_get_icon_gicon GtkEntry* entry GtkEntryIconPosition icon_pos")
-;(CFNC-300 "void gtk_entry_get_icon_area GtkEntry* entry GtkEntryIconPosition icon_pos GdkRectangle* [icon_area]")
-;(CFNC-300 "void gtk_entry_get_text_area GtkEntry* entry GdkRectangle* [text_area]")
-;(CFNC-300 "gboolean gtk_entry_im_context_filter_keypress GtkEntry* entry GdkEventKey* event")
-;(CFNC-300 "void gtk_entry_reset_im_context GtkEntry* entry")
-
-(CFNC-300 "void gtk_container_propagate_draw GtkContainer* container GtkWidget* child cairo_t* cr")
-(CFNC-300 "void gtk_container_set_focus_chain GtkContainer* container GList* focusable_widgets")
-(CFNC-300 "gboolean gtk_container_get_focus_chain GtkContainer* container GList** [focusable_widgets]")
-(CFNC-300 "void gtk_container_unset_focus_chain GtkContainer* container")
-(CFNC-300 "void gtk_container_set_reallocate_redraws GtkContainer* container gboolean needs_redraws")
-(CFNC-300 "void gtk_container_set_focus_child GtkContainer* container GtkWidget* child")
-(CFNC-300 "void gtk_container_set_focus_vadjustment GtkContainer* container GtkAdjustment* adjustment")
-(CFNC-300 "GtkAdjustment* gtk_container_get_focus_vadjustment GtkContainer* container")
-(CFNC-300 "void gtk_container_set_focus_hadjustment GtkContainer* container GtkAdjustment* adjustment")
-(CFNC-300 "GtkAdjustment* gtk_container_get_focus_hadjustment GtkContainer* container")
-(CFNC-300 "void gtk_container_resize_children GtkContainer* container")
-
-(CFNC-300 "void gtk_assistant_commit GtkAssistant* assistant")
-
-(CFNC-300 "char* gtk_im_multicontext_get_context_id GtkIMMulticontext* context" 'const-return)
-(CFNC-300 "void gtk_im_multicontext_set_context_id GtkIMMulticontext* context char* context_id" 'const)
-
-(CINT-300 "GTK_FILE_CHOOSER_ERROR" "GtkFileChooserError")
-(CINT-300 "GTK_FILE_CHOOSER_ERROR_NONEXISTENT" "GtkFileChooserError")
-(CINT-300 "GTK_FILE_CHOOSER_ERROR_BAD_FILENAME" "GtkFileChooserError")
-(CINT-300 "GTK_FILE_CHOOSER_ERROR_ALREADY_EXISTS" "GtkFileChooserError")
-(CINT-300 "GTK_FILE_CHOOSER_ERROR_INCOMPLETE_HOSTNAME" "GtkFileChooserError")
+(CFNC-3.0 "GtkWidget* gtk_invisible_new_for_screen GdkScreen* screen")
+(CFNC-3.0 "void gtk_invisible_set_screen GtkInvisible* invisible GdkScreen* screen")
+(CFNC-3.0 "GdkScreen* gtk_invisible_get_screen GtkInvisible* invisible")
+
+(CFNC-3.0 "GtkImageType gtk_entry_get_icon_storage_type GtkEntry* entry GtkEntryIconPosition icon_pos")
+(CFNC-3.0 "GdkPixbuf* gtk_entry_get_icon_pixbuf GtkEntry* entry GtkEntryIconPosition icon_pos")
+;;; 3.9.8 (CFNC-3.0 "gchar* gtk_entry_get_icon_stock GtkEntry* entry GtkEntryIconPosition icon_pos" 'const-return)
+(CFNC-3.0 "GIcon* gtk_entry_get_icon_gicon GtkEntry* entry GtkEntryIconPosition icon_pos")
+;(CFNC-3.0 "void gtk_entry_get_icon_area GtkEntry* entry GtkEntryIconPosition icon_pos GdkRectangle* [icon_area]")
+;(CFNC-3.0 "void gtk_entry_get_text_area GtkEntry* entry GdkRectangle* [text_area]")
+;(CFNC-3.0 "gboolean gtk_entry_im_context_filter_keypress GtkEntry* entry GdkEventKey* event")
+;(CFNC-3.0 "void gtk_entry_reset_im_context GtkEntry* entry")
+
+(CFNC-3.0 "void gtk_container_propagate_draw GtkContainer* container GtkWidget* child cairo_t* cr")
+(CFNC-3.0 "void gtk_container_set_focus_chain GtkContainer* container GList* focusable_widgets")
+(CFNC-3.0 "gboolean gtk_container_get_focus_chain GtkContainer* container GList** [focusable_widgets]")
+(CFNC-3.0 "void gtk_container_unset_focus_chain GtkContainer* container")
+;;; 3.13.2 (CFNC-3.0 "void gtk_container_set_reallocate_redraws GtkContainer* container gboolean needs_redraws")
+(CFNC-3.0 "void gtk_container_set_focus_child GtkContainer* container GtkWidget* child")
+(CFNC-3.0 "void gtk_container_set_focus_vadjustment GtkContainer* container GtkAdjustment* adjustment")
+(CFNC-3.0 "GtkAdjustment* gtk_container_get_focus_vadjustment GtkContainer* container")
+(CFNC-3.0 "void gtk_container_set_focus_hadjustment GtkContainer* container GtkAdjustment* adjustment")
+(CFNC-3.0 "GtkAdjustment* gtk_container_get_focus_hadjustment GtkContainer* container")
+;;; 3.9.4 (CFNC-3.0 "void gtk_container_resize_children GtkContainer* container")
+
+(CFNC-3.0 "void gtk_assistant_commit GtkAssistant* assistant")
+
+;;; (CFNC-3.0 "char* gtk_im_multicontext_get_context_id GtkIMMulticontext* context" 'const-return)
+;;; (CFNC-3.0 "void gtk_im_multicontext_set_context_id GtkIMMulticontext* context char* context_id" 'const)
+
+(CINT-3.0 "GTK_FILE_CHOOSER_ERROR" "GtkFileChooserError")
+(CINT-3.0 "GTK_FILE_CHOOSER_ERROR_NONEXISTENT" "GtkFileChooserError")
+(CINT-3.0 "GTK_FILE_CHOOSER_ERROR_BAD_FILENAME" "GtkFileChooserError")
+(CINT-3.0 "GTK_FILE_CHOOSER_ERROR_ALREADY_EXISTS" "GtkFileChooserError")
+(CINT-3.0 "GTK_FILE_CHOOSER_ERROR_INCOMPLETE_HOSTNAME" "GtkFileChooserError")
;gtkfilechooser: gtk_file_chooser_error_quark
-(CFNC-300 "void gtk_about_dialog_set_license_type GtkAboutDialog* about GtkLicense license_type")
-(CFNC-300 "GtkLicense gtk_about_dialog_get_license_type GtkAboutDialog* about")
-;void gtk_show_about_dialog GtkWindow* parent gchar* first_property_name ...)
-(CINT-300 "GTK_LICENSE_UNKNOWN" "GtkLicense")
-(CINT-300 "GTK_LICENSE_CUSTOM" "GtkLicense")
-(CINT-300 "GTK_LICENSE_GPL_2_0" "GtkLicense")
-(CINT-300 "GTK_LICENSE_GPL_3_0" "GtkLicense")
-(CINT-300 "GTK_LICENSE_LGPL_2_1" "GtkLicense")
-(CINT-300 "GTK_LICENSE_LGPL_3_0" "GtkLicense")
-(CINT-300 "GTK_LICENSE_BSD" "GtkLicense")
-(CINT-300 "GTK_LICENSE_MIT_X11" "GtkLicense")
-(CINT-300 "GTK_LICENSE_ARTISTIC" "GtkLicense")
-
-(CFNC-300 "void gtk_window_set_skip_taskbar_hint GtkWindow* window gboolean setting")
-(CFNC-300 "gboolean gtk_window_get_skip_taskbar_hint GtkWindow* window")
-(CFNC-300 "void gtk_window_set_skip_pager_hint GtkWindow* window gboolean setting")
-(CFNC-300 "gboolean gtk_window_get_skip_pager_hint GtkWindow* window")
-(CFNC-300 "void gtk_window_set_screen GtkWindow* window GdkScreen* screen")
-(CFNC-300 "GdkScreen* gtk_window_get_screen GtkWindow* window")
-(CFNC-300 "gboolean gtk_window_set_icon_from_file GtkWindow* window gchar* filename GError** [err]" 'const)
-(CFNC-300 "gboolean gtk_window_set_default_icon_from_file gchar* filename GError** [err]" 'const)
-(CFNC-300 "void gtk_window_fullscreen GtkWindow* window")
-(CFNC-300 "void gtk_window_unfullscreen GtkWindow* window")
-(CFNC-300 "GtkWindowType gtk_window_get_window_type GtkWindow* window")
+;(CFNC-3.0 "void gtk_about_dialog_set_license_type GtkAboutDialog* about GtkLicense license_type")
+;(CFNC-3.0 "GtkLicense gtk_about_dialog_get_license_type GtkAboutDialog* about")
+;;void gtk_show_about_dialog GtkWindow* parent gchar* first_property_name ...)
+;(CINT-3.0 "GTK_LICENSE_UNKNOWN" "GtkLicense")
+;(CINT-3.0 "GTK_LICENSE_CUSTOM" "GtkLicense")
+;(CINT-3.0 "GTK_LICENSE_GPL_2_0" "GtkLicense")
+;(CINT-3.0 "GTK_LICENSE_GPL_3_0" "GtkLicense")
+;(CINT-3.0 "GTK_LICENSE_LGPL_2_1" "GtkLicense")
+;(CINT-3.0 "GTK_LICENSE_LGPL_3_0" "GtkLicense")
+;(CINT-3.0 "GTK_LICENSE_BSD" "GtkLicense")
+;(CINT-3.0 "GTK_LICENSE_MIT_X11" "GtkLicense")
+;(CINT-3.0 "GTK_LICENSE_ARTISTIC" "GtkLicense")
+
+(CFNC-3.0 "void gtk_window_set_skip_taskbar_hint GtkWindow* window gboolean setting")
+(CFNC-3.0 "gboolean gtk_window_get_skip_taskbar_hint GtkWindow* window")
+(CFNC-3.0 "void gtk_window_set_skip_pager_hint GtkWindow* window gboolean setting")
+(CFNC-3.0 "gboolean gtk_window_get_skip_pager_hint GtkWindow* window")
+(CFNC-3.0 "void gtk_window_set_screen GtkWindow* window GdkScreen* screen")
+(CFNC-3.0 "GdkScreen* gtk_window_get_screen GtkWindow* window")
+(CFNC-3.0 "gboolean gtk_window_set_icon_from_file GtkWindow* window gchar* filename GError** [err]" 'const)
+(CFNC-3.0 "gboolean gtk_window_set_default_icon_from_file gchar* filename GError** [err]" 'const)
+(CFNC-3.0 "void gtk_window_fullscreen GtkWindow* window")
+(CFNC-3.0 "void gtk_window_unfullscreen GtkWindow* window")
+(CFNC-3.0 "GtkWindowType gtk_window_get_window_type GtkWindow* window")
;GtkApplication *gtk_window_get_application GtkWindow* window)
;void gtk_window_set_application GtkWindow* window GtkApplication* application)
-(CCAST-300 "GTK_WINDOW_GROUP(object)" "GtkWindowGroup*")
-(CCHK-300 "GTK_IS_WINDOW_GROUP(object)" "GtkWindowGroup*")
-(CFNC-300 "void gtk_window_group_add_window GtkWindowGroup* window_group GtkWindow* window")
-(CFNC-300 "void gtk_window_group_remove_window GtkWindowGroup* window_group GtkWindow* window")
-(CFNC-300 "GtkWindowGroup* gtk_window_group_new void")
-(CFNC-300 "GtkWindowGroup* gtk_window_get_group GtkWindow* window")
-(CFNC-300 "GList* gtk_window_group_list_windows GtkWindowGroup* window_group")
-(CFNC-300 "GtkWidget* gtk_window_group_get_current_device_grab GtkWindowGroup* window_group GdkDevice* device")
+(CCAST-3.0 "GTK_WINDOW_GROUP(object)" "GtkWindowGroup*")
+(CCHK-3.0 "GTK_IS_WINDOW_GROUP(object)" "GtkWindowGroup*")
+(CFNC-3.0 "void gtk_window_group_add_window GtkWindowGroup* window_group GtkWindow* window")
+(CFNC-3.0 "void gtk_window_group_remove_window GtkWindowGroup* window_group GtkWindow* window")
+(CFNC-3.0 "GtkWindowGroup* gtk_window_group_new void")
+(CFNC-3.0 "GtkWindowGroup* gtk_window_get_group GtkWindow* window")
+(CFNC-3.0 "GList* gtk_window_group_list_windows GtkWindowGroup* window_group")
+(CFNC-3.0 "GtkWidget* gtk_window_group_get_current_device_grab GtkWindowGroup* window_group GdkDevice* device")
;;;;(CFNC "GType gtk_window_group_get_type void")
-(CFNC-300 "GtkWidget* gtk_window_group_get_current_grab GtkWindowGroup* window_group")
+(CFNC-3.0 "GtkWidget* gtk_window_group_get_current_grab GtkWindowGroup* window_group")
;gtkrecentchooserdialog: gtk_recent_chooser_dialog_new -- these 2 use property lists
;gtkrecentchooserdialog: gtk_recent_chooser_dialog_new_for_manager
-(CFNC-300 "guchar* gtk_selection_data_get_data GtkSelectionData* selection_data" 'const)
-(CFNC-300 "gboolean gtk_selection_owner_set_for_display GdkDisplay* display GtkWidget* widget GdkAtom selection guint32 time")
-
-(CCAST-300 "GTK_TOOL_SHELL" "GtkToolShell*")
-(CCHK-300 "GTK_IS_TOOL_SHELL" "GtkToolShell*")
-(CFNC-300 "GtkOrientation gtk_tool_shell_get_text_orientation GtkToolShell* shell")
-(CFNC-300 "gfloat gtk_tool_shell_get_text_alignment GtkToolShell* shell")
-(CFNC-300 "PangoEllipsizeMode gtk_tool_shell_get_ellipsize_mode GtkToolShell* shell")
-(CFNC-300 "GtkSizeGroup* gtk_tool_shell_get_text_size_group GtkToolShell* shell")
-(CFNC-300 "GtkIconSize gtk_tool_shell_get_icon_size GtkToolShell* shell")
-(CFNC-300 "GtkOrientation gtk_tool_shell_get_orientation GtkToolShell* shell")
-(CFNC-300 "GtkToolbarStyle gtk_tool_shell_get_style GtkToolShell* shell")
-(CFNC-300 "GtkReliefStyle gtk_tool_shell_get_relief_style GtkToolShell* shell")
-(CFNC-300 "void gtk_tool_shell_rebuild_menu GtkToolShell* shell")
-
-(CFNC-300 "GtkStatusIcon* gtk_status_icon_new_from_gicon GIcon* icon")
-(CFNC-300 "void gtk_status_icon_set_from_gicon GtkStatusIcon* status_icon GIcon* icon")
-(CFNC-300 "GIcon* gtk_status_icon_get_gicon GtkStatusIcon* status_icon")
-(CFNC-300 "void gtk_status_icon_set_has_tooltip GtkStatusIcon* status_icon gboolean has_tooltip")
-(CFNC-300 "void gtk_status_icon_set_tooltip_text GtkStatusIcon* status_icon gchar* text" 'const)
-(CFNC-300 "void gtk_status_icon_set_tooltip_markup GtkStatusIcon* status_icon gchar* markup" 'const)
-(CFNC-300 "gboolean gtk_status_icon_get_has_tooltip GtkStatusIcon* status_icon")
-(CFNC-300 "gchar* gtk_status_icon_get_tooltip_text GtkStatusIcon* status_icon")
-(CFNC-300 "gchar* gtk_status_icon_get_tooltip_markup GtkStatusIcon* status_icon")
-
-(CFNC-300 "void gtk_accel_map_lock_path gchar* accel_path" 'const)
-(CFNC-300 "void gtk_accel_map_unlock_path gchar* accel_path" 'const)
-
-;(CFNC-300 "gboolean gtk_icon_size_lookup_for_settings GtkSettings* settings GtkIconSize size gint* [width] gint* [height]")
-; all the GtkSettings funcs have been removed above and docs say this func isn't needed
-
-(CINT-300 "GTK_ICON_LOOKUP_FORCE_SIZE" "GtkIconLookupFlags")
-(CINT-300 "GTK_ICON_THEME_NOT_FOUND" "GtkIconThemeError")
-(CINT-300 "GTK_ICON_THEME_FAILED" "GtkIconThemeError")
+(CFNC-3.0 "guchar* gtk_selection_data_get_data GtkSelectionData* selection_data" 'const)
+(CFNC-3.0 "gboolean gtk_selection_owner_set_for_display GdkDisplay* display GtkWidget* widget GdkAtom selection guint32 time")
+
+(CCAST-3.0 "GTK_TOOL_SHELL" "GtkToolShell*")
+(CCHK-3.0 "GTK_IS_TOOL_SHELL" "GtkToolShell*")
+(CFNC-3.0 "GtkOrientation gtk_tool_shell_get_text_orientation GtkToolShell* shell")
+(CFNC-3.0 "gfloat gtk_tool_shell_get_text_alignment GtkToolShell* shell")
+(CFNC-3.0 "PangoEllipsizeMode gtk_tool_shell_get_ellipsize_mode GtkToolShell* shell")
+(CFNC-3.0 "GtkSizeGroup* gtk_tool_shell_get_text_size_group GtkToolShell* shell")
+;;; (CFNC-3.0 "GtkIconSize gtk_tool_shell_get_icon_size GtkToolShell* shell")
+(CFNC-3.0 "GtkOrientation gtk_tool_shell_get_orientation GtkToolShell* shell")
+(CFNC-3.0 "GtkToolbarStyle gtk_tool_shell_get_style GtkToolShell* shell")
+(CFNC-3.0 "GtkReliefStyle gtk_tool_shell_get_relief_style GtkToolShell* shell")
+(CFNC-3.0 "void gtk_tool_shell_rebuild_menu GtkToolShell* shell")
+
+;;; 3.14.0 (CFNC-3.0 "GtkStatusIcon* gtk_status_icon_new_from_gicon GIcon* icon")
+;;; 3.14.0 (CFNC-3.0 "void gtk_status_icon_set_from_gicon GtkStatusIcon* status_icon GIcon* icon")
+;;; 3.14.0 (CFNC-3.0 "GIcon* gtk_status_icon_get_gicon GtkStatusIcon* status_icon")
+;;; 3.14.0 (CFNC-3.0 "void gtk_status_icon_set_has_tooltip GtkStatusIcon* status_icon gboolean has_tooltip")
+;;; 3.14.0 (CFNC-3.0 "void gtk_status_icon_set_tooltip_text GtkStatusIcon* status_icon gchar* text" 'const)
+;;; 3.14.0 (CFNC-3.0 "void gtk_status_icon_set_tooltip_markup GtkStatusIcon* status_icon gchar* markup" 'const)
+;;; 3.14.0 (CFNC-3.0 "gboolean gtk_status_icon_get_has_tooltip GtkStatusIcon* status_icon")
+;;; 3.14.0 (CFNC-3.0 "gchar* gtk_status_icon_get_tooltip_text GtkStatusIcon* status_icon")
+;;; 3.14.0 (CFNC-3.0 "gchar* gtk_status_icon_get_tooltip_markup GtkStatusIcon* status_icon")
+
+(CFNC-3.0 "void gtk_accel_map_lock_path gchar* accel_path" 'const)
+(CFNC-3.0 "void gtk_accel_map_unlock_path gchar* accel_path" 'const)
+
+;;; ;(CFNC-3.0 "gboolean gtk_icon_size_lookup_for_settings GtkSettings* settings GtkIconSize size gint* [width] gint* [height]")
+; most of the GtkSettings funcs have been removed above and docs say this func isn't needed
+
+(CINT-3.0 "GTK_ICON_LOOKUP_FORCE_SIZE" "GtkIconLookupFlags")
+(CINT-3.0 "GTK_ICON_THEME_NOT_FOUND" "GtkIconThemeError")
+(CINT-3.0 "GTK_ICON_THEME_FAILED" "GtkIconThemeError")
;gtkicontheme: gtk_icon_theme_choose_icon -- ref array?
;gtkicontheme: gtk_icon_info_load_symbolic
;gtkicontheme: gtk_icon_info_load_symbolic_for_context
-(CFNC-300 "GtkIconInfo* gtk_icon_theme_lookup_by_gicon GtkIconTheme* icon_theme GIcon* icon gint size GtkIconLookupFlags flags")
-(CFNC-300 "GtkIconInfo* gtk_icon_info_new_for_pixbuf GtkIconTheme* icon_theme GdkPixbuf* pixbuf")
+(CFNC-3.0 "GtkIconInfo* gtk_icon_theme_lookup_by_gicon GtkIconTheme* icon_theme GIcon* icon gint size GtkIconLookupFlags flags")
+(CFNC-3.0 "GtkIconInfo* gtk_icon_info_new_for_pixbuf GtkIconTheme* icon_theme GdkPixbuf* pixbuf")
;;; 2.99.3 ;gtkplug: gtk_plug_construct_for_display -- GdkNativeWindow
;;; 2.99.3 ;gtkplug: gtk_plug_new_for_display
-(CFNC-300 "void gtk_icon_view_set_item_orientation GtkIconView* icon_view GtkOrientation orientation")
-(CFNC-300 "GtkOrientation gtk_icon_view_get_item_orientation GtkIconView* icon_view")
+(CFNC-3.0 "void gtk_icon_view_set_item_orientation GtkIconView* icon_view GtkOrientation orientation")
+(CFNC-3.0 "GtkOrientation gtk_icon_view_get_item_orientation GtkIconView* icon_view")
-(CFNC-300 "gboolean gtk_text_view_im_context_filter_keypress GtkTextView* text_view GdkEventKey* event")
-(CFNC-300 "void gtk_text_view_reset_im_context GtkTextView* text_view")
+(CFNC-3.0 "gboolean gtk_text_view_im_context_filter_keypress GtkTextView* text_view GdkEventKey* event")
+(CFNC-3.0 "void gtk_text_view_reset_im_context GtkTextView* text_view")
-;(CFNC-300 "void gtk_text_layout_draw GtkTextLayout* layout GtkWidget* widget cairo_t* cr GList** widgets")
+;(CFNC-3.0 "void gtk_text_layout_draw GtkTextLayout* layout GtkWidget* widget cairo_t* cr GList** widgets")
-(CFNC-300 "gchar* gtk_action_get_accel_path GtkAction* action" 'const-return)
-(CFNC-300 "void gtk_action_block_activate GtkAction* action")
-(CFNC-300 "void gtk_action_unblock_activate GtkAction* action")
-(CFNC-300 "void gtk_action_set_accel_path GtkAction* action gchar* accel_path" 'const)
-(CFNC-300 "void gtk_action_set_accel_group GtkAction* action GtkAccelGroup* accel_group")
+;;; (CFNC-3.0 "gchar* gtk_action_get_accel_path GtkAction* action" 'const-return)
+;;; (CFNC-3.0 "void gtk_action_block_activate GtkAction* action")
+;;; (CFNC-3.0 "void gtk_action_unblock_activate GtkAction* action")
+;;; (CFNC-3.0 "void gtk_action_set_accel_path GtkAction* action gchar* accel_path" 'const)
+;;; (CFNC-3.0 "void gtk_action_set_accel_group GtkAction* action GtkAccelGroup* accel_group")
;;; 2.99.0
-(CFNC-300 "void gdk_device_get_position GdkDevice* device GdkScreen** screen gint* [x] gint* [y]")
-(CFNC-300 "GdkWindow* gdk_device_get_window_at_position GdkDevice* device gint* [win_x] gint* [win_y]")
-(CFNC-300 "gboolean gtk_cell_view_get_draw_sensitive GtkCellView* cell_view")
-(CFNC-300 "void gtk_cell_view_set_draw_sensitive GtkCellView* cell_view gboolean draw_sensitive")
-(CFNC-300 "gboolean gtk_cell_view_get_fit_model GtkCellView* cell_view")
-(CFNC-300 "void gtk_cell_view_set_fit_model GtkCellView* cell_view gboolean fit_model")
-(CFNC-300 "GtkWidget* gtk_combo_box_new_with_area GtkCellArea* area")
-(CFNC-300 "GtkWidget* gtk_combo_box_new_with_area_and_entry GtkCellArea* area")
-(CFNC-300 "GtkWidget* gtk_icon_view_new_with_area GtkCellArea* area")
-(CFNC-300 "void gtk_menu_item_set_reserve_indicator GtkMenuItem* menu_item gboolean reserve")
-(CFNC-300 "gboolean gtk_menu_item_get_reserve_indicator GtkMenuItem* menu_item")
-(CFNC-300 "GtkWidget* gtk_menu_shell_get_selected_item GtkMenuShell* menu_shell")
-(CFNC-300 "GtkWidget* gtk_menu_shell_get_parent_shell GtkMenuShell* menu_shell")
-(CFNC-300 "guchar* gtk_selection_data_get_data_with_length GtkSelectionData* selection_data gint* [length]" 'const)
-(CFNC-300 "gboolean gtk_tree_model_iter_previous GtkTreeModel* tree_model GtkTreeIter* iter")
-(CSTR-300 "GTK_STYLE_CLASS_HIGHLIGHT")
-(CSTR-300 "GTK_STYLE_CLASS_FRAME")
-(CSTR-300 "GTK_STYLE_CLASS_DND")
+(CFNC-3.0 "void gdk_device_get_position GdkDevice* device GdkScreen** screen gint* [x] gint* [y]")
+(CFNC-3.0 "GdkWindow* gdk_device_get_window_at_position GdkDevice* device gint* [win_x] gint* [win_y]")
+(CFNC-3.0 "gboolean gtk_cell_view_get_draw_sensitive GtkCellView* cell_view")
+(CFNC-3.0 "void gtk_cell_view_set_draw_sensitive GtkCellView* cell_view gboolean draw_sensitive")
+(CFNC-3.0 "gboolean gtk_cell_view_get_fit_model GtkCellView* cell_view")
+(CFNC-3.0 "void gtk_cell_view_set_fit_model GtkCellView* cell_view gboolean fit_model")
+(CFNC-3.0 "GtkWidget* gtk_combo_box_new_with_area GtkCellArea* area")
+(CFNC-3.0 "GtkWidget* gtk_combo_box_new_with_area_and_entry GtkCellArea* area")
+(CFNC-3.0 "GtkWidget* gtk_icon_view_new_with_area GtkCellArea* area")
+(CFNC-3.0 "void gtk_menu_item_set_reserve_indicator GtkMenuItem* menu_item gboolean reserve")
+(CFNC-3.0 "gboolean gtk_menu_item_get_reserve_indicator GtkMenuItem* menu_item")
+(CFNC-3.0 "GtkWidget* gtk_menu_shell_get_selected_item GtkMenuShell* menu_shell")
+(CFNC-3.0 "GtkWidget* gtk_menu_shell_get_parent_shell GtkMenuShell* menu_shell")
+(CFNC-3.0 "guchar* gtk_selection_data_get_data_with_length GtkSelectionData* selection_data gint* [length]" 'const)
+(CFNC-3.0 "gboolean gtk_tree_model_iter_previous GtkTreeModel* tree_model GtkTreeIter* iter")
+(CSTR-3.0 "GTK_STYLE_CLASS_HIGHLIGHT")
+(CSTR-3.0 "GTK_STYLE_CLASS_FRAME")
+(CSTR-3.0 "GTK_STYLE_CLASS_DND")
;;; 2.99.1
-(CSTR-300 "GTK_STYLE_CLASS_HORIZONTAL")
-(CSTR-300 "GTK_STYLE_CLASS_VERTICAL")
-(CFNC-300 "gboolean gtk_tree_view_is_blank_at_pos GtkTreeView* tree_view gint x gint y GtkTreePath** [path] GtkTreeViewColumn** [column] gint* [cell_x] gint* [cell_y]")
-(CFNC-300 "void gtk_widget_set_device_enabled GtkWidget* widget GdkDevice* device gboolean enabled")
-(CFNC-300 "gboolean gtk_widget_get_device_enabled GtkWidget* widget GdkDevice* device")
-(CFNC-300 "void gtk_window_set_has_user_ref_count GtkWindow* window gboolean setting")
+(CSTR-3.0 "GTK_STYLE_CLASS_HORIZONTAL")
+(CSTR-3.0 "GTK_STYLE_CLASS_VERTICAL")
+(CFNC-3.0 "gboolean gtk_tree_view_is_blank_at_pos GtkTreeView* tree_view gint x gint y GtkTreePath** [path] GtkTreeViewColumn** [column] gint* [cell_x] gint* [cell_y]")
+(CFNC-3.0 "void gtk_widget_set_device_enabled GtkWidget* widget GdkDevice* device gboolean enabled")
+(CFNC-3.0 "gboolean gtk_widget_get_device_enabled GtkWidget* widget GdkDevice* device")
+(CFNC-3.0 "void gtk_window_set_has_user_ref_count GtkWindow* window gboolean setting")
;;; 2.99.2 -- no changes for xgdata I think
;;; 2.99.3
-(CFNC-300 "void gdk_selection_send_notify GdkWindow* requestor GdkAtom selection GdkAtom target GdkAtom property guint32 time_")
-(CFNC-300 "void gdk_selection_send_notify_for_display GdkDisplay* display GdkWindow* requestor GdkAtom selection GdkAtom target GdkAtom property guint32 time_")
-;(CFNC-300 "void gtk_text_view_get_cursor_locations GtkTextView* text_view GtkTextIter* iter GdkRectangle* [strong] GdkRectangle* [weak]")
+(CFNC-3.0 "void gdk_selection_send_notify GdkWindow* requestor GdkAtom selection GdkAtom target GdkAtom property guint32 time_")
+(CFNC-3.0 "void gdk_selection_send_notify_for_display GdkDisplay* display GdkWindow* requestor GdkAtom selection GdkAtom target GdkAtom property guint32 time_")
+;(CFNC-3.0 "void gtk_text_view_get_cursor_locations GtkTextView* text_view GtkTextIter* iter GdkRectangle* [strong] GdkRectangle* [weak]")
+
+(CFNC-3.0 "GdkRGBA* gdk_rgba_copy GdkRGBA* rgba" 'const)
+(CFNC-3.0 "void gdk_rgba_free GdkRGBA* rgba")
+(CFNC-3.0 "gboolean gdk_rgba_parse GdkRGBA* rgba gchar* spec" 'const)
+(CFNC-3.0 "gchar* gdk_rgba_to_string GdkRGBA* rgba" 'const)
-(CFNC-300 "GdkRGBA* gdk_rgba_copy GdkRGBA* rgba" 'const)
-(CFNC-300 "void gdk_rgba_free GdkRGBA* rgba")
-(CFNC-300 "gboolean gdk_rgba_parse GdkRGBA* rgba gchar* spec" 'const)
-(CFNC-300 "gchar* gdk_rgba_to_string GdkRGBA* rgba" 'const)
+;(STRUCT-3.0-make "GdkRGBA")
-(STRUCT-300-make "GdkRGBA")
+(CINT-3.0 "GTK_STATE_FLAG_NORMAL" "GtkStateFlags")
+(CINT-3.0 "GTK_STATE_FLAG_ACTIVE" "GtkStateFlags")
+(CINT-3.0 "GTK_STATE_FLAG_PRELIGHT" "GtkStateFlags")
+(CINT-3.0 "GTK_STATE_FLAG_SELECTED" "GtkStateFlags")
+(CINT-3.0 "GTK_STATE_FLAG_INSENSITIVE" "GtkStateFlags")
+(CINT-3.0 "GTK_STATE_FLAG_INCONSISTENT" "GtkStateFlags")
+(CINT-3.0 "GTK_STATE_FLAG_FOCUSED" "GtkStateFlags")
+(CFNC-3.0 "void gtk_widget_set_state_flags GtkWidget* widget GtkStateFlags flags gboolean clear")
+(CFNC-3.0 "void gtk_widget_unset_state_flags GtkWidget* widget GtkStateFlags flags")
+(CFNC-3.0 "GtkStateFlags gtk_widget_get_state_flags GtkWidget* widget")
+;;; 3.15 (CFNC-3.0 "void gtk_widget_override_color GtkWidget* widget GtkStateFlags state GdkRGBA* color" 'const)
+;;; 3.15 (CFNC-3.0 "void gtk_widget_override_background_color GtkWidget* widget GtkStateFlags state GdkRGBA* color" 'const)
+;;; 3.15 (CFNC-3.0 "void gtk_widget_override_font GtkWidget* widget PangoFontDescription* font_desc" 'const)
+;;; 3.7.4 (CFNC-3.0 "void gtk_widget_override_symbolic_color GtkWidget* widget gchar* name GdkRGBA* color" 'const)
+;;; 3.15 (CFNC-3.0 "void gtk_widget_override_cursor GtkWidget* widget GdkRGBA* cursor GdkRGBA* secondary_cursor" 'const)
+
+
+
+;;; 3.1.2
+
+(CINT-3.2 "GTK_SIZE_REQUEST_CONSTANT_SIZE" "GtkSizeRequestMode")
+;(CINT-3.2 "GDK_RENDERING_MODE_SIMILAR" "GdkRenderingMode")
+;(CINT-3.2 "GDK_RENDERING_MODE_IMAGE" "GdkRenderingMode")
+;(CINT-3.2 "GDK_RENDERING_MODE_RECORDING" "GdkRenderingMode")
+
+(CFNC-3.2 "gchar* gtk_entry_get_placeholder_text GtkEntry* entry" 'const)
+(CFNC-3.2 "void gtk_entry_set_placeholder_text GtkEntry* entry gchar* text" 'const)
+(CFNC-3.2 "void gtk_expander_set_resize_toplevel GtkExpander* expander gboolean resize_toplevel")
+(CFNC-3.2 "gboolean gtk_expander_get_resize_toplevel GtkExpander* expander")
+;(CFNC-3.2 "void gtk_widget_queue_draw_region GtkWidget* widget cairo_region_t* [region]" 'const)
+(CFNC-3.2 "char* gtk_widget_path_to_string GtkWidgetPath* path" 'const)
+
+;;; 3.1.4
+(CFNC-3.2 "gboolean gtk_button_box_get_child_non_homogeneous GtkButtonBox* widget GtkWidget* child")
+(CFNC-3.2 "void gtk_button_box_set_child_non_homogeneous GtkButtonBox* widget GtkWidget* child gboolean non_homogeneous")
+(CFNC-3.2 "void gtk_container_child_notify GtkContainer* container GtkWidget* child gchar* property_name" 'const)
+(CFNC-3.2 "void gtk_drag_source_set_icon_gicon GtkWidget* widget GIcon* icon")
+(CFNC-3.2 "void gtk_drag_set_icon_gicon GdkDragContext* context GIcon* icon gint hot_x gint hot_y")
+(CFNC-3.2 "gboolean gtk_combo_box_set_active_id GtkComboBox* combo_box gchar* active_id" 'const)
+
+
+;;; 3.1.6
+;(CFNC-3.2 "char* gtk_css_provider_to_string GtkCssProvider* provider")
+
+;;; 3.7.4 (CFNC-3.2 "GtkGradient* gtk_gradient_new_linear gdouble x0 gdouble y0 gdouble x1 gdouble y1")
+;;; 3.7.4 (CFNC-3.2 "GtkGradient* gtk_gradient_new_radial gdouble x0 gdouble y0 gdouble radius0 gdouble x1 gdouble y1 gdouble radius1")
+;;; 3.7.4 (CFNC-3.2 "void gtk_gradient_add_color_stop GtkGradient* gradient gdouble offset GtkSymbolicColor* color")
+;;; 3.7.4 (CFNC-3.2 "GtkGradient* gtk_gradient_ref GtkGradient* gradient")
+;;; 3.7.4 (CFNC-3.2 "void gtk_gradient_unref GtkGradient* gradient")
+;;; 3.7.4 (CFNC-3.2 "gboolean gtk_gradient_resolve GtkGradient* gradient GtkStyleProperties* props cairo_pattern_t** resolved_gradient")
+
+;;; 3.7.4 (CFNC-3.2 "char* gtk_gradient_to_string GtkGradient* gradient")
+;;; 3.7.4 (CFNC-3.2 "char* gtk_symbolic_color_to_string GtkSymbolicColor* color")
+
+(CFNC-3.2 "gint gtk_tree_view_column_get_x_offset GtkTreeViewColumn* tree_column")
+;(CFNC-3.2 void gtk_render_icon GtkStyleContext* context cairo_t* cr GdkPixbuf* pixbuf gdouble x gdouble y")
+
+(CCAST-3.2 "GTK_OVERLAY" "GtkOverlay*")
+(CCHK-3.2 "GTK_IS_OVERLAY" "GtkOverlay*")
+(CFNC-3.2 "GtkWidget* gtk_overlay_new void")
+(CFNC-3.2 "void gtk_overlay_add_overlay GtkOverlay* overlay GtkWidget* widget")
+
+;;; 3.1.8: no changes
+
+;;; 3.1.10:
+(CFNC-3.2 "gdouble gtk_adjustment_get_minimum_increment GtkAdjustment* adjustment")
+;(CFNC-3.2 "void gtk_asssistant_remove_page GtkAssistant* assistant gint page_num")
+
+
+
+;;; 3.1.12:
+(CCAST-3.2 "GTK_FONT_CHOOSER" "GtkFontChooser*")
+(CCHK-3.2 "GTK_IS_FONT_CHOOSER" "GtkFontChooser*")
+(CCAST-3.2 "GTK_FONT_CHOOSER_DIALOG" "GtkFontChooserDialog*")
+(CCHK-3.2 "GTK_IS_FONT_CHOOSER_DIALOG" "GtkFontChooserDialog*")
+
+;;; typedef gboolean (*GtkFontFilterFunc) (const PangoFontFamily *family, const PangoFontFace *face, gpointer data);
+;;; void gtk_font_chooser_set_filter_func(GtkFontChooser *fontchooser, GtkFontFilterFunc filter, gpointer data, GDestroyNotify destroy);
+
+(CFNC-3.2 "void gtk_grid_insert_row GtkGrid* grid gint position")
+(CFNC-3.2 "void gtk_grid_insert_column GtkGrid* grid gint position")
+(CFNC-3.2 "void gtk_grid_insert_next_to GtkGrid* grid GtkWidget* sibling GtkPositionType side")
+(CFNC-3.2 "void gtk_text_iter_assign GtkTextIter* iter GtkTextIter* other") ; const
+(CFNC-3.2 "gboolean gtk_widget_has_visible_focus GtkWidget* widget")
+(CFNC-3.2 "void gtk_window_set_focus_visible GtkWindow* window gboolean setting")
+(CFNC-3.2 "gboolean gtk_window_get_focus_visible GtkWindow* window")
+
+;;; out 3.1.90?
+;;; (CFNC-3.2 "GtkWidget* gtk_font_chooser_new void")
+;;; (CFNC-3.2 "PangoFontFamily* gtk_font_chooser_get_family GtkFontChooser* fontchooser")
+;;; (CFNC-3.2 "PangoFontFace* gtk_font_chooser_get_face GtkFontChooser* fontchooser")
+;;; (CFNC-3.2 "gint gtk_font_chooser_get_size GtkFontChooser* fontchooser")
+;;; (CFNC-3.2 "gchar* gtk_font_chooser_get_font_name GtkFontChooser* fontchooser")
+;;; (CFNC-3.2 "gboolean gtk_font_chooser_set_font_name GtkFontChooser* fontchooser gchar* fontname" 'const)
+;;; (CFNC-3.2 "gchar* gtk_font_chooser_get_preview_text GtkFontChooser* fontchooser" 'const-return)
+;;; (CFNC-3.2 "void gtk_font_chooser_set_preview_text GtkFontChooser* fontchooser gchar* text" 'const)
+;;; (CFNC-3.2 "gboolean gtk_font_chooser_get_show_preview_entry GtkFontChooser* fontchooser")
+;;; (CFNC-3.2 "void gtk_font_chooser_set_show_preview_entry GtkFontChooser* fontchooser gboolean show_preview_entry")
+;;; (CFNC-3.2 "GtkWidget* gtk_font_chooser_dialog_get_font_chooser GtkFontChooserDialog* fcd")
+;;; (CFNC-3.2 "gchar* gtk_font_chooser_dialog_get_font_name GtkFontChooserDialog* fcd")
+;;; (CFNC-3.2 "gboolean gtk_font_chooser_dialog_set_font_name GtkFontChooserDialog* fcd gchar* fontname" 'const)
+;;; (CFNC-3.2 "gchar* gtk_font_chooser_dialog_get_preview_text GtkFontChooserDialog* fcd" 'const-return)
+;;; (CFNC-3.2 "void gtk_font_chooser_dialog_set_preview_text GtkFontChooserDialog* fcd gchar* text" 'const)
+
+
+(CFNC-3.2 "GtkWidget* gtk_font_chooser_dialog_new gchar* title GtkWindow* window" 'const)
+
+;;; 3.1.16|18
+;;; new: gtkcsssection.h
+
+(CFNC-3.2 "gboolean gdk_event_get_button GdkEvent* event guint* button")
+(CFNC-3.2 "gboolean gdk_event_get_click_count GdkEvent* event guint* click_count")
+(CFNC-3.2 "gboolean gdk_event_get_keyval GdkEvent* event guint* keyval")
+(CFNC-3.2 "gboolean gdk_event_get_keycode GdkEvent* event guint16* keycode")
+(CFNC-3.2 "gboolean gdk_event_get_scroll_direction GdkEvent* event GdkScrollDirection* [direction]")
+(CFNC-3.2 "GtkWidget* gtk_grid_get_child_at GtkGrid* grid gint left gint top")
+
+;;; 3.1.90
+(CCAST-3.2 "GTK_FONT_CHOOSER_WIDGET" "GtkFontChooserWidget*")
+(CCHK-3.2 "GTK_IS_FONT_CHOOSER_WIDGET" "GtkFontChooserWidget*")
+
+(CFNC-3.2 "PangoFontFamily* gtk_font_chooser_get_font_family GtkFontChooser* fontchooser")
+(CFNC-3.2 "PangoFontFace* gtk_font_chooser_get_font_face GtkFontChooser* fontchooser")
+(CFNC-3.2 "gint gtk_font_chooser_get_font_size GtkFontChooser* fontchooser")
+(CFNC-3.2 "PangoFontDescription* gtk_font_chooser_get_font_desc GtkFontChooser* fontchooser")
+(CFNC-3.2 "void gtk_font_chooser_set_font_desc GtkFontChooser* fontchooser PangoFontDescription* font_desc" 'const)
+(CFNC-3.2 "gchar* gtk_font_chooser_get_font GtkFontChooser* fontchooser")
+(CFNC-3.2 "void gtk_font_chooser_set_font GtkFontChooser* fontchooser gchar* fontname" 'const)
+(CFNC-3.2 "gchar* gtk_font_chooser_get_preview_text GtkFontChooser* fontchooser")
+(CFNC-3.2 "void gtk_font_chooser_set_preview_text GtkFontChooser* fontchooser gchar* text" 'const)
+(CFNC-3.2 "gboolean gtk_font_chooser_get_show_preview_entry GtkFontChooser* fontchooser")
+(CFNC-3.2 "void gtk_font_chooser_set_show_preview_entry GtkFontChooser* fontchooser gboolean show_preview_entry")
+(CFNC-3.2 "GtkWidget* gtk_font_chooser_widget_new void")
+
+;;; void gtk_font_chooser_set_filter_func GtkFontChooser* fontchooser GtkFontFilterFuncfilter gpointer user_data GDestroyNotify destroy)
+
+
+
+;;; gtk 3.3.2
+;;; gtk 3.3.6
+;;; the scale troughs are changed -- in prefs they're all green or gray now?
+
+(CCAST-3.4 "GTK_APPLICATION_WINDOW" "GtkApplicationWindow*")
+(CCHK-3.4 "GTK_IS_APPLICATION_WINDOW" "GtkApplicationWindow*")
+
+(CINT-3.4 "GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR" "GdkModifierIntent")
+(CINT-3.4 "GDK_MODIFIER_INTENT_CONTEXT_MENU" "GdkModifierIntent")
+(CINT-3.4 "GDK_MODIFIER_INTENT_EXTEND_SELECTION" "GdkModifierIntent")
+(CINT-3.4 "GDK_MODIFIER_INTENT_MODIFY_SELECTION" "GdkModifierIntent")
+(CINT-3.4 "GDK_MODIFIER_INTENT_NO_TEXT_INPUT" "GdkModifierIntent")
+(CINT-3.4 "GDK_MODIFIER_INTENT_SHIFT_GROUP" "GdkModifierIntent")
+
+(CINT-3.4 "GTK_REGION_ONLY" "GtkRegionFlags")
+(CINT-3.4 "GDK_WINDOW_STATE_FOCUSED" "GdkWindowState")
+;;; (CINT-3.4 "GTK_STATE_FLAG_WINDOW_UNFOCUSED" "GtkStateFlags")
+
+(CINT-3.4 "GTK_CELL_RENDERER_EXPANDABLE" "GtkCellRendererState")
+(CINT-3.4 "GTK_CELL_RENDERER_EXPANDED" "GtkCellRendererState")
+
+(CFNC-3.4 "GdkModifierType gdk_keymap_get_modifier_mask GdkKeymap* keymap GdkModifierIntent intent")
+(CFNC-3.4 "void gdk_window_begin_resize_drag_for_device GdkWindow* window GdkWindowEdge edge GdkDevice* device gint button gint root_x gint root_y guint32 timestamp")
+(CFNC-3.4 "void gdk_window_begin_move_drag_for_device GdkWindow* window GdkDevice* device gint button gint root_x gint root_y guint32 timestamp")
+(CFNC-3.4 "void gtk_accelerator_parse_with_keycode gchar* accelerator guint* accelerator_key guint** accelerator_codes GdkModifierType* accelerator_mods" 'const)
+(CFNC-3.4 "gchar* gtk_accelerator_name_with_keycode GdkDisplay* display guint accelerator_key guint keycode GdkModifierType accelerator_mods")
+(CFNC-3.4 "gchar* gtk_accelerator_get_label_with_keycode GdkDisplay* display guint accelerator_key guint keycode GdkModifierType accelerator_mods")
+(CFNC-3.4 "void gdk_screen_get_monitor_workarea GdkScreen* screen gint monitor_num GdkRectangle* dest")
+(CFNC-3.4 "GMenuModel* gtk_application_get_app_menu GtkApplication* application")
+(CFNC-3.4 "void gtk_application_set_app_menu GtkApplication* application GMenuModel* model")
+(CFNC-3.4 "GMenuModel* gtk_application_get_menubar GtkApplication* application")
+(CFNC-3.4 "void gtk_application_set_menubar GtkApplication* application GMenuModel* model")
+;;; 3.14 (CFNC-3.4 "void gtk_application_add_accelerator GtkApplication* application gchar* accelerator gchar* action_name GVariant* parameter" 'const)
+;;; 3.14 (CFNC-3.4 "void gtk_application_remove_accelerator GtkApplication* application gchar* action_name GVariant* parameter" 'const)
+(CFNC-3.4 "gchar* gtk_entry_completion_compute_prefix GtkEntryCompletion* completion char* key" 'const)
+(CFNC-3.4 "void gtk_scale_set_has_origin GtkScale* scale gboolean has_origin")
+(CFNC-3.4 "gboolean gtk_scale_get_has_origin GtkScale* scale")
+(CFNC-3.4 "void gtk_window_set_hide_titlebar_when_maximized GtkWindow* window gboolean setting")
+(CFNC-3.4 "gboolean gtk_window_get_hide_titlebar_when_maximized GtkWindow* window")
+(CFNC-3.4 "GtkWidget* gtk_application_window_new GtkApplication* application")
+(CFNC-3.4 "void gtk_application_window_set_show_menubar GtkApplicationWindow* window gboolean show_menubar")
+(CFNC-3.4 "gboolean gtk_application_window_get_show_menubar GtkApplicationWindow* window")
+
+
+;;; 3.3.8 GdkColor deprecated, so all existing refs above need -gtk2
+
+(CINT-3.4 "GTK_STATE_FLAG_BACKDROP" "GtkStateFlags")
+
+(CFNC-3.4 "GtkWidget* gtk_image_new_from_resource gchar* resource_path" 'const)
+(CFNC-3.4 "void gtk_image_set_from_resource GtkImage* image gchar* resource_path" 'const)
+(CFNC-3.4 "void gtk_window_set_attached_to GtkWindow* window GtkWidget* attach_widget")
+(CFNC-3.4 "GtkWidget* gtk_window_get_attached_to GtkWindow* window")
+
+;;; 3.3.10 nothing new
+;;; 3.3.12
+(CFNC-3.4 "void gtk_about_dialog_add_credit_section GtkAboutDialog* about gchar* section_name gchar** people" 'const)
+
+;;; 3.3.14 nothing new
+
+;;; 3.3.16 color selection dialog deprecated -- many new headers for color chooser dialog
+;;; colorsel.h and colorseldialog.h gone
+;;; color_button stuff seems also to be deprecated?
+
+(CFNC-3.4 "guint gdk_keymap_get_modifier_state GdkKeymap* keymap")
+(CFNC-3.4 "void gtk_hsv_to_rgb gdouble h gdouble s gdouble v gdouble* [r] gdouble* [g] gdouble* [b]")
+(CFNC-3.4 "void gtk_rgb_to_hsv gdouble r gdouble g gdouble b gdouble* [h] gdouble* [s] gdouble* [v]")
+(CFNC-3.4 "void gtk_color_chooser_get_rgba GtkColorChooser* chooser GdkRGBA* color")
+(CFNC-3.4 "void gtk_color_chooser_set_rgba GtkColorChooser* chooser GdkRGBA* color" 'const)
+(CFNC-3.4 "gboolean gtk_color_chooser_get_use_alpha GtkColorChooser* chooser")
+(CFNC-3.4 "void gtk_color_chooser_set_use_alpha GtkColorChooser* chooser gboolean use_alpha")
+(CFNC-3.4 "GtkWidget* gtk_color_chooser_dialog_new gchar* title GtkWindow* parent" 'const)
+(CFNC-3.4 "GtkWidget* gtk_color_chooser_widget_new void")
+
+(CCAST-3.4 "GTK_COLOR_CHOOSER_DIALOG" "GtkColorChooserDialog*")
+(CCHK-3.4 "GTK_IS_COLOR_CHOOSER_DIALOG" "GtkColorChooserDialog*")
+(CCAST-3.4 "GTK_COLOR_CHOOSER_WIDGET" "GtkColorWidget*")
+(CCHK-3.4 "GTK_IS_COLOR_CHOOSER_WIDGET" "GtkColorWidget*")
+
+;; also GDK_BUTTON_PRIMARY|MIDDLE|SECONDARY but they are just ints (from gdkevents.h)
+
+
+;;; 3.3.18
+
+;(CINT-3.6 "GDK_EXTENSION_EVENTS_NONE" "GdkExtensionMode")
+;(CINT-3.6 "GDK_EXTENSION_EVENTS_ALL" "GdkExtensionMode")
+;(CINT-3.6 "GDK_EXTENSION_EVENTS_CURSOR" "GdkExtensionMode")
+
+(CINT-3.6 "GDK_TOUCH_BEGIN" "GdkEventType")
+(CINT-3.6 "GDK_TOUCH_UPDATE" "GdkEventType")
+(CINT-3.6 "GDK_TOUCH_END" "GdkEventType")
+(CINT-3.6 "GDK_TOUCH_CANCEL" "GdkEventType")
+
+(CINT-3.6 "GDK_SCROLL_SMOOTH" "GdkScrollDirection")
+
+(CINT-3.6 "GDK_CROSSING_TOUCH_BEGIN" "GdkCrossingMode")
+(CINT-3.6 "GDK_CROSSING_TOUCH_END" "GdkCrossingMode")
+(CINT-3.6 "GDK_CROSSING_DEVICE_SWITCH" "GdkCrossingMode")
+
+;(CINT-3.6 "GDK_EVENT_POINTER_EMULATED" "GdkEventFlags")
+
+(CINT-3.6 "GDK_TOUCH_MASK" "GdkEventMask")
+(CINT-3.6 "GDK_SMOOTH_SCROLL_MASK" "GdkEventMask")
+
+(CFNC-3.6 "gboolean gdk_event_get_scroll_deltas GdkEvent* event gdouble* [delta_x] gdouble* [delta_y]")
+
+;;; 3.3.20 -- nothing new but "XI2" requirement -- what is that?? -- apparently some sort of typo
+(CFNC-3.6 "void gtk_color_chooser_add_palette GtkColorChooser* chooser GtkOrientation horizontal gint colors_per_line gint n_colors GdkRGBA* colors") ; was gboolean horizontal
+
+;;; 3.4.0|1 -- nothing new
+;;; 3.5.2 -- a few deprecations (below)
+
+
+;;; 3.5.4
+(CFNC-3.6 "void gtk_button_set_always_show_image GtkButton* button gboolean always_show")
+(CFNC-3.6 "gboolean gtk_button_get_always_show_image GtkButton* button")
+(CFNC-3.6 "guint gtk_tree_view_get_n_columns GtkTreeView* tree_view")
+
+
+;;; GTK_UNIT_NONE as a GtkUnit (like pixel) but this enum is commented out above
+
+;;; 3.5.6
+;(CFNC-3.6 "gboolean gtk_icon_view_get_cell_rect GtkIconView* icon_view GtkTreePath* path GtkCellRenderer* cell GdkRectangle** [rect]")
+(CCAST-3.6 "GTK_MENU_BUTTON" "GtkMenuButton*")
+(CCHK-3.6 "GTK_IS_MENU_BUTTON" "GtkMenuButton*")
+(CFNC-3.6 "GtkWidget* gtk_menu_button_new void")
+;;; 3.5.12 (CFNC-3.6 "void gtk_menu_button_set_menu GtkMenuButton* menu_button GtkWidget* menu")
+;;; 3.5.12 (CFNC-3.6 "GtkMenu* gtk_menu_button_get_menu GtkMenuButton* menu_button")
+;;; 3.13.2 (CFNC-3.6 "void gtk_menu_button_set_direction GtkMenuButton* menu_button GtkArrowType direction")
+;;; 3.13.2 (CFNC-3.6 "GtkArrowType gtk_menu_button_get_direction GtkMenuButton* menu_button")
+(CFNC-3.6 "void gtk_menu_button_set_menu_model GtkMenuButton* menu_button GMenuModel* menu_model")
+(CFNC-3.6 "GMenuModel* gtk_menu_button_get_menu_model GtkMenuButton* menu_button")
+(CFNC-3.6 "void gtk_menu_button_set_align_widget GtkMenuButton* menu_button GtkWidget* align_widget")
+(CFNC-3.6 "GtkWidget* gtk_menu_button_get_align_widget GtkMenuButton* menu_button")
+(CCAST-3.6 "GTK_SEARCH_ENTRY" "GtkWidget*")
+(CCHK-3.6 "GTK_IS_SEARCH_ENTRY" "GtkWidget*")
+(CFNC-3.6 "GtkWidget* gtk_search_entry_new void")
+
+;;; 3.5.8 (which requires atk-bridge which is not builable!)
+(CINT-3.6 "GTK_LEVEL_BAR_MODE_CONTINUOUS" "GtkLevelBarMode")
+(CINT-3.6 "GTK_LEVEL_BAR_MODE_DISCRETE" "GtkLevelBarMode")
+
+(CCAST-3.6 "GTK_LEVEL_BAR" "GtkLevelBar*")
+(CCHK-3.6 "GTK_IS_LEVEL_BAR" "GtkLevelBar*")
+
+(CFNC-3.6 "GtkWidget* gtk_level_bar_new void")
+(CFNC-3.6 "GtkWidget* gtk_level_bar_new_for_interval gdouble min_value gdouble max_value")
+(CFNC-3.6 "void gtk_level_bar_set_mode GtkLevelBar* self GtkLevelBarMode mode")
+(CFNC-3.6 "GtkLevelBarMode gtk_level_bar_get_mode GtkLevelBar* self")
+(CFNC-3.6 "void gtk_level_bar_set_value GtkLevelBar* self gdouble value")
+(CFNC-3.6 "gdouble gtk_level_bar_get_value GtkLevelBar* self")
+(CFNC-3.6 "void gtk_level_bar_set_min_value GtkLevelBar* self gdouble value")
+(CFNC-3.6 "gdouble gtk_level_bar_get_min_value GtkLevelBar* self")
+(CFNC-3.6 "void gtk_level_bar_set_max_value GtkLevelBar* self gdouble value")
+(CFNC-3.6 "gdouble gtk_level_bar_get_max_value GtkLevelBar* self")
+(CFNC-3.6 "void gtk_level_bar_add_offset_value GtkLevelBar* self gchar* name gdouble value" 'const)
+(CFNC-3.6 "void gtk_level_bar_remove_offset_value GtkLevelBar* self gchar* name" 'const)
+(CFNC-3.6 "gboolean gtk_level_bar_get_offset_value GtkLevelBar* self gchar* name gdouble* [value]" 'const)
+
+
+;;; 3.5.12
+(CFNC-3.6 "GtkWindow* gtk_application_get_active_window GtkApplication* application")
+(CFNC-3.6 "void gtk_entry_set_input_purpose GtkEntry* entry GtkInputPurpose purpose")
+(CFNC-3.6 "GtkInputPurpose gtk_entry_get_input_purpose GtkEntry* entry")
+(CFNC-3.6 "void gtk_entry_set_input_hints GtkEntry* entry GtkInputHints hints")
+(CFNC-3.6 "GtkInputHints gtk_entry_get_input_hints GtkEntry* entry")
+;;; ?? (CFNC-3.6 "void gtk_menu_button_set_menu GtkMenuButton* menu_button GtkWidget* menu")
+(CFNC-3.6 "GtkMenu* gtk_menu_button_get_popup GtkMenuButton* menu_button")
+(CFNC-3.6 "void gtk_text_view_set_input_purpose GtkTextView* text_view GtkInputPurpose purpose")
+(CFNC-3.6 "GtkInputPurpose gtk_text_view_get_input_purpose GtkTextView* text_view")
+(CFNC-3.6 "void gtk_text_view_set_input_hints GtkTextView* text_view GtkInputHints hints")
+(CFNC-3.6 "GtkInputHints gtk_text_view_get_input_hints GtkTextView* text_view")
+;(CFNC-3.6 "void gtk_widget_insert_action_group GtkWidget* widget gchar* name GActionGroup* group" 'const)
+
+(CINT-3.6 "GTK_INPUT_PURPOSE_FREE_FORM" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_ALPHA" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_DIGITS" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_NUMBER" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_PHONE" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_URL" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_EMAIL" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_NAME" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_PASSWORD" "GtkInputPurpose")
+(CINT-3.6 "GTK_INPUT_PURPOSE_PIN" "GtkInputPurpose")
+
+(CINT-3.6 "GTK_INPUT_HINT_NONE" "GtkInputHints")
+(CINT-3.6 "GTK_INPUT_HINT_SPELLCHECK" "GtkInputHints")
+(CINT-3.6 "GTK_INPUT_HINT_NO_SPELLCHECK" "GtkInputHints")
+(CINT-3.6 "GTK_INPUT_HINT_WORD_COMPLETION" "GtkInputHints")
+(CINT-3.6 "GTK_INPUT_HINT_LOWERCASE" "GtkInputHints")
+(CINT-3.6 "GTK_INPUT_HINT_UPPERCASE_CHARS" "GtkInputHints")
+(CINT-3.6 "GTK_INPUT_HINT_UPPERCASE_WORDS" "GtkInputHints")
+(CINT-3.6 "GTK_INPUT_HINT_UPPERCASE_SENTENCES" "GtkInputHints")
+
+
+;;; 3.5.14
+(CINT-3.6 "GTK_INPUT_HINT_INHIBIT_OSK" "GtkInputHints")
+(CFNC-3.6 "void gtk_entry_set_attributes GtkEntry* entry PangoAttrList* attrs")
+(CFNC-3.6 "PangoAttrList* gtk_entry_get_attributes GtkEntry* entry")
+
+;;; nothing new in 3.5.16
+
+;;; 3.5.18
+(CFNC-3.6 "void gtk_accel_label_set_accel GtkAccelLabel* accel_label guint accelerator_key GdkModifierType accelerator_mods")
+;;; (CFNC-3.6 "GtkAccelGroup* gtk_action_group_get_accel_group GtkActionGroup* action_group")
+;;; (CFNC-3.6 "void gtk_action_group_set_accel_group GtkActionGroup* action_group GtkAccelGroup* accel_group")
+(CFNC-3.6 "void gtk_menu_shell_bind_model GtkMenuShell* menu_shell GMenuModel* model gchar* action_namespace gboolean with_separators" 'const)
+
+;;; nothing new in 3.6.0|1
+
+;;; 3.7.0
+(CFNC-3.8 "void gtk_level_bar_set_inverted GtkLevelBar* self gboolean inverted")
+(CFNC-3.8 "gboolean gtk_level_bar_get_inverted GtkLevelBar* self")
+
+
+;;; 3.7.2
+(CFNC-3.8 "gboolean gtk_widget_is_visible GtkWidget* widget")
+
+
+;;; 3.7.4
+;;; gtk-gradient is deprecated? and symboliccolor
+
+
+;;; 3.7.6
+(CINT-3.8 "GTK_STATE_FLAG_DIR_LTR" "GtkStateFlags")
+(CINT-3.8 "GTK_STATE_FLAG_DIR_RTL" "GtkStateFlags")
+
+
+;;; 3.7.8
+(CINT-3.8 "GDK_FULLSCREEN_ON_CURRENT_MONITOR" "GdkFullscreenMode")
+(CINT-3.8 "GDK_FULLSCREEN_ON_ALL_MONITORS" "GdkFullscreenMode")
+
+(CFNC-3.8 "void gdk_window_set_fullscreen_mode GdkWindow* window GdkFullscreenMode mode")
+(CFNC-3.8 "GdkFullscreenMode gdk_window_get_fullscreen_mode GdkWindow* window")
+(CFNC-3.8 "void gtk_icon_view_set_activate_on_single_click GtkIconView* icon_view gboolean single")
+(CFNC-3.8 "gboolean gtk_icon_view_get_activate_on_single_click GtkIconView* icon_view")
+(CFNC-3.8 "gboolean gtk_tree_view_get_activate_on_single_click GtkTreeView* tree_view")
+(CFNC-3.8 "void gtk_tree_view_set_activate_on_single_click GtkTreeView* tree_view gboolean single")
+
+
+;;; 3.7.10
+(CFNC-3.8 "void gtk_widget_register_window GtkWidget* widget GdkWindow* window")
+(CFNC-3.8 "void gtk_widget_unregister_window GtkWidget* widget GdkWindow* window")
+(CFNC-3.8 "void gtk_widget_set_opacity GtkWidget* widget double opacity")
+(CFNC-3.8 "double gtk_widget_get_opacity GtkWidget* widget")
+
+;;; 3.7.12:
+(CFNC-3.8 "void pango_font_map_changed PangoFontMap* fontmap")
+
+;;; 3.7.14: no changes
+;;; 3.8.0: no changes
+
+;;; 3.9.0: lots of changes! here we go...
+
+;;; (CFNC-3.10 "GdkDisplayManager* gdk_display_manager_peek void")
+(CFNC-3.10 "void gdk_set_allowed_backends gchar* backends" 'const)
+(CFNC-3.10 "void gtk_box_set_baseline_position GtkBox* box GtkBaselinePosition position")
+(CFNC-3.10 "GtkBaselinePosition gtk_box_get_baseline_position GtkBox* box")
+(CFNC-3.10 "void gtk_grid_remove_row GtkGrid* grid gint position")
+(CFNC-3.10 "void gtk_grid_remove_column GtkGrid* grid gint position")
+(CFNC-3.10 "void gtk_grid_set_row_baseline_position GtkGrid* grid gint row GtkBaselinePosition pos")
+(CFNC-3.10 "GtkBaselinePosition gtk_grid_get_row_baseline_position GtkGrid* grid gint row")
+(CFNC-3.10 "void gtk_grid_set_baseline_row GtkGrid* grid gint row")
+(CFNC-3.10 "gint gtk_grid_get_baseline_row GtkGrid* grid")
+(CFNC-3.10 "void gtk_widget_size_allocate_with_baseline GtkWidget* widget GtkAllocation* allocation gint baseline")
+(CFNC-3.10 "void gtk_widget_get_preferred_height_and_baseline_for_width GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height] gint* [minimum_baseline] gint* [natural_baseline]")
+;;; (CFNC-3.10 "void gtk_widget_get_preferred_size_and_baseline GtkWidget* widget GtkRequisition* minimum_size GtkRequisition* natural_size gint* [minimum_baseline] gint* [natural_baseline]")
+(CFNC-3.10 "int gtk_widget_get_allocated_baseline GtkWidget* widget")
+(CFNC-3.10 "GtkAlign gtk_widget_get_valign_with_baseline GtkWidget* widget")
+(CFNC-3.10 "void gtk_widget_init_template GtkWidget* widget")
+;;; (CFNC-3.10 "GObject* gtk_widget_get_automated_child GtkWidget* widget GType widget_type gchar* name" 'const)
+;;; GObject* is apparently the problem here
+;(CFNC-3.10 "void gtk_widget_class_set_template GtkWidgetClass* widget_class GBytes* template_bytes")
+;(CFNC-3.10 "void gtk_widget_class_set_template_from_resource GtkWidgetClass* widget_class gchar* resource_name" 'const)
+;;; (CFNC-3.10 "void gtk_widget_class_declare_callback GtkWidgetClass* widget_class gchar* callback_name GCallback callback_symbol" 'const)
+;;; (CFNC-3.10 "void gtk_widget_class_automate_child GtkWidgetClass* widget_class gchar* name gboolean internal_child gssize struct_offset" 'const)
+(CFNC-3.10 "void gtk_window_set_titlebar GtkWindow* window GtkWidget* titlebar")
+(CFNC-3.10 "GtkWidget* gtk_places_sidebar_new void")
+(CFNC-3.10 "GtkPlacesOpenFlags gtk_places_sidebar_get_open_flags GtkPlacesSidebar* sidebar")
+(CFNC-3.10 "void gtk_places_sidebar_set_open_flags GtkPlacesSidebar* sidebar GtkPlacesOpenFlags flags")
+(CFNC-3.10 "GFile* gtk_places_sidebar_get_location GtkPlacesSidebar* sidebar")
+(CFNC-3.10 "void gtk_places_sidebar_set_location GtkPlacesSidebar* sidebar GFile* location")
+(CFNC-3.10 "gboolean gtk_places_sidebar_get_show_desktop GtkPlacesSidebar* sidebar")
+(CFNC-3.10 "void gtk_places_sidebar_set_show_desktop GtkPlacesSidebar* sidebar gboolean show_desktop")
+;;; 3.18 (CFNC-3.10 "gboolean gtk_places_sidebar_get_show_connect_to_server GtkPlacesSidebar* sidebar")
+;;; 3.18 (CFNC-3.10 "void gtk_places_sidebar_set_show_connect_to_server GtkPlacesSidebar* sidebar gboolean show_connect_to_server")
+(CFNC-3.10 "void gtk_places_sidebar_add_shortcut GtkPlacesSidebar* sidebar GFile* location")
+(CFNC-3.10 "void gtk_places_sidebar_remove_shortcut GtkPlacesSidebar* sidebar GFile* location")
+(CFNC-3.10 "GSList* gtk_places_sidebar_list_shortcuts GtkPlacesSidebar* sidebar")
+(CFNC-3.10 "GFile* gtk_places_sidebar_get_nth_bookmark GtkPlacesSidebar* sidebar gint n")
+(CFNC-3.10 "GtkWidget* gtk_stack_switcher_new void")
+(CFNC-3.10 "void gtk_stack_switcher_set_stack GtkStackSwitcher* switcher GtkStack* stack")
+(CFNC-3.10 "GtkStack* gtk_stack_switcher_get_stack GtkStackSwitcher* switcher")
+(CFNC-3.10 "GtkWidget* gtk_stack_new void")
+(CFNC-3.10 "void gtk_stack_add_named GtkStack* stack GtkWidget* child gchar* name" 'const)
+(CFNC-3.10 "void gtk_stack_add_titled GtkStack* stack GtkWidget* child gchar* name gchar* title" 'const)
+(CFNC-3.10 "void gtk_stack_set_visible_child GtkStack* stack GtkWidget* child")
+(CFNC-3.10 "GtkWidget* gtk_stack_get_visible_child GtkStack* stack")
+(CFNC-3.10 "void gtk_stack_set_visible_child_name GtkStack* stack gchar* name" 'const)
+(CFNC-3.10 "gchar* gtk_stack_get_visible_child_name GtkStack* stack")
+(CFNC-3.10 "void gtk_stack_set_visible_child_full GtkStack* stack gchar* name GtkStackTransitionType transition" 'const)
+(CFNC-3.10 "void gtk_stack_set_homogeneous GtkStack* stack gboolean homogeneous")
+(CFNC-3.10 "gboolean gtk_stack_get_homogeneous GtkStack* stack")
+(CFNC-3.10 "void gtk_stack_set_transition_duration GtkStack* stack guint duration")
+(CFNC-3.10 "guint gtk_stack_get_transition_duration GtkStack* stack")
+(CFNC-3.10 "void gtk_stack_set_transition_type GtkStack* stack GtkStackTransitionType transition")
+(CFNC-3.10 "GtkStackTransitionType gtk_stack_get_transition_type GtkStack* stack")
+(CFNC-3.10 "GtkWidget* gtk_revealer_new void")
+(CFNC-3.10 "gboolean gtk_revealer_get_reveal_child GtkRevealer* revealer")
+(CFNC-3.10 "void gtk_revealer_set_reveal_child GtkRevealer* revealer gboolean reveal_child")
+(CFNC-3.10 "gboolean gtk_revealer_get_child_revealed GtkRevealer* revealer")
+(CFNC-3.10 "guint gtk_revealer_get_transition_duration GtkRevealer* revealer")
+(CFNC-3.10 "void gtk_revealer_set_transition_duration GtkRevealer* revealer guint duration")
+(CFNC-3.10 "void gtk_revealer_set_transition_type GtkRevealer* revealer GtkRevealerTransitionType transition")
+(CFNC-3.10 "GtkRevealerTransitionType gtk_revealer_get_transition_type GtkRevealer* revealer")
+(CFNC-3.10 "GtkWidget* gtk_header_bar_new void")
+(CFNC-3.10 "void gtk_header_bar_set_title GtkHeaderBar* bar gchar* title" 'const)
+(CFNC-3.10 "gchar* gtk_header_bar_get_title GtkHeaderBar* bar" 'const)
+(CFNC-3.10 "void gtk_header_bar_set_subtitle GtkHeaderBar* bar gchar* subtitle" 'const)
+(CFNC-3.10 "gchar* gtk_header_bar_get_subtitle GtkHeaderBar* bar" 'const)
+(CFNC-3.10 "void gtk_header_bar_set_custom_title GtkHeaderBar* bar GtkWidget* title_widget")
+(CFNC-3.10 "GtkWidget* gtk_header_bar_get_custom_title GtkHeaderBar* bar")
+(CFNC-3.10 "void gtk_header_bar_pack_start GtkHeaderBar* bar GtkWidget* child")
+(CFNC-3.10 "void gtk_header_bar_pack_end GtkHeaderBar* bar GtkWidget* child")
+
+(CINT-3.10 "GTK_ALIGN_BASELINE" "GtkAlign")
+(CINT-3.10 "GTK_BASELINE_POSITION_TOP" "GtkBaselinePosition")
+(CINT-3.10 "GTK_BASELINE_POSITION_CENTER" "GtkBaselinePosition")
+(CINT-3.10 "GTK_BASELINE_POSITION_BOTTOM" "GtkBaselinePosition")
+(CINT-3.10 "GTK_PLACES_OPEN_NORMAL" "GtkPlacesOpenFlags")
+(CINT-3.10 "GTK_PLACES_OPEN_NEW_TAB" "GtkPlacesOpenFlags")
+(CINT-3.10 "GTK_PLACES_OPEN_NEW_WINDOW" "GtkPlacesOpenFlags")
+(CINT-3.10 "GTK_STACK_TRANSITION_TYPE_NONE" "GtkStackTransitionType")
+(CINT-3.10 "GTK_STACK_TRANSITION_TYPE_CROSSFADE" "GtkStackTransitionType")
+(CINT-3.10 "GTK_STACK_TRANSITION_TYPE_SLIDE_RIGHT" "GtkStackTransitionType")
+(CINT-3.10 "GTK_STACK_TRANSITION_TYPE_SLIDE_LEFT" "GtkStackTransitionType")
+(CINT-3.10 "GTK_STACK_TRANSITION_TYPE_SLIDE_UP" "GtkStackTransitionType")
+(CINT-3.10 "GTK_STACK_TRANSITION_TYPE_SLIDE_DOWN" "GtkStackTransitionType")
+(CINT-3.10 "GTK_REVEALER_TRANSITION_TYPE_NONE" "GtkRevealerTransitionType")
+(CINT-3.10 "GTK_REVEALER_TRANSITION_TYPE_CROSSFADE" "GtkRevealerTransitionType")
+(CINT-3.10 "GTK_REVEALER_TRANSITION_TYPE_SLIDE_RIGHT" "GtkRevealerTransitionType")
+(CINT-3.10 "GTK_REVEALER_TRANSITION_TYPE_SLIDE_LEFT" "GtkRevealerTransitionType")
+(CINT-3.10 "GTK_REVEALER_TRANSITION_TYPE_SLIDE_UP" "GtkRevealerTransitionType")
+(CINT-3.10 "GTK_REVEALER_TRANSITION_TYPE_SLIDE_DOWN" "GtkRevealerTransitionType")
+
+(CCAST-3.10 "GTK_PLACES_SIDEBAR" "GtkPlacesSidebar*")
+(CCHK-3.10 "GTK_IS_PLACES_SIDEBAR" "GtkPlacesSidebar*")
+(CCAST-3.10 "GTK_STACK_SWITCHER" "GtkStackSwitcher*")
+(CCHK-3.10 "GTK_IS_STACK_SWITCHER" "GtkStackSwitcher*")
+(CCAST-3.10 "GTK_STACK" "GtkStack*")
+(CCHK-3.10 "GTK_IS_STACK" "GtkStack*")
+(CCAST-3.10 "GTK_REVEALER" "GtkRevealer*")
+(CCHK-3.10 "GTK_IS_REVEALER" "GtkRevealer*")
+(CCAST-3.10 "GTK_HEADER_BAR" "GtkHeaderBar*")
+(CCHK-3.10 "GTK_IS_HEADER_BAR" "GtkHeaderBar*")
+
+
+
+;;; 3.9.2
+
+(CINT-3.10 "GDK_WINDOW_STATE_TILED" "GdkWindowState")
+
+;new files: [gtkactionmuxer|observable|observer] -- not apparently tying these in (see recent action), [gtkmenutrackeritem]
+
+;;; 3.9.4: gtklistbox (slist replacement?) and gtksearchbar
+
+(CCAST-3.10 "GTK_LIST_BOX" "GtkListBox*")
+(CCHK-3.10 "GTK_IS_LIST_BOX" "GtkListBox*")
+
+(CCAST-3.10 "GTK_LIST_BOX_ROW" "GtkListBoxRow*")
+(CCHK-3.10 "GTK_IS_LIST_BOX_ROW" "GtkListBoxRow*")
+
+(CCAST-3.10 "GTK_SEARCH_BAR" "GtkSearchBar*")
+(CCHK-3.10 "GTK_IS_SEARCH_BAR" "GtkSearchBar*")
+
+;typedef gboolean (*GtkListBoxFilterFunc) (GtkListBoxRow *row, gpointer user_data);
+;typedef gint (*GtkListBoxSortFunc) (GtkListBoxRow *row1, GtkListBoxRow *row2, gpointer user_data);
+;typedef void (*GtkListBoxUpdateHeaderFunc) (GtkListBoxRow *row, GtkListBoxRow *before, gpointer user_data);
+
+(CFNC-3.10 "GtkWidget* gtk_list_box_row_new void")
+(CFNC-3.10 "GtkWidget* gtk_list_box_row_get_header GtkListBoxRow* row")
+(CFNC-3.10 "void gtk_list_box_row_set_header GtkListBoxRow* row GtkWidget* header")
+(CFNC-3.10 "void gtk_list_box_row_changed GtkListBoxRow* row")
+(CFNC-3.10 "GtkListBoxRow* gtk_list_box_get_selected_row GtkListBox* list_box")
+(CFNC-3.10 "GtkListBoxRow* gtk_list_box_get_row_at_index GtkListBox* list_box gint index_")
+(CFNC-3.10 "GtkListBoxRow* gtk_list_box_get_row_at_y GtkListBox* list_box gint y")
+(CFNC-3.10 "void gtk_list_box_select_row GtkListBox* list_box GtkListBoxRow* row")
+(CFNC-3.10 "void gtk_list_box_set_placeholder GtkListBox* list_box GtkWidget* placeholder")
+(CFNC-3.10 "void gtk_list_box_set_adjustment GtkListBox* list_box GtkAdjustment* adjustment")
+(CFNC-3.10 "GtkAdjustment* gtk_list_box_get_adjustment GtkListBox* list_box")
+(CFNC-3.10 "void gtk_list_box_set_selection_mode GtkListBox* list_box GtkSelectionMode mode")
+(CFNC-3.10 "GtkSelectionMode gtk_list_box_get_selection_mode GtkListBox* list_box")
+;(CFNC-3.10 "void gtk_list_box_set_filter_func GtkListBox* list_box GtkListBoxFilterFunc filter_func gpointer user_data GDestroyNotify destroy")
+;(CFNC-3.10 "void gtk_list_box_set_header_func GtkListBox* list_box GtkListBoxUpdateHeaderFunc update_header gpointer user_data GDestroyNotify destroy")
+(CFNC-3.10 "void gtk_list_box_invalidate_filter GtkListBox* list_box")
+(CFNC-3.10 "void gtk_list_box_invalidate_sort GtkListBox* list_box")
+(CFNC-3.10 "void gtk_list_box_invalidate_headers GtkListBox* list_box")
+;(CFNC-3.10 "void gtk_list_box_set_sort_func GtkListBox* list_box GtkListBoxSortFunc sort_func gpointer user_data GDestroyNotify destroy")
+(CFNC-3.10 "void gtk_list_box_set_activate_on_single_click GtkListBox* list_box gboolean single")
+(CFNC-3.10 "gboolean gtk_list_box_get_activate_on_single_click GtkListBox* list_box")
+(CFNC-3.10 "void gtk_list_box_drag_unhighlight_row GtkListBox* list_box")
+(CFNC-3.10 "void gtk_list_box_drag_highlight_row GtkListBox* list_box GtkListBoxRow* row")
+(CFNC-3.10 "GtkWidget* gtk_list_box_new void")
+(CFNC-3.10 "GtkWidget* gtk_search_bar_new void")
+(CFNC-3.10 "void gtk_search_bar_connect_entry GtkSearchBar* bar GtkEntry* entry")
+(CFNC-3.10 "gboolean gtk_search_bar_get_search_mode GtkSearchBar* bar")
+(CFNC-3.10 "void gtk_search_bar_set_search_mode GtkSearchBar* bar gboolean search_mode")
+(CFNC-3.10 "gboolean gtk_search_bar_get_show_close_button GtkSearchBar* bar")
+(CFNC-3.10 "void gtk_search_bar_set_show_close_button GtkSearchBar* bar gboolean visible")
+(CFNC-3.10 "gboolean gtk_search_bar_handle_event GtkSearchBar* bar GdkEvent* event")
+
+
+;;; 3.9.6
+(CFNC-3.10 "gchar* gtk_file_chooser_get_current_name GtkFileChooser* chooser")
+
+
+; Wholly deprecated as part of this effort:
+; GtkIconFactory, GtkIconSet, GtkIconSource, GtkImageMenuItem,
+; GtkAction, GtkUIManager
+;
+; A number of settings have been deprecated and are ignored now:
+; gtk-button-images, gtk-show-unicode-menu, gtk-show-input-method-menu, gtk-enable-mnemonics, gtk-auto-mnemonics,
+; gtk-color-palette, gtk-can-change-accels, cursor blink settings, gtk-fallback-icon-theme, gtk-scrolled-window-placement,
+; menu popup delay settings, gtk-menu-bar-accel, keynav tweaks, gtk-touchscreen-mode, gtk-icon-sizes, im style tweaks,
+; gtk-file-chooser-backend, gtk-enable-tooltips, gtk-visible-focus, tooltip timeout tweaks, toolbar style tweaks
+
+;;; 3.9.8:
+(CFNC-3.10 "cairo_surface_t* gdk_cairo_surface_create_from_pixbuf GdkPixbuf* pixbuf int scale GdkWindow* for_window")
+(CFNC-3.10 "void gdk_device_get_position_double GdkDevice* device GdkScreen** [screen] gdouble* [x] gdouble* [y]")
+(CFNC-3.10 "GdkWindow* gdk_device_get_window_at_position_double GdkDevice* device gdouble* [win_x] gdouble* [win_y]")
+(CFNC-3.10 "gint gdk_screen_get_monitor_scale_factor GdkScreen* screen gint monitor_num")
+(CFNC-3.10 "gint gdk_window_get_scale_factor GdkWindow* window")
+(CFNC-3.10 "GdkWindow* gdk_window_get_device_position_double GdkWindow* window GdkDevice* device gdouble* [x] gdouble* [y] GdkModifierType* [mask]")
+(CFNC-3.10 "cairo_surface_t* gdk_window_create_similar_image_surface GdkWindow* window cairo_format_t format int width int height int scale")
+(CFNC-3.10 "GtkIconInfo* gtk_icon_theme_lookup_icon_for_scale GtkIconTheme* icon_theme gchar* icon_name gint size gint scale GtkIconLookupFlags flags" 'const)
+;(CFNC-3.10 "GtkIconInfo* gtk_icon_theme_choose_icon_for_scale GtkIconTheme* icon_theme gchar* icon_names[] gint size gint scale GtkIconLookupFlags flags" 'const)
+(CFNC-3.10 "GdkPixbuf* gtk_icon_theme_load_icon_for_scale GtkIconTheme* icon_theme gchar* icon_name gint size gint scale GtkIconLookupFlags flags GError** [error]" 'const)
+(CFNC-3.10 "cairo_surface_t* gtk_icon_theme_load_surface GtkIconTheme* icon_theme gchar* icon_name gint size gint scale GdkWindow* for_window GtkIconLookupFlags flags GError** [error]" 'const)
+(CFNC-3.10 "GtkIconInfo* gtk_icon_theme_lookup_by_gicon_for_scale GtkIconTheme* icon_theme GIcon* icon gint size gint scale GtkIconLookupFlags flags")
+(CFNC-3.10 "gint gtk_icon_info_get_base_scale GtkIconInfo* icon_info")
+(CFNC-3.10 "cairo_surface_t* gtk_icon_info_load_surface GtkIconInfo* icon_info GdkWindow* for_window GError** [error]")
+(CFNC-3.10 "GtkWidget* gtk_image_new_from_surface cairo_surface_t* surface")
+(CFNC-3.10 "void gtk_image_set_from_surface GtkImage* image cairo_surface_t* surface")
+(CFNC-3.10 "gint gtk_list_box_row_get_index GtkListBoxRow* row")
+(CFNC-3.10 "gint gtk_widget_get_scale_factor GtkWidget* widget")
+(CFNC-3.10 "void gtk_window_close GtkWindow* window")
+
+;;; 3.9.10:
+(CFNC-3.10 "void gtk_info_bar_set_show_close_button GtkInfoBar* info_bar gboolean setting")
+(CFNC-3.10 "gboolean gtk_info_bar_get_show_close_button GtkInfoBar* info_bar")
+(CFNC-3.10 "void gtk_tree_model_rows_reordered_with_length GtkTreeModel* tree_model GtkTreePath* path GtkTreeIter* iter gint* new_order gint length")
+
+
+;;; 3.9.12:
+
+(CFNC-3.10 "GdkCursor* gdk_cursor_new_from_surface GdkDisplay* display cairo_surface_t* surface gdouble x gdouble y")
+(CFNC-3.10 "cairo_surface_t* gdk_cursor_get_surface GdkCursor* cursor gdouble* [x_hot] gdouble* [y_hot]")
+(CFNC-3.10 "GdkEventType gdk_event_get_event_type GdkEvent* event" 'const)
+;;; (CFNC-3.10 "GtkWidget* gtk_button_new_from_icon_name gchar* icon_name GtkIconSize size" 'const)
+(CFNC-3.10 "void gtk_entry_set_tabs GtkEntry* entry PangoTabArray* tabs")
+(CFNC-3.10 "PangoTabArray* gtk_entry_get_tabs GtkEntry* entry")
+(CFNC-3.10 "gboolean gtk_header_bar_get_show_close_button GtkHeaderBar* bar")
+(CFNC-3.10 "void gtk_header_bar_set_show_close_button GtkHeaderBar* bar gboolean setting")
+(CFNC-3.10 "void gtk_list_box_prepend GtkListBox* list_box GtkWidget* child")
+(CFNC-3.10 "void gtk_list_box_insert GtkListBox* list_box GtkWidget* child gint position")
+
+;;; 3.9.14:
+
+(CFNC-3.10 "void gdk_window_set_opaque_region GdkWindow* window cairo_region_t* region")
+(CFNC-3.10 "void gtk_label_set_lines GtkLabel* label gint lines")
+(CFNC-3.10 "gint gtk_label_get_lines GtkLabel* label")
+
+
+;;; 3.9.16:
+
+(CFNC-3.10 "GdkWindow* gdk_event_get_window GdkEvent* event" 'const)
+
+
+;;; 3.10.0|1|2 -- nothing new
+
+;;; 3.11.0 flowbox.h
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_SLIDE_LEFT_RIGHT" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_SLIDE_UP_DOWN" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_OVER_UP" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_OVER_DOWN" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_OVER_LEFT" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_OVER_RIGHT" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_UNDER_UP" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_UNDER_DOWN" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_UNDER_LEFT" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_UNDER_RIGHT" "GtkStackTransitionType")
+(CINT-3.12 "GTK_STACK_TRANSITION_TYPE_OVER_UP_DOWN" "GtkStackTransitionType")
+
+(CCAST-3.12 "GTK_FLOW_BOX" "GtkFlowBox*")
+(CCHK-3.12 "GTK_IS_FLOW_BOX" "GtkFlowBox*")
+(CCAST-3.12 "GTK_FLOW_BOX_CHILD" "GtkFlowBoxChild*")
+(CCHK-3.12 "GTK_IS_FLOW_BOX_CHILD" "GtkFlowBoxChild*")
+
+(CFNC-3.12 "GtkWidget* gtk_flow_box_child_new void")
+(CFNC-3.12 "gint gtk_flow_box_child_get_index GtkFlowBoxChild* child")
+(CFNC-3.12 "gboolean gtk_flow_box_child_is_selected GtkFlowBoxChild* child")
+(CFNC-3.12 "void gtk_flow_box_child_changed GtkFlowBoxChild* child")
+(CFNC-3.12 "GtkWidget* gtk_flow_box_new void")
+(CFNC-3.12 "void gtk_flow_box_set_homogeneous GtkFlowBox* box gboolean homogeneous")
+(CFNC-3.12 "gboolean gtk_flow_box_get_homogeneous GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_set_row_spacing GtkFlowBox* box guint spacing")
+(CFNC-3.12 "guint gtk_flow_box_get_row_spacing GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_set_column_spacing GtkFlowBox* box guint spacing")
+(CFNC-3.12 "guint gtk_flow_box_get_column_spacing GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_set_min_children_per_line GtkFlowBox* box guint n_children")
+(CFNC-3.12 "guint gtk_flow_box_get_min_children_per_line GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_set_max_children_per_line GtkFlowBox* box guint n_children")
+(CFNC-3.12 "guint gtk_flow_box_get_max_children_per_line GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_set_activate_on_single_click GtkFlowBox* box gboolean single")
+(CFNC-3.12 "gboolean gtk_flow_box_get_activate_on_single_click GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_insert GtkFlowBox* box GtkWidget* widget gint position")
+(CFNC-3.12 "GtkFlowBoxChild* gtk_flow_box_get_child_at_index GtkFlowBox* box gint idx")
+(CFNC-3.12 "GList* gtk_flow_box_get_selected_children GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_select_child GtkFlowBox* box GtkFlowBoxChild* child")
+(CFNC-3.12 "void gtk_flow_box_unselect_child GtkFlowBox* box GtkFlowBoxChild* child")
+(CFNC-3.12 "void gtk_flow_box_select_all GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_unselect_all GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_set_selection_mode GtkFlowBox* box GtkSelectionMode mode")
+(CFNC-3.12 "GtkSelectionMode gtk_flow_box_get_selection_mode GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_set_hadjustment GtkFlowBox* box GtkAdjustment* adjustment")
+(CFNC-3.12 "void gtk_flow_box_set_vadjustment GtkFlowBox* box GtkAdjustment* adjustment")
+(CFNC-3.12 "void gtk_flow_box_invalidate_filter GtkFlowBox* box")
+(CFNC-3.12 "void gtk_flow_box_invalidate_sort GtkFlowBox* box")
+
+;void gtk_flow_box_selected_foreach GtkFlowBox* box GtkFlowBoxForeachFunc func gpointer data)
+;void gtk_flow_box_set_sort_func GtkFlowBox* box GtkFlowBoxSortFunc sort_func gpointer user_data GDestroyNotify destroy)
+;void gtk_flow_box_set_filter_func GtkFlowBox* box GtkFlowBoxFilterFunc filter_func gpointer user_data GDestroyNotify destroy)
+
+
+;;; 3.11.2 -- these are internal to gdk
+;;; (CINT-3.12 "GDK_EVENT_FLUSHED" "GdkEventFlags")
+;;; (CINT-3.12 "GTK_STATE_FLAG_LINK" "GtkStateFlags")
+;;; (CINT-3.12 "GTK_STATE_FLAG_VISITED" "GtkStateFlags")
+
+(CFNC-3.12 "void gdk_window_set_event_compression GdkWindow* window gboolean event_compression")
+(CFNC-3.12 "gboolean gdk_window_get_event_compression GdkWindow* window")
+;;; (CFNC-3.12 "gboolean gtk_header_bar_get_show_fallback_app_menu GtkHeaderBar* bar")
+;;; (CFNC-3.12 "void gtk_header_bar_set_show_fallback_app_menu GtkHeaderBar* bar gboolean setting")
+(CFNC-3.12 "void gtk_places_sidebar_set_local_only GtkPlacesSidebar* sidebar gboolean local_only")
+(CFNC-3.12 "gboolean gtk_places_sidebar_get_local_only GtkPlacesSidebar* sidebar")
+(CFNC-3.12 "gboolean gtk_stack_get_transition_running GtkStack* stack")
+(CFNC-3.12 "gint gtk_widget_get_margin_start GtkWidget* widget")
+(CFNC-3.12 "void gtk_widget_set_margin_start GtkWidget* widget gint margin")
+(CFNC-3.12 "gint gtk_widget_get_margin_end GtkWidget* widget")
+(CFNC-3.12 "void gtk_widget_set_margin_end GtkWidget* widget gint margin")
+
+;;; 3.11.4
+
+(CCAST-3.12 "GTK_ACTION_BAR" "GtkActionBar*")
+(CCHK-3.12 "GTK_IS_ACTION_BAR" "GtkActionBar*")
+(CFNC-3.12 "void gtk_accel_label_get_accel GtkAccelLabel* accel_label guint* [accelerator_key] GdkModifierType* [accelerator_mods]")
+(CFNC-3.12 "void gdk_window_set_shadow_width GdkWindow* window gint left gint right gint top gint bottom")
+(CFNC-3.12 "GtkWidget* gtk_action_bar_new void")
+(CFNC-3.12 "GtkWidget* gtk_action_bar_get_center_widget GtkActionBar* bar")
+(CFNC-3.12 "void gtk_action_bar_set_center_widget GtkActionBar* bar GtkWidget* center_widget")
+(CFNC-3.12 "void gtk_action_bar_pack_start GtkActionBar* bar GtkWidget* child")
+(CFNC-3.12 "void gtk_action_bar_pack_end GtkActionBar* bar GtkWidget* child")
+(CFNC-3.12 "void gtk_header_bar_set_has_subtitle GtkHeaderBar* bar gboolean setting")
+(CFNC-3.12 "gboolean gtk_header_bar_get_has_subtitle GtkHeaderBar* bar")
+(CFNC-3.12 "void gtk_header_bar_set_decoration_layout GtkHeaderBar* bar gchar* layout" 'const)
+(CFNC-3.12 "gchar* gtk_header_bar_get_decoration_layout GtkHeaderBar* bar" 'const)
+(CFNC-3.12 "gboolean gtk_icon_info_is_symbolic GtkIconInfo* icon_info")
+(CFNC-3.12 "GtkTextDirection gtk_get_locale_direction void")
+;(CFNC-3.12 "GtkTreePath* gtk_tree_path_new_from_indicesv gint* indices gsize length")
+(CFNC-3.12 "gboolean gtk_window_is_maximized GtkWindow* window")
+
+
+;;; 3.11.5
+
+(CCAST-3.12 "GTK_POPOVER" "GtkPopover*")
+(CCHK-3.12 "GTK_IS_POPOVER" "GtkPopover*")
+;;; ?? (CFNC-3.12 "GdkVisual* gdk_screen_get_preferred_visual GdkScreen* screen")
+(CFNC-3.12 "GtkWidget* gtk_dialog_get_header_bar GtkDialog* dialog")
+(CFNC-3.12 "GtkWidget* gtk_popover_new GtkWidget* relative_to")
+(CFNC-3.12 "void gtk_popover_set_relative_to GtkPopover* popover GtkWidget* relative_to")
+(CFNC-3.12 "GtkWidget* gtk_popover_get_relative_to GtkPopover* popover")
+;(CFNC-3.12 "void gtk_popover_set_pointing_to GtkPopover* popover GdkRectangle *rect")
+;(CFNC-3.12 "gboolean gtk_popover_get_pointing_to GtkPopover* popover GdkRectangle* [rect]")
+(CFNC-3.12 "void gtk_popover_set_position GtkPopover* popover GtkPositionType position")
+(CFNC-3.12 "GtkPositionType gtk_popover_get_position GtkPopover* popover")
+(CFNC-3.12 "void gtk_popover_set_modal GtkPopover* popover gboolean modal")
+(CFNC-3.12 "gboolean gtk_popover_get_modal GtkPopover* popover")
+
+
+;;; 3.11.6
+;;; gtkmodelbutton.h
+
+(CFNC-3.12 "void gtk_box_set_center_widget GtkBox* box GtkWidget* widget")
+(CFNC-3.12 "GtkWidget* gtk_box_get_center_widget GtkBox* box")
+(CFNC-3.12 "void gtk_entry_set_max_width_chars GtkEntry* entry gint n_chars")
+(CFNC-3.12 "gint gtk_entry_get_max_width_chars GtkEntry* entry")
+
+
+;;; 3.11.9
+(CFNC-3.12 "GdkWindow* gdk_device_get_last_event_window GdkDevice* device")
+
+;;; 3.12.0 -- no changes
+
+;;; 3.12.1 -- no changes?
+
+;;; 3.13.1
+(CFNC-3.14 "gboolean gtk_list_box_row_is_selected GtkListBoxRow* row")
+;(CFNC-3.14 "void gtk_list_box_selected_foreach (GtkListBox* box GtkListBoxForeachFunc func gpointer data")
+;(CFNC-3.14 "GList *gtk_list_box_get_selected_rows GtkListBox* box")
+(CFNC-3.14 "void gtk_list_box_unselect_row GtkListBox* box GtkListBoxRow* row")
+(CFNC-3.14 "void gtk_list_box_select_all GtkListBox* box")
+(CFNC-3.14 "void gtk_list_box_unselect_all GtkListBox* box")
+(CFNC-3.14 "gboolean gtk_places_sidebar_get_show_enter_location GtkPlacesSidebar* sidebar")
+(CFNC-3.14 "void gtk_places_sidebar_set_show_enter_location GtkPlacesSidebar* sidebar gboolean show_enter_location")
+(CFNC-3.14 "void gtk_switch_set_state GtkSwitch* sw gboolean state")
+(CFNC-3.14 "gboolean gtk_switch_get_state GtkSwitch* sw")
+
+;;; is this exported?
+; GTK_MENU_SECTION_BOX(inst)
+; GTK_IS_MENU_SECTION_BOX(inst)
+; void gtk_menu_section_box_new_toplevel GtkStack* stack GMenuModel* model const gchar* action_namespace)
+
+
+;;; 3.13.2:
+
+(CFNC-3.14 "gboolean gdk_window_show_window_menu GdkWindow* window GdkEvent* event")
+(CFNC-3.14 "void gtk_widget_set_clip GtkWidget* widget GtkAllocation* clip" 'const)
+(CFNC-3.14 "void gtk_widget_get_clip GtkWidget* widget GtkAllocation* clip")
+
+(CCAST-3.14 "GTK_GESTURE" "GtkGesture*")
+(CCHK-3.14 "GTK_IS_GESTURE" "GtkGesture*")
+(CCAST-3.14 "GTK_GESTURE_DRAG" "GtkGestureDrag*")
+(CCHK-3.14 "GTK_IS_GESTURE_DRAG" "GtkGestureDrag*")
+(CCAST-3.14 "GTK_GESTURE_LONG_PRESS" "GtkGestureLongPress*")
+(CCHK-3.14 "GTK_IS_GESTURE_LONG_PRESS" "GtkGestureLongPress*")
+(CCAST-3.14 "GTK_GESTURE_ZOOM" "GtkGestureZoom*")
+(CCHK-3.14 "GTK_IS_GESTURE_ZOOM" "GtkGestureZoom*")
+(CCAST-3.14 "GTK_GESTURE_SWIPE" "GtkGestureSwipe*")
+(CCHK-3.14 "GTK_IS_GESTURE_SWIPE" "GtkGestureSwipe*")
+(CCAST-3.14 "GTK_GESTURE_SINGLE" "GtkGestureSingle*")
+(CCHK-3.14 "GTK_IS_GESTURE_SINGLE" "GtkGestureSingle*")
+(CCAST-3.14 "GTK_GESTURE_PAN" "GtkGesturePan*")
+(CCHK-3.14 "GTK_IS_GESTURE_PAN" "GtkGesturePan*")
+(CCAST-3.14 "GTK_GESTURE_MULTI_PRESS" "GtkGestureMultiPress*")
+(CCHK-3.14 "GTK_IS_GESTURE_MULTI_PRESS" "GtkGestureMultiPress*")
+(CCAST-3.14 "GTK_GESTURE_ROTATE" "GtkGestureRotate*")
+(CCHK-3.14 "GTK_IS_GESTURE_ROTATE" "GtkGestureRotate*")
+
+(CFNC-3.14 "GdkDevice* gtk_gesture_get_device GtkGesture* gesture")
+(CFNC-3.14 "gboolean gtk_gesture_set_state GtkGesture* gesture GtkEventSequenceState state")
+(CFNC-3.14 "GtkEventSequenceState gtk_gesture_get_sequence_state GtkGesture* gesture GdkEventSequence* sequence")
+(CFNC-3.14 "gboolean gtk_gesture_set_sequence_state GtkGesture* gesture GdkEventSequence* sequence GtkEventSequenceState state")
+(CFNC-3.14 "GList* gtk_gesture_get_sequences GtkGesture* gesture")
+(CFNC-3.14 "GdkEventSequence* gtk_gesture_get_last_updated_sequence GtkGesture* gesture")
+(CFNC-3.14 "gboolean gtk_gesture_handles_sequence GtkGesture* gesture GdkEventSequence* sequence")
+(CFNC-3.14 "GdkEvent* gtk_gesture_get_last_event GtkGesture* gesture GdkEventSequence* sequence" 'const-return)
+(CFNC-3.14 "gboolean gtk_gesture_get_point GtkGesture* gesture GdkEventSequence* sequence gdouble* [x] gdouble* [y]")
+(CFNC-3.14 "gboolean gtk_gesture_get_bounding_box GtkGesture* gesture GdkRectangle* rect")
+(CFNC-3.14 "gboolean gtk_gesture_get_bounding_box_center GtkGesture* gesture gdouble* [x] gdouble* [y]")
+(CFNC-3.14 "gboolean gtk_gesture_is_active GtkGesture* gesture")
+(CFNC-3.14 "gboolean gtk_gesture_is_recognized GtkGesture* gesture")
+(CFNC-3.14 "GdkWindow* gtk_gesture_get_window GtkGesture* gesture")
+(CFNC-3.14 "void gtk_gesture_set_window GtkGesture* gesture GdkWindow* window")
+(CFNC-3.14 "void gtk_gesture_group GtkGesture* group_gesture GtkGesture* gesture")
+(CFNC-3.14 "void gtk_gesture_ungroup GtkGesture* gesture")
+(CFNC-3.14 "GList* gtk_gesture_get_group GtkGesture* gesture")
+(CFNC-3.14 "gboolean gtk_gesture_is_grouped_with GtkGesture* gesture GtkGesture* other")
+(CFNC-3.14 "GtkGesture* gtk_gesture_drag_new GtkWidget* widget")
+(CFNC-3.14 "gboolean gtk_gesture_drag_get_start_point GtkGestureDrag* gesture gdouble* [x] gdouble* [y]")
+(CFNC-3.14 "gboolean gtk_gesture_drag_get_offset GtkGestureDrag* gesture gdouble* [x] gdouble* [y]")
+(CFNC-3.14 "GtkGesture* gtk_gesture_long_press_new GtkWidget* widget")
+(CFNC-3.14 "GtkGesture* gtk_gesture_pan_new GtkWidget* widget GtkOrientation orientation")
+(CFNC-3.14 "GtkOrientation gtk_gesture_pan_get_orientation GtkGesturePan* gesture")
+(CFNC-3.14 "void gtk_gesture_pan_set_orientation GtkGesturePan* gesture GtkOrientation orientation")
+(CFNC-3.14 "GtkGesture* gtk_gesture_multi_press_new GtkWidget* widget")
+(CFNC-3.14 "void gtk_gesture_multi_press_set_area GtkGestureMultiPress* gesture GdkRectangle* rect")
+(CFNC-3.14 "gboolean gtk_gesture_multi_press_get_area GtkGestureMultiPress* gesture GdkRectangle* rect")
+(CFNC-3.14 "GtkGesture* gtk_gesture_rotate_new GtkWidget* widget")
+(CFNC-3.14 "gdouble gtk_gesture_rotate_get_angle_delta GtkGestureRotate* gesture")
+(CFNC-3.14 "gboolean gtk_gesture_single_get_touch_only GtkGestureSingle* gesture")
+(CFNC-3.14 "void gtk_gesture_single_set_touch_only GtkGestureSingle* gesture gboolean touch_only")
+(CFNC-3.14 "gboolean gtk_gesture_single_get_exclusive GtkGestureSingle* gesture")
+(CFNC-3.14 "void gtk_gesture_single_set_exclusive GtkGestureSingle* gesture gboolean exclusive")
+(CFNC-3.14 "guint gtk_gesture_single_get_button GtkGestureSingle* gesture")
+(CFNC-3.14 "void gtk_gesture_single_set_button GtkGestureSingle* gesture guint button")
+(CFNC-3.14 "guint gtk_gesture_single_get_current_button GtkGestureSingle* gesture")
+(CFNC-3.14 "GdkEventSequence* gtk_gesture_single_get_current_sequence GtkGestureSingle* gesture")
+(CFNC-3.14 "GtkGesture* gtk_gesture_swipe_new GtkWidget* widget")
+(CFNC-3.14 "gboolean gtk_gesture_swipe_get_velocity GtkGestureSwipe* gesture gdouble* [velocity_x] gdouble* [velocity_y]")
+(CFNC-3.14 "GtkGesture* gtk_gesture_zoom_new GtkWidget* widget")
+(CFNC-3.14 "gdouble gtk_gesture_zoom_get_scale_delta GtkGestureZoom* gesture")
+
+(CCAST-3.14 "GTK_EVENT_CONTROLLER" "GtkEventController*")
+(CCHK-3.14 "GTK_IS_EVENT_CONTROLLER" "GtkEventController*")
+(CFNC-3.14 "GtkWidget* gtk_event_controller_get_widget GtkEventController* controller")
+(CFNC-3.14 "gboolean gtk_event_controller_handle_event GtkEventController* controller GdkEvent* event")
+(CFNC-3.14 "void gtk_event_controller_reset GtkEventController* controller")
+(CFNC-3.14 "GtkPropagationPhase gtk_event_controller_get_propagation_phase GtkEventController* controller")
+(CFNC-3.14 "void gtk_event_controller_set_propagation_phase GtkEventController* controller GtkPropagationPhase phase")
+
+;;; 3.13.3: nothing new
+
+;;; 3.13.4:
+(CFNC-3.14 "void gtk_icon_theme_add_resource_path GtkIconTheme* icon_theme gchar* path" 'const)
+(CFNC-3.14 "void gtk_list_box_row_set_activatable GtkListBoxRow* row gboolean activatable")
+(CFNC-3.14 "gboolean gtk_list_box_row_get_activatable GtkListBoxRow* row")
+
+;;; 3.13.5:
+(CFNC-3.14 "void gtk_list_box_row_set_selectable GtkListBoxRow* row gboolean selectable")
+(CFNC-3.14 "gboolean gtk_list_box_row_get_selectable GtkListBoxRow* row")
+(CFNC-3.14 "GtkStateFlags gtk_widget_path_iter_get_state GtkWidgetPath* path gint pos" 'const)
+(CFNC-3.14 "void gtk_widget_path_iter_set_state GtkWidgetPath* path gint pos GtkStateFlags state")
+
+;;; 3.13.6:
+(CINT-3.14 "GTK_TEXT_VIEW_LAYER_BELOW" "GtkTextViewLayer")
+(CINT-3.14 "GTK_TEXT_VIEW_LAYER_ABOVE" "GtkTextViewLayer")
+
+;;; 3.13.7: nothing new (GtkStatusIcon deprecated)
+;;; 3.13.8: nothing new
+;;; 3.13.9: nothing new, but GDK_KEY changes
+;;; 3.14.0: nothing new
+;;; 3.14.1: nothing new
+;;; 3.14.2: nothing new
+;;; 3.14.3: nothing new
+;;; 3.14.4: nothing new
+
+;;; 3.15.0:
+
+(CINT-3.16 "GTK_POLICY_EXTERNAL" "GtkPolicyType")
+;(CINT-3.16 "GDK_GL_PROFILE_DEFAULT" "GdkGLProfile")
+;(CINT-3.16 "GDK_GL_PROFILE_LEGACY" "GdkGLProfile")
+;(CINT-3.16 "GDK_GL_PROFILE_3_2_CORE" "GdkGLProfile")
+;(CINT-3.16 "GDK_GL_ERROR_NOT_AVAILABLE" "GdkGLError")
+;(CINT-3.16 "GDK_GL_ERROR_UNSUPPORTED_FORMAT" "GdkGLError")
+;(CINT-3.16 "GDK_GL_ERROR_UNSUPPORTED_PROFIL" "GdkGLError")
+
+(CCAST-3.16 "GTK_GL_AREA(object)" "GtkGLArea*")
+(CCAST-3.16 "GDK_GL_CONTEXT(object)" "GdkGLContext*")
+
+(CCHK-3.16 "GTK_IS_GL_AREA(object)" "GtkGLArea*")
+(CCHK-3.16 "GDK_IS_GL_CONTEXT(object)" "GdkGLContext*")
+
+(CFNC-3.16 "void gdk_cairo_draw_from_gl cairo_t* cr GdkWindow* window int source int source_type int buffer_scale int x int y int width int height")
+(CFNC-3.16 "void gdk_window_mark_paint_from_clip GdkWindow* window cairo_t* cr")
+;(CFNC-3.16 "GdkGLContext* gdk_window_create_gl_context GdkWindow* window GdkGLProfile profile GError** error")
+;(CFNC-3.16 "void gtk_css_provider_load_from_resource GtkCssProvider* css_provider gchar* resource_path" 'const)
+(CFNC-3.16 "void gtk_label_set_xalign GtkLabel* label gfloat xalign")
+(CFNC-3.16 "gfloat gtk_label_get_xalign GtkLabel* label")
+(CFNC-3.16 "void gtk_label_set_yalign GtkLabel* label gfloat xalign")
+(CFNC-3.16 "gfloat gtk_label_get_yalign GtkLabel* label")
+(CFNC-3.16 "void gtk_paned_set_wide_handle GtkPaned* paned gboolean wide")
+(CFNC-3.16 "gboolean gtk_paned_get_wide_handle GtkPaned* paned")
+(CFNC-3.16 "void gtk_scrolled_window_set_overlay_scrolling GtkScrolledWindow* scrolled_window gboolean overlay_scrolling")
+(CFNC-3.16 "gboolean gtk_scrolled_window_get_overlay_scrolling GtkScrolledWindow* scrolled_window")
+(CFNC-3.16 "void gtk_text_view_set_monospace GtkTextView* text_view gboolean monospace")
+(CFNC-3.16 "gboolean gtk_text_view_get_monospace GtkTextView* text_view")
+(CFNC-3.16 "GtkWidget* gtk_window_get_titlebar GtkWindow* window")
+(CFNC-3.16 "GtkWidget* gtk_gl_area_new void")
+(CFNC-3.16 "gboolean gtk_gl_area_get_has_alpha GtkGLArea* area")
+(CFNC-3.16 "void gtk_gl_area_set_has_alpha GtkGLArea* area gboolean has_alpha")
+(CFNC-3.16 "gboolean gtk_gl_area_get_has_depth_buffer GtkGLArea* area")
+(CFNC-3.16 "void gtk_gl_area_set_has_depth_buffer GtkGLArea* area gboolean has_depth_buffer")
+(CFNC-3.16 "GdkGLContext* gtk_gl_area_get_context GtkGLArea* area")
+(CFNC-3.16 "void gtk_gl_area_make_current GtkGLArea* area")
+(CFNC-3.16 "void gtk_render_check GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
+(CFNC-3.16 "void gtk_render_option GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
+(CFNC-3.16 "void gtk_render_arrow GtkStyleContext* context cairo_t* cr gdouble angle gdouble x gdouble y gdouble size")
+(CFNC-3.16 "void gtk_render_background GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
+(CFNC-3.16 "void gtk_render_frame GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
+(CFNC-3.16 "void gtk_render_expander GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
+(CFNC-3.16 "void gtk_render_focus GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
+(CFNC-3.16 "void gtk_render_layout GtkStyleContext* context cairo_t* cr gdouble x gdouble y PangoLayout* layout")
+(CFNC-3.16 "void gtk_render_line GtkStyleContext* context cairo_t* cr gdouble x0 gdouble y0 gdouble x1 gdouble y1")
+(CFNC-3.16 "void gtk_render_slider GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height GtkOrientation orientation")
+(CFNC-3.16 "void gtk_render_frame_gap GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height GtkPositionType gap_side gdouble xy0_gap gdouble xy1_gap")
+(CFNC-3.16 "void gtk_render_extension GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height GtkPositionType gap_side")
+(CFNC-3.16 "void gtk_render_handle GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
+(CFNC-3.16 "void gtk_render_activity GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
+(CFNC-3.16 "void gtk_render_icon GtkStyleContext* context cairo_t* cr GdkPixbuf* pixbuf gdouble x gdouble y")
+(CFNC-3.16 "void gtk_render_icon_surface GtkStyleContext* context cairo_t* cr cairo_surface_t* surface gdouble x gdouble y")
+;;; 3.15.2 (CFNC-3.16 "GdkVisual* gdk_gl_context_get_visual GdkGLContext* context")
+(CFNC-3.16 "GdkWindow* gdk_gl_context_get_window GdkGLContext* context")
+(CFNC-3.16 "void gdk_gl_context_make_current GdkGLContext* context")
+(CFNC-3.16 "GdkGLContext* gdk_gl_context_get_current void")
+(CFNC-3.16 "void gdk_gl_context_clear_current void")
+
+
+;;; 3.15.1:
+
+(CFNC-3.16 "void gtk_stack_set_hhomogeneous GtkStack* stack gboolean hhomogeneous")
+(CFNC-3.16 "gboolean gtk_stack_get_hhomogeneous GtkStack* stack")
+(CFNC-3.16 "void gtk_stack_set_vhomogeneous GtkStack* stack gboolean vhomogeneous")
+(CFNC-3.16 "gboolean gtk_stack_get_vhomogeneous GtkStack* stack")
+
+;;; pango 1.36.8
+(CINT-3.16 "PANGO_WEIGHT_SEMILIGHT" "PangoWeight")
#|
-(CCAST-300 "GTK_CSS_PROVIDER" "GtkCssProvider*")
-(CCHK-300 "GTK_IS_CSS_PROVIDER" "GtkCssProvider*")
-(CINT-300 "GTK_CSS_PROVIDER_ERROR_FAILED" "GtkCssProviderError")
-(CFNC-300 "GtkCssProvider* gtk_css_provider_new void")
-(CFNC-300 "gboolean gtk_css_provider_load_from_data GtkCssProvider* css_provider gchar* data gssize length GError** [error]" 'const)
-(CFNC-300 "gboolean gtk_css_provider_load_from_file GtkCssProvider* css_provider GFile* file GError** [error]")
-(CFNC-300 "gboolean gtk_css_provider_load_from_path GtkCssProvider* css_provider gchar* path GError** [error]" 'const)
-(CFNC-300 "GtkCssProvider* gtk_css_provider_get_default void")
-(CFNC-300 "GtkCssProvider* gtk_css_provider_get_named gchar* name gchar* variant" 'const)
-
-(CFNC-300 "GtkWidgetPath* gtk_container_get_path_for_child GtkContainer* container GtkWidget* child")
-(CFNC-300 "GtkWidgetPath* gtk_widget_get_path GtkWidget* widget")
-(CFNC-300 "void gtk_widget_path GtkWidget* widget guint* path_length gchar** [path] gchar** [path_reversed]")
-(CFNC-300 "void gtk_widget_class_path GtkWidget* widget guint* path_length gchar** [path] gchar** [path_reversed]")
-
-(CCAST-300 "GTK_STYLE_PROVIDER" "GtkStyleProvider*")
-(CCHK-300 "GTK_IS_STYLE_PROVIDER" "GtkStyleProvider*")
-(CINT-300 "GTK_STYLE_PROVIDER_PRIORITY_FALLBACK")
-(CINT-300 "GTK_STYLE_PROVIDER_PRIORITY_THEME")
-(CINT-300 "GTK_STYLE_PROVIDER_PRIORITY_SETTINGS")
-(CINT-300 "GTK_STYLE_PROVIDER_PRIORITY_APPLICATION")
-(CINT-300 "GTK_STYLE_PROVIDER_PRIORITY_USER")
-(CFNC-300 "GtkStyleProperties* gtk_style_provider_get_style GtkStyleProvider* provider GtkWidgetPath* path")
-(CFNC-300 "gboolean gtk_style_provider_get_style_property GtkStyleProvider* provider GtkWidgetPath* path GtkStateFlags state GParamSpec* pspec GValue* [value]")
-(CFNC-300 "GtkIconFactory* gtk_style_provider_get_icon_factory GtkStyleProvider* provider GtkWidgetPath* path")
-
-(CSTR-300 "GTK_STYLE_PROPERTY_BACKGROUND_COLOR")
-(CSTR-300 "GTK_STYLE_PROPERTY_COLOR")
-(CSTR-300 "GTK_STYLE_PROPERTY_FONT")
-(CSTR-300 "GTK_STYLE_PROPERTY_MARGIN")
-(CSTR-300 "GTK_STYLE_PROPERTY_PADDING")
-(CSTR-300 "GTK_STYLE_PROPERTY_BORDER_WIDTH")
-(CSTR-300 "GTK_STYLE_PROPERTY_BORDER_RADIUS")
-(CSTR-300 "GTK_STYLE_PROPERTY_BORDER_STYLE")
-(CSTR-300 "GTK_STYLE_PROPERTY_BORDER_COLOR")
-(CSTR-300 "GTK_STYLE_PROPERTY_BACKGROUND_IMAGE")
-(CSTR-300 "GTK_STYLE_CLASS_CELL")
-(CSTR-300 "GTK_STYLE_CLASS_ENTRY")
-(CSTR-300 "GTK_STYLE_CLASS_BUTTON")
-(CSTR-300 "GTK_STYLE_CLASS_CALENDAR")
-(CSTR-300 "GTK_STYLE_CLASS_SLIDER")
-(CSTR-300 "GTK_STYLE_CLASS_BACKGROUND")
-(CSTR-300 "GTK_STYLE_CLASS_RUBBERBAND")
-(CSTR-300 "GTK_STYLE_CLASS_TOOLTIP")
-(CSTR-300 "GTK_STYLE_CLASS_MENU")
-(CSTR-300 "GTK_STYLE_CLASS_MENUBAR")
-(CSTR-300 "GTK_STYLE_CLASS_MENUITEM")
-(CSTR-300 "GTK_STYLE_CLASS_TOOLBAR")
-(CSTR-300 "GTK_STYLE_CLASS_RADIO")
-(CSTR-300 "GTK_STYLE_CLASS_CHECK")
-(CSTR-300 "GTK_STYLE_CLASS_DEFAULT")
-(CSTR-300 "GTK_STYLE_CLASS_TROUGH")
-(CSTR-300 "GTK_STYLE_CLASS_SCROLLBAR")
-(CSTR-300 "GTK_STYLE_CLASS_HEADER")
-(CSTR-300 "GTK_STYLE_CLASS_ACCELERATOR")
-(CSTR-300 "GTK_STYLE_CLASS_GRIP")
-(CSTR-300 "GTK_STYLE_CLASS_DOCK")
-(CSTR-300 "GTK_STYLE_CLASS_PROGRESSBAR")
-(CSTR-300 "GTK_STYLE_CLASS_SPINNER")
-(CSTR-300 "GTK_STYLE_REGION_ROW")
-(CSTR-300 "GTK_STYLE_REGION_COLUMN")
-(CSTR-300 "GTK_STYLE_REGION_COLUMN_HEADER")
-(CSTR-300 "GTK_STYLE_REGION_TAB")
-(CSTR-300 "GTK_STYLE_CLASS_SCALE")
-(CSTR-300 "GTK_STYLE_CLASS_MARK")
-(CSTR-300 "GTK_STYLE_CLASS_EXPANDER")
-(CSTR-300 "GTK_STYLE_CLASS_SPINBUTTON")
-(CSTR-300 "GTK_STYLE_CLASS_NOTEBOOK")
-(CSTR-300 "GTK_STYLE_CLASS_VIEW")
-(CSTR-300 "GTK_STYLE_CLASS_INFO")
-(CSTR-300 "GTK_STYLE_CLASS_WARNING")
-(CSTR-300 "GTK_STYLE_CLASS_QUESTION")
-(CSTR-300 "GTK_STYLE_CLASS_ERROR")
-
-(CINT-300 "GTK_REGION_EVEN" "GtkRegionFlags")
-(CINT-300 "GTK_REGION_ODD" "GtkRegionFlags")
-(CINT-300 "GTK_REGION_FIRST" "GtkRegionFlags")
-(CINT-300 "GTK_REGION_LAST" "GtkRegionFlags")
-(CINT-300 "GTK_REGION_SORTED" "GtkRegionFlags")
-
-(CINT-300 "GTK_JUNCTION_NONE" "GtkJunctionSides")
-(CINT-300 "GTK_JUNCTION_CORNER_TOPLEFT" "GtkJunctionSides")
-(CINT-300 "GTK_JUNCTION_CORNER_TOPRIGHT" "GtkJunctionSides")
-(CINT-300 "GTK_JUNCTION_CORNER_BOTTOMLEFT" "GtkJunctionSides")
-(CINT-300 "GTK_JUNCTION_CORNER_BOTTOMRIGHT" "GtkJunctionSides")
-(CINT-300 "GTK_JUNCTION_TOP" "GtkJunctionSides")
-(CINT-300 "GTK_JUNCTION_BOTTOM" "GtkJunctionSides")
-(CINT-300 "GTK_JUNCTION_LEFT" "GtkJunctionSides")
-(CINT-300 "GTK_JUNCTION_RIGHT" "GtkJunctionSides")
-
-(CINT-300 "GTK_BORDER_STYLE_NONE" "GtkBorderStyle")
-(CINT-300 "GTK_BORDER_STYLE_SOLID" "GtkBorderStyle")
-(CINT-300 "GTK_BORDER_STYLE_INSET" "GtkBorderStyle")
-(CINT-300 "GTK_BORDER_STYLE_OUTSET" "GtkBorderStyle")
-
-(CCAST-300 "GTK_MODIFIER_STYLE" "GtkModifierStyle*")
-(CCHK-300 "GTK_IS_MODIFIER_STYLE" "GtkModifierStyle*")
-
-(CCAST-300 "GTK_STYLE_CONTEXT" "GtkStyleContext*")
-(CCHK-300 "GTK_IS_STYLE_CONTEXT" "GtkStyleContext*")
-
-(CCAST-300 "GTK_STYLE_PROPERTIES" "GtkStyleProperties*")
-(CCHK-300 "GTK_IS_STYLE_PROPERTIES" "GtkStyleProperties*")
-
-(CFNC-300 "GtkGradient* gtk_gradient_new_linear gdouble x0 gdouble y0 gdouble x1 gdouble y1")
-(CFNC-300 "GtkGradient* gtk_gradient_new_radial gdouble x0 gdouble y0 gdouble radius0 gdouble x1 gdouble y1 gdouble radius1")
-(CFNC-300 "void gtk_gradient_add_color_stop GtkGradient* gradient gdouble offset GtkSymbolicColor* color")
-(CFNC-300 "GtkGradient* gtk_gradient_ref GtkGradient* gradient")
-(CFNC-300 "void gtk_gradient_unref GtkGradient* gradient")
-(CFNC-300 "gboolean gtk_gradient_resolve GtkGradient* gradient GtkStyleProperties* props cairo_pattern_t** resolved_gradient")
-;;; 3.0.0 (CFNC-300 "void gtk_modifier_style_set_background_color GtkModifierStyle* style GtkStateFlags state GdkRGBA* color" 'const)
-;;; 3.0.0 (CFNC-300 "void gtk_modifier_style_set_color GtkModifierStyle* style GtkStateFlags state GdkRGBA* color" 'const)
-;;; 3.0.0 (CFNC-300 "void gtk_modifier_style_set_font GtkModifierStyle* style PangoFontDescription* font_desc" 'const)
-;;; 3.0.0 (CFNC-300 "void gtk_modifier_style_map_color GtkModifierStyle* style gchar* name GdkRGBA* color" 'const)
-;;; 3.0.0 (CFNC-300 "void gtk_modifier_style_set_color_property GtkModifierStyle* style GType widget_type gchar* prop_name GdkRGBA* color" 'const)
-(CFNC-300 "GtkStyleContext* gtk_style_context_new void")
-(CFNC-300 "void gtk_style_context_add_provider_for_screen GdkScreen* screen GtkStyleProvider* provider guint priority")
-(CFNC-300 "void gtk_style_context_remove_provider_for_screen GdkScreen* screen GtkStyleProvider* provider")
-(CFNC-300 "void gtk_style_context_add_provider GtkStyleContext* context GtkStyleProvider* provider guint priority")
-(CFNC-300 "void gtk_style_context_remove_provider GtkStyleContext* context GtkStyleProvider* provider")
-(CFNC-300 "void gtk_style_context_save GtkStyleContext* context")
-(CFNC-300 "void gtk_style_context_restore GtkStyleContext* context")
-(CFNC-300 "void gtk_style_context_get_property GtkStyleContext* context gchar* property GtkStateFlags state GValue* value" 'const)
-;(CFNC-300 "void gtk_style_context_get_valist GtkStyleContext* context GtkStateFlags state va_list args")
-;(CFNC-300 "void gtk_style_context_get GtkStyleContext* context GtkStateFlags state ...")
-(CFNC-300 "void gtk_style_context_set_state GtkStyleContext* context GtkStateFlags flags")
-(CFNC-300 "GtkStateFlags gtk_style_context_get_state GtkStyleContext* context")
-(CFNC-300 "gboolean gtk_style_context_state_is_running GtkStyleContext* context GtkStateType state gdouble* progress")
-(CFNC-300 "void gtk_style_context_set_path GtkStyleContext* context GtkWidgetPath* path")
-(CFNC-300 "GtkWidgetPath* gtk_style_context_get_path GtkStyleContext* context" 'const)
-(CFNC-300 "GList* gtk_style_context_list_classes GtkStyleContext* context")
-(CFNC-300 "void gtk_style_context_add_class GtkStyleContext* context gchar* class_name" 'const)
-(CFNC-300 "void gtk_style_context_remove_class GtkStyleContext* context gchar* class_name" 'const)
-(CFNC-300 "gboolean gtk_style_context_has_class GtkStyleContext* context gchar* class_name" 'const)
-(CFNC-300 "GList* gtk_style_context_list_regions GtkStyleContext* context")
-(CFNC-300 "void gtk_style_context_add_region GtkStyleContext* context gchar* region_name GtkRegionFlags flags" 'const)
-(CFNC-300 "void gtk_style_context_remove_region GtkStyleContext* context gchar* region_name" 'const)
-(CFNC-300 "gboolean gtk_style_context_has_region GtkStyleContext* context gchar* region_name GtkRegionFlags* flags_return" 'const)
-(CFNC-300 "void gtk_style_context_get_style_property GtkStyleContext* context gchar* property_name GValue* value" 'const)
-;(CFNC-300 "void gtk_style_context_get_style_valist GtkStyleContext* context va_list args")
-;(CFNC-300 "void gtk_style_context_get_style GtkStyleContext* context ...")
-(CFNC-300 "GtkIconSet* gtk_style_context_lookup_icon_set GtkStyleContext* context gchar* stock_id" 'const)
-(CFNC-300 "gtk_icon_set_render_icon_pixbuf GtkIconSet* icon_set GtkStyleContext* context GtkIconSize size")
-(CFNC-300 "void gtk_style_context_set_screen GtkStyleContext* context GdkScreen* screen")
-(CFNC-300 "GdkScreen* gtk_style_context_get_screen GtkStyleContext* context")
-(CFNC-300 "void gtk_style_context_set_direction GtkStyleContext* context GtkTextDirection direction")
-(CFNC-300 "GtkTextDirection gtk_style_context_get_direction GtkStyleContext* context")
-(CFNC-300 "void gtk_style_context_set_junction_sides GtkStyleContext* context GtkJunctionSides sides")
-(CFNC-300 "GtkJunctionSides gtk_style_context_get_junction_sides GtkStyleContext* context")
-(CFNC-300 "gboolean gtk_style_context_lookup_color GtkStyleContext* context gchar* color_name GdkRGBA* color" 'const)
-(CFNC-300 "void gtk_style_context_notify_state_change GtkStyleContext* context GdkWindow* window gpointer region_id GtkStateType state gboolean state_value")
-(CFNC-300 "void gtk_style_context_push_animatable_region GtkStyleContext* context gpointer region_id")
-(CFNC-300 "void gtk_style_context_pop_animatable_region GtkStyleContext* context")
-(CFNC-300 "void gtk_style_context_get_color GtkStyleContext* context GtkStateFlags state GdkRGBA* color")
-(CFNC-300 "void gtk_style_context_get_background_color GtkStyleContext* context GtkStateFlags state GdkRGBA* color")
-(CFNC-300 "void gtk_style_context_get_border_color GtkStyleContext* context GtkStateFlags state GdkRGBA* color")
-(CFNC-300 "void gtk_style_context_get_border GtkStyleContext* context GtkStateFlags state GtkBorder* border")
-(CFNC-300 "void gtk_style_context_get_padding GtkStyleContext* context GtkStateFlags state GtkBorder* padding")
-(CFNC-300 "void gtk_style_context_get_margin GtkStyleContext* context GtkStateFlags state GtkBorder* margin")
-(CFNC-300 "void gtk_style_context_invalidate GtkStyleContext* context")
-(CFNC-300 "void gtk_style_context_reset_widgets GdkScreen* screen")
-(CFNC-300 "void gtk_style_context_set_background GtkStyleContext* context GdkWindow* window")
-(CFNC-300 "void gtk_render_check GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
-(CFNC-300 "void gtk_render_option GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
-(CFNC-300 "void gtk_render_arrow GtkStyleContext* context cairo_t* cr gdouble angle gdouble x gdouble y gdouble size")
-(CFNC-300 "void gtk_render_background GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
-(CFNC-300 "void gtk_render_frame GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
-(CFNC-300 "void gtk_render_expander GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
-(CFNC-300 "void gtk_render_focus GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
-(CFNC-300 "void gtk_render_layout GtkStyleContext* context cairo_t* cr gdouble x gdouble y PangoLayout* layout")
-(CFNC-300 "void gtk_render_line GtkStyleContext* context cairo_t* cr gdouble x0 gdouble y0 gdouble x1 gdouble y1")
-(CFNC-300 "void gtk_render_slider GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height GtkOrientation orientation")
-(CFNC-300 "void gtk_render_frame_gap GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height GtkPositionType gap_side gdouble xy0_gap gdouble xy1_gap")
-(CFNC-300 "void gtk_render_extension GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height GtkPositionType gap_side")
-(CFNC-300 "void gtk_render_handle GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
-(CFNC-300 "void gtk_render_activity GtkStyleContext* context cairo_t* cr gdouble x gdouble y gdouble width gdouble height")
-(CFNC-300 "GdkPixbuf* gtk_render_icon_pixbuf GtkStyleContext* context GtkIconSource* source GtkIconSize size" 'const)
-
-(CFNC-300 "void gtk_style_context_cancel_animations GtkStyleContext* context gpointer region_id")
-(CFNC-300 "void gtk_style_context_scroll_animations GtkStyleContext* context GdkWindow* window gint dx gint dy")
-
-(CFNC-300 "void gtk_style_properties_register_property GtkStylePropertyParser parse_func GParamSpec* pspec")
-(CFNC-300 "gboolean gtk_style_properties_lookup_property gchar* property_name GtkStylePropertyParser* parse_func GParamSpec** pspec" 'const)
-(CFNC-300 "GtkStyleProperties* gtk_style_properties_new void")
-(CFNC-300 "void gtk_style_properties_map_color GtkStyleProperties* props gchar* name GtkSymbolicColor* color" 'const)
-(CFNC-300 "GtkSymbolicColor* gtk_style_properties_lookup_color GtkStyleProperties* props gchar* name" 'const)
-(CFNC-300 "void gtk_style_properties_set_property GtkStyleProperties* props gchar* property GtkStateFlags state GValue* value" 'const)
-;(CFNC-300 "void gtk_style_properties_set_valist GtkStyleProperties* props GtkStateFlags state va_list args")void gtk_style_properties_set GtkStyleProperties* props GtkStateFlags state ...)
-(CFNC-300 "gboolean gtk_style_properties_get_property GtkStyleProperties* props gchar* property GtkStateFlags state GValue* value" 'const)
-;(CFNC-300 "void gtk_style_properties_get_valist GtkStyleProperties* props GtkStateFlags state va_list args")
-;(CFNC-300 "void gtk_style_properties_get GtkStyleProperties* props GtkStateFlags state ...")
-(CFNC-300 "void gtk_style_properties_unset_property GtkStyleProperties* props gchar* property GtkStateFlags state" 'const)
-(CFNC-300 "void gtk_style_properties_clear GtkStyleProperties* props")
-(CFNC-300 "void gtk_style_properties_merge GtkStyleProperties* props GtkStyleProperties* props_to_merge gboolean replace" 'const)
-(CFNC-300 "GtkSymbolicColor* gtk_symbolic_color_new_literal GdkRGBA* color" 'const)
-(CFNC-300 "GtkSymbolicColor* gtk_symbolic_color_new_name gchar* name" 'const)
-(CFNC-300 "GtkSymbolicColor* gtk_symbolic_color_new_shade GtkSymbolicColor* color gdouble factor")
-(CFNC-300 "GtkSymbolicColor* gtk_symbolic_color_new_alpha GtkSymbolicColor* color gdouble factor")
-(CFNC-300 "GtkSymbolicColor* gtk_symbolic_color_new_mix GtkSymbolicColor* color1 GtkSymbolicColor* color2 gdouble factor")
-(CFNC-300 "GtkSymbolicColor* gtk_symbolic_color_ref GtkSymbolicColor* color")
-(CFNC-300 "void gtk_symbolic_color_unref GtkSymbolicColor* color")
-(CFNC-300 "gboolean gtk_symbolic_color_resolve GtkSymbolicColor* color GtkStyleProperties* props GdkRGBA* resolved_color")
-(CFNC-300 "void gtk_widget_set_state_flags GtkWidget* widget GtkStateFlags flags gboolean clear")
-(CFNC-300 "void gtk_widget_unset_state_flags GtkWidget* widget GtkStateFlags flags")
-(CFNC-300 "GtkStateFlags gtk_widget_get_state_flags GtkWidget* widget")
-(CFNC-300 "void gtk_widget_override_color GtkWidget* widget GtkStateFlags state GdkRGBA* color" 'const)
-(CFNC-300 "void gtk_widget_override_background_color GtkWidget* widget GtkStateFlags state GdkRGBA* color" 'const)
-(CFNC-300 "void gtk_widget_override_font GtkWidget* widget PangoFontDescription* font_desc" 'const)
-(CFNC-300 "void gtk_widget_override_symbolic_color GtkWidget* widget gchar* name GdkRGBA* color" 'const)
-(CFNC-300 "void gtk_widget_override_cursor GtkWidget* widget GdkRGBA* cursor GdkRGBA* secondary_cursor" 'const)
-(CFNC-300 "GtkStyleContext* gtk_widget_get_style_context GtkWidget* widget")
-
-
-;;; 2.91.7 -- is any of this useful? -- docs say they're for people writing their own widgets
-
-(CCAST-300 "GDK_CURSOR" "GdkCursor*")
-(CCHK-300 "GDK_IS_CURSOR "GdkCursor*")
-
-(CCAST-300 "GTK_CELL_AREA" "GtkCellArea*")
-(CCHK-300 "GTK_IS_CELL_AREA" "GtkCellArea*")
-;;; typedef gboolean* GtkCellCallback) GtkCellRenderer* renderer gpointer data
-
-(CCAST-300 "GTK_CELL_AREA_BOX" "GtkCellAreaBox*")
-(CCHK-300 "GTK_IS_CELL_AREA_BOX" "GtkCellAreaBox*")
-
-(CCAST-300 "GTK_CELL_AREA_BOX_CONTEXT" "GtkCellAreaBoxContext*")
-(CCHK-300 "GTK_IS_CELL_AREA_BOX_CONTEXT" "GtkCellAreaBoxContext*")
-
-(CCAST-300 "GTK_CELL_AREA_CONTEXT" "GtkCellAreaContext*")
-(CCHK-300 "GTK_IS_CELL_AREA_CONTEXT" "GtkCellAreaContext*")
-
-(CFNC-300 "GtkWidget* gtk_cell_view_new_with_context GtkCellArea* area GtkCellAreaContext* context")
-
-(CFNC-300 "void gtk_cell_area_add GtkCellArea* area GtkCellRenderer* renderer")
-(CFNC-300 "void gtk_cell_area_remove GtkCellArea* area GtkCellRenderer* renderer")
-(CFNC-300 "gboolean gtk_cell_area_has_renderer GtkCellArea* area GtkCellRenderer* renderer")
-(CFNC-300 "void gtk_cell_area_foreach GtkCellArea* area GtkCellCallback callback gpointer callback_data")
-(CFNC-300 "void gtk_cell_area_foreach_alloc GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget GdkRectangle* cell_area GdkRectangle* background_area GtkCellAllocCallback callback gpointer callback_data" 'const)
-(CFNC-300 "gint gtk_cell_area_event GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget GdkEvent* event GdkRectangle* cell_area GtkCellRendererState flags" 'const)
-(CFNC-300 "void gtk_cell_area_render GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget cairo_t* cr GdkRectangle* background_area GdkRectangle* cell_area GtkCellRendererState flags gboolean paint_focus" 'const)
-(CFNC-300 "void gtk_cell_area_set_style_detail GtkCellArea* area gchar* detail" 'const)
-(CFNC-300 "gchar* gtk_cell_area_get_style_detail GtkCellArea* area" 'const)
-(CFNC-300 "void gtk_cell_area_get_cell_allocation GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget GtkCellRenderer* renderer GdkRectangle* cell_area GdkRectangle* allocation" 'const)
-(CFNC-300 "GtkCellRenderer* gtk_cell_area_get_cell_at_position GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget GdkRectangle* cell_area gint x gint y GdkRectangle* alloc_area" 'const)
-(CFNC-300 "GtkCellAreaContext* gtk_cell_area_create_context GtkCellArea* area")
-(CFNC-300 "GtkCellAreaContext* gtk_cell_area_copy_context GtkCellArea* area GtkCellAreaContext* context")
-(CFNC-300 "GtkSizeRequestMode gtk_cell_area_get_request_mode GtkCellArea* area")
-(CFNC-300 "void gtk_cell_area_get_preferred_width GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget gint* [minimum_width] gint* [natural_width]")
-(CFNC-300 "void gtk_cell_area_get_preferred_height_for_width GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_cell_area_get_preferred_height GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_cell_area_get_preferred_width_for_height GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget gint height gint* [minimum_width] gint* [natural_width]")
-(CFNC-300 "gchar* gtk_cell_area_get_current_path_string GtkCellArea* area" 'const)
-(CFNC-300 "void gtk_cell_area_apply_attributes GtkCellArea* area GtkTreeModel* tree_model GtkTreeIter* iter gboolean is_expander gboolean is_expanded")
-(CFNC-300 "void gtk_cell_area_attribute_connect GtkCellArea* area GtkCellRenderer* renderer gchar* attribute gint column" 'const)
-(CFNC-300 "void gtk_cell_area_attribute_disconnect GtkCellArea* area GtkCellRenderer* renderer gchar* attribute" 'const)
-(CFNC-300 "void gtk_cell_area_class_install_cell_property GtkCellAreaClass* aclass guint property_id GParamSpec* pspec")
-(CFNC-300 "GParamSpec* gtk_cell_area_class_find_cell_property GtkCellAreaClass* aclass gchar* property_name" 'const)
-(CFNC-300 "GParamSpec** gtk_cell_area_class_list_cell_properties GtkCellAreaClass* aclass guint* n_properties")
-;(CFNC-300 "void gtk_cell_area_add_with_properties GtkCellArea* area GtkCellRenderer* renderer gchar* first_prop_name ..." 'const) G_GNUC_NULL_TERMINATED
-;(CFNC-300 "void gtk_cell_area_cell_set GtkCellArea* area GtkCellRenderer* renderer gchar* first_prop_name ..." 'const) G_GNUC_NULL_TERMINATED
-;(CFNC-300 "void gtk_cell_area_cell_get GtkCellArea* area GtkCellRenderer* renderer gchar* first_prop_name ..." 'const) G_GNUC_NULL_TERMINATED
-;(CFNC-300 "void gtk_cell_area_cell_set_valist GtkCellArea* area GtkCellRenderer* renderer gchar* first_property_name va_list var_args" 'const)
-;(CFNC-300 "void gtk_cell_area_cell_get_valist GtkCellArea* area GtkCellRenderer* renderer gchar* first_property_name va_list var_args" 'const)
-(CFNC-300 "void gtk_cell_area_cell_set_property GtkCellArea* area GtkCellRenderer* renderer gchar* property_name GValue* value" 'const)
-(CFNC-300 "void gtk_cell_area_cell_get_property GtkCellArea* area GtkCellRenderer* renderer gchar* property_name GValue* value" 'const)
-(CFNC-300 "gboolean gtk_cell_area_is_activatable GtkCellArea* area")
-(CFNC-300 "gboolean gtk_cell_area_activate GtkCellArea* area GtkCellAreaContext* context GtkWidget* widget GdkRectangle* cell_area GtkCellRendererState flags gboolean edit_only" 'const)
-(CFNC-300 "gboolean gtk_cell_area_focus GtkCellArea* area GtkDirectionType direction")
-(CFNC-300 "void gtk_cell_area_set_focus_cell GtkCellArea* area GtkCellRenderer* renderer")
-(CFNC-300 "GtkCellRenderer* gtk_cell_area_get_focus_cell GtkCellArea* area")
-(CFNC-300 "void gtk_cell_area_add_focus_sibling GtkCellArea* area GtkCellRenderer* renderer GtkCellRenderer* sibling")
-(CFNC-300 "void gtk_cell_area_remove_focus_sibling GtkCellArea* area GtkCellRenderer* renderer GtkCellRenderer* sibling")
-(CFNC-300 "gboolean gtk_cell_area_is_focus_sibling GtkCellArea* area GtkCellRenderer* renderer GtkCellRenderer* sibling")
-(CFNC-300 "GList* gtk_cell_area_get_focus_siblings GtkCellArea* area GtkCellRenderer* renderer" 'const)
-(CFNC-300 "GtkCellRenderer* gtk_cell_area_get_focus_from_sibling GtkCellArea* area GtkCellRenderer* renderer")
-(CFNC-300 "GtkCellRenderer* gtk_cell_area_get_edited_cell GtkCellArea* area")
-(CFNC-300 "GtkCellEditable* gtk_cell_area_get_edit_widget GtkCellArea* area")
-(CFNC-300 "gboolean gtk_cell_area_activate_cell GtkCellArea* area GtkWidget* widget GtkCellRenderer* renderer GdkEvent* event GdkRectangle* cell_area GtkCellRendererState flags" 'const)
-(CFNC-300 "void gtk_cell_area_stop_editing GtkCellArea* area gboolean canceled")
-(CFNC-300 "void gtk_cell_area_inner_cell_area GtkCellArea* area GtkWidget* widget GdkRectangle* cell_area GdkRectangle* inner_area" 'const)
-(CFNC-300 "void gtk_cell_area_request_renderer GtkCellArea* area GtkCellRenderer* renderer GtkOrientation orientation GtkWidget* widget gint for_size gint* minimum_size gint* natural_size")
-(CFNC-300 "void _gtk_cell_area_set_cell_data_func_with_proxy GtkCellArea* area GtkCellRenderer* cell GFunc func gpointer func_data GDestroyNotify destroy gpointer proxy")
-(CFNC-300 "GtkCellArea* gtk_cell_area_box_new void")
-(CFNC-300 "void gtk_cell_area_box_pack_start GtkCellAreaBox* box GtkCellRenderer* renderer gboolean expand gboolean align gboolean fixed")
-(CFNC-300 "void gtk_cell_area_box_pack_end GtkCellAreaBox* box GtkCellRenderer* renderer gboolean expand gboolean align gboolean fixed")
-(CFNC-300 "gint gtk_cell_area_box_get_spacing GtkCellAreaBox* box")
-(CFNC-300 "void gtk_cell_area_box_set_spacing GtkCellAreaBox* box gint spacing")
-(CFNC-300 "GtkCellAreaBoxContext* gtk_cell_area_box_context_copy GtkCellAreaBox* box GtkCellAreaBoxContext* box_context")
-(CFNC-300 "void gtk_cell_area_box_init_groups GtkCellAreaBoxContext* box_context guint n_groups gboolean* expand_groups gboolean* align_groups")
-(CFNC-300 "void gtk_cell_area_box_context_push_group_width GtkCellAreaBoxContext* box_context gint group_idx gint minimum_width gint natural_width")
-(CFNC-300 "void gtk_cell_area_box_context_push_group_height_for_width GtkCellAreaBoxContext* box_context gint group_idx gint for_width gint minimum_height gint natural_height")
-(CFNC-300 "void gtk_cell_area_box_context_push_group_height GtkCellAreaBoxContext* box_context gint group_idx gint minimum_height gint natural_height")
-(CFNC-300 "void gtk_cell_area_box_context_push_group_width_for_height GtkCellAreaBoxContext* box_context gint group_idx gint for_height gint minimum_width gint natural_width")
-(CFNC-300 "void gtk_cell_area_box_context_get_group_width GtkCellAreaBoxContext* box_context gint group_idx gint* [minimum_width] gint* [natural_width]")
-(CFNC-300 "void gtk_cell_area_box_context_get_group_height_for_width GtkCellAreaBoxContext* box_context gint group_idx gint for_width gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_cell_area_box_context_get_group_height GtkCellAreaBoxContext* box_context gint group_idx gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_cell_area_box_context_get_group_width_for_height GtkCellAreaBoxContext* box_context gint group_idx gint for_height gint* [minimum_width] gint* [natural_width]")
-(CFNC-300 "GtkRequestedSize* gtk_cell_area_box_context_get_widths GtkCellAreaBoxContext* box_context gint* [n_widths]")
-(CFNC-300 "GtkRequestedSize* gtk_cell_area_box_context_get_heights GtkCellAreaBoxContext* box_context gint* [n_heights]")
-(CFNC-300 "GtkCellArea* gtk_cell_area_context_get_area GtkCellAreaContext* context")
-(CFNC-300 "void gtk_cell_area_context_allocate GtkCellAreaContext* context gint width gint height")
-(CFNC-300 "void gtk_cell_area_context_reset GtkCellAreaContext* context")
-(CFNC-300 "void gtk_cell_area_context_get_preferred_width GtkCellAreaContext* context gint* [minimum_width] gint* [natural_width]")
-(CFNC-300 "void gtk_cell_area_context_get_preferred_height GtkCellAreaContext* context gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_cell_area_context_get_preferred_height_for_width GtkCellAreaContext* context gint width gint* [minimum_height] gint* [natural_height]")
-(CFNC-300 "void gtk_cell_area_context_get_preferred_width_for_height GtkCellAreaContext* context gint height gint* [minimum_width] gint* [natural_width]")
-(CFNC-300 "void gtk_cell_area_context_get_allocation GtkCellAreaContext* context gint* [width] gint* [height]")
-(CFNC-300 "void gtk_cell_area_context_push_preferred_width GtkCellAreaContext* context gint minimum_width gint natural_width")
-(CFNC-300 "void gtk_cell_area_context_push_preferred_height GtkCellAreaContext* context gint minimum_height gint natural_height")
-(CFNC-300 "GtkCellArea* gtk_cell_layout_get_area GtkCellLayout* cell_layout")
-(CFNC-300 "void gtk_cell_renderer_get_aligned_area GtkCellRenderer* cell GtkWidget* widget GtkCellRendererState flags GdkRectangle* cell_area GdkRectangle* aligned_area" 'const)
-(CFNC-300 "gboolean gtk_cell_renderer_is_activatable GtkCellRenderer* cell")
-(CFNC-300 "GtkEntryCompletion* gtk_entry_completion_new_with_area GtkCellArea* area")
-(CFNC-300 "const PangoFontDescription* gtk_style_context_get_font GtkStyleContext* context GtkStateFlags state")
-(CFNC-300 "GtkTreeViewColumn* gtk_tree_view_column_new_with_area GtkCellArea* area")
-
-
-
-;;; as of 2.91.7, here are the xg-undefined names from gtk *.h
-
-gtkappchooserbutton: GTK_APP_CHOOSER_BUTTON
-gtkappchooserbutton: GTK_IS_APP_CHOOSER_BUTTON
-gtkappchooserbutton: gtk_app_chooser_button_new
-gtkappchooserbutton: gtk_app_chooser_button_append_separator
-gtkappchooserbutton: gtk_app_chooser_button_append_custom_item
-gtkappchooserbutton: gtk_app_chooser_button_set_active_custom_item
-gtkappchooserbutton: gtk_app_chooser_button_set_show_dialog_item
-gtkappchooserbutton: gtk_app_chooser_button_get_show_dialog_item
-gtkappchooserdialog: GTK_APP_CHOOSER_DIALOG
-gtkappchooserdialog: GTK_IS_APP_CHOOSER_DIALOG
-gtkappchooserdialog: gtk_app_chooser_dialog_new
-gtkappchooserdialog: gtk_app_chooser_dialog_new_for_content_type
-gtkappchooserdialog: gtk_app_chooser_dialog_get_widget
-gtkappchooser: GTK_APP_CHOOSER
-gtkappchooser: GTK_IS_APP_CHOOSER
-gtkappchooser: gtk_app_chooser_get_app_info
-gtkappchooser: gtk_app_chooser_get_content_type
-gtkappchooser: gtk_app_chooser_refresh
-gtkappchooserwidget: GTK_APP_CHOOSER_WIDGET
-gtkappchooserwidget: GTK_IS_APP_CHOOSER_WIDGET
-gtkappchooserwidget: gtk_app_chooser_widget_new
-gtkappchooserwidget: gtk_app_chooser_widget_set_show_default
-gtkappchooserwidget: gtk_app_chooser_widget_get_show_default
-gtkappchooserwidget: gtk_app_chooser_widget_set_show_recommended
-gtkappchooserwidget: gtk_app_chooser_widget_get_show_recommended
-gtkappchooserwidget: gtk_app_chooser_widget_set_show_fallback
-gtkappchooserwidget: gtk_app_chooser_widget_get_show_fallback
-gtkappchooserwidget: gtk_app_chooser_widget_set_show_other
-gtkappchooserwidget: gtk_app_chooser_widget_get_show_other
-gtkappchooserwidget: gtk_app_chooser_widget_set_show_all
-gtkappchooserwidget: gtk_app_chooser_widget_get_show_all
-gtkappchooserwidget: gtk_app_chooser_widget_set_default_text
-gtkappchooserwidget: gtk_app_chooser_widget_get_default_text
-gtkpagesetup: GTK_PAGE_SETUP
-gtkpagesetup: GTK_IS_PAGE_SETUP
-gtkpagesetup: gtk_page_setup_new
-gtkpagesetup: gtk_page_setup_copy
-gtkpagesetup: gtk_page_setup_get_orientation
-gtkpagesetup: gtk_page_setup_set_orientation
-gtkpagesetup: gtk_page_setup_get_paper_size
-gtkpagesetup: gtk_page_setup_set_paper_size
-gtkpagesetup: gtk_page_setup_get_top_margin
-gtkpagesetup: gtk_page_setup_set_top_margin
-gtkpagesetup: gtk_page_setup_get_bottom_margin
-gtkpagesetup: gtk_page_setup_set_bottom_margin
-gtkpagesetup: gtk_page_setup_get_left_margin
-gtkpagesetup: gtk_page_setup_set_left_margin
-gtkpagesetup: gtk_page_setup_get_right_margin
-gtkpagesetup: gtk_page_setup_set_right_margin
-gtkpagesetup: gtk_page_setup_set_paper_size_and_default_margins
-gtkpagesetup: gtk_page_setup_get_paper_width
-gtkpagesetup: gtk_page_setup_get_paper_height
-gtkpagesetup: gtk_page_setup_get_page_width
-gtkpagesetup: gtk_page_setup_get_page_height
-gtkpagesetup: gtk_page_setup_load_file
-gtkpagesetup: gtk_page_setup_new_from_key_file
-gtkpagesetup: gtk_page_setup_load_key_file
-gtkpagesetup: gtk_page_setup_to_key_file
-gtkpagesetupunixdialog: GTK_PAGE_SETUP_UNIX_DIALOG
-gtkpagesetupunixdialog: GTK_IS_PAGE_SETUP_UNIX_DIALOG
-gtkpagesetupunixdialog: gtk_page_setup_unix_dialog_new
-gtkpagesetupunixdialog: gtk_page_setup_unix_dialog_get_page_setup
-gtkpagesetupunixdialog: gtk_page_setup_unix_dialog_get_print_settings
-gtkpapersize: GTK_PAPER_NAME_A
-gtkpapersize: GTK_PAPER_NAME_A
-gtkpapersize: GTK_PAPER_NAME_LETTER
-gtkpapersize: GTK_PAPER_NAME_EXECUTIVE
-gtkpapersize: GTK_PAPER_NAME_LEGAL
-gtkpapersize: gtk_paper_size_new
-gtkpapersize: gtk_paper_size_new_from_ppd
-gtkpapersize: gtk_paper_size_new_custom
-gtkpapersize: gtk_paper_size_copy
-gtkpapersize: gtk_paper_size_free
-gtkpapersize: gtk_paper_size_is_equal
-gtkpapersize: gtk_paper_size_get_paper_sizes
-gtkpapersize: gtk_paper_size_get_name
-gtkpapersize: gtk_paper_size_get_display_name
-gtkpapersize: gtk_paper_size_get_ppd_name
-gtkpapersize: gtk_paper_size_get_width
-gtkpapersize: gtk_paper_size_get_height
-gtkpapersize: gtk_paper_size_is_custom
-gtkpapersize: gtk_paper_size_set_size
-gtkpapersize: gtk_paper_size_get_default_top_margin
-gtkpapersize: gtk_paper_size_get_default_bottom_margin
-gtkpapersize: gtk_paper_size_get_default_left_margin
-gtkpapersize: gtk_paper_size_get_default_right_margin
-gtkpapersize: gtk_paper_size_get_default
-gtkpapersize: gtk_paper_size_new_from_key_file
-gtkpapersize: gtk_paper_size_to_key_file
-gtkprintbackend: GTK_PRINT_BACKEND_ENABLE_UNSUPPORTED
-gtkprintbackend: GTK_PRINT_BACKEND_ERROR
-gtkprintbackend: GTK_PRINT_BACKEND_ERROR_GENERIC
-gtkprintbackend: gtk_print_backend_error_quark
-gtkprintbackend: GTK_PRINT_BACKEND
-gtkprintbackend: GTK_IS_PRINT_BACKEND
-gtkprintbackend: GTK_PRINT_BACKEND_STATUS_UNKNOWN
-gtkprintbackend: GTK_PRINT_BACKEND_STATUS_OK
-gtkprintbackend: GTK_PRINT_BACKEND_STATUS_UNAVAILABLE
-gtkprintbackend: gtk_print_backend_get_printer_list
-gtkprintbackend: gtk_print_backend_printer_list_is_done
-gtkprintbackend: gtk_print_backend_find_printer
-gtkprintbackend: gtk_print_backend_print_stream
-gtkprintbackend: gtk_print_backend_load_modules
-gtkprintbackend: gtk_print_backend_destroy
-gtkprintbackend: gtk_print_backend_set_password
-gtkprintbackend: gtk_print_backend_add_printer
-gtkprintbackend: gtk_print_backend_remove_printer
-gtkprintbackend: gtk_print_backend_set_list_done
-gtkprintbackend: gtk_printer_new
-gtkprintbackend: gtk_printer_is_new
-gtkprintbackend: gtk_printer_set_is_new
-gtkprintbackend: gtk_printer_set_is_active
-gtkprintbackend: gtk_printer_set_is_paused
-gtkprintbackend: gtk_printer_set_is_accepting_jobs
-gtkprintbackend: gtk_printer_set_has_details
-gtkprintbackend: gtk_printer_set_is_default
-gtkprintbackend: gtk_printer_set_icon_name
-gtkprintbackend: gtk_printer_set_job_count
-gtkprintbackend: gtk_printer_set_location
-gtkprintbackend: gtk_printer_set_description
-gtkprintbackend: gtk_printer_set_state_message
-gtkprintcontext: gtk_print_context_get_hard_margins
-gtkprintcontext: gtk_print_context_get_pango_fontmap
-gtkprinter: GTK_PRINT_CAPABILITY_PAGE_SET
-gtkprinter: GTK_PRINT_CAPABILITY_COPIES
-gtkprinter: GTK_PRINT_CAPABILITY_COLLATE
-gtkprinter: GTK_PRINT_CAPABILITY_REVERSE
-gtkprinter: GTK_PRINT_CAPABILITY_SCALE
-gtkprinter: GTK_PRINT_CAPABILITY_GENERATE_PDF
-gtkprinter: GTK_PRINT_CAPABILITY_GENERATE_PS
-gtkprinter: GTK_PRINT_CAPABILITY_PREVIEW
-gtkprinter: GTK_PRINT_CAPABILITY_NUMBER_UP
-gtkprinter: GTK_PRINT_CAPABILITY_NUMBER_UP_LAYOUT
-gtkprinter: GTK_PRINTER
-gtkprinter: GTK_IS_PRINTER
-gtkprinter: gtk_printer_new
-gtkprinter: gtk_printer_get_backend
-gtkprinter: gtk_printer_get_name
-gtkprinter: gtk_printer_get_state_message
-gtkprinter: gtk_printer_get_description
-gtkprinter: gtk_printer_get_location
-gtkprinter: gtk_printer_get_icon_name
-gtkprinter: gtk_printer_get_job_count
-gtkprinter: gtk_printer_is_active
-gtkprinter: gtk_printer_is_paused
-gtkprinter: gtk_printer_is_accepting_jobs
-gtkprinter: gtk_printer_is_virtual
-gtkprinter: gtk_printer_is_default
-gtkprinter: gtk_printer_accepts_pdf
-gtkprinter: gtk_printer_accepts_ps
-gtkprinter: gtk_printer_list_papers
-gtkprinter: gtk_printer_get_default_page_size
-gtkprinter: gtk_printer_compare
-gtkprinter: gtk_printer_has_details
-gtkprinter: gtk_printer_request_details
-gtkprinter: gtk_printer_get_capabilities
-gtkprinter: gtk_printer_get_hard_margins
-gtkprinter: gtk_enumerate_printers
-gtkprinteroption: GTK_PRINT_BACKEND_ENABLE_UNSUPPORTED
-gtkprinteroption: GTK_PRINTER_OPTION
-gtkprinteroption: GTK_IS_PRINTER_OPTION
-gtkprinteroption: GTK_PRINTER_OPTION_GROUP_IMAGE_QUALITY
-gtkprinteroption: GTK_PRINTER_OPTION_GROUP_FINISHING
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_BOOLEAN
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_PICKONE
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_PICKONE_PASSWORD
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_PICKONE_PASSCODE
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_PICKONE_REAL
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_PICKONE_INT
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_PICKONE_STRING
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_ALTERNATIVE
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_STRING
-gtkprinteroption: GTK_PRINTER_OPTION_TYPE_FILESAVE
-gtkprinteroption: gtk_printer_option_new
-gtkprinteroption: gtk_printer_option_set
-gtkprinteroption: gtk_printer_option_set_has_conflict
-gtkprinteroption: gtk_printer_option_clear_has_conflict
-gtkprinteroption: gtk_printer_option_set_boolean
-gtkprinteroption: gtk_printer_option_allocate_choices
-gtkprinteroption: gtk_printer_option_choices_from_array
-gtkprinteroption: gtk_printer_option_has_choice
-gtkprinteroption: gtk_printer_option_set_activates_default
-gtkprinteroption: gtk_printer_option_get_activates_default
-gtkprinteroptionset: GTK_PRINT_BACKEND_ENABLE_UNSUPPORTED
-gtkprinteroptionset: GTK_PRINTER_OPTION_SET
-gtkprinteroptionset: GTK_IS_PRINTER_OPTION_SET
-gtkprinteroptionset: gtk_printer_option_set_new
-gtkprinteroptionset: gtk_printer_option_set_add
-gtkprinteroptionset: gtk_printer_option_set_remove
-gtkprinteroptionset: gtk_printer_option_set_lookup
-gtkprinteroptionset: gtk_printer_option_set_foreach
-gtkprinteroptionset: gtk_printer_option_set_clear_conflicts
-gtkprinteroptionset: gtk_printer_option_set_get_groups
-gtkprinteroptionset: gtk_printer_option_set_foreach_in_group
-gtkprinteroptionwidget: GTK_PRINTER_OPTION_WIDGET
-gtkprinteroptionwidget: GTK_IS_PRINTER_OPTION_WIDGET
-gtkprinteroptionwidget: gtk_printer_option_widget_new
-gtkprinteroptionwidget: gtk_printer_option_widget_set_source
-gtkprinteroptionwidget: gtk_printer_option_widget_has_external_label
-gtkprinteroptionwidget: gtk_printer_option_widget_get_external_label
-gtkprinteroptionwidget: gtk_printer_option_widget_get_value
-gtkprintjob: GTK_PRINT_JOB
-gtkprintjob: GTK_IS_PRINT_JOB
-gtkprintjob: gtk_print_job_new
-gtkprintjob: gtk_print_job_get_settings
-gtkprintjob: gtk_print_job_get_printer
-gtkprintjob: gtk_print_job_get_title
-gtkprintjob: gtk_print_job_get_status
-gtkprintjob: gtk_print_job_set_source_file
-gtkprintjob: gtk_print_job_get_surface
-gtkprintjob: gtk_print_job_set_track_print_status
-gtkprintjob: gtk_print_job_get_track_print_status
-gtkprintjob: gtk_print_job_send
-gtkprintjob: gtk_print_job_get_pages
-gtkprintjob: gtk_print_job_set_pages
-gtkprintjob: gtk_print_job_get_page_ranges
-gtkprintjob: gtk_print_job_set_page_ranges
-gtkprintjob: gtk_print_job_get_page_set
-gtkprintjob: gtk_print_job_set_page_set
-gtkprintjob: gtk_print_job_get_num_copies
-gtkprintjob: gtk_print_job_set_num_copies
-gtkprintjob: gtk_print_job_get_scale
-gtkprintjob: gtk_print_job_set_scale
-gtkprintjob: gtk_print_job_get_n_up
-gtkprintjob: gtk_print_job_set_n_up
-gtkprintjob: gtk_print_job_get_n_up_layout
-gtkprintjob: gtk_print_job_set_n_up_layout
-gtkprintjob: gtk_print_job_get_rotate
-gtkprintjob: gtk_print_job_set_rotate
-gtkprintjob: gtk_print_job_get_collate
-gtkprintjob: gtk_print_job_set_collate
-gtkprintjob: gtk_print_job_get_reverse
-gtkprintjob: gtk_print_job_set_reverse
-gtkprintoperation: GTK_PRINT_ERROR
-gtkprintoperation: gtk_print_error_quark
-gtkprintoperation: gtk_print_operation_draw_page_finish
-gtkprintoperation: gtk_print_operation_set_defer_drawing
-gtkprintoperation: gtk_print_operation_set_support_selection
-gtkprintoperation: gtk_print_operation_get_support_selection
-gtkprintoperation: gtk_print_operation_set_has_selection
-gtkprintoperation: gtk_print_operation_get_has_selection
-gtkprintoperation: gtk_print_operation_get_n_pages_to_print
-gtkprintsettings: gtk_print_settings_load_file
-gtkprintsettings: gtk_print_settings_new_from_key_file
-gtkprintsettings: gtk_print_settings_load_key_file
-gtkprintsettings: gtk_print_settings_to_key_file
-gtkprintsettings: GTK_PRINT_SETTINGS_NUMBER_UP_LAYOUT
-gtkprintsettings: GTK_PRINT_SETTINGS_RESOLUTION_X
-gtkprintsettings: GTK_PRINT_SETTINGS_RESOLUTION_Y
-gtkprintsettings: GTK_PRINT_SETTINGS_PRINTER_LPI
-gtkprintsettings: GTK_PRINT_SETTINGS_WIN
-gtkprintsettings: GTK_PRINT_SETTINGS_WIN
-gtkprintsettings: gtk_print_settings_get_number_up_layout
-gtkprintsettings: gtk_print_settings_set_number_up_layout
-gtkprintsettings: gtk_print_settings_get_resolution_x
-gtkprintsettings: gtk_print_settings_get_resolution_y
-gtkprintsettings: gtk_print_settings_set_resolution_xy
-gtkprintsettings: gtk_print_settings_get_printer_lpi
-gtkprintunixdialog: GTK_PRINT_UNIX_DIALOG
-gtkprintunixdialog: GTK_IS_PRINT_UNIX_DIALOG
-gtkprintunixdialog: gtk_print_unix_dialog_new
-gtkprintunixdialog: gtk_print_unix_dialog_set_page_setup
-gtkprintunixdialog: gtk_print_unix_dialog_set_current_page
-gtkprintunixdialog: gtk_print_unix_dialog_set_settings
-gtkprintunixdialog: gtk_print_unix_dialog_get_selected_printer
-gtkprintunixdialog: gtk_print_unix_dialog_add_custom_tab
-gtkprintunixdialog: gtk_print_unix_dialog_set_manual_capabilities
-gtkprintunixdialog: gtk_print_unix_dialog_set_support_selection
-gtkprintunixdialog: gtk_print_unix_dialog_set_has_selection
-gtkprintunixdialog: gtk_print_unix_dialog_set_embed_page_setup
-gtkprintunixdialog: gtk_print_unix_dialog_get_page_setup_set
-gtkrecentaction: GTK_RECENT_ACTION
-gtkrecentaction: GTK_IS_RECENT_ACTION
-gtkrecentaction: gtk_recent_action_new
-gtkrecentaction: gtk_recent_action_new_for_manager
-gtkrecentaction: gtk_recent_action_get_show_numbers
-gtkrecentaction: gtk_recent_action_set_show_numbers
-gtkrecentchooser: GTK_RECENT_CHOOSER_ERROR
-gtkrecentmanager: GTK_RECENT_MANAGER_ERROR
-gtkrecentmanager: gtk_recent_info_get_application_info
-gtkrecentmanager: gtk_recent_info_create_app_info
-gtkrecentmanager: gtk_recent_info_get_gicon
-
-;; fgrep "gtk_" *.h > names
-;; fgrep "GTK_" *.h >> names
-;; then get rid of all the obvious junk
-
-;; omit gtkrc.h, gtkcellarea*, gtkstylecontext.h, gtkstyle.h, gtkrbtree.h (internal to gtktreeview), gtktimeline.h
-;; gtktextlayout.h (all internal), gtktexttypes.h, gtktrayicon.h, gtkrecentchooserutils.h, gtksearch*.h
-;; gtkmodules.h, gtkquery.h, gtktextsegment.h, gtkbuilder.h, gtkbuilable.h, gtkapplication.h, gtkuimanager.h
-;; gtksizerequest.h, gtkoffscreenwindow.h, gtkthemingengine.h, gtkwidgetpath.h, gtkpathbar.h, gtkmountoperation.h
-;; gtkhsv.h (not used anywhere?)
-
-(call-with-input-file "names"
- (lambda (p)
-
- (do ((line (read-line p) (read-line p)))
- ((eof-object? line))
- ;(format #t "~S~%" line)
- (let ((len (length line)))
- (if (> len 4)
- (let ((pos #f)
- (header #f)
- (function #f))
- (call-with-exit
- (lambda (ok)
- (do ((k 0 (+ k 1)))
- ((>= k (- len 1)))
- (if (and (char=? (line k) #\.)
- (char=? (line (+ k 1)) #\h))
- (begin
- (set! pos (+ k 2))
- (set! header (substring line 0 k))
- (ok))))))
- (if (number? pos)
- (call-with-exit
- (lambda (ok)
- (do ((k pos (+ k 1)))
- ((>= k len))
- (let ((test (substring line k (+ k 4)))
- (prev (line (- k 1))))
- (if (and (or (string=? "gtk_" test)
- (string=? "GTK_" test))
- (or (char=? prev #\space)
- (char=? prev #\*)
- (char=? prev #\:)
- (char=? prev #\tab)))
- (do ((i (+ k 5) (+ i 1)))
- ((or (= i len)
- (and (not (char-alphabetic? (line i)))
- (not (char=? (line i) #\_))))
- (set! function (substring line k i))
- (ok)))))))))
- (if (and function
- (not (defined? (string->symbol function))))
- (format #t "~A: ~A~%" header function))))))))
+;;; cairo 1.14.0:
+(CFNC-3.16 "void cairo_surface_set_device_scale cairo_surface_t* surface double x_scale double y_scale")
+(CFNC-3.16 "void cairo_surface_get_device_scale cairo_surface_t* surface double* [x_scale] double* [y_scale]")
|#
-;;; TODO: support g_object_get|set
\ No newline at end of file
+;;; 3.15.2:
+
+;(CINT-3.16 "GDK_GL_DISABLE" "GdkGLFlags")
+;(CINT-3.16 "GDK_GL_ALWAYS" "GdkGLFlags")
+;(CINT-3.16 "GDK_GL_SOFTWARE_DRAW_GL" "GdkGLFlags")
+;(CINT-3.16 "GDK_GL_SOFTWARE_DRAW_SURFACE" "GdkGLFlags")
+;(CINT-3.16 "GDK_GL_TEXTURE_RECTANGLE" "GdkGLFlags")
+
+(CCAST-3.16 "GTK_POPOVER_MENU(object)" "GtkPopoverMenu*")
+(CCHK-3.16 "GTK_IS_POPOVER_MENU(object)" "GtkPopoverMenu*")
+
+(CFNC-3.16 "GdkDisplay* gdk_gl_context_get_display GdkGLContext* context")
+;(CFNC-3.16 "GdkGLProfile gdk_gl_context_get_profile GdkGLContext* context")
+;(CFNC-3.16 "GdkGLProfile gtk_gl_area_get_profile GtkGLArea* area")
+;(CFNC-3.16 "void gtk_gl_area_set_profile GtkGLArea* area GdkGLProfile profile")
+(CFNC-3.16 "gboolean gtk_gl_area_get_has_stencil_buffer GtkGLArea* area")
+(CFNC-3.16 "void gtk_gl_area_set_has_stencil_buffer GtkGLArea* area gboolean has_stencil_buffer")
+(CFNC-3.16 "gboolean gtk_gl_area_get_auto_render GtkGLArea* area")
+(CFNC-3.16 "void gtk_gl_area_set_auto_render GtkGLArea* area gboolean auto_render")
+(CFNC-3.16 "void gtk_gl_area_queue_render GtkGLArea* area")
+(CFNC-3.16 "void gtk_gl_area_attach_buffers GtkGLArea* area")
+;(CFNC-3.16 "void gtk_gl_area_set_error GtkGLArea* area GError *error" 'const)
+(CFNC-3.16 "GError* gtk_gl_area_get_error GtkGLArea* area")
+(CFNC-3.16 "GtkWidget* gtk_popover_menu_new void")
+(CFNC-3.16 "void gtk_popover_menu_open_submenu GtkPopoverMenu* popover gchar* name" 'const)
+
+;;; 3.15.3:
+
+(CFNC-3.16 "void gtk_entry_grab_focus_without_selecting GtkEntry* entry")
+(CFNC-3.16 "gboolean gtk_scrollable_get_border GtkScrollable* scrollable GtkBorder* border")
+(CFNC-3.16 "void gtk_text_buffer_insert_markup GtkTextBuffer* buffer GtkTextIter* iter gchar* markup gint len" 'const)
+
+;(CFNC-3.16 "GActionGroup* gtk_widget_get_action_group GtkWidget* widget gchar* prefix" 'const)
+;(CNFC-3.16 "gchar** gtk_widget_list_action_prefixes GtkWidget* widget" 'const)
+
+;;; 3.15.4:
+
+(CFNC-3.16 "gchar* gdk_device_get_vendor_id GdkDevice* device" 'const-return)
+(CFNC-3.16 "gchar* gdk_device_get_product_id GdkDevice* device" 'const-return)
+
+(CINT-3.16 "GTK_TEXT_EXTEND_SELECTION_WORD" "GtkTextExtendSelection")
+(CINT-3.16 "GTK_TEXT_EXTEND_SELECTION_LINE" "GtkTextExtendSelection")
+
+;;; 3.15.5:
+
+(CFNC-3.16 "GdkGLContext* gdk_gl_context_get_shared_context GdkGLContext* context")
+(CFNC-3.16 "void gdk_gl_context_set_required_version GdkGLContext* context int major int minor")
+(CFNC-3.16 "void gdk_gl_context_get_required_version GdkGLContext* context int* [major] int* [minor]")
+(CFNC-3.16 "void gdk_gl_context_set_debug_enabled GdkGLContext* context gboolean enabled")
+(CFNC-3.16 "gboolean gdk_gl_context_get_debug_enabled GdkGLContext* context")
+(CFNC-3.16 "void gdk_gl_context_set_forward_compatible GdkGLContext* context gboolean compatible")
+(CFNC-3.16 "gboolean gdk_gl_context_get_forward_compatible GdkGLContext* context")
+(CFNC-3.16 "gboolean gdk_gl_context_realize GdkGLContext* context GError** [error]")
+
+(CFNC-3.16 "GtkClipboard* gtk_clipboard_get_default GdkDisplay* display")
+(CFNC-3.16 "void gtk_drag_cancel GdkDragContext* context")
+(CFNC-3.16 "gboolean gtk_search_entry_handle_event GtkSearchEntry* entry GdkEvent* event")
+
+;;; 3.15.7:
+
+(CFNC-3.16 "void gdk_gl_context_get_version GdkGLContext* context int* [major] int* [minor]")
+(CFNC-3.16 "void gtk_gl_area_set_required_version GtkGLArea* area gint major gint minor")
+(CFNC-3.16 "void gtk_gl_area_get_required_version GtkGLArea* area gint* [major] gint* [minor]")
+;(CFNC-3.16 "void gtk_list_box_bind_model GtkListBox* box GListModel* model GtkListBoxCreateWidgetFunc create_widget_func gpointer user_data GDestroyNotify user_data_free_func")
+(CFNC-3.16 "void gtk_notebook_detach_tab GtkNotebook* notebook GtkWidget* child")
+
+(CCAST-3.16 "GTK_STACK_SIDEBAR(object)" "GtkStackSidebar*")
+(CCHK-3.16 "GTK_IS_STACK_SIDEBAR(object)" "GtkStackSidebar*")
+(CFNC-3.16 "GtkWidget* gtk_stack_sidebar_new void")
+(CFNC-3.16 "void gtk_stack_sidebar_set_stack GtkStackSidebar* sidebar GtkStack* stack")
+(CFNC-3.16 "GtkStack* gtk_stack_sidebar_get_stack GtkStackSidebar* sidebar")
+
+;;; 3.15.8:
+
+(CFNC-3.16 "void gtk_popover_set_transitions_enabled GtkPopover* popover gboolean transitions_enabled")
+(CFNC-3.16 "gboolean gtk_popover_get_transitions_enabled GtkPopover* popover")
+
+;;; 3.16.0
+;;; 3.16.1
+;;; 3.16.2:
+
+;;; 3.17.1
+
+(CFNC-3.18 "gboolean gdk_keymap_get_scroll_lock_state GdkKeymap* keymap")
+(CFNC-3.18 "void gtk_radio_menu_item_join_group GtkRadioMenuItem* radio_menu_item GtkRadioMenuItem* group_source")
+
+;;; 3.17.2:
+
+(CFNC-3.18 "void gtk_font_chooser_set_font_map GtkFontChooser* fontchooser PangoFontMap* fontmap")
+(CFNC-3.18 "PangoFontMap* gtk_font_chooser_get_font_map GtkFontChooser* fontchooser")
+(CFNC-3.18 "void gtk_popover_set_default_widget GtkPopover* popover GtkWidget* widget")
+(CFNC-3.18 "GtkWidget* gtk_popover_get_default_widget GtkPopover* popover")
+
+;;; 3.17.4:
+
+(CFNC-3.18 "void gdk_window_set_pass_through GdkWindow* window gboolean pass_through")
+(CFNC-3.18 "gboolean gdk_window_get_pass_through GdkWindow* window")
+(CFNC-3.18 "void gtk_overlay_reorder_overlay GtkOverlay* overlay GtkWidget* child gint position")
+(CFNC-3.18 "gboolean gtk_overlay_get_overlay_pass_through GtkOverlay* overlay GtkWidget* widget")
+(CFNC-3.18 "void gtk_overlay_set_overlay_pass_through GtkOverlay* overlay GtkWidget* widget gboolean pass_through")
+(CFNC-3.18 "gboolean gtk_places_sidebar_get_show_recent GtkPlacesSidebar* sidebar")
+(CFNC-3.18 "void gtk_places_sidebar_set_show_recent GtkPlacesSidebar* sidebar gboolean show_recent")
+(CFNC-3.18 "void gtk_places_sidebar_set_drop_targets_visible GtkPlacesSidebar* sidebar gboolean visible GdkDragContext* context")
+
+;;; 3.17.5:
+
+(CFNC-3.18 "gboolean gtk_places_sidebar_get_show_trash GtkPlacesSidebar* sidebar")
+(CFNC-3.18 "void gtk_places_sidebar_set_show_trash GtkPlacesSidebar* sidebar gboolean show_trash")
+(CFNC-3.18 "void gtk_places_sidebar_set_show_other_locations GtkPlacesSidebar* sidebar gboolean show_other_locations")
+(CFNC-3.18 "gboolean gtk_places_sidebar_get_show_other_locations GtkPlacesSidebar* sidebar")
+(CFNC-3.18 "void gtk_stack_set_interpolate_size GtkStack* stack gboolean interpolate_size")
+(CFNC-3.18 "gboolean gtk_stack_get_interpolate_size GtkStack* stack")
+(CFNC-3.18 "void gtk_widget_set_font_options GtkWidget* widget cairo_font_options_t* options" 'const)
+(CFNC-3.18 "cairo_font_options_t* gtk_widget_get_font_options GtkWidget* widget" 'const-return)
+(CFNC-3.18 "void gtk_widget_set_font_map GtkWidget* widget PangoFontMap* fontmap")
+(CFNC-3.18 "PangoFontMap* gtk_widget_get_font_map GtkWidget* widget")
+
+;;; 3.17.6:
+
+(CFNC-3.18 "void gdk_window_fullscreen_on_monitor GdkWindow* window gint monitor")
+(CFNC-3.18 "void gtk_window_fullscreen_on_monitor GtkWindow* window GdkScreen* screen gint monitor")
+
+;;; 3.17.7:
+
+(CINT-3.18 "GDK_TOUCHPAD_SWIPE" "GdkEventType")
+(CINT-3.18 "GDK_TOUCHPAD_PINCH" "GdkEventType")
+
+(CINT-3.18 "GDK_TOUCHPAD_GESTURE_PHASE_BEGIN" "GdkTouchpadGesturePhase")
+(CINT-3.18 "GDK_TOUCHPAD_GESTURE_PHASE_UPDATE" "GdkTouchpadGesturePhase")
+(CINT-3.18 "GDK_TOUCHPAD_GESTURE_PHASE_END" "GdkTouchpadGesturePhase")
+(CINT-3.18 "GDK_TOUCHPAD_GESTURE_PHASE_CANCEL" "GdkTouchpadGesturePhase")
+
+(CINT-3.18 "GDK_TOUCHPAD_GESTURE_MASK" "GdkEventMask")
+
+;(CFNC-3.18 "void gtk_flow_box_bind_model GtkFlowBox* box GListModel* model GtkFlowBoxCreateWidgetFunc create_widget_func gpointer user_data GDestroyNotify user_data_free_func")
+
+(CFNC-3.18 "void gtk_text_view_set_top_margin GtkTextView* text_view gint top_margin")
+(CFNC-3.18 "gint gtk_text_view_get_top_margin GtkTextView* text_view")
+(CFNC-3.18 "void gtk_text_view_set_bottom_margin GtkTextView* text_view gint bottom_margin")
+(CFNC-3.18 "gint gtk_text_view_get_bottom_margin GtkTextView* text_view")
+
+;;; 3.17.8|9:
+
+(CINT-3.18 "GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK" "GdkModifierIntent")
+
+;;; 3.18.0
+;;; 3.18.1
+
+
+;;; 3.19.1:
+
+(CFNC-3.20 "gboolean gdk_gl_context_is_legacy GdkGLContext* context")
+(CFNC-3.20 "gboolean gdk_rectangle_equal GdkRectangle* rect1 GdkRectangle*rect2" 'const)
+(CFNC-3.20 "void gtk_application_window_set_help_overlay GtkApplicationWindow* window GtkShortcutsWindow* help_overlay")
+;;; (CFNC-3.20 "GtkShortcutsWindow* gtk_application_window_get_help_overlay GtkApplicationWindow* window")
+(CFNC-3.20 "void gtk_settings_reset_property GtkSettings* settings gchar* name" 'const)
+(CFNC-3.20 "void gtk_text_tag_changed GtkTextTag* tag gboolean size_changed")
+;;; (CFNC-3.20 "void gtk_widget_class_set_css_name GtkWidgetClass* widget_class char* name" 'const)
+;;; (CFNC-3.20 "char* gtk_widget_class_get_css_name GtkWidgetClass* widget_class" 'const-return)
+(CFNC-3.20 "char* gtk_widget_path_iter_get_object_name GtkWidgetPath* path gint pos" 'const-return)
+(CFNC-3.20 "void gtk_widget_path_iter_set_object_name GtkWidgetPath* path gint pos char* name" 'const)
+
+
+;;; 3.19.2:
+
+(CFNC-3.20 "void gtk_widget_queue_allocate GtkWidget* widget")
+(CFNC-3.20 "void gtk_widget_set_focus_on_click GtkWidget* widget gboolean focus_on_click")
+(CFNC-3.20 "gboolean gtk_widget_get_focus_on_click GtkWidget* widget")
+(CFNC-3.20 "void gtk_widget_get_allocated_size GtkWidget* widget GtkAllocation* [allocation] int* [baseline]")
+
+
+;;; 3.19.3:
+
+(CINT-3.20 "GTK_SHORTCUT_ACCELERATOR" "GtkShortcutType")
+(CINT-3.20 "GTK_SHORTCUT_GESTURE_PINCH" "GtkShortcutType")
+(CINT-3.20 "GTK_SHORTCUT_GESTURE_STRETCH" "GtkShortcutType")
+(CINT-3.20 "GTK_SHORTCUT_GESTURE_ROTATE_CLOCKWISE" "GtkShortcutType")
+(CINT-3.20 "GTK_SHORTCUT_GESTURE_ROTATE_COUNTERCLOCKWISE" "GtkShortcutType")
+(CINT-3.20 "GTK_SHORTCUT_GESTURE_TWO_FINGER_SWIPE_LEFT" "GtkShortcutType")
+(CINT-3.20 "GTK_SHORTCUT_GESTURE_TWO_FINGER_SWIPE_RIGHT" "GtkShortcutType")
+(CINT-3.20 "GTK_SHORTCUT_GESTURE" "GtkShortcutType")
+
diff --git a/tutorial/1_intro_and_build_snd.html b/tutorial/1_intro_and_build_snd.html
deleted file mode 100644
index 998223d..0000000
--- a/tutorial/1_intro_and_build_snd.html
+++ /dev/null
@@ -1,211 +0,0 @@
-<html>
-<body bgcolor="#FFFFFF">
-
-<center><h3>Developing And Using Snd</h3></center>
-<center><h4>A Simple Guide And Tutorial For Editing Sound Under Linux</h4></center>
-<center><h4>by</h4></center>
-<center><h4><a href=mailto:dlphilp at bright.net>Dave Phillips</a></h4></center>
-<p>
-
-<u><b>INTRODUCTION TO SOUNDFILE EDITORS</b></u>
-<p>
-
-A soundfile editor (aka an audio editor) is one of the standard tools of the digital sound and music trades. Audio editors work on soundfiles in ways that are analogous to the actions of text and graphics editors upon their respective file types. Typically a modern soundfile editor includes the common cut/copy/paste routines along with a complement of signal processing and mixing modules. A graphic interface and waveform display is usually encountered (though text-mode audio editors do exist for UNIX/Linux), and point & click is the expected mode of user interaction.
-<p>
-
-As Linux grows in popularity among artists working in media such as audio/video and animation we can expect to see more interest in the system's audio capabilities and its available sound and music software. Sound workers migrating from Windows or the Mac will look for tools similar to what they have enjoyed using on their previous platforms, and one of their most frequently asked questions is "What Linux audio editor will most completely take the place of Cool Edit ?".
-<p>
-
-<a href=http://www.syntrillium.com/cooledit/>Cool Edit</a> [Figure 1] is perhaps the most popular soundfile editor available for the Windows OS family. It has been in continuous development for more than ten years: programmer David Johnston originally wrote Cool Edit as shareware for Windows 3.1, and in 1995 the Syntrillium corporation began managing the commercial development of the program (the company still maintains and distributes the shareware version available on the Internet).
-<p>
-
-<center> <img src="images/jpg/1_01-ce2000.jpg">
-<p>
-<b>Figure 1.</b> Cool Edit 2000 (courtesy Dmitri Touretsky)
-</center>
-<p>
-
-Cool Edit is a wonderful program. Its interface is easy to navigate and invites experimentation with a powerful editing and processing toolkit. I used it extensively from its earliest versions through Cool Edit 96, and when I finally stopped using Windows Cool Edit was one of the few programs I truly missed.
-<p>
-
-For various reasons it has been rather difficult to advise Cool Edit users on a Linux equivalent. While there are many soundfile editors available for Linux none are up to Cool Edit's standard, particularly with regards to transparency and ease of use. In response to this challenge I decided to work on extending and enhancing Snd, a powerful audio editor for Linux and other UNIX platforms (see Table 1 for a complete list).
-<p>
-
-<pre>
-********************************
-* *
-* Table 1: Supported platforms *
-* *
-********************************
-
- Cool Edit: Windows 95/98/ME, NT/2000, or higher
-
- Snd: DEC Alpha, SGI, HP-UX, mkLinux, Linux, PPC, SCO, Solaris, *BSD, Mac OSX
-</pre>
-<p>
-
-Like Cool Edit, Snd has been in lengthy development. Snd author Bill Schottstaedt has programmed it continuously since 1996, but his involvement with writing soundfile editors dates back to the late 1970s when he wrote the Dpysnd audio editor for the PDP-10 minicomputer. However, Snd's user interface and other basic design differences are problematic for Cool Edit users, and it is easy to miss Snd's great power and utility. I decided to expose more of that power to the novice and to try to create a working environment similar to Cool Edit. This article will relate how that work has been accomplished so far and will indicate the work that remains.
-<p>
-
-The differences and similarities between Cool Edit and Snd led me to many considerations regarding interface design and its necessary trade-offs. Cool Edit's interface is uniformly designed for editing and processing soundfiles. Almost every action and function in the program can be accessed and controlled by the mouse, and users can navigate their way through the entire program by pointing and clicking. Thanks to this uniform interface a novice easily learns and remembers the program's behavior and more quickly moves into actually working with the program. On the other hand, Snd has been designed to function within a rich sound processing and music composition software environment developed at <a href=http://www-ccrma.stanford.edu/>CCRMA</a>, Stanford University's Center for Computer Research in Music and Acoustics. That environment includes the Common LISP Music (CLM) sound synthesis language, the Common Music (CM) scoring tools for CLM and other output formats (such as Csound and MIDI), and the Common Music Notation (CMN) package. Indeed, Snd could be considered as a graphic display front-end for CLM: the standard build incorporates CLM as a built-in module, Snd provides a window called the Listener for entering code to access the module's synthesis and processing functions, and the interface provides various ways to play and represent the newly synthesized sound.
-<p>
-
-In contrast to the uniformity of Cool Edit, Snd's user interface could be thought of as "multiform" by design. In the default GUI the mouse is extensively employed, but far more program control is available through Snd's Emacs-style keyboard commands. And while considerable processing power lurks under its surface access to that power has been restricted to users willing to learn the necessary scripting language. Thus, in order to use Snd to its fullest potential the user must learn to manage Snd's more complex control interface and acquire some proficiency in the Guile/Scheme language. With that proficiency he can customize the program's appearance and behavior, warping it into quite a different Snd, something more like Cool Edit but definitely still Snd.
-<p>
-
-This article describes how such a warping has been achieved by a user with very little programming skill (I'm really a musician) and virtually no experience with LISP or Scheme. It is not a shoot-out between Cool Edit and Snd. It is actually a status report of an on-going project to externalize Snd's great internal power, using Cool Edit as a model for developing Snd's user interface. I must also note that Cool Edit 2000 has been my measuring rod, not its bigger brother Cool Edit Pro: I have focused on Snd's utility as a soundfile editor, and I consider Cool Edit Pro to be more of a multitrack hard-disk recording environment. So with this undertanding let's get into Snd...
-<p>
-
-
-<u><b>GETTING STARTED WITH SND</b></u>
-<p>
-
-<b>Requirements</b>
-<p>
-
-To build the version of Snd presented in this article you will need to install the following support software:
-<p>
-
-<pre>
- Guile 1.5.x
- OpenMotif 2.1
- ALSA 0.9.x with OSS emulation enabled
- LADSPA and its various plugins
- the Scheme customization files included in the snd-6/dlp directory
-</pre>
-<p>
-
-See the Resources section for the download locations for these packages. It is beyond the scope of this profile to give instructions on installing this software, but the documentation for each package will lead you through their respective build and install procedures. Any other requirements should be fulfilled by libraries and other software included in most mainstream Linux distributions.
-<p>
-
-The ALSA driver packages are not strictly required. You can build Snd perfectly well with either the kernel sound modules (aka OSS/Free) installed or with the excellent OSS/Linux commercial drivers from 4Front Technologies.
-<p>
-
-<b>Getting It, Building It, Installing It</b>
-<p>
-
-Prebuilt binaries for Linux i386, LinuxPPC, and Sun are available from the Snd home page. Source and binary RPMs have been prepared and are available for the i386 and PPC Linux versions. To install Snd from those packages simply follow the usual method of installing RPMs. For example, this command:
-<p>
-
-<pre>
- rpm -ivh snd-5-1.ppc.rpm
-</pre>
-<p>
-
-will install the LinuxPPC package (you will probably need root status to install the RPM file).
-<p>
-
-<i>Note: The instructions and descriptions throughout this article refer to Snd built for the i386 architecture. I was unable to test my build configuration on any other system, but I would like to hear from anyone running Snd on other platforms, particularly LinuxPPC.</i>
-<p>
-
-To build Snd yourself first download the source package (currently snd-5.tar.gz) from the <a href=http://www-ccrma.stanford.edu/software/snd/>CCRMA Snd Home Page</a> to your home directory. Unpack it with 'tar xzvf snd-n.tar.gz' (where n is the major version number), then enter your newly created snd-n directory and read the README.Snd file for the latest installation instructions and details. Run './configure --help' for a list of configuration options: This list includes options for your choice of user interface (Motif, GTK, none), soundcard driver support (ALSA, OSS, Esound), the use of Ruby instead of Guile for Snd's extension language, and support for LADSPA plugins. I use the following command options to compile Snd:
-<p>
-
-<p>
-<pre>
- ./configure --with-motif --with-ladspa --with-static-xm
-</pre>
-<p>
-
-This configuration builds Snd with a Motif 2.1 GUI, support for the LADSPA audio plugins, and built-in support for the graphics routines within Snd's Motif module (xm.so, if built separately). Default values are accepted for all other configuration options, including Snd's default support for the OSS/Free kernel sound API.
-<p>
-
-After configuring the build, run 'make' and wait for the compiler to finish building your new Snd. Become superuser (su root) and run 'make install'. The binary will be installed in /usr/local/bin and a manual page will be placed in /usr/local/man/man1.
-<p>
-
-Snd is also available via CVS. Please see the Snd home page for the details of accessing and downloading using CVS.
-<p>
-
-<!--
-<b>Why Not Native ALSA ?</b>
-<p>
-
-My build configuration includes Snd's default support for the OSS/Free kernel sound API. Including the --with-alsa option will build Snd with native ALSA support (either 0.5.x or the 0.9.x beta series), but the state of the ALSA API is rather mercurial at this time (though quickly closing in on its long-anticipated 1.0 release). Depending on your soundcard, Snd's ALSA support may not be in sync with the most current API. Running Snd with ALSA 0.5.11 native support for my SBLive Value crashed the program when trying to record, but the same driver package works perfectly (via ALSA's OSS/Free emulation mode) with Snd compiled for OSS support. However, native ALSA support and OSS emulation both worked fine for my SB PCI128. I also encountered no problems with recording or playback using the OSS/Linux drivers.
-<p>
-
-<i>Note: Fernando Lopez-Lezcano has recently hacked a work-around that allows recording in Snd under native ALSA with my SBLive. Preliminary tests indicate that the hack works well with mic, line, and CD input, but it is problematic recording from my mixer's master output channel. Hopefully a complete solution will be found soon, and I should emphasize that Snd's ALSA support is already quite functional.</i>
-<p>
--->
-
-<b>Why Motif Instead Of GTK ?</b>
-<p>
-
-Snd can be configured for a build using either Motif or the GTK graphics libraries or for a build with no GUI at all. Some users may wonder why I chose to build Snd with Motif instead of the more modern GTK. As a matter of fact I did build Snd with GTK a few times, but I prefer the amenities of Motif, particularly the keyboard acceleration. More importantly, my interface enhancements depend on the xm.so module. Work proceeds on bringing the GTK version to the same level of customization as the Motif build, but it's not there yet. A final consideration was the fact that Motif 2.1 is now freely available from the <a href=http://www.opengroup.org/openmotif/>OpenMotif</a> group, while the well-known LessTif (replaces Motif 1.2) is also available for free and is usually included with most mainstream Linux distributions. However, Snd may exhibit some odd behavior with LessTif, and author Bill Schottstaedt has indicated that he would rather not bother with Snd + LessTif problems, so I recommend the OpenMotif package.
-<p>
-
-<b>The Test System</b>
-<p>
-
-Here are the hardware specfications of the system used throughout this article:
-<p>
-
-<pre>
- 800 MHz AMD Duron
- 512 MB memory
- two 15 GB Maxtor IDE hard-disks
- Voodoo3 video card with 19" monitor
- SBLive Value and SB PCI128 soundcards
-</pre>
-<p>
-
-System software includes Linux kernel 2.4.5 patched for low-latency (for more information please see my article about <a href=http://linux.oreillynet.com/pub/a/linux/2000/11/17/low_latency.html>setting up the Linux kernel for low-latency</a> published by the O'Reilly Network) and the soundcard drivers from ALSA 0.9.0beta10. I built the ALSA package with the OSS emulation enabled and Snd is quite content with that arrangement.
-<p>
-
-The reader might notice that the test machine is rather "loaded". Processing digital audio consumes system resources, so for best results you'll want a fast CPU, lots of RAM, a large fast hard-disk, and a good video system, preferably with at least a 17" monitor (multichannel displays quickly eat up viewing area, even on a 19" monitor in high-resolution modes). You can work with Snd with less powerful resources, but your mileage will certainly vary from the test system.
-<p>
-
-
-<b>Firing Up</b>
-<p>
-
-Start Snd by entering <i>snd</i> at an xterm prompt. With no command-line options or flags you will see Snd's default opening display [Figure 2]. Cool Edit users will immediately wonder what's going on here. They are accustomed to seeing a complete display when Cool Edit starts, not this rather stark and uninformative box. Expanding the window only opens up a blank grey canvas, nothing like the visual array of icons, meters, and timers in Cool Edit.
-<p>
-
-<center> <img src="images/jpg/1_02-snd_default_open.jpg">
-<p>
-<b>Figure 2.</b> Snd opened with no soundfiles loaded
-</center>
-<p>
-
-Snd has evolved within the UNIX domain, and more pointedly it has evolved in the world of computer music and sound synthesis programming languages running on UNIX machines. Unlike Cool Edit, Snd expects the user to learn and understand how to use an underlying programming language to tap the full extent of Snd's capabilities, and this factor often proves to be the major stumbling point for migrating Cool Edit users. Despite the relative ease of learning the Scheme or Ruby scripting language, users coming from Windows or the Mac simply do not expect to meet with such a requirement for the full use of the software. When a user is already proficient at the task, learning a programming language in order to use an audio editor seems not only a daunting endeavor but a pointless one as well.
-<p>
-
-The next formidable block for Cool Edit users is the management of a combined keyboard/mouse interface. As I mentioned earlier, Cool Edit is almost entirely mouse-operated. Text entry is supported, but at almost every point the mouse is the designated input device for selecting files and other data, choosing processing options and other menu items, and even setting data values (with spinboxes, sliders, and other data entry widgets).
-<p>
-
-By comparison, the default Snd is far more keyboard-intensive. Emacs users will be pleased to find that Snd's keyboard control is based on the Emacs keyboard layout, but that will be little comfort to Cool Edit users (or to <b>vi</b> adherents like myself). Control and Alt key combinations are normally used to operate the default Snd, and I advise new users to learn at least the following keystroke commands:
-<p>
-
-<pre>
- C-a position cursor at beginning of the display
- C-e position cursor at the end of the display
- C-v position cursor at the midpoint of the file
-
- C-l moves cursor to mid-display
- C-j position cursor on the next mark
-
- C-t stop playback
- C-g stop all processing
-
- C-i sends a report to the minibuffer on the status of the soundfile at the cursor position.
-</pre>
-
-Press the space bar to pause playback; press it again to continue playback from the pause point.
-<p>
-
-The following key combinations provide more precise cursor movement:
-<p>
-
-<pre>
- C-b move cursor back one sample
- C-f move cursor forward one sample
-</pre>
-
-These particular movements are especially valuable when zoomed into a file to single-sample resolution.
-<p>
-
-There are many other keyboard controls for cursor movement. Fortunately, most of the other basic operations of the program (opening and closing files, starting and stopping playback, accessing menus and menu items, navigating the display, exiting the program) can be controlled by mouse actions. The new user should have no trouble learning a dozen key combinations, but for the seriously keystroke-challenged I have provided graphic controls for positioning the cursor.
-<p>
-
-</body>
-</html>
diff --git a/tutorial/1_intro_and_build_snd.html~ b/tutorial/1_intro_and_build_snd.html~
deleted file mode 100644
index 33bb087..0000000
--- a/tutorial/1_intro_and_build_snd.html~
+++ /dev/null
@@ -1,211 +0,0 @@
-<html>
-<body bgcolor="#FFFFFF">
-
-<center><h3>Developing And Using Snd</h3></center>
-<center><h4>A Simple Guide And Tutorial For Editing Sound Under Linux</h4></center>
-<center><h4>by</h4></center>
-<center><h4><a href=mailto:dlphilp at bright.net>Dave Phillips</a></h4></center>
-<p>
-
-<u><b>INTRODUCTION TO SOUNDFILE EDITORS</b></u>
-<p>
-
-A soundfile editor (aka an audio editor) is one of the standard tools of the digital sound and music trades. Audio editors work on soundfiles in ways that are analogous to the actions of text and graphics editors upon their respective file types. Typically a modern soundfile editor includes the common cut/copy/paste routines along with a complement of signal processing and mixing modules. A graphic interface and waveform display is usually encountered (though text-mode audio editors do exist for UNIX/Linux), and point & click is the expected mode of user interaction.
-<p>
-
-As Linux grows in popularity among artists working in media such as audio/video and animation we can expect to see more interest in the system's audio capabilities and its available sound and music software. Sound workers migrating from Windows or the Mac will look for tools similar to what they have enjoyed using on their previous platforms, and one of their most frequently asked questions is "What Linux audio editor will most completely take the place of Cool Edit ?".
-<p>
-
-<a href=http://www.syntrillium.com/cooledit/>Cool Edit</a> [Figure 1] is perhaps the most popular soundfile editor available for the Windows OS family. It has been in continuous development for more than ten years: programmer David Johnston originally wrote Cool Edit as shareware for Windows 3.1, and in 1995 the Syntrillium corporation began managing the commercial development of the program (the company still maintains and distributes the shareware version available on the Internet).
-<p>
-
-<center> <img src="images/jpg/1_01-ce2000.jpg">
-<p>
-<b>Figure 1.</b> Cool Edit 2000 (courtesy Dmitri Touretsky)
-</center>
-<p>
-
-Cool Edit is a wonderful program. Its interface is easy to navigate and invites experimentation with a powerful editing and processing toolkit. I used it extensively from its earliest versions through Cool Edit 96, and when I finally stopped using Windows Cool Edit was one of the few programs I truly missed.
-<p>
-
-For various reasons it has been rather difficult to advise Cool Edit users on a Linux equivalent. While there are many soundfile editors available for Linux none are up to Cool Edit's standard, particularly with regards to transparency and ease of use. In response to this challenge I decided to work on extending and enhancing Snd, a powerful audio editor for Linux and other UNIX platforms (see Table 1 for a complete list).
-<p>
-
-<pre>
-********************************
-* *
-* Table 1: Supported platforms *
-* *
-********************************
-
- Cool Edit: Windows 95/98/ME, NT/2000, or higher
-
- Snd: DEC Alpha, SGI, HP-UX, mkLinux, Linux, PPC, SCO, Solaris, *BSD, Mac OSX
-</pre>
-<p>
-
-Like Cool Edit, Snd has been in lengthy development. Snd author Bill Schottstaedt has programmed it continuously since 1996, but his involvement with writing soundfile editors dates back to the late 1970s when he wrote the Dpysnd audio editor for the PDP-10 minicomputer. However, Snd's user interface and other basic design differences are problematic for Cool Edit users, and it is easy to miss Snd's great power and utility. I decided to expose more of that power to the novice and to try to create a working environment similar to Cool Edit. This article will relate how that work has been accomplished so far and will indicate the work that remains.
-<p>
-
-The differences and similarities between Cool Edit and Snd led me to many considerations regarding interface design and its necessary trade-offs. Cool Edit's interface is uniformly designed for editing and processing soundfiles. Almost every action and function in the program can be accessed and controlled by the mouse, and users can navigate their way through the entire program by pointing and clicking. Thanks to this uniform interface a novice easily learns and remembers the program's behavior and more quickly moves into actually working with the program. On the other hand, Snd has been designed to function within a rich sound processing and music composition software environment developed at <a href=http://www-ccrma.stanford.edu/>CCRMA</a>, Stanford University's Center for Computer Research in Music and Acoustics. That environment includes the Common LISP Music (CLM) sound synthesis language, the Common Music (CM) scoring tools for CLM and other output formats (such as Csound and MIDI), and the Common Music Notation (CMN) package. Indeed, Snd could be considered as a graphic display front-end for CLM: the standard build incorporates CLM as a built-in module, Snd provides a window called the Listener for entering code to access the module's synthesis and processing functions, and the interface provides various ways to play and represent the newly synthesized sound.
-<p>
-
-In contrast to the uniformity of Cool Edit, Snd's user interface could be thought of as "multiform" by design. In the default GUI the mouse is extensively employed, but far more program control is available through Snd's Emacs-style keyboard commands. And while considerable processing power lurks under its surface access to that power has been restricted to users willing to learn the necessary scripting language. Thus, in order to use Snd to its fullest potential the user must learn to manage Snd's more complex control interface and acquire some proficiency in the Guile/Scheme language. With that proficiency he can customize the program's appearance and behavior, warping it into quite a different Snd, something more like Cool Edit but definitely still Snd.
-<p>
-
-This article describes how such a warping has been achieved by a user with very little programming skill (I'm really a musician) and virtually no experience with LISP or Scheme. It is not a shoot-out between Cool Edit and Snd. It is actually a status report of an on-going project to externalize Snd's great internal power, using Cool Edit as a model for developing Snd's user interface. I must also note that Cool Edit 2000 has been my measuring rod, not its bigger brother Cool Edit Pro: I have focused on Snd's utility as a soundfile editor, and I consider Cool Edit Pro to be more of a multitrack hard-disk recording environment. So with this undertanding let's get into Snd...
-<p>
-
-
-<u><b>GETTING STARTED WITH SND</b></u>
-<p>
-
-<b>Requirements</b>
-<p>
-
-To build the version of Snd presented in this article you will need to install the following support software:
-<p>
-
-<pre>
- Guile 1.5.x
- OpenMotif 2.1
- ALSA 0.9.x with OSS emulation enabled
- LADSPA and its various plugins
- the Scheme customization files included in the snd-5/contrib/dlp directory
-</pre>
-<p>
-
-See the Resources section for the download locations for these packages. It is beyond the scope of this profile to give instructions on installing this software, but the documentation for each package will lead you through their respective build and install procedures. Any other requirements should be fulfilled by libraries and other software included in most mainstream Linux distributions.
-<p>
-
-The ALSA driver packages are not strictly required. You can build Snd perfectly well with either the kernel sound modules (aka OSS/Free) installed or with the excellent OSS/Linux commercial drivers from 4Front Technologies.
-<p>
-
-<b>Getting It, Building It, Installing It</b>
-<p>
-
-Prebuilt binaries for Linux i386, LinuxPPC, and Sun are available from the Snd home page. Source and binary RPMs have been prepared and are available for the i386 and PPC Linux versions. To install Snd from those packages simply follow the usual method of installing RPMs. For example, this command:
-<p>
-
-<pre>
- rpm -ivh snd-5-1.ppc.rpm
-</pre>
-<p>
-
-will install the LinuxPPC package (you will probably need root status to install the RPM file).
-<p>
-
-<i>Note: The instructions and descriptions throughout this article refer to Snd built for the i386 architecture. I was unable to test my build configuration on any other system, but I would like to hear from anyone running Snd on other platforms, particularly LinuxPPC.</i>
-<p>
-
-To build Snd yourself first download the source package (currently snd-5.tar.gz) from the <a href=http://www-ccrma.stanford.edu/software/snd/>CCRMA Snd Home Page</a> to your home directory. Unpack it with 'tar xzvf snd-n.tar.gz' (where n is the major version number), then enter your newly created snd-n directory and read the README.Snd file for the latest installation instructions and details. Run './configure --help' for a list of configuration options: This list includes options for your choice of user interface (Motif, GTK, none), soundcard driver support (ALSA, OSS, Esound), the use of Ruby instead of Guile for Snd's extension language, and support for LADSPA plugins. I use the following command options to compile Snd:
-<p>
-
-<p>
-<pre>
- ./configure --with-motif --with-ladspa --with-static-xm
-</pre>
-<p>
-
-This configuration builds Snd with a Motif 2.1 GUI, support for the LADSPA audio plugins, and built-in support for the graphics routines within Snd's Motif module (xm.so, if built separately). Default values are accepted for all other configuration options, including Snd's default support for the OSS/Free kernel sound API.
-<p>
-
-After configuring the build, run 'make' and wait for the compiler to finish building your new Snd. Become superuser (su root) and run 'make install'. The binary will be installed in /usr/local/bin and a manual page will be placed in /usr/local/man/man1.
-<p>
-
-Snd is also available via CVS. Please see the Snd home page for the details of accessing and downloading using CVS.
-<p>
-
-<!--
-<b>Why Not Native ALSA ?</b>
-<p>
-
-My build configuration includes Snd's default support for the OSS/Free kernel sound API. Including the --with-alsa option will build Snd with native ALSA support (either 0.5.x or the 0.9.x beta series), but the state of the ALSA API is rather mercurial at this time (though quickly closing in on its long-anticipated 1.0 release). Depending on your soundcard, Snd's ALSA support may not be in sync with the most current API. Running Snd with ALSA 0.5.11 native support for my SBLive Value crashed the program when trying to record, but the same driver package works perfectly (via ALSA's OSS/Free emulation mode) with Snd compiled for OSS support. However, native ALSA support and OSS emulation both worked fine for my SB PCI128. I also encountered no problems with recording or playback using the OSS/Linux drivers.
-<p>
-
-<i>Note: Fernando Lopez-Lezcano has recently hacked a work-around that allows recording in Snd under native ALSA with my SBLive. Preliminary tests indicate that the hack works well with mic, line, and CD input, but it is problematic recording from my mixer's master output channel. Hopefully a complete solution will be found soon, and I should emphasize that Snd's ALSA support is already quite functional.</i>
-<p>
--->
-
-<b>Why Motif Instead Of GTK ?</b>
-<p>
-
-Snd can be configured for a build using either Motif or the GTK graphics libraries or for a build with no GUI at all. Some users may wonder why I chose to build Snd with Motif instead of the more modern GTK. As a matter of fact I did build Snd with GTK a few times, but I prefer the amenities of Motif, particularly the keyboard acceleration. More importantly, my interface enhancements depend on the xm.so module. Work proceeds on bringing the GTK version to the same level of customization as the Motif build, but it's not there yet. A final consideration was the fact that Motif 2.1 is now freely available from the <a href=http://www.opengroup.org/openmotif/>OpenMotif</a> group, while the well-known LessTif (replaces Motif 1.2) is also available for free and is usually included with most mainstream Linux distributions. However, Snd may exhibit some odd behavior with LessTif, and author Bill Schottstaedt has indicated that he would rather not bother with Snd + LessTif problems, so I recommend the OpenMotif package.
-<p>
-
-<b>The Test System</b>
-<p>
-
-Here are the hardware specfications of the system used throughout this article:
-<p>
-
-<pre>
- 800 MHz AMD Duron
- 512 MB memory
- two 15 GB Maxtor IDE hard-disks
- Voodoo3 video card with 19" monitor
- SBLive Value and SB PCI128 soundcards
-</pre>
-<p>
-
-System software includes Linux kernel 2.4.5 patched for low-latency (for more information please see my article about <a href=http://linux.oreillynet.com/pub/a/linux/2000/11/17/low_latency.html>setting up the Linux kernel for low-latency</a> published by the O'Reilly Network) and the soundcard drivers from ALSA 0.9.0beta10. I built the ALSA package with the OSS emulation enabled and Snd is quite content with that arrangement.
-<p>
-
-The reader might notice that the test machine is rather "loaded". Processing digital audio consumes system resources, so for best results you'll want a fast CPU, lots of RAM, a large fast hard-disk, and a good video system, preferably with at least a 17" monitor (multichannel displays quickly eat up viewing area, even on a 19" monitor in high-resolution modes). You can work with Snd with less powerful resources, but your mileage will certainly vary from the test system.
-<p>
-
-
-<b>Firing Up</b>
-<p>
-
-Start Snd by entering <i>snd</i> at an xterm prompt. With no command-line options or flags you will see Snd's default opening display [Figure 2]. Cool Edit users will immediately wonder what's going on here. They are accustomed to seeing a complete display when Cool Edit starts, not this rather stark and uninformative box. Expanding the window only opens up a blank grey canvas, nothing like the visual array of icons, meters, and timers in Cool Edit.
-<p>
-
-<center> <img src="images/jpg/1_02-snd_default_open.jpg">
-<p>
-<b>Figure 2.</b> Snd opened with no soundfiles loaded
-</center>
-<p>
-
-Snd has evolved within the UNIX domain, and more pointedly it has evolved in the world of computer music and sound synthesis programming languages running on UNIX machines. Unlike Cool Edit, Snd expects the user to learn and understand how to use an underlying programming language to tap the full extent of Snd's capabilities, and this factor often proves to be the major stumbling point for migrating Cool Edit users. Despite the relative ease of learning the Scheme or Ruby scripting language, users coming from Windows or the Mac simply do not expect to meet with such a requirement for the full use of the software. When a user is already proficient at the task, learning a programming language in order to use an audio editor seems not only a daunting endeavor but a pointless one as well.
-<p>
-
-The next formidable block for Cool Edit users is the management of a combined keyboard/mouse interface. As I mentioned earlier, Cool Edit is almost entirely mouse-operated. Text entry is supported, but at almost every point the mouse is the designated input device for selecting files and other data, choosing processing options and other menu items, and even setting data values (with spinboxes, sliders, and other data entry widgets).
-<p>
-
-By comparison, the default Snd is far more keyboard-intensive. Emacs users will be pleased to find that Snd's keyboard control is based on the Emacs keyboard layout, but that will be little comfort to Cool Edit users (or to <b>vi</b> adherents like myself). Control and Alt key combinations are normally used to operate the default Snd, and I advise new users to learn at least the following keystroke commands:
-<p>
-
-<pre>
- C-a position cursor at beginning of the display
- C-e position cursor at the end of the display
- C-v position cursor at the midpoint of the file
-
- C-l moves cursor to mid-display
- C-j position cursor on the next mark
-
- C-t stop playback
- C-g stop all processing
-
- C-i sends a report to the minibuffer on the status of the soundfile at the cursor position.
-</pre>
-
-Press the space bar to pause playback; press it again to continue playback from the pause point.
-<p>
-
-The following key combinations provide more precise cursor movement:
-<p>
-
-<pre>
- C-b move cursor back one sample
- C-f move cursor forward one sample
-</pre>
-
-These particular movements are especially valuable when zoomed into a file to single-sample resolution.
-<p>
-
-There are many other keyboard controls for cursor movement. Fortunately, most of the other basic operations of the program (opening and closing files, starting and stopping playback, accessing menus and menu items, navigating the display, exiting the program) can be controlled by mouse actions. The new user should have no trouble learning a dozen key combinations, but for the seriously keystroke-challenged I have provided graphic controls for positioning the cursor.
-<p>
-
-</body>
-</html>
diff --git a/tutorial/2_custom_snd.html b/tutorial/2_custom_snd.html
deleted file mode 100644
index ee31296..0000000
--- a/tutorial/2_custom_snd.html
+++ /dev/null
@@ -1,235 +0,0 @@
-
-<html>
-<body bgcolor="#FFFFFF">
-
-<u><b>CUSTOMIZING SND: THE BASICS</b></u>
-<p>
-
-Both Cool Edit and Snd can be customized, but in Cool Edit the extent is limited to interface cosmetics, audio system configuration settings, and support for plugin architectures (though this support is very powerful). Snd is vastly more extensible, and it is by means of that extensibility that we will find a gentler and perhaps more familiar way into the depths of Snd. And yes, Snd also supports a plugin architecture (LADSPA). Let's take a closer look at how we can customize Snd to make it friendlier to Cool Edit users.
-<p>
-
-Snd's functions can be customized and extended by means of three files: the .snd initialization file, the Snd.ad X resource file, and Scheme code (i.e., files with the .scm extensions) loaded at runtime or dynamically loaded during program operation (via the Listener window). Some customization options are also available at the command-line when launching Snd. The resource and initialization files can both contain Scheme code, but I suggest placing lengthy code within its own file or files.
-<p>
-
-I use my $HOME/.snd initialization file (included in the dp_scm tarball listed in the Resources for this article) to define the cursor shape, set display colors, restrict file listings to soundfile types only, and set some audio parameters. This file also stores the information generated from selecting Save Options from the Options menu.
-<p>
-
-An X/Motif program such as Snd may utilize a resource file that defines various aspects of the Motif graphic interface such as color sets and font lists. The Snd distribution contains a resource file named Snd.ad (the extensions stands for "applications defaults") that should be copied simply as <i>Snd</i> to your $HOME directory. There isn't much to edit in Snd.ad, and you can safely leave it as it's found in the source package.
-<p>
-
-The source distribution includes a large collection of <i>scm</i> files. These Scheme code files are the keys to accessing Snd's full range of capabilities, including routines for signal processing and other special effects and for adding new features to the graphic interface (such as menus and graphic control widgets). We will return to these files throughout this article, and we will investigate some of them in detail, but for now let's continue with our introduction to the basics of Snd.
-<p>
-
-Here's how I might typically open Snd:
-<p>
-<pre>
- snd -geometry 900x800 -xrm '*autoresize: 0' -l /home/dlphilp/my_scm/misc.scm foo.snd foo.wav foo.au foo.sf2 foo.mp3 foo.W01
-</pre>
-<p>
-
-The -geometry flag is an X windows option to set the size of any X-aware application and is not unique to Snd. The -xrm flag is another X window option that notifies the X resource manager that Snd's window is to <i>not</i> automatically resize by unlimited expansion. By using this flag I can keep the display size within my monitor's screen area while adding soundfiles; otherwise, the display size will expand beyond my screen resolution.
-<p>
-
-The format extensions to those foo soundfiles should be familiar to most audio people (the last one is a file format for the Yamaha TX16W sampler) and Snd will dutifully load them all. The MP3 and sampler files are converted to RAW and SND respectively, but the conversions work only for importing sounds: Snd does not encode MP3 files nor can it directly write files in the TX16W format (see Table 2 for a full list of Snd's accepted file types).
-<p>
-
-
-<pre>
-*********************************************
-* *
-* Table 2: Comparing supported file formats *
-* *
-*********************************************
-
-Cool Edit:
- read/write:
- MPEG 3 (MP3), ACM waveform (WAV), Apple AIFF format (PCM encoded data only) (AIF),
- CCITT mu-Law and A-Law waveforms (WAV), Dialogic ADPCM (VOX), IMA/DVI ADPCM waveform (WAV),
- Microsoft ADPCM waveform (WAV), Next/Sun CCITT mu-Law, A-Law and PCM format (AU),
- Raw PCM Data, Sound Blaster voice file format (VOC), TrueSpeech (WAV), ASCII Text Data (.TXT),
- Amiga IFF-8SVX (.IFF, .SVX)
- write-only:
- RealMedia G2 (export only)
-
-Snd:
- read/write (many data formats):
- NeXT/Sun/DEC/AFsp, AIFF/AIFC, RIFF (Microsoft WAV), IRCAM (old style), NIST-sphere, no header (RAW)
- read-only (in selected data formats):
- 8SVX (IFF), EBICSF, INRS, ESPS, SPPACK, ADC (OGI), AVR, VOC, PVF, Sound Tools, Turtle Beach SMP, SoundFont 2.0,
- Sound Designer I and II, PSION, MAUD, Kurzweil 2000, Tandy DeskMate,
- Gravis Ultrasound, ASF, PAF, CSL, Comdisco SPW, Goldwave sample, omf, quicktime Sonic Foundry, SBStudio II,
- Delusion digital, Digiplayer ST3, Farandole Composer WaveSample, Ultratracker WaveSample, Sample Dump exchange,
- Yamaha SY85/SY99/TX16, Covox v8, SPL, AVI
- automatically translated to Sun 16-bit, then read/write:
- IEEE text, Mus10 SAM 16-bit (modes 1 and 4), IBM CVSD, AVI, NIST shortpack, HCOM, Intel and Oki (Dialogic) ADPCM,
- MIDI sample dump, G721, G723_24, G723_40, IFF Fibonacci and Exponential
- automatically translated (with appropriate Scheme module) to 16-bit 44.1 kHz stereo RAW, then read-only:
- MP3
-</pre>
-<p>
-
-The <b>-l</b> flag informs Snd that a Scheme file is to be loaded along with the rest of the program's normal functions. I utilize several Scheme files from the Snd source package to customize the program with such amenities as an effects menu, various time-domain and frequency-domain editing routines, and other significant interface extensions and enhancements.
-<p>
-
-Multiple instances of this flag may be entered at the command-line, but one Scheme file can '#include' other Scheme files by using the <i>load</i> command. For example, my misc.scm file begins by including some of the distribution Scheme files as well as some custom code for my own extensions:
-<p>
-
-<pre>
- (load "/home/dlphilp/snd-5/snd-motif.scm")
- (load "/home/dlphilp/snd-5/examp.scm")
- (load "/home/dlphilp/snd-5/dsp.scm")
- ...
- (load "/home/dlphilp/my_scm/special-menu.scm")
- (load "/home/dlphilp/my_scm/new-effects.scm")
-</pre>
-<p>
-
-But the easiest method for loading your often-used Scheme files is to place statements in your $HOME/.snd file similar to these :
-<p>
-
-<pre>
- (set! %load-path (cons "/home/dlphilp/my_scm" %load-path))
- (set! %load-path (cons "/home/dlphilp/snd-5" %load-path))
- (set! snd-remember-paths #t)
-
- (load-from-path "misc.scm")
-</pre>
-<p>
-
-After adding those lines you need only specify the desired file to be loaded, without naming its entire path. For instance, the examples above could be entered in misc.scm in this fashion:
-<p>
-
-<pre>
- (load-from-path "snd-motif.scm")
- (load-from-path "examp.scm")
- (load-from-path "dsp.scm")
- ...
- (load-from-path "special-menu.scm")
- (load-from-path "dp-new-effects.scm")
-</pre>
-<p>
-
-Snd will then look for those files in my specified load paths.
-<p>
-
-Other lines in my misc.scm will turn on a "hidden controls" dialog, check for unsaved edits before exiting Snd, summon a panel for listing and editing marks, and add many other features available from the Scheme files loaded above. We'll look more closely into misc.scm later, but for now it is important to note that before using my misc.scm to customize Snd you must edit the load path to indicate where you have unpacked the Snd sources.
-<p>
-
-Snd's graphic display can also be configured using the -notebook, -separate, and -horizontal flags. The notebook flag will present your soundfiles as though they were on pages in a tabbed spiral-bound notebook [Figure 3], while the -separate flag will open the files in separate windows [Figure 4]. Snd's normal graph view stacks multiple soundfiles in a vertical fashion, but the -horizontal flag will place them side by side [Figure 5].
-<p>
-
-
-<center> <img src="images/jpg/2_01-snd_notebook.jpg">
-<p>
-<b>Figure 3.</b> The notebook layout
-</center>
-<p>
-
-<center> <img src="images/jpg/2_02-snd_separate.jpg">
-<p>
-<b>Figure 4.</b> The separated layout
-</center>
-<p>
-
-<center> <img src="images/jpg/2_03-snd_horizontal.jpg ">
-<p>
-<b>Figure 5.</b> The horizontal layout
-</center>
-<p>
-
-Finally, opening Snd with the --help flag will result in this display of information:
-<p>
-
-<p>
-<pre>
- [dlphilp at localhost dlphilp]$ snd --help
- Snd is a sound editor. Peruse the 'help' menu or try the snd-help function for help.
- This is Snd version 5.2 of 30-Aug-01:
- Xen: 1.0, Guile: 1.5.0
- OSS 3.9.8
- Sndlib 13.7 (29-Aug-01, int24 samples)
- CLM 1.51 (6-July-01)
- gsl: 0.9.1
- Motif 2.1.30 X11R6
- Xpm 3.4.11
- with LADSPA
- Compiled Aug 30 2001 09:40:29
- C: egcs-2.91.66 19990314/Linux (egcs-1.1.2 release)
- Libc: 2.1.3.stable
-</pre>
-<p>
-
-<u><b>A LOOK AT MY SND</b></u>
-<p>
-
-Figure 6 shows how my customized Snd appears with one soundfile loaded and its time-domain and frequency displays both opened. The marks panel and edit history list are active, and I have also opened the Listener and the Control Panel. Note that you can open or close any sashed panel by grabbing and moving the sash key. Note also the menus added to the main menu bar: the Special, Marks, and Panic Control menus are not standard with Snd, I have added them via my customization files.
-<p>
-
-<center> <img src="images/jpg/2_04-snd_full_defined.jpg">
-<p>
-<b>Figure 6.</b> Full-throttle Snd, with definitions
-</center>
-<p>
-
-<u><b>INSIDE A SCHEME FILE</b></u>
-<p>
-
-Scheme is a LISP-like programming language and Guile is its interpreter. Files written in Scheme are processed by Guile and the results returned to Snd. We have seen what such files can add to Snd, so now let's take a look inside a Scheme module to see how it worksr. We'll use excerpts from my misc.scm file for our example: The file is too long to quote entirely, but I have placed the <a href="files/misc.scm.txt">complete text of misc.scm</a> on-line for interested readers. It is also included in my Snd customization package listed in the Resources at the end of this article.
-<p>
-
-We know already that misc.scm starts by loading a variety of other Scheme files. Immediately after those files are loaded I make the following calls to them from within misc.scm:
-<p>
-
-<pre>
- (title-with-date) ;;; puts the filename and date in the xterm titlebar, from examp.scm
- (keep-file-dialog-open-upon-ok) ;;; keeps the file dialog open after clicking on OK, helpful when loading many files, from snd-motif.scm
- (make-hidden-controls-dialog) ;;; places the Open Hidden Controls entry in the Options menu, from snd-motif.scm
- (check-for-unsaved-edits #t) ;;; checks for unsaved edits before closing, from extensions.scm
- (add-hook! after-open-hook show-disk-space) ;;; reports available disk space to the minibuffer, from snd-motif.scm
- (add-mark-pane) ;;; adds the mark panel automatically after the first mark is created, from snd-motif.scm
- (add-sound-file-extension "W01") ;;; adds the soundfile extension W01 (for Yamaha TX16W sampler files) to Snd's internal list of recognized file formats, from extensions.scm
-</pre>
-<p>
-
-These lines demonstrate how to customize Snd using Scheme modules from the source distribution. The actual functions are defined in other pre-loaded Scheme files but are called from misc.scm. Many of Snd's most interesting features are defined throughout the source package's various Scheme files but they are not activated by default. Much of my preparatory work involved studying the various Scheme modules to find what treasures they contained.
-<p>
-
-This code actually adds a new function to Snd and a new entry to an existing menu:
-<p>
-
-<pre>
- ;;; -------- Cut selection -> new file
-
- (define (cut-selection->new) ;;; give the function a name
- (if (selection?) ;;; if there is a selection
- (let ((new-file-name (format #f "sel-~D.snd" selctr))) ;;; make a new filename numbered by selctr
- (set! selctr (+ selctr 1)) ;;; increment selctr
- (save-selection new-file-name) ;;; save the selection with the new filename
- (delete-selection) ;;; cut out the selection
- (open-sound new-file-name)))) ;;; open the new file
-
- (add-to-menu 1 "Cut Selection -> New" cut-selection->new) ;;; add "Cut Selection -> New" to menu number 1 (the Edit menu)
-</pre>
-<p>
-
-Misc.scm can itself act as a holder for Scheme code activated elsewhere. I added this brief block in order to add an Unselect function to Snd:
-<p>
-
-<pre>
- ;;; -------- Deselect function
-
- (define (deselect-all) ;;; name the new function
- (if (selection?) ;;; if there is a selection
- (set! (selection-member? #t) #f))) ;;; negate its existence (reset its state from true to false)
-</pre>
-<p>
-
-However, I placed the call in Snd's popup.scm for placement in the channel graph display popup menu.
-<p>
-
-These examples indicate how I have gone about customizing Snd. I began by making sure that the baseline features as enumerated by Curtis Roads (and listed in the next section of this article) were present and easily accessible, then I added functions and operations suggested by the responses to my query to Cool Edit users. I must emphasize that I myself wrote virtually no code (well, maybe a wee tiny bit): as stated earlier, my objective has been to make more of Snd's inherent processing and editing power more visible and accessible to users, and thanks especially to the routines in snd-motif.scm (and a lot of help from Bill Schottstaedt) I believe I'm well on the way to meeting that objective.
-<p>
-
-
-</body>
-</html>
diff --git a/tutorial/3_editing_and_processing_snd.html b/tutorial/3_editing_and_processing_snd.html
deleted file mode 100644
index 81d16fa..0000000
--- a/tutorial/3_editing_and_processing_snd.html
+++ /dev/null
@@ -1,406 +0,0 @@
-
-<html>
-<body bgcolor="#FFFFFF">
-
-
-<u><b>A BRIEF TUTORIAL FOR SND</b></u>
-<p>
-
-Before beginning this tutorial you should load the following Scheme files into Snd. These files are included with the Snd source package:
-<p>
-
-<pre>
- snd-motif.scm provides Motif GUI components (sliders, buttons, entry boxes)
- examp.scm various examples
- extensions.scm various extensions
- dsp.scm some DSP code
- draw.scm drawing routines
- env.scm envelope-specific code
- enved.scm envelope editing routines
- marks.scm mark-related procedures
- mix.scm routines for mixing soundfiles
- moog.scm the Moog filter code
- popup.scm provides various popup menus
- rubber.scm code to stretch/contract sound
-</pre>
-
-The following files are my own additions (see the Resources at the end of this article):
-<p>
-
-<pre>
- special-menu.scm adds a special menu to the main menu bar
- my_backgrounds.scm some background pixmaps
- marks-menu.scm adds a menu for mark processes
- dp-new-effects.scm adds an expanded effects menu
- panic.scm adds a panic menu for stopping Snd processes
- misc.scm includes all of these files and some miscellaneous code
-</pre>
-
-See the previous section for instructions on how to load these files, then launch Snd with this command string:
-<p>
-
-<pre>
- snd foo.wav
-</pre>
-<p>
-
-Loading the soundfile is optional. You can of course add new soundfiles via the File/Open dialog box at any time. The customization package adds some nice features to the dialog, including buttons for toggling a soundfiles-only listing and for playing the selected file. Multichannel soundfiles are listed in different colors, and the dialog displays useful information about the selected file. [Figure 7]
-<p>
-
-<center> <img src="images/jpg/3_01-snd_file_popup.jpg">
-<p>
-<b>Figure 7.</b> The File dialog
-</center>
-<p>
-
-
-
-<b>Documentation</b>
-<p>
-
-Bill Schottstaedt has provided extensive and well-written documentation for Snd in the snd.html file (or snd1.html if your browser supports frames). The HTML documentation is quite complete and should be considered the definitive reference. I advise all users to read at least the "Getting Started" section. As mentioned earlier there is also a manual page, but it is very brief, containing only a description of the program and a list of some of the command-line flags. I'll cover some of the material found in the HTML documentation, but in a more tutorial fashion.
-<p>
-
-<b>The Heart Of The Matter</b>
-<p>
-
-In his <cite>Computer Music Tutorial</cite> Curtis Roads lists these basic functions of soundfile editors:
-<p>
-
-<ul>
- <li> cut/copy/paste
- <li> splice/insert/replace
- <li> move samples
- <li> mix tracks
- <li> syncronize files/tracks
- <li> compress/expand time scale
- <li> pitch shifting
- <li> equalization/filtering
- <li> sample rate conversion
- <li> transfer sounds to external sampler
- <li> displays in different time formats
- <li> display multiple views of file
- <li> display multiple files simultaneously
- <li> independent X/Y axis control
- <li> find maximum sample value
- <li> display amplitude envelope in various representations (db, peak, RMS)
- <li> edit pitch and amplitude envelopes
- <li> varispeed playback
- <li> print out display of samples
- <li> spectrum analysis
- <li> segment and label musical notes in sample stream
-</ul>
-
-Snd meets nearly all the baseline criteria in that list. Direct I/O with external samplers is perhaps better considered as a function of hardware support, although Snd does support the MIDI Sample File Dump standard as well as a variety of sampler-specific file formats. The identification of a sound sample's musical note values is still technically very problematic and is not commonly found in the popular soundfile editors for Windows, the Mac, or Linux. All the other operations are present and accounted for in Snd.
-<p>
-
-Beyond the baseline criteria I've culled a set of common operations from the results of an informal poll of Cool Edit users on the mail lists for Csound, LAD (Linux Audio Developers), and Common Music. Those users most frequently employed the following functions and operations in Cool Edit:
-<p>
-
-<ul>
- <li> recording and editing large files
- <li> trimming files
- <li> accurate edits at the single-sample level
- <li> noise reduction and click removal
- <li> varispeed play
- <li> amplitude editing (gain, normalization, fade in/out, crossfade)
- <li> zoom view and play zoomed view
- <li> unlimited undo/redo
- <li> spectral view
- <li> FFT filtering
- <li> adding reverb and other effects
- <li> play 32-bit files
- <li> file format conversion
- <li> DirectX plugins
- <li> compression/limiting dynamic range
-</ul>
-
-With only a few exceptions Snd again meets the criteria. Noise reduction and compression/limiting are still in development, and of course DirectX plugin support is absent. However, Snd does support the LADSPA plugins, and there are a few other ways of plugging into Snd that we'll look at later.
-<p>
-
-However, it is one thing to say that Snd has this or that specific function available, and it is another thing to access the function or operation. In classic Snd many of the baseline functions and Cool Edit-style edits are invoked from the Listener via the Guile/Scheme language. However, the most recent releases of Snd have added a number of widgets and menu items to graphically access its editing tools and signal processors. Power users still have the Listener, but new users can now more easily make their way into Snd's considerable toolkit.
-<p>
-
-Before we start using that toolkit let's see how to determine an editing area in Snd.
-<p>
-
-<u><b>BASIC EDITING AREAS OF SND</b></u>
-<p>
-
-Edit areas in Snd include the whole file or files, the area between marks, and the selection (highlighted) area. The assumed edit area is the whole file. At this time most of the effects are applied only to whole files, but work is underway to add options to restrict processing to the highlighted selection or to a marked area.
-<p>
-
-<b>Marked Areas</b>
-<p>
-
-Marks can be placed into a file in three different forms. Type Ctrl-m or select "Add mark" from the graph display popup menu to add a normal mark into your file. Named marks are created with the Ctrl-x-m keyboard combination, and sync'd marks are added with the Ctrl-M command. In each case, the cursor position defines the mark insert point in the graph display. Delete marks via the channel graph popup: Set the cursor near the mark you want to delete, select "Delete mark" from the popup, and it's gone.
-<p>
-
-Any mark can be moved by left-clicking and holding on the handle at the top of the mark and carrying it with the mouse to a new location. You can toggle playback from any mark position by clicking on the triangular tab at the bottom of the mark, or you can drag the mark tab to "scrub" through the sound data. Marks can be used to move sections of a file forwards or backwards in time: hold down the Control key and left-click on the mark handle, then drag the mark forward to replace the existing data (if any) with the dragged material, or drag the mark backwards to shift the soundfile back and to add silence for the space of the drag. Marks can be used to define sample-accurate boundaries for processing a selection area: Place your marks at single-sample resolution, then select "Define selection by marks" from the Marks menu, and voilà, the marked area will become a sample-accurate highlighted selection area.
-<p>
-
-Named marks are simply normal marks with names added for display and identification. If Snd's marks.scm package is loaded the report-mark-names function will display mark names in the minibuffer during playback.
-<p>
-
-Sync'd marks are marks whose actions are syncronized. Whatever is done with one mark will be done for all others sync'd with it: move one mark and the others will follow, even across different channels and files. Click on any sync'd mark's tab and multichannel playback will begin from the position of each sync'd mark.
-<p>
-
-You can sync previously-placed normal and named marks with the Start/Stop mark sync items in the Marks menu provided by the customization package. That menu includes many other mark-related editing functions, such as crop and trim operations, loop-play between marks, and a "fit selection to marks" function that time-scales a selected (highlighted) area and fits it between two marks, mixing it with any pre-existing material in the same marked area.
-<p>
-
-<b>Selected Areas And Regions</b>
-<p>
-
-A highlighted selection area is made by holding down the left mouse button anywhere within the channel graph display and sweeping the mouse to the left or right. The swept area will be highlighted; release the mouse button to finalize your selection (a Select All/Unselect All function is also available from the channel graph popup menu). Right-click anywhere within the highlighted area to pop up a menu of actions to perform on the selection, such as playback, loop play, reverse, and copy-to-new.
-<p>
-
-A selected area defines a region. View/Regions will call up the Regions Browser [Figure 8], a dialog window that includes a list of all the selections you've made up to that point, including selections from files that have been closed. At present, the browser is not too useful. You can play individual regions and send them to new edit channels, you can lock regions from deletion or further editing, and you can delete selections from the browser.
-<p>
-
-<center> <img src="images/jpg/3_02-snd_regions.jpg">
-<p>
-<b>Figure 8.</b> The Regions browser
-</center>
-<p>
-
-Snd's examp.scm file includes code for two forms of sequential playback of regions. This command in the Listener:
-<p>
-
-<pre>
- (region-play-sequence '(0 2 1))
-</pre>
-<p>
-
-will play regions 0, 2, and 1 in an uninterrupted sequence. This command:
-<p>
-
-<pre>
- (region-play-list (list (list 0.0 0) (list 0.5 1) (list 1.0 2) (list 1.0 0)))
-</pre>
-<p>
-
-will play region 0 at 0.0 seconds, region 1 at .5 seconds, and regions 2 and 0 together at 1 second after the start. Hopefully the regions browser will eventually incorporate these commands into a set of graphic controls.
-<p>
-
-<b>Mixes And Tracks</b>
-<p>
-
-Standard soundfile mixing operations include functions to paste, insert, and replace data. Paste-mix blends the mix file (which Snd just calls a mix) with the original data, insert-mix splices in the mix at the cursor point (lengthening the original by the length of the mix data), and replace-mix wipes out the original data and replaces it with the new.
-<p>
-
-Snd provides a few different methods of paste-mixing. Double-clicking on a soundfile name in the File/Mix dialog will paste-mix that file into the active channel. Alternately, you can drag a highlighted file name from the entry box of any file dialog in Snd and drop it into any channel graph display. Paste-mix is also available from the channel graph popup menu, but in this case the mix source is the currently selected area. Make your selection, position the cursor at the mix point, then click on Mix Selection from the popup menu. In all these methods the mix is pasted in at the cursor position, and a waveform graphic will appear at the top of the channel display. You can reposition the mix waveform by clicking and dragging the handle at the left end of the graph [Figure 9].
-<p>
-
-<center> <img src="images/jpg/3_03-snd_mix.jpg">
-<p>
-<b>Figure 9.</b> The Mix panel
-</center>
-<p>
-
-Insert-mix is present as an insert-file action and as an insert-selection operation. To make things easy, I've added an Insert File item to the menu created by the special.scm file. Click on the menu item, select your file from the dialog box, and the original data will be pushed aside by the inserted mix data. The Edit menu and the channel graph popup menu both provide an Insert Selection function that operates the same way using the selected area for the mix data. Note too that middle-clicking will insert the last selected area at the cursor position for very fast insert-mixing.
-<p>
-
-Mix by replacement is also available from the Edit and channel popup menus. Once again the mix point is the cursor location in the active channel, and any highlighted data will be mixed into the channel, replacing any existing data from the cursor forwards.
-<p>
-
-Here's a rather elaborate replace-mix technique for a precise remove/edit/replace operation: Select an area in your soundfile and copy it to a new file. Snap a pair of marks to the original selection boundaries, then zero out the selected area (copy-to-new, snap-marks, and zero-out are all found in the selection area popup menu). Now switch to the copied selection (named newf-n.snd by default), edit and add effects to taste, click on Edit/Select All, then switch back to the original channel. Position the cursor anywhere before the first marker and type C-j to accurately position the cursor at the mark point. Right-clck in the channel graph display and choose "Mix selection" or "Replace with selection" from the popup menu to replace the zeroed out area with your edited region. If the mix material is longer than the original selection area the mix method will determine whether the mix blends with existing data or replaces it.
-<p>
-
-Other mixing functions are available via the Mix Panel (see Figure 9), including a way to organize your mix files into tracks. A track is a specifier for a group of mix files: When mixes are defined into a track, any action on one of the track members occurs upon all other members sharing the same track identifier. If you move one mix file, all other mix files with the same track number will be moved too. The Mix Panel also includes speed and amplitude sliders that again can be used to adjust one or several mix files at once. Note that clicking on any mix file in the channel graph will update the mix panel to represent the selected mix.
-<p>
-
-Mixing creates temporary files stored at Snd's $TMPDIR directory. These files add up, so make sure $TMPDIR points to a spacious directory. I put the following line in my $HOME/.bashrc file to set the temporary files in a large empty directory:
-<p>
-
-<pre>
- export TMPDIR=/usr/local/dump
-</pre>
-<p>
-
-Finally, be aware that by default the various mix procedures do not automatically normalize or scale amplitudes. You may want to adjust the gain of your original file, or you can use the Mix Panel amplitude slider to scale the volume of the mix file (or files).
-<p>
-
-<u><b>IF COOL EDIT CAN DO IT...</b></u>
-<p>
-
-Now that we know how to designate edit areas let's perform some of those operations commonly employed by Cool Edit users to see how Snd does the same things.
-<p>
-
-<b>Amplitude And Dynamics Processing</b>
-<p>
-
-Gain and normalization are simple processes. Go to the Effects menu, select the appropriate process, adjust the value slider in the GUI widget, and click on the DoIt button. Most (but not yet all) effects in Snd will call a small hourglass icon to indicate elapsed time during the processing; when the hourglass has filled its bottom half the process is ended and the channel display will update automatically. Gain and normalize can be applied to the whole file, highlighted selection, or marked area.
-<p>
-
-<b>Cutting And Trimming Files</b>
-<p>
-
-The easiest way to cut data from a file is to select it with the mouse, then right-click in the selected area to open the Selection popup menu. From there you can choose to delete or erase the area or to crop the data surrounding the selected area. Alternately, you can cut or copy your selection to a new channel. If you sync a group of files you can perform the same cut over all the sync'd files. Trimming and cropping are also mark operations, available as Scheme code or items in the Marks menu. Trim cuts the file length before or behind a mark, crop cuts everything outside a marked area.
-<p>
-
-<b>Zooming And High-resolution Edits</b>
-<p>
-
-Snd has excellent zoom controls. You can use the horizontal sliders beneath a sound's channel graph display to adjust zoom factor and and viewing position, or you can use the keyboard's arrow keys to zoom in or out and move the display view from left to right. The zoom focus can be controlled from the whole-file view down to the individual sample level. To the left of the channel graph display you can see Snd's vertical resolution sliders. These sliders are especially helpful when editing files with very low amplitudes. You can quickly set the x/y axes to minimum or maximum view by middle-clicking at either end of the slider trough.
-<p>
-
-Some Cool Edit users specifically mentioned that program's use of sinc interpolation between sample points. According to one user this method of interpolation yields smoother sound, reducing the possibility of clicks after an edit. Snd employs linear interpolation between sample points, but it also provides a smooth-sound function similar to sinc interpolation for smoothing the results of some editing processes. Snd's default interpolation is quite good though, and all operations available for marked and selected areas can be applied to a single sample.
-<p>
-
-Sinc interpolation is employed by default for Snd's high-quality sample-rate conversion. The sinc width can be set to improve the lowpass filter during conversion, and sinc interpolation can be toggled to linear interpolation for lower-powered machines.
-<p>
-
-<b>Undo/Redo</b>
-<p>
-
-Snd has an "unlimited" undo/redo function. Snd's Edit History panel (see Figure 6) provides another way to undo/redo and compare edits: simply click on any listing in the panel and the channel graph immediately displays that particular edit stage. Very sweet...
-<p>
-
-<b>Varispeed And Other Realtime Controls</b>
-<p>
-
-From the main menu click on View/Show Controls. A set of sliders and other control widgets will unfold beneath the active file's channel graph display (see Figure 6). All of the sliders work in realtime: the amplitude and speed controls are always active, the others are toggled on or off by a check-box to the right of their displays. Select Options/Hidden Controls to open a bank of sliders to fine-tune some of the effects parameters [Figure 10]. In case you were wondering, the icon to the right of the speed slider is a pair of arrows (<-->) for toggling playback direction, in realtime of course.
-<p>
-
-<center> <img src="images/jpg/3_04-snd_hidden_controls.jpg">
-<p>
-<b>Figure 10.</b> The hidden controls
-</center>
-<p>
-
-
-Realtime response was quite smooth for most of the effects. High values for the reverb scaler tended to distort the sound, and the Contrast effect was particularly sensitive. Time compress/expand and pitch-shifting performed smoothly over a looping playback (an ideal setup for the musician trying to learn a difficult passage from a recording), and within reasonable scaling limits the reverb was equally responsive.
-<p>
-
-<b>Filtering And Envelope Editing</b>
-<p>
-
-Snd provides two graphic filter editors, one below the default control panel display and one in the Edit menu. Several pre-defined filters are also available in the Effects menu.
-<p>
-
-Pull up the control panel's sash from its default position to uncover a frequency response envelope editor for an arbitrary-order (even-numbered) FIR filter. Plot your envelope points, set the order of the filter by clicking the tiny increment/decrement buttons to the right of the data box labelled "filter:", then press Apply to filter the active soundfile. Judge the results, undo as necessary and repeat process until satisfied.
-<p>
-
-Select Edit Envelope from the Edit menu to open another graphic editor [Figure 11]. This one is more general-purpose: you can create linear or exponential envelopes for amplitude (amp), frequency (flt), and sample rate conversion (src), and you can apply them to the whole file or just to the selected area. The frequency response envelope is applied to an arbitrary-order FIR or FFT filter, the exponentiation factor can be adjusted (with the slider labelled "exp:"), and envelopes can be named and saved to files for later use.
-<p>
-
-<center> <img src="images/jpg/3_05-snd_enved.jpg">
-<p>
-<b>Figure 11.</b> The envelope editor
-</center>
-<p>
-
-The Effects menu includes a variety of pre-fabricated filters. Butterworth filters are available in band-pass, band-reject, high-pass, and low-pass configurations, two comb filters are on the menu, and there's even a Moog-style lowpass-filter (24db/oct) with variable Q. More filters and filter parameter controls are available via the Listener, and work proceeds to bring more of that code into the Effects menu and the graphic control widgets.
-<p>
-
-<b>Reverb And Other Effects</b>
-<p>
-
-We have already seen the realtime reverb controls available on Snd's control panel. The algorithm employed for that reverb is from composer Michael McNabb's Nrev, and it can now be called from the Effects menu with more of its parameters exposed. Composer John Chowning's reverb also produces a good sounding reverb with only two controls.
-<p>
-
-Convolution is an excellent means of applying a natural reverberation to a soundfile. The process typically requires a soundfile to be effected and an impulse response (IR) file to supply the effect. IR files are recordings of very brief sound events such as a finger-snap or a firecracker in an interesting acoustic environment. When a soundfile is convolved with an impulse response file it will sound as though it had been originally recorded in that environment. Snd's "simple" convolution is surprisingly effective, and I had great fun reverberating soundfiles with impulse responses from subway stations, stone cathedrals, and gigantic gas tanks. I also rediscovered the value of the Normalize amplitude scaler: the convolution produced a soundfile with a greatly expanded dynamic range, but normalizing scaled the data back to the range comfortable for my 16-bit audio device.
-<p>
-
-The Effects menu includes other common signal processing routines such as flange, echo, and time-scaling/pitch-shifting. It also includes less-common routines such as cross synthesis and adaptive saturation. All of these processing options have been available via the Listener, but the graphic controls invite experimentation without the language learning curve.
-<p>
-
-<b>Spectral View</b>
-<p>
-
-Snd's frequency analysis displays are impressive. Your soundfile can be analyzed by any of nine transforms, with more than a dozen window types and sizes. The spectral view itself can be controlled by the keys of your numeric keypad: The arrow keys control the perspective, the forward slash and asterisk keys control the transform size, and the plus and minus keys adjust the analysis window's "hop" size. The keypad Enter key resets the analysis defaults. You can also control the resolution of the x axis by left-clicking on the axis display and dragging the mouse to zoom in and out of the analysis data. Many other options are available from the frequency graph popup menu [Figure 12] or from Options/Transform Options on the main menu bar.
-<p>
-
-<center> <img src="images/jpg/3_06-snd_fft_popup.jpg">
-<p>
-<b>Figure 12.</b> Popup menu for the frequency-domain display
-</center>
-<p>
-
-<b>32-bit File Support And File Format Conversion</b>
-<p>
-
-Snd correctly reads and displays 32-bit soundfiles, automatically scaling the output for 16-bit audio equipment. I tested Snd's 32-bit capability by using Csound to create two 32-bit files, one in IRCAM's SF format and the other as a WAV file. Both soundfiles loaded and played without complaint. Note however that my soundcard is certainly not 32-bit capable; Snd performs an internal conversion to 16-bits to accomodate typical consumer-grade soundcards.
-<p>
-
-You can convert the soundfile's format with File/Save As. That dialog includes selection boxes for header style and data representation (with default associations), an entry box for comments, and the default sampling rate (user-definable).
-<p>
-
-<b>Plugin Support And Dynamically Loaded Modules</b>
-<p>
-
-If Snd is configured --with-ladspa you can dynamically load LADSPA plugins (see my <a href=http://linux.oreillynet.com/pub/a/linux/2001/02/02/ladspa.html>article on LADSPA plugins</a> on the O'Reilly Network). I have "hard-coded" a number of widgets to provide graphic controls for LADSPA plugins as stand-alone effects, but loading them via the Listener is not terribly diffcult. Here's a basic example:
-<p>
-
-<pre>
- (apply-ladspa (make-sample-reader 0) (list "cmt" "delay_5s" .3 .5) 12000 "/home/dlphilp/soundfiles/bunt.wav")
-</pre>
-<p>
-
-This sequence tells Snd to read a block of 12000 samples from the bunt.wav file, starting at sample number 0, and apply the delay_5s LADSPA plug-in (found in the cmt.so library) with a delay time of .3 seconds and a 50/50 balance of uneffected and effected sound.
-<p>
-
-<u><b>FILE PLAYBACK AND RECORDING</b></u>
-<p>
-
-<b>Playing Files</b>
-<p>
-
-Play commands are available everywhere in Snd. The Play button toggles playback from the start of the file; when toggled off the cursor returns to its original position. Normal play and loop play are available for the whole file, highlighted selection, or marked area. The channel graph popup menu includes commands for normal play (from the start of the file), play from cursor position, play previous edit, and play the original unedited file. Use sync'd marks for multichannel play as described above. Press the space bar to pause playback, press again to continue playback from the stop point. Type C-t to stop the player at any time, or select Stop Play from the Panic Control menu created by the customization package.
-<p>
-
-Snd will load and play monaural, stereo, and multichannel soundfiles in 8, 16, or 32 bit resolution. If your audio hardware supports true multichannel playback Snd will distribute the channels properly, but it will also nicely fold multichannel files into stereo output if the hardware is not capable of handling more than two channels. You can also make a multichannel soundfile by specifying the desired number of channels when creating a new empty file from the File/New dialog.
-<p>
-
-<b>Recording With Snd</b>
-<p>
-
-Go to File/Record to open Snd's Recorder window [Figure 13]. In this window you can monitor and record audio input, set system sound levels, and save your recordings in a variety of file formats. You can specify a filename for your recording, along with its sample rate and number of channels, and if necessary you can adjust the record buffer size.
-<p>
-
-<center> <img src="images/jpg/3_07-snd_recorder.jpg">
-<p>
-<b>Figure 13.</b> The Recorder window
-</center>
-<p>
-Snd's default input device is the microphone channel of the system soundcard mixer. To change the recording device, close the Recorder and make this entry in the Listener:
-<p>
-
-<pre>
- (set! (recorder-in-device) mus-audio-line-in)
-</pre>
-
-Reopen the Recorder and the input channel will now be set to the line-in of your soundcard mixer. To set the input channel back to the microphone, close the record window and run this command in the Listener:
-<p>
-
-<pre>
- (set! (recorder-in-device) mus-audio-microphone)
-</pre>
-
-Replace 'microphone' with 'cd' to record from your CD player. Or you can skip all that typing by using a widget I put together for my SBLive (found in the Special menu), but you'll still need to open/close the Recorder window to reset the input device.
-<p>
-
-The instructions above are valid for ALSA, OSS/Linux, and the kernel drivers. However, if you're using the ALSA drivers you have an extra record input option: you can tap the soundcard mixer's master output as a recording source, letting you record the output from programs like <a href=http://www.bitmechanic.com/projects/freebirth/>Freebirth</a> (a cool synth/sample-player/sequencer with, alas, no file-save function) or from Internet streaming audio broadcasts. This Listener command correctly informs the Recorder to take its input from the soundcard mixer's master output:
-<p>
-
-<pre>
- (set! (recorder-in-device) mus-audio-line-out)
-</pre>
-
-It will not reset the system mixer, because Snd is slightly out of sync the current ALSA packages. Any ALSA-aware mixer should include a switch to set the master output as the record source, and hopefully, Snd's support for native ALSA features will improve after ALSA reaches version 1.0. Until then, ALSA's OSS emulation layer works perfectly for Snd compiled with support for the OSS/Free (kernel sound) API.
-<p>
-
-<i>Note: Snd hacker Fernando Lopez-Lezcano has been working to improve Snd's support for native ALSA. Snd does support ALSA 0.5.x (now deprecated) and 0.9.x, though your mileage with Snd + ALSA may vary according to your particular soundcard. See the documentation in the latest Snd packages for the latest information regarding Snd and ALSA.</i>
-<p>
-
-Once you've selected your recording device you can set its level from the mixer in the top right corner of the Recorder window. When you are satisfied with the level settings, activate the Recorder's input channels by pressing one or both of the A/B buttons beside the input level meters. Now give your recording a new name and press the Record button; when you've finished, press the Done button (it replaced Record). If you toggled the Autoload button your new file will be loaded immediately after recording.
-<p>
-
-You can also start recording only after the input signal passes a certain level. When you move the Trigger slider the Record button becomes a Triggered Record button: press it, but no recording will occur until the input level reaches the amplitude set by the threshold slider.
-<p>
-
-Snd's recording facilities are rather Spartan, but Snd was not designed to replace a hard-disk recording system. The Recorder is a useful tool, and if your recording needs are not particularly heavy it may suit your purpose perfectly.
-<p>
-
-</body>
-</html>
diff --git a/tutorial/4_advanced_snd.html b/tutorial/4_advanced_snd.html
deleted file mode 100644
index 4d00c1d..0000000
--- a/tutorial/4_advanced_snd.html
+++ /dev/null
@@ -1,88 +0,0 @@
-
-<html>
-<body bgcolor="#FFFFFF">
-
-<center><h3>SOME ADVANCED USES OF SND</h3></center>
-<p>
-
-There are too many other untapped resources in Snd to cover in this article, such as the scanned synthesis display, the FM violin controls, and running Snd remotely. But before we leave let's take a brief look at a few advanced uses of Snd...
-<p>
-
-<b>Batch Processing And GUI-less Snd</b>
-<p>
-
-You may recall that Snd can be compiled without support for any GUI. In this form it can be used as an interactive interpreter for Scheme commands, as seen in the following very simple sequence:
-<p>
-
-<pre>
- [dlphilp at localhost snd-5]$ ./snd
- snd> (open-sound "bunt.wav")
- 0
- snd> (play)
- #t
- snd> (close-sound 0)
- (null)#f
- snd> (exit)
-</pre>
-
-The call to open bunt.wav returns the file ID, the play command plays any files opened (all at once if several are loaded), and close-sound closes out the file with the particular ID.
-<p>
-
-Snd with no GUI can also function as a batch processor for Scheme scripts. For example, this test.scm file:
-<p>
-
-<pre>
- (open-sound "bunt.wav")
- (scale-by 0.5)
- (save-sound-as "bunt-scaled.snd")
- (exit)
-</pre>
-
-will open bunt.wav, reduce its amplitude by half, save it as a new file, and exit. Run it with this command under Snd with no GUI:
-<p>
-
-<pre>
- snd -l test.scm
-</pre>
-
-Obviously far more complex scripts can be assembled, and the interested reader is advised to refer to the relevant sections of Snd's documentation.
-<p>
-
-<b>Other Dynamically-loaded Modules</b>
-<p>
-
-So far we have considered LADSPA plugins and Scheme code files as ways to dynamically load new functions into Snd. Snd is also capable of loading shared objects at runtime via commands issued in the Listener. The procedure for building shared objects from the Scheme code is described in detail in the Snd documentation, and I refer the interested reader to those sections dealing with Snd's use of runtime modules and external programs. The documentation also describes methods for using external applications with Snd, such as Perry Cook's <a href=http://www-ccrma.stanford.edu/software/stk/>STK</a> (synthesis toolkit), the <a href=http://home.sprynet.com/~cbagwell/sox.html>SoX</a> "Swiss Army knife of audio", and Bill Schottstaedt's own Common LISP Music.
-<p>
-
-For example, you can link a shared object into Snd with these commands:
-<p>
-
-<pre>
- (define lib (dynamic-link "/home/dlphilp/snd-5/eff.so"))
- (dynamic-call "init_eff" lib)
-</pre>
-
-At this point you can invoke the flange processor from the shared object:
-<p>
-
-<pre>
- (loop-samples (make-sample-reader 0) (get-flange) (frames) "flange" (make-flange 2.0 5.0 0.001))
-</pre>
-
-Called this way the flange processor should run about thirty times faster than if it were called via the same code in effects.scm.
-<p>
-
-<b>Panning Envelopes</b>
-<p>
-
-If you load the customization package Snd will place a Special menu on the main menu bar. Among other things that menu offers a Start/Stop Enveloping feature. When Start Enveloping is invoked the next file opened will appear with a graphic envelope editor beside the usual time-domain waveform display [Figure 14]. This editor will appear along all subsequently opened files until the Stop Enveloping item is selected. When Start Enveloping is active you can create an envelope in the graphic editor and apply it to either amplitude or panning. I have added a widget for the panning function, available from the Special/Play Panned menu item, to make it easier to experiment with this interesting feature.
-<p>
-
-<center> <img src="images/jpg/4_01-snd_pan_env.jpg">
-<p>
-<b>Figure 14.</b> Making a panning envelope
-</center>
-<p>
-
-</body>
-</html>
diff --git a/tutorial/5_close_snd.html b/tutorial/5_close_snd.html
deleted file mode 100644
index 32a4dfb..0000000
--- a/tutorial/5_close_snd.html
+++ /dev/null
@@ -1,21 +0,0 @@
-
-<html>
-<body bgcolor="#FFFFFF">
-
-<center><h3>SOUNDING OUT</h3></center>
-<p>
-
-<b>Closing Remarks And Acknowledgements</b>
-<p>
-
-I hope you've enjoyed this article. Above all I hope you actually tried using Snd with its latest enhancements on some files of your own. I welcome any feedback, particularly with suggestions for improving the interface components and corrections to parameter definitions.
-<p>
-
-Snd is rich in editing, processing, mixing, and synthesis capabilities, and the customization of Snd is an on-going process. The addition of GUI widgets and popup menus has contributed greatly to the new Snd's ease of use, but much of Snd's power remains to be revealed to the non-programming user. Work on improving Snd's interface will continue, and the interested reader is advised to join the Snd mail-list to stay current with its latest developments (see the Snd home page for details).
-<p>
-
-I would like to thank the many respondents to my query regarding Cool Edit on the mail lists for Csound, the Linux Audio Developers group, and the "Common" software packages. Their responses formed the core around which my customization of Snd took shape, and I am truly in their debt. I must also thank Fernando Pablo Lopez-Lezcano for his assistance in resolving my problems with ALSA and Snd. But by far the greatest thanks goes to Snd author Bill Schottstaedt. He endured a nearly unceasing flow of questions and requests during the writing of this article, and he provided nearly all the tools needed to create the Snd presented in this article.
-<p>
-
-</body>
-</html>
diff --git a/tutorial/6_resources.html b/tutorial/6_resources.html
deleted file mode 100644
index adddc56..0000000
--- a/tutorial/6_resources.html
+++ /dev/null
@@ -1,41 +0,0 @@
-
-<html>
-<body bgcolor="#FFFFFF">
-
-<center><h3>RESOURCES</h3></center>
-<p>
-
-<u><b>On-line Resources</b></u>
-<p>
-
-<ul>
-<li> <a href=http://www-ccrma.stanford.edu/software/snd/>http://www-ccrma.stanford.edu/software/snd/</a> The official Snd home page
-<li> <a href=http://mstation.org/schottstaedt.html>http://mstation.org/schottstaedt.html</a> John Littler interviews Bill Schottstaedt
-<li> <a href=http://www.linuxgazette.com/issue47/ayers.html>http://www.linuxgazette.com/issue47/ayers.html</a> An article by Larry Ayers that includes a brief review of Snd
-</ul>
-
-<u><b>Other Necessary Software</b></u>
-<p>
-
-<ul>
-<li> <a href=http://www.alsa-project.org>http://www.alsa-project.org</a> The ALSA Web site
-<li> <a href=http://www.gnu.org/software/guile/guile.html>http://www.gnu.org/software/guile/guile.html</a> The Guile home page
-<li> <a href=http://www.ladspa.org/>http://www.ladspa.org/</a> Home page for LADSPA (the Linux Audio Developers' Simple Plugin Architecture)
-<li> <a href=http://www.opengroup.org/openmotif/>http://www.opengroup.org/openmotif/</a> The OpenMotif home page
-<li> <a href=http://www.opensound.com/>http://www.opensound.com/</a> Home to the OSS/Linux drivers
-<li> <a href=ftp://mustec.bgsu.edu/pub/linux/dp_scm.tar.gz>ftp://mustec.bgsu.edu/pub/linux/dp_scm.tar.gz</a> My Scheme files for customizing Snd
-</ul>
-
-
-<u><b>Print Resources</b></u>
-<p>
-
-<ul>
-<li> Dodge, C., and Jerse, T. A. <i>Computer Music: Synthesis, Composition, And Performance.</i> New York: Schirmer, 1997. Perhaps the best introduction to the subject. See the material in chapter 10.3, <u>Modification Of Sampled Sound</u>.
-<li> Phillips, D. <i>The Book Of Linux Music And Sound</i> San Francisco: No Starch Press, 2000. Includes a chapter on soundfile editors for Linux, with a profile of Snd.
-<li> Roads, C. <i>The Computer Music Tutorial.</i> Cambridge: MIT Press, 1996. The definitive tome; see especially the material in chapter V.16, <u>The Musician's Interface</u>.
-</ul>
-
-
-</body>
-</html>
diff --git a/tutorial/README b/tutorial/README
deleted file mode 100644
index 76dc78f..0000000
--- a/tutorial/README
+++ /dev/null
@@ -1,9 +0,0 @@
-This directory contains Dave Phillips' Snd tutorial published by
-O'Reilly & Associates at their website:
-
- http://linux.oreillynet.com/pub/a/linux/2001/10/05/snd_partone.html
- http://linux.oreillynet.com/pub/a/linux/2001/10/18/snd_parttwo.html
-
-O'Reilly has generously given us permission to include this tutorial
-with Snd without restrictions.
-
diff --git a/tutorial/files/.snd b/tutorial/files/.snd
deleted file mode 100644
index 76cb852..0000000
--- a/tutorial/files/.snd
+++ /dev/null
@@ -1,75 +0,0 @@
-
-;(set! (just-sounds) #t)
-
-(add-hook! after-open-hook (lambda (snd) (set! (cursor-follows-play snd) #t)))
-(add-hook! initial-graph-hook (lambda (s c dur) (list 0.0 dur)) #t)
-
-(define set-sound-cursor
- (lambda (snd shape)
- (do ((j 0 (1+ j)))
- ((= j (channels snd)) #f)
- (set-cursor-style shape snd j))))
-
- (add-hook! start-playing-hook
- (lambda (snd) (if (cursor-follows-play snd) (set-sound-cursor snd cursor-line))))
- (add-hook! stop-playing-hook
- (lambda (snd) (set-sound-cursor snd cursor-line)))
-
-(set! (graph-style) graph-filled)
-(set! (show-y-zero) #t)
-
-;;; my colors
-
-(load "/home/dlphilp/snd/rgb.scm")
-
-(set! (basic-color) light-grey)
-(set! (cursor-color) red)
-(set! (data-color) dark-grey)
-(set! (enved-waveform-color) blue)
-(set! (filter-waveform-color) blue)
-(set! (graph-color) antique-white)
-(set! (highlight-color) ivory1)
-(set! (listener-color) lightsteelblue1)
-(set! (mark-color) red)
-(set! (mix-color) gray)
-(set! (selected-mix-color) light-green)
-(set! (position-color) ivory3)
-(set! (pushed-button-color) lightsteelblue1)
-(set! (sash-color) light-green)
-(set! (selected-data-color) dark-blue)
-(set! (selected-graph-color) light-cyan)
-(set! (selection-color) steelblue1)
-(set! (text-focus-color) antique-white)
-(set! (zoom-color) ivory4)
-
-;;; try to smooth playing response
-
-(set-oss-buffers 2 12)
-(set! (dac-size) 64)
-
-; Snd 5.2 (30-July-01) options saved Tue 31-Jul-2001 16:07 EDT
-(set! (transform-graph-type) graph-transform-as-spectrogram)
-(set! (graph-style) graph-filled)
-(set! (auto-resize) #f)
-(set! (ask-before-overwrite) #t)
-(set! (colormap) 4)
-(set! (dac-size) 65536)
-(set! (show-y-zero) #t)
-(set! (fft-log-magnitude) #t)
-(set! (save-state-file) "saved-snd.scm")
-; end of snd options
-
-; Snd 5.2 (1-Aug-01) options saved Wed 01-Aug-2001 22:35 EDT
-(set! (transform-size) 512)
-(set! (fft-window) hann-window)
-(set! (transform-graph-type) graph-transform-as-spectrogram)
-(set! (graph-style) graph-filled)
-(set! (auto-resize) #f)
-(set! (color-inverted) #f)
-(set! (ask-before-overwrite) #t)
-(set! (colormap) 10)
-(set! (wavelet-type) 8)
-(set! (dac-size) 65536)
-(set! (show-y-zero) #t)
-(set! (save-state-file) "saved-snd.scm")
-; end of snd options
diff --git a/tutorial/files/misc.scm.txt b/tutorial/files/misc.scm.txt
deleted file mode 100644
index 56cf3b9..0000000
--- a/tutorial/files/misc.scm.txt
+++ /dev/null
@@ -1,328 +0,0 @@
-; this is a comment
-
-(load "/home/dlphilp/snd-5/snd-motif.scm")
-(load "/home/dlphilp/snd-5/examp.scm")
-(load "/home/dlphilp/snd-5/extensions.scm")
-(load "/home/dlphilp/snd-5/dsp.scm")
-(load "/home/dlphilp/snd-5/draw.scm")
-(load "/home/dlphilp/snd-5/env.scm")
-(load "/home/dlphilp/snd-5/enved.scm")
-(load "/home/dlphilp/snd-5/marks.scm")
-(load "/home/dlphilp/snd-5/mix.scm")
-(load "/home/dlphilp/snd-5/moog.scm")
-(load "/home/dlphilp/snd-5/popup.scm")
-(load "/home/dlphilp/snd-5/rubber.scm")
-(load "/home/dlphilp/my_scm/special-menu.scm")
-(load "/home/dlphilp/my_scm/my_backgrounds.scm")
-(load "/home/dlphilp/my_scm/marks-menu.scm")
-(load "/home/dlphilp/my_scm/new-effects.scm")
-(load "/home/dlphilp/my_scm/panic.scm")
-
-(title-with-date)
-(keep-file-dialog-open-upon-ok)
-(make-hidden-controls-dialog)
-(check-for-unsaved-edits #t)
-(add-hook! after-open-hook show-disk-space)
-
-;(define wd (make-pixmap (Widget (cadr (main-widgets))) rough))
-;(for-each-child (Widget (cadr (main-widgets))) (lambda (w) (XtSetValues w (list XmNbackgroundPixmap wd))))
-
-;;; uncomment the next line to add meters to the main window
-;;; (with-level-meters 2)
-
-(add-mark-pane)
-
-(add-sound-file-extension "SF2")
-(add-sound-file-extension "mp3")
-(add-sound-file-extension "MP3")
-(add-sound-file-extension "W01")
-(add-sound-file-extension "W02")
-(add-sound-file-extension "W03")
-(add-sound-file-extension "W04")
-(add-sound-file-extension "W05")
-(add-sound-file-extension "W06")
-(add-sound-file-extension "W07")
-(add-sound-file-extension "W08")
-(add-sound-file-extension "W09")
-
-;;;
-;;; disable original Play radio button
-;;;
-
-;(add-hook! after-open-hook
-; (lambda (snd)
-; (XtUnmanageChild (find-child (Widget (list-ref (sound-widgets snd) 2)) "play"))))
-
-
-;;;
-;;; main menu additions
-;;;
-
-;;; -------- add delete and rename options to the file menu
-
-(define (add-delete-option)
- (add-to-menu 0 "Delete" ; add Delete option to File menu
- (lambda ()
- ;; close current sound and delete it (after requesting confirmation)
- (if (selected-sound)
- (let ((filename (file-name)))
- (close-sound)
- (if (yes-or-no? (format #f "delete ~S?" filename))
- (delete-file filename)))))
- 8)) ; place after File:New
-
-(define (add-rename-option)
- (let ((rename-dialog #f)
- (rename-text #f))
- (add-to-menu 0 "Rename"
- (lambda ()
- ;; open dialog to get new name, save-as that name, open
- (if (not rename-dialog)
- ;; make a standard dialog
- (let* ((xdismiss (XmStringCreate "Dismiss" XmFONTLIST_DEFAULT_TAG))
- (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
- (xok (XmStringCreate "DoIt" XmFONTLIST_DEFAULT_TAG))
- (titlestr (XmStringCreate "Rename" XmFONTLIST_DEFAULT_TAG))
- (new-dialog (XmCreateTemplateDialog
- (Widget (cadr (main-widgets))) "Rename"
- (list XmNcancelLabelString xdismiss
- XmNhelpLabelString xhelp
- XmNokLabelString xok
- XmNautoUnmanage #f
- XmNdialogTitle titlestr
- XmNresizePolicy XmRESIZE_GROW
- XmNnoResize #f
- XmNbackground (basic-color)
- XmNtransient #f))))
- (for-each
- (lambda (button)
- (XtVaSetValues
- (XmMessageBoxGetChild new-dialog button)
- (list XmNarmColor (pushed-button-color)
- XmNbackground (basic-color))))
- (list XmDIALOG_HELP_BUTTON XmDIALOG_CANCEL_BUTTON XmDIALOG_OK_BUTTON))
-
- (XtAddCallback new-dialog XmNcancelCallback
- (lambda (w c i) (XtUnmanageChild w)))
-
- (XtAddCallback new-dialog XmNhelpCallback
- (lambda (w c i)
- (help-dialog "Rename" "Give a new file name to rename the currently selected sound.")))
-
- (XtAddCallback new-dialog XmNokCallback
- (lambda (w c i)
- (let ((new-name (XmTextFieldGetString rename-text)))
- (if (and (string? new-name)
- (> (string-length new-name) 0)
- (selected-sound))
- (let ((current-name (file-name)))
- (save-sound-as new-name)
- (close-sound)
- (rename-file current-name new-name)
- (open-sound new-name)
- (XtUnmanageChild w))))))
- (XmStringFree xhelp)
- (XmStringFree xok)
- (XmStringFree xdismiss)
- (XmStringFree titlestr)
- (set! rename-dialog new-dialog)
- (let* ((mainform (XtCreateManagedWidget "formd" xmRowColumnWidgetClass rename-dialog
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_WIDGET
- XmNbottomWidget (XmMessageBoxGetChild rename-dialog XmDIALOG_SEPARATOR)
- XmNorientation XmVERTICAL
- XmNbackground (basic-color))))
- (label (XtCreateManagedWidget "new name:" xmLabelWidgetClass mainform
- (list XmNleftAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_NONE
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color)))))
- (set! rename-text
- (XtCreateManagedWidget "newname" xmTextFieldWidgetClass mainform
- (list XmNleftAttachment XmATTACH_WIDGET
- XmNleftWidget label
- XmNrightAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNbackground (basic-color))))
- (XtAddEventHandler rename-text EnterWindowMask #f
- (lambda (w context ev flag)
- (XmProcessTraversal w XmTRAVERSE_CURRENT)
- (XtSetValues w (list XmNbackground (white-pixel)))))
- (XtAddEventHandler rename-text LeaveWindowMask #f
- (lambda (w context ev flag)
- (XtSetValues w (list XmNbackground (basic-color))))))))
- (if (not (XtIsManaged rename-dialog))
- (XtManageChild rename-dialog)
- (raise-dialog rename-dialog)))
- 8)))
-
-(install-searcher-with-colors (lambda (file) #t))
-(add-delete-option)
-(add-rename-option)
-
-;;;
-;;; poup menu stuff
-;;;
-
-(change-graph-popup-color "pink")
-
-;;;(add-selection-popup)
-
-
-(define (change-selection-popup-color new-color)
- ;; new-color can be the color name, an xm Pixel, a snd color, or a list of rgb values (as in Snd's make-color)
- (let ((color-pixel
- (if (string? new-color) ; assuming X11 color names here
- (let* ((shell (Widget (cadr (main-widgets))))
- (dpy (XtDisplay shell))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr))
- (col (XColor)))
- (if (= (XAllocNamedColor dpy cmap new-color col col) 0)
- (snd-error "can't allocate ~S" new-color)
- (.pixel col)))
- (if (color? new-color)
- new-color
- ;; assume a list of rgb vals?
- (apply make-color new-color)))))
- (for-each-child
- selection-popup-menu
- (lambda (n)
- (XmChangeColor n color-pixel)))))
-(change-selection-popup-color "coral")
-
-(define (change-fft-popup-color new-color)
- (let ((color-pixel
- (if (string? new-color) ; assuming X11 color names here
- (let* ((shell (Widget (cadr (main-widgets))))
- (dpy (XtDisplay shell))
- (scr (DefaultScreen dpy))
- (cmap (DefaultColormap dpy scr))
- (col (XColor)))
- (if (= (XAllocNamedColor dpy cmap new-color col col) 0)
- (snd-error "can't allocate ~S" new-color)
- (.pixel col)))
- (if (color? new-color)
- new-color
- ;; assume a list of rgb vals?
- (apply make-color new-color)))))
- (for-each-child
- fft-popup-menu
- (lambda (n)
- (XmChangeColor n color-pixel)))))
-(change-fft-popup-color "orange")
-
-;(change-listener-popup-color "red")
-
-(add-to-menu 1 #f #f) ; separator
-
-;;;
-;;; additions to Edit menu
-;;;
-
-(define selctr 0)
-
-;;; -------- cut selection -> new file
-
-(define (cut-selection->new)
- (if (selection?)
- (let ((new-file-name (format #f "sel-~D.snd" selctr)))
- (set! selctr (+ selctr 1))
- (save-selection new-file-name)
- (delete-selection)
- (open-sound new-file-name))))
-
-;;; (add-to-menu 1 "Cut Selection -> New" cut-selection->new)
-
-;;; -------- append sound (and append selection for lafs)
-
-(define (append-sound name)
- ;; appends sound file
- (insert-sound name (frames)))
-
-(define (append-selection)
- (if (selection?)
- (insert-selection (frames))))
-
-(add-to-menu 1 "Append Selection" append-selection)
-
-;;; Replace with selection
-;;;
-
-(define (replace-with-selection)
- (let ((beg (cursor))
- (len (selection-frames)))
- (delete-samples beg len)
- (insert-selection beg)))
-
-(add-to-menu 1 "Replace with Selection" replace-with-selection)
-
-;;; (add-to-menu 1 #f #f)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; open and convert stereo MP3 files automatically
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(add-hook! open-raw-sound-hook
- (lambda (file choices)
- (list 2 44100 (if (little-endian?) mus-lshort mus-bshort))))
-
-(add-hook! open-hook
- (lambda (filename)
- (if (= (mus-sound-header-type filename) mus-raw)
- (let ((rawfile (string-append filename ".raw")))
- (system (format #f "mpg123 -s ~A > ~A" filename rawfile))
- rawfile)
- #f)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; open and convert stereo OGG files automatically
-;;;
-;;; (see examp.scm for writing these files, and a slightly improved reader)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(add-hook! open-raw-sound-hook
- (lambda (file choices)
- (list 2 44100 (if (little-endian?) mus-lshort mus-bshort))))
-
-(add-hook! open-hook
- (lambda (filename)
- (if (= (mus-sound-header-type filename) mus-raw)
- (let ((rawfile (string-append filename ".raw")))
- (system (format #f "ogg123 -d raw -f ~A ~A" rawfile filename))
- rawfile)
- #f)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; set up a region play list
-;;; TODO: a GUI for this feature !
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (region-play-list data)
- ;; data is list of lists (list (list time region)...), time in secs
- (for-each
- (lambda (tone)
- (let ((time (* 1000 (car tone)))
- (region (cadr tone)))
- (if (region? region)
- (in time (lambda () (play-region region))))))
- data))
-
-;;; (region-play-list (list (list 0.0 0) (list 0.5 1) (list 1.0 2) (list 1.0 0)))
-
-;;; Deselect function
-;;;
-
-(define (deselect-all)
- (if (selection?)
- (set! (selection-member? #t) #f)))
-
diff --git a/tutorial/files/misc.scm.txt~ b/tutorial/files/misc.scm.txt~
deleted file mode 100644
index acd3941..0000000
--- a/tutorial/files/misc.scm.txt~
+++ /dev/null
@@ -1,303 +0,0 @@
-; this is a comment
-
-(load "/home/dlphilp/snd-5/snd-motif.scm")
-(load "/home/dlphilp/snd-5/examp.scm")
-(load "/home/dlphilp/snd-5/extensions.scm")
-(load "/home/dlphilp/snd-5/dsp.scm")
-(load "/home/dlphilp/snd-5/draw.scm")
-(load "/home/dlphilp/snd-5/env.scm")
-(load "/home/dlphilp/snd-5/enved.scm")
-(load "/home/dlphilp/snd-5/marks.scm")
-(load "/home/dlphilp/snd-5/mix.scm")
-(load "/home/dlphilp/snd-5/moog.scm")
-(load "/home/dlphilp/snd-5/popup.scm")
-(load "/home/dlphilp/snd-5/rubber.scm")
-(load "/home/dlphilp/my_scm/special-menu.scm")
-(load "/home/dlphilp/my_scm/my_backgrounds.scm")
-(load "/home/dlphilp/my_scm/marks-menu.scm")
-(load "/home/dlphilp/my_scm/new-effects.scm")
-(load "/home/dlphilp/my_scm/panic.scm")
-
-(title-with-date)
-(keep-file-dialog-open-upon-ok)
-(make-hidden-controls-dialog)
-(check-for-unsaved-edits #t)
-(add-hook! after-open-hook show-disk-space)
-
-(define wd (make-pixmap (|Widget (cadr (main-widgets))) rough))
-(for-each-child (|Widget (cadr (main-widgets))) (lambda (w) (|XtSetValues w (list |XmNbackgroundPixmap wd))))
-
-;;; uncomment the next line to add meters to the main window
-;;; (with-level-meters 2)
-
-(add-mark-pane)
-
-(add-sound-file-extension "SF2")
-(add-sound-file-extension "mp3")
-(add-sound-file-extension "MP3")
-(add-sound-file-extension "W01")
-(add-sound-file-extension "W02")
-(add-sound-file-extension "W03")
-(add-sound-file-extension "W04")
-(add-sound-file-extension "W05")
-(add-sound-file-extension "W06")
-(add-sound-file-extension "W07")
-(add-sound-file-extension "W08")
-(add-sound-file-extension "W09")
-
-;;; I might eventually use these for cursor control
-;;; (add-very-useful-icons)
-
-;;;
-;;; main menu additions
-;;;
-
-;;; -------- add delete and rename options to the file menu
-
-(define (add-delete-option)
- (add-to-menu 0 "Delete" ; add Delete option to File menu
- (lambda ()
- ;; close current sound and delete it (after requesting confirmation)
- (if (>= (selected-sound) 0)
- (let ((filename (file-name)))
- (close-sound)
- (if (yes-or-no? (format #f "delete ~S?" filename))
- (delete-file filename)))))
- 8)) ; place after File:New
-
-(define (add-rename-option)
- (let ((rename-dialog #f)
- (rename-text #f))
- (add-to-menu 0 "Rename"
- (lambda ()
- ;; open dialog to get new name, save-as that name, open
- (if (not rename-dialog)
- ;; make a standard dialog
- (let* ((xdismiss (|XmStringCreate "Dismiss" |XmFONTLIST_DEFAULT_TAG))
- (xhelp (|XmStringCreate "Help" |XmFONTLIST_DEFAULT_TAG))
- (xok (|XmStringCreate "DoIt" |XmFONTLIST_DEFAULT_TAG))
- (titlestr (|XmStringCreate "Rename" |XmFONTLIST_DEFAULT_TAG))
- (new-dialog (|XmCreateTemplateDialog
- (|Widget (cadr (main-widgets))) "Rename"
- (list |XmNcancelLabelString xdismiss
- |XmNhelpLabelString xhelp
- |XmNokLabelString xok
- |XmNautoUnmanage #f
- |XmNdialogTitle titlestr
- |XmNresizePolicy |XmRESIZE_GROW
- |XmNnoResize #f
- |XmNbackground (|Pixel (snd-pixel (basic-color)))
- |XmNtransient #f))))
- (for-each
- (lambda (button)
- (|XtVaSetValues
- (|XmMessageBoxGetChild new-dialog button)
- (list |XmNarmColor (|Pixel (snd-pixel (pushed-button-color)))
- |XmNbackground (|Pixel (snd-pixel (basic-color))))))
- (list |XmDIALOG_HELP_BUTTON |XmDIALOG_CANCEL_BUTTON |XmDIALOG_OK_BUTTON))
-
- (|XtAddCallback new-dialog |XmNcancelCallback
- (lambda (w c i) (|XtUnmanageChild w)))
-
- (|XtAddCallback new-dialog |XmNhelpCallback
- (lambda (w c i)
- (help-dialog "Rename" "Give a new file name to rename the currently selected sound.")))
-
- (|XtAddCallback new-dialog |XmNokCallback
- (lambda (w c i)
- (let ((new-name (|XmTextFieldGetString rename-text)))
- (if (and (string? new-name)
- (> (string-length new-name) 0)
- (>= (selected-sound) 0))
- (let ((current-name (file-name)))
- (save-sound-as new-name)
- (close-sound)
- (rename-file current-name new-name)
- (open-sound new-name)
- (|XtUnmanageChild w))))))
- (|XmStringFree xhelp)
- (|XmStringFree xok)
- (|XmStringFree xdismiss)
- (|XmStringFree titlestr)
- (set! rename-dialog new-dialog)
- (let* ((mainform (|XtCreateManagedWidget "formd" |xmRowColumnWidgetClass rename-dialog
- (list |XmNleftAttachment |XmATTACH_FORM
- |XmNrightAttachment |XmATTACH_FORM
- |XmNtopAttachment |XmATTACH_FORM
- |XmNbottomAttachment |XmATTACH_WIDGET
- |XmNbottomWidget (|XmMessageBoxGetChild rename-dialog |XmDIALOG_SEPARATOR)
- |XmNorientation |XmVERTICAL
- |XmNbackground (|Pixel (snd-pixel (basic-color))))))
- (label (|XtCreateManagedWidget "new name:" |xmLabelWidgetClass mainform
- (list |XmNleftAttachment |XmATTACH_FORM
- |XmNrightAttachment |XmATTACH_NONE
- |XmNtopAttachment |XmATTACH_FORM
- |XmNbottomAttachment |XmATTACH_FORM
- |XmNbackground (|Pixel (snd-pixel (basic-color)))))))
- (set! rename-text
- (|XtCreateManagedWidget "newname" |xmTextFieldWidgetClass mainform
- (list |XmNleftAttachment |XmATTACH_WIDGET
- |XmNleftWidget label
- |XmNrightAttachment |XmATTACH_FORM
- |XmNtopAttachment |XmATTACH_FORM
- |XmNbottomAttachment |XmATTACH_FORM
- |XmNbackground (|Pixel (snd-pixel (basic-color))))))
- (|XtAddEventHandler rename-text |EnterWindowMask #f
- (lambda (w context ev flag)
- (|XmProcessTraversal w |XmTRAVERSE_CURRENT)
- (|XtSetValues w (list |XmNbackground (white-pixel)))))
- (|XtAddEventHandler rename-text |LeaveWindowMask #f
- (lambda (w context ev flag)
- (|XtSetValues w (list |XmNbackground (|Pixel (snd-pixel (basic-color))))))))))
- (if (not (|XtIsManaged rename-dialog))
- (|XtManageChild rename-dialog)
- (raise-dialog rename-dialog)))
- 8)))
-
-(install-searcher-with-colors (lambda (file) #t))
-(add-delete-option)
-(add-rename-option)
-
-;;;
-;;; popup menu stuff
-;;;
-
-(change-graph-popup-color "pink")
-
-
-(define (change-selection-popup-color new-color)
- ;; new-color can be the color name, an xm Pixel, a snd color, or a list of rgb values (as in Snd's make-color)
- (let ((color-pixel
- (if (string? new-color) ; assuming X11 color names here
- (let* ((shell (|Widget (cadr (main-widgets))))
- (dpy (|XtDisplay shell))
- (scr (|DefaultScreen dpy))
- (cmap (|DefaultColormap dpy scr))
- (col (|XColor)))
- (if (= (|XAllocNamedColor dpy cmap new-color col col) 0)
- (snd-error "can't allocate ~S" new-color)
- (|pixel col)))
- (if (color? new-color)
- (|Pixel (snd-pixel new-color))
- (if (|Pixel? new-color)
- new-color
- ;; assume a list of rgb vals?
- (|Pixel (snd-pixel (apply make-color new-color))))))))
- (for-each-child
- selection-popup-menu
- (lambda (n)
- (|XmChangeColor n color-pixel)))))
-(change-selection-popup-color "coral")
-
-(define (change-fft-popup-color new-color)
- (let ((color-pixel
- (if (string? new-color) ; assuming X11 color names here
- (let* ((shell (|Widget (cadr (main-widgets))))
- (dpy (|XtDisplay shell))
- (scr (|DefaultScreen dpy))
- (cmap (|DefaultColormap dpy scr))
- (col (|XColor)))
- (if (= (|XAllocNamedColor dpy cmap new-color col col) 0)
- (snd-error "can't allocate ~S" new-color)
- (|pixel col)))
- (if (color? new-color)
- (|Pixel (snd-pixel new-color))
- (if (|Pixel? new-color)
- new-color
- ;; assume a list of rgb vals?
- (|Pixel (snd-pixel (apply make-color new-color))))))))
- (for-each-child
- fft-popup-menu
- (lambda (n)
- (|XmChangeColor n color-pixel)))))
-(change-fft-popup-color "orange")
-
-(change-listener-popup-color "red")
-
-;;;
-;;; additions to Edit menu
-;;;
-
-(add-to-menu 1 #f #f) ; separator
-
-;;; -------- cut selection -> new file
-
-(define (cut-selection->new)
- (if (selection?)
- (let ((new-file-name (format #f "sel-~D.snd" selctr)))
- (set! selctr (+ selctr 1))
- (save-selection new-file-name)
- (delete-selection)
- (open-sound new-file-name))))
-
-(add-to-menu 1 "Cut Selection -> New" cut-selection->new)
-
-;;; -------- append sound (and append selection for lafs)
-
-(define (append-sound name)
- ;; appends sound file
- (insert-sound name (frames)))
-
-(define (append-selection)
- (if (selection?)
- (insert-selection (frames))))
-
-(add-to-menu 1 "Append Selection" append-selection)
-
-;;; Replace with selection
-;;;
-
-(define (replace-with-selection)
- (let ((beg (cursor))
- (len (selection-length)))
- (delete-samples beg len)
- (insert-selection beg)))
-
-(add-to-menu 1 "Replace with Selection" replace-with-selection)
-
-;;; (add-to-menu 1 #f #f)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; open and convert stereo MP3 files automatically
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(add-hook! open-raw-sound-hook
- (lambda (file choices)
- (list 2 44100 (if (little-endian?) mus-lshort mus-bshort))))
-
-(add-hook! open-hook
- (lambda (filename)
- (if (= (mus-sound-header-type filename) mus-raw)
- (let ((rawfile (string-append filename ".raw")))
- (system (format #f "mpg123 -s ~A > ~A" filename rawfile))
- rawfile)
- #f)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; set up a region play list
-;;; TODO: a GUI for this feature !
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (region-play-list data)
- ;; data is list of lists (list (list time region)...), time in secs
- (for-each
- (lambda (tone)
- (let ((time (* 1000 (car tone)))
- (region (cadr tone)))
- (if (region? region)
- (in time (lambda () (play-region region))))))
- data))
-
-;;; (region-play-list (list (list 0.0 0) (list 0.5 1) (list 1.0 2) (list 1.0 0)))
-
-;;; Deselect function
-;;;
-
-(define (deselect-all)
- (if (selection?)
- (set! (selection-member? #t) #f)))
-
diff --git a/tutorial/images/jpg/1_01-ce2000.jpg b/tutorial/images/jpg/1_01-ce2000.jpg
deleted file mode 100644
index 0fb2fab..0000000
Binary files a/tutorial/images/jpg/1_01-ce2000.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/1_02-snd_default_open.jpg b/tutorial/images/jpg/1_02-snd_default_open.jpg
deleted file mode 100644
index 178924e..0000000
Binary files a/tutorial/images/jpg/1_02-snd_default_open.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/2_01-snd_notebook.jpg b/tutorial/images/jpg/2_01-snd_notebook.jpg
deleted file mode 100644
index fbaa398..0000000
Binary files a/tutorial/images/jpg/2_01-snd_notebook.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/2_02-snd_separate.jpg b/tutorial/images/jpg/2_02-snd_separate.jpg
deleted file mode 100644
index 2f41361..0000000
Binary files a/tutorial/images/jpg/2_02-snd_separate.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/2_03-snd_horizontal.jpg b/tutorial/images/jpg/2_03-snd_horizontal.jpg
deleted file mode 100644
index 2cd50d9..0000000
Binary files a/tutorial/images/jpg/2_03-snd_horizontal.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/2_04-snd_full_defined.jpg b/tutorial/images/jpg/2_04-snd_full_defined.jpg
deleted file mode 100644
index 67ec583..0000000
Binary files a/tutorial/images/jpg/2_04-snd_full_defined.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/3_01-snd_file_popup.jpg b/tutorial/images/jpg/3_01-snd_file_popup.jpg
deleted file mode 100644
index e24c036..0000000
Binary files a/tutorial/images/jpg/3_01-snd_file_popup.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/3_02-snd_regions.jpg b/tutorial/images/jpg/3_02-snd_regions.jpg
deleted file mode 100644
index 3f08857..0000000
Binary files a/tutorial/images/jpg/3_02-snd_regions.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/3_03-snd_mix.jpg b/tutorial/images/jpg/3_03-snd_mix.jpg
deleted file mode 100644
index be9e314..0000000
Binary files a/tutorial/images/jpg/3_03-snd_mix.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/3_04-snd_hidden_controls.jpg b/tutorial/images/jpg/3_04-snd_hidden_controls.jpg
deleted file mode 100644
index 864283d..0000000
Binary files a/tutorial/images/jpg/3_04-snd_hidden_controls.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/3_05-snd_enved.jpg b/tutorial/images/jpg/3_05-snd_enved.jpg
deleted file mode 100644
index e60ca36..0000000
Binary files a/tutorial/images/jpg/3_05-snd_enved.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/3_06-snd_fft_popup.jpg b/tutorial/images/jpg/3_06-snd_fft_popup.jpg
deleted file mode 100644
index d8b86b6..0000000
Binary files a/tutorial/images/jpg/3_06-snd_fft_popup.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/3_07-snd_recorder.jpg b/tutorial/images/jpg/3_07-snd_recorder.jpg
deleted file mode 100644
index f07e366..0000000
Binary files a/tutorial/images/jpg/3_07-snd_recorder.jpg and /dev/null differ
diff --git a/tutorial/images/jpg/4_01-snd_pan_env.jpg b/tutorial/images/jpg/4_01-snd_pan_env.jpg
deleted file mode 100644
index 735c752..0000000
Binary files a/tutorial/images/jpg/4_01-snd_pan_env.jpg and /dev/null differ
diff --git a/v.rb b/v.rb
index 0c17353..0d3a6b3 100644
--- a/v.rb
+++ b/v.rb
@@ -1,24 +1,15 @@
-# v.rb -*- snd-ruby -*-
-
# Translator: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Wed Nov 20 02:24:34 CET 2002
-# Changed: Thu Oct 15 00:21:26 CEST 2009
+# Created: 02/11/20 02:24:34
+# Changed: 14/11/23 03:36:55
-# Comment:
-#
-# class Instrument
-# fm_violin_rb(start, dur, freq, amp, *args)
-# jc_reverb_rb(*args)
-#
+# fm_violin(start, dur, freq, amp, *args)
+# play_fm_violin(start, dur, freq, amp, *args)
# make_fm_violin(start, dur, freq, amp, *args)
-#
-# Code:
+# jc_reverb(*args)
require "ws"
-class Instrument
- add_help(:fm_violin_rb,
- "fm_violin([start=0.0[, dur=1.0[, freq=440.0[, amp=0.5[, *args]]]]])
+v_opts_str = "fm_violin(start=0.0, dur=1.0, freq=440.0, amp=0.5, *args)
:fm_index = 1.0
:amp_env = [0, 0, 25, 1, 75, 1, 100, 0]
:periodic_vibrato_rate = 5.0
@@ -43,224 +34,63 @@ class Instrument
:fm2_index = false
:fm3_index = false
:base = 1.0
- :index_type = :violin
+ :index_type = :violin"
+
+add_help(:fm_violin,
+ "#{v_opts_str}
:reverb_amount = 0.01
:degree = kernel_rand(90.0)
:distance = 1.0
- Ruby: fm_violin_rb(0, 1, 440, 0.1, :fm_index, 2.0)
- Guile: (fm-violin 0 1 440 0.1 :fm-index 2.0)
-Example: with_sound do fm_violin_rb(0, 1, 440, 0.1, :fm_index, 2.0) end")
- def fm_violin_rb(start = 0.0, dur = 1.0, freq = 440.0, amp = 0.5, *args)
- fm_index, amp_env, periodic_vibrato_rate, random_vibrato_rate = nil
- periodic_vibrato_amp, random_vibrato_amp, noise_amount, noise_freq = nil
- ind_noise_freq, ind_noise_amount, amp_noise_freq, amp_noise_amount = nil
- gliss_env, gliss_amount, fm1_env, fm2_env, fm3_env, fm1_rat, fm2_rat, fm3_rat = nil
- fm1_index, fm2_index, fm3_index, base, index_type, reverb_amount, degree, distance = nil
- optkey(args, binding,
- [:fm_index, 1.0],
- [:amp_env, [0, 0, 25, 1, 75, 1, 100, 0]],
- [:periodic_vibrato_rate, 5.0],
- [:random_vibrato_rate, 16.0],
- [:periodic_vibrato_amp, 0.0025],
- [:random_vibrato_amp, 0.005],
- [:noise_amount, 0.0],
- [:noise_freq, 1000.0],
- [:ind_noise_freq, 10.0],
- [:ind_noise_amount, 0.0],
- [:amp_noise_freq, 20.0],
- [:amp_noise_amount, 0.0],
- [:gliss_env, [0, 0, 100, 0]],
- [:gliss_amount, 0.0],
- [:fm1_env, [0, 1, 25, 0.4, 75, 0.6, 100, 0]],
- [:fm2_env, [0, 1, 25, 0.4, 75, 0.6, 100, 0]],
- [:fm3_env, [0, 1, 25, 0.4, 75, 0.6, 100, 0]],
- [:fm1_rat, 1.0],
- [:fm2_rat, 3.0],
- [:fm3_rat, 4.0],
- [:fm1_index, false],
- [:fm2_index, false],
- [:fm3_index, false],
- [:base, 1.0],
- [:index_type, :violin],
- [:reverb_amount, 0.01],
- [:degree, kernel_rand(90.0)],
- [:distance, 1.0])
- frq_scl = hz2radians(freq)
- modulate = fm_index.nonzero?
- maxdev = frq_scl * fm_index
- vln = (index_type != :cello)
- logfreq = log(freq)
- sqrtfreq = sqrt(freq)
- index1 = (fm1_index or [PI, maxdev * (vln ? 5.0 : 7.5) / logfreq].min)
- index2 = (fm2_index or [PI, maxdev * 3.0 * \
- (vln ? ((8.5 - logfreq) / (3.0 + freq * 0.001)) : (15.0 / sqrtfreq))].min)
- index3 = (fm3_index or [PI, maxdev * (vln ? 4.0 : 8.0) / sqrtfreq].min)
- easy_case = (noise_amount.zero? and
- (fm1_env == fm2_env) and
- (fm1_env == fm3_env) and
- (fm1_rat - fm1_rat.floor).zero? and
- (fm2_rat - fm2_rat.floor).zero? and
- (fm3_rat - fm3_rat.floor).zero?)
- norm = ((easy_case and modulate and 1.0) or index1)
- carrier = make_oscil(freq)
- fmosc1 = if modulate
- if easy_case
- make_polyshape(:frequency, fm1_rat * freq,
- :coeffs, partials2polynomial([fm1_rat.to_i, index1,
- (fm2_rat / fm1_rat).floor, index2,
- (fm3_rat / fm1_rat).floor, index3]))
- else
- make_oscil(:frequency, fm1_rat * freq)
- end
- else
- false
- end
- fmosc2 = (modulate and (easy_case or make_oscil(:frequency, fm2_rat * freq)))
- fmosc3 = (modulate and (easy_case or make_oscil(:frequency, fm3_rat * freq)))
- ampf = make_env(amp_env, amp, dur, 0.0, base)
- indf1 = (modulate and make_env(fm1_env, norm, dur))
- indf2 = (modulate and (easy_case or make_env(fm2_env, index2, dur)))
- indf3 = (modulate and (easy_case or make_env(fm3_env, index3, dur)))
- frqf = make_env(gliss_env, gliss_amount * frq_scl, dur)
- pervib = make_triangle_wave(periodic_vibrato_rate, periodic_vibrato_amp * frq_scl)
- ranvib = make_rand_interp(random_vibrato_rate, random_vibrato_amp * frq_scl)
- fm_noi = (noise_amount.nonzero? and make_rand(noise_freq, PI * noise_amount))
- ind_noi = ((ind_noise_amount.nonzero? and ind_noise_freq.nonzero?) and
- make_rand_interp(ind_noise_freq, ind_noise_amount))
- amp_noi = ((amp_noise_amount.nonzero? and amp_noise_freq.nonzero?) and
- make_rand_interp(amp_noise_freq, amp_noise_amount))
- fuzz = modulation = 0.0
- ind_fuzz = amp_fuzz = 1.0
- run_instrument(start, dur,
- :reverb_amount, reverb_amount,
- :degree, degree,
- :distance, distance) do
- fuzz = rand(fm_noi) if noise_amount.nonzero?
- vib = env(frqf) + triangle_wave(pervib) + rand_interp(ranvib)
- ind_fuzz = 1.0 + rand_interp(ind_noi) if ind_noi
- amp_fuzz = 1.0 + rand_interp(amp_noi) if amp_noi
- if modulate
- modulation = if easy_case
- env(indf1) * polyshape(fmosc1, 1.0, vib)
- else
- (env(indf1) * oscil(fmosc1, fm1_rat * vib + fuzz) +
- env(indf2) * oscil(fmosc2, fm2_rat * vib + fuzz) +
- env(indf3) * oscil(fmosc3, fm3_rat * vib + fuzz))
- end
- end
- env(ampf) * amp_fuzz * oscil(carrier, vib + ind_fuzz * modulation)
- end
- end
-
- add_help(:jc_reverb_rb,
- "jc_reverb_rb(*args) \
- :volume = 1.0
- :delay1 = 0.013
- :delay2 = 0.011
- :delay3 = 0.015
- :delay4 = 0.017
- :low_pass = false
- :double = false
- :amp_env = false
-Chowning reverb")
- def jc_reverb_rb(*args)
- low_pass, volume, amp_env, delay1, delay2, delay3, delay4, double = nil
- optkey(args, binding,
- [:volume, 1.0],
- [:delay1, 0.013],
- [:delay2, 0.011],
- [:delay3, 0.015],
- [:delay4, 0.017],
- [:low_pass, false],
- [:double, false],
- [:amp_env, false])
- chan2 = (@channels > 1)
- chan4 = (@channels == 4)
- if double and chan4
- error("%s: not set up for doubled reverb in quad", get_func_name)
- end
- allpass1 = make_all_pass(-0.7, 0.7, 1051)
- allpass2 = make_all_pass(-0.7, 0.7, 337)
- allpass3 = make_all_pass(-0.7, 0.7, 113)
- comb1 = make_comb(0.742, 4799)
- comb2 = make_comb(0.733, 4999)
- comb3 = make_comb(0.715, 5399)
- comb4 = make_comb(0.697, 5801)
- outdel1 = make_delay((delay1 * @srate).round)
- outdel2 = (chan2 ? make_delay((delay2 * @srate).round) : false)
- outdel3 = ((chan4 or double) ? make_delay((delay3 * @srate).round) : false)
- outdel4 = ((chan4 or (double and chan2)) ? make_delay((delay4 * @srate).round) : false)
- envA = if amp_env
- make_env(:envelope, amp_env,
- :scaler, volume,
- :duration, ws_duration(@revfile) + @decay_time)
- else
- false
- end
- comb_sum_1 = comb_sum = 0.0
- reverb_frame = make_frame(@channels)
- run_reverb() do |ho, i|
- allpass_sum = all_pass(allpass3, all_pass(allpass2, all_pass(allpass1, ho)))
- comb_sum_2, comb_sum_1 = comb_sum_1, comb_sum
- comb_sum = (comb(comb1, allpass_sum) + comb(comb2, allpass_sum) + \
- comb(comb3, allpass_sum) + comb(comb4, allpass_sum))
- all_sums = if low_pass
- 0.25 * (comb_sum + comb_sum_2) + 0.5 * comb_sum_1
- else
- comb_sum
- end
- delA = delay(outdel1, all_sums)
- if double
- delA += delay(outdel3, all_sums)
- end
- if envA
- volume = env(envA)
- end
- frame_set!(reverb_frame, 0, volume * delA)
- if chan2
- delB = delay(outdel2, all_sums)
- if double
- delB += delay(outdel4, all_sums)
- end
- frame_set!(reverb_frame, 1, volume * delB)
- if chan4
- frame_set!(reverb_frame, 2, volume * delay(outdel3, all_sums))
- frame_set!(reverb_frame, 3, volume * delay(outdel4, all_sums))
- end
- end
- reverb_frame
- end
+ Ruby: fm_violin(0, 1, 440, 0.1, :fm_index, 2.0)
+Scheme: (fm-violin 0 1 440 0.1 :fm-index 2.0)
+Example: with_sound do fm_violin(0, 1, 440, 0.1, :fm_index, 2.0) end")
+def fm_violin(start = 0.0, dur = 1.0, freq = 440.0, amp = 0.5, *args)
+ r = get_args(args, :reverb_amount, 0.01)
+ d = get_args(args, :degree, kernel_rand(90.0))
+ s = get_args(args, :distance, 1.0)
+ fm_vln = make_fm_violin_gen(start, dur, freq, amp, *args)
+ run_instrument(start, dur, :reverb_amount, r, :degree, d, :distance, s) do
+ fm_vln.call(0)
end
end
-class Snd_Instrument
- alias fm_violin fm_violin_rb
- alias jc_reverb jc_reverb_rb
+add_help(:play_fm_violin,
+ "play_#{v_opts_str}
+Returns a fm_violin proc with no arg for play(proc).
+v = play_fm_violin(0, 1, 440, 0.5)
+play(v)
+or
+play(play_fm_violin(0, 1, 440, 0.5))")
+def play_fm_violin(start = 0.0, dur = 1.0, freq = 440.0, amp = 0.5, *args)
+ fm_vln = make_fm_violin_gen(start, dur, freq, amp, *args)
+ len = seconds2samples(dur)
+ lambda do
+ (len -= 1).positive? and fm_vln.call(0)
+ end
end
-# fm_violin generator
-
-add_help(:make_fm_violin, "make_fm_violin(start, dur, freq, amp, *args) \
-returns a thunk for vct_map!() or a proc with one arg for map_channel()
-*args are like fm_violin's, an extra arg is :thunk? = false
-
+#
+# make_fm_violin: returns lambda do |y| ... end
+#
+add_help(:make_fm_violin,
+ "make_#{v_opts_str}
+Returns a proc with one arg for map_channel()
+*args are like fm_violin's
ins = new_sound(:file, \"fmv.snd\", :srate, 22050, :channels, 2)
-
-# thunk
-fmv1 = make_fm_violin(0, 1, 440, 0.5, :thunk?, true)
-v = make_vct(22050)
-vct_map!(v, fmv1)
-vct2channel(v, 0, 22050, ins, 0)
-
# proc with one arg
-fmv2 = make_fm_violin(0, 1, 440, 0.5, :thunk?, false)
-map_channel(fmv2, 0, 22050, ins, 1)")
-def make_fm_violin(start, dur, freq, amp, *args)
+fmv1 = make_fm_violin(0, 1, 440, 0.5)
+map_channel(fmv1, 0, 22050, ins, 1)")
+def make_fm_violin(start = 0.0, dur = 1.0, freq = 440.0, amp = 1.0, *args)
+ make_fm_violin_gen(start, dur, freq, amp, *args)
+end
+
+def make_fm_violin_gen(start, dur, freq, amp, *args)
fm_index, amp_env, periodic_vibrato_rate, random_vibrato_rate = nil
periodic_vibrato_amp, random_vibrato_amp, noise_amount, noise_freq = nil
ind_noise_freq, ind_noise_amount, amp_noise_freq, amp_noise_amount = nil
- gliss_env, gliss_amount, fm1_env, fm2_env, fm3_env, fm1_rat, fm2_rat, fm3_rat = nil
- fm1_index, fm2_index, fm3_index, base, index_type, reverb_amount, degree, distance = nil
+ gliss_env, gliss_amount = nil
+ fm1_env, fm2_env, fm3_env, fm1_rat, fm2_rat, fm3_rat = nil
+ fm1_index, fm2_index, fm3_index, base, index_type = nil
optkey(args, binding,
[:fm_index, 1.0],
[:amp_env, [0, 0, 25, 1, 75, 1, 100, 0]],
@@ -286,78 +116,189 @@ def make_fm_violin(start, dur, freq, amp, *args)
[:fm2_index, false],
[:fm3_index, false],
[:base, 1.0],
- [:index_type, :violin],
- [:reverb_amount, 0.01],
- [:degree, kernel_rand(90.0)],
- [:distance, 1.0])
+ [:index_type, :violin])
frq_scl = hz2radians(freq)
modulate = fm_index.nonzero?
maxdev = frq_scl * fm_index
+ vln = (index_type == :violin or index_type == 1)
logfreq = log(freq)
sqrtfreq = sqrt(freq)
- index1 = (fm1_index or [PI, maxdev * 5.0 / logfreq].min)
- index2 = (fm2_index or [PI, maxdev * 3.0 * (8.5 - logfreq) / (3.0 + freq * 0.001)].min)
- index3 = (fm3_index or [PI, maxdev * 4.0 / sqrtfreq].min)
+ index1 = (fm1_index or [PI, maxdev * (vln ? 5.0 : 7.5) / logfreq].min)
+ index2 = (fm2_index or [PI, maxdev * 3.0 *
+ (vln ? ((8.5 - logfreq) / (3.0 + freq * 0.001)) :
+ (15.0 / sqrtfreq))].min)
+ index3 = (fm3_index or [PI, maxdev * (vln ? 4.0 : 8.0) / sqrtfreq].min)
easy_case = (noise_amount.zero? and
- fm1_env == fm2_env and
- fm1_env == fm3_env and
- fm1_rat == fm1_rat.floor and
- fm2_rat == fm2_rat.floor and
- fm3_rat == fm3_rat.floor)
+ (fm1_env == fm2_env) and
+ (fm1_env == fm3_env) and
+ (fm1_rat - fm1_rat.floor).zero? and
+ (fm2_rat - fm2_rat.floor).zero? and
+ (fm3_rat - fm3_rat.floor).zero?)
norm = ((easy_case and modulate and 1.0) or index1)
- carrier = make_oscil(:frequency, freq)
- fmosc1 = if modulate
- if easy_case
- make_polyshape(:frequency, fm1_rat * freq,
- :coeffs, partials2polynomial([fm1_rat.to_i, index1,
- (fm2_rat / fm1_rat).floor, index2,
- (fm3_rat / fm1_rat).floor, index3]))
- else
- make_oscil(:frequency, fm1_rat * freq)
- end
+ carrier = make_oscil(freq)
+ fmosc1 = fmosc2 = fmosc3 = false
+ indf1 = indf2 = indf3 = false
+ if modulate
+ indf1 = make_env(fm1_env, norm, dur)
+ if easy_case
+ a = [fm1_rat.to_i, index1,
+ (fm2_rat / fm1_rat).floor, index2,
+ (fm3_rat / fm1_rat).floor, index3]
+ coe = partials2polynomial(a)
+ fmosc1 = make_polyshape(:frequency, fm1_rat * freq, :coeffs, coe)
+ else
+ indf2 = make_env(fm2_env, index2, dur)
+ indf3 = make_env(fm3_env, index3, dur)
+ if (fm1_rat * freq * 2.0) > mus_srate
+ fmosc1 = make_oscil(:frequency, freq)
+ else
+ fmosc1 = make_oscil(:frequency, fm1_rat * freq)
+ end
+ if (fm2_rat * freq * 2.0) > mus_srate
+ fmosc2 = make_oscil(:frequency, freq)
+ else
+ fmosc2 = make_oscil(:frequency, fm2_rat * freq)
+ end
+ if (fm3_rat * freq * 2.0) > mus_srate
+ fmosc3 = make_oscil(:frequency, freq)
+ else
+ fmosc3 = make_oscil(:frequency, fm3_rat * freq)
+ end
+ end
+ end
+ ampf = make_env(amp_env, amp, dur, 0.0, base)
+ frqf = make_env(gliss_env, gliss_amount * frq_scl, dur)
+ pervib = make_triangle_wave(periodic_vibrato_rate,
+ periodic_vibrato_amp * frq_scl)
+ ranvib = make_rand_interp(random_vibrato_rate,
+ random_vibrato_amp * frq_scl)
+ fm_noi = if noise_amount.nonzero?
+ make_rand(noise_freq, PI * noise_amount)
else
false
end
- fmosc2 = (modulate and (easy_case or make_oscil(:frequency, fm2_rat * freq)))
- fmosc3 = (modulate and (easy_case or make_oscil(:frequency, fm3_rat * freq)))
- ampf = make_env(:envelope, amp_env, :scaler, amp, :duration, dur, :base, base)
- indf1 = (modulate and make_env(:envelope, fm1_env, :scaler, norm, :duration, dur))
- indf2 = (modulate and
- (easy_case or make_env(:envelope, fm2_env, :scaler, index2, :duration, dur)))
- indf3 = (modulate and
- (easy_case or make_env(:envelope, fm3_env, :scaler, index3, :duration, dur)))
- frqf = make_env(:envelope, gliss_env, :scaler, gliss_amount * frq_scl, :duration, dur)
- pervib = make_triangle_wave(periodic_vibrato_rate, periodic_vibrato_amp * frq_scl)
- ranvib = make_rand_interp(random_vibrato_rate, random_vibrato_amp * frq_scl)
- fm_noi = (noise_amount.nonzero? and make_rand(noise_freq, PI * noise_amount))
- ind_noi = ((ind_noise_amount.nonzero? and ind_noise_freq.nonzero?) and
- make_rand_interp(ind_noise_freq, ind_noise_amount))
- amp_noi = ((amp_noise_amount.nonzero? and amp_noise_freq.nonzero?) and
- make_rand_interp(amp_noise_freq, amp_noise_amount))
+ ind_noi = if ind_noise_amount.nonzero? and ind_noise_freq.nonzero?
+ make_rand_interp(ind_noise_freq, ind_noise_amount)
+ else
+ false
+ end
+ amp_noi = if amp_noise_amount.nonzero? and amp_noise_freq.nonzero?
+ make_rand_interp(amp_noise_freq, amp_noise_amount)
+ else
+ false
+ end
fuzz = modulation = 0.0
ind_fuzz = amp_fuzz = 1.0
- fnc = lambda do |y|
- fuzz = rand(fm_noi) if noise_amount.nonzero?
- vib = env(frqf) + triangle_wave(pervib) + rand_interp(ranvib)
- ind_fuzz = 1.0 + rand_interp(ind_noi) if ind_noi
- amp_fuzz = 1.0 + rand_interp(amp_noi) if amp_noi
- if modulate
- modulation = if easy_case
- env(indf1) * polyshape(fmosc1, 1.0, vib)
- else
- (env(indf1) * oscil(fmosc1, fm1_rat * vib + fuzz) +
- env(indf2) * oscil(fmosc2, fm2_rat * vib + fuzz) +
- env(indf3) * oscil(fmosc3, fm3_rat * vib + fuzz))
- end
+ if modulate
+ if easy_case
+ lambda do |y|
+ vib = env(frqf) + triangle_wave(pervib) + rand_interp(ranvib)
+ ind_fuzz = 1.0 + rand_interp(ind_noi) if ind_noi
+ amp_fuzz = 1.0 + rand_interp(amp_noi) if amp_noi
+ modulation = env(indf1) * polyshape(fmosc1, 1.0, vib)
+ env(ampf) * amp_fuzz * oscil(carrier, vib + ind_fuzz * modulation)
+ end
+ else
+ lambda do |y|
+ fuzz = rand(fm_noi) if fm_noi
+ vib = env(frqf) + triangle_wave(pervib) + rand_interp(ranvib)
+ ind_fuzz = 1.0 + rand_interp(ind_noi) if ind_noi
+ amp_fuzz = 1.0 + rand_interp(amp_noi) if amp_noi
+ modulation = (env(indf1) * oscil(fmosc1, fm1_rat * vib + fuzz) +
+ env(indf2) * oscil(fmosc2, fm2_rat * vib + fuzz) +
+ env(indf3) * oscil(fmosc3, fm3_rat * vib + fuzz))
+ env(ampf) * amp_fuzz * oscil(carrier, vib + ind_fuzz * modulation)
+ end
end
- env(ampf) * amp_fuzz * oscil(carrier, vib + ind_fuzz * modulation)
- end
- if get_args(args, :thunk?, false)
- # returns a thunk for vct_map!()
- lambda do | | fnc.call(0) end
else
- # returns a proc with one arg for map_channel() etc.
- fnc
+ lambda do |y|
+ vib = env(frqf) + triangle_wave(pervib) + rand_interp(ranvib)
+ ind_fuzz = 1.0 + rand_interp(ind_noi) if ind_noi
+ amp_fuzz = 1.0 + rand_interp(amp_noi) if amp_noi
+ env(ampf) * amp_fuzz * oscil(carrier, vib + ind_fuzz)
+ end
+ end
+end
+
+add_help(:jc_reverb,
+ "jc_reverb(*args)
+ :volume = 1.0
+ :delay1 = 0.013
+ :delay2 = 0.011
+ :delay3 = 0.015
+ :delay4 = 0.017
+ :low_pass = false
+ :double = false
+ :amp_env = false
+Chowning reverb")
+def jc_reverb(*args)
+ low_pass, volume, amp_env, delay1, delay2, delay3, delay4, double = nil
+ optkey(args, binding,
+ [:volume, 1.0],
+ [:delay1, 0.013],
+ [:delay2, 0.011],
+ [:delay3, 0.015],
+ [:delay4, 0.017],
+ [:low_pass, false],
+ [:double, false],
+ [:amp_env, false])
+ chan2 = (@channels > 1)
+ chan4 = (@channels == 4)
+ if double and chan4
+ error("%s: not set up for doubled reverb in quad", get_func_name)
+ end
+ allpass1 = make_all_pass(-0.7, 0.7, 1051)
+ allpass2 = make_all_pass(-0.7, 0.7, 337)
+ allpass3 = make_all_pass(-0.7, 0.7, 113)
+ comb1 = make_comb(0.742, 4799)
+ comb2 = make_comb(0.733, 4999)
+ comb3 = make_comb(0.715, 5399)
+ comb4 = make_comb(0.697, 5801)
+ outdel1 = make_delay((delay1 * @srate).round)
+ outdel2 = (chan2 ? make_delay((delay2 * @srate).round) : false)
+ outdel3 = ((chan4 or double) ? make_delay((delay3 * @srate).round) : false)
+ outdel4 = ((chan4 or (double and chan2)) ?
+ make_delay((delay4 * @srate).round) : false)
+ envA = if amp_env
+ make_env(:envelope, amp_env,
+ :scaler, volume,
+ :duration, ws_duration(@revfile) + @decay_time)
+ else
+ false
+ end
+ comb_sum_1 = comb_sum = 0.0
+ out_frample = Vct.new(@channels)
+ run_reverb() do |ho, i|
+ allpass_sum = all_pass(allpass3, all_pass(allpass2,
+ all_pass(allpass1, ho)))
+ comb_sum_2, comb_sum_1 = comb_sum_1, comb_sum
+ comb_sum = (comb(comb1, allpass_sum) + comb(comb2, allpass_sum) +
+ comb(comb3, allpass_sum) + comb(comb4, allpass_sum))
+ all_sums = if low_pass
+ 0.25 * (comb_sum + comb_sum_2) + 0.5 * comb_sum_1
+ else
+ comb_sum
+ end
+ delA = delay(outdel1, all_sums)
+ if double
+ delA += delay(outdel3, all_sums)
+ end
+ if envA
+ volume = env(envA)
+ end
+ out_frample[0] = volume * delA
+ if chan2
+ delB = delay(outdel2, all_sums)
+ if double
+ delB += delay(outdel4, all_sums)
+ end
+ out_frample[1] = volume * delB
+ if chan4
+ out_frample[2] = volume * delay(outdel3, all_sums)
+ out_frample[3] = volume * delay(outdel4, all_sums)
+ end
+ end
+ out_frample
end
end
diff --git a/v.scm b/v.scm
index b5f12c6..5b3b015 100644
--- a/v.scm
+++ b/v.scm
@@ -1,14 +1,16 @@
(provide 'snd-v.scm)
-(if (and (not (provided? 'snd-ws.scm))
- (not (provided? 'sndlib-ws.scm)))
- (load "ws.scm"))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
-;;; this version of the fm-violin assumes it is running within with-sound (where *output* and *reverb* are defined)
+(define default-index-env (float-vector 0 1 25 .4 75 .6 100 0))
+(define default-amp-env (float-vector 0 0 25 1 75 1 100 0))
+(define default-gliss-env (float-vector 0 0 100 0))
(definstrument (fm-violin startime dur frequency amplitude
(fm-index 1.0)
- (amp-env '(0 0 25 1 75 1 100 0))
+ amp-env
(periodic-vibrato-rate 5.0)
(random-vibrato-rate 16.0)
(periodic-vibrato-amplitude 0.0025)
@@ -19,18 +21,18 @@
(ind-noise-amount 0.0)
(amp-noise-freq 20.0)
(amp-noise-amount 0.0)
- (gliss-env '(0 0 100 0))
+ (gliss-env default-gliss-env)
(glissando-amount 0.0)
- (fm1-env '(0 1 25 .4 75 .6 100 0))
- (fm2-env '(0 1 25 .4 75 .6 100 0))
- (fm3-env '(0 1 25 .4 75 .6 100 0))
+ fm1-env
+ fm2-env
+ fm3-env
(fm1-rat 1.0)
(fm2-rat 3.0)
(fm3-rat 4.0)
- (fm1-index #f)
- (fm2-index #f)
- (fm3-index #f)
- (degree #f)
+ fm1-index
+ fm2-index
+ fm3-index
+ degree
(distance 1.0)
(reverb-amount 0.01)
(base 1.0))
@@ -48,91 +50,131 @@
(fm2-rat 3.0) (fm1-index #f) (fm2-index #f)
(fm3-index #f) (degree #f) (distance 1.0)
(reverb-amount 0.01) (base 1.0))
-This version of the fm-violin assumes it is running within with-sound (where *output* and *reverb* are defined).
+
(with-sound () (fm-violin 0 1 440 .1))"
- (let* ((beg (seconds->samples startime))
- (len (seconds->samples dur))
- (end (+ beg len))
- (frq-scl (hz->radians frequency))
- (modulate (not (zero? fm-index)))
- (maxdev (* frq-scl fm-index))
- (logfreq (log frequency))
- (sqrtfreq (sqrt frequency))
- (index1 (or fm1-index (min pi (* maxdev (/ 5.0 logfreq)))))
- (index2 (or fm2-index (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001)))))))
- (index3 (or fm3-index (min pi (* maxdev (/ 4.0 sqrtfreq)))))
- (easy-case (and (zero? noise-amount)
- (equal? fm1-env fm2-env)
- (equal? fm1-env fm3-env)
- (= fm1-rat (floor fm1-rat))
- (= fm2-rat (floor fm2-rat))
- (= fm3-rat (floor fm3-rat))
- (integer? (rationalize (/ fm2-rat fm1-rat))) ; might be 2=2 but 1=3 or whatever
- (integer? (rationalize (/ fm3-rat fm1-rat)))))
- (norm (or (and easy-case modulate 1.0) index1))
- (carrier (make-oscil frequency))
- (fmosc1 (if modulate
- (if easy-case
- (make-polywave (* fm1-rat frequency)
- (list (floor fm1-rat) index1
- (floor (/ fm2-rat fm1-rat)) index2
- (floor (/ fm3-rat fm1-rat)) index3)
- mus-chebyshev-second-kind)
- (make-oscil (* fm1-rat frequency)))
- #f))
- (fmosc2 (and modulate (or easy-case (make-oscil (* fm2-rat frequency)))))
- (fmosc3 (and modulate (or easy-case (make-oscil (* fm3-rat frequency)))))
- (ampf (make-env amp-env :scaler amplitude :base base :duration dur))
- (indf1 (and modulate (make-env fm1-env norm :duration dur)))
- (indf2 (and modulate (or easy-case (make-env fm2-env index2 :duration dur))))
- (indf3 (and modulate (or easy-case (make-env fm3-env index3 :duration dur))))
- (frqf (make-env gliss-env (* glissando-amount frq-scl) :duration dur))
- (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
- (ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
- (fm-noi (if (not (= 0.0 noise-amount))
- (make-rand noise-freq (* pi noise-amount))
- #f))
- (ind-noi (if (and (not (= 0.0 ind-noise-amount)) (not (= 0.0 ind-noise-freq)))
- (make-rand-interp ind-noise-freq ind-noise-amount)
- #f))
- (amp-noi (if (and (not (= 0.0 amp-noise-amount)) (not (= 0.0 amp-noise-freq)))
- (make-rand-interp amp-noise-freq amp-noise-amount)
- #f))
- (locs (make-locsig (or degree (random 90.0)) distance reverb-amount))
- (vib 0.0)
- (modulation 0.0)
- (fuzz 0.0)
- (ind-fuzz 1.0)
- (amp-fuzz 1.0))
- (ws-interrupt?)
- (if (or (not easy-case) ind-noi amp-noi (> noise-amount 0.0) (not modulate))
- (run
- (do ((i beg (+ i 1)))
- ((= i end))
- (if (not (= 0.0 noise-amount))
- (set! fuzz (rand fm-noi)))
- (set! vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
- (if ind-noi (set! ind-fuzz (+ 1.0 (rand-interp ind-noi))))
- (if amp-noi (set! amp-fuzz (+ 1.0 (rand-interp amp-noi))))
- (if modulate
- (if easy-case
- (set! modulation
- (* (env indf1)
- (polywave fmosc1 vib)))
- (set! modulation
- (+ (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
- (* (env indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
- (* (env indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))))
- (locsig locs i (* (env ampf) amp-fuzz
- (oscil carrier (+ vib (* ind-fuzz modulation)))))))
- (run
- (do ((i beg (+ 1 i)))
- ((= i end))
- (let* ((vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib))))
- (locsig locs i (* (env ampf)
- (oscil carrier (+ vib (* (env indf1)
- (polywave fmosc1 vib))))))))))))
+ (let ((beg (seconds->samples startime))
+ (end (seconds->samples (+ startime dur)))
+ (frq-scl (hz->radians frequency))
+ (logfreq (log frequency))
+ (sqrtfreq (sqrt frequency))
+ (maxdev (* (hz->radians frequency) fm-index)))
+
+ (if (>= (* 2 fm1-rat frequency) *clm-srate*) (set! fm1-rat 1.0))
+ (if (>= (* 2 fm2-rat frequency) *clm-srate*) (set! fm2-rat 1.0))
+ (if (>= (* 2 fm3-rat frequency) *clm-srate*) (set! fm3-rat 1.0))
+
+ (let ((index1 (or fm1-index (min pi (* maxdev (/ 5.0 logfreq)))))
+ (index2 (or fm2-index (min pi (* maxdev 3.0 (/ (- 8.5 logfreq) (+ 3.0 (* frequency .001)))))))
+ (index3 (or fm3-index (min pi (* maxdev (/ 4.0 sqrtfreq)))))
+ (easy-case (and (zero? noise-amount)
+ (equal? fm1-env fm2-env)
+ (equal? fm1-env fm3-env)
+ (= fm1-rat (floor fm1-rat))
+ (= fm2-rat (floor fm2-rat))
+ (= fm3-rat (floor fm3-rat))
+ (integer? (rationalize (/ fm2-rat fm1-rat))) ; might be 2=2 but 1=3 or whatever
+ (integer? (rationalize (/ fm3-rat fm1-rat))))))
+ (let ((norm (if easy-case 1.0 index1)))
+ (let ((fmosc1 (if easy-case
+ (make-polywave (* fm1-rat frequency)
+ (list (floor fm1-rat) index1
+ (floor (/ fm2-rat fm1-rat)) index2
+ (floor (/ fm3-rat fm1-rat)) index3)
+ mus-chebyshev-second-kind)
+ (make-oscil (* fm1-rat frequency))))
+ (indf1 (make-env (or fm1-env default-index-env) norm :duration dur))
+ (indf2 (or easy-case (make-env (or fm2-env default-index-env) index2 :duration dur)))
+ (indf3 (or easy-case (make-env (or fm3-env default-index-env) index3 :duration dur)))
+ (frqf (make-env gliss-env (* glissando-amount frq-scl) :duration dur))
+ (pervib (make-triangle-wave periodic-vibrato-rate (* periodic-vibrato-amplitude frq-scl)))
+ (ranvib (make-rand-interp random-vibrato-rate (* random-vibrato-amplitude frq-scl)))
+ (fm-noi (and (not (zero? noise-amount))
+ (make-rand noise-freq (* pi noise-amount))))
+ (ind-noi (and (not (zero? ind-noise-amount))
+ (not (zero? ind-noise-freq))
+ (make-rand-interp ind-noise-freq ind-noise-amount)))
+ (amp-noi (and (not (zero? amp-noise-amount))
+ (not (zero? amp-noise-freq))
+ (make-rand-interp amp-noise-freq amp-noise-amount)))
+ (carrier (make-oscil frequency))
+ (fmosc2 (if (not easy-case) (make-oscil (* fm2-rat frequency))))
+ (fmosc3 (if (not easy-case) (make-oscil (* fm3-rat frequency))))
+ (ampf (make-env (or amp-env default-amp-env) :scaler amplitude :base base :duration dur))
+ (locs (make-locsig (or degree (random 90.0)) distance reverb-amount)))
+
+ (if (or (not easy-case)
+ ind-noi
+ amp-noi
+ fm-noi)
+ (let ((fuzz 0.0)
+ (vib 0.0)
+ (anoi 1.0)
+ (inoi 1.0))
+ (if easy-case ; no fm-noi here
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (if amp-noi
+ (set! anoi (* (env ampf) (+ 1.0 (rand-interp amp-noi))))
+ (set! anoi (env ampf)))
+ (if ind-noi
+ (set! inoi (+ 1.0 (rand-interp ind-noi))))
+ (set! vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
+ (locsig locs i (* anoi (oscil carrier (+ vib (* inoi (env indf1) (polywave fmosc1 vib)))))))
+
+ (if (or ind-noi amp-noi fm-noi)
+ (if (not (or ind-noi amp-noi))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((fuzz (rand fm-noi))
+ (vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib))))
+ (locsig locs i (* (env ampf)
+ (oscil carrier
+ (+ vib
+ (+ (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
+ (* (env indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
+ (* (env indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz))))))))))
+
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (if fm-noi (set! fuzz (rand fm-noi)))
+ (if amp-noi
+ (set! anoi (* (env ampf) (+ 1.0 (rand-interp amp-noi))))
+ (set! anoi (env ampf)))
+ (if ind-noi (set! inoi (+ 1.0 (rand-interp ind-noi))))
+ (set! vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
+ (locsig locs i (* anoi (oscil carrier
+ (+ vib
+ (* inoi
+ (+ (* (env indf1) (oscil fmosc1 (+ (* fm1-rat vib) fuzz)))
+ (* (env indf2) (oscil fmosc2 (+ (* fm2-rat vib) fuzz)))
+ (* (env indf3) (oscil fmosc3 (+ (* fm3-rat vib) fuzz)))))))))))
+
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib))))
+ (locsig locs i (* (env ampf)
+ (oscil carrier (+ vib
+ (+ (* (env indf1) (oscil fmosc1 (* fm1-rat vib)))
+ (* (env indf2) (oscil fmosc2 (* fm2-rat vib)))
+ (* (env indf3) (oscil fmosc3 (* fm3-rat vib)))))))))))))
+ (if (= (mus-scaler frqf) 0.0)
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
+ (locsig locs i (* (env ampf)
+ (oscil carrier (+ vib (* (env indf1)
+ (polywave fmosc1 vib))))))))
+ (do ((i beg (+ i 1)))
+ ((= i end))
+ (let ((vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib))))
+ (locsig locs i (* (env ampf)
+ (oscil carrier (+ vib (* (env indf1)
+ (polywave fmosc1 vib)))))))))))))))
+
+;; (with-sound (:statistics #t) (fm-violin 0 10 440 .1 :fm-index 2.0))
+;; (with-sound (:statistics #t) (fm-violin 0 10 440 .1 :noise-amount .01))
+;; (with-sound (:statistics #t) (fm-violin 0 10 440 .1 :ind-noise-amount .01))
+;; (with-sound (:statistics #t) (fm-violin 0 10 440 .1 :fm1-rat 1.002))
-; (fm-violin 0 1 440 .1 :fm-index 2.0)
diff --git a/vct.c b/vct.c
index 0049164..68b2cc0 100644
--- a/vct.c
+++ b/vct.c
@@ -4,14 +4,12 @@
*
* C side:
* void mus_vct_init(void) called to declare the various functions and the vct type
- * bool mus_vct_p(XEN obj) is obj a vct
- * XEN xen_make_vct(int len, mus_float_t *data) make a new vct
- * XEN xen_make_vct_wrapper(int len, mus_float_t *data) make a new vct that doesn't free data when garbage collector strikes
- * vct *xen_to_vct(XEN arg) given XEN arg, return vct
+ * bool mus_is_vct(Xen obj) is obj a vct
+ * Xen xen_make_vct(int len, mus_float_t *data) make a new vct
+ * Xen xen_make_vct_wrapper(int len, mus_float_t *data) make a new vct that doesn't free data when garbage collector strikes
+ * vct *xen_to_vct(Xen arg) given Xen arg, return vct
* void mus_vct_set_print_length(int val) set vct print length (default 10) (also mus_vct_print_length)
- * vct *mus_vct_copy(vct *vc) return copy of vc
*
- * Scheme side:
* (make-vct len (filler 0.0)) make new vct
* (vct? obj) is obj a vct
* (vct-ref v index) return v[index]
@@ -23,9 +21,11 @@
* (vct-offset! v1 scl) v1[i] += scl -> v1
* (vct-multiply! v1 v2) v1[i] *= v2[i] -> v1
* (vct-scale! v1 scl) v1[i] *= scl -> v1
+ * (vct-abs! v) v[i] = abs(v[i])
* (vct-fill! v1 val) v1[i] = val -> v1
* (vct-map! v1 proc) set each element of v1 to value of function proc()
* (vct-peak v1) max val (abs) in v
+ * (vct-equal? v1 v2 diff) is element-wise relative-difference of v1 and v2 ever greater than diff?
* (list->vct lst) return vct with elements of list lst
* (vct->list v1) return list with elements of vct v1
* (vector->vct vect) return vct with elements of vector vect
@@ -43,30 +43,99 @@
* the Snd package; others can be found in the CLM package (clm2xen.c).
*/
-#include <mus-config.h>
+#include "mus-config.h"
#if USE_SND
#include "snd.h"
#endif
+#include <stddef.h>
#include <math.h>
#include <stdlib.h>
#include <stdio.h>
-#if HAVE_STRING_H
- #include <string.h>
+#include <string.h>
+
+#if _MSC_VER
+ #pragma warning(disable: 4244)
#endif
#include "_sndlib.h"
#include "xen.h"
#include "clm.h"
#include "sndlib2xen.h"
+#include "clm2xen.h"
#include "vct.h"
-#ifndef calloc
- #define calloc(a, b) calloc(a, b)
- #define malloc(a) malloc(a)
- #define free(a) free(a)
- #define realloc(a, b) realloc(a, b)
+#if (!HAVE_SCHEME)
+struct vct {
+ mus_long_t length;
+ mus_float_t *data;
+ bool dont_free;
+};
+
+mus_long_t mus_vct_length(vct *v) {return(v->length);}
+mus_float_t *mus_vct_data(vct *v) {return(v->data);}
+#endif
+
+#if HAVE_SCHEME
+#define S_make_vct "make-float-vector"
+#define S_vct_add "float-vector-add!"
+#define S_vct_subtract "float-vector-subtract!"
+#define S_vct_copy "float-vector-copy"
+#define S_vct_length "float-vector-length"
+#define S_vct_multiply "float-vector-multiply!"
+#define S_vct_offset "float-vector-offset!"
+#define S_vct_ref "float-vector-ref"
+#define S_vct_scale "float-vector-scale!"
+#define S_vct_abs "float-vector-abs!"
+#define S_vct_fill "float-vector-fill!"
+#define S_vct_set "float-vector-set!"
+#define S_vct_peak "float-vector-peak"
+#define S_vct_equal "float-vector-equal?"
+#define S_is_vct "float-vector?"
+#define S_list_to_vct "list->float-vector"
+#define S_vct_to_list "float-vector->list"
+#define S_vector_to_vct "vector->float-vector"
+#define S_vct_to_vector "float-vector->vector"
+#define S_vct_move "float-vector-move!"
+#define S_vct_subseq "float-vector-subseq"
+#define S_vct_reverse "float-vector-reverse!"
+#define S_vct_to_string "float-vector->string"
+#define S_vct_times "float-vector*"
+#define S_vct_plus "float-vector+"
+#define A_VCT "a float-vector"
+#else
+#define S_make_vct "make-vct"
+#define S_vct_add "vct-add!"
+#define S_vct_subtract "vct-subtract!"
+#define S_vct_copy "vct-copy"
+#define S_vct_length "vct-length"
+#define S_vct_multiply "vct-multiply!"
+#define S_vct_offset "vct-offset!"
+#define S_vct_ref "vct-ref"
+#define S_vct_scale "vct-scale!"
+#define S_vct_abs "vct-abs!"
+#define S_vct_fill "vct-fill!"
+#define S_vct_set "vct-set!"
+#define S_vct_peak "vct-peak"
+#define S_vct_equal "vct-equal?"
+#define S_is_vct "vct?"
+#define S_list_to_vct "list->vct"
+#define S_vct_to_list "vct->list"
+#define S_vector_to_vct "vector->vct"
+#define S_vct_to_vector "vct->vector"
+#define S_vct_move "vct-move!"
+#define S_vct_subseq "vct-subseq"
+#define S_vct_reverse "vct-reverse!"
+#define S_vct_to_string "vct->string"
+#if HAVE_RUBY
+ #define S_vct_times "vct_multiply"
+ #define S_vct_plus "vct_add"
+#else
+ #define S_vct_times "vct*"
+ #define S_vct_plus "vct+"
+#endif
+#define A_VCT "a vct"
#endif
#ifndef PROC_FALSE
@@ -85,11 +154,6 @@
#define VCT_PRINT_LENGTH 10
#endif
-#ifndef MIN
- #define MIN(a, b) ((a > b) ? (b) : (a))
-#endif
-
-static XEN_OBJECT_TYPE vct_tag;
static int vct_print_length = VCT_PRINT_LENGTH;
void mus_vct_set_print_length(int len)
@@ -103,24 +167,24 @@ int mus_vct_print_length(void)
}
-bool mus_vct_p(XEN obj)
+vct *xen_to_vct(Xen arg)
{
- return(XEN_OBJECT_TYPE_P(obj, vct_tag));
+ if (mus_is_vct(arg))
+ return((vct *)Xen_to_vct(arg));
+ return(NULL);
}
-static XEN g_vct_p(XEN obj)
-{
- #define H_vct_p "(" S_vct_p " obj): is obj a vct"
- return(C_TO_XEN_BOOLEAN(MUS_VCT_P(obj)));
-}
+#define VCT_PRINT_BUFFER_SIZE 64
+
+#if (!HAVE_SCHEME)
-vct *xen_to_vct(XEN arg)
+static Xen_object_type_t vct_tag;
+
+bool mus_is_vct(Xen obj)
{
- if (MUS_VCT_P(arg))
- return((vct *)XEN_OBJECT_REF(arg));
- return(NULL);
+ return(Xen_c_object_is_type(obj, vct_tag));
}
@@ -136,64 +200,68 @@ static void vct_free(vct *v)
}
}
-XEN_MAKE_OBJECT_FREE_PROCEDURE(vct, free_vct, vct_free)
+Xen_wrap_free(vct, free_vct, vct_free)
-#define VCT_PRINT_BUFFER_SIZE 64
-
-char *mus_vct_to_string(vct *v)
+static char *mus_vct_to_string(vct *v)
{
- int len;
+ int len, size;
char *buf;
char flt[VCT_PRINT_BUFFER_SIZE];
+ mus_float_t *d;
if (v == NULL) return(NULL);
len = vct_print_length;
- if (len > v->length) len = v->length;
-
- buf = (char *)calloc((len + 1) * VCT_PRINT_BUFFER_SIZE, sizeof(char));
+ if (len > mus_vct_length(v)) len = mus_vct_length(v);
+ d = mus_vct_data(v);
+ size = (len + 1) * VCT_PRINT_BUFFER_SIZE;
+ buf = (char *)calloc(size, sizeof(char));
+ snprintf(buf, size, "#<vct[len=%lld" "]", mus_vct_length(v));
- sprintf(buf, "#<vct[len=" MUS_LD "]", v->length);
- if ((len > 0) && (v->data != NULL))
+ if ((len > 0) && (d != NULL))
{
int i;
strcat(buf, ":");
for (i = 0; i < len; i++)
{
- mus_snprintf(flt, VCT_PRINT_BUFFER_SIZE, " %.3f", v->data[i]);
+ snprintf(flt, VCT_PRINT_BUFFER_SIZE, " %.3f", d[i]);
strcat(buf, flt);
}
- if (v->length > vct_print_length)
+ if (mus_vct_length(v) > vct_print_length)
strcat(buf, " ...");
}
strcat(buf, ">");
return(buf);
}
+#endif
char *mus_vct_to_readable_string(vct *v)
{
- int i, len;
+ int i, len, size;
char *buf;
char flt[VCT_PRINT_BUFFER_SIZE];
+ mus_float_t *d;
if (v == NULL) return(NULL);
- len = (int)(v->length);
- buf = (char *)calloc((len + 1) * VCT_PRINT_BUFFER_SIZE, sizeof(char));
+ len = (int)(mus_vct_length(v));
+ size = (len + 1) * VCT_PRINT_BUFFER_SIZE;
+ buf = (char *)calloc(size, sizeof(char));
+ d = mus_vct_data(v);
#if HAVE_SCHEME
- sprintf(buf, "(vct");
+ snprintf(buf, size, "(float-vector");
#endif
#if HAVE_RUBY || HAVE_FORTH
- sprintf(buf, "vct(");
+ snprintf(buf, size, "vct(");
#endif
for (i = 0; i < len; i++)
{
#if HAVE_SCHEME || HAVE_FORTH
- mus_snprintf(flt, VCT_PRINT_BUFFER_SIZE, " %.3f", v->data[i]);
+ snprintf(flt, VCT_PRINT_BUFFER_SIZE, " %.3f", d[i]);
#endif
#if HAVE_RUBY
- mus_snprintf(flt, VCT_PRINT_BUFFER_SIZE, "%.3f%s", v->data[i], i + 1 < len ? ", " : "");
+ snprintf(flt, VCT_PRINT_BUFFER_SIZE, "%.3f%s", d[i], i + 1 < len ? ", " : "");
#endif
strcat(buf, flt);
}
@@ -207,80 +275,45 @@ char *mus_vct_to_readable_string(vct *v)
}
-static XEN g_vct_to_readable_string(XEN obj)
+static Xen g_vct_to_readable_string(Xen obj)
{
char *vstr;
- XEN result;
- #define H_vct_to_string "(" S_vct_to_string " v): scheme readable description of v"
+ Xen result;
+ #define H_vct_to_string "(" S_vct_to_string " v): readable description of v"
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ONLY_ARG, S_vct_to_string, "a vct");
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_to_string, A_VCT);
- vstr = mus_vct_to_readable_string(XEN_TO_VCT(obj));
- result = C_TO_XEN_STRING(vstr);
+ vstr = mus_vct_to_readable_string(Xen_to_vct(obj));
+ result = C_string_to_Xen_string(vstr);
free(vstr);
return(result);
}
-
-bool mus_vct_equalp(vct *v1, vct *v2)
+bool mus_vct_is_equal(vct *v1, vct *v2)
{
if (v1 == v2) return(true);
- return((v1->length == v2->length) &&
- (mus_arrays_are_equal(v1->data, v2->data,
+ return((mus_vct_length(v1) == mus_vct_length(v2)) &&
+ (mus_arrays_are_equal(mus_vct_data(v1), mus_vct_data(v2),
mus_float_equal_fudge_factor(),
- v1->length)));
+ mus_vct_length(v1))));
}
-static XEN g_vct_fill(XEN obj, XEN val);
-#if (HAVE_SCHEME)
-static XEN g_vct_ref(XEN obj, XEN pos);
-static XEN g_vct_set(XEN obj, XEN pos, XEN val);
-static XEN g_vct_length(XEN obj);
-static XEN g_vct_copy(XEN obj);
-
-static bool s7_mus_vct_equalp(void *uv1, void *uv2)
-{
- return(mus_vct_equalp((vct *)uv1, (vct *)uv2));
-}
-
-static XEN s7_mus_vct_apply(s7_scheme *sc, XEN obj, XEN args)
-{
- return(g_vct_ref(obj, XEN_CAR(args)));
-}
-
-static XEN s7_mus_vct_set(s7_scheme *sc, XEN obj, XEN args)
-{
- return(g_vct_set(obj, XEN_CAR(args), XEN_CADR(args)));
-}
-
-static XEN s7_mus_vct_length(s7_scheme *sc, XEN obj)
-{
- return(g_vct_length(obj));
-}
-
-static XEN s7_mus_vct_copy(s7_scheme *sc, XEN obj)
-{
- return(g_vct_copy(obj));
-}
+#if (!HAVE_SCHEME)
-static XEN s7_mus_vct_fill(s7_scheme *sc, XEN obj, XEN val)
+static Xen g_is_vct(Xen obj)
{
- return(g_vct_fill(obj, val));
+ #define H_is_vct "(" S_is_vct " obj): is obj a " S_vct
+ return(C_bool_to_Xen_boolean(mus_is_vct(obj)));
}
-#endif
-
+Xen_wrap_print(vct, print_vct, mus_vct_to_string)
-XEN_MAKE_OBJECT_PRINT_PROCEDURE(vct, print_vct, mus_vct_to_string)
-
-#if (!HAVE_SCHEME)
-static XEN equalp_vct(XEN obj1, XEN obj2)
+static Xen equalp_vct(Xen obj1, Xen obj2)
{
- if ((!(MUS_VCT_P(obj1))) || (!(MUS_VCT_P(obj2)))) return(XEN_FALSE);
- return(C_TO_XEN_BOOLEAN(mus_vct_equalp(XEN_TO_VCT(obj1), XEN_TO_VCT(obj2))));
+ if ((!(mus_is_vct(obj1))) || (!(mus_is_vct(obj2)))) return(Xen_false);
+ return(C_bool_to_Xen_boolean(mus_vct_is_equal(Xen_to_vct(obj1), Xen_to_vct(obj2))));
}
-#endif
vct *mus_vct_make(mus_long_t len)
{
@@ -295,598 +328,833 @@ vct *mus_vct_make(mus_long_t len)
}
-vct *mus_vct_free(vct *v)
+vct *mus_vct_wrap(mus_long_t len, mus_float_t *data)
{
- vct_free(v);
- return(NULL);
+ vct *new_vct;
+ new_vct = (vct *)malloc(sizeof(vct));
+ new_vct->length = len;
+ new_vct->data = data;
+ new_vct->dont_free = true;
+ return(new_vct);
}
-vct *mus_vct_copy(vct *vc)
+vct *mus_vct_free(vct *v)
{
- vct *v = NULL;
- mus_long_t len;
- if (vc)
- {
- len = vc->length;
- v = mus_vct_make(len);
- if (len > 0)
- memcpy((void *)(v->data), (void *)(vc->data), (len * sizeof(mus_float_t)));
- }
- return(v);
+ vct_free(v);
+ return(NULL);
}
-XEN xen_make_vct(mus_long_t len, mus_float_t *data)
+Xen xen_make_vct(mus_long_t len, mus_float_t *data)
{
vct *new_vct;
- if (len < 0) return(XEN_FALSE);
+ if (len < 0) return(Xen_false);
if ((len > 0) &&
(data == NULL))
- XEN_ERROR(XEN_ERROR_TYPE("out-of-memory"),
- XEN_LIST_2(C_TO_XEN_STRING(S_make_vct ": can't allocate size ~A"),
- C_TO_XEN_INT(len)));
+ Xen_error(Xen_make_error_type("out-of-memory"),
+ Xen_list_2(C_string_to_Xen_string(S_make_vct ": can't allocate size ~A"),
+ C_int_to_Xen_integer(len)));
new_vct = (vct *)malloc(sizeof(vct));
new_vct->length = len;
new_vct->data = data;
new_vct->dont_free = false;
- XEN_MAKE_AND_RETURN_OBJECT(vct_tag, new_vct, 0, free_vct);
+ return(Xen_make_object(vct_tag, new_vct, 0, free_vct));
}
-XEN xen_make_vct_wrapper(mus_long_t len, mus_float_t *data)
+Xen xen_make_vct_wrapper(mus_long_t len, mus_float_t *data)
{
vct *new_vct;
new_vct = (vct *)malloc(sizeof(vct));
new_vct->length = len;
new_vct->data = data;
new_vct->dont_free = true;
- XEN_MAKE_AND_RETURN_OBJECT(vct_tag, new_vct, 0, free_vct);
+ return(Xen_make_object(vct_tag, new_vct, 0, free_vct));
}
-XEN vct_to_xen(vct *v)
+Xen vct_to_xen(vct *v)
{
- XEN_MAKE_AND_RETURN_OBJECT(vct_tag, v, 0, free_vct);
+ return(Xen_make_object(vct_tag, v, 0, free_vct));
}
-static XEN g_make_vct(XEN len, XEN filler)
+static Xen g_vct_fill(Xen obj, Xen val);
+
+static Xen g_make_vct(Xen len, Xen filler)
{
- #if HAVE_SCHEME
- #define vct_make_example "(define v (make-vct 32 1.0))"
- #endif
#if HAVE_RUBY
#define vct_make_example "v = make_vct(32, 1.0)"
#endif
#if HAVE_FORTH
#define vct_make_example "32 1.0 make-vct value v"
#endif
+ #if HAVE_SCHEME
+ #define vct_make_example "(make-float-vector 32 1.0)"
+ #endif
- #define H_make_vct "(" S_make_vct " len :optional (initial-element 0)): returns a new vct of length len filled with \
+ #define H_make_vct "(" S_make_vct " len :optional (initial-element 0)): returns a new " S_vct " of length len filled with \
initial-element: \n " vct_make_example
mus_long_t size;
- XEN_ASSERT_TYPE(XEN_INT64_T_P(len), len, XEN_ARG_1, S_make_vct, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(filler) || XEN_NOT_BOUND_P(filler), filler, XEN_ARG_2, S_make_vct, "a number");
+ Xen_check_type(Xen_is_llong(len), len, 1, S_make_vct, "an integer");
+ Xen_check_type(Xen_is_number(filler) || !Xen_is_bound(filler), filler, 2, S_make_vct, "a number");
- size = XEN_TO_C_INT64_T(len);
+ size = Xen_llong_to_C_llong(len);
if (size < 0)
- XEN_OUT_OF_RANGE_ERROR(S_make_vct, 1, len, "len ~A < 0?");
+ Xen_out_of_range_error(S_make_vct, 1, len, "new vct size < 0?");
if ((size > mus_max_malloc()) ||
(((mus_long_t)(size * sizeof(mus_float_t))) > mus_max_malloc()))
- XEN_OUT_OF_RANGE_ERROR(S_make_vct, 1, len, "len ~A too large (see mus-max-malloc)");
+ Xen_out_of_range_error(S_make_vct, 1, len, "new vct size is too large (see mus-max-malloc)");
- if (XEN_NUMBER_P(filler))
+ if (Xen_is_number(filler))
return(g_vct_fill(xen_make_vct(size, (mus_float_t *)calloc(size, sizeof(mus_float_t))), filler));
return(xen_make_vct(size, (mus_float_t *)calloc(size, sizeof(mus_float_t))));
}
-static XEN g_vct_copy(XEN obj)
+static Xen g_vct_length(Xen obj)
+{
+ #define H_vct_length "(" S_vct_length " v): length of " S_vct " v"
+ vct *v;
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_length, A_VCT);
+ v = Xen_to_vct(obj);
+ return(C_llong_to_Xen_llong(mus_vct_length(v)));
+}
+
+
+static Xen g_vct_copy(Xen obj)
{
- #define H_vct_copy "(" S_vct_copy " v): returns a copy of vct v"
+ #define H_vct_copy "(" S_vct_copy " v): returns a copy of " S_vct " v"
vct *v;
mus_float_t *copied_data = NULL;
mus_long_t len;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ONLY_ARG, S_vct_copy, "a vct");
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_copy, A_VCT);
- v = XEN_TO_VCT(obj);
- len = v->length;
+ v = Xen_to_vct(obj);
+ len = mus_vct_length(v);
if (len > 0)
{
copied_data = (mus_float_t *)malloc(len * sizeof(mus_float_t));
- memcpy((void *)copied_data, (void *)(v->data), (len * sizeof(mus_float_t)));
+ memcpy((void *)copied_data, (void *)(mus_vct_data(v)), (len * sizeof(mus_float_t)));
}
return(xen_make_vct(len, copied_data));
}
+#else /* HAVE_SCHEME */
+vct *mus_vct_make(mus_long_t len)
+{
+ s7_int di[1];
+ di[0] = len;
+ return(s7_make_float_vector(s7, len, 1, di));
+}
-static XEN g_vct_move(XEN obj, XEN newi, XEN oldi, XEN backwards)
+Xen xen_make_vct(mus_long_t len, mus_float_t *data)
{
- #define H_vct_moveB "(" S_vct_moveB " obj new old :optional backwards): moves vct obj data from old to new: v[new++] = v[old++], or \
+ return(s7_make_float_vector_wrapper(s7, len, (s7_double *)data, 1, NULL, true)); /* freed by s7 */
+}
+
+Xen xen_make_vct_wrapper(mus_long_t len, mus_float_t *data)
+{
+ s7_int di[1];
+ di[0] = len;
+ return(s7_make_float_vector_wrapper(s7, len, (s7_double *)data, 1, di, false)); /* not freed by s7 */
+}
+
+vct *mus_vct_wrap(mus_long_t len, mus_float_t *data)
+{
+ return(xen_make_vct_wrapper(len, data));
+}
+
+static Xen g_vct_copy(Xen obj)
+{
+ #define H_vct_copy "(" S_vct_copy " v): returns a copy of " S_vct " v"
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_copy, A_VCT);
+ return(s7_vector_copy(s7, obj));
+}
+#endif
+
+
+static Xen g_vct_move(Xen obj, Xen newi, Xen oldi, Xen backwards)
+{
+ #define H_vct_moveB "(" S_vct_move " obj new old :optional backwards): moves " S_vct " obj data from old to new: v[new++] = v[old++], or \
v[new--] = v[old--] if backwards is " PROC_FALSE "."
vct *v;
mus_long_t i, j, ni, nj;
+ mus_float_t *d;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ARG_1, S_vct_moveB, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(newi), newi, XEN_ARG_2, S_vct_moveB, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(oldi), oldi, XEN_ARG_3, S_vct_moveB, "an integer");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_IF_BOUND_P(backwards), backwards, XEN_ARG_4, S_vct_moveB, "a boolean");
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_move, A_VCT);
+ Xen_check_type(Xen_is_llong(newi), newi, 2, S_vct_move, "an integer");
+ Xen_check_type(Xen_is_llong(oldi), oldi, 3, S_vct_move, "an integer");
+ Xen_check_type(Xen_is_boolean_or_unbound(backwards), backwards, 4, S_vct_move, "a boolean");
- v = XEN_TO_VCT(obj);
- ni = XEN_TO_C_INT64_T(newi);
- nj = XEN_TO_C_INT64_T(oldi);
+ v = Xen_to_vct(obj);
+ d = mus_vct_data(v);
+ ni = Xen_llong_to_C_llong(newi);
+ nj = Xen_llong_to_C_llong(oldi);
- if ((XEN_BOOLEAN_P(backwards)) &&
- (XEN_NOT_FALSE_P(backwards)))
+ if ((Xen_is_boolean(backwards)) &&
+ (!Xen_is_false(backwards)))
{
- if (ni >= v->length)
- XEN_OUT_OF_RANGE_ERROR(S_vct_moveB, 2, newi, "new-index ~A too high");
- if (nj >= v->length)
- XEN_OUT_OF_RANGE_ERROR(S_vct_moveB, 3, oldi, "old-index ~A too high");
+ if (ni >= mus_vct_length(v))
+ Xen_out_of_range_error(S_vct_move, 2, newi, "new-index too high");
+ if (nj >= mus_vct_length(v))
+ Xen_out_of_range_error(S_vct_move, 3, oldi, "old-index too high");
for (i = ni, j = nj; (j >= 0) && (i >= 0); i--, j--)
- v->data[i] = v->data[j];
+ d[i] = d[j];
}
else
{
+ mus_long_t len;
if (ni < 0)
- XEN_OUT_OF_RANGE_ERROR(S_vct_moveB, 2, newi, "new-index ~A < 0?");
+ Xen_out_of_range_error(S_vct_move, 2, newi, "new-index < 0?");
if (nj < 0)
- XEN_OUT_OF_RANGE_ERROR(S_vct_moveB, 3, oldi, "old-index ~A < 0?");
- for (i = ni, j = nj; (j < v->length) && (i < v->length); i++, j++)
- v->data[i] = v->data[j];
+ Xen_out_of_range_error(S_vct_move, 3, oldi, "old-index < 0?");
+ len = mus_vct_length(v);
+ for (i = ni, j = nj; (j < len) && (i < len); i++, j++)
+ d[i] = d[j];
}
return(obj);
}
-
-static XEN g_vct_length(XEN obj)
-{
- #define H_vct_length "(" S_vct_length " v): length of vct v"
- vct *v;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ONLY_ARG, S_vct_length, "a vct");
- v = XEN_TO_VCT(obj);
- return(C_TO_XEN_INT64_T(v->length));
-}
-
-
-static XEN g_vct_ref(XEN obj, XEN pos)
+#if (!HAVE_SCHEME)
+static Xen g_vct_ref(Xen obj, Xen pos)
{
- #define H_vct_ref "(" S_vct_ref " v n): element n of vct v, v[n]"
+ #define H_vct_ref "(" S_vct_ref " v n): element n of " S_vct " v, v[n]"
vct *v;
mus_long_t loc;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ARG_1, S_vct_ref, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(pos), pos, XEN_ARG_2, S_vct_ref, "an integer");
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_ref, A_VCT);
+ Xen_check_type(Xen_is_llong(pos), pos, 2, S_vct_ref, "an integer");
- v = XEN_TO_VCT(obj);
- loc = XEN_TO_C_INT64_T(pos);
+ v = Xen_to_vct(obj);
+ loc = Xen_llong_to_C_llong(pos);
if (loc < 0)
- XEN_OUT_OF_RANGE_ERROR(S_vct_ref, 2, pos, "index ~A < 0?");
- if (loc >= v->length)
- XEN_OUT_OF_RANGE_ERROR(S_vct_ref, 2, pos, "index ~A too high?");
+ Xen_out_of_range_error(S_vct_ref, 2, pos, "index < 0?");
+ if (loc >= mus_vct_length(v))
+ Xen_out_of_range_error(S_vct_ref, 2, pos, "index too high?");
- return(C_TO_XEN_DOUBLE(v->data[loc]));
+ return(C_double_to_Xen_real(mus_vct_data(v)[loc]));
}
-static XEN g_vct_set(XEN obj, XEN pos, XEN val)
+static Xen g_vct_set(Xen obj, Xen pos, Xen val)
{
- #define H_vct_setB "(" S_vct_setB " v n val): sets element of vct v to val, v[n] = val"
+ #define H_vct_setB "(" S_vct_set " v n val): sets element of " S_vct " v to val, v[n] = val"
vct *v;
mus_long_t loc;
+ double x;
+ mus_float_t *d;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ARG_1, S_vct_setB, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(pos), pos, XEN_ARG_2, S_vct_setB, "an integer");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(val), val, XEN_ARG_3, S_vct_setB, "a real number");
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_set, A_VCT);
+ Xen_check_type(Xen_is_llong(pos), pos, 2, S_vct_set, "an integer");
+ Xen_check_type(Xen_is_number(val), val, 3, S_vct_set, "a real number");
- v = XEN_TO_VCT(obj);
- loc = XEN_TO_C_INT64_T(pos);
+ x = Xen_real_to_C_double(val);
+ v = Xen_to_vct(obj);
+ loc = Xen_llong_to_C_llong(pos);
if (loc < 0)
- XEN_OUT_OF_RANGE_ERROR(S_vct_setB, 2, pos, "index ~A < 0?");
- if (loc >= v->length)
- XEN_OUT_OF_RANGE_ERROR(S_vct_setB, 2, pos, "index ~A >= vct-length?");
-
- v->data[loc] = XEN_TO_C_DOUBLE(val);
+ Xen_out_of_range_error(S_vct_set, 2, pos, "index < 0?");
+ if (loc >= mus_vct_length(v))
+ Xen_out_of_range_error(S_vct_set, 2, pos, "index >= vct-length?");
+
+ d = mus_vct_data(v);
+ d[loc] = x;
return(val);
}
+#endif
-static XEN g_vct_multiply(XEN obj1, XEN obj2)
+static Xen g_vct_multiply(Xen obj1, Xen obj2)
{
- #define H_vct_multiplyB "(" S_vct_multiplyB " v1 v2): element-wise multiply of vcts v1 and v2: v1[i] *= v2[i], returns v1"
- mus_long_t i, lim;
+ #define H_vct_multiplyB "(" S_vct_multiply " v1 v2): element-wise multiply of " S_vct "s v1 and v2: v1[i] *= v2[i], returns v1"
+ mus_long_t i, lim, lim1;
vct *v1, *v2;
-
- XEN_ASSERT_TYPE(MUS_VCT_P(obj1), obj1, XEN_ARG_1, S_vct_multiplyB, "a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(obj2), obj2, XEN_ARG_2, S_vct_multiplyB, "a vct");
-
- v1 = XEN_TO_VCT(obj1);
- v2 = XEN_TO_VCT(obj2);
- lim = MIN(v1->length, v2->length);
- for (i = 0; i < lim; i++) v1->data[i] *= v2->data[i];
+ mus_float_t *d1, *d2;
+
+ Xen_check_type(mus_is_vct(obj1), obj1, 1, S_vct_multiply, A_VCT);
+ Xen_check_type(mus_is_vct(obj2), obj2, 2, S_vct_multiply, A_VCT);
+
+ v1 = Xen_to_vct(obj1);
+ v2 = Xen_to_vct(obj2);
+ d1 = mus_vct_data(v1);
+ d2 = mus_vct_data(v2);
+ lim = mus_vct_length(v1);
+ lim1 = mus_vct_length(v2);
+ if (lim > lim1) lim = lim1;
+ for (i = 0; i < lim; i++) d1[i] *= d2[i];
return(obj1);
}
+static void vct_add(mus_float_t *d1, mus_float_t *d2, mus_long_t lim)
+{
+ mus_long_t i, lim8;
+ lim8 = lim - 16;
+ i = 0;
+ while (i <= lim8)
+ {
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ d1[i] += d2[i]; i++;
+ }
+ for (; i < lim; i++)
+ d1[i] += d2[i];
+}
-static XEN g_vct_add(XEN obj1, XEN obj2, XEN offs)
+static Xen g_vct_add(Xen obj1, Xen obj2, Xen offs)
{
- #define H_vct_addB "(" S_vct_addB " v1 v2 :optional (offset 0)): element-wise add of vcts v1 and v2: v1[i + offset] += v2[i], returns v1"
- mus_long_t i, lim, j;
+ #define H_vct_addB "(" S_vct_add " v1 v2 :optional (offset 0)): element-wise add of " S_vct "s v1 and v2: v1[i + offset] += v2[i], returns v1"
+ mus_long_t lim, len1;
vct *v1, *v2;
-
- XEN_ASSERT_TYPE(MUS_VCT_P(obj1), obj1, XEN_ARG_1, S_vct_addB, "a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(obj2), obj2, XEN_ARG_2, S_vct_addB, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(offs), offs, XEN_ARG_3, S_vct_addB, "an integer");
-
- v1 = XEN_TO_VCT(obj1);
- v2 = XEN_TO_VCT(obj2);
- lim = MIN(v1->length, v2->length);
+ mus_float_t *d1, *d2;
+
+ Xen_check_type(mus_is_vct(obj1), obj1, 1, S_vct_add, A_VCT);
+ Xen_check_type(mus_is_vct(obj2), obj2, 2, S_vct_add, A_VCT);
+ Xen_check_type(Xen_is_llong_or_unbound(offs), offs, 3, S_vct_add, "an integer");
+
+ v1 = Xen_to_vct(obj1);
+ v2 = Xen_to_vct(obj2);
+ d1 = mus_vct_data(v1);
+ d2 = mus_vct_data(v2);
+ len1 = mus_vct_length(v1);
+ lim = mus_vct_length(v2);
+ if (lim > len1) lim = len1;
if (lim == 0) return(obj1);
- if (XEN_INT64_T_P(offs))
+ if (Xen_is_llong(offs))
{
- j = XEN_TO_C_INT64_T(offs);
+ mus_long_t j;
+ j = Xen_llong_to_C_llong(offs);
if (j < 0)
- XEN_OUT_OF_RANGE_ERROR(S_vct_addB, 3, offs, "offset ~A < 0?");
+ Xen_out_of_range_error(S_vct_add, 3, offs, "offset < 0?");
+ if (j > len1)
+ Xen_out_of_range_error(S_vct_add, 3, offs, "offset > length of vct?");
- if ((j + lim) > v1->length)
- lim = (v1->length - j);
+ if ((j + lim) > len1)
+ lim = (len1 - j);
- for (i = 0; i < lim; i++, j++)
- v1->data[j] += v2->data[i];
+ vct_add((mus_float_t *)(d1 + j), d2, lim);
}
- else
- {
- mus_float_t *d1, *d2, *dend;
- d1 = v1->data;
- d2 = v2->data;
- dend = (mus_float_t *)(v1->data + lim);
- while (d1 != dend) (*d1++) += (*d2++); /* is this safe? or perhaps use (*d1++) = (*d1) + (*d2++)? */
+ else vct_add(d1, d2, lim);
+ return(obj1);
+}
+
- /* for (i = 0; i < lim; i++) v1->data[i] += v2->data[i]; */
+static Xen g_vct_subtract(Xen obj1, Xen obj2)
+{
+ #define H_vct_subtractB "(" S_vct_subtract " v1 v2): element-wise subtract of " S_vct "s v1 and v2: v1[i] -= v2[i], returns v1"
+ mus_long_t i, lim, lim1, lim4;
+ vct *v1, *v2;
+ mus_float_t *d1, *d2;
+
+ Xen_check_type(mus_is_vct(obj1), obj1, 1, S_vct_subtract, A_VCT);
+ Xen_check_type(mus_is_vct(obj2), obj2, 2, S_vct_subtract, A_VCT);
+
+ v1 = Xen_to_vct(obj1);
+ v2 = Xen_to_vct(obj2);
+ d1 = mus_vct_data(v1);
+ d2 = mus_vct_data(v2);
+ lim = mus_vct_length(v1);
+ lim1 = mus_vct_length(v2);
+ if (lim > lim1) lim = lim1;
+ lim4 = lim - 4;
+
+ i = 0;
+ while (i <= lim4)
+ {
+ d1[i] -= d2[i]; i++;
+ d1[i] -= d2[i]; i++;
+ d1[i] -= d2[i]; i++;
+ d1[i] -= d2[i]; i++;
}
+ for (; i < lim; i++)
+ d1[i] -= d2[i];
+
return(obj1);
}
-static XEN g_vct_subtract(XEN obj1, XEN obj2)
+static Xen g_vct_abs(Xen obj)
{
- #define H_vct_subtractB "(" S_vct_subtractB " v1 v2): element-wise subtract of vcts v1 and v2: v1[i] -= v2[i], returns v1"
+ #define H_vct_absB "(" S_vct_abs " v): v[i] = abs(v[i]), return v."
mus_long_t i, lim;
- vct *v1, *v2;
+ vct *v;
+ mus_float_t *d;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj1), obj1, XEN_ARG_1, S_vct_subtractB, "a vct");
- XEN_ASSERT_TYPE(MUS_VCT_P(obj2), obj2, XEN_ARG_2, S_vct_subtractB, "a vct");
+ Xen_check_type(mus_is_vct(obj), obj, 0, S_vct_abs, A_VCT);
- v1 = XEN_TO_VCT(obj1);
- v2 = XEN_TO_VCT(obj2);
- lim = MIN(v1->length, v2->length);
- for (i = 0; i < lim; i++) v1->data[i] -= v2->data[i];
- return(obj1);
+ v = Xen_to_vct(obj);
+ d = mus_vct_data(v);
+ lim = mus_vct_length(v);
+ for (i = 0; i < lim; i++) d[i] = fabs(d[i]);
+ return(obj);
}
-static XEN g_vct_scale(XEN obj1, XEN obj2)
+static Xen g_vct_equal(Xen uv1, Xen uv2, Xen udiff)
{
- #define H_vct_scaleB "(" S_vct_scaleB " v val): scale each element of v by val: v[i] *= val, returns v"
- mus_long_t i;
- vct *v1;
- mus_float_t scl;
+ #define H_vct_equal "(" S_vct_equal " v1 v2 diff): is element-wise relative-difference of v1 and v2 ever greater than diff?"
+ mus_long_t i, lim;
+ vct *v1, *v2;
+ mus_float_t *d1, *d2;
+ mus_float_t diff, max_diff = 0.0;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj1), obj1, XEN_ARG_1, S_vct_scaleB, "a vct");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(obj2), obj2, XEN_ARG_2, S_vct_scaleB, "a number");
+ Xen_check_type(mus_is_vct(uv1), uv1, 1, S_vct_equal, A_VCT);
+ Xen_check_type(mus_is_vct(uv2), uv2, 2, S_vct_equal, A_VCT);
+ Xen_check_type(Xen_is_number(udiff), udiff, 3, S_vct_equal, "a number");
- v1 = XEN_TO_VCT(obj1);
- if (v1->length == 0) return(obj1);
+ v1 = Xen_to_vct(uv1);
+ d1 = mus_vct_data(v1);
+ v2 = Xen_to_vct(uv2);
+ d2 = mus_vct_data(v2);
+ diff = Xen_real_to_C_double(udiff);
- scl = XEN_TO_C_DOUBLE(obj2);
+ lim = mus_vct_length(v1);
+ if (mus_vct_length(v2) < lim) lim = mus_vct_length(v2);
+
+ for (i = 0; i < lim; i++)
+ {
+ mus_float_t x1, x2, z;
+ x1 = fabs(d1[i]);
+ x2 = fabs(d2[i]);
+ z = fabs(d1[i] - d2[i]);
+ if (x1 > x2)
+ z /= x1;
+ else
+ {
+ if (x2 > 0.0)
+ z /= x2;
+ }
+ if (z > diff)
+ return(Xen_false);
+ if (z > max_diff)
+ max_diff = z;
+ }
+
+ return(C_double_to_Xen_real(max_diff));
+}
+
+static void vct_scale(mus_float_t *d, mus_float_t scl, mus_long_t len)
+{
if (scl == 0.0)
- mus_clear_array(v1->data, v1->length);
+ memset((void *)d, 0, len * sizeof(mus_float_t));
else
{
if (scl != 1.0)
- for (i = 0; i < v1->length; i++) v1->data[i] *= scl;
+ {
+ mus_long_t i, lim4;
+ lim4 = len - 4;
+ i = 0;
+ while (i <= lim4)
+ {
+ d[i++] *= scl;
+ d[i++] *= scl;
+ d[i++] *= scl;
+ d[i++] *= scl;
+ }
+ for (; i < len; i++)
+ d[i] *= scl;
+ }
}
- return(obj1);
}
-
-static XEN g_vct_offset(XEN obj1, XEN obj2)
+static Xen g_vct_scale(Xen obj1, Xen obj2)
{
- #define H_vct_offsetB "(" S_vct_offsetB " v val): add val to each element of v: v[i] += val, returns v"
- mus_long_t i;
- vct *v1;
- mus_float_t scl;
+ #define H_vct_scaleB "(" S_vct_scale " v val): scale each element of v by val: v[i] *= val, returns v"
- XEN_ASSERT_TYPE(MUS_VCT_P(obj1), obj1, XEN_ARG_1, S_vct_offsetB, "a vct");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(obj2), obj2, XEN_ARG_2, S_vct_offsetB, "a number");
+ /* Xen_check_type(s7_is_float_vector(obj1), obj1, 1, "float-vector-scale!", "a float-vector");
+ * return(s7_float_vector_scale(s7, obj1, obj2));
+ */
+ vct *v1;
- v1 = XEN_TO_VCT(obj1);
- if (v1->length == 0) return(obj1);
+ Xen_check_type(mus_is_vct(obj1), obj1, 1, S_vct_scale, A_VCT);
+ Xen_check_type(Xen_is_number(obj2), obj2, 2, S_vct_scale, "a number");
- scl = XEN_TO_C_DOUBLE(obj2);
- if (scl != 0.0)
- for (i = 0; i < v1->length; i++) v1->data[i] += scl;
+ v1 = Xen_to_vct(obj1);
+ if (mus_vct_length(v1) == 0) return(obj1);
+ vct_scale(mus_vct_data(v1), Xen_real_to_C_double(obj2), mus_vct_length(v1));
return(obj1);
}
-static XEN g_vct_fill(XEN obj1, XEN obj2)
+static Xen g_vct_offset(Xen obj1, Xen obj2)
{
- #define H_vct_fillB "(" S_vct_fillB " v val): set each element of v to val: v[i] = val, returns v"
- mus_long_t i;
+ #define H_vct_offsetB "(" S_vct_offset " v val): add val to each element of v: v[i] += val, returns v"
vct *v1;
mus_float_t scl;
+ mus_float_t *d;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj1), obj1, XEN_ARG_1, S_vct_fillB, "a vct");
- XEN_ASSERT_TYPE(XEN_NUMBER_P(obj2), obj2, XEN_ARG_2, S_vct_fillB, "a number");
+ Xen_check_type(mus_is_vct(obj1), obj1, 1, S_vct_offset, A_VCT);
+ Xen_check_type(Xen_is_number(obj2), obj2, 2, S_vct_offset, "a number");
- v1 = XEN_TO_VCT(obj1);
- if (v1->length == 0) return(obj1);
+ v1 = Xen_to_vct(obj1);
+ if (mus_vct_length(v1) == 0) return(obj1);
+ d = mus_vct_data(v1);
- scl = XEN_TO_C_DOUBLE(obj2);
- if (scl == 0.0)
- mus_clear_array(v1->data, v1->length);
- else for (i = 0; i < v1->length; i++) v1->data[i] = scl;
+ scl = Xen_real_to_C_double(obj2);
+ if (scl != 0.0)
+ {
+ mus_long_t i;
+ for (i = 0; i < mus_vct_length(v1); i++)
+ d[i] += scl;
+ }
return(obj1);
}
-
-static XEN g_vct_mapB(XEN obj, XEN proc)
+#if HAVE_SCHEME
+#define S_vct_spatter "float-vector-spatter"
+static Xen g_vct_spatter(Xen fv, XEN iv, XEN end, XEN val)
{
- #if HAVE_SCHEME
- #define vct_map_example "(vct-map! v (lambda () 3.0))"
- #define vct_fill_example "(vct-fill! v 3.0)"
- #endif
- #if HAVE_RUBY
- #define vct_map_example "vct_map!(v, lambda do | | 3.0 end)"
- #define vct_fill_example "vct_fill!(v, 3.0)"
- #endif
- #if HAVE_FORTH
- #define vct_map_example "v lambda: <{ -- val }> 3.0 ; vct-map!"
- #define vct_fill_example "v 3.0 vct-fill!"
- #endif
+ #define H_vct_spatter "(" S_vct_spatter " fv iv end val) places val in fv at locations determined by iv"
+ s7_double *fv_vals;
+ s7_int *iv_vals;
+ s7_double x;
+ int i, len;
- #define H_vct_mapB "(" S_vct_mapB " v proc): set each element of v to value of proc (a thunk): v[i] = (proc), returns \
-v. " vct_map_example " is the same as " vct_fill_example
+ if (!s7_is_float_vector(fv)) s7_wrong_type_arg_error(s7, S_vct_spatter, 1, fv, "a float-vector");
+ if (!s7_is_int_vector(iv)) s7_wrong_type_arg_error(s7, S_vct_spatter, 2, iv, "an int-vector");
+ if (!s7_is_integer(end)) s7_wrong_type_arg_error(s7, S_vct_spatter, 3, end, "an integer");
+ if (!s7_is_real(val)) s7_wrong_type_arg_error(s7, S_vct_spatter, 4, val, "a real");
- mus_long_t i;
- vct *v;
+ fv_vals = s7_float_vector_elements(fv);
+ iv_vals = s7_int_vector_elements(iv);
+ len = s7_integer(end);
+ x = s7_real(val);
+ for (i = 0; i < len; i++)
+ fv_vals[iv_vals[i]] = x;
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ARG_1, S_vct_mapB, "a vct");
+ return(val);
+}
- v = XEN_TO_VCT(obj);
-#if HAVE_SCHEME && USE_SND
- {
- struct ptree *pt = NULL;
- if ((optimization(ss)) > 0)
- {
- pt = mus_run_form_to_ptree_0_f(XEN_PROCEDURE_SOURCE(proc));
- if (pt)
- {
- for (i = 0; i < v->length; i++)
- v->data[i] = mus_run_evaluate_ptree_0f2f(pt);
- mus_run_free_ptree(pt);
- return(obj);
- }
- }
-
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(proc) && (XEN_REQUIRED_ARGS_OK(proc, 0)), proc, XEN_ARG_2, S_vct_mapB, "a thunk");
- for (i = 0; i < v->length; i++)
- v->data[i] = XEN_TO_C_DOUBLE(XEN_CALL_0_NO_CATCH(proc));
- }
-#else
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(proc) && (XEN_REQUIRED_ARGS_OK(proc, 0)), proc, XEN_ARG_2, S_vct_mapB, "a thunk");
- for (i = 0; i < v->length; i++)
- v->data[i] = XEN_TO_C_DOUBLE(XEN_CALL_0_NO_CATCH(proc));
+#define S_vct_interpolate "float-vector-interpolate"
+static Xen g_vct_interpolate(Xen fv, Xen start_index, Xen end_index, Xen start_x, XEN incr, XEN val1, XEN val2)
+{
+ #define H_vct_interpolate "(" S_vct_interpolate " fv index0 index1 x0 dx x1 x2) sets the values of fv between\
+index0 and index1 interpolating between x2 and x1 by incrementing x0 by dx"
+ s7_double x0, dx, x1, x2;
+ int i, beg, lim;
+ s7_double *fv_vals;
+ fv_vals = s7_float_vector_elements(fv);
+
+ if (!s7_is_float_vector(fv)) s7_wrong_type_arg_error(s7, S_vct_interpolate, 1, fv, "a float-vector");
+ if (!s7_is_integer(start_index)) s7_wrong_type_arg_error(s7, S_vct_spatter, 2, start_index, "an integer");
+ if (!s7_is_integer(end_index)) s7_wrong_type_arg_error(s7, S_vct_spatter, 3, end_index, "an integer");
+ if (!s7_is_real(start_x)) s7_wrong_type_arg_error(s7, S_vct_spatter, 4, start_x, "a real");
+ if (!s7_is_real(incr)) s7_wrong_type_arg_error(s7, S_vct_spatter, 5, incr, "a real");
+ if (!s7_is_real(val1)) s7_wrong_type_arg_error(s7, S_vct_spatter, 6, val1, "a real");
+ if (!s7_is_real(val2)) s7_wrong_type_arg_error(s7, S_vct_spatter, 7, val2, "a real");
+
+ beg = s7_integer(start_index);
+ lim = s7_integer(end_index);
+ x0 = s7_real(start_x);
+ dx = s7_real(incr);
+ x1 = s7_real(val1);
+ x2 = s7_real(val2);
+ for (i = beg; i < lim; i++, x0 += dx)
+ fv_vals[i] = (x0 * x1) + ((1.0 - x0) * x2);
+ return(val1);
+}
#endif
- return(obj);
+
+#if (!HAVE_SCHEME)
+static Xen g_vct_fill(Xen obj1, Xen obj2)
+{
+ #define H_vct_fillB "(" S_vct_fill " v val): set each element of v to val: v[i] = val, returns v"
+ mus_long_t i; /* unsigned int is much slower */
+ vct *v1;
+ mus_float_t scl;
+ mus_float_t *d;
+
+ Xen_check_type(mus_is_vct(obj1), obj1, 1, S_vct_fill, A_VCT);
+ Xen_check_type(Xen_is_number(obj2), obj2, 2, S_vct_fill, "a number");
+
+ v1 = Xen_to_vct(obj1);
+ if (mus_vct_length(v1) == 0) return(obj1);
+ d = mus_vct_data(v1);
+
+ scl = Xen_real_to_C_double(obj2);
+ if (scl == 0.0)
+ memset((void *)d, 0, mus_vct_length(v1) * sizeof(mus_float_t));
+ else
+ {
+ mus_long_t lim8;
+ lim8 = mus_vct_length(v1) - 8;
+ i = 0;
+ while (i <= lim8)
+ {
+ d[i++] = scl;
+ d[i++] = scl;
+ d[i++] = scl;
+ d[i++] = scl;
+ d[i++] = scl;
+ d[i++] = scl;
+ d[i++] = scl;
+ d[i++] = scl;
+ }
+ for (; i < mus_vct_length(v1); i++)
+ d[i] = scl;
+ }
+ return(obj1);
}
+#endif
double mus_vct_peak(vct *v)
{
mus_float_t val = 0.0, absv;
- mus_float_t *d1, *dend;
+ mus_float_t *d;
+ mus_long_t i, lim4, len;
- if (v->length == 0) return(0.0);
+ len = mus_vct_length(v);
- val = fabs(v->data[0]);
- d1 = (mus_float_t *)(v->data + 1);
- dend = (mus_float_t *)(v->data + v->length);
- while (d1 != dend)
+ if (len == 0) return(0.0);
+ lim4 = len - 4;
+ i = 1;
+ d = mus_vct_data(v);
+ val = fabs(d[0]);
+
+ while (i <= lim4)
{
- absv = fabs(*d1++);
+ absv = fabs(d[i++]);
+ if (absv > val) val = absv;
+ absv = fabs(d[i++]);
+ if (absv > val) val = absv;
+ absv = fabs(d[i++]);
+ if (absv > val) val = absv;
+ absv = fabs(d[i++]);
if (absv > val) val = absv;
}
+ for (; i < len; i++)
+ {
+ absv = fabs(d[i]);
+ if (absv > val) val = absv;
+ }
return(val);
}
-XEN g_vct_peak(XEN obj)
+Xen g_vct_peak(Xen obj)
{
#define H_vct_peak "(" S_vct_peak " v): max of abs of elements of v"
- XEN_ASSERT_TYPE(MUS_VCT_P(obj), obj, XEN_ONLY_ARG, S_vct_peak, "a vct");
- return(C_TO_XEN_DOUBLE(mus_vct_peak(XEN_TO_VCT(obj))));
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_peak, A_VCT);
+ return(C_double_to_Xen_real(mus_vct_peak(Xen_to_vct(obj))));
}
-static XEN g_vct_subseq(XEN vobj, XEN start, XEN end, XEN newv)
+#if HAVE_SCHEME
+#define S_vct_peak_and_location "float-vector-peak-and-location"
+#else
+#define S_vct_peak_and_location "vct-peak-and-location"
+#endif
+
+static Xen g_vct_peak_and_location(Xen obj)
{
- #define H_vct_subseq "(" S_vct_subseq " v start :optional end vnew): v[start..end], placed in vnew if given or new vct"
+ #define H_vct_peak_and_location "(" S_vct_peak_and_location " v): max of abs of elements of v and its position in v"
+ mus_float_t val = 0.0;
+ mus_long_t i, loc = 0;
+ vct *v;
+ mus_float_t *d;
+
+ Xen_check_type(mus_is_vct(obj), obj, 1, S_vct_peak_and_location, "a " S_vct);
+ v = Xen_to_vct(obj);
+ d = mus_vct_data(v);
+
+ for (i = 0; i < mus_vct_length(v); i++)
+ {
+ mus_float_t absv;
+ absv = fabs(d[i]);
+ if (absv > val)
+ {
+ val = absv;
+ loc = i;
+ }
+ }
+ return(Xen_list_2(C_double_to_Xen_real(val), C_int_to_Xen_integer(loc)));
+}
+
+
+static Xen g_vct_subseq(Xen vobj, Xen start, Xen end, Xen newv)
+{
+ #define H_vct_subseq "(" S_vct_subseq " v start :optional end vnew): v[start..end], placed in vnew if given or new " S_vct
vct *vold, *vnew;
- XEN res;
- mus_long_t i, old_len, new_len, j, istart, iend;
+ mus_float_t *dnew, *dold;
+ Xen res;
+ mus_long_t i, old_len, new_len, j, istart;
- XEN_ASSERT_TYPE(MUS_VCT_P(vobj), vobj, XEN_ARG_1, S_vct_subseq, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_P(start), start, XEN_ARG_2, S_vct_subseq, "an integer");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(end), end, XEN_ARG_3, S_vct_subseq, "an integer");
+ Xen_check_type(mus_is_vct(vobj), vobj, 1, S_vct_subseq, A_VCT);
+ Xen_check_type(Xen_is_llong(start), start, 2, S_vct_subseq, "an integer");
+ Xen_check_type(Xen_is_llong_or_unbound(end), end, 3, S_vct_subseq, "an integer");
- istart = XEN_TO_C_INT64_T(start);
+ istart = Xen_llong_to_C_llong(start);
if (istart < 0)
- XEN_OUT_OF_RANGE_ERROR(S_vct_subseq, 2, start, "start ~A < 0?");
+ Xen_out_of_range_error(S_vct_subseq, 2, start, "start < 0?");
- vold = XEN_TO_VCT(vobj);
- old_len = vold->length;
+ vold = Xen_to_vct(vobj);
+ old_len = mus_vct_length(vold);
- if (XEN_INT64_T_P(end))
+ if (Xen_is_llong(end))
{
- iend = XEN_TO_C_INT64_T(end);
+ mus_long_t iend;
+ iend = Xen_llong_to_C_llong(end);
if (iend < istart)
- XEN_OUT_OF_RANGE_ERROR(S_vct_subseq, 3, end, "end ~A < start?");
+ Xen_out_of_range_error(S_vct_subseq, 3, end, "end < start?");
if (iend > old_len)
- XEN_OUT_OF_RANGE_ERROR(S_vct_subseq, 3, end, "end ~A > vct length?");
+ Xen_out_of_range_error(S_vct_subseq, 3, end, "end > vct length?");
new_len = iend - istart + 1;
}
else new_len = old_len - istart;
if (new_len <= 0)
- return(XEN_FALSE);
+ return(Xen_false);
- if (MUS_VCT_P(newv))
+ if (mus_is_vct(newv))
res = newv;
else res = xen_make_vct(new_len, (mus_float_t *)calloc(new_len, sizeof(mus_float_t)));
- vnew = XEN_TO_VCT(res);
- if (new_len > vnew->length)
- new_len = vnew->length;
+ vnew = Xen_to_vct(res);
+
+ if (new_len > mus_vct_length(vnew))
+ new_len = mus_vct_length(vnew);
+ dnew = mus_vct_data(vnew);
+ dold = mus_vct_data(vold);
+
for (i = istart, j = 0; (j < new_len) && (i < old_len); i++, j++)
- vnew->data[j] = vold->data[i];
+ dnew[j] = dold[i];
return(res);
}
-XEN xen_list_to_vct(XEN lst)
+Xen xen_list_to_vct(Xen lst)
{
- #define H_list_to_vct "(" S_list_to_vct " lst): returns a new vct filled with elements of list lst"
+ #define H_list_to_vct "(" S_list_to_vct " lst): returns a new " S_vct " filled with elements of list lst"
mus_long_t len = 0, i;
vct *v;
- XEN scv, lst1;
-
- XEN_ASSERT_TYPE(XEN_LIST_P_WITH_LENGTH(lst, len), lst, XEN_ONLY_ARG, S_list_to_vct, "a list");
+ mus_float_t *d;
+ Xen scv, lst1;
+ Xen_check_type(Xen_is_list(lst), lst, 1, S_list_to_vct, "a list");
+ len = Xen_list_length(lst);
if (len > 0)
scv = xen_make_vct(len, (mus_float_t *)calloc(len, sizeof(mus_float_t)));
else scv = xen_make_vct(0, NULL);
- v = XEN_TO_VCT(scv);
- for (i = 0, lst1 = XEN_COPY_ARG(lst); i < len; i++, lst1 = XEN_CDR(lst1))
+ v = Xen_to_vct(scv);
+ d = mus_vct_data(v);
+ for (i = 0, lst1 = Xen_copy_arg(lst); i < len; i++, lst1 = Xen_cdr(lst1))
{
- if (XEN_NUMBER_P(XEN_CAR(lst1)))
- v->data[i] = (mus_float_t)XEN_TO_C_DOUBLE_OR_ELSE(XEN_CAR(lst1), 0.0);
- else XEN_WRONG_TYPE_ARG_ERROR(S_list_to_vct, i, XEN_CAR(lst1), "a number");
+ if (Xen_is_number(Xen_car(lst1)))
+ d[i] = (mus_float_t)Xen_real_to_C_double(Xen_car(lst1));
+ else Xen_wrong_type_arg_error(S_list_to_vct, i, Xen_car(lst1), "a number");
}
return(scv);
}
-static XEN g_vct(XEN args)
+Xen mus_array_to_list(mus_float_t *arr, mus_long_t i, mus_long_t len)
{
- #define H_vct "(" S_vct " args...): returns a new vct with args as contents; same as " S_list_to_vct ": (vct 1 2 3)"
- return(xen_list_to_vct(args));
+ if (i < (len - 1))
+ return(Xen_cons(C_double_to_Xen_real(arr[i]),
+ mus_array_to_list(arr, i + 1, len)));
+ else return(Xen_cons(C_double_to_Xen_real(arr[i]),
+ Xen_empty_list));
}
-XEN mus_array_to_list(mus_float_t *arr, mus_long_t i, mus_long_t len)
+#if (!HAVE_SCHEME)
+static Xen g_vct(Xen args)
{
- if (i < (len - 1))
- return(XEN_CONS(C_TO_XEN_DOUBLE(arr[i]),
- mus_array_to_list(arr, i + 1, len)));
- else return(XEN_CONS(C_TO_XEN_DOUBLE(arr[i]),
- XEN_EMPTY_LIST));
+ #define H_vct "(" S_vct " args...): returns a new " S_vct " with args as contents; same as " S_list_to_vct ": (" S_vct " 1 2 3)"
+ return(xen_list_to_vct(args));
}
-static XEN g_vct_to_list(XEN vobj)
+static Xen g_vct_to_list(Xen vobj)
{
- #define H_vct_to_list "(" S_vct_to_list " v): returns a new list with elements of vct v"
+ #define H_vct_to_list "(" S_vct_to_list " v): returns a new list with elements of " S_vct " v"
vct *v;
- XEN_ASSERT_TYPE(MUS_VCT_P(vobj), vobj, XEN_ONLY_ARG, S_vct_to_list, "a vct");
+ Xen_check_type(mus_is_vct(vobj), vobj, 1, S_vct_to_list, A_VCT);
- v = XEN_TO_VCT(vobj);
- if (v->length == 0)
- return(XEN_EMPTY_LIST);
+ v = Xen_to_vct(vobj);
+ if (mus_vct_length(v) == 0)
+ return(Xen_empty_list);
- return(mus_array_to_list(v->data, 0, v->length));
+ return(mus_array_to_list(mus_vct_data(v), 0, mus_vct_length(v)));
}
-static XEN g_vector_to_vct(XEN vect)
+static Xen g_vector_to_vct(Xen vect)
{
- #define H_vector_to_vct "(" S_vector_to_vct " vect): returns a new vct with the elements of vector vect"
+ #define H_vector_to_vct "(" S_vector_to_vct " vect): returns a new " S_vct " with the elements of vector vect"
mus_long_t len, i;
vct *v;
- XEN scv;
-#if HAVE_SCHEME
- int gc_loc;
-#endif
+ mus_float_t *d;
+ Xen scv;
- XEN_ASSERT_TYPE(XEN_VECTOR_P(vect), vect, XEN_ONLY_ARG, S_vector_to_vct, "a vector");
+ Xen_check_type(Xen_is_vector(vect), vect, 1, S_vector_to_vct, "a vector");
- len = (mus_long_t)XEN_VECTOR_LENGTH(vect);
+ len = (mus_long_t)Xen_vector_length(vect);
if (len > 0)
scv = xen_make_vct(len, (mus_float_t *)calloc(len, sizeof(mus_float_t)));
else scv = xen_make_vct(0, NULL);
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, scv);
-#endif
- v = XEN_TO_VCT(scv);
+ v = Xen_to_vct(scv);
+ d = mus_vct_data(v);
for (i = 0; i < len; i++)
- v->data[i] = (mus_float_t)XEN_TO_C_DOUBLE(XEN_VECTOR_REF(vect, i));
+ d[i] = (mus_float_t)Xen_real_to_C_double(Xen_vector_ref(vect, i));
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
return(scv);
}
-static XEN g_vct_to_vector(XEN vobj)
+static Xen g_vct_to_vector(Xen vobj)
{
- #define H_vct_to_vector "(" S_vct_to_vector " vct): returns a new vector with the elements of vct"
+ #define H_vct_to_vector "(" S_vct_to_vector " v): returns a new vector with the elements of " S_vct
vct *v;
+ mus_float_t *d;
mus_long_t i, len;
- XEN new_vect;
-#if HAVE_SCHEME
- int gc_loc;
-#endif
-
- XEN_ASSERT_TYPE(MUS_VCT_P(vobj), vobj, XEN_ONLY_ARG, S_vct_to_vector, "a vct");
+ Xen new_vect;
- v = XEN_TO_VCT(vobj);
- len = v->length;
- new_vect = XEN_MAKE_VECTOR(len, C_TO_XEN_DOUBLE(0.0));
+ Xen_check_type(mus_is_vct(vobj), vobj, 1, S_vct_to_vector, A_VCT);
+ v = Xen_to_vct(vobj);
+ len = mus_vct_length(v);
+ new_vect = Xen_make_vector(len, C_double_to_Xen_real(0.0));
-#if HAVE_SCHEME
- gc_loc = s7_gc_protect(s7, new_vect);
-#endif
#if HAVE_RUBY && HAVE_RB_GC_DISABLE
rb_gc_disable();
- /* uh oh -- gc is triggered by C_TO_XEN_DOUBLE causing segfault, even if we
- * protect (via XEN_PROTECT_FROM_GC) new_vect -- I guess the double currently
+ /* uh oh -- gc is triggered by C_double_to_Xen_real causing segfault, even if we
+ * protect (via Xen_protect_from_gc) new_vect -- I guess the double currently
* being created is causing the trouble?
*/
#endif
+ d = mus_vct_data(v);
for (i = 0; i < len; i++)
- XEN_VECTOR_SET(new_vect, i, C_TO_XEN_DOUBLE(v->data[i]));
+ Xen_vector_set(new_vect, i, C_double_to_Xen_real(d[i]));
-#if HAVE_SCHEME
- s7_gc_unprotect_at(s7, gc_loc);
-#endif
#if HAVE_RUBY && HAVE_RB_GC_DISABLE
rb_gc_enable();
#endif
@@ -895,39 +1163,104 @@ static XEN g_vct_to_vector(XEN vobj)
}
-static XEN g_vct_reverse(XEN vobj, XEN size)
+static Xen g_vct_reverse(Xen vobj, Xen size)
{
- #define H_vct_reverse "(" S_vct_reverse " vct len): in-place reversal of vct contents"
+ #define H_vct_reverse "(" S_vct_reverse " v len): in-place reversal of " S_vct " contents"
vct *v;
+ mus_float_t *d;
mus_long_t i, j, len = -1;
- XEN_ASSERT_TYPE(MUS_VCT_P(vobj), vobj, XEN_ARG_1, S_vct_to_vector, "a vct");
- XEN_ASSERT_TYPE(XEN_INT64_T_IF_BOUND_P(size), size, XEN_ARG_2, S_vct_to_vector, "an integer");
+ Xen_check_type(mus_is_vct(vobj), vobj, 1, S_vct_reverse, A_VCT);
+ Xen_check_type(Xen_is_llong_or_unbound(size), size, 2, S_vct_reverse, "an integer");
- v = XEN_TO_VCT(vobj);
- if (XEN_INT64_T_P(size))
- len = XEN_TO_C_INT64_T(size);
- if ((len <= 0) || (len > v->length))
- len = v->length;
+ v = Xen_to_vct(vobj);
+ if (Xen_is_llong(size))
+ len = Xen_llong_to_C_llong(size);
+ if ((len <= 0) || (len > mus_vct_length(v)))
+ len = mus_vct_length(v);
if (len == 1) return(vobj);
+ d = mus_vct_data(v);
for (i = 0, j = len - 1; i < j; i++, j--)
{
mus_float_t temp;
- temp = v->data[i];
- v->data[i] = v->data[j];
- v->data[j] = temp;
+ temp = d[i];
+ d[i] = d[j];
+ d[j] = temp;
}
return(vobj);
}
+#endif
-static XEN g_vct_times(XEN obj1, XEN obj2)
+#if HAVE_SCHEME
+#define S_vct_max "float-vector-max"
+#define S_vct_min "float-vector-min"
+#else
+#define S_vct_max "vct-max"
+#define S_vct_min "vct-min"
+#endif
+
+static mus_float_t vct_max(mus_float_t *d, mus_long_t len)
+{
+ mus_long_t i;
+ mus_float_t mx;
+ mx = d[0];
+ for (i = 1; i < len; i++)
+ if (d[i] > mx)
+ mx = d[i];
+ return(mx);
+}
+
+static Xen g_vct_max(Xen vobj)
{
- #define H_vct_times "(" S_vct_times " obj1 obj2): either " S_vct_multiplyB " or " S_vct_scaleB ", depending on the types of its arguments"
- if (MUS_VCT_P(obj1))
+ #define H_vct_max "(" S_vct_max " v): returns the maximum element of " S_vct
+ vct *v;
+ mus_long_t len;
+
+ Xen_check_type(mus_is_vct(vobj), vobj, 1, S_vct_max, A_VCT);
+ v = Xen_to_vct(vobj);
+
+ len = mus_vct_length(v);
+ if (len > 0)
+ return(C_double_to_Xen_real(vct_max(mus_vct_data(v), len)));
+ return(C_double_to_Xen_real(0.0));
+}
+
+
+static mus_float_t vct_min(mus_float_t *d, mus_long_t len)
+{
+ mus_long_t i;
+ mus_float_t mx;
+ mx = d[0];
+ for (i = 1; i < len; i++)
+ if (d[i] < mx)
+ mx = d[i];
+ return(mx);
+}
+
+static Xen g_vct_min(Xen vobj)
+{
+ #define H_vct_min "(" S_vct_min " v): returns the minimum element of " S_vct
+ vct *v;
+ mus_long_t len;
+
+ Xen_check_type(mus_is_vct(vobj), vobj, 1, S_vct_min, A_VCT);
+ v = Xen_to_vct(vobj);
+
+ len = mus_vct_length(v);
+ if (len > 0)
+ return(C_double_to_Xen_real(vct_min(mus_vct_data(v), len)));
+ return(C_double_to_Xen_real(0.0));
+}
+
+
+static Xen g_vct_times(Xen obj1, Xen obj2)
+{
+ #define H_vct_times "(" S_vct_times " obj1 obj2): either " S_vct_multiply " or " S_vct_scale ", depending on the types of its arguments"
+ if (mus_is_vct(obj1))
{
- if (MUS_VCT_P(obj2))
+ if (mus_is_vct(obj2))
return(g_vct_multiply(obj1, obj2));
return(g_vct_scale(obj1, obj2));
}
@@ -935,126 +1268,79 @@ static XEN g_vct_times(XEN obj1, XEN obj2)
}
-static XEN g_vct_plus(XEN obj1, XEN obj2)
+static Xen g_vct_plus(Xen obj1, Xen obj2)
{
- #define H_vct_plus "(" S_vct_plus " obj1 obj2): either " S_vct_addB " or " S_vct_offsetB ", depending on the types of its arguments"
- if (MUS_VCT_P(obj1))
+ #define H_vct_plus "(" S_vct_plus " obj1 obj2): either " S_vct_add " or " S_vct_offset ", depending on the types of its arguments"
+ if (mus_is_vct(obj1))
{
- if (MUS_VCT_P(obj2))
- return(g_vct_add(obj1, obj2, XEN_UNDEFINED));
+ if (mus_is_vct(obj2))
+ return(g_vct_add(obj1, obj2, Xen_undefined));
return(g_vct_offset(obj1, obj2));
}
return(g_vct_offset(obj2, obj1));
}
-
-#ifdef XEN_ARGIFY_1
-XEN_ARGIFY_2(g_make_vct_w, g_make_vct)
-XEN_NARGIFY_1(g_vct_copy_w, g_vct_copy)
-XEN_NARGIFY_1(g_vct_p_w, g_vct_p)
-XEN_NARGIFY_1(g_list_to_vct_w, xen_list_to_vct)
-XEN_NARGIFY_1(g_vct_to_list_w, g_vct_to_list)
-XEN_NARGIFY_1(g_vector_to_vct_w, g_vector_to_vct)
-XEN_NARGIFY_1(g_vct_to_vector_w, g_vct_to_vector)
-XEN_NARGIFY_1(g_vct_length_w, g_vct_length)
-XEN_NARGIFY_2(g_vct_ref_w, g_vct_ref)
-XEN_NARGIFY_3(g_vct_set_w, g_vct_set)
-XEN_NARGIFY_2(g_vct_multiply_w, g_vct_multiply)
-XEN_NARGIFY_2(g_vct_scale_w, g_vct_scale)
-XEN_NARGIFY_2(g_vct_fill_w, g_vct_fill)
-XEN_ARGIFY_3(g_vct_add_w, g_vct_add)
-XEN_NARGIFY_2(g_vct_subtract_w, g_vct_subtract)
-XEN_NARGIFY_2(g_vct_offset_w, g_vct_offset)
-XEN_NARGIFY_2(g_vct_mapB_w, g_vct_mapB)
-XEN_NARGIFY_1(g_vct_peak_w, g_vct_peak)
-XEN_ARGIFY_4(g_vct_move_w, g_vct_move)
-XEN_ARGIFY_4(g_vct_subseq_w, g_vct_subseq)
-XEN_VARGIFY(g_vct_w, g_vct)
-XEN_ARGIFY_2(g_vct_reverse_w, g_vct_reverse)
-XEN_NARGIFY_1(g_vct_to_readable_string_w, g_vct_to_readable_string)
-XEN_NARGIFY_2(g_vct_times_w, g_vct_times)
-XEN_NARGIFY_2(g_vct_plus_w, g_vct_plus)
-#else
-#define g_make_vct_w g_make_vct
-#define g_vct_copy_w g_vct_copy
-#define g_vct_p_w g_vct_p
-#define g_list_to_vct_w xen_list_to_vct
-#define g_vct_to_list_w g_vct_to_list
-#define g_vector_to_vct_w g_vector_to_vct
-#define g_vct_to_vector_w g_vct_to_vector
-#define g_vct_length_w g_vct_length
-#define g_vct_ref_w g_vct_ref
-#define g_vct_set_w g_vct_set
-#define g_vct_multiply_w g_vct_multiply
-#define g_vct_scale_w g_vct_scale
-#define g_vct_fill_w g_vct_fill
-#define g_vct_add_w g_vct_add
-#define g_vct_subtract_w g_vct_subtract
-#define g_vct_offset_w g_vct_offset
-#define g_vct_mapB_w g_vct_mapB
-#define g_vct_peak_w g_vct_peak
-#define g_vct_move_w g_vct_move
-#define g_vct_subseq_w g_vct_subseq
-#define g_vct_w g_vct
-#define g_vct_reverse_w g_vct_reverse
-#define g_vct_to_readable_string_w g_vct_to_readable_string
-#define g_vct_times_w g_vct_times
-#define g_vct_plus_w g_vct_plus
-#endif
-
-
#if HAVE_RUBY
-static XEN g_vct_each(XEN obj)
+static Xen g_vct_each(Xen obj)
{
mus_long_t i;
vct *v;
- v = XEN_TO_VCT(obj);
- for (i = 0; i < v->length; i++)
- rb_yield(C_TO_XEN_DOUBLE(v->data[i]));
+ mus_float_t *d;
+
+ v = Xen_to_vct(obj);
+ d = mus_vct_data(v);
+
+ for (i = 0; i < mus_vct_length(v); i++)
+ rb_yield(C_double_to_Xen_real(d[i]));
return(obj);
}
-static XEN g_vct_compare(XEN vr1, XEN vr2)
+static Xen g_vct_compare(Xen vr1, Xen vr2)
{
- mus_long_t i, len;
- vct *v1, *v2;
- if ((MUS_VCT_P(vr1)) && (MUS_VCT_P(vr2)))
+ if ((mus_is_vct(vr1)) && (mus_is_vct(vr2)))
{
- v1 = XEN_TO_VCT(vr1);
- v2 = XEN_TO_VCT(vr2);
- len = v1->length;
- if (len > v2->length) len = v2->length;
+ mus_long_t i, len;
+ vct *v1, *v2;
+ mus_float_t *d1, *d2;
+
+ v1 = Xen_to_vct(vr1);
+ v2 = Xen_to_vct(vr2);
+ d1 = mus_vct_data(v1);
+ d2 = mus_vct_data(v2);
+
+ len = mus_vct_length(v1);
+ if (len > mus_vct_length(v2)) len = mus_vct_length(v2);
for (i = 0; i < len; i++)
- if (v1->data[i] < v2->data[i])
- return(C_TO_XEN_INT(-1));
+ if (d1[i] < d2[i])
+ return(C_int_to_Xen_integer(-1));
else
- if (v1->data[i] > v2->data[i])
- return(C_TO_XEN_INT(1));
- len = v1->length - v2->length;
- if (len == 0) return(C_TO_XEN_INT(0));
- if (len > 0) return(C_TO_XEN_INT(1));
+ if (d1[i] > d2[i])
+ return(C_int_to_Xen_integer(1));
+ len = mus_vct_length(v1) - mus_vct_length(v2);
+ if (len == 0) return(C_int_to_Xen_integer(0));
+ if (len > 0) return(C_int_to_Xen_integer(1));
}
- return(C_TO_XEN_INT(-1));
+ return(C_int_to_Xen_integer(-1));
}
-static XEN g_rb_make_vct(int argc, XEN *argv, XEN self)
+static Xen g_rb_make_vct(int argc, Xen *argv, Xen self)
{
mus_long_t size;
- XEN len, filler;
+ Xen len, filler;
rb_scan_args(argc, argv, "11", &len, &filler);
- XEN_ASSERT_TYPE(XEN_INT64_T_P(len), len, XEN_ONLY_ARG, "Vct.new", "an integer");
- size = XEN_TO_C_INT64_T(len);
+ Xen_check_type(Xen_is_llong(len), len, 1, "Vct.new", "an integer");
+ size = Xen_llong_to_C_llong(len);
if (size <= 0)
- XEN_OUT_OF_RANGE_ERROR("Vct.new", 1, len, "len <= 0?");
- if (XEN_NUMBER_P(filler))
+ Xen_out_of_range_error("Vct.new", 1, len, "len <= 0?");
+ if (Xen_is_number(filler))
return(g_vct_fill(xen_make_vct(size, (mus_float_t *)calloc(size, sizeof(mus_float_t))), filler));
if (rb_block_given_p()) {
mus_long_t i;
mus_float_t *buffer = (mus_float_t *)calloc(size, sizeof(mus_float_t));
for (i = 0; i < size; i++) {
- buffer[i] = XEN_TO_C_DOUBLE(rb_yield(C_TO_XEN_INT(i)));
+ buffer[i] = Xen_real_to_C_double(rb_yield(C_int_to_Xen_integer(i)));
}
return xen_make_vct(size, buffer);
}
@@ -1062,155 +1348,159 @@ static XEN g_rb_make_vct(int argc, XEN *argv, XEN self)
}
-static XEN g_vct_map(XEN obj)
+static Xen g_vct_map(Xen obj)
{
- if (rb_block_given_p()) {
- mus_long_t i;
- vct *v = XEN_TO_VCT(obj);
- mus_float_t *buffer = (mus_float_t *)calloc(v->length, sizeof(mus_float_t));
- for (i = 0; i < v->length; i++)
- buffer[i] = XEN_TO_C_DOUBLE(rb_yield(C_TO_XEN_DOUBLE(v->data[i])));
- return xen_make_vct(v->length, buffer);
- }
+ if (rb_block_given_p())
+ {
+ mus_long_t i;
+ vct *v;
+ mus_float_t *d;
+
+ v = Xen_to_vct(obj);
+ d = mus_vct_data(v);
+ mus_float_t *buffer = (mus_float_t *)calloc(mus_vct_length(v), sizeof(mus_float_t));
+
+ for (i = 0; i < mus_vct_length(v); i++)
+ buffer[i] = Xen_real_to_C_double(rb_yield(C_double_to_Xen_real(d[i])));
+ return xen_make_vct(mus_vct_length(v), buffer);
+ }
return obj;
}
-static XEN g_vct_map_store(XEN obj)
+static Xen g_vct_map_store(Xen obj)
{
- if (rb_block_given_p()) {
- mus_long_t i;
- vct *v = XEN_TO_VCT(obj);
- for (i = 0; i < v->length; i++)
- v->data[i] = XEN_TO_C_DOUBLE(rb_yield(C_TO_XEN_DOUBLE(v->data[i])));
- }
+ if (rb_block_given_p())
+ {
+ mus_long_t i;
+ vct *v;
+ mus_float_t *d;
+
+ v = Xen_to_vct(obj);
+ d = mus_vct_data(v);
+
+ for (i = 0; i < mus_vct_length(v); i++)
+ d[i] = Xen_real_to_C_double(rb_yield(C_double_to_Xen_real(d[i])));
+ }
return obj;
}
/* v1.add!(v2[,offset=0]) destructive */
-static XEN rb_vct_add(int argc, XEN *argv, XEN obj1)
+static Xen rb_vct_add(int argc, Xen *argv, Xen obj1)
{
- XEN obj2, offs;
+ Xen obj2, offs;
rb_scan_args(argc, argv, "11", &obj2, &offs);
- return g_vct_add(obj1, obj2, (argc == 2) ? offs : XEN_UNDEFINED);
+ return g_vct_add(obj1, obj2, (argc == 2) ? offs : Xen_undefined);
}
/* v1.add(v2[,offset=0]) returns new vct */
-static XEN rb_vct_add_cp(int argc, XEN *argv, XEN obj1)
+static Xen rb_vct_add_cp(int argc, Xen *argv, Xen obj1)
{
- XEN obj2, offs;
+ Xen obj2, offs;
rb_scan_args(argc, argv, "11", &obj2, &offs);
- return g_vct_add(g_vct_copy(obj1), obj2, (argc == 2) ? offs : XEN_UNDEFINED);
+ return g_vct_add(g_vct_copy(obj1), obj2, (argc == 2) ? offs : Xen_undefined);
}
/* v1.subtract(v2) returns new vct */
-static XEN rb_vct_subtract_cp(XEN obj1, XEN obj2)
+static Xen rb_vct_subtract_cp(Xen obj1, Xen obj2)
{
return g_vct_subtract(g_vct_copy(obj1), obj2);
}
-static XEN rb_vct_offset_cp(XEN obj, XEN scl)
+static Xen rb_vct_offset_cp(Xen obj, Xen scl)
{
return g_vct_offset(g_vct_copy(obj), scl);
}
-static XEN rb_vct_multiply_cp(XEN obj1, XEN obj2)
+static Xen rb_vct_multiply_cp(Xen obj1, Xen obj2)
{
return g_vct_multiply(g_vct_copy(obj1), obj2);
}
-static XEN rb_vct_scale_cp(XEN obj, XEN scl)
+static Xen rb_vct_scale_cp(Xen obj, Xen scl)
{
return g_vct_scale(g_vct_copy(obj), scl);
}
-#if 0
-static XEN rb_vct_fill_cp(XEN obj, XEN scl)
-{
- return g_vct_fill(g_vct_copy(obj), scl);
-}
-#endif
-
-
/* destructive */
-static XEN rb_vct_move(int argc, XEN *argv, XEN obj)
+static Xen rb_vct_move(int argc, Xen *argv, Xen obj)
{
- XEN vnew, old, backward;
+ Xen vnew, old, backward;
rb_scan_args(argc, argv, "21", &vnew, &old, &backward);
- return g_vct_move(obj, vnew, old, (argc == 3) ? backward : XEN_UNDEFINED);
+ return g_vct_move(obj, vnew, old, (argc == 3) ? backward : Xen_undefined);
}
/* returns new vct */
-static XEN rb_vct_move_cp(int argc, XEN *argv, XEN obj)
+static Xen rb_vct_move_cp(int argc, Xen *argv, Xen obj)
{
- XEN vnew, old, backward;
+ Xen vnew, old, backward;
rb_scan_args(argc, argv, "21", &vnew, &old, &backward);
- return g_vct_move(g_vct_copy(obj), vnew, old, (argc == 3) ? backward : XEN_UNDEFINED);
+ return g_vct_move(g_vct_copy(obj), vnew, old, (argc == 3) ? backward : Xen_undefined);
}
-static XEN rb_vct_subseq(int argc, XEN *argv, XEN obj)
+static Xen rb_vct_subseq(int argc, Xen *argv, Xen obj)
{
- XEN start, end, vnew;
+ Xen start, end, vnew;
rb_scan_args(argc, argv, "12", &start, &end, &vnew);
- return g_vct_subseq(obj, start, (argc > 1) ? end :XEN_UNDEFINED, (argc > 2) ? vnew : XEN_UNDEFINED);
+ return g_vct_subseq(obj, start, (argc > 1) ? end :Xen_undefined, (argc > 2) ? vnew : Xen_undefined);
}
/* destructive */
-static XEN rb_vct_reverse(int argc, XEN *argv, XEN obj)
+static Xen rb_vct_reverse(int argc, Xen *argv, Xen obj)
{
- XEN len;
+ Xen len;
rb_scan_args(argc, argv, "01", &len);
- return g_vct_reverse(obj, (argc > 0) ? len : XEN_UNDEFINED);
+ return g_vct_reverse(obj, (argc > 0) ? len : Xen_undefined);
}
/* returns new vct */
-static XEN rb_vct_reverse_cp(int argc, XEN *argv, XEN obj)
+static Xen rb_vct_reverse_cp(int argc, Xen *argv, Xen obj)
{
- XEN len;
+ Xen len;
rb_scan_args(argc, argv, "01", &len);
- return g_vct_reverse(g_vct_copy(obj), (argc > 0) ? len : XEN_UNDEFINED);
+ return g_vct_reverse(g_vct_copy(obj), (argc > 0) ? len : Xen_undefined);
}
-static XEN rb_vct_first(XEN obj)
+static Xen rb_vct_first(Xen obj)
{
- return g_vct_ref(obj, C_TO_XEN_INT(0));
+ return g_vct_ref(obj, C_int_to_Xen_integer(0));
}
-static XEN rb_set_vct_first(XEN obj, XEN val)
+static Xen rb_set_vct_first(Xen obj, Xen val)
{
- return g_vct_set(obj, C_TO_XEN_INT(0), val);
+ return g_vct_set(obj, C_int_to_Xen_integer(0), val);
}
-static XEN rb_vct_last(XEN obj)
+static Xen rb_vct_last(Xen obj)
{
- return g_vct_ref(obj, C_TO_XEN_INT(XEN_TO_VCT(obj)->length - 1));
+ return g_vct_ref(obj, C_int_to_Xen_integer(mus_vct_length(Xen_to_vct(obj)) - 1));
}
-static XEN rb_set_vct_last(XEN obj, XEN val)
+static Xen rb_set_vct_last(Xen obj, Xen val)
{
- return g_vct_set(obj, C_TO_XEN_INT(XEN_TO_VCT(obj)->length - 1), val);
+ return g_vct_set(obj, C_int_to_Xen_integer(mus_vct_length(Xen_to_vct(obj)) - 1), val);
}
#endif
@@ -1246,20 +1536,254 @@ static void ficl_begin_vct(ficlVm *vm)
#define h_begin_vct "( -- ) \
Creates a vct with contents between `vct(' and closing paren `)'.\n\
vct( 0.5 0.3 0.1 ) .g => #<vct[len=3]: 0.500 0.300 0.100>"
- fth_begin_values_to_obj(vm, ">vct", FTH_FALSE);
+ fth_begin_values_to_obj(vm, (char *)">vct", FTH_FALSE);
}
#endif
-void mus_vct_init(void)
+#if HAVE_SCHEME
+
+#define PF_TO_RF(CName, Cfnc) \
+ static s7_double CName ## _rf_a(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pf_t f; \
+ s7_pointer x; \
+ f = (s7_pf_t)(**p); (*p)++; \
+ x = f(sc, p); \
+ return(Cfnc); \
+ } \
+ static s7_rf_t CName ## _rf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_null(sc, s7_cddr(expr))) && \
+ (s7_arg_to_pf(sc, s7_cadr(expr)))) \
+ return(CName ## _rf_a); \
+ return(NULL); \
+ }
+
+static s7_double c_vct_max(s7_scheme *sc, s7_pointer x)
+{
+ s7_int len;
+ if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_max, 1, x, "a float-vector");
+ len = s7_vector_length(x);
+ if (len == 0) return(0.0);
+ return(vct_max(s7_float_vector_elements(x), len));
+}
+
+PF_TO_RF(float_vector_max, c_vct_max(sc, x))
+
+static s7_double c_vct_min(s7_scheme *sc, s7_pointer x)
{
+ s7_int len;
+ if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_min, 1, x, "a float-vector");
+ len = s7_vector_length(x);
+ if (len == 0) return(0.0);
+ return(vct_min(s7_float_vector_elements(x), len));
+}
+
+PF_TO_RF(float_vector_min, c_vct_min(sc, x))
+
+PF_TO_RF(float_vector_peak, mus_vct_peak(x))
+
+
+#define PF2_TO_PF(CName, Cfnc) \
+ static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pf_t f; \
+ s7_pointer x, y; \
+ f = (s7_pf_t)(**p); (*p)++; \
+ x = f(sc, p); \
+ f = (s7_pf_t)(**p); (*p)++; \
+ y = f(sc, p); \
+ return(Cfnc); \
+ } \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
+ (s7_arg_to_pf(sc, s7_cadr(expr))) && \
+ (s7_arg_to_pf(sc, s7_caddr(expr)))) \
+ return(CName ## _pf_a); \
+ return(NULL); \
+ }
+
+static s7_pointer c_vct_add(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ s7_int len1, lim;
+ if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_add, 1, x, "a float-vector");
+ if (!s7_is_float_vector(y)) s7_wrong_type_arg_error(sc, S_vct_add, 2, y, "a float-vector");
+ len1 = s7_vector_length(x);
+ lim = s7_vector_length(y);
+ if (lim > len1) lim = len1;
+ if (lim == 0) return(x);
+ vct_add(s7_float_vector_elements(x), s7_float_vector_elements(y), lim);
+ return(x);
+}
+
+PF2_TO_PF(float_vector_add, c_vct_add(sc, x, y))
+
+static s7_pointer c_vct_subtract(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ s7_int i, len1, lim;
+ s7_double *fx, *fy;
+ if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_subtract, 1, x, "a float-vector");
+ if (!s7_is_float_vector(y)) s7_wrong_type_arg_error(sc, S_vct_subtract, 2, y, "a float-vector");
+ len1 = s7_vector_length(x);
+ lim = s7_vector_length(y);
+ if (lim > len1) lim = len1;
+ if (lim == 0) return(x);
+ fx = s7_float_vector_elements(x);
+ fy = s7_float_vector_elements(y);
+ for (i = 0; i < lim; i++) fx[i] -= fy[i];
+ return(x);
+}
+
+PF2_TO_PF(float_vector_subtract, c_vct_subtract(sc, x, y))
+
+static s7_pointer c_vct_multiply(s7_scheme *sc, s7_pointer x, s7_pointer y)
+{
+ s7_int i, len1, lim;
+ s7_double *fx, *fy;
+ if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_multiply, 1, x, "a float-vector");
+ if (!s7_is_float_vector(y)) s7_wrong_type_arg_error(sc, S_vct_multiply, 2, y, "a float-vector");
+ len1 = s7_vector_length(x);
+ lim = s7_vector_length(y);
+ if (lim > len1) lim = len1;
+ if (lim == 0) return(x);
+ fx = s7_float_vector_elements(x);
+ fy = s7_float_vector_elements(y);
+ for (i = 0; i < lim; i++) fx[i] *= fy[i];
+ return(x);
+}
+
+PF2_TO_PF(float_vector_multiply, c_vct_multiply(sc, x, y))
+
+#define PRF_TO_PF(CName, Cfnc) \
+ static s7_pointer CName ## _pf_a(s7_scheme *sc, s7_pointer **p) \
+ { \
+ s7_pf_t f; \
+ s7_rf_t r; \
+ s7_pointer x; \
+ s7_double y; \
+ f = (s7_pf_t)(**p); (*p)++; \
+ x = f(sc, p); \
+ r = (s7_rf_t)(**p); (*p)++; \
+ y = r(sc, p); \
+ return(Cfnc); \
+ } \
+ static s7_pf_t CName ## _pf(s7_scheme *sc, s7_pointer expr) \
+ { \
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_pair(s7_cddr(expr))) && (s7_is_null(sc, s7_cdddr(expr))) && \
+ (s7_arg_to_pf(sc, s7_cadr(expr))) && \
+ (s7_arg_to_rf(sc, s7_caddr(expr)))) \
+ return(CName ## _pf_a); \
+ return(NULL); \
+ }
+
+
+static s7_pointer c_vct_scale(s7_scheme *sc, s7_pointer x, s7_double y)
+{
+ s7_int len;
+ if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_scale, 1, x, "a float-vector");
+ len = s7_vector_length(x);
+ if (len == 0) return(x);
+ vct_scale(s7_float_vector_elements(x), y, len);
+ return(x);
+}
+
+PRF_TO_PF(float_vector_scale, c_vct_scale(sc, x, y))
+
+static s7_pointer c_vct_offset(s7_scheme *sc, s7_pointer x, s7_double y)
+{
+ s7_int i, len;
+ s7_double *fx;
+ if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_offset, 1, x, "a float-vector");
+ len = s7_vector_length(x);
+ if (len == 0) return(x);
+ fx = s7_float_vector_elements(x);
+ for (i = 0; i < len; i++) fx[i] += y;
+ return(x);
+}
+
+PRF_TO_PF(float_vector_offset, c_vct_offset(sc, x, y))
+
+
+static s7_pointer vct_abs_pf_a(s7_scheme *sc, s7_pointer **p)
+{
+ s7_pf_t f;
+ s7_pointer x;
+ s7_int i, len;
+ s7_double *fx;
+
+ f = (s7_pf_t)(**p); (*p)++;
+ x = f(sc, p);
+ if (!s7_is_float_vector(x)) s7_wrong_type_arg_error(sc, S_vct_abs, 1, x, "a float-vector");
+ len = s7_vector_length(x);
+ if (len == 0) return(x);
+ fx = s7_float_vector_elements(x);
+ for (i = 0; i < len; i++) fx[i] = fabs(fx[i]);
+ return(x);
+}
+
+static s7_pf_t float_vector_abs_pf(s7_scheme *sc, s7_pointer expr)
+{
+ if ((s7_is_pair(s7_cdr(expr))) && (s7_is_null(sc, s7_cddr(expr))) &&
+ (s7_arg_to_pf(sc, s7_cadr(expr))))
+ return(vct_abs_pf_a); \
+ return(NULL);
+}
+#endif
+
+
+
+#if (!HAVE_SCHEME)
+ Xen_wrap_2_optional_args(g_make_vct_w, g_make_vct)
+ Xen_wrap_2_args(g_vct_fill_w, g_vct_fill)
+ Xen_wrap_any_args(g_vct_w, g_vct)
+ Xen_wrap_1_arg(g_vct_length_w, g_vct_length)
+ Xen_wrap_2_optional_args(g_vct_reverse_w, g_vct_reverse)
+ Xen_wrap_1_arg(g_vct_to_list_w, g_vct_to_list)
+ Xen_wrap_1_arg(g_list_to_vct_w, xen_list_to_vct)
+ Xen_wrap_1_arg(g_vector_to_vct_w, g_vector_to_vct)
+ Xen_wrap_1_arg(g_vct_to_vector_w, g_vct_to_vector)
+ Xen_wrap_1_arg(g_is_vct_w, g_is_vct)
+ Xen_wrap_2_args(g_vct_ref_w, g_vct_ref)
+ Xen_wrap_3_args(g_vct_set_w, g_vct_set)
+#endif
+Xen_wrap_1_arg(g_vct_copy_w, g_vct_copy)
+Xen_wrap_2_args(g_vct_multiply_w, g_vct_multiply)
+Xen_wrap_2_args(g_vct_scale_w, g_vct_scale)
+Xen_wrap_1_arg(g_vct_abs_w, g_vct_abs)
+Xen_wrap_3_optional_args(g_vct_add_w, g_vct_add)
+Xen_wrap_2_args(g_vct_subtract_w, g_vct_subtract)
+Xen_wrap_2_args(g_vct_offset_w, g_vct_offset)
+Xen_wrap_1_arg(g_vct_peak_w, g_vct_peak)
+Xen_wrap_3_args(g_vct_equal_w, g_vct_equal)
+Xen_wrap_1_arg(g_vct_peak_and_location_w, g_vct_peak_and_location)
+Xen_wrap_4_optional_args(g_vct_move_w, g_vct_move)
+Xen_wrap_4_optional_args(g_vct_subseq_w, g_vct_subseq)
+Xen_wrap_1_arg(g_vct_to_readable_string_w, g_vct_to_readable_string)
+Xen_wrap_2_args(g_vct_times_w, g_vct_times)
+Xen_wrap_2_args(g_vct_plus_w, g_vct_plus)
+Xen_wrap_1_arg(g_vct_max_w, g_vct_max)
+Xen_wrap_1_arg(g_vct_min_w, g_vct_min)
+#if HAVE_SCHEME
+Xen_wrap_4_args(g_vct_spatter_w, g_vct_spatter)
+Xen_wrap_7_args(g_vct_interpolate_w, g_vct_interpolate)
+#endif
+
+void mus_vct_init(void)
+{
#if HAVE_SCHEME
- vct_tag = XEN_MAKE_OBJECT_TYPE("<vct>", print_vct, free_vct, s7_mus_vct_equalp, NULL,
- s7_mus_vct_apply, s7_mus_vct_set, s7_mus_vct_length,
- s7_mus_vct_copy, s7_mus_vct_fill);
+ s7_pointer pl_ff, pl_rf, pl_fff, pl_fffi, pl_ffr, pl_pf, pl_bffr, pl_ftt, pl_ffii, pl_ffiif, pl_sf;
#else
- vct_tag = XEN_MAKE_OBJECT_TYPE("Vct", sizeof(vct));
+ vct_tag = Xen_make_object_type("Vct", sizeof(vct));
+
+ /* for ruby and forth, I think we can define Frame, SoundData, and Mixer to be Vct's with
+ * some handlers for the channel arg. Then nothing in the *.rb|fs file has to change
+ * except all the deprecated names like "region-frames" -> framples.
+ *
+ * Not sure how to do this -- is it "alias" in Ruby?
+ */
#endif
#if HAVE_FORTH
@@ -1272,83 +1796,130 @@ void mus_vct_init(void)
fth_set_object_equal(vct_tag, equalp_vct);
fth_set_object_length(vct_tag, g_vct_length);
fth_set_object_free(vct_tag, free_vct);
- fth_set_object_apply(vct_tag, XEN_PROCEDURE_CAST g_vct_ref, 1, 0, 0);
- FTH_PRIM(FTH_FICL_DICT(), ">vct", ficl_values_to_vct, h_values_to_vct);
- FTH_PRIM(FTH_FICL_DICT(), "vct(", ficl_begin_vct, h_begin_vct);
- XEN_EVAL_C_STRING("start-prefixes : vct( vct( ; end-prefixes");
+ fth_set_object_apply(vct_tag, Xen_procedure_cast g_vct_ref, 1, 0, 0);
+ FTH_PRIM(FTH_FICL_DICT(), (char *)">vct", ficl_values_to_vct, h_values_to_vct);
+ FTH_PRIM(FTH_FICL_DICT(), (char *)"vct(", ficl_begin_vct, h_begin_vct);
+ Xen_eval_C_string("start-prefixes : vct( vct( ; end-prefixes");
#endif
#if HAVE_RUBY
rb_include_module(vct_tag, rb_mComparable);
rb_include_module(vct_tag, rb_mEnumerable);
- rb_define_method(vct_tag, "to_s", XEN_PROCEDURE_CAST print_vct, 0);
- rb_define_method(vct_tag, "eql?", XEN_PROCEDURE_CAST equalp_vct, 1);
- rb_define_method(vct_tag, "[]", XEN_PROCEDURE_CAST g_vct_ref, 1);
- rb_define_method(vct_tag, "[]=", XEN_PROCEDURE_CAST g_vct_set, 2);
- rb_define_method(vct_tag, "length", XEN_PROCEDURE_CAST g_vct_length, 0);
- rb_define_method(vct_tag, "each", XEN_PROCEDURE_CAST g_vct_each, 0);
- rb_define_method(vct_tag, "<=>", XEN_PROCEDURE_CAST g_vct_compare, 1);
- rb_define_singleton_method(vct_tag, "new", XEN_PROCEDURE_CAST g_rb_make_vct, -1);
- rb_define_method(vct_tag, "map", XEN_PROCEDURE_CAST g_vct_map, 0);
- rb_define_method(vct_tag, "map!", XEN_PROCEDURE_CAST g_vct_map_store, 0);
- rb_define_method(vct_tag, "to_a", XEN_PROCEDURE_CAST g_vct_to_vector, 0);
- rb_define_method(rb_cArray, "to_vct", XEN_PROCEDURE_CAST g_vector_to_vct, 0);
-
- rb_define_method(vct_tag, "to_str", XEN_PROCEDURE_CAST g_vct_to_readable_string, 0);
- rb_define_method(vct_tag, "dup", XEN_PROCEDURE_CAST g_vct_copy, 0);
- rb_define_method(vct_tag, "peak", XEN_PROCEDURE_CAST g_vct_peak, 0);
- rb_define_method(vct_tag, "add", XEN_PROCEDURE_CAST rb_vct_add_cp, -1);
- rb_define_method(vct_tag, "add!", XEN_PROCEDURE_CAST rb_vct_add, -1);
- rb_define_method(vct_tag, "subtract", XEN_PROCEDURE_CAST rb_vct_subtract_cp, 1);
- rb_define_method(vct_tag, "subtract!", XEN_PROCEDURE_CAST g_vct_subtract, 1);
- rb_define_method(vct_tag, "offset", XEN_PROCEDURE_CAST rb_vct_offset_cp, 1);
- rb_define_method(vct_tag, "offset!", XEN_PROCEDURE_CAST g_vct_offset, 1);
- rb_define_method(vct_tag, "multiply", XEN_PROCEDURE_CAST rb_vct_multiply_cp, 1);
- rb_define_method(vct_tag, "multiply!", XEN_PROCEDURE_CAST g_vct_multiply, 1);
- rb_define_method(vct_tag, "scale", XEN_PROCEDURE_CAST rb_vct_scale_cp, 1);
- rb_define_method(vct_tag, "scale!", XEN_PROCEDURE_CAST g_vct_scale, 1);
- rb_define_method(vct_tag, "fill", XEN_PROCEDURE_CAST g_vct_fill, 1);
- rb_define_method(vct_tag, "move", XEN_PROCEDURE_CAST rb_vct_move_cp, -1);
- rb_define_method(vct_tag, "move!", XEN_PROCEDURE_CAST rb_vct_move, -1);
- rb_define_method(vct_tag, "subseq", XEN_PROCEDURE_CAST rb_vct_subseq, -1);
- rb_define_method(vct_tag, "reverse", XEN_PROCEDURE_CAST rb_vct_reverse_cp, -1);
- rb_define_method(vct_tag, "reverse!", XEN_PROCEDURE_CAST rb_vct_reverse, -1);
- rb_define_method(vct_tag, "first", XEN_PROCEDURE_CAST rb_vct_first, 0);
- rb_define_method(vct_tag, "first=", XEN_PROCEDURE_CAST rb_set_vct_first, 1);
- rb_define_method(vct_tag, "last", XEN_PROCEDURE_CAST rb_vct_last, 0);
- rb_define_method(vct_tag, "last=", XEN_PROCEDURE_CAST rb_set_vct_last, 1);
+ rb_define_method(vct_tag, "to_s", Xen_procedure_cast print_vct, 0);
+ rb_define_method(vct_tag, "eql?", Xen_procedure_cast equalp_vct, 1);
+ rb_define_method(vct_tag, "[]", Xen_procedure_cast g_vct_ref, 1);
+ rb_define_method(vct_tag, "[]=", Xen_procedure_cast g_vct_set, 2);
+ rb_define_method(vct_tag, "length", Xen_procedure_cast g_vct_length, 0);
+ rb_define_method(vct_tag, "each", Xen_procedure_cast g_vct_each, 0);
+ rb_define_method(vct_tag, "<=>", Xen_procedure_cast g_vct_compare, 1);
+ rb_define_singleton_method(vct_tag, "new", Xen_procedure_cast g_rb_make_vct, -1);
+ rb_define_method(vct_tag, "map", Xen_procedure_cast g_vct_map, 0);
+ rb_define_method(vct_tag, "map!", Xen_procedure_cast g_vct_map_store, 0);
+ rb_define_method(vct_tag, "to_a", Xen_procedure_cast g_vct_to_vector, 0);
+ rb_define_method(rb_cArray, "to_vct", Xen_procedure_cast g_vector_to_vct, 0);
+
+ rb_define_method(vct_tag, "to_str", Xen_procedure_cast g_vct_to_readable_string, 0);
+ rb_define_method(vct_tag, "dup", Xen_procedure_cast g_vct_copy, 0);
+ rb_define_method(vct_tag, "peak", Xen_procedure_cast g_vct_peak, 0);
+ rb_define_method(vct_tag, "add", Xen_procedure_cast rb_vct_add_cp, -1);
+ rb_define_method(vct_tag, "add!", Xen_procedure_cast rb_vct_add, -1);
+ rb_define_method(vct_tag, "subtract", Xen_procedure_cast rb_vct_subtract_cp, 1);
+ rb_define_method(vct_tag, "subtract!", Xen_procedure_cast g_vct_subtract, 1);
+ rb_define_method(vct_tag, "offset", Xen_procedure_cast rb_vct_offset_cp, 1);
+ rb_define_method(vct_tag, "offset!", Xen_procedure_cast g_vct_offset, 1);
+ rb_define_method(vct_tag, "multiply", Xen_procedure_cast rb_vct_multiply_cp, 1);
+ rb_define_method(vct_tag, "multiply!", Xen_procedure_cast g_vct_multiply, 1);
+ rb_define_method(vct_tag, "scale", Xen_procedure_cast rb_vct_scale_cp, 1);
+ rb_define_method(vct_tag, "scale!", Xen_procedure_cast g_vct_scale, 1);
+ rb_define_method(vct_tag, "fill", Xen_procedure_cast g_vct_fill, 1);
+ rb_define_method(vct_tag, "move", Xen_procedure_cast rb_vct_move_cp, -1);
+ rb_define_method(vct_tag, "move!", Xen_procedure_cast rb_vct_move, -1);
+ rb_define_method(vct_tag, "subseq", Xen_procedure_cast rb_vct_subseq, -1);
+ rb_define_method(vct_tag, "reverse", Xen_procedure_cast rb_vct_reverse_cp, -1);
+ rb_define_method(vct_tag, "reverse!", Xen_procedure_cast rb_vct_reverse, -1);
+ rb_define_method(vct_tag, "first", Xen_procedure_cast rb_vct_first, 0);
+ rb_define_method(vct_tag, "first=", Xen_procedure_cast rb_set_vct_first, 1);
+ rb_define_method(vct_tag, "last", Xen_procedure_cast rb_vct_last, 0);
+ rb_define_method(vct_tag, "last=", Xen_procedure_cast rb_set_vct_last, 1);
#endif
- XEN_DEFINE_PROCEDURE(S_make_vct, g_make_vct_w, 1, 1, 0, H_make_vct);
- XEN_DEFINE_PROCEDURE(S_vct_copy, g_vct_copy_w, 1, 0, 0, H_vct_copy);
- XEN_DEFINE_PROCEDURE(S_vct_p, g_vct_p_w, 1, 0, 0, H_vct_p);
- XEN_DEFINE_PROCEDURE(S_list_to_vct, g_list_to_vct_w, 1, 0, 0, H_list_to_vct);
- XEN_DEFINE_PROCEDURE(S_vct_to_list, g_vct_to_list_w, 1, 0, 0, H_vct_to_list);
- XEN_DEFINE_PROCEDURE(S_vector_to_vct, g_vector_to_vct_w, 1, 0, 0, H_vector_to_vct);
- XEN_DEFINE_PROCEDURE(S_vct_to_vector, g_vct_to_vector_w, 1, 0, 0, H_vct_to_vector);
- XEN_DEFINE_PROCEDURE(S_vct_length, g_vct_length_w, 1, 0, 0, H_vct_length);
- XEN_DEFINE_PROCEDURE(S_vct_multiplyB, g_vct_multiply_w, 2, 0, 0, H_vct_multiplyB);
- XEN_DEFINE_PROCEDURE(S_vct_scaleB, g_vct_scale_w, 2, 0, 0, H_vct_scaleB);
- XEN_DEFINE_PROCEDURE(S_vct_fillB, g_vct_fill_w, 2, 0, 0, H_vct_fillB);
- XEN_DEFINE_PROCEDURE(S_vct_addB, g_vct_add_w, 2, 1, 0, H_vct_addB);
- XEN_DEFINE_PROCEDURE(S_vct_subtractB, g_vct_subtract_w, 2, 0, 0, H_vct_subtractB);
- XEN_DEFINE_PROCEDURE(S_vct_offsetB, g_vct_offset_w, 2, 0, 0, H_vct_offsetB);
- XEN_DEFINE_PROCEDURE(S_vct_peak, g_vct_peak_w, 1, 0, 0, H_vct_peak);
- XEN_DEFINE_PROCEDURE(S_vct_moveB, g_vct_move_w, 3, 1, 0, H_vct_moveB);
- XEN_DEFINE_PROCEDURE(S_vct_subseq, g_vct_subseq_w, 2, 2, 0, H_vct_subseq);
- XEN_DEFINE_PROCEDURE(S_vct, g_vct_w, 0, 0, 1, H_vct);
- XEN_DEFINE_PROCEDURE(S_vct_reverse, g_vct_reverse_w, 1, 1, 0, H_vct_reverse);
- XEN_DEFINE_PROCEDURE(S_vct_mapB, g_vct_mapB_w, 2, 0, 0, H_vct_mapB);
+#if HAVE_SCHEME
+ {
+ s7_pointer s, i, p, b, r, f, t;
+ s = s7_make_symbol(s7, "string?");
+ i = s7_make_symbol(s7, "integer?");
+ p = s7_make_symbol(s7, "pair?");
+ r = s7_make_symbol(s7, "real?");
+ b = s7_make_symbol(s7, "boolean?");
+ f = s7_make_symbol(s7, "float-vector?");
+ t = s7_t(s7);
+ pl_rf = s7_make_signature(s7, 2, r, f);
+ pl_ff = s7_make_signature(s7, 2, f, f);
+ pl_sf = s7_make_signature(s7, 2, s, f);
+ pl_pf = s7_make_signature(s7, 2, p, f);
+ pl_ftt = s7_make_signature(s7, 3, f, t, t);
+ pl_fff = s7_make_signature(s7, 3, f, f, f);
+ pl_ffr = s7_make_signature(s7, 3, f, f, r);
+ pl_bffr = s7_make_signature(s7, 4, b, f, f, r);
+ pl_fffi = s7_make_signature(s7, 4, f, f, f, i);
+ pl_ffii = s7_make_signature(s7, 4, f, f, i, i);
+ pl_ffiif = s7_make_signature(s7, 5, f, f, i, i, f);
+ }
+#endif
-#if HAVE_SCHEME || HAVE_FORTH
- XEN_DEFINE_PROCEDURE_WITH_SETTER(S_vct_ref, g_vct_ref_w, H_vct_ref, "set-" S_vct_ref, g_vct_set_w, 2, 0, 3, 0);
+ Xen_define_typed_procedure(S_vct_multiply, g_vct_multiply_w, 2, 0, 0, H_vct_multiplyB, pl_fff);
+ Xen_define_typed_procedure(S_vct_add, g_vct_add_w, 2, 1, 0, H_vct_addB, pl_fffi);
+ Xen_define_typed_procedure(S_vct_subtract, g_vct_subtract_w, 2, 0, 0, H_vct_subtractB, pl_fff);
+ Xen_define_typed_procedure(S_vct_offset, g_vct_offset_w, 2, 0, 0, H_vct_offsetB, pl_ffr);
+ Xen_define_typed_procedure(S_vct_peak, g_vct_peak_w, 1, 0, 0, H_vct_peak, pl_rf);
+ Xen_define_typed_procedure(S_vct_peak_and_location, g_vct_peak_and_location_w, 1, 0, 0, H_vct_peak_and_location, pl_pf);
+ Xen_define_typed_procedure(S_vct_move, g_vct_move_w, 3, 1, 0, H_vct_moveB, pl_ffii);
+ Xen_define_typed_procedure(S_vct_subseq, g_vct_subseq_w, 2, 2, 0, H_vct_subseq, pl_ffiif);
+ Xen_define_typed_procedure(S_vct_copy, g_vct_copy_w, 1, 0, 0, H_vct_copy, pl_ff);
+
+#if HAVE_FORTH
+ Xen_define_dilambda(S_vct_ref, g_vct_ref_w, H_vct_ref, "set-" S_vct_ref, g_vct_set_w, 2, 0, 3, 0);
#else
- XEN_DEFINE_PROCEDURE(S_vct_ref, g_vct_ref_w, 2, 0, 0, H_vct_ref);
+#if (!HAVE_SCHEME)
+ Xen_define_procedure(S_vct_ref, g_vct_ref_w, 2, 0, 0, H_vct_ref);
#endif
+#endif
+
+ Xen_define_typed_procedure(S_vct_to_string, g_vct_to_readable_string_w, 1, 0, 0, H_vct_to_string, pl_sf);
+ Xen_define_typed_procedure(S_vct_times, g_vct_times_w, 2, 0, 0, H_vct_times, pl_ftt);
+ Xen_define_typed_procedure(S_vct_plus, g_vct_plus_w, 2, 0, 0, H_vct_plus, pl_ftt);
+ Xen_define_typed_procedure(S_vct_max, g_vct_max_w, 1, 0, 0, H_vct_max, pl_rf);
+ Xen_define_typed_procedure(S_vct_min, g_vct_min_w, 1, 0, 0, H_vct_min, pl_rf);
+ Xen_define_typed_procedure(S_vct_scale, g_vct_scale_w, 2, 0, 0, H_vct_scaleB, pl_ftt);
+ Xen_define_typed_procedure(S_vct_abs, g_vct_abs_w, 1, 0, 0, H_vct_absB, pl_ff);
+ Xen_define_typed_procedure(S_vct_equal, g_vct_equal_w, 3, 0, 0, H_vct_equal, pl_bffr);
- XEN_DEFINE_PROCEDURE(S_vct_to_string, g_vct_to_readable_string_w, 1, 0, 0, H_vct_to_string);
- XEN_DEFINE_PROCEDURE(S_vct_setB, g_vct_set_w, 3, 0, 0, H_vct_setB);
- XEN_DEFINE_PROCEDURE(S_vct_times, g_vct_times_w, 2, 0, 0, H_vct_times);
- XEN_DEFINE_PROCEDURE(S_vct_plus, g_vct_plus_w, 2, 0, 0, H_vct_plus);
+#if (!HAVE_SCHEME)
+ Xen_define_procedure(S_vct_set, g_vct_set_w, 3, 0, 0, H_vct_setB);
+ Xen_define_procedure(S_is_vct, g_is_vct_w, 1, 0, 0, H_is_vct);
+ Xen_define_procedure(S_vct_fill, g_vct_fill_w, 2, 0, 0, H_vct_fillB);
+ Xen_define_procedure(S_vct, g_vct_w, 0, 0, 1, H_vct);
+ Xen_define_procedure(S_vct_length, g_vct_length_w, 1, 0, 0, H_vct_length);
+ Xen_define_procedure(S_vct_reverse, g_vct_reverse_w, 1, 1, 0, H_vct_reverse);
+ Xen_define_procedure(S_vct_to_list, g_vct_to_list_w, 1, 0, 0, H_vct_to_list);
+ Xen_define_procedure(S_list_to_vct, g_list_to_vct_w, 1, 0, 0, H_list_to_vct);
+ Xen_define_procedure(S_vector_to_vct, g_vector_to_vct_w, 1, 0, 0, H_vector_to_vct);
+ Xen_define_procedure(S_vct_to_vector, g_vct_to_vector_w, 1, 0, 0, H_vct_to_vector);
+ Xen_define_procedure(S_make_vct, g_make_vct_w, 1, 1, 0, H_make_vct);
+#else
+ Xen_define_procedure(S_vct_spatter, g_vct_spatter_w, 4, 0, 0, H_vct_spatter);
+ Xen_define_procedure(S_vct_interpolate, g_vct_interpolate_w, 7, 0, 0, H_vct_interpolate);
+
+ s7_pf_set_function(s7_name_to_value(s7, S_vct_add), float_vector_add_pf);
+ s7_pf_set_function(s7_name_to_value(s7, S_vct_subtract), float_vector_subtract_pf);
+ s7_pf_set_function(s7_name_to_value(s7, S_vct_multiply), float_vector_multiply_pf);
+ s7_pf_set_function(s7_name_to_value(s7, S_vct_scale), float_vector_scale_pf);
+ s7_pf_set_function(s7_name_to_value(s7, S_vct_offset), float_vector_offset_pf);
+ s7_pf_set_function(s7_name_to_value(s7, S_vct_abs), float_vector_abs_pf);
+
+ s7_rf_set_function(s7_name_to_value(s7, S_vct_min), float_vector_min_rf);
+ s7_rf_set_function(s7_name_to_value(s7, S_vct_max), float_vector_max_rf);
+ s7_rf_set_function(s7_name_to_value(s7, S_vct_peak), float_vector_peak_rf);
+#endif
}
diff --git a/vct.h b/vct.h
index fc2ed79..b7a4c9d 100644
--- a/vct.h
+++ b/vct.h
@@ -1,70 +1,49 @@
#ifndef VCT_H
#define VCT_H
-#define S_make_vct "make-vct"
-#define S_vct_addB "vct-add!"
-#define S_vct_subtractB "vct-subtract!"
-#define S_vct_copy "vct-copy"
-#define S_vct_length "vct-length"
-#define S_vct_multiplyB "vct-multiply!"
-#define S_vct_offsetB "vct-offset!"
-#define S_vct_ref "vct-ref"
-#define S_vct_scaleB "vct-scale!"
-#define S_vct_fillB "vct-fill!"
-#define S_vct_setB "vct-set!"
-#define S_vct_mapB "vct-map!"
-#define S_vct_peak "vct-peak"
-#define S_vct_p "vct?"
-#define S_list_to_vct "list->vct"
-#define S_vct_to_list "vct->list"
-#define S_vector_to_vct "vector->vct"
-#define S_vct_to_vector "vct->vector"
-#define S_vct_moveB "vct-move!"
-#define S_vct_subseq "vct-subseq"
-#define S_vct "vct"
-#define S_vct_reverse "vct-reverse!"
-#define S_vct_to_string "vct->string"
-#if HAVE_RUBY
- #define S_vct_times "vct_multiply"
- #define S_vct_plus "vct_add"
+#if HAVE_SCHEME
+ typedef struct s7_cell vct;
#else
- #define S_vct_times "vct*"
- #define S_vct_plus "vct+"
+typedef struct vct vct;
#endif
-typedef struct {
- mus_long_t length;
- mus_float_t *data;
- bool dont_free;
-} vct;
-
#ifdef __cplusplus
extern "C" {
#endif
MUS_EXPORT void mus_vct_init(void);
-MUS_EXPORT bool mus_vct_p(XEN obj);
MUS_EXPORT int mus_vct_print_length(void);
MUS_EXPORT void mus_vct_set_print_length(int len);
-MUS_EXPORT XEN mus_array_to_list(mus_float_t *arr, mus_long_t i, mus_long_t len);
-MUS_EXPORT char *mus_vct_to_string(vct *v);
-MUS_EXPORT bool mus_vct_equalp(vct *v1, vct *v2);
+MUS_EXPORT Xen mus_array_to_list(mus_float_t *arr, mus_long_t i, mus_long_t len);
+MUS_EXPORT bool mus_vct_is_equal(vct *v1, vct *v2);
MUS_EXPORT char *mus_vct_to_readable_string(vct *v);
MUS_EXPORT vct *mus_vct_make(mus_long_t len);
MUS_EXPORT vct *mus_vct_free(vct *v);
-MUS_EXPORT vct *mus_vct_copy(vct *vc);
MUS_EXPORT double mus_vct_peak(vct *v);
-MUS_EXPORT XEN vct_to_xen(vct *v);
-MUS_EXPORT XEN xen_list_to_vct(XEN lst);
-MUS_EXPORT vct *xen_to_vct(XEN arg);
-MUS_EXPORT XEN xen_make_vct(mus_long_t len, mus_float_t *data);
-MUS_EXPORT XEN xen_make_vct_wrapper(mus_long_t len, mus_float_t *data);
-MUS_EXPORT XEN g_vct_peak(XEN obj);
-
-#define XEN_TO_VCT(arg) ((vct *)XEN_OBJECT_REF(arg))
-#define MUS_VCT_P(arg) mus_vct_p(arg)
-
+MUS_EXPORT Xen xen_list_to_vct(Xen lst);
+MUS_EXPORT vct *xen_to_vct(Xen arg);
+MUS_EXPORT Xen xen_make_vct(mus_long_t len, mus_float_t *data);
+MUS_EXPORT Xen xen_make_vct_wrapper(mus_long_t len, mus_float_t *data);
+MUS_EXPORT Xen g_vct_peak(Xen obj);
+
+MUS_EXPORT vct *mus_vct_wrap(mus_long_t len, mus_float_t *data);
+
+#if HAVE_SCHEME
+ #define S_vct "float-vector"
+ #define Xen_to_vct(Obj) (vct *)Obj
+ #define mus_vct_length(V) s7_vector_length((s7_pointer)V)
+ #define mus_vct_data(V) s7_float_vector_elements((s7_pointer)V)
+ #define mus_is_vct(Obj) s7_is_float_vector(Obj)
+ #define vct_to_xen(V) (Xen)V
+#else
+ #define S_vct "vct"
+ #define Xen_to_vct(arg) ((vct *)Xen_object_ref(arg))
+ MUS_EXPORT mus_long_t mus_vct_length(vct *v);
+ MUS_EXPORT mus_float_t *mus_vct_data(vct *v);
+ MUS_EXPORT bool mus_is_vct(Xen obj);
+ MUS_EXPORT Xen vct_to_xen(vct *v);
+#endif
#ifdef __cplusplus
}
diff --git a/write.scm b/write.scm
new file mode 100644
index 0000000..2cca91f
--- /dev/null
+++ b/write.scm
@@ -0,0 +1,417 @@
+(provide 'write.scm)
+
+;;; -------------------------------- pretty-print --------------------------------
+
+(define pretty-print
+
+ (let ((*pretty-print-length* 100)
+ (*pretty-print-spacing* 2)
+ (*pretty-print-float-format* "~,4F"))
+
+ (lambda* (obj (port (current-output-port)) (column 0))
+
+ (define (pretty-print-1 obj port column)
+ (define (spaces n)
+ (write-char #\newline port)
+ (do ((i 0 (+ i 1))) ((= i n)) (write-char #\space port)))
+
+ (define (stacked-list lst col)
+ (do ((l1 lst (cdr l1)))
+ ((not (pair? l1)))
+ (let ((added 0))
+ (if (not (eq? l1 lst)) (spaces col))
+ (let* ((str (object->string (car l1)))
+ (len (length str)))
+ (if (and (keyword? (car l1))
+ (pair? (cdr l1)))
+ (begin
+ (write (car l1) port)
+ (write-char #\space port)
+ (set! added (+ 1 len))
+ (set! l1 (cdr l1))))
+ (if (pair? l1)
+ (if (and (pair? (car l1))
+ (pair? (cdar l1))
+ (null? (cddar l1))
+ (> len (/ *pretty-print-length* 2)))
+ (begin
+ (write-char #\( port)
+ (pretty-print-1 (caar l1) port col)
+ (spaces (+ col 1))
+ (pretty-print-1 (cadar l1) port (+ col 1))
+ (write-char #\) port))
+ (pretty-print-1 (car l1) port (+ col added)))
+ (format port " . ~S" l1)))
+ (set! added 0))))
+
+ (define (stacked-split-list lst col)
+ (if (pair? lst)
+ (do ((l1 lst (cdr l1)))
+ ((not (pair? l1)))
+ (if (not (eq? l1 lst)) (spaces col))
+ (write-char #\( port)
+ (if (pair? (car l1))
+ (begin
+ (write (caar l1) port)
+ (write-char #\space port)
+ (if (and (pair? (cdar l1))
+ (symbol? (caar l1)))
+ (pretty-print-1 (cadar l1) port (+ col (length (symbol->string (caar l1))) 2))
+ (write (cdar l1) port)))
+ (write (car l1) port))
+ (write-char #\) port))
+ (write lst port)))
+
+ (define (messy-number z)
+ (if (real? z)
+ (if (or (nan? z)
+ (infinite? z))
+ (object->string z)
+ (if (= z pi)
+ "pi"
+ (format #f *pretty-print-float-format* z)))
+ (format "~A~A~Ai"
+ (messy-number (real-part z))
+ (if (negative? (imag-part z)) "-" "+")
+ (messy-number (abs (imag-part z))))))
+
+ (define (any-keyword? lst)
+ (and (pair? lst)
+ (or (keyword? (car lst))
+ (any-keyword? (cdr lst)))))
+
+ (cond ((number? obj)
+ (if (rational? obj)
+ (write obj port)
+ (display (messy-number obj) port)))
+
+ ((pair? obj)
+ (let ((cobj (if (symbol? (car obj)) (string->symbol (symbol->string (car obj))) (car obj)))) ; this clears out some optimization confusion
+ (case cobj
+
+ ((lambda lambda* define* define-macro define-macro* define-bacro define-bacro* with-let when unless
+ call-with-input-string call-with-input-file call-with-output-file
+ with-input-from-file with-input-from-string with-output-to-file)
+ (if (or (not (pair? (cdr obj))) ; (when) or (when . #t)
+ (not (pair? (cddr obj))))
+ (write obj port)
+ (begin
+ (format port "(~A ~A" (car obj) (cadr obj))
+ (spaces (+ column *pretty-print-spacing*))
+ (stacked-list (cddr obj) (+ column *pretty-print-spacing*))
+ (write-char #\) port))))
+
+ ((defmacro defmacro*)
+ (if (or (not (pair? (cdr obj)))
+ (not (pair? (cddr obj))))
+ (write obj port)
+ (begin
+ (format port "(~A ~A ~A" (car obj) (cadr obj) (caddr obj))
+ (spaces (+ column *pretty-print-spacing*))
+ (stacked-list (cdddr obj) (+ column *pretty-print-spacing*))
+ (write-char #\) port))))
+
+ ((define)
+ (if (not (pair? (cdr obj)))
+ (write obj port)
+ (begin
+ (format port "(~A ~A " (car obj) (cadr obj))
+ (if (pair? (cadr obj))
+ (begin
+ (spaces (+ column *pretty-print-spacing*))
+ (stacked-list (cddr obj) (+ column *pretty-print-spacing*)))
+ (begin
+ (if (pair? (cddr obj))
+ (let ((str (object->string (caddr obj))))
+ (if (> (length str) 60)
+ (begin
+ (spaces (+ column *pretty-print-spacing*))
+ (pretty-print-1 (caddr obj) port (+ column *pretty-print-spacing*)))
+ (write (caddr obj) port)))
+ (write (cddr obj) port))))
+ (write-char #\) port))))
+
+ ((do)
+ (if (not (pair? (cdr obj)))
+ (write obj port)
+ (begin
+ (format port "(do (")
+ (if (pair? (cadr obj))
+ (stacked-list (cadr obj) (+ column 5)))
+ (write-char #\) port)
+ (if (pair? (cddr obj))
+ (let ((end (caddr obj)))
+ (spaces (+ column 4))
+ (if (< (length (object->string end)) (- *pretty-print-length* column))
+ (write end port)
+ (begin
+ (write-char #\( port)
+ (pretty-print-1 (car end) port (+ column 4))
+ (spaces (+ column 5))
+ (stacked-list (cdr end) (+ column 5))
+ (write-char #\) port)))
+ (spaces (+ column *pretty-print-spacing*))
+ (stacked-list (cdddr obj) (+ column *pretty-print-spacing*))
+ (write-char #\) port))
+ (write-char #\) port)))))
+
+ ((cond)
+ (format port "(cond ")
+ (stacked-list (cdr obj) (+ column 6))
+ (write-char #\) port))
+
+ ((or and)
+ (if (> (length (object->string obj)) 40)
+ (begin
+ (format port "(~A " (car obj))
+ (stacked-list (cdr obj) (+ column *pretty-print-spacing* (length (symbol->string (car obj)))))
+ (write-char #\) port))
+ (write obj port)))
+
+ ((case)
+ (if (not (pair? (cdr obj)))
+ (write obj port)
+ (begin
+ (format port "(case ~A" (cadr obj)) ; send out the selector
+ (do ((lst (cddr obj) (cdr lst)))
+ ((not (pair? lst)))
+ (spaces (+ column *pretty-print-spacing*))
+ (if (not (pair? (car lst)))
+ (write (car lst) port)
+ (begin
+ (write-char #\( port)
+ (if (not (pair? (caar lst)))
+ (write (caar lst) port)
+ (let ((len (length (caar lst))))
+ (if (< len 6)
+ (write (caar lst) port)
+ (let ((p (caar lst)))
+ (write-char #\( port)
+ (do ((i 0 (+ i 6)))
+ ((>= i len))
+ (do ((j 0 (+ j 1)))
+ ((or (= j 6)
+ (null? p))
+ (if (pair? p) (spaces (+ column 4))))
+ (write (car p) port)
+ (set! p (cdr p))
+ (if (pair? p) (write-char #\space port))))
+ (write-char #\) port)))))
+ (if (and (pair? (cdar lst))
+ (null? (cddar lst))
+ (< (length (object->string (cadar lst))) 60))
+ (begin
+ (write-char #\space port)
+ (write (cadar lst) port))
+ (begin
+ (spaces (+ column 3))
+ (stacked-list (cdar lst) (+ column 3))))
+ (write-char #\) port))))
+ (write-char #\) port))))
+
+ ((begin call-with-exit call/cc call-with-current-continuation with-baffle with-output-to-string call-with-output-string
+ map for-each)
+ (format port "(~A" (car obj))
+ (if (pair? (cdr obj))
+ (begin
+ (spaces (+ column *pretty-print-spacing*))
+ (stacked-list (cdr obj) (+ column *pretty-print-spacing*))))
+ (write-char #\) port))
+
+ ((dynamic-wind)
+ (format port "(dynamic-wind")
+ (spaces (+ column *pretty-print-spacing*))
+ (stacked-list (cdr obj) (+ column *pretty-print-spacing*))
+ (write-char #\) port))
+
+ ((if)
+ (let ((objstr (object->string obj))
+ (ifcol (+ column 4)))
+ (if (< (length objstr) 40)
+ (display objstr port)
+ (begin
+ (format port "(if ")
+ (pretty-print-1 (cadr obj) port ifcol)
+ (spaces (+ column 4))
+ (pretty-print-1 (caddr obj) port ifcol)
+ (if (pair? (cdddr obj))
+ (begin
+ (spaces (+ column 4))
+ (pretty-print-1 (cadddr obj) port ifcol)))
+ (write-char #\) port)))))
+
+ ((let let* letrec letrec*)
+ (if (or (not (pair? (cdr obj)))
+ (not (pair? (cddr obj))))
+ (write obj port)
+ (let ((head-len (length (symbol->string (car obj)))))
+ (if (symbol? (cadr obj))
+ (begin
+ (format port "(~A ~A (" (car obj) (cadr obj))
+ (if (pair? (cddr obj))
+ (if (pair? (caddr obj)) ; (let x () ...)
+ (stacked-split-list (caddr obj) (+ column head-len (length (symbol->string (cadr obj))) 4))
+ (write (caddr obj) port))
+ (if (not (null? (cddr obj)))
+ (format port " . ~S" (cddr obj)))))
+ (begin
+ (format port "(~A (" (car obj))
+ (if (pair? (cadr obj))
+ (stacked-split-list (cadr obj) (+ column head-len 3)))))
+ (write-char #\) port)
+ (spaces (+ column *pretty-print-spacing*))
+ (if (pair? ((if (symbol? (cadr obj)) cdddr cddr) obj))
+ (stacked-list ((if (symbol? (cadr obj)) cdddr cddr) obj) (+ column *pretty-print-spacing*)))
+ (write-char #\) port))))
+
+ ((inlet)
+ (format port "(inlet")
+ (if (pair? (cdr obj))
+ (do ((lst (cdr obj) (cddr lst)))
+ ((or (not (pair? lst))
+ (not (pair? (cdr lst)))))
+ (spaces (+ column *pretty-print-spacing*))
+ (if (pair? (cdr lst))
+ (begin
+ (write (car lst) port)
+ (write-char #\space port)
+ (pretty-print-1 (cadr lst) port (+ column *pretty-print-spacing* (length (object->string (car lst))))))
+ (write lst port))))
+ (write-char #\) port))
+
+ ((set!)
+ (let ((str (object->string obj)))
+ (if (> (length str) 60)
+ (let ((settee (object->string (cadr obj))))
+ (format port "(set! ~A" settee)
+ (if (> (length settee) 20)
+ (begin
+ (spaces (+ column 6))
+ (pretty-print-1 (caddr obj) port (+ column 6)))
+ (begin
+ (write-char #\space port)
+ (pretty-print-1 (caddr obj) port (+ column 7 (length settee)))))
+ (write-char #\) port))
+ (display str port))))
+
+ ((quote)
+ (if (not (pair? (cdr obj))) ; (quote) or (quote . 1)
+ (write obj port)
+ (begin
+ (write-char #\' port)
+ (pretty-print-1 (cadr obj) port column))))
+
+ (else
+ (let* ((objstr (object->string obj))
+ (strlen (length objstr)))
+ (if (< (+ column strlen) *pretty-print-length*)
+ (display objstr port)
+ (let ((lstlen (length obj)))
+ (if (or (infinite? lstlen)
+ (< lstlen 2))
+ (display objstr port)
+ (if (and (pair? (car obj))
+ (member (caar obj) '(lambda lambda*) eq?))
+ (begin
+ (write-char #\( port)
+ (pretty-print-1 (car obj) port column)
+ (spaces (+ column 1))
+ (display (cadr obj) port)
+ (write-char #\) port))
+ (let* ((carstr (object->string (car obj)))
+ (carstrlen (length carstr)))
+ (if (eq? (car obj) 'quote)
+ (write-char #\' port)
+ (format port "(~A" carstr))
+ (if (any-keyword? (cdr obj))
+ (begin
+ (spaces (+ column *pretty-print-spacing*))
+ (stacked-list (cdr obj) (+ column *pretty-print-spacing*)))
+ (let ((line-len (ceiling (/ (- strlen carstrlen) 40)))
+ (line-start (+ column *pretty-print-spacing* carstrlen)))
+ (if (= lstlen 2)
+ (begin
+ (write-char #\space port)
+ (pretty-print-1 (cadr obj) port line-start))
+ (if (< lstlen 5)
+ (begin
+ (write-char #\space port)
+ (stacked-list (cdr obj) line-start))
+ (let ((lst (cdr obj)))
+ (do ((i 1 (+ i line-len)))
+ ((>= i lstlen))
+ (do ((k 0 (+ k 1)))
+ ((or (null? lst)
+ (= k line-len)))
+ (let ((str (format #f "~S" (car lst))))
+ (if (> (length str) (- *pretty-print-length* line-start))
+ (begin
+ (if (not (zero? k)) (spaces line-start))
+ (pretty-print-1 (car lst) port line-start))
+ (begin
+ (if (or (not (zero? k)) (= i 1)) (write-char #\space port))
+ (display str port))))
+ (set! lst (cdr lst)))
+ (if (pair? lst)
+ (spaces line-start))))))))
+ (if (not (eq? (car obj) 'quote))
+ (write-char #\) port))))))))))))
+ (else
+ (write obj port))))
+
+ (let ((old-port port))
+ (if (boolean? old-port)
+ (set! port (open-output-string)))
+ (pretty-print-1 obj port column)
+ (flush-output-port port)
+ (if (boolean? old-port)
+ (let ((str (get-output-string port)))
+ (close-output-port port)
+ (if (eq? old-port #t)
+ (display str))
+ str)
+ (values))))))
+
+(define (pp obj)
+ (call-with-output-string
+ (lambda (p)
+ (pretty-print obj p))))
+
+#|
+(define (pretty-print-all)
+ (let ((st (symbol-table)))
+ (for-each
+ (lambda (sym)
+ (if (defined? sym)
+ (let ((val (symbol->value sym)))
+ (let ((source (and (procedure? val)
+ (procedure-source val))))
+ (if (pair? source)
+ (format *stderr* "~<sym~> ~<val~>:~%~<(pp source)~>~%~%"))))))
+ st)))
+
+(define-macro (fully-macroexpand form)
+ (define (expand form)
+ ;; walk form looking for macros, expand any that are found -- see stuff.scm for a newer version
+ (if (pair? form)
+ (if (and (symbol? (car form))
+ (macro? (symbol->value (car form))))
+ (expand ((eval (procedure-source (symbol->value (car form)))) form))
+ (cons (expand (car form))
+ (expand (cdr form))))
+ form))
+ `(pretty-print ',(expand form)))
+
+(define* (pp-sequence seq)
+ (let ((iter (make-iterator seq))
+ (strs ())
+ (plen (*s7* 'print-length)))
+ (do ((i 0 (+ i 1))
+ (entry (iterate iter) (iterate iter)))
+ ((or (= i plen)
+ (eof-object? entry))
+ (if (not (eof-object? entry))
+ (apply string-append (append (reverse! strs) (list "...")))
+ (apply string-append (reverse! strs))))
+ (set! strs (cons (format #f "~S " entry) strs)))))
+|#
diff --git a/ws.rb b/ws.rb
index 3ef3064..0477a3d 100644
--- a/ws.rb
+++ b/ws.rb
@@ -1,6 +1,6 @@
# ws.rb -- with_sound and friends for Snd/Ruby
-# Copyright (c) 2003--2011 Michael Scholz <mi-scholz at users.sourceforge.net>
+# Copyright (c) 2003-2015 Michael Scholz <mi-scholz at users.sourceforge.net>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -23,61 +23,79 @@
# 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.
-
-# Commentary:
#
+# Created: 03/04/08 17:05:03
+# Changed: 15/03/04 16:38:12
+
# module WS
+# ws_getlogin
+# ws_gethostname
# ws_break(*rest)
-# with_reverb(reverb, reverb_amount, snd, *with_sound_args)
# with_sound(*args) do ... end
+# with_dac(*args) do ... end
+# with_snd(*args) do ... end
+# with_clm(*args) do ... end
# with_full_sound(*args) do ... end
# with_temp_sound(*args) do ... end
-# with_dac(*args) do ... end
-# clm_load(rbm_file, *args)
# with_temp_snd(snd) do |temp_snd_file_name| ... end
+# clm_load(rbm_file, *args)
# make_default_comment
# remove_file(file)
# each_sample(start, dur) do |samp| ... end
-# sound_data_frame_ref(data, samp, frm)
-# sound_data_frame_set!(data, samp, frm)
# process_times
#
+# class XenSound
+# name
+# length
+# update
+# revert
+# save
+# close
+# snd_file_name
+# snd_maxamp(chn, edpos)
+# snd_framples(chn, edpos)
+# snd_sample_type snd_sample_type=(v)
+# snd_header_type snd_header_type=(v)
+# snd_comment snd_comment=(v)
+# snd_srate snd_srate=(v)
+# snd_channels snd_channels=(v)
+#
# class With_sound
# initialize(*args, &body)
#
# properties:
-# output # file name, String
-# out_snd # sound index, Fixnum
-# with_sound_note_hook # note hook, Hook
+# output # file name (String)
+# out_snd # sound index (XenSound)
+# with_sound_note_hook # note hook (Hook)
#
# methods:
-# help (or description, info)
+# help (or description, info)
# inspect
# to_s
# describe (show_local_variables)
# with_sound(*args) do ... end
+# with_current_sound(*args) do ... end
# scaled_to(scale) do ... end
# scaled_by(scale) do ... end
# with_offset(secs) do ... end
-# with_current_sound(*args) do ... end
# sound_let(*args) do |*sl_args| ... end
-# clm_load(rbm_file, *args)
# with_mix(*args, file[, beg_time], body_string)
# with_sound_info(instrument_name, start, dur, binding)
# run_instrument(start, dur, *locsig_args) do |samp| ... end
-# run_reverb(chan = 0) do |in_val, samp| ... end
-# clm_mix(filename, *args)
+# run_reverb do |ho, samp| ... end
# run do ... end
+# clm_mix(infile, *args)
#
# class Instrument
-# my_simp(start, dur, freq, amp, amp_env = [0, 1, 1, 1])
+# ws_simp(start, dur, freq, amp, amp_env)
+# ws_violin(start, dur, freq, amp, fm_index, amp_env)
# make_ws_reader(file, *args)
# ws_readin(rd)
# close_ws_reader(rd)
# ws_location(rd)
-# set_ws_location(rd, val)
+# set_ws_location(rd, v)
# ws_increment(rd)
-# set_ws_increment(rd, val)
+# set_ws_increment(rd, v)
# ws_srate(file)
# ws_channels(file)
# ws_duration(file)
@@ -97,15 +115,18 @@
# | |
# v v
# Snd_Instrument CLM_Instrument
-# | | |
-# v v v
-# With_Snd With_DAC With_CLM
+# | | |
+# v v v
+# With_Snd With_DAC With_CLM
#
-# Instruments can use the generalized run-loop `run_instrument'.
+# Instruments can use the generalized run-loop 'run_instrument'.
#
-# RUN_INSTRUMENT(start, dur, *locsig_args) do |samp| ... (return next sample) end
+# RUN_INSTRUMENT(start, dur, *locsig_args) do |samp|
+# ...
+# (return next sample)
+# end
#
-# The body (or block) of `run_instrument' should return the next sample, e.g.:
+# The body (or block) of 'run_instrument' should return the next sample, e.g.:
#
# class Instrument
# def my_simp(start, dur, freq, amp, amp_env = [0, 1, 1, 1])
@@ -120,67 +141,55 @@
# In Snd as well as in a Ruby script:
# with_sound do my_simp(0, 1, 440, 0.2) end
#
-# In addition, `with_dac do my_simp(0, 1, 440, 0.2) end' can use the
-# same instrument for dac-output.
-#
-# Reverbs can use the generalized run-loop `run_reverb'.
+# If the reverb file has only one channel, reverb instruments can use
+# the generalized run-loop 'run_reverb'.
#
-# RUN_REVERB(chan = 0) do |value, samp| ... (return next frame) end
+# RUN_REVERB() do |ho, samp| ... (return next frample) end
#
-# VALUE is the next sample value on location SAMP of reverb file's
-# CHANnel. It replaces
+# HO is the sample on location SAMP of reverb file.
+# It replaces
#
# (beg...len).each do |i|
-# ho = ina(i, $reverb)
+# ho = ina(i, @ws_reverb)
# ...
# end
-# by
+#
+# with
+#
# run_reverb() do |ho, i|
# ...
# end
#
-# The body should return a frame object of out-channels length. The
-# body is called seconds2sample(dur) times, like run_instrument.
+# The body should return a vct of @channels length, the out_frample.
+# The body is called seconds2sample(dur + @decay_time) times.
#
# def my_reverb(start, dur, *rest)
# ...
-# out_frames = make_frame(@channels)
+# out_frample = Vct.new(@channels, 0.0)
# run_reverb() do |ho, i|
# ...
-# frame_set!(out_frames, 0, val0)
+# out_frample[0] = val0
# if @channels > 1
-# frame_set!(out_frames, 1, val1)
+# out_frample[1] = val1
# end
# ...
-# out_frames
+# out_frample
# end
# end
#
-# A special case occures in freeverb.rb.
-#
-# run_reverb(:frames) do |in_frame, i|
-# ...
-# end
-#
-# IN_FRAME is a frame object of the I-th location in the reverb file
-# (or snd), the rest is like above.
-#
# The classes Snd_Instrument and CLM_Instrument can be used to define
# special instruments, see FULLMIX in clm-ins.rb.
#
# Class Snd_Instrument instruments can only be used in Snd. The
-# buffer can be created by with_sound or you can provide buffers for
-# output and revout, vcts or sound_data objects.
+# buffer can be created by with_sound or you can provide vcts for
+# output and revout.
#
# with_sound(:out_buffer, Vct.new(22050))
-# with_sound(:out_buffer, SoundData.new(22050, 2), :channels, 2)
#
# Class CLM_Instrument instruments use sample2file output and can be
# used in Snd as well as in Ruby scripts, @ws_output and $output are
# the same, @ws_reverb and $reverb are the same too.
-# Usage:
-#
# Global variables can be set in ~/.snd_ruby or in other scripts
# before or after loading ws.rb.
#
@@ -211,7 +220,7 @@
# with_sound. with_sound returns a filename which can be used in the
# sound_let body.
#
-# sound_let(Proc.new do | | fm_violin(0, 1, 330, 0.5) end,
+# sound_let(Proc.new do fm_violin(0, 1, 330, 0.5) end,
# 1024) do |tmp_file, val|
# end
#
@@ -220,7 +229,8 @@
# If with_sound needs args, the args and the procedure must be in an
# array.
#
-# sound_let([:scaled_to, 0.3, :output, "sl.snd", Proc.new do | | fm_violin(0, 1, 330, 0.5) end],
+# sound_let([:scaled_to, 0.3, :output, "sl.snd",
+# Proc.new do fm_violin(0, 1, 330, 0.5) end],
# 1024) do |tmp_file, val|
# end
#
@@ -228,15 +238,17 @@
#
# One with_sound-call and one temporary file name, arbitrary called TMP:
#
-# sound_let([:reverb, :jc_reverb, Proc.new do | | fm_violin(0, 1, 220, 0.2) end]) do |tmp|
+# sound_let([:reverb, :jc_reverb,
+# Proc.new do fm_violin(0, 1, 220, 0.2) end]) do |tmp|
# mus_mix(@output, tmp)
# end
#
# Two with_sound-calls and two temporary file names, arbitrary
# called TEMP_1 and TEMP_2:
#
-# sound_let([:reverb, :jc_reverb, Proc.new do | | fm_violin(0, 1, 220, 0.2) end],
-# Proc.new do | | fm_violin(0.5, 1, 440, 0.3) end) do |temp_1, temp_2|
+# sound_let([:reverb, :jc_reverb,
+# Proc.new do fm_violin(0, 1, 220, 0.2) end],
+# Proc.new do fm_violin(0.5, 1, 440, 0.3) end) do |temp_1, temp_2|
# mus_mix(temp_1, temp_2)
# mus_mix(@output, temp_1)
# end
@@ -283,7 +295,7 @@
#
# installs the @with_sound_note_hook and prints the line
#
-# `# fm_violin: start 0.000, dur 1.000'
+# '# fm_violin: start 0.000, dur 1.000'
#
# If option :info is true, every instrument-call prints the line
# mentioned above.
@@ -335,18 +347,18 @@
# (mix tmp :output-frame *srate*))
# (fm-violin .5 .1 330 .1))))
# (mix tmp :amplitude .5)))
-#
+
=begin
# Snd/Ruby examples
with_sound() do
clm_mix(with_sound(:output, "hiho.snd") do
fm_violin(0, 1, 440, 0.1)
- end.output, :scale, 0.5)
+ end.output, :scaler, 0.5)
end
with_sound() do
with_mix "s1", %Q{
- sound_let(Proc.new do | | fm_violin(0, 1, 440, 0.1) end) do |tmp|
+ sound_let(Proc.new do fm_violin(0, 1, 440, 0.1) end) do |tmp|
clm_mix(tmp)
end
}
@@ -354,44 +366,43 @@ end
with_sound(:verbose, true) do
with_mix "s6", %Q{
- sound_let(Proc.new do | | fm_violin(0, 1, 440, 0.1) end,
- [:reverb, :nrev, Proc.new do | | clm_mix("oboe.snd") end]) do |tmp, tmp1|
+ sound_let(Proc.new do fm_violin(0, 1, 440, 0.1) end,
+ [:reverb, :nrev,
+ Proc.new do clm_mix("oboe.snd") end]) do |tmp, tmp1|
clm_mix(tmp1)
- clm_mix(tmp, :scale, 0.2, :output_frame, seconds2samples(1))
+ clm_mix(tmp, :scaler, 0.2, :output_frame, seconds2samples(1))
end
fm_violin(0.5, 0.1, 330, 0.1)
}
end
with_sound(:verbose, true) do
- sound_let(Proc.new do | |
+ sound_let(Proc.new do
with_mix "s7", 0, %Q{
- sound_let(Proc.new do | | fm_violin(0, 1, 440, 0.1) end,
- Proc.new do | | clm_mix("oboe.snd") end) do |tmp, tmp1|
- clm_mix(tmp1)
- clm_mix(tmp, :output_frame, @srate)
+ sound_let(Proc.new do fm_violin(0, 1, 440, 0.1) end,
+ Proc.new do clm_mix("oboe.snd") end) do |t1, t2|
+ clm_mix(t2)
+ clm_mix(t1, :output_frame, @srate)
end
fm_violin(0.5, 0.1, 330, 0.1)
}
- end) do |tmp0|
- clm_mix(tmp0, :scale, 0.5)
+ end) do |t0|
+ clm_mix(t0, :scaler, 0.5)
end
end
=end
-# Code:
-
require "clm"
require "hooks"
def clm_find_sound_file(file)
- if File.exists?(file)
+ if File.exist?(file)
file
else
fname = false
if array?($clm_search_list)
$clm_search_list.each do |path|
- if File.exists?(fs = path + "/" + file)
+ if File.exist?(fs = path + "/" + file)
fname = fs
break
end
@@ -402,25 +413,37 @@ def clm_find_sound_file(file)
end
def clm_player(s)
- if provided?(:snd) and sound?(s)
- play(s, :wait, true)
- elsif string?(s) and File.exists?(fs = clm_find_sound_file(s))
- system("sndplay #{fs}")
+ fs = nil
+ if string?(s)
+ fs = clm_find_sound_file(s)
+ unless File.exist?(fs)
+ Snd.raise(:no_such_file, s, "need a sound index or a file name")
+ end
+ elsif sound?(s)
+ fs = s
else
Snd.raise(:no_such_sound, s, "need a sound index or a file name")
end
+ if provided?(:snd)
+ play(fs, :wait, true)
+ else
+ system("sndplay #{fs}")
+ end
end
-trace_var(:$clm_default_frequency) do |val| set_clm_default_frequency(val) end
-trace_var(:$clm_table_size) do |val| set_clm_table_size(val) end
+trace_var(:$clm_default_frequency) do |val|
+ set_clm_default_frequency(val)
+end
+trace_var(:$clm_table_size) do |val|
+ set_clm_table_size(val)
+end
with_silence do
# warning: undefined variable
- $clm_version = "ruby 19-Feb-2011"
+ $clm_version = "ruby 2015/03/04"
$output ||= false
$reverb ||= false
$clm_array_print_length ||= 8
- $clm_audio_format ||= Mus_lshort
$clm_clipped ||= true
$clm_comment ||= nil
$clm_decay_time ||= 1.0
@@ -430,7 +453,7 @@ with_silence do
$clm_info ||= false
$clm_notehook ||= nil
$clm_play ||= 0
- $clm_player ||= :clm_player
+ $clm_player ||= false
$clm_reverb ||= nil
$clm_reverb_channels ||= 1
$clm_reverb_data ||= []
@@ -439,70 +462,74 @@ with_silence do
$clm_table_size ||= 512
$clm_verbose ||= false
$clm_default_frequency ||= 0.0
+ $clm_locsig_type ||= locsig_type
$clm_search_list ||= (ENV["CLM_SEARCH_PATH"] or ".").split(/:/)
if provided? :snd
$clm_channels ||= default_output_chans
- $clm_data_format ||= default_output_data_format
- $clm_header_type ||= default_output_header_type
- $clm_locsig_type ||= locsig_type
- $clm_output_device ||= audio_output_device
- $clm_rt_bufsize ||= dac_size
$clm_srate ||= default_output_srate
+ $clm_header_type ||= default_output_header_type
+ $clm_sample_type ||= default_output_sample_type
+ $clm_dac_size ||= dac_size
else
$clm_channels ||= 1
- $clm_data_format ||= Mus_lfloat
- $clm_header_type ||= Mus_next
- $clm_locsig_type ||= Mus_interp_linear
- $clm_output_device ||= 0
- $clm_rt_bufsize ||= 512
$clm_srate ||= 44100
+ $clm_header_type ||= Mus_next
+ $clm_sample_type ||= Mus_lfloat
+ $clm_dac_size ||= 1024
end
end
+# for backward compatibility
+$clm_data_format = $clm_sample_type
+trace_var(:$clm_data_format) do |val|
+ $clm_sample_type = val
+end
+$clm_rt_bufsize = $clm_dac_size
+trace_var(:$clm_rt_bufsize) do |val|
+ $clm_dac_size = val
+end
+
module WS
+ ws_ht = mus_header_type2string($clm_header_type)
+ ws_st = mus_sample_type2string($clm_sample_type)
+ if string?(ws_fn = $clm_file_name)
+ ws_fn = File.basename(ws_fn)
+ end
+ if string?(ws_rf = $clm_reverb_file_name)
+ ws_rf = File.basename(ws_rf)
+ end
ws_doc = "\
- with_sound(*args) do ... end
-
- :output $clm_file_name test.snd
- :channels $clm_channels 1
- :srate $clm_srate 44100
- :header_type $clm_header_type Mus_next
- :data_format $clm_data_format Mus_lfloat
- :audio_format $clm_audio_format Mus_lshort
-
- :reverb $clm_reverb nil
- :reverb_data $clm_reverb_data []
- :reverb_channels $clm_reverb_channels 1
- :revfile $clm_reverb_file_name nil
- :delete_reverb $clm_delete_reverb false
-
- :decay_time $clm_decay_time 1.0
+with_sound(*args) do ... end
+ :output $clm_file_name (#{ws_fn.inspect})
+ :channels $clm_channels (#{$clm_channels})
+ :srate $clm_srate (#{$clm_srate})
+ :header_type $clm_header_type (#{ws_ht})
+ :sample_type $clm_sample_type (#{ws_st})
+ :reverb $clm_reverb (#{$clm_reverb.inspect})
+ :reverb_data $clm_reverb_data (#{$clm_reverb_data})
+ :reverb_channels $clm_reverb_channels (#{$clm_reverb_channels})
+ :revfile $clm_reverb_file_name (#{ws_rf.inspect})
+ :delete_reverb $clm_delete_reverb (#{$clm_delete_reverb})
+ :decay_time $clm_decay_time (#{$clm_decay_time})
:scaled_to false
:scaled_by false
:continue_old_file false
- :notehook $clm_notehook nil
-
- :play $clm_play 0
- :statistics $clm_statistics false
- :comment $clm_comment nil
- :locsig_type $clm_locsig_type Mus_interp_linear
- :verbose $clm_verbose false
-
-# next option works only with newer Ruby versions
-# save the with_sound-body in sound file's comment
+ :notehook $clm_notehook (#{$clm_notehook})
+ :dac_size $clm_dac_size (#{$clm_dac_size})
+ :play $clm_play (#{$clm_play})
+ :statistics $clm_statistics (#{$clm_statistics})
+ :comment $clm_comment (#{$clm_comment.inspect})
+ :locsig_type $clm_locsig_type (Mus_interp_linear)
+ :verbose $clm_verbose (#{$clm_verbose})
:save_body false
-
-# if an instrument uses run_instrument/run_reverb and INFO is true, a
-# message will be printed: `instrument_name: start 0.000, dur 0.000'
- :info $clm_info false
- :clipped $clm_clipped true
- :player $clm_player sndplay
-# special with_dac options:
- :bufsize $clm_rt_bufsize 512
- :device $clm_output_device 0
-
- Usage: with_sound(:play, 1, :statistics, true) do fm_violin end"
+ :info $clm_info (#{$clm_info})
+ :clipped $clm_clipped (#{$clm_clipped})
+ :player $clm_player (#{$clm_player.inspect})
+ :to_snd (true, false, nil)
+ :clm (true, false, nil)
+ :help
+Usage: with_sound(:play, 1, :statistics, true) do fm_violin end"
with_silence do
unless defined? Etc.getlogin
@@ -533,80 +560,98 @@ module WS
msg = format("%s received Break", get_func_name(2))
unless rest.null?
msg += ":"
- rest.each do |s| msg += format(" %s,", s) end
+ rest.each do |s|
+ msg += format(" %s,", s)
+ end
end
raise(Break, msg.chomp(","), caller(1))
end
-
- add_help(:with_reverb,
- "with_reverb(reverb, reverb_amount=0.05, snd=false, *with_sound_args)
-with_reverb(:jc_reverb)
-require 'clm-ins'
-with_reverb(:jl_reverb, 0.2)")
- def with_reverb(reverb, reverb_amount = 0.05, snd = false, *args)
- ws = With_Snd.new(:reverb, reverb,
- :output, file_name(Snd.snd(snd)),
- *args)
- ws.with_reverb(reverb_amount)
- ws
- end
+ # :to_snd has the following arguments:
+ # :snd or true => With_Snd
+ # :clm or false => With_CLM
+ # :dac or nil => With_DAC
+ # :clm has these (false and true swapped)
+ # :snd or false => With_Snd
+ # :clm or true => With_CLM
+ # :dac or nil => With_DAC
+ # :output "dac" => With_DAC
add_help(:with_sound, ws_doc)
def with_sound(*args, &body)
- clm = get_args(args, :clm, true)
- out = get_args(args, :out_buffer, false)
- if vct?(out) or sound_data?(out) then clm = false end
- ws = if clm
- With_CLM.new(*args, &body)
- else
- With_Snd.new(*args, &body)
- end
- if get_args(args, :help, false)
- Snd.message(ws.help)
+ if args.member?(:help)
+ return Snd.display(get_help(:with_sound))
+ end
+ if (not provided?(:snd))
+ klass = With_CLM
+ elsif args.member?(:output) and args[args.index(:output) + 1] == "dac"
+ klass = With_DAC
+ elsif args.member?(:to_snd)
+ case args[args.index(:to_snd) + 1]
+ when :snd, TrueClass
+ klass = With_Snd
+ when :clm, FalseClass
+ klass = With_CLM
+ when :dac, NilClass
+ klass = With_DAC
+ end
+ elsif args.member?(:clm)
+ case args[args.index(:clm) + 1]
+ when :snd, FalseClass
+ klass = With_Snd
+ when :clm, TrueClass
+ klass = With_CLM
+ when :dac, NilClass
+ klass = With_DAC
+ end
else
- ws.run
+ klass = With_CLM
end
+ ws = klass.new(*args, &body)
+ ws.run(&body)
ws
end
+ # require "v"
+ # with_dac(:statistics, true,
+ # :info, true,
+ # :dac_size, 8192 * 4,
+ # :srate, 22050) do
+ # violin(0.5, 2.5, 440, 0.2, 0.1, [0, 0, 25, 1, 75, 1, 100, 0])
+ # fm_violin(0, 5, 330, 0.2, :fm_index, 10.5)
+ # fm_violin(1, 2, 660, 0.2, :fm_index, 0.8)
+ # end
+ add_help(:with_dac, ws_doc)
+ def with_dac(*args, &body)
+ with_sound(:to_snd, :dac, *args, &body)
+ end
+
+ add_help(:with_snd, ws_doc)
+ def with_snd(*args, &body)
+ with_sound(:to_snd, :snd, *args, &body)
+ end
+
+ add_help(:with_clm, ws_doc)
+ def with_clm(*args, &body)
+ with_sound(:to_snd, :clm, *args, &body)
+ end
+
add_help(:with_full_sound, ws_doc)
def with_full_sound(*args, &body)
- ws = with_sound(:clm, false, *args, &body)
- set_x_bounds([0, frames($snd_opened_sound) / srate($snd_opened_sound).to_f], $snd_opened_sound)
+ ws = with_sound(:to_snd, :snd, *args, &body)
+ len = framples($snd_opened_sound) / srate($snd_opened_sound).to_f
+ set_x_bounds([0, len], $snd_opened_sound)
ws
end
add_help(:with_temp_sound, ws_doc)
def with_temp_sound(*args, &body)
- old_output = $clm_file_name
- $clm_file_name = tempnam()
- ws = with_sound(:clm, true, *args, &body)
- $clm_file_name = old_output
- ws
- end
-
- add_help(:with_dac, ws_doc)
- def with_dac(*args, &body)
- ws = With_DAC.new(*args, &body)
- if get_args(args, :help, false)
- Snd.message(ws.help)
- else
- ws.run
- end
+ ws = with_sound(:to_snd, :clm, :output, tempnam(), *args, &body)
+ remove_file(ws.output)
ws
end
-
- add_help(:clm_load, "clm_load(rbm_file, *with_sound_args)\n" + ws_doc)
- def clm_load(rbm_file, *args)
- assert_type(File.exists?(rbm_file), rbm_file, 1, "an existing file")
- with_sound(*args) do
- if @verbose then Snd.message("Loading %s", rbm_file.inspect) end
- eval(File.open(rbm_file).read, nil, format("(clm_load %s)", rbm_file), 1)
- end
- end
add_help(:with_temp_snd,
- "with_temp_snd(snd = false) do |temp_snd_file_name| ... end \
+ "with_temp_snd(snd=false) do |temp_snd_file_name| ... end \
Saves SND in a temporary file, which name can be accessed in the body code. \
After finishing the body, the file will be removed.")
def with_temp_snd(snd = false, &body)
@@ -616,20 +661,34 @@ After finishing the body, the file will be removed.")
remove_file(t)
ret
end
+
+ add_help(:clm_load,
+ "clm_load(rbm_file, *with_sound_args)\n" + ws_doc)
+ def clm_load(rbm_file, *args)
+ assert_type(File.exist?(rbm_file), rbm_file, 1, "an existing file")
+ with_sound(*args) do
+ if @verbose
+ Snd.message("Loading %s", rbm_file.inspect)
+ end
+ eval(File.open(rbm_file).read, nil, "(clm_load #{rbm_file})", 1)
+ end
+ end
if defined? snd_tempnam
alias tempnam snd_tempnam
else
$file_number = 0
def tempnam
- dir = (ENV.map do |k, v| v if /TMP/ =~ k end.compact.first or "/tmp")
+ dir = (ENV.map do |k, v|
+ v if /TMP/ =~ k
+ end.compact.first or "/tmp")
format("%s/snd_%d_%d.snd", dir, $$, $file_number += 1)
end
end
def make_default_comment
format("# Written %s by %s at %s using clm (%s)",
- Time.new.localtime.strftime("%a %d-%b-%y %H:%M %Z"),
+ Time.new.localtime.strftime("%a %d-%b-%y %H:%M %z"),
ws_getlogin,
ws_gethostname,
$clm_version)
@@ -637,28 +696,15 @@ After finishing the body, the file will be removed.")
def remove_file(file)
if provided?(:snd) and sound?(snd = find_sound(file))
- revert_sound(snd)
+ snd.revert
close_sound_extend(snd)
end
File.owned?(file) and File.unlink(file)
end
- def each_sample(start, dur)
+ def each_sample(start, dur, &body)
beg, ends = times2samples(start, dur)
- (beg...ends).each do |samp| yield(samp) end
- end
-
- def sound_data_frame_ref(data, samp, frm)
- sound_data_chans(data).times do |chn|
- frame_set!(frm, chn, sound_data_ref(data, chn, samp))
- end
- frm
- end
-
- def sound_data_frame_set!(data, samp, frm)
- sound_data_chans(data).times do |chn|
- sound_data_set!(data, chn, samp, frame_ref(frm, chn))
- end
+ (beg...ends).each(&body)
end
def process_times
@@ -670,6 +716,84 @@ After finishing the body, the file will be removed.")
end
end
+class XenSound
+ def name
+ self.class.name
+ end
+
+ def length
+ framples(self, false, false)
+ end
+
+ def update
+ update_sound(self)
+ end
+
+ def revert
+ revert_sound(self)
+ end
+
+ def save
+ save_sound(self)
+ end
+
+ def close
+ close_sound(self)
+ end
+
+ def snd_file_name
+ file_name(self)
+ end
+
+ def snd_maxamp(chn = false, edpos = false)
+ maxamp(self, chn, edpos)
+ end
+
+ def snd_framples(chn = false, edpos = false)
+ framples(self, chn, edpos)
+ end
+
+ def snd_sample_type
+ sample_type(self)
+ end
+
+ def snd_sample_type=(v)
+ set_sample_type(self, v)
+ end
+
+ def snd_header_type
+ header_type(self)
+ end
+
+ def snd_header_type=(v)
+ set_header_type(self, v)
+ end
+
+ def snd_comment
+ comment(self)
+ end
+
+ def snd_comment=(v)
+ set_comment(self, v)
+ end
+
+ def snd_srate
+ srate(self)
+ end
+
+ def snd_srate=(v)
+ set_srate(self, v)
+ end
+
+ def snd_channels
+ channels(self)
+ end
+
+ def snd_channels=(v)
+ set_channels(self, v)
+ end
+end
+
class With_sound
include Info
include WS
@@ -679,8 +803,9 @@ class With_sound
@channels = get_args(args, :channels, $clm_channels)
@srate = get_args(args, :srate, $clm_srate)
@header_type = get_args(args, :header_type, $clm_header_type)
- @data_format = get_args(args, :data_format, $clm_data_format)
- @audio_format = get_args(args, :audio_format, $clm_audio_format)
+ # for backward compatibility
+ @sample_type = get_args(args, :data_format, $clm_sample_type)
+ @sample_type = get_args(args, :sample_type, $clm_sample_type)
@out_buffer = get_args(args, :out_buffer, false)
@reverb = get_args(args, :reverb, $clm_reverb)
@@ -696,6 +821,7 @@ class With_sound
@continue = get_args(args, :continue_old_file, false)
@notehook = get_args(args, :notehook, $clm_notehook)
+ @dac_size = get_args(args, :dac_size, $clm_dac_size)
@save_body = get_args(args, :save_body, false)
@player = get_args(args, :player, $clm_player)
@@ -709,13 +835,12 @@ class With_sound
@offset = get_args(args, :offset, 0.0)
@rtime = @utime = @stime = 0.0
- @stat_frames = 0
- @stat_data_format = false
+ @stat_framples = 0
+ @stat_sample_type = false
@stat_header_type = false
@stat_comment = nil
@stat_maxamp = nil
@stat_revamp = nil
- @body = body
if @reverb and @revfile.null?
@revfile = make_reverb_file_name
end
@@ -738,8 +863,12 @@ class With_sound
if @reverb_channels.zero?
@reverb = $reverb = false
end
- unless string?(@comment) then @comment = make_default_comment end
- if @save_body and proc?(@body) then @comment << "\n" << @body.to_body end
+ unless string?(@comment)
+ @comment = make_default_comment
+ end
+ if @save_body and proc?(body)
+ @comment << "\n" << body.to_body
+ end
@old_srate = mus_srate
@old_update_interval = if defined? auto_update_interval
auto_update_interval
@@ -752,88 +881,105 @@ class With_sound
@out_snd = @rev_snd = false
@clm_instruments = Hash.new
@with_sound_note_hook = Hook.new("@with_sound_note_hook", 3, "\
-lambda do |inst_name, start, dur| ... end: called if an instrument has
+lambda do |inst_name, start, dur| ... end: called if an instrument has \
the run_instrument/run_reverb loop included.
-
-Every time an instrument starts computing, @with_sound_note_hook is
-called with the instrument name INST_NAME, the start time START, and
+Every time an instrument starts computing, @with_sound_note_hook is \
+called with the instrument name INST_NAME, the start time START, and \
the duration DUR.
-
def my_notehook(name, start, dur)
if name =~ /violin/
Snd.message(\"%s: start %1.3f, dur %1.3f\", name, start, dur)
end
end
-
with_sound(:notehook, :my_notehook) do
fm_violin(0, 1, 440, 0.1)
fbell = [0, 1, 2, 1.1, 25, 0.75, 75, 0.5, 100, 0.2]
abell = [0, 0, 0.1, 1, 10, 0.6, 25, 0.3, 50, 0.15, 90, 0.1, 100, 0]
fm_bell(0.5, 2.0, 220, 0.5, abell, fbell, 1)
end
-
installs the @with_sound_note_hook and prints the line
-
- `# fm_violin: start 0.000, dur 1.000'.")
+'# fm_violin: start 0.000, dur 1.000'.")
case @notehook
when Proc
- @with_sound_note_hook.add_hook!("with-sound-note-hook") do |name, start, dur|
+ @with_sound_note_hook.add_hook!("wsnh") do |name, start, dur|
@notehook.call(name, start, dur)
end
when Symbol, String
- @with_sound_note_hook.add_hook!("with-sound-note-hook") do |name, start, dur|
- snd_proc(@notehook, name, start, dur)
+ @with_sound_note_hook.add_hook!("wsnh") do |name, start, dur|
+ snd_func(@notehook, name, start, dur)
end
end
- set_help
+ self.description = get_help(:with_sound)
end
attr_reader :output, :out_snd, :with_sound_note_hook
alias help description
+
+ def inspect
+ s = self.to_s
+ unless @clm_instruments.empty?
+ s += "\n#<clm_instruments: "
+ @clm_instruments.sort do |a, b|
+ a[1][1] <=> b[1][1]
+ end.each do |k, v|
+ s += format("%s [%1.3f-%1.3f]\n", *v)
+ s += " " * 19
+ end
+ s.strip!
+ s += ">"
+ end
+ s
+ end
def to_s
- format("#<%s: output: %s, channels: %d, srate: %d%s>",
- self.class, @output.inspect, @channels, @srate.to_i,
- @reverb ? format(", reverb: %s, reverb-channels: %d", @reverb, @reverb_channels) : "")
+ if @reverb
+ s = format(", reverb: %s, reverb-channels: %d", @reverb, @reverb_channels)
+ else
+ s = ""
+ end
+ format("#<%s: output: %p, channels: %d, srate: %d%s>",
+ self.class, @output, @channels, @srate.to_i, s)
end
- alias inspect to_s
def describe
show_local_variables
end
def with_sound(*args, &body)
- com = format("%s#%s: temporary sound, args %s", self.class, get_func_name, args.inspect)
- ws = self.class.new(:output, get_args(args, :output, @output),
- :comment, get_args(args, :comment, com),
- :play, get_args(args, :play, false),
- :statistics, get_args(args, :statistics, false),
- :reverb, get_args(args, :reverb, false),
- :reverb_data, get_args(args, :reverb_data, @reverb_data),
- :reverb_file_name, get_args(args, :reverb_file_name, @revfile),
- :reverb_channels, get_args(args, :reverb_channels, @reverb_channels),
- :delete_reverb, get_args(args, :delete_reverb, @delete_reverb),
- :decay_time, get_args(args, :decay_time, @decay_time),
- :continue_old_file, get_args(args, :continue_old_file, @continue),
- :out_buffer, get_args(args, :out_buffer, @out_buffer),
- :rev_buffer, get_args(args, :rev_buffer, @rev_buffer),
- :scaled_to, get_args(args, :scaled_to, @scaled_to),
- :scaled_by, get_args(args, :scaled_by, @scaled_by),
- :notehook, get_args(args, :notehook, @notehook),
- :save_body, get_args(args, :save_body, @save_body),
- :channels, get_args(args, :channels, @channels),
- :srate, get_args(args, :srate, @srate),
- :header_type, get_args(args, :header_type, @header_type),
- :data_format, get_args(args, :data_format, @data_format),
- :audio_format, get_args(args, :audio_format, @audio_format),
- :verbose, get_args(args, :verbose, @verbose),
- :info, get_args(args, :info, @info),
- :clipped, get_args(args, :clipped, @clipped),
- :offset, get_args(args, :offset, 0.0),
- &body)
- ws.run
+ com = format("%s#%s: temporary sound, args %p",
+ self.class, get_func_name, args)
+ ws = self.class.new(:output, get_args(args, :output, @output),
+ :comment, get_args(args, :comment, com),
+ :play, get_args(args, :play, false),
+ :statistics, get_args(args, :statistics, false),
+ :reverb, get_args(args, :reverb, false),
+ :reverb_data, get_args(args,
+ :reverb_data, @reverb_data),
+ :reverb_file_name, get_args(args, :reverb_file_name, @revfile),
+ :reverb_channels, get_args(args, :reverb_channels, @reverb_channels),
+ :delete_reverb, get_args(args, :delete_reverb, @delete_reverb),
+ :decay_time, get_args(args, :decay_time, @decay_time),
+ :continue_old_file, get_args(args, :continue_old_file, @continue),
+ :out_buffer, get_args(args, :out_buffer, @out_buffer),
+ :rev_buffer, get_args(args, :rev_buffer, @rev_buffer),
+ :scaled_to, get_args(args, :scaled_to, @scaled_to),
+ :scaled_by, get_args(args, :scaled_by, @scaled_by),
+ :notehook, get_args(args, :notehook, @notehook),
+ :save_body, get_args(args, :save_body, @save_body),
+ :channels, get_args(args, :channels, @channels),
+ :srate, get_args(args, :srate, @srate),
+ :header_type, get_args(args, :header_type, @header_type),
+ # for backward compatibility
+ :sample_type, get_args(args, :data_format, @sample_type),
+ :sample_type, get_args(args, :sample_type, @sample_type),
+ :verbose, get_args(args, :verbose, @verbose),
+ :info, get_args(args, :info, @info),
+ :clipped, get_args(args, :clipped, @clipped),
+ :offset, get_args(args, :offset, 0.0),
+ &body)
+ ws.run(&body)
ws
end
-
+
def with_current_sound(*args, &body)
output, offset, scaled_to, scaled_by = nil
optkey(args, binding,
@@ -892,85 +1038,85 @@ installs the @with_sound_note_hook and prints the line
def with_mix(*args)
body_str = args.pop
assert_type(string?(body_str), body_str, 0, "a string (body string)")
- start = if number?(args[-1])
- args.pop
- else
- 0
- end
+ start = 0
+ if number?(args[-1])
+ start = args.pop
+ end
fname = args.pop
assert_type(string?(fname), fname, 0, "a string (filename)")
out_file = fname + ".snd"
rbm_file = fname + ".rbm"
- snd_time = if File.exists?(out_file)
- File.mtime(out_file)
- else
- :load
- end
- old_body = if File.exists?(rbm_file)
- File.open(rbm_file).read
- else
- ""
- end
- rbm_time = if old_body == body_str
- File.mtime(rbm_file)
- else
- File.open(rbm_file, "w") do |f| f << body_str end
- :load
- end
+ snd_time = :load
+ if File.exist?(out_file)
+ snd_time = File.mtime(out_file)
+ end
+ old_body = ""
+ if File.exist?(rbm_file)
+ old_body = File.open(rbm_file).read
+ end
+ rbm_time = :load
+ if old_body == body_str
+ rbm_time = File.mtime(rbm_file)
+ else
+ File.open(rbm_file, "w") do |f|
+ f << body_str
+ end
+ rbm_file = :load
+ end
if snd_time == :load or rbm_time == :load or snd_time < rbm_time
- if @verbose then Snd.message("mix remake %s at %1.3f", out_file, start) end
+ if @verbose
+ Snd.message("mix remake %s at %1.3f", out_file, start)
+ end
comm = format("# written %s (Snd: %s)\n", Time.now, snd_version)
comm += format("[%s, %s]\n", args.to_s.inspect, body_str.inspect)
self.with_sound(:output, out_file, :comment, comm, *args) do
- eval(File.open(rbm_file).read, nil, format("(with_mix_load %s)", rbm_file), 1)
+ eval(File.open(rbm_file).read,
+ nil,
+ format("(with_mix_load %s)", rbm_file),
+ 1)
end
else
- if @verbose then Snd.message("mix %s at %1.3f", out_file, start) end
+ if @verbose
+ Snd.message("mix %s at %1.3f", out_file, start)
+ end
end
clm_mix(out_file, :output_frame, seconds2samples(start))
end
- def with_sound_info(name, start, dur, environ = binding)
- @clm_instruments.store(environ, [name, start, dur])
- if @info then Snd.message("%s: start %1.3f, dur %1.3f", name, start, dur) end
- if @notehook then @with_sound_note_hook.call(name, start, dur) end
+ def with_sound_info(name, start, dur, body = binding)
+ @clm_instruments.store(body, [name, start, dur])
+ if @info and (not @notehook)
+ Snd.message("%s: start %1.3f, dur %1.3f", name, start, dur)
+ end
+ if @notehook
+ @with_sound_note_hook.call(name, start, dur)
+ end
end
- def run_instrument(start, dur, *locsig_args, &environ)
+ def run_instrument(start, dur, body)
@start_frame = seconds2samples(start + @offset)
- with_sound_info(get_func_name(3), start, dur, environ)
+ with_sound_info(get_func_name(3), start, dur, body)
end
- # case chan
- # when Integer
- # # jc_reverb_rb, jl_reverb_rb, nrev_rb
- # body.call(sample_of_CHAN, current_sample_number)
- # when :frames
- # # freeverb_rb
- # body.call(frame_of_reverb_file, current_sample_number)
- # end
- def run_reverb(chan, &environ)
+ # Handles only the first channel of a reverb file.
+ # body.call(sample, current_sample_index) => vct of @channels' length
+ def run_reverb(&body)
name = get_func_name(3)
- dur = samples2seconds(@ws_reverb.length)
- if @clm then dur += @decay_time end
- with_sound_info("reverb " + name, 0, dur, environ)
+ dur = samples2seconds(@ws_reverb.length) + @decay_time
+ with_sound_info("reverb " + name, 0, dur, body)
if @verbose
- Snd.message("%s on %d in and %d out channels", name, @reverb_channels, @channels)
- end
- unless chan.kind_of?(Symbol)
- unless chan.between?(0, @reverb_channels - 1)
- Snd.raise(:out_of_range, chan, @reverb_channels, "reverb channel is out of range")
- end
+ Snd.message("%s on %d in and %d out channels",
+ name, @reverb_channels, @channels)
end
end
def run(&body)
- @body ||= body
set_mus_file_buffer_size($clm_file_buffer_size)
set_mus_array_print_length($clm_array_print_length)
if @clipped == :undefined
if (@scaled_by or @scaled_to) and
- [Mus_bfloat, Mus_lfloat, Mus_bdouble, Mus_ldouble].member?(@data_format)
+ [Mus_bfloat, Mus_lfloat,
+ Mus_bdouble, Mus_ldouble].member?(@sample_type)
set_mus_clipping(false)
else
set_mus_clipping($clm_clipped)
@@ -978,31 +1124,38 @@ installs the @with_sound_note_hook and prints the line
else
set_mus_clipping(@clipped)
end
- if defined? set_auto_update_interval then set_auto_update_interval(0.0) end
+ if defined? set_auto_update_interval
+ set_auto_update_interval(0.0)
+ end
before_output
- frm1 = ws_frame_location
+ frm1 = ws_frample_location
init_process_time
- run_body
+ run_body(&body)
after_output
stop_process_time
old_sync = false
if provided? :snd
if sound?(snd = find_sound(@output))
old_sync = sync(snd)
- @out_snd = update_sound(snd)
+ @out_snd = snd.update
else
- @out_snd = if @header_type == Mus_raw
- open_raw_sound(@output, @channels, @srate.to_i, @data_format)
- else
- open_sound(@output)
- end
+ if @header_type == Mus_raw
+ @out_snd = open_raw_sound(@output, @channels,
+ @srate.to_i, @sample_type)
+ else
+ @out_snd = open_sound(@output)
+ end
end
set_sync(true, @out_snd)
end
set_statistics
- frm2 = ws_frame_location
- if @scaled_to then scaled_to_sound(frm1, frm2 - frm1) end
- if @scaled_by then scaled_by_sound(frm1, frm2 - frm1) end
+ frm2 = ws_frample_location
+ if @scaled_to
+ scaled_to_sound(frm1, frm2 - frm1)
+ end
+ if @scaled_by
+ scaled_by_sound(frm1, frm2 - frm1)
+ end
if provided? :snd
if sound?(snd = find_sound(@output))
if old_sync
@@ -1012,8 +1165,12 @@ installs the @with_sound_note_hook and prints the line
end
end
finish_sound
- if @statistics then statistics end
- 1.upto(@play) do play_it end
+ if @statistics
+ statistics
+ end
+ 1.upto(@play) do
+ play_it
+ end
end
protected
@@ -1030,10 +1187,8 @@ installs the @with_sound_note_hook and prints the line
# ArgumentError: wrong number of arguments (1 for 0)
# if BODY: Proc.new do | | ... end
# okay (Proc ignores arity)
- #
- # tomorrow?
- def run_body
- instance_eval(&@body)
+ def run_body(&body)
+ instance_eval(&body)
rescue Interrupt, ScriptError, NameError, StandardError
finish_sound
show_local_variables
@@ -1082,9 +1237,12 @@ installs the @with_sound_note_hook and prints the line
end
def make_reverb_file_name
- path = File.split(@output).first
- file = File.basename(@output, ".*") + ".reverb"
- unless path == "." then file = path + "/" + file end
+ s = string?(@output) ? @output : @output.class.to_s
+ path = File.split(s).first
+ file = File.basename(s, ".*") + ".reverb"
+ unless path == "."
+ file = path + "/" + file
+ end
file
end
@@ -1106,7 +1264,7 @@ installs the @with_sound_note_hook and prints the line
set_mus_srate(@srate)
end
- def ws_frame_location
+ def ws_frample_location
end
def scaled_to_sound(from, to)
@@ -1116,25 +1274,26 @@ installs the @with_sound_note_hook and prints the line
end
def statistics
- obj_name = case @ws_output
- when Mus, Vct, SoundData
- " (" + @ws_output.name + ")"
- else
- ""
- end
- Snd.message("filename: %s%s", @output.inspect, obj_name)
+ if string?(@ws_output)
+ obj_name = ""
+ else
+ obj_name = " (" + @ws_output.name + ")"
+ end
+ Snd.message("filename: %p%s", @output, obj_name)
Snd.message(" chans: %d, srate: %d", @channels, @srate.to_i)
- if @stat_data_format and @stat_header_type
+ if @stat_sample_type and @stat_header_type
Snd.message(" format: %s [%s]",
- mus_data_format_name(@stat_data_format),
+ mus_sample_type_name(@stat_sample_type),
mus_header_type_name(@stat_header_type))
end
- if @stat_frames > 0
- Snd.message(" length: %1.3f (%d frames)", @stat_frames / @srate.to_f, @stat_frames)
+ if @stat_framples > 0
+ Snd.message(" length: %1.3f (%d frames)",
+ @stat_framples / @srate.to_f, @stat_framples)
end
- Snd.message(" real: %1.3f (utime %1.3f, stime %1.3f)", @rtime, @utime, @stime)
- if @stat_frames > 1
- rt = (@srate.to_f / @stat_frames)
+ Snd.message(" real: %1.3f (utime %1.3f, stime %1.3f)",
+ @rtime, @utime, @stime)
+ if @stat_framples > 1
+ rt = (@srate.to_f / @stat_framples)
Snd.message(" ratio: %1.2f (uratio %1.2f)", @rtime * rt, @utime * rt)
end
ws_maxamp_statistics
@@ -1144,10 +1303,12 @@ installs the @with_sound_note_hook and prints the line
end
def finish_sound
- if defined? set_auto_update_interval then set_auto_update_interval(@old_update_interval) end
+ if defined? set_auto_update_interval
+ set_auto_update_interval(@old_update_interval)
+ end
@reverb and @delete_reverb and (not @continue) and remove_file(@revfile)
set_mus_srate(@old_srate)
- @stat_frames = ws_frame_location
+ @stat_framples = ws_frample_location
end
def play_it
@@ -1173,61 +1334,12 @@ installs the @with_sound_note_hook and prints the line
end
end
end
-
- def set_help
- self.description = format("\
-# with_sound(*args) do ... end
-#
-# :output $clm_file_name (#{$clm_file_name.inspect})
-# :channels $clm_channels (#$clm_channels)
-# :srate $clm_srate (#$clm_srate)
-# :header_type $clm_header_type (#$clm_header_type)
-# :data_format $clm_data_format (#$clm_data_format)
-# :audio_format $clm_audio_format (#$clm_audio_format)
-# :out_buffer nil (vct or sound-data object)
-#
-# :reverb $clm_reverb (#{$clm_reverb.inspect})
-# :reverb_data $clm_reverb_data (#{$clm_reverb_data.inspect})
-# :reverb_channels $clm_reverb_channels (#$clm_reverb_channels)
-# :revfile $clm_reverb_file_name (#{$clm_reverb_file_name.inspect})
-# :delete_reverb $clm_delete_reverb (#$clm_delete_reverb)
-# :rev_buffer nil (vct or sound-data object)
-#
-# :decay_time $clm_decay_time (#{$clm_decay_time})
-# :scaled_to false
-# :scaled_by false
-# :continue_old_file false
-# :notehook $clm_notehook (#{$clm_notehook.inspect})
-#
-# :play $clm_play (#$clm_play)
-# :statistics $clm_statistics (#$clm_statistics)
-# :comment $clm_comment (#{$clm_comment.inspect})
-# :locsig_type $clm_locsig_type (#{$clm_locsig_type})
-# :verbose $clm_verbose (#$clm_verbose)
-#
-## next option works only with newer Ruby versions
-## save the with_sound-body in sound file's comment
-# :save_body false
-#
-## if an instrument uses run_instrument/run_reverb and INFO is true, a
-## message will be printed: `instrument_name: start 0.000, dur 0.000'
-# :info $clm_info (#$clm_info)
-# :clipped $clm_clipped (#$clm_clipped)
-#
-# :player $clm_player (#{$clm_player.inspect})
-#
-## special with_dac options:
-# :bufsize $clm_rt_bufsize (#$clm_rt_bufsize)
-# :device $clm_output_device (#$clm_output_device)
-#
-# Usage: with_sound(:play, 1, :statistics, true) do fm_violin end")
- end
end
class Instrument < With_sound
# Actually it isn't necessary to define instruments as methods of
# class Instrument.
- def my_simp(start = 0, dur = 1, freq = 440, amp = 0.5, amp_env = [0, 1, 1, 1])
+ def ws_simp(start = 0, dur = 1, freq = 440, amp = 0.5, amp_env = [0, 1, 1, 1])
os = make_sum_of_cosines(:frequency, freq, :cosines, 3)
en = make_env(:envelope, amp_env, :scaler, amp, :duration, dur)
fs = hz2radians(freq)
@@ -1239,7 +1351,8 @@ class Instrument < With_sound
end
# simple violin, see snd/fm.html
- def fm_v(start = 0, dur = 1, freq = 440, amp = 0.5, fm_index = 1, amp_env = [0, 1, 1, 1])
+ def ws_violin(start = 0, dur = 1, freq = 440, amp = 0.5,
+ fm_index = 1, amp_env = [0, 1, 1, 1])
frq_scl = hz2radians(freq)
maxdev = frq_scl * fm_index
index1 = maxdev * (5.0 / log(freq))
@@ -1250,84 +1363,88 @@ class Instrument < With_sound
fmosc2 = make_oscil(:frequency, freq * 3.0)
fmosc3 = make_oscil(:frequency, freq * 4.0)
ampf = make_env(:envelope, amp_env, :scaler, amp, :duration, dur)
- indf1 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0], :scaler, index1, :duration, dur)
- indf2 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0], :scaler, index2, :duration, dur)
- indf3 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0], :scaler, index3, :duration, dur)
+ indf1 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0],
+ :scaler, index1, :duration, dur)
+ indf2 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0],
+ :scaler, index2, :duration, dur)
+ indf3 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0],
+ :scaler, index3, :duration, dur)
pervib = make_triangle_wave(:frequency, 0.5, :amplitude, 0.0025 * frq_scl)
ranvib = make_rand_interp(:frequency, 16.0, :amplitude, 0.005 * frq_scl)
run_instrument(start, dur) do
vib = triangle_wave(pervib) + rand_interp(ranvib)
- env(ampf) * oscil(carrier,
- vib + \
- env(indf1) * oscil(fmosc1, vib) + \
- env(indf2) * oscil(fmosc2, 3.0 * vib) + \
- env(indf3) * oscil(fmosc3, 4.0 * vib))
+ env(ampf) *
+ oscil(carrier,
+ vib +
+ env(indf1) * oscil(fmosc1, vib) +
+ env(indf2) * oscil(fmosc2, 3.0 * vib) +
+ env(indf3) * oscil(fmosc3, 4.0 * vib))
end
end
+ alias violin ws_violin
end
# WSChannel2Vct and WSSampler are helper classes used by class
# Snd_Instrument. sampler has no possibility to set location
# (and direction) which is needed by instrument grani (clm-ins.rb).
-if provided? :snd
- class WSChannel2Vct
- # (channel->vct (beg 0) (dur len) (snd #f) (chn #f) (edpos #f))
- def initialize(snd = false, chn = false, start = 0, dir = 1)
- @vct = channel2vct(0, frames(snd, chn), snd, chn, false)
- @location = ((dir > 0) ? (start - 1) : (start + 1))
- @start = start
- @direction = dir
- @snd = snd
- @chn = chn
- @last_location = @vct.length - 1
- end
- attr_accessor :direction
-
- def inspect
- format("%s.new(%s, %s, %s, %s)", self.class, @snd.inspect, @chn.inspect, @start, @direction)
- end
-
- def to_s
- format("#<%s snd: %s, chn: %s, location: %d, direction: %d, vct: %s>",
- self.class, @snd.inspect, @chn.inspect, location, @direction, @vct.inspect)
- end
-
- def next
- if @direction > 0
- if @location < @last_location
- @location += 1
- @vct[@location]
- else
- 0.0
- end
+class WSChannel2Vct
+ # (channel->vct (beg 0) (dur len) (snd #f) (chn #f) (edpos #f))
+ def initialize(snd = false, chn = false, start = 0, dir = 1)
+ @vct = channel2vct(0, framples(snd, chn), snd, chn, false)
+ @location = ((dir > 0) ? (start - 1) : (start + 1))
+ @start = start
+ @direction = dir
+ @snd = snd
+ @chn = chn
+ @last_location = @vct.length - 1
+ end
+ attr_accessor :direction
+
+ def inspect
+ format("%s.new(%p, %p, %s, %s)",
+ self.class, @snd, @chn, @start, @direction)
+ end
+
+ def to_s
+ format("#<%s snd: %p, chn: %p, location: %d, direction: %d, vct: %p>",
+ self.class, @snd, @chn, location, @direction, @vct)
+ end
+
+ def next
+ if @direction > 0
+ if @location < @last_location
+ @location += 1
+ @vct[@location]
else
- if @location > 0
- @location -= 1
- @vct[@location]
- else
- 0.0
- end
+ 0.0
end
- end
-
- def close
- # not needed
- end
-
- def location
- if @direction > 0
- @location + 1
+ else
+ if @location > 0
+ @location -= 1
+ @vct[@location]
else
- @location - 1
+ 0.0
end
end
+ end
+
+ def close
+ # not needed
+ end
+
+ def location
+ if @direction > 0
+ @location + 1
+ else
+ @location - 1
+ end
+ end
- def location=(val)
- if @direction > 0
- @location = val - 1
- else
- @location = val + 1
- end
+ def location=(v)
+ if @direction > 0
+ @location = v - 1
+ else
+ @location = v + 1
end
end
end
@@ -1345,7 +1462,8 @@ class WSSampler
attr_accessor :direction
def inspect
- format("%s.new(%s, %s, %s, %s)", self.class, @snd.inspect, @chn.inspect, @start, @direction)
+ format("%s.new(%s, %s, %s, %s)",
+ self.class, @snd.inspect, @chn.inspect, @start, @direction)
end
def to_s
@@ -1367,7 +1485,7 @@ class WSSampler
sampler_position(@reader)
end
- def location=(val)
+ def location=(v)
# sampler_position isn't settable
end
end
@@ -1375,25 +1493,6 @@ end
class Snd_Instrument < Instrument
# place holder for special Snd instruments, see FULLMIX in
# clm-ins.rb.
-
- def get_snd(file)
- snd = if integer?(file)
- integer2sound(file)
- elsif string?(file)
- if sound?(s = find_sound(file))
- s
- else
- open_sound(file)
- end
- end
- if sound?(snd)
- snd
- else
- Snd.snd(snd)
- end
- end
- private :get_snd
-
def make_ws_reader(file, *args)
start, channel, direction = nil
optkey(args, binding,
@@ -1420,16 +1519,16 @@ class Snd_Instrument < Instrument
rd.location
end
- def set_ws_location(rd, val)
- rd.location = val.to_i
+ def set_ws_location(rd, v)
+ rd.location = v.to_i
end
def ws_increment(rd)
rd.direction
end
- def set_ws_increment(rd, val)
- rd.direction = val.to_i
+ def set_ws_increment(rd, v)
+ rd.direction = v.to_i
end
def ws_srate(file)
@@ -1442,7 +1541,25 @@ class Snd_Instrument < Instrument
def ws_duration(file)
snd = get_snd(file)
- frames(snd) / srate(snd).to_f
+ framples(snd) / srate(snd).to_f
+ end
+
+ private
+ def get_snd(file)
+ snd = if integer?(file)
+ integer2sound(file)
+ elsif string?(file)
+ if sound?(s = find_sound(file))
+ s
+ else
+ open_sound(file)
+ end
+ end
+ if sound?(snd)
+ snd
+ else
+ Snd.snd(snd)
+ end
end
end
@@ -1457,7 +1574,8 @@ class CLM_Instrument < Instrument
[:start, 0],
[:channel, 0],
[:direction, 1])
- make_readin(:file, file, :channel, channel, :start, start, :direction, direction)
+ make_readin(:file, file, :channel, channel,
+ :start, start, :direction, direction)
end
# (readin gen)
@@ -1473,16 +1591,16 @@ class CLM_Instrument < Instrument
mus_location(rd)
end
- def set_ws_location(rd, val)
- set_mus_location(rd, val)
+ def set_ws_location(rd, v)
+ set_mus_location(rd, v)
end
def ws_increment(rd)
mus_increment(rd)
end
- def set_ws_increment(rd, val)
- set_mus_increment(rd, val)
+ def set_ws_increment(rd, v)
+ set_mus_increment(rd, v)
end
def ws_srate(file)
@@ -1499,229 +1617,199 @@ class CLM_Instrument < Instrument
end
class With_Snd < Snd_Instrument
- def initialize(*args)
- @clm = false
- super
+ def run_instrument(start, dur, *locsig_args, &body)
+ super(start, dur, body)
+ # locsig and Vct as :output and :revout handles only 1 channel.
+ if @channels == 1 and @reverb_channels < 2
+ run_inst_with_locsig(start, dur, *locsig_args, &body)
+ else
+ run_inst_with_map(start, dur, *locsig_args, &body)
+ end
end
- def run_instrument(start, dur, *locsig_args)
- super
- degree, distance, reverb_amount = nil
- optkey(locsig_args, binding,
- [:degree, random(90.0)],
- [:distance, 1.0],
- [:reverb_amount, 0.05])
- out = if vct?(@out_buffer) or sound_data?(@out_buffer)
- @out_buffer.fill(0.0)
- @out_buffer
- else
- len = seconds2samples(dur)
- if @channels == 1
- Vct.new(len, 0.0)
- else
- SoundData.new(@channels, len)
- end
- end
- rev = if @reverb
- if vct?(@rev_buffer) or sound_data?(@rev_buffer)
- @rev_buffer.fill(0.0)
- @rev_buffer
- else
- len = seconds2samples(dur + @decay_time)
- if @reverb_channels == 1
- Vct.new(len, 0.0)
- else
- SoundData.new(@reverb_channels, len)
- end
- end
- else
- false
- end
- loc = make_locsig(:degree, degree,
- :distance, distance,
- :reverb, reverb_amount,
- :output, out,
- :revout, rev,
- :channels, @channels,
- :type, @locsig_type)
- out.length.times do |samp|
- locsig(loc, samp, yield(@start_frame + samp))
- end
- @channels.times do |chn|
- mix_vct(out.to_vct(chn), @start_frame, @out_snd, chn, false)
- end
- if @reverb
- @reverb_channels.times do |chn|
- mix_vct(rev.to_vct(chn), @start_frame, @rev_snd, chn, false)
- end
+ def run_reverb(&body)
+ super(&body)
+ # run_reverb handles only one reverb channel
+ vo = channel2vct(0, false, @rev_snd, 0, false)
+ vl = vo.length + seconds2samples(@decay_time)
+ vr = Array.new(@channels) do
+ Vct.new(vl, 0.0)
end
- end
-
- def run_reverb(chan = 0)
- super
- rev_out = SoundData.new(@reverb_channels, @ws_reverb.length)
- case chan
- when Integer
- case @ws_reverb
- when Vct
- rev_out.length.times do |i|
- sound_data_frame_set!(rev_out, i, body.call(@ws_reverb[i], i))
- end
- when SoundData
- rev_out.length.times do |i|
- sound_data_frame_set!(rev_out, i, body.call(@ws_reverb[chan, i], i))
- end
- end
- when :frames
- case @ws_reverb
- when Vct
- frm = make_frame(1)
- rev_out.length.times do |i|
- frame_set!(frm, 0, @ws_reverb[i])
- sound_data_frame_set!(rev_out, i, body.call(frm, i))
- end
- when SoundData
- frm = make_frame(@reverb_channels)
- rev_out.length.times do |i|
- @ws_reverb.chans.times do |chn| frame_set!(frm, chn, @ws_reverb[chn, i]) end
- sound_data_frame_set!(rev_out, i, body.call(frm, i))
- end
+ vo.each_with_index do |s, i|
+ fr = body.call(s, i)
+ @channels.times do |chn|
+ vr[chn][i] = fr[chn]
end
end
- if @channels == @reverb_channels
- @channels.times do |chn| mix_vct(rev_out.to_vct(chn), 0, @out_snd, chn, false) end
- else
- v = rev_out.to_vct
- @channels.times do |chn| mix_vct(v, 0, @out_snd, chn, false) end
+ origin = format("%s(&body", get_func_name)
+ @channels.times do |chn|
+ mix_vct(vr[chn], 0, @out_snd, chn, false, origin)
end
- rev_out = false
- @ws_reverb = false
end
-
- add_help(:clm_mix, "clm_mix(filename, *args)
- :input_frame = 0
+
+ add_help(:clm_mix,
+ "clm_mix(infile, *args)
+ :output = false
:output_frame = 0
- :frames = mus_sound_frames(filename)
- :scale = 1.0
+ :frames = framples(infile)
+ :input_frame = 0
+ :scaler = false
Example: clm_mix(\"tmp\")")
- def clm_mix(filename, *args)
- input_frame, output_frame, frames, scale = nil
+ def clm_mix(infile, *args)
+ output, output_frame, frames, input_frame, scaler = nil
optkey(args, binding,
- [:input_frame, 0],
+ [:output, false],
[:output_frame, 0],
- [:frames, mus_sound_frames(filename)],
- [:scale, 1.0])
- unless sound?(snd = find_sound(filename))
- unless snd = open_sound(filename)
- Snd.raise(:no_such_file, filename, "file name required")
+ [:frames, framples(infile)],
+ [:input_frame, 0],
+ [:scaler, false])
+ unless sound?(snd = find_sound(infile))
+ unless snd = open_sound(infile)
+ Snd.raise(:no_such_file, infile, "file name required")
end
end
+ # to silence "warning: assigned but unused variable - output"
+ output = "not_used"
[channels(snd), @channels].min.times do |chn|
- if scale.nonzero?
- scale_channel(scale, input_frame, frames, snd, chn)
+ if scaler and scaler.nonzero?
+ scale_channel(scaler, input_frame, frames, snd, chn)
end
- mix_vct(channel2vct(input_frame, frames, snd, chn), output_frame, snd, chn, false)
+ mix_vct(channel2vct(input_frame, frames, snd, chn),
+ output_frame, snd, chn, false)
end
- revert_sound(snd)
+ snd.revert
close_sound_extend(snd)
end
- def with_reverb(reverb_amount)
- snd = Snd.snd
- @channels = channels(snd)
- set_mus_srate(@srate)
- len = frames(snd)
- @start_frame = 0
- if sound?(rsnd = find_sound(@revfile))
- close_sound_extend(rsnd)
- remove_file(@revfile)
- rsnd = new_sound(@revfile, @header_type, @data_format, @srate.to_i, @reverb_channels)
- else
- rsnd = new_sound(@revfile, @header_type, @data_format, @srate.to_i, @reverb_channels)
+ protected
+ def run_inst_with_locsig(start, dur, *locsig_args, &body)
+ degree, distance, reverb_amount = nil
+ optkey(locsig_args, binding,
+ [:degree, random(90.0)],
+ [:distance, 1.0],
+ [:reverb_amount, 0.05])
+ vo = Vct.new(seconds2samples(dur), 0.0)
+ vr = @reverb ? Vct.new(seconds2samples(dur), 0.0) : false
+ @locsig = make_locsig(:degree, degree,
+ :distance, distance,
+ :reverb, reverb_amount,
+ :output, vo,
+ :revout, vr,
+ :channels, @channels,
+ :type, @locsig_type)
+ vo.length.times do |i|
+ locsig(@locsig, i, body.call(@start_frame + i))
end
- @out_snd = snd
- @rev_snd = rsnd
- @ws_reverb = SoundData.new(@reverb_channels, len)
- init_process_time
- @reverb_channels.times do |chn|
- channel2vct(0, len, @out_snd, chn).scale(reverb_amount).to_sound_data(@ws_reverb, chn)
+ origin = format("run_instrument(%s, %s, %s, &body",
+ start, dur,
+ locsig_args.to_s[1..-2]) # get rid of '[' and ']'
+ mix_vct(vo, @start_frame, @out_snd, 0, false, origin)
+ if @reverb
+ mix_vct(vr, @start_frame, @rev_snd, 0, false, origin)
+ end
+ end
+
+ def run_inst_with_map(start, dur, *locsig_args, &body)
+ origin = format("run_instrument(%s, %s, %s, &body",
+ start, dur,
+ locsig_args.to_s[1..-2])
+ vo = Vct.new(seconds2samples(dur)) do |i|
+ body.call(@start_frame + i)
+ end
+ @channels.times do |chn|
+ mix_vct(vo, @start_frame, @out_snd, chn, false, origin)
+ end
+ if @reverb
+ ra = get_args(locsig_args, :reverb_amount, 0.05)
+ vr = vo.scale(ra)
+ @reverb_channels.times do |chn|
+ mix_vct(vr, @start_frame, @rev_snd, chn, false, origin)
+ end
end
- after_output
- stop_process_time
- finish_sound
- 1.upto(@play) do play_it end
end
- protected
def before_output
super
snd = rsnd = false
sr = mus_srate.to_i
+ snd = find_sound(@output)
if sound?(snd = find_sound(@output))
if @continue
- @srate = set_mus_srate(srate(snd))
+ @srate = set_mus_srate(snd.snd_srate)
else
- set_header_type(snd, @header_type)
- set_data_format(snd, @data_format)
- set_srate(snd, sr)
- set_channels(snd, @channels)
- set_comment(snd, @comment)
- channels(snd).times do |chn| set_frames(1, snd, chn) end
- snd = update_sound(snd)
+ snd.snd_header_type = @header_type
+ snd.snd_sample_type = @sample_type
+ snd.snd_srate = sr
+ snd.snd_channels = @channels
+ snd.snd_comment = @comment
+ snd.snd_channels.times do |chn|
+ set_framples(1, snd, chn)
+ end
+ snd.save
+ snd = snd.update
end
else
- unless @continue then remove_file(@output) end
- snd = new_sound(@output, @header_type, @data_format, sr, @channels, @comment)
+ unless @continue
+ remove_file(@output)
+ end
+ snd = new_sound(@output, @channels, sr,
+ @sample_type, @header_type, @comment)
end
if @reverb
if sound?(rsnd = find_sound(@revfile)) and (not @continue)
- set_header_type(@header_type, rsnd)
- set_data_format(@data_format, rsnd)
- set_srate(sr, rsnd)
- set_channels(@reverb_channels, rsnd)
- set_frames(1, rsnd)
- update_sound(rsnd)
+ rsnd.snd_header_type = @header_type
+ rsnd.snd_sample_type = @sample_type
+ rsnd.snd_srate = sr
+ rsnd.snd_channels = @reverb_channels
+ rsnd.snd_channels.times do |chn|
+ set_framples(1, rsnd, chn)
+ end
+ rsnd.save
+ rsnd = rsnd.update
else
unless @continue
remove_file(@revfile)
end
- rsnd = new_sound(@revfile, @header_type, @data_format, sr, @reverb_channels)
+ rsnd = new_sound(@revfile, @reverb_channels, sr,
+ @sample_type, @header_type)
end
end
- $output = @out_snd = snd
- $reverb = @rev_snd = rsnd
+ $output = @ws_output = @out_snd = snd
+ $reverb = @ws_reverb = @rev_snd = rsnd
end
def after_output
@reverb and run_reverb_body
+ @out_snd.save
end
- def ws_frame_location
- frames(@out_snd)
+ def ws_frample_location
+ @out_snd.length
end
def scaled_to_sound(beg, len)
+ scl = @scaled_to / maxamp(@out_snd, true).max
@channels.times do |chn|
- scale_channel(@scaled_to / maxamp(@out_snd, true).max, beg, len, @out_snd, chn)
+ scale_channel(scl, beg, len, @out_snd, chn)
end
- save_sound(@out_snd)
+ @out_snd.save
end
def scaled_by_sound(beg, len)
@channels.times do |chn|
scale_channel(@scaled_by, beg, len, @out_snd, chn)
end
- save_sound(@out_snd)
+ @out_snd.save
end
def set_statistics
- @stat_frames = frames(@out_snd)
- @stat_data_format = data_format(@out_snd)
- @stat_header_type = header_type(@out_snd)
- @stat_comment = comment(@out_snd)
- @stat_maxamp = maxamp(@out_snd, true)
+ @stat_framples = @out_snd.length
+ @stat_sample_type = @out_snd.snd_sample_type
+ @stat_header_type = @out_snd.snd_header_type
+ @stat_comment = @out_snd.snd_comment
+ @stat_maxamp = @out_snd.snd_maxamp(true)
if @reverb
- @stat_revamp = maxamp(@rev_snd, true)
+ @stat_revamp = @rev_snd.snd_maxamp(true)
end
end
@@ -1738,8 +1826,8 @@ Example: clm_mix(\"tmp\")")
# returns new snd index
# see clm-ins.rb, run_fullmix
def with_closed_sound(snd, &body)
- snd_name = file_name(snd)
- update_sound(snd)
+ snd_name = snd.file_name
+ snd = snd.update
close_sound_extend(snd)
body.call(snd_name)
open_sound(snd_name)
@@ -1747,60 +1835,72 @@ Example: clm_mix(\"tmp\")")
end
class With_CLM < CLM_Instrument
- def initialize(*args)
- @clm = true
- super
- end
-
- def run_instrument(start, dur, *locsig_args)
- super
+ def run_instrument(start, dur, *locsig_args, &body)
+ super(start, dur, body)
degree, distance, reverb_amount = nil
optkey(locsig_args, binding,
[:degree, random(90.0)],
[:distance, 1.0],
[:reverb_amount, 0.05])
- loc = make_locsig(:degree, degree,
- :distance, distance,
- :reverb, reverb_amount,
- :output, @ws_output,
- :revout, @ws_reverb,
- :channels, @channels,
- :type, @locsig_type)
- @start_frame.upto((@start_frame + seconds2samples(dur)) - 1) do |samp|
- locsig(loc, samp, yield(samp))
+ @locsig = make_locsig(:degree, degree,
+ :distance, distance,
+ :reverb, reverb_amount,
+ :output, @ws_output,
+ :revout, @ws_reverb,
+ :channels, @channels,
+ :type, @locsig_type)
+ @start_frame.upto((@start_frame + seconds2samples(dur)) - 1) do |i|
+ locsig(@locsig, i, body.call(i))
end
end
- def run_reverb(chan = 0)
- super
- case chan
- when Integer
- (@ws_reverb.length + seconds2samples(@decay_time)).times do |samp|
- frame2file(@ws_output, samp, yield(file2sample(@ws_reverb, samp, chan), samp))
- end
- when :frames
- frm = make_frame(@reverb_channels)
- (@ws_reverb.length + seconds2samples(@decay_time)).times do |samp|
- frame2file(@ws_output, samp, yield(file2frame(@ws_reverb, samp, frm), samp))
- end
+ def run_reverb(&body)
+ super(&body)
+ (@ws_reverb.length + seconds2samples(@decay_time)).times do |i|
+ frample2file(@ws_output, i, body.call(file2sample(@ws_reverb, i, 0), i))
end
end
- add_help(:clm_mix, "clm_mix(filename, *args)
- :input_frame = 0
+ add_help(:clm_mix,
+ "clm_mix(infile, *args)
+ :output = false
:output_frame = 0
- :frames = mus_sound_frames(filename)
- :scale = 1.0
+ :frames = mus_sound_framples(infile)
+ :input_frame = 0
+ :scaler = false
Example: clm_mix(\"tmp\")")
- def clm_mix(filename, *args)
- input_frame, output_frame, frames, scale = nil
+ def clm_mix(infile, *args)
+ output, output_frame, frames, input_frame, scaler = nil
optkey(args, binding,
- [:input_frame, 0],
+ [:output, false],
[:output_frame, 0],
- [:frames, mus_sound_frames(filename)],
- [:scale, 1.0])
- mx = make_mixer(@channels, *(0... at channels * @channels).map do scale end)
- mus_mix(@output, filename, output_frame, frames, input_frame, mx)
+ [:frames, mus_sound_framples(infile)],
+ [:input_frame, 0],
+ [:scaler, false])
+ chans = 0
+ outgen = mus_output?(@ws_output)
+ unless output
+ if outgen
+ chans = @ws_output.channels
+ output = @ws_output.file_name
+ else
+ Snd.raise(:no_such_sound, @ws_output, "output generator required")
+ end
+ end
+ unless infile = clm_find_sound_file(infile)
+ Snd.raise(:no_such_file, infile, "file name required")
+ end
+ if outgen
+ @ws_output.close
+ end
+ mx = false
+ if chans > 0 and scaler and scaler != 0.0
+ mx = Vct.new(chans * chans, scaler)
+ end
+ mus_file_mix(output, infile, output_frame, frames, input_frame, mx)
+ if outgen
+ @ws_output = continue_sample2file(output)
+ end
end
protected
@@ -1817,10 +1917,12 @@ Example: clm_mix(\"tmp\")")
end
else
remove_file(@output)
- @ws_output = make_sample2file(@output, @channels, @data_format, @header_type, @comment)
+ @ws_output = make_sample2file(@output, @channels,
+ @sample_type, @header_type, @comment)
if @reverb
remove_file(@revfile)
- @ws_reverb = make_sample2file(@revfile, @reverb_channels, @data_format, @header_type)
+ @ws_reverb = make_sample2file(@revfile, @reverb_channels,
+ @sample_type, @header_type)
end
end
$output = @ws_output
@@ -1829,58 +1931,61 @@ Example: clm_mix(\"tmp\")")
def after_output
if @reverb
- mus_output?(@ws_reverb) and mus_close(@ws_reverb)
+ mus_output?(@ws_reverb) and @ws_reverb.close
old_reverb = @ws_reverb
# non-RUN_REVERB...END functions need it here
$reverb = @ws_reverb = make_file2sample(@revfile)
run_reverb_body
- mus_input?(@ws_reverb) and mus_close(@ws_reverb)
+ mus_input?(@ws_reverb) and @ws_reverb.close
$reverb = @ws_reverb = old_reverb
end
- mus_output?(@ws_output) and mus_close(@ws_output)
+ mus_output?(@ws_output) and @ws_output.close
end
- def ws_frame_location
+ def ws_frample_location
with_closed_output do
- mus_sound_frames(@output)
+ mus_sound_framples(@output)
end
end
-
- def scale_it(beg, len, scale)
- mx = make_mixer(@channels, *(0... at channels * @channels).map do scale end)
- mus_mix(@output, @output, beg, len, beg, mx, false)
- end
- private :scale_it
def scaled_to_sound(beg, len)
if provided? :snd
if sound?(@out_snd = find_sound(@output))
- @channels.times do |chn| scale_to(@scaled_to, @out_snd, chn) end
- save_sound(@out_snd)
+ @channels.times do |chn|
+ scale_to(@scaled_to, @out_snd, chn)
+ end
+ @out_snd.save
end
else
omax = mus_sound_maxamp(@output)
mx = 0.0
- 1.step(omax.length - 1, 2) do |i| mx = [omax[i].abs, mx].max end
- if mx.zero? then mx = 1.0 end
- scale_it(beg, len, @scaled_to / mx)
+ 1.step(omax.length - 1, 2) do |i|
+ mx = [omax[i].abs, mx].max
+ end
+ if mx.zero?
+ mx = 1.0
+ end
+ clm_mix(@output, :output_frame, beg,
+ :frames, len, :scaler, @scaled_to / mx)
end
end
def scaled_by_sound(beg, len)
if provided? :snd
if sound?(@out_snd = find_sound(@output))
- @channels.times do |chn| scale_channel(@scaled_by, beg, len, @out_snd, chn) end
- save_sound(@out_snd)
+ @channels.times do |chn|
+ scale_channel(@scaled_by, beg, len, @out_snd, chn)
+ end
+ @out_snd.save
end
else
- scale_it(beg, len, @scaled_by)
+ clm_mix(@output, :output_frame, beg, :frames, len, :scaler, @scaled_by)
end
end
def set_statistics
- @stat_frames = mus_sound_frames(@output)
- @stat_data_format = mus_sound_data_format(@output)
+ @stat_framples = mus_sound_framples(@output)
+ @stat_sample_type = mus_sound_sample_type(@output)
@stat_header_type = mus_sound_header_type(@output)
@stat_comment = mus_sound_comment(@output)
@stat_maxamp = mus_sound_maxamp(@output)
@@ -1905,95 +2010,97 @@ Example: clm_mix(\"tmp\")")
end
end
- def with_closed_output
- mus_output?(@ws_output) and mus_close(@ws_output)
- ret = yield
+ def with_closed_output(&body)
+ mus_output?(@ws_output) and @ws_output.close
+ ret = body.call()
$output = @ws_output = continue_sample2file(@output)
ret
end
end
class With_DAC < Snd_Instrument
- # no reverb
- # handles instruments parallel if computing is fast enough
- def initialize(*args)
- @clm = false
- super
- @bufsize = get_args(args, :bufsize, $clm_rt_bufsize)
- @device = get_args(args, :device, $clm_output_device)
- @ws_reverb = @ws_output = @reverb = false
- @output = "dac"
- # @instruments = [[first_samp, last_samp, body], ...]
- @instruments = []
- @current_sample = 0
+ def initialize(*args, &body)
+ super(:output, "dac", :reverb, false, *args, &body)
end
- def run_instrument(start, dur, *args, &body)
- super
- degree, distance, reverb_amount = nil
- optkey(locsig_args, binding,
- [:degree, random(90.0)],
- [:distance, 1.0],
- [:reverb_amount, 0.05])
- @locsig = make_locsig(:degree, degree,
- :distance, distance,
- :reverb, reverb_amount,
- :output, @ws_output,
- :revout, @ws_reverb,
- :channels, @channels,
- :type, @locsig_type)
- beg, ends = times2samples(start, dur)
- @instruments.push([beg, ends, body])
- real_run(beg)
- end
-
- def real_run(sample)
- while @current_sample < sample
- idxs = []
- dac_vct = Vct.new(@bufsize)
- # calls bufsize times all instruments in current sample-window
- # and accumulates the result in dac_vct
- @instruments.each_with_index do |arg, idx|
- beg, ends, body = arg
- if @current_sample.between?(beg, ends)
- dac_vct.add!(Vct.new(@bufsize) do |i| body.call(@current_sample + i) end)
- elsif @current_sample >= ends
- idxs.push(idx)
- end
- end
- idxs.each do |idx| @instruments.delete_at(idx) end
- dac_data = SoundData.new(@channels, @bufsize)
- @channels.times do |chn|
- dac_vct.scale(locsig_ref(@locsig, chn)).to_sound_data(dac_data, chn)
- end
- mus_audio_write(@ws_output, dac_data, @bufsize)
- @current_sample += @bufsize
+ def to_s
+ format("#<%s: channels: %d, srate: %d, dac_size: %d>",
+ self.class, @channels, @srate.to_i, @dac_size)
+ end
+
+ def run_instrument(start, dur, *locsig_args, &body)
+ # dac.run_instrument needs get_func_name(2) here
+ with_sound_info(get_func_name(2), start, dur, body)
+ @locsig = false
+ end
+
+ def with_current_sound(*args, &body)
+ end
+
+ def run(&body)
+ before_output
+ set_mus_file_buffer_size($clm_file_buffer_size)
+ init_process_time
+ run_body(&body)
+ play_it
+ stop_process_time
+ if @statistics
+ statistics
end
end
protected
- def before_output
- super
- @ws_output = mus_audio_open_output(@device, @srate.round, @channels, @audio_format,
- @bufsize * @channels * 2)
- if @ws_output < 0
- Snd.raise(:mus_error, @ws_output, "can't open DAC")
+ def statistics
+ Snd.message("filename: %s", @output)
+ Snd.message(" chans: %d, srate: %d", @channels, @srate.to_i)
+ Snd.message(" real: %1.3f (utime %1.3f, stime %1.3f)",
+ @rtime, @utime, @stime)
+ if @stat_framples > 0
+ Snd.message(" length: %1.3f (%d frames)",
+ @stat_framples / @srate.to_f, @stat_framples)
end
end
-
- def ws_maxamp_statistics
- end
-
- def after_output
- # flush contents of instrument array
- real_run(@current_sample + 1) until @instruments.empty?
- end
- def finish_sound
- if defined? set_auto_update_interval then set_auto_update_interval(@old_update_interval) end
- number?(@ws_output) and mus_audio_close(@ws_output)
+ def play_it
+ len = 0
+ # [body, [name, start, dur]]
+ insts = @clm_instruments.sort do |a, b|
+ a[1][1] <=> b[1][1]
+ end.to_a.map! do |body, args|
+ start = args[1]
+ dur = args[2]
+ beg, ends = times2samples(start, dur)
+ if len < ends
+ len = ends
+ end
+ [beg, ends, body]
+ end
+ oc = mus_clipping()
+ set_mus_clipping(true)
+ od = dac_size()
+ set_dac_size(@dac_size)
+ len += @dac_size
+ len += mus_file_buffer_size()
+ @stat_framples = len
+ s = 0
+ play(lambda do
+ if s < len
+ sum = 0.0
+ insts.each do |args|
+ beg, ends, body = args
+ if s.between?(beg, ends)
+ sum += body.call(s)
+ end
+ end
+ s += 1
+ sum
+ else
+ false
+ end
+ end)
+ set_mus_clipping(oc)
+ set_dac_size(od)
set_mus_srate(@old_srate)
- @ws_output = false
end
end
diff --git a/ws.scm b/ws.scm
index a77f8bf..969c359 100644
--- a/ws.scm
+++ b/ws.scm
@@ -2,55 +2,49 @@
(provide 'snd-ws.scm)
-(define (ws-interrupt?) #f) ; backwards compatibility
-
-
;;; -------- with-sound defaults --------
-(define *clm-srate* (default-output-srate))
+(set! *clm-srate* *default-output-srate*)
+
(define *clm-file-name* "test.snd")
-(define *clm-channels* (default-output-chans))
-(define *clm-data-format* (default-output-data-format))
-(define *clm-header-type* (default-output-header-type))
+(define *clm-reverb-file-name* "test.rev")
+(define *clm-channels* *default-output-chans*)
+(define *clm-sample-type* *default-output-sample-type*)
+(define *clm-header-type* *default-output-header-type*)
(define *clm-verbose* #f)
(define *clm-play* #f)
(define *clm-statistics* #f)
(define *clm-reverb* #f)
(define *clm-reverb-channels* 1)
-(define *clm-reverb-data* '())
-(define *clm-table-size* 512)
-(define *clm-file-buffer-size* 65536)
+(define *clm-reverb-data* ())
(define *clm-locsig-type* mus-interp-linear)
(define *clm-clipped* #t)
-(define *clm-array-print-length* (print-length))
+(define *clm-array-print-length* *print-length*)
(define *clm-player* #f)
(define *clm-notehook* #f)
(define *clm-with-sound-depth* 0) ; for CM, not otherwise used
-(define *clm-default-frequency* 0.0)
-(define *clm-safety* 0) ; obsolete
(define *clm-delete-reverb* #f) ; should with-sound clean up reverb stream
-(define *clm-threads* 4)
-(define *clm-output-safety* 0) ; if 1, assume output buffers will not need to be flushed except at the very end
(define *to-snd* #t)
-(define *default-player* (lambda (s) (play s :wait #t))) ; we need to perserve "play" because it is used as a keyword argument in with-sound
+(define *default-player* (lambda (s) (play s :wait #t)))
+(set! *clm-file-buffer-size* 65536)
-(define (times->samples beg dur)
- "(times->samples beg dur) converts beg and (+ beg dur) to samples, returning both in a list"
- (list (seconds->samples beg) (seconds->samples (+ beg dur))))
+(define times->samples
+ (let ((documentation "(times->samples beg dur) converts beg and (+ beg dur) to samples, returning both in a list"))
+ (lambda (beg dur)
+ (list (seconds->samples beg) (seconds->samples (+ beg dur))))))
;;; -------- definstrument --------
;(define definstrument define*) -- old form 2-Nov-05
-
(define *definstrument-hook* #f) ; for CM
-(defmacro definstrument (args . body)
+(define-macro (definstrument args . body)
(let* ((name (car args))
(targs (cdr args))
- (utargs (let ((arg-names '()))
+ (utargs (let ((arg-names ()))
(for-each
(lambda (a)
(if (not (keyword? a))
@@ -58,61 +52,62 @@
(set! arg-names (cons a arg-names))
(set! arg-names (cons (car a) arg-names)))))
targs)
- (reverse arg-names)))
- (doc (if (string? (car body))
- (let ((val (car body)))
- (set! body (cdr body))
- val)
- "no help")))
- `(begin
- (define* (,name , at targs)
- ,doc
- (if *clm-notehook*
- (*clm-notehook* (symbol->string ',name) , at utargs))
- ((lambda () ; for inner defines, if any
- , at body)))
- ,@(if *definstrument-hook*
- (list (*definstrument-hook* name targs))
- (list)))))
-
+ (reverse arg-names))))
+ (if (string? (car body))
+ `(begin
+ (define ,name
+ (let ((documentation ,(car body)))
+ (lambda* ,targs
+ (if *clm-notehook*
+ (*clm-notehook* (symbol->string ',name) , at utargs))
+ ,@(cdr body))))
+ ,@(if *definstrument-hook*
+ (list (*definstrument-hook* name targs))
+ (list)))
+ `(begin
+ (define* (,name , at targs)
+ (if *clm-notehook*
+ (*clm-notehook* (symbol->string ',name) , at utargs))
+ , at body)
+ ,@(if *definstrument-hook*
+ (list (*definstrument-hook* name targs))
+ (list))))))
+
+
;;; -------- with-sound --------
(define* (with-sound-helper thunk
- (srate *clm-srate*)
(output *clm-file-name*)
(channels *clm-channels*)
+ (srate *clm-srate*)
+ (sample-type *clm-sample-type*)
(header-type *clm-header-type*)
- (data-format *clm-data-format*)
- (comment #f)
+ comment
(verbose *clm-verbose*)
(reverb *clm-reverb*)
- (revfile "test.rev")
+ (revfile *clm-reverb-file-name*)
(reverb-data *clm-reverb-data*)
(reverb-channels *clm-reverb-channels*)
- (continue-old-file #f)
+ continue-old-file
(statistics *clm-statistics*)
- (scaled-to #f)
+ scaled-to
(play *clm-play*)
(to-snd *to-snd*)
(clipped 'unset)
(notehook *clm-notehook*) ; (with-sound (:notehook (lambda args (display args))) (fm-violin 0 1 440 .1))
- (scaled-by #f)
- (ignore-output #f)
- (thread-output #f)
- (thread-reverb #f)
- (output-safety *clm-output-safety*))
- "with-sound-helper is the business portion of the with-sound macro"
- (let* ((old-srate (mus-srate))
- (old-*output* *output*)
- (old-*reverb* *reverb*)
- (old-notehook *clm-notehook*)
- (old-verbose *clm-verbose*)
- (old-auto-update-interval (auto-update-interval))
- (output-1 output) ; protect during nesting
- (output-to-file (string? output))
- (reverb-1 revfile)
- (reverb-to-file (and reverb (string? revfile))))
+ scaled-by
+ ignore-output)
+ (let ((old-srate *clm-srate*)
+ (old-*output* *output*)
+ (old-*reverb* *reverb*)
+ (old-notehook *clm-notehook*)
+ (old-verbose *clm-verbose*)
+ (old-auto-update-interval *auto-update-interval*)
+ (output-1 output) ; protect during nesting
+ (output-to-file (string? output))
+ (reverb-1 revfile)
+ (reverb-to-file (and reverb (string? revfile))))
(if ignore-output
(begin
@@ -124,80 +119,56 @@
(lambda ()
(set! *clm-verbose* verbose)
(set! *clm-notehook* notehook)
- (set! (clm-table-size) *clm-table-size*)
- (set! (clm-default-frequency) *clm-default-frequency*)
- (set! (mus-file-buffer-size) *clm-file-buffer-size*)
(set! (locsig-type) *clm-locsig-type*)
- (set! (mus-array-print-length) *clm-array-print-length*)
- (set! (auto-update-interval) 0.0) ; turn it off
- (if (equal? clipped 'unset)
+ (set! *mus-array-print-length* *clm-array-print-length*)
+ (set! *auto-update-interval* 0.0)
+ (if (eq? clipped 'unset)
(if (and (or scaled-by scaled-to)
- (member data-format (list mus-bfloat mus-lfloat mus-bdouble mus-ldouble)))
+ (member sample-type (list mus-bfloat mus-lfloat mus-bdouble mus-ldouble)))
(set! (mus-clipping) #f)
(set! (mus-clipping) *clm-clipped*))
(set! (mus-clipping) clipped))
- (set! (mus-srate) srate))
+ (set! *clm-srate* srate))
(lambda ()
- (if (not thread-output)
+ (if output-to-file
(begin
-
- (if output-to-file
+ (if continue-old-file
(begin
- (if continue-old-file
- (begin
- (set! *output* (continue-sample->file output-1))
- (set! (mus-srate) (mus-sound-srate output-1)) ; "srate" arg shadows the generic func
- (let ((ind (find-sound output-1)))
- (if (sound? ind)
- (close-sound ind))))
- (begin
- (if (file-exists? output-1)
- (delete-file output-1))
- (set! *output* (make-sample->file output-1 channels data-format header-type comment))))
- (if *output*
- (set! (mus-safety *output*) output-safety)))
+ (set! *output* (continue-sample->file output-1))
+ (set! *clm-srate* (mus-sound-srate output-1)) ; "srate" arg shadows the generic func
+ (let ((ind (find-sound output-1)))
+ (if (sound? ind)
+ (close-sound ind))))
(begin
- (if (not continue-old-file)
- (if (or (vct? output-1)
- (sound-data? output-1)
- (vector? output-1))
- (fill! output-1 0.0)))
- (set! *output* output-1)))
-
- (if reverb
- (if reverb-to-file
- (begin
- (if continue-old-file
- (set! *reverb* (continue-sample->file reverb-1))
- (begin
- (if (file-exists? reverb-1)
- (delete-file reverb-1))
- (set! *reverb* (make-sample->file reverb-1 reverb-channels data-format header-type))))
- (if *reverb*
- (set! (mus-safety *reverb*) output-safety)))
- (begin
- (if (not continue-old-file)
- (if (or (vct? reverb-1)
- (sound-data? reverb-1)
- (vector? reverb-1))
- (fill! reverb-1 0.0)))
- (set! *reverb* reverb-1)))))
-
- ;; else thread-output
+ (if (file-exists? output-1)
+ (delete-file output-1))
+ (set! *output* (make-sample->file output-1 channels sample-type header-type comment)))))
(begin
- (if (file-exists? output-1)
- (delete-file output-1))
- (set! (thread-output) (make-sample->file output-1 channels data-format header-type comment))
- (set! (mus-safety (thread-output)) output-safety)
- (if thread-reverb
- (begin
- (if (file-exists? reverb-1)
- (delete-file reverb-1))
- (set! (thread-reverb) (make-sample->file reverb-1 reverb-channels data-format header-type))
- (set! (mus-safety (thread-reverb)) output-safety)))
- (set! statistics #f)
- ))
+ (if (and (not continue-old-file)
+ (vector? output-1))
+ (fill! output-1 0.0))
+ (set! *output* output-1)))
+
+ (if reverb
+ (if reverb-to-file
+ (begin
+ (if continue-old-file
+ (set! *reverb* (continue-sample->file reverb-1))
+ (begin
+ (if (file-exists? reverb-1)
+ (delete-file reverb-1))
+ (set! *reverb* (make-sample->file reverb-1
+ reverb-channels
+ (if (mus-header-writable header-type mus-ldouble)
+ mus-ldouble
+ sample-type)
+ header-type)))))
+ (begin
+ (if (and (not continue-old-file)
+ (vector? reverb-1))
+ (fill! reverb-1 0.0))
+ (set! *reverb* reverb-1))))
(let ((start (if statistics (get-internal-real-time)))
(flush-reverb #f)
@@ -218,7 +189,7 @@
;; (with-sound () (fm-violin 0 1 440 .1 :amp-env '(0 0 1 1 1 2 3 0)))
;; user might have listener closed, or no listener so...
- (display (format #f ";~%with-sound mus-error: ~{~A~^ ~}~%" (cdr args)))
+ (format #t ";~%with-sound mus-error: ~{~A~^ ~}~%" (cdr args))
;; now try to get something to listener, since there may be no stdout
(snd-print (format #f ";~%with-sound mus-error: ~{~A~^ ~}~%" (cdr args)))
@@ -227,43 +198,35 @@
(if (and reverb
(not flush-reverb)) ; i.e. not interrupted by error and trying to jump out
(begin
- (if thread-reverb
- (if (not (= (mus-safety (thread-output)) 1)) (mus-close (thread-reverb)))
- (if reverb-to-file
- (mus-close *reverb*)))
- (if statistics
- (if (or reverb-to-file
- (vct? reverb-1)
- (sound-data? reverb-1)
- (vector? reverb-1))
- (set! revmax (maxamp reverb-1))))
- (if (not thread-reverb)
- (begin
- (if reverb-to-file
- (set! *reverb* (make-file->sample reverb-1)))
- (apply reverb reverb-data) ; here is the reverb call(!)
- (if reverb-to-file
- (mus-close *reverb*))
- (if (and reverb-to-file *clm-delete-reverb*)
- (delete-file reverb-1))))))
-
- (if thread-output
- (if (not (= (mus-safety (thread-output)) 1)) (mus-close (thread-output)))
- (if output-to-file
- (mus-close *output*)))
+ (if reverb-to-file
+ (mus-close *reverb*))
+ (if (and statistics
+ (or reverb-to-file
+ (vector? reverb-1)))
+ (set! revmax (maxamp reverb-1)))
+ (if reverb-to-file
+ (set! *reverb* (make-file->sample reverb-1)))
+ (apply reverb reverb-data) ; here is the reverb call(!)
+ (if reverb-to-file
+ (mus-close *reverb*))
+ (if (and reverb-to-file *clm-delete-reverb*)
+ (delete-file reverb-1))))
+
+ (if output-to-file
+ (mus-close *output*))
(let ((snd-output #f)
(cur-sync #f))
(if statistics
- (set! cycles (/ (* 1.0 (- (get-internal-real-time) start)) internal-time-units-per-second)))
+ (set! cycles (* 1.0 (- (get-internal-real-time) start))))
(if (and to-snd output-to-file)
- (let* ((cur (find-sound output-1)))
+ (let ((cur (find-sound output-1)))
(set! cur-sync (and cur (sync cur)))
(if cur
(set! snd-output (update-sound cur))
(if (= header-type mus-raw)
- (set! snd-output (open-raw-sound output-1 channels srate data-format))
+ (set! snd-output (open-raw-sound output-1 channels (floor srate) sample-type))
;; open-sound here would either ask for raw settings or use possibly irrelevant defaults
(set! snd-output (open-sound output-1))))
(set! (sync snd-output) #t)))
@@ -274,16 +237,12 @@
(if to-snd
snd-print
display))
- (format #f (if (not (member data-format (list mus-bdouble mus-ldouble)))
+ (format #f (if (not (member sample-type (list mus-bdouble mus-ldouble)))
"~%;~A:~% maxamp~A:~{ ~,4F~}~%~A compute time: ~,3F~%"
"~%;~A:~% maxamp~A:~{ ~,8F~}~%~A compute time: ~,3F~%")
(if output-to-file
output-1
- (if (vct? output-1) "vct"
- (if (sound-data? output-1) "sound-data"
- (if (procedure? output-1) "function"
- (if (vector? output-1) "vector"
- "flush")))))
+ (if (vector? output-1) "vector" "flush"))
(if (or scaled-to scaled-by)
" (before scaling)"
"")
@@ -293,58 +252,50 @@
(let ((lst (mus-sound-maxamp output-1)))
(do ((i 0 (+ i 2)))
((>= i (length lst)))
- (list-set! lst i (/ (list-ref lst i) (mus-srate))))
+ (set! (lst i) (/ (lst i) *clm-srate*)))
lst))
- (if (vct? output-1)
- (list (vct-peak output-1))
- (if (sound-data? output-1)
- (sound-data-maxamp output-1)
- (if (vector? output-1)
- (list (maxamp output-1))
- 0.0))))
+ (if (vector? output-1)
+ (list (maxamp output-1))
+ '(0.0)))
(if revmax (format #f " rev max: ~,4F~%" revmax) "")
cycles)))
(if (or scaled-to scaled-by)
(if output-to-file
- (let ((scale-output (or snd-output (open-sound output-1))))
+ (let* ((scale-output (or snd-output (open-sound output-1)))
+ (old-sync (sync scale-output)))
+ (set! (sync scale-output) (+ (sync-max) 1)) ; make sure scaling doesn't follow sync
(if scaled-to
(scale-to scaled-to scale-output)
- (if scaled-by
- (scale-by scaled-by scale-output)))
+ (scale-by scaled-by scale-output))
+ (set! (sync scale-output) old-sync)
(save-sound scale-output)
(if (not to-snd)
(close-sound scale-output)))
- (if (vct? output-1)
+ (if (float-vector? output-1)
(if scaled-to
- (let ((pk (vct-peak output-1)))
+ (let ((pk (float-vector-peak output-1)))
(if (> pk 0.0)
- (vct-scale! output-1 (/ scaled-to pk))))
- (vct-scale! output-1 scaled-by))
- (if (sound-data? output-1)
+ (float-vector-scale! output-1 (/ scaled-to pk))))
+ (float-vector-scale! output-1 scaled-by))
+ (if (vector? output-1)
(if scaled-to
- (let ((pk (sound-data-peak output-1)))
+ (let ((pk (maxamp output-1)))
(if (> pk 0.0)
- (sound-data-scale! output-1 (/ scaled-to pk))))
- (sound-data-scale! output-1 scaled-by))
- (if (vector? output-1)
- (if scaled-to
- (let ((pk (maxamp output-1)))
- (if (> pk 0.0)
- (let ((scl (/ scaled-to pk)))
- (do ((i 0 (+ i 1)))
- ((= i (length output-1)))
- (set! (output-1 i) (* scl (output-1 i)))))))
- (do ((i 0 (+ i 1)))
- ((= i (length output-1)))
- (set! (output-1 i) (* scaled-by (output-1 i))))))))))
+ (let ((scl (/ scaled-to pk)))
+ (do ((i 0 (+ i 1)))
+ ((= i (length output-1)))
+ (set! (output-1 i) (* scl (output-1 i)))))))
+ (do ((i 0 (+ i 1)))
+ ((= i (length output-1)))
+ (set! (output-1 i) (* scaled-by (output-1 i)))))))))
(if (and play output-to-file)
(if to-snd
(if *clm-player*
(*clm-player* snd-output)
(*default-player* snd-output))
- (*default-player* output-1))) ; this was (play output-1) which could not have worked?!
+ (*default-player* output-1)))
(if (and to-snd output-to-file)
(begin
@@ -356,142 +307,50 @@
(lambda ()
(set! *clm-verbose* old-verbose)
(set! *clm-notehook* old-notehook)
- (set! (auto-update-interval) old-auto-update-interval)
+ (set! *auto-update-interval* old-auto-update-interval)
(if *reverb*
(begin
- (if thread-reverb
- (if (not (= (mus-safety (thread-reverb)) 1)) (mus-close (thread-reverb)))
- (mus-close *reverb*))
+ (mus-close *reverb*)
(set! *reverb* old-*reverb*)))
(if *output*
(begin
- (if thread-output
- (if (not (= (mus-safety (thread-output)) 1)) (mus-close (thread-output)))
- (if (mus-output? *output*)
- (mus-close *output*)))
+ (if (mus-output? *output*)
+ (mus-close *output*))
(set! *output* old-*output*)))
- (set! (mus-srate) old-srate)))))
+ (set! *clm-srate* old-srate)))))
-(defmacro with-sound (args . body)
+(define-macro (with-sound args . body)
`(with-sound-helper (lambda () , at body) , at args))
;;; -------- with-full-sound --------
-(defmacro with-full-sound (args . body)
+(define-macro (with-full-sound args . body)
;; with-sound but display full sound in Snd window
`(let ((snd (with-sound-helper (lambda () , at body) , at args)))
- (set! (x-bounds *snd-opened-sound*) (list 0.0 (/ (frames *snd-opened-sound*) (srate *snd-opened-sound*))))
+ (set! (x-bounds *snd-opened-sound*) (list 0.0 (/ (framples *snd-opened-sound*) (srate *snd-opened-sound*))))
(let ((mx (apply max (maxamp *snd-opened-sound* #t))))
(if (> mx 1.0)
(set! (y-bounds *snd-opened-sound*) (list (- mx) mx))))
snd))
-
-;;; -------- with-threaded-sound --------
-
-(defmacro with-threaded-sound (args . body)
- (if (and (provided? 'snd-threads)
- (not (= (optimization) 0)))
- (let ((split
- (lambda (l n k)
- (define (split-1 s l n i)
- (if (null? l)
- (reverse s)
- (if (= i n)
- (split-1 (cons (car l) s) (cdr l) n 1)
- (split-1 s (cdr l) n (+ i 1)))))
- (split-1 '() l n (- n k))))
-
- (remove-output-and-reverb-args
- (lambda (lst)
- (let ((badarg #f)
- (new-args '()))
- (for-each
- (lambda (arg)
- (if badarg
- (set! badarg #f)
- (if (not (member arg (list :output :reverb :revfile :reverb-data :reverb-channels)))
- (set! new-args (cons arg new-args))
- (set! badarg #t))))
- lst)
- (reverse new-args)))))
-
- (let ((lists '()))
- (do ((i 0 (+ 1 i)))
- ((= i *clm-threads*))
- (set! lists (cons (split body *clm-threads* i) lists)))
-
- (let ((new-args (remove-output-and-reverb-args args)))
-
- `(with-sound-helper
- (lambda ()
- (let ((threads '())
- (thread-output (make-thread-variable))
- (thread-reverb (and *reverb* (make-thread-variable)))
- (mix-lock (make-lock))
- (main-output *output*)
- (main-reverb *reverb*))
-
- (set! *output* thread-output)
- (if thread-reverb (set! *reverb* thread-reverb))
-
- ,@(map
- (lambda (expr)
- `(set! threads (cons (make-thread
- (lambda ()
- (let* ((reverb-tmp (and *reverb* (snd-tempnam)))
- (tmp (with-sound-helper
- (lambda ()
- , at expr
- #f)
- :thread-output thread-output
- :thread-reverb thread-reverb
- :output (snd-tempnam)
- :revfile reverb-tmp
- :to-snd #f
- , at new-args
- )))
- (grab-lock mix-lock)
- (display (format #f "mix ~S [~D]~%" tmp (mus-safety main-output)))
- (if (= (mus-safety main-output) 1)
- (begin
- (sample->file+ main-output (thread-output))
- (mus-close (thread-output)))
- (mus-mix main-output tmp))
- (if *reverb*
- (if (= (mus-safety main-output) 1)
- (begin
- (sample->file+ main-reverb (thread-reverb))
- (mus-close (thread-reverb)))
- (mus-mix main-reverb reverb-tmp)))
- (release-lock mix-lock)
- (delete-file tmp))))
- threads)))
- lists)
-
- (for-each
- (lambda (thread)
- (join-thread thread))
- threads)
-
- (if main-reverb (set! *reverb* main-reverb))
- (set! *output* main-output)))
-
- , at args))))
-
- `(with-sound-helper
- (lambda ()
- , at body)
- , at args)))
-
-
+(define-macro (with-fullest-sound args . body)
+ ;; with-sound but display full sound in Snd window
+ `(let ((snd (with-sound-helper (lambda () , at body) , at args)))
+ (set! (x-bounds *snd-opened-sound*) (list 0.0 (/ (framples *snd-opened-sound*) (srate *snd-opened-sound*))))
+ (set! (channel-style *snd-opened-sound*) channels-separate)
+ (do ((chn 0 (+ chn 1)))
+ ((= chn (channels *snd-opened-sound*)))
+ (let ((mx (maxamp *snd-opened-sound* chn)))
+ (if (> mx 1.0)
+ (set! (y-bounds *snd-opened-sound* chn) (list (- mx) mx)))))
+ snd))
;;; -------- with-temp-sound --------
-(defmacro with-temp-sound (args . body)
+(define-macro (with-temp-sound args . body)
`(let ((old-file-name *clm-file-name*)
(old-to-snd *to-snd*))
;; with-sound but using tempnam for output (can be over-ridden by explicit :output) and does not open result in Snd
@@ -508,9 +367,10 @@
;;; -------- clm-load --------
-(define (clm-load file . args)
- "(clm-load file . args) loads 'file' in the context of with-sound"
- (apply with-sound-helper (lambda () (load file)) args))
+(define clm-load
+ (let ((documentation "(clm-load file . args) loads 'file' in the context of with-sound"))
+ (lambda (file . args)
+ (apply with-sound-helper (lambda () (load file)) args))))
;;; -------- with-mixed-sound --------
@@ -529,38 +389,40 @@
(< id (+ (car info) (caddr info)))))
all-info)))
-(defmacro with-mixed-sound (args . body)
+(define-macro (with-mixed-sound args . body)
`(let* ((output (with-sound-helper (lambda () #f) , at args :to-snd #t)) ; pick up args for output
(outsnd (find-sound output)))
(if (sound? outsnd)
- (let ((mix-info '())
+ (let ((mix-info ())
(old-sync (sync outsnd)))
;; if multichannel output, make sure cross-chan mixes move together
(if (> (channels outsnd) 1)
(begin
- (set! (hook-functions mix-release-hook) '())
+ (set! (hook-functions mix-release-hook) ())
(hook-push mix-release-hook
- (lambda (id samps-moved)
- (let ((new-pos (+ samps-moved (mix-position id)))
- (base (sync id)))
- (do ((mx (integer->mix base) (integer->mix (+ (mix->integer mx) 1))))
- ((or (not (mix? mx))
- (not (= (sync mx) base))))
- (set! (mix-position mx) new-pos))
- #t)))))
+ (lambda (hook)
+ (let ((id (hook 'id))
+ (samps-moved (hook 'samples)))
+ (let ((new-pos (+ samps-moved (mix-position id)))
+ (base (sync id)))
+ (do ((mx (integer->mix base) (integer->mix (+ (mix->integer mx) 1))))
+ ((or (not (mix? mx))
+ (not (= (sync mx) base))))
+ (set! (mix-position mx) new-pos))
+ (set! (hook 'result) #t)))))))
;; click shows the original note list entry
- (set! (hook-functions mix-click-hook) '())
+ (set! (hook-functions mix-click-hook) ())
(hook-push mix-click-hook
- (lambda (id)
- (let ((info (with-mixed-sound-mix-info id outsnd)))
- (report-in-minibuffer (format #f "mix ~A: ~A"
- id (or (and info
- (cadddr info))
- (/ (mix-position id) (* 1.0 (srate outsnd))))))
- #t))) ; #t -> don't print the mix id in the minibuffer
+ (lambda (hook)
+ (let ((info (with-mixed-sound-mix-info (hook 'id) outsnd)))
+ (status-report (format #f "mix ~A: ~A"
+ (hook 'id) (or (and info
+ (cadddr info))
+ (/ (mix-position id) (* 1.0 (srate outsnd))))))
+ (set! (hook 'result) #t)))) ; #t -> don't print the mix id in the status area
(dynamic-wind
(lambda ()
@@ -572,7 +434,7 @@
(lambda ()
(for-each
(lambda (note)
- (let* ((snd (with-temp-sound (, at args :ignore-output #t :clipped #f) (eval (append (list (car note) 0.0) (cddr note)) (current-environment))))
+ (let* ((snd (with-temp-sound (, at args :ignore-output #t :clipped #f) (eval (append (list (car note) 0.0) (cddr note)) (curlet))))
;; I can't immediately find a way around the "eval"
(beg (floor (* (srate outsnd) (cadr note))))
;; can't use seconds->samples here because the global mus-srate value might not match the local one
@@ -613,34 +475,33 @@
(let* ((outsnd (or snd (selected-sound) (car (sounds))))
(mix-info (sound-property 'with-mixed-sound-info outsnd)))
(if (not mix-info)
- (throw 'no-such-mixed-sound (list "with-mixed-sound->notelist" outsnd))
+ (error 'no-such-mixed-sound (list "with-mixed-sound->notelist" outsnd))
(let ((cur-mixes (mixes outsnd 0)) ; for now assume each mix is multichannel
(oput (open-output-file output-file)))
- (display (format #f "(with-sound (:channels ~D)~%" (channels snd)) oput)
+ (format oput "(with-sound (:channels ~D)~%" (channels snd))
(for-each
(lambda (id)
(let ((info (with-mixed-sound-mix-info id snd)))
(if info
(let ((call (cadddr info)))
(if (not (= (cadr info) (mix-position id)))
- (display (format #f " (~A ~,3F~{ ~A~})~%"
- (car call)
- (/ (mix-position id) (* 1.0 (srate snd)))
- (cddr call))
- oput)
- (display (format #f " ~A~%" call) oput)))
- (report-in-minibuffer "can't find note associated with mix ~A" id))))
+ (format oput " (~A ~,3F~{ ~A~})~%"
+ (car call)
+ (/ (mix-position id) (* 1.0 (srate snd)))
+ (cddr call))
+ (format oput " ~A~%" call)))
+ (status-report "can't find note associated with mix ~A" id))))
cur-mixes)
- (display (format #f ")~%") oput)
+ (format oput ")~%")
(close-output-port oput)))))
;;; -------- with-marked-sound --------
-(defmacro with-marked-sound (args . body)
+(define-macro (with-marked-sound args . body)
`(let ((old-notehook *clm-notehook*)
- (mark-list '()))
+ (mark-list ()))
(dynamic-wind
(lambda ()
(set! *clm-notehook* (lambda (name . args)
@@ -674,32 +535,28 @@
;;;
;;; (with-sound () (sound-let ((a () (fm-violin 0 .1 440 .1))) (mus-mix "test.snd" a)))
-(defmacro sound-let (snds . body)
- `(let ((temp-files '())
+(define-macro (sound-let snds . body)
+ `(let ((temp-files ())
(old-hook-list (hook-functions new-sound-hook))) ; save old new-sound-hook (nested sound-lets etc)
- (begin
- (set! (hook-functions new-sound-hook) '())
- (hook-push new-sound-hook (lambda (file) ; save current sound-let temp file list
- (if (string? file) ; try to ignore vcts and sound-data objects
- (set! temp-files (cons file temp-files)))))
- (let ((val (let ,(map (lambda (arg)
- (if (> (length arg) 2)
- ; if with-sound, embed with-temp-sound
- `(,(car arg) (with-temp-sound ,(cadr arg) ,@(cddr arg)))
- arg)) ; else use direct (normal var in the let)
- snds)
- , at body))) ; sound-let body
- (for-each (lambda (file) ; clean up all local temps
- (if (and (string? file) ; is it a file? (might be a vct or sound-data object)
- (file-exists? file))
- (delete-file file)))
- temp-files)
- (set! (hook-functions new-sound-hook) '()) ; restore old new-sound-hook (should this happen before , at body?)
- (if (not (null? old-hook-list))
- (for-each (lambda (proc)
- (hook-push new-sound-hook proc))
- old-hook-list))
- val)))) ; return body result
+ (set! (hook-functions new-sound-hook)
+ (list (lambda (hook) ; save current sound-let temp file list
+ (let ((file (hook 'name)))
+ (if (string? file) ; try to ignore float-vectors
+ (set! temp-files (cons file temp-files)))))))
+ (let ((val (let ,(map (lambda (arg)
+ (if (> (length arg) 2)
+ ; if with-sound, embed with-temp-sound
+ `(,(car arg) (with-temp-sound ,(cadr arg) ,@(cddr arg)))
+ arg)) ; else use direct (normal var in the let)
+ snds)
+ , at body))) ; sound-let body
+ (for-each (lambda (file) ; clean up all local temps
+ (if (and (string? file) ; is it a file? (might be a float-vector)
+ (file-exists? file))
+ (delete-file file)))
+ temp-files)
+ (set! (hook-functions new-sound-hook) old-hook-list)
+ val)))
@@ -710,43 +567,41 @@
(output *clm-file-name*)
(channels *clm-channels*)
(header-type *clm-header-type*)
- (data-format *clm-data-format*)
- (comment #f)
+ data-format
+ (sample-type *clm-sample-type*)
+ comment
;(verbose *clm-verbose*) ; why is this commented out?
(reverb *clm-reverb*)
- (revfile "test.rev")
+ (revfile *clm-reverb-file-name*)
(reverb-data *clm-reverb-data*)
(reverb-channels *clm-reverb-channels*)
- (continue-old-file #f)
+ continue-old-file
(statistics *clm-statistics*)
- (scaled-to #f)
+ scaled-to
(play *clm-play*)
(to-snd *to-snd*)
- (scaled-by #f))
- "(init-with-sound . args) is the first half of with-sound; it sets up the CLM output choices, reverb, etc. Use \
-finish-with-sound to complete the process."
- (let ((old-srate (mus-srate))
+ scaled-by)
+ (let ((old-srate *clm-srate*)
(start (if statistics (get-internal-real-time)))
(output-to-file (string? output))
(reverb-to-file (and reverb (string? revfile))))
+ (set! *clm-srate* srate)
(if output-to-file
(if continue-old-file
(begin
(set! *output* (continue-sample->file output))
- (set! (mus-srate) (mus-sound-srate output))
+ (set! *clm-srate* (mus-sound-srate output))
(let ((ind (find-sound output)))
(if (sound? ind)
(close-sound ind))))
(begin
(if (file-exists? output)
(delete-file output))
- (set! *output* (make-sample->file output channels data-format header-type comment))))
+ (set! *output* (make-sample->file output channels (or data-format sample-type) header-type comment))))
(begin
- (if (not continue-old-file)
- (if (or (vct? output)
- (sound-data? output)
- (vector? output))
- (fill! output 0.0)))
+ (if (and (not continue-old-file)
+ (vector? output))
+ (fill! output 0.0))
(set! *output* output)))
(if reverb
@@ -756,13 +611,11 @@ finish-with-sound to complete the process."
(begin
(if (file-exists? revfile)
(delete-file revfile))
- (set! *reverb* (make-sample->file revfile reverb-channels data-format header-type))))
+ (set! *reverb* (make-sample->file revfile reverb-channels (or data-format sample-type) header-type))))
(begin
- (if (not continue-old-file)
- (if (or (vct? revfile)
- (sound-data? revfile)
- (vector? revfile))
- (fill! revfile 0.0)))
+ (if (and (not continue-old-file)
+ (vector? revfile))
+ (fill! revfile 0.0))
(set! *reverb* revfile))))
(list 'with-sound-data
@@ -779,20 +632,19 @@ finish-with-sound to complete the process."
start)))
(define (finish-with-sound wsd)
- "(finish-with-sound wsd) closes the notelist process started by init-with-sound"
(if (eq? (car wsd) 'with-sound-data)
(let ((cycles 0)
- (output (list-ref wsd 1))
- (reverb (list-ref wsd 2))
- (revfile (list-ref wsd 3))
- (old-srate (list-ref wsd 4))
- (statistics (list-ref wsd 5))
- (to-snd (list-ref wsd 6))
- (scaled-to (list-ref wsd 7))
- (scaled-by (list-ref wsd 8))
- (play (list-ref wsd 9))
- (reverb-data (list-ref wsd 10))
- (start (list-ref wsd 11)))
+ (output (wsd 1))
+ (reverb (wsd 2))
+ (revfile (wsd 3))
+ (old-srate (wsd 4))
+ (statistics (wsd 5))
+ (to-snd (wsd 6))
+ (scaled-to (wsd 7))
+ (scaled-by (wsd 8))
+ (play (wsd 9))
+ (reverb-data (wsd 10))
+ (start (wsd 11)))
(if reverb
(begin
@@ -825,46 +677,48 @@ finish-with-sound to complete the process."
(save-sound snd-output)))
(if play (*default-player* snd-output))
(update-time-graph snd-output)))
- (set! (mus-srate) old-srate)
+ (set! *clm-srate* old-srate)
output)
- (throw 'wrong-type-arg
+ (error 'wrong-type-arg
(list "finish-with-sound" wsd))))
(define wsdat-play ; for cm
- (make-procedure-with-setter
- (lambda (w)
- "accessor for play field of init-with-sound struct"
- (list-ref w 9))
+ (dilambda
+ (let ((documentation "accessor for play field of init-with-sound struct"))
+ (lambda (w)
+ (w 9)))
(lambda (w val)
- (list-set! w 9 val))))
+ (set! (w 9) val))))
;;; -------- with-sound save state --------
-(define (ws-save-state filename)
- "(ws-save-state filename) is an after-save-state-hook function that saves the current with-sound global settings"
-
- (define (open-appending filename)
- (open-output-file filename "a"))
-
- (define (close-appending fd)
- (close-output-port fd))
-
- (let ((fd (open-appending filename)))
- ;; fd is a Scheme port at this point (not an integer), so we can use format etc
- ;; should the save-state file load this file if it hasn't been loaded? (what path?)
- (format fd "~%~%;;; from ws.scm~%")
- (format fd "(if (defined? '*clm-srate*)~%")
- (format fd " (begin~%")
- (format fd " (set! *clm-srate* ~A)~%" *clm-srate*)
- (format fd " (set! *clm-file-name* ~S)~%" *clm-file-name*)
- (format fd " (set! *clm-channels* ~A)~%" *clm-channels*)
- (format fd " (set! *clm-data-format* ~A)~%" (mus-data-format->string *clm-data-format*))
- (format fd " (set! *clm-header-type* ~A)))~%" (mus-header-type->string *clm-header-type*))
- (close-appending fd)))
+(define ws-save-state
+ (let ((documentation "(ws-save-state filename) is an after-save-state-hook function that saves the current with-sound global settings"))
+ (lambda (hook)
+ (let ((filename (hook 'name)))
-(hook-push after-save-state-hook ws-save-state)
+ (define (open-appending filename)
+ (open-output-file filename "a"))
+
+ (define close-appending close-output-port)
+
+ (let ((fd (open-appending filename)))
+ ;; fd is a Scheme port at this point (not an integer), so we can use format etc
+ ;; should the save-state file load this file if it hasn't been loaded? (what path?)
+ (format fd "~%~%;;; from ws.scm~%")
+ (format fd "(if (defined? '*clm-srate*)~%")
+ (format fd " (begin~%")
+ (format fd " (set! *clm-srate* ~A)~%" *clm-srate*)
+ (format fd " (set! *clm-file-name* ~S)~%" *clm-file-name*)
+ (format fd " (set! *clm-channels* ~A)~%" *clm-channels*)
+ (format fd " (set! *clm-sample-type* ~A)~%" (mus-sample-type->string *clm-sample-type*))
+ (format fd " (set! *clm-header-type* ~A)))~%" (mus-header-type->string *clm-header-type*))
+ (close-appending fd))))))
+
+(if (not (member ws-save-state (hook-functions after-save-state-hook) eq?))
+ (set! (hook-functions after-save-state-hook) (list ws-save-state)))
;;; -------- ->frequency --------
@@ -872,24 +726,23 @@ finish-with-sound to complete the process."
(define ->frequency
(let ((main-pitch (/ 440.0 (expt 2.0 (/ 57 12)))) ; a4 = 440Hz is pitch 57 in our numbering
(last-octave 0) ; octave number can be omitted
- (ratios (vector 1.0 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2.0)))
+ (ratios (vector 1.0 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2.0))
+ (documentation "(->frequency pitch pythagorean) returns the frequency (Hz) of the 'pitch', a CLM/CM style note name as a \
+symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small-integer ratios, rather than equal-tempered tuning."))
(lambda* (pitch pythagorean) ; pitch can be pitch name or actual frequency
- "(->frequency pitch pythagorean) returns the frequency (Hz) of the 'pitch', a CLM/CM style note name as a \
-symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small-integer ratios, rather than equal-tempered tuning."
(if (symbol? pitch)
(let* ((name (string-downcase (symbol->string pitch)))
- (base-char (string-ref name 0))
- (sign-char (and (> (string-length name) 1)
- (not (char-numeric? (string-ref name 1)))
- (not (char=? (string-ref name 1) #\n))
- (string-ref name 1)))
- (octave-char (if (and (> (string-length name) 1)
- (char-numeric? (string-ref name 1)))
- (string-ref name 1)
- (if (and (> (string-length name) 2)
- (char-numeric? (string-ref name 2)))
- (string-ref name 2)
- #f)))
+ (base-char (name 0))
+ (sign-char (and (> (length name) 1)
+ (not (char-numeric? (name 1)))
+ (not (char=? (name 1) #\n))
+ (name 1)))
+ (octave-char (if (and (> (length name) 1)
+ (char-numeric? (name 1)))
+ (name 1)
+ (and (> (length name) 2)
+ (char-numeric? (name 2))
+ (name 2))))
(base (modulo (+ 5 (- (char->integer base-char) (char->integer #\a))) 7)) ; c-based (diatonic) octaves
(sign (if (not sign-char) 0 (if (char=? sign-char #\f) -1 1)))
(octave (if octave-char (- (char->integer octave-char) (char->integer #\0)) last-octave))
@@ -904,274 +757,77 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
;;; -------- ->sample --------
-(define (->sample beg)
- "(->sample time-in-seconds) -> time-in-samples"
- (round (* (if (not (null? (sounds))) (srate) (mus-srate)) beg)))
+(define ->sample
+ (let ((documentation "(->sample time-in-seconds) -> time-in-samples"))
+ (lambda (beg)
+ (round (* (if (pair? (sounds)) (srate) *clm-srate*) beg)))))
;;; -------- defgenerator --------
-;;; :(defgenerator (osc :make-wrapper (lambda (gen) (set! (osc-freq gen) (hz->radians (osc-freq gen))) gen)) freq phase)
-;;; #<unspecified>
-;;; :(define hi (make-osc 440.0 0.0))
-;;; #<unspecified>
-;;; :hi
-;;; (osc 0.125378749798983 0.0)
-
-;;; besides setting up the list accessors, the make function, and the type predicate, defgenerator
-;;; calls add-clm-field to tell run the type of each list element (only actually needed if
-;;; there are different types in use)
-;;; it also adds the built-in methods mus-name, mus-reset, mus-run, and mus-describe (if they don't already exist), and
-;;; mus-frequency if a "frequency" field exists (treated as radians)
-;;; mus-phase if a "phase" or "angle" field exists
-;;; mus-scaler if "r" or "amplitude",
-;;; mus-order if "n" or "order"
-;;; mus-offset if "ratio" (mimics nrxy*)
-
-(define (find-if pred l)
- (cond ((null? l) #f)
- ((pred (car l)) (car l))
- (else (find-if pred (cdr l)))))
-
-(defmacro defgenerator (struct-name . fields)
- (let* ((name (if (list? struct-name) (car struct-name) struct-name))
-
- (wrapper (or (and (list? struct-name)
+;;; (defgenerator osc a b)
+;;; (defgenerator (osc :methods (list (cons 'mus-frequency (lambda (obj) 100.0)))) a b)
+
+(define-macro (defgenerator struct-name . fields)
+
+ (define (list->bindings lst)
+ (let ((len (length lst)))
+ (let ((nlst (make-list (* len 2))))
+ (do ((old lst (cdr old))
+ (nsym nlst (cddr nsym)))
+ ((null? old) nlst)
+ (if (pair? (car old))
+ (begin
+ (set-car! (cdr nsym) (caar old))
+ (set-car! nsym (list 'quote (caar old))))
+ (begin
+ (set-car! (cdr nsym) (car old))
+ (set-car! nsym (list 'quote (car old)))))))))
+
+ (let* ((name (if (pair? struct-name)
+ (car struct-name)
+ struct-name))
+ (sname (if (string? name)
+ name
+ (symbol->string name)))
+ (wrapper (or (and (pair? struct-name)
(or (and (> (length struct-name) 2)
- (equal? (struct-name 1) :make-wrapper)
+ (eq? (struct-name 1) :make-wrapper)
(struct-name 2))
(and (= (length struct-name) 5)
- (equal? (struct-name 3) :make-wrapper)
+ (eq? (struct-name 3) :make-wrapper)
(struct-name 4))))
(lambda (gen) gen)))
-
- (sname (if (string? name) name (symbol->string name)))
-
- (field-names (map (lambda (n)
- (symbol->string (if (list? n) (car n) n)))
- fields))
-
- (field-types (map (lambda (n)
- (if (and (list? n) (cadr n) (eq? (cadr n) :type))
- (snd-error (format #f ":type indication for defgenerator (~A) field (~A) should be after the default value" name n)))
- (if (and (list? n)
- (= (length n) 4)
- (eq? (n 2) :type))
- (n 3)
- (if (and (list? n)
- (= (length n) 2))
- (if (number? (cadr n))
- (if (rational? (cadr n))
- 'int
- 'float)
- (if (string? (cadr n))
- 'string
- (if (char? (cadr n))
- 'char
- (if (or (equal? (cadr n) #t)
- (equal? (cadr n) #f))
- 'boolean
- 'float))))
- 'float)))
- fields))
-
- (original-methods (or (and (list? struct-name)
- (or (and (> (length struct-name) 2)
- (equal? (struct-name 1) :methods)
- (struct-name 2))
- (and (= (length struct-name) 5)
- (equal? (struct-name 3) :methods)
- (struct-name 4))))
- (list)))
-
- (method-exists? (lambda (method)
- (and (not (null? original-methods))
- (find-if (lambda (g)
- (and (list? g)
- (list? (cadr g))
- (eq? (car (cadr g)) method)))
- (cdr original-methods)))))
-
- (phase-field-name (and (not (method-exists? 'mus-phase))
- (let ((fld (find-if (lambda (name)
- (or (string=? name "phase")
- (string=? name "angle")))
- field-names)))
- (and fld (string-append "-" fld)))))
-
- (frequency-field-name (and (not (method-exists? 'mus-frequency))
- (find-if (lambda (name)
- (string=? name "frequency"))
- field-names)
- "-frequency"))
-
- (offset-field-name (and (not (method-exists? 'mus-offset))
- (find-if (lambda (name)
- (string=? name "ratio"))
- field-names)
- "-ratio"))
-
- (scaler-field-name (and (not (method-exists? 'mus-scaler))
- (let ((fld (find-if (lambda (name)
- (or (string=? name "r")
- (string=? name "amplitude")))
- field-names)))
- (and fld (string-append "-" fld)))))
-
- (order-field-name (and (not (method-exists? 'mus-order))
- (let ((fld (find-if (lambda (name)
- (or (string=? name "n")
- (string=? name "order")))
- field-names)))
- (and fld (string-append "-" fld)))))
-
- ;; using append to splice out unwanted entries
- (methods `(append ,original-methods
-
- (if ,phase-field-name
- (list
- (list 'mus-phase
- (lambda (g)
- (,(string->symbol (string-append sname (or phase-field-name "oops"))) g))
- (lambda (g val)
- (set! (,(string->symbol (string-append sname (or phase-field-name "oops"))) g) val))))
- (list))
-
- (if ,frequency-field-name
- (list
- (list 'mus-frequency
- (lambda (g)
- (radians->hz (,(string->symbol (string-append sname (or frequency-field-name "oops"))) g)))
- (lambda (g val)
- (set! (,(string->symbol (string-append sname (or frequency-field-name "oops"))) g) (hz->radians val))
- val)))
- (list))
-
- (if ,offset-field-name
- (list
- (list 'mus-offset
- (lambda (g)
- (,(string->symbol (string-append sname (or offset-field-name "oops"))) g))
- (lambda (g val)
- (set! (,(string->symbol (string-append sname (or offset-field-name "oops"))) g) val)
- val)))
- (list))
-
- (if ,order-field-name
- (list ; not settable -- maybe use mus-length?
- (list 'mus-order
- (lambda (g)
- (,(string->symbol (string-append sname (or order-field-name "oops"))) g))))
- (list))
-
- (if ,scaler-field-name
- (list
- (list 'mus-scaler
- (lambda (g)
- (,(string->symbol (string-append sname (or scaler-field-name "oops"))) g))
- (lambda (g val)
- (set! (,(string->symbol (string-append sname (or scaler-field-name "oops"))) g) val))))
- (list))
-
- (if ,(not (method-exists? 'mus-describe))
- (list
- (list 'mus-describe
- (lambda (g)
- (let ((desc (mus-name g))
- (first-time #t))
- (for-each
- (lambda (field)
- (set! desc (string-append desc
- (format #f "~A~A: ~A"
- (if first-time " " ", ")
- field
- (if (string=? field "frequency")
- (radians->hz ((symbol->value (string->symbol (string-append ,sname "-" field))) g))
- ((symbol->value (string->symbol (string-append ,sname "-" field))) g)))))
- (set! first-time #f))
- (list , at field-names))
- desc))))
- (list))
-
- (if ,(not (method-exists? 'mus-run))
- (list
- (list 'mus-run
- (lambda (g arg1 arg2)
- (,(string->symbol sname) g arg1)))) ; this assumes the run-time function takes two args
- (list))
-
- (if ,(not (method-exists? 'mus-reset))
- (list
- (list 'mus-reset
- (lambda (g)
- (for-each
- (lambda (name type orig)
- (if (or (not (string=? type "clm"))
- (not ((symbol->value (string->symbol (string-append ,sname "-" name))) g)))
- (set! ((string->symbol (string-append ,sname "-" name)) g) orig)
- (mus-reset ((symbol->value (string->symbol (string-append ,sname "-" name))) g))))
- (list , at field-names)
- (list ,@(map symbol->string field-types))
- (list ,@(map (lambda (n)
- (if (and (list? n)
- (>= (length n) 2))
- (cadr n)
- 0.0))
- fields))))))
- (list))
-
- (if ,(not (method-exists? 'mus-name))
- (list
- (list 'mus-name
- (lambda (g)
- ,sname)
- (lambda (g new-name)
- (set-car! (cdr (assoc 'mus-name (g (- (length g) 1))))
- (lambda (g)
- new-name))))) ; depend on closures?
- (list)))))
-
- `(begin
- (define ,(string->symbol (string-append sname "?"))
- (lambda (obj)
- (and (list? obj)
- (eq? (car obj) ',(string->symbol sname)))))
-
- (define ,(string->symbol (string-append sname "-methods"))
- (lambda ()
- ,methods))
-
- (define* (,(string->symbol (string-append "make-" sname))
- ,@(map (lambda (n)
- (if (and (list? n)
- (>= (length n) 2))
- (list (car n) (cadr n))
- (list n 0.0)))
- fields))
- (,wrapper (if (list? ,methods)
- (list ',(string->symbol sname)
- ,@(map string->symbol field-names)
- ,methods)
- (list ',(string->symbol sname)
- ,@(map string->symbol field-names)))))
-
- ,@(map (let ((ctr 1))
- (lambda (n type)
- (let ((val `(define ,(string->symbol (string-append sname "-" n))
- (make-procedure-with-setter
- (lambda (arg)
- "generator field accessor"
- (arg ,ctr))
- (lambda (arg val)
- (list-set! arg ,ctr val))))))
- (add-clm-field sname (string-append sname "-" n) ctr type)
- (set! ctr (+ 1 ctr))
- val)))
- field-names field-types))))
-
-
-(define def-clm-struct defgenerator)
+ (methods (and (pair? struct-name)
+ (or (and (> (length struct-name) 2)
+ (eq? (struct-name 1) :methods)
+ (struct-name 2))
+ (and (= (length struct-name) 5)
+ (eq? (struct-name 3) :methods)
+ (struct-name 4))))))
+ `(begin
+ (define ,(string->symbol (string-append sname "?")) #f)
+ (define ,(string->symbol (string-append "make-" sname)) #f)
+
+ (let ((gen-type ',(string->symbol (string-append "+" sname "+")))
+ (gen-methods (and ,methods (apply inlet ,methods))))
+
+ (set! ,(string->symbol (string-append sname "?"))
+ (lambda (obj)
+ (and (let? obj)
+ (eq? (obj 'mus-generator-type) gen-type))))
+
+ (set! ,(string->symbol (string-append "make-" sname))
+ (lambda* ,(map (lambda (n)
+ (if (pair? n) n (list n 0.0)))
+ fields)
+ (,wrapper
+ (openlet
+ ,(if methods
+ `(sublet gen-methods
+ ,@(list->bindings (reverse fields)) 'mus-generator-type gen-type)
+ `(inlet 'mus-generator-type gen-type ,@(list->bindings fields)))))))))))
@@ -1181,64 +837,23 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
(define (clm-display-globals)
- (format #f ";CLM globals:~%; *clm-srate*: ~A (default: ~A, mus-srate: ~A)~%; *clm-file-name*: ~A~%; *clm-channels: ~A (default: ~A)~%; *clm-data-format*: ~A (default: ~A)~%; *clm-header-type*: ~A (default: ~A)~%; *clm-reverb-channels*: ~A, *clm-reverb-data*: ~A~%; *clm-table-size*: ~A~%; *clm-file-buffer-size*: ~A (~A)~%; *clm-locsig-type*: ~A~%; *clm-array-print-length*: ~A (~A)~%; *clm-notehook*: ~A~%; *clm-default-frequency*: ~A~%; *clm-clipped*: ~A, mus-clipping: ~A, mus-prescaler: ~A~%; *clm-threads*: ~A~%; *clm-output-safety*: ~A~%~%"
+ (format #f ";CLM globals:~%; *clm-srate*: ~A (default: ~A)~%; *clm-file-name*: ~A~%; *clm-channels: ~A (default: ~A)~%; *clm-sample-type*: ~A (default: ~A)~%; *clm-header-type*: ~A (default: ~A)~%; *clm-reverb-channels*: ~A, *clm-reverb-data*: ~A~%; *clm-table-size*: ~A~%; *clm-file-buffer-size*: ~A~%; *clm-locsig-type*: ~A~%; *clm-array-print-length*: ~A (~A)~%; *clm-notehook*: ~A~%; *clm-default-frequency*: ~A~%; *clm-clipped*: ~A, mus-clipping: ~A~%~%"
- *clm-srate* (default-output-srate) (mus-srate)
+ *clm-srate* *default-output-srate*
*clm-file-name*
- *clm-channels* (default-output-chans)
- (mus-data-format->string *clm-data-format*) (mus-data-format->string (default-output-data-format))
- (mus-header-type->string *clm-header-type*) (mus-header-type->string (default-output-header-type))
+ *clm-channels* *default-output-chans*
+ (mus-sample-type->string *clm-sample-type*) (mus-sample-type->string *default-output-sample-type*)
+ (mus-header-type->string *clm-header-type*) (mus-header-type->string *default-output-header-type*)
*clm-reverb-channels* *clm-reverb-data*
*clm-table-size*
- *clm-file-buffer-size* (mus-file-buffer-size)
+ *clm-file-buffer-size*
*clm-locsig-type*
- *clm-array-print-length* (print-length)
+ *clm-array-print-length* *print-length*
*clm-notehook*
*clm-default-frequency*
- *clm-clipped* (mus-clipping)
- (mus-prescaler)
- *clm-threads*
- *clm-output-safety*))
-
-
+ *clm-clipped* (mus-clipping)))
-;;; -------- with-threaded-channels
-
-(define (with-threaded-channels snd func)
- (let ((chns (channels snd)))
- (if (and (provided? 'snd-threads)
- (> chns 1))
-
- (dynamic-wind
-
- (lambda ()
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (set! (squelch-update snd chn) #t)))
-
- (lambda ()
- (let ((threads '()))
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (let ((lchn chn))
- (set! threads (cons (make-thread (lambda ()
- (func snd lchn)))
- threads))))
- (for-each
- (lambda (expr)
- (join-thread expr))
- threads)))
-
- (lambda ()
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (set! (squelch-update snd chn) #f))))
-
- ;; else do it without threads
- (do ((chn 0 (+ 1 chn)))
- ((= chn chns))
- (func snd chn)))))
;;; -------- *clm-search-list*
@@ -1252,7 +867,7 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
(lambda (return)
(for-each
(lambda (path)
- (let ((len (string-length path)))
+ (let ((len (length path)))
(if (> len 0)
(let ((new-name (string-append path (if (not (char=? (path (- len 1)) #\/)) "/" "") name)))
(if (file-exists? new-name)
@@ -1263,17 +878,15 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
#|
(with-sound ()
(let ((fd (make-file->sample "oboe.snd"))
- (len (mus-sound-frames "oboe.snd")))
- (run
- (lambda ()
- (do ((i 0 (+ i 1)))
- ((= i len))
- (outa i (* .5 (file->sample fd i 0))))))))
+ (len (mus-sound-framples "oboe.snd")))
+ (do ((i 0 (+ i 1)))
+ ((= i len))
+ (outa i (* .5 (file->sample fd i 0))))))
|#
(define (mix-notelists . notelists)
- ;; assume the 2nd parameter is the begin time in seconds (the 1st is the instrument name)
+ ;; assume the second parameter is the begin time in seconds (the 1st is the instrument name)
(sort!
(apply append notelists)
(lambda (note1 note2)
@@ -1290,17 +903,20 @@ symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small
|#
-(define* (with-simple-sound-helper thunk (output "test.snd") (channels 1) (srate 44100) (data-format mus-lfloat) (header-type mus-next))
+(define* (with-simple-sound-helper thunk (output "test.snd") (channels 1) (srate 44100) (sample-type mus-lfloat) (header-type mus-next))
(let ((old-output *output*))
(dynamic-wind
(lambda ()
- (set! *output* (make-sample->file output channels data-format header-type "with-simple-sound output")))
+ (if (string? output)
+ (set! *output* (make-sample->file output channels sample-type header-type "with-simple-sound output"))
+ (set! *output* output)))
(lambda ()
(thunk)
output)
(lambda ()
- (mus-close *output*)
+ (if (string? output)
+ (mus-close *output*))
(set! *output* old-output)))))
-(defmacro with-simple-sound (args . body)
+(define-macro (with-simple-sound args . body)
`(with-simple-sound-helper (lambda () , at body) , at args))
diff --git a/wz_data.js b/wz_data.js
deleted file mode 100644
index d8ba011..0000000
--- a/wz_data.js
+++ /dev/null
@@ -1,1465 +0,0 @@
-var extsnd_addmark_tip = "<code>(add-mark samp snd chn name (sync 0))</code>:<br>" +
- " add a mark at sample 'samp' returning the mark id.";
-
-var extsnd_addsoundfileextension_tip = "<code>(add-sound-file-extension ext)</code>:<br>" +
- " add the file extension 'ext' to the list of sound file extensions";
-
-var extsnd_addtomenu_tip = "<code>(add-to-menu menu label func position)</code>:<br>" +
- " add label to menu (a main menu index),<br>" +
- " invoke func (a function of no args) when the new menu is activated.<br>" +
- " Return the new menu label widget.";
-
-var extsnd_addtransform_tip = "<code>(add-transform name x-label low high func)</code>:<br>" +
- " add the transform func to the transform lists;<br>" +
- " func should be a function of two arguments, <br>" +
- " the length of the transform and a sampler to get the data, <br>" +
- " and should return a vct containing the transform results. <br>" +
- " name is the transform's name, x-label is its x-axis label, <br>" +
- " and the relevant returned data to be displayed goes from low to high (normally 0.0 to 1.0)";
-
-var extsnd_afterapplycontrolshook_tip = "<code>after-apply-controls-hook (snd)</code>: called when apply-controls finishes.";
-
-var extsnd_aftergraphhook_tip = "<code>after-graph-hook (snd chn)</code>: called after a graph is updated.";
-
-var extsnd_afteropenhook_tip = "<code>after-open-hook (snd)</code>: called just before the new file's window is displayed.<br>" +
- " This provides a way to set various sound-specific defaults. <pre>" +
- " (add-hook! after-open-hook<br>" +
- " (lambda (snd) <br>" +
- " (if (> (channels snd) 1) <br>" +
- " (set! (channel-style snd) channels-combined))))</pre>";
-
-var extsnd_aftersaveashook_tip = "<code>after-save-as-hook (saved-sound-index save-as-full-filename from-save-as-dialog)</code>:<br>" +
- " called upon File:Save as or save-sound-as completion.";
-
-var extsnd_aftersavestatehook_tip = "<code>after-save-state-hook (filename)</code>: called after Snd state has been saved;<br>" +
- " filename is the save state file.";
-
-var extsnd_aftertransformhook_tip = "<code>after-transform-hook (snd chn scaler)</code>: called just after a spectrum is calculated.";
-
-var extsnd_ampcontrol_tip = "<code>(amp-control snd chn)</code>: current amp slider setting";
-
-var extsnd_applycontrols_tip = "<code>(apply-controls snd (choice 0) (beg 0) (dur len))</code>:<br>" +
- " applies the current control panel state as an edit. <br>" +
- " The 'choices' are 0 (apply to sound), 1 (apply to channel), and 2 (apply to selection).<br>" +
- " If 'beg' is given, the apply starts there.";
-
-var extsnd_asoneedit_tip = "<code>(as-one-edit thunk origin)</code>: evaluate thunk,<br>" +
- " collecting all edits into one from the edit history's point of view";
-
-var extsnd_axisinfo_tip = "<code>(axis-info snd chn (ax time-graph))</code>: info about axis:<br>" +
- "<pre> (list losamp hisamp x0 y0 x1 y1 xmin ymin xmax ymax pix_x0 pix_y0 pix_x1 pix_y1<br>" +
- " y_offset xscale yscale xlabel ylabel new-peaks)</pre>";
-
-var extsnd_axislabelfont_tip = "<code>(axis-label-font)</code>: font used for axis labels";
-
-var extsnd_axisnumbersfont_tip = "<code>(axis-numbers-font)</code>: font used for axis numbers";
-
-var extsnd_badheaderhook_tip = "<code>bad-header-hook (filename)</code>: called if a file has some bogus-looking header.<br>" +
- " Return #t to give up on that file.";
-
-var extsnd_basiccolor_tip = "<code>(basic-color)</code>: Snd's basic color";
-
-var extsnd_beatsperminute_tip = "<code>(beats-per-minute snd chn)</code>: beats per minute if x-axis-style is x-axis-in-beats";
-
-var extsnd_beforeclosehook_tip = "<code>before-close-hook (snd)</code>: called each time a file is closed (before the close).<br>" +
- " If it returns #t, the file is not closed.";
-
-var extsnd_beforeexithook_tip = "<code>before-exit-hook ()</code>: called upon exit. If it returns #t, Snd does not exit.<br>" +
- " This can be used to check for unsaved edits.";
-
-var extsnd_beforesaveashook_tip = "<code>before-save-as-hook (index filename selection srate type format comment)</code>:<br>" +
- " called before File:Save as or save-sound-as. Provides a way to fixup a sound just before it is saved.";
-
-var extsnd_beforesavestatehook_tip = "<code>before-save-state-hook (filename)</code>: called before Snd state is saved.<br>" +
- " If the hook functions return #t, the save state process opens 'filename' for appending, rather than truncating.";
-
-var extsnd_besj0_tip = "<code>(bes-j0 x) returns the Bessel function J0(x)";
-
-var extsnd_bindkey_tip = "<code>(bind-key key modifiers func extended origin prefs-info)</code>:<br>" +
- " causes 'key' (an integer, character, or string) when typed with 'modifiers'<br>" +
- " (0:none, 4:control, 8:meta) (and C-x if extended) to invoke 'func', a function of zero or one arguments.<br>" +
- " If the function takes one argument, it is passed the preceding C-u number, if any.<br>" +
- " The function should return one of the cursor choices (e.g. keyboard-no-action).<br>" +
- " 'origin' is the name reported if an error occurs.<br>" +
- " The 'key' argument can be the X/Gtk name of the key (e.g. \"plus\" for \"+\" or \"Home\"),<br>" +
- " the character on the key (#\x07), or the integer corresponding to that character:<br>" +
- " (\"(char->integer #\x07)\" in Scheme, or \"?a\" in Ruby.";
-
-var extsnd_boldpeaksfont_tip = "<code>(bold-peaks-font)</code>: bold font used by fft peak display";
-
-var extsnd_channels_tip = "<code>(channels snd)</code>: how many channels snd has";
-
-var extsnd_channelstyle_tip = "<code>(channel-style snd)</code>: how multichannel sounds lay out the channels.<br>" +
- " The default is channels-combined; other values are channels-separate and channels-superimposed.<br>" +
- " As a global (if the 'snd' arg is omitted), it is the default setting for each sound's 'unite' button.";
-
-var extsnd_channeltovct_tip = "<code>(channel->vct beg dur snd chn edpos)</code>: return a vct with the specified samples.";
-
-var extsnd_channelwidgets_tip = "<code>(channel-widgets snd chn)</code>: a list of widgets: ((0)graph (1)w (2)f (3)sx (4)sy (5)zx (6)zy (7)edhist)";
-
-var extsnd_chans_tip = "<code>(channels snd)</code>: how many channels snd has";
-
-var extsnd_clearminibuffer_tip = "<code>(clear-minibuffer snd)</code>: clears snd's minibuffer (erasing any error message as well).";
-
-var extsnd_cliphook_tip = "<code>clip-hook (clipping-value)</code> is called each time a sample is about to be clipped<br>" +
- " upon being written to a sound file. The hook function can return the new value to be written,<br>" +
- " or rely on the default (-1.0 or 1.0 depending on the sign of 'clipping-value').";
-
-var extsnd_clmchannel_tip = "<code>(clm-channel gen (beg 0) (dur len) snd chn edpos (overlap 0) origin)</code>:<br>" +
- " apply gen to snd's channel chn starting at beg for dur samples.<br>" +
- " overlap is the 'ring' time, if any.";
-
-var extsnd_closehook_tip = "<code>close-hook (snd)</code>: called each time a file is closed (before the close).";
-
-var extsnd_closesound_tip = "<code>(close-sound snd)</code>: close snd";
-
-var extsnd_comment_tip = "<code>(comment snd)</code>: snd's comment (in its header)";
-
-var extsnd_countmatches_tip = "<code>(count-matches func (start-samp 0) snd chn edpos)</code>:<br>" +
- " return how many samples satisfy func (a function of one argument,<br>" +
- " the current sample, returning #t upon match):<br>" +
- " <code>(count-matches (lambda (y) (> y .1)))</code>";
-
-var extsnd_cursor_tip = "<code>(cursor snd chn edpos)</code>: current cursor location in snd's channel chn";
-
-var extsnd_cursorcontext_tip = "graphics context for the cursor";
-
-var extsnd_dachook_tip = "<code>dac-hook (sdobj)</code>: called just before data is sent to DAC passing data as sound-data object";
-
-var extsnd_dacsize_tip = "<code>(dac-size)</code>: the current DAC buffer size in frames (256)";
-
-var extsnd_datacolor_tip = "<code>(data-color)</code>: color used to draw unselected data";
-
-var extsnd_dataformat_tip = "<code>(data-format snd)</code>: snd's data format (e.g. mus-bshort)";
-
-var extsnd_datalocation_tip = "<code>(data-location snd)</code>: snd's data location (bytes)";
-
-var extsnd_declare_tip = "Functions embedded within run may need to declare the type of their arguments;<br>" +
- " run assumes each variable has one type (integer by default) throughout its life.<br>" +
- " So, the following code displays \"0\", rather than \"3.14\":<br><br>" +
- " <code> (run (let ((x 3.14)) (define (a b) (display b)) (a x)))</code><br><br>" +
- " The \"b\" argument to \"a\" is assumed to be an integer, and passing in a float<br>" +
- " causes nothing but confusion. To get this code to work right:<br><br>" +
- " <code> (run (let ((x 3.14)) (define (a b) (<b>declare</b> (b real)) (display b)) (a x)))</code><br><br>" +
- " The current declarable types include:<br><br>" +
- " <code> int float boolean char string list symbol keyword vct sampler mix-sampler</code><br>" +
- " <code> sound-data clm float-vector int-vector vct-vector list-vector clm-vector</code>";
-
-var extsnd_defineenvelope_tip = "<code>(define-envelope name data)</code>: define 'name' to have the value 'data'<br>" +
- " (a list of breakpoints), and load it into the envelope editor.";
-
-var extsnd_defvar_tip = "<code>(defvar name data)</code>: define 'name' to have the value 'data'<br>" +
- " (a list of breakpoints), and load it into the envelope editor.";
-
-var extsnd_deletesamples_tip = "<code>(delete-samples start-samp samps snd chn edpos)</code>:<br>" +
- " delete 'samps' samples from snd's channel chn starting at 'start-samp'";
-
-var extsnd_dialogwidgets_tip = "<code>(dialog-widgets)</code>: dialog widgets (each #f if not yet created)</code>:<br>" +
- " <code>(list (0 color-dialog) (1 orientation-dialog) (2 enved-dialog)<br>" +
- " (3 #f) (4 #f) (5 transform-dialog) (6 open-file-dialog) (7 save-sound-dialog)<br>" +
- " (8 view-files-dialog) (9 raw data dialog) (10 new file dialog)<br>" +
- " (11 mix-file-dialog) (12 edit-header-dialog) (13 find-dialog)<br>" +
- " (14 help-dialog) (15 listener completion) (16 view-mixes-dialog)<br>" +
- " (17 print-dialog) (18 recorder-dialog) (19 view-regions-dialog)<br>" +
- " (20 info-dialog) (21 #f) (22 save-selection-dialog)<br>" +
- " (23 insert-file-dialog) (24 save-region-dialog) (25 preferences-dialog))</code>";
-
-var extsnd_dotsize_tip = "<code>(dot-size snd chn)</code>: size in pixels of dots when graphing with dots (1)";
-
-var extsnd_drawline_tip = "<code>(draw-line x0 y0 x1 y1 snd chn (ax time-graph))</code>: draw a line";
-
-var extsnd_drawstring_tip = "<code>(draw-string text x0 y0 snd chn (ax time-graph))</code>: draw a string";
-
-var extsnd_duringopenhook_tip = "<code>during-open-hook (fd name reason)</code>:<br>" +
- " called after file is opened, but before data has been read.<br>" +
- "<pre> (add-hook! during-open-hook<br>" +
- " (lambda (fd name reason) <br>" +
- " (if (= (mus-sound-header-type name) mus-raw)<br>" +
- " (set! (mus-file-prescaler fd) 500.0))))</pre>";
-
-var extsnd_editfragment_tip = "<code>(edit-fragment (ctr current-edit-position) snd chn)</code>:<br>" +
- " edit history entry at ctr associated with snd's channel chn;<br>" +
- " the returned value is a list (origin type start-sample samps)";
-
-var extsnd_editposition_tip = "<code>(edit-position snd chn)</code>: current edit history position in snd's channel chn";
-
-var extsnd_edits_tip = "<code>(edits snd chn)</code>: <br>" +
- "returns <code>(list undoable-edits redoable-edits)</code> in snd's channel chn";
-
-var extsnd_emarks_tip = "<code>(marks snd chn edpos)</code>: list of marks (ids) in snd/chn<br>" +
- " at edit history position pos. mark list is: <br>" +
- " if channel given: (id id ...), <br>" +
- " if snd given: ((id id) (id id ...)), <br>" +
- " if neither given: (((id ...) ...) ...).";
-
-var extsnd_envchannel_tip = "<code>(env-channel env-gen-or-envelope (beg 0) (dur len) snd chn edpos)</code>:<br>" +
- " apply amplitude envelope to snd's channel chn starting at beg for dur samples.";
-
-var extsnd_envedtarget_tip = "<code>(enved-target)</code>: determines how the envelope edit envelope is applied:<br>" +
- " enved-amplitude, enved-srate (apply to speed), and enved-spectrum (apply as a filter).";
-
-var extsnd_envedwaving_tip = "<code>(enved-wave?)</code>: #t if the envelope editor is displaying the waveform to be edited";
-
-var extsnd_envsound_tip = "<code>(env-sound env (start-samp 0) (samps len) (env-base 1.0) snd chn edpos)</code>:<br>" +
- " apply an amplitude envelope (a list of breakpoints or a CLM env) to snd's channel chn<br>" +
- " starting at start-samp, going either to the end of the sound or for samps samples,<br>" +
- " with segments interpolating according to env-base (1 = linear).";
-
-var extsnd_envselection_tip = "<code>(env-selection env (env-base 1.0))</code>:<br>" +
- " apply envelope to the selection using env-base to determine how breakpoints are connected";
-
-var extsnd_eregions_tip = "<code>(regions)</code>: current active regions (a list of region ids)";
-
-var extsnd_exit_tip = "<code>(exit)</code>: exit Snd";
-
-var extsnd_exithook_tip = "<code>exit-hook ()</code>: called upon exit. This can be used to perform cleanup activities.";
-
-var extsnd_expandcontrol_tip = "<code>(expand-control snd)</code>: current expand slider setting";
-
-var extsnd_expandcontrolp_tip = "<code>(expand-control? snd)</code>: snd's control panel expand button state";
-
-var extsnd_filename_tip = "<code>(file-name snd)</code>: snd's full filename";
-
-var extsnd_fillrectangle_tip = "<code>(fill-rectangle x0 y0 width height snd chn (ax time-graph) erase)</code>: draw a filled rectangle";
-
-var extsnd_filterchannel_tip = "<code>(filter-channel env order beg dur snd chn edpos (truncate #t) origin)</code>:<br>" +
- " applies an FIR filter to snd's channel chn.<br>" +
- " 'env' is the frequency response envelope, or a vct with the coefficients.";
-
-var extsnd_filterselection_tip = "<code>(filter-selection filter order (truncate #t))</code>:<br>" +
- " apply filter to selection.<br>" +
- " If truncate, cut off filter output at end of selection, else mix";
-
-var extsnd_filtersound_tip = "<code>(filter-sound filter order snd chn edpos origin)</code>:<br>" +
- " applies FIR filter to snd's channel chn.<br>" +
- " 'filter' is either the frequency response envelope,<br>" +
- " a CLM filter, or a vct with the actual coefficients";
-
-var extsnd_findchannel_tip = "<code>(find-channel func (start-samp 0) snd chn edpos)</code>:<br>" +
- " apply func, a function of one argument, the current sample,<br>" +
- " to each sample in snd's channel chn, starting at 'start-samp'<br>" +
- " until func returns something other than #f: <br>" +
- " <code> (find-channel (lambda (y) (> y .1)))</code>";
-
-var extsnd_focuswidget_tip = "<code>(focus-widget widget)</code>: cause widget to receive input focus";
-
-var extsnd_frames_tip = "<code>(frames snd chn edpos)</code>: number of frames of data in snd's channel chn";
-
-var extsnd_freesampler_tip = "<code>(free-sampler reader)</code>: free a sampler (of any kind)";
-
-var extsnd_gin_tip = "<code>(in msecs thunk)</code>: invoke thunk in msecs milliseconds (named call_in in Ruby)";
-
-var extsnd_graph_tip = "<code>(graph data xlabel (x0 0.0) (x1 1.0) y0 y1 snd chn (force-display #t) show-axes)</code>:<br>" +
- " displays 'data' as a graph with x axis label 'xlabel', axis units going from x0 to x1 and y0 to y1;<br>" +
- " 'data' can be a list or a vct. If 'data' is a list of numbers, it is treated as an envelope.";
-
-var extsnd_graphhook_tip = "<code>graph-hook (snd chn y0 y1)</code>: called each time a graph is about to be updated. <br>" +
- "If it returns #t, the display is not updated.";
-
-var extsnd_graphonce_tip = "<code>graph-once</code> is the default value of the graph types (time-graph-type and transform-graph-type).";
-
-var extsnd_graphshorizontal_tip = "<code>(graphs-horizontal snd chn)</code>:<br>" +
- " #t if the time domain, fft, and lisp graphs are layed out horizontally";
-
-var extsnd_graphstyle_tip = "<code>(graph-style snd chn)</code>: graph style, <br>" +
- " one of <code>graph-lines graph-dots graph-dots-and-lines graph-lollipops graph-filled</code>";
-
-var extsnd_headertype_tip = "<code>(header-type snd)</code>: snd's header type (e.g. <code>mus-aiff</code>)";
-
-var extsnd_helpdialog_tip = "<code>(help-dialog subject message xrefs urls)</code>: start the Help window with subject and message";
-
-var extsnd_hidewidget_tip = "<code>(hide-widget widget)</code>: hide or undisplay widget";
-
-var extsnd_highlightcolor_tip = "<code>(highlight-color)</code>: color of highlighted text or buttons";
-
-var extsnd_infodialog_tip = "<code>(info-dialog subject message)</code>: start the Info window with subject and message";
-
-var extsnd_initialgraphhook_tip = "<code>initial-graph-hook (snd chn dur)</code>:<br>" +
- " called when a sound is displayed for the first time";
-
-var extsnd_insertsound_tip = "<code>(insert-sound file (beg 0) (file-chan 0) snd chn edpos auto-delete)</code>:<br>" +
- " insert channel file-chan of file (or all chans if file-chan is not given)<br>" +
- " into snd's channel chn at beg or at the cursor position.<br>" +
- "<code> (insert-sound \"oboe.snd\" 1000)</code><br>" +
- " inserts all of oboe.snd starting at sample 1000.";
-
-var extsnd_justsounds_tip = "<code>(just-sounds)</code>: the 'just sounds' choice in the file chooser dialog";
-
-var extsnd_keyboard_no_action_tip = "<code>keyboard-no-action</code> is one of the <code>bind-key</a> function<br>" +
- "return values. It indicates that Snd should not update the graphs.";
-
-var extsnd_leftsample_tip = "<code>(left-sample snd chn)</code>: left sample number in time domain window";
-
-var extsnd_lispgraph_tip = "the <code>lisp-graph</code> is the 3rd graph displayed in the channel graphs.";
-
-var extsnd_lispgraphhook_tip = "<code>lisp-graph-hook (snd chn)</code>: called just before the lisp graph is updated.<br>" +
- " If it returns a list of pixels, these are used in order by the list of graphs<br>" +
- " (if any), rather than Snd's default set; this makes it possible to use different<br>" +
- " colors for the various graphs. If it returns a function (of no arguments),<br>" +
- " that function is called rather than the standard graph routine.";
-
-var extsnd_listenerfont_tip = "<code>(listener-font)</code>: font used by the lisp listener";
-
-var extsnd_listenerprompt_tip = "<code>(listener-prompt)</code>: the current lisp listener prompt character ('>') ";
-
-var extsnd_listtovct_tip = "<code>(list->vct lst)</code>: returns a new vct filled with elements of list lst";
-
-var extsnd_mainwidgets_tip = "<code>(main-widgets)</code>: top level widgets<br>" +
- " <code>(list (0)main-app (1)main-shell (2)main-pane<br>" +
- " (3)sound-pane (4)listener-pane (5)notebook-outer-pane)</code>";
-
-var extsnd_makecolor_tip = "<code>(make-color r g b)</code>: return a color object with the indicated rgb values";
-
-var extsnd_makegraphdata_tip = "<code>(make-graph-data snd chn edpos low high)</code>:<br>" +
- " return either a vct (if the graph has one trace), or a list of two vcts<br>" +
- " (the two sides of the envelope graph).<br>" +
- " 'edpos' defaults to the current-edit-position,<br>" +
- " 'low' defaults to the current window left sample, and<br>" +
- " 'high' defaults to the current rightmost sample.<br>" +
- " <code>(graph-data (make-graph-data))</code> reimplements the time domain graph.";
-
-var extsnd_makemixsampler_tip = "<code>(make-mix-sampler id (beg 0))</code>:<br>" +
- " return a reader ready to access mix id";
-
-var extsnd_makesampler_tip = "<code>(make-sampler (start-samp 0) snd chn (dir 1) edpos)</code>:<br>" +
- " return a reader ready to access snd's channel chn's data starting at start-samp,<br>" +
- " going in direction dir (1 = forward, -1 = backward),<br>" +
- " reading the version of the data indicated by edpos which defaults to the current version.<br>" +
- " snd can be a filename, or a sound index number.";
-
-var extsnd_makesounddata_tip = "<code>(make-sound-data chans frames)</code>: return a new sound-data object<br>" +
- " with 'chans' channels, each having 'frames' samples";
-
-var extsnd_makevct_tip = "<code>(make-vct len (initial-element 0))</code>: <br>" +
- " returns a new vct of length len filled with initial-element:<br>" +
- "<code> (define v (make-vct 32 1.0))</code>";
-
-var extsnd_mapchannel_tip = "<code>(map-channel func (start 0) (dur len) snd chn edpos edname)</code>:<br>" +
- " apply func to samples in current channel;<br>" +
- " edname is the edit history name for this editing operation.<br>" +
- "<code> (map-channel (lambda (y) (* y 2.0)))</code>";
-
-var extsnd_markclickhook_tip = "<code>mark-click-hook (id)</code>: called when a mark is clicked;<br>" +
- " return #t to squelch the default message.";
-
-var extsnd_markdraghook_tip = "<code>mark-drag-hook (id)</code>: called when a mark is dragged";
-
-var extsnd_markhome_tip = "<code>(mark-home id)</code>: the sound (index) and channel that hold mark id";
-
-var extsnd_markname_tip = "<code>(mark-name id)</code>: mark's name";
-
-var extsnd_marksample_tip = "<code>(mark-sample id pos)</code>: mark's location (sample number) at edit history pos";
-
-var extsnd_marksync_tip = "<code>(mark-sync id)</code>: mark's sync value (default: 0)";
-
-var extsnd_marksyncmax_tip = "<code>(mark-sync-max)</code>: max mark sync value seen so far";
-
-var extsnd_maxamp_tip = "<code>(maxamp snd chn edpos)</code>: maxamp of data in snd's channel chn";
-
-var extsnd_mix_tip = "<code>(mix file (beg 0) (file-chan 0) snd chn (with-tag with-mix-tags) auto-delete)</code>:<br>" +
- " mix channel file-chan of file into snd's channel chn starting at beg (in the output),<br>" +
- " returning the new mix's id. if with-tag is #f, no draggable tag is created. <br>" +
- " If auto-delete is #t, the input file is deleted when it is no longer needed.";
-
-var extsnd_mixamp_tip = "<code>(mix-amp id)</code>: mix's scaler";
-
-var extsnd_mixcolor_tip = "<code>(mix-color mix-id)</code>: color of all mix tags<br>" +
- " (if mix-id is omitted), or of mix-id's tag";
-
-var extsnd_mixposition_tip = "<code>(mix-position id)</code>: mix's begin time in the output in samples";
-
-var extsnd_mixreleasehook_tip = "<code>mix-release-hook (mix-id samps)</code>:<br>" +
- " called after the mouse has dragged a mix to some new position.<br>" +
- " 'samps' = samples moved in the course of the drag.<br>" +
- " If the hook returns #t, the actual remix is the hook's responsibility.";
-
-var extsnd_mixsamplerQ_tip = "<code>(mix-sampler? obj)</code>: #t if obj is a mix-sampler";
-
-var extsnd_mixselection_tip = "<code>(mix-selection (beg 0) snd chn (selection-channel #t))</code>:<br>" +
- " mix the currently selected portion starting at beg";
-
-var extsnd_mixsync_tip = "<code>(mix-sync id)</code>: mix sync field (an integer)";
-
-var extsnd_mixsyncmax_tip = "<code>(mix-sync-max)</code>: max mix sync value seen so far";
-
-var extsnd_mixtagy_tip = "<code>(mix-tag-y id)</code>: height of mix's tag";
-
-var extsnd_musaudioclose_tip = "<code>(mus-audio-close line)</code>: close the audio hardware line";
-
-var extsnd_musaudioopenoutput_tip = "<code>(mus-audio-open-output device srate chans format bytes)</code>:<br>" +
- " open the audio device ready for output at the given srate and so on;<br>" +
- " return the audio line number:<br>" +
- "<code> (mus-audio-open-output mus-audio-default 22050 1 mus-lshort 256)</code>";
-
-var extsnd_musaudiowrite_tip = "<code>(mus-audio-write line sdata frames)</code>:<br>" +
- " write frames of data (channels * frames = samples) to the audio line from sound-data sdata.";
-
-var extsnd_musbfloat_tip = "<code>mus-bfloat</code> data is big-endian float";
-
-var extsnd_musbshort_tip = "<code>mus-bshort</code> data is big-endian signed 16-bit integer";
-
-var extsnd_musdataformatname_tip = "<code>(mus-data-format-name format)</code>: data format (e.g. mus-bshort) as a string";
-
-var extsnd_musfileprescaler_tip = "sometimes sound files sample values are so small that they need<br>" +
- "to be boosted before Snd uses them.";
-
-var extsnd_musheadertypename_tip = "<code>(mus-header-type-name type)</code>: header type (e.g. mus-aiff) as a string";
-
-var extsnd_muslfloat_tip = "<code>mus-lfloat</code> data is little-endian float";
-
-var extsnd_muslshort_tip = "<code>mus-lshort</code> data is little-endian signed 16-bit integer";
-
-var extsnd_musraw_tip = "<code>mus-raw</code> means 'no header'; see header-type.";
-
-var extsnd_musosssetbuffers_tip = "<code>(mus-oss-set-buffers num size)</code>: set Linux OSS 'fragment' number and size.<br>" +
- " If Snd's controls seem sluggish, try <code>(mus-oss-set-buffers 4 12)</code><br>" +
- " or even <code>(mus-oss-set-buffers 2 12)</code>.<br>" +
- " This reduces the on-card buffering, but may introduce clicks.";
-
-var extsnd_mussoundchans_tip = "<code>(mus-sound-chans filename)</code>: channels of data in sound file";
-
-var extsnd_mussoundcloseinput_tip = "<code>(mus-sound-close-input fd)</code>: close (low-level) file fd that was opened by mus-sound-open-input.";
-
-var extsnd_mussoundcomment_tip = "<code>(mus-sound-comment filename)</code>: comment (a string) found in sound file's header";
-
-var extsnd_mussounddataformat_tip = "<code>(mus-sound-data-format filename)</code>: data format (e.g. mus-bshort) of data in sound file";
-
-var extsnd_mussoundduration_tip = "<code>(mus-sound-duration filename)</code>: duration (in seconds) of sound file";
-
-var extsnd_mussoundframes_tip = "<code>(mus-sound-frames filename)</code>: frames (samples / channel) in sound file";
-
-var extsnd_mussoundheadertype_tip = "<code>(mus-sound-header-type filename)</code>: header type (e.g. mus-aifc) of sound file";
-
-var extsnd_mussoundloopinfo_tip = "<code>(mus-sound-loop-info filename)</code>: synth loop info for sound as a list:<br>" +
- "<code> (start1 end1 start2 end2 base-note base-detune mode1 mode2)</code>";
-
-var extsnd_mussoundmaxamp_tip = "<code>(mus-sound-maxamp filename)</code>: maxamps in sound<br>" +
- " (a list of paired amps (as floats) and locations (in samples))";
-
-var extsnd_mussoundmaxampexists_tip = "<code>(mus-sound-maxamp-exists? filename)</code>: #t if sound's maxamp data is available;<br>" +
- " if it isn't, a call on mus-sound-maxamp has to open and read the data to get the maxamp.";
-
-var extsnd_mussoundopeninput_tip = "<code>(mus-sound-open-input filename)</code>: open filename for (low-level) sound input,<br>" +
- " return file descriptor (an integer)";
-
-var extsnd_mussoundread_tip = "<code>(mus-sound-read fd beg end chans sdata)</code>: read sound data from file fd,<br>" +
- " filling sound-data sdata's buffers starting at beg (buffer location), going to end";
-
-var extsnd_mussoundsamples_tip = "<code>(mus-sound-samples filename)</code>: samples (frames * channels) in sound file";
-
-var extsnd_mussoundsrate_tip = "<code>(mus-sound-srate filename)</code>: sampling rate of sound file";
-
-var extsnd_nameclickhook_tip = "<code>name-click-hook (snd)</code>: called when sound name clicked.<br>" +
- " If it returns #t, the usual informative minibuffer babbling is squelched.";
-
-var extsnd_newsound_tip = "<code>(new-sound :file :header-type :data-format :srate :channels :comment :size)</code>:<br>" +
- " creates a new sound file with the indicated attributes; if any are omitted,<br>" +
- " the corresponding default-output variable is used. <br>" +
- " The 'size' argument sets the number of samples (zeros) in the newly created sound.<br>" +
- "<code> (new-sound \"test.snd\" mus-next mus-bshort 22050 1 \"no comment\" 1000)</code>";
-
-var extsnd_nextsample_tip = "<code>(next-sample reader)</code>: next sample from reader";
-
-var extsnd_normalizefft_tip = "<code>(transform-normalization snd chn)</code>:<br>" +
- " decides whether spectral data is normalized before display;<br>" +
- " can be dont-normalize, normalize-by-channel (default), normalize-by-sound, or normalize-globally.";
-
-var extsnd_openfiledialog_tip = "<code>(open-file-dialog (managed #t))</code>:<br>" +
- " create the file dialog if needed and display it if 'managed'";
-
-var extsnd_openhook_tip = "<code>open-hook (filename)</code>: called each time a file is opened<br>" +
- " (before the actual open). If it returns #t, the file is not opened.";
-
-var extsnd_openrawsoundhook_tip = "<code>open-raw-sound-hook (filename current-choices)</code>:<br>" +
- " called when a headerless sound file is opened.<br>" +
- " Its result can be a list describing the raw file's attributes <br>" +
- " (thereby bypassing the Raw File Dialog and so on).<br>" +
- " The list (passed to subsequent hook functions as 'current-choice')<br>" +
- " is interpreted as <code>(list chans srate data-format data-location data-length)</code><br>" +
- " where trailing elements can be omitted (location defaults to 0,<br>" +
- " and length defaults to the file length in bytes).";
-
-var extsnd_opensound_tip = "<code>(open-sound filename)</code>: open filename <br>" +
- " (as if opened from File:Open menu option), and return the new sound's index";
-
-var extsnd_optimizationhook_tip = "<code>optimization-hook (msg)</code>: called if the run macro encounters something it can't optimize.<br>" +
- " 'msg' is a string description of the offending form:<br>" +
- "<code> (add-hook! optimization-hook (lambda (msg) (snd-print msg)))</code>.<br>" +
- " You can often slightly rewrite the form to make run happy.";
-
-var extsnd_padchannel_tip = "<code>(pad-channel beg dur snd chn edpos)</code>: insert dur zeros at beg in snd's chn";
-
-var extsnd_peaksfont_tip = "<code>(peaks-font)</code>: normal font used by fft peak display";
-
-var extsnd_play_tip = "<code>(play object :start :end :channel :edit-position :out-channel :with-sync :wait :stop):<br>" +
- " play the object from start to end.<br>" +
- " If channel is not given, play all channels.<br>" +
- " If with-sync, play all objects sync'd to the current object.<br>" +
- " If wait, wait for the play process to finish before going on.<br>" +
- " If out-channel, send the samples to that DAC channel.<br>" +
- " If edit-position, play that member of the edit list.<br>" +
- " If stop, call that function when the play process finishes.<br>" +
- " If object is a string, it is assumed to be a file name.";
-
-var extsnd_playhook_tip = "<code>play-hook (samps)</code>: called each time a buffer is sent to the DAC.";
-
-var extsnd_positiontox_tip = "<code>(position->x val snd chn (ax time-graph))</code>: x axis value corresponding to pixel val";
-
-var extsnd_previoussample_tip = "<code>(previous-sample reader)</code>: previous sample from reader";
-
-var extsnd_promptinminibuffer_tip = "<code>(prompt-in-minibuffer msg callback snd raw)</code>:<br>" +
- " post msg in snd's minibuffer then when the user eventually responds,<br>" +
- " invoke the function callback, if any, with the response.<br>" +
- " If 'raw' is #t, the response is passed as a string to the prompt callback function;<br>" +
- " otherwise it is evaluated first as Scheme code.<br>" +
- "<code> (prompt-in-minibuffer \"what?\" (lambda (response) (snd-print response)))</code>";
-
-var extsnd_ptreechannel_tip = "<code>(ptree-channel proc (beg 0) (dur len) snd chn edpos peak-env-also init-func origin)</code>:<br>" +
- " apply 'proc' as a 'virtual edit';<br>" +
- " that is, the effect of 'proc' (a function of one argument, the current sample, if init-func is not specified),<br>" +
- " comes about as an implicit change in the way the data is read. This is similar to scaling and some envelope<br>" +
- " operations in that no data actually changes. If 'peak-env-also' is #t, the same function is applied to the peak<br>" +
- " env values to get the new version. If 'proc' needs some state, it can be supplied in a vct returned by 'init-func'.<br>" +
- " 'init-func' is a function of 2 or 3 args, the current fragment-relative begin position, the overall fragment duration,<br>" +
- " and optionally the read direction. In this case, 'proc' is a function of 3 args: the current sample, the vct<br>" +
- " returned by 'init-func', and the current read direction.";
-
-var extsnd_readmixsample_tip = "<code>(read-mix-sample reader)</code>: read sample from mix reader";
-
-var extsnd_readonly_tip = "<code>(read-only snd)</code>: whether snd is write-protected";
-
-var extsnd_readsample_tip = "<code>(read-sample reader)</code>: get the next sample from the sampler";
-
-var extsnd_regionframes_tip = "<code>(region-frames (reg 0) (chan 0))</code>: region length in frames";
-
-var extsnd_regionok_tip = "<code>(region? reg)</code>: #t if region is active";
-
-var extsnd_regularizedargs_tip = "The \"regularized\" functions take arguments in the order<br>" +
- " begin time, duration (not end sample), sound index, channel number, and edit position.";
-
-var extsnd_reportinminibuffer_tip = "<code>(report-in-minibuffer msg snd as-error)</code>:<br>" +
- " display msg in snd's minibuffer.<br>" +
- " If 'as-error' is #t, place the message in the minibuffer's error label.";
-
-var extsnd_restorecontrols_tip = "<code>(restore-controls snd)</code>: restore the previously saved control panel settings";
-
-var extsnd_reversesound_tip = "<code>(reverse-sound snd chn edpos)</code>: reverse snd's channel chn";
-
-var extsnd_revertsound_tip = "<code>(revert-sound snd)</code>: return 'snd' to its unedited state (undo all edits).";
-
-var extsnd_rightsample_tip = "<code>(right-sample snd chn)</code>: right sample number in time domain window";
-
-var extsnd_run_tip = "<code>(run code)</code>: try to optimize the forms (or thunk) passed as its argument,<br>" +
- " then evaluate it; if the optimizer can't handle something in the forms,<br>" +
- " it is passed to Scheme.";
-
-var extsnd_sample_tip = "<code>(sample samp snd chn edpos)</code>:<br>" +
- " return sample samp in snd's channel chn<br>" +
- " (this is a slow access -- use samplers for speed)";
-
-var extsnd_sampleratendQ_tip = "<code>(sampler-at-end? obj)</code>: #t if sampler has reached the end of its data";
-
-var extsnd_samplerposition_tip = "<code>(sampler-position obj)</code>: current (sample-wise) location of sampler";
-
-var extsnd_samples_tip = "<code>(samples (start-samp 0) (samps len) snd chn edpos)</code>:<br>" +
- " return a vct containing snd channel chn's samples starting a start-samp for samps samples;<br>" +
- " edpos is the edit history position to read (defaults to current position).";
-
-var extsnd_savedir_tip = "<code>(save-dir)</code>: name of directory for saved state data (or #f=null)";
-
-var extsnd_savehook_tip = "<code>save-hook (snd name)</code>: called each time a file is about to be saved.<br>" +
- " If it returns #t, the file is not saved.<br>" +
- " 'name' is #f unless the file is being saved under a new name (as in sound-save-as).";
-
-var extsnd_savesound_tip = "<code>(save-sound snd)</code>: save snd<br>" +
- " (update the on-disk data to match Snd's current version)";
-
-var extsnd_savesoundas_tip = "<code>(save-sound-as :file :sound :header-type :data-format :srate :channel :edit-position :comment)</code>:<br>" +
- " save sound in file using the indicated attributes.<br>" +
- " If channel is specified, only that channel is saved (extracted).<br>" +
- " Omitted arguments take their value from the sound being saved.<br>" +
- "<code> (save-sound-as \"test.snd\" index mus-next mus-bshort)</code>";
-
-var extsnd_savestatehook_tip = "<code>save-state-hook (temp-filename)</code>: called each time the save-state<br>" +
- " mechanism is about to create a new temporary file to save some edit history<br>" +
- " sample values. temp-filename is the current file.<br>" +
- " If the hook returns a string, it is treated as the new temp filename.<br>" +
- " This hook provides a way to keep track of which files are in a given<br>" +
- " saved state batch, and a way to rename or redirect those files.";
-
-var extsnd_scaleby_tip = "<code>(scale-by scalers snd chn)</code>: scale snd by scalers (following sync);<br>" +
- " scalers can be a float or a vct/list of floats";
-
-var extsnd_scalechannel_tip = "<code>(scale-channel scaler (beg 0) (dur len) snd chn edpos)</code>:<br>" +
- " scale samples in the given sound/channel between beg and beg + num by scaler.";
-
-var extsnd_scaleselectionby_tip = "<code>(scale-selection-by scalers)</code>: scale selected portion by scalers";
-
-var extsnd_scaleto_tip = "<code>(scale-to (norms 1.0) snd chn)</code>: normalize snd to norms (following sync);<br>" +
- " norms can be a float or a vct/list of floats";
-
-var extsnd_scanchannel_tip = "<code>(scan-channel func (start 0) (dur len) snd chn edpos)</code>:<br>" +
- " apply func to samples in current channel (or the specified channel).<br>" +
- " func is a function of one argument, the current sample.<br>" +
- " if func returns non-#f, the scan stops, and the value is returned to the caller<br>" +
- " with the sample number.<br>" +
- "<code> (scan-channel (lambda (y) (> y .1)))</code>";
-
-var extsnd_scriptarg_tip = "<code>(script-arg)</code>: where we are in the startup arg list";
-
-var extsnd_scriptargs_tip = "<code>(script-args)</code>: the args passed to Snd at startup as a list of strings";
-
-var extsnd_searchprocedure_tip = "<code>(search-procedure snd)</code>: global search function<br>" +
- " (if no 'snd' specified) or sound-local search function";
-
-var extsnd_selectall_tip = "<code>(select-all snd chn)</code>: make a new selection containing all of snd's channel chn.<br>" +
- " If sync is set, all chans are included. <br>" +
- " The new region id is returned (if selection-creates-region is #t).";
-
-var extsnd_selectedchannel_tip = "<code>(selected-channel snd)</code>: currently selected channel in snd (or #f if none)";
-
-var extsnd_selecteddatacolor_tip = "<code>(selected-data-color)</code>: color used for selected data";
-
-var extsnd_selectedgraphcolor_tip = "<code>(selected-graph-color)</code>: background color of selected data";
-
-var extsnd_selectedsound_tip = "<code>(selected-sound)</code>: index of currently selected sound (or #f if none)";
-
-var extsnd_selectioncreatesregion_tip = "<code>(selection-creates-region)</code>: #t if a region should be created each time a selection is made.<br>" +
- " The default is currently #t, but that may change.<br>" +
- " If you're dealing with large selections, and have no need of regions (saved selections),<br>" +
- " you can speed up many operations by setting this flag to #f";
-
-var extsnd_selectionframes_tip = "<code>(selection-frames snd chn)</code>: selection length";
-
-var extsnd_selectionmember_tip = "<code>(selection-member? snd chn)</code>: #t if snd's channel chn is a member of the current selection";
-
-var extsnd_selectionok_tip = "<code>(selection?)</code>: #t if selection is currently active, visible, etc";
-
-var extsnd_selectionposition_tip = "<code>(selection-position snd chn)</code>: selection start samp";
-
-var extsnd_setsamples_tip = "<code>(set-samples start-samp samps data snd chn truncate edname (infile-chan 0) edpos auto-delete)</code>:<br>" +
- " set snd's channel chn's samples starting at start-samp for samps from data (a vct, vector, or string (filename));<br>" +
- " start-samp can be beyond current data end;<br>" +
- " if truncate is #t and start-samp is 0, the end of the file is set to match the new data's end.";
-
-var extsnd_shortfilename_tip = "<code>(short-file-name snd)</code>: short form of snd's file name (no directory)";
-
-var extsnd_showlistener_tip = "<code>(show-listener (open #t))</code>: if 'open' opens the lisp listener;<br>" +
- " returns whether the listener is visible.";
-
-var extsnd_showtransformpeaks_tip = "<code>(show-transform-peaks snd chn)</code>: #t if fft display should include peak list";
-
-var extsnd_sndhelp_tip = "<code>(snd-help (arg 'snd-help) (formatted #t))</code>: return the documentation associated with its argument.<br>" +
- "<code> (snd-help 'make-vct)</code> for example, prints out a brief description of make-vct.<br>" +
- " The argument can be a string, symbol, or in some cases, the object itself.<br>" +
- " In the help descriptions, optional arguments are in parens with the default value (if any) as the 2nd entry.<br>" +
- " A ':' as the start of the argument name marks a CLM-style optional keyword argument. <br>" +
- " If you load index.scm the functions html and ? can be used in place of help to go to the HTML description,<br>" +
- " and the location of the associated C code will be displayed, if it can be found.<br>" +
- " If help-hook is not empty, it is invoked with the subject and the snd-help result and its value is returned.";
-
-var extsnd_sndprint_tip = "<code>(snd-print str)</code>: display str in the listener window";
-
-var extsnd_sndspectrum_tip = "<code>(snd-spectrum data (window rectangular-window) (len data-len)<br>" +
- " (linear #t) (beta 0.0) in-place (normalized #t))</code>:<br>" +
- " magnitude spectrum of data (a vct), in data if in-place, using fft-window win and fft length len.";
-
-var extsnd_sndtempnam_tip = "<code>(snd-tempnam)</code>: return a new temp file name using temp-dir.";
-
-var extsnd_sounddataref_tip = "<code>(sound-data-ref sd chan i)</code>: sample in channel chan at location i of sound-data sd:<br>" +
- " sd[chan][i]";
-
-var extsnd_sounddataset_tip = "<code>(sound-data-set! sd chan i val)</code>: set sound-data sd's i-th element in channel chan to val:<br>" +
- " sd[chan][i] = val";
-
-var extsnd_sounddata_times_tip = "<code>(sound-data* val1 val2)</code>: multiply val1 by val2 (either or both can be a sound-data object).";
-
-var extsnd_soundfilep_tip = "<code>(sound-file? name)</code>: #t if name has a known sound file extension";
-
-var extsnd_soundfilesindirectory_tip = "<code>(sound-files-in-directory (directory \".\"))</code>:<br>" +
- " return a list of the sound files in 'directory'";
-
-var extsnd_soundp_tip = "<code>(sound? (index 0))</code>: #t if sound associated with 'index' is active (accessible)";
-
-var extsnd_sounds_tip = "<code>(sounds)</code>: list of active sounds (a list of indices)";
-
-var extsnd_soundwidgets_tip = "<code>(sound-widgets snd)</code>: returns a list of widgets associated with 'snd':<br>" +
- "(0)pane (1)name (2)control-panel<br>" +
- "(3)minibuffer (4)play-button (5)filter-env<br>" +
- "(6)unite-button (7)name-label (8)name-icon (9)sync-button";
-
-var extsnd_squelchupdate_tip = "<code>(squelch-update snd chn)</code>: #t if updates (redisplays) are turned off in snd's channel chn";
-
-var extsnd_srate_tip = "<code>(srate snd)</code>: snd's srate";
-
-var extsnd_srcchannel_tip = "<code>(src-channel ratio-or-env (beg 0) (dur len) snd chn edpos)</code>:<br>" +
- " sampling-rate convert snd's channel chn by ratio, or following an envelope <br>" +
- " (a list or a CLM env generator).";
-
-var extsnd_srcsound_tip = "<code>(src-sound ratio-or-env (base 1.0) snd chn edpos)</code>:<br>" +
- " sampling-rate convert snd's channel chn by ratio, or following an envelope.<br>" +
- " A negative ratio reverses the sound";
-
-var extsnd_selectionmaxamp_tip = "<code>(selection-maxamp)</code> returns the peak amplitude in the selection.";
-
-var extsnd_startplayinghook_tip = "<code>start-playing-hook (snd)</code>: called when a play request is triggered.<br>" +
- " If it returns #t, the sound is not played.";
-
-var extsnd_startplayingselectionhook_tip = "<code>start-playing-selection-hook ()</code>: called when the selection starts playing";
-
-var extsnd_stopdachook_tip = "<code>stop-dac-hook ()</code>: called upon mus_audio_close (when DAC is turned off)";
-
-var extsnd_stopplaying_tip = "<code>(stop-playing snd)</code>: stop play (DAC output) in progress";
-
-var extsnd_stopplayinghook_tip = "<code>stop-playing-hook (snd)</code>: called when a sound finishes playing.";
-
-var extsnd_stopplayingselectionhook_tip = "<code>stop-playing-selection-hook ()</code>: called when the selection stops playing";
-
-var extsnd_sync_tip = "<code>(sync snd)</code>: snd's sync value (0 = no sync).<br>" +
- " Some editing operations are applied to all sounds sharing the sync value of the selected sound.";
-
-var extsnd_tempdir_tip = "<code>(temp-dir)</code>: name of directory for temp files (or #f=null)";
-
-var extsnd_time_graph_tip = "<code>time-graph<code> is the constant associated with the time domain graph<br>" +
- "The other two graphs are <code>transform-graph</code> and <code>lisp-graph</code>";
-
-var extsnd_timegraphtype_tip = "<code>(time-graph-type snd chn)</code>: graph-as-wavogram if<br>" +
- " Snd's time domain display is a 'wavogram',otherwise graph-once.";
-
-var extsnd_tinyfont_tip = "<code>(tiny-font)</code>: font use for some info in the graphs";
-
-var extsnd_transformgraphp_tip = "<code>(transform-graph? snd chn)</code>: #t if fft display is active in snd's channel chn";
-
-var extsnd_transformgraphtype_tip = "<code>(transform-graph-type snd chn)</code>: can be<br>" +
- " graph-once, graph-as-sonogram, or graph-as-spectrogram.";
-
-var extsnd_transformsize_tip = "<code>(transform-size snd chn)</code>: current fft size (512)";
-
-var extsnd_transformtovct_tip = "<code>(transform->vct snd chn obj)</code>: return a vct (obj if it's passed),<br>" +
- " with the current transform data from snd's channel chn";
-
-var extsnd_undo_tip = "<code>(undo (count 1) snd chn)</code>: undo 'count' edits in snd's channel chn";
-
-var extsnd_updatesound_tip = "<code>(update-sound snd)</code>: update snd (re-read it from the disk after flushing pending edits)";
-
-var extsnd_updatetimegraph_tip = "<code>(update-time-graph snd chn)</code>: redraw snd channel chn's graphs";
-
-var extsnd_updatetransformgraph_tip = "<code>(update-transform-graph snd chn)</code>: redraw snd channel chn's fft display";
-
-var extsnd_vct_tip = "<code>(vct :rest args)</code>: returns a new vct with args as contents; same as list->vct: (vct 1 2 3)";
-
-var extsnd_vctadd_tip = "<code>(vct-add! v1 v2 (offset 0))</code>: element-wise add of vcts v1 and v2: v1[i + offset] += v2[i], returns v1";
-
-var extsnd_vctcopy_tip = "<code>(vct-copy v)</code>: returns a copy of vct v";
-
-var extsnd_vctfill_tip = "<code>(vct-fill! v val)</code>: set each element of v to val: v[i] = val, returns v";
-
-var extsnd_vctmap_tip = "<code>(vct-map! v proc)</code>: set each element of v to value of proc (a thunk):<br>" +
- " v[i] = (proc), returns v.<br>" +
- "<code> (vct-map! v (lambda () 3.0))</code> is the same as <code>(vct-fill! v 3.0)</code>";
-
-var extsnd_vctmove_tip = "<code>(vct-move! obj new old backwards)</code>: moves vct obj data from old to new:<br>" +
- " v[new++] = v[old++], or v[new--] = v[old--] if backwards is #f.";
-
-var extsnd_vctmultiply_tip = "<code>(vct-multiply! v1 v2)</code>: element-wise multiply of vcts v1 and v2:<br>" +
- " v1[i] *= v2[i], returns v1";
-
-var extsnd_vctoffset_tip = "<code>(vct-offset! v val)</code>: add val to each element of v:<br>" +
- " v[i] += val, returns v";
-
-var extsnd_vctp_tip = "<code>(vct? obj)</code>: is obj a vct";
-
-var extsnd_vctpeak_tip = "<code>(vct-peak v)</code>: max of abs of elements of v";
-
-var extsnd_vctref_tip = "<code>(vct-ref v n)</code>: element n of vct v, v[n]";
-
-var extsnd_vctreverse_tip = "<code>(vct-reverse! vct len)</code>: in-place reversal of vct contents";
-
-var extsnd_vctscale_tip = "<code>(vct-scale! v val)</code>: scale each element of v by val:<br>" +
- " v[i] *= val, returns v";
-
-var extsnd_vctset_tip = "<code>(vct-set! v n val)</code>: sets element of vct v to val, v[n] = val";
-
-var extsnd_vctsubseq_tip = "<code>(vct-subseq v start end vnew)</code>: v[start..end],<br>" +
- " placed in vnew if given or new vct";
-
-var extsnd_vcttochannel_tip = "<code>(vct->channel vct (beg 0) (dur len) snd chn edpos origin)</code>:<br>" +
- " set snd's channel chn's samples starting at beg for dur samps from vct data";
-
-var extsnd_vcttosounddata_tip = "<code>(vct->sound-data v sd chan)</code>: copies vct v's data into sound-data sd's channel chan";
-
-var extsnd_widgetposition_tip = "<code>(widget-position wid)</code>: widget's position, (list x y), in pixels";
-
-var extsnd_widgetsize_tip = "<code>(widget-size wid)</code>: widget's size, (list width height), in pixels";
-
-var extsnd_windowheight_tip = "<code>(window-height)</code>: current Snd window height in pixels";
-
-var extsnd_windowwidth_tip = "<code>(window-width)</code>: current Snd window width in pixels";
-
-var extsnd_withmixtags_tip = "<code>(with-mix-tags)</code>: #t if Snd should try to use virtual (tagged) mixing";
-
-var extsnd_withtrackingcursor_tip = "<code>(with-tracking-cursor snd)</code>:<br>#t if cursor moves along in waveform display as sound is played";
-
-var extsnd_xaxislabel_tip = "<code>(x-axis-label snd chn (ax time-graph))</code>: current x axis label";
-
-var extsnd_xaxisstyle_tip = "<code>(x-axis-style snd chn)</code>: The x axis labelling of the time domain waveform<br>" +
- " can be in seconds (x-axis-in-seconds), in samples (x-axis-in-samples),<br>" +
- " expressed as a percentage of the overall duration (x-axis-as-percentage),<br>" +
- " as a beat number (x-axis-in-beats), as a measure number (x-axis-in-measures),<br>" +
- " or clock-style (dd:hh:mm:ss) (x-axis-as-clock).";
-
-var extsnd_xbounds_tip = "<code>(x-bounds snd chn)</code>:<br>a list (x0 x1) giving the current x axis bounds of snd channel chn";
-
-var extsnd_xtoposition_tip = "<code>(x->position val snd chn (ax time-graph))</code>: x pixel loc of val";
-
-var extsnd_xzoomslider_tip = "<code>(x-zoom-slider snd chn)</code>: current x axis zoom slider of snd channel chn";
-
-var extsnd_ybounds_tip = "<code>(y-bounds snd chn)</code>:<br>a list (low high) giving the current y axis bounds of snd channel chn";
-
-var extsnd_ytoposition_tip = "<code>(y->position val snd chn (ax time-graph))</code>: y pixel loc of val";
-
-var extsnd_yzoomslider_tip = "<code>(y-zoom-slider snd chn)</code>: current y axis zoom slider of snd channel chn";
-
-var sndclm_amplitude_modulate_tip = "<code>(amplitude-modulate carrier in1 in2)</code>: in1 * (carrier + in2)";
-
-var sndclm_array_interp_tip = "<code>(array-interp v phase size)</code>: v[phase] taking into account wrap-around<br>" +
- " (size is size of data), with linear interpolation if phase is not an integer.";
-
-var sndclm_comb_tip = "<code>(comb gen (val 0.0) (pm 0.0))</code>: comb filter val, pm changes the delay length.";
-
-var sndclm_continue_sampletofile_tip = "<code>(continue-sample->file filename)</code>: return an output generator<br>" +
- " that reopens an existing sound file 'filename' ready for output via sample->file";
-
-var sndclm_contrast_enhancement_tip = "<code>(contrast-enhancement sig (index 1.0))</code>: sin(sig * pi / 2 + index * sin(sig * 2 * pi))";
-
-var sndclm_convolve_tip = "<code>(convolve gen input-func)</code>: next sample from convolution generator";
-
-var sndclm_delay_tip = "<code>(delay gen (val 0.0) (pm 0.0))</code>: delay val<br>" +
- " according to the delay line's length and pm ('phase-modulation').<br>" +
- " If pm is greater than 0.0, the max-size argument used to create gen<br>" +
- " should have accommodated its maximum value.";
-
-var sndclm_dot_product_tip = "<code>(dot-product v1 v2 size)</code>: sum of (vcts) v1[i] * v2[i] (also named scalar product)";
-
-var sndclm_env_tip = "<code>(env gen)</code>: next sample from envelope generator";
-
-var sndclm_fft_tip = "<code>(mus-fft rl im len (dir 1))</code>:<br>" +
- " return the fft of vcts rl and im which contain <br>" +
- " the real and imaginary parts of the data;<br>" +
- " len should be a power of 2,<br>" +
- " dir = 1 for fft, -1 for inverse-fft";
-
-var sndclm_filetoarray_tip = "<code>(file->array filename chan start samples data)</code>:<br>" +
- " read the sound file 'filename' placing samples from channel 'chan'<br>" +
- " into the vct 'data' starting in the file at frame 'start'<br>" +
- " and reading 'samples' samples altogether.";
-
-var sndclm_filetosample_tip = "<code>(file->sample obj frame chan)</code>: sample value in sound file read by 'obj' in channel chan at frame";
-
-var sndclm_fir_filter_tip = "<code>(fir-filter gen (input 0.0))</code>: next sample from FIR filter";
-
-var sndclm_formant_tip = "<code>(formant gen (input 0.0) freq-in-radians)</code>: next sample from resonator generator";
-
-var sndclm_frame_ref_tip = "<code>(frame-ref f chan)</code>: f[chan] (the chan-th sample in frame f";
-
-var sndclm_frame_set_tip = "<code>(frame-set! f chan val)</code>: sets frame f's chan-th sample to val:<br>" +
- " f[chan] = val";
-
-var sndclm_frame_times_tip = "<code>(frame* f1 f2 outf)</code>: multiply f1 and f2 (elementwise)<br>" +
- " returning outf; if outf is not given, a new frame is created.<br>" +
- " outf[i] = f1[i] * f2[i].";
-
-var sndclm_granulate_tip = "<code>(granulate gen input-func edit-func)</code>: next sample from granular synthesis generator";
-
-var sndclm_hztoradians_tip = "<code>(hz->radians hz)</code>: convert frequency in Hz to radians per sample: hz * 2 * pi / srate";
-
-var sndclm_in_any_tip = "<code>(in-any frame chan stream)</code>: input stream sample at frame in channel chan";
-
-var sndclm_ina_tip = "<code>(ina frame stream)</code>: input stream sample in channel 0 at frame";
-
-var sndclm_locsig_set_tip = "<code>(locsig-set! gen chan val)</code>: set the locsig generator's channel 'chan' scaler to 'val'";
-
-var sndclm_locsig_tip = "<code>(locsig gen loc val)</code>: add 'val' to the output of locsig at frame 'loc'";
-
-var sndclm_make_comb_tip = "<code>(make-comb :scaler :size :initial-contents (:initial-element 0.0) :max-size (:type mus-interp-linear))</code>:<br>" +
- " return a new comb filter (a delay line with a scaler on the feedback) of size elements.<br>" +
- " If the comb length will be changing at run-time, max-size sets its maximum length.<br>" +
- " initial-contents can be either a list or a vct.";
-
-var sndclm_contrast_enhancement_tip = "<code>(contrast-enhancement input (fm-index 1.0))</code><br>" +
- " phase-modulates its input.";
-
-var sndclm_make_convolve_tip = "<code>(make-convolve :input :filter :fft-size)</code>: <br>" +
- " return a new convolution generator which convolves its input with the impulse response 'filter'.";
-
-var sndclm_make_delay_tip = "<code>(make-delay :size :initial-contents (:initial-element 0.0) (:max-size) (:type mus-interp-linear))</code>:<br>" +
- " return a new delay line of size elements.<br>" +
- " If the delay length will be changing at run-time, max-size sets its maximum length,<br>" +
- " so <code>(make-delay len :max-size (+ len 10))</code> provides 10 extra elements of delay<br>" +
- " for subsequent phasing or flanging.<br>" +
- " initial-contents can be either a list or a vct.";
-
-var sndclm_make_env_tip = "<code>(make-env :envelope (:scaler 1.0) :duration (:offset 0.0) (:base 1.0) :end :length)</code>:<br>" +
- " return a new envelope generator.<br>" +
- " 'envelope' is a list or vct of break-point pairs. To create the envelope,<br>" +
- " these points are offset by 'offset', scaled by 'scaler', and mapped over the time interval<br>" +
- " defined by either 'duration' (seconds) or 'length' (samples).<br>" +
- " If 'base' is 1.0, the connecting segments are linear, if 0.0 you get a step function,<br>" +
- " and anything else produces an exponential connecting segment.";
-
-var sndclm_make_filetosample_tip = "<code>(make-file->sample filename buffer-size)</code>:<br>" +
- " return an input generator reading 'filename' (a sound file)";
-
-var sndclm_make_filter_tip = "<code>(make-filter :order :xcoeffs :ycoeffs)</code>:<br>" +
- " return a new direct form FIR/IIR filter, coeff args are vcts";
-
-var sndclm_make_fir_filter_tip = "<code>(make-fir-filter :order :xcoeffs)</code>: return a new FIR filter, xcoeffs a vct";
-
-var sndclm_make_formant_tip = "<code>(make-formant :frequency :radius)</code>:<br>" +
- " return a new formant generator (a resonator).<br>" +
- " radius sets the pole radius (in terms of the 'unit circle').<br>" +
- " frequency sets the resonance center frequency (Hz).";
-
-var sndclm_make_frame_tip = "<code>(make-frame chans val0 val1 ...)</code>:<br>" +
- " return a new frame object with chans samples,<br>" +
- " each sample set from the trailing arguments (defaulting to 0.0):<br>" +
- "<code> (make-frame 2 .1 .2)</code>";
-
-var sndclm_make_granulate_tip = "<code>(make-granulate :input (:expansion 1.0) (:length .15) (:scaler .6) (:hop .05)<br>" +
- " (:ramp .4) (:jitter 1.0) :max-size :edit)</code>:<br>" +
- " return a new granular synthesis generator.<br>" +
- " 'length' is the grain length (seconds),<br>" +
- " 'expansion' is the ratio in timing between the new and old (expansion > 1.0 slows things down),<br>" +
- " 'scaler' scales the grains to avoid overflows,<br>" +
- " 'hop' is the spacing (seconds) between successive grains upon output,<br>" +
- " 'jitter' controls the randomness in that spacing,<br>" +
- " 'input' can be a file pointer.<br>" +
- " 'edit' can be a function of one arg, the current granulate generator.<br>" +
- " It is called just before a grain is added into the output buffer.<br>" +
- " The current grain is accessible via mus-data.<br>" +
- " The edit function, if any, should return the length in samples of the grain, or 0.";
-
-var sndclm_make_locsig_tip = "<code>(make-locsig (:degree 0.0) (:distance 1.0) (:reverb 0.0) (:output *output*) (:revout *reverb*)<br>" +
- " (:channels (mus-channels *output*)) (:type mus-interp-linear))</code>:<br>" +
- " return a new generator for signal placement in n channels. Channel 0 corresponds to 0 degrees.";
-
-var sndclm_make_moving_average_tip = "<code>(make-moving-average :size :initial-contents (:initial-element 0.0))</code>:<br>" +
- " return a new moving_average generator. initial-contents can be either a list or a vct.";
-
-var sndclm_moving_max_tip = "<code>(moving-max gen y)</code>: return moving window max given input 'y'.<br>" +
- " moving-max is a specialization of the delay generator that produces<br>" +
- " an envelope that tracks the peak amplitude of the last 'size' samples.";
-
-var sndclm_make_ncos_tip = "<code>(make-ncos (:frequency *clm-default-frequency*) (:n 1))</code>:<br>" +
- " return a new ncos generator, producing a sum of 'n' equal amplitude cosines.";
-
-var sndclm_make_one_pole_tip = "<code>(make-one-pole :a0 :b1)</code>: return a new one-pole filter; a0*x(n) - b1*y(n-1)";
-
-var sndclm_make_one_zero_tip = "<code>(make-one-zero :a0 :a1)</code>: return a new one-zero filter; a0*x(n) + a1*x(n-1)";
-
-var sndclm_make_oscil_tip = "<code>(make-oscil (:frequency *clm-default-frequency*) (:initial-phase 0.0))</code>:<br>" +
- " return a new oscil (sinewave) generator";
-
-var sndclm_make_phase_vocoder_tip = "<code>(make-phase-vocoder :input :fft-size :overlap :interp :pitch :analyze :edit :synthesize)</code>:<br>" +
- " return a new phase-vocoder generator;<br>" +
- " input is the input function (it can be set at run-time),<br>" +
- " analyze, edit, and synthesize are either #f or functions that replace the default innards of the generator,<br>" +
- " fft-size, overlap and interp set the fftsize, the amount of overlap between ffts, and the time between new analysis calls.<br>" +
- " 'analyze', if given, takes 2 args, the generator and the input function;<br>" +
- " if it returns #t, the default analysis code is also called.<br>" +
- " 'edit', if given, takes 1 arg, the generator; if it returns #t, the default edit code is run.<br>" +
- " 'synthesize' is a function of 1 arg, the generator; it is called to get the current vocoder output.";
-
-var sndclm_make_polyshape_tip = "<code>(make-polyshape (:frequency *clm-default-frequency*) (:initial-phase 0.0) :coeffs (:partials '(1 1)) (:kind mus-chebyshev-first-kind))</code>:<br>" +
- " return a new polynomial-based waveshaping generator:<br>" +
- "<code> (make-polyshape :coeffs (partials->polynomial '(1 1.0)))</code><br>" +
- " is the same in effect as make-oscil";
-
-var sndclm_make_polywave_tip = "<code>(make-polyshape (:frequency *clm-default-frequency*) (:partials '(1 1)) (:kind mus-chebyshev-first-kind))</code>:<br>" +
- " return a new polynomial-based waveshaping generator (additive synthesis).";
-
-var sndclm_make_pulse_train_tip = "<code>(make-pulse-train (:frequency *clm-default-frequency*) (:amplitude 1.0) (:initial-phase 0.0))</code>:<br>" +
- " return a new pulse-train generator. This produces a sequence of impulses.";
-
-var sndclm_make_rand_interp_tip = "<code>(make-rand-interp (:frequency *clm-default-frequency*) (:amplitude 1.0) :envelope :distribution :size)</code>:<br>" +
- " return a new rand-interp generator, producing linearly interpolated random numbers.<br>" +
- " frequency is the rate at which new end-points are chosen.";
-
-var sndclm_make_rand_tip = "<code>(make-rand (:frequency *clm-default-frequency*) (:amplitude 1.0) :envelope :distribution :size)</code>:<br>" +
- " return a new rand generator, producing a sequence of random numbers (a step function).<br>" +
- " frequency is the rate at which new numbers are chosen.";
-
-var sndclm_make_readin_tip = "<code>(make-readin :file (:channel 0) (:start 0) (:direction 1) :size)</code>:<br>" +
- " return a new readin (file input) generator reading the sound file 'file'<br>" +
- " starting at frame 'start' in channel 'channel' and reading forward if 'direction' is not -1";
-
-var sndclm_make_sampletofile_tip = "<code>(make-sample->file filename chans data-format header-type comment)</code>:<br>" +
- " return an output generator writing the sound file 'filename'<br>" +
- " which is set up to have 'chans' channels of 'data-format' samples with a header of 'header-type'.<br>" +
- " The latter should be sndlib identifiers:<br>" +
- "<code> (make-sample->file \"test.snd\" 2 mus-lshort mus-riff)</code>";
-
-var sndclm_make_src_tip = "<code>(make-src :input (:srate 1.0) (:width 10))</code>: return a new sampling-rate conversion generator<br>" +
- " (using 'warped sinc interpolation').<br>" +
- " 'srate' is the ratio between the new rate and the old.<br>" +
- " 'width' is the sine width (effectively the steepness of the low-pass filter), normally between 10 and 100.<br>" +
- " 'input' if given is an open file stream.";
-
-var sndclm_make_triangle_wave_tip = "<code>(make-triangle-wave (:frequency *clm-default-frequency*) (:amplitude 1.0) (:initial-phase 0.0))</code>:<br>" +
- " return a new triangle-wave generator.";
-
-var sndclm_make_two_zero_tip = "<code>(make-two-zero :a0 :a1 :a2 or :frequency :radius)</code>:<br>" +
- " return a new two-zero filter; a0*x(n) + a1*x(n-1) + a2*x(n-2)";
-
-var sndclm_moving_average_tip = "<code>(moving-average gen (val 0.0))</code>: moving window moving_average.";
-
-var sndclm_mus_close_tip = "<code>(mus-close gen)</code>: close the IO stream managed by 'gen' (a sample->file generator, for example)";
-
-var sndclm_mus_data_tip = "<code>(mus-data gen)</code>: gen's internal data (a vct)";
-
-var sndclm_mus_frequency_tip = "<code>(mus-frequency gen)</code>: gen's frequency (Hz)";
-
-var sndclm_mus_increment_tip = "<code>(mus-increment gen)</code>: gen's mus-increment field";
-
-var sndclm_mus_length_tip = "<code>(mus-length gen)</code>: gen's length";
-
-var sndclm_mus_offset_tip = "<code>(mus-offset gen)</code>: gen's offset";
-
-var sndclm_mus_random_tip = "<code>(mus-random val)</code>: a random number between -val and val.<br>" +
- " the built-in 'random' function returns values between 0 and its argument";
-
-var sndclm_mus_scaler_tip = "<code>(mus-scaler gen)</code>: gen's scaler, if any.<br>" +
- " This is often an amplitude adjustment of some sort.";
-
-var sndclm_mussrate_tip = "<code>(mus-srate)</code>: current sampling rate";
-
-var sndclm_ncos_tip = "<code>(ncos gen (fm 0.0))</code>: get the next sample from 'gen', an ncos generator";
-
-var sndclm_oscil_tip = "<code>(oscil gen (fm 0.0) (pm 0.0))</code>:<br>" +
- " next sample from oscil gen: val = sin(phase + pm); phase += (freq + fm)";
-
-var sndclm_out_any_tip = "<code>(out-any frame val chan stream)</code>: add val to output stream at frame in channel chan";
-
-var sndclm_outa_tip = "<code>(outa frame val stream)</code>: add val to output stream at frame in channel 0";
-
-var sndclm_outb_tip = "<code>(outb frame val stream)</code>: add val to output stream at frame in channel 1 (counting from 0)";
-
-var sndclm_output_tip = "<code>*output*</code> is the direct signal output stream. The reverb input is sent to *reverb*.";
-
-var sndclm_partialstopolynomial_tip = "<code>(partials->polynomial partials (kind mus-chebyshev-first-kind))</code>:<br>" +
- " produce a Chebyshev polynomial suitable for use with the polynomial generator<br>" +
- " to create (via waveshaping) the harmonic spectrum described by the partials argument:<br>" +
- "<code> (let ((v0 (partials->polynomial '(1 1.0 2 1.0)))<br> (os (make-oscil)))<br> (polynomial v0 (oscil os)))</code>";
-
-var sndclm_phase_vocoder_tip = "<code>(phase-vocoder gen input-function analyze-func edit-func synthesize-func)</code>: next phase vocoder value";
-
-var sndclm_polynomial_tip = "<code>(polynomial coeffs x)</code>: evaluate a polynomial at x.<br>" +
- " coeffs are in order of degree, so coeff[0] is the constant term.";
-
-var sndclm_polyshape_tip = "<code>(polyshape gen (index 1.0) (fm 0.0))</code>:<br>" +
- " next sample of polynomial-based waveshaper";
-
-var sndclm_polywave_tip = "<code>(polywave gen (fm 0.0))</code>:<br>" +
- " next sample of polynomial-based waveshaper (additive synthesis)";
-
-var sndclm_pulse_train_tip = "<code>(pulse-train gen (fm 0.0))</code>: next pulse train sample from generator";
-
-var sndclm_rand_interp_tip = "<code>(rand-interp gen (fm 0.0))</code>: gen's current (interpolating) random number.<br>" +
- " fm modulates the rate at which new segment end-points are chosen.";
-
-var sndclm_rand_tip = "<code>(rand gen (fm 0.0))</code>: gen's current random number.<br>" +
- " fm modulates the rate at which the current number is changed.";
-
-var sndclm_readin_tip = "<code>(readin gen)</code>: next sample from readin generator (a sound file reader)";
-
-var sndclm_reverb_tip = "<code>*reverb*</code> is the reverb stream. The direct signal is sent to *output*.";
-
-var sndclm_secondstosamples_tip = "<code>(seconds->samples secs)</code>: use mus-srate to convert seconds to samples";
-
-var sndclm_spectrum_tip = "<code>(spectrum rdat idat window norm-type</code>: return the spectrum of rdat and idat.<br>" +
- "norm-type defaults to linear (1); the other choices are raw (unnormalized: 2), and dB (0).";
-
-var sndclm_src_tip = "<code>(src gen (pm 0.0) input-function)</code>: next sampling rate conversion sample.<br>" +
- " 'pm' can be used to change the sampling rate on a sample-by-sample basis.<br>" +
- " 'input-function' is a function of one argument (the current input direction, normally ignored)<br>" +
- " that is called internally whenever a new sample of input data is needed.<br>" +
- " If the associated make-src included an 'input' argument, input-function is ignored.";
-
-var sndclm_tap_tip = "<code>(tap gen (pm 0.0))</code>: tap the delay generator offset by pm";
-
-var sndclm_timestosamples_tip = "<code>(times->samples beg dur)</code>: returns a list of beg and beg+dur in samples.";
-
-var sndclm_triangle_wave_tip = "<code>(triangle-wave gen (fm 0.0))</code>: next triangle wave sample from generator";
-
-var sndscm_IIRfilters_tip = "These are simple 2nd order IIR filters in dsp.scm.";
-
-var sndscm_analogfilterdoc_tip = "These are the standard 'analog' IIR filters: Butterworth, Chebyshev, etc.";
-
-var sndscm_channelproperty_tip = "<code>(channel-property key snd chn)</code>: returns the value associated with 'key'<br>" +
- " in the given channel's property list. To add or change a property,<br>" +
- " use set! with this procedure.<br><br>" +
- "<code> (set! (channel-property 'info 0 0) \"this is sound 0, first channel\")</code><br>" +
- " now <code>(channel-property 'info 0 0)</code> returns \"this is sound 0, first channel\".";
-
-var sndclm_defgenerator_tip = "defgenerator sets up a structure, an object with named slots that you can get and set,<br>" +
- " and ties it into the optimizer so that you can use the structures without any speed penalty.<br>" +
- " It also defines a \"make\" function to create an instance of the structure, and a predicate for it.<br><br>" +
- "<code> (defgenerator osc freq phase)</code><br><br>" +
- " defines a struct named \"osc\" with the (float) fields freq and phase.<br>" +
- " it also defines make-osc which creates an osc, and osc? returns #t if passed an osc.<br>" +
- " the struct fields are accessed via osc-freq and osc-phase.";
-
-var sndscm_definstrument_tip = "definstrument is very much like define, but with added code to support notehook<br>" +
- " and (for Common Music) *definstrument-hook*.";
-
-var sndscm_envelopeinterp_tip = "<code>(envelope-interp x env (base 1.0)</code>: returns value of 'env' at 'x'.<br>" +
- " If 'base' is 0, 'env' is treated as a step function;<br>" +
- " if 'base' is 1.0 (the default), the breakpoints of 'env' are connected by a straight line,<br>" +
- " and any other 'base' connects the breakpoints with an exponential curve.";
-
-var sndscm_envelopelastx_tip = "<code>(envelope-last-x env)</code>: returns the last breakpoint's x axis value in 'env'";
-
-var sndscm_envexptchannel_tip = "<code>(env-expt-channel env exponent (symmetric #t) beg dur snd chn edpos)</code>:<br>" +
- " applies 'env' to the given channel using 'exponent' for the exponential base.<br>" +
- " The 'symmetric' argument determines whether the up and down moving ramps look<br>" +
- " symmetrical around a break point.";
-
-var sndscm_findchild_tip = "<code>(find-child widget name)</code> searches for a widget named 'name',<br>" +
- "starting from 'widget' and moving through all its children.";
-
-var sndscm_fmviolin_tip = "The fm-violin instrument uses FM to produce a string-like sound;<br>" +
- " It has many parameters, the principal ones being <code>startime dur frequency amplitude</code>.<br>" +
- " The code is in v.scm.";
-
-var sndscm_hilberttransform_tip = "<code>(hilbert-transform gen input)</code> returns the Hilbert transform of 'input'.";
-
-var sndscm_html_function_tip = "<code>(html arg)</code> where 'arg' can be a string, a symbol, or a procedure<br>" +
- " sends the html reader to the corresponding url in the Snd documents.";
-
-var sndscm_insertchannel_tip = "<code>(insert-channel filedat beg dur snd chn edpos)</code>:<br>" +
- " inserts the specified data ('filedat') in the given channel at the given location.<br>" +
- " 'filedat' can be either a filename (a string), a sound index, or a list containing<br>" +
- " the filename (or index), the start point in the file, and (optionally) the channel of the file to mix.";
-
-var sndscm_makebandpass_tip = "<code>(make-bandpass flo fhi length)</code> returns a bandpass filter.";
-
-var sndscm_makebiquad_tip = "<code>(make-biquad a0 a1 a2 b1 b2)</code> returns a biquad filter section.";
-
-var sndscm_makebutter_tip = "various 2nd order Butterworth filters in dsp.scm.";
-
-var sndscm_makedifferentiator_tip = "<code>(make-differentiator length)</code> returns a differentiating filter.";
-
-var sndscm_makeframereader_tip = "<code>(make-frame-reader start snd dir pos)</code>: creates a frame-reader<br>" +
- " reading the sound 'snd' starting at frame 'start'<br>" +
- " with initial read direction 'dir' (1=forward, -1=backward).<br>" +
- " 'pos' is the edit history position to read (it defaults to current position).";
-
-var sndscm_makehighpass_tip = "<code>(make-highpass fc length)</code> returns a highpass filter.";
-
-var sndscm_makehilberttransform_tip = "<code>(make-hilbert-transform length)</code> returns a Hilbert transformer.";
-
-var sndscm_makelowpass_tip = "<code>(make-lowpass fc length)</code> returns a lowpass filter.";
-
-var sndscm_makeramp_tip = "<code>(make-ramp (size 128))</code>: return a ramp generator.";
-
-var sndscm_makeselection_tip = "<code>(make-selection beg end snd chn)</code>: makes a selection,<br>" +
- " like make-region but without creating a region.<br>" +
- " It selects 'dur' samples starting at 'beg' in the given channel.";
-
-var sndscm_makespencerfilter_tip = "<code>(make-spencer-filter)</code> returns an FIR filter with the Spencer (smoothing) coefficients.";
-
-var sndscm_markproperties_tip = "<code>(mark-properties id)</code> accesses the property list associated with the mark 'id'";
-
-var sndscm_matchsoundfiles_tip = "<code>(match-sound-files func dir)</code>: apply 'func' to each sound file in 'dir'<br>" +
- " and return a list of files for which func does not return #f.";
-
-var sndscm_maxenvelope_tip = "<code>(max-envelope env)</code>: return the maximum y value in 'env'";
-
-var sndscm_moogfilter_tip = "<code>(moog-filter gen input)</code>: return Moog-style 4-pole lowpass filtering of 'input'";
-
-var sndscm_mpg_tip = "<code>(mpg mpgfile rawfile)</code>: call mpg123 to translate an MPEG format sound file<br>" +
- " to a headerless (\"raw\") file containing 16-bit samples.";
-
-var sndscm_musmix_tip = "<code>(mus-mix outfile infile (outloc 0) (frames) (inloc 0) mixer envs)</code>:<br>" +
- " mix 'infile' into 'outfile' starting at 'outloc' in 'outfile'<br>" +
- " and 'inloc' in 'infile', mixing 'frames' frames into 'outfile'.<br>" +
- " 'frames' defaults to the length of 'infile'.<br>" +
- " If 'mixer', use it to scale the various channels;<br>" +
- " if 'envs' (an array of envelope generators), use it in conjunction with mixer<br>" +
- " to scale and envelope all the various ins and outs.<br>" +
- " 'outfile' can also be a frame->file generator, and<br>" +
- " 'infile' can be a file->frame generator.";
-
-var sndscm_poly_times_tip = "<code>(poly* p1 p2)</code> multiplies p1 by p2, both polynomials.";
-
-var sndscm_powerenv_tip = "<code>(power-env env)</code>: an envelope generator where each segment has its own base.";
-
-var sndscm_prc95doc_tip = "various physical modeling functions from Perry Cook.";
-
-var sndscm_rmsgain_tip = "various RMS-related generators.";
-
-var sndscm_scalemixes_tip = "<code>(scale-mixes mix-list scl)</code>: scales the amplitude of each mix in 'mix-list' by 'scl'.";
-
-var sndscm_sgfilter_tip = "<code>(savitzky-golay-filter gen input)</code>: a Savitzky-Golay filter, assuming symmetrical positioning.<br>" +
- " It is an FIR smoothing filter.";
-
-var sndscm_sound_let_tip = "sound-let is a form of let* that creates temporary sound files within with-sound.<br>" +
- " Its syntax is a combination of let* and with-sound:<br><br>" +
- "<code> (sound-let ((temp-1 () (fm-violin 0 1 440 .1))<br>" +
- " (temp-2 () (fm-violin 0 2 660 .1)<br>" +
- " (fm-violin .125 .5 880 .1)))<br>" +
- " (granulate-sound temp-1 0 2 0 2) ;temp-1 is the name of the 1st temporary file<br>" +
- " (granulate-sound temp-2 1 1 0 2))</code><br><br>" +
- " This creates two temporary files and passes them along to the subsequent calls<br>" +
- " on granulate-sound. The first list after the sound file identifier is the list of <br>" +
- " with-sound options to be passed along when creating this temporary file. These default<br>" +
- " to :output with a unique name generated internally, and all other variables are taken from<br>" +
- " the overall (enclosing) with-sound. The rest of the list is the body of the associated with-sound.";
-
-var sndscm_sounddatatosound_tip = "<code>(sound-data->sound sd beg dur snd)</code>: place the contents of<br>" +
- " its sound-data argument 'sd' into the sound 'snd' starting at 'beg' and going for 'dur' frames.<br>" +
- " 'dur' defaults to the sound-data object's length.";
-
-var sndscm_soundinterp_tip = "<code>(sound-interp reader loc)</code>: the sound-interp interpolating reader<br>" +
- " reads a channel at an arbitary location, interpolating between samples if necessary.";
-
-var sndscm_soundtosounddata_tip = "<code>(sound->sound-data beg dur snd)</code>:<br>" +
- " return a sound-data object containing the contents of the sound 'snd'<br>" +
- " starting from beg for dur frames.<br>" +
- " <code> (sound-data->sound (sound-data* (sound->sound-data) 2.0))</code><br>" +
- " is yet another way to scale a sound by 2.0.";
-
-var sndscm_syncdmixes_tip = "<code>(syncd-mixes sync)</code>: returns a list of all mixes whose mix-sync field is set to 'sync'.";
-
-var sndscm_tofrequency_tip = "<code>(->frequency pitch ratio)</code> takes either a number or a common-music pitch symbol<br>" +
- " ('c4 is middle C), and returns either the number or the frequency associated with that pitch:<br>" +
- " <code>(->frequency 'cs5)</code> returns 554 and change.<br>" +
- " 'ratio' can be #t to get small integer ratios rather than equal temperment.";
-
-var sndscm_tosample_tip = "<code>(->sample time)</code> returns a sample number given a time in seconds";
-
-var sndscm_volterrafilter_tip = "<code>(volterra-filter flt x)</code>: pass 'x' through the Volterra (non-linear) filter 'flt'.";
-
-var sndscm_windowsamples_tip = "<code>(window-samples snd chn)</code>: returns (in a vct) the samples<br>" +
- " displayed in the current graph window for the given channel.";
-
-var sndscm_withtempsound_tip = "with-temp-sound is like sound-let (it sets up a temporary output<br>" +
- " for with-sound) , but does not delete its output file.";
-
-var sndscm_wsdoc_tip = "with-sound provides a simple way to package up a bunch of instrument calls into a new<br>" +
- " sound file, and open that file in Snd when the computation is complete. <br>" +
- " with-sound opens an output object, and optionally a reverb output object.<br>" +
- " Each instrument uses out-any to add its sounds to the *output* results.<br>" +
- "<pre> with-sound<br>" +
- " (srate *clm-srate*) ; output sampling rate (44100)<br>" +
- " (output *clm-file-name*) ; output file name (\"test.snd\")<br>" +
- " (channels *clm-channels*) ; channels in output (1)<br>" +
- " (header-type *clm-header-type*) ; output header type (mus-next or mus-aifc)<br>" +
- " (data-format *clm-data-format*) ; output sample data type (mus-bfloat)<br>" +
- " (comment #f) ; any comment to store in the header (a string)<br>" +
- " (reverb *clm-reverb*) ; reverb instrument (jc-reverb)<br>" +
- " (reverb-data *clm-reverb-data*) ; arguments passed to the reverb<br>" +
- " (statistics *clm-statistics*) ; if #t, print info at end of with-sound<br>" +
- " (scaled-to #f) ; if a number, scale the output to peak at that amp<br>" +
- " (play *clm-play*) ; if #t, play the sound automatically</pre><br>" +
- " The with-sound syntax may look sightly odd; we include the arguments in the<br>" +
- " first list, then everything after that is evaluated as a note list.<br>" +
- "<pre> (with-sound (:srate 44100 :channels 2 :output \"test.snd\")<br>" +
- " (fm-violin 0 1 440 .1)<br>" +
- " (fm-violin 1 1 660 .1))</pre><br>" +
- " produces a sound file with two fm-violin notes; the sound file is named \"test.snd\",<br>" +
- " is stero, and has a sampling rate of 44100.";
-
-var sndscm_zipper_tip = "<code>(zipper gen in1 in2)</code>: the digital zipper; a way to crossfade between in1 and in2.";
-
-
-
-var sndlib_html_tip = "library that handles sound files and audio ports";
-
-var sndclm_html_tip = "sound synthesis generators";
-
-var sndscm_html_tip = "Scheme, Ruby, and Forth files included with Snd";
-
-var fm_html_tip = "introduction to frequency modulation";
-
-var extsnd_html_tip = "Snd extension and customization";
-
-var grfsnd_html_tip = "Snd configuration, connection to other libraries and programs";
-
-var snd_html_tip = "basic Snd user-interface documentation";
-
-var libxm_html_tip = "library that ties Motif and Gtk into Snd";
-
-var s7_html_tip = "a Scheme implementation that comes with Snd";
-
-var index_html_tip = "overall index";
-
-
-
-var analog_filter_doc_tip = "These are the traditional IIR filters, any type, any even order<br>" +
- "(Butterworth, Chebyshev, Inverse Chebyshev, Bessel, and Elliptic)<br>" +
- "The elliptic function filters need GSL, and all of these work better<br>" +
- "if you build Snd --with-doubles.";
-
-var animals_doc_tip = "synthesis of birds, frogs, and insects";
-
-var autosave_doc_tip = "periodically save current sound edits in a backup file, <br>" +
- "useful if your machine crashes a lot.";
-
-var bess_doc_tip = "This sets up a dialog to experiment with simple FM, <br>" +
- "the fm-violin, or with a compositional algorithm";
-
-var binary_io_doc_tip = "This file has functions to read and write binary files";
-
-var bird_doc_tip = "simple synthesis of about 50 birds using additive synthesis.<br>" +
- "see animals.scm for much more elaborate versions of these birds";
-
-var clean_doc_tip = "click, pop, and hum removal, and signal reconstruction";
-
-var clm_ins_doc_tip = "Instruments using many standard synthesis techniques,<br>" +
- " including a bagpipe, FOF synthesis, many FM examples,<br>" +
- " granular synthesis, spectral modeling, reverbs, and physical modeling.";
-
-
-var dlocsig_doc_tip = "dlocsig sets up envelopes to mimic a moving sound;<br>" +
- " included are many path-specification functions";
-
-var draw_doc_tip = "Examples of drawing extensions, primarily one that puts a thumbnail graph<br>" +
- " of the current sound in the upper right corner";
-
-var dsp_doc_tip = "This has all the usual DSP stuff: filters, ffts, sample rate conversion, <br>" +
- " sound effects, statistics, scanned synthesis, transforms, etc";
-
-var env_doc_tip = "Various operations on envelopes: add, scale, copy, stretch";
-
-var enved_doc_tip = "This adds an envelope editor to each displayed channel.<br>" +
- " You can set it up to be an amplitude envelope.";
-
-var examp_doc_tip = "A bunch of examples of things like ffts, filters, marks, selections,<br>" +
- " graphics extensions, sound effects, and generators.";
-
-var extensions_doc_tip = "channel and sound property lists, several enveloping functions,<br>" +
- " and commonly used editing sequences such as channel extraction.";
-
-var fade_doc_tip = "sound mixing using envelopes in the frequency domain";
-
-var frame_doc_tip = "various frame, vct, and sound-data functions";
-
-var freeverb_doc_tip = "a reverberator along the lines of nrev, but with more options.";
-
-var generators_doc_tip = "about 80 generators related to sums of sinusoids<br>" +
- " bessel functions, adjustable square-waves, special envelopes, etc";
-
-var grani_doc_tip = "this is a very flexible granular synthesis instrument";
-
-var heart_doc_tip = "This code is aimed at blood pressure readings.";
-
-var hooks_doc_tip = "snd-hooks, describe-hook, with-local-hook, reset-all-hooks.";
-
-var index_doc_tip = "this provides a connection between firefox and the snd-help mechanism.";
-
-var inf_snd_doc_tip = "this provides a Snd emacs mode implementation.<br>" +
- " You can use emacs as the listener, rather than the built-in Snd window.";
-
-var jcrev_doc_tip = "this is probably the first Schroeder reverb, based on all-pass and comb filters.";
-
-var maraca_doc_tip = "this includes the maraca, tambourine, wind-chimes, etc";
-
-var marks_doc_tip = "this includes describe-mark, eval-between-marks, mark-property,<br>" +
- " play-between-marks, and snap-marks.";
-
-var maxf_doc_tip = "This is a collection of modal synthesis demos.<br>" +
- " For the actual filter, see the firmant generator";
-
-var menus_doc_tip = "Menu additions for things like crop, trim, fft notch filter,<br>" +
- " mark and mix functions, etc. The main added menu loads a huge<br>" +
- " set of sound effects";
-
-var mix_doc_tip = "mix-property, silence-all-mixes, mix-sound, save-mix, snap-mix-to-beat<br>" +
- " and many functions acting on lists of mixes";
-
-var mixer_doc_tip = "mixers and frames treated as matrices and vectors: <br>" +
- " matrix determinant, transpose, invert, solve, mixer-poly, etc";
-
-var moog_doc_tip = "Moog's four pole lowpass (24db/Oct) filter as a clm generator,<br>" +
- " variable resonance, \"that warm, analog sound\".";
-
-var musglyphs_doc_tip = "The CMN music symbol font built from bezier curves.<br>" +
- "This file is a lisp->scheme wrapper for cmn-glyphs.lisp";
-
-var nb_doc_tip = "As you move the mouse through the view-files list,<br>" +
- " the help dialog posts information about the file underneath the mouse";
-
-var noise_doc_tip = "This ancient noise instrument can produce those all-important whooshing<br>" +
- " sounds. noise.ins translated to Scheme/Ruby by Michael Scholz";
-
-var numerics_doc_tip = "Various numerical functions: factorial, plgndr, gegenbaur, etc";
-
-var oscope_doc_tip = "oscope.scm sets up a dialog with a Snd channel window<br>" +
- " (time domain, fft etc) that displays data read from the<br>" +
- " microphone in real time.";
-
-var piano_doc_tip = "Scott van Duyne's piano model that includes multiple coupled strings,<br>" +
- " a nonlinear hammer, and an arbitrarily large soundboard and enclosure";
-
-var play_doc_tip = "play between marks, play continuously, play a set of sines, etc";
-
-var poly_doc_tip = "polynomial addition, multiplication, division, gcd, roots, and discriminant";
-
-var prc95_doc_tip = "The basic physical models: pluck, bow, clarinet, brass, flute";
-
-var pvoc_doc_tip = "various versions of the Moore-Klingbeil-Trevisani-Edwards phase-vocoder.<br>" +
- "see also the CLM phase-vocoder generator.";
-
-var rgb_doc_tip = "this translates the standard X11 color names into Snd color objects.";
-
-var rtio_doc_tip = "show graph of real-time input and so on";
-
-var rubber_doc_tip = "rubber-sound tries to stretch or contract a sound (in time);<br>" +
- " it scans the sound looking for stable sections, then either <br>" +
- " deletes periods or interpolates new ones to shorten or lengthen the sound";
-
-var selection_doc_tip = "includes swap-selection-channels, replace-with-selection, <br>" +
- " selection-members, make-selection, delete-selection-and-smooth,<br>" +
- " filter-selection-and-smooth, and with-temporary-selection";
-
-var singer_doc_tip = "This is based on Perry's singer.c and CLM's singer.ins";
-
-var sndold_doc_tip = "These files (snd9.scm to snd11.scm) provide backwards compatibility<br>" +
- " with earlier versions of Snd.";
-
-var snddiff_doc_tip = "a diff or grep-like function for sounds. It can currently find<br>" +
- " initial delays, scaling differences, and scattered individual<br>" +
- " sample differences: <code>(snddiff snd0 chn0 snd1 chn1)</code>.";
-
-var snd_gl_doc_tip = "This depends on access to openGL (Mesa); it includes a waterfall fft graph<br>" +
- "and GL state readbacks";
-
-var snd_motif_doc_tip = "user interface extensions using the libxm modules: add-mark-pane,<br>" +
- " display-scanned-synthesis, load-font, with-level-meters,<br>" +
- " variable-display, smpte labels, and lots more.<br>" +
- " snd-motif is for Motif, snd-gtk for Gtk.";
-
-var snd_test_doc_tip = "Snd regression test suite; zillions of examples.";
-
-var sndwarp_doc_tip = "time stretching and whatnot";
-
-var ws_doc_tip = "with-sound provides a simple way to package up a bunch of<br>" +
- " instrument calls into a new sound file, and open that file in Snd";
-
-var zip_doc_tip = "The zipper marches through the two sounds taking equal short portions<br>" +
- " of each, then abutting them while resampling so that as one sound<br>" +
- " takes less overall frame space, the other takes more.";
-
-var scheme_format_tip = "<code>(format destination control-string :rest args)</code> produces formatted output.<br>" +
- "If 'destination' is #f (the usual case in Snd), the output is a string.<br>" +
- "The output depends on 'control-string' which can contain characters preceded by tilde.<br>" +
- "These are replaced with other strings based on the character and the associated argument in 'args'.<br>" +
- "The main tilde cases are ~% = add a newline, ~A = add some readable description of its argument<br>" +
- "~D = treat its arg as an integer, ~F = treat arg as float, ~S = treat arg as string.<br><br>" +
- "<code>(format #f \"A: ~A, D: ~D, F: ~F~%\" (make-vct 2 3.14) 32 1.5)</code><br><br>" +
- "produces:<br><br>" +
- "<code>\"A: #<vct[len=2]: 3.140 3.140>, D: 32, F: 1.5<br>" +
- "\"</code>.";
-
-var scheme_reset_hook_tip = "<code>(reset-hook! hook)</code>: removes all functions from 'hook'.";
\ No newline at end of file
diff --git a/wz_tooltip.js b/wz_tooltip.js
deleted file mode 100644
index 0c939f6..0000000
--- a/wz_tooltip.js
+++ /dev/null
@@ -1,1243 +0,0 @@
-/* This notice must be untouched at all times.
-Copyright (c) 2002-2008 Walter Zorn. All rights reserved.
-
-wz_tooltip.js v. 5.01
-
-The latest version is available at
-http://www.walterzorn.com
-or http://www.devira.com
-or http://www.walterzorn.de
-
-Created 1.12.2002 by Walter Zorn (Web: http://www.walterzorn.com )
-Last modified: 26.3.2008
-
-Easy-to-use cross-browser tooltips.
-Just include the script at the beginning of the <body> section, and invoke
-Tip('Tooltip text') from the desired HTML onmouseover eventhandlers,
-and UnTip(), usually from the onmouseout eventhandlers, to hide the tip.
-No container DIV required.
-By default, width and height of tooltips are automatically adapted to content.
-Is even capable of dynamically converting arbitrary HTML elements to tooltips
-by calling TagToTip('ID_of_HTML_element_to_be_converted') instead of Tip(),
-which means you can put important, search-engine-relevant stuff into tooltips.
-Appearance of tooltips can be individually configured
-via commands passed to Tip() or TagToTip().
-
-Tab Width: 4
-LICENSE: LGPL
-
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License (LGPL) as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
-
-This library 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.
-
-For more details on the GNU Lesser General Public License,
-see http://www.gnu.org/copyleft/lesser.html
-*/
-
-var config = new Object();
-
-
-//=================== GLOBAL TOOPTIP CONFIGURATION =========================//
-var tt_Debug = true // false or true - recommended: false once you release your page to the public
-var tt_Enabled = true // Allows to (temporarily) suppress tooltips, e.g. by providing the user with a button that sets this global variable to false
-var TagsToTip = true // false or true - if true, HTML elements to be converted to tooltips via TagToTip() are automatically hidden;
- // if false, you should hide those HTML elements yourself
-
-// For each of the following config variables there exists a command, which is
-// just the variablename in uppercase, to be passed to Tip() or TagToTip() to
-// configure tooltips individually. Individual commands override global
-// configuration. Order of commands is arbitrary.
-// Example: onmouseover="Tip('Tooltip text', LEFT, true, BGCOLOR, '#FF9900', FADEIN, 400)"
-
-config. Above = false // false or true - tooltip above mousepointer
- // config. BgColor = '#E2E7FF' // Background colour (HTML colour value, in quotes)
-config. BgColor = '#f5f5dc'
-config. BgImg = '' // Path to background image, none if empty string ''
- // config. BorderColor = '#003099'
- // config. BorderColor = '#4070ff'
-config. BorderColor = '#40ff70'
-config. BorderStyle = 'solid' // Any permitted CSS value, but I recommend 'solid', 'dotted' or 'dashed'
-config. BorderWidth = 2
-config. CenterMouse = false // false or true - center the tip horizontally below (or above) the mousepointer
-config. ClickClose = false // false or true - close tooltip if the user clicks somewhere
-config. ClickSticky = false // false or true - make tooltip sticky if user left-clicks on the hovered element while the tooltip is active
-config. CloseBtn = false // false or true - closebutton in titlebar
-config. CloseBtnColors = ['#990000', '#FFFFFF', '#DD3333', '#FFFFFF'] // [Background, text, hovered background, hovered text] - use empty strings '' to inherit title colours
-config. CloseBtnText = ' X ' // Close button text (may also be an image tag)
-config. CopyContent = true // When converting a HTML element to a tooltip, copy only the element's content, rather than converting the element by its own
-config. Delay = 1000 // Time span in ms until tooltip shows up
-config. Duration = 0 // Time span in ms after which the tooltip disappears; 0 for infinite duration, < 0 for delay in ms _after_ the onmouseout until the tooltip disappears
-config. FadeIn = 120 // Fade-in duration in ms, e.g. 400; 0 for no animation
-config. FadeOut = 120
-config. FadeInterval = 30 // Duration of each fade step in ms (recommended: 30) - shorter is smoother but causes more CPU-load
-config. Fix = null // Fixated position - x- an y-oordinates in brackets, e.g. [210, 480], or null for no fixation
-config. FollowMouse = true // false or true - tooltip follows the mouse
-config. FontColor = '#000044'
-config. FontFace = 'Verdana,Geneva,sans-serif'
- // config. FontSize = '8pt' // E.g. '9pt' or '12px' - unit is mandatory
-config. FontSize = '9pt' // E.g. '9pt' or '12px' - unit is mandatory
-config. FontWeight = 'normal' // 'normal' or 'bold';
-config. Height = 0 // Tooltip height; 0 for automatic adaption to tooltip content, < 0 (e.g. -100) for a maximum for automatic adaption
-config. JumpHorz = false // false or true - jump horizontally to other side of mouse if tooltip would extend past clientarea boundary
-config. JumpVert = true // false or true - jump vertically "
-config. Left = false // false or true - tooltip on the left of the mouse
-config. OffsetX = 100 // Horizontal offset of left-top corner from mousepointer
-config. OffsetY = 20 // Vertical offset
-config. Opacity = 100 // Integer between 0 and 100 - opacity of tooltip in percent
-config. Padding = 4 // Spacing between border and content
-config. Shadow = false // false or true
-config. ShadowColor = '#C0C0C0'
-config. ShadowWidth = 5
-config. Sticky = false // false or true - fixate tip, ie. don't follow the mouse and don't hide on mouseout
-config. TextAlign = 'left' // 'left', 'right' or 'justify'
-config. Title = '' // Default title text applied to all tips (no default title: empty string '')
-config. TitleAlign = 'left' // 'left' or 'right' - text alignment inside the title bar
-config. TitleBgColor = '' // If empty string '', BorderColor will be used
-config. TitleFontColor = '#000000' // Color of title text - if '', BgColor (of tooltip body) will be used
-config. TitleFontFace = '' // If '' use FontFace (boldified)
-config. TitleFontSize = '' // If '' use FontSize
-config. Width = 0 // Tooltip width; 0 for automatic adaption to tooltip content; < -1 (e.g. -240) for a maximum width for that automatic adaption;
- // -1: tooltip width confined to the width required for the titlebar
-//======= END OF TOOLTIP CONFIG, DO NOT CHANGE ANYTHING BELOW ==============//
-
-
-
-
-//===================== PUBLIC =============================================//
-function Tip()
-{
- tt_Tip(arguments, null);
-}
-function TagToTip()
-{
- var t2t = tt_GetElt(arguments[0]);
- if(t2t)
- tt_Tip(arguments, t2t);
-}
-function UnTip()
-{
- tt_OpReHref();
- if(tt_aV[DURATION] < 0)
- tt_tDurt.Timer("tt_HideInit()", -tt_aV[DURATION], true);
- else if(!(tt_aV[STICKY] && (tt_iState & 0x2)))
- tt_HideInit();
-}
-
-//================== PUBLIC PLUGIN API =====================================//
-// Extension eventhandlers currently supported:
-// OnLoadConfig, OnCreateContentString, OnSubDivsCreated, OnShow, OnMoveBefore,
-// OnMoveAfter, OnHideInit, OnHide, OnKill
-
-var tt_aElt = new Array(10), // Container DIV, outer title & body DIVs, inner title & body TDs, closebutton SPAN, shadow DIVs, and IFRAME to cover windowed elements in IE
-tt_aV = new Array(), // Caches and enumerates config data for currently active tooltip
-tt_sContent, // Inner tooltip text or HTML
-tt_scrlX = 0, tt_scrlY = 0,
-tt_musX, tt_musY,
-tt_over,
-tt_x, tt_y, tt_w, tt_h; // Position, width and height of currently displayed tooltip
-
-function tt_Extension()
-{
- tt_ExtCmdEnum();
- tt_aExt[tt_aExt.length] = this;
- return this;
-}
-function tt_SetTipPos(x, y)
-{
- var css = tt_aElt[0].style;
-
- tt_x = x;
- tt_y = y;
- css.left = x + "px";
- css.top = y + "px";
- if(tt_ie56)
- {
- var ifrm = tt_aElt[tt_aElt.length - 1];
- if(ifrm)
- {
- ifrm.style.left = css.left;
- ifrm.style.top = css.top;
- }
- }
-}
-function tt_HideInit()
-{
- if(tt_iState)
- {
- tt_ExtCallFncs(0, "HideInit");
- tt_iState &= ~0x4;
- if(tt_flagOpa && tt_aV[FADEOUT])
- {
- tt_tFade.EndTimer();
- if(tt_opa)
- {
- var n = Math.round(tt_aV[FADEOUT] / (tt_aV[FADEINTERVAL] * (tt_aV[OPACITY] / tt_opa)));
- tt_Fade(tt_opa, tt_opa, 0, n);
- return;
- }
- }
- tt_tHide.Timer("tt_Hide();", 1, false);
- }
-}
-function tt_Hide()
-{
- if(tt_db && tt_iState)
- {
- tt_OpReHref();
- if(tt_iState & 0x2)
- {
- tt_aElt[0].style.visibility = "hidden";
- tt_ExtCallFncs(0, "Hide");
- }
- tt_tShow.EndTimer();
- tt_tHide.EndTimer();
- tt_tDurt.EndTimer();
- tt_tFade.EndTimer();
- if(!tt_op && !tt_ie)
- {
- tt_tWaitMov.EndTimer();
- tt_bWait = false;
- }
- if(tt_aV[CLICKCLOSE] || tt_aV[CLICKSTICKY])
- tt_RemEvtFnc(document, "mouseup", tt_OnLClick);
- tt_ExtCallFncs(0, "Kill");
- // In case of a TagToTip tooltip, hide converted DOM node and
- // re-insert it into document
- if(tt_t2t && !tt_aV[COPYCONTENT])
- {
- tt_t2t.style.display = "none";
- tt_MovDomNode(tt_t2t, tt_aElt[6], tt_t2tDad);
- }
- tt_iState = 0;
- tt_over = null;
- tt_ResetMainDiv();
- if(tt_aElt[tt_aElt.length - 1])
- tt_aElt[tt_aElt.length - 1].style.display = "none";
- }
-}
-function tt_GetElt(id)
-{
- return(document.getElementById ? document.getElementById(id)
- : document.all ? document.all[id]
- : null);
-}
-function tt_GetDivW(el)
-{
- return(el ? (el.offsetWidth || el.style.pixelWidth || 0) : 0);
-}
-function tt_GetDivH(el)
-{
- return(el ? (el.offsetHeight || el.style.pixelHeight || 0) : 0);
-}
-function tt_GetScrollX()
-{
- return(window.pageXOffset || (tt_db ? (tt_db.scrollLeft || 0) : 0));
-}
-function tt_GetScrollY()
-{
- return(window.pageYOffset || (tt_db ? (tt_db.scrollTop || 0) : 0));
-}
-function tt_GetClientW()
-{
- return(document.body && (typeof(document.body.clientWidth) != tt_u) ? document.body.clientWidth
- : (typeof(window.innerWidth) != tt_u) ? window.innerWidth
- : tt_db ? (tt_db.clientWidth || 0)
- : 0);
-}
-function tt_GetClientH()
-{
- // Exactly this order seems to yield correct values in all major browsers
- return(document.body && (typeof(document.body.clientHeight) != tt_u) ? document.body.clientHeight
- : (typeof(window.innerHeight) != tt_u) ? window.innerHeight
- : tt_db ? (tt_db.clientHeight || 0)
- : 0);
-}
-function tt_GetEvtX(e)
-{
- return (e ? ((typeof(e.pageX) != tt_u) ? e.pageX : (e.clientX + tt_scrlX)) : 0);
-}
-function tt_GetEvtY(e)
-{
- return (e ? ((typeof(e.pageY) != tt_u) ? e.pageY : (e.clientY + tt_scrlY)) : 0);
-}
-function tt_AddEvtFnc(el, sEvt, PFnc)
-{
- if(el)
- {
- if(el.addEventListener)
- el.addEventListener(sEvt, PFnc, false);
- else
- el.attachEvent("on" + sEvt, PFnc);
- }
-}
-function tt_RemEvtFnc(el, sEvt, PFnc)
-{
- if(el)
- {
- if(el.removeEventListener)
- el.removeEventListener(sEvt, PFnc, false);
- else
- el.detachEvent("on" + sEvt, PFnc);
- }
-}
-
-//====================== PRIVATE ===========================================//
-var tt_aExt = new Array(), // Array of extension objects
-
-tt_db, tt_op, tt_ie, tt_ie56, tt_bBoxOld, // Browser flags
-tt_body,
-tt_ovr_, // HTML element the mouse is currently over
-tt_flagOpa, // Opacity support: 1=IE, 2=Khtml, 3=KHTML, 4=Moz, 5=W3C
-tt_maxPosX, tt_maxPosY,
-tt_iState = 0, // Tooltip active |= 1, shown |= 2, move with mouse |= 4
-tt_opa, // Currently applied opacity
-tt_bJmpVert, tt_bJmpHorz,// Tip temporarily on other side of mouse
-tt_t2t, tt_t2tDad, // Tag converted to tip, and its parent element in the document
-tt_elDeHref, // The tag from which we've removed the href attribute
-// Timer
-tt_tShow = new Number(0), tt_tHide = new Number(0), tt_tDurt = new Number(0),
-tt_tFade = new Number(0), tt_tWaitMov = new Number(0),
-tt_bWait = false,
-tt_u = "undefined";
-
-
-function tt_Init()
-{
- tt_MkCmdEnum();
- // Send old browsers instantly to hell
- if(!tt_Browser() || !tt_MkMainDiv())
- return;
- tt_IsW3cBox();
- tt_OpaSupport();
- tt_AddEvtFnc(window, "scroll", tt_OnScrl);
- // IE doesn't fire onscroll event when switching to fullscreen;
- // fix suggested by Yoav Karpeles 14.2.2008
- tt_AddEvtFnc(window, "resize", tt_OnScrl);
- tt_AddEvtFnc(document, "mousemove", tt_Move);
- // In Debug mode we search for TagToTip() calls in order to notify
- // the user if they've forgotten to set the TagsToTip config flag
- if(TagsToTip || tt_Debug)
- tt_SetOnloadFnc();
- // Ensure the tip be hidden when the page unloads
- tt_AddEvtFnc(window, "unload", tt_Hide);
-}
-// Creates command names by translating config variable names to upper case
-function tt_MkCmdEnum()
-{
- var n = 0;
- for(var i in config)
- eval("window." + i.toString().toUpperCase() + " = " + n++);
- tt_aV.length = n;
-}
-function tt_Browser()
-{
- var n, nv, n6, w3c;
-
- n = navigator.userAgent.toLowerCase(),
- nv = navigator.appVersion;
- tt_op = (document.defaultView && typeof(eval("w" + "indow" + "." + "o" + "p" + "er" + "a")) != tt_u);
- tt_ie = n.indexOf("msie") != -1 && document.all && !tt_op;
- if(tt_ie)
- {
- var ieOld = (!document.compatMode || document.compatMode == "BackCompat");
- tt_db = !ieOld ? document.documentElement : (document.body || null);
- if(tt_db)
- tt_ie56 = parseFloat(nv.substring(nv.indexOf("MSIE") + 5)) >= 5.5
- && typeof document.body.style.maxHeight == tt_u;
- }
- else
- {
- tt_db = document.documentElement || document.body ||
- (document.getElementsByTagName ? document.getElementsByTagName("body")[0]
- : null);
- if(!tt_op)
- {
- n6 = document.defaultView && typeof document.defaultView.getComputedStyle != tt_u;
- w3c = !n6 && document.getElementById;
- }
- }
- tt_body = (document.getElementsByTagName ? document.getElementsByTagName("body")[0]
- : (document.body || null));
- if(tt_ie || n6 || tt_op || w3c)
- {
- if(tt_body && tt_db)
- {
- if(document.attachEvent || document.addEventListener)
- return true;
- }
- else
- tt_Err("wz_tooltip.js must be included INSIDE the body section,"
- + " immediately after the opening <body> tag.", false);
- }
- tt_db = null;
- return false;
-}
-function tt_MkMainDiv()
-{
- // Create the tooltip DIV
- if(tt_body.insertAdjacentHTML)
- tt_body.insertAdjacentHTML("afterBegin", tt_MkMainDivHtm());
- else if(typeof tt_body.innerHTML != tt_u && document.createElement && tt_body.appendChild)
- tt_body.appendChild(tt_MkMainDivDom());
- if(window.tt_GetMainDivRefs /* FireFox Alzheimer */ && tt_GetMainDivRefs())
- return true;
- tt_db = null;
- return false;
-}
-function tt_MkMainDivHtm()
-{
- return('<div id="WzTtDiV"></div>' +
- (tt_ie56 ? ('<iframe id="WzTtIfRm" src="javascript:false" scrolling="no" frameborder="0" style="filter:Alpha(opacity=0);position:absolute;top:0px;left:0px;display:none;"></iframe>')
- : ''));
-}
-function tt_MkMainDivDom()
-{
- var el = document.createElement("div");
- if(el)
- el.id = "WzTtDiV";
- return el;
-}
-function tt_GetMainDivRefs()
-{
- tt_aElt[0] = tt_GetElt("WzTtDiV");
- if(tt_ie56 && tt_aElt[0])
- {
- tt_aElt[tt_aElt.length - 1] = tt_GetElt("WzTtIfRm");
- if(!tt_aElt[tt_aElt.length - 1])
- tt_aElt[0] = null;
- }
- if(tt_aElt[0])
- {
- var css = tt_aElt[0].style;
-
- css.visibility = "hidden";
- css.position = "absolute";
- css.overflow = "hidden";
- return true;
- }
- return false;
-}
-function tt_ResetMainDiv()
-{
- var w = (window.screen && screen.width) ? screen.width : 10000;
-
- tt_SetTipPos(-w, 0);
- tt_aElt[0].innerHTML = "";
- tt_aElt[0].style.width = (w - 1) + "px";
- tt_h = 0;
-}
-function tt_IsW3cBox()
-{
- var css = tt_aElt[0].style;
-
- css.padding = "10px";
- css.width = "40px";
- tt_bBoxOld = (tt_GetDivW(tt_aElt[0]) == 40);
- css.padding = "0px";
- tt_ResetMainDiv();
-}
-function tt_OpaSupport()
-{
- var css = tt_body.style;
-
- tt_flagOpa = (typeof(css.filter) != tt_u) ? 1
- : (typeof(css.KhtmlOpacity) != tt_u) ? 2
- : (typeof(css.KHTMLOpacity) != tt_u) ? 3
- : (typeof(css.MozOpacity) != tt_u) ? 4
- : (typeof(css.opacity) != tt_u) ? 5
- : 0;
-}
-// Ported from http://dean.edwards.name/weblog/2006/06/again/
-// (Dean Edwards et al.)
-function tt_SetOnloadFnc()
-{
- tt_AddEvtFnc(document, "DOMContentLoaded", tt_HideSrcTags);
- tt_AddEvtFnc(window, "load", tt_HideSrcTags);
- if(tt_body.attachEvent)
- tt_body.attachEvent("onreadystatechange",
- function() {
- if(tt_body.readyState == "complete")
- tt_HideSrcTags();
- } );
- if(/WebKit|KHTML/i.test(navigator.userAgent))
- {
- var t = setInterval(function() {
- if(/loaded|complete/.test(document.readyState))
- {
- clearInterval(t);
- tt_HideSrcTags();
- }
- }, 10);
- }
-}
-function tt_HideSrcTags()
-{
- if(!window.tt_HideSrcTags || window.tt_HideSrcTags.done)
- return;
- window.tt_HideSrcTags.done = true;
- if(!tt_HideSrcTagsRecurs(tt_body))
- tt_Err("There are HTML elements to be converted to tooltips.\nIf you"
- + " want these HTML elements to be automatically hidden, you"
- + " must edit wz_tooltip.js, and set TagsToTip in the global"
- + " tooltip configuration to true.", true);
-}
-function tt_HideSrcTagsRecurs(dad)
-{
- var ovr, asT2t;
- // Walk the DOM tree for tags that have an onmouseover or onclick attribute
- // containing a TagToTip('...') call.
- // (.childNodes first since .children is bugous in Safari)
- var a = dad.childNodes || dad.children || null;
-
- for(var i = a ? a.length : 0; i;)
- {--i;
- if(!tt_HideSrcTagsRecurs(a[i]))
- return false;
- ovr = a[i].getAttribute ? (a[i].getAttribute("onmouseover") || a[i].getAttribute("onclick"))
- : (typeof a[i].onmouseover == "function") ? (a[i].onmouseover || a[i].onclick)
- : null;
- if(ovr)
- {
- asT2t = ovr.toString().match(/TagToTip\s*\(\s*'[^'.]+'\s*[\),]/);
- if(asT2t && asT2t.length)
- {
- if(!tt_HideSrcTag(asT2t[0]))
- return false;
- }
- }
- }
- return true;
-}
-function tt_HideSrcTag(sT2t)
-{
- var id, el;
-
- // The ID passed to the found TagToTip() call identifies an HTML element
- // to be converted to a tooltip, so hide that element
- id = sT2t.replace(/.+'([^'.]+)'.+/, "$1");
- el = tt_GetElt(id);
- if(el)
- {
- if(tt_Debug && !TagsToTip)
- return false;
- else
- el.style.display = "none";
- }
- else
- tt_Err("Invalid ID\n'" + id + "'\npassed to TagToTip()."
- + " There exists no HTML element with that ID.", true);
- return true;
-}
-function tt_Tip(arg, t2t)
-{
- if(!tt_db)
- return;
- if(tt_iState)
- tt_Hide();
- if(!tt_Enabled)
- return;
- tt_t2t = t2t;
- if(!tt_ReadCmds(arg))
- return;
- tt_iState = 0x1 | 0x4;
- tt_AdaptConfig1();
- tt_MkTipContent(arg);
- tt_MkTipSubDivs();
- tt_FormatTip();
- tt_bJmpVert = false;
- tt_bJmpHorz = false;
- tt_maxPosX = tt_GetClientW() + tt_scrlX - tt_w - 1;
- tt_maxPosY = tt_GetClientH() + tt_scrlY - tt_h - 1;
- tt_AdaptConfig2();
- // Ensure the tip be shown and positioned before the first onmousemove
- tt_OverInit();
- tt_ShowInit();
- tt_Move();
-}
-function tt_ReadCmds(a)
-{
- var i;
-
- // First load the global config values, to initialize also values
- // for which no command is passed
- i = 0;
- for(var j in config)
- tt_aV[i++] = config[j];
- // Then replace each cached config value for which a command is
- // passed (ensure the # of command args plus value args be even)
- if(a.length & 1)
- {
- for(i = a.length - 1; i > 0; i -= 2)
- tt_aV[a[i - 1]] = a[i];
- return true;
- }
- tt_Err("Incorrect call of Tip() or TagToTip().\n"
- + "Each command must be followed by a value.", true);
- return false;
-}
-function tt_AdaptConfig1()
-{
- tt_ExtCallFncs(0, "LoadConfig");
- // Inherit unspecified title formattings from body
- if(!tt_aV[TITLEBGCOLOR].length)
- tt_aV[TITLEBGCOLOR] = tt_aV[BORDERCOLOR];
- if(!tt_aV[TITLEFONTCOLOR].length)
- tt_aV[TITLEFONTCOLOR] = tt_aV[BGCOLOR];
- if(!tt_aV[TITLEFONTFACE].length)
- tt_aV[TITLEFONTFACE] = tt_aV[FONTFACE];
- if(!tt_aV[TITLEFONTSIZE].length)
- tt_aV[TITLEFONTSIZE] = tt_aV[FONTSIZE];
- if(tt_aV[CLOSEBTN])
- {
- // Use title colours for non-specified closebutton colours
- if(!tt_aV[CLOSEBTNCOLORS])
- tt_aV[CLOSEBTNCOLORS] = new Array("", "", "", "");
- for(var i = 4; i;)
- {--i;
- if(!tt_aV[CLOSEBTNCOLORS][i].length)
- tt_aV[CLOSEBTNCOLORS][i] = (i & 1) ? tt_aV[TITLEFONTCOLOR] : tt_aV[TITLEBGCOLOR];
- }
- // Enforce titlebar be shown
- if(!tt_aV[TITLE].length)
- tt_aV[TITLE] = " ";
- }
- // Circumvents broken display of images and fade-in flicker in Geckos < 1.8
- if(tt_aV[OPACITY] == 100 && typeof tt_aElt[0].style.MozOpacity != tt_u && !Array.every)
- tt_aV[OPACITY] = 99;
- // Smartly shorten the delay for fade-in tooltips
- if(tt_aV[FADEIN] && tt_flagOpa && tt_aV[DELAY] > 100)
- tt_aV[DELAY] = Math.max(tt_aV[DELAY] - tt_aV[FADEIN], 100);
-}
-function tt_AdaptConfig2()
-{
- if(tt_aV[CENTERMOUSE])
- {
- tt_aV[OFFSETX] -= ((tt_w - (tt_aV[SHADOW] ? tt_aV[SHADOWWIDTH] : 0)) >> 1);
- tt_aV[JUMPHORZ] = false;
- }
-}
-// Expose content globally so extensions can modify it
-function tt_MkTipContent(a)
-{
- if(tt_t2t)
- {
- if(tt_aV[COPYCONTENT])
- tt_sContent = tt_t2t.innerHTML;
- else
- tt_sContent = "";
- }
- else
- tt_sContent = a[0];
- tt_ExtCallFncs(0, "CreateContentString");
-}
-function tt_MkTipSubDivs()
-{
- var sCss = 'position:relative;margin:0px;padding:0px;border-width:0px;left:0px;top:0px;line-height:normal;width:auto;',
- sTbTrTd = ' cellspacing="0" cellpadding="0" border="0" style="' + sCss + '"><tbody style="' + sCss + '"><tr><td ';
-
- tt_aElt[0].innerHTML =
- (''
- + (tt_aV[TITLE].length ?
- ('<div id="WzTiTl" style="position:relative;z-index:1;">'
- + '<table id="WzTiTlTb"' + sTbTrTd + 'id="WzTiTlI" style="' + sCss + '">'
- + tt_aV[TITLE]
- + '</td>'
- + (tt_aV[CLOSEBTN] ?
- ('<td align="right" style="' + sCss
- + 'text-align:right;">'
- + '<span id="WzClOsE" style="padding-left:2px;padding-right:2px;'
- + 'cursor:' + (tt_ie ? 'hand' : 'pointer')
- + ';" onmouseover="tt_OnCloseBtnOver(1)" onmouseout="tt_OnCloseBtnOver(0)" onclick="tt_HideInit()">'
- + tt_aV[CLOSEBTNTEXT]
- + '</span></td>')
- : '')
- + '</tr></tbody></table></div>')
- : '')
- + '<div id="WzBoDy" style="position:relative;z-index:0;">'
- + '<table' + sTbTrTd + 'id="WzBoDyI" style="' + sCss + '">'
- + tt_sContent
- + '</td></tr></tbody></table></div>'
- + (tt_aV[SHADOW]
- ? ('<div id="WzTtShDwR" style="position:absolute;overflow:hidden;"></div>'
- + '<div id="WzTtShDwB" style="position:relative;overflow:hidden;"></div>')
- : '')
- );
- tt_GetSubDivRefs();
- // Convert DOM node to tip
- if(tt_t2t && !tt_aV[COPYCONTENT])
- {
- // Store the tag's parent element so we can restore that DOM branch
- // once the tooltip is hidden
- tt_t2tDad = tt_t2t.parentNode || tt_t2t.parentElement || tt_t2t.offsetParent || null;
- if(tt_t2tDad)
- {
- tt_MovDomNode(tt_t2t, tt_t2tDad, tt_aElt[6]);
- tt_t2t.style.display = "block";
- }
- }
- tt_ExtCallFncs(0, "SubDivsCreated");
-}
-function tt_GetSubDivRefs()
-{
- var aId = new Array("WzTiTl", "WzTiTlTb", "WzTiTlI", "WzClOsE", "WzBoDy", "WzBoDyI", "WzTtShDwB", "WzTtShDwR");
-
- for(var i = aId.length; i; --i)
- tt_aElt[i] = tt_GetElt(aId[i - 1]);
-}
-function tt_FormatTip()
-{
- var css, w, h, iOffY, iOffSh,
- iAdd = (tt_aV[PADDING] + tt_aV[BORDERWIDTH]) << 1;
-
- //--------- Title DIV ----------
- if(tt_aV[TITLE].length)
- {
- css = tt_aElt[1].style;
- css.background = tt_aV[TITLEBGCOLOR];
- css.paddingTop = (tt_aV[CLOSEBTN] ? 2 : 0) + "px";
- css.paddingBottom = "1px";
- css.paddingLeft = css.paddingRight = tt_aV[PADDING] + "px";
- css = tt_aElt[3].style;
- css.color = tt_aV[TITLEFONTCOLOR];
- if (tt_aV[WIDTH] == -1)
- css.whiteSpace = "nowrap";
- css.fontFamily = tt_aV[TITLEFONTFACE];
- css.fontSize = tt_aV[TITLEFONTSIZE];
- css.fontWeight = "bold";
- css.textAlign = tt_aV[TITLEALIGN];
- // Close button DIV
- if(tt_aElt[4])
- {
- css.paddingRight = (tt_aV[PADDING] << 1) + "px";
- css = tt_aElt[4].style;
- css.background = tt_aV[CLOSEBTNCOLORS][0];
- css.color = tt_aV[CLOSEBTNCOLORS][1];
- css.fontFamily = tt_aV[TITLEFONTFACE];
- css.fontSize = tt_aV[TITLEFONTSIZE];
- css.fontWeight = "bold";
- }
- if(tt_aV[WIDTH] > 0)
- tt_w = tt_aV[WIDTH];
- else
- {
- tt_w = tt_GetDivW(tt_aElt[3]) + tt_GetDivW(tt_aElt[4]);
- // Some spacing between title DIV and closebutton
- if(tt_aElt[4])
- tt_w += tt_aV[PADDING];
- // Restrict auto width to max width
- if(tt_aV[WIDTH] < -1 && tt_w > -tt_aV[WIDTH])
- tt_w = -tt_aV[WIDTH];
- }
- // Ensure the top border of the body DIV be covered by the title DIV
- iOffY = -tt_aV[BORDERWIDTH];
- }
- else
- {
- tt_w = 0;
- iOffY = 0;
- }
-
- //-------- Body DIV ------------
- css = tt_aElt[5].style;
- css.top = iOffY + "px";
- if(tt_aV[BORDERWIDTH])
- {
- css.borderColor = tt_aV[BORDERCOLOR];
- css.borderStyle = tt_aV[BORDERSTYLE];
- css.borderWidth = tt_aV[BORDERWIDTH] + "px";
- }
- if(tt_aV[BGCOLOR].length)
- css.background = tt_aV[BGCOLOR];
- if(tt_aV[BGIMG].length)
- css.backgroundImage = "url(" + tt_aV[BGIMG] + ")";
- css.padding = tt_aV[PADDING] + "px";
- css.textAlign = tt_aV[TEXTALIGN];
- if(tt_aV[HEIGHT])
- {
- css.overflow = "auto";
- if(tt_aV[HEIGHT] > 0)
- css.height = (tt_aV[HEIGHT] + iAdd) + "px";
- else
- tt_h = iAdd - tt_aV[HEIGHT];
- }
- // TD inside body DIV
- css = tt_aElt[6].style;
- css.color = tt_aV[FONTCOLOR];
- css.fontFamily = tt_aV[FONTFACE];
- css.fontSize = tt_aV[FONTSIZE];
- css.fontWeight = tt_aV[FONTWEIGHT];
- css.background = "";
- css.textAlign = tt_aV[TEXTALIGN];
- if(tt_aV[WIDTH] > 0)
- w = tt_aV[WIDTH];
- // Width like title (if existent)
- else if(tt_aV[WIDTH] == -1 && tt_w)
- w = tt_w;
- else
- {
- // Measure width of the body's inner TD, as some browsers would expand
- // the container and outer body DIV to 100%
- w = tt_GetDivW(tt_aElt[6]);
- // Restrict auto width to max width
- if(tt_aV[WIDTH] < -1 && w > -tt_aV[WIDTH])
- w = -tt_aV[WIDTH];
- }
- if(w > tt_w)
- tt_w = w;
- tt_w += iAdd;
-
- //--------- Shadow DIVs ------------
- if(tt_aV[SHADOW])
- {
- tt_w += tt_aV[SHADOWWIDTH];
- iOffSh = Math.floor((tt_aV[SHADOWWIDTH] * 4) / 3);
- // Bottom shadow
- css = tt_aElt[7].style;
- css.top = iOffY + "px";
- css.left = iOffSh + "px";
- css.width = (tt_w - iOffSh - tt_aV[SHADOWWIDTH]) + "px";
- css.height = tt_aV[SHADOWWIDTH] + "px";
- css.background = tt_aV[SHADOWCOLOR];
- // Right shadow
- css = tt_aElt[8].style;
- css.top = iOffSh + "px";
- css.left = (tt_w - tt_aV[SHADOWWIDTH]) + "px";
- css.width = tt_aV[SHADOWWIDTH] + "px";
- css.background = tt_aV[SHADOWCOLOR];
- }
- else
- iOffSh = 0;
-
- //-------- Container DIV -------
- tt_SetTipOpa(tt_aV[FADEIN] ? 0 : tt_aV[OPACITY]);
- tt_FixSize(iOffY, iOffSh);
-}
-// Fixate the size so it can't dynamically change while the tooltip is moving.
-function tt_FixSize(iOffY, iOffSh)
-{
- var wIn, wOut, h, add, i;
-
- tt_aElt[0].style.width = tt_w + "px";
- tt_aElt[0].style.pixelWidth = tt_w;
- wOut = tt_w - ((tt_aV[SHADOW]) ? tt_aV[SHADOWWIDTH] : 0);
- // Body
- wIn = wOut;
- if(!tt_bBoxOld)
- wIn -= (tt_aV[PADDING] + tt_aV[BORDERWIDTH]) << 1;
- tt_aElt[5].style.width = wIn + "px";
- // Title
- if(tt_aElt[1])
- {
- wIn = wOut - (tt_aV[PADDING] << 1);
- if(!tt_bBoxOld)
- wOut = wIn;
- tt_aElt[1].style.width = wOut + "px";
- tt_aElt[2].style.width = wIn + "px";
- }
- // Max height specified
- if(tt_h)
- {
- h = tt_GetDivH(tt_aElt[5]);
- if(h > tt_h)
- {
- if(!tt_bBoxOld)
- tt_h -= (tt_aV[PADDING] + tt_aV[BORDERWIDTH]) << 1;
- tt_aElt[5].style.height = tt_h + "px";
- }
- }
- tt_h = tt_GetDivH(tt_aElt[0]) + iOffY;
- // Right shadow
- if(tt_aElt[8])
- tt_aElt[8].style.height = (tt_h - iOffSh) + "px";
- i = tt_aElt.length - 1;
- if(tt_aElt[i])
- {
- tt_aElt[i].style.width = tt_w + "px";
- tt_aElt[i].style.height = tt_h + "px";
- }
-}
-function tt_DeAlt(el)
-{
- var aKid;
-
- if(el)
- {
- if(el.alt)
- el.alt = "";
- if(el.title)
- el.title = "";
- aKid = el.childNodes || el.children || null;
- if(aKid)
- {
- for(var i = aKid.length; i;)
- tt_DeAlt(aKid[--i]);
- }
- }
-}
-// This hack removes the native tooltips over links in Opera
-function tt_OpDeHref(el)
-{
- if(!tt_op)
- return;
- if(tt_elDeHref)
- tt_OpReHref();
- while(el)
- {
- if(el.hasAttribute("href"))
- {
- el.t_href = el.getAttribute("href");
- el.t_stats = window.status;
- el.removeAttribute("href");
- el.style.cursor = "hand";
- tt_AddEvtFnc(el, "mousedown", tt_OpReHref);
- window.status = el.t_href;
- tt_elDeHref = el;
- break;
- }
- el = el.parentElement;
- }
-}
-function tt_OpReHref()
-{
- if(tt_elDeHref)
- {
- tt_elDeHref.setAttribute("href", tt_elDeHref.t_href);
- tt_RemEvtFnc(tt_elDeHref, "mousedown", tt_OpReHref);
- window.status = tt_elDeHref.t_stats;
- tt_elDeHref = null;
- }
-}
-function tt_OverInit()
-{
- if(window.event)
- tt_over = window.event.target || window.event.srcElement;
- else
- tt_over = tt_ovr_;
- tt_DeAlt(tt_over);
- tt_OpDeHref(tt_over);
-}
-function tt_ShowInit()
-{
- tt_tShow.Timer("tt_Show()", tt_aV[DELAY], true);
- if(tt_aV[CLICKCLOSE] || tt_aV[CLICKSTICKY])
- tt_AddEvtFnc(document, "mouseup", tt_OnLClick);
-}
-function tt_Show()
-{
- var css = tt_aElt[0].style;
-
- // Override the z-index of the topmost wz_dragdrop.js D&D item
- css.zIndex = Math.max((window.dd && dd.z) ? (dd.z + 2) : 0, 1010);
- if(tt_aV[STICKY] || !tt_aV[FOLLOWMOUSE])
- tt_iState &= ~0x4;
- if(tt_aV[DURATION] > 0)
- tt_tDurt.Timer("tt_HideInit()", tt_aV[DURATION], true);
- tt_ExtCallFncs(0, "Show")
- css.visibility = "visible";
- tt_iState |= 0x2;
- if(tt_aV[FADEIN])
- tt_Fade(0, 0, tt_aV[OPACITY], Math.round(tt_aV[FADEIN] / tt_aV[FADEINTERVAL]));
- tt_ShowIfrm();
-}
-function tt_ShowIfrm()
-{
- if(tt_ie56)
- {
- var ifrm = tt_aElt[tt_aElt.length - 1];
- if(ifrm)
- {
- var css = ifrm.style;
- css.zIndex = tt_aElt[0].style.zIndex - 1;
- css.display = "block";
- }
- }
-}
-function tt_Move(e)
-{
- if(e)
- tt_ovr_ = e.target || e.srcElement;
- e = e || window.event;
- if(e)
- {
- tt_musX = tt_GetEvtX(e);
- tt_musY = tt_GetEvtY(e);
- }
- if(tt_iState & 0x04)
- {
- // Prevent jam of mousemove events
- if(!tt_op && !tt_ie)
- {
- if(tt_bWait)
- return;
- tt_bWait = true;
- tt_tWaitMov.Timer("tt_bWait = false;", 1, true);
- }
- if(tt_aV[FIX])
- {
- var iY = tt_aV[FIX][1];
- // For a fixed tip to be positioned above the mouse, use the
- // bottom edge as anchor
- // (recommended by Christophe Rebeschini, 31.1.2008)
- if(tt_aV[ABOVE])
- iY -= tt_h;
- tt_iState &= ~0x4;
- tt_SetTipPos(tt_aV[FIX][0], tt_aV[FIX][1]);
- }
- else if(!tt_ExtCallFncs(e, "MoveBefore"))
- tt_SetTipPos(tt_Pos(0), tt_Pos(1));
- tt_ExtCallFncs([tt_musX, tt_musY], "MoveAfter")
- }
-}
-function tt_Pos(iDim)
-{
- var iX, bJmpMode, cmdAlt, cmdOff, cx, iMax, iScrl, iMus, bJmp;
-
- // Map values according to dimension to calculate
- if(iDim)
- {
- bJmpMode = tt_aV[JUMPVERT];
- cmdAlt = ABOVE;
- cmdOff = OFFSETY;
- cx = tt_h;
- iMax = tt_maxPosY;
- iScrl = tt_scrlY;
- iMus = tt_musY;
- bJmp = tt_bJmpVert;
- }
- else
- {
- bJmpMode = tt_aV[JUMPHORZ];
- cmdAlt = LEFT;
- cmdOff = OFFSETX;
- cx = tt_w;
- iMax = tt_maxPosX;
- iScrl = tt_scrlX;
- iMus = tt_musX;
- bJmp = tt_bJmpHorz;
- }
- if(bJmpMode)
- {
- if(tt_aV[cmdAlt] && (!bJmp || tt_CalcPosAlt(iDim) >= iScrl + 16))
- iX = tt_PosAlt(iDim);
- else if(!tt_aV[cmdAlt] && bJmp && tt_CalcPosDef(iDim) > iMax - 16)
- iX = tt_PosAlt(iDim);
- else
- iX = tt_PosDef(iDim);
- }
- else
- {
- iX = iMus;
- if(tt_aV[cmdAlt])
- iX -= cx + tt_aV[cmdOff] - (tt_aV[SHADOW] ? tt_aV[SHADOWWIDTH] : 0);
- else
- iX += tt_aV[cmdOff];
- }
- // Prevent tip from extending past clientarea boundary
- if(iX > iMax)
- iX = bJmpMode ? tt_PosAlt(iDim) : iMax;
- // In case of insufficient space on both sides, ensure the left/upper part
- // of the tip be visible
- if(iX < iScrl)
- iX = bJmpMode ? tt_PosDef(iDim) : iScrl;
- return iX;
-}
-function tt_PosDef(iDim)
-{
- if(iDim)
- tt_bJmpVert = tt_aV[ABOVE];
- else
- tt_bJmpHorz = tt_aV[LEFT];
- return tt_CalcPosDef(iDim);
-}
-function tt_PosAlt(iDim)
-{
- if(iDim)
- tt_bJmpVert = !tt_aV[ABOVE];
- else
- tt_bJmpHorz = !tt_aV[LEFT];
- return tt_CalcPosAlt(iDim);
-}
-function tt_CalcPosDef(iDim)
-{
- return iDim ? (tt_musY + tt_aV[OFFSETY]) : (tt_musX + tt_aV[OFFSETX]);
-}
-function tt_CalcPosAlt(iDim)
-{
- var cmdOff = iDim ? OFFSETY : OFFSETX;
- var dx = tt_aV[cmdOff] - (tt_aV[SHADOW] ? tt_aV[SHADOWWIDTH] : 0);
- if(tt_aV[cmdOff] > 0 && dx <= 0)
- dx = 1;
- return((iDim ? (tt_musY - tt_h) : (tt_musX - tt_w)) - dx);
-}
-function tt_Fade(a, now, z, n)
-{
- if(n)
- {
- now += Math.round((z - now) / n);
- if((z > a) ? (now >= z) : (now <= z))
- now = z;
- else
- tt_tFade.Timer("tt_Fade("
- + a + "," + now + "," + z + "," + (n - 1)
- + ")",
- tt_aV[FADEINTERVAL],
- true);
- }
- now ? tt_SetTipOpa(now) : tt_Hide();
-}
-function tt_SetTipOpa(opa)
-{
- // To circumvent the opacity nesting flaws of IE, we set the opacity
- // for each sub-DIV separately, rather than for the container DIV.
- tt_SetOpa(tt_aElt[5], opa);
- if(tt_aElt[1])
- tt_SetOpa(tt_aElt[1], opa);
- if(tt_aV[SHADOW])
- {
- opa = Math.round(opa * 0.8);
- tt_SetOpa(tt_aElt[7], opa);
- tt_SetOpa(tt_aElt[8], opa);
- }
-}
-function tt_OnScrl()
-{
- tt_scrlX = tt_GetScrollX();
- tt_scrlY = tt_GetScrollY();
-}
-function tt_OnCloseBtnOver(iOver)
-{
- var css = tt_aElt[4].style;
-
- iOver <<= 1;
- css.background = tt_aV[CLOSEBTNCOLORS][iOver];
- css.color = tt_aV[CLOSEBTNCOLORS][iOver + 1];
-}
-function tt_OnLClick(e)
-{
- // Ignore right-clicks
- e = e || window.event;
- if(!((e.button && e.button & 2) || (e.which && e.which == 3)))
- {
- if(tt_aV[CLICKSTICKY] && (tt_iState & 0x4))
- {
- tt_aV[STICKY] = true;
- tt_iState &= ~0x4;
- }
- else if(tt_aV[CLICKCLOSE])
- tt_HideInit();
- }
-}
-function tt_Int(x)
-{
- var y;
-
- return(isNaN(y = parseInt(x)) ? 0 : y);
-}
-Number.prototype.Timer = function(s, iT, bUrge)
-{
- if(!this.value || bUrge)
- this.value = window.setTimeout(s, iT);
-}
-Number.prototype.EndTimer = function()
-{
- if(this.value)
- {
- window.clearTimeout(this.value);
- this.value = 0;
- }
-}
-function tt_SetOpa(el, opa)
-{
- var css = el.style;
-
- tt_opa = opa;
- if(tt_flagOpa == 1)
- {
- if(opa < 100)
- {
- // Hacks for bugs of IE:
- // 1.) Once a CSS filter has been applied, fonts are no longer
- // anti-aliased, so we store the previous 'non-filter' to be
- // able to restore it
- if(typeof(el.filtNo) == tt_u)
- el.filtNo = css.filter;
- // 2.) A DIV cannot be made visible in a single step if an
- // opacity < 100 has been applied while the DIV was hidden
- var bVis = css.visibility != "hidden";
- // 3.) In IE6, applying an opacity < 100 has no effect if the
- // element has no layout (position, size, zoom, ...)
- css.zoom = "100%";
- if(!bVis)
- css.visibility = "visible";
- css.filter = "alpha(opacity=" + opa + ")";
- if(!bVis)
- css.visibility = "hidden";
- }
- else if(typeof(el.filtNo) != tt_u)
- // Restore 'non-filter'
- css.filter = el.filtNo;
- }
- else
- {
- opa /= 100.0;
- switch(tt_flagOpa)
- {
- case 2:
- css.KhtmlOpacity = opa; break;
- case 3:
- css.KHTMLOpacity = opa; break;
- case 4:
- css.MozOpacity = opa; break;
- case 5:
- css.opacity = opa; break;
- }
- }
-}
-function tt_MovDomNode(el, dadFrom, dadTo)
-{
- if(dadFrom)
- dadFrom.removeChild(el);
- if(dadTo)
- dadTo.appendChild(el);
-}
-function tt_Err(sErr, bIfDebug)
-{
- if(tt_Debug || !bIfDebug)
- alert("Tooltip Script Error Message:\n\n" + sErr);
-}
-
-//============ EXTENSION (PLUGIN) MANAGER ===============//
-function tt_ExtCmdEnum()
-{
- var s;
-
- // Add new command(s) to the commands enum
- for(var i in config)
- {
- s = "window." + i.toString().toUpperCase();
- if(eval("typeof(" + s + ") == tt_u"))
- {
- eval(s + " = " + tt_aV.length);
- tt_aV[tt_aV.length] = null;
- }
- }
-}
-function tt_ExtCallFncs(arg, sFnc)
-{
- var b = false;
- for(var i = tt_aExt.length; i;)
- {--i;
- var fnc = tt_aExt[i]["On" + sFnc];
- // Call the method the extension has defined for this event
- if(fnc && fnc(arg))
- b = true;
- }
- return b;
-}
-
-tt_Init();
diff --git a/xen.c b/xen.c
index 0f7be8b..1ba78ba 100644
--- a/xen.c
+++ b/xen.c
@@ -1,17 +1,18 @@
/* xen support procedures */
-#include <mus-config.h>
+#include "mus-config.h"
#include <ctype.h>
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
-#if HAVE_STDINT_H
- #include <stdint.h>
-#endif
#include <math.h>
-#if HAVE_PTHREAD_H
- #include <pthread.h>
+#include <time.h>
+
+#ifdef _MSC_VER
+ #include <io.h>
+ #include <process.h>
+ #pragma warning(disable: 4244)
#endif
#include "xen.h"
@@ -35,48 +36,51 @@ char *xen_strdup(const char *str)
#if HAVE_RUBY
+#define HAVE_RB_PROC_NEW 1
+/* As the README says, only versions of ruby 1.8 or later will work */
+
#if USE_SND
-void snd_rb_raise(XEN type, XEN info); /* XEN_ERROR */
+void snd_rb_raise(Xen type, Xen info); /* XEN_ERROR */
#endif
#define S_add_help "add_help"
#define S_get_help "get_help"
-XEN rb_documentation(XEN name)
+Xen rb_documentation(Xen name)
{
- XEN_ASSERT_TYPE((XEN_STRING_P(name) || XEN_SYMBOL_P(name)), name, XEN_ONLY_ARG, S_get_help, "a char* or symbol");
- if (XEN_SYMBOL_P(name))
- return(rb_property(XEN_SYMBOL_TO_STRING(name), XEN_DOCUMENTATION_SYMBOL));
+ Xen_check_type((Xen_is_string(name) || Xen_is_symbol(name)), name, 1, S_get_help, "a char* or symbol");
+ if (Xen_is_symbol(name))
+ return(rb_property(XEN_SYMBOL_TO_STRING(name), Xen_documentation_symbol));
else
- return(rb_property(name, XEN_DOCUMENTATION_SYMBOL));
+ return(rb_property(name, Xen_documentation_symbol));
}
-XEN rb_set_documentation(XEN name, XEN help)
+Xen rb_set_documentation(Xen name, Xen help)
{
- XEN_ASSERT_TYPE((XEN_STRING_P(name) || XEN_SYMBOL_P(name)), name, XEN_ARG_1, S_add_help, "a char* or symbol");
- XEN_ASSERT_TYPE(XEN_STRING_P(help), help, XEN_ARG_2, S_add_help, "a char*");
- if (XEN_SYMBOL_P(name))
- rb_set_property(XEN_SYMBOL_TO_STRING(name), XEN_DOCUMENTATION_SYMBOL, help);
+ Xen_check_type((Xen_is_string(name) || Xen_is_symbol(name)), name, 1, S_add_help, "a char* or symbol");
+ Xen_check_type(Xen_is_string(help), help, 2, S_add_help, "a char*");
+ if (Xen_is_symbol(name))
+ rb_set_property(XEN_SYMBOL_TO_STRING(name), Xen_documentation_symbol, help);
else
- rb_set_property(name, XEN_DOCUMENTATION_SYMBOL, help);
+ rb_set_property(name, Xen_documentation_symbol, help);
return(name);
}
-static XEN g_add_help(XEN name, XEN help)
+static Xen g_add_help(Xen name, Xen help)
{
-#define H_add_help S_add_help"(name, help) add help to topic or function name (String or Symbol)"
+#define H_add_help S_add_help "(name, help) add help to topic or function name (String or Symbol)"
return(rb_set_documentation(name, help));
}
-static XEN g_get_help(XEN name)
+static Xen g_get_help(Xen name)
{
-#define H_get_help S_get_help"([name=:"S_get_help"]) \
+#define H_get_help S_get_help "([name=:" S_get_help "]) \
return help associated with name (String or Symbol) or false"
- if (XEN_NOT_BOUND_P(name))
- return(C_TO_XEN_STRING(H_get_help));
+ if (!Xen_is_bound(name))
+ return(C_string_to_Xen_string(H_get_help));
else
return(rb_documentation(name));
}
@@ -90,88 +94,24 @@ void xen_initialize(void)
ruby_init();
ruby_init_loadpath();
- ruby_script("xen"); /* necessary in ruby 1.9 (else segfault in rb_raise) */
+ ruby_script("xen"); /* necessary in ruby 1.9 (else segfault in rb_raise -- is this the rb GC bug (see snd-xen.c)?) */
Init_Hook();
}
-off_t xen_to_c_off_t_or_else(XEN obj, off_t fallback)
-{
- if (XEN_OFF_T_P(obj))
-#if (defined(SIZEOF_OFF_T) && (SIZEOF_OFF_T > 4)) || (defined(_FILE_OFFSET_BITS) && (_FILE_OFFSET_BITS == 64))
- return(XEN_TO_C_LONG_LONG(obj));
-#else
- return(XEN_TO_C_INT(obj));
-#endif
- else
- if (XEN_NUMBER_P(obj))
- return((off_t)XEN_TO_C_DOUBLE(obj));
- return(fallback);
-}
-
-
-off_t xen_to_c_off_t(XEN obj)
-{
-#if (defined(SIZEOF_OFF_T) && (SIZEOF_OFF_T > 4)) || (defined(_FILE_OFFSET_BITS) && (_FILE_OFFSET_BITS == 64))
- return(XEN_TO_C_LONG_LONG(obj));
-#else
- return(XEN_TO_C_INT(obj));
-#endif
-}
-
-
-XEN c_to_xen_off_t(off_t val)
-{
-#if (defined(SIZEOF_OFF_T) && (SIZEOF_OFF_T > 4)) || (defined(_FILE_OFFSET_BITS) && (_FILE_OFFSET_BITS == 64))
- return(C_TO_XEN_LONG_LONG(val));
-#else
- return(C_TO_XEN_INT(val));
-#endif
-}
-
-
-int64_t xen_to_c_int64_t_or_else(XEN obj, int64_t fallback)
-{
- if (XEN_INT64_T_P(obj))
- return(XEN_TO_C_LONG_LONG(obj));
- else
- if (XEN_NUMBER_P(obj))
- return((int64_t)XEN_TO_C_DOUBLE(obj));
- return(fallback);
-}
-
-
-int64_t xen_to_c_int64_t(XEN obj)
-{
- return(XEN_TO_C_LONG_LONG(obj));
-}
-
-
-int xen_to_c_int_or_else(XEN obj, int fallback)
-{
- /* don't want errors about floats with non-zero fractions etc */
- if (XEN_INTEGER_P(obj))
- return(XEN_TO_C_INT(obj));
- else
- if (XEN_NUMBER_P(obj))
- return((int)XEN_TO_C_DOUBLE(obj));
- return(fallback);
-}
-
-
-void xen_gc_mark(XEN val)
+void xen_gc_mark(Xen val)
{
rb_gc_mark(val);
}
-XEN xen_rb_cdr(XEN val)
+Xen xen_rb_cdr(Xen val)
{
- if (XEN_CONS_P(val))
+ if (Xen_is_cons(val))
{
- XEN new_list;
- new_list = XEN_COPY_ARG(val);
+ Xen new_list;
+ new_list = Xen_copy_arg(val);
rb_ary_delete_at(new_list, 0);
return(new_list);
}
@@ -179,25 +119,25 @@ XEN xen_rb_cdr(XEN val)
}
-XEN xen_rb_cons(XEN arg1, XEN arg2)
+Xen xen_rb_cons(Xen arg1, Xen arg2)
{
- if (XEN_NULL_P(arg2))
+ if (Xen_is_null(arg2))
return(rb_ary_new3(1, arg1));
- if (!(XEN_CONS_P(arg2)))
+ if (!(Xen_is_cons(arg2)))
return(rb_ary_new3(2, arg1, arg2));
return(rb_ary_unshift(arg2, arg1)); /* arg2 assumed to be array here in Ruby */
}
-XEN xen_rb_cons2(XEN arg1, XEN arg2, XEN arg3)
+Xen xen_rb_cons2(Xen arg1, Xen arg2, Xen arg3)
{
return(rb_ary_unshift(xen_rb_cons(arg2, arg3), arg1));
}
-XEN xen_rb_ary_new_with_initial_element(long num, XEN element)
+Xen xen_rb_ary_new_with_initial_element(long num, Xen element)
{
- XEN arr;
+ Xen arr;
int i;
arr = rb_ary_new2(num);
for (i = 0; i < num; i++)
@@ -206,7 +146,7 @@ XEN xen_rb_ary_new_with_initial_element(long num, XEN element)
}
-XEN xen_set_assoc(XEN key, XEN val, XEN alist)
+Xen xen_set_assoc(Xen key, Xen val, Xen alist)
{
/* assoc key val in alist so later rb_ary_assoc will find val given key in alist */
/*
@@ -220,11 +160,11 @@ XEN xen_set_assoc(XEN key, XEN val, XEN alist)
[[key, val]]
end
*/
- if (XEN_CONS_P(alist))
+ if (Xen_is_cons(alist))
{
- XEN pair;
+ Xen pair;
pair = rb_ary_assoc(alist, key);
- if (XEN_CONS_P(pair))
+ if (Xen_is_cons(pair))
rb_ary_store(pair, 1, val);
else rb_ary_push(alist, rb_assoc_new(key, val));
return(alist);
@@ -233,11 +173,11 @@ XEN xen_set_assoc(XEN key, XEN val, XEN alist)
}
-XEN xen_assoc(XEN key, XEN alist)
+Xen xen_assoc(Xen key, Xen alist)
{
- if (XEN_CONS_P(alist))
+ if (Xen_is_cons(alist))
{
- XEN val;
+ Xen val;
val = rb_ary_assoc(alist, key);
if (val != Qnil)
return(rb_ary_entry(val, 1));
@@ -250,10 +190,11 @@ static char *scheme_to_ruby(const char *name)
{
/* replace any non-alphanumeric except "?" with "_". "?" -> "_p". '->" -> "2" drop "!" */
char *new_name = NULL;
- int len, i, j;
+ int len;
len = strlen(name);
if (len > 0)
{
+ int i, j;
new_name = (char *)calloc(len + 3, sizeof(char)); /* +1 for possible _p, +1 for possible $ */
for (i = 0, j = 0; i < len; i++)
{
@@ -285,7 +226,7 @@ static char *scheme_to_ruby(const char *name)
char *xen_scheme_constant_to_ruby(const char *name)
{
- /* upcase 1st char */
+ /* upcase first char */
char *new_name;
new_name = scheme_to_ruby(name);
new_name[0] = toupper(new_name[0]);
@@ -296,10 +237,11 @@ char *xen_scheme_constant_to_ruby(const char *name)
char *xen_scheme_procedure_to_ruby(const char *name)
{
char *new_name = NULL;
- int len, i, j;
- len = strlen(name);
+ int len;
+ len = name ? strlen(name) : 0;
if (len > 0)
{
+ int i, j;
new_name = (char *)calloc(len + 1, sizeof(char));
for (i = 0, j = 0; i < len; i++)
{
@@ -351,7 +293,7 @@ bool xen_rb_defined_p(const char *name)
sprintf(buf, "defined? %s", var_name);
else sprintf(buf, "defined? $%s", var_name);
- if (XEN_EVAL_C_STRING(buf) != Qnil)
+ if (Xen_eval_C_string(buf) != Qnil)
{
free(var_name);
return(true);
@@ -367,10 +309,10 @@ bool xen_rb_defined_p(const char *name)
}
-XEN xen_rb_gv_get(const char *name)
+Xen xen_rb_gv_get(const char *name)
{
char *temp;
- XEN val;
+ Xen val;
temp = xen_scheme_global_variable_to_ruby(name);
val = rb_gv_get(temp);
if (temp) free(temp);
@@ -378,10 +320,10 @@ XEN xen_rb_gv_get(const char *name)
}
-XEN xen_rb_gv_set(const char *name, XEN new_val)
+Xen xen_rb_gv_set(const char *name, Xen new_val)
{
char *temp;
- XEN val;
+ Xen val;
temp = xen_scheme_global_variable_to_ruby(name);
val = rb_gv_set(temp, new_val);
if (temp) free(temp);
@@ -389,10 +331,10 @@ XEN xen_rb_gv_set(const char *name, XEN new_val)
}
-XEN xen_rb_intern(const char *name)
+Xen xen_rb_intern(const char *name)
{
char *temp;
- XEN val;
+ Xen val;
temp = xen_scheme_constant_to_ruby(name);
val = rb_intern(temp);
if (temp) free(temp);
@@ -400,18 +342,18 @@ XEN xen_rb_intern(const char *name)
}
-XEN xen_rb_make_keyword(const char *name)
+Xen xen_rb_make_keyword(const char *name)
{
char *temp;
- XEN val;
+ Xen val;
temp = xen_scheme_procedure_to_ruby(name);
- val = C_STRING_TO_XEN_SYMBOL(temp);
+ val = C_string_to_Xen_symbol(temp);
if (temp) free(temp);
return(val);
}
-void xen_rb_define(const char *name, XEN value)
+void xen_rb_define(const char *name, Xen value)
{
char *temp;
temp = xen_scheme_constant_to_ruby(name);
@@ -420,10 +362,10 @@ void xen_rb_define(const char *name, XEN value)
}
-XEN xen_rb_define_class(const char *name)
+Xen xen_rb_define_class(const char *name)
{
char *temp;
- XEN val;
+ Xen val;
temp = xen_scheme_constant_to_ruby(name);
val = rb_define_class(temp, rb_cObject);
if (temp) free(temp);
@@ -442,31 +384,27 @@ XEN xen_rb_define_class(const char *name)
#endif
-int xen_rb_list_length(XEN obj)
+int xen_rb_list_length(Xen obj)
{
- if (XEN_VECTOR_P(obj))
+ if (Xen_is_vector(obj))
return((int)RB_ARRAY_LEN(obj));
- if (obj == XEN_EMPTY_LIST)
+ if (obj == Xen_empty_list)
return(0);
return(-1);
}
-/* XEN_CAR, XEN_CADR..., XEN_LIST_REF, XEN_VECTOR_REF */
-
-XEN xen_rb_list_ref(XEN obj, int index)
+Xen xen_rb_list_ref(Xen obj, int index)
{
- if (XEN_VECTOR_P(obj))
+ if (Xen_is_vector(obj))
return(rb_ary_entry(obj, (long)index));
- return(XEN_EMPTY_LIST);
+ return(Xen_empty_list);
}
-/* XEN_LIST_SET, XEN_VECTOR_SET */
-
-XEN xen_rb_list_set(XEN obj, int index, XEN value)
+Xen xen_rb_list_set(Xen obj, int index, Xen value)
{
- if (XEN_VECTOR_P(obj))
+ if (Xen_is_vector(obj))
rb_ary_store(obj, (long)index, value);
return(value);
}
@@ -474,76 +412,47 @@ XEN xen_rb_list_set(XEN obj, int index, XEN value)
char *xen_version(void)
{
+ /* there is no macro we can depend on for the version number (its name changes unpredictably),
+ * and ruby/version.h tries to be funny about how unreliable their semi-functional access is.
+ * Maybe use <ruby/version.h> and ruby_version here (a const char*).
+ * No, even that doesn't work because there's no way to tell whether version.h exists.
+ * Humph!
+ */
char *buf;
buf = (char *)calloc(128, sizeof(char));
-#if HAVE_SNPRINTF
- snprintf(buf, 128, "Ruby: %s (%s), Xen: %s",
-#else
- sprintf(buf, "Ruby: %s (%s), Xen: %s",
-#endif
-#ifdef MUS_RUBY_VERSION
- MUS_RUBY_VERSION,
- RUBY_RELEASE_DATE,
-#else
- XEN_TO_C_STRING(XEN_EVAL_C_STRING("RUBY_VERSION")),
- XEN_TO_C_STRING(XEN_EVAL_C_STRING("RUBY_RELEASE_DATE")),
-#endif
- XEN_VERSION);
+ snprintf(buf, 128, "%s", "Ruby");
return(buf);
}
-#if HAVE_READLINE
- #include <readline/readline.h>
- #include <readline/history.h>
-#endif
-
-static XEN xen_rb_report_error(XEN nada, XEN err_info)
+static Xen xen_rb_report_error(Xen nada, Xen err_info)
{
/* backtrace info: */
/* return rb_funcall(err_info, rb_intern("backtrace"), 0); */
/* which can be an array of strings */
- fprintf(stderr,"error: %s\n", XEN_AS_STRING(err_info));
- return(XEN_FALSE);
+ fprintf(stderr,"error: %s\n", Xen_object_to_C_string(err_info));
+ return(Xen_false);
}
static char *rb_prompt = NULL;
-static XEN xen_rb_rep(XEN ig)
+static Xen xen_rb_rep(Xen ig)
{
- XEN val;
+ Xen val;
char *str;
-#if HAVE_READLINE
- char *line_read = NULL;
- line_read = readline(rb_prompt);
- if ((line_read) && (*line_read))
- {
- add_history(line_read);
- val = xen_rb_eval_string_with_error(line_read);
- str = XEN_AS_STRING(val);
- fprintf(stdout, "%s\n", (str) ? str : "nil");
- free(line_read);
- line_read = NULL;
- }
-#else
- int size = 512;
+ size_t size = 512;
char **buffer = NULL;
buffer = (char **)calloc(1, sizeof(char *));
buffer[0] = (char *)calloc(size, sizeof(char));
- fprintf(stdout, rb_prompt);
-#if HAVE_GETLINE
- getline(buffer, &size, stdin);
-#else
+ fprintf(stdout, "%s", rb_prompt);
fgets(buffer[0], size, stdin);
-#endif
val = xen_rb_eval_string_with_error(buffer[0]);
- str = XEN_AS_STRING(val);
+ str = Xen_object_to_C_string(val);
fprintf(stdout, "%s\n", (str) ? str : "nil");
free(buffer[0]);
free(buffer);
-#endif
return(ig);
}
@@ -555,13 +464,13 @@ void xen_rb_repl_set_prompt(const char *prompt)
}
-static XEN xen_rb_rescue(XEN val)
+static Xen xen_rb_rescue(Xen val)
{
if (!rb_prompt) rb_prompt = xen_strdup(">");
- return(rb_rescue(XEN_PROCEDURE_CAST xen_rb_rep,
- XEN_FALSE,
- XEN_PROCEDURE_CAST xen_rb_report_error,
- XEN_FALSE));
+ return(rb_rescue(Xen_procedure_cast xen_rb_rep,
+ Xen_false,
+ Xen_procedure_cast xen_rb_report_error,
+ Xen_false));
}
@@ -571,68 +480,68 @@ void xen_repl(int argc, char **argv)
{
int status = 0;
rb_protect(XEN_VALUE_ARG_PROCEDURE_CAST xen_rb_rescue,
- XEN_FALSE,
+ Xen_false,
&status);
if (status != 0)
{
- fprintf(stderr, "%s\n", XEN_AS_STRING(rb_gv_get("$!")));
+ fprintf(stderr, "%s\n", Xen_object_to_C_string(rb_gv_get("$!")));
status = 0;
}
}
}
-XEN xen_rb_eval_string_with_error(const char *str)
+Xen xen_rb_eval_string_with_error(const char *str)
{
int status = 0;
- XEN res;
+ Xen res;
res = rb_eval_string_protect(str, &status);
if (status != 0)
- return(XEN_TO_STRING(rb_gv_get("$!")));
+ return(xen_rb_obj_as_string(rb_gv_get("$!")));
return(res);
}
-XEN xen_rb_load_file_with_error(XEN file)
+Xen xen_rb_load_file_with_error(Xen file)
{
int status = 0;
rb_load_protect(file, 0, &status);
if (status != 0)
- return(XEN_TO_STRING(rb_gv_get("$!")));
- return(XEN_TRUE);
+ return(xen_rb_obj_as_string(rb_gv_get("$!")));
+ return(Xen_true);
}
-XEN xen_rb_add_to_load_path(char *path)
+Xen xen_rb_add_to_load_path(char *path)
{
- XEN rpath, load_path;
+ Xen rpath, load_path;
rpath = rb_str_new2(path);
load_path = rb_gv_get("$:");
- if (XEN_FALSE_P(rb_ary_includes(load_path, rpath)))
+ if (Xen_is_false(rb_ary_includes(load_path, rpath)))
rb_ary_unshift(load_path, rpath);
- return(XEN_FALSE);
+ return(Xen_false);
}
static char *lstbuf = NULL;
-static char *xen_rb_list_to_s(XEN lst)
+static char *xen_rb_list_to_s(Xen lst)
{
int i, len;
if (lstbuf == NULL)
lstbuf = (char *)calloc(512, sizeof(char));
else lstbuf[0] = '\0';
- len = XEN_LIST_LENGTH(lst);
+ len = Xen_list_length(lst);
for (i = 0; i < len; i++)
{
- strcat(lstbuf, XEN_AS_STRING(XEN_LIST_REF(lst, i)));
+ strcat(lstbuf, Xen_object_to_C_string(Xen_list_ref(lst, i)));
strcat(lstbuf, " ");
}
return(lstbuf);
}
-void xen_rb_raise(XEN type, XEN info)
+void xen_rb_raise(Xen type, Xen info)
{
rb_raise(rb_eStandardError, "%s: %s\n",
rb_id2name(type),
@@ -640,129 +549,115 @@ void xen_rb_raise(XEN type, XEN info)
}
-int xen_rb_required_args(XEN val)
+int xen_rb_required_args(Xen val)
{
int args;
- args = XEN_TO_C_INT(val);
+ args = Xen_integer_to_C_int(val);
if (args == -1) return(1);
if (args < 0) return(abs(args + 1));
return(args);
}
-XEN xen_rb_obj_as_string(XEN obj)
+Xen xen_rb_obj_as_string(Xen obj)
{
int status = 0;
- XEN result;
+ Xen result;
result = rb_protect(XEN_VALUE_ARG_PROCEDURE_CAST rb_obj_as_string,
obj,
&status);
if (status != 0)
- return(C_TO_XEN_STRING("<invalid object>"));
+ return(C_string_to_Xen_string("<invalid object>"));
return(result);
}
#if HAVE_RB_PROC_NEW
-static XEN xen_rb_apply_1(XEN args)
+static Xen xen_rb_apply_1(Xen args)
{
- return(rb_apply(XEN_CAR(args), rb_intern("call"), XEN_CADR(args)));
+ return(rb_apply(Xen_car(args), rb_intern("call"), Xen_cadr(args)));
}
#else
-static XEN xen_rb_apply_1(XEN args)
+static Xen xen_rb_apply_1(Xen args)
{
- if (XEN_PROCEDURE_P(XEN_CAR(args)))
- return(rb_apply(XEN_CAR(args), rb_intern("call"), XEN_CADR(args)));
- return(rb_apply(rb_mKernel, XEN_CAR(args), XEN_CADR(args)));
+ if (Xen_is_procedure(Xen_car(args)))
+ return(rb_apply(Xen_car(args), rb_intern("call"), Xen_cadr(args)));
+ return(rb_apply(rb_mKernel, Xen_car(args), Xen_cadr(args)));
}
#endif
-XEN xen_rb_apply(XEN func, XEN args)
+Xen xen_rb_apply(Xen func, Xen args)
{
- XEN val;
+ Xen val;
int status = 0;
val = rb_protect(XEN_VALUE_ARG_PROCEDURE_CAST xen_rb_apply_1,
- XEN_LIST_2(func, args),
+ Xen_list_2(func, args),
&status);
if (status != 0)
- return(XEN_TO_STRING(rb_gv_get("$!")));
+ return(xen_rb_obj_as_string(rb_gv_get("$!")));
return(val);
}
-static XEN xen_rb_funcall_0_inner(XEN args)
+static Xen xen_rb_funcall_0_inner(Xen args)
{
return(rb_funcall(args, rb_intern("call"), 0));
}
-XEN xen_rb_funcall_0(XEN func)
+Xen xen_rb_funcall_0(Xen func)
{
- XEN val;
+ Xen val;
int status = 0;
val = rb_protect(XEN_VALUE_ARG_PROCEDURE_CAST xen_rb_funcall_0_inner,
func,
&status);
if (status != 0)
- return(XEN_TO_STRING(rb_gv_get("$!")));
+ return(xen_rb_obj_as_string(rb_gv_get("$!")));
return(val);
}
-XEN xen_rb_copy_list(XEN val)
+Xen xen_rb_copy_list(Xen val)
{
- if ((val == XEN_EMPTY_LIST) || (!XEN_CONS_P(val)))
- return XEN_EMPTY_LIST;
+ if ((val == Xen_empty_list) || (!Xen_is_cons(val)))
+ return Xen_empty_list;
return rb_ary_dup(val);
}
-XEN xen_rb_str_new2(char *arg)
+Xen xen_rb_str_new2(char *arg)
{
return(rb_str_new2((arg) ? arg : ""));
}
-double xen_rb_to_c_double_or_else(XEN a, double b)
-{
- return(XEN_NUMBER_P(a) ? NUM2DBL(a) : b);
-}
-
-
-int xen_rb_to_c_int_or_else(XEN a, int b)
-{
- if (XEN_INTEGER_P(a)) return(FIX2INT(a));
- if (XEN_NUMBER_P(a)) return((int)(NUM2DBL(a)));
- return(b);
-}
-
-
/* class Hook */
-static XEN xen_rb_cHook;
+static Xen xen_rb_cHook;
-static XEN hook_alloc(XEN klass)
+static Xen hook_alloc(Xen klass)
{
return(Data_Wrap_Struct(klass, 0, 0, 0));
}
-#define XEN_CLASS_HOOK_P(Arg) rb_obj_is_kind_of(Arg, xen_rb_cHook)
+#define Xen_is_class_hook(Arg) rb_obj_is_kind_of(Arg, xen_rb_cHook)
-bool xen_rb_hook_p(XEN obj)
+bool xen_rb_hook_p(Xen obj)
{
- return(XEN_CLASS_HOOK_P(obj));
+ return(Xen_is_class_hook(obj));
}
-bool xen_rb_hook_empty_p(XEN obj)
+bool xen_rb_hook_empty_p(Xen obj)
{
- if (XEN_CLASS_HOOK_P(obj))
+ if (Xen_is_class_hook(obj))
return(RB_ARRAY_LEN(rb_iv_get(obj, "@procs")) == 0);
return(true);
}
@@ -774,24 +669,23 @@ bool xen_rb_hook_empty_p(XEN obj)
* @procs = [["named proc1", proc1], ...]
*/
-static XEN xen_rb_hook_initialize(int argc, XEN *argv, XEN hook)
+static Xen xen_rb_hook_initialize(int argc, Xen *argv, Xen hook)
{
- XEN name, arity, help;
+ Xen name, arity, help;
rb_scan_args(argc, argv, "12", &name, &arity, &help);
- XEN_ASSERT_TYPE(XEN_STRING_P(name) || XEN_SYMBOL_P(name), name, XEN_ARG_1, c__FUNCTION__, "a char* or symbol");
- if (XEN_SYMBOL_P(name))
+ Xen_check_type(Xen_is_string(name) || Xen_is_symbol(name), name, 1, __func__, "a char* or symbol");
+ if (Xen_is_symbol(name))
name = XEN_SYMBOL_TO_STRING(name);
if (arity != Qnil)
{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arity), arity, XEN_ARG_2, c__FUNCTION__, "an integer");
+ Xen_check_type(Xen_is_integer(arity), arity, 2, __func__, "an integer");
}
else arity = INT2NUM(0);
if (help != Qnil)
{
- XEN_ASSERT_TYPE(XEN_STRING_P(help), help, XEN_ARG_3, c__FUNCTION__, "a char*");
+ Xen_check_type(Xen_is_string(help), help, 3, __func__, "a char*");
XEN_SET_OBJECT_HELP(name, help);
}
- else help = rb_str_new2("");
rb_iv_set(hook, "@name", name);
rb_iv_set(hook, "@arity", arity);
rb_iv_set(hook, "@procs", rb_ary_new());
@@ -804,12 +698,12 @@ static XEN xen_rb_hook_initialize(int argc, XEN *argv, XEN hook)
* To create a global hook variables, see xen_rb_create_hook() below.
*/
-XEN xen_rb_hook_c_new(char *name, int arity, char *help)
+Xen xen_rb_hook_c_new(char *name, int arity, char *help)
{
- XEN args[3];
- args[0] = C_TO_XEN_STRING(name);
- args[1] = C_TO_XEN_INT(arity);
- args[2] = C_TO_XEN_STRING(help);
+ Xen args[3];
+ args[0] = C_string_to_Xen_string(name);
+ args[1] = C_int_to_Xen_integer(arity);
+ args[2] = C_string_to_Xen_string(help);
return(xen_rb_hook_initialize(3, args, hook_alloc(xen_rb_cHook)));
}
@@ -826,10 +720,10 @@ XEN xen_rb_hook_c_new(char *name, int arity, char *help)
etc.
*/
-#ifdef MUS_RUBY_VERSION
+#ifdef RUBY_VERSION
#define XEN_RUBY_RELEASE_DATE RUBY_RELEASE_DATE
#else
- #define XEN_RUBY_RELEASE_DATE XEN_TO_C_STRING(XEN_EVAL_C_STRING("RUBY_RELEASE_DATE"))
+ #define XEN_RUBY_RELEASE_DATE Xen_string_to_C_string(Xen_eval_C_string("RUBY_RELEASE_DATE"))
#endif
#define RUBY_NEW_ARITY_DATE "2004-03-18"
@@ -852,15 +746,15 @@ bool xen_rb_arity_ok(int rargs, int args)
}
-static XEN xen_rb_hook_add_hook(int argc, XEN *argv, XEN hook)
+static Xen xen_rb_hook_add_hook(int argc, Xen *argv, Xen hook)
{
- XEN name, func;
+ Xen name, func;
int args;
- args = XEN_TO_C_INT(rb_iv_get(hook, "@arity"));
+ args = Xen_integer_to_C_int(rb_iv_get(hook, "@arity"));
rb_scan_args(argc, argv, "1&", &name, &func);
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ARG_1, c__FUNCTION__, "a char*");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(func) && xen_rb_arity_ok(XEN_TO_C_INT(XEN_ARITY(func)), args),
- func, XEN_ARG_2, c__FUNCTION__, "a procedure");
+ Xen_check_type(Xen_is_string(name), name, 1, __func__, "a char*");
+ Xen_check_type(Xen_is_procedure(func) && xen_rb_arity_ok(Xen_integer_to_C_int(Xen_arity(func)), args),
+ func, 2, __func__, "a procedure");
rb_ary_push(rb_iv_get(hook, "@procs"), rb_ary_new3(2, name, func));
return(hook);
}
@@ -868,50 +762,51 @@ static XEN xen_rb_hook_add_hook(int argc, XEN *argv, XEN hook)
#if HAVE_RB_PROC_NEW
-static XEN xen_proc_call(XEN args, XEN id)
+static Xen xen_proc_call(Xen args, Xen id)
{
- return(rb_apply(rb_mKernel, (ID)id, XEN_CONS_P(args) ? args : XEN_LIST_1(args)));
+ return(rb_apply(rb_mKernel, (ID)id, Xen_is_cons(args) ? args : Xen_list_1(args)));
}
#if 0
VALUE rb_proc_new((VALUE (*)(ANYARGS/* VALUE yieldarg[, VALUE procarg] */), VALUE));
#endif
-static XEN xen_rb_proc_new(const char *name, XEN (*func)(), int arity, const char* doc)
+static Xen xen_rb_proc_new(const char *name, Xen (*func)(), int arity, const char* doc)
{
- rb_define_module_function(rb_mKernel, name, XEN_PROCEDURE_CAST func, arity);
+ rb_define_module_function(rb_mKernel, name, Xen_procedure_cast func, arity);
if (doc) C_SET_OBJECT_HELP(name, doc);
- return(rb_proc_new(XEN_PROCEDURE_CAST xen_proc_call, rb_intern(name)));
+ return(rb_proc_new(Xen_procedure_cast xen_proc_call, rb_intern(name)));
}
-static XEN xen_rb_hook_arity(XEN hook);
+static Xen xen_rb_hook_arity(Xen hook);
-XEN xen_rb_add_hook(XEN hook, VALUE (*func)(), const char *name, const char* doc)
+Xen xen_rb_add_hook(Xen hook, VALUE (*func)(), const char *name, const char* doc)
{
/* called from C, not Ruby, to add a function to a Ruby-side hook */
char *temp;
temp = xen_scheme_procedure_to_ruby(name);
- rb_ary_push(rb_iv_get(hook, "@procs"), rb_ary_new3(2, C_TO_XEN_STRING(temp), xen_rb_proc_new(temp, func, XEN_TO_C_INT(xen_rb_hook_arity(hook)), doc)));
+ rb_ary_push(rb_iv_get(hook, "@procs"), rb_ary_new3(2, C_string_to_Xen_string(temp), xen_rb_proc_new(temp, func, Xen_integer_to_C_int(xen_rb_hook_arity(hook)), doc)));
if (temp) free(temp);
return(hook);
}
#else
-XEN xen_rb_add_hook(XEN hook, VALUE (*func)(), const char *name, const char* doc)
+Xen xen_rb_add_hook(Xen hook, VALUE (*func)(), const char *name, const char* doc)
{
/* called from C, not Ruby, to add a function to a Ruby-side hook
* this doesn't work in g++ because it thinks the funcs are invalid:
* "error: invalid conversion from 'VALUE (*)(VALUE, VALUE)' to 'VALUE (*)(...)'" (snd-file.c etc)
*/
- XEN var;
+ Xen var, avar;
char *temp;
temp = xen_scheme_procedure_to_ruby(name);
- rb_define_module_function(rb_mKernel, temp, XEN_PROCEDURE_CAST func, XEN_TO_C_INT_OR_ELSE(rb_iv_get(hook, "@arity"), 0));
+ avar = rb_iv_get(hook, "@arity");
+ rb_define_module_function(rb_mKernel, temp, Xen_procedure_cast func, (Xen_is_integer(avar)) ? Xen_integer_to_C_int(avar) : 0);
if (doc) C_SET_OBJECT_HELP(temp, doc);
var = rb_intern(temp);
- rb_ary_push(rb_iv_get(hook, "@procs"), rb_ary_new3(2, C_TO_XEN_STRING(temp), var));
+ rb_ary_push(rb_iv_get(hook, "@procs"), rb_ary_new3(2, C_string_to_Xen_string(temp), var));
if (temp) free(temp);
return(hook);
}
@@ -919,25 +814,25 @@ XEN xen_rb_add_hook(XEN hook, VALUE (*func)(), const char *name, const char* doc
#endif
-static XEN xen_rb_hook_remove_hook(XEN hook, XEN name)
+static Xen xen_rb_hook_remove_hook(Xen hook, Xen name)
{
- XEN ary;
+ Xen ary;
ary = rb_iv_get(hook, "@procs");
return(rb_ary_delete(ary, rb_ary_assoc(ary, name)));
}
-XEN xen_rb_hook_reset_hook(XEN hook)
+Xen xen_rb_hook_reset_hook(Xen hook)
{
- if (XEN_CLASS_HOOK_P(hook))
+ if (Xen_is_class_hook(hook))
rb_ary_clear(rb_iv_get(hook, "@procs"));
return(hook);
}
-static XEN xen_rb_hook_names(XEN hook)
+static Xen xen_rb_hook_names(Xen hook)
{
- XEN ary, ret = Qnil;
+ Xen ary, ret = Qnil;
long len;
ary = rb_iv_get(hook, "@procs");
len = RB_ARRAY_LEN(ary);
@@ -946,34 +841,34 @@ static XEN xen_rb_hook_names(XEN hook)
long i;
ret = rb_ary_new2(len);
for (i = 0; i < len; i++)
- rb_ary_store(ret, i, XEN_VECTOR_REF(XEN_VECTOR_REF(ary, i), 0));
+ rb_ary_store(ret, i, Xen_vector_ref(Xen_vector_ref(ary, i), 0));
}
return(ret);
}
-XEN xen_rb_hook_to_a(XEN hook)
+Xen xen_rb_hook_to_a(Xen hook)
{
- XEN ret = Qnil;
- if (XEN_CLASS_HOOK_P(hook))
+ Xen ret = Qnil;
+ if (Xen_is_class_hook(hook))
{
- XEN ary;
+ Xen ary;
long len;
ary = rb_iv_get(hook, "@procs");
- len = XEN_LIST_LENGTH(ary);
+ len = Xen_list_length(ary);
if (len > 0)
{
long i;
ret = rb_ary_new2(len);
for (i = 0; i < len; i++)
- rb_ary_store(ret, i, XEN_VECTOR_REF(XEN_VECTOR_REF(ary, i), 1));
+ rb_ary_store(ret, i, Xen_vector_ref(Xen_vector_ref(ary, i), 1));
}
}
return(ret);
}
-static XEN xen_rb_hook_run_hook(XEN hook)
+static Xen xen_rb_hook_run_hook(Xen hook)
{
if (RB_ARRAY_LEN(rb_iv_get(hook, "@procs")))
rb_ary_each(xen_rb_hook_to_a(hook));
@@ -987,9 +882,9 @@ static XEN xen_rb_hook_run_hook(XEN hook)
* results.
*/
-static XEN xen_rb_hook_call(int argc, XEN *argv, XEN hook)
+static Xen xen_rb_hook_call(int argc, Xen *argv, Xen hook)
{
- XEN result = Qnil, rest, procs;
+ Xen result = Qnil, rest, procs;
rb_scan_args(argc, argv, "*", &rest);
procs = xen_rb_hook_to_a(hook);
if (procs != Qnil)
@@ -1002,39 +897,39 @@ static XEN xen_rb_hook_call(int argc, XEN *argv, XEN hook)
}
-static XEN xen_rb_hook_is_empty_p(XEN hook)
+static Xen xen_rb_hook_is_empty_p(Xen hook)
{
- return(C_TO_XEN_BOOLEAN(RB_ARRAY_LEN(rb_iv_get(hook, "@procs")) == 0));
+ return(C_bool_to_Xen_boolean(RB_ARRAY_LEN(rb_iv_get(hook, "@procs")) == 0));
}
-static XEN xen_rb_hook_length(XEN hook)
+static Xen xen_rb_hook_length(Xen hook)
{
- return(C_TO_XEN_INT(RB_ARRAY_LEN(rb_iv_get(hook, "@procs"))));
+ return(C_int_to_Xen_integer(RB_ARRAY_LEN(rb_iv_get(hook, "@procs"))));
}
-static XEN xen_rb_hook_name(XEN hook)
+static Xen xen_rb_hook_name(Xen hook)
{
return(rb_iv_get(hook, "@name"));
}
-static XEN xen_rb_hook_describe(XEN hook)
+static Xen xen_rb_hook_describe(Xen hook)
{
- return(XEN_OBJECT_HELP(xen_rb_hook_name(hook)));
+ return(Xen_documentation(xen_rb_hook_name(hook)));
}
-static XEN xen_rb_hook_arity(XEN hook)
+static Xen xen_rb_hook_arity(Xen hook)
{
return(rb_iv_get(hook, "@arity"));
}
-static XEN xen_rb_hook_inspect(XEN hook)
+static Xen xen_rb_hook_inspect(Xen hook)
{
- XEN str = rb_str_new2("#<Hook name: ");
+ Xen str = rb_str_new2("#<Hook name: ");
rb_str_append(str, rb_inspect(rb_iv_get(hook, "@name")));
rb_str_cat2(str, ", arity: ");
rb_str_append(str, rb_inspect(rb_iv_get(hook, "@arity")));
@@ -1047,19 +942,19 @@ static XEN xen_rb_hook_inspect(XEN hook)
}
-/* bil -- added xen_rb_create_hook for XEN_DEFINE_HOOK in xen.h, 13-Jun-05 --
+/* bil -- added xen_rb_create_hook for Xen_define_hook in xen.h, 13-Jun-05 --
* seems to work, but I'm guessing, especially the rb_gv_set line.
* I can't use rb_define_variable here, as in the old version, because it takes a pointer
* to the new variable, which in this case is a local variable => segfault.
*/
-XEN xen_rb_create_hook(char *name, int arity, char *help)
+Xen xen_rb_create_hook(char *name, int arity, char *help)
{
- XEN var, hook_name;
+ Xen var, hook_name;
char *temp;
var = xen_rb_hook_c_new(temp = xen_scheme_global_variable_to_ruby(name), arity, help);
hook_name = xen_rb_hook_name(var);
- rb_gv_set(XEN_TO_C_STRING(hook_name), var);
+ rb_gv_set(Xen_string_to_C_string(hook_name), var);
if (temp) free(temp);
return(var);
}
@@ -1067,10 +962,10 @@ XEN xen_rb_create_hook(char *name, int arity, char *help)
static int simple_hook_number = 0;
-XEN xen_rb_create_simple_hook(int arity)
+Xen xen_rb_create_simple_hook(int arity)
{
char *name;
- XEN hook;
+ Xen hook;
name = (char *)calloc(20, sizeof(char));
snprintf(name, 20, "simple_%02d_hook", simple_hook_number++);
hook = xen_rb_create_hook(name, arity, NULL);
@@ -1100,9 +995,9 @@ XEN xen_rb_create_simple_hook(int arity)
#define RB_STR_LEN(str) RSTRING_LEN(str)
#endif
-static XEN xen_rb_make_hook(int argc, XEN *argv, XEN klass)
+static Xen xen_rb_make_hook(int argc, Xen *argv, Xen klass)
{
- XEN hook = XEN_FALSE, name;
+ Xen hook = Xen_false, name;
if (argc > 0 && argc < 4)
{
hook = xen_rb_hook_initialize(argc, argv, hook_alloc(xen_rb_cHook));
@@ -1118,24 +1013,24 @@ static XEN xen_rb_make_hook(int argc, XEN *argv, XEN klass)
argv[0] = argv[3];
xen_rb_hook_add_hook(1, argv, hook);
}
- else XEN_ERROR(XEN_ERROR_TYPE("wrong-number-of-args"),
- XEN_LIST_1(C_TO_XEN_STRING("make_hook(name, arity=0, help=\"\", hook_name=\"\", &func)")));
+ else Xen_error(Xen_make_error_type("wrong-number-of-args"),
+ Xen_list_1(C_string_to_Xen_string("make_hook(name, arity=0, help=\"\", hook_name=\"\", &func)")));
name = xen_rb_hook_name(hook);
- if (XEN_TO_C_CHAR(name) != '$')
+ if (Xen_char_to_C_char(name) != '$')
{
char *temp;
- temp = xen_scheme_global_variable_to_ruby(XEN_TO_C_STRING(name));
- name = C_TO_XEN_STRING(temp);
+ temp = xen_scheme_global_variable_to_ruby(Xen_string_to_C_string(name));
+ name = C_string_to_Xen_string(temp);
if (temp) free(temp);
}
- XEN_ASSERT_TYPE(RB_STR_LEN(name) >= 2, name, XEN_ARG_1, c__FUNCTION__, "a char*, len >= 2");
- return(rb_gv_set(XEN_TO_C_STRING(name), hook));
+ Xen_check_type(RB_STR_LEN(name) >= 2, name, 1, __func__, "a char*, len >= 2");
+ return(rb_gv_set(Xen_string_to_C_string(name), hook));
}
-static XEN xen_rb_is_hook_p(XEN klass, XEN obj)
+static Xen xen_rb_is_hook_p(Xen klass, Xen obj)
{
- return(C_TO_XEN_BOOLEAN(XEN_CLASS_HOOK_P(obj)));
+ return(C_bool_to_Xen_boolean(Xen_is_class_hook(obj)));
}
@@ -1161,55 +1056,55 @@ static XEN xen_rb_is_hook_p(XEN klass, XEN obj)
*/
#if (!HAVE_RB_DEFINE_ALLOC_FUNC)
-static XEN xen_rb_new(int argc, XEN *argv, XEN klass)
+static Xen xen_rb_new(int argc, Xen *argv, Xen klass)
{
- XEN hook = hook_alloc(klass);
+ Xen hook = hook_alloc(klass);
rb_obj_call_init(hook, argc, argv);
return(hook);
}
#endif
-static XEN rb_object_properties = XEN_FALSE;
+static Xen rb_object_properties = Xen_false;
#define S_property "property"
#define S_set_property "set_property"
#define S_properties "properties"
-XEN rb_property(XEN obj, XEN key)
+Xen rb_property(Xen obj, Xen key)
{
#define H_property S_property "(obj, key) \
if key exists, return obj's value (maybe nil) associated with key otherwise false"
- XEN props = XEN_FALSE;
+ Xen props = Xen_false;
- if (XEN_FALSE_P(rb_object_properties))
- return(XEN_FALSE);
+ if (Xen_is_false(rb_object_properties))
+ return(Xen_false);
props = rb_hash_aref(rb_object_properties, obj);
- if (XEN_FALSE_P(props) || props == Qnil)
- return(XEN_FALSE);
+ if (Xen_is_false(props) || props == Qnil)
+ return(Xen_false);
else
return(rb_hash_aref(props, key));
}
-XEN rb_set_property(XEN obj, XEN key, XEN value)
+Xen rb_set_property(Xen obj, Xen key, Xen value)
{
#define H_set_property S_set_property "(obj, key, value) \
set key-value pair for obj and return value"
- XEN props = XEN_FALSE;
+ Xen props = Xen_false;
- if (XEN_FALSE_P(rb_object_properties))
+ if (Xen_is_false(rb_object_properties))
{
rb_object_properties = rb_hash_new();
- XEN_PROTECT_FROM_GC(rb_object_properties);
+ Xen_GC_protect(rb_object_properties);
}
else
props = rb_hash_aref(rb_object_properties, obj);
- if (XEN_FALSE_P(props) || props == Qnil)
+ if (Xen_is_false(props) || props == Qnil)
props = rb_hash_new();
rb_hash_aset(props, key, value);
@@ -1218,37 +1113,37 @@ set key-value pair for obj and return value"
}
-XEN rb_properties(void)
+Xen rb_properties(void)
{
#define H_properties S_properties "() return all properties of rb_object_properties (a hash)"
return(rb_object_properties);
}
-static XEN g_gc_off(void)
+static Xen g_gc_off(void)
{
#define H_gc_off "(" S_gc_off ") turns off garbage collection"
rb_gc_disable();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_gc_on(void)
+static Xen g_gc_on(void)
{
#define H_gc_on "(" S_gc_on ") turns on garbage collection"
rb_gc_enable();
- return(XEN_FALSE);
+ return(Xen_false);
}
-XEN_ARGIFY_1(g_get_help_w, g_get_help);
-XEN_NARGIFY_2(g_add_help_w, g_add_help);
-XEN_NARGIFY_3(g_set_property_w, rb_set_property);
-XEN_NARGIFY_2(g_property_w, rb_property);
-XEN_NARGIFY_0(g_properties_w, rb_properties);
+Xen_wrap_1_optional_arg(g_get_help_w, g_get_help);
+Xen_wrap_2_args(g_add_help_w, g_add_help);
+Xen_wrap_3_args(g_set_property_w, rb_set_property);
+Xen_wrap_2_args(g_property_w, rb_property);
+Xen_wrap_no_args(g_properties_w, rb_properties);
-XEN_NARGIFY_0(g_gc_off_w, g_gc_off)
-XEN_NARGIFY_0(g_gc_on_w, g_gc_on)
+Xen_wrap_no_args(g_gc_off_w, g_gc_off)
+Xen_wrap_no_args(g_gc_on_w, g_gc_on)
static bool hook_inited = false;
@@ -1263,40 +1158,40 @@ void Init_Hook(void)
#if HAVE_RB_DEFINE_ALLOC_FUNC
rb_define_alloc_func(xen_rb_cHook, hook_alloc);
#else
- rb_define_singleton_method(xen_rb_cHook, "new", XEN_PROCEDURE_CAST xen_rb_new, -1);
+ rb_define_singleton_method(xen_rb_cHook, "new", Xen_procedure_cast xen_rb_new, -1);
#endif
- rb_define_method(xen_rb_cHook, "initialize", XEN_PROCEDURE_CAST xen_rb_hook_initialize, -1);
- rb_define_method(xen_rb_cHook, "add_hook!", XEN_PROCEDURE_CAST xen_rb_hook_add_hook, -1);
- rb_define_method(xen_rb_cHook, "remove_hook!", XEN_PROCEDURE_CAST xen_rb_hook_remove_hook, 1);
- rb_define_method(xen_rb_cHook, "reset_hook!", XEN_PROCEDURE_CAST xen_rb_hook_reset_hook, 0);
+ rb_define_method(xen_rb_cHook, "initialize", Xen_procedure_cast xen_rb_hook_initialize, -1);
+ rb_define_method(xen_rb_cHook, "add_hook!", Xen_procedure_cast xen_rb_hook_add_hook, -1);
+ rb_define_method(xen_rb_cHook, "remove_hook!", Xen_procedure_cast xen_rb_hook_remove_hook, 1);
+ rb_define_method(xen_rb_cHook, "reset_hook!", Xen_procedure_cast xen_rb_hook_reset_hook, 0);
rb_define_alias(xen_rb_cHook, "clear", "reset_hook!");
- rb_define_method(xen_rb_cHook, "to_a", XEN_PROCEDURE_CAST xen_rb_hook_to_a, 0);
- rb_define_method(xen_rb_cHook, "run_hook", XEN_PROCEDURE_CAST xen_rb_hook_run_hook, 0);
+ rb_define_method(xen_rb_cHook, "to_a", Xen_procedure_cast xen_rb_hook_to_a, 0);
+ rb_define_method(xen_rb_cHook, "run_hook", Xen_procedure_cast xen_rb_hook_run_hook, 0);
rb_define_alias(xen_rb_cHook, "each", "run_hook");
- rb_define_method(xen_rb_cHook, "call", XEN_PROCEDURE_CAST xen_rb_hook_call, -1);
- rb_define_method(xen_rb_cHook, "length", XEN_PROCEDURE_CAST xen_rb_hook_length, 0);
+ rb_define_method(xen_rb_cHook, "call", Xen_procedure_cast xen_rb_hook_call, -1);
+ rb_define_method(xen_rb_cHook, "length", Xen_procedure_cast xen_rb_hook_length, 0);
rb_define_alias(xen_rb_cHook, "size", "length");
- rb_define_method(xen_rb_cHook, "empty?", XEN_PROCEDURE_CAST xen_rb_hook_is_empty_p, 0);
- rb_define_method(xen_rb_cHook, "name", XEN_PROCEDURE_CAST xen_rb_hook_name, 0);
- rb_define_method(xen_rb_cHook, "arity", XEN_PROCEDURE_CAST xen_rb_hook_arity, 0);
- rb_define_method(xen_rb_cHook, "describe", XEN_PROCEDURE_CAST xen_rb_hook_describe, 0);
+ rb_define_method(xen_rb_cHook, "empty?", Xen_procedure_cast xen_rb_hook_is_empty_p, 0);
+ rb_define_method(xen_rb_cHook, "name", Xen_procedure_cast xen_rb_hook_name, 0);
+ rb_define_method(xen_rb_cHook, "arity", Xen_procedure_cast xen_rb_hook_arity, 0);
+ rb_define_method(xen_rb_cHook, "describe", Xen_procedure_cast xen_rb_hook_describe, 0);
rb_define_alias(xen_rb_cHook, "help", "describe");
rb_define_alias(xen_rb_cHook, "documentation", "describe");
- rb_define_method(xen_rb_cHook, "inspect", XEN_PROCEDURE_CAST xen_rb_hook_inspect, 0);
+ rb_define_method(xen_rb_cHook, "inspect", Xen_procedure_cast xen_rb_hook_inspect, 0);
- rb_define_global_function("make_hook", XEN_PROCEDURE_CAST xen_rb_make_hook, -1);
- rb_define_global_function("hook?", XEN_PROCEDURE_CAST xen_rb_is_hook_p, 1);
+ rb_define_global_function("make_hook", Xen_procedure_cast xen_rb_make_hook, -1);
+ rb_define_global_function("hook?", Xen_procedure_cast xen_rb_is_hook_p, 1);
- XEN_DEFINE_PROCEDURE(S_get_help, g_get_help_w, 0, 1, 0, H_get_help);
- XEN_DEFINE_PROCEDURE(S_add_help, g_add_help_w, 2, 0, 0, H_add_help);
+ Xen_define_procedure(S_get_help, g_get_help_w, 0, 1, 0, H_get_help);
+ Xen_define_procedure(S_add_help, g_add_help_w, 2, 0, 0, H_add_help);
- XEN_DEFINE_PROCEDURE(S_set_property, g_set_property_w, 3, 0, 0, H_set_property);
- XEN_DEFINE_PROCEDURE(S_property, g_property_w, 2, 0, 0, H_property);
- XEN_DEFINE_PROCEDURE(S_properties, g_properties_w, 0, 0, 0, H_properties);
+ Xen_define_procedure(S_set_property, g_set_property_w, 3, 0, 0, H_set_property);
+ Xen_define_procedure(S_property, g_property_w, 2, 0, 0, H_property);
+ Xen_define_procedure(S_properties, g_properties_w, 0, 0, 0, H_properties);
- XEN_DEFINE_PROCEDURE(S_gc_off, g_gc_off_w, 0, 0, 0, H_gc_off);
- XEN_DEFINE_PROCEDURE(S_gc_on, g_gc_on_w, 0, 0, 0, H_gc_on);
+ Xen_define_procedure(S_gc_off, g_gc_off_w, 0, 0, 0, H_gc_off);
+ Xen_define_procedure(S_gc_on, g_gc_on_w, 0, 0, 0, H_gc_on);
}
/* end of class Hook */
@@ -1315,7 +1210,7 @@ char *xen_version(void)
}
-void xen_gc_mark(XEN val)
+void xen_gc_mark(Xen val)
{
fth_gc_mark(val);
}
@@ -1341,65 +1236,31 @@ void xen_repl(int argc, char **argv)
}
-off_t xen_to_c_off_t_or_else(XEN obj, off_t fallback)
-{
- if (XEN_NUMBER_P(obj))
- return(fth_long_long_ref(obj));
- return(fallback);
-}
-
-
-off_t xen_to_c_off_t(XEN obj)
-{
- return(fth_long_long_ref(obj));
-}
-
-
-XEN c_to_xen_off_t(off_t obj)
-{
- return(fth_make_long_long(obj));
-}
-
-
-int64_t xen_to_c_int64_t_or_else(XEN obj, int64_t fallback)
-{
- if (XEN_NUMBER_P(obj))
- return(fth_long_long_ref(obj));
- return(fallback);
-}
-
-
-int64_t xen_to_c_int64_t(XEN obj)
-{
- return(fth_long_long_ref(obj));
-}
-
-
static ficlWord *snd_exit_xt;
static void fth_snd_exit(int n)
{
if (!snd_exit_xt)
- snd_exit_xt = ficlSystemLookup(FTH_FICL_SYSTEM(), "snd-exit");
+ snd_exit_xt = ficlSystemLookup(FTH_FICL_SYSTEM(), (char *)"snd-exit");
ficlStackPushInteger(FTH_FICL_STACK(), n);
ficlVmExecuteXT(FTH_FICL_VM(), snd_exit_xt);
ficlStackDrop(FTH_FICL_STACK(), 1);
}
-static XEN g_gc_off(void)
+static Xen g_gc_off(void)
{
#define H_gc_off "(" S_gc_off ") turns off garbage collection"
fth_gc_on();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_gc_on(void)
+static Xen g_gc_on(void)
{
#define H_gc_on "(" S_gc_on ") turns on garbage collection"
fth_gc_on();
- return(XEN_FALSE);
+ return(Xen_false);
}
@@ -1408,8 +1269,8 @@ void xen_initialize(void)
fth_init();
fth_exit_hook = fth_snd_exit;
- XEN_DEFINE_PROCEDURE(S_gc_off, g_gc_off, 0, 0, 0, H_gc_off);
- XEN_DEFINE_PROCEDURE(S_gc_on, g_gc_on, 0, 0, 0, H_gc_on);
+ Xen_define_procedure(S_gc_off, g_gc_off, 0, 0, 0, H_gc_off);
+ Xen_define_procedure(S_gc_on, g_gc_on, 0, 0, 0, H_gc_on);
}
#endif /* HAVE_FORTH */
@@ -1419,18 +1280,10 @@ void xen_initialize(void)
/* ------------------------------ S7 ------------------------------ */
#if HAVE_SCHEME
-
-#if HAVE_LIMITS_H
- #include <limits.h>
-#else
- #define INT_MAX 2147483647
- #define INT_MIN (-INT_MAX - 1)
-#endif
-
#include "s7.h"
s7_scheme *s7;
-XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
+Xen xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
char *xen_version(void)
{
@@ -1445,34 +1298,6 @@ char *xen_version(void)
}
-int xen_to_c_int(XEN a) /* xen_to_c_int is expected to return an int (not an int64_t) */
-{
- s7_Int val;
- val = s7_number_to_integer(a);
- if (val > INT_MAX)
- return(INT_MAX);
- if (val < INT_MIN)
- return(INT_MIN);
- return(val);
-}
-
-
-int64_t xen_to_c_int64_t(XEN a)
-{
- if (XEN_NUMBER_P(a))
- return(s7_number_to_integer(a));
- return(0); /* ?? in xm.c, XtSetValues of XmUserData with a pointer falls back on this -- probably can't work */
-}
-
-
-double xen_to_c_double_or_else(XEN a, double b)
-{
- if (XEN_NUMBER_P(a))
- return(s7_number_to_real(a));
- return(b);
-}
-
-
static char *xen_s7_repl_prompt = NULL;
void xen_s7_set_repl_prompt(const char *new_prompt)
@@ -1482,6 +1307,11 @@ void xen_s7_set_repl_prompt(const char *new_prompt)
}
+#if USE_SND
+char *stdin_check_for_full_expression(const char *newstr);
+void stdin_free_str(void);
+#endif
+
void xen_repl(int argc, char **argv)
{
int size = 512;
@@ -1508,7 +1338,7 @@ void xen_repl(int argc, char **argv)
{
if (buffer[i] == 0)
break;
- if (!isspace(buffer[i]))
+ if (!isspace((int)buffer[i]))
{
expr_ok = true;
break;
@@ -1516,13 +1346,22 @@ void xen_repl(int argc, char **argv)
}
if (expr_ok)
{
- char *temp;
- temp = (char *)malloc(len + 128);
- sprintf(temp,
- "(write %s)",
- buffer); /* use write, not display so that strings are in double quotes */
- XEN_EVAL_C_STRING(temp);
+ char *str, *temp;
+#if USE_SND
+ str = stdin_check_for_full_expression(buffer); /* "str" here is actually stdin_str, so we need to clear it explicitly */
+ if (!str) {expr_ok = false; continue;}
+ len = strlen(str) + 16;
+ temp = (char *)malloc(len * sizeof(char));
+ snprintf(temp, len, "(write %s)", str);
+ Xen_eval_C_string(temp);
+ free(temp);
+ stdin_free_str();
+#else
+ temp = (char *)malloc(len + 16);
+ snprintf(temp, len + 16, "(write %s)", buffer); /* use write, not display so that strings are in double quotes */
+ Xen_eval_C_string(temp);
free(temp);
+#endif
}
}
}
@@ -1530,91 +1369,13 @@ void xen_repl(int argc, char **argv)
}
-void xen_s7_ignore(s7_function func) /* squelch compiler warnings */
-{
-}
-
-
-XEN xen_define_variable(const char *name, XEN value)
-{
- XEN_DEFINE(name, value);
- /* s7_gc_protect(s7, value); */
- /* XEN_DEFINE places value in the global env, so it is already gc protected */
- return(C_STRING_TO_XEN_SYMBOL(name));
-}
-
-
-XEN xen_s7_define_hook(const char *name, XEN value)
-{
- s7_define_constant(s7, name, value);
- /* s7_gc_protect(s7, value); -- see above */
- return(value);
-}
-
-
-void xen_gc_mark(XEN val)
+void xen_gc_mark(Xen val)
{
s7_mark_object(val);
}
-#if !(defined(__GNUC__) && (!(defined(__cplusplus))))
-XEN xen_s7_c_to_xen_string(const char *str)
-{
- return((str) ? s7_make_string(s7, str) : XEN_FALSE);
-}
-#endif
-
-
-static const char **constant_names = NULL, **constant_helps = NULL;
-static int constant_size = 0, constant_top = -1;
-
-void xen_s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value, const char *help)
-{
- /* save doc string */
- constant_top++;
- if (constant_top >= constant_size)
- {
- if (constant_size == 0)
- {
- constant_size = 128;
- constant_names = (const char **)calloc(constant_size, sizeof(const char *));
- constant_helps = (const char **)calloc(constant_size, sizeof(const char *));
- }
- else
- {
- int i;
- i = constant_size;
- constant_size += 128;
- constant_names = (const char **)realloc(constant_names, constant_size * sizeof(const char *));
- constant_helps = (const char **)realloc(constant_helps, constant_size * sizeof(const char *));
- for (; i < constant_size; i++)
- {
- constant_names[i] = NULL;
- constant_helps[i] = NULL;
- }
- }
- }
- constant_names[constant_top] = xen_strdup(name);
- constant_helps[constant_top] = xen_strdup(help);
- s7_define_constant(s7, name, value);
-}
-
-
-const char *xen_s7_constant_help(const char *name)
-{
- int i;
- if (name)
- {
- for (i = 0; i <= constant_top; i++)
- if (strcmp(name, constant_names[i]) == 0)
- return(constant_helps[i]);
- }
- return(NULL);
-}
-
-
-XEN xen_set_assoc(s7_scheme *sc, s7_pointer key, s7_pointer val, s7_pointer alist)
+Xen xen_set_assoc(s7_scheme *sc, s7_pointer key, s7_pointer val, s7_pointer alist)
{
/* fixup alist, return it (caller has to make sure it is reflected in its object) */
/*
@@ -1625,7 +1386,7 @@ XEN xen_set_assoc(s7_scheme *sc, s7_pointer key, s7_pointer val, s7_pointer alis
alist)
(cons (cons key new-val) alist)))
*/
- XEN old_val;
+ Xen old_val;
old_val = s7_assoc(sc, key, alist); /* returns #f if nothing found */
if (old_val == s7_f(sc))
return(s7_cons(sc, s7_cons(sc, key, val), alist));
@@ -1634,9 +1395,9 @@ XEN xen_set_assoc(s7_scheme *sc, s7_pointer key, s7_pointer val, s7_pointer alis
}
-XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist)
+Xen xen_assoc(s7_scheme *sc, Xen key, Xen alist)
{
- XEN val;
+ Xen val;
val = s7_assoc(sc, key, alist);
if (val != s7_f(sc))
return(s7_cdr(val));
@@ -1646,29 +1407,26 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist)
/* add various file functions that everyone else implements */
-#if (defined(HAVE_LIBC_H) && (!defined(HAVE_UNISTD_H)))
- #include <libc.h>
-#else
- #if (!(defined(_MSC_VER)))
- #include <unistd.h>
- #endif
-#endif
-
-#if HAVE_SYS_TIME_H
+#ifndef _MSC_VER
+ #include <unistd.h>
#include <sys/time.h>
#endif
#include <sys/stat.h>
+#include <fcntl.h>
-#if HAVE_FCNTL_H
- #include <fcntl.h>
-#endif
+static Xen g_getpid(void)
+{
+ #define H_getpid "(getpid) returns the current job's process id"
+ return(C_int_to_Xen_integer((int)getpid()));
+}
+
+#if (!WITH_SYSTEM_EXTRAS)
static bool file_probe(const char *arg)
{
- /* from io.c */
-#if HAVE_ACCESS
+#ifndef _MSC_VER
return(access(arg, F_OK) == 0);
#else
int fd;
@@ -1684,106 +1442,100 @@ static bool file_probe(const char *arg)
}
-static bool directory_p(const char *filename)
+static Xen g_file_exists_p(Xen name)
{
-#if HAVE_WINDOZE
- return(false);
+ #define H_file_exists_p "(file-exists? filename): #t if the file exists"
+ Xen_check_type(Xen_is_string(name), name, 1, "file-exists?", "a string");
+ return(C_bool_to_Xen_boolean(file_probe(Xen_string_to_C_string(name))));
+}
+
+static bool is_directory(const char *filename)
+{
+#if (defined(_MSC_VER) || __CYGWIN__)
+ return(false);
#else
- /* from snd-file.c */
#ifdef S_ISDIR
struct stat statbuf;
-#if HAVE_LSTAT
- return((lstat(filename, &statbuf) >= 0) &&
+ return((stat(filename, &statbuf) >= 0) &&
(S_ISDIR(statbuf.st_mode)));
return(false);
-#else
- return((stat(filename, &statbuf) == 0) &&
- (S_ISDIR(statbuf.st_mode)));
-#endif
#endif
#endif
}
-
-static XEN g_file_exists_p(XEN name)
-{
- #define H_file_exists_p "(file-exists? filename): #t if the file exists"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, "file-exists?", "a string");
- return(C_TO_XEN_BOOLEAN(file_probe(XEN_TO_C_STRING(name))));
-}
-
-
-static XEN g_getpid(void)
+static Xen g_is_directory(Xen name)
{
- #define H_getpid "(getpid) returns the current job's process id"
- return(C_TO_XEN_INT((int)getpid()));
+ #define H_is_directory "(directory? filename): #t if filename names a directory"
+ Xen_check_type(Xen_is_string(name), name, 1, "directory?", "a string");
+ return(C_bool_to_Xen_boolean(is_directory(Xen_string_to_C_string(name)))); /* snd-file.c l 84 */
}
-
-static XEN g_file_is_directory(XEN name)
+static Xen g_delete_file(Xen name)
{
- #define H_file_is_directory "(file-is-directory? filename): #t if filename names a directory"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, "file-is-directory?", "a string");
- return(C_TO_XEN_BOOLEAN(directory_p(XEN_TO_C_STRING(name)))); /* snd-file.c l 84 */
+ #define H_delete_file "(delete-file filename): deletes the file"
+ Xen_check_type(Xen_is_string(name), name, 1, "delete-file", "a string");
+ return(C_bool_to_Xen_boolean(unlink(Xen_string_to_C_string(name))));
}
-static XEN g_system(XEN command)
+static Xen g_system(Xen command)
{
#define H_system "(system command): execute command"
- XEN_ASSERT_TYPE(XEN_STRING_P(command), command, XEN_ONLY_ARG, "system", "a string");
- return(C_TO_XEN_INT(system(XEN_TO_C_STRING(command))));
+ Xen_check_type(Xen_is_string(command), command, 1, "system", "a string");
+ return(C_int_to_Xen_integer(system(Xen_string_to_C_string(command))));
}
-static XEN g_s7_getenv(XEN var) /* "g_getenv" is in use in glib! */
+static Xen g_s7_getenv(Xen var) /* "g_getenv" is in use in glib! */
{
#define H_getenv "(getenv var): return value of environment variable var"
- XEN_ASSERT_TYPE(XEN_STRING_P(var), var, XEN_ONLY_ARG, "getenv", "a string");
- return(C_TO_XEN_STRING(getenv(XEN_TO_C_STRING(var))));
+ Xen_check_type(Xen_is_string(var), var, 1, "getenv", "a string");
+ return(C_string_to_Xen_string(getenv(Xen_string_to_C_string(var))));
}
+#endif
-static XEN g_delete_file(XEN name)
-{
- #define H_delete_file "(delete-file filename): deletes the file"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, XEN_ONLY_ARG, "delete-file", "a string");
- return(C_TO_XEN_BOOLEAN(unlink(XEN_TO_C_STRING(name))));
-}
-
#ifdef _MSC_VER
#include <direct.h>
#endif
-static XEN g_getcwd(void)
+static Xen g_getcwd(void)
{
#define H_getcwd "(getcwd) returns the name of the current working directory"
char *buf;
- XEN result = XEN_FALSE;
+ Xen result = Xen_false;
buf = (char *)calloc(1024, sizeof(char));
#ifdef _MSC_VER
if (_getcwd(buf, 1024) != NULL)
#else
if (getcwd(buf, 1024) != NULL)
#endif
- result = C_TO_XEN_STRING(buf);
+ result = C_string_to_Xen_string(buf);
free(buf);
return(result);
}
-static XEN g_strftime(XEN format, XEN tm)
+static Xen g_strftime(Xen format, Xen tm)
{
#define H_strftime "(strftime format time) returns a string describing the time: (strftime \"%d-%b %H:%M %Z\" (localtime (current-time)))"
char *buf;
- XEN result;
- XEN_ASSERT_TYPE(XEN_STRING_P(format), format, XEN_ARG_1, "strftime", "a string");
+ Xen result;
+ const struct tm *p;
+
+ Xen_check_type(Xen_is_string(format), format, 1, "strftime", "a string");
+ Xen_check_type(Xen_is_wrapped_c_pointer(tm), tm, 2, "strftime", "a localtime struct");
+
+ p = (const struct tm *)Xen_unwrap_C_pointer(tm);
+ Xen_check_type(p != NULL, tm, 2, "strftime", "a localtime struct");
+
buf = (char *)calloc(1024, sizeof(char));
- strftime(buf, 1024, XEN_TO_C_STRING(format), (const struct tm *)XEN_UNWRAP_C_POINTER(tm));
- result = C_TO_XEN_STRING(buf);
+ strftime(buf, 1024, Xen_string_to_C_string(format), p);
+ result = C_string_to_Xen_string(buf);
free(buf);
+
return(result);
}
@@ -1791,32 +1543,31 @@ static XEN g_strftime(XEN format, XEN tm)
/* (format #f ";~A~%" (strftime "%d-%b %H:%M %Z" (localtime (current-time)))) */
/* these two need to be compatible with g_file_write_date in snd-file.c */
-static XEN g_localtime(XEN tm)
+static Xen g_localtime(Xen tm)
{
#define H_localtime "(localtime tm) breaks up tm into something suitable for strftime"
time_t rtime;
- rtime = (time_t)XEN_TO_C_ULONG(tm);
- return(XEN_WRAP_C_POINTER(localtime((time_t *)(&rtime))));
+ rtime = (time_t)Xen_ulong_to_C_ulong(tm);
+ return(Xen_wrap_C_pointer(localtime((time_t *)(&rtime))));
}
-static XEN g_current_time(void)
+static Xen g_current_time(void)
{
time_t curtime;
#define H_current_time "(current-time) returns the current time (for localtime and strftime)"
curtime = time(NULL);
- return(C_TO_XEN_ULONG(curtime));
+ return(C_ulong_to_Xen_ulong(curtime));
}
-static XEN g_tmpnam(void)
+static Xen g_tmpnam(void)
{
- #define H_tmpnam "(tmpnam) returns a new (hopefully unused) tempporary file name"
+ #define H_tmpnam "(tmpnam) returns a new (hopefully unused) temporary file name"
#define BUFFER_SIZE 512
static int file_ctr = 0;
char *str, *tmpdir = NULL;
- int len;
- XEN result;
+ Xen result;
str = (char *)calloc(BUFFER_SIZE, sizeof(char));
tmpdir = xen_strdup(getenv("TMPDIR"));
@@ -1826,10 +1577,12 @@ static XEN g_tmpnam(void)
tmpdir = xen_strdup(P_tmpdir); /* /usr/include/stdio.h */
if (tmpdir)
{
+ int len;
len = strlen(tmpdir);
if (len > 0)
{
- if (tmpdir[len - 1] == '/') tmpdir[len - 1] = 0;
+ if (tmpdir[len - 1] == '/')
+ tmpdir[len - 1] = 0;
}
else
{
@@ -1843,55 +1596,57 @@ static XEN g_tmpnam(void)
snprintf(str, BUFFER_SIZE, "%s/xen_%d_%d", tmpdir, (int)getpid(), file_ctr++);
if (tmpdir) free(tmpdir);
- result = C_TO_XEN_STRING(str);
+ result = C_string_to_Xen_string(str);
free(str);
return(result);
}
-static XEN g_ftell(XEN fd)
+static Xen g_ftell(Xen fd)
{
- return(C_TO_XEN_OFF_T(lseek(XEN_TO_C_INT(fd), 0, SEEK_CUR)));
+ return(C_int_to_Xen_integer(lseek(Xen_integer_to_C_int(fd), 0, SEEK_CUR)));
}
-static XEN g_gc_off(void)
+static Xen g_gc_off(void)
{
#define H_gc_off "(" S_gc_off ") turns off garbage collection"
s7_gc_on(s7, false);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN g_gc_on(void)
+static Xen g_gc_on(void)
{
#define H_gc_on "(" S_gc_on ") turns on garbage collection"
s7_gc_on(s7, true);
- return(XEN_FALSE);
+ return(Xen_false);
}
-XEN_NARGIFY_0(g_getpid_w, g_getpid)
-XEN_NARGIFY_1(g_file_exists_p_w, g_file_exists_p)
-XEN_NARGIFY_1(g_file_is_directory_w, g_file_is_directory)
-XEN_NARGIFY_1(g_system_w, g_system)
-XEN_NARGIFY_1(g_s7_getenv_w, g_s7_getenv)
-XEN_NARGIFY_1(g_delete_file_w, g_delete_file)
-XEN_NARGIFY_0(g_getcwd_w, g_getcwd)
-XEN_NARGIFY_2(g_strftime_w, g_strftime)
-XEN_NARGIFY_1(g_localtime_w, g_localtime)
-XEN_NARGIFY_0(g_current_time_w, g_current_time)
-XEN_NARGIFY_0(g_tmpnam_w, g_tmpnam)
-XEN_NARGIFY_1(g_ftell_w, g_ftell)
+Xen_wrap_no_args(g_getpid_w, g_getpid)
+#if (!WITH_SYSTEM_EXTRAS)
+ Xen_wrap_1_arg(g_file_exists_p_w, g_file_exists_p)
+ Xen_wrap_1_arg(g_is_directory_w, g_is_directory)
+ Xen_wrap_1_arg(g_delete_file_w, g_delete_file)
+ Xen_wrap_1_arg(g_s7_getenv_w, g_s7_getenv)
+ Xen_wrap_1_arg(g_system_w, g_system)
+#endif
+Xen_wrap_no_args(g_getcwd_w, g_getcwd)
+Xen_wrap_2_args(g_strftime_w, g_strftime)
+Xen_wrap_1_arg(g_localtime_w, g_localtime)
+Xen_wrap_no_args(g_current_time_w, g_current_time)
+Xen_wrap_no_args(g_tmpnam_w, g_tmpnam)
+Xen_wrap_1_arg(g_ftell_w, g_ftell)
-XEN_NARGIFY_0(g_gc_off_w, g_gc_off)
-XEN_NARGIFY_0(g_gc_on_w, g_gc_on)
+Xen_wrap_no_args(g_gc_off_w, g_gc_off)
+Xen_wrap_no_args(g_gc_on_w, g_gc_on)
s7_scheme *s7_xen_initialize(s7_scheme *sc)
{
- xen_s7_repl_prompt = xen_strdup(">");
+ xen_s7_repl_prompt = xen_strdup("> ");
if (!sc)
{
s7 = s7_init();
@@ -1908,57 +1663,45 @@ s7_scheme *s7_xen_initialize(s7_scheme *sc)
xen_nil = s7_nil(s7);
xen_undefined = s7_undefined(s7);
xen_zero = s7_make_integer(s7, 0);
-
- XEN_DEFINE_PROCEDURE("getpid", g_getpid_w, 0, 0, 0, H_getpid);
- XEN_DEFINE_PROCEDURE("file-exists?", g_file_exists_p_w, 1, 0, 0, H_file_exists_p);
- XEN_DEFINE_PROCEDURE("directory?", g_file_is_directory_w, 1, 0, 0, H_file_is_directory);
- XEN_EVAL_C_STRING("(define file-is-directory? directory?)"); /* backwards compatibility: */
- XEN_DEFINE_PROCEDURE("system", g_system_w, 1, 0, 0, H_system);
- XEN_DEFINE_PROCEDURE("getenv", g_s7_getenv_w, 1, 0, 0, H_getenv);
- XEN_DEFINE_PROCEDURE("delete-file", g_delete_file_w, 1, 0, 0, H_delete_file);
- XEN_DEFINE_PROCEDURE("getcwd", g_getcwd_w, 0, 0, 0, H_getcwd);
- XEN_DEFINE_PROCEDURE("strftime", g_strftime_w, 2, 0, 0, H_strftime);
- XEN_DEFINE_PROCEDURE("tmpnam", g_tmpnam_w, 0, 0, 0, H_tmpnam);
- XEN_DEFINE_PROCEDURE("localtime", g_localtime_w, 1, 0, 0, H_localtime);
- XEN_DEFINE_PROCEDURE("current-time", g_current_time_w, 0, 0, 0, H_current_time);
- XEN_DEFINE_PROCEDURE("ftell", g_ftell_w, 1, 0, 0, "(ftell fd): lseek");
- XEN_DEFINE_PROCEDURE(S_gc_off, g_gc_off_w, 0, 0, 0, H_gc_off);
- XEN_DEFINE_PROCEDURE(S_gc_on, g_gc_on_w, 0, 0, 0, H_gc_on);
-
- /* backwards compatibility (guile hook functions) */
- XEN_EVAL_C_STRING("(define (hook-empty? hook) (null? (hook-functions hook)))");
- XEN_EVAL_C_STRING("(define (reset-hook! hook) (set! (hook-functions hook) '()))");
- XEN_EVAL_C_STRING("(define (run-hook . args) (hook-apply (car args) (cdr args)))");
- XEN_EVAL_C_STRING("(define hook->list hook-functions)");
- XEN_EVAL_C_STRING("(define* (add-hook! hook func (at-end #f)) \n\
- (set! (hook-functions hook) \n\
- (if (not at-end) \n\
- (cons func (hook-functions hook)) \n\
- (append (hook-functions hook) (list func)))))");
- XEN_EVAL_C_STRING("(define (remove-hook! hook func) \n\
+ s7_gc_protect(s7, xen_zero);
+
+ Xen_define_safe_procedure("getpid", g_getpid_w, 0, 0, 0, H_getpid);
+#if (!WITH_SYSTEM_EXTRAS)
+ Xen_define_safe_procedure("file-exists?", g_file_exists_p_w, 1, 0, 0, H_file_exists_p);
+ Xen_define_safe_procedure("directory?", g_is_directory_w, 1, 0, 0, H_is_directory);
+ Xen_define_safe_procedure("delete-file", g_delete_file_w, 1, 0, 0, H_delete_file);
+ Xen_define_safe_procedure("getenv", g_s7_getenv_w, 1, 0, 0, H_getenv);
+ Xen_define_safe_procedure("system", g_system_w, 1, 0, 0, H_system);
+#endif
+ Xen_define_safe_procedure("getcwd", g_getcwd_w, 0, 0, 0, H_getcwd);
+ Xen_define_safe_procedure("strftime", g_strftime_w, 2, 0, 0, H_strftime);
+ Xen_define_safe_procedure("tmpnam", g_tmpnam_w, 0, 0, 0, H_tmpnam);
+ Xen_define_safe_procedure("localtime", g_localtime_w, 1, 0, 0, H_localtime);
+ Xen_define_safe_procedure("current-time", g_current_time_w, 0, 0, 0, H_current_time);
+ Xen_define_safe_procedure("ftell", g_ftell_w, 1, 0, 0, "(ftell fd): lseek");
+ Xen_define_safe_procedure(S_gc_off, g_gc_off_w, 0, 0, 0, H_gc_off);
+ Xen_define_safe_procedure(S_gc_on, g_gc_on_w, 0, 0, 0, H_gc_on);
+
+ Xen_eval_C_string("(define (hook-push hook func) \n\
+ \"(hook-push hook func) adds func to hook's function list\" \n\
+ (if (not (member func (hook-functions hook) eq?)) (set! (hook-functions hook) (cons func (hook-functions hook)))))");
+ Xen_eval_C_string("(define (hook-append hook func) \n\
+ \"(hook-append hook func) adds func to the end of hook's function list\" \n\
+ (set! (hook-functions hook) (append (hook-functions hook) (list func))))");
+ Xen_eval_C_string("(define (hook-clear hook) (set! (hook-functions hook) ()))");
+ Xen_eval_C_string("(define (hook-remove hook func) \n\
(set! (hook-functions hook)\n\
(let loop ((l (hook-functions hook))\n\
- (result '()))\n\
+ (result ()))\n\
(cond ((null? l) (reverse! result))\n\
((eq? func (car l)) (loop (cdr l) result))\n\
(else (loop (cdr l) (cons (car l) result)))))))");
- /* these three to replace add-hook! and remove-hook! */
- XEN_EVAL_C_STRING("(define (hook-push hook func) \n\
- \"(hook-push hook func) adds func to hook's function list\" \n\
- (set! (hook-functions hook) (cons func (hook-functions hook))))");
- XEN_EVAL_C_STRING("(define (hook-append hook func) \n\
- \"(hook-append hook func) adds func to the end of hook's function list\" \n\
- (set! (hook-functions hook) (append (hook-functions hook) (list func))))");
- XEN_EVAL_C_STRING("(define hook-remove remove-hook!)");
-
-
- XEN_EVAL_C_STRING("(define load-from-path load)");
- XEN_EVAL_C_STRING("(define (1+ x) \"add 1 to arg\" (+ x 1))");
- XEN_EVAL_C_STRING("(define (1- x) \"subtract 1 from arg\" (- x 1))");
- XEN_EVAL_C_STRING("(defmacro while (whether . body) `(do () ((not ,whether)) , at body))");
- XEN_EVAL_C_STRING("(define (identity x) \"return arg\" x)");
- XEN_EVAL_C_STRING("(define (throw . args) (apply error args))");
+ Xen_eval_C_string("(define load-from-path load)");
+ Xen_eval_C_string("(define (1+ x) \"add 1 to arg\" (+ x 1))");
+ Xen_eval_C_string("(define (1- x) \"subtract 1 from arg\" (- x 1))");
+ Xen_eval_C_string("(define-macro (while whether . body) `(do () ((not ,whether)) , at body))");
+ Xen_eval_C_string("(define (identity x) \"return arg\" x)");
return(s7);
}
@@ -1979,9 +1722,6 @@ void xen_initialize(void)
char *xen_version(void)
{
-#if HAVE_XEN_STRDUP
- return(xen_strdup("no extension language"));
-#else
char *buf;
buf = (char *)calloc(64, sizeof(char));
#if HAVE_SNPRINTF
@@ -1990,7 +1730,6 @@ char *xen_version(void)
sprintf(buf, "no extension language");
#endif
return(buf);
-#endif
}
@@ -2004,44 +1743,8 @@ void xen_initialize(void)
}
-void xen_gc_mark(XEN val)
-{
-}
-
-
-int xen_to_c_int_or_else(XEN obj, int fallback)
-{
- return(fallback);
-}
-
-
-off_t xen_to_c_off_t_or_else(XEN obj, off_t fallback)
-{
- return(0);
-}
-
-
-off_t xen_to_c_off_t(XEN obj)
-{
- return(0);
-}
-
-
-XEN c_to_xen_off_t(off_t val)
-{
- return(XEN_ZERO);
-}
-
-
-int64_t xen_to_c_int64_t_or_else(XEN obj, int64_t fallback)
-{
- return(0);
-}
-
-
-int64_t xen_to_c_int64_t(XEN obj)
+void xen_gc_mark(Xen val)
{
- return(0);
}
diff --git a/xen.h b/xen.h
index fd8c08f..6945a2e 100644
--- a/xen.h
+++ b/xen.h
@@ -10,11 +10,31 @@
*/
#define XEN_MAJOR_VERSION 3
-#define XEN_MINOR_VERSION 7
-#define XEN_VERSION "3.7"
+#define XEN_MINOR_VERSION 25
+#define XEN_VERSION "3.25"
/* HISTORY:
*
+ * 20-Aug-15: Xen_define_typed_procedure, Xen_define_typed_dilambda.
+ * --------
+ * 27-Dec: Xen_arity in s7 now uses s7_arity. Xen_define_integer_procedure, Xen_define_dilambda.
+ * 21-Feb: Xen_is_number and friends.
+ * 7-Jan-14: in s7, C_TO_XEN_STRING and XEN_TO_C_STRING now treat a null string as a string (not #f).
+ * --------
+ * 9-Nov: removed XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER.
+ * 11-Oct: removed XEN_EXACT_P.
+ * 23-Sep: removed *_OR_ELSE, XEN_ARG_*, and OFF_T* macros; added XEN_ARGIFY* to the Forth section.
+ * 7-Jul-13: removed int64 stuff (it was not used anywhere). Made various Ruby changes (NUM2ULL etc).
+ * --------
+ * 5-Nov: minor s7-related changes.
+ * 9-July: XEN_VECTOR_ELEMENTS and XEN_VECTOR_COPY.
+ * 4-June: XEN_PROVIDE
+ * 8-May: added description arg to XEN_DEFINE_SIMPLE_HOOK and XEN_DEFINE_HOOK, only used in scheme.
+ * 12-Jan-12: added reverse argument to s7 version of XEN_MAKE_OBJECT_TYPE.
+ * --------
+ * 20-Oct: XEN_LONG_LONG_P.
+ * 5-Jun-11: XEN_DEFINE_SAFE_PROCEDURE, an experiment with s7.
+ * --------
* 25-Nov: updates for Ruby 1.9.*.
* 7-Nov: XEN_ADD_HOOK.
* 23-Oct: use s7_call_with_location, rather than s7_call, for better error reporting.
@@ -34,88 +54,86 @@
* 14-Mar: removed XEN_LOCAL_GC_PROTECT and XEN_LOCAL_GC_UNPROTECT.
* 14-Jan-09: s7_xen_initialize.
* --------
- * 17-Nov-08: use s7_define_constant in XEN_DEFINE_CONSTANT.
- * 1-Nov-08: changed s7 and Guile C_TO_XEN_STRING slightly.
- * 16-Oct-08: removed Gauche support.
- * 10-Aug-08: S7, a TinyScheme derivative.
+ * 17-Nov: use s7_define_constant in XEN_DEFINE_CONSTANT.
+ * 1-Nov: changed s7 and Guile C_TO_XEN_STRING slightly.
+ * 16-Oct: removed Gauche support.
+ * 10-Aug: S7, a TinyScheme derivative.
* changed XEN_NUMERATOR and XEN_DENOMINATOR to return off_t not XEN.
- * 23-Jul-08: be more careful about wrapping POINTERs (they say 64-bit MS C void* == unsigned long long, but not unsigned long).
- * 30-Jun-08: XEN_OFF_T_IF_BOUND_P.
- * 19-May-08: more const char* arg declarations.
- * 14-May-08: changed XEN_ARITY in Guile to use scm_procedure_property.
- * 1-May-08: XEN_NAN_P and XEN_INF_P (Guile).
- * 23-Apr-08: try to get old Gauche (8.7) to work again.
+ * 23-Jul: be more careful about wrapping POINTERs (they say 64-bit MS C void* == unsigned long long, but not unsigned long).
+ * 30-Jun: XEN_OFF_T_IF_BOUND_P.
+ * 19-May: more const char* arg declarations.
+ * 14-May: changed XEN_ARITY in Guile to use scm_procedure_property.
+ * 1-May: XEN_NAN_P and XEN_INF_P (Guile).
+ * 23-Apr: try to get old Gauche (8.7) to work again.
* 1-Mar-08: no ext case now checks arg consistency.
* --------
- * 12-Dec-07: Gauche uses COMPNUM, not COMPLEX (after 0.8.7?), NUMBERP for complex?
- * 21-Nov-07: XEN_HAVE_COMPLEX_NUMBERS.
- * 18-Jul-07: Gauche error handling changes.
- * 28-Apr-07: Gauche API changes in versions 0.8.8, 0.8.10, and 0.9.
- * 14-Feb-07: XEN_PUTS and friends for fth (Mike).
+ * 12-Dec: Gauche uses COMPNUM, not COMPLEX (after 0.8.7?), NUMBERP for complex?
+ * 21-Nov: XEN_HAVE_COMPLEX_NUMBERS.
+ * 18-Jul: Gauche error handling changes.
+ * 28-Apr: Gauche API changes in versions 0.8.8, 0.8.10, and 0.9.
+ * 14-Feb: XEN_PUTS and friends for fth (Mike).
* 17-Jan-07: rb_errinfo changes (Mike Scholz).
* --------
- * 14-Nov-06: check for Scm_EvalRec (Gauche 0.8.8).
- * 9-Sep-06: XEN_LOAD_PATH and XEN_ADD_TO_LOAD_PATH
- * 1-Sep-06: string and array changes for Ruby (from Mike).
- * 7-Aug-06: more careful list length handling in Ruby (from Mike).
- * 23-May-06: added xen_rb_repl_set_prompt to set (no-gui) Ruby repl prompt.
- * 12-May-06: changed HAVE_RATIOS to XEN_HAVE_RATIOS.
- * 17-Apr-06: removed XEN_MAKE_OBJECT.
- * 15-Apr-06: Gauche support.
+ * 14-Nov: check for Scm_EvalRec (Gauche 0.8.8).
+ * 9-Sep: XEN_LOAD_PATH and XEN_ADD_TO_LOAD_PATH
+ * 1-Sep: string and array changes for Ruby (from Mike).
+ * 7-Aug: more careful list length handling in Ruby (from Mike).
+ * 23-May: added xen_rb_repl_set_prompt to set (no-gui) Ruby repl prompt.
+ * 12-May: changed HAVE_RATIOS to XEN_HAVE_RATIOS.
+ * 17-Apr: removed XEN_MAKE_OBJECT.
+ * 15-Apr: Gauche support.
* 28-Mar-06: Forth support thanks to Mike Scholz.
* --------
- * 7-Nov-05: xen_rb_defined_p (Mike Scholz).
- * 24-Oct-05: XEN_LOAD_FILE_WITH_PATH.
- * 16-Sep-05: removed some debugging extras that caused confusion on 64-bit machines.
- * 12-Aug-05: include guile setter procedure names for better error reporting.
- * 14-Jun-05: XEN_DEFINE (XEN value, not assumed to be int as in XEN_DEFINE_CONSTANT).
+ * 7-Nov: xen_rb_defined_p (Mike Scholz).
+ * 16-Sep: removed some debugging extras that caused confusion on 64-bit machines.
+ * 12-Aug: include guile setter procedure names for better error reporting.
+ * 14-Jun: XEN_DEFINE (XEN value, not assumed to be int as in XEN_DEFINE_CONSTANT).
* XEN_ASSOC, XEN_MEMBER, and XEN_PROCEDURE_NAME for Scheme side.
* XEN_DEFINE_HOOK and XEN_DEFINE_SIMPLE_HOOK no longer take the "Var" arg.
- * 18-May-05: deprecate XEN_NUMBER_OR_BOOLEAN_IF_BOUND_P and XEN_NUMBER_OR_BOOLEAN_P.
- * 29-Mar-05: C_TO_XEN_STRINGN changes.
- * 24-Mar-05: Ruby properties (Mike Scholz).
- * 8-Mar-05: Ruby improvements in keywords and hooks (Mike Scholz).
- * 7-Mar-05: C99 complex number changes (creal, _Complex_I) (Steve Bankowitz).
- * 2-Mar-05: Ruby support for off_t (Mike Scholz).
- * 4-Jan-05: more guile changes, deprecated XEN_VECTOR_ELEMENTS.
+ * 18-May: deprecate XEN_NUMBER_OR_BOOLEAN_IF_BOUND_P and XEN_NUMBER_OR_BOOLEAN_P.
+ * 29-Mar: C_TO_XEN_STRINGN changes.
+ * 24-Mar: Ruby properties (Mike Scholz).
+ * 8-Mar: Ruby improvements in keywords and hooks (Mike Scholz).
+ * 7-Mar: C99 complex number changes (creal, _Complex_I) (Steve Bankowitz).
+ * 2-Mar: Ruby support for off_t (Mike Scholz).
+ * 4-Jan-05: more guile changes.
* --------
- * 31-Dec-04: removed "caller" arg from *_NO_CATCH.
- * 10-Nov-04: scm_c_vector* (new Guile functions)
- * 21-Oct-04: XEN_LIST_REVERSE, (using rb_ary_dup available in 1.8)
- * 7-Oct-04: keyword changes for new Guile.
- * 28-Sep-04: deprecated *_WITH_CALLER -- these no longer do anything useful in Guile.
+ * 31-Dec: removed "caller" arg from *_NO_CATCH.
+ * 10-Nov: scm_c_vector* (new Guile functions)
+ * 21-Oct: XEN_LIST_REVERSE, (using rb_ary_dup available in 1.8)
+ * 7-Oct: keyword changes for new Guile.
+ * 28-Sep: deprecated *_WITH_CALLER -- these no longer do anything useful in Guile.
* NaNs and Infs -> 0 or 0.0 in XEN_TO_C_INT|DOUBLE -- perhaps I should add another set of macros?
- * 23-Aug-04: more Guile name changes.
- * 12-Aug-04: more Guile name changes, C_TO_XEN_STRINGN (Guile)
- * 3-Aug-04: xen_to_c_int bugfix thanks to Kjetil S. Matheussen.
- * 29-Jul-04: deprecated XEN_TO_C_BOOLEAN_OR_TRUE.
- * 21-Jul-04: deprecated XEN_TO_SMALL_C_INT and C_TO_SMALL_XEN_INT.
+ * 23-Aug: more Guile name changes.
+ * 12-Aug: more Guile name changes, C_TO_XEN_STRINGN (Guile)
+ * 3-Aug: xen_to_c_int bugfix thanks to Kjetil S. Matheussen.
+ * 29-Jul: deprecated XEN_TO_C_BOOLEAN_OR_TRUE.
+ * 21-Jul: deprecated XEN_TO_SMALL_C_INT and C_TO_SMALL_XEN_INT.
* use new Guile 1.7 numerical function names (under flag HAVE_SCM_TO_SIGNED_INTEGER).
- * 28-Jun-04: XEN_REQUIRED_ARGS_OK to make it easier to turn off this check.
- * 9-June-04: complex number conversions (Guile) -- Ruby complex numbers are an optional module?
- * 21-May-04: plug some memory leaks in Ruby cases.
- * 23-Feb-04: changed DEBUGGING to XEN_DEBUGGING, added redefinition checks under that switch.
- * 2-Feb-04: C_TO_XEN_CHAR, ratio support (Guile), XEN_CONS_P, XEN_PAIR_P, etc
- * 6-Jan-04: XEN_VARIABLE_REF in Guile changed to support 1.4 and older versions.
+ * 28-Jun: XEN_REQUIRED_ARGS_OK to make it easier to turn off this check.
+ * 9-June: complex number conversions (Guile) -- Ruby complex numbers are an optional module?
+ * 21-May: plug some memory leaks in Ruby cases.
+ * 23-Feb: changed DEBUGGING to XEN_DEBUGGING, added redefinition checks under that switch.
+ * 2-Feb: C_TO_XEN_CHAR, ratio support (Guile), XEN_CONS_P, XEN_PAIR_P, etc
+ * 6-Jan: XEN_VARIABLE_REF in Guile changed to support 1.4 and older versions.
* 5-Jan-04: hook support in Ruby thanks to Michael Scholz.
* --------
- * 1-Nov-03: protect several macros from hidden double evaluations.
- * 29-Sep-03: fixed incorrect assumption in xen_rb_cons (xen.c) that arg2 was list.
- * 8-Sep-03: removed xen_malloc -- can't remember now why this existed.
- * 19-Aug-03: xen_rb_str_new2 to avoid unwanted side-effects.
- * 12-Aug-03: various changes for ISO C99.
- * 30-Jul-03: use new SCM_VECTOR_REF/SET macros if they're defined.
- * 7-Apr-03: changes to error handlers for more perspicuous error messages
+ * 1-Nov: protect several macros from hidden double evaluations.
+ * 29-Sep: fixed incorrect assumption in xen_rb_cons (xen.c) that arg2 was list.
+ * 8-Sep: removed xen_malloc -- can't remember now why this existed.
+ * 19-Aug: xen_rb_str_new2 to avoid unwanted side-effects.
+ * 12-Aug: various changes for ISO C99.
+ * 30-Jul: use new SCM_VECTOR_REF/SET macros if they're defined.
+ * 7-Apr: changes to error handlers for more perspicuous error messages
* changed XEN_PROTECT_FROM_GC in Ruby to use rb_gc_register_address, added XEN_UNPROTECT_FROM_GC (rb_gc_unregister_address)
- * 10-Mar-03: XEN_OUT_OF_RANGE_ERROR, XEN_BAD_ARITY_ERROR
- * 17-Feb-03: XEN_HOOK_P
+ * 10-Mar: XEN_OUT_OF_RANGE_ERROR, XEN_BAD_ARITY_ERROR
+ * 17-Feb: XEN_HOOK_P
* 20-Jan-03: added Windows case for auto-import loader bugfix.
* --------
- * 19-Dec-02: proc arg checks for Ruby (to make sure XEN_[N|V]ARGIFY|DEFINE_PROCEDURE[etc] agree)
- * 29-Jul-02: SCM_WRITABLE_VELTS for current CVS Guile
- * 28-May-02: off_t equivalents in Ruby 1.7
- * 6-May-02: off_t (long long) macros.
- * 29-Apr-02: XEN_EXACT_P
+ * 19-Dec: proc arg checks for Ruby (to make sure XEN_[N|V]ARGIFY|DEFINE_PROCEDURE[etc] agree)
+ * 29-Jul: SCM_WRITABLE_VELTS for current CVS Guile
+ * 28-May: off_t equivalents in Ruby 1.7
+ * 6-May: off_t (long long) macros.
* 2-Jan-02: removed TIMING and MCHECK debugging stuff, VARIABLE_REF -> XEN_VARIABLE_REF
* --------
* 22-Sep-01: removed (redundant) UNSIGNED_LONG macros -- use ULONG instead
@@ -123,27 +141,20 @@
#ifndef __cplusplus
#include <sys/types.h>
-#if HAVE_STDBOOL_H
+#ifndef _MSC_VER
#include <stdbool.h>
#else
#ifndef true
- #define bool int
+ #define bool unsigned char
#define true 1
#define false 0
#endif
#endif
#endif
-#ifndef c__FUNCTION__
-#if defined(__STDC__) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)
- #define c__FUNCTION__ __func__
-#else
-#ifdef __GNUC__
- #define c__FUNCTION__ __FUNCTION__
-#else
- #define c__FUNCTION__ ""
-#endif
-#endif
+
+#if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L))))
+ #define __func__ __FUNCTION__
#endif
@@ -192,16 +203,12 @@
#define XEN_NUMBER_P(Arg) ({ int _xen_h_8_ = TYPE(Arg); ((_xen_h_8_ == T_FLOAT) || (_xen_h_8_ == T_FIXNUM) || (_xen_h_8_ == T_BIGNUM)); })
#define XEN_INTEGER_P(Arg) ({ int _xen_h_9_ = TYPE(Arg); ((_xen_h_9_ == T_FIXNUM) || (_xen_h_9_ == T_BIGNUM)); })
#define XEN_PROCEDURE_P(Arg) ({ XEN _xen_h_10_ = Arg; (XEN_BOUND_P(_xen_h_10_) && (rb_obj_is_kind_of(_xen_h_10_, rb_cProc))); })
- #define XEN_OFF_T_P(Arg) ({ int _xen_h_11_ = TYPE(Arg); ((_xen_h_11_ == T_FIXNUM) || (_xen_h_11_ == T_BIGNUM)); })
- #define XEN_INT64_T_P(Arg) ({ int _xen_h_11_ = TYPE(Arg); ((_xen_h_11_ == T_FIXNUM) || (_xen_h_11_ == T_BIGNUM)); })
#define XEN_KEYWORD_P(Obj) ({ XEN _xen_h_12_ = Obj; (XEN_BOUND_P(_xen_h_12_) && SYMBOL_P(_xen_h_12_)); })
#else
#define XEN_BOOLEAN_P(Arg) (XEN_TRUE_P(Arg) || XEN_FALSE_P(Arg))
#define XEN_NUMBER_P(Arg) ((TYPE(Arg) == T_FLOAT) || (TYPE(Arg) == T_FIXNUM) || (TYPE(Arg) == T_BIGNUM))
#define XEN_INTEGER_P(Arg) ((TYPE(Arg) == T_FIXNUM) || (TYPE(Arg) == T_BIGNUM))
#define XEN_PROCEDURE_P(Arg) (XEN_BOUND_P(Arg) && (rb_obj_is_kind_of(Arg, rb_cProc)))
- #define XEN_OFF_T_P(Arg) ((TYPE(Arg) == T_FIXNUM) || (TYPE(Arg) == T_BIGNUM))
- #define XEN_INT64_T_P(Arg) ((TYPE(Arg) == T_FIXNUM) || (TYPE(Arg) == T_BIGNUM))
#define XEN_KEYWORD_P(Obj) (XEN_BOUND_P(Obj) && SYMBOL_P(Obj))
#endif
@@ -219,13 +226,12 @@
#define XEN_CADDDR(a) xen_rb_list_ref(a, 3)
#define XEN_CDR(a) xen_rb_cdr(a)
#define XEN_CDDR(a) XEN_CDR(XEN_CDR(a))
+#define XEN_CDDDR(a) XEN_CDR(XEN_CDR(XEN_CDR(a)))
#define XEN_LIST_P(Arg) ((Arg) == XEN_EMPTY_LIST || XEN_CONS_P(Arg))
#define XEN_LIST_P_WITH_LENGTH(Arg, Len) ((Len = XEN_LIST_LENGTH(Arg)) >= 0)
#define XEN_LIST_LENGTH(Arg) xen_rb_list_length(Arg)
#define XEN_EQ_P(a, b) ((a) == (b))
-#define XEN_EQV_P(a, b) ((a) == (b))
-#define XEN_EQUAL_P(a, b) ((a) == (b))
#define XEN_LIST_1(a) rb_ary_new3(1, a)
#define XEN_LIST_2(a, b) rb_ary_new3(2, a, b)
#define XEN_LIST_3(a, b, c) rb_ary_new3(3, a, b, c)
@@ -242,22 +248,19 @@
#define XEN_LIST_REVERSE(Lst) ((Lst == XEN_EMPTY_LIST) ? XEN_EMPTY_LIST : rb_ary_reverse(XEN_COPY_ARG(Lst)))
/* ---- numbers ---- */
-/* apparently no complex numbers (built-in) in Ruby? */
-
#define XEN_ZERO INT2NUM(0)
#define XEN_DOUBLE_P(Arg) XEN_NUMBER_P(Arg)
#define XEN_TO_C_DOUBLE(a) NUM2DBL(a)
-#if defined(__GNUC__) && (!(defined(__cplusplus)))
- #define XEN_TO_C_DOUBLE_OR_ELSE(a, b) ({ XEN _xen_h_4_ = a; (XEN_NUMBER_P(_xen_h_4_) ? NUM2DBL(_xen_h_4_) : b); })
-#else
- #define XEN_TO_C_DOUBLE_OR_ELSE(a, b) xen_rb_to_c_double_or_else(a, b)
-#endif
#define C_TO_XEN_DOUBLE(a) rb_float_new(a)
#define XEN_TO_C_INT(a) rb_num2long(a)
-#define XEN_TO_C_INT_OR_ELSE(a, b) xen_rb_to_c_int_or_else(a, b)
+
+/* apparently no complex numbers (built-in) in Ruby? */
+#define XEN_COMPLEX_P(Arg) 1
+#define C_TO_XEN_COMPLEX(a) XEN_ZERO
+#define XEN_TO_C_COMPLEX(a) 0.0
#define XEN_ULONG_P(Arg1) XEN_INTEGER_P(Arg1)
-#define XEN_EXACT_P(Arg1) XEN_INTEGER_P(Arg1)
+#define XEN_WRAPPED_C_POINTER_P(Arg1) XEN_INTEGER_P(Arg1)
#define C_TO_XEN_INT(a) INT2NUM(a)
#define XEN_TO_C_ULONG(a) NUM2ULONG(a)
#ifdef ULONG2NUM
@@ -266,18 +269,30 @@
#define C_TO_XEN_ULONG(a) UINT2NUM((unsigned long)a)
#endif
-#ifndef OFFT2NUM
- #define OFFT2NUM(a) INT2NUM(a)
-#endif
-#ifndef NUM2OFFT
- #define NUM2OFFT(a) NUM2LONG(a)
-#endif
-#define C_TO_XEN_LONG_LONG(a) OFFT2NUM(a)
-#define XEN_TO_C_LONG_LONG(a) NUM2OFFT(a)
+#ifdef NUM2ULL
+/* ruby 1.9.3 */
+ #define C_TO_XEN_LONG_LONG(a) LL2NUM(a)
+ #define XEN_TO_C_LONG_LONG(a) NUM2LL(a)
-#define XEN_ULONG_LONG_P(Arg) XEN_ULONG_P(Arg)
-#define XEN_TO_C_ULONG_LONG(Arg) XEN_TO_C_INT64_T(a)
-#define C_TO_XEN_ULONG_LONG(Arg) C_TO_XEN_INT64_T((int64_t)a)
+ #define XEN_ULONG_LONG_P(Arg) XEN_INTEGER_P(Arg)
+ #define XEN_TO_C_ULONG_LONG(Arg) NUM2ULL(Arg) /* NUM2ULONG(Arg) */
+ #define C_TO_XEN_ULONG_LONG(Arg) ULL2NUM(Arg) /* INT2NUM(Arg) */
+#else
+/* older versions -- no dependable version number in ruby -- these macros may not work on a 64-bit machine */
+
+ #ifndef OFFT2NUM
+ #define OFFT2NUM(a) INT2NUM(a)
+ #endif
+ #ifndef NUM2OFFT
+ #define NUM2OFFT(a) NUM2LONG(a)
+ #endif
+ #define C_TO_XEN_LONG_LONG(a) OFFT2NUM(a)
+ #define XEN_TO_C_LONG_LONG(a) NUM2OFFT(a)
+
+ #define XEN_ULONG_LONG_P(Arg) XEN_INTEGER_P(Arg)
+ #define XEN_TO_C_ULONG_LONG(Arg) NUM2OFFT(Arg)
+ #define C_TO_XEN_ULONG_LONG(Arg) OFFT2NUM(Arg)
+#endif
/* ---- strings ---- */
#define XEN_STRING_P(Arg) ((TYPE(Arg) == T_STRING) && (!SYMBOL_P(Arg)))
@@ -294,12 +309,9 @@
#define C_TO_XEN_CHAR(Arg) rb_str_new((char *)(&(Arg)), 1)
#define XEN_NAME_AS_C_STRING_TO_VALUE(a) xen_rb_gv_get(a)
-#define C_STRING_TO_XEN_FORM(Str) XEN_EVAL_C_STRING(Str)
-#define XEN_EVAL_FORM(Form) ((XEN)Form)
#define XEN_EVAL_C_STRING(Arg) xen_rb_eval_string_with_error(Arg)
#define XEN_TO_STRING(Obj) xen_rb_obj_as_string(Obj)
#define XEN_LOAD_FILE(a) xen_rb_load_file_with_error(C_TO_XEN_STRING(a))
-#define XEN_LOAD_FILE_WITH_PATH(a) xen_rb_load_file_with_error(C_TO_XEN_STRING(a))
#define XEN_LOAD_PATH XEN_NAME_AS_C_STRING_TO_VALUE("$LOAD_PATH")
#define XEN_ADD_TO_LOAD_PATH(Path) xen_rb_add_to_load_path(Path)
@@ -308,9 +320,8 @@
#define XEN_HOOK_PROCEDURES(a) xen_rb_hook_to_a(a)
#define XEN_CLEAR_HOOK(a) xen_rb_hook_reset_hook(a)
#define XEN_HOOKED(a) (!xen_rb_hook_empty_p(a))
-#define XEN_DEFINE_HOOK(Name, Arity, Help) xen_rb_create_hook((char *)(Name), Arity, (char *)Help)
-/* #define XEN_DEFINE_SIMPLE_HOOK(Arity) xen_rb_hook_c_new((char *)"simple_hook", Arity, NULL); */
-#define XEN_DEFINE_SIMPLE_HOOK(Arity) xen_rb_create_simple_hook(Arity);
+#define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) xen_rb_create_hook((char *)(Name), Arity, (char *)Help)
+#define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) xen_rb_create_simple_hook(Arity);
#define XEN_ADD_HOOK(Hook, Func, Name, Doc) xen_rb_add_hook(Hook, (XEN (*)())Func, Name, Doc)
/* ---- vectors ---- */
@@ -320,6 +331,7 @@
#define XEN_VECTOR_SET(Vect, Num, Val) xen_rb_list_set(Vect, Num, Val)
#define XEN_MAKE_VECTOR(Num, Fill) xen_rb_ary_new_with_initial_element(Num, Fill)
#define XEN_VECTOR_TO_LIST(a) a
+#define XEN_VECTOR_COPY(Vect) rb_ary_dup(Vect)
#define XEN_ASSOC_REF(Item, Lst) xen_assoc(Item, Lst)
#define XEN_ASSOC_SET(Sym, Val, Lst) xen_set_assoc(Sym, Val, Lst)
@@ -329,7 +341,6 @@
#define XEN_SYMBOL_P(Arg) SYMBOL_P(Arg)
#define XEN_SYMBOL_TO_C_STRING(a) ((char *)rb_id2name(SYM2ID(a)))
#define C_STRING_TO_XEN_SYMBOL(a) ID2SYM(rb_intern(a))
-#define XEN_STRING_TO_SYMBOL(Str) C_STRING_TO_XEN_SYMBOL(XEN_TO_C_STRING(Str))
#define XEN_SYMBOL_TO_STRING(Sym) C_TO_XEN_STRING(XEN_SYMBOL_TO_C_STRING(Sym))
#define XEN_DOCUMENTATION_SYMBOL C_STRING_TO_XEN_SYMBOL("documentation")
#define XEN_OBJECT_HELP(Name) rb_documentation(Name)
@@ -361,6 +372,7 @@
/* ---- C structs ---- */
#define XEN_MARK_OBJECT_TYPE void *
#define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, Mark, Free) return(Data_Wrap_Struct(Tag, Mark, Free, Val))
+#define XEN_MAKE_OBJECT(Tag, Val, Mark, Free) Data_Wrap_Struct(Tag, Mark, Free, Val)
#define XEN_OBJECT_REF(a) DATA_PTR(a)
#define XEN_OBJECT_TYPE VALUE
#define XEN_OBJECT_TYPE_P(OBJ, TAG) (XEN_BOUND_P(OBJ) && (rb_obj_is_instance_of(OBJ, TAG)))
@@ -398,7 +410,6 @@
#define XEN_VALUE_ARG_PROCEDURE_CAST
#endif
-#define XEN_PROCEDURE_SOURCE(Func) Func
#define XEN_ARITY(Func) rb_funcall(Func, rb_intern("arity"), 0)
#define XEN_REQUIRED_ARGS(Func) xen_rb_required_args(XEN_ARITY(Func))
#define XEN_REQUIRED_ARGS_OK(Func, Args) (xen_rb_required_args(XEN_ARITY(Func)) == Args)
@@ -418,11 +429,7 @@
XEN_DEFINE_PROCEDURE(Set_Name, XEN_PROCEDURE_CAST Set_Func, Set_Req, Set_Opt, 0, Get_Help); \
} while (0)
-#define XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Rev_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \
- do { \
- XEN_DEFINE_PROCEDURE(Get_Name, XEN_PROCEDURE_CAST Get_Func, Get_Req, Get_Opt, 0, Get_Help); \
- XEN_DEFINE_PROCEDURE(Set_Name, XEN_PROCEDURE_CAST Set_Func, Set_Req, Set_Opt, 0, Get_Help); \
- } while (0)
+#define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc)
#define XEN_CALL_0(Func, Caller) xen_rb_funcall_0(Func)
#define XEN_CALL_1(Func, Arg1, Caller) rb_funcall(Func, rb_intern("call"), 1, Arg1)
@@ -432,7 +439,6 @@
#define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) rb_funcall(Func, rb_intern("call"), 5, Arg1, Arg2, Arg3, Arg4, Arg5)
#define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) rb_funcall(Func, rb_intern("call"), 6, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)
#define XEN_APPLY(Func, Args, Caller) xen_rb_apply(Func, Args)
-#define XEN_APPLY_ARG_LIST_END Qnil
#define XEN_CALL_0_NO_CATCH(Func) xen_rb_funcall_0(Func)
#define XEN_CALL_1_NO_CATCH(Func, Arg1) rb_funcall(Func, rb_intern("call"), 1, Arg1)
#define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) rb_funcall(Func, rb_intern("call"), 2, Arg1, Arg2)
@@ -442,7 +448,7 @@
/* ---- keywords, etc ---- */
#define XEN_KEYWORD_EQ_P(k1, k2) ((k1) == (k2))
#define XEN_MAKE_KEYWORD(Arg) xen_rb_make_keyword(Arg)
-#define XEN_YES_WE_HAVE(a) rb_provide(a)
+#define XEN_PROVIDE(a) rb_provide(a)
#define XEN_PROTECT_FROM_GC(Var) rb_gc_register_address(&(Var))
#define XEN_UNPROTECT_FROM_GC(Var) rb_gc_unregister_address(&(Var))
@@ -450,53 +456,43 @@
#define XEN_ERROR_TYPE(Name) xen_rb_intern(Name)
-#if USE_SND
-
-#define XEN_ERROR(Type, Info) snd_rb_raise(Type, Info)
+#if USE_SND
-#define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \
- do { \
- if (!(Assertion)) \
- snd_rb_raise(XEN_ERROR_TYPE("wrong-type-arg"),\
- XEN_LIST_4(C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \
- C_TO_XEN_INT(Position),\
- Arg,\
- C_TO_XEN_STRING(Correct_Type))); \
- } while (0)
+#define XEN_ERROR(Type, Info) snd_rb_raise(Type, Info)
#define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) \
snd_rb_raise(XEN_ERROR_TYPE("out-of-range"), \
- XEN_LIST_3(C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \
- C_TO_XEN_STRING(Descr), \
- XEN_LIST_1(Arg)))
+ XEN_LIST_5(C_TO_XEN_STRING("~A: argument ~A, ~A, is out of range (~A)"), \
+ C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \
+ C_TO_XEN_INT(ArgN), \
+ Arg, \
+ C_TO_XEN_STRING(Descr)))
#define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) \
- snd_rb_raise(XEN_ERROR_TYPE("wrong-type-arg"),\
- XEN_LIST_4(C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \
- C_TO_XEN_INT(ArgN),\
- Arg,\
- C_TO_XEN_STRING(Descr)))
+ snd_rb_raise(XEN_ERROR_TYPE("wrong-type-arg"), \
+ XEN_LIST_5(C_TO_XEN_STRING("~A: argument ~A, ~A, should be ~A"), \
+ C_TO_XEN_STRING(xen_scheme_procedure_to_ruby(Caller)), \
+ C_TO_XEN_INT(ArgN), \
+ Arg, \
+ C_TO_XEN_STRING(Descr)))
-#else
-
-#define XEN_ERROR(Type, Info) xen_rb_raise(Type, Info)
+#else
-#define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \
- do { \
- if (!(Assertion)) \
- rb_raise(rb_eTypeError, "%s: wrong type arg %d, %s, wanted %s\n", \
- Caller, Position, XEN_TO_C_STRING(XEN_TO_STRING(Arg)), Correct_Type); \
- } while (0)
+#define XEN_ERROR(Type, Info) xen_rb_raise(Type, Info)
#define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr) \
- rb_raise(rb_eRangeError, "%s: arg %d, %s, out of range: %s\n", \
- Caller, ArgN, XEN_TO_C_STRING(XEN_TO_STRING(Arg)), Descr)
+ rb_raise(rb_eRangeError, "%s: argument %d, %s, is out of range (%s)\n", \
+ Caller, (int)ArgN, XEN_AS_STRING(Arg), Descr)
#define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) \
- rb_raise(rb_eTypeError, "%s: wrong type arg %d, %s, wanted %s\n", \
- Caller, ArgN, XEN_TO_C_STRING(XEN_TO_STRING(Arg)), Descr)
+ rb_raise(rb_eTypeError, "%s: argument %d, %s, should be %s\n", \
+ Caller, (int)ArgN, XEN_AS_STRING(Arg), Descr)
-#endif
+#endif
+
+#define XEN_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \
+ if (!(Assertion)) \
+ XEN_WRONG_TYPE_ARG_ERROR(Caller, Position, Arg, Correct_Type)
#define XEN_THROW(Type, Info) xen_rb_raise(Type, Info)
@@ -590,21 +586,6 @@
(argc > 8) ? argv[8] : XEN_UNDEFINED)); \
}
-#define XEN_ARGIFY_10(OutName, InName) \
- static XEN OutName(int argc, XEN *argv, XEN self) \
- { \
- return(InName((argc > 0) ? argv[0] : XEN_UNDEFINED, \
- (argc > 1) ? argv[1] : XEN_UNDEFINED, \
- (argc > 2) ? argv[2] : XEN_UNDEFINED, \
- (argc > 3) ? argv[3] : XEN_UNDEFINED, \
- (argc > 4) ? argv[4] : XEN_UNDEFINED, \
- (argc > 5) ? argv[5] : XEN_UNDEFINED, \
- (argc > 6) ? argv[6] : XEN_UNDEFINED, \
- (argc > 7) ? argv[7] : XEN_UNDEFINED, \
- (argc > 8) ? argv[8] : XEN_UNDEFINED, \
- (argc > 9) ? argv[9] : XEN_UNDEFINED)); \
- }
-
#define XEN_NARGIFY_0(OutName, InName) \
static XEN OutName(void) {return(InName());}
@@ -621,7 +602,7 @@
static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4) {return(InName(Arg1, Arg2, Arg3, Arg4));}
#define XEN_NARGIFY_5(OutName, InName) \
-static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5) {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5));}
+ static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5) {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5));}
#define XEN_NARGIFY_6(OutName, InName) \
static XEN OutName(XEN self, XEN Arg1, XEN Arg2, XEN Arg3, XEN Arg4, XEN Arg5, XEN Arg6) {return(InName(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6));}
@@ -673,8 +654,6 @@ XEN xen_rb_copy_list(XEN val);
XEN xen_rb_str_new2(char *arg);
void xen_add_help(char *name, const char *help);
char *xen_help(char *name);
-double xen_rb_to_c_double_or_else(XEN a, double b);
-int xen_rb_to_c_int_or_else(XEN a, int b);
/* class Hook */
bool xen_rb_hook_p(XEN hook);
bool xen_rb_hook_empty_p(XEN hook);
@@ -733,7 +712,7 @@ XEN xen_assoc(XEN key, XEN alist);
#define XEN_DOCUMENTATION_SYMBOL FTH_DOCUMENTATION_SYMBOL
#define XEN_DEFINED_P(name) fth_defined_p((char *)name)
-#define XEN_YES_WE_HAVE(feature) fth_add_feature(feature)
+#define XEN_PROVIDE(feature) fth_add_feature(feature)
/* === Boolean, Bound, Equal === */
#define XEN_BOOLEAN_P(Arg) FTH_BOOLEAN_P(Arg)
@@ -743,20 +722,16 @@ XEN xen_assoc(XEN key, XEN alist);
#define XEN_TO_C_BOOLEAN(a) FTH_TO_BOOL(a)
#define XEN_BOUND_P(Arg) FTH_BOUND_P(Arg)
-
#define XEN_EQ_P(a, b) ((a) == (b))
-#define XEN_EQV_P(a, b) XEN_EQ_P(a, b)
-#define XEN_EQUAL_P(a, b) fth_object_equal_p(a, b)
/* === Number === */
#define XEN_ZERO FTH_ZERO
#define XEN_NUMBER_P(Arg) FTH_NUMBER_P(Arg)
-#define XEN_EXACT_P(Arg) FTH_EXACT_P(Arg)
+#define XEN_WRAPPED_C_POINTER_P(Arg) FTH_EXACT_P(Arg)
#define XEN_INTEGER_P(Arg) FTH_INTEGER_P(Arg)
#define C_TO_XEN_INT(a) fth_make_int(a)
#define XEN_TO_C_INT(a) fth_int_ref(a)
-#define XEN_TO_C_INT_OR_ELSE(a, b) fth_int_ref_or_else(a, b)
#define XEN_ULONG_P(Arg) FTH_UNSIGNED_P(Arg)
#define C_TO_XEN_ULONG(a) fth_make_unsigned((unsigned long)(a))
@@ -766,17 +741,14 @@ XEN xen_assoc(XEN key, XEN alist);
#define XEN_TO_C_ULONG_LONG(Arg) fth_ulong_long_ref(Arg)
#define C_TO_XEN_ULONG_LONG(Arg) fth_make_ulong_long((unsigned long long)Arg)
-#define XEN_OFF_T_P(Arg) FTH_LONG_LONG_P(Arg)
-#define XEN_INT64_T_P(Arg) FTH_LONG_LONG_P(Arg)
#define C_TO_XEN_LONG_LONG(a) fth_make_long_long(a)
#define XEN_TO_C_LONG_LONG(a) fth_long_long_ref(a)
#define XEN_DOUBLE_P(Arg) FTH_FLOAT_P(Arg)
#define C_TO_XEN_DOUBLE(a) fth_make_float(a)
#define XEN_TO_C_DOUBLE(a) fth_float_ref(a)
-#define XEN_TO_C_DOUBLE_OR_ELSE(a, b) fth_float_ref_or_else(a, b)
-#if HAVE_MAKE_COMPLEX || HAVE_MAKE_RECTANGULAR
+#if HAVE_COMPLEX_NUMBERS
# define XEN_COMPLEX_P(Arg) FTH_NUMBER_P(Arg)
# define C_TO_XEN_COMPLEX(a) fth_make_complex(a)
# define XEN_TO_C_COMPLEX(a) fth_complex_ref(a)
@@ -791,8 +763,8 @@ XEN xen_assoc(XEN key, XEN alist);
# define XEN_HAVE_RATIOS true
# define XEN_RATIO_P(Arg) FTH_RATIO_P(Arg)
# define XEN_MAKE_RATIO(Num, Den) fth_make_ratio(Num, Den)
-# define XEN_NUMERATOR(Arg) XEN_TO_C_INT64_T(fth_numerator(Arg))
-# define XEN_DENOMINATOR(Arg) XEN_TO_C_INT64_T(fth_denominator(Arg))
+# define XEN_NUMERATOR(Arg) XEN_TO_C_LONG_LONG(fth_numerator(Arg))
+# define XEN_DENOMINATOR(Arg) XEN_TO_C_LONG_LONG(fth_denominator(Arg))
# define XEN_RATIONALIZE(Arg1, Arg2) fth_rationalize(Arg1, Arg2)
#endif
@@ -826,10 +798,7 @@ XEN xen_assoc(XEN key, XEN alist);
#define XEN_KEYWORD_EQ_P(K1, K2) XEN_EQ_P(K1, K2)
#define XEN_EVAL_C_STRING(arg) fth_eval(arg)
-#define XEN_EVAL_FORM(Form) XEN_EVAL_C_STRING(XEN_TO_C_STRING(Form))
-#define C_STRING_TO_XEN_FORM(str) XEN_EVAL_C_STRING(str)
#define XEN_LOAD_FILE(a) fth_load_file(a)
-#define XEN_LOAD_FILE_WITH_PATH(a) fth_load_file(a)
#define XEN_LOAD_PATH XEN_NAME_AS_C_STRING_TO_VALUE("*load-path*")
#define XEN_ADD_TO_LOAD_PATH(Path) fth_add_load_path(Path)
@@ -840,6 +809,7 @@ XEN xen_assoc(XEN key, XEN alist);
#define XEN_VECTOR_TO_LIST(Vect) fth_array_to_list(Vect)
#define XEN_VECTOR_REF(Vect, Num) fth_array_ref(Vect, Num)
#define XEN_VECTOR_SET(Vect, Num, Val) fth_array_set(Vect, Num, Val)
+#define XEN_VECTOR_COPY(Vect) fth_array_copy(Vect)
/* === List === */
#define XEN_NULL_P(a) FTH_NIL_P(a)
@@ -868,6 +838,7 @@ XEN xen_assoc(XEN key, XEN alist);
#define XEN_CADDDR(a) FTH_CADDDR(a)
#define XEN_CDR(a) fth_cdr(a)
#define XEN_CDDR(a) FTH_CDDR(a)
+#define XEN_CDDDR(a) FTH_CDDDR(a)
#define XEN_COPY_ARG(Lst) fth_list_copy(Lst)
#define XEN_APPEND(a, b) fth_list_append(XEN_LIST_2(a, b))
#define XEN_ASSOC_REF(Item, Lst) fth_list_assoc_ref(Lst, Item)
@@ -878,8 +849,8 @@ XEN xen_assoc(XEN key, XEN alist);
/* === Hook, Procedure === */
#define XEN_HOOK_P(Arg) FTH_HOOK_P(Arg)
#define XEN_HOOKED(a) (!fth_hook_empty_p(a))
-#define XEN_DEFINE_HOOK(name, arity, help) fth_make_hook(name, arity, help)
-#define XEN_DEFINE_SIMPLE_HOOK(arity) fth_make_simple_hook(arity)
+#define XEN_DEFINE_HOOK(name, descr, arity, help) fth_make_hook(name, arity, help)
+#define XEN_DEFINE_SIMPLE_HOOK(descr, arity) fth_make_simple_hook(arity)
#define XEN_CLEAR_HOOK(Arg) fth_hook_clear(Arg)
#define XEN_HOOK_PROCEDURES(Obj) fth_hook_procedure_list(Obj)
#define XEN_ADD_HOOK(Hook, Func, Name, Doc) fth_add_hook(Hook, (FTH)fth_define_procedure(Name, Func, fth_hook_arity(Hook), 0, false, Doc))
@@ -887,8 +858,6 @@ XEN xen_assoc(XEN key, XEN alist);
#define XEN_PROCEDURE_P(Arg) FTH_PROC_P(Arg)
#define XEN_PROCEDURE_NAME(Func) C_TO_XEN_STRING(fth_proc_name(Func))
#define XEN_PROCEDURE_HELP(Name) fth_documentation_ref(Name)
-#define XEN_PROCEDURE_SOURCE_HELP(Name) XEN_PROCEDURE_HELP(Name)
-#define XEN_PROCEDURE_SOURCE(Func) fth_proc_source_ref(Func)
#define XEN_ARITY(Func) INT_TO_FIX(XEN_REQUIRED_ARGS(Func))
#define XEN_REQUIRED_ARGS(Func) fth_proc_arity(Func)
#define XEN_REQUIRED_ARGS_OK(Func, args) (XEN_REQUIRED_ARGS(Func) == (args))
@@ -904,7 +873,6 @@ XEN xen_assoc(XEN key, XEN alist);
#define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) \
fth_proc_call(Func, Caller, 6, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6)
#define XEN_APPLY(Func, Args, Caller) fth_proc_apply(Func, Args, Caller)
-#define XEN_APPLY_ARG_LIST_END XEN_EMPTY_LIST
#define XEN_CALL_0_NO_CATCH(Func) XEN_CALL_0(Func, NULL)
#define XEN_CALL_1_NO_CATCH(Func, Arg1) XEN_CALL_1(Func, Arg1, NULL)
#define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) XEN_CALL_2(Func, Arg1, Arg2, NULL)
@@ -935,14 +903,14 @@ XEN xen_assoc(XEN key, XEN alist);
XEN_DEFINE_PROCEDURE(Set_Name, XEN_PROCEDURE_CAST Set_Func, Set_Req, Set_Opt, 0, Get_Help); \
} while (0)
-#define XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Rev_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \
- XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt)
+#define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc)
/* === Object === */
#define XEN_OBJECT_TYPE FTH
#define XEN_MARK_OBJECT_TYPE void
#define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, Mark, Free) return(fth_make_instance(Tag, Val))
+#define XEN_MAKE_OBJECT(Tag, Val, Mark, Free) fth_make_instance(Tag, Val)
#define XEN_OBJECT_TYPE_P(Obj, Tag) fth_object_is_instance_of(Obj, Tag)
#define XEN_OBJECT_REF(Obj) fth_instance_ref_gen(Obj)
@@ -982,6 +950,27 @@ XEN xen_assoc(XEN key, XEN alist);
typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data);
+#define XEN_NARGIFY_0(OutName, InName) static XEN (*OutName)(void) = InName;
+#define XEN_NARGIFY_1(OutName, InName) static XEN (*OutName)(XEN a1) = InName;
+#define XEN_NARGIFY_2(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2) = InName;
+#define XEN_NARGIFY_3(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3) = InName;
+#define XEN_NARGIFY_4(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4) = InName;
+#define XEN_NARGIFY_5(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5) = InName;
+#define XEN_NARGIFY_6(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6) = InName;
+#define XEN_NARGIFY_7(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7) = InName;
+#define XEN_NARGIFY_8(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7, XEN a8) = InName;
+#define XEN_NARGIFY_9(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7, XEN a8, XEN a9) = InName;
+#define XEN_ARGIFY_1(OutName, InName) static XEN (*OutName)(XEN a1) = InName;
+#define XEN_ARGIFY_2(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2) = InName;
+#define XEN_ARGIFY_3(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3) = InName;
+#define XEN_ARGIFY_4(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4) = InName;
+#define XEN_ARGIFY_5(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5) = InName;
+#define XEN_ARGIFY_6(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6) = InName;
+#define XEN_ARGIFY_7(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7) = InName;
+#define XEN_ARGIFY_8(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7, XEN a8) = InName;
+#define XEN_ARGIFY_9(OutName, InName) static XEN (*OutName)(XEN a1, XEN a2, XEN a3, XEN a4, XEN a5, XEN a6, XEN a7, XEN a8, XEN a9) = InName;
+#define XEN_VARGIFY(OutName, InName) static XEN (*OutName)(XEN a1) = InName;
+
#endif /* end HAVE_FORTH */
@@ -993,7 +982,15 @@ typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data);
#include "s7.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
extern s7_scheme *s7; /* s7 is a pointer to the current scheme */
+#ifdef __cplusplus
+}
+#endif
+
#define XEN s7_pointer
#define XEN_FILE_EXTENSION "scm"
@@ -1001,12 +998,13 @@ extern s7_scheme *s7; /* s7 is a pointer to the current scheme */
#define XEN_COMMENT_STRING ";"
extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
+extern size_t xen_s7_number_location, xen_s7_denominator_location;
#define XEN_FALSE xen_false
#define XEN_TRUE xen_true
#define XEN_TRUE_P(Arg) ((Arg) == XEN_TRUE) /* not scheme-wise, but Snd-wise (#t as special arg) */
#define XEN_FALSE_P(Arg) ((Arg) == XEN_FALSE)
-#define XEN_BOOLEAN_P(Arg) (((Arg) == XEN_TRUE) || ((Arg) == XEN_FALSE))
+#define XEN_BOOLEAN_P(Arg) s7_is_boolean(Arg)
#define C_TO_XEN_BOOLEAN(Arg) ((Arg) ? XEN_TRUE : XEN_FALSE)
#define XEN_TO_C_BOOLEAN(Arg) ((XEN_TRUE_P(Arg)) ? true : false)
@@ -1014,34 +1012,31 @@ extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
#define XEN_BOUND_P(Arg) ((Arg) != xen_undefined)
#define XEN_EMPTY_LIST xen_nil
#define XEN_UNDEFINED xen_undefined
-
-#define XEN_EQ_P(Arg1, Arg2) s7_is_eq(Arg1, Arg2)
-#define XEN_EQV_P(Arg1, Arg2) s7_is_eqv(Arg1, Arg2)
-#define XEN_EQUAL_P(Arg1, Arg2) s7_is_equal(s7, Arg1, Arg2)
+#define XEN_EQ_P(Arg1, Arg2) ((Arg1) == (Arg2))
#define XEN_CONS_P(Arg) s7_cons_p(Arg)
#define XEN_CONS(Arg1, Arg2) s7_cons(s7, Arg1, Arg2)
-#define XEN_CONS_2(Arg1, Arg2, Arg3) s7_cons(s7, Arg1, XEN_CONS(Arg2, Arg3))
+#define XEN_CONS_2(Arg1, Arg2, Arg3) s7_cons(s7, Arg1, s7_cons(s7, Arg2, Arg3))
#define XEN_PAIR_P(Arg) s7_is_pair(Arg)
#define XEN_CAR(Arg) s7_car(Arg)
#define XEN_CDR(Arg) s7_cdr(Arg)
-#define XEN_CADR(Arg) XEN_CAR(XEN_CDR(Arg))
-#define XEN_CADDR(Arg) XEN_CAR(XEN_CDR(XEN_CDR(Arg)))
-#define XEN_CADDDR(Arg) XEN_CAR(XEN_CDR(XEN_CDR(XEN_CDR(Arg))))
-#define XEN_CDDR(Arg) XEN_CDR(XEN_CDR(Arg))
-#define XEN_CDDDR(Arg) XEN_CDR(XEN_CDR(XEN_CDR(Arg)))
+#define XEN_CADR(Arg) s7_cadr(Arg)
+#define XEN_CADDR(Arg) s7_caddr(Arg)
+#define XEN_CADDDR(Arg) s7_cadddr(Arg)
+#define XEN_CDDR(Arg) s7_cddr(Arg)
+#define XEN_CDDDR(Arg) s7_cdddr(Arg)
#define XEN_LIST_P(Arg) s7_is_list(s7, Arg) /* not pair? because we want '() to return #t here */
#define XEN_LIST_LENGTH(Arg) s7_list_length(s7, Arg)
#define XEN_LIST_P_WITH_LENGTH(Arg, Len) ((s7_is_list(s7, Arg)) && ((Len = XEN_LIST_LENGTH(Arg)) >= 0))
-#define XEN_LIST_1(a) XEN_CONS(a, xen_nil)
-#define XEN_LIST_2(a, b) XEN_CONS(a, XEN_LIST_1(b))
-#define XEN_LIST_3(a, b, c) XEN_CONS(a, XEN_LIST_2(b, c))
-#define XEN_LIST_4(a, b, c, d) XEN_CONS(a, XEN_LIST_3(b, c, d))
-#define XEN_LIST_5(a, b, c, d, e) XEN_CONS(a, XEN_LIST_4(b, c, d, e))
-#define XEN_LIST_6(a, b, c, d, e, f) XEN_CONS(a, XEN_LIST_5(b, c, d, e, f))
-#define XEN_LIST_7(a, b, c, d, e, f, g) XEN_CONS(a, XEN_LIST_6(b, c, d, e, f, g))
-#define XEN_LIST_8(a, b, c, d, e, f, g, h) XEN_CONS(a, XEN_LIST_7(b, c, d, e, f, g, h))
-#define XEN_LIST_9(a, b, c, d, e, f, g, h, i) XEN_CONS(a, XEN_LIST_8(b, c, d, e, f, g, h, i))
+#define XEN_LIST_1(a) s7_list(s7, 1, a)
+#define XEN_LIST_2(a, b) s7_list(s7, 2, a, b)
+#define XEN_LIST_3(a, b, c) s7_list(s7, 3, a, b, c)
+#define XEN_LIST_4(a, b, c, d) s7_list(s7, 4, a, b, c, d)
+#define XEN_LIST_5(a, b, c, d, e) s7_list(s7, 5, a, b, c, d, e)
+#define XEN_LIST_6(a, b, c, d, e, f) s7_list(s7, 6, a, b, c, d, e, f)
+#define XEN_LIST_7(a, b, c, d, e, f, g) s7_list(s7, 7, a, b, c, d, e, f, g)
+#define XEN_LIST_8(a, b, c, d, e, f, g, h) s7_list(s7, 8, a, b, c, d, e, f, g, h)
+#define XEN_LIST_9(a, b, c, d, e, f, g, h, i) s7_list(s7, 9, a, b, c, d, e, f, g, h, i)
#define XEN_LIST_REF(Lst, Num) s7_list_ref(s7, Lst, Num)
#define XEN_LIST_SET(Lst, Num, Val) s7_list_set(s7, Lst, Num, Val)
#define XEN_LIST_REVERSE(Lst) s7_reverse(s7, Lst)
@@ -1055,18 +1050,13 @@ extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
#define XEN_STRING_P(Arg) s7_is_string(Arg)
#define XEN_NAME_AS_C_STRING_TO_VALUE(Arg) s7_name_to_value(s7, Arg)
#define XEN_TO_C_STRING(Str) s7_string(Str)
-#if defined(__GNUC__) && (!(defined(__cplusplus)))
- #define C_TO_XEN_STRING(Str) ({ const char *a = Str; (a) ? s7_make_string(s7, a) : XEN_FALSE; })
-#else
- #define C_TO_XEN_STRING(Arg) xen_s7_c_to_xen_string(Arg)
-#endif
+#define C_TO_XEN_STRING(Str) s7_make_string(s7, Str)
#define C_TO_XEN_STRINGN(Str, Len) s7_make_string_with_length(s7, Str, Len)
#define XEN_ZERO xen_zero
#define XEN_INTEGER_P(Arg) s7_is_integer(Arg)
#define C_TO_XEN_INT(Arg) s7_make_integer(s7, Arg)
-#define XEN_TO_C_INT(Arg) xen_to_c_int(Arg)
-#define XEN_TO_C_INT_OR_ELSE(Arg, Def) ((XEN_INTEGER_P(Arg)) ? XEN_TO_C_INT(Arg) : Def)
+#define XEN_TO_C_INT(Arg) s7_integer(Arg)
#define XEN_ULONG_P(Arg) s7_is_ulong(Arg)
#define XEN_TO_C_ULONG(Arg) s7_ulong(Arg)
@@ -1076,36 +1066,26 @@ extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
#define XEN_TO_C_ULONG_LONG(Arg) s7_ulong_long(Arg)
#define C_TO_XEN_ULONG_LONG(Arg) s7_make_ulong_long(s7, (unsigned long long)Arg)
-#define C_TO_XEN_LONG_LONG(Arg) C_TO_XEN_INT64_T(Arg)
-#define XEN_TO_C_LONG_LONG(Arg) XEN_TO_C_INT64_T(Arg)
+#define C_TO_XEN_LONG_LONG(Arg) s7_make_integer(s7, Arg)
+#define XEN_TO_C_LONG_LONG(Arg) s7_integer(Arg)
-#define XEN_OFF_T_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_INT64_T_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_OFF_T_OR_ELSE(Arg, Def) XEN_TO_C_INT64_T_OR_ELSE(Arg, Def)
-#define C_TO_XEN_OFF_T(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_OFF_T(Arg) XEN_TO_C_INT64_T(Arg)
-#define XEN_TO_C_INT64_T_OR_ELSE(Arg, Def) ((XEN_INTEGER_P(Arg)) ? XEN_TO_C_INT64_T(Arg) : Def)
-#define C_TO_XEN_INT64_T(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_INT64_T(Arg) xen_to_c_int64_t(Arg)
-
-#define XEN_NUMBER_P(Arg) s7_is_real(Arg) /* !! throughout xen, we're assuming no complex number! -- s7_is_number(Arg) */
-#define XEN_EXACT_P(Arg) s7_is_exact(Arg)
+#define XEN_NUMBER_P(Arg) s7_is_real(Arg)
+#define XEN_WRAPPED_C_POINTER_P(Arg) s7_is_c_pointer(Arg)
#define XEN_DOUBLE_P(Arg) s7_is_real(Arg)
-#define XEN_TO_C_DOUBLE(Arg) ((double)s7_number_to_real(Arg))
-#define XEN_TO_C_DOUBLE_OR_ELSE(Arg, Def) xen_to_c_double_or_else(Arg, Def)
+#define XEN_TO_C_DOUBLE(Arg) ((double)s7_number_to_real(s7, Arg))
#define C_TO_XEN_DOUBLE(Arg) s7_make_real(s7, Arg)
-#if WITH_COMPLEX
+#if HAVE_COMPLEX_NUMBERS
#define XEN_HAVE_COMPLEX_NUMBERS 1
#define XEN_COMPLEX_P(Arg) s7_is_complex(Arg)
#define XEN_TO_C_COMPLEX(a) (s7_real_part(a) + s7_imag_part(a) * _Complex_I)
#define C_TO_XEN_COMPLEX(a) s7_make_complex(s7, creal(a), cimag(a))
#else
#define XEN_HAVE_COMPLEX_NUMBERS 0
- #define XEN_COMPLEX_P(Arg) Arg
- #define XEN_TO_C_COMPLEX(a) a
- #define C_TO_XEN_COMPLEX(a) a
+ #define XEN_COMPLEX_P(Arg) false
+ #define XEN_TO_C_COMPLEX(a) 0.0
+ #define C_TO_XEN_COMPLEX(a) XEN_ZERO
#endif
#define XEN_HAVE_RATIOS 1
@@ -1113,9 +1093,8 @@ extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
#define XEN_DENOMINATOR(Arg) s7_denominator(Arg)
#define XEN_RATIONALIZE(Arg1, Arg2) s7_rationalize(s7, XEN_TO_C_DOUBLE(Arg1), XEN_TO_C_DOUBLE(Arg2))
#define XEN_RATIO_P(Arg) s7_is_ratio(Arg)
-#define XEN_MAKE_RATIO(Num, Den) s7_make_ratio(s7, XEN_TO_C_INT64_T(Num), XEN_TO_C_INT64_T(Den))
+#define XEN_MAKE_RATIO(Num, Den) s7_make_ratio(s7, XEN_TO_C_INT(Num), XEN_TO_C_INT(Den))
-#define C_STRING_TO_XEN_FORM(Str) s7_eval_c_string(s7, Str)
#define XEN_EVAL_C_STRING(Arg) s7_eval_c_string(s7, Arg)
#define XEN_TO_STRING(Obj) s7_object_to_string(s7, Obj, false)
@@ -1132,20 +1111,20 @@ extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
#define XEN_MAKE_VECTOR(Num, Fill) s7_make_and_fill_vector(s7, Num, Fill)
#define XEN_VECTOR_TO_LIST(Vect) s7_vector_to_list(s7, Vect)
#define XEN_VECTOR_RANK(Vect) s7_vector_rank(Vect)
+#define XEN_VECTOR_COPY(Vect) s7_vector_copy(s7, Vect)
+#define XEN_VECTOR_ELEMENTS(Vect) s7_vector_elements(Vect)
#define XEN_CHAR_P(Arg) s7_is_character(Arg)
#define XEN_TO_C_CHAR(Arg) s7_character(Arg)
#define C_TO_XEN_CHAR(Arg) s7_make_character(s7, Arg)
#define XEN_KEYWORD_P(Obj) s7_is_keyword(Obj)
-#define XEN_KEYWORD_EQ_P(k1, k2) s7_keyword_eq_p(k1, k2)
+#define XEN_KEYWORD_EQ_P(k1, k2) ((k1) == (k2))
#define XEN_MAKE_KEYWORD(Arg) s7_make_keyword(s7, Arg)
#define XEN_PROCEDURE_P(Arg) s7_is_procedure(Arg)
-#define XEN_PROCEDURE_SOURCE(Func) s7_procedure_source(s7, Func)
#define XEN_LOAD_FILE(File) s7_load(s7, File)
-#define XEN_LOAD_FILE_WITH_PATH(File) s7_load(s7, File)
#define XEN_LOAD_PATH s7_load_path(s7)
#define XEN_ADD_TO_LOAD_PATH(Path) s7_add_to_load_path(s7, Path)
@@ -1153,7 +1132,7 @@ extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
#define XEN_ERROR(Type, Info) s7_error(s7, Type, Info)
#define XEN_THROW(Type, Info) s7_error(s7, Type, Info)
-#define XEN_YES_WE_HAVE(Feature) s7_provide(s7, Feature)
+#define XEN_PROVIDE(Feature) s7_provide(s7, Feature)
#define XEN_PROTECT_FROM_GC(Arg) s7_gc_protect(s7, Arg)
#define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr) s7_wrong_type_arg_error(s7, Caller, ArgN, Arg, Descr)
@@ -1163,245 +1142,37 @@ extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
#define XEN_NARGIFY_0(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName());}
#define XEN_NARGIFY_1(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName(XEN_CAR(args)));}
-#define XEN_NARGIFY_2(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName(XEN_CAR(args), XEN_CADR(args)));}
-
-#define XEN_NARGIFY_3(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1, arg2, arg3; \
- arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- return(InName(arg1, arg2, arg3)); \
- }
-
-#define XEN_NARGIFY_4(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1, arg2, arg3, arg4; \
- arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- return(InName(arg1, arg2, arg3, arg4)); \
- }
-
-#define XEN_NARGIFY_5(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1, arg2, arg3, arg4, arg5; \
- arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- return(InName(arg1, arg2, arg3, arg4, arg5)); \
- }
-
-#define XEN_NARGIFY_6(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1, arg2, arg3, arg4, arg5, arg6; \
- arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- arg6 = XEN_CAR(args); args = XEN_CDR(args); \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6)); \
- }
-
-#define XEN_NARGIFY_7(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7; \
- arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- arg6 = XEN_CAR(args); args = XEN_CDR(args); \
- arg7 = XEN_CAR(args); args = XEN_CDR(args); \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6, arg7)); \
- }
-
-#define XEN_NARGIFY_8(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8; \
- arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- arg6 = XEN_CAR(args); args = XEN_CDR(args); \
- arg7 = XEN_CAR(args); args = XEN_CDR(args); \
- arg8 = XEN_CAR(args); args = XEN_CDR(args); \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)); \
- }
-
-#define XEN_NARGIFY_9(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9; \
- arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- arg6 = XEN_CAR(args); args = XEN_CDR(args); \
- arg7 = XEN_CAR(args); args = XEN_CDR(args); \
- arg8 = XEN_CAR(args); args = XEN_CDR(args); \
- arg9 = XEN_CAR(args); args = XEN_CDR(args); \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9)); \
- }
-
-
-#define XEN_ARGIFY_1(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg = XEN_UNDEFINED; \
- if (args != xen_nil) arg = XEN_CAR(args); \
- return(InName(arg)); \
- }
-
-#define XEN_ARGIFY_2(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED; \
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg2 = XEN_CAR(args);} \
- return(InName(arg1, arg2)); \
- }
-
-#define XEN_ARGIFY_3(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED, arg3 = XEN_UNDEFINED;\
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg3 = XEN_CAR(args);}} \
- return(InName(arg1, arg2, arg3)); \
- }
-
-#define XEN_ARGIFY_4(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED, arg3 = XEN_UNDEFINED, arg4 = XEN_UNDEFINED; \
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg4 = XEN_CAR(args);}}} \
- return(InName(arg1, arg2, arg3, arg4)); \
- }
-
-#define XEN_ARGIFY_5(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED, arg3 = XEN_UNDEFINED, arg4 = XEN_UNDEFINED, arg5 = XEN_UNDEFINED; \
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg5 = XEN_CAR(args);}}}} \
- return(InName(arg1, arg2, arg3, arg4, arg5)); \
- }
-
-#define XEN_ARGIFY_6(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED, arg3 = XEN_UNDEFINED, arg4 = XEN_UNDEFINED, arg5 = XEN_UNDEFINED, arg6 = XEN_UNDEFINED; \
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg6 = XEN_CAR(args);}}}}} \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6)); \
- }
-
-#define XEN_ARGIFY_7(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED, arg3 = XEN_UNDEFINED, arg4 = XEN_UNDEFINED, arg5 = XEN_UNDEFINED; \
- XEN arg6 = XEN_UNDEFINED, arg7 = XEN_UNDEFINED; \
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg6 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg7 = XEN_CAR(args);}}}}}} \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6, arg7)); \
- }
-
-#define XEN_ARGIFY_8(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED, arg3 = XEN_UNDEFINED, arg4 = XEN_UNDEFINED, arg5 = XEN_UNDEFINED; \
- XEN arg6 = XEN_UNDEFINED, arg7 = XEN_UNDEFINED, arg8 = XEN_UNDEFINED;\
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg6 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg7 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg8 = XEN_CAR(args);}}}}}}} \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)); \
- }
-
-#define XEN_ARGIFY_9(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED, arg3 = XEN_UNDEFINED, arg4 = XEN_UNDEFINED, arg5 = XEN_UNDEFINED; \
- XEN arg6 = XEN_UNDEFINED, arg7 = XEN_UNDEFINED, arg8 = XEN_UNDEFINED, arg9 = XEN_UNDEFINED; \
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg6 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg7 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg8 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg9 = XEN_CAR(args);}}}}}}}} \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9)); \
- }
-
-#define XEN_ARGIFY_10(OutName, InName) \
- static s7_pointer OutName(s7_scheme *sc, s7_pointer args) \
- { \
- XEN arg1 = XEN_UNDEFINED, arg2 = XEN_UNDEFINED, arg3 = XEN_UNDEFINED, arg4 = XEN_UNDEFINED, arg5 = XEN_UNDEFINED; \
- XEN arg6 = XEN_UNDEFINED, arg7 = XEN_UNDEFINED, arg8 = XEN_UNDEFINED, arg9 = XEN_UNDEFINED, arg10 = XEN_UNDEFINED; \
- if (args != xen_nil) {arg1 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg2 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg3 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg4 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg5 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg6 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg7 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg8 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) {arg9 = XEN_CAR(args); args = XEN_CDR(args); \
- if (args != xen_nil) arg10 = XEN_CAR(args);}}}}}}}}} \
- return(InName(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10)); \
- }
-
+#define XEN_NARGIFY_2(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_2(s7, args, InName));}
+#define XEN_NARGIFY_3(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_3(s7, args, InName));}
+#define XEN_NARGIFY_4(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_4(s7, args, InName));}
+#define XEN_NARGIFY_5(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_5(s7, args, InName));}
+#define XEN_NARGIFY_6(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_6(s7, args, InName));}
+#define XEN_NARGIFY_7(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_7(s7, args, InName));}
+#define XEN_NARGIFY_8(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_8(s7, args, InName));}
+#define XEN_NARGIFY_9(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_9(s7, args, InName));}
+
+#define XEN_ARGIFY_1(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_1(s7, args, InName));}
+#define XEN_ARGIFY_2(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_2(s7, args, InName));}
+#define XEN_ARGIFY_3(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_3(s7, args, InName));}
+#define XEN_ARGIFY_4(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_4(s7, args, InName));}
+#define XEN_ARGIFY_5(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_5(s7, args, InName));}
+#define XEN_ARGIFY_6(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_6(s7, args, InName));}
+#define XEN_ARGIFY_7(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_7(s7, args, InName));}
+#define XEN_ARGIFY_8(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_8(s7, args, InName));}
+#define XEN_ARGIFY_9(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(s7_apply_n_9(s7, args, InName));}
#define XEN_VARGIFY(OutName, InName) static s7_pointer OutName(s7_scheme *sc, s7_pointer args) {return(InName(args));}
#define XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) s7_define_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc)
+#define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) s7_define_safe_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc)
#define XEN_DEFINE_PROCEDURE_STAR(Name, Func, Args, Doc) s7_define_function_star(s7, Name, Func, Args, Doc)
#define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \
- s7_define_variable(s7, Get_Name, s7_make_procedure_with_setter(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Set_Func, Set_Req, Set_Opt, Get_Help))
+ s7_dilambda(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Set_Func, Set_Req, Set_Opt, Get_Help)
-#define XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Rev_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \
- s7_define_variable(s7, Get_Name, s7_make_procedure_with_setter(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Rev_Func, Set_Req, Set_Opt, Get_Help)); \
- xen_s7_ignore(Set_Func)
-
-#define XEN_ARITY(Func) s7_procedure_arity(s7, Func)
+#define XEN_ARITY(Func) s7_arity(s7, Func)
#define XEN_REQUIRED_ARGS(Func) XEN_TO_C_INT(XEN_CAR(XEN_ARITY(Func)))
-#define XEN_REQUIRED_ARGS_OK(Func, Args) (XEN_REQUIRED_ARGS(Func) == Args)
+#define XEN_REQUIRED_ARGS_OK(Func, Args) s7_is_aritable(s7, Func, Args) /* (XEN_REQUIRED_ARGS(Func) == Args) */
#define XEN_CALL_0(Func, Caller) s7_call_with_location(s7, Func, XEN_EMPTY_LIST, Caller, __FILE__, __LINE__) /* these need a catch */
#define XEN_CALL_1(Func, Arg1, Caller) s7_call_with_location(s7, Func, XEN_LIST_1(Arg1), Caller, __FILE__, __LINE__)
@@ -1411,73 +1182,60 @@ extern XEN xen_false, xen_true, xen_nil, xen_undefined, xen_zero;
#define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) s7_call_with_location(s7, Func, XEN_LIST_5(Arg1, Arg2, Arg3, Arg4, Arg5), Caller, __FILE__, __LINE__)
#define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) s7_call_with_location(s7, Func, XEN_LIST_6(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6), Caller, __FILE__, __LINE__)
#define XEN_APPLY(Func, Args, Caller) s7_call_with_location(s7, Func, Args, Caller, __FILE__, __LINE__)
-#define XEN_APPLY_ARG_LIST_END XEN_EMPTY_LIST
-#define XEN_CALL_0_NO_CATCH(Func) s7_call_with_location(s7, Func, XEN_EMPTY_LIST, c__FUNCTION__, __FILE__, __LINE__)
-#define XEN_CALL_1_NO_CATCH(Func, Arg1) s7_call_with_location(s7, Func, XEN_LIST_1(Arg1), c__FUNCTION__, __FILE__, __LINE__)
-#define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) s7_call_with_location(s7, Func, XEN_LIST_2(Arg1, Arg2), c__FUNCTION__, __FILE__, __LINE__)
-#define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) s7_call_with_location(s7, Func, XEN_LIST_3(Arg1, Arg2, Arg3), c__FUNCTION__, __FILE__, __LINE__)
-#define XEN_APPLY_NO_CATCH(Func, Args) s7_call_with_location(s7, Func, Args, c__FUNCTION__, __FILE__, __LINE__)
+#define XEN_CALL_0_NO_CATCH(Func) s7_call_with_location(s7, Func, XEN_EMPTY_LIST, __func__, __FILE__, __LINE__)
+#define XEN_CALL_1_NO_CATCH(Func, Arg1) s7_call_with_location(s7, Func, XEN_LIST_1(Arg1), __func__, __FILE__, __LINE__)
+#define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) s7_call_with_location(s7, Func, XEN_LIST_2(Arg1, Arg2), __func__, __FILE__, __LINE__)
+#define XEN_CALL_3_NO_CATCH(Func, Arg1, Arg2, Arg3) s7_call_with_location(s7, Func, XEN_LIST_3(Arg1, Arg2, Arg3), __func__, __FILE__, __LINE__)
+#define XEN_APPLY_NO_CATCH(Func, Args) s7_call_with_location(s7, Func, Args, __func__, __FILE__, __LINE__)
typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data);
-#define XEN_DEFINE_CONSTANT(Name, Value, Help) xen_s7_define_constant(s7, Name, s7_make_integer(s7, Value), Help)
+#define XEN_DEFINE_CONSTANT(Name, Value, Help) s7_define_constant_with_documentation(s7, Name, s7_make_integer(s7, Value), Help)
#define XEN_DEFINE(Name, Value) s7_define_variable(s7, Name, Value)
#define XEN_DEFINED_P(Name) s7_is_defined(s7, Name)
-#define XEN_DEFINE_VARIABLE(Name, Var, Value) Var = xen_define_variable(Name, Value)
+#define XEN_DEFINE_VARIABLE(Name, Var, Value) Var = s7_define_variable(s7, Name, Value)
#define XEN_VARIABLE_SET(Var, Val) s7_symbol_set_value(s7, Var, Val)
#define XEN_VARIABLE_REF(Var) s7_symbol_value(s7, Var)
#define XEN_NAME_AS_C_STRING_TO_VARIABLE(a) s7_make_symbol(s7, a)
#define XEN_MARK_OBJECT_TYPE void
-#define XEN_MAKE_OBJECT_TYPE(Name, Print, Free, Equal, Gc_Mark, Apply, Set, Length, Copy, Fill) \
- s7_new_type_x(Name, Print, Free, Equal, Gc_Mark, Apply, Set, Length, Copy, Fill)
+#define XEN_MAKE_OBJECT_TYPE(Name, Print, Free, Equal, Gc_Mark, Apply, Set, Length, Copy, Reverse, Fill) \
+ s7_new_type_x(Name, Print, Free, Equal, Gc_Mark, Apply, Set, Length, Copy, Reverse, Fill)
#define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) \
static void Wrapped_Free(void *obj) {Original_Free((Type *)obj);}
#define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) \
static char *Wrapped_Print(s7_scheme *sc, void *obj) {return(Original_Print((Type *)obj));}
#define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, ig1, ig2) return(s7_make_object(s7, Tag, Val))
+#define XEN_MAKE_OBJECT(Tag, Val, ig1, ig2) s7_make_object(s7, Tag, Val)
#define XEN_OBJECT_REF(Arg) s7_object_value(Arg)
#define XEN_OBJECT_TYPE int /* tag type */
#define XEN_OBJECT_TYPE_P(Obj, Tag) (s7_object_type(Obj) == Tag)
-#define XEN_HOOK_P(Arg) s7_is_hook(Arg)
-#define XEN_DEFINE_HOOK(Name, Arity, Help) xen_s7_define_hook(Name, s7_make_hook(s7, Arity, 0, false, Help))
+#define XEN_HOOK_P(Arg) ((Arg) != XEN_FALSE)
+#define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) s7_define_constant_with_documentation(s7, Name, s7_eval_c_string(s7, Descr), Help)
/* "simple hooks are for channel-local hooks (unnamed, accessed through the channel) */
-#define XEN_DEFINE_SIMPLE_HOOK(Arity) s7_make_hook(s7, Arity, 0, false, NULL)
-#define XEN_HOOKED(Hook) s7_is_pair(s7_hook_functions(Hook))
-#define XEN_CLEAR_HOOK(Hook) s7_hook_set_functions(Hook, s7_nil(s7))
-#define XEN_HOOK_PROCEDURES(Hook) s7_hook_functions(Hook)
-#define XEN_ADD_HOOK(Hook, Func, Name, Doc) s7_hook_set_functions(Hook, s7_cons(s7, s7_make_function(s7, Name, Func, (int)s7_integer(s7_car(s7_hook_arity(Hook))), 0, false, Doc), s7_hook_functions(Hook)))
+#define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) s7_eval_c_string(s7, Descr)
+#define XEN_HOOKED(Hook) s7_is_pair(s7_hook_functions(s7, Hook))
+#define XEN_CLEAR_HOOK(Hook) s7_hook_set_functions(s7, Hook, s7_nil(s7))
+#define XEN_HOOK_PROCEDURES(Hook) s7_hook_functions(s7, Hook)
+#define XEN_ADD_HOOK(Hook, Func, Name, Doc) s7_hook_set_functions(s7, Hook, s7_cons(s7, s7_make_function(s7, Name, Func, 1, 0, false, Doc), s7_hook_functions(s7, Hook)))
#ifdef __cplusplus
extern "C" {
#endif
-XEN xen_define_variable(const char *name, XEN value);
-XEN xen_s7_define_hook(const char *name, XEN value);
-void xen_s7_ignore(s7_function func); /* squelch compiler warnings */
-const char *xen_s7_object_help(XEN sym);
-int xen_to_c_int(XEN a);
-int64_t xen_to_c_int64_t(XEN a);
-double xen_to_c_double_or_else(XEN a, double b);
s7_scheme *s7_xen_initialize(s7_scheme *sc);
void xen_s7_set_repl_prompt(const char *new_prompt);
-void xen_s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value, const char *help);
-const char *xen_s7_constant_help(const char *name);
XEN xen_set_assoc(s7_scheme *sc, s7_pointer key, s7_pointer val, s7_pointer alist);
XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
-#if !(defined(__GNUC__) && (!(defined(__cplusplus))))
- XEN xen_s7_c_to_xen_string(const char *str);
-#endif
-
#ifdef __cplusplus
}
#endif
#endif
-/* end S7 */
+/* end s7 */
@@ -1503,8 +1261,6 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_EMPTY_LIST 0
#define XEN_UNDEFINED 0
#define XEN_EQ_P(a, b) 0
-#define XEN_EQV_P(a, b) 0
-#define XEN_EQUAL_P(a, b) 0
#define XEN_CONS_P(Arg) 0
#define XEN_CONS(Arg1, Arg2) 0
#define XEN_CONS_2(Arg1, Arg2, Arg3) 0
@@ -1515,6 +1271,7 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_CADDDR(a) 0
#define XEN_CDR(a) 0
#define XEN_CDDR(a) 0
+#define XEN_CDDDR(a) 0
#define XEN_LIST_P(Arg) 0
#define XEN_LIST_P_WITH_LENGTH(Arg, Len) 0
#define XEN_LIST_LENGTH(Arg) 0
@@ -1540,16 +1297,15 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define C_STRING_TO_XEN_SYMBOL(a) 0
#define XEN_ZERO 0
#define XEN_NUMBER_P(Arg) 0
-#define XEN_OFF_T_P(Arg) 0
-#define XEN_INT64_T_P(Arg) 0
#define XEN_DOUBLE_P(Arg) 0
#define XEN_TO_C_DOUBLE(a) 0.0
-#define XEN_TO_C_DOUBLE_OR_ELSE(a, b) b
#define C_TO_XEN_DOUBLE(a) 0
#define XEN_INTEGER_P(Arg) 0
#define C_TO_XEN_INT(a) a
#define XEN_TO_C_INT(a) 0
-#define XEN_TO_C_INT_OR_ELSE(a, b) b
+#define XEN_COMPLEX_P(Arg) 0
+#define XEN_TO_C_COMPLEX(a) 0.0
+#define C_TO_XEN_COMPLEX(a) a
#define XEN_ULONG_P(Arg) 0
#define XEN_TO_C_ULONG(a) 0
#define C_TO_XEN_ULONG(a) 0
@@ -1558,16 +1314,12 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_ULONG_LONG_P(Arg) 0
#define XEN_TO_C_ULONG_LONG(Arg) 0
#define C_TO_XEN_ULONG_LONG(Arg) 0
-#define XEN_EXACT_P(Arg) 0
-#define C_STRING_TO_XEN_FORM(Str) 0
-#define XEN_EVAL_FORM(Form) 0
+#define XEN_WRAPPED_C_POINTER_P(Arg) 0
#define XEN_EVAL_C_STRING(Arg) 0
#define XEN_SYMBOL_TO_C_STRING(a) "(not a symbol)"
#define XEN_TO_STRING(Obj) "(unknown)"
#define XEN_PROCEDURE_P(Arg) 0
-#define XEN_PROCEDURE_SOURCE(Func) 0
-/* error checking ... */
#define XEN_ARGIFY_1(OutName, InName) static int OutName(void) {return(-1);}
#define XEN_ARGIFY_2(OutName, InName) static int OutName(void) {return(-2);}
#define XEN_ARGIFY_3(OutName, InName) static int OutName(void) {return(-3);}
@@ -1577,7 +1329,6 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_ARGIFY_7(OutName, InName) static int OutName(void) {return(-7);}
#define XEN_ARGIFY_8(OutName, InName) static int OutName(void) {return(-8);}
#define XEN_ARGIFY_9(OutName, InName) static int OutName(void) {return(-9);}
-#define XEN_ARGIFY_10(OutName, InName) static int OutName(void) {return(-10);}
#define XEN_NARGIFY_0(OutName, InName) static int OutName(void) {return(0);}
#define XEN_NARGIFY_1(OutName, InName) static int OutName(void) {return(1);}
@@ -1598,8 +1349,7 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_DEFINE_PROCEDURE_WITH_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \
{xen_no_ext_lang_check_args(Get_Name, Get_Func(), Get_Req, Get_Opt, 0); xen_no_ext_lang_check_args(Set_Name, Set_Func(), Set_Req, Set_Opt, 0);}
-#define XEN_DEFINE_PROCEDURE_WITH_REVERSED_SETTER(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Rev_Func, Get_Req, Get_Opt, Set_Req, Set_Opt) \
- {xen_no_ext_lang_check_args(Get_Name, Get_Func(), Get_Req, Get_Opt, 0); xen_no_ext_lang_check_args(Set_Name, Set_Func(), Set_Req, Set_Opt, 0);}
+#define XEN_DEFINE_SAFE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc) XEN_DEFINE_PROCEDURE(Name, Func, ReqArg, OptArg, RstArg, Doc)
#define XEN_ARITY(Func) 0
#define XEN_REQUIRED_ARGS(Func) 0
@@ -1612,7 +1362,6 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_CALL_5(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Caller) 0
#define XEN_CALL_6(Func, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Caller) 0
#define XEN_APPLY(Func, Args, Caller) 0
-#define XEN_APPLY_ARG_LIST_END 0
#define XEN_CALL_0_NO_CATCH(Func) 0
#define XEN_CALL_1_NO_CATCH(Func, Arg1) 0
#define XEN_CALL_2_NO_CATCH(Func, Arg1, Arg2) 0
@@ -1628,14 +1377,15 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print)
#define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free)
#define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, ig1, ig2) return(0)
+#define XEN_MAKE_OBJECT(Tag, Val, ig1, ig2) 0
#define XEN_OBJECT_REF(a) 0
#define XEN_OBJECT_TYPE int
#define XEN_OBJECT_TYPE_P(OBJ, TAG) 0
#define XEN_SYMBOL_P(Arg) 0
#define XEN_HOOK_P(Arg) 0
#define XEN_HOOKED(a) 0
-#define XEN_DEFINE_HOOK(Name, Arity, Help) 0
-#define XEN_DEFINE_SIMPLE_HOOK(Arity) 0
+#define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) 0
+#define XEN_DEFINE_SIMPLE_HOOK(Descr, Arity) 0
#define XEN_CLEAR_HOOK(Arg)
#define XEN_HOOK_PROCEDURES(a) 0
#define XEN_ADD_HOOK(Hook, Func, Name, Doc)
@@ -1653,12 +1403,11 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_KEYWORD_P(Obj) 0
#define XEN_KEYWORD_EQ_P(k1, k2) 0
#define XEN_MAKE_KEYWORD(Arg) 0
-#define XEN_YES_WE_HAVE(Feature)
+#define XEN_PROVIDE(Feature)
#define XEN_DOCUMENTATION_SYMBOL 0
#define XEN_OBJECT_HELP(Name) 0
#define XEN_PROTECT_FROM_GC(a) 0
#define XEN_LOAD_FILE(a) 0
-#define XEN_LOAD_FILE_WITH_PATH(a) 0
#define XEN_LOAD_PATH XEN_FALSE
#define XEN_ADD_TO_LOAD_PATH(Path) XEN_FALSE
#define XEN_ERROR_TYPE(Typ) XEN_FALSE
@@ -1668,6 +1417,7 @@ XEN xen_assoc(s7_scheme *sc, XEN key, XEN alist);
#define XEN_WRONG_TYPE_ARG_ERROR(Caller, ArgN, Arg, Descr)
#define XEN_OUT_OF_RANGE_ERROR(Caller, ArgN, Arg, Descr)
typedef XEN (*XEN_CATCH_BODY_TYPE) (void *data);
+#define XEN_UNPROTECT_FROM_GC(Var) 0
#ifdef __cplusplus
extern "C" {
@@ -1692,8 +1442,6 @@ void xen_no_ext_lang_check_args(const char *name, int args, int req_args, int op
#if defined(__GNUC__) && (!(defined(__cplusplus)))
#define XEN_BOOLEAN_IF_BOUND_P(Arg) ({ XEN _xen_h_14_ = Arg; ((XEN_BOOLEAN_P(_xen_h_14_)) || (XEN_NOT_BOUND_P(_xen_h_14_))); })
#define XEN_INTEGER_IF_BOUND_P(Arg) ({ XEN _xen_h_15_ = Arg; ((XEN_NOT_BOUND_P(_xen_h_15_)) || (XEN_INTEGER_P(_xen_h_15_))); })
- #define XEN_OFF_T_IF_BOUND_P(Arg) ({ XEN _xen_h_15_ = Arg; ((XEN_NOT_BOUND_P(_xen_h_15_)) || (XEN_OFF_T_P(_xen_h_15_))); })
- #define XEN_INT64_T_IF_BOUND_P(Arg) ({ XEN _xen_h_15_ = Arg; ((XEN_NOT_BOUND_P(_xen_h_15_)) || (XEN_INT64_T_P(_xen_h_15_))); })
#define XEN_NUMBER_IF_BOUND_P(Arg) ({ XEN _xen_h_16_ = Arg; ((XEN_NOT_BOUND_P(_xen_h_16_)) || (XEN_NUMBER_P(_xen_h_16_))); })
#define XEN_STRING_IF_BOUND_P(Arg) ({ XEN _xen_h_17_ = Arg; ((XEN_NOT_BOUND_P(_xen_h_17_)) || (XEN_STRING_P(_xen_h_17_))); })
#define XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(Arg) ({ XEN _xen_h_18_ = Arg; ((XEN_BOOLEAN_P(_xen_h_18_)) || (XEN_NOT_BOUND_P(_xen_h_18_)) || (XEN_INTEGER_P(_xen_h_18_))); })
@@ -1701,34 +1449,20 @@ void xen_no_ext_lang_check_args(const char *name, int args, int req_args, int op
#else
#define XEN_BOOLEAN_IF_BOUND_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_NOT_BOUND_P(Arg)))
#define XEN_INTEGER_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_INTEGER_P(Arg)))
- #define XEN_OFF_T_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_OFF_T_P(Arg)))
- #define XEN_INT64_T_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_INT64_T_P(Arg)))
#define XEN_NUMBER_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_NUMBER_P(Arg)))
#define XEN_STRING_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_STRING_P(Arg)))
#define XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_NOT_BOUND_P(Arg)) || (XEN_INTEGER_P(Arg)))
#define XEN_INTEGER_OR_BOOLEAN_P(Arg) ((XEN_BOOLEAN_P(Arg)) || (XEN_INTEGER_P(Arg)))
#endif
-#define XEN_ONLY_ARG 1
-
-#define XEN_ARG_1 1
-#define XEN_ARG_2 2
-#define XEN_ARG_3 3
-#define XEN_ARG_4 4
-#define XEN_ARG_5 5
-#define XEN_ARG_6 6
-#define XEN_ARG_7 7
-#define XEN_ARG_8 8
-#define XEN_ARG_9 9
-#define XEN_ARG_10 10
+#if (!HAVE_FORTH)
+#define XEN_LONG_LONG_P(Arg) XEN_INTEGER_P(Arg)
+#else
+#define XEN_LONG_LONG_P(Arg) FTH_LONG_LONG_P(Arg)
+#endif
+#define XEN_LONG_LONG_IF_BOUND_P(Arg) ((XEN_NOT_BOUND_P(Arg)) || (XEN_LONG_LONG_P(Arg)))
#if (!HAVE_SCHEME)
- #define XEN_TO_C_OFF_T_OR_ELSE(a, b) xen_to_c_off_t_or_else(a, b)
- #define XEN_TO_C_INT64_T_OR_ELSE(a, b) xen_to_c_int64_t_or_else(a, b)
- #define C_TO_XEN_OFF_T(a) c_to_xen_off_t(a)
- #define C_TO_XEN_INT64_T(a) C_TO_XEN_LONG_LONG(a)
- #define XEN_TO_C_OFF_T(a) xen_to_c_off_t(a)
- #define XEN_TO_C_INT64_T(a) xen_to_c_int64_t(a)
#define XEN_AS_STRING(form) XEN_TO_C_STRING(XEN_TO_STRING(form))
#define XEN_VECTOR_RANK(Vect) 1
#else
@@ -1757,35 +1491,225 @@ void xen_no_ext_lang_check_args(const char *name, int args, int req_args, int op
#if HAVE_SCHEME
#define XEN_WRAP_C_POINTER(a) s7_make_c_pointer(s7, (void *)(a))
#define XEN_UNWRAP_C_POINTER(a) s7_c_pointer(a)
- #define XEN_WRAPPED_C_POINTER_P(a) s7_is_c_pointer(a)
#else
-
- #if (SIZEOF_VOID_P == SIZEOF_UNSIGNED_LONG)
- #define XEN_WRAP_C_POINTER(a) ((XEN)(C_TO_XEN_ULONG((unsigned long)a)))
+ #if (SIZEOF_VOID_P == 4)
+ #define XEN_WRAP_C_POINTER(a) ((XEN)(C_TO_XEN_ULONG((unsigned int)a)))
#define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_ULONG(a)
#else
- #define XEN_WRAP_C_POINTER(a) C_TO_XEN_INT64_T((int64_t)(a))
- #define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_INT64_T(a)
+ #define XEN_WRAP_C_POINTER(a) C_TO_XEN_ULONG_LONG((unsigned long long int)(a))
+ #define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_ULONG_LONG(a)
#endif
+#endif
+
+
+/* Feb-14: the upper case macro names and the old-fashioned _p names are ugly and hard to read -- start replacing them
+ */
+
+#define Xen_is_number(Arg) XEN_NUMBER_P(Arg)
+#define Xen_is_integer(Arg) XEN_INTEGER_P(Arg)
+#define Xen_is_llong(Arg) XEN_LONG_LONG_P(Arg)
+#define Xen_is_keyword(Arg) XEN_KEYWORD_P(Arg)
+#define Xen_is_true(Arg) XEN_TRUE_P(Arg)
+#define Xen_is_false(Arg) XEN_FALSE_P(Arg)
+#define Xen_is_bound(Arg) XEN_BOUND_P(Arg)
+#define Xen_is_boolean(Arg) XEN_BOOLEAN_P(Arg)
+#define Xen_is_null(Arg) XEN_NULL_P(Arg)
+#define Xen_is_eq(Arg1, Arg2) XEN_EQ_P(Arg1, Arg2)
+#define Xen_is_cons(Arg) XEN_CONS_P(Arg)
+#define Xen_is_pair(Arg) XEN_PAIR_P(Arg)
+#define Xen_is_list(Arg) XEN_LIST_P(Arg)
+#define Xen_is_string(Arg) XEN_STRING_P(Arg)
+#define Xen_is_double(Arg) XEN_DOUBLE_P(Arg)
+#define Xen_is_complex(Arg) XEN_COMPLEX_P(Arg)
+#define Xen_is_ulong(Arg) XEN_ULONG_P(Arg)
+#define Xen_is_ullong(Arg) XEN_ULONG_LONG_P(Arg)
+#define Xen_is_wrapped_c_pointer(Arg) XEN_WRAPPED_C_POINTER_P(Arg)
+#define Xen_is_procedure(Arg) XEN_PROCEDURE_P(Arg)
+#define Xen_c_object_is_type(Obj, Tag) XEN_OBJECT_TYPE_P(Obj, Tag)
+#define Xen_is_symbol(Arg) XEN_SYMBOL_P(Arg)
+#define Xen_is_hook(Arg) XEN_HOOK_P(Arg)
+#define Xen_is_vector(Arg) XEN_VECTOR_P(Arg)
+#define Xen_is_char(Arg) XEN_CHAR_P(Arg)
+#define Xen_keyword_is_eq(Arg1, Arg2) XEN_KEYWORD_EQ_P(Arg1, Arg2)
+#define Xen_is_defined(Arg) XEN_DEFINED_P(Arg)
+#define Xen_is_ratio(Arg) XEN_RATIO_P(Arg)
+
+#define Xen_is_llong_or_unbound(Arg) XEN_LONG_LONG_IF_BOUND_P(Arg)
+#define Xen_is_boolean_or_unbound(Arg) XEN_BOOLEAN_IF_BOUND_P(Arg)
+#define Xen_is_integer_or_unbound(Arg) XEN_INTEGER_IF_BOUND_P(Arg)
+#define Xen_is_number_or_unbound(Arg) XEN_NUMBER_IF_BOUND_P(Arg)
+#define Xen_is_string_or_unbound(Arg) XEN_STRING_IF_BOUND_P(Arg)
+#define Xen_is_integer_boolean_or_unbound(Arg) XEN_INTEGER_OR_BOOLEAN_IF_BOUND_P(Arg)
+#define Xen_is_integer_or_boolean(Arg) XEN_INTEGER_OR_BOOLEAN_P(Arg)
+
+#define Xen_append(a, b) XEN_APPEND(a, b)
+#define Xen_cadddr(a) XEN_CADDDR(a)
+#define Xen_caddr(a) XEN_CADDR(a)
+#define Xen_cadr(a) XEN_CADR(a)
+#define Xen_car(a) XEN_CAR(a)
+#define Xen_cddr(a) XEN_CDDR(a)
+#define Xen_cdddr(a) XEN_CDDDR(a)
+#define Xen_cdr(a) XEN_CDR(a)
+#define Xen_cons(a, b) XEN_CONS(a, b)
+#define Xen_cons_2(a, b, c) XEN_CONS_2(a, b, c)
+#define Xen_list_1(a) XEN_LIST_1(a)
+#define Xen_list_2(a, b) XEN_LIST_2(a, b)
+#define Xen_list_3(a, b, c) XEN_LIST_3(a, b, c)
+#define Xen_list_4(a, b, c, d) XEN_LIST_4(a, b, c, d)
+#define Xen_list_5(a, b, c, d, e) XEN_LIST_5(a, b, c, d, e)
+#define Xen_list_6(a, b, c, d, e, f) XEN_LIST_6(a, b, c, d, e, f)
+#define Xen_list_7(a, b, c, d, e, f, g) XEN_LIST_7(a, b, c, d, e, f, g)
+#define Xen_list_8(a, b, c, d, e, f, g, h) XEN_LIST_8(a, b, c, d, e, f, g, h)
+#define Xen_list_9(a, b, c, d, e, f, g, h, i) XEN_LIST_9(a, b, c, d, e, f, g, h, i)
+#define Xen_list_length(a) XEN_LIST_LENGTH(a)
+#define Xen_list_ref(a, b) XEN_LIST_REF(a, b)
+#define Xen_list_reverse(a) XEN_LIST_REVERSE(a)
+#define Xen_list_set(a, b, c) XEN_LIST_SET(a, b, c)
+#define Xen_member(a, b) XEN_MEMBER(a, b)
+#define Xen_make_keyword(a) XEN_MAKE_KEYWORD(a)
+#define Xen_make_vector(a, b) XEN_MAKE_VECTOR(a, b)
+#define Xen_throw(a) XEN_THROW(a)
+#define Xen_vector_length(a) XEN_VECTOR_LENGTH(a)
+#define Xen_vector_ref(a, b) XEN_VECTOR_REF(a, b)
+#define Xen_vector_set(a, b, c) XEN_VECTOR_SET(a, b, c)
+#define Xen_vector_to_Xen_list(a) XEN_VECTOR_TO_LIST(a)
+#define C_bool_to_Xen_boolean(a) C_TO_XEN_BOOLEAN(a)
+#define C_char_to_Xen_char(a) C_TO_XEN_CHAR(a)
+#define C_complex_to_Xen_complex(a) C_TO_XEN_COMPLEX(a)
+#define C_double_to_Xen_real(a) C_TO_XEN_DOUBLE(a)
+#define C_int_to_Xen_integer(a) C_TO_XEN_INT(a)
+#define C_llong_to_Xen_llong(a) C_TO_XEN_LONG_LONG(a)
+#define C_string_to_Xen_string(a) C_TO_XEN_STRING(a)
+#define C_string_to_Xen_string_with_length(a, b) C_TO_XEN_STRINGN(a, b)
+#define C_string_to_Xen_symbol(a) C_STRING_TO_XEN_SYMBOL(a)
+#define C_ulong_to_Xen_ulong(a) C_TO_XEN_ULONG(a)
+#define C_ullong_to_Xen_ullong(a) C_TO_XEN_ULONG_LONG(a)
+#define Xen_boolean_to_C_bool(a) XEN_TO_C_BOOLEAN(a)
+#define Xen_char_to_C_char(a) XEN_TO_C_CHAR(a)
+#define Xen_complex_to_C_complex(a) XEN_TO_C_COMPLEX(a)
+#define Xen_real_to_C_double(a) XEN_TO_C_DOUBLE(a)
+#define Xen_integer_to_C_int(a) XEN_TO_C_INT(a)
+#define Xen_llong_to_C_llong(a) XEN_TO_C_LONG_LONG(a)
+#define Xen_string_to_C_string(a) XEN_TO_C_STRING(a)
+#define Xen_symbol_to_C_string(a) XEN_SYMBOL_TO_C_STRING(a)
+#define C_string_to_Xen_value(a) XEN_NAME_AS_C_STRING_TO_VALUE(a)
+#define Xen_ulong_to_C_ulong(a) XEN_TO_C_ULONG(a)
+#define Xen_ullong_to_C_ullong(a) XEN_TO_C_ULONG_LONG(a)
+#define Xen_wrap_C_pointer(a) XEN_WRAP_C_POINTER(a)
+#define Xen_unwrap_C_pointer(a) XEN_UNWRAP_C_POINTER(a)
+#define Xen_numerator(a) XEN_NUMERATOR(a)
+#define Xen_denominator(a) XEN_DENOMINATOR(a)
+#define Xen_rationalize(a, b) XEN_RATIONALIZE(a, b)
+#define Xen_make_ratio(a, b) XEN_MAKE_RATIO(a, b)
+#define Xen_load(a) XEN_LOAD_FILE(a)
+#define Xen_documentation(a) XEN_OBJECT_HELP(a)
+#define Xen_vector_rank(a) XEN_VECTOR_RANK(a)
+#define Xen_wrap_no_args(a, b) XEN_NARGIFY_0(a, b)
+#define Xen_wrap_1_arg(a, b) XEN_NARGIFY_1(a, b)
+#define Xen_wrap_2_args(a, b) XEN_NARGIFY_2(a, b)
+#define Xen_wrap_3_args(a, b) XEN_NARGIFY_3(a, b)
+#define Xen_wrap_4_args(a, b) XEN_NARGIFY_4(a, b)
+#define Xen_wrap_5_args(a, b) XEN_NARGIFY_5(a, b)
+#define Xen_wrap_6_args(a, b) XEN_NARGIFY_6(a, b)
+#define Xen_wrap_7_args(a, b) XEN_NARGIFY_7(a, b)
+#define Xen_wrap_8_args(a, b) XEN_NARGIFY_8(a, b)
+#define Xen_wrap_9_args(a, b) XEN_NARGIFY_9(a, b)
+#define Xen_wrap_1_optional_arg(a, b) XEN_ARGIFY_1(a, b)
+#define Xen_wrap_2_optional_args(a, b) XEN_ARGIFY_2(a, b)
+#define Xen_wrap_3_optional_args(a, b) XEN_ARGIFY_3(a, b)
+#define Xen_wrap_4_optional_args(a, b) XEN_ARGIFY_4(a, b)
+#define Xen_wrap_5_optional_args(a, b) XEN_ARGIFY_5(a, b)
+#define Xen_wrap_6_optional_args(a, b) XEN_ARGIFY_6(a, b)
+#define Xen_wrap_7_optional_args(a, b) XEN_ARGIFY_7(a, b)
+#define Xen_wrap_8_optional_args(a, b) XEN_ARGIFY_8(a, b)
+#define Xen_wrap_9_optional_args(a, b) XEN_ARGIFY_9(a, b)
+#define Xen_wrap_any_args(a, b) XEN_VARGIFY(a, b)
+#define Xen_apply(a, b, c) XEN_APPLY(a, b, c)
+#define Xen_unprotected_apply(a, b) XEN_APPLY_NO_CATCH(a, b)
+#define Xen_eval_C_string(a) XEN_EVAL_C_STRING(a)
+#define Xen_error(a, b) XEN_ERROR(a, b)
+#define Xen_call_with_no_args(a, b) XEN_CALL_0(a, b)
+#define Xen_call_with_1_arg(a, b, c) XEN_CALL_1(a, b, c)
+#define Xen_call_with_2_args(a, b, c, d) XEN_CALL_2(a, b, c, d)
+#define Xen_call_with_3_args(a, b, c, d, e) XEN_CALL_3(a, b, c, d, e)
+#define Xen_call_with_4_args(a, b, c, d, e, f) XEN_CALL_4(a, b, c, d, e, f)
+#define Xen_call_with_5_args(a, b, c, d, e, f, g) XEN_CALL_5(a, b, c, d, e, f, g)
+#define Xen_call_with_6_args(a, b, c, d, e, f, g, h) XEN_CALL_6(a, b, c, d, e, f, g, h)
+#define Xen_unprotected_call_with_no_args(a) XEN_CALL_0_NO_CATCH(a)
+#define Xen_unprotected_call_with_1_arg(a, b) XEN_CALL_1_NO_CATCH(a, b)
+#define Xen_unprotected_call_with_2_args(a, b, c) XEN_CALL_2_NO_CATCH(a, b, c)
+#define Xen_unprotected_call_with_3_args(a, b, c, d) XEN_CALL_3_NO_CATCH(a, b, c, d)
+#define Xen_define(a, b) XEN_DEFINE(a, b)
+#define Xen_define_constant(a, b, c) XEN_DEFINE_CONSTANT(a, b, c)
+#define Xen_define_hook(a, b, c, d) XEN_DEFINE_HOOK(a, b, c, d)
+#define Xen_define_procedure(a, b, c, d, e, f) XEN_DEFINE_PROCEDURE(a, b, c, d, e, f)
+#define Xen_define_procedure_with_setter(a, b, c, d, e, f, g, h, i) XEN_DEFINE_PROCEDURE_WITH_SETTER(a, b, c, d, e, f, g, h, i)
+#define Xen_define_dilambda(a, b, c, d, e, f, g, h, i) XEN_DEFINE_PROCEDURE_WITH_SETTER(a, b, c, d, e, f, g, h, i)
+#define Xen_define_safe_procedure(a, b, c, d, e, f) XEN_DEFINE_SAFE_PROCEDURE(a, b, c, d, e, f)
+
+#define Xen_define_integer_procedure(a, b, c, d, e, f) XEN_DEFINE_SAFE_PROCEDURE(a, b, c, d, e, f) /*obsolete */
+
+#define Xen_define_simple_hook(a, b) XEN_DEFINE_SIMPLE_HOOK(a, b)
+#define Xen_define_variable(a, b, c) XEN_DEFINE_VARIABLE(a, b, c)
+#define Xen_out_of_range_error(a, b, c, d) XEN_OUT_OF_RANGE_ERROR(a, b, c, d)
+#define Xen_wrong_type_arg_error(a, b, c, d) XEN_WRONG_TYPE_ARG_ERROR(a, b, c, d)
+#define Xen_bad_arity_error(a, b, c, d) XEN_BAD_ARITY_ERROR(a, b, c, d)
+#define Xen_clear_hook_list(a) XEN_CLEAR_HOOK(a)
+#define Xen_hook_has_list(a) XEN_HOOKED(a)
+#define Xen_hook_list(a) XEN_HOOK_PROCEDURES(a)
+#define Xen_add_to_hook_list(a, b, c, d) XEN_ADD_HOOK(a, b, c, d)
+#define Xen_GC_protect(a) XEN_PROTECT_FROM_GC(a)
+#define Xen_GC_unprotect(a) XEN_UNPROTECT_FROM_GC(a)
+#define Xen_provide_feature(a) XEN_PROVIDE(a)
+#define Xen_arity(a) XEN_ARITY(a)
+#define Xen_add_to_load_path(a) XEN_ADD_TO_LOAD_PATH(a)
+#define Xen_check_type(a, b, c, d, e) XEN_ASSERT_TYPE(a, b, c, d, e)
+#define Xen_make_object(a, b, c, d) XEN_MAKE_OBJECT(a, b, c, d)
+#define Xen_variable_ref(a) XEN_VARIABLE_REF(a)
+#define Xen_variable_set(a, b) XEN_VARIABLE_SET(a, b)
+#define Xen_object_ref(a) XEN_OBJECT_REF(a)
+#define Xen_copy_arg(a) XEN_COPY_ARG(a)
+#define Xen_assoc(a, b) XEN_ASSOC(a, b)
+#define Xen_assoc_ref(a, b) XEN_ASSOC_REF(a, b)
+#define Xen_assoc_set(a, b, c) XEN_ASSOC_SET(a, b, c)
+#define Xen_make_error_type(a) XEN_ERROR_TYPE(a)
+#define Xen_required_args(a) XEN_REQUIRED_ARGS(a)
+#define Xen_is_aritable(a, b) XEN_REQUIRED_ARGS_OK(a, b)
+#define Xen_object_to_C_string(a) XEN_AS_STRING(a)
+#define Xen_wrap_free(a, b, c) XEN_MAKE_OBJECT_FREE_PROCEDURE(a, b, c)
+#define Xen_wrap_print(a, b, c) XEN_MAKE_OBJECT_PRINT_PROCEDURE(a, b, c)
+#define Xen_make_object_type(a, b) XEN_MAKE_OBJECT_TYPE(a, b)
+#define Xen_object_mark_t XEN_MARK_OBJECT_TYPE
+#define Xen_object_type_t XEN_OBJECT_TYPE
+#define Xen_catch_t XEN_CATCH_BODY_TYPE
+#define Xen_comment_mark XEN_COMMENT_STRING
+#define Xen_documentation_symbol XEN_DOCUMENTATION_SYMBOL
+#define Xen_empty_list XEN_EMPTY_LIST
+#define Xen_false XEN_FALSE
+#define Xen_true XEN_TRUE
+#define Xen_undefined XEN_UNDEFINED
+#define Xen_integer_zero XEN_ZERO
+#define Xen_file_extension XEN_FILE_EXTENSION
+#define Xen_language XEN_LANGUAGE_NAME
+#define Xen_load_path XEN_LOAD_PATH
+#define Xen_procedure_cast XEN_PROCEDURE_CAST
+#define Xen XEN
- #define XEN_WRAPPED_C_POINTER_P(a) XEN_EXACT_P(a)
+#if HAVE_SCHEME
+#define Xen_define_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) s7_define_typed_function(s7, Name, Func, ReqArg, OptArg, RstArg, Doc, Sig)
+#define Xen_define_typed_dilambda(Get_Name, Get_Func, Get_Help, Set_Name, Set_Func, Get_Req, Get_Opt, Set_Req, Set_Opt, Get_Sig, Set_Sig) \
+ s7_typed_dilambda(s7, Get_Name, Get_Func, Get_Req, Get_Opt, Set_Func, Set_Req, Set_Opt, Get_Help, Get_Sig, Set_Sig)
+#else
+#define Xen_define_typed_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc, Sig) Xen_define_safe_procedure(Name, Func, ReqArg, OptArg, RstArg, Doc)
+#define Xen_define_typed_dilambda(a, b, c, d, e, f, g, h, i, j, k) XEN_DEFINE_PROCEDURE_WITH_SETTER(a, b, c, d, e, f, g, h, i)
#endif
+
#ifdef __cplusplus
extern "C" {
#endif
char *xen_strdup(const char *str);
-
-#if (!HAVE_SCHEME)
- int xen_to_c_int_or_else(XEN obj, int fallback);
- off_t xen_to_c_off_t_or_else(XEN obj, off_t fallback);
- off_t xen_to_c_off_t(XEN obj);
- XEN c_to_xen_off_t(off_t val);
- int64_t xen_to_c_int64_t_or_else(XEN obj, int64_t fallback);
- int64_t xen_to_c_int64_t(XEN obj);
-#endif
-
char *xen_version(void);
void xen_repl(int argc, char **argv);
void xen_initialize(void);
diff --git a/xen.html b/xen.html
deleted file mode 100644
index e0970d2..0000000
--- a/xen.html
+++ /dev/null
@@ -1,82 +0,0 @@
-<html>
-<head>
-<title>Xen</title>
-<style type="text/css">
-<!--
- EM.red {color:red; font-style:normal}
- EM.typing {color:maroon; font-style: normal}
- EM.listener {color:darkblue; font-style: normal}
- EM.tab {font-style: normal; font-size: small; font-family: fixed}
- EM.def {font-weight: bold; font-style: normal}
- H1 {text-align: center}
- UL {list-style-type: none}
-
- A {text-decoration:none}
- A:hover {text-decoration:underline}
- A.quiet {color:black; text-decoration:none}
- A.quiet:hover {text-decoration:underline}
--->
-</style>
-</head>
-<body bgcolor=white>
-
-<table width="100%" border=1><tr><td bgcolor="beige" align="center" valign="middle"><h1>Xen</h1></td></tr></table>
-<br>
-
-<p>The Xen package provides macros and procedures making it possible for the
-same C code to support several different embedded (or extension) languages.
-Currently supported are s7, Ruby, and Forth.
-</p>
-<p>Here's a program that defines a function (named "fnc" in the
-extension language) that takes an integer argument and increments it,
-a variable (named "var" in the extension language) that is initialized
-to 32, a constant (named "twelve") that has the value 12, then places
-you in a read-eval-print loop:
-</p>
-
-<pre>
-#include <stdio.h>
-#include "xen.h"
-
-static XEN orig_function(XEN argument)
-{
- XEN_ASSERT_TYPE(XEN_INTEGER_P(argument), argument, XEN_ONLY_ARG, "fnc", "an integer");
- fprintf(stdout, "argument is %d\n", XEN_TO_C_INT(argument));
- return(C_TO_XEN_INT(XEN_TO_C_INT(argument) + 1));
-}
-
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_1(function, orig_function);
-#else
- #define function orig_function
-#endif
-
-static XEN variable;
-
-int main(int argc, char **argv)
-{
- xen_initialize();
-
- XEN_DEFINE_VARIABLE("var", variable, C_TO_XEN_INT(32));
- XEN_DEFINE_CONSTANT("twelve", 12, "this is 12");
- XEN_DEFINE_PROCEDURE("fnc", function, 1, 0, 0, "this is our function");
-
- fprintf(stdout, "we're running: %s\n", xen_version());
-
- xen_repl(argc, argv);
- return(0);
-}
-</pre>
-
-<p>The "XEN_ARGIFY" step
-is needed for those languages that assume one calling sequence for
-a C-defined function; we have to wrap up the actual call in whatever
-sequence the extension language wants.
-</p>
-<p>Currently constants are assumed to be integers. Type checks are
-handled by macros such as XEN_INTEGER_P; type conversions by macros
-such as XEN_TO_C_INT or C_TO_XEN_INT.
-</p>
-
-</body>
-</html>
diff --git a/xg.c b/xg.c
index f5c9a75..64cbd48 100644
--- a/xg.c
+++ b/xg.c
@@ -9,11 +9,9 @@
*
* added funcs:
* (xg-version): date string.
- * (->string val) interprets 'val' as a string.
* (c-array->list arr len) derefs each member of arr, returning lisp list, len=#f: null terminated array
* (list->c-array lst ctype) packages each member of list as c-type "type" returning (wrapped) c array
* (make-target-entry lst) returns a GtkTargetEntry table, each member of 'lst' should be (list target flags info)
- * (GdkColor pixel red green blue): GdkColor struct
* (GtkTextIter): GtkTextIter struct
* (GtkTreeIter): GtkTreeIter struct
* (PangoRectangle): PangoRectangle struct
@@ -26,6 +24,19 @@
* win32-specific functions
*
* HISTORY:
+ *
+ * 29-Oct: removed ->string.
+ * 21-Aug-15: procedure-signature changes.
+ * --------
+ * 27-Dec: integer procedure stuff.
+ * 16-Apr: changed max-args to 8.
+ * 6-Mar: changed most macros.
+ * 21-Feb-14: changed _p to _is_.
+ * --------
+ * 3-Sep: use symbol directly in type checks, not the symbol name.
+ * 18-Aug: changed the gtk version macros to reflect the version number.
+ * 7-Jun-13: added mixed arg types to the ... arg lists.
+ * --------
* 19-Aug-10: removed lots of Gdk stuff -- we assume Gtk 2.9 and cairo now.
* 28-Jan-10: removed the rest of the struct accessors.
* --------
@@ -50,7 +61,7 @@
* 13-Jun: folded xg-ruby.c into xg.c.
* 21-Feb: changed libxm to libxg, xm-version to xg-version.
* 10-Jan: plugged some memory leaks.
- * 4-Jan-05: removed deprecated XEN_VECTOR_ELEMENTS.
+ * 4-Jan-05: removed deprecated Xen_VECTOR_ELEMENTS.
* --------
* 8-Dec: added some g_log handler funcs.
* 6-Dec: check for lost callback context.
@@ -78,30 +89,31 @@
* 19-Jul: XG_FIELD_PRE for change from using vertical-bar (reserved in R5RS)
* 2-Jun: removed deprecated and broken stuff
* 12-Mar: support for GtkDestroyNotify callbacks
- * 25-Feb: dialog example in libxm.html
* Ruby support via xg-ruby.c
* 21-Feb: #f=NULL throughout, gdk-pixbuf, GTypes.
* 11-Feb-02: initial version.
*/
-#include <mus-config.h>
+#include "mus-config.h"
-#if HAVE_EXTENSION_LANGUAGE
+#define HAVE_CAIRO_1_8 ((CAIRO_VERSION_MAJOR >= 1) && (CAIRO_VERSION_MINOR >= 8))
+#define HAVE_CAIRO_1_9_12 ((CAIRO_VERSION_MAJOR >= 1) && (CAIRO_VERSION_MINOR >= 9) && (CAIRO_VERSION_MICRO >= 12))
-#if UNDEF_USE_SND
- #undef USE_SND
- #define USE_SND 0
+#if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L))))
+ #define __func__ __FUNCTION__
#endif
+#if HAVE_EXTENSION_LANGUAGE
+
#include <string.h>
#include <stdlib.h>
#include <glib.h>
#include <gdk/gdk.h>
-#if (!HAVE_GTK_3)
+#include <gtk/gtk.h>
+#if (!GTK_CHECK_VERSION(3, 0, 0))
#include <gdk/gdkkeysyms.h>
#endif
-#include <gtk/gtk.h>
#include <glib-object.h>
#include <pango/pango.h>
#include <cairo/cairo.h>
@@ -123,10 +135,10 @@
#endif
#endif
-/* -------------------------------- smob for GC -------------------------------- */
-static XEN_OBJECT_TYPE xm_obj_tag;
+/* -------------------------------- GC -------------------------------- */
+static Xen_object_type_t xm_obj_tag;
#if HAVE_RUBY
-static void *xm_obj_free(XEN obj)
+static void *xm_obj_free(Xen obj)
{
void *xobj;
xobj = (void *)obj;
@@ -135,10 +147,10 @@ static void *xm_obj_free(XEN obj)
}
#endif
#if HAVE_FORTH
-static void xm_obj_free(XEN obj)
+static void xm_obj_free(Xen obj)
{
void *val;
- val = (void *)XEN_OBJECT_REF(obj);
+ val = (void *)Xen_object_ref(obj);
free(val);
}
#endif
@@ -152,16 +164,16 @@ static bool s7_equalp_xm(void *x1, void *x2)
return(x1 == x2);
}
#endif
-static XEN make_xm_obj(void *ptr)
+static Xen make_xm_obj(void *ptr)
{
- XEN_MAKE_AND_RETURN_OBJECT(xm_obj_tag, ptr, 0, xm_obj_free);
+ return(Xen_make_object(xm_obj_tag, ptr, 0, xm_obj_free));
}
static void define_xm_obj(void)
{
#if HAVE_SCHEME
- xm_obj_tag = XEN_MAKE_OBJECT_TYPE("<XmObj>", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL);
+ xm_obj_tag = s7_new_type_x(s7, "<XmObj>", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
#else
- xm_obj_tag = XEN_MAKE_OBJECT_TYPE("XmObj", sizeof(void *));
+ xm_obj_tag = Xen_make_object_type("XmObj", sizeof(void *));
#endif
#if HAVE_FORTH
fth_set_object_free(xm_obj_tag, xm_obj_free);
@@ -170,904 +182,900 @@ static void define_xm_obj(void)
/* prefix for all names */
#if HAVE_SCHEME
- #define XG_PRE ""
- #define XG_FIELD_PRE "."
- #define XG_POST ""
+ #define Xg_pre ""
+ #define Xg_field_pre "."
+ #define Xg_post ""
#endif
#if HAVE_RUBY
/* for Ruby, XG PRE needs to be uppercase */
- #define XG_PRE "R"
- #define XG_POST ""
- #define XG_FIELD_PRE "R"
+ #define Xg_pre "R"
+ #define Xg_post ""
+ #define Xg_field_pre "R"
#endif
#if HAVE_FORTH
- #define XG_PRE "F"
- #define XG_POST ""
- #define XG_FIELD_PRE "F"
+ #define Xg_pre "F"
+ #define Xg_post ""
+ #define Xg_field_pre "F"
#endif
-#define WRAP_FOR_XEN(Name, Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(Name), XEN_WRAP_C_POINTER(Value))
-#define WRAP_P(Name, Value) (XEN_LIST_P(Value) && \
- (XEN_LIST_LENGTH(Value) >= 2) && \
- (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp(Name, XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
+static Xen xg_GtkAllocation_symbol, xg_GtkShortcutsWindow__symbol, xg_GtkStackSidebar__symbol, xg_GtkSearchEntry__symbol, xg_GtkPopoverMenu__symbol, xg_GtkStyleContext__symbol, xg_GdkGLContext__symbol, xg_GtkGLArea__symbol, xg_GtkPropagationPhase_symbol, xg_GtkEventController__symbol, xg_GtkGestureZoom__symbol, xg_GtkGestureSwipe__symbol, xg_GtkGestureSingle__symbol, xg_GtkGestureRotate__symbol, xg_GtkGestureMultiPress__symbol, xg_GtkGesturePan__symbol, xg_GtkGestureDrag__symbol, xg_GdkEventSequence__symbol, xg_GtkEventSequenceState_symbol, xg_GtkGesture__symbol, xg_GtkPopover__symbol, xg_GtkActionBar__symbol, xg_GtkFlowBox__symbol, xg_GtkFlowBoxChild__symbol, xg_GdkEventType_symbol, xg_GtkSearchBar__symbol, xg_GtkListBox__symbol, xg_GtkListBoxRow__symbol, xg_GtkHeaderBar__symbol, xg_GtkRevealerTransitionType_symbol, xg_GtkRevealer__symbol, xg_GtkStackTransitionType_symbol, xg_GtkStack__symbol, xg_GtkStackSwitcher__symbol, xg_GtkPlacesSidebar__symbol, xg_GtkPlacesOpenFlags_symbol, xg_GtkBaselinePosition_symbol, xg_GdkFullscreenMode_symbol, xg_GtkInputHints_symbol, xg_GtkInputPurpose_symbol, xg_GtkLevelBarMode_symbol, xg_GtkLevelBar__symbol, xg_GtkMenuButton__symbol, xg_GtkColorChooser__symbol, xg_GtkApplicationWindow__symbol, xg_GtkApplication__symbol, xg_GMenuModel__symbol, xg_guint___symbol, xg_GdkModifierIntent_symbol, xg_GtkFontChooser__symbol, xg_GdkScrollDirection_symbol, xg_GtkOverlay__symbol, xg_GtkWidgetPath__symbol, xg_GtkStateFlags_symbol, xg_GdkScreen___symbol, xg_GtkToolShell__symbol, xg_GtkWindowGroup__symbol, xg_GtkInvisible__symbol, xg_GtkOrientable__symbol, xg_GtkCellArea__symbol, xg_GtkBorder__symbol, xg_GtkSwitch__symbol, xg_GtkScrollablePolicy_symbol, xg_GtkScrollable__symbol, xg_GtkGrid__symbol, xg_GdkRGBA__symbol, xg_GtkComboBoxText__symbol, xg_GtkAlign_symbol, xg_GtkContainerClass__symbol, xg_GtkSizeRequestMode_symbol, xg_cairo_region_overlap_t_symbol, xg_cairo_rectangle_int_t__symbol, xg_double__symbol, xg_cairo_rectangle_t__symbol, xg_cairo_device_t__symbol, xg_cairo_bool_t_symbol, xg_cairo_text_cluster_flags_t__symbol, xg_cairo_text_cluster_t___symbol, xg_cairo_glyph_t___symbol, xg_cairo_text_cluster_flags_t_symbol, xg_cairo_text_cluster_t__symbol, xg_cairo_region_t__symbol, xg_GtkMessageDialog__symbol, xg_GdkDevice__symbol, xg_GdkDeviceManager__symbol, xg_GtkAccessible__symbol, xg_GdkModifierType__symbol, xg_GtkToolPaletteDragTargets_symbol, xg_GtkToolItemGroup__symbol, xg_GtkToolPalette__symbol, xg_GtkSpinner__symbol, xg_GtkEntryBuffer__symbol, xg_GtkMessageType_symbol, xg_GtkInfoBar__symbol, xg_GIcon__symbol, xg_GtkEntryIconPosition_symbol, xg_GFile__symbol, xg_GtkScaleButton__symbol, xg_GtkCalendarDetailFunc_symbol, xg_GtkTooltip__symbol, xg_cairo_rectangle_list_t__symbol, xg_void__symbol, xg_cairo_filter_t_symbol, xg_cairo_extend_t_symbol, xg_cairo_format_t_symbol, xg_cairo_path_t__symbol, xg_cairo_destroy_func_t_symbol, xg_cairo_user_data_key_t__symbol, xg_cairo_text_extents_t__symbol, xg_cairo_font_extents_t__symbol, xg_cairo_font_face_t__symbol, xg_cairo_glyph_t__symbol, xg_cairo_scaled_font_t__symbol, xg_cairo_font_weight_t_symbol, xg_cairo_font_slant_t_symbol, xg_cairo_hint_metrics_t_symbol, xg_cairo_hint_style_t_symbol, xg_cairo_subpixel_order_t_symbol, xg_cairo_status_t_symbol, xg_bool_symbol, xg_cairo_matrix_t__symbol, xg_cairo_line_join_t_symbol, xg_cairo_line_cap_t_symbol, xg_cairo_fill_rule_t_symbol, xg_cairo_antialias_t_symbol, xg_cairo_operator_t_symbol, xg_cairo_pattern_t__symbol, xg_cairo_content_t_symbol, xg_GtkPageSet_symbol, xg_GtkPageRange__symbol, xg_GtkPrintPages_symbol, xg_GtkPrintQuality_symbol, xg_GtkPrintDuplex_symbol, xg_GtkPaperSize__symbol, xg_GtkPageOrientation_symbol, xg_GtkPrintSettingsFunc_symbol, xg_GtkPrintOperationPreview__symbol, xg_GtkPageSetupDoneFunc_symbol, xg_GtkPrintStatus_symbol, xg_GtkPrintOperationAction_symbol, xg_GtkPrintOperationResult_symbol, xg_GtkUnit_symbol, xg_GtkPrintSettings__symbol, xg_GtkPrintOperation__symbol, xg_GtkPageSetup__symbol, xg_GtkPrintContext__symbol, xg_cairo_surface_t__symbol, xg_GtkTreeViewGridLines_symbol, xg_GtkRecentData__symbol, xg_GtkTextBufferDeserializeFunc_symbol, xg_GtkTextBufferSerializeFunc_symbol, xg_time_t_symbol, xg_GtkRecentChooserMenu__symbol, xg_GtkRecentManager__symbol, xg_GtkRecentFilter__symbol, xg_GtkRecentSortFunc_symbol, xg_GtkRecentSortType_symbol, xg_GtkRecentChooser__symbol, xg_GtkLinkButton__symbol, xg_GtkAssistantPageType_symbol, xg_GtkAssistantPageFunc_symbol, xg_GtkAssistant__symbol, xg_GDestroyNotify_symbol, xg_GtkTreeViewSearchPositionFunc_symbol, xg_GtkSensitivityType_symbol, xg_GtkClipboardRichTextReceivedFunc_symbol, xg_GtkMenuBar__symbol, xg_GtkPackDirection_symbol, xg_GtkIconViewDropPosition_symbol, xg_GValue__symbol, xg_GLogFunc_symbol, xg_PangoMatrix__symbol, xg_PangoRenderPart_symbol, xg_PangoRenderer__symbol, xg_GtkClipboardImageReceivedFunc_symbol, xg_GtkMenuToolButton__symbol, xg_GtkFileChooserButton__symbol, xg_PangoScriptIter__symbol, xg_PangoScript_symbol, xg_PangoAttrFilterFunc_symbol, xg_PangoEllipsizeMode_symbol, xg_GtkIconViewForeachFunc_symbol, xg_GtkAboutDialog__symbol, xg_GtkTreeViewRowSeparatorFunc_symbol, xg_GtkCellView__symbol, xg_GtkAccelMap__symbol, xg_GtkClipboardTargetsReceivedFunc_symbol, xg_GtkOrientation_symbol, xg_GtkToolButton__symbol, xg_GtkIconLookupFlags_symbol, xg_GtkIconInfo__symbol, xg_GtkIconTheme__symbol, xg_GtkFileChooser__symbol, xg_GtkCellLayoutDataFunc_symbol, xg_GtkCellLayout__symbol, xg_GtkFileFilterFunc_symbol, xg_GtkFileFilterFlags_symbol, xg_GtkFileFilter__symbol, xg_GSourceFunc_symbol, xg_GtkToggleToolButton__symbol, xg_GtkSeparatorToolItem__symbol, xg_GtkRadioToolButton__symbol, xg_GtkEntryCompletionMatchFunc_symbol, xg_GtkFontButton__symbol, xg_GtkExpander__symbol, xg_GtkComboBox__symbol, xg_GtkTreeModelFilter__symbol, xg_GtkFileChooserAction_symbol, xg_GtkToolItem__symbol, xg_GtkEventBox__symbol, xg_GtkCalendarDisplayOptions_symbol, xg_GdkScreen__symbol, xg_PangoLayoutRun__symbol, xg_PangoLayoutIter__symbol, xg_PangoLayoutLine__symbol, xg_int__symbol, xg_PangoAlignment_symbol, xg_PangoWrapMode_symbol, xg_PangoItem__symbol, xg_PangoGlyphString__symbol, xg_PangoFontMap__symbol, xg_PangoGlyph_symbol, xg_PangoFontFace__symbol, xg_PangoFontFace___symbol, xg_PangoFontFamily__symbol, xg_PangoFontMask_symbol, xg_PangoFontDescription___symbol, xg_PangoCoverageLevel_symbol, xg_PangoCoverage__symbol, xg_PangoFontMetrics__symbol, xg_PangoFontset__symbol, xg_PangoFont__symbol, xg_PangoFontFamily___symbol, xg_PangoLogAttr__symbol, xg_PangoAnalysis__symbol, xg_PangoAttrList___symbol, xg_PangoAttrIterator__symbol, xg_PangoRectangle__symbol, xg_PangoUnderline_symbol, xg_PangoStretch_symbol, xg_PangoVariant_symbol, xg_PangoWeight_symbol, xg_PangoStyle_symbol, xg_guint16_symbol, xg_PangoAttribute__symbol, xg_PangoAttrType_symbol, xg_PangoColor__symbol, xg_GdkGravity_symbol, xg_GtkWindowPosition_symbol, xg_GtkWindowType_symbol, xg_GtkWindow__symbol, xg_GtkTextDirection_symbol, xg_AtkObject__symbol, xg_GtkDirectionType_symbol, xg_GtkAllocation__symbol, xg_GtkViewport__symbol, xg_GtkTreeViewSearchEqualFunc_symbol, xg_GtkTreeViewDropPosition_symbol, xg_GtkTreeViewMappingFunc_symbol, xg_GtkTreeViewColumnDropFunc_symbol, xg_GtkTreeViewColumnSizing_symbol, xg_GtkTreeCellDataFunc_symbol, xg_GtkTreeStore__symbol, xg_GtkTreeIterCompareFunc_symbol, xg_GtkSortType_symbol, xg_GtkTreeSortable__symbol, xg_GtkTreeSelectionForeachFunc_symbol, xg_GtkTreeModel___symbol, xg_GtkTreeSelectionFunc_symbol, xg_GtkSelectionMode_symbol, xg_GtkTreeModelSort__symbol, xg_GtkTreeModelForeachFunc_symbol, xg_GtkTreeModelFlags_symbol, xg_GtkTreeRowReference__symbol, xg_GtkTreeDragDest__symbol, xg_GtkTreeDragSource__symbol, xg_GtkToolbarStyle_symbol, xg_GtkToolbar__symbol, xg_GtkToggleButton__symbol, xg_PangoTabArray__symbol, xg_GtkWrapMode_symbol, xg_GtkTextWindowType_symbol, xg_GtkTextView__symbol, xg_GtkTextTagTableForeach_symbol, xg_GtkTextSearchFlags_symbol, xg_GtkTextCharPredicate_symbol, xg_GtkTextAttributes__symbol, xg_GtkTextMark__symbol, xg_GtkTextChildAnchor__symbol, xg_GtkTextIter__symbol, xg_GtkTextTagTable__symbol, xg_GtkTextBuffer__symbol, xg_GtkStatusbar__symbol, xg_GtkSpinType_symbol, xg_GtkSpinButtonUpdatePolicy_symbol, xg_GtkSpinButton__symbol, xg_GtkSizeGroupMode_symbol, xg_GtkSizeGroup__symbol, xg_GtkSettings__symbol, xg_GtkCornerType_symbol, xg_GtkPolicyType_symbol, xg_GtkScrolledWindow__symbol, xg_GtkScale__symbol, xg_GtkRange__symbol, xg_GtkRadioMenuItem__symbol, xg_GtkRadioButton__symbol, xg_GtkProgressBar__symbol, xg_GtkPaned__symbol, xg_GtkPositionType_symbol, xg_GtkNotebook__symbol, xg_GtkMenuShell__symbol, xg_GtkMenuItem__symbol, xg_GtkMenuPositionFunc_symbol, xg_PangoLanguage__symbol, xg_GtkListStore__symbol, xg_GtkLayout__symbol, xg_GtkJustification_symbol, xg_GtkLabel__symbol, xg_guint16__symbol, xg_GtkIMContextSimple__symbol, xg_GdkEventKey__symbol, xg_PangoAttrList__symbol, xg_GtkIMContext__symbol, xg_GtkImageType_symbol, xg_GtkImage__symbol, xg_GtkShadowType_symbol, xg_GtkFrame__symbol, xg_GtkFixed__symbol, xg_PangoLayout__symbol, xg_GtkEntry__symbol, xg_GtkEditable__symbol, xg_GtkTargetList__symbol, xg_GtkDestDefaults_symbol, xg_etc_symbol, xg_GtkDialog__symbol, xg_GtkCallback_symbol, xg_GtkContainer__symbol, xg_GtkClipboardTextReceivedFunc_symbol, xg_GtkClipboardReceivedFunc_symbol, xg_GtkClipboardClearFunc_symbol, xg_GtkClipboardGetFunc_symbol, xg_GtkTargetEntry__symbol, xg_GtkCheckMenuItem__symbol, xg_GtkCellRendererToggle__symbol, xg_GtkCellRendererText__symbol, xg_GtkCellRendererState_symbol, xg_GtkCellEditable__symbol, xg_GtkCalendar__symbol, xg_GtkReliefStyle_symbol, xg_GtkButton__symbol, xg_GtkPackType_symbol, xg_GtkBox__symbol, xg_GtkBin__symbol, xg_GtkBindingSet__symbol, xg_GtkButtonBox__symbol, xg_GtkButtonBoxStyle_symbol, xg_GtkAspectFrame__symbol, xg_GtkAdjustment__symbol, xg_GtkAccelMapForeach_symbol, xg_GtkAccelLabel__symbol, xg_GtkAccelGroupEntry__symbol, xg_lambda3_symbol, xg_GSList__symbol, xg_GObject__symbol, xg_GtkAccelFlags_symbol, xg_GtkAccelGroup__symbol, xg_GTimeVal__symbol, xg_GdkPixbufAnimationIter__symbol, xg_GdkPixbufAnimation__symbol, xg_GdkInterpType_symbol, xg_double_symbol, xg_gfloat_symbol, xg_guchar_symbol, xg_char___symbol, xg_GdkPixbufDestroyNotify_symbol, xg_GError__symbol, xg_int_symbol, xg_GdkColorspace_symbol, xg_GdkWindowTypeHint_symbol, xg_GdkWindowHints_symbol, xg_GdkGeometry__symbol, xg_GdkWindowEdge_symbol, xg_GdkWMFunction_symbol, xg_GdkWMDecoration_symbol, xg_GdkEventMask_symbol, xg_GdkWindowState_symbol, xg_GdkFilterFunc_symbol, xg_GdkWindowType_symbol, xg_GdkWindowAttr__symbol, xg_GdkVisualType__symbol, xg_gint__symbol, xg_GdkVisualType_symbol, xg_GdkPropMode_symbol, xg_guchar__symbol, xg_PangoContext__symbol, xg_PangoDirection_symbol, xg_GdkKeymapKey__symbol, xg_GdkKeymap__symbol, xg_GdkRectangle__symbol, xg_char__symbol, xg_gchar___symbol, xg_GdkEventFunc_symbol, xg_gdouble_symbol, xg_GList__symbol, xg_GdkWindow__symbol, xg_guint32_symbol, xg_GdkDragAction_symbol, xg_GdkDragContext__symbol, xg_GdkCursorType_symbol, xg_GdkDisplay__symbol, xg_GdkCursor__symbol, xg_GdkVisual__symbol, xg_GSignalMatchType_symbol, xg_GConnectFlags_symbol, xg_GtkDestroyNotify_symbol, xg_GSignalEmissionHook_symbol, xg_gulong_symbol, xg_GSignalInvocationHint__symbol, xg_GQuark_symbol, xg_guint__symbol, xg_GSignalQuery__symbol, xg_GType__symbol, xg_GSignalCMarshaller_symbol, xg_gpointer_symbol, xg_GSignalAccumulator_symbol, xg_GSignalFlags_symbol, xg_GType_symbol, xg_GClosureNotify_symbol, xg_GCallback_symbol, xg_GNormalizeMode_symbol, xg_glong_symbol, xg_gssize_symbol, xg_gunichar__symbol, xg_void_symbol, xg_GtkRecentInfo__symbol, xg_gsize_symbol, xg_guint8__symbol, xg_GdkAtom_symbol, xg_GLogLevelFlags_symbol, xg_GdkPixbuf__symbol, xg_GtkIconView__symbol, xg_GtkEntryCompletion__symbol, xg_GtkFileFilterInfo__symbol, xg_GtkTreeSelection__symbol, xg_GtkCellRenderer__symbol, xg_GtkTreeViewColumn__symbol, xg_GtkTreeView__symbol, xg_gunichar_symbol, xg_GdkAtom__symbol, xg_GtkSelectionData__symbol, xg_GtkClipboard__symbol, xg_GtkTreeIter__symbol, xg_GtkTreePath__symbol, xg_GtkTreeModel__symbol, xg_GdkModifierType_symbol, xg_guint_symbol, xg_gchar__symbol, xg_GtkTextTag__symbol, xg_gboolean_symbol, xg_gint_symbol, xg_GtkMenu__symbol, xg_GdkXEvent__symbol, xg_GtkWidget__symbol, xg_lambda_data_symbol, xg_GClosure__symbol, xg_GtkAccelKey__symbol, xg_GdkEventMotion__symbol, xg_gdouble__symbol, xg_GdkEventAny__symbol, xg_GdkEvent__symbol, xg_cairo_t__symbol, xg_cairo_font_options_t__symbol, xg_PangoFontDescription__symbol, xg_idler_symbol, xg_GtkCellRendererPixbuf__symbol, xg_GtkCheckButton__symbol, xg_GtkDrawingArea__symbol, xg_GtkScrollbar__symbol, xg_GtkSeparator__symbol, xg_GtkSeparatorMenuItem__symbol, xg_GdkEventExpose__symbol, xg_GdkEventNoExpose__symbol, xg_GdkEventVisibility__symbol, xg_GdkEventButton__symbol, xg_GdkEventScroll__symbol, xg_GdkEventCrossing__symbol, xg_GdkEventFocus__symbol, xg_GdkEventConfigure__symbol, xg_GdkEventProperty__symbol, xg_GdkEventSelection__symbol, xg_GdkEventProximity__symbol, xg_GdkEventSetting__symbol, xg_GdkEventWindowState__symbol, xg_GdkEventDND__symbol, xg_GtkFileChooserDialog__symbol, xg_GtkFileChooserWidget__symbol, xg_GtkColorButton__symbol, xg_GtkAccelMap_symbol, xg_GtkCellRendererCombo__symbol, xg_GtkCellRendererProgress__symbol, xg_GtkCellRendererAccel__symbol, xg_GtkCellRendererSpin__symbol, xg_GtkRecentChooserDialog__symbol, xg_GtkRecentChooserWidget__symbol, xg_GtkCellRendererSpinner__symbol, xg_gboolean__symbol, xg_GtkFontChooserDialog__symbol, xg_GtkFontChooserWidget__symbol, xg_GtkColorChooserDialog__symbol, xg_GtkColorChooserWidget__symbol, xg_GtkColorWidget__symbol, xg_GtkGestureLongPress__symbol;
+
+#define wrap_for_Xen(Name, Value) Xen_list_2(xg_ ## Name ## _symbol, Xen_wrap_C_pointer(Value))
+#define is_wrapped(Name, Value) (Xen_is_pair(Value) && (Xen_car(Value) == xg_ ## Name ## _symbol))
-#define XM_TYPE(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(#Name), C_TO_XEN_ULONG(val)));} \
- static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
+#define Xm_type(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {return(Xen_list_2(xg_ ## Name ## _symbol, C_ulong_to_Xen_ulong(val)));} \
+ static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}
-#define XM_TYPE_1(Name, XType) \
- static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
+#define Xm_type_1(Name, XType) \
+ static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}
-#define XM_TYPE_NO_P_2(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {return(WRAP_FOR_XEN(#Name, val));}
+#define Xm_type_no_p_2(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {return(wrap_for_Xen(Name, val));}
-#define XM_TYPE_PTR(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
+#define Xm_type_Ptr(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(Name, val)); return(Xen_false);} \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}
-#define XM_TYPE_PTR_CONST(Name, XType) \
- static XEN C_TO_XEN_ ## Name (const XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \
- static const XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((const XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
+#define Xm_type_Ptr_const(Name, XType) \
+ static Xen C_to_Xen_ ## Name (const XType val) {if (val) return(wrap_for_Xen(Name, val)); return(Xen_false);} \
+ static const XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((const XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}
-#define XM_TYPE_PTR_1(Name, XType) \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
+#define Xm_type_Ptr_1(Name, XType) \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(Name, val));}
-#define XM_TYPE_PTR_2(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \
+#define Xm_type_Ptr_2(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(Name, val)); return(Xen_false);} \
/* type checks for callback wrappers */
-#define XEN_lambda3_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GtkCallback_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 2)))
-#define XEN_GSourceFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 1)))
-#define XEN_GtkDestroyNotify_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 1)))
-#define XEN_GdkFilterFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GdkEventFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 2)))
-#define XEN_GtkKeySnoopFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GtkMenuPositionFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 5)))
-#define XEN_GtkTextTagTableForeach_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 2)))
-#define XEN_GtkAccelMapForeach_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 5)))
-#define XEN_GtkTreeModelForeachFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 4)))
-#define XEN_GtkTreeSelectionForeachFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 4)))
-#define XEN_GtkClipboardReceivedFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GtkClipboardTextReceivedFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GtkClipboardTargetsReceivedFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 4)))
-#define XEN_GtkTextCharPredicate_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 2)))
-#define XEN_GtkTreeViewColumnDropFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 5)))
-#define XEN_GtkTreeViewMappingFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GtkTreeViewSearchEqualFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 5)))
-#define XEN_GtkTreeCellDataFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 5)))
-#define XEN_GtkTreeIterCompareFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 4)))
-#define XEN_GtkTreeSelectionFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 5)))
-#define XEN_GtkClipboardGetFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 4)))
-#define XEN_GtkClipboardClearFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 2)))
-#define XEN_GtkFileFilterFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 2)))
-#define XEN_GtkEntryCompletionMatchFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 4)))
-#define XEN_GtkTreeViewRowSeparatorFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GtkIconViewForeachFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GtkClipboardImageReceivedFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GLogFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 4)))
-#define XEN_GtkClipboardRichTextReceivedFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 5)))
-#define XEN_GtkRecentFilterFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 2)))
-#define XEN_GtkTreeViewSearchPositionFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GtkAssistantPageFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 2)))
-#define XEN_GtkRecentSortFunc_P(Arg) XEN_FALSE_P(Arg) || (XEN_PROCEDURE_P(Arg) && (XEN_REQUIRED_ARGS_OK(Arg, 3)))
-#define XEN_GCallback_P(Arg) (XEN_PROCEDURE_P(Arg) && ((XEN_REQUIRED_ARGS_OK(Arg, 2)) || (XEN_REQUIRED_ARGS_OK(Arg, 3)) || (XEN_REQUIRED_ARGS_OK(Arg, 4))))
-#define XEN_TO_C_lambda3(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_find_func
-#define XEN_TO_C_GtkCallback(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_func2
-#define XEN_TO_C_GSourceFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_timer_func
-#define XEN_TO_C_GtkDestroyNotify(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_destroy_func
-#define XEN_TO_C_GdkFilterFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_filter_func
-#define XEN_TO_C_GdkEventFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_event_func
-#define XEN_TO_C_GtkKeySnoopFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_snoop_func
-#define XEN_TO_C_GtkMenuPositionFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_menu_position_func
-#define XEN_TO_C_GtkTextTagTableForeach(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_text_tag_table_foreach
-#define XEN_TO_C_GtkAccelMapForeach(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_accel_map_foreach
-#define XEN_TO_C_GtkTreeModelForeachFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_model_func
-#define XEN_TO_C_GtkTreeSelectionForeachFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_tree_selection_func
-#define XEN_TO_C_GtkClipboardReceivedFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_clip_received
-#define XEN_TO_C_GtkClipboardTextReceivedFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_clip_text_received
-#define XEN_TO_C_GtkClipboardTargetsReceivedFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_clip_targets_received
-#define XEN_TO_C_GtkTextCharPredicate(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_text_char_predicate
-#define XEN_TO_C_GtkTreeViewColumnDropFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_tree_column
-#define XEN_TO_C_GtkTreeViewMappingFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_tree_mapping
-#define XEN_TO_C_GtkTreeViewSearchEqualFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_tree_search
-#define XEN_TO_C_GtkTreeCellDataFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_cell_data
-#define XEN_TO_C_GtkTreeIterCompareFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_iter_compare
-#define XEN_TO_C_GtkTreeSelectionFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_tree_selection
-#define XEN_TO_C_GtkClipboardGetFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_clip_get
-#define XEN_TO_C_GtkClipboardClearFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_clip_clear
-#define XEN_TO_C_GtkFileFilterFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_file_filter
-#define XEN_TO_C_GtkEntryCompletionMatchFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_entry_completion_match
-#define XEN_TO_C_GtkTreeViewRowSeparatorFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_row_separator
-#define XEN_TO_C_GtkIconViewForeachFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_icon_view_foreach
-#define XEN_TO_C_GtkClipboardImageReceivedFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_clip_image_received
-#define XEN_TO_C_GLogFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_g_message_log_func
-#define XEN_TO_C_GtkClipboardRichTextReceivedFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_clip_rich_text_received
-#define XEN_TO_C_GtkRecentFilterFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_recent_filter
-#define XEN_TO_C_GtkTreeViewSearchPositionFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_search_position
-#define XEN_TO_C_GtkAssistantPageFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_page_func
-#define XEN_TO_C_GtkRecentSortFunc(Arg) XEN_FALSE_P(Arg) ? NULL : gxg_recent_sort
-#define XEN_TO_C_GCallback(Arg) ((XEN_REQUIRED_ARGS_OK(Arg, 4)) ? (GCallback)gxg_func4 : ((XEN_REQUIRED_ARGS_OK(Arg, 3)) ? (GCallback)gxg_func3 : (GCallback)gxg_func2))
-#define XEN_TO_C_lambda_data(Arg) (gpointer)gxg_ptr
-#define XEN_lambda_data_P(Arg) 1
-#define C_TO_XEN_GtkTreeViewSearchPositionFunc(Arg) WRAP_FOR_XEN("GtkTreeViewSearchPositionFunc", Arg)
-#define C_TO_XEN_GtkTreeViewSearchEqualFunc(Arg) WRAP_FOR_XEN("GtkTreeViewSearchEqualFunc", Arg)
-#define XEN_TO_C_GdkFilterReturn(Arg) (GdkFilterReturn)XEN_TO_C_INT(Arg)
-#define XEN_TO_C_String(Arg) ((XEN_STRING_P(Arg)) ? XEN_TO_C_STRING(Arg) : NULL)
-#define C_TO_XEN_String(Arg) ((Arg != NULL) ? C_TO_XEN_STRING((char *)Arg) : XEN_FALSE)
-#define XEN_String_P(Arg) ((XEN_FALSE_P(Arg)) || (XEN_STRING_P(Arg)))
-static XEN C_TO_XEN_GError_(GError *err)
+#define Xen_is_lambda3(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GtkCallback(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 2)))
+#define Xen_is_GSourceFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 1)))
+#define Xen_is_GtkDestroyNotify(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 1)))
+#define Xen_is_GdkFilterFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GdkEventFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 2)))
+#define Xen_is_GtkMenuPositionFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 5)))
+#define Xen_is_GtkTextTagTableForeach(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 2)))
+#define Xen_is_GtkAccelMapForeach(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 5)))
+#define Xen_is_GtkTreeModelForeachFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 4)))
+#define Xen_is_GtkTreeSelectionForeachFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 4)))
+#define Xen_is_GtkClipboardReceivedFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GtkClipboardTextReceivedFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GtkClipboardTargetsReceivedFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 4)))
+#define Xen_is_GtkTextCharPredicate(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 2)))
+#define Xen_is_GtkTreeViewColumnDropFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 5)))
+#define Xen_is_GtkTreeViewMappingFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GtkTreeViewSearchEqualFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 5)))
+#define Xen_is_GtkTreeCellDataFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 5)))
+#define Xen_is_GtkTreeIterCompareFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 4)))
+#define Xen_is_GtkTreeSelectionFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 5)))
+#define Xen_is_GtkClipboardGetFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 4)))
+#define Xen_is_GtkClipboardClearFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 2)))
+#define Xen_is_GtkFileFilterFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 2)))
+#define Xen_is_GtkEntryCompletionMatchFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 4)))
+#define Xen_is_GtkTreeViewRowSeparatorFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GtkIconViewForeachFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GtkClipboardImageReceivedFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GLogFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 4)))
+#define Xen_is_GtkClipboardRichTextReceivedFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 5)))
+#define Xen_is_GtkTreeViewSearchPositionFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GtkAssistantPageFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 2)))
+#define Xen_is_GtkRecentSortFunc(Arg) Xen_is_false(Arg) || (Xen_is_procedure(Arg) && (Xen_is_aritable(Arg, 3)))
+#define Xen_is_GCallback(Arg) (Xen_is_procedure(Arg) && ((Xen_is_aritable(Arg, 2)) || (Xen_is_aritable(Arg, 3)) || (Xen_is_aritable(Arg, 4))))
+#define Xen_to_C_lambda3(Arg) Xen_is_false(Arg) ? NULL : gxg_find_func
+#define Xen_to_C_GtkCallback(Arg) Xen_is_false(Arg) ? NULL : gxg_func2
+#define Xen_to_C_GSourceFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_timer_func
+#define Xen_to_C_GtkDestroyNotify(Arg) Xen_is_false(Arg) ? NULL : gxg_destroy_func
+#define Xen_to_C_GdkFilterFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_filter_func
+#define Xen_to_C_GdkEventFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_event_func
+#define Xen_to_C_GtkMenuPositionFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_menu_position_func
+#define Xen_to_C_GtkTextTagTableForeach(Arg) Xen_is_false(Arg) ? NULL : gxg_text_tag_table_foreach
+#define Xen_to_C_GtkAccelMapForeach(Arg) Xen_is_false(Arg) ? NULL : gxg_accel_map_foreach
+#define Xen_to_C_GtkTreeModelForeachFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_model_func
+#define Xen_to_C_GtkTreeSelectionForeachFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_tree_selection_func
+#define Xen_to_C_GtkClipboardReceivedFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_clip_received
+#define Xen_to_C_GtkClipboardTextReceivedFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_clip_text_received
+#define Xen_to_C_GtkClipboardTargetsReceivedFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_clip_targets_received
+#define Xen_to_C_GtkTextCharPredicate(Arg) Xen_is_false(Arg) ? NULL : gxg_text_char_predicate
+#define Xen_to_C_GtkTreeViewColumnDropFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_tree_column
+#define Xen_to_C_GtkTreeViewMappingFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_tree_mapping
+#define Xen_to_C_GtkTreeViewSearchEqualFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_tree_search
+#define Xen_to_C_GtkTreeCellDataFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_cell_data
+#define Xen_to_C_GtkTreeIterCompareFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_iter_compare
+#define Xen_to_C_GtkTreeSelectionFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_tree_selection
+#define Xen_to_C_GtkClipboardGetFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_clip_get
+#define Xen_to_C_GtkClipboardClearFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_clip_clear
+#define Xen_to_C_GtkFileFilterFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_file_filter
+#define Xen_to_C_GtkEntryCompletionMatchFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_entry_completion_match
+#define Xen_to_C_GtkTreeViewRowSeparatorFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_row_separator
+#define Xen_to_C_GtkIconViewForeachFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_icon_view_foreach
+#define Xen_to_C_GtkClipboardImageReceivedFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_clip_image_received
+#define Xen_to_C_GLogFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_g_message_log_func
+#define Xen_to_C_GtkClipboardRichTextReceivedFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_clip_rich_text_received
+#define Xen_to_C_GtkTreeViewSearchPositionFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_search_position
+#define Xen_to_C_GtkAssistantPageFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_page_func
+#define Xen_to_C_GtkRecentSortFunc(Arg) Xen_is_false(Arg) ? NULL : gxg_recent_sort
+#define Xen_to_C_GCallback(Arg) ((Xen_is_aritable(Arg, 4)) ? (GCallback)gxg_func4 : ((Xen_is_aritable(Arg, 3)) ? (GCallback)gxg_func3 : (GCallback)gxg_func2))
+#define Xen_to_C_lambda_data(Arg) (gpointer)gxg_ptr
+#define Xen_is_lambda_data(Arg) 1
+#define C_to_Xen_GtkTreeViewSearchPositionFunc(Arg) wrap_for_Xen(GtkTreeViewSearchPositionFunc, Arg)
+#define C_to_Xen_GtkTreeViewSearchEqualFunc(Arg) wrap_for_Xen(GtkTreeViewSearchEqualFunc, Arg)
+#define Xen_to_C_GdkFilterReturn(Arg) (GdkFilterReturn)Xen_integer_to_C_int(Arg)
+#define C_to_Xen_String(Arg) C_string_to_Xen_string((char *)Arg)
+static Xen C_to_Xen_GError_(GError *err)
{
if (err)
{
- XEN msg;
- msg = C_TO_XEN_STRING(err->message);
+ Xen msg;
+ msg = C_string_to_Xen_string(err->message);
g_error_free(err);
return(msg);
}
- return(XEN_FALSE);
+ return(Xen_false);
}
/* ---------------------------------------- types ---------------------------------------- */
-XM_TYPE_PTR(PangoFontDescription_, PangoFontDescription*)
-XM_TYPE_PTR(cairo_font_options_t_, cairo_font_options_t*)
-XM_TYPE_PTR(cairo_t_, cairo_t*)
-XM_TYPE_PTR_2(gboolean_, gboolean*)
-XM_TYPE_PTR(GdkEvent_, GdkEvent*)
-XM_TYPE_PTR_2(GdkEventAny_, GdkEventAny*)
-XM_TYPE_PTR_1(gdouble_, gdouble*)
-XM_TYPE_PTR_1(GtkColorSelectionDialog_, GtkColorSelectionDialog*)
-XM_TYPE_PTR_1(GdkEventMotion_, GdkEventMotion*)
-XM_TYPE_PTR(GtkAccelKey_, GtkAccelKey*)
-XM_TYPE_PTR(GClosure_, GClosure*)
-XM_TYPE_PTR(GtkWidget_, GtkWidget*)
-XM_TYPE_PTR_2(GdkXEvent_, GdkXEvent*)
-XM_TYPE_PTR(GdkEventKey_, GdkEventKey*)
-XM_TYPE_PTR(GtkMenu_, GtkMenu*)
-#define C_TO_XEN_gint(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_gint(Arg) (gint)(XEN_TO_C_INT(Arg))
-#define XEN_gint_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_gboolean(Arg) C_TO_XEN_BOOLEAN(Arg)
-#define XEN_TO_C_gboolean(Arg) (gboolean)(XEN_TO_C_BOOLEAN(Arg))
-#define XEN_gboolean_P(Arg) XEN_BOOLEAN_P(Arg)
-XM_TYPE_PTR(GtkTextTag_, GtkTextTag*)
-#define C_TO_XEN_gchar_(Arg) C_TO_XEN_String(Arg)
-#define XEN_TO_C_gchar_(Arg) (gchar*)(XEN_TO_C_String(Arg))
-#define XEN_gchar__P(Arg) XEN_String_P(Arg)
-#define C_TO_XEN_guint(Arg) C_TO_XEN_ULONG(Arg)
-#define XEN_TO_C_guint(Arg) (guint)(XEN_TO_C_ULONG(Arg))
-#define XEN_guint_P(Arg) XEN_ULONG_P(Arg)
-#define C_TO_XEN_GdkModifierType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GdkModifierType(Arg) (GdkModifierType)(XEN_TO_C_INT(Arg))
-#define XEN_GdkModifierType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkTreeModel_, GtkTreeModel*)
-XM_TYPE_PTR(GtkTreePath_, GtkTreePath*)
-XM_TYPE_PTR(GtkTreeIter_, GtkTreeIter*)
-XM_TYPE_PTR(GtkClipboard_, GtkClipboard*)
-XM_TYPE_PTR(GtkSelectionData_, GtkSelectionData*)
-XM_TYPE_PTR(GdkAtom_, GdkAtom*)
-#define C_TO_XEN_gunichar(Arg) C_TO_XEN_ULONG(Arg)
-#define XEN_TO_C_gunichar(Arg) (gunichar)(XEN_TO_C_ULONG(Arg))
-#define XEN_gunichar_P(Arg) XEN_ULONG_P(Arg)
-XM_TYPE_PTR(GtkTreeView_, GtkTreeView*)
-XM_TYPE_PTR(GtkTreeViewColumn_, GtkTreeViewColumn*)
-XM_TYPE_PTR(GtkCellRenderer_, GtkCellRenderer*)
-XM_TYPE_PTR(GtkTreeSelection_, GtkTreeSelection*)
-XM_TYPE_PTR(GtkFileFilterInfo_, GtkFileFilterInfo*)
-XM_TYPE_PTR(GtkEntryCompletion_, GtkEntryCompletion*)
-XM_TYPE_PTR(GtkIconView_, GtkIconView*)
-XM_TYPE_PTR(GdkPixbuf_, GdkPixbuf*)
-#define C_TO_XEN_GLogLevelFlags(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GLogLevelFlags(Arg) (GLogLevelFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GLogLevelFlags_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE(GdkAtom, GdkAtom)
-XM_TYPE_PTR_CONST(guint8_, guint8*)
-#define C_TO_XEN_gsize(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_gsize(Arg) (gsize)(XEN_TO_C_INT(Arg))
-#define XEN_gsize_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_CONST(GtkRecentFilterInfo_, GtkRecentFilterInfo*)
-XM_TYPE_PTR(GtkRecentInfo_, GtkRecentInfo*)
-#define C_TO_XEN_GType(Arg) C_TO_XEN_ULONG(Arg)
-#define XEN_TO_C_GType(Arg) (GType)(XEN_TO_C_ULONG(Arg))
-#define XEN_GType_P(Arg) XEN_ULONG_P(Arg)
-#define C_TO_XEN_GQuark(Arg) C_TO_XEN_ULONG(Arg)
-#define XEN_TO_C_GQuark(Arg) (GQuark)(XEN_TO_C_ULONG(Arg))
-#define XEN_GQuark_P(Arg) XEN_ULONG_P(Arg)
-XM_TYPE_PTR_1(GClosureNotify, GClosureNotify)
-#define XEN_TO_C_GSignalFlags(Arg) (GSignalFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GSignalFlags_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_1(GSignalAccumulator, GSignalAccumulator)
-XM_TYPE_PTR(gpointer, gpointer)
-XM_TYPE_1(GSignalCMarshaller, GSignalCMarshaller)
-XM_TYPE_PTR_1(GType_, GType*)
-XM_TYPE_PTR_1(GSignalQuery_, GSignalQuery*)
-XM_TYPE_PTR(guint_, guint*)
-XM_TYPE_PTR_2(GSignalInvocationHint_, GSignalInvocationHint*)
-#define C_TO_XEN_gulong(Arg) C_TO_XEN_ULONG(Arg)
-#define XEN_TO_C_gulong(Arg) (gulong)(XEN_TO_C_ULONG(Arg))
-#define XEN_gulong_P(Arg) XEN_ULONG_P(Arg)
-XM_TYPE_1(GSignalEmissionHook, GSignalEmissionHook)
-#define XEN_TO_C_GConnectFlags(Arg) (GConnectFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GConnectFlags_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_GSignalMatchType(Arg) (GSignalMatchType)(XEN_TO_C_INT(Arg))
-#define XEN_GSignalMatchType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GdkVisual_, GdkVisual*)
-XM_TYPE_PTR(GdkColor_, GdkColor*)
-XM_TYPE_PTR(GdkCursor_, GdkCursor*)
-#define C_TO_XEN_GdkCursorType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GdkCursorType(Arg) (GdkCursorType)(XEN_TO_C_INT(Arg))
-#define XEN_GdkCursorType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GdkDragContext_, GdkDragContext*)
-#define XEN_TO_C_GdkDragAction(Arg) (GdkDragAction)(XEN_TO_C_INT(Arg))
-#define XEN_GdkDragAction_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_guint32(Arg) C_TO_XEN_ULONG(Arg)
-#define XEN_TO_C_guint32(Arg) (guint32)(XEN_TO_C_ULONG(Arg))
-#define XEN_guint32_P(Arg) XEN_ULONG_P(Arg)
-XM_TYPE_PTR(GdkWindow_, GdkWindow*)
-XM_TYPE_PTR(GList_, GList*)
-#define C_TO_XEN_gdouble(Arg) C_TO_XEN_DOUBLE(Arg)
-#define XEN_TO_C_gdouble(Arg) (gdouble)(XEN_TO_C_DOUBLE(Arg))
-#define XEN_gdouble_P(Arg) XEN_NUMBER_P(Arg)
-XM_TYPE_PTR(gchar__, gchar**)
-#define C_TO_XEN_char_(Arg) C_TO_XEN_String(Arg)
-#define XEN_TO_C_char_(Arg) (char*)(XEN_TO_C_String(Arg))
-#define XEN_char__P(Arg) XEN_String_P(Arg)
-XM_TYPE_PTR_1(GdkRectangle_, GdkRectangle*)
-XM_TYPE_PTR(GdkKeymap_, GdkKeymap*)
-XM_TYPE_PTR(GdkKeymapKey_, GdkKeymapKey*)
-#define C_TO_XEN_PangoDirection(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoDirection(Arg) (PangoDirection)(XEN_TO_C_INT(Arg))
-#define XEN_PangoDirection_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(PangoContext_, PangoContext*)
-#define C_TO_XEN_guchar_(Arg) C_TO_XEN_String(Arg)
-#define XEN_TO_C_guchar_(Arg) (guchar*)(XEN_TO_C_String(Arg))
-#define XEN_guchar__P(Arg) XEN_String_P(Arg)
-#define XEN_TO_C_GdkPropMode(Arg) (GdkPropMode)(XEN_TO_C_INT(Arg))
-#define XEN_GdkPropMode_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GdkVisualType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GdkVisualType(Arg) (GdkVisualType)(XEN_TO_C_INT(Arg))
-#define XEN_GdkVisualType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(gint_, gint*)
-XM_TYPE_PTR_2(GdkVisualType_, GdkVisualType*)
-XM_TYPE_PTR_1(GdkWindowAttr_, GdkWindowAttr*)
-#define C_TO_XEN_GdkWindowType(Arg) C_TO_XEN_INT(Arg)
-#define C_TO_XEN_GdkWindowState(Arg) C_TO_XEN_INT(Arg)
-#define C_TO_XEN_GdkEventMask(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GdkEventMask(Arg) (GdkEventMask)(XEN_TO_C_INT(Arg))
-#define XEN_GdkEventMask_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GdkWMDecoration(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GdkWMDecoration(Arg) (GdkWMDecoration)(XEN_TO_C_INT(Arg))
-#define XEN_GdkWMDecoration_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_GdkWMFunction(Arg) (GdkWMFunction)(XEN_TO_C_INT(Arg))
-#define XEN_GdkWMFunction_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_GdkWindowEdge(Arg) (GdkWindowEdge)(XEN_TO_C_INT(Arg))
-#define XEN_GdkWindowEdge_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GdkGeometry_, GdkGeometry*)
-#define C_TO_XEN_GdkWindowTypeHint(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GdkWindowTypeHint(Arg) (GdkWindowTypeHint)(XEN_TO_C_INT(Arg))
-#define XEN_GdkWindowTypeHint_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_GdkWindowHints(Arg) (GdkWindowHints)(XEN_TO_C_INT(Arg))
-#define XEN_GdkWindowHints_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE(GdkColorspace, GdkColorspace)
-#define C_TO_XEN_int(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_int(Arg) (int)(XEN_TO_C_INT(Arg))
-#define XEN_int_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_1(GdkPixbufDestroyNotify, GdkPixbufDestroyNotify)
-XM_TYPE_PTR(char__, char**)
-#define C_TO_XEN_guchar(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_guchar(Arg) (guchar)(XEN_TO_C_INT(Arg))
-#define XEN_guchar_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_gfloat(Arg) C_TO_XEN_DOUBLE(Arg)
-#define XEN_TO_C_gfloat(Arg) (gfloat)(XEN_TO_C_DOUBLE(Arg))
-#define XEN_gfloat_P(Arg) XEN_NUMBER_P(Arg)
-#define C_TO_XEN_double(Arg) C_TO_XEN_DOUBLE(Arg)
-#define XEN_TO_C_double(Arg) (double)(XEN_TO_C_DOUBLE(Arg))
-#define XEN_double_P(Arg) XEN_NUMBER_P(Arg)
-#define XEN_TO_C_GdkInterpType(Arg) (GdkInterpType)(XEN_TO_C_INT(Arg))
-#define XEN_GdkInterpType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GdkPixbufAnimation_, GdkPixbufAnimation*)
-XM_TYPE_PTR(GdkPixbufAnimationIter_, GdkPixbufAnimationIter*)
-XM_TYPE_PTR_1(GTimeVal_, GTimeVal*)
-XM_TYPE_PTR(GtkAccelGroup_, GtkAccelGroup*)
-#define XEN_TO_C_GtkAccelFlags(Arg) (GtkAccelFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GtkAccelFlags_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GObject_, GObject*)
-XM_TYPE_PTR(GSList_, GSList*)
-XM_TYPE_PTR_2(GtkAccelGroupEntry_, GtkAccelGroupEntry*)
-XM_TYPE_PTR_1(GtkAccelLabel_, GtkAccelLabel*)
-XM_TYPE_PTR_1(GtkAccessible_, GtkAccessible*)
-XM_TYPE_PTR(GtkAdjustment_, GtkAdjustment*)
-XM_TYPE_PTR_1(GtkAlignment_, GtkAlignment*)
-#define XEN_TO_C_GtkArrowType(Arg) (GtkArrowType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkArrowType_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkShadowType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkShadowType(Arg) (GtkShadowType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkShadowType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkArrow_, GtkArrow*)
-XM_TYPE_PTR_1(GtkAspectFrame_, GtkAspectFrame*)
-#define C_TO_XEN_GtkButtonBoxStyle(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkButtonBoxStyle(Arg) (GtkButtonBoxStyle)(XEN_TO_C_INT(Arg))
-#define XEN_GtkButtonBoxStyle_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkButtonBox_, GtkButtonBox*)
-XM_TYPE_PTR(GtkBindingSet_, GtkBindingSet*)
-XM_TYPE_PTR_1(GtkBin_, GtkBin*)
-XM_TYPE_PTR_1(GtkBox_, GtkBox*)
-#define C_TO_XEN_GtkPackType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkPackType(Arg) (GtkPackType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkPackType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkButton_, GtkButton*)
-#define C_TO_XEN_GtkReliefStyle(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkReliefStyle(Arg) (GtkReliefStyle)(XEN_TO_C_INT(Arg))
-#define XEN_GtkReliefStyle_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkCalendar_, GtkCalendar*)
-XM_TYPE_PTR(GtkCellEditable_, GtkCellEditable*)
-#define XEN_TO_C_GtkCellRendererState(Arg) (GtkCellRendererState)(XEN_TO_C_INT(Arg))
-#define XEN_GtkCellRendererState_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkCellRendererText_, GtkCellRendererText*)
-XM_TYPE_PTR_1(GtkCellRendererToggle_, GtkCellRendererToggle*)
-XM_TYPE_PTR_1(GtkCheckMenuItem_, GtkCheckMenuItem*)
-XM_TYPE_PTR(GtkTargetEntry_, GtkTargetEntry*)
-XM_TYPE_PTR_1(GtkColorSelection_, GtkColorSelection*)
-#define C_TO_XEN_guint16(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_guint16(Arg) (guint16)(XEN_TO_C_INT(Arg))
-#define XEN_guint16_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkContainer_, GtkContainer*)
-#define C_TO_XEN_GtkResizeMode(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkResizeMode(Arg) (GtkResizeMode)(XEN_TO_C_INT(Arg))
-#define XEN_GtkResizeMode_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkWindow_, GtkWindow*)
-#define XEN_TO_C_GtkDialogFlags(Arg) (GtkDialogFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GtkDialogFlags_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_etc_P(Arg) (XEN_LIST_P(Arg))
-XM_TYPE_PTR_1(GtkDialog_, GtkDialog*)
-#define XEN_TO_C_GtkDestDefaults(Arg) (GtkDestDefaults)(XEN_TO_C_INT(Arg))
-#define XEN_GtkDestDefaults_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkTargetList_, GtkTargetList*)
-XM_TYPE_PTR_1(GtkEditable_, GtkEditable*)
-XM_TYPE_PTR(GtkEntry_, GtkEntry*)
-XM_TYPE_PTR(PangoLayout_, PangoLayout*)
-XM_TYPE_PTR_1(GtkFixed_, GtkFixed*)
-XM_TYPE_PTR_1(GtkFontSelection_, GtkFontSelection*)
-XM_TYPE_PTR_1(GtkFontSelectionDialog_, GtkFontSelectionDialog*)
-XM_TYPE_PTR_1(GtkFrame_, GtkFrame*)
-XM_TYPE_PTR_1(GtkHandleBox_, GtkHandleBox*)
-#define C_TO_XEN_GtkPositionType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkPositionType(Arg) (GtkPositionType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkPositionType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkIconFactory_, GtkIconFactory*)
-XM_TYPE_PTR(GtkIconSet_, GtkIconSet*)
-#define C_TO_XEN_GtkIconSize(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkIconSize(Arg) (GtkIconSize)(XEN_TO_C_INT(Arg))
-#define XEN_GtkIconSize_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkIconSource_, GtkIconSource*)
-XM_TYPE_PTR_2(GtkIconSize_, GtkIconSize*)
-#define C_TO_XEN_GtkTextDirection(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkTextDirection(Arg) (GtkTextDirection)(XEN_TO_C_INT(Arg))
-#define XEN_GtkTextDirection_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkStateType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkStateType(Arg) (GtkStateType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkStateType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkImage_, GtkImage*)
-#define C_TO_XEN_GtkImageType(Arg) C_TO_XEN_INT(Arg)
-XM_TYPE_PTR_1(GtkImageMenuItem_, GtkImageMenuItem*)
-XM_TYPE_PTR(GtkIMContext_, GtkIMContext*)
-XM_TYPE_PTR(PangoAttrList_, PangoAttrList*)
-XM_TYPE_PTR_1(GtkIMContextSimple_, GtkIMContextSimple*)
-XM_TYPE_PTR_1(guint16_, guint16*)
-XM_TYPE_PTR_1(GtkIMMulticontext_, GtkIMMulticontext*)
-XM_TYPE_PTR_1(GtkMenuShell_, GtkMenuShell*)
-XM_TYPE_PTR_1(GtkLabel_, GtkLabel*)
-#define C_TO_XEN_GtkJustification(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkJustification(Arg) (GtkJustification)(XEN_TO_C_INT(Arg))
-#define XEN_GtkJustification_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkLayout_, GtkLayout*)
-XM_TYPE_PTR(GtkListStore_, GtkListStore*)
-XM_TYPE_PTR(PangoLanguage_, PangoLanguage*)
-XM_TYPE_PTR_1(GtkMenuItem_, GtkMenuItem*)
-XM_TYPE_PTR_1(GtkMisc_, GtkMisc*)
-XM_TYPE_PTR_1(GtkNotebook_, GtkNotebook*)
-XM_TYPE_PTR_1(GtkPaned_, GtkPaned*)
-XM_TYPE_PTR_1(GtkProgressBar_, GtkProgressBar*)
-XM_TYPE_PTR_1(GtkRadioButton_, GtkRadioButton*)
-XM_TYPE_PTR_1(GtkRadioMenuItem_, GtkRadioMenuItem*)
-XM_TYPE_PTR_1(GtkRange_, GtkRange*)
-XM_TYPE_PTR_1(GtkScale_, GtkScale*)
-XM_TYPE_PTR_1(GtkScrolledWindow_, GtkScrolledWindow*)
-#define C_TO_XEN_GtkPolicyType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkPolicyType(Arg) (GtkPolicyType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkPolicyType_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkCornerType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkCornerType(Arg) (GtkCornerType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkCornerType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkSizeGroup_, GtkSizeGroup*)
-#define C_TO_XEN_GtkSizeGroupMode(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkSizeGroupMode(Arg) (GtkSizeGroupMode)(XEN_TO_C_INT(Arg))
-#define XEN_GtkSizeGroupMode_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkSpinButton_, GtkSpinButton*)
-#define C_TO_XEN_GtkSpinButtonUpdatePolicy(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkSpinButtonUpdatePolicy(Arg) (GtkSpinButtonUpdatePolicy)(XEN_TO_C_INT(Arg))
-#define XEN_GtkSpinButtonUpdatePolicy_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_GtkSpinType(Arg) (GtkSpinType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkSpinType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkStatusbar_, GtkStatusbar*)
-XM_TYPE_PTR(GtkStockItem_, GtkStockItem*)
-XM_TYPE_PTR_1(GtkTable_, GtkTable*)
-#define XEN_TO_C_GtkAttachOptions(Arg) (GtkAttachOptions)(XEN_TO_C_INT(Arg))
-#define XEN_GtkAttachOptions_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkTextBuffer_, GtkTextBuffer*)
-XM_TYPE_PTR(GtkTextTagTable_, GtkTextTagTable*)
-XM_TYPE_PTR(GtkTextIter_, GtkTextIter*)
-XM_TYPE_PTR(GtkTextChildAnchor_, GtkTextChildAnchor*)
-XM_TYPE_PTR(GtkTextMark_, GtkTextMark*)
-XM_TYPE_PTR(GtkTextAttributes_, GtkTextAttributes*)
-#define XEN_TO_C_GtkTextSearchFlags(Arg) (GtkTextSearchFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GtkTextSearchFlags_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkTextView_, GtkTextView*)
-#define C_TO_XEN_GtkTextWindowType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkTextWindowType(Arg) (GtkTextWindowType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkTextWindowType_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkWrapMode(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkWrapMode(Arg) (GtkWrapMode)(XEN_TO_C_INT(Arg))
-#define XEN_GtkWrapMode_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(PangoTabArray_, PangoTabArray*)
-XM_TYPE_PTR_1(GtkToggleButton_, GtkToggleButton*)
-XM_TYPE_PTR_1(GtkToolbar_, GtkToolbar*)
-#define C_TO_XEN_GtkToolbarStyle(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkToolbarStyle(Arg) (GtkToolbarStyle)(XEN_TO_C_INT(Arg))
-#define XEN_GtkToolbarStyle_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkTreeDragSource_, GtkTreeDragSource*)
-XM_TYPE_PTR_1(GtkTreeDragDest_, GtkTreeDragDest*)
-XM_TYPE_PTR(GtkTreeRowReference_, GtkTreeRowReference*)
-#define C_TO_XEN_GtkTreeModelFlags(Arg) C_TO_XEN_INT(Arg)
-XM_TYPE_PTR_1(GtkTreeModelSort_, GtkTreeModelSort*)
-#define C_TO_XEN_GtkSelectionMode(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkSelectionMode(Arg) (GtkSelectionMode)(XEN_TO_C_INT(Arg))
-#define XEN_GtkSelectionMode_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkTreeModel__, GtkTreeModel**)
-XM_TYPE_PTR_1(GtkTreeSortable_, GtkTreeSortable*)
-#define C_TO_XEN_GtkSortType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkSortType(Arg) (GtkSortType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkSortType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkTreeStore_, GtkTreeStore*)
-#define C_TO_XEN_GtkTreeViewColumnSizing(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkTreeViewColumnSizing(Arg) (GtkTreeViewColumnSizing)(XEN_TO_C_INT(Arg))
-#define XEN_GtkTreeViewColumnSizing_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkTreeViewDropPosition(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkTreeViewDropPosition(Arg) (GtkTreeViewDropPosition)(XEN_TO_C_INT(Arg))
-#define XEN_GtkTreeViewDropPosition_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkViewport_, GtkViewport*)
-XM_TYPE_PTR_1(GtkAllocation_, GtkAllocation*)
-#define XEN_TO_C_GtkDirectionType(Arg) (GtkDirectionType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkDirectionType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_2(AtkObject_, AtkObject*)
-#define C_TO_XEN_GtkWindowType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkWindowType(Arg) (GtkWindowType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkWindowType_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_GtkWindowPosition(Arg) (GtkWindowPosition)(XEN_TO_C_INT(Arg))
-#define XEN_GtkWindowPosition_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GdkGravity(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GdkGravity(Arg) (GdkGravity)(XEN_TO_C_INT(Arg))
-#define XEN_GdkGravity_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(PangoColor_, PangoColor*)
-#define C_TO_XEN_PangoAttrType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoAttrType(Arg) (PangoAttrType)(XEN_TO_C_INT(Arg))
-#define XEN_PangoAttrType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(PangoAttribute_, PangoAttribute*)
-#define C_TO_XEN_PangoStyle(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoStyle(Arg) (PangoStyle)(XEN_TO_C_INT(Arg))
-#define XEN_PangoStyle_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_PangoWeight(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoWeight(Arg) (PangoWeight)(XEN_TO_C_INT(Arg))
-#define XEN_PangoWeight_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_PangoVariant(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoVariant(Arg) (PangoVariant)(XEN_TO_C_INT(Arg))
-#define XEN_PangoVariant_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_PangoStretch(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoStretch(Arg) (PangoStretch)(XEN_TO_C_INT(Arg))
-#define XEN_PangoStretch_P(Arg) XEN_INTEGER_P(Arg)
-#define XEN_TO_C_PangoUnderline(Arg) (PangoUnderline)(XEN_TO_C_INT(Arg))
-#define XEN_PangoUnderline_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(PangoRectangle_, PangoRectangle*)
-XM_TYPE_PTR(PangoAttrIterator_, PangoAttrIterator*)
-XM_TYPE_PTR_1(PangoAttrList__, PangoAttrList**)
-XM_TYPE_PTR_1(gunichar_, gunichar*)
-XM_TYPE_PTR_1(PangoAnalysis_, PangoAnalysis*)
-XM_TYPE_PTR(PangoLogAttr_, PangoLogAttr*)
-XM_TYPE_PTR_2(PangoFontFamily__, PangoFontFamily**)
-XM_TYPE_PTR(PangoFont_, PangoFont*)
-XM_TYPE_PTR_2(PangoFontset_, PangoFontset*)
-XM_TYPE_PTR(PangoFontMetrics_, PangoFontMetrics*)
-XM_TYPE_PTR(PangoCoverage_, PangoCoverage*)
-#define C_TO_XEN_PangoCoverageLevel(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoCoverageLevel(Arg) (PangoCoverageLevel)(XEN_TO_C_INT(Arg))
-#define XEN_PangoCoverageLevel_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(PangoFontDescription__, PangoFontDescription**)
-#define C_TO_XEN_PangoFontMask(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoFontMask(Arg) (PangoFontMask)(XEN_TO_C_INT(Arg))
-#define XEN_PangoFontMask_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(PangoFontFamily_, PangoFontFamily*)
-XM_TYPE_PTR_2(PangoFontFace__, PangoFontFace**)
-XM_TYPE_PTR(PangoFontFace_, PangoFontFace*)
-#define XEN_TO_C_PangoGlyph(Arg) (PangoGlyph)(XEN_TO_C_ULONG(Arg))
-#define XEN_PangoGlyph_P(Arg) XEN_ULONG_P(Arg)
-XM_TYPE_PTR_1(PangoFontMap_, PangoFontMap*)
-XM_TYPE_PTR(PangoGlyphString_, PangoGlyphString*)
-XM_TYPE_PTR(PangoItem_, PangoItem*)
-#define C_TO_XEN_PangoWrapMode(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoWrapMode(Arg) (PangoWrapMode)(XEN_TO_C_INT(Arg))
-#define XEN_PangoWrapMode_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_PangoAlignment(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoAlignment(Arg) (PangoAlignment)(XEN_TO_C_INT(Arg))
-#define XEN_PangoAlignment_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(int_, int*)
-XM_TYPE_PTR(PangoLayoutLine_, PangoLayoutLine*)
-XM_TYPE_PTR(PangoLayoutIter_, PangoLayoutIter*)
-XM_TYPE_PTR_2(PangoLayoutRun_, PangoLayoutRun*)
-#define XEN_TO_C_gssize(Arg) (gssize)(XEN_TO_C_INT(Arg))
-#define XEN_gssize_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GdkDisplay_, GdkDisplay*)
-XM_TYPE_PTR(GdkScreen_, GdkScreen*)
-#define C_TO_XEN_GtkCalendarDisplayOptions(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkCalendarDisplayOptions(Arg) (GtkCalendarDisplayOptions)(XEN_TO_C_INT(Arg))
-#define XEN_GtkCalendarDisplayOptions_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkEventBox_, GtkEventBox*)
-XM_TYPE_PTR(GtkToolItem_, GtkToolItem*)
-#define C_TO_XEN_GtkFileChooserAction(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkFileChooserAction(Arg) (GtkFileChooserAction)(XEN_TO_C_INT(Arg))
-#define XEN_GtkFileChooserAction_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkTreeModelFilter_, GtkTreeModelFilter*)
-XM_TYPE_PTR(GtkAction_, GtkAction*)
-XM_TYPE_PTR(GtkActionGroup_, GtkActionGroup*)
-XM_TYPE_PTR_1(GtkActionEntry_, GtkActionEntry*)
-XM_TYPE_PTR_1(GtkToggleActionEntry_, GtkToggleActionEntry*)
-XM_TYPE_PTR_1(GtkComboBox_, GtkComboBox*)
-XM_TYPE_PTR_1(GtkExpander_, GtkExpander*)
-XM_TYPE_PTR_1(GtkFontButton_, GtkFontButton*)
-XM_TYPE_PTR_1(GtkColorButton_, GtkColorButton*)
-XM_TYPE_PTR_1(GtkRadioToolButton_, GtkRadioToolButton*)
-XM_TYPE_PTR(GtkRadioAction_, GtkRadioAction*)
-XM_TYPE_PTR_1(GtkSeparatorToolItem_, GtkSeparatorToolItem*)
-XM_TYPE_PTR(GtkToggleAction_, GtkToggleAction*)
-XM_TYPE_PTR_1(GtkToggleToolButton_, GtkToggleToolButton*)
-XM_TYPE_PTR(GtkFileFilter_, GtkFileFilter*)
-#define C_TO_XEN_GtkFileFilterFlags(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkFileFilterFlags(Arg) (GtkFileFilterFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GtkFileFilterFlags_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkCellLayout_, GtkCellLayout*)
-XM_TYPE_1(GtkCellLayoutDataFunc, GtkCellLayoutDataFunc)
-XM_TYPE_PTR_1(GtkFileChooser_, GtkFileChooser*)
-XM_TYPE_PTR(GtkIconTheme_, GtkIconTheme*)
-XM_TYPE_PTR(GtkIconInfo_, GtkIconInfo*)
-#define XEN_TO_C_GtkIconLookupFlags(Arg) (GtkIconLookupFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GtkIconLookupFlags_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkToolButton_, GtkToolButton*)
-#define C_TO_XEN_GtkOrientation(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkOrientation(Arg) (GtkOrientation)(XEN_TO_C_INT(Arg))
-#define XEN_GtkOrientation_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_2(GtkAccelMap_, GtkAccelMap*)
-XM_TYPE_PTR_1(GtkCellView_, GtkCellView*)
-XM_TYPE_PTR_1(GtkAboutDialog_, GtkAboutDialog*)
-#define C_TO_XEN_PangoEllipsizeMode(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_PangoEllipsizeMode(Arg) (PangoEllipsizeMode)(XEN_TO_C_INT(Arg))
-#define XEN_PangoEllipsizeMode_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_1(PangoAttrFilterFunc, PangoAttrFilterFunc)
-#define C_TO_XEN_PangoScript(Arg) C_TO_XEN_INT(Arg)
-XM_TYPE_PTR(PangoScriptIter_, PangoScriptIter*)
-XM_TYPE_PTR_1(GtkFileChooserButton_, GtkFileChooserButton*)
-XM_TYPE_PTR_1(GtkMenuToolButton_, GtkMenuToolButton*)
-XM_TYPE_PTR_1(PangoRenderer_, PangoRenderer*)
-XM_TYPE_1(PangoRenderPart, PangoRenderPart)
-XM_TYPE_PTR_1(PangoMatrix_, PangoMatrix*)
-XM_TYPE_PTR_1(GValue_, GValue*)
-#define C_TO_XEN_GtkIconViewDropPosition(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkIconViewDropPosition(Arg) (GtkIconViewDropPosition)(XEN_TO_C_INT(Arg))
-#define XEN_GtkIconViewDropPosition_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkPackDirection(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkPackDirection(Arg) (GtkPackDirection)(XEN_TO_C_INT(Arg))
-#define XEN_GtkPackDirection_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkMenuBar_, GtkMenuBar*)
-#define C_TO_XEN_GtkSensitivityType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkSensitivityType(Arg) (GtkSensitivityType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkSensitivityType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_1(GDestroyNotify, GDestroyNotify)
-XM_TYPE_PTR_1(GtkAssistant_, GtkAssistant*)
-#define C_TO_XEN_GtkAssistantPageType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkAssistantPageType(Arg) (GtkAssistantPageType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkAssistantPageType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkLinkButton_, GtkLinkButton*)
-XM_TYPE_PTR_1(GtkRecentChooser_, GtkRecentChooser*)
-#define C_TO_XEN_GtkRecentSortType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkRecentSortType(Arg) (GtkRecentSortType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkRecentSortType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkRecentFilter_, GtkRecentFilter*)
-XM_TYPE_PTR(GtkRecentManager_, GtkRecentManager*)
-XM_TYPE_PTR_1(GtkRecentChooserMenu_, GtkRecentChooserMenu*)
-#define C_TO_XEN_GtkRecentFilterFlags(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkRecentFilterFlags(Arg) (GtkRecentFilterFlags)(XEN_TO_C_INT(Arg))
-#define XEN_GtkRecentFilterFlags_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_NO_P_2(time_t, time_t)
-XM_TYPE_PTR(GtkStatusIcon_, GtkStatusIcon*)
-XM_TYPE_1(GtkTextBufferSerializeFunc, GtkTextBufferSerializeFunc)
-XM_TYPE_1(GtkTextBufferDeserializeFunc, GtkTextBufferDeserializeFunc)
-XM_TYPE_PTR_1(GtkRecentData_, GtkRecentData*)
-#define C_TO_XEN_GtkTreeViewGridLines(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkTreeViewGridLines(Arg) (GtkTreeViewGridLines)(XEN_TO_C_INT(Arg))
-#define XEN_GtkTreeViewGridLines_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkPrintContext_, GtkPrintContext*)
-XM_TYPE_PTR(GtkPageSetup_, GtkPageSetup*)
-XM_TYPE_PTR(GtkPrintOperation_, GtkPrintOperation*)
-XM_TYPE_PTR(GtkPrintSettings_, GtkPrintSettings*)
-XM_TYPE_1(GtkUnit, GtkUnit)
-#define C_TO_XEN_GtkPrintOperationResult(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkPrintOperationAction(Arg) (GtkPrintOperationAction)(XEN_TO_C_INT(Arg))
-#define XEN_GtkPrintOperationAction_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkPrintStatus(Arg) C_TO_XEN_INT(Arg)
-XM_TYPE_1(GtkPageSetupDoneFunc, GtkPageSetupDoneFunc)
-XM_TYPE_PTR_1(GtkPrintOperationPreview_, GtkPrintOperationPreview*)
-XM_TYPE_1(GtkPrintSettingsFunc, GtkPrintSettingsFunc)
-XM_TYPE(GtkPageOrientation, GtkPageOrientation)
-XM_TYPE_PTR(GtkPaperSize_, GtkPaperSize*)
-XM_TYPE(GtkPrintDuplex, GtkPrintDuplex)
-XM_TYPE(GtkPrintQuality, GtkPrintQuality)
-XM_TYPE(GtkPrintPages, GtkPrintPages)
-XM_TYPE_PTR(GtkPageRange_, GtkPageRange*)
-XM_TYPE(GtkPageSet, GtkPageSet)
-XM_TYPE_PTR_2(GtkSettings_, GtkSettings*)
-XM_TYPE_PTR_1(GtkTooltip_, GtkTooltip*)
-#if HAVE_GTK_TEST_WIDGET_CLICK
-XM_TYPE_1(GtkCalendarDetailFunc, GtkCalendarDetailFunc)
+Xm_type_Ptr(PangoFontDescription_, PangoFontDescription*)
+Xm_type_Ptr(cairo_font_options_t_, cairo_font_options_t*)
+Xm_type_Ptr(cairo_t_, cairo_t*)
+Xm_type_Ptr_2(gboolean_, gboolean*)
+Xm_type_Ptr(GdkEvent_, GdkEvent*)
+Xm_type_Ptr_2(GdkEventAny_, GdkEventAny*)
+Xm_type_Ptr_1(gdouble_, gdouble*)
+Xm_type_Ptr_1(GdkEventMotion_, GdkEventMotion*)
+Xm_type_Ptr(GtkAccelKey_, GtkAccelKey*)
+Xm_type_Ptr(GClosure_, GClosure*)
+Xm_type_Ptr(GtkWidget_, GtkWidget*)
+Xm_type_Ptr_2(GdkXEvent_, GdkXEvent*)
+Xm_type_Ptr(GtkMenu_, GtkMenu*)
+#define C_to_Xen_gint(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_gint(Arg) (gint)(Xen_integer_to_C_int(Arg))
+#define Xen_is_gint(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_gboolean(Arg) C_bool_to_Xen_boolean(Arg)
+#define Xen_to_C_gboolean(Arg) (gboolean)(Xen_boolean_to_C_bool(Arg))
+#define Xen_is_gboolean(Arg) Xen_is_boolean(Arg)
+Xm_type_Ptr(GtkTextTag_, GtkTextTag*)
+#define C_to_Xen_gchar_(Arg) C_string_to_Xen_string(Arg)
+#define Xen_to_C_gchar_(Arg) (gchar*)(Xen_string_to_C_string(Arg))
+#define Xen_is_gchar_(Arg) Xen_is_string(Arg)
+#define C_to_Xen_guint(Arg) C_ulong_to_Xen_ulong(Arg)
+#define Xen_to_C_guint(Arg) (guint)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_guint(Arg) Xen_is_ulong(Arg)
+#define C_to_Xen_GdkModifierType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkModifierType(Arg) (GdkModifierType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkModifierType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkTreeModel_, GtkTreeModel*)
+Xm_type_Ptr(GtkTreePath_, GtkTreePath*)
+Xm_type_Ptr(GtkTreeIter_, GtkTreeIter*)
+Xm_type_Ptr(GtkClipboard_, GtkClipboard*)
+Xm_type_Ptr(GtkSelectionData_, GtkSelectionData*)
+Xm_type_Ptr(GdkAtom_, GdkAtom*)
+#define C_to_Xen_gunichar(Arg) C_ulong_to_Xen_ulong(Arg)
+#define Xen_to_C_gunichar(Arg) (gunichar)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_gunichar(Arg) Xen_is_ulong(Arg)
+Xm_type_Ptr(GtkTreeView_, GtkTreeView*)
+Xm_type_Ptr(GtkTreeViewColumn_, GtkTreeViewColumn*)
+Xm_type_Ptr(GtkCellRenderer_, GtkCellRenderer*)
+Xm_type_Ptr(GtkTreeSelection_, GtkTreeSelection*)
+Xm_type_Ptr(GtkFileFilterInfo_, GtkFileFilterInfo*)
+Xm_type_Ptr(GtkEntryCompletion_, GtkEntryCompletion*)
+Xm_type_Ptr(GtkIconView_, GtkIconView*)
+Xm_type_Ptr(GdkPixbuf_, GdkPixbuf*)
+#define C_to_Xen_GLogLevelFlags(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GLogLevelFlags(Arg) (GLogLevelFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GLogLevelFlags(Arg) Xen_is_integer(Arg)
+Xm_type(GdkAtom, GdkAtom)
+Xm_type_Ptr_const(guint8_, guint8*)
+#define C_to_Xen_gsize(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_gsize(Arg) (gsize)(Xen_integer_to_C_int(Arg))
+#define Xen_is_gsize(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkRecentInfo_, GtkRecentInfo*)
+#define Xen_to_C_gunichar_(Arg) (gunichar*)(Xen_string_to_C_string(Arg))
+#define Xen_is_gunichar_(Arg) Xen_is_string(Arg)
+#define Xen_to_C_gssize(Arg) (gssize)(Xen_integer_to_C_int(Arg))
+#define Xen_is_gssize(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_glong(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GNormalizeMode(Arg) (GNormalizeMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GNormalizeMode(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GClosureNotify, GClosureNotify)
+#define C_to_Xen_GType(Arg) C_ulong_to_Xen_ulong(Arg)
+#define Xen_to_C_GType(Arg) (GType)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_GType(Arg) Xen_is_ulong(Arg)
+#define Xen_to_C_GSignalFlags(Arg) (GSignalFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GSignalFlags(Arg) Xen_is_integer(Arg)
+Xm_type_1(GSignalAccumulator, GSignalAccumulator)
+Xm_type_Ptr(gpointer, gpointer)
+Xm_type_1(GSignalCMarshaller, GSignalCMarshaller)
+Xm_type_Ptr_1(GType_, GType*)
+Xm_type_Ptr_1(GSignalQuery_, GSignalQuery*)
+Xm_type_Ptr(guint_, guint*)
+#define C_to_Xen_GQuark(Arg) C_ulong_to_Xen_ulong(Arg)
+#define Xen_to_C_GQuark(Arg) (GQuark)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_GQuark(Arg) Xen_is_ulong(Arg)
+Xm_type_Ptr_2(GSignalInvocationHint_, GSignalInvocationHint*)
+#define C_to_Xen_gulong(Arg) C_ulong_to_Xen_ulong(Arg)
+#define Xen_to_C_gulong(Arg) (gulong)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_gulong(Arg) Xen_is_ulong(Arg)
+Xm_type_1(GSignalEmissionHook, GSignalEmissionHook)
+#define Xen_to_C_GConnectFlags(Arg) (GConnectFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GConnectFlags(Arg) Xen_is_integer(Arg)
+#define Xen_to_C_GSignalMatchType(Arg) (GSignalMatchType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GSignalMatchType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GdkVisual_, GdkVisual*)
+Xm_type_Ptr(GdkCursor_, GdkCursor*)
+Xm_type_Ptr(GdkDisplay_, GdkDisplay*)
+#define C_to_Xen_GdkCursorType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkCursorType(Arg) (GdkCursorType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkCursorType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GdkDragContext_, GdkDragContext*)
+#define Xen_to_C_GdkDragAction(Arg) (GdkDragAction)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkDragAction(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_guint32(Arg) C_ulong_to_Xen_ulong(Arg)
+#define Xen_to_C_guint32(Arg) (guint32)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_guint32(Arg) Xen_is_ulong(Arg)
+Xm_type_Ptr(GdkWindow_, GdkWindow*)
+Xm_type_Ptr(GList_, GList*)
+#define C_to_Xen_gdouble(Arg) C_double_to_Xen_real(Arg)
+#define Xen_to_C_gdouble(Arg) (gdouble)(Xen_real_to_C_double(Arg))
+#define Xen_is_gdouble(Arg) Xen_is_number(Arg)
+Xm_type_Ptr(gchar__, gchar**)
+#define C_to_Xen_char_(Arg) C_string_to_Xen_string(Arg)
+#define Xen_to_C_char_(Arg) (char*)(Xen_string_to_C_string(Arg))
+#define Xen_is_char_(Arg) Xen_is_string(Arg)
+Xm_type_Ptr_1(GdkRectangle_, GdkRectangle*)
+Xm_type_Ptr(GdkKeymap_, GdkKeymap*)
+Xm_type_Ptr(GdkKeymapKey_, GdkKeymapKey*)
+#define C_to_Xen_PangoDirection(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoDirection(Arg) (PangoDirection)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoDirection(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(PangoContext_, PangoContext*)
+#define C_to_Xen_guchar_(Arg) C_to_Xen_String(Arg)
+#define Xen_to_C_guchar_(Arg) (guchar*)(Xen_string_to_C_string(Arg))
+#define Xen_is_guchar_(Arg) Xen_is_string(Arg)
+#define Xen_to_C_GdkPropMode(Arg) (GdkPropMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkPropMode(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GdkVisualType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkVisualType(Arg) (GdkVisualType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkVisualType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(gint_, gint*)
+Xm_type_Ptr_2(GdkVisualType_, GdkVisualType*)
+Xm_type_Ptr_1(GdkWindowAttr_, GdkWindowAttr*)
+#define C_to_Xen_GdkWindowType(Arg) C_int_to_Xen_integer(Arg)
+#define C_to_Xen_GdkWindowState(Arg) C_int_to_Xen_integer(Arg)
+#define C_to_Xen_GdkEventMask(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkEventMask(Arg) (GdkEventMask)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkEventMask(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GdkWMDecoration(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkWMDecoration(Arg) (GdkWMDecoration)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkWMDecoration(Arg) Xen_is_integer(Arg)
+#define Xen_to_C_GdkWMFunction(Arg) (GdkWMFunction)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkWMFunction(Arg) Xen_is_integer(Arg)
+#define Xen_to_C_GdkWindowEdge(Arg) (GdkWindowEdge)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkWindowEdge(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GdkGeometry_, GdkGeometry*)
+#define Xen_to_C_GdkWindowHints(Arg) (GdkWindowHints)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkWindowHints(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GdkWindowTypeHint(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkWindowTypeHint(Arg) (GdkWindowTypeHint)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkWindowTypeHint(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GdkColorspace(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkColorspace(Arg) (GdkColorspace)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkColorspace(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_int(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_int(Arg) (int)(Xen_integer_to_C_int(Arg))
+#define Xen_is_int(Arg) Xen_is_integer(Arg)
+Xm_type_1(GdkPixbufDestroyNotify, GdkPixbufDestroyNotify)
+Xm_type_Ptr(char__, char**)
+#define C_to_Xen_guchar(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_guchar(Arg) (guchar)(Xen_integer_to_C_int(Arg))
+#define Xen_is_guchar(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_gfloat(Arg) C_double_to_Xen_real(Arg)
+#define Xen_to_C_gfloat(Arg) (gfloat)(Xen_real_to_C_double(Arg))
+#define Xen_is_gfloat(Arg) Xen_is_number(Arg)
+#define C_to_Xen_double(Arg) C_double_to_Xen_real(Arg)
+#define Xen_to_C_double(Arg) (double)(Xen_real_to_C_double(Arg))
+#define Xen_to_C_GdkInterpType(Arg) (GdkInterpType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkInterpType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GdkPixbufAnimation_, GdkPixbufAnimation*)
+Xm_type_Ptr(GdkPixbufAnimationIter_, GdkPixbufAnimationIter*)
+Xm_type_Ptr_1(GTimeVal_, GTimeVal*)
+Xm_type_Ptr(GtkAccelGroup_, GtkAccelGroup*)
+#define Xen_to_C_GtkAccelFlags(Arg) (GtkAccelFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkAccelFlags(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GObject_, GObject*)
+Xm_type_Ptr(GSList_, GSList*)
+Xm_type_Ptr_2(GtkAccelGroupEntry_, GtkAccelGroupEntry*)
+Xm_type_Ptr_1(GtkAccelLabel_, GtkAccelLabel*)
+Xm_type_Ptr(GtkAdjustment_, GtkAdjustment*)
+Xm_type_Ptr_1(GtkAspectFrame_, GtkAspectFrame*)
+#define C_to_Xen_GtkButtonBoxStyle(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkButtonBoxStyle(Arg) (GtkButtonBoxStyle)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkButtonBoxStyle(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkButtonBox_, GtkButtonBox*)
+Xm_type_Ptr(GtkBindingSet_, GtkBindingSet*)
+Xm_type_Ptr_1(GtkBin_, GtkBin*)
+Xm_type_Ptr_1(GtkBox_, GtkBox*)
+#define C_to_Xen_GtkPackType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkPackType(Arg) (GtkPackType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkPackType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkButton_, GtkButton*)
+#define C_to_Xen_GtkReliefStyle(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkReliefStyle(Arg) (GtkReliefStyle)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkReliefStyle(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkCalendar_, GtkCalendar*)
+Xm_type_Ptr(GtkCellEditable_, GtkCellEditable*)
+#define Xen_to_C_GtkCellRendererState(Arg) (GtkCellRendererState)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkCellRendererState(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkCellRendererText_, GtkCellRendererText*)
+Xm_type_Ptr_1(GtkCellRendererToggle_, GtkCellRendererToggle*)
+Xm_type_Ptr_1(GtkCheckMenuItem_, GtkCheckMenuItem*)
+Xm_type_Ptr(GtkTargetEntry_, GtkTargetEntry*)
+Xm_type_Ptr_1(GtkContainer_, GtkContainer*)
+Xm_type_Ptr_1(GtkDialog_, GtkDialog*)
+#define Xen_is_etc(Arg) (Xen_is_list(Arg))
+#define Xen_to_C_GtkDestDefaults(Arg) (GtkDestDefaults)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkDestDefaults(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkTargetList_, GtkTargetList*)
+Xm_type_Ptr_1(GtkEditable_, GtkEditable*)
+Xm_type_Ptr(GtkEntry_, GtkEntry*)
+Xm_type_Ptr(PangoLayout_, PangoLayout*)
+Xm_type_Ptr_1(GtkFixed_, GtkFixed*)
+Xm_type_Ptr_1(GtkFrame_, GtkFrame*)
+#define C_to_Xen_GtkShadowType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkShadowType(Arg) (GtkShadowType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkShadowType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkImage_, GtkImage*)
+#define C_to_Xen_GtkImageType(Arg) C_int_to_Xen_integer(Arg)
+Xm_type_Ptr(GtkIMContext_, GtkIMContext*)
+Xm_type_Ptr(PangoAttrList_, PangoAttrList*)
+Xm_type_Ptr_1(GdkEventKey_, GdkEventKey*)
+Xm_type_Ptr_1(GtkIMContextSimple_, GtkIMContextSimple*)
+Xm_type_Ptr_1(guint16_, guint16*)
+Xm_type_Ptr_1(GtkLabel_, GtkLabel*)
+#define C_to_Xen_GtkJustification(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkJustification(Arg) (GtkJustification)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkJustification(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkLayout_, GtkLayout*)
+Xm_type_Ptr(GtkListStore_, GtkListStore*)
+Xm_type_Ptr(PangoLanguage_, PangoLanguage*)
+Xm_type_Ptr_1(GtkMenuItem_, GtkMenuItem*)
+Xm_type_Ptr_1(GtkMenuShell_, GtkMenuShell*)
+Xm_type_Ptr_1(GtkNotebook_, GtkNotebook*)
+#define C_to_Xen_GtkPositionType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkPositionType(Arg) (GtkPositionType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkPositionType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkPaned_, GtkPaned*)
+Xm_type_Ptr_1(GtkProgressBar_, GtkProgressBar*)
+Xm_type_Ptr_1(GtkRadioButton_, GtkRadioButton*)
+Xm_type_Ptr_1(GtkRadioMenuItem_, GtkRadioMenuItem*)
+Xm_type_Ptr_1(GtkRange_, GtkRange*)
+Xm_type_Ptr_1(GtkScale_, GtkScale*)
+Xm_type_Ptr_1(GtkScrolledWindow_, GtkScrolledWindow*)
+#define C_to_Xen_GtkPolicyType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkPolicyType(Arg) (GtkPolicyType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkPolicyType(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GtkCornerType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkCornerType(Arg) (GtkCornerType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkCornerType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_2(GtkSettings_, GtkSettings*)
+Xm_type_Ptr(GtkSizeGroup_, GtkSizeGroup*)
+#define C_to_Xen_GtkSizeGroupMode(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkSizeGroupMode(Arg) (GtkSizeGroupMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkSizeGroupMode(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkSpinButton_, GtkSpinButton*)
+#define C_to_Xen_GtkSpinButtonUpdatePolicy(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkSpinButtonUpdatePolicy(Arg) (GtkSpinButtonUpdatePolicy)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkSpinButtonUpdatePolicy(Arg) Xen_is_integer(Arg)
+#define Xen_to_C_GtkSpinType(Arg) (GtkSpinType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkSpinType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkStatusbar_, GtkStatusbar*)
+Xm_type_Ptr(GtkTextBuffer_, GtkTextBuffer*)
+Xm_type_Ptr(GtkTextTagTable_, GtkTextTagTable*)
+Xm_type_Ptr(GtkTextIter_, GtkTextIter*)
+Xm_type_Ptr(GtkTextChildAnchor_, GtkTextChildAnchor*)
+Xm_type_Ptr(GtkTextMark_, GtkTextMark*)
+Xm_type_Ptr(GtkTextAttributes_, GtkTextAttributes*)
+#define Xen_to_C_GtkTextSearchFlags(Arg) (GtkTextSearchFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkTextSearchFlags(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkTextView_, GtkTextView*)
+#define C_to_Xen_GtkTextWindowType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkTextWindowType(Arg) (GtkTextWindowType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkTextWindowType(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GtkWrapMode(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkWrapMode(Arg) (GtkWrapMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkWrapMode(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(PangoTabArray_, PangoTabArray*)
+Xm_type_Ptr_1(GtkToggleButton_, GtkToggleButton*)
+Xm_type_Ptr_1(GtkToolbar_, GtkToolbar*)
+#define C_to_Xen_GtkToolbarStyle(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkToolbarStyle(Arg) (GtkToolbarStyle)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkToolbarStyle(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkTreeDragSource_, GtkTreeDragSource*)
+Xm_type_Ptr_1(GtkTreeDragDest_, GtkTreeDragDest*)
+Xm_type_Ptr(GtkTreeRowReference_, GtkTreeRowReference*)
+#define C_to_Xen_GtkTreeModelFlags(Arg) C_int_to_Xen_integer(Arg)
+Xm_type_Ptr_1(GtkTreeModelSort_, GtkTreeModelSort*)
+#define C_to_Xen_GtkSelectionMode(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkSelectionMode(Arg) (GtkSelectionMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkSelectionMode(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkTreeModel__, GtkTreeModel**)
+Xm_type_Ptr_1(GtkTreeSortable_, GtkTreeSortable*)
+#define C_to_Xen_GtkSortType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkSortType(Arg) (GtkSortType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkSortType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkTreeStore_, GtkTreeStore*)
+#define C_to_Xen_GtkTreeViewColumnSizing(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkTreeViewColumnSizing(Arg) (GtkTreeViewColumnSizing)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkTreeViewColumnSizing(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GtkTreeViewDropPosition(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkTreeViewDropPosition(Arg) (GtkTreeViewDropPosition)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkTreeViewDropPosition(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkViewport_, GtkViewport*)
+Xm_type_Ptr_1(GtkAllocation_, GtkAllocation*)
+#define Xen_to_C_GtkDirectionType(Arg) (GtkDirectionType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkDirectionType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_2(AtkObject_, AtkObject*)
+#define C_to_Xen_GtkTextDirection(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkTextDirection(Arg) (GtkTextDirection)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkTextDirection(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkWindow_, GtkWindow*)
+#define C_to_Xen_GtkWindowType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkWindowType(Arg) (GtkWindowType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkWindowType(Arg) Xen_is_integer(Arg)
+#define Xen_to_C_GtkWindowPosition(Arg) (GtkWindowPosition)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkWindowPosition(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GdkGravity(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkGravity(Arg) (GdkGravity)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkGravity(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(PangoColor_, PangoColor*)
+#define C_to_Xen_PangoAttrType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoAttrType(Arg) (PangoAttrType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoAttrType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(PangoAttribute_, PangoAttribute*)
+#define C_to_Xen_guint16(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_guint16(Arg) (guint16)(Xen_integer_to_C_int(Arg))
+#define Xen_is_guint16(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_PangoStyle(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoStyle(Arg) (PangoStyle)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoStyle(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_PangoWeight(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoWeight(Arg) (PangoWeight)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoWeight(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_PangoVariant(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoVariant(Arg) (PangoVariant)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoVariant(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_PangoStretch(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoStretch(Arg) (PangoStretch)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoStretch(Arg) Xen_is_integer(Arg)
+#define Xen_to_C_PangoUnderline(Arg) (PangoUnderline)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoUnderline(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(PangoRectangle_, PangoRectangle*)
+Xm_type_Ptr(PangoAttrIterator_, PangoAttrIterator*)
+Xm_type_Ptr_1(PangoAttrList__, PangoAttrList**)
+Xm_type_Ptr_1(PangoAnalysis_, PangoAnalysis*)
+Xm_type_Ptr(PangoLogAttr_, PangoLogAttr*)
+Xm_type_Ptr_2(PangoFontFamily__, PangoFontFamily**)
+Xm_type_Ptr(PangoFont_, PangoFont*)
+Xm_type_Ptr_2(PangoFontset_, PangoFontset*)
+Xm_type_Ptr(PangoFontMetrics_, PangoFontMetrics*)
+Xm_type_Ptr(PangoCoverage_, PangoCoverage*)
+#define C_to_Xen_PangoCoverageLevel(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoCoverageLevel(Arg) (PangoCoverageLevel)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoCoverageLevel(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(PangoFontDescription__, PangoFontDescription**)
+#define C_to_Xen_PangoFontMask(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoFontMask(Arg) (PangoFontMask)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoFontMask(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(PangoFontFamily_, PangoFontFamily*)
+Xm_type_Ptr_2(PangoFontFace__, PangoFontFace**)
+Xm_type_Ptr(PangoFontFace_, PangoFontFace*)
+#define Xen_to_C_PangoGlyph(Arg) (PangoGlyph)(Xen_ulong_to_C_ulong(Arg))
+#define Xen_is_PangoGlyph(Arg) Xen_is_ulong(Arg)
+Xm_type_Ptr(PangoFontMap_, PangoFontMap*)
+Xm_type_Ptr(PangoGlyphString_, PangoGlyphString*)
+Xm_type_Ptr(PangoItem_, PangoItem*)
+#define C_to_Xen_PangoWrapMode(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoWrapMode(Arg) (PangoWrapMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoWrapMode(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_PangoAlignment(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoAlignment(Arg) (PangoAlignment)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoAlignment(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(int_, int*)
+Xm_type_Ptr(PangoLayoutLine_, PangoLayoutLine*)
+Xm_type_Ptr(PangoLayoutIter_, PangoLayoutIter*)
+Xm_type_Ptr_2(PangoLayoutRun_, PangoLayoutRun*)
+Xm_type_Ptr(GdkScreen_, GdkScreen*)
+#define C_to_Xen_GtkCalendarDisplayOptions(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkCalendarDisplayOptions(Arg) (GtkCalendarDisplayOptions)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkCalendarDisplayOptions(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkEventBox_, GtkEventBox*)
+Xm_type_Ptr(GtkToolItem_, GtkToolItem*)
+#define C_to_Xen_GtkFileChooserAction(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkFileChooserAction(Arg) (GtkFileChooserAction)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkFileChooserAction(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkTreeModelFilter_, GtkTreeModelFilter*)
+Xm_type_Ptr_1(GtkComboBox_, GtkComboBox*)
+Xm_type_Ptr_1(GtkExpander_, GtkExpander*)
+Xm_type_Ptr_1(GtkFontButton_, GtkFontButton*)
+Xm_type_Ptr_1(GtkRadioToolButton_, GtkRadioToolButton*)
+Xm_type_Ptr_1(GtkSeparatorToolItem_, GtkSeparatorToolItem*)
+Xm_type_Ptr_1(GtkToggleToolButton_, GtkToggleToolButton*)
+Xm_type_Ptr(GtkFileFilter_, GtkFileFilter*)
+#define C_to_Xen_GtkFileFilterFlags(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkFileFilterFlags(Arg) (GtkFileFilterFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkFileFilterFlags(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkCellLayout_, GtkCellLayout*)
+Xm_type_1(GtkCellLayoutDataFunc, GtkCellLayoutDataFunc)
+Xm_type_Ptr_1(GtkFileChooser_, GtkFileChooser*)
+Xm_type_Ptr(GtkIconTheme_, GtkIconTheme*)
+Xm_type_Ptr(GtkIconInfo_, GtkIconInfo*)
+#define Xen_to_C_GtkIconLookupFlags(Arg) (GtkIconLookupFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkIconLookupFlags(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkToolButton_, GtkToolButton*)
+#define C_to_Xen_GtkOrientation(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkOrientation(Arg) (GtkOrientation)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkOrientation(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_2(GtkAccelMap_, GtkAccelMap*)
+Xm_type_Ptr_1(GtkCellView_, GtkCellView*)
+Xm_type_Ptr_1(GtkAboutDialog_, GtkAboutDialog*)
+#define C_to_Xen_PangoEllipsizeMode(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_PangoEllipsizeMode(Arg) (PangoEllipsizeMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoEllipsizeMode(Arg) Xen_is_integer(Arg)
+Xm_type_1(PangoAttrFilterFunc, PangoAttrFilterFunc)
+#define C_to_Xen_PangoScript(Arg) C_int_to_Xen_integer(Arg)
+Xm_type_Ptr(PangoScriptIter_, PangoScriptIter*)
+Xm_type_Ptr_1(GtkFileChooserButton_, GtkFileChooserButton*)
+Xm_type_Ptr_1(GtkMenuToolButton_, GtkMenuToolButton*)
+Xm_type_Ptr_1(PangoRenderer_, PangoRenderer*)
+#define Xen_to_C_PangoRenderPart(Arg) (PangoRenderPart)(Xen_integer_to_C_int(Arg))
+#define Xen_is_PangoRenderPart(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(PangoMatrix_, PangoMatrix*)
+Xm_type_Ptr_1(GValue_, GValue*)
+#define C_to_Xen_GtkIconViewDropPosition(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkIconViewDropPosition(Arg) (GtkIconViewDropPosition)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkIconViewDropPosition(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GtkPackDirection(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkPackDirection(Arg) (GtkPackDirection)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkPackDirection(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkMenuBar_, GtkMenuBar*)
+#define C_to_Xen_GtkSensitivityType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkSensitivityType(Arg) (GtkSensitivityType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkSensitivityType(Arg) Xen_is_integer(Arg)
+Xm_type_1(GDestroyNotify, GDestroyNotify)
+Xm_type_Ptr_1(GtkAssistant_, GtkAssistant*)
+#define C_to_Xen_GtkAssistantPageType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkAssistantPageType(Arg) (GtkAssistantPageType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkAssistantPageType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkLinkButton_, GtkLinkButton*)
+Xm_type_Ptr_1(GtkRecentChooser_, GtkRecentChooser*)
+#define C_to_Xen_GtkRecentSortType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkRecentSortType(Arg) (GtkRecentSortType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkRecentSortType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkRecentFilter_, GtkRecentFilter*)
+Xm_type_Ptr(GtkRecentManager_, GtkRecentManager*)
+Xm_type_Ptr_1(GtkRecentChooserMenu_, GtkRecentChooserMenu*)
+Xm_type_no_p_2(time_t, time_t)
+Xm_type_1(GtkTextBufferSerializeFunc, GtkTextBufferSerializeFunc)
+Xm_type_1(GtkTextBufferDeserializeFunc, GtkTextBufferDeserializeFunc)
+Xm_type_Ptr_1(GtkRecentData_, GtkRecentData*)
+#define C_to_Xen_GtkTreeViewGridLines(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkTreeViewGridLines(Arg) (GtkTreeViewGridLines)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkTreeViewGridLines(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkPrintContext_, GtkPrintContext*)
+Xm_type_Ptr(GtkPageSetup_, GtkPageSetup*)
+Xm_type_Ptr(GtkPrintOperation_, GtkPrintOperation*)
+Xm_type_Ptr(GtkPrintSettings_, GtkPrintSettings*)
+Xm_type_1(GtkUnit, GtkUnit)
+#define C_to_Xen_GtkPrintOperationResult(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkPrintOperationAction(Arg) (GtkPrintOperationAction)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkPrintOperationAction(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GtkPrintStatus(Arg) C_int_to_Xen_integer(Arg)
+Xm_type_1(GtkPageSetupDoneFunc, GtkPageSetupDoneFunc)
+Xm_type_Ptr_1(GtkPrintOperationPreview_, GtkPrintOperationPreview*)
+Xm_type_1(GtkPrintSettingsFunc, GtkPrintSettingsFunc)
+Xm_type(GtkPageOrientation, GtkPageOrientation)
+Xm_type_Ptr(GtkPaperSize_, GtkPaperSize*)
+Xm_type(GtkPrintDuplex, GtkPrintDuplex)
+Xm_type(GtkPrintQuality, GtkPrintQuality)
+Xm_type(GtkPrintPages, GtkPrintPages)
+Xm_type_Ptr(GtkPageRange_, GtkPageRange*)
+Xm_type(GtkPageSet, GtkPageSet)
+Xm_type_Ptr_1(GtkTooltip_, GtkTooltip*)
+#if GTK_CHECK_VERSION(2, 14, 0)
+Xm_type_1(GtkCalendarDetailFunc, GtkCalendarDetailFunc)
+Xm_type_Ptr_1(GtkScaleButton_, GtkScaleButton*)
+Xm_type_Ptr(GFile_, GFile*)
#endif
-#if HAVE_GTK_ADJUSTMENT_GET_UPPER
-XM_TYPE_PTR_1(GtkScaleButton_, GtkScaleButton*)
-XM_TYPE_PTR(GFile_, GFile*)
+#if GTK_CHECK_VERSION(2, 16, 0)
+#define Xen_to_C_GtkEntryIconPosition(Arg) (GtkEntryIconPosition)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkEntryIconPosition(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GIcon_, GIcon*)
#endif
-#if HAVE_GTK_SCALE_ADD_MARK
-#define XEN_TO_C_GtkEntryIconPosition(Arg) (GtkEntryIconPosition)(XEN_TO_C_INT(Arg))
-#define XEN_GtkEntryIconPosition_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GIcon_, GIcon*)
+#if GTK_CHECK_VERSION(2, 18, 0)
+Xm_type_Ptr_1(GtkInfoBar_, GtkInfoBar*)
+#define C_to_Xen_GtkMessageType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkMessageType(Arg) (GtkMessageType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkMessageType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(GtkEntryBuffer_, GtkEntryBuffer*)
#endif
-#if HAVE_GTK_INFO_BAR_NEW
-XM_TYPE_PTR_1(GtkInfoBar_, GtkInfoBar*)
-#define C_TO_XEN_GtkMessageType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkMessageType(Arg) (GtkMessageType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkMessageType_P(Arg) XEN_INTEGER_P(Arg)
+#if GTK_CHECK_VERSION(2, 20, 0)
+Xm_type_Ptr_1(GtkSpinner_, GtkSpinner*)
+Xm_type_Ptr_1(GtkToolPalette_, GtkToolPalette*)
+Xm_type_Ptr(GtkToolItemGroup_, GtkToolItemGroup*)
+#define Xen_to_C_GtkToolPaletteDragTargets(Arg) (GtkToolPaletteDragTargets)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkToolPaletteDragTargets(Arg) Xen_is_integer(Arg)
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-XM_TYPE_PTR(GtkEntryBuffer_, GtkEntryBuffer*)
+#if GTK_CHECK_VERSION(3, 0, 0)
+Xm_type_Ptr_1(GdkModifierType_, GdkModifierType*)
+Xm_type_Ptr_1(GtkAccessible_, GtkAccessible*)
+Xm_type_Ptr_2(GdkDeviceManager_, GdkDeviceManager*)
+Xm_type_Ptr(GdkDevice_, GdkDevice*)
+Xm_type_Ptr_1(GtkMessageDialog_, GtkMessageDialog*)
+Xm_type_Ptr(cairo_region_t_, cairo_region_t*)
+#define C_to_Xen_GtkSizeRequestMode(Arg) C_int_to_Xen_integer(Arg)
+Xm_type_Ptr_1(GtkContainerClass_, GtkContainerClass*)
+#define C_to_Xen_GtkAlign(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkAlign(Arg) (GtkAlign)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkAlign(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkComboBoxText_, GtkComboBoxText*)
+Xm_type_Ptr(GdkRGBA_, GdkRGBA*)
+Xm_type_Ptr_1(GtkGrid_, GtkGrid*)
+Xm_type_Ptr_1(GtkScrollable_, GtkScrollable*)
+#define C_to_Xen_GtkScrollablePolicy(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkScrollablePolicy(Arg) (GtkScrollablePolicy)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkScrollablePolicy(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkSwitch_, GtkSwitch*)
+Xm_type_Ptr(GtkBorder_, GtkBorder*)
+Xm_type_Ptr_1(GtkCellArea_, GtkCellArea*)
+Xm_type_Ptr_1(GtkOrientable_, GtkOrientable*)
+Xm_type_Ptr_1(GtkInvisible_, GtkInvisible*)
+Xm_type_Ptr(GtkWindowGroup_, GtkWindowGroup*)
+Xm_type_Ptr_1(GtkToolShell_, GtkToolShell*)
+Xm_type_Ptr_1(GdkScreen__, GdkScreen**)
+#define C_to_Xen_GtkStateFlags(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkStateFlags(Arg) (GtkStateFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkStateFlags(Arg) Xen_is_integer(Arg)
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-XM_TYPE_PTR_1(GtkSpinner_, GtkSpinner*)
-XM_TYPE_PTR_1(GtkToolPalette_, GtkToolPalette*)
-XM_TYPE_PTR(GtkToolItemGroup_, GtkToolItemGroup*)
-XM_TYPE_1(GtkToolPaletteDragTargets, GtkToolPaletteDragTargets)
+#if GTK_CHECK_VERSION(3, 2, 0)
+Xm_type_Ptr_1(GtkWidgetPath_, GtkWidgetPath*)
+Xm_type_Ptr_1(GtkOverlay_, GtkOverlay*)
+#define C_to_Xen_GdkScrollDirection(Arg) C_int_to_Xen_integer(Arg)
+Xm_type_Ptr_1(GtkFontChooser_, GtkFontChooser*)
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-XM_TYPE_PTR_1(GdkModifierType_, GdkModifierType*)
-XM_TYPE_PTR_2(GdkDeviceManager_, GdkDeviceManager*)
-XM_TYPE_PTR(GdkDevice_, GdkDevice*)
-XM_TYPE_PTR_1(GtkMessageDialog_, GtkMessageDialog*)
-XM_TYPE_PTR(cairo_region_t_, cairo_region_t*)
-#define C_TO_XEN_GtkSizeRequestMode(Arg) C_TO_XEN_INT(Arg)
-XM_TYPE_PTR_1(GtkContainerClass_, GtkContainerClass*)
-XM_TYPE(GtkAlign, GtkAlign)
-XM_TYPE_PTR_1(GtkComboBoxText_, GtkComboBoxText*)
-XM_TYPE_PTR(GdkRGBA_, GdkRGBA*)
-XM_TYPE_PTR_1(GtkGrid_, GtkGrid*)
-XM_TYPE_PTR_1(GtkScrollable_, GtkScrollable*)
-#define C_TO_XEN_GtkScrollablePolicy(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkScrollablePolicy(Arg) (GtkScrollablePolicy)(XEN_TO_C_INT(Arg))
-#define XEN_GtkScrollablePolicy_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(GtkSwitch_, GtkSwitch*)
-XM_TYPE_PTR(GtkBorder_, GtkBorder*)
-XM_TYPE_PTR_1(GtkActivatable_, GtkActivatable*)
-XM_TYPE_PTR_1(GtkCellArea_, GtkCellArea*)
-XM_TYPE_PTR_1(GtkOrientable_, GtkOrientable*)
-XM_TYPE_PTR_1(GtkInvisible_, GtkInvisible*)
-#define C_TO_XEN_GtkLicense(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkLicense(Arg) (GtkLicense)(XEN_TO_C_INT(Arg))
-#define XEN_GtkLicense_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkWindowGroup_, GtkWindowGroup*)
-XM_TYPE_PTR_1(GtkToolShell_, GtkToolShell*)
-XM_TYPE_PTR_1(GdkScreen__, GdkScreen**)
+#if GTK_CHECK_VERSION(3, 4, 0)
+#define Xen_to_C_GdkModifierIntent(Arg) (GdkModifierIntent)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkModifierIntent(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(guint__, guint**)
+Xm_type_Ptr(GMenuModel_, GMenuModel*)
+Xm_type_Ptr_1(GtkApplication_, GtkApplication*)
+Xm_type_Ptr_1(GtkApplicationWindow_, GtkApplicationWindow*)
+Xm_type_Ptr_1(GtkColorChooser_, GtkColorChooser*)
#endif
-#if (!HAVE_GTK_3)
-XM_TYPE_PTR(GdkColormap_, GdkColormap*)
-#define C_TO_XEN_GdkDragProtocol(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GdkDragProtocol(Arg) (GdkDragProtocol)(XEN_TO_C_INT(Arg))
-#define XEN_GdkDragProtocol_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GdkDrawable_, GdkDrawable*)
-XM_TYPE_PTR(GdkBitmap_, GdkBitmap*)
-#define C_TO_XEN_int(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_int(Arg) (int)(XEN_TO_C_INT(Arg))
-#define XEN_int_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GdkPixmap_, GdkPixmap*)
-#define XEN_TO_C_GdkNativeWindow(Arg) (GdkNativeWindow)(XEN_TO_C_ULONG(Arg))
-#define XEN_GdkNativeWindow_P(Arg) XEN_ULONG_P(Arg)
-XM_TYPE_PTR(GtkObject_, GtkObject*)
-XM_TYPE_PTR(GtkStyle_, GtkStyle*)
-#define C_TO_XEN_GtkTextDirection(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkTextDirection(Arg) (GtkTextDirection)(XEN_TO_C_INT(Arg))
-#define XEN_GtkTextDirection_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkStateType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkStateType(Arg) (GtkStateType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkStateType_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_GtkUpdateType(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_GtkUpdateType(Arg) (GtkUpdateType)(XEN_TO_C_INT(Arg))
-#define XEN_GtkUpdateType_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(GtkRcStyle_, GtkRcStyle*)
-XM_TYPE_PTR(GtkRequisition_, GtkRequisition*)
+#if GTK_CHECK_VERSION(3, 6, 0)
+Xm_type_Ptr_1(GtkMenuButton_, GtkMenuButton*)
+Xm_type_Ptr_1(GtkLevelBar_, GtkLevelBar*)
+#define C_to_Xen_GtkLevelBarMode(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkLevelBarMode(Arg) (GtkLevelBarMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkLevelBarMode(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GtkInputPurpose(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkInputPurpose(Arg) (GtkInputPurpose)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkInputPurpose(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GtkInputHints(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkInputHints(Arg) (GtkInputHints)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkInputHints(Arg) Xen_is_integer(Arg)
#endif
-XM_TYPE_PTR(cairo_surface_t_, cairo_surface_t*)
-#define C_TO_XEN_cairo_content_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_content_t(Arg) (cairo_content_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_content_t_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(cairo_pattern_t_, cairo_pattern_t*)
-#define C_TO_XEN_cairo_operator_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_operator_t(Arg) (cairo_operator_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_operator_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_antialias_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_antialias_t(Arg) (cairo_antialias_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_antialias_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_fill_rule_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_fill_rule_t(Arg) (cairo_fill_rule_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_fill_rule_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_line_cap_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_line_cap_t(Arg) (cairo_line_cap_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_line_cap_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_line_join_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_line_join_t(Arg) (cairo_line_join_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_line_join_t_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR_1(cairo_matrix_t_, cairo_matrix_t*)
-#define C_TO_XEN_bool(Arg) C_TO_XEN_BOOLEAN(Arg)
-#define XEN_TO_C_bool(Arg) (bool)(XEN_TO_C_BOOLEAN(Arg))
-#define XEN_bool_P(Arg) XEN_BOOLEAN_P(Arg)
-#define C_TO_XEN_cairo_status_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_status_t(Arg) (cairo_status_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_status_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_subpixel_order_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_subpixel_order_t(Arg) (cairo_subpixel_order_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_subpixel_order_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_hint_style_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_hint_style_t(Arg) (cairo_hint_style_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_hint_style_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_hint_metrics_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_hint_metrics_t(Arg) (cairo_hint_metrics_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_hint_metrics_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_font_slant_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_font_slant_t(Arg) (cairo_font_slant_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_font_slant_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_font_weight_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_font_weight_t(Arg) (cairo_font_weight_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_font_weight_t_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(cairo_scaled_font_t_, cairo_scaled_font_t*)
-XM_TYPE_PTR(cairo_glyph_t_, cairo_glyph_t*)
-XM_TYPE_PTR(cairo_font_face_t_, cairo_font_face_t*)
-XM_TYPE_PTR_1(cairo_font_extents_t_, cairo_font_extents_t*)
-XM_TYPE_PTR_1(cairo_text_extents_t_, cairo_text_extents_t*)
-XM_TYPE_PTR_1(cairo_user_data_key_t_, cairo_user_data_key_t*)
-XM_TYPE_1(cairo_destroy_func_t, cairo_destroy_func_t)
-XM_TYPE_PTR(cairo_path_t_, cairo_path_t*)
-#define C_TO_XEN_cairo_format_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_format_t(Arg) (cairo_format_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_format_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_extend_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_extend_t(Arg) (cairo_extend_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_extend_t_P(Arg) XEN_INTEGER_P(Arg)
-#define C_TO_XEN_cairo_filter_t(Arg) C_TO_XEN_INT(Arg)
-#define XEN_TO_C_cairo_filter_t(Arg) (cairo_filter_t)(XEN_TO_C_INT(Arg))
-#define XEN_cairo_filter_t_P(Arg) XEN_INTEGER_P(Arg)
-XM_TYPE_PTR(void_, void*)
-XM_TYPE_PTR(cairo_rectangle_list_t_, cairo_rectangle_list_t*)
-#if HAVE_CAIRO_GLYPH_ALLOCATE
-XM_TYPE_PTR(cairo_text_cluster_t_, cairo_text_cluster_t*)
-XM_TYPE_1(cairo_text_cluster_flags_t, cairo_text_cluster_flags_t)
-XM_TYPE_PTR_1(cairo_glyph_t__, cairo_glyph_t**)
-XM_TYPE_PTR_1(cairo_text_cluster_t__, cairo_text_cluster_t**)
-XM_TYPE_PTR_1(cairo_text_cluster_flags_t_, cairo_text_cluster_flags_t*)
-#define C_TO_XEN_cairo_bool_t(Arg) C_TO_XEN_INT(Arg)
+#if GTK_CHECK_VERSION(3, 8, 0)
+#define C_to_Xen_GdkFullscreenMode(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GdkFullscreenMode(Arg) (GdkFullscreenMode)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GdkFullscreenMode(Arg) Xen_is_integer(Arg)
#endif
-#if HAVE_CAIRO_REGION_XOR
-XM_TYPE_PTR(cairo_device_t_, cairo_device_t*)
-XM_TYPE_PTR_1(cairo_rectangle_t_, cairo_rectangle_t*)
-XM_TYPE_PTR_1(double_, double*)
-XM_TYPE_PTR_1(cairo_rectangle_int_t_, cairo_rectangle_int_t*)
-XM_TYPE_NO_P_2(cairo_region_overlap_t, cairo_region_overlap_t)
+#if GTK_CHECK_VERSION(3, 10, 0)
+#define C_to_Xen_GtkBaselinePosition(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkBaselinePosition(Arg) (GtkBaselinePosition)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkBaselinePosition(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_GtkPlacesOpenFlags(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkPlacesOpenFlags(Arg) (GtkPlacesOpenFlags)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkPlacesOpenFlags(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkPlacesSidebar_, GtkPlacesSidebar*)
+Xm_type_Ptr_1(GtkStackSwitcher_, GtkStackSwitcher*)
+Xm_type_Ptr(GtkStack_, GtkStack*)
+#define C_to_Xen_GtkStackTransitionType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkStackTransitionType(Arg) (GtkStackTransitionType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkStackTransitionType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkRevealer_, GtkRevealer*)
+#define C_to_Xen_GtkRevealerTransitionType(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_GtkRevealerTransitionType(Arg) (GtkRevealerTransitionType)(Xen_integer_to_C_int(Arg))
+#define Xen_is_GtkRevealerTransitionType(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(GtkHeaderBar_, GtkHeaderBar*)
+Xm_type_Ptr(GtkListBoxRow_, GtkListBoxRow*)
+Xm_type_Ptr_1(GtkListBox_, GtkListBox*)
+Xm_type_Ptr_1(GtkSearchBar_, GtkSearchBar*)
+#define C_to_Xen_GdkEventType(Arg) C_int_to_Xen_integer(Arg)
#endif
-#define XLS(a, b) XEN_TO_C_gchar_(XEN_LIST_REF(a, b))
-#define XLI(a, b) ((int)XEN_TO_C_INT(XEN_LIST_REF(a, b)))
-#define XLG(a, b) XEN_TO_C_GType(XEN_LIST_REF(a, b))
-#define XLT(a, b) XEN_TO_C_GtkTextTag_(XEN_LIST_REF(a, b))
+#if GTK_CHECK_VERSION(3, 12, 0)
+Xm_type_Ptr(GtkFlowBoxChild_, GtkFlowBoxChild*)
+Xm_type_Ptr_1(GtkFlowBox_, GtkFlowBox*)
+Xm_type_Ptr_1(GtkActionBar_, GtkActionBar*)
+Xm_type_Ptr_1(GtkPopover_, GtkPopover*)
+#endif
-static XEN c_to_xen_string(XEN str)
-{
- return(C_TO_XEN_STRING((char *)XEN_UNWRAP_C_POINTER(str)));
-}
+#if GTK_CHECK_VERSION(3, 14, 0)
+Xm_type_Ptr(GtkGesture_, GtkGesture*)
+Xm_type(GtkEventSequenceState, GtkEventSequenceState)
+Xm_type_Ptr(GdkEventSequence_, GdkEventSequence*)
+Xm_type_Ptr_1(GtkGestureDrag_, GtkGestureDrag*)
+Xm_type_Ptr_1(GtkGesturePan_, GtkGesturePan*)
+Xm_type_Ptr_1(GtkGestureMultiPress_, GtkGestureMultiPress*)
+Xm_type_Ptr_1(GtkGestureRotate_, GtkGestureRotate*)
+Xm_type_Ptr_1(GtkGestureSingle_, GtkGestureSingle*)
+Xm_type_Ptr_1(GtkGestureSwipe_, GtkGestureSwipe*)
+Xm_type_Ptr_1(GtkGestureZoom_, GtkGestureZoom*)
+Xm_type_Ptr_1(GtkEventController_, GtkEventController*)
+Xm_type(GtkPropagationPhase, GtkPropagationPhase)
+#endif
+
+#if GTK_CHECK_VERSION(3, 16, 0)
+Xm_type_Ptr_1(GtkGLArea_, GtkGLArea*)
+Xm_type_Ptr(GdkGLContext_, GdkGLContext*)
+Xm_type_Ptr_1(GtkStyleContext_, GtkStyleContext*)
+Xm_type_Ptr_1(GtkPopoverMenu_, GtkPopoverMenu*)
+Xm_type_Ptr_1(GtkSearchEntry_, GtkSearchEntry*)
+Xm_type_Ptr_1(GtkStackSidebar_, GtkStackSidebar*)
+#endif
+
+#if GTK_CHECK_VERSION(3, 20, 0)
+Xm_type_Ptr(GtkShortcutsWindow_, GtkShortcutsWindow*)
+Xm_type(GtkAllocation, GtkAllocation)
+#endif
+
+Xm_type_Ptr(cairo_surface_t_, cairo_surface_t*)
+#define C_to_Xen_cairo_content_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_content_t(Arg) (cairo_content_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_content_t(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(cairo_pattern_t_, cairo_pattern_t*)
+#define C_to_Xen_cairo_operator_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_operator_t(Arg) (cairo_operator_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_operator_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_antialias_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_antialias_t(Arg) (cairo_antialias_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_antialias_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_fill_rule_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_fill_rule_t(Arg) (cairo_fill_rule_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_fill_rule_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_line_cap_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_line_cap_t(Arg) (cairo_line_cap_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_line_cap_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_line_join_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_line_join_t(Arg) (cairo_line_join_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_line_join_t(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr_1(cairo_matrix_t_, cairo_matrix_t*)
+#define C_to_Xen_bool(Arg) C_bool_to_Xen_boolean(Arg)
+#define Xen_to_C_bool(Arg) (bool)(Xen_boolean_to_C_bool(Arg))
+#define Xen_is_bool(Arg) Xen_is_boolean(Arg)
+#define C_to_Xen_cairo_status_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_status_t(Arg) (cairo_status_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_status_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_subpixel_order_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_subpixel_order_t(Arg) (cairo_subpixel_order_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_subpixel_order_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_hint_style_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_hint_style_t(Arg) (cairo_hint_style_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_hint_style_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_hint_metrics_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_hint_metrics_t(Arg) (cairo_hint_metrics_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_hint_metrics_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_font_slant_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_font_slant_t(Arg) (cairo_font_slant_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_font_slant_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_font_weight_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_font_weight_t(Arg) (cairo_font_weight_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_font_weight_t(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(cairo_scaled_font_t_, cairo_scaled_font_t*)
+Xm_type_Ptr(cairo_glyph_t_, cairo_glyph_t*)
+Xm_type_Ptr(cairo_font_face_t_, cairo_font_face_t*)
+Xm_type_Ptr_1(cairo_font_extents_t_, cairo_font_extents_t*)
+Xm_type_Ptr_1(cairo_text_extents_t_, cairo_text_extents_t*)
+Xm_type_Ptr_1(cairo_user_data_key_t_, cairo_user_data_key_t*)
+Xm_type_1(cairo_destroy_func_t, cairo_destroy_func_t)
+Xm_type_Ptr(cairo_path_t_, cairo_path_t*)
+#define C_to_Xen_cairo_format_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_format_t(Arg) (cairo_format_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_format_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_extend_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_extend_t(Arg) (cairo_extend_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_extend_t(Arg) Xen_is_integer(Arg)
+#define C_to_Xen_cairo_filter_t(Arg) C_int_to_Xen_integer(Arg)
+#define Xen_to_C_cairo_filter_t(Arg) (cairo_filter_t)(Xen_integer_to_C_int(Arg))
+#define Xen_is_cairo_filter_t(Arg) Xen_is_integer(Arg)
+Xm_type_Ptr(void_, void*)
+Xm_type_Ptr(cairo_rectangle_list_t_, cairo_rectangle_list_t*)
+#if HAVE_CAIRO_1_8
+Xm_type_Ptr(cairo_text_cluster_t_, cairo_text_cluster_t*)
+Xm_type_1(cairo_text_cluster_flags_t, cairo_text_cluster_flags_t)
+Xm_type_Ptr_1(cairo_glyph_t__, cairo_glyph_t**)
+Xm_type_Ptr_1(cairo_text_cluster_t__, cairo_text_cluster_t**)
+Xm_type_Ptr_1(cairo_text_cluster_flags_t_, cairo_text_cluster_flags_t*)
+#define C_to_Xen_cairo_bool_t(Arg) C_int_to_Xen_integer(Arg)
+#endif
+
+#if HAVE_CAIRO_1_9_12 && GTK_CHECK_VERSION(3, 0, 0)
+Xm_type_Ptr(cairo_device_t_, cairo_device_t*)
+Xm_type_Ptr_1(cairo_rectangle_t_, cairo_rectangle_t*)
+Xm_type_Ptr_1(double_, double*)
+Xm_type_Ptr_1(cairo_rectangle_int_t_, cairo_rectangle_int_t*)
+Xm_type_no_p_2(cairo_region_overlap_t, cairo_region_overlap_t)
+#endif
+
+#define XLS(a, b) Xen_to_C_gchar_(Xen_list_ref(a, b))
+#define XLI(a, b) ((int)Xen_integer_to_C_int(Xen_list_ref(a, b)))
+#define XLL(a, b) (Xen_llong_to_C_llong(Xen_list_ref(a, b)))
+#define XLG(a, b) Xen_to_C_GType(Xen_list_ref(a, b))
+#define XLT(a, b) Xen_to_C_GtkTextTag_(Xen_list_ref(a, b))
+#define XLA(a, b) ((Xen_is_integer(Xen_list_ref(a, b))) ? ((gpointer)XLL(a, b)) : ((Xen_is_string(Xen_list_ref(a, b))) ? ((gpointer)XLS(a, b)) : ((gpointer)XLG(a, b))))
/* -------------------------------- gc protection -------------------------------- */
-static XEN xm_protected;
+static Xen xm_protected;
static int xm_protected_size = 0;
-static XEN xm_gc_table;
+static Xen xm_gc_table;
static int last_xm_unprotect = NOT_A_GC_LOC;
-static int xm_protect(XEN obj)
+static int xm_protect(Xen obj)
{
int i, new_size;
- XEN new_table;
+ Xen new_table;
if (last_xm_unprotect >= 0)
{
i = last_xm_unprotect;
- if (XEN_FALSE_P(XEN_VECTOR_REF(xm_protected, i)))
+ if (Xen_is_false(Xen_vector_ref(xm_protected, i)))
{
- XEN_VECTOR_SET(xm_protected, i, obj);
+ Xen_vector_set(xm_protected, i, obj);
last_xm_unprotect = NOT_A_GC_LOC;
return(i);
}
last_xm_unprotect = NOT_A_GC_LOC;
}
for (i = 0; i < xm_protected_size; i++)
- if (XEN_FALSE_P(XEN_VECTOR_REF(xm_protected, i)))
+ if (Xen_is_false(Xen_vector_ref(xm_protected, i)))
{
- XEN_VECTOR_SET(xm_protected, i, obj);
+ Xen_vector_set(xm_protected, i, obj);
return(i);
}
new_size = xm_protected_size * 2;
- new_table = XEN_MAKE_VECTOR(new_size, XEN_FALSE);
+ new_table = Xen_make_vector(new_size, Xen_false);
for (i = 0; i < xm_protected_size; i++)
{
- XEN_VECTOR_SET(new_table, i, XEN_VECTOR_REF(xm_protected, i));
- XEN_VECTOR_SET(xm_protected, i, XEN_FALSE);
+ Xen_vector_set(new_table, i, Xen_vector_ref(xm_protected, i));
+ Xen_vector_set(xm_protected, i, Xen_false);
}
- XEN_VECTOR_SET(new_table, xm_protected_size, obj);
- XEN_VECTOR_SET(xm_gc_table, 0, new_table);
+ Xen_vector_set(new_table, xm_protected_size, obj);
+ Xen_vector_set(xm_gc_table, 0, new_table);
i = xm_protected_size;
xm_protected_size = new_size;
xm_protected = new_table;
return(i);
}
-#if 0
-static void xm_unprotect_idler(guint id)
-{
- int i;
- XEN cur, idler;
- for (i = 0; i < xm_protected_size; i++)
- {
- cur = XEN_VECTOR_REF(xm_protected, i);
- if ((XEN_LIST_P(cur)) && (XEN_LIST_LENGTH(cur) == 3) && (XEN_LIST_P(XEN_CADDR(cur))))
- {
- idler = XEN_CADDR(cur);
- if ((XEN_SYMBOL_P(XEN_CAR(idler))) &&
- (strcmp("idler", XEN_SYMBOL_TO_C_STRING(XEN_CAR(idler))) == 0) &&
- (id == (guint)(XEN_TO_C_INT(XEN_CADR(idler)))))
- {
- velts[i] = XEN_FALSE;
- last_xm_unprotect = i;
- return;
- }}}
-}
-#endif
static void xm_unprotect_at(int ind)
{
- XEN_VECTOR_SET(xm_protected, ind, XEN_FALSE);
+ Xen_vector_set(xm_protected, ind, Xen_false);
last_xm_unprotect = ind;
}
@@ -1077,1322 +1085,1518 @@ static void xm_unprotect_at(int ind)
static gboolean gxg_find_func(GtkAccelKey* key, GClosure* closure, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkAccelKey_(key),
- C_TO_XEN_GClosure_(closure),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkAccelKey_(key),
+ C_to_Xen_GClosure_(closure),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static void gxg_func2(GtkWidget* w, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_2(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkWidget_(w),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_2_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkWidget_(w),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static gboolean gxg_timer_func(gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_1(XEN_CAR((XEN)func_info),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_1_arg(Xen_car((Xen)func_info),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static void gxg_destroy_func(gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_1(XEN_CADDDR((XEN)func_info),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_1_arg(Xen_cadddr((Xen)func_info),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static GdkFilterReturn gxg_filter_func(GdkXEvent* xevent, GdkEvent* event, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((GdkFilterReturn)0);
- return(XEN_TO_C_GdkFilterReturn(XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GdkXEvent_(xevent),
- C_TO_XEN_GdkEvent_(event),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((GdkFilterReturn)0);
+ return(Xen_to_C_GdkFilterReturn(Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GdkXEvent_(xevent),
+ C_to_Xen_GdkEvent_(event),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static void gxg_event_func(GdkEvent* event, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_2(XEN_CAR((XEN)func_info),
- C_TO_XEN_GdkEvent_(event),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
-}
-
-static gint gxg_snoop_func(GtkWidget* widget, GdkEventKey* event, gpointer func_info)
-{
- if (!XEN_LIST_P((XEN)func_info)) return((gint)0);
- return(XEN_TO_C_gint(XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkWidget_(widget),
- C_TO_XEN_GdkEventKey_(event),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_2_args(Xen_car((Xen)func_info),
+ C_to_Xen_GdkEvent_(event),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_menu_position_func(GtkMenu* menu, gint* x, gint* y, gboolean* push, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_5(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkMenu_(menu),
- C_TO_XEN_gint_(x),
- C_TO_XEN_gint_(y),
- C_TO_XEN_gboolean_(push),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_5_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkMenu_(menu),
+ C_to_Xen_gint_(x),
+ C_to_Xen_gint_(y),
+ C_to_Xen_gboolean_(push),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_text_tag_table_foreach(GtkTextTag* tag, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_2(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTextTag_(tag),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_2_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTextTag_(tag),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_accel_map_foreach(gpointer func_info, const gchar* accel_path, guint accel_key, GdkModifierType accel_mods, gboolean changed)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_5(XEN_CAR((XEN)func_info),
- XEN_CADR((XEN)func_info),
- C_TO_XEN_gchar_(accel_path),
- C_TO_XEN_guint(accel_key),
- C_TO_XEN_GdkModifierType(accel_mods),
- C_TO_XEN_gboolean(changed),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_5_args(Xen_car((Xen)func_info),
+ Xen_cadr((Xen)func_info),
+ C_to_Xen_gchar_(accel_path),
+ C_to_Xen_guint(accel_key),
+ C_to_Xen_GdkModifierType(accel_mods),
+ C_to_Xen_gboolean(changed),
+ __func__);
}
static gboolean gxg_model_func(GtkTreeModel* model, GtkTreePath* path, GtkTreeIter* iter, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_4(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeModel_(model),
- C_TO_XEN_GtkTreePath_(path),
- C_TO_XEN_GtkTreeIter_(iter),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_4_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeModel_(model),
+ C_to_Xen_GtkTreePath_(path),
+ C_to_Xen_GtkTreeIter_(iter),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static void gxg_tree_selection_func(GtkTreeModel* model, GtkTreePath* path, GtkTreeIter* iter, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_4(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeModel_(model),
- C_TO_XEN_GtkTreePath_(path),
- C_TO_XEN_GtkTreeIter_(iter),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_4_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeModel_(model),
+ C_to_Xen_GtkTreePath_(path),
+ C_to_Xen_GtkTreeIter_(iter),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_clip_received(GtkClipboard* clipboard, GtkSelectionData* selection_data, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkClipboard_(clipboard),
- C_TO_XEN_GtkSelectionData_(selection_data),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkClipboard_(clipboard),
+ C_to_Xen_GtkSelectionData_(selection_data),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_clip_text_received(GtkClipboard* clipboard, const gchar* text, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkClipboard_(clipboard),
- C_TO_XEN_gchar_(text),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkClipboard_(clipboard),
+ C_to_Xen_gchar_(text),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_clip_targets_received(GtkClipboard* clipboard, GdkAtom* atoms, gint n_atoms, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_4(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkClipboard_(clipboard),
- C_TO_XEN_GdkAtom_(atoms),
- C_TO_XEN_gint(n_atoms),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_4_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkClipboard_(clipboard),
+ C_to_Xen_GdkAtom_(atoms),
+ C_to_Xen_gint(n_atoms),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static gboolean gxg_text_char_predicate(gunichar ch, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_2(XEN_CAR((XEN)func_info),
- C_TO_XEN_gunichar(ch),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_2_args(Xen_car((Xen)func_info),
+ C_to_Xen_gunichar(ch),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static gboolean gxg_tree_column(GtkTreeView* tree_view, GtkTreeViewColumn* column, GtkTreeViewColumn* prev_column, GtkTreeViewColumn* next_column, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_5(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeView_(tree_view),
- C_TO_XEN_GtkTreeViewColumn_(column),
- C_TO_XEN_GtkTreeViewColumn_(prev_column),
- C_TO_XEN_GtkTreeViewColumn_(next_column),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_5_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeView_(tree_view),
+ C_to_Xen_GtkTreeViewColumn_(column),
+ C_to_Xen_GtkTreeViewColumn_(prev_column),
+ C_to_Xen_GtkTreeViewColumn_(next_column),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static void gxg_tree_mapping(GtkTreeView* tree_view, GtkTreePath* path, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeView_(tree_view),
- C_TO_XEN_GtkTreePath_(path),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeView_(tree_view),
+ C_to_Xen_GtkTreePath_(path),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static gboolean gxg_tree_search(GtkTreeModel* model, gint column, const gchar* key, GtkTreeIter* iter, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_5(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeModel_(model),
- C_TO_XEN_gint(column),
- C_TO_XEN_gchar_(key),
- C_TO_XEN_GtkTreeIter_(iter),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_5_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeModel_(model),
+ C_to_Xen_gint(column),
+ C_to_Xen_gchar_(key),
+ C_to_Xen_GtkTreeIter_(iter),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static void gxg_cell_data(GtkTreeViewColumn* tree_column, GtkCellRenderer* cell, GtkTreeModel* tree_model, GtkTreeIter* iter, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_5(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeViewColumn_(tree_column),
- C_TO_XEN_GtkCellRenderer_(cell),
- C_TO_XEN_GtkTreeModel_(tree_model),
- C_TO_XEN_GtkTreeIter_(iter),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_5_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeViewColumn_(tree_column),
+ C_to_Xen_GtkCellRenderer_(cell),
+ C_to_Xen_GtkTreeModel_(tree_model),
+ C_to_Xen_GtkTreeIter_(iter),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static gint gxg_iter_compare(GtkTreeModel* model, GtkTreeIter* a, GtkTreeIter* b, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gint)0);
- return(XEN_TO_C_gint(XEN_CALL_4(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeModel_(model),
- C_TO_XEN_GtkTreeIter_(a),
- C_TO_XEN_GtkTreeIter_(b),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gint)0);
+ return(Xen_to_C_gint(Xen_call_with_4_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeModel_(model),
+ C_to_Xen_GtkTreeIter_(a),
+ C_to_Xen_GtkTreeIter_(b),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static gboolean gxg_tree_selection(GtkTreeSelection* selection, GtkTreeModel* model, GtkTreePath* path, gboolean path_currently_selected, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_5(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeSelection_(selection),
- C_TO_XEN_GtkTreeModel_(model),
- C_TO_XEN_GtkTreePath_(path),
- C_TO_XEN_gboolean(path_currently_selected),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_5_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeSelection_(selection),
+ C_to_Xen_GtkTreeModel_(model),
+ C_to_Xen_GtkTreePath_(path),
+ C_to_Xen_gboolean(path_currently_selected),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static void gxg_clip_get(GtkClipboard* clipboard, GtkSelectionData* selection_data, guint info, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_4(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkClipboard_(clipboard),
- C_TO_XEN_GtkSelectionData_(selection_data),
- C_TO_XEN_guint(info),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_4_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkClipboard_(clipboard),
+ C_to_Xen_GtkSelectionData_(selection_data),
+ C_to_Xen_guint(info),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_clip_clear(GtkClipboard* clipboard, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_2(XEN_CADDR((XEN)func_info),
- C_TO_XEN_GtkClipboard_(clipboard),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_2_args(Xen_caddr((Xen)func_info),
+ C_to_Xen_GtkClipboard_(clipboard),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static gboolean gxg_file_filter(const GtkFileFilterInfo* info, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_2(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkFileFilterInfo_((GtkFileFilterInfo *)info),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_2_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkFileFilterInfo_((GtkFileFilterInfo *)info),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static gboolean gxg_entry_completion_match(GtkEntryCompletion* completion, const gchar* key, GtkTreeIter* iter, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_4(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkEntryCompletion_(completion),
- C_TO_XEN_gchar_(key),
- C_TO_XEN_GtkTreeIter_(iter),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_4_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkEntryCompletion_(completion),
+ C_to_Xen_gchar_(key),
+ C_to_Xen_GtkTreeIter_(iter),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static gboolean gxg_row_separator(GtkTreeModel* model, GtkTreeIter* iter, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
- return(XEN_TO_C_gboolean(XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeModel_(model),
- C_TO_XEN_GtkTreeIter_(iter),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gboolean)0);
+ return(Xen_to_C_gboolean(Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeModel_(model),
+ C_to_Xen_GtkTreeIter_(iter),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static void gxg_icon_view_foreach(GtkIconView* icon_view, GtkTreePath* path, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkIconView_(icon_view),
- C_TO_XEN_GtkTreePath_(path),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkIconView_(icon_view),
+ C_to_Xen_GtkTreePath_(path),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_clip_image_received(GtkClipboard* clipboard, GdkPixbuf* pixbuf, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkClipboard_(clipboard),
- C_TO_XEN_GdkPixbuf_(pixbuf),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkClipboard_(clipboard),
+ C_to_Xen_GdkPixbuf_(pixbuf),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_g_message_log_func(const gchar* domain, GLogLevelFlags log_level, const gchar* message, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_4(XEN_CAR((XEN)func_info),
- C_TO_XEN_gchar_(domain),
- C_TO_XEN_GLogLevelFlags(log_level),
- C_TO_XEN_gchar_(message),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_4_args(Xen_car((Xen)func_info),
+ C_to_Xen_gchar_(domain),
+ C_to_Xen_GLogLevelFlags(log_level),
+ C_to_Xen_gchar_(message),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static void gxg_clip_rich_text_received(GtkClipboard* clipboard, GdkAtom format, const guint8* text, gsize length, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- #if (!(defined(__cplusplus)))
- XEN_CALL_5(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkClipboard_(clipboard),
- C_TO_XEN_GdkAtom(format),
- C_TO_XEN_guint8_(text),
- C_TO_XEN_gsize(length),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
- #endif
-}
-
-static gboolean gxg_recent_filter(const GtkRecentFilterInfo* filter_info, gpointer func_info)
-{
- if (!XEN_LIST_P((XEN)func_info)) return((gboolean)0);
+ if (!Xen_is_list((Xen)func_info)) return;
#if (!(defined(__cplusplus)))
- return(XEN_TO_C_gboolean(XEN_CALL_2(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkRecentFilterInfo_(filter_info),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
- #else
- return((gboolean)0);
+ Xen_call_with_5_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkClipboard_(clipboard),
+ C_to_Xen_GdkAtom(format),
+ C_to_Xen_guint8_(text),
+ C_to_Xen_gsize(length),
+ Xen_cadr((Xen)func_info),
+ __func__);
#endif
}
static void gxg_search_position(GtkTreeView* tree_view, GtkWidget* search_dialog, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return;
- XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkTreeView_(tree_view),
- C_TO_XEN_GtkWidget_(search_dialog),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__);
+ if (!Xen_is_list((Xen)func_info)) return;
+ Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkTreeView_(tree_view),
+ C_to_Xen_GtkWidget_(search_dialog),
+ Xen_cadr((Xen)func_info),
+ __func__);
}
static gint gxg_page_func(gint current_page, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gint)0);
- return(XEN_TO_C_gint(XEN_CALL_2(XEN_CAR((XEN)func_info),
- C_TO_XEN_gint(current_page),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gint)0);
+ return(Xen_to_C_gint(Xen_call_with_2_args(Xen_car((Xen)func_info),
+ C_to_Xen_gint(current_page),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static gint gxg_recent_sort(GtkRecentInfo* a, GtkRecentInfo* b, gpointer func_info)
{
- if (!XEN_LIST_P((XEN)func_info)) return((gint)0);
- return(XEN_TO_C_gint(XEN_CALL_3(XEN_CAR((XEN)func_info),
- C_TO_XEN_GtkRecentInfo_(a),
- C_TO_XEN_GtkRecentInfo_(b),
- XEN_CADR((XEN)func_info),
- c__FUNCTION__)));
+ if (!Xen_is_list((Xen)func_info)) return((gint)0);
+ return(Xen_to_C_gint(Xen_call_with_3_args(Xen_car((Xen)func_info),
+ C_to_Xen_GtkRecentInfo_(a),
+ C_to_Xen_GtkRecentInfo_(b),
+ Xen_cadr((Xen)func_info),
+ __func__)));
}
static gboolean gxg_func3(GtkWidget *w, GdkEventAny *ev, gpointer data)
{
- return(XEN_TO_C_BOOLEAN(XEN_CALL_3(XEN_CAR((XEN)data),
- C_TO_XEN_GtkWidget_(w),
- C_TO_XEN_GdkEventAny_(ev),
- XEN_CADR((XEN)data),
- c__FUNCTION__)));
+ return(Xen_boolean_to_C_bool(Xen_call_with_3_args(Xen_car((Xen)data),
+ C_to_Xen_GtkWidget_(w),
+ C_to_Xen_GdkEventAny_(ev),
+ Xen_cadr((Xen)data),
+ __func__)));
}
static gboolean gxg_func4(GtkPrintOperation *op, GtkPrintContext *context, gint page_nr, gpointer data)
{
- return(XEN_TO_C_BOOLEAN(XEN_CALL_4(XEN_CAR((XEN)data),
- C_TO_XEN_GtkPrintOperation_(op),
- C_TO_XEN_GtkPrintContext_(context),
- C_TO_XEN_INT(page_nr),
- XEN_CADR((XEN)data),
- c__FUNCTION__)));
+ return(Xen_boolean_to_C_bool(Xen_call_with_4_args(Xen_car((Xen)data),
+ C_to_Xen_GtkPrintOperation_(op),
+ C_to_Xen_GtkPrintContext_(context),
+ C_int_to_Xen_integer(page_nr),
+ Xen_cadr((Xen)data),
+ __func__)));
}
/* ---------------------------------------- functions ---------------------------------------- */
-static XEN gxg_g_type_name(XEN type)
+static Xen gxg_g_unichar_validate(Xen ch)
+{
+ #define H_g_unichar_validate "gboolean g_unichar_validate(gunichar ch)"
+ Xen_check_type(Xen_is_gunichar(ch), ch, 1, "g_unichar_validate", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_validate(Xen_to_C_gunichar(ch))));
+}
+
+static Xen gxg_g_unichar_isalnum(Xen c)
+{
+ #define H_g_unichar_isalnum "gboolean g_unichar_isalnum(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isalnum", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isalnum(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_isalpha(Xen c)
+{
+ #define H_g_unichar_isalpha "gboolean g_unichar_isalpha(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isalpha", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isalpha(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_iscntrl(Xen c)
+{
+ #define H_g_unichar_iscntrl "gboolean g_unichar_iscntrl(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_iscntrl", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_iscntrl(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_isdefined(Xen c)
+{
+ #define H_g_unichar_isdefined "gboolean g_unichar_isdefined(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isdefined", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isdefined(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_isdigit(Xen c)
+{
+ #define H_g_unichar_isdigit "gboolean g_unichar_isdigit(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isdigit", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isdigit(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_isgraph(Xen c)
+{
+ #define H_g_unichar_isgraph "gboolean g_unichar_isgraph(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isgraph", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isgraph(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_islower(Xen c)
+{
+ #define H_g_unichar_islower "gboolean g_unichar_islower(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_islower", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_islower(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_ismark(Xen c)
+{
+ #define H_g_unichar_ismark "gboolean g_unichar_ismark(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_ismark", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_ismark(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_isprint(Xen c)
+{
+ #define H_g_unichar_isprint "gboolean g_unichar_isprint(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isprint", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isprint(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_ispunct(Xen c)
+{
+ #define H_g_unichar_ispunct "gboolean g_unichar_ispunct(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_ispunct", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_ispunct(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_isspace(Xen c)
+{
+ #define H_g_unichar_isspace "gboolean g_unichar_isspace(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isspace", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isspace(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_istitle(Xen c)
+{
+ #define H_g_unichar_istitle "gboolean g_unichar_istitle(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_istitle", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_istitle(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_isupper(Xen c)
+{
+ #define H_g_unichar_isupper "gboolean g_unichar_isupper(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isupper", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isupper(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_isxdigit(Xen c)
+{
+ #define H_g_unichar_isxdigit "gboolean g_unichar_isxdigit(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_isxdigit", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_isxdigit(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_iswide(Xen c)
+{
+ #define H_g_unichar_iswide "gboolean g_unichar_iswide(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_iswide", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_iswide(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_iswide_cjk(Xen c)
+{
+ #define H_g_unichar_iswide_cjk "gboolean g_unichar_iswide_cjk(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_iswide_cjk", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_iswide_cjk(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_iszerowidth(Xen c)
+{
+ #define H_g_unichar_iszerowidth "gboolean g_unichar_iszerowidth(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_iszerowidth", "gunichar");
+ return(C_to_Xen_gboolean(g_unichar_iszerowidth(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_toupper(Xen c)
+{
+ #define H_g_unichar_toupper "gunichar g_unichar_toupper(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_toupper", "gunichar");
+ return(C_to_Xen_gunichar(g_unichar_toupper(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_tolower(Xen c)
+{
+ #define H_g_unichar_tolower "gunichar g_unichar_tolower(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_tolower", "gunichar");
+ return(C_to_Xen_gunichar(g_unichar_tolower(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_totitle(Xen c)
+{
+ #define H_g_unichar_totitle "gunichar g_unichar_totitle(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_totitle", "gunichar");
+ return(C_to_Xen_gunichar(g_unichar_totitle(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_digit_value(Xen c)
+{
+ #define H_g_unichar_digit_value "gint g_unichar_digit_value(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_digit_value", "gunichar");
+ return(C_to_Xen_gint(g_unichar_digit_value(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_xdigit_value(Xen c)
+{
+ #define H_g_unichar_xdigit_value "gint g_unichar_xdigit_value(gunichar c)"
+ Xen_check_type(Xen_is_gunichar(c), c, 1, "g_unichar_xdigit_value", "gunichar");
+ return(C_to_Xen_gint(g_unichar_xdigit_value(Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_unichar_combining_class(Xen uc)
+{
+ #define H_g_unichar_combining_class "gint g_unichar_combining_class(gunichar uc)"
+ Xen_check_type(Xen_is_gunichar(uc), uc, 1, "g_unichar_combining_class", "gunichar");
+ return(C_to_Xen_gint(g_unichar_combining_class(Xen_to_C_gunichar(uc))));
+}
+
+static Xen gxg_g_unicode_canonical_ordering(Xen string, Xen len)
+{
+ #define H_g_unicode_canonical_ordering "void g_unicode_canonical_ordering(gunichar* string, gsize len)"
+ Xen_check_type(Xen_is_gunichar_(string), string, 1, "g_unicode_canonical_ordering", "gunichar*");
+ Xen_check_type(Xen_is_gsize(len), len, 2, "g_unicode_canonical_ordering", "gsize");
+ g_unicode_canonical_ordering(Xen_to_C_gunichar_(string), Xen_to_C_gsize(len));
+ return(Xen_false);
+}
+
+static Xen gxg_g_utf8_get_char(Xen p)
+{
+ #define H_g_utf8_get_char "gunichar g_utf8_get_char(gchar* p)"
+ Xen_check_type(Xen_is_gchar_(p), p, 1, "g_utf8_get_char", "gchar*");
+ return(C_to_Xen_gunichar(g_utf8_get_char((const gchar*)Xen_to_C_gchar_(p))));
+}
+
+static Xen gxg_g_utf8_get_char_validated(Xen p, Xen max_len)
+{
+ #define H_g_utf8_get_char_validated "gunichar g_utf8_get_char_validated(gchar* p, gssize max_len)"
+ Xen_check_type(Xen_is_gchar_(p), p, 1, "g_utf8_get_char_validated", "gchar*");
+ Xen_check_type(Xen_is_gssize(max_len), max_len, 2, "g_utf8_get_char_validated", "gssize");
+ return(C_to_Xen_gunichar(g_utf8_get_char_validated((const gchar*)Xen_to_C_gchar_(p), Xen_to_C_gssize(max_len))));
+}
+
+static Xen gxg_g_utf8_prev_char(Xen p)
+{
+ #define H_g_utf8_prev_char "gchar* g_utf8_prev_char(gchar* p)"
+ Xen_check_type(Xen_is_gchar_(p), p, 1, "g_utf8_prev_char", "gchar*");
+ return(C_to_Xen_gchar_(g_utf8_prev_char((const gchar*)Xen_to_C_gchar_(p))));
+}
+
+static Xen gxg_g_utf8_find_next_char(Xen p, Xen end)
+{
+ #define H_g_utf8_find_next_char "gchar* g_utf8_find_next_char(gchar* p, gchar* end)"
+ Xen_check_type(Xen_is_gchar_(p), p, 1, "g_utf8_find_next_char", "gchar*");
+ Xen_check_type(Xen_is_gchar_(end), end, 2, "g_utf8_find_next_char", "gchar*");
+ return(C_to_Xen_gchar_(g_utf8_find_next_char((const gchar*)Xen_to_C_gchar_(p), (const gchar*)Xen_to_C_gchar_(end))));
+}
+
+static Xen gxg_g_utf8_find_prev_char(Xen str, Xen p)
+{
+ #define H_g_utf8_find_prev_char "gchar* g_utf8_find_prev_char(gchar* str, gchar* p)"
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_find_prev_char", "gchar*");
+ Xen_check_type(Xen_is_gchar_(p), p, 2, "g_utf8_find_prev_char", "gchar*");
+ return(C_to_Xen_gchar_(g_utf8_find_prev_char((const gchar*)Xen_to_C_gchar_(str), (const gchar*)Xen_to_C_gchar_(p))));
+}
+
+static Xen gxg_g_utf8_strlen(Xen p, Xen max)
+{
+ #define H_g_utf8_strlen "glong g_utf8_strlen(gchar* p, gssize max)"
+ Xen_check_type(Xen_is_gchar_(p), p, 1, "g_utf8_strlen", "gchar*");
+ Xen_check_type(Xen_is_gssize(max), max, 2, "g_utf8_strlen", "gssize");
+ return(C_to_Xen_glong(g_utf8_strlen((const gchar*)Xen_to_C_gchar_(p), Xen_to_C_gssize(max))));
+}
+
+static Xen gxg_g_utf8_strchr(Xen p, Xen len, Xen c)
+{
+ #define H_g_utf8_strchr "gchar* g_utf8_strchr(gchar* p, gssize len, gunichar c)"
+ Xen_check_type(Xen_is_gchar_(p), p, 1, "g_utf8_strchr", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_strchr", "gssize");
+ Xen_check_type(Xen_is_gunichar(c), c, 3, "g_utf8_strchr", "gunichar");
+ return(C_to_Xen_gchar_(g_utf8_strchr((const gchar*)Xen_to_C_gchar_(p), Xen_to_C_gssize(len), Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_utf8_strrchr(Xen p, Xen len, Xen c)
+{
+ #define H_g_utf8_strrchr "gchar* g_utf8_strrchr(gchar* p, gssize len, gunichar c)"
+ Xen_check_type(Xen_is_gchar_(p), p, 1, "g_utf8_strrchr", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_strrchr", "gssize");
+ Xen_check_type(Xen_is_gunichar(c), c, 3, "g_utf8_strrchr", "gunichar");
+ return(C_to_Xen_gchar_(g_utf8_strrchr((const gchar*)Xen_to_C_gchar_(p), Xen_to_C_gssize(len), Xen_to_C_gunichar(c))));
+}
+
+static Xen gxg_g_utf8_strreverse(Xen str, Xen len)
+{
+ #define H_g_utf8_strreverse "gchar* g_utf8_strreverse(gchar* str, gssize len)"
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_strreverse", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_strreverse", "gssize");
+ return(C_to_Xen_gchar_(g_utf8_strreverse((const gchar*)Xen_to_C_gchar_(str), Xen_to_C_gssize(len))));
+}
+
+static Xen gxg_g_utf8_validate(Xen str, Xen max_len, Xen ignore_end)
+{
+ #define H_g_utf8_validate "gboolean g_utf8_validate(gchar* str, gssize max_len, gchar** [end])"
+ gchar* ref_end = NULL;
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_validate", "gchar*");
+ Xen_check_type(Xen_is_gssize(max_len), max_len, 2, "g_utf8_validate", "gssize");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(g_utf8_validate((const gchar*)Xen_to_C_gchar_(str), Xen_to_C_gssize(max_len), (const gchar**)&ref_end));
+ return(Xen_list_2(result, C_to_Xen_gchar_(ref_end)));
+ }
+}
+
+static Xen gxg_g_utf8_strup(Xen str, Xen len)
+{
+ #define H_g_utf8_strup "gchar* g_utf8_strup(gchar* str, gssize len)"
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_strup", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_strup", "gssize");
+ return(C_to_Xen_gchar_(g_utf8_strup((const gchar*)Xen_to_C_gchar_(str), Xen_to_C_gssize(len))));
+}
+
+static Xen gxg_g_utf8_strdown(Xen str, Xen len)
+{
+ #define H_g_utf8_strdown "gchar* g_utf8_strdown(gchar* str, gssize len)"
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_strdown", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_strdown", "gssize");
+ return(C_to_Xen_gchar_(g_utf8_strdown((const gchar*)Xen_to_C_gchar_(str), Xen_to_C_gssize(len))));
+}
+
+static Xen gxg_g_utf8_casefold(Xen str, Xen len)
{
- #define H_g_type_name "gchar* g_type_name(GType type)"
- XEN_ASSERT_TYPE(XEN_GType_P(type), type, 1, "g_type_name", "GType");
- return(C_TO_XEN_gchar_(g_type_name(XEN_TO_C_GType(type))));
+ #define H_g_utf8_casefold "gchar* g_utf8_casefold(gchar* str, gssize len)"
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_casefold", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_casefold", "gssize");
+ return(C_to_Xen_gchar_(g_utf8_casefold((const gchar*)Xen_to_C_gchar_(str), Xen_to_C_gssize(len))));
}
-static XEN gxg_g_type_qname(XEN type)
+static Xen gxg_g_utf8_normalize(Xen str, Xen len, Xen mode)
{
- #define H_g_type_qname "GQuark g_type_qname(GType type)"
- XEN_ASSERT_TYPE(XEN_GType_P(type), type, 1, "g_type_qname", "GType");
- return(C_TO_XEN_GQuark(g_type_qname(XEN_TO_C_GType(type))));
+ #define H_g_utf8_normalize "gchar* g_utf8_normalize(gchar* str, gssize len, GNormalizeMode mode)"
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_normalize", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_normalize", "gssize");
+ Xen_check_type(Xen_is_GNormalizeMode(mode), mode, 3, "g_utf8_normalize", "GNormalizeMode");
+ return(C_to_Xen_gchar_(g_utf8_normalize((const gchar*)Xen_to_C_gchar_(str), Xen_to_C_gssize(len), Xen_to_C_GNormalizeMode(mode))));
}
-static XEN gxg_g_type_from_name(XEN name)
+static Xen gxg_g_utf8_collate(Xen str1, Xen str2)
{
- #define H_g_type_from_name "GType g_type_from_name(gchar* name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "g_type_from_name", "gchar*");
- return(C_TO_XEN_GType(g_type_from_name(XEN_TO_C_gchar_(name))));
+ #define H_g_utf8_collate "gint g_utf8_collate(gchar* str1, gchar* str2)"
+ Xen_check_type(Xen_is_gchar_(str1), str1, 1, "g_utf8_collate", "gchar*");
+ Xen_check_type(Xen_is_gchar_(str2), str2, 2, "g_utf8_collate", "gchar*");
+ return(C_to_Xen_gint(g_utf8_collate((const gchar*)Xen_to_C_gchar_(str1), (const gchar*)Xen_to_C_gchar_(str2))));
}
-static XEN gxg_g_type_parent(XEN type)
+static Xen gxg_g_utf8_collate_key(Xen str, Xen len)
{
- #define H_g_type_parent "GType g_type_parent(GType type)"
- XEN_ASSERT_TYPE(XEN_GType_P(type), type, 1, "g_type_parent", "GType");
- return(C_TO_XEN_GType(g_type_parent(XEN_TO_C_GType(type))));
+ #define H_g_utf8_collate_key "gchar* g_utf8_collate_key(gchar* str, gssize len)"
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_collate_key", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_collate_key", "gssize");
+ return(C_to_Xen_gchar_(g_utf8_collate_key((const gchar*)Xen_to_C_gchar_(str), Xen_to_C_gssize(len))));
}
-static XEN gxg_g_type_is_a(XEN type, XEN is_a_type)
+static Xen gxg_g_utf8_collate_key_for_filename(Xen str, Xen len)
{
- #define H_g_type_is_a "gboolean g_type_is_a(GType type, GType is_a_type)"
- XEN_ASSERT_TYPE(XEN_GType_P(type), type, 1, "g_type_is_a", "GType");
- XEN_ASSERT_TYPE(XEN_GType_P(is_a_type), is_a_type, 2, "g_type_is_a", "GType");
- return(C_TO_XEN_gboolean(g_type_is_a(XEN_TO_C_GType(type), XEN_TO_C_GType(is_a_type))));
+ #define H_g_utf8_collate_key_for_filename "gchar* g_utf8_collate_key_for_filename(gchar* str, gssize len)"
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "g_utf8_collate_key_for_filename", "gchar*");
+ Xen_check_type(Xen_is_gssize(len), len, 2, "g_utf8_collate_key_for_filename", "gssize");
+ return(C_to_Xen_gchar_(g_utf8_collate_key_for_filename((const gchar*)Xen_to_C_gchar_(str), Xen_to_C_gssize(len))));
}
-static XEN gxg_g_cclosure_new(XEN func, XEN func_info, XEN destroy_data)
+static Xen gxg_g_cclosure_new(Xen func, Xen func_info, Xen destroy_data)
{
#define H_g_cclosure_new "GClosure* g_cclosure_new(GCallback func, lambda_data func_info, GClosureNotify destroy_data)"
- XEN_ASSERT_TYPE(XEN_GCallback_P(func), func, 1, "g_cclosure_new", "GCallback");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 2, "g_cclosure_new", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GClosureNotify_P(destroy_data) || XEN_FALSE_P(destroy_data), destroy_data, 3, "g_cclosure_new", "GClosureNotify");
+ Xen_check_type(Xen_is_GCallback(func), func, 1, "g_cclosure_new", "GCallback");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 2, "g_cclosure_new", "lambda_data");
+ Xen_check_type(Xen_is_GClosureNotify(destroy_data) || Xen_is_false(destroy_data), destroy_data, 3, "g_cclosure_new", "GClosureNotify");
{
- XEN result = XEN_FALSE;
+ Xen result;
int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_GClosure_(g_cclosure_new(XEN_TO_C_GCallback(func), XEN_TO_C_lambda_data(func_info), XEN_TO_C_GClosureNotify(destroy_data)));
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_GClosure_(g_cclosure_new(Xen_to_C_GCallback(func), Xen_to_C_lambda_data(func_info), Xen_to_C_GClosureNotify(destroy_data)));
return(result);
}
}
-static XEN gxg_g_signal_newv(XEN arglist)
+static Xen gxg_g_signal_newv(Xen arglist)
{
#define H_g_signal_newv "guint g_signal_newv(gchar* signal_name, GType itype, GSignalFlags signal_flags, \
GClosure* class_closure, GSignalAccumulator accumulator, gpointer accu_data, GSignalCMarshaller c_marshaller, \
GType return_type, guint n_params, GType* param_types)"
- XEN signal_name, itype, signal_flags, class_closure, accumulator, accu_data, c_marshaller, return_type, n_params, param_types;
- signal_name = XEN_LIST_REF(arglist, 0);
- itype = XEN_LIST_REF(arglist, 1);
- signal_flags = XEN_LIST_REF(arglist, 2);
- class_closure = XEN_LIST_REF(arglist, 3);
- accumulator = XEN_LIST_REF(arglist, 4);
- accu_data = XEN_LIST_REF(arglist, 5);
- c_marshaller = XEN_LIST_REF(arglist, 6);
- return_type = XEN_LIST_REF(arglist, 7);
- n_params = XEN_LIST_REF(arglist, 8);
- param_types = XEN_LIST_REF(arglist, 9);
- XEN_ASSERT_TYPE(XEN_gchar__P(signal_name), signal_name, 1, "g_signal_newv", "gchar*");
- XEN_ASSERT_TYPE(XEN_GType_P(itype), itype, 2, "g_signal_newv", "GType");
- XEN_ASSERT_TYPE(XEN_GSignalFlags_P(signal_flags), signal_flags, 3, "g_signal_newv", "GSignalFlags");
- XEN_ASSERT_TYPE(XEN_GClosure__P(class_closure) || XEN_FALSE_P(class_closure), class_closure, 4, "g_signal_newv", "GClosure*");
- XEN_ASSERT_TYPE(XEN_GSignalAccumulator_P(accumulator), accumulator, 5, "g_signal_newv", "GSignalAccumulator");
- XEN_ASSERT_TYPE(XEN_gpointer_P(accu_data), accu_data, 6, "g_signal_newv", "gpointer");
- XEN_ASSERT_TYPE(XEN_GSignalCMarshaller_P(c_marshaller), c_marshaller, 7, "g_signal_newv", "GSignalCMarshaller");
- XEN_ASSERT_TYPE(XEN_GType_P(return_type), return_type, 8, "g_signal_newv", "GType");
- XEN_ASSERT_TYPE(XEN_guint_P(n_params), n_params, 9, "g_signal_newv", "guint");
- XEN_ASSERT_TYPE(XEN_GType__P(param_types), param_types, 10, "g_signal_newv", "GType*");
- return(C_TO_XEN_guint(g_signal_newv(XEN_TO_C_gchar_(signal_name), XEN_TO_C_GType(itype), XEN_TO_C_GSignalFlags(signal_flags),
- XEN_TO_C_GClosure_(class_closure), XEN_TO_C_GSignalAccumulator(accumulator), XEN_TO_C_gpointer(accu_data),
- XEN_TO_C_GSignalCMarshaller(c_marshaller), XEN_TO_C_GType(return_type), XEN_TO_C_guint(n_params),
- XEN_TO_C_GType_(param_types))));
-}
-
-static XEN gxg_g_signal_lookup(XEN name, XEN itype)
+ Xen signal_name, itype, signal_flags, class_closure, accumulator, accu_data, c_marshaller, return_type, n_params, param_types;
+ signal_name = Xen_list_ref(arglist, 0);
+ itype = Xen_list_ref(arglist, 1);
+ signal_flags = Xen_list_ref(arglist, 2);
+ class_closure = Xen_list_ref(arglist, 3);
+ accumulator = Xen_list_ref(arglist, 4);
+ accu_data = Xen_list_ref(arglist, 5);
+ c_marshaller = Xen_list_ref(arglist, 6);
+ return_type = Xen_list_ref(arglist, 7);
+ n_params = Xen_list_ref(arglist, 8);
+ param_types = Xen_list_ref(arglist, 9);
+ Xen_check_type(Xen_is_gchar_(signal_name), signal_name, 1, "g_signal_newv", "gchar*");
+ Xen_check_type(Xen_is_GType(itype), itype, 2, "g_signal_newv", "GType");
+ Xen_check_type(Xen_is_GSignalFlags(signal_flags), signal_flags, 3, "g_signal_newv", "GSignalFlags");
+ Xen_check_type(Xen_is_GClosure_(class_closure) || Xen_is_false(class_closure), class_closure, 4, "g_signal_newv", "GClosure*");
+ Xen_check_type(Xen_is_GSignalAccumulator(accumulator), accumulator, 5, "g_signal_newv", "GSignalAccumulator");
+ Xen_check_type(Xen_is_gpointer(accu_data), accu_data, 6, "g_signal_newv", "gpointer");
+ Xen_check_type(Xen_is_GSignalCMarshaller(c_marshaller), c_marshaller, 7, "g_signal_newv", "GSignalCMarshaller");
+ Xen_check_type(Xen_is_GType(return_type), return_type, 8, "g_signal_newv", "GType");
+ Xen_check_type(Xen_is_guint(n_params), n_params, 9, "g_signal_newv", "guint");
+ Xen_check_type(Xen_is_GType_(param_types), param_types, 10, "g_signal_newv", "GType*");
+ return(C_to_Xen_guint(g_signal_newv(Xen_to_C_gchar_(signal_name), Xen_to_C_GType(itype), Xen_to_C_GSignalFlags(signal_flags),
+ Xen_to_C_GClosure_(class_closure), Xen_to_C_GSignalAccumulator(accumulator), Xen_to_C_gpointer(accu_data),
+ Xen_to_C_GSignalCMarshaller(c_marshaller), Xen_to_C_GType(return_type), Xen_to_C_guint(n_params),
+ Xen_to_C_GType_(param_types))));
+}
+
+static Xen gxg_g_signal_lookup(Xen name, Xen itype)
{
#define H_g_signal_lookup "guint g_signal_lookup(gchar* name, GType itype)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "g_signal_lookup", "gchar*");
- XEN_ASSERT_TYPE(XEN_GType_P(itype), itype, 2, "g_signal_lookup", "GType");
- return(C_TO_XEN_guint(g_signal_lookup(XEN_TO_C_gchar_(name), XEN_TO_C_GType(itype))));
+ Xen_check_type(Xen_is_gchar_(name), name, 1, "g_signal_lookup", "gchar*");
+ Xen_check_type(Xen_is_GType(itype), itype, 2, "g_signal_lookup", "GType");
+ return(C_to_Xen_guint(g_signal_lookup(Xen_to_C_gchar_(name), Xen_to_C_GType(itype))));
}
-static XEN gxg_g_signal_name(XEN signal_id)
+static Xen gxg_g_signal_name(Xen signal_id)
{
#define H_g_signal_name "gchar* g_signal_name(guint signal_id)"
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 1, "g_signal_name", "guint");
- return(C_TO_XEN_gchar_(g_signal_name(XEN_TO_C_guint(signal_id))));
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 1, "g_signal_name", "guint");
+ return(C_to_Xen_gchar_(g_signal_name(Xen_to_C_guint(signal_id))));
}
-static XEN gxg_g_signal_query(XEN signal_id, XEN query)
+static Xen gxg_g_signal_query(Xen signal_id, Xen query)
{
#define H_g_signal_query "void g_signal_query(guint signal_id, GSignalQuery* query)"
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 1, "g_signal_query", "guint");
- XEN_ASSERT_TYPE(XEN_GSignalQuery__P(query), query, 2, "g_signal_query", "GSignalQuery*");
- g_signal_query(XEN_TO_C_guint(signal_id), XEN_TO_C_GSignalQuery_(query));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 1, "g_signal_query", "guint");
+ Xen_check_type(Xen_is_GSignalQuery_(query), query, 2, "g_signal_query", "GSignalQuery*");
+ g_signal_query(Xen_to_C_guint(signal_id), Xen_to_C_GSignalQuery_(query));
+ return(Xen_false);
}
-static XEN gxg_g_signal_list_ids(XEN itype, XEN n_ids)
+static Xen gxg_g_signal_list_ids(Xen itype, Xen n_ids)
{
#define H_g_signal_list_ids "guint* g_signal_list_ids(GType itype, guint* n_ids)"
- XEN_ASSERT_TYPE(XEN_GType_P(itype), itype, 1, "g_signal_list_ids", "GType");
- XEN_ASSERT_TYPE(XEN_guint__P(n_ids), n_ids, 2, "g_signal_list_ids", "guint*");
- return(C_TO_XEN_guint_(g_signal_list_ids(XEN_TO_C_GType(itype), XEN_TO_C_guint_(n_ids))));
+ Xen_check_type(Xen_is_GType(itype), itype, 1, "g_signal_list_ids", "GType");
+ Xen_check_type(Xen_is_guint_(n_ids), n_ids, 2, "g_signal_list_ids", "guint*");
+ return(C_to_Xen_guint_(g_signal_list_ids(Xen_to_C_GType(itype), Xen_to_C_guint_(n_ids))));
}
-static XEN gxg_g_signal_parse_name(XEN detailed_signal, XEN itype, XEN ignore_signal_id_p, XEN ignore_detail_p, XEN force_detail_quark)
+static Xen gxg_g_signal_parse_name(Xen detailed_signal, Xen itype, Xen ignore_signal_id_p, Xen ignore_detail_p, Xen force_detail_quark)
{
#define H_g_signal_parse_name "gboolean g_signal_parse_name(gchar* detailed_signal, GType itype, guint* [signal_id_p], \
GQuark* [detail_p], gboolean force_detail_quark)"
guint ref_signal_id_p;
GQuark ref_detail_p;
- XEN_ASSERT_TYPE(XEN_gchar__P(detailed_signal), detailed_signal, 1, "g_signal_parse_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_GType_P(itype), itype, 2, "g_signal_parse_name", "GType");
- XEN_ASSERT_TYPE(XEN_gboolean_P(force_detail_quark), force_detail_quark, 5, "g_signal_parse_name", "gboolean");
+ Xen_check_type(Xen_is_gchar_(detailed_signal), detailed_signal, 1, "g_signal_parse_name", "gchar*");
+ Xen_check_type(Xen_is_GType(itype), itype, 2, "g_signal_parse_name", "GType");
+ Xen_check_type(Xen_is_gboolean(force_detail_quark), force_detail_quark, 5, "g_signal_parse_name", "gboolean");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(g_signal_parse_name(XEN_TO_C_gchar_(detailed_signal), XEN_TO_C_GType(itype), &ref_signal_id_p,
- &ref_detail_p, XEN_TO_C_gboolean(force_detail_quark)));
- return(XEN_LIST_3(result, C_TO_XEN_guint(ref_signal_id_p), C_TO_XEN_GQuark(ref_detail_p)));
+ Xen result;
+ result = C_to_Xen_gboolean(g_signal_parse_name(Xen_to_C_gchar_(detailed_signal), Xen_to_C_GType(itype), &ref_signal_id_p,
+ &ref_detail_p, Xen_to_C_gboolean(force_detail_quark)));
+ return(Xen_list_3(result, C_to_Xen_guint(ref_signal_id_p), C_to_Xen_GQuark(ref_detail_p)));
}
}
-static XEN gxg_g_signal_get_invocation_hint(XEN instance)
+static Xen gxg_g_signal_get_invocation_hint(Xen instance)
{
#define H_g_signal_get_invocation_hint "GSignalInvocationHint* g_signal_get_invocation_hint(gpointer instance)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_get_invocation_hint", "gpointer");
- return(C_TO_XEN_GSignalInvocationHint_(g_signal_get_invocation_hint(XEN_TO_C_gpointer(instance))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_get_invocation_hint", "gpointer");
+ return(C_to_Xen_GSignalInvocationHint_(g_signal_get_invocation_hint(Xen_to_C_gpointer(instance))));
}
-static XEN gxg_g_signal_stop_emission(XEN instance, XEN signal_id, XEN detail)
+static Xen gxg_g_signal_stop_emission(Xen instance, Xen signal_id, Xen detail)
{
#define H_g_signal_stop_emission "void g_signal_stop_emission(gpointer instance, guint signal_id, GQuark detail)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_stop_emission", "gpointer");
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 2, "g_signal_stop_emission", "guint");
- XEN_ASSERT_TYPE(XEN_GQuark_P(detail), detail, 3, "g_signal_stop_emission", "GQuark");
- g_signal_stop_emission(XEN_TO_C_gpointer(instance), XEN_TO_C_guint(signal_id), XEN_TO_C_GQuark(detail));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_stop_emission", "gpointer");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 2, "g_signal_stop_emission", "guint");
+ Xen_check_type(Xen_is_GQuark(detail), detail, 3, "g_signal_stop_emission", "GQuark");
+ g_signal_stop_emission(Xen_to_C_gpointer(instance), Xen_to_C_guint(signal_id), Xen_to_C_GQuark(detail));
+ return(Xen_false);
}
-static XEN gxg_g_signal_stop_emission_by_name(XEN instance, XEN detailed_signal)
+static Xen gxg_g_signal_stop_emission_by_name(Xen instance, Xen detailed_signal)
{
#define H_g_signal_stop_emission_by_name "void g_signal_stop_emission_by_name(gpointer instance, gchar* detailed_signal)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_stop_emission_by_name", "gpointer");
- XEN_ASSERT_TYPE(XEN_gchar__P(detailed_signal), detailed_signal, 2, "g_signal_stop_emission_by_name", "gchar*");
- g_signal_stop_emission_by_name(XEN_TO_C_gpointer(instance), XEN_TO_C_gchar_(detailed_signal));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_stop_emission_by_name", "gpointer");
+ Xen_check_type(Xen_is_gchar_(detailed_signal), detailed_signal, 2, "g_signal_stop_emission_by_name", "gchar*");
+ g_signal_stop_emission_by_name(Xen_to_C_gpointer(instance), Xen_to_C_gchar_(detailed_signal));
+ return(Xen_false);
}
-static XEN gxg_g_signal_add_emission_hook(XEN signal_id, XEN quark, XEN hook_func, XEN func_info, XEN data_destroy)
+static Xen gxg_g_signal_add_emission_hook(Xen signal_id, Xen quark, Xen hook_func, Xen func_info, Xen data_destroy)
{
#define H_g_signal_add_emission_hook "gulong g_signal_add_emission_hook(guint signal_id, GQuark quark, \
GSignalEmissionHook hook_func, lambda_data func_info, GtkDestroyNotify data_destroy)"
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 1, "g_signal_add_emission_hook", "guint");
- XEN_ASSERT_TYPE(XEN_GQuark_P(quark), quark, 2, "g_signal_add_emission_hook", "GQuark");
- XEN_ASSERT_TYPE(XEN_GSignalEmissionHook_P(hook_func), hook_func, 3, "g_signal_add_emission_hook", "GSignalEmissionHook");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "g_signal_add_emission_hook", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(data_destroy), data_destroy, 5, "g_signal_add_emission_hook", "GtkDestroyNotify");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 1, "g_signal_add_emission_hook", "guint");
+ Xen_check_type(Xen_is_GQuark(quark), quark, 2, "g_signal_add_emission_hook", "GQuark");
+ Xen_check_type(Xen_is_GSignalEmissionHook(hook_func), hook_func, 3, "g_signal_add_emission_hook", "GSignalEmissionHook");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "g_signal_add_emission_hook", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(data_destroy), data_destroy, 5, "g_signal_add_emission_hook", "GtkDestroyNotify");
{
- XEN result = XEN_FALSE;
- XEN gxg_ptr = XEN_LIST_5(XEN_FALSE, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen result;
+ Xen gxg_ptr = Xen_list_5(Xen_false, func_info, Xen_false, Xen_false, Xen_false);
xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, data_destroy);
- result = C_TO_XEN_gulong(g_signal_add_emission_hook(XEN_TO_C_guint(signal_id), XEN_TO_C_GQuark(quark), XEN_TO_C_GSignalEmissionHook(hook_func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(data_destroy)));
+ Xen_list_set(gxg_ptr, 3, data_destroy);
+ result = C_to_Xen_gulong(g_signal_add_emission_hook(Xen_to_C_guint(signal_id), Xen_to_C_GQuark(quark), Xen_to_C_GSignalEmissionHook(hook_func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GtkDestroyNotify(data_destroy)));
return(result);
}
}
-static XEN gxg_g_signal_remove_emission_hook(XEN signal_id, XEN hook_id)
+static Xen gxg_g_signal_remove_emission_hook(Xen signal_id, Xen hook_id)
{
#define H_g_signal_remove_emission_hook "void g_signal_remove_emission_hook(guint signal_id, gulong hook_id)"
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 1, "g_signal_remove_emission_hook", "guint");
- XEN_ASSERT_TYPE(XEN_gulong_P(hook_id), hook_id, 2, "g_signal_remove_emission_hook", "gulong");
- g_signal_remove_emission_hook(XEN_TO_C_guint(signal_id), XEN_TO_C_gulong(hook_id));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 1, "g_signal_remove_emission_hook", "guint");
+ Xen_check_type(Xen_is_gulong(hook_id), hook_id, 2, "g_signal_remove_emission_hook", "gulong");
+ g_signal_remove_emission_hook(Xen_to_C_guint(signal_id), Xen_to_C_gulong(hook_id));
+ return(Xen_false);
}
-static XEN gxg_g_signal_has_handler_pending(XEN instance, XEN signal_id, XEN detail, XEN may_be_blocked)
+static Xen gxg_g_signal_has_handler_pending(Xen instance, Xen signal_id, Xen detail, Xen may_be_blocked)
{
#define H_g_signal_has_handler_pending "gboolean g_signal_has_handler_pending(gpointer instance, guint signal_id, \
GQuark detail, gboolean may_be_blocked)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_has_handler_pending", "gpointer");
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 2, "g_signal_has_handler_pending", "guint");
- XEN_ASSERT_TYPE(XEN_GQuark_P(detail), detail, 3, "g_signal_has_handler_pending", "GQuark");
- XEN_ASSERT_TYPE(XEN_gboolean_P(may_be_blocked), may_be_blocked, 4, "g_signal_has_handler_pending", "gboolean");
- return(C_TO_XEN_gboolean(g_signal_has_handler_pending(XEN_TO_C_gpointer(instance), XEN_TO_C_guint(signal_id), XEN_TO_C_GQuark(detail),
- XEN_TO_C_gboolean(may_be_blocked))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_has_handler_pending", "gpointer");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 2, "g_signal_has_handler_pending", "guint");
+ Xen_check_type(Xen_is_GQuark(detail), detail, 3, "g_signal_has_handler_pending", "GQuark");
+ Xen_check_type(Xen_is_gboolean(may_be_blocked), may_be_blocked, 4, "g_signal_has_handler_pending", "gboolean");
+ return(C_to_Xen_gboolean(g_signal_has_handler_pending(Xen_to_C_gpointer(instance), Xen_to_C_guint(signal_id), Xen_to_C_GQuark(detail),
+ Xen_to_C_gboolean(may_be_blocked))));
}
-static XEN gxg_g_signal_connect_closure_by_id(XEN instance, XEN signal_id, XEN detail, XEN closure, XEN after)
+static Xen gxg_g_signal_connect_closure_by_id(Xen instance, Xen signal_id, Xen detail, Xen closure, Xen after)
{
#define H_g_signal_connect_closure_by_id "gulong g_signal_connect_closure_by_id(gpointer instance, \
guint signal_id, GQuark detail, GClosure* closure, gboolean after)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_connect_closure_by_id", "gpointer");
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 2, "g_signal_connect_closure_by_id", "guint");
- XEN_ASSERT_TYPE(XEN_GQuark_P(detail), detail, 3, "g_signal_connect_closure_by_id", "GQuark");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure), closure, 4, "g_signal_connect_closure_by_id", "GClosure*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(after), after, 5, "g_signal_connect_closure_by_id", "gboolean");
- return(C_TO_XEN_gulong(g_signal_connect_closure_by_id(XEN_TO_C_gpointer(instance), XEN_TO_C_guint(signal_id), XEN_TO_C_GQuark(detail),
- XEN_TO_C_GClosure_(closure), XEN_TO_C_gboolean(after))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_connect_closure_by_id", "gpointer");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 2, "g_signal_connect_closure_by_id", "guint");
+ Xen_check_type(Xen_is_GQuark(detail), detail, 3, "g_signal_connect_closure_by_id", "GQuark");
+ Xen_check_type(Xen_is_GClosure_(closure), closure, 4, "g_signal_connect_closure_by_id", "GClosure*");
+ Xen_check_type(Xen_is_gboolean(after), after, 5, "g_signal_connect_closure_by_id", "gboolean");
+ return(C_to_Xen_gulong(g_signal_connect_closure_by_id(Xen_to_C_gpointer(instance), Xen_to_C_guint(signal_id), Xen_to_C_GQuark(detail),
+ Xen_to_C_GClosure_(closure), Xen_to_C_gboolean(after))));
}
-static XEN gxg_g_signal_connect_closure(XEN instance, XEN detailed_signal, XEN closure, XEN after)
+static Xen gxg_g_signal_connect_closure(Xen instance, Xen detailed_signal, Xen closure, Xen after)
{
#define H_g_signal_connect_closure "gulong g_signal_connect_closure(gpointer instance, gchar* detailed_signal, \
GClosure* closure, gboolean after)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_connect_closure", "gpointer");
- XEN_ASSERT_TYPE(XEN_gchar__P(detailed_signal), detailed_signal, 2, "g_signal_connect_closure", "gchar*");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure), closure, 3, "g_signal_connect_closure", "GClosure*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(after), after, 4, "g_signal_connect_closure", "gboolean");
- return(C_TO_XEN_gulong(g_signal_connect_closure(XEN_TO_C_gpointer(instance), XEN_TO_C_gchar_(detailed_signal), XEN_TO_C_GClosure_(closure),
- XEN_TO_C_gboolean(after))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_connect_closure", "gpointer");
+ Xen_check_type(Xen_is_gchar_(detailed_signal), detailed_signal, 2, "g_signal_connect_closure", "gchar*");
+ Xen_check_type(Xen_is_GClosure_(closure), closure, 3, "g_signal_connect_closure", "GClosure*");
+ Xen_check_type(Xen_is_gboolean(after), after, 4, "g_signal_connect_closure", "gboolean");
+ return(C_to_Xen_gulong(g_signal_connect_closure(Xen_to_C_gpointer(instance), Xen_to_C_gchar_(detailed_signal), Xen_to_C_GClosure_(closure),
+ Xen_to_C_gboolean(after))));
}
-static XEN gxg_g_signal_connect_data(XEN instance, XEN detailed_signal, XEN func, XEN func_info, XEN destroy_data, XEN connect_flags)
+static Xen gxg_g_signal_connect_data(Xen instance, Xen detailed_signal, Xen func, Xen func_info, Xen destroy_data, Xen connect_flags)
{
#define H_g_signal_connect_data "gulong g_signal_connect_data(gpointer instance, gchar* detailed_signal, \
GCallback func, lambda_data func_info, GClosureNotify destroy_data, GConnectFlags connect_flags)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_connect_data", "gpointer");
- XEN_ASSERT_TYPE(XEN_gchar__P(detailed_signal), detailed_signal, 2, "g_signal_connect_data", "gchar*");
- XEN_ASSERT_TYPE(XEN_GCallback_P(func), func, 3, "g_signal_connect_data", "GCallback");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "g_signal_connect_data", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GClosureNotify_P(destroy_data) || XEN_FALSE_P(destroy_data), destroy_data, 5, "g_signal_connect_data", "GClosureNotify");
- XEN_ASSERT_TYPE(XEN_GConnectFlags_P(connect_flags), connect_flags, 6, "g_signal_connect_data", "GConnectFlags");
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_connect_data", "gpointer");
+ Xen_check_type(Xen_is_gchar_(detailed_signal), detailed_signal, 2, "g_signal_connect_data", "gchar*");
+ Xen_check_type(Xen_is_GCallback(func), func, 3, "g_signal_connect_data", "GCallback");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "g_signal_connect_data", "lambda_data");
+ Xen_check_type(Xen_is_GClosureNotify(destroy_data) || Xen_is_false(destroy_data), destroy_data, 5, "g_signal_connect_data", "GClosureNotify");
+ Xen_check_type(Xen_is_GConnectFlags(connect_flags), connect_flags, 6, "g_signal_connect_data", "GConnectFlags");
{
- XEN result = XEN_FALSE;
+ Xen result;
int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_gulong(g_signal_connect_data(XEN_TO_C_gpointer(instance), XEN_TO_C_gchar_(detailed_signal), XEN_TO_C_GCallback(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GClosureNotify(destroy_data),
- XEN_TO_C_GConnectFlags(connect_flags)));
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_gulong(g_signal_connect_data(Xen_to_C_gpointer(instance), Xen_to_C_gchar_(detailed_signal), Xen_to_C_GCallback(func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GClosureNotify(destroy_data),
+ Xen_to_C_GConnectFlags(connect_flags)));
return(result);
}
}
-static XEN gxg_g_signal_handler_block(XEN instance, XEN handler_id)
+static Xen gxg_g_signal_handler_block(Xen instance, Xen handler_id)
{
#define H_g_signal_handler_block "void g_signal_handler_block(gpointer instance, gulong handler_id)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handler_block", "gpointer");
- XEN_ASSERT_TYPE(XEN_gulong_P(handler_id), handler_id, 2, "g_signal_handler_block", "gulong");
- g_signal_handler_block(XEN_TO_C_gpointer(instance), XEN_TO_C_gulong(handler_id));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handler_block", "gpointer");
+ Xen_check_type(Xen_is_gulong(handler_id), handler_id, 2, "g_signal_handler_block", "gulong");
+ g_signal_handler_block(Xen_to_C_gpointer(instance), Xen_to_C_gulong(handler_id));
+ return(Xen_false);
}
-static XEN gxg_g_signal_handler_unblock(XEN instance, XEN handler_id)
+static Xen gxg_g_signal_handler_unblock(Xen instance, Xen handler_id)
{
#define H_g_signal_handler_unblock "void g_signal_handler_unblock(gpointer instance, gulong handler_id)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handler_unblock", "gpointer");
- XEN_ASSERT_TYPE(XEN_gulong_P(handler_id), handler_id, 2, "g_signal_handler_unblock", "gulong");
- g_signal_handler_unblock(XEN_TO_C_gpointer(instance), XEN_TO_C_gulong(handler_id));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handler_unblock", "gpointer");
+ Xen_check_type(Xen_is_gulong(handler_id), handler_id, 2, "g_signal_handler_unblock", "gulong");
+ g_signal_handler_unblock(Xen_to_C_gpointer(instance), Xen_to_C_gulong(handler_id));
+ return(Xen_false);
}
-static XEN gxg_g_signal_handler_disconnect(XEN instance, XEN handler_id)
+static Xen gxg_g_signal_handler_disconnect(Xen instance, Xen handler_id)
{
#define H_g_signal_handler_disconnect "void g_signal_handler_disconnect(gpointer instance, gulong handler_id)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handler_disconnect", "gpointer");
- XEN_ASSERT_TYPE(XEN_gulong_P(handler_id), handler_id, 2, "g_signal_handler_disconnect", "gulong");
- g_signal_handler_disconnect(XEN_TO_C_gpointer(instance), XEN_TO_C_gulong(handler_id));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handler_disconnect", "gpointer");
+ Xen_check_type(Xen_is_gulong(handler_id), handler_id, 2, "g_signal_handler_disconnect", "gulong");
+ g_signal_handler_disconnect(Xen_to_C_gpointer(instance), Xen_to_C_gulong(handler_id));
+ return(Xen_false);
}
-static XEN gxg_g_signal_handler_is_connected(XEN instance, XEN handler_id)
+static Xen gxg_g_signal_handler_is_connected(Xen instance, Xen handler_id)
{
#define H_g_signal_handler_is_connected "gboolean g_signal_handler_is_connected(gpointer instance, \
gulong handler_id)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handler_is_connected", "gpointer");
- XEN_ASSERT_TYPE(XEN_gulong_P(handler_id), handler_id, 2, "g_signal_handler_is_connected", "gulong");
- return(C_TO_XEN_gboolean(g_signal_handler_is_connected(XEN_TO_C_gpointer(instance), XEN_TO_C_gulong(handler_id))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handler_is_connected", "gpointer");
+ Xen_check_type(Xen_is_gulong(handler_id), handler_id, 2, "g_signal_handler_is_connected", "gulong");
+ return(C_to_Xen_gboolean(g_signal_handler_is_connected(Xen_to_C_gpointer(instance), Xen_to_C_gulong(handler_id))));
}
-static XEN gxg_g_signal_handler_find(XEN instance, XEN mask, XEN signal_id, XEN detail, XEN closure, XEN func, XEN data)
+static Xen gxg_g_signal_handler_find(Xen instance, Xen mask, Xen signal_id, Xen detail, Xen closure, Xen func, Xen data)
{
#define H_g_signal_handler_find "gulong g_signal_handler_find(gpointer instance, GSignalMatchType mask, \
guint signal_id, GQuark detail, GClosure* closure, gpointer func, gpointer data)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handler_find", "gpointer");
- XEN_ASSERT_TYPE(XEN_GSignalMatchType_P(mask), mask, 2, "g_signal_handler_find", "GSignalMatchType");
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 3, "g_signal_handler_find", "guint");
- XEN_ASSERT_TYPE(XEN_GQuark_P(detail), detail, 4, "g_signal_handler_find", "GQuark");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 5, "g_signal_handler_find", "GClosure*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(func), func, 6, "g_signal_handler_find", "gpointer");
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 7, "g_signal_handler_find", "gpointer");
- return(C_TO_XEN_gulong(g_signal_handler_find(XEN_TO_C_gpointer(instance), XEN_TO_C_GSignalMatchType(mask), XEN_TO_C_guint(signal_id),
- XEN_TO_C_GQuark(detail), XEN_TO_C_GClosure_(closure), XEN_TO_C_gpointer(func),
- XEN_TO_C_gpointer(data))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handler_find", "gpointer");
+ Xen_check_type(Xen_is_GSignalMatchType(mask), mask, 2, "g_signal_handler_find", "GSignalMatchType");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 3, "g_signal_handler_find", "guint");
+ Xen_check_type(Xen_is_GQuark(detail), detail, 4, "g_signal_handler_find", "GQuark");
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 5, "g_signal_handler_find", "GClosure*");
+ Xen_check_type(Xen_is_gpointer(func), func, 6, "g_signal_handler_find", "gpointer");
+ Xen_check_type(Xen_is_gpointer(data), data, 7, "g_signal_handler_find", "gpointer");
+ return(C_to_Xen_gulong(g_signal_handler_find(Xen_to_C_gpointer(instance), Xen_to_C_GSignalMatchType(mask), Xen_to_C_guint(signal_id),
+ Xen_to_C_GQuark(detail), Xen_to_C_GClosure_(closure), Xen_to_C_gpointer(func),
+ Xen_to_C_gpointer(data))));
}
-static XEN gxg_g_signal_handlers_block_matched(XEN instance, XEN mask, XEN signal_id, XEN detail, XEN closure, XEN func, XEN data)
+static Xen gxg_g_signal_handlers_block_matched(Xen instance, Xen mask, Xen signal_id, Xen detail, Xen closure, Xen func, Xen data)
{
#define H_g_signal_handlers_block_matched "guint g_signal_handlers_block_matched(gpointer instance, \
GSignalMatchType mask, guint signal_id, GQuark detail, GClosure* closure, gpointer func, gpointer data)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handlers_block_matched", "gpointer");
- XEN_ASSERT_TYPE(XEN_GSignalMatchType_P(mask), mask, 2, "g_signal_handlers_block_matched", "GSignalMatchType");
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 3, "g_signal_handlers_block_matched", "guint");
- XEN_ASSERT_TYPE(XEN_GQuark_P(detail), detail, 4, "g_signal_handlers_block_matched", "GQuark");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 5, "g_signal_handlers_block_matched", "GClosure*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(func), func, 6, "g_signal_handlers_block_matched", "gpointer");
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 7, "g_signal_handlers_block_matched", "gpointer");
- return(C_TO_XEN_guint(g_signal_handlers_block_matched(XEN_TO_C_gpointer(instance), XEN_TO_C_GSignalMatchType(mask), XEN_TO_C_guint(signal_id),
- XEN_TO_C_GQuark(detail), XEN_TO_C_GClosure_(closure), XEN_TO_C_gpointer(func),
- XEN_TO_C_gpointer(data))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handlers_block_matched", "gpointer");
+ Xen_check_type(Xen_is_GSignalMatchType(mask), mask, 2, "g_signal_handlers_block_matched", "GSignalMatchType");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 3, "g_signal_handlers_block_matched", "guint");
+ Xen_check_type(Xen_is_GQuark(detail), detail, 4, "g_signal_handlers_block_matched", "GQuark");
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 5, "g_signal_handlers_block_matched", "GClosure*");
+ Xen_check_type(Xen_is_gpointer(func), func, 6, "g_signal_handlers_block_matched", "gpointer");
+ Xen_check_type(Xen_is_gpointer(data), data, 7, "g_signal_handlers_block_matched", "gpointer");
+ return(C_to_Xen_guint(g_signal_handlers_block_matched(Xen_to_C_gpointer(instance), Xen_to_C_GSignalMatchType(mask), Xen_to_C_guint(signal_id),
+ Xen_to_C_GQuark(detail), Xen_to_C_GClosure_(closure), Xen_to_C_gpointer(func),
+ Xen_to_C_gpointer(data))));
}
-static XEN gxg_g_signal_handlers_unblock_matched(XEN instance, XEN mask, XEN signal_id, XEN detail, XEN closure, XEN func, XEN data)
+static Xen gxg_g_signal_handlers_unblock_matched(Xen instance, Xen mask, Xen signal_id, Xen detail, Xen closure, Xen func, Xen data)
{
#define H_g_signal_handlers_unblock_matched "guint g_signal_handlers_unblock_matched(gpointer instance, \
GSignalMatchType mask, guint signal_id, GQuark detail, GClosure* closure, gpointer func, gpointer data)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handlers_unblock_matched", "gpointer");
- XEN_ASSERT_TYPE(XEN_GSignalMatchType_P(mask), mask, 2, "g_signal_handlers_unblock_matched", "GSignalMatchType");
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 3, "g_signal_handlers_unblock_matched", "guint");
- XEN_ASSERT_TYPE(XEN_GQuark_P(detail), detail, 4, "g_signal_handlers_unblock_matched", "GQuark");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 5, "g_signal_handlers_unblock_matched", "GClosure*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(func), func, 6, "g_signal_handlers_unblock_matched", "gpointer");
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 7, "g_signal_handlers_unblock_matched", "gpointer");
- return(C_TO_XEN_guint(g_signal_handlers_unblock_matched(XEN_TO_C_gpointer(instance), XEN_TO_C_GSignalMatchType(mask), XEN_TO_C_guint(signal_id),
- XEN_TO_C_GQuark(detail), XEN_TO_C_GClosure_(closure), XEN_TO_C_gpointer(func),
- XEN_TO_C_gpointer(data))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handlers_unblock_matched", "gpointer");
+ Xen_check_type(Xen_is_GSignalMatchType(mask), mask, 2, "g_signal_handlers_unblock_matched", "GSignalMatchType");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 3, "g_signal_handlers_unblock_matched", "guint");
+ Xen_check_type(Xen_is_GQuark(detail), detail, 4, "g_signal_handlers_unblock_matched", "GQuark");
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 5, "g_signal_handlers_unblock_matched", "GClosure*");
+ Xen_check_type(Xen_is_gpointer(func), func, 6, "g_signal_handlers_unblock_matched", "gpointer");
+ Xen_check_type(Xen_is_gpointer(data), data, 7, "g_signal_handlers_unblock_matched", "gpointer");
+ return(C_to_Xen_guint(g_signal_handlers_unblock_matched(Xen_to_C_gpointer(instance), Xen_to_C_GSignalMatchType(mask), Xen_to_C_guint(signal_id),
+ Xen_to_C_GQuark(detail), Xen_to_C_GClosure_(closure), Xen_to_C_gpointer(func),
+ Xen_to_C_gpointer(data))));
}
-static XEN gxg_g_signal_handlers_disconnect_matched(XEN instance, XEN mask, XEN signal_id, XEN detail, XEN closure, XEN func, XEN data)
+static Xen gxg_g_signal_handlers_disconnect_matched(Xen instance, Xen mask, Xen signal_id, Xen detail, Xen closure, Xen func, Xen data)
{
#define H_g_signal_handlers_disconnect_matched "guint g_signal_handlers_disconnect_matched(gpointer instance, \
GSignalMatchType mask, guint signal_id, GQuark detail, GClosure* closure, gpointer func, gpointer data)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handlers_disconnect_matched", "gpointer");
- XEN_ASSERT_TYPE(XEN_GSignalMatchType_P(mask), mask, 2, "g_signal_handlers_disconnect_matched", "GSignalMatchType");
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 3, "g_signal_handlers_disconnect_matched", "guint");
- XEN_ASSERT_TYPE(XEN_GQuark_P(detail), detail, 4, "g_signal_handlers_disconnect_matched", "GQuark");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 5, "g_signal_handlers_disconnect_matched", "GClosure*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(func), func, 6, "g_signal_handlers_disconnect_matched", "gpointer");
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 7, "g_signal_handlers_disconnect_matched", "gpointer");
- return(C_TO_XEN_guint(g_signal_handlers_disconnect_matched(XEN_TO_C_gpointer(instance), XEN_TO_C_GSignalMatchType(mask),
- XEN_TO_C_guint(signal_id), XEN_TO_C_GQuark(detail), XEN_TO_C_GClosure_(closure),
- XEN_TO_C_gpointer(func), XEN_TO_C_gpointer(data))));
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handlers_disconnect_matched", "gpointer");
+ Xen_check_type(Xen_is_GSignalMatchType(mask), mask, 2, "g_signal_handlers_disconnect_matched", "GSignalMatchType");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 3, "g_signal_handlers_disconnect_matched", "guint");
+ Xen_check_type(Xen_is_GQuark(detail), detail, 4, "g_signal_handlers_disconnect_matched", "GQuark");
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 5, "g_signal_handlers_disconnect_matched", "GClosure*");
+ Xen_check_type(Xen_is_gpointer(func), func, 6, "g_signal_handlers_disconnect_matched", "gpointer");
+ Xen_check_type(Xen_is_gpointer(data), data, 7, "g_signal_handlers_disconnect_matched", "gpointer");
+ return(C_to_Xen_guint(g_signal_handlers_disconnect_matched(Xen_to_C_gpointer(instance), Xen_to_C_GSignalMatchType(mask),
+ Xen_to_C_guint(signal_id), Xen_to_C_GQuark(detail), Xen_to_C_GClosure_(closure),
+ Xen_to_C_gpointer(func), Xen_to_C_gpointer(data))));
}
-static XEN gxg_g_signal_handlers_destroy(XEN instance)
+static Xen gxg_g_signal_handlers_destroy(Xen instance)
{
#define H_g_signal_handlers_destroy "void g_signal_handlers_destroy(gpointer instance)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(instance), instance, 1, "g_signal_handlers_destroy", "gpointer");
- g_signal_handlers_destroy(XEN_TO_C_gpointer(instance));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gpointer(instance), instance, 1, "g_signal_handlers_destroy", "gpointer");
+ g_signal_handlers_destroy(Xen_to_C_gpointer(instance));
+ return(Xen_false);
}
-static XEN gxg_g_object_ref(XEN object)
+static Xen gxg_g_object_ref(Xen object)
{
#define H_g_object_ref "gpointer g_object_ref(gpointer object)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(object), object, 1, "g_object_ref", "gpointer");
- return(C_TO_XEN_gpointer(g_object_ref(XEN_TO_C_gpointer(object))));
+ Xen_check_type(Xen_is_gpointer(object), object, 1, "g_object_ref", "gpointer");
+ return(C_to_Xen_gpointer(g_object_ref(Xen_to_C_gpointer(object))));
}
-static XEN gxg_g_object_unref(XEN object)
+static Xen gxg_g_object_unref(Xen object)
{
#define H_g_object_unref "void g_object_unref(gpointer object)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(object), object, 1, "g_object_unref", "gpointer");
- g_object_unref(XEN_TO_C_gpointer(object));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gpointer(object), object, 1, "g_object_unref", "gpointer");
+ g_object_unref(Xen_to_C_gpointer(object));
+ return(Xen_false);
}
-static XEN gxg_gdk_visual_get_system(void)
+static Xen gxg_gdk_visual_get_system(void)
{
#define H_gdk_visual_get_system "GdkVisual* gdk_visual_get_system( void)"
- return(C_TO_XEN_GdkVisual_(gdk_visual_get_system()));
-}
-
-static XEN gxg_gdk_color_copy(XEN color)
-{
- #define H_gdk_color_copy "GdkColor* gdk_color_copy(GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 1, "gdk_color_copy", "GdkColor*");
- return(C_TO_XEN_GdkColor_(gdk_color_copy(XEN_TO_C_GdkColor_(color))));
-}
-
-static XEN gxg_gdk_color_free(XEN color)
-{
- #define H_gdk_color_free "void gdk_color_free(GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 1, "gdk_color_free", "GdkColor*");
- gdk_color_free(XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_color_parse(XEN spec, XEN color)
-{
- #define H_gdk_color_parse "gint gdk_color_parse(gchar* spec, GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_gchar__P(spec), spec, 1, "gdk_color_parse", "gchar*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gdk_color_parse", "GdkColor*");
- return(C_TO_XEN_gint(gdk_color_parse(XEN_TO_C_gchar_(spec), XEN_TO_C_GdkColor_(color))));
-}
-
-static XEN gxg_gdk_color_hash(XEN colora)
-{
- #define H_gdk_color_hash "guint gdk_color_hash(GdkColor* colora)"
- XEN_ASSERT_TYPE(XEN_GdkColor__P(colora), colora, 1, "gdk_color_hash", "GdkColor*");
- return(C_TO_XEN_guint(gdk_color_hash(XEN_TO_C_GdkColor_(colora))));
+ return(C_to_Xen_GdkVisual_(gdk_visual_get_system()));
}
-static XEN gxg_gdk_color_equal(XEN colora, XEN colorb)
+static Xen gxg_gdk_cursor_new_for_display(Xen display, Xen cursor_type)
{
- #define H_gdk_color_equal "gboolean gdk_color_equal(GdkColor* colora, GdkColor* colorb)"
- XEN_ASSERT_TYPE(XEN_GdkColor__P(colora), colora, 1, "gdk_color_equal", "GdkColor*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(colorb), colorb, 2, "gdk_color_equal", "GdkColor*");
- return(C_TO_XEN_gboolean(gdk_color_equal(XEN_TO_C_GdkColor_(colora), XEN_TO_C_GdkColor_(colorb))));
+ #define H_gdk_cursor_new_for_display "GdkCursor* gdk_cursor_new_for_display(GdkDisplay* display, GdkCursorType cursor_type)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_cursor_new_for_display", "GdkDisplay*");
+ Xen_check_type(Xen_is_GdkCursorType(cursor_type), cursor_type, 2, "gdk_cursor_new_for_display", "GdkCursorType");
+ return(C_to_Xen_GdkCursor_(gdk_cursor_new_for_display(Xen_to_C_GdkDisplay_(display), Xen_to_C_GdkCursorType(cursor_type))));
}
-static XEN gxg_gdk_cursor_new(XEN cursor_type)
+static Xen gxg_gdk_cursor_get_display(Xen cursor)
{
- #define H_gdk_cursor_new "GdkCursor* gdk_cursor_new(GdkCursorType cursor_type)"
- XEN_ASSERT_TYPE(XEN_GdkCursorType_P(cursor_type), cursor_type, 1, "gdk_cursor_new", "GdkCursorType");
- return(C_TO_XEN_GdkCursor_(gdk_cursor_new(XEN_TO_C_GdkCursorType(cursor_type))));
+ #define H_gdk_cursor_get_display "GdkDisplay* gdk_cursor_get_display(GdkCursor* cursor)"
+ Xen_check_type(Xen_is_GdkCursor_(cursor), cursor, 1, "gdk_cursor_get_display", "GdkCursor*");
+ return(C_to_Xen_GdkDisplay_(gdk_cursor_get_display(Xen_to_C_GdkCursor_(cursor))));
}
-static XEN gxg_gdk_drag_status(XEN context, XEN action, XEN time)
+static Xen gxg_gdk_drag_status(Xen context, Xen action, Xen time)
{
#define H_gdk_drag_status "void gdk_drag_status(GdkDragContext* context, GdkDragAction action, guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_status", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(action), action, 2, "gdk_drag_status", "GdkDragAction");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 3, "gdk_drag_status", "guint32");
- gdk_drag_status(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GdkDragAction(action), XEN_TO_C_guint32(time));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_status", "GdkDragContext*");
+ Xen_check_type(Xen_is_GdkDragAction(action), action, 2, "gdk_drag_status", "GdkDragAction");
+ Xen_check_type(Xen_is_guint32(time), time, 3, "gdk_drag_status", "guint32");
+ gdk_drag_status(Xen_to_C_GdkDragContext_(context), Xen_to_C_GdkDragAction(action), Xen_to_C_guint32(time));
+ return(Xen_false);
}
-static XEN gxg_gdk_drop_reply(XEN context, XEN ok, XEN time)
+static Xen gxg_gdk_drop_reply(Xen context, Xen ok, Xen time)
{
#define H_gdk_drop_reply "void gdk_drop_reply(GdkDragContext* context, gboolean ok, guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drop_reply", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(ok), ok, 2, "gdk_drop_reply", "gboolean");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 3, "gdk_drop_reply", "guint32");
- gdk_drop_reply(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_gboolean(ok), XEN_TO_C_guint32(time));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drop_reply", "GdkDragContext*");
+ Xen_check_type(Xen_is_gboolean(ok), ok, 2, "gdk_drop_reply", "gboolean");
+ Xen_check_type(Xen_is_guint32(time), time, 3, "gdk_drop_reply", "guint32");
+ gdk_drop_reply(Xen_to_C_GdkDragContext_(context), Xen_to_C_gboolean(ok), Xen_to_C_guint32(time));
+ return(Xen_false);
}
-static XEN gxg_gdk_drop_finish(XEN context, XEN success, XEN time)
+static Xen gxg_gdk_drop_finish(Xen context, Xen success, Xen time)
{
#define H_gdk_drop_finish "void gdk_drop_finish(GdkDragContext* context, gboolean success, guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drop_finish", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(success), success, 2, "gdk_drop_finish", "gboolean");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 3, "gdk_drop_finish", "guint32");
- gdk_drop_finish(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_gboolean(success), XEN_TO_C_guint32(time));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drop_finish", "GdkDragContext*");
+ Xen_check_type(Xen_is_gboolean(success), success, 2, "gdk_drop_finish", "gboolean");
+ Xen_check_type(Xen_is_guint32(time), time, 3, "gdk_drop_finish", "guint32");
+ gdk_drop_finish(Xen_to_C_GdkDragContext_(context), Xen_to_C_gboolean(success), Xen_to_C_guint32(time));
+ return(Xen_false);
}
-static XEN gxg_gdk_drag_get_selection(XEN context)
+static Xen gxg_gdk_drag_get_selection(Xen context)
{
#define H_gdk_drag_get_selection "GdkAtom gdk_drag_get_selection(GdkDragContext* context)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_get_selection", "GdkDragContext*");
- return(C_TO_XEN_GdkAtom(gdk_drag_get_selection(XEN_TO_C_GdkDragContext_(context))));
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_get_selection", "GdkDragContext*");
+ return(C_to_Xen_GdkAtom(gdk_drag_get_selection(Xen_to_C_GdkDragContext_(context))));
}
-static XEN gxg_gdk_drag_begin(XEN window, XEN targets)
+static Xen gxg_gdk_drag_begin(Xen window, Xen targets)
{
#define H_gdk_drag_begin "GdkDragContext* gdk_drag_begin(GdkWindow* window, GList* targets)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_drag_begin", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GList__P(targets), targets, 2, "gdk_drag_begin", "GList*");
- return(C_TO_XEN_GdkDragContext_(gdk_drag_begin(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GList_(targets))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_drag_begin", "GdkWindow*");
+ Xen_check_type(Xen_is_GList_(targets), targets, 2, "gdk_drag_begin", "GList*");
+ return(C_to_Xen_GdkDragContext_(gdk_drag_begin(Xen_to_C_GdkWindow_(window), Xen_to_C_GList_(targets))));
}
-static XEN gxg_gdk_drag_drop(XEN context, XEN time)
+static Xen gxg_gdk_drag_drop(Xen context, Xen time)
{
#define H_gdk_drag_drop "void gdk_drag_drop(GdkDragContext* context, guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_drop", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 2, "gdk_drag_drop", "guint32");
- gdk_drag_drop(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_guint32(time));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_drop", "GdkDragContext*");
+ Xen_check_type(Xen_is_guint32(time), time, 2, "gdk_drag_drop", "guint32");
+ gdk_drag_drop(Xen_to_C_GdkDragContext_(context), Xen_to_C_guint32(time));
+ return(Xen_false);
}
-static XEN gxg_gdk_drag_abort(XEN context, XEN time)
+static Xen gxg_gdk_drag_abort(Xen context, Xen time)
{
#define H_gdk_drag_abort "void gdk_drag_abort(GdkDragContext* context, guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_abort", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 2, "gdk_drag_abort", "guint32");
- gdk_drag_abort(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_guint32(time));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_abort", "GdkDragContext*");
+ Xen_check_type(Xen_is_guint32(time), time, 2, "gdk_drag_abort", "guint32");
+ gdk_drag_abort(Xen_to_C_GdkDragContext_(context), Xen_to_C_guint32(time));
+ return(Xen_false);
}
-static XEN gxg_gdk_events_pending(void)
+static Xen gxg_gdk_events_pending(void)
{
#define H_gdk_events_pending "gboolean gdk_events_pending( void)"
- return(C_TO_XEN_gboolean(gdk_events_pending()));
+ return(C_to_Xen_gboolean(gdk_events_pending()));
}
-static XEN gxg_gdk_event_get(void)
+static Xen gxg_gdk_event_get(void)
{
#define H_gdk_event_get "GdkEvent* gdk_event_get( void)"
- return(C_TO_XEN_GdkEvent_(gdk_event_get()));
+ return(C_to_Xen_GdkEvent_(gdk_event_get()));
}
-static XEN gxg_gdk_event_peek(void)
+static Xen gxg_gdk_event_peek(void)
{
#define H_gdk_event_peek "GdkEvent* gdk_event_peek( void)"
- return(C_TO_XEN_GdkEvent_(gdk_event_peek()));
+ return(C_to_Xen_GdkEvent_(gdk_event_peek()));
}
-static XEN gxg_gdk_event_put(XEN event)
+static Xen gxg_gdk_event_put(Xen event)
{
#define H_gdk_event_put "void gdk_event_put(GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_put", "GdkEvent*");
- gdk_event_put(XEN_TO_C_GdkEvent_(event));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_put", "GdkEvent*");
+ gdk_event_put(Xen_to_C_GdkEvent_(event));
+ return(Xen_false);
}
-static XEN gxg_gdk_event_copy(XEN event)
+static Xen gxg_gdk_event_copy(Xen event)
{
#define H_gdk_event_copy "GdkEvent* gdk_event_copy(GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_copy", "GdkEvent*");
- return(C_TO_XEN_GdkEvent_(gdk_event_copy(XEN_TO_C_GdkEvent_(event))));
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_copy", "GdkEvent*");
+ return(C_to_Xen_GdkEvent_(gdk_event_copy(Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gdk_event_free(XEN event)
+static Xen gxg_gdk_event_free(Xen event)
{
#define H_gdk_event_free "void gdk_event_free(GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_free", "GdkEvent*");
- gdk_event_free(XEN_TO_C_GdkEvent_(event));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_free", "GdkEvent*");
+ gdk_event_free(Xen_to_C_GdkEvent_(event));
+ return(Xen_false);
}
-static XEN gxg_gdk_event_get_time(XEN event)
+static Xen gxg_gdk_event_get_time(Xen event)
{
#define H_gdk_event_get_time "guint32 gdk_event_get_time(GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event) || XEN_FALSE_P(event), event, 1, "gdk_event_get_time", "GdkEvent*");
- return(C_TO_XEN_guint32(gdk_event_get_time(XEN_TO_C_GdkEvent_(event))));
+ Xen_check_type(Xen_is_GdkEvent_(event) || Xen_is_false(event), event, 1, "gdk_event_get_time", "GdkEvent*");
+ return(C_to_Xen_guint32(gdk_event_get_time(Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gdk_event_get_state(XEN event, XEN ignore_state)
+static Xen gxg_gdk_event_get_state(Xen event, Xen ignore_state)
{
#define H_gdk_event_get_state "gboolean gdk_event_get_state(GdkEvent* event, GdkModifierType* [state])"
GdkModifierType ref_state;
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_get_state", "GdkEvent*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_state", "GdkEvent*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_event_get_state(XEN_TO_C_GdkEvent_(event), &ref_state));
- return(XEN_LIST_2(result, C_TO_XEN_GdkModifierType(ref_state)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_event_get_state(Xen_to_C_GdkEvent_(event), &ref_state));
+ return(Xen_list_2(result, C_to_Xen_GdkModifierType(ref_state)));
}
}
-static XEN gxg_gdk_event_get_coords(XEN event, XEN ignore_x_win, XEN ignore_y_win)
+static Xen gxg_gdk_event_get_coords(Xen event, Xen ignore_x_win, Xen ignore_y_win)
{
#define H_gdk_event_get_coords "gboolean gdk_event_get_coords(GdkEvent* event, gdouble* [x_win], gdouble* [y_win])"
gdouble ref_x_win;
gdouble ref_y_win;
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_get_coords", "GdkEvent*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_coords", "GdkEvent*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_event_get_coords(XEN_TO_C_GdkEvent_(event), &ref_x_win, &ref_y_win));
- return(XEN_LIST_3(result, C_TO_XEN_gdouble(ref_x_win), C_TO_XEN_gdouble(ref_y_win)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_event_get_coords(Xen_to_C_GdkEvent_(event), &ref_x_win, &ref_y_win));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_x_win), C_to_Xen_gdouble(ref_y_win)));
}
}
-static XEN gxg_gdk_event_get_root_coords(XEN event, XEN ignore_x_root, XEN ignore_y_root)
+static Xen gxg_gdk_event_get_root_coords(Xen event, Xen ignore_x_root, Xen ignore_y_root)
{
#define H_gdk_event_get_root_coords "gboolean gdk_event_get_root_coords(GdkEvent* event, gdouble* [x_root], \
gdouble* [y_root])"
gdouble ref_x_root;
gdouble ref_y_root;
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_get_root_coords", "GdkEvent*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_root_coords", "GdkEvent*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_event_get_root_coords(XEN_TO_C_GdkEvent_(event), &ref_x_root, &ref_y_root));
- return(XEN_LIST_3(result, C_TO_XEN_gdouble(ref_x_root), C_TO_XEN_gdouble(ref_y_root)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_event_get_root_coords(Xen_to_C_GdkEvent_(event), &ref_x_root, &ref_y_root));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_x_root), C_to_Xen_gdouble(ref_y_root)));
}
}
-static XEN gxg_gdk_event_handler_set(XEN func, XEN func_info, XEN notify)
+static Xen gxg_gdk_event_handler_set(Xen func, Xen func_info, Xen notify)
{
#define H_gdk_event_handler_set "void gdk_event_handler_set(GdkEventFunc func, lambda_data func_info, \
GtkDestroyNotify notify)"
- XEN_ASSERT_TYPE(XEN_GdkEventFunc_P(func), func, 1, "gdk_event_handler_set", "GdkEventFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 2, "gdk_event_handler_set", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(notify), notify, 3, "gdk_event_handler_set", "GtkDestroyNotify");
+ Xen_check_type(Xen_is_GdkEventFunc(func), func, 1, "gdk_event_handler_set", "GdkEventFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 2, "gdk_event_handler_set", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(notify), notify, 3, "gdk_event_handler_set", "GtkDestroyNotify");
{
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, notify);
- gdk_event_handler_set(XEN_TO_C_GdkEventFunc(func), XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(notify));
- return(XEN_FALSE);
+ Xen_list_set(gxg_ptr, 3, notify);
+ gdk_event_handler_set(Xen_to_C_GdkEventFunc(func), Xen_to_C_lambda_data(func_info), Xen_to_C_GtkDestroyNotify(notify));
+ return(Xen_false);
}
}
-static XEN gxg_gdk_set_show_events(XEN show_events)
+static Xen gxg_gdk_set_show_events(Xen show_events)
{
#define H_gdk_set_show_events "void gdk_set_show_events(gboolean show_events)"
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_events), show_events, 1, "gdk_set_show_events", "gboolean");
- gdk_set_show_events(XEN_TO_C_gboolean(show_events));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gboolean(show_events), show_events, 1, "gdk_set_show_events", "gboolean");
+ gdk_set_show_events(Xen_to_C_gboolean(show_events));
+ return(Xen_false);
}
-static XEN gxg_gdk_get_show_events(void)
+static Xen gxg_gdk_get_show_events(void)
{
#define H_gdk_get_show_events "gboolean gdk_get_show_events( void)"
- return(C_TO_XEN_gboolean(gdk_get_show_events()));
+ return(C_to_Xen_gboolean(gdk_get_show_events()));
}
-static XEN gxg_gdk_init(XEN argc, XEN argv)
+static Xen gxg_gdk_init(Xen argc, Xen argv)
{
#define H_gdk_init "void gdk_init(gint* {argc}, gchar*** |argv|)"
gint ref_argc;
gchar** ref_argv = NULL;
- ref_argc = XEN_TO_C_gint(argc);
+ ref_argc = Xen_to_C_gint(argc);
ref_argv = (gchar**)calloc(ref_argc, sizeof(gchar*));
{
int i;
- XEN lst;
- lst = XEN_COPY_ARG(argv);
- for (i = 0; i < ref_argc; i++, lst = XEN_CDR(lst)) ref_argv[i] = XEN_TO_C_gchar_(XEN_CAR(lst));
+ Xen lst;
+ lst = Xen_copy_arg(argv);
+ for (i = 0; i < ref_argc; i++, lst = Xen_cdr(lst)) ref_argv[i] = Xen_to_C_gchar_(Xen_car(lst));
}
gdk_init(&ref_argc, &ref_argv);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_argc), C_TO_XEN_gchar__(ref_argv)));
+ return(Xen_list_2(C_to_Xen_gint(ref_argc), C_to_Xen_gchar__(ref_argv)));
}
-static XEN gxg_gdk_init_check(XEN argc, XEN argv)
+static Xen gxg_gdk_init_check(Xen argc, Xen argv)
{
#define H_gdk_init_check "gboolean gdk_init_check(gint* {argc}, gchar*** |argv|)"
gint ref_argc;
gchar** ref_argv = NULL;
- ref_argc = XEN_TO_C_gint(argc);
+ ref_argc = Xen_to_C_gint(argc);
ref_argv = (gchar**)calloc(ref_argc, sizeof(gchar*));
{
int i;
- XEN lst;
- lst = XEN_COPY_ARG(argv);
- for (i = 0; i < ref_argc; i++, lst = XEN_CDR(lst)) ref_argv[i] = XEN_TO_C_gchar_(XEN_CAR(lst));
+ Xen lst;
+ lst = Xen_copy_arg(argv);
+ for (i = 0; i < ref_argc; i++, lst = Xen_cdr(lst)) ref_argv[i] = Xen_to_C_gchar_(Xen_car(lst));
}
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_init_check(&ref_argc, &ref_argv));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_argc), C_TO_XEN_gchar__(ref_argv)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_init_check(&ref_argc, &ref_argv));
+ return(Xen_list_3(result, C_to_Xen_gint(ref_argc), C_to_Xen_gchar__(ref_argv)));
}
}
-static XEN gxg_gdk_get_program_class(void)
+static Xen gxg_gdk_get_program_class(void)
{
#define H_gdk_get_program_class "char* gdk_get_program_class( void)"
- return(C_TO_XEN_char_(gdk_get_program_class()));
+ return(C_to_Xen_char_(gdk_get_program_class()));
}
-static XEN gxg_gdk_set_program_class(XEN program_class)
+static Xen gxg_gdk_set_program_class(Xen program_class)
{
#define H_gdk_set_program_class "void gdk_set_program_class(char* program_class)"
- XEN_ASSERT_TYPE(XEN_char__P(program_class), program_class, 1, "gdk_set_program_class", "char*");
- gdk_set_program_class(XEN_TO_C_char_(program_class));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_char_(program_class), program_class, 1, "gdk_set_program_class", "char*");
+ gdk_set_program_class(Xen_to_C_char_(program_class));
+ return(Xen_false);
}
-static XEN gxg_gdk_error_trap_push(void)
+static Xen gxg_gdk_error_trap_push(void)
{
#define H_gdk_error_trap_push "void gdk_error_trap_push( void)"
gdk_error_trap_push();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_gdk_error_trap_pop(void)
+static Xen gxg_gdk_error_trap_pop(void)
{
#define H_gdk_error_trap_pop "gint gdk_error_trap_pop( void)"
- return(C_TO_XEN_gint(gdk_error_trap_pop()));
-}
-
-static XEN gxg_gdk_get_display(void)
-{
- #define H_gdk_get_display "gchar* gdk_get_display( void)"
- {
- gchar* result;
- XEN rtn;
- result = gdk_get_display();
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ return(C_to_Xen_gint(gdk_error_trap_pop()));
}
-static XEN gxg_gdk_get_display_arg_name(void)
+static Xen gxg_gdk_get_display_arg_name(void)
{
#define H_gdk_get_display_arg_name "gchar* gdk_get_display_arg_name( void)"
- return(C_TO_XEN_gchar_(gdk_get_display_arg_name()));
+ return(C_to_Xen_gchar_(gdk_get_display_arg_name()));
}
-static XEN gxg_gdk_notify_startup_complete(void)
+static Xen gxg_gdk_notify_startup_complete(void)
{
#define H_gdk_notify_startup_complete "void gdk_notify_startup_complete( void)"
gdk_notify_startup_complete();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_width(void)
+static Xen gxg_gdk_screen_width(void)
{
#define H_gdk_screen_width "gint gdk_screen_width( void)"
- return(C_TO_XEN_gint(gdk_screen_width()));
+ return(C_to_Xen_gint(gdk_screen_width()));
}
-static XEN gxg_gdk_screen_height(void)
+static Xen gxg_gdk_screen_height(void)
{
#define H_gdk_screen_height "gint gdk_screen_height( void)"
- return(C_TO_XEN_gint(gdk_screen_height()));
+ return(C_to_Xen_gint(gdk_screen_height()));
}
-static XEN gxg_gdk_screen_width_mm(void)
+static Xen gxg_gdk_screen_width_mm(void)
{
#define H_gdk_screen_width_mm "gint gdk_screen_width_mm( void)"
- return(C_TO_XEN_gint(gdk_screen_width_mm()));
+ return(C_to_Xen_gint(gdk_screen_width_mm()));
}
-static XEN gxg_gdk_screen_height_mm(void)
+static Xen gxg_gdk_screen_height_mm(void)
{
#define H_gdk_screen_height_mm "gint gdk_screen_height_mm( void)"
- return(C_TO_XEN_gint(gdk_screen_height_mm()));
+ return(C_to_Xen_gint(gdk_screen_height_mm()));
}
-static XEN gxg_gdk_flush(void)
+static Xen gxg_gdk_flush(void)
{
#define H_gdk_flush "void gdk_flush( void)"
gdk_flush();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_gdk_beep(void)
+static Xen gxg_gdk_beep(void)
{
#define H_gdk_beep "void gdk_beep( void)"
gdk_beep();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_gdk_set_double_click_time(XEN msec)
+static Xen gxg_gdk_set_double_click_time(Xen msec)
{
#define H_gdk_set_double_click_time "void gdk_set_double_click_time(guint msec)"
- XEN_ASSERT_TYPE(XEN_guint_P(msec), msec, 1, "gdk_set_double_click_time", "guint");
- gdk_set_double_click_time(XEN_TO_C_guint(msec));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_guint(msec), msec, 1, "gdk_set_double_click_time", "guint");
+ gdk_set_double_click_time(Xen_to_C_guint(msec));
+ return(Xen_false);
}
-static XEN gxg_gdk_rectangle_intersect(XEN src1, XEN src2, XEN dest)
+static Xen gxg_gdk_rectangle_intersect(Xen src1, Xen src2, Xen dest)
{
#define H_gdk_rectangle_intersect "gboolean gdk_rectangle_intersect(GdkRectangle* src1, GdkRectangle* src2, \
GdkRectangle* dest)"
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(src1), src1, 1, "gdk_rectangle_intersect", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(src2), src2, 2, "gdk_rectangle_intersect", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(dest), dest, 3, "gdk_rectangle_intersect", "GdkRectangle*");
- return(C_TO_XEN_gboolean(gdk_rectangle_intersect(XEN_TO_C_GdkRectangle_(src1), XEN_TO_C_GdkRectangle_(src2), XEN_TO_C_GdkRectangle_(dest))));
+ Xen_check_type(Xen_is_GdkRectangle_(src1), src1, 1, "gdk_rectangle_intersect", "GdkRectangle*");
+ Xen_check_type(Xen_is_GdkRectangle_(src2), src2, 2, "gdk_rectangle_intersect", "GdkRectangle*");
+ Xen_check_type(Xen_is_GdkRectangle_(dest), dest, 3, "gdk_rectangle_intersect", "GdkRectangle*");
+ return(C_to_Xen_gboolean(gdk_rectangle_intersect(Xen_to_C_GdkRectangle_(src1), Xen_to_C_GdkRectangle_(src2), Xen_to_C_GdkRectangle_(dest))));
}
-static XEN gxg_gdk_rectangle_union(XEN src1, XEN src2, XEN dest)
+static Xen gxg_gdk_rectangle_union(Xen src1, Xen src2, Xen dest)
{
#define H_gdk_rectangle_union "void gdk_rectangle_union(GdkRectangle* src1, GdkRectangle* src2, GdkRectangle* dest)"
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(src1), src1, 1, "gdk_rectangle_union", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(src2), src2, 2, "gdk_rectangle_union", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(dest), dest, 3, "gdk_rectangle_union", "GdkRectangle*");
- gdk_rectangle_union(XEN_TO_C_GdkRectangle_(src1), XEN_TO_C_GdkRectangle_(src2), XEN_TO_C_GdkRectangle_(dest));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_threads_enter(void)
-{
- #define H_gdk_threads_enter "void gdk_threads_enter( void)"
- gdk_threads_enter();
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_threads_leave(void)
-{
- #define H_gdk_threads_leave "void gdk_threads_leave( void)"
- gdk_threads_leave();
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_threads_init(void)
-{
- #define H_gdk_threads_init "void gdk_threads_init( void)"
- gdk_threads_init();
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkRectangle_(src1), src1, 1, "gdk_rectangle_union", "GdkRectangle*");
+ Xen_check_type(Xen_is_GdkRectangle_(src2), src2, 2, "gdk_rectangle_union", "GdkRectangle*");
+ Xen_check_type(Xen_is_GdkRectangle_(dest), dest, 3, "gdk_rectangle_union", "GdkRectangle*");
+ gdk_rectangle_union(Xen_to_C_GdkRectangle_(src1), Xen_to_C_GdkRectangle_(src2), Xen_to_C_GdkRectangle_(dest));
+ return(Xen_false);
}
-static XEN gxg_gdk_keymap_get_default(void)
+static Xen gxg_gdk_keymap_get_default(void)
{
#define H_gdk_keymap_get_default "GdkKeymap* gdk_keymap_get_default( void)"
- return(C_TO_XEN_GdkKeymap_(gdk_keymap_get_default()));
+ return(C_to_Xen_GdkKeymap_(gdk_keymap_get_default()));
}
-static XEN gxg_gdk_keymap_lookup_key(XEN keymap, XEN key)
+static Xen gxg_gdk_keymap_lookup_key(Xen keymap, Xen key)
{
#define H_gdk_keymap_lookup_key "guint gdk_keymap_lookup_key(GdkKeymap* keymap, GdkKeymapKey* key)"
- XEN_ASSERT_TYPE(XEN_GdkKeymap__P(keymap), keymap, 1, "gdk_keymap_lookup_key", "GdkKeymap*");
- XEN_ASSERT_TYPE(XEN_GdkKeymapKey__P(key), key, 2, "gdk_keymap_lookup_key", "GdkKeymapKey*");
- return(C_TO_XEN_guint(gdk_keymap_lookup_key(XEN_TO_C_GdkKeymap_(keymap), XEN_TO_C_GdkKeymapKey_(key))));
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_lookup_key", "GdkKeymap*");
+ Xen_check_type(Xen_is_GdkKeymapKey_(key), key, 2, "gdk_keymap_lookup_key", "GdkKeymapKey*");
+ return(C_to_Xen_guint(gdk_keymap_lookup_key(Xen_to_C_GdkKeymap_(keymap), Xen_to_C_GdkKeymapKey_(key))));
}
-static XEN gxg_gdk_keymap_get_entries_for_keyval(XEN keymap, XEN keyval, XEN ignore_keys, XEN ignore_n_keys)
+static Xen gxg_gdk_keymap_get_entries_for_keyval(Xen keymap, Xen keyval, Xen ignore_keys, Xen ignore_n_keys)
{
#define H_gdk_keymap_get_entries_for_keyval "gboolean gdk_keymap_get_entries_for_keyval(GdkKeymap* keymap, \
guint keyval, GdkKeymapKey** [keys], gint* [n_keys])"
GdkKeymapKey* ref_keys = NULL;
gint ref_n_keys;
- XEN_ASSERT_TYPE(XEN_GdkKeymap__P(keymap), keymap, 1, "gdk_keymap_get_entries_for_keyval", "GdkKeymap*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gdk_keymap_get_entries_for_keyval", "guint");
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_get_entries_for_keyval", "GdkKeymap*");
+ Xen_check_type(Xen_is_guint(keyval), keyval, 2, "gdk_keymap_get_entries_for_keyval", "guint");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_keymap_get_entries_for_keyval(XEN_TO_C_GdkKeymap_(keymap), XEN_TO_C_guint(keyval), &ref_keys,
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_keymap_get_entries_for_keyval(Xen_to_C_GdkKeymap_(keymap), Xen_to_C_guint(keyval), &ref_keys,
&ref_n_keys));
- return(XEN_LIST_3(result, C_TO_XEN_GdkKeymapKey_(ref_keys), C_TO_XEN_gint(ref_n_keys)));
+ return(Xen_list_3(result, C_to_Xen_GdkKeymapKey_(ref_keys), C_to_Xen_gint(ref_n_keys)));
}
}
-static XEN gxg_gdk_keymap_get_entries_for_keycode(XEN keymap, XEN hardware_keycode, XEN ignore_keys, XEN ignore_keyvals, XEN ignore_n_entries)
+static Xen gxg_gdk_keymap_get_entries_for_keycode(Xen keymap, Xen hardware_keycode, Xen ignore_keys, Xen ignore_keyvals, Xen ignore_n_entries)
{
#define H_gdk_keymap_get_entries_for_keycode "gboolean gdk_keymap_get_entries_for_keycode(GdkKeymap* keymap, \
guint hardware_keycode, GdkKeymapKey** [keys], guint** [keyvals], gint* [n_entries])"
GdkKeymapKey* ref_keys = NULL;
guint* ref_keyvals = NULL;
gint ref_n_entries;
- XEN_ASSERT_TYPE(XEN_GdkKeymap__P(keymap), keymap, 1, "gdk_keymap_get_entries_for_keycode", "GdkKeymap*");
- XEN_ASSERT_TYPE(XEN_guint_P(hardware_keycode), hardware_keycode, 2, "gdk_keymap_get_entries_for_keycode", "guint");
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_get_entries_for_keycode", "GdkKeymap*");
+ Xen_check_type(Xen_is_guint(hardware_keycode), hardware_keycode, 2, "gdk_keymap_get_entries_for_keycode", "guint");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_keymap_get_entries_for_keycode(XEN_TO_C_GdkKeymap_(keymap), XEN_TO_C_guint(hardware_keycode),
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_keymap_get_entries_for_keycode(Xen_to_C_GdkKeymap_(keymap), Xen_to_C_guint(hardware_keycode),
&ref_keys, &ref_keyvals, &ref_n_entries));
- return(XEN_LIST_4(result, C_TO_XEN_GdkKeymapKey_(ref_keys), C_TO_XEN_guint_(ref_keyvals), C_TO_XEN_gint(ref_n_entries)));
+ return(Xen_list_4(result, C_to_Xen_GdkKeymapKey_(ref_keys), C_to_Xen_guint_(ref_keyvals), C_to_Xen_gint(ref_n_entries)));
}
}
-static XEN gxg_gdk_keymap_get_direction(XEN keymap)
+static Xen gxg_gdk_keymap_get_direction(Xen keymap)
{
#define H_gdk_keymap_get_direction "PangoDirection gdk_keymap_get_direction(GdkKeymap* keymap)"
- XEN_ASSERT_TYPE(XEN_GdkKeymap__P(keymap), keymap, 1, "gdk_keymap_get_direction", "GdkKeymap*");
- return(C_TO_XEN_PangoDirection(gdk_keymap_get_direction(XEN_TO_C_GdkKeymap_(keymap))));
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_get_direction", "GdkKeymap*");
+ return(C_to_Xen_PangoDirection(gdk_keymap_get_direction(Xen_to_C_GdkKeymap_(keymap))));
}
-static XEN gxg_gdk_keyval_name(XEN keyval)
+static Xen gxg_gdk_keyval_name(Xen keyval)
{
#define H_gdk_keyval_name "gchar* gdk_keyval_name(guint keyval)"
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 1, "gdk_keyval_name", "guint");
- return(C_TO_XEN_gchar_(gdk_keyval_name(XEN_TO_C_guint(keyval))));
+ Xen_check_type(Xen_is_guint(keyval), keyval, 1, "gdk_keyval_name", "guint");
+ return(C_to_Xen_gchar_(gdk_keyval_name(Xen_to_C_guint(keyval))));
}
-static XEN gxg_gdk_keyval_from_name(XEN keyval_name)
+static Xen gxg_gdk_keyval_from_name(Xen keyval_name)
{
#define H_gdk_keyval_from_name "guint gdk_keyval_from_name(gchar* keyval_name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(keyval_name), keyval_name, 1, "gdk_keyval_from_name", "gchar*");
- return(C_TO_XEN_guint(gdk_keyval_from_name(XEN_TO_C_gchar_(keyval_name))));
+ Xen_check_type(Xen_is_gchar_(keyval_name), keyval_name, 1, "gdk_keyval_from_name", "gchar*");
+ return(C_to_Xen_guint(gdk_keyval_from_name(Xen_to_C_gchar_(keyval_name))));
}
-static XEN gxg_gdk_keyval_convert_case(XEN symbol, XEN ignore_lower, XEN ignore_upper)
+static Xen gxg_gdk_keyval_convert_case(Xen symbol, Xen ignore_lower, Xen ignore_upper)
{
#define H_gdk_keyval_convert_case "void gdk_keyval_convert_case(guint symbol, guint* [lower], guint* [upper])"
guint ref_lower;
guint ref_upper;
- XEN_ASSERT_TYPE(XEN_guint_P(symbol), symbol, 1, "gdk_keyval_convert_case", "guint");
- gdk_keyval_convert_case(XEN_TO_C_guint(symbol), &ref_lower, &ref_upper);
- return(XEN_LIST_2(C_TO_XEN_guint(ref_lower), C_TO_XEN_guint(ref_upper)));
+ Xen_check_type(Xen_is_guint(symbol), symbol, 1, "gdk_keyval_convert_case", "guint");
+ gdk_keyval_convert_case(Xen_to_C_guint(symbol), &ref_lower, &ref_upper);
+ return(Xen_list_2(C_to_Xen_guint(ref_lower), C_to_Xen_guint(ref_upper)));
}
-static XEN gxg_gdk_keyval_to_upper(XEN keyval)
+static Xen gxg_gdk_keyval_to_upper(Xen keyval)
{
#define H_gdk_keyval_to_upper "guint gdk_keyval_to_upper(guint keyval)"
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 1, "gdk_keyval_to_upper", "guint");
- return(C_TO_XEN_guint(gdk_keyval_to_upper(XEN_TO_C_guint(keyval))));
+ Xen_check_type(Xen_is_guint(keyval), keyval, 1, "gdk_keyval_to_upper", "guint");
+ return(C_to_Xen_guint(gdk_keyval_to_upper(Xen_to_C_guint(keyval))));
}
-static XEN gxg_gdk_keyval_to_lower(XEN keyval)
+static Xen gxg_gdk_keyval_to_lower(Xen keyval)
{
#define H_gdk_keyval_to_lower "guint gdk_keyval_to_lower(guint keyval)"
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 1, "gdk_keyval_to_lower", "guint");
- return(C_TO_XEN_guint(gdk_keyval_to_lower(XEN_TO_C_guint(keyval))));
+ Xen_check_type(Xen_is_guint(keyval), keyval, 1, "gdk_keyval_to_lower", "guint");
+ return(C_to_Xen_guint(gdk_keyval_to_lower(Xen_to_C_guint(keyval))));
}
-static XEN gxg_gdk_keyval_is_upper(XEN keyval)
+static Xen gxg_gdk_keyval_is_upper(Xen keyval)
{
#define H_gdk_keyval_is_upper "gboolean gdk_keyval_is_upper(guint keyval)"
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 1, "gdk_keyval_is_upper", "guint");
- return(C_TO_XEN_gboolean(gdk_keyval_is_upper(XEN_TO_C_guint(keyval))));
+ Xen_check_type(Xen_is_guint(keyval), keyval, 1, "gdk_keyval_is_upper", "guint");
+ return(C_to_Xen_gboolean(gdk_keyval_is_upper(Xen_to_C_guint(keyval))));
}
-static XEN gxg_gdk_keyval_is_lower(XEN keyval)
+static Xen gxg_gdk_keyval_is_lower(Xen keyval)
{
#define H_gdk_keyval_is_lower "gboolean gdk_keyval_is_lower(guint keyval)"
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 1, "gdk_keyval_is_lower", "guint");
- return(C_TO_XEN_gboolean(gdk_keyval_is_lower(XEN_TO_C_guint(keyval))));
+ Xen_check_type(Xen_is_guint(keyval), keyval, 1, "gdk_keyval_is_lower", "guint");
+ return(C_to_Xen_gboolean(gdk_keyval_is_lower(Xen_to_C_guint(keyval))));
}
-static XEN gxg_gdk_keyval_to_unicode(XEN keyval)
+static Xen gxg_gdk_keyval_to_unicode(Xen keyval)
{
#define H_gdk_keyval_to_unicode "guint32 gdk_keyval_to_unicode(guint keyval)"
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 1, "gdk_keyval_to_unicode", "guint");
- return(C_TO_XEN_guint32(gdk_keyval_to_unicode(XEN_TO_C_guint(keyval))));
+ Xen_check_type(Xen_is_guint(keyval), keyval, 1, "gdk_keyval_to_unicode", "guint");
+ return(C_to_Xen_guint32(gdk_keyval_to_unicode(Xen_to_C_guint(keyval))));
}
-static XEN gxg_gdk_unicode_to_keyval(XEN wc)
+static Xen gxg_gdk_unicode_to_keyval(Xen wc)
{
#define H_gdk_unicode_to_keyval "guint gdk_unicode_to_keyval(guint32 wc)"
- XEN_ASSERT_TYPE(XEN_guint32_P(wc), wc, 1, "gdk_unicode_to_keyval", "guint32");
- return(C_TO_XEN_guint(gdk_unicode_to_keyval(XEN_TO_C_guint32(wc))));
+ Xen_check_type(Xen_is_guint32(wc), wc, 1, "gdk_unicode_to_keyval", "guint32");
+ return(C_to_Xen_guint(gdk_unicode_to_keyval(Xen_to_C_guint32(wc))));
}
-static XEN gxg_gdk_pango_context_get(void)
+static Xen gxg_gdk_pango_context_get(void)
{
#define H_gdk_pango_context_get "PangoContext* gdk_pango_context_get( void)"
- return(C_TO_XEN_PangoContext_(gdk_pango_context_get()));
+ return(C_to_Xen_PangoContext_(gdk_pango_context_get()));
}
-static XEN gxg_gdk_atom_intern(XEN atom_name, XEN only_if_exists)
+static Xen gxg_gdk_atom_intern(Xen atom_name, Xen only_if_exists)
{
#define H_gdk_atom_intern "GdkAtom gdk_atom_intern(gchar* atom_name, gboolean only_if_exists)"
- XEN_ASSERT_TYPE(XEN_gchar__P(atom_name), atom_name, 1, "gdk_atom_intern", "gchar*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(only_if_exists), only_if_exists, 2, "gdk_atom_intern", "gboolean");
- return(C_TO_XEN_GdkAtom(gdk_atom_intern(XEN_TO_C_gchar_(atom_name), XEN_TO_C_gboolean(only_if_exists))));
+ Xen_check_type(Xen_is_gchar_(atom_name), atom_name, 1, "gdk_atom_intern", "gchar*");
+ Xen_check_type(Xen_is_gboolean(only_if_exists), only_if_exists, 2, "gdk_atom_intern", "gboolean");
+ return(C_to_Xen_GdkAtom(gdk_atom_intern(Xen_to_C_gchar_(atom_name), Xen_to_C_gboolean(only_if_exists))));
}
-static XEN gxg_gdk_atom_name(XEN atom)
+static Xen gxg_gdk_atom_name(Xen atom)
{
#define H_gdk_atom_name "gchar* gdk_atom_name(GdkAtom atom)"
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(atom), atom, 1, "gdk_atom_name", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(atom), atom, 1, "gdk_atom_name", "GdkAtom");
{
gchar* result;
- XEN rtn;
- result = gdk_atom_name(XEN_TO_C_GdkAtom(atom));
- rtn = C_TO_XEN_gchar_(result);
+ Xen rtn;
+ result = gdk_atom_name(Xen_to_C_GdkAtom(atom));
+ rtn = C_to_Xen_gchar_(result);
g_free(result);
return(rtn);
}
}
-static XEN gxg_gdk_property_get(XEN arglist)
+static Xen gxg_gdk_property_get(Xen arglist)
{
#define H_gdk_property_get "gboolean gdk_property_get(GdkWindow* window, GdkAtom property, GdkAtom type, \
gulong offset, gulong length, gint pdelete, GdkAtom* [actual_property_type], gint* [actual_format], gint* [actual_length], \
@@ -2401,1901 +2605,1792 @@ guchar** [data])"
gint ref_actual_format;
gint ref_actual_length;
guchar* ref_data = NULL;
- XEN window, property, type, offset, length, pdelete;
- window = XEN_LIST_REF(arglist, 0);
- property = XEN_LIST_REF(arglist, 1);
- type = XEN_LIST_REF(arglist, 2);
- offset = XEN_LIST_REF(arglist, 3);
- length = XEN_LIST_REF(arglist, 4);
- pdelete = XEN_LIST_REF(arglist, 5);
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_property_get", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(property), property, 2, "gdk_property_get", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(type), type, 3, "gdk_property_get", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_gulong_P(offset), offset, 4, "gdk_property_get", "gulong");
- XEN_ASSERT_TYPE(XEN_gulong_P(length), length, 5, "gdk_property_get", "gulong");
- XEN_ASSERT_TYPE(XEN_gint_P(pdelete), pdelete, 6, "gdk_property_get", "gint");
+ Xen window, property, type, offset, length, pdelete;
+ window = Xen_list_ref(arglist, 0);
+ property = Xen_list_ref(arglist, 1);
+ type = Xen_list_ref(arglist, 2);
+ offset = Xen_list_ref(arglist, 3);
+ length = Xen_list_ref(arglist, 4);
+ pdelete = Xen_list_ref(arglist, 5);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_property_get", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkAtom(property), property, 2, "gdk_property_get", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(type), type, 3, "gdk_property_get", "GdkAtom");
+ Xen_check_type(Xen_is_gulong(offset), offset, 4, "gdk_property_get", "gulong");
+ Xen_check_type(Xen_is_gulong(length), length, 5, "gdk_property_get", "gulong");
+ Xen_check_type(Xen_is_gint(pdelete), pdelete, 6, "gdk_property_get", "gint");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_property_get(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkAtom(property), XEN_TO_C_GdkAtom(type),
- XEN_TO_C_gulong(offset), XEN_TO_C_gulong(length), XEN_TO_C_gint(pdelete),
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_property_get(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkAtom(property), Xen_to_C_GdkAtom(type),
+ Xen_to_C_gulong(offset), Xen_to_C_gulong(length), Xen_to_C_gint(pdelete),
&ref_actual_property_type, &ref_actual_format, &ref_actual_length, &ref_data));
{
- XEN data_val = XEN_FALSE;
+ Xen data_val = Xen_false;
if (ref_actual_property_type == GDK_TARGET_STRING)
- data_val = C_TO_XEN_STRING((char *)ref_data);
- else if (ref_actual_length > 0) data_val = C_TO_XEN_STRINGN((char *)ref_data, ref_actual_length * ref_actual_format / 8);
- return(XEN_LIST_5(result, C_TO_XEN_GdkAtom(ref_actual_property_type), C_TO_XEN_gint(ref_actual_format),
- C_TO_XEN_gint(ref_actual_length), data_val));
+ data_val = C_string_to_Xen_string((char *)ref_data);
+ else if (ref_actual_length > 0) data_val = C_string_to_Xen_string_with_length((char *)ref_data, ref_actual_length * ref_actual_format / 8);
+ return(Xen_list_5(result, C_to_Xen_GdkAtom(ref_actual_property_type), C_to_Xen_gint(ref_actual_format),
+ C_to_Xen_gint(ref_actual_length), data_val));
}
}
}
-static XEN gxg_gdk_property_change(XEN window, XEN property, XEN type, XEN format, XEN mode, XEN data, XEN nelements)
+static Xen gxg_gdk_property_change(Xen window, Xen property, Xen type, Xen format, Xen mode, Xen data, Xen nelements)
{
#define H_gdk_property_change "void gdk_property_change(GdkWindow* window, GdkAtom property, GdkAtom type, \
gint format, GdkPropMode mode, guchar* data, gint nelements)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_property_change", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(property), property, 2, "gdk_property_change", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(type), type, 3, "gdk_property_change", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_gint_P(format), format, 4, "gdk_property_change", "gint");
- XEN_ASSERT_TYPE(XEN_GdkPropMode_P(mode), mode, 5, "gdk_property_change", "GdkPropMode");
- XEN_ASSERT_TYPE(XEN_guchar__P(data), data, 6, "gdk_property_change", "guchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(nelements), nelements, 7, "gdk_property_change", "gint");
- gdk_property_change(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkAtom(property), XEN_TO_C_GdkAtom(type), XEN_TO_C_gint(format),
- XEN_TO_C_GdkPropMode(mode), XEN_TO_C_guchar_(data), XEN_TO_C_gint(nelements));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_property_change", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkAtom(property), property, 2, "gdk_property_change", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(type), type, 3, "gdk_property_change", "GdkAtom");
+ Xen_check_type(Xen_is_gint(format), format, 4, "gdk_property_change", "gint");
+ Xen_check_type(Xen_is_GdkPropMode(mode), mode, 5, "gdk_property_change", "GdkPropMode");
+ Xen_check_type(Xen_is_guchar_(data), data, 6, "gdk_property_change", "guchar*");
+ Xen_check_type(Xen_is_gint(nelements), nelements, 7, "gdk_property_change", "gint");
+ gdk_property_change(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkAtom(property), Xen_to_C_GdkAtom(type), Xen_to_C_gint(format),
+ Xen_to_C_GdkPropMode(mode), Xen_to_C_guchar_(data), Xen_to_C_gint(nelements));
+ return(Xen_false);
}
-static XEN gxg_gdk_property_delete(XEN window, XEN property)
+static Xen gxg_gdk_property_delete(Xen window, Xen property)
{
#define H_gdk_property_delete "void gdk_property_delete(GdkWindow* window, GdkAtom property)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_property_delete", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(property), property, 2, "gdk_property_delete", "GdkAtom");
- gdk_property_delete(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkAtom(property));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_property_delete", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkAtom(property), property, 2, "gdk_property_delete", "GdkAtom");
+ gdk_property_delete(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkAtom(property));
+ return(Xen_false);
}
-static XEN gxg_gdk_utf8_to_string_target(XEN str)
+static Xen gxg_gdk_utf8_to_string_target(Xen str)
{
#define H_gdk_utf8_to_string_target "gchar* gdk_utf8_to_string_target(gchar* str)"
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 1, "gdk_utf8_to_string_target", "gchar*");
+ Xen_check_type(Xen_is_gchar_(str), str, 1, "gdk_utf8_to_string_target", "gchar*");
{
gchar* result;
- XEN rtn;
- result = gdk_utf8_to_string_target(XEN_TO_C_gchar_(str));
- rtn = C_TO_XEN_gchar_(result);
+ Xen rtn;
+ result = gdk_utf8_to_string_target(Xen_to_C_gchar_(str));
+ rtn = C_to_Xen_gchar_(result);
g_free(result);
return(rtn);
}
}
-static XEN gxg_gdk_selection_owner_set(XEN owner, XEN selection, XEN time, XEN send_event)
+static Xen gxg_gdk_selection_owner_set(Xen owner, Xen selection, Xen time, Xen send_event)
{
#define H_gdk_selection_owner_set "gboolean gdk_selection_owner_set(GdkWindow* owner, GdkAtom selection, \
guint32 time, gboolean send_event)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(owner), owner, 1, "gdk_selection_owner_set", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gdk_selection_owner_set", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 3, "gdk_selection_owner_set", "guint32");
- XEN_ASSERT_TYPE(XEN_gboolean_P(send_event), send_event, 4, "gdk_selection_owner_set", "gboolean");
- return(C_TO_XEN_gboolean(gdk_selection_owner_set(XEN_TO_C_GdkWindow_(owner), XEN_TO_C_GdkAtom(selection), XEN_TO_C_guint32(time),
- XEN_TO_C_gboolean(send_event))));
+ Xen_check_type(Xen_is_GdkWindow_(owner), owner, 1, "gdk_selection_owner_set", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gdk_selection_owner_set", "GdkAtom");
+ Xen_check_type(Xen_is_guint32(time), time, 3, "gdk_selection_owner_set", "guint32");
+ Xen_check_type(Xen_is_gboolean(send_event), send_event, 4, "gdk_selection_owner_set", "gboolean");
+ return(C_to_Xen_gboolean(gdk_selection_owner_set(Xen_to_C_GdkWindow_(owner), Xen_to_C_GdkAtom(selection), Xen_to_C_guint32(time),
+ Xen_to_C_gboolean(send_event))));
}
-static XEN gxg_gdk_selection_owner_get(XEN selection)
+static Xen gxg_gdk_selection_owner_get(Xen selection)
{
#define H_gdk_selection_owner_get "GdkWindow* gdk_selection_owner_get(GdkAtom selection)"
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 1, "gdk_selection_owner_get", "GdkAtom");
- return(C_TO_XEN_GdkWindow_(gdk_selection_owner_get(XEN_TO_C_GdkAtom(selection))));
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 1, "gdk_selection_owner_get", "GdkAtom");
+ return(C_to_Xen_GdkWindow_(gdk_selection_owner_get(Xen_to_C_GdkAtom(selection))));
}
-static XEN gxg_gdk_selection_convert(XEN requestor, XEN selection, XEN target, XEN time)
+static Xen gxg_gdk_selection_convert(Xen requestor, Xen selection, Xen target, Xen time)
{
#define H_gdk_selection_convert "void gdk_selection_convert(GdkWindow* requestor, GdkAtom selection, \
GdkAtom target, guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(requestor), requestor, 1, "gdk_selection_convert", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gdk_selection_convert", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 3, "gdk_selection_convert", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 4, "gdk_selection_convert", "guint32");
- gdk_selection_convert(XEN_TO_C_GdkWindow_(requestor), XEN_TO_C_GdkAtom(selection), XEN_TO_C_GdkAtom(target), XEN_TO_C_guint32(time));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(requestor), requestor, 1, "gdk_selection_convert", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gdk_selection_convert", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 3, "gdk_selection_convert", "GdkAtom");
+ Xen_check_type(Xen_is_guint32(time), time, 4, "gdk_selection_convert", "guint32");
+ gdk_selection_convert(Xen_to_C_GdkWindow_(requestor), Xen_to_C_GdkAtom(selection), Xen_to_C_GdkAtom(target), Xen_to_C_guint32(time));
+ return(Xen_false);
}
-static XEN gxg_gdk_selection_property_get(XEN requestor, XEN ignore_data, XEN ignore_prop_type, XEN ignore_prop_format)
+static Xen gxg_gdk_selection_property_get(Xen requestor, Xen ignore_data, Xen ignore_prop_type, Xen ignore_prop_format)
{
#define H_gdk_selection_property_get "gboolean gdk_selection_property_get(GdkWindow* requestor, guchar** [data], \
GdkAtom* [prop_type], gint* [prop_format])"
guchar* ref_data = NULL;
GdkAtom ref_prop_type;
gint ref_prop_format;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(requestor), requestor, 1, "gdk_selection_property_get", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindow_(requestor), requestor, 1, "gdk_selection_property_get", "GdkWindow*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_selection_property_get(XEN_TO_C_GdkWindow_(requestor), &ref_data, &ref_prop_type, &ref_prop_format));
- return(XEN_LIST_4(result, C_TO_XEN_guchar_(ref_data), C_TO_XEN_GdkAtom(ref_prop_type), C_TO_XEN_gint(ref_prop_format)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_selection_property_get(Xen_to_C_GdkWindow_(requestor), &ref_data, &ref_prop_type, &ref_prop_format));
+ return(Xen_list_4(result, C_to_Xen_guchar_(ref_data), C_to_Xen_GdkAtom(ref_prop_type), C_to_Xen_gint(ref_prop_format)));
}
}
-static XEN gxg_gdk_visual_get_best_depth(void)
+static Xen gxg_gdk_visual_get_best_depth(void)
{
#define H_gdk_visual_get_best_depth "gint gdk_visual_get_best_depth( void)"
- return(C_TO_XEN_gint(gdk_visual_get_best_depth()));
+ return(C_to_Xen_gint(gdk_visual_get_best_depth()));
}
-static XEN gxg_gdk_visual_get_best_type(void)
+static Xen gxg_gdk_visual_get_best_type(void)
{
#define H_gdk_visual_get_best_type "GdkVisualType gdk_visual_get_best_type( void)"
- return(C_TO_XEN_GdkVisualType(gdk_visual_get_best_type()));
+ return(C_to_Xen_GdkVisualType(gdk_visual_get_best_type()));
}
-static XEN gxg_gdk_visual_get_best(void)
+static Xen gxg_gdk_visual_get_best(void)
{
#define H_gdk_visual_get_best "GdkVisual* gdk_visual_get_best( void)"
- return(C_TO_XEN_GdkVisual_(gdk_visual_get_best()));
+ return(C_to_Xen_GdkVisual_(gdk_visual_get_best()));
}
-static XEN gxg_gdk_visual_get_best_with_depth(XEN depth)
+static Xen gxg_gdk_visual_get_best_with_depth(Xen depth)
{
#define H_gdk_visual_get_best_with_depth "GdkVisual* gdk_visual_get_best_with_depth(gint depth)"
- XEN_ASSERT_TYPE(XEN_gint_P(depth), depth, 1, "gdk_visual_get_best_with_depth", "gint");
- return(C_TO_XEN_GdkVisual_(gdk_visual_get_best_with_depth(XEN_TO_C_gint(depth))));
+ Xen_check_type(Xen_is_gint(depth), depth, 1, "gdk_visual_get_best_with_depth", "gint");
+ return(C_to_Xen_GdkVisual_(gdk_visual_get_best_with_depth(Xen_to_C_gint(depth))));
}
-static XEN gxg_gdk_visual_get_best_with_type(XEN visual_type)
+static Xen gxg_gdk_visual_get_best_with_type(Xen visual_type)
{
#define H_gdk_visual_get_best_with_type "GdkVisual* gdk_visual_get_best_with_type(GdkVisualType visual_type)"
- XEN_ASSERT_TYPE(XEN_GdkVisualType_P(visual_type), visual_type, 1, "gdk_visual_get_best_with_type", "GdkVisualType");
- return(C_TO_XEN_GdkVisual_(gdk_visual_get_best_with_type(XEN_TO_C_GdkVisualType(visual_type))));
+ Xen_check_type(Xen_is_GdkVisualType(visual_type), visual_type, 1, "gdk_visual_get_best_with_type", "GdkVisualType");
+ return(C_to_Xen_GdkVisual_(gdk_visual_get_best_with_type(Xen_to_C_GdkVisualType(visual_type))));
}
-static XEN gxg_gdk_visual_get_best_with_both(XEN depth, XEN visual_type)
+static Xen gxg_gdk_visual_get_best_with_both(Xen depth, Xen visual_type)
{
#define H_gdk_visual_get_best_with_both "GdkVisual* gdk_visual_get_best_with_both(gint depth, GdkVisualType visual_type)"
- XEN_ASSERT_TYPE(XEN_gint_P(depth), depth, 1, "gdk_visual_get_best_with_both", "gint");
- XEN_ASSERT_TYPE(XEN_GdkVisualType_P(visual_type), visual_type, 2, "gdk_visual_get_best_with_both", "GdkVisualType");
- return(C_TO_XEN_GdkVisual_(gdk_visual_get_best_with_both(XEN_TO_C_gint(depth), XEN_TO_C_GdkVisualType(visual_type))));
+ Xen_check_type(Xen_is_gint(depth), depth, 1, "gdk_visual_get_best_with_both", "gint");
+ Xen_check_type(Xen_is_GdkVisualType(visual_type), visual_type, 2, "gdk_visual_get_best_with_both", "GdkVisualType");
+ return(C_to_Xen_GdkVisual_(gdk_visual_get_best_with_both(Xen_to_C_gint(depth), Xen_to_C_GdkVisualType(visual_type))));
}
-static XEN gxg_gdk_query_depths(XEN ignore_depths, XEN ignore_count)
+static Xen gxg_gdk_query_depths(Xen ignore_depths, Xen ignore_count)
{
#define H_gdk_query_depths "void gdk_query_depths(gint** [depths], gint* [count])"
gint* ref_depths = NULL;
gint ref_count;
gdk_query_depths(&ref_depths, &ref_count);
- return(XEN_LIST_2(C_TO_XEN_gint_(ref_depths), C_TO_XEN_gint(ref_count)));
+ return(Xen_list_2(C_to_Xen_gint_(ref_depths), C_to_Xen_gint(ref_count)));
}
-static XEN gxg_gdk_query_visual_types(XEN ignore_visual_types, XEN ignore_count)
+static Xen gxg_gdk_query_visual_types(Xen ignore_visual_types, Xen ignore_count)
{
#define H_gdk_query_visual_types "void gdk_query_visual_types(GdkVisualType** [visual_types], gint* [count])"
GdkVisualType* ref_visual_types = NULL;
gint ref_count;
gdk_query_visual_types(&ref_visual_types, &ref_count);
- return(XEN_LIST_2(C_TO_XEN_GdkVisualType_(ref_visual_types), C_TO_XEN_gint(ref_count)));
+ return(Xen_list_2(C_to_Xen_GdkVisualType_(ref_visual_types), C_to_Xen_gint(ref_count)));
}
-static XEN gxg_gdk_list_visuals(void)
+static Xen gxg_gdk_list_visuals(void)
{
#define H_gdk_list_visuals "GList* gdk_list_visuals( void)"
- return(C_TO_XEN_GList_(gdk_list_visuals()));
+ return(C_to_Xen_GList_(gdk_list_visuals()));
}
-static XEN gxg_gdk_window_new(XEN parent, XEN attributes, XEN attributes_mask)
+static Xen gxg_gdk_window_new(Xen parent, Xen attributes, Xen attributes_mask)
{
#define H_gdk_window_new "GdkWindow* gdk_window_new(GdkWindow* parent, GdkWindowAttr* attributes, gint attributes_mask)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(parent), parent, 1, "gdk_window_new", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindowAttr__P(attributes), attributes, 2, "gdk_window_new", "GdkWindowAttr*");
- XEN_ASSERT_TYPE(XEN_gint_P(attributes_mask), attributes_mask, 3, "gdk_window_new", "gint");
- return(C_TO_XEN_GdkWindow_(gdk_window_new(XEN_TO_C_GdkWindow_(parent), XEN_TO_C_GdkWindowAttr_(attributes), XEN_TO_C_gint(attributes_mask))));
+ Xen_check_type(Xen_is_GdkWindow_(parent), parent, 1, "gdk_window_new", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindowAttr_(attributes), attributes, 2, "gdk_window_new", "GdkWindowAttr*");
+ Xen_check_type(Xen_is_gint(attributes_mask), attributes_mask, 3, "gdk_window_new", "gint");
+ return(C_to_Xen_GdkWindow_(gdk_window_new(Xen_to_C_GdkWindow_(parent), Xen_to_C_GdkWindowAttr_(attributes), Xen_to_C_gint(attributes_mask))));
}
-static XEN gxg_gdk_window_destroy(XEN window)
+static Xen gxg_gdk_window_destroy(Xen window)
{
#define H_gdk_window_destroy "void gdk_window_destroy(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_destroy", "GdkWindow*");
- gdk_window_destroy(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_destroy", "GdkWindow*");
+ gdk_window_destroy(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_window_type(XEN window)
+static Xen gxg_gdk_window_get_window_type(Xen window)
{
#define H_gdk_window_get_window_type "GdkWindowType gdk_window_get_window_type(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_window_type", "GdkWindow*");
- return(C_TO_XEN_GdkWindowType(gdk_window_get_window_type(XEN_TO_C_GdkWindow_(window))));
-}
-
-static XEN gxg_gdk_window_at_pointer(XEN ignore_win_x, XEN ignore_win_y)
-{
- #define H_gdk_window_at_pointer "GdkWindow* gdk_window_at_pointer(gint* [win_x], gint* [win_y])"
- gint ref_win_x;
- gint ref_win_y;
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkWindow_(gdk_window_at_pointer(&ref_win_x, &ref_win_y));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_win_x), C_TO_XEN_gint(ref_win_y)));
- }
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_window_type", "GdkWindow*");
+ return(C_to_Xen_GdkWindowType(gdk_window_get_window_type(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_show(XEN window)
+static Xen gxg_gdk_window_show(Xen window)
{
#define H_gdk_window_show "void gdk_window_show(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_show", "GdkWindow*");
- gdk_window_show(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_show", "GdkWindow*");
+ gdk_window_show(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_hide(XEN window)
+static Xen gxg_gdk_window_hide(Xen window)
{
#define H_gdk_window_hide "void gdk_window_hide(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_hide", "GdkWindow*");
- gdk_window_hide(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_hide", "GdkWindow*");
+ gdk_window_hide(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_withdraw(XEN window)
+static Xen gxg_gdk_window_withdraw(Xen window)
{
#define H_gdk_window_withdraw "void gdk_window_withdraw(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_withdraw", "GdkWindow*");
- gdk_window_withdraw(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_withdraw", "GdkWindow*");
+ gdk_window_withdraw(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_show_unraised(XEN window)
+static Xen gxg_gdk_window_show_unraised(Xen window)
{
#define H_gdk_window_show_unraised "void gdk_window_show_unraised(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_show_unraised", "GdkWindow*");
- gdk_window_show_unraised(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_show_unraised", "GdkWindow*");
+ gdk_window_show_unraised(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_move(XEN window, XEN x, XEN y)
+static Xen gxg_gdk_window_move(Xen window, Xen x, Xen y)
{
#define H_gdk_window_move "void gdk_window_move(GdkWindow* window, gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_move", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gdk_window_move", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gdk_window_move", "gint");
- gdk_window_move(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_move", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gdk_window_move", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gdk_window_move", "gint");
+ gdk_window_move(Xen_to_C_GdkWindow_(window), Xen_to_C_gint(x), Xen_to_C_gint(y));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_resize(XEN window, XEN width, XEN height)
+static Xen gxg_gdk_window_resize(Xen window, Xen width, Xen height)
{
#define H_gdk_window_resize "void gdk_window_resize(GdkWindow* window, gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_resize", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gdk_window_resize", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gdk_window_resize", "gint");
- gdk_window_resize(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_resize", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gdk_window_resize", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 3, "gdk_window_resize", "gint");
+ gdk_window_resize(Xen_to_C_GdkWindow_(window), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_move_resize(XEN window, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_gdk_window_move_resize(Xen window, Xen x, Xen y, Xen width, Xen height)
{
#define H_gdk_window_move_resize "void gdk_window_move_resize(GdkWindow* window, gint x, gint y, gint width, \
gint height)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_move_resize", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gdk_window_move_resize", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gdk_window_move_resize", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 4, "gdk_window_move_resize", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 5, "gdk_window_move_resize", "gint");
- gdk_window_move_resize(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gint(x), XEN_TO_C_gint(y), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_move_resize", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gdk_window_move_resize", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gdk_window_move_resize", "gint");
+ Xen_check_type(Xen_is_gint(width), width, 4, "gdk_window_move_resize", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 5, "gdk_window_move_resize", "gint");
+ gdk_window_move_resize(Xen_to_C_GdkWindow_(window), Xen_to_C_gint(x), Xen_to_C_gint(y), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_reparent(XEN window, XEN new_parent, XEN x, XEN y)
+static Xen gxg_gdk_window_reparent(Xen window, Xen new_parent, Xen x, Xen y)
{
#define H_gdk_window_reparent "void gdk_window_reparent(GdkWindow* window, GdkWindow* new_parent, gint x, \
gint y)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_reparent", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(new_parent), new_parent, 2, "gdk_window_reparent", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 3, "gdk_window_reparent", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 4, "gdk_window_reparent", "gint");
- gdk_window_reparent(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWindow_(new_parent), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_reparent", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindow_(new_parent), new_parent, 2, "gdk_window_reparent", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(x), x, 3, "gdk_window_reparent", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 4, "gdk_window_reparent", "gint");
+ gdk_window_reparent(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWindow_(new_parent), Xen_to_C_gint(x), Xen_to_C_gint(y));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_raise(XEN window)
+static Xen gxg_gdk_window_raise(Xen window)
{
#define H_gdk_window_raise "void gdk_window_raise(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_raise", "GdkWindow*");
- gdk_window_raise(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_raise", "GdkWindow*");
+ gdk_window_raise(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_lower(XEN window)
+static Xen gxg_gdk_window_lower(Xen window)
{
#define H_gdk_window_lower "void gdk_window_lower(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_lower", "GdkWindow*");
- gdk_window_lower(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_lower", "GdkWindow*");
+ gdk_window_lower(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_focus(XEN window, XEN timestamp)
+static Xen gxg_gdk_window_focus(Xen window, Xen timestamp)
{
#define H_gdk_window_focus "void gdk_window_focus(GdkWindow* window, guint32 timestamp)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_focus", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_guint32_P(timestamp), timestamp, 2, "gdk_window_focus", "guint32");
- gdk_window_focus(XEN_TO_C_GdkWindow_(window), XEN_TO_C_guint32(timestamp));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_focus", "GdkWindow*");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 2, "gdk_window_focus", "guint32");
+ gdk_window_focus(Xen_to_C_GdkWindow_(window), Xen_to_C_guint32(timestamp));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_user_data(XEN window, XEN user_data)
+static Xen gxg_gdk_window_set_user_data(Xen window, Xen user_data)
{
#define H_gdk_window_set_user_data "void gdk_window_set_user_data(GdkWindow* window, gpointer user_data)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window) || XEN_FALSE_P(window), window, 1, "gdk_window_set_user_data", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 2, "gdk_window_set_user_data", "gpointer");
- gdk_window_set_user_data(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gpointer(user_data));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window) || Xen_is_false(window), window, 1, "gdk_window_set_user_data", "GdkWindow*");
+ Xen_check_type(Xen_is_gpointer(user_data), user_data, 2, "gdk_window_set_user_data", "gpointer");
+ gdk_window_set_user_data(Xen_to_C_GdkWindow_(window), Xen_to_C_gpointer(user_data));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_override_redirect(XEN window, XEN override_redirect)
+static Xen gxg_gdk_window_set_override_redirect(Xen window, Xen override_redirect)
{
#define H_gdk_window_set_override_redirect "void gdk_window_set_override_redirect(GdkWindow* window, \
gboolean override_redirect)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_override_redirect", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(override_redirect), override_redirect, 2, "gdk_window_set_override_redirect", "gboolean");
- gdk_window_set_override_redirect(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(override_redirect));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_override_redirect", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(override_redirect), override_redirect, 2, "gdk_window_set_override_redirect", "gboolean");
+ gdk_window_set_override_redirect(Xen_to_C_GdkWindow_(window), Xen_to_C_gboolean(override_redirect));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_add_filter(XEN window, XEN func, XEN func_info)
+static Xen gxg_gdk_window_add_filter(Xen window, Xen func, Xen func_info)
{
#define H_gdk_window_add_filter "void gdk_window_add_filter(GdkWindow* window, GdkFilterFunc func, \
lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_add_filter", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkFilterFunc_P(func), func, 2, "gdk_window_add_filter", "GdkFilterFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gdk_window_add_filter", "lambda_data");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_add_filter", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkFilterFunc(func), func, 2, "gdk_window_add_filter", "GdkFilterFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gdk_window_add_filter", "lambda_data");
{
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
xm_protect(gxg_ptr);
- gdk_window_add_filter(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkFilterFunc(func), XEN_TO_C_lambda_data(func_info));
- return(XEN_FALSE);
+ gdk_window_add_filter(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkFilterFunc(func), Xen_to_C_lambda_data(func_info));
+ return(Xen_false);
}
}
-static XEN gxg_gdk_window_remove_filter(XEN window, XEN func, XEN func_info)
+static Xen gxg_gdk_window_remove_filter(Xen window, Xen func, Xen func_info)
{
#define H_gdk_window_remove_filter "void gdk_window_remove_filter(GdkWindow* window, GdkFilterFunc func, \
lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_remove_filter", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkFilterFunc_P(func), func, 2, "gdk_window_remove_filter", "GdkFilterFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gdk_window_remove_filter", "lambda_data");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_remove_filter", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkFilterFunc(func), func, 2, "gdk_window_remove_filter", "GdkFilterFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gdk_window_remove_filter", "lambda_data");
{
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
xm_protect(gxg_ptr);
- gdk_window_remove_filter(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkFilterFunc(func), XEN_TO_C_lambda_data(func_info));
- return(XEN_FALSE);
+ gdk_window_remove_filter(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkFilterFunc(func), Xen_to_C_lambda_data(func_info));
+ return(Xen_false);
}
}
-static XEN gxg_gdk_window_scroll(XEN window, XEN dx, XEN dy)
+static Xen gxg_gdk_window_scroll(Xen window, Xen dx, Xen dy)
{
#define H_gdk_window_scroll "void gdk_window_scroll(GdkWindow* window, gint dx, gint dy)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_scroll", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(dx), dx, 2, "gdk_window_scroll", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(dy), dy, 3, "gdk_window_scroll", "gint");
- gdk_window_scroll(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gint(dx), XEN_TO_C_gint(dy));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_scroll", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(dx), dx, 2, "gdk_window_scroll", "gint");
+ Xen_check_type(Xen_is_gint(dy), dy, 3, "gdk_window_scroll", "gint");
+ gdk_window_scroll(Xen_to_C_GdkWindow_(window), Xen_to_C_gint(dx), Xen_to_C_gint(dy));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_child_shapes(XEN window)
+static Xen gxg_gdk_window_set_child_shapes(Xen window)
{
#define H_gdk_window_set_child_shapes "void gdk_window_set_child_shapes(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_child_shapes", "GdkWindow*");
- gdk_window_set_child_shapes(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_child_shapes", "GdkWindow*");
+ gdk_window_set_child_shapes(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_merge_child_shapes(XEN window)
+static Xen gxg_gdk_window_merge_child_shapes(Xen window)
{
#define H_gdk_window_merge_child_shapes "void gdk_window_merge_child_shapes(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_merge_child_shapes", "GdkWindow*");
- gdk_window_merge_child_shapes(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_merge_child_shapes", "GdkWindow*");
+ gdk_window_merge_child_shapes(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_is_visible(XEN window)
+static Xen gxg_gdk_window_is_visible(Xen window)
{
#define H_gdk_window_is_visible "gboolean gdk_window_is_visible(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_is_visible", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_is_visible(XEN_TO_C_GdkWindow_(window))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_is_visible", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_is_visible(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_is_viewable(XEN window)
+static Xen gxg_gdk_window_is_viewable(Xen window)
{
#define H_gdk_window_is_viewable "gboolean gdk_window_is_viewable(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_is_viewable", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_is_viewable(XEN_TO_C_GdkWindow_(window))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_is_viewable", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_is_viewable(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_get_state(XEN window)
+static Xen gxg_gdk_window_get_state(Xen window)
{
#define H_gdk_window_get_state "GdkWindowState gdk_window_get_state(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_state", "GdkWindow*");
- return(C_TO_XEN_GdkWindowState(gdk_window_get_state(XEN_TO_C_GdkWindow_(window))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_state", "GdkWindow*");
+ return(C_to_Xen_GdkWindowState(gdk_window_get_state(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_set_static_gravities(XEN window, XEN use_static)
-{
- #define H_gdk_window_set_static_gravities "gboolean gdk_window_set_static_gravities(GdkWindow* window, \
-gboolean use_static)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_static_gravities", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_static), use_static, 2, "gdk_window_set_static_gravities", "gboolean");
- return(C_TO_XEN_gboolean(gdk_window_set_static_gravities(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(use_static))));
-}
-
-static XEN gxg_gdk_window_get_root_origin(XEN window, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gdk_window_get_root_origin(Xen window, Xen ignore_x, Xen ignore_y)
{
#define H_gdk_window_get_root_origin "void gdk_window_get_root_origin(GdkWindow* window, gint* [x], \
gint* [y])"
gint ref_x;
gint ref_y;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_root_origin", "GdkWindow*");
- gdk_window_get_root_origin(XEN_TO_C_GdkWindow_(window), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y)));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_root_origin", "GdkWindow*");
+ gdk_window_get_root_origin(Xen_to_C_GdkWindow_(window), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y)));
}
-static XEN gxg_gdk_window_get_frame_extents(XEN window, XEN rect)
+static Xen gxg_gdk_window_get_frame_extents(Xen window, Xen rect)
{
#define H_gdk_window_get_frame_extents "void gdk_window_get_frame_extents(GdkWindow* window, GdkRectangle* rect)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_frame_extents", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rect), rect, 2, "gdk_window_get_frame_extents", "GdkRectangle*");
- gdk_window_get_frame_extents(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkRectangle_(rect));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_window_get_pointer(XEN window, XEN ignore_x, XEN ignore_y, XEN ignore_mask)
-{
- #define H_gdk_window_get_pointer "GdkWindow* gdk_window_get_pointer(GdkWindow* window, gint* [x], gint* [y], \
-GdkModifierType* [mask])"
- gint ref_x;
- gint ref_y;
- GdkModifierType ref_mask;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_pointer", "GdkWindow*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkWindow_(gdk_window_get_pointer(XEN_TO_C_GdkWindow_(window), &ref_x, &ref_y, &ref_mask));
- return(XEN_LIST_4(result, C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_GdkModifierType(ref_mask)));
- }
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_frame_extents", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 2, "gdk_window_get_frame_extents", "GdkRectangle*");
+ gdk_window_get_frame_extents(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkRectangle_(rect));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_parent(XEN window)
+static Xen gxg_gdk_window_get_parent(Xen window)
{
#define H_gdk_window_get_parent "GdkWindow* gdk_window_get_parent(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_parent", "GdkWindow*");
- return(C_TO_XEN_GdkWindow_(gdk_window_get_parent(XEN_TO_C_GdkWindow_(window))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_parent", "GdkWindow*");
+ return(C_to_Xen_GdkWindow_(gdk_window_get_parent(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_get_toplevel(XEN window)
+static Xen gxg_gdk_window_get_toplevel(Xen window)
{
#define H_gdk_window_get_toplevel "GdkWindow* gdk_window_get_toplevel(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_toplevel", "GdkWindow*");
- return(C_TO_XEN_GdkWindow_(gdk_window_get_toplevel(XEN_TO_C_GdkWindow_(window))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_toplevel", "GdkWindow*");
+ return(C_to_Xen_GdkWindow_(gdk_window_get_toplevel(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_get_children(XEN window)
+static Xen gxg_gdk_window_get_children(Xen window)
{
#define H_gdk_window_get_children "GList* gdk_window_get_children(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_children", "GdkWindow*");
- return(C_TO_XEN_GList_(gdk_window_get_children(XEN_TO_C_GdkWindow_(window))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_children", "GdkWindow*");
+ return(C_to_Xen_GList_(gdk_window_get_children(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_peek_children(XEN window)
+static Xen gxg_gdk_window_peek_children(Xen window)
{
#define H_gdk_window_peek_children "GList* gdk_window_peek_children(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_peek_children", "GdkWindow*");
- return(C_TO_XEN_GList_(gdk_window_peek_children(XEN_TO_C_GdkWindow_(window))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_peek_children", "GdkWindow*");
+ return(C_to_Xen_GList_(gdk_window_peek_children(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_get_events(XEN window)
+static Xen gxg_gdk_window_get_events(Xen window)
{
#define H_gdk_window_get_events "GdkEventMask gdk_window_get_events(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_events", "GdkWindow*");
- return(C_TO_XEN_GdkEventMask(gdk_window_get_events(XEN_TO_C_GdkWindow_(window))));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_events", "GdkWindow*");
+ return(C_to_Xen_GdkEventMask(gdk_window_get_events(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_window_set_events(XEN window, XEN event_mask)
+static Xen gxg_gdk_window_set_events(Xen window, Xen event_mask)
{
#define H_gdk_window_set_events "void gdk_window_set_events(GdkWindow* window, GdkEventMask event_mask)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_events", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkEventMask_P(event_mask), event_mask, 2, "gdk_window_set_events", "GdkEventMask");
- gdk_window_set_events(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkEventMask(event_mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_events", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkEventMask(event_mask), event_mask, 2, "gdk_window_set_events", "GdkEventMask");
+ gdk_window_set_events(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkEventMask(event_mask));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_icon_list(XEN window, XEN pixbufs)
+static Xen gxg_gdk_window_set_icon_list(Xen window, Xen pixbufs)
{
#define H_gdk_window_set_icon_list "void gdk_window_set_icon_list(GdkWindow* window, GList* pixbufs)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_icon_list", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GList__P(pixbufs), pixbufs, 2, "gdk_window_set_icon_list", "GList*");
- gdk_window_set_icon_list(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GList_(pixbufs));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_icon_list", "GdkWindow*");
+ Xen_check_type(Xen_is_GList_(pixbufs), pixbufs, 2, "gdk_window_set_icon_list", "GList*");
+ gdk_window_set_icon_list(Xen_to_C_GdkWindow_(window), Xen_to_C_GList_(pixbufs));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_icon_name(XEN window, XEN name)
+static Xen gxg_gdk_window_set_icon_name(Xen window, Xen name)
{
#define H_gdk_window_set_icon_name "void gdk_window_set_icon_name(GdkWindow* window, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_icon_name", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gdk_window_set_icon_name", "gchar*");
- gdk_window_set_icon_name(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_icon_name", "GdkWindow*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gdk_window_set_icon_name", "gchar*");
+ gdk_window_set_icon_name(Xen_to_C_GdkWindow_(window), Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_group(XEN window, XEN leader)
+static Xen gxg_gdk_window_set_group(Xen window, Xen leader)
{
#define H_gdk_window_set_group "void gdk_window_set_group(GdkWindow* window, GdkWindow* leader)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_group", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(leader), leader, 2, "gdk_window_set_group", "GdkWindow*");
- gdk_window_set_group(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWindow_(leader));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_group", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindow_(leader), leader, 2, "gdk_window_set_group", "GdkWindow*");
+ gdk_window_set_group(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWindow_(leader));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_decorations(XEN window, XEN decorations)
+static Xen gxg_gdk_window_set_decorations(Xen window, Xen decorations)
{
#define H_gdk_window_set_decorations "void gdk_window_set_decorations(GdkWindow* window, GdkWMDecoration decorations)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_decorations", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWMDecoration_P(decorations), decorations, 2, "gdk_window_set_decorations", "GdkWMDecoration");
- gdk_window_set_decorations(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWMDecoration(decorations));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_decorations", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWMDecoration(decorations), decorations, 2, "gdk_window_set_decorations", "GdkWMDecoration");
+ gdk_window_set_decorations(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWMDecoration(decorations));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_decorations(XEN window, XEN ignore_decorations)
+static Xen gxg_gdk_window_get_decorations(Xen window, Xen ignore_decorations)
{
#define H_gdk_window_get_decorations "gboolean gdk_window_get_decorations(GdkWindow* window, GdkWMDecoration* [decorations])"
GdkWMDecoration ref_decorations;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_decorations", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_decorations", "GdkWindow*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_window_get_decorations(XEN_TO_C_GdkWindow_(window), &ref_decorations));
- return(XEN_LIST_2(result, C_TO_XEN_GdkWMDecoration(ref_decorations)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_window_get_decorations(Xen_to_C_GdkWindow_(window), &ref_decorations));
+ return(Xen_list_2(result, C_to_Xen_GdkWMDecoration(ref_decorations)));
}
}
-static XEN gxg_gdk_window_set_functions(XEN window, XEN functions)
+static Xen gxg_gdk_window_set_functions(Xen window, Xen functions)
{
#define H_gdk_window_set_functions "void gdk_window_set_functions(GdkWindow* window, GdkWMFunction functions)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_functions", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWMFunction_P(functions), functions, 2, "gdk_window_set_functions", "GdkWMFunction");
- gdk_window_set_functions(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWMFunction(functions));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_functions", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWMFunction(functions), functions, 2, "gdk_window_set_functions", "GdkWMFunction");
+ gdk_window_set_functions(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWMFunction(functions));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_iconify(XEN window)
+static Xen gxg_gdk_window_iconify(Xen window)
{
#define H_gdk_window_iconify "void gdk_window_iconify(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_iconify", "GdkWindow*");
- gdk_window_iconify(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_iconify", "GdkWindow*");
+ gdk_window_iconify(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_deiconify(XEN window)
+static Xen gxg_gdk_window_deiconify(Xen window)
{
#define H_gdk_window_deiconify "void gdk_window_deiconify(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_deiconify", "GdkWindow*");
- gdk_window_deiconify(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_deiconify", "GdkWindow*");
+ gdk_window_deiconify(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_stick(XEN window)
+static Xen gxg_gdk_window_stick(Xen window)
{
#define H_gdk_window_stick "void gdk_window_stick(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_stick", "GdkWindow*");
- gdk_window_stick(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_stick", "GdkWindow*");
+ gdk_window_stick(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_unstick(XEN window)
+static Xen gxg_gdk_window_unstick(Xen window)
{
#define H_gdk_window_unstick "void gdk_window_unstick(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_unstick", "GdkWindow*");
- gdk_window_unstick(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_unstick", "GdkWindow*");
+ gdk_window_unstick(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_maximize(XEN window)
+static Xen gxg_gdk_window_maximize(Xen window)
{
#define H_gdk_window_maximize "void gdk_window_maximize(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_maximize", "GdkWindow*");
- gdk_window_maximize(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_maximize", "GdkWindow*");
+ gdk_window_maximize(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_unmaximize(XEN window)
+static Xen gxg_gdk_window_unmaximize(Xen window)
{
#define H_gdk_window_unmaximize "void gdk_window_unmaximize(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_unmaximize", "GdkWindow*");
- gdk_window_unmaximize(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_unmaximize", "GdkWindow*");
+ gdk_window_unmaximize(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_register_dnd(XEN window)
+static Xen gxg_gdk_window_register_dnd(Xen window)
{
#define H_gdk_window_register_dnd "void gdk_window_register_dnd(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_register_dnd", "GdkWindow*");
- gdk_window_register_dnd(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_register_dnd", "GdkWindow*");
+ gdk_window_register_dnd(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_begin_resize_drag(XEN window, XEN edge, XEN button, XEN root_x, XEN root_y, XEN timestamp)
+static Xen gxg_gdk_window_begin_resize_drag(Xen window, Xen edge, Xen button, Xen root_x, Xen root_y, Xen timestamp)
{
#define H_gdk_window_begin_resize_drag "void gdk_window_begin_resize_drag(GdkWindow* window, GdkWindowEdge edge, \
gint button, gint root_x, gint root_y, guint32 timestamp)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_begin_resize_drag", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindowEdge_P(edge), edge, 2, "gdk_window_begin_resize_drag", "GdkWindowEdge");
- XEN_ASSERT_TYPE(XEN_gint_P(button), button, 3, "gdk_window_begin_resize_drag", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(root_x), root_x, 4, "gdk_window_begin_resize_drag", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(root_y), root_y, 5, "gdk_window_begin_resize_drag", "gint");
- XEN_ASSERT_TYPE(XEN_guint32_P(timestamp), timestamp, 6, "gdk_window_begin_resize_drag", "guint32");
- gdk_window_begin_resize_drag(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWindowEdge(edge), XEN_TO_C_gint(button), XEN_TO_C_gint(root_x),
- XEN_TO_C_gint(root_y), XEN_TO_C_guint32(timestamp));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_begin_resize_drag", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindowEdge(edge), edge, 2, "gdk_window_begin_resize_drag", "GdkWindowEdge");
+ Xen_check_type(Xen_is_gint(button), button, 3, "gdk_window_begin_resize_drag", "gint");
+ Xen_check_type(Xen_is_gint(root_x), root_x, 4, "gdk_window_begin_resize_drag", "gint");
+ Xen_check_type(Xen_is_gint(root_y), root_y, 5, "gdk_window_begin_resize_drag", "gint");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 6, "gdk_window_begin_resize_drag", "guint32");
+ gdk_window_begin_resize_drag(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWindowEdge(edge), Xen_to_C_gint(button), Xen_to_C_gint(root_x),
+ Xen_to_C_gint(root_y), Xen_to_C_guint32(timestamp));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_begin_move_drag(XEN window, XEN button, XEN root_x, XEN root_y, XEN timestamp)
+static Xen gxg_gdk_window_begin_move_drag(Xen window, Xen button, Xen root_x, Xen root_y, Xen timestamp)
{
#define H_gdk_window_begin_move_drag "void gdk_window_begin_move_drag(GdkWindow* window, gint button, \
gint root_x, gint root_y, guint32 timestamp)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_begin_move_drag", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(button), button, 2, "gdk_window_begin_move_drag", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(root_x), root_x, 3, "gdk_window_begin_move_drag", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(root_y), root_y, 4, "gdk_window_begin_move_drag", "gint");
- XEN_ASSERT_TYPE(XEN_guint32_P(timestamp), timestamp, 5, "gdk_window_begin_move_drag", "guint32");
- gdk_window_begin_move_drag(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gint(button), XEN_TO_C_gint(root_x), XEN_TO_C_gint(root_y),
- XEN_TO_C_guint32(timestamp));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_begin_move_drag", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(button), button, 2, "gdk_window_begin_move_drag", "gint");
+ Xen_check_type(Xen_is_gint(root_x), root_x, 3, "gdk_window_begin_move_drag", "gint");
+ Xen_check_type(Xen_is_gint(root_y), root_y, 4, "gdk_window_begin_move_drag", "gint");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 5, "gdk_window_begin_move_drag", "guint32");
+ gdk_window_begin_move_drag(Xen_to_C_GdkWindow_(window), Xen_to_C_gint(button), Xen_to_C_gint(root_x), Xen_to_C_gint(root_y),
+ Xen_to_C_guint32(timestamp));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_invalidate_rect(XEN window, XEN rect, XEN invalidate_children)
+static Xen gxg_gdk_window_invalidate_rect(Xen window, Xen rect, Xen invalidate_children)
{
#define H_gdk_window_invalidate_rect "void gdk_window_invalidate_rect(GdkWindow* window, GdkRectangle* rect, \
gboolean invalidate_children)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_invalidate_rect", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rect), rect, 2, "gdk_window_invalidate_rect", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(invalidate_children), invalidate_children, 3, "gdk_window_invalidate_rect", "gboolean");
- gdk_window_invalidate_rect(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkRectangle_(rect), XEN_TO_C_gboolean(invalidate_children));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_invalidate_rect", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 2, "gdk_window_invalidate_rect", "GdkRectangle*");
+ Xen_check_type(Xen_is_gboolean(invalidate_children), invalidate_children, 3, "gdk_window_invalidate_rect", "gboolean");
+ gdk_window_invalidate_rect(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkRectangle_(rect), Xen_to_C_gboolean(invalidate_children));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_freeze_updates(XEN window)
+static Xen gxg_gdk_window_freeze_updates(Xen window)
{
#define H_gdk_window_freeze_updates "void gdk_window_freeze_updates(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_freeze_updates", "GdkWindow*");
- gdk_window_freeze_updates(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_freeze_updates", "GdkWindow*");
+ gdk_window_freeze_updates(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_thaw_updates(XEN window)
+static Xen gxg_gdk_window_thaw_updates(Xen window)
{
#define H_gdk_window_thaw_updates "void gdk_window_thaw_updates(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_thaw_updates", "GdkWindow*");
- gdk_window_thaw_updates(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_thaw_updates", "GdkWindow*");
+ gdk_window_thaw_updates(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_process_all_updates(void)
+static Xen gxg_gdk_window_process_all_updates(void)
{
#define H_gdk_window_process_all_updates "void gdk_window_process_all_updates( void)"
gdk_window_process_all_updates();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxg_gdk_window_process_updates(XEN window, XEN update_children)
+static Xen gxg_gdk_window_process_updates(Xen window, Xen update_children)
{
#define H_gdk_window_process_updates "void gdk_window_process_updates(GdkWindow* window, gboolean update_children)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_process_updates", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(update_children), update_children, 2, "gdk_window_process_updates", "gboolean");
- gdk_window_process_updates(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(update_children));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_process_updates", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(update_children), update_children, 2, "gdk_window_process_updates", "gboolean");
+ gdk_window_process_updates(Xen_to_C_GdkWindow_(window), Xen_to_C_gboolean(update_children));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_debug_updates(XEN setting)
+static Xen gxg_gdk_window_set_debug_updates(Xen setting)
{
#define H_gdk_window_set_debug_updates "void gdk_window_set_debug_updates(gboolean setting)"
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 1, "gdk_window_set_debug_updates", "gboolean");
- gdk_window_set_debug_updates(XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gboolean(setting), setting, 1, "gdk_window_set_debug_updates", "gboolean");
+ gdk_window_set_debug_updates(Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_constrain_size(XEN geometry, XEN flags, XEN width, XEN height, XEN ignore_new_width, XEN ignore_new_height)
+static Xen gxg_gdk_window_constrain_size(Xen geometry, Xen flags, Xen width, Xen height, Xen ignore_new_width, Xen ignore_new_height)
{
- #define H_gdk_window_constrain_size "void gdk_window_constrain_size(GdkGeometry* geometry, guint flags, \
+ #define H_gdk_window_constrain_size "void gdk_window_constrain_size(GdkGeometry* geometry, GdkWindowHints flags, \
gint width, gint height, gint* [new_width], gint* [new_height])"
gint ref_new_width;
gint ref_new_height;
- XEN_ASSERT_TYPE(XEN_GdkGeometry__P(geometry), geometry, 1, "gdk_window_constrain_size", "GdkGeometry*");
- XEN_ASSERT_TYPE(XEN_guint_P(flags), flags, 2, "gdk_window_constrain_size", "guint");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 3, "gdk_window_constrain_size", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 4, "gdk_window_constrain_size", "gint");
- gdk_window_constrain_size(XEN_TO_C_GdkGeometry_(geometry), XEN_TO_C_guint(flags), XEN_TO_C_gint(width), XEN_TO_C_gint(height),
+ Xen_check_type(Xen_is_GdkGeometry_(geometry), geometry, 1, "gdk_window_constrain_size", "GdkGeometry*");
+ Xen_check_type(Xen_is_GdkWindowHints(flags), flags, 2, "gdk_window_constrain_size", "GdkWindowHints");
+ Xen_check_type(Xen_is_gint(width), width, 3, "gdk_window_constrain_size", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 4, "gdk_window_constrain_size", "gint");
+ gdk_window_constrain_size(Xen_to_C_GdkGeometry_(geometry), Xen_to_C_GdkWindowHints(flags), Xen_to_C_gint(width), Xen_to_C_gint(height),
&ref_new_width, &ref_new_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_new_width), C_TO_XEN_gint(ref_new_height)));
+ return(Xen_list_2(C_to_Xen_gint(ref_new_width), C_to_Xen_gint(ref_new_height)));
}
-static XEN gxg_gdk_window_set_type_hint(XEN window, XEN hint)
+static Xen gxg_gdk_window_set_type_hint(Xen window, Xen hint)
{
#define H_gdk_window_set_type_hint "void gdk_window_set_type_hint(GdkWindow* window, GdkWindowTypeHint hint)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_type_hint", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindowTypeHint_P(hint), hint, 2, "gdk_window_set_type_hint", "GdkWindowTypeHint");
- gdk_window_set_type_hint(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWindowTypeHint(hint));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_type_hint", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindowTypeHint(hint), hint, 2, "gdk_window_set_type_hint", "GdkWindowTypeHint");
+ gdk_window_set_type_hint(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWindowTypeHint(hint));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_modal_hint(XEN window, XEN modal)
+static Xen gxg_gdk_window_set_modal_hint(Xen window, Xen modal)
{
#define H_gdk_window_set_modal_hint "void gdk_window_set_modal_hint(GdkWindow* window, gboolean modal)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_modal_hint", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(modal), modal, 2, "gdk_window_set_modal_hint", "gboolean");
- gdk_window_set_modal_hint(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(modal));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_modal_hint", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(modal), modal, 2, "gdk_window_set_modal_hint", "gboolean");
+ gdk_window_set_modal_hint(Xen_to_C_GdkWindow_(window), Xen_to_C_gboolean(modal));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_geometry_hints(XEN window, XEN geometry, XEN geom_mask)
+static Xen gxg_gdk_window_set_geometry_hints(Xen window, Xen geometry, Xen geom_mask)
{
#define H_gdk_window_set_geometry_hints "void gdk_window_set_geometry_hints(GdkWindow* window, GdkGeometry* geometry, \
GdkWindowHints geom_mask)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_geometry_hints", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkGeometry__P(geometry), geometry, 2, "gdk_window_set_geometry_hints", "GdkGeometry*");
- XEN_ASSERT_TYPE(XEN_GdkWindowHints_P(geom_mask), geom_mask, 3, "gdk_window_set_geometry_hints", "GdkWindowHints");
- gdk_window_set_geometry_hints(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkGeometry_(geometry), XEN_TO_C_GdkWindowHints(geom_mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_geometry_hints", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkGeometry_(geometry), geometry, 2, "gdk_window_set_geometry_hints", "GdkGeometry*");
+ Xen_check_type(Xen_is_GdkWindowHints(geom_mask), geom_mask, 3, "gdk_window_set_geometry_hints", "GdkWindowHints");
+ gdk_window_set_geometry_hints(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkGeometry_(geometry), Xen_to_C_GdkWindowHints(geom_mask));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_begin_paint_rect(XEN window, XEN rectangle)
+static Xen gxg_gdk_window_begin_paint_rect(Xen window, Xen rectangle)
{
#define H_gdk_window_begin_paint_rect "void gdk_window_begin_paint_rect(GdkWindow* window, GdkRectangle* rectangle)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_begin_paint_rect", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rectangle), rectangle, 2, "gdk_window_begin_paint_rect", "GdkRectangle*");
- gdk_window_begin_paint_rect(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkRectangle_(rectangle));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_begin_paint_rect", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkRectangle_(rectangle), rectangle, 2, "gdk_window_begin_paint_rect", "GdkRectangle*");
+ gdk_window_begin_paint_rect(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkRectangle_(rectangle));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_end_paint(XEN window)
+static Xen gxg_gdk_window_end_paint(Xen window)
{
#define H_gdk_window_end_paint "void gdk_window_end_paint(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_end_paint", "GdkWindow*");
- gdk_window_end_paint(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_end_paint", "GdkWindow*");
+ gdk_window_end_paint(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_title(XEN window, XEN title)
+static Xen gxg_gdk_window_set_title(Xen window, Xen title)
{
#define H_gdk_window_set_title "void gdk_window_set_title(GdkWindow* window, gchar* title)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_title", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gdk_window_set_title", "gchar*");
- gdk_window_set_title(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_title", "GdkWindow*");
+ Xen_check_type(Xen_is_gchar_(title), title, 2, "gdk_window_set_title", "gchar*");
+ gdk_window_set_title(Xen_to_C_GdkWindow_(window), Xen_to_C_gchar_(title));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_role(XEN window, XEN role)
+static Xen gxg_gdk_window_set_role(Xen window, Xen role)
{
#define H_gdk_window_set_role "void gdk_window_set_role(GdkWindow* window, gchar* role)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_role", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(role), role, 2, "gdk_window_set_role", "gchar*");
- gdk_window_set_role(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gchar_(role));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_role", "GdkWindow*");
+ Xen_check_type(Xen_is_gchar_(role), role, 2, "gdk_window_set_role", "gchar*");
+ gdk_window_set_role(Xen_to_C_GdkWindow_(window), Xen_to_C_gchar_(role));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_transient_for(XEN window, XEN parent)
+static Xen gxg_gdk_window_set_transient_for(Xen window, Xen parent)
{
#define H_gdk_window_set_transient_for "void gdk_window_set_transient_for(GdkWindow* window, GdkWindow* parent)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_transient_for", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(parent), parent, 2, "gdk_window_set_transient_for", "GdkWindow*");
- gdk_window_set_transient_for(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWindow_(parent));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_window_set_background(XEN window, XEN color)
-{
- #define H_gdk_window_set_background "void gdk_window_set_background(GdkWindow* window, GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_background", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gdk_window_set_background", "GdkColor*");
- gdk_window_set_background(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_transient_for", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindow_(parent), parent, 2, "gdk_window_set_transient_for", "GdkWindow*");
+ gdk_window_set_transient_for(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWindow_(parent));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_cursor(XEN window, XEN cursor)
+static Xen gxg_gdk_window_set_cursor(Xen window, Xen cursor)
{
#define H_gdk_window_set_cursor "void gdk_window_set_cursor(GdkWindow* window, GdkCursor* cursor)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_cursor", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkCursor__P(cursor), cursor, 2, "gdk_window_set_cursor", "GdkCursor*");
- gdk_window_set_cursor(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkCursor_(cursor));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_cursor", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkCursor_(cursor), cursor, 2, "gdk_window_set_cursor", "GdkCursor*");
+ gdk_window_set_cursor(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkCursor_(cursor));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_user_data(XEN window, XEN ignore_data)
+static Xen gxg_gdk_window_get_user_data(Xen window, Xen ignore_data)
{
#define H_gdk_window_get_user_data "void gdk_window_get_user_data(GdkWindow* window, gpointer* [data])"
gpointer ref_data;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_user_data", "GdkWindow*");
- gdk_window_get_user_data(XEN_TO_C_GdkWindow_(window), &ref_data);
- return(XEN_LIST_1(C_TO_XEN_gpointer(ref_data)));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_user_data", "GdkWindow*");
+ gdk_window_get_user_data(Xen_to_C_GdkWindow_(window), &ref_data);
+ return(Xen_list_1(C_to_Xen_gpointer(ref_data)));
}
-static XEN gxg_gdk_window_get_position(XEN window, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gdk_window_get_position(Xen window, Xen ignore_x, Xen ignore_y)
{
#define H_gdk_window_get_position "void gdk_window_get_position(GdkWindow* window, gint* [x], gint* [y])"
gint ref_x;
gint ref_y;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_position", "GdkWindow*");
- gdk_window_get_position(XEN_TO_C_GdkWindow_(window), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y)));
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_position", "GdkWindow*");
+ gdk_window_get_position(Xen_to_C_GdkWindow_(window), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y)));
}
-static XEN gxg_gdk_window_get_origin(XEN window, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gdk_window_get_origin(Xen window, Xen ignore_x, Xen ignore_y)
{
#define H_gdk_window_get_origin "gint gdk_window_get_origin(GdkWindow* window, gint* [x], gint* [y])"
gint ref_x;
gint ref_y;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_origin", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_origin", "GdkWindow*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gint(gdk_window_get_origin(XEN_TO_C_GdkWindow_(window), &ref_x, &ref_y));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y)));
+ Xen result;
+ result = C_to_Xen_gint(gdk_window_get_origin(Xen_to_C_GdkWindow_(window), &ref_x, &ref_y));
+ return(Xen_list_3(result, C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y)));
}
}
-static XEN gxg_gdk_get_default_root_window(void)
+static Xen gxg_gdk_get_default_root_window(void)
{
#define H_gdk_get_default_root_window "GdkWindow* gdk_get_default_root_window( void)"
- return(C_TO_XEN_GdkWindow_(gdk_get_default_root_window()));
+ return(C_to_Xen_GdkWindow_(gdk_get_default_root_window()));
}
-static XEN gxg_gdk_pixbuf_error_quark(void)
+static Xen gxg_gdk_pixbuf_error_quark(void)
{
#define H_gdk_pixbuf_error_quark "GQuark gdk_pixbuf_error_quark( void)"
- return(C_TO_XEN_GQuark(gdk_pixbuf_error_quark()));
+ return(C_to_Xen_GQuark(gdk_pixbuf_error_quark()));
}
-static XEN gxg_gdk_pixbuf_get_colorspace(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_get_colorspace(Xen pixbuf)
{
#define H_gdk_pixbuf_get_colorspace "GdkColorspace gdk_pixbuf_get_colorspace(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_colorspace", "GdkPixbuf*");
- return(C_TO_XEN_GdkColorspace(gdk_pixbuf_get_colorspace(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_colorspace", "GdkPixbuf*");
+ return(C_to_Xen_GdkColorspace(gdk_pixbuf_get_colorspace(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_get_n_channels(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_get_n_channels(Xen pixbuf)
{
#define H_gdk_pixbuf_get_n_channels "int gdk_pixbuf_get_n_channels(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_n_channels", "GdkPixbuf*");
- return(C_TO_XEN_int(gdk_pixbuf_get_n_channels(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_n_channels", "GdkPixbuf*");
+ return(C_to_Xen_int(gdk_pixbuf_get_n_channels(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_get_has_alpha(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_get_has_alpha(Xen pixbuf)
{
#define H_gdk_pixbuf_get_has_alpha "gboolean gdk_pixbuf_get_has_alpha(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_has_alpha", "GdkPixbuf*");
- return(C_TO_XEN_gboolean(gdk_pixbuf_get_has_alpha(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_has_alpha", "GdkPixbuf*");
+ return(C_to_Xen_gboolean(gdk_pixbuf_get_has_alpha(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_get_bits_per_sample(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_get_bits_per_sample(Xen pixbuf)
{
#define H_gdk_pixbuf_get_bits_per_sample "int gdk_pixbuf_get_bits_per_sample(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_bits_per_sample", "GdkPixbuf*");
- return(C_TO_XEN_int(gdk_pixbuf_get_bits_per_sample(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_bits_per_sample", "GdkPixbuf*");
+ return(C_to_Xen_int(gdk_pixbuf_get_bits_per_sample(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_get_pixels(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_get_pixels(Xen pixbuf)
{
#define H_gdk_pixbuf_get_pixels "guchar* gdk_pixbuf_get_pixels(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_pixels", "GdkPixbuf*");
- return(C_TO_XEN_guchar_(gdk_pixbuf_get_pixels(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_pixels", "GdkPixbuf*");
+ return(C_to_Xen_guchar_(gdk_pixbuf_get_pixels(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_get_width(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_get_width(Xen pixbuf)
{
#define H_gdk_pixbuf_get_width "int gdk_pixbuf_get_width(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_width", "GdkPixbuf*");
- return(C_TO_XEN_int(gdk_pixbuf_get_width(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_width", "GdkPixbuf*");
+ return(C_to_Xen_int(gdk_pixbuf_get_width(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_get_height(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_get_height(Xen pixbuf)
{
#define H_gdk_pixbuf_get_height "int gdk_pixbuf_get_height(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_height", "GdkPixbuf*");
- return(C_TO_XEN_int(gdk_pixbuf_get_height(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_height", "GdkPixbuf*");
+ return(C_to_Xen_int(gdk_pixbuf_get_height(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_get_rowstride(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_get_rowstride(Xen pixbuf)
{
#define H_gdk_pixbuf_get_rowstride "int gdk_pixbuf_get_rowstride(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_rowstride", "GdkPixbuf*");
- return(C_TO_XEN_int(gdk_pixbuf_get_rowstride(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_rowstride", "GdkPixbuf*");
+ return(C_to_Xen_int(gdk_pixbuf_get_rowstride(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_new(XEN colorspace, XEN has_alpha, XEN bits_per_sample, XEN width, XEN height)
+static Xen gxg_gdk_pixbuf_new(Xen colorspace, Xen has_alpha, Xen bits_per_sample, Xen width, Xen height)
{
#define H_gdk_pixbuf_new "GdkPixbuf* gdk_pixbuf_new(GdkColorspace colorspace, gboolean has_alpha, int bits_per_sample, \
int width, int height)"
- XEN_ASSERT_TYPE(XEN_GdkColorspace_P(colorspace), colorspace, 1, "gdk_pixbuf_new", "GdkColorspace");
- XEN_ASSERT_TYPE(XEN_gboolean_P(has_alpha), has_alpha, 2, "gdk_pixbuf_new", "gboolean");
- XEN_ASSERT_TYPE(XEN_int_P(bits_per_sample), bits_per_sample, 3, "gdk_pixbuf_new", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 4, "gdk_pixbuf_new", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 5, "gdk_pixbuf_new", "int");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_new(XEN_TO_C_GdkColorspace(colorspace), XEN_TO_C_gboolean(has_alpha), XEN_TO_C_int(bits_per_sample),
- XEN_TO_C_int(width), XEN_TO_C_int(height))));
+ Xen_check_type(Xen_is_GdkColorspace(colorspace), colorspace, 1, "gdk_pixbuf_new", "GdkColorspace");
+ Xen_check_type(Xen_is_gboolean(has_alpha), has_alpha, 2, "gdk_pixbuf_new", "gboolean");
+ Xen_check_type(Xen_is_int(bits_per_sample), bits_per_sample, 3, "gdk_pixbuf_new", "int");
+ Xen_check_type(Xen_is_int(width), width, 4, "gdk_pixbuf_new", "int");
+ Xen_check_type(Xen_is_int(height), height, 5, "gdk_pixbuf_new", "int");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_new(Xen_to_C_GdkColorspace(colorspace), Xen_to_C_gboolean(has_alpha), Xen_to_C_int(bits_per_sample),
+ Xen_to_C_int(width), Xen_to_C_int(height))));
}
-static XEN gxg_gdk_pixbuf_copy(XEN pixbuf)
+static Xen gxg_gdk_pixbuf_copy(Xen pixbuf)
{
#define H_gdk_pixbuf_copy "GdkPixbuf* gdk_pixbuf_copy(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_copy", "GdkPixbuf*");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_copy(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_copy", "GdkPixbuf*");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_copy(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_pixbuf_new_subpixbuf(XEN src_pixbuf, XEN src_x, XEN src_y, XEN width, XEN height)
+static Xen gxg_gdk_pixbuf_new_subpixbuf(Xen src_pixbuf, Xen src_x, Xen src_y, Xen width, Xen height)
{
#define H_gdk_pixbuf_new_subpixbuf "GdkPixbuf* gdk_pixbuf_new_subpixbuf(GdkPixbuf* src_pixbuf, int src_x, \
int src_y, int width, int height)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(src_pixbuf), src_pixbuf, 1, "gdk_pixbuf_new_subpixbuf", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(src_x), src_x, 2, "gdk_pixbuf_new_subpixbuf", "int");
- XEN_ASSERT_TYPE(XEN_int_P(src_y), src_y, 3, "gdk_pixbuf_new_subpixbuf", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 4, "gdk_pixbuf_new_subpixbuf", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 5, "gdk_pixbuf_new_subpixbuf", "int");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_new_subpixbuf(XEN_TO_C_GdkPixbuf_(src_pixbuf), XEN_TO_C_int(src_x), XEN_TO_C_int(src_y),
- XEN_TO_C_int(width), XEN_TO_C_int(height))));
+ Xen_check_type(Xen_is_GdkPixbuf_(src_pixbuf), src_pixbuf, 1, "gdk_pixbuf_new_subpixbuf", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(src_x), src_x, 2, "gdk_pixbuf_new_subpixbuf", "int");
+ Xen_check_type(Xen_is_int(src_y), src_y, 3, "gdk_pixbuf_new_subpixbuf", "int");
+ Xen_check_type(Xen_is_int(width), width, 4, "gdk_pixbuf_new_subpixbuf", "int");
+ Xen_check_type(Xen_is_int(height), height, 5, "gdk_pixbuf_new_subpixbuf", "int");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_new_subpixbuf(Xen_to_C_GdkPixbuf_(src_pixbuf), Xen_to_C_int(src_x), Xen_to_C_int(src_y),
+ Xen_to_C_int(width), Xen_to_C_int(height))));
}
-static XEN gxg_gdk_pixbuf_new_from_file(XEN filename, XEN ignore_error)
+static Xen gxg_gdk_pixbuf_new_from_file(Xen filename, Xen ignore_error)
{
#define H_gdk_pixbuf_new_from_file "GdkPixbuf* gdk_pixbuf_new_from_file(char* filename, GError** [error])"
GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_char__P(filename), filename, 1, "gdk_pixbuf_new_from_file", "char*");
+ Xen_check_type(Xen_is_char_(filename), filename, 1, "gdk_pixbuf_new_from_file", "char*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkPixbuf_(gdk_pixbuf_new_from_file(XEN_TO_C_char_(filename), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
+ Xen result;
+ result = C_to_Xen_GdkPixbuf_(gdk_pixbuf_new_from_file(Xen_to_C_char_(filename), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
}
}
-static XEN gxg_gdk_pixbuf_new_from_data(XEN data, XEN colorspace, XEN has_alpha, XEN bits_per_sample, XEN width, XEN height, XEN rowstride, XEN destroy_fn, XEN destroy_fn_data)
+static Xen gxg_gdk_pixbuf_new_from_data(Xen arglist)
{
#define H_gdk_pixbuf_new_from_data "GdkPixbuf* gdk_pixbuf_new_from_data(guchar* data, GdkColorspace colorspace, \
gboolean has_alpha, int bits_per_sample, int width, int height, int rowstride, GdkPixbufDestroyNotify destroy_fn, \
gpointer destroy_fn_data)"
- XEN_ASSERT_TYPE(XEN_guchar__P(data), data, 1, "gdk_pixbuf_new_from_data", "guchar*");
- XEN_ASSERT_TYPE(XEN_GdkColorspace_P(colorspace), colorspace, 2, "gdk_pixbuf_new_from_data", "GdkColorspace");
- XEN_ASSERT_TYPE(XEN_gboolean_P(has_alpha), has_alpha, 3, "gdk_pixbuf_new_from_data", "gboolean");
- XEN_ASSERT_TYPE(XEN_int_P(bits_per_sample), bits_per_sample, 4, "gdk_pixbuf_new_from_data", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 5, "gdk_pixbuf_new_from_data", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 6, "gdk_pixbuf_new_from_data", "int");
- XEN_ASSERT_TYPE(XEN_int_P(rowstride), rowstride, 7, "gdk_pixbuf_new_from_data", "int");
- XEN_ASSERT_TYPE(XEN_GdkPixbufDestroyNotify_P(destroy_fn), destroy_fn, 8, "gdk_pixbuf_new_from_data", "GdkPixbufDestroyNotify");
- XEN_ASSERT_TYPE(XEN_gpointer_P(destroy_fn_data), destroy_fn_data, 9, "gdk_pixbuf_new_from_data", "gpointer");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_new_from_data(XEN_TO_C_guchar_(data), XEN_TO_C_GdkColorspace(colorspace), XEN_TO_C_gboolean(has_alpha),
- XEN_TO_C_int(bits_per_sample), XEN_TO_C_int(width), XEN_TO_C_int(height),
- XEN_TO_C_int(rowstride), XEN_TO_C_GdkPixbufDestroyNotify(destroy_fn),
- XEN_TO_C_gpointer(destroy_fn_data))));
-}
-
-static XEN gxg_gdk_pixbuf_new_from_xpm_data(XEN data)
+ Xen data, colorspace, has_alpha, bits_per_sample, width, height, rowstride, destroy_fn, destroy_fn_data;
+ data = Xen_list_ref(arglist, 0);
+ colorspace = Xen_list_ref(arglist, 1);
+ has_alpha = Xen_list_ref(arglist, 2);
+ bits_per_sample = Xen_list_ref(arglist, 3);
+ width = Xen_list_ref(arglist, 4);
+ height = Xen_list_ref(arglist, 5);
+ rowstride = Xen_list_ref(arglist, 6);
+ destroy_fn = Xen_list_ref(arglist, 7);
+ destroy_fn_data = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_guchar_(data), data, 1, "gdk_pixbuf_new_from_data", "guchar*");
+ Xen_check_type(Xen_is_GdkColorspace(colorspace), colorspace, 2, "gdk_pixbuf_new_from_data", "GdkColorspace");
+ Xen_check_type(Xen_is_gboolean(has_alpha), has_alpha, 3, "gdk_pixbuf_new_from_data", "gboolean");
+ Xen_check_type(Xen_is_int(bits_per_sample), bits_per_sample, 4, "gdk_pixbuf_new_from_data", "int");
+ Xen_check_type(Xen_is_int(width), width, 5, "gdk_pixbuf_new_from_data", "int");
+ Xen_check_type(Xen_is_int(height), height, 6, "gdk_pixbuf_new_from_data", "int");
+ Xen_check_type(Xen_is_int(rowstride), rowstride, 7, "gdk_pixbuf_new_from_data", "int");
+ Xen_check_type(Xen_is_GdkPixbufDestroyNotify(destroy_fn), destroy_fn, 8, "gdk_pixbuf_new_from_data", "GdkPixbufDestroyNotify");
+ Xen_check_type(Xen_is_gpointer(destroy_fn_data), destroy_fn_data, 9, "gdk_pixbuf_new_from_data", "gpointer");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_new_from_data(Xen_to_C_guchar_(data), Xen_to_C_GdkColorspace(colorspace), Xen_to_C_gboolean(has_alpha),
+ Xen_to_C_int(bits_per_sample), Xen_to_C_int(width), Xen_to_C_int(height),
+ Xen_to_C_int(rowstride), Xen_to_C_GdkPixbufDestroyNotify(destroy_fn),
+ Xen_to_C_gpointer(destroy_fn_data))));
+}
+
+static Xen gxg_gdk_pixbuf_new_from_xpm_data(Xen data)
{
#define H_gdk_pixbuf_new_from_xpm_data "GdkPixbuf* gdk_pixbuf_new_from_xpm_data(char** data)"
- XEN_ASSERT_TYPE(XEN_char___P(data), data, 1, "gdk_pixbuf_new_from_xpm_data", "char**");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_new_from_xpm_data((const char**)XEN_TO_C_char__(data))));
-}
-
-static XEN gxg_gdk_pixbuf_new_from_inline(XEN data_length, XEN data, XEN copy_pixels, XEN ignore_error)
-{
- #define H_gdk_pixbuf_new_from_inline "GdkPixbuf* gdk_pixbuf_new_from_inline(gint data_length, guint8* data, \
-gboolean copy_pixels, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_gint_P(data_length), data_length, 1, "gdk_pixbuf_new_from_inline", "gint");
- XEN_ASSERT_TYPE(XEN_guint8__P(data), data, 2, "gdk_pixbuf_new_from_inline", "guint8*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(copy_pixels), copy_pixels, 3, "gdk_pixbuf_new_from_inline", "gboolean");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkPixbuf_(gdk_pixbuf_new_from_inline(XEN_TO_C_gint(data_length), XEN_TO_C_guint8_(data), XEN_TO_C_gboolean(copy_pixels),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ Xen_check_type(Xen_is_char__(data), data, 1, "gdk_pixbuf_new_from_xpm_data", "char**");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_new_from_xpm_data((const char**)Xen_to_C_char__(data))));
}
-static XEN gxg_gdk_pixbuf_fill(XEN pixbuf, XEN pixel)
+static Xen gxg_gdk_pixbuf_fill(Xen pixbuf, Xen pixel)
{
#define H_gdk_pixbuf_fill "void gdk_pixbuf_fill(GdkPixbuf* pixbuf, guint32 pixel)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_fill", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_guint32_P(pixel), pixel, 2, "gdk_pixbuf_fill", "guint32");
- gdk_pixbuf_fill(XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_guint32(pixel));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_fill", "GdkPixbuf*");
+ Xen_check_type(Xen_is_guint32(pixel), pixel, 2, "gdk_pixbuf_fill", "guint32");
+ gdk_pixbuf_fill(Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_guint32(pixel));
+ return(Xen_false);
}
-static XEN gxg_gdk_pixbuf_savev(XEN pixbuf, XEN filename, XEN type, XEN option_keys, XEN option_values, XEN ignore_error)
+static Xen gxg_gdk_pixbuf_savev(Xen pixbuf, Xen filename, Xen type, Xen option_keys, Xen option_values, Xen ignore_error)
{
#define H_gdk_pixbuf_savev "gboolean gdk_pixbuf_savev(GdkPixbuf* pixbuf, char* filename, char* type, \
char** option_keys, char** option_values, GError** [error])"
GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_savev", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_char__P(filename), filename, 2, "gdk_pixbuf_savev", "char*");
- XEN_ASSERT_TYPE(XEN_char__P(type), type, 3, "gdk_pixbuf_savev", "char*");
- XEN_ASSERT_TYPE(XEN_char___P(option_keys), option_keys, 4, "gdk_pixbuf_savev", "char**");
- XEN_ASSERT_TYPE(XEN_char___P(option_values), option_values, 5, "gdk_pixbuf_savev", "char**");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_savev", "GdkPixbuf*");
+ Xen_check_type(Xen_is_char_(filename), filename, 2, "gdk_pixbuf_savev", "char*");
+ Xen_check_type(Xen_is_char_(type), type, 3, "gdk_pixbuf_savev", "char*");
+ Xen_check_type(Xen_is_char__(option_keys), option_keys, 4, "gdk_pixbuf_savev", "char**");
+ Xen_check_type(Xen_is_char__(option_values), option_values, 5, "gdk_pixbuf_savev", "char**");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_pixbuf_savev(XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_char_(filename), XEN_TO_C_char_(type),
- XEN_TO_C_char__(option_keys), XEN_TO_C_char__(option_values), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_pixbuf_savev(Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_char_(filename), Xen_to_C_char_(type),
+ Xen_to_C_char__(option_keys), Xen_to_C_char__(option_values), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
}
}
-static XEN gxg_gdk_pixbuf_add_alpha(XEN pixbuf, XEN substitute_color, XEN r, XEN g, XEN b)
+static Xen gxg_gdk_pixbuf_add_alpha(Xen pixbuf, Xen substitute_color, Xen r, Xen g, Xen b)
{
#define H_gdk_pixbuf_add_alpha "GdkPixbuf* gdk_pixbuf_add_alpha(GdkPixbuf* pixbuf, gboolean substitute_color, \
guchar r, guchar g, guchar b)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_add_alpha", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(substitute_color), substitute_color, 2, "gdk_pixbuf_add_alpha", "gboolean");
- XEN_ASSERT_TYPE(XEN_guchar_P(r), r, 3, "gdk_pixbuf_add_alpha", "guchar");
- XEN_ASSERT_TYPE(XEN_guchar_P(g), g, 4, "gdk_pixbuf_add_alpha", "guchar");
- XEN_ASSERT_TYPE(XEN_guchar_P(b), b, 5, "gdk_pixbuf_add_alpha", "guchar");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_add_alpha(XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_gboolean(substitute_color), XEN_TO_C_guchar(r),
- XEN_TO_C_guchar(g), XEN_TO_C_guchar(b))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_add_alpha", "GdkPixbuf*");
+ Xen_check_type(Xen_is_gboolean(substitute_color), substitute_color, 2, "gdk_pixbuf_add_alpha", "gboolean");
+ Xen_check_type(Xen_is_guchar(r), r, 3, "gdk_pixbuf_add_alpha", "guchar");
+ Xen_check_type(Xen_is_guchar(g), g, 4, "gdk_pixbuf_add_alpha", "guchar");
+ Xen_check_type(Xen_is_guchar(b), b, 5, "gdk_pixbuf_add_alpha", "guchar");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_add_alpha(Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_gboolean(substitute_color), Xen_to_C_guchar(r),
+ Xen_to_C_guchar(g), Xen_to_C_guchar(b))));
}
-static XEN gxg_gdk_pixbuf_copy_area(XEN src_pixbuf, XEN src_x, XEN src_y, XEN width, XEN height, XEN dest_pixbuf, XEN dest_x, XEN dest_y)
+static Xen gxg_gdk_pixbuf_copy_area(Xen arglist)
{
#define H_gdk_pixbuf_copy_area "void gdk_pixbuf_copy_area(GdkPixbuf* src_pixbuf, int src_x, int src_y, \
int width, int height, GdkPixbuf* dest_pixbuf, int dest_x, int dest_y)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(src_pixbuf), src_pixbuf, 1, "gdk_pixbuf_copy_area", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(src_x), src_x, 2, "gdk_pixbuf_copy_area", "int");
- XEN_ASSERT_TYPE(XEN_int_P(src_y), src_y, 3, "gdk_pixbuf_copy_area", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 4, "gdk_pixbuf_copy_area", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 5, "gdk_pixbuf_copy_area", "int");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(dest_pixbuf), dest_pixbuf, 6, "gdk_pixbuf_copy_area", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(dest_x), dest_x, 7, "gdk_pixbuf_copy_area", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_y), dest_y, 8, "gdk_pixbuf_copy_area", "int");
- gdk_pixbuf_copy_area(XEN_TO_C_GdkPixbuf_(src_pixbuf), XEN_TO_C_int(src_x), XEN_TO_C_int(src_y), XEN_TO_C_int(width), XEN_TO_C_int(height),
- XEN_TO_C_GdkPixbuf_(dest_pixbuf), XEN_TO_C_int(dest_x), XEN_TO_C_int(dest_y));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_pixbuf_saturate_and_pixelate(XEN src, XEN dest, XEN saturation, XEN pixelate)
+ Xen src_pixbuf, src_x, src_y, width, height, dest_pixbuf, dest_x, dest_y;
+ src_pixbuf = Xen_list_ref(arglist, 0);
+ src_x = Xen_list_ref(arglist, 1);
+ src_y = Xen_list_ref(arglist, 2);
+ width = Xen_list_ref(arglist, 3);
+ height = Xen_list_ref(arglist, 4);
+ dest_pixbuf = Xen_list_ref(arglist, 5);
+ dest_x = Xen_list_ref(arglist, 6);
+ dest_y = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_GdkPixbuf_(src_pixbuf), src_pixbuf, 1, "gdk_pixbuf_copy_area", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(src_x), src_x, 2, "gdk_pixbuf_copy_area", "int");
+ Xen_check_type(Xen_is_int(src_y), src_y, 3, "gdk_pixbuf_copy_area", "int");
+ Xen_check_type(Xen_is_int(width), width, 4, "gdk_pixbuf_copy_area", "int");
+ Xen_check_type(Xen_is_int(height), height, 5, "gdk_pixbuf_copy_area", "int");
+ Xen_check_type(Xen_is_GdkPixbuf_(dest_pixbuf), dest_pixbuf, 6, "gdk_pixbuf_copy_area", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(dest_x), dest_x, 7, "gdk_pixbuf_copy_area", "int");
+ Xen_check_type(Xen_is_int(dest_y), dest_y, 8, "gdk_pixbuf_copy_area", "int");
+ gdk_pixbuf_copy_area(Xen_to_C_GdkPixbuf_(src_pixbuf), Xen_to_C_int(src_x), Xen_to_C_int(src_y), Xen_to_C_int(width), Xen_to_C_int(height),
+ Xen_to_C_GdkPixbuf_(dest_pixbuf), Xen_to_C_int(dest_x), Xen_to_C_int(dest_y));
+ return(Xen_false);
+}
+
+static Xen gxg_gdk_pixbuf_saturate_and_pixelate(Xen src, Xen dest, Xen saturation, Xen pixelate)
{
#define H_gdk_pixbuf_saturate_and_pixelate "void gdk_pixbuf_saturate_and_pixelate(GdkPixbuf* src, GdkPixbuf* dest, \
gfloat saturation, gboolean pixelate)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(src), src, 1, "gdk_pixbuf_saturate_and_pixelate", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(dest), dest, 2, "gdk_pixbuf_saturate_and_pixelate", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(saturation), saturation, 3, "gdk_pixbuf_saturate_and_pixelate", "gfloat");
- XEN_ASSERT_TYPE(XEN_gboolean_P(pixelate), pixelate, 4, "gdk_pixbuf_saturate_and_pixelate", "gboolean");
- gdk_pixbuf_saturate_and_pixelate(XEN_TO_C_GdkPixbuf_(src), XEN_TO_C_GdkPixbuf_(dest), XEN_TO_C_gfloat(saturation), XEN_TO_C_gboolean(pixelate));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkPixbuf_(src), src, 1, "gdk_pixbuf_saturate_and_pixelate", "GdkPixbuf*");
+ Xen_check_type(Xen_is_GdkPixbuf_(dest), dest, 2, "gdk_pixbuf_saturate_and_pixelate", "GdkPixbuf*");
+ Xen_check_type(Xen_is_gfloat(saturation), saturation, 3, "gdk_pixbuf_saturate_and_pixelate", "gfloat");
+ Xen_check_type(Xen_is_gboolean(pixelate), pixelate, 4, "gdk_pixbuf_saturate_and_pixelate", "gboolean");
+ gdk_pixbuf_saturate_and_pixelate(Xen_to_C_GdkPixbuf_(src), Xen_to_C_GdkPixbuf_(dest), Xen_to_C_gfloat(saturation), Xen_to_C_gboolean(pixelate));
+ return(Xen_false);
}
-static XEN gxg_gdk_pixbuf_scale(XEN arglist)
+static Xen gxg_gdk_pixbuf_scale(Xen arglist)
{
#define H_gdk_pixbuf_scale "void gdk_pixbuf_scale(GdkPixbuf* src, GdkPixbuf* dest, int dest_x, int dest_y, \
int dest_width, int dest_height, double offset_x, double offset_y, double scale_x, double scale_y, GdkInterpType interp_type)"
- XEN src, dest, dest_x, dest_y, dest_width, dest_height, offset_x, offset_y, scale_x, scale_y, interp_type;
- src = XEN_LIST_REF(arglist, 0);
- dest = XEN_LIST_REF(arglist, 1);
- dest_x = XEN_LIST_REF(arglist, 2);
- dest_y = XEN_LIST_REF(arglist, 3);
- dest_width = XEN_LIST_REF(arglist, 4);
- dest_height = XEN_LIST_REF(arglist, 5);
- offset_x = XEN_LIST_REF(arglist, 6);
- offset_y = XEN_LIST_REF(arglist, 7);
- scale_x = XEN_LIST_REF(arglist, 8);
- scale_y = XEN_LIST_REF(arglist, 9);
- interp_type = XEN_LIST_REF(arglist, 10);
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(src), src, 1, "gdk_pixbuf_scale", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(dest), dest, 2, "gdk_pixbuf_scale", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(dest_x), dest_x, 3, "gdk_pixbuf_scale", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_y), dest_y, 4, "gdk_pixbuf_scale", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_width), dest_width, 5, "gdk_pixbuf_scale", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_height), dest_height, 6, "gdk_pixbuf_scale", "int");
- XEN_ASSERT_TYPE(XEN_double_P(offset_x), offset_x, 7, "gdk_pixbuf_scale", "double");
- XEN_ASSERT_TYPE(XEN_double_P(offset_y), offset_y, 8, "gdk_pixbuf_scale", "double");
- XEN_ASSERT_TYPE(XEN_double_P(scale_x), scale_x, 9, "gdk_pixbuf_scale", "double");
- XEN_ASSERT_TYPE(XEN_double_P(scale_y), scale_y, 10, "gdk_pixbuf_scale", "double");
- XEN_ASSERT_TYPE(XEN_GdkInterpType_P(interp_type), interp_type, 11, "gdk_pixbuf_scale", "GdkInterpType");
- gdk_pixbuf_scale(XEN_TO_C_GdkPixbuf_(src), XEN_TO_C_GdkPixbuf_(dest), XEN_TO_C_int(dest_x), XEN_TO_C_int(dest_y), XEN_TO_C_int(dest_width),
- XEN_TO_C_int(dest_height), XEN_TO_C_double(offset_x), XEN_TO_C_double(offset_y), XEN_TO_C_double(scale_x),
- XEN_TO_C_double(scale_y), XEN_TO_C_GdkInterpType(interp_type));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_pixbuf_composite(XEN arglist)
+ Xen src, dest, dest_x, dest_y, dest_width, dest_height, offset_x, offset_y, scale_x, scale_y, interp_type;
+ src = Xen_list_ref(arglist, 0);
+ dest = Xen_list_ref(arglist, 1);
+ dest_x = Xen_list_ref(arglist, 2);
+ dest_y = Xen_list_ref(arglist, 3);
+ dest_width = Xen_list_ref(arglist, 4);
+ dest_height = Xen_list_ref(arglist, 5);
+ offset_x = Xen_list_ref(arglist, 6);
+ offset_y = Xen_list_ref(arglist, 7);
+ scale_x = Xen_list_ref(arglist, 8);
+ scale_y = Xen_list_ref(arglist, 9);
+ interp_type = Xen_list_ref(arglist, 10);
+ Xen_check_type(Xen_is_GdkPixbuf_(src), src, 1, "gdk_pixbuf_scale", "GdkPixbuf*");
+ Xen_check_type(Xen_is_GdkPixbuf_(dest), dest, 2, "gdk_pixbuf_scale", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(dest_x), dest_x, 3, "gdk_pixbuf_scale", "int");
+ Xen_check_type(Xen_is_int(dest_y), dest_y, 4, "gdk_pixbuf_scale", "int");
+ Xen_check_type(Xen_is_int(dest_width), dest_width, 5, "gdk_pixbuf_scale", "int");
+ Xen_check_type(Xen_is_int(dest_height), dest_height, 6, "gdk_pixbuf_scale", "int");
+ Xen_check_type(Xen_is_double(offset_x), offset_x, 7, "gdk_pixbuf_scale", "double");
+ Xen_check_type(Xen_is_double(offset_y), offset_y, 8, "gdk_pixbuf_scale", "double");
+ Xen_check_type(Xen_is_double(scale_x), scale_x, 9, "gdk_pixbuf_scale", "double");
+ Xen_check_type(Xen_is_double(scale_y), scale_y, 10, "gdk_pixbuf_scale", "double");
+ Xen_check_type(Xen_is_GdkInterpType(interp_type), interp_type, 11, "gdk_pixbuf_scale", "GdkInterpType");
+ gdk_pixbuf_scale(Xen_to_C_GdkPixbuf_(src), Xen_to_C_GdkPixbuf_(dest), Xen_to_C_int(dest_x), Xen_to_C_int(dest_y), Xen_to_C_int(dest_width),
+ Xen_to_C_int(dest_height), Xen_to_C_double(offset_x), Xen_to_C_double(offset_y), Xen_to_C_double(scale_x),
+ Xen_to_C_double(scale_y), Xen_to_C_GdkInterpType(interp_type));
+ return(Xen_false);
+}
+
+static Xen gxg_gdk_pixbuf_composite(Xen arglist)
{
#define H_gdk_pixbuf_composite "void gdk_pixbuf_composite(GdkPixbuf* src, GdkPixbuf* dest, int dest_x, \
int dest_y, int dest_width, int dest_height, double offset_x, double offset_y, double scale_x, double scale_y, \
GdkInterpType interp_type, int overall_alpha)"
- XEN src, dest, dest_x, dest_y, dest_width, dest_height, offset_x, offset_y, scale_x, scale_y, interp_type, overall_alpha;
- src = XEN_LIST_REF(arglist, 0);
- dest = XEN_LIST_REF(arglist, 1);
- dest_x = XEN_LIST_REF(arglist, 2);
- dest_y = XEN_LIST_REF(arglist, 3);
- dest_width = XEN_LIST_REF(arglist, 4);
- dest_height = XEN_LIST_REF(arglist, 5);
- offset_x = XEN_LIST_REF(arglist, 6);
- offset_y = XEN_LIST_REF(arglist, 7);
- scale_x = XEN_LIST_REF(arglist, 8);
- scale_y = XEN_LIST_REF(arglist, 9);
- interp_type = XEN_LIST_REF(arglist, 10);
- overall_alpha = XEN_LIST_REF(arglist, 11);
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(src), src, 1, "gdk_pixbuf_composite", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(dest), dest, 2, "gdk_pixbuf_composite", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(dest_x), dest_x, 3, "gdk_pixbuf_composite", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_y), dest_y, 4, "gdk_pixbuf_composite", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_width), dest_width, 5, "gdk_pixbuf_composite", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_height), dest_height, 6, "gdk_pixbuf_composite", "int");
- XEN_ASSERT_TYPE(XEN_double_P(offset_x), offset_x, 7, "gdk_pixbuf_composite", "double");
- XEN_ASSERT_TYPE(XEN_double_P(offset_y), offset_y, 8, "gdk_pixbuf_composite", "double");
- XEN_ASSERT_TYPE(XEN_double_P(scale_x), scale_x, 9, "gdk_pixbuf_composite", "double");
- XEN_ASSERT_TYPE(XEN_double_P(scale_y), scale_y, 10, "gdk_pixbuf_composite", "double");
- XEN_ASSERT_TYPE(XEN_GdkInterpType_P(interp_type), interp_type, 11, "gdk_pixbuf_composite", "GdkInterpType");
- XEN_ASSERT_TYPE(XEN_int_P(overall_alpha), overall_alpha, 12, "gdk_pixbuf_composite", "int");
- gdk_pixbuf_composite(XEN_TO_C_GdkPixbuf_(src), XEN_TO_C_GdkPixbuf_(dest), XEN_TO_C_int(dest_x), XEN_TO_C_int(dest_y), XEN_TO_C_int(dest_width),
- XEN_TO_C_int(dest_height), XEN_TO_C_double(offset_x), XEN_TO_C_double(offset_y), XEN_TO_C_double(scale_x),
- XEN_TO_C_double(scale_y), XEN_TO_C_GdkInterpType(interp_type), XEN_TO_C_int(overall_alpha));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_pixbuf_composite_color(XEN arglist)
+ Xen src, dest, dest_x, dest_y, dest_width, dest_height, offset_x, offset_y, scale_x, scale_y, interp_type, overall_alpha;
+ src = Xen_list_ref(arglist, 0);
+ dest = Xen_list_ref(arglist, 1);
+ dest_x = Xen_list_ref(arglist, 2);
+ dest_y = Xen_list_ref(arglist, 3);
+ dest_width = Xen_list_ref(arglist, 4);
+ dest_height = Xen_list_ref(arglist, 5);
+ offset_x = Xen_list_ref(arglist, 6);
+ offset_y = Xen_list_ref(arglist, 7);
+ scale_x = Xen_list_ref(arglist, 8);
+ scale_y = Xen_list_ref(arglist, 9);
+ interp_type = Xen_list_ref(arglist, 10);
+ overall_alpha = Xen_list_ref(arglist, 11);
+ Xen_check_type(Xen_is_GdkPixbuf_(src), src, 1, "gdk_pixbuf_composite", "GdkPixbuf*");
+ Xen_check_type(Xen_is_GdkPixbuf_(dest), dest, 2, "gdk_pixbuf_composite", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(dest_x), dest_x, 3, "gdk_pixbuf_composite", "int");
+ Xen_check_type(Xen_is_int(dest_y), dest_y, 4, "gdk_pixbuf_composite", "int");
+ Xen_check_type(Xen_is_int(dest_width), dest_width, 5, "gdk_pixbuf_composite", "int");
+ Xen_check_type(Xen_is_int(dest_height), dest_height, 6, "gdk_pixbuf_composite", "int");
+ Xen_check_type(Xen_is_double(offset_x), offset_x, 7, "gdk_pixbuf_composite", "double");
+ Xen_check_type(Xen_is_double(offset_y), offset_y, 8, "gdk_pixbuf_composite", "double");
+ Xen_check_type(Xen_is_double(scale_x), scale_x, 9, "gdk_pixbuf_composite", "double");
+ Xen_check_type(Xen_is_double(scale_y), scale_y, 10, "gdk_pixbuf_composite", "double");
+ Xen_check_type(Xen_is_GdkInterpType(interp_type), interp_type, 11, "gdk_pixbuf_composite", "GdkInterpType");
+ Xen_check_type(Xen_is_int(overall_alpha), overall_alpha, 12, "gdk_pixbuf_composite", "int");
+ gdk_pixbuf_composite(Xen_to_C_GdkPixbuf_(src), Xen_to_C_GdkPixbuf_(dest), Xen_to_C_int(dest_x), Xen_to_C_int(dest_y), Xen_to_C_int(dest_width),
+ Xen_to_C_int(dest_height), Xen_to_C_double(offset_x), Xen_to_C_double(offset_y), Xen_to_C_double(scale_x),
+ Xen_to_C_double(scale_y), Xen_to_C_GdkInterpType(interp_type), Xen_to_C_int(overall_alpha));
+ return(Xen_false);
+}
+
+static Xen gxg_gdk_pixbuf_composite_color(Xen arglist)
{
#define H_gdk_pixbuf_composite_color "void gdk_pixbuf_composite_color(GdkPixbuf* src, GdkPixbuf* dest, \
int dest_x, int dest_y, int dest_width, int dest_height, double offset_x, double offset_y, double scale_x, \
double scale_y, GdkInterpType interp_type, int overall_alpha, int check_x, int check_y, int check_size, \
guint32 color1, guint32 color2)"
- XEN src, dest, dest_x, dest_y, dest_width, dest_height, offset_x, offset_y, scale_x, scale_y, interp_type, overall_alpha, check_x, check_y, check_size, color1, color2;
- src = XEN_LIST_REF(arglist, 0);
- dest = XEN_LIST_REF(arglist, 1);
- dest_x = XEN_LIST_REF(arglist, 2);
- dest_y = XEN_LIST_REF(arglist, 3);
- dest_width = XEN_LIST_REF(arglist, 4);
- dest_height = XEN_LIST_REF(arglist, 5);
- offset_x = XEN_LIST_REF(arglist, 6);
- offset_y = XEN_LIST_REF(arglist, 7);
- scale_x = XEN_LIST_REF(arglist, 8);
- scale_y = XEN_LIST_REF(arglist, 9);
- interp_type = XEN_LIST_REF(arglist, 10);
- overall_alpha = XEN_LIST_REF(arglist, 11);
- check_x = XEN_LIST_REF(arglist, 12);
- check_y = XEN_LIST_REF(arglist, 13);
- check_size = XEN_LIST_REF(arglist, 14);
- color1 = XEN_LIST_REF(arglist, 15);
- color2 = XEN_LIST_REF(arglist, 16);
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(src), src, 1, "gdk_pixbuf_composite_color", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(dest), dest, 2, "gdk_pixbuf_composite_color", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(dest_x), dest_x, 3, "gdk_pixbuf_composite_color", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_y), dest_y, 4, "gdk_pixbuf_composite_color", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_width), dest_width, 5, "gdk_pixbuf_composite_color", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_height), dest_height, 6, "gdk_pixbuf_composite_color", "int");
- XEN_ASSERT_TYPE(XEN_double_P(offset_x), offset_x, 7, "gdk_pixbuf_composite_color", "double");
- XEN_ASSERT_TYPE(XEN_double_P(offset_y), offset_y, 8, "gdk_pixbuf_composite_color", "double");
- XEN_ASSERT_TYPE(XEN_double_P(scale_x), scale_x, 9, "gdk_pixbuf_composite_color", "double");
- XEN_ASSERT_TYPE(XEN_double_P(scale_y), scale_y, 10, "gdk_pixbuf_composite_color", "double");
- XEN_ASSERT_TYPE(XEN_GdkInterpType_P(interp_type), interp_type, 11, "gdk_pixbuf_composite_color", "GdkInterpType");
- XEN_ASSERT_TYPE(XEN_int_P(overall_alpha), overall_alpha, 12, "gdk_pixbuf_composite_color", "int");
- XEN_ASSERT_TYPE(XEN_int_P(check_x), check_x, 13, "gdk_pixbuf_composite_color", "int");
- XEN_ASSERT_TYPE(XEN_int_P(check_y), check_y, 14, "gdk_pixbuf_composite_color", "int");
- XEN_ASSERT_TYPE(XEN_int_P(check_size), check_size, 15, "gdk_pixbuf_composite_color", "int");
- XEN_ASSERT_TYPE(XEN_guint32_P(color1), color1, 16, "gdk_pixbuf_composite_color", "guint32");
- XEN_ASSERT_TYPE(XEN_guint32_P(color2), color2, 17, "gdk_pixbuf_composite_color", "guint32");
- gdk_pixbuf_composite_color(XEN_TO_C_GdkPixbuf_(src), XEN_TO_C_GdkPixbuf_(dest), XEN_TO_C_int(dest_x), XEN_TO_C_int(dest_y),
- XEN_TO_C_int(dest_width), XEN_TO_C_int(dest_height), XEN_TO_C_double(offset_x), XEN_TO_C_double(offset_y),
- XEN_TO_C_double(scale_x), XEN_TO_C_double(scale_y), XEN_TO_C_GdkInterpType(interp_type), XEN_TO_C_int(overall_alpha),
- XEN_TO_C_int(check_x), XEN_TO_C_int(check_y), XEN_TO_C_int(check_size), XEN_TO_C_guint32(color1),
- XEN_TO_C_guint32(color2));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gdk_pixbuf_scale_simple(XEN src, XEN dest_width, XEN dest_height, XEN interp_type)
+ Xen src, dest, dest_x, dest_y, dest_width, dest_height, offset_x, offset_y, scale_x, scale_y, interp_type, overall_alpha, check_x, check_y, check_size, color1, color2;
+ src = Xen_list_ref(arglist, 0);
+ dest = Xen_list_ref(arglist, 1);
+ dest_x = Xen_list_ref(arglist, 2);
+ dest_y = Xen_list_ref(arglist, 3);
+ dest_width = Xen_list_ref(arglist, 4);
+ dest_height = Xen_list_ref(arglist, 5);
+ offset_x = Xen_list_ref(arglist, 6);
+ offset_y = Xen_list_ref(arglist, 7);
+ scale_x = Xen_list_ref(arglist, 8);
+ scale_y = Xen_list_ref(arglist, 9);
+ interp_type = Xen_list_ref(arglist, 10);
+ overall_alpha = Xen_list_ref(arglist, 11);
+ check_x = Xen_list_ref(arglist, 12);
+ check_y = Xen_list_ref(arglist, 13);
+ check_size = Xen_list_ref(arglist, 14);
+ color1 = Xen_list_ref(arglist, 15);
+ color2 = Xen_list_ref(arglist, 16);
+ Xen_check_type(Xen_is_GdkPixbuf_(src), src, 1, "gdk_pixbuf_composite_color", "GdkPixbuf*");
+ Xen_check_type(Xen_is_GdkPixbuf_(dest), dest, 2, "gdk_pixbuf_composite_color", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(dest_x), dest_x, 3, "gdk_pixbuf_composite_color", "int");
+ Xen_check_type(Xen_is_int(dest_y), dest_y, 4, "gdk_pixbuf_composite_color", "int");
+ Xen_check_type(Xen_is_int(dest_width), dest_width, 5, "gdk_pixbuf_composite_color", "int");
+ Xen_check_type(Xen_is_int(dest_height), dest_height, 6, "gdk_pixbuf_composite_color", "int");
+ Xen_check_type(Xen_is_double(offset_x), offset_x, 7, "gdk_pixbuf_composite_color", "double");
+ Xen_check_type(Xen_is_double(offset_y), offset_y, 8, "gdk_pixbuf_composite_color", "double");
+ Xen_check_type(Xen_is_double(scale_x), scale_x, 9, "gdk_pixbuf_composite_color", "double");
+ Xen_check_type(Xen_is_double(scale_y), scale_y, 10, "gdk_pixbuf_composite_color", "double");
+ Xen_check_type(Xen_is_GdkInterpType(interp_type), interp_type, 11, "gdk_pixbuf_composite_color", "GdkInterpType");
+ Xen_check_type(Xen_is_int(overall_alpha), overall_alpha, 12, "gdk_pixbuf_composite_color", "int");
+ Xen_check_type(Xen_is_int(check_x), check_x, 13, "gdk_pixbuf_composite_color", "int");
+ Xen_check_type(Xen_is_int(check_y), check_y, 14, "gdk_pixbuf_composite_color", "int");
+ Xen_check_type(Xen_is_int(check_size), check_size, 15, "gdk_pixbuf_composite_color", "int");
+ Xen_check_type(Xen_is_guint32(color1), color1, 16, "gdk_pixbuf_composite_color", "guint32");
+ Xen_check_type(Xen_is_guint32(color2), color2, 17, "gdk_pixbuf_composite_color", "guint32");
+ gdk_pixbuf_composite_color(Xen_to_C_GdkPixbuf_(src), Xen_to_C_GdkPixbuf_(dest), Xen_to_C_int(dest_x), Xen_to_C_int(dest_y),
+ Xen_to_C_int(dest_width), Xen_to_C_int(dest_height), Xen_to_C_double(offset_x), Xen_to_C_double(offset_y),
+ Xen_to_C_double(scale_x), Xen_to_C_double(scale_y), Xen_to_C_GdkInterpType(interp_type), Xen_to_C_int(overall_alpha),
+ Xen_to_C_int(check_x), Xen_to_C_int(check_y), Xen_to_C_int(check_size), Xen_to_C_guint32(color1),
+ Xen_to_C_guint32(color2));
+ return(Xen_false);
+}
+
+static Xen gxg_gdk_pixbuf_scale_simple(Xen src, Xen dest_width, Xen dest_height, Xen interp_type)
{
#define H_gdk_pixbuf_scale_simple "GdkPixbuf* gdk_pixbuf_scale_simple(GdkPixbuf* src, int dest_width, \
int dest_height, GdkInterpType interp_type)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(src), src, 1, "gdk_pixbuf_scale_simple", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(dest_width), dest_width, 2, "gdk_pixbuf_scale_simple", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_height), dest_height, 3, "gdk_pixbuf_scale_simple", "int");
- XEN_ASSERT_TYPE(XEN_GdkInterpType_P(interp_type), interp_type, 4, "gdk_pixbuf_scale_simple", "GdkInterpType");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_scale_simple(XEN_TO_C_GdkPixbuf_(src), XEN_TO_C_int(dest_width), XEN_TO_C_int(dest_height),
- XEN_TO_C_GdkInterpType(interp_type))));
+ Xen_check_type(Xen_is_GdkPixbuf_(src), src, 1, "gdk_pixbuf_scale_simple", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(dest_width), dest_width, 2, "gdk_pixbuf_scale_simple", "int");
+ Xen_check_type(Xen_is_int(dest_height), dest_height, 3, "gdk_pixbuf_scale_simple", "int");
+ Xen_check_type(Xen_is_GdkInterpType(interp_type), interp_type, 4, "gdk_pixbuf_scale_simple", "GdkInterpType");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_scale_simple(Xen_to_C_GdkPixbuf_(src), Xen_to_C_int(dest_width), Xen_to_C_int(dest_height),
+ Xen_to_C_GdkInterpType(interp_type))));
}
-static XEN gxg_gdk_pixbuf_composite_color_simple(XEN src, XEN dest_width, XEN dest_height, XEN interp_type, XEN overall_alpha, XEN check_size, XEN color1, XEN color2)
+static Xen gxg_gdk_pixbuf_composite_color_simple(Xen arglist)
{
#define H_gdk_pixbuf_composite_color_simple "GdkPixbuf* gdk_pixbuf_composite_color_simple(GdkPixbuf* src, \
int dest_width, int dest_height, GdkInterpType interp_type, int overall_alpha, int check_size, guint32 color1, \
guint32 color2)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(src), src, 1, "gdk_pixbuf_composite_color_simple", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(dest_width), dest_width, 2, "gdk_pixbuf_composite_color_simple", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_height), dest_height, 3, "gdk_pixbuf_composite_color_simple", "int");
- XEN_ASSERT_TYPE(XEN_GdkInterpType_P(interp_type), interp_type, 4, "gdk_pixbuf_composite_color_simple", "GdkInterpType");
- XEN_ASSERT_TYPE(XEN_int_P(overall_alpha), overall_alpha, 5, "gdk_pixbuf_composite_color_simple", "int");
- XEN_ASSERT_TYPE(XEN_int_P(check_size), check_size, 6, "gdk_pixbuf_composite_color_simple", "int");
- XEN_ASSERT_TYPE(XEN_guint32_P(color1), color1, 7, "gdk_pixbuf_composite_color_simple", "guint32");
- XEN_ASSERT_TYPE(XEN_guint32_P(color2), color2, 8, "gdk_pixbuf_composite_color_simple", "guint32");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_composite_color_simple(XEN_TO_C_GdkPixbuf_(src), XEN_TO_C_int(dest_width), XEN_TO_C_int(dest_height),
- XEN_TO_C_GdkInterpType(interp_type), XEN_TO_C_int(overall_alpha),
- XEN_TO_C_int(check_size), XEN_TO_C_guint32(color1), XEN_TO_C_guint32(color2))));
-}
-
-static XEN gxg_gdk_pixbuf_animation_new_from_file(XEN filename, XEN ignore_error)
+ Xen src, dest_width, dest_height, interp_type, overall_alpha, check_size, color1, color2;
+ src = Xen_list_ref(arglist, 0);
+ dest_width = Xen_list_ref(arglist, 1);
+ dest_height = Xen_list_ref(arglist, 2);
+ interp_type = Xen_list_ref(arglist, 3);
+ overall_alpha = Xen_list_ref(arglist, 4);
+ check_size = Xen_list_ref(arglist, 5);
+ color1 = Xen_list_ref(arglist, 6);
+ color2 = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_GdkPixbuf_(src), src, 1, "gdk_pixbuf_composite_color_simple", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(dest_width), dest_width, 2, "gdk_pixbuf_composite_color_simple", "int");
+ Xen_check_type(Xen_is_int(dest_height), dest_height, 3, "gdk_pixbuf_composite_color_simple", "int");
+ Xen_check_type(Xen_is_GdkInterpType(interp_type), interp_type, 4, "gdk_pixbuf_composite_color_simple", "GdkInterpType");
+ Xen_check_type(Xen_is_int(overall_alpha), overall_alpha, 5, "gdk_pixbuf_composite_color_simple", "int");
+ Xen_check_type(Xen_is_int(check_size), check_size, 6, "gdk_pixbuf_composite_color_simple", "int");
+ Xen_check_type(Xen_is_guint32(color1), color1, 7, "gdk_pixbuf_composite_color_simple", "guint32");
+ Xen_check_type(Xen_is_guint32(color2), color2, 8, "gdk_pixbuf_composite_color_simple", "guint32");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_composite_color_simple(Xen_to_C_GdkPixbuf_(src), Xen_to_C_int(dest_width), Xen_to_C_int(dest_height),
+ Xen_to_C_GdkInterpType(interp_type), Xen_to_C_int(overall_alpha),
+ Xen_to_C_int(check_size), Xen_to_C_guint32(color1), Xen_to_C_guint32(color2))));
+}
+
+static Xen gxg_gdk_pixbuf_animation_new_from_file(Xen filename, Xen ignore_error)
{
#define H_gdk_pixbuf_animation_new_from_file "GdkPixbufAnimation* gdk_pixbuf_animation_new_from_file(char* filename, \
GError** [error])"
GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_char__P(filename), filename, 1, "gdk_pixbuf_animation_new_from_file", "char*");
+ Xen_check_type(Xen_is_char_(filename), filename, 1, "gdk_pixbuf_animation_new_from_file", "char*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkPixbufAnimation_(gdk_pixbuf_animation_new_from_file(XEN_TO_C_char_(filename), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
+ Xen result;
+ result = C_to_Xen_GdkPixbufAnimation_(gdk_pixbuf_animation_new_from_file(Xen_to_C_char_(filename), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
}
}
-static XEN gxg_gdk_pixbuf_animation_get_width(XEN animation)
+static Xen gxg_gdk_pixbuf_animation_get_width(Xen animation)
{
#define H_gdk_pixbuf_animation_get_width "int gdk_pixbuf_animation_get_width(GdkPixbufAnimation* animation)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimation__P(animation), animation, 1, "gdk_pixbuf_animation_get_width", "GdkPixbufAnimation*");
- return(C_TO_XEN_int(gdk_pixbuf_animation_get_width(XEN_TO_C_GdkPixbufAnimation_(animation))));
+ Xen_check_type(Xen_is_GdkPixbufAnimation_(animation), animation, 1, "gdk_pixbuf_animation_get_width", "GdkPixbufAnimation*");
+ return(C_to_Xen_int(gdk_pixbuf_animation_get_width(Xen_to_C_GdkPixbufAnimation_(animation))));
}
-static XEN gxg_gdk_pixbuf_animation_get_height(XEN animation)
+static Xen gxg_gdk_pixbuf_animation_get_height(Xen animation)
{
#define H_gdk_pixbuf_animation_get_height "int gdk_pixbuf_animation_get_height(GdkPixbufAnimation* animation)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimation__P(animation), animation, 1, "gdk_pixbuf_animation_get_height", "GdkPixbufAnimation*");
- return(C_TO_XEN_int(gdk_pixbuf_animation_get_height(XEN_TO_C_GdkPixbufAnimation_(animation))));
+ Xen_check_type(Xen_is_GdkPixbufAnimation_(animation), animation, 1, "gdk_pixbuf_animation_get_height", "GdkPixbufAnimation*");
+ return(C_to_Xen_int(gdk_pixbuf_animation_get_height(Xen_to_C_GdkPixbufAnimation_(animation))));
}
-static XEN gxg_gdk_pixbuf_animation_is_static_image(XEN animation)
+static Xen gxg_gdk_pixbuf_animation_is_static_image(Xen animation)
{
#define H_gdk_pixbuf_animation_is_static_image "gboolean gdk_pixbuf_animation_is_static_image(GdkPixbufAnimation* animation)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimation__P(animation), animation, 1, "gdk_pixbuf_animation_is_static_image", "GdkPixbufAnimation*");
- return(C_TO_XEN_gboolean(gdk_pixbuf_animation_is_static_image(XEN_TO_C_GdkPixbufAnimation_(animation))));
+ Xen_check_type(Xen_is_GdkPixbufAnimation_(animation), animation, 1, "gdk_pixbuf_animation_is_static_image", "GdkPixbufAnimation*");
+ return(C_to_Xen_gboolean(gdk_pixbuf_animation_is_static_image(Xen_to_C_GdkPixbufAnimation_(animation))));
}
-static XEN gxg_gdk_pixbuf_animation_get_static_image(XEN animation)
+static Xen gxg_gdk_pixbuf_animation_get_static_image(Xen animation)
{
#define H_gdk_pixbuf_animation_get_static_image "GdkPixbuf* gdk_pixbuf_animation_get_static_image(GdkPixbufAnimation* animation)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimation__P(animation), animation, 1, "gdk_pixbuf_animation_get_static_image", "GdkPixbufAnimation*");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_animation_get_static_image(XEN_TO_C_GdkPixbufAnimation_(animation))));
+ Xen_check_type(Xen_is_GdkPixbufAnimation_(animation), animation, 1, "gdk_pixbuf_animation_get_static_image", "GdkPixbufAnimation*");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_animation_get_static_image(Xen_to_C_GdkPixbufAnimation_(animation))));
}
-static XEN gxg_gdk_pixbuf_animation_get_iter(XEN animation, XEN start_time)
+static Xen gxg_gdk_pixbuf_animation_get_iter(Xen animation, Xen start_time)
{
#define H_gdk_pixbuf_animation_get_iter "GdkPixbufAnimationIter* gdk_pixbuf_animation_get_iter(GdkPixbufAnimation* animation, \
GTimeVal* start_time)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimation__P(animation), animation, 1, "gdk_pixbuf_animation_get_iter", "GdkPixbufAnimation*");
- XEN_ASSERT_TYPE(XEN_GTimeVal__P(start_time), start_time, 2, "gdk_pixbuf_animation_get_iter", "GTimeVal*");
- return(C_TO_XEN_GdkPixbufAnimationIter_(gdk_pixbuf_animation_get_iter(XEN_TO_C_GdkPixbufAnimation_(animation), XEN_TO_C_GTimeVal_(start_time))));
+ Xen_check_type(Xen_is_GdkPixbufAnimation_(animation), animation, 1, "gdk_pixbuf_animation_get_iter", "GdkPixbufAnimation*");
+ Xen_check_type(Xen_is_GTimeVal_(start_time), start_time, 2, "gdk_pixbuf_animation_get_iter", "GTimeVal*");
+ return(C_to_Xen_GdkPixbufAnimationIter_(gdk_pixbuf_animation_get_iter(Xen_to_C_GdkPixbufAnimation_(animation), Xen_to_C_GTimeVal_(start_time))));
}
-static XEN gxg_gdk_pixbuf_animation_iter_get_delay_time(XEN iter)
+static Xen gxg_gdk_pixbuf_animation_iter_get_delay_time(Xen iter)
{
#define H_gdk_pixbuf_animation_iter_get_delay_time "int gdk_pixbuf_animation_iter_get_delay_time(GdkPixbufAnimationIter* iter)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimationIter__P(iter), iter, 1, "gdk_pixbuf_animation_iter_get_delay_time", "GdkPixbufAnimationIter*");
- return(C_TO_XEN_int(gdk_pixbuf_animation_iter_get_delay_time(XEN_TO_C_GdkPixbufAnimationIter_(iter))));
+ Xen_check_type(Xen_is_GdkPixbufAnimationIter_(iter), iter, 1, "gdk_pixbuf_animation_iter_get_delay_time", "GdkPixbufAnimationIter*");
+ return(C_to_Xen_int(gdk_pixbuf_animation_iter_get_delay_time(Xen_to_C_GdkPixbufAnimationIter_(iter))));
}
-static XEN gxg_gdk_pixbuf_animation_iter_get_pixbuf(XEN iter)
+static Xen gxg_gdk_pixbuf_animation_iter_get_pixbuf(Xen iter)
{
#define H_gdk_pixbuf_animation_iter_get_pixbuf "GdkPixbuf* gdk_pixbuf_animation_iter_get_pixbuf(GdkPixbufAnimationIter* iter)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimationIter__P(iter), iter, 1, "gdk_pixbuf_animation_iter_get_pixbuf", "GdkPixbufAnimationIter*");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_animation_iter_get_pixbuf(XEN_TO_C_GdkPixbufAnimationIter_(iter))));
+ Xen_check_type(Xen_is_GdkPixbufAnimationIter_(iter), iter, 1, "gdk_pixbuf_animation_iter_get_pixbuf", "GdkPixbufAnimationIter*");
+ return(C_to_Xen_GdkPixbuf_(gdk_pixbuf_animation_iter_get_pixbuf(Xen_to_C_GdkPixbufAnimationIter_(iter))));
}
-static XEN gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame(XEN iter)
+static Xen gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame(Xen iter)
{
#define H_gdk_pixbuf_animation_iter_on_currently_loading_frame "gboolean gdk_pixbuf_animation_iter_on_currently_loading_frame(GdkPixbufAnimationIter* iter)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimationIter__P(iter), iter, 1, "gdk_pixbuf_animation_iter_on_currently_loading_frame", "GdkPixbufAnimationIter*");
- return(C_TO_XEN_gboolean(gdk_pixbuf_animation_iter_on_currently_loading_frame(XEN_TO_C_GdkPixbufAnimationIter_(iter))));
+ Xen_check_type(Xen_is_GdkPixbufAnimationIter_(iter), iter, 1, "gdk_pixbuf_animation_iter_on_currently_loading_frame", "GdkPixbufAnimationIter*");
+ return(C_to_Xen_gboolean(gdk_pixbuf_animation_iter_on_currently_loading_frame(Xen_to_C_GdkPixbufAnimationIter_(iter))));
}
-static XEN gxg_gdk_pixbuf_animation_iter_advance(XEN iter, XEN current_time)
+static Xen gxg_gdk_pixbuf_animation_iter_advance(Xen iter, Xen current_time)
{
#define H_gdk_pixbuf_animation_iter_advance "gboolean gdk_pixbuf_animation_iter_advance(GdkPixbufAnimationIter* iter, \
GTimeVal* current_time)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimationIter__P(iter), iter, 1, "gdk_pixbuf_animation_iter_advance", "GdkPixbufAnimationIter*");
- XEN_ASSERT_TYPE(XEN_GTimeVal__P(current_time), current_time, 2, "gdk_pixbuf_animation_iter_advance", "GTimeVal*");
- return(C_TO_XEN_gboolean(gdk_pixbuf_animation_iter_advance(XEN_TO_C_GdkPixbufAnimationIter_(iter), XEN_TO_C_GTimeVal_(current_time))));
+ Xen_check_type(Xen_is_GdkPixbufAnimationIter_(iter), iter, 1, "gdk_pixbuf_animation_iter_advance", "GdkPixbufAnimationIter*");
+ Xen_check_type(Xen_is_GTimeVal_(current_time), current_time, 2, "gdk_pixbuf_animation_iter_advance", "GTimeVal*");
+ return(C_to_Xen_gboolean(gdk_pixbuf_animation_iter_advance(Xen_to_C_GdkPixbufAnimationIter_(iter), Xen_to_C_GTimeVal_(current_time))));
}
-static XEN gxg_gdk_pixbuf_get_option(XEN pixbuf, XEN key)
+static Xen gxg_gdk_pixbuf_get_option(Xen pixbuf, Xen key)
{
#define H_gdk_pixbuf_get_option "gchar* gdk_pixbuf_get_option(GdkPixbuf* pixbuf, gchar* key)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_get_option", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gdk_pixbuf_get_option", "gchar*");
- return(C_TO_XEN_gchar_(gdk_pixbuf_get_option(XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_gchar_(key))));
-}
-
-static XEN gxg_gtk_vbox_new(XEN homogeneous, XEN spacing)
-{
- #define H_gtk_vbox_new "GtkWidget* gtk_vbox_new(gboolean homogeneous, gint spacing)"
- XEN_ASSERT_TYPE(XEN_gboolean_P(homogeneous), homogeneous, 1, "gtk_vbox_new", "gboolean");
- XEN_ASSERT_TYPE(XEN_gint_P(spacing), spacing, 2, "gtk_vbox_new", "gint");
- return(C_TO_XEN_GtkWidget_(gtk_vbox_new(XEN_TO_C_gboolean(homogeneous), XEN_TO_C_gint(spacing))));
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_pixbuf_get_option", "GdkPixbuf*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gdk_pixbuf_get_option", "gchar*");
+ return(C_to_Xen_gchar_(gdk_pixbuf_get_option(Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_gchar_(key))));
}
-static XEN gxg_gtk_accel_group_new(void)
+static Xen gxg_gtk_accel_group_new(void)
{
#define H_gtk_accel_group_new "GtkAccelGroup* gtk_accel_group_new( void)"
- return(C_TO_XEN_GtkAccelGroup_(gtk_accel_group_new()));
+ return(C_to_Xen_GtkAccelGroup_(gtk_accel_group_new()));
}
-static XEN gxg_gtk_accel_group_lock(XEN accel_group)
+static Xen gxg_gtk_accel_group_lock(Xen accel_group)
{
#define H_gtk_accel_group_lock "void gtk_accel_group_lock(GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_lock", "GtkAccelGroup*");
- gtk_accel_group_lock(XEN_TO_C_GtkAccelGroup_(accel_group));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_lock", "GtkAccelGroup*");
+ gtk_accel_group_lock(Xen_to_C_GtkAccelGroup_(accel_group));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_group_unlock(XEN accel_group)
+static Xen gxg_gtk_accel_group_unlock(Xen accel_group)
{
#define H_gtk_accel_group_unlock "void gtk_accel_group_unlock(GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_unlock", "GtkAccelGroup*");
- gtk_accel_group_unlock(XEN_TO_C_GtkAccelGroup_(accel_group));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_unlock", "GtkAccelGroup*");
+ gtk_accel_group_unlock(Xen_to_C_GtkAccelGroup_(accel_group));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_group_connect(XEN accel_group, XEN accel_key, XEN accel_mods, XEN accel_flags, XEN closure)
+static Xen gxg_gtk_accel_group_connect(Xen accel_group, Xen accel_key, Xen accel_mods, Xen accel_flags, Xen closure)
{
#define H_gtk_accel_group_connect "void gtk_accel_group_connect(GtkAccelGroup* accel_group, guint accel_key, \
GdkModifierType accel_mods, GtkAccelFlags accel_flags, GClosure* closure)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_connect", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 2, "gtk_accel_group_connect", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 3, "gtk_accel_group_connect", "GdkModifierType");
- XEN_ASSERT_TYPE(XEN_GtkAccelFlags_P(accel_flags), accel_flags, 4, "gtk_accel_group_connect", "GtkAccelFlags");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 5, "gtk_accel_group_connect", "GClosure*");
- gtk_accel_group_connect(XEN_TO_C_GtkAccelGroup_(accel_group), XEN_TO_C_guint(accel_key), XEN_TO_C_GdkModifierType(accel_mods),
- XEN_TO_C_GtkAccelFlags(accel_flags), XEN_TO_C_GClosure_(closure));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_connect", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 2, "gtk_accel_group_connect", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 3, "gtk_accel_group_connect", "GdkModifierType");
+ Xen_check_type(Xen_is_GtkAccelFlags(accel_flags), accel_flags, 4, "gtk_accel_group_connect", "GtkAccelFlags");
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 5, "gtk_accel_group_connect", "GClosure*");
+ gtk_accel_group_connect(Xen_to_C_GtkAccelGroup_(accel_group), Xen_to_C_guint(accel_key), Xen_to_C_GdkModifierType(accel_mods),
+ Xen_to_C_GtkAccelFlags(accel_flags), Xen_to_C_GClosure_(closure));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_group_connect_by_path(XEN accel_group, XEN accel_path, XEN closure)
+static Xen gxg_gtk_accel_group_connect_by_path(Xen accel_group, Xen accel_path, Xen closure)
{
#define H_gtk_accel_group_connect_by_path "void gtk_accel_group_connect_by_path(GtkAccelGroup* accel_group, \
gchar* accel_path, GClosure* closure)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_connect_by_path", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 2, "gtk_accel_group_connect_by_path", "gchar*");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 3, "gtk_accel_group_connect_by_path", "GClosure*");
- gtk_accel_group_connect_by_path(XEN_TO_C_GtkAccelGroup_(accel_group), XEN_TO_C_gchar_(accel_path), XEN_TO_C_GClosure_(closure));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_connect_by_path", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 2, "gtk_accel_group_connect_by_path", "gchar*");
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 3, "gtk_accel_group_connect_by_path", "GClosure*");
+ gtk_accel_group_connect_by_path(Xen_to_C_GtkAccelGroup_(accel_group), Xen_to_C_gchar_(accel_path), Xen_to_C_GClosure_(closure));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_group_disconnect(XEN accel_group, XEN closure)
+static Xen gxg_gtk_accel_group_disconnect(Xen accel_group, Xen closure)
{
#define H_gtk_accel_group_disconnect "gboolean gtk_accel_group_disconnect(GtkAccelGroup* accel_group, \
GClosure* closure)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_disconnect", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 2, "gtk_accel_group_disconnect", "GClosure*");
- return(C_TO_XEN_gboolean(gtk_accel_group_disconnect(XEN_TO_C_GtkAccelGroup_(accel_group), XEN_TO_C_GClosure_(closure))));
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_disconnect", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 2, "gtk_accel_group_disconnect", "GClosure*");
+ return(C_to_Xen_gboolean(gtk_accel_group_disconnect(Xen_to_C_GtkAccelGroup_(accel_group), Xen_to_C_GClosure_(closure))));
}
-static XEN gxg_gtk_accel_group_disconnect_key(XEN accel_group, XEN accel_key, XEN accel_mods)
+static Xen gxg_gtk_accel_group_disconnect_key(Xen accel_group, Xen accel_key, Xen accel_mods)
{
#define H_gtk_accel_group_disconnect_key "gboolean gtk_accel_group_disconnect_key(GtkAccelGroup* accel_group, \
guint accel_key, GdkModifierType accel_mods)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_disconnect_key", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 2, "gtk_accel_group_disconnect_key", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 3, "gtk_accel_group_disconnect_key", "GdkModifierType");
- return(C_TO_XEN_gboolean(gtk_accel_group_disconnect_key(XEN_TO_C_GtkAccelGroup_(accel_group), XEN_TO_C_guint(accel_key),
- XEN_TO_C_GdkModifierType(accel_mods))));
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_disconnect_key", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 2, "gtk_accel_group_disconnect_key", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 3, "gtk_accel_group_disconnect_key", "GdkModifierType");
+ return(C_to_Xen_gboolean(gtk_accel_group_disconnect_key(Xen_to_C_GtkAccelGroup_(accel_group), Xen_to_C_guint(accel_key),
+ Xen_to_C_GdkModifierType(accel_mods))));
}
-static XEN gxg_gtk_accel_groups_activate(XEN object, XEN accel_key, XEN accel_mods)
+static Xen gxg_gtk_accel_groups_activate(Xen object, Xen accel_key, Xen accel_mods)
{
#define H_gtk_accel_groups_activate "gboolean gtk_accel_groups_activate(GObject* object, guint accel_key, \
GdkModifierType accel_mods)"
- XEN_ASSERT_TYPE(XEN_GObject__P(object), object, 1, "gtk_accel_groups_activate", "GObject*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 2, "gtk_accel_groups_activate", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 3, "gtk_accel_groups_activate", "GdkModifierType");
- return(C_TO_XEN_gboolean(gtk_accel_groups_activate(XEN_TO_C_GObject_(object), XEN_TO_C_guint(accel_key), XEN_TO_C_GdkModifierType(accel_mods))));
+ Xen_check_type(Xen_is_GObject_(object), object, 1, "gtk_accel_groups_activate", "GObject*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 2, "gtk_accel_groups_activate", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 3, "gtk_accel_groups_activate", "GdkModifierType");
+ return(C_to_Xen_gboolean(gtk_accel_groups_activate(Xen_to_C_GObject_(object), Xen_to_C_guint(accel_key), Xen_to_C_GdkModifierType(accel_mods))));
}
-static XEN gxg_gtk_accel_groups_from_object(XEN object)
+static Xen gxg_gtk_accel_groups_from_object(Xen object)
{
#define H_gtk_accel_groups_from_object "GSList* gtk_accel_groups_from_object(GObject* object)"
- XEN_ASSERT_TYPE(XEN_GObject__P(object), object, 1, "gtk_accel_groups_from_object", "GObject*");
- return(C_TO_XEN_GSList_(gtk_accel_groups_from_object(XEN_TO_C_GObject_(object))));
+ Xen_check_type(Xen_is_GObject_(object), object, 1, "gtk_accel_groups_from_object", "GObject*");
+ return(C_to_Xen_GSList_(gtk_accel_groups_from_object(Xen_to_C_GObject_(object))));
}
-static XEN gxg_gtk_accel_group_find(XEN accel_group, XEN func, XEN func_info)
+static Xen gxg_gtk_accel_group_find(Xen accel_group, Xen func, Xen func_info)
{
#define H_gtk_accel_group_find "GtkAccelKey* gtk_accel_group_find(GtkAccelGroup* accel_group, lambda3 func, \
lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_find", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_lambda3_P(func), func, 2, "gtk_accel_group_find", "lambda3");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_accel_group_find", "lambda_data");
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_find", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_lambda3(func), func, 2, "gtk_accel_group_find", "lambda3");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_accel_group_find", "lambda_data");
{
- XEN result = XEN_FALSE;
+ Xen result;
int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_GtkAccelKey_(gtk_accel_group_find(XEN_TO_C_GtkAccelGroup_(accel_group), XEN_TO_C_lambda3(func), XEN_TO_C_lambda_data(func_info)));
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_GtkAccelKey_(gtk_accel_group_find(Xen_to_C_GtkAccelGroup_(accel_group), Xen_to_C_lambda3(func), Xen_to_C_lambda_data(func_info)));
xm_unprotect_at(loc);
return(result);
}
}
-static XEN gxg_gtk_accel_group_from_accel_closure(XEN closure)
+static Xen gxg_gtk_accel_group_from_accel_closure(Xen closure)
{
#define H_gtk_accel_group_from_accel_closure "GtkAccelGroup* gtk_accel_group_from_accel_closure(GClosure* closure)"
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 1, "gtk_accel_group_from_accel_closure", "GClosure*");
- return(C_TO_XEN_GtkAccelGroup_(gtk_accel_group_from_accel_closure(XEN_TO_C_GClosure_(closure))));
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 1, "gtk_accel_group_from_accel_closure", "GClosure*");
+ return(C_to_Xen_GtkAccelGroup_(gtk_accel_group_from_accel_closure(Xen_to_C_GClosure_(closure))));
}
-static XEN gxg_gtk_accelerator_valid(XEN keyval, XEN modifiers)
+static Xen gxg_gtk_accelerator_valid(Xen keyval, Xen modifiers)
{
#define H_gtk_accelerator_valid "gboolean gtk_accelerator_valid(guint keyval, GdkModifierType modifiers)"
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 1, "gtk_accelerator_valid", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifiers), modifiers, 2, "gtk_accelerator_valid", "GdkModifierType");
- return(C_TO_XEN_gboolean(gtk_accelerator_valid(XEN_TO_C_guint(keyval), XEN_TO_C_GdkModifierType(modifiers))));
+ Xen_check_type(Xen_is_guint(keyval), keyval, 1, "gtk_accelerator_valid", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(modifiers), modifiers, 2, "gtk_accelerator_valid", "GdkModifierType");
+ return(C_to_Xen_gboolean(gtk_accelerator_valid(Xen_to_C_guint(keyval), Xen_to_C_GdkModifierType(modifiers))));
}
-static XEN gxg_gtk_accelerator_parse(XEN accelerator, XEN ignore_accelerator_key, XEN ignore_accelerator_mods)
+static Xen gxg_gtk_accelerator_parse(Xen accelerator, Xen ignore_accelerator_key, Xen ignore_accelerator_mods)
{
#define H_gtk_accelerator_parse "void gtk_accelerator_parse(gchar* accelerator, guint* [accelerator_key], \
GdkModifierType* [accelerator_mods])"
guint ref_accelerator_key;
GdkModifierType ref_accelerator_mods;
- XEN_ASSERT_TYPE(XEN_gchar__P(accelerator), accelerator, 1, "gtk_accelerator_parse", "gchar*");
- gtk_accelerator_parse(XEN_TO_C_gchar_(accelerator), &ref_accelerator_key, &ref_accelerator_mods);
- return(XEN_LIST_2(C_TO_XEN_guint(ref_accelerator_key), C_TO_XEN_GdkModifierType(ref_accelerator_mods)));
+ Xen_check_type(Xen_is_gchar_(accelerator), accelerator, 1, "gtk_accelerator_parse", "gchar*");
+ gtk_accelerator_parse(Xen_to_C_gchar_(accelerator), &ref_accelerator_key, &ref_accelerator_mods);
+ return(Xen_list_2(C_to_Xen_guint(ref_accelerator_key), C_to_Xen_GdkModifierType(ref_accelerator_mods)));
}
-static XEN gxg_gtk_accelerator_name(XEN accelerator_key, XEN accelerator_mods)
+static Xen gxg_gtk_accelerator_name(Xen accelerator_key, Xen accelerator_mods)
{
#define H_gtk_accelerator_name "gchar* gtk_accelerator_name(guint accelerator_key, GdkModifierType accelerator_mods)"
- XEN_ASSERT_TYPE(XEN_guint_P(accelerator_key), accelerator_key, 1, "gtk_accelerator_name", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accelerator_mods), accelerator_mods, 2, "gtk_accelerator_name", "GdkModifierType");
+ Xen_check_type(Xen_is_guint(accelerator_key), accelerator_key, 1, "gtk_accelerator_name", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accelerator_mods), accelerator_mods, 2, "gtk_accelerator_name", "GdkModifierType");
{
gchar* result;
- XEN rtn;
- result = gtk_accelerator_name(XEN_TO_C_guint(accelerator_key), XEN_TO_C_GdkModifierType(accelerator_mods));
- rtn = C_TO_XEN_gchar_(result);
+ Xen rtn;
+ result = gtk_accelerator_name(Xen_to_C_guint(accelerator_key), Xen_to_C_GdkModifierType(accelerator_mods));
+ rtn = C_to_Xen_gchar_(result);
g_free(result);
return(rtn);
}
}
-static XEN gxg_gtk_accelerator_set_default_mod_mask(XEN default_mod_mask)
+static Xen gxg_gtk_accelerator_set_default_mod_mask(Xen default_mod_mask)
{
#define H_gtk_accelerator_set_default_mod_mask "void gtk_accelerator_set_default_mod_mask(GdkModifierType default_mod_mask)"
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(default_mod_mask), default_mod_mask, 1, "gtk_accelerator_set_default_mod_mask", "GdkModifierType");
- gtk_accelerator_set_default_mod_mask(XEN_TO_C_GdkModifierType(default_mod_mask));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkModifierType(default_mod_mask), default_mod_mask, 1, "gtk_accelerator_set_default_mod_mask", "GdkModifierType");
+ gtk_accelerator_set_default_mod_mask(Xen_to_C_GdkModifierType(default_mod_mask));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_group_query(XEN accel_group, XEN accel_key, XEN accel_mods, XEN ignore_n_entries)
+static Xen gxg_gtk_accel_group_query(Xen accel_group, Xen accel_key, Xen accel_mods, Xen ignore_n_entries)
{
#define H_gtk_accel_group_query "GtkAccelGroupEntry* gtk_accel_group_query(GtkAccelGroup* accel_group, \
guint accel_key, GdkModifierType accel_mods, guint* [n_entries])"
guint ref_n_entries;
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_query", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 2, "gtk_accel_group_query", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 3, "gtk_accel_group_query", "GdkModifierType");
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_query", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 2, "gtk_accel_group_query", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 3, "gtk_accel_group_query", "GdkModifierType");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GtkAccelGroupEntry_(gtk_accel_group_query(XEN_TO_C_GtkAccelGroup_(accel_group), XEN_TO_C_guint(accel_key),
- XEN_TO_C_GdkModifierType(accel_mods), &ref_n_entries));
- return(XEN_LIST_2(result, C_TO_XEN_guint(ref_n_entries)));
+ Xen result;
+ result = C_to_Xen_GtkAccelGroupEntry_(gtk_accel_group_query(Xen_to_C_GtkAccelGroup_(accel_group), Xen_to_C_guint(accel_key),
+ Xen_to_C_GdkModifierType(accel_mods), &ref_n_entries));
+ return(Xen_list_2(result, C_to_Xen_guint(ref_n_entries)));
}
}
-static XEN gxg_gtk_accel_group_activate(XEN accel_group, XEN accel_quark, XEN acceleratable, XEN accel_key, XEN accel_mods)
+static Xen gxg_gtk_accel_group_activate(Xen accel_group, Xen accel_quark, Xen acceleratable, Xen accel_key, Xen accel_mods)
{
#define H_gtk_accel_group_activate "gboolean gtk_accel_group_activate(GtkAccelGroup* accel_group, GQuark accel_quark, \
GObject* acceleratable, guint accel_key, GdkModifierType accel_mods)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_activate", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_GQuark_P(accel_quark), accel_quark, 2, "gtk_accel_group_activate", "GQuark");
- XEN_ASSERT_TYPE(XEN_GObject__P(acceleratable), acceleratable, 3, "gtk_accel_group_activate", "GObject*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 4, "gtk_accel_group_activate", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 5, "gtk_accel_group_activate", "GdkModifierType");
- return(C_TO_XEN_gboolean(gtk_accel_group_activate(XEN_TO_C_GtkAccelGroup_(accel_group), XEN_TO_C_GQuark(accel_quark), XEN_TO_C_GObject_(acceleratable),
- XEN_TO_C_guint(accel_key), XEN_TO_C_GdkModifierType(accel_mods))));
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_activate", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_GQuark(accel_quark), accel_quark, 2, "gtk_accel_group_activate", "GQuark");
+ Xen_check_type(Xen_is_GObject_(acceleratable), acceleratable, 3, "gtk_accel_group_activate", "GObject*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 4, "gtk_accel_group_activate", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 5, "gtk_accel_group_activate", "GdkModifierType");
+ return(C_to_Xen_gboolean(gtk_accel_group_activate(Xen_to_C_GtkAccelGroup_(accel_group), Xen_to_C_GQuark(accel_quark), Xen_to_C_GObject_(acceleratable),
+ Xen_to_C_guint(accel_key), Xen_to_C_GdkModifierType(accel_mods))));
}
-static XEN gxg_gtk_accel_label_new(XEN string)
+static Xen gxg_gtk_accel_label_new(Xen string)
{
#define H_gtk_accel_label_new "GtkWidget* gtk_accel_label_new(gchar* string)"
- XEN_ASSERT_TYPE(XEN_gchar__P(string), string, 1, "gtk_accel_label_new", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_accel_label_new(XEN_TO_C_gchar_(string))));
+ Xen_check_type(Xen_is_gchar_(string), string, 1, "gtk_accel_label_new", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_accel_label_new(Xen_to_C_gchar_(string))));
}
-static XEN gxg_gtk_accel_label_get_accel_widget(XEN accel_label)
+static Xen gxg_gtk_accel_label_get_accel_widget(Xen accel_label)
{
#define H_gtk_accel_label_get_accel_widget "GtkWidget* gtk_accel_label_get_accel_widget(GtkAccelLabel* accel_label)"
- XEN_ASSERT_TYPE(XEN_GtkAccelLabel__P(accel_label), accel_label, 1, "gtk_accel_label_get_accel_widget", "GtkAccelLabel*");
- return(C_TO_XEN_GtkWidget_(gtk_accel_label_get_accel_widget(XEN_TO_C_GtkAccelLabel_(accel_label))));
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_get_accel_widget", "GtkAccelLabel*");
+ return(C_to_Xen_GtkWidget_(gtk_accel_label_get_accel_widget(Xen_to_C_GtkAccelLabel_(accel_label))));
}
-static XEN gxg_gtk_accel_label_get_accel_width(XEN accel_label)
+static Xen gxg_gtk_accel_label_get_accel_width(Xen accel_label)
{
#define H_gtk_accel_label_get_accel_width "guint gtk_accel_label_get_accel_width(GtkAccelLabel* accel_label)"
- XEN_ASSERT_TYPE(XEN_GtkAccelLabel__P(accel_label), accel_label, 1, "gtk_accel_label_get_accel_width", "GtkAccelLabel*");
- return(C_TO_XEN_guint(gtk_accel_label_get_accel_width(XEN_TO_C_GtkAccelLabel_(accel_label))));
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_get_accel_width", "GtkAccelLabel*");
+ return(C_to_Xen_guint(gtk_accel_label_get_accel_width(Xen_to_C_GtkAccelLabel_(accel_label))));
}
-static XEN gxg_gtk_accel_label_set_accel_widget(XEN accel_label, XEN accel_widget)
+static Xen gxg_gtk_accel_label_set_accel_widget(Xen accel_label, Xen accel_widget)
{
#define H_gtk_accel_label_set_accel_widget "void gtk_accel_label_set_accel_widget(GtkAccelLabel* accel_label, \
GtkWidget* accel_widget)"
- XEN_ASSERT_TYPE(XEN_GtkAccelLabel__P(accel_label), accel_label, 1, "gtk_accel_label_set_accel_widget", "GtkAccelLabel*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(accel_widget), accel_widget, 2, "gtk_accel_label_set_accel_widget", "GtkWidget*");
- gtk_accel_label_set_accel_widget(XEN_TO_C_GtkAccelLabel_(accel_label), XEN_TO_C_GtkWidget_(accel_widget));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_set_accel_widget", "GtkAccelLabel*");
+ Xen_check_type(Xen_is_GtkWidget_(accel_widget), accel_widget, 2, "gtk_accel_label_set_accel_widget", "GtkWidget*");
+ gtk_accel_label_set_accel_widget(Xen_to_C_GtkAccelLabel_(accel_label), Xen_to_C_GtkWidget_(accel_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_label_set_accel_closure(XEN accel_label, XEN closure)
+static Xen gxg_gtk_accel_label_set_accel_closure(Xen accel_label, Xen closure)
{
#define H_gtk_accel_label_set_accel_closure "void gtk_accel_label_set_accel_closure(GtkAccelLabel* accel_label, \
GClosure* closure)"
- XEN_ASSERT_TYPE(XEN_GtkAccelLabel__P(accel_label), accel_label, 1, "gtk_accel_label_set_accel_closure", "GtkAccelLabel*");
- XEN_ASSERT_TYPE(XEN_GClosure__P(closure) || XEN_FALSE_P(closure), closure, 2, "gtk_accel_label_set_accel_closure", "GClosure*");
- gtk_accel_label_set_accel_closure(XEN_TO_C_GtkAccelLabel_(accel_label), XEN_TO_C_GClosure_(closure));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_set_accel_closure", "GtkAccelLabel*");
+ Xen_check_type(Xen_is_GClosure_(closure) || Xen_is_false(closure), closure, 2, "gtk_accel_label_set_accel_closure", "GClosure*");
+ gtk_accel_label_set_accel_closure(Xen_to_C_GtkAccelLabel_(accel_label), Xen_to_C_GClosure_(closure));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_label_refetch(XEN accel_label)
+static Xen gxg_gtk_accel_label_refetch(Xen accel_label)
{
#define H_gtk_accel_label_refetch "gboolean gtk_accel_label_refetch(GtkAccelLabel* accel_label)"
- XEN_ASSERT_TYPE(XEN_GtkAccelLabel__P(accel_label), accel_label, 1, "gtk_accel_label_refetch", "GtkAccelLabel*");
- return(C_TO_XEN_gboolean(gtk_accel_label_refetch(XEN_TO_C_GtkAccelLabel_(accel_label))));
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_refetch", "GtkAccelLabel*");
+ return(C_to_Xen_gboolean(gtk_accel_label_refetch(Xen_to_C_GtkAccelLabel_(accel_label))));
}
-static XEN gxg_gtk_accel_map_add_entry(XEN accel_path, XEN accel_key, XEN accel_mods)
+static Xen gxg_gtk_accel_map_add_entry(Xen accel_path, Xen accel_key, Xen accel_mods)
{
#define H_gtk_accel_map_add_entry "void gtk_accel_map_add_entry(gchar* accel_path, guint accel_key, \
GdkModifierType accel_mods)"
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 1, "gtk_accel_map_add_entry", "gchar*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 2, "gtk_accel_map_add_entry", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 3, "gtk_accel_map_add_entry", "GdkModifierType");
- gtk_accel_map_add_entry(XEN_TO_C_gchar_(accel_path), XEN_TO_C_guint(accel_key), XEN_TO_C_GdkModifierType(accel_mods));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 1, "gtk_accel_map_add_entry", "gchar*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 2, "gtk_accel_map_add_entry", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 3, "gtk_accel_map_add_entry", "GdkModifierType");
+ gtk_accel_map_add_entry(Xen_to_C_gchar_(accel_path), Xen_to_C_guint(accel_key), Xen_to_C_GdkModifierType(accel_mods));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_map_lookup_entry(XEN accel_path, XEN key)
+static Xen gxg_gtk_accel_map_lookup_entry(Xen accel_path, Xen key)
{
#define H_gtk_accel_map_lookup_entry "gboolean gtk_accel_map_lookup_entry(gchar* accel_path, GtkAccelKey* key)"
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 1, "gtk_accel_map_lookup_entry", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkAccelKey__P(key), key, 2, "gtk_accel_map_lookup_entry", "GtkAccelKey*");
- return(C_TO_XEN_gboolean(gtk_accel_map_lookup_entry(XEN_TO_C_gchar_(accel_path), XEN_TO_C_GtkAccelKey_(key))));
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 1, "gtk_accel_map_lookup_entry", "gchar*");
+ Xen_check_type(Xen_is_GtkAccelKey_(key), key, 2, "gtk_accel_map_lookup_entry", "GtkAccelKey*");
+ return(C_to_Xen_gboolean(gtk_accel_map_lookup_entry(Xen_to_C_gchar_(accel_path), Xen_to_C_GtkAccelKey_(key))));
}
-static XEN gxg_gtk_accel_map_change_entry(XEN accel_path, XEN accel_key, XEN accel_mods, XEN replace)
+static Xen gxg_gtk_accel_map_change_entry(Xen accel_path, Xen accel_key, Xen accel_mods, Xen replace)
{
#define H_gtk_accel_map_change_entry "gboolean gtk_accel_map_change_entry(gchar* accel_path, guint accel_key, \
GdkModifierType accel_mods, gboolean replace)"
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 1, "gtk_accel_map_change_entry", "gchar*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 2, "gtk_accel_map_change_entry", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 3, "gtk_accel_map_change_entry", "GdkModifierType");
- XEN_ASSERT_TYPE(XEN_gboolean_P(replace), replace, 4, "gtk_accel_map_change_entry", "gboolean");
- return(C_TO_XEN_gboolean(gtk_accel_map_change_entry(XEN_TO_C_gchar_(accel_path), XEN_TO_C_guint(accel_key), XEN_TO_C_GdkModifierType(accel_mods),
- XEN_TO_C_gboolean(replace))));
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 1, "gtk_accel_map_change_entry", "gchar*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 2, "gtk_accel_map_change_entry", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 3, "gtk_accel_map_change_entry", "GdkModifierType");
+ Xen_check_type(Xen_is_gboolean(replace), replace, 4, "gtk_accel_map_change_entry", "gboolean");
+ return(C_to_Xen_gboolean(gtk_accel_map_change_entry(Xen_to_C_gchar_(accel_path), Xen_to_C_guint(accel_key), Xen_to_C_GdkModifierType(accel_mods),
+ Xen_to_C_gboolean(replace))));
}
-static XEN gxg_gtk_accel_map_load(XEN file_name)
+static Xen gxg_gtk_accel_map_load(Xen file_name)
{
#define H_gtk_accel_map_load "void gtk_accel_map_load(gchar* file_name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(file_name), file_name, 1, "gtk_accel_map_load", "gchar*");
- gtk_accel_map_load(XEN_TO_C_gchar_(file_name));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gchar_(file_name), file_name, 1, "gtk_accel_map_load", "gchar*");
+ gtk_accel_map_load(Xen_to_C_gchar_(file_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_map_save(XEN file_name)
+static Xen gxg_gtk_accel_map_save(Xen file_name)
{
#define H_gtk_accel_map_save "void gtk_accel_map_save(gchar* file_name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(file_name), file_name, 1, "gtk_accel_map_save", "gchar*");
- gtk_accel_map_save(XEN_TO_C_gchar_(file_name));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gchar_(file_name), file_name, 1, "gtk_accel_map_save", "gchar*");
+ gtk_accel_map_save(Xen_to_C_gchar_(file_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_map_foreach(XEN func_info, XEN func)
+static Xen gxg_gtk_accel_map_foreach(Xen func_info, Xen func)
{
#define H_gtk_accel_map_foreach "void gtk_accel_map_foreach(lambda_data func_info, GtkAccelMapForeach func)"
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 1, "gtk_accel_map_foreach", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkAccelMapForeach_P(func), func, 2, "gtk_accel_map_foreach", "GtkAccelMapForeach");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 1, "gtk_accel_map_foreach", "lambda_data");
+ Xen_check_type(Xen_is_GtkAccelMapForeach(func), func, 2, "gtk_accel_map_foreach", "GtkAccelMapForeach");
{
int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_accel_map_foreach(XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkAccelMapForeach(func));
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_accel_map_foreach(Xen_to_C_lambda_data(func_info), Xen_to_C_GtkAccelMapForeach(func));
xm_unprotect_at(loc);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxg_gtk_accel_map_load_fd(XEN fd)
+static Xen gxg_gtk_accel_map_load_fd(Xen fd)
{
#define H_gtk_accel_map_load_fd "void gtk_accel_map_load_fd(gint fd)"
- XEN_ASSERT_TYPE(XEN_gint_P(fd), fd, 1, "gtk_accel_map_load_fd", "gint");
- gtk_accel_map_load_fd(XEN_TO_C_gint(fd));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gint(fd), fd, 1, "gtk_accel_map_load_fd", "gint");
+ gtk_accel_map_load_fd(Xen_to_C_gint(fd));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_map_save_fd(XEN fd)
+static Xen gxg_gtk_accel_map_save_fd(Xen fd)
{
#define H_gtk_accel_map_save_fd "void gtk_accel_map_save_fd(gint fd)"
- XEN_ASSERT_TYPE(XEN_gint_P(fd), fd, 1, "gtk_accel_map_save_fd", "gint");
- gtk_accel_map_save_fd(XEN_TO_C_gint(fd));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gint(fd), fd, 1, "gtk_accel_map_save_fd", "gint");
+ gtk_accel_map_save_fd(Xen_to_C_gint(fd));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_map_add_filter(XEN filter_pattern)
+static Xen gxg_gtk_accel_map_add_filter(Xen filter_pattern)
{
#define H_gtk_accel_map_add_filter "void gtk_accel_map_add_filter(gchar* filter_pattern)"
- XEN_ASSERT_TYPE(XEN_gchar__P(filter_pattern), filter_pattern, 1, "gtk_accel_map_add_filter", "gchar*");
- gtk_accel_map_add_filter(XEN_TO_C_gchar_(filter_pattern));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_gchar_(filter_pattern), filter_pattern, 1, "gtk_accel_map_add_filter", "gchar*");
+ gtk_accel_map_add_filter(Xen_to_C_gchar_(filter_pattern));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_map_foreach_unfiltered(XEN func_info, XEN func)
+static Xen gxg_gtk_accel_map_foreach_unfiltered(Xen func_info, Xen func)
{
#define H_gtk_accel_map_foreach_unfiltered "void gtk_accel_map_foreach_unfiltered(lambda_data func_info, \
GtkAccelMapForeach func)"
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 1, "gtk_accel_map_foreach_unfiltered", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkAccelMapForeach_P(func), func, 2, "gtk_accel_map_foreach_unfiltered", "GtkAccelMapForeach");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 1, "gtk_accel_map_foreach_unfiltered", "lambda_data");
+ Xen_check_type(Xen_is_GtkAccelMapForeach(func), func, 2, "gtk_accel_map_foreach_unfiltered", "GtkAccelMapForeach");
{
int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_accel_map_foreach_unfiltered(XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkAccelMapForeach(func));
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_accel_map_foreach_unfiltered(Xen_to_C_lambda_data(func_info), Xen_to_C_GtkAccelMapForeach(func));
xm_unprotect_at(loc);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxg_gtk_accessible_connect_widget_destroyed(XEN accessible)
-{
- #define H_gtk_accessible_connect_widget_destroyed "void gtk_accessible_connect_widget_destroyed(GtkAccessible* accessible)"
- XEN_ASSERT_TYPE(XEN_GtkAccessible__P(accessible), accessible, 1, "gtk_accessible_connect_widget_destroyed", "GtkAccessible*");
- gtk_accessible_connect_widget_destroyed(XEN_TO_C_GtkAccessible_(accessible));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_adjustment_changed(XEN adjustment)
-{
- #define H_gtk_adjustment_changed "void gtk_adjustment_changed(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_changed", "GtkAdjustment*");
- gtk_adjustment_changed(XEN_TO_C_GtkAdjustment_(adjustment));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_adjustment_value_changed(XEN adjustment)
-{
- #define H_gtk_adjustment_value_changed "void gtk_adjustment_value_changed(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_value_changed", "GtkAdjustment*");
- gtk_adjustment_value_changed(XEN_TO_C_GtkAdjustment_(adjustment));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_adjustment_clamp_page(XEN adjustment, XEN lower, XEN upper)
+static Xen gxg_gtk_adjustment_clamp_page(Xen adjustment, Xen lower, Xen upper)
{
#define H_gtk_adjustment_clamp_page "void gtk_adjustment_clamp_page(GtkAdjustment* adjustment, gdouble lower, \
gdouble upper)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_clamp_page", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(lower), lower, 2, "gtk_adjustment_clamp_page", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(upper), upper, 3, "gtk_adjustment_clamp_page", "gdouble");
- gtk_adjustment_clamp_page(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(lower), XEN_TO_C_gdouble(upper));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_clamp_page", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(lower), lower, 2, "gtk_adjustment_clamp_page", "gdouble");
+ Xen_check_type(Xen_is_gdouble(upper), upper, 3, "gtk_adjustment_clamp_page", "gdouble");
+ gtk_adjustment_clamp_page(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(lower), Xen_to_C_gdouble(upper));
+ return(Xen_false);
}
-static XEN gxg_gtk_adjustment_get_value(XEN adjustment)
+static Xen gxg_gtk_adjustment_get_value(Xen adjustment)
{
#define H_gtk_adjustment_get_value "gdouble gtk_adjustment_get_value(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_get_value", "GtkAdjustment*");
- return(C_TO_XEN_gdouble(gtk_adjustment_get_value(XEN_TO_C_GtkAdjustment_(adjustment))));
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_get_value", "GtkAdjustment*");
+ return(C_to_Xen_gdouble(gtk_adjustment_get_value(Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gtk_adjustment_set_value(XEN adjustment, XEN value)
+static Xen gxg_gtk_adjustment_set_value(Xen adjustment, Xen value)
{
#define H_gtk_adjustment_set_value "void gtk_adjustment_set_value(GtkAdjustment* adjustment, gdouble value)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_set_value", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 2, "gtk_adjustment_set_value", "gdouble");
- gtk_adjustment_set_value(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(value));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_alignment_new(XEN xalign, XEN yalign, XEN xscale, XEN yscale)
-{
- #define H_gtk_alignment_new "GtkWidget* gtk_alignment_new(gfloat xalign, gfloat yalign, gfloat xscale, \
-gfloat yscale)"
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 1, "gtk_alignment_new", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yalign), yalign, 2, "gtk_alignment_new", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xscale), xscale, 3, "gtk_alignment_new", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yscale), yscale, 4, "gtk_alignment_new", "gfloat");
- return(C_TO_XEN_GtkWidget_(gtk_alignment_new(XEN_TO_C_gfloat(xalign), XEN_TO_C_gfloat(yalign), XEN_TO_C_gfloat(xscale),
- XEN_TO_C_gfloat(yscale))));
-}
-
-static XEN gxg_gtk_alignment_set(XEN alignment, XEN xalign, XEN yalign, XEN xscale, XEN yscale)
-{
- #define H_gtk_alignment_set "void gtk_alignment_set(GtkAlignment* alignment, gfloat xalign, gfloat yalign, \
-gfloat xscale, gfloat yscale)"
- XEN_ASSERT_TYPE(XEN_GtkAlignment__P(alignment), alignment, 1, "gtk_alignment_set", "GtkAlignment*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_alignment_set", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yalign), yalign, 3, "gtk_alignment_set", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xscale), xscale, 4, "gtk_alignment_set", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yscale), yscale, 5, "gtk_alignment_set", "gfloat");
- gtk_alignment_set(XEN_TO_C_GtkAlignment_(alignment), XEN_TO_C_gfloat(xalign), XEN_TO_C_gfloat(yalign), XEN_TO_C_gfloat(xscale),
- XEN_TO_C_gfloat(yscale));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_arrow_new(XEN arrow_type, XEN shadow_type)
-{
- #define H_gtk_arrow_new "GtkWidget* gtk_arrow_new(GtkArrowType arrow_type, GtkShadowType shadow_type)"
- XEN_ASSERT_TYPE(XEN_GtkArrowType_P(arrow_type), arrow_type, 1, "gtk_arrow_new", "GtkArrowType");
- XEN_ASSERT_TYPE(XEN_GtkShadowType_P(shadow_type), shadow_type, 2, "gtk_arrow_new", "GtkShadowType");
- return(C_TO_XEN_GtkWidget_(gtk_arrow_new(XEN_TO_C_GtkArrowType(arrow_type), XEN_TO_C_GtkShadowType(shadow_type))));
-}
-
-static XEN gxg_gtk_arrow_set(XEN arrow, XEN arrow_type, XEN shadow_type)
-{
- #define H_gtk_arrow_set "void gtk_arrow_set(GtkArrow* arrow, GtkArrowType arrow_type, GtkShadowType shadow_type)"
- XEN_ASSERT_TYPE(XEN_GtkArrow__P(arrow), arrow, 1, "gtk_arrow_set", "GtkArrow*");
- XEN_ASSERT_TYPE(XEN_GtkArrowType_P(arrow_type), arrow_type, 2, "gtk_arrow_set", "GtkArrowType");
- XEN_ASSERT_TYPE(XEN_GtkShadowType_P(shadow_type), shadow_type, 3, "gtk_arrow_set", "GtkShadowType");
- gtk_arrow_set(XEN_TO_C_GtkArrow_(arrow), XEN_TO_C_GtkArrowType(arrow_type), XEN_TO_C_GtkShadowType(shadow_type));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_set_value", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(value), value, 2, "gtk_adjustment_set_value", "gdouble");
+ gtk_adjustment_set_value(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_aspect_frame_new(XEN label, XEN xalign, XEN yalign, XEN ratio, XEN obey_child)
+static Xen gxg_gtk_aspect_frame_new(Xen label, Xen xalign, Xen yalign, Xen ratio, Xen obey_child)
{
#define H_gtk_aspect_frame_new "GtkWidget* gtk_aspect_frame_new(gchar* label, gfloat xalign, gfloat yalign, \
gfloat ratio, gboolean obey_child)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_aspect_frame_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_aspect_frame_new", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yalign), yalign, 3, "gtk_aspect_frame_new", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(ratio), ratio, 4, "gtk_aspect_frame_new", "gfloat");
- XEN_ASSERT_TYPE(XEN_gboolean_P(obey_child), obey_child, 5, "gtk_aspect_frame_new", "gboolean");
- return(C_TO_XEN_GtkWidget_(gtk_aspect_frame_new(XEN_TO_C_gchar_(label), XEN_TO_C_gfloat(xalign), XEN_TO_C_gfloat(yalign),
- XEN_TO_C_gfloat(ratio), XEN_TO_C_gboolean(obey_child))));
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_aspect_frame_new", "gchar*");
+ Xen_check_type(Xen_is_gfloat(xalign), xalign, 2, "gtk_aspect_frame_new", "gfloat");
+ Xen_check_type(Xen_is_gfloat(yalign), yalign, 3, "gtk_aspect_frame_new", "gfloat");
+ Xen_check_type(Xen_is_gfloat(ratio), ratio, 4, "gtk_aspect_frame_new", "gfloat");
+ Xen_check_type(Xen_is_gboolean(obey_child), obey_child, 5, "gtk_aspect_frame_new", "gboolean");
+ return(C_to_Xen_GtkWidget_(gtk_aspect_frame_new(Xen_to_C_gchar_(label), Xen_to_C_gfloat(xalign), Xen_to_C_gfloat(yalign),
+ Xen_to_C_gfloat(ratio), Xen_to_C_gboolean(obey_child))));
}
-static XEN gxg_gtk_aspect_frame_set(XEN aspect_frame, XEN xalign, XEN yalign, XEN ratio, XEN obey_child)
+static Xen gxg_gtk_aspect_frame_set(Xen aspect_frame, Xen xalign, Xen yalign, Xen ratio, Xen obey_child)
{
#define H_gtk_aspect_frame_set "void gtk_aspect_frame_set(GtkAspectFrame* aspect_frame, gfloat xalign, \
gfloat yalign, gfloat ratio, gboolean obey_child)"
- XEN_ASSERT_TYPE(XEN_GtkAspectFrame__P(aspect_frame), aspect_frame, 1, "gtk_aspect_frame_set", "GtkAspectFrame*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_aspect_frame_set", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yalign), yalign, 3, "gtk_aspect_frame_set", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(ratio), ratio, 4, "gtk_aspect_frame_set", "gfloat");
- XEN_ASSERT_TYPE(XEN_gboolean_P(obey_child), obey_child, 5, "gtk_aspect_frame_set", "gboolean");
- gtk_aspect_frame_set(XEN_TO_C_GtkAspectFrame_(aspect_frame), XEN_TO_C_gfloat(xalign), XEN_TO_C_gfloat(yalign), XEN_TO_C_gfloat(ratio),
- XEN_TO_C_gboolean(obey_child));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkAspectFrame_(aspect_frame), aspect_frame, 1, "gtk_aspect_frame_set", "GtkAspectFrame*");
+ Xen_check_type(Xen_is_gfloat(xalign), xalign, 2, "gtk_aspect_frame_set", "gfloat");
+ Xen_check_type(Xen_is_gfloat(yalign), yalign, 3, "gtk_aspect_frame_set", "gfloat");
+ Xen_check_type(Xen_is_gfloat(ratio), ratio, 4, "gtk_aspect_frame_set", "gfloat");
+ Xen_check_type(Xen_is_gboolean(obey_child), obey_child, 5, "gtk_aspect_frame_set", "gboolean");
+ gtk_aspect_frame_set(Xen_to_C_GtkAspectFrame_(aspect_frame), Xen_to_C_gfloat(xalign), Xen_to_C_gfloat(yalign), Xen_to_C_gfloat(ratio),
+ Xen_to_C_gboolean(obey_child));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_box_get_layout(XEN widget)
+static Xen gxg_gtk_button_box_get_layout(Xen widget)
{
#define H_gtk_button_box_get_layout "GtkButtonBoxStyle gtk_button_box_get_layout(GtkButtonBox* widget)"
- XEN_ASSERT_TYPE(XEN_GtkButtonBox__P(widget), widget, 1, "gtk_button_box_get_layout", "GtkButtonBox*");
- return(C_TO_XEN_GtkButtonBoxStyle(gtk_button_box_get_layout(XEN_TO_C_GtkButtonBox_(widget))));
+ Xen_check_type(Xen_is_GtkButtonBox_(widget), widget, 1, "gtk_button_box_get_layout", "GtkButtonBox*");
+ return(C_to_Xen_GtkButtonBoxStyle(gtk_button_box_get_layout(Xen_to_C_GtkButtonBox_(widget))));
}
-static XEN gxg_gtk_button_box_set_layout(XEN widget, XEN layout_style)
+static Xen gxg_gtk_button_box_set_layout(Xen widget, Xen layout_style)
{
#define H_gtk_button_box_set_layout "void gtk_button_box_set_layout(GtkButtonBox* widget, GtkButtonBoxStyle layout_style)"
- XEN_ASSERT_TYPE(XEN_GtkButtonBox__P(widget), widget, 1, "gtk_button_box_set_layout", "GtkButtonBox*");
- XEN_ASSERT_TYPE(XEN_GtkButtonBoxStyle_P(layout_style), layout_style, 2, "gtk_button_box_set_layout", "GtkButtonBoxStyle");
- gtk_button_box_set_layout(XEN_TO_C_GtkButtonBox_(widget), XEN_TO_C_GtkButtonBoxStyle(layout_style));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkButtonBox_(widget), widget, 1, "gtk_button_box_set_layout", "GtkButtonBox*");
+ Xen_check_type(Xen_is_GtkButtonBoxStyle(layout_style), layout_style, 2, "gtk_button_box_set_layout", "GtkButtonBoxStyle");
+ gtk_button_box_set_layout(Xen_to_C_GtkButtonBox_(widget), Xen_to_C_GtkButtonBoxStyle(layout_style));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_box_set_child_secondary(XEN widget, XEN child, XEN is_secondary)
+static Xen gxg_gtk_button_box_set_child_secondary(Xen widget, Xen child, Xen is_secondary)
{
#define H_gtk_button_box_set_child_secondary "void gtk_button_box_set_child_secondary(GtkButtonBox* widget, \
GtkWidget* child, gboolean is_secondary)"
- XEN_ASSERT_TYPE(XEN_GtkButtonBox__P(widget), widget, 1, "gtk_button_box_set_child_secondary", "GtkButtonBox*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_button_box_set_child_secondary", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_secondary), is_secondary, 3, "gtk_button_box_set_child_secondary", "gboolean");
- gtk_button_box_set_child_secondary(XEN_TO_C_GtkButtonBox_(widget), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gboolean(is_secondary));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkButtonBox_(widget), widget, 1, "gtk_button_box_set_child_secondary", "GtkButtonBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_button_box_set_child_secondary", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(is_secondary), is_secondary, 3, "gtk_button_box_set_child_secondary", "gboolean");
+ gtk_button_box_set_child_secondary(Xen_to_C_GtkButtonBox_(widget), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(is_secondary));
+ return(Xen_false);
}
-static XEN gxg_gtk_binding_set_new(XEN set_name)
+static Xen gxg_gtk_binding_set_new(Xen set_name)
{
#define H_gtk_binding_set_new "GtkBindingSet* gtk_binding_set_new(gchar* set_name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(set_name), set_name, 1, "gtk_binding_set_new", "gchar*");
- return(C_TO_XEN_GtkBindingSet_(gtk_binding_set_new(XEN_TO_C_gchar_(set_name))));
+ Xen_check_type(Xen_is_gchar_(set_name), set_name, 1, "gtk_binding_set_new", "gchar*");
+ return(C_to_Xen_GtkBindingSet_(gtk_binding_set_new(Xen_to_C_gchar_(set_name))));
}
-static XEN gxg_gtk_binding_set_by_class(XEN object_class)
+static Xen gxg_gtk_binding_set_by_class(Xen object_class)
{
#define H_gtk_binding_set_by_class "GtkBindingSet* gtk_binding_set_by_class(gpointer object_class)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(object_class), object_class, 1, "gtk_binding_set_by_class", "gpointer");
- return(C_TO_XEN_GtkBindingSet_(gtk_binding_set_by_class(XEN_TO_C_gpointer(object_class))));
+ Xen_check_type(Xen_is_gpointer(object_class), object_class, 1, "gtk_binding_set_by_class", "gpointer");
+ return(C_to_Xen_GtkBindingSet_(gtk_binding_set_by_class(Xen_to_C_gpointer(object_class))));
}
-static XEN gxg_gtk_binding_set_find(XEN set_name)
+static Xen gxg_gtk_binding_set_find(Xen set_name)
{
#define H_gtk_binding_set_find "GtkBindingSet* gtk_binding_set_find(gchar* set_name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(set_name), set_name, 1, "gtk_binding_set_find", "gchar*");
- return(C_TO_XEN_GtkBindingSet_(gtk_binding_set_find(XEN_TO_C_gchar_(set_name))));
+ Xen_check_type(Xen_is_gchar_(set_name), set_name, 1, "gtk_binding_set_find", "gchar*");
+ return(C_to_Xen_GtkBindingSet_(gtk_binding_set_find(Xen_to_C_gchar_(set_name))));
}
-static XEN gxg_gtk_binding_entry_remove(XEN binding_set, XEN keyval, XEN modifiers)
+static Xen gxg_gtk_binding_entry_remove(Xen binding_set, Xen keyval, Xen modifiers)
{
#define H_gtk_binding_entry_remove "void gtk_binding_entry_remove(GtkBindingSet* binding_set, guint keyval, \
GdkModifierType modifiers)"
- XEN_ASSERT_TYPE(XEN_GtkBindingSet__P(binding_set), binding_set, 1, "gtk_binding_entry_remove", "GtkBindingSet*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_binding_entry_remove", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifiers), modifiers, 3, "gtk_binding_entry_remove", "GdkModifierType");
- gtk_binding_entry_remove(XEN_TO_C_GtkBindingSet_(binding_set), XEN_TO_C_guint(keyval), XEN_TO_C_GdkModifierType(modifiers));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkBindingSet_(binding_set), binding_set, 1, "gtk_binding_entry_remove", "GtkBindingSet*");
+ Xen_check_type(Xen_is_guint(keyval), keyval, 2, "gtk_binding_entry_remove", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(modifiers), modifiers, 3, "gtk_binding_entry_remove", "GdkModifierType");
+ gtk_binding_entry_remove(Xen_to_C_GtkBindingSet_(binding_set), Xen_to_C_guint(keyval), Xen_to_C_GdkModifierType(modifiers));
+ return(Xen_false);
}
-static XEN gxg_gtk_bin_get_child(XEN bin)
+static Xen gxg_gtk_bin_get_child(Xen bin)
{
#define H_gtk_bin_get_child "GtkWidget* gtk_bin_get_child(GtkBin* bin)"
- XEN_ASSERT_TYPE(XEN_GtkBin__P(bin), bin, 1, "gtk_bin_get_child", "GtkBin*");
- return(C_TO_XEN_GtkWidget_(gtk_bin_get_child(XEN_TO_C_GtkBin_(bin))));
+ Xen_check_type(Xen_is_GtkBin_(bin), bin, 1, "gtk_bin_get_child", "GtkBin*");
+ return(C_to_Xen_GtkWidget_(gtk_bin_get_child(Xen_to_C_GtkBin_(bin))));
}
-static XEN gxg_gtk_box_pack_start(XEN box, XEN child, XEN expand, XEN fill, XEN padding)
+static Xen gxg_gtk_box_pack_start(Xen box, Xen child, Xen expand, Xen fill, Xen padding)
{
#define H_gtk_box_pack_start "void gtk_box_pack_start(GtkBox* box, GtkWidget* child, gboolean expand, \
gboolean fill, guint padding)"
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_pack_start", "GtkBox*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_box_pack_start", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 3, "gtk_box_pack_start", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(fill), fill, 4, "gtk_box_pack_start", "gboolean");
- XEN_ASSERT_TYPE(XEN_guint_P(padding), padding, 5, "gtk_box_pack_start", "guint");
- gtk_box_pack_start(XEN_TO_C_GtkBox_(box), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gboolean(expand), XEN_TO_C_gboolean(fill),
- XEN_TO_C_guint(padding));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_pack_start", "GtkBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_pack_start", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_box_pack_start", "gboolean");
+ Xen_check_type(Xen_is_gboolean(fill), fill, 4, "gtk_box_pack_start", "gboolean");
+ Xen_check_type(Xen_is_guint(padding), padding, 5, "gtk_box_pack_start", "guint");
+ gtk_box_pack_start(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(expand), Xen_to_C_gboolean(fill),
+ Xen_to_C_guint(padding));
+ return(Xen_false);
}
-static XEN gxg_gtk_box_pack_end(XEN box, XEN child, XEN expand, XEN fill, XEN padding)
+static Xen gxg_gtk_box_pack_end(Xen box, Xen child, Xen expand, Xen fill, Xen padding)
{
#define H_gtk_box_pack_end "void gtk_box_pack_end(GtkBox* box, GtkWidget* child, gboolean expand, gboolean fill, \
guint padding)"
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_pack_end", "GtkBox*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_box_pack_end", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 3, "gtk_box_pack_end", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(fill), fill, 4, "gtk_box_pack_end", "gboolean");
- XEN_ASSERT_TYPE(XEN_guint_P(padding), padding, 5, "gtk_box_pack_end", "guint");
- gtk_box_pack_end(XEN_TO_C_GtkBox_(box), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gboolean(expand), XEN_TO_C_gboolean(fill),
- XEN_TO_C_guint(padding));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_pack_end", "GtkBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_pack_end", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_box_pack_end", "gboolean");
+ Xen_check_type(Xen_is_gboolean(fill), fill, 4, "gtk_box_pack_end", "gboolean");
+ Xen_check_type(Xen_is_guint(padding), padding, 5, "gtk_box_pack_end", "guint");
+ gtk_box_pack_end(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(expand), Xen_to_C_gboolean(fill),
+ Xen_to_C_guint(padding));
+ return(Xen_false);
}
-static XEN gxg_gtk_box_set_homogeneous(XEN box, XEN homogeneous)
+static Xen gxg_gtk_box_set_homogeneous(Xen box, Xen homogeneous)
{
#define H_gtk_box_set_homogeneous "void gtk_box_set_homogeneous(GtkBox* box, gboolean homogeneous)"
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_set_homogeneous", "GtkBox*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(homogeneous), homogeneous, 2, "gtk_box_set_homogeneous", "gboolean");
- gtk_box_set_homogeneous(XEN_TO_C_GtkBox_(box), XEN_TO_C_gboolean(homogeneous));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_set_homogeneous", "GtkBox*");
+ Xen_check_type(Xen_is_gboolean(homogeneous), homogeneous, 2, "gtk_box_set_homogeneous", "gboolean");
+ gtk_box_set_homogeneous(Xen_to_C_GtkBox_(box), Xen_to_C_gboolean(homogeneous));
+ return(Xen_false);
}
-static XEN gxg_gtk_box_get_homogeneous(XEN box)
+static Xen gxg_gtk_box_get_homogeneous(Xen box)
{
#define H_gtk_box_get_homogeneous "gboolean gtk_box_get_homogeneous(GtkBox* box)"
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_get_homogeneous", "GtkBox*");
- return(C_TO_XEN_gboolean(gtk_box_get_homogeneous(XEN_TO_C_GtkBox_(box))));
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_get_homogeneous", "GtkBox*");
+ return(C_to_Xen_gboolean(gtk_box_get_homogeneous(Xen_to_C_GtkBox_(box))));
}
-static XEN gxg_gtk_box_set_spacing(XEN box, XEN spacing)
+static Xen gxg_gtk_box_set_spacing(Xen box, Xen spacing)
{
#define H_gtk_box_set_spacing "void gtk_box_set_spacing(GtkBox* box, gint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_set_spacing", "GtkBox*");
- XEN_ASSERT_TYPE(XEN_gint_P(spacing), spacing, 2, "gtk_box_set_spacing", "gint");
- gtk_box_set_spacing(XEN_TO_C_GtkBox_(box), XEN_TO_C_gint(spacing));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_set_spacing", "GtkBox*");
+ Xen_check_type(Xen_is_gint(spacing), spacing, 2, "gtk_box_set_spacing", "gint");
+ gtk_box_set_spacing(Xen_to_C_GtkBox_(box), Xen_to_C_gint(spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_box_get_spacing(XEN box)
+static Xen gxg_gtk_box_get_spacing(Xen box)
{
#define H_gtk_box_get_spacing "gint gtk_box_get_spacing(GtkBox* box)"
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_get_spacing", "GtkBox*");
- return(C_TO_XEN_gint(gtk_box_get_spacing(XEN_TO_C_GtkBox_(box))));
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_get_spacing", "GtkBox*");
+ return(C_to_Xen_gint(gtk_box_get_spacing(Xen_to_C_GtkBox_(box))));
}
-static XEN gxg_gtk_box_reorder_child(XEN box, XEN child, XEN position)
+static Xen gxg_gtk_box_reorder_child(Xen box, Xen child, Xen position)
{
#define H_gtk_box_reorder_child "void gtk_box_reorder_child(GtkBox* box, GtkWidget* child, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_reorder_child", "GtkBox*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_box_reorder_child", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_box_reorder_child", "gint");
- gtk_box_reorder_child(XEN_TO_C_GtkBox_(box), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_reorder_child", "GtkBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_reorder_child", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_box_reorder_child", "gint");
+ gtk_box_reorder_child(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_box_query_child_packing(XEN box, XEN child, XEN ignore_expand, XEN ignore_fill, XEN ignore_padding, XEN ignore_pack_type)
+static Xen gxg_gtk_box_query_child_packing(Xen box, Xen child, Xen ignore_expand, Xen ignore_fill, Xen ignore_padding, Xen ignore_pack_type)
{
#define H_gtk_box_query_child_packing "void gtk_box_query_child_packing(GtkBox* box, GtkWidget* child, \
gboolean* [expand], gboolean* [fill], guint* [padding], GtkPackType* [pack_type])"
@@ -4303,831 +4398,599 @@ gboolean* [expand], gboolean* [fill], guint* [padding], GtkPackType* [pack_type]
gboolean ref_fill;
guint ref_padding;
GtkPackType ref_pack_type;
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_query_child_packing", "GtkBox*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_box_query_child_packing", "GtkWidget*");
- gtk_box_query_child_packing(XEN_TO_C_GtkBox_(box), XEN_TO_C_GtkWidget_(child), &ref_expand, &ref_fill, &ref_padding, &ref_pack_type);
- return(XEN_LIST_4(C_TO_XEN_gboolean(ref_expand), C_TO_XEN_gboolean(ref_fill), C_TO_XEN_guint(ref_padding), C_TO_XEN_GtkPackType(ref_pack_type)));
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_query_child_packing", "GtkBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_query_child_packing", "GtkWidget*");
+ gtk_box_query_child_packing(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child), &ref_expand, &ref_fill, &ref_padding, &ref_pack_type);
+ return(Xen_list_4(C_to_Xen_gboolean(ref_expand), C_to_Xen_gboolean(ref_fill), C_to_Xen_guint(ref_padding), C_to_Xen_GtkPackType(ref_pack_type)));
}
-static XEN gxg_gtk_box_set_child_packing(XEN box, XEN child, XEN expand, XEN fill, XEN padding, XEN pack_type)
+static Xen gxg_gtk_box_set_child_packing(Xen box, Xen child, Xen expand, Xen fill, Xen padding, Xen pack_type)
{
#define H_gtk_box_set_child_packing "void gtk_box_set_child_packing(GtkBox* box, GtkWidget* child, \
gboolean expand, gboolean fill, guint padding, GtkPackType pack_type)"
- XEN_ASSERT_TYPE(XEN_GtkBox__P(box), box, 1, "gtk_box_set_child_packing", "GtkBox*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_box_set_child_packing", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 3, "gtk_box_set_child_packing", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(fill), fill, 4, "gtk_box_set_child_packing", "gboolean");
- XEN_ASSERT_TYPE(XEN_guint_P(padding), padding, 5, "gtk_box_set_child_packing", "guint");
- XEN_ASSERT_TYPE(XEN_GtkPackType_P(pack_type), pack_type, 6, "gtk_box_set_child_packing", "GtkPackType");
- gtk_box_set_child_packing(XEN_TO_C_GtkBox_(box), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gboolean(expand), XEN_TO_C_gboolean(fill),
- XEN_TO_C_guint(padding), XEN_TO_C_GtkPackType(pack_type));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_set_child_packing", "GtkBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_box_set_child_packing", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_box_set_child_packing", "gboolean");
+ Xen_check_type(Xen_is_gboolean(fill), fill, 4, "gtk_box_set_child_packing", "gboolean");
+ Xen_check_type(Xen_is_guint(padding), padding, 5, "gtk_box_set_child_packing", "guint");
+ Xen_check_type(Xen_is_GtkPackType(pack_type), pack_type, 6, "gtk_box_set_child_packing", "GtkPackType");
+ gtk_box_set_child_packing(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(expand), Xen_to_C_gboolean(fill),
+ Xen_to_C_guint(padding), Xen_to_C_GtkPackType(pack_type));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_new(void)
+static Xen gxg_gtk_button_new(void)
{
#define H_gtk_button_new "GtkWidget* gtk_button_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_button_new()));
+ return(C_to_Xen_GtkWidget_(gtk_button_new()));
}
-static XEN gxg_gtk_button_new_with_label(XEN label)
+static Xen gxg_gtk_button_new_with_label(Xen label)
{
#define H_gtk_button_new_with_label "GtkWidget* gtk_button_new_with_label(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_button_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_button_new_with_label(XEN_TO_C_gchar_(label))));
-}
-
-static XEN gxg_gtk_button_new_from_stock(XEN stock_id)
-{
- #define H_gtk_button_new_from_stock "GtkWidget* gtk_button_new_from_stock(gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_button_new_from_stock", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_button_new_from_stock(XEN_TO_C_gchar_(stock_id))));
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_button_new_with_label", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_button_new_with_label(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_button_new_with_mnemonic(XEN label)
+static Xen gxg_gtk_button_new_with_mnemonic(Xen label)
{
#define H_gtk_button_new_with_mnemonic "GtkWidget* gtk_button_new_with_mnemonic(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_button_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_button_new_with_mnemonic(XEN_TO_C_gchar_(label))));
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_button_new_with_mnemonic", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_button_new_with_mnemonic(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_button_clicked(XEN button)
+static Xen gxg_gtk_button_clicked(Xen button)
{
#define H_gtk_button_clicked "void gtk_button_clicked(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_clicked", "GtkButton*");
- gtk_button_clicked(XEN_TO_C_GtkButton_(button));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_clicked", "GtkButton*");
+ gtk_button_clicked(Xen_to_C_GtkButton_(button));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_set_relief(XEN button, XEN newstyle)
+static Xen gxg_gtk_button_set_relief(Xen button, Xen newstyle)
{
#define H_gtk_button_set_relief "void gtk_button_set_relief(GtkButton* button, GtkReliefStyle newstyle)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_set_relief", "GtkButton*");
- XEN_ASSERT_TYPE(XEN_GtkReliefStyle_P(newstyle), newstyle, 2, "gtk_button_set_relief", "GtkReliefStyle");
- gtk_button_set_relief(XEN_TO_C_GtkButton_(button), XEN_TO_C_GtkReliefStyle(newstyle));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_set_relief", "GtkButton*");
+ Xen_check_type(Xen_is_GtkReliefStyle(newstyle), newstyle, 2, "gtk_button_set_relief", "GtkReliefStyle");
+ gtk_button_set_relief(Xen_to_C_GtkButton_(button), Xen_to_C_GtkReliefStyle(newstyle));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_get_relief(XEN button)
+static Xen gxg_gtk_button_get_relief(Xen button)
{
#define H_gtk_button_get_relief "GtkReliefStyle gtk_button_get_relief(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_relief", "GtkButton*");
- return(C_TO_XEN_GtkReliefStyle(gtk_button_get_relief(XEN_TO_C_GtkButton_(button))));
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_get_relief", "GtkButton*");
+ return(C_to_Xen_GtkReliefStyle(gtk_button_get_relief(Xen_to_C_GtkButton_(button))));
}
-static XEN gxg_gtk_button_set_label(XEN button, XEN label)
+static Xen gxg_gtk_button_set_label(Xen button, Xen label)
{
#define H_gtk_button_set_label "void gtk_button_set_label(GtkButton* button, gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_set_label", "GtkButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_button_set_label", "gchar*");
- gtk_button_set_label(XEN_TO_C_GtkButton_(button), XEN_TO_C_gchar_(label));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_set_label", "GtkButton*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_button_set_label", "gchar*");
+ gtk_button_set_label(Xen_to_C_GtkButton_(button), Xen_to_C_gchar_(label));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_get_label(XEN button)
+static Xen gxg_gtk_button_get_label(Xen button)
{
#define H_gtk_button_get_label "gchar* gtk_button_get_label(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_label", "GtkButton*");
- return(C_TO_XEN_gchar_(gtk_button_get_label(XEN_TO_C_GtkButton_(button))));
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_get_label", "GtkButton*");
+ return(C_to_Xen_gchar_(gtk_button_get_label(Xen_to_C_GtkButton_(button))));
}
-static XEN gxg_gtk_button_set_use_underline(XEN button, XEN use_underline)
+static Xen gxg_gtk_button_set_use_underline(Xen button, Xen use_underline)
{
#define H_gtk_button_set_use_underline "void gtk_button_set_use_underline(GtkButton* button, gboolean use_underline)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_set_use_underline", "GtkButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_underline), use_underline, 2, "gtk_button_set_use_underline", "gboolean");
- gtk_button_set_use_underline(XEN_TO_C_GtkButton_(button), XEN_TO_C_gboolean(use_underline));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_set_use_underline", "GtkButton*");
+ Xen_check_type(Xen_is_gboolean(use_underline), use_underline, 2, "gtk_button_set_use_underline", "gboolean");
+ gtk_button_set_use_underline(Xen_to_C_GtkButton_(button), Xen_to_C_gboolean(use_underline));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_get_use_underline(XEN button)
+static Xen gxg_gtk_button_get_use_underline(Xen button)
{
#define H_gtk_button_get_use_underline "gboolean gtk_button_get_use_underline(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_use_underline", "GtkButton*");
- return(C_TO_XEN_gboolean(gtk_button_get_use_underline(XEN_TO_C_GtkButton_(button))));
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_get_use_underline", "GtkButton*");
+ return(C_to_Xen_gboolean(gtk_button_get_use_underline(Xen_to_C_GtkButton_(button))));
}
-static XEN gxg_gtk_button_set_use_stock(XEN button, XEN use_stock)
-{
- #define H_gtk_button_set_use_stock "void gtk_button_set_use_stock(GtkButton* button, gboolean use_stock)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_set_use_stock", "GtkButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_stock), use_stock, 2, "gtk_button_set_use_stock", "gboolean");
- gtk_button_set_use_stock(XEN_TO_C_GtkButton_(button), XEN_TO_C_gboolean(use_stock));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_button_get_use_stock(XEN button)
-{
- #define H_gtk_button_get_use_stock "gboolean gtk_button_get_use_stock(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_use_stock", "GtkButton*");
- return(C_TO_XEN_gboolean(gtk_button_get_use_stock(XEN_TO_C_GtkButton_(button))));
-}
-
-static XEN gxg_gtk_calendar_new(void)
+static Xen gxg_gtk_calendar_new(void)
{
#define H_gtk_calendar_new "GtkWidget* gtk_calendar_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_calendar_new()));
+ return(C_to_Xen_GtkWidget_(gtk_calendar_new()));
}
-static XEN gxg_gtk_calendar_select_day(XEN calendar, XEN day)
+static Xen gxg_gtk_calendar_select_day(Xen calendar, Xen day)
{
#define H_gtk_calendar_select_day "void gtk_calendar_select_day(GtkCalendar* calendar, guint day)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_select_day", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_guint_P(day), day, 2, "gtk_calendar_select_day", "guint");
- gtk_calendar_select_day(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_guint(day));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_select_day", "GtkCalendar*");
+ Xen_check_type(Xen_is_guint(day), day, 2, "gtk_calendar_select_day", "guint");
+ gtk_calendar_select_day(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_guint(day));
+ return(Xen_false);
}
-static XEN gxg_gtk_calendar_clear_marks(XEN calendar)
+static Xen gxg_gtk_calendar_clear_marks(Xen calendar)
{
#define H_gtk_calendar_clear_marks "void gtk_calendar_clear_marks(GtkCalendar* calendar)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_clear_marks", "GtkCalendar*");
- gtk_calendar_clear_marks(XEN_TO_C_GtkCalendar_(calendar));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_clear_marks", "GtkCalendar*");
+ gtk_calendar_clear_marks(Xen_to_C_GtkCalendar_(calendar));
+ return(Xen_false);
}
-static XEN gxg_gtk_calendar_get_date(XEN calendar, XEN ignore_year, XEN ignore_month, XEN ignore_day)
+static Xen gxg_gtk_calendar_get_date(Xen calendar, Xen ignore_year, Xen ignore_month, Xen ignore_day)
{
#define H_gtk_calendar_get_date "void gtk_calendar_get_date(GtkCalendar* calendar, guint* [year], guint* [month], \
guint* [day])"
guint ref_year;
guint ref_month;
guint ref_day;
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_get_date", "GtkCalendar*");
- gtk_calendar_get_date(XEN_TO_C_GtkCalendar_(calendar), &ref_year, &ref_month, &ref_day);
- return(XEN_LIST_3(C_TO_XEN_guint(ref_year), C_TO_XEN_guint(ref_month), C_TO_XEN_guint(ref_day)));
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_get_date", "GtkCalendar*");
+ gtk_calendar_get_date(Xen_to_C_GtkCalendar_(calendar), &ref_year, &ref_month, &ref_day);
+ return(Xen_list_3(C_to_Xen_guint(ref_year), C_to_Xen_guint(ref_month), C_to_Xen_guint(ref_day)));
}
-static XEN gxg_gtk_cell_editable_start_editing(XEN cell_editable, XEN event)
+static Xen gxg_gtk_cell_editable_start_editing(Xen cell_editable, Xen event)
{
#define H_gtk_cell_editable_start_editing "void gtk_cell_editable_start_editing(GtkCellEditable* cell_editable, \
GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GtkCellEditable__P(cell_editable), cell_editable, 1, "gtk_cell_editable_start_editing", "GtkCellEditable*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event) || XEN_FALSE_P(event), event, 2, "gtk_cell_editable_start_editing", "GdkEvent*");
- gtk_cell_editable_start_editing(XEN_TO_C_GtkCellEditable_(cell_editable), XEN_TO_C_GdkEvent_(event));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCellEditable_(cell_editable), cell_editable, 1, "gtk_cell_editable_start_editing", "GtkCellEditable*");
+ Xen_check_type(Xen_is_GdkEvent_(event) || Xen_is_false(event), event, 2, "gtk_cell_editable_start_editing", "GdkEvent*");
+ gtk_cell_editable_start_editing(Xen_to_C_GtkCellEditable_(cell_editable), Xen_to_C_GdkEvent_(event));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_editable_editing_done(XEN cell_editable)
+static Xen gxg_gtk_cell_editable_editing_done(Xen cell_editable)
{
#define H_gtk_cell_editable_editing_done "void gtk_cell_editable_editing_done(GtkCellEditable* cell_editable)"
- XEN_ASSERT_TYPE(XEN_GtkCellEditable__P(cell_editable), cell_editable, 1, "gtk_cell_editable_editing_done", "GtkCellEditable*");
- gtk_cell_editable_editing_done(XEN_TO_C_GtkCellEditable_(cell_editable));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCellEditable_(cell_editable), cell_editable, 1, "gtk_cell_editable_editing_done", "GtkCellEditable*");
+ gtk_cell_editable_editing_done(Xen_to_C_GtkCellEditable_(cell_editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_editable_remove_widget(XEN cell_editable)
+static Xen gxg_gtk_cell_editable_remove_widget(Xen cell_editable)
{
#define H_gtk_cell_editable_remove_widget "void gtk_cell_editable_remove_widget(GtkCellEditable* cell_editable)"
- XEN_ASSERT_TYPE(XEN_GtkCellEditable__P(cell_editable), cell_editable, 1, "gtk_cell_editable_remove_widget", "GtkCellEditable*");
- gtk_cell_editable_remove_widget(XEN_TO_C_GtkCellEditable_(cell_editable));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCellEditable_(cell_editable), cell_editable, 1, "gtk_cell_editable_remove_widget", "GtkCellEditable*");
+ gtk_cell_editable_remove_widget(Xen_to_C_GtkCellEditable_(cell_editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_activate(XEN cell, XEN event, XEN widget, XEN path, XEN background_area, XEN cell_area, XEN flags)
+static Xen gxg_gtk_cell_renderer_activate(Xen cell, Xen event, Xen widget, Xen path, Xen background_area, Xen cell_area, Xen flags)
{
#define H_gtk_cell_renderer_activate "gboolean gtk_cell_renderer_activate(GtkCellRenderer* cell, GdkEvent* event, \
GtkWidget* widget, gchar* path, GdkRectangle* background_area, GdkRectangle* cell_area, GtkCellRendererState flags)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_activate", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 2, "gtk_cell_renderer_activate", "GdkEvent*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 3, "gtk_cell_renderer_activate", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(path), path, 4, "gtk_cell_renderer_activate", "gchar*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(background_area), background_area, 5, "gtk_cell_renderer_activate", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(cell_area), cell_area, 6, "gtk_cell_renderer_activate", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GtkCellRendererState_P(flags), flags, 7, "gtk_cell_renderer_activate", "GtkCellRendererState");
- return(C_TO_XEN_gboolean(gtk_cell_renderer_activate(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GdkEvent_(event), XEN_TO_C_GtkWidget_(widget),
- XEN_TO_C_gchar_(path), XEN_TO_C_GdkRectangle_(background_area), XEN_TO_C_GdkRectangle_(cell_area),
- XEN_TO_C_GtkCellRendererState(flags))));
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_activate", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gtk_cell_renderer_activate", "GdkEvent*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 3, "gtk_cell_renderer_activate", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(path), path, 4, "gtk_cell_renderer_activate", "gchar*");
+ Xen_check_type(Xen_is_GdkRectangle_(background_area), background_area, 5, "gtk_cell_renderer_activate", "GdkRectangle*");
+ Xen_check_type(Xen_is_GdkRectangle_(cell_area), cell_area, 6, "gtk_cell_renderer_activate", "GdkRectangle*");
+ Xen_check_type(Xen_is_GtkCellRendererState(flags), flags, 7, "gtk_cell_renderer_activate", "GtkCellRendererState");
+ return(C_to_Xen_gboolean(gtk_cell_renderer_activate(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_GdkEvent_(event), Xen_to_C_GtkWidget_(widget),
+ Xen_to_C_gchar_(path), Xen_to_C_GdkRectangle_(background_area), Xen_to_C_GdkRectangle_(cell_area),
+ Xen_to_C_GtkCellRendererState(flags))));
}
-static XEN gxg_gtk_cell_renderer_start_editing(XEN cell, XEN event, XEN widget, XEN path, XEN background_area, XEN cell_area, XEN flags)
+static Xen gxg_gtk_cell_renderer_start_editing(Xen cell, Xen event, Xen widget, Xen path, Xen background_area, Xen cell_area, Xen flags)
{
#define H_gtk_cell_renderer_start_editing "GtkCellEditable* gtk_cell_renderer_start_editing(GtkCellRenderer* cell, \
GdkEvent* event, GtkWidget* widget, gchar* path, GdkRectangle* background_area, GdkRectangle* cell_area, \
GtkCellRendererState flags)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_start_editing", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event) || XEN_FALSE_P(event), event, 2, "gtk_cell_renderer_start_editing", "GdkEvent*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 3, "gtk_cell_renderer_start_editing", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(path), path, 4, "gtk_cell_renderer_start_editing", "gchar*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(background_area), background_area, 5, "gtk_cell_renderer_start_editing", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(cell_area), cell_area, 6, "gtk_cell_renderer_start_editing", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GtkCellRendererState_P(flags), flags, 7, "gtk_cell_renderer_start_editing", "GtkCellRendererState");
- return(C_TO_XEN_GtkCellEditable_(gtk_cell_renderer_start_editing(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GdkEvent_(event),
- XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(path), XEN_TO_C_GdkRectangle_(background_area),
- XEN_TO_C_GdkRectangle_(cell_area), XEN_TO_C_GtkCellRendererState(flags))));
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_start_editing", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GdkEvent_(event) || Xen_is_false(event), event, 2, "gtk_cell_renderer_start_editing", "GdkEvent*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 3, "gtk_cell_renderer_start_editing", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(path), path, 4, "gtk_cell_renderer_start_editing", "gchar*");
+ Xen_check_type(Xen_is_GdkRectangle_(background_area), background_area, 5, "gtk_cell_renderer_start_editing", "GdkRectangle*");
+ Xen_check_type(Xen_is_GdkRectangle_(cell_area), cell_area, 6, "gtk_cell_renderer_start_editing", "GdkRectangle*");
+ Xen_check_type(Xen_is_GtkCellRendererState(flags), flags, 7, "gtk_cell_renderer_start_editing", "GtkCellRendererState");
+ return(C_to_Xen_GtkCellEditable_(gtk_cell_renderer_start_editing(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_GdkEvent_(event),
+ Xen_to_C_GtkWidget_(widget), Xen_to_C_gchar_(path), Xen_to_C_GdkRectangle_(background_area),
+ Xen_to_C_GdkRectangle_(cell_area), Xen_to_C_GtkCellRendererState(flags))));
}
-static XEN gxg_gtk_cell_renderer_set_fixed_size(XEN cell, XEN width, XEN height)
+static Xen gxg_gtk_cell_renderer_set_fixed_size(Xen cell, Xen width, Xen height)
{
#define H_gtk_cell_renderer_set_fixed_size "void gtk_cell_renderer_set_fixed_size(GtkCellRenderer* cell, \
gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_set_fixed_size", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_cell_renderer_set_fixed_size", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gtk_cell_renderer_set_fixed_size", "gint");
- gtk_cell_renderer_set_fixed_size(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_set_fixed_size", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_cell_renderer_set_fixed_size", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 3, "gtk_cell_renderer_set_fixed_size", "gint");
+ gtk_cell_renderer_set_fixed_size(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_get_fixed_size(XEN cell, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_cell_renderer_get_fixed_size(Xen cell, Xen ignore_width, Xen ignore_height)
{
#define H_gtk_cell_renderer_get_fixed_size "void gtk_cell_renderer_get_fixed_size(GtkCellRenderer* cell, \
gint* [width], gint* [height])"
gint ref_width;
gint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_fixed_size", "GtkCellRenderer*");
- gtk_cell_renderer_get_fixed_size(XEN_TO_C_GtkCellRenderer_(cell), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_fixed_size", "GtkCellRenderer*");
+ gtk_cell_renderer_get_fixed_size(Xen_to_C_GtkCellRenderer_(cell), &ref_width, &ref_height);
+ return(Xen_list_2(C_to_Xen_gint(ref_width), C_to_Xen_gint(ref_height)));
}
-static XEN gxg_gtk_cell_renderer_pixbuf_new(void)
+static Xen gxg_gtk_cell_renderer_pixbuf_new(void)
{
#define H_gtk_cell_renderer_pixbuf_new "GtkCellRenderer* gtk_cell_renderer_pixbuf_new( void)"
- return(C_TO_XEN_GtkCellRenderer_(gtk_cell_renderer_pixbuf_new()));
+ return(C_to_Xen_GtkCellRenderer_(gtk_cell_renderer_pixbuf_new()));
}
-static XEN gxg_gtk_cell_renderer_text_new(void)
+static Xen gxg_gtk_cell_renderer_text_new(void)
{
#define H_gtk_cell_renderer_text_new "GtkCellRenderer* gtk_cell_renderer_text_new( void)"
- return(C_TO_XEN_GtkCellRenderer_(gtk_cell_renderer_text_new()));
+ return(C_to_Xen_GtkCellRenderer_(gtk_cell_renderer_text_new()));
}
-static XEN gxg_gtk_cell_renderer_text_set_fixed_height_from_font(XEN renderer, XEN number_of_rows)
+static Xen gxg_gtk_cell_renderer_text_set_fixed_height_from_font(Xen renderer, Xen number_of_rows)
{
#define H_gtk_cell_renderer_text_set_fixed_height_from_font "void gtk_cell_renderer_text_set_fixed_height_from_font(GtkCellRendererText* renderer, \
gint number_of_rows)"
- XEN_ASSERT_TYPE(XEN_GtkCellRendererText__P(renderer), renderer, 1, "gtk_cell_renderer_text_set_fixed_height_from_font", "GtkCellRendererText*");
- XEN_ASSERT_TYPE(XEN_gint_P(number_of_rows), number_of_rows, 2, "gtk_cell_renderer_text_set_fixed_height_from_font", "gint");
- gtk_cell_renderer_text_set_fixed_height_from_font(XEN_TO_C_GtkCellRendererText_(renderer), XEN_TO_C_gint(number_of_rows));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCellRendererText_(renderer), renderer, 1, "gtk_cell_renderer_text_set_fixed_height_from_font", "GtkCellRendererText*");
+ Xen_check_type(Xen_is_gint(number_of_rows), number_of_rows, 2, "gtk_cell_renderer_text_set_fixed_height_from_font", "gint");
+ gtk_cell_renderer_text_set_fixed_height_from_font(Xen_to_C_GtkCellRendererText_(renderer), Xen_to_C_gint(number_of_rows));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_toggle_new(void)
+static Xen gxg_gtk_cell_renderer_toggle_new(void)
{
#define H_gtk_cell_renderer_toggle_new "GtkCellRenderer* gtk_cell_renderer_toggle_new( void)"
- return(C_TO_XEN_GtkCellRenderer_(gtk_cell_renderer_toggle_new()));
+ return(C_to_Xen_GtkCellRenderer_(gtk_cell_renderer_toggle_new()));
}
-static XEN gxg_gtk_cell_renderer_toggle_get_radio(XEN toggle)
+static Xen gxg_gtk_cell_renderer_toggle_get_radio(Xen toggle)
{
#define H_gtk_cell_renderer_toggle_get_radio "gboolean gtk_cell_renderer_toggle_get_radio(GtkCellRendererToggle* toggle)"
- XEN_ASSERT_TYPE(XEN_GtkCellRendererToggle__P(toggle), toggle, 1, "gtk_cell_renderer_toggle_get_radio", "GtkCellRendererToggle*");
- return(C_TO_XEN_gboolean(gtk_cell_renderer_toggle_get_radio(XEN_TO_C_GtkCellRendererToggle_(toggle))));
+ Xen_check_type(Xen_is_GtkCellRendererToggle_(toggle), toggle, 1, "gtk_cell_renderer_toggle_get_radio", "GtkCellRendererToggle*");
+ return(C_to_Xen_gboolean(gtk_cell_renderer_toggle_get_radio(Xen_to_C_GtkCellRendererToggle_(toggle))));
}
-static XEN gxg_gtk_cell_renderer_toggle_set_radio(XEN toggle, XEN radio)
+static Xen gxg_gtk_cell_renderer_toggle_set_radio(Xen toggle, Xen radio)
{
#define H_gtk_cell_renderer_toggle_set_radio "void gtk_cell_renderer_toggle_set_radio(GtkCellRendererToggle* toggle, \
gboolean radio)"
- XEN_ASSERT_TYPE(XEN_GtkCellRendererToggle__P(toggle), toggle, 1, "gtk_cell_renderer_toggle_set_radio", "GtkCellRendererToggle*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(radio), radio, 2, "gtk_cell_renderer_toggle_set_radio", "gboolean");
- gtk_cell_renderer_toggle_set_radio(XEN_TO_C_GtkCellRendererToggle_(toggle), XEN_TO_C_gboolean(radio));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCellRendererToggle_(toggle), toggle, 1, "gtk_cell_renderer_toggle_set_radio", "GtkCellRendererToggle*");
+ Xen_check_type(Xen_is_gboolean(radio), radio, 2, "gtk_cell_renderer_toggle_set_radio", "gboolean");
+ gtk_cell_renderer_toggle_set_radio(Xen_to_C_GtkCellRendererToggle_(toggle), Xen_to_C_gboolean(radio));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_toggle_get_active(XEN toggle)
+static Xen gxg_gtk_cell_renderer_toggle_get_active(Xen toggle)
{
#define H_gtk_cell_renderer_toggle_get_active "gboolean gtk_cell_renderer_toggle_get_active(GtkCellRendererToggle* toggle)"
- XEN_ASSERT_TYPE(XEN_GtkCellRendererToggle__P(toggle), toggle, 1, "gtk_cell_renderer_toggle_get_active", "GtkCellRendererToggle*");
- return(C_TO_XEN_gboolean(gtk_cell_renderer_toggle_get_active(XEN_TO_C_GtkCellRendererToggle_(toggle))));
+ Xen_check_type(Xen_is_GtkCellRendererToggle_(toggle), toggle, 1, "gtk_cell_renderer_toggle_get_active", "GtkCellRendererToggle*");
+ return(C_to_Xen_gboolean(gtk_cell_renderer_toggle_get_active(Xen_to_C_GtkCellRendererToggle_(toggle))));
}
-static XEN gxg_gtk_cell_renderer_toggle_set_active(XEN toggle, XEN setting)
+static Xen gxg_gtk_cell_renderer_toggle_set_active(Xen toggle, Xen setting)
{
#define H_gtk_cell_renderer_toggle_set_active "void gtk_cell_renderer_toggle_set_active(GtkCellRendererToggle* toggle, \
gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkCellRendererToggle__P(toggle), toggle, 1, "gtk_cell_renderer_toggle_set_active", "GtkCellRendererToggle*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_cell_renderer_toggle_set_active", "gboolean");
- gtk_cell_renderer_toggle_set_active(XEN_TO_C_GtkCellRendererToggle_(toggle), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCellRendererToggle_(toggle), toggle, 1, "gtk_cell_renderer_toggle_set_active", "GtkCellRendererToggle*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_cell_renderer_toggle_set_active", "gboolean");
+ gtk_cell_renderer_toggle_set_active(Xen_to_C_GtkCellRendererToggle_(toggle), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_check_button_new(void)
+static Xen gxg_gtk_check_button_new(void)
{
#define H_gtk_check_button_new "GtkWidget* gtk_check_button_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_check_button_new()));
+ return(C_to_Xen_GtkWidget_(gtk_check_button_new()));
}
-static XEN gxg_gtk_check_button_new_with_label(XEN label)
+static Xen gxg_gtk_check_button_new_with_label(Xen label)
{
#define H_gtk_check_button_new_with_label "GtkWidget* gtk_check_button_new_with_label(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_check_button_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_check_button_new_with_label(XEN_TO_C_gchar_(label))));
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_check_button_new_with_label", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_check_button_new_with_label(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_check_button_new_with_mnemonic(XEN label)
+static Xen gxg_gtk_check_button_new_with_mnemonic(Xen label)
{
#define H_gtk_check_button_new_with_mnemonic "GtkWidget* gtk_check_button_new_with_mnemonic(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_check_button_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_check_button_new_with_mnemonic(XEN_TO_C_gchar_(label))));
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_check_button_new_with_mnemonic", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_check_button_new_with_mnemonic(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_check_menu_item_new(void)
+static Xen gxg_gtk_check_menu_item_new(void)
{
#define H_gtk_check_menu_item_new "GtkWidget* gtk_check_menu_item_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_check_menu_item_new()));
+ return(C_to_Xen_GtkWidget_(gtk_check_menu_item_new()));
}
-static XEN gxg_gtk_check_menu_item_new_with_label(XEN label)
+static Xen gxg_gtk_check_menu_item_new_with_label(Xen label)
{
#define H_gtk_check_menu_item_new_with_label "GtkWidget* gtk_check_menu_item_new_with_label(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_check_menu_item_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_check_menu_item_new_with_label(XEN_TO_C_gchar_(label))));
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_check_menu_item_new_with_label", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_check_menu_item_new_with_label(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_check_menu_item_new_with_mnemonic(XEN label)
+static Xen gxg_gtk_check_menu_item_new_with_mnemonic(Xen label)
{
#define H_gtk_check_menu_item_new_with_mnemonic "GtkWidget* gtk_check_menu_item_new_with_mnemonic(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_check_menu_item_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_check_menu_item_new_with_mnemonic(XEN_TO_C_gchar_(label))));
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_check_menu_item_new_with_mnemonic", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_check_menu_item_new_with_mnemonic(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_check_menu_item_set_active(XEN check_menu_item, XEN is_active)
+static Xen gxg_gtk_check_menu_item_set_active(Xen check_menu_item, Xen is_active)
{
#define H_gtk_check_menu_item_set_active "void gtk_check_menu_item_set_active(GtkCheckMenuItem* check_menu_item, \
gboolean is_active)"
- XEN_ASSERT_TYPE(XEN_GtkCheckMenuItem__P(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_set_active", "GtkCheckMenuItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_active), is_active, 2, "gtk_check_menu_item_set_active", "gboolean");
- gtk_check_menu_item_set_active(XEN_TO_C_GtkCheckMenuItem_(check_menu_item), XEN_TO_C_gboolean(is_active));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCheckMenuItem_(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_set_active", "GtkCheckMenuItem*");
+ Xen_check_type(Xen_is_gboolean(is_active), is_active, 2, "gtk_check_menu_item_set_active", "gboolean");
+ gtk_check_menu_item_set_active(Xen_to_C_GtkCheckMenuItem_(check_menu_item), Xen_to_C_gboolean(is_active));
+ return(Xen_false);
}
-static XEN gxg_gtk_check_menu_item_get_active(XEN check_menu_item)
+static Xen gxg_gtk_check_menu_item_get_active(Xen check_menu_item)
{
#define H_gtk_check_menu_item_get_active "gboolean gtk_check_menu_item_get_active(GtkCheckMenuItem* check_menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkCheckMenuItem__P(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_get_active", "GtkCheckMenuItem*");
- return(C_TO_XEN_gboolean(gtk_check_menu_item_get_active(XEN_TO_C_GtkCheckMenuItem_(check_menu_item))));
+ Xen_check_type(Xen_is_GtkCheckMenuItem_(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_get_active", "GtkCheckMenuItem*");
+ return(C_to_Xen_gboolean(gtk_check_menu_item_get_active(Xen_to_C_GtkCheckMenuItem_(check_menu_item))));
}
-static XEN gxg_gtk_check_menu_item_toggled(XEN check_menu_item)
+static Xen gxg_gtk_check_menu_item_toggled(Xen check_menu_item)
{
#define H_gtk_check_menu_item_toggled "void gtk_check_menu_item_toggled(GtkCheckMenuItem* check_menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkCheckMenuItem__P(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_toggled", "GtkCheckMenuItem*");
- gtk_check_menu_item_toggled(XEN_TO_C_GtkCheckMenuItem_(check_menu_item));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCheckMenuItem_(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_toggled", "GtkCheckMenuItem*");
+ gtk_check_menu_item_toggled(Xen_to_C_GtkCheckMenuItem_(check_menu_item));
+ return(Xen_false);
}
-static XEN gxg_gtk_check_menu_item_set_inconsistent(XEN check_menu_item, XEN setting)
+static Xen gxg_gtk_check_menu_item_set_inconsistent(Xen check_menu_item, Xen setting)
{
#define H_gtk_check_menu_item_set_inconsistent "void gtk_check_menu_item_set_inconsistent(GtkCheckMenuItem* check_menu_item, \
gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkCheckMenuItem__P(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_set_inconsistent", "GtkCheckMenuItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_check_menu_item_set_inconsistent", "gboolean");
- gtk_check_menu_item_set_inconsistent(XEN_TO_C_GtkCheckMenuItem_(check_menu_item), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkCheckMenuItem_(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_set_inconsistent", "GtkCheckMenuItem*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_check_menu_item_set_inconsistent", "gboolean");
+ gtk_check_menu_item_set_inconsistent(Xen_to_C_GtkCheckMenuItem_(check_menu_item), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_check_menu_item_get_inconsistent(XEN check_menu_item)
+static Xen gxg_gtk_check_menu_item_get_inconsistent(Xen check_menu_item)
{
#define H_gtk_check_menu_item_get_inconsistent "gboolean gtk_check_menu_item_get_inconsistent(GtkCheckMenuItem* check_menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkCheckMenuItem__P(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_get_inconsistent", "GtkCheckMenuItem*");
- return(C_TO_XEN_gboolean(gtk_check_menu_item_get_inconsistent(XEN_TO_C_GtkCheckMenuItem_(check_menu_item))));
+ Xen_check_type(Xen_is_GtkCheckMenuItem_(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_get_inconsistent", "GtkCheckMenuItem*");
+ return(C_to_Xen_gboolean(gtk_check_menu_item_get_inconsistent(Xen_to_C_GtkCheckMenuItem_(check_menu_item))));
}
-static XEN gxg_gtk_clipboard_get(XEN selection)
+static Xen gxg_gtk_clipboard_get(Xen selection)
{
#define H_gtk_clipboard_get "GtkClipboard* gtk_clipboard_get(GdkAtom selection)"
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 1, "gtk_clipboard_get", "GdkAtom");
- return(C_TO_XEN_GtkClipboard_(gtk_clipboard_get(XEN_TO_C_GdkAtom(selection))));
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 1, "gtk_clipboard_get", "GdkAtom");
+ return(C_to_Xen_GtkClipboard_(gtk_clipboard_get(Xen_to_C_GdkAtom(selection))));
}
-static XEN gxg_gtk_clipboard_set_with_data(XEN clipboard, XEN targets, XEN n_targets, XEN func, XEN clear_func, XEN func_info)
+static Xen gxg_gtk_clipboard_set_with_data(Xen clipboard, Xen targets, Xen n_targets, Xen func, Xen clear_func, Xen func_info)
{
#define H_gtk_clipboard_set_with_data "gboolean gtk_clipboard_set_with_data(GtkClipboard* clipboard, \
GtkTargetEntry* targets, guint n_targets, GtkClipboardGetFunc func, GtkClipboardClearFunc clear_func, \
lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_set_with_data", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 2, "gtk_clipboard_set_with_data", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_guint_P(n_targets), n_targets, 3, "gtk_clipboard_set_with_data", "guint");
- XEN_ASSERT_TYPE(XEN_GtkClipboardGetFunc_P(func), func, 4, "gtk_clipboard_set_with_data", "GtkClipboardGetFunc");
- XEN_ASSERT_TYPE(XEN_GtkClipboardClearFunc_P(clear_func), clear_func, 5, "gtk_clipboard_set_with_data", "GtkClipboardClearFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 6, "gtk_clipboard_set_with_data", "lambda_data");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_set_with_data", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 2, "gtk_clipboard_set_with_data", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_guint(n_targets), n_targets, 3, "gtk_clipboard_set_with_data", "guint");
+ Xen_check_type(Xen_is_GtkClipboardGetFunc(func), func, 4, "gtk_clipboard_set_with_data", "GtkClipboardGetFunc");
+ Xen_check_type(Xen_is_GtkClipboardClearFunc(clear_func), clear_func, 5, "gtk_clipboard_set_with_data", "GtkClipboardClearFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 6, "gtk_clipboard_set_with_data", "lambda_data");
{
- XEN result = XEN_FALSE;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen result;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, clear_func);
- result = C_TO_XEN_gboolean(gtk_clipboard_set_with_data(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkTargetEntry_(targets),
- XEN_TO_C_guint(n_targets), XEN_TO_C_GtkClipboardGetFunc(func),
- XEN_TO_C_GtkClipboardClearFunc(clear_func), XEN_TO_C_lambda_data(func_info)));
+ Xen_list_set(gxg_ptr, 2, clear_func);
+ result = C_to_Xen_gboolean(gtk_clipboard_set_with_data(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkTargetEntry_(targets),
+ Xen_to_C_guint(n_targets), Xen_to_C_GtkClipboardGetFunc(func),
+ Xen_to_C_GtkClipboardClearFunc(clear_func), Xen_to_C_lambda_data(func_info)));
return(result);
}
}
-static XEN gxg_gtk_clipboard_get_owner(XEN clipboard)
+static Xen gxg_gtk_clipboard_get_owner(Xen clipboard)
{
#define H_gtk_clipboard_get_owner "GObject* gtk_clipboard_get_owner(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_get_owner", "GtkClipboard*");
- return(C_TO_XEN_GObject_(gtk_clipboard_get_owner(XEN_TO_C_GtkClipboard_(clipboard))));
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_get_owner", "GtkClipboard*");
+ return(C_to_Xen_GObject_(gtk_clipboard_get_owner(Xen_to_C_GtkClipboard_(clipboard))));
}
-static XEN gxg_gtk_clipboard_clear(XEN clipboard)
+static Xen gxg_gtk_clipboard_clear(Xen clipboard)
{
#define H_gtk_clipboard_clear "void gtk_clipboard_clear(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_clear", "GtkClipboard*");
- gtk_clipboard_clear(XEN_TO_C_GtkClipboard_(clipboard));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_clear", "GtkClipboard*");
+ gtk_clipboard_clear(Xen_to_C_GtkClipboard_(clipboard));
+ return(Xen_false);
}
-static XEN gxg_gtk_clipboard_set_text(XEN clipboard, XEN text, XEN len)
+static Xen gxg_gtk_clipboard_set_text(Xen clipboard, Xen text, Xen len)
{
#define H_gtk_clipboard_set_text "void gtk_clipboard_set_text(GtkClipboard* clipboard, gchar* text, \
gint len)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_set_text", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_clipboard_set_text", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 3, "gtk_clipboard_set_text", "gint");
- gtk_clipboard_set_text(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_gchar_(text), XEN_TO_C_gint(len));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_set_text", "GtkClipboard*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_clipboard_set_text", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 3, "gtk_clipboard_set_text", "gint");
+ gtk_clipboard_set_text(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_gchar_(text), Xen_to_C_gint(len));
+ return(Xen_false);
}
-static XEN gxg_gtk_clipboard_request_contents(XEN clipboard, XEN target, XEN func, XEN func_info)
+static Xen gxg_gtk_clipboard_request_contents(Xen clipboard, Xen target, Xen func, Xen func_info)
{
#define H_gtk_clipboard_request_contents "void gtk_clipboard_request_contents(GtkClipboard* clipboard, \
GdkAtom target, GtkClipboardReceivedFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_request_contents", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 2, "gtk_clipboard_request_contents", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GtkClipboardReceivedFunc_P(func), func, 3, "gtk_clipboard_request_contents", "GtkClipboardReceivedFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gtk_clipboard_request_contents", "lambda_data");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_request_contents", "GtkClipboard*");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 2, "gtk_clipboard_request_contents", "GdkAtom");
+ Xen_check_type(Xen_is_GtkClipboardReceivedFunc(func), func, 3, "gtk_clipboard_request_contents", "GtkClipboardReceivedFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "gtk_clipboard_request_contents", "lambda_data");
{
int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_clipboard_request_contents(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GdkAtom(target), XEN_TO_C_GtkClipboardReceivedFunc(func),
- XEN_TO_C_lambda_data(func_info));
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_clipboard_request_contents(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GdkAtom(target), Xen_to_C_GtkClipboardReceivedFunc(func),
+ Xen_to_C_lambda_data(func_info));
xm_unprotect_at(loc);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxg_gtk_clipboard_request_text(XEN clipboard, XEN func, XEN func_info)
+static Xen gxg_gtk_clipboard_request_text(Xen clipboard, Xen func, Xen func_info)
{
#define H_gtk_clipboard_request_text "void gtk_clipboard_request_text(GtkClipboard* clipboard, GtkClipboardTextReceivedFunc func, \
lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_request_text", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkClipboardTextReceivedFunc_P(func), func, 2, "gtk_clipboard_request_text", "GtkClipboardTextReceivedFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_clipboard_request_text", "lambda_data");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_request_text", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkClipboardTextReceivedFunc(func), func, 2, "gtk_clipboard_request_text", "GtkClipboardTextReceivedFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_clipboard_request_text", "lambda_data");
{
int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_clipboard_request_text(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkClipboardTextReceivedFunc(func), XEN_TO_C_lambda_data(func_info));
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_clipboard_request_text(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkClipboardTextReceivedFunc(func), Xen_to_C_lambda_data(func_info));
xm_unprotect_at(loc);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxg_gtk_clipboard_wait_for_contents(XEN clipboard, XEN target)
+static Xen gxg_gtk_clipboard_wait_for_contents(Xen clipboard, Xen target)
{
#define H_gtk_clipboard_wait_for_contents "GtkSelectionData* gtk_clipboard_wait_for_contents(GtkClipboard* clipboard, \
GdkAtom target)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_for_contents", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 2, "gtk_clipboard_wait_for_contents", "GdkAtom");
- return(C_TO_XEN_GtkSelectionData_(gtk_clipboard_wait_for_contents(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GdkAtom(target))));
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_for_contents", "GtkClipboard*");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 2, "gtk_clipboard_wait_for_contents", "GdkAtom");
+ return(C_to_Xen_GtkSelectionData_(gtk_clipboard_wait_for_contents(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GdkAtom(target))));
}
-static XEN gxg_gtk_clipboard_wait_for_text(XEN clipboard)
+static Xen gxg_gtk_clipboard_wait_for_text(Xen clipboard)
{
#define H_gtk_clipboard_wait_for_text "gchar* gtk_clipboard_wait_for_text(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_for_text", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_for_text", "GtkClipboard*");
{
gchar* result;
- XEN rtn;
- result = gtk_clipboard_wait_for_text(XEN_TO_C_GtkClipboard_(clipboard));
- rtn = C_TO_XEN_gchar_(result);
+ Xen rtn;
+ result = gtk_clipboard_wait_for_text(Xen_to_C_GtkClipboard_(clipboard));
+ rtn = C_to_Xen_gchar_(result);
g_free(result);
return(rtn);
}
}
-static XEN gxg_gtk_clipboard_wait_is_text_available(XEN clipboard)
+static Xen gxg_gtk_clipboard_wait_is_text_available(Xen clipboard)
{
#define H_gtk_clipboard_wait_is_text_available "gboolean gtk_clipboard_wait_is_text_available(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_is_text_available", "GtkClipboard*");
- return(C_TO_XEN_gboolean(gtk_clipboard_wait_is_text_available(XEN_TO_C_GtkClipboard_(clipboard))));
-}
-
-static XEN gxg_gtk_color_selection_dialog_new(XEN title)
-{
- #define H_gtk_color_selection_dialog_new "GtkWidget* gtk_color_selection_dialog_new(gchar* title)"
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 1, "gtk_color_selection_dialog_new", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_color_selection_dialog_new(XEN_TO_C_gchar_(title))));
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_is_text_available", "GtkClipboard*");
+ return(C_to_Xen_gboolean(gtk_clipboard_wait_is_text_available(Xen_to_C_GtkClipboard_(clipboard))));
}
-static XEN gxg_gtk_color_selection_new(void)
+static Xen gxg_gtk_container_set_border_width(Xen container, Xen border_width)
{
- #define H_gtk_color_selection_new "GtkWidget* gtk_color_selection_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_color_selection_new()));
+ #define H_gtk_container_set_border_width "void gtk_container_set_border_width(GtkContainer* container, \
+guint border_width)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_set_border_width", "GtkContainer*");
+ Xen_check_type(Xen_is_guint(border_width), border_width, 2, "gtk_container_set_border_width", "guint");
+ gtk_container_set_border_width(Xen_to_C_GtkContainer_(container), Xen_to_C_guint(border_width));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_selection_get_has_opacity_control(XEN colorsel)
+static Xen gxg_gtk_container_get_border_width(Xen container)
{
- #define H_gtk_color_selection_get_has_opacity_control "gboolean gtk_color_selection_get_has_opacity_control(GtkColorSelection* colorsel)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_get_has_opacity_control", "GtkColorSelection*");
- return(C_TO_XEN_gboolean(gtk_color_selection_get_has_opacity_control(XEN_TO_C_GtkColorSelection_(colorsel))));
+ #define H_gtk_container_get_border_width "guint gtk_container_get_border_width(GtkContainer* container)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_get_border_width", "GtkContainer*");
+ return(C_to_Xen_guint(gtk_container_get_border_width(Xen_to_C_GtkContainer_(container))));
}
-static XEN gxg_gtk_color_selection_set_has_opacity_control(XEN colorsel, XEN has_opacity)
+static Xen gxg_gtk_container_add(Xen container, Xen widget)
{
- #define H_gtk_color_selection_set_has_opacity_control "void gtk_color_selection_set_has_opacity_control(GtkColorSelection* colorsel, \
-gboolean has_opacity)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_set_has_opacity_control", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(has_opacity), has_opacity, 2, "gtk_color_selection_set_has_opacity_control", "gboolean");
- gtk_color_selection_set_has_opacity_control(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_gboolean(has_opacity));
- return(XEN_FALSE);
+ #define H_gtk_container_add "void gtk_container_add(GtkContainer* container, GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_add", "GtkContainer*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_container_add", "GtkWidget*");
+ gtk_container_add(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_selection_get_has_palette(XEN colorsel)
+static Xen gxg_gtk_container_remove(Xen container, Xen widget)
{
- #define H_gtk_color_selection_get_has_palette "gboolean gtk_color_selection_get_has_palette(GtkColorSelection* colorsel)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_get_has_palette", "GtkColorSelection*");
- return(C_TO_XEN_gboolean(gtk_color_selection_get_has_palette(XEN_TO_C_GtkColorSelection_(colorsel))));
+ #define H_gtk_container_remove "void gtk_container_remove(GtkContainer* container, GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_remove", "GtkContainer*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_container_remove", "GtkWidget*");
+ gtk_container_remove(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_selection_set_has_palette(XEN colorsel, XEN has_palette)
+static Xen gxg_gtk_container_check_resize(Xen container)
{
- #define H_gtk_color_selection_set_has_palette "void gtk_color_selection_set_has_palette(GtkColorSelection* colorsel, \
-gboolean has_palette)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_set_has_palette", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(has_palette), has_palette, 2, "gtk_color_selection_set_has_palette", "gboolean");
- gtk_color_selection_set_has_palette(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_gboolean(has_palette));
- return(XEN_FALSE);
+ #define H_gtk_container_check_resize "void gtk_container_check_resize(GtkContainer* container)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_check_resize", "GtkContainer*");
+ gtk_container_check_resize(Xen_to_C_GtkContainer_(container));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_selection_set_current_color(XEN colorsel, XEN color)
-{
- #define H_gtk_color_selection_set_current_color "void gtk_color_selection_set_current_color(GtkColorSelection* colorsel, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_set_current_color", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gtk_color_selection_set_current_color", "GdkColor*");
- gtk_color_selection_set_current_color(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_color_selection_set_current_alpha(XEN colorsel, XEN alpha)
-{
- #define H_gtk_color_selection_set_current_alpha "void gtk_color_selection_set_current_alpha(GtkColorSelection* colorsel, \
-guint16 alpha)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_set_current_alpha", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_guint16_P(alpha), alpha, 2, "gtk_color_selection_set_current_alpha", "guint16");
- gtk_color_selection_set_current_alpha(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_guint16(alpha));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_color_selection_get_current_color(XEN colorsel, XEN color)
-{
- #define H_gtk_color_selection_get_current_color "void gtk_color_selection_get_current_color(GtkColorSelection* colorsel, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_get_current_color", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gtk_color_selection_get_current_color", "GdkColor*");
- gtk_color_selection_get_current_color(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_color_selection_get_current_alpha(XEN colorsel)
-{
- #define H_gtk_color_selection_get_current_alpha "guint16 gtk_color_selection_get_current_alpha(GtkColorSelection* colorsel)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_get_current_alpha", "GtkColorSelection*");
- return(C_TO_XEN_guint16(gtk_color_selection_get_current_alpha(XEN_TO_C_GtkColorSelection_(colorsel))));
-}
-
-static XEN gxg_gtk_color_selection_set_previous_color(XEN colorsel, XEN color)
-{
- #define H_gtk_color_selection_set_previous_color "void gtk_color_selection_set_previous_color(GtkColorSelection* colorsel, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_set_previous_color", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gtk_color_selection_set_previous_color", "GdkColor*");
- gtk_color_selection_set_previous_color(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_color_selection_set_previous_alpha(XEN colorsel, XEN alpha)
-{
- #define H_gtk_color_selection_set_previous_alpha "void gtk_color_selection_set_previous_alpha(GtkColorSelection* colorsel, \
-guint16 alpha)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_set_previous_alpha", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_guint16_P(alpha), alpha, 2, "gtk_color_selection_set_previous_alpha", "guint16");
- gtk_color_selection_set_previous_alpha(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_guint16(alpha));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_color_selection_get_previous_color(XEN colorsel, XEN color)
-{
- #define H_gtk_color_selection_get_previous_color "void gtk_color_selection_get_previous_color(GtkColorSelection* colorsel, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_get_previous_color", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gtk_color_selection_get_previous_color", "GdkColor*");
- gtk_color_selection_get_previous_color(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_color_selection_get_previous_alpha(XEN colorsel)
-{
- #define H_gtk_color_selection_get_previous_alpha "guint16 gtk_color_selection_get_previous_alpha(GtkColorSelection* colorsel)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_get_previous_alpha", "GtkColorSelection*");
- return(C_TO_XEN_guint16(gtk_color_selection_get_previous_alpha(XEN_TO_C_GtkColorSelection_(colorsel))));
-}
-
-static XEN gxg_gtk_color_selection_is_adjusting(XEN colorsel)
-{
- #define H_gtk_color_selection_is_adjusting "gboolean gtk_color_selection_is_adjusting(GtkColorSelection* colorsel)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_is_adjusting", "GtkColorSelection*");
- return(C_TO_XEN_gboolean(gtk_color_selection_is_adjusting(XEN_TO_C_GtkColorSelection_(colorsel))));
-}
-
-static XEN gxg_gtk_color_selection_palette_from_string(XEN str, XEN ignore_colors, XEN ignore_n_colors)
-{
- #define H_gtk_color_selection_palette_from_string "gboolean gtk_color_selection_palette_from_string(gchar* str, \
-GdkColor** [colors], gint* [n_colors])"
- GdkColor* ref_colors = NULL;
- gint ref_n_colors;
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 1, "gtk_color_selection_palette_from_string", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_color_selection_palette_from_string(XEN_TO_C_gchar_(str), &ref_colors, &ref_n_colors));
- return(XEN_LIST_3(result, C_TO_XEN_GdkColor_(ref_colors), C_TO_XEN_gint(ref_n_colors)));
- }
-}
-
-static XEN gxg_gtk_color_selection_palette_to_string(XEN colors, XEN n_colors)
-{
- #define H_gtk_color_selection_palette_to_string "gchar* gtk_color_selection_palette_to_string(GdkColor* colors, \
-gint n_colors)"
- XEN_ASSERT_TYPE(XEN_GdkColor__P(colors), colors, 1, "gtk_color_selection_palette_to_string", "GdkColor*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_colors), n_colors, 2, "gtk_color_selection_palette_to_string", "gint");
- {
- gchar* result;
- XEN rtn;
- result = gtk_color_selection_palette_to_string(XEN_TO_C_GdkColor_(colors), XEN_TO_C_gint(n_colors));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
-}
-
-static XEN gxg_gtk_container_set_border_width(XEN container, XEN border_width)
-{
- #define H_gtk_container_set_border_width "void gtk_container_set_border_width(GtkContainer* container, \
-guint border_width)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_set_border_width", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_guint_P(border_width), border_width, 2, "gtk_container_set_border_width", "guint");
- gtk_container_set_border_width(XEN_TO_C_GtkContainer_(container), XEN_TO_C_guint(border_width));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_container_get_border_width(XEN container)
-{
- #define H_gtk_container_get_border_width "guint gtk_container_get_border_width(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_get_border_width", "GtkContainer*");
- return(C_TO_XEN_guint(gtk_container_get_border_width(XEN_TO_C_GtkContainer_(container))));
-}
-
-static XEN gxg_gtk_container_add(XEN container, XEN widget)
-{
- #define H_gtk_container_add "void gtk_container_add(GtkContainer* container, GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_add", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_container_add", "GtkWidget*");
- gtk_container_add(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_container_remove(XEN container, XEN widget)
-{
- #define H_gtk_container_remove "void gtk_container_remove(GtkContainer* container, GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_remove", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_container_remove", "GtkWidget*");
- gtk_container_remove(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_container_set_resize_mode(XEN container, XEN resize_mode)
-{
- #define H_gtk_container_set_resize_mode "void gtk_container_set_resize_mode(GtkContainer* container, \
-GtkResizeMode resize_mode)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_set_resize_mode", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GtkResizeMode_P(resize_mode), resize_mode, 2, "gtk_container_set_resize_mode", "GtkResizeMode");
- gtk_container_set_resize_mode(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GtkResizeMode(resize_mode));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_container_get_resize_mode(XEN container)
-{
- #define H_gtk_container_get_resize_mode "GtkResizeMode gtk_container_get_resize_mode(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_get_resize_mode", "GtkContainer*");
- return(C_TO_XEN_GtkResizeMode(gtk_container_get_resize_mode(XEN_TO_C_GtkContainer_(container))));
-}
-
-static XEN gxg_gtk_container_check_resize(XEN container)
-{
- #define H_gtk_container_check_resize "void gtk_container_check_resize(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_check_resize", "GtkContainer*");
- gtk_container_check_resize(XEN_TO_C_GtkContainer_(container));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_container_foreach(XEN container, XEN func, XEN func_info)
+static Xen gxg_gtk_container_foreach(Xen container, Xen func, Xen func_info)
{
#define H_gtk_container_foreach "void gtk_container_foreach(GtkContainer* container, GtkCallback func, \
lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_foreach", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GtkCallback_P(func), func, 2, "gtk_container_foreach", "GtkCallback");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_container_foreach", "lambda_data");
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_foreach", "GtkContainer*");
+ Xen_check_type(Xen_is_GtkCallback(func), func, 2, "gtk_container_foreach", "GtkCallback");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_container_foreach", "lambda_data");
{
int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_container_foreach(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GtkCallback(func), XEN_TO_C_lambda_data(func_info));
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_container_foreach(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkCallback(func), Xen_to_C_lambda_data(func_info));
xm_unprotect_at(loc);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxg_gtk_container_get_children(XEN container)
+static Xen gxg_gtk_container_get_children(Xen container)
{
#define H_gtk_container_get_children "GList* gtk_container_get_children(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_get_children", "GtkContainer*");
- return(C_TO_XEN_GList_(gtk_container_get_children(XEN_TO_C_GtkContainer_(container))));
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_get_children", "GtkContainer*");
+ return(C_to_Xen_GList_(gtk_container_get_children(Xen_to_C_GtkContainer_(container))));
}
-static XEN gxg_gtk_dialog_new(void)
+static Xen gxg_gtk_dialog_new(void)
{
#define H_gtk_dialog_new "GtkWidget* gtk_dialog_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_dialog_new()));
-}
-
-static XEN gxg_gtk_dialog_new_with_buttons(XEN title, XEN parent, XEN flags, XEN buttons)
-{
- #define H_gtk_dialog_new_with_buttons "GtkWidget* gtk_dialog_new_with_buttons(gchar* title, GtkWindow* parent, \
-GtkDialogFlags flags, etc buttons)"
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 1, "gtk_dialog_new_with_buttons", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(parent) || XEN_FALSE_P(parent), parent, 2, "gtk_dialog_new_with_buttons", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkDialogFlags_P(flags), flags, 3, "gtk_dialog_new_with_buttons", "GtkDialogFlags");
- if (XEN_NOT_BOUND_P(buttons)) buttons = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_etc_P(buttons), buttons, 4, "gtk_dialog_new_with_buttons", "etc");
- {
- int etc_len = 0;
- GtkWidget* result = NULL;
- gchar* p_arg0;
- GtkWindow* p_arg1;
- GtkDialogFlags p_arg2;
- if (XEN_LIST_P(buttons)) etc_len = XEN_LIST_LENGTH(buttons);
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_dialog_new_with_buttons", 3, buttons, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_dialog_new_with_buttons", 3, buttons, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_gchar_(title);
- p_arg1 = XEN_TO_C_GtkWindow_(parent);
- p_arg2 = XEN_TO_C_GtkDialogFlags(flags);
- switch (etc_len)
- {
- case 0: result = gtk_dialog_new_with_buttons(p_arg0, p_arg1, p_arg2, NULL); break;
- case 2: result = gtk_dialog_new_with_buttons(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), NULL); break;
- case 4: result = gtk_dialog_new_with_buttons(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), NULL); break;
- case 6: result = gtk_dialog_new_with_buttons(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), NULL); break;
- case 8: result = gtk_dialog_new_with_buttons(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), XLS(buttons, 6), XLI(buttons, 7), NULL); break;
- case 10: result = gtk_dialog_new_with_buttons(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), XLS(buttons, 6), XLI(buttons, 7), XLS(buttons, 8), XLI(buttons, 9), NULL); break;
- }
- return(C_TO_XEN_GtkWidget_(result));
- }
+ return(C_to_Xen_GtkWidget_(gtk_dialog_new()));
}
-static XEN gxg_gtk_dialog_add_action_widget(XEN dialog, XEN child, XEN response_id)
+static Xen gxg_gtk_dialog_add_action_widget(Xen dialog, Xen child, Xen response_id)
{
#define H_gtk_dialog_add_action_widget "void gtk_dialog_add_action_widget(GtkDialog* dialog, GtkWidget* child, \
gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_add_action_widget", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_dialog_add_action_widget", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 3, "gtk_dialog_add_action_widget", "gint");
- gtk_dialog_add_action_widget(XEN_TO_C_GtkDialog_(dialog), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gint(response_id));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_add_action_widget", "GtkDialog*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_dialog_add_action_widget", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 3, "gtk_dialog_add_action_widget", "gint");
+ gtk_dialog_add_action_widget(Xen_to_C_GtkDialog_(dialog), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(response_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_dialog_add_button(XEN dialog, XEN button_text, XEN response_id)
+static Xen gxg_gtk_dialog_add_button(Xen dialog, Xen button_text, Xen response_id)
{
#define H_gtk_dialog_add_button "GtkWidget* gtk_dialog_add_button(GtkDialog* dialog, gchar* button_text, \
gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_add_button", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(button_text), button_text, 2, "gtk_dialog_add_button", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 3, "gtk_dialog_add_button", "gint");
- return(C_TO_XEN_GtkWidget_(gtk_dialog_add_button(XEN_TO_C_GtkDialog_(dialog), XEN_TO_C_gchar_(button_text), XEN_TO_C_gint(response_id))));
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_add_button", "GtkDialog*");
+ Xen_check_type(Xen_is_gchar_(button_text), button_text, 2, "gtk_dialog_add_button", "gchar*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 3, "gtk_dialog_add_button", "gint");
+ return(C_to_Xen_GtkWidget_(gtk_dialog_add_button(Xen_to_C_GtkDialog_(dialog), Xen_to_C_gchar_(button_text), Xen_to_C_gint(response_id))));
}
-static XEN gxg_gtk_dialog_add_buttons(XEN dialog, XEN buttons)
+static Xen gxg_gtk_dialog_add_buttons(Xen dialog, Xen buttons)
{
#define H_gtk_dialog_add_buttons "void gtk_dialog_add_buttons(GtkDialog* dialog, etc buttons)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_add_buttons", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_etc_P(buttons), buttons, 2, "gtk_dialog_add_buttons", "etc");
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_add_buttons", "GtkDialog*");
+ Xen_check_type(Xen_is_etc(buttons), buttons, 2, "gtk_dialog_add_buttons", "etc");
{
int etc_len = 0;
GtkDialog* p_arg0;
- if (XEN_LIST_P(buttons)) etc_len = XEN_LIST_LENGTH(buttons);
- if (etc_len < 2) XEN_OUT_OF_RANGE_ERROR("gtk_dialog_add_buttons", 1, buttons, "... list must have at least 2 entries");
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_dialog_add_buttons", 1, buttons, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_dialog_add_buttons", 1, buttons, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_GtkDialog_(dialog);
+ if (Xen_is_list(buttons)) etc_len = Xen_list_length(buttons);
+ if (etc_len < 2) Xen_out_of_range_error("gtk_dialog_add_buttons", 1, buttons, "... list must have at least 2 entries");
+ if (etc_len > 10) Xen_out_of_range_error("gtk_dialog_add_buttons", 1, buttons, "... list too long (max len: 10)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_dialog_add_buttons", 1, buttons, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_GtkDialog_(dialog);
switch (etc_len)
{
case 2: gtk_dialog_add_buttons(p_arg0, XLS(buttons, 0), XLI(buttons, 1), NULL); break;
@@ -5136,28414 +4999,28761 @@ static XEN gxg_gtk_dialog_add_buttons(XEN dialog, XEN buttons)
case 8: gtk_dialog_add_buttons(p_arg0, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), XLS(buttons, 6), XLI(buttons, 7), NULL); break;
case 10: gtk_dialog_add_buttons(p_arg0, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), XLS(buttons, 6), XLI(buttons, 7), XLS(buttons, 8), XLI(buttons, 9), NULL); break;
}
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxg_gtk_dialog_set_response_sensitive(XEN dialog, XEN response_id, XEN setting)
+static Xen gxg_gtk_dialog_set_response_sensitive(Xen dialog, Xen response_id, Xen setting)
{
#define H_gtk_dialog_set_response_sensitive "void gtk_dialog_set_response_sensitive(GtkDialog* dialog, \
gint response_id, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_set_response_sensitive", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 2, "gtk_dialog_set_response_sensitive", "gint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 3, "gtk_dialog_set_response_sensitive", "gboolean");
- gtk_dialog_set_response_sensitive(XEN_TO_C_GtkDialog_(dialog), XEN_TO_C_gint(response_id), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_set_response_sensitive", "GtkDialog*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 2, "gtk_dialog_set_response_sensitive", "gint");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 3, "gtk_dialog_set_response_sensitive", "gboolean");
+ gtk_dialog_set_response_sensitive(Xen_to_C_GtkDialog_(dialog), Xen_to_C_gint(response_id), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_dialog_set_default_response(XEN dialog, XEN response_id)
+static Xen gxg_gtk_dialog_set_default_response(Xen dialog, Xen response_id)
{
#define H_gtk_dialog_set_default_response "void gtk_dialog_set_default_response(GtkDialog* dialog, \
gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_set_default_response", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 2, "gtk_dialog_set_default_response", "gint");
- gtk_dialog_set_default_response(XEN_TO_C_GtkDialog_(dialog), XEN_TO_C_gint(response_id));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_set_default_response", "GtkDialog*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 2, "gtk_dialog_set_default_response", "gint");
+ gtk_dialog_set_default_response(Xen_to_C_GtkDialog_(dialog), Xen_to_C_gint(response_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_dialog_response(XEN dialog, XEN response_id)
+static Xen gxg_gtk_dialog_response(Xen dialog, Xen response_id)
{
#define H_gtk_dialog_response "void gtk_dialog_response(GtkDialog* dialog, gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_response", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 2, "gtk_dialog_response", "gint");
- gtk_dialog_response(XEN_TO_C_GtkDialog_(dialog), XEN_TO_C_gint(response_id));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_response", "GtkDialog*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 2, "gtk_dialog_response", "gint");
+ gtk_dialog_response(Xen_to_C_GtkDialog_(dialog), Xen_to_C_gint(response_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_dialog_run(XEN dialog)
+static Xen gxg_gtk_dialog_run(Xen dialog)
{
#define H_gtk_dialog_run "gint gtk_dialog_run(GtkDialog* dialog)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_run", "GtkDialog*");
- return(C_TO_XEN_gint(gtk_dialog_run(XEN_TO_C_GtkDialog_(dialog))));
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_run", "GtkDialog*");
+ return(C_to_Xen_gint(gtk_dialog_run(Xen_to_C_GtkDialog_(dialog))));
}
-static XEN gxg_gtk_drag_get_data(XEN widget, XEN context, XEN target, XEN time)
+static Xen gxg_gtk_drag_get_data(Xen widget, Xen context, Xen target, Xen time)
{
#define H_gtk_drag_get_data "void gtk_drag_get_data(GtkWidget* widget, GdkDragContext* context, GdkAtom target, \
guint32 time)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_get_data", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 2, "gtk_drag_get_data", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 3, "gtk_drag_get_data", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 4, "gtk_drag_get_data", "guint32");
- gtk_drag_get_data(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GdkAtom(target), XEN_TO_C_guint32(time));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_get_data", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 2, "gtk_drag_get_data", "GdkDragContext*");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 3, "gtk_drag_get_data", "GdkAtom");
+ Xen_check_type(Xen_is_guint32(time), time, 4, "gtk_drag_get_data", "guint32");
+ gtk_drag_get_data(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDragContext_(context), Xen_to_C_GdkAtom(target), Xen_to_C_guint32(time));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_finish(XEN context, XEN success, XEN del, XEN time)
+static Xen gxg_gtk_drag_finish(Xen context, Xen success, Xen del, Xen time)
{
#define H_gtk_drag_finish "void gtk_drag_finish(GdkDragContext* context, gboolean success, gboolean del, \
guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_finish", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(success), success, 2, "gtk_drag_finish", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(del), del, 3, "gtk_drag_finish", "gboolean");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 4, "gtk_drag_finish", "guint32");
- gtk_drag_finish(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_gboolean(success), XEN_TO_C_gboolean(del), XEN_TO_C_guint32(time));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_finish", "GdkDragContext*");
+ Xen_check_type(Xen_is_gboolean(success), success, 2, "gtk_drag_finish", "gboolean");
+ Xen_check_type(Xen_is_gboolean(del), del, 3, "gtk_drag_finish", "gboolean");
+ Xen_check_type(Xen_is_guint32(time), time, 4, "gtk_drag_finish", "guint32");
+ gtk_drag_finish(Xen_to_C_GdkDragContext_(context), Xen_to_C_gboolean(success), Xen_to_C_gboolean(del), Xen_to_C_guint32(time));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_get_source_widget(XEN context)
+static Xen gxg_gtk_drag_get_source_widget(Xen context)
{
#define H_gtk_drag_get_source_widget "GtkWidget* gtk_drag_get_source_widget(GdkDragContext* context)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_get_source_widget", "GdkDragContext*");
- return(C_TO_XEN_GtkWidget_(gtk_drag_get_source_widget(XEN_TO_C_GdkDragContext_(context))));
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_get_source_widget", "GdkDragContext*");
+ return(C_to_Xen_GtkWidget_(gtk_drag_get_source_widget(Xen_to_C_GdkDragContext_(context))));
}
-static XEN gxg_gtk_drag_highlight(XEN widget)
+static Xen gxg_gtk_drag_highlight(Xen widget)
{
#define H_gtk_drag_highlight "void gtk_drag_highlight(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_highlight", "GtkWidget*");
- gtk_drag_highlight(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_highlight", "GtkWidget*");
+ gtk_drag_highlight(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_unhighlight(XEN widget)
+static Xen gxg_gtk_drag_unhighlight(Xen widget)
{
#define H_gtk_drag_unhighlight "void gtk_drag_unhighlight(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_unhighlight", "GtkWidget*");
- gtk_drag_unhighlight(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_unhighlight", "GtkWidget*");
+ gtk_drag_unhighlight(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_dest_set(XEN widget, XEN flags, XEN targets, XEN n_targets, XEN actions)
+static Xen gxg_gtk_drag_dest_set(Xen widget, Xen flags, Xen targets, Xen n_targets, Xen actions)
{
#define H_gtk_drag_dest_set "void gtk_drag_dest_set(GtkWidget* widget, GtkDestDefaults flags, GtkTargetEntry* targets, \
gint n_targets, GdkDragAction actions)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_set", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkDestDefaults_P(flags), flags, 2, "gtk_drag_dest_set", "GtkDestDefaults");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 3, "gtk_drag_dest_set", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 4, "gtk_drag_dest_set", "gint");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 5, "gtk_drag_dest_set", "GdkDragAction");
- gtk_drag_dest_set(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkDestDefaults(flags), XEN_TO_C_GtkTargetEntry_(targets), XEN_TO_C_gint(n_targets),
- XEN_TO_C_GdkDragAction(actions));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_set", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkDestDefaults(flags), flags, 2, "gtk_drag_dest_set", "GtkDestDefaults");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 3, "gtk_drag_dest_set", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 4, "gtk_drag_dest_set", "gint");
+ Xen_check_type(Xen_is_GdkDragAction(actions), actions, 5, "gtk_drag_dest_set", "GdkDragAction");
+ gtk_drag_dest_set(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkDestDefaults(flags), Xen_to_C_GtkTargetEntry_(targets), Xen_to_C_gint(n_targets),
+ Xen_to_C_GdkDragAction(actions));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_dest_unset(XEN widget)
+static Xen gxg_gtk_drag_dest_unset(Xen widget)
{
#define H_gtk_drag_dest_unset "void gtk_drag_dest_unset(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_unset", "GtkWidget*");
- gtk_drag_dest_unset(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_unset", "GtkWidget*");
+ gtk_drag_dest_unset(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_dest_find_target(XEN widget, XEN context, XEN target_list)
+static Xen gxg_gtk_drag_dest_find_target(Xen widget, Xen context, Xen target_list)
{
#define H_gtk_drag_dest_find_target "GdkAtom gtk_drag_dest_find_target(GtkWidget* widget, GdkDragContext* context, \
GtkTargetList* target_list)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_find_target", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 2, "gtk_drag_dest_find_target", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(target_list) || XEN_FALSE_P(target_list), target_list, 3, "gtk_drag_dest_find_target", "GtkTargetList*");
- return(C_TO_XEN_GdkAtom(gtk_drag_dest_find_target(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GtkTargetList_(target_list))));
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_find_target", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 2, "gtk_drag_dest_find_target", "GdkDragContext*");
+ Xen_check_type(Xen_is_GtkTargetList_(target_list) || Xen_is_false(target_list), target_list, 3, "gtk_drag_dest_find_target", "GtkTargetList*");
+ return(C_to_Xen_GdkAtom(gtk_drag_dest_find_target(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDragContext_(context), Xen_to_C_GtkTargetList_(target_list))));
}
-static XEN gxg_gtk_drag_dest_get_target_list(XEN widget)
+static Xen gxg_gtk_drag_dest_get_target_list(Xen widget)
{
#define H_gtk_drag_dest_get_target_list "GtkTargetList* gtk_drag_dest_get_target_list(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_get_target_list", "GtkWidget*");
- return(C_TO_XEN_GtkTargetList_(gtk_drag_dest_get_target_list(XEN_TO_C_GtkWidget_(widget))));
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_get_target_list", "GtkWidget*");
+ return(C_to_Xen_GtkTargetList_(gtk_drag_dest_get_target_list(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_drag_dest_set_target_list(XEN widget, XEN target_list)
+static Xen gxg_gtk_drag_dest_set_target_list(Xen widget, Xen target_list)
{
#define H_gtk_drag_dest_set_target_list "void gtk_drag_dest_set_target_list(GtkWidget* widget, GtkTargetList* target_list)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_set_target_list", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(target_list) || XEN_FALSE_P(target_list), target_list, 2, "gtk_drag_dest_set_target_list", "GtkTargetList*");
- gtk_drag_dest_set_target_list(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkTargetList_(target_list));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_set_target_list", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkTargetList_(target_list) || Xen_is_false(target_list), target_list, 2, "gtk_drag_dest_set_target_list", "GtkTargetList*");
+ gtk_drag_dest_set_target_list(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkTargetList_(target_list));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_source_set(XEN widget, XEN start_button_mask, XEN targets, XEN n_targets, XEN actions)
+static Xen gxg_gtk_drag_source_set(Xen widget, Xen start_button_mask, Xen targets, Xen n_targets, Xen actions)
{
#define H_gtk_drag_source_set "void gtk_drag_source_set(GtkWidget* widget, GdkModifierType start_button_mask, \
GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_set", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(start_button_mask), start_button_mask, 2, "gtk_drag_source_set", "GdkModifierType");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 3, "gtk_drag_source_set", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 4, "gtk_drag_source_set", "gint");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 5, "gtk_drag_source_set", "GdkDragAction");
- gtk_drag_source_set(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkModifierType(start_button_mask), XEN_TO_C_GtkTargetEntry_(targets),
- XEN_TO_C_gint(n_targets), XEN_TO_C_GdkDragAction(actions));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_set", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkModifierType(start_button_mask), start_button_mask, 2, "gtk_drag_source_set", "GdkModifierType");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 3, "gtk_drag_source_set", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 4, "gtk_drag_source_set", "gint");
+ Xen_check_type(Xen_is_GdkDragAction(actions), actions, 5, "gtk_drag_source_set", "GdkDragAction");
+ gtk_drag_source_set(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkModifierType(start_button_mask), Xen_to_C_GtkTargetEntry_(targets),
+ Xen_to_C_gint(n_targets), Xen_to_C_GdkDragAction(actions));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_source_unset(XEN widget)
+static Xen gxg_gtk_drag_source_unset(Xen widget)
{
#define H_gtk_drag_source_unset "void gtk_drag_source_unset(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_unset", "GtkWidget*");
- gtk_drag_source_unset(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_unset", "GtkWidget*");
+ gtk_drag_source_unset(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_source_set_icon_pixbuf(XEN widget, XEN pixbuf)
+static Xen gxg_gtk_drag_source_set_icon_pixbuf(Xen widget, Xen pixbuf)
{
#define H_gtk_drag_source_set_icon_pixbuf "void gtk_drag_source_set_icon_pixbuf(GtkWidget* widget, \
GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_set_icon_pixbuf", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gtk_drag_source_set_icon_pixbuf", "GdkPixbuf*");
- gtk_drag_source_set_icon_pixbuf(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_drag_source_set_icon_stock(XEN widget, XEN stock_id)
-{
- #define H_gtk_drag_source_set_icon_stock "void gtk_drag_source_set_icon_stock(GtkWidget* widget, gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_set_icon_stock", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_drag_source_set_icon_stock", "gchar*");
- gtk_drag_source_set_icon_stock(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(stock_id));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_drag_begin(XEN widget, XEN targets, XEN actions, XEN button, XEN event)
-{
- #define H_gtk_drag_begin "GdkDragContext* gtk_drag_begin(GtkWidget* widget, GtkTargetList* targets, \
-GdkDragAction actions, gint button, GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_begin", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(targets), targets, 2, "gtk_drag_begin", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 3, "gtk_drag_begin", "GdkDragAction");
- XEN_ASSERT_TYPE(XEN_gint_P(button), button, 4, "gtk_drag_begin", "gint");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 5, "gtk_drag_begin", "GdkEvent*");
- return(C_TO_XEN_GdkDragContext_(gtk_drag_begin(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkTargetList_(targets), XEN_TO_C_GdkDragAction(actions),
- XEN_TO_C_gint(button), XEN_TO_C_GdkEvent_(event))));
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_set_icon_pixbuf", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 2, "gtk_drag_source_set_icon_pixbuf", "GdkPixbuf*");
+ gtk_drag_source_set_icon_pixbuf(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkPixbuf_(pixbuf));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_set_icon_widget(XEN context, XEN widget, XEN hot_x, XEN hot_y)
+static Xen gxg_gtk_drag_set_icon_widget(Xen context, Xen widget, Xen hot_x, Xen hot_y)
{
#define H_gtk_drag_set_icon_widget "void gtk_drag_set_icon_widget(GdkDragContext* context, GtkWidget* widget, \
gint hot_x, gint hot_y)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_set_icon_widget", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_drag_set_icon_widget", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_x), hot_x, 3, "gtk_drag_set_icon_widget", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_y), hot_y, 4, "gtk_drag_set_icon_widget", "gint");
- gtk_drag_set_icon_widget(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(hot_x), XEN_TO_C_gint(hot_y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_set_icon_widget", "GdkDragContext*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_drag_set_icon_widget", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(hot_x), hot_x, 3, "gtk_drag_set_icon_widget", "gint");
+ Xen_check_type(Xen_is_gint(hot_y), hot_y, 4, "gtk_drag_set_icon_widget", "gint");
+ gtk_drag_set_icon_widget(Xen_to_C_GdkDragContext_(context), Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(hot_x), Xen_to_C_gint(hot_y));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_set_icon_pixbuf(XEN context, XEN pixbuf, XEN hot_x, XEN hot_y)
+static Xen gxg_gtk_drag_set_icon_pixbuf(Xen context, Xen pixbuf, Xen hot_x, Xen hot_y)
{
#define H_gtk_drag_set_icon_pixbuf "void gtk_drag_set_icon_pixbuf(GdkDragContext* context, GdkPixbuf* pixbuf, \
gint hot_x, gint hot_y)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_set_icon_pixbuf", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gtk_drag_set_icon_pixbuf", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_x), hot_x, 3, "gtk_drag_set_icon_pixbuf", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_y), hot_y, 4, "gtk_drag_set_icon_pixbuf", "gint");
- gtk_drag_set_icon_pixbuf(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_gint(hot_x), XEN_TO_C_gint(hot_y));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_drag_set_icon_stock(XEN context, XEN stock_id, XEN hot_x, XEN hot_y)
-{
- #define H_gtk_drag_set_icon_stock "void gtk_drag_set_icon_stock(GdkDragContext* context, gchar* stock_id, \
-gint hot_x, gint hot_y)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_set_icon_stock", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_drag_set_icon_stock", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_x), hot_x, 3, "gtk_drag_set_icon_stock", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_y), hot_y, 4, "gtk_drag_set_icon_stock", "gint");
- gtk_drag_set_icon_stock(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_gchar_(stock_id), XEN_TO_C_gint(hot_x), XEN_TO_C_gint(hot_y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_set_icon_pixbuf", "GdkDragContext*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 2, "gtk_drag_set_icon_pixbuf", "GdkPixbuf*");
+ Xen_check_type(Xen_is_gint(hot_x), hot_x, 3, "gtk_drag_set_icon_pixbuf", "gint");
+ Xen_check_type(Xen_is_gint(hot_y), hot_y, 4, "gtk_drag_set_icon_pixbuf", "gint");
+ gtk_drag_set_icon_pixbuf(Xen_to_C_GdkDragContext_(context), Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_gint(hot_x), Xen_to_C_gint(hot_y));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_set_icon_default(XEN context)
+static Xen gxg_gtk_drag_set_icon_default(Xen context)
{
#define H_gtk_drag_set_icon_default "void gtk_drag_set_icon_default(GdkDragContext* context)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_set_icon_default", "GdkDragContext*");
- gtk_drag_set_icon_default(XEN_TO_C_GdkDragContext_(context));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_set_icon_default", "GdkDragContext*");
+ gtk_drag_set_icon_default(Xen_to_C_GdkDragContext_(context));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_check_threshold(XEN widget, XEN start_x, XEN start_y, XEN current_x, XEN current_y)
+static Xen gxg_gtk_drag_check_threshold(Xen widget, Xen start_x, Xen start_y, Xen current_x, Xen current_y)
{
#define H_gtk_drag_check_threshold "gboolean gtk_drag_check_threshold(GtkWidget* widget, gint start_x, \
gint start_y, gint current_x, gint current_y)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_check_threshold", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(start_x), start_x, 2, "gtk_drag_check_threshold", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(start_y), start_y, 3, "gtk_drag_check_threshold", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(current_x), current_x, 4, "gtk_drag_check_threshold", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(current_y), current_y, 5, "gtk_drag_check_threshold", "gint");
- return(C_TO_XEN_gboolean(gtk_drag_check_threshold(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(start_x), XEN_TO_C_gint(start_y),
- XEN_TO_C_gint(current_x), XEN_TO_C_gint(current_y))));
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_check_threshold", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(start_x), start_x, 2, "gtk_drag_check_threshold", "gint");
+ Xen_check_type(Xen_is_gint(start_y), start_y, 3, "gtk_drag_check_threshold", "gint");
+ Xen_check_type(Xen_is_gint(current_x), current_x, 4, "gtk_drag_check_threshold", "gint");
+ Xen_check_type(Xen_is_gint(current_y), current_y, 5, "gtk_drag_check_threshold", "gint");
+ return(C_to_Xen_gboolean(gtk_drag_check_threshold(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(start_x), Xen_to_C_gint(start_y),
+ Xen_to_C_gint(current_x), Xen_to_C_gint(current_y))));
}
-static XEN gxg_gtk_drawing_area_new(void)
+static Xen gxg_gtk_drawing_area_new(void)
{
#define H_gtk_drawing_area_new "GtkWidget* gtk_drawing_area_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_drawing_area_new()));
+ return(C_to_Xen_GtkWidget_(gtk_drawing_area_new()));
}
-static XEN gxg_gtk_editable_select_region(XEN editable, XEN start, XEN end)
+static Xen gxg_gtk_editable_select_region(Xen editable, Xen start, Xen end)
{
#define H_gtk_editable_select_region "void gtk_editable_select_region(GtkEditable* editable, gint start, \
gint end)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_select_region", "GtkEditable*");
- XEN_ASSERT_TYPE(XEN_gint_P(start), start, 2, "gtk_editable_select_region", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(end), end, 3, "gtk_editable_select_region", "gint");
- gtk_editable_select_region(XEN_TO_C_GtkEditable_(editable), XEN_TO_C_gint(start), XEN_TO_C_gint(end));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_select_region", "GtkEditable*");
+ Xen_check_type(Xen_is_gint(start), start, 2, "gtk_editable_select_region", "gint");
+ Xen_check_type(Xen_is_gint(end), end, 3, "gtk_editable_select_region", "gint");
+ gtk_editable_select_region(Xen_to_C_GtkEditable_(editable), Xen_to_C_gint(start), Xen_to_C_gint(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_editable_get_selection_bounds(XEN editable, XEN ignore_start, XEN ignore_end)
+static Xen gxg_gtk_editable_get_selection_bounds(Xen editable, Xen ignore_start, Xen ignore_end)
{
#define H_gtk_editable_get_selection_bounds "gboolean gtk_editable_get_selection_bounds(GtkEditable* editable, \
gint* [start], gint* [end])"
gint ref_start;
gint ref_end;
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_get_selection_bounds", "GtkEditable*");
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_get_selection_bounds", "GtkEditable*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_editable_get_selection_bounds(XEN_TO_C_GtkEditable_(editable), &ref_start, &ref_end));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_start), C_TO_XEN_gint(ref_end)));
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_editable_get_selection_bounds(Xen_to_C_GtkEditable_(editable), &ref_start, &ref_end));
+ return(Xen_list_3(result, C_to_Xen_gint(ref_start), C_to_Xen_gint(ref_end)));
}
}
-static XEN gxg_gtk_editable_insert_text(XEN editable, XEN new_text, XEN new_text_length, XEN ignore_position)
+static Xen gxg_gtk_editable_insert_text(Xen editable, Xen new_text, Xen new_text_length, Xen ignore_position)
{
#define H_gtk_editable_insert_text "void gtk_editable_insert_text(GtkEditable* editable, gchar* new_text, \
gint new_text_length, gint* [position])"
gint ref_position;
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_insert_text", "GtkEditable*");
- XEN_ASSERT_TYPE(XEN_gchar__P(new_text), new_text, 2, "gtk_editable_insert_text", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(new_text_length), new_text_length, 3, "gtk_editable_insert_text", "gint");
- gtk_editable_insert_text(XEN_TO_C_GtkEditable_(editable), XEN_TO_C_gchar_(new_text), XEN_TO_C_gint(new_text_length), &ref_position);
- return(XEN_LIST_1(C_TO_XEN_gint(ref_position)));
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_insert_text", "GtkEditable*");
+ Xen_check_type(Xen_is_gchar_(new_text), new_text, 2, "gtk_editable_insert_text", "gchar*");
+ Xen_check_type(Xen_is_gint(new_text_length), new_text_length, 3, "gtk_editable_insert_text", "gint");
+ gtk_editable_insert_text(Xen_to_C_GtkEditable_(editable), Xen_to_C_gchar_(new_text), Xen_to_C_gint(new_text_length), &ref_position);
+ return(Xen_list_1(C_to_Xen_gint(ref_position)));
}
-static XEN gxg_gtk_editable_delete_text(XEN editable, XEN start_pos, XEN end_pos)
+static Xen gxg_gtk_editable_delete_text(Xen editable, Xen start_pos, Xen end_pos)
{
#define H_gtk_editable_delete_text "void gtk_editable_delete_text(GtkEditable* editable, gint start_pos, \
gint end_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_delete_text", "GtkEditable*");
- XEN_ASSERT_TYPE(XEN_gint_P(start_pos), start_pos, 2, "gtk_editable_delete_text", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(end_pos), end_pos, 3, "gtk_editable_delete_text", "gint");
- gtk_editable_delete_text(XEN_TO_C_GtkEditable_(editable), XEN_TO_C_gint(start_pos), XEN_TO_C_gint(end_pos));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_delete_text", "GtkEditable*");
+ Xen_check_type(Xen_is_gint(start_pos), start_pos, 2, "gtk_editable_delete_text", "gint");
+ Xen_check_type(Xen_is_gint(end_pos), end_pos, 3, "gtk_editable_delete_text", "gint");
+ gtk_editable_delete_text(Xen_to_C_GtkEditable_(editable), Xen_to_C_gint(start_pos), Xen_to_C_gint(end_pos));
+ return(Xen_false);
}
-static XEN gxg_gtk_editable_get_chars(XEN editable, XEN start_pos, XEN end_pos)
+static Xen gxg_gtk_editable_get_chars(Xen editable, Xen start_pos, Xen end_pos)
{
#define H_gtk_editable_get_chars "gchar* gtk_editable_get_chars(GtkEditable* editable, gint start_pos, \
gint end_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_get_chars", "GtkEditable*");
- XEN_ASSERT_TYPE(XEN_gint_P(start_pos), start_pos, 2, "gtk_editable_get_chars", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(end_pos), end_pos, 3, "gtk_editable_get_chars", "gint");
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_get_chars", "GtkEditable*");
+ Xen_check_type(Xen_is_gint(start_pos), start_pos, 2, "gtk_editable_get_chars", "gint");
+ Xen_check_type(Xen_is_gint(end_pos), end_pos, 3, "gtk_editable_get_chars", "gint");
{
gchar* result;
- XEN rtn;
- result = gtk_editable_get_chars(XEN_TO_C_GtkEditable_(editable), XEN_TO_C_gint(start_pos),
- XEN_TO_C_gint(end_pos));
- rtn = C_TO_XEN_gchar_(result);
+ Xen rtn;
+ result = gtk_editable_get_chars(Xen_to_C_GtkEditable_(editable), Xen_to_C_gint(start_pos),
+ Xen_to_C_gint(end_pos));
+ rtn = C_to_Xen_gchar_(result);
g_free(result);
return(rtn);
}
}
-static XEN gxg_gtk_editable_cut_clipboard(XEN editable)
+static Xen gxg_gtk_editable_cut_clipboard(Xen editable)
{
#define H_gtk_editable_cut_clipboard "void gtk_editable_cut_clipboard(GtkEditable* editable)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_cut_clipboard", "GtkEditable*");
- gtk_editable_cut_clipboard(XEN_TO_C_GtkEditable_(editable));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_cut_clipboard", "GtkEditable*");
+ gtk_editable_cut_clipboard(Xen_to_C_GtkEditable_(editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_editable_copy_clipboard(XEN editable)
+static Xen gxg_gtk_editable_copy_clipboard(Xen editable)
{
#define H_gtk_editable_copy_clipboard "void gtk_editable_copy_clipboard(GtkEditable* editable)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_copy_clipboard", "GtkEditable*");
- gtk_editable_copy_clipboard(XEN_TO_C_GtkEditable_(editable));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_copy_clipboard", "GtkEditable*");
+ gtk_editable_copy_clipboard(Xen_to_C_GtkEditable_(editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_editable_paste_clipboard(XEN editable)
+static Xen gxg_gtk_editable_paste_clipboard(Xen editable)
{
#define H_gtk_editable_paste_clipboard "void gtk_editable_paste_clipboard(GtkEditable* editable)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_paste_clipboard", "GtkEditable*");
- gtk_editable_paste_clipboard(XEN_TO_C_GtkEditable_(editable));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_paste_clipboard", "GtkEditable*");
+ gtk_editable_paste_clipboard(Xen_to_C_GtkEditable_(editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_editable_delete_selection(XEN editable)
+static Xen gxg_gtk_editable_delete_selection(Xen editable)
{
#define H_gtk_editable_delete_selection "void gtk_editable_delete_selection(GtkEditable* editable)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_delete_selection", "GtkEditable*");
- gtk_editable_delete_selection(XEN_TO_C_GtkEditable_(editable));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_delete_selection", "GtkEditable*");
+ gtk_editable_delete_selection(Xen_to_C_GtkEditable_(editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_editable_set_position(XEN editable, XEN position)
+static Xen gxg_gtk_editable_set_position(Xen editable, Xen position)
{
#define H_gtk_editable_set_position "void gtk_editable_set_position(GtkEditable* editable, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_set_position", "GtkEditable*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 2, "gtk_editable_set_position", "gint");
- gtk_editable_set_position(XEN_TO_C_GtkEditable_(editable), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_set_position", "GtkEditable*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_editable_set_position", "gint");
+ gtk_editable_set_position(Xen_to_C_GtkEditable_(editable), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_editable_get_position(XEN editable)
+static Xen gxg_gtk_editable_get_position(Xen editable)
{
#define H_gtk_editable_get_position "gint gtk_editable_get_position(GtkEditable* editable)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_get_position", "GtkEditable*");
- return(C_TO_XEN_gint(gtk_editable_get_position(XEN_TO_C_GtkEditable_(editable))));
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_get_position", "GtkEditable*");
+ return(C_to_Xen_gint(gtk_editable_get_position(Xen_to_C_GtkEditable_(editable))));
}
-static XEN gxg_gtk_editable_set_editable(XEN editable, XEN is_editable)
+static Xen gxg_gtk_editable_set_editable(Xen editable, Xen is_editable)
{
#define H_gtk_editable_set_editable "void gtk_editable_set_editable(GtkEditable* editable, gboolean is_editable)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_set_editable", "GtkEditable*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_editable), is_editable, 2, "gtk_editable_set_editable", "gboolean");
- gtk_editable_set_editable(XEN_TO_C_GtkEditable_(editable), XEN_TO_C_gboolean(is_editable));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_set_editable", "GtkEditable*");
+ Xen_check_type(Xen_is_gboolean(is_editable), is_editable, 2, "gtk_editable_set_editable", "gboolean");
+ gtk_editable_set_editable(Xen_to_C_GtkEditable_(editable), Xen_to_C_gboolean(is_editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_editable_get_editable(XEN editable)
+static Xen gxg_gtk_editable_get_editable(Xen editable)
{
#define H_gtk_editable_get_editable "gboolean gtk_editable_get_editable(GtkEditable* editable)"
- XEN_ASSERT_TYPE(XEN_GtkEditable__P(editable), editable, 1, "gtk_editable_get_editable", "GtkEditable*");
- return(C_TO_XEN_gboolean(gtk_editable_get_editable(XEN_TO_C_GtkEditable_(editable))));
+ Xen_check_type(Xen_is_GtkEditable_(editable), editable, 1, "gtk_editable_get_editable", "GtkEditable*");
+ return(C_to_Xen_gboolean(gtk_editable_get_editable(Xen_to_C_GtkEditable_(editable))));
}
-static XEN gxg_gtk_entry_new(void)
+static Xen gxg_gtk_entry_new(void)
{
#define H_gtk_entry_new "GtkWidget* gtk_entry_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_entry_new()));
+ return(C_to_Xen_GtkWidget_(gtk_entry_new()));
}
-static XEN gxg_gtk_entry_set_visibility(XEN entry, XEN visible)
+static Xen gxg_gtk_entry_set_visibility(Xen entry, Xen visible)
{
#define H_gtk_entry_set_visibility "void gtk_entry_set_visibility(GtkEntry* entry, gboolean visible)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_visibility", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible), visible, 2, "gtk_entry_set_visibility", "gboolean");
- gtk_entry_set_visibility(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gboolean(visible));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_visibility", "GtkEntry*");
+ Xen_check_type(Xen_is_gboolean(visible), visible, 2, "gtk_entry_set_visibility", "gboolean");
+ gtk_entry_set_visibility(Xen_to_C_GtkEntry_(entry), Xen_to_C_gboolean(visible));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_visibility(XEN entry)
+static Xen gxg_gtk_entry_get_visibility(Xen entry)
{
#define H_gtk_entry_get_visibility "gboolean gtk_entry_get_visibility(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_visibility", "GtkEntry*");
- return(C_TO_XEN_gboolean(gtk_entry_get_visibility(XEN_TO_C_GtkEntry_(entry))));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_visibility", "GtkEntry*");
+ return(C_to_Xen_gboolean(gtk_entry_get_visibility(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_entry_set_invisible_char(XEN entry, XEN ch)
+static Xen gxg_gtk_entry_set_invisible_char(Xen entry, Xen ch)
{
#define H_gtk_entry_set_invisible_char "void gtk_entry_set_invisible_char(GtkEntry* entry, gunichar ch)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_invisible_char", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gunichar_P(ch), ch, 2, "gtk_entry_set_invisible_char", "gunichar");
- gtk_entry_set_invisible_char(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gunichar(ch));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_invisible_char", "GtkEntry*");
+ Xen_check_type(Xen_is_gunichar(ch), ch, 2, "gtk_entry_set_invisible_char", "gunichar");
+ gtk_entry_set_invisible_char(Xen_to_C_GtkEntry_(entry), Xen_to_C_gunichar(ch));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_invisible_char(XEN entry)
+static Xen gxg_gtk_entry_get_invisible_char(Xen entry)
{
#define H_gtk_entry_get_invisible_char "gunichar gtk_entry_get_invisible_char(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_invisible_char", "GtkEntry*");
- return(C_TO_XEN_gunichar(gtk_entry_get_invisible_char(XEN_TO_C_GtkEntry_(entry))));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_invisible_char", "GtkEntry*");
+ return(C_to_Xen_gunichar(gtk_entry_get_invisible_char(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_entry_set_has_frame(XEN entry, XEN setting)
+static Xen gxg_gtk_entry_set_has_frame(Xen entry, Xen setting)
{
#define H_gtk_entry_set_has_frame "void gtk_entry_set_has_frame(GtkEntry* entry, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_has_frame", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_entry_set_has_frame", "gboolean");
- gtk_entry_set_has_frame(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_has_frame", "GtkEntry*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_entry_set_has_frame", "gboolean");
+ gtk_entry_set_has_frame(Xen_to_C_GtkEntry_(entry), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_has_frame(XEN entry)
+static Xen gxg_gtk_entry_get_has_frame(Xen entry)
{
#define H_gtk_entry_get_has_frame "gboolean gtk_entry_get_has_frame(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_has_frame", "GtkEntry*");
- return(C_TO_XEN_gboolean(gtk_entry_get_has_frame(XEN_TO_C_GtkEntry_(entry))));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_has_frame", "GtkEntry*");
+ return(C_to_Xen_gboolean(gtk_entry_get_has_frame(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_entry_set_max_length(XEN entry, XEN max)
+static Xen gxg_gtk_entry_set_max_length(Xen entry, Xen max)
{
#define H_gtk_entry_set_max_length "void gtk_entry_set_max_length(GtkEntry* entry, gint max)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_max_length", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(max), max, 2, "gtk_entry_set_max_length", "gint");
- gtk_entry_set_max_length(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gint(max));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_max_length", "GtkEntry*");
+ Xen_check_type(Xen_is_gint(max), max, 2, "gtk_entry_set_max_length", "gint");
+ gtk_entry_set_max_length(Xen_to_C_GtkEntry_(entry), Xen_to_C_gint(max));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_max_length(XEN entry)
+static Xen gxg_gtk_entry_get_max_length(Xen entry)
{
#define H_gtk_entry_get_max_length "gint gtk_entry_get_max_length(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_max_length", "GtkEntry*");
- return(C_TO_XEN_gint(gtk_entry_get_max_length(XEN_TO_C_GtkEntry_(entry))));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_max_length", "GtkEntry*");
+ return(C_to_Xen_gint(gtk_entry_get_max_length(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_entry_set_activates_default(XEN entry, XEN setting)
+static Xen gxg_gtk_entry_set_activates_default(Xen entry, Xen setting)
{
#define H_gtk_entry_set_activates_default "void gtk_entry_set_activates_default(GtkEntry* entry, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_activates_default", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_entry_set_activates_default", "gboolean");
- gtk_entry_set_activates_default(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_activates_default", "GtkEntry*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_entry_set_activates_default", "gboolean");
+ gtk_entry_set_activates_default(Xen_to_C_GtkEntry_(entry), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_activates_default(XEN entry)
+static Xen gxg_gtk_entry_get_activates_default(Xen entry)
{
#define H_gtk_entry_get_activates_default "gboolean gtk_entry_get_activates_default(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_activates_default", "GtkEntry*");
- return(C_TO_XEN_gboolean(gtk_entry_get_activates_default(XEN_TO_C_GtkEntry_(entry))));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_activates_default", "GtkEntry*");
+ return(C_to_Xen_gboolean(gtk_entry_get_activates_default(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_entry_set_width_chars(XEN entry, XEN n_chars)
+static Xen gxg_gtk_entry_set_width_chars(Xen entry, Xen n_chars)
{
#define H_gtk_entry_set_width_chars "void gtk_entry_set_width_chars(GtkEntry* entry, gint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_width_chars", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_chars), n_chars, 2, "gtk_entry_set_width_chars", "gint");
- gtk_entry_set_width_chars(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gint(n_chars));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_width_chars", "GtkEntry*");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 2, "gtk_entry_set_width_chars", "gint");
+ gtk_entry_set_width_chars(Xen_to_C_GtkEntry_(entry), Xen_to_C_gint(n_chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_width_chars(XEN entry)
+static Xen gxg_gtk_entry_get_width_chars(Xen entry)
{
#define H_gtk_entry_get_width_chars "gint gtk_entry_get_width_chars(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_width_chars", "GtkEntry*");
- return(C_TO_XEN_gint(gtk_entry_get_width_chars(XEN_TO_C_GtkEntry_(entry))));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_width_chars", "GtkEntry*");
+ return(C_to_Xen_gint(gtk_entry_get_width_chars(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_entry_set_text(XEN entry, XEN text)
+static Xen gxg_gtk_entry_set_text(Xen entry, Xen text)
{
#define H_gtk_entry_set_text "void gtk_entry_set_text(GtkEntry* entry, gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_text", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_entry_set_text", "gchar*");
- gtk_entry_set_text(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_text", "GtkEntry*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_entry_set_text", "gchar*");
+ gtk_entry_set_text(Xen_to_C_GtkEntry_(entry), Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_text(XEN entry)
+static Xen gxg_gtk_entry_get_text(Xen entry)
{
#define H_gtk_entry_get_text "gchar* gtk_entry_get_text(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_text", "GtkEntry*");
- return(C_TO_XEN_gchar_(gtk_entry_get_text(XEN_TO_C_GtkEntry_(entry))));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_text", "GtkEntry*");
+ return(C_to_Xen_gchar_(gtk_entry_get_text(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_entry_get_layout(XEN entry)
+static Xen gxg_gtk_entry_get_layout(Xen entry)
{
#define H_gtk_entry_get_layout "PangoLayout* gtk_entry_get_layout(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_layout", "GtkEntry*");
- return(C_TO_XEN_PangoLayout_(gtk_entry_get_layout(XEN_TO_C_GtkEntry_(entry))));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_layout", "GtkEntry*");
+ return(C_to_Xen_PangoLayout_(gtk_entry_get_layout(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_entry_get_layout_offsets(XEN entry, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gtk_entry_get_layout_offsets(Xen entry, Xen ignore_x, Xen ignore_y)
{
#define H_gtk_entry_get_layout_offsets "void gtk_entry_get_layout_offsets(GtkEntry* entry, gint* [x], \
gint* [y])"
gint ref_x;
gint ref_y;
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_layout_offsets", "GtkEntry*");
- gtk_entry_get_layout_offsets(XEN_TO_C_GtkEntry_(entry), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y)));
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_layout_offsets", "GtkEntry*");
+ gtk_entry_get_layout_offsets(Xen_to_C_GtkEntry_(entry), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y)));
}
-static XEN gxg_gtk_event_box_new(void)
+static Xen gxg_gtk_event_box_new(void)
{
#define H_gtk_event_box_new "GtkWidget* gtk_event_box_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_event_box_new()));
+ return(C_to_Xen_GtkWidget_(gtk_event_box_new()));
}
-static XEN gxg_gtk_fixed_new(void)
+static Xen gxg_gtk_fixed_new(void)
{
#define H_gtk_fixed_new "GtkWidget* gtk_fixed_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_fixed_new()));
+ return(C_to_Xen_GtkWidget_(gtk_fixed_new()));
}
-static XEN gxg_gtk_fixed_put(XEN fixed, XEN widget, XEN x, XEN y)
+static Xen gxg_gtk_fixed_put(Xen fixed, Xen widget, Xen x, Xen y)
{
#define H_gtk_fixed_put "void gtk_fixed_put(GtkFixed* fixed, GtkWidget* widget, gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkFixed__P(fixed), fixed, 1, "gtk_fixed_put", "GtkFixed*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_fixed_put", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 3, "gtk_fixed_put", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 4, "gtk_fixed_put", "gint");
- gtk_fixed_put(XEN_TO_C_GtkFixed_(fixed), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkFixed_(fixed), fixed, 1, "gtk_fixed_put", "GtkFixed*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_fixed_put", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(x), x, 3, "gtk_fixed_put", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 4, "gtk_fixed_put", "gint");
+ gtk_fixed_put(Xen_to_C_GtkFixed_(fixed), Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(x), Xen_to_C_gint(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_fixed_move(XEN fixed, XEN widget, XEN x, XEN y)
+static Xen gxg_gtk_fixed_move(Xen fixed, Xen widget, Xen x, Xen y)
{
#define H_gtk_fixed_move "void gtk_fixed_move(GtkFixed* fixed, GtkWidget* widget, gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkFixed__P(fixed), fixed, 1, "gtk_fixed_move", "GtkFixed*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_fixed_move", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 3, "gtk_fixed_move", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 4, "gtk_fixed_move", "gint");
- gtk_fixed_move(XEN_TO_C_GtkFixed_(fixed), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_font_selection_new(void)
-{
- #define H_gtk_font_selection_new "GtkWidget* gtk_font_selection_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_new()));
-}
-
-static XEN gxg_gtk_font_selection_get_font_name(XEN fontsel)
-{
- #define H_gtk_font_selection_get_font_name "gchar* gtk_font_selection_get_font_name(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_font_name", "GtkFontSelection*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_font_selection_get_font_name(XEN_TO_C_GtkFontSelection_(fontsel));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
-}
-
-static XEN gxg_gtk_font_selection_set_font_name(XEN fontsel, XEN fontname)
-{
- #define H_gtk_font_selection_set_font_name "gboolean gtk_font_selection_set_font_name(GtkFontSelection* fontsel, \
-gchar* fontname)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_set_font_name", "GtkFontSelection*");
- XEN_ASSERT_TYPE(XEN_gchar__P(fontname), fontname, 2, "gtk_font_selection_set_font_name", "gchar*");
- return(C_TO_XEN_gboolean(gtk_font_selection_set_font_name(XEN_TO_C_GtkFontSelection_(fontsel), XEN_TO_C_gchar_(fontname))));
-}
-
-static XEN gxg_gtk_font_selection_get_preview_text(XEN fontsel)
-{
- #define H_gtk_font_selection_get_preview_text "gchar* gtk_font_selection_get_preview_text(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_preview_text", "GtkFontSelection*");
- return(C_TO_XEN_gchar_(gtk_font_selection_get_preview_text(XEN_TO_C_GtkFontSelection_(fontsel))));
-}
-
-static XEN gxg_gtk_font_selection_set_preview_text(XEN fontsel, XEN text)
-{
- #define H_gtk_font_selection_set_preview_text "void gtk_font_selection_set_preview_text(GtkFontSelection* fontsel, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_set_preview_text", "GtkFontSelection*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_font_selection_set_preview_text", "gchar*");
- gtk_font_selection_set_preview_text(XEN_TO_C_GtkFontSelection_(fontsel), XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_font_selection_dialog_new(XEN title)
-{
- #define H_gtk_font_selection_dialog_new "GtkWidget* gtk_font_selection_dialog_new(gchar* title)"
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 1, "gtk_font_selection_dialog_new", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_dialog_new(XEN_TO_C_gchar_(title))));
-}
-
-static XEN gxg_gtk_font_selection_dialog_get_font_name(XEN fsd)
-{
- #define H_gtk_font_selection_dialog_get_font_name "gchar* gtk_font_selection_dialog_get_font_name(GtkFontSelectionDialog* fsd)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelectionDialog__P(fsd), fsd, 1, "gtk_font_selection_dialog_get_font_name", "GtkFontSelectionDialog*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_font_selection_dialog_get_font_name(XEN_TO_C_GtkFontSelectionDialog_(fsd));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
-}
-
-static XEN gxg_gtk_font_selection_dialog_set_font_name(XEN fsd, XEN fontname)
-{
- #define H_gtk_font_selection_dialog_set_font_name "gboolean gtk_font_selection_dialog_set_font_name(GtkFontSelectionDialog* fsd, \
-gchar* fontname)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelectionDialog__P(fsd), fsd, 1, "gtk_font_selection_dialog_set_font_name", "GtkFontSelectionDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(fontname), fontname, 2, "gtk_font_selection_dialog_set_font_name", "gchar*");
- return(C_TO_XEN_gboolean(gtk_font_selection_dialog_set_font_name(XEN_TO_C_GtkFontSelectionDialog_(fsd), XEN_TO_C_gchar_(fontname))));
-}
-
-static XEN gxg_gtk_font_selection_dialog_get_preview_text(XEN fsd)
-{
- #define H_gtk_font_selection_dialog_get_preview_text "gchar* gtk_font_selection_dialog_get_preview_text(GtkFontSelectionDialog* fsd)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelectionDialog__P(fsd), fsd, 1, "gtk_font_selection_dialog_get_preview_text", "GtkFontSelectionDialog*");
- return(C_TO_XEN_gchar_(gtk_font_selection_dialog_get_preview_text(XEN_TO_C_GtkFontSelectionDialog_(fsd))));
+ Xen_check_type(Xen_is_GtkFixed_(fixed), fixed, 1, "gtk_fixed_move", "GtkFixed*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_fixed_move", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(x), x, 3, "gtk_fixed_move", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 4, "gtk_fixed_move", "gint");
+ gtk_fixed_move(Xen_to_C_GtkFixed_(fixed), Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(x), Xen_to_C_gint(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_selection_dialog_set_preview_text(XEN fsd, XEN text)
-{
- #define H_gtk_font_selection_dialog_set_preview_text "void gtk_font_selection_dialog_set_preview_text(GtkFontSelectionDialog* fsd, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelectionDialog__P(fsd), fsd, 1, "gtk_font_selection_dialog_set_preview_text", "GtkFontSelectionDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_font_selection_dialog_set_preview_text", "gchar*");
- gtk_font_selection_dialog_set_preview_text(XEN_TO_C_GtkFontSelectionDialog_(fsd), XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_frame_new(XEN label)
+static Xen gxg_gtk_frame_new(Xen label)
{
#define H_gtk_frame_new "GtkWidget* gtk_frame_new(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_frame_new", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_frame_new(XEN_TO_C_gchar_(label))));
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_frame_new", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_frame_new(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_frame_set_label(XEN frame, XEN label)
+static Xen gxg_gtk_frame_set_label(Xen frame, Xen label)
{
#define H_gtk_frame_set_label "void gtk_frame_set_label(GtkFrame* frame, gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkFrame__P(frame), frame, 1, "gtk_frame_set_label", "GtkFrame*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_frame_set_label", "gchar*");
- gtk_frame_set_label(XEN_TO_C_GtkFrame_(frame), XEN_TO_C_gchar_(label));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkFrame_(frame), frame, 1, "gtk_frame_set_label", "GtkFrame*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_frame_set_label", "gchar*");
+ gtk_frame_set_label(Xen_to_C_GtkFrame_(frame), Xen_to_C_gchar_(label));
+ return(Xen_false);
}
-static XEN gxg_gtk_frame_get_label(XEN frame)
+static Xen gxg_gtk_frame_get_label(Xen frame)
{
#define H_gtk_frame_get_label "gchar* gtk_frame_get_label(GtkFrame* frame)"
- XEN_ASSERT_TYPE(XEN_GtkFrame__P(frame), frame, 1, "gtk_frame_get_label", "GtkFrame*");
- return(C_TO_XEN_gchar_(gtk_frame_get_label(XEN_TO_C_GtkFrame_(frame))));
+ Xen_check_type(Xen_is_GtkFrame_(frame), frame, 1, "gtk_frame_get_label", "GtkFrame*");
+ return(C_to_Xen_gchar_(gtk_frame_get_label(Xen_to_C_GtkFrame_(frame))));
}
-static XEN gxg_gtk_frame_set_label_widget(XEN frame, XEN label_widget)
+static Xen gxg_gtk_frame_set_label_widget(Xen frame, Xen label_widget)
{
#define H_gtk_frame_set_label_widget "void gtk_frame_set_label_widget(GtkFrame* frame, GtkWidget* label_widget)"
- XEN_ASSERT_TYPE(XEN_GtkFrame__P(frame), frame, 1, "gtk_frame_set_label_widget", "GtkFrame*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(label_widget), label_widget, 2, "gtk_frame_set_label_widget", "GtkWidget*");
- gtk_frame_set_label_widget(XEN_TO_C_GtkFrame_(frame), XEN_TO_C_GtkWidget_(label_widget));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkFrame_(frame), frame, 1, "gtk_frame_set_label_widget", "GtkFrame*");
+ Xen_check_type(Xen_is_GtkWidget_(label_widget), label_widget, 2, "gtk_frame_set_label_widget", "GtkWidget*");
+ gtk_frame_set_label_widget(Xen_to_C_GtkFrame_(frame), Xen_to_C_GtkWidget_(label_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_frame_get_label_widget(XEN frame)
+static Xen gxg_gtk_frame_get_label_widget(Xen frame)
{
#define H_gtk_frame_get_label_widget "GtkWidget* gtk_frame_get_label_widget(GtkFrame* frame)"
- XEN_ASSERT_TYPE(XEN_GtkFrame__P(frame), frame, 1, "gtk_frame_get_label_widget", "GtkFrame*");
- return(C_TO_XEN_GtkWidget_(gtk_frame_get_label_widget(XEN_TO_C_GtkFrame_(frame))));
+ Xen_check_type(Xen_is_GtkFrame_(frame), frame, 1, "gtk_frame_get_label_widget", "GtkFrame*");
+ return(C_to_Xen_GtkWidget_(gtk_frame_get_label_widget(Xen_to_C_GtkFrame_(frame))));
}
-static XEN gxg_gtk_frame_set_label_align(XEN frame, XEN xalign, XEN yalign)
+static Xen gxg_gtk_frame_set_label_align(Xen frame, Xen xalign, Xen yalign)
{
#define H_gtk_frame_set_label_align "void gtk_frame_set_label_align(GtkFrame* frame, gfloat xalign, \
gfloat yalign)"
- XEN_ASSERT_TYPE(XEN_GtkFrame__P(frame), frame, 1, "gtk_frame_set_label_align", "GtkFrame*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_frame_set_label_align", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yalign), yalign, 3, "gtk_frame_set_label_align", "gfloat");
- gtk_frame_set_label_align(XEN_TO_C_GtkFrame_(frame), XEN_TO_C_gfloat(xalign), XEN_TO_C_gfloat(yalign));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkFrame_(frame), frame, 1, "gtk_frame_set_label_align", "GtkFrame*");
+ Xen_check_type(Xen_is_gfloat(xalign), xalign, 2, "gtk_frame_set_label_align", "gfloat");
+ Xen_check_type(Xen_is_gfloat(yalign), yalign, 3, "gtk_frame_set_label_align", "gfloat");
+ gtk_frame_set_label_align(Xen_to_C_GtkFrame_(frame), Xen_to_C_gfloat(xalign), Xen_to_C_gfloat(yalign));
+ return(Xen_false);
}
-static XEN gxg_gtk_frame_get_label_align(XEN frame, XEN ignore_xalign, XEN ignore_yalign)
+static Xen gxg_gtk_frame_get_label_align(Xen frame, Xen ignore_xalign, Xen ignore_yalign)
{
#define H_gtk_frame_get_label_align "void gtk_frame_get_label_align(GtkFrame* frame, gfloat* [xalign], \
gfloat* [yalign])"
gfloat ref_xalign;
gfloat ref_yalign;
- XEN_ASSERT_TYPE(XEN_GtkFrame__P(frame), frame, 1, "gtk_frame_get_label_align", "GtkFrame*");
- gtk_frame_get_label_align(XEN_TO_C_GtkFrame_(frame), &ref_xalign, &ref_yalign);
- return(XEN_LIST_2(C_TO_XEN_gfloat(ref_xalign), C_TO_XEN_gfloat(ref_yalign)));
+ Xen_check_type(Xen_is_GtkFrame_(frame), frame, 1, "gtk_frame_get_label_align", "GtkFrame*");
+ gtk_frame_get_label_align(Xen_to_C_GtkFrame_(frame), &ref_xalign, &ref_yalign);
+ return(Xen_list_2(C_to_Xen_gfloat(ref_xalign), C_to_Xen_gfloat(ref_yalign)));
}
-static XEN gxg_gtk_frame_set_shadow_type(XEN frame, XEN type)
+static Xen gxg_gtk_frame_set_shadow_type(Xen frame, Xen type)
{
#define H_gtk_frame_set_shadow_type "void gtk_frame_set_shadow_type(GtkFrame* frame, GtkShadowType type)"
- XEN_ASSERT_TYPE(XEN_GtkFrame__P(frame), frame, 1, "gtk_frame_set_shadow_type", "GtkFrame*");
- XEN_ASSERT_TYPE(XEN_GtkShadowType_P(type), type, 2, "gtk_frame_set_shadow_type", "GtkShadowType");
- gtk_frame_set_shadow_type(XEN_TO_C_GtkFrame_(frame), XEN_TO_C_GtkShadowType(type));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GtkFrame_(frame), frame, 1, "gtk_frame_set_shadow_type", "GtkFrame*");
+ Xen_check_type(Xen_is_GtkShadowType(type), type, 2, "gtk_frame_set_shadow_type", "GtkShadowType");
+ gtk_frame_set_shadow_type(Xen_to_C_GtkFrame_(frame), Xen_to_C_GtkShadowType(type));
+ return(Xen_false);
}
-static XEN gxg_gtk_frame_get_shadow_type(XEN frame)
+static Xen gxg_gtk_frame_get_shadow_type(Xen frame)
{
#define H_gtk_frame_get_shadow_type "GtkShadowType gtk_frame_get_shadow_type(GtkFrame* frame)"
- XEN_ASSERT_TYPE(XEN_GtkFrame__P(frame), frame, 1, "gtk_frame_get_shadow_type", "GtkFrame*");
- return(C_TO_XEN_GtkShadowType(gtk_frame_get_shadow_type(XEN_TO_C_GtkFrame_(frame))));
+ Xen_check_type(Xen_is_GtkFrame_(frame), frame, 1, "gtk_frame_get_shadow_type", "GtkFrame*");
+ return(C_to_Xen_GtkShadowType(gtk_frame_get_shadow_type(Xen_to_C_GtkFrame_(frame))));
}
-static XEN gxg_gtk_handle_box_new(void)
+static Xen gxg_gtk_image_new(void)
{
- #define H_gtk_handle_box_new "GtkWidget* gtk_handle_box_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_handle_box_new()));
-}
-
-static XEN gxg_gtk_handle_box_set_shadow_type(XEN handle_box, XEN type)
-{
- #define H_gtk_handle_box_set_shadow_type "void gtk_handle_box_set_shadow_type(GtkHandleBox* handle_box, \
-GtkShadowType type)"
- XEN_ASSERT_TYPE(XEN_GtkHandleBox__P(handle_box), handle_box, 1, "gtk_handle_box_set_shadow_type", "GtkHandleBox*");
- XEN_ASSERT_TYPE(XEN_GtkShadowType_P(type), type, 2, "gtk_handle_box_set_shadow_type", "GtkShadowType");
- gtk_handle_box_set_shadow_type(XEN_TO_C_GtkHandleBox_(handle_box), XEN_TO_C_GtkShadowType(type));
- return(XEN_FALSE);
+ #define H_gtk_image_new "GtkWidget* gtk_image_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_image_new()));
}
-static XEN gxg_gtk_handle_box_get_shadow_type(XEN handle_box)
+static Xen gxg_gtk_image_new_from_file(Xen filename)
{
- #define H_gtk_handle_box_get_shadow_type "GtkShadowType gtk_handle_box_get_shadow_type(GtkHandleBox* handle_box)"
- XEN_ASSERT_TYPE(XEN_GtkHandleBox__P(handle_box), handle_box, 1, "gtk_handle_box_get_shadow_type", "GtkHandleBox*");
- return(C_TO_XEN_GtkShadowType(gtk_handle_box_get_shadow_type(XEN_TO_C_GtkHandleBox_(handle_box))));
+ #define H_gtk_image_new_from_file "GtkWidget* gtk_image_new_from_file(gchar* filename)"
+ Xen_check_type(Xen_is_gchar_(filename), filename, 1, "gtk_image_new_from_file", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_image_new_from_file(Xen_to_C_gchar_(filename))));
}
-static XEN gxg_gtk_handle_box_set_handle_position(XEN handle_box, XEN position)
+static Xen gxg_gtk_image_new_from_pixbuf(Xen pixbuf)
{
- #define H_gtk_handle_box_set_handle_position "void gtk_handle_box_set_handle_position(GtkHandleBox* handle_box, \
-GtkPositionType position)"
- XEN_ASSERT_TYPE(XEN_GtkHandleBox__P(handle_box), handle_box, 1, "gtk_handle_box_set_handle_position", "GtkHandleBox*");
- XEN_ASSERT_TYPE(XEN_GtkPositionType_P(position), position, 2, "gtk_handle_box_set_handle_position", "GtkPositionType");
- gtk_handle_box_set_handle_position(XEN_TO_C_GtkHandleBox_(handle_box), XEN_TO_C_GtkPositionType(position));
- return(XEN_FALSE);
+ #define H_gtk_image_new_from_pixbuf "GtkWidget* gtk_image_new_from_pixbuf(GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf) || Xen_is_false(pixbuf), pixbuf, 1, "gtk_image_new_from_pixbuf", "GdkPixbuf*");
+ return(C_to_Xen_GtkWidget_(gtk_image_new_from_pixbuf(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gtk_handle_box_get_handle_position(XEN handle_box)
+static Xen gxg_gtk_image_new_from_animation(Xen animation)
{
- #define H_gtk_handle_box_get_handle_position "GtkPositionType gtk_handle_box_get_handle_position(GtkHandleBox* handle_box)"
- XEN_ASSERT_TYPE(XEN_GtkHandleBox__P(handle_box), handle_box, 1, "gtk_handle_box_get_handle_position", "GtkHandleBox*");
- return(C_TO_XEN_GtkPositionType(gtk_handle_box_get_handle_position(XEN_TO_C_GtkHandleBox_(handle_box))));
+ #define H_gtk_image_new_from_animation "GtkWidget* gtk_image_new_from_animation(GdkPixbufAnimation* animation)"
+ Xen_check_type(Xen_is_GdkPixbufAnimation_(animation), animation, 1, "gtk_image_new_from_animation", "GdkPixbufAnimation*");
+ return(C_to_Xen_GtkWidget_(gtk_image_new_from_animation(Xen_to_C_GdkPixbufAnimation_(animation))));
}
-static XEN gxg_gtk_handle_box_set_snap_edge(XEN handle_box, XEN edge)
+static Xen gxg_gtk_image_set_from_file(Xen image, Xen filename)
{
- #define H_gtk_handle_box_set_snap_edge "void gtk_handle_box_set_snap_edge(GtkHandleBox* handle_box, \
-GtkPositionType edge)"
- XEN_ASSERT_TYPE(XEN_GtkHandleBox__P(handle_box), handle_box, 1, "gtk_handle_box_set_snap_edge", "GtkHandleBox*");
- XEN_ASSERT_TYPE(XEN_GtkPositionType_P(edge), edge, 2, "gtk_handle_box_set_snap_edge", "GtkPositionType");
- gtk_handle_box_set_snap_edge(XEN_TO_C_GtkHandleBox_(handle_box), XEN_TO_C_GtkPositionType(edge));
- return(XEN_FALSE);
+ #define H_gtk_image_set_from_file "void gtk_image_set_from_file(GtkImage* image, gchar* filename)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_set_from_file", "GtkImage*");
+ Xen_check_type(Xen_is_gchar_(filename), filename, 2, "gtk_image_set_from_file", "gchar*");
+ gtk_image_set_from_file(Xen_to_C_GtkImage_(image), Xen_to_C_gchar_(filename));
+ return(Xen_false);
}
-static XEN gxg_gtk_handle_box_get_snap_edge(XEN handle_box)
+static Xen gxg_gtk_image_set_from_pixbuf(Xen image, Xen pixbuf)
{
- #define H_gtk_handle_box_get_snap_edge "GtkPositionType gtk_handle_box_get_snap_edge(GtkHandleBox* handle_box)"
- XEN_ASSERT_TYPE(XEN_GtkHandleBox__P(handle_box), handle_box, 1, "gtk_handle_box_get_snap_edge", "GtkHandleBox*");
- return(C_TO_XEN_GtkPositionType(gtk_handle_box_get_snap_edge(XEN_TO_C_GtkHandleBox_(handle_box))));
+ #define H_gtk_image_set_from_pixbuf "void gtk_image_set_from_pixbuf(GtkImage* image, GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_set_from_pixbuf", "GtkImage*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf) || Xen_is_false(pixbuf), pixbuf, 2, "gtk_image_set_from_pixbuf", "GdkPixbuf*");
+ gtk_image_set_from_pixbuf(Xen_to_C_GtkImage_(image), Xen_to_C_GdkPixbuf_(pixbuf));
+ return(Xen_false);
}
-static XEN gxg_gtk_hbutton_box_new(void)
+static Xen gxg_gtk_image_set_from_animation(Xen image, Xen animation)
{
- #define H_gtk_hbutton_box_new "GtkWidget* gtk_hbutton_box_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_hbutton_box_new()));
+ #define H_gtk_image_set_from_animation "void gtk_image_set_from_animation(GtkImage* image, GdkPixbufAnimation* animation)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_set_from_animation", "GtkImage*");
+ Xen_check_type(Xen_is_GdkPixbufAnimation_(animation) || Xen_is_false(animation), animation, 2, "gtk_image_set_from_animation", "GdkPixbufAnimation*");
+ gtk_image_set_from_animation(Xen_to_C_GtkImage_(image), Xen_to_C_GdkPixbufAnimation_(animation));
+ return(Xen_false);
}
-static XEN gxg_gtk_hbox_new(XEN homogeneous, XEN spacing)
+static Xen gxg_gtk_image_get_storage_type(Xen image)
{
- #define H_gtk_hbox_new "GtkWidget* gtk_hbox_new(gboolean homogeneous, gint spacing)"
- XEN_ASSERT_TYPE(XEN_gboolean_P(homogeneous), homogeneous, 1, "gtk_hbox_new", "gboolean");
- XEN_ASSERT_TYPE(XEN_gint_P(spacing), spacing, 2, "gtk_hbox_new", "gint");
- return(C_TO_XEN_GtkWidget_(gtk_hbox_new(XEN_TO_C_gboolean(homogeneous), XEN_TO_C_gint(spacing))));
+ #define H_gtk_image_get_storage_type "GtkImageType gtk_image_get_storage_type(GtkImage* image)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_get_storage_type", "GtkImage*");
+ return(C_to_Xen_GtkImageType(gtk_image_get_storage_type(Xen_to_C_GtkImage_(image))));
}
-static XEN gxg_gtk_hpaned_new(void)
+static Xen gxg_gtk_image_get_pixbuf(Xen image)
{
- #define H_gtk_hpaned_new "GtkWidget* gtk_hpaned_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_hpaned_new()));
+ #define H_gtk_image_get_pixbuf "GdkPixbuf* gtk_image_get_pixbuf(GtkImage* image)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_get_pixbuf", "GtkImage*");
+ return(C_to_Xen_GdkPixbuf_(gtk_image_get_pixbuf(Xen_to_C_GtkImage_(image))));
}
-static XEN gxg_gtk_hscale_new(XEN adjustment)
+static Xen gxg_gtk_image_get_animation(Xen image)
{
- #define H_gtk_hscale_new "GtkWidget* gtk_hscale_new(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment) || XEN_FALSE_P(adjustment), adjustment, 1, "gtk_hscale_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_hscale_new(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_image_get_animation "GdkPixbufAnimation* gtk_image_get_animation(GtkImage* image)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_get_animation", "GtkImage*");
+ return(C_to_Xen_GdkPixbufAnimation_(gtk_image_get_animation(Xen_to_C_GtkImage_(image))));
}
-static XEN gxg_gtk_hscale_new_with_range(XEN min, XEN max, XEN step)
+static Xen gxg_gtk_im_context_set_client_window(Xen context, Xen window)
{
- #define H_gtk_hscale_new_with_range "GtkWidget* gtk_hscale_new_with_range(gdouble min, gdouble max, \
-gdouble step)"
- XEN_ASSERT_TYPE(XEN_gdouble_P(min), min, 1, "gtk_hscale_new_with_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(max), max, 2, "gtk_hscale_new_with_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step), step, 3, "gtk_hscale_new_with_range", "gdouble");
- return(C_TO_XEN_GtkWidget_(gtk_hscale_new_with_range(XEN_TO_C_gdouble(min), XEN_TO_C_gdouble(max), XEN_TO_C_gdouble(step))));
+ #define H_gtk_im_context_set_client_window "void gtk_im_context_set_client_window(GtkIMContext* context, \
+GdkWindow* window)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_set_client_window", "GtkIMContext*");
+ Xen_check_type(Xen_is_GdkWindow_(window) || Xen_is_false(window), window, 2, "gtk_im_context_set_client_window", "GdkWindow*");
+ gtk_im_context_set_client_window(Xen_to_C_GtkIMContext_(context), Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_hscrollbar_new(XEN adjustment)
+static Xen gxg_gtk_im_context_get_preedit_string(Xen context, Xen ignore_str, Xen ignore_attrs, Xen ignore_cursor_pos)
{
- #define H_gtk_hscrollbar_new "GtkWidget* gtk_hscrollbar_new(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment) || XEN_FALSE_P(adjustment), adjustment, 1, "gtk_hscrollbar_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_hscrollbar_new(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_im_context_get_preedit_string "void gtk_im_context_get_preedit_string(GtkIMContext* context, \
+gchar** [str], PangoAttrList** [attrs], gint* [cursor_pos])"
+ gchar* ref_str = NULL;
+ PangoAttrList* ref_attrs = NULL;
+ gint ref_cursor_pos;
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_get_preedit_string", "GtkIMContext*");
+ gtk_im_context_get_preedit_string(Xen_to_C_GtkIMContext_(context), &ref_str, &ref_attrs, &ref_cursor_pos);
+ return(Xen_list_3(C_to_Xen_gchar_(ref_str), C_to_Xen_PangoAttrList_(ref_attrs), C_to_Xen_gint(ref_cursor_pos)));
}
-static XEN gxg_gtk_hseparator_new(void)
+static Xen gxg_gtk_im_context_filter_keypress(Xen context, Xen event)
{
- #define H_gtk_hseparator_new "GtkWidget* gtk_hseparator_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_hseparator_new()));
+ #define H_gtk_im_context_filter_keypress "gboolean gtk_im_context_filter_keypress(GtkIMContext* context, \
+GdkEventKey* event)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_filter_keypress", "GtkIMContext*");
+ Xen_check_type(Xen_is_GdkEventKey_(event), event, 2, "gtk_im_context_filter_keypress", "GdkEventKey*");
+ return(C_to_Xen_gboolean(gtk_im_context_filter_keypress(Xen_to_C_GtkIMContext_(context), Xen_to_C_GdkEventKey_(event))));
}
-static XEN gxg_gtk_icon_factory_new(void)
+static Xen gxg_gtk_im_context_focus_in(Xen context)
{
- #define H_gtk_icon_factory_new "GtkIconFactory* gtk_icon_factory_new( void)"
- return(C_TO_XEN_GtkIconFactory_(gtk_icon_factory_new()));
+ #define H_gtk_im_context_focus_in "void gtk_im_context_focus_in(GtkIMContext* context)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_focus_in", "GtkIMContext*");
+ gtk_im_context_focus_in(Xen_to_C_GtkIMContext_(context));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_factory_add(XEN factory, XEN stock_id, XEN icon_set)
+static Xen gxg_gtk_im_context_focus_out(Xen context)
{
- #define H_gtk_icon_factory_add "void gtk_icon_factory_add(GtkIconFactory* factory, gchar* stock_id, \
-GtkIconSet* icon_set)"
- XEN_ASSERT_TYPE(XEN_GtkIconFactory__P(factory), factory, 1, "gtk_icon_factory_add", "GtkIconFactory*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_icon_factory_add", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 3, "gtk_icon_factory_add", "GtkIconSet*");
- gtk_icon_factory_add(XEN_TO_C_GtkIconFactory_(factory), XEN_TO_C_gchar_(stock_id), XEN_TO_C_GtkIconSet_(icon_set));
- return(XEN_FALSE);
+ #define H_gtk_im_context_focus_out "void gtk_im_context_focus_out(GtkIMContext* context)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_focus_out", "GtkIMContext*");
+ gtk_im_context_focus_out(Xen_to_C_GtkIMContext_(context));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_factory_lookup(XEN factory, XEN stock_id)
+static Xen gxg_gtk_im_context_reset(Xen context)
{
- #define H_gtk_icon_factory_lookup "GtkIconSet* gtk_icon_factory_lookup(GtkIconFactory* factory, gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GtkIconFactory__P(factory), factory, 1, "gtk_icon_factory_lookup", "GtkIconFactory*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_icon_factory_lookup", "gchar*");
- return(C_TO_XEN_GtkIconSet_(gtk_icon_factory_lookup(XEN_TO_C_GtkIconFactory_(factory), XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_im_context_reset "void gtk_im_context_reset(GtkIMContext* context)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_reset", "GtkIMContext*");
+ gtk_im_context_reset(Xen_to_C_GtkIMContext_(context));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_factory_add_default(XEN factory)
+static Xen gxg_gtk_im_context_set_cursor_location(Xen context, Xen area)
{
- #define H_gtk_icon_factory_add_default "void gtk_icon_factory_add_default(GtkIconFactory* factory)"
- XEN_ASSERT_TYPE(XEN_GtkIconFactory__P(factory), factory, 1, "gtk_icon_factory_add_default", "GtkIconFactory*");
- gtk_icon_factory_add_default(XEN_TO_C_GtkIconFactory_(factory));
- return(XEN_FALSE);
+ #define H_gtk_im_context_set_cursor_location "void gtk_im_context_set_cursor_location(GtkIMContext* context, \
+GdkRectangle* area)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_set_cursor_location", "GtkIMContext*");
+ Xen_check_type(Xen_is_GdkRectangle_(area), area, 2, "gtk_im_context_set_cursor_location", "GdkRectangle*");
+ gtk_im_context_set_cursor_location(Xen_to_C_GtkIMContext_(context), Xen_to_C_GdkRectangle_(area));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_factory_remove_default(XEN factory)
+static Xen gxg_gtk_im_context_set_use_preedit(Xen context, Xen use_preedit)
{
- #define H_gtk_icon_factory_remove_default "void gtk_icon_factory_remove_default(GtkIconFactory* factory)"
- XEN_ASSERT_TYPE(XEN_GtkIconFactory__P(factory), factory, 1, "gtk_icon_factory_remove_default", "GtkIconFactory*");
- gtk_icon_factory_remove_default(XEN_TO_C_GtkIconFactory_(factory));
- return(XEN_FALSE);
+ #define H_gtk_im_context_set_use_preedit "void gtk_im_context_set_use_preedit(GtkIMContext* context, \
+gboolean use_preedit)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_set_use_preedit", "GtkIMContext*");
+ Xen_check_type(Xen_is_gboolean(use_preedit), use_preedit, 2, "gtk_im_context_set_use_preedit", "gboolean");
+ gtk_im_context_set_use_preedit(Xen_to_C_GtkIMContext_(context), Xen_to_C_gboolean(use_preedit));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_factory_lookup_default(XEN stock_id)
+static Xen gxg_gtk_im_context_set_surrounding(Xen context, Xen text, Xen len, Xen cursor_index)
{
- #define H_gtk_icon_factory_lookup_default "GtkIconSet* gtk_icon_factory_lookup_default(gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_icon_factory_lookup_default", "gchar*");
- return(C_TO_XEN_GtkIconSet_(gtk_icon_factory_lookup_default(XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_im_context_set_surrounding "void gtk_im_context_set_surrounding(GtkIMContext* context, \
+gchar* text, gint len, gint cursor_index)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_set_surrounding", "GtkIMContext*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_im_context_set_surrounding", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 3, "gtk_im_context_set_surrounding", "gint");
+ Xen_check_type(Xen_is_gint(cursor_index), cursor_index, 4, "gtk_im_context_set_surrounding", "gint");
+ gtk_im_context_set_surrounding(Xen_to_C_GtkIMContext_(context), Xen_to_C_gchar_(text), Xen_to_C_gint(len), Xen_to_C_gint(cursor_index));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_size_lookup(XEN size, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_im_context_get_surrounding(Xen context, Xen ignore_text, Xen ignore_cursor_index)
{
- #define H_gtk_icon_size_lookup "gboolean gtk_icon_size_lookup(GtkIconSize size, gint* [width], gint* [height])"
- gint ref_width;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 1, "gtk_icon_size_lookup", "GtkIconSize");
+ #define H_gtk_im_context_get_surrounding "gboolean gtk_im_context_get_surrounding(GtkIMContext* context, \
+gchar** [text], gint* [cursor_index])"
+ gchar* ref_text = NULL;
+ gint ref_cursor_index;
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_get_surrounding", "GtkIMContext*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_icon_size_lookup(XEN_TO_C_GtkIconSize(size), &ref_width, &ref_height));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_im_context_get_surrounding(Xen_to_C_GtkIMContext_(context), &ref_text, &ref_cursor_index));
+ return(Xen_list_3(result, C_to_Xen_gchar_(ref_text), C_to_Xen_gint(ref_cursor_index)));
}
}
-static XEN gxg_gtk_icon_size_register(XEN name, XEN width, XEN height)
+static Xen gxg_gtk_im_context_delete_surrounding(Xen context, Xen offset, Xen n_chars)
{
- #define H_gtk_icon_size_register "GtkIconSize gtk_icon_size_register(gchar* name, gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_icon_size_register", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_icon_size_register", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gtk_icon_size_register", "gint");
- return(C_TO_XEN_GtkIconSize(gtk_icon_size_register(XEN_TO_C_gchar_(name), XEN_TO_C_gint(width), XEN_TO_C_gint(height))));
+ #define H_gtk_im_context_delete_surrounding "gboolean gtk_im_context_delete_surrounding(GtkIMContext* context, \
+gint offset, gint n_chars)"
+ Xen_check_type(Xen_is_GtkIMContext_(context), context, 1, "gtk_im_context_delete_surrounding", "GtkIMContext*");
+ Xen_check_type(Xen_is_gint(offset), offset, 2, "gtk_im_context_delete_surrounding", "gint");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 3, "gtk_im_context_delete_surrounding", "gint");
+ return(C_to_Xen_gboolean(gtk_im_context_delete_surrounding(Xen_to_C_GtkIMContext_(context), Xen_to_C_gint(offset), Xen_to_C_gint(n_chars))));
}
-static XEN gxg_gtk_icon_size_register_alias(XEN alias, XEN target)
+static Xen gxg_gtk_im_context_simple_new(void)
{
- #define H_gtk_icon_size_register_alias "void gtk_icon_size_register_alias(gchar* alias, GtkIconSize target)"
- XEN_ASSERT_TYPE(XEN_gchar__P(alias), alias, 1, "gtk_icon_size_register_alias", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(target), target, 2, "gtk_icon_size_register_alias", "GtkIconSize");
- gtk_icon_size_register_alias(XEN_TO_C_gchar_(alias), XEN_TO_C_GtkIconSize(target));
- return(XEN_FALSE);
+ #define H_gtk_im_context_simple_new "GtkIMContext* gtk_im_context_simple_new( void)"
+ return(C_to_Xen_GtkIMContext_(gtk_im_context_simple_new()));
}
-static XEN gxg_gtk_icon_size_from_name(XEN name)
+static Xen gxg_gtk_im_context_simple_add_table(Xen context_simple, Xen data, Xen max_seq_len, Xen n_seqs)
{
- #define H_gtk_icon_size_from_name "GtkIconSize gtk_icon_size_from_name(gchar* name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_icon_size_from_name", "gchar*");
- return(C_TO_XEN_GtkIconSize(gtk_icon_size_from_name(XEN_TO_C_gchar_(name))));
+ #define H_gtk_im_context_simple_add_table "void gtk_im_context_simple_add_table(GtkIMContextSimple* context_simple, \
+guint16* data, gint max_seq_len, gint n_seqs)"
+ Xen_check_type(Xen_is_GtkIMContextSimple_(context_simple), context_simple, 1, "gtk_im_context_simple_add_table", "GtkIMContextSimple*");
+ Xen_check_type(Xen_is_guint16_(data), data, 2, "gtk_im_context_simple_add_table", "guint16*");
+ Xen_check_type(Xen_is_gint(max_seq_len), max_seq_len, 3, "gtk_im_context_simple_add_table", "gint");
+ Xen_check_type(Xen_is_gint(n_seqs), n_seqs, 4, "gtk_im_context_simple_add_table", "gint");
+ gtk_im_context_simple_add_table(Xen_to_C_GtkIMContextSimple_(context_simple), Xen_to_C_guint16_(data), Xen_to_C_gint(max_seq_len),
+ Xen_to_C_gint(n_seqs));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_size_get_name(XEN size)
+static Xen gxg_gtk_invisible_new(void)
{
- #define H_gtk_icon_size_get_name "gchar* gtk_icon_size_get_name(GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 1, "gtk_icon_size_get_name", "GtkIconSize");
- return(C_TO_XEN_gchar_(gtk_icon_size_get_name(XEN_TO_C_GtkIconSize(size))));
+ #define H_gtk_invisible_new "GtkWidget* gtk_invisible_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_invisible_new()));
}
-static XEN gxg_gtk_icon_set_new(void)
+static Xen gxg_gtk_label_new(Xen str)
{
- #define H_gtk_icon_set_new "GtkIconSet* gtk_icon_set_new( void)"
- return(C_TO_XEN_GtkIconSet_(gtk_icon_set_new()));
+ #define H_gtk_label_new "GtkWidget* gtk_label_new(char* str)"
+ Xen_check_type(Xen_is_char_(str), str, 1, "gtk_label_new", "char*");
+ return(C_to_Xen_GtkWidget_(gtk_label_new(Xen_to_C_char_(str))));
}
-static XEN gxg_gtk_icon_set_new_from_pixbuf(XEN pixbuf)
+static Xen gxg_gtk_label_new_with_mnemonic(Xen str)
{
- #define H_gtk_icon_set_new_from_pixbuf "GtkIconSet* gtk_icon_set_new_from_pixbuf(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gtk_icon_set_new_from_pixbuf", "GdkPixbuf*");
- return(C_TO_XEN_GtkIconSet_(gtk_icon_set_new_from_pixbuf(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ #define H_gtk_label_new_with_mnemonic "GtkWidget* gtk_label_new_with_mnemonic(char* str)"
+ Xen_check_type(Xen_is_char_(str), str, 1, "gtk_label_new_with_mnemonic", "char*");
+ return(C_to_Xen_GtkWidget_(gtk_label_new_with_mnemonic(Xen_to_C_char_(str))));
}
-static XEN gxg_gtk_icon_set_ref(XEN icon_set)
+static Xen gxg_gtk_label_set_text(Xen label, Xen str)
{
- #define H_gtk_icon_set_ref "GtkIconSet* gtk_icon_set_ref(GtkIconSet* icon_set)"
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 1, "gtk_icon_set_ref", "GtkIconSet*");
- return(C_TO_XEN_GtkIconSet_(gtk_icon_set_ref(XEN_TO_C_GtkIconSet_(icon_set))));
+ #define H_gtk_label_set_text "void gtk_label_set_text(GtkLabel* label, char* str)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_text", "GtkLabel*");
+ Xen_check_type(Xen_is_char_(str), str, 2, "gtk_label_set_text", "char*");
+ gtk_label_set_text(Xen_to_C_GtkLabel_(label), Xen_to_C_char_(str));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_set_unref(XEN icon_set)
+static Xen gxg_gtk_label_get_text(Xen label)
{
- #define H_gtk_icon_set_unref "void gtk_icon_set_unref(GtkIconSet* icon_set)"
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 1, "gtk_icon_set_unref", "GtkIconSet*");
- gtk_icon_set_unref(XEN_TO_C_GtkIconSet_(icon_set));
- return(XEN_FALSE);
+ #define H_gtk_label_get_text "gchar* gtk_label_get_text(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_text", "GtkLabel*");
+ return(C_to_Xen_gchar_(gtk_label_get_text(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_set_copy(XEN icon_set)
+static Xen gxg_gtk_label_set_attributes(Xen label, Xen attrs)
{
- #define H_gtk_icon_set_copy "GtkIconSet* gtk_icon_set_copy(GtkIconSet* icon_set)"
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 1, "gtk_icon_set_copy", "GtkIconSet*");
- return(C_TO_XEN_GtkIconSet_(gtk_icon_set_copy(XEN_TO_C_GtkIconSet_(icon_set))));
+ #define H_gtk_label_set_attributes "void gtk_label_set_attributes(GtkLabel* label, PangoAttrList* attrs)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_attributes", "GtkLabel*");
+ Xen_check_type(Xen_is_PangoAttrList_(attrs), attrs, 2, "gtk_label_set_attributes", "PangoAttrList*");
+ gtk_label_set_attributes(Xen_to_C_GtkLabel_(label), Xen_to_C_PangoAttrList_(attrs));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_set_add_source(XEN icon_set, XEN source)
+static Xen gxg_gtk_label_get_attributes(Xen label)
{
- #define H_gtk_icon_set_add_source "void gtk_icon_set_add_source(GtkIconSet* icon_set, GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 1, "gtk_icon_set_add_source", "GtkIconSet*");
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 2, "gtk_icon_set_add_source", "GtkIconSource*");
- gtk_icon_set_add_source(XEN_TO_C_GtkIconSet_(icon_set), XEN_TO_C_GtkIconSource_(source));
- return(XEN_FALSE);
+ #define H_gtk_label_get_attributes "PangoAttrList* gtk_label_get_attributes(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_attributes", "GtkLabel*");
+ return(C_to_Xen_PangoAttrList_(gtk_label_get_attributes(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_set_get_sizes(XEN icon_set, XEN ignore_sizes, XEN ignore_n_sizes)
+static Xen gxg_gtk_label_set_label(Xen label, Xen str)
{
- #define H_gtk_icon_set_get_sizes "void gtk_icon_set_get_sizes(GtkIconSet* icon_set, GtkIconSize** [sizes], \
-gint* [n_sizes])"
- GtkIconSize* ref_sizes = NULL;
- gint ref_n_sizes;
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 1, "gtk_icon_set_get_sizes", "GtkIconSet*");
- gtk_icon_set_get_sizes(XEN_TO_C_GtkIconSet_(icon_set), &ref_sizes, &ref_n_sizes);
- return(XEN_LIST_2(C_TO_XEN_GtkIconSize_(ref_sizes), C_TO_XEN_gint(ref_n_sizes)));
+ #define H_gtk_label_set_label "void gtk_label_set_label(GtkLabel* label, gchar* str)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_label", "GtkLabel*");
+ Xen_check_type(Xen_is_gchar_(str), str, 2, "gtk_label_set_label", "gchar*");
+ gtk_label_set_label(Xen_to_C_GtkLabel_(label), Xen_to_C_gchar_(str));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_new(void)
+static Xen gxg_gtk_label_get_label(Xen label)
{
- #define H_gtk_icon_source_new "GtkIconSource* gtk_icon_source_new( void)"
- return(C_TO_XEN_GtkIconSource_(gtk_icon_source_new()));
+ #define H_gtk_label_get_label "gchar* gtk_label_get_label(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_label", "GtkLabel*");
+ return(C_to_Xen_gchar_(gtk_label_get_label(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_source_copy(XEN source)
+static Xen gxg_gtk_label_set_markup(Xen label, Xen str)
{
- #define H_gtk_icon_source_copy "GtkIconSource* gtk_icon_source_copy(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_copy", "GtkIconSource*");
- return(C_TO_XEN_GtkIconSource_(gtk_icon_source_copy(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_set_markup "void gtk_label_set_markup(GtkLabel* label, gchar* str)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_markup", "GtkLabel*");
+ Xen_check_type(Xen_is_gchar_(str), str, 2, "gtk_label_set_markup", "gchar*");
+ gtk_label_set_markup(Xen_to_C_GtkLabel_(label), Xen_to_C_gchar_(str));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_free(XEN source)
+static Xen gxg_gtk_label_set_use_markup(Xen label, Xen setting)
{
- #define H_gtk_icon_source_free "void gtk_icon_source_free(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_free", "GtkIconSource*");
- gtk_icon_source_free(XEN_TO_C_GtkIconSource_(source));
- return(XEN_FALSE);
+ #define H_gtk_label_set_use_markup "void gtk_label_set_use_markup(GtkLabel* label, gboolean setting)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_use_markup", "GtkLabel*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_label_set_use_markup", "gboolean");
+ gtk_label_set_use_markup(Xen_to_C_GtkLabel_(label), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_set_filename(XEN source, XEN filename)
+static Xen gxg_gtk_label_get_use_markup(Xen label)
{
- #define H_gtk_icon_source_set_filename "void gtk_icon_source_set_filename(GtkIconSource* source, gchar* filename)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_set_filename", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 2, "gtk_icon_source_set_filename", "gchar*");
- gtk_icon_source_set_filename(XEN_TO_C_GtkIconSource_(source), XEN_TO_C_gchar_(filename));
- return(XEN_FALSE);
+ #define H_gtk_label_get_use_markup "gboolean gtk_label_get_use_markup(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_use_markup", "GtkLabel*");
+ return(C_to_Xen_gboolean(gtk_label_get_use_markup(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_source_set_pixbuf(XEN source, XEN pixbuf)
+static Xen gxg_gtk_label_set_use_underline(Xen label, Xen setting)
{
- #define H_gtk_icon_source_set_pixbuf "void gtk_icon_source_set_pixbuf(GtkIconSource* source, GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_set_pixbuf", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf) || XEN_FALSE_P(pixbuf), pixbuf, 2, "gtk_icon_source_set_pixbuf", "GdkPixbuf*");
- gtk_icon_source_set_pixbuf(XEN_TO_C_GtkIconSource_(source), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_label_set_use_underline "void gtk_label_set_use_underline(GtkLabel* label, gboolean setting)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_use_underline", "GtkLabel*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_label_set_use_underline", "gboolean");
+ gtk_label_set_use_underline(Xen_to_C_GtkLabel_(label), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_get_filename(XEN source)
+static Xen gxg_gtk_label_get_use_underline(Xen label)
{
- #define H_gtk_icon_source_get_filename "gchar* gtk_icon_source_get_filename(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_filename", "GtkIconSource*");
- return(C_TO_XEN_gchar_(gtk_icon_source_get_filename(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_get_use_underline "gboolean gtk_label_get_use_underline(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_use_underline", "GtkLabel*");
+ return(C_to_Xen_gboolean(gtk_label_get_use_underline(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_source_get_pixbuf(XEN source)
+static Xen gxg_gtk_label_set_markup_with_mnemonic(Xen label, Xen str)
{
- #define H_gtk_icon_source_get_pixbuf "GdkPixbuf* gtk_icon_source_get_pixbuf(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_pixbuf", "GtkIconSource*");
- return(C_TO_XEN_GdkPixbuf_(gtk_icon_source_get_pixbuf(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_set_markup_with_mnemonic "void gtk_label_set_markup_with_mnemonic(GtkLabel* label, \
+gchar* str)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_markup_with_mnemonic", "GtkLabel*");
+ Xen_check_type(Xen_is_gchar_(str), str, 2, "gtk_label_set_markup_with_mnemonic", "gchar*");
+ gtk_label_set_markup_with_mnemonic(Xen_to_C_GtkLabel_(label), Xen_to_C_gchar_(str));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_set_direction_wildcarded(XEN source, XEN setting)
+static Xen gxg_gtk_label_get_mnemonic_keyval(Xen label)
{
- #define H_gtk_icon_source_set_direction_wildcarded "void gtk_icon_source_set_direction_wildcarded(GtkIconSource* source, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_set_direction_wildcarded", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_icon_source_set_direction_wildcarded", "gboolean");
- gtk_icon_source_set_direction_wildcarded(XEN_TO_C_GtkIconSource_(source), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_label_get_mnemonic_keyval "guint gtk_label_get_mnemonic_keyval(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_mnemonic_keyval", "GtkLabel*");
+ return(C_to_Xen_guint(gtk_label_get_mnemonic_keyval(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_source_set_state_wildcarded(XEN source, XEN setting)
+static Xen gxg_gtk_label_set_mnemonic_widget(Xen label, Xen widget)
{
- #define H_gtk_icon_source_set_state_wildcarded "void gtk_icon_source_set_state_wildcarded(GtkIconSource* source, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_set_state_wildcarded", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_icon_source_set_state_wildcarded", "gboolean");
- gtk_icon_source_set_state_wildcarded(XEN_TO_C_GtkIconSource_(source), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_label_set_mnemonic_widget "void gtk_label_set_mnemonic_widget(GtkLabel* label, GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_mnemonic_widget", "GtkLabel*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_label_set_mnemonic_widget", "GtkWidget*");
+ gtk_label_set_mnemonic_widget(Xen_to_C_GtkLabel_(label), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_set_size_wildcarded(XEN source, XEN setting)
+static Xen gxg_gtk_label_get_mnemonic_widget(Xen label)
{
- #define H_gtk_icon_source_set_size_wildcarded "void gtk_icon_source_set_size_wildcarded(GtkIconSource* source, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_set_size_wildcarded", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_icon_source_set_size_wildcarded", "gboolean");
- gtk_icon_source_set_size_wildcarded(XEN_TO_C_GtkIconSource_(source), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_label_get_mnemonic_widget "GtkWidget* gtk_label_get_mnemonic_widget(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_mnemonic_widget", "GtkLabel*");
+ return(C_to_Xen_GtkWidget_(gtk_label_get_mnemonic_widget(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_source_get_size_wildcarded(XEN source)
+static Xen gxg_gtk_label_set_text_with_mnemonic(Xen label, Xen str)
{
- #define H_gtk_icon_source_get_size_wildcarded "gboolean gtk_icon_source_get_size_wildcarded(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_size_wildcarded", "GtkIconSource*");
- return(C_TO_XEN_gboolean(gtk_icon_source_get_size_wildcarded(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_set_text_with_mnemonic "void gtk_label_set_text_with_mnemonic(GtkLabel* label, \
+gchar* str)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_text_with_mnemonic", "GtkLabel*");
+ Xen_check_type(Xen_is_gchar_(str), str, 2, "gtk_label_set_text_with_mnemonic", "gchar*");
+ gtk_label_set_text_with_mnemonic(Xen_to_C_GtkLabel_(label), Xen_to_C_gchar_(str));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_get_state_wildcarded(XEN source)
+static Xen gxg_gtk_label_set_justify(Xen label, Xen jtype)
{
- #define H_gtk_icon_source_get_state_wildcarded "gboolean gtk_icon_source_get_state_wildcarded(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_state_wildcarded", "GtkIconSource*");
- return(C_TO_XEN_gboolean(gtk_icon_source_get_state_wildcarded(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_set_justify "void gtk_label_set_justify(GtkLabel* label, GtkJustification jtype)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_justify", "GtkLabel*");
+ Xen_check_type(Xen_is_GtkJustification(jtype), jtype, 2, "gtk_label_set_justify", "GtkJustification");
+ gtk_label_set_justify(Xen_to_C_GtkLabel_(label), Xen_to_C_GtkJustification(jtype));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_get_direction_wildcarded(XEN source)
+static Xen gxg_gtk_label_get_justify(Xen label)
{
- #define H_gtk_icon_source_get_direction_wildcarded "gboolean gtk_icon_source_get_direction_wildcarded(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_direction_wildcarded", "GtkIconSource*");
- return(C_TO_XEN_gboolean(gtk_icon_source_get_direction_wildcarded(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_get_justify "GtkJustification gtk_label_get_justify(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_justify", "GtkLabel*");
+ return(C_to_Xen_GtkJustification(gtk_label_get_justify(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_source_set_direction(XEN source, XEN direction)
+static Xen gxg_gtk_label_set_pattern(Xen label, Xen pattern)
{
- #define H_gtk_icon_source_set_direction "void gtk_icon_source_set_direction(GtkIconSource* source, \
-GtkTextDirection direction)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_set_direction", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_GtkTextDirection_P(direction), direction, 2, "gtk_icon_source_set_direction", "GtkTextDirection");
- gtk_icon_source_set_direction(XEN_TO_C_GtkIconSource_(source), XEN_TO_C_GtkTextDirection(direction));
- return(XEN_FALSE);
+ #define H_gtk_label_set_pattern "void gtk_label_set_pattern(GtkLabel* label, gchar* pattern)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_pattern", "GtkLabel*");
+ Xen_check_type(Xen_is_gchar_(pattern), pattern, 2, "gtk_label_set_pattern", "gchar*");
+ gtk_label_set_pattern(Xen_to_C_GtkLabel_(label), Xen_to_C_gchar_(pattern));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_set_state(XEN source, XEN state)
+static Xen gxg_gtk_label_set_line_wrap(Xen label, Xen wrap)
{
- #define H_gtk_icon_source_set_state "void gtk_icon_source_set_state(GtkIconSource* source, GtkStateType state)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_set_state", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state), state, 2, "gtk_icon_source_set_state", "GtkStateType");
- gtk_icon_source_set_state(XEN_TO_C_GtkIconSource_(source), XEN_TO_C_GtkStateType(state));
- return(XEN_FALSE);
+ #define H_gtk_label_set_line_wrap "void gtk_label_set_line_wrap(GtkLabel* label, gboolean wrap)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_line_wrap", "GtkLabel*");
+ Xen_check_type(Xen_is_gboolean(wrap), wrap, 2, "gtk_label_set_line_wrap", "gboolean");
+ gtk_label_set_line_wrap(Xen_to_C_GtkLabel_(label), Xen_to_C_gboolean(wrap));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_set_size(XEN source, XEN size)
+static Xen gxg_gtk_label_get_line_wrap(Xen label)
{
- #define H_gtk_icon_source_set_size "void gtk_icon_source_set_size(GtkIconSource* source, GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_set_size", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 2, "gtk_icon_source_set_size", "GtkIconSize");
- gtk_icon_source_set_size(XEN_TO_C_GtkIconSource_(source), XEN_TO_C_GtkIconSize(size));
- return(XEN_FALSE);
+ #define H_gtk_label_get_line_wrap "gboolean gtk_label_get_line_wrap(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_line_wrap", "GtkLabel*");
+ return(C_to_Xen_gboolean(gtk_label_get_line_wrap(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_source_get_direction(XEN source)
+static Xen gxg_gtk_label_set_selectable(Xen label, Xen setting)
{
- #define H_gtk_icon_source_get_direction "GtkTextDirection gtk_icon_source_get_direction(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_direction", "GtkIconSource*");
- return(C_TO_XEN_GtkTextDirection(gtk_icon_source_get_direction(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_set_selectable "void gtk_label_set_selectable(GtkLabel* label, gboolean setting)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_selectable", "GtkLabel*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_label_set_selectable", "gboolean");
+ gtk_label_set_selectable(Xen_to_C_GtkLabel_(label), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_source_get_state(XEN source)
+static Xen gxg_gtk_label_get_selectable(Xen label)
{
- #define H_gtk_icon_source_get_state "GtkStateType gtk_icon_source_get_state(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_state", "GtkIconSource*");
- return(C_TO_XEN_GtkStateType(gtk_icon_source_get_state(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_get_selectable "gboolean gtk_label_get_selectable(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_selectable", "GtkLabel*");
+ return(C_to_Xen_gboolean(gtk_label_get_selectable(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_source_get_size(XEN source)
+static Xen gxg_gtk_label_select_region(Xen label, Xen start_offset, Xen end_offset)
{
- #define H_gtk_icon_source_get_size "GtkIconSize gtk_icon_source_get_size(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_size", "GtkIconSource*");
- return(C_TO_XEN_GtkIconSize(gtk_icon_source_get_size(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_label_select_region "void gtk_label_select_region(GtkLabel* label, gint start_offset, \
+gint end_offset)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_select_region", "GtkLabel*");
+ Xen_check_type(Xen_is_gint(start_offset), start_offset, 2, "gtk_label_select_region", "gint");
+ Xen_check_type(Xen_is_gint(end_offset), end_offset, 3, "gtk_label_select_region", "gint");
+ gtk_label_select_region(Xen_to_C_GtkLabel_(label), Xen_to_C_gint(start_offset), Xen_to_C_gint(end_offset));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_new(void)
+static Xen gxg_gtk_label_get_selection_bounds(Xen label, Xen ignore_start, Xen ignore_end)
{
- #define H_gtk_image_new "GtkWidget* gtk_image_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_image_new()));
+ #define H_gtk_label_get_selection_bounds "gboolean gtk_label_get_selection_bounds(GtkLabel* label, \
+gint* [start], gint* [end])"
+ gint ref_start;
+ gint ref_end;
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_selection_bounds", "GtkLabel*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_label_get_selection_bounds(Xen_to_C_GtkLabel_(label), &ref_start, &ref_end));
+ return(Xen_list_3(result, C_to_Xen_gint(ref_start), C_to_Xen_gint(ref_end)));
+ }
}
-static XEN gxg_gtk_image_new_from_file(XEN filename)
+static Xen gxg_gtk_label_get_layout(Xen label)
{
- #define H_gtk_image_new_from_file "GtkWidget* gtk_image_new_from_file(gchar* filename)"
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 1, "gtk_image_new_from_file", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_image_new_from_file(XEN_TO_C_gchar_(filename))));
+ #define H_gtk_label_get_layout "PangoLayout* gtk_label_get_layout(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_layout", "GtkLabel*");
+ return(C_to_Xen_PangoLayout_(gtk_label_get_layout(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_image_new_from_pixbuf(XEN pixbuf)
+static Xen gxg_gtk_label_get_layout_offsets(Xen label, Xen ignore_x, Xen ignore_y)
{
- #define H_gtk_image_new_from_pixbuf "GtkWidget* gtk_image_new_from_pixbuf(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf) || XEN_FALSE_P(pixbuf), pixbuf, 1, "gtk_image_new_from_pixbuf", "GdkPixbuf*");
- return(C_TO_XEN_GtkWidget_(gtk_image_new_from_pixbuf(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ #define H_gtk_label_get_layout_offsets "void gtk_label_get_layout_offsets(GtkLabel* label, gint* [x], \
+gint* [y])"
+ gint ref_x;
+ gint ref_y;
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_layout_offsets", "GtkLabel*");
+ gtk_label_get_layout_offsets(Xen_to_C_GtkLabel_(label), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y)));
}
-static XEN gxg_gtk_image_new_from_stock(XEN stock_id, XEN size)
+static Xen gxg_gtk_layout_new(Xen hadjustment, Xen vadjustment)
{
- #define H_gtk_image_new_from_stock "GtkWidget* gtk_image_new_from_stock(gchar* stock_id, GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_image_new_from_stock", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 2, "gtk_image_new_from_stock", "GtkIconSize");
- return(C_TO_XEN_GtkWidget_(gtk_image_new_from_stock(XEN_TO_C_gchar_(stock_id), XEN_TO_C_GtkIconSize(size))));
+ #define H_gtk_layout_new "GtkWidget* gtk_layout_new(GtkAdjustment* hadjustment, GtkAdjustment* vadjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(hadjustment) || Xen_is_false(hadjustment), hadjustment, 1, "gtk_layout_new", "GtkAdjustment*");
+ Xen_check_type(Xen_is_GtkAdjustment_(vadjustment) || Xen_is_false(vadjustment), vadjustment, 2, "gtk_layout_new", "GtkAdjustment*");
+ return(C_to_Xen_GtkWidget_(gtk_layout_new(Xen_to_C_GtkAdjustment_(hadjustment), Xen_to_C_GtkAdjustment_(vadjustment))));
}
-static XEN gxg_gtk_image_new_from_icon_set(XEN icon_set, XEN size)
+static Xen gxg_gtk_layout_put(Xen layout, Xen child_widget, Xen x, Xen y)
{
- #define H_gtk_image_new_from_icon_set "GtkWidget* gtk_image_new_from_icon_set(GtkIconSet* icon_set, \
-GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 1, "gtk_image_new_from_icon_set", "GtkIconSet*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 2, "gtk_image_new_from_icon_set", "GtkIconSize");
- return(C_TO_XEN_GtkWidget_(gtk_image_new_from_icon_set(XEN_TO_C_GtkIconSet_(icon_set), XEN_TO_C_GtkIconSize(size))));
+ #define H_gtk_layout_put "void gtk_layout_put(GtkLayout* layout, GtkWidget* child_widget, gint x, gint y)"
+ Xen_check_type(Xen_is_GtkLayout_(layout), layout, 1, "gtk_layout_put", "GtkLayout*");
+ Xen_check_type(Xen_is_GtkWidget_(child_widget), child_widget, 2, "gtk_layout_put", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(x), x, 3, "gtk_layout_put", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 4, "gtk_layout_put", "gint");
+ gtk_layout_put(Xen_to_C_GtkLayout_(layout), Xen_to_C_GtkWidget_(child_widget), Xen_to_C_gint(x), Xen_to_C_gint(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_new_from_animation(XEN animation)
+static Xen gxg_gtk_layout_move(Xen layout, Xen child_widget, Xen x, Xen y)
{
- #define H_gtk_image_new_from_animation "GtkWidget* gtk_image_new_from_animation(GdkPixbufAnimation* animation)"
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimation__P(animation), animation, 1, "gtk_image_new_from_animation", "GdkPixbufAnimation*");
- return(C_TO_XEN_GtkWidget_(gtk_image_new_from_animation(XEN_TO_C_GdkPixbufAnimation_(animation))));
+ #define H_gtk_layout_move "void gtk_layout_move(GtkLayout* layout, GtkWidget* child_widget, gint x, \
+gint y)"
+ Xen_check_type(Xen_is_GtkLayout_(layout), layout, 1, "gtk_layout_move", "GtkLayout*");
+ Xen_check_type(Xen_is_GtkWidget_(child_widget), child_widget, 2, "gtk_layout_move", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(x), x, 3, "gtk_layout_move", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 4, "gtk_layout_move", "gint");
+ gtk_layout_move(Xen_to_C_GtkLayout_(layout), Xen_to_C_GtkWidget_(child_widget), Xen_to_C_gint(x), Xen_to_C_gint(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_set_from_file(XEN image, XEN filename)
+static Xen gxg_gtk_layout_set_size(Xen layout, Xen width, Xen height)
{
- #define H_gtk_image_set_from_file "void gtk_image_set_from_file(GtkImage* image, gchar* filename)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_set_from_file", "GtkImage*");
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 2, "gtk_image_set_from_file", "gchar*");
- gtk_image_set_from_file(XEN_TO_C_GtkImage_(image), XEN_TO_C_gchar_(filename));
- return(XEN_FALSE);
+ #define H_gtk_layout_set_size "void gtk_layout_set_size(GtkLayout* layout, guint width, guint height)"
+ Xen_check_type(Xen_is_GtkLayout_(layout), layout, 1, "gtk_layout_set_size", "GtkLayout*");
+ Xen_check_type(Xen_is_guint(width), width, 2, "gtk_layout_set_size", "guint");
+ Xen_check_type(Xen_is_guint(height), height, 3, "gtk_layout_set_size", "guint");
+ gtk_layout_set_size(Xen_to_C_GtkLayout_(layout), Xen_to_C_guint(width), Xen_to_C_guint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_set_from_pixbuf(XEN image, XEN pixbuf)
+static Xen gxg_gtk_layout_get_size(Xen layout, Xen ignore_width, Xen ignore_height)
{
- #define H_gtk_image_set_from_pixbuf "void gtk_image_set_from_pixbuf(GtkImage* image, GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_set_from_pixbuf", "GtkImage*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf) || XEN_FALSE_P(pixbuf), pixbuf, 2, "gtk_image_set_from_pixbuf", "GdkPixbuf*");
- gtk_image_set_from_pixbuf(XEN_TO_C_GtkImage_(image), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_layout_get_size "void gtk_layout_get_size(GtkLayout* layout, guint* [width], guint* [height])"
+ guint ref_width;
+ guint ref_height;
+ Xen_check_type(Xen_is_GtkLayout_(layout), layout, 1, "gtk_layout_get_size", "GtkLayout*");
+ gtk_layout_get_size(Xen_to_C_GtkLayout_(layout), &ref_width, &ref_height);
+ return(Xen_list_2(C_to_Xen_guint(ref_width), C_to_Xen_guint(ref_height)));
}
-static XEN gxg_gtk_image_set_from_stock(XEN image, XEN stock_id, XEN size)
+static Xen gxg_gtk_list_store_new(Xen n_columns, Xen types)
{
- #define H_gtk_image_set_from_stock "void gtk_image_set_from_stock(GtkImage* image, gchar* stock_id, \
-GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_set_from_stock", "GtkImage*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_image_set_from_stock", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 3, "gtk_image_set_from_stock", "GtkIconSize");
- gtk_image_set_from_stock(XEN_TO_C_GtkImage_(image), XEN_TO_C_gchar_(stock_id), XEN_TO_C_GtkIconSize(size));
- return(XEN_FALSE);
+ #define H_gtk_list_store_new "GtkListStore* gtk_list_store_new(gint n_columns, etc types)"
+ Xen_check_type(Xen_is_gint(n_columns), n_columns, 1, "gtk_list_store_new", "gint");
+ Xen_check_type(Xen_is_etc(types), types, 2, "gtk_list_store_new", "etc");
+ {
+ int etc_len = 0;
+ GtkListStore* result = NULL;
+ gint p_arg0;
+ if (Xen_is_list(types)) etc_len = Xen_list_length(types);
+ if (etc_len < 1) Xen_out_of_range_error("gtk_list_store_new", 1, types, "... list must have at least 1 entry");
+ if (etc_len > 6) Xen_out_of_range_error("gtk_list_store_new", 1, types, "... list too long (max len: 6)");
+ p_arg0 = Xen_to_C_gint(n_columns);
+ switch (etc_len)
+ {
+ case 1: result = gtk_list_store_new(p_arg0, XLG(types, 0)); break;
+ case 2: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1)); break;
+ case 3: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2)); break;
+ case 4: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3)); break;
+ case 5: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3), XLG(types, 4)); break;
+ case 6: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3), XLG(types, 4), XLG(types, 5)); break;
+ }
+ return(C_to_Xen_GtkListStore_(result));
+ }
}
-static XEN gxg_gtk_image_set_from_icon_set(XEN image, XEN icon_set, XEN size)
+static Xen gxg_gtk_list_store_newv(Xen n_columns, Xen types)
{
- #define H_gtk_image_set_from_icon_set "void gtk_image_set_from_icon_set(GtkImage* image, GtkIconSet* icon_set, \
-GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_set_from_icon_set", "GtkImage*");
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 2, "gtk_image_set_from_icon_set", "GtkIconSet*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 3, "gtk_image_set_from_icon_set", "GtkIconSize");
- gtk_image_set_from_icon_set(XEN_TO_C_GtkImage_(image), XEN_TO_C_GtkIconSet_(icon_set), XEN_TO_C_GtkIconSize(size));
- return(XEN_FALSE);
+ #define H_gtk_list_store_newv "GtkListStore* gtk_list_store_newv(gint n_columns, GType* types)"
+ Xen_check_type(Xen_is_gint(n_columns), n_columns, 1, "gtk_list_store_newv", "gint");
+ Xen_check_type(Xen_is_GType_(types), types, 2, "gtk_list_store_newv", "GType*");
+ return(C_to_Xen_GtkListStore_(gtk_list_store_newv(Xen_to_C_gint(n_columns), Xen_to_C_GType_(types))));
}
-static XEN gxg_gtk_image_set_from_animation(XEN image, XEN animation)
+static Xen gxg_gtk_list_store_set_column_types(Xen list_store, Xen n_columns, Xen types)
{
- #define H_gtk_image_set_from_animation "void gtk_image_set_from_animation(GtkImage* image, GdkPixbufAnimation* animation)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_set_from_animation", "GtkImage*");
- XEN_ASSERT_TYPE(XEN_GdkPixbufAnimation__P(animation) || XEN_FALSE_P(animation), animation, 2, "gtk_image_set_from_animation", "GdkPixbufAnimation*");
- gtk_image_set_from_animation(XEN_TO_C_GtkImage_(image), XEN_TO_C_GdkPixbufAnimation_(animation));
- return(XEN_FALSE);
+ #define H_gtk_list_store_set_column_types "void gtk_list_store_set_column_types(GtkListStore* list_store, \
+gint n_columns, GType* types)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_set_column_types", "GtkListStore*");
+ Xen_check_type(Xen_is_gint(n_columns), n_columns, 2, "gtk_list_store_set_column_types", "gint");
+ Xen_check_type(Xen_is_GType_(types), types, 3, "gtk_list_store_set_column_types", "GType*");
+ gtk_list_store_set_column_types(Xen_to_C_GtkListStore_(list_store), Xen_to_C_gint(n_columns), Xen_to_C_GType_(types));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_get_storage_type(XEN image)
+static Xen gxg_gtk_list_store_set(Xen list_store, Xen iter, Xen values)
{
- #define H_gtk_image_get_storage_type "GtkImageType gtk_image_get_storage_type(GtkImage* image)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_get_storage_type", "GtkImage*");
- return(C_TO_XEN_GtkImageType(gtk_image_get_storage_type(XEN_TO_C_GtkImage_(image))));
-}
-
-static XEN gxg_gtk_image_get_pixbuf(XEN image)
-{
- #define H_gtk_image_get_pixbuf "GdkPixbuf* gtk_image_get_pixbuf(GtkImage* image)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_get_pixbuf", "GtkImage*");
- return(C_TO_XEN_GdkPixbuf_(gtk_image_get_pixbuf(XEN_TO_C_GtkImage_(image))));
+ #define H_gtk_list_store_set "void gtk_list_store_set(GtkListStore* list_store, GtkTreeIter* iter, \
+etc values)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_set", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_set", "GtkTreeIter*");
+ Xen_check_type(Xen_is_etc(values), values, 3, "gtk_list_store_set", "etc");
+ {
+ int etc_len = 0;
+ GtkListStore* p_arg0;
+ GtkTreeIter* p_arg1;
+ if (Xen_is_list(values)) etc_len = Xen_list_length(values);
+ if (etc_len < 2) Xen_out_of_range_error("gtk_list_store_set", 2, values, "... list must have at least 2 entries");
+ if (etc_len > 10) Xen_out_of_range_error("gtk_list_store_set", 2, values, "... list too long (max len: 10)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_list_store_set", 2, values, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_GtkListStore_(list_store);
+ p_arg1 = Xen_to_C_GtkTreeIter_(iter);
+ switch (etc_len)
+ {
+ case 2: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), -1); break;
+ case 4: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), -1); break;
+ case 6: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), -1); break;
+ case 8: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), XLI(values, 6), XLS(values, 7), -1); break;
+ case 10: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), XLI(values, 6), XLS(values, 7), XLI(values, 8), XLS(values, 9), -1); break;
+ }
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_image_get_stock(XEN image, XEN ignore_stock_id, XEN ignore_size)
+static Xen gxg_gtk_list_store_insert(Xen list_store, Xen iter, Xen position)
{
- #define H_gtk_image_get_stock "void gtk_image_get_stock(GtkImage* image, gchar** [stock_id], GtkIconSize* [size])"
- gchar* ref_stock_id = NULL;
- GtkIconSize ref_size;
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_get_stock", "GtkImage*");
- gtk_image_get_stock(XEN_TO_C_GtkImage_(image), &ref_stock_id, &ref_size);
- return(XEN_LIST_2(C_TO_XEN_gchar_(ref_stock_id), C_TO_XEN_GtkIconSize(ref_size)));
+ #define H_gtk_list_store_insert "void gtk_list_store_insert(GtkListStore* list_store, GtkTreeIter* iter, \
+gint position)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_insert", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_insert", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_list_store_insert", "gint");
+ gtk_list_store_insert(Xen_to_C_GtkListStore_(list_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_get_icon_set(XEN image, XEN ignore_icon_set, XEN ignore_size)
+static Xen gxg_gtk_list_store_insert_before(Xen list_store, Xen iter, Xen sibling)
{
- #define H_gtk_image_get_icon_set "void gtk_image_get_icon_set(GtkImage* image, GtkIconSet** [icon_set], \
-GtkIconSize* [size])"
- GtkIconSet* ref_icon_set = NULL;
- GtkIconSize ref_size;
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_get_icon_set", "GtkImage*");
- gtk_image_get_icon_set(XEN_TO_C_GtkImage_(image), &ref_icon_set, &ref_size);
- return(XEN_LIST_2(C_TO_XEN_GtkIconSet_(ref_icon_set), C_TO_XEN_GtkIconSize(ref_size)));
+ #define H_gtk_list_store_insert_before "void gtk_list_store_insert_before(GtkListStore* list_store, \
+GtkTreeIter* iter, GtkTreeIter* sibling)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_insert_before", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_insert_before", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(sibling) || Xen_is_false(sibling), sibling, 3, "gtk_list_store_insert_before", "GtkTreeIter*");
+ gtk_list_store_insert_before(Xen_to_C_GtkListStore_(list_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(sibling));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_get_animation(XEN image)
+static Xen gxg_gtk_list_store_insert_after(Xen list_store, Xen iter, Xen sibling)
{
- #define H_gtk_image_get_animation "GdkPixbufAnimation* gtk_image_get_animation(GtkImage* image)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_get_animation", "GtkImage*");
- return(C_TO_XEN_GdkPixbufAnimation_(gtk_image_get_animation(XEN_TO_C_GtkImage_(image))));
+ #define H_gtk_list_store_insert_after "void gtk_list_store_insert_after(GtkListStore* list_store, GtkTreeIter* iter, \
+GtkTreeIter* sibling)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_insert_after", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_insert_after", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(sibling) || Xen_is_false(sibling), sibling, 3, "gtk_list_store_insert_after", "GtkTreeIter*");
+ gtk_list_store_insert_after(Xen_to_C_GtkListStore_(list_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(sibling));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_menu_item_new(void)
+static Xen gxg_gtk_list_store_prepend(Xen list_store, Xen iter)
{
- #define H_gtk_image_menu_item_new "GtkWidget* gtk_image_menu_item_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_image_menu_item_new()));
+ #define H_gtk_list_store_prepend "void gtk_list_store_prepend(GtkListStore* list_store, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_prepend", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_prepend", "GtkTreeIter*");
+ gtk_list_store_prepend(Xen_to_C_GtkListStore_(list_store), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_menu_item_new_with_label(XEN label)
+static Xen gxg_gtk_list_store_append(Xen list_store, Xen iter)
{
- #define H_gtk_image_menu_item_new_with_label "GtkWidget* gtk_image_menu_item_new_with_label(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_image_menu_item_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_image_menu_item_new_with_label(XEN_TO_C_gchar_(label))));
+ #define H_gtk_list_store_append "void gtk_list_store_append(GtkListStore* list_store, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_append", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_append", "GtkTreeIter*");
+ gtk_list_store_append(Xen_to_C_GtkListStore_(list_store), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_menu_item_new_with_mnemonic(XEN label)
+static Xen gxg_gtk_list_store_clear(Xen list_store)
{
- #define H_gtk_image_menu_item_new_with_mnemonic "GtkWidget* gtk_image_menu_item_new_with_mnemonic(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_image_menu_item_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_image_menu_item_new_with_mnemonic(XEN_TO_C_gchar_(label))));
+ #define H_gtk_list_store_clear "void gtk_list_store_clear(GtkListStore* list_store)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_clear", "GtkListStore*");
+ gtk_list_store_clear(Xen_to_C_GtkListStore_(list_store));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_menu_item_new_from_stock(XEN stock_id, XEN accel_group)
+static Xen gxg_gtk_check_version(Xen required_major, Xen required_minor, Xen required_micro)
{
- #define H_gtk_image_menu_item_new_from_stock "GtkWidget* gtk_image_menu_item_new_from_stock(gchar* stock_id, \
-GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_image_menu_item_new_from_stock", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group) || XEN_FALSE_P(accel_group), accel_group, 2, "gtk_image_menu_item_new_from_stock", "GtkAccelGroup*");
- return(C_TO_XEN_GtkWidget_(gtk_image_menu_item_new_from_stock(XEN_TO_C_gchar_(stock_id), XEN_TO_C_GtkAccelGroup_(accel_group))));
+ #define H_gtk_check_version "gchar* gtk_check_version(guint required_major, guint required_minor, guint required_micro)"
+ Xen_check_type(Xen_is_guint(required_major), required_major, 1, "gtk_check_version", "guint");
+ Xen_check_type(Xen_is_guint(required_minor), required_minor, 2, "gtk_check_version", "guint");
+ Xen_check_type(Xen_is_guint(required_micro), required_micro, 3, "gtk_check_version", "guint");
+ return(C_to_Xen_gchar_((gchar*)gtk_check_version(Xen_to_C_guint(required_major), Xen_to_C_guint(required_minor), Xen_to_C_guint(required_micro))));
}
-static XEN gxg_gtk_image_menu_item_set_image(XEN image_menu_item, XEN image)
+static Xen gxg_gtk_disable_setlocale(void)
{
- #define H_gtk_image_menu_item_set_image "void gtk_image_menu_item_set_image(GtkImageMenuItem* image_menu_item, \
-GtkWidget* image)"
- XEN_ASSERT_TYPE(XEN_GtkImageMenuItem__P(image_menu_item), image_menu_item, 1, "gtk_image_menu_item_set_image", "GtkImageMenuItem*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(image), image, 2, "gtk_image_menu_item_set_image", "GtkWidget*");
- gtk_image_menu_item_set_image(XEN_TO_C_GtkImageMenuItem_(image_menu_item), XEN_TO_C_GtkWidget_(image));
- return(XEN_FALSE);
+ #define H_gtk_disable_setlocale "void gtk_disable_setlocale( void)"
+ gtk_disable_setlocale();
+ return(Xen_false);
}
-static XEN gxg_gtk_image_menu_item_get_image(XEN image_menu_item)
+static Xen gxg_gtk_get_default_language(void)
{
- #define H_gtk_image_menu_item_get_image "GtkWidget* gtk_image_menu_item_get_image(GtkImageMenuItem* image_menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkImageMenuItem__P(image_menu_item), image_menu_item, 1, "gtk_image_menu_item_get_image", "GtkImageMenuItem*");
- return(C_TO_XEN_GtkWidget_(gtk_image_menu_item_get_image(XEN_TO_C_GtkImageMenuItem_(image_menu_item))));
+ #define H_gtk_get_default_language "PangoLanguage* gtk_get_default_language( void)"
+ return(C_to_Xen_PangoLanguage_(gtk_get_default_language()));
}
-static XEN gxg_gtk_im_context_set_client_window(XEN context, XEN window)
+static Xen gxg_gtk_events_pending(void)
{
- #define H_gtk_im_context_set_client_window "void gtk_im_context_set_client_window(GtkIMContext* context, \
-GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_set_client_window", "GtkIMContext*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window) || XEN_FALSE_P(window), window, 2, "gtk_im_context_set_client_window", "GdkWindow*");
- gtk_im_context_set_client_window(XEN_TO_C_GtkIMContext_(context), XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gtk_events_pending "gint gtk_events_pending( void)"
+ return(C_to_Xen_gint(gtk_events_pending()));
}
-static XEN gxg_gtk_im_context_get_preedit_string(XEN context, XEN ignore_str, XEN ignore_attrs, XEN ignore_cursor_pos)
+static Xen gxg_gtk_main_do_event(Xen event)
{
- #define H_gtk_im_context_get_preedit_string "void gtk_im_context_get_preedit_string(GtkIMContext* context, \
-gchar** [str], PangoAttrList** [attrs], gint* [cursor_pos])"
- gchar* ref_str = NULL;
- PangoAttrList* ref_attrs = NULL;
- gint ref_cursor_pos;
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_get_preedit_string", "GtkIMContext*");
- gtk_im_context_get_preedit_string(XEN_TO_C_GtkIMContext_(context), &ref_str, &ref_attrs, &ref_cursor_pos);
- return(XEN_LIST_3(C_TO_XEN_gchar_(ref_str), C_TO_XEN_PangoAttrList_(ref_attrs), C_TO_XEN_gint(ref_cursor_pos)));
+ #define H_gtk_main_do_event "void gtk_main_do_event(GdkEvent* event)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gtk_main_do_event", "GdkEvent*");
+ gtk_main_do_event(Xen_to_C_GdkEvent_(event));
+ return(Xen_false);
}
-static XEN gxg_gtk_im_context_filter_keypress(XEN context, XEN event)
+static Xen gxg_gtk_main(void)
{
- #define H_gtk_im_context_filter_keypress "gboolean gtk_im_context_filter_keypress(GtkIMContext* context, \
-GdkEventKey* event)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_filter_keypress", "GtkIMContext*");
- XEN_ASSERT_TYPE(XEN_GdkEventKey__P(event), event, 2, "gtk_im_context_filter_keypress", "GdkEventKey*");
- return(C_TO_XEN_gboolean(gtk_im_context_filter_keypress(XEN_TO_C_GtkIMContext_(context), XEN_TO_C_GdkEventKey_(event))));
+ #define H_gtk_main "void gtk_main( void)"
+ gtk_main();
+ return(Xen_false);
}
-static XEN gxg_gtk_im_context_focus_in(XEN context)
+static Xen gxg_gtk_main_level(void)
{
- #define H_gtk_im_context_focus_in "void gtk_im_context_focus_in(GtkIMContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_focus_in", "GtkIMContext*");
- gtk_im_context_focus_in(XEN_TO_C_GtkIMContext_(context));
- return(XEN_FALSE);
+ #define H_gtk_main_level "guint gtk_main_level( void)"
+ return(C_to_Xen_guint(gtk_main_level()));
}
-static XEN gxg_gtk_im_context_focus_out(XEN context)
+static Xen gxg_gtk_main_quit(void)
{
- #define H_gtk_im_context_focus_out "void gtk_im_context_focus_out(GtkIMContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_focus_out", "GtkIMContext*");
- gtk_im_context_focus_out(XEN_TO_C_GtkIMContext_(context));
- return(XEN_FALSE);
+ #define H_gtk_main_quit "void gtk_main_quit( void)"
+ gtk_main_quit();
+ return(Xen_false);
}
-static XEN gxg_gtk_im_context_reset(XEN context)
+static Xen gxg_gtk_main_iteration(void)
{
- #define H_gtk_im_context_reset "void gtk_im_context_reset(GtkIMContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_reset", "GtkIMContext*");
- gtk_im_context_reset(XEN_TO_C_GtkIMContext_(context));
- return(XEN_FALSE);
+ #define H_gtk_main_iteration "gboolean gtk_main_iteration( void)"
+ return(C_to_Xen_gboolean(gtk_main_iteration()));
}
-static XEN gxg_gtk_im_context_set_cursor_location(XEN context, XEN area)
+static Xen gxg_gtk_main_iteration_do(Xen blocking)
{
- #define H_gtk_im_context_set_cursor_location "void gtk_im_context_set_cursor_location(GtkIMContext* context, \
-GdkRectangle* area)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_set_cursor_location", "GtkIMContext*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(area), area, 2, "gtk_im_context_set_cursor_location", "GdkRectangle*");
- gtk_im_context_set_cursor_location(XEN_TO_C_GtkIMContext_(context), XEN_TO_C_GdkRectangle_(area));
- return(XEN_FALSE);
+ #define H_gtk_main_iteration_do "gboolean gtk_main_iteration_do(gboolean blocking)"
+ Xen_check_type(Xen_is_gboolean(blocking), blocking, 1, "gtk_main_iteration_do", "gboolean");
+ return(C_to_Xen_gboolean(gtk_main_iteration_do(Xen_to_C_gboolean(blocking))));
}
-static XEN gxg_gtk_im_context_set_use_preedit(XEN context, XEN use_preedit)
+static Xen gxg_gtk_true(void)
{
- #define H_gtk_im_context_set_use_preedit "void gtk_im_context_set_use_preedit(GtkIMContext* context, \
-gboolean use_preedit)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_set_use_preedit", "GtkIMContext*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_preedit), use_preedit, 2, "gtk_im_context_set_use_preedit", "gboolean");
- gtk_im_context_set_use_preedit(XEN_TO_C_GtkIMContext_(context), XEN_TO_C_gboolean(use_preedit));
- return(XEN_FALSE);
+ #define H_gtk_true "gboolean gtk_true( void)"
+ return(C_to_Xen_gboolean(gtk_true()));
}
-static XEN gxg_gtk_im_context_set_surrounding(XEN context, XEN text, XEN len, XEN cursor_index)
+static Xen gxg_gtk_false(void)
{
- #define H_gtk_im_context_set_surrounding "void gtk_im_context_set_surrounding(GtkIMContext* context, \
-gchar* text, gint len, gint cursor_index)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_set_surrounding", "GtkIMContext*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_im_context_set_surrounding", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 3, "gtk_im_context_set_surrounding", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(cursor_index), cursor_index, 4, "gtk_im_context_set_surrounding", "gint");
- gtk_im_context_set_surrounding(XEN_TO_C_GtkIMContext_(context), XEN_TO_C_gchar_(text), XEN_TO_C_gint(len), XEN_TO_C_gint(cursor_index));
- return(XEN_FALSE);
+ #define H_gtk_false "gboolean gtk_false( void)"
+ return(C_to_Xen_gboolean(gtk_false()));
}
-static XEN gxg_gtk_im_context_get_surrounding(XEN context, XEN ignore_text, XEN ignore_cursor_index)
+static Xen gxg_gtk_grab_add(Xen widget)
{
- #define H_gtk_im_context_get_surrounding "gboolean gtk_im_context_get_surrounding(GtkIMContext* context, \
-gchar** [text], gint* [cursor_index])"
- gchar* ref_text = NULL;
- gint ref_cursor_index;
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_get_surrounding", "GtkIMContext*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_im_context_get_surrounding(XEN_TO_C_GtkIMContext_(context), &ref_text, &ref_cursor_index));
- return(XEN_LIST_3(result, C_TO_XEN_gchar_(ref_text), C_TO_XEN_gint(ref_cursor_index)));
- }
+ #define H_gtk_grab_add "void gtk_grab_add(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_grab_add", "GtkWidget*");
+ gtk_grab_add(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_im_context_delete_surrounding(XEN context, XEN offset, XEN n_chars)
+static Xen gxg_gtk_grab_get_current(void)
{
- #define H_gtk_im_context_delete_surrounding "gboolean gtk_im_context_delete_surrounding(GtkIMContext* context, \
-gint offset, gint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkIMContext__P(context), context, 1, "gtk_im_context_delete_surrounding", "GtkIMContext*");
- XEN_ASSERT_TYPE(XEN_gint_P(offset), offset, 2, "gtk_im_context_delete_surrounding", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(n_chars), n_chars, 3, "gtk_im_context_delete_surrounding", "gint");
- return(C_TO_XEN_gboolean(gtk_im_context_delete_surrounding(XEN_TO_C_GtkIMContext_(context), XEN_TO_C_gint(offset), XEN_TO_C_gint(n_chars))));
+ #define H_gtk_grab_get_current "GtkWidget* gtk_grab_get_current( void)"
+ return(C_to_Xen_GtkWidget_(gtk_grab_get_current()));
}
-static XEN gxg_gtk_im_context_simple_new(void)
+static Xen gxg_gtk_grab_remove(Xen widget)
{
- #define H_gtk_im_context_simple_new "GtkIMContext* gtk_im_context_simple_new( void)"
- return(C_TO_XEN_GtkIMContext_(gtk_im_context_simple_new()));
+ #define H_gtk_grab_remove "void gtk_grab_remove(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_grab_remove", "GtkWidget*");
+ gtk_grab_remove(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_im_context_simple_add_table(XEN context_simple, XEN data, XEN max_seq_len, XEN n_seqs)
+static Xen gxg_gtk_get_current_event(void)
{
- #define H_gtk_im_context_simple_add_table "void gtk_im_context_simple_add_table(GtkIMContextSimple* context_simple, \
-guint16* data, gint max_seq_len, gint n_seqs)"
- XEN_ASSERT_TYPE(XEN_GtkIMContextSimple__P(context_simple), context_simple, 1, "gtk_im_context_simple_add_table", "GtkIMContextSimple*");
- XEN_ASSERT_TYPE(XEN_guint16__P(data), data, 2, "gtk_im_context_simple_add_table", "guint16*");
- XEN_ASSERT_TYPE(XEN_gint_P(max_seq_len), max_seq_len, 3, "gtk_im_context_simple_add_table", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(n_seqs), n_seqs, 4, "gtk_im_context_simple_add_table", "gint");
- gtk_im_context_simple_add_table(XEN_TO_C_GtkIMContextSimple_(context_simple), XEN_TO_C_guint16_(data), XEN_TO_C_gint(max_seq_len),
- XEN_TO_C_gint(n_seqs));
- return(XEN_FALSE);
+ #define H_gtk_get_current_event "GdkEvent* gtk_get_current_event( void)"
+ return(C_to_Xen_GdkEvent_(gtk_get_current_event()));
}
-static XEN gxg_gtk_im_multicontext_new(void)
+static Xen gxg_gtk_get_current_event_time(void)
{
- #define H_gtk_im_multicontext_new "GtkIMContext* gtk_im_multicontext_new( void)"
- return(C_TO_XEN_GtkIMContext_(gtk_im_multicontext_new()));
+ #define H_gtk_get_current_event_time "guint32 gtk_get_current_event_time( void)"
+ return(C_to_Xen_guint32(gtk_get_current_event_time()));
}
-static XEN gxg_gtk_im_multicontext_append_menuitems(XEN context, XEN menushell)
+static Xen gxg_gtk_get_current_event_state(Xen ignore_state)
{
- #define H_gtk_im_multicontext_append_menuitems "void gtk_im_multicontext_append_menuitems(GtkIMMulticontext* context, \
-GtkMenuShell* menushell)"
- XEN_ASSERT_TYPE(XEN_GtkIMMulticontext__P(context), context, 1, "gtk_im_multicontext_append_menuitems", "GtkIMMulticontext*");
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menushell), menushell, 2, "gtk_im_multicontext_append_menuitems", "GtkMenuShell*");
- gtk_im_multicontext_append_menuitems(XEN_TO_C_GtkIMMulticontext_(context), XEN_TO_C_GtkMenuShell_(menushell));
- return(XEN_FALSE);
+ #define H_gtk_get_current_event_state "gboolean gtk_get_current_event_state(GdkModifierType* [state])"
+ GdkModifierType ref_state;
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_get_current_event_state(&ref_state));
+ return(Xen_list_2(result, C_to_Xen_GdkModifierType(ref_state)));
+ }
}
-static XEN gxg_gtk_invisible_new(void)
+static Xen gxg_gtk_get_event_widget(Xen event)
{
- #define H_gtk_invisible_new "GtkWidget* gtk_invisible_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_invisible_new()));
+ #define H_gtk_get_event_widget "GtkWidget* gtk_get_event_widget(GdkEvent* event)"
+ Xen_check_type(Xen_is_GdkEvent_(event) || Xen_is_false(event), event, 1, "gtk_get_event_widget", "GdkEvent*");
+ return(C_to_Xen_GtkWidget_(gtk_get_event_widget(Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_label_new(XEN str)
+static Xen gxg_gtk_propagate_event(Xen widget, Xen event)
{
- #define H_gtk_label_new "GtkWidget* gtk_label_new(char* str)"
- XEN_ASSERT_TYPE(XEN_char__P(str), str, 1, "gtk_label_new", "char*");
- return(C_TO_XEN_GtkWidget_(gtk_label_new(XEN_TO_C_char_(str))));
+ #define H_gtk_propagate_event "void gtk_propagate_event(GtkWidget* widget, GdkEvent* event)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_propagate_event", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gtk_propagate_event", "GdkEvent*");
+ gtk_propagate_event(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkEvent_(event));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_new_with_mnemonic(XEN str)
+static Xen gxg_gtk_menu_bar_new(void)
{
- #define H_gtk_label_new_with_mnemonic "GtkWidget* gtk_label_new_with_mnemonic(char* str)"
- XEN_ASSERT_TYPE(XEN_char__P(str), str, 1, "gtk_label_new_with_mnemonic", "char*");
- return(C_TO_XEN_GtkWidget_(gtk_label_new_with_mnemonic(XEN_TO_C_char_(str))));
+ #define H_gtk_menu_bar_new "GtkWidget* gtk_menu_bar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_menu_bar_new()));
}
-static XEN gxg_gtk_label_set_text(XEN label, XEN str)
+static Xen gxg_gtk_menu_new(void)
{
- #define H_gtk_label_set_text "void gtk_label_set_text(GtkLabel* label, char* str)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_text", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_char__P(str), str, 2, "gtk_label_set_text", "char*");
- gtk_label_set_text(XEN_TO_C_GtkLabel_(label), XEN_TO_C_char_(str));
- return(XEN_FALSE);
+ #define H_gtk_menu_new "GtkWidget* gtk_menu_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_menu_new()));
}
-static XEN gxg_gtk_label_get_text(XEN label)
+static Xen gxg_gtk_menu_popup(Xen menu, Xen parent_menu_shell, Xen parent_menu_item, Xen func, Xen func_info, Xen button, Xen activate_time)
{
- #define H_gtk_label_get_text "gchar* gtk_label_get_text(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_text", "GtkLabel*");
- return(C_TO_XEN_gchar_(gtk_label_get_text(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_popup "void gtk_menu_popup(GtkMenu* menu, GtkWidget* parent_menu_shell, GtkWidget* parent_menu_item, \
+GtkMenuPositionFunc func, lambda_data func_info, guint button, guint32 activate_time)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_popup", "GtkMenu*");
+ Xen_check_type(Xen_is_GtkWidget_(parent_menu_shell) || Xen_is_false(parent_menu_shell), parent_menu_shell, 2, "gtk_menu_popup", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(parent_menu_item) || Xen_is_false(parent_menu_item), parent_menu_item, 3, "gtk_menu_popup", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkMenuPositionFunc(func), func, 4, "gtk_menu_popup", "GtkMenuPositionFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 5, "gtk_menu_popup", "lambda_data");
+ Xen_check_type(Xen_is_guint(button), button, 6, "gtk_menu_popup", "guint");
+ Xen_check_type(Xen_is_guint32(activate_time), activate_time, 7, "gtk_menu_popup", "guint32");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ gtk_menu_popup(Xen_to_C_GtkMenu_(menu), Xen_to_C_GtkWidget_(parent_menu_shell), Xen_to_C_GtkWidget_(parent_menu_item), Xen_to_C_GtkMenuPositionFunc(func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_guint(button), Xen_to_C_guint32(activate_time));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_label_set_attributes(XEN label, XEN attrs)
+static Xen gxg_gtk_menu_reposition(Xen menu)
{
- #define H_gtk_label_set_attributes "void gtk_label_set_attributes(GtkLabel* label, PangoAttrList* attrs)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_attributes", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(attrs), attrs, 2, "gtk_label_set_attributes", "PangoAttrList*");
- gtk_label_set_attributes(XEN_TO_C_GtkLabel_(label), XEN_TO_C_PangoAttrList_(attrs));
- return(XEN_FALSE);
+ #define H_gtk_menu_reposition "void gtk_menu_reposition(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_reposition", "GtkMenu*");
+ gtk_menu_reposition(Xen_to_C_GtkMenu_(menu));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_attributes(XEN label)
+static Xen gxg_gtk_menu_popdown(Xen menu)
{
- #define H_gtk_label_get_attributes "PangoAttrList* gtk_label_get_attributes(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_attributes", "GtkLabel*");
- return(C_TO_XEN_PangoAttrList_(gtk_label_get_attributes(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_popdown "void gtk_menu_popdown(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_popdown", "GtkMenu*");
+ gtk_menu_popdown(Xen_to_C_GtkMenu_(menu));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_label(XEN label, XEN str)
+static Xen gxg_gtk_menu_get_active(Xen menu)
{
- #define H_gtk_label_set_label "void gtk_label_set_label(GtkLabel* label, gchar* str)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_label", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 2, "gtk_label_set_label", "gchar*");
- gtk_label_set_label(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gchar_(str));
- return(XEN_FALSE);
+ #define H_gtk_menu_get_active "GtkWidget* gtk_menu_get_active(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_get_active", "GtkMenu*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_get_active(Xen_to_C_GtkMenu_(menu))));
}
-static XEN gxg_gtk_label_get_label(XEN label)
+static Xen gxg_gtk_menu_set_active(Xen menu, Xen index)
{
- #define H_gtk_label_get_label "gchar* gtk_label_get_label(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_label", "GtkLabel*");
- return(C_TO_XEN_gchar_(gtk_label_get_label(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_set_active "void gtk_menu_set_active(GtkMenu* menu, guint index)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_set_active", "GtkMenu*");
+ Xen_check_type(Xen_is_guint(index), index, 2, "gtk_menu_set_active", "guint");
+ gtk_menu_set_active(Xen_to_C_GtkMenu_(menu), Xen_to_C_guint(index));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_markup(XEN label, XEN str)
+static Xen gxg_gtk_menu_set_accel_group(Xen menu, Xen accel_group)
{
- #define H_gtk_label_set_markup "void gtk_label_set_markup(GtkLabel* label, gchar* str)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_markup", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 2, "gtk_label_set_markup", "gchar*");
- gtk_label_set_markup(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gchar_(str));
- return(XEN_FALSE);
+ #define H_gtk_menu_set_accel_group "void gtk_menu_set_accel_group(GtkMenu* menu, GtkAccelGroup* accel_group)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_set_accel_group", "GtkMenu*");
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group) || Xen_is_false(accel_group), accel_group, 2, "gtk_menu_set_accel_group", "GtkAccelGroup*");
+ gtk_menu_set_accel_group(Xen_to_C_GtkMenu_(menu), Xen_to_C_GtkAccelGroup_(accel_group));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_use_markup(XEN label, XEN setting)
+static Xen gxg_gtk_menu_get_accel_group(Xen menu)
{
- #define H_gtk_label_set_use_markup "void gtk_label_set_use_markup(GtkLabel* label, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_use_markup", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_label_set_use_markup", "gboolean");
- gtk_label_set_use_markup(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_menu_get_accel_group "GtkAccelGroup* gtk_menu_get_accel_group(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_get_accel_group", "GtkMenu*");
+ return(C_to_Xen_GtkAccelGroup_(gtk_menu_get_accel_group(Xen_to_C_GtkMenu_(menu))));
}
-static XEN gxg_gtk_label_get_use_markup(XEN label)
+static Xen gxg_gtk_menu_set_accel_path(Xen menu, Xen accel_path)
{
- #define H_gtk_label_get_use_markup "gboolean gtk_label_get_use_markup(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_use_markup", "GtkLabel*");
- return(C_TO_XEN_gboolean(gtk_label_get_use_markup(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_set_accel_path "void gtk_menu_set_accel_path(GtkMenu* menu, gchar* accel_path)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_set_accel_path", "GtkMenu*");
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 2, "gtk_menu_set_accel_path", "gchar*");
+ gtk_menu_set_accel_path(Xen_to_C_GtkMenu_(menu), Xen_to_C_gchar_(accel_path));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_use_underline(XEN label, XEN setting)
+static Xen gxg_gtk_menu_detach(Xen menu)
{
- #define H_gtk_label_set_use_underline "void gtk_label_set_use_underline(GtkLabel* label, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_use_underline", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_label_set_use_underline", "gboolean");
- gtk_label_set_use_underline(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_menu_detach "void gtk_menu_detach(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_detach", "GtkMenu*");
+ gtk_menu_detach(Xen_to_C_GtkMenu_(menu));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_use_underline(XEN label)
+static Xen gxg_gtk_menu_get_attach_widget(Xen menu)
{
- #define H_gtk_label_get_use_underline "gboolean gtk_label_get_use_underline(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_use_underline", "GtkLabel*");
- return(C_TO_XEN_gboolean(gtk_label_get_use_underline(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_get_attach_widget "GtkWidget* gtk_menu_get_attach_widget(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_get_attach_widget", "GtkMenu*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_get_attach_widget(Xen_to_C_GtkMenu_(menu))));
}
-static XEN gxg_gtk_label_set_markup_with_mnemonic(XEN label, XEN str)
+static Xen gxg_gtk_menu_reorder_child(Xen menu, Xen child, Xen position)
{
- #define H_gtk_label_set_markup_with_mnemonic "void gtk_label_set_markup_with_mnemonic(GtkLabel* label, \
-gchar* str)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_markup_with_mnemonic", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 2, "gtk_label_set_markup_with_mnemonic", "gchar*");
- gtk_label_set_markup_with_mnemonic(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gchar_(str));
- return(XEN_FALSE);
+ #define H_gtk_menu_reorder_child "void gtk_menu_reorder_child(GtkMenu* menu, GtkWidget* child, gint position)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_reorder_child", "GtkMenu*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_menu_reorder_child", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_menu_reorder_child", "gint");
+ gtk_menu_reorder_child(Xen_to_C_GtkMenu_(menu), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_mnemonic_keyval(XEN label)
+static Xen gxg_gtk_menu_set_monitor(Xen menu, Xen monitor_num)
{
- #define H_gtk_label_get_mnemonic_keyval "guint gtk_label_get_mnemonic_keyval(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_mnemonic_keyval", "GtkLabel*");
- return(C_TO_XEN_guint(gtk_label_get_mnemonic_keyval(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_set_monitor "void gtk_menu_set_monitor(GtkMenu* menu, gint monitor_num)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_set_monitor", "GtkMenu*");
+ Xen_check_type(Xen_is_gint(monitor_num), monitor_num, 2, "gtk_menu_set_monitor", "gint");
+ gtk_menu_set_monitor(Xen_to_C_GtkMenu_(menu), Xen_to_C_gint(monitor_num));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_mnemonic_widget(XEN label, XEN widget)
+static Xen gxg_gtk_menu_item_new(void)
{
- #define H_gtk_label_set_mnemonic_widget "void gtk_label_set_mnemonic_widget(GtkLabel* label, GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_mnemonic_widget", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_label_set_mnemonic_widget", "GtkWidget*");
- gtk_label_set_mnemonic_widget(XEN_TO_C_GtkLabel_(label), XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_menu_item_new "GtkWidget* gtk_menu_item_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_menu_item_new()));
}
-static XEN gxg_gtk_label_get_mnemonic_widget(XEN label)
+static Xen gxg_gtk_menu_item_new_with_label(Xen label)
{
- #define H_gtk_label_get_mnemonic_widget "GtkWidget* gtk_label_get_mnemonic_widget(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_mnemonic_widget", "GtkLabel*");
- return(C_TO_XEN_GtkWidget_(gtk_label_get_mnemonic_widget(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_item_new_with_label "GtkWidget* gtk_menu_item_new_with_label(gchar* label)"
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_menu_item_new_with_label", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_item_new_with_label(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_label_set_text_with_mnemonic(XEN label, XEN str)
+static Xen gxg_gtk_menu_item_new_with_mnemonic(Xen label)
{
- #define H_gtk_label_set_text_with_mnemonic "void gtk_label_set_text_with_mnemonic(GtkLabel* label, \
-gchar* str)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_text_with_mnemonic", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 2, "gtk_label_set_text_with_mnemonic", "gchar*");
- gtk_label_set_text_with_mnemonic(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gchar_(str));
- return(XEN_FALSE);
+ #define H_gtk_menu_item_new_with_mnemonic "GtkWidget* gtk_menu_item_new_with_mnemonic(gchar* label)"
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_menu_item_new_with_mnemonic", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_item_new_with_mnemonic(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_label_set_justify(XEN label, XEN jtype)
+static Xen gxg_gtk_menu_item_set_submenu(Xen menu_item, Xen submenu)
{
- #define H_gtk_label_set_justify "void gtk_label_set_justify(GtkLabel* label, GtkJustification jtype)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_justify", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_GtkJustification_P(jtype), jtype, 2, "gtk_label_set_justify", "GtkJustification");
- gtk_label_set_justify(XEN_TO_C_GtkLabel_(label), XEN_TO_C_GtkJustification(jtype));
- return(XEN_FALSE);
+ #define H_gtk_menu_item_set_submenu "void gtk_menu_item_set_submenu(GtkMenuItem* menu_item, GtkWidget* submenu)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_set_submenu", "GtkMenuItem*");
+ Xen_check_type(Xen_is_GtkWidget_(submenu), submenu, 2, "gtk_menu_item_set_submenu", "GtkWidget*");
+ gtk_menu_item_set_submenu(Xen_to_C_GtkMenuItem_(menu_item), Xen_to_C_GtkWidget_(submenu));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_justify(XEN label)
+static Xen gxg_gtk_menu_item_get_submenu(Xen menu_item)
{
- #define H_gtk_label_get_justify "GtkJustification gtk_label_get_justify(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_justify", "GtkLabel*");
- return(C_TO_XEN_GtkJustification(gtk_label_get_justify(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_item_get_submenu "GtkWidget* gtk_menu_item_get_submenu(GtkMenuItem* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_get_submenu", "GtkMenuItem*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_item_get_submenu(Xen_to_C_GtkMenuItem_(menu_item))));
}
-static XEN gxg_gtk_label_set_pattern(XEN label, XEN pattern)
+static Xen gxg_gtk_menu_item_select(Xen menu_item)
{
- #define H_gtk_label_set_pattern "void gtk_label_set_pattern(GtkLabel* label, gchar* pattern)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_pattern", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gchar__P(pattern), pattern, 2, "gtk_label_set_pattern", "gchar*");
- gtk_label_set_pattern(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gchar_(pattern));
- return(XEN_FALSE);
+ #define H_gtk_menu_item_select "void gtk_menu_item_select(GtkMenuItem* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_select", "GtkMenuItem*");
+ gtk_menu_item_select(Xen_to_C_GtkMenuItem_(menu_item));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_line_wrap(XEN label, XEN wrap)
+static Xen gxg_gtk_menu_item_deselect(Xen menu_item)
{
- #define H_gtk_label_set_line_wrap "void gtk_label_set_line_wrap(GtkLabel* label, gboolean wrap)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_line_wrap", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(wrap), wrap, 2, "gtk_label_set_line_wrap", "gboolean");
- gtk_label_set_line_wrap(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gboolean(wrap));
- return(XEN_FALSE);
+ #define H_gtk_menu_item_deselect "void gtk_menu_item_deselect(GtkMenuItem* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_deselect", "GtkMenuItem*");
+ gtk_menu_item_deselect(Xen_to_C_GtkMenuItem_(menu_item));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_line_wrap(XEN label)
+static Xen gxg_gtk_menu_item_activate(Xen menu_item)
{
- #define H_gtk_label_get_line_wrap "gboolean gtk_label_get_line_wrap(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_line_wrap", "GtkLabel*");
- return(C_TO_XEN_gboolean(gtk_label_get_line_wrap(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_item_activate "void gtk_menu_item_activate(GtkMenuItem* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_activate", "GtkMenuItem*");
+ gtk_menu_item_activate(Xen_to_C_GtkMenuItem_(menu_item));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_selectable(XEN label, XEN setting)
+static Xen gxg_gtk_menu_item_toggle_size_request(Xen menu_item, Xen requisition)
{
- #define H_gtk_label_set_selectable "void gtk_label_set_selectable(GtkLabel* label, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_selectable", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_label_set_selectable", "gboolean");
- gtk_label_set_selectable(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_menu_item_toggle_size_request "void gtk_menu_item_toggle_size_request(GtkMenuItem* menu_item, \
+gint* requisition)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_toggle_size_request", "GtkMenuItem*");
+ Xen_check_type(Xen_is_gint_(requisition), requisition, 2, "gtk_menu_item_toggle_size_request", "gint*");
+ gtk_menu_item_toggle_size_request(Xen_to_C_GtkMenuItem_(menu_item), Xen_to_C_gint_(requisition));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_selectable(XEN label)
+static Xen gxg_gtk_menu_item_toggle_size_allocate(Xen menu_item, Xen allocation)
{
- #define H_gtk_label_get_selectable "gboolean gtk_label_get_selectable(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_selectable", "GtkLabel*");
- return(C_TO_XEN_gboolean(gtk_label_get_selectable(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_item_toggle_size_allocate "void gtk_menu_item_toggle_size_allocate(GtkMenuItem* menu_item, \
+gint allocation)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_toggle_size_allocate", "GtkMenuItem*");
+ Xen_check_type(Xen_is_gint(allocation), allocation, 2, "gtk_menu_item_toggle_size_allocate", "gint");
+ gtk_menu_item_toggle_size_allocate(Xen_to_C_GtkMenuItem_(menu_item), Xen_to_C_gint(allocation));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_select_region(XEN label, XEN start_offset, XEN end_offset)
+static Xen gxg_gtk_menu_item_set_accel_path(Xen menu_item, Xen accel_path)
{
- #define H_gtk_label_select_region "void gtk_label_select_region(GtkLabel* label, gint start_offset, \
-gint end_offset)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_select_region", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gint_P(start_offset), start_offset, 2, "gtk_label_select_region", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(end_offset), end_offset, 3, "gtk_label_select_region", "gint");
- gtk_label_select_region(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gint(start_offset), XEN_TO_C_gint(end_offset));
- return(XEN_FALSE);
+ #define H_gtk_menu_item_set_accel_path "void gtk_menu_item_set_accel_path(GtkMenuItem* menu_item, gchar* accel_path)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_set_accel_path", "GtkMenuItem*");
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 2, "gtk_menu_item_set_accel_path", "gchar*");
+ gtk_menu_item_set_accel_path(Xen_to_C_GtkMenuItem_(menu_item), Xen_to_C_gchar_(accel_path));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_selection_bounds(XEN label, XEN ignore_start, XEN ignore_end)
+static Xen gxg_gtk_menu_shell_append(Xen menu_shell, Xen child)
{
- #define H_gtk_label_get_selection_bounds "gboolean gtk_label_get_selection_bounds(GtkLabel* label, \
-gint* [start], gint* [end])"
- gint ref_start;
- gint ref_end;
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_selection_bounds", "GtkLabel*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_label_get_selection_bounds(XEN_TO_C_GtkLabel_(label), &ref_start, &ref_end));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_start), C_TO_XEN_gint(ref_end)));
- }
+ #define H_gtk_menu_shell_append "void gtk_menu_shell_append(GtkMenuShell* menu_shell, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_append", "GtkMenuShell*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_menu_shell_append", "GtkWidget*");
+ gtk_menu_shell_append(Xen_to_C_GtkMenuShell_(menu_shell), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_layout(XEN label)
+static Xen gxg_gtk_menu_shell_prepend(Xen menu_shell, Xen child)
{
- #define H_gtk_label_get_layout "PangoLayout* gtk_label_get_layout(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_layout", "GtkLabel*");
- return(C_TO_XEN_PangoLayout_(gtk_label_get_layout(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_menu_shell_prepend "void gtk_menu_shell_prepend(GtkMenuShell* menu_shell, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_prepend", "GtkMenuShell*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_menu_shell_prepend", "GtkWidget*");
+ gtk_menu_shell_prepend(Xen_to_C_GtkMenuShell_(menu_shell), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_layout_offsets(XEN label, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gtk_menu_shell_insert(Xen menu_shell, Xen child, Xen position)
{
- #define H_gtk_label_get_layout_offsets "void gtk_label_get_layout_offsets(GtkLabel* label, gint* [x], \
-gint* [y])"
- gint ref_x;
- gint ref_y;
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_layout_offsets", "GtkLabel*");
- gtk_label_get_layout_offsets(XEN_TO_C_GtkLabel_(label), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y)));
+ #define H_gtk_menu_shell_insert "void gtk_menu_shell_insert(GtkMenuShell* menu_shell, GtkWidget* child, \
+gint position)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_insert", "GtkMenuShell*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_menu_shell_insert", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_menu_shell_insert", "gint");
+ gtk_menu_shell_insert(Xen_to_C_GtkMenuShell_(menu_shell), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_layout_new(XEN hadjustment, XEN vadjustment)
+static Xen gxg_gtk_menu_shell_deactivate(Xen menu_shell)
{
- #define H_gtk_layout_new "GtkWidget* gtk_layout_new(GtkAdjustment* hadjustment, GtkAdjustment* vadjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(hadjustment) || XEN_FALSE_P(hadjustment), hadjustment, 1, "gtk_layout_new", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(vadjustment) || XEN_FALSE_P(vadjustment), vadjustment, 2, "gtk_layout_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_layout_new(XEN_TO_C_GtkAdjustment_(hadjustment), XEN_TO_C_GtkAdjustment_(vadjustment))));
+ #define H_gtk_menu_shell_deactivate "void gtk_menu_shell_deactivate(GtkMenuShell* menu_shell)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_deactivate", "GtkMenuShell*");
+ gtk_menu_shell_deactivate(Xen_to_C_GtkMenuShell_(menu_shell));
+ return(Xen_false);
}
-static XEN gxg_gtk_layout_put(XEN layout, XEN child_widget, XEN x, XEN y)
+static Xen gxg_gtk_menu_shell_select_item(Xen menu_shell, Xen menu_item)
{
- #define H_gtk_layout_put "void gtk_layout_put(GtkLayout* layout, GtkWidget* child_widget, gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkLayout__P(layout), layout, 1, "gtk_layout_put", "GtkLayout*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child_widget), child_widget, 2, "gtk_layout_put", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 3, "gtk_layout_put", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 4, "gtk_layout_put", "gint");
- gtk_layout_put(XEN_TO_C_GtkLayout_(layout), XEN_TO_C_GtkWidget_(child_widget), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
+ #define H_gtk_menu_shell_select_item "void gtk_menu_shell_select_item(GtkMenuShell* menu_shell, GtkWidget* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_select_item", "GtkMenuShell*");
+ Xen_check_type(Xen_is_GtkWidget_(menu_item), menu_item, 2, "gtk_menu_shell_select_item", "GtkWidget*");
+ gtk_menu_shell_select_item(Xen_to_C_GtkMenuShell_(menu_shell), Xen_to_C_GtkWidget_(menu_item));
+ return(Xen_false);
}
-static XEN gxg_gtk_layout_move(XEN layout, XEN child_widget, XEN x, XEN y)
+static Xen gxg_gtk_menu_shell_deselect(Xen menu_shell)
{
- #define H_gtk_layout_move "void gtk_layout_move(GtkLayout* layout, GtkWidget* child_widget, gint x, \
-gint y)"
- XEN_ASSERT_TYPE(XEN_GtkLayout__P(layout), layout, 1, "gtk_layout_move", "GtkLayout*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child_widget), child_widget, 2, "gtk_layout_move", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 3, "gtk_layout_move", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 4, "gtk_layout_move", "gint");
- gtk_layout_move(XEN_TO_C_GtkLayout_(layout), XEN_TO_C_GtkWidget_(child_widget), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
+ #define H_gtk_menu_shell_deselect "void gtk_menu_shell_deselect(GtkMenuShell* menu_shell)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_deselect", "GtkMenuShell*");
+ gtk_menu_shell_deselect(Xen_to_C_GtkMenuShell_(menu_shell));
+ return(Xen_false);
}
-static XEN gxg_gtk_layout_set_size(XEN layout, XEN width, XEN height)
+static Xen gxg_gtk_menu_shell_activate_item(Xen menu_shell, Xen menu_item, Xen force_deactivate)
{
- #define H_gtk_layout_set_size "void gtk_layout_set_size(GtkLayout* layout, guint width, guint height)"
- XEN_ASSERT_TYPE(XEN_GtkLayout__P(layout), layout, 1, "gtk_layout_set_size", "GtkLayout*");
- XEN_ASSERT_TYPE(XEN_guint_P(width), width, 2, "gtk_layout_set_size", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(height), height, 3, "gtk_layout_set_size", "guint");
- gtk_layout_set_size(XEN_TO_C_GtkLayout_(layout), XEN_TO_C_guint(width), XEN_TO_C_guint(height));
- return(XEN_FALSE);
+ #define H_gtk_menu_shell_activate_item "void gtk_menu_shell_activate_item(GtkMenuShell* menu_shell, \
+GtkWidget* menu_item, gboolean force_deactivate)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_activate_item", "GtkMenuShell*");
+ Xen_check_type(Xen_is_GtkWidget_(menu_item), menu_item, 2, "gtk_menu_shell_activate_item", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(force_deactivate), force_deactivate, 3, "gtk_menu_shell_activate_item", "gboolean");
+ gtk_menu_shell_activate_item(Xen_to_C_GtkMenuShell_(menu_shell), Xen_to_C_GtkWidget_(menu_item), Xen_to_C_gboolean(force_deactivate));
+ return(Xen_false);
}
-static XEN gxg_gtk_layout_get_size(XEN layout, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_notebook_new(void)
{
- #define H_gtk_layout_get_size "void gtk_layout_get_size(GtkLayout* layout, guint* [width], guint* [height])"
- guint ref_width;
- guint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkLayout__P(layout), layout, 1, "gtk_layout_get_size", "GtkLayout*");
- gtk_layout_get_size(XEN_TO_C_GtkLayout_(layout), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_guint(ref_width), C_TO_XEN_guint(ref_height)));
+ #define H_gtk_notebook_new "GtkWidget* gtk_notebook_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_notebook_new()));
}
-static XEN gxg_gtk_list_store_new(XEN n_columns, XEN types)
+static Xen gxg_gtk_notebook_remove_page(Xen notebook, Xen page_num)
{
- #define H_gtk_list_store_new "GtkListStore* gtk_list_store_new(gint n_columns, etc types)"
- XEN_ASSERT_TYPE(XEN_gint_P(n_columns), n_columns, 1, "gtk_list_store_new", "gint");
- XEN_ASSERT_TYPE(XEN_etc_P(types), types, 2, "gtk_list_store_new", "etc");
- {
- int etc_len = 0;
- GtkListStore* result = NULL;
- gint p_arg0;
- if (XEN_LIST_P(types)) etc_len = XEN_LIST_LENGTH(types);
- if (etc_len < 1) XEN_OUT_OF_RANGE_ERROR("gtk_list_store_new", 1, types, "... list must have at least 1 entry");
- if (etc_len > 6) XEN_OUT_OF_RANGE_ERROR("gtk_list_store_new", 1, types, "... list too long (max len: 6)");
- p_arg0 = XEN_TO_C_gint(n_columns);
- switch (etc_len)
- {
- case 1: result = gtk_list_store_new(p_arg0, XLG(types, 0)); break;
- case 2: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1)); break;
- case 3: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2)); break;
- case 4: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3)); break;
- case 5: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3), XLG(types, 4)); break;
- case 6: result = gtk_list_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3), XLG(types, 4), XLG(types, 5)); break;
- }
- return(C_TO_XEN_GtkListStore_(result));
- }
+ #define H_gtk_notebook_remove_page "void gtk_notebook_remove_page(GtkNotebook* notebook, gint page_num)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_remove_page", "GtkNotebook*");
+ Xen_check_type(Xen_is_gint(page_num), page_num, 2, "gtk_notebook_remove_page", "gint");
+ gtk_notebook_remove_page(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_gint(page_num));
+ return(Xen_false);
}
-static XEN gxg_gtk_list_store_newv(XEN n_columns, XEN types)
+static Xen gxg_gtk_notebook_get_current_page(Xen notebook)
{
- #define H_gtk_list_store_newv "GtkListStore* gtk_list_store_newv(gint n_columns, GType* types)"
- XEN_ASSERT_TYPE(XEN_gint_P(n_columns), n_columns, 1, "gtk_list_store_newv", "gint");
- XEN_ASSERT_TYPE(XEN_GType__P(types), types, 2, "gtk_list_store_newv", "GType*");
- return(C_TO_XEN_GtkListStore_(gtk_list_store_newv(XEN_TO_C_gint(n_columns), XEN_TO_C_GType_(types))));
+ #define H_gtk_notebook_get_current_page "gint gtk_notebook_get_current_page(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_current_page", "GtkNotebook*");
+ return(C_to_Xen_gint(gtk_notebook_get_current_page(Xen_to_C_GtkNotebook_(notebook))));
}
-static XEN gxg_gtk_list_store_set_column_types(XEN list_store, XEN n_columns, XEN types)
+static Xen gxg_gtk_notebook_get_nth_page(Xen notebook, Xen page_num)
{
- #define H_gtk_list_store_set_column_types "void gtk_list_store_set_column_types(GtkListStore* list_store, \
-gint n_columns, GType* types)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_set_column_types", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_columns), n_columns, 2, "gtk_list_store_set_column_types", "gint");
- XEN_ASSERT_TYPE(XEN_GType__P(types), types, 3, "gtk_list_store_set_column_types", "GType*");
- gtk_list_store_set_column_types(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_gint(n_columns), XEN_TO_C_GType_(types));
- return(XEN_FALSE);
+ #define H_gtk_notebook_get_nth_page "GtkWidget* gtk_notebook_get_nth_page(GtkNotebook* notebook, gint page_num)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_nth_page", "GtkNotebook*");
+ Xen_check_type(Xen_is_gint(page_num), page_num, 2, "gtk_notebook_get_nth_page", "gint");
+ return(C_to_Xen_GtkWidget_(gtk_notebook_get_nth_page(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_gint(page_num))));
}
-static XEN gxg_gtk_list_store_set(XEN list_store, XEN iter, XEN values)
+static Xen gxg_gtk_notebook_page_num(Xen notebook, Xen child)
{
- #define H_gtk_list_store_set "void gtk_list_store_set(GtkListStore* list_store, GtkTreeIter* iter, \
-etc values)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_set", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_set", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_etc_P(values), values, 3, "gtk_list_store_set", "etc");
- {
- int etc_len = 0;
- GtkListStore* p_arg0;
- GtkTreeIter* p_arg1;
- if (XEN_LIST_P(values)) etc_len = XEN_LIST_LENGTH(values);
- if (etc_len < 2) XEN_OUT_OF_RANGE_ERROR("gtk_list_store_set", 2, values, "... list must have at least 2 entries");
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_list_store_set", 2, values, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_list_store_set", 2, values, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_GtkListStore_(list_store);
- p_arg1 = XEN_TO_C_GtkTreeIter_(iter);
- switch (etc_len)
- {
- case 2: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), -1); break;
- case 4: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), -1); break;
- case 6: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), -1); break;
- case 8: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), XLI(values, 6), XLS(values, 7), -1); break;
- case 10: gtk_list_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), XLI(values, 6), XLS(values, 7), XLI(values, 8), XLS(values, 9), -1); break;
- }
- return(XEN_FALSE);
- }
+ #define H_gtk_notebook_page_num "gint gtk_notebook_page_num(GtkNotebook* notebook, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_page_num", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_page_num", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_notebook_page_num(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_gtk_list_store_insert(XEN list_store, XEN iter, XEN position)
+static Xen gxg_gtk_notebook_set_current_page(Xen notebook, Xen page_num)
{
- #define H_gtk_list_store_insert "void gtk_list_store_insert(GtkListStore* list_store, GtkTreeIter* iter, \
-gint position)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_insert", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_insert", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_list_store_insert", "gint");
- gtk_list_store_insert(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_notebook_set_current_page "void gtk_notebook_set_current_page(GtkNotebook* notebook, \
+gint page_num)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_current_page", "GtkNotebook*");
+ Xen_check_type(Xen_is_gint(page_num), page_num, 2, "gtk_notebook_set_current_page", "gint");
+ gtk_notebook_set_current_page(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_gint(page_num));
+ return(Xen_false);
}
-static XEN gxg_gtk_list_store_insert_before(XEN list_store, XEN iter, XEN sibling)
+static Xen gxg_gtk_notebook_next_page(Xen notebook)
{
- #define H_gtk_list_store_insert_before "void gtk_list_store_insert_before(GtkListStore* list_store, \
-GtkTreeIter* iter, GtkTreeIter* sibling)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_insert_before", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_insert_before", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(sibling) || XEN_FALSE_P(sibling), sibling, 3, "gtk_list_store_insert_before", "GtkTreeIter*");
- gtk_list_store_insert_before(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(sibling));
- return(XEN_FALSE);
+ #define H_gtk_notebook_next_page "void gtk_notebook_next_page(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_next_page", "GtkNotebook*");
+ gtk_notebook_next_page(Xen_to_C_GtkNotebook_(notebook));
+ return(Xen_false);
}
-static XEN gxg_gtk_list_store_insert_after(XEN list_store, XEN iter, XEN sibling)
+static Xen gxg_gtk_notebook_prev_page(Xen notebook)
{
- #define H_gtk_list_store_insert_after "void gtk_list_store_insert_after(GtkListStore* list_store, GtkTreeIter* iter, \
-GtkTreeIter* sibling)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_insert_after", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_insert_after", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(sibling) || XEN_FALSE_P(sibling), sibling, 3, "gtk_list_store_insert_after", "GtkTreeIter*");
- gtk_list_store_insert_after(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(sibling));
- return(XEN_FALSE);
+ #define H_gtk_notebook_prev_page "void gtk_notebook_prev_page(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_prev_page", "GtkNotebook*");
+ gtk_notebook_prev_page(Xen_to_C_GtkNotebook_(notebook));
+ return(Xen_false);
}
-static XEN gxg_gtk_list_store_prepend(XEN list_store, XEN iter)
+static Xen gxg_gtk_notebook_set_show_border(Xen notebook, Xen show_border)
{
- #define H_gtk_list_store_prepend "void gtk_list_store_prepend(GtkListStore* list_store, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_prepend", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_prepend", "GtkTreeIter*");
- gtk_list_store_prepend(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_notebook_set_show_border "void gtk_notebook_set_show_border(GtkNotebook* notebook, gboolean show_border)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_show_border", "GtkNotebook*");
+ Xen_check_type(Xen_is_gboolean(show_border), show_border, 2, "gtk_notebook_set_show_border", "gboolean");
+ gtk_notebook_set_show_border(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_gboolean(show_border));
+ return(Xen_false);
}
-static XEN gxg_gtk_list_store_append(XEN list_store, XEN iter)
+static Xen gxg_gtk_notebook_get_show_border(Xen notebook)
{
- #define H_gtk_list_store_append "void gtk_list_store_append(GtkListStore* list_store, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_append", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_append", "GtkTreeIter*");
- gtk_list_store_append(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_notebook_get_show_border "gboolean gtk_notebook_get_show_border(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_show_border", "GtkNotebook*");
+ return(C_to_Xen_gboolean(gtk_notebook_get_show_border(Xen_to_C_GtkNotebook_(notebook))));
}
-static XEN gxg_gtk_list_store_clear(XEN list_store)
+static Xen gxg_gtk_notebook_set_show_tabs(Xen notebook, Xen show_tabs)
{
- #define H_gtk_list_store_clear "void gtk_list_store_clear(GtkListStore* list_store)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_clear", "GtkListStore*");
- gtk_list_store_clear(XEN_TO_C_GtkListStore_(list_store));
- return(XEN_FALSE);
+ #define H_gtk_notebook_set_show_tabs "void gtk_notebook_set_show_tabs(GtkNotebook* notebook, gboolean show_tabs)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_show_tabs", "GtkNotebook*");
+ Xen_check_type(Xen_is_gboolean(show_tabs), show_tabs, 2, "gtk_notebook_set_show_tabs", "gboolean");
+ gtk_notebook_set_show_tabs(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_gboolean(show_tabs));
+ return(Xen_false);
}
-static XEN gxg_gtk_check_version(XEN required_major, XEN required_minor, XEN required_micro)
+static Xen gxg_gtk_notebook_get_show_tabs(Xen notebook)
{
- #define H_gtk_check_version "gchar* gtk_check_version(guint required_major, guint required_minor, guint required_micro)"
- XEN_ASSERT_TYPE(XEN_guint_P(required_major), required_major, 1, "gtk_check_version", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(required_minor), required_minor, 2, "gtk_check_version", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(required_micro), required_micro, 3, "gtk_check_version", "guint");
- return(C_TO_XEN_gchar_((gchar*)gtk_check_version(XEN_TO_C_guint(required_major), XEN_TO_C_guint(required_minor), XEN_TO_C_guint(required_micro))));
+ #define H_gtk_notebook_get_show_tabs "gboolean gtk_notebook_get_show_tabs(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_show_tabs", "GtkNotebook*");
+ return(C_to_Xen_gboolean(gtk_notebook_get_show_tabs(Xen_to_C_GtkNotebook_(notebook))));
}
-static XEN gxg_gtk_disable_setlocale(void)
+static Xen gxg_gtk_notebook_set_tab_pos(Xen notebook, Xen pos)
{
- #define H_gtk_disable_setlocale "void gtk_disable_setlocale( void)"
- gtk_disable_setlocale();
- return(XEN_FALSE);
+ #define H_gtk_notebook_set_tab_pos "void gtk_notebook_set_tab_pos(GtkNotebook* notebook, GtkPositionType pos)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_tab_pos", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkPositionType(pos), pos, 2, "gtk_notebook_set_tab_pos", "GtkPositionType");
+ gtk_notebook_set_tab_pos(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkPositionType(pos));
+ return(Xen_false);
}
-static XEN gxg_gtk_get_default_language(void)
+static Xen gxg_gtk_notebook_get_tab_pos(Xen notebook)
{
- #define H_gtk_get_default_language "PangoLanguage* gtk_get_default_language( void)"
- return(C_TO_XEN_PangoLanguage_(gtk_get_default_language()));
+ #define H_gtk_notebook_get_tab_pos "GtkPositionType gtk_notebook_get_tab_pos(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_tab_pos", "GtkNotebook*");
+ return(C_to_Xen_GtkPositionType(gtk_notebook_get_tab_pos(Xen_to_C_GtkNotebook_(notebook))));
}
-static XEN gxg_gtk_events_pending(void)
+static Xen gxg_gtk_notebook_set_scrollable(Xen notebook, Xen scrollable)
{
- #define H_gtk_events_pending "gint gtk_events_pending( void)"
- return(C_TO_XEN_gint(gtk_events_pending()));
+ #define H_gtk_notebook_set_scrollable "void gtk_notebook_set_scrollable(GtkNotebook* notebook, gboolean scrollable)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_scrollable", "GtkNotebook*");
+ Xen_check_type(Xen_is_gboolean(scrollable), scrollable, 2, "gtk_notebook_set_scrollable", "gboolean");
+ gtk_notebook_set_scrollable(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_gboolean(scrollable));
+ return(Xen_false);
}
-static XEN gxg_gtk_main_do_event(XEN event)
+static Xen gxg_gtk_notebook_get_scrollable(Xen notebook)
{
- #define H_gtk_main_do_event "void gtk_main_do_event(GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gtk_main_do_event", "GdkEvent*");
- gtk_main_do_event(XEN_TO_C_GdkEvent_(event));
- return(XEN_FALSE);
+ #define H_gtk_notebook_get_scrollable "gboolean gtk_notebook_get_scrollable(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_scrollable", "GtkNotebook*");
+ return(C_to_Xen_gboolean(gtk_notebook_get_scrollable(Xen_to_C_GtkNotebook_(notebook))));
}
-static XEN gxg_gtk_main(void)
+static Xen gxg_gtk_notebook_popup_enable(Xen notebook)
{
- #define H_gtk_main "void gtk_main( void)"
- gtk_main();
- return(XEN_FALSE);
+ #define H_gtk_notebook_popup_enable "void gtk_notebook_popup_enable(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_popup_enable", "GtkNotebook*");
+ gtk_notebook_popup_enable(Xen_to_C_GtkNotebook_(notebook));
+ return(Xen_false);
}
-static XEN gxg_gtk_main_level(void)
+static Xen gxg_gtk_notebook_popup_disable(Xen notebook)
{
- #define H_gtk_main_level "guint gtk_main_level( void)"
- return(C_TO_XEN_guint(gtk_main_level()));
+ #define H_gtk_notebook_popup_disable "void gtk_notebook_popup_disable(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_popup_disable", "GtkNotebook*");
+ gtk_notebook_popup_disable(Xen_to_C_GtkNotebook_(notebook));
+ return(Xen_false);
}
-static XEN gxg_gtk_main_quit(void)
+static Xen gxg_gtk_notebook_get_tab_label(Xen notebook, Xen child)
{
- #define H_gtk_main_quit "void gtk_main_quit( void)"
- gtk_main_quit();
- return(XEN_FALSE);
+ #define H_gtk_notebook_get_tab_label "GtkWidget* gtk_notebook_get_tab_label(GtkNotebook* notebook, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_tab_label", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_get_tab_label", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_notebook_get_tab_label(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_gtk_main_iteration(void)
+static Xen gxg_gtk_notebook_set_tab_label(Xen notebook, Xen child, Xen tab_label)
{
- #define H_gtk_main_iteration "gboolean gtk_main_iteration( void)"
- return(C_TO_XEN_gboolean(gtk_main_iteration()));
+ #define H_gtk_notebook_set_tab_label "void gtk_notebook_set_tab_label(GtkNotebook* notebook, GtkWidget* child, \
+GtkWidget* tab_label)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_tab_label", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_set_tab_label", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(tab_label) || Xen_is_false(tab_label), tab_label, 3, "gtk_notebook_set_tab_label", "GtkWidget*");
+ gtk_notebook_set_tab_label(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(tab_label));
+ return(Xen_false);
}
-static XEN gxg_gtk_main_iteration_do(XEN blocking)
+static Xen gxg_gtk_notebook_set_tab_label_text(Xen notebook, Xen child, Xen tab_text)
{
- #define H_gtk_main_iteration_do "gboolean gtk_main_iteration_do(gboolean blocking)"
- XEN_ASSERT_TYPE(XEN_gboolean_P(blocking), blocking, 1, "gtk_main_iteration_do", "gboolean");
- return(C_TO_XEN_gboolean(gtk_main_iteration_do(XEN_TO_C_gboolean(blocking))));
+ #define H_gtk_notebook_set_tab_label_text "void gtk_notebook_set_tab_label_text(GtkNotebook* notebook, \
+GtkWidget* child, gchar* tab_text)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_tab_label_text", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_set_tab_label_text", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(tab_text), tab_text, 3, "gtk_notebook_set_tab_label_text", "gchar*");
+ gtk_notebook_set_tab_label_text(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_gchar_(tab_text));
+ return(Xen_false);
}
-static XEN gxg_gtk_true(void)
+static Xen gxg_gtk_notebook_get_tab_label_text(Xen notebook, Xen child)
{
- #define H_gtk_true "gboolean gtk_true( void)"
- return(C_TO_XEN_gboolean(gtk_true()));
+ #define H_gtk_notebook_get_tab_label_text "gchar* gtk_notebook_get_tab_label_text(GtkNotebook* notebook, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_tab_label_text", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_get_tab_label_text", "GtkWidget*");
+ return(C_to_Xen_gchar_(gtk_notebook_get_tab_label_text(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_gtk_false(void)
+static Xen gxg_gtk_notebook_get_menu_label(Xen notebook, Xen child)
{
- #define H_gtk_false "gboolean gtk_false( void)"
- return(C_TO_XEN_gboolean(gtk_false()));
+ #define H_gtk_notebook_get_menu_label "GtkWidget* gtk_notebook_get_menu_label(GtkNotebook* notebook, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_menu_label", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_get_menu_label", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_notebook_get_menu_label(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_gtk_grab_add(XEN widget)
+static Xen gxg_gtk_notebook_set_menu_label(Xen notebook, Xen child, Xen menu_label)
{
- #define H_gtk_grab_add "void gtk_grab_add(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_grab_add", "GtkWidget*");
- gtk_grab_add(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_notebook_set_menu_label "void gtk_notebook_set_menu_label(GtkNotebook* notebook, GtkWidget* child, \
+GtkWidget* menu_label)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_menu_label", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_set_menu_label", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(menu_label), menu_label, 3, "gtk_notebook_set_menu_label", "GtkWidget*");
+ gtk_notebook_set_menu_label(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(menu_label));
+ return(Xen_false);
}
-static XEN gxg_gtk_grab_get_current(void)
+static Xen gxg_gtk_notebook_set_menu_label_text(Xen notebook, Xen child, Xen menu_text)
{
- #define H_gtk_grab_get_current "GtkWidget* gtk_grab_get_current( void)"
- return(C_TO_XEN_GtkWidget_(gtk_grab_get_current()));
+ #define H_gtk_notebook_set_menu_label_text "void gtk_notebook_set_menu_label_text(GtkNotebook* notebook, \
+GtkWidget* child, gchar* menu_text)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_menu_label_text", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_set_menu_label_text", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(menu_text), menu_text, 3, "gtk_notebook_set_menu_label_text", "gchar*");
+ gtk_notebook_set_menu_label_text(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_gchar_(menu_text));
+ return(Xen_false);
}
-static XEN gxg_gtk_grab_remove(XEN widget)
+static Xen gxg_gtk_notebook_get_menu_label_text(Xen notebook, Xen child)
{
- #define H_gtk_grab_remove "void gtk_grab_remove(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_grab_remove", "GtkWidget*");
- gtk_grab_remove(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_notebook_get_menu_label_text "gchar* gtk_notebook_get_menu_label_text(GtkNotebook* notebook, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_menu_label_text", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_get_menu_label_text", "GtkWidget*");
+ return(C_to_Xen_gchar_(gtk_notebook_get_menu_label_text(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_gtk_key_snooper_install(XEN func, XEN func_info)
+static Xen gxg_gtk_notebook_reorder_child(Xen notebook, Xen child, Xen position)
{
- #define H_gtk_key_snooper_install "guint gtk_key_snooper_install(GtkKeySnoopFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkKeySnoopFunc_P(func), func, 1, "gtk_key_snooper_install", "GtkKeySnoopFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 2, "gtk_key_snooper_install", "lambda_data");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(gtk_key_snooper_install(XEN_TO_C_GtkKeySnoopFunc(func), XEN_TO_C_lambda_data(func_info)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gtk_notebook_reorder_child "void gtk_notebook_reorder_child(GtkNotebook* notebook, GtkWidget* child, \
+gint position)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_reorder_child", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_reorder_child", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_notebook_reorder_child", "gint");
+ gtk_notebook_reorder_child(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_key_snooper_remove(XEN snooper_handler_id)
+static Xen gxg_gtk_notebook_append_page(Xen notebook, Xen child, Xen tab_label)
{
- #define H_gtk_key_snooper_remove "void gtk_key_snooper_remove(guint snooper_handler_id)"
- XEN_ASSERT_TYPE(XEN_guint_P(snooper_handler_id), snooper_handler_id, 1, "gtk_key_snooper_remove", "guint");
- gtk_key_snooper_remove(XEN_TO_C_guint(snooper_handler_id));
- xm_unprotect_at(XEN_TO_C_INT(XEN_CADDR(snooper_handler_id)));
- return(XEN_FALSE);
+ #define H_gtk_notebook_append_page "gint gtk_notebook_append_page(GtkNotebook* notebook, GtkWidget* child, \
+GtkWidget* tab_label)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_append_page", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_append_page", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(tab_label) || Xen_is_false(tab_label), tab_label, 3, "gtk_notebook_append_page", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_notebook_append_page(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(tab_label))));
}
-static XEN gxg_gtk_get_current_event(void)
+static Xen gxg_gtk_notebook_append_page_menu(Xen notebook, Xen child, Xen tab_label, Xen menu_label)
{
- #define H_gtk_get_current_event "GdkEvent* gtk_get_current_event( void)"
- return(C_TO_XEN_GdkEvent_(gtk_get_current_event()));
+ #define H_gtk_notebook_append_page_menu "gint gtk_notebook_append_page_menu(GtkNotebook* notebook, \
+GtkWidget* child, GtkWidget* tab_label, GtkWidget* menu_label)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_append_page_menu", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_append_page_menu", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(tab_label) || Xen_is_false(tab_label), tab_label, 3, "gtk_notebook_append_page_menu", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(menu_label) || Xen_is_false(menu_label), menu_label, 4, "gtk_notebook_append_page_menu", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_notebook_append_page_menu(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(tab_label),
+ Xen_to_C_GtkWidget_(menu_label))));
}
-static XEN gxg_gtk_get_current_event_time(void)
+static Xen gxg_gtk_notebook_prepend_page(Xen notebook, Xen child, Xen tab_label)
{
- #define H_gtk_get_current_event_time "guint32 gtk_get_current_event_time( void)"
- return(C_TO_XEN_guint32(gtk_get_current_event_time()));
+ #define H_gtk_notebook_prepend_page "gint gtk_notebook_prepend_page(GtkNotebook* notebook, GtkWidget* child, \
+GtkWidget* tab_label)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_prepend_page", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_prepend_page", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(tab_label) || Xen_is_false(tab_label), tab_label, 3, "gtk_notebook_prepend_page", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_notebook_prepend_page(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(tab_label))));
}
-static XEN gxg_gtk_get_current_event_state(XEN ignore_state)
+static Xen gxg_gtk_notebook_prepend_page_menu(Xen notebook, Xen child, Xen tab_label, Xen menu_label)
{
- #define H_gtk_get_current_event_state "gboolean gtk_get_current_event_state(GdkModifierType* [state])"
- GdkModifierType ref_state;
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_get_current_event_state(&ref_state));
- return(XEN_LIST_2(result, C_TO_XEN_GdkModifierType(ref_state)));
- }
+ #define H_gtk_notebook_prepend_page_menu "gint gtk_notebook_prepend_page_menu(GtkNotebook* notebook, \
+GtkWidget* child, GtkWidget* tab_label, GtkWidget* menu_label)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_prepend_page_menu", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_prepend_page_menu", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(tab_label) || Xen_is_false(tab_label), tab_label, 3, "gtk_notebook_prepend_page_menu", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(menu_label) || Xen_is_false(menu_label), menu_label, 4, "gtk_notebook_prepend_page_menu", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_notebook_prepend_page_menu(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(tab_label),
+ Xen_to_C_GtkWidget_(menu_label))));
}
-static XEN gxg_gtk_get_event_widget(XEN event)
+static Xen gxg_gtk_notebook_insert_page(Xen notebook, Xen child, Xen tab_label, Xen position)
{
- #define H_gtk_get_event_widget "GtkWidget* gtk_get_event_widget(GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event) || XEN_FALSE_P(event), event, 1, "gtk_get_event_widget", "GdkEvent*");
- return(C_TO_XEN_GtkWidget_(gtk_get_event_widget(XEN_TO_C_GdkEvent_(event))));
+ #define H_gtk_notebook_insert_page "gint gtk_notebook_insert_page(GtkNotebook* notebook, GtkWidget* child, \
+GtkWidget* tab_label, gint position)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_insert_page", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_insert_page", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(tab_label) || Xen_is_false(tab_label), tab_label, 3, "gtk_notebook_insert_page", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 4, "gtk_notebook_insert_page", "gint");
+ return(C_to_Xen_gint(gtk_notebook_insert_page(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(tab_label),
+ Xen_to_C_gint(position))));
}
-static XEN gxg_gtk_propagate_event(XEN widget, XEN event)
+static Xen gxg_gtk_notebook_insert_page_menu(Xen notebook, Xen child, Xen tab_label, Xen menu_label, Xen position)
{
- #define H_gtk_propagate_event "void gtk_propagate_event(GtkWidget* widget, GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_propagate_event", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 2, "gtk_propagate_event", "GdkEvent*");
- gtk_propagate_event(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkEvent_(event));
- return(XEN_FALSE);
+ #define H_gtk_notebook_insert_page_menu "gint gtk_notebook_insert_page_menu(GtkNotebook* notebook, \
+GtkWidget* child, GtkWidget* tab_label, GtkWidget* menu_label, gint position)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_insert_page_menu", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_insert_page_menu", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(tab_label) || Xen_is_false(tab_label), tab_label, 3, "gtk_notebook_insert_page_menu", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(menu_label) || Xen_is_false(menu_label), menu_label, 4, "gtk_notebook_insert_page_menu", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 5, "gtk_notebook_insert_page_menu", "gint");
+ return(C_to_Xen_gint(gtk_notebook_insert_page_menu(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(tab_label),
+ Xen_to_C_GtkWidget_(menu_label), Xen_to_C_gint(position))));
}
-static XEN gxg_gtk_menu_bar_new(void)
+static Xen gxg_gtk_paned_add1(Xen paned, Xen child)
{
- #define H_gtk_menu_bar_new "GtkWidget* gtk_menu_bar_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_menu_bar_new()));
+ #define H_gtk_paned_add1 "void gtk_paned_add1(GtkPaned* paned, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_add1", "GtkPaned*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_paned_add1", "GtkWidget*");
+ gtk_paned_add1(Xen_to_C_GtkPaned_(paned), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_new(void)
+static Xen gxg_gtk_paned_add2(Xen paned, Xen child)
{
- #define H_gtk_menu_new "GtkWidget* gtk_menu_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_menu_new()));
+ #define H_gtk_paned_add2 "void gtk_paned_add2(GtkPaned* paned, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_add2", "GtkPaned*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_paned_add2", "GtkWidget*");
+ gtk_paned_add2(Xen_to_C_GtkPaned_(paned), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_popup(XEN menu, XEN parent_menu_shell, XEN parent_menu_item, XEN func, XEN func_info, XEN button, XEN activate_time)
+static Xen gxg_gtk_paned_pack1(Xen paned, Xen child, Xen resize, Xen shrink)
{
- #define H_gtk_menu_popup "void gtk_menu_popup(GtkMenu* menu, GtkWidget* parent_menu_shell, GtkWidget* parent_menu_item, \
-GtkMenuPositionFunc func, lambda_data func_info, guint button, guint32 activate_time)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_popup", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(parent_menu_shell) || XEN_FALSE_P(parent_menu_shell), parent_menu_shell, 2, "gtk_menu_popup", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(parent_menu_item) || XEN_FALSE_P(parent_menu_item), parent_menu_item, 3, "gtk_menu_popup", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkMenuPositionFunc_P(func), func, 4, "gtk_menu_popup", "GtkMenuPositionFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 5, "gtk_menu_popup", "lambda_data");
- XEN_ASSERT_TYPE(XEN_guint_P(button), button, 6, "gtk_menu_popup", "guint");
- XEN_ASSERT_TYPE(XEN_guint32_P(activate_time), activate_time, 7, "gtk_menu_popup", "guint32");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- gtk_menu_popup(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_GtkWidget_(parent_menu_shell), XEN_TO_C_GtkWidget_(parent_menu_item), XEN_TO_C_GtkMenuPositionFunc(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_guint(button), XEN_TO_C_guint32(activate_time));
- return(XEN_FALSE);
- }
+ #define H_gtk_paned_pack1 "void gtk_paned_pack1(GtkPaned* paned, GtkWidget* child, gboolean resize, \
+gboolean shrink)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_pack1", "GtkPaned*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_paned_pack1", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(resize), resize, 3, "gtk_paned_pack1", "gboolean");
+ Xen_check_type(Xen_is_gboolean(shrink), shrink, 4, "gtk_paned_pack1", "gboolean");
+ gtk_paned_pack1(Xen_to_C_GtkPaned_(paned), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(resize), Xen_to_C_gboolean(shrink));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_reposition(XEN menu)
+static Xen gxg_gtk_paned_pack2(Xen paned, Xen child, Xen resize, Xen shrink)
{
- #define H_gtk_menu_reposition "void gtk_menu_reposition(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_reposition", "GtkMenu*");
- gtk_menu_reposition(XEN_TO_C_GtkMenu_(menu));
- return(XEN_FALSE);
+ #define H_gtk_paned_pack2 "void gtk_paned_pack2(GtkPaned* paned, GtkWidget* child, gboolean resize, \
+gboolean shrink)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_pack2", "GtkPaned*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_paned_pack2", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(resize), resize, 3, "gtk_paned_pack2", "gboolean");
+ Xen_check_type(Xen_is_gboolean(shrink), shrink, 4, "gtk_paned_pack2", "gboolean");
+ gtk_paned_pack2(Xen_to_C_GtkPaned_(paned), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(resize), Xen_to_C_gboolean(shrink));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_popdown(XEN menu)
+static Xen gxg_gtk_paned_get_position(Xen paned)
{
- #define H_gtk_menu_popdown "void gtk_menu_popdown(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_popdown", "GtkMenu*");
- gtk_menu_popdown(XEN_TO_C_GtkMenu_(menu));
- return(XEN_FALSE);
+ #define H_gtk_paned_get_position "gint gtk_paned_get_position(GtkPaned* paned)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_get_position", "GtkPaned*");
+ return(C_to_Xen_gint(gtk_paned_get_position(Xen_to_C_GtkPaned_(paned))));
}
-static XEN gxg_gtk_menu_get_active(XEN menu)
+static Xen gxg_gtk_paned_set_position(Xen paned, Xen position)
{
- #define H_gtk_menu_get_active "GtkWidget* gtk_menu_get_active(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_get_active", "GtkMenu*");
- return(C_TO_XEN_GtkWidget_(gtk_menu_get_active(XEN_TO_C_GtkMenu_(menu))));
+ #define H_gtk_paned_set_position "void gtk_paned_set_position(GtkPaned* paned, gint position)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_set_position", "GtkPaned*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_paned_set_position", "gint");
+ gtk_paned_set_position(Xen_to_C_GtkPaned_(paned), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_set_active(XEN menu, XEN index)
+static Xen gxg_gtk_progress_bar_new(void)
{
- #define H_gtk_menu_set_active "void gtk_menu_set_active(GtkMenu* menu, guint index)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_set_active", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_guint_P(index), index, 2, "gtk_menu_set_active", "guint");
- gtk_menu_set_active(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_guint(index));
- return(XEN_FALSE);
+ #define H_gtk_progress_bar_new "GtkWidget* gtk_progress_bar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_progress_bar_new()));
}
-static XEN gxg_gtk_menu_set_accel_group(XEN menu, XEN accel_group)
+static Xen gxg_gtk_progress_bar_pulse(Xen pbar)
{
- #define H_gtk_menu_set_accel_group "void gtk_menu_set_accel_group(GtkMenu* menu, GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_set_accel_group", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group) || XEN_FALSE_P(accel_group), accel_group, 2, "gtk_menu_set_accel_group", "GtkAccelGroup*");
- gtk_menu_set_accel_group(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_GtkAccelGroup_(accel_group));
- return(XEN_FALSE);
+ #define H_gtk_progress_bar_pulse "void gtk_progress_bar_pulse(GtkProgressBar* pbar)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_pulse", "GtkProgressBar*");
+ gtk_progress_bar_pulse(Xen_to_C_GtkProgressBar_(pbar));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_get_accel_group(XEN menu)
+static Xen gxg_gtk_progress_bar_set_text(Xen pbar, Xen text)
{
- #define H_gtk_menu_get_accel_group "GtkAccelGroup* gtk_menu_get_accel_group(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_get_accel_group", "GtkMenu*");
- return(C_TO_XEN_GtkAccelGroup_(gtk_menu_get_accel_group(XEN_TO_C_GtkMenu_(menu))));
+ #define H_gtk_progress_bar_set_text "void gtk_progress_bar_set_text(GtkProgressBar* pbar, gchar* text)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_set_text", "GtkProgressBar*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_progress_bar_set_text", "gchar*");
+ gtk_progress_bar_set_text(Xen_to_C_GtkProgressBar_(pbar), Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_set_accel_path(XEN menu, XEN accel_path)
+static Xen gxg_gtk_progress_bar_set_fraction(Xen pbar, Xen fraction)
{
- #define H_gtk_menu_set_accel_path "void gtk_menu_set_accel_path(GtkMenu* menu, gchar* accel_path)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_set_accel_path", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 2, "gtk_menu_set_accel_path", "gchar*");
- gtk_menu_set_accel_path(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_gchar_(accel_path));
- return(XEN_FALSE);
+ #define H_gtk_progress_bar_set_fraction "void gtk_progress_bar_set_fraction(GtkProgressBar* pbar, gdouble fraction)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_set_fraction", "GtkProgressBar*");
+ Xen_check_type(Xen_is_gdouble(fraction), fraction, 2, "gtk_progress_bar_set_fraction", "gdouble");
+ gtk_progress_bar_set_fraction(Xen_to_C_GtkProgressBar_(pbar), Xen_to_C_gdouble(fraction));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_detach(XEN menu)
+static Xen gxg_gtk_progress_bar_set_pulse_step(Xen pbar, Xen fraction)
{
- #define H_gtk_menu_detach "void gtk_menu_detach(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_detach", "GtkMenu*");
- gtk_menu_detach(XEN_TO_C_GtkMenu_(menu));
- return(XEN_FALSE);
+ #define H_gtk_progress_bar_set_pulse_step "void gtk_progress_bar_set_pulse_step(GtkProgressBar* pbar, \
+gdouble fraction)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_set_pulse_step", "GtkProgressBar*");
+ Xen_check_type(Xen_is_gdouble(fraction), fraction, 2, "gtk_progress_bar_set_pulse_step", "gdouble");
+ gtk_progress_bar_set_pulse_step(Xen_to_C_GtkProgressBar_(pbar), Xen_to_C_gdouble(fraction));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_get_attach_widget(XEN menu)
+static Xen gxg_gtk_progress_bar_get_text(Xen pbar)
{
- #define H_gtk_menu_get_attach_widget "GtkWidget* gtk_menu_get_attach_widget(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_get_attach_widget", "GtkMenu*");
- return(C_TO_XEN_GtkWidget_(gtk_menu_get_attach_widget(XEN_TO_C_GtkMenu_(menu))));
+ #define H_gtk_progress_bar_get_text "gchar* gtk_progress_bar_get_text(GtkProgressBar* pbar)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_get_text", "GtkProgressBar*");
+ return(C_to_Xen_gchar_(gtk_progress_bar_get_text(Xen_to_C_GtkProgressBar_(pbar))));
}
-static XEN gxg_gtk_menu_set_tearoff_state(XEN menu, XEN torn_off)
+static Xen gxg_gtk_progress_bar_get_fraction(Xen pbar)
{
- #define H_gtk_menu_set_tearoff_state "void gtk_menu_set_tearoff_state(GtkMenu* menu, gboolean torn_off)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_set_tearoff_state", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(torn_off), torn_off, 2, "gtk_menu_set_tearoff_state", "gboolean");
- gtk_menu_set_tearoff_state(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_gboolean(torn_off));
- return(XEN_FALSE);
+ #define H_gtk_progress_bar_get_fraction "gdouble gtk_progress_bar_get_fraction(GtkProgressBar* pbar)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_get_fraction", "GtkProgressBar*");
+ return(C_to_Xen_gdouble(gtk_progress_bar_get_fraction(Xen_to_C_GtkProgressBar_(pbar))));
}
-static XEN gxg_gtk_menu_get_tearoff_state(XEN menu)
+static Xen gxg_gtk_progress_bar_get_pulse_step(Xen pbar)
{
- #define H_gtk_menu_get_tearoff_state "gboolean gtk_menu_get_tearoff_state(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_get_tearoff_state", "GtkMenu*");
- return(C_TO_XEN_gboolean(gtk_menu_get_tearoff_state(XEN_TO_C_GtkMenu_(menu))));
+ #define H_gtk_progress_bar_get_pulse_step "gdouble gtk_progress_bar_get_pulse_step(GtkProgressBar* pbar)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_get_pulse_step", "GtkProgressBar*");
+ return(C_to_Xen_gdouble(gtk_progress_bar_get_pulse_step(Xen_to_C_GtkProgressBar_(pbar))));
}
-static XEN gxg_gtk_menu_set_title(XEN menu, XEN title)
+static Xen gxg_gtk_radio_button_new(Xen group)
{
- #define H_gtk_menu_set_title "void gtk_menu_set_title(GtkMenu* menu, gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_set_title", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gtk_menu_set_title", "gchar*");
- gtk_menu_set_title(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_gtk_radio_button_new "GtkWidget* gtk_radio_button_new(GSList* group)"
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 1, "gtk_radio_button_new", "GSList*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_button_new(Xen_to_C_GSList_(group))));
}
-static XEN gxg_gtk_menu_get_title(XEN menu)
+static Xen gxg_gtk_radio_button_new_from_widget(Xen group)
{
- #define H_gtk_menu_get_title "gchar* gtk_menu_get_title(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_get_title", "GtkMenu*");
- return(C_TO_XEN_gchar_(gtk_menu_get_title(XEN_TO_C_GtkMenu_(menu))));
+ #define H_gtk_radio_button_new_from_widget "GtkWidget* gtk_radio_button_new_from_widget(GtkRadioButton* group)"
+ Xen_check_type(Xen_is_GtkRadioButton_(group), group, 1, "gtk_radio_button_new_from_widget", "GtkRadioButton*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_button_new_from_widget(Xen_to_C_GtkRadioButton_(group))));
}
-static XEN gxg_gtk_menu_reorder_child(XEN menu, XEN child, XEN position)
+static Xen gxg_gtk_radio_button_new_with_label(Xen group, Xen label)
{
- #define H_gtk_menu_reorder_child "void gtk_menu_reorder_child(GtkMenu* menu, GtkWidget* child, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_reorder_child", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_menu_reorder_child", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_menu_reorder_child", "gint");
- gtk_menu_reorder_child(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_radio_button_new_with_label "GtkWidget* gtk_radio_button_new_with_label(GSList* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 1, "gtk_radio_button_new_with_label", "GSList*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_radio_button_new_with_label", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_button_new_with_label(Xen_to_C_GSList_(group), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_menu_set_monitor(XEN menu, XEN monitor_num)
+static Xen gxg_gtk_radio_button_new_with_label_from_widget(Xen group, Xen label)
{
- #define H_gtk_menu_set_monitor "void gtk_menu_set_monitor(GtkMenu* menu, gint monitor_num)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_set_monitor", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_gint_P(monitor_num), monitor_num, 2, "gtk_menu_set_monitor", "gint");
- gtk_menu_set_monitor(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_gint(monitor_num));
- return(XEN_FALSE);
+ #define H_gtk_radio_button_new_with_label_from_widget "GtkWidget* gtk_radio_button_new_with_label_from_widget(GtkRadioButton* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GtkRadioButton_(group), group, 1, "gtk_radio_button_new_with_label_from_widget", "GtkRadioButton*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_radio_button_new_with_label_from_widget", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_button_new_with_label_from_widget(Xen_to_C_GtkRadioButton_(group), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_menu_item_new(void)
+static Xen gxg_gtk_radio_button_new_with_mnemonic(Xen group, Xen label)
{
- #define H_gtk_menu_item_new "GtkWidget* gtk_menu_item_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_menu_item_new()));
+ #define H_gtk_radio_button_new_with_mnemonic "GtkWidget* gtk_radio_button_new_with_mnemonic(GSList* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 1, "gtk_radio_button_new_with_mnemonic", "GSList*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_radio_button_new_with_mnemonic", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_button_new_with_mnemonic(Xen_to_C_GSList_(group), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_menu_item_new_with_label(XEN label)
+static Xen gxg_gtk_radio_button_new_with_mnemonic_from_widget(Xen group, Xen label)
{
- #define H_gtk_menu_item_new_with_label "GtkWidget* gtk_menu_item_new_with_label(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_menu_item_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_menu_item_new_with_label(XEN_TO_C_gchar_(label))));
+ #define H_gtk_radio_button_new_with_mnemonic_from_widget "GtkWidget* gtk_radio_button_new_with_mnemonic_from_widget(GtkRadioButton* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GtkRadioButton_(group), group, 1, "gtk_radio_button_new_with_mnemonic_from_widget", "GtkRadioButton*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_radio_button_new_with_mnemonic_from_widget", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_button_new_with_mnemonic_from_widget(Xen_to_C_GtkRadioButton_(group), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_menu_item_new_with_mnemonic(XEN label)
+static Xen gxg_gtk_radio_button_get_group(Xen radio_button)
{
- #define H_gtk_menu_item_new_with_mnemonic "GtkWidget* gtk_menu_item_new_with_mnemonic(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_menu_item_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_menu_item_new_with_mnemonic(XEN_TO_C_gchar_(label))));
+ #define H_gtk_radio_button_get_group "GSList* gtk_radio_button_get_group(GtkRadioButton* radio_button)"
+ Xen_check_type(Xen_is_GtkRadioButton_(radio_button), radio_button, 1, "gtk_radio_button_get_group", "GtkRadioButton*");
+ return(C_to_Xen_GSList_(gtk_radio_button_get_group(Xen_to_C_GtkRadioButton_(radio_button))));
}
-static XEN gxg_gtk_menu_item_set_submenu(XEN menu_item, XEN submenu)
+static Xen gxg_gtk_radio_button_set_group(Xen radio_button, Xen group)
{
- #define H_gtk_menu_item_set_submenu "void gtk_menu_item_set_submenu(GtkMenuItem* menu_item, GtkWidget* submenu)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_set_submenu", "GtkMenuItem*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(submenu), submenu, 2, "gtk_menu_item_set_submenu", "GtkWidget*");
- gtk_menu_item_set_submenu(XEN_TO_C_GtkMenuItem_(menu_item), XEN_TO_C_GtkWidget_(submenu));
- return(XEN_FALSE);
+ #define H_gtk_radio_button_set_group "void gtk_radio_button_set_group(GtkRadioButton* radio_button, \
+GSList* group)"
+ Xen_check_type(Xen_is_GtkRadioButton_(radio_button), radio_button, 1, "gtk_radio_button_set_group", "GtkRadioButton*");
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 2, "gtk_radio_button_set_group", "GSList*");
+ gtk_radio_button_set_group(Xen_to_C_GtkRadioButton_(radio_button), Xen_to_C_GSList_(group));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_item_get_submenu(XEN menu_item)
+static Xen gxg_gtk_radio_menu_item_new(Xen group)
{
- #define H_gtk_menu_item_get_submenu "GtkWidget* gtk_menu_item_get_submenu(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_get_submenu", "GtkMenuItem*");
- return(C_TO_XEN_GtkWidget_(gtk_menu_item_get_submenu(XEN_TO_C_GtkMenuItem_(menu_item))));
+ #define H_gtk_radio_menu_item_new "GtkWidget* gtk_radio_menu_item_new(GSList* group)"
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 1, "gtk_radio_menu_item_new", "GSList*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_menu_item_new(Xen_to_C_GSList_(group))));
}
-static XEN gxg_gtk_menu_item_select(XEN menu_item)
+static Xen gxg_gtk_radio_menu_item_new_with_label(Xen group, Xen label)
{
- #define H_gtk_menu_item_select "void gtk_menu_item_select(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_select", "GtkMenuItem*");
- gtk_menu_item_select(XEN_TO_C_GtkMenuItem_(menu_item));
- return(XEN_FALSE);
+ #define H_gtk_radio_menu_item_new_with_label "GtkWidget* gtk_radio_menu_item_new_with_label(GSList* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 1, "gtk_radio_menu_item_new_with_label", "GSList*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_radio_menu_item_new_with_label", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_menu_item_new_with_label(Xen_to_C_GSList_(group), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_menu_item_deselect(XEN menu_item)
+static Xen gxg_gtk_radio_menu_item_new_with_mnemonic(Xen group, Xen label)
{
- #define H_gtk_menu_item_deselect "void gtk_menu_item_deselect(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_deselect", "GtkMenuItem*");
- gtk_menu_item_deselect(XEN_TO_C_GtkMenuItem_(menu_item));
- return(XEN_FALSE);
+ #define H_gtk_radio_menu_item_new_with_mnemonic "GtkWidget* gtk_radio_menu_item_new_with_mnemonic(GSList* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 1, "gtk_radio_menu_item_new_with_mnemonic", "GSList*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_radio_menu_item_new_with_mnemonic", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_menu_item_new_with_mnemonic(Xen_to_C_GSList_(group), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_menu_item_activate(XEN menu_item)
+static Xen gxg_gtk_radio_menu_item_get_group(Xen radio_menu_item)
{
- #define H_gtk_menu_item_activate "void gtk_menu_item_activate(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_activate", "GtkMenuItem*");
- gtk_menu_item_activate(XEN_TO_C_GtkMenuItem_(menu_item));
- return(XEN_FALSE);
+ #define H_gtk_radio_menu_item_get_group "GSList* gtk_radio_menu_item_get_group(GtkRadioMenuItem* radio_menu_item)"
+ Xen_check_type(Xen_is_GtkRadioMenuItem_(radio_menu_item), radio_menu_item, 1, "gtk_radio_menu_item_get_group", "GtkRadioMenuItem*");
+ return(C_to_Xen_GSList_(gtk_radio_menu_item_get_group(Xen_to_C_GtkRadioMenuItem_(radio_menu_item))));
}
-static XEN gxg_gtk_menu_item_toggle_size_request(XEN menu_item, XEN requisition)
+static Xen gxg_gtk_radio_menu_item_set_group(Xen radio_menu_item, Xen group)
{
- #define H_gtk_menu_item_toggle_size_request "void gtk_menu_item_toggle_size_request(GtkMenuItem* menu_item, \
-gint* requisition)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_toggle_size_request", "GtkMenuItem*");
- XEN_ASSERT_TYPE(XEN_gint__P(requisition), requisition, 2, "gtk_menu_item_toggle_size_request", "gint*");
- gtk_menu_item_toggle_size_request(XEN_TO_C_GtkMenuItem_(menu_item), XEN_TO_C_gint_(requisition));
- return(XEN_FALSE);
+ #define H_gtk_radio_menu_item_set_group "void gtk_radio_menu_item_set_group(GtkRadioMenuItem* radio_menu_item, \
+GSList* group)"
+ Xen_check_type(Xen_is_GtkRadioMenuItem_(radio_menu_item), radio_menu_item, 1, "gtk_radio_menu_item_set_group", "GtkRadioMenuItem*");
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 2, "gtk_radio_menu_item_set_group", "GSList*");
+ gtk_radio_menu_item_set_group(Xen_to_C_GtkRadioMenuItem_(radio_menu_item), Xen_to_C_GSList_(group));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_item_toggle_size_allocate(XEN menu_item, XEN allocation)
+static Xen gxg_gtk_range_set_adjustment(Xen range, Xen adjustment)
{
- #define H_gtk_menu_item_toggle_size_allocate "void gtk_menu_item_toggle_size_allocate(GtkMenuItem* menu_item, \
-gint allocation)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_toggle_size_allocate", "GtkMenuItem*");
- XEN_ASSERT_TYPE(XEN_gint_P(allocation), allocation, 2, "gtk_menu_item_toggle_size_allocate", "gint");
- gtk_menu_item_toggle_size_allocate(XEN_TO_C_GtkMenuItem_(menu_item), XEN_TO_C_gint(allocation));
- return(XEN_FALSE);
+ #define H_gtk_range_set_adjustment "void gtk_range_set_adjustment(GtkRange* range, GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_adjustment", "GtkRange*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment) || Xen_is_false(adjustment), adjustment, 2, "gtk_range_set_adjustment", "GtkAdjustment*");
+ gtk_range_set_adjustment(Xen_to_C_GtkRange_(range), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_item_set_right_justified(XEN menu_item, XEN right_justified)
+static Xen gxg_gtk_range_get_adjustment(Xen range)
{
- #define H_gtk_menu_item_set_right_justified "void gtk_menu_item_set_right_justified(GtkMenuItem* menu_item, \
-gboolean right_justified)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_set_right_justified", "GtkMenuItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(right_justified), right_justified, 2, "gtk_menu_item_set_right_justified", "gboolean");
- gtk_menu_item_set_right_justified(XEN_TO_C_GtkMenuItem_(menu_item), XEN_TO_C_gboolean(right_justified));
- return(XEN_FALSE);
+ #define H_gtk_range_get_adjustment "GtkAdjustment* gtk_range_get_adjustment(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_adjustment", "GtkRange*");
+ return(C_to_Xen_GtkAdjustment_(gtk_range_get_adjustment(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_menu_item_get_right_justified(XEN menu_item)
+static Xen gxg_gtk_range_set_inverted(Xen range, Xen setting)
{
- #define H_gtk_menu_item_get_right_justified "gboolean gtk_menu_item_get_right_justified(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_get_right_justified", "GtkMenuItem*");
- return(C_TO_XEN_gboolean(gtk_menu_item_get_right_justified(XEN_TO_C_GtkMenuItem_(menu_item))));
+ #define H_gtk_range_set_inverted "void gtk_range_set_inverted(GtkRange* range, gboolean setting)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_inverted", "GtkRange*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_range_set_inverted", "gboolean");
+ gtk_range_set_inverted(Xen_to_C_GtkRange_(range), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_item_set_accel_path(XEN menu_item, XEN accel_path)
+static Xen gxg_gtk_range_get_inverted(Xen range)
{
- #define H_gtk_menu_item_set_accel_path "void gtk_menu_item_set_accel_path(GtkMenuItem* menu_item, gchar* accel_path)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_set_accel_path", "GtkMenuItem*");
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 2, "gtk_menu_item_set_accel_path", "gchar*");
- gtk_menu_item_set_accel_path(XEN_TO_C_GtkMenuItem_(menu_item), XEN_TO_C_gchar_(accel_path));
- return(XEN_FALSE);
+ #define H_gtk_range_get_inverted "gboolean gtk_range_get_inverted(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_inverted", "GtkRange*");
+ return(C_to_Xen_gboolean(gtk_range_get_inverted(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_menu_shell_append(XEN menu_shell, XEN child)
+static Xen gxg_gtk_range_set_increments(Xen range, Xen step, Xen page)
{
- #define H_gtk_menu_shell_append "void gtk_menu_shell_append(GtkMenuShell* menu_shell, GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_append", "GtkMenuShell*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_menu_shell_append", "GtkWidget*");
- gtk_menu_shell_append(XEN_TO_C_GtkMenuShell_(menu_shell), XEN_TO_C_GtkWidget_(child));
- return(XEN_FALSE);
+ #define H_gtk_range_set_increments "void gtk_range_set_increments(GtkRange* range, gdouble step, gdouble page)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_increments", "GtkRange*");
+ Xen_check_type(Xen_is_gdouble(step), step, 2, "gtk_range_set_increments", "gdouble");
+ Xen_check_type(Xen_is_gdouble(page), page, 3, "gtk_range_set_increments", "gdouble");
+ gtk_range_set_increments(Xen_to_C_GtkRange_(range), Xen_to_C_gdouble(step), Xen_to_C_gdouble(page));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_shell_prepend(XEN menu_shell, XEN child)
+static Xen gxg_gtk_range_set_range(Xen range, Xen min, Xen max)
{
- #define H_gtk_menu_shell_prepend "void gtk_menu_shell_prepend(GtkMenuShell* menu_shell, GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_prepend", "GtkMenuShell*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_menu_shell_prepend", "GtkWidget*");
- gtk_menu_shell_prepend(XEN_TO_C_GtkMenuShell_(menu_shell), XEN_TO_C_GtkWidget_(child));
- return(XEN_FALSE);
+ #define H_gtk_range_set_range "void gtk_range_set_range(GtkRange* range, gdouble min, gdouble max)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_range", "GtkRange*");
+ Xen_check_type(Xen_is_gdouble(min), min, 2, "gtk_range_set_range", "gdouble");
+ Xen_check_type(Xen_is_gdouble(max), max, 3, "gtk_range_set_range", "gdouble");
+ gtk_range_set_range(Xen_to_C_GtkRange_(range), Xen_to_C_gdouble(min), Xen_to_C_gdouble(max));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_shell_insert(XEN menu_shell, XEN child, XEN position)
+static Xen gxg_gtk_range_set_value(Xen range, Xen value)
{
- #define H_gtk_menu_shell_insert "void gtk_menu_shell_insert(GtkMenuShell* menu_shell, GtkWidget* child, \
-gint position)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_insert", "GtkMenuShell*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_menu_shell_insert", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_menu_shell_insert", "gint");
- gtk_menu_shell_insert(XEN_TO_C_GtkMenuShell_(menu_shell), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_range_set_value "void gtk_range_set_value(GtkRange* range, gdouble value)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_value", "GtkRange*");
+ Xen_check_type(Xen_is_gdouble(value), value, 2, "gtk_range_set_value", "gdouble");
+ gtk_range_set_value(Xen_to_C_GtkRange_(range), Xen_to_C_gdouble(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_shell_deactivate(XEN menu_shell)
+static Xen gxg_gtk_range_get_value(Xen range)
{
- #define H_gtk_menu_shell_deactivate "void gtk_menu_shell_deactivate(GtkMenuShell* menu_shell)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_deactivate", "GtkMenuShell*");
- gtk_menu_shell_deactivate(XEN_TO_C_GtkMenuShell_(menu_shell));
- return(XEN_FALSE);
+ #define H_gtk_range_get_value "gdouble gtk_range_get_value(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_value", "GtkRange*");
+ return(C_to_Xen_gdouble(gtk_range_get_value(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_menu_shell_select_item(XEN menu_shell, XEN menu_item)
+static Xen gxg_gtk_scale_set_digits(Xen scale, Xen digits)
{
- #define H_gtk_menu_shell_select_item "void gtk_menu_shell_select_item(GtkMenuShell* menu_shell, GtkWidget* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_select_item", "GtkMenuShell*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(menu_item), menu_item, 2, "gtk_menu_shell_select_item", "GtkWidget*");
- gtk_menu_shell_select_item(XEN_TO_C_GtkMenuShell_(menu_shell), XEN_TO_C_GtkWidget_(menu_item));
- return(XEN_FALSE);
+ #define H_gtk_scale_set_digits "void gtk_scale_set_digits(GtkScale* scale, gint digits)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_set_digits", "GtkScale*");
+ Xen_check_type(Xen_is_gint(digits), digits, 2, "gtk_scale_set_digits", "gint");
+ gtk_scale_set_digits(Xen_to_C_GtkScale_(scale), Xen_to_C_gint(digits));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_shell_deselect(XEN menu_shell)
+static Xen gxg_gtk_scale_get_digits(Xen scale)
{
- #define H_gtk_menu_shell_deselect "void gtk_menu_shell_deselect(GtkMenuShell* menu_shell)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_deselect", "GtkMenuShell*");
- gtk_menu_shell_deselect(XEN_TO_C_GtkMenuShell_(menu_shell));
- return(XEN_FALSE);
+ #define H_gtk_scale_get_digits "gint gtk_scale_get_digits(GtkScale* scale)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_get_digits", "GtkScale*");
+ return(C_to_Xen_gint(gtk_scale_get_digits(Xen_to_C_GtkScale_(scale))));
}
-static XEN gxg_gtk_menu_shell_activate_item(XEN menu_shell, XEN menu_item, XEN force_deactivate)
+static Xen gxg_gtk_scale_set_draw_value(Xen scale, Xen draw_value)
{
- #define H_gtk_menu_shell_activate_item "void gtk_menu_shell_activate_item(GtkMenuShell* menu_shell, \
-GtkWidget* menu_item, gboolean force_deactivate)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_activate_item", "GtkMenuShell*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(menu_item), menu_item, 2, "gtk_menu_shell_activate_item", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(force_deactivate), force_deactivate, 3, "gtk_menu_shell_activate_item", "gboolean");
- gtk_menu_shell_activate_item(XEN_TO_C_GtkMenuShell_(menu_shell), XEN_TO_C_GtkWidget_(menu_item), XEN_TO_C_gboolean(force_deactivate));
- return(XEN_FALSE);
+ #define H_gtk_scale_set_draw_value "void gtk_scale_set_draw_value(GtkScale* scale, gboolean draw_value)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_set_draw_value", "GtkScale*");
+ Xen_check_type(Xen_is_gboolean(draw_value), draw_value, 2, "gtk_scale_set_draw_value", "gboolean");
+ gtk_scale_set_draw_value(Xen_to_C_GtkScale_(scale), Xen_to_C_gboolean(draw_value));
+ return(Xen_false);
}
-static XEN gxg_gtk_misc_set_alignment(XEN misc, XEN xalign, XEN yalign)
+static Xen gxg_gtk_scale_get_draw_value(Xen scale)
{
- #define H_gtk_misc_set_alignment "void gtk_misc_set_alignment(GtkMisc* misc, gfloat xalign, gfloat yalign)"
- XEN_ASSERT_TYPE(XEN_GtkMisc__P(misc), misc, 1, "gtk_misc_set_alignment", "GtkMisc*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_misc_set_alignment", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yalign), yalign, 3, "gtk_misc_set_alignment", "gfloat");
- gtk_misc_set_alignment(XEN_TO_C_GtkMisc_(misc), XEN_TO_C_gfloat(xalign), XEN_TO_C_gfloat(yalign));
- return(XEN_FALSE);
+ #define H_gtk_scale_get_draw_value "gboolean gtk_scale_get_draw_value(GtkScale* scale)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_get_draw_value", "GtkScale*");
+ return(C_to_Xen_gboolean(gtk_scale_get_draw_value(Xen_to_C_GtkScale_(scale))));
}
-static XEN gxg_gtk_misc_get_alignment(XEN misc, XEN ignore_xalign, XEN ignore_yalign)
+static Xen gxg_gtk_scale_set_value_pos(Xen scale, Xen pos)
{
- #define H_gtk_misc_get_alignment "void gtk_misc_get_alignment(GtkMisc* misc, gfloat* [xalign], gfloat* [yalign])"
- gfloat ref_xalign;
- gfloat ref_yalign;
- XEN_ASSERT_TYPE(XEN_GtkMisc__P(misc), misc, 1, "gtk_misc_get_alignment", "GtkMisc*");
- gtk_misc_get_alignment(XEN_TO_C_GtkMisc_(misc), &ref_xalign, &ref_yalign);
- return(XEN_LIST_2(C_TO_XEN_gfloat(ref_xalign), C_TO_XEN_gfloat(ref_yalign)));
+ #define H_gtk_scale_set_value_pos "void gtk_scale_set_value_pos(GtkScale* scale, GtkPositionType pos)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_set_value_pos", "GtkScale*");
+ Xen_check_type(Xen_is_GtkPositionType(pos), pos, 2, "gtk_scale_set_value_pos", "GtkPositionType");
+ gtk_scale_set_value_pos(Xen_to_C_GtkScale_(scale), Xen_to_C_GtkPositionType(pos));
+ return(Xen_false);
}
-static XEN gxg_gtk_misc_set_padding(XEN misc, XEN xpad, XEN ypad)
+static Xen gxg_gtk_scale_get_value_pos(Xen scale)
{
- #define H_gtk_misc_set_padding "void gtk_misc_set_padding(GtkMisc* misc, gint xpad, gint ypad)"
- XEN_ASSERT_TYPE(XEN_GtkMisc__P(misc), misc, 1, "gtk_misc_set_padding", "GtkMisc*");
- XEN_ASSERT_TYPE(XEN_gint_P(xpad), xpad, 2, "gtk_misc_set_padding", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(ypad), ypad, 3, "gtk_misc_set_padding", "gint");
- gtk_misc_set_padding(XEN_TO_C_GtkMisc_(misc), XEN_TO_C_gint(xpad), XEN_TO_C_gint(ypad));
- return(XEN_FALSE);
+ #define H_gtk_scale_get_value_pos "GtkPositionType gtk_scale_get_value_pos(GtkScale* scale)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_get_value_pos", "GtkScale*");
+ return(C_to_Xen_GtkPositionType(gtk_scale_get_value_pos(Xen_to_C_GtkScale_(scale))));
}
-static XEN gxg_gtk_misc_get_padding(XEN misc, XEN ignore_xpad, XEN ignore_ypad)
+static Xen gxg_gtk_scrolled_window_new(Xen hadjustment, Xen vadjustment)
{
- #define H_gtk_misc_get_padding "void gtk_misc_get_padding(GtkMisc* misc, gint* [xpad], gint* [ypad])"
- gint ref_xpad;
- gint ref_ypad;
- XEN_ASSERT_TYPE(XEN_GtkMisc__P(misc), misc, 1, "gtk_misc_get_padding", "GtkMisc*");
- gtk_misc_get_padding(XEN_TO_C_GtkMisc_(misc), &ref_xpad, &ref_ypad);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_xpad), C_TO_XEN_gint(ref_ypad)));
+ #define H_gtk_scrolled_window_new "GtkWidget* gtk_scrolled_window_new(GtkAdjustment* hadjustment, GtkAdjustment* vadjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(hadjustment) || Xen_is_false(hadjustment), hadjustment, 1, "gtk_scrolled_window_new", "GtkAdjustment*");
+ Xen_check_type(Xen_is_GtkAdjustment_(vadjustment) || Xen_is_false(vadjustment), vadjustment, 2, "gtk_scrolled_window_new", "GtkAdjustment*");
+ return(C_to_Xen_GtkWidget_(gtk_scrolled_window_new(Xen_to_C_GtkAdjustment_(hadjustment), Xen_to_C_GtkAdjustment_(vadjustment))));
}
-static XEN gxg_gtk_notebook_new(void)
+static Xen gxg_gtk_scrolled_window_set_hadjustment(Xen scrolled_window, Xen hadjustment)
{
- #define H_gtk_notebook_new "GtkWidget* gtk_notebook_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_notebook_new()));
+ #define H_gtk_scrolled_window_set_hadjustment "void gtk_scrolled_window_set_hadjustment(GtkScrolledWindow* scrolled_window, \
+GtkAdjustment* hadjustment)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_hadjustment", "GtkScrolledWindow*");
+ Xen_check_type(Xen_is_GtkAdjustment_(hadjustment) || Xen_is_false(hadjustment), hadjustment, 2, "gtk_scrolled_window_set_hadjustment", "GtkAdjustment*");
+ gtk_scrolled_window_set_hadjustment(Xen_to_C_GtkScrolledWindow_(scrolled_window), Xen_to_C_GtkAdjustment_(hadjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_remove_page(XEN notebook, XEN page_num)
+static Xen gxg_gtk_scrolled_window_set_vadjustment(Xen scrolled_window, Xen hadjustment)
{
- #define H_gtk_notebook_remove_page "void gtk_notebook_remove_page(GtkNotebook* notebook, gint page_num)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_remove_page", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_gint_P(page_num), page_num, 2, "gtk_notebook_remove_page", "gint");
- gtk_notebook_remove_page(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_gint(page_num));
- return(XEN_FALSE);
+ #define H_gtk_scrolled_window_set_vadjustment "void gtk_scrolled_window_set_vadjustment(GtkScrolledWindow* scrolled_window, \
+GtkAdjustment* hadjustment)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_vadjustment", "GtkScrolledWindow*");
+ Xen_check_type(Xen_is_GtkAdjustment_(hadjustment) || Xen_is_false(hadjustment), hadjustment, 2, "gtk_scrolled_window_set_vadjustment", "GtkAdjustment*");
+ gtk_scrolled_window_set_vadjustment(Xen_to_C_GtkScrolledWindow_(scrolled_window), Xen_to_C_GtkAdjustment_(hadjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_current_page(XEN notebook)
+static Xen gxg_gtk_scrolled_window_get_hadjustment(Xen scrolled_window)
{
- #define H_gtk_notebook_get_current_page "gint gtk_notebook_get_current_page(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_current_page", "GtkNotebook*");
- return(C_TO_XEN_gint(gtk_notebook_get_current_page(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_scrolled_window_get_hadjustment "GtkAdjustment* gtk_scrolled_window_get_hadjustment(GtkScrolledWindow* scrolled_window)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_hadjustment", "GtkScrolledWindow*");
+ return(C_to_Xen_GtkAdjustment_(gtk_scrolled_window_get_hadjustment(Xen_to_C_GtkScrolledWindow_(scrolled_window))));
}
-static XEN gxg_gtk_notebook_get_nth_page(XEN notebook, XEN page_num)
+static Xen gxg_gtk_scrolled_window_get_vadjustment(Xen scrolled_window)
{
- #define H_gtk_notebook_get_nth_page "GtkWidget* gtk_notebook_get_nth_page(GtkNotebook* notebook, gint page_num)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_nth_page", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_gint_P(page_num), page_num, 2, "gtk_notebook_get_nth_page", "gint");
- return(C_TO_XEN_GtkWidget_(gtk_notebook_get_nth_page(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_gint(page_num))));
+ #define H_gtk_scrolled_window_get_vadjustment "GtkAdjustment* gtk_scrolled_window_get_vadjustment(GtkScrolledWindow* scrolled_window)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_vadjustment", "GtkScrolledWindow*");
+ return(C_to_Xen_GtkAdjustment_(gtk_scrolled_window_get_vadjustment(Xen_to_C_GtkScrolledWindow_(scrolled_window))));
}
-static XEN gxg_gtk_notebook_page_num(XEN notebook, XEN child)
+static Xen gxg_gtk_scrolled_window_set_policy(Xen scrolled_window, Xen hscrollbar_policy, Xen vscrollbar_policy)
{
- #define H_gtk_notebook_page_num "gint gtk_notebook_page_num(GtkNotebook* notebook, GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_page_num", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_page_num", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_notebook_page_num(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child))));
+ #define H_gtk_scrolled_window_set_policy "void gtk_scrolled_window_set_policy(GtkScrolledWindow* scrolled_window, \
+GtkPolicyType hscrollbar_policy, GtkPolicyType vscrollbar_policy)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_policy", "GtkScrolledWindow*");
+ Xen_check_type(Xen_is_GtkPolicyType(hscrollbar_policy), hscrollbar_policy, 2, "gtk_scrolled_window_set_policy", "GtkPolicyType");
+ Xen_check_type(Xen_is_GtkPolicyType(vscrollbar_policy), vscrollbar_policy, 3, "gtk_scrolled_window_set_policy", "GtkPolicyType");
+ gtk_scrolled_window_set_policy(Xen_to_C_GtkScrolledWindow_(scrolled_window), Xen_to_C_GtkPolicyType(hscrollbar_policy),
+ Xen_to_C_GtkPolicyType(vscrollbar_policy));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_set_current_page(XEN notebook, XEN page_num)
+static Xen gxg_gtk_scrolled_window_get_policy(Xen scrolled_window, Xen ignore_hscrollbar_policy, Xen ignore_vscrollbar_policy)
{
- #define H_gtk_notebook_set_current_page "void gtk_notebook_set_current_page(GtkNotebook* notebook, \
-gint page_num)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_current_page", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_gint_P(page_num), page_num, 2, "gtk_notebook_set_current_page", "gint");
- gtk_notebook_set_current_page(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_gint(page_num));
- return(XEN_FALSE);
+ #define H_gtk_scrolled_window_get_policy "void gtk_scrolled_window_get_policy(GtkScrolledWindow* scrolled_window, \
+GtkPolicyType* [hscrollbar_policy], GtkPolicyType* [vscrollbar_policy])"
+ GtkPolicyType ref_hscrollbar_policy;
+ GtkPolicyType ref_vscrollbar_policy;
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_policy", "GtkScrolledWindow*");
+ gtk_scrolled_window_get_policy(Xen_to_C_GtkScrolledWindow_(scrolled_window), &ref_hscrollbar_policy, &ref_vscrollbar_policy);
+ return(Xen_list_2(C_to_Xen_GtkPolicyType(ref_hscrollbar_policy), C_to_Xen_GtkPolicyType(ref_vscrollbar_policy)));
}
-static XEN gxg_gtk_notebook_next_page(XEN notebook)
+static Xen gxg_gtk_scrolled_window_set_placement(Xen scrolled_window, Xen window_placement)
{
- #define H_gtk_notebook_next_page "void gtk_notebook_next_page(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_next_page", "GtkNotebook*");
- gtk_notebook_next_page(XEN_TO_C_GtkNotebook_(notebook));
- return(XEN_FALSE);
+ #define H_gtk_scrolled_window_set_placement "void gtk_scrolled_window_set_placement(GtkScrolledWindow* scrolled_window, \
+GtkCornerType window_placement)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_placement", "GtkScrolledWindow*");
+ Xen_check_type(Xen_is_GtkCornerType(window_placement), window_placement, 2, "gtk_scrolled_window_set_placement", "GtkCornerType");
+ gtk_scrolled_window_set_placement(Xen_to_C_GtkScrolledWindow_(scrolled_window), Xen_to_C_GtkCornerType(window_placement));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_prev_page(XEN notebook)
+static Xen gxg_gtk_scrolled_window_get_placement(Xen scrolled_window)
{
- #define H_gtk_notebook_prev_page "void gtk_notebook_prev_page(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_prev_page", "GtkNotebook*");
- gtk_notebook_prev_page(XEN_TO_C_GtkNotebook_(notebook));
- return(XEN_FALSE);
+ #define H_gtk_scrolled_window_get_placement "GtkCornerType gtk_scrolled_window_get_placement(GtkScrolledWindow* scrolled_window)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_placement", "GtkScrolledWindow*");
+ return(C_to_Xen_GtkCornerType(gtk_scrolled_window_get_placement(Xen_to_C_GtkScrolledWindow_(scrolled_window))));
}
-static XEN gxg_gtk_notebook_set_show_border(XEN notebook, XEN show_border)
+static Xen gxg_gtk_scrolled_window_set_shadow_type(Xen scrolled_window, Xen type)
{
- #define H_gtk_notebook_set_show_border "void gtk_notebook_set_show_border(GtkNotebook* notebook, gboolean show_border)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_show_border", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_border), show_border, 2, "gtk_notebook_set_show_border", "gboolean");
- gtk_notebook_set_show_border(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_gboolean(show_border));
- return(XEN_FALSE);
+ #define H_gtk_scrolled_window_set_shadow_type "void gtk_scrolled_window_set_shadow_type(GtkScrolledWindow* scrolled_window, \
+GtkShadowType type)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_shadow_type", "GtkScrolledWindow*");
+ Xen_check_type(Xen_is_GtkShadowType(type), type, 2, "gtk_scrolled_window_set_shadow_type", "GtkShadowType");
+ gtk_scrolled_window_set_shadow_type(Xen_to_C_GtkScrolledWindow_(scrolled_window), Xen_to_C_GtkShadowType(type));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_show_border(XEN notebook)
+static Xen gxg_gtk_scrolled_window_get_shadow_type(Xen scrolled_window)
{
- #define H_gtk_notebook_get_show_border "gboolean gtk_notebook_get_show_border(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_show_border", "GtkNotebook*");
- return(C_TO_XEN_gboolean(gtk_notebook_get_show_border(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_scrolled_window_get_shadow_type "GtkShadowType gtk_scrolled_window_get_shadow_type(GtkScrolledWindow* scrolled_window)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_shadow_type", "GtkScrolledWindow*");
+ return(C_to_Xen_GtkShadowType(gtk_scrolled_window_get_shadow_type(Xen_to_C_GtkScrolledWindow_(scrolled_window))));
}
-static XEN gxg_gtk_notebook_set_show_tabs(XEN notebook, XEN show_tabs)
+static Xen gxg_gtk_target_list_new(Xen targets, Xen ntargets)
{
- #define H_gtk_notebook_set_show_tabs "void gtk_notebook_set_show_tabs(GtkNotebook* notebook, gboolean show_tabs)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_show_tabs", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_tabs), show_tabs, 2, "gtk_notebook_set_show_tabs", "gboolean");
- gtk_notebook_set_show_tabs(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_gboolean(show_tabs));
- return(XEN_FALSE);
+ #define H_gtk_target_list_new "GtkTargetList* gtk_target_list_new(GtkTargetEntry* targets, guint ntargets)"
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets) || Xen_is_false(targets), targets, 1, "gtk_target_list_new", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_guint(ntargets), ntargets, 2, "gtk_target_list_new", "guint");
+ return(C_to_Xen_GtkTargetList_(gtk_target_list_new(Xen_to_C_GtkTargetEntry_(targets), Xen_to_C_guint(ntargets))));
}
-static XEN gxg_gtk_notebook_get_show_tabs(XEN notebook)
+static Xen gxg_gtk_target_list_unref(Xen list)
{
- #define H_gtk_notebook_get_show_tabs "gboolean gtk_notebook_get_show_tabs(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_show_tabs", "GtkNotebook*");
- return(C_TO_XEN_gboolean(gtk_notebook_get_show_tabs(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_target_list_unref "void gtk_target_list_unref(GtkTargetList* list)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_unref", "GtkTargetList*");
+ gtk_target_list_unref(Xen_to_C_GtkTargetList_(list));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_set_tab_pos(XEN notebook, XEN pos)
+static Xen gxg_gtk_target_list_add(Xen list, Xen target, Xen flags, Xen info)
{
- #define H_gtk_notebook_set_tab_pos "void gtk_notebook_set_tab_pos(GtkNotebook* notebook, GtkPositionType pos)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_tab_pos", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkPositionType_P(pos), pos, 2, "gtk_notebook_set_tab_pos", "GtkPositionType");
- gtk_notebook_set_tab_pos(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkPositionType(pos));
- return(XEN_FALSE);
+ #define H_gtk_target_list_add "void gtk_target_list_add(GtkTargetList* list, GdkAtom target, guint flags, \
+guint info)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_add", "GtkTargetList*");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 2, "gtk_target_list_add", "GdkAtom");
+ Xen_check_type(Xen_is_guint(flags), flags, 3, "gtk_target_list_add", "guint");
+ Xen_check_type(Xen_is_guint(info), info, 4, "gtk_target_list_add", "guint");
+ gtk_target_list_add(Xen_to_C_GtkTargetList_(list), Xen_to_C_GdkAtom(target), Xen_to_C_guint(flags), Xen_to_C_guint(info));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_tab_pos(XEN notebook)
+static Xen gxg_gtk_target_list_add_table(Xen list, Xen targets, Xen ntargets)
{
- #define H_gtk_notebook_get_tab_pos "GtkPositionType gtk_notebook_get_tab_pos(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_tab_pos", "GtkNotebook*");
- return(C_TO_XEN_GtkPositionType(gtk_notebook_get_tab_pos(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_target_list_add_table "void gtk_target_list_add_table(GtkTargetList* list, GtkTargetEntry* targets, \
+guint ntargets)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_add_table", "GtkTargetList*");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 2, "gtk_target_list_add_table", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_guint(ntargets), ntargets, 3, "gtk_target_list_add_table", "guint");
+ gtk_target_list_add_table(Xen_to_C_GtkTargetList_(list), Xen_to_C_GtkTargetEntry_(targets), Xen_to_C_guint(ntargets));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_set_scrollable(XEN notebook, XEN scrollable)
+static Xen gxg_gtk_target_list_remove(Xen list, Xen target)
{
- #define H_gtk_notebook_set_scrollable "void gtk_notebook_set_scrollable(GtkNotebook* notebook, gboolean scrollable)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_scrollable", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(scrollable), scrollable, 2, "gtk_notebook_set_scrollable", "gboolean");
- gtk_notebook_set_scrollable(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_gboolean(scrollable));
- return(XEN_FALSE);
+ #define H_gtk_target_list_remove "void gtk_target_list_remove(GtkTargetList* list, GdkAtom target)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_remove", "GtkTargetList*");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 2, "gtk_target_list_remove", "GdkAtom");
+ gtk_target_list_remove(Xen_to_C_GtkTargetList_(list), Xen_to_C_GdkAtom(target));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_scrollable(XEN notebook)
+static Xen gxg_gtk_target_list_find(Xen list, Xen target, Xen ignore_info)
{
- #define H_gtk_notebook_get_scrollable "gboolean gtk_notebook_get_scrollable(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_scrollable", "GtkNotebook*");
- return(C_TO_XEN_gboolean(gtk_notebook_get_scrollable(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_target_list_find "gboolean gtk_target_list_find(GtkTargetList* list, GdkAtom target, \
+guint* [info])"
+ guint ref_info;
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_find", "GtkTargetList*");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 2, "gtk_target_list_find", "GdkAtom");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_target_list_find(Xen_to_C_GtkTargetList_(list), Xen_to_C_GdkAtom(target), &ref_info));
+ return(Xen_list_2(result, C_to_Xen_guint(ref_info)));
+ }
}
-static XEN gxg_gtk_notebook_popup_enable(XEN notebook)
+static Xen gxg_gtk_selection_owner_set(Xen widget, Xen selection, Xen time)
{
- #define H_gtk_notebook_popup_enable "void gtk_notebook_popup_enable(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_popup_enable", "GtkNotebook*");
- gtk_notebook_popup_enable(XEN_TO_C_GtkNotebook_(notebook));
- return(XEN_FALSE);
+ #define H_gtk_selection_owner_set "gboolean gtk_selection_owner_set(GtkWidget* widget, GdkAtom selection, \
+guint32 time)"
+ Xen_check_type(Xen_is_GtkWidget_(widget) || Xen_is_false(widget), widget, 1, "gtk_selection_owner_set", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gtk_selection_owner_set", "GdkAtom");
+ Xen_check_type(Xen_is_guint32(time), time, 3, "gtk_selection_owner_set", "guint32");
+ return(C_to_Xen_gboolean(gtk_selection_owner_set(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkAtom(selection), Xen_to_C_guint32(time))));
}
-static XEN gxg_gtk_notebook_popup_disable(XEN notebook)
+static Xen gxg_gtk_selection_add_target(Xen widget, Xen selection, Xen target, Xen info)
{
- #define H_gtk_notebook_popup_disable "void gtk_notebook_popup_disable(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_popup_disable", "GtkNotebook*");
- gtk_notebook_popup_disable(XEN_TO_C_GtkNotebook_(notebook));
- return(XEN_FALSE);
+ #define H_gtk_selection_add_target "void gtk_selection_add_target(GtkWidget* widget, GdkAtom selection, \
+GdkAtom target, guint info)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_selection_add_target", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gtk_selection_add_target", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 3, "gtk_selection_add_target", "GdkAtom");
+ Xen_check_type(Xen_is_guint(info), info, 4, "gtk_selection_add_target", "guint");
+ gtk_selection_add_target(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkAtom(selection), Xen_to_C_GdkAtom(target), Xen_to_C_guint(info));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_tab_label(XEN notebook, XEN child)
+static Xen gxg_gtk_selection_add_targets(Xen widget, Xen selection, Xen targets, Xen ntargets)
{
- #define H_gtk_notebook_get_tab_label "GtkWidget* gtk_notebook_get_tab_label(GtkNotebook* notebook, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_tab_label", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_get_tab_label", "GtkWidget*");
- return(C_TO_XEN_GtkWidget_(gtk_notebook_get_tab_label(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child))));
+ #define H_gtk_selection_add_targets "void gtk_selection_add_targets(GtkWidget* widget, GdkAtom selection, \
+GtkTargetEntry* targets, guint ntargets)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_selection_add_targets", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gtk_selection_add_targets", "GdkAtom");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 3, "gtk_selection_add_targets", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_guint(ntargets), ntargets, 4, "gtk_selection_add_targets", "guint");
+ gtk_selection_add_targets(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkAtom(selection), Xen_to_C_GtkTargetEntry_(targets),
+ Xen_to_C_guint(ntargets));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_set_tab_label(XEN notebook, XEN child, XEN tab_label)
+static Xen gxg_gtk_selection_clear_targets(Xen widget, Xen selection)
{
- #define H_gtk_notebook_set_tab_label "void gtk_notebook_set_tab_label(GtkNotebook* notebook, GtkWidget* child, \
-GtkWidget* tab_label)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_tab_label", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_set_tab_label", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(tab_label) || XEN_FALSE_P(tab_label), tab_label, 3, "gtk_notebook_set_tab_label", "GtkWidget*");
- gtk_notebook_set_tab_label(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(tab_label));
- return(XEN_FALSE);
+ #define H_gtk_selection_clear_targets "void gtk_selection_clear_targets(GtkWidget* widget, GdkAtom selection)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_selection_clear_targets", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gtk_selection_clear_targets", "GdkAtom");
+ gtk_selection_clear_targets(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkAtom(selection));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_set_tab_label_text(XEN notebook, XEN child, XEN tab_text)
+static Xen gxg_gtk_selection_convert(Xen widget, Xen selection, Xen target, Xen time)
{
- #define H_gtk_notebook_set_tab_label_text "void gtk_notebook_set_tab_label_text(GtkNotebook* notebook, \
-GtkWidget* child, gchar* tab_text)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_tab_label_text", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_set_tab_label_text", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(tab_text), tab_text, 3, "gtk_notebook_set_tab_label_text", "gchar*");
- gtk_notebook_set_tab_label_text(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gchar_(tab_text));
- return(XEN_FALSE);
+ #define H_gtk_selection_convert "gboolean gtk_selection_convert(GtkWidget* widget, GdkAtom selection, \
+GdkAtom target, guint32 time)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_selection_convert", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gtk_selection_convert", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 3, "gtk_selection_convert", "GdkAtom");
+ Xen_check_type(Xen_is_guint32(time), time, 4, "gtk_selection_convert", "guint32");
+ return(C_to_Xen_gboolean(gtk_selection_convert(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkAtom(selection), Xen_to_C_GdkAtom(target),
+ Xen_to_C_guint32(time))));
}
-static XEN gxg_gtk_notebook_get_tab_label_text(XEN notebook, XEN child)
+static Xen gxg_gtk_selection_data_set(Xen selection_data, Xen type, Xen format, Xen data, Xen length)
{
- #define H_gtk_notebook_get_tab_label_text "gchar* gtk_notebook_get_tab_label_text(GtkNotebook* notebook, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_tab_label_text", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_get_tab_label_text", "GtkWidget*");
- return(C_TO_XEN_gchar_(gtk_notebook_get_tab_label_text(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child))));
+ #define H_gtk_selection_data_set "void gtk_selection_data_set(GtkSelectionData* selection_data, GdkAtom type, \
+gint format, guchar* data, gint length)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_set", "GtkSelectionData*");
+ Xen_check_type(Xen_is_GdkAtom(type), type, 2, "gtk_selection_data_set", "GdkAtom");
+ Xen_check_type(Xen_is_gint(format), format, 3, "gtk_selection_data_set", "gint");
+ Xen_check_type(Xen_is_guchar_(data), data, 4, "gtk_selection_data_set", "guchar*");
+ Xen_check_type(Xen_is_gint(length), length, 5, "gtk_selection_data_set", "gint");
+ gtk_selection_data_set(Xen_to_C_GtkSelectionData_(selection_data), Xen_to_C_GdkAtom(type), Xen_to_C_gint(format), Xen_to_C_guchar_(data),
+ Xen_to_C_gint(length));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_menu_label(XEN notebook, XEN child)
+static Xen gxg_gtk_selection_data_set_text(Xen selection_data, Xen str, Xen len)
{
- #define H_gtk_notebook_get_menu_label "GtkWidget* gtk_notebook_get_menu_label(GtkNotebook* notebook, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_menu_label", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_get_menu_label", "GtkWidget*");
- return(C_TO_XEN_GtkWidget_(gtk_notebook_get_menu_label(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child))));
+ #define H_gtk_selection_data_set_text "gboolean gtk_selection_data_set_text(GtkSelectionData* selection_data, \
+gchar* str, gint len)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_set_text", "GtkSelectionData*");
+ Xen_check_type(Xen_is_gchar_(str), str, 2, "gtk_selection_data_set_text", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 3, "gtk_selection_data_set_text", "gint");
+ return(C_to_Xen_gboolean(gtk_selection_data_set_text(Xen_to_C_GtkSelectionData_(selection_data), Xen_to_C_gchar_(str),
+ Xen_to_C_gint(len))));
}
-static XEN gxg_gtk_notebook_set_menu_label(XEN notebook, XEN child, XEN menu_label)
+static Xen gxg_gtk_selection_data_get_text(Xen selection_data)
{
- #define H_gtk_notebook_set_menu_label "void gtk_notebook_set_menu_label(GtkNotebook* notebook, GtkWidget* child, \
-GtkWidget* menu_label)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_menu_label", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_set_menu_label", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(menu_label), menu_label, 3, "gtk_notebook_set_menu_label", "GtkWidget*");
- gtk_notebook_set_menu_label(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(menu_label));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_get_text "guchar* gtk_selection_data_get_text(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_text", "GtkSelectionData*");
+ {
+ guchar* result;
+ Xen rtn;
+ result = gtk_selection_data_get_text(Xen_to_C_GtkSelectionData_(selection_data));
+ rtn = C_to_Xen_guchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_notebook_set_menu_label_text(XEN notebook, XEN child, XEN menu_text)
+static Xen gxg_gtk_selection_data_get_targets(Xen selection_data, Xen ignore_targets, Xen ignore_n_atoms)
{
- #define H_gtk_notebook_set_menu_label_text "void gtk_notebook_set_menu_label_text(GtkNotebook* notebook, \
-GtkWidget* child, gchar* menu_text)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_menu_label_text", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_set_menu_label_text", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(menu_text), menu_text, 3, "gtk_notebook_set_menu_label_text", "gchar*");
- gtk_notebook_set_menu_label_text(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gchar_(menu_text));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_get_targets "gboolean gtk_selection_data_get_targets(GtkSelectionData* selection_data, \
+GdkAtom** [targets], gint* [n_atoms])"
+ GdkAtom* ref_targets = NULL;
+ gint ref_n_atoms;
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_targets", "GtkSelectionData*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_selection_data_get_targets(Xen_to_C_GtkSelectionData_(selection_data), &ref_targets, &ref_n_atoms));
+ return(Xen_list_3(result, C_to_Xen_GdkAtom_(ref_targets), C_to_Xen_gint(ref_n_atoms)));
+ }
}
-static XEN gxg_gtk_notebook_get_menu_label_text(XEN notebook, XEN child)
+static Xen gxg_gtk_selection_data_targets_include_text(Xen selection_data)
{
- #define H_gtk_notebook_get_menu_label_text "gchar* gtk_notebook_get_menu_label_text(GtkNotebook* notebook, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_menu_label_text", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_get_menu_label_text", "GtkWidget*");
- return(C_TO_XEN_gchar_(gtk_notebook_get_menu_label_text(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child))));
+ #define H_gtk_selection_data_targets_include_text "gboolean gtk_selection_data_targets_include_text(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_targets_include_text", "GtkSelectionData*");
+ return(C_to_Xen_gboolean(gtk_selection_data_targets_include_text(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_notebook_reorder_child(XEN notebook, XEN child, XEN position)
+static Xen gxg_gtk_selection_remove_all(Xen widget)
{
- #define H_gtk_notebook_reorder_child "void gtk_notebook_reorder_child(GtkNotebook* notebook, GtkWidget* child, \
-gint position)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_reorder_child", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_reorder_child", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_notebook_reorder_child", "gint");
- gtk_notebook_reorder_child(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_selection_remove_all "void gtk_selection_remove_all(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_selection_remove_all", "GtkWidget*");
+ gtk_selection_remove_all(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_append_page(XEN notebook, XEN child, XEN tab_label)
+static Xen gxg_gtk_selection_data_copy(Xen data)
{
- #define H_gtk_notebook_append_page "gint gtk_notebook_append_page(GtkNotebook* notebook, GtkWidget* child, \
-GtkWidget* tab_label)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_append_page", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_append_page", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(tab_label) || XEN_FALSE_P(tab_label), tab_label, 3, "gtk_notebook_append_page", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_notebook_append_page(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(tab_label))));
+ #define H_gtk_selection_data_copy "GtkSelectionData* gtk_selection_data_copy(GtkSelectionData* data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(data), data, 1, "gtk_selection_data_copy", "GtkSelectionData*");
+ return(C_to_Xen_GtkSelectionData_(gtk_selection_data_copy(Xen_to_C_GtkSelectionData_(data))));
}
-static XEN gxg_gtk_notebook_append_page_menu(XEN notebook, XEN child, XEN tab_label, XEN menu_label)
+static Xen gxg_gtk_selection_data_free(Xen data)
{
- #define H_gtk_notebook_append_page_menu "gint gtk_notebook_append_page_menu(GtkNotebook* notebook, \
-GtkWidget* child, GtkWidget* tab_label, GtkWidget* menu_label)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_append_page_menu", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_append_page_menu", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(tab_label) || XEN_FALSE_P(tab_label), tab_label, 3, "gtk_notebook_append_page_menu", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(menu_label) || XEN_FALSE_P(menu_label), menu_label, 4, "gtk_notebook_append_page_menu", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_notebook_append_page_menu(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(tab_label),
- XEN_TO_C_GtkWidget_(menu_label))));
+ #define H_gtk_selection_data_free "void gtk_selection_data_free(GtkSelectionData* data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(data), data, 1, "gtk_selection_data_free", "GtkSelectionData*");
+ gtk_selection_data_free(Xen_to_C_GtkSelectionData_(data));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_prepend_page(XEN notebook, XEN child, XEN tab_label)
+static Xen gxg_gtk_separator_menu_item_new(void)
{
- #define H_gtk_notebook_prepend_page "gint gtk_notebook_prepend_page(GtkNotebook* notebook, GtkWidget* child, \
-GtkWidget* tab_label)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_prepend_page", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_prepend_page", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(tab_label) || XEN_FALSE_P(tab_label), tab_label, 3, "gtk_notebook_prepend_page", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_notebook_prepend_page(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(tab_label))));
+ #define H_gtk_separator_menu_item_new "GtkWidget* gtk_separator_menu_item_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_separator_menu_item_new()));
}
-static XEN gxg_gtk_notebook_prepend_page_menu(XEN notebook, XEN child, XEN tab_label, XEN menu_label)
+static Xen gxg_gtk_settings_get_default(void)
{
- #define H_gtk_notebook_prepend_page_menu "gint gtk_notebook_prepend_page_menu(GtkNotebook* notebook, \
-GtkWidget* child, GtkWidget* tab_label, GtkWidget* menu_label)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_prepend_page_menu", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_prepend_page_menu", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(tab_label) || XEN_FALSE_P(tab_label), tab_label, 3, "gtk_notebook_prepend_page_menu", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(menu_label) || XEN_FALSE_P(menu_label), menu_label, 4, "gtk_notebook_prepend_page_menu", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_notebook_prepend_page_menu(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(tab_label),
- XEN_TO_C_GtkWidget_(menu_label))));
+ #define H_gtk_settings_get_default "GtkSettings* gtk_settings_get_default( void)"
+ return(C_to_Xen_GtkSettings_(gtk_settings_get_default()));
}
-static XEN gxg_gtk_notebook_insert_page(XEN notebook, XEN child, XEN tab_label, XEN position)
+static Xen gxg_gtk_size_group_new(Xen mode)
{
- #define H_gtk_notebook_insert_page "gint gtk_notebook_insert_page(GtkNotebook* notebook, GtkWidget* child, \
-GtkWidget* tab_label, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_insert_page", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_insert_page", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(tab_label) || XEN_FALSE_P(tab_label), tab_label, 3, "gtk_notebook_insert_page", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 4, "gtk_notebook_insert_page", "gint");
- return(C_TO_XEN_gint(gtk_notebook_insert_page(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(tab_label),
- XEN_TO_C_gint(position))));
+ #define H_gtk_size_group_new "GtkSizeGroup* gtk_size_group_new(GtkSizeGroupMode mode)"
+ Xen_check_type(Xen_is_GtkSizeGroupMode(mode), mode, 1, "gtk_size_group_new", "GtkSizeGroupMode");
+ return(C_to_Xen_GtkSizeGroup_(gtk_size_group_new(Xen_to_C_GtkSizeGroupMode(mode))));
}
-static XEN gxg_gtk_notebook_insert_page_menu(XEN notebook, XEN child, XEN tab_label, XEN menu_label, XEN position)
+static Xen gxg_gtk_size_group_set_mode(Xen size_group, Xen mode)
{
- #define H_gtk_notebook_insert_page_menu "gint gtk_notebook_insert_page_menu(GtkNotebook* notebook, \
-GtkWidget* child, GtkWidget* tab_label, GtkWidget* menu_label, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_insert_page_menu", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_insert_page_menu", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(tab_label) || XEN_FALSE_P(tab_label), tab_label, 3, "gtk_notebook_insert_page_menu", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(menu_label) || XEN_FALSE_P(menu_label), menu_label, 4, "gtk_notebook_insert_page_menu", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 5, "gtk_notebook_insert_page_menu", "gint");
- return(C_TO_XEN_gint(gtk_notebook_insert_page_menu(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(tab_label),
- XEN_TO_C_GtkWidget_(menu_label), XEN_TO_C_gint(position))));
+ #define H_gtk_size_group_set_mode "void gtk_size_group_set_mode(GtkSizeGroup* size_group, GtkSizeGroupMode mode)"
+ Xen_check_type(Xen_is_GtkSizeGroup_(size_group), size_group, 1, "gtk_size_group_set_mode", "GtkSizeGroup*");
+ Xen_check_type(Xen_is_GtkSizeGroupMode(mode), mode, 2, "gtk_size_group_set_mode", "GtkSizeGroupMode");
+ gtk_size_group_set_mode(Xen_to_C_GtkSizeGroup_(size_group), Xen_to_C_GtkSizeGroupMode(mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_paned_add1(XEN paned, XEN child)
+static Xen gxg_gtk_size_group_get_mode(Xen size_group)
{
- #define H_gtk_paned_add1 "void gtk_paned_add1(GtkPaned* paned, GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_add1", "GtkPaned*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_paned_add1", "GtkWidget*");
- gtk_paned_add1(XEN_TO_C_GtkPaned_(paned), XEN_TO_C_GtkWidget_(child));
- return(XEN_FALSE);
+ #define H_gtk_size_group_get_mode "GtkSizeGroupMode gtk_size_group_get_mode(GtkSizeGroup* size_group)"
+ Xen_check_type(Xen_is_GtkSizeGroup_(size_group), size_group, 1, "gtk_size_group_get_mode", "GtkSizeGroup*");
+ return(C_to_Xen_GtkSizeGroupMode(gtk_size_group_get_mode(Xen_to_C_GtkSizeGroup_(size_group))));
}
-static XEN gxg_gtk_paned_add2(XEN paned, XEN child)
+static Xen gxg_gtk_size_group_add_widget(Xen size_group, Xen widget)
{
- #define H_gtk_paned_add2 "void gtk_paned_add2(GtkPaned* paned, GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_add2", "GtkPaned*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_paned_add2", "GtkWidget*");
- gtk_paned_add2(XEN_TO_C_GtkPaned_(paned), XEN_TO_C_GtkWidget_(child));
- return(XEN_FALSE);
+ #define H_gtk_size_group_add_widget "void gtk_size_group_add_widget(GtkSizeGroup* size_group, GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkSizeGroup_(size_group), size_group, 1, "gtk_size_group_add_widget", "GtkSizeGroup*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_size_group_add_widget", "GtkWidget*");
+ gtk_size_group_add_widget(Xen_to_C_GtkSizeGroup_(size_group), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_paned_pack1(XEN paned, XEN child, XEN resize, XEN shrink)
+static Xen gxg_gtk_size_group_remove_widget(Xen size_group, Xen widget)
{
- #define H_gtk_paned_pack1 "void gtk_paned_pack1(GtkPaned* paned, GtkWidget* child, gboolean resize, \
-gboolean shrink)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_pack1", "GtkPaned*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_paned_pack1", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(resize), resize, 3, "gtk_paned_pack1", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(shrink), shrink, 4, "gtk_paned_pack1", "gboolean");
- gtk_paned_pack1(XEN_TO_C_GtkPaned_(paned), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gboolean(resize), XEN_TO_C_gboolean(shrink));
- return(XEN_FALSE);
+ #define H_gtk_size_group_remove_widget "void gtk_size_group_remove_widget(GtkSizeGroup* size_group, \
+GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkSizeGroup_(size_group), size_group, 1, "gtk_size_group_remove_widget", "GtkSizeGroup*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_size_group_remove_widget", "GtkWidget*");
+ gtk_size_group_remove_widget(Xen_to_C_GtkSizeGroup_(size_group), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_paned_pack2(XEN paned, XEN child, XEN resize, XEN shrink)
+static Xen gxg_gtk_spin_button_configure(Xen spin_button, Xen adjustment, Xen climb_rate, Xen digits)
{
- #define H_gtk_paned_pack2 "void gtk_paned_pack2(GtkPaned* paned, GtkWidget* child, gboolean resize, \
-gboolean shrink)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_pack2", "GtkPaned*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_paned_pack2", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(resize), resize, 3, "gtk_paned_pack2", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(shrink), shrink, 4, "gtk_paned_pack2", "gboolean");
- gtk_paned_pack2(XEN_TO_C_GtkPaned_(paned), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gboolean(resize), XEN_TO_C_gboolean(shrink));
- return(XEN_FALSE);
+ #define H_gtk_spin_button_configure "void gtk_spin_button_configure(GtkSpinButton* spin_button, GtkAdjustment* adjustment, \
+gdouble climb_rate, guint digits)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_configure", "GtkSpinButton*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment) || Xen_is_false(adjustment), adjustment, 2, "gtk_spin_button_configure", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(climb_rate), climb_rate, 3, "gtk_spin_button_configure", "gdouble");
+ Xen_check_type(Xen_is_guint(digits), digits, 4, "gtk_spin_button_configure", "guint");
+ gtk_spin_button_configure(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(climb_rate),
+ Xen_to_C_guint(digits));
+ return(Xen_false);
}
-static XEN gxg_gtk_paned_get_position(XEN paned)
+static Xen gxg_gtk_spin_button_new(Xen adjustment, Xen climb_rate, Xen digits)
{
- #define H_gtk_paned_get_position "gint gtk_paned_get_position(GtkPaned* paned)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_get_position", "GtkPaned*");
- return(C_TO_XEN_gint(gtk_paned_get_position(XEN_TO_C_GtkPaned_(paned))));
+ #define H_gtk_spin_button_new "GtkWidget* gtk_spin_button_new(GtkAdjustment* adjustment, gdouble climb_rate, \
+guint digits)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment) || Xen_is_false(adjustment), adjustment, 1, "gtk_spin_button_new", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(climb_rate), climb_rate, 2, "gtk_spin_button_new", "gdouble");
+ Xen_check_type(Xen_is_guint(digits), digits, 3, "gtk_spin_button_new", "guint");
+ return(C_to_Xen_GtkWidget_(gtk_spin_button_new(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(climb_rate), Xen_to_C_guint(digits))));
}
-static XEN gxg_gtk_paned_set_position(XEN paned, XEN position)
+static Xen gxg_gtk_spin_button_new_with_range(Xen min, Xen max, Xen step)
{
- #define H_gtk_paned_set_position "void gtk_paned_set_position(GtkPaned* paned, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_set_position", "GtkPaned*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 2, "gtk_paned_set_position", "gint");
- gtk_paned_set_position(XEN_TO_C_GtkPaned_(paned), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_spin_button_new_with_range "GtkWidget* gtk_spin_button_new_with_range(gdouble min, gdouble max, \
+gdouble step)"
+ Xen_check_type(Xen_is_gdouble(min), min, 1, "gtk_spin_button_new_with_range", "gdouble");
+ Xen_check_type(Xen_is_gdouble(max), max, 2, "gtk_spin_button_new_with_range", "gdouble");
+ Xen_check_type(Xen_is_gdouble(step), step, 3, "gtk_spin_button_new_with_range", "gdouble");
+ return(C_to_Xen_GtkWidget_(gtk_spin_button_new_with_range(Xen_to_C_gdouble(min), Xen_to_C_gdouble(max), Xen_to_C_gdouble(step))));
}
-static XEN gxg_gtk_progress_bar_new(void)
+static Xen gxg_gtk_spin_button_set_adjustment(Xen spin_button, Xen adjustment)
{
- #define H_gtk_progress_bar_new "GtkWidget* gtk_progress_bar_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_progress_bar_new()));
+ #define H_gtk_spin_button_set_adjustment "void gtk_spin_button_set_adjustment(GtkSpinButton* spin_button, \
+GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_adjustment", "GtkSpinButton*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment) || Xen_is_false(adjustment), adjustment, 2, "gtk_spin_button_set_adjustment", "GtkAdjustment*");
+ gtk_spin_button_set_adjustment(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_progress_bar_pulse(XEN pbar)
+static Xen gxg_gtk_spin_button_get_adjustment(Xen spin_button)
{
- #define H_gtk_progress_bar_pulse "void gtk_progress_bar_pulse(GtkProgressBar* pbar)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_pulse", "GtkProgressBar*");
- gtk_progress_bar_pulse(XEN_TO_C_GtkProgressBar_(pbar));
- return(XEN_FALSE);
+ #define H_gtk_spin_button_get_adjustment "GtkAdjustment* gtk_spin_button_get_adjustment(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_adjustment", "GtkSpinButton*");
+ return(C_to_Xen_GtkAdjustment_(gtk_spin_button_get_adjustment(Xen_to_C_GtkSpinButton_(spin_button))));
}
-static XEN gxg_gtk_progress_bar_set_text(XEN pbar, XEN text)
+static Xen gxg_gtk_spin_button_set_digits(Xen spin_button, Xen digits)
{
- #define H_gtk_progress_bar_set_text "void gtk_progress_bar_set_text(GtkProgressBar* pbar, gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_set_text", "GtkProgressBar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_progress_bar_set_text", "gchar*");
- gtk_progress_bar_set_text(XEN_TO_C_GtkProgressBar_(pbar), XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_spin_button_set_digits "void gtk_spin_button_set_digits(GtkSpinButton* spin_button, guint digits)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_digits", "GtkSpinButton*");
+ Xen_check_type(Xen_is_guint(digits), digits, 2, "gtk_spin_button_set_digits", "guint");
+ gtk_spin_button_set_digits(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_guint(digits));
+ return(Xen_false);
}
-static XEN gxg_gtk_progress_bar_set_fraction(XEN pbar, XEN fraction)
+static Xen gxg_gtk_spin_button_get_digits(Xen spin_button)
{
- #define H_gtk_progress_bar_set_fraction "void gtk_progress_bar_set_fraction(GtkProgressBar* pbar, gdouble fraction)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_set_fraction", "GtkProgressBar*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(fraction), fraction, 2, "gtk_progress_bar_set_fraction", "gdouble");
- gtk_progress_bar_set_fraction(XEN_TO_C_GtkProgressBar_(pbar), XEN_TO_C_gdouble(fraction));
- return(XEN_FALSE);
+ #define H_gtk_spin_button_get_digits "guint gtk_spin_button_get_digits(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_digits", "GtkSpinButton*");
+ return(C_to_Xen_guint(gtk_spin_button_get_digits(Xen_to_C_GtkSpinButton_(spin_button))));
}
-static XEN gxg_gtk_progress_bar_set_pulse_step(XEN pbar, XEN fraction)
+static Xen gxg_gtk_spin_button_set_increments(Xen spin_button, Xen step, Xen page)
{
- #define H_gtk_progress_bar_set_pulse_step "void gtk_progress_bar_set_pulse_step(GtkProgressBar* pbar, \
-gdouble fraction)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_set_pulse_step", "GtkProgressBar*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(fraction), fraction, 2, "gtk_progress_bar_set_pulse_step", "gdouble");
- gtk_progress_bar_set_pulse_step(XEN_TO_C_GtkProgressBar_(pbar), XEN_TO_C_gdouble(fraction));
- return(XEN_FALSE);
+ #define H_gtk_spin_button_set_increments "void gtk_spin_button_set_increments(GtkSpinButton* spin_button, \
+gdouble step, gdouble page)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_increments", "GtkSpinButton*");
+ Xen_check_type(Xen_is_gdouble(step), step, 2, "gtk_spin_button_set_increments", "gdouble");
+ Xen_check_type(Xen_is_gdouble(page), page, 3, "gtk_spin_button_set_increments", "gdouble");
+ gtk_spin_button_set_increments(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_gdouble(step), Xen_to_C_gdouble(page));
+ return(Xen_false);
}
-static XEN gxg_gtk_progress_bar_get_text(XEN pbar)
+static Xen gxg_gtk_spin_button_get_increments(Xen spin_button, Xen ignore_step, Xen ignore_page)
{
- #define H_gtk_progress_bar_get_text "gchar* gtk_progress_bar_get_text(GtkProgressBar* pbar)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_get_text", "GtkProgressBar*");
- return(C_TO_XEN_gchar_(gtk_progress_bar_get_text(XEN_TO_C_GtkProgressBar_(pbar))));
+ #define H_gtk_spin_button_get_increments "void gtk_spin_button_get_increments(GtkSpinButton* spin_button, \
+gdouble* [step], gdouble* [page])"
+ gdouble ref_step;
+ gdouble ref_page;
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_increments", "GtkSpinButton*");
+ gtk_spin_button_get_increments(Xen_to_C_GtkSpinButton_(spin_button), &ref_step, &ref_page);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_step), C_to_Xen_gdouble(ref_page)));
}
-static XEN gxg_gtk_progress_bar_get_fraction(XEN pbar)
+static Xen gxg_gtk_spin_button_set_range(Xen spin_button, Xen min, Xen max)
{
- #define H_gtk_progress_bar_get_fraction "gdouble gtk_progress_bar_get_fraction(GtkProgressBar* pbar)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_get_fraction", "GtkProgressBar*");
- return(C_TO_XEN_gdouble(gtk_progress_bar_get_fraction(XEN_TO_C_GtkProgressBar_(pbar))));
+ #define H_gtk_spin_button_set_range "void gtk_spin_button_set_range(GtkSpinButton* spin_button, gdouble min, \
+gdouble max)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_range", "GtkSpinButton*");
+ Xen_check_type(Xen_is_gdouble(min), min, 2, "gtk_spin_button_set_range", "gdouble");
+ Xen_check_type(Xen_is_gdouble(max), max, 3, "gtk_spin_button_set_range", "gdouble");
+ gtk_spin_button_set_range(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_gdouble(min), Xen_to_C_gdouble(max));
+ return(Xen_false);
}
-static XEN gxg_gtk_progress_bar_get_pulse_step(XEN pbar)
+static Xen gxg_gtk_spin_button_get_range(Xen spin_button, Xen ignore_min, Xen ignore_max)
{
- #define H_gtk_progress_bar_get_pulse_step "gdouble gtk_progress_bar_get_pulse_step(GtkProgressBar* pbar)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_get_pulse_step", "GtkProgressBar*");
- return(C_TO_XEN_gdouble(gtk_progress_bar_get_pulse_step(XEN_TO_C_GtkProgressBar_(pbar))));
+ #define H_gtk_spin_button_get_range "void gtk_spin_button_get_range(GtkSpinButton* spin_button, gdouble* [min], \
+gdouble* [max])"
+ gdouble ref_min;
+ gdouble ref_max;
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_range", "GtkSpinButton*");
+ gtk_spin_button_get_range(Xen_to_C_GtkSpinButton_(spin_button), &ref_min, &ref_max);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_min), C_to_Xen_gdouble(ref_max)));
}
-static XEN gxg_gtk_radio_button_new(XEN group)
+static Xen gxg_gtk_spin_button_get_value(Xen spin_button)
{
- #define H_gtk_radio_button_new "GtkWidget* gtk_radio_button_new(GSList* group)"
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 1, "gtk_radio_button_new", "GSList*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_button_new(XEN_TO_C_GSList_(group))));
+ #define H_gtk_spin_button_get_value "gdouble gtk_spin_button_get_value(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_value", "GtkSpinButton*");
+ return(C_to_Xen_gdouble(gtk_spin_button_get_value(Xen_to_C_GtkSpinButton_(spin_button))));
}
-static XEN gxg_gtk_radio_button_new_from_widget(XEN group)
+static Xen gxg_gtk_spin_button_get_value_as_int(Xen spin_button)
{
- #define H_gtk_radio_button_new_from_widget "GtkWidget* gtk_radio_button_new_from_widget(GtkRadioButton* group)"
- XEN_ASSERT_TYPE(XEN_GtkRadioButton__P(group), group, 1, "gtk_radio_button_new_from_widget", "GtkRadioButton*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_button_new_from_widget(XEN_TO_C_GtkRadioButton_(group))));
+ #define H_gtk_spin_button_get_value_as_int "gint gtk_spin_button_get_value_as_int(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_value_as_int", "GtkSpinButton*");
+ return(C_to_Xen_gint(gtk_spin_button_get_value_as_int(Xen_to_C_GtkSpinButton_(spin_button))));
}
-static XEN gxg_gtk_radio_button_new_with_label(XEN group, XEN label)
+static Xen gxg_gtk_spin_button_set_value(Xen spin_button, Xen value)
{
- #define H_gtk_radio_button_new_with_label "GtkWidget* gtk_radio_button_new_with_label(GSList* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 1, "gtk_radio_button_new_with_label", "GSList*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_button_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_button_new_with_label(XEN_TO_C_GSList_(group), XEN_TO_C_gchar_(label))));
+ #define H_gtk_spin_button_set_value "void gtk_spin_button_set_value(GtkSpinButton* spin_button, gdouble value)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_value", "GtkSpinButton*");
+ Xen_check_type(Xen_is_gdouble(value), value, 2, "gtk_spin_button_set_value", "gdouble");
+ gtk_spin_button_set_value(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_gdouble(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_button_new_with_label_from_widget(XEN group, XEN label)
+static Xen gxg_gtk_spin_button_set_update_policy(Xen spin_button, Xen policy)
{
- #define H_gtk_radio_button_new_with_label_from_widget "GtkWidget* gtk_radio_button_new_with_label_from_widget(GtkRadioButton* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkRadioButton__P(group), group, 1, "gtk_radio_button_new_with_label_from_widget", "GtkRadioButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_button_new_with_label_from_widget", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_button_new_with_label_from_widget(XEN_TO_C_GtkRadioButton_(group), XEN_TO_C_gchar_(label))));
+ #define H_gtk_spin_button_set_update_policy "void gtk_spin_button_set_update_policy(GtkSpinButton* spin_button, \
+GtkSpinButtonUpdatePolicy policy)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_update_policy", "GtkSpinButton*");
+ Xen_check_type(Xen_is_GtkSpinButtonUpdatePolicy(policy), policy, 2, "gtk_spin_button_set_update_policy", "GtkSpinButtonUpdatePolicy");
+ gtk_spin_button_set_update_policy(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_GtkSpinButtonUpdatePolicy(policy));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_button_new_with_mnemonic(XEN group, XEN label)
+static Xen gxg_gtk_spin_button_get_update_policy(Xen spin_button)
{
- #define H_gtk_radio_button_new_with_mnemonic "GtkWidget* gtk_radio_button_new_with_mnemonic(GSList* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 1, "gtk_radio_button_new_with_mnemonic", "GSList*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_button_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_button_new_with_mnemonic(XEN_TO_C_GSList_(group), XEN_TO_C_gchar_(label))));
+ #define H_gtk_spin_button_get_update_policy "GtkSpinButtonUpdatePolicy gtk_spin_button_get_update_policy(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_update_policy", "GtkSpinButton*");
+ return(C_to_Xen_GtkSpinButtonUpdatePolicy(gtk_spin_button_get_update_policy(Xen_to_C_GtkSpinButton_(spin_button))));
}
-static XEN gxg_gtk_radio_button_new_with_mnemonic_from_widget(XEN group, XEN label)
+static Xen gxg_gtk_spin_button_set_numeric(Xen spin_button, Xen numeric)
{
- #define H_gtk_radio_button_new_with_mnemonic_from_widget "GtkWidget* gtk_radio_button_new_with_mnemonic_from_widget(GtkRadioButton* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkRadioButton__P(group), group, 1, "gtk_radio_button_new_with_mnemonic_from_widget", "GtkRadioButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_button_new_with_mnemonic_from_widget", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_button_new_with_mnemonic_from_widget(XEN_TO_C_GtkRadioButton_(group), XEN_TO_C_gchar_(label))));
+ #define H_gtk_spin_button_set_numeric "void gtk_spin_button_set_numeric(GtkSpinButton* spin_button, \
+gboolean numeric)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_numeric", "GtkSpinButton*");
+ Xen_check_type(Xen_is_gboolean(numeric), numeric, 2, "gtk_spin_button_set_numeric", "gboolean");
+ gtk_spin_button_set_numeric(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_gboolean(numeric));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_button_get_group(XEN radio_button)
+static Xen gxg_gtk_spin_button_get_numeric(Xen spin_button)
{
- #define H_gtk_radio_button_get_group "GSList* gtk_radio_button_get_group(GtkRadioButton* radio_button)"
- XEN_ASSERT_TYPE(XEN_GtkRadioButton__P(radio_button), radio_button, 1, "gtk_radio_button_get_group", "GtkRadioButton*");
- return(C_TO_XEN_GSList_(gtk_radio_button_get_group(XEN_TO_C_GtkRadioButton_(radio_button))));
+ #define H_gtk_spin_button_get_numeric "gboolean gtk_spin_button_get_numeric(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_numeric", "GtkSpinButton*");
+ return(C_to_Xen_gboolean(gtk_spin_button_get_numeric(Xen_to_C_GtkSpinButton_(spin_button))));
}
-static XEN gxg_gtk_radio_button_set_group(XEN radio_button, XEN group)
+static Xen gxg_gtk_spin_button_spin(Xen spin_button, Xen direction, Xen increment)
{
- #define H_gtk_radio_button_set_group "void gtk_radio_button_set_group(GtkRadioButton* radio_button, \
-GSList* group)"
- XEN_ASSERT_TYPE(XEN_GtkRadioButton__P(radio_button), radio_button, 1, "gtk_radio_button_set_group", "GtkRadioButton*");
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 2, "gtk_radio_button_set_group", "GSList*");
- gtk_radio_button_set_group(XEN_TO_C_GtkRadioButton_(radio_button), XEN_TO_C_GSList_(group));
- return(XEN_FALSE);
+ #define H_gtk_spin_button_spin "void gtk_spin_button_spin(GtkSpinButton* spin_button, GtkSpinType direction, \
+gdouble increment)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_spin", "GtkSpinButton*");
+ Xen_check_type(Xen_is_GtkSpinType(direction), direction, 2, "gtk_spin_button_spin", "GtkSpinType");
+ Xen_check_type(Xen_is_gdouble(increment), increment, 3, "gtk_spin_button_spin", "gdouble");
+ gtk_spin_button_spin(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_GtkSpinType(direction), Xen_to_C_gdouble(increment));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_menu_item_new(XEN group)
+static Xen gxg_gtk_spin_button_set_wrap(Xen spin_button, Xen wrap)
{
- #define H_gtk_radio_menu_item_new "GtkWidget* gtk_radio_menu_item_new(GSList* group)"
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 1, "gtk_radio_menu_item_new", "GSList*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_menu_item_new(XEN_TO_C_GSList_(group))));
+ #define H_gtk_spin_button_set_wrap "void gtk_spin_button_set_wrap(GtkSpinButton* spin_button, gboolean wrap)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_wrap", "GtkSpinButton*");
+ Xen_check_type(Xen_is_gboolean(wrap), wrap, 2, "gtk_spin_button_set_wrap", "gboolean");
+ gtk_spin_button_set_wrap(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_gboolean(wrap));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_menu_item_new_with_label(XEN group, XEN label)
+static Xen gxg_gtk_spin_button_get_wrap(Xen spin_button)
{
- #define H_gtk_radio_menu_item_new_with_label "GtkWidget* gtk_radio_menu_item_new_with_label(GSList* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 1, "gtk_radio_menu_item_new_with_label", "GSList*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_menu_item_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_menu_item_new_with_label(XEN_TO_C_GSList_(group), XEN_TO_C_gchar_(label))));
+ #define H_gtk_spin_button_get_wrap "gboolean gtk_spin_button_get_wrap(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_wrap", "GtkSpinButton*");
+ return(C_to_Xen_gboolean(gtk_spin_button_get_wrap(Xen_to_C_GtkSpinButton_(spin_button))));
}
-static XEN gxg_gtk_radio_menu_item_new_with_mnemonic(XEN group, XEN label)
+static Xen gxg_gtk_spin_button_set_snap_to_ticks(Xen spin_button, Xen snap_to_ticks)
{
- #define H_gtk_radio_menu_item_new_with_mnemonic "GtkWidget* gtk_radio_menu_item_new_with_mnemonic(GSList* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 1, "gtk_radio_menu_item_new_with_mnemonic", "GSList*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_menu_item_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_menu_item_new_with_mnemonic(XEN_TO_C_GSList_(group), XEN_TO_C_gchar_(label))));
+ #define H_gtk_spin_button_set_snap_to_ticks "void gtk_spin_button_set_snap_to_ticks(GtkSpinButton* spin_button, \
+gboolean snap_to_ticks)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_snap_to_ticks", "GtkSpinButton*");
+ Xen_check_type(Xen_is_gboolean(snap_to_ticks), snap_to_ticks, 2, "gtk_spin_button_set_snap_to_ticks", "gboolean");
+ gtk_spin_button_set_snap_to_ticks(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_gboolean(snap_to_ticks));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_menu_item_get_group(XEN radio_menu_item)
+static Xen gxg_gtk_spin_button_get_snap_to_ticks(Xen spin_button)
{
- #define H_gtk_radio_menu_item_get_group "GSList* gtk_radio_menu_item_get_group(GtkRadioMenuItem* radio_menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkRadioMenuItem__P(radio_menu_item), radio_menu_item, 1, "gtk_radio_menu_item_get_group", "GtkRadioMenuItem*");
- return(C_TO_XEN_GSList_(gtk_radio_menu_item_get_group(XEN_TO_C_GtkRadioMenuItem_(radio_menu_item))));
+ #define H_gtk_spin_button_get_snap_to_ticks "gboolean gtk_spin_button_get_snap_to_ticks(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_snap_to_ticks", "GtkSpinButton*");
+ return(C_to_Xen_gboolean(gtk_spin_button_get_snap_to_ticks(Xen_to_C_GtkSpinButton_(spin_button))));
}
-static XEN gxg_gtk_radio_menu_item_set_group(XEN radio_menu_item, XEN group)
+static Xen gxg_gtk_spin_button_update(Xen spin_button)
{
- #define H_gtk_radio_menu_item_set_group "void gtk_radio_menu_item_set_group(GtkRadioMenuItem* radio_menu_item, \
-GSList* group)"
- XEN_ASSERT_TYPE(XEN_GtkRadioMenuItem__P(radio_menu_item), radio_menu_item, 1, "gtk_radio_menu_item_set_group", "GtkRadioMenuItem*");
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 2, "gtk_radio_menu_item_set_group", "GSList*");
- gtk_radio_menu_item_set_group(XEN_TO_C_GtkRadioMenuItem_(radio_menu_item), XEN_TO_C_GSList_(group));
- return(XEN_FALSE);
+ #define H_gtk_spin_button_update "void gtk_spin_button_update(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_update", "GtkSpinButton*");
+ gtk_spin_button_update(Xen_to_C_GtkSpinButton_(spin_button));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_set_adjustment(XEN range, XEN adjustment)
+static Xen gxg_gtk_statusbar_new(void)
{
- #define H_gtk_range_set_adjustment "void gtk_range_set_adjustment(GtkRange* range, GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_adjustment", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment) || XEN_FALSE_P(adjustment), adjustment, 2, "gtk_range_set_adjustment", "GtkAdjustment*");
- gtk_range_set_adjustment(XEN_TO_C_GtkRange_(range), XEN_TO_C_GtkAdjustment_(adjustment));
- return(XEN_FALSE);
+ #define H_gtk_statusbar_new "GtkWidget* gtk_statusbar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_statusbar_new()));
}
-static XEN gxg_gtk_range_get_adjustment(XEN range)
+static Xen gxg_gtk_statusbar_get_context_id(Xen statusbar, Xen context_description)
{
- #define H_gtk_range_get_adjustment "GtkAdjustment* gtk_range_get_adjustment(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_adjustment", "GtkRange*");
- return(C_TO_XEN_GtkAdjustment_(gtk_range_get_adjustment(XEN_TO_C_GtkRange_(range))));
+ #define H_gtk_statusbar_get_context_id "guint gtk_statusbar_get_context_id(GtkStatusbar* statusbar, \
+gchar* context_description)"
+ Xen_check_type(Xen_is_GtkStatusbar_(statusbar), statusbar, 1, "gtk_statusbar_get_context_id", "GtkStatusbar*");
+ Xen_check_type(Xen_is_gchar_(context_description), context_description, 2, "gtk_statusbar_get_context_id", "gchar*");
+ return(C_to_Xen_guint(gtk_statusbar_get_context_id(Xen_to_C_GtkStatusbar_(statusbar), Xen_to_C_gchar_(context_description))));
}
-static XEN gxg_gtk_range_set_inverted(XEN range, XEN setting)
+static Xen gxg_gtk_statusbar_push(Xen statusbar, Xen context_id, Xen text)
{
- #define H_gtk_range_set_inverted "void gtk_range_set_inverted(GtkRange* range, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_inverted", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_range_set_inverted", "gboolean");
- gtk_range_set_inverted(XEN_TO_C_GtkRange_(range), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_statusbar_push "guint gtk_statusbar_push(GtkStatusbar* statusbar, guint context_id, gchar* text)"
+ Xen_check_type(Xen_is_GtkStatusbar_(statusbar), statusbar, 1, "gtk_statusbar_push", "GtkStatusbar*");
+ Xen_check_type(Xen_is_guint(context_id), context_id, 2, "gtk_statusbar_push", "guint");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_statusbar_push", "gchar*");
+ return(C_to_Xen_guint(gtk_statusbar_push(Xen_to_C_GtkStatusbar_(statusbar), Xen_to_C_guint(context_id), Xen_to_C_gchar_(text))));
}
-static XEN gxg_gtk_range_get_inverted(XEN range)
+static Xen gxg_gtk_statusbar_pop(Xen statusbar, Xen context_id)
{
- #define H_gtk_range_get_inverted "gboolean gtk_range_get_inverted(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_inverted", "GtkRange*");
- return(C_TO_XEN_gboolean(gtk_range_get_inverted(XEN_TO_C_GtkRange_(range))));
+ #define H_gtk_statusbar_pop "void gtk_statusbar_pop(GtkStatusbar* statusbar, guint context_id)"
+ Xen_check_type(Xen_is_GtkStatusbar_(statusbar), statusbar, 1, "gtk_statusbar_pop", "GtkStatusbar*");
+ Xen_check_type(Xen_is_guint(context_id), context_id, 2, "gtk_statusbar_pop", "guint");
+ gtk_statusbar_pop(Xen_to_C_GtkStatusbar_(statusbar), Xen_to_C_guint(context_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_set_increments(XEN range, XEN step, XEN page)
+static Xen gxg_gtk_statusbar_remove(Xen statusbar, Xen context_id, Xen message_id)
{
- #define H_gtk_range_set_increments "void gtk_range_set_increments(GtkRange* range, gdouble step, gdouble page)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_increments", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step), step, 2, "gtk_range_set_increments", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page), page, 3, "gtk_range_set_increments", "gdouble");
- gtk_range_set_increments(XEN_TO_C_GtkRange_(range), XEN_TO_C_gdouble(step), XEN_TO_C_gdouble(page));
- return(XEN_FALSE);
+ #define H_gtk_statusbar_remove "void gtk_statusbar_remove(GtkStatusbar* statusbar, guint context_id, \
+guint message_id)"
+ Xen_check_type(Xen_is_GtkStatusbar_(statusbar), statusbar, 1, "gtk_statusbar_remove", "GtkStatusbar*");
+ Xen_check_type(Xen_is_guint(context_id), context_id, 2, "gtk_statusbar_remove", "guint");
+ Xen_check_type(Xen_is_guint(message_id), message_id, 3, "gtk_statusbar_remove", "guint");
+ gtk_statusbar_remove(Xen_to_C_GtkStatusbar_(statusbar), Xen_to_C_guint(context_id), Xen_to_C_guint(message_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_set_range(XEN range, XEN min, XEN max)
+static Xen gxg_gtk_text_buffer_new(Xen table)
{
- #define H_gtk_range_set_range "void gtk_range_set_range(GtkRange* range, gdouble min, gdouble max)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_range", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(min), min, 2, "gtk_range_set_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(max), max, 3, "gtk_range_set_range", "gdouble");
- gtk_range_set_range(XEN_TO_C_GtkRange_(range), XEN_TO_C_gdouble(min), XEN_TO_C_gdouble(max));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_new "GtkTextBuffer* gtk_text_buffer_new(GtkTextTagTable* table)"
+ Xen_check_type(Xen_is_GtkTextTagTable_(table) || Xen_is_false(table), table, 1, "gtk_text_buffer_new", "GtkTextTagTable*");
+ return(C_to_Xen_GtkTextBuffer_(gtk_text_buffer_new(Xen_to_C_GtkTextTagTable_(table))));
}
-static XEN gxg_gtk_range_set_value(XEN range, XEN value)
+static Xen gxg_gtk_text_buffer_get_line_count(Xen buffer)
{
- #define H_gtk_range_set_value "void gtk_range_set_value(GtkRange* range, gdouble value)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_value", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 2, "gtk_range_set_value", "gdouble");
- gtk_range_set_value(XEN_TO_C_GtkRange_(range), XEN_TO_C_gdouble(value));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_line_count "gint gtk_text_buffer_get_line_count(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_line_count", "GtkTextBuffer*");
+ return(C_to_Xen_gint(gtk_text_buffer_get_line_count(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_range_get_value(XEN range)
+static Xen gxg_gtk_text_buffer_get_char_count(Xen buffer)
{
- #define H_gtk_range_get_value "gdouble gtk_range_get_value(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_value", "GtkRange*");
- return(C_TO_XEN_gdouble(gtk_range_get_value(XEN_TO_C_GtkRange_(range))));
+ #define H_gtk_text_buffer_get_char_count "gint gtk_text_buffer_get_char_count(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_char_count", "GtkTextBuffer*");
+ return(C_to_Xen_gint(gtk_text_buffer_get_char_count(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_scale_set_digits(XEN scale, XEN digits)
+static Xen gxg_gtk_text_buffer_get_tag_table(Xen buffer)
{
- #define H_gtk_scale_set_digits "void gtk_scale_set_digits(GtkScale* scale, gint digits)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_set_digits", "GtkScale*");
- XEN_ASSERT_TYPE(XEN_gint_P(digits), digits, 2, "gtk_scale_set_digits", "gint");
- gtk_scale_set_digits(XEN_TO_C_GtkScale_(scale), XEN_TO_C_gint(digits));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_tag_table "GtkTextTagTable* gtk_text_buffer_get_tag_table(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_tag_table", "GtkTextBuffer*");
+ return(C_to_Xen_GtkTextTagTable_(gtk_text_buffer_get_tag_table(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_scale_get_digits(XEN scale)
+static Xen gxg_gtk_text_buffer_set_text(Xen buffer, Xen text, Xen len)
{
- #define H_gtk_scale_get_digits "gint gtk_scale_get_digits(GtkScale* scale)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_get_digits", "GtkScale*");
- return(C_TO_XEN_gint(gtk_scale_get_digits(XEN_TO_C_GtkScale_(scale))));
+ #define H_gtk_text_buffer_set_text "void gtk_text_buffer_set_text(GtkTextBuffer* buffer, gchar* text, \
+gint len)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_set_text", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_text_buffer_set_text", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 3, "gtk_text_buffer_set_text", "gint");
+ gtk_text_buffer_set_text(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(text), Xen_to_C_gint(len));
+ return(Xen_false);
}
-static XEN gxg_gtk_scale_set_draw_value(XEN scale, XEN draw_value)
+static Xen gxg_gtk_text_buffer_insert(Xen buffer, Xen iter, Xen text, Xen len)
{
- #define H_gtk_scale_set_draw_value "void gtk_scale_set_draw_value(GtkScale* scale, gboolean draw_value)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_set_draw_value", "GtkScale*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(draw_value), draw_value, 2, "gtk_scale_set_draw_value", "gboolean");
- gtk_scale_set_draw_value(XEN_TO_C_GtkScale_(scale), XEN_TO_C_gboolean(draw_value));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_insert "void gtk_text_buffer_insert(GtkTextBuffer* buffer, GtkTextIter* iter, \
+gchar* text, gint len)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert", "GtkTextIter*");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_text_buffer_insert", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 4, "gtk_text_buffer_insert", "gint");
+ gtk_text_buffer_insert(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gchar_(text), Xen_to_C_gint(len));
+ return(Xen_false);
}
-static XEN gxg_gtk_scale_get_draw_value(XEN scale)
+static Xen gxg_gtk_text_buffer_insert_at_cursor(Xen buffer, Xen text, Xen len)
{
- #define H_gtk_scale_get_draw_value "gboolean gtk_scale_get_draw_value(GtkScale* scale)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_get_draw_value", "GtkScale*");
- return(C_TO_XEN_gboolean(gtk_scale_get_draw_value(XEN_TO_C_GtkScale_(scale))));
+ #define H_gtk_text_buffer_insert_at_cursor "void gtk_text_buffer_insert_at_cursor(GtkTextBuffer* buffer, \
+gchar* text, gint len)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_at_cursor", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_text_buffer_insert_at_cursor", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 3, "gtk_text_buffer_insert_at_cursor", "gint");
+ gtk_text_buffer_insert_at_cursor(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(text), Xen_to_C_gint(len));
+ return(Xen_false);
}
-static XEN gxg_gtk_scale_set_value_pos(XEN scale, XEN pos)
+static Xen gxg_gtk_text_buffer_insert_interactive(Xen buffer, Xen iter, Xen text, Xen len, Xen default_editable)
{
- #define H_gtk_scale_set_value_pos "void gtk_scale_set_value_pos(GtkScale* scale, GtkPositionType pos)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_set_value_pos", "GtkScale*");
- XEN_ASSERT_TYPE(XEN_GtkPositionType_P(pos), pos, 2, "gtk_scale_set_value_pos", "GtkPositionType");
- gtk_scale_set_value_pos(XEN_TO_C_GtkScale_(scale), XEN_TO_C_GtkPositionType(pos));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_insert_interactive "gboolean gtk_text_buffer_insert_interactive(GtkTextBuffer* buffer, \
+GtkTextIter* iter, gchar* text, gint len, gboolean default_editable)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_interactive", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert_interactive", "GtkTextIter*");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_text_buffer_insert_interactive", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 4, "gtk_text_buffer_insert_interactive", "gint");
+ Xen_check_type(Xen_is_gboolean(default_editable), default_editable, 5, "gtk_text_buffer_insert_interactive", "gboolean");
+ return(C_to_Xen_gboolean(gtk_text_buffer_insert_interactive(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter),
+ Xen_to_C_gchar_(text), Xen_to_C_gint(len), Xen_to_C_gboolean(default_editable))));
}
-static XEN gxg_gtk_scale_get_value_pos(XEN scale)
+static Xen gxg_gtk_text_buffer_insert_interactive_at_cursor(Xen buffer, Xen text, Xen len, Xen default_editable)
{
- #define H_gtk_scale_get_value_pos "GtkPositionType gtk_scale_get_value_pos(GtkScale* scale)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_get_value_pos", "GtkScale*");
- return(C_TO_XEN_GtkPositionType(gtk_scale_get_value_pos(XEN_TO_C_GtkScale_(scale))));
+ #define H_gtk_text_buffer_insert_interactive_at_cursor "gboolean gtk_text_buffer_insert_interactive_at_cursor(GtkTextBuffer* buffer, \
+gchar* text, gint len, gboolean default_editable)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_interactive_at_cursor", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_text_buffer_insert_interactive_at_cursor", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 3, "gtk_text_buffer_insert_interactive_at_cursor", "gint");
+ Xen_check_type(Xen_is_gboolean(default_editable), default_editable, 4, "gtk_text_buffer_insert_interactive_at_cursor", "gboolean");
+ return(C_to_Xen_gboolean(gtk_text_buffer_insert_interactive_at_cursor(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(text),
+ Xen_to_C_gint(len), Xen_to_C_gboolean(default_editable))));
}
-static XEN gxg_gtk_scrolled_window_new(XEN hadjustment, XEN vadjustment)
+static Xen gxg_gtk_text_buffer_insert_range(Xen buffer, Xen iter, Xen start, Xen end)
{
- #define H_gtk_scrolled_window_new "GtkWidget* gtk_scrolled_window_new(GtkAdjustment* hadjustment, GtkAdjustment* vadjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(hadjustment) || XEN_FALSE_P(hadjustment), hadjustment, 1, "gtk_scrolled_window_new", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(vadjustment) || XEN_FALSE_P(vadjustment), vadjustment, 2, "gtk_scrolled_window_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_scrolled_window_new(XEN_TO_C_GtkAdjustment_(hadjustment), XEN_TO_C_GtkAdjustment_(vadjustment))));
+ #define H_gtk_text_buffer_insert_range "void gtk_text_buffer_insert_range(GtkTextBuffer* buffer, GtkTextIter* iter, \
+GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_range", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert_range", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 3, "gtk_text_buffer_insert_range", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 4, "gtk_text_buffer_insert_range", "GtkTextIter*");
+ gtk_text_buffer_insert_range(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextIter_(start),
+ Xen_to_C_GtkTextIter_(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrolled_window_set_hadjustment(XEN scrolled_window, XEN hadjustment)
+static Xen gxg_gtk_text_buffer_insert_range_interactive(Xen buffer, Xen iter, Xen start, Xen end, Xen default_editable)
{
- #define H_gtk_scrolled_window_set_hadjustment "void gtk_scrolled_window_set_hadjustment(GtkScrolledWindow* scrolled_window, \
-GtkAdjustment* hadjustment)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_hadjustment", "GtkScrolledWindow*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(hadjustment) || XEN_FALSE_P(hadjustment), hadjustment, 2, "gtk_scrolled_window_set_hadjustment", "GtkAdjustment*");
- gtk_scrolled_window_set_hadjustment(XEN_TO_C_GtkScrolledWindow_(scrolled_window), XEN_TO_C_GtkAdjustment_(hadjustment));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_insert_range_interactive "gboolean gtk_text_buffer_insert_range_interactive(GtkTextBuffer* buffer, \
+GtkTextIter* iter, GtkTextIter* start, GtkTextIter* end, gboolean default_editable)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_range_interactive", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert_range_interactive", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 3, "gtk_text_buffer_insert_range_interactive", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 4, "gtk_text_buffer_insert_range_interactive", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(default_editable), default_editable, 5, "gtk_text_buffer_insert_range_interactive", "gboolean");
+ return(C_to_Xen_gboolean(gtk_text_buffer_insert_range_interactive(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter),
+ Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end),
+ Xen_to_C_gboolean(default_editable))));
}
-static XEN gxg_gtk_scrolled_window_set_vadjustment(XEN scrolled_window, XEN hadjustment)
+static Xen gxg_gtk_text_buffer_insert_with_tags(Xen buffer, Xen iter, Xen text, Xen len, Xen tags)
{
- #define H_gtk_scrolled_window_set_vadjustment "void gtk_scrolled_window_set_vadjustment(GtkScrolledWindow* scrolled_window, \
-GtkAdjustment* hadjustment)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_vadjustment", "GtkScrolledWindow*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(hadjustment) || XEN_FALSE_P(hadjustment), hadjustment, 2, "gtk_scrolled_window_set_vadjustment", "GtkAdjustment*");
- gtk_scrolled_window_set_vadjustment(XEN_TO_C_GtkScrolledWindow_(scrolled_window), XEN_TO_C_GtkAdjustment_(hadjustment));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_insert_with_tags "void gtk_text_buffer_insert_with_tags(GtkTextBuffer* buffer, \
+GtkTextIter* iter, gchar* text, gint len, etc tags)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_with_tags", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert_with_tags", "GtkTextIter*");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_text_buffer_insert_with_tags", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 4, "gtk_text_buffer_insert_with_tags", "gint");
+ Xen_check_type(Xen_is_etc(tags), tags, 5, "gtk_text_buffer_insert_with_tags", "etc");
+ {
+ int etc_len = 0;
+ GtkTextBuffer* p_arg0;
+ GtkTextIter* p_arg1;
+ gchar* p_arg2;
+ gint p_arg3;
+ if (Xen_is_list(tags)) etc_len = Xen_list_length(tags);
+ if (etc_len < 1) Xen_out_of_range_error("gtk_text_buffer_insert_with_tags", 4, tags, "... list must have at least 1 entry");
+ if (etc_len > 6) Xen_out_of_range_error("gtk_text_buffer_insert_with_tags", 4, tags, "... list too long (max len: 6)");
+ p_arg0 = Xen_to_C_GtkTextBuffer_(buffer);
+ p_arg1 = Xen_to_C_GtkTextIter_(iter);
+ p_arg2 = Xen_to_C_gchar_(text);
+ p_arg3 = Xen_to_C_gint(len);
+ switch (etc_len)
+ {
+ case 1: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), NULL); break;
+ case 2: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), NULL); break;
+ case 3: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), XLT(tags, 2), NULL); break;
+ case 4: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), XLT(tags, 2), XLT(tags, 3), NULL); break;
+ case 5: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), XLT(tags, 2), XLT(tags, 3), XLT(tags, 4), NULL); break;
+ case 6: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), XLT(tags, 2), XLT(tags, 3), XLT(tags, 4), XLT(tags, 5), NULL); break;
+ }
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_scrolled_window_get_hadjustment(XEN scrolled_window)
+static Xen gxg_gtk_text_buffer_insert_with_tags_by_name(Xen buffer, Xen iter, Xen text, Xen len, Xen tags)
{
- #define H_gtk_scrolled_window_get_hadjustment "GtkAdjustment* gtk_scrolled_window_get_hadjustment(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_hadjustment", "GtkScrolledWindow*");
- return(C_TO_XEN_GtkAdjustment_(gtk_scrolled_window_get_hadjustment(XEN_TO_C_GtkScrolledWindow_(scrolled_window))));
+ #define H_gtk_text_buffer_insert_with_tags_by_name "void gtk_text_buffer_insert_with_tags_by_name(GtkTextBuffer* buffer, \
+GtkTextIter* iter, gchar* text, gint len, etc tags)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_with_tags_by_name", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert_with_tags_by_name", "GtkTextIter*");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_text_buffer_insert_with_tags_by_name", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 4, "gtk_text_buffer_insert_with_tags_by_name", "gint");
+ Xen_check_type(Xen_is_etc(tags), tags, 5, "gtk_text_buffer_insert_with_tags_by_name", "etc");
+ {
+ int etc_len = 0;
+ GtkTextBuffer* p_arg0;
+ GtkTextIter* p_arg1;
+ gchar* p_arg2;
+ gint p_arg3;
+ if (Xen_is_list(tags)) etc_len = Xen_list_length(tags);
+ if (etc_len < 1) Xen_out_of_range_error("gtk_text_buffer_insert_with_tags_by_name", 4, tags, "... list must have at least 1 entry");
+ if (etc_len > 6) Xen_out_of_range_error("gtk_text_buffer_insert_with_tags_by_name", 4, tags, "... list too long (max len: 6)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_text_buffer_insert_with_tags_by_name", 4, tags, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_GtkTextBuffer_(buffer);
+ p_arg1 = Xen_to_C_GtkTextIter_(iter);
+ p_arg2 = Xen_to_C_gchar_(text);
+ p_arg3 = Xen_to_C_gint(len);
+ switch (etc_len)
+ {
+ case 1: gtk_text_buffer_insert_with_tags_by_name(p_arg0, p_arg1, p_arg2, p_arg3, XLS(tags, 0), NULL); break;
+ case 3: gtk_text_buffer_insert_with_tags_by_name(p_arg0, p_arg1, p_arg2, p_arg3, XLS(tags, 0), XLI(tags, 1), XLS(tags, 2), NULL); break;
+ case 5: gtk_text_buffer_insert_with_tags_by_name(p_arg0, p_arg1, p_arg2, p_arg3, XLS(tags, 0), XLI(tags, 1), XLS(tags, 2), XLI(tags, 3), XLS(tags, 4), NULL); break;
+ }
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_scrolled_window_get_vadjustment(XEN scrolled_window)
+static Xen gxg_gtk_text_buffer_delete(Xen buffer, Xen start, Xen end)
{
- #define H_gtk_scrolled_window_get_vadjustment "GtkAdjustment* gtk_scrolled_window_get_vadjustment(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_vadjustment", "GtkScrolledWindow*");
- return(C_TO_XEN_GtkAdjustment_(gtk_scrolled_window_get_vadjustment(XEN_TO_C_GtkScrolledWindow_(scrolled_window))));
+ #define H_gtk_text_buffer_delete "void gtk_text_buffer_delete(GtkTextBuffer* buffer, GtkTextIter* start, \
+GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_delete", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 2, "gtk_text_buffer_delete", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 3, "gtk_text_buffer_delete", "GtkTextIter*");
+ gtk_text_buffer_delete(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrolled_window_set_policy(XEN scrolled_window, XEN hscrollbar_policy, XEN vscrollbar_policy)
+static Xen gxg_gtk_text_buffer_delete_interactive(Xen buffer, Xen start_iter, Xen end_iter, Xen default_editable)
{
- #define H_gtk_scrolled_window_set_policy "void gtk_scrolled_window_set_policy(GtkScrolledWindow* scrolled_window, \
-GtkPolicyType hscrollbar_policy, GtkPolicyType vscrollbar_policy)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_policy", "GtkScrolledWindow*");
- XEN_ASSERT_TYPE(XEN_GtkPolicyType_P(hscrollbar_policy), hscrollbar_policy, 2, "gtk_scrolled_window_set_policy", "GtkPolicyType");
- XEN_ASSERT_TYPE(XEN_GtkPolicyType_P(vscrollbar_policy), vscrollbar_policy, 3, "gtk_scrolled_window_set_policy", "GtkPolicyType");
- gtk_scrolled_window_set_policy(XEN_TO_C_GtkScrolledWindow_(scrolled_window), XEN_TO_C_GtkPolicyType(hscrollbar_policy),
- XEN_TO_C_GtkPolicyType(vscrollbar_policy));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_delete_interactive "gboolean gtk_text_buffer_delete_interactive(GtkTextBuffer* buffer, \
+GtkTextIter* start_iter, GtkTextIter* end_iter, gboolean default_editable)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_delete_interactive", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(start_iter), start_iter, 2, "gtk_text_buffer_delete_interactive", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end_iter), end_iter, 3, "gtk_text_buffer_delete_interactive", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(default_editable), default_editable, 4, "gtk_text_buffer_delete_interactive", "gboolean");
+ return(C_to_Xen_gboolean(gtk_text_buffer_delete_interactive(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(start_iter),
+ Xen_to_C_GtkTextIter_(end_iter), Xen_to_C_gboolean(default_editable))));
}
-static XEN gxg_gtk_scrolled_window_get_policy(XEN scrolled_window, XEN ignore_hscrollbar_policy, XEN ignore_vscrollbar_policy)
+static Xen gxg_gtk_text_buffer_get_text(Xen buffer, Xen start, Xen end, Xen include_hidden_chars)
{
- #define H_gtk_scrolled_window_get_policy "void gtk_scrolled_window_get_policy(GtkScrolledWindow* scrolled_window, \
-GtkPolicyType* [hscrollbar_policy], GtkPolicyType* [vscrollbar_policy])"
- GtkPolicyType ref_hscrollbar_policy;
- GtkPolicyType ref_vscrollbar_policy;
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_policy", "GtkScrolledWindow*");
- gtk_scrolled_window_get_policy(XEN_TO_C_GtkScrolledWindow_(scrolled_window), &ref_hscrollbar_policy, &ref_vscrollbar_policy);
- return(XEN_LIST_2(C_TO_XEN_GtkPolicyType(ref_hscrollbar_policy), C_TO_XEN_GtkPolicyType(ref_vscrollbar_policy)));
+ #define H_gtk_text_buffer_get_text "gchar* gtk_text_buffer_get_text(GtkTextBuffer* buffer, GtkTextIter* start, \
+GtkTextIter* end, gboolean include_hidden_chars)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_text", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 2, "gtk_text_buffer_get_text", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 3, "gtk_text_buffer_get_text", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(include_hidden_chars), include_hidden_chars, 4, "gtk_text_buffer_get_text", "gboolean");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_text_buffer_get_text(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(start),
+ Xen_to_C_GtkTextIter_(end), Xen_to_C_gboolean(include_hidden_chars));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_scrolled_window_set_placement(XEN scrolled_window, XEN window_placement)
+static Xen gxg_gtk_text_buffer_get_slice(Xen buffer, Xen start, Xen end, Xen include_hidden_chars)
{
- #define H_gtk_scrolled_window_set_placement "void gtk_scrolled_window_set_placement(GtkScrolledWindow* scrolled_window, \
-GtkCornerType window_placement)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_placement", "GtkScrolledWindow*");
- XEN_ASSERT_TYPE(XEN_GtkCornerType_P(window_placement), window_placement, 2, "gtk_scrolled_window_set_placement", "GtkCornerType");
- gtk_scrolled_window_set_placement(XEN_TO_C_GtkScrolledWindow_(scrolled_window), XEN_TO_C_GtkCornerType(window_placement));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_slice "gchar* gtk_text_buffer_get_slice(GtkTextBuffer* buffer, GtkTextIter* start, \
+GtkTextIter* end, gboolean include_hidden_chars)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_slice", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 2, "gtk_text_buffer_get_slice", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 3, "gtk_text_buffer_get_slice", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(include_hidden_chars), include_hidden_chars, 4, "gtk_text_buffer_get_slice", "gboolean");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_text_buffer_get_slice(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(start),
+ Xen_to_C_GtkTextIter_(end), Xen_to_C_gboolean(include_hidden_chars));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_scrolled_window_get_placement(XEN scrolled_window)
+static Xen gxg_gtk_text_buffer_insert_pixbuf(Xen buffer, Xen iter, Xen pixbuf)
{
- #define H_gtk_scrolled_window_get_placement "GtkCornerType gtk_scrolled_window_get_placement(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_placement", "GtkScrolledWindow*");
- return(C_TO_XEN_GtkCornerType(gtk_scrolled_window_get_placement(XEN_TO_C_GtkScrolledWindow_(scrolled_window))));
+ #define H_gtk_text_buffer_insert_pixbuf "void gtk_text_buffer_insert_pixbuf(GtkTextBuffer* buffer, \
+GtkTextIter* iter, GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_pixbuf", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert_pixbuf", "GtkTextIter*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 3, "gtk_text_buffer_insert_pixbuf", "GdkPixbuf*");
+ gtk_text_buffer_insert_pixbuf(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_GdkPixbuf_(pixbuf));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrolled_window_set_shadow_type(XEN scrolled_window, XEN type)
+static Xen gxg_gtk_text_buffer_insert_child_anchor(Xen buffer, Xen iter, Xen anchor)
{
- #define H_gtk_scrolled_window_set_shadow_type "void gtk_scrolled_window_set_shadow_type(GtkScrolledWindow* scrolled_window, \
-GtkShadowType type)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_shadow_type", "GtkScrolledWindow*");
- XEN_ASSERT_TYPE(XEN_GtkShadowType_P(type), type, 2, "gtk_scrolled_window_set_shadow_type", "GtkShadowType");
- gtk_scrolled_window_set_shadow_type(XEN_TO_C_GtkScrolledWindow_(scrolled_window), XEN_TO_C_GtkShadowType(type));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_insert_child_anchor "void gtk_text_buffer_insert_child_anchor(GtkTextBuffer* buffer, \
+GtkTextIter* iter, GtkTextChildAnchor* anchor)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_child_anchor", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert_child_anchor", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextChildAnchor_(anchor), anchor, 3, "gtk_text_buffer_insert_child_anchor", "GtkTextChildAnchor*");
+ gtk_text_buffer_insert_child_anchor(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextChildAnchor_(anchor));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrolled_window_get_shadow_type(XEN scrolled_window)
+static Xen gxg_gtk_text_buffer_create_child_anchor(Xen buffer, Xen iter)
{
- #define H_gtk_scrolled_window_get_shadow_type "GtkShadowType gtk_scrolled_window_get_shadow_type(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_shadow_type", "GtkScrolledWindow*");
- return(C_TO_XEN_GtkShadowType(gtk_scrolled_window_get_shadow_type(XEN_TO_C_GtkScrolledWindow_(scrolled_window))));
+ #define H_gtk_text_buffer_create_child_anchor "GtkTextChildAnchor* gtk_text_buffer_create_child_anchor(GtkTextBuffer* buffer, \
+GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_create_child_anchor", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_create_child_anchor", "GtkTextIter*");
+ return(C_to_Xen_GtkTextChildAnchor_(gtk_text_buffer_create_child_anchor(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_scrolled_window_add_with_viewport(XEN scrolled_window, XEN child)
+static Xen gxg_gtk_text_buffer_create_mark(Xen buffer, Xen mark_name, Xen where, Xen left_gravity)
{
- #define H_gtk_scrolled_window_add_with_viewport "void gtk_scrolled_window_add_with_viewport(GtkScrolledWindow* scrolled_window, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_add_with_viewport", "GtkScrolledWindow*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_scrolled_window_add_with_viewport", "GtkWidget*");
- gtk_scrolled_window_add_with_viewport(XEN_TO_C_GtkScrolledWindow_(scrolled_window), XEN_TO_C_GtkWidget_(child));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_create_mark "GtkTextMark* gtk_text_buffer_create_mark(GtkTextBuffer* buffer, \
+gchar* mark_name, GtkTextIter* where, gboolean left_gravity)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_create_mark", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(mark_name), mark_name, 2, "gtk_text_buffer_create_mark", "gchar*");
+ Xen_check_type(Xen_is_GtkTextIter_(where), where, 3, "gtk_text_buffer_create_mark", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(left_gravity), left_gravity, 4, "gtk_text_buffer_create_mark", "gboolean");
+ return(C_to_Xen_GtkTextMark_(gtk_text_buffer_create_mark(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(mark_name), Xen_to_C_GtkTextIter_(where),
+ Xen_to_C_gboolean(left_gravity))));
}
-static XEN gxg_gtk_target_list_new(XEN targets, XEN ntargets)
+static Xen gxg_gtk_text_buffer_move_mark(Xen buffer, Xen mark, Xen where)
{
- #define H_gtk_target_list_new "GtkTargetList* gtk_target_list_new(GtkTargetEntry* targets, guint ntargets)"
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets) || XEN_FALSE_P(targets), targets, 1, "gtk_target_list_new", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_guint_P(ntargets), ntargets, 2, "gtk_target_list_new", "guint");
- return(C_TO_XEN_GtkTargetList_(gtk_target_list_new(XEN_TO_C_GtkTargetEntry_(targets), XEN_TO_C_guint(ntargets))));
+ #define H_gtk_text_buffer_move_mark "void gtk_text_buffer_move_mark(GtkTextBuffer* buffer, GtkTextMark* mark, \
+GtkTextIter* where)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_move_mark", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 2, "gtk_text_buffer_move_mark", "GtkTextMark*");
+ Xen_check_type(Xen_is_GtkTextIter_(where), where, 3, "gtk_text_buffer_move_mark", "GtkTextIter*");
+ gtk_text_buffer_move_mark(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextMark_(mark), Xen_to_C_GtkTextIter_(where));
+ return(Xen_false);
}
-static XEN gxg_gtk_target_list_unref(XEN list)
+static Xen gxg_gtk_text_buffer_delete_mark(Xen buffer, Xen mark)
{
- #define H_gtk_target_list_unref "void gtk_target_list_unref(GtkTargetList* list)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_unref", "GtkTargetList*");
- gtk_target_list_unref(XEN_TO_C_GtkTargetList_(list));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_delete_mark "void gtk_text_buffer_delete_mark(GtkTextBuffer* buffer, GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_delete_mark", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 2, "gtk_text_buffer_delete_mark", "GtkTextMark*");
+ gtk_text_buffer_delete_mark(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextMark_(mark));
+ return(Xen_false);
}
-static XEN gxg_gtk_target_list_add(XEN list, XEN target, XEN flags, XEN info)
+static Xen gxg_gtk_text_buffer_get_mark(Xen buffer, Xen name)
{
- #define H_gtk_target_list_add "void gtk_target_list_add(GtkTargetList* list, GdkAtom target, guint flags, \
-guint info)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_add", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 2, "gtk_target_list_add", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint_P(flags), flags, 3, "gtk_target_list_add", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(info), info, 4, "gtk_target_list_add", "guint");
- gtk_target_list_add(XEN_TO_C_GtkTargetList_(list), XEN_TO_C_GdkAtom(target), XEN_TO_C_guint(flags), XEN_TO_C_guint(info));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_mark "GtkTextMark* gtk_text_buffer_get_mark(GtkTextBuffer* buffer, gchar* name)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_mark", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_text_buffer_get_mark", "gchar*");
+ return(C_to_Xen_GtkTextMark_(gtk_text_buffer_get_mark(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(name))));
}
-static XEN gxg_gtk_target_list_add_table(XEN list, XEN targets, XEN ntargets)
+static Xen gxg_gtk_text_buffer_move_mark_by_name(Xen buffer, Xen name, Xen where)
{
- #define H_gtk_target_list_add_table "void gtk_target_list_add_table(GtkTargetList* list, GtkTargetEntry* targets, \
-guint ntargets)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_add_table", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 2, "gtk_target_list_add_table", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_guint_P(ntargets), ntargets, 3, "gtk_target_list_add_table", "guint");
- gtk_target_list_add_table(XEN_TO_C_GtkTargetList_(list), XEN_TO_C_GtkTargetEntry_(targets), XEN_TO_C_guint(ntargets));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_move_mark_by_name "void gtk_text_buffer_move_mark_by_name(GtkTextBuffer* buffer, \
+gchar* name, GtkTextIter* where)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_move_mark_by_name", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_text_buffer_move_mark_by_name", "gchar*");
+ Xen_check_type(Xen_is_GtkTextIter_(where), where, 3, "gtk_text_buffer_move_mark_by_name", "GtkTextIter*");
+ gtk_text_buffer_move_mark_by_name(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(name), Xen_to_C_GtkTextIter_(where));
+ return(Xen_false);
}
-static XEN gxg_gtk_target_list_remove(XEN list, XEN target)
+static Xen gxg_gtk_text_buffer_delete_mark_by_name(Xen buffer, Xen name)
{
- #define H_gtk_target_list_remove "void gtk_target_list_remove(GtkTargetList* list, GdkAtom target)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_remove", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 2, "gtk_target_list_remove", "GdkAtom");
- gtk_target_list_remove(XEN_TO_C_GtkTargetList_(list), XEN_TO_C_GdkAtom(target));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_delete_mark_by_name "void gtk_text_buffer_delete_mark_by_name(GtkTextBuffer* buffer, \
+gchar* name)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_delete_mark_by_name", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_text_buffer_delete_mark_by_name", "gchar*");
+ gtk_text_buffer_delete_mark_by_name(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_target_list_find(XEN list, XEN target, XEN ignore_info)
+static Xen gxg_gtk_text_buffer_get_insert(Xen buffer)
{
- #define H_gtk_target_list_find "gboolean gtk_target_list_find(GtkTargetList* list, GdkAtom target, \
-guint* [info])"
- guint ref_info;
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_find", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 2, "gtk_target_list_find", "GdkAtom");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_target_list_find(XEN_TO_C_GtkTargetList_(list), XEN_TO_C_GdkAtom(target), &ref_info));
- return(XEN_LIST_2(result, C_TO_XEN_guint(ref_info)));
- }
+ #define H_gtk_text_buffer_get_insert "GtkTextMark* gtk_text_buffer_get_insert(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_insert", "GtkTextBuffer*");
+ return(C_to_Xen_GtkTextMark_(gtk_text_buffer_get_insert(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_selection_owner_set(XEN widget, XEN selection, XEN time)
+static Xen gxg_gtk_text_buffer_get_selection_bound(Xen buffer)
{
- #define H_gtk_selection_owner_set "gboolean gtk_selection_owner_set(GtkWidget* widget, GdkAtom selection, \
-guint32 time)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget) || XEN_FALSE_P(widget), widget, 1, "gtk_selection_owner_set", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gtk_selection_owner_set", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 3, "gtk_selection_owner_set", "guint32");
- return(C_TO_XEN_gboolean(gtk_selection_owner_set(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkAtom(selection), XEN_TO_C_guint32(time))));
+ #define H_gtk_text_buffer_get_selection_bound "GtkTextMark* gtk_text_buffer_get_selection_bound(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_selection_bound", "GtkTextBuffer*");
+ return(C_to_Xen_GtkTextMark_(gtk_text_buffer_get_selection_bound(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_selection_add_target(XEN widget, XEN selection, XEN target, XEN info)
+static Xen gxg_gtk_text_buffer_place_cursor(Xen buffer, Xen where)
{
- #define H_gtk_selection_add_target "void gtk_selection_add_target(GtkWidget* widget, GdkAtom selection, \
-GdkAtom target, guint info)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_selection_add_target", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gtk_selection_add_target", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 3, "gtk_selection_add_target", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint_P(info), info, 4, "gtk_selection_add_target", "guint");
- gtk_selection_add_target(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkAtom(selection), XEN_TO_C_GdkAtom(target), XEN_TO_C_guint(info));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_place_cursor "void gtk_text_buffer_place_cursor(GtkTextBuffer* buffer, GtkTextIter* where)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_place_cursor", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(where), where, 2, "gtk_text_buffer_place_cursor", "GtkTextIter*");
+ gtk_text_buffer_place_cursor(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(where));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_add_targets(XEN widget, XEN selection, XEN targets, XEN ntargets)
+static Xen gxg_gtk_text_buffer_apply_tag(Xen buffer, Xen tag, Xen start, Xen end)
{
- #define H_gtk_selection_add_targets "void gtk_selection_add_targets(GtkWidget* widget, GdkAtom selection, \
-GtkTargetEntry* targets, guint ntargets)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_selection_add_targets", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gtk_selection_add_targets", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 3, "gtk_selection_add_targets", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_guint_P(ntargets), ntargets, 4, "gtk_selection_add_targets", "guint");
- gtk_selection_add_targets(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkAtom(selection), XEN_TO_C_GtkTargetEntry_(targets),
- XEN_TO_C_guint(ntargets));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_apply_tag "void gtk_text_buffer_apply_tag(GtkTextBuffer* buffer, GtkTextTag* tag, \
+GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_apply_tag", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 2, "gtk_text_buffer_apply_tag", "GtkTextTag*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 3, "gtk_text_buffer_apply_tag", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 4, "gtk_text_buffer_apply_tag", "GtkTextIter*");
+ gtk_text_buffer_apply_tag(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextTag_(tag), Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_clear_targets(XEN widget, XEN selection)
+static Xen gxg_gtk_text_buffer_remove_tag(Xen buffer, Xen tag, Xen start, Xen end)
{
- #define H_gtk_selection_clear_targets "void gtk_selection_clear_targets(GtkWidget* widget, GdkAtom selection)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_selection_clear_targets", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gtk_selection_clear_targets", "GdkAtom");
- gtk_selection_clear_targets(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkAtom(selection));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_remove_tag "void gtk_text_buffer_remove_tag(GtkTextBuffer* buffer, GtkTextTag* tag, \
+GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_remove_tag", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 2, "gtk_text_buffer_remove_tag", "GtkTextTag*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 3, "gtk_text_buffer_remove_tag", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 4, "gtk_text_buffer_remove_tag", "GtkTextIter*");
+ gtk_text_buffer_remove_tag(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextTag_(tag), Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_convert(XEN widget, XEN selection, XEN target, XEN time)
+static Xen gxg_gtk_text_buffer_apply_tag_by_name(Xen buffer, Xen name, Xen start, Xen end)
{
- #define H_gtk_selection_convert "gboolean gtk_selection_convert(GtkWidget* widget, GdkAtom selection, \
-GdkAtom target, guint32 time)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_selection_convert", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gtk_selection_convert", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 3, "gtk_selection_convert", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 4, "gtk_selection_convert", "guint32");
- return(C_TO_XEN_gboolean(gtk_selection_convert(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkAtom(selection), XEN_TO_C_GdkAtom(target),
- XEN_TO_C_guint32(time))));
+ #define H_gtk_text_buffer_apply_tag_by_name "void gtk_text_buffer_apply_tag_by_name(GtkTextBuffer* buffer, \
+gchar* name, GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_apply_tag_by_name", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_text_buffer_apply_tag_by_name", "gchar*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 3, "gtk_text_buffer_apply_tag_by_name", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 4, "gtk_text_buffer_apply_tag_by_name", "GtkTextIter*");
+ gtk_text_buffer_apply_tag_by_name(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(name), Xen_to_C_GtkTextIter_(start),
+ Xen_to_C_GtkTextIter_(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_set(XEN selection_data, XEN type, XEN format, XEN data, XEN length)
+static Xen gxg_gtk_text_buffer_remove_tag_by_name(Xen buffer, Xen name, Xen start, Xen end)
{
- #define H_gtk_selection_data_set "void gtk_selection_data_set(GtkSelectionData* selection_data, GdkAtom type, \
-gint format, guchar* data, gint length)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_set", "GtkSelectionData*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(type), type, 2, "gtk_selection_data_set", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_gint_P(format), format, 3, "gtk_selection_data_set", "gint");
- XEN_ASSERT_TYPE(XEN_guchar__P(data), data, 4, "gtk_selection_data_set", "guchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(length), length, 5, "gtk_selection_data_set", "gint");
- gtk_selection_data_set(XEN_TO_C_GtkSelectionData_(selection_data), XEN_TO_C_GdkAtom(type), XEN_TO_C_gint(format), XEN_TO_C_guchar_(data),
- XEN_TO_C_gint(length));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_remove_tag_by_name "void gtk_text_buffer_remove_tag_by_name(GtkTextBuffer* buffer, \
+gchar* name, GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_remove_tag_by_name", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_text_buffer_remove_tag_by_name", "gchar*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 3, "gtk_text_buffer_remove_tag_by_name", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 4, "gtk_text_buffer_remove_tag_by_name", "GtkTextIter*");
+ gtk_text_buffer_remove_tag_by_name(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(name), Xen_to_C_GtkTextIter_(start),
+ Xen_to_C_GtkTextIter_(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_set_text(XEN selection_data, XEN str, XEN len)
+static Xen gxg_gtk_text_buffer_remove_all_tags(Xen buffer, Xen start, Xen end)
{
- #define H_gtk_selection_data_set_text "gboolean gtk_selection_data_set_text(GtkSelectionData* selection_data, \
-gchar* str, gint len)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_set_text", "GtkSelectionData*");
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 2, "gtk_selection_data_set_text", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 3, "gtk_selection_data_set_text", "gint");
- return(C_TO_XEN_gboolean(gtk_selection_data_set_text(XEN_TO_C_GtkSelectionData_(selection_data), XEN_TO_C_gchar_(str),
- XEN_TO_C_gint(len))));
+ #define H_gtk_text_buffer_remove_all_tags "void gtk_text_buffer_remove_all_tags(GtkTextBuffer* buffer, \
+GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_remove_all_tags", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 2, "gtk_text_buffer_remove_all_tags", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 3, "gtk_text_buffer_remove_all_tags", "GtkTextIter*");
+ gtk_text_buffer_remove_all_tags(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_get_text(XEN selection_data)
+static Xen gxg_gtk_text_buffer_create_tag(Xen buffer, Xen tag_name, Xen tags)
{
- #define H_gtk_selection_data_get_text "guchar* gtk_selection_data_get_text(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_text", "GtkSelectionData*");
+ #define H_gtk_text_buffer_create_tag "GtkTextTag* gtk_text_buffer_create_tag(GtkTextBuffer* buffer, \
+gchar* tag_name, etc tags)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_create_tag", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(tag_name), tag_name, 2, "gtk_text_buffer_create_tag", "gchar*");
+ if (!Xen_is_bound(tags)) tags = Xen_false;
+ else Xen_check_type(Xen_is_etc(tags), tags, 3, "gtk_text_buffer_create_tag", "etc");
{
- guchar* result;
- XEN rtn;
- result = gtk_selection_data_get_text(XEN_TO_C_GtkSelectionData_(selection_data));
- rtn = C_TO_XEN_guchar_(result);
- g_free(result);
- return(rtn);
+ int etc_len = 0;
+ GtkTextTag* result = NULL;
+ GtkTextBuffer* p_arg0;
+ gchar* p_arg1;
+ if (Xen_is_list(tags)) etc_len = Xen_list_length(tags);
+ if (etc_len > 6) Xen_out_of_range_error("gtk_text_buffer_create_tag", 2, tags, "... list too long (max len: 6)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_text_buffer_create_tag", 2, tags, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_GtkTextBuffer_(buffer);
+ p_arg1 = Xen_to_C_gchar_(tag_name);
+ switch (etc_len)
+ {
+ case 0: result = gtk_text_buffer_create_tag(p_arg0, p_arg1, NULL); break;
+ case 2: result = gtk_text_buffer_create_tag(p_arg0, p_arg1, XLS(tags, 0), XLA(tags, 1), NULL); break;
+ case 4: result = gtk_text_buffer_create_tag(p_arg0, p_arg1, XLS(tags, 0), XLA(tags, 1), XLS(tags, 2), XLA(tags, 3), NULL); break;
+ case 6: result = gtk_text_buffer_create_tag(p_arg0, p_arg1, XLS(tags, 0), XLA(tags, 1), XLS(tags, 2), XLA(tags, 3), XLS(tags, 4), XLA(tags, 5), NULL); break;
+ }
+ return(C_to_Xen_GtkTextTag_(result));
}
}
-static XEN gxg_gtk_selection_data_get_targets(XEN selection_data, XEN ignore_targets, XEN ignore_n_atoms)
+static Xen gxg_gtk_text_buffer_get_iter_at_line_offset(Xen buffer, Xen iter, Xen line_number, Xen char_offset)
{
- #define H_gtk_selection_data_get_targets "gboolean gtk_selection_data_get_targets(GtkSelectionData* selection_data, \
-GdkAtom** [targets], gint* [n_atoms])"
- GdkAtom* ref_targets = NULL;
- gint ref_n_atoms;
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_targets", "GtkSelectionData*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_selection_data_get_targets(XEN_TO_C_GtkSelectionData_(selection_data), &ref_targets, &ref_n_atoms));
- return(XEN_LIST_3(result, C_TO_XEN_GdkAtom_(ref_targets), C_TO_XEN_gint(ref_n_atoms)));
- }
+ #define H_gtk_text_buffer_get_iter_at_line_offset "void gtk_text_buffer_get_iter_at_line_offset(GtkTextBuffer* buffer, \
+GtkTextIter* iter, gint line_number, gint char_offset)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_line_offset", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_get_iter_at_line_offset", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(line_number), line_number, 3, "gtk_text_buffer_get_iter_at_line_offset", "gint");
+ Xen_check_type(Xen_is_gint(char_offset), char_offset, 4, "gtk_text_buffer_get_iter_at_line_offset", "gint");
+ gtk_text_buffer_get_iter_at_line_offset(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(line_number),
+ Xen_to_C_gint(char_offset));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_targets_include_text(XEN selection_data)
+static Xen gxg_gtk_text_buffer_get_iter_at_line_index(Xen buffer, Xen iter, Xen line_number, Xen byte_index)
{
- #define H_gtk_selection_data_targets_include_text "gboolean gtk_selection_data_targets_include_text(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_targets_include_text", "GtkSelectionData*");
- return(C_TO_XEN_gboolean(gtk_selection_data_targets_include_text(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_text_buffer_get_iter_at_line_index "void gtk_text_buffer_get_iter_at_line_index(GtkTextBuffer* buffer, \
+GtkTextIter* iter, gint line_number, gint byte_index)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_line_index", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_get_iter_at_line_index", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(line_number), line_number, 3, "gtk_text_buffer_get_iter_at_line_index", "gint");
+ Xen_check_type(Xen_is_gint(byte_index), byte_index, 4, "gtk_text_buffer_get_iter_at_line_index", "gint");
+ gtk_text_buffer_get_iter_at_line_index(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(line_number),
+ Xen_to_C_gint(byte_index));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_remove_all(XEN widget)
+static Xen gxg_gtk_text_buffer_get_iter_at_offset(Xen buffer, Xen iter, Xen char_offset)
{
- #define H_gtk_selection_remove_all "void gtk_selection_remove_all(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_selection_remove_all", "GtkWidget*");
- gtk_selection_remove_all(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_iter_at_offset "void gtk_text_buffer_get_iter_at_offset(GtkTextBuffer* buffer, \
+GtkTextIter* iter, gint char_offset)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_offset", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_get_iter_at_offset", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(char_offset), char_offset, 3, "gtk_text_buffer_get_iter_at_offset", "gint");
+ gtk_text_buffer_get_iter_at_offset(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(char_offset));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_copy(XEN data)
+static Xen gxg_gtk_text_buffer_get_iter_at_line(Xen buffer, Xen iter, Xen line_number)
{
- #define H_gtk_selection_data_copy "GtkSelectionData* gtk_selection_data_copy(GtkSelectionData* data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(data), data, 1, "gtk_selection_data_copy", "GtkSelectionData*");
- return(C_TO_XEN_GtkSelectionData_(gtk_selection_data_copy(XEN_TO_C_GtkSelectionData_(data))));
+ #define H_gtk_text_buffer_get_iter_at_line "void gtk_text_buffer_get_iter_at_line(GtkTextBuffer* buffer, \
+GtkTextIter* iter, gint line_number)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_line", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_get_iter_at_line", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(line_number), line_number, 3, "gtk_text_buffer_get_iter_at_line", "gint");
+ gtk_text_buffer_get_iter_at_line(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(line_number));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_free(XEN data)
+static Xen gxg_gtk_text_buffer_get_start_iter(Xen buffer, Xen iter)
{
- #define H_gtk_selection_data_free "void gtk_selection_data_free(GtkSelectionData* data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(data), data, 1, "gtk_selection_data_free", "GtkSelectionData*");
- gtk_selection_data_free(XEN_TO_C_GtkSelectionData_(data));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_start_iter "void gtk_text_buffer_get_start_iter(GtkTextBuffer* buffer, \
+GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_start_iter", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_get_start_iter", "GtkTextIter*");
+ gtk_text_buffer_get_start_iter(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_separator_menu_item_new(void)
+static Xen gxg_gtk_text_buffer_get_end_iter(Xen buffer, Xen iter)
{
- #define H_gtk_separator_menu_item_new "GtkWidget* gtk_separator_menu_item_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_separator_menu_item_new()));
+ #define H_gtk_text_buffer_get_end_iter "void gtk_text_buffer_get_end_iter(GtkTextBuffer* buffer, GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_end_iter", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_get_end_iter", "GtkTextIter*");
+ gtk_text_buffer_get_end_iter(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_size_group_new(XEN mode)
+static Xen gxg_gtk_text_buffer_get_bounds(Xen buffer, Xen start, Xen end)
{
- #define H_gtk_size_group_new "GtkSizeGroup* gtk_size_group_new(GtkSizeGroupMode mode)"
- XEN_ASSERT_TYPE(XEN_GtkSizeGroupMode_P(mode), mode, 1, "gtk_size_group_new", "GtkSizeGroupMode");
- return(C_TO_XEN_GtkSizeGroup_(gtk_size_group_new(XEN_TO_C_GtkSizeGroupMode(mode))));
+ #define H_gtk_text_buffer_get_bounds "void gtk_text_buffer_get_bounds(GtkTextBuffer* buffer, GtkTextIter* start, \
+GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_bounds", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 2, "gtk_text_buffer_get_bounds", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 3, "gtk_text_buffer_get_bounds", "GtkTextIter*");
+ gtk_text_buffer_get_bounds(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ return(Xen_false);
}
-static XEN gxg_gtk_size_group_set_mode(XEN size_group, XEN mode)
+static Xen gxg_gtk_text_buffer_get_iter_at_mark(Xen buffer, Xen iter, Xen mark)
{
- #define H_gtk_size_group_set_mode "void gtk_size_group_set_mode(GtkSizeGroup* size_group, GtkSizeGroupMode mode)"
- XEN_ASSERT_TYPE(XEN_GtkSizeGroup__P(size_group), size_group, 1, "gtk_size_group_set_mode", "GtkSizeGroup*");
- XEN_ASSERT_TYPE(XEN_GtkSizeGroupMode_P(mode), mode, 2, "gtk_size_group_set_mode", "GtkSizeGroupMode");
- gtk_size_group_set_mode(XEN_TO_C_GtkSizeGroup_(size_group), XEN_TO_C_GtkSizeGroupMode(mode));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_iter_at_mark "void gtk_text_buffer_get_iter_at_mark(GtkTextBuffer* buffer, \
+GtkTextIter* iter, GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_mark", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_get_iter_at_mark", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 3, "gtk_text_buffer_get_iter_at_mark", "GtkTextMark*");
+ gtk_text_buffer_get_iter_at_mark(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextMark_(mark));
+ return(Xen_false);
}
-static XEN gxg_gtk_size_group_get_mode(XEN size_group)
+static Xen gxg_gtk_text_buffer_get_iter_at_child_anchor(Xen buffer, Xen iter, Xen anchor)
{
- #define H_gtk_size_group_get_mode "GtkSizeGroupMode gtk_size_group_get_mode(GtkSizeGroup* size_group)"
- XEN_ASSERT_TYPE(XEN_GtkSizeGroup__P(size_group), size_group, 1, "gtk_size_group_get_mode", "GtkSizeGroup*");
- return(C_TO_XEN_GtkSizeGroupMode(gtk_size_group_get_mode(XEN_TO_C_GtkSizeGroup_(size_group))));
+ #define H_gtk_text_buffer_get_iter_at_child_anchor "void gtk_text_buffer_get_iter_at_child_anchor(GtkTextBuffer* buffer, \
+GtkTextIter* iter, GtkTextChildAnchor* anchor)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_child_anchor", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_get_iter_at_child_anchor", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextChildAnchor_(anchor), anchor, 3, "gtk_text_buffer_get_iter_at_child_anchor", "GtkTextChildAnchor*");
+ gtk_text_buffer_get_iter_at_child_anchor(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextChildAnchor_(anchor));
+ return(Xen_false);
}
-static XEN gxg_gtk_size_group_add_widget(XEN size_group, XEN widget)
+static Xen gxg_gtk_text_buffer_get_modified(Xen buffer)
{
- #define H_gtk_size_group_add_widget "void gtk_size_group_add_widget(GtkSizeGroup* size_group, GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkSizeGroup__P(size_group), size_group, 1, "gtk_size_group_add_widget", "GtkSizeGroup*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_size_group_add_widget", "GtkWidget*");
- gtk_size_group_add_widget(XEN_TO_C_GtkSizeGroup_(size_group), XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_modified "gboolean gtk_text_buffer_get_modified(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_modified", "GtkTextBuffer*");
+ return(C_to_Xen_gboolean(gtk_text_buffer_get_modified(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_size_group_remove_widget(XEN size_group, XEN widget)
+static Xen gxg_gtk_text_buffer_set_modified(Xen buffer, Xen setting)
{
- #define H_gtk_size_group_remove_widget "void gtk_size_group_remove_widget(GtkSizeGroup* size_group, \
-GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkSizeGroup__P(size_group), size_group, 1, "gtk_size_group_remove_widget", "GtkSizeGroup*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_size_group_remove_widget", "GtkWidget*");
- gtk_size_group_remove_widget(XEN_TO_C_GtkSizeGroup_(size_group), XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_set_modified "void gtk_text_buffer_set_modified(GtkTextBuffer* buffer, gboolean setting)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_set_modified", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_text_buffer_set_modified", "gboolean");
+ gtk_text_buffer_set_modified(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_configure(XEN spin_button, XEN adjustment, XEN climb_rate, XEN digits)
+static Xen gxg_gtk_text_buffer_add_selection_clipboard(Xen buffer, Xen clipboard)
{
- #define H_gtk_spin_button_configure "void gtk_spin_button_configure(GtkSpinButton* spin_button, GtkAdjustment* adjustment, \
-gdouble climb_rate, guint digits)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_configure", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment) || XEN_FALSE_P(adjustment), adjustment, 2, "gtk_spin_button_configure", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(climb_rate), climb_rate, 3, "gtk_spin_button_configure", "gdouble");
- XEN_ASSERT_TYPE(XEN_guint_P(digits), digits, 4, "gtk_spin_button_configure", "guint");
- gtk_spin_button_configure(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(climb_rate),
- XEN_TO_C_guint(digits));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_add_selection_clipboard "void gtk_text_buffer_add_selection_clipboard(GtkTextBuffer* buffer, \
+GtkClipboard* clipboard)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_add_selection_clipboard", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 2, "gtk_text_buffer_add_selection_clipboard", "GtkClipboard*");
+ gtk_text_buffer_add_selection_clipboard(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkClipboard_(clipboard));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_new(XEN adjustment, XEN climb_rate, XEN digits)
+static Xen gxg_gtk_text_buffer_remove_selection_clipboard(Xen buffer, Xen clipboard)
{
- #define H_gtk_spin_button_new "GtkWidget* gtk_spin_button_new(GtkAdjustment* adjustment, gdouble climb_rate, \
-guint digits)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment) || XEN_FALSE_P(adjustment), adjustment, 1, "gtk_spin_button_new", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(climb_rate), climb_rate, 2, "gtk_spin_button_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_guint_P(digits), digits, 3, "gtk_spin_button_new", "guint");
- return(C_TO_XEN_GtkWidget_(gtk_spin_button_new(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(climb_rate), XEN_TO_C_guint(digits))));
+ #define H_gtk_text_buffer_remove_selection_clipboard "void gtk_text_buffer_remove_selection_clipboard(GtkTextBuffer* buffer, \
+GtkClipboard* clipboard)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_remove_selection_clipboard", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 2, "gtk_text_buffer_remove_selection_clipboard", "GtkClipboard*");
+ gtk_text_buffer_remove_selection_clipboard(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkClipboard_(clipboard));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_new_with_range(XEN min, XEN max, XEN step)
+static Xen gxg_gtk_text_buffer_cut_clipboard(Xen buffer, Xen clipboard, Xen default_editable)
{
- #define H_gtk_spin_button_new_with_range "GtkWidget* gtk_spin_button_new_with_range(gdouble min, gdouble max, \
-gdouble step)"
- XEN_ASSERT_TYPE(XEN_gdouble_P(min), min, 1, "gtk_spin_button_new_with_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(max), max, 2, "gtk_spin_button_new_with_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step), step, 3, "gtk_spin_button_new_with_range", "gdouble");
- return(C_TO_XEN_GtkWidget_(gtk_spin_button_new_with_range(XEN_TO_C_gdouble(min), XEN_TO_C_gdouble(max), XEN_TO_C_gdouble(step))));
+ #define H_gtk_text_buffer_cut_clipboard "void gtk_text_buffer_cut_clipboard(GtkTextBuffer* buffer, \
+GtkClipboard* clipboard, gboolean default_editable)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_cut_clipboard", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 2, "gtk_text_buffer_cut_clipboard", "GtkClipboard*");
+ Xen_check_type(Xen_is_gboolean(default_editable), default_editable, 3, "gtk_text_buffer_cut_clipboard", "gboolean");
+ gtk_text_buffer_cut_clipboard(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_gboolean(default_editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_set_adjustment(XEN spin_button, XEN adjustment)
+static Xen gxg_gtk_text_buffer_copy_clipboard(Xen buffer, Xen clipboard)
{
- #define H_gtk_spin_button_set_adjustment "void gtk_spin_button_set_adjustment(GtkSpinButton* spin_button, \
-GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_adjustment", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment) || XEN_FALSE_P(adjustment), adjustment, 2, "gtk_spin_button_set_adjustment", "GtkAdjustment*");
- gtk_spin_button_set_adjustment(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_GtkAdjustment_(adjustment));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_copy_clipboard "void gtk_text_buffer_copy_clipboard(GtkTextBuffer* buffer, \
+GtkClipboard* clipboard)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_copy_clipboard", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 2, "gtk_text_buffer_copy_clipboard", "GtkClipboard*");
+ gtk_text_buffer_copy_clipboard(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkClipboard_(clipboard));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_get_adjustment(XEN spin_button)
+static Xen gxg_gtk_text_buffer_paste_clipboard(Xen buffer, Xen clipboard, Xen override_location, Xen default_editable)
{
- #define H_gtk_spin_button_get_adjustment "GtkAdjustment* gtk_spin_button_get_adjustment(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_adjustment", "GtkSpinButton*");
- return(C_TO_XEN_GtkAdjustment_(gtk_spin_button_get_adjustment(XEN_TO_C_GtkSpinButton_(spin_button))));
+ #define H_gtk_text_buffer_paste_clipboard "void gtk_text_buffer_paste_clipboard(GtkTextBuffer* buffer, \
+GtkClipboard* clipboard, GtkTextIter* override_location, gboolean default_editable)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_paste_clipboard", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 2, "gtk_text_buffer_paste_clipboard", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkTextIter_(override_location) || Xen_is_false(override_location), override_location, 3, "gtk_text_buffer_paste_clipboard", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(default_editable), default_editable, 4, "gtk_text_buffer_paste_clipboard", "gboolean");
+ gtk_text_buffer_paste_clipboard(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkTextIter_(override_location),
+ Xen_to_C_gboolean(default_editable));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_set_digits(XEN spin_button, XEN digits)
+static Xen gxg_gtk_text_buffer_get_selection_bounds(Xen buffer, Xen start, Xen end)
{
- #define H_gtk_spin_button_set_digits "void gtk_spin_button_set_digits(GtkSpinButton* spin_button, guint digits)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_digits", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_guint_P(digits), digits, 2, "gtk_spin_button_set_digits", "guint");
- gtk_spin_button_set_digits(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_guint(digits));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_selection_bounds "gboolean gtk_text_buffer_get_selection_bounds(GtkTextBuffer* buffer, \
+GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_selection_bounds", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 2, "gtk_text_buffer_get_selection_bounds", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 3, "gtk_text_buffer_get_selection_bounds", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_buffer_get_selection_bounds(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(start),
+ Xen_to_C_GtkTextIter_(end))));
}
-static XEN gxg_gtk_spin_button_get_digits(XEN spin_button)
+static Xen gxg_gtk_text_buffer_delete_selection(Xen buffer, Xen interactive, Xen default_editable)
{
- #define H_gtk_spin_button_get_digits "guint gtk_spin_button_get_digits(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_digits", "GtkSpinButton*");
- return(C_TO_XEN_guint(gtk_spin_button_get_digits(XEN_TO_C_GtkSpinButton_(spin_button))));
+ #define H_gtk_text_buffer_delete_selection "gboolean gtk_text_buffer_delete_selection(GtkTextBuffer* buffer, \
+gboolean interactive, gboolean default_editable)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_delete_selection", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gboolean(interactive), interactive, 2, "gtk_text_buffer_delete_selection", "gboolean");
+ Xen_check_type(Xen_is_gboolean(default_editable), default_editable, 3, "gtk_text_buffer_delete_selection", "gboolean");
+ return(C_to_Xen_gboolean(gtk_text_buffer_delete_selection(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gboolean(interactive),
+ Xen_to_C_gboolean(default_editable))));
}
-static XEN gxg_gtk_spin_button_set_increments(XEN spin_button, XEN step, XEN page)
+static Xen gxg_gtk_text_buffer_begin_user_action(Xen buffer)
{
- #define H_gtk_spin_button_set_increments "void gtk_spin_button_set_increments(GtkSpinButton* spin_button, \
-gdouble step, gdouble page)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_increments", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step), step, 2, "gtk_spin_button_set_increments", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page), page, 3, "gtk_spin_button_set_increments", "gdouble");
- gtk_spin_button_set_increments(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_gdouble(step), XEN_TO_C_gdouble(page));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_begin_user_action "void gtk_text_buffer_begin_user_action(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_begin_user_action", "GtkTextBuffer*");
+ gtk_text_buffer_begin_user_action(Xen_to_C_GtkTextBuffer_(buffer));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_get_increments(XEN spin_button, XEN ignore_step, XEN ignore_page)
+static Xen gxg_gtk_text_buffer_end_user_action(Xen buffer)
{
- #define H_gtk_spin_button_get_increments "void gtk_spin_button_get_increments(GtkSpinButton* spin_button, \
-gdouble* [step], gdouble* [page])"
- gdouble ref_step;
- gdouble ref_page;
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_increments", "GtkSpinButton*");
- gtk_spin_button_get_increments(XEN_TO_C_GtkSpinButton_(spin_button), &ref_step, &ref_page);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_step), C_TO_XEN_gdouble(ref_page)));
+ #define H_gtk_text_buffer_end_user_action "void gtk_text_buffer_end_user_action(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_end_user_action", "GtkTextBuffer*");
+ gtk_text_buffer_end_user_action(Xen_to_C_GtkTextBuffer_(buffer));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_set_range(XEN spin_button, XEN min, XEN max)
+static Xen gxg_gtk_text_child_anchor_new(void)
{
- #define H_gtk_spin_button_set_range "void gtk_spin_button_set_range(GtkSpinButton* spin_button, gdouble min, \
-gdouble max)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_range", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(min), min, 2, "gtk_spin_button_set_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(max), max, 3, "gtk_spin_button_set_range", "gdouble");
- gtk_spin_button_set_range(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_gdouble(min), XEN_TO_C_gdouble(max));
- return(XEN_FALSE);
+ #define H_gtk_text_child_anchor_new "GtkTextChildAnchor* gtk_text_child_anchor_new( void)"
+ return(C_to_Xen_GtkTextChildAnchor_(gtk_text_child_anchor_new()));
}
-static XEN gxg_gtk_spin_button_get_range(XEN spin_button, XEN ignore_min, XEN ignore_max)
+static Xen gxg_gtk_text_child_anchor_get_widgets(Xen anchor)
{
- #define H_gtk_spin_button_get_range "void gtk_spin_button_get_range(GtkSpinButton* spin_button, gdouble* [min], \
-gdouble* [max])"
- gdouble ref_min;
- gdouble ref_max;
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_range", "GtkSpinButton*");
- gtk_spin_button_get_range(XEN_TO_C_GtkSpinButton_(spin_button), &ref_min, &ref_max);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_min), C_TO_XEN_gdouble(ref_max)));
+ #define H_gtk_text_child_anchor_get_widgets "GList* gtk_text_child_anchor_get_widgets(GtkTextChildAnchor* anchor)"
+ Xen_check_type(Xen_is_GtkTextChildAnchor_(anchor), anchor, 1, "gtk_text_child_anchor_get_widgets", "GtkTextChildAnchor*");
+ return(C_to_Xen_GList_(gtk_text_child_anchor_get_widgets(Xen_to_C_GtkTextChildAnchor_(anchor))));
}
-static XEN gxg_gtk_spin_button_get_value(XEN spin_button)
+static Xen gxg_gtk_text_child_anchor_get_deleted(Xen anchor)
{
- #define H_gtk_spin_button_get_value "gdouble gtk_spin_button_get_value(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_value", "GtkSpinButton*");
- return(C_TO_XEN_gdouble(gtk_spin_button_get_value(XEN_TO_C_GtkSpinButton_(spin_button))));
+ #define H_gtk_text_child_anchor_get_deleted "gboolean gtk_text_child_anchor_get_deleted(GtkTextChildAnchor* anchor)"
+ Xen_check_type(Xen_is_GtkTextChildAnchor_(anchor), anchor, 1, "gtk_text_child_anchor_get_deleted", "GtkTextChildAnchor*");
+ return(C_to_Xen_gboolean(gtk_text_child_anchor_get_deleted(Xen_to_C_GtkTextChildAnchor_(anchor))));
}
-static XEN gxg_gtk_spin_button_get_value_as_int(XEN spin_button)
+static Xen gxg_gtk_text_iter_get_buffer(Xen iter)
{
- #define H_gtk_spin_button_get_value_as_int "gint gtk_spin_button_get_value_as_int(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_value_as_int", "GtkSpinButton*");
- return(C_TO_XEN_gint(gtk_spin_button_get_value_as_int(XEN_TO_C_GtkSpinButton_(spin_button))));
+ #define H_gtk_text_iter_get_buffer "GtkTextBuffer* gtk_text_iter_get_buffer(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_buffer", "GtkTextIter*");
+ return(C_to_Xen_GtkTextBuffer_(gtk_text_iter_get_buffer(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_set_value(XEN spin_button, XEN value)
+static Xen gxg_gtk_text_iter_copy(Xen iter)
{
- #define H_gtk_spin_button_set_value "void gtk_spin_button_set_value(GtkSpinButton* spin_button, gdouble value)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_value", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 2, "gtk_spin_button_set_value", "gdouble");
- gtk_spin_button_set_value(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_gdouble(value));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_copy "GtkTextIter* gtk_text_iter_copy(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_copy", "GtkTextIter*");
+ return(C_to_Xen_GtkTextIter_(gtk_text_iter_copy(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_set_update_policy(XEN spin_button, XEN policy)
+static Xen gxg_gtk_text_iter_free(Xen iter)
{
- #define H_gtk_spin_button_set_update_policy "void gtk_spin_button_set_update_policy(GtkSpinButton* spin_button, \
-GtkSpinButtonUpdatePolicy policy)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_update_policy", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_GtkSpinButtonUpdatePolicy_P(policy), policy, 2, "gtk_spin_button_set_update_policy", "GtkSpinButtonUpdatePolicy");
- gtk_spin_button_set_update_policy(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_GtkSpinButtonUpdatePolicy(policy));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_free "void gtk_text_iter_free(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_free", "GtkTextIter*");
+ gtk_text_iter_free(Xen_to_C_GtkTextIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_spin_button_get_update_policy(XEN spin_button)
+static Xen gxg_gtk_text_iter_get_offset(Xen iter)
{
- #define H_gtk_spin_button_get_update_policy "GtkSpinButtonUpdatePolicy gtk_spin_button_get_update_policy(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_update_policy", "GtkSpinButton*");
- return(C_TO_XEN_GtkSpinButtonUpdatePolicy(gtk_spin_button_get_update_policy(XEN_TO_C_GtkSpinButton_(spin_button))));
+ #define H_gtk_text_iter_get_offset "gint gtk_text_iter_get_offset(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_offset", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_get_offset(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_set_numeric(XEN spin_button, XEN numeric)
+static Xen gxg_gtk_text_iter_get_line(Xen iter)
{
- #define H_gtk_spin_button_set_numeric "void gtk_spin_button_set_numeric(GtkSpinButton* spin_button, \
-gboolean numeric)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_numeric", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(numeric), numeric, 2, "gtk_spin_button_set_numeric", "gboolean");
- gtk_spin_button_set_numeric(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_gboolean(numeric));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_line "gint gtk_text_iter_get_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_line", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_get_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_get_numeric(XEN spin_button)
+static Xen gxg_gtk_text_iter_get_line_offset(Xen iter)
{
- #define H_gtk_spin_button_get_numeric "gboolean gtk_spin_button_get_numeric(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_numeric", "GtkSpinButton*");
- return(C_TO_XEN_gboolean(gtk_spin_button_get_numeric(XEN_TO_C_GtkSpinButton_(spin_button))));
+ #define H_gtk_text_iter_get_line_offset "gint gtk_text_iter_get_line_offset(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_line_offset", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_get_line_offset(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_spin(XEN spin_button, XEN direction, XEN increment)
+static Xen gxg_gtk_text_iter_get_line_index(Xen iter)
{
- #define H_gtk_spin_button_spin "void gtk_spin_button_spin(GtkSpinButton* spin_button, GtkSpinType direction, \
-gdouble increment)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_spin", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_GtkSpinType_P(direction), direction, 2, "gtk_spin_button_spin", "GtkSpinType");
- XEN_ASSERT_TYPE(XEN_gdouble_P(increment), increment, 3, "gtk_spin_button_spin", "gdouble");
- gtk_spin_button_spin(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_GtkSpinType(direction), XEN_TO_C_gdouble(increment));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_line_index "gint gtk_text_iter_get_line_index(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_line_index", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_get_line_index(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_set_wrap(XEN spin_button, XEN wrap)
+static Xen gxg_gtk_text_iter_get_visible_line_offset(Xen iter)
{
- #define H_gtk_spin_button_set_wrap "void gtk_spin_button_set_wrap(GtkSpinButton* spin_button, gboolean wrap)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_wrap", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(wrap), wrap, 2, "gtk_spin_button_set_wrap", "gboolean");
- gtk_spin_button_set_wrap(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_gboolean(wrap));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_visible_line_offset "gint gtk_text_iter_get_visible_line_offset(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_visible_line_offset", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_get_visible_line_offset(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_get_wrap(XEN spin_button)
+static Xen gxg_gtk_text_iter_get_visible_line_index(Xen iter)
{
- #define H_gtk_spin_button_get_wrap "gboolean gtk_spin_button_get_wrap(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_wrap", "GtkSpinButton*");
- return(C_TO_XEN_gboolean(gtk_spin_button_get_wrap(XEN_TO_C_GtkSpinButton_(spin_button))));
+ #define H_gtk_text_iter_get_visible_line_index "gint gtk_text_iter_get_visible_line_index(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_visible_line_index", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_get_visible_line_index(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_set_snap_to_ticks(XEN spin_button, XEN snap_to_ticks)
+static Xen gxg_gtk_text_iter_get_char(Xen iter)
{
- #define H_gtk_spin_button_set_snap_to_ticks "void gtk_spin_button_set_snap_to_ticks(GtkSpinButton* spin_button, \
-gboolean snap_to_ticks)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_set_snap_to_ticks", "GtkSpinButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(snap_to_ticks), snap_to_ticks, 2, "gtk_spin_button_set_snap_to_ticks", "gboolean");
- gtk_spin_button_set_snap_to_ticks(XEN_TO_C_GtkSpinButton_(spin_button), XEN_TO_C_gboolean(snap_to_ticks));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_char "gunichar gtk_text_iter_get_char(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_char", "GtkTextIter*");
+ return(C_to_Xen_gunichar(gtk_text_iter_get_char(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_spin_button_get_snap_to_ticks(XEN spin_button)
+static Xen gxg_gtk_text_iter_get_slice(Xen start, Xen end)
{
- #define H_gtk_spin_button_get_snap_to_ticks "gboolean gtk_spin_button_get_snap_to_ticks(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_get_snap_to_ticks", "GtkSpinButton*");
- return(C_TO_XEN_gboolean(gtk_spin_button_get_snap_to_ticks(XEN_TO_C_GtkSpinButton_(spin_button))));
+ #define H_gtk_text_iter_get_slice "gchar* gtk_text_iter_get_slice(GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 1, "gtk_text_iter_get_slice", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 2, "gtk_text_iter_get_slice", "GtkTextIter*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_text_iter_get_slice(Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_spin_button_update(XEN spin_button)
+static Xen gxg_gtk_text_iter_get_text(Xen start, Xen end)
{
- #define H_gtk_spin_button_update "void gtk_spin_button_update(GtkSpinButton* spin_button)"
- XEN_ASSERT_TYPE(XEN_GtkSpinButton__P(spin_button), spin_button, 1, "gtk_spin_button_update", "GtkSpinButton*");
- gtk_spin_button_update(XEN_TO_C_GtkSpinButton_(spin_button));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_text "gchar* gtk_text_iter_get_text(GtkTextIter* start, GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 1, "gtk_text_iter_get_text", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 2, "gtk_text_iter_get_text", "GtkTextIter*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_text_iter_get_text(Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_statusbar_new(void)
+static Xen gxg_gtk_text_iter_get_visible_slice(Xen start, Xen end)
{
- #define H_gtk_statusbar_new "GtkWidget* gtk_statusbar_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_statusbar_new()));
+ #define H_gtk_text_iter_get_visible_slice "gchar* gtk_text_iter_get_visible_slice(GtkTextIter* start, \
+GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 1, "gtk_text_iter_get_visible_slice", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 2, "gtk_text_iter_get_visible_slice", "GtkTextIter*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_text_iter_get_visible_slice(Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_statusbar_get_context_id(XEN statusbar, XEN context_description)
+static Xen gxg_gtk_text_iter_get_visible_text(Xen start, Xen end)
{
- #define H_gtk_statusbar_get_context_id "guint gtk_statusbar_get_context_id(GtkStatusbar* statusbar, \
-gchar* context_description)"
- XEN_ASSERT_TYPE(XEN_GtkStatusbar__P(statusbar), statusbar, 1, "gtk_statusbar_get_context_id", "GtkStatusbar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(context_description), context_description, 2, "gtk_statusbar_get_context_id", "gchar*");
- return(C_TO_XEN_guint(gtk_statusbar_get_context_id(XEN_TO_C_GtkStatusbar_(statusbar), XEN_TO_C_gchar_(context_description))));
+ #define H_gtk_text_iter_get_visible_text "gchar* gtk_text_iter_get_visible_text(GtkTextIter* start, \
+GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 1, "gtk_text_iter_get_visible_text", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 2, "gtk_text_iter_get_visible_text", "GtkTextIter*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_text_iter_get_visible_text(Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_statusbar_push(XEN statusbar, XEN context_id, XEN text)
+static Xen gxg_gtk_text_iter_get_pixbuf(Xen iter)
{
- #define H_gtk_statusbar_push "guint gtk_statusbar_push(GtkStatusbar* statusbar, guint context_id, gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkStatusbar__P(statusbar), statusbar, 1, "gtk_statusbar_push", "GtkStatusbar*");
- XEN_ASSERT_TYPE(XEN_guint_P(context_id), context_id, 2, "gtk_statusbar_push", "guint");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_statusbar_push", "gchar*");
- return(C_TO_XEN_guint(gtk_statusbar_push(XEN_TO_C_GtkStatusbar_(statusbar), XEN_TO_C_guint(context_id), XEN_TO_C_gchar_(text))));
+ #define H_gtk_text_iter_get_pixbuf "GdkPixbuf* gtk_text_iter_get_pixbuf(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_pixbuf", "GtkTextIter*");
+ return(C_to_Xen_GdkPixbuf_(gtk_text_iter_get_pixbuf(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_statusbar_pop(XEN statusbar, XEN context_id)
+static Xen gxg_gtk_text_iter_get_marks(Xen iter)
{
- #define H_gtk_statusbar_pop "void gtk_statusbar_pop(GtkStatusbar* statusbar, guint context_id)"
- XEN_ASSERT_TYPE(XEN_GtkStatusbar__P(statusbar), statusbar, 1, "gtk_statusbar_pop", "GtkStatusbar*");
- XEN_ASSERT_TYPE(XEN_guint_P(context_id), context_id, 2, "gtk_statusbar_pop", "guint");
- gtk_statusbar_pop(XEN_TO_C_GtkStatusbar_(statusbar), XEN_TO_C_guint(context_id));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_marks "GSList* gtk_text_iter_get_marks(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_marks", "GtkTextIter*");
+ return(C_to_Xen_GSList_(gtk_text_iter_get_marks(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_statusbar_remove(XEN statusbar, XEN context_id, XEN message_id)
+static Xen gxg_gtk_text_iter_get_child_anchor(Xen iter)
{
- #define H_gtk_statusbar_remove "void gtk_statusbar_remove(GtkStatusbar* statusbar, guint context_id, \
-guint message_id)"
- XEN_ASSERT_TYPE(XEN_GtkStatusbar__P(statusbar), statusbar, 1, "gtk_statusbar_remove", "GtkStatusbar*");
- XEN_ASSERT_TYPE(XEN_guint_P(context_id), context_id, 2, "gtk_statusbar_remove", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(message_id), message_id, 3, "gtk_statusbar_remove", "guint");
- gtk_statusbar_remove(XEN_TO_C_GtkStatusbar_(statusbar), XEN_TO_C_guint(context_id), XEN_TO_C_guint(message_id));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_child_anchor "GtkTextChildAnchor* gtk_text_iter_get_child_anchor(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_child_anchor", "GtkTextIter*");
+ return(C_to_Xen_GtkTextChildAnchor_(gtk_text_iter_get_child_anchor(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_stock_add(XEN items, XEN n_items)
+static Xen gxg_gtk_text_iter_get_toggled_tags(Xen iter, Xen toggled_on)
{
- #define H_gtk_stock_add "void gtk_stock_add(GtkStockItem* items, guint n_items)"
- XEN_ASSERT_TYPE(XEN_GtkStockItem__P(items), items, 1, "gtk_stock_add", "GtkStockItem*");
- XEN_ASSERT_TYPE(XEN_guint_P(n_items), n_items, 2, "gtk_stock_add", "guint");
- gtk_stock_add(XEN_TO_C_GtkStockItem_(items), XEN_TO_C_guint(n_items));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_toggled_tags "GSList* gtk_text_iter_get_toggled_tags(GtkTextIter* iter, \
+gboolean toggled_on)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_toggled_tags", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(toggled_on), toggled_on, 2, "gtk_text_iter_get_toggled_tags", "gboolean");
+ return(C_to_Xen_GSList_(gtk_text_iter_get_toggled_tags(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gboolean(toggled_on))));
}
-static XEN gxg_gtk_stock_add_static(XEN items, XEN n_items)
+static Xen gxg_gtk_text_iter_begins_tag(Xen iter, Xen tag)
{
- #define H_gtk_stock_add_static "void gtk_stock_add_static(GtkStockItem* items, guint n_items)"
- XEN_ASSERT_TYPE(XEN_GtkStockItem__P(items), items, 1, "gtk_stock_add_static", "GtkStockItem*");
- XEN_ASSERT_TYPE(XEN_guint_P(n_items), n_items, 2, "gtk_stock_add_static", "guint");
- gtk_stock_add_static(XEN_TO_C_GtkStockItem_(items), XEN_TO_C_guint(n_items));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_begins_tag "gboolean gtk_text_iter_begins_tag(GtkTextIter* iter, GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_begins_tag", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag) || Xen_is_false(tag), tag, 2, "gtk_text_iter_begins_tag", "GtkTextTag*");
+ return(C_to_Xen_gboolean(gtk_text_iter_begins_tag(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextTag_(tag))));
}
-static XEN gxg_gtk_stock_lookup(XEN stock_id, XEN item)
+static Xen gxg_gtk_text_iter_ends_tag(Xen iter, Xen tag)
{
- #define H_gtk_stock_lookup "gboolean gtk_stock_lookup(gchar* stock_id, GtkStockItem* item)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_stock_lookup", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkStockItem__P(item), item, 2, "gtk_stock_lookup", "GtkStockItem*");
- return(C_TO_XEN_gboolean(gtk_stock_lookup(XEN_TO_C_gchar_(stock_id), XEN_TO_C_GtkStockItem_(item))));
+ #define H_gtk_text_iter_ends_tag "gboolean gtk_text_iter_ends_tag(GtkTextIter* iter, GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_ends_tag", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag) || Xen_is_false(tag), tag, 2, "gtk_text_iter_ends_tag", "GtkTextTag*");
+ return(C_to_Xen_gboolean(gtk_text_iter_ends_tag(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextTag_(tag))));
}
-static XEN gxg_gtk_stock_list_ids(void)
+static Xen gxg_gtk_text_iter_toggles_tag(Xen iter, Xen tag)
{
- #define H_gtk_stock_list_ids "GSList* gtk_stock_list_ids( void)"
- return(C_TO_XEN_GSList_(gtk_stock_list_ids()));
+ #define H_gtk_text_iter_toggles_tag "gboolean gtk_text_iter_toggles_tag(GtkTextIter* iter, GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_toggles_tag", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag) || Xen_is_false(tag), tag, 2, "gtk_text_iter_toggles_tag", "GtkTextTag*");
+ return(C_to_Xen_gboolean(gtk_text_iter_toggles_tag(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextTag_(tag))));
}
-static XEN gxg_gtk_stock_item_copy(XEN item)
+static Xen gxg_gtk_text_iter_has_tag(Xen iter, Xen tag)
{
- #define H_gtk_stock_item_copy "GtkStockItem* gtk_stock_item_copy(GtkStockItem* item)"
- XEN_ASSERT_TYPE(XEN_GtkStockItem__P(item), item, 1, "gtk_stock_item_copy", "GtkStockItem*");
- return(C_TO_XEN_GtkStockItem_(gtk_stock_item_copy(XEN_TO_C_GtkStockItem_(item))));
+ #define H_gtk_text_iter_has_tag "gboolean gtk_text_iter_has_tag(GtkTextIter* iter, GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_has_tag", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 2, "gtk_text_iter_has_tag", "GtkTextTag*");
+ return(C_to_Xen_gboolean(gtk_text_iter_has_tag(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextTag_(tag))));
}
-static XEN gxg_gtk_stock_item_free(XEN item)
+static Xen gxg_gtk_text_iter_get_tags(Xen iter)
{
- #define H_gtk_stock_item_free "void gtk_stock_item_free(GtkStockItem* item)"
- XEN_ASSERT_TYPE(XEN_GtkStockItem__P(item), item, 1, "gtk_stock_item_free", "GtkStockItem*");
- gtk_stock_item_free(XEN_TO_C_GtkStockItem_(item));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_tags "GSList* gtk_text_iter_get_tags(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_tags", "GtkTextIter*");
+ return(C_to_Xen_GSList_(gtk_text_iter_get_tags(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_new(XEN rows, XEN columns, XEN homogeneous)
+static Xen gxg_gtk_text_iter_editable(Xen iter, Xen default_setting)
{
- #define H_gtk_table_new "GtkWidget* gtk_table_new(guint rows, guint columns, gboolean homogeneous)"
- XEN_ASSERT_TYPE(XEN_guint_P(rows), rows, 1, "gtk_table_new", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(columns), columns, 2, "gtk_table_new", "guint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(homogeneous), homogeneous, 3, "gtk_table_new", "gboolean");
- return(C_TO_XEN_GtkWidget_(gtk_table_new(XEN_TO_C_guint(rows), XEN_TO_C_guint(columns), XEN_TO_C_gboolean(homogeneous))));
+ #define H_gtk_text_iter_editable "gboolean gtk_text_iter_editable(GtkTextIter* iter, gboolean default_setting)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_editable", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(default_setting), default_setting, 2, "gtk_text_iter_editable", "gboolean");
+ return(C_to_Xen_gboolean(gtk_text_iter_editable(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gboolean(default_setting))));
}
-static XEN gxg_gtk_table_resize(XEN table, XEN rows, XEN columns)
+static Xen gxg_gtk_text_iter_can_insert(Xen iter, Xen default_editability)
{
- #define H_gtk_table_resize "void gtk_table_resize(GtkTable* table, guint rows, guint columns)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_resize", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_guint_P(rows), rows, 2, "gtk_table_resize", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(columns), columns, 3, "gtk_table_resize", "guint");
- gtk_table_resize(XEN_TO_C_GtkTable_(table), XEN_TO_C_guint(rows), XEN_TO_C_guint(columns));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_can_insert "gboolean gtk_text_iter_can_insert(GtkTextIter* iter, gboolean default_editability)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_can_insert", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(default_editability), default_editability, 2, "gtk_text_iter_can_insert", "gboolean");
+ return(C_to_Xen_gboolean(gtk_text_iter_can_insert(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gboolean(default_editability))));
}
-static XEN gxg_gtk_table_attach(XEN arglist)
+static Xen gxg_gtk_text_iter_starts_word(Xen iter)
{
- #define H_gtk_table_attach "void gtk_table_attach(GtkTable* table, GtkWidget* child, guint left_attach, \
-guint right_attach, guint top_attach, guint bottom_attach, GtkAttachOptions xoptions, GtkAttachOptions yoptions, \
-guint xpadding, guint ypadding)"
- XEN table, child, left_attach, right_attach, top_attach, bottom_attach, xoptions, yoptions, xpadding, ypadding;
- table = XEN_LIST_REF(arglist, 0);
- child = XEN_LIST_REF(arglist, 1);
- left_attach = XEN_LIST_REF(arglist, 2);
- right_attach = XEN_LIST_REF(arglist, 3);
- top_attach = XEN_LIST_REF(arglist, 4);
- bottom_attach = XEN_LIST_REF(arglist, 5);
- xoptions = XEN_LIST_REF(arglist, 6);
- yoptions = XEN_LIST_REF(arglist, 7);
- xpadding = XEN_LIST_REF(arglist, 8);
- ypadding = XEN_LIST_REF(arglist, 9);
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_attach", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_table_attach", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_guint_P(left_attach), left_attach, 3, "gtk_table_attach", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(right_attach), right_attach, 4, "gtk_table_attach", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(top_attach), top_attach, 5, "gtk_table_attach", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(bottom_attach), bottom_attach, 6, "gtk_table_attach", "guint");
- XEN_ASSERT_TYPE(XEN_GtkAttachOptions_P(xoptions), xoptions, 7, "gtk_table_attach", "GtkAttachOptions");
- XEN_ASSERT_TYPE(XEN_GtkAttachOptions_P(yoptions), yoptions, 8, "gtk_table_attach", "GtkAttachOptions");
- XEN_ASSERT_TYPE(XEN_guint_P(xpadding), xpadding, 9, "gtk_table_attach", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(ypadding), ypadding, 10, "gtk_table_attach", "guint");
- gtk_table_attach(XEN_TO_C_GtkTable_(table), XEN_TO_C_GtkWidget_(child), XEN_TO_C_guint(left_attach), XEN_TO_C_guint(right_attach),
- XEN_TO_C_guint(top_attach), XEN_TO_C_guint(bottom_attach), XEN_TO_C_GtkAttachOptions(xoptions), XEN_TO_C_GtkAttachOptions(yoptions),
- XEN_TO_C_guint(xpadding), XEN_TO_C_guint(ypadding));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_starts_word "gboolean gtk_text_iter_starts_word(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_starts_word", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_starts_word(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_attach_defaults(XEN table, XEN widget, XEN left_attach, XEN right_attach, XEN top_attach, XEN bottom_attach)
+static Xen gxg_gtk_text_iter_ends_word(Xen iter)
{
- #define H_gtk_table_attach_defaults "void gtk_table_attach_defaults(GtkTable* table, GtkWidget* widget, \
-guint left_attach, guint right_attach, guint top_attach, guint bottom_attach)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_attach_defaults", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_table_attach_defaults", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_guint_P(left_attach), left_attach, 3, "gtk_table_attach_defaults", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(right_attach), right_attach, 4, "gtk_table_attach_defaults", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(top_attach), top_attach, 5, "gtk_table_attach_defaults", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(bottom_attach), bottom_attach, 6, "gtk_table_attach_defaults", "guint");
- gtk_table_attach_defaults(XEN_TO_C_GtkTable_(table), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_guint(left_attach), XEN_TO_C_guint(right_attach),
- XEN_TO_C_guint(top_attach), XEN_TO_C_guint(bottom_attach));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_ends_word "gboolean gtk_text_iter_ends_word(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_ends_word", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_ends_word(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_set_row_spacing(XEN table, XEN row, XEN spacing)
+static Xen gxg_gtk_text_iter_inside_word(Xen iter)
{
- #define H_gtk_table_set_row_spacing "void gtk_table_set_row_spacing(GtkTable* table, guint row, guint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_set_row_spacing", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_guint_P(row), row, 2, "gtk_table_set_row_spacing", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(spacing), spacing, 3, "gtk_table_set_row_spacing", "guint");
- gtk_table_set_row_spacing(XEN_TO_C_GtkTable_(table), XEN_TO_C_guint(row), XEN_TO_C_guint(spacing));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_inside_word "gboolean gtk_text_iter_inside_word(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_inside_word", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_inside_word(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_get_row_spacing(XEN table, XEN row)
+static Xen gxg_gtk_text_iter_starts_sentence(Xen iter)
{
- #define H_gtk_table_get_row_spacing "guint gtk_table_get_row_spacing(GtkTable* table, guint row)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_get_row_spacing", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_guint_P(row), row, 2, "gtk_table_get_row_spacing", "guint");
- return(C_TO_XEN_guint(gtk_table_get_row_spacing(XEN_TO_C_GtkTable_(table), XEN_TO_C_guint(row))));
+ #define H_gtk_text_iter_starts_sentence "gboolean gtk_text_iter_starts_sentence(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_starts_sentence", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_starts_sentence(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_set_col_spacing(XEN table, XEN column, XEN spacing)
+static Xen gxg_gtk_text_iter_ends_sentence(Xen iter)
{
- #define H_gtk_table_set_col_spacing "void gtk_table_set_col_spacing(GtkTable* table, guint column, \
-guint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_set_col_spacing", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_guint_P(column), column, 2, "gtk_table_set_col_spacing", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(spacing), spacing, 3, "gtk_table_set_col_spacing", "guint");
- gtk_table_set_col_spacing(XEN_TO_C_GtkTable_(table), XEN_TO_C_guint(column), XEN_TO_C_guint(spacing));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_ends_sentence "gboolean gtk_text_iter_ends_sentence(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_ends_sentence", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_ends_sentence(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_get_col_spacing(XEN table, XEN column)
+static Xen gxg_gtk_text_iter_inside_sentence(Xen iter)
{
- #define H_gtk_table_get_col_spacing "guint gtk_table_get_col_spacing(GtkTable* table, guint column)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_get_col_spacing", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_guint_P(column), column, 2, "gtk_table_get_col_spacing", "guint");
- return(C_TO_XEN_guint(gtk_table_get_col_spacing(XEN_TO_C_GtkTable_(table), XEN_TO_C_guint(column))));
+ #define H_gtk_text_iter_inside_sentence "gboolean gtk_text_iter_inside_sentence(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_inside_sentence", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_inside_sentence(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_set_row_spacings(XEN table, XEN spacing)
+static Xen gxg_gtk_text_iter_starts_line(Xen iter)
{
- #define H_gtk_table_set_row_spacings "void gtk_table_set_row_spacings(GtkTable* table, guint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_set_row_spacings", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_guint_P(spacing), spacing, 2, "gtk_table_set_row_spacings", "guint");
- gtk_table_set_row_spacings(XEN_TO_C_GtkTable_(table), XEN_TO_C_guint(spacing));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_starts_line "gboolean gtk_text_iter_starts_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_starts_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_starts_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_get_default_row_spacing(XEN table)
+static Xen gxg_gtk_text_iter_ends_line(Xen iter)
{
- #define H_gtk_table_get_default_row_spacing "guint gtk_table_get_default_row_spacing(GtkTable* table)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_get_default_row_spacing", "GtkTable*");
- return(C_TO_XEN_guint(gtk_table_get_default_row_spacing(XEN_TO_C_GtkTable_(table))));
+ #define H_gtk_text_iter_ends_line "gboolean gtk_text_iter_ends_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_ends_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_ends_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_set_col_spacings(XEN table, XEN spacing)
+static Xen gxg_gtk_text_iter_is_cursor_position(Xen iter)
{
- #define H_gtk_table_set_col_spacings "void gtk_table_set_col_spacings(GtkTable* table, guint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_set_col_spacings", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_guint_P(spacing), spacing, 2, "gtk_table_set_col_spacings", "guint");
- gtk_table_set_col_spacings(XEN_TO_C_GtkTable_(table), XEN_TO_C_guint(spacing));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_is_cursor_position "gboolean gtk_text_iter_is_cursor_position(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_is_cursor_position", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_is_cursor_position(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_get_default_col_spacing(XEN table)
+static Xen gxg_gtk_text_iter_get_chars_in_line(Xen iter)
{
- #define H_gtk_table_get_default_col_spacing "guint gtk_table_get_default_col_spacing(GtkTable* table)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_get_default_col_spacing", "GtkTable*");
- return(C_TO_XEN_guint(gtk_table_get_default_col_spacing(XEN_TO_C_GtkTable_(table))));
+ #define H_gtk_text_iter_get_chars_in_line "gint gtk_text_iter_get_chars_in_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_chars_in_line", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_get_chars_in_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_set_homogeneous(XEN table, XEN homogeneous)
+static Xen gxg_gtk_text_iter_get_bytes_in_line(Xen iter)
{
- #define H_gtk_table_set_homogeneous "void gtk_table_set_homogeneous(GtkTable* table, gboolean homogeneous)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_set_homogeneous", "GtkTable*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(homogeneous), homogeneous, 2, "gtk_table_set_homogeneous", "gboolean");
- gtk_table_set_homogeneous(XEN_TO_C_GtkTable_(table), XEN_TO_C_gboolean(homogeneous));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_get_bytes_in_line "gint gtk_text_iter_get_bytes_in_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_bytes_in_line", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_get_bytes_in_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_table_get_homogeneous(XEN table)
+static Xen gxg_gtk_text_iter_get_attributes(Xen iter, Xen values)
{
- #define H_gtk_table_get_homogeneous "gboolean gtk_table_get_homogeneous(GtkTable* table)"
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_get_homogeneous", "GtkTable*");
- return(C_TO_XEN_gboolean(gtk_table_get_homogeneous(XEN_TO_C_GtkTable_(table))));
+ #define H_gtk_text_iter_get_attributes "gboolean gtk_text_iter_get_attributes(GtkTextIter* iter, GtkTextAttributes* values)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_attributes", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextAttributes_(values), values, 2, "gtk_text_iter_get_attributes", "GtkTextAttributes*");
+ return(C_to_Xen_gboolean(gtk_text_iter_get_attributes(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextAttributes_(values))));
}
-static XEN gxg_gtk_tearoff_menu_item_new(void)
+static Xen gxg_gtk_text_iter_get_language(Xen iter)
{
- #define H_gtk_tearoff_menu_item_new "GtkWidget* gtk_tearoff_menu_item_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_tearoff_menu_item_new()));
+ #define H_gtk_text_iter_get_language "PangoLanguage* gtk_text_iter_get_language(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_get_language", "GtkTextIter*");
+ return(C_to_Xen_PangoLanguage_(gtk_text_iter_get_language(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_new(XEN table)
+static Xen gxg_gtk_text_iter_is_end(Xen iter)
{
- #define H_gtk_text_buffer_new "GtkTextBuffer* gtk_text_buffer_new(GtkTextTagTable* table)"
- XEN_ASSERT_TYPE(XEN_GtkTextTagTable__P(table) || XEN_FALSE_P(table), table, 1, "gtk_text_buffer_new", "GtkTextTagTable*");
- return(C_TO_XEN_GtkTextBuffer_(gtk_text_buffer_new(XEN_TO_C_GtkTextTagTable_(table))));
+ #define H_gtk_text_iter_is_end "gboolean gtk_text_iter_is_end(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_is_end", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_is_end(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_get_line_count(XEN buffer)
+static Xen gxg_gtk_text_iter_is_start(Xen iter)
{
- #define H_gtk_text_buffer_get_line_count "gint gtk_text_buffer_get_line_count(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_line_count", "GtkTextBuffer*");
- return(C_TO_XEN_gint(gtk_text_buffer_get_line_count(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_text_iter_is_start "gboolean gtk_text_iter_is_start(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_is_start", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_is_start(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_get_char_count(XEN buffer)
+static Xen gxg_gtk_text_iter_forward_char(Xen iter)
{
- #define H_gtk_text_buffer_get_char_count "gint gtk_text_buffer_get_char_count(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_char_count", "GtkTextBuffer*");
- return(C_TO_XEN_gint(gtk_text_buffer_get_char_count(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_text_iter_forward_char "gboolean gtk_text_iter_forward_char(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_char", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_char(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_get_tag_table(XEN buffer)
+static Xen gxg_gtk_text_iter_backward_char(Xen iter)
{
- #define H_gtk_text_buffer_get_tag_table "GtkTextTagTable* gtk_text_buffer_get_tag_table(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_tag_table", "GtkTextBuffer*");
- return(C_TO_XEN_GtkTextTagTable_(gtk_text_buffer_get_tag_table(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_text_iter_backward_char "gboolean gtk_text_iter_backward_char(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_char", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_char(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_set_text(XEN buffer, XEN text, XEN len)
+static Xen gxg_gtk_text_iter_forward_chars(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_set_text "void gtk_text_buffer_set_text(GtkTextBuffer* buffer, gchar* text, \
-gint len)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_set_text", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_text_buffer_set_text", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 3, "gtk_text_buffer_set_text", "gint");
- gtk_text_buffer_set_text(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(text), XEN_TO_C_gint(len));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_chars "gboolean gtk_text_iter_forward_chars(GtkTextIter* iter, gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_chars", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_forward_chars", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_chars(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_insert(XEN buffer, XEN iter, XEN text, XEN len)
+static Xen gxg_gtk_text_iter_backward_chars(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_insert "void gtk_text_buffer_insert(GtkTextBuffer* buffer, GtkTextIter* iter, \
-gchar* text, gint len)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_insert", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_text_buffer_insert", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 4, "gtk_text_buffer_insert", "gint");
- gtk_text_buffer_insert(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gchar_(text), XEN_TO_C_gint(len));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_backward_chars "gboolean gtk_text_iter_backward_chars(GtkTextIter* iter, gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_chars", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_backward_chars", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_chars(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_insert_at_cursor(XEN buffer, XEN text, XEN len)
+static Xen gxg_gtk_text_iter_forward_line(Xen iter)
{
- #define H_gtk_text_buffer_insert_at_cursor "void gtk_text_buffer_insert_at_cursor(GtkTextBuffer* buffer, \
-gchar* text, gint len)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_at_cursor", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_text_buffer_insert_at_cursor", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 3, "gtk_text_buffer_insert_at_cursor", "gint");
- gtk_text_buffer_insert_at_cursor(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(text), XEN_TO_C_gint(len));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_line "gboolean gtk_text_iter_forward_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_insert_interactive(XEN buffer, XEN iter, XEN text, XEN len, XEN default_editable)
+static Xen gxg_gtk_text_iter_backward_line(Xen iter)
{
- #define H_gtk_text_buffer_insert_interactive "gboolean gtk_text_buffer_insert_interactive(GtkTextBuffer* buffer, \
-GtkTextIter* iter, gchar* text, gint len, gboolean default_editable)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_interactive", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_insert_interactive", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_text_buffer_insert_interactive", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 4, "gtk_text_buffer_insert_interactive", "gint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editable), default_editable, 5, "gtk_text_buffer_insert_interactive", "gboolean");
- return(C_TO_XEN_gboolean(gtk_text_buffer_insert_interactive(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter),
- XEN_TO_C_gchar_(text), XEN_TO_C_gint(len), XEN_TO_C_gboolean(default_editable))));
+ #define H_gtk_text_iter_backward_line "gboolean gtk_text_iter_backward_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_insert_interactive_at_cursor(XEN buffer, XEN text, XEN len, XEN default_editable)
+static Xen gxg_gtk_text_iter_forward_lines(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_insert_interactive_at_cursor "gboolean gtk_text_buffer_insert_interactive_at_cursor(GtkTextBuffer* buffer, \
-gchar* text, gint len, gboolean default_editable)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_interactive_at_cursor", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_text_buffer_insert_interactive_at_cursor", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 3, "gtk_text_buffer_insert_interactive_at_cursor", "gint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editable), default_editable, 4, "gtk_text_buffer_insert_interactive_at_cursor", "gboolean");
- return(C_TO_XEN_gboolean(gtk_text_buffer_insert_interactive_at_cursor(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(text),
- XEN_TO_C_gint(len), XEN_TO_C_gboolean(default_editable))));
+ #define H_gtk_text_iter_forward_lines "gboolean gtk_text_iter_forward_lines(GtkTextIter* iter, gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_lines", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_forward_lines", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_lines(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_insert_range(XEN buffer, XEN iter, XEN start, XEN end)
+static Xen gxg_gtk_text_iter_backward_lines(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_insert_range "void gtk_text_buffer_insert_range(GtkTextBuffer* buffer, GtkTextIter* iter, \
-GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_range", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_insert_range", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 3, "gtk_text_buffer_insert_range", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 4, "gtk_text_buffer_insert_range", "GtkTextIter*");
- gtk_text_buffer_insert_range(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextIter_(start),
- XEN_TO_C_GtkTextIter_(end));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_backward_lines "gboolean gtk_text_iter_backward_lines(GtkTextIter* iter, gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_lines", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_backward_lines", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_lines(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_insert_range_interactive(XEN buffer, XEN iter, XEN start, XEN end, XEN default_editable)
+static Xen gxg_gtk_text_iter_forward_word_end(Xen iter)
{
- #define H_gtk_text_buffer_insert_range_interactive "gboolean gtk_text_buffer_insert_range_interactive(GtkTextBuffer* buffer, \
-GtkTextIter* iter, GtkTextIter* start, GtkTextIter* end, gboolean default_editable)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_range_interactive", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_insert_range_interactive", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 3, "gtk_text_buffer_insert_range_interactive", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 4, "gtk_text_buffer_insert_range_interactive", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editable), default_editable, 5, "gtk_text_buffer_insert_range_interactive", "gboolean");
- return(C_TO_XEN_gboolean(gtk_text_buffer_insert_range_interactive(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter),
- XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end),
- XEN_TO_C_gboolean(default_editable))));
+ #define H_gtk_text_iter_forward_word_end "gboolean gtk_text_iter_forward_word_end(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_word_end", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_word_end(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_insert_with_tags(XEN buffer, XEN iter, XEN text, XEN len, XEN tags)
+static Xen gxg_gtk_text_iter_backward_word_start(Xen iter)
{
- #define H_gtk_text_buffer_insert_with_tags "void gtk_text_buffer_insert_with_tags(GtkTextBuffer* buffer, \
-GtkTextIter* iter, gchar* text, gint len, etc tags)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_with_tags", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_insert_with_tags", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_text_buffer_insert_with_tags", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 4, "gtk_text_buffer_insert_with_tags", "gint");
- XEN_ASSERT_TYPE(XEN_etc_P(tags), tags, 5, "gtk_text_buffer_insert_with_tags", "etc");
- {
- int etc_len = 0;
- GtkTextBuffer* p_arg0;
- GtkTextIter* p_arg1;
- gchar* p_arg2;
- gint p_arg3;
- if (XEN_LIST_P(tags)) etc_len = XEN_LIST_LENGTH(tags);
- if (etc_len < 1) XEN_OUT_OF_RANGE_ERROR("gtk_text_buffer_insert_with_tags", 4, tags, "... list must have at least 1 entry");
- if (etc_len > 6) XEN_OUT_OF_RANGE_ERROR("gtk_text_buffer_insert_with_tags", 4, tags, "... list too long (max len: 6)");
- p_arg0 = XEN_TO_C_GtkTextBuffer_(buffer);
- p_arg1 = XEN_TO_C_GtkTextIter_(iter);
- p_arg2 = XEN_TO_C_gchar_(text);
- p_arg3 = XEN_TO_C_gint(len);
- switch (etc_len)
- {
- case 1: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), NULL); break;
- case 2: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), NULL); break;
- case 3: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), XLT(tags, 2), NULL); break;
- case 4: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), XLT(tags, 2), XLT(tags, 3), NULL); break;
- case 5: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), XLT(tags, 2), XLT(tags, 3), XLT(tags, 4), NULL); break;
- case 6: gtk_text_buffer_insert_with_tags(p_arg0, p_arg1, p_arg2, p_arg3, XLT(tags, 0), XLT(tags, 1), XLT(tags, 2), XLT(tags, 3), XLT(tags, 4), XLT(tags, 5), NULL); break;
- }
- return(XEN_FALSE);
- }
+ #define H_gtk_text_iter_backward_word_start "gboolean gtk_text_iter_backward_word_start(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_word_start", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_word_start(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_insert_with_tags_by_name(XEN buffer, XEN iter, XEN text, XEN len, XEN tags)
+static Xen gxg_gtk_text_iter_forward_word_ends(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_insert_with_tags_by_name "void gtk_text_buffer_insert_with_tags_by_name(GtkTextBuffer* buffer, \
-GtkTextIter* iter, gchar* text, gint len, etc tags)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_with_tags_by_name", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_insert_with_tags_by_name", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_text_buffer_insert_with_tags_by_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 4, "gtk_text_buffer_insert_with_tags_by_name", "gint");
- XEN_ASSERT_TYPE(XEN_etc_P(tags), tags, 5, "gtk_text_buffer_insert_with_tags_by_name", "etc");
- {
- int etc_len = 0;
- GtkTextBuffer* p_arg0;
- GtkTextIter* p_arg1;
- gchar* p_arg2;
- gint p_arg3;
- if (XEN_LIST_P(tags)) etc_len = XEN_LIST_LENGTH(tags);
- if (etc_len < 1) XEN_OUT_OF_RANGE_ERROR("gtk_text_buffer_insert_with_tags_by_name", 4, tags, "... list must have at least 1 entry");
- if (etc_len > 6) XEN_OUT_OF_RANGE_ERROR("gtk_text_buffer_insert_with_tags_by_name", 4, tags, "... list too long (max len: 6)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_text_buffer_insert_with_tags_by_name", 4, tags, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_GtkTextBuffer_(buffer);
- p_arg1 = XEN_TO_C_GtkTextIter_(iter);
- p_arg2 = XEN_TO_C_gchar_(text);
- p_arg3 = XEN_TO_C_gint(len);
- switch (etc_len)
- {
- case 1: gtk_text_buffer_insert_with_tags_by_name(p_arg0, p_arg1, p_arg2, p_arg3, XLS(tags, 0), NULL); break;
- case 3: gtk_text_buffer_insert_with_tags_by_name(p_arg0, p_arg1, p_arg2, p_arg3, XLS(tags, 0), XLI(tags, 1), XLS(tags, 2), NULL); break;
- case 5: gtk_text_buffer_insert_with_tags_by_name(p_arg0, p_arg1, p_arg2, p_arg3, XLS(tags, 0), XLI(tags, 1), XLS(tags, 2), XLI(tags, 3), XLS(tags, 4), NULL); break;
- }
- return(XEN_FALSE);
- }
+ #define H_gtk_text_iter_forward_word_ends "gboolean gtk_text_iter_forward_word_ends(GtkTextIter* iter, \
+gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_word_ends", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_forward_word_ends", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_word_ends(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_delete(XEN buffer, XEN start, XEN end)
+static Xen gxg_gtk_text_iter_backward_word_starts(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_delete "void gtk_text_buffer_delete(GtkTextBuffer* buffer, GtkTextIter* start, \
-GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_delete", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 2, "gtk_text_buffer_delete", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 3, "gtk_text_buffer_delete", "GtkTextIter*");
- gtk_text_buffer_delete(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_backward_word_starts "gboolean gtk_text_iter_backward_word_starts(GtkTextIter* iter, \
+gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_word_starts", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_backward_word_starts", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_word_starts(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_delete_interactive(XEN buffer, XEN start_iter, XEN end_iter, XEN default_editable)
+static Xen gxg_gtk_text_iter_forward_sentence_end(Xen iter)
{
- #define H_gtk_text_buffer_delete_interactive "gboolean gtk_text_buffer_delete_interactive(GtkTextBuffer* buffer, \
-GtkTextIter* start_iter, GtkTextIter* end_iter, gboolean default_editable)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_delete_interactive", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start_iter), start_iter, 2, "gtk_text_buffer_delete_interactive", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end_iter), end_iter, 3, "gtk_text_buffer_delete_interactive", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editable), default_editable, 4, "gtk_text_buffer_delete_interactive", "gboolean");
- return(C_TO_XEN_gboolean(gtk_text_buffer_delete_interactive(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(start_iter),
- XEN_TO_C_GtkTextIter_(end_iter), XEN_TO_C_gboolean(default_editable))));
+ #define H_gtk_text_iter_forward_sentence_end "gboolean gtk_text_iter_forward_sentence_end(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_sentence_end", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_sentence_end(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_get_text(XEN buffer, XEN start, XEN end, XEN include_hidden_chars)
+static Xen gxg_gtk_text_iter_backward_sentence_start(Xen iter)
{
- #define H_gtk_text_buffer_get_text "gchar* gtk_text_buffer_get_text(GtkTextBuffer* buffer, GtkTextIter* start, \
-GtkTextIter* end, gboolean include_hidden_chars)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_text", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 2, "gtk_text_buffer_get_text", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 3, "gtk_text_buffer_get_text", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(include_hidden_chars), include_hidden_chars, 4, "gtk_text_buffer_get_text", "gboolean");
- {
- gchar* result;
- XEN rtn;
- result = gtk_text_buffer_get_text(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(start),
- XEN_TO_C_GtkTextIter_(end), XEN_TO_C_gboolean(include_hidden_chars));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_text_iter_backward_sentence_start "gboolean gtk_text_iter_backward_sentence_start(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_sentence_start", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_sentence_start(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_get_slice(XEN buffer, XEN start, XEN end, XEN include_hidden_chars)
+static Xen gxg_gtk_text_iter_forward_sentence_ends(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_get_slice "gchar* gtk_text_buffer_get_slice(GtkTextBuffer* buffer, GtkTextIter* start, \
-GtkTextIter* end, gboolean include_hidden_chars)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_slice", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 2, "gtk_text_buffer_get_slice", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 3, "gtk_text_buffer_get_slice", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(include_hidden_chars), include_hidden_chars, 4, "gtk_text_buffer_get_slice", "gboolean");
- {
- gchar* result;
- XEN rtn;
- result = gtk_text_buffer_get_slice(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(start),
- XEN_TO_C_GtkTextIter_(end), XEN_TO_C_gboolean(include_hidden_chars));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_text_iter_forward_sentence_ends "gboolean gtk_text_iter_forward_sentence_ends(GtkTextIter* iter, \
+gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_sentence_ends", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_forward_sentence_ends", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_sentence_ends(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_insert_pixbuf(XEN buffer, XEN iter, XEN pixbuf)
+static Xen gxg_gtk_text_iter_backward_sentence_starts(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_insert_pixbuf "void gtk_text_buffer_insert_pixbuf(GtkTextBuffer* buffer, \
-GtkTextIter* iter, GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_pixbuf", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_insert_pixbuf", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 3, "gtk_text_buffer_insert_pixbuf", "GdkPixbuf*");
- gtk_text_buffer_insert_pixbuf(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_backward_sentence_starts "gboolean gtk_text_iter_backward_sentence_starts(GtkTextIter* iter, \
+gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_sentence_starts", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_backward_sentence_starts", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_sentence_starts(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_insert_child_anchor(XEN buffer, XEN iter, XEN anchor)
+static Xen gxg_gtk_text_iter_forward_cursor_position(Xen iter)
{
- #define H_gtk_text_buffer_insert_child_anchor "void gtk_text_buffer_insert_child_anchor(GtkTextBuffer* buffer, \
-GtkTextIter* iter, GtkTextChildAnchor* anchor)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_insert_child_anchor", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_insert_child_anchor", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextChildAnchor__P(anchor), anchor, 3, "gtk_text_buffer_insert_child_anchor", "GtkTextChildAnchor*");
- gtk_text_buffer_insert_child_anchor(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextChildAnchor_(anchor));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_cursor_position "gboolean gtk_text_iter_forward_cursor_position(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_cursor_position", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_cursor_position(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_create_child_anchor(XEN buffer, XEN iter)
+static Xen gxg_gtk_text_iter_backward_cursor_position(Xen iter)
{
- #define H_gtk_text_buffer_create_child_anchor "GtkTextChildAnchor* gtk_text_buffer_create_child_anchor(GtkTextBuffer* buffer, \
-GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_create_child_anchor", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_create_child_anchor", "GtkTextIter*");
- return(C_TO_XEN_GtkTextChildAnchor_(gtk_text_buffer_create_child_anchor(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_iter_backward_cursor_position "gboolean gtk_text_iter_backward_cursor_position(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_cursor_position", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_cursor_position(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_create_mark(XEN buffer, XEN mark_name, XEN where, XEN left_gravity)
+static Xen gxg_gtk_text_iter_forward_cursor_positions(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_create_mark "GtkTextMark* gtk_text_buffer_create_mark(GtkTextBuffer* buffer, \
-gchar* mark_name, GtkTextIter* where, gboolean left_gravity)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_create_mark", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(mark_name), mark_name, 2, "gtk_text_buffer_create_mark", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(where), where, 3, "gtk_text_buffer_create_mark", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(left_gravity), left_gravity, 4, "gtk_text_buffer_create_mark", "gboolean");
- return(C_TO_XEN_GtkTextMark_(gtk_text_buffer_create_mark(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(mark_name), XEN_TO_C_GtkTextIter_(where),
- XEN_TO_C_gboolean(left_gravity))));
-}
-
-static XEN gxg_gtk_text_buffer_move_mark(XEN buffer, XEN mark, XEN where)
-{
- #define H_gtk_text_buffer_move_mark "void gtk_text_buffer_move_mark(GtkTextBuffer* buffer, GtkTextMark* mark, \
-GtkTextIter* where)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_move_mark", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 2, "gtk_text_buffer_move_mark", "GtkTextMark*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(where), where, 3, "gtk_text_buffer_move_mark", "GtkTextIter*");
- gtk_text_buffer_move_mark(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextMark_(mark), XEN_TO_C_GtkTextIter_(where));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_cursor_positions "gboolean gtk_text_iter_forward_cursor_positions(GtkTextIter* iter, \
+gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_cursor_positions", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_forward_cursor_positions", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_cursor_positions(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_delete_mark(XEN buffer, XEN mark)
+static Xen gxg_gtk_text_iter_backward_cursor_positions(Xen iter, Xen count)
{
- #define H_gtk_text_buffer_delete_mark "void gtk_text_buffer_delete_mark(GtkTextBuffer* buffer, GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_delete_mark", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 2, "gtk_text_buffer_delete_mark", "GtkTextMark*");
- gtk_text_buffer_delete_mark(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextMark_(mark));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_backward_cursor_positions "gboolean gtk_text_iter_backward_cursor_positions(GtkTextIter* iter, \
+gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_cursor_positions", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_backward_cursor_positions", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_cursor_positions(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_buffer_get_mark(XEN buffer, XEN name)
+static Xen gxg_gtk_text_iter_set_offset(Xen iter, Xen char_offset)
{
- #define H_gtk_text_buffer_get_mark "GtkTextMark* gtk_text_buffer_get_mark(GtkTextBuffer* buffer, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_mark", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_text_buffer_get_mark", "gchar*");
- return(C_TO_XEN_GtkTextMark_(gtk_text_buffer_get_mark(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(name))));
+ #define H_gtk_text_iter_set_offset "void gtk_text_iter_set_offset(GtkTextIter* iter, gint char_offset)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_set_offset", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(char_offset), char_offset, 2, "gtk_text_iter_set_offset", "gint");
+ gtk_text_iter_set_offset(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(char_offset));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_move_mark_by_name(XEN buffer, XEN name, XEN where)
+static Xen gxg_gtk_text_iter_set_line(Xen iter, Xen line_number)
{
- #define H_gtk_text_buffer_move_mark_by_name "void gtk_text_buffer_move_mark_by_name(GtkTextBuffer* buffer, \
-gchar* name, GtkTextIter* where)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_move_mark_by_name", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_text_buffer_move_mark_by_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(where), where, 3, "gtk_text_buffer_move_mark_by_name", "GtkTextIter*");
- gtk_text_buffer_move_mark_by_name(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(name), XEN_TO_C_GtkTextIter_(where));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_set_line "void gtk_text_iter_set_line(GtkTextIter* iter, gint line_number)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_set_line", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(line_number), line_number, 2, "gtk_text_iter_set_line", "gint");
+ gtk_text_iter_set_line(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(line_number));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_delete_mark_by_name(XEN buffer, XEN name)
+static Xen gxg_gtk_text_iter_set_line_offset(Xen iter, Xen char_on_line)
{
- #define H_gtk_text_buffer_delete_mark_by_name "void gtk_text_buffer_delete_mark_by_name(GtkTextBuffer* buffer, \
-gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_delete_mark_by_name", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_text_buffer_delete_mark_by_name", "gchar*");
- gtk_text_buffer_delete_mark_by_name(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_set_line_offset "void gtk_text_iter_set_line_offset(GtkTextIter* iter, gint char_on_line)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_set_line_offset", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(char_on_line), char_on_line, 2, "gtk_text_iter_set_line_offset", "gint");
+ gtk_text_iter_set_line_offset(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(char_on_line));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_get_insert(XEN buffer)
+static Xen gxg_gtk_text_iter_set_line_index(Xen iter, Xen byte_on_line)
{
- #define H_gtk_text_buffer_get_insert "GtkTextMark* gtk_text_buffer_get_insert(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_insert", "GtkTextBuffer*");
- return(C_TO_XEN_GtkTextMark_(gtk_text_buffer_get_insert(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_text_iter_set_line_index "void gtk_text_iter_set_line_index(GtkTextIter* iter, gint byte_on_line)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_set_line_index", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(byte_on_line), byte_on_line, 2, "gtk_text_iter_set_line_index", "gint");
+ gtk_text_iter_set_line_index(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(byte_on_line));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_get_selection_bound(XEN buffer)
+static Xen gxg_gtk_text_iter_forward_to_end(Xen iter)
{
- #define H_gtk_text_buffer_get_selection_bound "GtkTextMark* gtk_text_buffer_get_selection_bound(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_selection_bound", "GtkTextBuffer*");
- return(C_TO_XEN_GtkTextMark_(gtk_text_buffer_get_selection_bound(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_text_iter_forward_to_end "void gtk_text_iter_forward_to_end(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_to_end", "GtkTextIter*");
+ gtk_text_iter_forward_to_end(Xen_to_C_GtkTextIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_place_cursor(XEN buffer, XEN where)
+static Xen gxg_gtk_text_iter_forward_to_line_end(Xen iter)
{
- #define H_gtk_text_buffer_place_cursor "void gtk_text_buffer_place_cursor(GtkTextBuffer* buffer, GtkTextIter* where)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_place_cursor", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(where), where, 2, "gtk_text_buffer_place_cursor", "GtkTextIter*");
- gtk_text_buffer_place_cursor(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(where));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_to_line_end "gboolean gtk_text_iter_forward_to_line_end(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_to_line_end", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_to_line_end(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_apply_tag(XEN buffer, XEN tag, XEN start, XEN end)
+static Xen gxg_gtk_text_iter_set_visible_line_offset(Xen iter, Xen char_on_line)
{
- #define H_gtk_text_buffer_apply_tag "void gtk_text_buffer_apply_tag(GtkTextBuffer* buffer, GtkTextTag* tag, \
-GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_apply_tag", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag), tag, 2, "gtk_text_buffer_apply_tag", "GtkTextTag*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 3, "gtk_text_buffer_apply_tag", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 4, "gtk_text_buffer_apply_tag", "GtkTextIter*");
- gtk_text_buffer_apply_tag(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextTag_(tag), XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_set_visible_line_offset "void gtk_text_iter_set_visible_line_offset(GtkTextIter* iter, \
+gint char_on_line)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_set_visible_line_offset", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(char_on_line), char_on_line, 2, "gtk_text_iter_set_visible_line_offset", "gint");
+ gtk_text_iter_set_visible_line_offset(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(char_on_line));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_remove_tag(XEN buffer, XEN tag, XEN start, XEN end)
+static Xen gxg_gtk_text_iter_set_visible_line_index(Xen iter, Xen byte_on_line)
{
- #define H_gtk_text_buffer_remove_tag "void gtk_text_buffer_remove_tag(GtkTextBuffer* buffer, GtkTextTag* tag, \
-GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_remove_tag", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag), tag, 2, "gtk_text_buffer_remove_tag", "GtkTextTag*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 3, "gtk_text_buffer_remove_tag", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 4, "gtk_text_buffer_remove_tag", "GtkTextIter*");
- gtk_text_buffer_remove_tag(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextTag_(tag), XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_set_visible_line_index "void gtk_text_iter_set_visible_line_index(GtkTextIter* iter, \
+gint byte_on_line)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_set_visible_line_index", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(byte_on_line), byte_on_line, 2, "gtk_text_iter_set_visible_line_index", "gint");
+ gtk_text_iter_set_visible_line_index(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(byte_on_line));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_apply_tag_by_name(XEN buffer, XEN name, XEN start, XEN end)
+static Xen gxg_gtk_text_iter_forward_to_tag_toggle(Xen iter, Xen tag)
{
- #define H_gtk_text_buffer_apply_tag_by_name "void gtk_text_buffer_apply_tag_by_name(GtkTextBuffer* buffer, \
-gchar* name, GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_apply_tag_by_name", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_text_buffer_apply_tag_by_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 3, "gtk_text_buffer_apply_tag_by_name", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 4, "gtk_text_buffer_apply_tag_by_name", "GtkTextIter*");
- gtk_text_buffer_apply_tag_by_name(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(name), XEN_TO_C_GtkTextIter_(start),
- XEN_TO_C_GtkTextIter_(end));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_to_tag_toggle "gboolean gtk_text_iter_forward_to_tag_toggle(GtkTextIter* iter, \
+GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_to_tag_toggle", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag) || Xen_is_false(tag), tag, 2, "gtk_text_iter_forward_to_tag_toggle", "GtkTextTag*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_to_tag_toggle(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextTag_(tag))));
}
-static XEN gxg_gtk_text_buffer_remove_tag_by_name(XEN buffer, XEN name, XEN start, XEN end)
+static Xen gxg_gtk_text_iter_backward_to_tag_toggle(Xen iter, Xen tag)
{
- #define H_gtk_text_buffer_remove_tag_by_name "void gtk_text_buffer_remove_tag_by_name(GtkTextBuffer* buffer, \
-gchar* name, GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_remove_tag_by_name", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_text_buffer_remove_tag_by_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 3, "gtk_text_buffer_remove_tag_by_name", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 4, "gtk_text_buffer_remove_tag_by_name", "GtkTextIter*");
- gtk_text_buffer_remove_tag_by_name(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(name), XEN_TO_C_GtkTextIter_(start),
- XEN_TO_C_GtkTextIter_(end));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_backward_to_tag_toggle "gboolean gtk_text_iter_backward_to_tag_toggle(GtkTextIter* iter, \
+GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_to_tag_toggle", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag) || Xen_is_false(tag), tag, 2, "gtk_text_iter_backward_to_tag_toggle", "GtkTextTag*");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_to_tag_toggle(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextTag_(tag))));
}
-static XEN gxg_gtk_text_buffer_remove_all_tags(XEN buffer, XEN start, XEN end)
+static Xen gxg_gtk_text_iter_forward_find_char(Xen iter, Xen pred, Xen func_info, Xen limit)
{
- #define H_gtk_text_buffer_remove_all_tags "void gtk_text_buffer_remove_all_tags(GtkTextBuffer* buffer, \
-GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_remove_all_tags", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 2, "gtk_text_buffer_remove_all_tags", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 3, "gtk_text_buffer_remove_all_tags", "GtkTextIter*");
- gtk_text_buffer_remove_all_tags(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_find_char "gboolean gtk_text_iter_forward_find_char(GtkTextIter* iter, \
+GtkTextCharPredicate pred, lambda_data func_info, GtkTextIter* limit)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_find_char", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextCharPredicate(pred), pred, 2, "gtk_text_iter_forward_find_char", "GtkTextCharPredicate");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_text_iter_forward_find_char", "lambda_data");
+ Xen_check_type(Xen_is_GtkTextIter_(limit) || Xen_is_false(limit), limit, 4, "gtk_text_iter_forward_find_char", "GtkTextIter*");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(Xen_false, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_gboolean(gtk_text_iter_forward_find_char(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextCharPredicate(pred),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GtkTextIter_(limit)));
+ xm_unprotect_at(loc);
+ return(result);
+ }
}
-static XEN gxg_gtk_text_buffer_create_tag(XEN buffer, XEN tag_name, XEN tags)
+static Xen gxg_gtk_text_iter_backward_find_char(Xen iter, Xen pred, Xen func_info, Xen limit)
{
- #define H_gtk_text_buffer_create_tag "GtkTextTag* gtk_text_buffer_create_tag(GtkTextBuffer* buffer, \
-gchar* tag_name, etc tags)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_create_tag", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(tag_name), tag_name, 2, "gtk_text_buffer_create_tag", "gchar*");
- if (XEN_NOT_BOUND_P(tags)) tags = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_etc_P(tags), tags, 3, "gtk_text_buffer_create_tag", "etc");
+ #define H_gtk_text_iter_backward_find_char "gboolean gtk_text_iter_backward_find_char(GtkTextIter* iter, \
+GtkTextCharPredicate pred, lambda_data func_info, GtkTextIter* limit)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_find_char", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextCharPredicate(pred), pred, 2, "gtk_text_iter_backward_find_char", "GtkTextCharPredicate");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_text_iter_backward_find_char", "lambda_data");
+ Xen_check_type(Xen_is_GtkTextIter_(limit) || Xen_is_false(limit), limit, 4, "gtk_text_iter_backward_find_char", "GtkTextIter*");
{
- int etc_len = 0;
- GtkTextTag* result = NULL;
- GtkTextBuffer* p_arg0;
- gchar* p_arg1;
- if (XEN_LIST_P(tags)) etc_len = XEN_LIST_LENGTH(tags);
- if (etc_len > 6) XEN_OUT_OF_RANGE_ERROR("gtk_text_buffer_create_tag", 2, tags, "... list too long (max len: 6)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_text_buffer_create_tag", 2, tags, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_GtkTextBuffer_(buffer);
- p_arg1 = XEN_TO_C_gchar_(tag_name);
- switch (etc_len)
- {
- case 0: result = gtk_text_buffer_create_tag(p_arg0, p_arg1, NULL); break;
- case 2: result = gtk_text_buffer_create_tag(p_arg0, p_arg1, XLS(tags, 0), XLI(tags, 1), NULL); break;
- case 4: result = gtk_text_buffer_create_tag(p_arg0, p_arg1, XLS(tags, 0), XLI(tags, 1), XLS(tags, 2), XLI(tags, 3), NULL); break;
- case 6: result = gtk_text_buffer_create_tag(p_arg0, p_arg1, XLS(tags, 0), XLI(tags, 1), XLS(tags, 2), XLI(tags, 3), XLS(tags, 4), XLI(tags, 5), NULL); break;
- }
- return(C_TO_XEN_GtkTextTag_(result));
- }
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(Xen_false, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_gboolean(gtk_text_iter_backward_find_char(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextCharPredicate(pred),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GtkTextIter_(limit)));
+ xm_unprotect_at(loc);
+ return(result);
+ }
}
-static XEN gxg_gtk_text_buffer_get_iter_at_line_offset(XEN buffer, XEN iter, XEN line_number, XEN char_offset)
+static Xen gxg_gtk_text_iter_forward_search(Xen iter, Xen str, Xen flags, Xen match_start, Xen match_end, Xen limit)
{
- #define H_gtk_text_buffer_get_iter_at_line_offset "void gtk_text_buffer_get_iter_at_line_offset(GtkTextBuffer* buffer, \
-GtkTextIter* iter, gint line_number, gint char_offset)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_line_offset", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_get_iter_at_line_offset", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(line_number), line_number, 3, "gtk_text_buffer_get_iter_at_line_offset", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(char_offset), char_offset, 4, "gtk_text_buffer_get_iter_at_line_offset", "gint");
- gtk_text_buffer_get_iter_at_line_offset(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(line_number),
- XEN_TO_C_gint(char_offset));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_search "gboolean gtk_text_iter_forward_search(GtkTextIter* iter, gchar* str, \
+GtkTextSearchFlags flags, GtkTextIter* match_start, GtkTextIter* match_end, GtkTextIter* limit)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_search", "GtkTextIter*");
+ Xen_check_type(Xen_is_gchar_(str), str, 2, "gtk_text_iter_forward_search", "gchar*");
+ Xen_check_type(Xen_is_GtkTextSearchFlags(flags), flags, 3, "gtk_text_iter_forward_search", "GtkTextSearchFlags");
+ Xen_check_type(Xen_is_GtkTextIter_(match_start) || Xen_is_false(match_start), match_start, 4, "gtk_text_iter_forward_search", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(match_end) || Xen_is_false(match_end), match_end, 5, "gtk_text_iter_forward_search", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(limit) || Xen_is_false(limit), limit, 6, "gtk_text_iter_forward_search", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_search(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gchar_(str), Xen_to_C_GtkTextSearchFlags(flags),
+ Xen_to_C_GtkTextIter_(match_start), Xen_to_C_GtkTextIter_(match_end),
+ Xen_to_C_GtkTextIter_(limit))));
}
-static XEN gxg_gtk_text_buffer_get_iter_at_line_index(XEN buffer, XEN iter, XEN line_number, XEN byte_index)
+static Xen gxg_gtk_text_iter_backward_search(Xen iter, Xen str, Xen flags, Xen match_start, Xen match_end, Xen limit)
{
- #define H_gtk_text_buffer_get_iter_at_line_index "void gtk_text_buffer_get_iter_at_line_index(GtkTextBuffer* buffer, \
-GtkTextIter* iter, gint line_number, gint byte_index)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_line_index", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_get_iter_at_line_index", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(line_number), line_number, 3, "gtk_text_buffer_get_iter_at_line_index", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(byte_index), byte_index, 4, "gtk_text_buffer_get_iter_at_line_index", "gint");
- gtk_text_buffer_get_iter_at_line_index(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(line_number),
- XEN_TO_C_gint(byte_index));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_backward_search "gboolean gtk_text_iter_backward_search(GtkTextIter* iter, \
+gchar* str, GtkTextSearchFlags flags, GtkTextIter* match_start, GtkTextIter* match_end, GtkTextIter* limit)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_search", "GtkTextIter*");
+ Xen_check_type(Xen_is_gchar_(str), str, 2, "gtk_text_iter_backward_search", "gchar*");
+ Xen_check_type(Xen_is_GtkTextSearchFlags(flags), flags, 3, "gtk_text_iter_backward_search", "GtkTextSearchFlags");
+ Xen_check_type(Xen_is_GtkTextIter_(match_start) || Xen_is_false(match_start), match_start, 4, "gtk_text_iter_backward_search", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(match_end) || Xen_is_false(match_end), match_end, 5, "gtk_text_iter_backward_search", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(limit) || Xen_is_false(limit), limit, 6, "gtk_text_iter_backward_search", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_search(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gchar_(str), Xen_to_C_GtkTextSearchFlags(flags),
+ Xen_to_C_GtkTextIter_(match_start), Xen_to_C_GtkTextIter_(match_end),
+ Xen_to_C_GtkTextIter_(limit))));
}
-static XEN gxg_gtk_text_buffer_get_iter_at_offset(XEN buffer, XEN iter, XEN char_offset)
+static Xen gxg_gtk_text_iter_equal(Xen lhs, Xen rhs)
{
- #define H_gtk_text_buffer_get_iter_at_offset "void gtk_text_buffer_get_iter_at_offset(GtkTextBuffer* buffer, \
-GtkTextIter* iter, gint char_offset)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_offset", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_get_iter_at_offset", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(char_offset), char_offset, 3, "gtk_text_buffer_get_iter_at_offset", "gint");
- gtk_text_buffer_get_iter_at_offset(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(char_offset));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_equal "gboolean gtk_text_iter_equal(GtkTextIter* lhs, GtkTextIter* rhs)"
+ Xen_check_type(Xen_is_GtkTextIter_(lhs), lhs, 1, "gtk_text_iter_equal", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(rhs), rhs, 2, "gtk_text_iter_equal", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_equal(Xen_to_C_GtkTextIter_(lhs), Xen_to_C_GtkTextIter_(rhs))));
}
-static XEN gxg_gtk_text_buffer_get_iter_at_line(XEN buffer, XEN iter, XEN line_number)
+static Xen gxg_gtk_text_iter_compare(Xen lhs, Xen rhs)
{
- #define H_gtk_text_buffer_get_iter_at_line "void gtk_text_buffer_get_iter_at_line(GtkTextBuffer* buffer, \
-GtkTextIter* iter, gint line_number)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_line", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_get_iter_at_line", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(line_number), line_number, 3, "gtk_text_buffer_get_iter_at_line", "gint");
- gtk_text_buffer_get_iter_at_line(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(line_number));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_compare "gint gtk_text_iter_compare(GtkTextIter* lhs, GtkTextIter* rhs)"
+ Xen_check_type(Xen_is_GtkTextIter_(lhs), lhs, 1, "gtk_text_iter_compare", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(rhs), rhs, 2, "gtk_text_iter_compare", "GtkTextIter*");
+ return(C_to_Xen_gint(gtk_text_iter_compare(Xen_to_C_GtkTextIter_(lhs), Xen_to_C_GtkTextIter_(rhs))));
}
-static XEN gxg_gtk_text_buffer_get_start_iter(XEN buffer, XEN iter)
+static Xen gxg_gtk_text_iter_in_range(Xen iter, Xen start, Xen end)
{
- #define H_gtk_text_buffer_get_start_iter "void gtk_text_buffer_get_start_iter(GtkTextBuffer* buffer, \
-GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_start_iter", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_get_start_iter", "GtkTextIter*");
- gtk_text_buffer_get_start_iter(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_in_range "gboolean gtk_text_iter_in_range(GtkTextIter* iter, GtkTextIter* start, \
+GtkTextIter* end)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_in_range", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 2, "gtk_text_iter_in_range", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 3, "gtk_text_iter_in_range", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_in_range(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end))));
}
-static XEN gxg_gtk_text_buffer_get_end_iter(XEN buffer, XEN iter)
+static Xen gxg_gtk_text_iter_order(Xen first, Xen second)
{
- #define H_gtk_text_buffer_get_end_iter "void gtk_text_buffer_get_end_iter(GtkTextBuffer* buffer, GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_end_iter", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_get_end_iter", "GtkTextIter*");
- gtk_text_buffer_get_end_iter(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_order "void gtk_text_iter_order(GtkTextIter* first, GtkTextIter* second)"
+ Xen_check_type(Xen_is_GtkTextIter_(first), first, 1, "gtk_text_iter_order", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(second), second, 2, "gtk_text_iter_order", "GtkTextIter*");
+ gtk_text_iter_order(Xen_to_C_GtkTextIter_(first), Xen_to_C_GtkTextIter_(second));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_get_bounds(XEN buffer, XEN start, XEN end)
+static Xen gxg_gtk_text_mark_set_visible(Xen mark, Xen setting)
{
- #define H_gtk_text_buffer_get_bounds "void gtk_text_buffer_get_bounds(GtkTextBuffer* buffer, GtkTextIter* start, \
-GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_bounds", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 2, "gtk_text_buffer_get_bounds", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 3, "gtk_text_buffer_get_bounds", "GtkTextIter*");
- gtk_text_buffer_get_bounds(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- return(XEN_FALSE);
+ #define H_gtk_text_mark_set_visible "void gtk_text_mark_set_visible(GtkTextMark* mark, gboolean setting)"
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 1, "gtk_text_mark_set_visible", "GtkTextMark*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_text_mark_set_visible", "gboolean");
+ gtk_text_mark_set_visible(Xen_to_C_GtkTextMark_(mark), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_get_iter_at_mark(XEN buffer, XEN iter, XEN mark)
+static Xen gxg_gtk_text_mark_get_visible(Xen mark)
{
- #define H_gtk_text_buffer_get_iter_at_mark "void gtk_text_buffer_get_iter_at_mark(GtkTextBuffer* buffer, \
-GtkTextIter* iter, GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_mark", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_get_iter_at_mark", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 3, "gtk_text_buffer_get_iter_at_mark", "GtkTextMark*");
- gtk_text_buffer_get_iter_at_mark(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextMark_(mark));
- return(XEN_FALSE);
+ #define H_gtk_text_mark_get_visible "gboolean gtk_text_mark_get_visible(GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 1, "gtk_text_mark_get_visible", "GtkTextMark*");
+ return(C_to_Xen_gboolean(gtk_text_mark_get_visible(Xen_to_C_GtkTextMark_(mark))));
}
-static XEN gxg_gtk_text_buffer_get_iter_at_child_anchor(XEN buffer, XEN iter, XEN anchor)
+static Xen gxg_gtk_text_mark_get_name(Xen mark)
{
- #define H_gtk_text_buffer_get_iter_at_child_anchor "void gtk_text_buffer_get_iter_at_child_anchor(GtkTextBuffer* buffer, \
-GtkTextIter* iter, GtkTextChildAnchor* anchor)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_iter_at_child_anchor", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_get_iter_at_child_anchor", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextChildAnchor__P(anchor), anchor, 3, "gtk_text_buffer_get_iter_at_child_anchor", "GtkTextChildAnchor*");
- gtk_text_buffer_get_iter_at_child_anchor(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextChildAnchor_(anchor));
- return(XEN_FALSE);
+ #define H_gtk_text_mark_get_name "char* gtk_text_mark_get_name(GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 1, "gtk_text_mark_get_name", "GtkTextMark*");
+ return(C_to_Xen_char_(gtk_text_mark_get_name(Xen_to_C_GtkTextMark_(mark))));
}
-static XEN gxg_gtk_text_buffer_get_modified(XEN buffer)
+static Xen gxg_gtk_text_mark_get_deleted(Xen mark)
{
- #define H_gtk_text_buffer_get_modified "gboolean gtk_text_buffer_get_modified(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_modified", "GtkTextBuffer*");
- return(C_TO_XEN_gboolean(gtk_text_buffer_get_modified(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_text_mark_get_deleted "gboolean gtk_text_mark_get_deleted(GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 1, "gtk_text_mark_get_deleted", "GtkTextMark*");
+ return(C_to_Xen_gboolean(gtk_text_mark_get_deleted(Xen_to_C_GtkTextMark_(mark))));
}
-static XEN gxg_gtk_text_buffer_set_modified(XEN buffer, XEN setting)
+static Xen gxg_gtk_text_mark_get_buffer(Xen mark)
{
- #define H_gtk_text_buffer_set_modified "void gtk_text_buffer_set_modified(GtkTextBuffer* buffer, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_set_modified", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_text_buffer_set_modified", "gboolean");
- gtk_text_buffer_set_modified(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_text_mark_get_buffer "GtkTextBuffer* gtk_text_mark_get_buffer(GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 1, "gtk_text_mark_get_buffer", "GtkTextMark*");
+ return(C_to_Xen_GtkTextBuffer_(gtk_text_mark_get_buffer(Xen_to_C_GtkTextMark_(mark))));
}
-static XEN gxg_gtk_text_buffer_add_selection_clipboard(XEN buffer, XEN clipboard)
+static Xen gxg_gtk_text_mark_get_left_gravity(Xen mark)
{
- #define H_gtk_text_buffer_add_selection_clipboard "void gtk_text_buffer_add_selection_clipboard(GtkTextBuffer* buffer, \
-GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_add_selection_clipboard", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 2, "gtk_text_buffer_add_selection_clipboard", "GtkClipboard*");
- gtk_text_buffer_add_selection_clipboard(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkClipboard_(clipboard));
- return(XEN_FALSE);
+ #define H_gtk_text_mark_get_left_gravity "gboolean gtk_text_mark_get_left_gravity(GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 1, "gtk_text_mark_get_left_gravity", "GtkTextMark*");
+ return(C_to_Xen_gboolean(gtk_text_mark_get_left_gravity(Xen_to_C_GtkTextMark_(mark))));
}
-static XEN gxg_gtk_text_buffer_remove_selection_clipboard(XEN buffer, XEN clipboard)
+static Xen gxg_gtk_text_tag_new(Xen name)
{
- #define H_gtk_text_buffer_remove_selection_clipboard "void gtk_text_buffer_remove_selection_clipboard(GtkTextBuffer* buffer, \
-GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_remove_selection_clipboard", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 2, "gtk_text_buffer_remove_selection_clipboard", "GtkClipboard*");
- gtk_text_buffer_remove_selection_clipboard(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkClipboard_(clipboard));
- return(XEN_FALSE);
+ #define H_gtk_text_tag_new "GtkTextTag* gtk_text_tag_new(gchar* name)"
+ Xen_check_type(Xen_is_gchar_(name), name, 1, "gtk_text_tag_new", "gchar*");
+ return(C_to_Xen_GtkTextTag_(gtk_text_tag_new(Xen_to_C_gchar_(name))));
}
-static XEN gxg_gtk_text_buffer_cut_clipboard(XEN buffer, XEN clipboard, XEN default_editable)
+static Xen gxg_gtk_text_tag_get_priority(Xen tag)
{
- #define H_gtk_text_buffer_cut_clipboard "void gtk_text_buffer_cut_clipboard(GtkTextBuffer* buffer, \
-GtkClipboard* clipboard, gboolean default_editable)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_cut_clipboard", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 2, "gtk_text_buffer_cut_clipboard", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editable), default_editable, 3, "gtk_text_buffer_cut_clipboard", "gboolean");
- gtk_text_buffer_cut_clipboard(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_gboolean(default_editable));
- return(XEN_FALSE);
+ #define H_gtk_text_tag_get_priority "gint gtk_text_tag_get_priority(GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 1, "gtk_text_tag_get_priority", "GtkTextTag*");
+ return(C_to_Xen_gint(gtk_text_tag_get_priority(Xen_to_C_GtkTextTag_(tag))));
}
-static XEN gxg_gtk_text_buffer_copy_clipboard(XEN buffer, XEN clipboard)
+static Xen gxg_gtk_text_tag_set_priority(Xen tag, Xen priority)
{
- #define H_gtk_text_buffer_copy_clipboard "void gtk_text_buffer_copy_clipboard(GtkTextBuffer* buffer, \
-GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_copy_clipboard", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 2, "gtk_text_buffer_copy_clipboard", "GtkClipboard*");
- gtk_text_buffer_copy_clipboard(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkClipboard_(clipboard));
- return(XEN_FALSE);
+ #define H_gtk_text_tag_set_priority "void gtk_text_tag_set_priority(GtkTextTag* tag, gint priority)"
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 1, "gtk_text_tag_set_priority", "GtkTextTag*");
+ Xen_check_type(Xen_is_gint(priority), priority, 2, "gtk_text_tag_set_priority", "gint");
+ gtk_text_tag_set_priority(Xen_to_C_GtkTextTag_(tag), Xen_to_C_gint(priority));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_paste_clipboard(XEN buffer, XEN clipboard, XEN override_location, XEN default_editable)
+static Xen gxg_gtk_text_tag_event(Xen tag, Xen event_object, Xen event, Xen iter)
{
- #define H_gtk_text_buffer_paste_clipboard "void gtk_text_buffer_paste_clipboard(GtkTextBuffer* buffer, \
-GtkClipboard* clipboard, GtkTextIter* override_location, gboolean default_editable)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_paste_clipboard", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 2, "gtk_text_buffer_paste_clipboard", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(override_location) || XEN_FALSE_P(override_location), override_location, 3, "gtk_text_buffer_paste_clipboard", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editable), default_editable, 4, "gtk_text_buffer_paste_clipboard", "gboolean");
- gtk_text_buffer_paste_clipboard(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkTextIter_(override_location),
- XEN_TO_C_gboolean(default_editable));
- return(XEN_FALSE);
+ #define H_gtk_text_tag_event "gboolean gtk_text_tag_event(GtkTextTag* tag, GObject* event_object, GdkEvent* event, \
+GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 1, "gtk_text_tag_event", "GtkTextTag*");
+ Xen_check_type(Xen_is_GObject_(event_object), event_object, 2, "gtk_text_tag_event", "GObject*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 3, "gtk_text_tag_event", "GdkEvent*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 4, "gtk_text_tag_event", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_tag_event(Xen_to_C_GtkTextTag_(tag), Xen_to_C_GObject_(event_object), Xen_to_C_GdkEvent_(event),
+ Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_buffer_get_selection_bounds(XEN buffer, XEN start, XEN end)
+static Xen gxg_gtk_text_attributes_new(void)
{
- #define H_gtk_text_buffer_get_selection_bounds "gboolean gtk_text_buffer_get_selection_bounds(GtkTextBuffer* buffer, \
-GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_selection_bounds", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 2, "gtk_text_buffer_get_selection_bounds", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 3, "gtk_text_buffer_get_selection_bounds", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_buffer_get_selection_bounds(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(start),
- XEN_TO_C_GtkTextIter_(end))));
+ #define H_gtk_text_attributes_new "GtkTextAttributes* gtk_text_attributes_new( void)"
+ return(C_to_Xen_GtkTextAttributes_(gtk_text_attributes_new()));
}
-static XEN gxg_gtk_text_buffer_delete_selection(XEN buffer, XEN interactive, XEN default_editable)
+static Xen gxg_gtk_text_attributes_copy(Xen src)
{
- #define H_gtk_text_buffer_delete_selection "gboolean gtk_text_buffer_delete_selection(GtkTextBuffer* buffer, \
-gboolean interactive, gboolean default_editable)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_delete_selection", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(interactive), interactive, 2, "gtk_text_buffer_delete_selection", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editable), default_editable, 3, "gtk_text_buffer_delete_selection", "gboolean");
- return(C_TO_XEN_gboolean(gtk_text_buffer_delete_selection(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gboolean(interactive),
- XEN_TO_C_gboolean(default_editable))));
+ #define H_gtk_text_attributes_copy "GtkTextAttributes* gtk_text_attributes_copy(GtkTextAttributes* src)"
+ Xen_check_type(Xen_is_GtkTextAttributes_(src), src, 1, "gtk_text_attributes_copy", "GtkTextAttributes*");
+ return(C_to_Xen_GtkTextAttributes_(gtk_text_attributes_copy(Xen_to_C_GtkTextAttributes_(src))));
}
-static XEN gxg_gtk_text_buffer_begin_user_action(XEN buffer)
+static Xen gxg_gtk_text_attributes_copy_values(Xen src, Xen dest)
{
- #define H_gtk_text_buffer_begin_user_action "void gtk_text_buffer_begin_user_action(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_begin_user_action", "GtkTextBuffer*");
- gtk_text_buffer_begin_user_action(XEN_TO_C_GtkTextBuffer_(buffer));
- return(XEN_FALSE);
+ #define H_gtk_text_attributes_copy_values "void gtk_text_attributes_copy_values(GtkTextAttributes* src, \
+GtkTextAttributes* dest)"
+ Xen_check_type(Xen_is_GtkTextAttributes_(src), src, 1, "gtk_text_attributes_copy_values", "GtkTextAttributes*");
+ Xen_check_type(Xen_is_GtkTextAttributes_(dest), dest, 2, "gtk_text_attributes_copy_values", "GtkTextAttributes*");
+ gtk_text_attributes_copy_values(Xen_to_C_GtkTextAttributes_(src), Xen_to_C_GtkTextAttributes_(dest));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_end_user_action(XEN buffer)
+static Xen gxg_gtk_text_attributes_unref(Xen values)
{
- #define H_gtk_text_buffer_end_user_action "void gtk_text_buffer_end_user_action(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_end_user_action", "GtkTextBuffer*");
- gtk_text_buffer_end_user_action(XEN_TO_C_GtkTextBuffer_(buffer));
- return(XEN_FALSE);
+ #define H_gtk_text_attributes_unref "void gtk_text_attributes_unref(GtkTextAttributes* values)"
+ Xen_check_type(Xen_is_GtkTextAttributes_(values), values, 1, "gtk_text_attributes_unref", "GtkTextAttributes*");
+ gtk_text_attributes_unref(Xen_to_C_GtkTextAttributes_(values));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_child_anchor_new(void)
+static Xen gxg_gtk_text_tag_table_new(void)
{
- #define H_gtk_text_child_anchor_new "GtkTextChildAnchor* gtk_text_child_anchor_new( void)"
- return(C_TO_XEN_GtkTextChildAnchor_(gtk_text_child_anchor_new()));
+ #define H_gtk_text_tag_table_new "GtkTextTagTable* gtk_text_tag_table_new( void)"
+ return(C_to_Xen_GtkTextTagTable_(gtk_text_tag_table_new()));
}
-static XEN gxg_gtk_text_child_anchor_get_widgets(XEN anchor)
+static Xen gxg_gtk_text_tag_table_add(Xen table, Xen tag)
{
- #define H_gtk_text_child_anchor_get_widgets "GList* gtk_text_child_anchor_get_widgets(GtkTextChildAnchor* anchor)"
- XEN_ASSERT_TYPE(XEN_GtkTextChildAnchor__P(anchor), anchor, 1, "gtk_text_child_anchor_get_widgets", "GtkTextChildAnchor*");
- return(C_TO_XEN_GList_(gtk_text_child_anchor_get_widgets(XEN_TO_C_GtkTextChildAnchor_(anchor))));
+ #define H_gtk_text_tag_table_add "void gtk_text_tag_table_add(GtkTextTagTable* table, GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextTagTable_(table), table, 1, "gtk_text_tag_table_add", "GtkTextTagTable*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 2, "gtk_text_tag_table_add", "GtkTextTag*");
+ gtk_text_tag_table_add(Xen_to_C_GtkTextTagTable_(table), Xen_to_C_GtkTextTag_(tag));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_child_anchor_get_deleted(XEN anchor)
+static Xen gxg_gtk_text_tag_table_remove(Xen table, Xen tag)
{
- #define H_gtk_text_child_anchor_get_deleted "gboolean gtk_text_child_anchor_get_deleted(GtkTextChildAnchor* anchor)"
- XEN_ASSERT_TYPE(XEN_GtkTextChildAnchor__P(anchor), anchor, 1, "gtk_text_child_anchor_get_deleted", "GtkTextChildAnchor*");
- return(C_TO_XEN_gboolean(gtk_text_child_anchor_get_deleted(XEN_TO_C_GtkTextChildAnchor_(anchor))));
+ #define H_gtk_text_tag_table_remove "void gtk_text_tag_table_remove(GtkTextTagTable* table, GtkTextTag* tag)"
+ Xen_check_type(Xen_is_GtkTextTagTable_(table), table, 1, "gtk_text_tag_table_remove", "GtkTextTagTable*");
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 2, "gtk_text_tag_table_remove", "GtkTextTag*");
+ gtk_text_tag_table_remove(Xen_to_C_GtkTextTagTable_(table), Xen_to_C_GtkTextTag_(tag));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_buffer(XEN iter)
+static Xen gxg_gtk_text_tag_table_lookup(Xen table, Xen name)
{
- #define H_gtk_text_iter_get_buffer "GtkTextBuffer* gtk_text_iter_get_buffer(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_buffer", "GtkTextIter*");
- return(C_TO_XEN_GtkTextBuffer_(gtk_text_iter_get_buffer(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_tag_table_lookup "GtkTextTag* gtk_text_tag_table_lookup(GtkTextTagTable* table, \
+gchar* name)"
+ Xen_check_type(Xen_is_GtkTextTagTable_(table), table, 1, "gtk_text_tag_table_lookup", "GtkTextTagTable*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_text_tag_table_lookup", "gchar*");
+ return(C_to_Xen_GtkTextTag_(gtk_text_tag_table_lookup(Xen_to_C_GtkTextTagTable_(table), Xen_to_C_gchar_(name))));
}
-static XEN gxg_gtk_text_iter_copy(XEN iter)
+static Xen gxg_gtk_text_tag_table_foreach(Xen table, Xen func, Xen func_info)
{
- #define H_gtk_text_iter_copy "GtkTextIter* gtk_text_iter_copy(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_copy", "GtkTextIter*");
- return(C_TO_XEN_GtkTextIter_(gtk_text_iter_copy(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_tag_table_foreach "void gtk_text_tag_table_foreach(GtkTextTagTable* table, GtkTextTagTableForeach func, \
+lambda_data func_info)"
+ Xen_check_type(Xen_is_GtkTextTagTable_(table), table, 1, "gtk_text_tag_table_foreach", "GtkTextTagTable*");
+ Xen_check_type(Xen_is_GtkTextTagTableForeach(func), func, 2, "gtk_text_tag_table_foreach", "GtkTextTagTableForeach");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_text_tag_table_foreach", "lambda_data");
+ {
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_text_tag_table_foreach(Xen_to_C_GtkTextTagTable_(table), Xen_to_C_GtkTextTagTableForeach(func), Xen_to_C_lambda_data(func_info));
+ xm_unprotect_at(loc);
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_text_iter_free(XEN iter)
+static Xen gxg_gtk_text_tag_table_get_size(Xen table)
{
- #define H_gtk_text_iter_free "void gtk_text_iter_free(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_free", "GtkTextIter*");
- gtk_text_iter_free(XEN_TO_C_GtkTextIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_text_tag_table_get_size "gint gtk_text_tag_table_get_size(GtkTextTagTable* table)"
+ Xen_check_type(Xen_is_GtkTextTagTable_(table), table, 1, "gtk_text_tag_table_get_size", "GtkTextTagTable*");
+ return(C_to_Xen_gint(gtk_text_tag_table_get_size(Xen_to_C_GtkTextTagTable_(table))));
}
-static XEN gxg_gtk_text_iter_get_offset(XEN iter)
+static Xen gxg_gtk_text_view_new(void)
{
- #define H_gtk_text_iter_get_offset "gint gtk_text_iter_get_offset(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_offset", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_get_offset(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_new "GtkWidget* gtk_text_view_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_text_view_new()));
}
-static XEN gxg_gtk_text_iter_get_line(XEN iter)
+static Xen gxg_gtk_text_view_new_with_buffer(Xen buffer)
{
- #define H_gtk_text_iter_get_line "gint gtk_text_iter_get_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_line", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_get_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_new_with_buffer "GtkWidget* gtk_text_view_new_with_buffer(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_view_new_with_buffer", "GtkTextBuffer*");
+ return(C_to_Xen_GtkWidget_(gtk_text_view_new_with_buffer(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_text_iter_get_line_offset(XEN iter)
+static Xen gxg_gtk_text_view_set_buffer(Xen text_view, Xen buffer)
{
- #define H_gtk_text_iter_get_line_offset "gint gtk_text_iter_get_line_offset(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_line_offset", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_get_line_offset(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_set_buffer "void gtk_text_view_set_buffer(GtkTextView* text_view, GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_buffer", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 2, "gtk_text_view_set_buffer", "GtkTextBuffer*");
+ gtk_text_view_set_buffer(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextBuffer_(buffer));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_line_index(XEN iter)
+static Xen gxg_gtk_text_view_get_buffer(Xen text_view)
{
- #define H_gtk_text_iter_get_line_index "gint gtk_text_iter_get_line_index(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_line_index", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_get_line_index(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_buffer "GtkTextBuffer* gtk_text_view_get_buffer(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_buffer", "GtkTextView*");
+ return(C_to_Xen_GtkTextBuffer_(gtk_text_view_get_buffer(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_get_visible_line_offset(XEN iter)
+static Xen gxg_gtk_text_view_scroll_to_iter(Xen text_view, Xen iter, Xen within_margin, Xen use_align, Xen xalign, Xen yalign)
{
- #define H_gtk_text_iter_get_visible_line_offset "gint gtk_text_iter_get_visible_line_offset(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_visible_line_offset", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_get_visible_line_offset(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_scroll_to_iter "gboolean gtk_text_view_scroll_to_iter(GtkTextView* text_view, \
+GtkTextIter* iter, gdouble within_margin, gboolean use_align, gdouble xalign, gdouble yalign)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_scroll_to_iter", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_scroll_to_iter", "GtkTextIter*");
+ Xen_check_type(Xen_is_gdouble(within_margin), within_margin, 3, "gtk_text_view_scroll_to_iter", "gdouble");
+ Xen_check_type(Xen_is_gboolean(use_align), use_align, 4, "gtk_text_view_scroll_to_iter", "gboolean");
+ Xen_check_type(Xen_is_gdouble(xalign), xalign, 5, "gtk_text_view_scroll_to_iter", "gdouble");
+ Xen_check_type(Xen_is_gdouble(yalign), yalign, 6, "gtk_text_view_scroll_to_iter", "gdouble");
+ return(C_to_Xen_gboolean(gtk_text_view_scroll_to_iter(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gdouble(within_margin),
+ Xen_to_C_gboolean(use_align), Xen_to_C_gdouble(xalign), Xen_to_C_gdouble(yalign))));
}
-static XEN gxg_gtk_text_iter_get_visible_line_index(XEN iter)
+static Xen gxg_gtk_text_view_scroll_to_mark(Xen text_view, Xen mark, Xen within_margin, Xen use_align, Xen xalign, Xen yalign)
{
- #define H_gtk_text_iter_get_visible_line_index "gint gtk_text_iter_get_visible_line_index(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_visible_line_index", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_get_visible_line_index(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_scroll_to_mark "void gtk_text_view_scroll_to_mark(GtkTextView* text_view, GtkTextMark* mark, \
+gdouble within_margin, gboolean use_align, gdouble xalign, gdouble yalign)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_scroll_to_mark", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 2, "gtk_text_view_scroll_to_mark", "GtkTextMark*");
+ Xen_check_type(Xen_is_gdouble(within_margin), within_margin, 3, "gtk_text_view_scroll_to_mark", "gdouble");
+ Xen_check_type(Xen_is_gboolean(use_align), use_align, 4, "gtk_text_view_scroll_to_mark", "gboolean");
+ Xen_check_type(Xen_is_gdouble(xalign), xalign, 5, "gtk_text_view_scroll_to_mark", "gdouble");
+ Xen_check_type(Xen_is_gdouble(yalign), yalign, 6, "gtk_text_view_scroll_to_mark", "gdouble");
+ gtk_text_view_scroll_to_mark(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextMark_(mark), Xen_to_C_gdouble(within_margin),
+ Xen_to_C_gboolean(use_align), Xen_to_C_gdouble(xalign), Xen_to_C_gdouble(yalign));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_char(XEN iter)
+static Xen gxg_gtk_text_view_scroll_mark_onscreen(Xen text_view, Xen mark)
{
- #define H_gtk_text_iter_get_char "gunichar gtk_text_iter_get_char(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_char", "GtkTextIter*");
- return(C_TO_XEN_gunichar(gtk_text_iter_get_char(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_scroll_mark_onscreen "void gtk_text_view_scroll_mark_onscreen(GtkTextView* text_view, \
+GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_scroll_mark_onscreen", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 2, "gtk_text_view_scroll_mark_onscreen", "GtkTextMark*");
+ gtk_text_view_scroll_mark_onscreen(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextMark_(mark));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_slice(XEN start, XEN end)
+static Xen gxg_gtk_text_view_move_mark_onscreen(Xen text_view, Xen mark)
{
- #define H_gtk_text_iter_get_slice "gchar* gtk_text_iter_get_slice(GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 1, "gtk_text_iter_get_slice", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 2, "gtk_text_iter_get_slice", "GtkTextIter*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_text_iter_get_slice(XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_text_view_move_mark_onscreen "gboolean gtk_text_view_move_mark_onscreen(GtkTextView* text_view, \
+GtkTextMark* mark)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_move_mark_onscreen", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 2, "gtk_text_view_move_mark_onscreen", "GtkTextMark*");
+ return(C_to_Xen_gboolean(gtk_text_view_move_mark_onscreen(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextMark_(mark))));
}
-static XEN gxg_gtk_text_iter_get_text(XEN start, XEN end)
+static Xen gxg_gtk_text_view_place_cursor_onscreen(Xen text_view)
{
- #define H_gtk_text_iter_get_text "gchar* gtk_text_iter_get_text(GtkTextIter* start, GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 1, "gtk_text_iter_get_text", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 2, "gtk_text_iter_get_text", "GtkTextIter*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_text_iter_get_text(XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_text_view_place_cursor_onscreen "gboolean gtk_text_view_place_cursor_onscreen(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_place_cursor_onscreen", "GtkTextView*");
+ return(C_to_Xen_gboolean(gtk_text_view_place_cursor_onscreen(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_get_visible_slice(XEN start, XEN end)
+static Xen gxg_gtk_text_view_get_visible_rect(Xen text_view, Xen visible_rect)
{
- #define H_gtk_text_iter_get_visible_slice "gchar* gtk_text_iter_get_visible_slice(GtkTextIter* start, \
-GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 1, "gtk_text_iter_get_visible_slice", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 2, "gtk_text_iter_get_visible_slice", "GtkTextIter*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_text_iter_get_visible_slice(XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_text_view_get_visible_rect "void gtk_text_view_get_visible_rect(GtkTextView* text_view, \
+GdkRectangle* visible_rect)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_visible_rect", "GtkTextView*");
+ Xen_check_type(Xen_is_GdkRectangle_(visible_rect), visible_rect, 2, "gtk_text_view_get_visible_rect", "GdkRectangle*");
+ gtk_text_view_get_visible_rect(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GdkRectangle_(visible_rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_visible_text(XEN start, XEN end)
+static Xen gxg_gtk_text_view_set_cursor_visible(Xen text_view, Xen setting)
{
- #define H_gtk_text_iter_get_visible_text "gchar* gtk_text_iter_get_visible_text(GtkTextIter* start, \
-GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 1, "gtk_text_iter_get_visible_text", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 2, "gtk_text_iter_get_visible_text", "GtkTextIter*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_text_iter_get_visible_text(XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_text_view_set_cursor_visible "void gtk_text_view_set_cursor_visible(GtkTextView* text_view, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_cursor_visible", "GtkTextView*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_text_view_set_cursor_visible", "gboolean");
+ gtk_text_view_set_cursor_visible(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_pixbuf(XEN iter)
+static Xen gxg_gtk_text_view_get_cursor_visible(Xen text_view)
{
- #define H_gtk_text_iter_get_pixbuf "GdkPixbuf* gtk_text_iter_get_pixbuf(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_pixbuf", "GtkTextIter*");
- return(C_TO_XEN_GdkPixbuf_(gtk_text_iter_get_pixbuf(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_cursor_visible "gboolean gtk_text_view_get_cursor_visible(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_cursor_visible", "GtkTextView*");
+ return(C_to_Xen_gboolean(gtk_text_view_get_cursor_visible(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_get_marks(XEN iter)
+static Xen gxg_gtk_text_view_get_iter_location(Xen text_view, Xen iter, Xen location)
{
- #define H_gtk_text_iter_get_marks "GSList* gtk_text_iter_get_marks(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_marks", "GtkTextIter*");
- return(C_TO_XEN_GSList_(gtk_text_iter_get_marks(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_iter_location "void gtk_text_view_get_iter_location(GtkTextView* text_view, \
+GtkTextIter* iter, GdkRectangle* location)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_iter_location", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_get_iter_location", "GtkTextIter*");
+ Xen_check_type(Xen_is_GdkRectangle_(location), location, 3, "gtk_text_view_get_iter_location", "GdkRectangle*");
+ gtk_text_view_get_iter_location(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter), Xen_to_C_GdkRectangle_(location));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_child_anchor(XEN iter)
+static Xen gxg_gtk_text_view_get_iter_at_location(Xen text_view, Xen iter, Xen x, Xen y)
{
- #define H_gtk_text_iter_get_child_anchor "GtkTextChildAnchor* gtk_text_iter_get_child_anchor(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_child_anchor", "GtkTextIter*");
- return(C_TO_XEN_GtkTextChildAnchor_(gtk_text_iter_get_child_anchor(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_iter_at_location "void gtk_text_view_get_iter_at_location(GtkTextView* text_view, \
+GtkTextIter* iter, gint x, gint y)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_iter_at_location", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_get_iter_at_location", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(x), x, 3, "gtk_text_view_get_iter_at_location", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 4, "gtk_text_view_get_iter_at_location", "gint");
+ gtk_text_view_get_iter_at_location(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(x), Xen_to_C_gint(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_toggled_tags(XEN iter, XEN toggled_on)
+static Xen gxg_gtk_text_view_get_line_yrange(Xen text_view, Xen iter, Xen ignore_y, Xen ignore_height)
{
- #define H_gtk_text_iter_get_toggled_tags "GSList* gtk_text_iter_get_toggled_tags(GtkTextIter* iter, \
-gboolean toggled_on)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_toggled_tags", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(toggled_on), toggled_on, 2, "gtk_text_iter_get_toggled_tags", "gboolean");
- return(C_TO_XEN_GSList_(gtk_text_iter_get_toggled_tags(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gboolean(toggled_on))));
+ #define H_gtk_text_view_get_line_yrange "void gtk_text_view_get_line_yrange(GtkTextView* text_view, \
+GtkTextIter* iter, gint* [y], gint* [height])"
+ gint ref_y;
+ gint ref_height;
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_line_yrange", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_get_line_yrange", "GtkTextIter*");
+ gtk_text_view_get_line_yrange(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter), &ref_y, &ref_height);
+ return(Xen_list_2(C_to_Xen_gint(ref_y), C_to_Xen_gint(ref_height)));
}
-static XEN gxg_gtk_text_iter_begins_tag(XEN iter, XEN tag)
+static Xen gxg_gtk_text_view_get_line_at_y(Xen text_view, Xen target_iter, Xen y, Xen ignore_line_top)
{
- #define H_gtk_text_iter_begins_tag "gboolean gtk_text_iter_begins_tag(GtkTextIter* iter, GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_begins_tag", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag) || XEN_FALSE_P(tag), tag, 2, "gtk_text_iter_begins_tag", "GtkTextTag*");
- return(C_TO_XEN_gboolean(gtk_text_iter_begins_tag(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextTag_(tag))));
+ #define H_gtk_text_view_get_line_at_y "void gtk_text_view_get_line_at_y(GtkTextView* text_view, GtkTextIter* target_iter, \
+gint y, gint* [line_top])"
+ gint ref_line_top;
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_line_at_y", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(target_iter), target_iter, 2, "gtk_text_view_get_line_at_y", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_text_view_get_line_at_y", "gint");
+ gtk_text_view_get_line_at_y(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(target_iter), Xen_to_C_gint(y), &ref_line_top);
+ return(Xen_list_1(C_to_Xen_gint(ref_line_top)));
}
-static XEN gxg_gtk_text_iter_ends_tag(XEN iter, XEN tag)
+static Xen gxg_gtk_text_view_buffer_to_window_coords(Xen text_view, Xen win, Xen buffer_x, Xen buffer_y, Xen ignore_window_x, Xen ignore_window_y)
{
- #define H_gtk_text_iter_ends_tag "gboolean gtk_text_iter_ends_tag(GtkTextIter* iter, GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_ends_tag", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag) || XEN_FALSE_P(tag), tag, 2, "gtk_text_iter_ends_tag", "GtkTextTag*");
- return(C_TO_XEN_gboolean(gtk_text_iter_ends_tag(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextTag_(tag))));
+ #define H_gtk_text_view_buffer_to_window_coords "void gtk_text_view_buffer_to_window_coords(GtkTextView* text_view, \
+GtkTextWindowType win, gint buffer_x, gint buffer_y, gint* [window_x], gint* [window_y])"
+ gint ref_window_x;
+ gint ref_window_y;
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_buffer_to_window_coords", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextWindowType(win), win, 2, "gtk_text_view_buffer_to_window_coords", "GtkTextWindowType");
+ Xen_check_type(Xen_is_gint(buffer_x), buffer_x, 3, "gtk_text_view_buffer_to_window_coords", "gint");
+ Xen_check_type(Xen_is_gint(buffer_y), buffer_y, 4, "gtk_text_view_buffer_to_window_coords", "gint");
+ gtk_text_view_buffer_to_window_coords(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextWindowType(win), Xen_to_C_gint(buffer_x),
+ Xen_to_C_gint(buffer_y), &ref_window_x, &ref_window_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_window_x), C_to_Xen_gint(ref_window_y)));
}
-static XEN gxg_gtk_text_iter_toggles_tag(XEN iter, XEN tag)
+static Xen gxg_gtk_text_view_window_to_buffer_coords(Xen text_view, Xen win, Xen window_x, Xen window_y, Xen ignore_buffer_x, Xen ignore_buffer_y)
{
- #define H_gtk_text_iter_toggles_tag "gboolean gtk_text_iter_toggles_tag(GtkTextIter* iter, GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_toggles_tag", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag) || XEN_FALSE_P(tag), tag, 2, "gtk_text_iter_toggles_tag", "GtkTextTag*");
- return(C_TO_XEN_gboolean(gtk_text_iter_toggles_tag(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextTag_(tag))));
+ #define H_gtk_text_view_window_to_buffer_coords "void gtk_text_view_window_to_buffer_coords(GtkTextView* text_view, \
+GtkTextWindowType win, gint window_x, gint window_y, gint* [buffer_x], gint* [buffer_y])"
+ gint ref_buffer_x;
+ gint ref_buffer_y;
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_window_to_buffer_coords", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextWindowType(win), win, 2, "gtk_text_view_window_to_buffer_coords", "GtkTextWindowType");
+ Xen_check_type(Xen_is_gint(window_x), window_x, 3, "gtk_text_view_window_to_buffer_coords", "gint");
+ Xen_check_type(Xen_is_gint(window_y), window_y, 4, "gtk_text_view_window_to_buffer_coords", "gint");
+ gtk_text_view_window_to_buffer_coords(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextWindowType(win), Xen_to_C_gint(window_x),
+ Xen_to_C_gint(window_y), &ref_buffer_x, &ref_buffer_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_buffer_x), C_to_Xen_gint(ref_buffer_y)));
}
-static XEN gxg_gtk_text_iter_has_tag(XEN iter, XEN tag)
+static Xen gxg_gtk_text_view_get_window(Xen text_view, Xen win)
{
- #define H_gtk_text_iter_has_tag "gboolean gtk_text_iter_has_tag(GtkTextIter* iter, GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_has_tag", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag), tag, 2, "gtk_text_iter_has_tag", "GtkTextTag*");
- return(C_TO_XEN_gboolean(gtk_text_iter_has_tag(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextTag_(tag))));
+ #define H_gtk_text_view_get_window "GdkWindow* gtk_text_view_get_window(GtkTextView* text_view, GtkTextWindowType win)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_window", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextWindowType(win), win, 2, "gtk_text_view_get_window", "GtkTextWindowType");
+ return(C_to_Xen_GdkWindow_(gtk_text_view_get_window(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextWindowType(win))));
}
-static XEN gxg_gtk_text_iter_get_tags(XEN iter)
+static Xen gxg_gtk_text_view_get_window_type(Xen text_view, Xen window)
{
- #define H_gtk_text_iter_get_tags "GSList* gtk_text_iter_get_tags(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_tags", "GtkTextIter*");
- return(C_TO_XEN_GSList_(gtk_text_iter_get_tags(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_window_type "GtkTextWindowType gtk_text_view_get_window_type(GtkTextView* text_view, \
+GdkWindow* window)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_window_type", "GtkTextView*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 2, "gtk_text_view_get_window_type", "GdkWindow*");
+ return(C_to_Xen_GtkTextWindowType(gtk_text_view_get_window_type(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_text_iter_editable(XEN iter, XEN default_setting)
+static Xen gxg_gtk_text_view_set_border_window_size(Xen text_view, Xen type, Xen size)
{
- #define H_gtk_text_iter_editable "gboolean gtk_text_iter_editable(GtkTextIter* iter, gboolean default_setting)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_editable", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_setting), default_setting, 2, "gtk_text_iter_editable", "gboolean");
- return(C_TO_XEN_gboolean(gtk_text_iter_editable(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gboolean(default_setting))));
+ #define H_gtk_text_view_set_border_window_size "void gtk_text_view_set_border_window_size(GtkTextView* text_view, \
+GtkTextWindowType type, gint size)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_border_window_size", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextWindowType(type), type, 2, "gtk_text_view_set_border_window_size", "GtkTextWindowType");
+ Xen_check_type(Xen_is_gint(size), size, 3, "gtk_text_view_set_border_window_size", "gint");
+ gtk_text_view_set_border_window_size(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextWindowType(type), Xen_to_C_gint(size));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_can_insert(XEN iter, XEN default_editability)
+static Xen gxg_gtk_text_view_get_border_window_size(Xen text_view, Xen type)
{
- #define H_gtk_text_iter_can_insert "gboolean gtk_text_iter_can_insert(GtkTextIter* iter, gboolean default_editability)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_can_insert", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editability), default_editability, 2, "gtk_text_iter_can_insert", "gboolean");
- return(C_TO_XEN_gboolean(gtk_text_iter_can_insert(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gboolean(default_editability))));
+ #define H_gtk_text_view_get_border_window_size "gint gtk_text_view_get_border_window_size(GtkTextView* text_view, \
+GtkTextWindowType type)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_border_window_size", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextWindowType(type), type, 2, "gtk_text_view_get_border_window_size", "GtkTextWindowType");
+ return(C_to_Xen_gint(gtk_text_view_get_border_window_size(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextWindowType(type))));
}
-static XEN gxg_gtk_text_iter_starts_word(XEN iter)
+static Xen gxg_gtk_text_view_forward_display_line(Xen text_view, Xen iter)
{
- #define H_gtk_text_iter_starts_word "gboolean gtk_text_iter_starts_word(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_starts_word", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_starts_word(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_forward_display_line "gboolean gtk_text_view_forward_display_line(GtkTextView* text_view, \
+GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_forward_display_line", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_forward_display_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_view_forward_display_line(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_iter_ends_word(XEN iter)
+static Xen gxg_gtk_text_view_backward_display_line(Xen text_view, Xen iter)
{
- #define H_gtk_text_iter_ends_word "gboolean gtk_text_iter_ends_word(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_ends_word", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_ends_word(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_backward_display_line "gboolean gtk_text_view_backward_display_line(GtkTextView* text_view, \
+GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_backward_display_line", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_backward_display_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_view_backward_display_line(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_iter_inside_word(XEN iter)
+static Xen gxg_gtk_text_view_forward_display_line_end(Xen text_view, Xen iter)
{
- #define H_gtk_text_iter_inside_word "gboolean gtk_text_iter_inside_word(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_inside_word", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_inside_word(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_forward_display_line_end "gboolean gtk_text_view_forward_display_line_end(GtkTextView* text_view, \
+GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_forward_display_line_end", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_forward_display_line_end", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_view_forward_display_line_end(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_iter_starts_sentence(XEN iter)
+static Xen gxg_gtk_text_view_backward_display_line_start(Xen text_view, Xen iter)
{
- #define H_gtk_text_iter_starts_sentence "gboolean gtk_text_iter_starts_sentence(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_starts_sentence", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_starts_sentence(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_backward_display_line_start "gboolean gtk_text_view_backward_display_line_start(GtkTextView* text_view, \
+GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_backward_display_line_start", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_backward_display_line_start", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_view_backward_display_line_start(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_iter_ends_sentence(XEN iter)
+static Xen gxg_gtk_text_view_starts_display_line(Xen text_view, Xen iter)
{
- #define H_gtk_text_iter_ends_sentence "gboolean gtk_text_iter_ends_sentence(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_ends_sentence", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_ends_sentence(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_starts_display_line "gboolean gtk_text_view_starts_display_line(GtkTextView* text_view, \
+GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_starts_display_line", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_starts_display_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_view_starts_display_line(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_text_iter_inside_sentence(XEN iter)
+static Xen gxg_gtk_text_view_move_visually(Xen text_view, Xen iter, Xen count)
{
- #define H_gtk_text_iter_inside_sentence "gboolean gtk_text_iter_inside_sentence(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_inside_sentence", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_inside_sentence(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_move_visually "gboolean gtk_text_view_move_visually(GtkTextView* text_view, \
+GtkTextIter* iter, gint count)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_move_visually", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_move_visually", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 3, "gtk_text_view_move_visually", "gint");
+ return(C_to_Xen_gboolean(gtk_text_view_move_visually(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_text_iter_starts_line(XEN iter)
+static Xen gxg_gtk_text_view_add_child_at_anchor(Xen text_view, Xen child, Xen anchor)
{
- #define H_gtk_text_iter_starts_line "gboolean gtk_text_iter_starts_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_starts_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_starts_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_add_child_at_anchor "void gtk_text_view_add_child_at_anchor(GtkTextView* text_view, \
+GtkWidget* child, GtkTextChildAnchor* anchor)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_add_child_at_anchor", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_text_view_add_child_at_anchor", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkTextChildAnchor_(anchor), anchor, 3, "gtk_text_view_add_child_at_anchor", "GtkTextChildAnchor*");
+ gtk_text_view_add_child_at_anchor(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkTextChildAnchor_(anchor));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_ends_line(XEN iter)
+static Xen gxg_gtk_text_view_add_child_in_window(Xen text_view, Xen child, Xen which_window, Xen xpos, Xen ypos)
{
- #define H_gtk_text_iter_ends_line "gboolean gtk_text_iter_ends_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_ends_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_ends_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_add_child_in_window "void gtk_text_view_add_child_in_window(GtkTextView* text_view, \
+GtkWidget* child, GtkTextWindowType which_window, gint xpos, gint ypos)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_add_child_in_window", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_text_view_add_child_in_window", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkTextWindowType(which_window), which_window, 3, "gtk_text_view_add_child_in_window", "GtkTextWindowType");
+ Xen_check_type(Xen_is_gint(xpos), xpos, 4, "gtk_text_view_add_child_in_window", "gint");
+ Xen_check_type(Xen_is_gint(ypos), ypos, 5, "gtk_text_view_add_child_in_window", "gint");
+ gtk_text_view_add_child_in_window(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkTextWindowType(which_window),
+ Xen_to_C_gint(xpos), Xen_to_C_gint(ypos));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_is_cursor_position(XEN iter)
+static Xen gxg_gtk_text_view_move_child(Xen text_view, Xen child, Xen xpos, Xen ypos)
{
- #define H_gtk_text_iter_is_cursor_position "gboolean gtk_text_iter_is_cursor_position(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_is_cursor_position", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_is_cursor_position(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_move_child "void gtk_text_view_move_child(GtkTextView* text_view, GtkWidget* child, \
+gint xpos, gint ypos)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_move_child", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_text_view_move_child", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(xpos), xpos, 3, "gtk_text_view_move_child", "gint");
+ Xen_check_type(Xen_is_gint(ypos), ypos, 4, "gtk_text_view_move_child", "gint");
+ gtk_text_view_move_child(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(xpos), Xen_to_C_gint(ypos));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_chars_in_line(XEN iter)
+static Xen gxg_gtk_text_view_set_wrap_mode(Xen text_view, Xen wrap_mode)
{
- #define H_gtk_text_iter_get_chars_in_line "gint gtk_text_iter_get_chars_in_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_chars_in_line", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_get_chars_in_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_set_wrap_mode "void gtk_text_view_set_wrap_mode(GtkTextView* text_view, GtkWrapMode wrap_mode)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_wrap_mode", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkWrapMode(wrap_mode), wrap_mode, 2, "gtk_text_view_set_wrap_mode", "GtkWrapMode");
+ gtk_text_view_set_wrap_mode(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkWrapMode(wrap_mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_bytes_in_line(XEN iter)
+static Xen gxg_gtk_text_view_get_wrap_mode(Xen text_view)
{
- #define H_gtk_text_iter_get_bytes_in_line "gint gtk_text_iter_get_bytes_in_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_bytes_in_line", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_get_bytes_in_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_wrap_mode "GtkWrapMode gtk_text_view_get_wrap_mode(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_wrap_mode", "GtkTextView*");
+ return(C_to_Xen_GtkWrapMode(gtk_text_view_get_wrap_mode(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_get_attributes(XEN iter, XEN values)
+static Xen gxg_gtk_text_view_set_editable(Xen text_view, Xen setting)
{
- #define H_gtk_text_iter_get_attributes "gboolean gtk_text_iter_get_attributes(GtkTextIter* iter, GtkTextAttributes* values)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_attributes", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextAttributes__P(values), values, 2, "gtk_text_iter_get_attributes", "GtkTextAttributes*");
- return(C_TO_XEN_gboolean(gtk_text_iter_get_attributes(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextAttributes_(values))));
+ #define H_gtk_text_view_set_editable "void gtk_text_view_set_editable(GtkTextView* text_view, gboolean setting)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_editable", "GtkTextView*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_text_view_set_editable", "gboolean");
+ gtk_text_view_set_editable(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_get_language(XEN iter)
+static Xen gxg_gtk_text_view_get_editable(Xen text_view)
{
- #define H_gtk_text_iter_get_language "PangoLanguage* gtk_text_iter_get_language(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_get_language", "GtkTextIter*");
- return(C_TO_XEN_PangoLanguage_(gtk_text_iter_get_language(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_editable "gboolean gtk_text_view_get_editable(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_editable", "GtkTextView*");
+ return(C_to_Xen_gboolean(gtk_text_view_get_editable(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_is_end(XEN iter)
+static Xen gxg_gtk_text_view_set_pixels_above_lines(Xen text_view, Xen pixels_above_lines)
{
- #define H_gtk_text_iter_is_end "gboolean gtk_text_iter_is_end(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_is_end", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_is_end(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_set_pixels_above_lines "void gtk_text_view_set_pixels_above_lines(GtkTextView* text_view, \
+gint pixels_above_lines)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_pixels_above_lines", "GtkTextView*");
+ Xen_check_type(Xen_is_gint(pixels_above_lines), pixels_above_lines, 2, "gtk_text_view_set_pixels_above_lines", "gint");
+ gtk_text_view_set_pixels_above_lines(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gint(pixels_above_lines));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_is_start(XEN iter)
+static Xen gxg_gtk_text_view_get_pixels_above_lines(Xen text_view)
{
- #define H_gtk_text_iter_is_start "gboolean gtk_text_iter_is_start(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_is_start", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_is_start(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_pixels_above_lines "gint gtk_text_view_get_pixels_above_lines(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_pixels_above_lines", "GtkTextView*");
+ return(C_to_Xen_gint(gtk_text_view_get_pixels_above_lines(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_forward_char(XEN iter)
+static Xen gxg_gtk_text_view_set_pixels_below_lines(Xen text_view, Xen pixels_below_lines)
{
- #define H_gtk_text_iter_forward_char "gboolean gtk_text_iter_forward_char(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_char", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_char(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_set_pixels_below_lines "void gtk_text_view_set_pixels_below_lines(GtkTextView* text_view, \
+gint pixels_below_lines)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_pixels_below_lines", "GtkTextView*");
+ Xen_check_type(Xen_is_gint(pixels_below_lines), pixels_below_lines, 2, "gtk_text_view_set_pixels_below_lines", "gint");
+ gtk_text_view_set_pixels_below_lines(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gint(pixels_below_lines));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_char(XEN iter)
+static Xen gxg_gtk_text_view_get_pixels_below_lines(Xen text_view)
{
- #define H_gtk_text_iter_backward_char "gboolean gtk_text_iter_backward_char(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_char", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_char(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_pixels_below_lines "gint gtk_text_view_get_pixels_below_lines(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_pixels_below_lines", "GtkTextView*");
+ return(C_to_Xen_gint(gtk_text_view_get_pixels_below_lines(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_forward_chars(XEN iter, XEN count)
+static Xen gxg_gtk_text_view_set_pixels_inside_wrap(Xen text_view, Xen pixels_inside_wrap)
{
- #define H_gtk_text_iter_forward_chars "gboolean gtk_text_iter_forward_chars(GtkTextIter* iter, gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_chars", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_forward_chars", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_chars(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_text_view_set_pixels_inside_wrap "void gtk_text_view_set_pixels_inside_wrap(GtkTextView* text_view, \
+gint pixels_inside_wrap)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_pixels_inside_wrap", "GtkTextView*");
+ Xen_check_type(Xen_is_gint(pixels_inside_wrap), pixels_inside_wrap, 2, "gtk_text_view_set_pixels_inside_wrap", "gint");
+ gtk_text_view_set_pixels_inside_wrap(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gint(pixels_inside_wrap));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_chars(XEN iter, XEN count)
+static Xen gxg_gtk_text_view_get_pixels_inside_wrap(Xen text_view)
{
- #define H_gtk_text_iter_backward_chars "gboolean gtk_text_iter_backward_chars(GtkTextIter* iter, gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_chars", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_backward_chars", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_chars(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_text_view_get_pixels_inside_wrap "gint gtk_text_view_get_pixels_inside_wrap(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_pixels_inside_wrap", "GtkTextView*");
+ return(C_to_Xen_gint(gtk_text_view_get_pixels_inside_wrap(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_forward_line(XEN iter)
+static Xen gxg_gtk_text_view_set_justification(Xen text_view, Xen justification)
{
- #define H_gtk_text_iter_forward_line "gboolean gtk_text_iter_forward_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_set_justification "void gtk_text_view_set_justification(GtkTextView* text_view, \
+GtkJustification justification)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_justification", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkJustification(justification), justification, 2, "gtk_text_view_set_justification", "GtkJustification");
+ gtk_text_view_set_justification(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkJustification(justification));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_line(XEN iter)
+static Xen gxg_gtk_text_view_get_justification(Xen text_view)
{
- #define H_gtk_text_iter_backward_line "gboolean gtk_text_iter_backward_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_justification "GtkJustification gtk_text_view_get_justification(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_justification", "GtkTextView*");
+ return(C_to_Xen_GtkJustification(gtk_text_view_get_justification(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_forward_lines(XEN iter, XEN count)
+static Xen gxg_gtk_text_view_set_left_margin(Xen text_view, Xen left_margin)
{
- #define H_gtk_text_iter_forward_lines "gboolean gtk_text_iter_forward_lines(GtkTextIter* iter, gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_lines", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_forward_lines", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_lines(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_text_view_set_left_margin "void gtk_text_view_set_left_margin(GtkTextView* text_view, \
+gint left_margin)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_left_margin", "GtkTextView*");
+ Xen_check_type(Xen_is_gint(left_margin), left_margin, 2, "gtk_text_view_set_left_margin", "gint");
+ gtk_text_view_set_left_margin(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gint(left_margin));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_lines(XEN iter, XEN count)
+static Xen gxg_gtk_text_view_get_left_margin(Xen text_view)
{
- #define H_gtk_text_iter_backward_lines "gboolean gtk_text_iter_backward_lines(GtkTextIter* iter, gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_lines", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_backward_lines", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_lines(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_text_view_get_left_margin "gint gtk_text_view_get_left_margin(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_left_margin", "GtkTextView*");
+ return(C_to_Xen_gint(gtk_text_view_get_left_margin(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_forward_word_end(XEN iter)
+static Xen gxg_gtk_text_view_set_right_margin(Xen text_view, Xen right_margin)
{
- #define H_gtk_text_iter_forward_word_end "gboolean gtk_text_iter_forward_word_end(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_word_end", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_word_end(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_set_right_margin "void gtk_text_view_set_right_margin(GtkTextView* text_view, \
+gint right_margin)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_right_margin", "GtkTextView*");
+ Xen_check_type(Xen_is_gint(right_margin), right_margin, 2, "gtk_text_view_set_right_margin", "gint");
+ gtk_text_view_set_right_margin(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gint(right_margin));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_word_start(XEN iter)
+static Xen gxg_gtk_text_view_get_right_margin(Xen text_view)
{
- #define H_gtk_text_iter_backward_word_start "gboolean gtk_text_iter_backward_word_start(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_word_start", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_word_start(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_right_margin "gint gtk_text_view_get_right_margin(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_right_margin", "GtkTextView*");
+ return(C_to_Xen_gint(gtk_text_view_get_right_margin(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_forward_word_ends(XEN iter, XEN count)
+static Xen gxg_gtk_text_view_set_indent(Xen text_view, Xen indent)
{
- #define H_gtk_text_iter_forward_word_ends "gboolean gtk_text_iter_forward_word_ends(GtkTextIter* iter, \
-gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_word_ends", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_forward_word_ends", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_word_ends(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_text_view_set_indent "void gtk_text_view_set_indent(GtkTextView* text_view, gint indent)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_indent", "GtkTextView*");
+ Xen_check_type(Xen_is_gint(indent), indent, 2, "gtk_text_view_set_indent", "gint");
+ gtk_text_view_set_indent(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gint(indent));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_word_starts(XEN iter, XEN count)
+static Xen gxg_gtk_text_view_get_indent(Xen text_view)
{
- #define H_gtk_text_iter_backward_word_starts "gboolean gtk_text_iter_backward_word_starts(GtkTextIter* iter, \
-gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_word_starts", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_backward_word_starts", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_word_starts(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_text_view_get_indent "gint gtk_text_view_get_indent(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_indent", "GtkTextView*");
+ return(C_to_Xen_gint(gtk_text_view_get_indent(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_forward_sentence_end(XEN iter)
+static Xen gxg_gtk_text_view_set_tabs(Xen text_view, Xen tabs)
{
- #define H_gtk_text_iter_forward_sentence_end "gboolean gtk_text_iter_forward_sentence_end(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_sentence_end", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_sentence_end(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_set_tabs "void gtk_text_view_set_tabs(GtkTextView* text_view, PangoTabArray* tabs)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_tabs", "GtkTextView*");
+ Xen_check_type(Xen_is_PangoTabArray_(tabs) || Xen_is_false(tabs), tabs, 2, "gtk_text_view_set_tabs", "PangoTabArray*");
+ gtk_text_view_set_tabs(Xen_to_C_GtkTextView_(text_view), Xen_to_C_PangoTabArray_(tabs));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_sentence_start(XEN iter)
+static Xen gxg_gtk_text_view_get_tabs(Xen text_view)
{
- #define H_gtk_text_iter_backward_sentence_start "gboolean gtk_text_iter_backward_sentence_start(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_sentence_start", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_sentence_start(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_text_view_get_tabs "PangoTabArray* gtk_text_view_get_tabs(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_tabs", "GtkTextView*");
+ return(C_to_Xen_PangoTabArray_(gtk_text_view_get_tabs(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_forward_sentence_ends(XEN iter, XEN count)
+static Xen gxg_gtk_text_view_get_default_attributes(Xen text_view)
{
- #define H_gtk_text_iter_forward_sentence_ends "gboolean gtk_text_iter_forward_sentence_ends(GtkTextIter* iter, \
-gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_sentence_ends", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_forward_sentence_ends", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_sentence_ends(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_text_view_get_default_attributes "GtkTextAttributes* gtk_text_view_get_default_attributes(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_default_attributes", "GtkTextView*");
+ return(C_to_Xen_GtkTextAttributes_(gtk_text_view_get_default_attributes(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_text_iter_backward_sentence_starts(XEN iter, XEN count)
+static Xen gxg_gtk_toggle_button_new(void)
{
- #define H_gtk_text_iter_backward_sentence_starts "gboolean gtk_text_iter_backward_sentence_starts(GtkTextIter* iter, \
-gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_sentence_starts", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_backward_sentence_starts", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_sentence_starts(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_toggle_button_new "GtkWidget* gtk_toggle_button_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_toggle_button_new()));
}
-static XEN gxg_gtk_text_iter_forward_cursor_position(XEN iter)
+static Xen gxg_gtk_toggle_button_new_with_label(Xen label)
{
- #define H_gtk_text_iter_forward_cursor_position "gboolean gtk_text_iter_forward_cursor_position(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_cursor_position", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_cursor_position(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_toggle_button_new_with_label "GtkWidget* gtk_toggle_button_new_with_label(gchar* label)"
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_toggle_button_new_with_label", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_toggle_button_new_with_label(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_text_iter_backward_cursor_position(XEN iter)
+static Xen gxg_gtk_toggle_button_new_with_mnemonic(Xen label)
{
- #define H_gtk_text_iter_backward_cursor_position "gboolean gtk_text_iter_backward_cursor_position(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_cursor_position", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_cursor_position(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_toggle_button_new_with_mnemonic "GtkWidget* gtk_toggle_button_new_with_mnemonic(gchar* label)"
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_toggle_button_new_with_mnemonic", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_toggle_button_new_with_mnemonic(Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_text_iter_forward_cursor_positions(XEN iter, XEN count)
+static Xen gxg_gtk_toggle_button_set_mode(Xen toggle_button, Xen draw_indicator)
{
- #define H_gtk_text_iter_forward_cursor_positions "gboolean gtk_text_iter_forward_cursor_positions(GtkTextIter* iter, \
-gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_cursor_positions", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_forward_cursor_positions", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_cursor_positions(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_toggle_button_set_mode "void gtk_toggle_button_set_mode(GtkToggleButton* toggle_button, \
+gboolean draw_indicator)"
+ Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_set_mode", "GtkToggleButton*");
+ Xen_check_type(Xen_is_gboolean(draw_indicator), draw_indicator, 2, "gtk_toggle_button_set_mode", "gboolean");
+ gtk_toggle_button_set_mode(Xen_to_C_GtkToggleButton_(toggle_button), Xen_to_C_gboolean(draw_indicator));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_cursor_positions(XEN iter, XEN count)
+static Xen gxg_gtk_toggle_button_get_mode(Xen toggle_button)
{
- #define H_gtk_text_iter_backward_cursor_positions "gboolean gtk_text_iter_backward_cursor_positions(GtkTextIter* iter, \
-gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_cursor_positions", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_backward_cursor_positions", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_cursor_positions(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_toggle_button_get_mode "gboolean gtk_toggle_button_get_mode(GtkToggleButton* toggle_button)"
+ Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_get_mode", "GtkToggleButton*");
+ return(C_to_Xen_gboolean(gtk_toggle_button_get_mode(Xen_to_C_GtkToggleButton_(toggle_button))));
}
-static XEN gxg_gtk_text_iter_set_offset(XEN iter, XEN char_offset)
+static Xen gxg_gtk_toggle_button_set_active(Xen toggle_button, Xen is_active)
{
- #define H_gtk_text_iter_set_offset "void gtk_text_iter_set_offset(GtkTextIter* iter, gint char_offset)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_set_offset", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(char_offset), char_offset, 2, "gtk_text_iter_set_offset", "gint");
- gtk_text_iter_set_offset(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(char_offset));
- return(XEN_FALSE);
+ #define H_gtk_toggle_button_set_active "void gtk_toggle_button_set_active(GtkToggleButton* toggle_button, \
+gboolean is_active)"
+ Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_set_active", "GtkToggleButton*");
+ Xen_check_type(Xen_is_gboolean(is_active), is_active, 2, "gtk_toggle_button_set_active", "gboolean");
+ gtk_toggle_button_set_active(Xen_to_C_GtkToggleButton_(toggle_button), Xen_to_C_gboolean(is_active));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_set_line(XEN iter, XEN line_number)
+static Xen gxg_gtk_toggle_button_get_active(Xen toggle_button)
{
- #define H_gtk_text_iter_set_line "void gtk_text_iter_set_line(GtkTextIter* iter, gint line_number)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_set_line", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(line_number), line_number, 2, "gtk_text_iter_set_line", "gint");
- gtk_text_iter_set_line(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(line_number));
- return(XEN_FALSE);
+ #define H_gtk_toggle_button_get_active "gboolean gtk_toggle_button_get_active(GtkToggleButton* toggle_button)"
+ Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_get_active", "GtkToggleButton*");
+ return(C_to_Xen_gboolean(gtk_toggle_button_get_active(Xen_to_C_GtkToggleButton_(toggle_button))));
}
-static XEN gxg_gtk_text_iter_set_line_offset(XEN iter, XEN char_on_line)
+static Xen gxg_gtk_toggle_button_toggled(Xen toggle_button)
{
- #define H_gtk_text_iter_set_line_offset "void gtk_text_iter_set_line_offset(GtkTextIter* iter, gint char_on_line)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_set_line_offset", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(char_on_line), char_on_line, 2, "gtk_text_iter_set_line_offset", "gint");
- gtk_text_iter_set_line_offset(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(char_on_line));
- return(XEN_FALSE);
+ #define H_gtk_toggle_button_toggled "void gtk_toggle_button_toggled(GtkToggleButton* toggle_button)"
+ Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_toggled", "GtkToggleButton*");
+ gtk_toggle_button_toggled(Xen_to_C_GtkToggleButton_(toggle_button));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_set_line_index(XEN iter, XEN byte_on_line)
+static Xen gxg_gtk_toggle_button_set_inconsistent(Xen toggle_button, Xen setting)
{
- #define H_gtk_text_iter_set_line_index "void gtk_text_iter_set_line_index(GtkTextIter* iter, gint byte_on_line)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_set_line_index", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(byte_on_line), byte_on_line, 2, "gtk_text_iter_set_line_index", "gint");
- gtk_text_iter_set_line_index(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(byte_on_line));
- return(XEN_FALSE);
+ #define H_gtk_toggle_button_set_inconsistent "void gtk_toggle_button_set_inconsistent(GtkToggleButton* toggle_button, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_set_inconsistent", "GtkToggleButton*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_toggle_button_set_inconsistent", "gboolean");
+ gtk_toggle_button_set_inconsistent(Xen_to_C_GtkToggleButton_(toggle_button), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_forward_to_end(XEN iter)
+static Xen gxg_gtk_toggle_button_get_inconsistent(Xen toggle_button)
{
- #define H_gtk_text_iter_forward_to_end "void gtk_text_iter_forward_to_end(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_to_end", "GtkTextIter*");
- gtk_text_iter_forward_to_end(XEN_TO_C_GtkTextIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_toggle_button_get_inconsistent "gboolean gtk_toggle_button_get_inconsistent(GtkToggleButton* toggle_button)"
+ Xen_check_type(Xen_is_GtkToggleButton_(toggle_button), toggle_button, 1, "gtk_toggle_button_get_inconsistent", "GtkToggleButton*");
+ return(C_to_Xen_gboolean(gtk_toggle_button_get_inconsistent(Xen_to_C_GtkToggleButton_(toggle_button))));
}
-static XEN gxg_gtk_text_iter_forward_to_line_end(XEN iter)
+static Xen gxg_gtk_toolbar_new(void)
{
- #define H_gtk_text_iter_forward_to_line_end "gboolean gtk_text_iter_forward_to_line_end(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_to_line_end", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_to_line_end(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_toolbar_new "GtkWidget* gtk_toolbar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_toolbar_new()));
}
-static XEN gxg_gtk_text_iter_set_visible_line_offset(XEN iter, XEN char_on_line)
+static Xen gxg_gtk_toolbar_set_style(Xen toolbar, Xen style)
{
- #define H_gtk_text_iter_set_visible_line_offset "void gtk_text_iter_set_visible_line_offset(GtkTextIter* iter, \
-gint char_on_line)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_set_visible_line_offset", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(char_on_line), char_on_line, 2, "gtk_text_iter_set_visible_line_offset", "gint");
- gtk_text_iter_set_visible_line_offset(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(char_on_line));
- return(XEN_FALSE);
+ #define H_gtk_toolbar_set_style "void gtk_toolbar_set_style(GtkToolbar* toolbar, GtkToolbarStyle style)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_set_style", "GtkToolbar*");
+ Xen_check_type(Xen_is_GtkToolbarStyle(style), style, 2, "gtk_toolbar_set_style", "GtkToolbarStyle");
+ gtk_toolbar_set_style(Xen_to_C_GtkToolbar_(toolbar), Xen_to_C_GtkToolbarStyle(style));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_set_visible_line_index(XEN iter, XEN byte_on_line)
+static Xen gxg_gtk_toolbar_unset_style(Xen toolbar)
{
- #define H_gtk_text_iter_set_visible_line_index "void gtk_text_iter_set_visible_line_index(GtkTextIter* iter, \
-gint byte_on_line)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_set_visible_line_index", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(byte_on_line), byte_on_line, 2, "gtk_text_iter_set_visible_line_index", "gint");
- gtk_text_iter_set_visible_line_index(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(byte_on_line));
- return(XEN_FALSE);
+ #define H_gtk_toolbar_unset_style "void gtk_toolbar_unset_style(GtkToolbar* toolbar)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_unset_style", "GtkToolbar*");
+ gtk_toolbar_unset_style(Xen_to_C_GtkToolbar_(toolbar));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_forward_to_tag_toggle(XEN iter, XEN tag)
+static Xen gxg_gtk_toolbar_get_style(Xen toolbar)
{
- #define H_gtk_text_iter_forward_to_tag_toggle "gboolean gtk_text_iter_forward_to_tag_toggle(GtkTextIter* iter, \
-GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_to_tag_toggle", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag) || XEN_FALSE_P(tag), tag, 2, "gtk_text_iter_forward_to_tag_toggle", "GtkTextTag*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_to_tag_toggle(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextTag_(tag))));
+ #define H_gtk_toolbar_get_style "GtkToolbarStyle gtk_toolbar_get_style(GtkToolbar* toolbar)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_get_style", "GtkToolbar*");
+ return(C_to_Xen_GtkToolbarStyle(gtk_toolbar_get_style(Xen_to_C_GtkToolbar_(toolbar))));
}
-static XEN gxg_gtk_text_iter_backward_to_tag_toggle(XEN iter, XEN tag)
+static Xen gxg_gtk_tree_drag_source_row_draggable(Xen drag_source, Xen path)
{
- #define H_gtk_text_iter_backward_to_tag_toggle "gboolean gtk_text_iter_backward_to_tag_toggle(GtkTextIter* iter, \
-GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_to_tag_toggle", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag) || XEN_FALSE_P(tag), tag, 2, "gtk_text_iter_backward_to_tag_toggle", "GtkTextTag*");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_to_tag_toggle(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextTag_(tag))));
+ #define H_gtk_tree_drag_source_row_draggable "gboolean gtk_tree_drag_source_row_draggable(GtkTreeDragSource* drag_source, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeDragSource_(drag_source), drag_source, 1, "gtk_tree_drag_source_row_draggable", "GtkTreeDragSource*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_drag_source_row_draggable", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_drag_source_row_draggable(Xen_to_C_GtkTreeDragSource_(drag_source), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_iter_forward_find_char(XEN iter, XEN pred, XEN func_info, XEN limit)
+static Xen gxg_gtk_tree_drag_source_drag_data_delete(Xen drag_source, Xen path)
{
- #define H_gtk_text_iter_forward_find_char "gboolean gtk_text_iter_forward_find_char(GtkTextIter* iter, \
-GtkTextCharPredicate pred, lambda_data func_info, GtkTextIter* limit)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_find_char", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextCharPredicate_P(pred), pred, 2, "gtk_text_iter_forward_find_char", "GtkTextCharPredicate");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_text_iter_forward_find_char", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(limit) || XEN_FALSE_P(limit), limit, 4, "gtk_text_iter_forward_find_char", "GtkTextIter*");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(XEN_FALSE, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_gboolean(gtk_text_iter_forward_find_char(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextCharPredicate(pred),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkTextIter_(limit)));
- xm_unprotect_at(loc);
- return(result);
- }
+ #define H_gtk_tree_drag_source_drag_data_delete "gboolean gtk_tree_drag_source_drag_data_delete(GtkTreeDragSource* drag_source, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeDragSource_(drag_source), drag_source, 1, "gtk_tree_drag_source_drag_data_delete", "GtkTreeDragSource*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_drag_source_drag_data_delete", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_drag_source_drag_data_delete(Xen_to_C_GtkTreeDragSource_(drag_source), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_iter_backward_find_char(XEN iter, XEN pred, XEN func_info, XEN limit)
+static Xen gxg_gtk_tree_drag_source_drag_data_get(Xen drag_source, Xen path, Xen selection_data)
{
- #define H_gtk_text_iter_backward_find_char "gboolean gtk_text_iter_backward_find_char(GtkTextIter* iter, \
-GtkTextCharPredicate pred, lambda_data func_info, GtkTextIter* limit)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_find_char", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextCharPredicate_P(pred), pred, 2, "gtk_text_iter_backward_find_char", "GtkTextCharPredicate");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_text_iter_backward_find_char", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(limit) || XEN_FALSE_P(limit), limit, 4, "gtk_text_iter_backward_find_char", "GtkTextIter*");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(XEN_FALSE, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_gboolean(gtk_text_iter_backward_find_char(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextCharPredicate(pred),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkTextIter_(limit)));
- xm_unprotect_at(loc);
- return(result);
- }
+ #define H_gtk_tree_drag_source_drag_data_get "gboolean gtk_tree_drag_source_drag_data_get(GtkTreeDragSource* drag_source, \
+GtkTreePath* path, GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkTreeDragSource_(drag_source), drag_source, 1, "gtk_tree_drag_source_drag_data_get", "GtkTreeDragSource*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_drag_source_drag_data_get", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 3, "gtk_tree_drag_source_drag_data_get", "GtkSelectionData*");
+ return(C_to_Xen_gboolean(gtk_tree_drag_source_drag_data_get(Xen_to_C_GtkTreeDragSource_(drag_source), Xen_to_C_GtkTreePath_(path),
+ Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_text_iter_forward_search(XEN iter, XEN str, XEN flags, XEN match_start, XEN match_end, XEN limit)
+static Xen gxg_gtk_tree_drag_dest_drag_data_received(Xen drag_dest, Xen dest, Xen selection_data)
{
- #define H_gtk_text_iter_forward_search "gboolean gtk_text_iter_forward_search(GtkTextIter* iter, gchar* str, \
-GtkTextSearchFlags flags, GtkTextIter* match_start, GtkTextIter* match_end, GtkTextIter* limit)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_search", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 2, "gtk_text_iter_forward_search", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkTextSearchFlags_P(flags), flags, 3, "gtk_text_iter_forward_search", "GtkTextSearchFlags");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(match_start) || XEN_FALSE_P(match_start), match_start, 4, "gtk_text_iter_forward_search", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(match_end) || XEN_FALSE_P(match_end), match_end, 5, "gtk_text_iter_forward_search", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(limit) || XEN_FALSE_P(limit), limit, 6, "gtk_text_iter_forward_search", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_search(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gchar_(str), XEN_TO_C_GtkTextSearchFlags(flags),
- XEN_TO_C_GtkTextIter_(match_start), XEN_TO_C_GtkTextIter_(match_end),
- XEN_TO_C_GtkTextIter_(limit))));
+ #define H_gtk_tree_drag_dest_drag_data_received "gboolean gtk_tree_drag_dest_drag_data_received(GtkTreeDragDest* drag_dest, \
+GtkTreePath* dest, GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkTreeDragDest_(drag_dest), drag_dest, 1, "gtk_tree_drag_dest_drag_data_received", "GtkTreeDragDest*");
+ Xen_check_type(Xen_is_GtkTreePath_(dest), dest, 2, "gtk_tree_drag_dest_drag_data_received", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 3, "gtk_tree_drag_dest_drag_data_received", "GtkSelectionData*");
+ return(C_to_Xen_gboolean(gtk_tree_drag_dest_drag_data_received(Xen_to_C_GtkTreeDragDest_(drag_dest), Xen_to_C_GtkTreePath_(dest),
+ Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_text_iter_backward_search(XEN iter, XEN str, XEN flags, XEN match_start, XEN match_end, XEN limit)
+static Xen gxg_gtk_tree_drag_dest_row_drop_possible(Xen drag_dest, Xen dest_path, Xen selection_data)
{
- #define H_gtk_text_iter_backward_search "gboolean gtk_text_iter_backward_search(GtkTextIter* iter, \
-gchar* str, GtkTextSearchFlags flags, GtkTextIter* match_start, GtkTextIter* match_end, GtkTextIter* limit)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_search", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 2, "gtk_text_iter_backward_search", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkTextSearchFlags_P(flags), flags, 3, "gtk_text_iter_backward_search", "GtkTextSearchFlags");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(match_start) || XEN_FALSE_P(match_start), match_start, 4, "gtk_text_iter_backward_search", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(match_end) || XEN_FALSE_P(match_end), match_end, 5, "gtk_text_iter_backward_search", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(limit) || XEN_FALSE_P(limit), limit, 6, "gtk_text_iter_backward_search", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_search(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gchar_(str), XEN_TO_C_GtkTextSearchFlags(flags),
- XEN_TO_C_GtkTextIter_(match_start), XEN_TO_C_GtkTextIter_(match_end),
- XEN_TO_C_GtkTextIter_(limit))));
+ #define H_gtk_tree_drag_dest_row_drop_possible "gboolean gtk_tree_drag_dest_row_drop_possible(GtkTreeDragDest* drag_dest, \
+GtkTreePath* dest_path, GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkTreeDragDest_(drag_dest), drag_dest, 1, "gtk_tree_drag_dest_row_drop_possible", "GtkTreeDragDest*");
+ Xen_check_type(Xen_is_GtkTreePath_(dest_path), dest_path, 2, "gtk_tree_drag_dest_row_drop_possible", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 3, "gtk_tree_drag_dest_row_drop_possible", "GtkSelectionData*");
+ return(C_to_Xen_gboolean(gtk_tree_drag_dest_row_drop_possible(Xen_to_C_GtkTreeDragDest_(drag_dest), Xen_to_C_GtkTreePath_(dest_path),
+ Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_text_iter_equal(XEN lhs, XEN rhs)
+static Xen gxg_gtk_tree_set_row_drag_data(Xen selection_data, Xen tree_model, Xen path)
{
- #define H_gtk_text_iter_equal "gboolean gtk_text_iter_equal(GtkTextIter* lhs, GtkTextIter* rhs)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(lhs), lhs, 1, "gtk_text_iter_equal", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(rhs), rhs, 2, "gtk_text_iter_equal", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_equal(XEN_TO_C_GtkTextIter_(lhs), XEN_TO_C_GtkTextIter_(rhs))));
+ #define H_gtk_tree_set_row_drag_data "gboolean gtk_tree_set_row_drag_data(GtkSelectionData* selection_data, \
+GtkTreeModel* tree_model, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_tree_set_row_drag_data", "GtkSelectionData*");
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 2, "gtk_tree_set_row_drag_data", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 3, "gtk_tree_set_row_drag_data", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_set_row_drag_data(Xen_to_C_GtkSelectionData_(selection_data), Xen_to_C_GtkTreeModel_(tree_model),
+ Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_iter_compare(XEN lhs, XEN rhs)
+static Xen gxg_gtk_tree_get_row_drag_data(Xen selection_data, Xen ignore_tree_model, Xen ignore_path)
{
- #define H_gtk_text_iter_compare "gint gtk_text_iter_compare(GtkTextIter* lhs, GtkTextIter* rhs)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(lhs), lhs, 1, "gtk_text_iter_compare", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(rhs), rhs, 2, "gtk_text_iter_compare", "GtkTextIter*");
- return(C_TO_XEN_gint(gtk_text_iter_compare(XEN_TO_C_GtkTextIter_(lhs), XEN_TO_C_GtkTextIter_(rhs))));
+ #define H_gtk_tree_get_row_drag_data "gboolean gtk_tree_get_row_drag_data(GtkSelectionData* selection_data, \
+GtkTreeModel** [tree_model], GtkTreePath** [path])"
+ GtkTreeModel* ref_tree_model = NULL;
+ GtkTreePath* ref_path = NULL;
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_tree_get_row_drag_data", "GtkSelectionData*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_tree_get_row_drag_data(Xen_to_C_GtkSelectionData_(selection_data), &ref_tree_model, &ref_path));
+ return(Xen_list_3(result, C_to_Xen_GtkTreeModel_(ref_tree_model), C_to_Xen_GtkTreePath_(ref_path)));
+ }
}
-static XEN gxg_gtk_text_iter_in_range(XEN iter, XEN start, XEN end)
+static Xen gxg_gtk_tree_path_new(void)
{
- #define H_gtk_text_iter_in_range "gboolean gtk_text_iter_in_range(GtkTextIter* iter, GtkTextIter* start, \
-GtkTextIter* end)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_in_range", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 2, "gtk_text_iter_in_range", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 3, "gtk_text_iter_in_range", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_in_range(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end))));
+ #define H_gtk_tree_path_new "GtkTreePath* gtk_tree_path_new( void)"
+ return(C_to_Xen_GtkTreePath_(gtk_tree_path_new()));
}
-static XEN gxg_gtk_text_iter_order(XEN first, XEN second)
+static Xen gxg_gtk_tree_path_new_from_string(Xen path)
{
- #define H_gtk_text_iter_order "void gtk_text_iter_order(GtkTextIter* first, GtkTextIter* second)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(first), first, 1, "gtk_text_iter_order", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(second), second, 2, "gtk_text_iter_order", "GtkTextIter*");
- gtk_text_iter_order(XEN_TO_C_GtkTextIter_(first), XEN_TO_C_GtkTextIter_(second));
- return(XEN_FALSE);
+ #define H_gtk_tree_path_new_from_string "GtkTreePath* gtk_tree_path_new_from_string(gchar* path)"
+ Xen_check_type(Xen_is_gchar_(path), path, 1, "gtk_tree_path_new_from_string", "gchar*");
+ return(C_to_Xen_GtkTreePath_(gtk_tree_path_new_from_string(Xen_to_C_gchar_(path))));
}
-static XEN gxg_gtk_text_mark_set_visible(XEN mark, XEN setting)
+static Xen gxg_gtk_tree_path_to_string(Xen path)
{
- #define H_gtk_text_mark_set_visible "void gtk_text_mark_set_visible(GtkTextMark* mark, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 1, "gtk_text_mark_set_visible", "GtkTextMark*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_text_mark_set_visible", "gboolean");
- gtk_text_mark_set_visible(XEN_TO_C_GtkTextMark_(mark), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_tree_path_to_string "gchar* gtk_tree_path_to_string(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_to_string", "GtkTreePath*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_tree_path_to_string(Xen_to_C_GtkTreePath_(path));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_text_mark_get_visible(XEN mark)
+static Xen gxg_gtk_tree_path_new_first(void)
{
- #define H_gtk_text_mark_get_visible "gboolean gtk_text_mark_get_visible(GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 1, "gtk_text_mark_get_visible", "GtkTextMark*");
- return(C_TO_XEN_gboolean(gtk_text_mark_get_visible(XEN_TO_C_GtkTextMark_(mark))));
+ #define H_gtk_tree_path_new_first "GtkTreePath* gtk_tree_path_new_first( void)"
+ return(C_to_Xen_GtkTreePath_(gtk_tree_path_new_first()));
}
-static XEN gxg_gtk_text_mark_get_name(XEN mark)
+static Xen gxg_gtk_tree_path_append_index(Xen path, Xen index)
{
- #define H_gtk_text_mark_get_name "char* gtk_text_mark_get_name(GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 1, "gtk_text_mark_get_name", "GtkTextMark*");
- return(C_TO_XEN_char_(gtk_text_mark_get_name(XEN_TO_C_GtkTextMark_(mark))));
+ #define H_gtk_tree_path_append_index "void gtk_tree_path_append_index(GtkTreePath* path, gint index)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_append_index", "GtkTreePath*");
+ Xen_check_type(Xen_is_gint(index), index, 2, "gtk_tree_path_append_index", "gint");
+ gtk_tree_path_append_index(Xen_to_C_GtkTreePath_(path), Xen_to_C_gint(index));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_mark_get_deleted(XEN mark)
+static Xen gxg_gtk_tree_path_prepend_index(Xen path, Xen index)
{
- #define H_gtk_text_mark_get_deleted "gboolean gtk_text_mark_get_deleted(GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 1, "gtk_text_mark_get_deleted", "GtkTextMark*");
- return(C_TO_XEN_gboolean(gtk_text_mark_get_deleted(XEN_TO_C_GtkTextMark_(mark))));
+ #define H_gtk_tree_path_prepend_index "void gtk_tree_path_prepend_index(GtkTreePath* path, gint index)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_prepend_index", "GtkTreePath*");
+ Xen_check_type(Xen_is_gint(index), index, 2, "gtk_tree_path_prepend_index", "gint");
+ gtk_tree_path_prepend_index(Xen_to_C_GtkTreePath_(path), Xen_to_C_gint(index));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_mark_get_buffer(XEN mark)
+static Xen gxg_gtk_tree_path_get_depth(Xen path)
{
- #define H_gtk_text_mark_get_buffer "GtkTextBuffer* gtk_text_mark_get_buffer(GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 1, "gtk_text_mark_get_buffer", "GtkTextMark*");
- return(C_TO_XEN_GtkTextBuffer_(gtk_text_mark_get_buffer(XEN_TO_C_GtkTextMark_(mark))));
+ #define H_gtk_tree_path_get_depth "gint gtk_tree_path_get_depth(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_get_depth", "GtkTreePath*");
+ return(C_to_Xen_gint(gtk_tree_path_get_depth(Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_mark_get_left_gravity(XEN mark)
+static Xen gxg_gtk_tree_path_get_indices(Xen path)
{
- #define H_gtk_text_mark_get_left_gravity "gboolean gtk_text_mark_get_left_gravity(GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 1, "gtk_text_mark_get_left_gravity", "GtkTextMark*");
- return(C_TO_XEN_gboolean(gtk_text_mark_get_left_gravity(XEN_TO_C_GtkTextMark_(mark))));
+ #define H_gtk_tree_path_get_indices "gint* gtk_tree_path_get_indices(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_get_indices", "GtkTreePath*");
+ return(C_to_Xen_gint_(gtk_tree_path_get_indices(Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_tag_new(XEN name)
+static Xen gxg_gtk_tree_path_free(Xen path)
{
- #define H_gtk_text_tag_new "GtkTextTag* gtk_text_tag_new(gchar* name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_text_tag_new", "gchar*");
- return(C_TO_XEN_GtkTextTag_(gtk_text_tag_new(XEN_TO_C_gchar_(name))));
+ #define H_gtk_tree_path_free "void gtk_tree_path_free(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_free", "GtkTreePath*");
+ gtk_tree_path_free(Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_tag_get_priority(XEN tag)
+static Xen gxg_gtk_tree_path_copy(Xen path)
{
- #define H_gtk_text_tag_get_priority "gint gtk_text_tag_get_priority(GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag), tag, 1, "gtk_text_tag_get_priority", "GtkTextTag*");
- return(C_TO_XEN_gint(gtk_text_tag_get_priority(XEN_TO_C_GtkTextTag_(tag))));
+ #define H_gtk_tree_path_copy "GtkTreePath* gtk_tree_path_copy(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_copy", "GtkTreePath*");
+ return(C_to_Xen_GtkTreePath_(gtk_tree_path_copy(Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_tag_set_priority(XEN tag, XEN priority)
+static Xen gxg_gtk_tree_path_compare(Xen a, Xen b)
{
- #define H_gtk_text_tag_set_priority "void gtk_text_tag_set_priority(GtkTextTag* tag, gint priority)"
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag), tag, 1, "gtk_text_tag_set_priority", "GtkTextTag*");
- XEN_ASSERT_TYPE(XEN_gint_P(priority), priority, 2, "gtk_text_tag_set_priority", "gint");
- gtk_text_tag_set_priority(XEN_TO_C_GtkTextTag_(tag), XEN_TO_C_gint(priority));
- return(XEN_FALSE);
+ #define H_gtk_tree_path_compare "gint gtk_tree_path_compare(GtkTreePath* a, GtkTreePath* b)"
+ Xen_check_type(Xen_is_GtkTreePath_(a), a, 1, "gtk_tree_path_compare", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreePath_(b), b, 2, "gtk_tree_path_compare", "GtkTreePath*");
+ return(C_to_Xen_gint(gtk_tree_path_compare(Xen_to_C_GtkTreePath_(a), Xen_to_C_GtkTreePath_(b))));
}
-static XEN gxg_gtk_text_tag_event(XEN tag, XEN event_object, XEN event, XEN iter)
+static Xen gxg_gtk_tree_path_next(Xen path)
{
- #define H_gtk_text_tag_event "gboolean gtk_text_tag_event(GtkTextTag* tag, GObject* event_object, GdkEvent* event, \
-GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag), tag, 1, "gtk_text_tag_event", "GtkTextTag*");
- XEN_ASSERT_TYPE(XEN_GObject__P(event_object), event_object, 2, "gtk_text_tag_event", "GObject*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 3, "gtk_text_tag_event", "GdkEvent*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 4, "gtk_text_tag_event", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_tag_event(XEN_TO_C_GtkTextTag_(tag), XEN_TO_C_GObject_(event_object), XEN_TO_C_GdkEvent_(event),
- XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_tree_path_next "void gtk_tree_path_next(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_next", "GtkTreePath*");
+ gtk_tree_path_next(Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_attributes_new(void)
+static Xen gxg_gtk_tree_path_prev(Xen path)
{
- #define H_gtk_text_attributes_new "GtkTextAttributes* gtk_text_attributes_new( void)"
- return(C_TO_XEN_GtkTextAttributes_(gtk_text_attributes_new()));
+ #define H_gtk_tree_path_prev "gboolean gtk_tree_path_prev(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_prev", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_path_prev(Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_attributes_copy(XEN src)
+static Xen gxg_gtk_tree_path_up(Xen path)
{
- #define H_gtk_text_attributes_copy "GtkTextAttributes* gtk_text_attributes_copy(GtkTextAttributes* src)"
- XEN_ASSERT_TYPE(XEN_GtkTextAttributes__P(src), src, 1, "gtk_text_attributes_copy", "GtkTextAttributes*");
- return(C_TO_XEN_GtkTextAttributes_(gtk_text_attributes_copy(XEN_TO_C_GtkTextAttributes_(src))));
+ #define H_gtk_tree_path_up "gboolean gtk_tree_path_up(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_up", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_path_up(Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_attributes_copy_values(XEN src, XEN dest)
+static Xen gxg_gtk_tree_path_down(Xen path)
{
- #define H_gtk_text_attributes_copy_values "void gtk_text_attributes_copy_values(GtkTextAttributes* src, \
-GtkTextAttributes* dest)"
- XEN_ASSERT_TYPE(XEN_GtkTextAttributes__P(src), src, 1, "gtk_text_attributes_copy_values", "GtkTextAttributes*");
- XEN_ASSERT_TYPE(XEN_GtkTextAttributes__P(dest), dest, 2, "gtk_text_attributes_copy_values", "GtkTextAttributes*");
- gtk_text_attributes_copy_values(XEN_TO_C_GtkTextAttributes_(src), XEN_TO_C_GtkTextAttributes_(dest));
- return(XEN_FALSE);
+ #define H_gtk_tree_path_down "void gtk_tree_path_down(GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_down", "GtkTreePath*");
+ gtk_tree_path_down(Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_attributes_unref(XEN values)
+static Xen gxg_gtk_tree_path_is_ancestor(Xen path, Xen descendant)
{
- #define H_gtk_text_attributes_unref "void gtk_text_attributes_unref(GtkTextAttributes* values)"
- XEN_ASSERT_TYPE(XEN_GtkTextAttributes__P(values), values, 1, "gtk_text_attributes_unref", "GtkTextAttributes*");
- gtk_text_attributes_unref(XEN_TO_C_GtkTextAttributes_(values));
- return(XEN_FALSE);
+ #define H_gtk_tree_path_is_ancestor "gboolean gtk_tree_path_is_ancestor(GtkTreePath* path, GtkTreePath* descendant)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_is_ancestor", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreePath_(descendant), descendant, 2, "gtk_tree_path_is_ancestor", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_path_is_ancestor(Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreePath_(descendant))));
}
-static XEN gxg_gtk_text_tag_table_new(void)
+static Xen gxg_gtk_tree_path_is_descendant(Xen path, Xen ancestor)
{
- #define H_gtk_text_tag_table_new "GtkTextTagTable* gtk_text_tag_table_new( void)"
- return(C_TO_XEN_GtkTextTagTable_(gtk_text_tag_table_new()));
+ #define H_gtk_tree_path_is_descendant "gboolean gtk_tree_path_is_descendant(GtkTreePath* path, GtkTreePath* ancestor)"
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 1, "gtk_tree_path_is_descendant", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreePath_(ancestor), ancestor, 2, "gtk_tree_path_is_descendant", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_path_is_descendant(Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreePath_(ancestor))));
}
-static XEN gxg_gtk_text_tag_table_add(XEN table, XEN tag)
+static Xen gxg_gtk_tree_row_reference_new(Xen model, Xen path)
{
- #define H_gtk_text_tag_table_add "void gtk_text_tag_table_add(GtkTextTagTable* table, GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextTagTable__P(table), table, 1, "gtk_text_tag_table_add", "GtkTextTagTable*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag), tag, 2, "gtk_text_tag_table_add", "GtkTextTag*");
- gtk_text_tag_table_add(XEN_TO_C_GtkTextTagTable_(table), XEN_TO_C_GtkTextTag_(tag));
- return(XEN_FALSE);
+ #define H_gtk_tree_row_reference_new "GtkTreeRowReference* gtk_tree_row_reference_new(GtkTreeModel* model, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeModel_(model), model, 1, "gtk_tree_row_reference_new", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_row_reference_new", "GtkTreePath*");
+ return(C_to_Xen_GtkTreeRowReference_(gtk_tree_row_reference_new(Xen_to_C_GtkTreeModel_(model), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_tag_table_remove(XEN table, XEN tag)
+static Xen gxg_gtk_tree_row_reference_new_proxy(Xen proxy, Xen model, Xen path)
{
- #define H_gtk_text_tag_table_remove "void gtk_text_tag_table_remove(GtkTextTagTable* table, GtkTextTag* tag)"
- XEN_ASSERT_TYPE(XEN_GtkTextTagTable__P(table), table, 1, "gtk_text_tag_table_remove", "GtkTextTagTable*");
- XEN_ASSERT_TYPE(XEN_GtkTextTag__P(tag), tag, 2, "gtk_text_tag_table_remove", "GtkTextTag*");
- gtk_text_tag_table_remove(XEN_TO_C_GtkTextTagTable_(table), XEN_TO_C_GtkTextTag_(tag));
- return(XEN_FALSE);
+ #define H_gtk_tree_row_reference_new_proxy "GtkTreeRowReference* gtk_tree_row_reference_new_proxy(GObject* proxy, \
+GtkTreeModel* model, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GObject_(proxy), proxy, 1, "gtk_tree_row_reference_new_proxy", "GObject*");
+ Xen_check_type(Xen_is_GtkTreeModel_(model), model, 2, "gtk_tree_row_reference_new_proxy", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 3, "gtk_tree_row_reference_new_proxy", "GtkTreePath*");
+ return(C_to_Xen_GtkTreeRowReference_(gtk_tree_row_reference_new_proxy(Xen_to_C_GObject_(proxy), Xen_to_C_GtkTreeModel_(model),
+ Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_tag_table_lookup(XEN table, XEN name)
+static Xen gxg_gtk_tree_row_reference_get_path(Xen reference)
{
- #define H_gtk_text_tag_table_lookup "GtkTextTag* gtk_text_tag_table_lookup(GtkTextTagTable* table, \
-gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkTextTagTable__P(table), table, 1, "gtk_text_tag_table_lookup", "GtkTextTagTable*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_text_tag_table_lookup", "gchar*");
- return(C_TO_XEN_GtkTextTag_(gtk_text_tag_table_lookup(XEN_TO_C_GtkTextTagTable_(table), XEN_TO_C_gchar_(name))));
+ #define H_gtk_tree_row_reference_get_path "GtkTreePath* gtk_tree_row_reference_get_path(GtkTreeRowReference* reference)"
+ Xen_check_type(Xen_is_GtkTreeRowReference_(reference), reference, 1, "gtk_tree_row_reference_get_path", "GtkTreeRowReference*");
+ return(C_to_Xen_GtkTreePath_(gtk_tree_row_reference_get_path(Xen_to_C_GtkTreeRowReference_(reference))));
}
-static XEN gxg_gtk_text_tag_table_foreach(XEN table, XEN func, XEN func_info)
+static Xen gxg_gtk_tree_row_reference_valid(Xen reference)
{
- #define H_gtk_text_tag_table_foreach "void gtk_text_tag_table_foreach(GtkTextTagTable* table, GtkTextTagTableForeach func, \
-lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkTextTagTable__P(table), table, 1, "gtk_text_tag_table_foreach", "GtkTextTagTable*");
- XEN_ASSERT_TYPE(XEN_GtkTextTagTableForeach_P(func), func, 2, "gtk_text_tag_table_foreach", "GtkTextTagTableForeach");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_text_tag_table_foreach", "lambda_data");
- {
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_text_tag_table_foreach(XEN_TO_C_GtkTextTagTable_(table), XEN_TO_C_GtkTextTagTableForeach(func), XEN_TO_C_lambda_data(func_info));
- xm_unprotect_at(loc);
- return(XEN_FALSE);
- }
+ #define H_gtk_tree_row_reference_valid "gboolean gtk_tree_row_reference_valid(GtkTreeRowReference* reference)"
+ Xen_check_type(Xen_is_GtkTreeRowReference_(reference), reference, 1, "gtk_tree_row_reference_valid", "GtkTreeRowReference*");
+ return(C_to_Xen_gboolean(gtk_tree_row_reference_valid(Xen_to_C_GtkTreeRowReference_(reference))));
}
-static XEN gxg_gtk_text_tag_table_get_size(XEN table)
+static Xen gxg_gtk_tree_row_reference_free(Xen reference)
{
- #define H_gtk_text_tag_table_get_size "gint gtk_text_tag_table_get_size(GtkTextTagTable* table)"
- XEN_ASSERT_TYPE(XEN_GtkTextTagTable__P(table), table, 1, "gtk_text_tag_table_get_size", "GtkTextTagTable*");
- return(C_TO_XEN_gint(gtk_text_tag_table_get_size(XEN_TO_C_GtkTextTagTable_(table))));
+ #define H_gtk_tree_row_reference_free "void gtk_tree_row_reference_free(GtkTreeRowReference* reference)"
+ Xen_check_type(Xen_is_GtkTreeRowReference_(reference), reference, 1, "gtk_tree_row_reference_free", "GtkTreeRowReference*");
+ gtk_tree_row_reference_free(Xen_to_C_GtkTreeRowReference_(reference));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_new(void)
+static Xen gxg_gtk_tree_row_reference_inserted(Xen proxy, Xen path)
{
- #define H_gtk_text_view_new "GtkWidget* gtk_text_view_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_text_view_new()));
+ #define H_gtk_tree_row_reference_inserted "void gtk_tree_row_reference_inserted(GObject* proxy, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GObject_(proxy), proxy, 1, "gtk_tree_row_reference_inserted", "GObject*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_row_reference_inserted", "GtkTreePath*");
+ gtk_tree_row_reference_inserted(Xen_to_C_GObject_(proxy), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_new_with_buffer(XEN buffer)
+static Xen gxg_gtk_tree_row_reference_deleted(Xen proxy, Xen path)
{
- #define H_gtk_text_view_new_with_buffer "GtkWidget* gtk_text_view_new_with_buffer(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_view_new_with_buffer", "GtkTextBuffer*");
- return(C_TO_XEN_GtkWidget_(gtk_text_view_new_with_buffer(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_tree_row_reference_deleted "void gtk_tree_row_reference_deleted(GObject* proxy, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GObject_(proxy), proxy, 1, "gtk_tree_row_reference_deleted", "GObject*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_row_reference_deleted", "GtkTreePath*");
+ gtk_tree_row_reference_deleted(Xen_to_C_GObject_(proxy), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_set_buffer(XEN text_view, XEN buffer)
+static Xen gxg_gtk_tree_row_reference_reordered(Xen proxy, Xen path, Xen iter, Xen new_order)
{
- #define H_gtk_text_view_set_buffer "void gtk_text_view_set_buffer(GtkTextView* text_view, GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_buffer", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 2, "gtk_text_view_set_buffer", "GtkTextBuffer*");
- gtk_text_view_set_buffer(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextBuffer_(buffer));
- return(XEN_FALSE);
+ #define H_gtk_tree_row_reference_reordered "void gtk_tree_row_reference_reordered(GObject* proxy, GtkTreePath* path, \
+GtkTreeIter* iter, gint* new_order)"
+ Xen_check_type(Xen_is_GObject_(proxy), proxy, 1, "gtk_tree_row_reference_reordered", "GObject*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_row_reference_reordered", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 3, "gtk_tree_row_reference_reordered", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gint_(new_order), new_order, 4, "gtk_tree_row_reference_reordered", "gint*");
+ gtk_tree_row_reference_reordered(Xen_to_C_GObject_(proxy), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_gint_(new_order));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_buffer(XEN text_view)
+static Xen gxg_gtk_tree_iter_copy(Xen iter)
{
- #define H_gtk_text_view_get_buffer "GtkTextBuffer* gtk_text_view_get_buffer(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_buffer", "GtkTextView*");
- return(C_TO_XEN_GtkTextBuffer_(gtk_text_view_get_buffer(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_iter_copy "GtkTreeIter* gtk_tree_iter_copy(GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 1, "gtk_tree_iter_copy", "GtkTreeIter*");
+ return(C_to_Xen_GtkTreeIter_(gtk_tree_iter_copy(Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_text_view_scroll_to_iter(XEN text_view, XEN iter, XEN within_margin, XEN use_align, XEN xalign, XEN yalign)
+static Xen gxg_gtk_tree_iter_free(Xen iter)
{
- #define H_gtk_text_view_scroll_to_iter "gboolean gtk_text_view_scroll_to_iter(GtkTextView* text_view, \
-GtkTextIter* iter, gdouble within_margin, gboolean use_align, gdouble xalign, gdouble yalign)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_scroll_to_iter", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_scroll_to_iter", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(within_margin), within_margin, 3, "gtk_text_view_scroll_to_iter", "gdouble");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_align), use_align, 4, "gtk_text_view_scroll_to_iter", "gboolean");
- XEN_ASSERT_TYPE(XEN_gdouble_P(xalign), xalign, 5, "gtk_text_view_scroll_to_iter", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(yalign), yalign, 6, "gtk_text_view_scroll_to_iter", "gdouble");
- return(C_TO_XEN_gboolean(gtk_text_view_scroll_to_iter(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gdouble(within_margin),
- XEN_TO_C_gboolean(use_align), XEN_TO_C_gdouble(xalign), XEN_TO_C_gdouble(yalign))));
+ #define H_gtk_tree_iter_free "void gtk_tree_iter_free(GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 1, "gtk_tree_iter_free", "GtkTreeIter*");
+ gtk_tree_iter_free(Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_scroll_to_mark(XEN text_view, XEN mark, XEN within_margin, XEN use_align, XEN xalign, XEN yalign)
+static Xen gxg_gtk_tree_model_get_flags(Xen tree_model)
{
- #define H_gtk_text_view_scroll_to_mark "void gtk_text_view_scroll_to_mark(GtkTextView* text_view, GtkTextMark* mark, \
-gdouble within_margin, gboolean use_align, gdouble xalign, gdouble yalign)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_scroll_to_mark", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 2, "gtk_text_view_scroll_to_mark", "GtkTextMark*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(within_margin), within_margin, 3, "gtk_text_view_scroll_to_mark", "gdouble");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_align), use_align, 4, "gtk_text_view_scroll_to_mark", "gboolean");
- XEN_ASSERT_TYPE(XEN_gdouble_P(xalign), xalign, 5, "gtk_text_view_scroll_to_mark", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(yalign), yalign, 6, "gtk_text_view_scroll_to_mark", "gdouble");
- gtk_text_view_scroll_to_mark(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextMark_(mark), XEN_TO_C_gdouble(within_margin),
- XEN_TO_C_gboolean(use_align), XEN_TO_C_gdouble(xalign), XEN_TO_C_gdouble(yalign));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_get_flags "GtkTreeModelFlags gtk_tree_model_get_flags(GtkTreeModel* tree_model)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_get_flags", "GtkTreeModel*");
+ return(C_to_Xen_GtkTreeModelFlags(gtk_tree_model_get_flags(Xen_to_C_GtkTreeModel_(tree_model))));
}
-static XEN gxg_gtk_text_view_scroll_mark_onscreen(XEN text_view, XEN mark)
+static Xen gxg_gtk_tree_model_get_n_columns(Xen tree_model)
{
- #define H_gtk_text_view_scroll_mark_onscreen "void gtk_text_view_scroll_mark_onscreen(GtkTextView* text_view, \
-GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_scroll_mark_onscreen", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 2, "gtk_text_view_scroll_mark_onscreen", "GtkTextMark*");
- gtk_text_view_scroll_mark_onscreen(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextMark_(mark));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_get_n_columns "gint gtk_tree_model_get_n_columns(GtkTreeModel* tree_model)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_get_n_columns", "GtkTreeModel*");
+ return(C_to_Xen_gint(gtk_tree_model_get_n_columns(Xen_to_C_GtkTreeModel_(tree_model))));
}
-static XEN gxg_gtk_text_view_move_mark_onscreen(XEN text_view, XEN mark)
+static Xen gxg_gtk_tree_model_get_column_type(Xen tree_model, Xen index)
{
- #define H_gtk_text_view_move_mark_onscreen "gboolean gtk_text_view_move_mark_onscreen(GtkTextView* text_view, \
-GtkTextMark* mark)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_move_mark_onscreen", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 2, "gtk_text_view_move_mark_onscreen", "GtkTextMark*");
- return(C_TO_XEN_gboolean(gtk_text_view_move_mark_onscreen(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextMark_(mark))));
+ #define H_gtk_tree_model_get_column_type "GType gtk_tree_model_get_column_type(GtkTreeModel* tree_model, \
+gint index)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_get_column_type", "GtkTreeModel*");
+ Xen_check_type(Xen_is_gint(index), index, 2, "gtk_tree_model_get_column_type", "gint");
+ return(C_to_Xen_GType(gtk_tree_model_get_column_type(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_gint(index))));
}
-static XEN gxg_gtk_text_view_place_cursor_onscreen(XEN text_view)
+static Xen gxg_gtk_tree_model_get_iter(Xen tree_model, Xen iter, Xen path)
{
- #define H_gtk_text_view_place_cursor_onscreen "gboolean gtk_text_view_place_cursor_onscreen(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_place_cursor_onscreen", "GtkTextView*");
- return(C_TO_XEN_gboolean(gtk_text_view_place_cursor_onscreen(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_model_get_iter "gboolean gtk_tree_model_get_iter(GtkTreeModel* tree_model, GtkTreeIter* iter, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_get_iter", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_get_iter", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 3, "gtk_tree_model_get_iter", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_model_get_iter(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_view_get_visible_rect(XEN text_view, XEN visible_rect)
+static Xen gxg_gtk_tree_model_get_iter_from_string(Xen tree_model, Xen iter, Xen path_string)
{
- #define H_gtk_text_view_get_visible_rect "void gtk_text_view_get_visible_rect(GtkTextView* text_view, \
-GdkRectangle* visible_rect)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_visible_rect", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(visible_rect), visible_rect, 2, "gtk_text_view_get_visible_rect", "GdkRectangle*");
- gtk_text_view_get_visible_rect(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GdkRectangle_(visible_rect));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_get_iter_from_string "gboolean gtk_tree_model_get_iter_from_string(GtkTreeModel* tree_model, \
+GtkTreeIter* iter, gchar* path_string)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_get_iter_from_string", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_get_iter_from_string", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gchar_(path_string), path_string, 3, "gtk_tree_model_get_iter_from_string", "gchar*");
+ return(C_to_Xen_gboolean(gtk_tree_model_get_iter_from_string(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter),
+ Xen_to_C_gchar_(path_string))));
}
-static XEN gxg_gtk_text_view_set_cursor_visible(XEN text_view, XEN setting)
+static Xen gxg_gtk_tree_model_get_iter_first(Xen tree_model, Xen iter)
{
- #define H_gtk_text_view_set_cursor_visible "void gtk_text_view_set_cursor_visible(GtkTextView* text_view, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_cursor_visible", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_text_view_set_cursor_visible", "gboolean");
- gtk_text_view_set_cursor_visible(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_get_iter_first "gboolean gtk_tree_model_get_iter_first(GtkTreeModel* tree_model, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_get_iter_first", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_get_iter_first", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_model_get_iter_first(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_text_view_get_cursor_visible(XEN text_view)
+static Xen gxg_gtk_tree_model_get_path(Xen tree_model, Xen iter)
{
- #define H_gtk_text_view_get_cursor_visible "gboolean gtk_text_view_get_cursor_visible(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_cursor_visible", "GtkTextView*");
- return(C_TO_XEN_gboolean(gtk_text_view_get_cursor_visible(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_model_get_path "GtkTreePath* gtk_tree_model_get_path(GtkTreeModel* tree_model, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_get_path", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_get_path", "GtkTreeIter*");
+ return(C_to_Xen_GtkTreePath_(gtk_tree_model_get_path(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_text_view_get_iter_location(XEN text_view, XEN iter, XEN location)
+static Xen gxg_gtk_tree_model_iter_next(Xen tree_model, Xen iter)
{
- #define H_gtk_text_view_get_iter_location "void gtk_text_view_get_iter_location(GtkTextView* text_view, \
-GtkTextIter* iter, GdkRectangle* location)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_iter_location", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_get_iter_location", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(location), location, 3, "gtk_text_view_get_iter_location", "GdkRectangle*");
- gtk_text_view_get_iter_location(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_GdkRectangle_(location));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_iter_next "gboolean gtk_tree_model_iter_next(GtkTreeModel* tree_model, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_iter_next", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_iter_next", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_model_iter_next(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_text_view_get_iter_at_location(XEN text_view, XEN iter, XEN x, XEN y)
+static Xen gxg_gtk_tree_model_iter_children(Xen tree_model, Xen iter, Xen parent)
{
- #define H_gtk_text_view_get_iter_at_location "void gtk_text_view_get_iter_at_location(GtkTextView* text_view, \
-GtkTextIter* iter, gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_iter_at_location", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_get_iter_at_location", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 3, "gtk_text_view_get_iter_at_location", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 4, "gtk_text_view_get_iter_at_location", "gint");
- gtk_text_view_get_iter_at_location(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_iter_children "gboolean gtk_tree_model_iter_children(GtkTreeModel* tree_model, \
+GtkTreeIter* iter, GtkTreeIter* parent)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_iter_children", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_iter_children", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(parent) || Xen_is_false(parent), parent, 3, "gtk_tree_model_iter_children", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_model_iter_children(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter),
+ Xen_to_C_GtkTreeIter_(parent))));
}
-static XEN gxg_gtk_text_view_get_line_yrange(XEN text_view, XEN iter, XEN ignore_y, XEN ignore_height)
+static Xen gxg_gtk_tree_model_iter_has_child(Xen tree_model, Xen iter)
{
- #define H_gtk_text_view_get_line_yrange "void gtk_text_view_get_line_yrange(GtkTextView* text_view, \
-GtkTextIter* iter, gint* [y], gint* [height])"
- gint ref_y;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_line_yrange", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_get_line_yrange", "GtkTextIter*");
- gtk_text_view_get_line_yrange(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter), &ref_y, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_y), C_TO_XEN_gint(ref_height)));
+ #define H_gtk_tree_model_iter_has_child "gboolean gtk_tree_model_iter_has_child(GtkTreeModel* tree_model, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_iter_has_child", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_iter_has_child", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_model_iter_has_child(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_text_view_get_line_at_y(XEN text_view, XEN target_iter, XEN y, XEN ignore_line_top)
+static Xen gxg_gtk_tree_model_iter_n_children(Xen tree_model, Xen iter)
{
- #define H_gtk_text_view_get_line_at_y "void gtk_text_view_get_line_at_y(GtkTextView* text_view, GtkTextIter* target_iter, \
-gint y, gint* [line_top])"
- gint ref_line_top;
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_line_at_y", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(target_iter), target_iter, 2, "gtk_text_view_get_line_at_y", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_text_view_get_line_at_y", "gint");
- gtk_text_view_get_line_at_y(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(target_iter), XEN_TO_C_gint(y), &ref_line_top);
- return(XEN_LIST_1(C_TO_XEN_gint(ref_line_top)));
+ #define H_gtk_tree_model_iter_n_children "gint gtk_tree_model_iter_n_children(GtkTreeModel* tree_model, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_iter_n_children", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter) || Xen_is_false(iter), iter, 2, "gtk_tree_model_iter_n_children", "GtkTreeIter*");
+ return(C_to_Xen_gint(gtk_tree_model_iter_n_children(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_text_view_buffer_to_window_coords(XEN text_view, XEN win, XEN buffer_x, XEN buffer_y, XEN ignore_window_x, XEN ignore_window_y)
+static Xen gxg_gtk_tree_model_iter_nth_child(Xen tree_model, Xen iter, Xen parent, Xen n)
{
- #define H_gtk_text_view_buffer_to_window_coords "void gtk_text_view_buffer_to_window_coords(GtkTextView* text_view, \
-GtkTextWindowType win, gint buffer_x, gint buffer_y, gint* [window_x], gint* [window_y])"
- gint ref_window_x;
- gint ref_window_y;
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_buffer_to_window_coords", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextWindowType_P(win), win, 2, "gtk_text_view_buffer_to_window_coords", "GtkTextWindowType");
- XEN_ASSERT_TYPE(XEN_gint_P(buffer_x), buffer_x, 3, "gtk_text_view_buffer_to_window_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(buffer_y), buffer_y, 4, "gtk_text_view_buffer_to_window_coords", "gint");
- gtk_text_view_buffer_to_window_coords(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextWindowType(win), XEN_TO_C_gint(buffer_x),
- XEN_TO_C_gint(buffer_y), &ref_window_x, &ref_window_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_window_x), C_TO_XEN_gint(ref_window_y)));
+ #define H_gtk_tree_model_iter_nth_child "gboolean gtk_tree_model_iter_nth_child(GtkTreeModel* tree_model, \
+GtkTreeIter* iter, GtkTreeIter* parent, gint n)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_iter_nth_child", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_iter_nth_child", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(parent) || Xen_is_false(parent), parent, 3, "gtk_tree_model_iter_nth_child", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gint(n), n, 4, "gtk_tree_model_iter_nth_child", "gint");
+ return(C_to_Xen_gboolean(gtk_tree_model_iter_nth_child(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter),
+ Xen_to_C_GtkTreeIter_(parent), Xen_to_C_gint(n))));
}
-static XEN gxg_gtk_text_view_window_to_buffer_coords(XEN text_view, XEN win, XEN window_x, XEN window_y, XEN ignore_buffer_x, XEN ignore_buffer_y)
+static Xen gxg_gtk_tree_model_iter_parent(Xen tree_model, Xen iter, Xen child)
{
- #define H_gtk_text_view_window_to_buffer_coords "void gtk_text_view_window_to_buffer_coords(GtkTextView* text_view, \
-GtkTextWindowType win, gint window_x, gint window_y, gint* [buffer_x], gint* [buffer_y])"
- gint ref_buffer_x;
- gint ref_buffer_y;
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_window_to_buffer_coords", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextWindowType_P(win), win, 2, "gtk_text_view_window_to_buffer_coords", "GtkTextWindowType");
- XEN_ASSERT_TYPE(XEN_gint_P(window_x), window_x, 3, "gtk_text_view_window_to_buffer_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(window_y), window_y, 4, "gtk_text_view_window_to_buffer_coords", "gint");
- gtk_text_view_window_to_buffer_coords(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextWindowType(win), XEN_TO_C_gint(window_x),
- XEN_TO_C_gint(window_y), &ref_buffer_x, &ref_buffer_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_buffer_x), C_TO_XEN_gint(ref_buffer_y)));
+ #define H_gtk_tree_model_iter_parent "gboolean gtk_tree_model_iter_parent(GtkTreeModel* tree_model, \
+GtkTreeIter* iter, GtkTreeIter* child)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_iter_parent", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_iter_parent", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(child), child, 3, "gtk_tree_model_iter_parent", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_model_iter_parent(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(child))));
}
-static XEN gxg_gtk_text_view_get_window(XEN text_view, XEN win)
+static Xen gxg_gtk_tree_model_ref_node(Xen tree_model, Xen iter)
{
- #define H_gtk_text_view_get_window "GdkWindow* gtk_text_view_get_window(GtkTextView* text_view, GtkTextWindowType win)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_window", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextWindowType_P(win), win, 2, "gtk_text_view_get_window", "GtkTextWindowType");
- return(C_TO_XEN_GdkWindow_(gtk_text_view_get_window(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextWindowType(win))));
+ #define H_gtk_tree_model_ref_node "void gtk_tree_model_ref_node(GtkTreeModel* tree_model, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_ref_node", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_ref_node", "GtkTreeIter*");
+ gtk_tree_model_ref_node(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_window_type(XEN text_view, XEN window)
+static Xen gxg_gtk_tree_model_unref_node(Xen tree_model, Xen iter)
{
- #define H_gtk_text_view_get_window_type "GtkTextWindowType gtk_text_view_get_window_type(GtkTextView* text_view, \
-GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_window_type", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 2, "gtk_text_view_get_window_type", "GdkWindow*");
- return(C_TO_XEN_GtkTextWindowType(gtk_text_view_get_window_type(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_tree_model_unref_node "void gtk_tree_model_unref_node(GtkTreeModel* tree_model, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_unref_node", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_unref_node", "GtkTreeIter*");
+ gtk_tree_model_unref_node(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_set_border_window_size(XEN text_view, XEN type, XEN size)
+static Xen gxg_gtk_tree_model_foreach(Xen model, Xen func, Xen func_info)
{
- #define H_gtk_text_view_set_border_window_size "void gtk_text_view_set_border_window_size(GtkTextView* text_view, \
-GtkTextWindowType type, gint size)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_border_window_size", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextWindowType_P(type), type, 2, "gtk_text_view_set_border_window_size", "GtkTextWindowType");
- XEN_ASSERT_TYPE(XEN_gint_P(size), size, 3, "gtk_text_view_set_border_window_size", "gint");
- gtk_text_view_set_border_window_size(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextWindowType(type), XEN_TO_C_gint(size));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_foreach "void gtk_tree_model_foreach(GtkTreeModel* model, GtkTreeModelForeachFunc func, \
+lambda_data func_info)"
+ Xen_check_type(Xen_is_GtkTreeModel_(model), model, 1, "gtk_tree_model_foreach", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeModelForeachFunc(func), func, 2, "gtk_tree_model_foreach", "GtkTreeModelForeachFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_model_foreach", "lambda_data");
+ {
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_tree_model_foreach(Xen_to_C_GtkTreeModel_(model), Xen_to_C_GtkTreeModelForeachFunc(func), Xen_to_C_lambda_data(func_info));
+ xm_unprotect_at(loc);
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_text_view_get_border_window_size(XEN text_view, XEN type)
+static Xen gxg_gtk_tree_model_row_changed(Xen tree_model, Xen path, Xen iter)
{
- #define H_gtk_text_view_get_border_window_size "gint gtk_text_view_get_border_window_size(GtkTextView* text_view, \
-GtkTextWindowType type)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_border_window_size", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextWindowType_P(type), type, 2, "gtk_text_view_get_border_window_size", "GtkTextWindowType");
- return(C_TO_XEN_gint(gtk_text_view_get_border_window_size(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextWindowType(type))));
+ #define H_gtk_tree_model_row_changed "void gtk_tree_model_row_changed(GtkTreeModel* tree_model, GtkTreePath* path, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_row_changed", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_model_row_changed", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 3, "gtk_tree_model_row_changed", "GtkTreeIter*");
+ gtk_tree_model_row_changed(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_forward_display_line(XEN text_view, XEN iter)
+static Xen gxg_gtk_tree_model_row_inserted(Xen tree_model, Xen path, Xen iter)
{
- #define H_gtk_text_view_forward_display_line "gboolean gtk_text_view_forward_display_line(GtkTextView* text_view, \
-GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_forward_display_line", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_forward_display_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_view_forward_display_line(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_tree_model_row_inserted "void gtk_tree_model_row_inserted(GtkTreeModel* tree_model, GtkTreePath* path, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_row_inserted", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_model_row_inserted", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 3, "gtk_tree_model_row_inserted", "GtkTreeIter*");
+ gtk_tree_model_row_inserted(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_backward_display_line(XEN text_view, XEN iter)
+static Xen gxg_gtk_tree_model_row_has_child_toggled(Xen tree_model, Xen path, Xen iter)
{
- #define H_gtk_text_view_backward_display_line "gboolean gtk_text_view_backward_display_line(GtkTextView* text_view, \
-GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_backward_display_line", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_backward_display_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_view_backward_display_line(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_tree_model_row_has_child_toggled "void gtk_tree_model_row_has_child_toggled(GtkTreeModel* tree_model, \
+GtkTreePath* path, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_row_has_child_toggled", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_model_row_has_child_toggled", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 3, "gtk_tree_model_row_has_child_toggled", "GtkTreeIter*");
+ gtk_tree_model_row_has_child_toggled(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_forward_display_line_end(XEN text_view, XEN iter)
+static Xen gxg_gtk_tree_model_row_deleted(Xen tree_model, Xen path)
{
- #define H_gtk_text_view_forward_display_line_end "gboolean gtk_text_view_forward_display_line_end(GtkTextView* text_view, \
-GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_forward_display_line_end", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_forward_display_line_end", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_view_forward_display_line_end(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_tree_model_row_deleted "void gtk_tree_model_row_deleted(GtkTreeModel* tree_model, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_row_deleted", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_model_row_deleted", "GtkTreePath*");
+ gtk_tree_model_row_deleted(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_backward_display_line_start(XEN text_view, XEN iter)
+static Xen gxg_gtk_tree_model_rows_reordered(Xen tree_model, Xen path, Xen iter, Xen new_order)
{
- #define H_gtk_text_view_backward_display_line_start "gboolean gtk_text_view_backward_display_line_start(GtkTextView* text_view, \
-GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_backward_display_line_start", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_backward_display_line_start", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_view_backward_display_line_start(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_tree_model_rows_reordered "void gtk_tree_model_rows_reordered(GtkTreeModel* tree_model, \
+GtkTreePath* path, GtkTreeIter* iter, gint* new_order)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_rows_reordered", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_model_rows_reordered", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 3, "gtk_tree_model_rows_reordered", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gint_(new_order), new_order, 4, "gtk_tree_model_rows_reordered", "gint*");
+ gtk_tree_model_rows_reordered(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeIter_(iter),
+ Xen_to_C_gint_(new_order));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_starts_display_line(XEN text_view, XEN iter)
+static Xen gxg_gtk_tree_model_sort_new_with_model(Xen child_model)
{
- #define H_gtk_text_view_starts_display_line "gboolean gtk_text_view_starts_display_line(GtkTextView* text_view, \
-GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_starts_display_line", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_starts_display_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_view_starts_display_line(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_tree_model_sort_new_with_model "GtkTreeModel* gtk_tree_model_sort_new_with_model(GtkTreeModel* child_model)"
+ Xen_check_type(Xen_is_GtkTreeModel_(child_model), child_model, 1, "gtk_tree_model_sort_new_with_model", "GtkTreeModel*");
+ return(C_to_Xen_GtkTreeModel_(gtk_tree_model_sort_new_with_model(Xen_to_C_GtkTreeModel_(child_model))));
}
-static XEN gxg_gtk_text_view_move_visually(XEN text_view, XEN iter, XEN count)
+static Xen gxg_gtk_tree_model_sort_get_model(Xen tree_model)
{
- #define H_gtk_text_view_move_visually "gboolean gtk_text_view_move_visually(GtkTextView* text_view, \
-GtkTextIter* iter, gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_move_visually", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_move_visually", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 3, "gtk_text_view_move_visually", "gint");
- return(C_TO_XEN_gboolean(gtk_text_view_move_visually(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_tree_model_sort_get_model "GtkTreeModel* gtk_tree_model_sort_get_model(GtkTreeModelSort* tree_model)"
+ Xen_check_type(Xen_is_GtkTreeModelSort_(tree_model), tree_model, 1, "gtk_tree_model_sort_get_model", "GtkTreeModelSort*");
+ return(C_to_Xen_GtkTreeModel_(gtk_tree_model_sort_get_model(Xen_to_C_GtkTreeModelSort_(tree_model))));
}
-static XEN gxg_gtk_text_view_add_child_at_anchor(XEN text_view, XEN child, XEN anchor)
+static Xen gxg_gtk_tree_model_sort_convert_child_path_to_path(Xen tree_model_sort, Xen child_path)
{
- #define H_gtk_text_view_add_child_at_anchor "void gtk_text_view_add_child_at_anchor(GtkTextView* text_view, \
-GtkWidget* child, GtkTextChildAnchor* anchor)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_add_child_at_anchor", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_text_view_add_child_at_anchor", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkTextChildAnchor__P(anchor), anchor, 3, "gtk_text_view_add_child_at_anchor", "GtkTextChildAnchor*");
- gtk_text_view_add_child_at_anchor(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkTextChildAnchor_(anchor));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_sort_convert_child_path_to_path "GtkTreePath* gtk_tree_model_sort_convert_child_path_to_path(GtkTreeModelSort* tree_model_sort, \
+GtkTreePath* child_path)"
+ Xen_check_type(Xen_is_GtkTreeModelSort_(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_convert_child_path_to_path", "GtkTreeModelSort*");
+ Xen_check_type(Xen_is_GtkTreePath_(child_path), child_path, 2, "gtk_tree_model_sort_convert_child_path_to_path", "GtkTreePath*");
+ return(C_to_Xen_GtkTreePath_(gtk_tree_model_sort_convert_child_path_to_path(Xen_to_C_GtkTreeModelSort_(tree_model_sort),
+ Xen_to_C_GtkTreePath_(child_path))));
}
-static XEN gxg_gtk_text_view_add_child_in_window(XEN text_view, XEN child, XEN which_window, XEN xpos, XEN ypos)
+static Xen gxg_gtk_tree_model_sort_convert_child_iter_to_iter(Xen tree_model_sort, Xen sort_iter, Xen child_iter)
{
- #define H_gtk_text_view_add_child_in_window "void gtk_text_view_add_child_in_window(GtkTextView* text_view, \
-GtkWidget* child, GtkTextWindowType which_window, gint xpos, gint ypos)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_add_child_in_window", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_text_view_add_child_in_window", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkTextWindowType_P(which_window), which_window, 3, "gtk_text_view_add_child_in_window", "GtkTextWindowType");
- XEN_ASSERT_TYPE(XEN_gint_P(xpos), xpos, 4, "gtk_text_view_add_child_in_window", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(ypos), ypos, 5, "gtk_text_view_add_child_in_window", "gint");
- gtk_text_view_add_child_in_window(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkTextWindowType(which_window),
- XEN_TO_C_gint(xpos), XEN_TO_C_gint(ypos));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_sort_convert_child_iter_to_iter "void gtk_tree_model_sort_convert_child_iter_to_iter(GtkTreeModelSort* tree_model_sort, \
+GtkTreeIter* sort_iter, GtkTreeIter* child_iter)"
+ Xen_check_type(Xen_is_GtkTreeModelSort_(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_convert_child_iter_to_iter", "GtkTreeModelSort*");
+ Xen_check_type(Xen_is_GtkTreeIter_(sort_iter), sort_iter, 2, "gtk_tree_model_sort_convert_child_iter_to_iter", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(child_iter), child_iter, 3, "gtk_tree_model_sort_convert_child_iter_to_iter", "GtkTreeIter*");
+ gtk_tree_model_sort_convert_child_iter_to_iter(Xen_to_C_GtkTreeModelSort_(tree_model_sort), Xen_to_C_GtkTreeIter_(sort_iter),
+ Xen_to_C_GtkTreeIter_(child_iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_move_child(XEN text_view, XEN child, XEN xpos, XEN ypos)
+static Xen gxg_gtk_tree_model_sort_convert_path_to_child_path(Xen tree_model_sort, Xen sorted_path)
{
- #define H_gtk_text_view_move_child "void gtk_text_view_move_child(GtkTextView* text_view, GtkWidget* child, \
-gint xpos, gint ypos)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_move_child", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_text_view_move_child", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(xpos), xpos, 3, "gtk_text_view_move_child", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(ypos), ypos, 4, "gtk_text_view_move_child", "gint");
- gtk_text_view_move_child(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gint(xpos), XEN_TO_C_gint(ypos));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_sort_convert_path_to_child_path "GtkTreePath* gtk_tree_model_sort_convert_path_to_child_path(GtkTreeModelSort* tree_model_sort, \
+GtkTreePath* sorted_path)"
+ Xen_check_type(Xen_is_GtkTreeModelSort_(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_convert_path_to_child_path", "GtkTreeModelSort*");
+ Xen_check_type(Xen_is_GtkTreePath_(sorted_path), sorted_path, 2, "gtk_tree_model_sort_convert_path_to_child_path", "GtkTreePath*");
+ return(C_to_Xen_GtkTreePath_(gtk_tree_model_sort_convert_path_to_child_path(Xen_to_C_GtkTreeModelSort_(tree_model_sort),
+ Xen_to_C_GtkTreePath_(sorted_path))));
}
-static XEN gxg_gtk_text_view_set_wrap_mode(XEN text_view, XEN wrap_mode)
+static Xen gxg_gtk_tree_model_sort_convert_iter_to_child_iter(Xen tree_model_sort, Xen child_iter, Xen sorted_iter)
{
- #define H_gtk_text_view_set_wrap_mode "void gtk_text_view_set_wrap_mode(GtkTextView* text_view, GtkWrapMode wrap_mode)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_wrap_mode", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkWrapMode_P(wrap_mode), wrap_mode, 2, "gtk_text_view_set_wrap_mode", "GtkWrapMode");
- gtk_text_view_set_wrap_mode(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkWrapMode(wrap_mode));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_sort_convert_iter_to_child_iter "void gtk_tree_model_sort_convert_iter_to_child_iter(GtkTreeModelSort* tree_model_sort, \
+GtkTreeIter* child_iter, GtkTreeIter* sorted_iter)"
+ Xen_check_type(Xen_is_GtkTreeModelSort_(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_convert_iter_to_child_iter", "GtkTreeModelSort*");
+ Xen_check_type(Xen_is_GtkTreeIter_(child_iter), child_iter, 2, "gtk_tree_model_sort_convert_iter_to_child_iter", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(sorted_iter), sorted_iter, 3, "gtk_tree_model_sort_convert_iter_to_child_iter", "GtkTreeIter*");
+ gtk_tree_model_sort_convert_iter_to_child_iter(Xen_to_C_GtkTreeModelSort_(tree_model_sort), Xen_to_C_GtkTreeIter_(child_iter),
+ Xen_to_C_GtkTreeIter_(sorted_iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_wrap_mode(XEN text_view)
+static Xen gxg_gtk_tree_model_sort_reset_default_sort_func(Xen tree_model_sort)
{
- #define H_gtk_text_view_get_wrap_mode "GtkWrapMode gtk_text_view_get_wrap_mode(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_wrap_mode", "GtkTextView*");
- return(C_TO_XEN_GtkWrapMode(gtk_text_view_get_wrap_mode(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_model_sort_reset_default_sort_func "void gtk_tree_model_sort_reset_default_sort_func(GtkTreeModelSort* tree_model_sort)"
+ Xen_check_type(Xen_is_GtkTreeModelSort_(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_reset_default_sort_func", "GtkTreeModelSort*");
+ gtk_tree_model_sort_reset_default_sort_func(Xen_to_C_GtkTreeModelSort_(tree_model_sort));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_set_editable(XEN text_view, XEN setting)
+static Xen gxg_gtk_tree_model_sort_clear_cache(Xen tree_model_sort)
{
- #define H_gtk_text_view_set_editable "void gtk_text_view_set_editable(GtkTextView* text_view, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_editable", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_text_view_set_editable", "gboolean");
- gtk_text_view_set_editable(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_sort_clear_cache "void gtk_tree_model_sort_clear_cache(GtkTreeModelSort* tree_model_sort)"
+ Xen_check_type(Xen_is_GtkTreeModelSort_(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_clear_cache", "GtkTreeModelSort*");
+ gtk_tree_model_sort_clear_cache(Xen_to_C_GtkTreeModelSort_(tree_model_sort));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_editable(XEN text_view)
+static Xen gxg_gtk_tree_selection_set_mode(Xen selection, Xen type)
{
- #define H_gtk_text_view_get_editable "gboolean gtk_text_view_get_editable(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_editable", "GtkTextView*");
- return(C_TO_XEN_gboolean(gtk_text_view_get_editable(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_selection_set_mode "void gtk_tree_selection_set_mode(GtkTreeSelection* selection, \
+GtkSelectionMode type)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_set_mode", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkSelectionMode(type), type, 2, "gtk_tree_selection_set_mode", "GtkSelectionMode");
+ gtk_tree_selection_set_mode(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkSelectionMode(type));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_set_pixels_above_lines(XEN text_view, XEN pixels_above_lines)
+static Xen gxg_gtk_tree_selection_get_mode(Xen selection)
{
- #define H_gtk_text_view_set_pixels_above_lines "void gtk_text_view_set_pixels_above_lines(GtkTextView* text_view, \
-gint pixels_above_lines)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_pixels_above_lines", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gint_P(pixels_above_lines), pixels_above_lines, 2, "gtk_text_view_set_pixels_above_lines", "gint");
- gtk_text_view_set_pixels_above_lines(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gint(pixels_above_lines));
- return(XEN_FALSE);
+ #define H_gtk_tree_selection_get_mode "GtkSelectionMode gtk_tree_selection_get_mode(GtkTreeSelection* selection)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_get_mode", "GtkTreeSelection*");
+ return(C_to_Xen_GtkSelectionMode(gtk_tree_selection_get_mode(Xen_to_C_GtkTreeSelection_(selection))));
}
-static XEN gxg_gtk_text_view_get_pixels_above_lines(XEN text_view)
+static Xen gxg_gtk_tree_selection_set_select_function(Xen selection, Xen func, Xen func_info, Xen destroy)
{
- #define H_gtk_text_view_get_pixels_above_lines "gint gtk_text_view_get_pixels_above_lines(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_pixels_above_lines", "GtkTextView*");
- return(C_TO_XEN_gint(gtk_text_view_get_pixels_above_lines(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_selection_set_select_function "void gtk_tree_selection_set_select_function(GtkTreeSelection* selection, \
+GtkTreeSelectionFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_set_select_function", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreeSelectionFunc(func), func, 2, "gtk_tree_selection_set_select_function", "GtkTreeSelectionFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_selection_set_select_function", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(destroy), destroy, 4, "gtk_tree_selection_set_select_function", "GtkDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, destroy);
+ gtk_tree_selection_set_select_function(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreeSelectionFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GtkDestroyNotify(destroy));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_text_view_set_pixels_below_lines(XEN text_view, XEN pixels_below_lines)
+static Xen gxg_gtk_tree_selection_get_user_data(Xen selection)
{
- #define H_gtk_text_view_set_pixels_below_lines "void gtk_text_view_set_pixels_below_lines(GtkTextView* text_view, \
-gint pixels_below_lines)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_pixels_below_lines", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gint_P(pixels_below_lines), pixels_below_lines, 2, "gtk_text_view_set_pixels_below_lines", "gint");
- gtk_text_view_set_pixels_below_lines(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gint(pixels_below_lines));
- return(XEN_FALSE);
+ #define H_gtk_tree_selection_get_user_data "gpointer gtk_tree_selection_get_user_data(GtkTreeSelection* selection)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_get_user_data", "GtkTreeSelection*");
+ return(C_to_Xen_gpointer(gtk_tree_selection_get_user_data(Xen_to_C_GtkTreeSelection_(selection))));
}
-static XEN gxg_gtk_text_view_get_pixels_below_lines(XEN text_view)
+static Xen gxg_gtk_tree_selection_get_tree_view(Xen selection)
{
- #define H_gtk_text_view_get_pixels_below_lines "gint gtk_text_view_get_pixels_below_lines(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_pixels_below_lines", "GtkTextView*");
- return(C_TO_XEN_gint(gtk_text_view_get_pixels_below_lines(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_selection_get_tree_view "GtkTreeView* gtk_tree_selection_get_tree_view(GtkTreeSelection* selection)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_get_tree_view", "GtkTreeSelection*");
+ return(C_to_Xen_GtkTreeView_(gtk_tree_selection_get_tree_view(Xen_to_C_GtkTreeSelection_(selection))));
}
-static XEN gxg_gtk_text_view_set_pixels_inside_wrap(XEN text_view, XEN pixels_inside_wrap)
+static Xen gxg_gtk_tree_selection_get_selected(Xen selection, Xen model, Xen iter)
{
- #define H_gtk_text_view_set_pixels_inside_wrap "void gtk_text_view_set_pixels_inside_wrap(GtkTextView* text_view, \
-gint pixels_inside_wrap)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_pixels_inside_wrap", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gint_P(pixels_inside_wrap), pixels_inside_wrap, 2, "gtk_text_view_set_pixels_inside_wrap", "gint");
- gtk_text_view_set_pixels_inside_wrap(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gint(pixels_inside_wrap));
- return(XEN_FALSE);
+ #define H_gtk_tree_selection_get_selected "gboolean gtk_tree_selection_get_selected(GtkTreeSelection* selection, \
+GtkTreeModel** model, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_get_selected", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreeModel__(model), model, 2, "gtk_tree_selection_get_selected", "GtkTreeModel**");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 3, "gtk_tree_selection_get_selected", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_selection_get_selected(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreeModel__(model),
+ Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_text_view_get_pixels_inside_wrap(XEN text_view)
+static Xen gxg_gtk_tree_selection_selected_foreach(Xen selection, Xen func, Xen func_info)
{
- #define H_gtk_text_view_get_pixels_inside_wrap "gint gtk_text_view_get_pixels_inside_wrap(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_pixels_inside_wrap", "GtkTextView*");
- return(C_TO_XEN_gint(gtk_text_view_get_pixels_inside_wrap(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_selection_selected_foreach "void gtk_tree_selection_selected_foreach(GtkTreeSelection* selection, \
+GtkTreeSelectionForeachFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_selected_foreach", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreeSelectionForeachFunc(func), func, 2, "gtk_tree_selection_selected_foreach", "GtkTreeSelectionForeachFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_selection_selected_foreach", "lambda_data");
+ {
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_tree_selection_selected_foreach(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreeSelectionForeachFunc(func), Xen_to_C_lambda_data(func_info));
+ xm_unprotect_at(loc);
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_text_view_set_justification(XEN text_view, XEN justification)
+static Xen gxg_gtk_tree_selection_select_path(Xen selection, Xen path)
{
- #define H_gtk_text_view_set_justification "void gtk_text_view_set_justification(GtkTextView* text_view, \
-GtkJustification justification)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_justification", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkJustification_P(justification), justification, 2, "gtk_text_view_set_justification", "GtkJustification");
- gtk_text_view_set_justification(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkJustification(justification));
- return(XEN_FALSE);
+ #define H_gtk_tree_selection_select_path "void gtk_tree_selection_select_path(GtkTreeSelection* selection, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_select_path", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_selection_select_path", "GtkTreePath*");
+ gtk_tree_selection_select_path(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_justification(XEN text_view)
+static Xen gxg_gtk_tree_selection_unselect_path(Xen selection, Xen path)
{
- #define H_gtk_text_view_get_justification "GtkJustification gtk_text_view_get_justification(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_justification", "GtkTextView*");
- return(C_TO_XEN_GtkJustification(gtk_text_view_get_justification(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_selection_unselect_path "void gtk_tree_selection_unselect_path(GtkTreeSelection* selection, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_unselect_path", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_selection_unselect_path", "GtkTreePath*");
+ gtk_tree_selection_unselect_path(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_set_left_margin(XEN text_view, XEN left_margin)
+static Xen gxg_gtk_tree_selection_select_iter(Xen selection, Xen iter)
{
- #define H_gtk_text_view_set_left_margin "void gtk_text_view_set_left_margin(GtkTextView* text_view, \
-gint left_margin)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_left_margin", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gint_P(left_margin), left_margin, 2, "gtk_text_view_set_left_margin", "gint");
- gtk_text_view_set_left_margin(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gint(left_margin));
- return(XEN_FALSE);
+ #define H_gtk_tree_selection_select_iter "void gtk_tree_selection_select_iter(GtkTreeSelection* selection, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_select_iter", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_selection_select_iter", "GtkTreeIter*");
+ gtk_tree_selection_select_iter(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_left_margin(XEN text_view)
+static Xen gxg_gtk_tree_selection_unselect_iter(Xen selection, Xen iter)
{
- #define H_gtk_text_view_get_left_margin "gint gtk_text_view_get_left_margin(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_left_margin", "GtkTextView*");
- return(C_TO_XEN_gint(gtk_text_view_get_left_margin(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_selection_unselect_iter "void gtk_tree_selection_unselect_iter(GtkTreeSelection* selection, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_unselect_iter", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_selection_unselect_iter", "GtkTreeIter*");
+ gtk_tree_selection_unselect_iter(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_set_right_margin(XEN text_view, XEN right_margin)
+static Xen gxg_gtk_tree_selection_path_is_selected(Xen selection, Xen path)
{
- #define H_gtk_text_view_set_right_margin "void gtk_text_view_set_right_margin(GtkTextView* text_view, \
-gint right_margin)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_right_margin", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gint_P(right_margin), right_margin, 2, "gtk_text_view_set_right_margin", "gint");
- gtk_text_view_set_right_margin(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gint(right_margin));
- return(XEN_FALSE);
+ #define H_gtk_tree_selection_path_is_selected "gboolean gtk_tree_selection_path_is_selected(GtkTreeSelection* selection, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_path_is_selected", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_selection_path_is_selected", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_selection_path_is_selected(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_text_view_get_right_margin(XEN text_view)
+static Xen gxg_gtk_tree_selection_iter_is_selected(Xen selection, Xen iter)
{
- #define H_gtk_text_view_get_right_margin "gint gtk_text_view_get_right_margin(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_right_margin", "GtkTextView*");
- return(C_TO_XEN_gint(gtk_text_view_get_right_margin(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_selection_iter_is_selected "gboolean gtk_tree_selection_iter_is_selected(GtkTreeSelection* selection, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_iter_is_selected", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_selection_iter_is_selected", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_selection_iter_is_selected(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_text_view_set_indent(XEN text_view, XEN indent)
+static Xen gxg_gtk_tree_selection_select_all(Xen selection)
{
- #define H_gtk_text_view_set_indent "void gtk_text_view_set_indent(GtkTextView* text_view, gint indent)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_indent", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gint_P(indent), indent, 2, "gtk_text_view_set_indent", "gint");
- gtk_text_view_set_indent(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gint(indent));
- return(XEN_FALSE);
+ #define H_gtk_tree_selection_select_all "void gtk_tree_selection_select_all(GtkTreeSelection* selection)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_select_all", "GtkTreeSelection*");
+ gtk_tree_selection_select_all(Xen_to_C_GtkTreeSelection_(selection));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_indent(XEN text_view)
+static Xen gxg_gtk_tree_selection_unselect_all(Xen selection)
{
- #define H_gtk_text_view_get_indent "gint gtk_text_view_get_indent(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_indent", "GtkTextView*");
- return(C_TO_XEN_gint(gtk_text_view_get_indent(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_selection_unselect_all "void gtk_tree_selection_unselect_all(GtkTreeSelection* selection)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_unselect_all", "GtkTreeSelection*");
+ gtk_tree_selection_unselect_all(Xen_to_C_GtkTreeSelection_(selection));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_set_tabs(XEN text_view, XEN tabs)
+static Xen gxg_gtk_tree_selection_select_range(Xen selection, Xen start_path, Xen end_path)
{
- #define H_gtk_text_view_set_tabs "void gtk_text_view_set_tabs(GtkTextView* text_view, PangoTabArray* tabs)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_tabs", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_PangoTabArray__P(tabs) || XEN_FALSE_P(tabs), tabs, 2, "gtk_text_view_set_tabs", "PangoTabArray*");
- gtk_text_view_set_tabs(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_PangoTabArray_(tabs));
- return(XEN_FALSE);
+ #define H_gtk_tree_selection_select_range "void gtk_tree_selection_select_range(GtkTreeSelection* selection, \
+GtkTreePath* start_path, GtkTreePath* end_path)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_select_range", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreePath_(start_path), start_path, 2, "gtk_tree_selection_select_range", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreePath_(end_path), end_path, 3, "gtk_tree_selection_select_range", "GtkTreePath*");
+ gtk_tree_selection_select_range(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreePath_(start_path), Xen_to_C_GtkTreePath_(end_path));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_tabs(XEN text_view)
+static Xen gxg_gtk_tree_sortable_sort_column_changed(Xen sortable)
{
- #define H_gtk_text_view_get_tabs "PangoTabArray* gtk_text_view_get_tabs(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_tabs", "GtkTextView*");
- return(C_TO_XEN_PangoTabArray_(gtk_text_view_get_tabs(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_sortable_sort_column_changed "void gtk_tree_sortable_sort_column_changed(GtkTreeSortable* sortable)"
+ Xen_check_type(Xen_is_GtkTreeSortable_(sortable), sortable, 1, "gtk_tree_sortable_sort_column_changed", "GtkTreeSortable*");
+ gtk_tree_sortable_sort_column_changed(Xen_to_C_GtkTreeSortable_(sortable));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_view_get_default_attributes(XEN text_view)
+static Xen gxg_gtk_tree_sortable_get_sort_column_id(Xen sortable, Xen ignore_sort_column_id, Xen ignore_order)
{
- #define H_gtk_text_view_get_default_attributes "GtkTextAttributes* gtk_text_view_get_default_attributes(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_default_attributes", "GtkTextView*");
- return(C_TO_XEN_GtkTextAttributes_(gtk_text_view_get_default_attributes(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_tree_sortable_get_sort_column_id "gboolean gtk_tree_sortable_get_sort_column_id(GtkTreeSortable* sortable, \
+gint* [sort_column_id], GtkSortType* [order])"
+ gint ref_sort_column_id;
+ GtkSortType ref_order;
+ Xen_check_type(Xen_is_GtkTreeSortable_(sortable), sortable, 1, "gtk_tree_sortable_get_sort_column_id", "GtkTreeSortable*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_tree_sortable_get_sort_column_id(Xen_to_C_GtkTreeSortable_(sortable), &ref_sort_column_id,
+ &ref_order));
+ return(Xen_list_3(result, C_to_Xen_gint(ref_sort_column_id), C_to_Xen_GtkSortType(ref_order)));
+ }
}
-static XEN gxg_gtk_toggle_button_new(void)
+static Xen gxg_gtk_tree_sortable_set_sort_column_id(Xen sortable, Xen sort_column_id, Xen order)
{
- #define H_gtk_toggle_button_new "GtkWidget* gtk_toggle_button_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_toggle_button_new()));
+ #define H_gtk_tree_sortable_set_sort_column_id "void gtk_tree_sortable_set_sort_column_id(GtkTreeSortable* sortable, \
+gint sort_column_id, GtkSortType order)"
+ Xen_check_type(Xen_is_GtkTreeSortable_(sortable), sortable, 1, "gtk_tree_sortable_set_sort_column_id", "GtkTreeSortable*");
+ Xen_check_type(Xen_is_gint(sort_column_id), sort_column_id, 2, "gtk_tree_sortable_set_sort_column_id", "gint");
+ Xen_check_type(Xen_is_GtkSortType(order), order, 3, "gtk_tree_sortable_set_sort_column_id", "GtkSortType");
+ gtk_tree_sortable_set_sort_column_id(Xen_to_C_GtkTreeSortable_(sortable), Xen_to_C_gint(sort_column_id), Xen_to_C_GtkSortType(order));
+ return(Xen_false);
}
-static XEN gxg_gtk_toggle_button_new_with_label(XEN label)
+static Xen gxg_gtk_tree_sortable_set_sort_func(Xen sortable, Xen sort_column_id, Xen func, Xen func_info, Xen destroy)
{
- #define H_gtk_toggle_button_new_with_label "GtkWidget* gtk_toggle_button_new_with_label(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_toggle_button_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_toggle_button_new_with_label(XEN_TO_C_gchar_(label))));
+ #define H_gtk_tree_sortable_set_sort_func "void gtk_tree_sortable_set_sort_func(GtkTreeSortable* sortable, \
+gint sort_column_id, GtkTreeIterCompareFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkTreeSortable_(sortable), sortable, 1, "gtk_tree_sortable_set_sort_func", "GtkTreeSortable*");
+ Xen_check_type(Xen_is_gint(sort_column_id), sort_column_id, 2, "gtk_tree_sortable_set_sort_func", "gint");
+ Xen_check_type(Xen_is_GtkTreeIterCompareFunc(func), func, 3, "gtk_tree_sortable_set_sort_func", "GtkTreeIterCompareFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "gtk_tree_sortable_set_sort_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(destroy), destroy, 5, "gtk_tree_sortable_set_sort_func", "GtkDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, destroy);
+ gtk_tree_sortable_set_sort_func(Xen_to_C_GtkTreeSortable_(sortable), Xen_to_C_gint(sort_column_id), Xen_to_C_GtkTreeIterCompareFunc(func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GtkDestroyNotify(destroy));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_toggle_button_new_with_mnemonic(XEN label)
+static Xen gxg_gtk_tree_sortable_set_default_sort_func(Xen sortable, Xen func, Xen func_info, Xen destroy)
{
- #define H_gtk_toggle_button_new_with_mnemonic "GtkWidget* gtk_toggle_button_new_with_mnemonic(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_toggle_button_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_toggle_button_new_with_mnemonic(XEN_TO_C_gchar_(label))));
+ #define H_gtk_tree_sortable_set_default_sort_func "void gtk_tree_sortable_set_default_sort_func(GtkTreeSortable* sortable, \
+GtkTreeIterCompareFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkTreeSortable_(sortable), sortable, 1, "gtk_tree_sortable_set_default_sort_func", "GtkTreeSortable*");
+ Xen_check_type(Xen_is_GtkTreeIterCompareFunc(func), func, 2, "gtk_tree_sortable_set_default_sort_func", "GtkTreeIterCompareFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_sortable_set_default_sort_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(destroy), destroy, 4, "gtk_tree_sortable_set_default_sort_func", "GtkDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, destroy);
+ gtk_tree_sortable_set_default_sort_func(Xen_to_C_GtkTreeSortable_(sortable), Xen_to_C_GtkTreeIterCompareFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GtkDestroyNotify(destroy));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_toggle_button_set_mode(XEN toggle_button, XEN draw_indicator)
+static Xen gxg_gtk_tree_sortable_has_default_sort_func(Xen sortable)
{
- #define H_gtk_toggle_button_set_mode "void gtk_toggle_button_set_mode(GtkToggleButton* toggle_button, \
-gboolean draw_indicator)"
- XEN_ASSERT_TYPE(XEN_GtkToggleButton__P(toggle_button), toggle_button, 1, "gtk_toggle_button_set_mode", "GtkToggleButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(draw_indicator), draw_indicator, 2, "gtk_toggle_button_set_mode", "gboolean");
- gtk_toggle_button_set_mode(XEN_TO_C_GtkToggleButton_(toggle_button), XEN_TO_C_gboolean(draw_indicator));
- return(XEN_FALSE);
+ #define H_gtk_tree_sortable_has_default_sort_func "gboolean gtk_tree_sortable_has_default_sort_func(GtkTreeSortable* sortable)"
+ Xen_check_type(Xen_is_GtkTreeSortable_(sortable), sortable, 1, "gtk_tree_sortable_has_default_sort_func", "GtkTreeSortable*");
+ return(C_to_Xen_gboolean(gtk_tree_sortable_has_default_sort_func(Xen_to_C_GtkTreeSortable_(sortable))));
}
-static XEN gxg_gtk_toggle_button_get_mode(XEN toggle_button)
+static Xen gxg_gtk_tree_store_new(Xen n_columns, Xen types)
{
- #define H_gtk_toggle_button_get_mode "gboolean gtk_toggle_button_get_mode(GtkToggleButton* toggle_button)"
- XEN_ASSERT_TYPE(XEN_GtkToggleButton__P(toggle_button), toggle_button, 1, "gtk_toggle_button_get_mode", "GtkToggleButton*");
- return(C_TO_XEN_gboolean(gtk_toggle_button_get_mode(XEN_TO_C_GtkToggleButton_(toggle_button))));
+ #define H_gtk_tree_store_new "GtkTreeStore* gtk_tree_store_new(gint n_columns, etc types)"
+ Xen_check_type(Xen_is_gint(n_columns), n_columns, 1, "gtk_tree_store_new", "gint");
+ Xen_check_type(Xen_is_etc(types), types, 2, "gtk_tree_store_new", "etc");
+ {
+ int etc_len = 0;
+ GtkTreeStore* result = NULL;
+ gint p_arg0;
+ if (Xen_is_list(types)) etc_len = Xen_list_length(types);
+ if (etc_len < 1) Xen_out_of_range_error("gtk_tree_store_new", 1, types, "... list must have at least 1 entry");
+ if (etc_len > 6) Xen_out_of_range_error("gtk_tree_store_new", 1, types, "... list too long (max len: 6)");
+ p_arg0 = Xen_to_C_gint(n_columns);
+ switch (etc_len)
+ {
+ case 1: result = gtk_tree_store_new(p_arg0, XLG(types, 0)); break;
+ case 2: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1)); break;
+ case 3: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2)); break;
+ case 4: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3)); break;
+ case 5: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3), XLG(types, 4)); break;
+ case 6: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3), XLG(types, 4), XLG(types, 5)); break;
+ }
+ return(C_to_Xen_GtkTreeStore_(result));
+ }
}
-static XEN gxg_gtk_toggle_button_set_active(XEN toggle_button, XEN is_active)
+static Xen gxg_gtk_tree_store_newv(Xen n_columns, Xen types)
{
- #define H_gtk_toggle_button_set_active "void gtk_toggle_button_set_active(GtkToggleButton* toggle_button, \
-gboolean is_active)"
- XEN_ASSERT_TYPE(XEN_GtkToggleButton__P(toggle_button), toggle_button, 1, "gtk_toggle_button_set_active", "GtkToggleButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_active), is_active, 2, "gtk_toggle_button_set_active", "gboolean");
- gtk_toggle_button_set_active(XEN_TO_C_GtkToggleButton_(toggle_button), XEN_TO_C_gboolean(is_active));
- return(XEN_FALSE);
+ #define H_gtk_tree_store_newv "GtkTreeStore* gtk_tree_store_newv(gint n_columns, GType* types)"
+ Xen_check_type(Xen_is_gint(n_columns), n_columns, 1, "gtk_tree_store_newv", "gint");
+ Xen_check_type(Xen_is_GType_(types), types, 2, "gtk_tree_store_newv", "GType*");
+ return(C_to_Xen_GtkTreeStore_(gtk_tree_store_newv(Xen_to_C_gint(n_columns), Xen_to_C_GType_(types))));
}
-static XEN gxg_gtk_toggle_button_get_active(XEN toggle_button)
+static Xen gxg_gtk_tree_store_set_column_types(Xen tree_store, Xen n_columns, Xen types)
{
- #define H_gtk_toggle_button_get_active "gboolean gtk_toggle_button_get_active(GtkToggleButton* toggle_button)"
- XEN_ASSERT_TYPE(XEN_GtkToggleButton__P(toggle_button), toggle_button, 1, "gtk_toggle_button_get_active", "GtkToggleButton*");
- return(C_TO_XEN_gboolean(gtk_toggle_button_get_active(XEN_TO_C_GtkToggleButton_(toggle_button))));
+ #define H_gtk_tree_store_set_column_types "void gtk_tree_store_set_column_types(GtkTreeStore* tree_store, \
+gint n_columns, GType* types)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_set_column_types", "GtkTreeStore*");
+ Xen_check_type(Xen_is_gint(n_columns), n_columns, 2, "gtk_tree_store_set_column_types", "gint");
+ Xen_check_type(Xen_is_GType_(types), types, 3, "gtk_tree_store_set_column_types", "GType*");
+ gtk_tree_store_set_column_types(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_gint(n_columns), Xen_to_C_GType_(types));
+ return(Xen_false);
}
-static XEN gxg_gtk_toggle_button_toggled(XEN toggle_button)
+static Xen gxg_gtk_tree_store_set(Xen tree_store, Xen iter, Xen values)
{
- #define H_gtk_toggle_button_toggled "void gtk_toggle_button_toggled(GtkToggleButton* toggle_button)"
- XEN_ASSERT_TYPE(XEN_GtkToggleButton__P(toggle_button), toggle_button, 1, "gtk_toggle_button_toggled", "GtkToggleButton*");
- gtk_toggle_button_toggled(XEN_TO_C_GtkToggleButton_(toggle_button));
- return(XEN_FALSE);
+ #define H_gtk_tree_store_set "void gtk_tree_store_set(GtkTreeStore* tree_store, GtkTreeIter* iter, \
+etc values)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_set", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_set", "GtkTreeIter*");
+ Xen_check_type(Xen_is_etc(values), values, 3, "gtk_tree_store_set", "etc");
+ {
+ int etc_len = 0;
+ GtkTreeStore* p_arg0;
+ GtkTreeIter* p_arg1;
+ if (Xen_is_list(values)) etc_len = Xen_list_length(values);
+ if (etc_len < 2) Xen_out_of_range_error("gtk_tree_store_set", 2, values, "... list must have at least 2 entries");
+ if (etc_len > 10) Xen_out_of_range_error("gtk_tree_store_set", 2, values, "... list too long (max len: 10)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_tree_store_set", 2, values, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_GtkTreeStore_(tree_store);
+ p_arg1 = Xen_to_C_GtkTreeIter_(iter);
+ switch (etc_len)
+ {
+ case 2: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), -1); break;
+ case 4: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), -1); break;
+ case 6: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), -1); break;
+ case 8: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), XLI(values, 6), XLS(values, 7), -1); break;
+ case 10: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), XLI(values, 6), XLS(values, 7), XLI(values, 8), XLS(values, 9), -1); break;
+ }
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_toggle_button_set_inconsistent(XEN toggle_button, XEN setting)
+static Xen gxg_gtk_tree_store_remove(Xen tree_store, Xen iter)
{
- #define H_gtk_toggle_button_set_inconsistent "void gtk_toggle_button_set_inconsistent(GtkToggleButton* toggle_button, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkToggleButton__P(toggle_button), toggle_button, 1, "gtk_toggle_button_set_inconsistent", "GtkToggleButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_toggle_button_set_inconsistent", "gboolean");
- gtk_toggle_button_set_inconsistent(XEN_TO_C_GtkToggleButton_(toggle_button), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_tree_store_remove "void gtk_tree_store_remove(GtkTreeStore* tree_store, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_remove", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_remove", "GtkTreeIter*");
+ gtk_tree_store_remove(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_toggle_button_get_inconsistent(XEN toggle_button)
+static Xen gxg_gtk_tree_store_insert(Xen tree_store, Xen iter, Xen parent, Xen position)
{
- #define H_gtk_toggle_button_get_inconsistent "gboolean gtk_toggle_button_get_inconsistent(GtkToggleButton* toggle_button)"
- XEN_ASSERT_TYPE(XEN_GtkToggleButton__P(toggle_button), toggle_button, 1, "gtk_toggle_button_get_inconsistent", "GtkToggleButton*");
- return(C_TO_XEN_gboolean(gtk_toggle_button_get_inconsistent(XEN_TO_C_GtkToggleButton_(toggle_button))));
+ #define H_gtk_tree_store_insert "void gtk_tree_store_insert(GtkTreeStore* tree_store, GtkTreeIter* iter, \
+GtkTreeIter* parent, gint position)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_insert", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_insert", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(parent) || Xen_is_false(parent), parent, 3, "gtk_tree_store_insert", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gint(position), position, 4, "gtk_tree_store_insert", "gint");
+ gtk_tree_store_insert(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(parent), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_toolbar_new(void)
+static Xen gxg_gtk_tree_store_insert_before(Xen tree_store, Xen iter, Xen parent, Xen sibling)
{
- #define H_gtk_toolbar_new "GtkWidget* gtk_toolbar_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_toolbar_new()));
+ #define H_gtk_tree_store_insert_before "void gtk_tree_store_insert_before(GtkTreeStore* tree_store, \
+GtkTreeIter* iter, GtkTreeIter* parent, GtkTreeIter* sibling)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_insert_before", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_insert_before", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(parent) || Xen_is_false(parent), parent, 3, "gtk_tree_store_insert_before", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(sibling) || Xen_is_false(sibling), sibling, 4, "gtk_tree_store_insert_before", "GtkTreeIter*");
+ gtk_tree_store_insert_before(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(parent),
+ Xen_to_C_GtkTreeIter_(sibling));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_store_insert_after(Xen tree_store, Xen iter, Xen parent, Xen sibling)
+{
+ #define H_gtk_tree_store_insert_after "void gtk_tree_store_insert_after(GtkTreeStore* tree_store, GtkTreeIter* iter, \
+GtkTreeIter* parent, GtkTreeIter* sibling)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_insert_after", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_insert_after", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(parent) || Xen_is_false(parent), parent, 3, "gtk_tree_store_insert_after", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(sibling) || Xen_is_false(sibling), sibling, 4, "gtk_tree_store_insert_after", "GtkTreeIter*");
+ gtk_tree_store_insert_after(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(parent),
+ Xen_to_C_GtkTreeIter_(sibling));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_store_prepend(Xen tree_store, Xen iter, Xen parent)
+{
+ #define H_gtk_tree_store_prepend "void gtk_tree_store_prepend(GtkTreeStore* tree_store, GtkTreeIter* iter, \
+GtkTreeIter* parent)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_prepend", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_prepend", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(parent) || Xen_is_false(parent), parent, 3, "gtk_tree_store_prepend", "GtkTreeIter*");
+ gtk_tree_store_prepend(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(parent));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_store_append(Xen tree_store, Xen iter, Xen parent)
+{
+ #define H_gtk_tree_store_append "void gtk_tree_store_append(GtkTreeStore* tree_store, GtkTreeIter* iter, \
+GtkTreeIter* parent)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_append", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_append", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(parent) || Xen_is_false(parent), parent, 3, "gtk_tree_store_append", "GtkTreeIter*");
+ gtk_tree_store_append(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(parent));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_store_is_ancestor(Xen tree_store, Xen iter, Xen descendant)
+{
+ #define H_gtk_tree_store_is_ancestor "gboolean gtk_tree_store_is_ancestor(GtkTreeStore* tree_store, \
+GtkTreeIter* iter, GtkTreeIter* descendant)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_is_ancestor", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_is_ancestor", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(descendant), descendant, 3, "gtk_tree_store_is_ancestor", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_store_is_ancestor(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(descendant))));
+}
+
+static Xen gxg_gtk_tree_store_iter_depth(Xen tree_store, Xen iter)
+{
+ #define H_gtk_tree_store_iter_depth "gint gtk_tree_store_iter_depth(GtkTreeStore* tree_store, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_iter_depth", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_store_iter_depth", "GtkTreeIter*");
+ return(C_to_Xen_gint(gtk_tree_store_iter_depth(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(iter))));
+}
+
+static Xen gxg_gtk_tree_store_clear(Xen tree_store)
+{
+ #define H_gtk_tree_store_clear "void gtk_tree_store_clear(GtkTreeStore* tree_store)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_clear", "GtkTreeStore*");
+ gtk_tree_store_clear(Xen_to_C_GtkTreeStore_(tree_store));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_new(void)
+{
+ #define H_gtk_tree_view_column_new "GtkTreeViewColumn* gtk_tree_view_column_new( void)"
+ return(C_to_Xen_GtkTreeViewColumn_(gtk_tree_view_column_new()));
+}
+
+static Xen gxg_gtk_tree_view_column_new_with_attributes(Xen title, Xen cell, Xen attributes)
+{
+ #define H_gtk_tree_view_column_new_with_attributes "GtkTreeViewColumn* gtk_tree_view_column_new_with_attributes(gchar* title, \
+GtkCellRenderer* cell, etc attributes)"
+ Xen_check_type(Xen_is_gchar_(title), title, 1, "gtk_tree_view_column_new_with_attributes", "gchar*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_tree_view_column_new_with_attributes", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_etc(attributes), attributes, 3, "gtk_tree_view_column_new_with_attributes", "etc");
+ {
+ int etc_len = 0;
+ GtkTreeViewColumn* result = NULL;
+ gchar* p_arg0;
+ GtkCellRenderer* p_arg1;
+ if (Xen_is_list(attributes)) etc_len = Xen_list_length(attributes);
+ if (etc_len < 2) Xen_out_of_range_error("gtk_tree_view_column_new_with_attributes", 2, attributes, "... list must have at least 2 entries");
+ if (etc_len > 10) Xen_out_of_range_error("gtk_tree_view_column_new_with_attributes", 2, attributes, "... list too long (max len: 10)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_tree_view_column_new_with_attributes", 2, attributes, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_gchar_(title);
+ p_arg1 = Xen_to_C_GtkCellRenderer_(cell);
+ switch (etc_len)
+ {
+ case 2: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), NULL); break;
+ case 4: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), NULL); break;
+ case 6: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), NULL); break;
+ case 8: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), NULL); break;
+ case 10: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), XLS(attributes, 8), XLI(attributes, 9), NULL); break;
+ }
+ return(C_to_Xen_GtkTreeViewColumn_(result));
+ }
+}
+
+static Xen gxg_gtk_tree_view_column_pack_start(Xen tree_column, Xen cell, Xen expand)
+{
+ #define H_gtk_tree_view_column_pack_start "void gtk_tree_view_column_pack_start(GtkTreeViewColumn* tree_column, \
+GtkCellRenderer* cell, gboolean expand)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_pack_start", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_tree_view_column_pack_start", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_tree_view_column_pack_start", "gboolean");
+ gtk_tree_view_column_pack_start(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gboolean(expand));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_pack_end(Xen tree_column, Xen cell, Xen expand)
+{
+ #define H_gtk_tree_view_column_pack_end "void gtk_tree_view_column_pack_end(GtkTreeViewColumn* tree_column, \
+GtkCellRenderer* cell, gboolean expand)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_pack_end", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_tree_view_column_pack_end", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_tree_view_column_pack_end", "gboolean");
+ gtk_tree_view_column_pack_end(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gboolean(expand));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_clear(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_clear "void gtk_tree_view_column_clear(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_clear", "GtkTreeViewColumn*");
+ gtk_tree_view_column_clear(Xen_to_C_GtkTreeViewColumn_(tree_column));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_add_attribute(Xen tree_column, Xen cell_renderer, Xen attribute, Xen column)
+{
+ #define H_gtk_tree_view_column_add_attribute "void gtk_tree_view_column_add_attribute(GtkTreeViewColumn* tree_column, \
+GtkCellRenderer* cell_renderer, gchar* attribute, gint column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_add_attribute", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_add_attribute", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gchar_(attribute), attribute, 3, "gtk_tree_view_column_add_attribute", "gchar*");
+ Xen_check_type(Xen_is_gint(column), column, 4, "gtk_tree_view_column_add_attribute", "gint");
+ gtk_tree_view_column_add_attribute(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkCellRenderer_(cell_renderer),
+ Xen_to_C_gchar_(attribute), Xen_to_C_gint(column));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_set_attributes(Xen tree_column, Xen cell_renderer, Xen attributes)
+{
+ #define H_gtk_tree_view_column_set_attributes "void gtk_tree_view_column_set_attributes(GtkTreeViewColumn* tree_column, \
+GtkCellRenderer* cell_renderer, etc attributes)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_attributes", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_set_attributes", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_etc(attributes), attributes, 3, "gtk_tree_view_column_set_attributes", "etc");
+ {
+ int etc_len = 0;
+ GtkTreeViewColumn* p_arg0;
+ GtkCellRenderer* p_arg1;
+ if (Xen_is_list(attributes)) etc_len = Xen_list_length(attributes);
+ if (etc_len < 2) Xen_out_of_range_error("gtk_tree_view_column_set_attributes", 2, attributes, "... list must have at least 2 entries");
+ if (etc_len > 10) Xen_out_of_range_error("gtk_tree_view_column_set_attributes", 2, attributes, "... list too long (max len: 10)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_tree_view_column_set_attributes", 2, attributes, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_GtkTreeViewColumn_(tree_column);
+ p_arg1 = Xen_to_C_GtkCellRenderer_(cell_renderer);
+ switch (etc_len)
+ {
+ case 2: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), NULL); break;
+ case 4: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), NULL); break;
+ case 6: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), NULL); break;
+ case 8: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), NULL); break;
+ case 10: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), XLS(attributes, 8), XLI(attributes, 9), NULL); break;
+ }
+ return(Xen_false);
+ }
+}
+
+static Xen gxg_gtk_tree_view_column_set_cell_data_func(Xen tree_column, Xen cell_renderer, Xen func, Xen func_info, Xen destroy)
+{
+ #define H_gtk_tree_view_column_set_cell_data_func "void gtk_tree_view_column_set_cell_data_func(GtkTreeViewColumn* tree_column, \
+GtkCellRenderer* cell_renderer, GtkTreeCellDataFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_cell_data_func", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_set_cell_data_func", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GtkTreeCellDataFunc(func), func, 3, "gtk_tree_view_column_set_cell_data_func", "GtkTreeCellDataFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "gtk_tree_view_column_set_cell_data_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(destroy), destroy, 5, "gtk_tree_view_column_set_cell_data_func", "GtkDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, destroy);
+ gtk_tree_view_column_set_cell_data_func(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkCellRenderer_(cell_renderer),
+ Xen_to_C_GtkTreeCellDataFunc(func), Xen_to_C_lambda_data(func_info), Xen_to_C_GtkDestroyNotify(destroy));
+ return(Xen_false);
+ }
+}
+
+static Xen gxg_gtk_tree_view_column_clear_attributes(Xen tree_column, Xen cell_renderer)
+{
+ #define H_gtk_tree_view_column_clear_attributes "void gtk_tree_view_column_clear_attributes(GtkTreeViewColumn* tree_column, \
+GtkCellRenderer* cell_renderer)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_clear_attributes", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_clear_attributes", "GtkCellRenderer*");
+ gtk_tree_view_column_clear_attributes(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkCellRenderer_(cell_renderer));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_set_spacing(Xen tree_column, Xen spacing)
+{
+ #define H_gtk_tree_view_column_set_spacing "void gtk_tree_view_column_set_spacing(GtkTreeViewColumn* tree_column, \
+gint spacing)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_spacing", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gint(spacing), spacing, 2, "gtk_tree_view_column_set_spacing", "gint");
+ gtk_tree_view_column_set_spacing(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gint(spacing));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_spacing(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_spacing "gint gtk_tree_view_column_get_spacing(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_spacing", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_column_get_spacing(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_visible(Xen tree_column, Xen visible)
+{
+ #define H_gtk_tree_view_column_set_visible "void gtk_tree_view_column_set_visible(GtkTreeViewColumn* tree_column, \
+gboolean visible)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_visible", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gboolean(visible), visible, 2, "gtk_tree_view_column_set_visible", "gboolean");
+ gtk_tree_view_column_set_visible(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gboolean(visible));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_visible(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_visible "gboolean gtk_tree_view_column_get_visible(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_visible", "GtkTreeViewColumn*");
+ return(C_to_Xen_gboolean(gtk_tree_view_column_get_visible(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_resizable(Xen tree_column, Xen resizable)
+{
+ #define H_gtk_tree_view_column_set_resizable "void gtk_tree_view_column_set_resizable(GtkTreeViewColumn* tree_column, \
+gboolean resizable)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_resizable", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gboolean(resizable), resizable, 2, "gtk_tree_view_column_set_resizable", "gboolean");
+ gtk_tree_view_column_set_resizable(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gboolean(resizable));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_resizable(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_resizable "gboolean gtk_tree_view_column_get_resizable(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_resizable", "GtkTreeViewColumn*");
+ return(C_to_Xen_gboolean(gtk_tree_view_column_get_resizable(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_sizing(Xen tree_column, Xen type)
+{
+ #define H_gtk_tree_view_column_set_sizing "void gtk_tree_view_column_set_sizing(GtkTreeViewColumn* tree_column, \
+GtkTreeViewColumnSizing type)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_sizing", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkTreeViewColumnSizing(type), type, 2, "gtk_tree_view_column_set_sizing", "GtkTreeViewColumnSizing");
+ gtk_tree_view_column_set_sizing(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkTreeViewColumnSizing(type));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_sizing(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_sizing "GtkTreeViewColumnSizing gtk_tree_view_column_get_sizing(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_sizing", "GtkTreeViewColumn*");
+ return(C_to_Xen_GtkTreeViewColumnSizing(gtk_tree_view_column_get_sizing(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_get_width(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_width "gint gtk_tree_view_column_get_width(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_width", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_column_get_width(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_get_fixed_width(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_fixed_width "gint gtk_tree_view_column_get_fixed_width(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_fixed_width", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_column_get_fixed_width(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_fixed_width(Xen tree_column, Xen fixed_width)
+{
+ #define H_gtk_tree_view_column_set_fixed_width "void gtk_tree_view_column_set_fixed_width(GtkTreeViewColumn* tree_column, \
+gint fixed_width)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_fixed_width", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gint(fixed_width), fixed_width, 2, "gtk_tree_view_column_set_fixed_width", "gint");
+ gtk_tree_view_column_set_fixed_width(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gint(fixed_width));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_set_min_width(Xen tree_column, Xen min_width)
+{
+ #define H_gtk_tree_view_column_set_min_width "void gtk_tree_view_column_set_min_width(GtkTreeViewColumn* tree_column, \
+gint min_width)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_min_width", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gint(min_width), min_width, 2, "gtk_tree_view_column_set_min_width", "gint");
+ gtk_tree_view_column_set_min_width(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gint(min_width));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_min_width(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_min_width "gint gtk_tree_view_column_get_min_width(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_min_width", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_column_get_min_width(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_max_width(Xen tree_column, Xen max_width)
+{
+ #define H_gtk_tree_view_column_set_max_width "void gtk_tree_view_column_set_max_width(GtkTreeViewColumn* tree_column, \
+gint max_width)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_max_width", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gint(max_width), max_width, 2, "gtk_tree_view_column_set_max_width", "gint");
+ gtk_tree_view_column_set_max_width(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gint(max_width));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_max_width(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_max_width "gint gtk_tree_view_column_get_max_width(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_max_width", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_column_get_max_width(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_clicked(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_clicked "void gtk_tree_view_column_clicked(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_clicked", "GtkTreeViewColumn*");
+ gtk_tree_view_column_clicked(Xen_to_C_GtkTreeViewColumn_(tree_column));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_set_title(Xen tree_column, Xen title)
+{
+ #define H_gtk_tree_view_column_set_title "void gtk_tree_view_column_set_title(GtkTreeViewColumn* tree_column, \
+gchar* title)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_title", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gchar_(title), title, 2, "gtk_tree_view_column_set_title", "gchar*");
+ gtk_tree_view_column_set_title(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gchar_(title));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_title(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_title "gchar* gtk_tree_view_column_get_title(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_title", "GtkTreeViewColumn*");
+ return(C_to_Xen_gchar_(gtk_tree_view_column_get_title(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_clickable(Xen tree_column, Xen clickable)
+{
+ #define H_gtk_tree_view_column_set_clickable "void gtk_tree_view_column_set_clickable(GtkTreeViewColumn* tree_column, \
+gboolean clickable)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_clickable", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gboolean(clickable), clickable, 2, "gtk_tree_view_column_set_clickable", "gboolean");
+ gtk_tree_view_column_set_clickable(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gboolean(clickable));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_clickable(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_clickable "gboolean gtk_tree_view_column_get_clickable(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_clickable", "GtkTreeViewColumn*");
+ return(C_to_Xen_gboolean(gtk_tree_view_column_get_clickable(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_widget(Xen tree_column, Xen widget)
+{
+ #define H_gtk_tree_view_column_set_widget "void gtk_tree_view_column_set_widget(GtkTreeViewColumn* tree_column, \
+GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_widget", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkWidget_(widget) || Xen_is_false(widget), widget, 2, "gtk_tree_view_column_set_widget", "GtkWidget*");
+ gtk_tree_view_column_set_widget(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_widget(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_widget "GtkWidget* gtk_tree_view_column_get_widget(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_widget", "GtkTreeViewColumn*");
+ return(C_to_Xen_GtkWidget_(gtk_tree_view_column_get_widget(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_alignment(Xen tree_column, Xen xalign)
+{
+ #define H_gtk_tree_view_column_set_alignment "void gtk_tree_view_column_set_alignment(GtkTreeViewColumn* tree_column, \
+gfloat xalign)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_alignment", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gfloat(xalign), xalign, 2, "gtk_tree_view_column_set_alignment", "gfloat");
+ gtk_tree_view_column_set_alignment(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gfloat(xalign));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_alignment(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_alignment "gfloat gtk_tree_view_column_get_alignment(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_alignment", "GtkTreeViewColumn*");
+ return(C_to_Xen_gfloat(gtk_tree_view_column_get_alignment(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_reorderable(Xen tree_column, Xen reorderable)
+{
+ #define H_gtk_tree_view_column_set_reorderable "void gtk_tree_view_column_set_reorderable(GtkTreeViewColumn* tree_column, \
+gboolean reorderable)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_reorderable", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gboolean(reorderable), reorderable, 2, "gtk_tree_view_column_set_reorderable", "gboolean");
+ gtk_tree_view_column_set_reorderable(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gboolean(reorderable));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_reorderable(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_reorderable "gboolean gtk_tree_view_column_get_reorderable(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_reorderable", "GtkTreeViewColumn*");
+ return(C_to_Xen_gboolean(gtk_tree_view_column_get_reorderable(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_sort_column_id(Xen tree_column, Xen sort_column_id)
+{
+ #define H_gtk_tree_view_column_set_sort_column_id "void gtk_tree_view_column_set_sort_column_id(GtkTreeViewColumn* tree_column, \
+gint sort_column_id)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_sort_column_id", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gint(sort_column_id), sort_column_id, 2, "gtk_tree_view_column_set_sort_column_id", "gint");
+ gtk_tree_view_column_set_sort_column_id(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gint(sort_column_id));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_tree_view_column_get_sort_column_id(Xen tree_column)
+{
+ #define H_gtk_tree_view_column_get_sort_column_id "gint gtk_tree_view_column_get_sort_column_id(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_sort_column_id", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_column_get_sort_column_id(Xen_to_C_GtkTreeViewColumn_(tree_column))));
+}
+
+static Xen gxg_gtk_tree_view_column_set_sort_indicator(Xen tree_column, Xen setting)
+{
+ #define H_gtk_tree_view_column_set_sort_indicator "void gtk_tree_view_column_set_sort_indicator(GtkTreeViewColumn* tree_column, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_sort_indicator", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_tree_view_column_set_sort_indicator", "gboolean");
+ gtk_tree_view_column_set_sort_indicator(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_toolbar_set_style(XEN toolbar, XEN style)
+static Xen gxg_gtk_tree_view_column_get_sort_indicator(Xen tree_column)
{
- #define H_gtk_toolbar_set_style "void gtk_toolbar_set_style(GtkToolbar* toolbar, GtkToolbarStyle style)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_set_style", "GtkToolbar*");
- XEN_ASSERT_TYPE(XEN_GtkToolbarStyle_P(style), style, 2, "gtk_toolbar_set_style", "GtkToolbarStyle");
- gtk_toolbar_set_style(XEN_TO_C_GtkToolbar_(toolbar), XEN_TO_C_GtkToolbarStyle(style));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_column_get_sort_indicator "gboolean gtk_tree_view_column_get_sort_indicator(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_sort_indicator", "GtkTreeViewColumn*");
+ return(C_to_Xen_gboolean(gtk_tree_view_column_get_sort_indicator(Xen_to_C_GtkTreeViewColumn_(tree_column))));
}
-static XEN gxg_gtk_toolbar_unset_style(XEN toolbar)
+static Xen gxg_gtk_tree_view_column_set_sort_order(Xen tree_column, Xen order)
{
- #define H_gtk_toolbar_unset_style "void gtk_toolbar_unset_style(GtkToolbar* toolbar)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_unset_style", "GtkToolbar*");
- gtk_toolbar_unset_style(XEN_TO_C_GtkToolbar_(toolbar));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_column_set_sort_order "void gtk_tree_view_column_set_sort_order(GtkTreeViewColumn* tree_column, \
+GtkSortType order)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_sort_order", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkSortType(order), order, 2, "gtk_tree_view_column_set_sort_order", "GtkSortType");
+ gtk_tree_view_column_set_sort_order(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkSortType(order));
+ return(Xen_false);
}
-static XEN gxg_gtk_toolbar_get_style(XEN toolbar)
+static Xen gxg_gtk_tree_view_column_get_sort_order(Xen tree_column)
{
- #define H_gtk_toolbar_get_style "GtkToolbarStyle gtk_toolbar_get_style(GtkToolbar* toolbar)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_get_style", "GtkToolbar*");
- return(C_TO_XEN_GtkToolbarStyle(gtk_toolbar_get_style(XEN_TO_C_GtkToolbar_(toolbar))));
+ #define H_gtk_tree_view_column_get_sort_order "GtkSortType gtk_tree_view_column_get_sort_order(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_sort_order", "GtkTreeViewColumn*");
+ return(C_to_Xen_GtkSortType(gtk_tree_view_column_get_sort_order(Xen_to_C_GtkTreeViewColumn_(tree_column))));
}
-static XEN gxg_gtk_toolbar_get_icon_size(XEN toolbar)
+static Xen gxg_gtk_tree_view_column_cell_set_cell_data(Xen tree_column, Xen tree_model, Xen iter, Xen is_expander, Xen is_expanded)
{
- #define H_gtk_toolbar_get_icon_size "GtkIconSize gtk_toolbar_get_icon_size(GtkToolbar* toolbar)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_get_icon_size", "GtkToolbar*");
- return(C_TO_XEN_GtkIconSize(gtk_toolbar_get_icon_size(XEN_TO_C_GtkToolbar_(toolbar))));
+ #define H_gtk_tree_view_column_cell_set_cell_data "void gtk_tree_view_column_cell_set_cell_data(GtkTreeViewColumn* tree_column, \
+GtkTreeModel* tree_model, GtkTreeIter* iter, gboolean is_expander, gboolean is_expanded)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_cell_set_cell_data", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 2, "gtk_tree_view_column_cell_set_cell_data", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 3, "gtk_tree_view_column_cell_set_cell_data", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gboolean(is_expander), is_expander, 4, "gtk_tree_view_column_cell_set_cell_data", "gboolean");
+ Xen_check_type(Xen_is_gboolean(is_expanded), is_expanded, 5, "gtk_tree_view_column_cell_set_cell_data", "gboolean");
+ gtk_tree_view_column_cell_set_cell_data(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter),
+ Xen_to_C_gboolean(is_expander), Xen_to_C_gboolean(is_expanded));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_drag_source_row_draggable(XEN drag_source, XEN path)
+static Xen gxg_gtk_tree_view_column_cell_get_size(Xen tree_column, Xen cell_area, Xen ignore_x_offset, Xen ignore_y_offset, Xen ignore_width, Xen ignore_height)
{
- #define H_gtk_tree_drag_source_row_draggable "gboolean gtk_tree_drag_source_row_draggable(GtkTreeDragSource* drag_source, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeDragSource__P(drag_source), drag_source, 1, "gtk_tree_drag_source_row_draggable", "GtkTreeDragSource*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_drag_source_row_draggable", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_drag_source_row_draggable(XEN_TO_C_GtkTreeDragSource_(drag_source), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_column_cell_get_size "void gtk_tree_view_column_cell_get_size(GtkTreeViewColumn* tree_column, \
+GdkRectangle* cell_area, gint* [x_offset], gint* [y_offset], gint* [width], gint* [height])"
+ gint ref_x_offset;
+ gint ref_y_offset;
+ gint ref_width;
+ gint ref_height;
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_cell_get_size", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GdkRectangle_(cell_area), cell_area, 2, "gtk_tree_view_column_cell_get_size", "GdkRectangle*");
+ gtk_tree_view_column_cell_get_size(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GdkRectangle_(cell_area), &ref_x_offset,
+ &ref_y_offset, &ref_width, &ref_height);
+ return(Xen_list_4(C_to_Xen_gint(ref_x_offset), C_to_Xen_gint(ref_y_offset), C_to_Xen_gint(ref_width), C_to_Xen_gint(ref_height)));
}
-static XEN gxg_gtk_tree_drag_source_drag_data_delete(XEN drag_source, XEN path)
+static Xen gxg_gtk_tree_view_column_cell_is_visible(Xen tree_column)
{
- #define H_gtk_tree_drag_source_drag_data_delete "gboolean gtk_tree_drag_source_drag_data_delete(GtkTreeDragSource* drag_source, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeDragSource__P(drag_source), drag_source, 1, "gtk_tree_drag_source_drag_data_delete", "GtkTreeDragSource*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_drag_source_drag_data_delete", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_drag_source_drag_data_delete(XEN_TO_C_GtkTreeDragSource_(drag_source), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_column_cell_is_visible "gboolean gtk_tree_view_column_cell_is_visible(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_cell_is_visible", "GtkTreeViewColumn*");
+ return(C_to_Xen_gboolean(gtk_tree_view_column_cell_is_visible(Xen_to_C_GtkTreeViewColumn_(tree_column))));
}
-static XEN gxg_gtk_tree_drag_source_drag_data_get(XEN drag_source, XEN path, XEN selection_data)
+static Xen gxg_gtk_tree_view_column_cell_get_position(Xen tree_column, Xen cell_renderer, Xen ignore_start_pos, Xen ignore_width)
{
- #define H_gtk_tree_drag_source_drag_data_get "gboolean gtk_tree_drag_source_drag_data_get(GtkTreeDragSource* drag_source, \
-GtkTreePath* path, GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkTreeDragSource__P(drag_source), drag_source, 1, "gtk_tree_drag_source_drag_data_get", "GtkTreeDragSource*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_drag_source_drag_data_get", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 3, "gtk_tree_drag_source_drag_data_get", "GtkSelectionData*");
- return(C_TO_XEN_gboolean(gtk_tree_drag_source_drag_data_get(XEN_TO_C_GtkTreeDragSource_(drag_source), XEN_TO_C_GtkTreePath_(path),
- XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_tree_view_column_cell_get_position "gboolean gtk_tree_view_column_cell_get_position(GtkTreeViewColumn* tree_column, \
+GtkCellRenderer* cell_renderer, gint* [start_pos], gint* [width])"
+ gint ref_start_pos;
+ gint ref_width;
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_cell_get_position", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_cell_get_position", "GtkCellRenderer*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_tree_view_column_cell_get_position(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkCellRenderer_(cell_renderer),
+ &ref_start_pos, &ref_width));
+ return(Xen_list_3(result, C_to_Xen_gint(ref_start_pos), C_to_Xen_gint(ref_width)));
+ }
}
-static XEN gxg_gtk_tree_drag_dest_drag_data_received(XEN drag_dest, XEN dest, XEN selection_data)
+static Xen gxg_gtk_tree_view_new(void)
{
- #define H_gtk_tree_drag_dest_drag_data_received "gboolean gtk_tree_drag_dest_drag_data_received(GtkTreeDragDest* drag_dest, \
-GtkTreePath* dest, GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkTreeDragDest__P(drag_dest), drag_dest, 1, "gtk_tree_drag_dest_drag_data_received", "GtkTreeDragDest*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(dest), dest, 2, "gtk_tree_drag_dest_drag_data_received", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 3, "gtk_tree_drag_dest_drag_data_received", "GtkSelectionData*");
- return(C_TO_XEN_gboolean(gtk_tree_drag_dest_drag_data_received(XEN_TO_C_GtkTreeDragDest_(drag_dest), XEN_TO_C_GtkTreePath_(dest),
- XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_tree_view_new "GtkWidget* gtk_tree_view_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_tree_view_new()));
}
-static XEN gxg_gtk_tree_drag_dest_row_drop_possible(XEN drag_dest, XEN dest_path, XEN selection_data)
+static Xen gxg_gtk_tree_view_new_with_model(Xen model)
{
- #define H_gtk_tree_drag_dest_row_drop_possible "gboolean gtk_tree_drag_dest_row_drop_possible(GtkTreeDragDest* drag_dest, \
-GtkTreePath* dest_path, GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkTreeDragDest__P(drag_dest), drag_dest, 1, "gtk_tree_drag_dest_row_drop_possible", "GtkTreeDragDest*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(dest_path), dest_path, 2, "gtk_tree_drag_dest_row_drop_possible", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 3, "gtk_tree_drag_dest_row_drop_possible", "GtkSelectionData*");
- return(C_TO_XEN_gboolean(gtk_tree_drag_dest_row_drop_possible(XEN_TO_C_GtkTreeDragDest_(drag_dest), XEN_TO_C_GtkTreePath_(dest_path),
- XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_tree_view_new_with_model "GtkWidget* gtk_tree_view_new_with_model(GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkTreeModel_(model), model, 1, "gtk_tree_view_new_with_model", "GtkTreeModel*");
+ return(C_to_Xen_GtkWidget_(gtk_tree_view_new_with_model(Xen_to_C_GtkTreeModel_(model))));
}
-static XEN gxg_gtk_tree_set_row_drag_data(XEN selection_data, XEN tree_model, XEN path)
+static Xen gxg_gtk_tree_view_get_model(Xen tree_view)
{
- #define H_gtk_tree_set_row_drag_data "gboolean gtk_tree_set_row_drag_data(GtkSelectionData* selection_data, \
-GtkTreeModel* tree_model, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_tree_set_row_drag_data", "GtkSelectionData*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 2, "gtk_tree_set_row_drag_data", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 3, "gtk_tree_set_row_drag_data", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_set_row_drag_data(XEN_TO_C_GtkSelectionData_(selection_data), XEN_TO_C_GtkTreeModel_(tree_model),
- XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_get_model "GtkTreeModel* gtk_tree_view_get_model(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_model", "GtkTreeView*");
+ return(C_to_Xen_GtkTreeModel_(gtk_tree_view_get_model(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_get_row_drag_data(XEN selection_data, XEN ignore_tree_model, XEN ignore_path)
+static Xen gxg_gtk_tree_view_set_model(Xen tree_view, Xen model)
{
- #define H_gtk_tree_get_row_drag_data "gboolean gtk_tree_get_row_drag_data(GtkSelectionData* selection_data, \
-GtkTreeModel** [tree_model], GtkTreePath** [path])"
- GtkTreeModel* ref_tree_model = NULL;
- GtkTreePath* ref_path = NULL;
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_tree_get_row_drag_data", "GtkSelectionData*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_tree_get_row_drag_data(XEN_TO_C_GtkSelectionData_(selection_data), &ref_tree_model, &ref_path));
- return(XEN_LIST_3(result, C_TO_XEN_GtkTreeModel_(ref_tree_model), C_TO_XEN_GtkTreePath_(ref_path)));
- }
+ #define H_gtk_tree_view_set_model "void gtk_tree_view_set_model(GtkTreeView* tree_view, GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_model", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeModel_(model) || Xen_is_false(model), model, 2, "gtk_tree_view_set_model", "GtkTreeModel*");
+ gtk_tree_view_set_model(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeModel_(model));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_path_new(void)
+static Xen gxg_gtk_tree_view_get_selection(Xen tree_view)
{
- #define H_gtk_tree_path_new "GtkTreePath* gtk_tree_path_new( void)"
- return(C_TO_XEN_GtkTreePath_(gtk_tree_path_new()));
+ #define H_gtk_tree_view_get_selection "GtkTreeSelection* gtk_tree_view_get_selection(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_selection", "GtkTreeView*");
+ return(C_to_Xen_GtkTreeSelection_(gtk_tree_view_get_selection(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_path_new_from_string(XEN path)
+static Xen gxg_gtk_tree_view_get_headers_visible(Xen tree_view)
{
- #define H_gtk_tree_path_new_from_string "GtkTreePath* gtk_tree_path_new_from_string(gchar* path)"
- XEN_ASSERT_TYPE(XEN_gchar__P(path), path, 1, "gtk_tree_path_new_from_string", "gchar*");
- return(C_TO_XEN_GtkTreePath_(gtk_tree_path_new_from_string(XEN_TO_C_gchar_(path))));
+ #define H_gtk_tree_view_get_headers_visible "gboolean gtk_tree_view_get_headers_visible(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_headers_visible", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_headers_visible(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_path_to_string(XEN path)
+static Xen gxg_gtk_tree_view_set_headers_visible(Xen tree_view, Xen headers_visible)
{
- #define H_gtk_tree_path_to_string "gchar* gtk_tree_path_to_string(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_to_string", "GtkTreePath*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_tree_path_to_string(XEN_TO_C_GtkTreePath_(path));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_tree_view_set_headers_visible "void gtk_tree_view_set_headers_visible(GtkTreeView* tree_view, \
+gboolean headers_visible)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_headers_visible", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(headers_visible), headers_visible, 2, "gtk_tree_view_set_headers_visible", "gboolean");
+ gtk_tree_view_set_headers_visible(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(headers_visible));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_path_new_first(void)
+static Xen gxg_gtk_tree_view_columns_autosize(Xen tree_view)
{
- #define H_gtk_tree_path_new_first "GtkTreePath* gtk_tree_path_new_first( void)"
- return(C_TO_XEN_GtkTreePath_(gtk_tree_path_new_first()));
+ #define H_gtk_tree_view_columns_autosize "void gtk_tree_view_columns_autosize(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_columns_autosize", "GtkTreeView*");
+ gtk_tree_view_columns_autosize(Xen_to_C_GtkTreeView_(tree_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_path_append_index(XEN path, XEN index)
+static Xen gxg_gtk_tree_view_set_headers_clickable(Xen tree_view, Xen setting)
{
- #define H_gtk_tree_path_append_index "void gtk_tree_path_append_index(GtkTreePath* path, gint index)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_append_index", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_gint_P(index), index, 2, "gtk_tree_path_append_index", "gint");
- gtk_tree_path_append_index(XEN_TO_C_GtkTreePath_(path), XEN_TO_C_gint(index));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_headers_clickable "void gtk_tree_view_set_headers_clickable(GtkTreeView* tree_view, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_headers_clickable", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_tree_view_set_headers_clickable", "gboolean");
+ gtk_tree_view_set_headers_clickable(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_path_prepend_index(XEN path, XEN index)
+static Xen gxg_gtk_tree_view_append_column(Xen tree_view, Xen column)
{
- #define H_gtk_tree_path_prepend_index "void gtk_tree_path_prepend_index(GtkTreePath* path, gint index)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_prepend_index", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_gint_P(index), index, 2, "gtk_tree_path_prepend_index", "gint");
- gtk_tree_path_prepend_index(XEN_TO_C_GtkTreePath_(path), XEN_TO_C_gint(index));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_append_column "gint gtk_tree_view_append_column(GtkTreeView* tree_view, GtkTreeViewColumn* column)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_append_column", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column), column, 2, "gtk_tree_view_append_column", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_append_column(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewColumn_(column))));
}
-static XEN gxg_gtk_tree_path_get_depth(XEN path)
+static Xen gxg_gtk_tree_view_remove_column(Xen tree_view, Xen column)
{
- #define H_gtk_tree_path_get_depth "gint gtk_tree_path_get_depth(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_get_depth", "GtkTreePath*");
- return(C_TO_XEN_gint(gtk_tree_path_get_depth(XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_remove_column "gint gtk_tree_view_remove_column(GtkTreeView* tree_view, GtkTreeViewColumn* column)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_remove_column", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column), column, 2, "gtk_tree_view_remove_column", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_remove_column(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewColumn_(column))));
}
-static XEN gxg_gtk_tree_path_get_indices(XEN path)
+static Xen gxg_gtk_tree_view_insert_column(Xen tree_view, Xen column, Xen position)
{
- #define H_gtk_tree_path_get_indices "gint* gtk_tree_path_get_indices(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_get_indices", "GtkTreePath*");
- return(C_TO_XEN_gint_(gtk_tree_path_get_indices(XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_insert_column "gint gtk_tree_view_insert_column(GtkTreeView* tree_view, GtkTreeViewColumn* column, \
+gint position)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_insert_column", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column), column, 2, "gtk_tree_view_insert_column", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_tree_view_insert_column", "gint");
+ return(C_to_Xen_gint(gtk_tree_view_insert_column(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewColumn_(column),
+ Xen_to_C_gint(position))));
}
-static XEN gxg_gtk_tree_path_free(XEN path)
+static Xen gxg_gtk_tree_view_insert_column_with_attributes(Xen tree_view, Xen position, Xen title, Xen cell, Xen attributes)
{
- #define H_gtk_tree_path_free "void gtk_tree_path_free(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_free", "GtkTreePath*");
- gtk_tree_path_free(XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_insert_column_with_attributes "gint gtk_tree_view_insert_column_with_attributes(GtkTreeView* tree_view, \
+gint position, gchar* title, GtkCellRenderer* cell, etc attributes)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_insert_column_with_attributes", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_tree_view_insert_column_with_attributes", "gint");
+ Xen_check_type(Xen_is_gchar_(title), title, 3, "gtk_tree_view_insert_column_with_attributes", "gchar*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 4, "gtk_tree_view_insert_column_with_attributes", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_etc(attributes), attributes, 5, "gtk_tree_view_insert_column_with_attributes", "etc");
+ {
+ int etc_len = 0;
+ gint result = 0;
+ GtkTreeView* p_arg0;
+ gint p_arg1;
+ gchar* p_arg2;
+ GtkCellRenderer* p_arg3;
+ if (Xen_is_list(attributes)) etc_len = Xen_list_length(attributes);
+ if (etc_len < 2) Xen_out_of_range_error("gtk_tree_view_insert_column_with_attributes", 4, attributes, "... list must have at least 2 entries");
+ if (etc_len > 10) Xen_out_of_range_error("gtk_tree_view_insert_column_with_attributes", 4, attributes, "... list too long (max len: 10)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_tree_view_insert_column_with_attributes", 4, attributes, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_GtkTreeView_(tree_view);
+ p_arg1 = Xen_to_C_gint(position);
+ p_arg2 = Xen_to_C_gchar_(title);
+ p_arg3 = Xen_to_C_GtkCellRenderer_(cell);
+ switch (etc_len)
+ {
+ case 2: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), NULL); break;
+ case 4: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), NULL); break;
+ case 6: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), NULL); break;
+ case 8: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), NULL); break;
+ case 10: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), XLS(attributes, 8), XLI(attributes, 9), NULL); break;
+ }
+ return(C_to_Xen_gint(result));
+ }
}
-static XEN gxg_gtk_tree_path_copy(XEN path)
+static Xen gxg_gtk_tree_view_insert_column_with_data_func(Xen tree_view, Xen position, Xen title, Xen cell, Xen func, Xen func_info, Xen dnotify)
{
- #define H_gtk_tree_path_copy "GtkTreePath* gtk_tree_path_copy(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_copy", "GtkTreePath*");
- return(C_TO_XEN_GtkTreePath_(gtk_tree_path_copy(XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_insert_column_with_data_func "gint gtk_tree_view_insert_column_with_data_func(GtkTreeView* tree_view, \
+gint position, gchar* title, GtkCellRenderer* cell, GtkTreeCellDataFunc func, lambda_data func_info, \
+GtkDestroyNotify dnotify)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_insert_column_with_data_func", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_tree_view_insert_column_with_data_func", "gint");
+ Xen_check_type(Xen_is_gchar_(title), title, 3, "gtk_tree_view_insert_column_with_data_func", "gchar*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 4, "gtk_tree_view_insert_column_with_data_func", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GtkTreeCellDataFunc(func), func, 5, "gtk_tree_view_insert_column_with_data_func", "GtkTreeCellDataFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 6, "gtk_tree_view_insert_column_with_data_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(dnotify), dnotify, 7, "gtk_tree_view_insert_column_with_data_func", "GtkDestroyNotify");
+ {
+ Xen result;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, dnotify);
+ result = C_to_Xen_gint(gtk_tree_view_insert_column_with_data_func(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(position),
+ Xen_to_C_gchar_(title), Xen_to_C_GtkCellRenderer_(cell),
+ Xen_to_C_GtkTreeCellDataFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GtkDestroyNotify(dnotify)));
+ return(result);
+ }
}
-static XEN gxg_gtk_tree_path_compare(XEN a, XEN b)
+static Xen gxg_gtk_tree_view_get_column(Xen tree_view, Xen n)
{
- #define H_gtk_tree_path_compare "gint gtk_tree_path_compare(GtkTreePath* a, GtkTreePath* b)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(a), a, 1, "gtk_tree_path_compare", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(b), b, 2, "gtk_tree_path_compare", "GtkTreePath*");
- return(C_TO_XEN_gint(gtk_tree_path_compare(XEN_TO_C_GtkTreePath_(a), XEN_TO_C_GtkTreePath_(b))));
+ #define H_gtk_tree_view_get_column "GtkTreeViewColumn* gtk_tree_view_get_column(GtkTreeView* tree_view, \
+gint n)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_column", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(n), n, 2, "gtk_tree_view_get_column", "gint");
+ return(C_to_Xen_GtkTreeViewColumn_(gtk_tree_view_get_column(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(n))));
}
-static XEN gxg_gtk_tree_path_next(XEN path)
+static Xen gxg_gtk_tree_view_get_columns(Xen tree_view)
{
- #define H_gtk_tree_path_next "void gtk_tree_path_next(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_next", "GtkTreePath*");
- gtk_tree_path_next(XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_columns "GList* gtk_tree_view_get_columns(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_columns", "GtkTreeView*");
+ return(C_to_Xen_GList_(gtk_tree_view_get_columns(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_path_prev(XEN path)
+static Xen gxg_gtk_tree_view_move_column_after(Xen tree_view, Xen column, Xen base_column)
{
- #define H_gtk_tree_path_prev "gboolean gtk_tree_path_prev(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_prev", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_path_prev(XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_move_column_after "void gtk_tree_view_move_column_after(GtkTreeView* tree_view, \
+GtkTreeViewColumn* column, GtkTreeViewColumn* base_column)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_move_column_after", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column), column, 2, "gtk_tree_view_move_column_after", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(base_column) || Xen_is_false(base_column), base_column, 3, "gtk_tree_view_move_column_after", "GtkTreeViewColumn*");
+ gtk_tree_view_move_column_after(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewColumn_(column), Xen_to_C_GtkTreeViewColumn_(base_column));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_path_up(XEN path)
+static Xen gxg_gtk_tree_view_set_expander_column(Xen tree_view, Xen column)
{
- #define H_gtk_tree_path_up "gboolean gtk_tree_path_up(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_up", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_path_up(XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_set_expander_column "void gtk_tree_view_set_expander_column(GtkTreeView* tree_view, \
+GtkTreeViewColumn* column)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_expander_column", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column) || Xen_is_false(column), column, 2, "gtk_tree_view_set_expander_column", "GtkTreeViewColumn*");
+ gtk_tree_view_set_expander_column(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewColumn_(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_path_down(XEN path)
+static Xen gxg_gtk_tree_view_get_expander_column(Xen tree_view)
{
- #define H_gtk_tree_path_down "void gtk_tree_path_down(GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_down", "GtkTreePath*");
- gtk_tree_path_down(XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_expander_column "GtkTreeViewColumn* gtk_tree_view_get_expander_column(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_expander_column", "GtkTreeView*");
+ return(C_to_Xen_GtkTreeViewColumn_(gtk_tree_view_get_expander_column(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_path_is_ancestor(XEN path, XEN descendant)
+static Xen gxg_gtk_tree_view_set_column_drag_function(Xen tree_view, Xen func, Xen func_info, Xen destroy)
{
- #define H_gtk_tree_path_is_ancestor "gboolean gtk_tree_path_is_ancestor(GtkTreePath* path, GtkTreePath* descendant)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_is_ancestor", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(descendant), descendant, 2, "gtk_tree_path_is_ancestor", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_path_is_ancestor(XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreePath_(descendant))));
+ #define H_gtk_tree_view_set_column_drag_function "void gtk_tree_view_set_column_drag_function(GtkTreeView* tree_view, \
+GtkTreeViewColumnDropFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_column_drag_function", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewColumnDropFunc(func), func, 2, "gtk_tree_view_set_column_drag_function", "GtkTreeViewColumnDropFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_view_set_column_drag_function", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(destroy), destroy, 4, "gtk_tree_view_set_column_drag_function", "GtkDestroyNotify");
+ {
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ Xen_list_set(gxg_ptr, 3, destroy);
+ gtk_tree_view_set_column_drag_function(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewColumnDropFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GtkDestroyNotify(destroy));
+ xm_unprotect_at(loc);
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_tree_path_is_descendant(XEN path, XEN ancestor)
+static Xen gxg_gtk_tree_view_scroll_to_point(Xen tree_view, Xen tree_x, Xen tree_y)
{
- #define H_gtk_tree_path_is_descendant "gboolean gtk_tree_path_is_descendant(GtkTreePath* path, GtkTreePath* ancestor)"
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 1, "gtk_tree_path_is_descendant", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(ancestor), ancestor, 2, "gtk_tree_path_is_descendant", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_path_is_descendant(XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreePath_(ancestor))));
+ #define H_gtk_tree_view_scroll_to_point "void gtk_tree_view_scroll_to_point(GtkTreeView* tree_view, \
+gint tree_x, gint tree_y)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_scroll_to_point", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(tree_x), tree_x, 2, "gtk_tree_view_scroll_to_point", "gint");
+ Xen_check_type(Xen_is_gint(tree_y), tree_y, 3, "gtk_tree_view_scroll_to_point", "gint");
+ gtk_tree_view_scroll_to_point(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(tree_x), Xen_to_C_gint(tree_y));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_row_reference_new(XEN model, XEN path)
+static Xen gxg_gtk_tree_view_scroll_to_cell(Xen tree_view, Xen path, Xen column, Xen use_align, Xen row_align, Xen col_align)
{
- #define H_gtk_tree_row_reference_new "GtkTreeRowReference* gtk_tree_row_reference_new(GtkTreeModel* model, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model), model, 1, "gtk_tree_row_reference_new", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_row_reference_new", "GtkTreePath*");
- return(C_TO_XEN_GtkTreeRowReference_(gtk_tree_row_reference_new(XEN_TO_C_GtkTreeModel_(model), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_scroll_to_cell "void gtk_tree_view_scroll_to_cell(GtkTreeView* tree_view, GtkTreePath* path, \
+GtkTreeViewColumn* column, gboolean use_align, gfloat row_align, gfloat col_align)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_scroll_to_cell", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path) || Xen_is_false(path), path, 2, "gtk_tree_view_scroll_to_cell", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column) || Xen_is_false(column), column, 3, "gtk_tree_view_scroll_to_cell", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gboolean(use_align), use_align, 4, "gtk_tree_view_scroll_to_cell", "gboolean");
+ Xen_check_type(Xen_is_gfloat(row_align), row_align, 5, "gtk_tree_view_scroll_to_cell", "gfloat");
+ Xen_check_type(Xen_is_gfloat(col_align), col_align, 6, "gtk_tree_view_scroll_to_cell", "gfloat");
+ gtk_tree_view_scroll_to_cell(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeViewColumn_(column),
+ Xen_to_C_gboolean(use_align), Xen_to_C_gfloat(row_align), Xen_to_C_gfloat(col_align));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_row_reference_new_proxy(XEN proxy, XEN model, XEN path)
+static Xen gxg_gtk_tree_view_row_activated(Xen tree_view, Xen path, Xen column)
{
- #define H_gtk_tree_row_reference_new_proxy "GtkTreeRowReference* gtk_tree_row_reference_new_proxy(GObject* proxy, \
-GtkTreeModel* model, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GObject__P(proxy), proxy, 1, "gtk_tree_row_reference_new_proxy", "GObject*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model), model, 2, "gtk_tree_row_reference_new_proxy", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 3, "gtk_tree_row_reference_new_proxy", "GtkTreePath*");
- return(C_TO_XEN_GtkTreeRowReference_(gtk_tree_row_reference_new_proxy(XEN_TO_C_GObject_(proxy), XEN_TO_C_GtkTreeModel_(model),
- XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_row_activated "void gtk_tree_view_row_activated(GtkTreeView* tree_view, GtkTreePath* path, \
+GtkTreeViewColumn* column)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_row_activated", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_row_activated", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column), column, 3, "gtk_tree_view_row_activated", "GtkTreeViewColumn*");
+ gtk_tree_view_row_activated(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeViewColumn_(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_row_reference_get_path(XEN reference)
+static Xen gxg_gtk_tree_view_expand_all(Xen tree_view)
{
- #define H_gtk_tree_row_reference_get_path "GtkTreePath* gtk_tree_row_reference_get_path(GtkTreeRowReference* reference)"
- XEN_ASSERT_TYPE(XEN_GtkTreeRowReference__P(reference), reference, 1, "gtk_tree_row_reference_get_path", "GtkTreeRowReference*");
- return(C_TO_XEN_GtkTreePath_(gtk_tree_row_reference_get_path(XEN_TO_C_GtkTreeRowReference_(reference))));
+ #define H_gtk_tree_view_expand_all "void gtk_tree_view_expand_all(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_expand_all", "GtkTreeView*");
+ gtk_tree_view_expand_all(Xen_to_C_GtkTreeView_(tree_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_row_reference_valid(XEN reference)
+static Xen gxg_gtk_tree_view_collapse_all(Xen tree_view)
{
- #define H_gtk_tree_row_reference_valid "gboolean gtk_tree_row_reference_valid(GtkTreeRowReference* reference)"
- XEN_ASSERT_TYPE(XEN_GtkTreeRowReference__P(reference), reference, 1, "gtk_tree_row_reference_valid", "GtkTreeRowReference*");
- return(C_TO_XEN_gboolean(gtk_tree_row_reference_valid(XEN_TO_C_GtkTreeRowReference_(reference))));
+ #define H_gtk_tree_view_collapse_all "void gtk_tree_view_collapse_all(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_collapse_all", "GtkTreeView*");
+ gtk_tree_view_collapse_all(Xen_to_C_GtkTreeView_(tree_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_row_reference_free(XEN reference)
+static Xen gxg_gtk_tree_view_expand_row(Xen tree_view, Xen path, Xen open_all)
{
- #define H_gtk_tree_row_reference_free "void gtk_tree_row_reference_free(GtkTreeRowReference* reference)"
- XEN_ASSERT_TYPE(XEN_GtkTreeRowReference__P(reference), reference, 1, "gtk_tree_row_reference_free", "GtkTreeRowReference*");
- gtk_tree_row_reference_free(XEN_TO_C_GtkTreeRowReference_(reference));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_expand_row "gboolean gtk_tree_view_expand_row(GtkTreeView* tree_view, GtkTreePath* path, \
+gboolean open_all)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_expand_row", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_expand_row", "GtkTreePath*");
+ Xen_check_type(Xen_is_gboolean(open_all), open_all, 3, "gtk_tree_view_expand_row", "gboolean");
+ return(C_to_Xen_gboolean(gtk_tree_view_expand_row(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_gboolean(open_all))));
}
-static XEN gxg_gtk_tree_row_reference_inserted(XEN proxy, XEN path)
+static Xen gxg_gtk_tree_view_collapse_row(Xen tree_view, Xen path)
{
- #define H_gtk_tree_row_reference_inserted "void gtk_tree_row_reference_inserted(GObject* proxy, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GObject__P(proxy), proxy, 1, "gtk_tree_row_reference_inserted", "GObject*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_row_reference_inserted", "GtkTreePath*");
- gtk_tree_row_reference_inserted(XEN_TO_C_GObject_(proxy), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_collapse_row "gboolean gtk_tree_view_collapse_row(GtkTreeView* tree_view, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_collapse_row", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_collapse_row", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_view_collapse_row(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_tree_row_reference_deleted(XEN proxy, XEN path)
+static Xen gxg_gtk_tree_view_map_expanded_rows(Xen tree_view, Xen func, Xen func_info)
{
- #define H_gtk_tree_row_reference_deleted "void gtk_tree_row_reference_deleted(GObject* proxy, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GObject__P(proxy), proxy, 1, "gtk_tree_row_reference_deleted", "GObject*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_row_reference_deleted", "GtkTreePath*");
- gtk_tree_row_reference_deleted(XEN_TO_C_GObject_(proxy), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_map_expanded_rows "void gtk_tree_view_map_expanded_rows(GtkTreeView* tree_view, \
+GtkTreeViewMappingFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_map_expanded_rows", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewMappingFunc(func), func, 2, "gtk_tree_view_map_expanded_rows", "GtkTreeViewMappingFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_view_map_expanded_rows", "lambda_data");
+ {
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_tree_view_map_expanded_rows(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewMappingFunc(func), Xen_to_C_lambda_data(func_info));
+ xm_unprotect_at(loc);
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_tree_row_reference_reordered(XEN proxy, XEN path, XEN iter, XEN new_order)
+static Xen gxg_gtk_tree_view_row_expanded(Xen tree_view, Xen path)
{
- #define H_gtk_tree_row_reference_reordered "void gtk_tree_row_reference_reordered(GObject* proxy, GtkTreePath* path, \
-GtkTreeIter* iter, gint* new_order)"
- XEN_ASSERT_TYPE(XEN_GObject__P(proxy), proxy, 1, "gtk_tree_row_reference_reordered", "GObject*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_row_reference_reordered", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 3, "gtk_tree_row_reference_reordered", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gint__P(new_order), new_order, 4, "gtk_tree_row_reference_reordered", "gint*");
- gtk_tree_row_reference_reordered(XEN_TO_C_GObject_(proxy), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_gint_(new_order));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_row_expanded "gboolean gtk_tree_view_row_expanded(GtkTreeView* tree_view, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_row_expanded", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_row_expanded", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_tree_view_row_expanded(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_tree_iter_copy(XEN iter)
+static Xen gxg_gtk_tree_view_set_reorderable(Xen tree_view, Xen reorderable)
{
- #define H_gtk_tree_iter_copy "GtkTreeIter* gtk_tree_iter_copy(GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 1, "gtk_tree_iter_copy", "GtkTreeIter*");
- return(C_TO_XEN_GtkTreeIter_(gtk_tree_iter_copy(XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_tree_view_set_reorderable "void gtk_tree_view_set_reorderable(GtkTreeView* tree_view, \
+gboolean reorderable)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_reorderable", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(reorderable), reorderable, 2, "gtk_tree_view_set_reorderable", "gboolean");
+ gtk_tree_view_set_reorderable(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(reorderable));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_iter_free(XEN iter)
+static Xen gxg_gtk_tree_view_get_reorderable(Xen tree_view)
{
- #define H_gtk_tree_iter_free "void gtk_tree_iter_free(GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 1, "gtk_tree_iter_free", "GtkTreeIter*");
- gtk_tree_iter_free(XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_reorderable "gboolean gtk_tree_view_get_reorderable(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_reorderable", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_reorderable(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_model_get_flags(XEN tree_model)
+static Xen gxg_gtk_tree_view_set_cursor(Xen tree_view, Xen path, Xen focus_column, Xen start_editing)
{
- #define H_gtk_tree_model_get_flags "GtkTreeModelFlags gtk_tree_model_get_flags(GtkTreeModel* tree_model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_get_flags", "GtkTreeModel*");
- return(C_TO_XEN_GtkTreeModelFlags(gtk_tree_model_get_flags(XEN_TO_C_GtkTreeModel_(tree_model))));
+ #define H_gtk_tree_view_set_cursor "void gtk_tree_view_set_cursor(GtkTreeView* tree_view, GtkTreePath* path, \
+GtkTreeViewColumn* focus_column, gboolean start_editing)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_cursor", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_set_cursor", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(focus_column), focus_column, 3, "gtk_tree_view_set_cursor", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gboolean(start_editing), start_editing, 4, "gtk_tree_view_set_cursor", "gboolean");
+ gtk_tree_view_set_cursor(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeViewColumn_(focus_column),
+ Xen_to_C_gboolean(start_editing));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_get_n_columns(XEN tree_model)
+static Xen gxg_gtk_tree_view_get_cursor(Xen tree_view, Xen ignore_path, Xen ignore_focus_column)
{
- #define H_gtk_tree_model_get_n_columns "gint gtk_tree_model_get_n_columns(GtkTreeModel* tree_model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_get_n_columns", "GtkTreeModel*");
- return(C_TO_XEN_gint(gtk_tree_model_get_n_columns(XEN_TO_C_GtkTreeModel_(tree_model))));
+ #define H_gtk_tree_view_get_cursor "void gtk_tree_view_get_cursor(GtkTreeView* tree_view, GtkTreePath** [path], \
+GtkTreeViewColumn** [focus_column])"
+ GtkTreePath* ref_path = NULL;
+ GtkTreeViewColumn* ref_focus_column = NULL;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_cursor", "GtkTreeView*");
+ gtk_tree_view_get_cursor(Xen_to_C_GtkTreeView_(tree_view), &ref_path, &ref_focus_column);
+ return(Xen_list_2(C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkTreeViewColumn_(ref_focus_column)));
}
-static XEN gxg_gtk_tree_model_get_column_type(XEN tree_model, XEN index)
+static Xen gxg_gtk_tree_view_get_bin_window(Xen tree_view)
{
- #define H_gtk_tree_model_get_column_type "GType gtk_tree_model_get_column_type(GtkTreeModel* tree_model, \
-gint index)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_get_column_type", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_gint_P(index), index, 2, "gtk_tree_model_get_column_type", "gint");
- return(C_TO_XEN_GType(gtk_tree_model_get_column_type(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_gint(index))));
+ #define H_gtk_tree_view_get_bin_window "GdkWindow* gtk_tree_view_get_bin_window(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_bin_window", "GtkTreeView*");
+ return(C_to_Xen_GdkWindow_(gtk_tree_view_get_bin_window(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_model_get_iter(XEN tree_model, XEN iter, XEN path)
+static Xen gxg_gtk_tree_view_get_path_at_pos(Xen tree_view, Xen x, Xen y, Xen ignore_path, Xen ignore_column, Xen ignore_cell_x, Xen ignore_cell_y)
{
- #define H_gtk_tree_model_get_iter "gboolean gtk_tree_model_get_iter(GtkTreeModel* tree_model, GtkTreeIter* iter, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_get_iter", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_get_iter", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 3, "gtk_tree_model_get_iter", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_model_get_iter(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_tree_view_get_path_at_pos "gboolean gtk_tree_view_get_path_at_pos(GtkTreeView* tree_view, \
+gint x, gint y, GtkTreePath** [path], GtkTreeViewColumn** [column], gint* [cell_x], gint* [cell_y])"
+ GtkTreePath* ref_path = NULL;
+ GtkTreeViewColumn* ref_column = NULL;
+ gint ref_cell_x;
+ gint ref_cell_y;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_path_at_pos", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_tree_view_get_path_at_pos", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_tree_view_get_path_at_pos", "gint");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_tree_view_get_path_at_pos(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(x), Xen_to_C_gint(y),
+ &ref_path, &ref_column, &ref_cell_x, &ref_cell_y));
+ return(Xen_list_5(result, C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkTreeViewColumn_(ref_column), C_to_Xen_gint(ref_cell_x), C_to_Xen_gint(ref_cell_y)));
+ }
}
-static XEN gxg_gtk_tree_model_get_iter_from_string(XEN tree_model, XEN iter, XEN path_string)
+static Xen gxg_gtk_tree_view_get_cell_area(Xen tree_view, Xen path, Xen column, Xen rect)
{
- #define H_gtk_tree_model_get_iter_from_string "gboolean gtk_tree_model_get_iter_from_string(GtkTreeModel* tree_model, \
-GtkTreeIter* iter, gchar* path_string)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_get_iter_from_string", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_get_iter_from_string", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(path_string), path_string, 3, "gtk_tree_model_get_iter_from_string", "gchar*");
- return(C_TO_XEN_gboolean(gtk_tree_model_get_iter_from_string(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter),
- XEN_TO_C_gchar_(path_string))));
+ #define H_gtk_tree_view_get_cell_area "void gtk_tree_view_get_cell_area(GtkTreeView* tree_view, GtkTreePath* path, \
+GtkTreeViewColumn* column, GdkRectangle* rect)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_cell_area", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path) || Xen_is_false(path), path, 2, "gtk_tree_view_get_cell_area", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column) || Xen_is_false(column), column, 3, "gtk_tree_view_get_cell_area", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 4, "gtk_tree_view_get_cell_area", "GdkRectangle*");
+ gtk_tree_view_get_cell_area(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeViewColumn_(column),
+ Xen_to_C_GdkRectangle_(rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_get_iter_first(XEN tree_model, XEN iter)
+static Xen gxg_gtk_tree_view_get_background_area(Xen tree_view, Xen path, Xen column, Xen rect)
{
- #define H_gtk_tree_model_get_iter_first "gboolean gtk_tree_model_get_iter_first(GtkTreeModel* tree_model, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_get_iter_first", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_get_iter_first", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_model_get_iter_first(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_tree_view_get_background_area "void gtk_tree_view_get_background_area(GtkTreeView* tree_view, \
+GtkTreePath* path, GtkTreeViewColumn* column, GdkRectangle* rect)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_background_area", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path) || Xen_is_false(path), path, 2, "gtk_tree_view_get_background_area", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column) || Xen_is_false(column), column, 3, "gtk_tree_view_get_background_area", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 4, "gtk_tree_view_get_background_area", "GdkRectangle*");
+ gtk_tree_view_get_background_area(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeViewColumn_(column),
+ Xen_to_C_GdkRectangle_(rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_get_path(XEN tree_model, XEN iter)
+static Xen gxg_gtk_tree_view_get_visible_rect(Xen tree_view, Xen visible_rect)
{
- #define H_gtk_tree_model_get_path "GtkTreePath* gtk_tree_model_get_path(GtkTreeModel* tree_model, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_get_path", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_get_path", "GtkTreeIter*");
- return(C_TO_XEN_GtkTreePath_(gtk_tree_model_get_path(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_tree_view_get_visible_rect "void gtk_tree_view_get_visible_rect(GtkTreeView* tree_view, \
+GdkRectangle* visible_rect)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_visible_rect", "GtkTreeView*");
+ Xen_check_type(Xen_is_GdkRectangle_(visible_rect), visible_rect, 2, "gtk_tree_view_get_visible_rect", "GdkRectangle*");
+ gtk_tree_view_get_visible_rect(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GdkRectangle_(visible_rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_iter_next(XEN tree_model, XEN iter)
+static Xen gxg_gtk_tree_view_enable_model_drag_source(Xen tree_view, Xen start_button_mask, Xen targets, Xen n_targets, Xen actions)
{
- #define H_gtk_tree_model_iter_next "gboolean gtk_tree_model_iter_next(GtkTreeModel* tree_model, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_iter_next", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_iter_next", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_model_iter_next(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_tree_view_enable_model_drag_source "void gtk_tree_view_enable_model_drag_source(GtkTreeView* tree_view, \
+GdkModifierType start_button_mask, GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_enable_model_drag_source", "GtkTreeView*");
+ Xen_check_type(Xen_is_GdkModifierType(start_button_mask), start_button_mask, 2, "gtk_tree_view_enable_model_drag_source", "GdkModifierType");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 3, "gtk_tree_view_enable_model_drag_source", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 4, "gtk_tree_view_enable_model_drag_source", "gint");
+ Xen_check_type(Xen_is_GdkDragAction(actions), actions, 5, "gtk_tree_view_enable_model_drag_source", "GdkDragAction");
+ gtk_tree_view_enable_model_drag_source(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GdkModifierType(start_button_mask), Xen_to_C_GtkTargetEntry_(targets),
+ Xen_to_C_gint(n_targets), Xen_to_C_GdkDragAction(actions));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_iter_children(XEN tree_model, XEN iter, XEN parent)
+static Xen gxg_gtk_tree_view_enable_model_drag_dest(Xen tree_view, Xen targets, Xen n_targets, Xen actions)
{
- #define H_gtk_tree_model_iter_children "gboolean gtk_tree_model_iter_children(GtkTreeModel* tree_model, \
-GtkTreeIter* iter, GtkTreeIter* parent)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_iter_children", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_iter_children", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(parent) || XEN_FALSE_P(parent), parent, 3, "gtk_tree_model_iter_children", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_model_iter_children(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter),
- XEN_TO_C_GtkTreeIter_(parent))));
+ #define H_gtk_tree_view_enable_model_drag_dest "void gtk_tree_view_enable_model_drag_dest(GtkTreeView* tree_view, \
+GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_enable_model_drag_dest", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 2, "gtk_tree_view_enable_model_drag_dest", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 3, "gtk_tree_view_enable_model_drag_dest", "gint");
+ Xen_check_type(Xen_is_GdkDragAction(actions), actions, 4, "gtk_tree_view_enable_model_drag_dest", "GdkDragAction");
+ gtk_tree_view_enable_model_drag_dest(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTargetEntry_(targets), Xen_to_C_gint(n_targets),
+ Xen_to_C_GdkDragAction(actions));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_iter_has_child(XEN tree_model, XEN iter)
+static Xen gxg_gtk_tree_view_unset_rows_drag_source(Xen tree_view)
{
- #define H_gtk_tree_model_iter_has_child "gboolean gtk_tree_model_iter_has_child(GtkTreeModel* tree_model, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_iter_has_child", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_iter_has_child", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_model_iter_has_child(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_tree_view_unset_rows_drag_source "void gtk_tree_view_unset_rows_drag_source(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_unset_rows_drag_source", "GtkTreeView*");
+ gtk_tree_view_unset_rows_drag_source(Xen_to_C_GtkTreeView_(tree_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_iter_n_children(XEN tree_model, XEN iter)
+static Xen gxg_gtk_tree_view_unset_rows_drag_dest(Xen tree_view)
{
- #define H_gtk_tree_model_iter_n_children "gint gtk_tree_model_iter_n_children(GtkTreeModel* tree_model, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_iter_n_children", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter) || XEN_FALSE_P(iter), iter, 2, "gtk_tree_model_iter_n_children", "GtkTreeIter*");
- return(C_TO_XEN_gint(gtk_tree_model_iter_n_children(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_tree_view_unset_rows_drag_dest "void gtk_tree_view_unset_rows_drag_dest(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_unset_rows_drag_dest", "GtkTreeView*");
+ gtk_tree_view_unset_rows_drag_dest(Xen_to_C_GtkTreeView_(tree_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_iter_nth_child(XEN tree_model, XEN iter, XEN parent, XEN n)
+static Xen gxg_gtk_tree_view_set_drag_dest_row(Xen tree_view, Xen path, Xen pos)
{
- #define H_gtk_tree_model_iter_nth_child "gboolean gtk_tree_model_iter_nth_child(GtkTreeModel* tree_model, \
-GtkTreeIter* iter, GtkTreeIter* parent, gint n)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_iter_nth_child", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_iter_nth_child", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(parent) || XEN_FALSE_P(parent), parent, 3, "gtk_tree_model_iter_nth_child", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(n), n, 4, "gtk_tree_model_iter_nth_child", "gint");
- return(C_TO_XEN_gboolean(gtk_tree_model_iter_nth_child(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter),
- XEN_TO_C_GtkTreeIter_(parent), XEN_TO_C_gint(n))));
+ #define H_gtk_tree_view_set_drag_dest_row "void gtk_tree_view_set_drag_dest_row(GtkTreeView* tree_view, \
+GtkTreePath* path, GtkTreeViewDropPosition pos)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_drag_dest_row", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_set_drag_dest_row", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeViewDropPosition(pos), pos, 3, "gtk_tree_view_set_drag_dest_row", "GtkTreeViewDropPosition");
+ gtk_tree_view_set_drag_dest_row(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeViewDropPosition(pos));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_iter_parent(XEN tree_model, XEN iter, XEN child)
+static Xen gxg_gtk_tree_view_get_drag_dest_row(Xen tree_view, Xen ignore_path, Xen ignore_pos)
{
- #define H_gtk_tree_model_iter_parent "gboolean gtk_tree_model_iter_parent(GtkTreeModel* tree_model, \
-GtkTreeIter* iter, GtkTreeIter* child)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_iter_parent", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_iter_parent", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(child), child, 3, "gtk_tree_model_iter_parent", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_model_iter_parent(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(child))));
+ #define H_gtk_tree_view_get_drag_dest_row "void gtk_tree_view_get_drag_dest_row(GtkTreeView* tree_view, \
+GtkTreePath** [path], GtkTreeViewDropPosition* [pos])"
+ GtkTreePath* ref_path = NULL;
+ GtkTreeViewDropPosition ref_pos;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_drag_dest_row", "GtkTreeView*");
+ gtk_tree_view_get_drag_dest_row(Xen_to_C_GtkTreeView_(tree_view), &ref_path, &ref_pos);
+ return(Xen_list_2(C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkTreeViewDropPosition(ref_pos)));
}
-static XEN gxg_gtk_tree_model_ref_node(XEN tree_model, XEN iter)
+static Xen gxg_gtk_tree_view_get_dest_row_at_pos(Xen tree_view, Xen drag_x, Xen drag_y, Xen ignore_path, Xen ignore_pos)
{
- #define H_gtk_tree_model_ref_node "void gtk_tree_model_ref_node(GtkTreeModel* tree_model, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_ref_node", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_ref_node", "GtkTreeIter*");
- gtk_tree_model_ref_node(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_dest_row_at_pos "gboolean gtk_tree_view_get_dest_row_at_pos(GtkTreeView* tree_view, \
+gint drag_x, gint drag_y, GtkTreePath** [path], GtkTreeViewDropPosition* [pos])"
+ GtkTreePath* ref_path = NULL;
+ GtkTreeViewDropPosition ref_pos;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_dest_row_at_pos", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(drag_x), drag_x, 2, "gtk_tree_view_get_dest_row_at_pos", "gint");
+ Xen_check_type(Xen_is_gint(drag_y), drag_y, 3, "gtk_tree_view_get_dest_row_at_pos", "gint");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_tree_view_get_dest_row_at_pos(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(drag_x),
+ Xen_to_C_gint(drag_y), &ref_path, &ref_pos));
+ return(Xen_list_3(result, C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkTreeViewDropPosition(ref_pos)));
+ }
}
-static XEN gxg_gtk_tree_model_unref_node(XEN tree_model, XEN iter)
+static Xen gxg_gtk_tree_view_set_enable_search(Xen tree_view, Xen enable_search)
{
- #define H_gtk_tree_model_unref_node "void gtk_tree_model_unref_node(GtkTreeModel* tree_model, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_unref_node", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_unref_node", "GtkTreeIter*");
- gtk_tree_model_unref_node(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_enable_search "void gtk_tree_view_set_enable_search(GtkTreeView* tree_view, \
+gboolean enable_search)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_enable_search", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(enable_search), enable_search, 2, "gtk_tree_view_set_enable_search", "gboolean");
+ gtk_tree_view_set_enable_search(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(enable_search));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_foreach(XEN model, XEN func, XEN func_info)
+static Xen gxg_gtk_tree_view_get_enable_search(Xen tree_view)
{
- #define H_gtk_tree_model_foreach "void gtk_tree_model_foreach(GtkTreeModel* model, GtkTreeModelForeachFunc func, \
-lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model), model, 1, "gtk_tree_model_foreach", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModelForeachFunc_P(func), func, 2, "gtk_tree_model_foreach", "GtkTreeModelForeachFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_model_foreach", "lambda_data");
- {
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_tree_model_foreach(XEN_TO_C_GtkTreeModel_(model), XEN_TO_C_GtkTreeModelForeachFunc(func), XEN_TO_C_lambda_data(func_info));
- xm_unprotect_at(loc);
- return(XEN_FALSE);
- }
+ #define H_gtk_tree_view_get_enable_search "gboolean gtk_tree_view_get_enable_search(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_enable_search", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_enable_search(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_model_row_changed(XEN tree_model, XEN path, XEN iter)
+static Xen gxg_gtk_tree_view_get_search_column(Xen tree_view)
{
- #define H_gtk_tree_model_row_changed "void gtk_tree_model_row_changed(GtkTreeModel* tree_model, GtkTreePath* path, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_row_changed", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_model_row_changed", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 3, "gtk_tree_model_row_changed", "GtkTreeIter*");
- gtk_tree_model_row_changed(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_search_column "gint gtk_tree_view_get_search_column(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_search_column", "GtkTreeView*");
+ return(C_to_Xen_gint(gtk_tree_view_get_search_column(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_model_row_inserted(XEN tree_model, XEN path, XEN iter)
+static Xen gxg_gtk_tree_view_set_search_column(Xen tree_view, Xen column)
{
- #define H_gtk_tree_model_row_inserted "void gtk_tree_model_row_inserted(GtkTreeModel* tree_model, GtkTreePath* path, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_row_inserted", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_model_row_inserted", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 3, "gtk_tree_model_row_inserted", "GtkTreeIter*");
- gtk_tree_model_row_inserted(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_search_column "void gtk_tree_view_set_search_column(GtkTreeView* tree_view, \
+gint column)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_search_column", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(column), column, 2, "gtk_tree_view_set_search_column", "gint");
+ gtk_tree_view_set_search_column(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_row_has_child_toggled(XEN tree_model, XEN path, XEN iter)
+static Xen gxg_gtk_tree_view_get_search_equal_func(Xen tree_view)
{
- #define H_gtk_tree_model_row_has_child_toggled "void gtk_tree_model_row_has_child_toggled(GtkTreeModel* tree_model, \
-GtkTreePath* path, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_row_has_child_toggled", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_model_row_has_child_toggled", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 3, "gtk_tree_model_row_has_child_toggled", "GtkTreeIter*");
- gtk_tree_model_row_has_child_toggled(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_search_equal_func "GtkTreeViewSearchEqualFunc gtk_tree_view_get_search_equal_func(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_search_equal_func", "GtkTreeView*");
+ return(C_to_Xen_GtkTreeViewSearchEqualFunc(gtk_tree_view_get_search_equal_func(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_tree_model_row_deleted(XEN tree_model, XEN path)
+static Xen gxg_gtk_tree_view_set_search_equal_func(Xen tree_view, Xen func, Xen func_info, Xen search_destroy)
{
- #define H_gtk_tree_model_row_deleted "void gtk_tree_model_row_deleted(GtkTreeModel* tree_model, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_row_deleted", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_model_row_deleted", "GtkTreePath*");
- gtk_tree_model_row_deleted(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_search_equal_func "void gtk_tree_view_set_search_equal_func(GtkTreeView* tree_view, \
+GtkTreeViewSearchEqualFunc func, lambda_data func_info, GtkDestroyNotify search_destroy)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_search_equal_func", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewSearchEqualFunc(func), func, 2, "gtk_tree_view_set_search_equal_func", "GtkTreeViewSearchEqualFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_view_set_search_equal_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(search_destroy), search_destroy, 4, "gtk_tree_view_set_search_equal_func", "GtkDestroyNotify");
+ {
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ Xen_list_set(gxg_ptr, 3, search_destroy);
+ gtk_tree_view_set_search_equal_func(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewSearchEqualFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GtkDestroyNotify(search_destroy));
+ xm_unprotect_at(loc);
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_tree_model_rows_reordered(XEN tree_model, XEN path, XEN iter, XEN new_order)
+static Xen gxg_gtk_viewport_new(Xen hadjustment, Xen vadjustment)
{
- #define H_gtk_tree_model_rows_reordered "void gtk_tree_model_rows_reordered(GtkTreeModel* tree_model, \
-GtkTreePath* path, GtkTreeIter* iter, gint* new_order)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_rows_reordered", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_model_rows_reordered", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 3, "gtk_tree_model_rows_reordered", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gint__P(new_order), new_order, 4, "gtk_tree_model_rows_reordered", "gint*");
- gtk_tree_model_rows_reordered(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeIter_(iter),
- XEN_TO_C_gint_(new_order));
- return(XEN_FALSE);
+ #define H_gtk_viewport_new "GtkWidget* gtk_viewport_new(GtkAdjustment* hadjustment, GtkAdjustment* vadjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(hadjustment) || Xen_is_false(hadjustment), hadjustment, 1, "gtk_viewport_new", "GtkAdjustment*");
+ Xen_check_type(Xen_is_GtkAdjustment_(vadjustment) || Xen_is_false(vadjustment), vadjustment, 2, "gtk_viewport_new", "GtkAdjustment*");
+ return(C_to_Xen_GtkWidget_(gtk_viewport_new(Xen_to_C_GtkAdjustment_(hadjustment), Xen_to_C_GtkAdjustment_(vadjustment))));
}
-static XEN gxg_gtk_tree_model_sort_new_with_model(XEN child_model)
+static Xen gxg_gtk_viewport_set_shadow_type(Xen viewport, Xen type)
{
- #define H_gtk_tree_model_sort_new_with_model "GtkTreeModel* gtk_tree_model_sort_new_with_model(GtkTreeModel* child_model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(child_model), child_model, 1, "gtk_tree_model_sort_new_with_model", "GtkTreeModel*");
- return(C_TO_XEN_GtkTreeModel_(gtk_tree_model_sort_new_with_model(XEN_TO_C_GtkTreeModel_(child_model))));
+ #define H_gtk_viewport_set_shadow_type "void gtk_viewport_set_shadow_type(GtkViewport* viewport, GtkShadowType type)"
+ Xen_check_type(Xen_is_GtkViewport_(viewport), viewport, 1, "gtk_viewport_set_shadow_type", "GtkViewport*");
+ Xen_check_type(Xen_is_GtkShadowType(type), type, 2, "gtk_viewport_set_shadow_type", "GtkShadowType");
+ gtk_viewport_set_shadow_type(Xen_to_C_GtkViewport_(viewport), Xen_to_C_GtkShadowType(type));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_sort_get_model(XEN tree_model)
+static Xen gxg_gtk_viewport_get_shadow_type(Xen viewport)
{
- #define H_gtk_tree_model_sort_get_model "GtkTreeModel* gtk_tree_model_sort_get_model(GtkTreeModelSort* tree_model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelSort__P(tree_model), tree_model, 1, "gtk_tree_model_sort_get_model", "GtkTreeModelSort*");
- return(C_TO_XEN_GtkTreeModel_(gtk_tree_model_sort_get_model(XEN_TO_C_GtkTreeModelSort_(tree_model))));
+ #define H_gtk_viewport_get_shadow_type "GtkShadowType gtk_viewport_get_shadow_type(GtkViewport* viewport)"
+ Xen_check_type(Xen_is_GtkViewport_(viewport), viewport, 1, "gtk_viewport_get_shadow_type", "GtkViewport*");
+ return(C_to_Xen_GtkShadowType(gtk_viewport_get_shadow_type(Xen_to_C_GtkViewport_(viewport))));
}
-static XEN gxg_gtk_tree_model_sort_convert_child_path_to_path(XEN tree_model_sort, XEN child_path)
+static Xen gxg_gtk_widget_destroy(Xen widget)
{
- #define H_gtk_tree_model_sort_convert_child_path_to_path "GtkTreePath* gtk_tree_model_sort_convert_child_path_to_path(GtkTreeModelSort* tree_model_sort, \
-GtkTreePath* child_path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelSort__P(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_convert_child_path_to_path", "GtkTreeModelSort*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(child_path), child_path, 2, "gtk_tree_model_sort_convert_child_path_to_path", "GtkTreePath*");
- return(C_TO_XEN_GtkTreePath_(gtk_tree_model_sort_convert_child_path_to_path(XEN_TO_C_GtkTreeModelSort_(tree_model_sort),
- XEN_TO_C_GtkTreePath_(child_path))));
+ #define H_gtk_widget_destroy "void gtk_widget_destroy(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_destroy", "GtkWidget*");
+ gtk_widget_destroy(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_sort_convert_child_iter_to_iter(XEN tree_model_sort, XEN sort_iter, XEN child_iter)
+static Xen gxg_gtk_widget_destroyed(Xen widget, Xen ignore_widget_pointer)
{
- #define H_gtk_tree_model_sort_convert_child_iter_to_iter "void gtk_tree_model_sort_convert_child_iter_to_iter(GtkTreeModelSort* tree_model_sort, \
-GtkTreeIter* sort_iter, GtkTreeIter* child_iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelSort__P(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_convert_child_iter_to_iter", "GtkTreeModelSort*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(sort_iter), sort_iter, 2, "gtk_tree_model_sort_convert_child_iter_to_iter", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(child_iter), child_iter, 3, "gtk_tree_model_sort_convert_child_iter_to_iter", "GtkTreeIter*");
- gtk_tree_model_sort_convert_child_iter_to_iter(XEN_TO_C_GtkTreeModelSort_(tree_model_sort), XEN_TO_C_GtkTreeIter_(sort_iter),
- XEN_TO_C_GtkTreeIter_(child_iter));
- return(XEN_FALSE);
+ #define H_gtk_widget_destroyed "void gtk_widget_destroyed(GtkWidget* widget, GtkWidget** [widget_pointer])"
+ GtkWidget* ref_widget_pointer = NULL;
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_destroyed", "GtkWidget*");
+ gtk_widget_destroyed(Xen_to_C_GtkWidget_(widget), &ref_widget_pointer);
+ return(Xen_list_1(C_to_Xen_GtkWidget_(ref_widget_pointer)));
}
-static XEN gxg_gtk_tree_model_sort_convert_path_to_child_path(XEN tree_model_sort, XEN sorted_path)
+static Xen gxg_gtk_widget_unparent(Xen widget)
{
- #define H_gtk_tree_model_sort_convert_path_to_child_path "GtkTreePath* gtk_tree_model_sort_convert_path_to_child_path(GtkTreeModelSort* tree_model_sort, \
-GtkTreePath* sorted_path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelSort__P(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_convert_path_to_child_path", "GtkTreeModelSort*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(sorted_path), sorted_path, 2, "gtk_tree_model_sort_convert_path_to_child_path", "GtkTreePath*");
- return(C_TO_XEN_GtkTreePath_(gtk_tree_model_sort_convert_path_to_child_path(XEN_TO_C_GtkTreeModelSort_(tree_model_sort),
- XEN_TO_C_GtkTreePath_(sorted_path))));
+ #define H_gtk_widget_unparent "void gtk_widget_unparent(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_unparent", "GtkWidget*");
+ gtk_widget_unparent(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_sort_convert_iter_to_child_iter(XEN tree_model_sort, XEN child_iter, XEN sorted_iter)
+static Xen gxg_gtk_widget_show(Xen widget)
{
- #define H_gtk_tree_model_sort_convert_iter_to_child_iter "void gtk_tree_model_sort_convert_iter_to_child_iter(GtkTreeModelSort* tree_model_sort, \
-GtkTreeIter* child_iter, GtkTreeIter* sorted_iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelSort__P(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_convert_iter_to_child_iter", "GtkTreeModelSort*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(child_iter), child_iter, 2, "gtk_tree_model_sort_convert_iter_to_child_iter", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(sorted_iter), sorted_iter, 3, "gtk_tree_model_sort_convert_iter_to_child_iter", "GtkTreeIter*");
- gtk_tree_model_sort_convert_iter_to_child_iter(XEN_TO_C_GtkTreeModelSort_(tree_model_sort), XEN_TO_C_GtkTreeIter_(child_iter),
- XEN_TO_C_GtkTreeIter_(sorted_iter));
- return(XEN_FALSE);
+ #define H_gtk_widget_show "void gtk_widget_show(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_show", "GtkWidget*");
+ gtk_widget_show(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_sort_reset_default_sort_func(XEN tree_model_sort)
+static Xen gxg_gtk_widget_show_now(Xen widget)
{
- #define H_gtk_tree_model_sort_reset_default_sort_func "void gtk_tree_model_sort_reset_default_sort_func(GtkTreeModelSort* tree_model_sort)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelSort__P(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_reset_default_sort_func", "GtkTreeModelSort*");
- gtk_tree_model_sort_reset_default_sort_func(XEN_TO_C_GtkTreeModelSort_(tree_model_sort));
- return(XEN_FALSE);
+ #define H_gtk_widget_show_now "void gtk_widget_show_now(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_show_now", "GtkWidget*");
+ gtk_widget_show_now(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_sort_clear_cache(XEN tree_model_sort)
+static Xen gxg_gtk_widget_hide(Xen widget)
{
- #define H_gtk_tree_model_sort_clear_cache "void gtk_tree_model_sort_clear_cache(GtkTreeModelSort* tree_model_sort)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelSort__P(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_clear_cache", "GtkTreeModelSort*");
- gtk_tree_model_sort_clear_cache(XEN_TO_C_GtkTreeModelSort_(tree_model_sort));
- return(XEN_FALSE);
+ #define H_gtk_widget_hide "void gtk_widget_hide(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_hide", "GtkWidget*");
+ gtk_widget_hide(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_set_mode(XEN selection, XEN type)
+static Xen gxg_gtk_widget_show_all(Xen widget)
{
- #define H_gtk_tree_selection_set_mode "void gtk_tree_selection_set_mode(GtkTreeSelection* selection, \
-GtkSelectionMode type)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_set_mode", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkSelectionMode_P(type), type, 2, "gtk_tree_selection_set_mode", "GtkSelectionMode");
- gtk_tree_selection_set_mode(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkSelectionMode(type));
- return(XEN_FALSE);
+ #define H_gtk_widget_show_all "void gtk_widget_show_all(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_show_all", "GtkWidget*");
+ gtk_widget_show_all(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_get_mode(XEN selection)
+static Xen gxg_gtk_widget_map(Xen widget)
{
- #define H_gtk_tree_selection_get_mode "GtkSelectionMode gtk_tree_selection_get_mode(GtkTreeSelection* selection)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_get_mode", "GtkTreeSelection*");
- return(C_TO_XEN_GtkSelectionMode(gtk_tree_selection_get_mode(XEN_TO_C_GtkTreeSelection_(selection))));
+ #define H_gtk_widget_map "void gtk_widget_map(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_map", "GtkWidget*");
+ gtk_widget_map(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_set_select_function(XEN selection, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_widget_unmap(Xen widget)
{
- #define H_gtk_tree_selection_set_select_function "void gtk_tree_selection_set_select_function(GtkTreeSelection* selection, \
-GtkTreeSelectionFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_set_select_function", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreeSelectionFunc_P(func), func, 2, "gtk_tree_selection_set_select_function", "GtkTreeSelectionFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_selection_set_select_function", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 4, "gtk_tree_selection_set_select_function", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_tree_selection_set_select_function(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreeSelectionFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GtkDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_unmap "void gtk_widget_unmap(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_unmap", "GtkWidget*");
+ gtk_widget_unmap(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_get_user_data(XEN selection)
+static Xen gxg_gtk_widget_realize(Xen widget)
{
- #define H_gtk_tree_selection_get_user_data "gpointer gtk_tree_selection_get_user_data(GtkTreeSelection* selection)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_get_user_data", "GtkTreeSelection*");
- return(C_TO_XEN_gpointer(gtk_tree_selection_get_user_data(XEN_TO_C_GtkTreeSelection_(selection))));
+ #define H_gtk_widget_realize "void gtk_widget_realize(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_realize", "GtkWidget*");
+ gtk_widget_realize(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_get_tree_view(XEN selection)
+static Xen gxg_gtk_widget_unrealize(Xen widget)
{
- #define H_gtk_tree_selection_get_tree_view "GtkTreeView* gtk_tree_selection_get_tree_view(GtkTreeSelection* selection)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_get_tree_view", "GtkTreeSelection*");
- return(C_TO_XEN_GtkTreeView_(gtk_tree_selection_get_tree_view(XEN_TO_C_GtkTreeSelection_(selection))));
+ #define H_gtk_widget_unrealize "void gtk_widget_unrealize(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_unrealize", "GtkWidget*");
+ gtk_widget_unrealize(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_get_selected(XEN selection, XEN model, XEN iter)
+static Xen gxg_gtk_widget_queue_draw(Xen widget)
{
- #define H_gtk_tree_selection_get_selected "gboolean gtk_tree_selection_get_selected(GtkTreeSelection* selection, \
-GtkTreeModel** model, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_get_selected", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel___P(model), model, 2, "gtk_tree_selection_get_selected", "GtkTreeModel**");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 3, "gtk_tree_selection_get_selected", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_selection_get_selected(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreeModel__(model),
- XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_widget_queue_draw "void gtk_widget_queue_draw(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_queue_draw", "GtkWidget*");
+ gtk_widget_queue_draw(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_selected_foreach(XEN selection, XEN func, XEN func_info)
+static Xen gxg_gtk_widget_queue_draw_area(Xen widget, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gtk_tree_selection_selected_foreach "void gtk_tree_selection_selected_foreach(GtkTreeSelection* selection, \
-GtkTreeSelectionForeachFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_selected_foreach", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreeSelectionForeachFunc_P(func), func, 2, "gtk_tree_selection_selected_foreach", "GtkTreeSelectionForeachFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_selection_selected_foreach", "lambda_data");
- {
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_tree_selection_selected_foreach(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreeSelectionForeachFunc(func), XEN_TO_C_lambda_data(func_info));
- xm_unprotect_at(loc);
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_queue_draw_area "void gtk_widget_queue_draw_area(GtkWidget* widget, gint x, gint y, \
+gint width, gint height)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_queue_draw_area", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_widget_queue_draw_area", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_widget_queue_draw_area", "gint");
+ Xen_check_type(Xen_is_gint(width), width, 4, "gtk_widget_queue_draw_area", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 5, "gtk_widget_queue_draw_area", "gint");
+ gtk_widget_queue_draw_area(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(x), Xen_to_C_gint(y), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_select_path(XEN selection, XEN path)
+static Xen gxg_gtk_widget_queue_resize(Xen widget)
{
- #define H_gtk_tree_selection_select_path "void gtk_tree_selection_select_path(GtkTreeSelection* selection, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_select_path", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_selection_select_path", "GtkTreePath*");
- gtk_tree_selection_select_path(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_widget_queue_resize "void gtk_widget_queue_resize(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_queue_resize", "GtkWidget*");
+ gtk_widget_queue_resize(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_unselect_path(XEN selection, XEN path)
+static Xen gxg_gtk_widget_size_allocate(Xen widget, Xen allocation)
{
- #define H_gtk_tree_selection_unselect_path "void gtk_tree_selection_unselect_path(GtkTreeSelection* selection, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_unselect_path", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_selection_unselect_path", "GtkTreePath*");
- gtk_tree_selection_unselect_path(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_widget_size_allocate "void gtk_widget_size_allocate(GtkWidget* widget, GtkAllocation* allocation)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_size_allocate", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAllocation_(allocation), allocation, 2, "gtk_widget_size_allocate", "GtkAllocation*");
+ gtk_widget_size_allocate(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAllocation_(allocation));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_select_iter(XEN selection, XEN iter)
+static Xen gxg_gtk_widget_add_accelerator(Xen widget, Xen accel_signal, Xen accel_group, Xen accel_key, Xen accel_mods, Xen accel_flags)
{
- #define H_gtk_tree_selection_select_iter "void gtk_tree_selection_select_iter(GtkTreeSelection* selection, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_select_iter", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_selection_select_iter", "GtkTreeIter*");
- gtk_tree_selection_select_iter(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_widget_add_accelerator "void gtk_widget_add_accelerator(GtkWidget* widget, gchar* accel_signal, \
+GtkAccelGroup* accel_group, guint accel_key, GdkModifierType accel_mods, GtkAccelFlags accel_flags)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_add_accelerator", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(accel_signal), accel_signal, 2, "gtk_widget_add_accelerator", "gchar*");
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 3, "gtk_widget_add_accelerator", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 4, "gtk_widget_add_accelerator", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 5, "gtk_widget_add_accelerator", "GdkModifierType");
+ Xen_check_type(Xen_is_GtkAccelFlags(accel_flags), accel_flags, 6, "gtk_widget_add_accelerator", "GtkAccelFlags");
+ gtk_widget_add_accelerator(Xen_to_C_GtkWidget_(widget), Xen_to_C_gchar_(accel_signal), Xen_to_C_GtkAccelGroup_(accel_group),
+ Xen_to_C_guint(accel_key), Xen_to_C_GdkModifierType(accel_mods), Xen_to_C_GtkAccelFlags(accel_flags));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_unselect_iter(XEN selection, XEN iter)
+static Xen gxg_gtk_widget_remove_accelerator(Xen widget, Xen accel_group, Xen accel_key, Xen accel_mods)
{
- #define H_gtk_tree_selection_unselect_iter "void gtk_tree_selection_unselect_iter(GtkTreeSelection* selection, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_unselect_iter", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_selection_unselect_iter", "GtkTreeIter*");
- gtk_tree_selection_unselect_iter(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_widget_remove_accelerator "gboolean gtk_widget_remove_accelerator(GtkWidget* widget, \
+GtkAccelGroup* accel_group, guint accel_key, GdkModifierType accel_mods)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_remove_accelerator", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 2, "gtk_widget_remove_accelerator", "GtkAccelGroup*");
+ Xen_check_type(Xen_is_guint(accel_key), accel_key, 3, "gtk_widget_remove_accelerator", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accel_mods), accel_mods, 4, "gtk_widget_remove_accelerator", "GdkModifierType");
+ return(C_to_Xen_gboolean(gtk_widget_remove_accelerator(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAccelGroup_(accel_group),
+ Xen_to_C_guint(accel_key), Xen_to_C_GdkModifierType(accel_mods))));
}
-static XEN gxg_gtk_tree_selection_path_is_selected(XEN selection, XEN path)
+static Xen gxg_gtk_widget_list_accel_closures(Xen widget)
{
- #define H_gtk_tree_selection_path_is_selected "gboolean gtk_tree_selection_path_is_selected(GtkTreeSelection* selection, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_path_is_selected", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_selection_path_is_selected", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_selection_path_is_selected(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_widget_list_accel_closures "GList* gtk_widget_list_accel_closures(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_list_accel_closures", "GtkWidget*");
+ return(C_to_Xen_GList_(gtk_widget_list_accel_closures(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_selection_iter_is_selected(XEN selection, XEN iter)
+static Xen gxg_gtk_widget_mnemonic_activate(Xen widget, Xen group_cycling)
{
- #define H_gtk_tree_selection_iter_is_selected "gboolean gtk_tree_selection_iter_is_selected(GtkTreeSelection* selection, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_iter_is_selected", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_selection_iter_is_selected", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_selection_iter_is_selected(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_widget_mnemonic_activate "gboolean gtk_widget_mnemonic_activate(GtkWidget* widget, gboolean group_cycling)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_mnemonic_activate", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(group_cycling), group_cycling, 2, "gtk_widget_mnemonic_activate", "gboolean");
+ return(C_to_Xen_gboolean(gtk_widget_mnemonic_activate(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(group_cycling))));
}
-static XEN gxg_gtk_tree_selection_select_all(XEN selection)
+static Xen gxg_gtk_widget_event(Xen widget, Xen event)
{
- #define H_gtk_tree_selection_select_all "void gtk_tree_selection_select_all(GtkTreeSelection* selection)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_select_all", "GtkTreeSelection*");
- gtk_tree_selection_select_all(XEN_TO_C_GtkTreeSelection_(selection));
- return(XEN_FALSE);
+ #define H_gtk_widget_event "gboolean gtk_widget_event(GtkWidget* widget, GdkEvent* event)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_event", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gtk_widget_event", "GdkEvent*");
+ return(C_to_Xen_gboolean(gtk_widget_event(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_tree_selection_unselect_all(XEN selection)
+static Xen gxg_gtk_widget_send_expose(Xen widget, Xen event)
{
- #define H_gtk_tree_selection_unselect_all "void gtk_tree_selection_unselect_all(GtkTreeSelection* selection)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_unselect_all", "GtkTreeSelection*");
- gtk_tree_selection_unselect_all(XEN_TO_C_GtkTreeSelection_(selection));
- return(XEN_FALSE);
+ #define H_gtk_widget_send_expose "gint gtk_widget_send_expose(GtkWidget* widget, GdkEvent* event)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_send_expose", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gtk_widget_send_expose", "GdkEvent*");
+ return(C_to_Xen_gint(gtk_widget_send_expose(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_tree_selection_select_range(XEN selection, XEN start_path, XEN end_path)
+static Xen gxg_gtk_widget_activate(Xen widget)
{
- #define H_gtk_tree_selection_select_range "void gtk_tree_selection_select_range(GtkTreeSelection* selection, \
-GtkTreePath* start_path, GtkTreePath* end_path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_select_range", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(start_path), start_path, 2, "gtk_tree_selection_select_range", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(end_path), end_path, 3, "gtk_tree_selection_select_range", "GtkTreePath*");
- gtk_tree_selection_select_range(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreePath_(start_path), XEN_TO_C_GtkTreePath_(end_path));
- return(XEN_FALSE);
+ #define H_gtk_widget_activate "gboolean gtk_widget_activate(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_activate", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_activate(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_sortable_sort_column_changed(XEN sortable)
+static Xen gxg_gtk_widget_intersect(Xen widget, Xen area, Xen intersection)
{
- #define H_gtk_tree_sortable_sort_column_changed "void gtk_tree_sortable_sort_column_changed(GtkTreeSortable* sortable)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSortable__P(sortable), sortable, 1, "gtk_tree_sortable_sort_column_changed", "GtkTreeSortable*");
- gtk_tree_sortable_sort_column_changed(XEN_TO_C_GtkTreeSortable_(sortable));
- return(XEN_FALSE);
+ #define H_gtk_widget_intersect "gboolean gtk_widget_intersect(GtkWidget* widget, GdkRectangle* area, \
+GdkRectangle* intersection)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_intersect", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkRectangle_(area), area, 2, "gtk_widget_intersect", "GdkRectangle*");
+ Xen_check_type(Xen_is_GdkRectangle_(intersection) || Xen_is_false(intersection), intersection, 3, "gtk_widget_intersect", "GdkRectangle*");
+ return(C_to_Xen_gboolean(gtk_widget_intersect(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkRectangle_(area), Xen_to_C_GdkRectangle_(intersection))));
}
-static XEN gxg_gtk_tree_sortable_get_sort_column_id(XEN sortable, XEN ignore_sort_column_id, XEN ignore_order)
+static Xen gxg_gtk_widget_freeze_child_notify(Xen widget)
{
- #define H_gtk_tree_sortable_get_sort_column_id "gboolean gtk_tree_sortable_get_sort_column_id(GtkTreeSortable* sortable, \
-gint* [sort_column_id], GtkSortType* [order])"
- gint ref_sort_column_id;
- GtkSortType ref_order;
- XEN_ASSERT_TYPE(XEN_GtkTreeSortable__P(sortable), sortable, 1, "gtk_tree_sortable_get_sort_column_id", "GtkTreeSortable*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_tree_sortable_get_sort_column_id(XEN_TO_C_GtkTreeSortable_(sortable), &ref_sort_column_id,
- &ref_order));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_sort_column_id), C_TO_XEN_GtkSortType(ref_order)));
- }
+ #define H_gtk_widget_freeze_child_notify "void gtk_widget_freeze_child_notify(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_freeze_child_notify", "GtkWidget*");
+ gtk_widget_freeze_child_notify(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_sortable_set_sort_column_id(XEN sortable, XEN sort_column_id, XEN order)
+static Xen gxg_gtk_widget_child_notify(Xen widget, Xen child_property)
{
- #define H_gtk_tree_sortable_set_sort_column_id "void gtk_tree_sortable_set_sort_column_id(GtkTreeSortable* sortable, \
-gint sort_column_id, GtkSortType order)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSortable__P(sortable), sortable, 1, "gtk_tree_sortable_set_sort_column_id", "GtkTreeSortable*");
- XEN_ASSERT_TYPE(XEN_gint_P(sort_column_id), sort_column_id, 2, "gtk_tree_sortable_set_sort_column_id", "gint");
- XEN_ASSERT_TYPE(XEN_GtkSortType_P(order), order, 3, "gtk_tree_sortable_set_sort_column_id", "GtkSortType");
- gtk_tree_sortable_set_sort_column_id(XEN_TO_C_GtkTreeSortable_(sortable), XEN_TO_C_gint(sort_column_id), XEN_TO_C_GtkSortType(order));
- return(XEN_FALSE);
+ #define H_gtk_widget_child_notify "void gtk_widget_child_notify(GtkWidget* widget, gchar* child_property)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_child_notify", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(child_property), child_property, 2, "gtk_widget_child_notify", "gchar*");
+ gtk_widget_child_notify(Xen_to_C_GtkWidget_(widget), Xen_to_C_gchar_(child_property));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_sortable_set_sort_func(XEN sortable, XEN sort_column_id, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_widget_thaw_child_notify(Xen widget)
{
- #define H_gtk_tree_sortable_set_sort_func "void gtk_tree_sortable_set_sort_func(GtkTreeSortable* sortable, \
-gint sort_column_id, GtkTreeIterCompareFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSortable__P(sortable), sortable, 1, "gtk_tree_sortable_set_sort_func", "GtkTreeSortable*");
- XEN_ASSERT_TYPE(XEN_gint_P(sort_column_id), sort_column_id, 2, "gtk_tree_sortable_set_sort_func", "gint");
- XEN_ASSERT_TYPE(XEN_GtkTreeIterCompareFunc_P(func), func, 3, "gtk_tree_sortable_set_sort_func", "GtkTreeIterCompareFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gtk_tree_sortable_set_sort_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 5, "gtk_tree_sortable_set_sort_func", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_tree_sortable_set_sort_func(XEN_TO_C_GtkTreeSortable_(sortable), XEN_TO_C_gint(sort_column_id), XEN_TO_C_GtkTreeIterCompareFunc(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_thaw_child_notify "void gtk_widget_thaw_child_notify(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_thaw_child_notify", "GtkWidget*");
+ gtk_widget_thaw_child_notify(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_sortable_set_default_sort_func(XEN sortable, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_widget_is_focus(Xen widget)
{
- #define H_gtk_tree_sortable_set_default_sort_func "void gtk_tree_sortable_set_default_sort_func(GtkTreeSortable* sortable, \
-GtkTreeIterCompareFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSortable__P(sortable), sortable, 1, "gtk_tree_sortable_set_default_sort_func", "GtkTreeSortable*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIterCompareFunc_P(func), func, 2, "gtk_tree_sortable_set_default_sort_func", "GtkTreeIterCompareFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_sortable_set_default_sort_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 4, "gtk_tree_sortable_set_default_sort_func", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_tree_sortable_set_default_sort_func(XEN_TO_C_GtkTreeSortable_(sortable), XEN_TO_C_GtkTreeIterCompareFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GtkDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_is_focus "gboolean gtk_widget_is_focus(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_is_focus", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_is_focus(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_sortable_has_default_sort_func(XEN sortable)
+static Xen gxg_gtk_widget_grab_focus(Xen widget)
{
- #define H_gtk_tree_sortable_has_default_sort_func "gboolean gtk_tree_sortable_has_default_sort_func(GtkTreeSortable* sortable)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSortable__P(sortable), sortable, 1, "gtk_tree_sortable_has_default_sort_func", "GtkTreeSortable*");
- return(C_TO_XEN_gboolean(gtk_tree_sortable_has_default_sort_func(XEN_TO_C_GtkTreeSortable_(sortable))));
+ #define H_gtk_widget_grab_focus "void gtk_widget_grab_focus(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_grab_focus", "GtkWidget*");
+ gtk_widget_grab_focus(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_new(XEN n_columns, XEN types)
+static Xen gxg_gtk_widget_grab_default(Xen widget)
{
- #define H_gtk_tree_store_new "GtkTreeStore* gtk_tree_store_new(gint n_columns, etc types)"
- XEN_ASSERT_TYPE(XEN_gint_P(n_columns), n_columns, 1, "gtk_tree_store_new", "gint");
- XEN_ASSERT_TYPE(XEN_etc_P(types), types, 2, "gtk_tree_store_new", "etc");
- {
- int etc_len = 0;
- GtkTreeStore* result = NULL;
- gint p_arg0;
- if (XEN_LIST_P(types)) etc_len = XEN_LIST_LENGTH(types);
- if (etc_len < 1) XEN_OUT_OF_RANGE_ERROR("gtk_tree_store_new", 1, types, "... list must have at least 1 entry");
- if (etc_len > 6) XEN_OUT_OF_RANGE_ERROR("gtk_tree_store_new", 1, types, "... list too long (max len: 6)");
- p_arg0 = XEN_TO_C_gint(n_columns);
- switch (etc_len)
- {
- case 1: result = gtk_tree_store_new(p_arg0, XLG(types, 0)); break;
- case 2: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1)); break;
- case 3: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2)); break;
- case 4: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3)); break;
- case 5: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3), XLG(types, 4)); break;
- case 6: result = gtk_tree_store_new(p_arg0, XLG(types, 0), XLG(types, 1), XLG(types, 2), XLG(types, 3), XLG(types, 4), XLG(types, 5)); break;
- }
- return(C_TO_XEN_GtkTreeStore_(result));
- }
+ #define H_gtk_widget_grab_default "void gtk_widget_grab_default(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_grab_default", "GtkWidget*");
+ gtk_widget_grab_default(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_newv(XEN n_columns, XEN types)
+static Xen gxg_gtk_widget_set_name(Xen widget, Xen name)
{
- #define H_gtk_tree_store_newv "GtkTreeStore* gtk_tree_store_newv(gint n_columns, GType* types)"
- XEN_ASSERT_TYPE(XEN_gint_P(n_columns), n_columns, 1, "gtk_tree_store_newv", "gint");
- XEN_ASSERT_TYPE(XEN_GType__P(types), types, 2, "gtk_tree_store_newv", "GType*");
- return(C_TO_XEN_GtkTreeStore_(gtk_tree_store_newv(XEN_TO_C_gint(n_columns), XEN_TO_C_GType_(types))));
+ #define H_gtk_widget_set_name "void gtk_widget_set_name(GtkWidget* widget, gchar* name)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_name", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_widget_set_name", "gchar*");
+ gtk_widget_set_name(Xen_to_C_GtkWidget_(widget), Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_set_column_types(XEN tree_store, XEN n_columns, XEN types)
+static Xen gxg_gtk_widget_get_name(Xen widget)
{
- #define H_gtk_tree_store_set_column_types "void gtk_tree_store_set_column_types(GtkTreeStore* tree_store, \
-gint n_columns, GType* types)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_set_column_types", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_columns), n_columns, 2, "gtk_tree_store_set_column_types", "gint");
- XEN_ASSERT_TYPE(XEN_GType__P(types), types, 3, "gtk_tree_store_set_column_types", "GType*");
- gtk_tree_store_set_column_types(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_gint(n_columns), XEN_TO_C_GType_(types));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_name "gchar* gtk_widget_get_name(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_name", "GtkWidget*");
+ return(C_to_Xen_gchar_(gtk_widget_get_name(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_store_set(XEN tree_store, XEN iter, XEN values)
+static Xen gxg_gtk_widget_set_sensitive(Xen widget, Xen sensitive)
{
- #define H_gtk_tree_store_set "void gtk_tree_store_set(GtkTreeStore* tree_store, GtkTreeIter* iter, \
-etc values)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_set", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_set", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_etc_P(values), values, 3, "gtk_tree_store_set", "etc");
- {
- int etc_len = 0;
- GtkTreeStore* p_arg0;
- GtkTreeIter* p_arg1;
- if (XEN_LIST_P(values)) etc_len = XEN_LIST_LENGTH(values);
- if (etc_len < 2) XEN_OUT_OF_RANGE_ERROR("gtk_tree_store_set", 2, values, "... list must have at least 2 entries");
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_tree_store_set", 2, values, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_tree_store_set", 2, values, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_GtkTreeStore_(tree_store);
- p_arg1 = XEN_TO_C_GtkTreeIter_(iter);
- switch (etc_len)
- {
- case 2: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), -1); break;
- case 4: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), -1); break;
- case 6: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), -1); break;
- case 8: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), XLI(values, 6), XLS(values, 7), -1); break;
- case 10: gtk_tree_store_set(p_arg0, p_arg1, XLI(values, 0), XLS(values, 1), XLI(values, 2), XLS(values, 3), XLI(values, 4), XLS(values, 5), XLI(values, 6), XLS(values, 7), XLI(values, 8), XLS(values, 9), -1); break;
- }
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_set_sensitive "void gtk_widget_set_sensitive(GtkWidget* widget, gboolean sensitive)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_sensitive", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(sensitive), sensitive, 2, "gtk_widget_set_sensitive", "gboolean");
+ gtk_widget_set_sensitive(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(sensitive));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_remove(XEN tree_store, XEN iter)
+static Xen gxg_gtk_widget_set_app_paintable(Xen widget, Xen app_paintable)
{
- #define H_gtk_tree_store_remove "void gtk_tree_store_remove(GtkTreeStore* tree_store, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_remove", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_remove", "GtkTreeIter*");
- gtk_tree_store_remove(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_app_paintable "void gtk_widget_set_app_paintable(GtkWidget* widget, gboolean app_paintable)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_app_paintable", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(app_paintable), app_paintable, 2, "gtk_widget_set_app_paintable", "gboolean");
+ gtk_widget_set_app_paintable(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(app_paintable));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_insert(XEN tree_store, XEN iter, XEN parent, XEN position)
+static Xen gxg_gtk_widget_set_redraw_on_allocate(Xen widget, Xen redraw_on_allocate)
{
- #define H_gtk_tree_store_insert "void gtk_tree_store_insert(GtkTreeStore* tree_store, GtkTreeIter* iter, \
-GtkTreeIter* parent, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_insert", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_insert", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(parent) || XEN_FALSE_P(parent), parent, 3, "gtk_tree_store_insert", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 4, "gtk_tree_store_insert", "gint");
- gtk_tree_store_insert(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(parent), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_redraw_on_allocate "void gtk_widget_set_redraw_on_allocate(GtkWidget* widget, \
+gboolean redraw_on_allocate)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_redraw_on_allocate", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(redraw_on_allocate), redraw_on_allocate, 2, "gtk_widget_set_redraw_on_allocate", "gboolean");
+ gtk_widget_set_redraw_on_allocate(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(redraw_on_allocate));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_insert_before(XEN tree_store, XEN iter, XEN parent, XEN sibling)
+static Xen gxg_gtk_widget_set_parent(Xen widget, Xen parent)
{
- #define H_gtk_tree_store_insert_before "void gtk_tree_store_insert_before(GtkTreeStore* tree_store, \
-GtkTreeIter* iter, GtkTreeIter* parent, GtkTreeIter* sibling)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_insert_before", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_insert_before", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(parent) || XEN_FALSE_P(parent), parent, 3, "gtk_tree_store_insert_before", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(sibling) || XEN_FALSE_P(sibling), sibling, 4, "gtk_tree_store_insert_before", "GtkTreeIter*");
- gtk_tree_store_insert_before(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(parent),
- XEN_TO_C_GtkTreeIter_(sibling));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_parent "void gtk_widget_set_parent(GtkWidget* widget, GtkWidget* parent)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_parent", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(parent), parent, 2, "gtk_widget_set_parent", "GtkWidget*");
+ gtk_widget_set_parent(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkWidget_(parent));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_insert_after(XEN tree_store, XEN iter, XEN parent, XEN sibling)
+static Xen gxg_gtk_widget_set_parent_window(Xen widget, Xen parent_window)
{
- #define H_gtk_tree_store_insert_after "void gtk_tree_store_insert_after(GtkTreeStore* tree_store, GtkTreeIter* iter, \
-GtkTreeIter* parent, GtkTreeIter* sibling)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_insert_after", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_insert_after", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(parent) || XEN_FALSE_P(parent), parent, 3, "gtk_tree_store_insert_after", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(sibling) || XEN_FALSE_P(sibling), sibling, 4, "gtk_tree_store_insert_after", "GtkTreeIter*");
- gtk_tree_store_insert_after(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(parent),
- XEN_TO_C_GtkTreeIter_(sibling));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_parent_window "void gtk_widget_set_parent_window(GtkWidget* widget, GdkWindow* parent_window)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_parent_window", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkWindow_(parent_window), parent_window, 2, "gtk_widget_set_parent_window", "GdkWindow*");
+ gtk_widget_set_parent_window(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkWindow_(parent_window));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_prepend(XEN tree_store, XEN iter, XEN parent)
+static Xen gxg_gtk_widget_set_child_visible(Xen widget, Xen is_visible)
{
- #define H_gtk_tree_store_prepend "void gtk_tree_store_prepend(GtkTreeStore* tree_store, GtkTreeIter* iter, \
-GtkTreeIter* parent)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_prepend", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_prepend", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(parent) || XEN_FALSE_P(parent), parent, 3, "gtk_tree_store_prepend", "GtkTreeIter*");
- gtk_tree_store_prepend(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(parent));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_child_visible "void gtk_widget_set_child_visible(GtkWidget* widget, gboolean is_visible)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_child_visible", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(is_visible), is_visible, 2, "gtk_widget_set_child_visible", "gboolean");
+ gtk_widget_set_child_visible(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(is_visible));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_append(XEN tree_store, XEN iter, XEN parent)
+static Xen gxg_gtk_widget_set_accel_path(Xen widget, Xen accel_path, Xen accel_group)
{
- #define H_gtk_tree_store_append "void gtk_tree_store_append(GtkTreeStore* tree_store, GtkTreeIter* iter, \
-GtkTreeIter* parent)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_append", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_append", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(parent) || XEN_FALSE_P(parent), parent, 3, "gtk_tree_store_append", "GtkTreeIter*");
- gtk_tree_store_append(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(parent));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_accel_path "void gtk_widget_set_accel_path(GtkWidget* widget, gchar* accel_path, \
+GtkAccelGroup* accel_group)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_accel_path", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 2, "gtk_widget_set_accel_path", "gchar*");
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 3, "gtk_widget_set_accel_path", "GtkAccelGroup*");
+ gtk_widget_set_accel_path(Xen_to_C_GtkWidget_(widget), Xen_to_C_gchar_(accel_path), Xen_to_C_GtkAccelGroup_(accel_group));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_store_is_ancestor(XEN tree_store, XEN iter, XEN descendant)
+static Xen gxg_gtk_widget_get_child_visible(Xen widget)
{
- #define H_gtk_tree_store_is_ancestor "gboolean gtk_tree_store_is_ancestor(GtkTreeStore* tree_store, \
-GtkTreeIter* iter, GtkTreeIter* descendant)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_is_ancestor", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_is_ancestor", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(descendant), descendant, 3, "gtk_tree_store_is_ancestor", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_store_is_ancestor(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(descendant))));
+ #define H_gtk_widget_get_child_visible "gboolean gtk_widget_get_child_visible(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_child_visible", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_child_visible(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_store_iter_depth(XEN tree_store, XEN iter)
+static Xen gxg_gtk_widget_get_parent(Xen widget)
{
- #define H_gtk_tree_store_iter_depth "gint gtk_tree_store_iter_depth(GtkTreeStore* tree_store, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_iter_depth", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_store_iter_depth", "GtkTreeIter*");
- return(C_TO_XEN_gint(gtk_tree_store_iter_depth(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_widget_get_parent "GtkWidget* gtk_widget_get_parent(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_parent", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_widget_get_parent(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_store_clear(XEN tree_store)
+static Xen gxg_gtk_widget_get_parent_window(Xen widget)
{
- #define H_gtk_tree_store_clear "void gtk_tree_store_clear(GtkTreeStore* tree_store)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_clear", "GtkTreeStore*");
- gtk_tree_store_clear(XEN_TO_C_GtkTreeStore_(tree_store));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_parent_window "GdkWindow* gtk_widget_get_parent_window(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_parent_window", "GtkWidget*");
+ return(C_to_Xen_GdkWindow_(gtk_widget_get_parent_window(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_new(void)
+static Xen gxg_gtk_widget_child_focus(Xen widget, Xen direction)
{
- #define H_gtk_tree_view_column_new "GtkTreeViewColumn* gtk_tree_view_column_new( void)"
- return(C_TO_XEN_GtkTreeViewColumn_(gtk_tree_view_column_new()));
+ #define H_gtk_widget_child_focus "gboolean gtk_widget_child_focus(GtkWidget* widget, GtkDirectionType direction)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_child_focus", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkDirectionType(direction), direction, 2, "gtk_widget_child_focus", "GtkDirectionType");
+ return(C_to_Xen_gboolean(gtk_widget_child_focus(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkDirectionType(direction))));
}
-static XEN gxg_gtk_tree_view_column_new_with_attributes(XEN title, XEN cell, XEN attributes)
+static Xen gxg_gtk_widget_set_size_request(Xen widget, Xen width, Xen height)
{
- #define H_gtk_tree_view_column_new_with_attributes "GtkTreeViewColumn* gtk_tree_view_column_new_with_attributes(gchar* title, \
-GtkCellRenderer* cell, etc attributes)"
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 1, "gtk_tree_view_column_new_with_attributes", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_tree_view_column_new_with_attributes", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_etc_P(attributes), attributes, 3, "gtk_tree_view_column_new_with_attributes", "etc");
- {
- int etc_len = 0;
- GtkTreeViewColumn* result = NULL;
- gchar* p_arg0;
- GtkCellRenderer* p_arg1;
- if (XEN_LIST_P(attributes)) etc_len = XEN_LIST_LENGTH(attributes);
- if (etc_len < 2) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_column_new_with_attributes", 2, attributes, "... list must have at least 2 entries");
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_column_new_with_attributes", 2, attributes, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_column_new_with_attributes", 2, attributes, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_gchar_(title);
- p_arg1 = XEN_TO_C_GtkCellRenderer_(cell);
- switch (etc_len)
- {
- case 2: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), NULL); break;
- case 4: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), NULL); break;
- case 6: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), NULL); break;
- case 8: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), NULL); break;
- case 10: result = gtk_tree_view_column_new_with_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), XLS(attributes, 8), XLI(attributes, 9), NULL); break;
- }
- return(C_TO_XEN_GtkTreeViewColumn_(result));
- }
+ #define H_gtk_widget_set_size_request "void gtk_widget_set_size_request(GtkWidget* widget, gint width, \
+gint height)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_size_request", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_widget_set_size_request", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 3, "gtk_widget_set_size_request", "gint");
+ gtk_widget_set_size_request(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_pack_start(XEN tree_column, XEN cell, XEN expand)
+static Xen gxg_gtk_widget_get_size_request(Xen widget, Xen ignore_width, Xen ignore_height)
{
- #define H_gtk_tree_view_column_pack_start "void gtk_tree_view_column_pack_start(GtkTreeViewColumn* tree_column, \
-GtkCellRenderer* cell, gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_pack_start", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_tree_view_column_pack_start", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 3, "gtk_tree_view_column_pack_start", "gboolean");
- gtk_tree_view_column_pack_start(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_size_request "void gtk_widget_get_size_request(GtkWidget* widget, gint* [width], \
+gint* [height])"
+ gint ref_width;
+ gint ref_height;
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_size_request", "GtkWidget*");
+ gtk_widget_get_size_request(Xen_to_C_GtkWidget_(widget), &ref_width, &ref_height);
+ return(Xen_list_2(C_to_Xen_gint(ref_width), C_to_Xen_gint(ref_height)));
}
-static XEN gxg_gtk_tree_view_column_pack_end(XEN tree_column, XEN cell, XEN expand)
+static Xen gxg_gtk_widget_set_events(Xen widget, Xen events)
{
- #define H_gtk_tree_view_column_pack_end "void gtk_tree_view_column_pack_end(GtkTreeViewColumn* tree_column, \
-GtkCellRenderer* cell, gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_pack_end", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_tree_view_column_pack_end", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 3, "gtk_tree_view_column_pack_end", "gboolean");
- gtk_tree_view_column_pack_end(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_events "void gtk_widget_set_events(GtkWidget* widget, gint events)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_events", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(events), events, 2, "gtk_widget_set_events", "gint");
+ gtk_widget_set_events(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(events));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_clear(XEN tree_column)
+static Xen gxg_gtk_widget_add_events(Xen widget, Xen events)
{
- #define H_gtk_tree_view_column_clear "void gtk_tree_view_column_clear(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_clear", "GtkTreeViewColumn*");
- gtk_tree_view_column_clear(XEN_TO_C_GtkTreeViewColumn_(tree_column));
- return(XEN_FALSE);
+ #define H_gtk_widget_add_events "void gtk_widget_add_events(GtkWidget* widget, gint events)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_add_events", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(events), events, 2, "gtk_widget_add_events", "gint");
+ gtk_widget_add_events(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(events));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_add_attribute(XEN tree_column, XEN cell_renderer, XEN attribute, XEN column)
+static Xen gxg_gtk_widget_get_toplevel(Xen widget)
{
- #define H_gtk_tree_view_column_add_attribute "void gtk_tree_view_column_add_attribute(GtkTreeViewColumn* tree_column, \
-GtkCellRenderer* cell_renderer, gchar* attribute, gint column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_add_attribute", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_add_attribute", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(attribute), attribute, 3, "gtk_tree_view_column_add_attribute", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 4, "gtk_tree_view_column_add_attribute", "gint");
- gtk_tree_view_column_add_attribute(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkCellRenderer_(cell_renderer),
- XEN_TO_C_gchar_(attribute), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_toplevel "GtkWidget* gtk_widget_get_toplevel(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_toplevel", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_widget_get_toplevel(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_set_attributes(XEN tree_column, XEN cell_renderer, XEN attributes)
+static Xen gxg_gtk_widget_get_ancestor(Xen widget, Xen widget_type)
{
- #define H_gtk_tree_view_column_set_attributes "void gtk_tree_view_column_set_attributes(GtkTreeViewColumn* tree_column, \
-GtkCellRenderer* cell_renderer, etc attributes)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_attributes", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_set_attributes", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_etc_P(attributes), attributes, 3, "gtk_tree_view_column_set_attributes", "etc");
- {
- int etc_len = 0;
- GtkTreeViewColumn* p_arg0;
- GtkCellRenderer* p_arg1;
- if (XEN_LIST_P(attributes)) etc_len = XEN_LIST_LENGTH(attributes);
- if (etc_len < 2) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_column_set_attributes", 2, attributes, "... list must have at least 2 entries");
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_column_set_attributes", 2, attributes, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_column_set_attributes", 2, attributes, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_GtkTreeViewColumn_(tree_column);
- p_arg1 = XEN_TO_C_GtkCellRenderer_(cell_renderer);
- switch (etc_len)
- {
- case 2: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), NULL); break;
- case 4: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), NULL); break;
- case 6: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), NULL); break;
- case 8: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), NULL); break;
- case 10: gtk_tree_view_column_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), XLS(attributes, 8), XLI(attributes, 9), NULL); break;
- }
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_get_ancestor "GtkWidget* gtk_widget_get_ancestor(GtkWidget* widget, GType widget_type)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_ancestor", "GtkWidget*");
+ Xen_check_type(Xen_is_GType(widget_type), widget_type, 2, "gtk_widget_get_ancestor", "GType");
+ return(C_to_Xen_GtkWidget_(gtk_widget_get_ancestor(Xen_to_C_GtkWidget_(widget), Xen_to_C_GType(widget_type))));
}
-static XEN gxg_gtk_tree_view_column_set_cell_data_func(XEN tree_column, XEN cell_renderer, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_widget_get_visual(Xen widget)
{
- #define H_gtk_tree_view_column_set_cell_data_func "void gtk_tree_view_column_set_cell_data_func(GtkTreeViewColumn* tree_column, \
-GtkCellRenderer* cell_renderer, GtkTreeCellDataFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_cell_data_func", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_set_cell_data_func", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GtkTreeCellDataFunc_P(func), func, 3, "gtk_tree_view_column_set_cell_data_func", "GtkTreeCellDataFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gtk_tree_view_column_set_cell_data_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 5, "gtk_tree_view_column_set_cell_data_func", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_tree_view_column_set_cell_data_func(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkCellRenderer_(cell_renderer),
- XEN_TO_C_GtkTreeCellDataFunc(func), XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_get_visual "GdkVisual* gtk_widget_get_visual(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_visual", "GtkWidget*");
+ return(C_to_Xen_GdkVisual_(gtk_widget_get_visual(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_clear_attributes(XEN tree_column, XEN cell_renderer)
+static Xen gxg_gtk_widget_get_settings(Xen widget)
{
- #define H_gtk_tree_view_column_clear_attributes "void gtk_tree_view_column_clear_attributes(GtkTreeViewColumn* tree_column, \
-GtkCellRenderer* cell_renderer)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_clear_attributes", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_clear_attributes", "GtkCellRenderer*");
- gtk_tree_view_column_clear_attributes(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkCellRenderer_(cell_renderer));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_settings "GtkSettings* gtk_widget_get_settings(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_settings", "GtkWidget*");
+ return(C_to_Xen_GtkSettings_(gtk_widget_get_settings(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_set_spacing(XEN tree_column, XEN spacing)
+static Xen gxg_gtk_widget_get_accessible(Xen widget)
{
- #define H_gtk_tree_view_column_set_spacing "void gtk_tree_view_column_set_spacing(GtkTreeViewColumn* tree_column, \
-gint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_spacing", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gint_P(spacing), spacing, 2, "gtk_tree_view_column_set_spacing", "gint");
- gtk_tree_view_column_set_spacing(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gint(spacing));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_accessible "AtkObject* gtk_widget_get_accessible(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_accessible", "GtkWidget*");
+ return(C_to_Xen_AtkObject_(gtk_widget_get_accessible(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_get_spacing(XEN tree_column)
+static Xen gxg_gtk_widget_get_events(Xen widget)
{
- #define H_gtk_tree_view_column_get_spacing "gint gtk_tree_view_column_get_spacing(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_spacing", "GtkTreeViewColumn*");
- return(C_TO_XEN_gint(gtk_tree_view_column_get_spacing(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_widget_get_events "gint gtk_widget_get_events(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_events", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_widget_get_events(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_set_visible(XEN tree_column, XEN visible)
+static Xen gxg_gtk_widget_is_ancestor(Xen widget, Xen ancestor)
{
- #define H_gtk_tree_view_column_set_visible "void gtk_tree_view_column_set_visible(GtkTreeViewColumn* tree_column, \
-gboolean visible)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_visible", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible), visible, 2, "gtk_tree_view_column_set_visible", "gboolean");
- gtk_tree_view_column_set_visible(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gboolean(visible));
- return(XEN_FALSE);
+ #define H_gtk_widget_is_ancestor "gboolean gtk_widget_is_ancestor(GtkWidget* widget, GtkWidget* ancestor)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_is_ancestor", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(ancestor), ancestor, 2, "gtk_widget_is_ancestor", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_is_ancestor(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkWidget_(ancestor))));
}
-static XEN gxg_gtk_tree_view_column_get_visible(XEN tree_column)
+static Xen gxg_gtk_widget_translate_coordinates(Xen src_widget, Xen dest_widget, Xen src_x, Xen src_y, Xen ignore_dest_x, Xen ignore_dest_y)
{
- #define H_gtk_tree_view_column_get_visible "gboolean gtk_tree_view_column_get_visible(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_visible", "GtkTreeViewColumn*");
- return(C_TO_XEN_gboolean(gtk_tree_view_column_get_visible(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_widget_translate_coordinates "gboolean gtk_widget_translate_coordinates(GtkWidget* src_widget, \
+GtkWidget* dest_widget, gint src_x, gint src_y, gint* [dest_x], gint* [dest_y])"
+ gint ref_dest_x;
+ gint ref_dest_y;
+ Xen_check_type(Xen_is_GtkWidget_(src_widget), src_widget, 1, "gtk_widget_translate_coordinates", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(dest_widget), dest_widget, 2, "gtk_widget_translate_coordinates", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(src_x), src_x, 3, "gtk_widget_translate_coordinates", "gint");
+ Xen_check_type(Xen_is_gint(src_y), src_y, 4, "gtk_widget_translate_coordinates", "gint");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_widget_translate_coordinates(Xen_to_C_GtkWidget_(src_widget), Xen_to_C_GtkWidget_(dest_widget),
+ Xen_to_C_gint(src_x), Xen_to_C_gint(src_y), &ref_dest_x,
+ &ref_dest_y));
+ return(Xen_list_3(result, C_to_Xen_gint(ref_dest_x), C_to_Xen_gint(ref_dest_y)));
+ }
}
-static XEN gxg_gtk_tree_view_column_set_resizable(XEN tree_column, XEN resizable)
+static Xen gxg_gtk_widget_hide_on_delete(Xen widget)
{
- #define H_gtk_tree_view_column_set_resizable "void gtk_tree_view_column_set_resizable(GtkTreeViewColumn* tree_column, \
-gboolean resizable)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_resizable", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(resizable), resizable, 2, "gtk_tree_view_column_set_resizable", "gboolean");
- gtk_tree_view_column_set_resizable(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gboolean(resizable));
- return(XEN_FALSE);
+ #define H_gtk_widget_hide_on_delete "gboolean gtk_widget_hide_on_delete(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_hide_on_delete", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_hide_on_delete(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_get_resizable(XEN tree_column)
+static Xen gxg_gtk_widget_create_pango_context(Xen widget)
{
- #define H_gtk_tree_view_column_get_resizable "gboolean gtk_tree_view_column_get_resizable(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_resizable", "GtkTreeViewColumn*");
- return(C_TO_XEN_gboolean(gtk_tree_view_column_get_resizable(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_widget_create_pango_context "PangoContext* gtk_widget_create_pango_context(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_create_pango_context", "GtkWidget*");
+ return(C_to_Xen_PangoContext_(gtk_widget_create_pango_context(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_set_sizing(XEN tree_column, XEN type)
+static Xen gxg_gtk_widget_get_pango_context(Xen widget)
{
- #define H_gtk_tree_view_column_set_sizing "void gtk_tree_view_column_set_sizing(GtkTreeViewColumn* tree_column, \
-GtkTreeViewColumnSizing type)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_sizing", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumnSizing_P(type), type, 2, "gtk_tree_view_column_set_sizing", "GtkTreeViewColumnSizing");
- gtk_tree_view_column_set_sizing(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkTreeViewColumnSizing(type));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_pango_context "PangoContext* gtk_widget_get_pango_context(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_pango_context", "GtkWidget*");
+ return(C_to_Xen_PangoContext_(gtk_widget_get_pango_context(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_get_sizing(XEN tree_column)
+static Xen gxg_gtk_widget_create_pango_layout(Xen widget, Xen text)
{
- #define H_gtk_tree_view_column_get_sizing "GtkTreeViewColumnSizing gtk_tree_view_column_get_sizing(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_sizing", "GtkTreeViewColumn*");
- return(C_TO_XEN_GtkTreeViewColumnSizing(gtk_tree_view_column_get_sizing(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_widget_create_pango_layout "PangoLayout* gtk_widget_create_pango_layout(GtkWidget* widget, \
+gchar* text)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_create_pango_layout", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_widget_create_pango_layout", "gchar*");
+ return(C_to_Xen_PangoLayout_(gtk_widget_create_pango_layout(Xen_to_C_GtkWidget_(widget), Xen_to_C_gchar_(text))));
}
-static XEN gxg_gtk_tree_view_column_get_width(XEN tree_column)
+static Xen gxg_gtk_widget_set_direction(Xen widget, Xen dir)
{
- #define H_gtk_tree_view_column_get_width "gint gtk_tree_view_column_get_width(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_width", "GtkTreeViewColumn*");
- return(C_TO_XEN_gint(gtk_tree_view_column_get_width(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_widget_set_direction "void gtk_widget_set_direction(GtkWidget* widget, GtkTextDirection dir)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_direction", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkTextDirection(dir), dir, 2, "gtk_widget_set_direction", "GtkTextDirection");
+ gtk_widget_set_direction(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkTextDirection(dir));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_get_fixed_width(XEN tree_column)
+static Xen gxg_gtk_widget_get_direction(Xen widget)
{
- #define H_gtk_tree_view_column_get_fixed_width "gint gtk_tree_view_column_get_fixed_width(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_fixed_width", "GtkTreeViewColumn*");
- return(C_TO_XEN_gint(gtk_tree_view_column_get_fixed_width(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_widget_get_direction "GtkTextDirection gtk_widget_get_direction(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_direction", "GtkWidget*");
+ return(C_to_Xen_GtkTextDirection(gtk_widget_get_direction(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_column_set_fixed_width(XEN tree_column, XEN fixed_width)
+static Xen gxg_gtk_widget_set_default_direction(Xen dir)
{
- #define H_gtk_tree_view_column_set_fixed_width "void gtk_tree_view_column_set_fixed_width(GtkTreeViewColumn* tree_column, \
-gint fixed_width)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_fixed_width", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gint_P(fixed_width), fixed_width, 2, "gtk_tree_view_column_set_fixed_width", "gint");
- gtk_tree_view_column_set_fixed_width(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gint(fixed_width));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_default_direction "void gtk_widget_set_default_direction(GtkTextDirection dir)"
+ Xen_check_type(Xen_is_GtkTextDirection(dir), dir, 1, "gtk_widget_set_default_direction", "GtkTextDirection");
+ gtk_widget_set_default_direction(Xen_to_C_GtkTextDirection(dir));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_min_width(XEN tree_column, XEN min_width)
+static Xen gxg_gtk_widget_get_default_direction(void)
{
- #define H_gtk_tree_view_column_set_min_width "void gtk_tree_view_column_set_min_width(GtkTreeViewColumn* tree_column, \
-gint min_width)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_min_width", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gint_P(min_width), min_width, 2, "gtk_tree_view_column_set_min_width", "gint");
- gtk_tree_view_column_set_min_width(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gint(min_width));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_default_direction "GtkTextDirection gtk_widget_get_default_direction( void)"
+ return(C_to_Xen_GtkTextDirection(gtk_widget_get_default_direction()));
+}
+
+static Xen gxg_gtk_widget_can_activate_accel(Xen widget, Xen signal_id)
+{
+ #define H_gtk_widget_can_activate_accel "gboolean gtk_widget_can_activate_accel(GtkWidget* widget, \
+guint signal_id)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_can_activate_accel", "GtkWidget*");
+ Xen_check_type(Xen_is_guint(signal_id), signal_id, 2, "gtk_widget_can_activate_accel", "guint");
+ return(C_to_Xen_gboolean(gtk_widget_can_activate_accel(Xen_to_C_GtkWidget_(widget), Xen_to_C_guint(signal_id))));
}
-static XEN gxg_gtk_tree_view_column_get_min_width(XEN tree_column)
+static Xen gxg_gtk_window_is_active(Xen window)
{
- #define H_gtk_tree_view_column_get_min_width "gint gtk_tree_view_column_get_min_width(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_min_width", "GtkTreeViewColumn*");
- return(C_TO_XEN_gint(gtk_tree_view_column_get_min_width(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_is_active "gboolean gtk_window_is_active(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_is_active", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_is_active(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_set_max_width(XEN tree_column, XEN max_width)
+static Xen gxg_gtk_window_has_toplevel_focus(Xen window)
{
- #define H_gtk_tree_view_column_set_max_width "void gtk_tree_view_column_set_max_width(GtkTreeViewColumn* tree_column, \
-gint max_width)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_max_width", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gint_P(max_width), max_width, 2, "gtk_tree_view_column_set_max_width", "gint");
- gtk_tree_view_column_set_max_width(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gint(max_width));
- return(XEN_FALSE);
+ #define H_gtk_window_has_toplevel_focus "gboolean gtk_window_has_toplevel_focus(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_has_toplevel_focus", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_has_toplevel_focus(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_get_max_width(XEN tree_column)
+static Xen gxg_gtk_window_new(Xen type)
{
- #define H_gtk_tree_view_column_get_max_width "gint gtk_tree_view_column_get_max_width(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_max_width", "GtkTreeViewColumn*");
- return(C_TO_XEN_gint(gtk_tree_view_column_get_max_width(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_new "GtkWidget* gtk_window_new(GtkWindowType type)"
+ Xen_check_type(Xen_is_GtkWindowType(type), type, 1, "gtk_window_new", "GtkWindowType");
+ return(C_to_Xen_GtkWidget_(gtk_window_new(Xen_to_C_GtkWindowType(type))));
}
-static XEN gxg_gtk_tree_view_column_clicked(XEN tree_column)
+static Xen gxg_gtk_window_set_title(Xen window, Xen title)
{
- #define H_gtk_tree_view_column_clicked "void gtk_tree_view_column_clicked(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_clicked", "GtkTreeViewColumn*");
- gtk_tree_view_column_clicked(XEN_TO_C_GtkTreeViewColumn_(tree_column));
- return(XEN_FALSE);
+ #define H_gtk_window_set_title "void gtk_window_set_title(GtkWindow* window, gchar* title)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_title", "GtkWindow*");
+ Xen_check_type(Xen_is_gchar_(title), title, 2, "gtk_window_set_title", "gchar*");
+ gtk_window_set_title(Xen_to_C_GtkWindow_(window), Xen_to_C_gchar_(title));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_title(XEN tree_column, XEN title)
+static Xen gxg_gtk_window_set_auto_startup_notification(Xen setting)
{
- #define H_gtk_tree_view_column_set_title "void gtk_tree_view_column_set_title(GtkTreeViewColumn* tree_column, \
-gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_title", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gtk_tree_view_column_set_title", "gchar*");
- gtk_tree_view_column_set_title(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_gtk_window_set_auto_startup_notification "void gtk_window_set_auto_startup_notification(gboolean setting)"
+ Xen_check_type(Xen_is_gboolean(setting), setting, 1, "gtk_window_set_auto_startup_notification", "gboolean");
+ gtk_window_set_auto_startup_notification(Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_get_title(XEN tree_column)
+static Xen gxg_gtk_window_get_title(Xen window)
{
- #define H_gtk_tree_view_column_get_title "gchar* gtk_tree_view_column_get_title(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_title", "GtkTreeViewColumn*");
- return(C_TO_XEN_gchar_(gtk_tree_view_column_get_title(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_get_title "gchar* gtk_window_get_title(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_title", "GtkWindow*");
+ return(C_to_Xen_gchar_(gtk_window_get_title(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_set_clickable(XEN tree_column, XEN clickable)
+static Xen gxg_gtk_window_set_wmclass(Xen window, Xen wmclass_name, Xen wmclass_class)
{
- #define H_gtk_tree_view_column_set_clickable "void gtk_tree_view_column_set_clickable(GtkTreeViewColumn* tree_column, \
-gboolean clickable)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_clickable", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(clickable), clickable, 2, "gtk_tree_view_column_set_clickable", "gboolean");
- gtk_tree_view_column_set_clickable(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gboolean(clickable));
- return(XEN_FALSE);
+ #define H_gtk_window_set_wmclass "void gtk_window_set_wmclass(GtkWindow* window, gchar* wmclass_name, \
+gchar* wmclass_class)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_wmclass", "GtkWindow*");
+ Xen_check_type(Xen_is_gchar_(wmclass_name), wmclass_name, 2, "gtk_window_set_wmclass", "gchar*");
+ Xen_check_type(Xen_is_gchar_(wmclass_class), wmclass_class, 3, "gtk_window_set_wmclass", "gchar*");
+ gtk_window_set_wmclass(Xen_to_C_GtkWindow_(window), Xen_to_C_gchar_(wmclass_name), Xen_to_C_gchar_(wmclass_class));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_get_clickable(XEN tree_column)
+static Xen gxg_gtk_window_set_role(Xen window, Xen role)
{
- #define H_gtk_tree_view_column_get_clickable "gboolean gtk_tree_view_column_get_clickable(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_clickable", "GtkTreeViewColumn*");
- return(C_TO_XEN_gboolean(gtk_tree_view_column_get_clickable(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_set_role "void gtk_window_set_role(GtkWindow* window, gchar* role)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_role", "GtkWindow*");
+ Xen_check_type(Xen_is_gchar_(role), role, 2, "gtk_window_set_role", "gchar*");
+ gtk_window_set_role(Xen_to_C_GtkWindow_(window), Xen_to_C_gchar_(role));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_widget(XEN tree_column, XEN widget)
+static Xen gxg_gtk_window_get_role(Xen window)
{
- #define H_gtk_tree_view_column_set_widget "void gtk_tree_view_column_set_widget(GtkTreeViewColumn* tree_column, \
-GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_widget", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget) || XEN_FALSE_P(widget), widget, 2, "gtk_tree_view_column_set_widget", "GtkWidget*");
- gtk_tree_view_column_set_widget(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_window_get_role "gchar* gtk_window_get_role(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_role", "GtkWindow*");
+ return(C_to_Xen_gchar_(gtk_window_get_role(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_get_widget(XEN tree_column)
+static Xen gxg_gtk_window_add_accel_group(Xen window, Xen accel_group)
{
- #define H_gtk_tree_view_column_get_widget "GtkWidget* gtk_tree_view_column_get_widget(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_widget", "GtkTreeViewColumn*");
- return(C_TO_XEN_GtkWidget_(gtk_tree_view_column_get_widget(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_add_accel_group "void gtk_window_add_accel_group(GtkWindow* window, GtkAccelGroup* accel_group)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_add_accel_group", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 2, "gtk_window_add_accel_group", "GtkAccelGroup*");
+ gtk_window_add_accel_group(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkAccelGroup_(accel_group));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_alignment(XEN tree_column, XEN xalign)
+static Xen gxg_gtk_window_remove_accel_group(Xen window, Xen accel_group)
{
- #define H_gtk_tree_view_column_set_alignment "void gtk_tree_view_column_set_alignment(GtkTreeViewColumn* tree_column, \
-gfloat xalign)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_alignment", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_tree_view_column_set_alignment", "gfloat");
- gtk_tree_view_column_set_alignment(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gfloat(xalign));
- return(XEN_FALSE);
+ #define H_gtk_window_remove_accel_group "void gtk_window_remove_accel_group(GtkWindow* window, GtkAccelGroup* accel_group)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_remove_accel_group", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 2, "gtk_window_remove_accel_group", "GtkAccelGroup*");
+ gtk_window_remove_accel_group(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkAccelGroup_(accel_group));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_get_alignment(XEN tree_column)
+static Xen gxg_gtk_window_set_position(Xen window, Xen position)
{
- #define H_gtk_tree_view_column_get_alignment "gfloat gtk_tree_view_column_get_alignment(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_alignment", "GtkTreeViewColumn*");
- return(C_TO_XEN_gfloat(gtk_tree_view_column_get_alignment(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_set_position "void gtk_window_set_position(GtkWindow* window, GtkWindowPosition position)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_position", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkWindowPosition(position), position, 2, "gtk_window_set_position", "GtkWindowPosition");
+ gtk_window_set_position(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkWindowPosition(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_reorderable(XEN tree_column, XEN reorderable)
+static Xen gxg_gtk_window_activate_focus(Xen window)
{
- #define H_gtk_tree_view_column_set_reorderable "void gtk_tree_view_column_set_reorderable(GtkTreeViewColumn* tree_column, \
-gboolean reorderable)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_reorderable", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(reorderable), reorderable, 2, "gtk_tree_view_column_set_reorderable", "gboolean");
- gtk_tree_view_column_set_reorderable(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gboolean(reorderable));
- return(XEN_FALSE);
+ #define H_gtk_window_activate_focus "gboolean gtk_window_activate_focus(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_activate_focus", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_activate_focus(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_get_reorderable(XEN tree_column)
+static Xen gxg_gtk_window_set_focus(Xen window, Xen focus)
{
- #define H_gtk_tree_view_column_get_reorderable "gboolean gtk_tree_view_column_get_reorderable(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_reorderable", "GtkTreeViewColumn*");
- return(C_TO_XEN_gboolean(gtk_tree_view_column_get_reorderable(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_set_focus "void gtk_window_set_focus(GtkWindow* window, GtkWidget* focus)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_focus", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkWidget_(focus) || Xen_is_false(focus), focus, 2, "gtk_window_set_focus", "GtkWidget*");
+ gtk_window_set_focus(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkWidget_(focus));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_sort_column_id(XEN tree_column, XEN sort_column_id)
+static Xen gxg_gtk_window_get_focus(Xen window)
{
- #define H_gtk_tree_view_column_set_sort_column_id "void gtk_tree_view_column_set_sort_column_id(GtkTreeViewColumn* tree_column, \
-gint sort_column_id)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_sort_column_id", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gint_P(sort_column_id), sort_column_id, 2, "gtk_tree_view_column_set_sort_column_id", "gint");
- gtk_tree_view_column_set_sort_column_id(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gint(sort_column_id));
- return(XEN_FALSE);
+ #define H_gtk_window_get_focus "GtkWidget* gtk_window_get_focus(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_focus", "GtkWindow*");
+ return(C_to_Xen_GtkWidget_(gtk_window_get_focus(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_get_sort_column_id(XEN tree_column)
+static Xen gxg_gtk_window_set_default(Xen window, Xen default_widget)
{
- #define H_gtk_tree_view_column_get_sort_column_id "gint gtk_tree_view_column_get_sort_column_id(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_sort_column_id", "GtkTreeViewColumn*");
- return(C_TO_XEN_gint(gtk_tree_view_column_get_sort_column_id(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_set_default "void gtk_window_set_default(GtkWindow* window, GtkWidget* default_widget)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_default", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkWidget_(default_widget) || Xen_is_false(default_widget), default_widget, 2, "gtk_window_set_default", "GtkWidget*");
+ gtk_window_set_default(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkWidget_(default_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_sort_indicator(XEN tree_column, XEN setting)
+static Xen gxg_gtk_window_activate_default(Xen window)
{
- #define H_gtk_tree_view_column_set_sort_indicator "void gtk_tree_view_column_set_sort_indicator(GtkTreeViewColumn* tree_column, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_sort_indicator", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_tree_view_column_set_sort_indicator", "gboolean");
- gtk_tree_view_column_set_sort_indicator(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_window_activate_default "gboolean gtk_window_activate_default(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_activate_default", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_activate_default(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_get_sort_indicator(XEN tree_column)
+static Xen gxg_gtk_window_set_transient_for(Xen window, Xen parent)
{
- #define H_gtk_tree_view_column_get_sort_indicator "gboolean gtk_tree_view_column_get_sort_indicator(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_sort_indicator", "GtkTreeViewColumn*");
- return(C_TO_XEN_gboolean(gtk_tree_view_column_get_sort_indicator(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_set_transient_for "void gtk_window_set_transient_for(GtkWindow* window, GtkWindow* parent)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_transient_for", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkWindow_(parent) || Xen_is_false(parent), parent, 2, "gtk_window_set_transient_for", "GtkWindow*");
+ gtk_window_set_transient_for(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkWindow_(parent));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_sort_order(XEN tree_column, XEN order)
+static Xen gxg_gtk_window_get_transient_for(Xen window)
{
- #define H_gtk_tree_view_column_set_sort_order "void gtk_tree_view_column_set_sort_order(GtkTreeViewColumn* tree_column, \
-GtkSortType order)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_sort_order", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkSortType_P(order), order, 2, "gtk_tree_view_column_set_sort_order", "GtkSortType");
- gtk_tree_view_column_set_sort_order(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkSortType(order));
- return(XEN_FALSE);
+ #define H_gtk_window_get_transient_for "GtkWindow* gtk_window_get_transient_for(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_transient_for", "GtkWindow*");
+ return(C_to_Xen_GtkWindow_(gtk_window_get_transient_for(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_get_sort_order(XEN tree_column)
+static Xen gxg_gtk_window_set_type_hint(Xen window, Xen hint)
{
- #define H_gtk_tree_view_column_get_sort_order "GtkSortType gtk_tree_view_column_get_sort_order(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_sort_order", "GtkTreeViewColumn*");
- return(C_TO_XEN_GtkSortType(gtk_tree_view_column_get_sort_order(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_set_type_hint "void gtk_window_set_type_hint(GtkWindow* window, GdkWindowTypeHint hint)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_type_hint", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkWindowTypeHint(hint), hint, 2, "gtk_window_set_type_hint", "GdkWindowTypeHint");
+ gtk_window_set_type_hint(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkWindowTypeHint(hint));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_cell_set_cell_data(XEN tree_column, XEN tree_model, XEN iter, XEN is_expander, XEN is_expanded)
+static Xen gxg_gtk_window_get_type_hint(Xen window)
{
- #define H_gtk_tree_view_column_cell_set_cell_data "void gtk_tree_view_column_cell_set_cell_data(GtkTreeViewColumn* tree_column, \
-GtkTreeModel* tree_model, GtkTreeIter* iter, gboolean is_expander, gboolean is_expanded)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_cell_set_cell_data", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 2, "gtk_tree_view_column_cell_set_cell_data", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 3, "gtk_tree_view_column_cell_set_cell_data", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_expander), is_expander, 4, "gtk_tree_view_column_cell_set_cell_data", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_expanded), is_expanded, 5, "gtk_tree_view_column_cell_set_cell_data", "gboolean");
- gtk_tree_view_column_cell_set_cell_data(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter),
- XEN_TO_C_gboolean(is_expander), XEN_TO_C_gboolean(is_expanded));
- return(XEN_FALSE);
+ #define H_gtk_window_get_type_hint "GdkWindowTypeHint gtk_window_get_type_hint(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_type_hint", "GtkWindow*");
+ return(C_to_Xen_GdkWindowTypeHint(gtk_window_get_type_hint(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_cell_get_size(XEN tree_column, XEN cell_area, XEN ignore_x_offset, XEN ignore_y_offset, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_window_set_destroy_with_parent(Xen window, Xen setting)
{
- #define H_gtk_tree_view_column_cell_get_size "void gtk_tree_view_column_cell_get_size(GtkTreeViewColumn* tree_column, \
-GdkRectangle* cell_area, gint* [x_offset], gint* [y_offset], gint* [width], gint* [height])"
- gint ref_x_offset;
- gint ref_y_offset;
- gint ref_width;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_cell_get_size", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(cell_area), cell_area, 2, "gtk_tree_view_column_cell_get_size", "GdkRectangle*");
- gtk_tree_view_column_cell_get_size(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GdkRectangle_(cell_area), &ref_x_offset,
- &ref_y_offset, &ref_width, &ref_height);
- return(XEN_LIST_4(C_TO_XEN_gint(ref_x_offset), C_TO_XEN_gint(ref_y_offset), C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ #define H_gtk_window_set_destroy_with_parent "void gtk_window_set_destroy_with_parent(GtkWindow* window, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_destroy_with_parent", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_destroy_with_parent", "gboolean");
+ gtk_window_set_destroy_with_parent(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_cell_is_visible(XEN tree_column)
+static Xen gxg_gtk_window_get_destroy_with_parent(Xen window)
{
- #define H_gtk_tree_view_column_cell_is_visible "gboolean gtk_tree_view_column_cell_is_visible(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_cell_is_visible", "GtkTreeViewColumn*");
- return(C_TO_XEN_gboolean(gtk_tree_view_column_cell_is_visible(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_window_get_destroy_with_parent "gboolean gtk_window_get_destroy_with_parent(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_destroy_with_parent", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_destroy_with_parent(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_column_cell_get_position(XEN tree_column, XEN cell_renderer, XEN ignore_start_pos, XEN ignore_width)
+static Xen gxg_gtk_window_set_resizable(Xen window, Xen resizable)
{
- #define H_gtk_tree_view_column_cell_get_position "gboolean gtk_tree_view_column_cell_get_position(GtkTreeViewColumn* tree_column, \
-GtkCellRenderer* cell_renderer, gint* [start_pos], gint* [width])"
- gint ref_start_pos;
- gint ref_width;
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_cell_get_position", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell_renderer), cell_renderer, 2, "gtk_tree_view_column_cell_get_position", "GtkCellRenderer*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_tree_view_column_cell_get_position(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkCellRenderer_(cell_renderer),
- &ref_start_pos, &ref_width));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_start_pos), C_TO_XEN_gint(ref_width)));
- }
+ #define H_gtk_window_set_resizable "void gtk_window_set_resizable(GtkWindow* window, gboolean resizable)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_resizable", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(resizable), resizable, 2, "gtk_window_set_resizable", "gboolean");
+ gtk_window_set_resizable(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(resizable));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_new(void)
+static Xen gxg_gtk_window_get_resizable(Xen window)
{
- #define H_gtk_tree_view_new "GtkWidget* gtk_tree_view_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_tree_view_new()));
+ #define H_gtk_window_get_resizable "gboolean gtk_window_get_resizable(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_resizable", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_resizable(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_new_with_model(XEN model)
+static Xen gxg_gtk_window_set_gravity(Xen window, Xen gravity)
{
- #define H_gtk_tree_view_new_with_model "GtkWidget* gtk_tree_view_new_with_model(GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model), model, 1, "gtk_tree_view_new_with_model", "GtkTreeModel*");
- return(C_TO_XEN_GtkWidget_(gtk_tree_view_new_with_model(XEN_TO_C_GtkTreeModel_(model))));
+ #define H_gtk_window_set_gravity "void gtk_window_set_gravity(GtkWindow* window, GdkGravity gravity)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_gravity", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkGravity(gravity), gravity, 2, "gtk_window_set_gravity", "GdkGravity");
+ gtk_window_set_gravity(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkGravity(gravity));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_model(XEN tree_view)
+static Xen gxg_gtk_window_get_gravity(Xen window)
{
- #define H_gtk_tree_view_get_model "GtkTreeModel* gtk_tree_view_get_model(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_model", "GtkTreeView*");
- return(C_TO_XEN_GtkTreeModel_(gtk_tree_view_get_model(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_window_get_gravity "GdkGravity gtk_window_get_gravity(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_gravity", "GtkWindow*");
+ return(C_to_Xen_GdkGravity(gtk_window_get_gravity(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_set_model(XEN tree_view, XEN model)
+static Xen gxg_gtk_window_set_geometry_hints(Xen window, Xen geometry_widget, Xen geometry, Xen geom_mask)
{
- #define H_gtk_tree_view_set_model "void gtk_tree_view_set_model(GtkTreeView* tree_view, GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_model", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model) || XEN_FALSE_P(model), model, 2, "gtk_tree_view_set_model", "GtkTreeModel*");
- gtk_tree_view_set_model(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeModel_(model));
- return(XEN_FALSE);
+ #define H_gtk_window_set_geometry_hints "void gtk_window_set_geometry_hints(GtkWindow* window, GtkWidget* geometry_widget, \
+GdkGeometry* geometry, GdkWindowHints geom_mask)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_geometry_hints", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkWidget_(geometry_widget), geometry_widget, 2, "gtk_window_set_geometry_hints", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkGeometry_(geometry), geometry, 3, "gtk_window_set_geometry_hints", "GdkGeometry*");
+ Xen_check_type(Xen_is_GdkWindowHints(geom_mask), geom_mask, 4, "gtk_window_set_geometry_hints", "GdkWindowHints");
+ gtk_window_set_geometry_hints(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkWidget_(geometry_widget), Xen_to_C_GdkGeometry_(geometry),
+ Xen_to_C_GdkWindowHints(geom_mask));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_selection(XEN tree_view)
+static Xen gxg_gtk_window_set_decorated(Xen window, Xen setting)
{
- #define H_gtk_tree_view_get_selection "GtkTreeSelection* gtk_tree_view_get_selection(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_selection", "GtkTreeView*");
- return(C_TO_XEN_GtkTreeSelection_(gtk_tree_view_get_selection(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_window_set_decorated "void gtk_window_set_decorated(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_decorated", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_decorated", "gboolean");
+ gtk_window_set_decorated(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_headers_visible(XEN tree_view)
+static Xen gxg_gtk_window_get_decorated(Xen window)
{
- #define H_gtk_tree_view_get_headers_visible "gboolean gtk_tree_view_get_headers_visible(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_headers_visible", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_headers_visible(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_window_get_decorated "gboolean gtk_window_get_decorated(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_decorated", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_decorated(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_set_headers_visible(XEN tree_view, XEN headers_visible)
+static Xen gxg_gtk_window_set_icon_list(Xen window, Xen list)
{
- #define H_gtk_tree_view_set_headers_visible "void gtk_tree_view_set_headers_visible(GtkTreeView* tree_view, \
-gboolean headers_visible)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_headers_visible", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(headers_visible), headers_visible, 2, "gtk_tree_view_set_headers_visible", "gboolean");
- gtk_tree_view_set_headers_visible(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(headers_visible));
- return(XEN_FALSE);
+ #define H_gtk_window_set_icon_list "void gtk_window_set_icon_list(GtkWindow* window, GList* list)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_icon_list", "GtkWindow*");
+ Xen_check_type(Xen_is_GList_(list) || Xen_is_false(list), list, 2, "gtk_window_set_icon_list", "GList*");
+ gtk_window_set_icon_list(Xen_to_C_GtkWindow_(window), Xen_to_C_GList_(list));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_columns_autosize(XEN tree_view)
+static Xen gxg_gtk_window_get_icon_list(Xen window)
{
- #define H_gtk_tree_view_columns_autosize "void gtk_tree_view_columns_autosize(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_columns_autosize", "GtkTreeView*");
- gtk_tree_view_columns_autosize(XEN_TO_C_GtkTreeView_(tree_view));
- return(XEN_FALSE);
+ #define H_gtk_window_get_icon_list "GList* gtk_window_get_icon_list(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_icon_list", "GtkWindow*");
+ return(C_to_Xen_GList_(gtk_window_get_icon_list(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_set_headers_clickable(XEN tree_view, XEN setting)
+static Xen gxg_gtk_window_set_icon(Xen window, Xen icon)
{
- #define H_gtk_tree_view_set_headers_clickable "void gtk_tree_view_set_headers_clickable(GtkTreeView* tree_view, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_headers_clickable", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_tree_view_set_headers_clickable", "gboolean");
- gtk_tree_view_set_headers_clickable(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_window_set_icon "void gtk_window_set_icon(GtkWindow* window, GdkPixbuf* icon)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_icon", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkPixbuf_(icon) || Xen_is_false(icon), icon, 2, "gtk_window_set_icon", "GdkPixbuf*");
+ gtk_window_set_icon(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkPixbuf_(icon));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_rules_hint(XEN tree_view, XEN setting)
+static Xen gxg_gtk_window_get_icon(Xen window)
{
- #define H_gtk_tree_view_set_rules_hint "void gtk_tree_view_set_rules_hint(GtkTreeView* tree_view, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_rules_hint", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_tree_view_set_rules_hint", "gboolean");
- gtk_tree_view_set_rules_hint(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_window_get_icon "GdkPixbuf* gtk_window_get_icon(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_icon", "GtkWindow*");
+ return(C_to_Xen_GdkPixbuf_(gtk_window_get_icon(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_get_rules_hint(XEN tree_view)
+static Xen gxg_gtk_window_set_default_icon_list(Xen list)
{
- #define H_gtk_tree_view_get_rules_hint "gboolean gtk_tree_view_get_rules_hint(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_rules_hint", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_rules_hint(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_window_set_default_icon_list "void gtk_window_set_default_icon_list(GList* list)"
+ Xen_check_type(Xen_is_GList_(list) || Xen_is_false(list), list, 1, "gtk_window_set_default_icon_list", "GList*");
+ gtk_window_set_default_icon_list(Xen_to_C_GList_(list));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_append_column(XEN tree_view, XEN column)
+static Xen gxg_gtk_window_get_default_icon_list(void)
{
- #define H_gtk_tree_view_append_column "gint gtk_tree_view_append_column(GtkTreeView* tree_view, GtkTreeViewColumn* column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_append_column", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column), column, 2, "gtk_tree_view_append_column", "GtkTreeViewColumn*");
- return(C_TO_XEN_gint(gtk_tree_view_append_column(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewColumn_(column))));
+ #define H_gtk_window_get_default_icon_list "GList* gtk_window_get_default_icon_list( void)"
+ return(C_to_Xen_GList_(gtk_window_get_default_icon_list()));
}
-static XEN gxg_gtk_tree_view_remove_column(XEN tree_view, XEN column)
+static Xen gxg_gtk_window_set_modal(Xen window, Xen modal)
{
- #define H_gtk_tree_view_remove_column "gint gtk_tree_view_remove_column(GtkTreeView* tree_view, GtkTreeViewColumn* column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_remove_column", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column), column, 2, "gtk_tree_view_remove_column", "GtkTreeViewColumn*");
- return(C_TO_XEN_gint(gtk_tree_view_remove_column(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewColumn_(column))));
+ #define H_gtk_window_set_modal "void gtk_window_set_modal(GtkWindow* window, gboolean modal)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_modal", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(modal), modal, 2, "gtk_window_set_modal", "gboolean");
+ gtk_window_set_modal(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(modal));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_insert_column(XEN tree_view, XEN column, XEN position)
+static Xen gxg_gtk_window_get_modal(Xen window)
{
- #define H_gtk_tree_view_insert_column "gint gtk_tree_view_insert_column(GtkTreeView* tree_view, GtkTreeViewColumn* column, \
-gint position)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_insert_column", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column), column, 2, "gtk_tree_view_insert_column", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_tree_view_insert_column", "gint");
- return(C_TO_XEN_gint(gtk_tree_view_insert_column(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewColumn_(column),
- XEN_TO_C_gint(position))));
+ #define H_gtk_window_get_modal "gboolean gtk_window_get_modal(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_modal", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_modal(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_insert_column_with_attributes(XEN tree_view, XEN position, XEN title, XEN cell, XEN attributes)
+static Xen gxg_gtk_window_list_toplevels(void)
{
- #define H_gtk_tree_view_insert_column_with_attributes "gint gtk_tree_view_insert_column_with_attributes(GtkTreeView* tree_view, \
-gint position, gchar* title, GtkCellRenderer* cell, etc attributes)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_insert_column_with_attributes", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 2, "gtk_tree_view_insert_column_with_attributes", "gint");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 3, "gtk_tree_view_insert_column_with_attributes", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 4, "gtk_tree_view_insert_column_with_attributes", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_etc_P(attributes), attributes, 5, "gtk_tree_view_insert_column_with_attributes", "etc");
- {
- int etc_len = 0;
- gint result = 0;
- GtkTreeView* p_arg0;
- gint p_arg1;
- gchar* p_arg2;
- GtkCellRenderer* p_arg3;
- if (XEN_LIST_P(attributes)) etc_len = XEN_LIST_LENGTH(attributes);
- if (etc_len < 2) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_insert_column_with_attributes", 4, attributes, "... list must have at least 2 entries");
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_insert_column_with_attributes", 4, attributes, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_tree_view_insert_column_with_attributes", 4, attributes, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_GtkTreeView_(tree_view);
- p_arg1 = XEN_TO_C_gint(position);
- p_arg2 = XEN_TO_C_gchar_(title);
- p_arg3 = XEN_TO_C_GtkCellRenderer_(cell);
- switch (etc_len)
- {
- case 2: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), NULL); break;
- case 4: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), NULL); break;
- case 6: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), NULL); break;
- case 8: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), NULL); break;
- case 10: result = gtk_tree_view_insert_column_with_attributes(p_arg0, p_arg1, p_arg2, p_arg3, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), XLS(attributes, 8), XLI(attributes, 9), NULL); break;
- }
- return(C_TO_XEN_gint(result));
- }
+ #define H_gtk_window_list_toplevels "GList* gtk_window_list_toplevels( void)"
+ return(C_to_Xen_GList_(gtk_window_list_toplevels()));
}
-static XEN gxg_gtk_tree_view_insert_column_with_data_func(XEN tree_view, XEN position, XEN title, XEN cell, XEN func, XEN func_info, XEN dnotify)
+static Xen gxg_gtk_window_add_mnemonic(Xen window, Xen keyval, Xen target)
{
- #define H_gtk_tree_view_insert_column_with_data_func "gint gtk_tree_view_insert_column_with_data_func(GtkTreeView* tree_view, \
-gint position, gchar* title, GtkCellRenderer* cell, GtkTreeCellDataFunc func, lambda_data func_info, \
-GtkDestroyNotify dnotify)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_insert_column_with_data_func", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 2, "gtk_tree_view_insert_column_with_data_func", "gint");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 3, "gtk_tree_view_insert_column_with_data_func", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 4, "gtk_tree_view_insert_column_with_data_func", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GtkTreeCellDataFunc_P(func), func, 5, "gtk_tree_view_insert_column_with_data_func", "GtkTreeCellDataFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 6, "gtk_tree_view_insert_column_with_data_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(dnotify), dnotify, 7, "gtk_tree_view_insert_column_with_data_func", "GtkDestroyNotify");
- {
- XEN result = XEN_FALSE;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, dnotify);
- result = C_TO_XEN_gint(gtk_tree_view_insert_column_with_data_func(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(position),
- XEN_TO_C_gchar_(title), XEN_TO_C_GtkCellRenderer_(cell),
- XEN_TO_C_GtkTreeCellDataFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GtkDestroyNotify(dnotify)));
- return(result);
- }
+ #define H_gtk_window_add_mnemonic "void gtk_window_add_mnemonic(GtkWindow* window, guint keyval, GtkWidget* target)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_add_mnemonic", "GtkWindow*");
+ Xen_check_type(Xen_is_guint(keyval), keyval, 2, "gtk_window_add_mnemonic", "guint");
+ Xen_check_type(Xen_is_GtkWidget_(target), target, 3, "gtk_window_add_mnemonic", "GtkWidget*");
+ gtk_window_add_mnemonic(Xen_to_C_GtkWindow_(window), Xen_to_C_guint(keyval), Xen_to_C_GtkWidget_(target));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_column(XEN tree_view, XEN n)
+static Xen gxg_gtk_window_remove_mnemonic(Xen window, Xen keyval, Xen target)
{
- #define H_gtk_tree_view_get_column "GtkTreeViewColumn* gtk_tree_view_get_column(GtkTreeView* tree_view, \
-gint n)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_column", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(n), n, 2, "gtk_tree_view_get_column", "gint");
- return(C_TO_XEN_GtkTreeViewColumn_(gtk_tree_view_get_column(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(n))));
+ #define H_gtk_window_remove_mnemonic "void gtk_window_remove_mnemonic(GtkWindow* window, guint keyval, \
+GtkWidget* target)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_remove_mnemonic", "GtkWindow*");
+ Xen_check_type(Xen_is_guint(keyval), keyval, 2, "gtk_window_remove_mnemonic", "guint");
+ Xen_check_type(Xen_is_GtkWidget_(target), target, 3, "gtk_window_remove_mnemonic", "GtkWidget*");
+ gtk_window_remove_mnemonic(Xen_to_C_GtkWindow_(window), Xen_to_C_guint(keyval), Xen_to_C_GtkWidget_(target));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_columns(XEN tree_view)
+static Xen gxg_gtk_window_mnemonic_activate(Xen window, Xen keyval, Xen modifier)
{
- #define H_gtk_tree_view_get_columns "GList* gtk_tree_view_get_columns(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_columns", "GtkTreeView*");
- return(C_TO_XEN_GList_(gtk_tree_view_get_columns(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_window_mnemonic_activate "gboolean gtk_window_mnemonic_activate(GtkWindow* window, guint keyval, \
+GdkModifierType modifier)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_mnemonic_activate", "GtkWindow*");
+ Xen_check_type(Xen_is_guint(keyval), keyval, 2, "gtk_window_mnemonic_activate", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(modifier), modifier, 3, "gtk_window_mnemonic_activate", "GdkModifierType");
+ return(C_to_Xen_gboolean(gtk_window_mnemonic_activate(Xen_to_C_GtkWindow_(window), Xen_to_C_guint(keyval), Xen_to_C_GdkModifierType(modifier))));
}
-static XEN gxg_gtk_tree_view_move_column_after(XEN tree_view, XEN column, XEN base_column)
+static Xen gxg_gtk_window_set_mnemonic_modifier(Xen window, Xen modifier)
{
- #define H_gtk_tree_view_move_column_after "void gtk_tree_view_move_column_after(GtkTreeView* tree_view, \
-GtkTreeViewColumn* column, GtkTreeViewColumn* base_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_move_column_after", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column), column, 2, "gtk_tree_view_move_column_after", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(base_column) || XEN_FALSE_P(base_column), base_column, 3, "gtk_tree_view_move_column_after", "GtkTreeViewColumn*");
- gtk_tree_view_move_column_after(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewColumn_(column), XEN_TO_C_GtkTreeViewColumn_(base_column));
- return(XEN_FALSE);
+ #define H_gtk_window_set_mnemonic_modifier "void gtk_window_set_mnemonic_modifier(GtkWindow* window, \
+GdkModifierType modifier)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_mnemonic_modifier", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkModifierType(modifier), modifier, 2, "gtk_window_set_mnemonic_modifier", "GdkModifierType");
+ gtk_window_set_mnemonic_modifier(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkModifierType(modifier));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_expander_column(XEN tree_view, XEN column)
+static Xen gxg_gtk_window_get_mnemonic_modifier(Xen window)
{
- #define H_gtk_tree_view_set_expander_column "void gtk_tree_view_set_expander_column(GtkTreeView* tree_view, \
-GtkTreeViewColumn* column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_expander_column", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column) || XEN_FALSE_P(column), column, 2, "gtk_tree_view_set_expander_column", "GtkTreeViewColumn*");
- gtk_tree_view_set_expander_column(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewColumn_(column));
- return(XEN_FALSE);
+ #define H_gtk_window_get_mnemonic_modifier "GdkModifierType gtk_window_get_mnemonic_modifier(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_mnemonic_modifier", "GtkWindow*");
+ return(C_to_Xen_GdkModifierType(gtk_window_get_mnemonic_modifier(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_get_expander_column(XEN tree_view)
+static Xen gxg_gtk_window_present(Xen window)
{
- #define H_gtk_tree_view_get_expander_column "GtkTreeViewColumn* gtk_tree_view_get_expander_column(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_expander_column", "GtkTreeView*");
- return(C_TO_XEN_GtkTreeViewColumn_(gtk_tree_view_get_expander_column(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_window_present "void gtk_window_present(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_present", "GtkWindow*");
+ gtk_window_present(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_column_drag_function(XEN tree_view, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_window_iconify(Xen window)
{
- #define H_gtk_tree_view_set_column_drag_function "void gtk_tree_view_set_column_drag_function(GtkTreeView* tree_view, \
-GtkTreeViewColumnDropFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_column_drag_function", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumnDropFunc_P(func), func, 2, "gtk_tree_view_set_column_drag_function", "GtkTreeViewColumnDropFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_view_set_column_drag_function", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 4, "gtk_tree_view_set_column_drag_function", "GtkDestroyNotify");
- {
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_tree_view_set_column_drag_function(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewColumnDropFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GtkDestroyNotify(destroy));
- xm_unprotect_at(loc);
- return(XEN_FALSE);
- }
+ #define H_gtk_window_iconify "void gtk_window_iconify(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_iconify", "GtkWindow*");
+ gtk_window_iconify(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_scroll_to_point(XEN tree_view, XEN tree_x, XEN tree_y)
+static Xen gxg_gtk_window_deiconify(Xen window)
{
- #define H_gtk_tree_view_scroll_to_point "void gtk_tree_view_scroll_to_point(GtkTreeView* tree_view, \
-gint tree_x, gint tree_y)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_scroll_to_point", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(tree_x), tree_x, 2, "gtk_tree_view_scroll_to_point", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(tree_y), tree_y, 3, "gtk_tree_view_scroll_to_point", "gint");
- gtk_tree_view_scroll_to_point(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(tree_x), XEN_TO_C_gint(tree_y));
- return(XEN_FALSE);
+ #define H_gtk_window_deiconify "void gtk_window_deiconify(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_deiconify", "GtkWindow*");
+ gtk_window_deiconify(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_scroll_to_cell(XEN tree_view, XEN path, XEN column, XEN use_align, XEN row_align, XEN col_align)
+static Xen gxg_gtk_window_stick(Xen window)
{
- #define H_gtk_tree_view_scroll_to_cell "void gtk_tree_view_scroll_to_cell(GtkTreeView* tree_view, GtkTreePath* path, \
-GtkTreeViewColumn* column, gboolean use_align, gfloat row_align, gfloat col_align)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_scroll_to_cell", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path) || XEN_FALSE_P(path), path, 2, "gtk_tree_view_scroll_to_cell", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column) || XEN_FALSE_P(column), column, 3, "gtk_tree_view_scroll_to_cell", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_align), use_align, 4, "gtk_tree_view_scroll_to_cell", "gboolean");
- XEN_ASSERT_TYPE(XEN_gfloat_P(row_align), row_align, 5, "gtk_tree_view_scroll_to_cell", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(col_align), col_align, 6, "gtk_tree_view_scroll_to_cell", "gfloat");
- gtk_tree_view_scroll_to_cell(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeViewColumn_(column),
- XEN_TO_C_gboolean(use_align), XEN_TO_C_gfloat(row_align), XEN_TO_C_gfloat(col_align));
- return(XEN_FALSE);
+ #define H_gtk_window_stick "void gtk_window_stick(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_stick", "GtkWindow*");
+ gtk_window_stick(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_row_activated(XEN tree_view, XEN path, XEN column)
+static Xen gxg_gtk_window_unstick(Xen window)
{
- #define H_gtk_tree_view_row_activated "void gtk_tree_view_row_activated(GtkTreeView* tree_view, GtkTreePath* path, \
-GtkTreeViewColumn* column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_row_activated", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_row_activated", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column), column, 3, "gtk_tree_view_row_activated", "GtkTreeViewColumn*");
- gtk_tree_view_row_activated(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeViewColumn_(column));
- return(XEN_FALSE);
+ #define H_gtk_window_unstick "void gtk_window_unstick(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_unstick", "GtkWindow*");
+ gtk_window_unstick(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_expand_all(XEN tree_view)
+static Xen gxg_gtk_window_maximize(Xen window)
{
- #define H_gtk_tree_view_expand_all "void gtk_tree_view_expand_all(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_expand_all", "GtkTreeView*");
- gtk_tree_view_expand_all(XEN_TO_C_GtkTreeView_(tree_view));
- return(XEN_FALSE);
+ #define H_gtk_window_maximize "void gtk_window_maximize(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_maximize", "GtkWindow*");
+ gtk_window_maximize(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_collapse_all(XEN tree_view)
+static Xen gxg_gtk_window_unmaximize(Xen window)
{
- #define H_gtk_tree_view_collapse_all "void gtk_tree_view_collapse_all(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_collapse_all", "GtkTreeView*");
- gtk_tree_view_collapse_all(XEN_TO_C_GtkTreeView_(tree_view));
- return(XEN_FALSE);
+ #define H_gtk_window_unmaximize "void gtk_window_unmaximize(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_unmaximize", "GtkWindow*");
+ gtk_window_unmaximize(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_expand_row(XEN tree_view, XEN path, XEN open_all)
+static Xen gxg_gtk_window_begin_resize_drag(Xen window, Xen edge, Xen button, Xen root_x, Xen root_y, Xen timestamp)
{
- #define H_gtk_tree_view_expand_row "gboolean gtk_tree_view_expand_row(GtkTreeView* tree_view, GtkTreePath* path, \
-gboolean open_all)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_expand_row", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_expand_row", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(open_all), open_all, 3, "gtk_tree_view_expand_row", "gboolean");
- return(C_TO_XEN_gboolean(gtk_tree_view_expand_row(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_gboolean(open_all))));
+ #define H_gtk_window_begin_resize_drag "void gtk_window_begin_resize_drag(GtkWindow* window, GdkWindowEdge edge, \
+gint button, gint root_x, gint root_y, guint32 timestamp)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_begin_resize_drag", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkWindowEdge(edge), edge, 2, "gtk_window_begin_resize_drag", "GdkWindowEdge");
+ Xen_check_type(Xen_is_gint(button), button, 3, "gtk_window_begin_resize_drag", "gint");
+ Xen_check_type(Xen_is_gint(root_x), root_x, 4, "gtk_window_begin_resize_drag", "gint");
+ Xen_check_type(Xen_is_gint(root_y), root_y, 5, "gtk_window_begin_resize_drag", "gint");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 6, "gtk_window_begin_resize_drag", "guint32");
+ gtk_window_begin_resize_drag(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkWindowEdge(edge), Xen_to_C_gint(button), Xen_to_C_gint(root_x),
+ Xen_to_C_gint(root_y), Xen_to_C_guint32(timestamp));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_collapse_row(XEN tree_view, XEN path)
+static Xen gxg_gtk_window_begin_move_drag(Xen window, Xen button, Xen root_x, Xen root_y, Xen timestamp)
{
- #define H_gtk_tree_view_collapse_row "gboolean gtk_tree_view_collapse_row(GtkTreeView* tree_view, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_collapse_row", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_collapse_row", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_view_collapse_row(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_window_begin_move_drag "void gtk_window_begin_move_drag(GtkWindow* window, gint button, \
+gint root_x, gint root_y, guint32 timestamp)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_begin_move_drag", "GtkWindow*");
+ Xen_check_type(Xen_is_gint(button), button, 2, "gtk_window_begin_move_drag", "gint");
+ Xen_check_type(Xen_is_gint(root_x), root_x, 3, "gtk_window_begin_move_drag", "gint");
+ Xen_check_type(Xen_is_gint(root_y), root_y, 4, "gtk_window_begin_move_drag", "gint");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 5, "gtk_window_begin_move_drag", "guint32");
+ gtk_window_begin_move_drag(Xen_to_C_GtkWindow_(window), Xen_to_C_gint(button), Xen_to_C_gint(root_x), Xen_to_C_gint(root_y),
+ Xen_to_C_guint32(timestamp));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_map_expanded_rows(XEN tree_view, XEN func, XEN func_info)
+static Xen gxg_gtk_window_set_default_size(Xen window, Xen width, Xen height)
{
- #define H_gtk_tree_view_map_expanded_rows "void gtk_tree_view_map_expanded_rows(GtkTreeView* tree_view, \
-GtkTreeViewMappingFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_map_expanded_rows", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewMappingFunc_P(func), func, 2, "gtk_tree_view_map_expanded_rows", "GtkTreeViewMappingFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_view_map_expanded_rows", "lambda_data");
- {
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_tree_view_map_expanded_rows(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewMappingFunc(func), XEN_TO_C_lambda_data(func_info));
- xm_unprotect_at(loc);
- return(XEN_FALSE);
- }
+ #define H_gtk_window_set_default_size "void gtk_window_set_default_size(GtkWindow* window, gint width, \
+gint height)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_default_size", "GtkWindow*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_window_set_default_size", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 3, "gtk_window_set_default_size", "gint");
+ gtk_window_set_default_size(Xen_to_C_GtkWindow_(window), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_row_expanded(XEN tree_view, XEN path)
+static Xen gxg_gtk_window_get_default_size(Xen window, Xen ignore_width, Xen ignore_height)
{
- #define H_gtk_tree_view_row_expanded "gboolean gtk_tree_view_row_expanded(GtkTreeView* tree_view, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_row_expanded", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_row_expanded", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_tree_view_row_expanded(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_window_get_default_size "void gtk_window_get_default_size(GtkWindow* window, gint* [width], \
+gint* [height])"
+ gint ref_width;
+ gint ref_height;
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_default_size", "GtkWindow*");
+ gtk_window_get_default_size(Xen_to_C_GtkWindow_(window), &ref_width, &ref_height);
+ return(Xen_list_2(C_to_Xen_gint(ref_width), C_to_Xen_gint(ref_height)));
}
-static XEN gxg_gtk_tree_view_set_reorderable(XEN tree_view, XEN reorderable)
+static Xen gxg_gtk_window_resize(Xen window, Xen width, Xen height)
{
- #define H_gtk_tree_view_set_reorderable "void gtk_tree_view_set_reorderable(GtkTreeView* tree_view, \
-gboolean reorderable)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_reorderable", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(reorderable), reorderable, 2, "gtk_tree_view_set_reorderable", "gboolean");
- gtk_tree_view_set_reorderable(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(reorderable));
- return(XEN_FALSE);
+ #define H_gtk_window_resize "void gtk_window_resize(GtkWindow* window, gint width, gint height)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_resize", "GtkWindow*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_window_resize", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 3, "gtk_window_resize", "gint");
+ gtk_window_resize(Xen_to_C_GtkWindow_(window), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_reorderable(XEN tree_view)
+static Xen gxg_gtk_window_get_size(Xen window, Xen ignore_width, Xen ignore_height)
{
- #define H_gtk_tree_view_get_reorderable "gboolean gtk_tree_view_get_reorderable(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_reorderable", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_reorderable(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_window_get_size "void gtk_window_get_size(GtkWindow* window, gint* [width], gint* [height])"
+ gint ref_width;
+ gint ref_height;
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_size", "GtkWindow*");
+ gtk_window_get_size(Xen_to_C_GtkWindow_(window), &ref_width, &ref_height);
+ return(Xen_list_2(C_to_Xen_gint(ref_width), C_to_Xen_gint(ref_height)));
}
-static XEN gxg_gtk_tree_view_set_cursor(XEN tree_view, XEN path, XEN focus_column, XEN start_editing)
+static Xen gxg_gtk_window_move(Xen window, Xen x, Xen y)
{
- #define H_gtk_tree_view_set_cursor "void gtk_tree_view_set_cursor(GtkTreeView* tree_view, GtkTreePath* path, \
-GtkTreeViewColumn* focus_column, gboolean start_editing)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_cursor", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_set_cursor", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(focus_column), focus_column, 3, "gtk_tree_view_set_cursor", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(start_editing), start_editing, 4, "gtk_tree_view_set_cursor", "gboolean");
- gtk_tree_view_set_cursor(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeViewColumn_(focus_column),
- XEN_TO_C_gboolean(start_editing));
- return(XEN_FALSE);
+ #define H_gtk_window_move "void gtk_window_move(GtkWindow* window, gint x, gint y)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_move", "GtkWindow*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_window_move", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_window_move", "gint");
+ gtk_window_move(Xen_to_C_GtkWindow_(window), Xen_to_C_gint(x), Xen_to_C_gint(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_cursor(XEN tree_view, XEN ignore_path, XEN ignore_focus_column)
+static Xen gxg_gtk_window_get_position(Xen window, Xen ignore_root_x, Xen ignore_root_y)
{
- #define H_gtk_tree_view_get_cursor "void gtk_tree_view_get_cursor(GtkTreeView* tree_view, GtkTreePath** [path], \
-GtkTreeViewColumn** [focus_column])"
- GtkTreePath* ref_path = NULL;
- GtkTreeViewColumn* ref_focus_column = NULL;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_cursor", "GtkTreeView*");
- gtk_tree_view_get_cursor(XEN_TO_C_GtkTreeView_(tree_view), &ref_path, &ref_focus_column);
- return(XEN_LIST_2(C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkTreeViewColumn_(ref_focus_column)));
+ #define H_gtk_window_get_position "void gtk_window_get_position(GtkWindow* window, gint* [root_x], \
+gint* [root_y])"
+ gint ref_root_x;
+ gint ref_root_y;
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_position", "GtkWindow*");
+ gtk_window_get_position(Xen_to_C_GtkWindow_(window), &ref_root_x, &ref_root_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_root_x), C_to_Xen_gint(ref_root_y)));
}
-static XEN gxg_gtk_tree_view_get_bin_window(XEN tree_view)
+static Xen gxg_gtk_window_parse_geometry(Xen window, Xen geometry)
{
- #define H_gtk_tree_view_get_bin_window "GdkWindow* gtk_tree_view_get_bin_window(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_bin_window", "GtkTreeView*");
- return(C_TO_XEN_GdkWindow_(gtk_tree_view_get_bin_window(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_window_parse_geometry "gboolean gtk_window_parse_geometry(GtkWindow* window, gchar* geometry)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_parse_geometry", "GtkWindow*");
+ Xen_check_type(Xen_is_gchar_(geometry), geometry, 2, "gtk_window_parse_geometry", "gchar*");
+ return(C_to_Xen_gboolean(gtk_window_parse_geometry(Xen_to_C_GtkWindow_(window), Xen_to_C_gchar_(geometry))));
}
-static XEN gxg_gtk_tree_view_get_path_at_pos(XEN tree_view, XEN x, XEN y, XEN ignore_path, XEN ignore_column, XEN ignore_cell_x, XEN ignore_cell_y)
+static Xen gxg_pango_color_copy(Xen src)
{
- #define H_gtk_tree_view_get_path_at_pos "gboolean gtk_tree_view_get_path_at_pos(GtkTreeView* tree_view, \
-gint x, gint y, GtkTreePath** [path], GtkTreeViewColumn** [column], gint* [cell_x], gint* [cell_y])"
- GtkTreePath* ref_path = NULL;
- GtkTreeViewColumn* ref_column = NULL;
- gint ref_cell_x;
- gint ref_cell_y;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_path_at_pos", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_tree_view_get_path_at_pos", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_tree_view_get_path_at_pos", "gint");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_tree_view_get_path_at_pos(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(x), XEN_TO_C_gint(y),
- &ref_path, &ref_column, &ref_cell_x, &ref_cell_y));
- return(XEN_LIST_5(result, C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkTreeViewColumn_(ref_column), C_TO_XEN_gint(ref_cell_x), C_TO_XEN_gint(ref_cell_y)));
- }
+ #define H_pango_color_copy "PangoColor* pango_color_copy(PangoColor* src)"
+ Xen_check_type(Xen_is_PangoColor_(src), src, 1, "pango_color_copy", "PangoColor*");
+ return(C_to_Xen_PangoColor_(pango_color_copy(Xen_to_C_PangoColor_(src))));
}
-static XEN gxg_gtk_tree_view_get_cell_area(XEN tree_view, XEN path, XEN column, XEN rect)
+static Xen gxg_pango_color_free(Xen color)
{
- #define H_gtk_tree_view_get_cell_area "void gtk_tree_view_get_cell_area(GtkTreeView* tree_view, GtkTreePath* path, \
-GtkTreeViewColumn* column, GdkRectangle* rect)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_cell_area", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path) || XEN_FALSE_P(path), path, 2, "gtk_tree_view_get_cell_area", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column) || XEN_FALSE_P(column), column, 3, "gtk_tree_view_get_cell_area", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rect), rect, 4, "gtk_tree_view_get_cell_area", "GdkRectangle*");
- gtk_tree_view_get_cell_area(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeViewColumn_(column),
- XEN_TO_C_GdkRectangle_(rect));
- return(XEN_FALSE);
+ #define H_pango_color_free "void pango_color_free(PangoColor* color)"
+ Xen_check_type(Xen_is_PangoColor_(color), color, 1, "pango_color_free", "PangoColor*");
+ pango_color_free(Xen_to_C_PangoColor_(color));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_background_area(XEN tree_view, XEN path, XEN column, XEN rect)
+static Xen gxg_pango_color_parse(Xen color, Xen spec)
{
- #define H_gtk_tree_view_get_background_area "void gtk_tree_view_get_background_area(GtkTreeView* tree_view, \
-GtkTreePath* path, GtkTreeViewColumn* column, GdkRectangle* rect)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_background_area", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path) || XEN_FALSE_P(path), path, 2, "gtk_tree_view_get_background_area", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column) || XEN_FALSE_P(column), column, 3, "gtk_tree_view_get_background_area", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rect), rect, 4, "gtk_tree_view_get_background_area", "GdkRectangle*");
- gtk_tree_view_get_background_area(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeViewColumn_(column),
- XEN_TO_C_GdkRectangle_(rect));
- return(XEN_FALSE);
+ #define H_pango_color_parse "gboolean pango_color_parse(PangoColor* color, char* spec)"
+ Xen_check_type(Xen_is_PangoColor_(color), color, 1, "pango_color_parse", "PangoColor*");
+ Xen_check_type(Xen_is_char_(spec), spec, 2, "pango_color_parse", "char*");
+ return(C_to_Xen_gboolean(pango_color_parse(Xen_to_C_PangoColor_(color), Xen_to_C_char_(spec))));
}
-static XEN gxg_gtk_tree_view_get_visible_rect(XEN tree_view, XEN visible_rect)
+static Xen gxg_pango_attr_type_register(Xen name)
{
- #define H_gtk_tree_view_get_visible_rect "void gtk_tree_view_get_visible_rect(GtkTreeView* tree_view, \
-GdkRectangle* visible_rect)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_visible_rect", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(visible_rect), visible_rect, 2, "gtk_tree_view_get_visible_rect", "GdkRectangle*");
- gtk_tree_view_get_visible_rect(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GdkRectangle_(visible_rect));
- return(XEN_FALSE);
+ #define H_pango_attr_type_register "PangoAttrType pango_attr_type_register(gchar* name)"
+ Xen_check_type(Xen_is_gchar_(name), name, 1, "pango_attr_type_register", "gchar*");
+ return(C_to_Xen_PangoAttrType(pango_attr_type_register(Xen_to_C_gchar_(name))));
}
-static XEN gxg_gtk_tree_view_enable_model_drag_source(XEN tree_view, XEN start_button_mask, XEN targets, XEN n_targets, XEN actions)
+static Xen gxg_pango_attribute_copy(Xen attr)
{
- #define H_gtk_tree_view_enable_model_drag_source "void gtk_tree_view_enable_model_drag_source(GtkTreeView* tree_view, \
-GdkModifierType start_button_mask, GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_enable_model_drag_source", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(start_button_mask), start_button_mask, 2, "gtk_tree_view_enable_model_drag_source", "GdkModifierType");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 3, "gtk_tree_view_enable_model_drag_source", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 4, "gtk_tree_view_enable_model_drag_source", "gint");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 5, "gtk_tree_view_enable_model_drag_source", "GdkDragAction");
- gtk_tree_view_enable_model_drag_source(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GdkModifierType(start_button_mask), XEN_TO_C_GtkTargetEntry_(targets),
- XEN_TO_C_gint(n_targets), XEN_TO_C_GdkDragAction(actions));
- return(XEN_FALSE);
+ #define H_pango_attribute_copy "PangoAttribute* pango_attribute_copy(PangoAttribute* attr)"
+ Xen_check_type(Xen_is_PangoAttribute_(attr), attr, 1, "pango_attribute_copy", "PangoAttribute*");
+ return(C_to_Xen_PangoAttribute_(pango_attribute_copy(Xen_to_C_PangoAttribute_(attr))));
}
-static XEN gxg_gtk_tree_view_enable_model_drag_dest(XEN tree_view, XEN targets, XEN n_targets, XEN actions)
+static Xen gxg_pango_attribute_destroy(Xen attr)
{
- #define H_gtk_tree_view_enable_model_drag_dest "void gtk_tree_view_enable_model_drag_dest(GtkTreeView* tree_view, \
-GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_enable_model_drag_dest", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 2, "gtk_tree_view_enable_model_drag_dest", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 3, "gtk_tree_view_enable_model_drag_dest", "gint");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 4, "gtk_tree_view_enable_model_drag_dest", "GdkDragAction");
- gtk_tree_view_enable_model_drag_dest(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTargetEntry_(targets), XEN_TO_C_gint(n_targets),
- XEN_TO_C_GdkDragAction(actions));
- return(XEN_FALSE);
+ #define H_pango_attribute_destroy "void pango_attribute_destroy(PangoAttribute* attr)"
+ Xen_check_type(Xen_is_PangoAttribute_(attr), attr, 1, "pango_attribute_destroy", "PangoAttribute*");
+ pango_attribute_destroy(Xen_to_C_PangoAttribute_(attr));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_unset_rows_drag_source(XEN tree_view)
+static Xen gxg_pango_attribute_equal(Xen attr1, Xen attr2)
{
- #define H_gtk_tree_view_unset_rows_drag_source "void gtk_tree_view_unset_rows_drag_source(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_unset_rows_drag_source", "GtkTreeView*");
- gtk_tree_view_unset_rows_drag_source(XEN_TO_C_GtkTreeView_(tree_view));
- return(XEN_FALSE);
+ #define H_pango_attribute_equal "gboolean pango_attribute_equal(PangoAttribute* attr1, PangoAttribute* attr2)"
+ Xen_check_type(Xen_is_PangoAttribute_(attr1), attr1, 1, "pango_attribute_equal", "PangoAttribute*");
+ Xen_check_type(Xen_is_PangoAttribute_(attr2), attr2, 2, "pango_attribute_equal", "PangoAttribute*");
+ return(C_to_Xen_gboolean(pango_attribute_equal(Xen_to_C_PangoAttribute_(attr1), Xen_to_C_PangoAttribute_(attr2))));
}
-static XEN gxg_gtk_tree_view_unset_rows_drag_dest(XEN tree_view)
+static Xen gxg_pango_attr_language_new(Xen language)
{
- #define H_gtk_tree_view_unset_rows_drag_dest "void gtk_tree_view_unset_rows_drag_dest(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_unset_rows_drag_dest", "GtkTreeView*");
- gtk_tree_view_unset_rows_drag_dest(XEN_TO_C_GtkTreeView_(tree_view));
- return(XEN_FALSE);
+ #define H_pango_attr_language_new "PangoAttribute* pango_attr_language_new(PangoLanguage* language)"
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 1, "pango_attr_language_new", "PangoLanguage*");
+ return(C_to_Xen_PangoAttribute_(pango_attr_language_new(Xen_to_C_PangoLanguage_(language))));
}
-static XEN gxg_gtk_tree_view_set_drag_dest_row(XEN tree_view, XEN path, XEN pos)
+static Xen gxg_pango_attr_family_new(Xen family)
{
- #define H_gtk_tree_view_set_drag_dest_row "void gtk_tree_view_set_drag_dest_row(GtkTreeView* tree_view, \
-GtkTreePath* path, GtkTreeViewDropPosition pos)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_drag_dest_row", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_set_drag_dest_row", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewDropPosition_P(pos), pos, 3, "gtk_tree_view_set_drag_dest_row", "GtkTreeViewDropPosition");
- gtk_tree_view_set_drag_dest_row(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeViewDropPosition(pos));
- return(XEN_FALSE);
+ #define H_pango_attr_family_new "PangoAttribute* pango_attr_family_new(char* family)"
+ Xen_check_type(Xen_is_char_(family), family, 1, "pango_attr_family_new", "char*");
+ return(C_to_Xen_PangoAttribute_(pango_attr_family_new(Xen_to_C_char_(family))));
}
-static XEN gxg_gtk_tree_view_get_drag_dest_row(XEN tree_view, XEN ignore_path, XEN ignore_pos)
+static Xen gxg_pango_attr_foreground_new(Xen red, Xen green, Xen blue)
{
- #define H_gtk_tree_view_get_drag_dest_row "void gtk_tree_view_get_drag_dest_row(GtkTreeView* tree_view, \
-GtkTreePath** [path], GtkTreeViewDropPosition* [pos])"
- GtkTreePath* ref_path = NULL;
- GtkTreeViewDropPosition ref_pos;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_drag_dest_row", "GtkTreeView*");
- gtk_tree_view_get_drag_dest_row(XEN_TO_C_GtkTreeView_(tree_view), &ref_path, &ref_pos);
- return(XEN_LIST_2(C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkTreeViewDropPosition(ref_pos)));
+ #define H_pango_attr_foreground_new "PangoAttribute* pango_attr_foreground_new(guint16 red, guint16 green, \
+guint16 blue)"
+ Xen_check_type(Xen_is_guint16(red), red, 1, "pango_attr_foreground_new", "guint16");
+ Xen_check_type(Xen_is_guint16(green), green, 2, "pango_attr_foreground_new", "guint16");
+ Xen_check_type(Xen_is_guint16(blue), blue, 3, "pango_attr_foreground_new", "guint16");
+ return(C_to_Xen_PangoAttribute_(pango_attr_foreground_new(Xen_to_C_guint16(red), Xen_to_C_guint16(green), Xen_to_C_guint16(blue))));
}
-static XEN gxg_gtk_tree_view_get_dest_row_at_pos(XEN tree_view, XEN drag_x, XEN drag_y, XEN ignore_path, XEN ignore_pos)
+static Xen gxg_pango_attr_background_new(Xen red, Xen green, Xen blue)
{
- #define H_gtk_tree_view_get_dest_row_at_pos "gboolean gtk_tree_view_get_dest_row_at_pos(GtkTreeView* tree_view, \
-gint drag_x, gint drag_y, GtkTreePath** [path], GtkTreeViewDropPosition* [pos])"
- GtkTreePath* ref_path = NULL;
- GtkTreeViewDropPosition ref_pos;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_dest_row_at_pos", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(drag_x), drag_x, 2, "gtk_tree_view_get_dest_row_at_pos", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(drag_y), drag_y, 3, "gtk_tree_view_get_dest_row_at_pos", "gint");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_tree_view_get_dest_row_at_pos(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(drag_x),
- XEN_TO_C_gint(drag_y), &ref_path, &ref_pos));
- return(XEN_LIST_3(result, C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkTreeViewDropPosition(ref_pos)));
- }
+ #define H_pango_attr_background_new "PangoAttribute* pango_attr_background_new(guint16 red, guint16 green, \
+guint16 blue)"
+ Xen_check_type(Xen_is_guint16(red), red, 1, "pango_attr_background_new", "guint16");
+ Xen_check_type(Xen_is_guint16(green), green, 2, "pango_attr_background_new", "guint16");
+ Xen_check_type(Xen_is_guint16(blue), blue, 3, "pango_attr_background_new", "guint16");
+ return(C_to_Xen_PangoAttribute_(pango_attr_background_new(Xen_to_C_guint16(red), Xen_to_C_guint16(green), Xen_to_C_guint16(blue))));
}
-static XEN gxg_gtk_tree_view_set_enable_search(XEN tree_view, XEN enable_search)
+static Xen gxg_pango_attr_size_new(Xen size)
{
- #define H_gtk_tree_view_set_enable_search "void gtk_tree_view_set_enable_search(GtkTreeView* tree_view, \
-gboolean enable_search)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_enable_search", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(enable_search), enable_search, 2, "gtk_tree_view_set_enable_search", "gboolean");
- gtk_tree_view_set_enable_search(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(enable_search));
- return(XEN_FALSE);
+ #define H_pango_attr_size_new "PangoAttribute* pango_attr_size_new(int size)"
+ Xen_check_type(Xen_is_int(size), size, 1, "pango_attr_size_new", "int");
+ return(C_to_Xen_PangoAttribute_(pango_attr_size_new(Xen_to_C_int(size))));
}
-static XEN gxg_gtk_tree_view_get_enable_search(XEN tree_view)
+static Xen gxg_pango_attr_style_new(Xen style)
{
- #define H_gtk_tree_view_get_enable_search "gboolean gtk_tree_view_get_enable_search(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_enable_search", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_enable_search(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_pango_attr_style_new "PangoAttribute* pango_attr_style_new(PangoStyle style)"
+ Xen_check_type(Xen_is_PangoStyle(style), style, 1, "pango_attr_style_new", "PangoStyle");
+ return(C_to_Xen_PangoAttribute_(pango_attr_style_new(Xen_to_C_PangoStyle(style))));
}
-static XEN gxg_gtk_tree_view_get_search_column(XEN tree_view)
+static Xen gxg_pango_attr_weight_new(Xen weight)
{
- #define H_gtk_tree_view_get_search_column "gint gtk_tree_view_get_search_column(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_search_column", "GtkTreeView*");
- return(C_TO_XEN_gint(gtk_tree_view_get_search_column(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_pango_attr_weight_new "PangoAttribute* pango_attr_weight_new(PangoWeight weight)"
+ Xen_check_type(Xen_is_PangoWeight(weight), weight, 1, "pango_attr_weight_new", "PangoWeight");
+ return(C_to_Xen_PangoAttribute_(pango_attr_weight_new(Xen_to_C_PangoWeight(weight))));
}
-static XEN gxg_gtk_tree_view_set_search_column(XEN tree_view, XEN column)
+static Xen gxg_pango_attr_variant_new(Xen variant)
{
- #define H_gtk_tree_view_set_search_column "void gtk_tree_view_set_search_column(GtkTreeView* tree_view, \
-gint column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_search_column", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 2, "gtk_tree_view_set_search_column", "gint");
- gtk_tree_view_set_search_column(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_pango_attr_variant_new "PangoAttribute* pango_attr_variant_new(PangoVariant variant)"
+ Xen_check_type(Xen_is_PangoVariant(variant), variant, 1, "pango_attr_variant_new", "PangoVariant");
+ return(C_to_Xen_PangoAttribute_(pango_attr_variant_new(Xen_to_C_PangoVariant(variant))));
}
-static XEN gxg_gtk_tree_view_get_search_equal_func(XEN tree_view)
+static Xen gxg_pango_attr_stretch_new(Xen stretch)
{
- #define H_gtk_tree_view_get_search_equal_func "GtkTreeViewSearchEqualFunc gtk_tree_view_get_search_equal_func(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_search_equal_func", "GtkTreeView*");
- return(C_TO_XEN_GtkTreeViewSearchEqualFunc(gtk_tree_view_get_search_equal_func(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_pango_attr_stretch_new "PangoAttribute* pango_attr_stretch_new(PangoStretch stretch)"
+ Xen_check_type(Xen_is_PangoStretch(stretch), stretch, 1, "pango_attr_stretch_new", "PangoStretch");
+ return(C_to_Xen_PangoAttribute_(pango_attr_stretch_new(Xen_to_C_PangoStretch(stretch))));
}
-static XEN gxg_gtk_tree_view_set_search_equal_func(XEN tree_view, XEN func, XEN func_info, XEN search_destroy)
+static Xen gxg_pango_attr_font_desc_new(Xen desc)
{
- #define H_gtk_tree_view_set_search_equal_func "void gtk_tree_view_set_search_equal_func(GtkTreeView* tree_view, \
-GtkTreeViewSearchEqualFunc func, lambda_data func_info, GtkDestroyNotify search_destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_search_equal_func", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewSearchEqualFunc_P(func), func, 2, "gtk_tree_view_set_search_equal_func", "GtkTreeViewSearchEqualFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_view_set_search_equal_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(search_destroy), search_destroy, 4, "gtk_tree_view_set_search_equal_func", "GtkDestroyNotify");
- {
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- XEN_LIST_SET(gxg_ptr, 3, search_destroy);
- gtk_tree_view_set_search_equal_func(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewSearchEqualFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GtkDestroyNotify(search_destroy));
- xm_unprotect_at(loc);
- return(XEN_FALSE);
- }
+ #define H_pango_attr_font_desc_new "PangoAttribute* pango_attr_font_desc_new(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_attr_font_desc_new", "PangoFontDescription*");
+ return(C_to_Xen_PangoAttribute_(pango_attr_font_desc_new(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_vbutton_box_new(void)
+static Xen gxg_pango_attr_underline_new(Xen underline)
{
- #define H_gtk_vbutton_box_new "GtkWidget* gtk_vbutton_box_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_vbutton_box_new()));
+ #define H_pango_attr_underline_new "PangoAttribute* pango_attr_underline_new(PangoUnderline underline)"
+ Xen_check_type(Xen_is_PangoUnderline(underline), underline, 1, "pango_attr_underline_new", "PangoUnderline");
+ return(C_to_Xen_PangoAttribute_(pango_attr_underline_new(Xen_to_C_PangoUnderline(underline))));
}
-static XEN gxg_gtk_viewport_new(XEN hadjustment, XEN vadjustment)
+static Xen gxg_pango_attr_strikethrough_new(Xen strikethrough)
{
- #define H_gtk_viewport_new "GtkWidget* gtk_viewport_new(GtkAdjustment* hadjustment, GtkAdjustment* vadjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(hadjustment) || XEN_FALSE_P(hadjustment), hadjustment, 1, "gtk_viewport_new", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(vadjustment) || XEN_FALSE_P(vadjustment), vadjustment, 2, "gtk_viewport_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_viewport_new(XEN_TO_C_GtkAdjustment_(hadjustment), XEN_TO_C_GtkAdjustment_(vadjustment))));
+ #define H_pango_attr_strikethrough_new "PangoAttribute* pango_attr_strikethrough_new(gboolean strikethrough)"
+ Xen_check_type(Xen_is_gboolean(strikethrough), strikethrough, 1, "pango_attr_strikethrough_new", "gboolean");
+ return(C_to_Xen_PangoAttribute_(pango_attr_strikethrough_new(Xen_to_C_gboolean(strikethrough))));
}
-static XEN gxg_gtk_viewport_set_shadow_type(XEN viewport, XEN type)
+static Xen gxg_pango_attr_rise_new(Xen rise)
{
- #define H_gtk_viewport_set_shadow_type "void gtk_viewport_set_shadow_type(GtkViewport* viewport, GtkShadowType type)"
- XEN_ASSERT_TYPE(XEN_GtkViewport__P(viewport), viewport, 1, "gtk_viewport_set_shadow_type", "GtkViewport*");
- XEN_ASSERT_TYPE(XEN_GtkShadowType_P(type), type, 2, "gtk_viewport_set_shadow_type", "GtkShadowType");
- gtk_viewport_set_shadow_type(XEN_TO_C_GtkViewport_(viewport), XEN_TO_C_GtkShadowType(type));
- return(XEN_FALSE);
+ #define H_pango_attr_rise_new "PangoAttribute* pango_attr_rise_new(int rise)"
+ Xen_check_type(Xen_is_int(rise), rise, 1, "pango_attr_rise_new", "int");
+ return(C_to_Xen_PangoAttribute_(pango_attr_rise_new(Xen_to_C_int(rise))));
}
-static XEN gxg_gtk_viewport_get_shadow_type(XEN viewport)
+static Xen gxg_pango_attr_shape_new(Xen ink_rect, Xen logical_rect)
{
- #define H_gtk_viewport_get_shadow_type "GtkShadowType gtk_viewport_get_shadow_type(GtkViewport* viewport)"
- XEN_ASSERT_TYPE(XEN_GtkViewport__P(viewport), viewport, 1, "gtk_viewport_get_shadow_type", "GtkViewport*");
- return(C_TO_XEN_GtkShadowType(gtk_viewport_get_shadow_type(XEN_TO_C_GtkViewport_(viewport))));
+ #define H_pango_attr_shape_new "PangoAttribute* pango_attr_shape_new(PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 1, "pango_attr_shape_new", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 2, "pango_attr_shape_new", "PangoRectangle*");
+ return(C_to_Xen_PangoAttribute_(pango_attr_shape_new(Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect))));
}
-static XEN gxg_gtk_vpaned_new(void)
+static Xen gxg_pango_attr_scale_new(Xen scale_factor)
{
- #define H_gtk_vpaned_new "GtkWidget* gtk_vpaned_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_vpaned_new()));
+ #define H_pango_attr_scale_new "PangoAttribute* pango_attr_scale_new(double scale_factor)"
+ Xen_check_type(Xen_is_double(scale_factor), scale_factor, 1, "pango_attr_scale_new", "double");
+ return(C_to_Xen_PangoAttribute_(pango_attr_scale_new(Xen_to_C_double(scale_factor))));
}
-static XEN gxg_gtk_vscale_new(XEN adjustment)
+static Xen gxg_pango_attr_list_new(void)
{
- #define H_gtk_vscale_new "GtkWidget* gtk_vscale_new(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment) || XEN_FALSE_P(adjustment), adjustment, 1, "gtk_vscale_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_vscale_new(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_pango_attr_list_new "PangoAttrList* pango_attr_list_new( void)"
+ return(C_to_Xen_PangoAttrList_(pango_attr_list_new()));
}
-static XEN gxg_gtk_vscale_new_with_range(XEN min, XEN max, XEN step)
+static Xen gxg_pango_attr_list_unref(Xen list)
{
- #define H_gtk_vscale_new_with_range "GtkWidget* gtk_vscale_new_with_range(gdouble min, gdouble max, \
-gdouble step)"
- XEN_ASSERT_TYPE(XEN_gdouble_P(min), min, 1, "gtk_vscale_new_with_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(max), max, 2, "gtk_vscale_new_with_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step), step, 3, "gtk_vscale_new_with_range", "gdouble");
- return(C_TO_XEN_GtkWidget_(gtk_vscale_new_with_range(XEN_TO_C_gdouble(min), XEN_TO_C_gdouble(max), XEN_TO_C_gdouble(step))));
+ #define H_pango_attr_list_unref "void pango_attr_list_unref(PangoAttrList* list)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_unref", "PangoAttrList*");
+ pango_attr_list_unref(Xen_to_C_PangoAttrList_(list));
+ return(Xen_false);
}
-static XEN gxg_gtk_vscrollbar_new(XEN adjustment)
+static Xen gxg_pango_attr_list_copy(Xen list)
{
- #define H_gtk_vscrollbar_new "GtkWidget* gtk_vscrollbar_new(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment) || XEN_FALSE_P(adjustment), adjustment, 1, "gtk_vscrollbar_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_vscrollbar_new(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_pango_attr_list_copy "PangoAttrList* pango_attr_list_copy(PangoAttrList* list)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_copy", "PangoAttrList*");
+ return(C_to_Xen_PangoAttrList_(pango_attr_list_copy(Xen_to_C_PangoAttrList_(list))));
}
-static XEN gxg_gtk_vseparator_new(void)
+static Xen gxg_pango_attr_list_insert(Xen list, Xen attr)
{
- #define H_gtk_vseparator_new "GtkWidget* gtk_vseparator_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_vseparator_new()));
+ #define H_pango_attr_list_insert "void pango_attr_list_insert(PangoAttrList* list, PangoAttribute* attr)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_insert", "PangoAttrList*");
+ Xen_check_type(Xen_is_PangoAttribute_(attr), attr, 2, "pango_attr_list_insert", "PangoAttribute*");
+ pango_attr_list_insert(Xen_to_C_PangoAttrList_(list), Xen_to_C_PangoAttribute_(attr));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_destroy(XEN widget)
+static Xen gxg_pango_attr_list_insert_before(Xen list, Xen attr)
{
- #define H_gtk_widget_destroy "void gtk_widget_destroy(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_destroy", "GtkWidget*");
- gtk_widget_destroy(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_list_insert_before "void pango_attr_list_insert_before(PangoAttrList* list, PangoAttribute* attr)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_insert_before", "PangoAttrList*");
+ Xen_check_type(Xen_is_PangoAttribute_(attr), attr, 2, "pango_attr_list_insert_before", "PangoAttribute*");
+ pango_attr_list_insert_before(Xen_to_C_PangoAttrList_(list), Xen_to_C_PangoAttribute_(attr));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_destroyed(XEN widget, XEN ignore_widget_pointer)
+static Xen gxg_pango_attr_list_change(Xen list, Xen attr)
{
- #define H_gtk_widget_destroyed "void gtk_widget_destroyed(GtkWidget* widget, GtkWidget** [widget_pointer])"
- GtkWidget* ref_widget_pointer = NULL;
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_destroyed", "GtkWidget*");
- gtk_widget_destroyed(XEN_TO_C_GtkWidget_(widget), &ref_widget_pointer);
- return(XEN_LIST_1(C_TO_XEN_GtkWidget_(ref_widget_pointer)));
+ #define H_pango_attr_list_change "void pango_attr_list_change(PangoAttrList* list, PangoAttribute* attr)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_change", "PangoAttrList*");
+ Xen_check_type(Xen_is_PangoAttribute_(attr), attr, 2, "pango_attr_list_change", "PangoAttribute*");
+ pango_attr_list_change(Xen_to_C_PangoAttrList_(list), Xen_to_C_PangoAttribute_(attr));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_unparent(XEN widget)
+static Xen gxg_pango_attr_list_splice(Xen list, Xen other, Xen pos, Xen len)
{
- #define H_gtk_widget_unparent "void gtk_widget_unparent(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_unparent", "GtkWidget*");
- gtk_widget_unparent(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_list_splice "void pango_attr_list_splice(PangoAttrList* list, PangoAttrList* other, \
+gint pos, gint len)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_splice", "PangoAttrList*");
+ Xen_check_type(Xen_is_PangoAttrList_(other), other, 2, "pango_attr_list_splice", "PangoAttrList*");
+ Xen_check_type(Xen_is_gint(pos), pos, 3, "pango_attr_list_splice", "gint");
+ Xen_check_type(Xen_is_gint(len), len, 4, "pango_attr_list_splice", "gint");
+ pango_attr_list_splice(Xen_to_C_PangoAttrList_(list), Xen_to_C_PangoAttrList_(other), Xen_to_C_gint(pos), Xen_to_C_gint(len));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_show(XEN widget)
+static Xen gxg_pango_attr_list_get_iterator(Xen list)
{
- #define H_gtk_widget_show "void gtk_widget_show(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_show", "GtkWidget*");
- gtk_widget_show(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_list_get_iterator "PangoAttrIterator* pango_attr_list_get_iterator(PangoAttrList* list)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_get_iterator", "PangoAttrList*");
+ return(C_to_Xen_PangoAttrIterator_(pango_attr_list_get_iterator(Xen_to_C_PangoAttrList_(list))));
}
-static XEN gxg_gtk_widget_show_now(XEN widget)
+static Xen gxg_pango_attr_iterator_range(Xen iterator, Xen ignore_start, Xen ignore_end)
{
- #define H_gtk_widget_show_now "void gtk_widget_show_now(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_show_now", "GtkWidget*");
- gtk_widget_show_now(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_iterator_range "void pango_attr_iterator_range(PangoAttrIterator* iterator, gint* [start], \
+gint* [end])"
+ gint ref_start;
+ gint ref_end;
+ Xen_check_type(Xen_is_PangoAttrIterator_(iterator), iterator, 1, "pango_attr_iterator_range", "PangoAttrIterator*");
+ pango_attr_iterator_range(Xen_to_C_PangoAttrIterator_(iterator), &ref_start, &ref_end);
+ return(Xen_list_2(C_to_Xen_gint(ref_start), C_to_Xen_gint(ref_end)));
}
-static XEN gxg_gtk_widget_hide(XEN widget)
+static Xen gxg_pango_attr_iterator_next(Xen iterator)
{
- #define H_gtk_widget_hide "void gtk_widget_hide(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_hide", "GtkWidget*");
- gtk_widget_hide(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_iterator_next "gboolean pango_attr_iterator_next(PangoAttrIterator* iterator)"
+ Xen_check_type(Xen_is_PangoAttrIterator_(iterator), iterator, 1, "pango_attr_iterator_next", "PangoAttrIterator*");
+ return(C_to_Xen_gboolean(pango_attr_iterator_next(Xen_to_C_PangoAttrIterator_(iterator))));
}
-static XEN gxg_gtk_widget_show_all(XEN widget)
+static Xen gxg_pango_attr_iterator_copy(Xen iterator)
{
- #define H_gtk_widget_show_all "void gtk_widget_show_all(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_show_all", "GtkWidget*");
- gtk_widget_show_all(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_iterator_copy "PangoAttrIterator* pango_attr_iterator_copy(PangoAttrIterator* iterator)"
+ Xen_check_type(Xen_is_PangoAttrIterator_(iterator), iterator, 1, "pango_attr_iterator_copy", "PangoAttrIterator*");
+ return(C_to_Xen_PangoAttrIterator_(pango_attr_iterator_copy(Xen_to_C_PangoAttrIterator_(iterator))));
}
-static XEN gxg_gtk_widget_map(XEN widget)
+static Xen gxg_pango_attr_iterator_destroy(Xen iterator)
{
- #define H_gtk_widget_map "void gtk_widget_map(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_map", "GtkWidget*");
- gtk_widget_map(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_iterator_destroy "void pango_attr_iterator_destroy(PangoAttrIterator* iterator)"
+ Xen_check_type(Xen_is_PangoAttrIterator_(iterator), iterator, 1, "pango_attr_iterator_destroy", "PangoAttrIterator*");
+ pango_attr_iterator_destroy(Xen_to_C_PangoAttrIterator_(iterator));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_unmap(XEN widget)
+static Xen gxg_pango_attr_iterator_get(Xen iterator, Xen type)
{
- #define H_gtk_widget_unmap "void gtk_widget_unmap(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_unmap", "GtkWidget*");
- gtk_widget_unmap(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_iterator_get "PangoAttribute* pango_attr_iterator_get(PangoAttrIterator* iterator, \
+PangoAttrType type)"
+ Xen_check_type(Xen_is_PangoAttrIterator_(iterator), iterator, 1, "pango_attr_iterator_get", "PangoAttrIterator*");
+ Xen_check_type(Xen_is_PangoAttrType(type), type, 2, "pango_attr_iterator_get", "PangoAttrType");
+ return(C_to_Xen_PangoAttribute_(pango_attr_iterator_get(Xen_to_C_PangoAttrIterator_(iterator), Xen_to_C_PangoAttrType(type))));
}
-static XEN gxg_gtk_widget_realize(XEN widget)
+static Xen gxg_pango_attr_iterator_get_font(Xen iterator, Xen desc, Xen ignore_language, Xen ignore_extra_attrs)
{
- #define H_gtk_widget_realize "void gtk_widget_realize(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_realize", "GtkWidget*");
- gtk_widget_realize(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_attr_iterator_get_font "void pango_attr_iterator_get_font(PangoAttrIterator* iterator, \
+PangoFontDescription* desc, PangoLanguage** [language], GSList** [extra_attrs])"
+ PangoLanguage* ref_language = NULL;
+ GSList* ref_extra_attrs = NULL;
+ Xen_check_type(Xen_is_PangoAttrIterator_(iterator), iterator, 1, "pango_attr_iterator_get_font", "PangoAttrIterator*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 2, "pango_attr_iterator_get_font", "PangoFontDescription*");
+ pango_attr_iterator_get_font(Xen_to_C_PangoAttrIterator_(iterator), Xen_to_C_PangoFontDescription_(desc), &ref_language,
+ &ref_extra_attrs);
+ return(Xen_list_2(C_to_Xen_PangoLanguage_(ref_language), C_to_Xen_GSList_(ref_extra_attrs)));
}
-static XEN gxg_gtk_widget_unrealize(XEN widget)
+static Xen gxg_pango_parse_markup(Xen markup_text, Xen length, Xen accel_marker, Xen attr_list, Xen text, Xen accel_char, Xen ignore_error)
{
- #define H_gtk_widget_unrealize "void gtk_widget_unrealize(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_unrealize", "GtkWidget*");
- gtk_widget_unrealize(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_parse_markup "gboolean pango_parse_markup(char* markup_text, int length, gunichar accel_marker, \
+PangoAttrList** attr_list, char** text, gunichar* accel_char, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_char_(markup_text), markup_text, 1, "pango_parse_markup", "char*");
+ Xen_check_type(Xen_is_int(length), length, 2, "pango_parse_markup", "int");
+ Xen_check_type(Xen_is_gunichar(accel_marker), accel_marker, 3, "pango_parse_markup", "gunichar");
+ Xen_check_type(Xen_is_PangoAttrList__(attr_list), attr_list, 4, "pango_parse_markup", "PangoAttrList**");
+ Xen_check_type(Xen_is_char__(text), text, 5, "pango_parse_markup", "char**");
+ Xen_check_type(Xen_is_gunichar_(accel_char), accel_char, 6, "pango_parse_markup", "gunichar*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(pango_parse_markup(Xen_to_C_char_(markup_text), Xen_to_C_int(length), Xen_to_C_gunichar(accel_marker),
+ Xen_to_C_PangoAttrList__(attr_list), Xen_to_C_char__(text), Xen_to_C_gunichar_(accel_char),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_widget_queue_draw(XEN widget)
+static Xen gxg_pango_break(Xen text, Xen length, Xen analysis, Xen attrs, Xen attrs_len)
{
- #define H_gtk_widget_queue_draw "void gtk_widget_queue_draw(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_queue_draw", "GtkWidget*");
- gtk_widget_queue_draw(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_break "void pango_break(gchar* text, int length, PangoAnalysis* analysis, PangoLogAttr* attrs, \
+int attrs_len)"
+ Xen_check_type(Xen_is_gchar_(text), text, 1, "pango_break", "gchar*");
+ Xen_check_type(Xen_is_int(length), length, 2, "pango_break", "int");
+ Xen_check_type(Xen_is_PangoAnalysis_(analysis), analysis, 3, "pango_break", "PangoAnalysis*");
+ Xen_check_type(Xen_is_PangoLogAttr_(attrs), attrs, 4, "pango_break", "PangoLogAttr*");
+ Xen_check_type(Xen_is_int(attrs_len), attrs_len, 5, "pango_break", "int");
+ pango_break(Xen_to_C_gchar_(text), Xen_to_C_int(length), Xen_to_C_PangoAnalysis_(analysis), Xen_to_C_PangoLogAttr_(attrs),
+ Xen_to_C_int(attrs_len));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_queue_draw_area(XEN widget, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_pango_find_paragraph_boundary(Xen text, Xen length, Xen ignore_paragraph_delimiter_index, Xen ignore_next_paragraph_start)
{
- #define H_gtk_widget_queue_draw_area "void gtk_widget_queue_draw_area(GtkWidget* widget, gint x, gint y, \
-gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_queue_draw_area", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_widget_queue_draw_area", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_widget_queue_draw_area", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 4, "gtk_widget_queue_draw_area", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 5, "gtk_widget_queue_draw_area", "gint");
- gtk_widget_queue_draw_area(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(x), XEN_TO_C_gint(y), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_pango_find_paragraph_boundary "void pango_find_paragraph_boundary(gchar* text, gint length, \
+gint* [paragraph_delimiter_index], gint* [next_paragraph_start])"
+ gint ref_paragraph_delimiter_index;
+ gint ref_next_paragraph_start;
+ Xen_check_type(Xen_is_gchar_(text), text, 1, "pango_find_paragraph_boundary", "gchar*");
+ Xen_check_type(Xen_is_gint(length), length, 2, "pango_find_paragraph_boundary", "gint");
+ pango_find_paragraph_boundary(Xen_to_C_gchar_(text), Xen_to_C_gint(length), &ref_paragraph_delimiter_index, &ref_next_paragraph_start);
+ return(Xen_list_2(C_to_Xen_gint(ref_paragraph_delimiter_index), C_to_Xen_gint(ref_next_paragraph_start)));
}
-static XEN gxg_gtk_widget_queue_resize(XEN widget)
+static Xen gxg_pango_get_log_attrs(Xen text, Xen length, Xen level, Xen language, Xen log_attrs, Xen attrs_len)
{
- #define H_gtk_widget_queue_resize "void gtk_widget_queue_resize(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_queue_resize", "GtkWidget*");
- gtk_widget_queue_resize(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_get_log_attrs "void pango_get_log_attrs(char* text, int length, int level, PangoLanguage* language, \
+PangoLogAttr* log_attrs, int attrs_len)"
+ Xen_check_type(Xen_is_char_(text), text, 1, "pango_get_log_attrs", "char*");
+ Xen_check_type(Xen_is_int(length), length, 2, "pango_get_log_attrs", "int");
+ Xen_check_type(Xen_is_int(level), level, 3, "pango_get_log_attrs", "int");
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 4, "pango_get_log_attrs", "PangoLanguage*");
+ Xen_check_type(Xen_is_PangoLogAttr_(log_attrs), log_attrs, 5, "pango_get_log_attrs", "PangoLogAttr*");
+ Xen_check_type(Xen_is_int(attrs_len), attrs_len, 6, "pango_get_log_attrs", "int");
+ pango_get_log_attrs(Xen_to_C_char_(text), Xen_to_C_int(length), Xen_to_C_int(level), Xen_to_C_PangoLanguage_(language),
+ Xen_to_C_PangoLogAttr_(log_attrs), Xen_to_C_int(attrs_len));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_size_allocate(XEN widget, XEN allocation)
+static Xen gxg_pango_context_list_families(Xen context, Xen ignore_families, Xen ignore_n_families)
{
- #define H_gtk_widget_size_allocate "void gtk_widget_size_allocate(GtkWidget* widget, GtkAllocation* allocation)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_size_allocate", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkAllocation__P(allocation), allocation, 2, "gtk_widget_size_allocate", "GtkAllocation*");
- gtk_widget_size_allocate(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkAllocation_(allocation));
- return(XEN_FALSE);
+ #define H_pango_context_list_families "void pango_context_list_families(PangoContext* context, PangoFontFamily*** [families], \
+int* [n_families])"
+ PangoFontFamily** ref_families = NULL;
+ int ref_n_families;
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_list_families", "PangoContext*");
+ pango_context_list_families(Xen_to_C_PangoContext_(context), &ref_families, &ref_n_families);
+ return(Xen_list_2(C_to_Xen_PangoFontFamily__(ref_families), C_to_Xen_int(ref_n_families)));
}
-static XEN gxg_gtk_widget_add_accelerator(XEN widget, XEN accel_signal, XEN accel_group, XEN accel_key, XEN accel_mods, XEN accel_flags)
+static Xen gxg_pango_context_load_font(Xen context, Xen desc)
{
- #define H_gtk_widget_add_accelerator "void gtk_widget_add_accelerator(GtkWidget* widget, gchar* accel_signal, \
-GtkAccelGroup* accel_group, guint accel_key, GdkModifierType accel_mods, GtkAccelFlags accel_flags)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_add_accelerator", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_signal), accel_signal, 2, "gtk_widget_add_accelerator", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 3, "gtk_widget_add_accelerator", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 4, "gtk_widget_add_accelerator", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 5, "gtk_widget_add_accelerator", "GdkModifierType");
- XEN_ASSERT_TYPE(XEN_GtkAccelFlags_P(accel_flags), accel_flags, 6, "gtk_widget_add_accelerator", "GtkAccelFlags");
- gtk_widget_add_accelerator(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(accel_signal), XEN_TO_C_GtkAccelGroup_(accel_group),
- XEN_TO_C_guint(accel_key), XEN_TO_C_GdkModifierType(accel_mods), XEN_TO_C_GtkAccelFlags(accel_flags));
- return(XEN_FALSE);
+ #define H_pango_context_load_font "PangoFont* pango_context_load_font(PangoContext* context, PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_load_font", "PangoContext*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 2, "pango_context_load_font", "PangoFontDescription*");
+ return(C_to_Xen_PangoFont_(pango_context_load_font(Xen_to_C_PangoContext_(context), Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_remove_accelerator(XEN widget, XEN accel_group, XEN accel_key, XEN accel_mods)
+static Xen gxg_pango_context_load_fontset(Xen context, Xen desc, Xen language)
{
- #define H_gtk_widget_remove_accelerator "gboolean gtk_widget_remove_accelerator(GtkWidget* widget, \
-GtkAccelGroup* accel_group, guint accel_key, GdkModifierType accel_mods)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_remove_accelerator", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 2, "gtk_widget_remove_accelerator", "GtkAccelGroup*");
- XEN_ASSERT_TYPE(XEN_guint_P(accel_key), accel_key, 3, "gtk_widget_remove_accelerator", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accel_mods), accel_mods, 4, "gtk_widget_remove_accelerator", "GdkModifierType");
- return(C_TO_XEN_gboolean(gtk_widget_remove_accelerator(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkAccelGroup_(accel_group),
- XEN_TO_C_guint(accel_key), XEN_TO_C_GdkModifierType(accel_mods))));
+ #define H_pango_context_load_fontset "PangoFontset* pango_context_load_fontset(PangoContext* context, \
+PangoFontDescription* desc, PangoLanguage* language)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_load_fontset", "PangoContext*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 2, "pango_context_load_fontset", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 3, "pango_context_load_fontset", "PangoLanguage*");
+ return(C_to_Xen_PangoFontset_(pango_context_load_fontset(Xen_to_C_PangoContext_(context), Xen_to_C_PangoFontDescription_(desc),
+ Xen_to_C_PangoLanguage_(language))));
}
-static XEN gxg_gtk_widget_list_accel_closures(XEN widget)
+static Xen gxg_pango_context_get_metrics(Xen context, Xen desc, Xen language)
{
- #define H_gtk_widget_list_accel_closures "GList* gtk_widget_list_accel_closures(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_list_accel_closures", "GtkWidget*");
- return(C_TO_XEN_GList_(gtk_widget_list_accel_closures(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_context_get_metrics "PangoFontMetrics* pango_context_get_metrics(PangoContext* context, \
+PangoFontDescription* desc, PangoLanguage* language)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_get_metrics", "PangoContext*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 2, "pango_context_get_metrics", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 3, "pango_context_get_metrics", "PangoLanguage*");
+ return(C_to_Xen_PangoFontMetrics_(pango_context_get_metrics(Xen_to_C_PangoContext_(context), Xen_to_C_PangoFontDescription_(desc),
+ Xen_to_C_PangoLanguage_(language))));
}
-static XEN gxg_gtk_widget_mnemonic_activate(XEN widget, XEN group_cycling)
+static Xen gxg_pango_context_set_font_description(Xen context, Xen desc)
{
- #define H_gtk_widget_mnemonic_activate "gboolean gtk_widget_mnemonic_activate(GtkWidget* widget, gboolean group_cycling)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_mnemonic_activate", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(group_cycling), group_cycling, 2, "gtk_widget_mnemonic_activate", "gboolean");
- return(C_TO_XEN_gboolean(gtk_widget_mnemonic_activate(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(group_cycling))));
+ #define H_pango_context_set_font_description "void pango_context_set_font_description(PangoContext* context, \
+PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_set_font_description", "PangoContext*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 2, "pango_context_set_font_description", "PangoFontDescription*");
+ pango_context_set_font_description(Xen_to_C_PangoContext_(context), Xen_to_C_PangoFontDescription_(desc));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_event(XEN widget, XEN event)
+static Xen gxg_pango_context_get_font_description(Xen context)
{
- #define H_gtk_widget_event "gboolean gtk_widget_event(GtkWidget* widget, GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_event", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 2, "gtk_widget_event", "GdkEvent*");
- return(C_TO_XEN_gboolean(gtk_widget_event(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkEvent_(event))));
+ #define H_pango_context_get_font_description "PangoFontDescription* pango_context_get_font_description(PangoContext* context)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_get_font_description", "PangoContext*");
+ return(C_to_Xen_PangoFontDescription_(pango_context_get_font_description(Xen_to_C_PangoContext_(context))));
}
-static XEN gxg_gtk_widget_send_expose(XEN widget, XEN event)
+static Xen gxg_pango_context_get_language(Xen context)
{
- #define H_gtk_widget_send_expose "gint gtk_widget_send_expose(GtkWidget* widget, GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_send_expose", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 2, "gtk_widget_send_expose", "GdkEvent*");
- return(C_TO_XEN_gint(gtk_widget_send_expose(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkEvent_(event))));
+ #define H_pango_context_get_language "PangoLanguage* pango_context_get_language(PangoContext* context)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_get_language", "PangoContext*");
+ return(C_to_Xen_PangoLanguage_(pango_context_get_language(Xen_to_C_PangoContext_(context))));
}
-static XEN gxg_gtk_widget_activate(XEN widget)
+static Xen gxg_pango_context_set_language(Xen context, Xen language)
{
- #define H_gtk_widget_activate "gboolean gtk_widget_activate(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_activate", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_activate(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_context_set_language "void pango_context_set_language(PangoContext* context, PangoLanguage* language)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_set_language", "PangoContext*");
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 2, "pango_context_set_language", "PangoLanguage*");
+ pango_context_set_language(Xen_to_C_PangoContext_(context), Xen_to_C_PangoLanguage_(language));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_reparent(XEN widget, XEN new_parent)
+static Xen gxg_pango_context_set_base_dir(Xen context, Xen direction)
{
- #define H_gtk_widget_reparent "void gtk_widget_reparent(GtkWidget* widget, GtkWidget* new_parent)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_reparent", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(new_parent), new_parent, 2, "gtk_widget_reparent", "GtkWidget*");
- gtk_widget_reparent(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkWidget_(new_parent));
- return(XEN_FALSE);
+ #define H_pango_context_set_base_dir "void pango_context_set_base_dir(PangoContext* context, PangoDirection direction)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_set_base_dir", "PangoContext*");
+ Xen_check_type(Xen_is_PangoDirection(direction), direction, 2, "pango_context_set_base_dir", "PangoDirection");
+ pango_context_set_base_dir(Xen_to_C_PangoContext_(context), Xen_to_C_PangoDirection(direction));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_intersect(XEN widget, XEN area, XEN intersection)
+static Xen gxg_pango_context_get_base_dir(Xen context)
{
- #define H_gtk_widget_intersect "gboolean gtk_widget_intersect(GtkWidget* widget, GdkRectangle* area, \
-GdkRectangle* intersection)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_intersect", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(area), area, 2, "gtk_widget_intersect", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(intersection) || XEN_FALSE_P(intersection), intersection, 3, "gtk_widget_intersect", "GdkRectangle*");
- return(C_TO_XEN_gboolean(gtk_widget_intersect(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkRectangle_(area), XEN_TO_C_GdkRectangle_(intersection))));
+ #define H_pango_context_get_base_dir "PangoDirection pango_context_get_base_dir(PangoContext* context)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_context_get_base_dir", "PangoContext*");
+ return(C_to_Xen_PangoDirection(pango_context_get_base_dir(Xen_to_C_PangoContext_(context))));
}
-static XEN gxg_gtk_widget_freeze_child_notify(XEN widget)
+static Xen gxg_pango_itemize(Xen context, Xen text, Xen start_index, Xen length, Xen attrs, Xen cached_iter)
{
- #define H_gtk_widget_freeze_child_notify "void gtk_widget_freeze_child_notify(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_freeze_child_notify", "GtkWidget*");
- gtk_widget_freeze_child_notify(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_itemize "GList* pango_itemize(PangoContext* context, char* text, int start_index, int length, \
+PangoAttrList* attrs, PangoAttrIterator* cached_iter)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_itemize", "PangoContext*");
+ Xen_check_type(Xen_is_char_(text), text, 2, "pango_itemize", "char*");
+ Xen_check_type(Xen_is_int(start_index), start_index, 3, "pango_itemize", "int");
+ Xen_check_type(Xen_is_int(length), length, 4, "pango_itemize", "int");
+ Xen_check_type(Xen_is_PangoAttrList_(attrs), attrs, 5, "pango_itemize", "PangoAttrList*");
+ Xen_check_type(Xen_is_PangoAttrIterator_(cached_iter), cached_iter, 6, "pango_itemize", "PangoAttrIterator*");
+ return(C_to_Xen_GList_(pango_itemize(Xen_to_C_PangoContext_(context), Xen_to_C_char_(text), Xen_to_C_int(start_index),
+ Xen_to_C_int(length), Xen_to_C_PangoAttrList_(attrs), Xen_to_C_PangoAttrIterator_(cached_iter))));
}
-static XEN gxg_gtk_widget_child_notify(XEN widget, XEN child_property)
+static Xen gxg_pango_coverage_new(void)
{
- #define H_gtk_widget_child_notify "void gtk_widget_child_notify(GtkWidget* widget, gchar* child_property)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_child_notify", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(child_property), child_property, 2, "gtk_widget_child_notify", "gchar*");
- gtk_widget_child_notify(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(child_property));
- return(XEN_FALSE);
+ #define H_pango_coverage_new "PangoCoverage* pango_coverage_new( void)"
+ return(C_to_Xen_PangoCoverage_(pango_coverage_new()));
}
-static XEN gxg_gtk_widget_thaw_child_notify(XEN widget)
+static Xen gxg_pango_coverage_ref(Xen coverage)
{
- #define H_gtk_widget_thaw_child_notify "void gtk_widget_thaw_child_notify(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_thaw_child_notify", "GtkWidget*");
- gtk_widget_thaw_child_notify(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_coverage_ref "PangoCoverage* pango_coverage_ref(PangoCoverage* coverage)"
+ Xen_check_type(Xen_is_PangoCoverage_(coverage), coverage, 1, "pango_coverage_ref", "PangoCoverage*");
+ return(C_to_Xen_PangoCoverage_(pango_coverage_ref(Xen_to_C_PangoCoverage_(coverage))));
}
-static XEN gxg_gtk_widget_is_focus(XEN widget)
+static Xen gxg_pango_coverage_unref(Xen coverage)
{
- #define H_gtk_widget_is_focus "gboolean gtk_widget_is_focus(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_is_focus", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_is_focus(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_coverage_unref "void pango_coverage_unref(PangoCoverage* coverage)"
+ Xen_check_type(Xen_is_PangoCoverage_(coverage), coverage, 1, "pango_coverage_unref", "PangoCoverage*");
+ pango_coverage_unref(Xen_to_C_PangoCoverage_(coverage));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_grab_focus(XEN widget)
+static Xen gxg_pango_coverage_copy(Xen coverage)
{
- #define H_gtk_widget_grab_focus "void gtk_widget_grab_focus(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_grab_focus", "GtkWidget*");
- gtk_widget_grab_focus(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_coverage_copy "PangoCoverage* pango_coverage_copy(PangoCoverage* coverage)"
+ Xen_check_type(Xen_is_PangoCoverage_(coverage), coverage, 1, "pango_coverage_copy", "PangoCoverage*");
+ return(C_to_Xen_PangoCoverage_(pango_coverage_copy(Xen_to_C_PangoCoverage_(coverage))));
}
-static XEN gxg_gtk_widget_grab_default(XEN widget)
+static Xen gxg_pango_coverage_get(Xen coverage, Xen index)
{
- #define H_gtk_widget_grab_default "void gtk_widget_grab_default(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_grab_default", "GtkWidget*");
- gtk_widget_grab_default(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_pango_coverage_get "PangoCoverageLevel pango_coverage_get(PangoCoverage* coverage, int index)"
+ Xen_check_type(Xen_is_PangoCoverage_(coverage), coverage, 1, "pango_coverage_get", "PangoCoverage*");
+ Xen_check_type(Xen_is_int(index), index, 2, "pango_coverage_get", "int");
+ return(C_to_Xen_PangoCoverageLevel(pango_coverage_get(Xen_to_C_PangoCoverage_(coverage), Xen_to_C_int(index))));
}
-static XEN gxg_gtk_widget_set_name(XEN widget, XEN name)
+static Xen gxg_pango_coverage_set(Xen coverage, Xen index, Xen level)
{
- #define H_gtk_widget_set_name "void gtk_widget_set_name(GtkWidget* widget, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_name", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_widget_set_name", "gchar*");
- gtk_widget_set_name(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_pango_coverage_set "void pango_coverage_set(PangoCoverage* coverage, int index, PangoCoverageLevel level)"
+ Xen_check_type(Xen_is_PangoCoverage_(coverage), coverage, 1, "pango_coverage_set", "PangoCoverage*");
+ Xen_check_type(Xen_is_int(index), index, 2, "pango_coverage_set", "int");
+ Xen_check_type(Xen_is_PangoCoverageLevel(level), level, 3, "pango_coverage_set", "PangoCoverageLevel");
+ pango_coverage_set(Xen_to_C_PangoCoverage_(coverage), Xen_to_C_int(index), Xen_to_C_PangoCoverageLevel(level));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_name(XEN widget)
+static Xen gxg_pango_coverage_max(Xen coverage, Xen other)
{
- #define H_gtk_widget_get_name "gchar* gtk_widget_get_name(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_name", "GtkWidget*");
- return(C_TO_XEN_gchar_(gtk_widget_get_name(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_coverage_max "void pango_coverage_max(PangoCoverage* coverage, PangoCoverage* other)"
+ Xen_check_type(Xen_is_PangoCoverage_(coverage), coverage, 1, "pango_coverage_max", "PangoCoverage*");
+ Xen_check_type(Xen_is_PangoCoverage_(other), other, 2, "pango_coverage_max", "PangoCoverage*");
+ pango_coverage_max(Xen_to_C_PangoCoverage_(coverage), Xen_to_C_PangoCoverage_(other));
+ return(Xen_false);
+}
+
+static Xen gxg_pango_coverage_to_bytes(Xen coverage, Xen ignore_bytes, Xen ignore_n_bytes)
+{
+ #define H_pango_coverage_to_bytes "void pango_coverage_to_bytes(PangoCoverage* coverage, guchar** [bytes], \
+int* [n_bytes])"
+ guchar* ref_bytes = NULL;
+ int ref_n_bytes;
+ Xen_check_type(Xen_is_PangoCoverage_(coverage), coverage, 1, "pango_coverage_to_bytes", "PangoCoverage*");
+ pango_coverage_to_bytes(Xen_to_C_PangoCoverage_(coverage), &ref_bytes, &ref_n_bytes);
+ return(Xen_list_2(C_to_Xen_guchar_(ref_bytes), C_to_Xen_int(ref_n_bytes)));
}
-static XEN gxg_gtk_widget_set_state(XEN widget, XEN state)
+static Xen gxg_pango_coverage_from_bytes(Xen bytes, Xen n_bytes)
{
- #define H_gtk_widget_set_state "void gtk_widget_set_state(GtkWidget* widget, GtkStateType state)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_state", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state), state, 2, "gtk_widget_set_state", "GtkStateType");
- gtk_widget_set_state(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkStateType(state));
- return(XEN_FALSE);
+ #define H_pango_coverage_from_bytes "PangoCoverage* pango_coverage_from_bytes(guchar* bytes, int n_bytes)"
+ Xen_check_type(Xen_is_guchar_(bytes), bytes, 1, "pango_coverage_from_bytes", "guchar*");
+ Xen_check_type(Xen_is_int(n_bytes), n_bytes, 2, "pango_coverage_from_bytes", "int");
+ return(C_to_Xen_PangoCoverage_(pango_coverage_from_bytes(Xen_to_C_guchar_(bytes), Xen_to_C_int(n_bytes))));
}
-static XEN gxg_gtk_widget_set_sensitive(XEN widget, XEN sensitive)
+static Xen gxg_pango_font_description_new(void)
{
- #define H_gtk_widget_set_sensitive "void gtk_widget_set_sensitive(GtkWidget* widget, gboolean sensitive)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_sensitive", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(sensitive), sensitive, 2, "gtk_widget_set_sensitive", "gboolean");
- gtk_widget_set_sensitive(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(sensitive));
- return(XEN_FALSE);
+ #define H_pango_font_description_new "PangoFontDescription* pango_font_description_new( void)"
+ return(C_to_Xen_PangoFontDescription_(pango_font_description_new()));
}
-static XEN gxg_gtk_widget_set_app_paintable(XEN widget, XEN app_paintable)
+static Xen gxg_pango_font_description_copy(Xen desc)
{
- #define H_gtk_widget_set_app_paintable "void gtk_widget_set_app_paintable(GtkWidget* widget, gboolean app_paintable)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_app_paintable", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(app_paintable), app_paintable, 2, "gtk_widget_set_app_paintable", "gboolean");
- gtk_widget_set_app_paintable(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(app_paintable));
- return(XEN_FALSE);
+ #define H_pango_font_description_copy "PangoFontDescription* pango_font_description_copy(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_copy", "PangoFontDescription*");
+ return(C_to_Xen_PangoFontDescription_(pango_font_description_copy(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_set_double_buffered(XEN widget, XEN double_buffered)
+static Xen gxg_pango_font_description_copy_static(Xen desc)
{
- #define H_gtk_widget_set_double_buffered "void gtk_widget_set_double_buffered(GtkWidget* widget, gboolean double_buffered)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_double_buffered", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(double_buffered), double_buffered, 2, "gtk_widget_set_double_buffered", "gboolean");
- gtk_widget_set_double_buffered(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(double_buffered));
- return(XEN_FALSE);
+ #define H_pango_font_description_copy_static "PangoFontDescription* pango_font_description_copy_static(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_copy_static", "PangoFontDescription*");
+ return(C_to_Xen_PangoFontDescription_(pango_font_description_copy_static(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_set_redraw_on_allocate(XEN widget, XEN redraw_on_allocate)
+static Xen gxg_pango_font_description_hash(Xen desc)
{
- #define H_gtk_widget_set_redraw_on_allocate "void gtk_widget_set_redraw_on_allocate(GtkWidget* widget, \
-gboolean redraw_on_allocate)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_redraw_on_allocate", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(redraw_on_allocate), redraw_on_allocate, 2, "gtk_widget_set_redraw_on_allocate", "gboolean");
- gtk_widget_set_redraw_on_allocate(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(redraw_on_allocate));
- return(XEN_FALSE);
+ #define H_pango_font_description_hash "guint pango_font_description_hash(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_hash", "PangoFontDescription*");
+ return(C_to_Xen_guint(pango_font_description_hash(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_set_parent(XEN widget, XEN parent)
+static Xen gxg_pango_font_description_equal(Xen desc1, Xen desc2)
{
- #define H_gtk_widget_set_parent "void gtk_widget_set_parent(GtkWidget* widget, GtkWidget* parent)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_parent", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(parent), parent, 2, "gtk_widget_set_parent", "GtkWidget*");
- gtk_widget_set_parent(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkWidget_(parent));
- return(XEN_FALSE);
+ #define H_pango_font_description_equal "gboolean pango_font_description_equal(PangoFontDescription* desc1, \
+PangoFontDescription* desc2)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc1), desc1, 1, "pango_font_description_equal", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc2), desc2, 2, "pango_font_description_equal", "PangoFontDescription*");
+ return(C_to_Xen_gboolean(pango_font_description_equal(Xen_to_C_PangoFontDescription_(desc1), Xen_to_C_PangoFontDescription_(desc2))));
}
-static XEN gxg_gtk_widget_set_parent_window(XEN widget, XEN parent_window)
+static Xen gxg_pango_font_description_free(Xen desc)
{
- #define H_gtk_widget_set_parent_window "void gtk_widget_set_parent_window(GtkWidget* widget, GdkWindow* parent_window)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_parent_window", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(parent_window), parent_window, 2, "gtk_widget_set_parent_window", "GdkWindow*");
- gtk_widget_set_parent_window(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkWindow_(parent_window));
- return(XEN_FALSE);
+ #define H_pango_font_description_free "void pango_font_description_free(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_free", "PangoFontDescription*");
+ pango_font_description_free(Xen_to_C_PangoFontDescription_(desc));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_child_visible(XEN widget, XEN is_visible)
+static Xen gxg_pango_font_descriptions_free(Xen descs, Xen n_descs)
{
- #define H_gtk_widget_set_child_visible "void gtk_widget_set_child_visible(GtkWidget* widget, gboolean is_visible)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_child_visible", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_visible), is_visible, 2, "gtk_widget_set_child_visible", "gboolean");
- gtk_widget_set_child_visible(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(is_visible));
- return(XEN_FALSE);
+ #define H_pango_font_descriptions_free "void pango_font_descriptions_free(PangoFontDescription** descs, \
+int n_descs)"
+ Xen_check_type(Xen_is_PangoFontDescription__(descs), descs, 1, "pango_font_descriptions_free", "PangoFontDescription**");
+ Xen_check_type(Xen_is_int(n_descs), n_descs, 2, "pango_font_descriptions_free", "int");
+ pango_font_descriptions_free(Xen_to_C_PangoFontDescription__(descs), Xen_to_C_int(n_descs));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_accel_path(XEN widget, XEN accel_path, XEN accel_group)
+static Xen gxg_pango_font_description_set_family(Xen desc, Xen family)
{
- #define H_gtk_widget_set_accel_path "void gtk_widget_set_accel_path(GtkWidget* widget, gchar* accel_path, \
-GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_accel_path", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 2, "gtk_widget_set_accel_path", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 3, "gtk_widget_set_accel_path", "GtkAccelGroup*");
- gtk_widget_set_accel_path(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(accel_path), XEN_TO_C_GtkAccelGroup_(accel_group));
- return(XEN_FALSE);
+ #define H_pango_font_description_set_family "void pango_font_description_set_family(PangoFontDescription* desc, \
+char* family)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_set_family", "PangoFontDescription*");
+ Xen_check_type(Xen_is_char_(family), family, 2, "pango_font_description_set_family", "char*");
+ pango_font_description_set_family(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_char_(family));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_child_visible(XEN widget)
+static Xen gxg_pango_font_description_set_family_static(Xen desc, Xen family)
{
- #define H_gtk_widget_get_child_visible "gboolean gtk_widget_get_child_visible(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_child_visible", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_child_visible(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_set_family_static "void pango_font_description_set_family_static(PangoFontDescription* desc, \
+char* family)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_set_family_static", "PangoFontDescription*");
+ Xen_check_type(Xen_is_char_(family), family, 2, "pango_font_description_set_family_static", "char*");
+ pango_font_description_set_family_static(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_char_(family));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_parent(XEN widget)
+static Xen gxg_pango_font_description_get_family(Xen desc)
{
- #define H_gtk_widget_get_parent "GtkWidget* gtk_widget_get_parent(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_parent", "GtkWidget*");
- return(C_TO_XEN_GtkWidget_(gtk_widget_get_parent(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_get_family "char* pango_font_description_get_family(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_get_family", "PangoFontDescription*");
+ return(C_to_Xen_char_(pango_font_description_get_family(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_get_parent_window(XEN widget)
+static Xen gxg_pango_font_description_set_style(Xen desc, Xen style)
{
- #define H_gtk_widget_get_parent_window "GdkWindow* gtk_widget_get_parent_window(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_parent_window", "GtkWidget*");
- return(C_TO_XEN_GdkWindow_(gtk_widget_get_parent_window(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_set_style "void pango_font_description_set_style(PangoFontDescription* desc, \
+PangoStyle style)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_set_style", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoStyle(style), style, 2, "pango_font_description_set_style", "PangoStyle");
+ pango_font_description_set_style(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoStyle(style));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_child_focus(XEN widget, XEN direction)
+static Xen gxg_pango_font_description_get_style(Xen desc)
{
- #define H_gtk_widget_child_focus "gboolean gtk_widget_child_focus(GtkWidget* widget, GtkDirectionType direction)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_child_focus", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkDirectionType_P(direction), direction, 2, "gtk_widget_child_focus", "GtkDirectionType");
- return(C_TO_XEN_gboolean(gtk_widget_child_focus(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkDirectionType(direction))));
+ #define H_pango_font_description_get_style "PangoStyle pango_font_description_get_style(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_get_style", "PangoFontDescription*");
+ return(C_to_Xen_PangoStyle(pango_font_description_get_style(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_set_size_request(XEN widget, XEN width, XEN height)
+static Xen gxg_pango_font_description_set_variant(Xen desc, Xen variant)
{
- #define H_gtk_widget_set_size_request "void gtk_widget_set_size_request(GtkWidget* widget, gint width, \
-gint height)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_size_request", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_widget_set_size_request", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gtk_widget_set_size_request", "gint");
- gtk_widget_set_size_request(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_pango_font_description_set_variant "void pango_font_description_set_variant(PangoFontDescription* desc, \
+PangoVariant variant)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_set_variant", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoVariant(variant), variant, 2, "pango_font_description_set_variant", "PangoVariant");
+ pango_font_description_set_variant(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoVariant(variant));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_size_request(XEN widget, XEN ignore_width, XEN ignore_height)
+static Xen gxg_pango_font_description_get_variant(Xen desc)
{
- #define H_gtk_widget_get_size_request "void gtk_widget_get_size_request(GtkWidget* widget, gint* [width], \
-gint* [height])"
- gint ref_width;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_size_request", "GtkWidget*");
- gtk_widget_get_size_request(XEN_TO_C_GtkWidget_(widget), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ #define H_pango_font_description_get_variant "PangoVariant pango_font_description_get_variant(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_get_variant", "PangoFontDescription*");
+ return(C_to_Xen_PangoVariant(pango_font_description_get_variant(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_set_events(XEN widget, XEN events)
+static Xen gxg_pango_font_description_set_weight(Xen desc, Xen weight)
{
- #define H_gtk_widget_set_events "void gtk_widget_set_events(GtkWidget* widget, gint events)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_events", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(events), events, 2, "gtk_widget_set_events", "gint");
- gtk_widget_set_events(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(events));
- return(XEN_FALSE);
+ #define H_pango_font_description_set_weight "void pango_font_description_set_weight(PangoFontDescription* desc, \
+PangoWeight weight)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_set_weight", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoWeight(weight), weight, 2, "pango_font_description_set_weight", "PangoWeight");
+ pango_font_description_set_weight(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoWeight(weight));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_add_events(XEN widget, XEN events)
+static Xen gxg_pango_font_description_get_weight(Xen desc)
{
- #define H_gtk_widget_add_events "void gtk_widget_add_events(GtkWidget* widget, gint events)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_add_events", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(events), events, 2, "gtk_widget_add_events", "gint");
- gtk_widget_add_events(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(events));
- return(XEN_FALSE);
+ #define H_pango_font_description_get_weight "PangoWeight pango_font_description_get_weight(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_get_weight", "PangoFontDescription*");
+ return(C_to_Xen_PangoWeight(pango_font_description_get_weight(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_get_toplevel(XEN widget)
+static Xen gxg_pango_font_description_set_stretch(Xen desc, Xen stretch)
{
- #define H_gtk_widget_get_toplevel "GtkWidget* gtk_widget_get_toplevel(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_toplevel", "GtkWidget*");
- return(C_TO_XEN_GtkWidget_(gtk_widget_get_toplevel(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_set_stretch "void pango_font_description_set_stretch(PangoFontDescription* desc, \
+PangoStretch stretch)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_set_stretch", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoStretch(stretch), stretch, 2, "pango_font_description_set_stretch", "PangoStretch");
+ pango_font_description_set_stretch(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoStretch(stretch));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_ancestor(XEN widget, XEN widget_type)
+static Xen gxg_pango_font_description_get_stretch(Xen desc)
{
- #define H_gtk_widget_get_ancestor "GtkWidget* gtk_widget_get_ancestor(GtkWidget* widget, GType widget_type)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_ancestor", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GType_P(widget_type), widget_type, 2, "gtk_widget_get_ancestor", "GType");
- return(C_TO_XEN_GtkWidget_(gtk_widget_get_ancestor(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GType(widget_type))));
+ #define H_pango_font_description_get_stretch "PangoStretch pango_font_description_get_stretch(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_get_stretch", "PangoFontDescription*");
+ return(C_to_Xen_PangoStretch(pango_font_description_get_stretch(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_get_visual(XEN widget)
+static Xen gxg_pango_font_description_set_size(Xen desc, Xen size)
{
- #define H_gtk_widget_get_visual "GdkVisual* gtk_widget_get_visual(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_visual", "GtkWidget*");
- return(C_TO_XEN_GdkVisual_(gtk_widget_get_visual(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_set_size "void pango_font_description_set_size(PangoFontDescription* desc, \
+gint size)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_set_size", "PangoFontDescription*");
+ Xen_check_type(Xen_is_gint(size), size, 2, "pango_font_description_set_size", "gint");
+ pango_font_description_set_size(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_gint(size));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_accessible(XEN widget)
+static Xen gxg_pango_font_description_get_size(Xen desc)
{
- #define H_gtk_widget_get_accessible "AtkObject* gtk_widget_get_accessible(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_accessible", "GtkWidget*");
- return(C_TO_XEN_AtkObject_(gtk_widget_get_accessible(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_get_size "gint pango_font_description_get_size(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_get_size", "PangoFontDescription*");
+ return(C_to_Xen_gint(pango_font_description_get_size(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_get_events(XEN widget)
+static Xen gxg_pango_font_description_get_set_fields(Xen desc)
{
- #define H_gtk_widget_get_events "gint gtk_widget_get_events(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_events", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_widget_get_events(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_get_set_fields "PangoFontMask pango_font_description_get_set_fields(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_get_set_fields", "PangoFontDescription*");
+ return(C_to_Xen_PangoFontMask(pango_font_description_get_set_fields(Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_widget_get_pointer(XEN widget, XEN ignore_x, XEN ignore_y)
+static Xen gxg_pango_font_description_unset_fields(Xen desc, Xen to_unset)
{
- #define H_gtk_widget_get_pointer "void gtk_widget_get_pointer(GtkWidget* widget, gint* [x], gint* [y])"
- gint ref_x;
- gint ref_y;
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_pointer", "GtkWidget*");
- gtk_widget_get_pointer(XEN_TO_C_GtkWidget_(widget), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y)));
+ #define H_pango_font_description_unset_fields "void pango_font_description_unset_fields(PangoFontDescription* desc, \
+PangoFontMask to_unset)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_unset_fields", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoFontMask(to_unset), to_unset, 2, "pango_font_description_unset_fields", "PangoFontMask");
+ pango_font_description_unset_fields(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoFontMask(to_unset));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_is_ancestor(XEN widget, XEN ancestor)
+static Xen gxg_pango_font_description_merge(Xen desc, Xen desc_to_merge, Xen replace_existing)
{
- #define H_gtk_widget_is_ancestor "gboolean gtk_widget_is_ancestor(GtkWidget* widget, GtkWidget* ancestor)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_is_ancestor", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(ancestor), ancestor, 2, "gtk_widget_is_ancestor", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_is_ancestor(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkWidget_(ancestor))));
+ #define H_pango_font_description_merge "void pango_font_description_merge(PangoFontDescription* desc, \
+PangoFontDescription* desc_to_merge, gboolean replace_existing)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_merge", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc_to_merge), desc_to_merge, 2, "pango_font_description_merge", "PangoFontDescription*");
+ Xen_check_type(Xen_is_gboolean(replace_existing), replace_existing, 3, "pango_font_description_merge", "gboolean");
+ pango_font_description_merge(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoFontDescription_(desc_to_merge), Xen_to_C_gboolean(replace_existing));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_translate_coordinates(XEN src_widget, XEN dest_widget, XEN src_x, XEN src_y, XEN ignore_dest_x, XEN ignore_dest_y)
+static Xen gxg_pango_font_description_merge_static(Xen desc, Xen desc_to_merge, Xen replace_existing)
{
- #define H_gtk_widget_translate_coordinates "gboolean gtk_widget_translate_coordinates(GtkWidget* src_widget, \
-GtkWidget* dest_widget, gint src_x, gint src_y, gint* [dest_x], gint* [dest_y])"
- gint ref_dest_x;
- gint ref_dest_y;
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(src_widget), src_widget, 1, "gtk_widget_translate_coordinates", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(dest_widget), dest_widget, 2, "gtk_widget_translate_coordinates", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(src_x), src_x, 3, "gtk_widget_translate_coordinates", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(src_y), src_y, 4, "gtk_widget_translate_coordinates", "gint");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_widget_translate_coordinates(XEN_TO_C_GtkWidget_(src_widget), XEN_TO_C_GtkWidget_(dest_widget),
- XEN_TO_C_gint(src_x), XEN_TO_C_gint(src_y), &ref_dest_x,
- &ref_dest_y));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_dest_x), C_TO_XEN_gint(ref_dest_y)));
- }
+ #define H_pango_font_description_merge_static "void pango_font_description_merge_static(PangoFontDescription* desc, \
+PangoFontDescription* desc_to_merge, gboolean replace_existing)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_merge_static", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc_to_merge), desc_to_merge, 2, "pango_font_description_merge_static", "PangoFontDescription*");
+ Xen_check_type(Xen_is_gboolean(replace_existing), replace_existing, 3, "pango_font_description_merge_static", "gboolean");
+ pango_font_description_merge_static(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoFontDescription_(desc_to_merge),
+ Xen_to_C_gboolean(replace_existing));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_hide_on_delete(XEN widget)
+static Xen gxg_pango_font_description_better_match(Xen desc, Xen old_match, Xen new_match)
{
- #define H_gtk_widget_hide_on_delete "gboolean gtk_widget_hide_on_delete(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_hide_on_delete", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_hide_on_delete(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_better_match "gboolean pango_font_description_better_match(PangoFontDescription* desc, \
+PangoFontDescription* old_match, PangoFontDescription* new_match)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_better_match", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoFontDescription_(old_match), old_match, 2, "pango_font_description_better_match", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoFontDescription_(new_match), new_match, 3, "pango_font_description_better_match", "PangoFontDescription*");
+ return(C_to_Xen_gboolean(pango_font_description_better_match(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoFontDescription_(old_match),
+ Xen_to_C_PangoFontDescription_(new_match))));
}
-static XEN gxg_gtk_widget_create_pango_context(XEN widget)
+static Xen gxg_pango_font_description_from_string(Xen str)
{
- #define H_gtk_widget_create_pango_context "PangoContext* gtk_widget_create_pango_context(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_create_pango_context", "GtkWidget*");
- return(C_TO_XEN_PangoContext_(gtk_widget_create_pango_context(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_from_string "PangoFontDescription* pango_font_description_from_string(char* str)"
+ Xen_check_type(Xen_is_char_(str), str, 1, "pango_font_description_from_string", "char*");
+ return(C_to_Xen_PangoFontDescription_(pango_font_description_from_string(Xen_to_C_char_(str))));
}
-static XEN gxg_gtk_widget_get_pango_context(XEN widget)
+static Xen gxg_pango_font_description_to_string(Xen desc)
{
- #define H_gtk_widget_get_pango_context "PangoContext* gtk_widget_get_pango_context(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_pango_context", "GtkWidget*");
- return(C_TO_XEN_PangoContext_(gtk_widget_get_pango_context(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_description_to_string "char* pango_font_description_to_string(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_to_string", "PangoFontDescription*");
+ {
+ char* result;
+ Xen rtn;
+ result = pango_font_description_to_string(Xen_to_C_PangoFontDescription_(desc));
+ rtn = C_to_Xen_char_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_widget_create_pango_layout(XEN widget, XEN text)
+static Xen gxg_pango_font_description_to_filename(Xen desc)
{
- #define H_gtk_widget_create_pango_layout "PangoLayout* gtk_widget_create_pango_layout(GtkWidget* widget, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_create_pango_layout", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_widget_create_pango_layout", "gchar*");
- return(C_TO_XEN_PangoLayout_(gtk_widget_create_pango_layout(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(text))));
+ #define H_pango_font_description_to_filename "char* pango_font_description_to_filename(PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_to_filename", "PangoFontDescription*");
+ {
+ char* result;
+ Xen rtn;
+ result = pango_font_description_to_filename(Xen_to_C_PangoFontDescription_(desc));
+ rtn = C_to_Xen_char_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_widget_set_composite_name(XEN widget, XEN name)
+static Xen gxg_pango_font_metrics_ref(Xen metrics)
{
- #define H_gtk_widget_set_composite_name "void gtk_widget_set_composite_name(GtkWidget* widget, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_composite_name", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_widget_set_composite_name", "gchar*");
- gtk_widget_set_composite_name(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_pango_font_metrics_ref "PangoFontMetrics* pango_font_metrics_ref(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_ref", "PangoFontMetrics*");
+ return(C_to_Xen_PangoFontMetrics_(pango_font_metrics_ref(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_widget_get_composite_name(XEN widget)
+static Xen gxg_pango_font_metrics_unref(Xen metrics)
{
- #define H_gtk_widget_get_composite_name "gchar* gtk_widget_get_composite_name(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_composite_name", "GtkWidget*");
- return(C_TO_XEN_gchar_(gtk_widget_get_composite_name(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_metrics_unref "void pango_font_metrics_unref(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_unref", "PangoFontMetrics*");
+ pango_font_metrics_unref(Xen_to_C_PangoFontMetrics_(metrics));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_push_composite_child(void)
+static Xen gxg_pango_font_metrics_get_ascent(Xen metrics)
{
- #define H_gtk_widget_push_composite_child "void gtk_widget_push_composite_child( void)"
- gtk_widget_push_composite_child();
- return(XEN_FALSE);
+ #define H_pango_font_metrics_get_ascent "int pango_font_metrics_get_ascent(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_get_ascent", "PangoFontMetrics*");
+ return(C_to_Xen_int(pango_font_metrics_get_ascent(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_widget_pop_composite_child(void)
+static Xen gxg_pango_font_metrics_get_descent(Xen metrics)
{
- #define H_gtk_widget_pop_composite_child "void gtk_widget_pop_composite_child( void)"
- gtk_widget_pop_composite_child();
- return(XEN_FALSE);
+ #define H_pango_font_metrics_get_descent "int pango_font_metrics_get_descent(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_get_descent", "PangoFontMetrics*");
+ return(C_to_Xen_int(pango_font_metrics_get_descent(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_widget_set_direction(XEN widget, XEN dir)
+static Xen gxg_pango_font_metrics_get_approximate_char_width(Xen metrics)
{
- #define H_gtk_widget_set_direction "void gtk_widget_set_direction(GtkWidget* widget, GtkTextDirection dir)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_direction", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkTextDirection_P(dir), dir, 2, "gtk_widget_set_direction", "GtkTextDirection");
- gtk_widget_set_direction(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkTextDirection(dir));
- return(XEN_FALSE);
+ #define H_pango_font_metrics_get_approximate_char_width "int pango_font_metrics_get_approximate_char_width(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_get_approximate_char_width", "PangoFontMetrics*");
+ return(C_to_Xen_int(pango_font_metrics_get_approximate_char_width(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_widget_get_direction(XEN widget)
+static Xen gxg_pango_font_metrics_get_approximate_digit_width(Xen metrics)
{
- #define H_gtk_widget_get_direction "GtkTextDirection gtk_widget_get_direction(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_direction", "GtkWidget*");
- return(C_TO_XEN_GtkTextDirection(gtk_widget_get_direction(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_font_metrics_get_approximate_digit_width "int pango_font_metrics_get_approximate_digit_width(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_get_approximate_digit_width", "PangoFontMetrics*");
+ return(C_to_Xen_int(pango_font_metrics_get_approximate_digit_width(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_widget_set_default_direction(XEN dir)
+static Xen gxg_pango_font_family_list_faces(Xen family, Xen ignore_faces, Xen ignore_n_faces)
{
- #define H_gtk_widget_set_default_direction "void gtk_widget_set_default_direction(GtkTextDirection dir)"
- XEN_ASSERT_TYPE(XEN_GtkTextDirection_P(dir), dir, 1, "gtk_widget_set_default_direction", "GtkTextDirection");
- gtk_widget_set_default_direction(XEN_TO_C_GtkTextDirection(dir));
- return(XEN_FALSE);
+ #define H_pango_font_family_list_faces "void pango_font_family_list_faces(PangoFontFamily* family, \
+PangoFontFace*** [faces], int* [n_faces])"
+ PangoFontFace** ref_faces = NULL;
+ int ref_n_faces;
+ Xen_check_type(Xen_is_PangoFontFamily_(family), family, 1, "pango_font_family_list_faces", "PangoFontFamily*");
+ pango_font_family_list_faces(Xen_to_C_PangoFontFamily_(family), &ref_faces, &ref_n_faces);
+ return(Xen_list_2(C_to_Xen_PangoFontFace__(ref_faces), C_to_Xen_int(ref_n_faces)));
}
-static XEN gxg_gtk_widget_get_default_direction(void)
+static Xen gxg_pango_font_family_get_name(Xen family)
{
- #define H_gtk_widget_get_default_direction "GtkTextDirection gtk_widget_get_default_direction( void)"
- return(C_TO_XEN_GtkTextDirection(gtk_widget_get_default_direction()));
+ #define H_pango_font_family_get_name "char* pango_font_family_get_name(PangoFontFamily* family)"
+ Xen_check_type(Xen_is_PangoFontFamily_(family), family, 1, "pango_font_family_get_name", "PangoFontFamily*");
+ return(C_to_Xen_char_(pango_font_family_get_name(Xen_to_C_PangoFontFamily_(family))));
}
-static XEN gxg_gtk_widget_can_activate_accel(XEN widget, XEN signal_id)
+static Xen gxg_pango_font_face_describe(Xen face)
{
- #define H_gtk_widget_can_activate_accel "gboolean gtk_widget_can_activate_accel(GtkWidget* widget, \
-guint signal_id)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_can_activate_accel", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_guint_P(signal_id), signal_id, 2, "gtk_widget_can_activate_accel", "guint");
- return(C_TO_XEN_gboolean(gtk_widget_can_activate_accel(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_guint(signal_id))));
+ #define H_pango_font_face_describe "PangoFontDescription* pango_font_face_describe(PangoFontFace* face)"
+ Xen_check_type(Xen_is_PangoFontFace_(face), face, 1, "pango_font_face_describe", "PangoFontFace*");
+ return(C_to_Xen_PangoFontDescription_(pango_font_face_describe(Xen_to_C_PangoFontFace_(face))));
}
-static XEN gxg_gtk_window_is_active(XEN window)
+static Xen gxg_pango_font_face_get_face_name(Xen face)
{
- #define H_gtk_window_is_active "gboolean gtk_window_is_active(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_is_active", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_is_active(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_font_face_get_face_name "char* pango_font_face_get_face_name(PangoFontFace* face)"
+ Xen_check_type(Xen_is_PangoFontFace_(face), face, 1, "pango_font_face_get_face_name", "PangoFontFace*");
+ return(C_to_Xen_char_(pango_font_face_get_face_name(Xen_to_C_PangoFontFace_(face))));
}
-static XEN gxg_gtk_window_has_toplevel_focus(XEN window)
+static Xen gxg_pango_font_describe(Xen font)
{
- #define H_gtk_window_has_toplevel_focus "gboolean gtk_window_has_toplevel_focus(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_has_toplevel_focus", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_has_toplevel_focus(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_font_describe "PangoFontDescription* pango_font_describe(PangoFont* font)"
+ Xen_check_type(Xen_is_PangoFont_(font), font, 1, "pango_font_describe", "PangoFont*");
+ return(C_to_Xen_PangoFontDescription_(pango_font_describe(Xen_to_C_PangoFont_(font))));
}
-static XEN gxg_gtk_window_new(XEN type)
+static Xen gxg_pango_font_get_coverage(Xen font, Xen language)
{
- #define H_gtk_window_new "GtkWidget* gtk_window_new(GtkWindowType type)"
- XEN_ASSERT_TYPE(XEN_GtkWindowType_P(type), type, 1, "gtk_window_new", "GtkWindowType");
- return(C_TO_XEN_GtkWidget_(gtk_window_new(XEN_TO_C_GtkWindowType(type))));
+ #define H_pango_font_get_coverage "PangoCoverage* pango_font_get_coverage(PangoFont* font, PangoLanguage* language)"
+ Xen_check_type(Xen_is_PangoFont_(font), font, 1, "pango_font_get_coverage", "PangoFont*");
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 2, "pango_font_get_coverage", "PangoLanguage*");
+ return(C_to_Xen_PangoCoverage_(pango_font_get_coverage(Xen_to_C_PangoFont_(font), Xen_to_C_PangoLanguage_(language))));
}
-static XEN gxg_gtk_window_set_title(XEN window, XEN title)
+static Xen gxg_pango_font_get_metrics(Xen font, Xen language)
{
- #define H_gtk_window_set_title "void gtk_window_set_title(GtkWindow* window, gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_title", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gtk_window_set_title", "gchar*");
- gtk_window_set_title(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_pango_font_get_metrics "PangoFontMetrics* pango_font_get_metrics(PangoFont* font, PangoLanguage* language)"
+ Xen_check_type(Xen_is_PangoFont_(font), font, 1, "pango_font_get_metrics", "PangoFont*");
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 2, "pango_font_get_metrics", "PangoLanguage*");
+ return(C_to_Xen_PangoFontMetrics_(pango_font_get_metrics(Xen_to_C_PangoFont_(font), Xen_to_C_PangoLanguage_(language))));
}
-static XEN gxg_gtk_window_set_auto_startup_notification(XEN setting)
+static Xen gxg_pango_font_get_glyph_extents(Xen font, Xen glyph, Xen ink_rect, Xen logical_rect)
{
- #define H_gtk_window_set_auto_startup_notification "void gtk_window_set_auto_startup_notification(gboolean setting)"
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 1, "gtk_window_set_auto_startup_notification", "gboolean");
- gtk_window_set_auto_startup_notification(XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_pango_font_get_glyph_extents "void pango_font_get_glyph_extents(PangoFont* font, PangoGlyph glyph, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoFont_(font), font, 1, "pango_font_get_glyph_extents", "PangoFont*");
+ Xen_check_type(Xen_is_PangoGlyph(glyph), glyph, 2, "pango_font_get_glyph_extents", "PangoGlyph");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 3, "pango_font_get_glyph_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 4, "pango_font_get_glyph_extents", "PangoRectangle*");
+ pango_font_get_glyph_extents(Xen_to_C_PangoFont_(font), Xen_to_C_PangoGlyph(glyph), Xen_to_C_PangoRectangle_(ink_rect),
+ Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_title(XEN window)
+static Xen gxg_pango_font_map_load_font(Xen fontmap, Xen context, Xen desc)
{
- #define H_gtk_window_get_title "gchar* gtk_window_get_title(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_title", "GtkWindow*");
- return(C_TO_XEN_gchar_(gtk_window_get_title(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_font_map_load_font "PangoFont* pango_font_map_load_font(PangoFontMap* fontmap, PangoContext* context, \
+PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoFontMap_(fontmap), fontmap, 1, "pango_font_map_load_font", "PangoFontMap*");
+ Xen_check_type(Xen_is_PangoContext_(context), context, 2, "pango_font_map_load_font", "PangoContext*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 3, "pango_font_map_load_font", "PangoFontDescription*");
+ return(C_to_Xen_PangoFont_(pango_font_map_load_font(Xen_to_C_PangoFontMap_(fontmap), Xen_to_C_PangoContext_(context), Xen_to_C_PangoFontDescription_(desc))));
}
-static XEN gxg_gtk_window_set_wmclass(XEN window, XEN wmclass_name, XEN wmclass_class)
+static Xen gxg_pango_font_map_load_fontset(Xen fontmap, Xen context, Xen desc, Xen language)
{
- #define H_gtk_window_set_wmclass "void gtk_window_set_wmclass(GtkWindow* window, gchar* wmclass_name, \
-gchar* wmclass_class)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_wmclass", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(wmclass_name), wmclass_name, 2, "gtk_window_set_wmclass", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(wmclass_class), wmclass_class, 3, "gtk_window_set_wmclass", "gchar*");
- gtk_window_set_wmclass(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gchar_(wmclass_name), XEN_TO_C_gchar_(wmclass_class));
- return(XEN_FALSE);
+ #define H_pango_font_map_load_fontset "PangoFontset* pango_font_map_load_fontset(PangoFontMap* fontmap, \
+PangoContext* context, PangoFontDescription* desc, PangoLanguage* language)"
+ Xen_check_type(Xen_is_PangoFontMap_(fontmap), fontmap, 1, "pango_font_map_load_fontset", "PangoFontMap*");
+ Xen_check_type(Xen_is_PangoContext_(context), context, 2, "pango_font_map_load_fontset", "PangoContext*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 3, "pango_font_map_load_fontset", "PangoFontDescription*");
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 4, "pango_font_map_load_fontset", "PangoLanguage*");
+ return(C_to_Xen_PangoFontset_(pango_font_map_load_fontset(Xen_to_C_PangoFontMap_(fontmap), Xen_to_C_PangoContext_(context),
+ Xen_to_C_PangoFontDescription_(desc), Xen_to_C_PangoLanguage_(language))));
}
-static XEN gxg_gtk_window_set_role(XEN window, XEN role)
+static Xen gxg_pango_font_map_list_families(Xen fontmap, Xen ignore_families, Xen ignore_n_families)
{
- #define H_gtk_window_set_role "void gtk_window_set_role(GtkWindow* window, gchar* role)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_role", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(role), role, 2, "gtk_window_set_role", "gchar*");
- gtk_window_set_role(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gchar_(role));
- return(XEN_FALSE);
+ #define H_pango_font_map_list_families "void pango_font_map_list_families(PangoFontMap* fontmap, PangoFontFamily*** [families], \
+int* [n_families])"
+ PangoFontFamily** ref_families = NULL;
+ int ref_n_families;
+ Xen_check_type(Xen_is_PangoFontMap_(fontmap), fontmap, 1, "pango_font_map_list_families", "PangoFontMap*");
+ pango_font_map_list_families(Xen_to_C_PangoFontMap_(fontmap), &ref_families, &ref_n_families);
+ return(Xen_list_2(C_to_Xen_PangoFontFamily__(ref_families), C_to_Xen_int(ref_n_families)));
}
-static XEN gxg_gtk_window_get_role(XEN window)
+static Xen gxg_pango_glyph_string_new(void)
{
- #define H_gtk_window_get_role "gchar* gtk_window_get_role(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_role", "GtkWindow*");
- return(C_TO_XEN_gchar_(gtk_window_get_role(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_glyph_string_new "PangoGlyphString* pango_glyph_string_new( void)"
+ return(C_to_Xen_PangoGlyphString_(pango_glyph_string_new()));
}
-static XEN gxg_gtk_window_add_accel_group(XEN window, XEN accel_group)
+static Xen gxg_pango_glyph_string_set_size(Xen string, Xen new_len)
{
- #define H_gtk_window_add_accel_group "void gtk_window_add_accel_group(GtkWindow* window, GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_add_accel_group", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 2, "gtk_window_add_accel_group", "GtkAccelGroup*");
- gtk_window_add_accel_group(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GtkAccelGroup_(accel_group));
- return(XEN_FALSE);
+ #define H_pango_glyph_string_set_size "void pango_glyph_string_set_size(PangoGlyphString* string, gint new_len)"
+ Xen_check_type(Xen_is_PangoGlyphString_(string), string, 1, "pango_glyph_string_set_size", "PangoGlyphString*");
+ Xen_check_type(Xen_is_gint(new_len), new_len, 2, "pango_glyph_string_set_size", "gint");
+ pango_glyph_string_set_size(Xen_to_C_PangoGlyphString_(string), Xen_to_C_gint(new_len));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_remove_accel_group(XEN window, XEN accel_group)
+static Xen gxg_pango_glyph_string_copy(Xen string)
{
- #define H_gtk_window_remove_accel_group "void gtk_window_remove_accel_group(GtkWindow* window, GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_remove_accel_group", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 2, "gtk_window_remove_accel_group", "GtkAccelGroup*");
- gtk_window_remove_accel_group(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GtkAccelGroup_(accel_group));
- return(XEN_FALSE);
+ #define H_pango_glyph_string_copy "PangoGlyphString* pango_glyph_string_copy(PangoGlyphString* string)"
+ Xen_check_type(Xen_is_PangoGlyphString_(string), string, 1, "pango_glyph_string_copy", "PangoGlyphString*");
+ return(C_to_Xen_PangoGlyphString_(pango_glyph_string_copy(Xen_to_C_PangoGlyphString_(string))));
}
-static XEN gxg_gtk_window_set_position(XEN window, XEN position)
+static Xen gxg_pango_glyph_string_free(Xen string)
{
- #define H_gtk_window_set_position "void gtk_window_set_position(GtkWindow* window, GtkWindowPosition position)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_position", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkWindowPosition_P(position), position, 2, "gtk_window_set_position", "GtkWindowPosition");
- gtk_window_set_position(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GtkWindowPosition(position));
- return(XEN_FALSE);
+ #define H_pango_glyph_string_free "void pango_glyph_string_free(PangoGlyphString* string)"
+ Xen_check_type(Xen_is_PangoGlyphString_(string), string, 1, "pango_glyph_string_free", "PangoGlyphString*");
+ pango_glyph_string_free(Xen_to_C_PangoGlyphString_(string));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_activate_focus(XEN window)
+static Xen gxg_pango_glyph_string_extents(Xen glyphs, Xen font, Xen ink_rect, Xen logical_rect)
{
- #define H_gtk_window_activate_focus "gboolean gtk_window_activate_focus(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_activate_focus", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_activate_focus(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_glyph_string_extents "void pango_glyph_string_extents(PangoGlyphString* glyphs, PangoFont* font, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 1, "pango_glyph_string_extents", "PangoGlyphString*");
+ Xen_check_type(Xen_is_PangoFont_(font), font, 2, "pango_glyph_string_extents", "PangoFont*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 3, "pango_glyph_string_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 4, "pango_glyph_string_extents", "PangoRectangle*");
+ pango_glyph_string_extents(Xen_to_C_PangoGlyphString_(glyphs), Xen_to_C_PangoFont_(font), Xen_to_C_PangoRectangle_(ink_rect),
+ Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_focus(XEN window, XEN focus)
+static Xen gxg_pango_glyph_string_extents_range(Xen glyphs, Xen start, Xen end, Xen font, Xen ink_rect, Xen logical_rect)
{
- #define H_gtk_window_set_focus "void gtk_window_set_focus(GtkWindow* window, GtkWidget* focus)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_focus", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(focus) || XEN_FALSE_P(focus), focus, 2, "gtk_window_set_focus", "GtkWidget*");
- gtk_window_set_focus(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GtkWidget_(focus));
- return(XEN_FALSE);
+ #define H_pango_glyph_string_extents_range "void pango_glyph_string_extents_range(PangoGlyphString* glyphs, \
+int start, int end, PangoFont* font, PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 1, "pango_glyph_string_extents_range", "PangoGlyphString*");
+ Xen_check_type(Xen_is_int(start), start, 2, "pango_glyph_string_extents_range", "int");
+ Xen_check_type(Xen_is_int(end), end, 3, "pango_glyph_string_extents_range", "int");
+ Xen_check_type(Xen_is_PangoFont_(font), font, 4, "pango_glyph_string_extents_range", "PangoFont*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 5, "pango_glyph_string_extents_range", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 6, "pango_glyph_string_extents_range", "PangoRectangle*");
+ pango_glyph_string_extents_range(Xen_to_C_PangoGlyphString_(glyphs), Xen_to_C_int(start), Xen_to_C_int(end), Xen_to_C_PangoFont_(font),
+ Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_focus(XEN window)
+static Xen gxg_pango_glyph_string_get_logical_widths(Xen glyphs, Xen text, Xen length, Xen embedding_level, Xen ignore_logical_widths)
{
- #define H_gtk_window_get_focus "GtkWidget* gtk_window_get_focus(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_focus", "GtkWindow*");
- return(C_TO_XEN_GtkWidget_(gtk_window_get_focus(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_glyph_string_get_logical_widths "void pango_glyph_string_get_logical_widths(PangoGlyphString* glyphs, \
+char* text, int length, int embedding_level, int* [logical_widths])"
+ int ref_logical_widths;
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 1, "pango_glyph_string_get_logical_widths", "PangoGlyphString*");
+ Xen_check_type(Xen_is_char_(text), text, 2, "pango_glyph_string_get_logical_widths", "char*");
+ Xen_check_type(Xen_is_int(length), length, 3, "pango_glyph_string_get_logical_widths", "int");
+ Xen_check_type(Xen_is_int(embedding_level), embedding_level, 4, "pango_glyph_string_get_logical_widths", "int");
+ pango_glyph_string_get_logical_widths(Xen_to_C_PangoGlyphString_(glyphs), Xen_to_C_char_(text), Xen_to_C_int(length), Xen_to_C_int(embedding_level),
+ &ref_logical_widths);
+ return(Xen_list_1(C_to_Xen_int(ref_logical_widths)));
}
-static XEN gxg_gtk_window_set_default(XEN window, XEN default_widget)
+static Xen gxg_pango_glyph_string_index_to_x(Xen glyphs, Xen text, Xen length, Xen analysis, Xen index, Xen trailing, Xen ignore_x_pos)
{
- #define H_gtk_window_set_default "void gtk_window_set_default(GtkWindow* window, GtkWidget* default_widget)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_default", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(default_widget) || XEN_FALSE_P(default_widget), default_widget, 2, "gtk_window_set_default", "GtkWidget*");
- gtk_window_set_default(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GtkWidget_(default_widget));
- return(XEN_FALSE);
+ #define H_pango_glyph_string_index_to_x "void pango_glyph_string_index_to_x(PangoGlyphString* glyphs, \
+char* text, int length, PangoAnalysis* analysis, int index, gboolean trailing, int* [x_pos])"
+ int ref_x_pos;
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 1, "pango_glyph_string_index_to_x", "PangoGlyphString*");
+ Xen_check_type(Xen_is_char_(text), text, 2, "pango_glyph_string_index_to_x", "char*");
+ Xen_check_type(Xen_is_int(length), length, 3, "pango_glyph_string_index_to_x", "int");
+ Xen_check_type(Xen_is_PangoAnalysis_(analysis), analysis, 4, "pango_glyph_string_index_to_x", "PangoAnalysis*");
+ Xen_check_type(Xen_is_int(index), index, 5, "pango_glyph_string_index_to_x", "int");
+ Xen_check_type(Xen_is_gboolean(trailing), trailing, 6, "pango_glyph_string_index_to_x", "gboolean");
+ pango_glyph_string_index_to_x(Xen_to_C_PangoGlyphString_(glyphs), Xen_to_C_char_(text), Xen_to_C_int(length), Xen_to_C_PangoAnalysis_(analysis),
+ Xen_to_C_int(index), Xen_to_C_gboolean(trailing), &ref_x_pos);
+ return(Xen_list_1(C_to_Xen_int(ref_x_pos)));
}
-static XEN gxg_gtk_window_activate_default(XEN window)
+static Xen gxg_pango_glyph_string_x_to_index(Xen glyphs, Xen text, Xen length, Xen analysis, Xen x_pos, Xen ignore_index, Xen ignore_trailing)
{
- #define H_gtk_window_activate_default "gboolean gtk_window_activate_default(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_activate_default", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_activate_default(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_glyph_string_x_to_index "void pango_glyph_string_x_to_index(PangoGlyphString* glyphs, \
+char* text, int length, PangoAnalysis* analysis, int x_pos, int* [index], int* [trailing])"
+ int ref_index;
+ int ref_trailing;
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 1, "pango_glyph_string_x_to_index", "PangoGlyphString*");
+ Xen_check_type(Xen_is_char_(text), text, 2, "pango_glyph_string_x_to_index", "char*");
+ Xen_check_type(Xen_is_int(length), length, 3, "pango_glyph_string_x_to_index", "int");
+ Xen_check_type(Xen_is_PangoAnalysis_(analysis), analysis, 4, "pango_glyph_string_x_to_index", "PangoAnalysis*");
+ Xen_check_type(Xen_is_int(x_pos), x_pos, 5, "pango_glyph_string_x_to_index", "int");
+ pango_glyph_string_x_to_index(Xen_to_C_PangoGlyphString_(glyphs), Xen_to_C_char_(text), Xen_to_C_int(length), Xen_to_C_PangoAnalysis_(analysis),
+ Xen_to_C_int(x_pos), &ref_index, &ref_trailing);
+ return(Xen_list_2(C_to_Xen_int(ref_index), C_to_Xen_int(ref_trailing)));
}
-static XEN gxg_gtk_window_set_transient_for(XEN window, XEN parent)
+static Xen gxg_pango_shape(Xen text, Xen length, Xen analysis, Xen glyphs)
{
- #define H_gtk_window_set_transient_for "void gtk_window_set_transient_for(GtkWindow* window, GtkWindow* parent)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_transient_for", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(parent) || XEN_FALSE_P(parent), parent, 2, "gtk_window_set_transient_for", "GtkWindow*");
- gtk_window_set_transient_for(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GtkWindow_(parent));
- return(XEN_FALSE);
+ #define H_pango_shape "void pango_shape(gchar* text, gint length, PangoAnalysis* analysis, PangoGlyphString* glyphs)"
+ Xen_check_type(Xen_is_gchar_(text), text, 1, "pango_shape", "gchar*");
+ Xen_check_type(Xen_is_gint(length), length, 2, "pango_shape", "gint");
+ Xen_check_type(Xen_is_PangoAnalysis_(analysis), analysis, 3, "pango_shape", "PangoAnalysis*");
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 4, "pango_shape", "PangoGlyphString*");
+ pango_shape(Xen_to_C_gchar_(text), Xen_to_C_gint(length), Xen_to_C_PangoAnalysis_(analysis), Xen_to_C_PangoGlyphString_(glyphs));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_transient_for(XEN window)
+static Xen gxg_pango_reorder_items(Xen logical_items)
{
- #define H_gtk_window_get_transient_for "GtkWindow* gtk_window_get_transient_for(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_transient_for", "GtkWindow*");
- return(C_TO_XEN_GtkWindow_(gtk_window_get_transient_for(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_reorder_items "GList* pango_reorder_items(GList* logical_items)"
+ Xen_check_type(Xen_is_GList_(logical_items), logical_items, 1, "pango_reorder_items", "GList*");
+ return(C_to_Xen_GList_(pango_reorder_items(Xen_to_C_GList_(logical_items))));
}
-static XEN gxg_gtk_window_set_type_hint(XEN window, XEN hint)
+static Xen gxg_pango_item_new(void)
{
- #define H_gtk_window_set_type_hint "void gtk_window_set_type_hint(GtkWindow* window, GdkWindowTypeHint hint)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_type_hint", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindowTypeHint_P(hint), hint, 2, "gtk_window_set_type_hint", "GdkWindowTypeHint");
- gtk_window_set_type_hint(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkWindowTypeHint(hint));
- return(XEN_FALSE);
+ #define H_pango_item_new "PangoItem* pango_item_new( void)"
+ return(C_to_Xen_PangoItem_(pango_item_new()));
}
-static XEN gxg_gtk_window_get_type_hint(XEN window)
+static Xen gxg_pango_item_copy(Xen item)
{
- #define H_gtk_window_get_type_hint "GdkWindowTypeHint gtk_window_get_type_hint(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_type_hint", "GtkWindow*");
- return(C_TO_XEN_GdkWindowTypeHint(gtk_window_get_type_hint(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_item_copy "PangoItem* pango_item_copy(PangoItem* item)"
+ Xen_check_type(Xen_is_PangoItem_(item), item, 1, "pango_item_copy", "PangoItem*");
+ return(C_to_Xen_PangoItem_(pango_item_copy(Xen_to_C_PangoItem_(item))));
}
-static XEN gxg_gtk_window_set_destroy_with_parent(XEN window, XEN setting)
+static Xen gxg_pango_item_free(Xen item)
{
- #define H_gtk_window_set_destroy_with_parent "void gtk_window_set_destroy_with_parent(GtkWindow* window, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_destroy_with_parent", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_destroy_with_parent", "gboolean");
- gtk_window_set_destroy_with_parent(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_pango_item_free "void pango_item_free(PangoItem* item)"
+ Xen_check_type(Xen_is_PangoItem_(item), item, 1, "pango_item_free", "PangoItem*");
+ pango_item_free(Xen_to_C_PangoItem_(item));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_destroy_with_parent(XEN window)
+static Xen gxg_pango_item_split(Xen orig, Xen split_index, Xen split_offset)
{
- #define H_gtk_window_get_destroy_with_parent "gboolean gtk_window_get_destroy_with_parent(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_destroy_with_parent", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_destroy_with_parent(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_item_split "PangoItem* pango_item_split(PangoItem* orig, int split_index, int split_offset)"
+ Xen_check_type(Xen_is_PangoItem_(orig), orig, 1, "pango_item_split", "PangoItem*");
+ Xen_check_type(Xen_is_int(split_index), split_index, 2, "pango_item_split", "int");
+ Xen_check_type(Xen_is_int(split_offset), split_offset, 3, "pango_item_split", "int");
+ return(C_to_Xen_PangoItem_(pango_item_split(Xen_to_C_PangoItem_(orig), Xen_to_C_int(split_index), Xen_to_C_int(split_offset))));
}
-static XEN gxg_gtk_window_set_resizable(XEN window, XEN resizable)
+static Xen gxg_pango_layout_new(Xen context)
{
- #define H_gtk_window_set_resizable "void gtk_window_set_resizable(GtkWindow* window, gboolean resizable)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_resizable", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(resizable), resizable, 2, "gtk_window_set_resizable", "gboolean");
- gtk_window_set_resizable(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(resizable));
- return(XEN_FALSE);
+ #define H_pango_layout_new "PangoLayout* pango_layout_new(PangoContext* context)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_layout_new", "PangoContext*");
+ return(C_to_Xen_PangoLayout_(pango_layout_new(Xen_to_C_PangoContext_(context))));
}
-static XEN gxg_gtk_window_get_resizable(XEN window)
+static Xen gxg_pango_layout_copy(Xen src)
{
- #define H_gtk_window_get_resizable "gboolean gtk_window_get_resizable(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_resizable", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_resizable(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_layout_copy "PangoLayout* pango_layout_copy(PangoLayout* src)"
+ Xen_check_type(Xen_is_PangoLayout_(src), src, 1, "pango_layout_copy", "PangoLayout*");
+ return(C_to_Xen_PangoLayout_(pango_layout_copy(Xen_to_C_PangoLayout_(src))));
}
-static XEN gxg_gtk_window_set_gravity(XEN window, XEN gravity)
+static Xen gxg_pango_layout_get_context(Xen layout)
{
- #define H_gtk_window_set_gravity "void gtk_window_set_gravity(GtkWindow* window, GdkGravity gravity)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_gravity", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkGravity_P(gravity), gravity, 2, "gtk_window_set_gravity", "GdkGravity");
- gtk_window_set_gravity(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkGravity(gravity));
- return(XEN_FALSE);
+ #define H_pango_layout_get_context "PangoContext* pango_layout_get_context(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_context", "PangoLayout*");
+ return(C_to_Xen_PangoContext_(pango_layout_get_context(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_get_gravity(XEN window)
+static Xen gxg_pango_layout_set_attributes(Xen layout, Xen attrs)
{
- #define H_gtk_window_get_gravity "GdkGravity gtk_window_get_gravity(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_gravity", "GtkWindow*");
- return(C_TO_XEN_GdkGravity(gtk_window_get_gravity(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_layout_set_attributes "void pango_layout_set_attributes(PangoLayout* layout, PangoAttrList* attrs)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_attributes", "PangoLayout*");
+ Xen_check_type(Xen_is_PangoAttrList_(attrs), attrs, 2, "pango_layout_set_attributes", "PangoAttrList*");
+ pango_layout_set_attributes(Xen_to_C_PangoLayout_(layout), Xen_to_C_PangoAttrList_(attrs));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_geometry_hints(XEN window, XEN geometry_widget, XEN geometry, XEN geom_mask)
+static Xen gxg_pango_layout_get_attributes(Xen layout)
{
- #define H_gtk_window_set_geometry_hints "void gtk_window_set_geometry_hints(GtkWindow* window, GtkWidget* geometry_widget, \
-GdkGeometry* geometry, GdkWindowHints geom_mask)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_geometry_hints", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(geometry_widget), geometry_widget, 2, "gtk_window_set_geometry_hints", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkGeometry__P(geometry), geometry, 3, "gtk_window_set_geometry_hints", "GdkGeometry*");
- XEN_ASSERT_TYPE(XEN_GdkWindowHints_P(geom_mask), geom_mask, 4, "gtk_window_set_geometry_hints", "GdkWindowHints");
- gtk_window_set_geometry_hints(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GtkWidget_(geometry_widget), XEN_TO_C_GdkGeometry_(geometry),
- XEN_TO_C_GdkWindowHints(geom_mask));
- return(XEN_FALSE);
+ #define H_pango_layout_get_attributes "PangoAttrList* pango_layout_get_attributes(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_attributes", "PangoLayout*");
+ return(C_to_Xen_PangoAttrList_(pango_layout_get_attributes(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_set_decorated(XEN window, XEN setting)
+static Xen gxg_pango_layout_set_text(Xen layout, Xen text, Xen length)
{
- #define H_gtk_window_set_decorated "void gtk_window_set_decorated(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_decorated", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_decorated", "gboolean");
- gtk_window_set_decorated(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_pango_layout_set_text "void pango_layout_set_text(PangoLayout* layout, char* text, int length)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_text", "PangoLayout*");
+ Xen_check_type(Xen_is_char_(text), text, 2, "pango_layout_set_text", "char*");
+ Xen_check_type(Xen_is_int(length), length, 3, "pango_layout_set_text", "int");
+ pango_layout_set_text(Xen_to_C_PangoLayout_(layout), Xen_to_C_char_(text), Xen_to_C_int(length));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_decorated(XEN window)
+static Xen gxg_pango_layout_get_text(Xen layout)
{
- #define H_gtk_window_get_decorated "gboolean gtk_window_get_decorated(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_decorated", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_decorated(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_layout_get_text "char* pango_layout_get_text(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_text", "PangoLayout*");
+ return(C_to_Xen_char_(pango_layout_get_text(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_set_icon_list(XEN window, XEN list)
+static Xen gxg_pango_layout_set_markup(Xen layout, Xen markup, Xen length)
{
- #define H_gtk_window_set_icon_list "void gtk_window_set_icon_list(GtkWindow* window, GList* list)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_icon_list", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GList__P(list) || XEN_FALSE_P(list), list, 2, "gtk_window_set_icon_list", "GList*");
- gtk_window_set_icon_list(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GList_(list));
- return(XEN_FALSE);
+ #define H_pango_layout_set_markup "void pango_layout_set_markup(PangoLayout* layout, char* markup, \
+int length)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_markup", "PangoLayout*");
+ Xen_check_type(Xen_is_char_(markup), markup, 2, "pango_layout_set_markup", "char*");
+ Xen_check_type(Xen_is_int(length), length, 3, "pango_layout_set_markup", "int");
+ pango_layout_set_markup(Xen_to_C_PangoLayout_(layout), Xen_to_C_char_(markup), Xen_to_C_int(length));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_icon_list(XEN window)
+static Xen gxg_pango_layout_set_markup_with_accel(Xen layout, Xen markup, Xen length, Xen accel_marker, Xen accel_char)
{
- #define H_gtk_window_get_icon_list "GList* gtk_window_get_icon_list(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_icon_list", "GtkWindow*");
- return(C_TO_XEN_GList_(gtk_window_get_icon_list(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_layout_set_markup_with_accel "void pango_layout_set_markup_with_accel(PangoLayout* layout, \
+char* markup, int length, gunichar accel_marker, gunichar* accel_char)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_markup_with_accel", "PangoLayout*");
+ Xen_check_type(Xen_is_char_(markup), markup, 2, "pango_layout_set_markup_with_accel", "char*");
+ Xen_check_type(Xen_is_int(length), length, 3, "pango_layout_set_markup_with_accel", "int");
+ Xen_check_type(Xen_is_gunichar(accel_marker), accel_marker, 4, "pango_layout_set_markup_with_accel", "gunichar");
+ Xen_check_type(Xen_is_gunichar_(accel_char), accel_char, 5, "pango_layout_set_markup_with_accel", "gunichar*");
+ pango_layout_set_markup_with_accel(Xen_to_C_PangoLayout_(layout), Xen_to_C_char_(markup), Xen_to_C_int(length), Xen_to_C_gunichar(accel_marker),
+ Xen_to_C_gunichar_(accel_char));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_icon(XEN window, XEN icon)
+static Xen gxg_pango_layout_set_font_description(Xen layout, Xen desc)
{
- #define H_gtk_window_set_icon "void gtk_window_set_icon(GtkWindow* window, GdkPixbuf* icon)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_icon", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(icon) || XEN_FALSE_P(icon), icon, 2, "gtk_window_set_icon", "GdkPixbuf*");
- gtk_window_set_icon(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkPixbuf_(icon));
- return(XEN_FALSE);
+ #define H_pango_layout_set_font_description "void pango_layout_set_font_description(PangoLayout* layout, \
+PangoFontDescription* desc)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_font_description", "PangoLayout*");
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 2, "pango_layout_set_font_description", "PangoFontDescription*");
+ pango_layout_set_font_description(Xen_to_C_PangoLayout_(layout), Xen_to_C_PangoFontDescription_(desc));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_icon(XEN window)
+static Xen gxg_pango_layout_set_width(Xen layout, Xen width)
{
- #define H_gtk_window_get_icon "GdkPixbuf* gtk_window_get_icon(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_icon", "GtkWindow*");
- return(C_TO_XEN_GdkPixbuf_(gtk_window_get_icon(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_layout_set_width "void pango_layout_set_width(PangoLayout* layout, int width)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_width", "PangoLayout*");
+ Xen_check_type(Xen_is_int(width), width, 2, "pango_layout_set_width", "int");
+ pango_layout_set_width(Xen_to_C_PangoLayout_(layout), Xen_to_C_int(width));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_default_icon_list(XEN list)
+static Xen gxg_pango_layout_get_width(Xen layout)
{
- #define H_gtk_window_set_default_icon_list "void gtk_window_set_default_icon_list(GList* list)"
- XEN_ASSERT_TYPE(XEN_GList__P(list) || XEN_FALSE_P(list), list, 1, "gtk_window_set_default_icon_list", "GList*");
- gtk_window_set_default_icon_list(XEN_TO_C_GList_(list));
- return(XEN_FALSE);
+ #define H_pango_layout_get_width "int pango_layout_get_width(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_width", "PangoLayout*");
+ return(C_to_Xen_int(pango_layout_get_width(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_get_default_icon_list(void)
+static Xen gxg_pango_layout_set_wrap(Xen layout, Xen wrap)
{
- #define H_gtk_window_get_default_icon_list "GList* gtk_window_get_default_icon_list( void)"
- return(C_TO_XEN_GList_(gtk_window_get_default_icon_list()));
+ #define H_pango_layout_set_wrap "void pango_layout_set_wrap(PangoLayout* layout, PangoWrapMode wrap)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_wrap", "PangoLayout*");
+ Xen_check_type(Xen_is_PangoWrapMode(wrap), wrap, 2, "pango_layout_set_wrap", "PangoWrapMode");
+ pango_layout_set_wrap(Xen_to_C_PangoLayout_(layout), Xen_to_C_PangoWrapMode(wrap));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_modal(XEN window, XEN modal)
+static Xen gxg_pango_layout_get_wrap(Xen layout)
{
- #define H_gtk_window_set_modal "void gtk_window_set_modal(GtkWindow* window, gboolean modal)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_modal", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(modal), modal, 2, "gtk_window_set_modal", "gboolean");
- gtk_window_set_modal(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(modal));
- return(XEN_FALSE);
+ #define H_pango_layout_get_wrap "PangoWrapMode pango_layout_get_wrap(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_wrap", "PangoLayout*");
+ return(C_to_Xen_PangoWrapMode(pango_layout_get_wrap(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_get_modal(XEN window)
+static Xen gxg_pango_layout_set_indent(Xen layout, Xen indent)
{
- #define H_gtk_window_get_modal "gboolean gtk_window_get_modal(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_modal", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_modal(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_layout_set_indent "void pango_layout_set_indent(PangoLayout* layout, int indent)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_indent", "PangoLayout*");
+ Xen_check_type(Xen_is_int(indent), indent, 2, "pango_layout_set_indent", "int");
+ pango_layout_set_indent(Xen_to_C_PangoLayout_(layout), Xen_to_C_int(indent));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_list_toplevels(void)
+static Xen gxg_pango_layout_get_indent(Xen layout)
{
- #define H_gtk_window_list_toplevels "GList* gtk_window_list_toplevels( void)"
- return(C_TO_XEN_GList_(gtk_window_list_toplevels()));
+ #define H_pango_layout_get_indent "int pango_layout_get_indent(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_indent", "PangoLayout*");
+ return(C_to_Xen_int(pango_layout_get_indent(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_add_mnemonic(XEN window, XEN keyval, XEN target)
+static Xen gxg_pango_layout_set_spacing(Xen layout, Xen spacing)
{
- #define H_gtk_window_add_mnemonic "void gtk_window_add_mnemonic(GtkWindow* window, guint keyval, GtkWidget* target)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_add_mnemonic", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_window_add_mnemonic", "guint");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(target), target, 3, "gtk_window_add_mnemonic", "GtkWidget*");
- gtk_window_add_mnemonic(XEN_TO_C_GtkWindow_(window), XEN_TO_C_guint(keyval), XEN_TO_C_GtkWidget_(target));
- return(XEN_FALSE);
+ #define H_pango_layout_set_spacing "void pango_layout_set_spacing(PangoLayout* layout, int spacing)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_spacing", "PangoLayout*");
+ Xen_check_type(Xen_is_int(spacing), spacing, 2, "pango_layout_set_spacing", "int");
+ pango_layout_set_spacing(Xen_to_C_PangoLayout_(layout), Xen_to_C_int(spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_remove_mnemonic(XEN window, XEN keyval, XEN target)
+static Xen gxg_pango_layout_get_spacing(Xen layout)
{
- #define H_gtk_window_remove_mnemonic "void gtk_window_remove_mnemonic(GtkWindow* window, guint keyval, \
-GtkWidget* target)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_remove_mnemonic", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_window_remove_mnemonic", "guint");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(target), target, 3, "gtk_window_remove_mnemonic", "GtkWidget*");
- gtk_window_remove_mnemonic(XEN_TO_C_GtkWindow_(window), XEN_TO_C_guint(keyval), XEN_TO_C_GtkWidget_(target));
- return(XEN_FALSE);
+ #define H_pango_layout_get_spacing "int pango_layout_get_spacing(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_spacing", "PangoLayout*");
+ return(C_to_Xen_int(pango_layout_get_spacing(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_mnemonic_activate(XEN window, XEN keyval, XEN modifier)
+static Xen gxg_pango_layout_set_justify(Xen layout, Xen justify)
{
- #define H_gtk_window_mnemonic_activate "gboolean gtk_window_mnemonic_activate(GtkWindow* window, guint keyval, \
-GdkModifierType modifier)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_mnemonic_activate", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_window_mnemonic_activate", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifier), modifier, 3, "gtk_window_mnemonic_activate", "GdkModifierType");
- return(C_TO_XEN_gboolean(gtk_window_mnemonic_activate(XEN_TO_C_GtkWindow_(window), XEN_TO_C_guint(keyval), XEN_TO_C_GdkModifierType(modifier))));
+ #define H_pango_layout_set_justify "void pango_layout_set_justify(PangoLayout* layout, gboolean justify)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_justify", "PangoLayout*");
+ Xen_check_type(Xen_is_gboolean(justify), justify, 2, "pango_layout_set_justify", "gboolean");
+ pango_layout_set_justify(Xen_to_C_PangoLayout_(layout), Xen_to_C_gboolean(justify));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_mnemonic_modifier(XEN window, XEN modifier)
+static Xen gxg_pango_layout_get_justify(Xen layout)
{
- #define H_gtk_window_set_mnemonic_modifier "void gtk_window_set_mnemonic_modifier(GtkWindow* window, \
-GdkModifierType modifier)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_mnemonic_modifier", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifier), modifier, 2, "gtk_window_set_mnemonic_modifier", "GdkModifierType");
- gtk_window_set_mnemonic_modifier(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkModifierType(modifier));
- return(XEN_FALSE);
+ #define H_pango_layout_get_justify "gboolean pango_layout_get_justify(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_justify", "PangoLayout*");
+ return(C_to_Xen_gboolean(pango_layout_get_justify(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_get_mnemonic_modifier(XEN window)
+static Xen gxg_pango_layout_set_alignment(Xen layout, Xen alignment)
{
- #define H_gtk_window_get_mnemonic_modifier "GdkModifierType gtk_window_get_mnemonic_modifier(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_mnemonic_modifier", "GtkWindow*");
- return(C_TO_XEN_GdkModifierType(gtk_window_get_mnemonic_modifier(XEN_TO_C_GtkWindow_(window))));
+ #define H_pango_layout_set_alignment "void pango_layout_set_alignment(PangoLayout* layout, PangoAlignment alignment)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_alignment", "PangoLayout*");
+ Xen_check_type(Xen_is_PangoAlignment(alignment), alignment, 2, "pango_layout_set_alignment", "PangoAlignment");
+ pango_layout_set_alignment(Xen_to_C_PangoLayout_(layout), Xen_to_C_PangoAlignment(alignment));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_present(XEN window)
+static Xen gxg_pango_layout_get_alignment(Xen layout)
{
- #define H_gtk_window_present "void gtk_window_present(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_present", "GtkWindow*");
- gtk_window_present(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_pango_layout_get_alignment "PangoAlignment pango_layout_get_alignment(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_alignment", "PangoLayout*");
+ return(C_to_Xen_PangoAlignment(pango_layout_get_alignment(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_iconify(XEN window)
+static Xen gxg_pango_layout_set_tabs(Xen layout, Xen tabs)
{
- #define H_gtk_window_iconify "void gtk_window_iconify(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_iconify", "GtkWindow*");
- gtk_window_iconify(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_pango_layout_set_tabs "void pango_layout_set_tabs(PangoLayout* layout, PangoTabArray* tabs)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_tabs", "PangoLayout*");
+ Xen_check_type(Xen_is_PangoTabArray_(tabs) || Xen_is_false(tabs), tabs, 2, "pango_layout_set_tabs", "PangoTabArray*");
+ pango_layout_set_tabs(Xen_to_C_PangoLayout_(layout), Xen_to_C_PangoTabArray_(tabs));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_deiconify(XEN window)
+static Xen gxg_pango_layout_get_tabs(Xen layout)
{
- #define H_gtk_window_deiconify "void gtk_window_deiconify(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_deiconify", "GtkWindow*");
- gtk_window_deiconify(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_pango_layout_get_tabs "PangoTabArray* pango_layout_get_tabs(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_tabs", "PangoLayout*");
+ return(C_to_Xen_PangoTabArray_(pango_layout_get_tabs(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_stick(XEN window)
+static Xen gxg_pango_layout_set_single_paragraph_mode(Xen layout, Xen setting)
{
- #define H_gtk_window_stick "void gtk_window_stick(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_stick", "GtkWindow*");
- gtk_window_stick(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_pango_layout_set_single_paragraph_mode "void pango_layout_set_single_paragraph_mode(PangoLayout* layout, \
+gboolean setting)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_single_paragraph_mode", "PangoLayout*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "pango_layout_set_single_paragraph_mode", "gboolean");
+ pango_layout_set_single_paragraph_mode(Xen_to_C_PangoLayout_(layout), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_unstick(XEN window)
+static Xen gxg_pango_layout_get_single_paragraph_mode(Xen layout)
{
- #define H_gtk_window_unstick "void gtk_window_unstick(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_unstick", "GtkWindow*");
- gtk_window_unstick(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_pango_layout_get_single_paragraph_mode "gboolean pango_layout_get_single_paragraph_mode(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_single_paragraph_mode", "PangoLayout*");
+ return(C_to_Xen_gboolean(pango_layout_get_single_paragraph_mode(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_maximize(XEN window)
+static Xen gxg_pango_layout_context_changed(Xen layout)
{
- #define H_gtk_window_maximize "void gtk_window_maximize(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_maximize", "GtkWindow*");
- gtk_window_maximize(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_pango_layout_context_changed "void pango_layout_context_changed(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_context_changed", "PangoLayout*");
+ pango_layout_context_changed(Xen_to_C_PangoLayout_(layout));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_unmaximize(XEN window)
+static Xen gxg_pango_layout_get_log_attrs(Xen layout, Xen ignore_attrs, Xen ignore_n_attrs)
{
- #define H_gtk_window_unmaximize "void gtk_window_unmaximize(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_unmaximize", "GtkWindow*");
- gtk_window_unmaximize(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_pango_layout_get_log_attrs "void pango_layout_get_log_attrs(PangoLayout* layout, PangoLogAttr** [attrs], \
+gint* [n_attrs])"
+ PangoLogAttr* ref_attrs = NULL;
+ gint ref_n_attrs;
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_log_attrs", "PangoLayout*");
+ pango_layout_get_log_attrs(Xen_to_C_PangoLayout_(layout), &ref_attrs, &ref_n_attrs);
+ return(Xen_list_2(C_to_Xen_PangoLogAttr_(ref_attrs), C_to_Xen_gint(ref_n_attrs)));
}
-static XEN gxg_gtk_window_begin_resize_drag(XEN window, XEN edge, XEN button, XEN root_x, XEN root_y, XEN timestamp)
+static Xen gxg_pango_layout_index_to_pos(Xen layout, Xen index, Xen pos)
{
- #define H_gtk_window_begin_resize_drag "void gtk_window_begin_resize_drag(GtkWindow* window, GdkWindowEdge edge, \
-gint button, gint root_x, gint root_y, guint32 timestamp)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_begin_resize_drag", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindowEdge_P(edge), edge, 2, "gtk_window_begin_resize_drag", "GdkWindowEdge");
- XEN_ASSERT_TYPE(XEN_gint_P(button), button, 3, "gtk_window_begin_resize_drag", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(root_x), root_x, 4, "gtk_window_begin_resize_drag", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(root_y), root_y, 5, "gtk_window_begin_resize_drag", "gint");
- XEN_ASSERT_TYPE(XEN_guint32_P(timestamp), timestamp, 6, "gtk_window_begin_resize_drag", "guint32");
- gtk_window_begin_resize_drag(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkWindowEdge(edge), XEN_TO_C_gint(button), XEN_TO_C_gint(root_x),
- XEN_TO_C_gint(root_y), XEN_TO_C_guint32(timestamp));
- return(XEN_FALSE);
+ #define H_pango_layout_index_to_pos "void pango_layout_index_to_pos(PangoLayout* layout, int index, \
+PangoRectangle* pos)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_index_to_pos", "PangoLayout*");
+ Xen_check_type(Xen_is_int(index), index, 2, "pango_layout_index_to_pos", "int");
+ Xen_check_type(Xen_is_PangoRectangle_(pos), pos, 3, "pango_layout_index_to_pos", "PangoRectangle*");
+ pango_layout_index_to_pos(Xen_to_C_PangoLayout_(layout), Xen_to_C_int(index), Xen_to_C_PangoRectangle_(pos));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_begin_move_drag(XEN window, XEN button, XEN root_x, XEN root_y, XEN timestamp)
+static Xen gxg_pango_layout_get_cursor_pos(Xen layout, Xen index, Xen strong_pos, Xen weak_pos)
{
- #define H_gtk_window_begin_move_drag "void gtk_window_begin_move_drag(GtkWindow* window, gint button, \
-gint root_x, gint root_y, guint32 timestamp)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_begin_move_drag", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(button), button, 2, "gtk_window_begin_move_drag", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(root_x), root_x, 3, "gtk_window_begin_move_drag", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(root_y), root_y, 4, "gtk_window_begin_move_drag", "gint");
- XEN_ASSERT_TYPE(XEN_guint32_P(timestamp), timestamp, 5, "gtk_window_begin_move_drag", "guint32");
- gtk_window_begin_move_drag(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gint(button), XEN_TO_C_gint(root_x), XEN_TO_C_gint(root_y),
- XEN_TO_C_guint32(timestamp));
- return(XEN_FALSE);
+ #define H_pango_layout_get_cursor_pos "void pango_layout_get_cursor_pos(PangoLayout* layout, int index, \
+PangoRectangle* strong_pos, PangoRectangle* weak_pos)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_cursor_pos", "PangoLayout*");
+ Xen_check_type(Xen_is_int(index), index, 2, "pango_layout_get_cursor_pos", "int");
+ Xen_check_type(Xen_is_PangoRectangle_(strong_pos), strong_pos, 3, "pango_layout_get_cursor_pos", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(weak_pos), weak_pos, 4, "pango_layout_get_cursor_pos", "PangoRectangle*");
+ pango_layout_get_cursor_pos(Xen_to_C_PangoLayout_(layout), Xen_to_C_int(index), Xen_to_C_PangoRectangle_(strong_pos), Xen_to_C_PangoRectangle_(weak_pos));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_default_size(XEN window, XEN width, XEN height)
+static Xen gxg_pango_layout_move_cursor_visually(Xen layout, Xen strong, Xen old_index, Xen old_trailing, Xen direction, Xen new_index, Xen new_trailing)
{
- #define H_gtk_window_set_default_size "void gtk_window_set_default_size(GtkWindow* window, gint width, \
-gint height)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_default_size", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_window_set_default_size", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gtk_window_set_default_size", "gint");
- gtk_window_set_default_size(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_pango_layout_move_cursor_visually "void pango_layout_move_cursor_visually(PangoLayout* layout, \
+gboolean strong, int old_index, int old_trailing, int direction, int* new_index, int* new_trailing)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_move_cursor_visually", "PangoLayout*");
+ Xen_check_type(Xen_is_gboolean(strong), strong, 2, "pango_layout_move_cursor_visually", "gboolean");
+ Xen_check_type(Xen_is_int(old_index), old_index, 3, "pango_layout_move_cursor_visually", "int");
+ Xen_check_type(Xen_is_int(old_trailing), old_trailing, 4, "pango_layout_move_cursor_visually", "int");
+ Xen_check_type(Xen_is_int(direction), direction, 5, "pango_layout_move_cursor_visually", "int");
+ Xen_check_type(Xen_is_int_(new_index), new_index, 6, "pango_layout_move_cursor_visually", "int*");
+ Xen_check_type(Xen_is_int_(new_trailing), new_trailing, 7, "pango_layout_move_cursor_visually", "int*");
+ pango_layout_move_cursor_visually(Xen_to_C_PangoLayout_(layout), Xen_to_C_gboolean(strong), Xen_to_C_int(old_index), Xen_to_C_int(old_trailing),
+ Xen_to_C_int(direction), Xen_to_C_int_(new_index), Xen_to_C_int_(new_trailing));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_default_size(XEN window, XEN ignore_width, XEN ignore_height)
+static Xen gxg_pango_layout_xy_to_index(Xen layout, Xen x, Xen y, Xen ignore_index, Xen ignore_trailing)
{
- #define H_gtk_window_get_default_size "void gtk_window_get_default_size(GtkWindow* window, gint* [width], \
-gint* [height])"
- gint ref_width;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_default_size", "GtkWindow*");
- gtk_window_get_default_size(XEN_TO_C_GtkWindow_(window), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ #define H_pango_layout_xy_to_index "gboolean pango_layout_xy_to_index(PangoLayout* layout, int x, int y, \
+int* [index], int* [trailing])"
+ int ref_index;
+ int ref_trailing;
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_xy_to_index", "PangoLayout*");
+ Xen_check_type(Xen_is_int(x), x, 2, "pango_layout_xy_to_index", "int");
+ Xen_check_type(Xen_is_int(y), y, 3, "pango_layout_xy_to_index", "int");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(pango_layout_xy_to_index(Xen_to_C_PangoLayout_(layout), Xen_to_C_int(x), Xen_to_C_int(y),
+ &ref_index, &ref_trailing));
+ return(Xen_list_3(result, C_to_Xen_int(ref_index), C_to_Xen_int(ref_trailing)));
+ }
}
-static XEN gxg_gtk_window_resize(XEN window, XEN width, XEN height)
+static Xen gxg_pango_layout_get_extents(Xen layout, Xen ink_rect, Xen logical_rect)
{
- #define H_gtk_window_resize "void gtk_window_resize(GtkWindow* window, gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_resize", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_window_resize", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gtk_window_resize", "gint");
- gtk_window_resize(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_pango_layout_get_extents "void pango_layout_get_extents(PangoLayout* layout, PangoRectangle* ink_rect, \
+PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_extents", "PangoLayout*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 2, "pango_layout_get_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 3, "pango_layout_get_extents", "PangoRectangle*");
+ pango_layout_get_extents(Xen_to_C_PangoLayout_(layout), Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_size(XEN window, XEN ignore_width, XEN ignore_height)
+static Xen gxg_pango_layout_get_pixel_extents(Xen layout, Xen ink_rect, Xen logical_rect)
{
- #define H_gtk_window_get_size "void gtk_window_get_size(GtkWindow* window, gint* [width], gint* [height])"
- gint ref_width;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_size", "GtkWindow*");
- gtk_window_get_size(XEN_TO_C_GtkWindow_(window), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ #define H_pango_layout_get_pixel_extents "void pango_layout_get_pixel_extents(PangoLayout* layout, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_pixel_extents", "PangoLayout*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 2, "pango_layout_get_pixel_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 3, "pango_layout_get_pixel_extents", "PangoRectangle*");
+ pango_layout_get_pixel_extents(Xen_to_C_PangoLayout_(layout), Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_move(XEN window, XEN x, XEN y)
+static Xen gxg_pango_layout_get_size(Xen layout, Xen ignore_width, Xen ignore_height)
{
- #define H_gtk_window_move "void gtk_window_move(GtkWindow* window, gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_move", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_window_move", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_window_move", "gint");
- gtk_window_move(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
+ #define H_pango_layout_get_size "void pango_layout_get_size(PangoLayout* layout, int* [width], int* [height])"
+ int ref_width;
+ int ref_height;
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_size", "PangoLayout*");
+ pango_layout_get_size(Xen_to_C_PangoLayout_(layout), &ref_width, &ref_height);
+ return(Xen_list_2(C_to_Xen_int(ref_width), C_to_Xen_int(ref_height)));
}
-static XEN gxg_gtk_window_get_position(XEN window, XEN ignore_root_x, XEN ignore_root_y)
+static Xen gxg_pango_layout_get_pixel_size(Xen layout, Xen ignore_width, Xen ignore_height)
{
- #define H_gtk_window_get_position "void gtk_window_get_position(GtkWindow* window, gint* [root_x], \
-gint* [root_y])"
- gint ref_root_x;
- gint ref_root_y;
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_position", "GtkWindow*");
- gtk_window_get_position(XEN_TO_C_GtkWindow_(window), &ref_root_x, &ref_root_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_root_x), C_TO_XEN_gint(ref_root_y)));
+ #define H_pango_layout_get_pixel_size "void pango_layout_get_pixel_size(PangoLayout* layout, int* [width], \
+int* [height])"
+ int ref_width;
+ int ref_height;
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_pixel_size", "PangoLayout*");
+ pango_layout_get_pixel_size(Xen_to_C_PangoLayout_(layout), &ref_width, &ref_height);
+ return(Xen_list_2(C_to_Xen_int(ref_width), C_to_Xen_int(ref_height)));
}
-static XEN gxg_gtk_window_parse_geometry(XEN window, XEN geometry)
+static Xen gxg_pango_layout_get_line_count(Xen layout)
{
- #define H_gtk_window_parse_geometry "gboolean gtk_window_parse_geometry(GtkWindow* window, gchar* geometry)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_parse_geometry", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(geometry), geometry, 2, "gtk_window_parse_geometry", "gchar*");
- return(C_TO_XEN_gboolean(gtk_window_parse_geometry(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gchar_(geometry))));
+ #define H_pango_layout_get_line_count "int pango_layout_get_line_count(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_line_count", "PangoLayout*");
+ return(C_to_Xen_int(pango_layout_get_line_count(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_window_reshow_with_initial_size(XEN window)
+static Xen gxg_pango_layout_get_line(Xen layout, Xen line)
{
- #define H_gtk_window_reshow_with_initial_size "void gtk_window_reshow_with_initial_size(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_reshow_with_initial_size", "GtkWindow*");
- gtk_window_reshow_with_initial_size(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_pango_layout_get_line "PangoLayoutLine* pango_layout_get_line(PangoLayout* layout, int line)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_line", "PangoLayout*");
+ Xen_check_type(Xen_is_int(line), line, 2, "pango_layout_get_line", "int");
+ return(C_to_Xen_PangoLayoutLine_(pango_layout_get_line(Xen_to_C_PangoLayout_(layout), Xen_to_C_int(line))));
}
-static XEN gxg_pango_color_copy(XEN src)
+static Xen gxg_pango_layout_get_lines(Xen layout)
{
- #define H_pango_color_copy "PangoColor* pango_color_copy(PangoColor* src)"
- XEN_ASSERT_TYPE(XEN_PangoColor__P(src), src, 1, "pango_color_copy", "PangoColor*");
- return(C_TO_XEN_PangoColor_(pango_color_copy(XEN_TO_C_PangoColor_(src))));
+ #define H_pango_layout_get_lines "GSList* pango_layout_get_lines(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_lines", "PangoLayout*");
+ return(C_to_Xen_GSList_(pango_layout_get_lines(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_pango_color_free(XEN color)
+static Xen gxg_pango_layout_line_unref(Xen line)
{
- #define H_pango_color_free "void pango_color_free(PangoColor* color)"
- XEN_ASSERT_TYPE(XEN_PangoColor__P(color), color, 1, "pango_color_free", "PangoColor*");
- pango_color_free(XEN_TO_C_PangoColor_(color));
- return(XEN_FALSE);
+ #define H_pango_layout_line_unref "void pango_layout_line_unref(PangoLayoutLine* line)"
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 1, "pango_layout_line_unref", "PangoLayoutLine*");
+ pango_layout_line_unref(Xen_to_C_PangoLayoutLine_(line));
+ return(Xen_false);
}
-static XEN gxg_pango_color_parse(XEN color, XEN spec)
+static Xen gxg_pango_layout_line_x_to_index(Xen line, Xen x_pos, Xen ignore_index, Xen ignore_trailing)
{
- #define H_pango_color_parse "gboolean pango_color_parse(PangoColor* color, char* spec)"
- XEN_ASSERT_TYPE(XEN_PangoColor__P(color), color, 1, "pango_color_parse", "PangoColor*");
- XEN_ASSERT_TYPE(XEN_char__P(spec), spec, 2, "pango_color_parse", "char*");
- return(C_TO_XEN_gboolean(pango_color_parse(XEN_TO_C_PangoColor_(color), XEN_TO_C_char_(spec))));
+ #define H_pango_layout_line_x_to_index "gboolean pango_layout_line_x_to_index(PangoLayoutLine* line, \
+int x_pos, int* [index], int* [trailing])"
+ int ref_index;
+ int ref_trailing;
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 1, "pango_layout_line_x_to_index", "PangoLayoutLine*");
+ Xen_check_type(Xen_is_int(x_pos), x_pos, 2, "pango_layout_line_x_to_index", "int");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(pango_layout_line_x_to_index(Xen_to_C_PangoLayoutLine_(line), Xen_to_C_int(x_pos), &ref_index,
+ &ref_trailing));
+ return(Xen_list_3(result, C_to_Xen_int(ref_index), C_to_Xen_int(ref_trailing)));
+ }
}
-static XEN gxg_pango_attr_type_register(XEN name)
+static Xen gxg_pango_layout_line_index_to_x(Xen line, Xen index, Xen trailing, Xen ignore_x_pos)
{
- #define H_pango_attr_type_register "PangoAttrType pango_attr_type_register(gchar* name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "pango_attr_type_register", "gchar*");
- return(C_TO_XEN_PangoAttrType(pango_attr_type_register(XEN_TO_C_gchar_(name))));
+ #define H_pango_layout_line_index_to_x "void pango_layout_line_index_to_x(PangoLayoutLine* line, int index, \
+gboolean trailing, int* [x_pos])"
+ int ref_x_pos;
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 1, "pango_layout_line_index_to_x", "PangoLayoutLine*");
+ Xen_check_type(Xen_is_int(index), index, 2, "pango_layout_line_index_to_x", "int");
+ Xen_check_type(Xen_is_gboolean(trailing), trailing, 3, "pango_layout_line_index_to_x", "gboolean");
+ pango_layout_line_index_to_x(Xen_to_C_PangoLayoutLine_(line), Xen_to_C_int(index), Xen_to_C_gboolean(trailing), &ref_x_pos);
+ return(Xen_list_1(C_to_Xen_int(ref_x_pos)));
}
-static XEN gxg_pango_attribute_copy(XEN attr)
+static Xen gxg_pango_layout_line_get_x_ranges(Xen line, Xen start_index, Xen end_index, Xen ignore_ranges, Xen ignore_n_ranges)
{
- #define H_pango_attribute_copy "PangoAttribute* pango_attribute_copy(PangoAttribute* attr)"
- XEN_ASSERT_TYPE(XEN_PangoAttribute__P(attr), attr, 1, "pango_attribute_copy", "PangoAttribute*");
- return(C_TO_XEN_PangoAttribute_(pango_attribute_copy(XEN_TO_C_PangoAttribute_(attr))));
+ #define H_pango_layout_line_get_x_ranges "void pango_layout_line_get_x_ranges(PangoLayoutLine* line, \
+int start_index, int end_index, int** [ranges], int* [n_ranges])"
+ int* ref_ranges = NULL;
+ int ref_n_ranges;
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 1, "pango_layout_line_get_x_ranges", "PangoLayoutLine*");
+ Xen_check_type(Xen_is_int(start_index), start_index, 2, "pango_layout_line_get_x_ranges", "int");
+ Xen_check_type(Xen_is_int(end_index), end_index, 3, "pango_layout_line_get_x_ranges", "int");
+ pango_layout_line_get_x_ranges(Xen_to_C_PangoLayoutLine_(line), Xen_to_C_int(start_index), Xen_to_C_int(end_index), &ref_ranges,
+ &ref_n_ranges);
+ return(Xen_list_2(C_to_Xen_int_(ref_ranges), C_to_Xen_int(ref_n_ranges)));
}
-static XEN gxg_pango_attribute_destroy(XEN attr)
+static Xen gxg_pango_layout_line_get_extents(Xen line, Xen ink_rect, Xen logical_rect)
{
- #define H_pango_attribute_destroy "void pango_attribute_destroy(PangoAttribute* attr)"
- XEN_ASSERT_TYPE(XEN_PangoAttribute__P(attr), attr, 1, "pango_attribute_destroy", "PangoAttribute*");
- pango_attribute_destroy(XEN_TO_C_PangoAttribute_(attr));
- return(XEN_FALSE);
+ #define H_pango_layout_line_get_extents "void pango_layout_line_get_extents(PangoLayoutLine* line, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 1, "pango_layout_line_get_extents", "PangoLayoutLine*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 2, "pango_layout_line_get_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 3, "pango_layout_line_get_extents", "PangoRectangle*");
+ pango_layout_line_get_extents(Xen_to_C_PangoLayoutLine_(line), Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_pango_attribute_equal(XEN attr1, XEN attr2)
+static Xen gxg_pango_layout_line_get_pixel_extents(Xen layout_line, Xen ink_rect, Xen logical_rect)
{
- #define H_pango_attribute_equal "gboolean pango_attribute_equal(PangoAttribute* attr1, PangoAttribute* attr2)"
- XEN_ASSERT_TYPE(XEN_PangoAttribute__P(attr1), attr1, 1, "pango_attribute_equal", "PangoAttribute*");
- XEN_ASSERT_TYPE(XEN_PangoAttribute__P(attr2), attr2, 2, "pango_attribute_equal", "PangoAttribute*");
- return(C_TO_XEN_gboolean(pango_attribute_equal(XEN_TO_C_PangoAttribute_(attr1), XEN_TO_C_PangoAttribute_(attr2))));
+ #define H_pango_layout_line_get_pixel_extents "void pango_layout_line_get_pixel_extents(PangoLayoutLine* layout_line, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayoutLine_(layout_line), layout_line, 1, "pango_layout_line_get_pixel_extents", "PangoLayoutLine*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 2, "pango_layout_line_get_pixel_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 3, "pango_layout_line_get_pixel_extents", "PangoRectangle*");
+ pango_layout_line_get_pixel_extents(Xen_to_C_PangoLayoutLine_(layout_line), Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_language_new(XEN language)
+static Xen gxg_pango_layout_get_iter(Xen layout)
{
- #define H_pango_attr_language_new "PangoAttribute* pango_attr_language_new(PangoLanguage* language)"
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 1, "pango_attr_language_new", "PangoLanguage*");
- return(C_TO_XEN_PangoAttribute_(pango_attr_language_new(XEN_TO_C_PangoLanguage_(language))));
+ #define H_pango_layout_get_iter "PangoLayoutIter* pango_layout_get_iter(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_iter", "PangoLayout*");
+ return(C_to_Xen_PangoLayoutIter_(pango_layout_get_iter(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_pango_attr_family_new(XEN family)
+static Xen gxg_pango_layout_iter_free(Xen iter)
{
- #define H_pango_attr_family_new "PangoAttribute* pango_attr_family_new(char* family)"
- XEN_ASSERT_TYPE(XEN_char__P(family), family, 1, "pango_attr_family_new", "char*");
- return(C_TO_XEN_PangoAttribute_(pango_attr_family_new(XEN_TO_C_char_(family))));
+ #define H_pango_layout_iter_free "void pango_layout_iter_free(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_free", "PangoLayoutIter*");
+ pango_layout_iter_free(Xen_to_C_PangoLayoutIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_foreground_new(XEN red, XEN green, XEN blue)
+static Xen gxg_pango_layout_iter_get_index(Xen iter)
{
- #define H_pango_attr_foreground_new "PangoAttribute* pango_attr_foreground_new(guint16 red, guint16 green, \
-guint16 blue)"
- XEN_ASSERT_TYPE(XEN_guint16_P(red), red, 1, "pango_attr_foreground_new", "guint16");
- XEN_ASSERT_TYPE(XEN_guint16_P(green), green, 2, "pango_attr_foreground_new", "guint16");
- XEN_ASSERT_TYPE(XEN_guint16_P(blue), blue, 3, "pango_attr_foreground_new", "guint16");
- return(C_TO_XEN_PangoAttribute_(pango_attr_foreground_new(XEN_TO_C_guint16(red), XEN_TO_C_guint16(green), XEN_TO_C_guint16(blue))));
+ #define H_pango_layout_iter_get_index "int pango_layout_iter_get_index(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_index", "PangoLayoutIter*");
+ return(C_to_Xen_int(pango_layout_iter_get_index(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_background_new(XEN red, XEN green, XEN blue)
+static Xen gxg_pango_layout_iter_get_run(Xen iter)
{
- #define H_pango_attr_background_new "PangoAttribute* pango_attr_background_new(guint16 red, guint16 green, \
-guint16 blue)"
- XEN_ASSERT_TYPE(XEN_guint16_P(red), red, 1, "pango_attr_background_new", "guint16");
- XEN_ASSERT_TYPE(XEN_guint16_P(green), green, 2, "pango_attr_background_new", "guint16");
- XEN_ASSERT_TYPE(XEN_guint16_P(blue), blue, 3, "pango_attr_background_new", "guint16");
- return(C_TO_XEN_PangoAttribute_(pango_attr_background_new(XEN_TO_C_guint16(red), XEN_TO_C_guint16(green), XEN_TO_C_guint16(blue))));
+ #define H_pango_layout_iter_get_run "PangoLayoutRun* pango_layout_iter_get_run(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_run", "PangoLayoutIter*");
+ return(C_to_Xen_PangoLayoutRun_(pango_layout_iter_get_run(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_size_new(XEN size)
+static Xen gxg_pango_layout_iter_get_line(Xen iter)
{
- #define H_pango_attr_size_new "PangoAttribute* pango_attr_size_new(int size)"
- XEN_ASSERT_TYPE(XEN_int_P(size), size, 1, "pango_attr_size_new", "int");
- return(C_TO_XEN_PangoAttribute_(pango_attr_size_new(XEN_TO_C_int(size))));
+ #define H_pango_layout_iter_get_line "PangoLayoutLine* pango_layout_iter_get_line(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_line", "PangoLayoutIter*");
+ return(C_to_Xen_PangoLayoutLine_(pango_layout_iter_get_line(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_style_new(XEN style)
+static Xen gxg_pango_layout_iter_at_last_line(Xen iter)
{
- #define H_pango_attr_style_new "PangoAttribute* pango_attr_style_new(PangoStyle style)"
- XEN_ASSERT_TYPE(XEN_PangoStyle_P(style), style, 1, "pango_attr_style_new", "PangoStyle");
- return(C_TO_XEN_PangoAttribute_(pango_attr_style_new(XEN_TO_C_PangoStyle(style))));
+ #define H_pango_layout_iter_at_last_line "gboolean pango_layout_iter_at_last_line(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_at_last_line", "PangoLayoutIter*");
+ return(C_to_Xen_gboolean(pango_layout_iter_at_last_line(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_weight_new(XEN weight)
+static Xen gxg_pango_layout_iter_next_char(Xen iter)
{
- #define H_pango_attr_weight_new "PangoAttribute* pango_attr_weight_new(PangoWeight weight)"
- XEN_ASSERT_TYPE(XEN_PangoWeight_P(weight), weight, 1, "pango_attr_weight_new", "PangoWeight");
- return(C_TO_XEN_PangoAttribute_(pango_attr_weight_new(XEN_TO_C_PangoWeight(weight))));
+ #define H_pango_layout_iter_next_char "gboolean pango_layout_iter_next_char(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_next_char", "PangoLayoutIter*");
+ return(C_to_Xen_gboolean(pango_layout_iter_next_char(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_variant_new(XEN variant)
+static Xen gxg_pango_layout_iter_next_cluster(Xen iter)
{
- #define H_pango_attr_variant_new "PangoAttribute* pango_attr_variant_new(PangoVariant variant)"
- XEN_ASSERT_TYPE(XEN_PangoVariant_P(variant), variant, 1, "pango_attr_variant_new", "PangoVariant");
- return(C_TO_XEN_PangoAttribute_(pango_attr_variant_new(XEN_TO_C_PangoVariant(variant))));
+ #define H_pango_layout_iter_next_cluster "gboolean pango_layout_iter_next_cluster(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_next_cluster", "PangoLayoutIter*");
+ return(C_to_Xen_gboolean(pango_layout_iter_next_cluster(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_stretch_new(XEN stretch)
+static Xen gxg_pango_layout_iter_next_run(Xen iter)
{
- #define H_pango_attr_stretch_new "PangoAttribute* pango_attr_stretch_new(PangoStretch stretch)"
- XEN_ASSERT_TYPE(XEN_PangoStretch_P(stretch), stretch, 1, "pango_attr_stretch_new", "PangoStretch");
- return(C_TO_XEN_PangoAttribute_(pango_attr_stretch_new(XEN_TO_C_PangoStretch(stretch))));
+ #define H_pango_layout_iter_next_run "gboolean pango_layout_iter_next_run(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_next_run", "PangoLayoutIter*");
+ return(C_to_Xen_gboolean(pango_layout_iter_next_run(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_font_desc_new(XEN desc)
+static Xen gxg_pango_layout_iter_next_line(Xen iter)
{
- #define H_pango_attr_font_desc_new "PangoAttribute* pango_attr_font_desc_new(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_attr_font_desc_new", "PangoFontDescription*");
- return(C_TO_XEN_PangoAttribute_(pango_attr_font_desc_new(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_pango_layout_iter_next_line "gboolean pango_layout_iter_next_line(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_next_line", "PangoLayoutIter*");
+ return(C_to_Xen_gboolean(pango_layout_iter_next_line(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_underline_new(XEN underline)
+static Xen gxg_pango_layout_iter_get_char_extents(Xen iter, Xen logical_rect)
{
- #define H_pango_attr_underline_new "PangoAttribute* pango_attr_underline_new(PangoUnderline underline)"
- XEN_ASSERT_TYPE(XEN_PangoUnderline_P(underline), underline, 1, "pango_attr_underline_new", "PangoUnderline");
- return(C_TO_XEN_PangoAttribute_(pango_attr_underline_new(XEN_TO_C_PangoUnderline(underline))));
+ #define H_pango_layout_iter_get_char_extents "void pango_layout_iter_get_char_extents(PangoLayoutIter* iter, \
+PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_char_extents", "PangoLayoutIter*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 2, "pango_layout_iter_get_char_extents", "PangoRectangle*");
+ pango_layout_iter_get_char_extents(Xen_to_C_PangoLayoutIter_(iter), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_strikethrough_new(XEN strikethrough)
+static Xen gxg_pango_layout_iter_get_cluster_extents(Xen iter, Xen ink_rect, Xen logical_rect)
{
- #define H_pango_attr_strikethrough_new "PangoAttribute* pango_attr_strikethrough_new(gboolean strikethrough)"
- XEN_ASSERT_TYPE(XEN_gboolean_P(strikethrough), strikethrough, 1, "pango_attr_strikethrough_new", "gboolean");
- return(C_TO_XEN_PangoAttribute_(pango_attr_strikethrough_new(XEN_TO_C_gboolean(strikethrough))));
+ #define H_pango_layout_iter_get_cluster_extents "void pango_layout_iter_get_cluster_extents(PangoLayoutIter* iter, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_cluster_extents", "PangoLayoutIter*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 2, "pango_layout_iter_get_cluster_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 3, "pango_layout_iter_get_cluster_extents", "PangoRectangle*");
+ pango_layout_iter_get_cluster_extents(Xen_to_C_PangoLayoutIter_(iter), Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_rise_new(XEN rise)
+static Xen gxg_pango_layout_iter_get_run_extents(Xen iter, Xen ink_rect, Xen logical_rect)
{
- #define H_pango_attr_rise_new "PangoAttribute* pango_attr_rise_new(int rise)"
- XEN_ASSERT_TYPE(XEN_int_P(rise), rise, 1, "pango_attr_rise_new", "int");
- return(C_TO_XEN_PangoAttribute_(pango_attr_rise_new(XEN_TO_C_int(rise))));
+ #define H_pango_layout_iter_get_run_extents "void pango_layout_iter_get_run_extents(PangoLayoutIter* iter, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_run_extents", "PangoLayoutIter*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 2, "pango_layout_iter_get_run_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 3, "pango_layout_iter_get_run_extents", "PangoRectangle*");
+ pango_layout_iter_get_run_extents(Xen_to_C_PangoLayoutIter_(iter), Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_shape_new(XEN ink_rect, XEN logical_rect)
+static Xen gxg_pango_layout_iter_get_line_extents(Xen iter, Xen ink_rect, Xen logical_rect)
{
- #define H_pango_attr_shape_new "PangoAttribute* pango_attr_shape_new(PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 1, "pango_attr_shape_new", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 2, "pango_attr_shape_new", "PangoRectangle*");
- return(C_TO_XEN_PangoAttribute_(pango_attr_shape_new(XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect))));
+ #define H_pango_layout_iter_get_line_extents "void pango_layout_iter_get_line_extents(PangoLayoutIter* iter, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_line_extents", "PangoLayoutIter*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 2, "pango_layout_iter_get_line_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 3, "pango_layout_iter_get_line_extents", "PangoRectangle*");
+ pango_layout_iter_get_line_extents(Xen_to_C_PangoLayoutIter_(iter), Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_scale_new(XEN scale_factor)
+static Xen gxg_pango_layout_iter_get_line_yrange(Xen iter, Xen ignore_y0, Xen ignore_y1)
{
- #define H_pango_attr_scale_new "PangoAttribute* pango_attr_scale_new(double scale_factor)"
- XEN_ASSERT_TYPE(XEN_double_P(scale_factor), scale_factor, 1, "pango_attr_scale_new", "double");
- return(C_TO_XEN_PangoAttribute_(pango_attr_scale_new(XEN_TO_C_double(scale_factor))));
+ #define H_pango_layout_iter_get_line_yrange "void pango_layout_iter_get_line_yrange(PangoLayoutIter* iter, \
+int* [y0], int* [y1])"
+ int ref_y0;
+ int ref_y1;
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_line_yrange", "PangoLayoutIter*");
+ pango_layout_iter_get_line_yrange(Xen_to_C_PangoLayoutIter_(iter), &ref_y0, &ref_y1);
+ return(Xen_list_2(C_to_Xen_int(ref_y0), C_to_Xen_int(ref_y1)));
}
-static XEN gxg_pango_attr_list_new(void)
+static Xen gxg_pango_layout_iter_get_layout_extents(Xen iter, Xen ink_rect, Xen logical_rect)
{
- #define H_pango_attr_list_new "PangoAttrList* pango_attr_list_new( void)"
- return(C_TO_XEN_PangoAttrList_(pango_attr_list_new()));
+ #define H_pango_layout_iter_get_layout_extents "void pango_layout_iter_get_layout_extents(PangoLayoutIter* iter, \
+PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_layout_extents", "PangoLayoutIter*");
+ Xen_check_type(Xen_is_PangoRectangle_(ink_rect), ink_rect, 2, "pango_layout_iter_get_layout_extents", "PangoRectangle*");
+ Xen_check_type(Xen_is_PangoRectangle_(logical_rect), logical_rect, 3, "pango_layout_iter_get_layout_extents", "PangoRectangle*");
+ pango_layout_iter_get_layout_extents(Xen_to_C_PangoLayoutIter_(iter), Xen_to_C_PangoRectangle_(ink_rect), Xen_to_C_PangoRectangle_(logical_rect));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_list_unref(XEN list)
+static Xen gxg_pango_layout_iter_get_baseline(Xen iter)
{
- #define H_pango_attr_list_unref "void pango_attr_list_unref(PangoAttrList* list)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_unref", "PangoAttrList*");
- pango_attr_list_unref(XEN_TO_C_PangoAttrList_(list));
- return(XEN_FALSE);
+ #define H_pango_layout_iter_get_baseline "int pango_layout_iter_get_baseline(PangoLayoutIter* iter)"
+ Xen_check_type(Xen_is_PangoLayoutIter_(iter), iter, 1, "pango_layout_iter_get_baseline", "PangoLayoutIter*");
+ return(C_to_Xen_int(pango_layout_iter_get_baseline(Xen_to_C_PangoLayoutIter_(iter))));
}
-static XEN gxg_pango_attr_list_copy(XEN list)
+static Xen gxg_pango_language_from_string(Xen language)
{
- #define H_pango_attr_list_copy "PangoAttrList* pango_attr_list_copy(PangoAttrList* list)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_copy", "PangoAttrList*");
- return(C_TO_XEN_PangoAttrList_(pango_attr_list_copy(XEN_TO_C_PangoAttrList_(list))));
+ #define H_pango_language_from_string "PangoLanguage* pango_language_from_string(char* language)"
+ Xen_check_type(Xen_is_char_(language), language, 1, "pango_language_from_string", "char*");
+ return(C_to_Xen_PangoLanguage_(pango_language_from_string(Xen_to_C_char_(language))));
}
-static XEN gxg_pango_attr_list_insert(XEN list, XEN attr)
+static Xen gxg_pango_language_matches(Xen language, Xen range_list)
{
- #define H_pango_attr_list_insert "void pango_attr_list_insert(PangoAttrList* list, PangoAttribute* attr)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_insert", "PangoAttrList*");
- XEN_ASSERT_TYPE(XEN_PangoAttribute__P(attr), attr, 2, "pango_attr_list_insert", "PangoAttribute*");
- pango_attr_list_insert(XEN_TO_C_PangoAttrList_(list), XEN_TO_C_PangoAttribute_(attr));
- return(XEN_FALSE);
+ #define H_pango_language_matches "gboolean pango_language_matches(PangoLanguage* language, char* range_list)"
+ Xen_check_type(Xen_is_PangoLanguage_(language), language, 1, "pango_language_matches", "PangoLanguage*");
+ Xen_check_type(Xen_is_char_(range_list), range_list, 2, "pango_language_matches", "char*");
+ return(C_to_Xen_gboolean(pango_language_matches(Xen_to_C_PangoLanguage_(language), Xen_to_C_char_(range_list))));
}
-static XEN gxg_pango_attr_list_insert_before(XEN list, XEN attr)
+static Xen gxg_G_OBJECT_TYPE(Xen object)
{
- #define H_pango_attr_list_insert_before "void pango_attr_list_insert_before(PangoAttrList* list, PangoAttribute* attr)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_insert_before", "PangoAttrList*");
- XEN_ASSERT_TYPE(XEN_PangoAttribute__P(attr), attr, 2, "pango_attr_list_insert_before", "PangoAttribute*");
- pango_attr_list_insert_before(XEN_TO_C_PangoAttrList_(list), XEN_TO_C_PangoAttribute_(attr));
- return(XEN_FALSE);
+ #define H_G_OBJECT_TYPE "GType G_OBJECT_TYPE(GObject* object)"
+ Xen_check_type(Xen_is_GObject_(object), object, 1, "G_OBJECT_TYPE", "GObject*");
+ return(C_to_Xen_GType(G_OBJECT_TYPE(Xen_to_C_GObject_(object))));
}
-static XEN gxg_pango_attr_list_change(XEN list, XEN attr)
+static Xen gxg_gtk_tree_model_get_string_from_iter(Xen tree_model, Xen iter)
{
- #define H_pango_attr_list_change "void pango_attr_list_change(PangoAttrList* list, PangoAttribute* attr)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_change", "PangoAttrList*");
- XEN_ASSERT_TYPE(XEN_PangoAttribute__P(attr), attr, 2, "pango_attr_list_change", "PangoAttribute*");
- pango_attr_list_change(XEN_TO_C_PangoAttrList_(list), XEN_TO_C_PangoAttribute_(attr));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_get_string_from_iter "gchar* gtk_tree_model_get_string_from_iter(GtkTreeModel* tree_model, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_get_string_from_iter", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_get_string_from_iter", "GtkTreeIter*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_tree_model_get_string_from_iter(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_pango_attr_list_splice(XEN list, XEN other, XEN pos, XEN len)
+static Xen gxg_gtk_tree_model_sort_iter_is_valid(Xen tree_model_sort, Xen iter)
{
- #define H_pango_attr_list_splice "void pango_attr_list_splice(PangoAttrList* list, PangoAttrList* other, \
-gint pos, gint len)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_splice", "PangoAttrList*");
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(other), other, 2, "pango_attr_list_splice", "PangoAttrList*");
- XEN_ASSERT_TYPE(XEN_gint_P(pos), pos, 3, "pango_attr_list_splice", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(len), len, 4, "pango_attr_list_splice", "gint");
- pango_attr_list_splice(XEN_TO_C_PangoAttrList_(list), XEN_TO_C_PangoAttrList_(other), XEN_TO_C_gint(pos), XEN_TO_C_gint(len));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_sort_iter_is_valid "gboolean gtk_tree_model_sort_iter_is_valid(GtkTreeModelSort* tree_model_sort, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModelSort_(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_iter_is_valid", "GtkTreeModelSort*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_sort_iter_is_valid", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_model_sort_iter_is_valid(Xen_to_C_GtkTreeModelSort_(tree_model_sort), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_pango_attr_list_get_iterator(XEN list)
+static Xen gxg_gtk_tree_view_expand_to_path(Xen tree_view, Xen path)
{
- #define H_pango_attr_list_get_iterator "PangoAttrIterator* pango_attr_list_get_iterator(PangoAttrList* list)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_get_iterator", "PangoAttrList*");
- return(C_TO_XEN_PangoAttrIterator_(pango_attr_list_get_iterator(XEN_TO_C_PangoAttrList_(list))));
+ #define H_gtk_tree_view_expand_to_path "void gtk_tree_view_expand_to_path(GtkTreeView* tree_view, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_expand_to_path", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_expand_to_path", "GtkTreePath*");
+ gtk_tree_view_expand_to_path(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_iterator_range(XEN iterator, XEN ignore_start, XEN ignore_end)
+static Xen gxg_gtk_tree_selection_get_selected_rows(Xen selection, Xen model)
{
- #define H_pango_attr_iterator_range "void pango_attr_iterator_range(PangoAttrIterator* iterator, gint* [start], \
-gint* [end])"
- gint ref_start;
- gint ref_end;
- XEN_ASSERT_TYPE(XEN_PangoAttrIterator__P(iterator), iterator, 1, "pango_attr_iterator_range", "PangoAttrIterator*");
- pango_attr_iterator_range(XEN_TO_C_PangoAttrIterator_(iterator), &ref_start, &ref_end);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_start), C_TO_XEN_gint(ref_end)));
+ #define H_gtk_tree_selection_get_selected_rows "GList* gtk_tree_selection_get_selected_rows(GtkTreeSelection* selection, \
+GtkTreeModel** model)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_get_selected_rows", "GtkTreeSelection*");
+ Xen_check_type(Xen_is_GtkTreeModel__(model), model, 2, "gtk_tree_selection_get_selected_rows", "GtkTreeModel**");
+ return(C_to_Xen_GList_(gtk_tree_selection_get_selected_rows(Xen_to_C_GtkTreeSelection_(selection), Xen_to_C_GtkTreeModel__(model))));
}
-static XEN gxg_pango_attr_iterator_next(XEN iterator)
+static Xen gxg_gtk_tree_selection_count_selected_rows(Xen selection)
{
- #define H_pango_attr_iterator_next "gboolean pango_attr_iterator_next(PangoAttrIterator* iterator)"
- XEN_ASSERT_TYPE(XEN_PangoAttrIterator__P(iterator), iterator, 1, "pango_attr_iterator_next", "PangoAttrIterator*");
- return(C_TO_XEN_gboolean(pango_attr_iterator_next(XEN_TO_C_PangoAttrIterator_(iterator))));
+ #define H_gtk_tree_selection_count_selected_rows "int gtk_tree_selection_count_selected_rows(GtkTreeSelection* selection)"
+ Xen_check_type(Xen_is_GtkTreeSelection_(selection), selection, 1, "gtk_tree_selection_count_selected_rows", "GtkTreeSelection*");
+ return(C_to_Xen_int(gtk_tree_selection_count_selected_rows(Xen_to_C_GtkTreeSelection_(selection))));
}
-static XEN gxg_pango_attr_iterator_copy(XEN iterator)
+static Xen gxg_gtk_menu_shell_select_first(Xen menu_shell, Xen search_sensitive)
{
- #define H_pango_attr_iterator_copy "PangoAttrIterator* pango_attr_iterator_copy(PangoAttrIterator* iterator)"
- XEN_ASSERT_TYPE(XEN_PangoAttrIterator__P(iterator), iterator, 1, "pango_attr_iterator_copy", "PangoAttrIterator*");
- return(C_TO_XEN_PangoAttrIterator_(pango_attr_iterator_copy(XEN_TO_C_PangoAttrIterator_(iterator))));
+ #define H_gtk_menu_shell_select_first "void gtk_menu_shell_select_first(GtkMenuShell* menu_shell, gboolean search_sensitive)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_select_first", "GtkMenuShell*");
+ Xen_check_type(Xen_is_gboolean(search_sensitive), search_sensitive, 2, "gtk_menu_shell_select_first", "gboolean");
+ gtk_menu_shell_select_first(Xen_to_C_GtkMenuShell_(menu_shell), Xen_to_C_gboolean(search_sensitive));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_iterator_destroy(XEN iterator)
+static Xen gxg_gtk_notebook_get_n_pages(Xen notebook)
{
- #define H_pango_attr_iterator_destroy "void pango_attr_iterator_destroy(PangoAttrIterator* iterator)"
- XEN_ASSERT_TYPE(XEN_PangoAttrIterator__P(iterator), iterator, 1, "pango_attr_iterator_destroy", "PangoAttrIterator*");
- pango_attr_iterator_destroy(XEN_TO_C_PangoAttrIterator_(iterator));
- return(XEN_FALSE);
+ #define H_gtk_notebook_get_n_pages "int gtk_notebook_get_n_pages(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_n_pages", "GtkNotebook*");
+ return(C_to_Xen_int(gtk_notebook_get_n_pages(Xen_to_C_GtkNotebook_(notebook))));
}
-static XEN gxg_pango_attr_iterator_get(XEN iterator, XEN type)
+static Xen gxg_gtk_list_store_reorder(Xen store, Xen new_order)
{
- #define H_pango_attr_iterator_get "PangoAttribute* pango_attr_iterator_get(PangoAttrIterator* iterator, \
-PangoAttrType type)"
- XEN_ASSERT_TYPE(XEN_PangoAttrIterator__P(iterator), iterator, 1, "pango_attr_iterator_get", "PangoAttrIterator*");
- XEN_ASSERT_TYPE(XEN_PangoAttrType_P(type), type, 2, "pango_attr_iterator_get", "PangoAttrType");
- return(C_TO_XEN_PangoAttribute_(pango_attr_iterator_get(XEN_TO_C_PangoAttrIterator_(iterator), XEN_TO_C_PangoAttrType(type))));
+ #define H_gtk_list_store_reorder "void gtk_list_store_reorder(GtkListStore* store, int* new_order)"
+ Xen_check_type(Xen_is_GtkListStore_(store), store, 1, "gtk_list_store_reorder", "GtkListStore*");
+ Xen_check_type(Xen_is_int_(new_order), new_order, 2, "gtk_list_store_reorder", "int*");
+ gtk_list_store_reorder(Xen_to_C_GtkListStore_(store), Xen_to_C_int_(new_order));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_iterator_get_font(XEN iterator, XEN desc, XEN ignore_language, XEN ignore_extra_attrs)
+static Xen gxg_gtk_list_store_swap(Xen store, Xen a, Xen b)
{
- #define H_pango_attr_iterator_get_font "void pango_attr_iterator_get_font(PangoAttrIterator* iterator, \
-PangoFontDescription* desc, PangoLanguage** [language], GSList** [extra_attrs])"
- PangoLanguage* ref_language = NULL;
- GSList* ref_extra_attrs = NULL;
- XEN_ASSERT_TYPE(XEN_PangoAttrIterator__P(iterator), iterator, 1, "pango_attr_iterator_get_font", "PangoAttrIterator*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 2, "pango_attr_iterator_get_font", "PangoFontDescription*");
- pango_attr_iterator_get_font(XEN_TO_C_PangoAttrIterator_(iterator), XEN_TO_C_PangoFontDescription_(desc), &ref_language,
- &ref_extra_attrs);
- return(XEN_LIST_2(C_TO_XEN_PangoLanguage_(ref_language), C_TO_XEN_GSList_(ref_extra_attrs)));
+ #define H_gtk_list_store_swap "void gtk_list_store_swap(GtkListStore* store, GtkTreeIter* a, GtkTreeIter* b)"
+ Xen_check_type(Xen_is_GtkListStore_(store), store, 1, "gtk_list_store_swap", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(a), a, 2, "gtk_list_store_swap", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(b), b, 3, "gtk_list_store_swap", "GtkTreeIter*");
+ gtk_list_store_swap(Xen_to_C_GtkListStore_(store), Xen_to_C_GtkTreeIter_(a), Xen_to_C_GtkTreeIter_(b));
+ return(Xen_false);
}
-static XEN gxg_pango_parse_markup(XEN markup_text, XEN length, XEN accel_marker, XEN attr_list, XEN text, XEN accel_char, XEN ignore_error)
+static Xen gxg_gtk_list_store_move_after(Xen store, Xen iter, Xen position)
{
- #define H_pango_parse_markup "gboolean pango_parse_markup(char* markup_text, int length, gunichar accel_marker, \
-PangoAttrList** attr_list, char** text, gunichar* accel_char, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_char__P(markup_text), markup_text, 1, "pango_parse_markup", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 2, "pango_parse_markup", "int");
- XEN_ASSERT_TYPE(XEN_gunichar_P(accel_marker), accel_marker, 3, "pango_parse_markup", "gunichar");
- XEN_ASSERT_TYPE(XEN_PangoAttrList___P(attr_list), attr_list, 4, "pango_parse_markup", "PangoAttrList**");
- XEN_ASSERT_TYPE(XEN_char___P(text), text, 5, "pango_parse_markup", "char**");
- XEN_ASSERT_TYPE(XEN_gunichar__P(accel_char), accel_char, 6, "pango_parse_markup", "gunichar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(pango_parse_markup(XEN_TO_C_char_(markup_text), XEN_TO_C_int(length), XEN_TO_C_gunichar(accel_marker),
- XEN_TO_C_PangoAttrList__(attr_list), XEN_TO_C_char__(text), XEN_TO_C_gunichar_(accel_char),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_list_store_move_after "void gtk_list_store_move_after(GtkListStore* store, GtkTreeIter* iter, \
+GtkTreeIter* position)"
+ Xen_check_type(Xen_is_GtkListStore_(store), store, 1, "gtk_list_store_move_after", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_move_after", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(position) || Xen_is_false(position), position, 3, "gtk_list_store_move_after", "GtkTreeIter*");
+ gtk_list_store_move_after(Xen_to_C_GtkListStore_(store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(position));
+ return(Xen_false);
}
-static XEN gxg_pango_break(XEN text, XEN length, XEN analysis, XEN attrs, XEN attrs_len)
+static Xen gxg_gtk_list_store_move_before(Xen store, Xen iter, Xen position)
{
- #define H_pango_break "void pango_break(gchar* text, int length, PangoAnalysis* analysis, PangoLogAttr* attrs, \
-int attrs_len)"
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 1, "pango_break", "gchar*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 2, "pango_break", "int");
- XEN_ASSERT_TYPE(XEN_PangoAnalysis__P(analysis), analysis, 3, "pango_break", "PangoAnalysis*");
- XEN_ASSERT_TYPE(XEN_PangoLogAttr__P(attrs), attrs, 4, "pango_break", "PangoLogAttr*");
- XEN_ASSERT_TYPE(XEN_int_P(attrs_len), attrs_len, 5, "pango_break", "int");
- pango_break(XEN_TO_C_gchar_(text), XEN_TO_C_int(length), XEN_TO_C_PangoAnalysis_(analysis), XEN_TO_C_PangoLogAttr_(attrs),
- XEN_TO_C_int(attrs_len));
- return(XEN_FALSE);
+ #define H_gtk_list_store_move_before "void gtk_list_store_move_before(GtkListStore* store, GtkTreeIter* iter, \
+GtkTreeIter* position)"
+ Xen_check_type(Xen_is_GtkListStore_(store), store, 1, "gtk_list_store_move_before", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_move_before", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(position) || Xen_is_false(position), position, 3, "gtk_list_store_move_before", "GtkTreeIter*");
+ gtk_list_store_move_before(Xen_to_C_GtkListStore_(store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_GtkTreeIter_(position));
+ return(Xen_false);
}
-static XEN gxg_pango_find_paragraph_boundary(XEN text, XEN length, XEN ignore_paragraph_delimiter_index, XEN ignore_next_paragraph_start)
+static Xen gxg_gtk_tree_store_reorder(Xen tree_store, Xen parent, Xen new_order)
{
- #define H_pango_find_paragraph_boundary "void pango_find_paragraph_boundary(gchar* text, gint length, \
-gint* [paragraph_delimiter_index], gint* [next_paragraph_start])"
- gint ref_paragraph_delimiter_index;
- gint ref_next_paragraph_start;
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 1, "pango_find_paragraph_boundary", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(length), length, 2, "pango_find_paragraph_boundary", "gint");
- pango_find_paragraph_boundary(XEN_TO_C_gchar_(text), XEN_TO_C_gint(length), &ref_paragraph_delimiter_index, &ref_next_paragraph_start);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_paragraph_delimiter_index), C_TO_XEN_gint(ref_next_paragraph_start)));
+ #define H_gtk_tree_store_reorder "void gtk_tree_store_reorder(GtkTreeStore* tree_store, GtkTreeIter* parent, \
+int* new_order)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_reorder", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(parent), parent, 2, "gtk_tree_store_reorder", "GtkTreeIter*");
+ Xen_check_type(Xen_is_int_(new_order), new_order, 3, "gtk_tree_store_reorder", "int*");
+ gtk_tree_store_reorder(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(parent), Xen_to_C_int_(new_order));
+ return(Xen_false);
}
-static XEN gxg_pango_get_log_attrs(XEN text, XEN length, XEN level, XEN language, XEN log_attrs, XEN attrs_len)
+static Xen gxg_gtk_tree_store_swap(Xen tree_store, Xen a, Xen b)
{
- #define H_pango_get_log_attrs "void pango_get_log_attrs(char* text, int length, int level, PangoLanguage* language, \
-PangoLogAttr* log_attrs, int attrs_len)"
- XEN_ASSERT_TYPE(XEN_char__P(text), text, 1, "pango_get_log_attrs", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 2, "pango_get_log_attrs", "int");
- XEN_ASSERT_TYPE(XEN_int_P(level), level, 3, "pango_get_log_attrs", "int");
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 4, "pango_get_log_attrs", "PangoLanguage*");
- XEN_ASSERT_TYPE(XEN_PangoLogAttr__P(log_attrs), log_attrs, 5, "pango_get_log_attrs", "PangoLogAttr*");
- XEN_ASSERT_TYPE(XEN_int_P(attrs_len), attrs_len, 6, "pango_get_log_attrs", "int");
- pango_get_log_attrs(XEN_TO_C_char_(text), XEN_TO_C_int(length), XEN_TO_C_int(level), XEN_TO_C_PangoLanguage_(language),
- XEN_TO_C_PangoLogAttr_(log_attrs), XEN_TO_C_int(attrs_len));
- return(XEN_FALSE);
+ #define H_gtk_tree_store_swap "void gtk_tree_store_swap(GtkTreeStore* tree_store, GtkTreeIter* a, GtkTreeIter* b)"
+ Xen_check_type(Xen_is_GtkTreeStore_(tree_store), tree_store, 1, "gtk_tree_store_swap", "GtkTreeStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(a), a, 2, "gtk_tree_store_swap", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(b), b, 3, "gtk_tree_store_swap", "GtkTreeIter*");
+ gtk_tree_store_swap(Xen_to_C_GtkTreeStore_(tree_store), Xen_to_C_GtkTreeIter_(a), Xen_to_C_GtkTreeIter_(b));
+ return(Xen_false);
}
-static XEN gxg_pango_context_list_families(XEN context, XEN ignore_families, XEN ignore_n_families)
+static Xen gxg_gdk_display_open(Xen display_name)
{
- #define H_pango_context_list_families "void pango_context_list_families(PangoContext* context, PangoFontFamily*** [families], \
-int* [n_families])"
- PangoFontFamily** ref_families = NULL;
- int ref_n_families;
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_list_families", "PangoContext*");
- pango_context_list_families(XEN_TO_C_PangoContext_(context), &ref_families, &ref_n_families);
- return(XEN_LIST_2(C_TO_XEN_PangoFontFamily__(ref_families), C_TO_XEN_int(ref_n_families)));
+ #define H_gdk_display_open "GdkDisplay* gdk_display_open(gchar* display_name)"
+ Xen_check_type(Xen_is_gchar_(display_name), display_name, 1, "gdk_display_open", "gchar*");
+ return(C_to_Xen_GdkDisplay_(gdk_display_open(Xen_to_C_gchar_(display_name))));
}
-static XEN gxg_pango_context_load_font(XEN context, XEN desc)
+static Xen gxg_gdk_display_get_name(Xen display)
{
- #define H_pango_context_load_font "PangoFont* pango_context_load_font(PangoContext* context, PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_load_font", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 2, "pango_context_load_font", "PangoFontDescription*");
- return(C_TO_XEN_PangoFont_(pango_context_load_font(XEN_TO_C_PangoContext_(context), XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_gdk_display_get_name "gchar* gdk_display_get_name(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_get_name", "GdkDisplay*");
+ return(C_to_Xen_gchar_(gdk_display_get_name(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_pango_context_load_fontset(XEN context, XEN desc, XEN language)
+static Xen gxg_gdk_display_get_screen(Xen display, Xen screen_num)
{
- #define H_pango_context_load_fontset "PangoFontset* pango_context_load_fontset(PangoContext* context, \
-PangoFontDescription* desc, PangoLanguage* language)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_load_fontset", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 2, "pango_context_load_fontset", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 3, "pango_context_load_fontset", "PangoLanguage*");
- return(C_TO_XEN_PangoFontset_(pango_context_load_fontset(XEN_TO_C_PangoContext_(context), XEN_TO_C_PangoFontDescription_(desc),
- XEN_TO_C_PangoLanguage_(language))));
+ #define H_gdk_display_get_screen "GdkScreen* gdk_display_get_screen(GdkDisplay* display, int screen_num)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_get_screen", "GdkDisplay*");
+ Xen_check_type(Xen_is_int(screen_num), screen_num, 2, "gdk_display_get_screen", "int");
+ return(C_to_Xen_GdkScreen_(gdk_display_get_screen(Xen_to_C_GdkDisplay_(display), Xen_to_C_int(screen_num))));
}
-static XEN gxg_pango_context_get_metrics(XEN context, XEN desc, XEN language)
+static Xen gxg_gdk_display_get_default_screen(Xen display)
{
- #define H_pango_context_get_metrics "PangoFontMetrics* pango_context_get_metrics(PangoContext* context, \
-PangoFontDescription* desc, PangoLanguage* language)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_get_metrics", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 2, "pango_context_get_metrics", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 3, "pango_context_get_metrics", "PangoLanguage*");
- return(C_TO_XEN_PangoFontMetrics_(pango_context_get_metrics(XEN_TO_C_PangoContext_(context), XEN_TO_C_PangoFontDescription_(desc),
- XEN_TO_C_PangoLanguage_(language))));
+ #define H_gdk_display_get_default_screen "GdkScreen* gdk_display_get_default_screen(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_get_default_screen", "GdkDisplay*");
+ return(C_to_Xen_GdkScreen_(gdk_display_get_default_screen(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_pango_context_set_font_description(XEN context, XEN desc)
+static Xen gxg_gdk_display_beep(Xen display)
{
- #define H_pango_context_set_font_description "void pango_context_set_font_description(PangoContext* context, \
-PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_set_font_description", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 2, "pango_context_set_font_description", "PangoFontDescription*");
- pango_context_set_font_description(XEN_TO_C_PangoContext_(context), XEN_TO_C_PangoFontDescription_(desc));
- return(XEN_FALSE);
+ #define H_gdk_display_beep "void gdk_display_beep(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_beep", "GdkDisplay*");
+ gdk_display_beep(Xen_to_C_GdkDisplay_(display));
+ return(Xen_false);
}
-static XEN gxg_pango_context_get_font_description(XEN context)
+static Xen gxg_gdk_display_sync(Xen display)
{
- #define H_pango_context_get_font_description "PangoFontDescription* pango_context_get_font_description(PangoContext* context)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_get_font_description", "PangoContext*");
- return(C_TO_XEN_PangoFontDescription_(pango_context_get_font_description(XEN_TO_C_PangoContext_(context))));
+ #define H_gdk_display_sync "void gdk_display_sync(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_sync", "GdkDisplay*");
+ gdk_display_sync(Xen_to_C_GdkDisplay_(display));
+ return(Xen_false);
}
-static XEN gxg_pango_context_get_language(XEN context)
+static Xen gxg_gdk_display_close(Xen display)
{
- #define H_pango_context_get_language "PangoLanguage* pango_context_get_language(PangoContext* context)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_get_language", "PangoContext*");
- return(C_TO_XEN_PangoLanguage_(pango_context_get_language(XEN_TO_C_PangoContext_(context))));
+ #define H_gdk_display_close "void gdk_display_close(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_close", "GdkDisplay*");
+ gdk_display_close(Xen_to_C_GdkDisplay_(display));
+ return(Xen_false);
}
-static XEN gxg_pango_context_set_language(XEN context, XEN language)
+static Xen gxg_gdk_display_get_event(Xen display)
{
- #define H_pango_context_set_language "void pango_context_set_language(PangoContext* context, PangoLanguage* language)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_set_language", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 2, "pango_context_set_language", "PangoLanguage*");
- pango_context_set_language(XEN_TO_C_PangoContext_(context), XEN_TO_C_PangoLanguage_(language));
- return(XEN_FALSE);
+ #define H_gdk_display_get_event "GdkEvent* gdk_display_get_event(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_get_event", "GdkDisplay*");
+ return(C_to_Xen_GdkEvent_(gdk_display_get_event(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_pango_context_set_base_dir(XEN context, XEN direction)
+static Xen gxg_gdk_display_peek_event(Xen display)
{
- #define H_pango_context_set_base_dir "void pango_context_set_base_dir(PangoContext* context, PangoDirection direction)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_set_base_dir", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_PangoDirection_P(direction), direction, 2, "pango_context_set_base_dir", "PangoDirection");
- pango_context_set_base_dir(XEN_TO_C_PangoContext_(context), XEN_TO_C_PangoDirection(direction));
- return(XEN_FALSE);
+ #define H_gdk_display_peek_event "GdkEvent* gdk_display_peek_event(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_peek_event", "GdkDisplay*");
+ return(C_to_Xen_GdkEvent_(gdk_display_peek_event(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_pango_context_get_base_dir(XEN context)
+static Xen gxg_gdk_display_put_event(Xen display, Xen event)
{
- #define H_pango_context_get_base_dir "PangoDirection pango_context_get_base_dir(PangoContext* context)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_context_get_base_dir", "PangoContext*");
- return(C_TO_XEN_PangoDirection(pango_context_get_base_dir(XEN_TO_C_PangoContext_(context))));
+ #define H_gdk_display_put_event "void gdk_display_put_event(GdkDisplay* display, GdkEvent* event)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_put_event", "GdkDisplay*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gdk_display_put_event", "GdkEvent*");
+ gdk_display_put_event(Xen_to_C_GdkDisplay_(display), Xen_to_C_GdkEvent_(event));
+ return(Xen_false);
}
-static XEN gxg_pango_itemize(XEN context, XEN text, XEN start_index, XEN length, XEN attrs, XEN cached_iter)
+static Xen gxg_gdk_display_set_double_click_time(Xen display, Xen msec)
{
- #define H_pango_itemize "GList* pango_itemize(PangoContext* context, char* text, int start_index, int length, \
-PangoAttrList* attrs, PangoAttrIterator* cached_iter)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_itemize", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_char__P(text), text, 2, "pango_itemize", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(start_index), start_index, 3, "pango_itemize", "int");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 4, "pango_itemize", "int");
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(attrs), attrs, 5, "pango_itemize", "PangoAttrList*");
- XEN_ASSERT_TYPE(XEN_PangoAttrIterator__P(cached_iter), cached_iter, 6, "pango_itemize", "PangoAttrIterator*");
- return(C_TO_XEN_GList_(pango_itemize(XEN_TO_C_PangoContext_(context), XEN_TO_C_char_(text), XEN_TO_C_int(start_index),
- XEN_TO_C_int(length), XEN_TO_C_PangoAttrList_(attrs), XEN_TO_C_PangoAttrIterator_(cached_iter))));
+ #define H_gdk_display_set_double_click_time "void gdk_display_set_double_click_time(GdkDisplay* display, \
+guint msec)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_set_double_click_time", "GdkDisplay*");
+ Xen_check_type(Xen_is_guint(msec), msec, 2, "gdk_display_set_double_click_time", "guint");
+ gdk_display_set_double_click_time(Xen_to_C_GdkDisplay_(display), Xen_to_C_guint(msec));
+ return(Xen_false);
}
-static XEN gxg_pango_coverage_new(void)
+static Xen gxg_gdk_display_get_default(void)
{
- #define H_pango_coverage_new "PangoCoverage* pango_coverage_new( void)"
- return(C_TO_XEN_PangoCoverage_(pango_coverage_new()));
+ #define H_gdk_display_get_default "GdkDisplay* gdk_display_get_default( void)"
+ return(C_to_Xen_GdkDisplay_(gdk_display_get_default()));
}
-static XEN gxg_pango_coverage_ref(XEN coverage)
+static Xen gxg_gdk_screen_get_system_visual(Xen screen)
{
- #define H_pango_coverage_ref "PangoCoverage* pango_coverage_ref(PangoCoverage* coverage)"
- XEN_ASSERT_TYPE(XEN_PangoCoverage__P(coverage), coverage, 1, "pango_coverage_ref", "PangoCoverage*");
- return(C_TO_XEN_PangoCoverage_(pango_coverage_ref(XEN_TO_C_PangoCoverage_(coverage))));
+ #define H_gdk_screen_get_system_visual "GdkVisual* gdk_screen_get_system_visual(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_system_visual", "GdkScreen*");
+ return(C_to_Xen_GdkVisual_(gdk_screen_get_system_visual(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_coverage_unref(XEN coverage)
+static Xen gxg_gdk_screen_get_root_window(Xen screen)
{
- #define H_pango_coverage_unref "void pango_coverage_unref(PangoCoverage* coverage)"
- XEN_ASSERT_TYPE(XEN_PangoCoverage__P(coverage), coverage, 1, "pango_coverage_unref", "PangoCoverage*");
- pango_coverage_unref(XEN_TO_C_PangoCoverage_(coverage));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_root_window "GdkWindow* gdk_screen_get_root_window(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_root_window", "GdkScreen*");
+ return(C_to_Xen_GdkWindow_(gdk_screen_get_root_window(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_coverage_copy(XEN coverage)
+static Xen gxg_gdk_screen_get_display(Xen screen)
{
- #define H_pango_coverage_copy "PangoCoverage* pango_coverage_copy(PangoCoverage* coverage)"
- XEN_ASSERT_TYPE(XEN_PangoCoverage__P(coverage), coverage, 1, "pango_coverage_copy", "PangoCoverage*");
- return(C_TO_XEN_PangoCoverage_(pango_coverage_copy(XEN_TO_C_PangoCoverage_(coverage))));
+ #define H_gdk_screen_get_display "GdkDisplay* gdk_screen_get_display(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_display", "GdkScreen*");
+ return(C_to_Xen_GdkDisplay_(gdk_screen_get_display(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_coverage_get(XEN coverage, XEN index)
+static Xen gxg_gdk_screen_get_number(Xen screen)
{
- #define H_pango_coverage_get "PangoCoverageLevel pango_coverage_get(PangoCoverage* coverage, int index)"
- XEN_ASSERT_TYPE(XEN_PangoCoverage__P(coverage), coverage, 1, "pango_coverage_get", "PangoCoverage*");
- XEN_ASSERT_TYPE(XEN_int_P(index), index, 2, "pango_coverage_get", "int");
- return(C_TO_XEN_PangoCoverageLevel(pango_coverage_get(XEN_TO_C_PangoCoverage_(coverage), XEN_TO_C_int(index))));
+ #define H_gdk_screen_get_number "int gdk_screen_get_number(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_number", "GdkScreen*");
+ return(C_to_Xen_int(gdk_screen_get_number(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_coverage_set(XEN coverage, XEN index, XEN level)
+static Xen gxg_gdk_screen_get_width(Xen screen)
{
- #define H_pango_coverage_set "void pango_coverage_set(PangoCoverage* coverage, int index, PangoCoverageLevel level)"
- XEN_ASSERT_TYPE(XEN_PangoCoverage__P(coverage), coverage, 1, "pango_coverage_set", "PangoCoverage*");
- XEN_ASSERT_TYPE(XEN_int_P(index), index, 2, "pango_coverage_set", "int");
- XEN_ASSERT_TYPE(XEN_PangoCoverageLevel_P(level), level, 3, "pango_coverage_set", "PangoCoverageLevel");
- pango_coverage_set(XEN_TO_C_PangoCoverage_(coverage), XEN_TO_C_int(index), XEN_TO_C_PangoCoverageLevel(level));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_width "int gdk_screen_get_width(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_width", "GdkScreen*");
+ return(C_to_Xen_int(gdk_screen_get_width(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_coverage_max(XEN coverage, XEN other)
+static Xen gxg_gdk_screen_get_height(Xen screen)
{
- #define H_pango_coverage_max "void pango_coverage_max(PangoCoverage* coverage, PangoCoverage* other)"
- XEN_ASSERT_TYPE(XEN_PangoCoverage__P(coverage), coverage, 1, "pango_coverage_max", "PangoCoverage*");
- XEN_ASSERT_TYPE(XEN_PangoCoverage__P(other), other, 2, "pango_coverage_max", "PangoCoverage*");
- pango_coverage_max(XEN_TO_C_PangoCoverage_(coverage), XEN_TO_C_PangoCoverage_(other));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_height "int gdk_screen_get_height(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_height", "GdkScreen*");
+ return(C_to_Xen_int(gdk_screen_get_height(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_coverage_to_bytes(XEN coverage, XEN ignore_bytes, XEN ignore_n_bytes)
+static Xen gxg_gdk_screen_get_width_mm(Xen screen)
{
- #define H_pango_coverage_to_bytes "void pango_coverage_to_bytes(PangoCoverage* coverage, guchar** [bytes], \
-int* [n_bytes])"
- guchar* ref_bytes = NULL;
- int ref_n_bytes;
- XEN_ASSERT_TYPE(XEN_PangoCoverage__P(coverage), coverage, 1, "pango_coverage_to_bytes", "PangoCoverage*");
- pango_coverage_to_bytes(XEN_TO_C_PangoCoverage_(coverage), &ref_bytes, &ref_n_bytes);
- return(XEN_LIST_2(C_TO_XEN_guchar_(ref_bytes), C_TO_XEN_int(ref_n_bytes)));
+ #define H_gdk_screen_get_width_mm "int gdk_screen_get_width_mm(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_width_mm", "GdkScreen*");
+ return(C_to_Xen_int(gdk_screen_get_width_mm(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_coverage_from_bytes(XEN bytes, XEN n_bytes)
+static Xen gxg_gdk_screen_get_height_mm(Xen screen)
{
- #define H_pango_coverage_from_bytes "PangoCoverage* pango_coverage_from_bytes(guchar* bytes, int n_bytes)"
- XEN_ASSERT_TYPE(XEN_guchar__P(bytes), bytes, 1, "pango_coverage_from_bytes", "guchar*");
- XEN_ASSERT_TYPE(XEN_int_P(n_bytes), n_bytes, 2, "pango_coverage_from_bytes", "int");
- return(C_TO_XEN_PangoCoverage_(pango_coverage_from_bytes(XEN_TO_C_guchar_(bytes), XEN_TO_C_int(n_bytes))));
+ #define H_gdk_screen_get_height_mm "int gdk_screen_get_height_mm(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_height_mm", "GdkScreen*");
+ return(C_to_Xen_int(gdk_screen_get_height_mm(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_font_description_new(void)
+static Xen gxg_gdk_screen_list_visuals(Xen screen)
{
- #define H_pango_font_description_new "PangoFontDescription* pango_font_description_new( void)"
- return(C_TO_XEN_PangoFontDescription_(pango_font_description_new()));
+ #define H_gdk_screen_list_visuals "GList* gdk_screen_list_visuals(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_list_visuals", "GdkScreen*");
+ return(C_to_Xen_GList_(gdk_screen_list_visuals(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_font_description_copy(XEN desc)
+static Xen gxg_gdk_screen_get_toplevel_windows(Xen screen)
{
- #define H_pango_font_description_copy "PangoFontDescription* pango_font_description_copy(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_copy", "PangoFontDescription*");
- return(C_TO_XEN_PangoFontDescription_(pango_font_description_copy(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_gdk_screen_get_toplevel_windows "GList* gdk_screen_get_toplevel_windows(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_toplevel_windows", "GdkScreen*");
+ return(C_to_Xen_GList_(gdk_screen_get_toplevel_windows(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_font_description_copy_static(XEN desc)
+static Xen gxg_gdk_screen_make_display_name(Xen screen)
{
- #define H_pango_font_description_copy_static "PangoFontDescription* pango_font_description_copy_static(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_copy_static", "PangoFontDescription*");
- return(C_TO_XEN_PangoFontDescription_(pango_font_description_copy_static(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_gdk_screen_make_display_name "gchar* gdk_screen_make_display_name(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_make_display_name", "GdkScreen*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gdk_screen_make_display_name(Xen_to_C_GdkScreen_(screen));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_pango_font_description_hash(XEN desc)
+static Xen gxg_gdk_screen_get_n_monitors(Xen screen)
{
- #define H_pango_font_description_hash "guint pango_font_description_hash(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_hash", "PangoFontDescription*");
- return(C_TO_XEN_guint(pango_font_description_hash(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_gdk_screen_get_n_monitors "int gdk_screen_get_n_monitors(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_n_monitors", "GdkScreen*");
+ return(C_to_Xen_int(gdk_screen_get_n_monitors(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_font_description_equal(XEN desc1, XEN desc2)
+static Xen gxg_gdk_screen_get_monitor_geometry(Xen screen, Xen monitor_num, Xen dest)
{
- #define H_pango_font_description_equal "gboolean pango_font_description_equal(PangoFontDescription* desc1, \
-PangoFontDescription* desc2)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc1), desc1, 1, "pango_font_description_equal", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc2), desc2, 2, "pango_font_description_equal", "PangoFontDescription*");
- return(C_TO_XEN_gboolean(pango_font_description_equal(XEN_TO_C_PangoFontDescription_(desc1), XEN_TO_C_PangoFontDescription_(desc2))));
+ #define H_gdk_screen_get_monitor_geometry "void gdk_screen_get_monitor_geometry(GdkScreen* screen, \
+int monitor_num, GdkRectangle* dest)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_monitor_geometry", "GdkScreen*");
+ Xen_check_type(Xen_is_int(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_geometry", "int");
+ Xen_check_type(Xen_is_GdkRectangle_(dest), dest, 3, "gdk_screen_get_monitor_geometry", "GdkRectangle*");
+ gdk_screen_get_monitor_geometry(Xen_to_C_GdkScreen_(screen), Xen_to_C_int(monitor_num), Xen_to_C_GdkRectangle_(dest));
+ return(Xen_false);
}
-static XEN gxg_pango_font_description_free(XEN desc)
+static Xen gxg_gdk_screen_get_monitor_at_point(Xen screen, Xen x, Xen y)
{
- #define H_pango_font_description_free "void pango_font_description_free(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_free", "PangoFontDescription*");
- pango_font_description_free(XEN_TO_C_PangoFontDescription_(desc));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_monitor_at_point "int gdk_screen_get_monitor_at_point(GdkScreen* screen, int x, \
+int y)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_monitor_at_point", "GdkScreen*");
+ Xen_check_type(Xen_is_int(x), x, 2, "gdk_screen_get_monitor_at_point", "int");
+ Xen_check_type(Xen_is_int(y), y, 3, "gdk_screen_get_monitor_at_point", "int");
+ return(C_to_Xen_int(gdk_screen_get_monitor_at_point(Xen_to_C_GdkScreen_(screen), Xen_to_C_int(x), Xen_to_C_int(y))));
}
-static XEN gxg_pango_font_descriptions_free(XEN descs, XEN n_descs)
+static Xen gxg_gdk_screen_get_monitor_at_window(Xen screen, Xen window)
{
- #define H_pango_font_descriptions_free "void pango_font_descriptions_free(PangoFontDescription** descs, \
-int n_descs)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription___P(descs), descs, 1, "pango_font_descriptions_free", "PangoFontDescription**");
- XEN_ASSERT_TYPE(XEN_int_P(n_descs), n_descs, 2, "pango_font_descriptions_free", "int");
- pango_font_descriptions_free(XEN_TO_C_PangoFontDescription__(descs), XEN_TO_C_int(n_descs));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_monitor_at_window "int gdk_screen_get_monitor_at_window(GdkScreen* screen, \
+GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_monitor_at_window", "GdkScreen*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 2, "gdk_screen_get_monitor_at_window", "GdkWindow*");
+ return(C_to_Xen_int(gdk_screen_get_monitor_at_window(Xen_to_C_GdkScreen_(screen), Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_pango_font_description_set_family(XEN desc, XEN family)
+static Xen gxg_gdk_screen_get_default(void)
{
- #define H_pango_font_description_set_family "void pango_font_description_set_family(PangoFontDescription* desc, \
-char* family)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_set_family", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_char__P(family), family, 2, "pango_font_description_set_family", "char*");
- pango_font_description_set_family(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_char_(family));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_default "GdkScreen* gdk_screen_get_default( void)"
+ return(C_to_Xen_GdkScreen_(gdk_screen_get_default()));
}
-static XEN gxg_pango_font_description_set_family_static(XEN desc, XEN family)
+static Xen gxg_gtk_clipboard_get_for_display(Xen display, Xen selection)
{
- #define H_pango_font_description_set_family_static "void pango_font_description_set_family_static(PangoFontDescription* desc, \
-char* family)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_set_family_static", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_char__P(family), family, 2, "pango_font_description_set_family_static", "char*");
- pango_font_description_set_family_static(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_char_(family));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_get_for_display "GtkClipboard* gtk_clipboard_get_for_display(GdkDisplay* display, \
+GdkAtom selection)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gtk_clipboard_get_for_display", "GdkDisplay*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gtk_clipboard_get_for_display", "GdkAtom");
+ return(C_to_Xen_GtkClipboard_(gtk_clipboard_get_for_display(Xen_to_C_GdkDisplay_(display), Xen_to_C_GdkAtom(selection))));
}
-static XEN gxg_pango_font_description_get_family(XEN desc)
+static Xen gxg_gtk_clipboard_get_display(Xen clipboard)
{
- #define H_pango_font_description_get_family "char* pango_font_description_get_family(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_get_family", "PangoFontDescription*");
- return(C_TO_XEN_char_(pango_font_description_get_family(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_gtk_clipboard_get_display "GdkDisplay* gtk_clipboard_get_display(GtkClipboard* clipboard)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_get_display", "GtkClipboard*");
+ return(C_to_Xen_GdkDisplay_(gtk_clipboard_get_display(Xen_to_C_GtkClipboard_(clipboard))));
}
-static XEN gxg_pango_font_description_set_style(XEN desc, XEN style)
+static Xen gxg_gtk_widget_get_screen(Xen widget)
{
- #define H_pango_font_description_set_style "void pango_font_description_set_style(PangoFontDescription* desc, \
-PangoStyle style)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_set_style", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoStyle_P(style), style, 2, "pango_font_description_set_style", "PangoStyle");
- pango_font_description_set_style(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoStyle(style));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_screen "GdkScreen* gtk_widget_get_screen(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_screen", "GtkWidget*");
+ return(C_to_Xen_GdkScreen_(gtk_widget_get_screen(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_pango_font_description_get_style(XEN desc)
+static Xen gxg_gtk_widget_has_screen(Xen widget)
{
- #define H_pango_font_description_get_style "PangoStyle pango_font_description_get_style(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_get_style", "PangoFontDescription*");
- return(C_TO_XEN_PangoStyle(pango_font_description_get_style(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_gtk_widget_has_screen "gboolean gtk_widget_has_screen(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_has_screen", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_has_screen(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_pango_font_description_set_variant(XEN desc, XEN variant)
+static Xen gxg_gtk_widget_get_display(Xen widget)
{
- #define H_pango_font_description_set_variant "void pango_font_description_set_variant(PangoFontDescription* desc, \
-PangoVariant variant)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_set_variant", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoVariant_P(variant), variant, 2, "pango_font_description_set_variant", "PangoVariant");
- pango_font_description_set_variant(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoVariant(variant));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_display "GdkDisplay* gtk_widget_get_display(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_display", "GtkWidget*");
+ return(C_to_Xen_GdkDisplay_(gtk_widget_get_display(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_pango_font_description_get_variant(XEN desc)
+static Xen gxg_gtk_widget_get_clipboard(Xen widget, Xen selection)
{
- #define H_pango_font_description_get_variant "PangoVariant pango_font_description_get_variant(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_get_variant", "PangoFontDescription*");
- return(C_TO_XEN_PangoVariant(pango_font_description_get_variant(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_gtk_widget_get_clipboard "GtkClipboard* gtk_widget_get_clipboard(GtkWidget* widget, GdkAtom selection)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_clipboard", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gtk_widget_get_clipboard", "GdkAtom");
+ return(C_to_Xen_GtkClipboard_(gtk_widget_get_clipboard(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkAtom(selection))));
}
-static XEN gxg_pango_font_description_set_weight(XEN desc, XEN weight)
+static Xen gxg_g_list_free(Xen list)
{
- #define H_pango_font_description_set_weight "void pango_font_description_set_weight(PangoFontDescription* desc, \
-PangoWeight weight)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_set_weight", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoWeight_P(weight), weight, 2, "pango_font_description_set_weight", "PangoWeight");
- pango_font_description_set_weight(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoWeight(weight));
- return(XEN_FALSE);
+ #define H_g_list_free "void g_list_free(GList* list)"
+ Xen_check_type(Xen_is_GList_(list), list, 1, "g_list_free", "GList*");
+ g_list_free(Xen_to_C_GList_(list));
+ return(Xen_false);
}
-static XEN gxg_pango_font_description_get_weight(XEN desc)
+static Xen gxg_g_list_reverse(Xen list)
{
- #define H_pango_font_description_get_weight "PangoWeight pango_font_description_get_weight(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_get_weight", "PangoFontDescription*");
- return(C_TO_XEN_PangoWeight(pango_font_description_get_weight(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_g_list_reverse "GList* g_list_reverse(GList* list)"
+ Xen_check_type(Xen_is_GList_(list) || Xen_is_false(list), list, 1, "g_list_reverse", "GList*");
+ return(C_to_Xen_GList_(g_list_reverse(Xen_to_C_GList_(list))));
}
-static XEN gxg_pango_font_description_set_stretch(XEN desc, XEN stretch)
+static Xen gxg_g_list_copy(Xen list)
{
- #define H_pango_font_description_set_stretch "void pango_font_description_set_stretch(PangoFontDescription* desc, \
-PangoStretch stretch)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_set_stretch", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoStretch_P(stretch), stretch, 2, "pango_font_description_set_stretch", "PangoStretch");
- pango_font_description_set_stretch(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoStretch(stretch));
- return(XEN_FALSE);
+ #define H_g_list_copy "GList* g_list_copy(GList* list)"
+ Xen_check_type(Xen_is_GList_(list) || Xen_is_false(list), list, 1, "g_list_copy", "GList*");
+ return(C_to_Xen_GList_(g_list_copy(Xen_to_C_GList_(list))));
}
-static XEN gxg_pango_font_description_get_stretch(XEN desc)
+static Xen gxg_g_list_last(Xen list)
{
- #define H_pango_font_description_get_stretch "PangoStretch pango_font_description_get_stretch(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_get_stretch", "PangoFontDescription*");
- return(C_TO_XEN_PangoStretch(pango_font_description_get_stretch(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_g_list_last "GList* g_list_last(GList* list)"
+ Xen_check_type(Xen_is_GList_(list), list, 1, "g_list_last", "GList*");
+ return(C_to_Xen_GList_(g_list_last(Xen_to_C_GList_(list))));
}
-static XEN gxg_pango_font_description_set_size(XEN desc, XEN size)
+static Xen gxg_g_list_first(Xen list)
{
- #define H_pango_font_description_set_size "void pango_font_description_set_size(PangoFontDescription* desc, \
-gint size)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_set_size", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_gint_P(size), size, 2, "pango_font_description_set_size", "gint");
- pango_font_description_set_size(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_gint(size));
- return(XEN_FALSE);
+ #define H_g_list_first "GList* g_list_first(GList* list)"
+ Xen_check_type(Xen_is_GList_(list), list, 1, "g_list_first", "GList*");
+ return(C_to_Xen_GList_(g_list_first(Xen_to_C_GList_(list))));
}
-static XEN gxg_pango_font_description_get_size(XEN desc)
+static Xen gxg_g_list_length(Xen list)
{
- #define H_pango_font_description_get_size "gint pango_font_description_get_size(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_get_size", "PangoFontDescription*");
- return(C_TO_XEN_gint(pango_font_description_get_size(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_g_list_length "guint g_list_length(GList* list)"
+ Xen_check_type(Xen_is_GList_(list) || Xen_is_false(list), list, 1, "g_list_length", "GList*");
+ return(C_to_Xen_guint(g_list_length(Xen_to_C_GList_(list))));
}
-static XEN gxg_pango_font_description_get_set_fields(XEN desc)
+static Xen gxg_g_free(Xen mem)
{
- #define H_pango_font_description_get_set_fields "PangoFontMask pango_font_description_get_set_fields(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_get_set_fields", "PangoFontDescription*");
- return(C_TO_XEN_PangoFontMask(pango_font_description_get_set_fields(XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_g_free "void g_free(gpointer mem)"
+ Xen_check_type(Xen_is_gpointer(mem), mem, 1, "g_free", "gpointer");
+ g_free(Xen_to_C_gpointer(mem));
+ return(Xen_false);
}
-static XEN gxg_pango_font_description_unset_fields(XEN desc, XEN to_unset)
+static Xen gxg_g_list_remove_link(Xen list, Xen llink)
{
- #define H_pango_font_description_unset_fields "void pango_font_description_unset_fields(PangoFontDescription* desc, \
-PangoFontMask to_unset)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_unset_fields", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoFontMask_P(to_unset), to_unset, 2, "pango_font_description_unset_fields", "PangoFontMask");
- pango_font_description_unset_fields(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoFontMask(to_unset));
- return(XEN_FALSE);
+ #define H_g_list_remove_link "GList* g_list_remove_link(GList* list, GList* llink)"
+ Xen_check_type(Xen_is_GList_(list), list, 1, "g_list_remove_link", "GList*");
+ Xen_check_type(Xen_is_GList_(llink), llink, 2, "g_list_remove_link", "GList*");
+ return(C_to_Xen_GList_(g_list_remove_link(Xen_to_C_GList_(list), Xen_to_C_GList_(llink))));
}
-static XEN gxg_pango_font_description_merge(XEN desc, XEN desc_to_merge, XEN replace_existing)
+static Xen gxg_g_object_get_data(Xen object, Xen key)
{
- #define H_pango_font_description_merge "void pango_font_description_merge(PangoFontDescription* desc, \
-PangoFontDescription* desc_to_merge, gboolean replace_existing)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_merge", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc_to_merge), desc_to_merge, 2, "pango_font_description_merge", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(replace_existing), replace_existing, 3, "pango_font_description_merge", "gboolean");
- pango_font_description_merge(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoFontDescription_(desc_to_merge), XEN_TO_C_gboolean(replace_existing));
- return(XEN_FALSE);
+ #define H_g_object_get_data "gpointer g_object_get_data(GObject* object, gchar* key)"
+ Xen_check_type(Xen_is_GObject_(object), object, 1, "g_object_get_data", "GObject*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "g_object_get_data", "gchar*");
+ return(C_to_Xen_gpointer(g_object_get_data(Xen_to_C_GObject_(object), (const gchar*)Xen_to_C_gchar_(key))));
}
-static XEN gxg_pango_font_description_merge_static(XEN desc, XEN desc_to_merge, XEN replace_existing)
+static Xen gxg_g_object_set_data(Xen object, Xen key, Xen data)
{
- #define H_pango_font_description_merge_static "void pango_font_description_merge_static(PangoFontDescription* desc, \
-PangoFontDescription* desc_to_merge, gboolean replace_existing)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_merge_static", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc_to_merge), desc_to_merge, 2, "pango_font_description_merge_static", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(replace_existing), replace_existing, 3, "pango_font_description_merge_static", "gboolean");
- pango_font_description_merge_static(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoFontDescription_(desc_to_merge),
- XEN_TO_C_gboolean(replace_existing));
- return(XEN_FALSE);
+ #define H_g_object_set_data "void g_object_set_data(GObject* object, gchar* key, gpointer data)"
+ Xen_check_type(Xen_is_GObject_(object), object, 1, "g_object_set_data", "GObject*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "g_object_set_data", "gchar*");
+ Xen_check_type(Xen_is_gpointer(data), data, 3, "g_object_set_data", "gpointer");
+ g_object_set_data(Xen_to_C_GObject_(object), (const gchar*)Xen_to_C_gchar_(key), Xen_to_C_gpointer(data));
+ return(Xen_false);
}
-static XEN gxg_pango_font_description_better_match(XEN desc, XEN old_match, XEN new_match)
+static Xen gxg_gdk_cursor_new_from_pixbuf(Xen display, Xen pixbuf, Xen x, Xen y)
{
- #define H_pango_font_description_better_match "gboolean pango_font_description_better_match(PangoFontDescription* desc, \
-PangoFontDescription* old_match, PangoFontDescription* new_match)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_better_match", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(old_match), old_match, 2, "pango_font_description_better_match", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(new_match), new_match, 3, "pango_font_description_better_match", "PangoFontDescription*");
- return(C_TO_XEN_gboolean(pango_font_description_better_match(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoFontDescription_(old_match),
- XEN_TO_C_PangoFontDescription_(new_match))));
+ #define H_gdk_cursor_new_from_pixbuf "GdkCursor* gdk_cursor_new_from_pixbuf(GdkDisplay* display, GdkPixbuf* pixbuf, \
+gint x, gint y)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_cursor_new_from_pixbuf", "GdkDisplay*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 2, "gdk_cursor_new_from_pixbuf", "GdkPixbuf*");
+ Xen_check_type(Xen_is_gint(x), x, 3, "gdk_cursor_new_from_pixbuf", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 4, "gdk_cursor_new_from_pixbuf", "gint");
+ return(C_to_Xen_GdkCursor_(gdk_cursor_new_from_pixbuf(Xen_to_C_GdkDisplay_(display), Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_gint(x),
+ Xen_to_C_gint(y))));
}
-static XEN gxg_pango_font_description_from_string(XEN str)
+static Xen gxg_gdk_display_flush(Xen display)
{
- #define H_pango_font_description_from_string "PangoFontDescription* pango_font_description_from_string(char* str)"
- XEN_ASSERT_TYPE(XEN_char__P(str), str, 1, "pango_font_description_from_string", "char*");
- return(C_TO_XEN_PangoFontDescription_(pango_font_description_from_string(XEN_TO_C_char_(str))));
+ #define H_gdk_display_flush "void gdk_display_flush(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_flush", "GdkDisplay*");
+ gdk_display_flush(Xen_to_C_GdkDisplay_(display));
+ return(Xen_false);
}
-static XEN gxg_pango_font_description_to_string(XEN desc)
+static Xen gxg_gdk_display_supports_cursor_alpha(Xen display)
{
- #define H_pango_font_description_to_string "char* pango_font_description_to_string(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_to_string", "PangoFontDescription*");
- {
- char* result;
- XEN rtn;
- result = pango_font_description_to_string(XEN_TO_C_PangoFontDescription_(desc));
- rtn = C_TO_XEN_char_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gdk_display_supports_cursor_alpha "gboolean gdk_display_supports_cursor_alpha(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_supports_cursor_alpha", "GdkDisplay*");
+ return(C_to_Xen_gboolean(gdk_display_supports_cursor_alpha(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_pango_font_description_to_filename(XEN desc)
+static Xen gxg_gdk_display_supports_cursor_color(Xen display)
{
- #define H_pango_font_description_to_filename "char* pango_font_description_to_filename(PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_to_filename", "PangoFontDescription*");
- {
- char* result;
- XEN rtn;
- result = pango_font_description_to_filename(XEN_TO_C_PangoFontDescription_(desc));
- rtn = C_TO_XEN_char_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gdk_display_supports_cursor_color "gboolean gdk_display_supports_cursor_color(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_supports_cursor_color", "GdkDisplay*");
+ return(C_to_Xen_gboolean(gdk_display_supports_cursor_color(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_pango_font_metrics_ref(XEN metrics)
+static Xen gxg_gdk_display_get_default_cursor_size(Xen display)
{
- #define H_pango_font_metrics_ref "PangoFontMetrics* pango_font_metrics_ref(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_ref", "PangoFontMetrics*");
- return(C_TO_XEN_PangoFontMetrics_(pango_font_metrics_ref(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gdk_display_get_default_cursor_size "guint gdk_display_get_default_cursor_size(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_get_default_cursor_size", "GdkDisplay*");
+ return(C_to_Xen_guint(gdk_display_get_default_cursor_size(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_pango_font_metrics_unref(XEN metrics)
+static Xen gxg_gdk_display_get_maximal_cursor_size(Xen display, Xen ignore_width, Xen ignore_height)
{
- #define H_pango_font_metrics_unref "void pango_font_metrics_unref(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_unref", "PangoFontMetrics*");
- pango_font_metrics_unref(XEN_TO_C_PangoFontMetrics_(metrics));
- return(XEN_FALSE);
+ #define H_gdk_display_get_maximal_cursor_size "void gdk_display_get_maximal_cursor_size(GdkDisplay* display, \
+guint* [width], guint* [height])"
+ guint ref_width;
+ guint ref_height;
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_get_maximal_cursor_size", "GdkDisplay*");
+ gdk_display_get_maximal_cursor_size(Xen_to_C_GdkDisplay_(display), &ref_width, &ref_height);
+ return(Xen_list_2(C_to_Xen_guint(ref_width), C_to_Xen_guint(ref_height)));
}
-static XEN gxg_pango_font_metrics_get_ascent(XEN metrics)
+static Xen gxg_gdk_window_set_keep_above(Xen window, Xen setting)
{
- #define H_pango_font_metrics_get_ascent "int pango_font_metrics_get_ascent(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_get_ascent", "PangoFontMetrics*");
- return(C_TO_XEN_int(pango_font_metrics_get_ascent(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gdk_window_set_keep_above "void gdk_window_set_keep_above(GdkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_keep_above", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gdk_window_set_keep_above", "gboolean");
+ gdk_window_set_keep_above(Xen_to_C_GdkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_pango_font_metrics_get_descent(XEN metrics)
+static Xen gxg_gdk_window_set_keep_below(Xen window, Xen setting)
{
- #define H_pango_font_metrics_get_descent "int pango_font_metrics_get_descent(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_get_descent", "PangoFontMetrics*");
- return(C_TO_XEN_int(pango_font_metrics_get_descent(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gdk_window_set_keep_below "void gdk_window_set_keep_below(GdkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_keep_below", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gdk_window_set_keep_below", "gboolean");
+ gdk_window_set_keep_below(Xen_to_C_GdkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_pango_font_metrics_get_approximate_char_width(XEN metrics)
+static Xen gxg_gtk_button_box_get_child_secondary(Xen widget, Xen child)
{
- #define H_pango_font_metrics_get_approximate_char_width "int pango_font_metrics_get_approximate_char_width(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_get_approximate_char_width", "PangoFontMetrics*");
- return(C_TO_XEN_int(pango_font_metrics_get_approximate_char_width(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gtk_button_box_get_child_secondary "gboolean gtk_button_box_get_child_secondary(GtkButtonBox* widget, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkButtonBox_(widget), widget, 1, "gtk_button_box_get_child_secondary", "GtkButtonBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_button_box_get_child_secondary", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_button_box_get_child_secondary(Xen_to_C_GtkButtonBox_(widget), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_pango_font_metrics_get_approximate_digit_width(XEN metrics)
+static Xen gxg_gtk_calendar_set_display_options(Xen calendar, Xen flags)
{
- #define H_pango_font_metrics_get_approximate_digit_width "int pango_font_metrics_get_approximate_digit_width(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_get_approximate_digit_width", "PangoFontMetrics*");
- return(C_TO_XEN_int(pango_font_metrics_get_approximate_digit_width(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gtk_calendar_set_display_options "void gtk_calendar_set_display_options(GtkCalendar* calendar, \
+GtkCalendarDisplayOptions flags)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_set_display_options", "GtkCalendar*");
+ Xen_check_type(Xen_is_GtkCalendarDisplayOptions(flags), flags, 2, "gtk_calendar_set_display_options", "GtkCalendarDisplayOptions");
+ gtk_calendar_set_display_options(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_GtkCalendarDisplayOptions(flags));
+ return(Xen_false);
}
-static XEN gxg_pango_font_family_list_faces(XEN family, XEN ignore_faces, XEN ignore_n_faces)
+static Xen gxg_gtk_calendar_get_display_options(Xen calendar)
{
- #define H_pango_font_family_list_faces "void pango_font_family_list_faces(PangoFontFamily* family, \
-PangoFontFace*** [faces], int* [n_faces])"
- PangoFontFace** ref_faces = NULL;
- int ref_n_faces;
- XEN_ASSERT_TYPE(XEN_PangoFontFamily__P(family), family, 1, "pango_font_family_list_faces", "PangoFontFamily*");
- pango_font_family_list_faces(XEN_TO_C_PangoFontFamily_(family), &ref_faces, &ref_n_faces);
- return(XEN_LIST_2(C_TO_XEN_PangoFontFace__(ref_faces), C_TO_XEN_int(ref_n_faces)));
+ #define H_gtk_calendar_get_display_options "GtkCalendarDisplayOptions gtk_calendar_get_display_options(GtkCalendar* calendar)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_get_display_options", "GtkCalendar*");
+ return(C_to_Xen_GtkCalendarDisplayOptions(gtk_calendar_get_display_options(Xen_to_C_GtkCalendar_(calendar))));
}
-static XEN gxg_pango_font_family_get_name(XEN family)
+static Xen gxg_gtk_check_menu_item_set_draw_as_radio(Xen check_menu_item, Xen draw_as_radio)
{
- #define H_pango_font_family_get_name "char* pango_font_family_get_name(PangoFontFamily* family)"
- XEN_ASSERT_TYPE(XEN_PangoFontFamily__P(family), family, 1, "pango_font_family_get_name", "PangoFontFamily*");
- return(C_TO_XEN_char_(pango_font_family_get_name(XEN_TO_C_PangoFontFamily_(family))));
+ #define H_gtk_check_menu_item_set_draw_as_radio "void gtk_check_menu_item_set_draw_as_radio(GtkCheckMenuItem* check_menu_item, \
+gboolean draw_as_radio)"
+ Xen_check_type(Xen_is_GtkCheckMenuItem_(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_set_draw_as_radio", "GtkCheckMenuItem*");
+ Xen_check_type(Xen_is_gboolean(draw_as_radio), draw_as_radio, 2, "gtk_check_menu_item_set_draw_as_radio", "gboolean");
+ gtk_check_menu_item_set_draw_as_radio(Xen_to_C_GtkCheckMenuItem_(check_menu_item), Xen_to_C_gboolean(draw_as_radio));
+ return(Xen_false);
}
-static XEN gxg_pango_font_face_describe(XEN face)
+static Xen gxg_gtk_check_menu_item_get_draw_as_radio(Xen check_menu_item)
{
- #define H_pango_font_face_describe "PangoFontDescription* pango_font_face_describe(PangoFontFace* face)"
- XEN_ASSERT_TYPE(XEN_PangoFontFace__P(face), face, 1, "pango_font_face_describe", "PangoFontFace*");
- return(C_TO_XEN_PangoFontDescription_(pango_font_face_describe(XEN_TO_C_PangoFontFace_(face))));
+ #define H_gtk_check_menu_item_get_draw_as_radio "gboolean gtk_check_menu_item_get_draw_as_radio(GtkCheckMenuItem* check_menu_item)"
+ Xen_check_type(Xen_is_GtkCheckMenuItem_(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_get_draw_as_radio", "GtkCheckMenuItem*");
+ return(C_to_Xen_gboolean(gtk_check_menu_item_get_draw_as_radio(Xen_to_C_GtkCheckMenuItem_(check_menu_item))));
}
-static XEN gxg_pango_font_face_get_face_name(XEN face)
+static Xen gxg_gtk_entry_set_completion(Xen entry, Xen completion)
{
- #define H_pango_font_face_get_face_name "char* pango_font_face_get_face_name(PangoFontFace* face)"
- XEN_ASSERT_TYPE(XEN_PangoFontFace__P(face), face, 1, "pango_font_face_get_face_name", "PangoFontFace*");
- return(C_TO_XEN_char_(pango_font_face_get_face_name(XEN_TO_C_PangoFontFace_(face))));
+ #define H_gtk_entry_set_completion "void gtk_entry_set_completion(GtkEntry* entry, GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_completion", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 2, "gtk_entry_set_completion", "GtkEntryCompletion*");
+ gtk_entry_set_completion(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryCompletion_(completion));
+ return(Xen_false);
}
-static XEN gxg_pango_font_describe(XEN font)
+static Xen gxg_gtk_entry_get_completion(Xen entry)
{
- #define H_pango_font_describe "PangoFontDescription* pango_font_describe(PangoFont* font)"
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 1, "pango_font_describe", "PangoFont*");
- return(C_TO_XEN_PangoFontDescription_(pango_font_describe(XEN_TO_C_PangoFont_(font))));
+ #define H_gtk_entry_get_completion "GtkEntryCompletion* gtk_entry_get_completion(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_completion", "GtkEntry*");
+ return(C_to_Xen_GtkEntryCompletion_(gtk_entry_get_completion(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_pango_font_get_coverage(XEN font, XEN language)
+static Xen gxg_gtk_event_box_get_visible_window(Xen event_box)
{
- #define H_pango_font_get_coverage "PangoCoverage* pango_font_get_coverage(PangoFont* font, PangoLanguage* language)"
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 1, "pango_font_get_coverage", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 2, "pango_font_get_coverage", "PangoLanguage*");
- return(C_TO_XEN_PangoCoverage_(pango_font_get_coverage(XEN_TO_C_PangoFont_(font), XEN_TO_C_PangoLanguage_(language))));
+ #define H_gtk_event_box_get_visible_window "gboolean gtk_event_box_get_visible_window(GtkEventBox* event_box)"
+ Xen_check_type(Xen_is_GtkEventBox_(event_box), event_box, 1, "gtk_event_box_get_visible_window", "GtkEventBox*");
+ return(C_to_Xen_gboolean(gtk_event_box_get_visible_window(Xen_to_C_GtkEventBox_(event_box))));
}
-static XEN gxg_pango_font_get_metrics(XEN font, XEN language)
+static Xen gxg_gtk_event_box_set_visible_window(Xen event_box, Xen visible_window)
{
- #define H_pango_font_get_metrics "PangoFontMetrics* pango_font_get_metrics(PangoFont* font, PangoLanguage* language)"
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 1, "pango_font_get_metrics", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 2, "pango_font_get_metrics", "PangoLanguage*");
- return(C_TO_XEN_PangoFontMetrics_(pango_font_get_metrics(XEN_TO_C_PangoFont_(font), XEN_TO_C_PangoLanguage_(language))));
+ #define H_gtk_event_box_set_visible_window "void gtk_event_box_set_visible_window(GtkEventBox* event_box, \
+gboolean visible_window)"
+ Xen_check_type(Xen_is_GtkEventBox_(event_box), event_box, 1, "gtk_event_box_set_visible_window", "GtkEventBox*");
+ Xen_check_type(Xen_is_gboolean(visible_window), visible_window, 2, "gtk_event_box_set_visible_window", "gboolean");
+ gtk_event_box_set_visible_window(Xen_to_C_GtkEventBox_(event_box), Xen_to_C_gboolean(visible_window));
+ return(Xen_false);
}
-static XEN gxg_pango_font_get_glyph_extents(XEN font, XEN glyph, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_event_box_get_above_child(Xen event_box)
{
- #define H_pango_font_get_glyph_extents "void pango_font_get_glyph_extents(PangoFont* font, PangoGlyph glyph, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 1, "pango_font_get_glyph_extents", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoGlyph_P(glyph), glyph, 2, "pango_font_get_glyph_extents", "PangoGlyph");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 3, "pango_font_get_glyph_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 4, "pango_font_get_glyph_extents", "PangoRectangle*");
- pango_font_get_glyph_extents(XEN_TO_C_PangoFont_(font), XEN_TO_C_PangoGlyph(glyph), XEN_TO_C_PangoRectangle_(ink_rect),
- XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_event_box_get_above_child "gboolean gtk_event_box_get_above_child(GtkEventBox* event_box)"
+ Xen_check_type(Xen_is_GtkEventBox_(event_box), event_box, 1, "gtk_event_box_get_above_child", "GtkEventBox*");
+ return(C_to_Xen_gboolean(gtk_event_box_get_above_child(Xen_to_C_GtkEventBox_(event_box))));
}
-static XEN gxg_pango_font_map_load_font(XEN fontmap, XEN context, XEN desc)
+static Xen gxg_gtk_event_box_set_above_child(Xen event_box, Xen above_child)
{
- #define H_pango_font_map_load_font "PangoFont* pango_font_map_load_font(PangoFontMap* fontmap, PangoContext* context, \
-PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoFontMap__P(fontmap), fontmap, 1, "pango_font_map_load_font", "PangoFontMap*");
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 2, "pango_font_map_load_font", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 3, "pango_font_map_load_font", "PangoFontDescription*");
- return(C_TO_XEN_PangoFont_(pango_font_map_load_font(XEN_TO_C_PangoFontMap_(fontmap), XEN_TO_C_PangoContext_(context), XEN_TO_C_PangoFontDescription_(desc))));
+ #define H_gtk_event_box_set_above_child "void gtk_event_box_set_above_child(GtkEventBox* event_box, \
+gboolean above_child)"
+ Xen_check_type(Xen_is_GtkEventBox_(event_box), event_box, 1, "gtk_event_box_set_above_child", "GtkEventBox*");
+ Xen_check_type(Xen_is_gboolean(above_child), above_child, 2, "gtk_event_box_set_above_child", "gboolean");
+ gtk_event_box_set_above_child(Xen_to_C_GtkEventBox_(event_box), Xen_to_C_gboolean(above_child));
+ return(Xen_false);
}
-static XEN gxg_pango_font_map_load_fontset(XEN fontmap, XEN context, XEN desc, XEN language)
+static Xen gxg_gtk_menu_attach(Xen menu, Xen child, Xen left_attach, Xen right_attach, Xen top_attach, Xen bottom_attach)
{
- #define H_pango_font_map_load_fontset "PangoFontset* pango_font_map_load_fontset(PangoFontMap* fontmap, \
-PangoContext* context, PangoFontDescription* desc, PangoLanguage* language)"
- XEN_ASSERT_TYPE(XEN_PangoFontMap__P(fontmap), fontmap, 1, "pango_font_map_load_fontset", "PangoFontMap*");
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 2, "pango_font_map_load_fontset", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 3, "pango_font_map_load_fontset", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 4, "pango_font_map_load_fontset", "PangoLanguage*");
- return(C_TO_XEN_PangoFontset_(pango_font_map_load_fontset(XEN_TO_C_PangoFontMap_(fontmap), XEN_TO_C_PangoContext_(context),
- XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_PangoLanguage_(language))));
+ #define H_gtk_menu_attach "void gtk_menu_attach(GtkMenu* menu, GtkWidget* child, guint left_attach, \
+guint right_attach, guint top_attach, guint bottom_attach)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_attach", "GtkMenu*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_menu_attach", "GtkWidget*");
+ Xen_check_type(Xen_is_guint(left_attach), left_attach, 3, "gtk_menu_attach", "guint");
+ Xen_check_type(Xen_is_guint(right_attach), right_attach, 4, "gtk_menu_attach", "guint");
+ Xen_check_type(Xen_is_guint(top_attach), top_attach, 5, "gtk_menu_attach", "guint");
+ Xen_check_type(Xen_is_guint(bottom_attach), bottom_attach, 6, "gtk_menu_attach", "guint");
+ gtk_menu_attach(Xen_to_C_GtkMenu_(menu), Xen_to_C_GtkWidget_(child), Xen_to_C_guint(left_attach), Xen_to_C_guint(right_attach),
+ Xen_to_C_guint(top_attach), Xen_to_C_guint(bottom_attach));
+ return(Xen_false);
}
-static XEN gxg_pango_font_map_list_families(XEN fontmap, XEN ignore_families, XEN ignore_n_families)
+static Xen gxg_gtk_text_buffer_select_range(Xen buffer, Xen ins, Xen bound)
{
- #define H_pango_font_map_list_families "void pango_font_map_list_families(PangoFontMap* fontmap, PangoFontFamily*** [families], \
-int* [n_families])"
- PangoFontFamily** ref_families = NULL;
- int ref_n_families;
- XEN_ASSERT_TYPE(XEN_PangoFontMap__P(fontmap), fontmap, 1, "pango_font_map_list_families", "PangoFontMap*");
- pango_font_map_list_families(XEN_TO_C_PangoFontMap_(fontmap), &ref_families, &ref_n_families);
- return(XEN_LIST_2(C_TO_XEN_PangoFontFamily__(ref_families), C_TO_XEN_int(ref_n_families)));
+ #define H_gtk_text_buffer_select_range "void gtk_text_buffer_select_range(GtkTextBuffer* buffer, GtkTextIter* ins, \
+GtkTextIter* bound)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_select_range", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(ins), ins, 2, "gtk_text_buffer_select_range", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(bound), bound, 3, "gtk_text_buffer_select_range", "GtkTextIter*");
+ gtk_text_buffer_select_range(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(ins), Xen_to_C_GtkTextIter_(bound));
+ return(Xen_false);
}
-static XEN gxg_pango_glyph_string_new(void)
+static Xen gxg_gtk_text_view_set_overwrite(Xen text_view, Xen overwrite)
{
- #define H_pango_glyph_string_new "PangoGlyphString* pango_glyph_string_new( void)"
- return(C_TO_XEN_PangoGlyphString_(pango_glyph_string_new()));
+ #define H_gtk_text_view_set_overwrite "void gtk_text_view_set_overwrite(GtkTextView* text_view, gboolean overwrite)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_overwrite", "GtkTextView*");
+ Xen_check_type(Xen_is_gboolean(overwrite), overwrite, 2, "gtk_text_view_set_overwrite", "gboolean");
+ gtk_text_view_set_overwrite(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gboolean(overwrite));
+ return(Xen_false);
}
-static XEN gxg_pango_glyph_string_set_size(XEN string, XEN new_len)
+static Xen gxg_gtk_text_view_get_overwrite(Xen text_view)
{
- #define H_pango_glyph_string_set_size "void pango_glyph_string_set_size(PangoGlyphString* string, gint new_len)"
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(string), string, 1, "pango_glyph_string_set_size", "PangoGlyphString*");
- XEN_ASSERT_TYPE(XEN_gint_P(new_len), new_len, 2, "pango_glyph_string_set_size", "gint");
- pango_glyph_string_set_size(XEN_TO_C_PangoGlyphString_(string), XEN_TO_C_gint(new_len));
- return(XEN_FALSE);
+ #define H_gtk_text_view_get_overwrite "gboolean gtk_text_view_get_overwrite(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_overwrite", "GtkTextView*");
+ return(C_to_Xen_gboolean(gtk_text_view_get_overwrite(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_pango_glyph_string_copy(XEN string)
+static Xen gxg_gtk_text_view_set_accepts_tab(Xen text_view, Xen accepts_tab)
{
- #define H_pango_glyph_string_copy "PangoGlyphString* pango_glyph_string_copy(PangoGlyphString* string)"
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(string), string, 1, "pango_glyph_string_copy", "PangoGlyphString*");
- return(C_TO_XEN_PangoGlyphString_(pango_glyph_string_copy(XEN_TO_C_PangoGlyphString_(string))));
+ #define H_gtk_text_view_set_accepts_tab "void gtk_text_view_set_accepts_tab(GtkTextView* text_view, \
+gboolean accepts_tab)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_accepts_tab", "GtkTextView*");
+ Xen_check_type(Xen_is_gboolean(accepts_tab), accepts_tab, 2, "gtk_text_view_set_accepts_tab", "gboolean");
+ gtk_text_view_set_accepts_tab(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gboolean(accepts_tab));
+ return(Xen_false);
}
-static XEN gxg_pango_glyph_string_free(XEN string)
+static Xen gxg_gtk_text_view_get_accepts_tab(Xen text_view)
{
- #define H_pango_glyph_string_free "void pango_glyph_string_free(PangoGlyphString* string)"
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(string), string, 1, "pango_glyph_string_free", "PangoGlyphString*");
- pango_glyph_string_free(XEN_TO_C_PangoGlyphString_(string));
- return(XEN_FALSE);
+ #define H_gtk_text_view_get_accepts_tab "gboolean gtk_text_view_get_accepts_tab(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_accepts_tab", "GtkTextView*");
+ return(C_to_Xen_gboolean(gtk_text_view_get_accepts_tab(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_pango_glyph_string_extents(XEN glyphs, XEN font, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_toolbar_insert(Xen toolbar, Xen item, Xen pos)
{
- #define H_pango_glyph_string_extents "void pango_glyph_string_extents(PangoGlyphString* glyphs, PangoFont* font, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 1, "pango_glyph_string_extents", "PangoGlyphString*");
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 2, "pango_glyph_string_extents", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 3, "pango_glyph_string_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 4, "pango_glyph_string_extents", "PangoRectangle*");
- pango_glyph_string_extents(XEN_TO_C_PangoGlyphString_(glyphs), XEN_TO_C_PangoFont_(font), XEN_TO_C_PangoRectangle_(ink_rect),
- XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_toolbar_insert "void gtk_toolbar_insert(GtkToolbar* toolbar, GtkToolItem* item, gint pos)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_insert", "GtkToolbar*");
+ Xen_check_type(Xen_is_GtkToolItem_(item), item, 2, "gtk_toolbar_insert", "GtkToolItem*");
+ Xen_check_type(Xen_is_gint(pos), pos, 3, "gtk_toolbar_insert", "gint");
+ gtk_toolbar_insert(Xen_to_C_GtkToolbar_(toolbar), Xen_to_C_GtkToolItem_(item), Xen_to_C_gint(pos));
+ return(Xen_false);
}
-static XEN gxg_pango_glyph_string_extents_range(XEN glyphs, XEN start, XEN end, XEN font, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_toolbar_get_item_index(Xen toolbar, Xen item)
{
- #define H_pango_glyph_string_extents_range "void pango_glyph_string_extents_range(PangoGlyphString* glyphs, \
-int start, int end, PangoFont* font, PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 1, "pango_glyph_string_extents_range", "PangoGlyphString*");
- XEN_ASSERT_TYPE(XEN_int_P(start), start, 2, "pango_glyph_string_extents_range", "int");
- XEN_ASSERT_TYPE(XEN_int_P(end), end, 3, "pango_glyph_string_extents_range", "int");
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 4, "pango_glyph_string_extents_range", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 5, "pango_glyph_string_extents_range", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 6, "pango_glyph_string_extents_range", "PangoRectangle*");
- pango_glyph_string_extents_range(XEN_TO_C_PangoGlyphString_(glyphs), XEN_TO_C_int(start), XEN_TO_C_int(end), XEN_TO_C_PangoFont_(font),
- XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_toolbar_get_item_index "gint gtk_toolbar_get_item_index(GtkToolbar* toolbar, GtkToolItem* item)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_get_item_index", "GtkToolbar*");
+ Xen_check_type(Xen_is_GtkToolItem_(item), item, 2, "gtk_toolbar_get_item_index", "GtkToolItem*");
+ return(C_to_Xen_gint(gtk_toolbar_get_item_index(Xen_to_C_GtkToolbar_(toolbar), Xen_to_C_GtkToolItem_(item))));
}
-static XEN gxg_pango_glyph_string_get_logical_widths(XEN glyphs, XEN text, XEN length, XEN embedding_level, XEN ignore_logical_widths)
+static Xen gxg_gtk_toolbar_get_n_items(Xen toolbar)
{
- #define H_pango_glyph_string_get_logical_widths "void pango_glyph_string_get_logical_widths(PangoGlyphString* glyphs, \
-char* text, int length, int embedding_level, int* [logical_widths])"
- int ref_logical_widths;
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 1, "pango_glyph_string_get_logical_widths", "PangoGlyphString*");
- XEN_ASSERT_TYPE(XEN_char__P(text), text, 2, "pango_glyph_string_get_logical_widths", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 3, "pango_glyph_string_get_logical_widths", "int");
- XEN_ASSERT_TYPE(XEN_int_P(embedding_level), embedding_level, 4, "pango_glyph_string_get_logical_widths", "int");
- pango_glyph_string_get_logical_widths(XEN_TO_C_PangoGlyphString_(glyphs), XEN_TO_C_char_(text), XEN_TO_C_int(length), XEN_TO_C_int(embedding_level),
- &ref_logical_widths);
- return(XEN_LIST_1(C_TO_XEN_int(ref_logical_widths)));
+ #define H_gtk_toolbar_get_n_items "gint gtk_toolbar_get_n_items(GtkToolbar* toolbar)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_get_n_items", "GtkToolbar*");
+ return(C_to_Xen_gint(gtk_toolbar_get_n_items(Xen_to_C_GtkToolbar_(toolbar))));
}
-static XEN gxg_pango_glyph_string_index_to_x(XEN glyphs, XEN text, XEN length, XEN analysis, XEN index, XEN trailing, XEN ignore_x_pos)
+static Xen gxg_gtk_toolbar_get_nth_item(Xen toolbar, Xen n)
{
- #define H_pango_glyph_string_index_to_x "void pango_glyph_string_index_to_x(PangoGlyphString* glyphs, \
-char* text, int length, PangoAnalysis* analysis, int index, gboolean trailing, int* [x_pos])"
- int ref_x_pos;
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 1, "pango_glyph_string_index_to_x", "PangoGlyphString*");
- XEN_ASSERT_TYPE(XEN_char__P(text), text, 2, "pango_glyph_string_index_to_x", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 3, "pango_glyph_string_index_to_x", "int");
- XEN_ASSERT_TYPE(XEN_PangoAnalysis__P(analysis), analysis, 4, "pango_glyph_string_index_to_x", "PangoAnalysis*");
- XEN_ASSERT_TYPE(XEN_int_P(index), index, 5, "pango_glyph_string_index_to_x", "int");
- XEN_ASSERT_TYPE(XEN_gboolean_P(trailing), trailing, 6, "pango_glyph_string_index_to_x", "gboolean");
- pango_glyph_string_index_to_x(XEN_TO_C_PangoGlyphString_(glyphs), XEN_TO_C_char_(text), XEN_TO_C_int(length), XEN_TO_C_PangoAnalysis_(analysis),
- XEN_TO_C_int(index), XEN_TO_C_gboolean(trailing), &ref_x_pos);
- return(XEN_LIST_1(C_TO_XEN_int(ref_x_pos)));
+ #define H_gtk_toolbar_get_nth_item "GtkToolItem* gtk_toolbar_get_nth_item(GtkToolbar* toolbar, gint n)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_get_nth_item", "GtkToolbar*");
+ Xen_check_type(Xen_is_gint(n), n, 2, "gtk_toolbar_get_nth_item", "gint");
+ return(C_to_Xen_GtkToolItem_(gtk_toolbar_get_nth_item(Xen_to_C_GtkToolbar_(toolbar), Xen_to_C_gint(n))));
}
-static XEN gxg_pango_glyph_string_x_to_index(XEN glyphs, XEN text, XEN length, XEN analysis, XEN x_pos, XEN ignore_index, XEN ignore_trailing)
+static Xen gxg_gtk_toolbar_set_show_arrow(Xen toolbar, Xen show_arrow)
{
- #define H_pango_glyph_string_x_to_index "void pango_glyph_string_x_to_index(PangoGlyphString* glyphs, \
-char* text, int length, PangoAnalysis* analysis, int x_pos, int* [index], int* [trailing])"
- int ref_index;
- int ref_trailing;
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 1, "pango_glyph_string_x_to_index", "PangoGlyphString*");
- XEN_ASSERT_TYPE(XEN_char__P(text), text, 2, "pango_glyph_string_x_to_index", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 3, "pango_glyph_string_x_to_index", "int");
- XEN_ASSERT_TYPE(XEN_PangoAnalysis__P(analysis), analysis, 4, "pango_glyph_string_x_to_index", "PangoAnalysis*");
- XEN_ASSERT_TYPE(XEN_int_P(x_pos), x_pos, 5, "pango_glyph_string_x_to_index", "int");
- pango_glyph_string_x_to_index(XEN_TO_C_PangoGlyphString_(glyphs), XEN_TO_C_char_(text), XEN_TO_C_int(length), XEN_TO_C_PangoAnalysis_(analysis),
- XEN_TO_C_int(x_pos), &ref_index, &ref_trailing);
- return(XEN_LIST_2(C_TO_XEN_int(ref_index), C_TO_XEN_int(ref_trailing)));
+ #define H_gtk_toolbar_set_show_arrow "void gtk_toolbar_set_show_arrow(GtkToolbar* toolbar, gboolean show_arrow)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_set_show_arrow", "GtkToolbar*");
+ Xen_check_type(Xen_is_gboolean(show_arrow), show_arrow, 2, "gtk_toolbar_set_show_arrow", "gboolean");
+ gtk_toolbar_set_show_arrow(Xen_to_C_GtkToolbar_(toolbar), Xen_to_C_gboolean(show_arrow));
+ return(Xen_false);
}
-static XEN gxg_pango_shape(XEN text, XEN length, XEN analysis, XEN glyphs)
+static Xen gxg_gtk_toolbar_get_show_arrow(Xen toolbar)
{
- #define H_pango_shape "void pango_shape(gchar* text, gint length, PangoAnalysis* analysis, PangoGlyphString* glyphs)"
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 1, "pango_shape", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(length), length, 2, "pango_shape", "gint");
- XEN_ASSERT_TYPE(XEN_PangoAnalysis__P(analysis), analysis, 3, "pango_shape", "PangoAnalysis*");
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 4, "pango_shape", "PangoGlyphString*");
- pango_shape(XEN_TO_C_gchar_(text), XEN_TO_C_gint(length), XEN_TO_C_PangoAnalysis_(analysis), XEN_TO_C_PangoGlyphString_(glyphs));
- return(XEN_FALSE);
+ #define H_gtk_toolbar_get_show_arrow "gboolean gtk_toolbar_get_show_arrow(GtkToolbar* toolbar)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_get_show_arrow", "GtkToolbar*");
+ return(C_to_Xen_gboolean(gtk_toolbar_get_show_arrow(Xen_to_C_GtkToolbar_(toolbar))));
}
-static XEN gxg_pango_reorder_items(XEN logical_items)
+static Xen gxg_gtk_toolbar_get_relief_style(Xen toolbar)
{
- #define H_pango_reorder_items "GList* pango_reorder_items(GList* logical_items)"
- XEN_ASSERT_TYPE(XEN_GList__P(logical_items), logical_items, 1, "pango_reorder_items", "GList*");
- return(C_TO_XEN_GList_(pango_reorder_items(XEN_TO_C_GList_(logical_items))));
+ #define H_gtk_toolbar_get_relief_style "GtkReliefStyle gtk_toolbar_get_relief_style(GtkToolbar* toolbar)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_get_relief_style", "GtkToolbar*");
+ return(C_to_Xen_GtkReliefStyle(gtk_toolbar_get_relief_style(Xen_to_C_GtkToolbar_(toolbar))));
}
-static XEN gxg_pango_item_new(void)
+static Xen gxg_gtk_toolbar_get_drop_index(Xen toolbar, Xen x, Xen y)
{
- #define H_pango_item_new "PangoItem* pango_item_new( void)"
- return(C_TO_XEN_PangoItem_(pango_item_new()));
+ #define H_gtk_toolbar_get_drop_index "gint gtk_toolbar_get_drop_index(GtkToolbar* toolbar, gint x, \
+gint y)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_get_drop_index", "GtkToolbar*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_toolbar_get_drop_index", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_toolbar_get_drop_index", "gint");
+ return(C_to_Xen_gint(gtk_toolbar_get_drop_index(Xen_to_C_GtkToolbar_(toolbar), Xen_to_C_gint(x), Xen_to_C_gint(y))));
}
-static XEN gxg_pango_item_copy(XEN item)
+static Xen gxg_gtk_tree_view_column_set_expand(Xen tree_column, Xen expand)
{
- #define H_pango_item_copy "PangoItem* pango_item_copy(PangoItem* item)"
- XEN_ASSERT_TYPE(XEN_PangoItem__P(item), item, 1, "pango_item_copy", "PangoItem*");
- return(C_TO_XEN_PangoItem_(pango_item_copy(XEN_TO_C_PangoItem_(item))));
+ #define H_gtk_tree_view_column_set_expand "void gtk_tree_view_column_set_expand(GtkTreeViewColumn* tree_column, \
+gboolean expand)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_set_expand", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 2, "gtk_tree_view_column_set_expand", "gboolean");
+ gtk_tree_view_column_set_expand(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_gboolean(expand));
+ return(Xen_false);
}
-static XEN gxg_pango_item_free(XEN item)
+static Xen gxg_gtk_tree_view_column_get_expand(Xen tree_column)
{
- #define H_pango_item_free "void pango_item_free(PangoItem* item)"
- XEN_ASSERT_TYPE(XEN_PangoItem__P(item), item, 1, "pango_item_free", "PangoItem*");
- pango_item_free(XEN_TO_C_PangoItem_(item));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_column_get_expand "gboolean gtk_tree_view_column_get_expand(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_expand", "GtkTreeViewColumn*");
+ return(C_to_Xen_gboolean(gtk_tree_view_column_get_expand(Xen_to_C_GtkTreeViewColumn_(tree_column))));
}
-static XEN gxg_pango_item_split(XEN orig, XEN split_index, XEN split_offset)
+static Xen gxg_gtk_widget_set_no_show_all(Xen widget, Xen no_show_all)
{
- #define H_pango_item_split "PangoItem* pango_item_split(PangoItem* orig, int split_index, int split_offset)"
- XEN_ASSERT_TYPE(XEN_PangoItem__P(orig), orig, 1, "pango_item_split", "PangoItem*");
- XEN_ASSERT_TYPE(XEN_int_P(split_index), split_index, 2, "pango_item_split", "int");
- XEN_ASSERT_TYPE(XEN_int_P(split_offset), split_offset, 3, "pango_item_split", "int");
- return(C_TO_XEN_PangoItem_(pango_item_split(XEN_TO_C_PangoItem_(orig), XEN_TO_C_int(split_index), XEN_TO_C_int(split_offset))));
+ #define H_gtk_widget_set_no_show_all "void gtk_widget_set_no_show_all(GtkWidget* widget, gboolean no_show_all)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_no_show_all", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(no_show_all), no_show_all, 2, "gtk_widget_set_no_show_all", "gboolean");
+ gtk_widget_set_no_show_all(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(no_show_all));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_new(XEN context)
+static Xen gxg_gtk_widget_get_no_show_all(Xen widget)
{
- #define H_pango_layout_new "PangoLayout* pango_layout_new(PangoContext* context)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_layout_new", "PangoContext*");
- return(C_TO_XEN_PangoLayout_(pango_layout_new(XEN_TO_C_PangoContext_(context))));
+ #define H_gtk_widget_get_no_show_all "gboolean gtk_widget_get_no_show_all(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_no_show_all", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_no_show_all(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_pango_layout_copy(XEN src)
+static Xen gxg_gtk_widget_queue_resize_no_redraw(Xen widget)
{
- #define H_pango_layout_copy "PangoLayout* pango_layout_copy(PangoLayout* src)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(src), src, 1, "pango_layout_copy", "PangoLayout*");
- return(C_TO_XEN_PangoLayout_(pango_layout_copy(XEN_TO_C_PangoLayout_(src))));
+ #define H_gtk_widget_queue_resize_no_redraw "void gtk_widget_queue_resize_no_redraw(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_queue_resize_no_redraw", "GtkWidget*");
+ gtk_widget_queue_resize_no_redraw(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_context(XEN layout)
+static Xen gxg_gtk_window_set_default_icon(Xen icon)
{
- #define H_pango_layout_get_context "PangoContext* pango_layout_get_context(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_context", "PangoLayout*");
- return(C_TO_XEN_PangoContext_(pango_layout_get_context(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_window_set_default_icon "void gtk_window_set_default_icon(GdkPixbuf* icon)"
+ Xen_check_type(Xen_is_GdkPixbuf_(icon), icon, 1, "gtk_window_set_default_icon", "GdkPixbuf*");
+ gtk_window_set_default_icon(Xen_to_C_GdkPixbuf_(icon));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_set_attributes(XEN layout, XEN attrs)
+static Xen gxg_gtk_window_set_keep_above(Xen window, Xen setting)
{
- #define H_pango_layout_set_attributes "void pango_layout_set_attributes(PangoLayout* layout, PangoAttrList* attrs)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_attributes", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(attrs), attrs, 2, "pango_layout_set_attributes", "PangoAttrList*");
- pango_layout_set_attributes(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_PangoAttrList_(attrs));
- return(XEN_FALSE);
+ #define H_gtk_window_set_keep_above "void gtk_window_set_keep_above(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_keep_above", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_keep_above", "gboolean");
+ gtk_window_set_keep_above(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_attributes(XEN layout)
+static Xen gxg_gtk_window_set_keep_below(Xen window, Xen setting)
{
- #define H_pango_layout_get_attributes "PangoAttrList* pango_layout_get_attributes(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_attributes", "PangoLayout*");
- return(C_TO_XEN_PangoAttrList_(pango_layout_get_attributes(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_window_set_keep_below "void gtk_window_set_keep_below(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_keep_below", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_keep_below", "gboolean");
+ gtk_window_set_keep_below(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_set_text(XEN layout, XEN text, XEN length)
+static Xen gxg_gtk_file_chooser_dialog_new(Xen title, Xen parent, Xen action, Xen buttons)
{
- #define H_pango_layout_set_text "void pango_layout_set_text(PangoLayout* layout, char* text, int length)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_text", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_char__P(text), text, 2, "pango_layout_set_text", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 3, "pango_layout_set_text", "int");
- pango_layout_set_text(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_char_(text), XEN_TO_C_int(length));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_dialog_new "GtkWidget* gtk_file_chooser_dialog_new(gchar* title, GtkWindow* parent, \
+GtkFileChooserAction action, etc buttons)"
+ Xen_check_type(Xen_is_gchar_(title), title, 1, "gtk_file_chooser_dialog_new", "gchar*");
+ Xen_check_type(Xen_is_GtkWindow_(parent) || Xen_is_false(parent), parent, 2, "gtk_file_chooser_dialog_new", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkFileChooserAction(action), action, 3, "gtk_file_chooser_dialog_new", "GtkFileChooserAction");
+ if (!Xen_is_bound(buttons)) buttons = Xen_false;
+ else Xen_check_type(Xen_is_etc(buttons), buttons, 4, "gtk_file_chooser_dialog_new", "etc");
+ {
+ int etc_len = 0;
+ GtkWidget* result = NULL;
+ gchar* p_arg0;
+ GtkWindow* p_arg1;
+ GtkFileChooserAction p_arg2;
+ if (Xen_is_list(buttons)) etc_len = Xen_list_length(buttons);
+ if (etc_len > 10) Xen_out_of_range_error("gtk_file_chooser_dialog_new", 3, buttons, "... list too long (max len: 10)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_file_chooser_dialog_new", 3, buttons, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_gchar_(title);
+ p_arg1 = Xen_to_C_GtkWindow_(parent);
+ p_arg2 = Xen_to_C_GtkFileChooserAction(action);
+ switch (etc_len)
+ {
+ case 0: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, NULL, NULL); break;
+ case 2: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), NULL); break;
+ case 4: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), NULL); break;
+ case 6: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), NULL); break;
+ case 8: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), XLS(buttons, 6), XLI(buttons, 7), NULL); break;
+ case 10: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), XLS(buttons, 6), XLI(buttons, 7), XLS(buttons, 8), XLI(buttons, 9), NULL); break;
+ }
+ return(C_to_Xen_GtkWidget_(result));
+ }
}
-static XEN gxg_pango_layout_get_text(XEN layout)
+static Xen gxg_gtk_file_chooser_widget_new(Xen action)
{
- #define H_pango_layout_get_text "char* pango_layout_get_text(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_text", "PangoLayout*");
- return(C_TO_XEN_char_(pango_layout_get_text(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_file_chooser_widget_new "GtkWidget* gtk_file_chooser_widget_new(GtkFileChooserAction action)"
+ Xen_check_type(Xen_is_GtkFileChooserAction(action), action, 1, "gtk_file_chooser_widget_new", "GtkFileChooserAction");
+ return(C_to_Xen_GtkWidget_(gtk_file_chooser_widget_new(Xen_to_C_GtkFileChooserAction(action))));
}
-static XEN gxg_pango_layout_set_markup(XEN layout, XEN markup, XEN length)
+static Xen gxg_gtk_tree_model_filter_new(Xen child_model, Xen root)
{
- #define H_pango_layout_set_markup "void pango_layout_set_markup(PangoLayout* layout, char* markup, \
-int length)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_markup", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_char__P(markup), markup, 2, "pango_layout_set_markup", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 3, "pango_layout_set_markup", "int");
- pango_layout_set_markup(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_char_(markup), XEN_TO_C_int(length));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_filter_new "GtkTreeModel* gtk_tree_model_filter_new(GtkTreeModel* child_model, \
+GtkTreePath* root)"
+ Xen_check_type(Xen_is_GtkTreeModel_(child_model), child_model, 1, "gtk_tree_model_filter_new", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(root) || Xen_is_false(root), root, 2, "gtk_tree_model_filter_new", "GtkTreePath*");
+ return(C_to_Xen_GtkTreeModel_(gtk_tree_model_filter_new(Xen_to_C_GtkTreeModel_(child_model), Xen_to_C_GtkTreePath_(root))));
}
-static XEN gxg_pango_layout_set_markup_with_accel(XEN layout, XEN markup, XEN length, XEN accel_marker, XEN accel_char)
+static Xen gxg_gtk_tree_model_filter_set_visible_column(Xen filter, Xen column)
{
- #define H_pango_layout_set_markup_with_accel "void pango_layout_set_markup_with_accel(PangoLayout* layout, \
-char* markup, int length, gunichar accel_marker, gunichar* accel_char)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_markup_with_accel", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_char__P(markup), markup, 2, "pango_layout_set_markup_with_accel", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 3, "pango_layout_set_markup_with_accel", "int");
- XEN_ASSERT_TYPE(XEN_gunichar_P(accel_marker), accel_marker, 4, "pango_layout_set_markup_with_accel", "gunichar");
- XEN_ASSERT_TYPE(XEN_gunichar__P(accel_char), accel_char, 5, "pango_layout_set_markup_with_accel", "gunichar*");
- pango_layout_set_markup_with_accel(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_char_(markup), XEN_TO_C_int(length), XEN_TO_C_gunichar(accel_marker),
- XEN_TO_C_gunichar_(accel_char));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_filter_set_visible_column "void gtk_tree_model_filter_set_visible_column(GtkTreeModelFilter* filter, \
+gint column)"
+ Xen_check_type(Xen_is_GtkTreeModelFilter_(filter), filter, 1, "gtk_tree_model_filter_set_visible_column", "GtkTreeModelFilter*");
+ Xen_check_type(Xen_is_gint(column), column, 2, "gtk_tree_model_filter_set_visible_column", "gint");
+ gtk_tree_model_filter_set_visible_column(Xen_to_C_GtkTreeModelFilter_(filter), Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_set_font_description(XEN layout, XEN desc)
+static Xen gxg_gtk_tree_model_filter_get_model(Xen filter)
{
- #define H_pango_layout_set_font_description "void pango_layout_set_font_description(PangoLayout* layout, \
-PangoFontDescription* desc)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_font_description", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 2, "pango_layout_set_font_description", "PangoFontDescription*");
- pango_layout_set_font_description(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_PangoFontDescription_(desc));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_filter_get_model "GtkTreeModel* gtk_tree_model_filter_get_model(GtkTreeModelFilter* filter)"
+ Xen_check_type(Xen_is_GtkTreeModelFilter_(filter), filter, 1, "gtk_tree_model_filter_get_model", "GtkTreeModelFilter*");
+ return(C_to_Xen_GtkTreeModel_(gtk_tree_model_filter_get_model(Xen_to_C_GtkTreeModelFilter_(filter))));
}
-static XEN gxg_pango_layout_set_width(XEN layout, XEN width)
+static Xen gxg_gtk_tree_model_filter_convert_iter_to_child_iter(Xen filter, Xen child_iter, Xen filter_iter)
{
- #define H_pango_layout_set_width "void pango_layout_set_width(PangoLayout* layout, int width)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_width", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 2, "pango_layout_set_width", "int");
- pango_layout_set_width(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(width));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_filter_convert_iter_to_child_iter "void gtk_tree_model_filter_convert_iter_to_child_iter(GtkTreeModelFilter* filter, \
+GtkTreeIter* child_iter, GtkTreeIter* filter_iter)"
+ Xen_check_type(Xen_is_GtkTreeModelFilter_(filter), filter, 1, "gtk_tree_model_filter_convert_iter_to_child_iter", "GtkTreeModelFilter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(child_iter), child_iter, 2, "gtk_tree_model_filter_convert_iter_to_child_iter", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(filter_iter), filter_iter, 3, "gtk_tree_model_filter_convert_iter_to_child_iter", "GtkTreeIter*");
+ gtk_tree_model_filter_convert_iter_to_child_iter(Xen_to_C_GtkTreeModelFilter_(filter), Xen_to_C_GtkTreeIter_(child_iter),
+ Xen_to_C_GtkTreeIter_(filter_iter));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_width(XEN layout)
+static Xen gxg_gtk_tree_model_filter_convert_child_path_to_path(Xen filter, Xen child_path)
{
- #define H_pango_layout_get_width "int pango_layout_get_width(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_width", "PangoLayout*");
- return(C_TO_XEN_int(pango_layout_get_width(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_tree_model_filter_convert_child_path_to_path "GtkTreePath* gtk_tree_model_filter_convert_child_path_to_path(GtkTreeModelFilter* filter, \
+GtkTreePath* child_path)"
+ Xen_check_type(Xen_is_GtkTreeModelFilter_(filter), filter, 1, "gtk_tree_model_filter_convert_child_path_to_path", "GtkTreeModelFilter*");
+ Xen_check_type(Xen_is_GtkTreePath_(child_path), child_path, 2, "gtk_tree_model_filter_convert_child_path_to_path", "GtkTreePath*");
+ return(C_to_Xen_GtkTreePath_(gtk_tree_model_filter_convert_child_path_to_path(Xen_to_C_GtkTreeModelFilter_(filter), Xen_to_C_GtkTreePath_(child_path))));
}
-static XEN gxg_pango_layout_set_wrap(XEN layout, XEN wrap)
+static Xen gxg_gtk_tree_model_filter_convert_path_to_child_path(Xen path, Xen filter_path)
{
- #define H_pango_layout_set_wrap "void pango_layout_set_wrap(PangoLayout* layout, PangoWrapMode wrap)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_wrap", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_PangoWrapMode_P(wrap), wrap, 2, "pango_layout_set_wrap", "PangoWrapMode");
- pango_layout_set_wrap(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_PangoWrapMode(wrap));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_filter_convert_path_to_child_path "GtkTreePath* gtk_tree_model_filter_convert_path_to_child_path(GtkTreeModelFilter* path, \
+GtkTreePath* filter_path)"
+ Xen_check_type(Xen_is_GtkTreeModelFilter_(path), path, 1, "gtk_tree_model_filter_convert_path_to_child_path", "GtkTreeModelFilter*");
+ Xen_check_type(Xen_is_GtkTreePath_(filter_path), filter_path, 2, "gtk_tree_model_filter_convert_path_to_child_path", "GtkTreePath*");
+ return(C_to_Xen_GtkTreePath_(gtk_tree_model_filter_convert_path_to_child_path(Xen_to_C_GtkTreeModelFilter_(path), Xen_to_C_GtkTreePath_(filter_path))));
}
-static XEN gxg_pango_layout_get_wrap(XEN layout)
+static Xen gxg_gtk_tree_model_filter_refilter(Xen filter)
{
- #define H_pango_layout_get_wrap "PangoWrapMode pango_layout_get_wrap(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_wrap", "PangoLayout*");
- return(C_TO_XEN_PangoWrapMode(pango_layout_get_wrap(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_tree_model_filter_refilter "void gtk_tree_model_filter_refilter(GtkTreeModelFilter* filter)"
+ Xen_check_type(Xen_is_GtkTreeModelFilter_(filter), filter, 1, "gtk_tree_model_filter_refilter", "GtkTreeModelFilter*");
+ gtk_tree_model_filter_refilter(Xen_to_C_GtkTreeModelFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_set_indent(XEN layout, XEN indent)
+static Xen gxg_gtk_tree_model_filter_clear_cache(Xen filter)
{
- #define H_pango_layout_set_indent "void pango_layout_set_indent(PangoLayout* layout, int indent)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_indent", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(indent), indent, 2, "pango_layout_set_indent", "int");
- pango_layout_set_indent(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(indent));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_filter_clear_cache "void gtk_tree_model_filter_clear_cache(GtkTreeModelFilter* filter)"
+ Xen_check_type(Xen_is_GtkTreeModelFilter_(filter), filter, 1, "gtk_tree_model_filter_clear_cache", "GtkTreeModelFilter*");
+ gtk_tree_model_filter_clear_cache(Xen_to_C_GtkTreeModelFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_indent(XEN layout)
+static Xen gxg_gtk_combo_box_new(void)
{
- #define H_pango_layout_get_indent "int pango_layout_get_indent(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_indent", "PangoLayout*");
- return(C_TO_XEN_int(pango_layout_get_indent(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_combo_box_new "GtkWidget* gtk_combo_box_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_combo_box_new()));
}
-static XEN gxg_pango_layout_set_spacing(XEN layout, XEN spacing)
+static Xen gxg_gtk_combo_box_new_with_model(Xen model)
{
- #define H_pango_layout_set_spacing "void pango_layout_set_spacing(PangoLayout* layout, int spacing)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_spacing", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(spacing), spacing, 2, "pango_layout_set_spacing", "int");
- pango_layout_set_spacing(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(spacing));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_new_with_model "GtkWidget* gtk_combo_box_new_with_model(GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkTreeModel_(model), model, 1, "gtk_combo_box_new_with_model", "GtkTreeModel*");
+ return(C_to_Xen_GtkWidget_(gtk_combo_box_new_with_model(Xen_to_C_GtkTreeModel_(model))));
}
-static XEN gxg_pango_layout_get_spacing(XEN layout)
+static Xen gxg_gtk_combo_box_set_model(Xen combo_box, Xen model)
{
- #define H_pango_layout_get_spacing "int pango_layout_get_spacing(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_spacing", "PangoLayout*");
- return(C_TO_XEN_int(pango_layout_get_spacing(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_combo_box_set_model "void gtk_combo_box_set_model(GtkComboBox* combo_box, GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_model", "GtkComboBox*");
+ Xen_check_type(Xen_is_GtkTreeModel_(model) || Xen_is_false(model), model, 2, "gtk_combo_box_set_model", "GtkTreeModel*");
+ gtk_combo_box_set_model(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_GtkTreeModel_(model));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_set_justify(XEN layout, XEN justify)
+static Xen gxg_gtk_combo_box_set_wrap_width(Xen combo_box, Xen width)
{
- #define H_pango_layout_set_justify "void pango_layout_set_justify(PangoLayout* layout, gboolean justify)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_justify", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(justify), justify, 2, "pango_layout_set_justify", "gboolean");
- pango_layout_set_justify(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_gboolean(justify));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_set_wrap_width "void gtk_combo_box_set_wrap_width(GtkComboBox* combo_box, gint width)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_wrap_width", "GtkComboBox*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_combo_box_set_wrap_width", "gint");
+ gtk_combo_box_set_wrap_width(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_gint(width));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_justify(XEN layout)
+static Xen gxg_gtk_combo_box_set_row_span_column(Xen combo_box, Xen row_span)
{
- #define H_pango_layout_get_justify "gboolean pango_layout_get_justify(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_justify", "PangoLayout*");
- return(C_TO_XEN_gboolean(pango_layout_get_justify(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_combo_box_set_row_span_column "void gtk_combo_box_set_row_span_column(GtkComboBox* combo_box, \
+gint row_span)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_row_span_column", "GtkComboBox*");
+ Xen_check_type(Xen_is_gint(row_span), row_span, 2, "gtk_combo_box_set_row_span_column", "gint");
+ gtk_combo_box_set_row_span_column(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_gint(row_span));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_set_alignment(XEN layout, XEN alignment)
+static Xen gxg_gtk_combo_box_set_column_span_column(Xen combo_box, Xen column_span)
{
- #define H_pango_layout_set_alignment "void pango_layout_set_alignment(PangoLayout* layout, PangoAlignment alignment)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_alignment", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_PangoAlignment_P(alignment), alignment, 2, "pango_layout_set_alignment", "PangoAlignment");
- pango_layout_set_alignment(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_PangoAlignment(alignment));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_set_column_span_column "void gtk_combo_box_set_column_span_column(GtkComboBox* combo_box, \
+gint column_span)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_column_span_column", "GtkComboBox*");
+ Xen_check_type(Xen_is_gint(column_span), column_span, 2, "gtk_combo_box_set_column_span_column", "gint");
+ gtk_combo_box_set_column_span_column(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_gint(column_span));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_alignment(XEN layout)
+static Xen gxg_gtk_combo_box_get_active(Xen combo_box)
{
- #define H_pango_layout_get_alignment "PangoAlignment pango_layout_get_alignment(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_alignment", "PangoLayout*");
- return(C_TO_XEN_PangoAlignment(pango_layout_get_alignment(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_combo_box_get_active "gint gtk_combo_box_get_active(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_active", "GtkComboBox*");
+ return(C_to_Xen_gint(gtk_combo_box_get_active(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_pango_layout_set_tabs(XEN layout, XEN tabs)
+static Xen gxg_gtk_combo_box_set_active(Xen combo_box, Xen index)
{
- #define H_pango_layout_set_tabs "void pango_layout_set_tabs(PangoLayout* layout, PangoTabArray* tabs)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_tabs", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_PangoTabArray__P(tabs) || XEN_FALSE_P(tabs), tabs, 2, "pango_layout_set_tabs", "PangoTabArray*");
- pango_layout_set_tabs(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_PangoTabArray_(tabs));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_set_active "void gtk_combo_box_set_active(GtkComboBox* combo_box, gint index)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_active", "GtkComboBox*");
+ Xen_check_type(Xen_is_gint(index), index, 2, "gtk_combo_box_set_active", "gint");
+ gtk_combo_box_set_active(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_gint(index));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_tabs(XEN layout)
+static Xen gxg_gtk_combo_box_get_active_iter(Xen combo_box, Xen iter)
{
- #define H_pango_layout_get_tabs "PangoTabArray* pango_layout_get_tabs(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_tabs", "PangoLayout*");
- return(C_TO_XEN_PangoTabArray_(pango_layout_get_tabs(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_combo_box_get_active_iter "gboolean gtk_combo_box_get_active_iter(GtkComboBox* combo_box, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_active_iter", "GtkComboBox*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_combo_box_get_active_iter", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_combo_box_get_active_iter(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_pango_layout_set_single_paragraph_mode(XEN layout, XEN setting)
+static Xen gxg_gtk_combo_box_set_active_iter(Xen combo_box, Xen iter)
{
- #define H_pango_layout_set_single_paragraph_mode "void pango_layout_set_single_paragraph_mode(PangoLayout* layout, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_single_paragraph_mode", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "pango_layout_set_single_paragraph_mode", "gboolean");
- pango_layout_set_single_paragraph_mode(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_set_active_iter "void gtk_combo_box_set_active_iter(GtkComboBox* combo_box, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_active_iter", "GtkComboBox*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_combo_box_set_active_iter", "GtkTreeIter*");
+ gtk_combo_box_set_active_iter(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_GtkTreeIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_single_paragraph_mode(XEN layout)
+static Xen gxg_gtk_combo_box_get_model(Xen combo_box)
{
- #define H_pango_layout_get_single_paragraph_mode "gboolean pango_layout_get_single_paragraph_mode(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_single_paragraph_mode", "PangoLayout*");
- return(C_TO_XEN_gboolean(pango_layout_get_single_paragraph_mode(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_combo_box_get_model "GtkTreeModel* gtk_combo_box_get_model(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_model", "GtkComboBox*");
+ return(C_to_Xen_GtkTreeModel_(gtk_combo_box_get_model(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_pango_layout_context_changed(XEN layout)
+static Xen gxg_gtk_expander_new(Xen label)
{
- #define H_pango_layout_context_changed "void pango_layout_context_changed(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_context_changed", "PangoLayout*");
- pango_layout_context_changed(XEN_TO_C_PangoLayout_(layout));
- return(XEN_FALSE);
+ #define H_gtk_expander_new "GtkWidget* gtk_expander_new(gchar* label)"
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_expander_new", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_expander_new(Xen_to_C_gchar_(label))));
}
-static XEN gxg_pango_layout_get_log_attrs(XEN layout, XEN ignore_attrs, XEN ignore_n_attrs)
+static Xen gxg_gtk_expander_new_with_mnemonic(Xen label)
{
- #define H_pango_layout_get_log_attrs "void pango_layout_get_log_attrs(PangoLayout* layout, PangoLogAttr** [attrs], \
-gint* [n_attrs])"
- PangoLogAttr* ref_attrs = NULL;
- gint ref_n_attrs;
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_log_attrs", "PangoLayout*");
- pango_layout_get_log_attrs(XEN_TO_C_PangoLayout_(layout), &ref_attrs, &ref_n_attrs);
- return(XEN_LIST_2(C_TO_XEN_PangoLogAttr_(ref_attrs), C_TO_XEN_gint(ref_n_attrs)));
+ #define H_gtk_expander_new_with_mnemonic "GtkWidget* gtk_expander_new_with_mnemonic(gchar* label)"
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_expander_new_with_mnemonic", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_expander_new_with_mnemonic(Xen_to_C_gchar_(label))));
}
-static XEN gxg_pango_layout_index_to_pos(XEN layout, XEN index, XEN pos)
+static Xen gxg_gtk_expander_set_expanded(Xen expander, Xen expanded)
{
- #define H_pango_layout_index_to_pos "void pango_layout_index_to_pos(PangoLayout* layout, int index, \
-PangoRectangle* pos)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_index_to_pos", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(index), index, 2, "pango_layout_index_to_pos", "int");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(pos), pos, 3, "pango_layout_index_to_pos", "PangoRectangle*");
- pango_layout_index_to_pos(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(index), XEN_TO_C_PangoRectangle_(pos));
- return(XEN_FALSE);
+ #define H_gtk_expander_set_expanded "void gtk_expander_set_expanded(GtkExpander* expander, gboolean expanded)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_set_expanded", "GtkExpander*");
+ Xen_check_type(Xen_is_gboolean(expanded), expanded, 2, "gtk_expander_set_expanded", "gboolean");
+ gtk_expander_set_expanded(Xen_to_C_GtkExpander_(expander), Xen_to_C_gboolean(expanded));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_cursor_pos(XEN layout, XEN index, XEN strong_pos, XEN weak_pos)
+static Xen gxg_gtk_expander_get_expanded(Xen expander)
{
- #define H_pango_layout_get_cursor_pos "void pango_layout_get_cursor_pos(PangoLayout* layout, int index, \
-PangoRectangle* strong_pos, PangoRectangle* weak_pos)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_cursor_pos", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(index), index, 2, "pango_layout_get_cursor_pos", "int");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(strong_pos), strong_pos, 3, "pango_layout_get_cursor_pos", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(weak_pos), weak_pos, 4, "pango_layout_get_cursor_pos", "PangoRectangle*");
- pango_layout_get_cursor_pos(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(index), XEN_TO_C_PangoRectangle_(strong_pos), XEN_TO_C_PangoRectangle_(weak_pos));
- return(XEN_FALSE);
+ #define H_gtk_expander_get_expanded "gboolean gtk_expander_get_expanded(GtkExpander* expander)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_get_expanded", "GtkExpander*");
+ return(C_to_Xen_gboolean(gtk_expander_get_expanded(Xen_to_C_GtkExpander_(expander))));
}
-static XEN gxg_pango_layout_move_cursor_visually(XEN layout, XEN strong, XEN old_index, XEN old_trailing, XEN direction, XEN new_index, XEN new_trailing)
+static Xen gxg_gtk_expander_set_spacing(Xen expander, Xen spacing)
{
- #define H_pango_layout_move_cursor_visually "void pango_layout_move_cursor_visually(PangoLayout* layout, \
-gboolean strong, int old_index, int old_trailing, int direction, int* new_index, int* new_trailing)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_move_cursor_visually", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(strong), strong, 2, "pango_layout_move_cursor_visually", "gboolean");
- XEN_ASSERT_TYPE(XEN_int_P(old_index), old_index, 3, "pango_layout_move_cursor_visually", "int");
- XEN_ASSERT_TYPE(XEN_int_P(old_trailing), old_trailing, 4, "pango_layout_move_cursor_visually", "int");
- XEN_ASSERT_TYPE(XEN_int_P(direction), direction, 5, "pango_layout_move_cursor_visually", "int");
- XEN_ASSERT_TYPE(XEN_int__P(new_index), new_index, 6, "pango_layout_move_cursor_visually", "int*");
- XEN_ASSERT_TYPE(XEN_int__P(new_trailing), new_trailing, 7, "pango_layout_move_cursor_visually", "int*");
- pango_layout_move_cursor_visually(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_gboolean(strong), XEN_TO_C_int(old_index), XEN_TO_C_int(old_trailing),
- XEN_TO_C_int(direction), XEN_TO_C_int_(new_index), XEN_TO_C_int_(new_trailing));
- return(XEN_FALSE);
+ #define H_gtk_expander_set_spacing "void gtk_expander_set_spacing(GtkExpander* expander, gint spacing)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_set_spacing", "GtkExpander*");
+ Xen_check_type(Xen_is_gint(spacing), spacing, 2, "gtk_expander_set_spacing", "gint");
+ gtk_expander_set_spacing(Xen_to_C_GtkExpander_(expander), Xen_to_C_gint(spacing));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_xy_to_index(XEN layout, XEN x, XEN y, XEN ignore_index, XEN ignore_trailing)
+static Xen gxg_gtk_expander_get_spacing(Xen expander)
{
- #define H_pango_layout_xy_to_index "gboolean pango_layout_xy_to_index(PangoLayout* layout, int x, int y, \
-int* [index], int* [trailing])"
- int ref_index;
- int ref_trailing;
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_xy_to_index", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 2, "pango_layout_xy_to_index", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 3, "pango_layout_xy_to_index", "int");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(pango_layout_xy_to_index(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(x), XEN_TO_C_int(y),
- &ref_index, &ref_trailing));
- return(XEN_LIST_3(result, C_TO_XEN_int(ref_index), C_TO_XEN_int(ref_trailing)));
- }
+ #define H_gtk_expander_get_spacing "gint gtk_expander_get_spacing(GtkExpander* expander)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_get_spacing", "GtkExpander*");
+ return(C_to_Xen_gint(gtk_expander_get_spacing(Xen_to_C_GtkExpander_(expander))));
}
-static XEN gxg_pango_layout_get_extents(XEN layout, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_expander_set_label(Xen expander, Xen label)
{
- #define H_pango_layout_get_extents "void pango_layout_get_extents(PangoLayout* layout, PangoRectangle* ink_rect, \
-PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_extents", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 2, "pango_layout_get_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 3, "pango_layout_get_extents", "PangoRectangle*");
- pango_layout_get_extents(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_expander_set_label "void gtk_expander_set_label(GtkExpander* expander, gchar* label)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_set_label", "GtkExpander*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_expander_set_label", "gchar*");
+ gtk_expander_set_label(Xen_to_C_GtkExpander_(expander), Xen_to_C_gchar_(label));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_pixel_extents(XEN layout, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_expander_get_label(Xen expander)
{
- #define H_pango_layout_get_pixel_extents "void pango_layout_get_pixel_extents(PangoLayout* layout, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_pixel_extents", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 2, "pango_layout_get_pixel_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 3, "pango_layout_get_pixel_extents", "PangoRectangle*");
- pango_layout_get_pixel_extents(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_expander_get_label "gchar* gtk_expander_get_label(GtkExpander* expander)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_get_label", "GtkExpander*");
+ return(C_to_Xen_gchar_(gtk_expander_get_label(Xen_to_C_GtkExpander_(expander))));
}
-static XEN gxg_pango_layout_get_size(XEN layout, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_expander_set_use_underline(Xen expander, Xen use_underline)
{
- #define H_pango_layout_get_size "void pango_layout_get_size(PangoLayout* layout, int* [width], int* [height])"
- int ref_width;
- int ref_height;
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_size", "PangoLayout*");
- pango_layout_get_size(XEN_TO_C_PangoLayout_(layout), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_int(ref_width), C_TO_XEN_int(ref_height)));
+ #define H_gtk_expander_set_use_underline "void gtk_expander_set_use_underline(GtkExpander* expander, \
+gboolean use_underline)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_set_use_underline", "GtkExpander*");
+ Xen_check_type(Xen_is_gboolean(use_underline), use_underline, 2, "gtk_expander_set_use_underline", "gboolean");
+ gtk_expander_set_use_underline(Xen_to_C_GtkExpander_(expander), Xen_to_C_gboolean(use_underline));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_pixel_size(XEN layout, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_expander_get_use_underline(Xen expander)
{
- #define H_pango_layout_get_pixel_size "void pango_layout_get_pixel_size(PangoLayout* layout, int* [width], \
-int* [height])"
- int ref_width;
- int ref_height;
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_pixel_size", "PangoLayout*");
- pango_layout_get_pixel_size(XEN_TO_C_PangoLayout_(layout), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_int(ref_width), C_TO_XEN_int(ref_height)));
+ #define H_gtk_expander_get_use_underline "gboolean gtk_expander_get_use_underline(GtkExpander* expander)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_get_use_underline", "GtkExpander*");
+ return(C_to_Xen_gboolean(gtk_expander_get_use_underline(Xen_to_C_GtkExpander_(expander))));
}
-static XEN gxg_pango_layout_get_line_count(XEN layout)
+static Xen gxg_gtk_expander_set_label_widget(Xen expander, Xen label_widget)
{
- #define H_pango_layout_get_line_count "int pango_layout_get_line_count(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_line_count", "PangoLayout*");
- return(C_TO_XEN_int(pango_layout_get_line_count(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_expander_set_label_widget "void gtk_expander_set_label_widget(GtkExpander* expander, \
+GtkWidget* label_widget)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_set_label_widget", "GtkExpander*");
+ Xen_check_type(Xen_is_GtkWidget_(label_widget), label_widget, 2, "gtk_expander_set_label_widget", "GtkWidget*");
+ gtk_expander_set_label_widget(Xen_to_C_GtkExpander_(expander), Xen_to_C_GtkWidget_(label_widget));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_get_line(XEN layout, XEN line)
+static Xen gxg_gtk_expander_get_label_widget(Xen expander)
{
- #define H_pango_layout_get_line "PangoLayoutLine* pango_layout_get_line(PangoLayout* layout, int line)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_line", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(line), line, 2, "pango_layout_get_line", "int");
- return(C_TO_XEN_PangoLayoutLine_(pango_layout_get_line(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(line))));
+ #define H_gtk_expander_get_label_widget "GtkWidget* gtk_expander_get_label_widget(GtkExpander* expander)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_get_label_widget", "GtkExpander*");
+ return(C_to_Xen_GtkWidget_(gtk_expander_get_label_widget(Xen_to_C_GtkExpander_(expander))));
}
-static XEN gxg_pango_layout_get_lines(XEN layout)
+static Xen gxg_gtk_expander_set_use_markup(Xen expander, Xen use_markup)
{
- #define H_pango_layout_get_lines "GSList* pango_layout_get_lines(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_lines", "PangoLayout*");
- return(C_TO_XEN_GSList_(pango_layout_get_lines(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_expander_set_use_markup "void gtk_expander_set_use_markup(GtkExpander* expander, gboolean use_markup)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_set_use_markup", "GtkExpander*");
+ Xen_check_type(Xen_is_gboolean(use_markup), use_markup, 2, "gtk_expander_set_use_markup", "gboolean");
+ gtk_expander_set_use_markup(Xen_to_C_GtkExpander_(expander), Xen_to_C_gboolean(use_markup));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_line_unref(XEN line)
+static Xen gxg_gtk_expander_get_use_markup(Xen expander)
{
- #define H_pango_layout_line_unref "void pango_layout_line_unref(PangoLayoutLine* line)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 1, "pango_layout_line_unref", "PangoLayoutLine*");
- pango_layout_line_unref(XEN_TO_C_PangoLayoutLine_(line));
- return(XEN_FALSE);
+ #define H_gtk_expander_get_use_markup "gboolean gtk_expander_get_use_markup(GtkExpander* expander)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_get_use_markup", "GtkExpander*");
+ return(C_to_Xen_gboolean(gtk_expander_get_use_markup(Xen_to_C_GtkExpander_(expander))));
}
-static XEN gxg_pango_layout_line_x_to_index(XEN line, XEN x_pos, XEN ignore_index, XEN ignore_trailing)
+static Xen gxg_gtk_font_button_new(void)
{
- #define H_pango_layout_line_x_to_index "gboolean pango_layout_line_x_to_index(PangoLayoutLine* line, \
-int x_pos, int* [index], int* [trailing])"
- int ref_index;
- int ref_trailing;
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 1, "pango_layout_line_x_to_index", "PangoLayoutLine*");
- XEN_ASSERT_TYPE(XEN_int_P(x_pos), x_pos, 2, "pango_layout_line_x_to_index", "int");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(pango_layout_line_x_to_index(XEN_TO_C_PangoLayoutLine_(line), XEN_TO_C_int(x_pos), &ref_index,
- &ref_trailing));
- return(XEN_LIST_3(result, C_TO_XEN_int(ref_index), C_TO_XEN_int(ref_trailing)));
- }
+ #define H_gtk_font_button_new "GtkWidget* gtk_font_button_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_font_button_new()));
}
-static XEN gxg_pango_layout_line_index_to_x(XEN line, XEN index, XEN trailing, XEN ignore_x_pos)
+static Xen gxg_gtk_font_button_new_with_font(Xen fontname)
{
- #define H_pango_layout_line_index_to_x "void pango_layout_line_index_to_x(PangoLayoutLine* line, int index, \
-gboolean trailing, int* [x_pos])"
- int ref_x_pos;
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 1, "pango_layout_line_index_to_x", "PangoLayoutLine*");
- XEN_ASSERT_TYPE(XEN_int_P(index), index, 2, "pango_layout_line_index_to_x", "int");
- XEN_ASSERT_TYPE(XEN_gboolean_P(trailing), trailing, 3, "pango_layout_line_index_to_x", "gboolean");
- pango_layout_line_index_to_x(XEN_TO_C_PangoLayoutLine_(line), XEN_TO_C_int(index), XEN_TO_C_gboolean(trailing), &ref_x_pos);
- return(XEN_LIST_1(C_TO_XEN_int(ref_x_pos)));
+ #define H_gtk_font_button_new_with_font "GtkWidget* gtk_font_button_new_with_font(gchar* fontname)"
+ Xen_check_type(Xen_is_gchar_(fontname), fontname, 1, "gtk_font_button_new_with_font", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_font_button_new_with_font(Xen_to_C_gchar_(fontname))));
}
-static XEN gxg_pango_layout_line_get_x_ranges(XEN line, XEN start_index, XEN end_index, XEN ignore_ranges, XEN ignore_n_ranges)
+static Xen gxg_gtk_font_button_get_title(Xen font_button)
{
- #define H_pango_layout_line_get_x_ranges "void pango_layout_line_get_x_ranges(PangoLayoutLine* line, \
-int start_index, int end_index, int** [ranges], int* [n_ranges])"
- int* ref_ranges = NULL;
- int ref_n_ranges;
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 1, "pango_layout_line_get_x_ranges", "PangoLayoutLine*");
- XEN_ASSERT_TYPE(XEN_int_P(start_index), start_index, 2, "pango_layout_line_get_x_ranges", "int");
- XEN_ASSERT_TYPE(XEN_int_P(end_index), end_index, 3, "pango_layout_line_get_x_ranges", "int");
- pango_layout_line_get_x_ranges(XEN_TO_C_PangoLayoutLine_(line), XEN_TO_C_int(start_index), XEN_TO_C_int(end_index), &ref_ranges,
- &ref_n_ranges);
- return(XEN_LIST_2(C_TO_XEN_int_(ref_ranges), C_TO_XEN_int(ref_n_ranges)));
+ #define H_gtk_font_button_get_title "gchar* gtk_font_button_get_title(GtkFontButton* font_button)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_get_title", "GtkFontButton*");
+ return(C_to_Xen_gchar_(gtk_font_button_get_title(Xen_to_C_GtkFontButton_(font_button))));
}
-static XEN gxg_pango_layout_line_get_extents(XEN line, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_font_button_set_title(Xen font_button, Xen title)
{
- #define H_pango_layout_line_get_extents "void pango_layout_line_get_extents(PangoLayoutLine* line, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 1, "pango_layout_line_get_extents", "PangoLayoutLine*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 2, "pango_layout_line_get_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 3, "pango_layout_line_get_extents", "PangoRectangle*");
- pango_layout_line_get_extents(XEN_TO_C_PangoLayoutLine_(line), XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_font_button_set_title "void gtk_font_button_set_title(GtkFontButton* font_button, gchar* title)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_set_title", "GtkFontButton*");
+ Xen_check_type(Xen_is_gchar_(title), title, 2, "gtk_font_button_set_title", "gchar*");
+ gtk_font_button_set_title(Xen_to_C_GtkFontButton_(font_button), Xen_to_C_gchar_(title));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_line_get_pixel_extents(XEN layout_line, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_font_button_get_use_font(Xen font_button)
{
- #define H_pango_layout_line_get_pixel_extents "void pango_layout_line_get_pixel_extents(PangoLayoutLine* layout_line, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(layout_line), layout_line, 1, "pango_layout_line_get_pixel_extents", "PangoLayoutLine*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 2, "pango_layout_line_get_pixel_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 3, "pango_layout_line_get_pixel_extents", "PangoRectangle*");
- pango_layout_line_get_pixel_extents(XEN_TO_C_PangoLayoutLine_(layout_line), XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_font_button_get_use_font "gboolean gtk_font_button_get_use_font(GtkFontButton* font_button)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_get_use_font", "GtkFontButton*");
+ return(C_to_Xen_gboolean(gtk_font_button_get_use_font(Xen_to_C_GtkFontButton_(font_button))));
}
-static XEN gxg_pango_layout_get_iter(XEN layout)
+static Xen gxg_gtk_font_button_set_use_font(Xen font_button, Xen use_font)
{
- #define H_pango_layout_get_iter "PangoLayoutIter* pango_layout_get_iter(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_iter", "PangoLayout*");
- return(C_TO_XEN_PangoLayoutIter_(pango_layout_get_iter(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_font_button_set_use_font "void gtk_font_button_set_use_font(GtkFontButton* font_button, \
+gboolean use_font)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_set_use_font", "GtkFontButton*");
+ Xen_check_type(Xen_is_gboolean(use_font), use_font, 2, "gtk_font_button_set_use_font", "gboolean");
+ gtk_font_button_set_use_font(Xen_to_C_GtkFontButton_(font_button), Xen_to_C_gboolean(use_font));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_iter_free(XEN iter)
+static Xen gxg_gtk_font_button_get_use_size(Xen font_button)
{
- #define H_pango_layout_iter_free "void pango_layout_iter_free(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_free", "PangoLayoutIter*");
- pango_layout_iter_free(XEN_TO_C_PangoLayoutIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_font_button_get_use_size "gboolean gtk_font_button_get_use_size(GtkFontButton* font_button)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_get_use_size", "GtkFontButton*");
+ return(C_to_Xen_gboolean(gtk_font_button_get_use_size(Xen_to_C_GtkFontButton_(font_button))));
}
-static XEN gxg_pango_layout_iter_get_index(XEN iter)
+static Xen gxg_gtk_font_button_set_use_size(Xen font_button, Xen use_size)
{
- #define H_pango_layout_iter_get_index "int pango_layout_iter_get_index(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_index", "PangoLayoutIter*");
- return(C_TO_XEN_int(pango_layout_iter_get_index(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_font_button_set_use_size "void gtk_font_button_set_use_size(GtkFontButton* font_button, \
+gboolean use_size)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_set_use_size", "GtkFontButton*");
+ Xen_check_type(Xen_is_gboolean(use_size), use_size, 2, "gtk_font_button_set_use_size", "gboolean");
+ gtk_font_button_set_use_size(Xen_to_C_GtkFontButton_(font_button), Xen_to_C_gboolean(use_size));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_iter_get_run(XEN iter)
+static Xen gxg_gtk_font_button_get_font_name(Xen font_button)
{
- #define H_pango_layout_iter_get_run "PangoLayoutRun* pango_layout_iter_get_run(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_run", "PangoLayoutIter*");
- return(C_TO_XEN_PangoLayoutRun_(pango_layout_iter_get_run(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_font_button_get_font_name "gchar* gtk_font_button_get_font_name(GtkFontButton* font_button)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_get_font_name", "GtkFontButton*");
+ return(C_to_Xen_gchar_(gtk_font_button_get_font_name(Xen_to_C_GtkFontButton_(font_button))));
}
-static XEN gxg_pango_layout_iter_get_line(XEN iter)
+static Xen gxg_gtk_font_button_set_font_name(Xen font_button, Xen fontname)
{
- #define H_pango_layout_iter_get_line "PangoLayoutLine* pango_layout_iter_get_line(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_line", "PangoLayoutIter*");
- return(C_TO_XEN_PangoLayoutLine_(pango_layout_iter_get_line(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_font_button_set_font_name "gboolean gtk_font_button_set_font_name(GtkFontButton* font_button, \
+gchar* fontname)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_set_font_name", "GtkFontButton*");
+ Xen_check_type(Xen_is_gchar_(fontname), fontname, 2, "gtk_font_button_set_font_name", "gchar*");
+ return(C_to_Xen_gboolean(gtk_font_button_set_font_name(Xen_to_C_GtkFontButton_(font_button), Xen_to_C_gchar_(fontname))));
}
-static XEN gxg_pango_layout_iter_at_last_line(XEN iter)
+static Xen gxg_gtk_font_button_get_show_style(Xen font_button)
{
- #define H_pango_layout_iter_at_last_line "gboolean pango_layout_iter_at_last_line(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_at_last_line", "PangoLayoutIter*");
- return(C_TO_XEN_gboolean(pango_layout_iter_at_last_line(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_font_button_get_show_style "gboolean gtk_font_button_get_show_style(GtkFontButton* font_button)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_get_show_style", "GtkFontButton*");
+ return(C_to_Xen_gboolean(gtk_font_button_get_show_style(Xen_to_C_GtkFontButton_(font_button))));
}
-static XEN gxg_pango_layout_iter_next_char(XEN iter)
+static Xen gxg_gtk_font_button_set_show_style(Xen font_button, Xen show_style)
{
- #define H_pango_layout_iter_next_char "gboolean pango_layout_iter_next_char(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_next_char", "PangoLayoutIter*");
- return(C_TO_XEN_gboolean(pango_layout_iter_next_char(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_font_button_set_show_style "void gtk_font_button_set_show_style(GtkFontButton* font_button, \
+gboolean show_style)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_set_show_style", "GtkFontButton*");
+ Xen_check_type(Xen_is_gboolean(show_style), show_style, 2, "gtk_font_button_set_show_style", "gboolean");
+ gtk_font_button_set_show_style(Xen_to_C_GtkFontButton_(font_button), Xen_to_C_gboolean(show_style));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_iter_next_cluster(XEN iter)
+static Xen gxg_gtk_font_button_get_show_size(Xen font_button)
{
- #define H_pango_layout_iter_next_cluster "gboolean pango_layout_iter_next_cluster(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_next_cluster", "PangoLayoutIter*");
- return(C_TO_XEN_gboolean(pango_layout_iter_next_cluster(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_font_button_get_show_size "gboolean gtk_font_button_get_show_size(GtkFontButton* font_button)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_get_show_size", "GtkFontButton*");
+ return(C_to_Xen_gboolean(gtk_font_button_get_show_size(Xen_to_C_GtkFontButton_(font_button))));
}
-static XEN gxg_pango_layout_iter_next_run(XEN iter)
+static Xen gxg_gtk_font_button_set_show_size(Xen font_button, Xen show_size)
{
- #define H_pango_layout_iter_next_run "gboolean pango_layout_iter_next_run(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_next_run", "PangoLayoutIter*");
- return(C_TO_XEN_gboolean(pango_layout_iter_next_run(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_font_button_set_show_size "void gtk_font_button_set_show_size(GtkFontButton* font_button, \
+gboolean show_size)"
+ Xen_check_type(Xen_is_GtkFontButton_(font_button), font_button, 1, "gtk_font_button_set_show_size", "GtkFontButton*");
+ Xen_check_type(Xen_is_gboolean(show_size), show_size, 2, "gtk_font_button_set_show_size", "gboolean");
+ gtk_font_button_set_show_size(Xen_to_C_GtkFontButton_(font_button), Xen_to_C_gboolean(show_size));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_iter_next_line(XEN iter)
+static Xen gxg_gtk_entry_completion_new(void)
{
- #define H_pango_layout_iter_next_line "gboolean pango_layout_iter_next_line(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_next_line", "PangoLayoutIter*");
- return(C_TO_XEN_gboolean(pango_layout_iter_next_line(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_entry_completion_new "GtkEntryCompletion* gtk_entry_completion_new( void)"
+ return(C_to_Xen_GtkEntryCompletion_(gtk_entry_completion_new()));
}
-static XEN gxg_pango_layout_iter_get_char_extents(XEN iter, XEN logical_rect)
+static Xen gxg_gtk_entry_completion_get_entry(Xen entry)
{
- #define H_pango_layout_iter_get_char_extents "void pango_layout_iter_get_char_extents(PangoLayoutIter* iter, \
-PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_char_extents", "PangoLayoutIter*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 2, "pango_layout_iter_get_char_extents", "PangoRectangle*");
- pango_layout_iter_get_char_extents(XEN_TO_C_PangoLayoutIter_(iter), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_entry_completion_get_entry "GtkWidget* gtk_entry_completion_get_entry(GtkEntryCompletion* entry)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(entry), entry, 1, "gtk_entry_completion_get_entry", "GtkEntryCompletion*");
+ return(C_to_Xen_GtkWidget_(gtk_entry_completion_get_entry(Xen_to_C_GtkEntryCompletion_(entry))));
}
-static XEN gxg_pango_layout_iter_get_cluster_extents(XEN iter, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_entry_completion_set_model(Xen completion, Xen model)
{
- #define H_pango_layout_iter_get_cluster_extents "void pango_layout_iter_get_cluster_extents(PangoLayoutIter* iter, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_cluster_extents", "PangoLayoutIter*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 2, "pango_layout_iter_get_cluster_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 3, "pango_layout_iter_get_cluster_extents", "PangoRectangle*");
- pango_layout_iter_get_cluster_extents(XEN_TO_C_PangoLayoutIter_(iter), XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_entry_completion_set_model "void gtk_entry_completion_set_model(GtkEntryCompletion* completion, \
+GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_model", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_GtkTreeModel_(model) || Xen_is_false(model), model, 2, "gtk_entry_completion_set_model", "GtkTreeModel*");
+ gtk_entry_completion_set_model(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_GtkTreeModel_(model));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_iter_get_run_extents(XEN iter, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_entry_completion_get_model(Xen completion)
{
- #define H_pango_layout_iter_get_run_extents "void pango_layout_iter_get_run_extents(PangoLayoutIter* iter, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_run_extents", "PangoLayoutIter*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 2, "pango_layout_iter_get_run_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 3, "pango_layout_iter_get_run_extents", "PangoRectangle*");
- pango_layout_iter_get_run_extents(XEN_TO_C_PangoLayoutIter_(iter), XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_entry_completion_get_model "GtkTreeModel* gtk_entry_completion_get_model(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_model", "GtkEntryCompletion*");
+ return(C_to_Xen_GtkTreeModel_(gtk_entry_completion_get_model(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_pango_layout_iter_get_line_extents(XEN iter, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_entry_completion_set_match_func(Xen completion, Xen func, Xen func_info, Xen func_notify)
{
- #define H_pango_layout_iter_get_line_extents "void pango_layout_iter_get_line_extents(PangoLayoutIter* iter, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_line_extents", "PangoLayoutIter*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 2, "pango_layout_iter_get_line_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 3, "pango_layout_iter_get_line_extents", "PangoRectangle*");
- pango_layout_iter_get_line_extents(XEN_TO_C_PangoLayoutIter_(iter), XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_entry_completion_set_match_func "void gtk_entry_completion_set_match_func(GtkEntryCompletion* completion, \
+GtkEntryCompletionMatchFunc func, lambda_data func_info, GtkDestroyNotify func_notify)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_match_func", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_GtkEntryCompletionMatchFunc(func), func, 2, "gtk_entry_completion_set_match_func", "GtkEntryCompletionMatchFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_entry_completion_set_match_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(func_notify), func_notify, 4, "gtk_entry_completion_set_match_func", "GtkDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, func_notify);
+ gtk_entry_completion_set_match_func(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_GtkEntryCompletionMatchFunc(func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GtkDestroyNotify(func_notify));
+ return(Xen_false);
+ }
}
-static XEN gxg_pango_layout_iter_get_line_yrange(XEN iter, XEN ignore_y0, XEN ignore_y1)
+static Xen gxg_gtk_entry_completion_set_minimum_key_length(Xen completion, Xen length)
{
- #define H_pango_layout_iter_get_line_yrange "void pango_layout_iter_get_line_yrange(PangoLayoutIter* iter, \
-int* [y0], int* [y1])"
- int ref_y0;
- int ref_y1;
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_line_yrange", "PangoLayoutIter*");
- pango_layout_iter_get_line_yrange(XEN_TO_C_PangoLayoutIter_(iter), &ref_y0, &ref_y1);
- return(XEN_LIST_2(C_TO_XEN_int(ref_y0), C_TO_XEN_int(ref_y1)));
+ #define H_gtk_entry_completion_set_minimum_key_length "void gtk_entry_completion_set_minimum_key_length(GtkEntryCompletion* completion, \
+gint length)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_minimum_key_length", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gint(length), length, 2, "gtk_entry_completion_set_minimum_key_length", "gint");
+ gtk_entry_completion_set_minimum_key_length(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gint(length));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_iter_get_layout_extents(XEN iter, XEN ink_rect, XEN logical_rect)
+static Xen gxg_gtk_entry_completion_get_minimum_key_length(Xen completion)
{
- #define H_pango_layout_iter_get_layout_extents "void pango_layout_iter_get_layout_extents(PangoLayoutIter* iter, \
-PangoRectangle* ink_rect, PangoRectangle* logical_rect)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_layout_extents", "PangoLayoutIter*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(ink_rect), ink_rect, 2, "pango_layout_iter_get_layout_extents", "PangoRectangle*");
- XEN_ASSERT_TYPE(XEN_PangoRectangle__P(logical_rect), logical_rect, 3, "pango_layout_iter_get_layout_extents", "PangoRectangle*");
- pango_layout_iter_get_layout_extents(XEN_TO_C_PangoLayoutIter_(iter), XEN_TO_C_PangoRectangle_(ink_rect), XEN_TO_C_PangoRectangle_(logical_rect));
- return(XEN_FALSE);
+ #define H_gtk_entry_completion_get_minimum_key_length "gint gtk_entry_completion_get_minimum_key_length(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_minimum_key_length", "GtkEntryCompletion*");
+ return(C_to_Xen_gint(gtk_entry_completion_get_minimum_key_length(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_pango_layout_iter_get_baseline(XEN iter)
+static Xen gxg_gtk_entry_completion_complete(Xen completion)
{
- #define H_pango_layout_iter_get_baseline "int pango_layout_iter_get_baseline(PangoLayoutIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutIter__P(iter), iter, 1, "pango_layout_iter_get_baseline", "PangoLayoutIter*");
- return(C_TO_XEN_int(pango_layout_iter_get_baseline(XEN_TO_C_PangoLayoutIter_(iter))));
+ #define H_gtk_entry_completion_complete "void gtk_entry_completion_complete(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_complete", "GtkEntryCompletion*");
+ gtk_entry_completion_complete(Xen_to_C_GtkEntryCompletion_(completion));
+ return(Xen_false);
}
-static XEN gxg_pango_language_from_string(XEN language)
+static Xen gxg_gtk_entry_completion_insert_action_text(Xen completion, Xen index, Xen text)
{
- #define H_pango_language_from_string "PangoLanguage* pango_language_from_string(char* language)"
- XEN_ASSERT_TYPE(XEN_char__P(language), language, 1, "pango_language_from_string", "char*");
- return(C_TO_XEN_PangoLanguage_(pango_language_from_string(XEN_TO_C_char_(language))));
+ #define H_gtk_entry_completion_insert_action_text "void gtk_entry_completion_insert_action_text(GtkEntryCompletion* completion, \
+gint index, gchar* text)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_insert_action_text", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gint(index), index, 2, "gtk_entry_completion_insert_action_text", "gint");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_entry_completion_insert_action_text", "gchar*");
+ gtk_entry_completion_insert_action_text(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gint(index), Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_pango_language_matches(XEN language, XEN range_list)
+static Xen gxg_gtk_entry_completion_insert_action_markup(Xen completion, Xen index, Xen markup)
{
- #define H_pango_language_matches "gboolean pango_language_matches(PangoLanguage* language, char* range_list)"
- XEN_ASSERT_TYPE(XEN_PangoLanguage__P(language), language, 1, "pango_language_matches", "PangoLanguage*");
- XEN_ASSERT_TYPE(XEN_char__P(range_list), range_list, 2, "pango_language_matches", "char*");
- return(C_TO_XEN_gboolean(pango_language_matches(XEN_TO_C_PangoLanguage_(language), XEN_TO_C_char_(range_list))));
+ #define H_gtk_entry_completion_insert_action_markup "void gtk_entry_completion_insert_action_markup(GtkEntryCompletion* completion, \
+gint index, gchar* markup)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_insert_action_markup", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gint(index), index, 2, "gtk_entry_completion_insert_action_markup", "gint");
+ Xen_check_type(Xen_is_gchar_(markup), markup, 3, "gtk_entry_completion_insert_action_markup", "gchar*");
+ gtk_entry_completion_insert_action_markup(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gint(index), Xen_to_C_gchar_(markup));
+ return(Xen_false);
}
-static XEN gxg_G_OBJECT_TYPE(XEN object)
+static Xen gxg_gtk_entry_completion_delete_action(Xen completion, Xen index)
{
- #define H_G_OBJECT_TYPE "GType G_OBJECT_TYPE(GObject* object)"
- XEN_ASSERT_TYPE(XEN_GObject__P(object), object, 1, "G_OBJECT_TYPE", "GObject*");
- return(C_TO_XEN_GType(G_OBJECT_TYPE(XEN_TO_C_GObject_(object))));
+ #define H_gtk_entry_completion_delete_action "void gtk_entry_completion_delete_action(GtkEntryCompletion* completion, \
+gint index)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_delete_action", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gint(index), index, 2, "gtk_entry_completion_delete_action", "gint");
+ gtk_entry_completion_delete_action(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gint(index));
+ return(Xen_false);
}
-static XEN gxg_g_utf8_validate(XEN str, XEN max_len, XEN ignore_end)
+static Xen gxg_gtk_entry_completion_set_text_column(Xen completion, Xen column)
{
- #define H_g_utf8_validate "gboolean g_utf8_validate(gchar* str, gssize max_len, gchar** [end])"
- gchar* ref_end = NULL;
- XEN_ASSERT_TYPE(XEN_gchar__P(str), str, 1, "g_utf8_validate", "gchar*");
- XEN_ASSERT_TYPE(XEN_gssize_P(max_len), max_len, 2, "g_utf8_validate", "gssize");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(g_utf8_validate((const gchar*)XEN_TO_C_gchar_(str), XEN_TO_C_gssize(max_len), (const gchar**)&ref_end));
- return(XEN_LIST_2(result, C_TO_XEN_gchar_(ref_end)));
- }
+ #define H_gtk_entry_completion_set_text_column "void gtk_entry_completion_set_text_column(GtkEntryCompletion* completion, \
+gint column)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_text_column", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gint(column), column, 2, "gtk_entry_completion_set_text_column", "gint");
+ gtk_entry_completion_set_text_column(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_get_string_from_iter(XEN tree_model, XEN iter)
+static Xen gxg_gtk_radio_tool_button_new(Xen group)
{
- #define H_gtk_tree_model_get_string_from_iter "gchar* gtk_tree_model_get_string_from_iter(GtkTreeModel* tree_model, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_get_string_from_iter", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_get_string_from_iter", "GtkTreeIter*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_tree_model_get_string_from_iter(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_radio_tool_button_new "GtkToolItem* gtk_radio_tool_button_new(GSList* group)"
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 1, "gtk_radio_tool_button_new", "GSList*");
+ return(C_to_Xen_GtkToolItem_(gtk_radio_tool_button_new(Xen_to_C_GSList_(group))));
+}
+
+static Xen gxg_gtk_radio_tool_button_new_from_widget(Xen group)
+{
+ #define H_gtk_radio_tool_button_new_from_widget "GtkToolItem* gtk_radio_tool_button_new_from_widget(GtkRadioToolButton* group)"
+ Xen_check_type(Xen_is_GtkRadioToolButton_(group), group, 1, "gtk_radio_tool_button_new_from_widget", "GtkRadioToolButton*");
+ return(C_to_Xen_GtkToolItem_(gtk_radio_tool_button_new_from_widget(Xen_to_C_GtkRadioToolButton_(group))));
}
-static XEN gxg_gtk_tree_model_sort_iter_is_valid(XEN tree_model_sort, XEN iter)
+static Xen gxg_gtk_radio_tool_button_get_group(Xen button)
{
- #define H_gtk_tree_model_sort_iter_is_valid "gboolean gtk_tree_model_sort_iter_is_valid(GtkTreeModelSort* tree_model_sort, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelSort__P(tree_model_sort), tree_model_sort, 1, "gtk_tree_model_sort_iter_is_valid", "GtkTreeModelSort*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_sort_iter_is_valid", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_model_sort_iter_is_valid(XEN_TO_C_GtkTreeModelSort_(tree_model_sort), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_radio_tool_button_get_group "GSList* gtk_radio_tool_button_get_group(GtkRadioToolButton* button)"
+ Xen_check_type(Xen_is_GtkRadioToolButton_(button), button, 1, "gtk_radio_tool_button_get_group", "GtkRadioToolButton*");
+ return(C_to_Xen_GSList_(gtk_radio_tool_button_get_group(Xen_to_C_GtkRadioToolButton_(button))));
}
-static XEN gxg_gtk_tree_view_expand_to_path(XEN tree_view, XEN path)
+static Xen gxg_gtk_radio_tool_button_set_group(Xen button, Xen group)
{
- #define H_gtk_tree_view_expand_to_path "void gtk_tree_view_expand_to_path(GtkTreeView* tree_view, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_expand_to_path", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_expand_to_path", "GtkTreePath*");
- gtk_tree_view_expand_to_path(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_radio_tool_button_set_group "void gtk_radio_tool_button_set_group(GtkRadioToolButton* button, \
+GSList* group)"
+ Xen_check_type(Xen_is_GtkRadioToolButton_(button), button, 1, "gtk_radio_tool_button_set_group", "GtkRadioToolButton*");
+ Xen_check_type(Xen_is_GSList_(group) || Xen_is_false(group), group, 2, "gtk_radio_tool_button_set_group", "GSList*");
+ gtk_radio_tool_button_set_group(Xen_to_C_GtkRadioToolButton_(button), Xen_to_C_GSList_(group));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_selection_get_selected_rows(XEN selection, XEN model)
+static Xen gxg_gtk_separator_tool_item_new(void)
{
- #define H_gtk_tree_selection_get_selected_rows "GList* gtk_tree_selection_get_selected_rows(GtkTreeSelection* selection, \
-GtkTreeModel** model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_get_selected_rows", "GtkTreeSelection*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel___P(model), model, 2, "gtk_tree_selection_get_selected_rows", "GtkTreeModel**");
- return(C_TO_XEN_GList_(gtk_tree_selection_get_selected_rows(XEN_TO_C_GtkTreeSelection_(selection), XEN_TO_C_GtkTreeModel__(model))));
+ #define H_gtk_separator_tool_item_new "GtkToolItem* gtk_separator_tool_item_new( void)"
+ return(C_to_Xen_GtkToolItem_(gtk_separator_tool_item_new()));
}
-static XEN gxg_gtk_tree_selection_count_selected_rows(XEN selection)
+static Xen gxg_gtk_separator_tool_item_get_draw(Xen item)
{
- #define H_gtk_tree_selection_count_selected_rows "int gtk_tree_selection_count_selected_rows(GtkTreeSelection* selection)"
- XEN_ASSERT_TYPE(XEN_GtkTreeSelection__P(selection), selection, 1, "gtk_tree_selection_count_selected_rows", "GtkTreeSelection*");
- return(C_TO_XEN_int(gtk_tree_selection_count_selected_rows(XEN_TO_C_GtkTreeSelection_(selection))));
+ #define H_gtk_separator_tool_item_get_draw "gboolean gtk_separator_tool_item_get_draw(GtkSeparatorToolItem* item)"
+ Xen_check_type(Xen_is_GtkSeparatorToolItem_(item), item, 1, "gtk_separator_tool_item_get_draw", "GtkSeparatorToolItem*");
+ return(C_to_Xen_gboolean(gtk_separator_tool_item_get_draw(Xen_to_C_GtkSeparatorToolItem_(item))));
}
-static XEN gxg_gtk_menu_shell_select_first(XEN menu_shell, XEN search_sensitive)
+static Xen gxg_gtk_separator_tool_item_set_draw(Xen tool_item, Xen draw)
{
- #define H_gtk_menu_shell_select_first "void gtk_menu_shell_select_first(GtkMenuShell* menu_shell, gboolean search_sensitive)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_select_first", "GtkMenuShell*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(search_sensitive), search_sensitive, 2, "gtk_menu_shell_select_first", "gboolean");
- gtk_menu_shell_select_first(XEN_TO_C_GtkMenuShell_(menu_shell), XEN_TO_C_gboolean(search_sensitive));
- return(XEN_FALSE);
+ #define H_gtk_separator_tool_item_set_draw "void gtk_separator_tool_item_set_draw(GtkSeparatorToolItem* tool_item, \
+gboolean draw)"
+ Xen_check_type(Xen_is_GtkSeparatorToolItem_(tool_item), tool_item, 1, "gtk_separator_tool_item_set_draw", "GtkSeparatorToolItem*");
+ Xen_check_type(Xen_is_gboolean(draw), draw, 2, "gtk_separator_tool_item_set_draw", "gboolean");
+ gtk_separator_tool_item_set_draw(Xen_to_C_GtkSeparatorToolItem_(tool_item), Xen_to_C_gboolean(draw));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_n_pages(XEN notebook)
+static Xen gxg_gtk_toggle_tool_button_new(void)
{
- #define H_gtk_notebook_get_n_pages "int gtk_notebook_get_n_pages(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_n_pages", "GtkNotebook*");
- return(C_TO_XEN_int(gtk_notebook_get_n_pages(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_toggle_tool_button_new "GtkToolItem* gtk_toggle_tool_button_new( void)"
+ return(C_to_Xen_GtkToolItem_(gtk_toggle_tool_button_new()));
}
-static XEN gxg_gtk_list_store_reorder(XEN store, XEN new_order)
+static Xen gxg_gtk_toggle_tool_button_set_active(Xen button, Xen is_active)
{
- #define H_gtk_list_store_reorder "void gtk_list_store_reorder(GtkListStore* store, int* new_order)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(store), store, 1, "gtk_list_store_reorder", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_int__P(new_order), new_order, 2, "gtk_list_store_reorder", "int*");
- gtk_list_store_reorder(XEN_TO_C_GtkListStore_(store), XEN_TO_C_int_(new_order));
- return(XEN_FALSE);
+ #define H_gtk_toggle_tool_button_set_active "void gtk_toggle_tool_button_set_active(GtkToggleToolButton* button, \
+gboolean is_active)"
+ Xen_check_type(Xen_is_GtkToggleToolButton_(button), button, 1, "gtk_toggle_tool_button_set_active", "GtkToggleToolButton*");
+ Xen_check_type(Xen_is_gboolean(is_active), is_active, 2, "gtk_toggle_tool_button_set_active", "gboolean");
+ gtk_toggle_tool_button_set_active(Xen_to_C_GtkToggleToolButton_(button), Xen_to_C_gboolean(is_active));
+ return(Xen_false);
}
-static XEN gxg_gtk_list_store_swap(XEN store, XEN a, XEN b)
+static Xen gxg_gtk_toggle_tool_button_get_active(Xen button)
{
- #define H_gtk_list_store_swap "void gtk_list_store_swap(GtkListStore* store, GtkTreeIter* a, GtkTreeIter* b)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(store), store, 1, "gtk_list_store_swap", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(a), a, 2, "gtk_list_store_swap", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(b), b, 3, "gtk_list_store_swap", "GtkTreeIter*");
- gtk_list_store_swap(XEN_TO_C_GtkListStore_(store), XEN_TO_C_GtkTreeIter_(a), XEN_TO_C_GtkTreeIter_(b));
- return(XEN_FALSE);
+ #define H_gtk_toggle_tool_button_get_active "gboolean gtk_toggle_tool_button_get_active(GtkToggleToolButton* button)"
+ Xen_check_type(Xen_is_GtkToggleToolButton_(button), button, 1, "gtk_toggle_tool_button_get_active", "GtkToggleToolButton*");
+ return(C_to_Xen_gboolean(gtk_toggle_tool_button_get_active(Xen_to_C_GtkToggleToolButton_(button))));
}
-static XEN gxg_gtk_list_store_move_after(XEN store, XEN iter, XEN position)
+static Xen gxg_g_timeout_add_full(Xen priority, Xen interval, Xen func, Xen func_info, Xen notify)
{
- #define H_gtk_list_store_move_after "void gtk_list_store_move_after(GtkListStore* store, GtkTreeIter* iter, \
-GtkTreeIter* position)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(store), store, 1, "gtk_list_store_move_after", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_move_after", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(position) || XEN_FALSE_P(position), position, 3, "gtk_list_store_move_after", "GtkTreeIter*");
- gtk_list_store_move_after(XEN_TO_C_GtkListStore_(store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(position));
- return(XEN_FALSE);
+ #define H_g_timeout_add_full "guint g_timeout_add_full(gint priority, guint interval, GSourceFunc func, \
+lambda_data func_info, GtkDestroyNotify notify)"
+ Xen_check_type(Xen_is_gint(priority), priority, 1, "g_timeout_add_full", "gint");
+ Xen_check_type(Xen_is_guint(interval), interval, 2, "g_timeout_add_full", "guint");
+ Xen_check_type(Xen_is_GSourceFunc(func), func, 3, "g_timeout_add_full", "GSourceFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "g_timeout_add_full", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(notify), notify, 5, "g_timeout_add_full", "GtkDestroyNotify");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ Xen_list_set(gxg_ptr, 3, notify);
+ result = C_to_Xen_guint(g_timeout_add_full(Xen_to_C_gint(priority), Xen_to_C_guint(interval), Xen_to_C_GSourceFunc(func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GtkDestroyNotify(notify)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
+ }
}
-static XEN gxg_gtk_list_store_move_before(XEN store, XEN iter, XEN position)
+static Xen gxg_g_timeout_add(Xen interval, Xen func, Xen func_info)
{
- #define H_gtk_list_store_move_before "void gtk_list_store_move_before(GtkListStore* store, GtkTreeIter* iter, \
-GtkTreeIter* position)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(store), store, 1, "gtk_list_store_move_before", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_move_before", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(position) || XEN_FALSE_P(position), position, 3, "gtk_list_store_move_before", "GtkTreeIter*");
- gtk_list_store_move_before(XEN_TO_C_GtkListStore_(store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_GtkTreeIter_(position));
- return(XEN_FALSE);
+ #define H_g_timeout_add "guint g_timeout_add(guint interval, GSourceFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_guint(interval), interval, 1, "g_timeout_add", "guint");
+ Xen_check_type(Xen_is_GSourceFunc(func), func, 2, "g_timeout_add", "GSourceFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "g_timeout_add", "lambda_data");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_guint(g_timeout_add(Xen_to_C_guint(interval), Xen_to_C_GSourceFunc(func), Xen_to_C_lambda_data(func_info)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
+ }
}
-static XEN gxg_gtk_tree_store_reorder(XEN tree_store, XEN parent, XEN new_order)
+static Xen gxg_g_idle_add(Xen func, Xen func_info)
{
- #define H_gtk_tree_store_reorder "void gtk_tree_store_reorder(GtkTreeStore* tree_store, GtkTreeIter* parent, \
-int* new_order)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_reorder", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(parent), parent, 2, "gtk_tree_store_reorder", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_int__P(new_order), new_order, 3, "gtk_tree_store_reorder", "int*");
- gtk_tree_store_reorder(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(parent), XEN_TO_C_int_(new_order));
- return(XEN_FALSE);
+ #define H_g_idle_add "guint g_idle_add(GSourceFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_GSourceFunc(func), func, 1, "g_idle_add", "GSourceFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 2, "g_idle_add", "lambda_data");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_guint(g_idle_add(Xen_to_C_GSourceFunc(func), Xen_to_C_lambda_data(func_info)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
+ }
}
-static XEN gxg_gtk_tree_store_swap(XEN tree_store, XEN a, XEN b)
+static Xen gxg_g_idle_add_full(Xen priority, Xen func, Xen func_info, Xen notify)
{
- #define H_gtk_tree_store_swap "void gtk_tree_store_swap(GtkTreeStore* tree_store, GtkTreeIter* a, GtkTreeIter* b)"
- XEN_ASSERT_TYPE(XEN_GtkTreeStore__P(tree_store), tree_store, 1, "gtk_tree_store_swap", "GtkTreeStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(a), a, 2, "gtk_tree_store_swap", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(b), b, 3, "gtk_tree_store_swap", "GtkTreeIter*");
- gtk_tree_store_swap(XEN_TO_C_GtkTreeStore_(tree_store), XEN_TO_C_GtkTreeIter_(a), XEN_TO_C_GtkTreeIter_(b));
- return(XEN_FALSE);
+ #define H_g_idle_add_full "guint g_idle_add_full(gint priority, GSourceFunc func, lambda_data func_info, \
+GtkDestroyNotify notify)"
+ Xen_check_type(Xen_is_gint(priority), priority, 1, "g_idle_add_full", "gint");
+ Xen_check_type(Xen_is_GSourceFunc(func), func, 2, "g_idle_add_full", "GSourceFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "g_idle_add_full", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(notify), notify, 4, "g_idle_add_full", "GtkDestroyNotify");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ Xen_list_set(gxg_ptr, 3, notify);
+ result = C_to_Xen_guint(g_idle_add_full(Xen_to_C_gint(priority), Xen_to_C_GSourceFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GtkDestroyNotify(notify)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
+ }
}
-static XEN gxg_gdk_display_open(XEN display_name)
+static Xen gxg_g_idle_remove_by_data(Xen data)
{
- #define H_gdk_display_open "GdkDisplay* gdk_display_open(gchar* display_name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(display_name), display_name, 1, "gdk_display_open", "gchar*");
- return(C_TO_XEN_GdkDisplay_(gdk_display_open(XEN_TO_C_gchar_(display_name))));
+ #define H_g_idle_remove_by_data "gboolean g_idle_remove_by_data(gpointer data)"
+ Xen_check_type(Xen_is_gpointer(data), data, 1, "g_idle_remove_by_data", "gpointer");
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_caddr(data)));
+ return(C_to_Xen_gboolean(g_idle_remove_by_data(Xen_to_C_gpointer(data))));
}
-static XEN gxg_gdk_display_get_name(XEN display)
+static Xen gxg_g_source_remove(Xen tag)
{
- #define H_gdk_display_get_name "gchar* gdk_display_get_name(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_name", "GdkDisplay*");
- return(C_TO_XEN_gchar_(gdk_display_get_name(XEN_TO_C_GdkDisplay_(display))));
+ #define H_g_source_remove "gboolean g_source_remove(guint tag)"
+ Xen_check_type(Xen_is_guint(tag), tag, 1, "g_source_remove", "guint");
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_caddr(tag)));
+ return(C_to_Xen_gboolean(g_source_remove(Xen_to_C_guint(tag))));
}
-static XEN gxg_gdk_display_get_n_screens(XEN display)
+static Xen gxg_gtk_file_filter_new(void)
{
- #define H_gdk_display_get_n_screens "int gdk_display_get_n_screens(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_n_screens", "GdkDisplay*");
- return(C_TO_XEN_int(gdk_display_get_n_screens(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_file_filter_new "GtkFileFilter* gtk_file_filter_new( void)"
+ return(C_to_Xen_GtkFileFilter_(gtk_file_filter_new()));
}
-static XEN gxg_gdk_display_get_screen(XEN display, XEN screen_num)
+static Xen gxg_gtk_file_filter_set_name(Xen filter, Xen name)
{
- #define H_gdk_display_get_screen "GdkScreen* gdk_display_get_screen(GdkDisplay* display, int screen_num)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_screen", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_int_P(screen_num), screen_num, 2, "gdk_display_get_screen", "int");
- return(C_TO_XEN_GdkScreen_(gdk_display_get_screen(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_int(screen_num))));
+ #define H_gtk_file_filter_set_name "void gtk_file_filter_set_name(GtkFileFilter* filter, gchar* name)"
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 1, "gtk_file_filter_set_name", "GtkFileFilter*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_file_filter_set_name", "gchar*");
+ gtk_file_filter_set_name(Xen_to_C_GtkFileFilter_(filter), Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_get_default_screen(XEN display)
+static Xen gxg_gtk_file_filter_get_name(Xen filter)
{
- #define H_gdk_display_get_default_screen "GdkScreen* gdk_display_get_default_screen(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_default_screen", "GdkDisplay*");
- return(C_TO_XEN_GdkScreen_(gdk_display_get_default_screen(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_file_filter_get_name "gchar* gtk_file_filter_get_name(GtkFileFilter* filter)"
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 1, "gtk_file_filter_get_name", "GtkFileFilter*");
+ return(C_to_Xen_gchar_(gtk_file_filter_get_name(Xen_to_C_GtkFileFilter_(filter))));
}
-static XEN gxg_gdk_display_beep(XEN display)
+static Xen gxg_gtk_file_filter_add_mime_type(Xen filter, Xen mime_type)
{
- #define H_gdk_display_beep "void gdk_display_beep(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_beep", "GdkDisplay*");
- gdk_display_beep(XEN_TO_C_GdkDisplay_(display));
- return(XEN_FALSE);
+ #define H_gtk_file_filter_add_mime_type "void gtk_file_filter_add_mime_type(GtkFileFilter* filter, \
+gchar* mime_type)"
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 1, "gtk_file_filter_add_mime_type", "GtkFileFilter*");
+ Xen_check_type(Xen_is_gchar_(mime_type), mime_type, 2, "gtk_file_filter_add_mime_type", "gchar*");
+ gtk_file_filter_add_mime_type(Xen_to_C_GtkFileFilter_(filter), Xen_to_C_gchar_(mime_type));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_sync(XEN display)
+static Xen gxg_gtk_file_filter_add_pattern(Xen filter, Xen pattern)
{
- #define H_gdk_display_sync "void gdk_display_sync(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_sync", "GdkDisplay*");
- gdk_display_sync(XEN_TO_C_GdkDisplay_(display));
- return(XEN_FALSE);
+ #define H_gtk_file_filter_add_pattern "void gtk_file_filter_add_pattern(GtkFileFilter* filter, gchar* pattern)"
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 1, "gtk_file_filter_add_pattern", "GtkFileFilter*");
+ Xen_check_type(Xen_is_gchar_(pattern), pattern, 2, "gtk_file_filter_add_pattern", "gchar*");
+ gtk_file_filter_add_pattern(Xen_to_C_GtkFileFilter_(filter), Xen_to_C_gchar_(pattern));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_close(XEN display)
+static Xen gxg_gtk_file_filter_add_custom(Xen filter, Xen needed, Xen func, Xen func_info, Xen notify)
{
- #define H_gdk_display_close "void gdk_display_close(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_close", "GdkDisplay*");
- gdk_display_close(XEN_TO_C_GdkDisplay_(display));
- return(XEN_FALSE);
+ #define H_gtk_file_filter_add_custom "void gtk_file_filter_add_custom(GtkFileFilter* filter, GtkFileFilterFlags needed, \
+GtkFileFilterFunc func, lambda_data func_info, GtkDestroyNotify notify)"
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 1, "gtk_file_filter_add_custom", "GtkFileFilter*");
+ Xen_check_type(Xen_is_GtkFileFilterFlags(needed), needed, 2, "gtk_file_filter_add_custom", "GtkFileFilterFlags");
+ Xen_check_type(Xen_is_GtkFileFilterFunc(func), func, 3, "gtk_file_filter_add_custom", "GtkFileFilterFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "gtk_file_filter_add_custom", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(notify), notify, 5, "gtk_file_filter_add_custom", "GtkDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, notify);
+ gtk_file_filter_add_custom(Xen_to_C_GtkFileFilter_(filter), Xen_to_C_GtkFileFilterFlags(needed), Xen_to_C_GtkFileFilterFunc(func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GtkDestroyNotify(notify));
+ return(Xen_false);
+ }
}
-static XEN gxg_gdk_display_get_event(XEN display)
+static Xen gxg_gtk_file_filter_get_needed(Xen filter)
{
- #define H_gdk_display_get_event "GdkEvent* gdk_display_get_event(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_event", "GdkDisplay*");
- return(C_TO_XEN_GdkEvent_(gdk_display_get_event(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_file_filter_get_needed "GtkFileFilterFlags gtk_file_filter_get_needed(GtkFileFilter* filter)"
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 1, "gtk_file_filter_get_needed", "GtkFileFilter*");
+ return(C_to_Xen_GtkFileFilterFlags(gtk_file_filter_get_needed(Xen_to_C_GtkFileFilter_(filter))));
}
-static XEN gxg_gdk_display_peek_event(XEN display)
+static Xen gxg_gtk_file_filter_filter(Xen filter, Xen filter_info)
{
- #define H_gdk_display_peek_event "GdkEvent* gdk_display_peek_event(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_peek_event", "GdkDisplay*");
- return(C_TO_XEN_GdkEvent_(gdk_display_peek_event(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_file_filter_filter "gboolean gtk_file_filter_filter(GtkFileFilter* filter, GtkFileFilterInfo* filter_info)"
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 1, "gtk_file_filter_filter", "GtkFileFilter*");
+ Xen_check_type(Xen_is_GtkFileFilterInfo_(filter_info), filter_info, 2, "gtk_file_filter_filter", "GtkFileFilterInfo*");
+ return(C_to_Xen_gboolean(gtk_file_filter_filter(Xen_to_C_GtkFileFilter_(filter), Xen_to_C_GtkFileFilterInfo_(filter_info))));
}
-static XEN gxg_gdk_display_put_event(XEN display, XEN event)
+static Xen gxg_gtk_cell_layout_pack_start(Xen cell_layout, Xen cell, Xen expand)
{
- #define H_gdk_display_put_event "void gdk_display_put_event(GdkDisplay* display, GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_put_event", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 2, "gdk_display_put_event", "GdkEvent*");
- gdk_display_put_event(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_GdkEvent_(event));
- return(XEN_FALSE);
+ #define H_gtk_cell_layout_pack_start "void gtk_cell_layout_pack_start(GtkCellLayout* cell_layout, GtkCellRenderer* cell, \
+gboolean expand)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_pack_start", "GtkCellLayout*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_cell_layout_pack_start", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_cell_layout_pack_start", "gboolean");
+ gtk_cell_layout_pack_start(Xen_to_C_GtkCellLayout_(cell_layout), Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gboolean(expand));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_set_double_click_time(XEN display, XEN msec)
+static Xen gxg_gtk_cell_layout_pack_end(Xen cell_layout, Xen cell, Xen expand)
{
- #define H_gdk_display_set_double_click_time "void gdk_display_set_double_click_time(GdkDisplay* display, \
-guint msec)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_set_double_click_time", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_guint_P(msec), msec, 2, "gdk_display_set_double_click_time", "guint");
- gdk_display_set_double_click_time(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_guint(msec));
- return(XEN_FALSE);
+ #define H_gtk_cell_layout_pack_end "void gtk_cell_layout_pack_end(GtkCellLayout* cell_layout, GtkCellRenderer* cell, \
+gboolean expand)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_pack_end", "GtkCellLayout*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_cell_layout_pack_end", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_cell_layout_pack_end", "gboolean");
+ gtk_cell_layout_pack_end(Xen_to_C_GtkCellLayout_(cell_layout), Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gboolean(expand));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_get_default(void)
+static Xen gxg_gtk_cell_layout_clear(Xen cell_layout)
{
- #define H_gdk_display_get_default "GdkDisplay* gdk_display_get_default( void)"
- return(C_TO_XEN_GdkDisplay_(gdk_display_get_default()));
+ #define H_gtk_cell_layout_clear "void gtk_cell_layout_clear(GtkCellLayout* cell_layout)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_clear", "GtkCellLayout*");
+ gtk_cell_layout_clear(Xen_to_C_GtkCellLayout_(cell_layout));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_system_visual(XEN screen)
+static Xen gxg_gtk_cell_layout_set_attributes(Xen cell_layout, Xen cell, Xen attributes)
{
- #define H_gdk_screen_get_system_visual "GdkVisual* gdk_screen_get_system_visual(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_system_visual", "GdkScreen*");
- return(C_TO_XEN_GdkVisual_(gdk_screen_get_system_visual(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_cell_layout_set_attributes "void gtk_cell_layout_set_attributes(GtkCellLayout* cell_layout, \
+GtkCellRenderer* cell, etc attributes)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_set_attributes", "GtkCellLayout*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_cell_layout_set_attributes", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_etc(attributes), attributes, 3, "gtk_cell_layout_set_attributes", "etc");
+ {
+ int etc_len = 0;
+ GtkCellLayout* p_arg0;
+ GtkCellRenderer* p_arg1;
+ if (Xen_is_list(attributes)) etc_len = Xen_list_length(attributes);
+ if (etc_len < 2) Xen_out_of_range_error("gtk_cell_layout_set_attributes", 2, attributes, "... list must have at least 2 entries");
+ if (etc_len > 10) Xen_out_of_range_error("gtk_cell_layout_set_attributes", 2, attributes, "... list too long (max len: 10)");
+ if ((etc_len % 2) != 0) Xen_out_of_range_error("gtk_cell_layout_set_attributes", 2, attributes, "... list len must be multiple of 2");
+ p_arg0 = Xen_to_C_GtkCellLayout_(cell_layout);
+ p_arg1 = Xen_to_C_GtkCellRenderer_(cell);
+ switch (etc_len)
+ {
+ case 2: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), NULL); break;
+ case 4: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), NULL); break;
+ case 6: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), NULL); break;
+ case 8: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), NULL); break;
+ case 10: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), XLS(attributes, 8), XLI(attributes, 9), NULL); break;
+ }
+ return(Xen_false);
+ }
}
-static XEN gxg_gdk_screen_get_root_window(XEN screen)
+static Xen gxg_gtk_cell_layout_add_attribute(Xen cell_layout, Xen cell, Xen attribute, Xen column)
{
- #define H_gdk_screen_get_root_window "GdkWindow* gdk_screen_get_root_window(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_root_window", "GdkScreen*");
- return(C_TO_XEN_GdkWindow_(gdk_screen_get_root_window(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_cell_layout_add_attribute "void gtk_cell_layout_add_attribute(GtkCellLayout* cell_layout, \
+GtkCellRenderer* cell, gchar* attribute, gint column)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_add_attribute", "GtkCellLayout*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_cell_layout_add_attribute", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gchar_(attribute), attribute, 3, "gtk_cell_layout_add_attribute", "gchar*");
+ Xen_check_type(Xen_is_gint(column), column, 4, "gtk_cell_layout_add_attribute", "gint");
+ gtk_cell_layout_add_attribute(Xen_to_C_GtkCellLayout_(cell_layout), Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gchar_(attribute),
+ Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_display(XEN screen)
+static Xen gxg_gtk_cell_layout_set_cell_data_func(Xen cell_layout, Xen cell, Xen func, Xen func_info, Xen destroy)
{
- #define H_gdk_screen_get_display "GdkDisplay* gdk_screen_get_display(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_display", "GdkScreen*");
- return(C_TO_XEN_GdkDisplay_(gdk_screen_get_display(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_cell_layout_set_cell_data_func "void gtk_cell_layout_set_cell_data_func(GtkCellLayout* cell_layout, \
+GtkCellRenderer* cell, GtkCellLayoutDataFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_set_cell_data_func", "GtkCellLayout*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_cell_layout_set_cell_data_func", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GtkCellLayoutDataFunc(func), func, 3, "gtk_cell_layout_set_cell_data_func", "GtkCellLayoutDataFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "gtk_cell_layout_set_cell_data_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(destroy), destroy, 5, "gtk_cell_layout_set_cell_data_func", "GtkDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, destroy);
+ gtk_cell_layout_set_cell_data_func(Xen_to_C_GtkCellLayout_(cell_layout), Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_GtkCellLayoutDataFunc(func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GtkDestroyNotify(destroy));
+ return(Xen_false);
+ }
}
-static XEN gxg_gdk_screen_get_number(XEN screen)
+static Xen gxg_gtk_cell_layout_clear_attributes(Xen cell_layout, Xen cell)
{
- #define H_gdk_screen_get_number "int gdk_screen_get_number(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_number", "GdkScreen*");
- return(C_TO_XEN_int(gdk_screen_get_number(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_cell_layout_clear_attributes "void gtk_cell_layout_clear_attributes(GtkCellLayout* cell_layout, \
+GtkCellRenderer* cell)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_clear_attributes", "GtkCellLayout*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_cell_layout_clear_attributes", "GtkCellRenderer*");
+ gtk_cell_layout_clear_attributes(Xen_to_C_GtkCellLayout_(cell_layout), Xen_to_C_GtkCellRenderer_(cell));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_width(XEN screen)
+static Xen gxg_gtk_file_chooser_set_action(Xen chooser, Xen action)
{
- #define H_gdk_screen_get_width "int gdk_screen_get_width(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_width", "GdkScreen*");
- return(C_TO_XEN_int(gdk_screen_get_width(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_file_chooser_set_action "void gtk_file_chooser_set_action(GtkFileChooser* chooser, GtkFileChooserAction action)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_action", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GtkFileChooserAction(action), action, 2, "gtk_file_chooser_set_action", "GtkFileChooserAction");
+ gtk_file_chooser_set_action(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GtkFileChooserAction(action));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_height(XEN screen)
+static Xen gxg_gtk_file_chooser_get_action(Xen chooser)
{
- #define H_gdk_screen_get_height "int gdk_screen_get_height(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_height", "GdkScreen*");
- return(C_TO_XEN_int(gdk_screen_get_height(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_file_chooser_get_action "GtkFileChooserAction gtk_file_chooser_get_action(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_action", "GtkFileChooser*");
+ return(C_to_Xen_GtkFileChooserAction(gtk_file_chooser_get_action(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gdk_screen_get_width_mm(XEN screen)
+static Xen gxg_gtk_file_chooser_set_local_only(Xen chooser, Xen files_only)
{
- #define H_gdk_screen_get_width_mm "int gdk_screen_get_width_mm(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_width_mm", "GdkScreen*");
- return(C_TO_XEN_int(gdk_screen_get_width_mm(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_file_chooser_set_local_only "void gtk_file_chooser_set_local_only(GtkFileChooser* chooser, \
+gboolean files_only)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_local_only", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gboolean(files_only), files_only, 2, "gtk_file_chooser_set_local_only", "gboolean");
+ gtk_file_chooser_set_local_only(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gboolean(files_only));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_height_mm(XEN screen)
+static Xen gxg_gtk_file_chooser_get_local_only(Xen chooser)
{
- #define H_gdk_screen_get_height_mm "int gdk_screen_get_height_mm(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_height_mm", "GdkScreen*");
- return(C_TO_XEN_int(gdk_screen_get_height_mm(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_file_chooser_get_local_only "gboolean gtk_file_chooser_get_local_only(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_local_only", "GtkFileChooser*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_get_local_only(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gdk_screen_list_visuals(XEN screen)
+static Xen gxg_gtk_file_chooser_set_select_multiple(Xen chooser, Xen select_multiple)
{
- #define H_gdk_screen_list_visuals "GList* gdk_screen_list_visuals(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_list_visuals", "GdkScreen*");
- return(C_TO_XEN_GList_(gdk_screen_list_visuals(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_file_chooser_set_select_multiple "void gtk_file_chooser_set_select_multiple(GtkFileChooser* chooser, \
+gboolean select_multiple)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_select_multiple", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gboolean(select_multiple), select_multiple, 2, "gtk_file_chooser_set_select_multiple", "gboolean");
+ gtk_file_chooser_set_select_multiple(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gboolean(select_multiple));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_toplevel_windows(XEN screen)
+static Xen gxg_gtk_file_chooser_get_select_multiple(Xen chooser)
{
- #define H_gdk_screen_get_toplevel_windows "GList* gdk_screen_get_toplevel_windows(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_toplevel_windows", "GdkScreen*");
- return(C_TO_XEN_GList_(gdk_screen_get_toplevel_windows(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_file_chooser_get_select_multiple "gboolean gtk_file_chooser_get_select_multiple(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_select_multiple", "GtkFileChooser*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_get_select_multiple(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gdk_screen_make_display_name(XEN screen)
+static Xen gxg_gtk_file_chooser_set_current_name(Xen chooser, Xen name)
{
- #define H_gdk_screen_make_display_name "gchar* gdk_screen_make_display_name(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_make_display_name", "GdkScreen*");
+ #define H_gtk_file_chooser_set_current_name "void gtk_file_chooser_set_current_name(GtkFileChooser* chooser, \
+gchar* name)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_current_name", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_file_chooser_set_current_name", "gchar*");
+ gtk_file_chooser_set_current_name(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gchar_(name));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_file_chooser_get_filename(Xen chooser)
+{
+ #define H_gtk_file_chooser_get_filename "gchar* gtk_file_chooser_get_filename(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_filename", "GtkFileChooser*");
{
gchar* result;
- XEN rtn;
- result = gdk_screen_make_display_name(XEN_TO_C_GdkScreen_(screen));
- rtn = C_TO_XEN_gchar_(result);
+ Xen rtn;
+ result = gtk_file_chooser_get_filename(Xen_to_C_GtkFileChooser_(chooser));
+ rtn = C_to_Xen_gchar_(result);
g_free(result);
return(rtn);
}
}
-static XEN gxg_gdk_screen_get_n_monitors(XEN screen)
-{
- #define H_gdk_screen_get_n_monitors "int gdk_screen_get_n_monitors(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_n_monitors", "GdkScreen*");
- return(C_TO_XEN_int(gdk_screen_get_n_monitors(XEN_TO_C_GdkScreen_(screen))));
-}
-
-static XEN gxg_gdk_screen_get_monitor_geometry(XEN screen, XEN monitor_num, XEN dest)
+static Xen gxg_gtk_file_chooser_set_filename(Xen chooser, Xen filename)
{
- #define H_gdk_screen_get_monitor_geometry "void gdk_screen_get_monitor_geometry(GdkScreen* screen, \
-int monitor_num, GdkRectangle* dest)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_monitor_geometry", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_int_P(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_geometry", "int");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(dest), dest, 3, "gdk_screen_get_monitor_geometry", "GdkRectangle*");
- gdk_screen_get_monitor_geometry(XEN_TO_C_GdkScreen_(screen), XEN_TO_C_int(monitor_num), XEN_TO_C_GdkRectangle_(dest));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_set_filename "gboolean gtk_file_chooser_set_filename(GtkFileChooser* chooser, \
+char* filename)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_filename", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(filename), filename, 2, "gtk_file_chooser_set_filename", "char*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_set_filename(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(filename))));
}
-static XEN gxg_gdk_screen_get_monitor_at_point(XEN screen, XEN x, XEN y)
+static Xen gxg_gtk_file_chooser_select_filename(Xen chooser, Xen filename)
{
- #define H_gdk_screen_get_monitor_at_point "int gdk_screen_get_monitor_at_point(GdkScreen* screen, int x, \
-int y)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_monitor_at_point", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 2, "gdk_screen_get_monitor_at_point", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 3, "gdk_screen_get_monitor_at_point", "int");
- return(C_TO_XEN_int(gdk_screen_get_monitor_at_point(XEN_TO_C_GdkScreen_(screen), XEN_TO_C_int(x), XEN_TO_C_int(y))));
+ #define H_gtk_file_chooser_select_filename "gboolean gtk_file_chooser_select_filename(GtkFileChooser* chooser, \
+char* filename)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_select_filename", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(filename), filename, 2, "gtk_file_chooser_select_filename", "char*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_select_filename(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(filename))));
}
-static XEN gxg_gdk_screen_get_monitor_at_window(XEN screen, XEN window)
+static Xen gxg_gtk_file_chooser_unselect_filename(Xen chooser, Xen filename)
{
- #define H_gdk_screen_get_monitor_at_window "int gdk_screen_get_monitor_at_window(GdkScreen* screen, \
-GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_monitor_at_window", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 2, "gdk_screen_get_monitor_at_window", "GdkWindow*");
- return(C_TO_XEN_int(gdk_screen_get_monitor_at_window(XEN_TO_C_GdkScreen_(screen), XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_file_chooser_unselect_filename "void gtk_file_chooser_unselect_filename(GtkFileChooser* chooser, \
+char* filename)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_unselect_filename", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(filename), filename, 2, "gtk_file_chooser_unselect_filename", "char*");
+ gtk_file_chooser_unselect_filename(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(filename));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_default(void)
+static Xen gxg_gtk_file_chooser_select_all(Xen chooser)
{
- #define H_gdk_screen_get_default "GdkScreen* gdk_screen_get_default( void)"
- return(C_TO_XEN_GdkScreen_(gdk_screen_get_default()));
+ #define H_gtk_file_chooser_select_all "void gtk_file_chooser_select_all(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_select_all", "GtkFileChooser*");
+ gtk_file_chooser_select_all(Xen_to_C_GtkFileChooser_(chooser));
+ return(Xen_false);
}
-static XEN gxg_gtk_clipboard_get_for_display(XEN display, XEN selection)
+static Xen gxg_gtk_file_chooser_unselect_all(Xen chooser)
{
- #define H_gtk_clipboard_get_for_display "GtkClipboard* gtk_clipboard_get_for_display(GdkDisplay* display, \
-GdkAtom selection)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gtk_clipboard_get_for_display", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gtk_clipboard_get_for_display", "GdkAtom");
- return(C_TO_XEN_GtkClipboard_(gtk_clipboard_get_for_display(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_GdkAtom(selection))));
+ #define H_gtk_file_chooser_unselect_all "void gtk_file_chooser_unselect_all(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_unselect_all", "GtkFileChooser*");
+ gtk_file_chooser_unselect_all(Xen_to_C_GtkFileChooser_(chooser));
+ return(Xen_false);
}
-static XEN gxg_gtk_clipboard_get_display(XEN clipboard)
+static Xen gxg_gtk_file_chooser_get_filenames(Xen chooser)
{
- #define H_gtk_clipboard_get_display "GdkDisplay* gtk_clipboard_get_display(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_get_display", "GtkClipboard*");
- return(C_TO_XEN_GdkDisplay_(gtk_clipboard_get_display(XEN_TO_C_GtkClipboard_(clipboard))));
+ #define H_gtk_file_chooser_get_filenames "GSList* gtk_file_chooser_get_filenames(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_filenames", "GtkFileChooser*");
+ return(C_to_Xen_GSList_(gtk_file_chooser_get_filenames(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_widget_get_screen(XEN widget)
+static Xen gxg_gtk_file_chooser_set_current_folder(Xen chooser, Xen filename)
{
- #define H_gtk_widget_get_screen "GdkScreen* gtk_widget_get_screen(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_screen", "GtkWidget*");
- return(C_TO_XEN_GdkScreen_(gtk_widget_get_screen(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_file_chooser_set_current_folder "gboolean gtk_file_chooser_set_current_folder(GtkFileChooser* chooser, \
+gchar* filename)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_current_folder", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gchar_(filename), filename, 2, "gtk_file_chooser_set_current_folder", "gchar*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_set_current_folder(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gchar_(filename))));
}
-static XEN gxg_gtk_widget_has_screen(XEN widget)
+static Xen gxg_gtk_file_chooser_get_current_folder(Xen chooser)
{
- #define H_gtk_widget_has_screen "gboolean gtk_widget_has_screen(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_has_screen", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_has_screen(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_file_chooser_get_current_folder "gchar* gtk_file_chooser_get_current_folder(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_current_folder", "GtkFileChooser*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_file_chooser_get_current_folder(Xen_to_C_GtkFileChooser_(chooser));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_widget_get_display(XEN widget)
+static Xen gxg_gtk_file_chooser_get_uri(Xen chooser)
{
- #define H_gtk_widget_get_display "GdkDisplay* gtk_widget_get_display(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_display", "GtkWidget*");
- return(C_TO_XEN_GdkDisplay_(gtk_widget_get_display(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_file_chooser_get_uri "gchar* gtk_file_chooser_get_uri(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_uri", "GtkFileChooser*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_file_chooser_get_uri(Xen_to_C_GtkFileChooser_(chooser));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gtk_widget_get_root_window(XEN widget)
+static Xen gxg_gtk_file_chooser_set_uri(Xen chooser, Xen uri)
{
- #define H_gtk_widget_get_root_window "GdkWindow* gtk_widget_get_root_window(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_root_window", "GtkWidget*");
- return(C_TO_XEN_GdkWindow_(gtk_widget_get_root_window(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_file_chooser_set_uri "gboolean gtk_file_chooser_set_uri(GtkFileChooser* chooser, char* uri)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_uri", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(uri), uri, 2, "gtk_file_chooser_set_uri", "char*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_set_uri(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(uri))));
}
-static XEN gxg_gtk_widget_get_clipboard(XEN widget, XEN selection)
+static Xen gxg_gtk_file_chooser_select_uri(Xen chooser, Xen uri)
{
- #define H_gtk_widget_get_clipboard "GtkClipboard* gtk_widget_get_clipboard(GtkWidget* widget, GdkAtom selection)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_clipboard", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gtk_widget_get_clipboard", "GdkAtom");
- return(C_TO_XEN_GtkClipboard_(gtk_widget_get_clipboard(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkAtom(selection))));
+ #define H_gtk_file_chooser_select_uri "gboolean gtk_file_chooser_select_uri(GtkFileChooser* chooser, \
+char* uri)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_select_uri", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(uri), uri, 2, "gtk_file_chooser_select_uri", "char*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_select_uri(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(uri))));
}
-static XEN gxg_g_list_free(XEN list)
+static Xen gxg_gtk_file_chooser_unselect_uri(Xen chooser, Xen uri)
{
- #define H_g_list_free "void g_list_free(GList* list)"
- XEN_ASSERT_TYPE(XEN_GList__P(list), list, 1, "g_list_free", "GList*");
- g_list_free(XEN_TO_C_GList_(list));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_unselect_uri "void gtk_file_chooser_unselect_uri(GtkFileChooser* chooser, \
+char* uri)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_unselect_uri", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(uri), uri, 2, "gtk_file_chooser_unselect_uri", "char*");
+ gtk_file_chooser_unselect_uri(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(uri));
+ return(Xen_false);
}
-static XEN gxg_g_list_reverse(XEN list)
+static Xen gxg_gtk_file_chooser_get_uris(Xen chooser)
{
- #define H_g_list_reverse "GList* g_list_reverse(GList* list)"
- XEN_ASSERT_TYPE(XEN_GList__P(list) || XEN_FALSE_P(list), list, 1, "g_list_reverse", "GList*");
- return(C_TO_XEN_GList_(g_list_reverse(XEN_TO_C_GList_(list))));
+ #define H_gtk_file_chooser_get_uris "GSList* gtk_file_chooser_get_uris(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_uris", "GtkFileChooser*");
+ return(C_to_Xen_GSList_(gtk_file_chooser_get_uris(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_g_list_copy(XEN list)
+static Xen gxg_gtk_file_chooser_set_current_folder_uri(Xen chooser, Xen uri)
{
- #define H_g_list_copy "GList* g_list_copy(GList* list)"
- XEN_ASSERT_TYPE(XEN_GList__P(list) || XEN_FALSE_P(list), list, 1, "g_list_copy", "GList*");
- return(C_TO_XEN_GList_(g_list_copy(XEN_TO_C_GList_(list))));
+ #define H_gtk_file_chooser_set_current_folder_uri "gboolean gtk_file_chooser_set_current_folder_uri(GtkFileChooser* chooser, \
+gchar* uri)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_current_folder_uri", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_file_chooser_set_current_folder_uri", "gchar*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_set_current_folder_uri(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gchar_(uri))));
}
-static XEN gxg_g_list_last(XEN list)
+static Xen gxg_gtk_file_chooser_get_current_folder_uri(Xen chooser)
{
- #define H_g_list_last "GList* g_list_last(GList* list)"
- XEN_ASSERT_TYPE(XEN_GList__P(list), list, 1, "g_list_last", "GList*");
- return(C_TO_XEN_GList_(g_list_last(XEN_TO_C_GList_(list))));
+ #define H_gtk_file_chooser_get_current_folder_uri "gchar* gtk_file_chooser_get_current_folder_uri(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_current_folder_uri", "GtkFileChooser*");
+ {
+ gchar* result;
+ Xen rtn;
+ result = gtk_file_chooser_get_current_folder_uri(Xen_to_C_GtkFileChooser_(chooser));
+ rtn = C_to_Xen_gchar_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_g_list_first(XEN list)
+static Xen gxg_gtk_file_chooser_set_preview_widget(Xen chooser, Xen preview_widget)
{
- #define H_g_list_first "GList* g_list_first(GList* list)"
- XEN_ASSERT_TYPE(XEN_GList__P(list), list, 1, "g_list_first", "GList*");
- return(C_TO_XEN_GList_(g_list_first(XEN_TO_C_GList_(list))));
+ #define H_gtk_file_chooser_set_preview_widget "void gtk_file_chooser_set_preview_widget(GtkFileChooser* chooser, \
+GtkWidget* preview_widget)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_preview_widget", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GtkWidget_(preview_widget), preview_widget, 2, "gtk_file_chooser_set_preview_widget", "GtkWidget*");
+ gtk_file_chooser_set_preview_widget(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GtkWidget_(preview_widget));
+ return(Xen_false);
}
-static XEN gxg_g_list_length(XEN list)
+static Xen gxg_gtk_file_chooser_get_preview_widget(Xen chooser)
{
- #define H_g_list_length "guint g_list_length(GList* list)"
- XEN_ASSERT_TYPE(XEN_GList__P(list) || XEN_FALSE_P(list), list, 1, "g_list_length", "GList*");
- return(C_TO_XEN_guint(g_list_length(XEN_TO_C_GList_(list))));
+ #define H_gtk_file_chooser_get_preview_widget "GtkWidget* gtk_file_chooser_get_preview_widget(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_preview_widget", "GtkFileChooser*");
+ return(C_to_Xen_GtkWidget_(gtk_file_chooser_get_preview_widget(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_g_free(XEN mem)
+static Xen gxg_gtk_file_chooser_set_preview_widget_active(Xen chooser, Xen active)
{
- #define H_g_free "void g_free(gpointer mem)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(mem), mem, 1, "g_free", "gpointer");
- g_free(XEN_TO_C_gpointer(mem));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_set_preview_widget_active "void gtk_file_chooser_set_preview_widget_active(GtkFileChooser* chooser, \
+gboolean active)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_preview_widget_active", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gboolean(active), active, 2, "gtk_file_chooser_set_preview_widget_active", "gboolean");
+ gtk_file_chooser_set_preview_widget_active(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gboolean(active));
+ return(Xen_false);
}
-static XEN gxg_g_list_remove_link(XEN list, XEN llink)
+static Xen gxg_gtk_file_chooser_get_preview_widget_active(Xen chooser)
{
- #define H_g_list_remove_link "GList* g_list_remove_link(GList* list, GList* llink)"
- XEN_ASSERT_TYPE(XEN_GList__P(list), list, 1, "g_list_remove_link", "GList*");
- XEN_ASSERT_TYPE(XEN_GList__P(llink), llink, 2, "g_list_remove_link", "GList*");
- return(C_TO_XEN_GList_(g_list_remove_link(XEN_TO_C_GList_(list), XEN_TO_C_GList_(llink))));
+ #define H_gtk_file_chooser_get_preview_widget_active "gboolean gtk_file_chooser_get_preview_widget_active(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_preview_widget_active", "GtkFileChooser*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_get_preview_widget_active(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_g_object_get_data(XEN object, XEN key)
+static Xen gxg_gtk_file_chooser_get_preview_filename(Xen file_chooser)
{
- #define H_g_object_get_data "gpointer g_object_get_data(GObject* object, gchar* key)"
- XEN_ASSERT_TYPE(XEN_GObject__P(object), object, 1, "g_object_get_data", "GObject*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "g_object_get_data", "gchar*");
- return(C_TO_XEN_gpointer(g_object_get_data(XEN_TO_C_GObject_(object), (const gchar*)XEN_TO_C_gchar_(key))));
+ #define H_gtk_file_chooser_get_preview_filename "char* gtk_file_chooser_get_preview_filename(GtkFileChooser* file_chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(file_chooser), file_chooser, 1, "gtk_file_chooser_get_preview_filename", "GtkFileChooser*");
+ {
+ char* result;
+ Xen rtn;
+ result = gtk_file_chooser_get_preview_filename(Xen_to_C_GtkFileChooser_(file_chooser));
+ rtn = C_to_Xen_char_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_g_object_set_data(XEN object, XEN key, XEN data)
+static Xen gxg_gtk_file_chooser_get_preview_uri(Xen file_chooser)
{
- #define H_g_object_set_data "void g_object_set_data(GObject* object, gchar* key, gpointer data)"
- XEN_ASSERT_TYPE(XEN_GObject__P(object), object, 1, "g_object_set_data", "GObject*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "g_object_set_data", "gchar*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 3, "g_object_set_data", "gpointer");
- g_object_set_data(XEN_TO_C_GObject_(object), (const gchar*)XEN_TO_C_gchar_(key), XEN_TO_C_gpointer(data));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_get_preview_uri "char* gtk_file_chooser_get_preview_uri(GtkFileChooser* file_chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(file_chooser), file_chooser, 1, "gtk_file_chooser_get_preview_uri", "GtkFileChooser*");
+ {
+ char* result;
+ Xen rtn;
+ result = gtk_file_chooser_get_preview_uri(Xen_to_C_GtkFileChooser_(file_chooser));
+ rtn = C_to_Xen_char_(result);
+ g_free(result);
+ return(rtn);
+ }
}
-static XEN gxg_gdk_cursor_new_from_pixbuf(XEN display, XEN pixbuf, XEN x, XEN y)
+static Xen gxg_gtk_file_chooser_set_extra_widget(Xen chooser, Xen extra_widget)
{
- #define H_gdk_cursor_new_from_pixbuf "GdkCursor* gdk_cursor_new_from_pixbuf(GdkDisplay* display, GdkPixbuf* pixbuf, \
-gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_cursor_new_from_pixbuf", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gdk_cursor_new_from_pixbuf", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 3, "gdk_cursor_new_from_pixbuf", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 4, "gdk_cursor_new_from_pixbuf", "gint");
- return(C_TO_XEN_GdkCursor_(gdk_cursor_new_from_pixbuf(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_gint(x),
- XEN_TO_C_gint(y))));
+ #define H_gtk_file_chooser_set_extra_widget "void gtk_file_chooser_set_extra_widget(GtkFileChooser* chooser, \
+GtkWidget* extra_widget)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_extra_widget", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GtkWidget_(extra_widget), extra_widget, 2, "gtk_file_chooser_set_extra_widget", "GtkWidget*");
+ gtk_file_chooser_set_extra_widget(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GtkWidget_(extra_widget));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_flush(XEN display)
+static Xen gxg_gtk_file_chooser_get_extra_widget(Xen chooser)
{
- #define H_gdk_display_flush "void gdk_display_flush(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_flush", "GdkDisplay*");
- gdk_display_flush(XEN_TO_C_GdkDisplay_(display));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_get_extra_widget "GtkWidget* gtk_file_chooser_get_extra_widget(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_extra_widget", "GtkFileChooser*");
+ return(C_to_Xen_GtkWidget_(gtk_file_chooser_get_extra_widget(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gdk_display_supports_cursor_alpha(XEN display)
+static Xen gxg_gtk_file_chooser_add_filter(Xen chooser, Xen filter)
{
- #define H_gdk_display_supports_cursor_alpha "gboolean gdk_display_supports_cursor_alpha(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_supports_cursor_alpha", "GdkDisplay*");
- return(C_TO_XEN_gboolean(gdk_display_supports_cursor_alpha(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_file_chooser_add_filter "void gtk_file_chooser_add_filter(GtkFileChooser* chooser, GtkFileFilter* filter)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_add_filter", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 2, "gtk_file_chooser_add_filter", "GtkFileFilter*");
+ gtk_file_chooser_add_filter(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GtkFileFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_supports_cursor_color(XEN display)
+static Xen gxg_gtk_file_chooser_remove_filter(Xen chooser, Xen filter)
{
- #define H_gdk_display_supports_cursor_color "gboolean gdk_display_supports_cursor_color(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_supports_cursor_color", "GdkDisplay*");
- return(C_TO_XEN_gboolean(gdk_display_supports_cursor_color(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_file_chooser_remove_filter "void gtk_file_chooser_remove_filter(GtkFileChooser* chooser, \
+GtkFileFilter* filter)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_remove_filter", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 2, "gtk_file_chooser_remove_filter", "GtkFileFilter*");
+ gtk_file_chooser_remove_filter(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GtkFileFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_get_default_cursor_size(XEN display)
+static Xen gxg_gtk_file_chooser_list_filters(Xen chooser)
{
- #define H_gdk_display_get_default_cursor_size "guint gdk_display_get_default_cursor_size(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_default_cursor_size", "GdkDisplay*");
- return(C_TO_XEN_guint(gdk_display_get_default_cursor_size(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_file_chooser_list_filters "GSList* gtk_file_chooser_list_filters(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_list_filters", "GtkFileChooser*");
+ return(C_to_Xen_GSList_(gtk_file_chooser_list_filters(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gdk_display_get_maximal_cursor_size(XEN display, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_file_chooser_set_filter(Xen chooser, Xen filter)
{
- #define H_gdk_display_get_maximal_cursor_size "void gdk_display_get_maximal_cursor_size(GdkDisplay* display, \
-guint* [width], guint* [height])"
- guint ref_width;
- guint ref_height;
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_maximal_cursor_size", "GdkDisplay*");
- gdk_display_get_maximal_cursor_size(XEN_TO_C_GdkDisplay_(display), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_guint(ref_width), C_TO_XEN_guint(ref_height)));
+ #define H_gtk_file_chooser_set_filter "void gtk_file_chooser_set_filter(GtkFileChooser* chooser, GtkFileFilter* filter)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_filter", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 2, "gtk_file_chooser_set_filter", "GtkFileFilter*");
+ gtk_file_chooser_set_filter(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GtkFileFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_keep_above(XEN window, XEN setting)
+static Xen gxg_gtk_file_chooser_get_filter(Xen chooser)
{
- #define H_gdk_window_set_keep_above "void gdk_window_set_keep_above(GdkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_keep_above", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gdk_window_set_keep_above", "gboolean");
- gdk_window_set_keep_above(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_get_filter "GtkFileFilter* gtk_file_chooser_get_filter(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_filter", "GtkFileChooser*");
+ return(C_to_Xen_GtkFileFilter_(gtk_file_chooser_get_filter(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gdk_window_set_keep_below(XEN window, XEN setting)
+static Xen gxg_gtk_file_chooser_add_shortcut_folder(Xen chooser, Xen folder, Xen ignore_error)
{
- #define H_gdk_window_set_keep_below "void gdk_window_set_keep_below(GdkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_keep_below", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gdk_window_set_keep_below", "gboolean");
- gdk_window_set_keep_below(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_add_shortcut_folder "gboolean gtk_file_chooser_add_shortcut_folder(GtkFileChooser* chooser, \
+char* folder, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_add_shortcut_folder", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(folder), folder, 2, "gtk_file_chooser_add_shortcut_folder", "char*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_file_chooser_add_shortcut_folder(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(folder),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_alignment_set_padding(XEN alignment, XEN padding_top, XEN padding_bottom, XEN padding_left, XEN padding_right)
+static Xen gxg_gtk_file_chooser_remove_shortcut_folder(Xen chooser, Xen folder, Xen ignore_error)
{
- #define H_gtk_alignment_set_padding "void gtk_alignment_set_padding(GtkAlignment* alignment, guint padding_top, \
-guint padding_bottom, guint padding_left, guint padding_right)"
- XEN_ASSERT_TYPE(XEN_GtkAlignment__P(alignment), alignment, 1, "gtk_alignment_set_padding", "GtkAlignment*");
- XEN_ASSERT_TYPE(XEN_guint_P(padding_top), padding_top, 2, "gtk_alignment_set_padding", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(padding_bottom), padding_bottom, 3, "gtk_alignment_set_padding", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(padding_left), padding_left, 4, "gtk_alignment_set_padding", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(padding_right), padding_right, 5, "gtk_alignment_set_padding", "guint");
- gtk_alignment_set_padding(XEN_TO_C_GtkAlignment_(alignment), XEN_TO_C_guint(padding_top), XEN_TO_C_guint(padding_bottom),
- XEN_TO_C_guint(padding_left), XEN_TO_C_guint(padding_right));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_remove_shortcut_folder "gboolean gtk_file_chooser_remove_shortcut_folder(GtkFileChooser* chooser, \
+char* folder, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_remove_shortcut_folder", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(folder), folder, 2, "gtk_file_chooser_remove_shortcut_folder", "char*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_file_chooser_remove_shortcut_folder(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(folder),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_alignment_get_padding(XEN alignment, XEN ignore_padding_top, XEN ignore_padding_bottom, XEN ignore_padding_left, XEN ignore_padding_right)
+static Xen gxg_gtk_file_chooser_list_shortcut_folders(Xen chooser)
{
- #define H_gtk_alignment_get_padding "void gtk_alignment_get_padding(GtkAlignment* alignment, guint* [padding_top], \
-guint* [padding_bottom], guint* [padding_left], guint* [padding_right])"
- guint ref_padding_top;
- guint ref_padding_bottom;
- guint ref_padding_left;
- guint ref_padding_right;
- XEN_ASSERT_TYPE(XEN_GtkAlignment__P(alignment), alignment, 1, "gtk_alignment_get_padding", "GtkAlignment*");
- gtk_alignment_get_padding(XEN_TO_C_GtkAlignment_(alignment), &ref_padding_top, &ref_padding_bottom, &ref_padding_left,
- &ref_padding_right);
- return(XEN_LIST_4(C_TO_XEN_guint(ref_padding_top), C_TO_XEN_guint(ref_padding_bottom), C_TO_XEN_guint(ref_padding_left), C_TO_XEN_guint(ref_padding_right)));
+ #define H_gtk_file_chooser_list_shortcut_folders "GSList* gtk_file_chooser_list_shortcut_folders(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_list_shortcut_folders", "GtkFileChooser*");
+ return(C_to_Xen_GSList_(gtk_file_chooser_list_shortcut_folders(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_button_box_get_child_secondary(XEN widget, XEN child)
+static Xen gxg_gtk_file_chooser_add_shortcut_folder_uri(Xen chooser, Xen folder, Xen ignore_error)
{
- #define H_gtk_button_box_get_child_secondary "gboolean gtk_button_box_get_child_secondary(GtkButtonBox* widget, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkButtonBox__P(widget), widget, 1, "gtk_button_box_get_child_secondary", "GtkButtonBox*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_button_box_get_child_secondary", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_button_box_get_child_secondary(XEN_TO_C_GtkButtonBox_(widget), XEN_TO_C_GtkWidget_(child))));
+ #define H_gtk_file_chooser_add_shortcut_folder_uri "gboolean gtk_file_chooser_add_shortcut_folder_uri(GtkFileChooser* chooser, \
+char* folder, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_add_shortcut_folder_uri", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(folder), folder, 2, "gtk_file_chooser_add_shortcut_folder_uri", "char*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_file_chooser_add_shortcut_folder_uri(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(folder),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_button_set_focus_on_click(XEN button, XEN focus_on_click)
+static Xen gxg_gtk_file_chooser_remove_shortcut_folder_uri(Xen chooser, Xen folder, Xen ignore_error)
{
- #define H_gtk_button_set_focus_on_click "void gtk_button_set_focus_on_click(GtkButton* button, gboolean focus_on_click)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_set_focus_on_click", "GtkButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(focus_on_click), focus_on_click, 2, "gtk_button_set_focus_on_click", "gboolean");
- gtk_button_set_focus_on_click(XEN_TO_C_GtkButton_(button), XEN_TO_C_gboolean(focus_on_click));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_remove_shortcut_folder_uri "gboolean gtk_file_chooser_remove_shortcut_folder_uri(GtkFileChooser* chooser, \
+char* folder, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_remove_shortcut_folder_uri", "GtkFileChooser*");
+ Xen_check_type(Xen_is_char_(folder), folder, 2, "gtk_file_chooser_remove_shortcut_folder_uri", "char*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_file_chooser_remove_shortcut_folder_uri(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_char_(folder),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_button_get_focus_on_click(XEN button)
+static Xen gxg_gtk_file_chooser_list_shortcut_folder_uris(Xen chooser)
{
- #define H_gtk_button_get_focus_on_click "gboolean gtk_button_get_focus_on_click(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_focus_on_click", "GtkButton*");
- return(C_TO_XEN_gboolean(gtk_button_get_focus_on_click(XEN_TO_C_GtkButton_(button))));
+ #define H_gtk_file_chooser_list_shortcut_folder_uris "GSList* gtk_file_chooser_list_shortcut_folder_uris(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_list_shortcut_folder_uris", "GtkFileChooser*");
+ return(C_to_Xen_GSList_(gtk_file_chooser_list_shortcut_folder_uris(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_calendar_set_display_options(XEN calendar, XEN flags)
+static Xen gxg_gtk_icon_theme_new(void)
{
- #define H_gtk_calendar_set_display_options "void gtk_calendar_set_display_options(GtkCalendar* calendar, \
-GtkCalendarDisplayOptions flags)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_set_display_options", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_GtkCalendarDisplayOptions_P(flags), flags, 2, "gtk_calendar_set_display_options", "GtkCalendarDisplayOptions");
- gtk_calendar_set_display_options(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_GtkCalendarDisplayOptions(flags));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_new "GtkIconTheme* gtk_icon_theme_new( void)"
+ return(C_to_Xen_GtkIconTheme_(gtk_icon_theme_new()));
}
-static XEN gxg_gtk_calendar_get_display_options(XEN calendar)
+static Xen gxg_gtk_icon_theme_get_default(void)
{
- #define H_gtk_calendar_get_display_options "GtkCalendarDisplayOptions gtk_calendar_get_display_options(GtkCalendar* calendar)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_get_display_options", "GtkCalendar*");
- return(C_TO_XEN_GtkCalendarDisplayOptions(gtk_calendar_get_display_options(XEN_TO_C_GtkCalendar_(calendar))));
+ #define H_gtk_icon_theme_get_default "GtkIconTheme* gtk_icon_theme_get_default( void)"
+ return(C_to_Xen_GtkIconTheme_(gtk_icon_theme_get_default()));
}
-static XEN gxg_gtk_check_menu_item_set_draw_as_radio(XEN check_menu_item, XEN draw_as_radio)
+static Xen gxg_gtk_icon_theme_get_for_screen(Xen screen)
{
- #define H_gtk_check_menu_item_set_draw_as_radio "void gtk_check_menu_item_set_draw_as_radio(GtkCheckMenuItem* check_menu_item, \
-gboolean draw_as_radio)"
- XEN_ASSERT_TYPE(XEN_GtkCheckMenuItem__P(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_set_draw_as_radio", "GtkCheckMenuItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(draw_as_radio), draw_as_radio, 2, "gtk_check_menu_item_set_draw_as_radio", "gboolean");
- gtk_check_menu_item_set_draw_as_radio(XEN_TO_C_GtkCheckMenuItem_(check_menu_item), XEN_TO_C_gboolean(draw_as_radio));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_get_for_screen "GtkIconTheme* gtk_icon_theme_get_for_screen(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gtk_icon_theme_get_for_screen", "GdkScreen*");
+ return(C_to_Xen_GtkIconTheme_(gtk_icon_theme_get_for_screen(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_gtk_check_menu_item_get_draw_as_radio(XEN check_menu_item)
+static Xen gxg_gtk_icon_theme_set_screen(Xen icon_theme, Xen screen)
{
- #define H_gtk_check_menu_item_get_draw_as_radio "gboolean gtk_check_menu_item_get_draw_as_radio(GtkCheckMenuItem* check_menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkCheckMenuItem__P(check_menu_item), check_menu_item, 1, "gtk_check_menu_item_get_draw_as_radio", "GtkCheckMenuItem*");
- return(C_TO_XEN_gboolean(gtk_check_menu_item_get_draw_as_radio(XEN_TO_C_GtkCheckMenuItem_(check_menu_item))));
+ #define H_gtk_icon_theme_set_screen "void gtk_icon_theme_set_screen(GtkIconTheme* icon_theme, GdkScreen* screen)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_set_screen", "GtkIconTheme*");
+ Xen_check_type(Xen_is_GdkScreen_(screen) || Xen_is_false(screen), screen, 2, "gtk_icon_theme_set_screen", "GdkScreen*");
+ gtk_icon_theme_set_screen(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_GdkScreen_(screen));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_completion(XEN entry, XEN completion)
+static Xen gxg_gtk_icon_theme_get_search_path(Xen icon_theme, Xen ignore_path, Xen ignore_n_elements)
{
- #define H_gtk_entry_set_completion "void gtk_entry_set_completion(GtkEntry* entry, GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_completion", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 2, "gtk_entry_set_completion", "GtkEntryCompletion*");
- gtk_entry_set_completion(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryCompletion_(completion));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_get_search_path "void gtk_icon_theme_get_search_path(GtkIconTheme* icon_theme, \
+gchar*** [path], gint* [n_elements])"
+ gchar** ref_path = NULL;
+ gint ref_n_elements;
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_get_search_path", "GtkIconTheme*");
+ gtk_icon_theme_get_search_path(Xen_to_C_GtkIconTheme_(icon_theme), &ref_path, &ref_n_elements);
+ return(Xen_list_2(C_to_Xen_gchar__(ref_path), C_to_Xen_gint(ref_n_elements)));
}
-static XEN gxg_gtk_entry_get_completion(XEN entry)
+static Xen gxg_gtk_icon_theme_append_search_path(Xen icon_theme, Xen path)
{
- #define H_gtk_entry_get_completion "GtkEntryCompletion* gtk_entry_get_completion(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_completion", "GtkEntry*");
- return(C_TO_XEN_GtkEntryCompletion_(gtk_entry_get_completion(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gtk_icon_theme_append_search_path "void gtk_icon_theme_append_search_path(GtkIconTheme* icon_theme, \
+gchar* path)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_append_search_path", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(path), path, 2, "gtk_icon_theme_append_search_path", "gchar*");
+ gtk_icon_theme_append_search_path(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_gchar_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_event_box_get_visible_window(XEN event_box)
+static Xen gxg_gtk_icon_theme_prepend_search_path(Xen icon_theme, Xen path)
{
- #define H_gtk_event_box_get_visible_window "gboolean gtk_event_box_get_visible_window(GtkEventBox* event_box)"
- XEN_ASSERT_TYPE(XEN_GtkEventBox__P(event_box), event_box, 1, "gtk_event_box_get_visible_window", "GtkEventBox*");
- return(C_TO_XEN_gboolean(gtk_event_box_get_visible_window(XEN_TO_C_GtkEventBox_(event_box))));
+ #define H_gtk_icon_theme_prepend_search_path "void gtk_icon_theme_prepend_search_path(GtkIconTheme* icon_theme, \
+gchar* path)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_prepend_search_path", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(path), path, 2, "gtk_icon_theme_prepend_search_path", "gchar*");
+ gtk_icon_theme_prepend_search_path(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_gchar_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_event_box_set_visible_window(XEN event_box, XEN visible_window)
+static Xen gxg_gtk_icon_theme_set_custom_theme(Xen icon_theme, Xen theme_name)
{
- #define H_gtk_event_box_set_visible_window "void gtk_event_box_set_visible_window(GtkEventBox* event_box, \
-gboolean visible_window)"
- XEN_ASSERT_TYPE(XEN_GtkEventBox__P(event_box), event_box, 1, "gtk_event_box_set_visible_window", "GtkEventBox*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible_window), visible_window, 2, "gtk_event_box_set_visible_window", "gboolean");
- gtk_event_box_set_visible_window(XEN_TO_C_GtkEventBox_(event_box), XEN_TO_C_gboolean(visible_window));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_set_custom_theme "void gtk_icon_theme_set_custom_theme(GtkIconTheme* icon_theme, \
+gchar* theme_name)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_set_custom_theme", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(theme_name), theme_name, 2, "gtk_icon_theme_set_custom_theme", "gchar*");
+ gtk_icon_theme_set_custom_theme(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_gchar_(theme_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_event_box_get_above_child(XEN event_box)
+static Xen gxg_gtk_icon_theme_has_icon(Xen icon_theme, Xen icon_name)
{
- #define H_gtk_event_box_get_above_child "gboolean gtk_event_box_get_above_child(GtkEventBox* event_box)"
- XEN_ASSERT_TYPE(XEN_GtkEventBox__P(event_box), event_box, 1, "gtk_event_box_get_above_child", "GtkEventBox*");
- return(C_TO_XEN_gboolean(gtk_event_box_get_above_child(XEN_TO_C_GtkEventBox_(event_box))));
+ #define H_gtk_icon_theme_has_icon "gboolean gtk_icon_theme_has_icon(GtkIconTheme* icon_theme, gchar* icon_name)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_has_icon", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_icon_theme_has_icon", "gchar*");
+ return(C_to_Xen_gboolean(gtk_icon_theme_has_icon(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_gchar_(icon_name))));
}
-static XEN gxg_gtk_event_box_set_above_child(XEN event_box, XEN above_child)
+static Xen gxg_gtk_icon_theme_lookup_icon(Xen icon_theme, Xen icon_name, Xen size, Xen flags)
{
- #define H_gtk_event_box_set_above_child "void gtk_event_box_set_above_child(GtkEventBox* event_box, \
-gboolean above_child)"
- XEN_ASSERT_TYPE(XEN_GtkEventBox__P(event_box), event_box, 1, "gtk_event_box_set_above_child", "GtkEventBox*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(above_child), above_child, 2, "gtk_event_box_set_above_child", "gboolean");
- gtk_event_box_set_above_child(XEN_TO_C_GtkEventBox_(event_box), XEN_TO_C_gboolean(above_child));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_lookup_icon "GtkIconInfo* gtk_icon_theme_lookup_icon(GtkIconTheme* icon_theme, \
+gchar* icon_name, gint size, GtkIconLookupFlags flags)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_lookup_icon", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_icon_theme_lookup_icon", "gchar*");
+ Xen_check_type(Xen_is_gint(size), size, 3, "gtk_icon_theme_lookup_icon", "gint");
+ Xen_check_type(Xen_is_GtkIconLookupFlags(flags), flags, 4, "gtk_icon_theme_lookup_icon", "GtkIconLookupFlags");
+ return(C_to_Xen_GtkIconInfo_(gtk_icon_theme_lookup_icon(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_gchar_(icon_name),
+ Xen_to_C_gint(size), Xen_to_C_GtkIconLookupFlags(flags))));
}
-static XEN gxg_gtk_icon_source_get_icon_name(XEN source)
+static Xen gxg_gtk_icon_theme_load_icon(Xen icon_theme, Xen icon_name, Xen size, Xen flags, Xen ignore_error)
{
- #define H_gtk_icon_source_get_icon_name "gchar* gtk_icon_source_get_icon_name(GtkIconSource* source)"
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 1, "gtk_icon_source_get_icon_name", "GtkIconSource*");
- return(C_TO_XEN_gchar_(gtk_icon_source_get_icon_name(XEN_TO_C_GtkIconSource_(source))));
+ #define H_gtk_icon_theme_load_icon "GdkPixbuf* gtk_icon_theme_load_icon(GtkIconTheme* icon_theme, gchar* icon_name, \
+gint size, GtkIconLookupFlags flags, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_load_icon", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_icon_theme_load_icon", "gchar*");
+ Xen_check_type(Xen_is_gint(size), size, 3, "gtk_icon_theme_load_icon", "gint");
+ Xen_check_type(Xen_is_GtkIconLookupFlags(flags), flags, 4, "gtk_icon_theme_load_icon", "GtkIconLookupFlags");
+ {
+ Xen result;
+ result = C_to_Xen_GdkPixbuf_(gtk_icon_theme_load_icon(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_gchar_(icon_name),
+ Xen_to_C_gint(size), Xen_to_C_GtkIconLookupFlags(flags), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_menu_attach(XEN menu, XEN child, XEN left_attach, XEN right_attach, XEN top_attach, XEN bottom_attach)
+static Xen gxg_gtk_icon_theme_list_icons(Xen icon_theme, Xen context)
{
- #define H_gtk_menu_attach "void gtk_menu_attach(GtkMenu* menu, GtkWidget* child, guint left_attach, \
-guint right_attach, guint top_attach, guint bottom_attach)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_attach", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_menu_attach", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_guint_P(left_attach), left_attach, 3, "gtk_menu_attach", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(right_attach), right_attach, 4, "gtk_menu_attach", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(top_attach), top_attach, 5, "gtk_menu_attach", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(bottom_attach), bottom_attach, 6, "gtk_menu_attach", "guint");
- gtk_menu_attach(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_GtkWidget_(child), XEN_TO_C_guint(left_attach), XEN_TO_C_guint(right_attach),
- XEN_TO_C_guint(top_attach), XEN_TO_C_guint(bottom_attach));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_list_icons "GList* gtk_icon_theme_list_icons(GtkIconTheme* icon_theme, gchar* context)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_list_icons", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(context), context, 2, "gtk_icon_theme_list_icons", "gchar*");
+ return(C_to_Xen_GList_(gtk_icon_theme_list_icons(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_gchar_(context))));
}
-static XEN gxg_gtk_text_buffer_select_range(XEN buffer, XEN ins, XEN bound)
+static Xen gxg_gtk_icon_theme_get_example_icon_name(Xen icon_theme)
{
- #define H_gtk_text_buffer_select_range "void gtk_text_buffer_select_range(GtkTextBuffer* buffer, GtkTextIter* ins, \
-GtkTextIter* bound)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_select_range", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(ins), ins, 2, "gtk_text_buffer_select_range", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(bound), bound, 3, "gtk_text_buffer_select_range", "GtkTextIter*");
- gtk_text_buffer_select_range(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(ins), XEN_TO_C_GtkTextIter_(bound));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_get_example_icon_name "char* gtk_icon_theme_get_example_icon_name(GtkIconTheme* icon_theme)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_get_example_icon_name", "GtkIconTheme*");
+ return(C_to_Xen_char_(gtk_icon_theme_get_example_icon_name(Xen_to_C_GtkIconTheme_(icon_theme))));
}
-static XEN gxg_gtk_text_view_set_overwrite(XEN text_view, XEN overwrite)
+static Xen gxg_gtk_icon_theme_rescan_if_needed(Xen icon_theme)
{
- #define H_gtk_text_view_set_overwrite "void gtk_text_view_set_overwrite(GtkTextView* text_view, gboolean overwrite)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_overwrite", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(overwrite), overwrite, 2, "gtk_text_view_set_overwrite", "gboolean");
- gtk_text_view_set_overwrite(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gboolean(overwrite));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_rescan_if_needed "gboolean gtk_icon_theme_rescan_if_needed(GtkIconTheme* icon_theme)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_rescan_if_needed", "GtkIconTheme*");
+ return(C_to_Xen_gboolean(gtk_icon_theme_rescan_if_needed(Xen_to_C_GtkIconTheme_(icon_theme))));
}
-static XEN gxg_gtk_text_view_get_overwrite(XEN text_view)
+static Xen gxg_gtk_icon_info_get_base_size(Xen icon_info)
{
- #define H_gtk_text_view_get_overwrite "gboolean gtk_text_view_get_overwrite(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_overwrite", "GtkTextView*");
- return(C_TO_XEN_gboolean(gtk_text_view_get_overwrite(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_icon_info_get_base_size "gint gtk_icon_info_get_base_size(GtkIconInfo* icon_info)"
+ Xen_check_type(Xen_is_GtkIconInfo_(icon_info), icon_info, 1, "gtk_icon_info_get_base_size", "GtkIconInfo*");
+ return(C_to_Xen_gint(gtk_icon_info_get_base_size(Xen_to_C_GtkIconInfo_(icon_info))));
}
-static XEN gxg_gtk_text_view_set_accepts_tab(XEN text_view, XEN accepts_tab)
+static Xen gxg_gtk_icon_info_get_filename(Xen icon_info)
{
- #define H_gtk_text_view_set_accepts_tab "void gtk_text_view_set_accepts_tab(GtkTextView* text_view, \
-gboolean accepts_tab)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_set_accepts_tab", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(accepts_tab), accepts_tab, 2, "gtk_text_view_set_accepts_tab", "gboolean");
- gtk_text_view_set_accepts_tab(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_gboolean(accepts_tab));
- return(XEN_FALSE);
+ #define H_gtk_icon_info_get_filename "gchar* gtk_icon_info_get_filename(GtkIconInfo* icon_info)"
+ Xen_check_type(Xen_is_GtkIconInfo_(icon_info), icon_info, 1, "gtk_icon_info_get_filename", "GtkIconInfo*");
+ return(C_to_Xen_gchar_(gtk_icon_info_get_filename(Xen_to_C_GtkIconInfo_(icon_info))));
}
-static XEN gxg_gtk_text_view_get_accepts_tab(XEN text_view)
+static Xen gxg_gtk_icon_info_load_icon(Xen icon_info, Xen ignore_error)
{
- #define H_gtk_text_view_get_accepts_tab "gboolean gtk_text_view_get_accepts_tab(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_accepts_tab", "GtkTextView*");
- return(C_TO_XEN_gboolean(gtk_text_view_get_accepts_tab(XEN_TO_C_GtkTextView_(text_view))));
+ #define H_gtk_icon_info_load_icon "GdkPixbuf* gtk_icon_info_load_icon(GtkIconInfo* icon_info, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkIconInfo_(icon_info), icon_info, 1, "gtk_icon_info_load_icon", "GtkIconInfo*");
+ {
+ Xen result;
+ result = C_to_Xen_GdkPixbuf_(gtk_icon_info_load_icon(Xen_to_C_GtkIconInfo_(icon_info), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_toolbar_insert(XEN toolbar, XEN item, XEN pos)
+static Xen gxg_gtk_tool_button_new(Xen icon_widget, Xen label)
{
- #define H_gtk_toolbar_insert "void gtk_toolbar_insert(GtkToolbar* toolbar, GtkToolItem* item, gint pos)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_insert", "GtkToolbar*");
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(item), item, 2, "gtk_toolbar_insert", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gint_P(pos), pos, 3, "gtk_toolbar_insert", "gint");
- gtk_toolbar_insert(XEN_TO_C_GtkToolbar_(toolbar), XEN_TO_C_GtkToolItem_(item), XEN_TO_C_gint(pos));
- return(XEN_FALSE);
+ #define H_gtk_tool_button_new "GtkToolItem* gtk_tool_button_new(GtkWidget* icon_widget, gchar* label)"
+ Xen_check_type(Xen_is_GtkWidget_(icon_widget) || Xen_is_false(icon_widget), icon_widget, 1, "gtk_tool_button_new", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_tool_button_new", "gchar*");
+ return(C_to_Xen_GtkToolItem_(gtk_tool_button_new(Xen_to_C_GtkWidget_(icon_widget), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_toolbar_get_item_index(XEN toolbar, XEN item)
+static Xen gxg_gtk_tool_button_set_label(Xen button, Xen label)
{
- #define H_gtk_toolbar_get_item_index "gint gtk_toolbar_get_item_index(GtkToolbar* toolbar, GtkToolItem* item)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_get_item_index", "GtkToolbar*");
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(item), item, 2, "gtk_toolbar_get_item_index", "GtkToolItem*");
- return(C_TO_XEN_gint(gtk_toolbar_get_item_index(XEN_TO_C_GtkToolbar_(toolbar), XEN_TO_C_GtkToolItem_(item))));
+ #define H_gtk_tool_button_set_label "void gtk_tool_button_set_label(GtkToolButton* button, gchar* label)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_set_label", "GtkToolButton*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_tool_button_set_label", "gchar*");
+ gtk_tool_button_set_label(Xen_to_C_GtkToolButton_(button), Xen_to_C_gchar_(label));
+ return(Xen_false);
}
-static XEN gxg_gtk_toolbar_get_n_items(XEN toolbar)
+static Xen gxg_gtk_tool_button_get_label(Xen button)
{
- #define H_gtk_toolbar_get_n_items "gint gtk_toolbar_get_n_items(GtkToolbar* toolbar)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_get_n_items", "GtkToolbar*");
- return(C_TO_XEN_gint(gtk_toolbar_get_n_items(XEN_TO_C_GtkToolbar_(toolbar))));
+ #define H_gtk_tool_button_get_label "gchar* gtk_tool_button_get_label(GtkToolButton* button)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_get_label", "GtkToolButton*");
+ return(C_to_Xen_gchar_(gtk_tool_button_get_label(Xen_to_C_GtkToolButton_(button))));
}
-static XEN gxg_gtk_toolbar_get_nth_item(XEN toolbar, XEN n)
+static Xen gxg_gtk_tool_button_set_use_underline(Xen button, Xen use_underline)
{
- #define H_gtk_toolbar_get_nth_item "GtkToolItem* gtk_toolbar_get_nth_item(GtkToolbar* toolbar, gint n)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_get_nth_item", "GtkToolbar*");
- XEN_ASSERT_TYPE(XEN_gint_P(n), n, 2, "gtk_toolbar_get_nth_item", "gint");
- return(C_TO_XEN_GtkToolItem_(gtk_toolbar_get_nth_item(XEN_TO_C_GtkToolbar_(toolbar), XEN_TO_C_gint(n))));
+ #define H_gtk_tool_button_set_use_underline "void gtk_tool_button_set_use_underline(GtkToolButton* button, \
+gboolean use_underline)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_set_use_underline", "GtkToolButton*");
+ Xen_check_type(Xen_is_gboolean(use_underline), use_underline, 2, "gtk_tool_button_set_use_underline", "gboolean");
+ gtk_tool_button_set_use_underline(Xen_to_C_GtkToolButton_(button), Xen_to_C_gboolean(use_underline));
+ return(Xen_false);
}
-static XEN gxg_gtk_toolbar_set_show_arrow(XEN toolbar, XEN show_arrow)
+static Xen gxg_gtk_tool_button_get_use_underline(Xen button)
{
- #define H_gtk_toolbar_set_show_arrow "void gtk_toolbar_set_show_arrow(GtkToolbar* toolbar, gboolean show_arrow)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_set_show_arrow", "GtkToolbar*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_arrow), show_arrow, 2, "gtk_toolbar_set_show_arrow", "gboolean");
- gtk_toolbar_set_show_arrow(XEN_TO_C_GtkToolbar_(toolbar), XEN_TO_C_gboolean(show_arrow));
- return(XEN_FALSE);
+ #define H_gtk_tool_button_get_use_underline "gboolean gtk_tool_button_get_use_underline(GtkToolButton* button)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_get_use_underline", "GtkToolButton*");
+ return(C_to_Xen_gboolean(gtk_tool_button_get_use_underline(Xen_to_C_GtkToolButton_(button))));
}
-static XEN gxg_gtk_toolbar_get_show_arrow(XEN toolbar)
+static Xen gxg_gtk_tool_button_set_icon_widget(Xen button, Xen icon_widget)
{
- #define H_gtk_toolbar_get_show_arrow "gboolean gtk_toolbar_get_show_arrow(GtkToolbar* toolbar)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_get_show_arrow", "GtkToolbar*");
- return(C_TO_XEN_gboolean(gtk_toolbar_get_show_arrow(XEN_TO_C_GtkToolbar_(toolbar))));
+ #define H_gtk_tool_button_set_icon_widget "void gtk_tool_button_set_icon_widget(GtkToolButton* button, \
+GtkWidget* icon_widget)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_set_icon_widget", "GtkToolButton*");
+ Xen_check_type(Xen_is_GtkWidget_(icon_widget) || Xen_is_false(icon_widget), icon_widget, 2, "gtk_tool_button_set_icon_widget", "GtkWidget*");
+ gtk_tool_button_set_icon_widget(Xen_to_C_GtkToolButton_(button), Xen_to_C_GtkWidget_(icon_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_toolbar_get_relief_style(XEN toolbar)
+static Xen gxg_gtk_tool_button_get_icon_widget(Xen button)
{
- #define H_gtk_toolbar_get_relief_style "GtkReliefStyle gtk_toolbar_get_relief_style(GtkToolbar* toolbar)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_get_relief_style", "GtkToolbar*");
- return(C_TO_XEN_GtkReliefStyle(gtk_toolbar_get_relief_style(XEN_TO_C_GtkToolbar_(toolbar))));
+ #define H_gtk_tool_button_get_icon_widget "GtkWidget* gtk_tool_button_get_icon_widget(GtkToolButton* button)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_get_icon_widget", "GtkToolButton*");
+ return(C_to_Xen_GtkWidget_(gtk_tool_button_get_icon_widget(Xen_to_C_GtkToolButton_(button))));
}
-static XEN gxg_gtk_toolbar_get_drop_index(XEN toolbar, XEN x, XEN y)
+static Xen gxg_gtk_tool_button_set_label_widget(Xen button, Xen label_widget)
{
- #define H_gtk_toolbar_get_drop_index "gint gtk_toolbar_get_drop_index(GtkToolbar* toolbar, gint x, \
-gint y)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_get_drop_index", "GtkToolbar*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_toolbar_get_drop_index", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_toolbar_get_drop_index", "gint");
- return(C_TO_XEN_gint(gtk_toolbar_get_drop_index(XEN_TO_C_GtkToolbar_(toolbar), XEN_TO_C_gint(x), XEN_TO_C_gint(y))));
+ #define H_gtk_tool_button_set_label_widget "void gtk_tool_button_set_label_widget(GtkToolButton* button, \
+GtkWidget* label_widget)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_set_label_widget", "GtkToolButton*");
+ Xen_check_type(Xen_is_GtkWidget_(label_widget) || Xen_is_false(label_widget), label_widget, 2, "gtk_tool_button_set_label_widget", "GtkWidget*");
+ gtk_tool_button_set_label_widget(Xen_to_C_GtkToolButton_(button), Xen_to_C_GtkWidget_(label_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_set_expand(XEN tree_column, XEN expand)
+static Xen gxg_gtk_tool_button_get_label_widget(Xen button)
{
- #define H_gtk_tree_view_column_set_expand "void gtk_tree_view_column_set_expand(GtkTreeViewColumn* tree_column, \
-gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_set_expand", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 2, "gtk_tree_view_column_set_expand", "gboolean");
- gtk_tree_view_column_set_expand(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_gtk_tool_button_get_label_widget "GtkWidget* gtk_tool_button_get_label_widget(GtkToolButton* button)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_get_label_widget", "GtkToolButton*");
+ return(C_to_Xen_GtkWidget_(gtk_tool_button_get_label_widget(Xen_to_C_GtkToolButton_(button))));
}
-static XEN gxg_gtk_tree_view_column_get_expand(XEN tree_column)
+static Xen gxg_gtk_tool_item_new(void)
{
- #define H_gtk_tree_view_column_get_expand "gboolean gtk_tree_view_column_get_expand(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_expand", "GtkTreeViewColumn*");
- return(C_TO_XEN_gboolean(gtk_tree_view_column_get_expand(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_tool_item_new "GtkToolItem* gtk_tool_item_new( void)"
+ return(C_to_Xen_GtkToolItem_(gtk_tool_item_new()));
}
-static XEN gxg_gtk_widget_set_no_show_all(XEN widget, XEN no_show_all)
+static Xen gxg_gtk_tool_item_set_homogeneous(Xen tool_item, Xen homogeneous)
{
- #define H_gtk_widget_set_no_show_all "void gtk_widget_set_no_show_all(GtkWidget* widget, gboolean no_show_all)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_no_show_all", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(no_show_all), no_show_all, 2, "gtk_widget_set_no_show_all", "gboolean");
- gtk_widget_set_no_show_all(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(no_show_all));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_set_homogeneous "void gtk_tool_item_set_homogeneous(GtkToolItem* tool_item, \
+gboolean homogeneous)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_set_homogeneous", "GtkToolItem*");
+ Xen_check_type(Xen_is_gboolean(homogeneous), homogeneous, 2, "gtk_tool_item_set_homogeneous", "gboolean");
+ gtk_tool_item_set_homogeneous(Xen_to_C_GtkToolItem_(tool_item), Xen_to_C_gboolean(homogeneous));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_no_show_all(XEN widget)
+static Xen gxg_gtk_tool_item_get_homogeneous(Xen tool_item)
{
- #define H_gtk_widget_get_no_show_all "gboolean gtk_widget_get_no_show_all(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_no_show_all", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_no_show_all(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_tool_item_get_homogeneous "gboolean gtk_tool_item_get_homogeneous(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_homogeneous", "GtkToolItem*");
+ return(C_to_Xen_gboolean(gtk_tool_item_get_homogeneous(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_widget_queue_resize_no_redraw(XEN widget)
+static Xen gxg_gtk_tool_item_set_expand(Xen tool_item, Xen expand)
{
- #define H_gtk_widget_queue_resize_no_redraw "void gtk_widget_queue_resize_no_redraw(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_queue_resize_no_redraw", "GtkWidget*");
- gtk_widget_queue_resize_no_redraw(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_set_expand "void gtk_tool_item_set_expand(GtkToolItem* tool_item, gboolean expand)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_set_expand", "GtkToolItem*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 2, "gtk_tool_item_set_expand", "gboolean");
+ gtk_tool_item_set_expand(Xen_to_C_GtkToolItem_(tool_item), Xen_to_C_gboolean(expand));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_default_icon(XEN icon)
+static Xen gxg_gtk_tool_item_get_expand(Xen tool_item)
{
- #define H_gtk_window_set_default_icon "void gtk_window_set_default_icon(GdkPixbuf* icon)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(icon), icon, 1, "gtk_window_set_default_icon", "GdkPixbuf*");
- gtk_window_set_default_icon(XEN_TO_C_GdkPixbuf_(icon));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_get_expand "gboolean gtk_tool_item_get_expand(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_expand", "GtkToolItem*");
+ return(C_to_Xen_gboolean(gtk_tool_item_get_expand(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_window_set_keep_above(XEN window, XEN setting)
+static Xen gxg_gtk_tool_item_set_use_drag_window(Xen toolitem, Xen use_drag_window)
{
- #define H_gtk_window_set_keep_above "void gtk_window_set_keep_above(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_keep_above", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_keep_above", "gboolean");
- gtk_window_set_keep_above(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_set_use_drag_window "void gtk_tool_item_set_use_drag_window(GtkToolItem* toolitem, \
+gboolean use_drag_window)"
+ Xen_check_type(Xen_is_GtkToolItem_(toolitem), toolitem, 1, "gtk_tool_item_set_use_drag_window", "GtkToolItem*");
+ Xen_check_type(Xen_is_gboolean(use_drag_window), use_drag_window, 2, "gtk_tool_item_set_use_drag_window", "gboolean");
+ gtk_tool_item_set_use_drag_window(Xen_to_C_GtkToolItem_(toolitem), Xen_to_C_gboolean(use_drag_window));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_keep_below(XEN window, XEN setting)
+static Xen gxg_gtk_tool_item_get_use_drag_window(Xen toolitem)
{
- #define H_gtk_window_set_keep_below "void gtk_window_set_keep_below(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_keep_below", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_keep_below", "gboolean");
- gtk_window_set_keep_below(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_get_use_drag_window "gboolean gtk_tool_item_get_use_drag_window(GtkToolItem* toolitem)"
+ Xen_check_type(Xen_is_GtkToolItem_(toolitem), toolitem, 1, "gtk_tool_item_get_use_drag_window", "GtkToolItem*");
+ return(C_to_Xen_gboolean(gtk_tool_item_get_use_drag_window(Xen_to_C_GtkToolItem_(toolitem))));
}
-static XEN gxg_gtk_file_chooser_dialog_new(XEN title, XEN parent, XEN action, XEN buttons)
+static Xen gxg_gtk_tool_item_set_visible_horizontal(Xen toolitem, Xen visible_horizontal)
{
- #define H_gtk_file_chooser_dialog_new "GtkWidget* gtk_file_chooser_dialog_new(gchar* title, GtkWindow* parent, \
-GtkFileChooserAction action, etc buttons)"
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 1, "gtk_file_chooser_dialog_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(parent) || XEN_FALSE_P(parent), parent, 2, "gtk_file_chooser_dialog_new", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkFileChooserAction_P(action), action, 3, "gtk_file_chooser_dialog_new", "GtkFileChooserAction");
- if (XEN_NOT_BOUND_P(buttons)) buttons = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_etc_P(buttons), buttons, 4, "gtk_file_chooser_dialog_new", "etc");
- {
- int etc_len = 0;
- GtkWidget* result = NULL;
- gchar* p_arg0;
- GtkWindow* p_arg1;
- GtkFileChooserAction p_arg2;
- if (XEN_LIST_P(buttons)) etc_len = XEN_LIST_LENGTH(buttons);
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_file_chooser_dialog_new", 3, buttons, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_file_chooser_dialog_new", 3, buttons, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_gchar_(title);
- p_arg1 = XEN_TO_C_GtkWindow_(parent);
- p_arg2 = XEN_TO_C_GtkFileChooserAction(action);
- switch (etc_len)
- {
- case 0: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, NULL, NULL); break;
- case 2: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), NULL); break;
- case 4: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), NULL); break;
- case 6: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), NULL); break;
- case 8: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), XLS(buttons, 6), XLI(buttons, 7), NULL); break;
- case 10: result = gtk_file_chooser_dialog_new(p_arg0, p_arg1, p_arg2, XLS(buttons, 0), XLI(buttons, 1), XLS(buttons, 2), XLI(buttons, 3), XLS(buttons, 4), XLI(buttons, 5), XLS(buttons, 6), XLI(buttons, 7), XLS(buttons, 8), XLI(buttons, 9), NULL); break;
- }
- return(C_TO_XEN_GtkWidget_(result));
- }
+ #define H_gtk_tool_item_set_visible_horizontal "void gtk_tool_item_set_visible_horizontal(GtkToolItem* toolitem, \
+gboolean visible_horizontal)"
+ Xen_check_type(Xen_is_GtkToolItem_(toolitem), toolitem, 1, "gtk_tool_item_set_visible_horizontal", "GtkToolItem*");
+ Xen_check_type(Xen_is_gboolean(visible_horizontal), visible_horizontal, 2, "gtk_tool_item_set_visible_horizontal", "gboolean");
+ gtk_tool_item_set_visible_horizontal(Xen_to_C_GtkToolItem_(toolitem), Xen_to_C_gboolean(visible_horizontal));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_widget_new(XEN action)
+static Xen gxg_gtk_tool_item_get_visible_horizontal(Xen toolitem)
{
- #define H_gtk_file_chooser_widget_new "GtkWidget* gtk_file_chooser_widget_new(GtkFileChooserAction action)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooserAction_P(action), action, 1, "gtk_file_chooser_widget_new", "GtkFileChooserAction");
- return(C_TO_XEN_GtkWidget_(gtk_file_chooser_widget_new(XEN_TO_C_GtkFileChooserAction(action))));
+ #define H_gtk_tool_item_get_visible_horizontal "gboolean gtk_tool_item_get_visible_horizontal(GtkToolItem* toolitem)"
+ Xen_check_type(Xen_is_GtkToolItem_(toolitem), toolitem, 1, "gtk_tool_item_get_visible_horizontal", "GtkToolItem*");
+ return(C_to_Xen_gboolean(gtk_tool_item_get_visible_horizontal(Xen_to_C_GtkToolItem_(toolitem))));
}
-static XEN gxg_gtk_tree_model_filter_new(XEN child_model, XEN root)
+static Xen gxg_gtk_tool_item_set_visible_vertical(Xen toolitem, Xen visible_vertical)
{
- #define H_gtk_tree_model_filter_new "GtkTreeModel* gtk_tree_model_filter_new(GtkTreeModel* child_model, \
-GtkTreePath* root)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(child_model), child_model, 1, "gtk_tree_model_filter_new", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(root) || XEN_FALSE_P(root), root, 2, "gtk_tree_model_filter_new", "GtkTreePath*");
- return(C_TO_XEN_GtkTreeModel_(gtk_tree_model_filter_new(XEN_TO_C_GtkTreeModel_(child_model), XEN_TO_C_GtkTreePath_(root))));
+ #define H_gtk_tool_item_set_visible_vertical "void gtk_tool_item_set_visible_vertical(GtkToolItem* toolitem, \
+gboolean visible_vertical)"
+ Xen_check_type(Xen_is_GtkToolItem_(toolitem), toolitem, 1, "gtk_tool_item_set_visible_vertical", "GtkToolItem*");
+ Xen_check_type(Xen_is_gboolean(visible_vertical), visible_vertical, 2, "gtk_tool_item_set_visible_vertical", "gboolean");
+ gtk_tool_item_set_visible_vertical(Xen_to_C_GtkToolItem_(toolitem), Xen_to_C_gboolean(visible_vertical));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_filter_set_visible_column(XEN filter, XEN column)
+static Xen gxg_gtk_tool_item_get_visible_vertical(Xen toolitem)
{
- #define H_gtk_tree_model_filter_set_visible_column "void gtk_tree_model_filter_set_visible_column(GtkTreeModelFilter* filter, \
-gint column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelFilter__P(filter), filter, 1, "gtk_tree_model_filter_set_visible_column", "GtkTreeModelFilter*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 2, "gtk_tree_model_filter_set_visible_column", "gint");
- gtk_tree_model_filter_set_visible_column(XEN_TO_C_GtkTreeModelFilter_(filter), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_get_visible_vertical "gboolean gtk_tool_item_get_visible_vertical(GtkToolItem* toolitem)"
+ Xen_check_type(Xen_is_GtkToolItem_(toolitem), toolitem, 1, "gtk_tool_item_get_visible_vertical", "GtkToolItem*");
+ return(C_to_Xen_gboolean(gtk_tool_item_get_visible_vertical(Xen_to_C_GtkToolItem_(toolitem))));
}
-static XEN gxg_gtk_tree_model_filter_get_model(XEN filter)
+static Xen gxg_gtk_tool_item_get_is_important(Xen tool_item)
{
- #define H_gtk_tree_model_filter_get_model "GtkTreeModel* gtk_tree_model_filter_get_model(GtkTreeModelFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelFilter__P(filter), filter, 1, "gtk_tree_model_filter_get_model", "GtkTreeModelFilter*");
- return(C_TO_XEN_GtkTreeModel_(gtk_tree_model_filter_get_model(XEN_TO_C_GtkTreeModelFilter_(filter))));
+ #define H_gtk_tool_item_get_is_important "gboolean gtk_tool_item_get_is_important(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_is_important", "GtkToolItem*");
+ return(C_to_Xen_gboolean(gtk_tool_item_get_is_important(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_tree_model_filter_convert_iter_to_child_iter(XEN filter, XEN child_iter, XEN filter_iter)
+static Xen gxg_gtk_tool_item_set_is_important(Xen tool_item, Xen is_important)
{
- #define H_gtk_tree_model_filter_convert_iter_to_child_iter "void gtk_tree_model_filter_convert_iter_to_child_iter(GtkTreeModelFilter* filter, \
-GtkTreeIter* child_iter, GtkTreeIter* filter_iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelFilter__P(filter), filter, 1, "gtk_tree_model_filter_convert_iter_to_child_iter", "GtkTreeModelFilter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(child_iter), child_iter, 2, "gtk_tree_model_filter_convert_iter_to_child_iter", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(filter_iter), filter_iter, 3, "gtk_tree_model_filter_convert_iter_to_child_iter", "GtkTreeIter*");
- gtk_tree_model_filter_convert_iter_to_child_iter(XEN_TO_C_GtkTreeModelFilter_(filter), XEN_TO_C_GtkTreeIter_(child_iter),
- XEN_TO_C_GtkTreeIter_(filter_iter));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_set_is_important "void gtk_tool_item_set_is_important(GtkToolItem* tool_item, \
+gboolean is_important)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_set_is_important", "GtkToolItem*");
+ Xen_check_type(Xen_is_gboolean(is_important), is_important, 2, "gtk_tool_item_set_is_important", "gboolean");
+ gtk_tool_item_set_is_important(Xen_to_C_GtkToolItem_(tool_item), Xen_to_C_gboolean(is_important));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_filter_convert_child_path_to_path(XEN filter, XEN child_path)
+static Xen gxg_gtk_tool_item_get_orientation(Xen tool_item)
{
- #define H_gtk_tree_model_filter_convert_child_path_to_path "GtkTreePath* gtk_tree_model_filter_convert_child_path_to_path(GtkTreeModelFilter* filter, \
-GtkTreePath* child_path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelFilter__P(filter), filter, 1, "gtk_tree_model_filter_convert_child_path_to_path", "GtkTreeModelFilter*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(child_path), child_path, 2, "gtk_tree_model_filter_convert_child_path_to_path", "GtkTreePath*");
- return(C_TO_XEN_GtkTreePath_(gtk_tree_model_filter_convert_child_path_to_path(XEN_TO_C_GtkTreeModelFilter_(filter), XEN_TO_C_GtkTreePath_(child_path))));
+ #define H_gtk_tool_item_get_orientation "GtkOrientation gtk_tool_item_get_orientation(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_orientation", "GtkToolItem*");
+ return(C_to_Xen_GtkOrientation(gtk_tool_item_get_orientation(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_tree_model_filter_convert_path_to_child_path(XEN path, XEN filter_path)
+static Xen gxg_gtk_tool_item_get_toolbar_style(Xen tool_item)
{
- #define H_gtk_tree_model_filter_convert_path_to_child_path "GtkTreePath* gtk_tree_model_filter_convert_path_to_child_path(GtkTreeModelFilter* path, \
-GtkTreePath* filter_path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelFilter__P(path), path, 1, "gtk_tree_model_filter_convert_path_to_child_path", "GtkTreeModelFilter*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(filter_path), filter_path, 2, "gtk_tree_model_filter_convert_path_to_child_path", "GtkTreePath*");
- return(C_TO_XEN_GtkTreePath_(gtk_tree_model_filter_convert_path_to_child_path(XEN_TO_C_GtkTreeModelFilter_(path), XEN_TO_C_GtkTreePath_(filter_path))));
+ #define H_gtk_tool_item_get_toolbar_style "GtkToolbarStyle gtk_tool_item_get_toolbar_style(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_toolbar_style", "GtkToolItem*");
+ return(C_to_Xen_GtkToolbarStyle(gtk_tool_item_get_toolbar_style(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_tree_model_filter_refilter(XEN filter)
+static Xen gxg_gtk_tool_item_get_relief_style(Xen tool_item)
{
- #define H_gtk_tree_model_filter_refilter "void gtk_tree_model_filter_refilter(GtkTreeModelFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelFilter__P(filter), filter, 1, "gtk_tree_model_filter_refilter", "GtkTreeModelFilter*");
- gtk_tree_model_filter_refilter(XEN_TO_C_GtkTreeModelFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_get_relief_style "GtkReliefStyle gtk_tool_item_get_relief_style(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_relief_style", "GtkToolItem*");
+ return(C_to_Xen_GtkReliefStyle(gtk_tool_item_get_relief_style(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_tree_model_filter_clear_cache(XEN filter)
+static Xen gxg_gtk_tool_item_retrieve_proxy_menu_item(Xen tool_item)
{
- #define H_gtk_tree_model_filter_clear_cache "void gtk_tree_model_filter_clear_cache(GtkTreeModelFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelFilter__P(filter), filter, 1, "gtk_tree_model_filter_clear_cache", "GtkTreeModelFilter*");
- gtk_tree_model_filter_clear_cache(XEN_TO_C_GtkTreeModelFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_retrieve_proxy_menu_item "GtkWidget* gtk_tool_item_retrieve_proxy_menu_item(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_retrieve_proxy_menu_item", "GtkToolItem*");
+ return(C_to_Xen_GtkWidget_(gtk_tool_item_retrieve_proxy_menu_item(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_action_get_name(XEN action)
+static Xen gxg_gtk_tool_item_get_proxy_menu_item(Xen tool_item, Xen menu_item_id)
{
- #define H_gtk_action_get_name "gchar* gtk_action_get_name(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_name", "GtkAction*");
- return(C_TO_XEN_gchar_(gtk_action_get_name(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_tool_item_get_proxy_menu_item "GtkWidget* gtk_tool_item_get_proxy_menu_item(GtkToolItem* tool_item, \
+gchar* menu_item_id)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_proxy_menu_item", "GtkToolItem*");
+ Xen_check_type(Xen_is_gchar_(menu_item_id), menu_item_id, 2, "gtk_tool_item_get_proxy_menu_item", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_tool_item_get_proxy_menu_item(Xen_to_C_GtkToolItem_(tool_item), Xen_to_C_gchar_(menu_item_id))));
}
-static XEN gxg_gtk_action_activate(XEN action)
+static Xen gxg_gtk_tool_item_set_proxy_menu_item(Xen tool_item, Xen menu_item_id, Xen menu_item)
{
- #define H_gtk_action_activate "void gtk_action_activate(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_activate", "GtkAction*");
- gtk_action_activate(XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_set_proxy_menu_item "void gtk_tool_item_set_proxy_menu_item(GtkToolItem* tool_item, \
+gchar* menu_item_id, GtkWidget* menu_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item) || Xen_is_false(tool_item), tool_item, 1, "gtk_tool_item_set_proxy_menu_item", "GtkToolItem*");
+ Xen_check_type(Xen_is_gchar_(menu_item_id), menu_item_id, 2, "gtk_tool_item_set_proxy_menu_item", "gchar*");
+ Xen_check_type(Xen_is_GtkWidget_(menu_item) || Xen_is_false(menu_item), menu_item, 3, "gtk_tool_item_set_proxy_menu_item", "GtkWidget*");
+ gtk_tool_item_set_proxy_menu_item(Xen_to_C_GtkToolItem_(tool_item), Xen_to_C_gchar_(menu_item_id), Xen_to_C_GtkWidget_(menu_item));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_create_icon(XEN action, XEN icon_size)
+static Xen gxg_gtk_list_store_remove(Xen list_store, Xen iter)
{
- #define H_gtk_action_create_icon "GtkWidget* gtk_action_create_icon(GtkAction* action, GtkIconSize icon_size)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_create_icon", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(icon_size), icon_size, 2, "gtk_action_create_icon", "GtkIconSize");
- return(C_TO_XEN_GtkWidget_(gtk_action_create_icon(XEN_TO_C_GtkAction_(action), XEN_TO_C_GtkIconSize(icon_size))));
+ #define H_gtk_list_store_remove "gboolean gtk_list_store_remove(GtkListStore* list_store, GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_remove", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_remove", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_list_store_remove(Xen_to_C_GtkListStore_(list_store), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_action_create_menu_item(XEN action)
+static Xen gxg_gdk_display_set_double_click_distance(Xen display, Xen distance)
{
- #define H_gtk_action_create_menu_item "GtkWidget* gtk_action_create_menu_item(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_create_menu_item", "GtkAction*");
- return(C_TO_XEN_GtkWidget_(gtk_action_create_menu_item(XEN_TO_C_GtkAction_(action))));
+ #define H_gdk_display_set_double_click_distance "void gdk_display_set_double_click_distance(GdkDisplay* display, \
+guint distance)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_set_double_click_distance", "GdkDisplay*");
+ Xen_check_type(Xen_is_guint(distance), distance, 2, "gdk_display_set_double_click_distance", "guint");
+ gdk_display_set_double_click_distance(Xen_to_C_GdkDisplay_(display), Xen_to_C_guint(distance));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_create_tool_item(XEN action)
+static Xen gxg_gdk_display_get_default_group(Xen display)
{
- #define H_gtk_action_create_tool_item "GtkWidget* gtk_action_create_tool_item(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_create_tool_item", "GtkAction*");
- return(C_TO_XEN_GtkWidget_(gtk_action_create_tool_item(XEN_TO_C_GtkAction_(action))));
+ #define H_gdk_display_get_default_group "GdkWindow* gdk_display_get_default_group(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_get_default_group", "GdkDisplay*");
+ return(C_to_Xen_GdkWindow_(gdk_display_get_default_group(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_gtk_action_get_proxies(XEN action)
+static Xen gxg_gdk_window_get_group(Xen window)
{
- #define H_gtk_action_get_proxies "GSList* gtk_action_get_proxies(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_proxies", "GtkAction*");
- return(C_TO_XEN_GSList_(gtk_action_get_proxies(XEN_TO_C_GtkAction_(action))));
+ #define H_gdk_window_get_group "GdkWindow* gdk_window_get_group(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_group", "GdkWindow*");
+ return(C_to_Xen_GdkWindow_(gdk_window_get_group(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_action_connect_accelerator(XEN action)
+static Xen gxg_gtk_cell_layout_reorder(Xen cell_layout, Xen cell, Xen position)
{
- #define H_gtk_action_connect_accelerator "void gtk_action_connect_accelerator(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_connect_accelerator", "GtkAction*");
- gtk_action_connect_accelerator(XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_cell_layout_reorder "void gtk_cell_layout_reorder(GtkCellLayout* cell_layout, GtkCellRenderer* cell, \
+gint position)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_reorder", "GtkCellLayout*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_cell_layout_reorder", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_cell_layout_reorder", "gint");
+ gtk_cell_layout_reorder(Xen_to_C_GtkCellLayout_(cell_layout), Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_disconnect_accelerator(XEN action)
+static Xen gxg_gtk_clipboard_request_targets(Xen clipboard, Xen func, Xen func_info)
{
- #define H_gtk_action_disconnect_accelerator "void gtk_action_disconnect_accelerator(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_disconnect_accelerator", "GtkAction*");
- gtk_action_disconnect_accelerator(XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_request_targets "void gtk_clipboard_request_targets(GtkClipboard* clipboard, \
+GtkClipboardTargetsReceivedFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_request_targets", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkClipboardTargetsReceivedFunc(func), func, 2, "gtk_clipboard_request_targets", "GtkClipboardTargetsReceivedFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_clipboard_request_targets", "lambda_data");
+ {
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ gtk_clipboard_request_targets(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkClipboardTargetsReceivedFunc(func), Xen_to_C_lambda_data(func_info));
+ xm_unprotect_at(loc);
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_action_group_new(XEN name)
+static Xen gxg_gtk_clipboard_wait_for_targets(Xen clipboard, Xen ignore_targets, Xen ignore_n_targets)
{
- #define H_gtk_action_group_new "GtkActionGroup* gtk_action_group_new(gchar* name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_action_group_new", "gchar*");
- return(C_TO_XEN_GtkActionGroup_(gtk_action_group_new(XEN_TO_C_gchar_(name))));
+ #define H_gtk_clipboard_wait_for_targets "gboolean gtk_clipboard_wait_for_targets(GtkClipboard* clipboard, \
+GdkAtom** [targets], gint* [n_targets])"
+ GdkAtom* ref_targets = NULL;
+ gint ref_n_targets;
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_for_targets", "GtkClipboard*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_clipboard_wait_for_targets(Xen_to_C_GtkClipboard_(clipboard), &ref_targets, &ref_n_targets));
+ return(Xen_list_3(result, C_to_Xen_GdkAtom_(ref_targets), C_to_Xen_gint(ref_n_targets)));
+ }
}
-static XEN gxg_gtk_action_group_get_name(XEN action_group)
+static Xen gxg_gtk_menu_shell_cancel(Xen menu_shell)
{
- #define H_gtk_action_group_get_name "gchar* gtk_action_group_get_name(GtkActionGroup* action_group)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_get_name", "GtkActionGroup*");
- return(C_TO_XEN_gchar_(gtk_action_group_get_name(XEN_TO_C_GtkActionGroup_(action_group))));
+ #define H_gtk_menu_shell_cancel "void gtk_menu_shell_cancel(GtkMenuShell* menu_shell)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_cancel", "GtkMenuShell*");
+ gtk_menu_shell_cancel(Xen_to_C_GtkMenuShell_(menu_shell));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_group_get_action(XEN action_group, XEN action_name)
+static Xen gxg_gtk_paned_get_child1(Xen paned)
{
- #define H_gtk_action_group_get_action "GtkAction* gtk_action_group_get_action(GtkActionGroup* action_group, \
-gchar* action_name)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_get_action", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_gchar__P(action_name), action_name, 2, "gtk_action_group_get_action", "gchar*");
- return(C_TO_XEN_GtkAction_(gtk_action_group_get_action(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_gchar_(action_name))));
+ #define H_gtk_paned_get_child1 "GtkWidget* gtk_paned_get_child1(GtkPaned* paned)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_get_child1", "GtkPaned*");
+ return(C_to_Xen_GtkWidget_(gtk_paned_get_child1(Xen_to_C_GtkPaned_(paned))));
}
-static XEN gxg_gtk_action_group_list_actions(XEN action_group)
+static Xen gxg_gtk_paned_get_child2(Xen paned)
{
- #define H_gtk_action_group_list_actions "GList* gtk_action_group_list_actions(GtkActionGroup* action_group)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_list_actions", "GtkActionGroup*");
- return(C_TO_XEN_GList_(gtk_action_group_list_actions(XEN_TO_C_GtkActionGroup_(action_group))));
+ #define H_gtk_paned_get_child2 "GtkWidget* gtk_paned_get_child2(GtkPaned* paned)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_get_child2", "GtkPaned*");
+ return(C_to_Xen_GtkWidget_(gtk_paned_get_child2(Xen_to_C_GtkPaned_(paned))));
}
-static XEN gxg_gtk_action_group_add_action(XEN action_group, XEN action)
+static Xen gxg_gtk_window_set_accept_focus(Xen window, Xen setting)
{
- #define H_gtk_action_group_add_action "void gtk_action_group_add_action(GtkActionGroup* action_group, \
-GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_add_action", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 2, "gtk_action_group_add_action", "GtkAction*");
- gtk_action_group_add_action(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_window_set_accept_focus "void gtk_window_set_accept_focus(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_accept_focus", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_accept_focus", "gboolean");
+ gtk_window_set_accept_focus(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_group_remove_action(XEN action_group, XEN action)
+static Xen gxg_gtk_window_get_accept_focus(Xen window)
{
- #define H_gtk_action_group_remove_action "void gtk_action_group_remove_action(GtkActionGroup* action_group, \
-GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_remove_action", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 2, "gtk_action_group_remove_action", "GtkAction*");
- gtk_action_group_remove_action(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_window_get_accept_focus "gboolean gtk_window_get_accept_focus(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_accept_focus", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_accept_focus(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_action_group_add_actions(XEN action_group, XEN entries, XEN n_entries, XEN user_data)
+static Xen gxg_g_list_nth_data(Xen list, Xen n)
{
- #define H_gtk_action_group_add_actions "void gtk_action_group_add_actions(GtkActionGroup* action_group, \
-GtkActionEntry* entries, guint n_entries, gpointer user_data)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_add_actions", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_GtkActionEntry__P(entries), entries, 2, "gtk_action_group_add_actions", "GtkActionEntry*");
- XEN_ASSERT_TYPE(XEN_guint_P(n_entries), n_entries, 3, "gtk_action_group_add_actions", "guint");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 4, "gtk_action_group_add_actions", "gpointer");
- gtk_action_group_add_actions(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_GtkActionEntry_(entries), XEN_TO_C_guint(n_entries),
- XEN_TO_C_gpointer(user_data));
- return(XEN_FALSE);
+ #define H_g_list_nth_data "gpointer g_list_nth_data(GList* list, guint n)"
+ Xen_check_type(Xen_is_GList_(list), list, 1, "g_list_nth_data", "GList*");
+ Xen_check_type(Xen_is_guint(n), n, 2, "g_list_nth_data", "guint");
+ return(C_to_Xen_gpointer(g_list_nth_data(Xen_to_C_GList_(list), Xen_to_C_guint(n))));
}
-static XEN gxg_gtk_action_group_add_toggle_actions(XEN action_group, XEN entries, XEN n_entries, XEN user_data)
+static Xen gxg_gtk_accel_map_get(void)
{
- #define H_gtk_action_group_add_toggle_actions "void gtk_action_group_add_toggle_actions(GtkActionGroup* action_group, \
-GtkToggleActionEntry* entries, guint n_entries, gpointer user_data)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_add_toggle_actions", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_GtkToggleActionEntry__P(entries), entries, 2, "gtk_action_group_add_toggle_actions", "GtkToggleActionEntry*");
- XEN_ASSERT_TYPE(XEN_guint_P(n_entries), n_entries, 3, "gtk_action_group_add_toggle_actions", "guint");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 4, "gtk_action_group_add_toggle_actions", "gpointer");
- gtk_action_group_add_toggle_actions(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_GtkToggleActionEntry_(entries), XEN_TO_C_guint(n_entries),
- XEN_TO_C_gpointer(user_data));
- return(XEN_FALSE);
+ #define H_gtk_accel_map_get "GtkAccelMap* gtk_accel_map_get( void)"
+ return(C_to_Xen_GtkAccelMap_(gtk_accel_map_get()));
}
-static XEN gxg_gtk_action_group_add_toggle_actions_full(XEN action_group, XEN entries, XEN n_entries, XEN func_info, XEN destroy)
+static Xen gxg_gtk_combo_box_popup(Xen combo_box)
{
- #define H_gtk_action_group_add_toggle_actions_full "void gtk_action_group_add_toggle_actions_full(GtkActionGroup* action_group, \
-GtkToggleActionEntry* entries, guint n_entries, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_add_toggle_actions_full", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_GtkToggleActionEntry__P(entries), entries, 2, "gtk_action_group_add_toggle_actions_full", "GtkToggleActionEntry*");
- XEN_ASSERT_TYPE(XEN_guint_P(n_entries), n_entries, 3, "gtk_action_group_add_toggle_actions_full", "guint");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gtk_action_group_add_toggle_actions_full", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 5, "gtk_action_group_add_toggle_actions_full", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(XEN_FALSE, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_action_group_add_toggle_actions_full(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_GtkToggleActionEntry_(entries),
- XEN_TO_C_guint(n_entries), XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_combo_box_popup "void gtk_combo_box_popup(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_popup", "GtkComboBox*");
+ gtk_combo_box_popup(Xen_to_C_GtkComboBox_(combo_box));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_group_set_translation_domain(XEN action_group, XEN domain)
+static Xen gxg_gtk_combo_box_popdown(Xen combo_box)
{
- #define H_gtk_action_group_set_translation_domain "void gtk_action_group_set_translation_domain(GtkActionGroup* action_group, \
-gchar* domain)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_set_translation_domain", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_gchar__P(domain), domain, 2, "gtk_action_group_set_translation_domain", "gchar*");
- gtk_action_group_set_translation_domain(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_gchar_(domain));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_popdown "void gtk_combo_box_popdown(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_popdown", "GtkComboBox*");
+ gtk_combo_box_popdown(Xen_to_C_GtkComboBox_(combo_box));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_new(void)
+static Xen gxg_gtk_radio_menu_item_new_from_widget(Xen group)
{
- #define H_gtk_combo_box_new "GtkWidget* gtk_combo_box_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_combo_box_new()));
+ #define H_gtk_radio_menu_item_new_from_widget "GtkWidget* gtk_radio_menu_item_new_from_widget(GtkRadioMenuItem* group)"
+ Xen_check_type(Xen_is_GtkRadioMenuItem_(group), group, 1, "gtk_radio_menu_item_new_from_widget", "GtkRadioMenuItem*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_menu_item_new_from_widget(Xen_to_C_GtkRadioMenuItem_(group))));
}
-static XEN gxg_gtk_combo_box_new_with_model(XEN model)
+static Xen gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget(Xen group, Xen label)
{
- #define H_gtk_combo_box_new_with_model "GtkWidget* gtk_combo_box_new_with_model(GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model), model, 1, "gtk_combo_box_new_with_model", "GtkTreeModel*");
- return(C_TO_XEN_GtkWidget_(gtk_combo_box_new_with_model(XEN_TO_C_GtkTreeModel_(model))));
+ #define H_gtk_radio_menu_item_new_with_mnemonic_from_widget "GtkWidget* gtk_radio_menu_item_new_with_mnemonic_from_widget(GtkRadioMenuItem* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GtkRadioMenuItem_(group), group, 1, "gtk_radio_menu_item_new_with_mnemonic_from_widget", "GtkRadioMenuItem*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_radio_menu_item_new_with_mnemonic_from_widget", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_menu_item_new_with_mnemonic_from_widget(Xen_to_C_GtkRadioMenuItem_(group), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_combo_box_set_model(XEN combo_box, XEN model)
+static Xen gxg_gtk_radio_menu_item_new_with_label_from_widget(Xen group, Xen label)
{
- #define H_gtk_combo_box_set_model "void gtk_combo_box_set_model(GtkComboBox* combo_box, GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_model", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model) || XEN_FALSE_P(model), model, 2, "gtk_combo_box_set_model", "GtkTreeModel*");
- gtk_combo_box_set_model(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_GtkTreeModel_(model));
- return(XEN_FALSE);
+ #define H_gtk_radio_menu_item_new_with_label_from_widget "GtkWidget* gtk_radio_menu_item_new_with_label_from_widget(GtkRadioMenuItem* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GtkRadioMenuItem_(group), group, 1, "gtk_radio_menu_item_new_with_label_from_widget", "GtkRadioMenuItem*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_radio_menu_item_new_with_label_from_widget", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_radio_menu_item_new_with_label_from_widget(Xen_to_C_GtkRadioMenuItem_(group), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_combo_box_set_wrap_width(XEN combo_box, XEN width)
+static Xen gxg_gtk_scale_get_layout(Xen scale)
{
- #define H_gtk_combo_box_set_wrap_width "void gtk_combo_box_set_wrap_width(GtkComboBox* combo_box, gint width)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_wrap_width", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_combo_box_set_wrap_width", "gint");
- gtk_combo_box_set_wrap_width(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gint(width));
- return(XEN_FALSE);
+ #define H_gtk_scale_get_layout "PangoLayout* gtk_scale_get_layout(GtkScale* scale)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_get_layout", "GtkScale*");
+ return(C_to_Xen_PangoLayout_(gtk_scale_get_layout(Xen_to_C_GtkScale_(scale))));
}
-static XEN gxg_gtk_combo_box_set_row_span_column(XEN combo_box, XEN row_span)
+static Xen gxg_gtk_scale_get_layout_offsets(Xen scale, Xen ignore_x, Xen ignore_y)
{
- #define H_gtk_combo_box_set_row_span_column "void gtk_combo_box_set_row_span_column(GtkComboBox* combo_box, \
-gint row_span)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_row_span_column", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gint_P(row_span), row_span, 2, "gtk_combo_box_set_row_span_column", "gint");
- gtk_combo_box_set_row_span_column(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gint(row_span));
- return(XEN_FALSE);
+ #define H_gtk_scale_get_layout_offsets "void gtk_scale_get_layout_offsets(GtkScale* scale, gint* [x], \
+gint* [y])"
+ gint ref_x;
+ gint ref_y;
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_get_layout_offsets", "GtkScale*");
+ gtk_scale_get_layout_offsets(Xen_to_C_GtkScale_(scale), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y)));
}
-static XEN gxg_gtk_combo_box_set_column_span_column(XEN combo_box, XEN column_span)
+static Xen gxg_gtk_drag_source_get_target_list(Xen widget)
{
- #define H_gtk_combo_box_set_column_span_column "void gtk_combo_box_set_column_span_column(GtkComboBox* combo_box, \
-gint column_span)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_column_span_column", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gint_P(column_span), column_span, 2, "gtk_combo_box_set_column_span_column", "gint");
- gtk_combo_box_set_column_span_column(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gint(column_span));
- return(XEN_FALSE);
+ #define H_gtk_drag_source_get_target_list "GtkTargetList* gtk_drag_source_get_target_list(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_get_target_list", "GtkWidget*");
+ return(C_to_Xen_GtkTargetList_(gtk_drag_source_get_target_list(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_combo_box_get_active(XEN combo_box)
+static Xen gxg_gtk_drag_source_set_target_list(Xen widget, Xen target_list)
{
- #define H_gtk_combo_box_get_active "gint gtk_combo_box_get_active(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_active", "GtkComboBox*");
- return(C_TO_XEN_gint(gtk_combo_box_get_active(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gtk_drag_source_set_target_list "void gtk_drag_source_set_target_list(GtkWidget* widget, \
+GtkTargetList* target_list)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_set_target_list", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkTargetList_(target_list) || Xen_is_false(target_list), target_list, 2, "gtk_drag_source_set_target_list", "GtkTargetList*");
+ gtk_drag_source_set_target_list(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkTargetList_(target_list));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_set_active(XEN combo_box, XEN index)
+static Xen gxg_gtk_entry_set_alignment(Xen entry, Xen xalign)
{
- #define H_gtk_combo_box_set_active "void gtk_combo_box_set_active(GtkComboBox* combo_box, gint index)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_active", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gint_P(index), index, 2, "gtk_combo_box_set_active", "gint");
- gtk_combo_box_set_active(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gint(index));
- return(XEN_FALSE);
+ #define H_gtk_entry_set_alignment "void gtk_entry_set_alignment(GtkEntry* entry, gfloat xalign)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_alignment", "GtkEntry*");
+ Xen_check_type(Xen_is_gfloat(xalign), xalign, 2, "gtk_entry_set_alignment", "gfloat");
+ gtk_entry_set_alignment(Xen_to_C_GtkEntry_(entry), Xen_to_C_gfloat(xalign));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_get_active_iter(XEN combo_box, XEN iter)
+static Xen gxg_gtk_entry_get_alignment(Xen entry)
{
- #define H_gtk_combo_box_get_active_iter "gboolean gtk_combo_box_get_active_iter(GtkComboBox* combo_box, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_active_iter", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_combo_box_get_active_iter", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_combo_box_get_active_iter(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_entry_get_alignment "gfloat gtk_entry_get_alignment(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_alignment", "GtkEntry*");
+ return(C_to_Xen_gfloat(gtk_entry_get_alignment(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_combo_box_set_active_iter(XEN combo_box, XEN iter)
+static Xen gxg_gtk_file_chooser_set_use_preview_label(Xen chooser, Xen use_label)
{
- #define H_gtk_combo_box_set_active_iter "void gtk_combo_box_set_active_iter(GtkComboBox* combo_box, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_active_iter", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_combo_box_set_active_iter", "GtkTreeIter*");
- gtk_combo_box_set_active_iter(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_GtkTreeIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_set_use_preview_label "void gtk_file_chooser_set_use_preview_label(GtkFileChooser* chooser, \
+gboolean use_label)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_use_preview_label", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gboolean(use_label), use_label, 2, "gtk_file_chooser_set_use_preview_label", "gboolean");
+ gtk_file_chooser_set_use_preview_label(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gboolean(use_label));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_get_model(XEN combo_box)
+static Xen gxg_gtk_file_chooser_get_use_preview_label(Xen chooser)
{
- #define H_gtk_combo_box_get_model "GtkTreeModel* gtk_combo_box_get_model(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_model", "GtkComboBox*");
- return(C_TO_XEN_GtkTreeModel_(gtk_combo_box_get_model(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gtk_file_chooser_get_use_preview_label "gboolean gtk_file_chooser_get_use_preview_label(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_use_preview_label", "GtkFileChooser*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_get_use_preview_label(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_expander_new(XEN label)
+static Xen gxg_gtk_widget_list_mnemonic_labels(Xen widget)
{
- #define H_gtk_expander_new "GtkWidget* gtk_expander_new(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_expander_new", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_expander_new(XEN_TO_C_gchar_(label))));
+ #define H_gtk_widget_list_mnemonic_labels "GList* gtk_widget_list_mnemonic_labels(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_list_mnemonic_labels", "GtkWidget*");
+ return(C_to_Xen_GList_(gtk_widget_list_mnemonic_labels(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_expander_new_with_mnemonic(XEN label)
+static Xen gxg_gtk_widget_add_mnemonic_label(Xen widget, Xen label)
{
- #define H_gtk_expander_new_with_mnemonic "GtkWidget* gtk_expander_new_with_mnemonic(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_expander_new_with_mnemonic", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_expander_new_with_mnemonic(XEN_TO_C_gchar_(label))));
+ #define H_gtk_widget_add_mnemonic_label "void gtk_widget_add_mnemonic_label(GtkWidget* widget, GtkWidget* label)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_add_mnemonic_label", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(label), label, 2, "gtk_widget_add_mnemonic_label", "GtkWidget*");
+ gtk_widget_add_mnemonic_label(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkWidget_(label));
+ return(Xen_false);
}
-static XEN gxg_gtk_expander_set_expanded(XEN expander, XEN expanded)
+static Xen gxg_gtk_widget_remove_mnemonic_label(Xen widget, Xen label)
{
- #define H_gtk_expander_set_expanded "void gtk_expander_set_expanded(GtkExpander* expander, gboolean expanded)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_set_expanded", "GtkExpander*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expanded), expanded, 2, "gtk_expander_set_expanded", "gboolean");
- gtk_expander_set_expanded(XEN_TO_C_GtkExpander_(expander), XEN_TO_C_gboolean(expanded));
- return(XEN_FALSE);
+ #define H_gtk_widget_remove_mnemonic_label "void gtk_widget_remove_mnemonic_label(GtkWidget* widget, \
+GtkWidget* label)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_remove_mnemonic_label", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(label), label, 2, "gtk_widget_remove_mnemonic_label", "GtkWidget*");
+ gtk_widget_remove_mnemonic_label(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkWidget_(label));
+ return(Xen_false);
}
-static XEN gxg_gtk_expander_get_expanded(XEN expander)
+static Xen gxg_gtk_window_activate_key(Xen window, Xen event)
{
- #define H_gtk_expander_get_expanded "gboolean gtk_expander_get_expanded(GtkExpander* expander)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_get_expanded", "GtkExpander*");
- return(C_TO_XEN_gboolean(gtk_expander_get_expanded(XEN_TO_C_GtkExpander_(expander))));
+ #define H_gtk_window_activate_key "gboolean gtk_window_activate_key(GtkWindow* window, GdkEventKey* event)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_activate_key", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkEventKey_(event), event, 2, "gtk_window_activate_key", "GdkEventKey*");
+ return(C_to_Xen_gboolean(gtk_window_activate_key(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkEventKey_(event))));
}
-static XEN gxg_gtk_expander_set_spacing(XEN expander, XEN spacing)
+static Xen gxg_gtk_window_propagate_key_event(Xen window, Xen event)
{
- #define H_gtk_expander_set_spacing "void gtk_expander_set_spacing(GtkExpander* expander, gint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_set_spacing", "GtkExpander*");
- XEN_ASSERT_TYPE(XEN_gint_P(spacing), spacing, 2, "gtk_expander_set_spacing", "gint");
- gtk_expander_set_spacing(XEN_TO_C_GtkExpander_(expander), XEN_TO_C_gint(spacing));
- return(XEN_FALSE);
+ #define H_gtk_window_propagate_key_event "gboolean gtk_window_propagate_key_event(GtkWindow* window, \
+GdkEventKey* event)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_propagate_key_event", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkEventKey_(event), event, 2, "gtk_window_propagate_key_event", "GdkEventKey*");
+ return(C_to_Xen_gboolean(gtk_window_propagate_key_event(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkEventKey_(event))));
}
-static XEN gxg_gtk_expander_get_spacing(XEN expander)
+static Xen gxg_g_quark_from_string(Xen string)
{
- #define H_gtk_expander_get_spacing "gint gtk_expander_get_spacing(GtkExpander* expander)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_get_spacing", "GtkExpander*");
- return(C_TO_XEN_gint(gtk_expander_get_spacing(XEN_TO_C_GtkExpander_(expander))));
+ #define H_g_quark_from_string "GQuark g_quark_from_string(gchar* string)"
+ Xen_check_type(Xen_is_gchar_(string), string, 1, "g_quark_from_string", "gchar*");
+ return(C_to_Xen_GQuark(g_quark_from_string(Xen_to_C_gchar_(string))));
}
-static XEN gxg_gtk_expander_set_label(XEN expander, XEN label)
+static Xen gxg_g_quark_to_string(Xen quark)
{
- #define H_gtk_expander_set_label "void gtk_expander_set_label(GtkExpander* expander, gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_set_label", "GtkExpander*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_expander_set_label", "gchar*");
- gtk_expander_set_label(XEN_TO_C_GtkExpander_(expander), XEN_TO_C_gchar_(label));
- return(XEN_FALSE);
+ #define H_g_quark_to_string "gchar* g_quark_to_string(GQuark quark)"
+ Xen_check_type(Xen_is_GQuark(quark), quark, 1, "g_quark_to_string", "GQuark");
+ return(C_to_Xen_gchar_(g_quark_to_string(Xen_to_C_GQuark(quark))));
}
-static XEN gxg_gtk_expander_get_label(XEN expander)
+static Xen gxg_gtk_cell_view_new(void)
{
- #define H_gtk_expander_get_label "gchar* gtk_expander_get_label(GtkExpander* expander)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_get_label", "GtkExpander*");
- return(C_TO_XEN_gchar_(gtk_expander_get_label(XEN_TO_C_GtkExpander_(expander))));
+ #define H_gtk_cell_view_new "GtkWidget* gtk_cell_view_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_cell_view_new()));
}
-static XEN gxg_gtk_expander_set_use_underline(XEN expander, XEN use_underline)
+static Xen gxg_gtk_cell_view_new_with_text(Xen text)
{
- #define H_gtk_expander_set_use_underline "void gtk_expander_set_use_underline(GtkExpander* expander, \
-gboolean use_underline)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_set_use_underline", "GtkExpander*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_underline), use_underline, 2, "gtk_expander_set_use_underline", "gboolean");
- gtk_expander_set_use_underline(XEN_TO_C_GtkExpander_(expander), XEN_TO_C_gboolean(use_underline));
- return(XEN_FALSE);
+ #define H_gtk_cell_view_new_with_text "GtkWidget* gtk_cell_view_new_with_text(gchar* text)"
+ Xen_check_type(Xen_is_gchar_(text), text, 1, "gtk_cell_view_new_with_text", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_cell_view_new_with_text(Xen_to_C_gchar_(text))));
}
-static XEN gxg_gtk_expander_get_use_underline(XEN expander)
+static Xen gxg_gtk_cell_view_new_with_markup(Xen markup)
{
- #define H_gtk_expander_get_use_underline "gboolean gtk_expander_get_use_underline(GtkExpander* expander)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_get_use_underline", "GtkExpander*");
- return(C_TO_XEN_gboolean(gtk_expander_get_use_underline(XEN_TO_C_GtkExpander_(expander))));
+ #define H_gtk_cell_view_new_with_markup "GtkWidget* gtk_cell_view_new_with_markup(gchar* markup)"
+ Xen_check_type(Xen_is_gchar_(markup), markup, 1, "gtk_cell_view_new_with_markup", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_cell_view_new_with_markup(Xen_to_C_gchar_(markup))));
}
-static XEN gxg_gtk_expander_set_label_widget(XEN expander, XEN label_widget)
+static Xen gxg_gtk_cell_view_new_with_pixbuf(Xen pixbuf)
{
- #define H_gtk_expander_set_label_widget "void gtk_expander_set_label_widget(GtkExpander* expander, \
-GtkWidget* label_widget)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_set_label_widget", "GtkExpander*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(label_widget), label_widget, 2, "gtk_expander_set_label_widget", "GtkWidget*");
- gtk_expander_set_label_widget(XEN_TO_C_GtkExpander_(expander), XEN_TO_C_GtkWidget_(label_widget));
- return(XEN_FALSE);
+ #define H_gtk_cell_view_new_with_pixbuf "GtkWidget* gtk_cell_view_new_with_pixbuf(GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gtk_cell_view_new_with_pixbuf", "GdkPixbuf*");
+ return(C_to_Xen_GtkWidget_(gtk_cell_view_new_with_pixbuf(Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gtk_expander_get_label_widget(XEN expander)
+static Xen gxg_gtk_cell_view_set_model(Xen cell_view, Xen model)
{
- #define H_gtk_expander_get_label_widget "GtkWidget* gtk_expander_get_label_widget(GtkExpander* expander)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_get_label_widget", "GtkExpander*");
- return(C_TO_XEN_GtkWidget_(gtk_expander_get_label_widget(XEN_TO_C_GtkExpander_(expander))));
+ #define H_gtk_cell_view_set_model "void gtk_cell_view_set_model(GtkCellView* cell_view, GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_set_model", "GtkCellView*");
+ Xen_check_type(Xen_is_GtkTreeModel_(model) || Xen_is_false(model), model, 2, "gtk_cell_view_set_model", "GtkTreeModel*");
+ gtk_cell_view_set_model(Xen_to_C_GtkCellView_(cell_view), Xen_to_C_GtkTreeModel_(model));
+ return(Xen_false);
}
-static XEN gxg_gtk_expander_set_use_markup(XEN expander, XEN use_markup)
+static Xen gxg_gtk_cell_view_set_displayed_row(Xen cell_view, Xen path)
{
- #define H_gtk_expander_set_use_markup "void gtk_expander_set_use_markup(GtkExpander* expander, gboolean use_markup)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_set_use_markup", "GtkExpander*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_markup), use_markup, 2, "gtk_expander_set_use_markup", "gboolean");
- gtk_expander_set_use_markup(XEN_TO_C_GtkExpander_(expander), XEN_TO_C_gboolean(use_markup));
- return(XEN_FALSE);
+ #define H_gtk_cell_view_set_displayed_row "void gtk_cell_view_set_displayed_row(GtkCellView* cell_view, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_set_displayed_row", "GtkCellView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_cell_view_set_displayed_row", "GtkTreePath*");
+ gtk_cell_view_set_displayed_row(Xen_to_C_GtkCellView_(cell_view), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_expander_get_use_markup(XEN expander)
+static Xen gxg_gtk_cell_view_get_displayed_row(Xen cell_view)
{
- #define H_gtk_expander_get_use_markup "gboolean gtk_expander_get_use_markup(GtkExpander* expander)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_get_use_markup", "GtkExpander*");
- return(C_TO_XEN_gboolean(gtk_expander_get_use_markup(XEN_TO_C_GtkExpander_(expander))));
+ #define H_gtk_cell_view_get_displayed_row "GtkTreePath* gtk_cell_view_get_displayed_row(GtkCellView* cell_view)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_get_displayed_row", "GtkCellView*");
+ return(C_to_Xen_GtkTreePath_(gtk_cell_view_get_displayed_row(Xen_to_C_GtkCellView_(cell_view))));
}
-static XEN gxg_gtk_font_button_new(void)
+static Xen gxg_gtk_combo_box_get_wrap_width(Xen combo_box)
{
- #define H_gtk_font_button_new "GtkWidget* gtk_font_button_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_font_button_new()));
+ #define H_gtk_combo_box_get_wrap_width "gint gtk_combo_box_get_wrap_width(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_wrap_width", "GtkComboBox*");
+ return(C_to_Xen_gint(gtk_combo_box_get_wrap_width(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_font_button_new_with_font(XEN fontname)
+static Xen gxg_gtk_combo_box_get_row_span_column(Xen combo_box)
{
- #define H_gtk_font_button_new_with_font "GtkWidget* gtk_font_button_new_with_font(gchar* fontname)"
- XEN_ASSERT_TYPE(XEN_gchar__P(fontname), fontname, 1, "gtk_font_button_new_with_font", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_font_button_new_with_font(XEN_TO_C_gchar_(fontname))));
+ #define H_gtk_combo_box_get_row_span_column "gint gtk_combo_box_get_row_span_column(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_row_span_column", "GtkComboBox*");
+ return(C_to_Xen_gint(gtk_combo_box_get_row_span_column(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_font_button_get_title(XEN font_button)
+static Xen gxg_gtk_combo_box_get_column_span_column(Xen combo_box)
{
- #define H_gtk_font_button_get_title "gchar* gtk_font_button_get_title(GtkFontButton* font_button)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_get_title", "GtkFontButton*");
- return(C_TO_XEN_gchar_(gtk_font_button_get_title(XEN_TO_C_GtkFontButton_(font_button))));
+ #define H_gtk_combo_box_get_column_span_column "gint gtk_combo_box_get_column_span_column(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_column_span_column", "GtkComboBox*");
+ return(C_to_Xen_gint(gtk_combo_box_get_column_span_column(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_font_button_set_title(XEN font_button, XEN title)
+static Xen gxg_gtk_drag_dest_add_text_targets(Xen widget)
{
- #define H_gtk_font_button_set_title "void gtk_font_button_set_title(GtkFontButton* font_button, gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_set_title", "GtkFontButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gtk_font_button_set_title", "gchar*");
- gtk_font_button_set_title(XEN_TO_C_GtkFontButton_(font_button), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_gtk_drag_dest_add_text_targets "void gtk_drag_dest_add_text_targets(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_add_text_targets", "GtkWidget*");
+ gtk_drag_dest_add_text_targets(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_button_get_use_font(XEN font_button)
+static Xen gxg_gtk_drag_source_add_text_targets(Xen widget)
{
- #define H_gtk_font_button_get_use_font "gboolean gtk_font_button_get_use_font(GtkFontButton* font_button)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_get_use_font", "GtkFontButton*");
- return(C_TO_XEN_gboolean(gtk_font_button_get_use_font(XEN_TO_C_GtkFontButton_(font_button))));
+ #define H_gtk_drag_source_add_text_targets "void gtk_drag_source_add_text_targets(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_add_text_targets", "GtkWidget*");
+ gtk_drag_source_add_text_targets(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_button_set_use_font(XEN font_button, XEN use_font)
+static Xen gxg_gtk_entry_completion_insert_prefix(Xen completion)
{
- #define H_gtk_font_button_set_use_font "void gtk_font_button_set_use_font(GtkFontButton* font_button, \
-gboolean use_font)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_set_use_font", "GtkFontButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_font), use_font, 2, "gtk_font_button_set_use_font", "gboolean");
- gtk_font_button_set_use_font(XEN_TO_C_GtkFontButton_(font_button), XEN_TO_C_gboolean(use_font));
- return(XEN_FALSE);
+ #define H_gtk_entry_completion_insert_prefix "void gtk_entry_completion_insert_prefix(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_insert_prefix", "GtkEntryCompletion*");
+ gtk_entry_completion_insert_prefix(Xen_to_C_GtkEntryCompletion_(completion));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_button_get_use_size(XEN font_button)
+static Xen gxg_gtk_entry_completion_set_inline_completion(Xen completion, Xen inline_completion)
{
- #define H_gtk_font_button_get_use_size "gboolean gtk_font_button_get_use_size(GtkFontButton* font_button)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_get_use_size", "GtkFontButton*");
- return(C_TO_XEN_gboolean(gtk_font_button_get_use_size(XEN_TO_C_GtkFontButton_(font_button))));
+ #define H_gtk_entry_completion_set_inline_completion "void gtk_entry_completion_set_inline_completion(GtkEntryCompletion* completion, \
+gboolean inline_completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_inline_completion", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gboolean(inline_completion), inline_completion, 2, "gtk_entry_completion_set_inline_completion", "gboolean");
+ gtk_entry_completion_set_inline_completion(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gboolean(inline_completion));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_button_set_use_size(XEN font_button, XEN use_size)
+static Xen gxg_gtk_entry_completion_get_inline_completion(Xen completion)
{
- #define H_gtk_font_button_set_use_size "void gtk_font_button_set_use_size(GtkFontButton* font_button, \
-gboolean use_size)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_set_use_size", "GtkFontButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_size), use_size, 2, "gtk_font_button_set_use_size", "gboolean");
- gtk_font_button_set_use_size(XEN_TO_C_GtkFontButton_(font_button), XEN_TO_C_gboolean(use_size));
- return(XEN_FALSE);
+ #define H_gtk_entry_completion_get_inline_completion "gboolean gtk_entry_completion_get_inline_completion(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_inline_completion", "GtkEntryCompletion*");
+ return(C_to_Xen_gboolean(gtk_entry_completion_get_inline_completion(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_gtk_font_button_get_font_name(XEN font_button)
+static Xen gxg_gtk_entry_completion_set_popup_completion(Xen completion, Xen popup_completion)
{
- #define H_gtk_font_button_get_font_name "gchar* gtk_font_button_get_font_name(GtkFontButton* font_button)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_get_font_name", "GtkFontButton*");
- return(C_TO_XEN_gchar_(gtk_font_button_get_font_name(XEN_TO_C_GtkFontButton_(font_button))));
+ #define H_gtk_entry_completion_set_popup_completion "void gtk_entry_completion_set_popup_completion(GtkEntryCompletion* completion, \
+gboolean popup_completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_popup_completion", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gboolean(popup_completion), popup_completion, 2, "gtk_entry_completion_set_popup_completion", "gboolean");
+ gtk_entry_completion_set_popup_completion(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gboolean(popup_completion));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_button_set_font_name(XEN font_button, XEN fontname)
+static Xen gxg_gtk_entry_completion_get_popup_completion(Xen completion)
{
- #define H_gtk_font_button_set_font_name "gboolean gtk_font_button_set_font_name(GtkFontButton* font_button, \
-gchar* fontname)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_set_font_name", "GtkFontButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(fontname), fontname, 2, "gtk_font_button_set_font_name", "gchar*");
- return(C_TO_XEN_gboolean(gtk_font_button_set_font_name(XEN_TO_C_GtkFontButton_(font_button), XEN_TO_C_gchar_(fontname))));
+ #define H_gtk_entry_completion_get_popup_completion "gboolean gtk_entry_completion_get_popup_completion(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_popup_completion", "GtkEntryCompletion*");
+ return(C_to_Xen_gboolean(gtk_entry_completion_get_popup_completion(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_gtk_font_button_get_show_style(XEN font_button)
+static Xen gxg_gtk_entry_completion_get_text_column(Xen completion)
{
- #define H_gtk_font_button_get_show_style "gboolean gtk_font_button_get_show_style(GtkFontButton* font_button)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_get_show_style", "GtkFontButton*");
- return(C_TO_XEN_gboolean(gtk_font_button_get_show_style(XEN_TO_C_GtkFontButton_(font_button))));
+ #define H_gtk_entry_completion_get_text_column "gint gtk_entry_completion_get_text_column(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_text_column", "GtkEntryCompletion*");
+ return(C_to_Xen_gint(gtk_entry_completion_get_text_column(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_gtk_font_button_set_show_style(XEN font_button, XEN show_style)
+static Xen gxg_gtk_icon_theme_get_icon_sizes(Xen icon_theme, Xen icon_name)
{
- #define H_gtk_font_button_set_show_style "void gtk_font_button_set_show_style(GtkFontButton* font_button, \
-gboolean show_style)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_set_show_style", "GtkFontButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_style), show_style, 2, "gtk_font_button_set_show_style", "gboolean");
- gtk_font_button_set_show_style(XEN_TO_C_GtkFontButton_(font_button), XEN_TO_C_gboolean(show_style));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_get_icon_sizes "gint* gtk_icon_theme_get_icon_sizes(GtkIconTheme* icon_theme, \
+gchar* icon_name)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_get_icon_sizes", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_icon_theme_get_icon_sizes", "gchar*");
+ return(C_to_Xen_gint_(gtk_icon_theme_get_icon_sizes(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_gchar_(icon_name))));
}
-static XEN gxg_gtk_font_button_get_show_size(XEN font_button)
+static Xen gxg_gtk_menu_get_for_attach_widget(Xen widget )
{
- #define H_gtk_font_button_get_show_size "gboolean gtk_font_button_get_show_size(GtkFontButton* font_button)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_get_show_size", "GtkFontButton*");
- return(C_TO_XEN_gboolean(gtk_font_button_get_show_size(XEN_TO_C_GtkFontButton_(font_button))));
+ #define H_gtk_menu_get_for_attach_widget "GList* gtk_menu_get_for_attach_widget(GtkWidget* widget, \
+)"
+ Xen_check_type(Xen_is_GtkWidget_(widget ), widget , 1, "gtk_menu_get_for_attach_widget", "GtkWidget*");
+ return(C_to_Xen_GList_(gtk_menu_get_for_attach_widget(Xen_to_C_GtkWidget_(widget ))));
}
-static XEN gxg_gtk_font_button_set_show_size(XEN font_button, XEN show_size)
+static Xen gxg_gtk_tree_view_set_fixed_height_mode(Xen tree_view, Xen enable)
{
- #define H_gtk_font_button_set_show_size "void gtk_font_button_set_show_size(GtkFontButton* font_button, \
-gboolean show_size)"
- XEN_ASSERT_TYPE(XEN_GtkFontButton__P(font_button), font_button, 1, "gtk_font_button_set_show_size", "GtkFontButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_size), show_size, 2, "gtk_font_button_set_show_size", "gboolean");
- gtk_font_button_set_show_size(XEN_TO_C_GtkFontButton_(font_button), XEN_TO_C_gboolean(show_size));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_fixed_height_mode "void gtk_tree_view_set_fixed_height_mode(GtkTreeView* tree_view, \
+gboolean enable)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_fixed_height_mode", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(enable), enable, 2, "gtk_tree_view_set_fixed_height_mode", "gboolean");
+ gtk_tree_view_set_fixed_height_mode(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(enable));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_button_new(void)
+static Xen gxg_gtk_tree_view_get_fixed_height_mode(Xen tree_view)
{
- #define H_gtk_color_button_new "GtkWidget* gtk_color_button_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_color_button_new()));
+ #define H_gtk_tree_view_get_fixed_height_mode "gboolean gtk_tree_view_get_fixed_height_mode(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_fixed_height_mode", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_fixed_height_mode(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_color_button_new_with_color(XEN color)
+static Xen gxg_gtk_tree_view_set_hover_selection(Xen tree_view, Xen hover)
{
- #define H_gtk_color_button_new_with_color "GtkWidget* gtk_color_button_new_with_color(GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 1, "gtk_color_button_new_with_color", "GdkColor*");
- return(C_TO_XEN_GtkWidget_(gtk_color_button_new_with_color(XEN_TO_C_GdkColor_(color))));
+ #define H_gtk_tree_view_set_hover_selection "void gtk_tree_view_set_hover_selection(GtkTreeView* tree_view, \
+gboolean hover)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_hover_selection", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(hover), hover, 2, "gtk_tree_view_set_hover_selection", "gboolean");
+ gtk_tree_view_set_hover_selection(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(hover));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_button_set_color(XEN color_button, XEN color)
+static Xen gxg_gtk_tree_view_get_hover_selection(Xen tree_view)
{
- #define H_gtk_color_button_set_color "void gtk_color_button_set_color(GtkColorButton* color_button, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_set_color", "GtkColorButton*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gtk_color_button_set_color", "GdkColor*");
- gtk_color_button_set_color(XEN_TO_C_GtkColorButton_(color_button), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_hover_selection "gboolean gtk_tree_view_get_hover_selection(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_hover_selection", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_hover_selection(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_color_button_set_alpha(XEN color_button, XEN alpha)
+static Xen gxg_gtk_tree_view_set_row_separator_func(Xen tree_view, Xen func, Xen func_info, Xen destroy)
{
- #define H_gtk_color_button_set_alpha "void gtk_color_button_set_alpha(GtkColorButton* color_button, \
-guint16 alpha)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_set_alpha", "GtkColorButton*");
- XEN_ASSERT_TYPE(XEN_guint16_P(alpha), alpha, 2, "gtk_color_button_set_alpha", "guint16");
- gtk_color_button_set_alpha(XEN_TO_C_GtkColorButton_(color_button), XEN_TO_C_guint16(alpha));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_row_separator_func "void gtk_tree_view_set_row_separator_func(GtkTreeView* tree_view, \
+GtkTreeViewRowSeparatorFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_row_separator_func", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewRowSeparatorFunc(func), func, 2, "gtk_tree_view_set_row_separator_func", "GtkTreeViewRowSeparatorFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_view_set_row_separator_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(destroy), destroy, 4, "gtk_tree_view_set_row_separator_func", "GtkDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 3, destroy);
+ gtk_tree_view_set_row_separator_func(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewRowSeparatorFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GtkDestroyNotify(destroy));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_color_button_get_color(XEN color_button, XEN color)
+static Xen gxg_gtk_window_set_focus_on_map(Xen window, Xen setting)
{
- #define H_gtk_color_button_get_color "void gtk_color_button_get_color(GtkColorButton* color_button, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_get_color", "GtkColorButton*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gtk_color_button_get_color", "GdkColor*");
- gtk_color_button_get_color(XEN_TO_C_GtkColorButton_(color_button), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_window_set_focus_on_map "void gtk_window_set_focus_on_map(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_focus_on_map", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_focus_on_map", "gboolean");
+ gtk_window_set_focus_on_map(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_button_get_alpha(XEN color_button)
+static Xen gxg_gtk_window_get_focus_on_map(Xen window)
{
- #define H_gtk_color_button_get_alpha "guint16 gtk_color_button_get_alpha(GtkColorButton* color_button)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_get_alpha", "GtkColorButton*");
- return(C_TO_XEN_guint16(gtk_color_button_get_alpha(XEN_TO_C_GtkColorButton_(color_button))));
+ #define H_gtk_window_get_focus_on_map "gboolean gtk_window_get_focus_on_map(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_focus_on_map", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_focus_on_map(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_color_button_set_use_alpha(XEN color_button, XEN use_alpha)
+static Xen gxg_gtk_window_set_icon_name(Xen window, Xen name)
{
- #define H_gtk_color_button_set_use_alpha "void gtk_color_button_set_use_alpha(GtkColorButton* color_button, \
-gboolean use_alpha)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_set_use_alpha", "GtkColorButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_alpha), use_alpha, 2, "gtk_color_button_set_use_alpha", "gboolean");
- gtk_color_button_set_use_alpha(XEN_TO_C_GtkColorButton_(color_button), XEN_TO_C_gboolean(use_alpha));
- return(XEN_FALSE);
+ #define H_gtk_window_set_icon_name "void gtk_window_set_icon_name(GtkWindow* window, gchar* name)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_icon_name", "GtkWindow*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_window_set_icon_name", "gchar*");
+ gtk_window_set_icon_name(Xen_to_C_GtkWindow_(window), Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_button_get_use_alpha(XEN color_button)
+static Xen gxg_gtk_window_get_icon_name(Xen window)
{
- #define H_gtk_color_button_get_use_alpha "gboolean gtk_color_button_get_use_alpha(GtkColorButton* color_button)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_get_use_alpha", "GtkColorButton*");
- return(C_TO_XEN_gboolean(gtk_color_button_get_use_alpha(XEN_TO_C_GtkColorButton_(color_button))));
+ #define H_gtk_window_get_icon_name "gchar* gtk_window_get_icon_name(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_icon_name", "GtkWindow*");
+ return(C_to_Xen_gchar_(gtk_window_get_icon_name(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_color_button_set_title(XEN color_button, XEN title)
+static Xen gxg_gtk_window_set_default_icon_name(Xen name)
{
- #define H_gtk_color_button_set_title "void gtk_color_button_set_title(GtkColorButton* color_button, \
-gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_set_title", "GtkColorButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gtk_color_button_set_title", "gchar*");
- gtk_color_button_set_title(XEN_TO_C_GtkColorButton_(color_button), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_gtk_window_set_default_icon_name "void gtk_window_set_default_icon_name(gchar* name)"
+ Xen_check_type(Xen_is_gchar_(name), name, 1, "gtk_window_set_default_icon_name", "gchar*");
+ gtk_window_set_default_icon_name(Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_button_get_title(XEN color_button)
+static Xen gxg_gtk_about_dialog_new(void)
{
- #define H_gtk_color_button_get_title "gchar* gtk_color_button_get_title(GtkColorButton* color_button)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_get_title", "GtkColorButton*");
- return(C_TO_XEN_gchar_(gtk_color_button_get_title(XEN_TO_C_GtkColorButton_(color_button))));
+ #define H_gtk_about_dialog_new "GtkWidget* gtk_about_dialog_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_about_dialog_new()));
}
-static XEN gxg_gtk_entry_completion_new(void)
+static Xen gxg_gtk_about_dialog_get_version(Xen about)
{
- #define H_gtk_entry_completion_new "GtkEntryCompletion* gtk_entry_completion_new( void)"
- return(C_TO_XEN_GtkEntryCompletion_(gtk_entry_completion_new()));
+ #define H_gtk_about_dialog_get_version "gchar* gtk_about_dialog_get_version(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_version", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_(gtk_about_dialog_get_version(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_entry_completion_get_entry(XEN entry)
+static Xen gxg_gtk_about_dialog_set_version(Xen about, Xen version)
{
- #define H_gtk_entry_completion_get_entry "GtkWidget* gtk_entry_completion_get_entry(GtkEntryCompletion* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(entry), entry, 1, "gtk_entry_completion_get_entry", "GtkEntryCompletion*");
- return(C_TO_XEN_GtkWidget_(gtk_entry_completion_get_entry(XEN_TO_C_GtkEntryCompletion_(entry))));
+ #define H_gtk_about_dialog_set_version "void gtk_about_dialog_set_version(GtkAboutDialog* about, gchar* version)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_version", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(version), version, 2, "gtk_about_dialog_set_version", "gchar*");
+ gtk_about_dialog_set_version(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_gchar_(version));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_completion_set_model(XEN completion, XEN model)
+static Xen gxg_gtk_about_dialog_get_copyright(Xen about)
{
- #define H_gtk_entry_completion_set_model "void gtk_entry_completion_set_model(GtkEntryCompletion* completion, \
-GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_model", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model) || XEN_FALSE_P(model), model, 2, "gtk_entry_completion_set_model", "GtkTreeModel*");
- gtk_entry_completion_set_model(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_GtkTreeModel_(model));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_get_copyright "gchar* gtk_about_dialog_get_copyright(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_copyright", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_(gtk_about_dialog_get_copyright(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_entry_completion_get_model(XEN completion)
+static Xen gxg_gtk_about_dialog_set_copyright(Xen about, Xen copyright)
{
- #define H_gtk_entry_completion_get_model "GtkTreeModel* gtk_entry_completion_get_model(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_model", "GtkEntryCompletion*");
- return(C_TO_XEN_GtkTreeModel_(gtk_entry_completion_get_model(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gtk_about_dialog_set_copyright "void gtk_about_dialog_set_copyright(GtkAboutDialog* about, \
+gchar* copyright)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_copyright", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(copyright), copyright, 2, "gtk_about_dialog_set_copyright", "gchar*");
+ gtk_about_dialog_set_copyright(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_gchar_(copyright));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_completion_set_match_func(XEN completion, XEN func, XEN func_info, XEN func_notify)
+static Xen gxg_gtk_about_dialog_get_comments(Xen about)
{
- #define H_gtk_entry_completion_set_match_func "void gtk_entry_completion_set_match_func(GtkEntryCompletion* completion, \
-GtkEntryCompletionMatchFunc func, lambda_data func_info, GtkDestroyNotify func_notify)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_match_func", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletionMatchFunc_P(func), func, 2, "gtk_entry_completion_set_match_func", "GtkEntryCompletionMatchFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_entry_completion_set_match_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(func_notify), func_notify, 4, "gtk_entry_completion_set_match_func", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, func_notify);
- gtk_entry_completion_set_match_func(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_GtkEntryCompletionMatchFunc(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(func_notify));
- return(XEN_FALSE);
- }
+ #define H_gtk_about_dialog_get_comments "gchar* gtk_about_dialog_get_comments(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_comments", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_(gtk_about_dialog_get_comments(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_entry_completion_set_minimum_key_length(XEN completion, XEN length)
+static Xen gxg_gtk_about_dialog_set_comments(Xen about, Xen comments)
{
- #define H_gtk_entry_completion_set_minimum_key_length "void gtk_entry_completion_set_minimum_key_length(GtkEntryCompletion* completion, \
-gint length)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_minimum_key_length", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gint_P(length), length, 2, "gtk_entry_completion_set_minimum_key_length", "gint");
- gtk_entry_completion_set_minimum_key_length(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gint(length));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_set_comments "void gtk_about_dialog_set_comments(GtkAboutDialog* about, \
+gchar* comments)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_comments", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(comments), comments, 2, "gtk_about_dialog_set_comments", "gchar*");
+ gtk_about_dialog_set_comments(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_gchar_(comments));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_completion_get_minimum_key_length(XEN completion)
+static Xen gxg_gtk_about_dialog_get_website(Xen about)
{
- #define H_gtk_entry_completion_get_minimum_key_length "gint gtk_entry_completion_get_minimum_key_length(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_minimum_key_length", "GtkEntryCompletion*");
- return(C_TO_XEN_gint(gtk_entry_completion_get_minimum_key_length(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gtk_about_dialog_get_website "gchar* gtk_about_dialog_get_website(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_website", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_(gtk_about_dialog_get_website(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_entry_completion_complete(XEN completion)
+static Xen gxg_gtk_about_dialog_set_website(Xen about, Xen website)
{
- #define H_gtk_entry_completion_complete "void gtk_entry_completion_complete(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_complete", "GtkEntryCompletion*");
- gtk_entry_completion_complete(XEN_TO_C_GtkEntryCompletion_(completion));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_set_website "void gtk_about_dialog_set_website(GtkAboutDialog* about, gchar* website)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_website", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(website), website, 2, "gtk_about_dialog_set_website", "gchar*");
+ gtk_about_dialog_set_website(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_gchar_(website));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_completion_insert_action_text(XEN completion, XEN index, XEN text)
+static Xen gxg_gtk_about_dialog_get_website_label(Xen about)
{
- #define H_gtk_entry_completion_insert_action_text "void gtk_entry_completion_insert_action_text(GtkEntryCompletion* completion, \
-gint index, gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_insert_action_text", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gint_P(index), index, 2, "gtk_entry_completion_insert_action_text", "gint");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_entry_completion_insert_action_text", "gchar*");
- gtk_entry_completion_insert_action_text(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gint(index), XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_get_website_label "gchar* gtk_about_dialog_get_website_label(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_website_label", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_(gtk_about_dialog_get_website_label(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_entry_completion_insert_action_markup(XEN completion, XEN index, XEN markup)
+static Xen gxg_gtk_about_dialog_set_website_label(Xen about, Xen website_label)
{
- #define H_gtk_entry_completion_insert_action_markup "void gtk_entry_completion_insert_action_markup(GtkEntryCompletion* completion, \
-gint index, gchar* markup)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_insert_action_markup", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gint_P(index), index, 2, "gtk_entry_completion_insert_action_markup", "gint");
- XEN_ASSERT_TYPE(XEN_gchar__P(markup), markup, 3, "gtk_entry_completion_insert_action_markup", "gchar*");
- gtk_entry_completion_insert_action_markup(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gint(index), XEN_TO_C_gchar_(markup));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_set_website_label "void gtk_about_dialog_set_website_label(GtkAboutDialog* about, \
+gchar* website_label)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_website_label", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(website_label), website_label, 2, "gtk_about_dialog_set_website_label", "gchar*");
+ gtk_about_dialog_set_website_label(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_gchar_(website_label));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_completion_delete_action(XEN completion, XEN index)
+static Xen gxg_gtk_about_dialog_get_authors(Xen about)
{
- #define H_gtk_entry_completion_delete_action "void gtk_entry_completion_delete_action(GtkEntryCompletion* completion, \
-gint index)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_delete_action", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gint_P(index), index, 2, "gtk_entry_completion_delete_action", "gint");
- gtk_entry_completion_delete_action(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gint(index));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_get_authors "gchar** gtk_about_dialog_get_authors(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_authors", "GtkAboutDialog*");
+ return(C_to_Xen_gchar__((gchar**)gtk_about_dialog_get_authors(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_entry_completion_set_text_column(XEN completion, XEN column)
+static Xen gxg_gtk_about_dialog_set_authors(Xen about, Xen authors)
{
- #define H_gtk_entry_completion_set_text_column "void gtk_entry_completion_set_text_column(GtkEntryCompletion* completion, \
-gint column)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_text_column", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 2, "gtk_entry_completion_set_text_column", "gint");
- gtk_entry_completion_set_text_column(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_set_authors "void gtk_about_dialog_set_authors(GtkAboutDialog* about, gchar** authors)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_authors", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar__(authors), authors, 2, "gtk_about_dialog_set_authors", "gchar**");
+ gtk_about_dialog_set_authors(Xen_to_C_GtkAboutDialog_(about), (const gchar**)Xen_to_C_gchar__(authors));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_tool_button_new(XEN group)
+static Xen gxg_gtk_about_dialog_get_documenters(Xen about)
{
- #define H_gtk_radio_tool_button_new "GtkToolItem* gtk_radio_tool_button_new(GSList* group)"
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 1, "gtk_radio_tool_button_new", "GSList*");
- return(C_TO_XEN_GtkToolItem_(gtk_radio_tool_button_new(XEN_TO_C_GSList_(group))));
+ #define H_gtk_about_dialog_get_documenters "gchar** gtk_about_dialog_get_documenters(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_documenters", "GtkAboutDialog*");
+ return(C_to_Xen_gchar__((gchar**)gtk_about_dialog_get_documenters(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_radio_tool_button_new_from_stock(XEN group, XEN stock_id)
+static Xen gxg_gtk_about_dialog_set_documenters(Xen about, Xen documenters)
{
- #define H_gtk_radio_tool_button_new_from_stock "GtkToolItem* gtk_radio_tool_button_new_from_stock(GSList* group, \
-gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 1, "gtk_radio_tool_button_new_from_stock", "GSList*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_radio_tool_button_new_from_stock", "gchar*");
- return(C_TO_XEN_GtkToolItem_(gtk_radio_tool_button_new_from_stock(XEN_TO_C_GSList_(group), XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_about_dialog_set_documenters "void gtk_about_dialog_set_documenters(GtkAboutDialog* about, \
+gchar** documenters)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_documenters", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar__(documenters), documenters, 2, "gtk_about_dialog_set_documenters", "gchar**");
+ gtk_about_dialog_set_documenters(Xen_to_C_GtkAboutDialog_(about), (const gchar**)Xen_to_C_gchar__(documenters));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_tool_button_new_from_widget(XEN group)
+static Xen gxg_gtk_about_dialog_get_artists(Xen about)
{
- #define H_gtk_radio_tool_button_new_from_widget "GtkToolItem* gtk_radio_tool_button_new_from_widget(GtkRadioToolButton* group)"
- XEN_ASSERT_TYPE(XEN_GtkRadioToolButton__P(group), group, 1, "gtk_radio_tool_button_new_from_widget", "GtkRadioToolButton*");
- return(C_TO_XEN_GtkToolItem_(gtk_radio_tool_button_new_from_widget(XEN_TO_C_GtkRadioToolButton_(group))));
+ #define H_gtk_about_dialog_get_artists "gchar** gtk_about_dialog_get_artists(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_artists", "GtkAboutDialog*");
+ return(C_to_Xen_gchar__((gchar**)gtk_about_dialog_get_artists(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_radio_tool_button_new_with_stock_from_widget(XEN group, XEN stock_id)
+static Xen gxg_gtk_about_dialog_set_artists(Xen about, Xen artists)
{
- #define H_gtk_radio_tool_button_new_with_stock_from_widget "GtkToolItem* gtk_radio_tool_button_new_with_stock_from_widget(GtkRadioToolButton* group, \
-gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GtkRadioToolButton__P(group), group, 1, "gtk_radio_tool_button_new_with_stock_from_widget", "GtkRadioToolButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_radio_tool_button_new_with_stock_from_widget", "gchar*");
- return(C_TO_XEN_GtkToolItem_(gtk_radio_tool_button_new_with_stock_from_widget(XEN_TO_C_GtkRadioToolButton_(group), XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_about_dialog_set_artists "void gtk_about_dialog_set_artists(GtkAboutDialog* about, gchar** artists)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_artists", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar__(artists), artists, 2, "gtk_about_dialog_set_artists", "gchar**");
+ gtk_about_dialog_set_artists(Xen_to_C_GtkAboutDialog_(about), (const gchar**)Xen_to_C_gchar__(artists));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_tool_button_get_group(XEN button)
+static Xen gxg_gtk_about_dialog_get_translator_credits(Xen about)
{
- #define H_gtk_radio_tool_button_get_group "GSList* gtk_radio_tool_button_get_group(GtkRadioToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkRadioToolButton__P(button), button, 1, "gtk_radio_tool_button_get_group", "GtkRadioToolButton*");
- return(C_TO_XEN_GSList_(gtk_radio_tool_button_get_group(XEN_TO_C_GtkRadioToolButton_(button))));
+ #define H_gtk_about_dialog_get_translator_credits "gchar* gtk_about_dialog_get_translator_credits(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_translator_credits", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_(gtk_about_dialog_get_translator_credits(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_radio_tool_button_set_group(XEN button, XEN group)
+static Xen gxg_gtk_about_dialog_set_translator_credits(Xen about, Xen translator_credits)
{
- #define H_gtk_radio_tool_button_set_group "void gtk_radio_tool_button_set_group(GtkRadioToolButton* button, \
-GSList* group)"
- XEN_ASSERT_TYPE(XEN_GtkRadioToolButton__P(button), button, 1, "gtk_radio_tool_button_set_group", "GtkRadioToolButton*");
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 2, "gtk_radio_tool_button_set_group", "GSList*");
- gtk_radio_tool_button_set_group(XEN_TO_C_GtkRadioToolButton_(button), XEN_TO_C_GSList_(group));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_set_translator_credits "void gtk_about_dialog_set_translator_credits(GtkAboutDialog* about, \
+gchar* translator_credits)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_translator_credits", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(translator_credits), translator_credits, 2, "gtk_about_dialog_set_translator_credits", "gchar*");
+ gtk_about_dialog_set_translator_credits(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_gchar_(translator_credits));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_action_get_group(XEN action)
+static Xen gxg_gtk_about_dialog_get_logo(Xen about)
{
- #define H_gtk_radio_action_get_group "GSList* gtk_radio_action_get_group(GtkRadioAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkRadioAction__P(action), action, 1, "gtk_radio_action_get_group", "GtkRadioAction*");
- return(C_TO_XEN_GSList_(gtk_radio_action_get_group(XEN_TO_C_GtkRadioAction_(action))));
+ #define H_gtk_about_dialog_get_logo "GdkPixbuf* gtk_about_dialog_get_logo(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_logo", "GtkAboutDialog*");
+ return(C_to_Xen_GdkPixbuf_(gtk_about_dialog_get_logo(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_radio_action_set_group(XEN action, XEN group)
+static Xen gxg_gtk_about_dialog_set_logo(Xen about, Xen logo)
{
- #define H_gtk_radio_action_set_group "void gtk_radio_action_set_group(GtkRadioAction* action, GSList* group)"
- XEN_ASSERT_TYPE(XEN_GtkRadioAction__P(action), action, 1, "gtk_radio_action_set_group", "GtkRadioAction*");
- XEN_ASSERT_TYPE(XEN_GSList__P(group) || XEN_FALSE_P(group), group, 2, "gtk_radio_action_set_group", "GSList*");
- gtk_radio_action_set_group(XEN_TO_C_GtkRadioAction_(action), XEN_TO_C_GSList_(group));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_set_logo "void gtk_about_dialog_set_logo(GtkAboutDialog* about, GdkPixbuf* logo)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_logo", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_GdkPixbuf_(logo) || Xen_is_false(logo), logo, 2, "gtk_about_dialog_set_logo", "GdkPixbuf*");
+ gtk_about_dialog_set_logo(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_GdkPixbuf_(logo));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_action_get_current_value(XEN action)
+static Xen gxg_gtk_about_dialog_get_program_name(Xen about)
{
- #define H_gtk_radio_action_get_current_value "gint gtk_radio_action_get_current_value(GtkRadioAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkRadioAction__P(action), action, 1, "gtk_radio_action_get_current_value", "GtkRadioAction*");
- return(C_TO_XEN_gint(gtk_radio_action_get_current_value(XEN_TO_C_GtkRadioAction_(action))));
+ #define H_gtk_about_dialog_get_program_name "gchar* gtk_about_dialog_get_program_name(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_program_name", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_(gtk_about_dialog_get_program_name(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_separator_tool_item_new(void)
+static Xen gxg_gtk_about_dialog_set_program_name(Xen about, Xen name)
{
- #define H_gtk_separator_tool_item_new "GtkToolItem* gtk_separator_tool_item_new( void)"
- return(C_TO_XEN_GtkToolItem_(gtk_separator_tool_item_new()));
+ #define H_gtk_about_dialog_set_program_name "void gtk_about_dialog_set_program_name(GtkAboutDialog* about, \
+gchar* name)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_program_name", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_about_dialog_set_program_name", "gchar*");
+ gtk_about_dialog_set_program_name(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_separator_tool_item_get_draw(XEN item)
+static Xen gxg_gtk_icon_view_new(void)
{
- #define H_gtk_separator_tool_item_get_draw "gboolean gtk_separator_tool_item_get_draw(GtkSeparatorToolItem* item)"
- XEN_ASSERT_TYPE(XEN_GtkSeparatorToolItem__P(item), item, 1, "gtk_separator_tool_item_get_draw", "GtkSeparatorToolItem*");
- return(C_TO_XEN_gboolean(gtk_separator_tool_item_get_draw(XEN_TO_C_GtkSeparatorToolItem_(item))));
+ #define H_gtk_icon_view_new "GtkWidget* gtk_icon_view_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_icon_view_new()));
}
-static XEN gxg_gtk_separator_tool_item_set_draw(XEN tool_item, XEN draw)
+static Xen gxg_gtk_icon_view_new_with_model(Xen model)
{
- #define H_gtk_separator_tool_item_set_draw "void gtk_separator_tool_item_set_draw(GtkSeparatorToolItem* tool_item, \
-gboolean draw)"
- XEN_ASSERT_TYPE(XEN_GtkSeparatorToolItem__P(tool_item), tool_item, 1, "gtk_separator_tool_item_set_draw", "GtkSeparatorToolItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(draw), draw, 2, "gtk_separator_tool_item_set_draw", "gboolean");
- gtk_separator_tool_item_set_draw(XEN_TO_C_GtkSeparatorToolItem_(tool_item), XEN_TO_C_gboolean(draw));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_new_with_model "GtkWidget* gtk_icon_view_new_with_model(GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkTreeModel_(model), model, 1, "gtk_icon_view_new_with_model", "GtkTreeModel*");
+ return(C_to_Xen_GtkWidget_(gtk_icon_view_new_with_model(Xen_to_C_GtkTreeModel_(model))));
}
-static XEN gxg_gtk_toggle_action_toggled(XEN action)
+static Xen gxg_gtk_icon_view_set_model(Xen icon_view, Xen model)
{
- #define H_gtk_toggle_action_toggled "void gtk_toggle_action_toggled(GtkToggleAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkToggleAction__P(action), action, 1, "gtk_toggle_action_toggled", "GtkToggleAction*");
- gtk_toggle_action_toggled(XEN_TO_C_GtkToggleAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_set_model "void gtk_icon_view_set_model(GtkIconView* icon_view, GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_model", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreeModel_(model) || Xen_is_false(model), model, 2, "gtk_icon_view_set_model", "GtkTreeModel*");
+ gtk_icon_view_set_model(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreeModel_(model));
+ return(Xen_false);
}
-static XEN gxg_gtk_toggle_action_set_active(XEN action, XEN is_active)
+static Xen gxg_gtk_icon_view_get_model(Xen icon_view)
{
- #define H_gtk_toggle_action_set_active "void gtk_toggle_action_set_active(GtkToggleAction* action, \
-gboolean is_active)"
- XEN_ASSERT_TYPE(XEN_GtkToggleAction__P(action), action, 1, "gtk_toggle_action_set_active", "GtkToggleAction*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_active), is_active, 2, "gtk_toggle_action_set_active", "gboolean");
- gtk_toggle_action_set_active(XEN_TO_C_GtkToggleAction_(action), XEN_TO_C_gboolean(is_active));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_get_model "GtkTreeModel* gtk_icon_view_get_model(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_model", "GtkIconView*");
+ return(C_to_Xen_GtkTreeModel_(gtk_icon_view_get_model(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_toggle_action_get_active(XEN action)
+static Xen gxg_gtk_icon_view_set_text_column(Xen icon_view, Xen column)
{
- #define H_gtk_toggle_action_get_active "gboolean gtk_toggle_action_get_active(GtkToggleAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkToggleAction__P(action), action, 1, "gtk_toggle_action_get_active", "GtkToggleAction*");
- return(C_TO_XEN_gboolean(gtk_toggle_action_get_active(XEN_TO_C_GtkToggleAction_(action))));
+ #define H_gtk_icon_view_set_text_column "void gtk_icon_view_set_text_column(GtkIconView* icon_view, \
+gint column)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_text_column", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(column), column, 2, "gtk_icon_view_set_text_column", "gint");
+ gtk_icon_view_set_text_column(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_toggle_action_set_draw_as_radio(XEN action, XEN draw_as_radio)
+static Xen gxg_gtk_icon_view_get_text_column(Xen icon_view)
{
- #define H_gtk_toggle_action_set_draw_as_radio "void gtk_toggle_action_set_draw_as_radio(GtkToggleAction* action, \
-gboolean draw_as_radio)"
- XEN_ASSERT_TYPE(XEN_GtkToggleAction__P(action), action, 1, "gtk_toggle_action_set_draw_as_radio", "GtkToggleAction*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(draw_as_radio), draw_as_radio, 2, "gtk_toggle_action_set_draw_as_radio", "gboolean");
- gtk_toggle_action_set_draw_as_radio(XEN_TO_C_GtkToggleAction_(action), XEN_TO_C_gboolean(draw_as_radio));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_get_text_column "gint gtk_icon_view_get_text_column(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_text_column", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_text_column(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_toggle_action_get_draw_as_radio(XEN action)
+static Xen gxg_gtk_icon_view_set_markup_column(Xen icon_view, Xen column)
{
- #define H_gtk_toggle_action_get_draw_as_radio "gboolean gtk_toggle_action_get_draw_as_radio(GtkToggleAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkToggleAction__P(action), action, 1, "gtk_toggle_action_get_draw_as_radio", "GtkToggleAction*");
- return(C_TO_XEN_gboolean(gtk_toggle_action_get_draw_as_radio(XEN_TO_C_GtkToggleAction_(action))));
+ #define H_gtk_icon_view_set_markup_column "void gtk_icon_view_set_markup_column(GtkIconView* icon_view, \
+gint column)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_markup_column", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(column), column, 2, "gtk_icon_view_set_markup_column", "gint");
+ gtk_icon_view_set_markup_column(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_toggle_tool_button_new(void)
+static Xen gxg_gtk_icon_view_get_markup_column(Xen icon_view)
{
- #define H_gtk_toggle_tool_button_new "GtkToolItem* gtk_toggle_tool_button_new( void)"
- return(C_TO_XEN_GtkToolItem_(gtk_toggle_tool_button_new()));
+ #define H_gtk_icon_view_get_markup_column "gint gtk_icon_view_get_markup_column(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_markup_column", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_markup_column(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_toggle_tool_button_new_from_stock(XEN stock_id)
+static Xen gxg_gtk_icon_view_set_pixbuf_column(Xen icon_view, Xen column)
{
- #define H_gtk_toggle_tool_button_new_from_stock "GtkToolItem* gtk_toggle_tool_button_new_from_stock(gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_toggle_tool_button_new_from_stock", "gchar*");
- return(C_TO_XEN_GtkToolItem_(gtk_toggle_tool_button_new_from_stock(XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_icon_view_set_pixbuf_column "void gtk_icon_view_set_pixbuf_column(GtkIconView* icon_view, \
+gint column)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_pixbuf_column", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(column), column, 2, "gtk_icon_view_set_pixbuf_column", "gint");
+ gtk_icon_view_set_pixbuf_column(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_toggle_tool_button_set_active(XEN button, XEN is_active)
+static Xen gxg_gtk_icon_view_get_pixbuf_column(Xen icon_view)
{
- #define H_gtk_toggle_tool_button_set_active "void gtk_toggle_tool_button_set_active(GtkToggleToolButton* button, \
-gboolean is_active)"
- XEN_ASSERT_TYPE(XEN_GtkToggleToolButton__P(button), button, 1, "gtk_toggle_tool_button_set_active", "GtkToggleToolButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_active), is_active, 2, "gtk_toggle_tool_button_set_active", "gboolean");
- gtk_toggle_tool_button_set_active(XEN_TO_C_GtkToggleToolButton_(button), XEN_TO_C_gboolean(is_active));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_get_pixbuf_column "gint gtk_icon_view_get_pixbuf_column(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_pixbuf_column", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_pixbuf_column(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_toggle_tool_button_get_active(XEN button)
+static Xen gxg_gtk_icon_view_get_path_at_pos(Xen icon_view, Xen x, Xen y)
{
- #define H_gtk_toggle_tool_button_get_active "gboolean gtk_toggle_tool_button_get_active(GtkToggleToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkToggleToolButton__P(button), button, 1, "gtk_toggle_tool_button_get_active", "GtkToggleToolButton*");
- return(C_TO_XEN_gboolean(gtk_toggle_tool_button_get_active(XEN_TO_C_GtkToggleToolButton_(button))));
+ #define H_gtk_icon_view_get_path_at_pos "GtkTreePath* gtk_icon_view_get_path_at_pos(GtkIconView* icon_view, \
+gint x, gint y)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_path_at_pos", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_icon_view_get_path_at_pos", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_icon_view_get_path_at_pos", "gint");
+ return(C_to_Xen_GtkTreePath_(gtk_icon_view_get_path_at_pos(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(x), Xen_to_C_gint(y))));
}
-static XEN gxg_g_timeout_add_full(XEN priority, XEN interval, XEN func, XEN func_info, XEN notify)
+static Xen gxg_gtk_icon_view_selected_foreach(Xen icon_view, Xen func, Xen func_info)
{
- #define H_g_timeout_add_full "guint g_timeout_add_full(gint priority, guint interval, GSourceFunc func, \
-lambda_data func_info, GtkDestroyNotify notify)"
- XEN_ASSERT_TYPE(XEN_gint_P(priority), priority, 1, "g_timeout_add_full", "gint");
- XEN_ASSERT_TYPE(XEN_guint_P(interval), interval, 2, "g_timeout_add_full", "guint");
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(func), func, 3, "g_timeout_add_full", "GSourceFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "g_timeout_add_full", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(notify), notify, 5, "g_timeout_add_full", "GtkDestroyNotify");
+ #define H_gtk_icon_view_selected_foreach "void gtk_icon_view_selected_foreach(GtkIconView* icon_view, \
+GtkIconViewForeachFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_selected_foreach", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkIconViewForeachFunc(func), func, 2, "gtk_icon_view_selected_foreach", "GtkIconViewForeachFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_icon_view_selected_foreach", "lambda_data");
{
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- XEN_LIST_SET(gxg_ptr, 3, notify);
- result = C_TO_XEN_guint(g_timeout_add_full(XEN_TO_C_gint(priority), XEN_TO_C_guint(interval), XEN_TO_C_GSourceFunc(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(notify)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ gtk_icon_view_selected_foreach(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkIconViewForeachFunc(func), Xen_to_C_lambda_data(func_info));
+ return(Xen_false);
}
}
-static XEN gxg_g_timeout_add(XEN interval, XEN func, XEN func_info)
+static Xen gxg_gtk_icon_view_set_selection_mode(Xen icon_view, Xen mode)
{
- #define H_g_timeout_add "guint g_timeout_add(guint interval, GSourceFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_guint_P(interval), interval, 1, "g_timeout_add", "guint");
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(func), func, 2, "g_timeout_add", "GSourceFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "g_timeout_add", "lambda_data");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(g_timeout_add(XEN_TO_C_guint(interval), XEN_TO_C_GSourceFunc(func), XEN_TO_C_lambda_data(func_info)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gtk_icon_view_set_selection_mode "void gtk_icon_view_set_selection_mode(GtkIconView* icon_view, \
+GtkSelectionMode mode)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_selection_mode", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkSelectionMode(mode), mode, 2, "gtk_icon_view_set_selection_mode", "GtkSelectionMode");
+ gtk_icon_view_set_selection_mode(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkSelectionMode(mode));
+ return(Xen_false);
}
-static XEN gxg_g_idle_add(XEN func, XEN func_info)
+static Xen gxg_gtk_icon_view_get_selection_mode(Xen icon_view)
{
- #define H_g_idle_add "guint g_idle_add(GSourceFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(func), func, 1, "g_idle_add", "GSourceFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 2, "g_idle_add", "lambda_data");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(g_idle_add(XEN_TO_C_GSourceFunc(func), XEN_TO_C_lambda_data(func_info)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gtk_icon_view_get_selection_mode "GtkSelectionMode gtk_icon_view_get_selection_mode(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_selection_mode", "GtkIconView*");
+ return(C_to_Xen_GtkSelectionMode(gtk_icon_view_get_selection_mode(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_g_idle_add_full(XEN priority, XEN func, XEN func_info, XEN notify)
+static Xen gxg_gtk_icon_view_select_path(Xen icon_view, Xen path)
{
- #define H_g_idle_add_full "guint g_idle_add_full(gint priority, GSourceFunc func, lambda_data func_info, \
-GtkDestroyNotify notify)"
- XEN_ASSERT_TYPE(XEN_gint_P(priority), priority, 1, "g_idle_add_full", "gint");
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(func), func, 2, "g_idle_add_full", "GSourceFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "g_idle_add_full", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(notify), notify, 4, "g_idle_add_full", "GtkDestroyNotify");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- XEN_LIST_SET(gxg_ptr, 3, notify);
- result = C_TO_XEN_guint(g_idle_add_full(XEN_TO_C_gint(priority), XEN_TO_C_GSourceFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GtkDestroyNotify(notify)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gtk_icon_view_select_path "void gtk_icon_view_select_path(GtkIconView* icon_view, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_select_path", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_select_path", "GtkTreePath*");
+ gtk_icon_view_select_path(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_g_idle_remove_by_data(XEN data)
+static Xen gxg_gtk_icon_view_unselect_path(Xen icon_view, Xen path)
{
- #define H_g_idle_remove_by_data "gboolean g_idle_remove_by_data(gpointer data)"
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 1, "g_idle_remove_by_data", "gpointer");
- return(C_TO_XEN_gboolean(g_idle_remove_by_data(XEN_TO_C_gpointer(data))));
- xm_unprotect_at(XEN_TO_C_INT(XEN_CADDR(data)));
+ #define H_gtk_icon_view_unselect_path "void gtk_icon_view_unselect_path(GtkIconView* icon_view, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_unselect_path", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_unselect_path", "GtkTreePath*");
+ gtk_icon_view_unselect_path(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_g_source_remove(XEN tag)
+static Xen gxg_gtk_icon_view_path_is_selected(Xen icon_view, Xen path)
{
- #define H_g_source_remove "gboolean g_source_remove(guint tag)"
- XEN_ASSERT_TYPE(XEN_guint_P(tag), tag, 1, "g_source_remove", "guint");
- return(C_TO_XEN_gboolean(g_source_remove(XEN_TO_C_guint(tag))));
- xm_unprotect_at(XEN_TO_C_INT(XEN_CADDR(tag)));
+ #define H_gtk_icon_view_path_is_selected "gboolean gtk_icon_view_path_is_selected(GtkIconView* icon_view, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_path_is_selected", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_path_is_selected", "GtkTreePath*");
+ return(C_to_Xen_gboolean(gtk_icon_view_path_is_selected(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_file_filter_new(void)
+static Xen gxg_gtk_icon_view_get_selected_items(Xen icon_view)
{
- #define H_gtk_file_filter_new "GtkFileFilter* gtk_file_filter_new( void)"
- return(C_TO_XEN_GtkFileFilter_(gtk_file_filter_new()));
+ #define H_gtk_icon_view_get_selected_items "GList* gtk_icon_view_get_selected_items(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_selected_items", "GtkIconView*");
+ return(C_to_Xen_GList_(gtk_icon_view_get_selected_items(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_file_filter_set_name(XEN filter, XEN name)
+static Xen gxg_gtk_icon_view_select_all(Xen icon_view)
{
- #define H_gtk_file_filter_set_name "void gtk_file_filter_set_name(GtkFileFilter* filter, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 1, "gtk_file_filter_set_name", "GtkFileFilter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_file_filter_set_name", "gchar*");
- gtk_file_filter_set_name(XEN_TO_C_GtkFileFilter_(filter), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_select_all "void gtk_icon_view_select_all(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_select_all", "GtkIconView*");
+ gtk_icon_view_select_all(Xen_to_C_GtkIconView_(icon_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_filter_get_name(XEN filter)
+static Xen gxg_gtk_icon_view_unselect_all(Xen icon_view)
{
- #define H_gtk_file_filter_get_name "gchar* gtk_file_filter_get_name(GtkFileFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 1, "gtk_file_filter_get_name", "GtkFileFilter*");
- return(C_TO_XEN_gchar_(gtk_file_filter_get_name(XEN_TO_C_GtkFileFilter_(filter))));
+ #define H_gtk_icon_view_unselect_all "void gtk_icon_view_unselect_all(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_unselect_all", "GtkIconView*");
+ gtk_icon_view_unselect_all(Xen_to_C_GtkIconView_(icon_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_filter_add_mime_type(XEN filter, XEN mime_type)
+static Xen gxg_gtk_icon_view_item_activated(Xen icon_view, Xen path)
{
- #define H_gtk_file_filter_add_mime_type "void gtk_file_filter_add_mime_type(GtkFileFilter* filter, \
-gchar* mime_type)"
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 1, "gtk_file_filter_add_mime_type", "GtkFileFilter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(mime_type), mime_type, 2, "gtk_file_filter_add_mime_type", "gchar*");
- gtk_file_filter_add_mime_type(XEN_TO_C_GtkFileFilter_(filter), XEN_TO_C_gchar_(mime_type));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_item_activated "void gtk_icon_view_item_activated(GtkIconView* icon_view, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_item_activated", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_item_activated", "GtkTreePath*");
+ gtk_icon_view_item_activated(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_filter_add_pattern(XEN filter, XEN pattern)
+static Xen gxg_gtk_cell_renderer_combo_new(void)
{
- #define H_gtk_file_filter_add_pattern "void gtk_file_filter_add_pattern(GtkFileFilter* filter, gchar* pattern)"
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 1, "gtk_file_filter_add_pattern", "GtkFileFilter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(pattern), pattern, 2, "gtk_file_filter_add_pattern", "gchar*");
- gtk_file_filter_add_pattern(XEN_TO_C_GtkFileFilter_(filter), XEN_TO_C_gchar_(pattern));
- return(XEN_FALSE);
+ #define H_gtk_cell_renderer_combo_new "GtkCellRenderer* gtk_cell_renderer_combo_new( void)"
+ return(C_to_Xen_GtkCellRenderer_(gtk_cell_renderer_combo_new()));
}
-static XEN gxg_gtk_file_filter_add_custom(XEN filter, XEN needed, XEN func, XEN func_info, XEN notify)
+static Xen gxg_gtk_cell_renderer_progress_new(void)
{
- #define H_gtk_file_filter_add_custom "void gtk_file_filter_add_custom(GtkFileFilter* filter, GtkFileFilterFlags needed, \
-GtkFileFilterFunc func, lambda_data func_info, GtkDestroyNotify notify)"
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 1, "gtk_file_filter_add_custom", "GtkFileFilter*");
- XEN_ASSERT_TYPE(XEN_GtkFileFilterFlags_P(needed), needed, 2, "gtk_file_filter_add_custom", "GtkFileFilterFlags");
- XEN_ASSERT_TYPE(XEN_GtkFileFilterFunc_P(func), func, 3, "gtk_file_filter_add_custom", "GtkFileFilterFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gtk_file_filter_add_custom", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(notify), notify, 5, "gtk_file_filter_add_custom", "GtkDestroyNotify");
+ #define H_gtk_cell_renderer_progress_new "GtkCellRenderer* gtk_cell_renderer_progress_new( void)"
+ return(C_to_Xen_GtkCellRenderer_(gtk_cell_renderer_progress_new()));
+}
+
+static Xen gxg_gtk_combo_box_set_row_separator_func(Xen combo_box, Xen func, Xen func_info, Xen destroy)
+{
+ #define H_gtk_combo_box_set_row_separator_func "void gtk_combo_box_set_row_separator_func(GtkComboBox* combo_box, \
+GtkTreeViewRowSeparatorFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_row_separator_func", "GtkComboBox*");
+ Xen_check_type(Xen_is_GtkTreeViewRowSeparatorFunc(func), func, 2, "gtk_combo_box_set_row_separator_func", "GtkTreeViewRowSeparatorFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_combo_box_set_row_separator_func", "lambda_data");
+ Xen_check_type(Xen_is_GtkDestroyNotify(destroy), destroy, 4, "gtk_combo_box_set_row_separator_func", "GtkDestroyNotify");
{
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, notify);
- gtk_file_filter_add_custom(XEN_TO_C_GtkFileFilter_(filter), XEN_TO_C_GtkFileFilterFlags(needed), XEN_TO_C_GtkFileFilterFunc(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(notify));
- return(XEN_FALSE);
+ Xen_list_set(gxg_ptr, 3, destroy);
+ gtk_combo_box_set_row_separator_func(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_GtkTreeViewRowSeparatorFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GtkDestroyNotify(destroy));
+ return(Xen_false);
}
}
-static XEN gxg_gtk_file_filter_get_needed(XEN filter)
+static Xen gxg_gtk_label_set_ellipsize(Xen label, Xen mode)
{
- #define H_gtk_file_filter_get_needed "GtkFileFilterFlags gtk_file_filter_get_needed(GtkFileFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 1, "gtk_file_filter_get_needed", "GtkFileFilter*");
- return(C_TO_XEN_GtkFileFilterFlags(gtk_file_filter_get_needed(XEN_TO_C_GtkFileFilter_(filter))));
+ #define H_gtk_label_set_ellipsize "void gtk_label_set_ellipsize(GtkLabel* label, PangoEllipsizeMode mode)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_ellipsize", "GtkLabel*");
+ Xen_check_type(Xen_is_PangoEllipsizeMode(mode), mode, 2, "gtk_label_set_ellipsize", "PangoEllipsizeMode");
+ gtk_label_set_ellipsize(Xen_to_C_GtkLabel_(label), Xen_to_C_PangoEllipsizeMode(mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_filter_filter(XEN filter, XEN filter_info)
+static Xen gxg_gtk_label_get_ellipsize(Xen label)
{
- #define H_gtk_file_filter_filter "gboolean gtk_file_filter_filter(GtkFileFilter* filter, GtkFileFilterInfo* filter_info)"
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 1, "gtk_file_filter_filter", "GtkFileFilter*");
- XEN_ASSERT_TYPE(XEN_GtkFileFilterInfo__P(filter_info), filter_info, 2, "gtk_file_filter_filter", "GtkFileFilterInfo*");
- return(C_TO_XEN_gboolean(gtk_file_filter_filter(XEN_TO_C_GtkFileFilter_(filter), XEN_TO_C_GtkFileFilterInfo_(filter_info))));
+ #define H_gtk_label_get_ellipsize "PangoEllipsizeMode gtk_label_get_ellipsize(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_ellipsize", "GtkLabel*");
+ return(C_to_Xen_PangoEllipsizeMode(gtk_label_get_ellipsize(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_cell_layout_pack_start(XEN cell_layout, XEN cell, XEN expand)
+static Xen gxg_pango_attr_fallback_new(Xen enable_fallback)
{
- #define H_gtk_cell_layout_pack_start "void gtk_cell_layout_pack_start(GtkCellLayout* cell_layout, GtkCellRenderer* cell, \
-gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_pack_start", "GtkCellLayout*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_cell_layout_pack_start", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 3, "gtk_cell_layout_pack_start", "gboolean");
- gtk_cell_layout_pack_start(XEN_TO_C_GtkCellLayout_(cell_layout), XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_pango_attr_fallback_new "PangoAttribute* pango_attr_fallback_new(gboolean enable_fallback)"
+ Xen_check_type(Xen_is_gboolean(enable_fallback), enable_fallback, 1, "pango_attr_fallback_new", "gboolean");
+ return(C_to_Xen_PangoAttribute_(pango_attr_fallback_new(Xen_to_C_gboolean(enable_fallback))));
}
-static XEN gxg_gtk_cell_layout_pack_end(XEN cell_layout, XEN cell, XEN expand)
+static Xen gxg_pango_attr_letter_spacing_new(Xen letter_spacing)
{
- #define H_gtk_cell_layout_pack_end "void gtk_cell_layout_pack_end(GtkCellLayout* cell_layout, GtkCellRenderer* cell, \
-gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_pack_end", "GtkCellLayout*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_cell_layout_pack_end", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 3, "gtk_cell_layout_pack_end", "gboolean");
- gtk_cell_layout_pack_end(XEN_TO_C_GtkCellLayout_(cell_layout), XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_pango_attr_letter_spacing_new "PangoAttribute* pango_attr_letter_spacing_new(int letter_spacing)"
+ Xen_check_type(Xen_is_int(letter_spacing), letter_spacing, 1, "pango_attr_letter_spacing_new", "int");
+ return(C_to_Xen_PangoAttribute_(pango_attr_letter_spacing_new(Xen_to_C_int(letter_spacing))));
}
-static XEN gxg_gtk_cell_layout_clear(XEN cell_layout)
+static Xen gxg_pango_attr_list_filter(Xen list, Xen func, Xen data)
{
- #define H_gtk_cell_layout_clear "void gtk_cell_layout_clear(GtkCellLayout* cell_layout)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_clear", "GtkCellLayout*");
- gtk_cell_layout_clear(XEN_TO_C_GtkCellLayout_(cell_layout));
- return(XEN_FALSE);
+ #define H_pango_attr_list_filter "PangoAttrList* pango_attr_list_filter(PangoAttrList* list, PangoAttrFilterFunc func, \
+gpointer data)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_filter", "PangoAttrList*");
+ Xen_check_type(Xen_is_PangoAttrFilterFunc(func), func, 2, "pango_attr_list_filter", "PangoAttrFilterFunc");
+ Xen_check_type(Xen_is_gpointer(data), data, 3, "pango_attr_list_filter", "gpointer");
+ return(C_to_Xen_PangoAttrList_(pango_attr_list_filter(Xen_to_C_PangoAttrList_(list), Xen_to_C_PangoAttrFilterFunc(func),
+ Xen_to_C_gpointer(data))));
}
-static XEN gxg_gtk_cell_layout_set_attributes(XEN cell_layout, XEN cell, XEN attributes)
+static Xen gxg_pango_attr_iterator_get_attrs(Xen iterator)
{
- #define H_gtk_cell_layout_set_attributes "void gtk_cell_layout_set_attributes(GtkCellLayout* cell_layout, \
-GtkCellRenderer* cell, etc attributes)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_set_attributes", "GtkCellLayout*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_cell_layout_set_attributes", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_etc_P(attributes), attributes, 3, "gtk_cell_layout_set_attributes", "etc");
- {
- int etc_len = 0;
- GtkCellLayout* p_arg0;
- GtkCellRenderer* p_arg1;
- if (XEN_LIST_P(attributes)) etc_len = XEN_LIST_LENGTH(attributes);
- if (etc_len < 2) XEN_OUT_OF_RANGE_ERROR("gtk_cell_layout_set_attributes", 2, attributes, "... list must have at least 2 entries");
- if (etc_len > 10) XEN_OUT_OF_RANGE_ERROR("gtk_cell_layout_set_attributes", 2, attributes, "... list too long (max len: 10)");
- if ((etc_len % 2) != 0) XEN_OUT_OF_RANGE_ERROR("gtk_cell_layout_set_attributes", 2, attributes, "... list len must be multiple of 2");
- p_arg0 = XEN_TO_C_GtkCellLayout_(cell_layout);
- p_arg1 = XEN_TO_C_GtkCellRenderer_(cell);
- switch (etc_len)
- {
- case 2: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), NULL); break;
- case 4: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), NULL); break;
- case 6: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), NULL); break;
- case 8: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), NULL); break;
- case 10: gtk_cell_layout_set_attributes(p_arg0, p_arg1, XLS(attributes, 0), XLI(attributes, 1), XLS(attributes, 2), XLI(attributes, 3), XLS(attributes, 4), XLI(attributes, 5), XLS(attributes, 6), XLI(attributes, 7), XLS(attributes, 8), XLI(attributes, 9), NULL); break;
- }
- return(XEN_FALSE);
- }
+ #define H_pango_attr_iterator_get_attrs "GSList* pango_attr_iterator_get_attrs(PangoAttrIterator* iterator)"
+ Xen_check_type(Xen_is_PangoAttrIterator_(iterator), iterator, 1, "pango_attr_iterator_get_attrs", "PangoAttrIterator*");
+ return(C_to_Xen_GSList_(pango_attr_iterator_get_attrs(Xen_to_C_PangoAttrIterator_(iterator))));
}
-static XEN gxg_gtk_cell_layout_add_attribute(XEN cell_layout, XEN cell, XEN attribute, XEN column)
+static Xen gxg_pango_font_metrics_get_underline_position(Xen metrics)
{
- #define H_gtk_cell_layout_add_attribute "void gtk_cell_layout_add_attribute(GtkCellLayout* cell_layout, \
-GtkCellRenderer* cell, gchar* attribute, gint column)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_add_attribute", "GtkCellLayout*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_cell_layout_add_attribute", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(attribute), attribute, 3, "gtk_cell_layout_add_attribute", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 4, "gtk_cell_layout_add_attribute", "gint");
- gtk_cell_layout_add_attribute(XEN_TO_C_GtkCellLayout_(cell_layout), XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gchar_(attribute),
- XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_pango_font_metrics_get_underline_position "int pango_font_metrics_get_underline_position(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_get_underline_position", "PangoFontMetrics*");
+ return(C_to_Xen_int(pango_font_metrics_get_underline_position(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_cell_layout_set_cell_data_func(XEN cell_layout, XEN cell, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_pango_font_metrics_get_underline_thickness(Xen metrics)
{
- #define H_gtk_cell_layout_set_cell_data_func "void gtk_cell_layout_set_cell_data_func(GtkCellLayout* cell_layout, \
-GtkCellRenderer* cell, GtkCellLayoutDataFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_set_cell_data_func", "GtkCellLayout*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_cell_layout_set_cell_data_func", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GtkCellLayoutDataFunc_P(func), func, 3, "gtk_cell_layout_set_cell_data_func", "GtkCellLayoutDataFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gtk_cell_layout_set_cell_data_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 5, "gtk_cell_layout_set_cell_data_func", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_cell_layout_set_cell_data_func(XEN_TO_C_GtkCellLayout_(cell_layout), XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GtkCellLayoutDataFunc(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GtkDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_pango_font_metrics_get_underline_thickness "int pango_font_metrics_get_underline_thickness(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_get_underline_thickness", "PangoFontMetrics*");
+ return(C_to_Xen_int(pango_font_metrics_get_underline_thickness(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_cell_layout_clear_attributes(XEN cell_layout, XEN cell)
+static Xen gxg_pango_font_metrics_get_strikethrough_position(Xen metrics)
{
- #define H_gtk_cell_layout_clear_attributes "void gtk_cell_layout_clear_attributes(GtkCellLayout* cell_layout, \
-GtkCellRenderer* cell)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_clear_attributes", "GtkCellLayout*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_cell_layout_clear_attributes", "GtkCellRenderer*");
- gtk_cell_layout_clear_attributes(XEN_TO_C_GtkCellLayout_(cell_layout), XEN_TO_C_GtkCellRenderer_(cell));
- return(XEN_FALSE);
+ #define H_pango_font_metrics_get_strikethrough_position "int pango_font_metrics_get_strikethrough_position(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_get_strikethrough_position", "PangoFontMetrics*");
+ return(C_to_Xen_int(pango_font_metrics_get_strikethrough_position(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_file_chooser_set_action(XEN chooser, XEN action)
+static Xen gxg_pango_font_metrics_get_strikethrough_thickness(Xen metrics)
{
- #define H_gtk_file_chooser_set_action "void gtk_file_chooser_set_action(GtkFileChooser* chooser, GtkFileChooserAction action)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_action", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GtkFileChooserAction_P(action), action, 2, "gtk_file_chooser_set_action", "GtkFileChooserAction");
- gtk_file_chooser_set_action(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GtkFileChooserAction(action));
- return(XEN_FALSE);
+ #define H_pango_font_metrics_get_strikethrough_thickness "int pango_font_metrics_get_strikethrough_thickness(PangoFontMetrics* metrics)"
+ Xen_check_type(Xen_is_PangoFontMetrics_(metrics), metrics, 1, "pango_font_metrics_get_strikethrough_thickness", "PangoFontMetrics*");
+ return(C_to_Xen_int(pango_font_metrics_get_strikethrough_thickness(Xen_to_C_PangoFontMetrics_(metrics))));
}
-static XEN gxg_gtk_file_chooser_get_action(XEN chooser)
+static Xen gxg_pango_font_family_is_monospace(Xen family)
{
- #define H_gtk_file_chooser_get_action "GtkFileChooserAction gtk_file_chooser_get_action(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_action", "GtkFileChooser*");
- return(C_TO_XEN_GtkFileChooserAction(gtk_file_chooser_get_action(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_pango_font_family_is_monospace "gboolean pango_font_family_is_monospace(PangoFontFamily* family)"
+ Xen_check_type(Xen_is_PangoFontFamily_(family), family, 1, "pango_font_family_is_monospace", "PangoFontFamily*");
+ return(C_to_Xen_gboolean(pango_font_family_is_monospace(Xen_to_C_PangoFontFamily_(family))));
}
-static XEN gxg_gtk_file_chooser_set_local_only(XEN chooser, XEN files_only)
+static Xen gxg_pango_font_face_list_sizes(Xen face, Xen ignore_sizes, Xen ignore_n_sizes)
{
- #define H_gtk_file_chooser_set_local_only "void gtk_file_chooser_set_local_only(GtkFileChooser* chooser, \
-gboolean files_only)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_local_only", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(files_only), files_only, 2, "gtk_file_chooser_set_local_only", "gboolean");
- gtk_file_chooser_set_local_only(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gboolean(files_only));
- return(XEN_FALSE);
+ #define H_pango_font_face_list_sizes "void pango_font_face_list_sizes(PangoFontFace* face, int** [sizes], \
+int* [n_sizes])"
+ int* ref_sizes = NULL;
+ int ref_n_sizes;
+ Xen_check_type(Xen_is_PangoFontFace_(face), face, 1, "pango_font_face_list_sizes", "PangoFontFace*");
+ pango_font_face_list_sizes(Xen_to_C_PangoFontFace_(face), &ref_sizes, &ref_n_sizes);
+ return(Xen_list_2(C_to_Xen_int_(ref_sizes), C_to_Xen_int(ref_n_sizes)));
}
-static XEN gxg_gtk_file_chooser_get_local_only(XEN chooser)
+static Xen gxg_pango_layout_set_auto_dir(Xen layout, Xen auto_dir)
{
- #define H_gtk_file_chooser_get_local_only "gboolean gtk_file_chooser_get_local_only(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_local_only", "GtkFileChooser*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_get_local_only(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_pango_layout_set_auto_dir "void pango_layout_set_auto_dir(PangoLayout* layout, gboolean auto_dir)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_set_auto_dir", "PangoLayout*");
+ Xen_check_type(Xen_is_gboolean(auto_dir), auto_dir, 2, "pango_layout_set_auto_dir", "gboolean");
+ pango_layout_set_auto_dir(Xen_to_C_PangoLayout_(layout), Xen_to_C_gboolean(auto_dir));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_set_select_multiple(XEN chooser, XEN select_multiple)
+static Xen gxg_pango_layout_get_auto_dir(Xen layout)
{
- #define H_gtk_file_chooser_set_select_multiple "void gtk_file_chooser_set_select_multiple(GtkFileChooser* chooser, \
-gboolean select_multiple)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_select_multiple", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(select_multiple), select_multiple, 2, "gtk_file_chooser_set_select_multiple", "gboolean");
- gtk_file_chooser_set_select_multiple(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gboolean(select_multiple));
- return(XEN_FALSE);
+ #define H_pango_layout_get_auto_dir "gboolean pango_layout_get_auto_dir(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_auto_dir", "PangoLayout*");
+ return(C_to_Xen_gboolean(pango_layout_get_auto_dir(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gtk_file_chooser_get_select_multiple(XEN chooser)
+static Xen gxg_pango_script_for_unichar(Xen ch)
{
- #define H_gtk_file_chooser_get_select_multiple "gboolean gtk_file_chooser_get_select_multiple(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_select_multiple", "GtkFileChooser*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_get_select_multiple(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_pango_script_for_unichar "PangoScript pango_script_for_unichar(gunichar ch)"
+ Xen_check_type(Xen_is_gunichar(ch), ch, 1, "pango_script_for_unichar", "gunichar");
+ return(C_to_Xen_PangoScript(pango_script_for_unichar(Xen_to_C_gunichar(ch))));
}
-static XEN gxg_gtk_file_chooser_set_current_name(XEN chooser, XEN name)
+static Xen gxg_pango_script_iter_new(Xen text, Xen length)
{
- #define H_gtk_file_chooser_set_current_name "void gtk_file_chooser_set_current_name(GtkFileChooser* chooser, \
-gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_current_name", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_file_chooser_set_current_name", "gchar*");
- gtk_file_chooser_set_current_name(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_pango_script_iter_new "PangoScriptIter* pango_script_iter_new(char* text, int length)"
+ Xen_check_type(Xen_is_char_(text), text, 1, "pango_script_iter_new", "char*");
+ Xen_check_type(Xen_is_int(length), length, 2, "pango_script_iter_new", "int");
+ return(C_to_Xen_PangoScriptIter_(pango_script_iter_new(Xen_to_C_char_(text), Xen_to_C_int(length))));
}
-static XEN gxg_gtk_file_chooser_get_filename(XEN chooser)
+static Xen gxg_pango_script_iter_get_range(Xen iter, Xen ignore_start, Xen ignore_end, Xen ignore_script)
{
- #define H_gtk_file_chooser_get_filename "gchar* gtk_file_chooser_get_filename(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_filename", "GtkFileChooser*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_file_chooser_get_filename(XEN_TO_C_GtkFileChooser_(chooser));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_pango_script_iter_get_range "void pango_script_iter_get_range(PangoScriptIter* iter, char** [start], \
+char** [end], PangoScript* [script])"
+ char* ref_start = NULL;
+ char* ref_end = NULL;
+ PangoScript ref_script;
+ Xen_check_type(Xen_is_PangoScriptIter_(iter), iter, 1, "pango_script_iter_get_range", "PangoScriptIter*");
+ pango_script_iter_get_range(Xen_to_C_PangoScriptIter_(iter), (const char**)&ref_start, (const char**)&ref_end, &ref_script);
+ return(Xen_list_3(C_to_Xen_char_(ref_start), C_to_Xen_char_(ref_end), C_to_Xen_PangoScript(ref_script)));
}
-static XEN gxg_gtk_file_chooser_set_filename(XEN chooser, XEN filename)
+static Xen gxg_pango_script_iter_next(Xen iter)
{
- #define H_gtk_file_chooser_set_filename "gboolean gtk_file_chooser_set_filename(GtkFileChooser* chooser, \
-char* filename)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_filename", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(filename), filename, 2, "gtk_file_chooser_set_filename", "char*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_set_filename(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(filename))));
+ #define H_pango_script_iter_next "gboolean pango_script_iter_next(PangoScriptIter* iter)"
+ Xen_check_type(Xen_is_PangoScriptIter_(iter), iter, 1, "pango_script_iter_next", "PangoScriptIter*");
+ return(C_to_Xen_gboolean(pango_script_iter_next(Xen_to_C_PangoScriptIter_(iter))));
}
-static XEN gxg_gtk_file_chooser_select_filename(XEN chooser, XEN filename)
+static Xen gxg_pango_script_iter_free(Xen iter)
{
- #define H_gtk_file_chooser_select_filename "gboolean gtk_file_chooser_select_filename(GtkFileChooser* chooser, \
-char* filename)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_select_filename", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(filename), filename, 2, "gtk_file_chooser_select_filename", "char*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_select_filename(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(filename))));
+ #define H_pango_script_iter_free "void pango_script_iter_free(PangoScriptIter* iter)"
+ Xen_check_type(Xen_is_PangoScriptIter_(iter), iter, 1, "pango_script_iter_free", "PangoScriptIter*");
+ pango_script_iter_free(Xen_to_C_PangoScriptIter_(iter));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_unselect_filename(XEN chooser, XEN filename)
+static Xen gxg_gtk_file_chooser_button_new_with_dialog(Xen dialog)
{
- #define H_gtk_file_chooser_unselect_filename "void gtk_file_chooser_unselect_filename(GtkFileChooser* chooser, \
-char* filename)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_unselect_filename", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(filename), filename, 2, "gtk_file_chooser_unselect_filename", "char*");
- gtk_file_chooser_unselect_filename(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(filename));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_button_new_with_dialog "GtkWidget* gtk_file_chooser_button_new_with_dialog(GtkWidget* dialog)"
+ Xen_check_type(Xen_is_GtkWidget_(dialog), dialog, 1, "gtk_file_chooser_button_new_with_dialog", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_file_chooser_button_new_with_dialog(Xen_to_C_GtkWidget_(dialog))));
}
-static XEN gxg_gtk_file_chooser_select_all(XEN chooser)
+static Xen gxg_gtk_file_chooser_button_get_title(Xen button)
{
- #define H_gtk_file_chooser_select_all "void gtk_file_chooser_select_all(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_select_all", "GtkFileChooser*");
- gtk_file_chooser_select_all(XEN_TO_C_GtkFileChooser_(chooser));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_button_get_title "gchar* gtk_file_chooser_button_get_title(GtkFileChooserButton* button)"
+ Xen_check_type(Xen_is_GtkFileChooserButton_(button), button, 1, "gtk_file_chooser_button_get_title", "GtkFileChooserButton*");
+ return(C_to_Xen_gchar_(gtk_file_chooser_button_get_title(Xen_to_C_GtkFileChooserButton_(button))));
}
-static XEN gxg_gtk_file_chooser_unselect_all(XEN chooser)
+static Xen gxg_gtk_file_chooser_button_set_title(Xen button, Xen title)
{
- #define H_gtk_file_chooser_unselect_all "void gtk_file_chooser_unselect_all(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_unselect_all", "GtkFileChooser*");
- gtk_file_chooser_unselect_all(XEN_TO_C_GtkFileChooser_(chooser));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_button_set_title "void gtk_file_chooser_button_set_title(GtkFileChooserButton* button, \
+gchar* title)"
+ Xen_check_type(Xen_is_GtkFileChooserButton_(button), button, 1, "gtk_file_chooser_button_set_title", "GtkFileChooserButton*");
+ Xen_check_type(Xen_is_gchar_(title), title, 2, "gtk_file_chooser_button_set_title", "gchar*");
+ gtk_file_chooser_button_set_title(Xen_to_C_GtkFileChooserButton_(button), Xen_to_C_gchar_(title));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_get_filenames(XEN chooser)
+static Xen gxg_gdk_drag_drop_succeeded(Xen context)
{
- #define H_gtk_file_chooser_get_filenames "GSList* gtk_file_chooser_get_filenames(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_filenames", "GtkFileChooser*");
- return(C_TO_XEN_GSList_(gtk_file_chooser_get_filenames(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gdk_drag_drop_succeeded "gboolean gdk_drag_drop_succeeded(GdkDragContext* context)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_drop_succeeded", "GdkDragContext*");
+ return(C_to_Xen_gboolean(gdk_drag_drop_succeeded(Xen_to_C_GdkDragContext_(context))));
}
-static XEN gxg_gtk_file_chooser_set_current_folder(XEN chooser, XEN filename)
+static Xen gxg_gtk_entry_layout_index_to_text_index(Xen entry, Xen layout_index)
{
- #define H_gtk_file_chooser_set_current_folder "gboolean gtk_file_chooser_set_current_folder(GtkFileChooser* chooser, \
-gchar* filename)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_current_folder", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 2, "gtk_file_chooser_set_current_folder", "gchar*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_set_current_folder(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gchar_(filename))));
+ #define H_gtk_entry_layout_index_to_text_index "gint gtk_entry_layout_index_to_text_index(GtkEntry* entry, \
+gint layout_index)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_layout_index_to_text_index", "GtkEntry*");
+ Xen_check_type(Xen_is_gint(layout_index), layout_index, 2, "gtk_entry_layout_index_to_text_index", "gint");
+ return(C_to_Xen_gint(gtk_entry_layout_index_to_text_index(Xen_to_C_GtkEntry_(entry), Xen_to_C_gint(layout_index))));
}
-static XEN gxg_gtk_file_chooser_get_current_folder(XEN chooser)
+static Xen gxg_gtk_entry_text_index_to_layout_index(Xen entry, Xen text_index)
{
- #define H_gtk_file_chooser_get_current_folder "gchar* gtk_file_chooser_get_current_folder(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_current_folder", "GtkFileChooser*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_file_chooser_get_current_folder(XEN_TO_C_GtkFileChooser_(chooser));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_entry_text_index_to_layout_index "gint gtk_entry_text_index_to_layout_index(GtkEntry* entry, \
+gint text_index)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_text_index_to_layout_index", "GtkEntry*");
+ Xen_check_type(Xen_is_gint(text_index), text_index, 2, "gtk_entry_text_index_to_layout_index", "gint");
+ return(C_to_Xen_gint(gtk_entry_text_index_to_layout_index(Xen_to_C_GtkEntry_(entry), Xen_to_C_gint(text_index))));
}
-static XEN gxg_gtk_file_chooser_get_uri(XEN chooser)
+static Xen gxg_gtk_file_chooser_set_show_hidden(Xen chooser, Xen show_hidden)
{
- #define H_gtk_file_chooser_get_uri "gchar* gtk_file_chooser_get_uri(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_uri", "GtkFileChooser*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_file_chooser_get_uri(XEN_TO_C_GtkFileChooser_(chooser));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_file_chooser_set_show_hidden "void gtk_file_chooser_set_show_hidden(GtkFileChooser* chooser, \
+gboolean show_hidden)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_show_hidden", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gboolean(show_hidden), show_hidden, 2, "gtk_file_chooser_set_show_hidden", "gboolean");
+ gtk_file_chooser_set_show_hidden(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gboolean(show_hidden));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_set_uri(XEN chooser, XEN uri)
+static Xen gxg_gtk_file_chooser_get_show_hidden(Xen chooser)
{
- #define H_gtk_file_chooser_set_uri "gboolean gtk_file_chooser_set_uri(GtkFileChooser* chooser, char* uri)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_uri", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(uri), uri, 2, "gtk_file_chooser_set_uri", "char*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_set_uri(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(uri))));
+ #define H_gtk_file_chooser_get_show_hidden "gboolean gtk_file_chooser_get_show_hidden(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_show_hidden", "GtkFileChooser*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_get_show_hidden(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_file_chooser_select_uri(XEN chooser, XEN uri)
+static Xen gxg_gtk_tree_view_set_hover_expand(Xen tree_view, Xen expand)
{
- #define H_gtk_file_chooser_select_uri "gboolean gtk_file_chooser_select_uri(GtkFileChooser* chooser, \
-char* uri)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_select_uri", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(uri), uri, 2, "gtk_file_chooser_select_uri", "char*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_select_uri(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(uri))));
+ #define H_gtk_tree_view_set_hover_expand "void gtk_tree_view_set_hover_expand(GtkTreeView* tree_view, \
+gboolean expand)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_hover_expand", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 2, "gtk_tree_view_set_hover_expand", "gboolean");
+ gtk_tree_view_set_hover_expand(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(expand));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_unselect_uri(XEN chooser, XEN uri)
+static Xen gxg_gtk_tree_view_get_hover_expand(Xen tree_view)
{
- #define H_gtk_file_chooser_unselect_uri "void gtk_file_chooser_unselect_uri(GtkFileChooser* chooser, \
-char* uri)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_unselect_uri", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(uri), uri, 2, "gtk_file_chooser_unselect_uri", "char*");
- gtk_file_chooser_unselect_uri(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(uri));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_hover_expand "gboolean gtk_tree_view_get_hover_expand(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_hover_expand", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_hover_expand(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_file_chooser_get_uris(XEN chooser)
+static Xen gxg_gtk_tool_item_rebuild_menu(Xen tool_item)
{
- #define H_gtk_file_chooser_get_uris "GSList* gtk_file_chooser_get_uris(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_uris", "GtkFileChooser*");
- return(C_TO_XEN_GSList_(gtk_file_chooser_get_uris(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_tool_item_rebuild_menu "void gtk_tool_item_rebuild_menu(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_rebuild_menu", "GtkToolItem*");
+ gtk_tool_item_rebuild_menu(Xen_to_C_GtkToolItem_(tool_item));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_set_current_folder_uri(XEN chooser, XEN uri)
+static Xen gxg_gtk_menu_tool_button_new(Xen icon_widget, Xen label)
{
- #define H_gtk_file_chooser_set_current_folder_uri "gboolean gtk_file_chooser_set_current_folder_uri(GtkFileChooser* chooser, \
-gchar* uri)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_current_folder_uri", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_file_chooser_set_current_folder_uri", "gchar*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_set_current_folder_uri(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gchar_(uri))));
+ #define H_gtk_menu_tool_button_new "GtkToolItem* gtk_menu_tool_button_new(GtkWidget* icon_widget, gchar* label)"
+ Xen_check_type(Xen_is_GtkWidget_(icon_widget) || Xen_is_false(icon_widget), icon_widget, 1, "gtk_menu_tool_button_new", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_menu_tool_button_new", "gchar*");
+ return(C_to_Xen_GtkToolItem_(gtk_menu_tool_button_new(Xen_to_C_GtkWidget_(icon_widget), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_file_chooser_get_current_folder_uri(XEN chooser)
+static Xen gxg_gtk_menu_tool_button_set_menu(Xen button, Xen menu)
{
- #define H_gtk_file_chooser_get_current_folder_uri "gchar* gtk_file_chooser_get_current_folder_uri(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_current_folder_uri", "GtkFileChooser*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_file_chooser_get_current_folder_uri(XEN_TO_C_GtkFileChooser_(chooser));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_menu_tool_button_set_menu "void gtk_menu_tool_button_set_menu(GtkMenuToolButton* button, \
+GtkWidget* menu)"
+ Xen_check_type(Xen_is_GtkMenuToolButton_(button), button, 1, "gtk_menu_tool_button_set_menu", "GtkMenuToolButton*");
+ Xen_check_type(Xen_is_GtkWidget_(menu), menu, 2, "gtk_menu_tool_button_set_menu", "GtkWidget*");
+ gtk_menu_tool_button_set_menu(Xen_to_C_GtkMenuToolButton_(button), Xen_to_C_GtkWidget_(menu));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_set_preview_widget(XEN chooser, XEN preview_widget)
+static Xen gxg_gtk_menu_tool_button_get_menu(Xen button)
{
- #define H_gtk_file_chooser_set_preview_widget "void gtk_file_chooser_set_preview_widget(GtkFileChooser* chooser, \
-GtkWidget* preview_widget)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_preview_widget", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(preview_widget), preview_widget, 2, "gtk_file_chooser_set_preview_widget", "GtkWidget*");
- gtk_file_chooser_set_preview_widget(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GtkWidget_(preview_widget));
- return(XEN_FALSE);
+ #define H_gtk_menu_tool_button_get_menu "GtkWidget* gtk_menu_tool_button_get_menu(GtkMenuToolButton* button)"
+ Xen_check_type(Xen_is_GtkMenuToolButton_(button), button, 1, "gtk_menu_tool_button_get_menu", "GtkMenuToolButton*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_tool_button_get_menu(Xen_to_C_GtkMenuToolButton_(button))));
}
-static XEN gxg_gtk_file_chooser_get_preview_widget(XEN chooser)
+static Xen gxg_gdk_display_supports_clipboard_persistence(Xen display)
{
- #define H_gtk_file_chooser_get_preview_widget "GtkWidget* gtk_file_chooser_get_preview_widget(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_preview_widget", "GtkFileChooser*");
- return(C_TO_XEN_GtkWidget_(gtk_file_chooser_get_preview_widget(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gdk_display_supports_clipboard_persistence "gboolean gdk_display_supports_clipboard_persistence(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_supports_clipboard_persistence", "GdkDisplay*");
+ return(C_to_Xen_gboolean(gdk_display_supports_clipboard_persistence(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_gtk_file_chooser_set_preview_widget_active(XEN chooser, XEN active)
+static Xen gxg_gtk_about_dialog_get_logo_icon_name(Xen about)
{
- #define H_gtk_file_chooser_set_preview_widget_active "void gtk_file_chooser_set_preview_widget_active(GtkFileChooser* chooser, \
-gboolean active)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_preview_widget_active", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(active), active, 2, "gtk_file_chooser_set_preview_widget_active", "gboolean");
- gtk_file_chooser_set_preview_widget_active(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gboolean(active));
- return(XEN_FALSE);
+ #define H_gtk_about_dialog_get_logo_icon_name "gchar* gtk_about_dialog_get_logo_icon_name(GtkAboutDialog* about)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_get_logo_icon_name", "GtkAboutDialog*");
+ return(C_to_Xen_gchar_(gtk_about_dialog_get_logo_icon_name(Xen_to_C_GtkAboutDialog_(about))));
}
-static XEN gxg_gtk_file_chooser_get_preview_widget_active(XEN chooser)
+static Xen gxg_gtk_about_dialog_set_logo_icon_name(Xen about, Xen icon_name)
{
- #define H_gtk_file_chooser_get_preview_widget_active "gboolean gtk_file_chooser_get_preview_widget_active(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_preview_widget_active", "GtkFileChooser*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_get_preview_widget_active(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_about_dialog_set_logo_icon_name "void gtk_about_dialog_set_logo_icon_name(GtkAboutDialog* about, \
+gchar* icon_name)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_set_logo_icon_name", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_about_dialog_set_logo_icon_name", "gchar*");
+ gtk_about_dialog_set_logo_icon_name(Xen_to_C_GtkAboutDialog_(about), Xen_to_C_gchar_(icon_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_get_preview_filename(XEN file_chooser)
+static Xen gxg_gtk_accelerator_get_label(Xen accelerator_key, Xen accelerator_mods)
{
- #define H_gtk_file_chooser_get_preview_filename "char* gtk_file_chooser_get_preview_filename(GtkFileChooser* file_chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(file_chooser), file_chooser, 1, "gtk_file_chooser_get_preview_filename", "GtkFileChooser*");
+ #define H_gtk_accelerator_get_label "gchar* gtk_accelerator_get_label(guint accelerator_key, GdkModifierType accelerator_mods)"
+ Xen_check_type(Xen_is_guint(accelerator_key), accelerator_key, 1, "gtk_accelerator_get_label", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accelerator_mods), accelerator_mods, 2, "gtk_accelerator_get_label", "GdkModifierType");
{
- char* result;
- XEN rtn;
- result = gtk_file_chooser_get_preview_filename(XEN_TO_C_GtkFileChooser_(file_chooser));
- rtn = C_TO_XEN_char_(result);
+ gchar* result;
+ Xen rtn;
+ result = gtk_accelerator_get_label(Xen_to_C_guint(accelerator_key), Xen_to_C_GdkModifierType(accelerator_mods));
+ rtn = C_to_Xen_gchar_(result);
g_free(result);
return(rtn);
}
}
-static XEN gxg_gtk_file_chooser_get_preview_uri(XEN file_chooser)
+static Xen gxg_gtk_clipboard_wait_is_target_available(Xen clipboard, Xen target)
{
- #define H_gtk_file_chooser_get_preview_uri "char* gtk_file_chooser_get_preview_uri(GtkFileChooser* file_chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(file_chooser), file_chooser, 1, "gtk_file_chooser_get_preview_uri", "GtkFileChooser*");
- {
- char* result;
- XEN rtn;
- result = gtk_file_chooser_get_preview_uri(XEN_TO_C_GtkFileChooser_(file_chooser));
- rtn = C_TO_XEN_char_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_clipboard_wait_is_target_available "gboolean gtk_clipboard_wait_is_target_available(GtkClipboard* clipboard, \
+GdkAtom target)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_is_target_available", "GtkClipboard*");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 2, "gtk_clipboard_wait_is_target_available", "GdkAtom");
+ return(C_to_Xen_gboolean(gtk_clipboard_wait_is_target_available(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GdkAtom(target))));
}
-static XEN gxg_gtk_file_chooser_set_extra_widget(XEN chooser, XEN extra_widget)
+static Xen gxg_gtk_clipboard_set_can_store(Xen clipboard, Xen targets, Xen n_targets)
{
- #define H_gtk_file_chooser_set_extra_widget "void gtk_file_chooser_set_extra_widget(GtkFileChooser* chooser, \
-GtkWidget* extra_widget)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_extra_widget", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(extra_widget), extra_widget, 2, "gtk_file_chooser_set_extra_widget", "GtkWidget*");
- gtk_file_chooser_set_extra_widget(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GtkWidget_(extra_widget));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_set_can_store "void gtk_clipboard_set_can_store(GtkClipboard* clipboard, GtkTargetEntry* targets, \
+gint n_targets)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_set_can_store", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets) || Xen_is_false(targets), targets, 2, "gtk_clipboard_set_can_store", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 3, "gtk_clipboard_set_can_store", "gint");
+ gtk_clipboard_set_can_store(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkTargetEntry_(targets), Xen_to_C_gint(n_targets));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_get_extra_widget(XEN chooser)
+static Xen gxg_gtk_clipboard_store(Xen clipboard)
{
- #define H_gtk_file_chooser_get_extra_widget "GtkWidget* gtk_file_chooser_get_extra_widget(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_extra_widget", "GtkFileChooser*");
- return(C_TO_XEN_GtkWidget_(gtk_file_chooser_get_extra_widget(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_clipboard_store "void gtk_clipboard_store(GtkClipboard* clipboard)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_store", "GtkClipboard*");
+ gtk_clipboard_store(Xen_to_C_GtkClipboard_(clipboard));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_add_filter(XEN chooser, XEN filter)
+static Xen gxg_gtk_drag_dest_add_image_targets(Xen widget)
{
- #define H_gtk_file_chooser_add_filter "void gtk_file_chooser_add_filter(GtkFileChooser* chooser, GtkFileFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_add_filter", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 2, "gtk_file_chooser_add_filter", "GtkFileFilter*");
- gtk_file_chooser_add_filter(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GtkFileFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_drag_dest_add_image_targets "void gtk_drag_dest_add_image_targets(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_add_image_targets", "GtkWidget*");
+ gtk_drag_dest_add_image_targets(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_remove_filter(XEN chooser, XEN filter)
+static Xen gxg_gtk_drag_dest_add_uri_targets(Xen widget)
{
- #define H_gtk_file_chooser_remove_filter "void gtk_file_chooser_remove_filter(GtkFileChooser* chooser, \
-GtkFileFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_remove_filter", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 2, "gtk_file_chooser_remove_filter", "GtkFileFilter*");
- gtk_file_chooser_remove_filter(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GtkFileFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_drag_dest_add_uri_targets "void gtk_drag_dest_add_uri_targets(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_add_uri_targets", "GtkWidget*");
+ gtk_drag_dest_add_uri_targets(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_list_filters(XEN chooser)
+static Xen gxg_gtk_drag_source_add_image_targets(Xen widget)
{
- #define H_gtk_file_chooser_list_filters "GSList* gtk_file_chooser_list_filters(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_list_filters", "GtkFileChooser*");
- return(C_TO_XEN_GSList_(gtk_file_chooser_list_filters(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_drag_source_add_image_targets "void gtk_drag_source_add_image_targets(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_add_image_targets", "GtkWidget*");
+ gtk_drag_source_add_image_targets(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_set_filter(XEN chooser, XEN filter)
+static Xen gxg_gtk_drag_source_add_uri_targets(Xen widget)
{
- #define H_gtk_file_chooser_set_filter "void gtk_file_chooser_set_filter(GtkFileChooser* chooser, GtkFileFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_filter", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 2, "gtk_file_chooser_set_filter", "GtkFileFilter*");
- gtk_file_chooser_set_filter(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GtkFileFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_drag_source_add_uri_targets "void gtk_drag_source_add_uri_targets(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_add_uri_targets", "GtkWidget*");
+ gtk_drag_source_add_uri_targets(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_get_filter(XEN chooser)
+static Xen gxg_gtk_file_chooser_button_get_width_chars(Xen button)
{
- #define H_gtk_file_chooser_get_filter "GtkFileFilter* gtk_file_chooser_get_filter(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_filter", "GtkFileChooser*");
- return(C_TO_XEN_GtkFileFilter_(gtk_file_chooser_get_filter(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_file_chooser_button_get_width_chars "gint gtk_file_chooser_button_get_width_chars(GtkFileChooserButton* button)"
+ Xen_check_type(Xen_is_GtkFileChooserButton_(button), button, 1, "gtk_file_chooser_button_get_width_chars", "GtkFileChooserButton*");
+ return(C_to_Xen_gint(gtk_file_chooser_button_get_width_chars(Xen_to_C_GtkFileChooserButton_(button))));
}
-static XEN gxg_gtk_file_chooser_add_shortcut_folder(XEN chooser, XEN folder, XEN ignore_error)
+static Xen gxg_gtk_file_chooser_button_set_width_chars(Xen button, Xen n_chars)
{
- #define H_gtk_file_chooser_add_shortcut_folder "gboolean gtk_file_chooser_add_shortcut_folder(GtkFileChooser* chooser, \
-char* folder, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_add_shortcut_folder", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(folder), folder, 2, "gtk_file_chooser_add_shortcut_folder", "char*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_file_chooser_add_shortcut_folder(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(folder),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_file_chooser_button_set_width_chars "void gtk_file_chooser_button_set_width_chars(GtkFileChooserButton* button, \
+gint n_chars)"
+ Xen_check_type(Xen_is_GtkFileChooserButton_(button), button, 1, "gtk_file_chooser_button_set_width_chars", "GtkFileChooserButton*");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 2, "gtk_file_chooser_button_set_width_chars", "gint");
+ gtk_file_chooser_button_set_width_chars(Xen_to_C_GtkFileChooserButton_(button), Xen_to_C_gint(n_chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_remove_shortcut_folder(XEN chooser, XEN folder, XEN ignore_error)
+static Xen gxg_gtk_image_set_pixel_size(Xen image, Xen pixel_size)
{
- #define H_gtk_file_chooser_remove_shortcut_folder "gboolean gtk_file_chooser_remove_shortcut_folder(GtkFileChooser* chooser, \
-char* folder, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_remove_shortcut_folder", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(folder), folder, 2, "gtk_file_chooser_remove_shortcut_folder", "char*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_file_chooser_remove_shortcut_folder(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(folder),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_image_set_pixel_size "void gtk_image_set_pixel_size(GtkImage* image, gint pixel_size)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_set_pixel_size", "GtkImage*");
+ Xen_check_type(Xen_is_gint(pixel_size), pixel_size, 2, "gtk_image_set_pixel_size", "gint");
+ gtk_image_set_pixel_size(Xen_to_C_GtkImage_(image), Xen_to_C_gint(pixel_size));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_list_shortcut_folders(XEN chooser)
+static Xen gxg_gtk_image_get_pixel_size(Xen image)
{
- #define H_gtk_file_chooser_list_shortcut_folders "GSList* gtk_file_chooser_list_shortcut_folders(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_list_shortcut_folders", "GtkFileChooser*");
- return(C_TO_XEN_GSList_(gtk_file_chooser_list_shortcut_folders(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_image_get_pixel_size "gint gtk_image_get_pixel_size(GtkImage* image)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_get_pixel_size", "GtkImage*");
+ return(C_to_Xen_gint(gtk_image_get_pixel_size(Xen_to_C_GtkImage_(image))));
}
-static XEN gxg_gtk_file_chooser_add_shortcut_folder_uri(XEN chooser, XEN folder, XEN ignore_error)
+static Xen gxg_gtk_label_set_width_chars(Xen label, Xen n_chars)
{
- #define H_gtk_file_chooser_add_shortcut_folder_uri "gboolean gtk_file_chooser_add_shortcut_folder_uri(GtkFileChooser* chooser, \
-char* folder, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_add_shortcut_folder_uri", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(folder), folder, 2, "gtk_file_chooser_add_shortcut_folder_uri", "char*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_file_chooser_add_shortcut_folder_uri(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(folder),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_label_set_width_chars "void gtk_label_set_width_chars(GtkLabel* label, gint n_chars)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_width_chars", "GtkLabel*");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 2, "gtk_label_set_width_chars", "gint");
+ gtk_label_set_width_chars(Xen_to_C_GtkLabel_(label), Xen_to_C_gint(n_chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_remove_shortcut_folder_uri(XEN chooser, XEN folder, XEN ignore_error)
+static Xen gxg_gtk_label_get_width_chars(Xen label)
{
- #define H_gtk_file_chooser_remove_shortcut_folder_uri "gboolean gtk_file_chooser_remove_shortcut_folder_uri(GtkFileChooser* chooser, \
-char* folder, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_remove_shortcut_folder_uri", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_char__P(folder), folder, 2, "gtk_file_chooser_remove_shortcut_folder_uri", "char*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_file_chooser_remove_shortcut_folder_uri(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_char_(folder),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_label_get_width_chars "gint gtk_label_get_width_chars(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_width_chars", "GtkLabel*");
+ return(C_to_Xen_gint(gtk_label_get_width_chars(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_file_chooser_list_shortcut_folder_uris(XEN chooser)
+static Xen gxg_gtk_target_list_add_text_targets(Xen list, Xen info)
{
- #define H_gtk_file_chooser_list_shortcut_folder_uris "GSList* gtk_file_chooser_list_shortcut_folder_uris(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_list_shortcut_folder_uris", "GtkFileChooser*");
- return(C_TO_XEN_GSList_(gtk_file_chooser_list_shortcut_folder_uris(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_target_list_add_text_targets "void gtk_target_list_add_text_targets(GtkTargetList* list, \
+guint info)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_add_text_targets", "GtkTargetList*");
+ Xen_check_type(Xen_is_guint(info), info, 2, "gtk_target_list_add_text_targets", "guint");
+ gtk_target_list_add_text_targets(Xen_to_C_GtkTargetList_(list), Xen_to_C_guint(info));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_theme_new(void)
+static Xen gxg_gtk_target_list_add_image_targets(Xen list, Xen info, Xen writable)
{
- #define H_gtk_icon_theme_new "GtkIconTheme* gtk_icon_theme_new( void)"
- return(C_TO_XEN_GtkIconTheme_(gtk_icon_theme_new()));
+ #define H_gtk_target_list_add_image_targets "void gtk_target_list_add_image_targets(GtkTargetList* list, \
+guint info, gboolean writable)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_add_image_targets", "GtkTargetList*");
+ Xen_check_type(Xen_is_guint(info), info, 2, "gtk_target_list_add_image_targets", "guint");
+ Xen_check_type(Xen_is_gboolean(writable), writable, 3, "gtk_target_list_add_image_targets", "gboolean");
+ gtk_target_list_add_image_targets(Xen_to_C_GtkTargetList_(list), Xen_to_C_guint(info), Xen_to_C_gboolean(writable));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_theme_get_default(void)
+static Xen gxg_gtk_target_list_add_uri_targets(Xen list, Xen info)
{
- #define H_gtk_icon_theme_get_default "GtkIconTheme* gtk_icon_theme_get_default( void)"
- return(C_TO_XEN_GtkIconTheme_(gtk_icon_theme_get_default()));
+ #define H_gtk_target_list_add_uri_targets "void gtk_target_list_add_uri_targets(GtkTargetList* list, \
+guint info)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_add_uri_targets", "GtkTargetList*");
+ Xen_check_type(Xen_is_guint(info), info, 2, "gtk_target_list_add_uri_targets", "guint");
+ gtk_target_list_add_uri_targets(Xen_to_C_GtkTargetList_(list), Xen_to_C_guint(info));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_theme_get_for_screen(XEN screen)
+static Xen gxg_gtk_selection_data_set_pixbuf(Xen selection_data, Xen pixbuf)
{
- #define H_gtk_icon_theme_get_for_screen "GtkIconTheme* gtk_icon_theme_get_for_screen(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gtk_icon_theme_get_for_screen", "GdkScreen*");
- return(C_TO_XEN_GtkIconTheme_(gtk_icon_theme_get_for_screen(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_selection_data_set_pixbuf "gboolean gtk_selection_data_set_pixbuf(GtkSelectionData* selection_data, \
+GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_set_pixbuf", "GtkSelectionData*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 2, "gtk_selection_data_set_pixbuf", "GdkPixbuf*");
+ return(C_to_Xen_gboolean(gtk_selection_data_set_pixbuf(Xen_to_C_GtkSelectionData_(selection_data), Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gtk_icon_theme_set_screen(XEN icon_theme, XEN screen)
+static Xen gxg_gtk_selection_data_get_pixbuf(Xen selection_data)
{
- #define H_gtk_icon_theme_set_screen "void gtk_icon_theme_set_screen(GtkIconTheme* icon_theme, GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_set_screen", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen) || XEN_FALSE_P(screen), screen, 2, "gtk_icon_theme_set_screen", "GdkScreen*");
- gtk_icon_theme_set_screen(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_GdkScreen_(screen));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_get_pixbuf "GdkPixbuf* gtk_selection_data_get_pixbuf(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_pixbuf", "GtkSelectionData*");
+ return(C_to_Xen_GdkPixbuf_(gtk_selection_data_get_pixbuf(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_icon_theme_get_search_path(XEN icon_theme, XEN ignore_path, XEN ignore_n_elements)
+static Xen gxg_gtk_selection_data_set_uris(Xen selection_data, Xen uris)
{
- #define H_gtk_icon_theme_get_search_path "void gtk_icon_theme_get_search_path(GtkIconTheme* icon_theme, \
-gchar*** [path], gint* [n_elements])"
- gchar** ref_path = NULL;
- gint ref_n_elements;
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_get_search_path", "GtkIconTheme*");
- gtk_icon_theme_get_search_path(XEN_TO_C_GtkIconTheme_(icon_theme), &ref_path, &ref_n_elements);
- return(XEN_LIST_2(C_TO_XEN_gchar__(ref_path), C_TO_XEN_gint(ref_n_elements)));
+ #define H_gtk_selection_data_set_uris "gboolean gtk_selection_data_set_uris(GtkSelectionData* selection_data, \
+gchar** uris)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_set_uris", "GtkSelectionData*");
+ Xen_check_type(Xen_is_gchar__(uris), uris, 2, "gtk_selection_data_set_uris", "gchar**");
+ return(C_to_Xen_gboolean(gtk_selection_data_set_uris(Xen_to_C_GtkSelectionData_(selection_data), Xen_to_C_gchar__(uris))));
}
-static XEN gxg_gtk_icon_theme_append_search_path(XEN icon_theme, XEN path)
+static Xen gxg_gtk_selection_data_get_uris(Xen selection_data)
{
- #define H_gtk_icon_theme_append_search_path "void gtk_icon_theme_append_search_path(GtkIconTheme* icon_theme, \
-gchar* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_append_search_path", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_gchar__P(path), path, 2, "gtk_icon_theme_append_search_path", "gchar*");
- gtk_icon_theme_append_search_path(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_gchar_(path));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_get_uris "gchar** gtk_selection_data_get_uris(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_uris", "GtkSelectionData*");
+ return(C_to_Xen_gchar__(gtk_selection_data_get_uris(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_icon_theme_prepend_search_path(XEN icon_theme, XEN path)
+static Xen gxg_gtk_text_buffer_backspace(Xen buffer, Xen iter, Xen interactive, Xen default_editable)
{
- #define H_gtk_icon_theme_prepend_search_path "void gtk_icon_theme_prepend_search_path(GtkIconTheme* icon_theme, \
-gchar* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_prepend_search_path", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_gchar__P(path), path, 2, "gtk_icon_theme_prepend_search_path", "gchar*");
- gtk_icon_theme_prepend_search_path(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_gchar_(path));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_backspace "gboolean gtk_text_buffer_backspace(GtkTextBuffer* buffer, GtkTextIter* iter, \
+gboolean interactive, gboolean default_editable)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_backspace", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_backspace", "GtkTextIter*");
+ Xen_check_type(Xen_is_gboolean(interactive), interactive, 3, "gtk_text_buffer_backspace", "gboolean");
+ Xen_check_type(Xen_is_gboolean(default_editable), default_editable, 4, "gtk_text_buffer_backspace", "gboolean");
+ return(C_to_Xen_gboolean(gtk_text_buffer_backspace(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), Xen_to_C_gboolean(interactive),
+ Xen_to_C_gboolean(default_editable))));
}
-static XEN gxg_gtk_icon_theme_set_custom_theme(XEN icon_theme, XEN theme_name)
+static Xen gxg_gtk_clipboard_set_image(Xen clipboard, Xen pixbuf)
{
- #define H_gtk_icon_theme_set_custom_theme "void gtk_icon_theme_set_custom_theme(GtkIconTheme* icon_theme, \
-gchar* theme_name)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_set_custom_theme", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_gchar__P(theme_name), theme_name, 2, "gtk_icon_theme_set_custom_theme", "gchar*");
- gtk_icon_theme_set_custom_theme(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_gchar_(theme_name));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_set_image "void gtk_clipboard_set_image(GtkClipboard* clipboard, GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_set_image", "GtkClipboard*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 2, "gtk_clipboard_set_image", "GdkPixbuf*");
+ gtk_clipboard_set_image(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GdkPixbuf_(pixbuf));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_theme_has_icon(XEN icon_theme, XEN icon_name)
+static Xen gxg_gtk_clipboard_request_image(Xen clipboard, Xen func, Xen func_info)
{
- #define H_gtk_icon_theme_has_icon "gboolean gtk_icon_theme_has_icon(GtkIconTheme* icon_theme, gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_has_icon", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_icon_theme_has_icon", "gchar*");
- return(C_TO_XEN_gboolean(gtk_icon_theme_has_icon(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_gchar_(icon_name))));
+ #define H_gtk_clipboard_request_image "void gtk_clipboard_request_image(GtkClipboard* clipboard, GtkClipboardImageReceivedFunc func, \
+lambda_data func_info)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_request_image", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkClipboardImageReceivedFunc(func), func, 2, "gtk_clipboard_request_image", "GtkClipboardImageReceivedFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_clipboard_request_image", "lambda_data");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ gtk_clipboard_request_image(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkClipboardImageReceivedFunc(func), Xen_to_C_lambda_data(func_info));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_icon_theme_lookup_icon(XEN icon_theme, XEN icon_name, XEN size, XEN flags)
+static Xen gxg_gtk_clipboard_wait_for_image(Xen clipboard)
{
- #define H_gtk_icon_theme_lookup_icon "GtkIconInfo* gtk_icon_theme_lookup_icon(GtkIconTheme* icon_theme, \
-gchar* icon_name, gint size, GtkIconLookupFlags flags)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_lookup_icon", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_icon_theme_lookup_icon", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(size), size, 3, "gtk_icon_theme_lookup_icon", "gint");
- XEN_ASSERT_TYPE(XEN_GtkIconLookupFlags_P(flags), flags, 4, "gtk_icon_theme_lookup_icon", "GtkIconLookupFlags");
- return(C_TO_XEN_GtkIconInfo_(gtk_icon_theme_lookup_icon(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_gchar_(icon_name),
- XEN_TO_C_gint(size), XEN_TO_C_GtkIconLookupFlags(flags))));
+ #define H_gtk_clipboard_wait_for_image "GdkPixbuf* gtk_clipboard_wait_for_image(GtkClipboard* clipboard)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_for_image", "GtkClipboard*");
+ return(C_to_Xen_GdkPixbuf_(gtk_clipboard_wait_for_image(Xen_to_C_GtkClipboard_(clipboard))));
}
-static XEN gxg_gtk_icon_theme_load_icon(XEN icon_theme, XEN icon_name, XEN size, XEN flags, XEN ignore_error)
+static Xen gxg_gtk_clipboard_wait_is_image_available(Xen clipboard)
{
- #define H_gtk_icon_theme_load_icon "GdkPixbuf* gtk_icon_theme_load_icon(GtkIconTheme* icon_theme, gchar* icon_name, \
-gint size, GtkIconLookupFlags flags, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_load_icon", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_icon_theme_load_icon", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(size), size, 3, "gtk_icon_theme_load_icon", "gint");
- XEN_ASSERT_TYPE(XEN_GtkIconLookupFlags_P(flags), flags, 4, "gtk_icon_theme_load_icon", "GtkIconLookupFlags");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkPixbuf_(gtk_icon_theme_load_icon(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_gchar_(icon_name),
- XEN_TO_C_gint(size), XEN_TO_C_GtkIconLookupFlags(flags), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_clipboard_wait_is_image_available "gboolean gtk_clipboard_wait_is_image_available(GtkClipboard* clipboard)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_is_image_available", "GtkClipboard*");
+ return(C_to_Xen_gboolean(gtk_clipboard_wait_is_image_available(Xen_to_C_GtkClipboard_(clipboard))));
}
-static XEN gxg_gtk_icon_theme_list_icons(XEN icon_theme, XEN context)
+static Xen gxg_gtk_file_filter_add_pixbuf_formats(Xen filter)
{
- #define H_gtk_icon_theme_list_icons "GList* gtk_icon_theme_list_icons(GtkIconTheme* icon_theme, gchar* context)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_list_icons", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_gchar__P(context), context, 2, "gtk_icon_theme_list_icons", "gchar*");
- return(C_TO_XEN_GList_(gtk_icon_theme_list_icons(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_gchar_(context))));
+ #define H_gtk_file_filter_add_pixbuf_formats "void gtk_file_filter_add_pixbuf_formats(GtkFileFilter* filter)"
+ Xen_check_type(Xen_is_GtkFileFilter_(filter), filter, 1, "gtk_file_filter_add_pixbuf_formats", "GtkFileFilter*");
+ gtk_file_filter_add_pixbuf_formats(Xen_to_C_GtkFileFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_theme_get_example_icon_name(XEN icon_theme)
+static Xen gxg_gtk_label_set_single_line_mode(Xen label, Xen single_line_mode)
{
- #define H_gtk_icon_theme_get_example_icon_name "char* gtk_icon_theme_get_example_icon_name(GtkIconTheme* icon_theme)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_get_example_icon_name", "GtkIconTheme*");
- return(C_TO_XEN_char_(gtk_icon_theme_get_example_icon_name(XEN_TO_C_GtkIconTheme_(icon_theme))));
+ #define H_gtk_label_set_single_line_mode "void gtk_label_set_single_line_mode(GtkLabel* label, gboolean single_line_mode)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_single_line_mode", "GtkLabel*");
+ Xen_check_type(Xen_is_gboolean(single_line_mode), single_line_mode, 2, "gtk_label_set_single_line_mode", "gboolean");
+ gtk_label_set_single_line_mode(Xen_to_C_GtkLabel_(label), Xen_to_C_gboolean(single_line_mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_theme_rescan_if_needed(XEN icon_theme)
+static Xen gxg_gtk_label_get_single_line_mode(Xen label)
{
- #define H_gtk_icon_theme_rescan_if_needed "gboolean gtk_icon_theme_rescan_if_needed(GtkIconTheme* icon_theme)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_rescan_if_needed", "GtkIconTheme*");
- return(C_TO_XEN_gboolean(gtk_icon_theme_rescan_if_needed(XEN_TO_C_GtkIconTheme_(icon_theme))));
+ #define H_gtk_label_get_single_line_mode "gboolean gtk_label_get_single_line_mode(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_single_line_mode", "GtkLabel*");
+ return(C_to_Xen_gboolean(gtk_label_get_single_line_mode(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_theme_add_builtin_icon(XEN icon_name, XEN size, XEN pixbuf)
+static Xen gxg_gtk_progress_bar_set_ellipsize(Xen pbar, Xen mode)
{
- #define H_gtk_icon_theme_add_builtin_icon "void gtk_icon_theme_add_builtin_icon(gchar* icon_name, gint size, \
-GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 1, "gtk_icon_theme_add_builtin_icon", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(size), size, 2, "gtk_icon_theme_add_builtin_icon", "gint");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 3, "gtk_icon_theme_add_builtin_icon", "GdkPixbuf*");
- gtk_icon_theme_add_builtin_icon(XEN_TO_C_gchar_(icon_name), XEN_TO_C_gint(size), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_progress_bar_set_ellipsize "void gtk_progress_bar_set_ellipsize(GtkProgressBar* pbar, \
+PangoEllipsizeMode mode)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_set_ellipsize", "GtkProgressBar*");
+ Xen_check_type(Xen_is_PangoEllipsizeMode(mode), mode, 2, "gtk_progress_bar_set_ellipsize", "PangoEllipsizeMode");
+ gtk_progress_bar_set_ellipsize(Xen_to_C_GtkProgressBar_(pbar), Xen_to_C_PangoEllipsizeMode(mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_info_copy(XEN icon_info)
+static Xen gxg_gtk_progress_bar_get_ellipsize(Xen pbar)
{
- #define H_gtk_icon_info_copy "GtkIconInfo* gtk_icon_info_copy(GtkIconInfo* icon_info)"
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_copy", "GtkIconInfo*");
- return(C_TO_XEN_GtkIconInfo_(gtk_icon_info_copy(XEN_TO_C_GtkIconInfo_(icon_info))));
+ #define H_gtk_progress_bar_get_ellipsize "PangoEllipsizeMode gtk_progress_bar_get_ellipsize(GtkProgressBar* pbar)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_get_ellipsize", "GtkProgressBar*");
+ return(C_to_Xen_PangoEllipsizeMode(gtk_progress_bar_get_ellipsize(Xen_to_C_GtkProgressBar_(pbar))));
}
-static XEN gxg_gtk_icon_info_free(XEN icon_info)
+static Xen gxg_gtk_selection_data_targets_include_image(Xen selection_data, Xen writable)
{
- #define H_gtk_icon_info_free "void gtk_icon_info_free(GtkIconInfo* icon_info)"
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_free", "GtkIconInfo*");
- gtk_icon_info_free(XEN_TO_C_GtkIconInfo_(icon_info));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_targets_include_image "gboolean gtk_selection_data_targets_include_image(GtkSelectionData* selection_data, \
+gboolean writable)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_targets_include_image", "GtkSelectionData*");
+ Xen_check_type(Xen_is_gboolean(writable), writable, 2, "gtk_selection_data_targets_include_image", "gboolean");
+ return(C_to_Xen_gboolean(gtk_selection_data_targets_include_image(Xen_to_C_GtkSelectionData_(selection_data), Xen_to_C_gboolean(writable))));
}
-static XEN gxg_gtk_icon_info_get_base_size(XEN icon_info)
+static Xen gxg_gtk_button_set_image(Xen button, Xen image)
{
- #define H_gtk_icon_info_get_base_size "gint gtk_icon_info_get_base_size(GtkIconInfo* icon_info)"
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_get_base_size", "GtkIconInfo*");
- return(C_TO_XEN_gint(gtk_icon_info_get_base_size(XEN_TO_C_GtkIconInfo_(icon_info))));
+ #define H_gtk_button_set_image "void gtk_button_set_image(GtkButton* button, GtkWidget* image)"
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_set_image", "GtkButton*");
+ Xen_check_type(Xen_is_GtkWidget_(image), image, 2, "gtk_button_set_image", "GtkWidget*");
+ gtk_button_set_image(Xen_to_C_GtkButton_(button), Xen_to_C_GtkWidget_(image));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_info_get_filename(XEN icon_info)
+static Xen gxg_gtk_button_get_image(Xen button)
{
- #define H_gtk_icon_info_get_filename "gchar* gtk_icon_info_get_filename(GtkIconInfo* icon_info)"
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_get_filename", "GtkIconInfo*");
- return(C_TO_XEN_gchar_(gtk_icon_info_get_filename(XEN_TO_C_GtkIconInfo_(icon_info))));
+ #define H_gtk_button_get_image "GtkWidget* gtk_button_get_image(GtkButton* button)"
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_get_image", "GtkButton*");
+ return(C_to_Xen_GtkWidget_(gtk_button_get_image(Xen_to_C_GtkButton_(button))));
}
-static XEN gxg_gtk_icon_info_get_builtin_pixbuf(XEN icon_info)
+static Xen gxg_gtk_label_set_angle(Xen label, Xen angle)
{
- #define H_gtk_icon_info_get_builtin_pixbuf "GdkPixbuf* gtk_icon_info_get_builtin_pixbuf(GtkIconInfo* icon_info)"
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_get_builtin_pixbuf", "GtkIconInfo*");
- return(C_TO_XEN_GdkPixbuf_(gtk_icon_info_get_builtin_pixbuf(XEN_TO_C_GtkIconInfo_(icon_info))));
+ #define H_gtk_label_set_angle "void gtk_label_set_angle(GtkLabel* label, gdouble angle)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_angle", "GtkLabel*");
+ Xen_check_type(Xen_is_gdouble(angle), angle, 2, "gtk_label_set_angle", "gdouble");
+ gtk_label_set_angle(Xen_to_C_GtkLabel_(label), Xen_to_C_gdouble(angle));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_info_load_icon(XEN icon_info, XEN ignore_error)
+static Xen gxg_gtk_label_get_angle(Xen label)
{
- #define H_gtk_icon_info_load_icon "GdkPixbuf* gtk_icon_info_load_icon(GtkIconInfo* icon_info, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_load_icon", "GtkIconInfo*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkPixbuf_(gtk_icon_info_load_icon(XEN_TO_C_GtkIconInfo_(icon_info), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_label_get_angle "gdouble gtk_label_get_angle(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_angle", "GtkLabel*");
+ return(C_to_Xen_gdouble(gtk_label_get_angle(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_icon_info_set_raw_coordinates(XEN icon_info, XEN raw_coordinates)
+static Xen gxg_gtk_menu_set_screen(Xen menu, Xen screen)
{
- #define H_gtk_icon_info_set_raw_coordinates "void gtk_icon_info_set_raw_coordinates(GtkIconInfo* icon_info, \
-gboolean raw_coordinates)"
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_set_raw_coordinates", "GtkIconInfo*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(raw_coordinates), raw_coordinates, 2, "gtk_icon_info_set_raw_coordinates", "gboolean");
- gtk_icon_info_set_raw_coordinates(XEN_TO_C_GtkIconInfo_(icon_info), XEN_TO_C_gboolean(raw_coordinates));
- return(XEN_FALSE);
+ #define H_gtk_menu_set_screen "void gtk_menu_set_screen(GtkMenu* menu, GdkScreen* screen)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_set_screen", "GtkMenu*");
+ Xen_check_type(Xen_is_GdkScreen_(screen) || Xen_is_false(screen), screen, 2, "gtk_menu_set_screen", "GdkScreen*");
+ gtk_menu_set_screen(Xen_to_C_GtkMenu_(menu), Xen_to_C_GdkScreen_(screen));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_info_get_embedded_rect(XEN icon_info, XEN rectangle)
+static Xen gxg_pango_attr_underline_color_new(Xen red, Xen green, Xen blue)
{
- #define H_gtk_icon_info_get_embedded_rect "gboolean gtk_icon_info_get_embedded_rect(GtkIconInfo* icon_info, \
-GdkRectangle* rectangle)"
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_get_embedded_rect", "GtkIconInfo*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rectangle), rectangle, 2, "gtk_icon_info_get_embedded_rect", "GdkRectangle*");
- return(C_TO_XEN_gboolean(gtk_icon_info_get_embedded_rect(XEN_TO_C_GtkIconInfo_(icon_info), XEN_TO_C_GdkRectangle_(rectangle))));
+ #define H_pango_attr_underline_color_new "PangoAttribute* pango_attr_underline_color_new(guint16 red, \
+guint16 green, guint16 blue)"
+ Xen_check_type(Xen_is_guint16(red), red, 1, "pango_attr_underline_color_new", "guint16");
+ Xen_check_type(Xen_is_guint16(green), green, 2, "pango_attr_underline_color_new", "guint16");
+ Xen_check_type(Xen_is_guint16(blue), blue, 3, "pango_attr_underline_color_new", "guint16");
+ return(C_to_Xen_PangoAttribute_(pango_attr_underline_color_new(Xen_to_C_guint16(red), Xen_to_C_guint16(green), Xen_to_C_guint16(blue))));
}
-static XEN gxg_gtk_icon_info_get_display_name(XEN icon_info)
+static Xen gxg_pango_attr_strikethrough_color_new(Xen red, Xen green, Xen blue)
{
- #define H_gtk_icon_info_get_display_name "gchar* gtk_icon_info_get_display_name(GtkIconInfo* icon_info)"
- XEN_ASSERT_TYPE(XEN_GtkIconInfo__P(icon_info), icon_info, 1, "gtk_icon_info_get_display_name", "GtkIconInfo*");
- return(C_TO_XEN_gchar_(gtk_icon_info_get_display_name(XEN_TO_C_GtkIconInfo_(icon_info))));
+ #define H_pango_attr_strikethrough_color_new "PangoAttribute* pango_attr_strikethrough_color_new(guint16 red, \
+guint16 green, guint16 blue)"
+ Xen_check_type(Xen_is_guint16(red), red, 1, "pango_attr_strikethrough_color_new", "guint16");
+ Xen_check_type(Xen_is_guint16(green), green, 2, "pango_attr_strikethrough_color_new", "guint16");
+ Xen_check_type(Xen_is_guint16(blue), blue, 3, "pango_attr_strikethrough_color_new", "guint16");
+ return(C_to_Xen_PangoAttribute_(pango_attr_strikethrough_color_new(Xen_to_C_guint16(red), Xen_to_C_guint16(green), Xen_to_C_guint16(blue))));
}
-static XEN gxg_gtk_tool_button_new(XEN icon_widget, XEN label)
+static Xen gxg_pango_renderer_draw_layout(Xen renderer, Xen layout, Xen x, Xen y)
{
- #define H_gtk_tool_button_new "GtkToolItem* gtk_tool_button_new(GtkWidget* icon_widget, gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(icon_widget) || XEN_FALSE_P(icon_widget), icon_widget, 1, "gtk_tool_button_new", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_tool_button_new", "gchar*");
- return(C_TO_XEN_GtkToolItem_(gtk_tool_button_new(XEN_TO_C_GtkWidget_(icon_widget), XEN_TO_C_gchar_(label))));
+ #define H_pango_renderer_draw_layout "void pango_renderer_draw_layout(PangoRenderer* renderer, PangoLayout* layout, \
+int x, int y)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_draw_layout", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 2, "pango_renderer_draw_layout", "PangoLayout*");
+ Xen_check_type(Xen_is_int(x), x, 3, "pango_renderer_draw_layout", "int");
+ Xen_check_type(Xen_is_int(y), y, 4, "pango_renderer_draw_layout", "int");
+ pango_renderer_draw_layout(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoLayout_(layout), Xen_to_C_int(x), Xen_to_C_int(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_new_from_stock(XEN stock_id)
+static Xen gxg_pango_renderer_draw_layout_line(Xen renderer, Xen line, Xen x, Xen y)
{
- #define H_gtk_tool_button_new_from_stock "GtkToolItem* gtk_tool_button_new_from_stock(gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_tool_button_new_from_stock", "gchar*");
- return(C_TO_XEN_GtkToolItem_(gtk_tool_button_new_from_stock(XEN_TO_C_gchar_(stock_id))));
+ #define H_pango_renderer_draw_layout_line "void pango_renderer_draw_layout_line(PangoRenderer* renderer, \
+PangoLayoutLine* line, int x, int y)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_draw_layout_line", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 2, "pango_renderer_draw_layout_line", "PangoLayoutLine*");
+ Xen_check_type(Xen_is_int(x), x, 3, "pango_renderer_draw_layout_line", "int");
+ Xen_check_type(Xen_is_int(y), y, 4, "pango_renderer_draw_layout_line", "int");
+ pango_renderer_draw_layout_line(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoLayoutLine_(line), Xen_to_C_int(x), Xen_to_C_int(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_set_label(XEN button, XEN label)
+static Xen gxg_pango_renderer_draw_glyphs(Xen renderer, Xen font, Xen glyphs, Xen x, Xen y)
{
- #define H_gtk_tool_button_set_label "void gtk_tool_button_set_label(GtkToolButton* button, gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_set_label", "GtkToolButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_tool_button_set_label", "gchar*");
- gtk_tool_button_set_label(XEN_TO_C_GtkToolButton_(button), XEN_TO_C_gchar_(label));
- return(XEN_FALSE);
+ #define H_pango_renderer_draw_glyphs "void pango_renderer_draw_glyphs(PangoRenderer* renderer, PangoFont* font, \
+PangoGlyphString* glyphs, int x, int y)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_draw_glyphs", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoFont_(font), font, 2, "pango_renderer_draw_glyphs", "PangoFont*");
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 3, "pango_renderer_draw_glyphs", "PangoGlyphString*");
+ Xen_check_type(Xen_is_int(x), x, 4, "pango_renderer_draw_glyphs", "int");
+ Xen_check_type(Xen_is_int(y), y, 5, "pango_renderer_draw_glyphs", "int");
+ pango_renderer_draw_glyphs(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoFont_(font), Xen_to_C_PangoGlyphString_(glyphs),
+ Xen_to_C_int(x), Xen_to_C_int(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_get_label(XEN button)
+static Xen gxg_pango_renderer_draw_rectangle(Xen renderer, Xen part, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gtk_tool_button_get_label "gchar* gtk_tool_button_get_label(GtkToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_get_label", "GtkToolButton*");
- return(C_TO_XEN_gchar_(gtk_tool_button_get_label(XEN_TO_C_GtkToolButton_(button))));
+ #define H_pango_renderer_draw_rectangle "void pango_renderer_draw_rectangle(PangoRenderer* renderer, \
+PangoRenderPart part, int x, int y, int width, int height)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_draw_rectangle", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoRenderPart(part), part, 2, "pango_renderer_draw_rectangle", "PangoRenderPart");
+ Xen_check_type(Xen_is_int(x), x, 3, "pango_renderer_draw_rectangle", "int");
+ Xen_check_type(Xen_is_int(y), y, 4, "pango_renderer_draw_rectangle", "int");
+ Xen_check_type(Xen_is_int(width), width, 5, "pango_renderer_draw_rectangle", "int");
+ Xen_check_type(Xen_is_int(height), height, 6, "pango_renderer_draw_rectangle", "int");
+ pango_renderer_draw_rectangle(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoRenderPart(part), Xen_to_C_int(x), Xen_to_C_int(y),
+ Xen_to_C_int(width), Xen_to_C_int(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_set_use_underline(XEN button, XEN use_underline)
+static Xen gxg_pango_renderer_draw_error_underline(Xen renderer, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gtk_tool_button_set_use_underline "void gtk_tool_button_set_use_underline(GtkToolButton* button, \
-gboolean use_underline)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_set_use_underline", "GtkToolButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_underline), use_underline, 2, "gtk_tool_button_set_use_underline", "gboolean");
- gtk_tool_button_set_use_underline(XEN_TO_C_GtkToolButton_(button), XEN_TO_C_gboolean(use_underline));
- return(XEN_FALSE);
+ #define H_pango_renderer_draw_error_underline "void pango_renderer_draw_error_underline(PangoRenderer* renderer, \
+int x, int y, int width, int height)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_draw_error_underline", "PangoRenderer*");
+ Xen_check_type(Xen_is_int(x), x, 2, "pango_renderer_draw_error_underline", "int");
+ Xen_check_type(Xen_is_int(y), y, 3, "pango_renderer_draw_error_underline", "int");
+ Xen_check_type(Xen_is_int(width), width, 4, "pango_renderer_draw_error_underline", "int");
+ Xen_check_type(Xen_is_int(height), height, 5, "pango_renderer_draw_error_underline", "int");
+ pango_renderer_draw_error_underline(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_int(x), Xen_to_C_int(y), Xen_to_C_int(width),
+ Xen_to_C_int(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_get_use_underline(XEN button)
+static Xen gxg_pango_renderer_draw_trapezoid(Xen arglist)
{
- #define H_gtk_tool_button_get_use_underline "gboolean gtk_tool_button_get_use_underline(GtkToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_get_use_underline", "GtkToolButton*");
- return(C_TO_XEN_gboolean(gtk_tool_button_get_use_underline(XEN_TO_C_GtkToolButton_(button))));
+ #define H_pango_renderer_draw_trapezoid "void pango_renderer_draw_trapezoid(PangoRenderer* renderer, \
+PangoRenderPart part, double y1, double x11, double x21, double y2, double x12, double x22)"
+ Xen renderer, part, y1, x11, x21, y2, x12, x22;
+ renderer = Xen_list_ref(arglist, 0);
+ part = Xen_list_ref(arglist, 1);
+ y1 = Xen_list_ref(arglist, 2);
+ x11 = Xen_list_ref(arglist, 3);
+ x21 = Xen_list_ref(arglist, 4);
+ y2 = Xen_list_ref(arglist, 5);
+ x12 = Xen_list_ref(arglist, 6);
+ x22 = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_draw_trapezoid", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoRenderPart(part), part, 2, "pango_renderer_draw_trapezoid", "PangoRenderPart");
+ Xen_check_type(Xen_is_double(y1), y1, 3, "pango_renderer_draw_trapezoid", "double");
+ Xen_check_type(Xen_is_double(x11), x11, 4, "pango_renderer_draw_trapezoid", "double");
+ Xen_check_type(Xen_is_double(x21), x21, 5, "pango_renderer_draw_trapezoid", "double");
+ Xen_check_type(Xen_is_double(y2), y2, 6, "pango_renderer_draw_trapezoid", "double");
+ Xen_check_type(Xen_is_double(x12), x12, 7, "pango_renderer_draw_trapezoid", "double");
+ Xen_check_type(Xen_is_double(x22), x22, 8, "pango_renderer_draw_trapezoid", "double");
+ pango_renderer_draw_trapezoid(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoRenderPart(part), Xen_to_C_double(y1), Xen_to_C_double(x11),
+ Xen_to_C_double(x21), Xen_to_C_double(y2), Xen_to_C_double(x12), Xen_to_C_double(x22));
+ return(Xen_false);
+}
+
+static Xen gxg_pango_renderer_draw_glyph(Xen renderer, Xen font, Xen glyph, Xen x, Xen y)
+{
+ #define H_pango_renderer_draw_glyph "void pango_renderer_draw_glyph(PangoRenderer* renderer, PangoFont* font, \
+PangoGlyph glyph, double x, double y)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_draw_glyph", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoFont_(font), font, 2, "pango_renderer_draw_glyph", "PangoFont*");
+ Xen_check_type(Xen_is_PangoGlyph(glyph), glyph, 3, "pango_renderer_draw_glyph", "PangoGlyph");
+ Xen_check_type(Xen_is_double(x), x, 4, "pango_renderer_draw_glyph", "double");
+ Xen_check_type(Xen_is_double(y), y, 5, "pango_renderer_draw_glyph", "double");
+ pango_renderer_draw_glyph(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoFont_(font), Xen_to_C_PangoGlyph(glyph), Xen_to_C_double(x),
+ Xen_to_C_double(y));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_set_stock_id(XEN button, XEN stock_id)
+static Xen gxg_pango_renderer_activate(Xen renderer)
{
- #define H_gtk_tool_button_set_stock_id "void gtk_tool_button_set_stock_id(GtkToolButton* button, gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_set_stock_id", "GtkToolButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_tool_button_set_stock_id", "gchar*");
- gtk_tool_button_set_stock_id(XEN_TO_C_GtkToolButton_(button), XEN_TO_C_gchar_(stock_id));
- return(XEN_FALSE);
+ #define H_pango_renderer_activate "void pango_renderer_activate(PangoRenderer* renderer)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_activate", "PangoRenderer*");
+ pango_renderer_activate(Xen_to_C_PangoRenderer_(renderer));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_get_stock_id(XEN button)
+static Xen gxg_pango_renderer_deactivate(Xen renderer)
{
- #define H_gtk_tool_button_get_stock_id "gchar* gtk_tool_button_get_stock_id(GtkToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_get_stock_id", "GtkToolButton*");
- return(C_TO_XEN_gchar_(gtk_tool_button_get_stock_id(XEN_TO_C_GtkToolButton_(button))));
+ #define H_pango_renderer_deactivate "void pango_renderer_deactivate(PangoRenderer* renderer)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_deactivate", "PangoRenderer*");
+ pango_renderer_deactivate(Xen_to_C_PangoRenderer_(renderer));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_set_icon_widget(XEN button, XEN icon_widget)
+static Xen gxg_pango_renderer_part_changed(Xen renderer, Xen part)
{
- #define H_gtk_tool_button_set_icon_widget "void gtk_tool_button_set_icon_widget(GtkToolButton* button, \
-GtkWidget* icon_widget)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_set_icon_widget", "GtkToolButton*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(icon_widget) || XEN_FALSE_P(icon_widget), icon_widget, 2, "gtk_tool_button_set_icon_widget", "GtkWidget*");
- gtk_tool_button_set_icon_widget(XEN_TO_C_GtkToolButton_(button), XEN_TO_C_GtkWidget_(icon_widget));
- return(XEN_FALSE);
+ #define H_pango_renderer_part_changed "void pango_renderer_part_changed(PangoRenderer* renderer, PangoRenderPart part)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_part_changed", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoRenderPart(part), part, 2, "pango_renderer_part_changed", "PangoRenderPart");
+ pango_renderer_part_changed(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoRenderPart(part));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_get_icon_widget(XEN button)
+static Xen gxg_pango_renderer_set_color(Xen renderer, Xen part, Xen color)
{
- #define H_gtk_tool_button_get_icon_widget "GtkWidget* gtk_tool_button_get_icon_widget(GtkToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_get_icon_widget", "GtkToolButton*");
- return(C_TO_XEN_GtkWidget_(gtk_tool_button_get_icon_widget(XEN_TO_C_GtkToolButton_(button))));
+ #define H_pango_renderer_set_color "void pango_renderer_set_color(PangoRenderer* renderer, PangoRenderPart part, \
+PangoColor* color)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_set_color", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoRenderPart(part), part, 2, "pango_renderer_set_color", "PangoRenderPart");
+ Xen_check_type(Xen_is_PangoColor_(color), color, 3, "pango_renderer_set_color", "PangoColor*");
+ pango_renderer_set_color(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoRenderPart(part), Xen_to_C_PangoColor_(color));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_set_label_widget(XEN button, XEN label_widget)
+static Xen gxg_pango_renderer_get_color(Xen renderer, Xen part)
{
- #define H_gtk_tool_button_set_label_widget "void gtk_tool_button_set_label_widget(GtkToolButton* button, \
-GtkWidget* label_widget)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_set_label_widget", "GtkToolButton*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(label_widget) || XEN_FALSE_P(label_widget), label_widget, 2, "gtk_tool_button_set_label_widget", "GtkWidget*");
- gtk_tool_button_set_label_widget(XEN_TO_C_GtkToolButton_(button), XEN_TO_C_GtkWidget_(label_widget));
- return(XEN_FALSE);
+ #define H_pango_renderer_get_color "PangoColor* pango_renderer_get_color(PangoRenderer* renderer, PangoRenderPart part)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_get_color", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoRenderPart(part), part, 2, "pango_renderer_get_color", "PangoRenderPart");
+ return(C_to_Xen_PangoColor_(pango_renderer_get_color(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoRenderPart(part))));
}
-static XEN gxg_gtk_tool_button_get_label_widget(XEN button)
+static Xen gxg_pango_renderer_set_matrix(Xen renderer, Xen matrix)
{
- #define H_gtk_tool_button_get_label_widget "GtkWidget* gtk_tool_button_get_label_widget(GtkToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_get_label_widget", "GtkToolButton*");
- return(C_TO_XEN_GtkWidget_(gtk_tool_button_get_label_widget(XEN_TO_C_GtkToolButton_(button))));
+ #define H_pango_renderer_set_matrix "void pango_renderer_set_matrix(PangoRenderer* renderer, PangoMatrix* matrix)"
+ Xen_check_type(Xen_is_PangoRenderer_(renderer), renderer, 1, "pango_renderer_set_matrix", "PangoRenderer*");
+ Xen_check_type(Xen_is_PangoMatrix_(matrix), matrix, 2, "pango_renderer_set_matrix", "PangoMatrix*");
+ pango_renderer_set_matrix(Xen_to_C_PangoRenderer_(renderer), Xen_to_C_PangoMatrix_(matrix));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_new(void)
+static Xen gxg_g_log_set_handler(Xen log_domain, Xen log_levels, Xen func, Xen func_info)
{
- #define H_gtk_tool_item_new "GtkToolItem* gtk_tool_item_new( void)"
- return(C_TO_XEN_GtkToolItem_(gtk_tool_item_new()));
+ #define H_g_log_set_handler "guint g_log_set_handler(gchar* log_domain, GLogLevelFlags log_levels, \
+GLogFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_gchar_(log_domain), log_domain, 1, "g_log_set_handler", "gchar*");
+ Xen_check_type(Xen_is_GLogLevelFlags(log_levels), log_levels, 2, "g_log_set_handler", "GLogLevelFlags");
+ Xen_check_type(Xen_is_GLogFunc(func), func, 3, "g_log_set_handler", "GLogFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "g_log_set_handler", "lambda_data");
+ {
+ Xen result;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ result = C_to_Xen_guint(g_log_set_handler(Xen_to_C_gchar_(log_domain), Xen_to_C_GLogLevelFlags(log_levels), Xen_to_C_GLogFunc(func),
+ Xen_to_C_lambda_data(func_info)));
+ return(result);
+ }
}
-static XEN gxg_gtk_tool_item_set_homogeneous(XEN tool_item, XEN homogeneous)
+static Xen gxg_g_log_remove_handler(Xen log_domain, Xen handler_id)
{
- #define H_gtk_tool_item_set_homogeneous "void gtk_tool_item_set_homogeneous(GtkToolItem* tool_item, \
-gboolean homogeneous)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_set_homogeneous", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(homogeneous), homogeneous, 2, "gtk_tool_item_set_homogeneous", "gboolean");
- gtk_tool_item_set_homogeneous(XEN_TO_C_GtkToolItem_(tool_item), XEN_TO_C_gboolean(homogeneous));
- return(XEN_FALSE);
+ #define H_g_log_remove_handler "void g_log_remove_handler(gchar* log_domain, guint handler_id)"
+ Xen_check_type(Xen_is_gchar_(log_domain), log_domain, 1, "g_log_remove_handler", "gchar*");
+ Xen_check_type(Xen_is_guint(handler_id), handler_id, 2, "g_log_remove_handler", "guint");
+ g_log_remove_handler(Xen_to_C_gchar_(log_domain), Xen_to_C_guint(handler_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_get_homogeneous(XEN tool_item)
+static Xen gxg_gtk_cell_renderer_stop_editing(Xen cell, Xen canceled)
{
- #define H_gtk_tool_item_get_homogeneous "gboolean gtk_tool_item_get_homogeneous(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_homogeneous", "GtkToolItem*");
- return(C_TO_XEN_gboolean(gtk_tool_item_get_homogeneous(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_cell_renderer_stop_editing "void gtk_cell_renderer_stop_editing(GtkCellRenderer* cell, \
+gboolean canceled)"
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_stop_editing", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(canceled), canceled, 2, "gtk_cell_renderer_stop_editing", "gboolean");
+ gtk_cell_renderer_stop_editing(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gboolean(canceled));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_file_chooser_button_new(Xen title, Xen action)
+{
+ #define H_gtk_file_chooser_button_new "GtkWidget* gtk_file_chooser_button_new(gchar* title, GtkFileChooserAction action)"
+ Xen_check_type(Xen_is_gchar_(title), title, 1, "gtk_file_chooser_button_new", "gchar*");
+ Xen_check_type(Xen_is_GtkFileChooserAction(action), action, 2, "gtk_file_chooser_button_new", "GtkFileChooserAction");
+ return(C_to_Xen_GtkWidget_(gtk_file_chooser_button_new((const gchar*)Xen_to_C_gchar_(title), Xen_to_C_GtkFileChooserAction(action))));
}
-static XEN gxg_gtk_tool_item_set_expand(XEN tool_item, XEN expand)
+static Xen gxg_gtk_icon_view_set_columns(Xen icon_view, Xen columns)
{
- #define H_gtk_tool_item_set_expand "void gtk_tool_item_set_expand(GtkToolItem* tool_item, gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_set_expand", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 2, "gtk_tool_item_set_expand", "gboolean");
- gtk_tool_item_set_expand(XEN_TO_C_GtkToolItem_(tool_item), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_set_columns "void gtk_icon_view_set_columns(GtkIconView* icon_view, gint columns)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_columns", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(columns), columns, 2, "gtk_icon_view_set_columns", "gint");
+ gtk_icon_view_set_columns(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(columns));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_get_expand(XEN tool_item)
+static Xen gxg_gtk_icon_view_get_columns(Xen icon_view)
{
- #define H_gtk_tool_item_get_expand "gboolean gtk_tool_item_get_expand(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_expand", "GtkToolItem*");
- return(C_TO_XEN_gboolean(gtk_tool_item_get_expand(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_icon_view_get_columns "gint gtk_icon_view_get_columns(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_columns", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_columns(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_tool_item_set_use_drag_window(XEN toolitem, XEN use_drag_window)
+static Xen gxg_gtk_icon_view_set_item_width(Xen icon_view, Xen item_width)
{
- #define H_gtk_tool_item_set_use_drag_window "void gtk_tool_item_set_use_drag_window(GtkToolItem* toolitem, \
-gboolean use_drag_window)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(toolitem), toolitem, 1, "gtk_tool_item_set_use_drag_window", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_drag_window), use_drag_window, 2, "gtk_tool_item_set_use_drag_window", "gboolean");
- gtk_tool_item_set_use_drag_window(XEN_TO_C_GtkToolItem_(toolitem), XEN_TO_C_gboolean(use_drag_window));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_set_item_width "void gtk_icon_view_set_item_width(GtkIconView* icon_view, gint item_width)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_item_width", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(item_width), item_width, 2, "gtk_icon_view_set_item_width", "gint");
+ gtk_icon_view_set_item_width(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(item_width));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_get_use_drag_window(XEN toolitem)
+static Xen gxg_gtk_icon_view_get_item_width(Xen icon_view)
{
- #define H_gtk_tool_item_get_use_drag_window "gboolean gtk_tool_item_get_use_drag_window(GtkToolItem* toolitem)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(toolitem), toolitem, 1, "gtk_tool_item_get_use_drag_window", "GtkToolItem*");
- return(C_TO_XEN_gboolean(gtk_tool_item_get_use_drag_window(XEN_TO_C_GtkToolItem_(toolitem))));
+ #define H_gtk_icon_view_get_item_width "gint gtk_icon_view_get_item_width(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_item_width", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_item_width(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_tool_item_set_visible_horizontal(XEN toolitem, XEN visible_horizontal)
+static Xen gxg_gtk_icon_view_set_spacing(Xen icon_view, Xen spacing)
{
- #define H_gtk_tool_item_set_visible_horizontal "void gtk_tool_item_set_visible_horizontal(GtkToolItem* toolitem, \
-gboolean visible_horizontal)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(toolitem), toolitem, 1, "gtk_tool_item_set_visible_horizontal", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible_horizontal), visible_horizontal, 2, "gtk_tool_item_set_visible_horizontal", "gboolean");
- gtk_tool_item_set_visible_horizontal(XEN_TO_C_GtkToolItem_(toolitem), XEN_TO_C_gboolean(visible_horizontal));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_set_spacing "void gtk_icon_view_set_spacing(GtkIconView* icon_view, gint spacing)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_spacing", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(spacing), spacing, 2, "gtk_icon_view_set_spacing", "gint");
+ gtk_icon_view_set_spacing(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_get_visible_horizontal(XEN toolitem)
+static Xen gxg_gtk_icon_view_get_spacing(Xen icon_view)
{
- #define H_gtk_tool_item_get_visible_horizontal "gboolean gtk_tool_item_get_visible_horizontal(GtkToolItem* toolitem)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(toolitem), toolitem, 1, "gtk_tool_item_get_visible_horizontal", "GtkToolItem*");
- return(C_TO_XEN_gboolean(gtk_tool_item_get_visible_horizontal(XEN_TO_C_GtkToolItem_(toolitem))));
+ #define H_gtk_icon_view_get_spacing "gint gtk_icon_view_get_spacing(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_spacing", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_spacing(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_tool_item_set_visible_vertical(XEN toolitem, XEN visible_vertical)
+static Xen gxg_gtk_icon_view_set_row_spacing(Xen icon_view, Xen row_spacing)
{
- #define H_gtk_tool_item_set_visible_vertical "void gtk_tool_item_set_visible_vertical(GtkToolItem* toolitem, \
-gboolean visible_vertical)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(toolitem), toolitem, 1, "gtk_tool_item_set_visible_vertical", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible_vertical), visible_vertical, 2, "gtk_tool_item_set_visible_vertical", "gboolean");
- gtk_tool_item_set_visible_vertical(XEN_TO_C_GtkToolItem_(toolitem), XEN_TO_C_gboolean(visible_vertical));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_set_row_spacing "void gtk_icon_view_set_row_spacing(GtkIconView* icon_view, \
+gint row_spacing)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_row_spacing", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(row_spacing), row_spacing, 2, "gtk_icon_view_set_row_spacing", "gint");
+ gtk_icon_view_set_row_spacing(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(row_spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_get_visible_vertical(XEN toolitem)
+static Xen gxg_gtk_icon_view_get_row_spacing(Xen icon_view)
{
- #define H_gtk_tool_item_get_visible_vertical "gboolean gtk_tool_item_get_visible_vertical(GtkToolItem* toolitem)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(toolitem), toolitem, 1, "gtk_tool_item_get_visible_vertical", "GtkToolItem*");
- return(C_TO_XEN_gboolean(gtk_tool_item_get_visible_vertical(XEN_TO_C_GtkToolItem_(toolitem))));
+ #define H_gtk_icon_view_get_row_spacing "gint gtk_icon_view_get_row_spacing(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_row_spacing", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_row_spacing(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_tool_item_get_is_important(XEN tool_item)
+static Xen gxg_gtk_icon_view_set_column_spacing(Xen icon_view, Xen column_spacing)
{
- #define H_gtk_tool_item_get_is_important "gboolean gtk_tool_item_get_is_important(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_is_important", "GtkToolItem*");
- return(C_TO_XEN_gboolean(gtk_tool_item_get_is_important(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_icon_view_set_column_spacing "void gtk_icon_view_set_column_spacing(GtkIconView* icon_view, \
+gint column_spacing)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_column_spacing", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(column_spacing), column_spacing, 2, "gtk_icon_view_set_column_spacing", "gint");
+ gtk_icon_view_set_column_spacing(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(column_spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_set_is_important(XEN tool_item, XEN is_important)
+static Xen gxg_gtk_icon_view_get_column_spacing(Xen icon_view)
{
- #define H_gtk_tool_item_set_is_important "void gtk_tool_item_set_is_important(GtkToolItem* tool_item, \
-gboolean is_important)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_set_is_important", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_important), is_important, 2, "gtk_tool_item_set_is_important", "gboolean");
- gtk_tool_item_set_is_important(XEN_TO_C_GtkToolItem_(tool_item), XEN_TO_C_gboolean(is_important));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_get_column_spacing "gint gtk_icon_view_get_column_spacing(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_column_spacing", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_column_spacing(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_tool_item_get_icon_size(XEN tool_item)
+static Xen gxg_gtk_icon_view_set_margin(Xen icon_view, Xen margin)
{
- #define H_gtk_tool_item_get_icon_size "GtkIconSize gtk_tool_item_get_icon_size(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_icon_size", "GtkToolItem*");
- return(C_TO_XEN_GtkIconSize(gtk_tool_item_get_icon_size(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_icon_view_set_margin "void gtk_icon_view_set_margin(GtkIconView* icon_view, gint margin)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_margin", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(margin), margin, 2, "gtk_icon_view_set_margin", "gint");
+ gtk_icon_view_set_margin(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(margin));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_get_orientation(XEN tool_item)
+static Xen gxg_gtk_icon_view_get_margin(Xen icon_view)
{
- #define H_gtk_tool_item_get_orientation "GtkOrientation gtk_tool_item_get_orientation(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_orientation", "GtkToolItem*");
- return(C_TO_XEN_GtkOrientation(gtk_tool_item_get_orientation(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_icon_view_get_margin "gint gtk_icon_view_get_margin(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_margin", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_margin(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_tool_item_get_toolbar_style(XEN tool_item)
+static Xen gxg_gtk_label_set_max_width_chars(Xen label, Xen n_chars)
{
- #define H_gtk_tool_item_get_toolbar_style "GtkToolbarStyle gtk_tool_item_get_toolbar_style(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_toolbar_style", "GtkToolItem*");
- return(C_TO_XEN_GtkToolbarStyle(gtk_tool_item_get_toolbar_style(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_label_set_max_width_chars "void gtk_label_set_max_width_chars(GtkLabel* label, gint n_chars)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_max_width_chars", "GtkLabel*");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 2, "gtk_label_set_max_width_chars", "gint");
+ gtk_label_set_max_width_chars(Xen_to_C_GtkLabel_(label), Xen_to_C_gint(n_chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_get_relief_style(XEN tool_item)
+static Xen gxg_gtk_label_get_max_width_chars(Xen label)
{
- #define H_gtk_tool_item_get_relief_style "GtkReliefStyle gtk_tool_item_get_relief_style(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_relief_style", "GtkToolItem*");
- return(C_TO_XEN_GtkReliefStyle(gtk_tool_item_get_relief_style(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_label_get_max_width_chars "gint gtk_label_get_max_width_chars(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_max_width_chars", "GtkLabel*");
+ return(C_to_Xen_gint(gtk_label_get_max_width_chars(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_tool_item_retrieve_proxy_menu_item(XEN tool_item)
+static Xen gxg_gtk_list_store_insert_with_values(Xen list_store, Xen iter, Xen position)
{
- #define H_gtk_tool_item_retrieve_proxy_menu_item "GtkWidget* gtk_tool_item_retrieve_proxy_menu_item(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_retrieve_proxy_menu_item", "GtkToolItem*");
- return(C_TO_XEN_GtkWidget_(gtk_tool_item_retrieve_proxy_menu_item(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_list_store_insert_with_values "void gtk_list_store_insert_with_values(GtkListStore* list_store, \
+GtkTreeIter* iter, gint position, ...)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_insert_with_values", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_insert_with_values", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_list_store_insert_with_values", "gint");
+ gtk_list_store_insert_with_values(Xen_to_C_GtkListStore_(list_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_get_proxy_menu_item(XEN tool_item, XEN menu_item_id)
+static Xen gxg_gtk_list_store_insert_with_valuesv(Xen list_store, Xen iter, Xen position, Xen columns, Xen values, Xen n_values)
{
- #define H_gtk_tool_item_get_proxy_menu_item "GtkWidget* gtk_tool_item_get_proxy_menu_item(GtkToolItem* tool_item, \
-gchar* menu_item_id)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_proxy_menu_item", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gchar__P(menu_item_id), menu_item_id, 2, "gtk_tool_item_get_proxy_menu_item", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_tool_item_get_proxy_menu_item(XEN_TO_C_GtkToolItem_(tool_item), XEN_TO_C_gchar_(menu_item_id))));
+ #define H_gtk_list_store_insert_with_valuesv "void gtk_list_store_insert_with_valuesv(GtkListStore* list_store, \
+GtkTreeIter* iter, gint position, gint* columns, GValue* values, gint n_values)"
+ Xen_check_type(Xen_is_GtkListStore_(list_store), list_store, 1, "gtk_list_store_insert_with_valuesv", "GtkListStore*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_list_store_insert_with_valuesv", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_list_store_insert_with_valuesv", "gint");
+ Xen_check_type(Xen_is_gint_(columns), columns, 4, "gtk_list_store_insert_with_valuesv", "gint*");
+ Xen_check_type(Xen_is_GValue_(values), values, 5, "gtk_list_store_insert_with_valuesv", "GValue*");
+ Xen_check_type(Xen_is_gint(n_values), n_values, 6, "gtk_list_store_insert_with_valuesv", "gint");
+ gtk_list_store_insert_with_valuesv(Xen_to_C_GtkListStore_(list_store), Xen_to_C_GtkTreeIter_(iter), Xen_to_C_gint(position),
+ Xen_to_C_gint_(columns), Xen_to_C_GValue_(values), Xen_to_C_gint(n_values));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_set_proxy_menu_item(XEN tool_item, XEN menu_item_id, XEN menu_item)
+static Xen gxg_gtk_text_view_get_iter_at_position(Xen text_view, Xen iter, Xen ignore_trailing, Xen x, Xen y)
{
- #define H_gtk_tool_item_set_proxy_menu_item "void gtk_tool_item_set_proxy_menu_item(GtkToolItem* tool_item, \
-gchar* menu_item_id, GtkWidget* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item) || XEN_FALSE_P(tool_item), tool_item, 1, "gtk_tool_item_set_proxy_menu_item", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gchar__P(menu_item_id), menu_item_id, 2, "gtk_tool_item_set_proxy_menu_item", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(menu_item) || XEN_FALSE_P(menu_item), menu_item, 3, "gtk_tool_item_set_proxy_menu_item", "GtkWidget*");
- gtk_tool_item_set_proxy_menu_item(XEN_TO_C_GtkToolItem_(tool_item), XEN_TO_C_gchar_(menu_item_id), XEN_TO_C_GtkWidget_(menu_item));
- return(XEN_FALSE);
+ #define H_gtk_text_view_get_iter_at_position "void gtk_text_view_get_iter_at_position(GtkTextView* text_view, \
+GtkTextIter* iter, gint* [trailing], gint x, gint y)"
+ gint ref_trailing;
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_iter_at_position", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_view_get_iter_at_position", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(x), x, 4, "gtk_text_view_get_iter_at_position", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 5, "gtk_text_view_get_iter_at_position", "gint");
+ gtk_text_view_get_iter_at_position(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkTextIter_(iter), &ref_trailing, Xen_to_C_gint(x),
+ Xen_to_C_gint(y));
+ return(Xen_list_1(C_to_Xen_gint(ref_trailing)));
}
-static XEN gxg_gtk_list_store_remove(XEN list_store, XEN iter)
+static Xen gxg_pango_attr_size_new_absolute(Xen size)
{
- #define H_gtk_list_store_remove "gboolean gtk_list_store_remove(GtkListStore* list_store, GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_remove", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_remove", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_list_store_remove(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_pango_attr_size_new_absolute "PangoAttribute* pango_attr_size_new_absolute(int size)"
+ Xen_check_type(Xen_is_int(size), size, 1, "pango_attr_size_new_absolute", "int");
+ return(C_to_Xen_PangoAttribute_(pango_attr_size_new_absolute(Xen_to_C_int(size))));
}
-static XEN gxg_gdk_display_set_double_click_distance(XEN display, XEN distance)
+static Xen gxg_pango_font_description_set_absolute_size(Xen desc, Xen size)
{
- #define H_gdk_display_set_double_click_distance "void gdk_display_set_double_click_distance(GdkDisplay* display, \
-guint distance)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_set_double_click_distance", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_guint_P(distance), distance, 2, "gdk_display_set_double_click_distance", "guint");
- gdk_display_set_double_click_distance(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_guint(distance));
- return(XEN_FALSE);
+ #define H_pango_font_description_set_absolute_size "void pango_font_description_set_absolute_size(PangoFontDescription* desc, \
+double size)"
+ Xen_check_type(Xen_is_PangoFontDescription_(desc), desc, 1, "pango_font_description_set_absolute_size", "PangoFontDescription*");
+ Xen_check_type(Xen_is_double(size), size, 2, "pango_font_description_set_absolute_size", "double");
+ pango_font_description_set_absolute_size(Xen_to_C_PangoFontDescription_(desc), Xen_to_C_double(size));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_get_default_group(XEN display)
+static Xen gxg_pango_layout_get_font_description(Xen layout)
{
- #define H_gdk_display_get_default_group "GdkWindow* gdk_display_get_default_group(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_default_group", "GdkDisplay*");
- return(C_TO_XEN_GdkWindow_(gdk_display_get_default_group(XEN_TO_C_GdkDisplay_(display))));
+ #define H_pango_layout_get_font_description "PangoFontDescription* pango_layout_get_font_description(PangoLayout* layout)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_get_font_description", "PangoLayout*");
+ return(C_to_Xen_PangoFontDescription_((PangoFontDescription*)pango_layout_get_font_description(Xen_to_C_PangoLayout_(layout))));
}
-static XEN gxg_gdk_window_get_group(XEN window)
+static Xen gxg_gdk_cursor_new_from_name(Xen display, Xen name)
{
- #define H_gdk_window_get_group "GdkWindow* gdk_window_get_group(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_group", "GdkWindow*");
- return(C_TO_XEN_GdkWindow_(gdk_window_get_group(XEN_TO_C_GdkWindow_(window))));
+ #define H_gdk_cursor_new_from_name "GdkCursor* gdk_cursor_new_from_name(GdkDisplay* display, gchar* name)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_cursor_new_from_name", "GdkDisplay*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gdk_cursor_new_from_name", "gchar*");
+ return(C_to_Xen_GdkCursor_(gdk_cursor_new_from_name(Xen_to_C_GdkDisplay_(display), (const gchar*)Xen_to_C_gchar_(name))));
}
-static XEN gxg_gtk_action_group_get_sensitive(XEN action_group)
+static Xen gxg_gdk_cursor_get_image(Xen cursor)
{
- #define H_gtk_action_group_get_sensitive "gboolean gtk_action_group_get_sensitive(GtkActionGroup* action_group)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_get_sensitive", "GtkActionGroup*");
- return(C_TO_XEN_gboolean(gtk_action_group_get_sensitive(XEN_TO_C_GtkActionGroup_(action_group))));
+ #define H_gdk_cursor_get_image "GdkPixbuf* gdk_cursor_get_image(GdkCursor* cursor)"
+ Xen_check_type(Xen_is_GdkCursor_(cursor), cursor, 1, "gdk_cursor_get_image", "GdkCursor*");
+ return(C_to_Xen_GdkPixbuf_(gdk_cursor_get_image(Xen_to_C_GdkCursor_(cursor))));
}
-static XEN gxg_gtk_action_group_set_sensitive(XEN action_group, XEN sensitive)
+static Xen gxg_gdk_screen_get_rgba_visual(Xen screen)
{
- #define H_gtk_action_group_set_sensitive "void gtk_action_group_set_sensitive(GtkActionGroup* action_group, \
-gboolean sensitive)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_set_sensitive", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(sensitive), sensitive, 2, "gtk_action_group_set_sensitive", "gboolean");
- gtk_action_group_set_sensitive(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_gboolean(sensitive));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_rgba_visual "GdkVisual* gdk_screen_get_rgba_visual(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_rgba_visual", "GdkScreen*");
+ return(C_to_Xen_GdkVisual_(gdk_screen_get_rgba_visual(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_gtk_action_group_get_visible(XEN action_group)
+static Xen gxg_gdk_window_set_urgency_hint(Xen window, Xen urgent)
{
- #define H_gtk_action_group_get_visible "gboolean gtk_action_group_get_visible(GtkActionGroup* action_group)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_get_visible", "GtkActionGroup*");
- return(C_TO_XEN_gboolean(gtk_action_group_get_visible(XEN_TO_C_GtkActionGroup_(action_group))));
+ #define H_gdk_window_set_urgency_hint "void gdk_window_set_urgency_hint(GdkWindow* window, gboolean urgent)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_urgency_hint", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(urgent), urgent, 2, "gdk_window_set_urgency_hint", "gboolean");
+ gdk_window_set_urgency_hint(Xen_to_C_GdkWindow_(window), Xen_to_C_gboolean(urgent));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_group_set_visible(XEN action_group, XEN visible)
+static Xen gxg_gtk_dialog_get_response_for_widget(Xen dialog, Xen widget)
{
- #define H_gtk_action_group_set_visible "void gtk_action_group_set_visible(GtkActionGroup* action_group, \
-gboolean visible)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_set_visible", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible), visible, 2, "gtk_action_group_set_visible", "gboolean");
- gtk_action_group_set_visible(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_gboolean(visible));
- return(XEN_FALSE);
+ #define H_gtk_dialog_get_response_for_widget "gint gtk_dialog_get_response_for_widget(GtkDialog* dialog, \
+GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_get_response_for_widget", "GtkDialog*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_dialog_get_response_for_widget", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_dialog_get_response_for_widget(Xen_to_C_GtkDialog_(dialog), Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_action_group_add_action_with_accel(XEN action_group, XEN action, XEN accelerator)
+static Xen gxg_gtk_drag_source_set_icon_name(Xen widget, Xen icon_name)
{
- #define H_gtk_action_group_add_action_with_accel "void gtk_action_group_add_action_with_accel(GtkActionGroup* action_group, \
-GtkAction* action, gchar* accelerator)"
- XEN_ASSERT_TYPE(XEN_GtkActionGroup__P(action_group), action_group, 1, "gtk_action_group_add_action_with_accel", "GtkActionGroup*");
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 2, "gtk_action_group_add_action_with_accel", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gchar__P(accelerator), accelerator, 3, "gtk_action_group_add_action_with_accel", "gchar*");
- gtk_action_group_add_action_with_accel(XEN_TO_C_GtkActionGroup_(action_group), XEN_TO_C_GtkAction_(action), XEN_TO_C_gchar_(accelerator));
- return(XEN_FALSE);
+ #define H_gtk_drag_source_set_icon_name "void gtk_drag_source_set_icon_name(GtkWidget* widget, gchar* icon_name)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_set_icon_name", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_drag_source_set_icon_name", "gchar*");
+ gtk_drag_source_set_icon_name(Xen_to_C_GtkWidget_(widget), (const gchar*)Xen_to_C_gchar_(icon_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_new(XEN name, XEN label, XEN tooltip, XEN stock_id)
+static Xen gxg_gtk_drag_set_icon_name(Xen context, Xen icon_name, Xen hot_x, Xen hot_y)
{
- #define H_gtk_action_new "GtkAction* gtk_action_new(gchar* name, gchar* label, gchar* tooltip, gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(tooltip), tooltip, 3, "gtk_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 4, "gtk_action_new", "gchar*");
- return(C_TO_XEN_GtkAction_(gtk_action_new(XEN_TO_C_gchar_(name), XEN_TO_C_gchar_(label), XEN_TO_C_gchar_(tooltip), XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_drag_set_icon_name "void gtk_drag_set_icon_name(GdkDragContext* context, gchar* icon_name, \
+gint hot_x, gint hot_y)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_set_icon_name", "GdkDragContext*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_drag_set_icon_name", "gchar*");
+ Xen_check_type(Xen_is_gint(hot_x), hot_x, 3, "gtk_drag_set_icon_name", "gint");
+ Xen_check_type(Xen_is_gint(hot_y), hot_y, 4, "gtk_drag_set_icon_name", "gint");
+ gtk_drag_set_icon_name(Xen_to_C_GdkDragContext_(context), (const gchar*)Xen_to_C_gchar_(icon_name), Xen_to_C_gint(hot_x), Xen_to_C_gint(hot_y));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_is_sensitive(XEN action)
+static Xen gxg_gtk_entry_completion_set_popup_set_width(Xen completion, Xen popup_set_width)
{
- #define H_gtk_action_is_sensitive "gboolean gtk_action_is_sensitive(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_is_sensitive", "GtkAction*");
- return(C_TO_XEN_gboolean(gtk_action_is_sensitive(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_entry_completion_set_popup_set_width "void gtk_entry_completion_set_popup_set_width(GtkEntryCompletion* completion, \
+gboolean popup_set_width)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_popup_set_width", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gboolean(popup_set_width), popup_set_width, 2, "gtk_entry_completion_set_popup_set_width", "gboolean");
+ gtk_entry_completion_set_popup_set_width(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gboolean(popup_set_width));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_get_sensitive(XEN action)
+static Xen gxg_gtk_entry_completion_get_popup_set_width(Xen completion)
{
- #define H_gtk_action_get_sensitive "gboolean gtk_action_get_sensitive(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_sensitive", "GtkAction*");
- return(C_TO_XEN_gboolean(gtk_action_get_sensitive(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_entry_completion_get_popup_set_width "gboolean gtk_entry_completion_get_popup_set_width(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_popup_set_width", "GtkEntryCompletion*");
+ return(C_to_Xen_gboolean(gtk_entry_completion_get_popup_set_width(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_gtk_action_is_visible(XEN action)
+static Xen gxg_gtk_entry_completion_set_popup_single_match(Xen completion, Xen popup_single_match)
{
- #define H_gtk_action_is_visible "gboolean gtk_action_is_visible(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_is_visible", "GtkAction*");
- return(C_TO_XEN_gboolean(gtk_action_is_visible(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_entry_completion_set_popup_single_match "void gtk_entry_completion_set_popup_single_match(GtkEntryCompletion* completion, \
+gboolean popup_single_match)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_popup_single_match", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gboolean(popup_single_match), popup_single_match, 2, "gtk_entry_completion_set_popup_single_match", "gboolean");
+ gtk_entry_completion_set_popup_single_match(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gboolean(popup_single_match));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_get_visible(XEN action)
+static Xen gxg_gtk_entry_completion_get_popup_single_match(Xen completion)
{
- #define H_gtk_action_get_visible "gboolean gtk_action_get_visible(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_visible", "GtkAction*");
- return(C_TO_XEN_gboolean(gtk_action_get_visible(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_entry_completion_get_popup_single_match "gboolean gtk_entry_completion_get_popup_single_match(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_popup_single_match", "GtkEntryCompletion*");
+ return(C_to_Xen_gboolean(gtk_entry_completion_get_popup_single_match(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_gtk_button_set_alignment(XEN button, XEN xalign, XEN yalign)
+static Xen gxg_gtk_icon_view_get_item_at_pos(Xen icon_view, Xen x, Xen y, Xen ignore_path, Xen ignore_cell)
{
- #define H_gtk_button_set_alignment "void gtk_button_set_alignment(GtkButton* button, gfloat xalign, \
-gfloat yalign)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_set_alignment", "GtkButton*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_button_set_alignment", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yalign), yalign, 3, "gtk_button_set_alignment", "gfloat");
- gtk_button_set_alignment(XEN_TO_C_GtkButton_(button), XEN_TO_C_gfloat(xalign), XEN_TO_C_gfloat(yalign));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_get_item_at_pos "gboolean gtk_icon_view_get_item_at_pos(GtkIconView* icon_view, \
+gint x, gint y, GtkTreePath** [path], GtkCellRenderer** [cell])"
+ GtkTreePath* ref_path = NULL;
+ GtkCellRenderer* ref_cell = NULL;
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_item_at_pos", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_icon_view_get_item_at_pos", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_icon_view_get_item_at_pos", "gint");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_icon_view_get_item_at_pos(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(x), Xen_to_C_gint(y),
+ &ref_path, &ref_cell));
+ return(Xen_list_3(result, C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkCellRenderer_(ref_cell)));
+ }
}
-static XEN gxg_gtk_button_get_alignment(XEN button, XEN ignore_xalign, XEN ignore_yalign)
+static Xen gxg_gtk_icon_view_get_visible_range(Xen icon_view, Xen ignore_start_path, Xen ignore_end_path)
{
- #define H_gtk_button_get_alignment "void gtk_button_get_alignment(GtkButton* button, gfloat* [xalign], \
-gfloat* [yalign])"
- gfloat ref_xalign;
- gfloat ref_yalign;
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_alignment", "GtkButton*");
- gtk_button_get_alignment(XEN_TO_C_GtkButton_(button), &ref_xalign, &ref_yalign);
- return(XEN_LIST_2(C_TO_XEN_gfloat(ref_xalign), C_TO_XEN_gfloat(ref_yalign)));
+ #define H_gtk_icon_view_get_visible_range "gboolean gtk_icon_view_get_visible_range(GtkIconView* icon_view, \
+GtkTreePath** [start_path], GtkTreePath** [end_path])"
+ GtkTreePath* ref_start_path = NULL;
+ GtkTreePath* ref_end_path = NULL;
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_visible_range", "GtkIconView*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_icon_view_get_visible_range(Xen_to_C_GtkIconView_(icon_view), &ref_start_path, &ref_end_path));
+ return(Xen_list_3(result, C_to_Xen_GtkTreePath_(ref_start_path), C_to_Xen_GtkTreePath_(ref_end_path)));
+ }
}
-static XEN gxg_gtk_cell_layout_reorder(XEN cell_layout, XEN cell, XEN position)
+static Xen gxg_gtk_icon_view_set_cursor(Xen icon_view, Xen path, Xen cell, Xen start_editing)
{
- #define H_gtk_cell_layout_reorder "void gtk_cell_layout_reorder(GtkCellLayout* cell_layout, GtkCellRenderer* cell, \
-gint position)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_reorder", "GtkCellLayout*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_cell_layout_reorder", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_cell_layout_reorder", "gint");
- gtk_cell_layout_reorder(XEN_TO_C_GtkCellLayout_(cell_layout), XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_set_cursor "void gtk_icon_view_set_cursor(GtkIconView* icon_view, GtkTreePath* path, \
+GtkCellRenderer* cell, gboolean start_editing)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_cursor", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_set_cursor", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 3, "gtk_icon_view_set_cursor", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(start_editing), start_editing, 4, "gtk_icon_view_set_cursor", "gboolean");
+ gtk_icon_view_set_cursor(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkCellRenderer_(cell),
+ Xen_to_C_gboolean(start_editing));
+ return(Xen_false);
}
-static XEN gxg_gtk_clipboard_request_targets(XEN clipboard, XEN func, XEN func_info)
+static Xen gxg_gtk_icon_view_get_cursor(Xen icon_view, Xen ignore_path, Xen ignore_cell)
{
- #define H_gtk_clipboard_request_targets "void gtk_clipboard_request_targets(GtkClipboard* clipboard, \
-GtkClipboardTargetsReceivedFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_request_targets", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkClipboardTargetsReceivedFunc_P(func), func, 2, "gtk_clipboard_request_targets", "GtkClipboardTargetsReceivedFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_clipboard_request_targets", "lambda_data");
+ #define H_gtk_icon_view_get_cursor "gboolean gtk_icon_view_get_cursor(GtkIconView* icon_view, GtkTreePath** [path], \
+GtkCellRenderer** [cell])"
+ GtkTreePath* ref_path = NULL;
+ GtkCellRenderer* ref_cell = NULL;
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_cursor", "GtkIconView*");
{
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- gtk_clipboard_request_targets(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkClipboardTargetsReceivedFunc(func), XEN_TO_C_lambda_data(func_info));
- xm_unprotect_at(loc);
- return(XEN_FALSE);
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_icon_view_get_cursor(Xen_to_C_GtkIconView_(icon_view), &ref_path, &ref_cell));
+ return(Xen_list_3(result, C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkCellRenderer_(ref_cell)));
}
}
-static XEN gxg_gtk_clipboard_wait_for_targets(XEN clipboard, XEN ignore_targets, XEN ignore_n_targets)
+static Xen gxg_gtk_icon_view_scroll_to_path(Xen icon_view, Xen path, Xen use_align, Xen row_align, Xen col_align)
{
- #define H_gtk_clipboard_wait_for_targets "gboolean gtk_clipboard_wait_for_targets(GtkClipboard* clipboard, \
-GdkAtom** [targets], gint* [n_targets])"
- GdkAtom* ref_targets = NULL;
- gint ref_n_targets;
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_for_targets", "GtkClipboard*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_clipboard_wait_for_targets(XEN_TO_C_GtkClipboard_(clipboard), &ref_targets, &ref_n_targets));
- return(XEN_LIST_3(result, C_TO_XEN_GdkAtom_(ref_targets), C_TO_XEN_gint(ref_n_targets)));
- }
+ #define H_gtk_icon_view_scroll_to_path "void gtk_icon_view_scroll_to_path(GtkIconView* icon_view, GtkTreePath* path, \
+gboolean use_align, gfloat row_align, gfloat col_align)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_scroll_to_path", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_scroll_to_path", "GtkTreePath*");
+ Xen_check_type(Xen_is_gboolean(use_align), use_align, 3, "gtk_icon_view_scroll_to_path", "gboolean");
+ Xen_check_type(Xen_is_gfloat(row_align), row_align, 4, "gtk_icon_view_scroll_to_path", "gfloat");
+ Xen_check_type(Xen_is_gfloat(col_align), col_align, 5, "gtk_icon_view_scroll_to_path", "gfloat");
+ gtk_icon_view_scroll_to_path(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_gboolean(use_align),
+ Xen_to_C_gfloat(row_align), Xen_to_C_gfloat(col_align));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_shell_cancel(XEN menu_shell)
+static Xen gxg_gtk_icon_view_enable_model_drag_source(Xen icon_view, Xen start_button_mask, Xen targets, Xen n_targets, Xen actions)
{
- #define H_gtk_menu_shell_cancel "void gtk_menu_shell_cancel(GtkMenuShell* menu_shell)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_cancel", "GtkMenuShell*");
- gtk_menu_shell_cancel(XEN_TO_C_GtkMenuShell_(menu_shell));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_enable_model_drag_source "void gtk_icon_view_enable_model_drag_source(GtkIconView* icon_view, \
+GdkModifierType start_button_mask, GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_enable_model_drag_source", "GtkIconView*");
+ Xen_check_type(Xen_is_GdkModifierType(start_button_mask), start_button_mask, 2, "gtk_icon_view_enable_model_drag_source", "GdkModifierType");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 3, "gtk_icon_view_enable_model_drag_source", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 4, "gtk_icon_view_enable_model_drag_source", "gint");
+ Xen_check_type(Xen_is_GdkDragAction(actions), actions, 5, "gtk_icon_view_enable_model_drag_source", "GdkDragAction");
+ gtk_icon_view_enable_model_drag_source(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GdkModifierType(start_button_mask), Xen_to_C_GtkTargetEntry_(targets),
+ Xen_to_C_gint(n_targets), Xen_to_C_GdkDragAction(actions));
+ return(Xen_false);
}
-static XEN gxg_gtk_paned_get_child1(XEN paned)
+static Xen gxg_gtk_icon_view_enable_model_drag_dest(Xen icon_view, Xen targets, Xen n_targets, Xen actions)
{
- #define H_gtk_paned_get_child1 "GtkWidget* gtk_paned_get_child1(GtkPaned* paned)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_get_child1", "GtkPaned*");
- return(C_TO_XEN_GtkWidget_(gtk_paned_get_child1(XEN_TO_C_GtkPaned_(paned))));
+ #define H_gtk_icon_view_enable_model_drag_dest "void gtk_icon_view_enable_model_drag_dest(GtkIconView* icon_view, \
+GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_enable_model_drag_dest", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 2, "gtk_icon_view_enable_model_drag_dest", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 3, "gtk_icon_view_enable_model_drag_dest", "gint");
+ Xen_check_type(Xen_is_GdkDragAction(actions), actions, 4, "gtk_icon_view_enable_model_drag_dest", "GdkDragAction");
+ gtk_icon_view_enable_model_drag_dest(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTargetEntry_(targets), Xen_to_C_gint(n_targets),
+ Xen_to_C_GdkDragAction(actions));
+ return(Xen_false);
}
-static XEN gxg_gtk_paned_get_child2(XEN paned)
+static Xen gxg_gtk_icon_view_unset_model_drag_source(Xen icon_view)
{
- #define H_gtk_paned_get_child2 "GtkWidget* gtk_paned_get_child2(GtkPaned* paned)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_get_child2", "GtkPaned*");
- return(C_TO_XEN_GtkWidget_(gtk_paned_get_child2(XEN_TO_C_GtkPaned_(paned))));
+ #define H_gtk_icon_view_unset_model_drag_source "void gtk_icon_view_unset_model_drag_source(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_unset_model_drag_source", "GtkIconView*");
+ gtk_icon_view_unset_model_drag_source(Xen_to_C_GtkIconView_(icon_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_action_new(XEN name, XEN label, XEN tooltip, XEN stock_id, XEN value)
+static Xen gxg_gtk_icon_view_unset_model_drag_dest(Xen icon_view)
{
- #define H_gtk_radio_action_new "GtkRadioAction* gtk_radio_action_new(gchar* name, gchar* label, gchar* tooltip, \
-gchar* stock_id, gint value)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_radio_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(tooltip), tooltip, 3, "gtk_radio_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 4, "gtk_radio_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(value), value, 5, "gtk_radio_action_new", "gint");
- return(C_TO_XEN_GtkRadioAction_(gtk_radio_action_new(XEN_TO_C_gchar_(name), XEN_TO_C_gchar_(label), XEN_TO_C_gchar_(tooltip),
- XEN_TO_C_gchar_(stock_id), XEN_TO_C_gint(value))));
+ #define H_gtk_icon_view_unset_model_drag_dest "void gtk_icon_view_unset_model_drag_dest(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_unset_model_drag_dest", "GtkIconView*");
+ gtk_icon_view_unset_model_drag_dest(Xen_to_C_GtkIconView_(icon_view));
+ return(Xen_false);
}
-static XEN gxg_gtk_toggle_action_new(XEN name, XEN label, XEN tooltip, XEN stock_id)
+static Xen gxg_gtk_icon_view_set_reorderable(Xen icon_view, Xen reorderable)
{
- #define H_gtk_toggle_action_new "GtkToggleAction* gtk_toggle_action_new(gchar* name, gchar* label, \
-gchar* tooltip, gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_toggle_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_toggle_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(tooltip), tooltip, 3, "gtk_toggle_action_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 4, "gtk_toggle_action_new", "gchar*");
- return(C_TO_XEN_GtkToggleAction_(gtk_toggle_action_new(XEN_TO_C_gchar_(name), XEN_TO_C_gchar_(label), XEN_TO_C_gchar_(tooltip),
- XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_icon_view_set_reorderable "void gtk_icon_view_set_reorderable(GtkIconView* icon_view, \
+gboolean reorderable)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_reorderable", "GtkIconView*");
+ Xen_check_type(Xen_is_gboolean(reorderable), reorderable, 2, "gtk_icon_view_set_reorderable", "gboolean");
+ gtk_icon_view_set_reorderable(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gboolean(reorderable));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_accept_focus(XEN window, XEN setting)
+static Xen gxg_gtk_icon_view_get_reorderable(Xen icon_view)
{
- #define H_gtk_window_set_accept_focus "void gtk_window_set_accept_focus(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_accept_focus", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_accept_focus", "gboolean");
- gtk_window_set_accept_focus(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_get_reorderable "gboolean gtk_icon_view_get_reorderable(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_reorderable", "GtkIconView*");
+ return(C_to_Xen_gboolean(gtk_icon_view_get_reorderable(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_window_get_accept_focus(XEN window)
+static Xen gxg_gtk_icon_view_set_drag_dest_item(Xen icon_view, Xen path, Xen pos)
{
- #define H_gtk_window_get_accept_focus "gboolean gtk_window_get_accept_focus(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_accept_focus", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_accept_focus(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_icon_view_set_drag_dest_item "void gtk_icon_view_set_drag_dest_item(GtkIconView* icon_view, \
+GtkTreePath* path, GtkIconViewDropPosition pos)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_drag_dest_item", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_set_drag_dest_item", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkIconViewDropPosition(pos), pos, 3, "gtk_icon_view_set_drag_dest_item", "GtkIconViewDropPosition");
+ gtk_icon_view_set_drag_dest_item(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkIconViewDropPosition(pos));
+ return(Xen_false);
}
-static XEN gxg_g_list_nth_data(XEN list, XEN n)
+static Xen gxg_gtk_icon_view_get_drag_dest_item(Xen icon_view, Xen ignore_path, Xen ignore_pos)
{
- #define H_g_list_nth_data "gpointer g_list_nth_data(GList* list, guint n)"
- XEN_ASSERT_TYPE(XEN_GList__P(list), list, 1, "g_list_nth_data", "GList*");
- XEN_ASSERT_TYPE(XEN_guint_P(n), n, 2, "g_list_nth_data", "guint");
- return(C_TO_XEN_gpointer(g_list_nth_data(XEN_TO_C_GList_(list), XEN_TO_C_guint(n))));
+ #define H_gtk_icon_view_get_drag_dest_item "void gtk_icon_view_get_drag_dest_item(GtkIconView* icon_view, \
+GtkTreePath** [path], GtkIconViewDropPosition* [pos])"
+ GtkTreePath* ref_path = NULL;
+ GtkIconViewDropPosition ref_pos;
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_drag_dest_item", "GtkIconView*");
+ gtk_icon_view_get_drag_dest_item(Xen_to_C_GtkIconView_(icon_view), &ref_path, &ref_pos);
+ return(Xen_list_2(C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkIconViewDropPosition(ref_pos)));
}
-static XEN gxg_gtk_accel_map_get(void)
+static Xen gxg_gtk_icon_view_get_dest_item_at_pos(Xen icon_view, Xen drag_x, Xen drag_y, Xen ignore_path, Xen ignore_pos)
{
- #define H_gtk_accel_map_get "GtkAccelMap* gtk_accel_map_get( void)"
- return(C_TO_XEN_GtkAccelMap_(gtk_accel_map_get()));
+ #define H_gtk_icon_view_get_dest_item_at_pos "gboolean gtk_icon_view_get_dest_item_at_pos(GtkIconView* icon_view, \
+gint drag_x, gint drag_y, GtkTreePath** [path], GtkIconViewDropPosition* [pos])"
+ GtkTreePath* ref_path = NULL;
+ GtkIconViewDropPosition ref_pos;
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_dest_item_at_pos", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(drag_x), drag_x, 2, "gtk_icon_view_get_dest_item_at_pos", "gint");
+ Xen_check_type(Xen_is_gint(drag_y), drag_y, 3, "gtk_icon_view_get_dest_item_at_pos", "gint");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_icon_view_get_dest_item_at_pos(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(drag_x),
+ Xen_to_C_gint(drag_y), &ref_path, &ref_pos));
+ return(Xen_list_3(result, C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkIconViewDropPosition(ref_pos)));
+ }
}
-static XEN gxg_gtk_combo_box_popup(XEN combo_box)
+static Xen gxg_gtk_image_clear(Xen image)
{
- #define H_gtk_combo_box_popup "void gtk_combo_box_popup(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_popup", "GtkComboBox*");
- gtk_combo_box_popup(XEN_TO_C_GtkComboBox_(combo_box));
- return(XEN_FALSE);
+ #define H_gtk_image_clear "void gtk_image_clear(GtkImage* image)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_clear", "GtkImage*");
+ gtk_image_clear(Xen_to_C_GtkImage_(image));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_popdown(XEN combo_box)
+static Xen gxg_gtk_menu_bar_get_pack_direction(Xen menubar)
{
- #define H_gtk_combo_box_popdown "void gtk_combo_box_popdown(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_popdown", "GtkComboBox*");
- gtk_combo_box_popdown(XEN_TO_C_GtkComboBox_(combo_box));
- return(XEN_FALSE);
+ #define H_gtk_menu_bar_get_pack_direction "GtkPackDirection gtk_menu_bar_get_pack_direction(GtkMenuBar* menubar)"
+ Xen_check_type(Xen_is_GtkMenuBar_(menubar), menubar, 1, "gtk_menu_bar_get_pack_direction", "GtkMenuBar*");
+ return(C_to_Xen_GtkPackDirection(gtk_menu_bar_get_pack_direction(Xen_to_C_GtkMenuBar_(menubar))));
}
-static XEN gxg_gtk_radio_menu_item_new_from_widget(XEN group)
+static Xen gxg_gtk_menu_bar_set_pack_direction(Xen menubar, Xen pack_dir)
{
- #define H_gtk_radio_menu_item_new_from_widget "GtkWidget* gtk_radio_menu_item_new_from_widget(GtkRadioMenuItem* group)"
- XEN_ASSERT_TYPE(XEN_GtkRadioMenuItem__P(group), group, 1, "gtk_radio_menu_item_new_from_widget", "GtkRadioMenuItem*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_menu_item_new_from_widget(XEN_TO_C_GtkRadioMenuItem_(group))));
+ #define H_gtk_menu_bar_set_pack_direction "void gtk_menu_bar_set_pack_direction(GtkMenuBar* menubar, \
+GtkPackDirection pack_dir)"
+ Xen_check_type(Xen_is_GtkMenuBar_(menubar), menubar, 1, "gtk_menu_bar_set_pack_direction", "GtkMenuBar*");
+ Xen_check_type(Xen_is_GtkPackDirection(pack_dir), pack_dir, 2, "gtk_menu_bar_set_pack_direction", "GtkPackDirection");
+ gtk_menu_bar_set_pack_direction(Xen_to_C_GtkMenuBar_(menubar), Xen_to_C_GtkPackDirection(pack_dir));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget(XEN group, XEN label)
+static Xen gxg_gtk_menu_bar_get_child_pack_direction(Xen menubar)
{
- #define H_gtk_radio_menu_item_new_with_mnemonic_from_widget "GtkWidget* gtk_radio_menu_item_new_with_mnemonic_from_widget(GtkRadioMenuItem* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkRadioMenuItem__P(group), group, 1, "gtk_radio_menu_item_new_with_mnemonic_from_widget", "GtkRadioMenuItem*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_menu_item_new_with_mnemonic_from_widget", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_menu_item_new_with_mnemonic_from_widget(XEN_TO_C_GtkRadioMenuItem_(group), XEN_TO_C_gchar_(label))));
+ #define H_gtk_menu_bar_get_child_pack_direction "GtkPackDirection gtk_menu_bar_get_child_pack_direction(GtkMenuBar* menubar)"
+ Xen_check_type(Xen_is_GtkMenuBar_(menubar), menubar, 1, "gtk_menu_bar_get_child_pack_direction", "GtkMenuBar*");
+ return(C_to_Xen_GtkPackDirection(gtk_menu_bar_get_child_pack_direction(Xen_to_C_GtkMenuBar_(menubar))));
}
-static XEN gxg_gtk_radio_menu_item_new_with_label_from_widget(XEN group, XEN label)
+static Xen gxg_gtk_menu_bar_set_child_pack_direction(Xen menubar, Xen child_pack_dir)
{
- #define H_gtk_radio_menu_item_new_with_label_from_widget "GtkWidget* gtk_radio_menu_item_new_with_label_from_widget(GtkRadioMenuItem* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkRadioMenuItem__P(group), group, 1, "gtk_radio_menu_item_new_with_label_from_widget", "GtkRadioMenuItem*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_radio_menu_item_new_with_label_from_widget", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_radio_menu_item_new_with_label_from_widget(XEN_TO_C_GtkRadioMenuItem_(group), XEN_TO_C_gchar_(label))));
+ #define H_gtk_menu_bar_set_child_pack_direction "void gtk_menu_bar_set_child_pack_direction(GtkMenuBar* menubar, \
+GtkPackDirection child_pack_dir)"
+ Xen_check_type(Xen_is_GtkMenuBar_(menubar), menubar, 1, "gtk_menu_bar_set_child_pack_direction", "GtkMenuBar*");
+ Xen_check_type(Xen_is_GtkPackDirection(child_pack_dir), child_pack_dir, 2, "gtk_menu_bar_set_child_pack_direction", "GtkPackDirection");
+ gtk_menu_bar_set_child_pack_direction(Xen_to_C_GtkMenuBar_(menubar), Xen_to_C_GtkPackDirection(child_pack_dir));
+ return(Xen_false);
}
-static XEN gxg_gtk_scale_get_layout(XEN scale)
+static Xen gxg_gtk_menu_shell_get_take_focus(Xen menu_shell)
{
- #define H_gtk_scale_get_layout "PangoLayout* gtk_scale_get_layout(GtkScale* scale)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_get_layout", "GtkScale*");
- return(C_TO_XEN_PangoLayout_(gtk_scale_get_layout(XEN_TO_C_GtkScale_(scale))));
+ #define H_gtk_menu_shell_get_take_focus "gboolean gtk_menu_shell_get_take_focus(GtkMenuShell* menu_shell)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_get_take_focus", "GtkMenuShell*");
+ return(C_to_Xen_gboolean(gtk_menu_shell_get_take_focus(Xen_to_C_GtkMenuShell_(menu_shell))));
}
-static XEN gxg_gtk_scale_get_layout_offsets(XEN scale, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gtk_menu_shell_set_take_focus(Xen menu_shell, Xen take_focus)
{
- #define H_gtk_scale_get_layout_offsets "void gtk_scale_get_layout_offsets(GtkScale* scale, gint* [x], \
-gint* [y])"
- gint ref_x;
- gint ref_y;
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_get_layout_offsets", "GtkScale*");
- gtk_scale_get_layout_offsets(XEN_TO_C_GtkScale_(scale), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y)));
+ #define H_gtk_menu_shell_set_take_focus "void gtk_menu_shell_set_take_focus(GtkMenuShell* menu_shell, \
+gboolean take_focus)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_set_take_focus", "GtkMenuShell*");
+ Xen_check_type(Xen_is_gboolean(take_focus), take_focus, 2, "gtk_menu_shell_set_take_focus", "gboolean");
+ gtk_menu_shell_set_take_focus(Xen_to_C_GtkMenuShell_(menu_shell), Xen_to_C_gboolean(take_focus));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_source_get_target_list(XEN widget)
+static Xen gxg_gtk_size_group_set_ignore_hidden(Xen size_group, Xen ignore_hidden)
{
- #define H_gtk_drag_source_get_target_list "GtkTargetList* gtk_drag_source_get_target_list(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_get_target_list", "GtkWidget*");
- return(C_TO_XEN_GtkTargetList_(gtk_drag_source_get_target_list(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_size_group_set_ignore_hidden "void gtk_size_group_set_ignore_hidden(GtkSizeGroup* size_group, \
+gboolean ignore_hidden)"
+ Xen_check_type(Xen_is_GtkSizeGroup_(size_group), size_group, 1, "gtk_size_group_set_ignore_hidden", "GtkSizeGroup*");
+ Xen_check_type(Xen_is_gboolean(ignore_hidden), ignore_hidden, 2, "gtk_size_group_set_ignore_hidden", "gboolean");
+ gtk_size_group_set_ignore_hidden(Xen_to_C_GtkSizeGroup_(size_group), Xen_to_C_gboolean(ignore_hidden));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_source_set_target_list(XEN widget, XEN target_list)
+static Xen gxg_gtk_size_group_get_ignore_hidden(Xen size_group)
{
- #define H_gtk_drag_source_set_target_list "void gtk_drag_source_set_target_list(GtkWidget* widget, \
-GtkTargetList* target_list)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_set_target_list", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(target_list) || XEN_FALSE_P(target_list), target_list, 2, "gtk_drag_source_set_target_list", "GtkTargetList*");
- gtk_drag_source_set_target_list(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkTargetList_(target_list));
- return(XEN_FALSE);
+ #define H_gtk_size_group_get_ignore_hidden "gboolean gtk_size_group_get_ignore_hidden(GtkSizeGroup* size_group)"
+ Xen_check_type(Xen_is_GtkSizeGroup_(size_group), size_group, 1, "gtk_size_group_get_ignore_hidden", "GtkSizeGroup*");
+ return(C_to_Xen_gboolean(gtk_size_group_get_ignore_hidden(Xen_to_C_GtkSizeGroup_(size_group))));
}
-static XEN gxg_gtk_entry_set_alignment(XEN entry, XEN xalign)
+static Xen gxg_gtk_text_iter_forward_visible_line(Xen iter)
{
- #define H_gtk_entry_set_alignment "void gtk_entry_set_alignment(GtkEntry* entry, gfloat xalign)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_alignment", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_entry_set_alignment", "gfloat");
- gtk_entry_set_alignment(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gfloat(xalign));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_visible_line "gboolean gtk_text_iter_forward_visible_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_visible_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_visible_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_entry_get_alignment(XEN entry)
+static Xen gxg_gtk_text_iter_backward_visible_line(Xen iter)
{
- #define H_gtk_entry_get_alignment "gfloat gtk_entry_get_alignment(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_alignment", "GtkEntry*");
- return(C_TO_XEN_gfloat(gtk_entry_get_alignment(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gtk_text_iter_backward_visible_line "gboolean gtk_text_iter_backward_visible_line(GtkTextIter* iter)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_visible_line", "GtkTextIter*");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_visible_line(Xen_to_C_GtkTextIter_(iter))));
}
-static XEN gxg_gtk_file_chooser_set_use_preview_label(XEN chooser, XEN use_label)
+static Xen gxg_gtk_text_iter_forward_visible_lines(Xen iter, Xen count)
{
- #define H_gtk_file_chooser_set_use_preview_label "void gtk_file_chooser_set_use_preview_label(GtkFileChooser* chooser, \
-gboolean use_label)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_use_preview_label", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_label), use_label, 2, "gtk_file_chooser_set_use_preview_label", "gboolean");
- gtk_file_chooser_set_use_preview_label(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gboolean(use_label));
- return(XEN_FALSE);
+ #define H_gtk_text_iter_forward_visible_lines "gboolean gtk_text_iter_forward_visible_lines(GtkTextIter* iter, \
+gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_forward_visible_lines", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_forward_visible_lines", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_forward_visible_lines(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_file_chooser_get_use_preview_label(XEN chooser)
+static Xen gxg_gtk_text_iter_backward_visible_lines(Xen iter, Xen count)
{
- #define H_gtk_file_chooser_get_use_preview_label "gboolean gtk_file_chooser_get_use_preview_label(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_use_preview_label", "GtkFileChooser*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_get_use_preview_label(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_text_iter_backward_visible_lines "gboolean gtk_text_iter_backward_visible_lines(GtkTextIter* iter, \
+gint count)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_backward_visible_lines", "GtkTextIter*");
+ Xen_check_type(Xen_is_gint(count), count, 2, "gtk_text_iter_backward_visible_lines", "gint");
+ return(C_to_Xen_gboolean(gtk_text_iter_backward_visible_lines(Xen_to_C_GtkTextIter_(iter), Xen_to_C_gint(count))));
}
-static XEN gxg_gtk_widget_list_mnemonic_labels(XEN widget)
+static Xen gxg_gtk_tool_button_set_icon_name(Xen button, Xen icon_name)
{
- #define H_gtk_widget_list_mnemonic_labels "GList* gtk_widget_list_mnemonic_labels(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_list_mnemonic_labels", "GtkWidget*");
- return(C_TO_XEN_GList_(gtk_widget_list_mnemonic_labels(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_tool_button_set_icon_name "void gtk_tool_button_set_icon_name(GtkToolButton* button, \
+gchar* icon_name)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_set_icon_name", "GtkToolButton*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_tool_button_set_icon_name", "gchar*");
+ gtk_tool_button_set_icon_name(Xen_to_C_GtkToolButton_(button), (const gchar*)Xen_to_C_gchar_(icon_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_add_mnemonic_label(XEN widget, XEN label)
+static Xen gxg_gtk_tool_button_get_icon_name(Xen button)
{
- #define H_gtk_widget_add_mnemonic_label "void gtk_widget_add_mnemonic_label(GtkWidget* widget, GtkWidget* label)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_add_mnemonic_label", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(label), label, 2, "gtk_widget_add_mnemonic_label", "GtkWidget*");
- gtk_widget_add_mnemonic_label(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkWidget_(label));
- return(XEN_FALSE);
+ #define H_gtk_tool_button_get_icon_name "gchar* gtk_tool_button_get_icon_name(GtkToolButton* button)"
+ Xen_check_type(Xen_is_GtkToolButton_(button), button, 1, "gtk_tool_button_get_icon_name", "GtkToolButton*");
+ return(C_to_Xen_gchar_((gchar*)gtk_tool_button_get_icon_name(Xen_to_C_GtkToolButton_(button))));
}
-static XEN gxg_gtk_widget_remove_mnemonic_label(XEN widget, XEN label)
+static Xen gxg_gtk_window_set_urgency_hint(Xen window, Xen setting)
{
- #define H_gtk_widget_remove_mnemonic_label "void gtk_widget_remove_mnemonic_label(GtkWidget* widget, \
-GtkWidget* label)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_remove_mnemonic_label", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(label), label, 2, "gtk_widget_remove_mnemonic_label", "GtkWidget*");
- gtk_widget_remove_mnemonic_label(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkWidget_(label));
- return(XEN_FALSE);
+ #define H_gtk_window_set_urgency_hint "void gtk_window_set_urgency_hint(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_urgency_hint", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_urgency_hint", "gboolean");
+ gtk_window_set_urgency_hint(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_activate_key(XEN window, XEN event)
+static Xen gxg_gtk_window_get_urgency_hint(Xen window)
{
- #define H_gtk_window_activate_key "gboolean gtk_window_activate_key(GtkWindow* window, GdkEventKey* event)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_activate_key", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkEventKey__P(event), event, 2, "gtk_window_activate_key", "GdkEventKey*");
- return(C_TO_XEN_gboolean(gtk_window_activate_key(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkEventKey_(event))));
+ #define H_gtk_window_get_urgency_hint "gboolean gtk_window_get_urgency_hint(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_urgency_hint", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_urgency_hint(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_window_propagate_key_event(XEN window, XEN event)
+static Xen gxg_gtk_window_present_with_time(Xen window, Xen timestamp)
{
- #define H_gtk_window_propagate_key_event "gboolean gtk_window_propagate_key_event(GtkWindow* window, \
-GdkEventKey* event)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_propagate_key_event", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkEventKey__P(event), event, 2, "gtk_window_propagate_key_event", "GdkEventKey*");
- return(C_TO_XEN_gboolean(gtk_window_propagate_key_event(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkEventKey_(event))));
+ #define H_gtk_window_present_with_time "void gtk_window_present_with_time(GtkWindow* window, guint32 timestamp)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_present_with_time", "GtkWindow*");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 2, "gtk_window_present_with_time", "guint32");
+ gtk_window_present_with_time(Xen_to_C_GtkWindow_(window), Xen_to_C_guint32(timestamp));
+ return(Xen_false);
}
-static XEN gxg_g_quark_from_string(XEN string)
+static Xen gxg_gtk_file_chooser_set_do_overwrite_confirmation(Xen chooser, Xen do_overwrite_confirmation)
{
- #define H_g_quark_from_string "GQuark g_quark_from_string(gchar* string)"
- XEN_ASSERT_TYPE(XEN_gchar__P(string), string, 1, "g_quark_from_string", "gchar*");
- return(C_TO_XEN_GQuark(g_quark_from_string(XEN_TO_C_gchar_(string))));
+ #define H_gtk_file_chooser_set_do_overwrite_confirmation "void gtk_file_chooser_set_do_overwrite_confirmation(GtkFileChooser* chooser, \
+gboolean do_overwrite_confirmation)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_do_overwrite_confirmation", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gboolean(do_overwrite_confirmation), do_overwrite_confirmation, 2, "gtk_file_chooser_set_do_overwrite_confirmation", "gboolean");
+ gtk_file_chooser_set_do_overwrite_confirmation(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gboolean(do_overwrite_confirmation));
+ return(Xen_false);
}
-static XEN gxg_g_quark_to_string(XEN quark)
+static Xen gxg_gtk_file_chooser_get_do_overwrite_confirmation(Xen chooser)
{
- #define H_g_quark_to_string "gchar* g_quark_to_string(GQuark quark)"
- XEN_ASSERT_TYPE(XEN_GQuark_P(quark), quark, 1, "g_quark_to_string", "GQuark");
- return(C_TO_XEN_gchar_(g_quark_to_string(XEN_TO_C_GQuark(quark))));
+ #define H_gtk_file_chooser_get_do_overwrite_confirmation "gboolean gtk_file_chooser_get_do_overwrite_confirmation(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_do_overwrite_confirmation", "GtkFileChooser*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_get_do_overwrite_confirmation(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_cell_view_new(void)
+static Xen gxg_gtk_tree_row_reference_get_model(Xen reference)
{
- #define H_gtk_cell_view_new "GtkWidget* gtk_cell_view_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_cell_view_new()));
+ #define H_gtk_tree_row_reference_get_model "GtkTreeModel* gtk_tree_row_reference_get_model(GtkTreeRowReference* reference)"
+ Xen_check_type(Xen_is_GtkTreeRowReference_(reference), reference, 1, "gtk_tree_row_reference_get_model", "GtkTreeRowReference*");
+ return(C_to_Xen_GtkTreeModel_(gtk_tree_row_reference_get_model(Xen_to_C_GtkTreeRowReference_(reference))));
}
-static XEN gxg_gtk_cell_view_new_with_text(XEN text)
+static Xen gxg_gtk_tree_view_column_queue_resize(Xen tree_column)
{
- #define H_gtk_cell_view_new_with_text "GtkWidget* gtk_cell_view_new_with_text(gchar* text)"
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 1, "gtk_cell_view_new_with_text", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_cell_view_new_with_text(XEN_TO_C_gchar_(text))));
+ #define H_gtk_tree_view_column_queue_resize "void gtk_tree_view_column_queue_resize(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_queue_resize", "GtkTreeViewColumn*");
+ gtk_tree_view_column_queue_resize(Xen_to_C_GtkTreeViewColumn_(tree_column));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_view_new_with_markup(XEN markup)
+static Xen gxg_gtk_tree_view_get_visible_range(Xen tree_view, Xen ignore_start_path, Xen ignore_end_path)
{
- #define H_gtk_cell_view_new_with_markup "GtkWidget* gtk_cell_view_new_with_markup(gchar* markup)"
- XEN_ASSERT_TYPE(XEN_gchar__P(markup), markup, 1, "gtk_cell_view_new_with_markup", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_cell_view_new_with_markup(XEN_TO_C_gchar_(markup))));
+ #define H_gtk_tree_view_get_visible_range "gboolean gtk_tree_view_get_visible_range(GtkTreeView* tree_view, \
+GtkTreePath** [start_path], GtkTreePath** [end_path])"
+ GtkTreePath* ref_start_path = NULL;
+ GtkTreePath* ref_end_path = NULL;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_visible_range", "GtkTreeView*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_tree_view_get_visible_range(Xen_to_C_GtkTreeView_(tree_view), &ref_start_path, &ref_end_path));
+ return(Xen_list_3(result, C_to_Xen_GtkTreePath_(ref_start_path), C_to_Xen_GtkTreePath_(ref_end_path)));
+ }
}
-static XEN gxg_gtk_cell_view_new_with_pixbuf(XEN pixbuf)
+static Xen gxg_gtk_text_attributes_ref(Xen values)
{
- #define H_gtk_cell_view_new_with_pixbuf "GtkWidget* gtk_cell_view_new_with_pixbuf(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gtk_cell_view_new_with_pixbuf", "GdkPixbuf*");
- return(C_TO_XEN_GtkWidget_(gtk_cell_view_new_with_pixbuf(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ #define H_gtk_text_attributes_ref "GtkTextAttributes* gtk_text_attributes_ref(GtkTextAttributes* values)"
+ Xen_check_type(Xen_is_GtkTextAttributes_(values), values, 1, "gtk_text_attributes_ref", "GtkTextAttributes*");
+ return(C_to_Xen_GtkTextAttributes_(gtk_text_attributes_ref(Xen_to_C_GtkTextAttributes_(values))));
}
-static XEN gxg_gtk_cell_view_set_model(XEN cell_view, XEN model)
+static Xen gxg_pango_attr_list_ref(Xen list)
{
- #define H_gtk_cell_view_set_model "void gtk_cell_view_set_model(GtkCellView* cell_view, GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_set_model", "GtkCellView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model) || XEN_FALSE_P(model), model, 2, "gtk_cell_view_set_model", "GtkTreeModel*");
- gtk_cell_view_set_model(XEN_TO_C_GtkCellView_(cell_view), XEN_TO_C_GtkTreeModel_(model));
- return(XEN_FALSE);
+ #define H_pango_attr_list_ref "PangoAttrList* pango_attr_list_ref(PangoAttrList* list)"
+ Xen_check_type(Xen_is_PangoAttrList_(list), list, 1, "pango_attr_list_ref", "PangoAttrList*");
+ return(C_to_Xen_PangoAttrList_(pango_attr_list_ref(Xen_to_C_PangoAttrList_(list))));
}
-static XEN gxg_gtk_cell_view_set_displayed_row(XEN cell_view, XEN path)
+static Xen gxg_pango_layout_line_ref(Xen line)
{
- #define H_gtk_cell_view_set_displayed_row "void gtk_cell_view_set_displayed_row(GtkCellView* cell_view, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_set_displayed_row", "GtkCellView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_cell_view_set_displayed_row", "GtkTreePath*");
- gtk_cell_view_set_displayed_row(XEN_TO_C_GtkCellView_(cell_view), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_pango_layout_line_ref "PangoLayoutLine* pango_layout_line_ref(PangoLayoutLine* line)"
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 1, "pango_layout_line_ref", "PangoLayoutLine*");
+ return(C_to_Xen_PangoLayoutLine_(pango_layout_line_ref(Xen_to_C_PangoLayoutLine_(line))));
}
-static XEN gxg_gtk_cell_view_get_displayed_row(XEN cell_view)
+static Xen gxg_pango_layout_index_to_line_x(Xen layout, Xen index_, Xen trailing, Xen ignore_line, Xen ignore_x_pos)
{
- #define H_gtk_cell_view_get_displayed_row "GtkTreePath* gtk_cell_view_get_displayed_row(GtkCellView* cell_view)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_get_displayed_row", "GtkCellView*");
- return(C_TO_XEN_GtkTreePath_(gtk_cell_view_get_displayed_row(XEN_TO_C_GtkCellView_(cell_view))));
+ #define H_pango_layout_index_to_line_x "void pango_layout_index_to_line_x(PangoLayout* layout, int index_, \
+gboolean trailing, int* [line], int* [x_pos])"
+ int ref_line;
+ int ref_x_pos;
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "pango_layout_index_to_line_x", "PangoLayout*");
+ Xen_check_type(Xen_is_int(index_), index_, 2, "pango_layout_index_to_line_x", "int");
+ Xen_check_type(Xen_is_gboolean(trailing), trailing, 3, "pango_layout_index_to_line_x", "gboolean");
+ pango_layout_index_to_line_x(Xen_to_C_PangoLayout_(layout), Xen_to_C_int(index_), Xen_to_C_gboolean(trailing), &ref_line,
+ &ref_x_pos);
+ return(Xen_list_2(C_to_Xen_int(ref_line), C_to_Xen_int(ref_x_pos)));
}
-static XEN gxg_gtk_cell_view_set_background_color(XEN cell_view, XEN color)
+static Xen gxg_gtk_target_list_ref(Xen list)
{
- #define H_gtk_cell_view_set_background_color "void gtk_cell_view_set_background_color(GtkCellView* cell_view, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_set_background_color", "GtkCellView*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gtk_cell_view_set_background_color", "GdkColor*");
- gtk_cell_view_set_background_color(XEN_TO_C_GtkCellView_(cell_view), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_target_list_ref "GtkTargetList* gtk_target_list_ref(GtkTargetList* list)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_ref", "GtkTargetList*");
+ return(C_to_Xen_GtkTargetList_(gtk_target_list_ref(Xen_to_C_GtkTargetList_(list))));
}
-static XEN gxg_gdk_window_enable_synchronized_configure(XEN window)
+static Xen gxg_gdk_display_supports_shapes(Xen display)
{
- #define H_gdk_window_enable_synchronized_configure "void gdk_window_enable_synchronized_configure(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_enable_synchronized_configure", "GdkWindow*");
- gdk_window_enable_synchronized_configure(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gdk_display_supports_shapes "gboolean gdk_display_supports_shapes(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_supports_shapes", "GdkDisplay*");
+ return(C_to_Xen_gboolean(gdk_display_supports_shapes(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_gdk_window_configure_finished(XEN window)
+static Xen gxg_gdk_display_supports_input_shapes(Xen display)
{
- #define H_gdk_window_configure_finished "void gdk_window_configure_finished(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_configure_finished", "GdkWindow*");
- gdk_window_configure_finished(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gdk_display_supports_input_shapes "gboolean gdk_display_supports_input_shapes(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_supports_input_shapes", "GdkDisplay*");
+ return(C_to_Xen_gboolean(gdk_display_supports_input_shapes(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_gtk_combo_box_get_wrap_width(XEN combo_box)
+static Xen gxg_gdk_screen_is_composited(Xen screen)
{
- #define H_gtk_combo_box_get_wrap_width "gint gtk_combo_box_get_wrap_width(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_wrap_width", "GtkComboBox*");
- return(C_TO_XEN_gint(gtk_combo_box_get_wrap_width(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gdk_screen_is_composited "gboolean gdk_screen_is_composited(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_is_composited", "GdkScreen*");
+ return(C_to_Xen_gboolean(gdk_screen_is_composited(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_gtk_combo_box_get_row_span_column(XEN combo_box)
+static Xen gxg_gdk_screen_set_resolution(Xen screen, Xen dpi)
{
- #define H_gtk_combo_box_get_row_span_column "gint gtk_combo_box_get_row_span_column(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_row_span_column", "GtkComboBox*");
- return(C_TO_XEN_gint(gtk_combo_box_get_row_span_column(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gdk_screen_set_resolution "void gdk_screen_set_resolution(GdkScreen* screen, gdouble dpi)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_set_resolution", "GdkScreen*");
+ Xen_check_type(Xen_is_gdouble(dpi), dpi, 2, "gdk_screen_set_resolution", "gdouble");
+ gdk_screen_set_resolution(Xen_to_C_GdkScreen_(screen), Xen_to_C_gdouble(dpi));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_get_column_span_column(XEN combo_box)
+static Xen gxg_gdk_screen_get_resolution(Xen screen)
{
- #define H_gtk_combo_box_get_column_span_column "gint gtk_combo_box_get_column_span_column(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_column_span_column", "GtkComboBox*");
- return(C_TO_XEN_gint(gtk_combo_box_get_column_span_column(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gdk_screen_get_resolution "gdouble gdk_screen_get_resolution(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_resolution", "GdkScreen*");
+ return(C_to_Xen_gdouble(gdk_screen_get_resolution(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_gtk_combo_box_get_add_tearoffs(XEN combo_box)
+static Xen gxg_gdk_screen_get_active_window(Xen screen)
{
- #define H_gtk_combo_box_get_add_tearoffs "gboolean gtk_combo_box_get_add_tearoffs(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_add_tearoffs", "GtkComboBox*");
- return(C_TO_XEN_gboolean(gtk_combo_box_get_add_tearoffs(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gdk_screen_get_active_window "GdkWindow* gdk_screen_get_active_window(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_active_window", "GdkScreen*");
+ return(C_to_Xen_GdkWindow_(gdk_screen_get_active_window(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_gtk_combo_box_set_add_tearoffs(XEN combo_box, XEN add_tearoffs)
+static Xen gxg_gdk_screen_get_window_stack(Xen screen)
{
- #define H_gtk_combo_box_set_add_tearoffs "void gtk_combo_box_set_add_tearoffs(GtkComboBox* combo_box, \
-gboolean add_tearoffs)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_add_tearoffs", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(add_tearoffs), add_tearoffs, 2, "gtk_combo_box_set_add_tearoffs", "gboolean");
- gtk_combo_box_set_add_tearoffs(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gboolean(add_tearoffs));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_window_stack "GList* gdk_screen_get_window_stack(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_window_stack", "GdkScreen*");
+ return(C_to_Xen_GList_(gdk_screen_get_window_stack(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_gtk_drag_dest_add_text_targets(XEN widget)
+static Xen gxg_gdk_window_get_type_hint(Xen window)
{
- #define H_gtk_drag_dest_add_text_targets "void gtk_drag_dest_add_text_targets(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_add_text_targets", "GtkWidget*");
- gtk_drag_dest_add_text_targets(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gdk_window_get_type_hint "GdkWindowTypeHint gdk_window_get_type_hint(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_type_hint", "GdkWindow*");
+ return(C_to_Xen_GdkWindowTypeHint(gdk_window_get_type_hint(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_drag_source_add_text_targets(XEN widget)
+static Xen gxg_gtk_clipboard_request_rich_text(Xen clipboard, Xen buffer, Xen func, Xen func_info)
{
- #define H_gtk_drag_source_add_text_targets "void gtk_drag_source_add_text_targets(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_add_text_targets", "GtkWidget*");
- gtk_drag_source_add_text_targets(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_request_rich_text "void gtk_clipboard_request_rich_text(GtkClipboard* clipboard, \
+GtkTextBuffer* buffer, GtkClipboardRichTextReceivedFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_request_rich_text", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 2, "gtk_clipboard_request_rich_text", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkClipboardRichTextReceivedFunc(func), func, 3, "gtk_clipboard_request_rich_text", "GtkClipboardRichTextReceivedFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "gtk_clipboard_request_rich_text", "lambda_data");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ gtk_clipboard_request_rich_text(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkClipboardRichTextReceivedFunc(func),
+ Xen_to_C_lambda_data(func_info));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_entry_completion_insert_prefix(XEN completion)
+static Xen gxg_gtk_clipboard_wait_for_rich_text(Xen clipboard, Xen buffer, Xen format, Xen ignore_length)
{
- #define H_gtk_entry_completion_insert_prefix "void gtk_entry_completion_insert_prefix(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_insert_prefix", "GtkEntryCompletion*");
- gtk_entry_completion_insert_prefix(XEN_TO_C_GtkEntryCompletion_(completion));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_wait_for_rich_text "guint8* gtk_clipboard_wait_for_rich_text(GtkClipboard* clipboard, \
+GtkTextBuffer* buffer, GdkAtom* format, gsize* [length])"
+ gsize ref_length;
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_for_rich_text", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 2, "gtk_clipboard_wait_for_rich_text", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GdkAtom_(format), format, 3, "gtk_clipboard_wait_for_rich_text", "GdkAtom*");
+ {
+ Xen result;
+ result = C_to_Xen_guint8_(gtk_clipboard_wait_for_rich_text(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkTextBuffer_(buffer),
+ Xen_to_C_GdkAtom_(format), &ref_length));
+ return(Xen_list_2(result, C_to_Xen_gsize(ref_length)));
+ }
}
-static XEN gxg_gtk_entry_completion_set_inline_completion(XEN completion, XEN inline_completion)
+static Xen gxg_gtk_clipboard_wait_is_rich_text_available(Xen clipboard, Xen buffer)
{
- #define H_gtk_entry_completion_set_inline_completion "void gtk_entry_completion_set_inline_completion(GtkEntryCompletion* completion, \
-gboolean inline_completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_inline_completion", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(inline_completion), inline_completion, 2, "gtk_entry_completion_set_inline_completion", "gboolean");
- gtk_entry_completion_set_inline_completion(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gboolean(inline_completion));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_wait_is_rich_text_available "gboolean gtk_clipboard_wait_is_rich_text_available(GtkClipboard* clipboard, \
+GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_is_rich_text_available", "GtkClipboard*");
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 2, "gtk_clipboard_wait_is_rich_text_available", "GtkTextBuffer*");
+ return(C_to_Xen_gboolean(gtk_clipboard_wait_is_rich_text_available(Xen_to_C_GtkClipboard_(clipboard), Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_entry_completion_get_inline_completion(XEN completion)
+static Xen gxg_gtk_drag_dest_set_track_motion(Xen widget, Xen track_motion)
{
- #define H_gtk_entry_completion_get_inline_completion "gboolean gtk_entry_completion_get_inline_completion(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_inline_completion", "GtkEntryCompletion*");
- return(C_TO_XEN_gboolean(gtk_entry_completion_get_inline_completion(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gtk_drag_dest_set_track_motion "void gtk_drag_dest_set_track_motion(GtkWidget* widget, gboolean track_motion)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_set_track_motion", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(track_motion), track_motion, 2, "gtk_drag_dest_set_track_motion", "gboolean");
+ gtk_drag_dest_set_track_motion(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(track_motion));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_completion_set_popup_completion(XEN completion, XEN popup_completion)
+static Xen gxg_gtk_drag_dest_get_track_motion(Xen widget)
{
- #define H_gtk_entry_completion_set_popup_completion "void gtk_entry_completion_set_popup_completion(GtkEntryCompletion* completion, \
-gboolean popup_completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_popup_completion", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(popup_completion), popup_completion, 2, "gtk_entry_completion_set_popup_completion", "gboolean");
- gtk_entry_completion_set_popup_completion(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gboolean(popup_completion));
- return(XEN_FALSE);
+ #define H_gtk_drag_dest_get_track_motion "gboolean gtk_drag_dest_get_track_motion(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_dest_get_track_motion", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_drag_dest_get_track_motion(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_entry_completion_get_popup_completion(XEN completion)
+static Xen gxg_gtk_notebook_get_tab_reorderable(Xen notebook, Xen child)
{
- #define H_gtk_entry_completion_get_popup_completion "gboolean gtk_entry_completion_get_popup_completion(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_popup_completion", "GtkEntryCompletion*");
- return(C_TO_XEN_gboolean(gtk_entry_completion_get_popup_completion(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gtk_notebook_get_tab_reorderable "gboolean gtk_notebook_get_tab_reorderable(GtkNotebook* notebook, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_tab_reorderable", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_get_tab_reorderable", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_notebook_get_tab_reorderable(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_gtk_entry_completion_get_text_column(XEN completion)
+static Xen gxg_gtk_notebook_set_tab_reorderable(Xen notebook, Xen child, Xen reorderable)
{
- #define H_gtk_entry_completion_get_text_column "gint gtk_entry_completion_get_text_column(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_text_column", "GtkEntryCompletion*");
- return(C_TO_XEN_gint(gtk_entry_completion_get_text_column(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gtk_notebook_set_tab_reorderable "void gtk_notebook_set_tab_reorderable(GtkNotebook* notebook, \
+GtkWidget* child, gboolean reorderable)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_tab_reorderable", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_set_tab_reorderable", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(reorderable), reorderable, 3, "gtk_notebook_set_tab_reorderable", "gboolean");
+ gtk_notebook_set_tab_reorderable(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(reorderable));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_theme_get_icon_sizes(XEN icon_theme, XEN icon_name)
+static Xen gxg_gtk_notebook_get_tab_detachable(Xen notebook, Xen child)
{
- #define H_gtk_icon_theme_get_icon_sizes "gint* gtk_icon_theme_get_icon_sizes(GtkIconTheme* icon_theme, \
-gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_get_icon_sizes", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_icon_theme_get_icon_sizes", "gchar*");
- return(C_TO_XEN_gint_(gtk_icon_theme_get_icon_sizes(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_gchar_(icon_name))));
+ #define H_gtk_notebook_get_tab_detachable "gboolean gtk_notebook_get_tab_detachable(GtkNotebook* notebook, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_tab_detachable", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_get_tab_detachable", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_notebook_get_tab_detachable(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_gtk_menu_get_for_attach_widget(XEN widget )
+static Xen gxg_gtk_notebook_set_tab_detachable(Xen notebook, Xen child, Xen detachable)
{
- #define H_gtk_menu_get_for_attach_widget "GList* gtk_menu_get_for_attach_widget(GtkWidget* widget, \
-)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget ), widget , 1, "gtk_menu_get_for_attach_widget", "GtkWidget*");
- return(C_TO_XEN_GList_(gtk_menu_get_for_attach_widget(XEN_TO_C_GtkWidget_(widget ))));
+ #define H_gtk_notebook_set_tab_detachable "void gtk_notebook_set_tab_detachable(GtkNotebook* notebook, \
+GtkWidget* child, gboolean detachable)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_tab_detachable", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_set_tab_detachable", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(detachable), detachable, 3, "gtk_notebook_set_tab_detachable", "gboolean");
+ gtk_notebook_set_tab_detachable(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(detachable));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_fixed_height_mode(XEN tree_view, XEN enable)
+static Xen gxg_gtk_range_set_lower_stepper_sensitivity(Xen range, Xen sensitivity)
{
- #define H_gtk_tree_view_set_fixed_height_mode "void gtk_tree_view_set_fixed_height_mode(GtkTreeView* tree_view, \
-gboolean enable)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_fixed_height_mode", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(enable), enable, 2, "gtk_tree_view_set_fixed_height_mode", "gboolean");
- gtk_tree_view_set_fixed_height_mode(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(enable));
- return(XEN_FALSE);
+ #define H_gtk_range_set_lower_stepper_sensitivity "void gtk_range_set_lower_stepper_sensitivity(GtkRange* range, \
+GtkSensitivityType sensitivity)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_lower_stepper_sensitivity", "GtkRange*");
+ Xen_check_type(Xen_is_GtkSensitivityType(sensitivity), sensitivity, 2, "gtk_range_set_lower_stepper_sensitivity", "GtkSensitivityType");
+ gtk_range_set_lower_stepper_sensitivity(Xen_to_C_GtkRange_(range), Xen_to_C_GtkSensitivityType(sensitivity));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_fixed_height_mode(XEN tree_view)
+static Xen gxg_gtk_range_get_lower_stepper_sensitivity(Xen range)
{
- #define H_gtk_tree_view_get_fixed_height_mode "gboolean gtk_tree_view_get_fixed_height_mode(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_fixed_height_mode", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_fixed_height_mode(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_range_get_lower_stepper_sensitivity "GtkSensitivityType gtk_range_get_lower_stepper_sensitivity(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_lower_stepper_sensitivity", "GtkRange*");
+ return(C_to_Xen_GtkSensitivityType(gtk_range_get_lower_stepper_sensitivity(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_tree_view_set_hover_selection(XEN tree_view, XEN hover)
+static Xen gxg_gtk_range_set_upper_stepper_sensitivity(Xen range, Xen sensitivity)
{
- #define H_gtk_tree_view_set_hover_selection "void gtk_tree_view_set_hover_selection(GtkTreeView* tree_view, \
-gboolean hover)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_hover_selection", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(hover), hover, 2, "gtk_tree_view_set_hover_selection", "gboolean");
- gtk_tree_view_set_hover_selection(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(hover));
- return(XEN_FALSE);
+ #define H_gtk_range_set_upper_stepper_sensitivity "void gtk_range_set_upper_stepper_sensitivity(GtkRange* range, \
+GtkSensitivityType sensitivity)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_upper_stepper_sensitivity", "GtkRange*");
+ Xen_check_type(Xen_is_GtkSensitivityType(sensitivity), sensitivity, 2, "gtk_range_set_upper_stepper_sensitivity", "GtkSensitivityType");
+ gtk_range_set_upper_stepper_sensitivity(Xen_to_C_GtkRange_(range), Xen_to_C_GtkSensitivityType(sensitivity));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_hover_selection(XEN tree_view)
+static Xen gxg_gtk_range_get_upper_stepper_sensitivity(Xen range)
{
- #define H_gtk_tree_view_get_hover_selection "gboolean gtk_tree_view_get_hover_selection(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_hover_selection", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_hover_selection(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_range_get_upper_stepper_sensitivity "GtkSensitivityType gtk_range_get_upper_stepper_sensitivity(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_upper_stepper_sensitivity", "GtkRange*");
+ return(C_to_Xen_GtkSensitivityType(gtk_range_get_upper_stepper_sensitivity(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_tree_view_set_row_separator_func(XEN tree_view, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_scrolled_window_unset_placement(Xen scrolled_window)
{
- #define H_gtk_tree_view_set_row_separator_func "void gtk_tree_view_set_row_separator_func(GtkTreeView* tree_view, \
-GtkTreeViewRowSeparatorFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_row_separator_func", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewRowSeparatorFunc_P(func), func, 2, "gtk_tree_view_set_row_separator_func", "GtkTreeViewRowSeparatorFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_view_set_row_separator_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 4, "gtk_tree_view_set_row_separator_func", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_tree_view_set_row_separator_func(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewRowSeparatorFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GtkDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_scrolled_window_unset_placement "void gtk_scrolled_window_unset_placement(GtkScrolledWindow* scrolled_window)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_unset_placement", "GtkScrolledWindow*");
+ gtk_scrolled_window_unset_placement(Xen_to_C_GtkScrolledWindow_(scrolled_window));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_focus_on_map(XEN window, XEN setting)
+static Xen gxg_gtk_target_list_add_rich_text_targets(Xen list, Xen info, Xen deserializable, Xen buffer)
{
- #define H_gtk_window_set_focus_on_map "void gtk_window_set_focus_on_map(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_focus_on_map", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_focus_on_map", "gboolean");
- gtk_window_set_focus_on_map(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_target_list_add_rich_text_targets "void gtk_target_list_add_rich_text_targets(GtkTargetList* list, \
+guint info, gboolean deserializable, GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_list_add_rich_text_targets", "GtkTargetList*");
+ Xen_check_type(Xen_is_guint(info), info, 2, "gtk_target_list_add_rich_text_targets", "guint");
+ Xen_check_type(Xen_is_gboolean(deserializable), deserializable, 3, "gtk_target_list_add_rich_text_targets", "gboolean");
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 4, "gtk_target_list_add_rich_text_targets", "GtkTextBuffer*");
+ gtk_target_list_add_rich_text_targets(Xen_to_C_GtkTargetList_(list), Xen_to_C_guint(info), Xen_to_C_gboolean(deserializable),
+ Xen_to_C_GtkTextBuffer_(buffer));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_focus_on_map(XEN window)
+static Xen gxg_gtk_target_table_new_from_list(Xen list, Xen ignore_n_targets)
{
- #define H_gtk_window_get_focus_on_map "gboolean gtk_window_get_focus_on_map(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_focus_on_map", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_focus_on_map(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_target_table_new_from_list "GtkTargetEntry* gtk_target_table_new_from_list(GtkTargetList* list, \
+gint* [n_targets])"
+ gint ref_n_targets;
+ Xen_check_type(Xen_is_GtkTargetList_(list), list, 1, "gtk_target_table_new_from_list", "GtkTargetList*");
+ {
+ Xen result;
+ result = C_to_Xen_GtkTargetEntry_(gtk_target_table_new_from_list(Xen_to_C_GtkTargetList_(list), &ref_n_targets));
+ return(Xen_list_2(result, C_to_Xen_gint(ref_n_targets)));
+ }
}
-static XEN gxg_gtk_window_set_icon_name(XEN window, XEN name)
+static Xen gxg_gtk_target_table_free(Xen targets, Xen n_targets)
{
- #define H_gtk_window_set_icon_name "void gtk_window_set_icon_name(GtkWindow* window, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_icon_name", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_window_set_icon_name", "gchar*");
- gtk_window_set_icon_name(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_gtk_target_table_free "void gtk_target_table_free(GtkTargetEntry* targets, gint n_targets)"
+ Xen_check_type(Xen_is_GtkTargetEntry_(targets), targets, 1, "gtk_target_table_free", "GtkTargetEntry*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 2, "gtk_target_table_free", "gint");
+ gtk_target_table_free(Xen_to_C_GtkTargetEntry_(targets), Xen_to_C_gint(n_targets));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_icon_name(XEN window)
+static Xen gxg_gtk_selection_data_targets_include_rich_text(Xen selection_data, Xen buffer)
{
- #define H_gtk_window_get_icon_name "gchar* gtk_window_get_icon_name(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_icon_name", "GtkWindow*");
- return(C_TO_XEN_gchar_(gtk_window_get_icon_name(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_selection_data_targets_include_rich_text "gboolean gtk_selection_data_targets_include_rich_text(GtkSelectionData* selection_data, \
+GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_targets_include_rich_text", "GtkSelectionData*");
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 2, "gtk_selection_data_targets_include_rich_text", "GtkTextBuffer*");
+ return(C_to_Xen_gboolean(gtk_selection_data_targets_include_rich_text(Xen_to_C_GtkSelectionData_(selection_data), Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_window_set_default_icon_name(XEN name)
+static Xen gxg_gtk_selection_data_targets_include_uri(Xen selection_data)
{
- #define H_gtk_window_set_default_icon_name "void gtk_window_set_default_icon_name(gchar* name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_window_set_default_icon_name", "gchar*");
- gtk_window_set_default_icon_name(XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_targets_include_uri "gboolean gtk_selection_data_targets_include_uri(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_targets_include_uri", "GtkSelectionData*");
+ return(C_to_Xen_gboolean(gtk_selection_data_targets_include_uri(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_about_dialog_new(void)
+static Xen gxg_gtk_targets_include_text(Xen targets, Xen n_targets)
{
- #define H_gtk_about_dialog_new "GtkWidget* gtk_about_dialog_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_about_dialog_new()));
+ #define H_gtk_targets_include_text "gboolean gtk_targets_include_text(GdkAtom* targets, gint n_targets)"
+ Xen_check_type(Xen_is_GdkAtom_(targets), targets, 1, "gtk_targets_include_text", "GdkAtom*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 2, "gtk_targets_include_text", "gint");
+ return(C_to_Xen_gboolean(gtk_targets_include_text(Xen_to_C_GdkAtom_(targets), Xen_to_C_gint(n_targets))));
}
-static XEN gxg_gtk_about_dialog_get_version(XEN about)
+static Xen gxg_gtk_targets_include_rich_text(Xen targets, Xen n_targets, Xen buffer)
{
- #define H_gtk_about_dialog_get_version "gchar* gtk_about_dialog_get_version(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_version", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_version(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_targets_include_rich_text "gboolean gtk_targets_include_rich_text(GdkAtom* targets, gint n_targets, \
+GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GdkAtom_(targets), targets, 1, "gtk_targets_include_rich_text", "GdkAtom*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 2, "gtk_targets_include_rich_text", "gint");
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 3, "gtk_targets_include_rich_text", "GtkTextBuffer*");
+ return(C_to_Xen_gboolean(gtk_targets_include_rich_text(Xen_to_C_GdkAtom_(targets), Xen_to_C_gint(n_targets), Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_about_dialog_set_version(XEN about, XEN version)
+static Xen gxg_gtk_targets_include_image(Xen targets, Xen n_targets, Xen writable)
{
- #define H_gtk_about_dialog_set_version "void gtk_about_dialog_set_version(GtkAboutDialog* about, gchar* version)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_version", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(version), version, 2, "gtk_about_dialog_set_version", "gchar*");
- gtk_about_dialog_set_version(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(version));
- return(XEN_FALSE);
+ #define H_gtk_targets_include_image "gboolean gtk_targets_include_image(GdkAtom* targets, gint n_targets, \
+gboolean writable)"
+ Xen_check_type(Xen_is_GdkAtom_(targets), targets, 1, "gtk_targets_include_image", "GdkAtom*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 2, "gtk_targets_include_image", "gint");
+ Xen_check_type(Xen_is_gboolean(writable), writable, 3, "gtk_targets_include_image", "gboolean");
+ return(C_to_Xen_gboolean(gtk_targets_include_image(Xen_to_C_GdkAtom_(targets), Xen_to_C_gint(n_targets), Xen_to_C_gboolean(writable))));
}
-static XEN gxg_gtk_about_dialog_get_copyright(XEN about)
+static Xen gxg_gtk_targets_include_uri(Xen targets, Xen n_targets)
{
- #define H_gtk_about_dialog_get_copyright "gchar* gtk_about_dialog_get_copyright(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_copyright", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_copyright(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_targets_include_uri "gboolean gtk_targets_include_uri(GdkAtom* targets, gint n_targets)"
+ Xen_check_type(Xen_is_GdkAtom_(targets), targets, 1, "gtk_targets_include_uri", "GdkAtom*");
+ Xen_check_type(Xen_is_gint(n_targets), n_targets, 2, "gtk_targets_include_uri", "gint");
+ return(C_to_Xen_gboolean(gtk_targets_include_uri(Xen_to_C_GdkAtom_(targets), Xen_to_C_gint(n_targets))));
}
-static XEN gxg_gtk_about_dialog_set_copyright(XEN about, XEN copyright)
+static Xen gxg_gtk_size_group_get_widgets(Xen size_group)
{
- #define H_gtk_about_dialog_set_copyright "void gtk_about_dialog_set_copyright(GtkAboutDialog* about, \
-gchar* copyright)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_copyright", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(copyright), copyright, 2, "gtk_about_dialog_set_copyright", "gchar*");
- gtk_about_dialog_set_copyright(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(copyright));
- return(XEN_FALSE);
+ #define H_gtk_size_group_get_widgets "GSList* gtk_size_group_get_widgets(GtkSizeGroup* size_group)"
+ Xen_check_type(Xen_is_GtkSizeGroup_(size_group), size_group, 1, "gtk_size_group_get_widgets", "GtkSizeGroup*");
+ return(C_to_Xen_GSList_(gtk_size_group_get_widgets(Xen_to_C_GtkSizeGroup_(size_group))));
}
-static XEN gxg_gtk_about_dialog_get_comments(XEN about)
+static Xen gxg_gtk_text_buffer_get_has_selection(Xen buffer)
{
- #define H_gtk_about_dialog_get_comments "gchar* gtk_about_dialog_get_comments(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_comments", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_comments(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_text_buffer_get_has_selection "gboolean gtk_text_buffer_get_has_selection(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_has_selection", "GtkTextBuffer*");
+ return(C_to_Xen_gboolean(gtk_text_buffer_get_has_selection(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_about_dialog_set_comments(XEN about, XEN comments)
+static Xen gxg_gtk_text_buffer_get_copy_target_list(Xen buffer)
{
- #define H_gtk_about_dialog_set_comments "void gtk_about_dialog_set_comments(GtkAboutDialog* about, \
-gchar* comments)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_comments", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(comments), comments, 2, "gtk_about_dialog_set_comments", "gchar*");
- gtk_about_dialog_set_comments(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(comments));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_copy_target_list "GtkTargetList* gtk_text_buffer_get_copy_target_list(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_copy_target_list", "GtkTextBuffer*");
+ return(C_to_Xen_GtkTargetList_(gtk_text_buffer_get_copy_target_list(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_about_dialog_get_license(XEN about)
+static Xen gxg_gtk_text_buffer_get_paste_target_list(Xen buffer)
{
- #define H_gtk_about_dialog_get_license "gchar* gtk_about_dialog_get_license(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_license", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_license(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_text_buffer_get_paste_target_list "GtkTargetList* gtk_text_buffer_get_paste_target_list(GtkTextBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_paste_target_list", "GtkTextBuffer*");
+ return(C_to_Xen_GtkTargetList_(gtk_text_buffer_get_paste_target_list(Xen_to_C_GtkTextBuffer_(buffer))));
}
-static XEN gxg_gtk_about_dialog_set_license(XEN about, XEN license)
+static Xen gxg_gtk_tree_view_get_headers_clickable(Xen tree_view)
{
- #define H_gtk_about_dialog_set_license "void gtk_about_dialog_set_license(GtkAboutDialog* about, gchar* license)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_license", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(license), license, 2, "gtk_about_dialog_set_license", "gchar*");
- gtk_about_dialog_set_license(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(license));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_headers_clickable "gboolean gtk_tree_view_get_headers_clickable(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_headers_clickable", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_headers_clickable(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_about_dialog_get_website(XEN about)
+static Xen gxg_gtk_tree_view_get_search_entry(Xen tree_view)
{
- #define H_gtk_about_dialog_get_website "gchar* gtk_about_dialog_get_website(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_website", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_website(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_tree_view_get_search_entry "GtkEntry* gtk_tree_view_get_search_entry(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_search_entry", "GtkTreeView*");
+ return(C_to_Xen_GtkEntry_(gtk_tree_view_get_search_entry(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_about_dialog_set_website(XEN about, XEN website)
+static Xen gxg_gtk_tree_view_set_search_entry(Xen tree_view, Xen entry)
{
- #define H_gtk_about_dialog_set_website "void gtk_about_dialog_set_website(GtkAboutDialog* about, gchar* website)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_website", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(website), website, 2, "gtk_about_dialog_set_website", "gchar*");
- gtk_about_dialog_set_website(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(website));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_search_entry "void gtk_tree_view_set_search_entry(GtkTreeView* tree_view, \
+GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_search_entry", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 2, "gtk_tree_view_set_search_entry", "GtkEntry*");
+ gtk_tree_view_set_search_entry(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkEntry_(entry));
+ return(Xen_false);
}
-static XEN gxg_gtk_about_dialog_get_website_label(XEN about)
+static Xen gxg_gtk_tree_view_get_search_position_func(Xen tree_view)
{
- #define H_gtk_about_dialog_get_website_label "gchar* gtk_about_dialog_get_website_label(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_website_label", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_website_label(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_tree_view_get_search_position_func "GtkTreeViewSearchPositionFunc gtk_tree_view_get_search_position_func(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_search_position_func", "GtkTreeView*");
+ return(C_to_Xen_GtkTreeViewSearchPositionFunc(gtk_tree_view_get_search_position_func(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_about_dialog_set_website_label(XEN about, XEN website_label)
+static Xen gxg_gtk_tree_view_set_search_position_func(Xen tree_view, Xen func, Xen func_info, Xen destroy)
{
- #define H_gtk_about_dialog_set_website_label "void gtk_about_dialog_set_website_label(GtkAboutDialog* about, \
-gchar* website_label)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_website_label", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(website_label), website_label, 2, "gtk_about_dialog_set_website_label", "gchar*");
- gtk_about_dialog_set_website_label(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(website_label));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_search_position_func "void gtk_tree_view_set_search_position_func(GtkTreeView* tree_view, \
+GtkTreeViewSearchPositionFunc func, lambda_data func_info, GDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_search_position_func", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewSearchPositionFunc(func), func, 2, "gtk_tree_view_set_search_position_func", "GtkTreeViewSearchPositionFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_tree_view_set_search_position_func", "lambda_data");
+ Xen_check_type(Xen_is_GDestroyNotify(destroy), destroy, 4, "gtk_tree_view_set_search_position_func", "GDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ gtk_tree_view_set_search_position_func(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewSearchPositionFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GDestroyNotify(destroy));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_about_dialog_get_authors(XEN about)
+static Xen gxg_gtk_widget_is_composited(Xen widget)
{
- #define H_gtk_about_dialog_get_authors "gchar** gtk_about_dialog_get_authors(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_authors", "GtkAboutDialog*");
- return(C_TO_XEN_gchar__((gchar**)gtk_about_dialog_get_authors(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_widget_is_composited "gboolean gtk_widget_is_composited(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_is_composited", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_is_composited(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_about_dialog_set_authors(XEN about, XEN authors)
+static Xen gxg_gtk_window_set_deletable(Xen window, Xen setting)
{
- #define H_gtk_about_dialog_set_authors "void gtk_about_dialog_set_authors(GtkAboutDialog* about, gchar** authors)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_authors", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar___P(authors), authors, 2, "gtk_about_dialog_set_authors", "gchar**");
- gtk_about_dialog_set_authors(XEN_TO_C_GtkAboutDialog_(about), (const gchar**)XEN_TO_C_gchar__(authors));
- return(XEN_FALSE);
+ #define H_gtk_window_set_deletable "void gtk_window_set_deletable(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_deletable", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_deletable", "gboolean");
+ gtk_window_set_deletable(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_about_dialog_get_documenters(XEN about)
+static Xen gxg_gtk_window_get_deletable(Xen window)
{
- #define H_gtk_about_dialog_get_documenters "gchar** gtk_about_dialog_get_documenters(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_documenters", "GtkAboutDialog*");
- return(C_TO_XEN_gchar__((gchar**)gtk_about_dialog_get_documenters(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_window_get_deletable "gboolean gtk_window_get_deletable(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_deletable", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_deletable(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_about_dialog_set_documenters(XEN about, XEN documenters)
+static Xen gxg_gtk_assistant_new(void)
{
- #define H_gtk_about_dialog_set_documenters "void gtk_about_dialog_set_documenters(GtkAboutDialog* about, \
-gchar** documenters)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_documenters", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar___P(documenters), documenters, 2, "gtk_about_dialog_set_documenters", "gchar**");
- gtk_about_dialog_set_documenters(XEN_TO_C_GtkAboutDialog_(about), (const gchar**)XEN_TO_C_gchar__(documenters));
- return(XEN_FALSE);
+ #define H_gtk_assistant_new "GtkWidget* gtk_assistant_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_assistant_new()));
}
-static XEN gxg_gtk_about_dialog_get_artists(XEN about)
+static Xen gxg_gtk_assistant_get_current_page(Xen assistant)
{
- #define H_gtk_about_dialog_get_artists "gchar** gtk_about_dialog_get_artists(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_artists", "GtkAboutDialog*");
- return(C_TO_XEN_gchar__((gchar**)gtk_about_dialog_get_artists(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_assistant_get_current_page "gint gtk_assistant_get_current_page(GtkAssistant* assistant)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_get_current_page", "GtkAssistant*");
+ return(C_to_Xen_gint(gtk_assistant_get_current_page(Xen_to_C_GtkAssistant_(assistant))));
}
-static XEN gxg_gtk_about_dialog_set_artists(XEN about, XEN artists)
+static Xen gxg_gtk_assistant_set_current_page(Xen assistant, Xen page_num)
{
- #define H_gtk_about_dialog_set_artists "void gtk_about_dialog_set_artists(GtkAboutDialog* about, gchar** artists)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_artists", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar___P(artists), artists, 2, "gtk_about_dialog_set_artists", "gchar**");
- gtk_about_dialog_set_artists(XEN_TO_C_GtkAboutDialog_(about), (const gchar**)XEN_TO_C_gchar__(artists));
- return(XEN_FALSE);
+ #define H_gtk_assistant_set_current_page "void gtk_assistant_set_current_page(GtkAssistant* assistant, \
+gint page_num)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_set_current_page", "GtkAssistant*");
+ Xen_check_type(Xen_is_gint(page_num), page_num, 2, "gtk_assistant_set_current_page", "gint");
+ gtk_assistant_set_current_page(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_gint(page_num));
+ return(Xen_false);
}
-static XEN gxg_gtk_about_dialog_get_translator_credits(XEN about)
+static Xen gxg_gtk_assistant_get_n_pages(Xen assistant)
{
- #define H_gtk_about_dialog_get_translator_credits "gchar* gtk_about_dialog_get_translator_credits(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_translator_credits", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_translator_credits(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_assistant_get_n_pages "gint gtk_assistant_get_n_pages(GtkAssistant* assistant)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_get_n_pages", "GtkAssistant*");
+ return(C_to_Xen_gint(gtk_assistant_get_n_pages(Xen_to_C_GtkAssistant_(assistant))));
}
-static XEN gxg_gtk_about_dialog_set_translator_credits(XEN about, XEN translator_credits)
+static Xen gxg_gtk_assistant_get_nth_page(Xen assistant, Xen page_num)
{
- #define H_gtk_about_dialog_set_translator_credits "void gtk_about_dialog_set_translator_credits(GtkAboutDialog* about, \
-gchar* translator_credits)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_translator_credits", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(translator_credits), translator_credits, 2, "gtk_about_dialog_set_translator_credits", "gchar*");
- gtk_about_dialog_set_translator_credits(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(translator_credits));
- return(XEN_FALSE);
+ #define H_gtk_assistant_get_nth_page "GtkWidget* gtk_assistant_get_nth_page(GtkAssistant* assistant, \
+gint page_num)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_get_nth_page", "GtkAssistant*");
+ Xen_check_type(Xen_is_gint(page_num), page_num, 2, "gtk_assistant_get_nth_page", "gint");
+ return(C_to_Xen_GtkWidget_(gtk_assistant_get_nth_page(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_gint(page_num))));
}
-static XEN gxg_gtk_about_dialog_get_logo(XEN about)
+static Xen gxg_gtk_assistant_prepend_page(Xen assistant, Xen page)
{
- #define H_gtk_about_dialog_get_logo "GdkPixbuf* gtk_about_dialog_get_logo(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_logo", "GtkAboutDialog*");
- return(C_TO_XEN_GdkPixbuf_(gtk_about_dialog_get_logo(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_assistant_prepend_page "gint gtk_assistant_prepend_page(GtkAssistant* assistant, GtkWidget* page)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_prepend_page", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_prepend_page", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_assistant_prepend_page(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page))));
}
-static XEN gxg_gtk_about_dialog_set_logo(XEN about, XEN logo)
+static Xen gxg_gtk_assistant_append_page(Xen assistant, Xen page)
{
- #define H_gtk_about_dialog_set_logo "void gtk_about_dialog_set_logo(GtkAboutDialog* about, GdkPixbuf* logo)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_logo", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(logo) || XEN_FALSE_P(logo), logo, 2, "gtk_about_dialog_set_logo", "GdkPixbuf*");
- gtk_about_dialog_set_logo(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_GdkPixbuf_(logo));
- return(XEN_FALSE);
+ #define H_gtk_assistant_append_page "gint gtk_assistant_append_page(GtkAssistant* assistant, GtkWidget* page)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_append_page", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_append_page", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_assistant_append_page(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page))));
}
-static XEN gxg_gtk_about_dialog_get_program_name(XEN about)
+static Xen gxg_gtk_assistant_insert_page(Xen assistant, Xen page, Xen position)
{
- #define H_gtk_about_dialog_get_program_name "gchar* gtk_about_dialog_get_program_name(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_program_name", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_program_name(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_assistant_insert_page "gint gtk_assistant_insert_page(GtkAssistant* assistant, GtkWidget* page, \
+gint position)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_insert_page", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_insert_page", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_assistant_insert_page", "gint");
+ return(C_to_Xen_gint(gtk_assistant_insert_page(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page), Xen_to_C_gint(position))));
}
-static XEN gxg_gtk_about_dialog_set_program_name(XEN about, XEN name)
+static Xen gxg_gtk_assistant_set_forward_page_func(Xen assistant, Xen page_func, Xen func_info, Xen destroy)
{
- #define H_gtk_about_dialog_set_program_name "void gtk_about_dialog_set_program_name(GtkAboutDialog* about, \
-gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_program_name", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_about_dialog_set_program_name", "gchar*");
- gtk_about_dialog_set_program_name(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_gtk_assistant_set_forward_page_func "void gtk_assistant_set_forward_page_func(GtkAssistant* assistant, \
+GtkAssistantPageFunc page_func, lambda_data func_info, GDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_set_forward_page_func", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkAssistantPageFunc(page_func), page_func, 2, "gtk_assistant_set_forward_page_func", "GtkAssistantPageFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_assistant_set_forward_page_func", "lambda_data");
+ Xen_check_type(Xen_is_GDestroyNotify(destroy), destroy, 4, "gtk_assistant_set_forward_page_func", "GDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(Xen_false, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ gtk_assistant_set_forward_page_func(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkAssistantPageFunc(page_func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GDestroyNotify(destroy));
+ return(Xen_false);
+ }
}
-static XEN gxg_gtk_icon_view_new(void)
+static Xen gxg_gtk_assistant_set_page_type(Xen assistant, Xen page, Xen type)
{
- #define H_gtk_icon_view_new "GtkWidget* gtk_icon_view_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_icon_view_new()));
+ #define H_gtk_assistant_set_page_type "void gtk_assistant_set_page_type(GtkAssistant* assistant, GtkWidget* page, \
+GtkAssistantPageType type)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_set_page_type", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_set_page_type", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAssistantPageType(type), type, 3, "gtk_assistant_set_page_type", "GtkAssistantPageType");
+ gtk_assistant_set_page_type(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page), Xen_to_C_GtkAssistantPageType(type));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_new_with_model(XEN model)
+static Xen gxg_gtk_assistant_get_page_type(Xen assistant, Xen page)
{
- #define H_gtk_icon_view_new_with_model "GtkWidget* gtk_icon_view_new_with_model(GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model), model, 1, "gtk_icon_view_new_with_model", "GtkTreeModel*");
- return(C_TO_XEN_GtkWidget_(gtk_icon_view_new_with_model(XEN_TO_C_GtkTreeModel_(model))));
+ #define H_gtk_assistant_get_page_type "GtkAssistantPageType gtk_assistant_get_page_type(GtkAssistant* assistant, \
+GtkWidget* page)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_get_page_type", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_get_page_type", "GtkWidget*");
+ return(C_to_Xen_GtkAssistantPageType(gtk_assistant_get_page_type(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page))));
}
-static XEN gxg_gtk_icon_view_set_model(XEN icon_view, XEN model)
+static Xen gxg_gtk_assistant_set_page_title(Xen assistant, Xen page, Xen title)
{
- #define H_gtk_icon_view_set_model "void gtk_icon_view_set_model(GtkIconView* icon_view, GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_model", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model) || XEN_FALSE_P(model), model, 2, "gtk_icon_view_set_model", "GtkTreeModel*");
- gtk_icon_view_set_model(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreeModel_(model));
- return(XEN_FALSE);
+ #define H_gtk_assistant_set_page_title "void gtk_assistant_set_page_title(GtkAssistant* assistant, \
+GtkWidget* page, gchar* title)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_set_page_title", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_set_page_title", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(title), title, 3, "gtk_assistant_set_page_title", "gchar*");
+ gtk_assistant_set_page_title(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page), Xen_to_C_gchar_(title));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_model(XEN icon_view)
+static Xen gxg_gtk_assistant_get_page_title(Xen assistant, Xen page)
{
- #define H_gtk_icon_view_get_model "GtkTreeModel* gtk_icon_view_get_model(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_model", "GtkIconView*");
- return(C_TO_XEN_GtkTreeModel_(gtk_icon_view_get_model(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_assistant_get_page_title "gchar* gtk_assistant_get_page_title(GtkAssistant* assistant, \
+GtkWidget* page)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_get_page_title", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_get_page_title", "GtkWidget*");
+ return(C_to_Xen_gchar_(gtk_assistant_get_page_title(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page))));
}
-static XEN gxg_gtk_icon_view_set_text_column(XEN icon_view, XEN column)
+static Xen gxg_gtk_assistant_set_page_complete(Xen assistant, Xen page, Xen complete)
{
- #define H_gtk_icon_view_set_text_column "void gtk_icon_view_set_text_column(GtkIconView* icon_view, \
-gint column)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_text_column", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 2, "gtk_icon_view_set_text_column", "gint");
- gtk_icon_view_set_text_column(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_gtk_assistant_set_page_complete "void gtk_assistant_set_page_complete(GtkAssistant* assistant, \
+GtkWidget* page, gboolean complete)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_set_page_complete", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_set_page_complete", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(complete), complete, 3, "gtk_assistant_set_page_complete", "gboolean");
+ gtk_assistant_set_page_complete(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page), Xen_to_C_gboolean(complete));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_text_column(XEN icon_view)
+static Xen gxg_gtk_assistant_get_page_complete(Xen assistant, Xen page)
{
- #define H_gtk_icon_view_get_text_column "gint gtk_icon_view_get_text_column(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_text_column", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_text_column(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_assistant_get_page_complete "gboolean gtk_assistant_get_page_complete(GtkAssistant* assistant, \
+GtkWidget* page)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_get_page_complete", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(page), page, 2, "gtk_assistant_get_page_complete", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_assistant_get_page_complete(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(page))));
}
-static XEN gxg_gtk_icon_view_set_markup_column(XEN icon_view, XEN column)
+static Xen gxg_gtk_assistant_add_action_widget(Xen assistant, Xen child)
{
- #define H_gtk_icon_view_set_markup_column "void gtk_icon_view_set_markup_column(GtkIconView* icon_view, \
-gint column)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_markup_column", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 2, "gtk_icon_view_set_markup_column", "gint");
- gtk_icon_view_set_markup_column(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_gtk_assistant_add_action_widget "void gtk_assistant_add_action_widget(GtkAssistant* assistant, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_add_action_widget", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_assistant_add_action_widget", "GtkWidget*");
+ gtk_assistant_add_action_widget(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_markup_column(XEN icon_view)
+static Xen gxg_gtk_assistant_remove_action_widget(Xen assistant, Xen child)
{
- #define H_gtk_icon_view_get_markup_column "gint gtk_icon_view_get_markup_column(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_markup_column", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_markup_column(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_assistant_remove_action_widget "void gtk_assistant_remove_action_widget(GtkAssistant* assistant, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_remove_action_widget", "GtkAssistant*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_assistant_remove_action_widget", "GtkWidget*");
+ gtk_assistant_remove_action_widget(Xen_to_C_GtkAssistant_(assistant), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_set_pixbuf_column(XEN icon_view, XEN column)
+static Xen gxg_gtk_assistant_update_buttons_state(Xen assistant)
{
- #define H_gtk_icon_view_set_pixbuf_column "void gtk_icon_view_set_pixbuf_column(GtkIconView* icon_view, \
-gint column)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_pixbuf_column", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 2, "gtk_icon_view_set_pixbuf_column", "gint");
- gtk_icon_view_set_pixbuf_column(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_gtk_assistant_update_buttons_state "void gtk_assistant_update_buttons_state(GtkAssistant* assistant)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_update_buttons_state", "GtkAssistant*");
+ gtk_assistant_update_buttons_state(Xen_to_C_GtkAssistant_(assistant));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_pixbuf_column(XEN icon_view)
+static Xen gxg_gtk_cell_renderer_accel_new(void)
{
- #define H_gtk_icon_view_get_pixbuf_column "gint gtk_icon_view_get_pixbuf_column(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_pixbuf_column", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_pixbuf_column(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_cell_renderer_accel_new "GtkCellRenderer* gtk_cell_renderer_accel_new( void)"
+ return(C_to_Xen_GtkCellRenderer_(gtk_cell_renderer_accel_new()));
}
-static XEN gxg_gtk_icon_view_get_path_at_pos(XEN icon_view, XEN x, XEN y)
+static Xen gxg_gtk_cell_renderer_spin_new(void)
{
- #define H_gtk_icon_view_get_path_at_pos "GtkTreePath* gtk_icon_view_get_path_at_pos(GtkIconView* icon_view, \
-gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_path_at_pos", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_icon_view_get_path_at_pos", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_icon_view_get_path_at_pos", "gint");
- return(C_TO_XEN_GtkTreePath_(gtk_icon_view_get_path_at_pos(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(x), XEN_TO_C_gint(y))));
+ #define H_gtk_cell_renderer_spin_new "GtkCellRenderer* gtk_cell_renderer_spin_new( void)"
+ return(C_to_Xen_GtkCellRenderer_(gtk_cell_renderer_spin_new()));
}
-static XEN gxg_gtk_icon_view_selected_foreach(XEN icon_view, XEN func, XEN func_info)
+static Xen gxg_gtk_link_button_new(Xen uri)
{
- #define H_gtk_icon_view_selected_foreach "void gtk_icon_view_selected_foreach(GtkIconView* icon_view, \
-GtkIconViewForeachFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_selected_foreach", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkIconViewForeachFunc_P(func), func, 2, "gtk_icon_view_selected_foreach", "GtkIconViewForeachFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_icon_view_selected_foreach", "lambda_data");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- gtk_icon_view_selected_foreach(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkIconViewForeachFunc(func), XEN_TO_C_lambda_data(func_info));
- return(XEN_FALSE);
- }
+ #define H_gtk_link_button_new "GtkWidget* gtk_link_button_new(gchar* uri)"
+ Xen_check_type(Xen_is_gchar_(uri), uri, 1, "gtk_link_button_new", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_link_button_new(Xen_to_C_gchar_(uri))));
}
-static XEN gxg_gtk_icon_view_set_selection_mode(XEN icon_view, XEN mode)
+static Xen gxg_gtk_link_button_new_with_label(Xen uri, Xen label)
{
- #define H_gtk_icon_view_set_selection_mode "void gtk_icon_view_set_selection_mode(GtkIconView* icon_view, \
-GtkSelectionMode mode)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_selection_mode", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkSelectionMode_P(mode), mode, 2, "gtk_icon_view_set_selection_mode", "GtkSelectionMode");
- gtk_icon_view_set_selection_mode(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkSelectionMode(mode));
- return(XEN_FALSE);
+ #define H_gtk_link_button_new_with_label "GtkWidget* gtk_link_button_new_with_label(gchar* uri, gchar* label)"
+ Xen_check_type(Xen_is_gchar_(uri), uri, 1, "gtk_link_button_new_with_label", "gchar*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_link_button_new_with_label", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_link_button_new_with_label(Xen_to_C_gchar_(uri), Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_icon_view_get_selection_mode(XEN icon_view)
+static Xen gxg_gtk_link_button_get_uri(Xen link_button)
{
- #define H_gtk_icon_view_get_selection_mode "GtkSelectionMode gtk_icon_view_get_selection_mode(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_selection_mode", "GtkIconView*");
- return(C_TO_XEN_GtkSelectionMode(gtk_icon_view_get_selection_mode(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_link_button_get_uri "gchar* gtk_link_button_get_uri(GtkLinkButton* link_button)"
+ Xen_check_type(Xen_is_GtkLinkButton_(link_button), link_button, 1, "gtk_link_button_get_uri", "GtkLinkButton*");
+ return(C_to_Xen_gchar_(gtk_link_button_get_uri(Xen_to_C_GtkLinkButton_(link_button))));
}
-static XEN gxg_gtk_icon_view_select_path(XEN icon_view, XEN path)
+static Xen gxg_gtk_link_button_set_uri(Xen link_button, Xen uri)
{
- #define H_gtk_icon_view_select_path "void gtk_icon_view_select_path(GtkIconView* icon_view, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_select_path", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_select_path", "GtkTreePath*");
- gtk_icon_view_select_path(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_link_button_set_uri "void gtk_link_button_set_uri(GtkLinkButton* link_button, gchar* uri)"
+ Xen_check_type(Xen_is_GtkLinkButton_(link_button), link_button, 1, "gtk_link_button_set_uri", "GtkLinkButton*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_link_button_set_uri", "gchar*");
+ gtk_link_button_set_uri(Xen_to_C_GtkLinkButton_(link_button), Xen_to_C_gchar_(uri));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_unselect_path(XEN icon_view, XEN path)
+static Xen gxg_gtk_recent_chooser_error_quark(void)
{
- #define H_gtk_icon_view_unselect_path "void gtk_icon_view_unselect_path(GtkIconView* icon_view, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_unselect_path", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_unselect_path", "GtkTreePath*");
- gtk_icon_view_unselect_path(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_error_quark "GQuark gtk_recent_chooser_error_quark( void)"
+ return(C_to_Xen_GQuark(gtk_recent_chooser_error_quark()));
}
-static XEN gxg_gtk_icon_view_path_is_selected(XEN icon_view, XEN path)
+static Xen gxg_gtk_recent_chooser_set_show_private(Xen chooser, Xen show_private)
{
- #define H_gtk_icon_view_path_is_selected "gboolean gtk_icon_view_path_is_selected(GtkIconView* icon_view, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_path_is_selected", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_path_is_selected", "GtkTreePath*");
- return(C_TO_XEN_gboolean(gtk_icon_view_path_is_selected(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_recent_chooser_set_show_private "void gtk_recent_chooser_set_show_private(GtkRecentChooser* chooser, \
+gboolean show_private)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_show_private", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gboolean(show_private), show_private, 2, "gtk_recent_chooser_set_show_private", "gboolean");
+ gtk_recent_chooser_set_show_private(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gboolean(show_private));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_selected_items(XEN icon_view)
+static Xen gxg_gtk_recent_chooser_get_show_private(Xen chooser)
{
- #define H_gtk_icon_view_get_selected_items "GList* gtk_icon_view_get_selected_items(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_selected_items", "GtkIconView*");
- return(C_TO_XEN_GList_(gtk_icon_view_get_selected_items(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_recent_chooser_get_show_private "gboolean gtk_recent_chooser_get_show_private(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_show_private", "GtkRecentChooser*");
+ return(C_to_Xen_gboolean(gtk_recent_chooser_get_show_private(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_gtk_icon_view_select_all(XEN icon_view)
+static Xen gxg_gtk_recent_chooser_set_show_not_found(Xen chooser, Xen show_not_found)
{
- #define H_gtk_icon_view_select_all "void gtk_icon_view_select_all(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_select_all", "GtkIconView*");
- gtk_icon_view_select_all(XEN_TO_C_GtkIconView_(icon_view));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_set_show_not_found "void gtk_recent_chooser_set_show_not_found(GtkRecentChooser* chooser, \
+gboolean show_not_found)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_show_not_found", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gboolean(show_not_found), show_not_found, 2, "gtk_recent_chooser_set_show_not_found", "gboolean");
+ gtk_recent_chooser_set_show_not_found(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gboolean(show_not_found));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_unselect_all(XEN icon_view)
+static Xen gxg_gtk_recent_chooser_get_show_not_found(Xen chooser)
{
- #define H_gtk_icon_view_unselect_all "void gtk_icon_view_unselect_all(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_unselect_all", "GtkIconView*");
- gtk_icon_view_unselect_all(XEN_TO_C_GtkIconView_(icon_view));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_get_show_not_found "gboolean gtk_recent_chooser_get_show_not_found(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_show_not_found", "GtkRecentChooser*");
+ return(C_to_Xen_gboolean(gtk_recent_chooser_get_show_not_found(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_gtk_icon_view_item_activated(XEN icon_view, XEN path)
+static Xen gxg_gtk_recent_chooser_set_select_multiple(Xen chooser, Xen select_multiple)
{
- #define H_gtk_icon_view_item_activated "void gtk_icon_view_item_activated(GtkIconView* icon_view, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_item_activated", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_item_activated", "GtkTreePath*");
- gtk_icon_view_item_activated(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_set_select_multiple "void gtk_recent_chooser_set_select_multiple(GtkRecentChooser* chooser, \
+gboolean select_multiple)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_select_multiple", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gboolean(select_multiple), select_multiple, 2, "gtk_recent_chooser_set_select_multiple", "gboolean");
+ gtk_recent_chooser_set_select_multiple(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gboolean(select_multiple));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_combo_new(void)
+static Xen gxg_gtk_recent_chooser_get_select_multiple(Xen chooser)
{
- #define H_gtk_cell_renderer_combo_new "GtkCellRenderer* gtk_cell_renderer_combo_new( void)"
- return(C_TO_XEN_GtkCellRenderer_(gtk_cell_renderer_combo_new()));
+ #define H_gtk_recent_chooser_get_select_multiple "gboolean gtk_recent_chooser_get_select_multiple(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_select_multiple", "GtkRecentChooser*");
+ return(C_to_Xen_gboolean(gtk_recent_chooser_get_select_multiple(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_gtk_cell_renderer_progress_new(void)
+static Xen gxg_gtk_recent_chooser_set_limit(Xen chooser, Xen limit)
{
- #define H_gtk_cell_renderer_progress_new "GtkCellRenderer* gtk_cell_renderer_progress_new( void)"
- return(C_TO_XEN_GtkCellRenderer_(gtk_cell_renderer_progress_new()));
+ #define H_gtk_recent_chooser_set_limit "void gtk_recent_chooser_set_limit(GtkRecentChooser* chooser, \
+gint limit)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_limit", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gint(limit), limit, 2, "gtk_recent_chooser_set_limit", "gint");
+ gtk_recent_chooser_set_limit(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gint(limit));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_set_row_separator_func(XEN combo_box, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_recent_chooser_get_limit(Xen chooser)
{
- #define H_gtk_combo_box_set_row_separator_func "void gtk_combo_box_set_row_separator_func(GtkComboBox* combo_box, \
-GtkTreeViewRowSeparatorFunc func, lambda_data func_info, GtkDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_row_separator_func", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewRowSeparatorFunc_P(func), func, 2, "gtk_combo_box_set_row_separator_func", "GtkTreeViewRowSeparatorFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_combo_box_set_row_separator_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GtkDestroyNotify_P(destroy), destroy, 4, "gtk_combo_box_set_row_separator_func", "GtkDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 3, destroy);
- gtk_combo_box_set_row_separator_func(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_GtkTreeViewRowSeparatorFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GtkDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_recent_chooser_get_limit "gint gtk_recent_chooser_get_limit(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_limit", "GtkRecentChooser*");
+ return(C_to_Xen_gint(gtk_recent_chooser_get_limit(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_gtk_label_set_ellipsize(XEN label, XEN mode)
+static Xen gxg_gtk_recent_chooser_set_local_only(Xen chooser, Xen local_only)
{
- #define H_gtk_label_set_ellipsize "void gtk_label_set_ellipsize(GtkLabel* label, PangoEllipsizeMode mode)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_ellipsize", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_PangoEllipsizeMode_P(mode), mode, 2, "gtk_label_set_ellipsize", "PangoEllipsizeMode");
- gtk_label_set_ellipsize(XEN_TO_C_GtkLabel_(label), XEN_TO_C_PangoEllipsizeMode(mode));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_set_local_only "void gtk_recent_chooser_set_local_only(GtkRecentChooser* chooser, \
+gboolean local_only)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_local_only", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gboolean(local_only), local_only, 2, "gtk_recent_chooser_set_local_only", "gboolean");
+ gtk_recent_chooser_set_local_only(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gboolean(local_only));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_ellipsize(XEN label)
+static Xen gxg_gtk_recent_chooser_get_local_only(Xen chooser)
{
- #define H_gtk_label_get_ellipsize "PangoEllipsizeMode gtk_label_get_ellipsize(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_ellipsize", "GtkLabel*");
- return(C_TO_XEN_PangoEllipsizeMode(gtk_label_get_ellipsize(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_recent_chooser_get_local_only "gboolean gtk_recent_chooser_get_local_only(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_local_only", "GtkRecentChooser*");
+ return(C_to_Xen_gboolean(gtk_recent_chooser_get_local_only(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_pango_attr_fallback_new(XEN enable_fallback)
+static Xen gxg_gtk_recent_chooser_set_show_tips(Xen chooser, Xen show_tips)
{
- #define H_pango_attr_fallback_new "PangoAttribute* pango_attr_fallback_new(gboolean enable_fallback)"
- XEN_ASSERT_TYPE(XEN_gboolean_P(enable_fallback), enable_fallback, 1, "pango_attr_fallback_new", "gboolean");
- return(C_TO_XEN_PangoAttribute_(pango_attr_fallback_new(XEN_TO_C_gboolean(enable_fallback))));
+ #define H_gtk_recent_chooser_set_show_tips "void gtk_recent_chooser_set_show_tips(GtkRecentChooser* chooser, \
+gboolean show_tips)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_show_tips", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gboolean(show_tips), show_tips, 2, "gtk_recent_chooser_set_show_tips", "gboolean");
+ gtk_recent_chooser_set_show_tips(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gboolean(show_tips));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_letter_spacing_new(XEN letter_spacing)
+static Xen gxg_gtk_recent_chooser_get_show_tips(Xen chooser)
{
- #define H_pango_attr_letter_spacing_new "PangoAttribute* pango_attr_letter_spacing_new(int letter_spacing)"
- XEN_ASSERT_TYPE(XEN_int_P(letter_spacing), letter_spacing, 1, "pango_attr_letter_spacing_new", "int");
- return(C_TO_XEN_PangoAttribute_(pango_attr_letter_spacing_new(XEN_TO_C_int(letter_spacing))));
+ #define H_gtk_recent_chooser_get_show_tips "gboolean gtk_recent_chooser_get_show_tips(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_show_tips", "GtkRecentChooser*");
+ return(C_to_Xen_gboolean(gtk_recent_chooser_get_show_tips(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_pango_attr_list_filter(XEN list, XEN func, XEN data)
+static Xen gxg_gtk_recent_chooser_set_show_icons(Xen chooser, Xen show_icons)
{
- #define H_pango_attr_list_filter "PangoAttrList* pango_attr_list_filter(PangoAttrList* list, PangoAttrFilterFunc func, \
-gpointer data)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_filter", "PangoAttrList*");
- XEN_ASSERT_TYPE(XEN_PangoAttrFilterFunc_P(func), func, 2, "pango_attr_list_filter", "PangoAttrFilterFunc");
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 3, "pango_attr_list_filter", "gpointer");
- return(C_TO_XEN_PangoAttrList_(pango_attr_list_filter(XEN_TO_C_PangoAttrList_(list), XEN_TO_C_PangoAttrFilterFunc(func),
- XEN_TO_C_gpointer(data))));
+ #define H_gtk_recent_chooser_set_show_icons "void gtk_recent_chooser_set_show_icons(GtkRecentChooser* chooser, \
+gboolean show_icons)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_show_icons", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gboolean(show_icons), show_icons, 2, "gtk_recent_chooser_set_show_icons", "gboolean");
+ gtk_recent_chooser_set_show_icons(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gboolean(show_icons));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_iterator_get_attrs(XEN iterator)
+static Xen gxg_gtk_recent_chooser_get_show_icons(Xen chooser)
{
- #define H_pango_attr_iterator_get_attrs "GSList* pango_attr_iterator_get_attrs(PangoAttrIterator* iterator)"
- XEN_ASSERT_TYPE(XEN_PangoAttrIterator__P(iterator), iterator, 1, "pango_attr_iterator_get_attrs", "PangoAttrIterator*");
- return(C_TO_XEN_GSList_(pango_attr_iterator_get_attrs(XEN_TO_C_PangoAttrIterator_(iterator))));
+ #define H_gtk_recent_chooser_get_show_icons "gboolean gtk_recent_chooser_get_show_icons(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_show_icons", "GtkRecentChooser*");
+ return(C_to_Xen_gboolean(gtk_recent_chooser_get_show_icons(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_pango_font_metrics_get_underline_position(XEN metrics)
+static Xen gxg_gtk_recent_chooser_set_sort_type(Xen chooser, Xen sort_type)
{
- #define H_pango_font_metrics_get_underline_position "int pango_font_metrics_get_underline_position(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_get_underline_position", "PangoFontMetrics*");
- return(C_TO_XEN_int(pango_font_metrics_get_underline_position(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gtk_recent_chooser_set_sort_type "void gtk_recent_chooser_set_sort_type(GtkRecentChooser* chooser, \
+GtkRecentSortType sort_type)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_sort_type", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_GtkRecentSortType(sort_type), sort_type, 2, "gtk_recent_chooser_set_sort_type", "GtkRecentSortType");
+ gtk_recent_chooser_set_sort_type(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_GtkRecentSortType(sort_type));
+ return(Xen_false);
}
-static XEN gxg_pango_font_metrics_get_underline_thickness(XEN metrics)
+static Xen gxg_gtk_recent_chooser_get_sort_type(Xen chooser)
{
- #define H_pango_font_metrics_get_underline_thickness "int pango_font_metrics_get_underline_thickness(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_get_underline_thickness", "PangoFontMetrics*");
- return(C_TO_XEN_int(pango_font_metrics_get_underline_thickness(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gtk_recent_chooser_get_sort_type "GtkRecentSortType gtk_recent_chooser_get_sort_type(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_sort_type", "GtkRecentChooser*");
+ return(C_to_Xen_GtkRecentSortType(gtk_recent_chooser_get_sort_type(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_pango_font_metrics_get_strikethrough_position(XEN metrics)
+static Xen gxg_gtk_recent_chooser_set_sort_func(Xen chooser, Xen func, Xen func_info, Xen data_destroy)
{
- #define H_pango_font_metrics_get_strikethrough_position "int pango_font_metrics_get_strikethrough_position(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_get_strikethrough_position", "PangoFontMetrics*");
- return(C_TO_XEN_int(pango_font_metrics_get_strikethrough_position(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gtk_recent_chooser_set_sort_func "void gtk_recent_chooser_set_sort_func(GtkRecentChooser* chooser, \
+GtkRecentSortFunc func, lambda_data func_info, GDestroyNotify data_destroy)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_sort_func", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_GtkRecentSortFunc(func), func, 2, "gtk_recent_chooser_set_sort_func", "GtkRecentSortFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gtk_recent_chooser_set_sort_func", "lambda_data");
+ Xen_check_type(Xen_is_GDestroyNotify(data_destroy), data_destroy, 4, "gtk_recent_chooser_set_sort_func", "GDestroyNotify");
+ {
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ xm_protect(gxg_ptr);
+ gtk_recent_chooser_set_sort_func(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_GtkRecentSortFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GDestroyNotify(data_destroy));
+ return(Xen_false);
+ }
}
-static XEN gxg_pango_font_metrics_get_strikethrough_thickness(XEN metrics)
+static Xen gxg_gtk_recent_chooser_set_current_uri(Xen chooser, Xen uri, Xen ignore_error)
{
- #define H_pango_font_metrics_get_strikethrough_thickness "int pango_font_metrics_get_strikethrough_thickness(PangoFontMetrics* metrics)"
- XEN_ASSERT_TYPE(XEN_PangoFontMetrics__P(metrics), metrics, 1, "pango_font_metrics_get_strikethrough_thickness", "PangoFontMetrics*");
- return(C_TO_XEN_int(pango_font_metrics_get_strikethrough_thickness(XEN_TO_C_PangoFontMetrics_(metrics))));
+ #define H_gtk_recent_chooser_set_current_uri "gboolean gtk_recent_chooser_set_current_uri(GtkRecentChooser* chooser, \
+gchar* uri, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_current_uri", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_chooser_set_current_uri", "gchar*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_recent_chooser_set_current_uri(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gchar_(uri),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_pango_font_family_is_monospace(XEN family)
+static Xen gxg_gtk_recent_chooser_get_current_uri(Xen chooser)
{
- #define H_pango_font_family_is_monospace "gboolean pango_font_family_is_monospace(PangoFontFamily* family)"
- XEN_ASSERT_TYPE(XEN_PangoFontFamily__P(family), family, 1, "pango_font_family_is_monospace", "PangoFontFamily*");
- return(C_TO_XEN_gboolean(pango_font_family_is_monospace(XEN_TO_C_PangoFontFamily_(family))));
+ #define H_gtk_recent_chooser_get_current_uri "gchar* gtk_recent_chooser_get_current_uri(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_current_uri", "GtkRecentChooser*");
+ return(C_to_Xen_gchar_(gtk_recent_chooser_get_current_uri(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_pango_font_face_list_sizes(XEN face, XEN ignore_sizes, XEN ignore_n_sizes)
+static Xen gxg_gtk_recent_chooser_get_current_item(Xen chooser)
{
- #define H_pango_font_face_list_sizes "void pango_font_face_list_sizes(PangoFontFace* face, int** [sizes], \
-int* [n_sizes])"
- int* ref_sizes = NULL;
- int ref_n_sizes;
- XEN_ASSERT_TYPE(XEN_PangoFontFace__P(face), face, 1, "pango_font_face_list_sizes", "PangoFontFace*");
- pango_font_face_list_sizes(XEN_TO_C_PangoFontFace_(face), &ref_sizes, &ref_n_sizes);
- return(XEN_LIST_2(C_TO_XEN_int_(ref_sizes), C_TO_XEN_int(ref_n_sizes)));
+ #define H_gtk_recent_chooser_get_current_item "GtkRecentInfo* gtk_recent_chooser_get_current_item(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_current_item", "GtkRecentChooser*");
+ return(C_to_Xen_GtkRecentInfo_(gtk_recent_chooser_get_current_item(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_pango_layout_set_auto_dir(XEN layout, XEN auto_dir)
+static Xen gxg_gtk_recent_chooser_select_uri(Xen chooser, Xen uri, Xen ignore_error)
{
- #define H_pango_layout_set_auto_dir "void pango_layout_set_auto_dir(PangoLayout* layout, gboolean auto_dir)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_set_auto_dir", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(auto_dir), auto_dir, 2, "pango_layout_set_auto_dir", "gboolean");
- pango_layout_set_auto_dir(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_gboolean(auto_dir));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_select_uri "gboolean gtk_recent_chooser_select_uri(GtkRecentChooser* chooser, \
+gchar* uri, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_select_uri", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_chooser_select_uri", "gchar*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_recent_chooser_select_uri(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gchar_(uri), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_pango_layout_get_auto_dir(XEN layout)
+static Xen gxg_gtk_recent_chooser_unselect_uri(Xen chooser, Xen uri)
{
- #define H_pango_layout_get_auto_dir "gboolean pango_layout_get_auto_dir(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_auto_dir", "PangoLayout*");
- return(C_TO_XEN_gboolean(pango_layout_get_auto_dir(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_recent_chooser_unselect_uri "void gtk_recent_chooser_unselect_uri(GtkRecentChooser* chooser, \
+gchar* uri)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_unselect_uri", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_chooser_unselect_uri", "gchar*");
+ gtk_recent_chooser_unselect_uri(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_gchar_(uri));
+ return(Xen_false);
}
-static XEN gxg_pango_script_for_unichar(XEN ch)
+static Xen gxg_gtk_recent_chooser_select_all(Xen chooser)
{
- #define H_pango_script_for_unichar "PangoScript pango_script_for_unichar(gunichar ch)"
- XEN_ASSERT_TYPE(XEN_gunichar_P(ch), ch, 1, "pango_script_for_unichar", "gunichar");
- return(C_TO_XEN_PangoScript(pango_script_for_unichar(XEN_TO_C_gunichar(ch))));
+ #define H_gtk_recent_chooser_select_all "void gtk_recent_chooser_select_all(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_select_all", "GtkRecentChooser*");
+ gtk_recent_chooser_select_all(Xen_to_C_GtkRecentChooser_(chooser));
+ return(Xen_false);
}
-static XEN gxg_pango_script_iter_new(XEN text, XEN length)
+static Xen gxg_gtk_recent_chooser_unselect_all(Xen chooser)
{
- #define H_pango_script_iter_new "PangoScriptIter* pango_script_iter_new(char* text, int length)"
- XEN_ASSERT_TYPE(XEN_char__P(text), text, 1, "pango_script_iter_new", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(length), length, 2, "pango_script_iter_new", "int");
- return(C_TO_XEN_PangoScriptIter_(pango_script_iter_new(XEN_TO_C_char_(text), XEN_TO_C_int(length))));
+ #define H_gtk_recent_chooser_unselect_all "void gtk_recent_chooser_unselect_all(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_unselect_all", "GtkRecentChooser*");
+ gtk_recent_chooser_unselect_all(Xen_to_C_GtkRecentChooser_(chooser));
+ return(Xen_false);
}
-static XEN gxg_pango_script_iter_get_range(XEN iter, XEN ignore_start, XEN ignore_end, XEN ignore_script)
+static Xen gxg_gtk_recent_chooser_get_items(Xen chooser)
{
- #define H_pango_script_iter_get_range "void pango_script_iter_get_range(PangoScriptIter* iter, char** [start], \
-char** [end], PangoScript* [script])"
- char* ref_start = NULL;
- char* ref_end = NULL;
- PangoScript ref_script;
- XEN_ASSERT_TYPE(XEN_PangoScriptIter__P(iter), iter, 1, "pango_script_iter_get_range", "PangoScriptIter*");
- pango_script_iter_get_range(XEN_TO_C_PangoScriptIter_(iter), (const char**)&ref_start, (const char**)&ref_end, &ref_script);
- return(XEN_LIST_3(C_TO_XEN_char_(ref_start), C_TO_XEN_char_(ref_end), C_TO_XEN_PangoScript(ref_script)));
+ #define H_gtk_recent_chooser_get_items "GList* gtk_recent_chooser_get_items(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_items", "GtkRecentChooser*");
+ return(C_to_Xen_GList_(gtk_recent_chooser_get_items(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_pango_script_iter_next(XEN iter)
+static Xen gxg_gtk_recent_chooser_get_uris(Xen chooser, Xen ignore_length)
{
- #define H_pango_script_iter_next "gboolean pango_script_iter_next(PangoScriptIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoScriptIter__P(iter), iter, 1, "pango_script_iter_next", "PangoScriptIter*");
- return(C_TO_XEN_gboolean(pango_script_iter_next(XEN_TO_C_PangoScriptIter_(iter))));
+ #define H_gtk_recent_chooser_get_uris "gchar** gtk_recent_chooser_get_uris(GtkRecentChooser* chooser, \
+gsize* [length])"
+ gsize ref_length;
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_uris", "GtkRecentChooser*");
+ {
+ Xen result;
+ result = C_to_Xen_gchar__(gtk_recent_chooser_get_uris(Xen_to_C_GtkRecentChooser_(chooser), &ref_length));
+ return(Xen_list_2(result, C_to_Xen_gsize(ref_length)));
+ }
}
-static XEN gxg_pango_script_iter_free(XEN iter)
+static Xen gxg_gtk_recent_chooser_add_filter(Xen chooser, Xen filter)
{
- #define H_pango_script_iter_free "void pango_script_iter_free(PangoScriptIter* iter)"
- XEN_ASSERT_TYPE(XEN_PangoScriptIter__P(iter), iter, 1, "pango_script_iter_free", "PangoScriptIter*");
- pango_script_iter_free(XEN_TO_C_PangoScriptIter_(iter));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_add_filter "void gtk_recent_chooser_add_filter(GtkRecentChooser* chooser, \
+GtkRecentFilter* filter)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_add_filter", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 2, "gtk_recent_chooser_add_filter", "GtkRecentFilter*");
+ gtk_recent_chooser_add_filter(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_GtkRecentFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_button_new_with_dialog(XEN dialog)
+static Xen gxg_gtk_recent_chooser_remove_filter(Xen chooser, Xen filter)
{
- #define H_gtk_file_chooser_button_new_with_dialog "GtkWidget* gtk_file_chooser_button_new_with_dialog(GtkWidget* dialog)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(dialog), dialog, 1, "gtk_file_chooser_button_new_with_dialog", "GtkWidget*");
- return(C_TO_XEN_GtkWidget_(gtk_file_chooser_button_new_with_dialog(XEN_TO_C_GtkWidget_(dialog))));
+ #define H_gtk_recent_chooser_remove_filter "void gtk_recent_chooser_remove_filter(GtkRecentChooser* chooser, \
+GtkRecentFilter* filter)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_remove_filter", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 2, "gtk_recent_chooser_remove_filter", "GtkRecentFilter*");
+ gtk_recent_chooser_remove_filter(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_GtkRecentFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_button_get_title(XEN button)
+static Xen gxg_gtk_recent_chooser_list_filters(Xen chooser)
{
- #define H_gtk_file_chooser_button_get_title "gchar* gtk_file_chooser_button_get_title(GtkFileChooserButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooserButton__P(button), button, 1, "gtk_file_chooser_button_get_title", "GtkFileChooserButton*");
- return(C_TO_XEN_gchar_(gtk_file_chooser_button_get_title(XEN_TO_C_GtkFileChooserButton_(button))));
+ #define H_gtk_recent_chooser_list_filters "GSList* gtk_recent_chooser_list_filters(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_list_filters", "GtkRecentChooser*");
+ return(C_to_Xen_GSList_(gtk_recent_chooser_list_filters(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_gtk_file_chooser_button_set_title(XEN button, XEN title)
+static Xen gxg_gtk_recent_chooser_set_filter(Xen chooser, Xen filter)
{
- #define H_gtk_file_chooser_button_set_title "void gtk_file_chooser_button_set_title(GtkFileChooserButton* button, \
-gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooserButton__P(button), button, 1, "gtk_file_chooser_button_set_title", "GtkFileChooserButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gtk_file_chooser_button_set_title", "gchar*");
- gtk_file_chooser_button_set_title(XEN_TO_C_GtkFileChooserButton_(button), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_set_filter "void gtk_recent_chooser_set_filter(GtkRecentChooser* chooser, \
+GtkRecentFilter* filter)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_set_filter", "GtkRecentChooser*");
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 2, "gtk_recent_chooser_set_filter", "GtkRecentFilter*");
+ gtk_recent_chooser_set_filter(Xen_to_C_GtkRecentChooser_(chooser), Xen_to_C_GtkRecentFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_gdk_drag_drop_succeeded(XEN context)
+static Xen gxg_gtk_recent_chooser_get_filter(Xen chooser)
{
- #define H_gdk_drag_drop_succeeded "gboolean gdk_drag_drop_succeeded(GdkDragContext* context)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_drop_succeeded", "GdkDragContext*");
- return(C_TO_XEN_gboolean(gdk_drag_drop_succeeded(XEN_TO_C_GdkDragContext_(context))));
+ #define H_gtk_recent_chooser_get_filter "GtkRecentFilter* gtk_recent_chooser_get_filter(GtkRecentChooser* chooser)"
+ Xen_check_type(Xen_is_GtkRecentChooser_(chooser), chooser, 1, "gtk_recent_chooser_get_filter", "GtkRecentChooser*");
+ return(C_to_Xen_GtkRecentFilter_(gtk_recent_chooser_get_filter(Xen_to_C_GtkRecentChooser_(chooser))));
}
-static XEN gxg_gtk_action_set_sensitive(XEN action, XEN sensitive)
+static Xen gxg_gtk_recent_chooser_menu_new(void)
{
- #define H_gtk_action_set_sensitive "void gtk_action_set_sensitive(GtkAction* action, gboolean sensitive)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_sensitive", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(sensitive), sensitive, 2, "gtk_action_set_sensitive", "gboolean");
- gtk_action_set_sensitive(XEN_TO_C_GtkAction_(action), XEN_TO_C_gboolean(sensitive));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_menu_new "GtkWidget* gtk_recent_chooser_menu_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_recent_chooser_menu_new()));
}
-static XEN gxg_gtk_action_set_visible(XEN action, XEN visible)
+static Xen gxg_gtk_recent_chooser_menu_new_for_manager(Xen manager)
{
- #define H_gtk_action_set_visible "void gtk_action_set_visible(GtkAction* action, gboolean visible)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_visible", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible), visible, 2, "gtk_action_set_visible", "gboolean");
- gtk_action_set_visible(XEN_TO_C_GtkAction_(action), XEN_TO_C_gboolean(visible));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_menu_new_for_manager "GtkWidget* gtk_recent_chooser_menu_new_for_manager(GtkRecentManager* manager)"
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_chooser_menu_new_for_manager", "GtkRecentManager*");
+ return(C_to_Xen_GtkWidget_(gtk_recent_chooser_menu_new_for_manager(Xen_to_C_GtkRecentManager_(manager))));
}
-static XEN gxg_gtk_combo_box_get_focus_on_click(XEN combo)
+static Xen gxg_gtk_recent_chooser_menu_get_show_numbers(Xen menu)
{
- #define H_gtk_combo_box_get_focus_on_click "gboolean gtk_combo_box_get_focus_on_click(GtkComboBox* combo)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo), combo, 1, "gtk_combo_box_get_focus_on_click", "GtkComboBox*");
- return(C_TO_XEN_gboolean(gtk_combo_box_get_focus_on_click(XEN_TO_C_GtkComboBox_(combo))));
+ #define H_gtk_recent_chooser_menu_get_show_numbers "gboolean gtk_recent_chooser_menu_get_show_numbers(GtkRecentChooserMenu* menu)"
+ Xen_check_type(Xen_is_GtkRecentChooserMenu_(menu), menu, 1, "gtk_recent_chooser_menu_get_show_numbers", "GtkRecentChooserMenu*");
+ return(C_to_Xen_gboolean(gtk_recent_chooser_menu_get_show_numbers(Xen_to_C_GtkRecentChooserMenu_(menu))));
}
-static XEN gxg_gtk_combo_box_set_focus_on_click(XEN combo, XEN focus_on_click)
+static Xen gxg_gtk_recent_chooser_menu_set_show_numbers(Xen menu, Xen show_numbers)
{
- #define H_gtk_combo_box_set_focus_on_click "void gtk_combo_box_set_focus_on_click(GtkComboBox* combo, \
-gboolean focus_on_click)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo), combo, 1, "gtk_combo_box_set_focus_on_click", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(focus_on_click), focus_on_click, 2, "gtk_combo_box_set_focus_on_click", "gboolean");
- gtk_combo_box_set_focus_on_click(XEN_TO_C_GtkComboBox_(combo), XEN_TO_C_gboolean(focus_on_click));
- return(XEN_FALSE);
+ #define H_gtk_recent_chooser_menu_set_show_numbers "void gtk_recent_chooser_menu_set_show_numbers(GtkRecentChooserMenu* menu, \
+gboolean show_numbers)"
+ Xen_check_type(Xen_is_GtkRecentChooserMenu_(menu), menu, 1, "gtk_recent_chooser_menu_set_show_numbers", "GtkRecentChooserMenu*");
+ Xen_check_type(Xen_is_gboolean(show_numbers), show_numbers, 2, "gtk_recent_chooser_menu_set_show_numbers", "gboolean");
+ gtk_recent_chooser_menu_set_show_numbers(Xen_to_C_GtkRecentChooserMenu_(menu), Xen_to_C_gboolean(show_numbers));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_layout_index_to_text_index(XEN entry, XEN layout_index)
+static Xen gxg_gtk_recent_chooser_widget_new(void)
{
- #define H_gtk_entry_layout_index_to_text_index "gint gtk_entry_layout_index_to_text_index(GtkEntry* entry, \
-gint layout_index)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_layout_index_to_text_index", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(layout_index), layout_index, 2, "gtk_entry_layout_index_to_text_index", "gint");
- return(C_TO_XEN_gint(gtk_entry_layout_index_to_text_index(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gint(layout_index))));
+ #define H_gtk_recent_chooser_widget_new "GtkWidget* gtk_recent_chooser_widget_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_recent_chooser_widget_new()));
}
-static XEN gxg_gtk_entry_text_index_to_layout_index(XEN entry, XEN text_index)
+static Xen gxg_gtk_recent_chooser_widget_new_for_manager(Xen manager)
{
- #define H_gtk_entry_text_index_to_layout_index "gint gtk_entry_text_index_to_layout_index(GtkEntry* entry, \
-gint text_index)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_text_index_to_layout_index", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(text_index), text_index, 2, "gtk_entry_text_index_to_layout_index", "gint");
- return(C_TO_XEN_gint(gtk_entry_text_index_to_layout_index(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gint(text_index))));
+ #define H_gtk_recent_chooser_widget_new_for_manager "GtkWidget* gtk_recent_chooser_widget_new_for_manager(GtkRecentManager* manager)"
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_chooser_widget_new_for_manager", "GtkRecentManager*");
+ return(C_to_Xen_GtkWidget_(gtk_recent_chooser_widget_new_for_manager(Xen_to_C_GtkRecentManager_(manager))));
}
-static XEN gxg_gtk_file_chooser_set_show_hidden(XEN chooser, XEN show_hidden)
+static Xen gxg_gtk_recent_filter_new(void)
{
- #define H_gtk_file_chooser_set_show_hidden "void gtk_file_chooser_set_show_hidden(GtkFileChooser* chooser, \
-gboolean show_hidden)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_show_hidden", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_hidden), show_hidden, 2, "gtk_file_chooser_set_show_hidden", "gboolean");
- gtk_file_chooser_set_show_hidden(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gboolean(show_hidden));
- return(XEN_FALSE);
+ #define H_gtk_recent_filter_new "GtkRecentFilter* gtk_recent_filter_new( void)"
+ return(C_to_Xen_GtkRecentFilter_(gtk_recent_filter_new()));
}
-static XEN gxg_gtk_file_chooser_get_show_hidden(XEN chooser)
+static Xen gxg_gtk_recent_filter_set_name(Xen filter, Xen name)
{
- #define H_gtk_file_chooser_get_show_hidden "gboolean gtk_file_chooser_get_show_hidden(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_show_hidden", "GtkFileChooser*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_get_show_hidden(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_recent_filter_set_name "void gtk_recent_filter_set_name(GtkRecentFilter* filter, gchar* name)"
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 1, "gtk_recent_filter_set_name", "GtkRecentFilter*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_recent_filter_set_name", "gchar*");
+ gtk_recent_filter_set_name(Xen_to_C_GtkRecentFilter_(filter), Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_hover_expand(XEN tree_view, XEN expand)
+static Xen gxg_gtk_recent_filter_get_name(Xen filter)
{
- #define H_gtk_tree_view_set_hover_expand "void gtk_tree_view_set_hover_expand(GtkTreeView* tree_view, \
-gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_hover_expand", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 2, "gtk_tree_view_set_hover_expand", "gboolean");
- gtk_tree_view_set_hover_expand(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_gtk_recent_filter_get_name "gchar* gtk_recent_filter_get_name(GtkRecentFilter* filter)"
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 1, "gtk_recent_filter_get_name", "GtkRecentFilter*");
+ return(C_to_Xen_gchar_((gchar*)gtk_recent_filter_get_name(Xen_to_C_GtkRecentFilter_(filter))));
}
-static XEN gxg_gtk_tree_view_get_hover_expand(XEN tree_view)
+static Xen gxg_gtk_recent_filter_add_mime_type(Xen filter, Xen mime_type)
{
- #define H_gtk_tree_view_get_hover_expand "gboolean gtk_tree_view_get_hover_expand(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_hover_expand", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_hover_expand(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_recent_filter_add_mime_type "void gtk_recent_filter_add_mime_type(GtkRecentFilter* filter, \
+gchar* mime_type)"
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 1, "gtk_recent_filter_add_mime_type", "GtkRecentFilter*");
+ Xen_check_type(Xen_is_gchar_(mime_type), mime_type, 2, "gtk_recent_filter_add_mime_type", "gchar*");
+ gtk_recent_filter_add_mime_type(Xen_to_C_GtkRecentFilter_(filter), Xen_to_C_gchar_(mime_type));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_rebuild_menu(XEN tool_item)
+static Xen gxg_gtk_recent_filter_add_pattern(Xen filter, Xen pattern)
{
- #define H_gtk_tool_item_rebuild_menu "void gtk_tool_item_rebuild_menu(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_rebuild_menu", "GtkToolItem*");
- gtk_tool_item_rebuild_menu(XEN_TO_C_GtkToolItem_(tool_item));
- return(XEN_FALSE);
+ #define H_gtk_recent_filter_add_pattern "void gtk_recent_filter_add_pattern(GtkRecentFilter* filter, \
+gchar* pattern)"
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 1, "gtk_recent_filter_add_pattern", "GtkRecentFilter*");
+ Xen_check_type(Xen_is_gchar_(pattern), pattern, 2, "gtk_recent_filter_add_pattern", "gchar*");
+ gtk_recent_filter_add_pattern(Xen_to_C_GtkRecentFilter_(filter), Xen_to_C_gchar_(pattern));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_tool_button_new(XEN icon_widget, XEN label)
+static Xen gxg_gtk_recent_filter_add_pixbuf_formats(Xen filter)
{
- #define H_gtk_menu_tool_button_new "GtkToolItem* gtk_menu_tool_button_new(GtkWidget* icon_widget, gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(icon_widget) || XEN_FALSE_P(icon_widget), icon_widget, 1, "gtk_menu_tool_button_new", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_menu_tool_button_new", "gchar*");
- return(C_TO_XEN_GtkToolItem_(gtk_menu_tool_button_new(XEN_TO_C_GtkWidget_(icon_widget), XEN_TO_C_gchar_(label))));
+ #define H_gtk_recent_filter_add_pixbuf_formats "void gtk_recent_filter_add_pixbuf_formats(GtkRecentFilter* filter)"
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 1, "gtk_recent_filter_add_pixbuf_formats", "GtkRecentFilter*");
+ gtk_recent_filter_add_pixbuf_formats(Xen_to_C_GtkRecentFilter_(filter));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_tool_button_new_from_stock(XEN stock_id)
+static Xen gxg_gtk_recent_filter_add_application(Xen filter, Xen application)
{
- #define H_gtk_menu_tool_button_new_from_stock "GtkToolItem* gtk_menu_tool_button_new_from_stock(gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_menu_tool_button_new_from_stock", "gchar*");
- return(C_TO_XEN_GtkToolItem_(gtk_menu_tool_button_new_from_stock(XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_recent_filter_add_application "void gtk_recent_filter_add_application(GtkRecentFilter* filter, \
+gchar* application)"
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 1, "gtk_recent_filter_add_application", "GtkRecentFilter*");
+ Xen_check_type(Xen_is_gchar_(application), application, 2, "gtk_recent_filter_add_application", "gchar*");
+ gtk_recent_filter_add_application(Xen_to_C_GtkRecentFilter_(filter), Xen_to_C_gchar_(application));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_tool_button_set_menu(XEN button, XEN menu)
+static Xen gxg_gtk_recent_filter_add_group(Xen filter, Xen group)
{
- #define H_gtk_menu_tool_button_set_menu "void gtk_menu_tool_button_set_menu(GtkMenuToolButton* button, \
-GtkWidget* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenuToolButton__P(button), button, 1, "gtk_menu_tool_button_set_menu", "GtkMenuToolButton*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(menu), menu, 2, "gtk_menu_tool_button_set_menu", "GtkWidget*");
- gtk_menu_tool_button_set_menu(XEN_TO_C_GtkMenuToolButton_(button), XEN_TO_C_GtkWidget_(menu));
- return(XEN_FALSE);
+ #define H_gtk_recent_filter_add_group "void gtk_recent_filter_add_group(GtkRecentFilter* filter, gchar* group)"
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 1, "gtk_recent_filter_add_group", "GtkRecentFilter*");
+ Xen_check_type(Xen_is_gchar_(group), group, 2, "gtk_recent_filter_add_group", "gchar*");
+ gtk_recent_filter_add_group(Xen_to_C_GtkRecentFilter_(filter), Xen_to_C_gchar_(group));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_tool_button_get_menu(XEN button)
+static Xen gxg_gtk_recent_filter_add_age(Xen filter, Xen days)
{
- #define H_gtk_menu_tool_button_get_menu "GtkWidget* gtk_menu_tool_button_get_menu(GtkMenuToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkMenuToolButton__P(button), button, 1, "gtk_menu_tool_button_get_menu", "GtkMenuToolButton*");
- return(C_TO_XEN_GtkWidget_(gtk_menu_tool_button_get_menu(XEN_TO_C_GtkMenuToolButton_(button))));
+ #define H_gtk_recent_filter_add_age "void gtk_recent_filter_add_age(GtkRecentFilter* filter, gint days)"
+ Xen_check_type(Xen_is_GtkRecentFilter_(filter), filter, 1, "gtk_recent_filter_add_age", "GtkRecentFilter*");
+ Xen_check_type(Xen_is_gint(days), days, 2, "gtk_recent_filter_add_age", "gint");
+ gtk_recent_filter_add_age(Xen_to_C_GtkRecentFilter_(filter), Xen_to_C_gint(days));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_supports_clipboard_persistence(XEN display)
+static Xen gxg_gtk_recent_manager_error_quark(void)
{
- #define H_gdk_display_supports_clipboard_persistence "gboolean gdk_display_supports_clipboard_persistence(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_supports_clipboard_persistence", "GdkDisplay*");
- return(C_TO_XEN_gboolean(gdk_display_supports_clipboard_persistence(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_recent_manager_error_quark "GQuark gtk_recent_manager_error_quark( void)"
+ return(C_to_Xen_GQuark(gtk_recent_manager_error_quark()));
}
-static XEN gxg_gtk_about_dialog_get_logo_icon_name(XEN about)
+static Xen gxg_gtk_recent_manager_new(void)
{
- #define H_gtk_about_dialog_get_logo_icon_name "gchar* gtk_about_dialog_get_logo_icon_name(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_logo_icon_name", "GtkAboutDialog*");
- return(C_TO_XEN_gchar_(gtk_about_dialog_get_logo_icon_name(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_recent_manager_new "GtkRecentManager* gtk_recent_manager_new( void)"
+ return(C_to_Xen_GtkRecentManager_(gtk_recent_manager_new()));
}
-static XEN gxg_gtk_about_dialog_set_logo_icon_name(XEN about, XEN icon_name)
+static Xen gxg_gtk_recent_manager_get_default(void)
{
- #define H_gtk_about_dialog_set_logo_icon_name "void gtk_about_dialog_set_logo_icon_name(GtkAboutDialog* about, \
-gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_logo_icon_name", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_about_dialog_set_logo_icon_name", "gchar*");
- gtk_about_dialog_set_logo_icon_name(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gchar_(icon_name));
- return(XEN_FALSE);
+ #define H_gtk_recent_manager_get_default "GtkRecentManager* gtk_recent_manager_get_default( void)"
+ return(C_to_Xen_GtkRecentManager_(gtk_recent_manager_get_default()));
}
-static XEN gxg_gtk_accelerator_get_label(XEN accelerator_key, XEN accelerator_mods)
+static Xen gxg_gtk_recent_manager_remove_item(Xen manager, Xen uri, Xen ignore_error)
{
- #define H_gtk_accelerator_get_label "gchar* gtk_accelerator_get_label(guint accelerator_key, GdkModifierType accelerator_mods)"
- XEN_ASSERT_TYPE(XEN_guint_P(accelerator_key), accelerator_key, 1, "gtk_accelerator_get_label", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(accelerator_mods), accelerator_mods, 2, "gtk_accelerator_get_label", "GdkModifierType");
+ #define H_gtk_recent_manager_remove_item "gboolean gtk_recent_manager_remove_item(GtkRecentManager* manager, \
+gchar* uri, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_manager_remove_item", "GtkRecentManager*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_manager_remove_item", "gchar*");
{
- gchar* result;
- XEN rtn;
- result = gtk_accelerator_get_label(XEN_TO_C_guint(accelerator_key), XEN_TO_C_GdkModifierType(accelerator_mods));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
-}
-
-static XEN gxg_gtk_clipboard_wait_is_target_available(XEN clipboard, XEN target)
-{
- #define H_gtk_clipboard_wait_is_target_available "gboolean gtk_clipboard_wait_is_target_available(GtkClipboard* clipboard, \
-GdkAtom target)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_is_target_available", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 2, "gtk_clipboard_wait_is_target_available", "GdkAtom");
- return(C_TO_XEN_gboolean(gtk_clipboard_wait_is_target_available(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GdkAtom(target))));
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_recent_manager_remove_item(Xen_to_C_GtkRecentManager_(manager), Xen_to_C_gchar_(uri),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_clipboard_set_can_store(XEN clipboard, XEN targets, XEN n_targets)
+static Xen gxg_gtk_recent_manager_lookup_item(Xen manager, Xen uri, Xen ignore_error)
{
- #define H_gtk_clipboard_set_can_store "void gtk_clipboard_set_can_store(GtkClipboard* clipboard, GtkTargetEntry* targets, \
-gint n_targets)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_set_can_store", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets) || XEN_FALSE_P(targets), targets, 2, "gtk_clipboard_set_can_store", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 3, "gtk_clipboard_set_can_store", "gint");
- gtk_clipboard_set_can_store(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkTargetEntry_(targets), XEN_TO_C_gint(n_targets));
- return(XEN_FALSE);
+ #define H_gtk_recent_manager_lookup_item "GtkRecentInfo* gtk_recent_manager_lookup_item(GtkRecentManager* manager, \
+gchar* uri, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_manager_lookup_item", "GtkRecentManager*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_manager_lookup_item", "gchar*");
+ {
+ Xen result;
+ result = C_to_Xen_GtkRecentInfo_(gtk_recent_manager_lookup_item(Xen_to_C_GtkRecentManager_(manager), Xen_to_C_gchar_(uri),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_clipboard_store(XEN clipboard)
+static Xen gxg_gtk_recent_manager_has_item(Xen manager, Xen uri)
{
- #define H_gtk_clipboard_store "void gtk_clipboard_store(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_store", "GtkClipboard*");
- gtk_clipboard_store(XEN_TO_C_GtkClipboard_(clipboard));
- return(XEN_FALSE);
+ #define H_gtk_recent_manager_has_item "gboolean gtk_recent_manager_has_item(GtkRecentManager* manager, \
+gchar* uri)"
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_manager_has_item", "GtkRecentManager*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_manager_has_item", "gchar*");
+ return(C_to_Xen_gboolean(gtk_recent_manager_has_item(Xen_to_C_GtkRecentManager_(manager), Xen_to_C_gchar_(uri))));
}
-static XEN gxg_gtk_alternative_dialog_button_order(XEN screen)
+static Xen gxg_gtk_recent_manager_move_item(Xen manager, Xen uri, Xen new_uri, Xen ignore_error)
{
- #define H_gtk_alternative_dialog_button_order "gboolean gtk_alternative_dialog_button_order(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen) || XEN_FALSE_P(screen), screen, 1, "gtk_alternative_dialog_button_order", "GdkScreen*");
- return(C_TO_XEN_gboolean(gtk_alternative_dialog_button_order(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_recent_manager_move_item "gboolean gtk_recent_manager_move_item(GtkRecentManager* manager, \
+gchar* uri, gchar* new_uri, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_manager_move_item", "GtkRecentManager*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_manager_move_item", "gchar*");
+ Xen_check_type(Xen_is_gchar_(new_uri), new_uri, 3, "gtk_recent_manager_move_item", "gchar*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_recent_manager_move_item(Xen_to_C_GtkRecentManager_(manager), Xen_to_C_gchar_(uri), Xen_to_C_gchar_(new_uri),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_drag_dest_add_image_targets(XEN widget)
+static Xen gxg_gtk_recent_manager_get_items(Xen manager)
{
- #define H_gtk_drag_dest_add_image_targets "void gtk_drag_dest_add_image_targets(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_add_image_targets", "GtkWidget*");
- gtk_drag_dest_add_image_targets(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_recent_manager_get_items "GList* gtk_recent_manager_get_items(GtkRecentManager* manager)"
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_manager_get_items", "GtkRecentManager*");
+ return(C_to_Xen_GList_(gtk_recent_manager_get_items(Xen_to_C_GtkRecentManager_(manager))));
}
-static XEN gxg_gtk_drag_dest_add_uri_targets(XEN widget)
+static Xen gxg_gtk_recent_manager_purge_items(Xen manager, Xen ignore_error)
{
- #define H_gtk_drag_dest_add_uri_targets "void gtk_drag_dest_add_uri_targets(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_add_uri_targets", "GtkWidget*");
- gtk_drag_dest_add_uri_targets(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_recent_manager_purge_items "gint gtk_recent_manager_purge_items(GtkRecentManager* manager, \
+GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_manager_purge_items", "GtkRecentManager*");
+ {
+ Xen result;
+ result = C_to_Xen_gint(gtk_recent_manager_purge_items(Xen_to_C_GtkRecentManager_(manager), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_drag_source_add_image_targets(XEN widget)
+static Xen gxg_gtk_recent_info_ref(Xen info)
{
- #define H_gtk_drag_source_add_image_targets "void gtk_drag_source_add_image_targets(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_add_image_targets", "GtkWidget*");
- gtk_drag_source_add_image_targets(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_ref "GtkRecentInfo* gtk_recent_info_ref(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_ref", "GtkRecentInfo*");
+ return(C_to_Xen_GtkRecentInfo_(gtk_recent_info_ref(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_drag_source_add_uri_targets(XEN widget)
+static Xen gxg_gtk_recent_info_unref(Xen info)
{
- #define H_gtk_drag_source_add_uri_targets "void gtk_drag_source_add_uri_targets(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_add_uri_targets", "GtkWidget*");
- gtk_drag_source_add_uri_targets(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_unref "void gtk_recent_info_unref(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_unref", "GtkRecentInfo*");
+ gtk_recent_info_unref(Xen_to_C_GtkRecentInfo_(info));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_button_get_width_chars(XEN button)
+static Xen gxg_gtk_recent_info_get_uri(Xen info)
{
- #define H_gtk_file_chooser_button_get_width_chars "gint gtk_file_chooser_button_get_width_chars(GtkFileChooserButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooserButton__P(button), button, 1, "gtk_file_chooser_button_get_width_chars", "GtkFileChooserButton*");
- return(C_TO_XEN_gint(gtk_file_chooser_button_get_width_chars(XEN_TO_C_GtkFileChooserButton_(button))));
+ #define H_gtk_recent_info_get_uri "gchar* gtk_recent_info_get_uri(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_uri", "GtkRecentInfo*");
+ return(C_to_Xen_gchar_(gtk_recent_info_get_uri(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_file_chooser_button_set_width_chars(XEN button, XEN n_chars)
+static Xen gxg_gtk_recent_info_get_display_name(Xen info)
{
- #define H_gtk_file_chooser_button_set_width_chars "void gtk_file_chooser_button_set_width_chars(GtkFileChooserButton* button, \
-gint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooserButton__P(button), button, 1, "gtk_file_chooser_button_set_width_chars", "GtkFileChooserButton*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_chars), n_chars, 2, "gtk_file_chooser_button_set_width_chars", "gint");
- gtk_file_chooser_button_set_width_chars(XEN_TO_C_GtkFileChooserButton_(button), XEN_TO_C_gint(n_chars));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_get_display_name "gchar* gtk_recent_info_get_display_name(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_display_name", "GtkRecentInfo*");
+ return(C_to_Xen_gchar_((gchar*)gtk_recent_info_get_display_name(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_image_new_from_icon_name(XEN icon_name, XEN size)
+static Xen gxg_gtk_recent_info_get_description(Xen info)
{
- #define H_gtk_image_new_from_icon_name "GtkWidget* gtk_image_new_from_icon_name(gchar* icon_name, GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 1, "gtk_image_new_from_icon_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 2, "gtk_image_new_from_icon_name", "GtkIconSize");
- return(C_TO_XEN_GtkWidget_(gtk_image_new_from_icon_name(XEN_TO_C_gchar_(icon_name), XEN_TO_C_GtkIconSize(size))));
+ #define H_gtk_recent_info_get_description "gchar* gtk_recent_info_get_description(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_description", "GtkRecentInfo*");
+ return(C_to_Xen_gchar_((gchar*)gtk_recent_info_get_description(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_image_set_from_icon_name(XEN image, XEN icon_name, XEN size)
+static Xen gxg_gtk_recent_info_get_mime_type(Xen info)
{
- #define H_gtk_image_set_from_icon_name "void gtk_image_set_from_icon_name(GtkImage* image, gchar* icon_name, \
-GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_set_from_icon_name", "GtkImage*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_image_set_from_icon_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 3, "gtk_image_set_from_icon_name", "GtkIconSize");
- gtk_image_set_from_icon_name(XEN_TO_C_GtkImage_(image), XEN_TO_C_gchar_(icon_name), XEN_TO_C_GtkIconSize(size));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_get_mime_type "gchar* gtk_recent_info_get_mime_type(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_mime_type", "GtkRecentInfo*");
+ return(C_to_Xen_gchar_((gchar*)gtk_recent_info_get_mime_type(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_image_set_pixel_size(XEN image, XEN pixel_size)
+static Xen gxg_gtk_recent_info_get_added(Xen info)
{
- #define H_gtk_image_set_pixel_size "void gtk_image_set_pixel_size(GtkImage* image, gint pixel_size)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_set_pixel_size", "GtkImage*");
- XEN_ASSERT_TYPE(XEN_gint_P(pixel_size), pixel_size, 2, "gtk_image_set_pixel_size", "gint");
- gtk_image_set_pixel_size(XEN_TO_C_GtkImage_(image), XEN_TO_C_gint(pixel_size));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_get_added "time_t gtk_recent_info_get_added(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_added", "GtkRecentInfo*");
+ return(C_to_Xen_time_t(gtk_recent_info_get_added(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_image_get_pixel_size(XEN image)
+static Xen gxg_gtk_recent_info_get_modified(Xen info)
{
- #define H_gtk_image_get_pixel_size "gint gtk_image_get_pixel_size(GtkImage* image)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_get_pixel_size", "GtkImage*");
- return(C_TO_XEN_gint(gtk_image_get_pixel_size(XEN_TO_C_GtkImage_(image))));
+ #define H_gtk_recent_info_get_modified "time_t gtk_recent_info_get_modified(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_modified", "GtkRecentInfo*");
+ return(C_to_Xen_time_t(gtk_recent_info_get_modified(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_label_set_width_chars(XEN label, XEN n_chars)
+static Xen gxg_gtk_recent_info_get_visited(Xen info)
{
- #define H_gtk_label_set_width_chars "void gtk_label_set_width_chars(GtkLabel* label, gint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_width_chars", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_chars), n_chars, 2, "gtk_label_set_width_chars", "gint");
- gtk_label_set_width_chars(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gint(n_chars));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_get_visited "time_t gtk_recent_info_get_visited(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_visited", "GtkRecentInfo*");
+ return(C_to_Xen_time_t(gtk_recent_info_get_visited(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_label_get_width_chars(XEN label)
+static Xen gxg_gtk_recent_info_get_private_hint(Xen info)
{
- #define H_gtk_label_get_width_chars "gint gtk_label_get_width_chars(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_width_chars", "GtkLabel*");
- return(C_TO_XEN_gint(gtk_label_get_width_chars(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_recent_info_get_private_hint "gboolean gtk_recent_info_get_private_hint(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_private_hint", "GtkRecentInfo*");
+ return(C_to_Xen_gboolean(gtk_recent_info_get_private_hint(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_target_list_add_text_targets(XEN list, XEN info)
+static Xen gxg_gtk_recent_info_get_applications(Xen info, Xen ignore_length)
{
- #define H_gtk_target_list_add_text_targets "void gtk_target_list_add_text_targets(GtkTargetList* list, \
-guint info)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_add_text_targets", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_guint_P(info), info, 2, "gtk_target_list_add_text_targets", "guint");
- gtk_target_list_add_text_targets(XEN_TO_C_GtkTargetList_(list), XEN_TO_C_guint(info));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_get_applications "gchar** gtk_recent_info_get_applications(GtkRecentInfo* info, \
+gsize* [length])"
+ gsize ref_length;
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_applications", "GtkRecentInfo*");
+ {
+ Xen result;
+ result = C_to_Xen_gchar__(gtk_recent_info_get_applications(Xen_to_C_GtkRecentInfo_(info), &ref_length));
+ return(Xen_list_2(result, C_to_Xen_gsize(ref_length)));
+ }
}
-static XEN gxg_gtk_target_list_add_image_targets(XEN list, XEN info, XEN writable)
+static Xen gxg_gtk_recent_info_last_application(Xen info)
{
- #define H_gtk_target_list_add_image_targets "void gtk_target_list_add_image_targets(GtkTargetList* list, \
-guint info, gboolean writable)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_add_image_targets", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_guint_P(info), info, 2, "gtk_target_list_add_image_targets", "guint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(writable), writable, 3, "gtk_target_list_add_image_targets", "gboolean");
- gtk_target_list_add_image_targets(XEN_TO_C_GtkTargetList_(list), XEN_TO_C_guint(info), XEN_TO_C_gboolean(writable));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_last_application "gchar* gtk_recent_info_last_application(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_last_application", "GtkRecentInfo*");
+ return(C_to_Xen_gchar_(gtk_recent_info_last_application(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_target_list_add_uri_targets(XEN list, XEN info)
+static Xen gxg_gtk_recent_info_has_application(Xen info, Xen app_name)
{
- #define H_gtk_target_list_add_uri_targets "void gtk_target_list_add_uri_targets(GtkTargetList* list, \
-guint info)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_add_uri_targets", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_guint_P(info), info, 2, "gtk_target_list_add_uri_targets", "guint");
- gtk_target_list_add_uri_targets(XEN_TO_C_GtkTargetList_(list), XEN_TO_C_guint(info));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_has_application "gboolean gtk_recent_info_has_application(GtkRecentInfo* info, \
+gchar* app_name)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_has_application", "GtkRecentInfo*");
+ Xen_check_type(Xen_is_gchar_(app_name), app_name, 2, "gtk_recent_info_has_application", "gchar*");
+ return(C_to_Xen_gboolean(gtk_recent_info_has_application(Xen_to_C_GtkRecentInfo_(info), Xen_to_C_gchar_(app_name))));
}
-static XEN gxg_gtk_selection_data_set_pixbuf(XEN selection_data, XEN pixbuf)
+static Xen gxg_gtk_recent_info_get_groups(Xen info, Xen ignore_length)
{
- #define H_gtk_selection_data_set_pixbuf "gboolean gtk_selection_data_set_pixbuf(GtkSelectionData* selection_data, \
-GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_set_pixbuf", "GtkSelectionData*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gtk_selection_data_set_pixbuf", "GdkPixbuf*");
- return(C_TO_XEN_gboolean(gtk_selection_data_set_pixbuf(XEN_TO_C_GtkSelectionData_(selection_data), XEN_TO_C_GdkPixbuf_(pixbuf))));
+ #define H_gtk_recent_info_get_groups "gchar** gtk_recent_info_get_groups(GtkRecentInfo* info, gsize* [length])"
+ gsize ref_length;
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_groups", "GtkRecentInfo*");
+ {
+ Xen result;
+ result = C_to_Xen_gchar__(gtk_recent_info_get_groups(Xen_to_C_GtkRecentInfo_(info), &ref_length));
+ return(Xen_list_2(result, C_to_Xen_gsize(ref_length)));
+ }
}
-static XEN gxg_gtk_selection_data_get_pixbuf(XEN selection_data)
+static Xen gxg_gtk_recent_info_has_group(Xen info, Xen group_name)
{
- #define H_gtk_selection_data_get_pixbuf "GdkPixbuf* gtk_selection_data_get_pixbuf(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_pixbuf", "GtkSelectionData*");
- return(C_TO_XEN_GdkPixbuf_(gtk_selection_data_get_pixbuf(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_recent_info_has_group "gboolean gtk_recent_info_has_group(GtkRecentInfo* info, gchar* group_name)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_has_group", "GtkRecentInfo*");
+ Xen_check_type(Xen_is_gchar_(group_name), group_name, 2, "gtk_recent_info_has_group", "gchar*");
+ return(C_to_Xen_gboolean(gtk_recent_info_has_group(Xen_to_C_GtkRecentInfo_(info), Xen_to_C_gchar_(group_name))));
}
-static XEN gxg_gtk_selection_data_set_uris(XEN selection_data, XEN uris)
+static Xen gxg_gtk_recent_info_get_icon(Xen info, Xen size)
{
- #define H_gtk_selection_data_set_uris "gboolean gtk_selection_data_set_uris(GtkSelectionData* selection_data, \
-gchar** uris)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_set_uris", "GtkSelectionData*");
- XEN_ASSERT_TYPE(XEN_gchar___P(uris), uris, 2, "gtk_selection_data_set_uris", "gchar**");
- return(C_TO_XEN_gboolean(gtk_selection_data_set_uris(XEN_TO_C_GtkSelectionData_(selection_data), XEN_TO_C_gchar__(uris))));
+ #define H_gtk_recent_info_get_icon "GdkPixbuf* gtk_recent_info_get_icon(GtkRecentInfo* info, gint size)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_icon", "GtkRecentInfo*");
+ Xen_check_type(Xen_is_gint(size), size, 2, "gtk_recent_info_get_icon", "gint");
+ return(C_to_Xen_GdkPixbuf_(gtk_recent_info_get_icon(Xen_to_C_GtkRecentInfo_(info), Xen_to_C_gint(size))));
}
-static XEN gxg_gtk_selection_data_get_uris(XEN selection_data)
+static Xen gxg_gtk_recent_info_get_short_name(Xen info)
{
- #define H_gtk_selection_data_get_uris "gchar** gtk_selection_data_get_uris(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_uris", "GtkSelectionData*");
- return(C_TO_XEN_gchar__(gtk_selection_data_get_uris(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_recent_info_get_short_name "gchar* gtk_recent_info_get_short_name(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_short_name", "GtkRecentInfo*");
+ return(C_to_Xen_gchar_(gtk_recent_info_get_short_name(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_text_buffer_backspace(XEN buffer, XEN iter, XEN interactive, XEN default_editable)
+static Xen gxg_gtk_recent_info_get_uri_display(Xen info)
{
- #define H_gtk_text_buffer_backspace "gboolean gtk_text_buffer_backspace(GtkTextBuffer* buffer, GtkTextIter* iter, \
-gboolean interactive, gboolean default_editable)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_backspace", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_buffer_backspace", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(interactive), interactive, 3, "gtk_text_buffer_backspace", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(default_editable), default_editable, 4, "gtk_text_buffer_backspace", "gboolean");
- return(C_TO_XEN_gboolean(gtk_text_buffer_backspace(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gboolean(interactive),
- XEN_TO_C_gboolean(default_editable))));
+ #define H_gtk_recent_info_get_uri_display "gchar* gtk_recent_info_get_uri_display(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_uri_display", "GtkRecentInfo*");
+ return(C_to_Xen_gchar_(gtk_recent_info_get_uri_display(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_clipboard_set_image(XEN clipboard, XEN pixbuf)
+static Xen gxg_gtk_recent_info_get_age(Xen info)
{
- #define H_gtk_clipboard_set_image "void gtk_clipboard_set_image(GtkClipboard* clipboard, GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_set_image", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gtk_clipboard_set_image", "GdkPixbuf*");
- gtk_clipboard_set_image(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_recent_info_get_age "gint gtk_recent_info_get_age(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_get_age", "GtkRecentInfo*");
+ return(C_to_Xen_gint(gtk_recent_info_get_age(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_clipboard_request_image(XEN clipboard, XEN func, XEN func_info)
+static Xen gxg_gtk_recent_info_is_local(Xen info)
{
- #define H_gtk_clipboard_request_image "void gtk_clipboard_request_image(GtkClipboard* clipboard, GtkClipboardImageReceivedFunc func, \
-lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_request_image", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkClipboardImageReceivedFunc_P(func), func, 2, "gtk_clipboard_request_image", "GtkClipboardImageReceivedFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_clipboard_request_image", "lambda_data");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- gtk_clipboard_request_image(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkClipboardImageReceivedFunc(func), XEN_TO_C_lambda_data(func_info));
- return(XEN_FALSE);
- }
+ #define H_gtk_recent_info_is_local "gboolean gtk_recent_info_is_local(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_is_local", "GtkRecentInfo*");
+ return(C_to_Xen_gboolean(gtk_recent_info_is_local(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_clipboard_wait_for_image(XEN clipboard)
+static Xen gxg_gtk_recent_info_exists(Xen info)
{
- #define H_gtk_clipboard_wait_for_image "GdkPixbuf* gtk_clipboard_wait_for_image(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_for_image", "GtkClipboard*");
- return(C_TO_XEN_GdkPixbuf_(gtk_clipboard_wait_for_image(XEN_TO_C_GtkClipboard_(clipboard))));
+ #define H_gtk_recent_info_exists "gboolean gtk_recent_info_exists(GtkRecentInfo* info)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info), info, 1, "gtk_recent_info_exists", "GtkRecentInfo*");
+ return(C_to_Xen_gboolean(gtk_recent_info_exists(Xen_to_C_GtkRecentInfo_(info))));
}
-static XEN gxg_gtk_clipboard_wait_is_image_available(XEN clipboard)
+static Xen gxg_gtk_recent_info_match(Xen info_a, Xen info_b)
{
- #define H_gtk_clipboard_wait_is_image_available "gboolean gtk_clipboard_wait_is_image_available(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_is_image_available", "GtkClipboard*");
- return(C_TO_XEN_gboolean(gtk_clipboard_wait_is_image_available(XEN_TO_C_GtkClipboard_(clipboard))));
+ #define H_gtk_recent_info_match "gboolean gtk_recent_info_match(GtkRecentInfo* info_a, GtkRecentInfo* info_b)"
+ Xen_check_type(Xen_is_GtkRecentInfo_(info_a), info_a, 1, "gtk_recent_info_match", "GtkRecentInfo*");
+ Xen_check_type(Xen_is_GtkRecentInfo_(info_b), info_b, 2, "gtk_recent_info_match", "GtkRecentInfo*");
+ return(C_to_Xen_gboolean(gtk_recent_info_match(Xen_to_C_GtkRecentInfo_(info_a), Xen_to_C_GtkRecentInfo_(info_b))));
}
-static XEN gxg_gtk_file_filter_add_pixbuf_formats(XEN filter)
+static Xen gxg_gtk_text_buffer_register_serialize_format(Xen buffer, Xen mime_type, Xen function, Xen user_data, Xen user_data_destroy)
{
- #define H_gtk_file_filter_add_pixbuf_formats "void gtk_file_filter_add_pixbuf_formats(GtkFileFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkFileFilter__P(filter), filter, 1, "gtk_file_filter_add_pixbuf_formats", "GtkFileFilter*");
- gtk_file_filter_add_pixbuf_formats(XEN_TO_C_GtkFileFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_register_serialize_format "GdkAtom gtk_text_buffer_register_serialize_format(GtkTextBuffer* buffer, \
+gchar* mime_type, GtkTextBufferSerializeFunc function, gpointer user_data, GDestroyNotify user_data_destroy)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_register_serialize_format", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(mime_type), mime_type, 2, "gtk_text_buffer_register_serialize_format", "gchar*");
+ Xen_check_type(Xen_is_GtkTextBufferSerializeFunc(function), function, 3, "gtk_text_buffer_register_serialize_format", "GtkTextBufferSerializeFunc");
+ Xen_check_type(Xen_is_gpointer(user_data), user_data, 4, "gtk_text_buffer_register_serialize_format", "gpointer");
+ Xen_check_type(Xen_is_GDestroyNotify(user_data_destroy), user_data_destroy, 5, "gtk_text_buffer_register_serialize_format", "GDestroyNotify");
+ return(C_to_Xen_GdkAtom(gtk_text_buffer_register_serialize_format(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(mime_type),
+ Xen_to_C_GtkTextBufferSerializeFunc(function), Xen_to_C_gpointer(user_data),
+ Xen_to_C_GDestroyNotify(user_data_destroy))));
}
-static XEN gxg_gtk_label_set_single_line_mode(XEN label, XEN single_line_mode)
+static Xen gxg_gtk_text_buffer_register_serialize_tagset(Xen buffer, Xen tagset_name)
{
- #define H_gtk_label_set_single_line_mode "void gtk_label_set_single_line_mode(GtkLabel* label, gboolean single_line_mode)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_single_line_mode", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(single_line_mode), single_line_mode, 2, "gtk_label_set_single_line_mode", "gboolean");
- gtk_label_set_single_line_mode(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gboolean(single_line_mode));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_register_serialize_tagset "GdkAtom gtk_text_buffer_register_serialize_tagset(GtkTextBuffer* buffer, \
+gchar* tagset_name)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_register_serialize_tagset", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(tagset_name), tagset_name, 2, "gtk_text_buffer_register_serialize_tagset", "gchar*");
+ return(C_to_Xen_GdkAtom(gtk_text_buffer_register_serialize_tagset(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(tagset_name))));
}
-static XEN gxg_gtk_label_get_single_line_mode(XEN label)
+static Xen gxg_gtk_text_buffer_register_deserialize_format(Xen buffer, Xen mime_type, Xen function, Xen user_data, Xen user_data_destroy)
{
- #define H_gtk_label_get_single_line_mode "gboolean gtk_label_get_single_line_mode(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_single_line_mode", "GtkLabel*");
- return(C_TO_XEN_gboolean(gtk_label_get_single_line_mode(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_text_buffer_register_deserialize_format "GdkAtom gtk_text_buffer_register_deserialize_format(GtkTextBuffer* buffer, \
+gchar* mime_type, GtkTextBufferDeserializeFunc function, gpointer user_data, GDestroyNotify user_data_destroy)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_register_deserialize_format", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(mime_type), mime_type, 2, "gtk_text_buffer_register_deserialize_format", "gchar*");
+ Xen_check_type(Xen_is_GtkTextBufferDeserializeFunc(function), function, 3, "gtk_text_buffer_register_deserialize_format", "GtkTextBufferDeserializeFunc");
+ Xen_check_type(Xen_is_gpointer(user_data), user_data, 4, "gtk_text_buffer_register_deserialize_format", "gpointer");
+ Xen_check_type(Xen_is_GDestroyNotify(user_data_destroy), user_data_destroy, 5, "gtk_text_buffer_register_deserialize_format", "GDestroyNotify");
+ return(C_to_Xen_GdkAtom(gtk_text_buffer_register_deserialize_format(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(mime_type),
+ Xen_to_C_GtkTextBufferDeserializeFunc(function), Xen_to_C_gpointer(user_data),
+ Xen_to_C_GDestroyNotify(user_data_destroy))));
}
-static XEN gxg_gtk_progress_bar_set_ellipsize(XEN pbar, XEN mode)
+static Xen gxg_gtk_text_buffer_register_deserialize_tagset(Xen buffer, Xen tagset_name)
{
- #define H_gtk_progress_bar_set_ellipsize "void gtk_progress_bar_set_ellipsize(GtkProgressBar* pbar, \
-PangoEllipsizeMode mode)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_set_ellipsize", "GtkProgressBar*");
- XEN_ASSERT_TYPE(XEN_PangoEllipsizeMode_P(mode), mode, 2, "gtk_progress_bar_set_ellipsize", "PangoEllipsizeMode");
- gtk_progress_bar_set_ellipsize(XEN_TO_C_GtkProgressBar_(pbar), XEN_TO_C_PangoEllipsizeMode(mode));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_register_deserialize_tagset "GdkAtom gtk_text_buffer_register_deserialize_tagset(GtkTextBuffer* buffer, \
+gchar* tagset_name)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_register_deserialize_tagset", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_gchar_(tagset_name), tagset_name, 2, "gtk_text_buffer_register_deserialize_tagset", "gchar*");
+ return(C_to_Xen_GdkAtom(gtk_text_buffer_register_deserialize_tagset(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_gchar_(tagset_name))));
}
-static XEN gxg_gtk_progress_bar_get_ellipsize(XEN pbar)
+static Xen gxg_gtk_text_buffer_unregister_serialize_format(Xen buffer, Xen format)
{
- #define H_gtk_progress_bar_get_ellipsize "PangoEllipsizeMode gtk_progress_bar_get_ellipsize(GtkProgressBar* pbar)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_get_ellipsize", "GtkProgressBar*");
- return(C_TO_XEN_PangoEllipsizeMode(gtk_progress_bar_get_ellipsize(XEN_TO_C_GtkProgressBar_(pbar))));
+ #define H_gtk_text_buffer_unregister_serialize_format "void gtk_text_buffer_unregister_serialize_format(GtkTextBuffer* buffer, \
+GdkAtom format)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_unregister_serialize_format", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GdkAtom(format), format, 2, "gtk_text_buffer_unregister_serialize_format", "GdkAtom");
+ gtk_text_buffer_unregister_serialize_format(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GdkAtom(format));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_targets_include_image(XEN selection_data, XEN writable)
+static Xen gxg_gtk_text_buffer_unregister_deserialize_format(Xen buffer, Xen format)
{
- #define H_gtk_selection_data_targets_include_image "gboolean gtk_selection_data_targets_include_image(GtkSelectionData* selection_data, \
-gboolean writable)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_targets_include_image", "GtkSelectionData*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(writable), writable, 2, "gtk_selection_data_targets_include_image", "gboolean");
- return(C_TO_XEN_gboolean(gtk_selection_data_targets_include_image(XEN_TO_C_GtkSelectionData_(selection_data), XEN_TO_C_gboolean(writable))));
+ #define H_gtk_text_buffer_unregister_deserialize_format "void gtk_text_buffer_unregister_deserialize_format(GtkTextBuffer* buffer, \
+GdkAtom format)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_unregister_deserialize_format", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GdkAtom(format), format, 2, "gtk_text_buffer_unregister_deserialize_format", "GdkAtom");
+ gtk_text_buffer_unregister_deserialize_format(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GdkAtom(format));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_set_image(XEN button, XEN image)
+static Xen gxg_gtk_text_buffer_deserialize_set_can_create_tags(Xen buffer, Xen format, Xen can_create_tags)
{
- #define H_gtk_button_set_image "void gtk_button_set_image(GtkButton* button, GtkWidget* image)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_set_image", "GtkButton*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(image), image, 2, "gtk_button_set_image", "GtkWidget*");
- gtk_button_set_image(XEN_TO_C_GtkButton_(button), XEN_TO_C_GtkWidget_(image));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_deserialize_set_can_create_tags "void gtk_text_buffer_deserialize_set_can_create_tags(GtkTextBuffer* buffer, \
+GdkAtom format, gboolean can_create_tags)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_deserialize_set_can_create_tags", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GdkAtom(format), format, 2, "gtk_text_buffer_deserialize_set_can_create_tags", "GdkAtom");
+ Xen_check_type(Xen_is_gboolean(can_create_tags), can_create_tags, 3, "gtk_text_buffer_deserialize_set_can_create_tags", "gboolean");
+ gtk_text_buffer_deserialize_set_can_create_tags(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GdkAtom(format), Xen_to_C_gboolean(can_create_tags));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_get_image(XEN button)
+static Xen gxg_gtk_text_buffer_deserialize_get_can_create_tags(Xen buffer, Xen format)
{
- #define H_gtk_button_get_image "GtkWidget* gtk_button_get_image(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_image", "GtkButton*");
- return(C_TO_XEN_GtkWidget_(gtk_button_get_image(XEN_TO_C_GtkButton_(button))));
+ #define H_gtk_text_buffer_deserialize_get_can_create_tags "gboolean gtk_text_buffer_deserialize_get_can_create_tags(GtkTextBuffer* buffer, \
+GdkAtom format)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_deserialize_get_can_create_tags", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GdkAtom(format), format, 2, "gtk_text_buffer_deserialize_get_can_create_tags", "GdkAtom");
+ return(C_to_Xen_gboolean(gtk_text_buffer_deserialize_get_can_create_tags(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GdkAtom(format))));
}
-static XEN gxg_gtk_dialog_set_alternative_button_order_from_array(XEN dialog, XEN n_params, XEN new_order)
+static Xen gxg_gtk_text_buffer_get_serialize_formats(Xen buffer, Xen ignore_n_formats)
{
- #define H_gtk_dialog_set_alternative_button_order_from_array "void gtk_dialog_set_alternative_button_order_from_array(GtkDialog* dialog, \
-gint n_params, gint* new_order)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_set_alternative_button_order_from_array", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_params), n_params, 2, "gtk_dialog_set_alternative_button_order_from_array", "gint");
- XEN_ASSERT_TYPE(XEN_gint__P(new_order), new_order, 3, "gtk_dialog_set_alternative_button_order_from_array", "gint*");
- gtk_dialog_set_alternative_button_order_from_array(XEN_TO_C_GtkDialog_(dialog), XEN_TO_C_gint(n_params), XEN_TO_C_gint_(new_order));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_serialize_formats "GdkAtom* gtk_text_buffer_get_serialize_formats(GtkTextBuffer* buffer, \
+gint* [n_formats])"
+ gint ref_n_formats;
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_serialize_formats", "GtkTextBuffer*");
+ {
+ Xen result;
+ result = C_to_Xen_GdkAtom_(gtk_text_buffer_get_serialize_formats(Xen_to_C_GtkTextBuffer_(buffer), &ref_n_formats));
+ return(Xen_list_2(result, C_to_Xen_gint(ref_n_formats)));
+ }
}
-static XEN gxg_gtk_label_set_angle(XEN label, XEN angle)
+static Xen gxg_gtk_text_buffer_get_deserialize_formats(Xen buffer, Xen ignore_n_formats)
{
- #define H_gtk_label_set_angle "void gtk_label_set_angle(GtkLabel* label, gdouble angle)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_angle", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(angle), angle, 2, "gtk_label_set_angle", "gdouble");
- gtk_label_set_angle(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gdouble(angle));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_get_deserialize_formats "GdkAtom* gtk_text_buffer_get_deserialize_formats(GtkTextBuffer* buffer, \
+gint* [n_formats])"
+ gint ref_n_formats;
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_get_deserialize_formats", "GtkTextBuffer*");
+ {
+ Xen result;
+ result = C_to_Xen_GdkAtom_(gtk_text_buffer_get_deserialize_formats(Xen_to_C_GtkTextBuffer_(buffer), &ref_n_formats));
+ return(Xen_list_2(result, C_to_Xen_gint(ref_n_formats)));
+ }
}
-static XEN gxg_gtk_label_get_angle(XEN label)
+static Xen gxg_gtk_text_buffer_serialize(Xen register_buffer, Xen content_buffer, Xen format, Xen start, Xen end, Xen ignore_length)
{
- #define H_gtk_label_get_angle "gdouble gtk_label_get_angle(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_angle", "GtkLabel*");
- return(C_TO_XEN_gdouble(gtk_label_get_angle(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_text_buffer_serialize "guint8* gtk_text_buffer_serialize(GtkTextBuffer* register_buffer, \
+GtkTextBuffer* content_buffer, GdkAtom format, GtkTextIter* start, GtkTextIter* end, gsize* [length])"
+ gsize ref_length;
+ Xen_check_type(Xen_is_GtkTextBuffer_(register_buffer), register_buffer, 1, "gtk_text_buffer_serialize", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextBuffer_(content_buffer), content_buffer, 2, "gtk_text_buffer_serialize", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GdkAtom(format), format, 3, "gtk_text_buffer_serialize", "GdkAtom");
+ Xen_check_type(Xen_is_GtkTextIter_(start), start, 4, "gtk_text_buffer_serialize", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(end), end, 5, "gtk_text_buffer_serialize", "GtkTextIter*");
+ {
+ Xen result;
+ result = C_to_Xen_guint8_(gtk_text_buffer_serialize(Xen_to_C_GtkTextBuffer_(register_buffer), Xen_to_C_GtkTextBuffer_(content_buffer),
+ Xen_to_C_GdkAtom(format), Xen_to_C_GtkTextIter_(start), Xen_to_C_GtkTextIter_(end),
+ &ref_length));
+ return(Xen_list_2(result, C_to_Xen_gsize(ref_length)));
+ }
}
-static XEN gxg_gtk_menu_set_screen(XEN menu, XEN screen)
+static Xen gxg_gtk_text_buffer_deserialize(Xen register_buffer, Xen content_buffer, Xen format, Xen iter, Xen data, Xen length, Xen ignore_error)
{
- #define H_gtk_menu_set_screen "void gtk_menu_set_screen(GtkMenu* menu, GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_set_screen", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen) || XEN_FALSE_P(screen), screen, 2, "gtk_menu_set_screen", "GdkScreen*");
- gtk_menu_set_screen(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_GdkScreen_(screen));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_deserialize "gboolean gtk_text_buffer_deserialize(GtkTextBuffer* register_buffer, \
+GtkTextBuffer* content_buffer, GdkAtom format, GtkTextIter* iter, guint8* data, gsize length, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkTextBuffer_(register_buffer), register_buffer, 1, "gtk_text_buffer_deserialize", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextBuffer_(content_buffer), content_buffer, 2, "gtk_text_buffer_deserialize", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GdkAtom(format), format, 3, "gtk_text_buffer_deserialize", "GdkAtom");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 4, "gtk_text_buffer_deserialize", "GtkTextIter*");
+ Xen_check_type(Xen_is_guint8_(data), data, 5, "gtk_text_buffer_deserialize", "guint8*");
+ Xen_check_type(Xen_is_gsize(length), length, 6, "gtk_text_buffer_deserialize", "gsize");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_text_buffer_deserialize(Xen_to_C_GtkTextBuffer_(register_buffer), Xen_to_C_GtkTextBuffer_(content_buffer),
+ Xen_to_C_GdkAtom(format), Xen_to_C_GtkTextIter_(iter), Xen_to_C_guint8_(data),
+ Xen_to_C_gsize(length), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_pango_attr_underline_color_new(XEN red, XEN green, XEN blue)
+static Xen gxg_gtk_recent_manager_add_item(Xen manager, Xen uri)
{
- #define H_pango_attr_underline_color_new "PangoAttribute* pango_attr_underline_color_new(guint16 red, \
-guint16 green, guint16 blue)"
- XEN_ASSERT_TYPE(XEN_guint16_P(red), red, 1, "pango_attr_underline_color_new", "guint16");
- XEN_ASSERT_TYPE(XEN_guint16_P(green), green, 2, "pango_attr_underline_color_new", "guint16");
- XEN_ASSERT_TYPE(XEN_guint16_P(blue), blue, 3, "pango_attr_underline_color_new", "guint16");
- return(C_TO_XEN_PangoAttribute_(pango_attr_underline_color_new(XEN_TO_C_guint16(red), XEN_TO_C_guint16(green), XEN_TO_C_guint16(blue))));
+ #define H_gtk_recent_manager_add_item "gboolean gtk_recent_manager_add_item(GtkRecentManager* manager, \
+gchar* uri)"
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_manager_add_item", "GtkRecentManager*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_manager_add_item", "gchar*");
+ return(C_to_Xen_gboolean(gtk_recent_manager_add_item(Xen_to_C_GtkRecentManager_(manager), Xen_to_C_gchar_(uri))));
}
-static XEN gxg_pango_attr_strikethrough_color_new(XEN red, XEN green, XEN blue)
+static Xen gxg_gtk_recent_manager_add_full(Xen manager, Xen uri, Xen recent_data)
{
- #define H_pango_attr_strikethrough_color_new "PangoAttribute* pango_attr_strikethrough_color_new(guint16 red, \
-guint16 green, guint16 blue)"
- XEN_ASSERT_TYPE(XEN_guint16_P(red), red, 1, "pango_attr_strikethrough_color_new", "guint16");
- XEN_ASSERT_TYPE(XEN_guint16_P(green), green, 2, "pango_attr_strikethrough_color_new", "guint16");
- XEN_ASSERT_TYPE(XEN_guint16_P(blue), blue, 3, "pango_attr_strikethrough_color_new", "guint16");
- return(C_TO_XEN_PangoAttribute_(pango_attr_strikethrough_color_new(XEN_TO_C_guint16(red), XEN_TO_C_guint16(green), XEN_TO_C_guint16(blue))));
+ #define H_gtk_recent_manager_add_full "gboolean gtk_recent_manager_add_full(GtkRecentManager* manager, \
+gchar* uri, GtkRecentData* recent_data)"
+ Xen_check_type(Xen_is_GtkRecentManager_(manager), manager, 1, "gtk_recent_manager_add_full", "GtkRecentManager*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_recent_manager_add_full", "gchar*");
+ Xen_check_type(Xen_is_GtkRecentData_(recent_data), recent_data, 3, "gtk_recent_manager_add_full", "GtkRecentData*");
+ return(C_to_Xen_gboolean(gtk_recent_manager_add_full(Xen_to_C_GtkRecentManager_(manager), Xen_to_C_gchar_(uri), Xen_to_C_GtkRecentData_(recent_data))));
}
-static XEN gxg_pango_renderer_draw_layout(XEN renderer, XEN layout, XEN x, XEN y)
+static Xen gxg_gtk_tree_model_filter_convert_child_iter_to_iter(Xen filter, Xen filter_iter, Xen child_iter)
{
- #define H_pango_renderer_draw_layout "void pango_renderer_draw_layout(PangoRenderer* renderer, PangoLayout* layout, \
-int x, int y)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_draw_layout", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 2, "pango_renderer_draw_layout", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 3, "pango_renderer_draw_layout", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 4, "pango_renderer_draw_layout", "int");
- pango_renderer_draw_layout(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(x), XEN_TO_C_int(y));
- return(XEN_FALSE);
+ #define H_gtk_tree_model_filter_convert_child_iter_to_iter "gboolean gtk_tree_model_filter_convert_child_iter_to_iter(GtkTreeModelFilter* filter, \
+GtkTreeIter* filter_iter, GtkTreeIter* child_iter)"
+ Xen_check_type(Xen_is_GtkTreeModelFilter_(filter), filter, 1, "gtk_tree_model_filter_convert_child_iter_to_iter", "GtkTreeModelFilter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(filter_iter), filter_iter, 2, "gtk_tree_model_filter_convert_child_iter_to_iter", "GtkTreeIter*");
+ Xen_check_type(Xen_is_GtkTreeIter_(child_iter), child_iter, 3, "gtk_tree_model_filter_convert_child_iter_to_iter", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_model_filter_convert_child_iter_to_iter(Xen_to_C_GtkTreeModelFilter_(filter), Xen_to_C_GtkTreeIter_(filter_iter),
+ Xen_to_C_GtkTreeIter_(child_iter))));
}
-static XEN gxg_pango_renderer_draw_layout_line(XEN renderer, XEN line, XEN x, XEN y)
+static Xen gxg_gtk_tree_view_get_grid_lines(Xen tree_view)
{
- #define H_pango_renderer_draw_layout_line "void pango_renderer_draw_layout_line(PangoRenderer* renderer, \
-PangoLayoutLine* line, int x, int y)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_draw_layout_line", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 2, "pango_renderer_draw_layout_line", "PangoLayoutLine*");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 3, "pango_renderer_draw_layout_line", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 4, "pango_renderer_draw_layout_line", "int");
- pango_renderer_draw_layout_line(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoLayoutLine_(line), XEN_TO_C_int(x), XEN_TO_C_int(y));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_grid_lines "GtkTreeViewGridLines gtk_tree_view_get_grid_lines(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_grid_lines", "GtkTreeView*");
+ return(C_to_Xen_GtkTreeViewGridLines(gtk_tree_view_get_grid_lines(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_pango_renderer_draw_glyphs(XEN renderer, XEN font, XEN glyphs, XEN x, XEN y)
+static Xen gxg_gtk_tree_view_set_grid_lines(Xen tree_view, Xen grid_lines)
{
- #define H_pango_renderer_draw_glyphs "void pango_renderer_draw_glyphs(PangoRenderer* renderer, PangoFont* font, \
-PangoGlyphString* glyphs, int x, int y)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_draw_glyphs", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 2, "pango_renderer_draw_glyphs", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 3, "pango_renderer_draw_glyphs", "PangoGlyphString*");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 4, "pango_renderer_draw_glyphs", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 5, "pango_renderer_draw_glyphs", "int");
- pango_renderer_draw_glyphs(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoFont_(font), XEN_TO_C_PangoGlyphString_(glyphs),
- XEN_TO_C_int(x), XEN_TO_C_int(y));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_grid_lines "void gtk_tree_view_set_grid_lines(GtkTreeView* tree_view, GtkTreeViewGridLines grid_lines)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_grid_lines", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreeViewGridLines(grid_lines), grid_lines, 2, "gtk_tree_view_set_grid_lines", "GtkTreeViewGridLines");
+ gtk_tree_view_set_grid_lines(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreeViewGridLines(grid_lines));
+ return(Xen_false);
}
-static XEN gxg_pango_renderer_draw_rectangle(XEN renderer, XEN part, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_gtk_tree_view_get_enable_tree_lines(Xen tree_view)
{
- #define H_pango_renderer_draw_rectangle "void pango_renderer_draw_rectangle(PangoRenderer* renderer, \
-PangoRenderPart part, int x, int y, int width, int height)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_draw_rectangle", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoRenderPart_P(part), part, 2, "pango_renderer_draw_rectangle", "PangoRenderPart");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 3, "pango_renderer_draw_rectangle", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 4, "pango_renderer_draw_rectangle", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 5, "pango_renderer_draw_rectangle", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 6, "pango_renderer_draw_rectangle", "int");
- pango_renderer_draw_rectangle(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoRenderPart(part), XEN_TO_C_int(x), XEN_TO_C_int(y),
- XEN_TO_C_int(width), XEN_TO_C_int(height));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_get_enable_tree_lines "gboolean gtk_tree_view_get_enable_tree_lines(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_enable_tree_lines", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_enable_tree_lines(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_pango_renderer_draw_error_underline(XEN renderer, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_gtk_tree_view_set_enable_tree_lines(Xen tree_view, Xen enabled)
{
- #define H_pango_renderer_draw_error_underline "void pango_renderer_draw_error_underline(PangoRenderer* renderer, \
-int x, int y, int width, int height)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_draw_error_underline", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 2, "pango_renderer_draw_error_underline", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 3, "pango_renderer_draw_error_underline", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 4, "pango_renderer_draw_error_underline", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 5, "pango_renderer_draw_error_underline", "int");
- pango_renderer_draw_error_underline(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_int(x), XEN_TO_C_int(y), XEN_TO_C_int(width),
- XEN_TO_C_int(height));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_enable_tree_lines "void gtk_tree_view_set_enable_tree_lines(GtkTreeView* tree_view, \
+gboolean enabled)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_enable_tree_lines", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(enabled), enabled, 2, "gtk_tree_view_set_enable_tree_lines", "gboolean");
+ gtk_tree_view_set_enable_tree_lines(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(enabled));
+ return(Xen_false);
}
-static XEN gxg_pango_renderer_draw_trapezoid(XEN renderer, XEN part, XEN y1, XEN x11, XEN x21, XEN y2, XEN x12, XEN x22)
+static Xen gxg_gtk_label_set_line_wrap_mode(Xen label, Xen wrap_mode)
{
- #define H_pango_renderer_draw_trapezoid "void pango_renderer_draw_trapezoid(PangoRenderer* renderer, \
-PangoRenderPart part, double y1, double x11, double x21, double y2, double x12, double x22)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_draw_trapezoid", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoRenderPart_P(part), part, 2, "pango_renderer_draw_trapezoid", "PangoRenderPart");
- XEN_ASSERT_TYPE(XEN_double_P(y1), y1, 3, "pango_renderer_draw_trapezoid", "double");
- XEN_ASSERT_TYPE(XEN_double_P(x11), x11, 4, "pango_renderer_draw_trapezoid", "double");
- XEN_ASSERT_TYPE(XEN_double_P(x21), x21, 5, "pango_renderer_draw_trapezoid", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y2), y2, 6, "pango_renderer_draw_trapezoid", "double");
- XEN_ASSERT_TYPE(XEN_double_P(x12), x12, 7, "pango_renderer_draw_trapezoid", "double");
- XEN_ASSERT_TYPE(XEN_double_P(x22), x22, 8, "pango_renderer_draw_trapezoid", "double");
- pango_renderer_draw_trapezoid(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoRenderPart(part), XEN_TO_C_double(y1), XEN_TO_C_double(x11),
- XEN_TO_C_double(x21), XEN_TO_C_double(y2), XEN_TO_C_double(x12), XEN_TO_C_double(x22));
- return(XEN_FALSE);
+ #define H_gtk_label_set_line_wrap_mode "void gtk_label_set_line_wrap_mode(GtkLabel* label, PangoWrapMode wrap_mode)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_line_wrap_mode", "GtkLabel*");
+ Xen_check_type(Xen_is_PangoWrapMode(wrap_mode), wrap_mode, 2, "gtk_label_set_line_wrap_mode", "PangoWrapMode");
+ gtk_label_set_line_wrap_mode(Xen_to_C_GtkLabel_(label), Xen_to_C_PangoWrapMode(wrap_mode));
+ return(Xen_false);
}
-static XEN gxg_pango_renderer_draw_glyph(XEN renderer, XEN font, XEN glyph, XEN x, XEN y)
+static Xen gxg_gtk_label_get_line_wrap_mode(Xen label)
{
- #define H_pango_renderer_draw_glyph "void pango_renderer_draw_glyph(PangoRenderer* renderer, PangoFont* font, \
-PangoGlyph glyph, double x, double y)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_draw_glyph", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 2, "pango_renderer_draw_glyph", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoGlyph_P(glyph), glyph, 3, "pango_renderer_draw_glyph", "PangoGlyph");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 4, "pango_renderer_draw_glyph", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 5, "pango_renderer_draw_glyph", "double");
- pango_renderer_draw_glyph(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoFont_(font), XEN_TO_C_PangoGlyph(glyph), XEN_TO_C_double(x),
- XEN_TO_C_double(y));
- return(XEN_FALSE);
+ #define H_gtk_label_get_line_wrap_mode "PangoWrapMode gtk_label_get_line_wrap_mode(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_line_wrap_mode", "GtkLabel*");
+ return(C_to_Xen_PangoWrapMode(gtk_label_get_line_wrap_mode(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_pango_renderer_activate(XEN renderer)
+static Xen gxg_gtk_print_context_get_cairo_context(Xen context)
{
- #define H_pango_renderer_activate "void pango_renderer_activate(PangoRenderer* renderer)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_activate", "PangoRenderer*");
- pango_renderer_activate(XEN_TO_C_PangoRenderer_(renderer));
- return(XEN_FALSE);
+ #define H_gtk_print_context_get_cairo_context "cairo_t* gtk_print_context_get_cairo_context(GtkPrintContext* context)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_get_cairo_context", "GtkPrintContext*");
+ return(C_to_Xen_cairo_t_(gtk_print_context_get_cairo_context(Xen_to_C_GtkPrintContext_(context))));
}
-static XEN gxg_pango_renderer_deactivate(XEN renderer)
+static Xen gxg_gtk_print_context_get_page_setup(Xen context)
{
- #define H_pango_renderer_deactivate "void pango_renderer_deactivate(PangoRenderer* renderer)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_deactivate", "PangoRenderer*");
- pango_renderer_deactivate(XEN_TO_C_PangoRenderer_(renderer));
- return(XEN_FALSE);
+ #define H_gtk_print_context_get_page_setup "GtkPageSetup* gtk_print_context_get_page_setup(GtkPrintContext* context)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_get_page_setup", "GtkPrintContext*");
+ return(C_to_Xen_GtkPageSetup_(gtk_print_context_get_page_setup(Xen_to_C_GtkPrintContext_(context))));
}
-static XEN gxg_pango_renderer_part_changed(XEN renderer, XEN part)
+static Xen gxg_gtk_print_context_get_width(Xen context)
{
- #define H_pango_renderer_part_changed "void pango_renderer_part_changed(PangoRenderer* renderer, PangoRenderPart part)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_part_changed", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoRenderPart_P(part), part, 2, "pango_renderer_part_changed", "PangoRenderPart");
- pango_renderer_part_changed(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoRenderPart(part));
- return(XEN_FALSE);
+ #define H_gtk_print_context_get_width "gdouble gtk_print_context_get_width(GtkPrintContext* context)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_get_width", "GtkPrintContext*");
+ return(C_to_Xen_gdouble(gtk_print_context_get_width(Xen_to_C_GtkPrintContext_(context))));
}
-static XEN gxg_pango_renderer_set_color(XEN renderer, XEN part, XEN color)
+static Xen gxg_gtk_print_context_get_height(Xen context)
{
- #define H_pango_renderer_set_color "void pango_renderer_set_color(PangoRenderer* renderer, PangoRenderPart part, \
-PangoColor* color)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_set_color", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoRenderPart_P(part), part, 2, "pango_renderer_set_color", "PangoRenderPart");
- XEN_ASSERT_TYPE(XEN_PangoColor__P(color), color, 3, "pango_renderer_set_color", "PangoColor*");
- pango_renderer_set_color(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoRenderPart(part), XEN_TO_C_PangoColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_print_context_get_height "gdouble gtk_print_context_get_height(GtkPrintContext* context)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_get_height", "GtkPrintContext*");
+ return(C_to_Xen_gdouble(gtk_print_context_get_height(Xen_to_C_GtkPrintContext_(context))));
}
-static XEN gxg_pango_renderer_get_color(XEN renderer, XEN part)
+static Xen gxg_gtk_print_context_get_dpi_x(Xen context)
{
- #define H_pango_renderer_get_color "PangoColor* pango_renderer_get_color(PangoRenderer* renderer, PangoRenderPart part)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_get_color", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoRenderPart_P(part), part, 2, "pango_renderer_get_color", "PangoRenderPart");
- return(C_TO_XEN_PangoColor_(pango_renderer_get_color(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoRenderPart(part))));
+ #define H_gtk_print_context_get_dpi_x "gdouble gtk_print_context_get_dpi_x(GtkPrintContext* context)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_get_dpi_x", "GtkPrintContext*");
+ return(C_to_Xen_gdouble(gtk_print_context_get_dpi_x(Xen_to_C_GtkPrintContext_(context))));
}
-static XEN gxg_pango_renderer_set_matrix(XEN renderer, XEN matrix)
+static Xen gxg_gtk_print_context_get_dpi_y(Xen context)
{
- #define H_pango_renderer_set_matrix "void pango_renderer_set_matrix(PangoRenderer* renderer, PangoMatrix* matrix)"
- XEN_ASSERT_TYPE(XEN_PangoRenderer__P(renderer), renderer, 1, "pango_renderer_set_matrix", "PangoRenderer*");
- XEN_ASSERT_TYPE(XEN_PangoMatrix__P(matrix), matrix, 2, "pango_renderer_set_matrix", "PangoMatrix*");
- pango_renderer_set_matrix(XEN_TO_C_PangoRenderer_(renderer), XEN_TO_C_PangoMatrix_(matrix));
- return(XEN_FALSE);
+ #define H_gtk_print_context_get_dpi_y "gdouble gtk_print_context_get_dpi_y(GtkPrintContext* context)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_get_dpi_y", "GtkPrintContext*");
+ return(C_to_Xen_gdouble(gtk_print_context_get_dpi_y(Xen_to_C_GtkPrintContext_(context))));
}
-static XEN gxg_g_log_set_handler(XEN log_domain, XEN log_levels, XEN func, XEN func_info)
+static Xen gxg_gtk_print_context_create_pango_context(Xen context)
{
- #define H_g_log_set_handler "guint g_log_set_handler(gchar* log_domain, GLogLevelFlags log_levels, \
-GLogFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_gchar__P(log_domain), log_domain, 1, "g_log_set_handler", "gchar*");
- XEN_ASSERT_TYPE(XEN_GLogLevelFlags_P(log_levels), log_levels, 2, "g_log_set_handler", "GLogLevelFlags");
- XEN_ASSERT_TYPE(XEN_GLogFunc_P(func), func, 3, "g_log_set_handler", "GLogFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "g_log_set_handler", "lambda_data");
- {
- XEN result = XEN_FALSE;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- result = C_TO_XEN_guint(g_log_set_handler(XEN_TO_C_gchar_(log_domain), XEN_TO_C_GLogLevelFlags(log_levels), XEN_TO_C_GLogFunc(func),
- XEN_TO_C_lambda_data(func_info)));
- return(result);
- }
+ #define H_gtk_print_context_create_pango_context "PangoContext* gtk_print_context_create_pango_context(GtkPrintContext* context)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_create_pango_context", "GtkPrintContext*");
+ return(C_to_Xen_PangoContext_(gtk_print_context_create_pango_context(Xen_to_C_GtkPrintContext_(context))));
}
-static XEN gxg_g_log_remove_handler(XEN log_domain, XEN handler_id)
+static Xen gxg_gtk_print_context_create_pango_layout(Xen context)
{
- #define H_g_log_remove_handler "void g_log_remove_handler(gchar* log_domain, guint handler_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(log_domain), log_domain, 1, "g_log_remove_handler", "gchar*");
- XEN_ASSERT_TYPE(XEN_guint_P(handler_id), handler_id, 2, "g_log_remove_handler", "guint");
- g_log_remove_handler(XEN_TO_C_gchar_(log_domain), XEN_TO_C_guint(handler_id));
- return(XEN_FALSE);
+ #define H_gtk_print_context_create_pango_layout "PangoLayout* gtk_print_context_create_pango_layout(GtkPrintContext* context)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_create_pango_layout", "GtkPrintContext*");
+ return(C_to_Xen_PangoLayout_(gtk_print_context_create_pango_layout(Xen_to_C_GtkPrintContext_(context))));
}
-static XEN gxg_gtk_cell_renderer_stop_editing(XEN cell, XEN canceled)
+static Xen gxg_gtk_print_context_set_cairo_context(Xen context, Xen cr, Xen dpi_x, Xen dpi_y)
{
- #define H_gtk_cell_renderer_stop_editing "void gtk_cell_renderer_stop_editing(GtkCellRenderer* cell, \
-gboolean canceled)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_stop_editing", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(canceled), canceled, 2, "gtk_cell_renderer_stop_editing", "gboolean");
- gtk_cell_renderer_stop_editing(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gboolean(canceled));
- return(XEN_FALSE);
+ #define H_gtk_print_context_set_cairo_context "void gtk_print_context_set_cairo_context(GtkPrintContext* context, \
+cairo_t* cr, double dpi_x, double dpi_y)"
+ Xen_check_type(Xen_is_GtkPrintContext_(context), context, 1, "gtk_print_context_set_cairo_context", "GtkPrintContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_print_context_set_cairo_context", "cairo_t*");
+ Xen_check_type(Xen_is_double(dpi_x), dpi_x, 3, "gtk_print_context_set_cairo_context", "double");
+ Xen_check_type(Xen_is_double(dpi_y), dpi_y, 4, "gtk_print_context_set_cairo_context", "double");
+ gtk_print_context_set_cairo_context(Xen_to_C_GtkPrintContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_double(dpi_x),
+ Xen_to_C_double(dpi_y));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_button_new(XEN title, XEN action)
+static Xen gxg_gtk_print_operation_new(void)
{
- #define H_gtk_file_chooser_button_new "GtkWidget* gtk_file_chooser_button_new(gchar* title, GtkFileChooserAction action)"
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 1, "gtk_file_chooser_button_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkFileChooserAction_P(action), action, 2, "gtk_file_chooser_button_new", "GtkFileChooserAction");
- return(C_TO_XEN_GtkWidget_(gtk_file_chooser_button_new((const gchar*)XEN_TO_C_gchar_(title), XEN_TO_C_GtkFileChooserAction(action))));
+ #define H_gtk_print_operation_new "GtkPrintOperation* gtk_print_operation_new( void)"
+ return(C_to_Xen_GtkPrintOperation_(gtk_print_operation_new()));
}
-static XEN gxg_gtk_icon_view_set_columns(XEN icon_view, XEN columns)
+static Xen gxg_gtk_print_operation_set_default_page_setup(Xen op, Xen default_page_setup)
{
- #define H_gtk_icon_view_set_columns "void gtk_icon_view_set_columns(GtkIconView* icon_view, gint columns)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_columns", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(columns), columns, 2, "gtk_icon_view_set_columns", "gint");
- gtk_icon_view_set_columns(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(columns));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_set_default_page_setup "void gtk_print_operation_set_default_page_setup(GtkPrintOperation* op, \
+GtkPageSetup* default_page_setup)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_default_page_setup", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_GtkPageSetup_(default_page_setup), default_page_setup, 2, "gtk_print_operation_set_default_page_setup", "GtkPageSetup*");
+ gtk_print_operation_set_default_page_setup(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_GtkPageSetup_(default_page_setup));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_columns(XEN icon_view)
+static Xen gxg_gtk_print_operation_get_default_page_setup(Xen op)
{
- #define H_gtk_icon_view_get_columns "gint gtk_icon_view_get_columns(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_columns", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_columns(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_print_operation_get_default_page_setup "GtkPageSetup* gtk_print_operation_get_default_page_setup(GtkPrintOperation* op)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_get_default_page_setup", "GtkPrintOperation*");
+ return(C_to_Xen_GtkPageSetup_(gtk_print_operation_get_default_page_setup(Xen_to_C_GtkPrintOperation_(op))));
}
-static XEN gxg_gtk_icon_view_set_item_width(XEN icon_view, XEN item_width)
+static Xen gxg_gtk_print_operation_set_print_settings(Xen op, Xen print_settings)
{
- #define H_gtk_icon_view_set_item_width "void gtk_icon_view_set_item_width(GtkIconView* icon_view, gint item_width)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_item_width", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(item_width), item_width, 2, "gtk_icon_view_set_item_width", "gint");
- gtk_icon_view_set_item_width(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(item_width));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_set_print_settings "void gtk_print_operation_set_print_settings(GtkPrintOperation* op, \
+GtkPrintSettings* print_settings)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_print_settings", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_GtkPrintSettings_(print_settings), print_settings, 2, "gtk_print_operation_set_print_settings", "GtkPrintSettings*");
+ gtk_print_operation_set_print_settings(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_GtkPrintSettings_(print_settings));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_item_width(XEN icon_view)
+static Xen gxg_gtk_print_operation_get_print_settings(Xen op)
{
- #define H_gtk_icon_view_get_item_width "gint gtk_icon_view_get_item_width(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_item_width", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_item_width(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_print_operation_get_print_settings "GtkPrintSettings* gtk_print_operation_get_print_settings(GtkPrintOperation* op)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_get_print_settings", "GtkPrintOperation*");
+ return(C_to_Xen_GtkPrintSettings_(gtk_print_operation_get_print_settings(Xen_to_C_GtkPrintOperation_(op))));
}
-static XEN gxg_gtk_icon_view_set_spacing(XEN icon_view, XEN spacing)
+static Xen gxg_gtk_print_operation_set_job_name(Xen op, Xen job_name)
{
- #define H_gtk_icon_view_set_spacing "void gtk_icon_view_set_spacing(GtkIconView* icon_view, gint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_spacing", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(spacing), spacing, 2, "gtk_icon_view_set_spacing", "gint");
- gtk_icon_view_set_spacing(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(spacing));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_set_job_name "void gtk_print_operation_set_job_name(GtkPrintOperation* op, \
+gchar* job_name)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_job_name", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gchar_(job_name), job_name, 2, "gtk_print_operation_set_job_name", "gchar*");
+ gtk_print_operation_set_job_name(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gchar_(job_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_spacing(XEN icon_view)
+static Xen gxg_gtk_print_operation_set_n_pages(Xen op, Xen n_pages)
{
- #define H_gtk_icon_view_get_spacing "gint gtk_icon_view_get_spacing(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_spacing", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_spacing(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_print_operation_set_n_pages "void gtk_print_operation_set_n_pages(GtkPrintOperation* op, \
+gint n_pages)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_n_pages", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gint(n_pages), n_pages, 2, "gtk_print_operation_set_n_pages", "gint");
+ gtk_print_operation_set_n_pages(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gint(n_pages));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_set_row_spacing(XEN icon_view, XEN row_spacing)
+static Xen gxg_gtk_print_operation_set_current_page(Xen op, Xen current_page)
{
- #define H_gtk_icon_view_set_row_spacing "void gtk_icon_view_set_row_spacing(GtkIconView* icon_view, \
-gint row_spacing)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_row_spacing", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(row_spacing), row_spacing, 2, "gtk_icon_view_set_row_spacing", "gint");
- gtk_icon_view_set_row_spacing(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(row_spacing));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_set_current_page "void gtk_print_operation_set_current_page(GtkPrintOperation* op, \
+gint current_page)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_current_page", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gint(current_page), current_page, 2, "gtk_print_operation_set_current_page", "gint");
+ gtk_print_operation_set_current_page(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gint(current_page));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_row_spacing(XEN icon_view)
+static Xen gxg_gtk_print_operation_set_use_full_page(Xen op, Xen full_page)
{
- #define H_gtk_icon_view_get_row_spacing "gint gtk_icon_view_get_row_spacing(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_row_spacing", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_row_spacing(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_print_operation_set_use_full_page "void gtk_print_operation_set_use_full_page(GtkPrintOperation* op, \
+gboolean full_page)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_use_full_page", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gboolean(full_page), full_page, 2, "gtk_print_operation_set_use_full_page", "gboolean");
+ gtk_print_operation_set_use_full_page(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gboolean(full_page));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_set_column_spacing(XEN icon_view, XEN column_spacing)
+static Xen gxg_gtk_print_operation_set_unit(Xen op, Xen unit)
{
- #define H_gtk_icon_view_set_column_spacing "void gtk_icon_view_set_column_spacing(GtkIconView* icon_view, \
-gint column_spacing)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_column_spacing", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(column_spacing), column_spacing, 2, "gtk_icon_view_set_column_spacing", "gint");
- gtk_icon_view_set_column_spacing(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(column_spacing));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_set_unit "void gtk_print_operation_set_unit(GtkPrintOperation* op, GtkUnit unit)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_unit", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_GtkUnit(unit), unit, 2, "gtk_print_operation_set_unit", "GtkUnit");
+ gtk_print_operation_set_unit(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_GtkUnit(unit));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_column_spacing(XEN icon_view)
+static Xen gxg_gtk_print_operation_set_export_filename(Xen op, Xen filename)
{
- #define H_gtk_icon_view_get_column_spacing "gint gtk_icon_view_get_column_spacing(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_column_spacing", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_column_spacing(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_print_operation_set_export_filename "void gtk_print_operation_set_export_filename(GtkPrintOperation* op, \
+gchar* filename)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_export_filename", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gchar_(filename), filename, 2, "gtk_print_operation_set_export_filename", "gchar*");
+ gtk_print_operation_set_export_filename(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gchar_(filename));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_set_margin(XEN icon_view, XEN margin)
+static Xen gxg_gtk_print_operation_set_track_print_status(Xen op, Xen track_status)
{
- #define H_gtk_icon_view_set_margin "void gtk_icon_view_set_margin(GtkIconView* icon_view, gint margin)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_margin", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(margin), margin, 2, "gtk_icon_view_set_margin", "gint");
- gtk_icon_view_set_margin(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(margin));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_set_track_print_status "void gtk_print_operation_set_track_print_status(GtkPrintOperation* op, \
+gboolean track_status)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_track_print_status", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gboolean(track_status), track_status, 2, "gtk_print_operation_set_track_print_status", "gboolean");
+ gtk_print_operation_set_track_print_status(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gboolean(track_status));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_margin(XEN icon_view)
+static Xen gxg_gtk_print_operation_set_show_progress(Xen op, Xen show_progress)
{
- #define H_gtk_icon_view_get_margin "gint gtk_icon_view_get_margin(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_margin", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_margin(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_print_operation_set_show_progress "void gtk_print_operation_set_show_progress(GtkPrintOperation* op, \
+gboolean show_progress)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_show_progress", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gboolean(show_progress), show_progress, 2, "gtk_print_operation_set_show_progress", "gboolean");
+ gtk_print_operation_set_show_progress(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gboolean(show_progress));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_max_width_chars(XEN label, XEN n_chars)
+static Xen gxg_gtk_print_operation_set_allow_async(Xen op, Xen allow_async)
{
- #define H_gtk_label_set_max_width_chars "void gtk_label_set_max_width_chars(GtkLabel* label, gint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_max_width_chars", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_chars), n_chars, 2, "gtk_label_set_max_width_chars", "gint");
- gtk_label_set_max_width_chars(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gint(n_chars));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_set_allow_async "void gtk_print_operation_set_allow_async(GtkPrintOperation* op, \
+gboolean allow_async)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_allow_async", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gboolean(allow_async), allow_async, 2, "gtk_print_operation_set_allow_async", "gboolean");
+ gtk_print_operation_set_allow_async(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gboolean(allow_async));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_get_max_width_chars(XEN label)
+static Xen gxg_gtk_print_operation_set_custom_tab_label(Xen op, Xen label)
{
- #define H_gtk_label_get_max_width_chars "gint gtk_label_get_max_width_chars(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_max_width_chars", "GtkLabel*");
- return(C_TO_XEN_gint(gtk_label_get_max_width_chars(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_print_operation_set_custom_tab_label "void gtk_print_operation_set_custom_tab_label(GtkPrintOperation* op, \
+gchar* label)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_custom_tab_label", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_print_operation_set_custom_tab_label", "gchar*");
+ gtk_print_operation_set_custom_tab_label(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gchar_(label));
+ return(Xen_false);
}
-static XEN gxg_gtk_list_store_insert_with_values(XEN list_store, XEN iter, XEN position)
+static Xen gxg_gtk_print_operation_run(Xen op, Xen action, Xen parent, Xen ignore_error)
{
- #define H_gtk_list_store_insert_with_values "void gtk_list_store_insert_with_values(GtkListStore* list_store, \
-GtkTreeIter* iter, gint position, ...)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_insert_with_values", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_insert_with_values", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_list_store_insert_with_values", "gint");
- gtk_list_store_insert_with_values(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_run "GtkPrintOperationResult gtk_print_operation_run(GtkPrintOperation* op, \
+GtkPrintOperationAction action, GtkWindow* parent, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_run", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_GtkPrintOperationAction(action), action, 2, "gtk_print_operation_run", "GtkPrintOperationAction");
+ Xen_check_type(Xen_is_GtkWindow_(parent), parent, 3, "gtk_print_operation_run", "GtkWindow*");
+ {
+ Xen result;
+ result = C_to_Xen_GtkPrintOperationResult(gtk_print_operation_run(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_GtkPrintOperationAction(action),
+ Xen_to_C_GtkWindow_(parent), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_list_store_insert_with_valuesv(XEN list_store, XEN iter, XEN position, XEN columns, XEN values, XEN n_values)
+static Xen gxg_gtk_print_operation_get_error(Xen op, Xen ignore_error)
{
- #define H_gtk_list_store_insert_with_valuesv "void gtk_list_store_insert_with_valuesv(GtkListStore* list_store, \
-GtkTreeIter* iter, gint position, gint* columns, GValue* values, gint n_values)"
- XEN_ASSERT_TYPE(XEN_GtkListStore__P(list_store), list_store, 1, "gtk_list_store_insert_with_valuesv", "GtkListStore*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_list_store_insert_with_valuesv", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_list_store_insert_with_valuesv", "gint");
- XEN_ASSERT_TYPE(XEN_gint__P(columns), columns, 4, "gtk_list_store_insert_with_valuesv", "gint*");
- XEN_ASSERT_TYPE(XEN_GValue__P(values), values, 5, "gtk_list_store_insert_with_valuesv", "GValue*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_values), n_values, 6, "gtk_list_store_insert_with_valuesv", "gint");
- gtk_list_store_insert_with_valuesv(XEN_TO_C_GtkListStore_(list_store), XEN_TO_C_GtkTreeIter_(iter), XEN_TO_C_gint(position),
- XEN_TO_C_gint_(columns), XEN_TO_C_GValue_(values), XEN_TO_C_gint(n_values));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_get_error "void gtk_print_operation_get_error(GtkPrintOperation* op, \
+GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_get_error", "GtkPrintOperation*");
+ gtk_print_operation_get_error(Xen_to_C_GtkPrintOperation_(op), &ref_error);
+ return(Xen_list_1(C_to_Xen_GError_(ref_error)));
}
-static XEN gxg_gtk_text_view_get_iter_at_position(XEN text_view, XEN iter, XEN ignore_trailing, XEN x, XEN y)
+static Xen gxg_gtk_print_operation_get_status(Xen op)
{
- #define H_gtk_text_view_get_iter_at_position "void gtk_text_view_get_iter_at_position(GtkTextView* text_view, \
-GtkTextIter* iter, gint* [trailing], gint x, gint y)"
- gint ref_trailing;
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_get_iter_at_position", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 2, "gtk_text_view_get_iter_at_position", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 4, "gtk_text_view_get_iter_at_position", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 5, "gtk_text_view_get_iter_at_position", "gint");
- gtk_text_view_get_iter_at_position(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GtkTextIter_(iter), &ref_trailing, XEN_TO_C_gint(x),
- XEN_TO_C_gint(y));
- return(XEN_LIST_1(C_TO_XEN_gint(ref_trailing)));
+ #define H_gtk_print_operation_get_status "GtkPrintStatus gtk_print_operation_get_status(GtkPrintOperation* op)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_get_status", "GtkPrintOperation*");
+ return(C_to_Xen_GtkPrintStatus(gtk_print_operation_get_status(Xen_to_C_GtkPrintOperation_(op))));
}
-static XEN gxg_pango_attr_size_new_absolute(XEN size)
+static Xen gxg_gtk_print_operation_get_status_string(Xen op)
{
- #define H_pango_attr_size_new_absolute "PangoAttribute* pango_attr_size_new_absolute(int size)"
- XEN_ASSERT_TYPE(XEN_int_P(size), size, 1, "pango_attr_size_new_absolute", "int");
- return(C_TO_XEN_PangoAttribute_(pango_attr_size_new_absolute(XEN_TO_C_int(size))));
+ #define H_gtk_print_operation_get_status_string "gchar* gtk_print_operation_get_status_string(GtkPrintOperation* op)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_get_status_string", "GtkPrintOperation*");
+ return(C_to_Xen_gchar_(gtk_print_operation_get_status_string(Xen_to_C_GtkPrintOperation_(op))));
}
-static XEN gxg_pango_font_description_set_absolute_size(XEN desc, XEN size)
+static Xen gxg_gtk_print_operation_is_finished(Xen op)
{
- #define H_pango_font_description_set_absolute_size "void pango_font_description_set_absolute_size(PangoFontDescription* desc, \
-double size)"
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(desc), desc, 1, "pango_font_description_set_absolute_size", "PangoFontDescription*");
- XEN_ASSERT_TYPE(XEN_double_P(size), size, 2, "pango_font_description_set_absolute_size", "double");
- pango_font_description_set_absolute_size(XEN_TO_C_PangoFontDescription_(desc), XEN_TO_C_double(size));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_is_finished "gboolean gtk_print_operation_is_finished(GtkPrintOperation* op)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_is_finished", "GtkPrintOperation*");
+ return(C_to_Xen_gboolean(gtk_print_operation_is_finished(Xen_to_C_GtkPrintOperation_(op))));
}
-static XEN gxg_pango_layout_get_font_description(XEN layout)
+static Xen gxg_gtk_print_operation_cancel(Xen op)
{
- #define H_pango_layout_get_font_description "PangoFontDescription* pango_layout_get_font_description(PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_get_font_description", "PangoLayout*");
- return(C_TO_XEN_PangoFontDescription_((PangoFontDescription*)pango_layout_get_font_description(XEN_TO_C_PangoLayout_(layout))));
+ #define H_gtk_print_operation_cancel "void gtk_print_operation_cancel(GtkPrintOperation* op)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_cancel", "GtkPrintOperation*");
+ gtk_print_operation_cancel(Xen_to_C_GtkPrintOperation_(op));
+ return(Xen_false);
}
-static XEN gxg_gdk_cursor_new_from_name(XEN display, XEN name)
+static Xen gxg_gtk_print_run_page_setup_dialog(Xen parent, Xen page_setup, Xen settings)
{
- #define H_gdk_cursor_new_from_name "GdkCursor* gdk_cursor_new_from_name(GdkDisplay* display, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_cursor_new_from_name", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gdk_cursor_new_from_name", "gchar*");
- return(C_TO_XEN_GdkCursor_(gdk_cursor_new_from_name(XEN_TO_C_GdkDisplay_(display), (const gchar*)XEN_TO_C_gchar_(name))));
+ #define H_gtk_print_run_page_setup_dialog "GtkPageSetup* gtk_print_run_page_setup_dialog(GtkWindow* parent, \
+GtkPageSetup* page_setup, GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkWindow_(parent), parent, 1, "gtk_print_run_page_setup_dialog", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkPageSetup_(page_setup), page_setup, 2, "gtk_print_run_page_setup_dialog", "GtkPageSetup*");
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 3, "gtk_print_run_page_setup_dialog", "GtkPrintSettings*");
+ return(C_to_Xen_GtkPageSetup_(gtk_print_run_page_setup_dialog(Xen_to_C_GtkWindow_(parent), Xen_to_C_GtkPageSetup_(page_setup),
+ Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gdk_cursor_get_image(XEN cursor)
+static Xen gxg_gtk_print_run_page_setup_dialog_async(Xen parent, Xen page_setup, Xen settings, Xen done_cb, Xen data)
{
- #define H_gdk_cursor_get_image "GdkPixbuf* gdk_cursor_get_image(GdkCursor* cursor)"
- XEN_ASSERT_TYPE(XEN_GdkCursor__P(cursor), cursor, 1, "gdk_cursor_get_image", "GdkCursor*");
- return(C_TO_XEN_GdkPixbuf_(gdk_cursor_get_image(XEN_TO_C_GdkCursor_(cursor))));
+ #define H_gtk_print_run_page_setup_dialog_async "void gtk_print_run_page_setup_dialog_async(GtkWindow* parent, \
+GtkPageSetup* page_setup, GtkPrintSettings* settings, GtkPageSetupDoneFunc done_cb, gpointer data)"
+ Xen_check_type(Xen_is_GtkWindow_(parent), parent, 1, "gtk_print_run_page_setup_dialog_async", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkPageSetup_(page_setup), page_setup, 2, "gtk_print_run_page_setup_dialog_async", "GtkPageSetup*");
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 3, "gtk_print_run_page_setup_dialog_async", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPageSetupDoneFunc(done_cb), done_cb, 4, "gtk_print_run_page_setup_dialog_async", "GtkPageSetupDoneFunc");
+ Xen_check_type(Xen_is_gpointer(data), data, 5, "gtk_print_run_page_setup_dialog_async", "gpointer");
+ gtk_print_run_page_setup_dialog_async(Xen_to_C_GtkWindow_(parent), Xen_to_C_GtkPageSetup_(page_setup), Xen_to_C_GtkPrintSettings_(settings),
+ Xen_to_C_GtkPageSetupDoneFunc(done_cb), Xen_to_C_gpointer(data));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_rgba_visual(XEN screen)
+static Xen gxg_gtk_print_operation_preview_render_page(Xen preview, Xen page_nr)
{
- #define H_gdk_screen_get_rgba_visual "GdkVisual* gdk_screen_get_rgba_visual(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_rgba_visual", "GdkScreen*");
- return(C_TO_XEN_GdkVisual_(gdk_screen_get_rgba_visual(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_print_operation_preview_render_page "void gtk_print_operation_preview_render_page(GtkPrintOperationPreview* preview, \
+gint page_nr)"
+ Xen_check_type(Xen_is_GtkPrintOperationPreview_(preview), preview, 1, "gtk_print_operation_preview_render_page", "GtkPrintOperationPreview*");
+ Xen_check_type(Xen_is_gint(page_nr), page_nr, 2, "gtk_print_operation_preview_render_page", "gint");
+ gtk_print_operation_preview_render_page(Xen_to_C_GtkPrintOperationPreview_(preview), Xen_to_C_gint(page_nr));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_urgency_hint(XEN window, XEN urgent)
+static Xen gxg_gtk_print_operation_preview_end_preview(Xen preview)
{
- #define H_gdk_window_set_urgency_hint "void gdk_window_set_urgency_hint(GdkWindow* window, gboolean urgent)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_urgency_hint", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(urgent), urgent, 2, "gdk_window_set_urgency_hint", "gboolean");
- gdk_window_set_urgency_hint(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(urgent));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_preview_end_preview "void gtk_print_operation_preview_end_preview(GtkPrintOperationPreview* preview)"
+ Xen_check_type(Xen_is_GtkPrintOperationPreview_(preview), preview, 1, "gtk_print_operation_preview_end_preview", "GtkPrintOperationPreview*");
+ gtk_print_operation_preview_end_preview(Xen_to_C_GtkPrintOperationPreview_(preview));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_get_accel_closure(XEN action)
+static Xen gxg_gtk_print_operation_preview_is_selected(Xen preview, Xen page_nr)
{
- #define H_gtk_action_get_accel_closure "GClosure* gtk_action_get_accel_closure(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_accel_closure", "GtkAction*");
- return(C_TO_XEN_GClosure_(gtk_action_get_accel_closure(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_print_operation_preview_is_selected "gboolean gtk_print_operation_preview_is_selected(GtkPrintOperationPreview* preview, \
+gint page_nr)"
+ Xen_check_type(Xen_is_GtkPrintOperationPreview_(preview), preview, 1, "gtk_print_operation_preview_is_selected", "GtkPrintOperationPreview*");
+ Xen_check_type(Xen_is_gint(page_nr), page_nr, 2, "gtk_print_operation_preview_is_selected", "gint");
+ return(C_to_Xen_gboolean(gtk_print_operation_preview_is_selected(Xen_to_C_GtkPrintOperationPreview_(preview), Xen_to_C_gint(page_nr))));
}
-static XEN gxg_gtk_dialog_get_response_for_widget(XEN dialog, XEN widget)
+static Xen gxg_gtk_print_settings_new(void)
{
- #define H_gtk_dialog_get_response_for_widget "gint gtk_dialog_get_response_for_widget(GtkDialog* dialog, \
-GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_get_response_for_widget", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_dialog_get_response_for_widget", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_dialog_get_response_for_widget(XEN_TO_C_GtkDialog_(dialog), XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_print_settings_new "GtkPrintSettings* gtk_print_settings_new( void)"
+ return(C_to_Xen_GtkPrintSettings_(gtk_print_settings_new()));
}
-static XEN gxg_gtk_drag_source_set_icon_name(XEN widget, XEN icon_name)
+static Xen gxg_gtk_print_settings_copy(Xen other)
{
- #define H_gtk_drag_source_set_icon_name "void gtk_drag_source_set_icon_name(GtkWidget* widget, gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_set_icon_name", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_drag_source_set_icon_name", "gchar*");
- gtk_drag_source_set_icon_name(XEN_TO_C_GtkWidget_(widget), (const gchar*)XEN_TO_C_gchar_(icon_name));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_copy "GtkPrintSettings* gtk_print_settings_copy(GtkPrintSettings* other)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(other), other, 1, "gtk_print_settings_copy", "GtkPrintSettings*");
+ return(C_to_Xen_GtkPrintSettings_(gtk_print_settings_copy(Xen_to_C_GtkPrintSettings_(other))));
}
-static XEN gxg_gtk_drag_set_icon_name(XEN context, XEN icon_name, XEN hot_x, XEN hot_y)
+static Xen gxg_gtk_print_settings_has_key(Xen settings, Xen key)
{
- #define H_gtk_drag_set_icon_name "void gtk_drag_set_icon_name(GdkDragContext* context, gchar* icon_name, \
-gint hot_x, gint hot_y)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_set_icon_name", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_drag_set_icon_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_x), hot_x, 3, "gtk_drag_set_icon_name", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_y), hot_y, 4, "gtk_drag_set_icon_name", "gint");
- gtk_drag_set_icon_name(XEN_TO_C_GdkDragContext_(context), (const gchar*)XEN_TO_C_gchar_(icon_name), XEN_TO_C_gint(hot_x), XEN_TO_C_gint(hot_y));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_has_key "gboolean gtk_print_settings_has_key(GtkPrintSettings* settings, \
+gchar* key)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_has_key", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_has_key", "gchar*");
+ return(C_to_Xen_gboolean(gtk_print_settings_has_key(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key))));
}
-static XEN gxg_gtk_entry_completion_set_popup_set_width(XEN completion, XEN popup_set_width)
+static Xen gxg_gtk_print_settings_get(Xen settings, Xen key)
{
- #define H_gtk_entry_completion_set_popup_set_width "void gtk_entry_completion_set_popup_set_width(GtkEntryCompletion* completion, \
-gboolean popup_set_width)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_popup_set_width", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(popup_set_width), popup_set_width, 2, "gtk_entry_completion_set_popup_set_width", "gboolean");
- gtk_entry_completion_set_popup_set_width(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gboolean(popup_set_width));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get "gchar* gtk_print_settings_get(GtkPrintSettings* settings, gchar* key)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_get", "gchar*");
+ return(C_to_Xen_gchar_(gtk_print_settings_get(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key))));
}
-static XEN gxg_gtk_entry_completion_get_popup_set_width(XEN completion)
+static Xen gxg_gtk_print_settings_set(Xen settings, Xen key, Xen value)
{
- #define H_gtk_entry_completion_get_popup_set_width "gboolean gtk_entry_completion_get_popup_set_width(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_popup_set_width", "GtkEntryCompletion*");
- return(C_TO_XEN_gboolean(gtk_entry_completion_get_popup_set_width(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gtk_print_settings_set "void gtk_print_settings_set(GtkPrintSettings* settings, gchar* key, \
+gchar* value)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_set", "gchar*");
+ Xen_check_type(Xen_is_gchar_(value), value, 3, "gtk_print_settings_set", "gchar*");
+ gtk_print_settings_set(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key), Xen_to_C_gchar_(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_completion_set_popup_single_match(XEN completion, XEN popup_single_match)
+static Xen gxg_gtk_print_settings_unset(Xen settings, Xen key)
{
- #define H_gtk_entry_completion_set_popup_single_match "void gtk_entry_completion_set_popup_single_match(GtkEntryCompletion* completion, \
-gboolean popup_single_match)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_popup_single_match", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(popup_single_match), popup_single_match, 2, "gtk_entry_completion_set_popup_single_match", "gboolean");
- gtk_entry_completion_set_popup_single_match(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gboolean(popup_single_match));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_unset "void gtk_print_settings_unset(GtkPrintSettings* settings, gchar* key)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_unset", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_unset", "gchar*");
+ gtk_print_settings_unset(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_completion_get_popup_single_match(XEN completion)
+static Xen gxg_gtk_print_settings_foreach(Xen settings, Xen func, Xen user_data)
{
- #define H_gtk_entry_completion_get_popup_single_match "gboolean gtk_entry_completion_get_popup_single_match(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_popup_single_match", "GtkEntryCompletion*");
- return(C_TO_XEN_gboolean(gtk_entry_completion_get_popup_single_match(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gtk_print_settings_foreach "void gtk_print_settings_foreach(GtkPrintSettings* settings, GtkPrintSettingsFunc func, \
+gpointer user_data)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_foreach", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPrintSettingsFunc(func), func, 2, "gtk_print_settings_foreach", "GtkPrintSettingsFunc");
+ Xen_check_type(Xen_is_gpointer(user_data), user_data, 3, "gtk_print_settings_foreach", "gpointer");
+ gtk_print_settings_foreach(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkPrintSettingsFunc(func), Xen_to_C_gpointer(user_data));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_item_at_pos(XEN icon_view, XEN x, XEN y, XEN ignore_path, XEN ignore_cell)
+static Xen gxg_gtk_print_settings_get_bool(Xen settings, Xen key)
{
- #define H_gtk_icon_view_get_item_at_pos "gboolean gtk_icon_view_get_item_at_pos(GtkIconView* icon_view, \
-gint x, gint y, GtkTreePath** [path], GtkCellRenderer** [cell])"
- GtkTreePath* ref_path = NULL;
- GtkCellRenderer* ref_cell = NULL;
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_item_at_pos", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_icon_view_get_item_at_pos", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_icon_view_get_item_at_pos", "gint");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_icon_view_get_item_at_pos(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(x), XEN_TO_C_gint(y),
- &ref_path, &ref_cell));
- return(XEN_LIST_3(result, C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkCellRenderer_(ref_cell)));
- }
+ #define H_gtk_print_settings_get_bool "gboolean gtk_print_settings_get_bool(GtkPrintSettings* settings, \
+gchar* key)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_bool", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_get_bool", "gchar*");
+ return(C_to_Xen_gboolean(gtk_print_settings_get_bool(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key))));
}
-static XEN gxg_gtk_icon_view_get_visible_range(XEN icon_view, XEN ignore_start_path, XEN ignore_end_path)
+static Xen gxg_gtk_print_settings_set_bool(Xen settings, Xen key, Xen value)
{
- #define H_gtk_icon_view_get_visible_range "gboolean gtk_icon_view_get_visible_range(GtkIconView* icon_view, \
-GtkTreePath** [start_path], GtkTreePath** [end_path])"
- GtkTreePath* ref_start_path = NULL;
- GtkTreePath* ref_end_path = NULL;
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_visible_range", "GtkIconView*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_icon_view_get_visible_range(XEN_TO_C_GtkIconView_(icon_view), &ref_start_path, &ref_end_path));
- return(XEN_LIST_3(result, C_TO_XEN_GtkTreePath_(ref_start_path), C_TO_XEN_GtkTreePath_(ref_end_path)));
- }
+ #define H_gtk_print_settings_set_bool "void gtk_print_settings_set_bool(GtkPrintSettings* settings, \
+gchar* key, gboolean value)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_bool", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_set_bool", "gchar*");
+ Xen_check_type(Xen_is_gboolean(value), value, 3, "gtk_print_settings_set_bool", "gboolean");
+ gtk_print_settings_set_bool(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key), Xen_to_C_gboolean(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_set_cursor(XEN icon_view, XEN path, XEN cell, XEN start_editing)
+static Xen gxg_gtk_print_settings_get_double(Xen settings, Xen key)
{
- #define H_gtk_icon_view_set_cursor "void gtk_icon_view_set_cursor(GtkIconView* icon_view, GtkTreePath* path, \
-GtkCellRenderer* cell, gboolean start_editing)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_cursor", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_set_cursor", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 3, "gtk_icon_view_set_cursor", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(start_editing), start_editing, 4, "gtk_icon_view_set_cursor", "gboolean");
- gtk_icon_view_set_cursor(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkCellRenderer_(cell),
- XEN_TO_C_gboolean(start_editing));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_double "gdouble gtk_print_settings_get_double(GtkPrintSettings* settings, \
+gchar* key)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_double", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_get_double", "gchar*");
+ return(C_to_Xen_gdouble(gtk_print_settings_get_double(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key))));
}
-static XEN gxg_gtk_icon_view_get_cursor(XEN icon_view, XEN ignore_path, XEN ignore_cell)
+static Xen gxg_gtk_print_settings_get_double_with_default(Xen settings, Xen key, Xen def)
{
- #define H_gtk_icon_view_get_cursor "gboolean gtk_icon_view_get_cursor(GtkIconView* icon_view, GtkTreePath** [path], \
-GtkCellRenderer** [cell])"
- GtkTreePath* ref_path = NULL;
- GtkCellRenderer* ref_cell = NULL;
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_cursor", "GtkIconView*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_icon_view_get_cursor(XEN_TO_C_GtkIconView_(icon_view), &ref_path, &ref_cell));
- return(XEN_LIST_3(result, C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkCellRenderer_(ref_cell)));
- }
+ #define H_gtk_print_settings_get_double_with_default "gdouble gtk_print_settings_get_double_with_default(GtkPrintSettings* settings, \
+gchar* key, gdouble def)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_double_with_default", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_get_double_with_default", "gchar*");
+ Xen_check_type(Xen_is_gdouble(def), def, 3, "gtk_print_settings_get_double_with_default", "gdouble");
+ return(C_to_Xen_gdouble(gtk_print_settings_get_double_with_default(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key),
+ Xen_to_C_gdouble(def))));
}
-static XEN gxg_gtk_icon_view_scroll_to_path(XEN icon_view, XEN path, XEN use_align, XEN row_align, XEN col_align)
+static Xen gxg_gtk_print_settings_set_double(Xen settings, Xen key, Xen value)
{
- #define H_gtk_icon_view_scroll_to_path "void gtk_icon_view_scroll_to_path(GtkIconView* icon_view, GtkTreePath* path, \
-gboolean use_align, gfloat row_align, gfloat col_align)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_scroll_to_path", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_scroll_to_path", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_align), use_align, 3, "gtk_icon_view_scroll_to_path", "gboolean");
- XEN_ASSERT_TYPE(XEN_gfloat_P(row_align), row_align, 4, "gtk_icon_view_scroll_to_path", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(col_align), col_align, 5, "gtk_icon_view_scroll_to_path", "gfloat");
- gtk_icon_view_scroll_to_path(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_gboolean(use_align),
- XEN_TO_C_gfloat(row_align), XEN_TO_C_gfloat(col_align));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_double "void gtk_print_settings_set_double(GtkPrintSettings* settings, \
+gchar* key, gdouble value)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_double", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_set_double", "gchar*");
+ Xen_check_type(Xen_is_gdouble(value), value, 3, "gtk_print_settings_set_double", "gdouble");
+ gtk_print_settings_set_double(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key), Xen_to_C_gdouble(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_enable_model_drag_source(XEN icon_view, XEN start_button_mask, XEN targets, XEN n_targets, XEN actions)
+static Xen gxg_gtk_print_settings_get_length(Xen settings, Xen key, Xen unit)
{
- #define H_gtk_icon_view_enable_model_drag_source "void gtk_icon_view_enable_model_drag_source(GtkIconView* icon_view, \
-GdkModifierType start_button_mask, GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_enable_model_drag_source", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(start_button_mask), start_button_mask, 2, "gtk_icon_view_enable_model_drag_source", "GdkModifierType");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 3, "gtk_icon_view_enable_model_drag_source", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 4, "gtk_icon_view_enable_model_drag_source", "gint");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 5, "gtk_icon_view_enable_model_drag_source", "GdkDragAction");
- gtk_icon_view_enable_model_drag_source(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GdkModifierType(start_button_mask), XEN_TO_C_GtkTargetEntry_(targets),
- XEN_TO_C_gint(n_targets), XEN_TO_C_GdkDragAction(actions));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_length "gdouble gtk_print_settings_get_length(GtkPrintSettings* settings, \
+gchar* key, GtkUnit unit)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_length", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_get_length", "gchar*");
+ Xen_check_type(Xen_is_GtkUnit(unit), unit, 3, "gtk_print_settings_get_length", "GtkUnit");
+ return(C_to_Xen_gdouble(gtk_print_settings_get_length(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key), Xen_to_C_GtkUnit(unit))));
}
-static XEN gxg_gtk_icon_view_enable_model_drag_dest(XEN icon_view, XEN targets, XEN n_targets, XEN actions)
+static Xen gxg_gtk_print_settings_set_length(Xen settings, Xen key, Xen value, Xen unit)
{
- #define H_gtk_icon_view_enable_model_drag_dest "void gtk_icon_view_enable_model_drag_dest(GtkIconView* icon_view, \
-GtkTargetEntry* targets, gint n_targets, GdkDragAction actions)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_enable_model_drag_dest", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 2, "gtk_icon_view_enable_model_drag_dest", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 3, "gtk_icon_view_enable_model_drag_dest", "gint");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 4, "gtk_icon_view_enable_model_drag_dest", "GdkDragAction");
- gtk_icon_view_enable_model_drag_dest(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTargetEntry_(targets), XEN_TO_C_gint(n_targets),
- XEN_TO_C_GdkDragAction(actions));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_length "void gtk_print_settings_set_length(GtkPrintSettings* settings, \
+gchar* key, gdouble value, GtkUnit unit)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_length", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_set_length", "gchar*");
+ Xen_check_type(Xen_is_gdouble(value), value, 3, "gtk_print_settings_set_length", "gdouble");
+ Xen_check_type(Xen_is_GtkUnit(unit), unit, 4, "gtk_print_settings_set_length", "GtkUnit");
+ gtk_print_settings_set_length(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key), Xen_to_C_gdouble(value), Xen_to_C_GtkUnit(unit));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_unset_model_drag_source(XEN icon_view)
+static Xen gxg_gtk_print_settings_get_int(Xen settings, Xen key)
{
- #define H_gtk_icon_view_unset_model_drag_source "void gtk_icon_view_unset_model_drag_source(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_unset_model_drag_source", "GtkIconView*");
- gtk_icon_view_unset_model_drag_source(XEN_TO_C_GtkIconView_(icon_view));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_int "gint gtk_print_settings_get_int(GtkPrintSettings* settings, gchar* key)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_int", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_get_int", "gchar*");
+ return(C_to_Xen_gint(gtk_print_settings_get_int(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key))));
}
-static XEN gxg_gtk_icon_view_unset_model_drag_dest(XEN icon_view)
+static Xen gxg_gtk_print_settings_get_int_with_default(Xen settings, Xen key, Xen def)
{
- #define H_gtk_icon_view_unset_model_drag_dest "void gtk_icon_view_unset_model_drag_dest(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_unset_model_drag_dest", "GtkIconView*");
- gtk_icon_view_unset_model_drag_dest(XEN_TO_C_GtkIconView_(icon_view));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_int_with_default "gint gtk_print_settings_get_int_with_default(GtkPrintSettings* settings, \
+gchar* key, gint def)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_int_with_default", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_get_int_with_default", "gchar*");
+ Xen_check_type(Xen_is_gint(def), def, 3, "gtk_print_settings_get_int_with_default", "gint");
+ return(C_to_Xen_gint(gtk_print_settings_get_int_with_default(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key),
+ Xen_to_C_gint(def))));
}
-static XEN gxg_gtk_icon_view_set_reorderable(XEN icon_view, XEN reorderable)
+static Xen gxg_gtk_print_settings_set_int(Xen settings, Xen key, Xen value)
{
- #define H_gtk_icon_view_set_reorderable "void gtk_icon_view_set_reorderable(GtkIconView* icon_view, \
-gboolean reorderable)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_reorderable", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(reorderable), reorderable, 2, "gtk_icon_view_set_reorderable", "gboolean");
- gtk_icon_view_set_reorderable(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gboolean(reorderable));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_int "void gtk_print_settings_set_int(GtkPrintSettings* settings, gchar* key, \
+gint value)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_int", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(key), key, 2, "gtk_print_settings_set_int", "gchar*");
+ Xen_check_type(Xen_is_gint(value), value, 3, "gtk_print_settings_set_int", "gint");
+ gtk_print_settings_set_int(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(key), Xen_to_C_gint(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_reorderable(XEN icon_view)
+static Xen gxg_gtk_print_settings_get_printer(Xen settings)
{
- #define H_gtk_icon_view_get_reorderable "gboolean gtk_icon_view_get_reorderable(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_reorderable", "GtkIconView*");
- return(C_TO_XEN_gboolean(gtk_icon_view_get_reorderable(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_print_settings_get_printer "gchar* gtk_print_settings_get_printer(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_printer", "GtkPrintSettings*");
+ return(C_to_Xen_gchar_(gtk_print_settings_get_printer(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_icon_view_set_drag_dest_item(XEN icon_view, XEN path, XEN pos)
+static Xen gxg_gtk_print_settings_set_printer(Xen settings, Xen printer)
{
- #define H_gtk_icon_view_set_drag_dest_item "void gtk_icon_view_set_drag_dest_item(GtkIconView* icon_view, \
-GtkTreePath* path, GtkIconViewDropPosition pos)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_drag_dest_item", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_set_drag_dest_item", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkIconViewDropPosition_P(pos), pos, 3, "gtk_icon_view_set_drag_dest_item", "GtkIconViewDropPosition");
- gtk_icon_view_set_drag_dest_item(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkIconViewDropPosition(pos));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_printer "void gtk_print_settings_set_printer(GtkPrintSettings* settings, \
+gchar* printer)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_printer", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(printer), printer, 2, "gtk_print_settings_set_printer", "gchar*");
+ gtk_print_settings_set_printer(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(printer));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_drag_dest_item(XEN icon_view, XEN ignore_path, XEN ignore_pos)
+static Xen gxg_gtk_print_settings_get_orientation(Xen settings)
{
- #define H_gtk_icon_view_get_drag_dest_item "void gtk_icon_view_get_drag_dest_item(GtkIconView* icon_view, \
-GtkTreePath** [path], GtkIconViewDropPosition* [pos])"
- GtkTreePath* ref_path = NULL;
- GtkIconViewDropPosition ref_pos;
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_drag_dest_item", "GtkIconView*");
- gtk_icon_view_get_drag_dest_item(XEN_TO_C_GtkIconView_(icon_view), &ref_path, &ref_pos);
- return(XEN_LIST_2(C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkIconViewDropPosition(ref_pos)));
+ #define H_gtk_print_settings_get_orientation "GtkPageOrientation gtk_print_settings_get_orientation(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_orientation", "GtkPrintSettings*");
+ return(C_to_Xen_GtkPageOrientation(gtk_print_settings_get_orientation(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_icon_view_get_dest_item_at_pos(XEN icon_view, XEN drag_x, XEN drag_y, XEN ignore_path, XEN ignore_pos)
+static Xen gxg_gtk_print_settings_set_orientation(Xen settings, Xen orientation)
{
- #define H_gtk_icon_view_get_dest_item_at_pos "gboolean gtk_icon_view_get_dest_item_at_pos(GtkIconView* icon_view, \
-gint drag_x, gint drag_y, GtkTreePath** [path], GtkIconViewDropPosition* [pos])"
- GtkTreePath* ref_path = NULL;
- GtkIconViewDropPosition ref_pos;
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_dest_item_at_pos", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(drag_x), drag_x, 2, "gtk_icon_view_get_dest_item_at_pos", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(drag_y), drag_y, 3, "gtk_icon_view_get_dest_item_at_pos", "gint");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_icon_view_get_dest_item_at_pos(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(drag_x),
- XEN_TO_C_gint(drag_y), &ref_path, &ref_pos));
- return(XEN_LIST_3(result, C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkIconViewDropPosition(ref_pos)));
- }
+ #define H_gtk_print_settings_set_orientation "void gtk_print_settings_set_orientation(GtkPrintSettings* settings, \
+GtkPageOrientation orientation)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_orientation", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPageOrientation(orientation), orientation, 2, "gtk_print_settings_set_orientation", "GtkPageOrientation");
+ gtk_print_settings_set_orientation(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkPageOrientation(orientation));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_clear(XEN image)
+static Xen gxg_gtk_print_settings_get_paper_size(Xen settings)
{
- #define H_gtk_image_clear "void gtk_image_clear(GtkImage* image)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_clear", "GtkImage*");
- gtk_image_clear(XEN_TO_C_GtkImage_(image));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_paper_size "GtkPaperSize* gtk_print_settings_get_paper_size(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_paper_size", "GtkPrintSettings*");
+ return(C_to_Xen_GtkPaperSize_(gtk_print_settings_get_paper_size(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_menu_bar_get_pack_direction(XEN menubar)
+static Xen gxg_gtk_print_settings_set_paper_size(Xen settings, Xen paper_size)
{
- #define H_gtk_menu_bar_get_pack_direction "GtkPackDirection gtk_menu_bar_get_pack_direction(GtkMenuBar* menubar)"
- XEN_ASSERT_TYPE(XEN_GtkMenuBar__P(menubar), menubar, 1, "gtk_menu_bar_get_pack_direction", "GtkMenuBar*");
- return(C_TO_XEN_GtkPackDirection(gtk_menu_bar_get_pack_direction(XEN_TO_C_GtkMenuBar_(menubar))));
+ #define H_gtk_print_settings_set_paper_size "void gtk_print_settings_set_paper_size(GtkPrintSettings* settings, \
+GtkPaperSize* paper_size)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_paper_size", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPaperSize_(paper_size), paper_size, 2, "gtk_print_settings_set_paper_size", "GtkPaperSize*");
+ gtk_print_settings_set_paper_size(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkPaperSize_(paper_size));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_bar_set_pack_direction(XEN menubar, XEN pack_dir)
+static Xen gxg_gtk_print_settings_get_paper_width(Xen settings, Xen unit)
{
- #define H_gtk_menu_bar_set_pack_direction "void gtk_menu_bar_set_pack_direction(GtkMenuBar* menubar, \
-GtkPackDirection pack_dir)"
- XEN_ASSERT_TYPE(XEN_GtkMenuBar__P(menubar), menubar, 1, "gtk_menu_bar_set_pack_direction", "GtkMenuBar*");
- XEN_ASSERT_TYPE(XEN_GtkPackDirection_P(pack_dir), pack_dir, 2, "gtk_menu_bar_set_pack_direction", "GtkPackDirection");
- gtk_menu_bar_set_pack_direction(XEN_TO_C_GtkMenuBar_(menubar), XEN_TO_C_GtkPackDirection(pack_dir));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_paper_width "gdouble gtk_print_settings_get_paper_width(GtkPrintSettings* settings, \
+GtkUnit unit)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_paper_width", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkUnit(unit), unit, 2, "gtk_print_settings_get_paper_width", "GtkUnit");
+ return(C_to_Xen_gdouble(gtk_print_settings_get_paper_width(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkUnit(unit))));
}
-static XEN gxg_gtk_menu_bar_get_child_pack_direction(XEN menubar)
+static Xen gxg_gtk_print_settings_set_paper_width(Xen settings, Xen width, Xen unit)
{
- #define H_gtk_menu_bar_get_child_pack_direction "GtkPackDirection gtk_menu_bar_get_child_pack_direction(GtkMenuBar* menubar)"
- XEN_ASSERT_TYPE(XEN_GtkMenuBar__P(menubar), menubar, 1, "gtk_menu_bar_get_child_pack_direction", "GtkMenuBar*");
- return(C_TO_XEN_GtkPackDirection(gtk_menu_bar_get_child_pack_direction(XEN_TO_C_GtkMenuBar_(menubar))));
+ #define H_gtk_print_settings_set_paper_width "void gtk_print_settings_set_paper_width(GtkPrintSettings* settings, \
+gdouble width, GtkUnit unit)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_paper_width", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gdouble(width), width, 2, "gtk_print_settings_set_paper_width", "gdouble");
+ Xen_check_type(Xen_is_GtkUnit(unit), unit, 3, "gtk_print_settings_set_paper_width", "GtkUnit");
+ gtk_print_settings_set_paper_width(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gdouble(width), Xen_to_C_GtkUnit(unit));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_bar_set_child_pack_direction(XEN menubar, XEN child_pack_dir)
+static Xen gxg_gtk_print_settings_get_paper_height(Xen settings, Xen unit)
{
- #define H_gtk_menu_bar_set_child_pack_direction "void gtk_menu_bar_set_child_pack_direction(GtkMenuBar* menubar, \
-GtkPackDirection child_pack_dir)"
- XEN_ASSERT_TYPE(XEN_GtkMenuBar__P(menubar), menubar, 1, "gtk_menu_bar_set_child_pack_direction", "GtkMenuBar*");
- XEN_ASSERT_TYPE(XEN_GtkPackDirection_P(child_pack_dir), child_pack_dir, 2, "gtk_menu_bar_set_child_pack_direction", "GtkPackDirection");
- gtk_menu_bar_set_child_pack_direction(XEN_TO_C_GtkMenuBar_(menubar), XEN_TO_C_GtkPackDirection(child_pack_dir));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_paper_height "gdouble gtk_print_settings_get_paper_height(GtkPrintSettings* settings, \
+GtkUnit unit)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_paper_height", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkUnit(unit), unit, 2, "gtk_print_settings_get_paper_height", "GtkUnit");
+ return(C_to_Xen_gdouble(gtk_print_settings_get_paper_height(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkUnit(unit))));
}
-static XEN gxg_gtk_menu_shell_get_take_focus(XEN menu_shell)
+static Xen gxg_gtk_print_settings_set_paper_height(Xen settings, Xen height, Xen unit)
{
- #define H_gtk_menu_shell_get_take_focus "gboolean gtk_menu_shell_get_take_focus(GtkMenuShell* menu_shell)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_get_take_focus", "GtkMenuShell*");
- return(C_TO_XEN_gboolean(gtk_menu_shell_get_take_focus(XEN_TO_C_GtkMenuShell_(menu_shell))));
+ #define H_gtk_print_settings_set_paper_height "void gtk_print_settings_set_paper_height(GtkPrintSettings* settings, \
+gdouble height, GtkUnit unit)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_paper_height", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gdouble(height), height, 2, "gtk_print_settings_set_paper_height", "gdouble");
+ Xen_check_type(Xen_is_GtkUnit(unit), unit, 3, "gtk_print_settings_set_paper_height", "GtkUnit");
+ gtk_print_settings_set_paper_height(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gdouble(height), Xen_to_C_GtkUnit(unit));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_shell_set_take_focus(XEN menu_shell, XEN take_focus)
+static Xen gxg_gtk_print_settings_get_use_color(Xen settings)
{
- #define H_gtk_menu_shell_set_take_focus "void gtk_menu_shell_set_take_focus(GtkMenuShell* menu_shell, \
-gboolean take_focus)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_set_take_focus", "GtkMenuShell*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(take_focus), take_focus, 2, "gtk_menu_shell_set_take_focus", "gboolean");
- gtk_menu_shell_set_take_focus(XEN_TO_C_GtkMenuShell_(menu_shell), XEN_TO_C_gboolean(take_focus));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_use_color "gboolean gtk_print_settings_get_use_color(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_use_color", "GtkPrintSettings*");
+ return(C_to_Xen_gboolean(gtk_print_settings_get_use_color(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_scrolled_window_get_hscrollbar(XEN scrolled_window)
+static Xen gxg_gtk_print_settings_set_use_color(Xen settings, Xen use_color)
{
- #define H_gtk_scrolled_window_get_hscrollbar "GtkWidget* gtk_scrolled_window_get_hscrollbar(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_hscrollbar", "GtkScrolledWindow*");
- return(C_TO_XEN_GtkWidget_(gtk_scrolled_window_get_hscrollbar(XEN_TO_C_GtkScrolledWindow_(scrolled_window))));
+ #define H_gtk_print_settings_set_use_color "void gtk_print_settings_set_use_color(GtkPrintSettings* settings, \
+gboolean use_color)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_use_color", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gboolean(use_color), use_color, 2, "gtk_print_settings_set_use_color", "gboolean");
+ gtk_print_settings_set_use_color(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gboolean(use_color));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrolled_window_get_vscrollbar(XEN scrolled_window)
+static Xen gxg_gtk_print_settings_get_collate(Xen settings)
{
- #define H_gtk_scrolled_window_get_vscrollbar "GtkWidget* gtk_scrolled_window_get_vscrollbar(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_vscrollbar", "GtkScrolledWindow*");
- return(C_TO_XEN_GtkWidget_(gtk_scrolled_window_get_vscrollbar(XEN_TO_C_GtkScrolledWindow_(scrolled_window))));
+ #define H_gtk_print_settings_get_collate "gboolean gtk_print_settings_get_collate(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_collate", "GtkPrintSettings*");
+ return(C_to_Xen_gboolean(gtk_print_settings_get_collate(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_size_group_set_ignore_hidden(XEN size_group, XEN ignore_hidden)
+static Xen gxg_gtk_print_settings_set_collate(Xen settings, Xen collate)
{
- #define H_gtk_size_group_set_ignore_hidden "void gtk_size_group_set_ignore_hidden(GtkSizeGroup* size_group, \
-gboolean ignore_hidden)"
- XEN_ASSERT_TYPE(XEN_GtkSizeGroup__P(size_group), size_group, 1, "gtk_size_group_set_ignore_hidden", "GtkSizeGroup*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(ignore_hidden), ignore_hidden, 2, "gtk_size_group_set_ignore_hidden", "gboolean");
- gtk_size_group_set_ignore_hidden(XEN_TO_C_GtkSizeGroup_(size_group), XEN_TO_C_gboolean(ignore_hidden));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_collate "void gtk_print_settings_set_collate(GtkPrintSettings* settings, \
+gboolean collate)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_collate", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gboolean(collate), collate, 2, "gtk_print_settings_set_collate", "gboolean");
+ gtk_print_settings_set_collate(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gboolean(collate));
+ return(Xen_false);
}
-static XEN gxg_gtk_size_group_get_ignore_hidden(XEN size_group)
+static Xen gxg_gtk_print_settings_get_reverse(Xen settings)
{
- #define H_gtk_size_group_get_ignore_hidden "gboolean gtk_size_group_get_ignore_hidden(GtkSizeGroup* size_group)"
- XEN_ASSERT_TYPE(XEN_GtkSizeGroup__P(size_group), size_group, 1, "gtk_size_group_get_ignore_hidden", "GtkSizeGroup*");
- return(C_TO_XEN_gboolean(gtk_size_group_get_ignore_hidden(XEN_TO_C_GtkSizeGroup_(size_group))));
+ #define H_gtk_print_settings_get_reverse "gboolean gtk_print_settings_get_reverse(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_reverse", "GtkPrintSettings*");
+ return(C_to_Xen_gboolean(gtk_print_settings_get_reverse(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_text_iter_forward_visible_line(XEN iter)
+static Xen gxg_gtk_print_settings_set_reverse(Xen settings, Xen reverse)
{
- #define H_gtk_text_iter_forward_visible_line "gboolean gtk_text_iter_forward_visible_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_visible_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_visible_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_print_settings_set_reverse "void gtk_print_settings_set_reverse(GtkPrintSettings* settings, \
+gboolean reverse)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_reverse", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gboolean(reverse), reverse, 2, "gtk_print_settings_set_reverse", "gboolean");
+ gtk_print_settings_set_reverse(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gboolean(reverse));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_visible_line(XEN iter)
+static Xen gxg_gtk_print_settings_get_duplex(Xen settings)
{
- #define H_gtk_text_iter_backward_visible_line "gboolean gtk_text_iter_backward_visible_line(GtkTextIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_visible_line", "GtkTextIter*");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_visible_line(XEN_TO_C_GtkTextIter_(iter))));
+ #define H_gtk_print_settings_get_duplex "GtkPrintDuplex gtk_print_settings_get_duplex(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_duplex", "GtkPrintSettings*");
+ return(C_to_Xen_GtkPrintDuplex(gtk_print_settings_get_duplex(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_text_iter_forward_visible_lines(XEN iter, XEN count)
+static Xen gxg_gtk_print_settings_set_duplex(Xen settings, Xen duplex)
{
- #define H_gtk_text_iter_forward_visible_lines "gboolean gtk_text_iter_forward_visible_lines(GtkTextIter* iter, \
-gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_forward_visible_lines", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_forward_visible_lines", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_forward_visible_lines(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_print_settings_set_duplex "void gtk_print_settings_set_duplex(GtkPrintSettings* settings, \
+GtkPrintDuplex duplex)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_duplex", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPrintDuplex(duplex), duplex, 2, "gtk_print_settings_set_duplex", "GtkPrintDuplex");
+ gtk_print_settings_set_duplex(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkPrintDuplex(duplex));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_iter_backward_visible_lines(XEN iter, XEN count)
+static Xen gxg_gtk_print_settings_get_quality(Xen settings)
{
- #define H_gtk_text_iter_backward_visible_lines "gboolean gtk_text_iter_backward_visible_lines(GtkTextIter* iter, \
-gint count)"
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 1, "gtk_text_iter_backward_visible_lines", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_gint_P(count), count, 2, "gtk_text_iter_backward_visible_lines", "gint");
- return(C_TO_XEN_gboolean(gtk_text_iter_backward_visible_lines(XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_gint(count))));
+ #define H_gtk_print_settings_get_quality "GtkPrintQuality gtk_print_settings_get_quality(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_quality", "GtkPrintSettings*");
+ return(C_to_Xen_GtkPrintQuality(gtk_print_settings_get_quality(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_tool_button_set_icon_name(XEN button, XEN icon_name)
+static Xen gxg_gtk_print_settings_set_quality(Xen settings, Xen quality)
{
- #define H_gtk_tool_button_set_icon_name "void gtk_tool_button_set_icon_name(GtkToolButton* button, \
-gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_set_icon_name", "GtkToolButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_tool_button_set_icon_name", "gchar*");
- gtk_tool_button_set_icon_name(XEN_TO_C_GtkToolButton_(button), (const gchar*)XEN_TO_C_gchar_(icon_name));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_quality "void gtk_print_settings_set_quality(GtkPrintSettings* settings, \
+GtkPrintQuality quality)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_quality", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPrintQuality(quality), quality, 2, "gtk_print_settings_set_quality", "GtkPrintQuality");
+ gtk_print_settings_set_quality(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkPrintQuality(quality));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_button_get_icon_name(XEN button)
+static Xen gxg_gtk_print_settings_get_n_copies(Xen settings)
{
- #define H_gtk_tool_button_get_icon_name "gchar* gtk_tool_button_get_icon_name(GtkToolButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkToolButton__P(button), button, 1, "gtk_tool_button_get_icon_name", "GtkToolButton*");
- return(C_TO_XEN_gchar_((gchar*)gtk_tool_button_get_icon_name(XEN_TO_C_GtkToolButton_(button))));
+ #define H_gtk_print_settings_get_n_copies "gint gtk_print_settings_get_n_copies(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_n_copies", "GtkPrintSettings*");
+ return(C_to_Xen_gint(gtk_print_settings_get_n_copies(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_window_set_urgency_hint(XEN window, XEN setting)
+static Xen gxg_gtk_print_settings_set_n_copies(Xen settings, Xen num_copies)
{
- #define H_gtk_window_set_urgency_hint "void gtk_window_set_urgency_hint(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_urgency_hint", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_urgency_hint", "gboolean");
- gtk_window_set_urgency_hint(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_n_copies "void gtk_print_settings_set_n_copies(GtkPrintSettings* settings, \
+gint num_copies)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_n_copies", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gint(num_copies), num_copies, 2, "gtk_print_settings_set_n_copies", "gint");
+ gtk_print_settings_set_n_copies(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gint(num_copies));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_urgency_hint(XEN window)
+static Xen gxg_gtk_print_settings_get_number_up(Xen settings)
{
- #define H_gtk_window_get_urgency_hint "gboolean gtk_window_get_urgency_hint(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_urgency_hint", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_urgency_hint(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_print_settings_get_number_up "gint gtk_print_settings_get_number_up(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_number_up", "GtkPrintSettings*");
+ return(C_to_Xen_gint(gtk_print_settings_get_number_up(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_window_present_with_time(XEN window, XEN timestamp)
+static Xen gxg_gtk_print_settings_set_number_up(Xen settings, Xen number_up)
{
- #define H_gtk_window_present_with_time "void gtk_window_present_with_time(GtkWindow* window, guint32 timestamp)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_present_with_time", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_guint32_P(timestamp), timestamp, 2, "gtk_window_present_with_time", "guint32");
- gtk_window_present_with_time(XEN_TO_C_GtkWindow_(window), XEN_TO_C_guint32(timestamp));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_number_up "void gtk_print_settings_set_number_up(GtkPrintSettings* settings, \
+gint number_up)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_number_up", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gint(number_up), number_up, 2, "gtk_print_settings_set_number_up", "gint");
+ gtk_print_settings_set_number_up(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gint(number_up));
+ return(Xen_false);
}
-static XEN gxg_gtk_about_dialog_get_wrap_license(XEN about)
+static Xen gxg_gtk_print_settings_get_resolution(Xen settings)
{
- #define H_gtk_about_dialog_get_wrap_license "gboolean gtk_about_dialog_get_wrap_license(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_wrap_license", "GtkAboutDialog*");
- return(C_TO_XEN_gboolean(gtk_about_dialog_get_wrap_license(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_print_settings_get_resolution "gint gtk_print_settings_get_resolution(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_resolution", "GtkPrintSettings*");
+ return(C_to_Xen_gint(gtk_print_settings_get_resolution(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_about_dialog_set_wrap_license(XEN about, XEN wrap_license)
+static Xen gxg_gtk_print_settings_set_resolution(Xen settings, Xen resolution)
{
- #define H_gtk_about_dialog_set_wrap_license "void gtk_about_dialog_set_wrap_license(GtkAboutDialog* about, \
-gboolean wrap_license)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_wrap_license", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(wrap_license), wrap_license, 2, "gtk_about_dialog_set_wrap_license", "gboolean");
- gtk_about_dialog_set_wrap_license(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_gboolean(wrap_license));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_resolution "void gtk_print_settings_set_resolution(GtkPrintSettings* settings, \
+gint resolution)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_resolution", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gint(resolution), resolution, 2, "gtk_print_settings_set_resolution", "gint");
+ gtk_print_settings_set_resolution(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gint(resolution));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_set_do_overwrite_confirmation(XEN chooser, XEN do_overwrite_confirmation)
+static Xen gxg_gtk_print_settings_get_scale(Xen settings)
{
- #define H_gtk_file_chooser_set_do_overwrite_confirmation "void gtk_file_chooser_set_do_overwrite_confirmation(GtkFileChooser* chooser, \
-gboolean do_overwrite_confirmation)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_do_overwrite_confirmation", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(do_overwrite_confirmation), do_overwrite_confirmation, 2, "gtk_file_chooser_set_do_overwrite_confirmation", "gboolean");
- gtk_file_chooser_set_do_overwrite_confirmation(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gboolean(do_overwrite_confirmation));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_get_scale "gdouble gtk_print_settings_get_scale(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_scale", "GtkPrintSettings*");
+ return(C_to_Xen_gdouble(gtk_print_settings_get_scale(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_file_chooser_get_do_overwrite_confirmation(XEN chooser)
+static Xen gxg_gtk_print_settings_set_scale(Xen settings, Xen scale)
{
- #define H_gtk_file_chooser_get_do_overwrite_confirmation "gboolean gtk_file_chooser_get_do_overwrite_confirmation(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_do_overwrite_confirmation", "GtkFileChooser*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_get_do_overwrite_confirmation(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_print_settings_set_scale "void gtk_print_settings_set_scale(GtkPrintSettings* settings, \
+gdouble scale)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_scale", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gdouble(scale), scale, 2, "gtk_print_settings_set_scale", "gdouble");
+ gtk_print_settings_set_scale(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gdouble(scale));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_row_reference_get_model(XEN reference)
+static Xen gxg_gtk_print_settings_get_print_pages(Xen settings)
{
- #define H_gtk_tree_row_reference_get_model "GtkTreeModel* gtk_tree_row_reference_get_model(GtkTreeRowReference* reference)"
- XEN_ASSERT_TYPE(XEN_GtkTreeRowReference__P(reference), reference, 1, "gtk_tree_row_reference_get_model", "GtkTreeRowReference*");
- return(C_TO_XEN_GtkTreeModel_(gtk_tree_row_reference_get_model(XEN_TO_C_GtkTreeRowReference_(reference))));
+ #define H_gtk_print_settings_get_print_pages "GtkPrintPages gtk_print_settings_get_print_pages(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_print_pages", "GtkPrintSettings*");
+ return(C_to_Xen_GtkPrintPages(gtk_print_settings_get_print_pages(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_tree_view_column_queue_resize(XEN tree_column)
+static Xen gxg_gtk_print_settings_set_print_pages(Xen settings, Xen pages)
{
- #define H_gtk_tree_view_column_queue_resize "void gtk_tree_view_column_queue_resize(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_queue_resize", "GtkTreeViewColumn*");
- gtk_tree_view_column_queue_resize(XEN_TO_C_GtkTreeViewColumn_(tree_column));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_print_pages "void gtk_print_settings_set_print_pages(GtkPrintSettings* settings, \
+GtkPrintPages pages)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_print_pages", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPrintPages(pages), pages, 2, "gtk_print_settings_set_print_pages", "GtkPrintPages");
+ gtk_print_settings_set_print_pages(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkPrintPages(pages));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_visible_range(XEN tree_view, XEN ignore_start_path, XEN ignore_end_path)
+static Xen gxg_gtk_print_settings_get_page_ranges(Xen settings, Xen num_ranges)
{
- #define H_gtk_tree_view_get_visible_range "gboolean gtk_tree_view_get_visible_range(GtkTreeView* tree_view, \
-GtkTreePath** [start_path], GtkTreePath** [end_path])"
- GtkTreePath* ref_start_path = NULL;
- GtkTreePath* ref_end_path = NULL;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_visible_range", "GtkTreeView*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_tree_view_get_visible_range(XEN_TO_C_GtkTreeView_(tree_view), &ref_start_path, &ref_end_path));
- return(XEN_LIST_3(result, C_TO_XEN_GtkTreePath_(ref_start_path), C_TO_XEN_GtkTreePath_(ref_end_path)));
- }
+ #define H_gtk_print_settings_get_page_ranges "GtkPageRange* gtk_print_settings_get_page_ranges(GtkPrintSettings* settings, \
+gint* num_ranges)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_page_ranges", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gint_(num_ranges), num_ranges, 2, "gtk_print_settings_get_page_ranges", "gint*");
+ return(C_to_Xen_GtkPageRange_(gtk_print_settings_get_page_ranges(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gint_(num_ranges))));
}
-static XEN gxg_gtk_text_attributes_ref(XEN values)
+static Xen gxg_gtk_print_settings_set_page_ranges(Xen settings, Xen page_ranges, Xen num_ranges)
{
- #define H_gtk_text_attributes_ref "GtkTextAttributes* gtk_text_attributes_ref(GtkTextAttributes* values)"
- XEN_ASSERT_TYPE(XEN_GtkTextAttributes__P(values), values, 1, "gtk_text_attributes_ref", "GtkTextAttributes*");
- return(C_TO_XEN_GtkTextAttributes_(gtk_text_attributes_ref(XEN_TO_C_GtkTextAttributes_(values))));
+ #define H_gtk_print_settings_set_page_ranges "void gtk_print_settings_set_page_ranges(GtkPrintSettings* settings, \
+GtkPageRange* page_ranges, gint num_ranges)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_page_ranges", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPageRange_(page_ranges), page_ranges, 2, "gtk_print_settings_set_page_ranges", "GtkPageRange*");
+ Xen_check_type(Xen_is_gint(num_ranges), num_ranges, 3, "gtk_print_settings_set_page_ranges", "gint");
+ gtk_print_settings_set_page_ranges(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkPageRange_(page_ranges), Xen_to_C_gint(num_ranges));
+ return(Xen_false);
}
-static XEN gxg_pango_attr_list_ref(XEN list)
+static Xen gxg_gtk_print_settings_get_page_set(Xen settings)
{
- #define H_pango_attr_list_ref "PangoAttrList* pango_attr_list_ref(PangoAttrList* list)"
- XEN_ASSERT_TYPE(XEN_PangoAttrList__P(list), list, 1, "pango_attr_list_ref", "PangoAttrList*");
- return(C_TO_XEN_PangoAttrList_(pango_attr_list_ref(XEN_TO_C_PangoAttrList_(list))));
+ #define H_gtk_print_settings_get_page_set "GtkPageSet gtk_print_settings_get_page_set(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_page_set", "GtkPrintSettings*");
+ return(C_to_Xen_GtkPageSet(gtk_print_settings_get_page_set(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_pango_layout_line_ref(XEN line)
+static Xen gxg_gtk_print_settings_set_page_set(Xen settings, Xen page_set)
{
- #define H_pango_layout_line_ref "PangoLayoutLine* pango_layout_line_ref(PangoLayoutLine* line)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 1, "pango_layout_line_ref", "PangoLayoutLine*");
- return(C_TO_XEN_PangoLayoutLine_(pango_layout_line_ref(XEN_TO_C_PangoLayoutLine_(line))));
+ #define H_gtk_print_settings_set_page_set "void gtk_print_settings_set_page_set(GtkPrintSettings* settings, \
+GtkPageSet page_set)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_page_set", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_GtkPageSet(page_set), page_set, 2, "gtk_print_settings_set_page_set", "GtkPageSet");
+ gtk_print_settings_set_page_set(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_GtkPageSet(page_set));
+ return(Xen_false);
}
-static XEN gxg_pango_layout_index_to_line_x(XEN layout, XEN index_, XEN trailing, XEN ignore_line, XEN ignore_x_pos)
+static Xen gxg_gtk_print_settings_get_default_source(Xen settings)
{
- #define H_pango_layout_index_to_line_x "void pango_layout_index_to_line_x(PangoLayout* layout, int index_, \
-gboolean trailing, int* [line], int* [x_pos])"
- int ref_line;
- int ref_x_pos;
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "pango_layout_index_to_line_x", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_int_P(index_), index_, 2, "pango_layout_index_to_line_x", "int");
- XEN_ASSERT_TYPE(XEN_gboolean_P(trailing), trailing, 3, "pango_layout_index_to_line_x", "gboolean");
- pango_layout_index_to_line_x(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_int(index_), XEN_TO_C_gboolean(trailing), &ref_line,
- &ref_x_pos);
- return(XEN_LIST_2(C_TO_XEN_int(ref_line), C_TO_XEN_int(ref_x_pos)));
+ #define H_gtk_print_settings_get_default_source "gchar* gtk_print_settings_get_default_source(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_default_source", "GtkPrintSettings*");
+ return(C_to_Xen_gchar_(gtk_print_settings_get_default_source(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gtk_target_list_ref(XEN list)
+static Xen gxg_gtk_print_settings_set_default_source(Xen settings, Xen default_source)
{
- #define H_gtk_target_list_ref "GtkTargetList* gtk_target_list_ref(GtkTargetList* list)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_ref", "GtkTargetList*");
- return(C_TO_XEN_GtkTargetList_(gtk_target_list_ref(XEN_TO_C_GtkTargetList_(list))));
+ #define H_gtk_print_settings_set_default_source "void gtk_print_settings_set_default_source(GtkPrintSettings* settings, \
+gchar* default_source)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_default_source", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(default_source), default_source, 2, "gtk_print_settings_set_default_source", "gchar*");
+ gtk_print_settings_set_default_source(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(default_source));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_supports_shapes(XEN display)
+static Xen gxg_gtk_print_settings_get_media_type(Xen settings)
{
- #define H_gdk_display_supports_shapes "gboolean gdk_display_supports_shapes(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_supports_shapes", "GdkDisplay*");
- return(C_TO_XEN_gboolean(gdk_display_supports_shapes(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_print_settings_get_media_type "gchar* gtk_print_settings_get_media_type(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_media_type", "GtkPrintSettings*");
+ return(C_to_Xen_gchar_(gtk_print_settings_get_media_type(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gdk_display_supports_input_shapes(XEN display)
+static Xen gxg_gtk_print_settings_set_media_type(Xen settings, Xen media_type)
{
- #define H_gdk_display_supports_input_shapes "gboolean gdk_display_supports_input_shapes(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_supports_input_shapes", "GdkDisplay*");
- return(C_TO_XEN_gboolean(gdk_display_supports_input_shapes(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_print_settings_set_media_type "void gtk_print_settings_set_media_type(GtkPrintSettings* settings, \
+gchar* media_type)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_media_type", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(media_type), media_type, 2, "gtk_print_settings_set_media_type", "gchar*");
+ gtk_print_settings_set_media_type(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(media_type));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_is_composited(XEN screen)
+static Xen gxg_gtk_print_settings_get_dither(Xen settings)
{
- #define H_gdk_screen_is_composited "gboolean gdk_screen_is_composited(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_is_composited", "GdkScreen*");
- return(C_TO_XEN_gboolean(gdk_screen_is_composited(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_print_settings_get_dither "gchar* gtk_print_settings_get_dither(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_dither", "GtkPrintSettings*");
+ return(C_to_Xen_gchar_(gtk_print_settings_get_dither(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gdk_screen_set_resolution(XEN screen, XEN dpi)
+static Xen gxg_gtk_print_settings_set_dither(Xen settings, Xen dither)
{
- #define H_gdk_screen_set_resolution "void gdk_screen_set_resolution(GdkScreen* screen, gdouble dpi)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_set_resolution", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(dpi), dpi, 2, "gdk_screen_set_resolution", "gdouble");
- gdk_screen_set_resolution(XEN_TO_C_GdkScreen_(screen), XEN_TO_C_gdouble(dpi));
- return(XEN_FALSE);
+ #define H_gtk_print_settings_set_dither "void gtk_print_settings_set_dither(GtkPrintSettings* settings, \
+gchar* dither)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_dither", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(dither), dither, 2, "gtk_print_settings_set_dither", "gchar*");
+ gtk_print_settings_set_dither(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(dither));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_resolution(XEN screen)
+static Xen gxg_gtk_print_settings_get_finishings(Xen settings)
{
- #define H_gdk_screen_get_resolution "gdouble gdk_screen_get_resolution(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_resolution", "GdkScreen*");
- return(C_TO_XEN_gdouble(gdk_screen_get_resolution(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_print_settings_get_finishings "gchar* gtk_print_settings_get_finishings(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_finishings", "GtkPrintSettings*");
+ return(C_to_Xen_gchar_(gtk_print_settings_get_finishings(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gdk_screen_get_active_window(XEN screen)
+static Xen gxg_gtk_print_settings_set_finishings(Xen settings, Xen finishings)
{
- #define H_gdk_screen_get_active_window "GdkWindow* gdk_screen_get_active_window(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_active_window", "GdkScreen*");
- return(C_TO_XEN_GdkWindow_(gdk_screen_get_active_window(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_print_settings_set_finishings "void gtk_print_settings_set_finishings(GtkPrintSettings* settings, \
+gchar* finishings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_finishings", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(finishings), finishings, 2, "gtk_print_settings_set_finishings", "gchar*");
+ gtk_print_settings_set_finishings(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(finishings));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_window_stack(XEN screen)
+static Xen gxg_gtk_print_settings_get_output_bin(Xen settings)
{
- #define H_gdk_screen_get_window_stack "GList* gdk_screen_get_window_stack(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_window_stack", "GdkScreen*");
- return(C_TO_XEN_GList_(gdk_screen_get_window_stack(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_print_settings_get_output_bin "gchar* gtk_print_settings_get_output_bin(GtkPrintSettings* settings)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_get_output_bin", "GtkPrintSettings*");
+ return(C_to_Xen_gchar_(gtk_print_settings_get_output_bin(Xen_to_C_GtkPrintSettings_(settings))));
}
-static XEN gxg_gdk_window_get_type_hint(XEN window)
+static Xen gxg_gtk_print_settings_set_output_bin(Xen settings, Xen output_bin)
{
- #define H_gdk_window_get_type_hint "GdkWindowTypeHint gdk_window_get_type_hint(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_type_hint", "GdkWindow*");
- return(C_TO_XEN_GdkWindowTypeHint(gdk_window_get_type_hint(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_print_settings_set_output_bin "void gtk_print_settings_set_output_bin(GtkPrintSettings* settings, \
+gchar* output_bin)"
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_set_output_bin", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(output_bin), output_bin, 2, "gtk_print_settings_set_output_bin", "gchar*");
+ gtk_print_settings_set_output_bin(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(output_bin));
+ return(Xen_false);
}
-static XEN gxg_gtk_clipboard_request_rich_text(XEN clipboard, XEN buffer, XEN func, XEN func_info)
+static Xen gxg_gtk_settings_get_for_screen(Xen screen)
{
- #define H_gtk_clipboard_request_rich_text "void gtk_clipboard_request_rich_text(GtkClipboard* clipboard, \
-GtkTextBuffer* buffer, GtkClipboardRichTextReceivedFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_request_rich_text", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 2, "gtk_clipboard_request_rich_text", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkClipboardRichTextReceivedFunc_P(func), func, 3, "gtk_clipboard_request_rich_text", "GtkClipboardRichTextReceivedFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gtk_clipboard_request_rich_text", "lambda_data");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- gtk_clipboard_request_rich_text(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkClipboardRichTextReceivedFunc(func),
- XEN_TO_C_lambda_data(func_info));
- return(XEN_FALSE);
- }
+ #define H_gtk_settings_get_for_screen "GtkSettings* gtk_settings_get_for_screen(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gtk_settings_get_for_screen", "GdkScreen*");
+ return(C_to_Xen_GtkSettings_(gtk_settings_get_for_screen(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_gtk_clipboard_wait_for_rich_text(XEN clipboard, XEN buffer, XEN format, XEN ignore_length)
+static Xen gxg_pango_cairo_create_layout(Xen cr)
{
- #define H_gtk_clipboard_wait_for_rich_text "guint8* gtk_clipboard_wait_for_rich_text(GtkClipboard* clipboard, \
-GtkTextBuffer* buffer, GdkAtom* format, gsize* [length])"
- gsize ref_length;
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_for_rich_text", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 2, "gtk_clipboard_wait_for_rich_text", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GdkAtom__P(format), format, 3, "gtk_clipboard_wait_for_rich_text", "GdkAtom*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_guint8_(gtk_clipboard_wait_for_rich_text(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkTextBuffer_(buffer),
- XEN_TO_C_GdkAtom_(format), &ref_length));
- return(XEN_LIST_2(result, C_TO_XEN_gsize(ref_length)));
- }
+ #define H_pango_cairo_create_layout "PangoLayout* pango_cairo_create_layout(cairo_t* cr)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_create_layout", "cairo_t*");
+ return(C_to_Xen_PangoLayout_(pango_cairo_create_layout(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_gtk_clipboard_wait_is_rich_text_available(XEN clipboard, XEN buffer)
+static Xen gxg_pango_cairo_update_layout(Xen cr, Xen layout)
{
- #define H_gtk_clipboard_wait_is_rich_text_available "gboolean gtk_clipboard_wait_is_rich_text_available(GtkClipboard* clipboard, \
-GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_is_rich_text_available", "GtkClipboard*");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 2, "gtk_clipboard_wait_is_rich_text_available", "GtkTextBuffer*");
- return(C_TO_XEN_gboolean(gtk_clipboard_wait_is_rich_text_available(XEN_TO_C_GtkClipboard_(clipboard), XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_pango_cairo_update_layout "void pango_cairo_update_layout(cairo_t* cr, PangoLayout* layout)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_update_layout", "cairo_t*");
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 2, "pango_cairo_update_layout", "PangoLayout*");
+ pango_cairo_update_layout(Xen_to_C_cairo_t_(cr), Xen_to_C_PangoLayout_(layout));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_get_title(XEN combo_box)
+static Xen gxg_pango_cairo_update_context(Xen cr, Xen context)
{
- #define H_gtk_combo_box_get_title "gchar* gtk_combo_box_get_title(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_title", "GtkComboBox*");
- return(C_TO_XEN_gchar_(gtk_combo_box_get_title(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_pango_cairo_update_context "void pango_cairo_update_context(cairo_t* cr, PangoContext* context)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_update_context", "cairo_t*");
+ Xen_check_type(Xen_is_PangoContext_(context), context, 2, "pango_cairo_update_context", "PangoContext*");
+ pango_cairo_update_context(Xen_to_C_cairo_t_(cr), Xen_to_C_PangoContext_(context));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_set_title(XEN combo_box, XEN title)
+static Xen gxg_pango_cairo_context_set_font_options(Xen context, Xen options)
{
- #define H_gtk_combo_box_set_title "void gtk_combo_box_set_title(GtkComboBox* combo_box, gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_title", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gtk_combo_box_set_title", "gchar*");
- gtk_combo_box_set_title(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_pango_cairo_context_set_font_options "void pango_cairo_context_set_font_options(PangoContext* context, \
+cairo_font_options_t* options)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_cairo_context_set_font_options", "PangoContext*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 2, "pango_cairo_context_set_font_options", "cairo_font_options_t*");
+ pango_cairo_context_set_font_options(Xen_to_C_PangoContext_(context), Xen_to_C_cairo_font_options_t_(options));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_dest_set_track_motion(XEN widget, XEN track_motion)
+static Xen gxg_pango_cairo_context_get_font_options(Xen context)
{
- #define H_gtk_drag_dest_set_track_motion "void gtk_drag_dest_set_track_motion(GtkWidget* widget, gboolean track_motion)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_set_track_motion", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(track_motion), track_motion, 2, "gtk_drag_dest_set_track_motion", "gboolean");
- gtk_drag_dest_set_track_motion(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(track_motion));
- return(XEN_FALSE);
+ #define H_pango_cairo_context_get_font_options "cairo_font_options_t* pango_cairo_context_get_font_options(PangoContext* context)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_cairo_context_get_font_options", "PangoContext*");
+ return(C_to_Xen_cairo_font_options_t_((cairo_font_options_t*)pango_cairo_context_get_font_options(Xen_to_C_PangoContext_(context))));
}
-static XEN gxg_gtk_drag_dest_get_track_motion(XEN widget)
+static Xen gxg_pango_cairo_context_set_resolution(Xen context, Xen dpi)
{
- #define H_gtk_drag_dest_get_track_motion "gboolean gtk_drag_dest_get_track_motion(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_get_track_motion", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_drag_dest_get_track_motion(XEN_TO_C_GtkWidget_(widget))));
+ #define H_pango_cairo_context_set_resolution "void pango_cairo_context_set_resolution(PangoContext* context, \
+gdouble dpi)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_cairo_context_set_resolution", "PangoContext*");
+ Xen_check_type(Xen_is_gdouble(dpi), dpi, 2, "pango_cairo_context_set_resolution", "gdouble");
+ pango_cairo_context_set_resolution(Xen_to_C_PangoContext_(context), Xen_to_C_gdouble(dpi));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_button_get_focus_on_click(XEN button)
+static Xen gxg_pango_cairo_context_get_resolution(Xen context)
{
- #define H_gtk_file_chooser_button_get_focus_on_click "gboolean gtk_file_chooser_button_get_focus_on_click(GtkFileChooserButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooserButton__P(button), button, 1, "gtk_file_chooser_button_get_focus_on_click", "GtkFileChooserButton*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_button_get_focus_on_click(XEN_TO_C_GtkFileChooserButton_(button))));
+ #define H_pango_cairo_context_get_resolution "gdouble pango_cairo_context_get_resolution(PangoContext* context)"
+ Xen_check_type(Xen_is_PangoContext_(context), context, 1, "pango_cairo_context_get_resolution", "PangoContext*");
+ return(C_to_Xen_gdouble(pango_cairo_context_get_resolution(Xen_to_C_PangoContext_(context))));
}
-static XEN gxg_gtk_file_chooser_button_set_focus_on_click(XEN button, XEN focus_on_click)
+static Xen gxg_pango_cairo_show_glyph_string(Xen cr, Xen font, Xen glyphs)
{
- #define H_gtk_file_chooser_button_set_focus_on_click "void gtk_file_chooser_button_set_focus_on_click(GtkFileChooserButton* button, \
-gboolean focus_on_click)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooserButton__P(button), button, 1, "gtk_file_chooser_button_set_focus_on_click", "GtkFileChooserButton*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(focus_on_click), focus_on_click, 2, "gtk_file_chooser_button_set_focus_on_click", "gboolean");
- gtk_file_chooser_button_set_focus_on_click(XEN_TO_C_GtkFileChooserButton_(button), XEN_TO_C_gboolean(focus_on_click));
- return(XEN_FALSE);
+ #define H_pango_cairo_show_glyph_string "void pango_cairo_show_glyph_string(cairo_t* cr, PangoFont* font, \
+PangoGlyphString* glyphs)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_show_glyph_string", "cairo_t*");
+ Xen_check_type(Xen_is_PangoFont_(font), font, 2, "pango_cairo_show_glyph_string", "PangoFont*");
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 3, "pango_cairo_show_glyph_string", "PangoGlyphString*");
+ pango_cairo_show_glyph_string(Xen_to_C_cairo_t_(cr), Xen_to_C_PangoFont_(font), Xen_to_C_PangoGlyphString_(glyphs));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_tab_reorderable(XEN notebook, XEN child)
+static Xen gxg_pango_cairo_show_layout_line(Xen cr, Xen line)
{
- #define H_gtk_notebook_get_tab_reorderable "gboolean gtk_notebook_get_tab_reorderable(GtkNotebook* notebook, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_tab_reorderable", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_get_tab_reorderable", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_notebook_get_tab_reorderable(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child))));
+ #define H_pango_cairo_show_layout_line "void pango_cairo_show_layout_line(cairo_t* cr, PangoLayoutLine* line)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_show_layout_line", "cairo_t*");
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 2, "pango_cairo_show_layout_line", "PangoLayoutLine*");
+ pango_cairo_show_layout_line(Xen_to_C_cairo_t_(cr), Xen_to_C_PangoLayoutLine_(line));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_set_tab_reorderable(XEN notebook, XEN child, XEN reorderable)
+static Xen gxg_pango_cairo_show_layout(Xen cr, Xen layout)
{
- #define H_gtk_notebook_set_tab_reorderable "void gtk_notebook_set_tab_reorderable(GtkNotebook* notebook, \
-GtkWidget* child, gboolean reorderable)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_tab_reorderable", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_set_tab_reorderable", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(reorderable), reorderable, 3, "gtk_notebook_set_tab_reorderable", "gboolean");
- gtk_notebook_set_tab_reorderable(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gboolean(reorderable));
- return(XEN_FALSE);
+ #define H_pango_cairo_show_layout "void pango_cairo_show_layout(cairo_t* cr, PangoLayout* layout)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_show_layout", "cairo_t*");
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 2, "pango_cairo_show_layout", "PangoLayout*");
+ pango_cairo_show_layout(Xen_to_C_cairo_t_(cr), Xen_to_C_PangoLayout_(layout));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_tab_detachable(XEN notebook, XEN child)
+static Xen gxg_pango_cairo_show_error_underline(Xen cr, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gtk_notebook_get_tab_detachable "gboolean gtk_notebook_get_tab_detachable(GtkNotebook* notebook, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_tab_detachable", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_get_tab_detachable", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_notebook_get_tab_detachable(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child))));
+ #define H_pango_cairo_show_error_underline "void pango_cairo_show_error_underline(cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_show_error_underline", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 2, "pango_cairo_show_error_underline", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 3, "pango_cairo_show_error_underline", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 4, "pango_cairo_show_error_underline", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 5, "pango_cairo_show_error_underline", "gdouble");
+ pango_cairo_show_error_underline(Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y), Xen_to_C_gdouble(width),
+ Xen_to_C_gdouble(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_set_tab_detachable(XEN notebook, XEN child, XEN detachable)
+static Xen gxg_pango_cairo_glyph_string_path(Xen cr, Xen font, Xen glyphs)
{
- #define H_gtk_notebook_set_tab_detachable "void gtk_notebook_set_tab_detachable(GtkNotebook* notebook, \
-GtkWidget* child, gboolean detachable)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_tab_detachable", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_notebook_set_tab_detachable", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(detachable), detachable, 3, "gtk_notebook_set_tab_detachable", "gboolean");
- gtk_notebook_set_tab_detachable(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gboolean(detachable));
- return(XEN_FALSE);
+ #define H_pango_cairo_glyph_string_path "void pango_cairo_glyph_string_path(cairo_t* cr, PangoFont* font, \
+PangoGlyphString* glyphs)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_glyph_string_path", "cairo_t*");
+ Xen_check_type(Xen_is_PangoFont_(font), font, 2, "pango_cairo_glyph_string_path", "PangoFont*");
+ Xen_check_type(Xen_is_PangoGlyphString_(glyphs), glyphs, 3, "pango_cairo_glyph_string_path", "PangoGlyphString*");
+ pango_cairo_glyph_string_path(Xen_to_C_cairo_t_(cr), Xen_to_C_PangoFont_(font), Xen_to_C_PangoGlyphString_(glyphs));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_action_set_current_value(XEN action, XEN current_value)
+static Xen gxg_pango_cairo_layout_line_path(Xen cr, Xen line)
{
- #define H_gtk_radio_action_set_current_value "void gtk_radio_action_set_current_value(GtkRadioAction* action, \
-gint current_value)"
- XEN_ASSERT_TYPE(XEN_GtkRadioAction__P(action), action, 1, "gtk_radio_action_set_current_value", "GtkRadioAction*");
- XEN_ASSERT_TYPE(XEN_gint_P(current_value), current_value, 2, "gtk_radio_action_set_current_value", "gint");
- gtk_radio_action_set_current_value(XEN_TO_C_GtkRadioAction_(action), XEN_TO_C_gint(current_value));
- return(XEN_FALSE);
+ #define H_pango_cairo_layout_line_path "void pango_cairo_layout_line_path(cairo_t* cr, PangoLayoutLine* line)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_layout_line_path", "cairo_t*");
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 2, "pango_cairo_layout_line_path", "PangoLayoutLine*");
+ pango_cairo_layout_line_path(Xen_to_C_cairo_t_(cr), Xen_to_C_PangoLayoutLine_(line));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_set_lower_stepper_sensitivity(XEN range, XEN sensitivity)
+static Xen gxg_pango_cairo_layout_path(Xen cr, Xen layout)
{
- #define H_gtk_range_set_lower_stepper_sensitivity "void gtk_range_set_lower_stepper_sensitivity(GtkRange* range, \
-GtkSensitivityType sensitivity)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_lower_stepper_sensitivity", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_GtkSensitivityType_P(sensitivity), sensitivity, 2, "gtk_range_set_lower_stepper_sensitivity", "GtkSensitivityType");
- gtk_range_set_lower_stepper_sensitivity(XEN_TO_C_GtkRange_(range), XEN_TO_C_GtkSensitivityType(sensitivity));
- return(XEN_FALSE);
+ #define H_pango_cairo_layout_path "void pango_cairo_layout_path(cairo_t* cr, PangoLayout* layout)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_layout_path", "cairo_t*");
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 2, "pango_cairo_layout_path", "PangoLayout*");
+ pango_cairo_layout_path(Xen_to_C_cairo_t_(cr), Xen_to_C_PangoLayout_(layout));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_get_lower_stepper_sensitivity(XEN range)
+static Xen gxg_pango_cairo_error_underline_path(Xen cr, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gtk_range_get_lower_stepper_sensitivity "GtkSensitivityType gtk_range_get_lower_stepper_sensitivity(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_lower_stepper_sensitivity", "GtkRange*");
- return(C_TO_XEN_GtkSensitivityType(gtk_range_get_lower_stepper_sensitivity(XEN_TO_C_GtkRange_(range))));
+ #define H_pango_cairo_error_underline_path "void pango_cairo_error_underline_path(cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "pango_cairo_error_underline_path", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 2, "pango_cairo_error_underline_path", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 3, "pango_cairo_error_underline_path", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 4, "pango_cairo_error_underline_path", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 5, "pango_cairo_error_underline_path", "gdouble");
+ pango_cairo_error_underline_path(Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y), Xen_to_C_gdouble(width),
+ Xen_to_C_gdouble(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_set_upper_stepper_sensitivity(XEN range, XEN sensitivity)
+static Xen gxg_gdk_cairo_set_source_pixbuf(Xen cr, Xen pixbuf, Xen pixbuf_x, Xen pixbuf_y)
{
- #define H_gtk_range_set_upper_stepper_sensitivity "void gtk_range_set_upper_stepper_sensitivity(GtkRange* range, \
-GtkSensitivityType sensitivity)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_upper_stepper_sensitivity", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_GtkSensitivityType_P(sensitivity), sensitivity, 2, "gtk_range_set_upper_stepper_sensitivity", "GtkSensitivityType");
- gtk_range_set_upper_stepper_sensitivity(XEN_TO_C_GtkRange_(range), XEN_TO_C_GtkSensitivityType(sensitivity));
- return(XEN_FALSE);
+ #define H_gdk_cairo_set_source_pixbuf "void gdk_cairo_set_source_pixbuf(cairo_t* cr, GdkPixbuf* pixbuf, \
+gdouble pixbuf_x, gdouble pixbuf_y)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "gdk_cairo_set_source_pixbuf", "cairo_t*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 2, "gdk_cairo_set_source_pixbuf", "GdkPixbuf*");
+ Xen_check_type(Xen_is_gdouble(pixbuf_x), pixbuf_x, 3, "gdk_cairo_set_source_pixbuf", "gdouble");
+ Xen_check_type(Xen_is_gdouble(pixbuf_y), pixbuf_y, 4, "gdk_cairo_set_source_pixbuf", "gdouble");
+ gdk_cairo_set_source_pixbuf(Xen_to_C_cairo_t_(cr), Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_gdouble(pixbuf_x), Xen_to_C_gdouble(pixbuf_y));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_get_upper_stepper_sensitivity(XEN range)
+static Xen gxg_gdk_cairo_rectangle(Xen cr, Xen rectangle)
{
- #define H_gtk_range_get_upper_stepper_sensitivity "GtkSensitivityType gtk_range_get_upper_stepper_sensitivity(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_upper_stepper_sensitivity", "GtkRange*");
- return(C_TO_XEN_GtkSensitivityType(gtk_range_get_upper_stepper_sensitivity(XEN_TO_C_GtkRange_(range))));
+ #define H_gdk_cairo_rectangle "void gdk_cairo_rectangle(cairo_t* cr, GdkRectangle* rectangle)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "gdk_cairo_rectangle", "cairo_t*");
+ Xen_check_type(Xen_is_GdkRectangle_(rectangle), rectangle, 2, "gdk_cairo_rectangle", "GdkRectangle*");
+ gdk_cairo_rectangle(Xen_to_C_cairo_t_(cr), Xen_to_C_GdkRectangle_(rectangle));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrolled_window_unset_placement(XEN scrolled_window)
+static Xen gxg_gdk_event_request_motions(Xen event)
{
- #define H_gtk_scrolled_window_unset_placement "void gtk_scrolled_window_unset_placement(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_unset_placement", "GtkScrolledWindow*");
- gtk_scrolled_window_unset_placement(XEN_TO_C_GtkScrolledWindow_(scrolled_window));
- return(XEN_FALSE);
+ #define H_gdk_event_request_motions "void gdk_event_request_motions(GdkEventMotion* event)"
+ Xen_check_type(Xen_is_GdkEventMotion_(event), event, 1, "gdk_event_request_motions", "GdkEventMotion*");
+ gdk_event_request_motions(Xen_to_C_GdkEventMotion_(event));
+ return(Xen_false);
}
-static XEN gxg_gtk_target_list_add_rich_text_targets(XEN list, XEN info, XEN deserializable, XEN buffer)
+static Xen gxg_gdk_notify_startup_complete_with_id(Xen startup_id)
{
- #define H_gtk_target_list_add_rich_text_targets "void gtk_target_list_add_rich_text_targets(GtkTargetList* list, \
-guint info, gboolean deserializable, GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_list_add_rich_text_targets", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_guint_P(info), info, 2, "gtk_target_list_add_rich_text_targets", "guint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(deserializable), deserializable, 3, "gtk_target_list_add_rich_text_targets", "gboolean");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 4, "gtk_target_list_add_rich_text_targets", "GtkTextBuffer*");
- gtk_target_list_add_rich_text_targets(XEN_TO_C_GtkTargetList_(list), XEN_TO_C_guint(info), XEN_TO_C_gboolean(deserializable),
- XEN_TO_C_GtkTextBuffer_(buffer));
- return(XEN_FALSE);
+ #define H_gdk_notify_startup_complete_with_id "void gdk_notify_startup_complete_with_id(gchar* startup_id)"
+ Xen_check_type(Xen_is_gchar_(startup_id), startup_id, 1, "gdk_notify_startup_complete_with_id", "gchar*");
+ gdk_notify_startup_complete_with_id(Xen_to_C_gchar_(startup_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_target_table_new_from_list(XEN list, XEN ignore_n_targets)
+static Xen gxg_gdk_threads_add_idle_full(Xen priority, Xen func, Xen func_info, Xen notify)
{
- #define H_gtk_target_table_new_from_list "GtkTargetEntry* gtk_target_table_new_from_list(GtkTargetList* list, \
-gint* [n_targets])"
- gint ref_n_targets;
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(list), list, 1, "gtk_target_table_new_from_list", "GtkTargetList*");
+ #define H_gdk_threads_add_idle_full "guint gdk_threads_add_idle_full(gint priority, GSourceFunc func, \
+lambda_data func_info, GDestroyNotify notify)"
+ Xen_check_type(Xen_is_gint(priority), priority, 1, "gdk_threads_add_idle_full", "gint");
+ Xen_check_type(Xen_is_GSourceFunc(func), func, 2, "gdk_threads_add_idle_full", "GSourceFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gdk_threads_add_idle_full", "lambda_data");
+ Xen_check_type(Xen_is_GDestroyNotify(notify), notify, 4, "gdk_threads_add_idle_full", "GDestroyNotify");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GtkTargetEntry_(gtk_target_table_new_from_list(XEN_TO_C_GtkTargetList_(list), &ref_n_targets));
- return(XEN_LIST_2(result, C_TO_XEN_gint(ref_n_targets)));
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_guint(gdk_threads_add_idle_full(Xen_to_C_gint(priority), Xen_to_C_GSourceFunc(func), Xen_to_C_lambda_data(func_info),
+ Xen_to_C_GDestroyNotify(notify)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
}
}
-static XEN gxg_gtk_target_table_free(XEN targets, XEN n_targets)
-{
- #define H_gtk_target_table_free "void gtk_target_table_free(GtkTargetEntry* targets, gint n_targets)"
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(targets), targets, 1, "gtk_target_table_free", "GtkTargetEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 2, "gtk_target_table_free", "gint");
- gtk_target_table_free(XEN_TO_C_GtkTargetEntry_(targets), XEN_TO_C_gint(n_targets));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_selection_data_targets_include_rich_text(XEN selection_data, XEN buffer)
+static Xen gxg_gdk_threads_add_idle(Xen func, Xen func_info)
{
- #define H_gtk_selection_data_targets_include_rich_text "gboolean gtk_selection_data_targets_include_rich_text(GtkSelectionData* selection_data, \
-GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_targets_include_rich_text", "GtkSelectionData*");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 2, "gtk_selection_data_targets_include_rich_text", "GtkTextBuffer*");
- return(C_TO_XEN_gboolean(gtk_selection_data_targets_include_rich_text(XEN_TO_C_GtkSelectionData_(selection_data), XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gdk_threads_add_idle "guint gdk_threads_add_idle(GSourceFunc func, lambda_data func_info)"
+ Xen_check_type(Xen_is_GSourceFunc(func), func, 1, "gdk_threads_add_idle", "GSourceFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 2, "gdk_threads_add_idle", "lambda_data");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_guint(gdk_threads_add_idle(Xen_to_C_GSourceFunc(func), Xen_to_C_lambda_data(func_info)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
+ }
}
-static XEN gxg_gtk_selection_data_targets_include_uri(XEN selection_data)
+static Xen gxg_gdk_threads_add_timeout_full(Xen priority, Xen interval, Xen func, Xen func_info, Xen notify)
{
- #define H_gtk_selection_data_targets_include_uri "gboolean gtk_selection_data_targets_include_uri(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_targets_include_uri", "GtkSelectionData*");
- return(C_TO_XEN_gboolean(gtk_selection_data_targets_include_uri(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gdk_threads_add_timeout_full "guint gdk_threads_add_timeout_full(gint priority, guint interval, \
+GSourceFunc func, lambda_data func_info, GDestroyNotify notify)"
+ Xen_check_type(Xen_is_gint(priority), priority, 1, "gdk_threads_add_timeout_full", "gint");
+ Xen_check_type(Xen_is_guint(interval), interval, 2, "gdk_threads_add_timeout_full", "guint");
+ Xen_check_type(Xen_is_GSourceFunc(func), func, 3, "gdk_threads_add_timeout_full", "GSourceFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "gdk_threads_add_timeout_full", "lambda_data");
+ Xen_check_type(Xen_is_GDestroyNotify(notify), notify, 5, "gdk_threads_add_timeout_full", "GDestroyNotify");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_guint(gdk_threads_add_timeout_full(Xen_to_C_gint(priority), Xen_to_C_guint(interval), Xen_to_C_GSourceFunc(func),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GDestroyNotify(notify)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
+ }
}
-static XEN gxg_gtk_targets_include_text(XEN targets, XEN n_targets)
+static Xen gxg_gdk_threads_add_timeout(Xen interval, Xen func, Xen func_info)
{
- #define H_gtk_targets_include_text "gboolean gtk_targets_include_text(GdkAtom* targets, gint n_targets)"
- XEN_ASSERT_TYPE(XEN_GdkAtom__P(targets), targets, 1, "gtk_targets_include_text", "GdkAtom*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 2, "gtk_targets_include_text", "gint");
- return(C_TO_XEN_gboolean(gtk_targets_include_text(XEN_TO_C_GdkAtom_(targets), XEN_TO_C_gint(n_targets))));
+ #define H_gdk_threads_add_timeout "guint gdk_threads_add_timeout(guint interval, GSourceFunc func, \
+lambda_data func_info)"
+ Xen_check_type(Xen_is_guint(interval), interval, 1, "gdk_threads_add_timeout", "guint");
+ Xen_check_type(Xen_is_GSourceFunc(func), func, 2, "gdk_threads_add_timeout", "GSourceFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gdk_threads_add_timeout", "lambda_data");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(func, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_guint(gdk_threads_add_timeout(Xen_to_C_guint(interval), Xen_to_C_GSourceFunc(func), Xen_to_C_lambda_data(func_info)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
+ }
}
-static XEN gxg_gtk_targets_include_rich_text(XEN targets, XEN n_targets, XEN buffer)
+static Xen gxg_gdk_window_set_startup_id(Xen window, Xen startup_id)
{
- #define H_gtk_targets_include_rich_text "gboolean gtk_targets_include_rich_text(GdkAtom* targets, gint n_targets, \
-GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GdkAtom__P(targets), targets, 1, "gtk_targets_include_rich_text", "GdkAtom*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 2, "gtk_targets_include_rich_text", "gint");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 3, "gtk_targets_include_rich_text", "GtkTextBuffer*");
- return(C_TO_XEN_gboolean(gtk_targets_include_rich_text(XEN_TO_C_GdkAtom_(targets), XEN_TO_C_gint(n_targets), XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gdk_window_set_startup_id "void gdk_window_set_startup_id(GdkWindow* window, gchar* startup_id)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_startup_id", "GdkWindow*");
+ Xen_check_type(Xen_is_gchar_(startup_id), startup_id, 2, "gdk_window_set_startup_id", "gchar*");
+ gdk_window_set_startup_id(Xen_to_C_GdkWindow_(window), Xen_to_C_gchar_(startup_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_targets_include_image(XEN targets, XEN n_targets, XEN writable)
+static Xen gxg_gdk_window_beep(Xen window)
{
- #define H_gtk_targets_include_image "gboolean gtk_targets_include_image(GdkAtom* targets, gint n_targets, \
-gboolean writable)"
- XEN_ASSERT_TYPE(XEN_GdkAtom__P(targets), targets, 1, "gtk_targets_include_image", "GdkAtom*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 2, "gtk_targets_include_image", "gint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(writable), writable, 3, "gtk_targets_include_image", "gboolean");
- return(C_TO_XEN_gboolean(gtk_targets_include_image(XEN_TO_C_GdkAtom_(targets), XEN_TO_C_gint(n_targets), XEN_TO_C_gboolean(writable))));
+ #define H_gdk_window_beep "void gdk_window_beep(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_beep", "GdkWindow*");
+ gdk_window_beep(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_targets_include_uri(XEN targets, XEN n_targets)
+static Xen gxg_gdk_window_set_opacity(Xen window, Xen opacity)
{
- #define H_gtk_targets_include_uri "gboolean gtk_targets_include_uri(GdkAtom* targets, gint n_targets)"
- XEN_ASSERT_TYPE(XEN_GdkAtom__P(targets), targets, 1, "gtk_targets_include_uri", "GdkAtom*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_targets), n_targets, 2, "gtk_targets_include_uri", "gint");
- return(C_TO_XEN_gboolean(gtk_targets_include_uri(XEN_TO_C_GdkAtom_(targets), XEN_TO_C_gint(n_targets))));
+ #define H_gdk_window_set_opacity "void gdk_window_set_opacity(GdkWindow* window, gdouble opacity)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_opacity", "GdkWindow*");
+ Xen_check_type(Xen_is_gdouble(opacity), opacity, 2, "gdk_window_set_opacity", "gdouble");
+ gdk_window_set_opacity(Xen_to_C_GdkWindow_(window), Xen_to_C_gdouble(opacity));
+ return(Xen_false);
}
-static XEN gxg_gtk_size_group_get_widgets(XEN size_group)
+static Xen gxg_gtk_binding_entry_skip(Xen binding_set, Xen keyval, Xen modifiers)
{
- #define H_gtk_size_group_get_widgets "GSList* gtk_size_group_get_widgets(GtkSizeGroup* size_group)"
- XEN_ASSERT_TYPE(XEN_GtkSizeGroup__P(size_group), size_group, 1, "gtk_size_group_get_widgets", "GtkSizeGroup*");
- return(C_TO_XEN_GSList_(gtk_size_group_get_widgets(XEN_TO_C_GtkSizeGroup_(size_group))));
+ #define H_gtk_binding_entry_skip "void gtk_binding_entry_skip(GtkBindingSet* binding_set, guint keyval, \
+GdkModifierType modifiers)"
+ Xen_check_type(Xen_is_GtkBindingSet_(binding_set), binding_set, 1, "gtk_binding_entry_skip", "GtkBindingSet*");
+ Xen_check_type(Xen_is_guint(keyval), keyval, 2, "gtk_binding_entry_skip", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(modifiers), modifiers, 3, "gtk_binding_entry_skip", "GdkModifierType");
+ gtk_binding_entry_skip(Xen_to_C_GtkBindingSet_(binding_set), Xen_to_C_guint(keyval), Xen_to_C_GdkModifierType(modifiers));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_get_has_selection(XEN buffer)
+static Xen gxg_gtk_cell_layout_get_cells(Xen cell_layout)
{
- #define H_gtk_text_buffer_get_has_selection "gboolean gtk_text_buffer_get_has_selection(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_has_selection", "GtkTextBuffer*");
- return(C_TO_XEN_gboolean(gtk_text_buffer_get_has_selection(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_cell_layout_get_cells "GList* gtk_cell_layout_get_cells(GtkCellLayout* cell_layout)"
+ Xen_check_type(Xen_is_GtkCellLayout_(cell_layout), cell_layout, 1, "gtk_cell_layout_get_cells", "GtkCellLayout*");
+ return(C_to_Xen_GList_(gtk_cell_layout_get_cells(Xen_to_C_GtkCellLayout_(cell_layout))));
}
-static XEN gxg_gtk_text_buffer_get_copy_target_list(XEN buffer)
+static Xen gxg_gtk_entry_completion_set_inline_selection(Xen completion, Xen inline_selection)
{
- #define H_gtk_text_buffer_get_copy_target_list "GtkTargetList* gtk_text_buffer_get_copy_target_list(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_copy_target_list", "GtkTextBuffer*");
- return(C_TO_XEN_GtkTargetList_(gtk_text_buffer_get_copy_target_list(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_entry_completion_set_inline_selection "void gtk_entry_completion_set_inline_selection(GtkEntryCompletion* completion, \
+gboolean inline_selection)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_set_inline_selection", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_gboolean(inline_selection), inline_selection, 2, "gtk_entry_completion_set_inline_selection", "gboolean");
+ gtk_entry_completion_set_inline_selection(Xen_to_C_GtkEntryCompletion_(completion), Xen_to_C_gboolean(inline_selection));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_get_paste_target_list(XEN buffer)
+static Xen gxg_gtk_entry_completion_get_inline_selection(Xen completion)
{
- #define H_gtk_text_buffer_get_paste_target_list "GtkTargetList* gtk_text_buffer_get_paste_target_list(GtkTextBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_paste_target_list", "GtkTextBuffer*");
- return(C_TO_XEN_GtkTargetList_(gtk_text_buffer_get_paste_target_list(XEN_TO_C_GtkTextBuffer_(buffer))));
+ #define H_gtk_entry_completion_get_inline_selection "gboolean gtk_entry_completion_get_inline_selection(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_inline_selection", "GtkEntryCompletion*");
+ return(C_to_Xen_gboolean(gtk_entry_completion_get_inline_selection(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_gtk_tree_view_get_headers_clickable(XEN tree_view)
+static Xen gxg_gtk_entry_completion_get_completion_prefix(Xen completion)
{
- #define H_gtk_tree_view_get_headers_clickable "gboolean gtk_tree_view_get_headers_clickable(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_headers_clickable", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_headers_clickable(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_entry_completion_get_completion_prefix "gchar* gtk_entry_completion_get_completion_prefix(GtkEntryCompletion* completion)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_get_completion_prefix", "GtkEntryCompletion*");
+ return(C_to_Xen_gchar_(gtk_entry_completion_get_completion_prefix(Xen_to_C_GtkEntryCompletion_(completion))));
}
-static XEN gxg_gtk_tree_view_get_search_entry(XEN tree_view)
+static Xen gxg_gtk_entry_set_cursor_hadjustment(Xen entry, Xen adjustment)
{
- #define H_gtk_tree_view_get_search_entry "GtkEntry* gtk_tree_view_get_search_entry(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_search_entry", "GtkTreeView*");
- return(C_TO_XEN_GtkEntry_(gtk_tree_view_get_search_entry(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_entry_set_cursor_hadjustment "void gtk_entry_set_cursor_hadjustment(GtkEntry* entry, \
+GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_cursor_hadjustment", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_entry_set_cursor_hadjustment", "GtkAdjustment*");
+ gtk_entry_set_cursor_hadjustment(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_search_entry(XEN tree_view, XEN entry)
+static Xen gxg_gtk_entry_get_cursor_hadjustment(Xen entry)
{
- #define H_gtk_tree_view_set_search_entry "void gtk_tree_view_set_search_entry(GtkTreeView* tree_view, \
-GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_search_entry", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 2, "gtk_tree_view_set_search_entry", "GtkEntry*");
- gtk_tree_view_set_search_entry(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkEntry_(entry));
- return(XEN_FALSE);
+ #define H_gtk_entry_get_cursor_hadjustment "GtkAdjustment* gtk_entry_get_cursor_hadjustment(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_cursor_hadjustment", "GtkEntry*");
+ return(C_to_Xen_GtkAdjustment_(gtk_entry_get_cursor_hadjustment(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_tree_view_get_search_position_func(XEN tree_view)
+static Xen gxg_gtk_icon_theme_list_contexts(Xen icon_theme)
{
- #define H_gtk_tree_view_get_search_position_func "GtkTreeViewSearchPositionFunc gtk_tree_view_get_search_position_func(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_search_position_func", "GtkTreeView*");
- return(C_TO_XEN_GtkTreeViewSearchPositionFunc(gtk_tree_view_get_search_position_func(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_icon_theme_list_contexts "GList* gtk_icon_theme_list_contexts(GtkIconTheme* icon_theme)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_list_contexts", "GtkIconTheme*");
+ return(C_to_Xen_GList_(gtk_icon_theme_list_contexts(Xen_to_C_GtkIconTheme_(icon_theme))));
}
-static XEN gxg_gtk_tree_view_set_search_position_func(XEN tree_view, XEN func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_print_settings_new_from_file(Xen file_name, Xen ignore_error)
{
- #define H_gtk_tree_view_set_search_position_func "void gtk_tree_view_set_search_position_func(GtkTreeView* tree_view, \
-GtkTreeViewSearchPositionFunc func, lambda_data func_info, GDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_search_position_func", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewSearchPositionFunc_P(func), func, 2, "gtk_tree_view_set_search_position_func", "GtkTreeViewSearchPositionFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_tree_view_set_search_position_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(destroy), destroy, 4, "gtk_tree_view_set_search_position_func", "GDestroyNotify");
+ #define H_gtk_print_settings_new_from_file "GtkPrintSettings* gtk_print_settings_new_from_file(gchar* file_name, \
+GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_gchar_(file_name), file_name, 1, "gtk_print_settings_new_from_file", "gchar*");
{
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- gtk_tree_view_set_search_position_func(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewSearchPositionFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GDestroyNotify(destroy));
- return(XEN_FALSE);
+ Xen result;
+ result = C_to_Xen_GtkPrintSettings_(gtk_print_settings_new_from_file(Xen_to_C_gchar_(file_name), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
}
}
-static XEN gxg_gtk_widget_is_composited(XEN widget)
+static Xen gxg_gtk_print_settings_to_file(Xen settings, Xen file_name, Xen ignore_error)
{
- #define H_gtk_widget_is_composited "gboolean gtk_widget_is_composited(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_is_composited", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_is_composited(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_print_settings_to_file "gboolean gtk_print_settings_to_file(GtkPrintSettings* settings, \
+gchar* file_name, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkPrintSettings_(settings), settings, 1, "gtk_print_settings_to_file", "GtkPrintSettings*");
+ Xen_check_type(Xen_is_gchar_(file_name), file_name, 2, "gtk_print_settings_to_file", "gchar*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_print_settings_to_file(Xen_to_C_GtkPrintSettings_(settings), Xen_to_C_gchar_(file_name),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_window_set_deletable(XEN window, XEN setting)
+static Xen gxg_gtk_range_set_show_fill_level(Xen range, Xen show_fill_level)
{
- #define H_gtk_window_set_deletable "void gtk_window_set_deletable(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_deletable", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_deletable", "gboolean");
- gtk_window_set_deletable(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_range_set_show_fill_level "void gtk_range_set_show_fill_level(GtkRange* range, gboolean, \
+show_fill_level)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_show_fill_level", "GtkRange*");
+ Xen_check_type(Xen_is_gboolean(show_fill_level), show_fill_level, 2, "gtk_range_set_show_fill_level", "gboolean");
+ gtk_range_set_show_fill_level(Xen_to_C_GtkRange_(range), Xen_to_C_gboolean(show_fill_level));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_deletable(XEN window)
+static Xen gxg_gtk_range_get_show_fill_level(Xen range)
{
- #define H_gtk_window_get_deletable "gboolean gtk_window_get_deletable(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_deletable", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_deletable(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_range_get_show_fill_level "gboolean gtk_range_get_show_fill_level(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_show_fill_level", "GtkRange*");
+ return(C_to_Xen_gboolean(gtk_range_get_show_fill_level(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_assistant_new(void)
+static Xen gxg_gtk_range_set_restrict_to_fill_level(Xen range, Xen restrict_to_fill_level)
{
- #define H_gtk_assistant_new "GtkWidget* gtk_assistant_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_assistant_new()));
+ #define H_gtk_range_set_restrict_to_fill_level "void gtk_range_set_restrict_to_fill_level(GtkRange* range, \
+ gboolean, restrict_to_fill_level)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_restrict_to_fill_level", "GtkRange*");
+ Xen_check_type(Xen_is_gboolean(restrict_to_fill_level), restrict_to_fill_level, 2, "gtk_range_set_restrict_to_fill_level", "gboolean");
+ gtk_range_set_restrict_to_fill_level(Xen_to_C_GtkRange_(range), Xen_to_C_gboolean(restrict_to_fill_level));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_get_current_page(XEN assistant)
+static Xen gxg_gtk_range_get_restrict_to_fill_level(Xen range)
{
- #define H_gtk_assistant_get_current_page "gint gtk_assistant_get_current_page(GtkAssistant* assistant)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_get_current_page", "GtkAssistant*");
- return(C_TO_XEN_gint(gtk_assistant_get_current_page(XEN_TO_C_GtkAssistant_(assistant))));
+ #define H_gtk_range_get_restrict_to_fill_level "gboolean gtk_range_get_restrict_to_fill_level(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_restrict_to_fill_level", "GtkRange*");
+ return(C_to_Xen_gboolean(gtk_range_get_restrict_to_fill_level(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_assistant_set_current_page(XEN assistant, XEN page_num)
+static Xen gxg_gtk_range_set_fill_level(Xen range, Xen fill_level)
{
- #define H_gtk_assistant_set_current_page "void gtk_assistant_set_current_page(GtkAssistant* assistant, \
-gint page_num)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_set_current_page", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_gint_P(page_num), page_num, 2, "gtk_assistant_set_current_page", "gint");
- gtk_assistant_set_current_page(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_gint(page_num));
- return(XEN_FALSE);
+ #define H_gtk_range_set_fill_level "void gtk_range_set_fill_level(GtkRange* range, gdouble, fill_level)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_fill_level", "GtkRange*");
+ Xen_check_type(Xen_is_gdouble(fill_level), fill_level, 2, "gtk_range_set_fill_level", "gdouble");
+ gtk_range_set_fill_level(Xen_to_C_GtkRange_(range), Xen_to_C_gdouble(fill_level));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_get_n_pages(XEN assistant)
+static Xen gxg_gtk_range_get_fill_level(Xen range)
{
- #define H_gtk_assistant_get_n_pages "gint gtk_assistant_get_n_pages(GtkAssistant* assistant)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_get_n_pages", "GtkAssistant*");
- return(C_TO_XEN_gint(gtk_assistant_get_n_pages(XEN_TO_C_GtkAssistant_(assistant))));
+ #define H_gtk_range_get_fill_level "gdouble gtk_range_get_fill_level(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_fill_level", "GtkRange*");
+ return(C_to_Xen_gdouble(gtk_range_get_fill_level(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_assistant_get_nth_page(XEN assistant, XEN page_num)
+static Xen gxg_gtk_tree_view_set_show_expanders(Xen tree_view, Xen enabled)
{
- #define H_gtk_assistant_get_nth_page "GtkWidget* gtk_assistant_get_nth_page(GtkAssistant* assistant, \
-gint page_num)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_get_nth_page", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_gint_P(page_num), page_num, 2, "gtk_assistant_get_nth_page", "gint");
- return(C_TO_XEN_GtkWidget_(gtk_assistant_get_nth_page(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_gint(page_num))));
+ #define H_gtk_tree_view_set_show_expanders "void gtk_tree_view_set_show_expanders(GtkTreeView* tree_view, \
+gboolean enabled)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_show_expanders", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(enabled), enabled, 2, "gtk_tree_view_set_show_expanders", "gboolean");
+ gtk_tree_view_set_show_expanders(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(enabled));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_prepend_page(XEN assistant, XEN page)
+static Xen gxg_gtk_tree_view_get_show_expanders(Xen tree_view)
{
- #define H_gtk_assistant_prepend_page "gint gtk_assistant_prepend_page(GtkAssistant* assistant, GtkWidget* page)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_prepend_page", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_prepend_page", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_assistant_prepend_page(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page))));
+ #define H_gtk_tree_view_get_show_expanders "gboolean gtk_tree_view_get_show_expanders(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_show_expanders", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_show_expanders(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_assistant_append_page(XEN assistant, XEN page)
+static Xen gxg_gtk_tree_view_set_level_indentation(Xen tree_view, Xen indentation)
{
- #define H_gtk_assistant_append_page "gint gtk_assistant_append_page(GtkAssistant* assistant, GtkWidget* page)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_append_page", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_append_page", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_assistant_append_page(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page))));
+ #define H_gtk_tree_view_set_level_indentation "void gtk_tree_view_set_level_indentation(GtkTreeView* tree_view, \
+gint indentation)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_level_indentation", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(indentation), indentation, 2, "gtk_tree_view_set_level_indentation", "gint");
+ gtk_tree_view_set_level_indentation(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(indentation));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_insert_page(XEN assistant, XEN page, XEN position)
+static Xen gxg_gtk_tree_view_get_level_indentation(Xen tree_view)
{
- #define H_gtk_assistant_insert_page "gint gtk_assistant_insert_page(GtkAssistant* assistant, GtkWidget* page, \
-gint position)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_insert_page", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_insert_page", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_assistant_insert_page", "gint");
- return(C_TO_XEN_gint(gtk_assistant_insert_page(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page), XEN_TO_C_gint(position))));
+ #define H_gtk_tree_view_get_level_indentation "gint gtk_tree_view_get_level_indentation(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_level_indentation", "GtkTreeView*");
+ return(C_to_Xen_gint(gtk_tree_view_get_level_indentation(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_assistant_set_forward_page_func(XEN assistant, XEN page_func, XEN func_info, XEN destroy)
+static Xen gxg_gtk_widget_keynav_failed(Xen widget, Xen direction)
{
- #define H_gtk_assistant_set_forward_page_func "void gtk_assistant_set_forward_page_func(GtkAssistant* assistant, \
-GtkAssistantPageFunc page_func, lambda_data func_info, GDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_set_forward_page_func", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkAssistantPageFunc_P(page_func), page_func, 2, "gtk_assistant_set_forward_page_func", "GtkAssistantPageFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_assistant_set_forward_page_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(destroy), destroy, 4, "gtk_assistant_set_forward_page_func", "GDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(XEN_FALSE, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- gtk_assistant_set_forward_page_func(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkAssistantPageFunc(page_func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GDestroyNotify(destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_keynav_failed "gboolean gtk_widget_keynav_failed(GtkWidget* widget, GtkDirectionType direction)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_keynav_failed", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkDirectionType(direction), direction, 2, "gtk_widget_keynav_failed", "GtkDirectionType");
+ return(C_to_Xen_gboolean(gtk_widget_keynav_failed(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkDirectionType(direction))));
}
-static XEN gxg_gtk_assistant_set_page_type(XEN assistant, XEN page, XEN type)
+static Xen gxg_gtk_widget_error_bell(Xen widget)
{
- #define H_gtk_assistant_set_page_type "void gtk_assistant_set_page_type(GtkAssistant* assistant, GtkWidget* page, \
-GtkAssistantPageType type)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_set_page_type", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_set_page_type", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkAssistantPageType_P(type), type, 3, "gtk_assistant_set_page_type", "GtkAssistantPageType");
- gtk_assistant_set_page_type(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page), XEN_TO_C_GtkAssistantPageType(type));
- return(XEN_FALSE);
+ #define H_gtk_widget_error_bell "void gtk_widget_error_bell(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_error_bell", "GtkWidget*");
+ gtk_widget_error_bell(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_get_page_type(XEN assistant, XEN page)
+static Xen gxg_gtk_widget_set_tooltip_window(Xen widget, Xen custom_window)
{
- #define H_gtk_assistant_get_page_type "GtkAssistantPageType gtk_assistant_get_page_type(GtkAssistant* assistant, \
-GtkWidget* page)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_get_page_type", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_get_page_type", "GtkWidget*");
- return(C_TO_XEN_GtkAssistantPageType(gtk_assistant_get_page_type(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page))));
+ #define H_gtk_widget_set_tooltip_window "void gtk_widget_set_tooltip_window(GtkWidget* widget, GtkWindow* custom_window)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_tooltip_window", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWindow_(custom_window), custom_window, 2, "gtk_widget_set_tooltip_window", "GtkWindow*");
+ gtk_widget_set_tooltip_window(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkWindow_(custom_window));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_set_page_title(XEN assistant, XEN page, XEN title)
+static Xen gxg_gtk_widget_get_tooltip_window(Xen widget)
{
- #define H_gtk_assistant_set_page_title "void gtk_assistant_set_page_title(GtkAssistant* assistant, \
-GtkWidget* page, gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_set_page_title", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_set_page_title", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 3, "gtk_assistant_set_page_title", "gchar*");
- gtk_assistant_set_page_title(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_tooltip_window "GtkWindow* gtk_widget_get_tooltip_window(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_tooltip_window", "GtkWidget*");
+ return(C_to_Xen_GtkWindow_(gtk_widget_get_tooltip_window(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_assistant_get_page_title(XEN assistant, XEN page)
+static Xen gxg_gtk_widget_trigger_tooltip_query(Xen widget)
{
- #define H_gtk_assistant_get_page_title "gchar* gtk_assistant_get_page_title(GtkAssistant* assistant, \
-GtkWidget* page)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_get_page_title", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_get_page_title", "GtkWidget*");
- return(C_TO_XEN_gchar_(gtk_assistant_get_page_title(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page))));
+ #define H_gtk_widget_trigger_tooltip_query "void gtk_widget_trigger_tooltip_query(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_trigger_tooltip_query", "GtkWidget*");
+ gtk_widget_trigger_tooltip_query(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_set_page_header_image(XEN assistant, XEN page, XEN pixbuf)
+static Xen gxg_gtk_window_set_startup_id(Xen window, Xen startup_id)
{
- #define H_gtk_assistant_set_page_header_image "void gtk_assistant_set_page_header_image(GtkAssistant* assistant, \
-GtkWidget* page, GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_set_page_header_image", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_set_page_header_image", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 3, "gtk_assistant_set_page_header_image", "GdkPixbuf*");
- gtk_assistant_set_page_header_image(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_window_set_startup_id "void gtk_window_set_startup_id(GtkWindow* window, gchar* startup_id)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_startup_id", "GtkWindow*");
+ Xen_check_type(Xen_is_gchar_(startup_id), startup_id, 2, "gtk_window_set_startup_id", "gchar*");
+ gtk_window_set_startup_id(Xen_to_C_GtkWindow_(window), Xen_to_C_gchar_(startup_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_get_page_header_image(XEN assistant, XEN page)
+static Xen gxg_gtk_text_buffer_add_mark(Xen buffer, Xen mark, Xen where)
{
- #define H_gtk_assistant_get_page_header_image "GdkPixbuf* gtk_assistant_get_page_header_image(GtkAssistant* assistant, \
-GtkWidget* page)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_get_page_header_image", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_get_page_header_image", "GtkWidget*");
- return(C_TO_XEN_GdkPixbuf_(gtk_assistant_get_page_header_image(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page))));
+ #define H_gtk_text_buffer_add_mark "void gtk_text_buffer_add_mark(GtkTextBuffer* buffer, GtkTextMark* mark, \
+GtkTextIter* where)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_add_mark", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextMark_(mark), mark, 2, "gtk_text_buffer_add_mark", "GtkTextMark*");
+ Xen_check_type(Xen_is_GtkTextIter_(where), where, 3, "gtk_text_buffer_add_mark", "GtkTextIter*");
+ gtk_text_buffer_add_mark(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextMark_(mark), Xen_to_C_GtkTextIter_(where));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_set_page_side_image(XEN assistant, XEN page, XEN pixbuf)
+static Xen gxg_gtk_text_mark_new(Xen name, Xen left_gravity)
{
- #define H_gtk_assistant_set_page_side_image "void gtk_assistant_set_page_side_image(GtkAssistant* assistant, \
-GtkWidget* page, GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_set_page_side_image", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_set_page_side_image", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 3, "gtk_assistant_set_page_side_image", "GdkPixbuf*");
- gtk_assistant_set_page_side_image(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_text_mark_new "GtkTextMark* gtk_text_mark_new(gchar* name, gboolean left_gravity)"
+ Xen_check_type(Xen_is_gchar_(name), name, 1, "gtk_text_mark_new", "gchar*");
+ Xen_check_type(Xen_is_gboolean(left_gravity), left_gravity, 2, "gtk_text_mark_new", "gboolean");
+ return(C_to_Xen_GtkTextMark_(gtk_text_mark_new(Xen_to_C_gchar_(name), Xen_to_C_gboolean(left_gravity))));
}
-static XEN gxg_gtk_assistant_get_page_side_image(XEN assistant, XEN page)
+static Xen gxg_gtk_tree_view_column_get_tree_view(Xen tree_column)
{
- #define H_gtk_assistant_get_page_side_image "GdkPixbuf* gtk_assistant_get_page_side_image(GtkAssistant* assistant, \
-GtkWidget* page)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_get_page_side_image", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_get_page_side_image", "GtkWidget*");
- return(C_TO_XEN_GdkPixbuf_(gtk_assistant_get_page_side_image(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page))));
+ #define H_gtk_tree_view_column_get_tree_view "GtkWidget* gtk_tree_view_column_get_tree_view(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_tree_view", "GtkTreeViewColumn*");
+ return(C_to_Xen_GtkWidget_(gtk_tree_view_column_get_tree_view(Xen_to_C_GtkTreeViewColumn_(tree_column))));
}
-static XEN gxg_gtk_assistant_set_page_complete(XEN assistant, XEN page, XEN complete)
+static Xen gxg_gtk_tooltip_set_text(Xen tooltip, Xen text)
{
- #define H_gtk_assistant_set_page_complete "void gtk_assistant_set_page_complete(GtkAssistant* assistant, \
-GtkWidget* page, gboolean complete)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_set_page_complete", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_set_page_complete", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(complete), complete, 3, "gtk_assistant_set_page_complete", "gboolean");
- gtk_assistant_set_page_complete(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page), XEN_TO_C_gboolean(complete));
- return(XEN_FALSE);
+ #define H_gtk_tooltip_set_text "void gtk_tooltip_set_text(GtkTooltip* tooltip, gchar* text)"
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 1, "gtk_tooltip_set_text", "GtkTooltip*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_tooltip_set_text", "gchar*");
+ gtk_tooltip_set_text(Xen_to_C_GtkTooltip_(tooltip), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_get_page_complete(XEN assistant, XEN page)
+static Xen gxg_gtk_tree_view_convert_widget_to_tree_coords(Xen tree_view, Xen wx, Xen wy, Xen ignore_tx, Xen ignore_ty)
{
- #define H_gtk_assistant_get_page_complete "gboolean gtk_assistant_get_page_complete(GtkAssistant* assistant, \
-GtkWidget* page)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_get_page_complete", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(page), page, 2, "gtk_assistant_get_page_complete", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_assistant_get_page_complete(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(page))));
+ #define H_gtk_tree_view_convert_widget_to_tree_coords "void gtk_tree_view_convert_widget_to_tree_coords(GtkTreeView* tree_view, \
+gint wx, gint wy, gint* [tx], gint* [ty])"
+ gint ref_tx;
+ gint ref_ty;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_convert_widget_to_tree_coords", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(wx), wx, 2, "gtk_tree_view_convert_widget_to_tree_coords", "gint");
+ Xen_check_type(Xen_is_gint(wy), wy, 3, "gtk_tree_view_convert_widget_to_tree_coords", "gint");
+ gtk_tree_view_convert_widget_to_tree_coords(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(wx), Xen_to_C_gint(wy), &ref_tx,
+ &ref_ty);
+ return(Xen_list_2(C_to_Xen_gint(ref_tx), C_to_Xen_gint(ref_ty)));
}
-static XEN gxg_gtk_assistant_add_action_widget(XEN assistant, XEN child)
+static Xen gxg_gtk_tree_view_convert_tree_to_widget_coords(Xen tree_view, Xen tx, Xen ty, Xen ignore_wx, Xen ignore_wy)
{
- #define H_gtk_assistant_add_action_widget "void gtk_assistant_add_action_widget(GtkAssistant* assistant, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_add_action_widget", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_assistant_add_action_widget", "GtkWidget*");
- gtk_assistant_add_action_widget(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(child));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_convert_tree_to_widget_coords "void gtk_tree_view_convert_tree_to_widget_coords(GtkTreeView* tree_view, \
+gint tx, gint ty, gint* [wx], gint* [wy])"
+ gint ref_wx;
+ gint ref_wy;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_convert_tree_to_widget_coords", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(tx), tx, 2, "gtk_tree_view_convert_tree_to_widget_coords", "gint");
+ Xen_check_type(Xen_is_gint(ty), ty, 3, "gtk_tree_view_convert_tree_to_widget_coords", "gint");
+ gtk_tree_view_convert_tree_to_widget_coords(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(tx), Xen_to_C_gint(ty), &ref_wx,
+ &ref_wy);
+ return(Xen_list_2(C_to_Xen_gint(ref_wx), C_to_Xen_gint(ref_wy)));
}
-static XEN gxg_gtk_assistant_remove_action_widget(XEN assistant, XEN child)
+static Xen gxg_gtk_tree_view_convert_widget_to_bin_window_coords(Xen tree_view, Xen wx, Xen wy, Xen ignore_bx, Xen ignore_by)
{
- #define H_gtk_assistant_remove_action_widget "void gtk_assistant_remove_action_widget(GtkAssistant* assistant, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_remove_action_widget", "GtkAssistant*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_assistant_remove_action_widget", "GtkWidget*");
- gtk_assistant_remove_action_widget(XEN_TO_C_GtkAssistant_(assistant), XEN_TO_C_GtkWidget_(child));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_convert_widget_to_bin_window_coords "void gtk_tree_view_convert_widget_to_bin_window_coords(GtkTreeView* tree_view, \
+gint wx, gint wy, gint* [bx], gint* [by])"
+ gint ref_bx;
+ gint ref_by;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_convert_widget_to_bin_window_coords", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(wx), wx, 2, "gtk_tree_view_convert_widget_to_bin_window_coords", "gint");
+ Xen_check_type(Xen_is_gint(wy), wy, 3, "gtk_tree_view_convert_widget_to_bin_window_coords", "gint");
+ gtk_tree_view_convert_widget_to_bin_window_coords(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(wx), Xen_to_C_gint(wy),
+ &ref_bx, &ref_by);
+ return(Xen_list_2(C_to_Xen_gint(ref_bx), C_to_Xen_gint(ref_by)));
}
-static XEN gxg_gtk_assistant_update_buttons_state(XEN assistant)
+static Xen gxg_gtk_tree_view_convert_bin_window_to_widget_coords(Xen tree_view, Xen bx, Xen by, Xen ignore_wx, Xen ignore_wy)
{
- #define H_gtk_assistant_update_buttons_state "void gtk_assistant_update_buttons_state(GtkAssistant* assistant)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_update_buttons_state", "GtkAssistant*");
- gtk_assistant_update_buttons_state(XEN_TO_C_GtkAssistant_(assistant));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_convert_bin_window_to_widget_coords "void gtk_tree_view_convert_bin_window_to_widget_coords(GtkTreeView* tree_view, \
+gint bx, gint by, gint* [wx], gint* [wy])"
+ gint ref_wx;
+ gint ref_wy;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_convert_bin_window_to_widget_coords", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(bx), bx, 2, "gtk_tree_view_convert_bin_window_to_widget_coords", "gint");
+ Xen_check_type(Xen_is_gint(by), by, 3, "gtk_tree_view_convert_bin_window_to_widget_coords", "gint");
+ gtk_tree_view_convert_bin_window_to_widget_coords(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(bx), Xen_to_C_gint(by),
+ &ref_wx, &ref_wy);
+ return(Xen_list_2(C_to_Xen_gint(ref_wx), C_to_Xen_gint(ref_wy)));
}
-static XEN gxg_gtk_cell_renderer_accel_new(void)
+static Xen gxg_gtk_tree_view_convert_tree_to_bin_window_coords(Xen tree_view, Xen tx, Xen ty, Xen ignore_bx, Xen ignore_by)
{
- #define H_gtk_cell_renderer_accel_new "GtkCellRenderer* gtk_cell_renderer_accel_new( void)"
- return(C_TO_XEN_GtkCellRenderer_(gtk_cell_renderer_accel_new()));
+ #define H_gtk_tree_view_convert_tree_to_bin_window_coords "void gtk_tree_view_convert_tree_to_bin_window_coords(GtkTreeView* tree_view, \
+gint tx, gint ty, gint* [bx], gint* [by])"
+ gint ref_bx;
+ gint ref_by;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_convert_tree_to_bin_window_coords", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(tx), tx, 2, "gtk_tree_view_convert_tree_to_bin_window_coords", "gint");
+ Xen_check_type(Xen_is_gint(ty), ty, 3, "gtk_tree_view_convert_tree_to_bin_window_coords", "gint");
+ gtk_tree_view_convert_tree_to_bin_window_coords(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(tx), Xen_to_C_gint(ty),
+ &ref_bx, &ref_by);
+ return(Xen_list_2(C_to_Xen_gint(ref_bx), C_to_Xen_gint(ref_by)));
}
-static XEN gxg_gtk_cell_renderer_spin_new(void)
+static Xen gxg_gtk_tree_view_convert_bin_window_to_tree_coords(Xen tree_view, Xen bx, Xen by, Xen ignore_tx, Xen ignore_ty)
{
- #define H_gtk_cell_renderer_spin_new "GtkCellRenderer* gtk_cell_renderer_spin_new( void)"
- return(C_TO_XEN_GtkCellRenderer_(gtk_cell_renderer_spin_new()));
+ #define H_gtk_tree_view_convert_bin_window_to_tree_coords "void gtk_tree_view_convert_bin_window_to_tree_coords(GtkTreeView* tree_view, \
+gint bx, gint by, gint* [tx], gint* [ty])"
+ gint ref_tx;
+ gint ref_ty;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_convert_bin_window_to_tree_coords", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(bx), bx, 2, "gtk_tree_view_convert_bin_window_to_tree_coords", "gint");
+ Xen_check_type(Xen_is_gint(by), by, 3, "gtk_tree_view_convert_bin_window_to_tree_coords", "gint");
+ gtk_tree_view_convert_bin_window_to_tree_coords(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(bx), Xen_to_C_gint(by),
+ &ref_tx, &ref_ty);
+ return(Xen_list_2(C_to_Xen_gint(ref_tx), C_to_Xen_gint(ref_ty)));
}
-static XEN gxg_gtk_link_button_new(XEN uri)
+static Xen gxg_gtk_widget_set_tooltip_text(Xen widget, Xen text)
{
- #define H_gtk_link_button_new "GtkWidget* gtk_link_button_new(gchar* uri)"
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 1, "gtk_link_button_new", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_link_button_new(XEN_TO_C_gchar_(uri))));
+ #define H_gtk_widget_set_tooltip_text "void gtk_widget_set_tooltip_text(GtkWidget* widget, gchar* text)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_tooltip_text", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_widget_set_tooltip_text", "gchar*");
+ gtk_widget_set_tooltip_text(Xen_to_C_GtkWidget_(widget), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_link_button_new_with_label(XEN uri, XEN label)
+static Xen gxg_gtk_widget_get_tooltip_text(Xen widget)
{
- #define H_gtk_link_button_new_with_label "GtkWidget* gtk_link_button_new_with_label(gchar* uri, gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 1, "gtk_link_button_new_with_label", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_link_button_new_with_label", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_link_button_new_with_label(XEN_TO_C_gchar_(uri), XEN_TO_C_gchar_(label))));
+ #define H_gtk_widget_get_tooltip_text "gchar* gtk_widget_get_tooltip_text(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_tooltip_text", "GtkWidget*");
+ return(C_to_Xen_gchar_(gtk_widget_get_tooltip_text(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_link_button_get_uri(XEN link_button)
+static Xen gxg_gtk_widget_set_tooltip_markup(Xen widget, Xen markup)
{
- #define H_gtk_link_button_get_uri "gchar* gtk_link_button_get_uri(GtkLinkButton* link_button)"
- XEN_ASSERT_TYPE(XEN_GtkLinkButton__P(link_button), link_button, 1, "gtk_link_button_get_uri", "GtkLinkButton*");
- return(C_TO_XEN_gchar_(gtk_link_button_get_uri(XEN_TO_C_GtkLinkButton_(link_button))));
+ #define H_gtk_widget_set_tooltip_markup "void gtk_widget_set_tooltip_markup(GtkWidget* widget, gchar* markup)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_tooltip_markup", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(markup), markup, 2, "gtk_widget_set_tooltip_markup", "gchar*");
+ gtk_widget_set_tooltip_markup(Xen_to_C_GtkWidget_(widget), (const gchar*)Xen_to_C_gchar_(markup));
+ return(Xen_false);
}
-static XEN gxg_gtk_link_button_set_uri(XEN link_button, XEN uri)
+static Xen gxg_gtk_widget_get_tooltip_markup(Xen widget)
{
- #define H_gtk_link_button_set_uri "void gtk_link_button_set_uri(GtkLinkButton* link_button, gchar* uri)"
- XEN_ASSERT_TYPE(XEN_GtkLinkButton__P(link_button), link_button, 1, "gtk_link_button_set_uri", "GtkLinkButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_link_button_set_uri", "gchar*");
- gtk_link_button_set_uri(XEN_TO_C_GtkLinkButton_(link_button), XEN_TO_C_gchar_(uri));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_tooltip_markup "gchar* gtk_widget_get_tooltip_markup(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_tooltip_markup", "GtkWidget*");
+ return(C_to_Xen_gchar_(gtk_widget_get_tooltip_markup(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_recent_chooser_error_quark(void)
+static Xen gxg_gtk_tree_view_is_rubber_banding_active(Xen tree_view)
{
- #define H_gtk_recent_chooser_error_quark "GQuark gtk_recent_chooser_error_quark( void)"
- return(C_TO_XEN_GQuark(gtk_recent_chooser_error_quark()));
+ #define H_gtk_tree_view_is_rubber_banding_active "gboolean gtk_tree_view_is_rubber_banding_active(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_is_rubber_banding_active", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_is_rubber_banding_active(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_recent_chooser_set_show_private(XEN chooser, XEN show_private)
+static Xen gxg_gtk_icon_view_convert_widget_to_bin_window_coords(Xen icon_view, Xen wx, Xen wy, Xen ignore_bx, Xen ignore_by)
{
- #define H_gtk_recent_chooser_set_show_private "void gtk_recent_chooser_set_show_private(GtkRecentChooser* chooser, \
-gboolean show_private)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_show_private", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_private), show_private, 2, "gtk_recent_chooser_set_show_private", "gboolean");
- gtk_recent_chooser_set_show_private(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gboolean(show_private));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_convert_widget_to_bin_window_coords "void gtk_icon_view_convert_widget_to_bin_window_coords(GtkIconView* icon_view, \
+gint wx, gint wy, gint* [bx], gint* [by])"
+ gint ref_bx;
+ gint ref_by;
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_convert_widget_to_bin_window_coords", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(wx), wx, 2, "gtk_icon_view_convert_widget_to_bin_window_coords", "gint");
+ Xen_check_type(Xen_is_gint(wy), wy, 3, "gtk_icon_view_convert_widget_to_bin_window_coords", "gint");
+ gtk_icon_view_convert_widget_to_bin_window_coords(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(wx), Xen_to_C_gint(wy),
+ &ref_bx, &ref_by);
+ return(Xen_list_2(C_to_Xen_gint(ref_bx), C_to_Xen_gint(ref_by)));
}
-static XEN gxg_gtk_recent_chooser_get_show_private(XEN chooser)
+static Xen gxg_gtk_icon_view_set_tooltip_item(Xen icon_view, Xen tooltip, Xen path)
{
- #define H_gtk_recent_chooser_get_show_private "gboolean gtk_recent_chooser_get_show_private(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_show_private", "GtkRecentChooser*");
- return(C_TO_XEN_gboolean(gtk_recent_chooser_get_show_private(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_icon_view_set_tooltip_item "void gtk_icon_view_set_tooltip_item(GtkIconView* icon_view, \
+GtkTooltip* tooltip, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_tooltip_item", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 2, "gtk_icon_view_set_tooltip_item", "GtkTooltip*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 3, "gtk_icon_view_set_tooltip_item", "GtkTreePath*");
+ gtk_icon_view_set_tooltip_item(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTooltip_(tooltip), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_set_show_not_found(XEN chooser, XEN show_not_found)
+static Xen gxg_gtk_icon_view_set_tooltip_cell(Xen icon_view, Xen tooltip, Xen path, Xen cell)
{
- #define H_gtk_recent_chooser_set_show_not_found "void gtk_recent_chooser_set_show_not_found(GtkRecentChooser* chooser, \
-gboolean show_not_found)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_show_not_found", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_not_found), show_not_found, 2, "gtk_recent_chooser_set_show_not_found", "gboolean");
- gtk_recent_chooser_set_show_not_found(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gboolean(show_not_found));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_set_tooltip_cell "void gtk_icon_view_set_tooltip_cell(GtkIconView* icon_view, \
+GtkTooltip* tooltip, GtkTreePath* path, GtkCellRenderer* cell)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_tooltip_cell", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 2, "gtk_icon_view_set_tooltip_cell", "GtkTooltip*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 3, "gtk_icon_view_set_tooltip_cell", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 4, "gtk_icon_view_set_tooltip_cell", "GtkCellRenderer*");
+ gtk_icon_view_set_tooltip_cell(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTooltip_(tooltip), Xen_to_C_GtkTreePath_(path),
+ Xen_to_C_GtkCellRenderer_(cell));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_show_not_found(XEN chooser)
+static Xen gxg_gtk_icon_view_get_tooltip_context(Xen icon_view, Xen ignore_x, Xen ignore_y, Xen keyboard_tip, Xen ignore_model, Xen ignore_path, Xen iter)
{
- #define H_gtk_recent_chooser_get_show_not_found "gboolean gtk_recent_chooser_get_show_not_found(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_show_not_found", "GtkRecentChooser*");
- return(C_TO_XEN_gboolean(gtk_recent_chooser_get_show_not_found(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_icon_view_get_tooltip_context "gboolean gtk_icon_view_get_tooltip_context(GtkIconView* icon_view, \
+gint* [x], gint* [y], gboolean keyboard_tip, GtkTreeModel** [model], GtkTreePath** [path], GtkTreeIter* iter)"
+ gint ref_x;
+ gint ref_y;
+ GtkTreeModel* ref_model = NULL;
+ GtkTreePath* ref_path = NULL;
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_tooltip_context", "GtkIconView*");
+ Xen_check_type(Xen_is_gboolean(keyboard_tip), keyboard_tip, 4, "gtk_icon_view_get_tooltip_context", "gboolean");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter) || Xen_is_false(iter), iter, 7, "gtk_icon_view_get_tooltip_context", "GtkTreeIter*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_icon_view_get_tooltip_context(Xen_to_C_GtkIconView_(icon_view), &ref_x, &ref_y, Xen_to_C_gboolean(keyboard_tip),
+ &ref_model, &ref_path, Xen_to_C_GtkTreeIter_(iter)));
+ return(Xen_list_5(result, C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y), C_to_Xen_GtkTreeModel_(ref_model), C_to_Xen_GtkTreePath_(ref_path)));
+ }
}
-static XEN gxg_gtk_recent_chooser_set_select_multiple(XEN chooser, XEN select_multiple)
+static Xen gxg_gtk_icon_view_set_tooltip_column(Xen icon_view, Xen column)
{
- #define H_gtk_recent_chooser_set_select_multiple "void gtk_recent_chooser_set_select_multiple(GtkRecentChooser* chooser, \
-gboolean select_multiple)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_select_multiple", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(select_multiple), select_multiple, 2, "gtk_recent_chooser_set_select_multiple", "gboolean");
- gtk_recent_chooser_set_select_multiple(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gboolean(select_multiple));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_set_tooltip_column "void gtk_icon_view_set_tooltip_column(GtkIconView* icon_view, \
+gint column)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_tooltip_column", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(column), column, 2, "gtk_icon_view_set_tooltip_column", "gint");
+ gtk_icon_view_set_tooltip_column(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_select_multiple(XEN chooser)
+static Xen gxg_gtk_icon_view_get_tooltip_column(Xen icon_view )
{
- #define H_gtk_recent_chooser_get_select_multiple "gboolean gtk_recent_chooser_get_select_multiple(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_select_multiple", "GtkRecentChooser*");
- return(C_TO_XEN_gboolean(gtk_recent_chooser_get_select_multiple(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_icon_view_get_tooltip_column "gint gtk_icon_view_get_tooltip_column(GtkIconView* icon_view, \
+)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view ), icon_view , 1, "gtk_icon_view_get_tooltip_column", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_tooltip_column(Xen_to_C_GtkIconView_(icon_view ))));
}
-static XEN gxg_gtk_recent_chooser_set_limit(XEN chooser, XEN limit)
+static Xen gxg_gtk_menu_tool_button_set_arrow_tooltip_text(Xen button, Xen text)
{
- #define H_gtk_recent_chooser_set_limit "void gtk_recent_chooser_set_limit(GtkRecentChooser* chooser, \
-gint limit)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_limit", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gint_P(limit), limit, 2, "gtk_recent_chooser_set_limit", "gint");
- gtk_recent_chooser_set_limit(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gint(limit));
- return(XEN_FALSE);
+ #define H_gtk_menu_tool_button_set_arrow_tooltip_text "void gtk_menu_tool_button_set_arrow_tooltip_text(GtkMenuToolButton* button, \
+gchar* text)"
+ Xen_check_type(Xen_is_GtkMenuToolButton_(button), button, 1, "gtk_menu_tool_button_set_arrow_tooltip_text", "GtkMenuToolButton*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_menu_tool_button_set_arrow_tooltip_text", "gchar*");
+ gtk_menu_tool_button_set_arrow_tooltip_text(Xen_to_C_GtkMenuToolButton_(button), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_limit(XEN chooser)
+static Xen gxg_gtk_menu_tool_button_set_arrow_tooltip_markup(Xen button, Xen markup)
{
- #define H_gtk_recent_chooser_get_limit "gint gtk_recent_chooser_get_limit(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_limit", "GtkRecentChooser*");
- return(C_TO_XEN_gint(gtk_recent_chooser_get_limit(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_menu_tool_button_set_arrow_tooltip_markup "void gtk_menu_tool_button_set_arrow_tooltip_markup(GtkMenuToolButton* button, \
+gchar* markup)"
+ Xen_check_type(Xen_is_GtkMenuToolButton_(button), button, 1, "gtk_menu_tool_button_set_arrow_tooltip_markup", "GtkMenuToolButton*");
+ Xen_check_type(Xen_is_gchar_(markup), markup, 2, "gtk_menu_tool_button_set_arrow_tooltip_markup", "gchar*");
+ gtk_menu_tool_button_set_arrow_tooltip_markup(Xen_to_C_GtkMenuToolButton_(button), (const gchar*)Xen_to_C_gchar_(markup));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_set_local_only(XEN chooser, XEN local_only)
+static Xen gxg_gtk_tool_item_set_tooltip_text(Xen tool_item, Xen text)
{
- #define H_gtk_recent_chooser_set_local_only "void gtk_recent_chooser_set_local_only(GtkRecentChooser* chooser, \
-gboolean local_only)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_local_only", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(local_only), local_only, 2, "gtk_recent_chooser_set_local_only", "gboolean");
- gtk_recent_chooser_set_local_only(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gboolean(local_only));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_set_tooltip_text "void gtk_tool_item_set_tooltip_text(GtkToolItem* tool_item, \
+gchar* text)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_set_tooltip_text", "GtkToolItem*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_tool_item_set_tooltip_text", "gchar*");
+ gtk_tool_item_set_tooltip_text(Xen_to_C_GtkToolItem_(tool_item), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_local_only(XEN chooser)
+static Xen gxg_gtk_tool_item_set_tooltip_markup(Xen tool_item, Xen markup)
{
- #define H_gtk_recent_chooser_get_local_only "gboolean gtk_recent_chooser_get_local_only(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_local_only", "GtkRecentChooser*");
- return(C_TO_XEN_gboolean(gtk_recent_chooser_get_local_only(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_tool_item_set_tooltip_markup "void gtk_tool_item_set_tooltip_markup(GtkToolItem* tool_item, \
+gchar* markup)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_set_tooltip_markup", "GtkToolItem*");
+ Xen_check_type(Xen_is_gchar_(markup), markup, 2, "gtk_tool_item_set_tooltip_markup", "gchar*");
+ gtk_tool_item_set_tooltip_markup(Xen_to_C_GtkToolItem_(tool_item), (const gchar*)Xen_to_C_gchar_(markup));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_set_show_tips(XEN chooser, XEN show_tips)
+static Xen gxg_gtk_tooltip_set_tip_area(Xen tooltip, Xen rect)
{
- #define H_gtk_recent_chooser_set_show_tips "void gtk_recent_chooser_set_show_tips(GtkRecentChooser* chooser, \
-gboolean show_tips)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_show_tips", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_tips), show_tips, 2, "gtk_recent_chooser_set_show_tips", "gboolean");
- gtk_recent_chooser_set_show_tips(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gboolean(show_tips));
- return(XEN_FALSE);
+ #define H_gtk_tooltip_set_tip_area "void gtk_tooltip_set_tip_area(GtkTooltip* tooltip, GdkRectangle* rect)"
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 1, "gtk_tooltip_set_tip_area", "GtkTooltip*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 2, "gtk_tooltip_set_tip_area", "GdkRectangle*");
+ gtk_tooltip_set_tip_area(Xen_to_C_GtkTooltip_(tooltip), Xen_to_C_GdkRectangle_(rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_show_tips(XEN chooser)
+static Xen gxg_gtk_tree_view_set_tooltip_row(Xen tree_view, Xen tooltip, Xen path)
{
- #define H_gtk_recent_chooser_get_show_tips "gboolean gtk_recent_chooser_get_show_tips(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_show_tips", "GtkRecentChooser*");
- return(C_TO_XEN_gboolean(gtk_recent_chooser_get_show_tips(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_tree_view_set_tooltip_row "void gtk_tree_view_set_tooltip_row(GtkTreeView* tree_view, \
+GtkTooltip* tooltip, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_tooltip_row", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 2, "gtk_tree_view_set_tooltip_row", "GtkTooltip*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 3, "gtk_tree_view_set_tooltip_row", "GtkTreePath*");
+ gtk_tree_view_set_tooltip_row(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTooltip_(tooltip), Xen_to_C_GtkTreePath_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_set_show_icons(XEN chooser, XEN show_icons)
+static Xen gxg_gtk_tree_view_set_tooltip_cell(Xen tree_view, Xen tooltip, Xen path, Xen column, Xen cell)
{
- #define H_gtk_recent_chooser_set_show_icons "void gtk_recent_chooser_set_show_icons(GtkRecentChooser* chooser, \
-gboolean show_icons)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_show_icons", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_icons), show_icons, 2, "gtk_recent_chooser_set_show_icons", "gboolean");
- gtk_recent_chooser_set_show_icons(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gboolean(show_icons));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_tooltip_cell "void gtk_tree_view_set_tooltip_cell(GtkTreeView* tree_view, \
+GtkTooltip* tooltip, GtkTreePath* path, GtkTreeViewColumn* column, GtkCellRenderer* cell)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_tooltip_cell", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 2, "gtk_tree_view_set_tooltip_cell", "GtkTooltip*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 3, "gtk_tree_view_set_tooltip_cell", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(column), column, 4, "gtk_tree_view_set_tooltip_cell", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 5, "gtk_tree_view_set_tooltip_cell", "GtkCellRenderer*");
+ gtk_tree_view_set_tooltip_cell(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTooltip_(tooltip), Xen_to_C_GtkTreePath_(path),
+ Xen_to_C_GtkTreeViewColumn_(column), Xen_to_C_GtkCellRenderer_(cell));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_show_icons(XEN chooser)
+static Xen gxg_gtk_tree_view_get_tooltip_context(Xen tree_view, Xen ignore_x, Xen ignore_y, Xen keyboard_tip, Xen ignore_model, Xen ignore_path, Xen iter)
{
- #define H_gtk_recent_chooser_get_show_icons "gboolean gtk_recent_chooser_get_show_icons(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_show_icons", "GtkRecentChooser*");
- return(C_TO_XEN_gboolean(gtk_recent_chooser_get_show_icons(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_tree_view_get_tooltip_context "gboolean gtk_tree_view_get_tooltip_context(GtkTreeView* tree_view, \
+gint* [x], gint* [y], gboolean keyboard_tip, GtkTreeModel** [model], GtkTreePath** [path], GtkTreeIter* iter)"
+ gint ref_x;
+ gint ref_y;
+ GtkTreeModel* ref_model = NULL;
+ GtkTreePath* ref_path = NULL;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_tooltip_context", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(keyboard_tip), keyboard_tip, 4, "gtk_tree_view_get_tooltip_context", "gboolean");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter) || Xen_is_false(iter), iter, 7, "gtk_tree_view_get_tooltip_context", "GtkTreeIter*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_tree_view_get_tooltip_context(Xen_to_C_GtkTreeView_(tree_view), &ref_x, &ref_y, Xen_to_C_gboolean(keyboard_tip),
+ &ref_model, &ref_path, Xen_to_C_GtkTreeIter_(iter)));
+ return(Xen_list_5(result, C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y), C_to_Xen_GtkTreeModel_(ref_model), C_to_Xen_GtkTreePath_(ref_path)));
+ }
}
-static XEN gxg_gtk_recent_chooser_set_sort_type(XEN chooser, XEN sort_type)
+static Xen gxg_gtk_tree_view_set_tooltip_column(Xen tree_view, Xen column)
{
- #define H_gtk_recent_chooser_set_sort_type "void gtk_recent_chooser_set_sort_type(GtkRecentChooser* chooser, \
-GtkRecentSortType sort_type)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_sort_type", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_GtkRecentSortType_P(sort_type), sort_type, 2, "gtk_recent_chooser_set_sort_type", "GtkRecentSortType");
- gtk_recent_chooser_set_sort_type(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_GtkRecentSortType(sort_type));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_set_tooltip_column "void gtk_tree_view_set_tooltip_column(GtkTreeView* tree_view, \
+gint column)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_tooltip_column", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(column), column, 2, "gtk_tree_view_set_tooltip_column", "gint");
+ gtk_tree_view_set_tooltip_column(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(column));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_sort_type(XEN chooser)
+static Xen gxg_gtk_tree_view_get_tooltip_column(Xen tree_view )
{
- #define H_gtk_recent_chooser_get_sort_type "GtkRecentSortType gtk_recent_chooser_get_sort_type(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_sort_type", "GtkRecentChooser*");
- return(C_TO_XEN_GtkRecentSortType(gtk_recent_chooser_get_sort_type(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_tree_view_get_tooltip_column "gint gtk_tree_view_get_tooltip_column(GtkTreeView* tree_view, \
+)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view ), tree_view , 1, "gtk_tree_view_get_tooltip_column", "GtkTreeView*");
+ return(C_to_Xen_gint(gtk_tree_view_get_tooltip_column(Xen_to_C_GtkTreeView_(tree_view ))));
}
-static XEN gxg_gtk_recent_chooser_set_sort_func(XEN chooser, XEN func, XEN func_info, XEN data_destroy)
+static Xen gxg_gtk_widget_set_has_tooltip(Xen widget, Xen has_tooltip)
{
- #define H_gtk_recent_chooser_set_sort_func "void gtk_recent_chooser_set_sort_func(GtkRecentChooser* chooser, \
-GtkRecentSortFunc func, lambda_data func_info, GDestroyNotify data_destroy)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_sort_func", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_GtkRecentSortFunc_P(func), func, 2, "gtk_recent_chooser_set_sort_func", "GtkRecentSortFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gtk_recent_chooser_set_sort_func", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(data_destroy), data_destroy, 4, "gtk_recent_chooser_set_sort_func", "GDestroyNotify");
- {
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- gtk_recent_chooser_set_sort_func(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_GtkRecentSortFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GDestroyNotify(data_destroy));
- return(XEN_FALSE);
- }
+ #define H_gtk_widget_set_has_tooltip "void gtk_widget_set_has_tooltip(GtkWidget* widget, gboolean has_tooltip)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_has_tooltip", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(has_tooltip), has_tooltip, 2, "gtk_widget_set_has_tooltip", "gboolean");
+ gtk_widget_set_has_tooltip(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(has_tooltip));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_set_current_uri(XEN chooser, XEN uri, XEN ignore_error)
+static Xen gxg_gtk_widget_get_has_tooltip(Xen widget)
{
- #define H_gtk_recent_chooser_set_current_uri "gboolean gtk_recent_chooser_set_current_uri(GtkRecentChooser* chooser, \
-gchar* uri, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_current_uri", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_chooser_set_current_uri", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_recent_chooser_set_current_uri(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gchar_(uri),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_widget_get_has_tooltip "gboolean gtk_widget_get_has_tooltip(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_has_tooltip", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_has_tooltip(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_recent_chooser_get_current_uri(XEN chooser)
+#if GTK_CHECK_VERSION(2, 14, 0)
+static Xen gxg_gtk_calendar_set_detail_func(Xen calendar, Xen func, Xen data, Xen destroy)
{
- #define H_gtk_recent_chooser_get_current_uri "gchar* gtk_recent_chooser_get_current_uri(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_current_uri", "GtkRecentChooser*");
- return(C_TO_XEN_gchar_(gtk_recent_chooser_get_current_uri(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_calendar_set_detail_func "void gtk_calendar_set_detail_func(GtkCalendar* calendar, GtkCalendarDetailFunc func, \
+gpointer data, GDestroyNotify destroy)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_set_detail_func", "GtkCalendar*");
+ Xen_check_type(Xen_is_GtkCalendarDetailFunc(func), func, 2, "gtk_calendar_set_detail_func", "GtkCalendarDetailFunc");
+ Xen_check_type(Xen_is_gpointer(data), data, 3, "gtk_calendar_set_detail_func", "gpointer");
+ Xen_check_type(Xen_is_GDestroyNotify(destroy), destroy, 4, "gtk_calendar_set_detail_func", "GDestroyNotify");
+ gtk_calendar_set_detail_func(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_GtkCalendarDetailFunc(func), Xen_to_C_gpointer(data),
+ Xen_to_C_GDestroyNotify(destroy));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_current_item(XEN chooser)
+static Xen gxg_gtk_calendar_set_detail_width_chars(Xen calendar, Xen chars)
{
- #define H_gtk_recent_chooser_get_current_item "GtkRecentInfo* gtk_recent_chooser_get_current_item(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_current_item", "GtkRecentChooser*");
- return(C_TO_XEN_GtkRecentInfo_(gtk_recent_chooser_get_current_item(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_calendar_set_detail_width_chars "void gtk_calendar_set_detail_width_chars(GtkCalendar* calendar, \
+gint chars)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_set_detail_width_chars", "GtkCalendar*");
+ Xen_check_type(Xen_is_gint(chars), chars, 2, "gtk_calendar_set_detail_width_chars", "gint");
+ gtk_calendar_set_detail_width_chars(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_gint(chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_select_uri(XEN chooser, XEN uri, XEN ignore_error)
+static Xen gxg_gtk_calendar_set_detail_height_rows(Xen calendar, Xen rows)
{
- #define H_gtk_recent_chooser_select_uri "gboolean gtk_recent_chooser_select_uri(GtkRecentChooser* chooser, \
-gchar* uri, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_select_uri", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_chooser_select_uri", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_recent_chooser_select_uri(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gchar_(uri), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_calendar_set_detail_height_rows "void gtk_calendar_set_detail_height_rows(GtkCalendar* calendar, \
+gint rows)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_set_detail_height_rows", "GtkCalendar*");
+ Xen_check_type(Xen_is_gint(rows), rows, 2, "gtk_calendar_set_detail_height_rows", "gint");
+ gtk_calendar_set_detail_height_rows(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_gint(rows));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_unselect_uri(XEN chooser, XEN uri)
+static Xen gxg_gtk_calendar_get_detail_width_chars(Xen calendar)
{
- #define H_gtk_recent_chooser_unselect_uri "void gtk_recent_chooser_unselect_uri(GtkRecentChooser* chooser, \
-gchar* uri)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_unselect_uri", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_chooser_unselect_uri", "gchar*");
- gtk_recent_chooser_unselect_uri(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_gchar_(uri));
- return(XEN_FALSE);
+ #define H_gtk_calendar_get_detail_width_chars "gint gtk_calendar_get_detail_width_chars(GtkCalendar* calendar)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_get_detail_width_chars", "GtkCalendar*");
+ return(C_to_Xen_gint(gtk_calendar_get_detail_width_chars(Xen_to_C_GtkCalendar_(calendar))));
}
-static XEN gxg_gtk_recent_chooser_select_all(XEN chooser)
+static Xen gxg_gtk_calendar_get_detail_height_rows(Xen calendar)
{
- #define H_gtk_recent_chooser_select_all "void gtk_recent_chooser_select_all(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_select_all", "GtkRecentChooser*");
- gtk_recent_chooser_select_all(XEN_TO_C_GtkRecentChooser_(chooser));
- return(XEN_FALSE);
+ #define H_gtk_calendar_get_detail_height_rows "gint gtk_calendar_get_detail_height_rows(GtkCalendar* calendar)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_get_detail_height_rows", "GtkCalendar*");
+ return(C_to_Xen_gint(gtk_calendar_get_detail_height_rows(Xen_to_C_GtkCalendar_(calendar))));
}
-static XEN gxg_gtk_recent_chooser_unselect_all(XEN chooser)
+static Xen gxg_gdk_screen_get_monitor_width_mm(Xen screen, Xen monitor_num)
{
- #define H_gtk_recent_chooser_unselect_all "void gtk_recent_chooser_unselect_all(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_unselect_all", "GtkRecentChooser*");
- gtk_recent_chooser_unselect_all(XEN_TO_C_GtkRecentChooser_(chooser));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_monitor_width_mm "gint gdk_screen_get_monitor_width_mm(GdkScreen* screen, \
+gint monitor_num)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_monitor_width_mm", "GdkScreen*");
+ Xen_check_type(Xen_is_gint(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_width_mm", "gint");
+ return(C_to_Xen_gint(gdk_screen_get_monitor_width_mm(Xen_to_C_GdkScreen_(screen), Xen_to_C_gint(monitor_num))));
}
-static XEN gxg_gtk_recent_chooser_get_items(XEN chooser)
+static Xen gxg_gdk_screen_get_monitor_height_mm(Xen screen, Xen monitor_num)
{
- #define H_gtk_recent_chooser_get_items "GList* gtk_recent_chooser_get_items(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_items", "GtkRecentChooser*");
- return(C_TO_XEN_GList_(gtk_recent_chooser_get_items(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gdk_screen_get_monitor_height_mm "gint gdk_screen_get_monitor_height_mm(GdkScreen* screen, \
+gint monitor_num)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_monitor_height_mm", "GdkScreen*");
+ Xen_check_type(Xen_is_gint(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_height_mm", "gint");
+ return(C_to_Xen_gint(gdk_screen_get_monitor_height_mm(Xen_to_C_GdkScreen_(screen), Xen_to_C_gint(monitor_num))));
}
-static XEN gxg_gtk_recent_chooser_get_uris(XEN chooser, XEN ignore_length)
+static Xen gxg_gdk_screen_get_monitor_plug_name(Xen screen, Xen monitor_num)
{
- #define H_gtk_recent_chooser_get_uris "gchar** gtk_recent_chooser_get_uris(GtkRecentChooser* chooser, \
-gsize* [length])"
- gsize ref_length;
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_uris", "GtkRecentChooser*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gchar__(gtk_recent_chooser_get_uris(XEN_TO_C_GtkRecentChooser_(chooser), &ref_length));
- return(XEN_LIST_2(result, C_TO_XEN_gsize(ref_length)));
- }
+ #define H_gdk_screen_get_monitor_plug_name "gchar* gdk_screen_get_monitor_plug_name(GdkScreen* screen, \
+gint monitor_num)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_monitor_plug_name", "GdkScreen*");
+ Xen_check_type(Xen_is_gint(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_plug_name", "gint");
+ return(C_to_Xen_gchar_(gdk_screen_get_monitor_plug_name(Xen_to_C_GdkScreen_(screen), Xen_to_C_gint(monitor_num))));
}
-static XEN gxg_gtk_recent_chooser_add_filter(XEN chooser, XEN filter)
+static Xen gxg_gtk_accel_group_get_is_locked(Xen accel_group)
{
- #define H_gtk_recent_chooser_add_filter "void gtk_recent_chooser_add_filter(GtkRecentChooser* chooser, \
-GtkRecentFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_add_filter", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 2, "gtk_recent_chooser_add_filter", "GtkRecentFilter*");
- gtk_recent_chooser_add_filter(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_GtkRecentFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_accel_group_get_is_locked "gboolean gtk_accel_group_get_is_locked(GtkAccelGroup* accel_group)"
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_get_is_locked", "GtkAccelGroup*");
+ return(C_to_Xen_gboolean(gtk_accel_group_get_is_locked(Xen_to_C_GtkAccelGroup_(accel_group))));
}
-static XEN gxg_gtk_recent_chooser_remove_filter(XEN chooser, XEN filter)
+static Xen gxg_gtk_container_get_focus_child(Xen container)
{
- #define H_gtk_recent_chooser_remove_filter "void gtk_recent_chooser_remove_filter(GtkRecentChooser* chooser, \
-GtkRecentFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_remove_filter", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 2, "gtk_recent_chooser_remove_filter", "GtkRecentFilter*");
- gtk_recent_chooser_remove_filter(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_GtkRecentFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_container_get_focus_child "GtkWidget* gtk_container_get_focus_child(GtkContainer* container)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_get_focus_child", "GtkContainer*");
+ return(C_to_Xen_GtkWidget_(gtk_container_get_focus_child(Xen_to_C_GtkContainer_(container))));
}
-static XEN gxg_gtk_recent_chooser_list_filters(XEN chooser)
+static Xen gxg_gtk_dialog_get_content_area(Xen dialog)
{
- #define H_gtk_recent_chooser_list_filters "GSList* gtk_recent_chooser_list_filters(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_list_filters", "GtkRecentChooser*");
- return(C_TO_XEN_GSList_(gtk_recent_chooser_list_filters(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_dialog_get_content_area "GtkWidget* gtk_dialog_get_content_area(GtkDialog* dialog)"
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_get_content_area", "GtkDialog*");
+ return(C_to_Xen_GtkWidget_(gtk_dialog_get_content_area(Xen_to_C_GtkDialog_(dialog))));
}
-static XEN gxg_gtk_recent_chooser_set_filter(XEN chooser, XEN filter)
+static Xen gxg_gtk_entry_set_overwrite_mode(Xen entry, Xen overwrite)
{
- #define H_gtk_recent_chooser_set_filter "void gtk_recent_chooser_set_filter(GtkRecentChooser* chooser, \
-GtkRecentFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_set_filter", "GtkRecentChooser*");
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 2, "gtk_recent_chooser_set_filter", "GtkRecentFilter*");
- gtk_recent_chooser_set_filter(XEN_TO_C_GtkRecentChooser_(chooser), XEN_TO_C_GtkRecentFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_entry_set_overwrite_mode "void gtk_entry_set_overwrite_mode(GtkEntry* entry, gboolean overwrite)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_overwrite_mode", "GtkEntry*");
+ Xen_check_type(Xen_is_gboolean(overwrite), overwrite, 2, "gtk_entry_set_overwrite_mode", "gboolean");
+ gtk_entry_set_overwrite_mode(Xen_to_C_GtkEntry_(entry), Xen_to_C_gboolean(overwrite));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_chooser_get_filter(XEN chooser)
+static Xen gxg_gtk_entry_get_overwrite_mode(Xen entry)
{
- #define H_gtk_recent_chooser_get_filter "GtkRecentFilter* gtk_recent_chooser_get_filter(GtkRecentChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooser__P(chooser), chooser, 1, "gtk_recent_chooser_get_filter", "GtkRecentChooser*");
- return(C_TO_XEN_GtkRecentFilter_(gtk_recent_chooser_get_filter(XEN_TO_C_GtkRecentChooser_(chooser))));
+ #define H_gtk_entry_get_overwrite_mode "gboolean gtk_entry_get_overwrite_mode(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_overwrite_mode", "GtkEntry*");
+ return(C_to_Xen_gboolean(gtk_entry_get_overwrite_mode(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_recent_chooser_menu_new(void)
+static Xen gxg_gtk_entry_get_text_length(Xen entry)
{
- #define H_gtk_recent_chooser_menu_new "GtkWidget* gtk_recent_chooser_menu_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_recent_chooser_menu_new()));
+ #define H_gtk_entry_get_text_length "guint16 gtk_entry_get_text_length(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_text_length", "GtkEntry*");
+ return(C_to_Xen_guint16(gtk_entry_get_text_length(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_recent_chooser_menu_new_for_manager(XEN manager)
+static Xen gxg_gtk_layout_get_bin_window(Xen layout)
{
- #define H_gtk_recent_chooser_menu_new_for_manager "GtkWidget* gtk_recent_chooser_menu_new_for_manager(GtkRecentManager* manager)"
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_chooser_menu_new_for_manager", "GtkRecentManager*");
- return(C_TO_XEN_GtkWidget_(gtk_recent_chooser_menu_new_for_manager(XEN_TO_C_GtkRecentManager_(manager))));
+ #define H_gtk_layout_get_bin_window "GdkWindow* gtk_layout_get_bin_window(GtkLayout* layout)"
+ Xen_check_type(Xen_is_GtkLayout_(layout), layout, 1, "gtk_layout_get_bin_window", "GtkLayout*");
+ return(C_to_Xen_GdkWindow_(gtk_layout_get_bin_window(Xen_to_C_GtkLayout_(layout))));
}
-static XEN gxg_gtk_recent_chooser_menu_get_show_numbers(XEN menu)
+static Xen gxg_gtk_menu_get_accel_path(Xen menu)
{
- #define H_gtk_recent_chooser_menu_get_show_numbers "gboolean gtk_recent_chooser_menu_get_show_numbers(GtkRecentChooserMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooserMenu__P(menu), menu, 1, "gtk_recent_chooser_menu_get_show_numbers", "GtkRecentChooserMenu*");
- return(C_TO_XEN_gboolean(gtk_recent_chooser_menu_get_show_numbers(XEN_TO_C_GtkRecentChooserMenu_(menu))));
+ #define H_gtk_menu_get_accel_path "gchar* gtk_menu_get_accel_path(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_get_accel_path", "GtkMenu*");
+ return(C_to_Xen_gchar_(gtk_menu_get_accel_path(Xen_to_C_GtkMenu_(menu))));
}
-static XEN gxg_gtk_recent_chooser_menu_set_show_numbers(XEN menu, XEN show_numbers)
+static Xen gxg_gtk_menu_get_monitor(Xen menu)
{
- #define H_gtk_recent_chooser_menu_set_show_numbers "void gtk_recent_chooser_menu_set_show_numbers(GtkRecentChooserMenu* menu, \
-gboolean show_numbers)"
- XEN_ASSERT_TYPE(XEN_GtkRecentChooserMenu__P(menu), menu, 1, "gtk_recent_chooser_menu_set_show_numbers", "GtkRecentChooserMenu*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_numbers), show_numbers, 2, "gtk_recent_chooser_menu_set_show_numbers", "gboolean");
- gtk_recent_chooser_menu_set_show_numbers(XEN_TO_C_GtkRecentChooserMenu_(menu), XEN_TO_C_gboolean(show_numbers));
- return(XEN_FALSE);
+ #define H_gtk_menu_get_monitor "gint gtk_menu_get_monitor(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_get_monitor", "GtkMenu*");
+ return(C_to_Xen_gint(gtk_menu_get_monitor(Xen_to_C_GtkMenu_(menu))));
}
-static XEN gxg_gtk_recent_chooser_widget_new(void)
+static Xen gxg_gtk_menu_item_get_accel_path(Xen menu_item)
{
- #define H_gtk_recent_chooser_widget_new "GtkWidget* gtk_recent_chooser_widget_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_recent_chooser_widget_new()));
+ #define H_gtk_menu_item_get_accel_path "gchar* gtk_menu_item_get_accel_path(GtkMenuItem* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_get_accel_path", "GtkMenuItem*");
+ return(C_to_Xen_gchar_(gtk_menu_item_get_accel_path(Xen_to_C_GtkMenuItem_(menu_item))));
}
-static XEN gxg_gtk_recent_chooser_widget_new_for_manager(XEN manager)
+static Xen gxg_gtk_scale_button_get_plus_button(Xen button)
{
- #define H_gtk_recent_chooser_widget_new_for_manager "GtkWidget* gtk_recent_chooser_widget_new_for_manager(GtkRecentManager* manager)"
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_chooser_widget_new_for_manager", "GtkRecentManager*");
- return(C_TO_XEN_GtkWidget_(gtk_recent_chooser_widget_new_for_manager(XEN_TO_C_GtkRecentManager_(manager))));
+ #define H_gtk_scale_button_get_plus_button "GtkWidget* gtk_scale_button_get_plus_button(GtkScaleButton* button)"
+ Xen_check_type(Xen_is_GtkScaleButton_(button), button, 1, "gtk_scale_button_get_plus_button", "GtkScaleButton*");
+ return(C_to_Xen_GtkWidget_(gtk_scale_button_get_plus_button(Xen_to_C_GtkScaleButton_(button))));
}
-static XEN gxg_gtk_recent_filter_new(void)
+static Xen gxg_gtk_scale_button_get_minus_button(Xen button)
{
- #define H_gtk_recent_filter_new "GtkRecentFilter* gtk_recent_filter_new( void)"
- return(C_TO_XEN_GtkRecentFilter_(gtk_recent_filter_new()));
+ #define H_gtk_scale_button_get_minus_button "GtkWidget* gtk_scale_button_get_minus_button(GtkScaleButton* button)"
+ Xen_check_type(Xen_is_GtkScaleButton_(button), button, 1, "gtk_scale_button_get_minus_button", "GtkScaleButton*");
+ return(C_to_Xen_GtkWidget_(gtk_scale_button_get_minus_button(Xen_to_C_GtkScaleButton_(button))));
}
-static XEN gxg_gtk_recent_filter_set_name(XEN filter, XEN name)
+static Xen gxg_gtk_scale_button_get_popup(Xen button)
{
- #define H_gtk_recent_filter_set_name "void gtk_recent_filter_set_name(GtkRecentFilter* filter, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_set_name", "GtkRecentFilter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_recent_filter_set_name", "gchar*");
- gtk_recent_filter_set_name(XEN_TO_C_GtkRecentFilter_(filter), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_gtk_scale_button_get_popup "GtkWidget* gtk_scale_button_get_popup(GtkScaleButton* button)"
+ Xen_check_type(Xen_is_GtkScaleButton_(button), button, 1, "gtk_scale_button_get_popup", "GtkScaleButton*");
+ return(C_to_Xen_GtkWidget_(gtk_scale_button_get_popup(Xen_to_C_GtkScaleButton_(button))));
}
-static XEN gxg_gtk_recent_filter_get_name(XEN filter)
+static Xen gxg_gtk_selection_data_get_target(Xen selection_data)
{
- #define H_gtk_recent_filter_get_name "gchar* gtk_recent_filter_get_name(GtkRecentFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_get_name", "GtkRecentFilter*");
- return(C_TO_XEN_gchar_((gchar*)gtk_recent_filter_get_name(XEN_TO_C_GtkRecentFilter_(filter))));
+ #define H_gtk_selection_data_get_target "GdkAtom gtk_selection_data_get_target(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_target", "GtkSelectionData*");
+ return(C_to_Xen_GdkAtom(gtk_selection_data_get_target(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_recent_filter_add_mime_type(XEN filter, XEN mime_type)
+static Xen gxg_gtk_selection_data_get_data_type(Xen selection_data)
{
- #define H_gtk_recent_filter_add_mime_type "void gtk_recent_filter_add_mime_type(GtkRecentFilter* filter, \
-gchar* mime_type)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_add_mime_type", "GtkRecentFilter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(mime_type), mime_type, 2, "gtk_recent_filter_add_mime_type", "gchar*");
- gtk_recent_filter_add_mime_type(XEN_TO_C_GtkRecentFilter_(filter), XEN_TO_C_gchar_(mime_type));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_get_data_type "GdkAtom gtk_selection_data_get_data_type(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_data_type", "GtkSelectionData*");
+ return(C_to_Xen_GdkAtom(gtk_selection_data_get_data_type(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_recent_filter_add_pattern(XEN filter, XEN pattern)
+static Xen gxg_gtk_selection_data_get_format(Xen selection_data)
{
- #define H_gtk_recent_filter_add_pattern "void gtk_recent_filter_add_pattern(GtkRecentFilter* filter, \
-gchar* pattern)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_add_pattern", "GtkRecentFilter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(pattern), pattern, 2, "gtk_recent_filter_add_pattern", "gchar*");
- gtk_recent_filter_add_pattern(XEN_TO_C_GtkRecentFilter_(filter), XEN_TO_C_gchar_(pattern));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_get_format "gint gtk_selection_data_get_format(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_format", "GtkSelectionData*");
+ return(C_to_Xen_gint(gtk_selection_data_get_format(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_recent_filter_add_pixbuf_formats(XEN filter)
+static Xen gxg_gtk_selection_data_get_display(Xen selection_data)
{
- #define H_gtk_recent_filter_add_pixbuf_formats "void gtk_recent_filter_add_pixbuf_formats(GtkRecentFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_add_pixbuf_formats", "GtkRecentFilter*");
- gtk_recent_filter_add_pixbuf_formats(XEN_TO_C_GtkRecentFilter_(filter));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_get_display "GdkDisplay* gtk_selection_data_get_display(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_display", "GtkSelectionData*");
+ return(C_to_Xen_GdkDisplay_(gtk_selection_data_get_display(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_recent_filter_add_application(XEN filter, XEN application)
+static Xen gxg_gtk_widget_get_window(Xen widget)
{
- #define H_gtk_recent_filter_add_application "void gtk_recent_filter_add_application(GtkRecentFilter* filter, \
-gchar* application)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_add_application", "GtkRecentFilter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(application), application, 2, "gtk_recent_filter_add_application", "gchar*");
- gtk_recent_filter_add_application(XEN_TO_C_GtkRecentFilter_(filter), XEN_TO_C_gchar_(application));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_window "GdkWindow* gtk_widget_get_window(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_window", "GtkWidget*");
+ return(C_to_Xen_GdkWindow_(gtk_widget_get_window(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_recent_filter_add_group(XEN filter, XEN group)
+static Xen gxg_gtk_accel_group_get_modifier_mask(Xen accel_group)
{
- #define H_gtk_recent_filter_add_group "void gtk_recent_filter_add_group(GtkRecentFilter* filter, gchar* group)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_add_group", "GtkRecentFilter*");
- XEN_ASSERT_TYPE(XEN_gchar__P(group), group, 2, "gtk_recent_filter_add_group", "gchar*");
- gtk_recent_filter_add_group(XEN_TO_C_GtkRecentFilter_(filter), XEN_TO_C_gchar_(group));
- return(XEN_FALSE);
+ #define H_gtk_accel_group_get_modifier_mask "GdkModifierType gtk_accel_group_get_modifier_mask(GtkAccelGroup* accel_group)"
+ Xen_check_type(Xen_is_GtkAccelGroup_(accel_group), accel_group, 1, "gtk_accel_group_get_modifier_mask", "GtkAccelGroup*");
+ return(C_to_Xen_GdkModifierType(gtk_accel_group_get_modifier_mask(Xen_to_C_GtkAccelGroup_(accel_group))));
}
-static XEN gxg_gtk_recent_filter_add_age(XEN filter, XEN days)
+static Xen gxg_gdk_threads_add_timeout_seconds_full(Xen priority, Xen interval, Xen function, Xen func_info, Xen notify)
{
- #define H_gtk_recent_filter_add_age "void gtk_recent_filter_add_age(GtkRecentFilter* filter, gint days)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_add_age", "GtkRecentFilter*");
- XEN_ASSERT_TYPE(XEN_gint_P(days), days, 2, "gtk_recent_filter_add_age", "gint");
- gtk_recent_filter_add_age(XEN_TO_C_GtkRecentFilter_(filter), XEN_TO_C_gint(days));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_recent_filter_add_custom(XEN filter, XEN needed, XEN func, XEN func_info, XEN data_destroy)
-{
- #define H_gtk_recent_filter_add_custom "void gtk_recent_filter_add_custom(GtkRecentFilter* filter, \
-GtkRecentFilterFlags needed, GtkRecentFilterFunc func, lambda_data func_info, GDestroyNotify data_destroy)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_add_custom", "GtkRecentFilter*");
- XEN_ASSERT_TYPE(XEN_GtkRecentFilterFlags_P(needed), needed, 2, "gtk_recent_filter_add_custom", "GtkRecentFilterFlags");
- XEN_ASSERT_TYPE(XEN_GtkRecentFilterFunc_P(func), func, 3, "gtk_recent_filter_add_custom", "GtkRecentFilterFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gtk_recent_filter_add_custom", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(data_destroy), data_destroy, 5, "gtk_recent_filter_add_custom", "GDestroyNotify");
+ #define H_gdk_threads_add_timeout_seconds_full "guint gdk_threads_add_timeout_seconds_full(gint priority, \
+guint interval, GSourceFunc function, lambda_data func_info, GDestroyNotify notify)"
+ Xen_check_type(Xen_is_gint(priority), priority, 1, "gdk_threads_add_timeout_seconds_full", "gint");
+ Xen_check_type(Xen_is_guint(interval), interval, 2, "gdk_threads_add_timeout_seconds_full", "guint");
+ Xen_check_type(Xen_is_GSourceFunc(function), function, 3, "gdk_threads_add_timeout_seconds_full", "GSourceFunc");
+ Xen_check_type(Xen_is_lambda_data(func_info), func_info, 4, "gdk_threads_add_timeout_seconds_full", "lambda_data");
+ Xen_check_type(Xen_is_GDestroyNotify(notify), notify, 5, "gdk_threads_add_timeout_seconds_full", "GDestroyNotify");
{
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- xm_protect(gxg_ptr);
- gtk_recent_filter_add_custom(XEN_TO_C_GtkRecentFilter_(filter), XEN_TO_C_GtkRecentFilterFlags(needed), XEN_TO_C_GtkRecentFilterFunc(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GDestroyNotify(data_destroy));
- return(XEN_FALSE);
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(Xen_false, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_guint(gdk_threads_add_timeout_seconds_full(Xen_to_C_gint(priority), Xen_to_C_guint(interval), Xen_to_C_GSourceFunc(function),
+ Xen_to_C_lambda_data(func_info), Xen_to_C_GDestroyNotify(notify)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
}
}
-static XEN gxg_gtk_recent_filter_get_needed(XEN filter)
+static Xen gxg_gdk_threads_add_timeout_seconds(Xen interval, Xen function, Xen func_info)
{
- #define H_gtk_recent_filter_get_needed "GtkRecentFilterFlags gtk_recent_filter_get_needed(GtkRecentFilter* filter)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_get_needed", "GtkRecentFilter*");
- return(C_TO_XEN_GtkRecentFilterFlags(gtk_recent_filter_get_needed(XEN_TO_C_GtkRecentFilter_(filter))));
+ #define H_gdk_threads_add_timeout_seconds "guint gdk_threads_add_timeout_seconds(guint interval, GSourceFunc function, \
+lambda_data func_info)"
+ Xen_check_type(Xen_is_guint(interval), interval, 1, "gdk_threads_add_timeout_seconds", "guint");
+ Xen_check_type(Xen_is_GSourceFunc(function), function, 2, "gdk_threads_add_timeout_seconds", "GSourceFunc");
+ if (!Xen_is_bound(func_info)) func_info = Xen_false;
+ else Xen_check_type(Xen_is_lambda_data(func_info), func_info, 3, "gdk_threads_add_timeout_seconds", "lambda_data");
+ {
+ Xen result;
+ int loc;
+ Xen gxg_ptr = Xen_list_5(Xen_false, func_info, Xen_false, Xen_false, Xen_false);
+ loc = xm_protect(gxg_ptr);
+ Xen_list_set(gxg_ptr, 2, C_int_to_Xen_integer(loc));
+ result = C_to_Xen_guint(gdk_threads_add_timeout_seconds(Xen_to_C_guint(interval), Xen_to_C_GSourceFunc(function), Xen_to_C_lambda_data(func_info)));
+ Xen_list_set(gxg_ptr, 2, Xen_list_3(xg_idler_symbol, result, C_int_to_Xen_integer(loc)));
+ return(result);
+ }
}
-static XEN gxg_gtk_recent_filter_filter(XEN filter, XEN filter_info)
+static Xen gxg_gtk_adjustment_get_lower(Xen adjustment)
{
- #define H_gtk_recent_filter_filter "gboolean gtk_recent_filter_filter(GtkRecentFilter* filter, GtkRecentFilterInfo* filter_info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentFilter__P(filter), filter, 1, "gtk_recent_filter_filter", "GtkRecentFilter*");
- XEN_ASSERT_TYPE(XEN_GtkRecentFilterInfo__P(filter_info), filter_info, 2, "gtk_recent_filter_filter", "GtkRecentFilterInfo*");
- return(C_TO_XEN_gboolean(gtk_recent_filter_filter(XEN_TO_C_GtkRecentFilter_(filter), XEN_TO_C_GtkRecentFilterInfo_(filter_info))));
+ #define H_gtk_adjustment_get_lower "gdouble gtk_adjustment_get_lower(GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_get_lower", "GtkAdjustment*");
+ return(C_to_Xen_gdouble(gtk_adjustment_get_lower(Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gtk_recent_manager_error_quark(void)
+static Xen gxg_gtk_adjustment_set_lower(Xen adjustment, Xen lower)
{
- #define H_gtk_recent_manager_error_quark "GQuark gtk_recent_manager_error_quark( void)"
- return(C_TO_XEN_GQuark(gtk_recent_manager_error_quark()));
+ #define H_gtk_adjustment_set_lower "void gtk_adjustment_set_lower(GtkAdjustment* adjustment, gdouble lower)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_set_lower", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(lower), lower, 2, "gtk_adjustment_set_lower", "gdouble");
+ gtk_adjustment_set_lower(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(lower));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_manager_new(void)
+static Xen gxg_gtk_adjustment_get_upper(Xen adjustment)
{
- #define H_gtk_recent_manager_new "GtkRecentManager* gtk_recent_manager_new( void)"
- return(C_TO_XEN_GtkRecentManager_(gtk_recent_manager_new()));
+ #define H_gtk_adjustment_get_upper "gdouble gtk_adjustment_get_upper(GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_get_upper", "GtkAdjustment*");
+ return(C_to_Xen_gdouble(gtk_adjustment_get_upper(Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gtk_recent_manager_get_default(void)
+static Xen gxg_gtk_adjustment_set_upper(Xen adjustment, Xen upper)
{
- #define H_gtk_recent_manager_get_default "GtkRecentManager* gtk_recent_manager_get_default( void)"
- return(C_TO_XEN_GtkRecentManager_(gtk_recent_manager_get_default()));
+ #define H_gtk_adjustment_set_upper "void gtk_adjustment_set_upper(GtkAdjustment* adjustment, gdouble upper)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_set_upper", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(upper), upper, 2, "gtk_adjustment_set_upper", "gdouble");
+ gtk_adjustment_set_upper(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(upper));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_manager_remove_item(XEN manager, XEN uri, XEN ignore_error)
+static Xen gxg_gtk_adjustment_get_step_increment(Xen adjustment)
{
- #define H_gtk_recent_manager_remove_item "gboolean gtk_recent_manager_remove_item(GtkRecentManager* manager, \
-gchar* uri, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_manager_remove_item", "GtkRecentManager*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_manager_remove_item", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_recent_manager_remove_item(XEN_TO_C_GtkRecentManager_(manager), XEN_TO_C_gchar_(uri),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_adjustment_get_step_increment "gdouble gtk_adjustment_get_step_increment(GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_get_step_increment", "GtkAdjustment*");
+ return(C_to_Xen_gdouble(gtk_adjustment_get_step_increment(Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gtk_recent_manager_lookup_item(XEN manager, XEN uri, XEN ignore_error)
+static Xen gxg_gtk_adjustment_set_step_increment(Xen adjustment, Xen step_increment)
{
- #define H_gtk_recent_manager_lookup_item "GtkRecentInfo* gtk_recent_manager_lookup_item(GtkRecentManager* manager, \
-gchar* uri, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_manager_lookup_item", "GtkRecentManager*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_manager_lookup_item", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GtkRecentInfo_(gtk_recent_manager_lookup_item(XEN_TO_C_GtkRecentManager_(manager), XEN_TO_C_gchar_(uri),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_adjustment_set_step_increment "void gtk_adjustment_set_step_increment(GtkAdjustment* adjustment, \
+gdouble step_increment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_set_step_increment", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(step_increment), step_increment, 2, "gtk_adjustment_set_step_increment", "gdouble");
+ gtk_adjustment_set_step_increment(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(step_increment));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_manager_has_item(XEN manager, XEN uri)
+static Xen gxg_gtk_adjustment_get_page_increment(Xen adjustment)
{
- #define H_gtk_recent_manager_has_item "gboolean gtk_recent_manager_has_item(GtkRecentManager* manager, \
-gchar* uri)"
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_manager_has_item", "GtkRecentManager*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_manager_has_item", "gchar*");
- return(C_TO_XEN_gboolean(gtk_recent_manager_has_item(XEN_TO_C_GtkRecentManager_(manager), XEN_TO_C_gchar_(uri))));
+ #define H_gtk_adjustment_get_page_increment "gdouble gtk_adjustment_get_page_increment(GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_get_page_increment", "GtkAdjustment*");
+ return(C_to_Xen_gdouble(gtk_adjustment_get_page_increment(Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gtk_recent_manager_move_item(XEN manager, XEN uri, XEN new_uri, XEN ignore_error)
+static Xen gxg_gtk_adjustment_set_page_increment(Xen adjustment, Xen page_increment)
{
- #define H_gtk_recent_manager_move_item "gboolean gtk_recent_manager_move_item(GtkRecentManager* manager, \
-gchar* uri, gchar* new_uri, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_manager_move_item", "GtkRecentManager*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_manager_move_item", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(new_uri), new_uri, 3, "gtk_recent_manager_move_item", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_recent_manager_move_item(XEN_TO_C_GtkRecentManager_(manager), XEN_TO_C_gchar_(uri), XEN_TO_C_gchar_(new_uri),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_adjustment_set_page_increment "void gtk_adjustment_set_page_increment(GtkAdjustment* adjustment, \
+gdouble page_increment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_set_page_increment", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(page_increment), page_increment, 2, "gtk_adjustment_set_page_increment", "gdouble");
+ gtk_adjustment_set_page_increment(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(page_increment));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_manager_get_items(XEN manager)
+static Xen gxg_gtk_adjustment_get_page_size(Xen adjustment)
{
- #define H_gtk_recent_manager_get_items "GList* gtk_recent_manager_get_items(GtkRecentManager* manager)"
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_manager_get_items", "GtkRecentManager*");
- return(C_TO_XEN_GList_(gtk_recent_manager_get_items(XEN_TO_C_GtkRecentManager_(manager))));
+ #define H_gtk_adjustment_get_page_size "gdouble gtk_adjustment_get_page_size(GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_get_page_size", "GtkAdjustment*");
+ return(C_to_Xen_gdouble(gtk_adjustment_get_page_size(Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gtk_recent_manager_purge_items(XEN manager, XEN ignore_error)
+static Xen gxg_gtk_adjustment_set_page_size(Xen adjustment, Xen page_size)
{
- #define H_gtk_recent_manager_purge_items "gint gtk_recent_manager_purge_items(GtkRecentManager* manager, \
-GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_manager_purge_items", "GtkRecentManager*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gint(gtk_recent_manager_purge_items(XEN_TO_C_GtkRecentManager_(manager), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_adjustment_set_page_size "void gtk_adjustment_set_page_size(GtkAdjustment* adjustment, \
+gdouble page_size)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_set_page_size", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(page_size), page_size, 2, "gtk_adjustment_set_page_size", "gdouble");
+ gtk_adjustment_set_page_size(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(page_size));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_info_ref(XEN info)
+static Xen gxg_gtk_adjustment_configure(Xen adjustment, Xen value, Xen lower, Xen upper, Xen step_increment, Xen page_increment, Xen page_size)
{
- #define H_gtk_recent_info_ref "GtkRecentInfo* gtk_recent_info_ref(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_ref", "GtkRecentInfo*");
- return(C_TO_XEN_GtkRecentInfo_(gtk_recent_info_ref(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_adjustment_configure "void gtk_adjustment_configure(GtkAdjustment* adjustment, gdouble value, \
+gdouble lower, gdouble upper, gdouble step_increment, gdouble page_increment, gdouble page_size)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_configure", "GtkAdjustment*");
+ Xen_check_type(Xen_is_gdouble(value), value, 2, "gtk_adjustment_configure", "gdouble");
+ Xen_check_type(Xen_is_gdouble(lower), lower, 3, "gtk_adjustment_configure", "gdouble");
+ Xen_check_type(Xen_is_gdouble(upper), upper, 4, "gtk_adjustment_configure", "gdouble");
+ Xen_check_type(Xen_is_gdouble(step_increment), step_increment, 5, "gtk_adjustment_configure", "gdouble");
+ Xen_check_type(Xen_is_gdouble(page_increment), page_increment, 6, "gtk_adjustment_configure", "gdouble");
+ Xen_check_type(Xen_is_gdouble(page_size), page_size, 7, "gtk_adjustment_configure", "gdouble");
+ gtk_adjustment_configure(Xen_to_C_GtkAdjustment_(adjustment), Xen_to_C_gdouble(value), Xen_to_C_gdouble(lower), Xen_to_C_gdouble(upper),
+ Xen_to_C_gdouble(step_increment), Xen_to_C_gdouble(page_increment), Xen_to_C_gdouble(page_size));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_info_unref(XEN info)
+static Xen gxg_gtk_combo_box_set_button_sensitivity(Xen combo_box, Xen sensitivity)
{
- #define H_gtk_recent_info_unref "void gtk_recent_info_unref(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_unref", "GtkRecentInfo*");
- gtk_recent_info_unref(XEN_TO_C_GtkRecentInfo_(info));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_set_button_sensitivity "void gtk_combo_box_set_button_sensitivity(GtkComboBox* combo_box, \
+GtkSensitivityType sensitivity)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_button_sensitivity", "GtkComboBox*");
+ Xen_check_type(Xen_is_GtkSensitivityType(sensitivity), sensitivity, 2, "gtk_combo_box_set_button_sensitivity", "GtkSensitivityType");
+ gtk_combo_box_set_button_sensitivity(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_GtkSensitivityType(sensitivity));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_info_get_uri(XEN info)
+static Xen gxg_gtk_combo_box_get_button_sensitivity(Xen combo_box)
{
- #define H_gtk_recent_info_get_uri "gchar* gtk_recent_info_get_uri(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_uri", "GtkRecentInfo*");
- return(C_TO_XEN_gchar_(gtk_recent_info_get_uri(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_combo_box_get_button_sensitivity "GtkSensitivityType gtk_combo_box_get_button_sensitivity(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_button_sensitivity", "GtkComboBox*");
+ return(C_to_Xen_GtkSensitivityType(gtk_combo_box_get_button_sensitivity(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_recent_info_get_display_name(XEN info)
+static Xen gxg_gtk_file_chooser_get_file(Xen chooser)
{
- #define H_gtk_recent_info_get_display_name "gchar* gtk_recent_info_get_display_name(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_display_name", "GtkRecentInfo*");
- return(C_TO_XEN_gchar_((gchar*)gtk_recent_info_get_display_name(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_file_chooser_get_file "GFile* gtk_file_chooser_get_file(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_file", "GtkFileChooser*");
+ return(C_to_Xen_GFile_(gtk_file_chooser_get_file(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_recent_info_get_description(XEN info)
+static Xen gxg_gtk_file_chooser_set_file(Xen chooser, Xen file, Xen ignore_error)
{
- #define H_gtk_recent_info_get_description "gchar* gtk_recent_info_get_description(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_description", "GtkRecentInfo*");
- return(C_TO_XEN_gchar_((gchar*)gtk_recent_info_get_description(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_file_chooser_set_file "gboolean gtk_file_chooser_set_file(GtkFileChooser* chooser, GFile* file, \
+GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_file", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GFile_(file), file, 2, "gtk_file_chooser_set_file", "GFile*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_file_chooser_set_file(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GFile_(file), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_recent_info_get_mime_type(XEN info)
+static Xen gxg_gtk_file_chooser_select_file(Xen chooser, Xen file, Xen ignore_error)
{
- #define H_gtk_recent_info_get_mime_type "gchar* gtk_recent_info_get_mime_type(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_mime_type", "GtkRecentInfo*");
- return(C_TO_XEN_gchar_((gchar*)gtk_recent_info_get_mime_type(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_file_chooser_select_file "gboolean gtk_file_chooser_select_file(GtkFileChooser* chooser, \
+GFile* file, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_select_file", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GFile_(file), file, 2, "gtk_file_chooser_select_file", "GFile*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_file_chooser_select_file(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GFile_(file), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_recent_info_get_added(XEN info)
+static Xen gxg_gtk_file_chooser_unselect_file(Xen chooser, Xen file)
{
- #define H_gtk_recent_info_get_added "time_t gtk_recent_info_get_added(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_added", "GtkRecentInfo*");
- return(C_TO_XEN_time_t(gtk_recent_info_get_added(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_file_chooser_unselect_file "void gtk_file_chooser_unselect_file(GtkFileChooser* chooser, \
+GFile* file)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_unselect_file", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GFile_(file), file, 2, "gtk_file_chooser_unselect_file", "GFile*");
+ gtk_file_chooser_unselect_file(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GFile_(file));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_info_get_modified(XEN info)
+static Xen gxg_gtk_file_chooser_get_files(Xen chooser)
{
- #define H_gtk_recent_info_get_modified "time_t gtk_recent_info_get_modified(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_modified", "GtkRecentInfo*");
- return(C_TO_XEN_time_t(gtk_recent_info_get_modified(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_file_chooser_get_files "GSList* gtk_file_chooser_get_files(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_files", "GtkFileChooser*");
+ return(C_to_Xen_GSList_(gtk_file_chooser_get_files(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_recent_info_get_visited(XEN info)
+static Xen gxg_gtk_file_chooser_set_current_folder_file(Xen chooser, Xen file, Xen ignore_error)
{
- #define H_gtk_recent_info_get_visited "time_t gtk_recent_info_get_visited(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_visited", "GtkRecentInfo*");
- return(C_TO_XEN_time_t(gtk_recent_info_get_visited(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_file_chooser_set_current_folder_file "gboolean gtk_file_chooser_set_current_folder_file(GtkFileChooser* chooser, \
+GFile* file, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_current_folder_file", "GtkFileChooser*");
+ Xen_check_type(Xen_is_GFile_(file), file, 2, "gtk_file_chooser_set_current_folder_file", "GFile*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_file_chooser_set_current_folder_file(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_GFile_(file),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_recent_info_get_private_hint(XEN info)
+static Xen gxg_gtk_file_chooser_get_current_folder_file(Xen chooser)
{
- #define H_gtk_recent_info_get_private_hint "gboolean gtk_recent_info_get_private_hint(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_private_hint", "GtkRecentInfo*");
- return(C_TO_XEN_gboolean(gtk_recent_info_get_private_hint(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_file_chooser_get_current_folder_file "GFile* gtk_file_chooser_get_current_folder_file(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_current_folder_file", "GtkFileChooser*");
+ return(C_to_Xen_GFile_(gtk_file_chooser_get_current_folder_file(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_recent_info_get_applications(XEN info, XEN ignore_length)
+static Xen gxg_gtk_file_chooser_get_preview_file(Xen chooser)
{
- #define H_gtk_recent_info_get_applications "gchar** gtk_recent_info_get_applications(GtkRecentInfo* info, \
-gsize* [length])"
- gsize ref_length;
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_applications", "GtkRecentInfo*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gchar__(gtk_recent_info_get_applications(XEN_TO_C_GtkRecentInfo_(info), &ref_length));
- return(XEN_LIST_2(result, C_TO_XEN_gsize(ref_length)));
- }
+ #define H_gtk_file_chooser_get_preview_file "GFile* gtk_file_chooser_get_preview_file(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_preview_file", "GtkFileChooser*");
+ return(C_to_Xen_GFile_(gtk_file_chooser_get_preview_file(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_recent_info_last_application(XEN info)
+static Xen gxg_gtk_window_get_default_widget(Xen window)
{
- #define H_gtk_recent_info_last_application "gchar* gtk_recent_info_last_application(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_last_application", "GtkRecentInfo*");
- return(C_TO_XEN_gchar_(gtk_recent_info_last_application(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_window_get_default_widget "GtkWidget* gtk_window_get_default_widget(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_default_widget", "GtkWindow*");
+ return(C_to_Xen_GtkWidget_(gtk_window_get_default_widget(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_recent_info_has_application(XEN info, XEN app_name)
+#endif
+
+#if GTK_CHECK_VERSION(2, 16, 0)
+static Xen gxg_gtk_link_button_get_visited(Xen link_button)
{
- #define H_gtk_recent_info_has_application "gboolean gtk_recent_info_has_application(GtkRecentInfo* info, \
-gchar* app_name)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_has_application", "GtkRecentInfo*");
- XEN_ASSERT_TYPE(XEN_gchar__P(app_name), app_name, 2, "gtk_recent_info_has_application", "gchar*");
- return(C_TO_XEN_gboolean(gtk_recent_info_has_application(XEN_TO_C_GtkRecentInfo_(info), XEN_TO_C_gchar_(app_name))));
+ #define H_gtk_link_button_get_visited "gboolean gtk_link_button_get_visited(GtkLinkButton* link_button)"
+ Xen_check_type(Xen_is_GtkLinkButton_(link_button), link_button, 1, "gtk_link_button_get_visited", "GtkLinkButton*");
+ return(C_to_Xen_gboolean(gtk_link_button_get_visited(Xen_to_C_GtkLinkButton_(link_button))));
}
-static XEN gxg_gtk_recent_info_get_groups(XEN info, XEN ignore_length)
+static Xen gxg_gtk_link_button_set_visited(Xen link_button, Xen visited)
{
- #define H_gtk_recent_info_get_groups "gchar** gtk_recent_info_get_groups(GtkRecentInfo* info, gsize* [length])"
- gsize ref_length;
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_groups", "GtkRecentInfo*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gchar__(gtk_recent_info_get_groups(XEN_TO_C_GtkRecentInfo_(info), &ref_length));
- return(XEN_LIST_2(result, C_TO_XEN_gsize(ref_length)));
- }
+ #define H_gtk_link_button_set_visited "void gtk_link_button_set_visited(GtkLinkButton* link_button, \
+bool visited)"
+ Xen_check_type(Xen_is_GtkLinkButton_(link_button), link_button, 1, "gtk_link_button_set_visited", "GtkLinkButton*");
+ Xen_check_type(Xen_is_bool(visited), visited, 2, "gtk_link_button_set_visited", "bool");
+ gtk_link_button_set_visited(Xen_to_C_GtkLinkButton_(link_button), Xen_to_C_bool(visited));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_info_has_group(XEN info, XEN group_name)
+static Xen gxg_gdk_keymap_get_caps_lock_state(Xen keymap)
{
- #define H_gtk_recent_info_has_group "gboolean gtk_recent_info_has_group(GtkRecentInfo* info, gchar* group_name)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_has_group", "GtkRecentInfo*");
- XEN_ASSERT_TYPE(XEN_gchar__P(group_name), group_name, 2, "gtk_recent_info_has_group", "gchar*");
- return(C_TO_XEN_gboolean(gtk_recent_info_has_group(XEN_TO_C_GtkRecentInfo_(info), XEN_TO_C_gchar_(group_name))));
+ #define H_gdk_keymap_get_caps_lock_state "gboolean gdk_keymap_get_caps_lock_state(GdkKeymap* keymap)"
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_get_caps_lock_state", "GdkKeymap*");
+ return(C_to_Xen_gboolean(gdk_keymap_get_caps_lock_state(Xen_to_C_GdkKeymap_(keymap))));
}
-static XEN gxg_gtk_recent_info_get_icon(XEN info, XEN size)
+static Xen gxg_gtk_cell_view_get_model(Xen cell_view)
{
- #define H_gtk_recent_info_get_icon "GdkPixbuf* gtk_recent_info_get_icon(GtkRecentInfo* info, gint size)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_icon", "GtkRecentInfo*");
- XEN_ASSERT_TYPE(XEN_gint_P(size), size, 2, "gtk_recent_info_get_icon", "gint");
- return(C_TO_XEN_GdkPixbuf_(gtk_recent_info_get_icon(XEN_TO_C_GtkRecentInfo_(info), XEN_TO_C_gint(size))));
+ #define H_gtk_cell_view_get_model "GtkTreeModel* gtk_cell_view_get_model(GtkCellView* cell_view)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_get_model", "GtkCellView*");
+ return(C_to_Xen_GtkTreeModel_(gtk_cell_view_get_model(Xen_to_C_GtkCellView_(cell_view))));
}
-static XEN gxg_gtk_recent_info_get_short_name(XEN info)
+static Xen gxg_gtk_entry_unset_invisible_char(Xen entry)
{
- #define H_gtk_recent_info_get_short_name "gchar* gtk_recent_info_get_short_name(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_short_name", "GtkRecentInfo*");
- return(C_TO_XEN_gchar_(gtk_recent_info_get_short_name(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_entry_unset_invisible_char "void gtk_entry_unset_invisible_char(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_unset_invisible_char", "GtkEntry*");
+ gtk_entry_unset_invisible_char(Xen_to_C_GtkEntry_(entry));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_info_get_uri_display(XEN info)
+static Xen gxg_gtk_entry_set_progress_fraction(Xen entry, Xen fraction)
{
- #define H_gtk_recent_info_get_uri_display "gchar* gtk_recent_info_get_uri_display(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_uri_display", "GtkRecentInfo*");
- return(C_TO_XEN_gchar_(gtk_recent_info_get_uri_display(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_entry_set_progress_fraction "void gtk_entry_set_progress_fraction(GtkEntry* entry, gdouble fraction)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_progress_fraction", "GtkEntry*");
+ Xen_check_type(Xen_is_gdouble(fraction), fraction, 2, "gtk_entry_set_progress_fraction", "gdouble");
+ gtk_entry_set_progress_fraction(Xen_to_C_GtkEntry_(entry), Xen_to_C_gdouble(fraction));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_info_get_age(XEN info)
+static Xen gxg_gtk_entry_get_progress_fraction(Xen entry)
{
- #define H_gtk_recent_info_get_age "gint gtk_recent_info_get_age(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_get_age", "GtkRecentInfo*");
- return(C_TO_XEN_gint(gtk_recent_info_get_age(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_entry_get_progress_fraction "gdouble gtk_entry_get_progress_fraction(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_progress_fraction", "GtkEntry*");
+ return(C_to_Xen_gdouble(gtk_entry_get_progress_fraction(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_recent_info_is_local(XEN info)
+static Xen gxg_gtk_entry_set_progress_pulse_step(Xen entry, Xen fraction)
{
- #define H_gtk_recent_info_is_local "gboolean gtk_recent_info_is_local(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_is_local", "GtkRecentInfo*");
- return(C_TO_XEN_gboolean(gtk_recent_info_is_local(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_entry_set_progress_pulse_step "void gtk_entry_set_progress_pulse_step(GtkEntry* entry, \
+gdouble fraction)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_progress_pulse_step", "GtkEntry*");
+ Xen_check_type(Xen_is_gdouble(fraction), fraction, 2, "gtk_entry_set_progress_pulse_step", "gdouble");
+ gtk_entry_set_progress_pulse_step(Xen_to_C_GtkEntry_(entry), Xen_to_C_gdouble(fraction));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_info_exists(XEN info)
+static Xen gxg_gtk_entry_get_progress_pulse_step(Xen entry)
{
- #define H_gtk_recent_info_exists "gboolean gtk_recent_info_exists(GtkRecentInfo* info)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info), info, 1, "gtk_recent_info_exists", "GtkRecentInfo*");
- return(C_TO_XEN_gboolean(gtk_recent_info_exists(XEN_TO_C_GtkRecentInfo_(info))));
+ #define H_gtk_entry_get_progress_pulse_step "gdouble gtk_entry_get_progress_pulse_step(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_progress_pulse_step", "GtkEntry*");
+ return(C_to_Xen_gdouble(gtk_entry_get_progress_pulse_step(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_recent_info_match(XEN info_a, XEN info_b)
+static Xen gxg_gtk_entry_progress_pulse(Xen entry)
{
- #define H_gtk_recent_info_match "gboolean gtk_recent_info_match(GtkRecentInfo* info_a, GtkRecentInfo* info_b)"
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info_a), info_a, 1, "gtk_recent_info_match", "GtkRecentInfo*");
- XEN_ASSERT_TYPE(XEN_GtkRecentInfo__P(info_b), info_b, 2, "gtk_recent_info_match", "GtkRecentInfo*");
- return(C_TO_XEN_gboolean(gtk_recent_info_match(XEN_TO_C_GtkRecentInfo_(info_a), XEN_TO_C_GtkRecentInfo_(info_b))));
+ #define H_gtk_entry_progress_pulse "void gtk_entry_progress_pulse(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_progress_pulse", "GtkEntry*");
+ gtk_entry_progress_pulse(Xen_to_C_GtkEntry_(entry));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_new(void)
+static Xen gxg_gtk_entry_set_icon_from_pixbuf(Xen entry, Xen icon_pos, Xen pixbuf)
{
- #define H_gtk_status_icon_new "GtkStatusIcon* gtk_status_icon_new( void)"
- return(C_TO_XEN_GtkStatusIcon_(gtk_status_icon_new()));
+ #define H_gtk_entry_set_icon_from_pixbuf "void gtk_entry_set_icon_from_pixbuf(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
+GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_icon_from_pixbuf", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_set_icon_from_pixbuf", "GtkEntryIconPosition");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 3, "gtk_entry_set_icon_from_pixbuf", "GdkPixbuf*");
+ gtk_entry_set_icon_from_pixbuf(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos), Xen_to_C_GdkPixbuf_(pixbuf));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_new_from_pixbuf(XEN pixbuf)
+static Xen gxg_gtk_entry_set_icon_from_icon_name(Xen entry, Xen icon_pos, Xen icon_name)
{
- #define H_gtk_status_icon_new_from_pixbuf "GtkStatusIcon* gtk_status_icon_new_from_pixbuf(GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gtk_status_icon_new_from_pixbuf", "GdkPixbuf*");
- return(C_TO_XEN_GtkStatusIcon_(gtk_status_icon_new_from_pixbuf(XEN_TO_C_GdkPixbuf_(pixbuf))));
+ #define H_gtk_entry_set_icon_from_icon_name "void gtk_entry_set_icon_from_icon_name(GtkEntry* entry, \
+GtkEntryIconPosition icon_pos, gchar* icon_name)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_icon_from_icon_name", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_set_icon_from_icon_name", "GtkEntryIconPosition");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 3, "gtk_entry_set_icon_from_icon_name", "gchar*");
+ gtk_entry_set_icon_from_icon_name(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos), Xen_to_C_gchar_(icon_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_new_from_file(XEN filename)
+static Xen gxg_gtk_entry_set_icon_from_gicon(Xen entry, Xen icon_pos, Xen icon)
{
- #define H_gtk_status_icon_new_from_file "GtkStatusIcon* gtk_status_icon_new_from_file(gchar* filename)"
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 1, "gtk_status_icon_new_from_file", "gchar*");
- return(C_TO_XEN_GtkStatusIcon_(gtk_status_icon_new_from_file(XEN_TO_C_gchar_(filename))));
+ #define H_gtk_entry_set_icon_from_gicon "void gtk_entry_set_icon_from_gicon(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
+GIcon* icon)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_icon_from_gicon", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_set_icon_from_gicon", "GtkEntryIconPosition");
+ Xen_check_type(Xen_is_GIcon_(icon), icon, 3, "gtk_entry_set_icon_from_gicon", "GIcon*");
+ gtk_entry_set_icon_from_gicon(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos), Xen_to_C_GIcon_(icon));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_new_from_stock(XEN stock_id)
+static Xen gxg_gtk_entry_get_icon_name(Xen entry, Xen icon_pos)
{
- #define H_gtk_status_icon_new_from_stock "GtkStatusIcon* gtk_status_icon_new_from_stock(gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 1, "gtk_status_icon_new_from_stock", "gchar*");
- return(C_TO_XEN_GtkStatusIcon_(gtk_status_icon_new_from_stock(XEN_TO_C_gchar_(stock_id))));
+ #define H_gtk_entry_get_icon_name "gchar* gtk_entry_get_icon_name(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_name", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_get_icon_name", "GtkEntryIconPosition");
+ return(C_to_Xen_gchar_(gtk_entry_get_icon_name(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos))));
}
-static XEN gxg_gtk_status_icon_new_from_icon_name(XEN icon_name)
+static Xen gxg_gtk_entry_set_icon_activatable(Xen entry, Xen icon_pos, Xen activatable)
{
- #define H_gtk_status_icon_new_from_icon_name "GtkStatusIcon* gtk_status_icon_new_from_icon_name(gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 1, "gtk_status_icon_new_from_icon_name", "gchar*");
- return(C_TO_XEN_GtkStatusIcon_(gtk_status_icon_new_from_icon_name(XEN_TO_C_gchar_(icon_name))));
+ #define H_gtk_entry_set_icon_activatable "void gtk_entry_set_icon_activatable(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
+gboolean activatable)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_icon_activatable", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_set_icon_activatable", "GtkEntryIconPosition");
+ Xen_check_type(Xen_is_gboolean(activatable), activatable, 3, "gtk_entry_set_icon_activatable", "gboolean");
+ gtk_entry_set_icon_activatable(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos), Xen_to_C_gboolean(activatable));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_set_from_pixbuf(XEN status_icon, XEN pixbuf)
+static Xen gxg_gtk_entry_get_icon_activatable(Xen entry, Xen icon_pos)
{
- #define H_gtk_status_icon_set_from_pixbuf "void gtk_status_icon_set_from_pixbuf(GtkStatusIcon* status_icon, \
-GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_from_pixbuf", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gtk_status_icon_set_from_pixbuf", "GdkPixbuf*");
- gtk_status_icon_set_from_pixbuf(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_entry_get_icon_activatable "gboolean gtk_entry_get_icon_activatable(GtkEntry* entry, \
+GtkEntryIconPosition icon_pos)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_activatable", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_get_icon_activatable", "GtkEntryIconPosition");
+ return(C_to_Xen_gboolean(gtk_entry_get_icon_activatable(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos))));
}
-static XEN gxg_gtk_status_icon_set_from_file(XEN status_icon, XEN filename)
+static Xen gxg_gtk_entry_set_icon_sensitive(Xen entry, Xen icon_pos, Xen sensitive)
{
- #define H_gtk_status_icon_set_from_file "void gtk_status_icon_set_from_file(GtkStatusIcon* status_icon, \
-gchar* filename)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_from_file", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 2, "gtk_status_icon_set_from_file", "gchar*");
- gtk_status_icon_set_from_file(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_gchar_(filename));
- return(XEN_FALSE);
+ #define H_gtk_entry_set_icon_sensitive "void gtk_entry_set_icon_sensitive(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
+gboolean sensitive)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_icon_sensitive", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_set_icon_sensitive", "GtkEntryIconPosition");
+ Xen_check_type(Xen_is_gboolean(sensitive), sensitive, 3, "gtk_entry_set_icon_sensitive", "gboolean");
+ gtk_entry_set_icon_sensitive(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos), Xen_to_C_gboolean(sensitive));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_set_from_stock(XEN status_icon, XEN stock_id)
+static Xen gxg_gtk_entry_get_icon_sensitive(Xen entry, Xen icon_pos)
{
- #define H_gtk_status_icon_set_from_stock "void gtk_status_icon_set_from_stock(GtkStatusIcon* status_icon, \
-gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_from_stock", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_status_icon_set_from_stock", "gchar*");
- gtk_status_icon_set_from_stock(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_gchar_(stock_id));
- return(XEN_FALSE);
+ #define H_gtk_entry_get_icon_sensitive "gboolean gtk_entry_get_icon_sensitive(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_sensitive", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_get_icon_sensitive", "GtkEntryIconPosition");
+ return(C_to_Xen_gboolean(gtk_entry_get_icon_sensitive(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos))));
}
-static XEN gxg_gtk_status_icon_set_from_icon_name(XEN status_icon, XEN icon_name)
+static Xen gxg_gtk_entry_get_icon_at_pos(Xen entry, Xen x, Xen y)
{
- #define H_gtk_status_icon_set_from_icon_name "void gtk_status_icon_set_from_icon_name(GtkStatusIcon* status_icon, \
-gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_from_icon_name", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_status_icon_set_from_icon_name", "gchar*");
- gtk_status_icon_set_from_icon_name(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_gchar_(icon_name));
- return(XEN_FALSE);
+ #define H_gtk_entry_get_icon_at_pos "gint gtk_entry_get_icon_at_pos(GtkEntry* entry, gint x, gint y)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_at_pos", "GtkEntry*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_entry_get_icon_at_pos", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_entry_get_icon_at_pos", "gint");
+ return(C_to_Xen_gint(gtk_entry_get_icon_at_pos(Xen_to_C_GtkEntry_(entry), Xen_to_C_gint(x), Xen_to_C_gint(y))));
}
-static XEN gxg_gtk_status_icon_get_storage_type(XEN status_icon)
+static Xen gxg_gtk_entry_set_icon_tooltip_text(Xen entry, Xen icon_pos, Xen tooltip)
{
- #define H_gtk_status_icon_get_storage_type "GtkImageType gtk_status_icon_get_storage_type(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_storage_type", "GtkStatusIcon*");
- return(C_TO_XEN_GtkImageType(gtk_status_icon_get_storage_type(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_entry_set_icon_tooltip_text "void gtk_entry_set_icon_tooltip_text(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
+gchar* tooltip)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_icon_tooltip_text", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_set_icon_tooltip_text", "GtkEntryIconPosition");
+ Xen_check_type(Xen_is_gchar_(tooltip), tooltip, 3, "gtk_entry_set_icon_tooltip_text", "gchar*");
+ gtk_entry_set_icon_tooltip_text(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos), Xen_to_C_gchar_(tooltip));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_get_pixbuf(XEN status_icon)
+static Xen gxg_gtk_entry_set_icon_tooltip_markup(Xen entry, Xen icon_pos, Xen tooltip)
{
- #define H_gtk_status_icon_get_pixbuf "GdkPixbuf* gtk_status_icon_get_pixbuf(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_pixbuf", "GtkStatusIcon*");
- return(C_TO_XEN_GdkPixbuf_(gtk_status_icon_get_pixbuf(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_entry_set_icon_tooltip_markup "void gtk_entry_set_icon_tooltip_markup(GtkEntry* entry, \
+GtkEntryIconPosition icon_pos, gchar* tooltip)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_icon_tooltip_markup", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_set_icon_tooltip_markup", "GtkEntryIconPosition");
+ Xen_check_type(Xen_is_gchar_(tooltip), tooltip, 3, "gtk_entry_set_icon_tooltip_markup", "gchar*");
+ gtk_entry_set_icon_tooltip_markup(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos), Xen_to_C_gchar_(tooltip));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_get_stock(XEN status_icon)
+static Xen gxg_gtk_entry_set_icon_drag_source(Xen entry, Xen icon_pos, Xen target_list, Xen actions)
{
- #define H_gtk_status_icon_get_stock "gchar* gtk_status_icon_get_stock(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_stock", "GtkStatusIcon*");
- return(C_TO_XEN_gchar_(gtk_status_icon_get_stock(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_entry_set_icon_drag_source "void gtk_entry_set_icon_drag_source(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
+GtkTargetList* target_list, GdkDragAction actions)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_icon_drag_source", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_set_icon_drag_source", "GtkEntryIconPosition");
+ Xen_check_type(Xen_is_GtkTargetList_(target_list), target_list, 3, "gtk_entry_set_icon_drag_source", "GtkTargetList*");
+ Xen_check_type(Xen_is_GdkDragAction(actions), actions, 4, "gtk_entry_set_icon_drag_source", "GdkDragAction");
+ gtk_entry_set_icon_drag_source(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos), Xen_to_C_GtkTargetList_(target_list),
+ Xen_to_C_GdkDragAction(actions));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_get_icon_name(XEN status_icon)
+static Xen gxg_gtk_entry_get_current_icon_drag_source(Xen entry)
{
- #define H_gtk_status_icon_get_icon_name "gchar* gtk_status_icon_get_icon_name(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_icon_name", "GtkStatusIcon*");
- return(C_TO_XEN_gchar_(gtk_status_icon_get_icon_name(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_entry_get_current_icon_drag_source "gint gtk_entry_get_current_icon_drag_source(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_current_icon_drag_source", "GtkEntry*");
+ return(C_to_Xen_gint(gtk_entry_get_current_icon_drag_source(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_status_icon_get_size(XEN status_icon)
+static Xen gxg_gtk_menu_item_set_label(Xen menu_item, Xen label)
{
- #define H_gtk_status_icon_get_size "gint gtk_status_icon_get_size(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_size", "GtkStatusIcon*");
- return(C_TO_XEN_gint(gtk_status_icon_get_size(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_menu_item_set_label "void gtk_menu_item_set_label(GtkMenuItem* menu_item, gchar* label)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_set_label", "GtkMenuItem*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_menu_item_set_label", "gchar*");
+ gtk_menu_item_set_label(Xen_to_C_GtkMenuItem_(menu_item), Xen_to_C_gchar_(label));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_set_visible(XEN status_icon, XEN visible)
+static Xen gxg_gtk_menu_item_get_label(Xen menu_item)
{
- #define H_gtk_status_icon_set_visible "void gtk_status_icon_set_visible(GtkStatusIcon* status_icon, \
-gboolean visible)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_visible", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible), visible, 2, "gtk_status_icon_set_visible", "gboolean");
- gtk_status_icon_set_visible(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_gboolean(visible));
- return(XEN_FALSE);
+ #define H_gtk_menu_item_get_label "gchar* gtk_menu_item_get_label(GtkMenuItem* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_get_label", "GtkMenuItem*");
+ return(C_to_Xen_gchar_(gtk_menu_item_get_label(Xen_to_C_GtkMenuItem_(menu_item))));
}
-static XEN gxg_gtk_status_icon_get_visible(XEN status_icon)
+static Xen gxg_gtk_menu_item_set_use_underline(Xen menu_item, Xen setting)
{
- #define H_gtk_status_icon_get_visible "gboolean gtk_status_icon_get_visible(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_visible", "GtkStatusIcon*");
- return(C_TO_XEN_gboolean(gtk_status_icon_get_visible(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_menu_item_set_use_underline "void gtk_menu_item_set_use_underline(GtkMenuItem* menu_item, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_set_use_underline", "GtkMenuItem*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_menu_item_set_use_underline", "gboolean");
+ gtk_menu_item_set_use_underline(Xen_to_C_GtkMenuItem_(menu_item), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_is_embedded(XEN status_icon)
+static Xen gxg_gtk_menu_item_get_use_underline(Xen menu_item)
{
- #define H_gtk_status_icon_is_embedded "gboolean gtk_status_icon_is_embedded(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_is_embedded", "GtkStatusIcon*");
- return(C_TO_XEN_gboolean(gtk_status_icon_is_embedded(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_menu_item_get_use_underline "gboolean gtk_menu_item_get_use_underline(GtkMenuItem* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_get_use_underline", "GtkMenuItem*");
+ return(C_to_Xen_gboolean(gtk_menu_item_get_use_underline(Xen_to_C_GtkMenuItem_(menu_item))));
}
-static XEN gxg_gtk_status_icon_position_menu(XEN menu, XEN ignore_x, XEN ignore_y, XEN ignore_push_in, XEN user_data)
+static Xen gxg_gtk_selection_data_get_selection(Xen selection_data)
{
- #define H_gtk_status_icon_position_menu "void gtk_status_icon_position_menu(GtkMenu* menu, gint* [x], \
-gint* [y], gboolean* [push_in], gpointer user_data)"
- gint ref_x;
- gint ref_y;
- gboolean ref_push_in;
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_status_icon_position_menu", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 5, "gtk_status_icon_position_menu", "gpointer");
- gtk_status_icon_position_menu(XEN_TO_C_GtkMenu_(menu), &ref_x, &ref_y, &ref_push_in, XEN_TO_C_gpointer(user_data));
- return(XEN_LIST_3(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_gboolean(ref_push_in)));
+ #define H_gtk_selection_data_get_selection "GdkAtom gtk_selection_data_get_selection(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_selection", "GtkSelectionData*");
+ return(C_to_Xen_GdkAtom(gtk_selection_data_get_selection(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_text_buffer_register_serialize_format(XEN buffer, XEN mime_type, XEN function, XEN user_data, XEN user_data_destroy)
+static Xen gxg_gtk_entry_get_icon_tooltip_text(Xen entry, Xen icon_pos)
{
- #define H_gtk_text_buffer_register_serialize_format "GdkAtom gtk_text_buffer_register_serialize_format(GtkTextBuffer* buffer, \
-gchar* mime_type, GtkTextBufferSerializeFunc function, gpointer user_data, GDestroyNotify user_data_destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_register_serialize_format", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(mime_type), mime_type, 2, "gtk_text_buffer_register_serialize_format", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkTextBufferSerializeFunc_P(function), function, 3, "gtk_text_buffer_register_serialize_format", "GtkTextBufferSerializeFunc");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 4, "gtk_text_buffer_register_serialize_format", "gpointer");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(user_data_destroy), user_data_destroy, 5, "gtk_text_buffer_register_serialize_format", "GDestroyNotify");
- return(C_TO_XEN_GdkAtom(gtk_text_buffer_register_serialize_format(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(mime_type),
- XEN_TO_C_GtkTextBufferSerializeFunc(function), XEN_TO_C_gpointer(user_data),
- XEN_TO_C_GDestroyNotify(user_data_destroy))));
+ #define H_gtk_entry_get_icon_tooltip_text "gchar* gtk_entry_get_icon_tooltip_text(GtkEntry* entry, \
+GtkEntryIconPosition icon_pos)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_tooltip_text", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_get_icon_tooltip_text", "GtkEntryIconPosition");
+ return(C_to_Xen_gchar_(gtk_entry_get_icon_tooltip_text(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos))));
}
-static XEN gxg_gtk_text_buffer_register_serialize_tagset(XEN buffer, XEN tagset_name)
+static Xen gxg_gtk_entry_get_icon_tooltip_markup(Xen entry, Xen icon_pos)
{
- #define H_gtk_text_buffer_register_serialize_tagset "GdkAtom gtk_text_buffer_register_serialize_tagset(GtkTextBuffer* buffer, \
-gchar* tagset_name)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_register_serialize_tagset", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(tagset_name), tagset_name, 2, "gtk_text_buffer_register_serialize_tagset", "gchar*");
- return(C_TO_XEN_GdkAtom(gtk_text_buffer_register_serialize_tagset(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(tagset_name))));
+ #define H_gtk_entry_get_icon_tooltip_markup "gchar* gtk_entry_get_icon_tooltip_markup(GtkEntry* entry, \
+GtkEntryIconPosition icon_pos)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_tooltip_markup", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_get_icon_tooltip_markup", "GtkEntryIconPosition");
+ return(C_to_Xen_gchar_(gtk_entry_get_icon_tooltip_markup(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos))));
}
-static XEN gxg_gtk_text_buffer_register_deserialize_format(XEN buffer, XEN mime_type, XEN function, XEN user_data, XEN user_data_destroy)
+static Xen gxg_gtk_scale_add_mark(Xen scale, Xen value, Xen position, Xen markup)
{
- #define H_gtk_text_buffer_register_deserialize_format "GdkAtom gtk_text_buffer_register_deserialize_format(GtkTextBuffer* buffer, \
-gchar* mime_type, GtkTextBufferDeserializeFunc function, gpointer user_data, GDestroyNotify user_data_destroy)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_register_deserialize_format", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(mime_type), mime_type, 2, "gtk_text_buffer_register_deserialize_format", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkTextBufferDeserializeFunc_P(function), function, 3, "gtk_text_buffer_register_deserialize_format", "GtkTextBufferDeserializeFunc");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 4, "gtk_text_buffer_register_deserialize_format", "gpointer");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(user_data_destroy), user_data_destroy, 5, "gtk_text_buffer_register_deserialize_format", "GDestroyNotify");
- return(C_TO_XEN_GdkAtom(gtk_text_buffer_register_deserialize_format(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(mime_type),
- XEN_TO_C_GtkTextBufferDeserializeFunc(function), XEN_TO_C_gpointer(user_data),
- XEN_TO_C_GDestroyNotify(user_data_destroy))));
+ #define H_gtk_scale_add_mark "void gtk_scale_add_mark(GtkScale* scale, gdouble value, GtkPositionType position, \
+gchar* markup)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_add_mark", "GtkScale*");
+ Xen_check_type(Xen_is_gdouble(value), value, 2, "gtk_scale_add_mark", "gdouble");
+ Xen_check_type(Xen_is_GtkPositionType(position), position, 3, "gtk_scale_add_mark", "GtkPositionType");
+ Xen_check_type(Xen_is_gchar_(markup), markup, 4, "gtk_scale_add_mark", "gchar*");
+ gtk_scale_add_mark(Xen_to_C_GtkScale_(scale), Xen_to_C_gdouble(value), Xen_to_C_GtkPositionType(position), Xen_to_C_gchar_(markup));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_register_deserialize_tagset(XEN buffer, XEN tagset_name)
+static Xen gxg_gtk_scale_clear_marks(Xen scale)
{
- #define H_gtk_text_buffer_register_deserialize_tagset "GdkAtom gtk_text_buffer_register_deserialize_tagset(GtkTextBuffer* buffer, \
-gchar* tagset_name)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_register_deserialize_tagset", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(tagset_name), tagset_name, 2, "gtk_text_buffer_register_deserialize_tagset", "gchar*");
- return(C_TO_XEN_GdkAtom(gtk_text_buffer_register_deserialize_tagset(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_gchar_(tagset_name))));
+ #define H_gtk_scale_clear_marks "void gtk_scale_clear_marks(GtkScale* scale)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_clear_marks", "GtkScale*");
+ gtk_scale_clear_marks(Xen_to_C_GtkScale_(scale));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_unregister_serialize_format(XEN buffer, XEN format)
+#endif
+
+#if GTK_CHECK_VERSION(2, 18, 0)
+static Xen gxg_gtk_window_get_default_icon_name(void)
{
- #define H_gtk_text_buffer_unregister_serialize_format "void gtk_text_buffer_unregister_serialize_format(GtkTextBuffer* buffer, \
-GdkAtom format)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_unregister_serialize_format", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(format), format, 2, "gtk_text_buffer_unregister_serialize_format", "GdkAtom");
- gtk_text_buffer_unregister_serialize_format(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GdkAtom(format));
- return(XEN_FALSE);
+ #define H_gtk_window_get_default_icon_name "gchar* gtk_window_get_default_icon_name( void)"
+ return(C_to_Xen_gchar_(gtk_window_get_default_icon_name()));
}
-static XEN gxg_gtk_text_buffer_unregister_deserialize_format(XEN buffer, XEN format)
+static Xen gxg_gtk_label_get_current_uri(Xen label)
{
- #define H_gtk_text_buffer_unregister_deserialize_format "void gtk_text_buffer_unregister_deserialize_format(GtkTextBuffer* buffer, \
-GdkAtom format)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_unregister_deserialize_format", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(format), format, 2, "gtk_text_buffer_unregister_deserialize_format", "GdkAtom");
- gtk_text_buffer_unregister_deserialize_format(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GdkAtom(format));
- return(XEN_FALSE);
+ #define H_gtk_label_get_current_uri "gchar* gtk_label_get_current_uri(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_current_uri", "GtkLabel*");
+ return(C_to_Xen_gchar_(gtk_label_get_current_uri(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_text_buffer_deserialize_set_can_create_tags(XEN buffer, XEN format, XEN can_create_tags)
+static Xen gxg_gtk_info_bar_new(void)
{
- #define H_gtk_text_buffer_deserialize_set_can_create_tags "void gtk_text_buffer_deserialize_set_can_create_tags(GtkTextBuffer* buffer, \
-GdkAtom format, gboolean can_create_tags)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_deserialize_set_can_create_tags", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(format), format, 2, "gtk_text_buffer_deserialize_set_can_create_tags", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_gboolean_P(can_create_tags), can_create_tags, 3, "gtk_text_buffer_deserialize_set_can_create_tags", "gboolean");
- gtk_text_buffer_deserialize_set_can_create_tags(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GdkAtom(format), XEN_TO_C_gboolean(can_create_tags));
- return(XEN_FALSE);
+ #define H_gtk_info_bar_new "GtkWidget* gtk_info_bar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_info_bar_new()));
}
-static XEN gxg_gtk_text_buffer_deserialize_get_can_create_tags(XEN buffer, XEN format)
+static Xen gxg_gtk_info_bar_get_action_area(Xen info_bar)
{
- #define H_gtk_text_buffer_deserialize_get_can_create_tags "gboolean gtk_text_buffer_deserialize_get_can_create_tags(GtkTextBuffer* buffer, \
-GdkAtom format)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_deserialize_get_can_create_tags", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(format), format, 2, "gtk_text_buffer_deserialize_get_can_create_tags", "GdkAtom");
- return(C_TO_XEN_gboolean(gtk_text_buffer_deserialize_get_can_create_tags(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GdkAtom(format))));
+ #define H_gtk_info_bar_get_action_area "GtkWidget* gtk_info_bar_get_action_area(GtkInfoBar* info_bar)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_get_action_area", "GtkInfoBar*");
+ return(C_to_Xen_GtkWidget_(gtk_info_bar_get_action_area(Xen_to_C_GtkInfoBar_(info_bar))));
}
-static XEN gxg_gtk_text_buffer_get_serialize_formats(XEN buffer, XEN ignore_n_formats)
+static Xen gxg_gtk_info_bar_get_content_area(Xen info_bar)
{
- #define H_gtk_text_buffer_get_serialize_formats "GdkAtom* gtk_text_buffer_get_serialize_formats(GtkTextBuffer* buffer, \
-gint* [n_formats])"
- gint ref_n_formats;
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_serialize_formats", "GtkTextBuffer*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkAtom_(gtk_text_buffer_get_serialize_formats(XEN_TO_C_GtkTextBuffer_(buffer), &ref_n_formats));
- return(XEN_LIST_2(result, C_TO_XEN_gint(ref_n_formats)));
- }
+ #define H_gtk_info_bar_get_content_area "GtkWidget* gtk_info_bar_get_content_area(GtkInfoBar* info_bar)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_get_content_area", "GtkInfoBar*");
+ return(C_to_Xen_GtkWidget_(gtk_info_bar_get_content_area(Xen_to_C_GtkInfoBar_(info_bar))));
}
-static XEN gxg_gtk_text_buffer_get_deserialize_formats(XEN buffer, XEN ignore_n_formats)
+static Xen gxg_gtk_info_bar_add_action_widget(Xen info_bar, Xen child, Xen response_id)
{
- #define H_gtk_text_buffer_get_deserialize_formats "GdkAtom* gtk_text_buffer_get_deserialize_formats(GtkTextBuffer* buffer, \
-gint* [n_formats])"
- gint ref_n_formats;
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_get_deserialize_formats", "GtkTextBuffer*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkAtom_(gtk_text_buffer_get_deserialize_formats(XEN_TO_C_GtkTextBuffer_(buffer), &ref_n_formats));
- return(XEN_LIST_2(result, C_TO_XEN_gint(ref_n_formats)));
- }
+ #define H_gtk_info_bar_add_action_widget "void gtk_info_bar_add_action_widget(GtkInfoBar* info_bar, \
+GtkWidget* child, gint response_id)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_add_action_widget", "GtkInfoBar*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_info_bar_add_action_widget", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 3, "gtk_info_bar_add_action_widget", "gint");
+ gtk_info_bar_add_action_widget(Xen_to_C_GtkInfoBar_(info_bar), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(response_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_text_buffer_serialize(XEN register_buffer, XEN content_buffer, XEN format, XEN start, XEN end, XEN ignore_length)
+static Xen gxg_gtk_info_bar_add_button(Xen info_bar, Xen button_text, Xen response_id)
{
- #define H_gtk_text_buffer_serialize "guint8* gtk_text_buffer_serialize(GtkTextBuffer* register_buffer, \
-GtkTextBuffer* content_buffer, GdkAtom format, GtkTextIter* start, GtkTextIter* end, gsize* [length])"
- gsize ref_length;
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(register_buffer), register_buffer, 1, "gtk_text_buffer_serialize", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(content_buffer), content_buffer, 2, "gtk_text_buffer_serialize", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(format), format, 3, "gtk_text_buffer_serialize", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(start), start, 4, "gtk_text_buffer_serialize", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(end), end, 5, "gtk_text_buffer_serialize", "GtkTextIter*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_guint8_(gtk_text_buffer_serialize(XEN_TO_C_GtkTextBuffer_(register_buffer), XEN_TO_C_GtkTextBuffer_(content_buffer),
- XEN_TO_C_GdkAtom(format), XEN_TO_C_GtkTextIter_(start), XEN_TO_C_GtkTextIter_(end),
- &ref_length));
- return(XEN_LIST_2(result, C_TO_XEN_gsize(ref_length)));
- }
+ #define H_gtk_info_bar_add_button "GtkWidget* gtk_info_bar_add_button(GtkInfoBar* info_bar, gchar* button_text, \
+gint response_id)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_add_button", "GtkInfoBar*");
+ Xen_check_type(Xen_is_gchar_(button_text), button_text, 2, "gtk_info_bar_add_button", "gchar*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 3, "gtk_info_bar_add_button", "gint");
+ return(C_to_Xen_GtkWidget_(gtk_info_bar_add_button(Xen_to_C_GtkInfoBar_(info_bar), Xen_to_C_gchar_(button_text), Xen_to_C_gint(response_id))));
}
-static XEN gxg_gtk_text_buffer_deserialize(XEN register_buffer, XEN content_buffer, XEN format, XEN iter, XEN data, XEN length, XEN ignore_error)
+static Xen gxg_gtk_info_bar_set_response_sensitive(Xen info_bar, Xen response_id, Xen setting)
{
- #define H_gtk_text_buffer_deserialize "gboolean gtk_text_buffer_deserialize(GtkTextBuffer* register_buffer, \
-GtkTextBuffer* content_buffer, GdkAtom format, GtkTextIter* iter, guint8* data, gsize length, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(register_buffer), register_buffer, 1, "gtk_text_buffer_deserialize", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(content_buffer), content_buffer, 2, "gtk_text_buffer_deserialize", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(format), format, 3, "gtk_text_buffer_deserialize", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(iter), iter, 4, "gtk_text_buffer_deserialize", "GtkTextIter*");
- XEN_ASSERT_TYPE(XEN_guint8__P(data), data, 5, "gtk_text_buffer_deserialize", "guint8*");
- XEN_ASSERT_TYPE(XEN_gsize_P(length), length, 6, "gtk_text_buffer_deserialize", "gsize");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_text_buffer_deserialize(XEN_TO_C_GtkTextBuffer_(register_buffer), XEN_TO_C_GtkTextBuffer_(content_buffer),
- XEN_TO_C_GdkAtom(format), XEN_TO_C_GtkTextIter_(iter), XEN_TO_C_guint8_(data),
- XEN_TO_C_gsize(length), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_info_bar_set_response_sensitive "void gtk_info_bar_set_response_sensitive(GtkInfoBar* info_bar, \
+gint response_id, gboolean setting)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_set_response_sensitive", "GtkInfoBar*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 2, "gtk_info_bar_set_response_sensitive", "gint");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 3, "gtk_info_bar_set_response_sensitive", "gboolean");
+ gtk_info_bar_set_response_sensitive(Xen_to_C_GtkInfoBar_(info_bar), Xen_to_C_gint(response_id), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_manager_add_item(XEN manager, XEN uri)
+static Xen gxg_gtk_info_bar_set_default_response(Xen info_bar, Xen response_id)
{
- #define H_gtk_recent_manager_add_item "gboolean gtk_recent_manager_add_item(GtkRecentManager* manager, \
-gchar* uri)"
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_manager_add_item", "GtkRecentManager*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_manager_add_item", "gchar*");
- return(C_TO_XEN_gboolean(gtk_recent_manager_add_item(XEN_TO_C_GtkRecentManager_(manager), XEN_TO_C_gchar_(uri))));
+ #define H_gtk_info_bar_set_default_response "void gtk_info_bar_set_default_response(GtkInfoBar* info_bar, \
+gint response_id)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_set_default_response", "GtkInfoBar*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 2, "gtk_info_bar_set_default_response", "gint");
+ gtk_info_bar_set_default_response(Xen_to_C_GtkInfoBar_(info_bar), Xen_to_C_gint(response_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_recent_manager_add_full(XEN manager, XEN uri, XEN recent_data)
+static Xen gxg_gtk_info_bar_response(Xen info_bar, Xen response_id)
{
- #define H_gtk_recent_manager_add_full "gboolean gtk_recent_manager_add_full(GtkRecentManager* manager, \
-gchar* uri, GtkRecentData* recent_data)"
- XEN_ASSERT_TYPE(XEN_GtkRecentManager__P(manager), manager, 1, "gtk_recent_manager_add_full", "GtkRecentManager*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_recent_manager_add_full", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkRecentData__P(recent_data), recent_data, 3, "gtk_recent_manager_add_full", "GtkRecentData*");
- return(C_TO_XEN_gboolean(gtk_recent_manager_add_full(XEN_TO_C_GtkRecentManager_(manager), XEN_TO_C_gchar_(uri), XEN_TO_C_GtkRecentData_(recent_data))));
+ #define H_gtk_info_bar_response "void gtk_info_bar_response(GtkInfoBar* info_bar, gint response_id)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_response", "GtkInfoBar*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 2, "gtk_info_bar_response", "gint");
+ gtk_info_bar_response(Xen_to_C_GtkInfoBar_(info_bar), Xen_to_C_gint(response_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_model_filter_convert_child_iter_to_iter(XEN filter, XEN filter_iter, XEN child_iter)
+static Xen gxg_gtk_info_bar_set_message_type(Xen info_bar, Xen message_type)
{
- #define H_gtk_tree_model_filter_convert_child_iter_to_iter "gboolean gtk_tree_model_filter_convert_child_iter_to_iter(GtkTreeModelFilter* filter, \
-GtkTreeIter* filter_iter, GtkTreeIter* child_iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModelFilter__P(filter), filter, 1, "gtk_tree_model_filter_convert_child_iter_to_iter", "GtkTreeModelFilter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(filter_iter), filter_iter, 2, "gtk_tree_model_filter_convert_child_iter_to_iter", "GtkTreeIter*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(child_iter), child_iter, 3, "gtk_tree_model_filter_convert_child_iter_to_iter", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_model_filter_convert_child_iter_to_iter(XEN_TO_C_GtkTreeModelFilter_(filter), XEN_TO_C_GtkTreeIter_(filter_iter),
- XEN_TO_C_GtkTreeIter_(child_iter))));
+ #define H_gtk_info_bar_set_message_type "void gtk_info_bar_set_message_type(GtkInfoBar* info_bar, GtkMessageType message_type)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_set_message_type", "GtkInfoBar*");
+ Xen_check_type(Xen_is_GtkMessageType(message_type), message_type, 2, "gtk_info_bar_set_message_type", "GtkMessageType");
+ gtk_info_bar_set_message_type(Xen_to_C_GtkInfoBar_(info_bar), Xen_to_C_GtkMessageType(message_type));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_grid_lines(XEN tree_view)
+static Xen gxg_gtk_info_bar_get_message_type(Xen info_bar)
{
- #define H_gtk_tree_view_get_grid_lines "GtkTreeViewGridLines gtk_tree_view_get_grid_lines(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_grid_lines", "GtkTreeView*");
- return(C_TO_XEN_GtkTreeViewGridLines(gtk_tree_view_get_grid_lines(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_info_bar_get_message_type "GtkMessageType gtk_info_bar_get_message_type(GtkInfoBar* info_bar)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_get_message_type", "GtkInfoBar*");
+ return(C_to_Xen_GtkMessageType(gtk_info_bar_get_message_type(Xen_to_C_GtkInfoBar_(info_bar))));
}
-static XEN gxg_gtk_tree_view_set_grid_lines(XEN tree_view, XEN grid_lines)
+static Xen gxg_gdk_window_ensure_native(Xen window)
{
- #define H_gtk_tree_view_set_grid_lines "void gtk_tree_view_set_grid_lines(GtkTreeView* tree_view, GtkTreeViewGridLines grid_lines)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_grid_lines", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewGridLines_P(grid_lines), grid_lines, 2, "gtk_tree_view_set_grid_lines", "GtkTreeViewGridLines");
- gtk_tree_view_set_grid_lines(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreeViewGridLines(grid_lines));
- return(XEN_FALSE);
+ #define H_gdk_window_ensure_native "gboolean gdk_window_ensure_native(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_ensure_native", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_ensure_native(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_get_enable_tree_lines(XEN tree_view)
+static Xen gxg_gdk_window_get_root_coords(Xen window, Xen x, Xen y, Xen ignore_root_x, Xen ignore_root_y)
{
- #define H_gtk_tree_view_get_enable_tree_lines "gboolean gtk_tree_view_get_enable_tree_lines(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_enable_tree_lines", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_enable_tree_lines(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gdk_window_get_root_coords "void gdk_window_get_root_coords(GdkWindow* window, gint x, gint y, \
+gint* [root_x], gint* [root_y])"
+ gint ref_root_x;
+ gint ref_root_y;
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_root_coords", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gdk_window_get_root_coords", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gdk_window_get_root_coords", "gint");
+ gdk_window_get_root_coords(Xen_to_C_GdkWindow_(window), Xen_to_C_gint(x), Xen_to_C_gint(y), &ref_root_x, &ref_root_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_root_x), C_to_Xen_gint(ref_root_y)));
}
-static XEN gxg_gtk_tree_view_set_enable_tree_lines(XEN tree_view, XEN enabled)
+static Xen gxg_gdk_offscreen_window_set_embedder(Xen window, Xen embedder)
{
- #define H_gtk_tree_view_set_enable_tree_lines "void gtk_tree_view_set_enable_tree_lines(GtkTreeView* tree_view, \
-gboolean enabled)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_enable_tree_lines", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(enabled), enabled, 2, "gtk_tree_view_set_enable_tree_lines", "gboolean");
- gtk_tree_view_set_enable_tree_lines(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(enabled));
- return(XEN_FALSE);
+ #define H_gdk_offscreen_window_set_embedder "void gdk_offscreen_window_set_embedder(GdkWindow* window, \
+GdkWindow* embedder)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_offscreen_window_set_embedder", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindow_(embedder), embedder, 2, "gdk_offscreen_window_set_embedder", "GdkWindow*");
+ gdk_offscreen_window_set_embedder(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWindow_(embedder));
+ return(Xen_false);
}
-static XEN gxg_gtk_label_set_line_wrap_mode(XEN label, XEN wrap_mode)
+static Xen gxg_gdk_offscreen_window_get_embedder(Xen window)
{
- #define H_gtk_label_set_line_wrap_mode "void gtk_label_set_line_wrap_mode(GtkLabel* label, PangoWrapMode wrap_mode)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_line_wrap_mode", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_PangoWrapMode_P(wrap_mode), wrap_mode, 2, "gtk_label_set_line_wrap_mode", "PangoWrapMode");
- gtk_label_set_line_wrap_mode(XEN_TO_C_GtkLabel_(label), XEN_TO_C_PangoWrapMode(wrap_mode));
- return(XEN_FALSE);
+ #define H_gdk_offscreen_window_get_embedder "GdkWindow* gdk_offscreen_window_get_embedder(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_offscreen_window_get_embedder", "GdkWindow*");
+ return(C_to_Xen_GdkWindow_(gdk_offscreen_window_get_embedder(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_label_get_line_wrap_mode(XEN label)
+static Xen gxg_gdk_window_geometry_changed(Xen window)
{
- #define H_gtk_label_get_line_wrap_mode "PangoWrapMode gtk_label_get_line_wrap_mode(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_line_wrap_mode", "GtkLabel*");
- return(C_TO_XEN_PangoWrapMode(gtk_label_get_line_wrap_mode(XEN_TO_C_GtkLabel_(label))));
+ #define H_gdk_window_geometry_changed "void gdk_window_geometry_changed(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_geometry_changed", "GdkWindow*");
+ gdk_window_geometry_changed(Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_context_get_cairo_context(XEN context)
+static Xen gxg_gtk_menu_set_reserve_toggle_size(Xen menu, Xen reserve_toggle_size)
{
- #define H_gtk_print_context_get_cairo_context "cairo_t* gtk_print_context_get_cairo_context(GtkPrintContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_get_cairo_context", "GtkPrintContext*");
- return(C_TO_XEN_cairo_t_(gtk_print_context_get_cairo_context(XEN_TO_C_GtkPrintContext_(context))));
+ #define H_gtk_menu_set_reserve_toggle_size "void gtk_menu_set_reserve_toggle_size(GtkMenu* menu, gboolean reserve_toggle_size)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_set_reserve_toggle_size", "GtkMenu*");
+ Xen_check_type(Xen_is_gboolean(reserve_toggle_size), reserve_toggle_size, 2, "gtk_menu_set_reserve_toggle_size", "gboolean");
+ gtk_menu_set_reserve_toggle_size(Xen_to_C_GtkMenu_(menu), Xen_to_C_gboolean(reserve_toggle_size));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_context_get_page_setup(XEN context)
+static Xen gxg_gtk_menu_get_reserve_toggle_size(Xen menu)
{
- #define H_gtk_print_context_get_page_setup "GtkPageSetup* gtk_print_context_get_page_setup(GtkPrintContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_get_page_setup", "GtkPrintContext*");
- return(C_TO_XEN_GtkPageSetup_(gtk_print_context_get_page_setup(XEN_TO_C_GtkPrintContext_(context))));
+ #define H_gtk_menu_get_reserve_toggle_size "gboolean gtk_menu_get_reserve_toggle_size(GtkMenu* menu)"
+ Xen_check_type(Xen_is_GtkMenu_(menu), menu, 1, "gtk_menu_get_reserve_toggle_size", "GtkMenu*");
+ return(C_to_Xen_gboolean(gtk_menu_get_reserve_toggle_size(Xen_to_C_GtkMenu_(menu))));
}
-static XEN gxg_gtk_print_context_get_width(XEN context)
+static Xen gxg_gtk_entry_new_with_buffer(Xen buffer)
{
- #define H_gtk_print_context_get_width "gdouble gtk_print_context_get_width(GtkPrintContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_get_width", "GtkPrintContext*");
- return(C_TO_XEN_gdouble(gtk_print_context_get_width(XEN_TO_C_GtkPrintContext_(context))));
+ #define H_gtk_entry_new_with_buffer "GtkWidget* gtk_entry_new_with_buffer(GtkEntryBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_new_with_buffer", "GtkEntryBuffer*");
+ return(C_to_Xen_GtkWidget_(gtk_entry_new_with_buffer(Xen_to_C_GtkEntryBuffer_(buffer))));
}
-static XEN gxg_gtk_print_context_get_height(XEN context)
+static Xen gxg_gtk_entry_get_buffer(Xen entry)
{
- #define H_gtk_print_context_get_height "gdouble gtk_print_context_get_height(GtkPrintContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_get_height", "GtkPrintContext*");
- return(C_TO_XEN_gdouble(gtk_print_context_get_height(XEN_TO_C_GtkPrintContext_(context))));
+ #define H_gtk_entry_get_buffer "GtkEntryBuffer* gtk_entry_get_buffer(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_buffer", "GtkEntry*");
+ return(C_to_Xen_GtkEntryBuffer_(gtk_entry_get_buffer(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_print_context_get_dpi_x(XEN context)
+static Xen gxg_gtk_entry_set_buffer(Xen entry, Xen buffer)
{
- #define H_gtk_print_context_get_dpi_x "gdouble gtk_print_context_get_dpi_x(GtkPrintContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_get_dpi_x", "GtkPrintContext*");
- return(C_TO_XEN_gdouble(gtk_print_context_get_dpi_x(XEN_TO_C_GtkPrintContext_(context))));
+ #define H_gtk_entry_set_buffer "void gtk_entry_set_buffer(GtkEntry* entry, GtkEntryBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_buffer", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 2, "gtk_entry_set_buffer", "GtkEntryBuffer*");
+ gtk_entry_set_buffer(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryBuffer_(buffer));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_context_get_dpi_y(XEN context)
+static Xen gxg_gtk_label_set_track_visited_links(Xen label, Xen track_links)
{
- #define H_gtk_print_context_get_dpi_y "gdouble gtk_print_context_get_dpi_y(GtkPrintContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_get_dpi_y", "GtkPrintContext*");
- return(C_TO_XEN_gdouble(gtk_print_context_get_dpi_y(XEN_TO_C_GtkPrintContext_(context))));
+ #define H_gtk_label_set_track_visited_links "void gtk_label_set_track_visited_links(GtkLabel* label, \
+gboolean track_links)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_track_visited_links", "GtkLabel*");
+ Xen_check_type(Xen_is_gboolean(track_links), track_links, 2, "gtk_label_set_track_visited_links", "gboolean");
+ gtk_label_set_track_visited_links(Xen_to_C_GtkLabel_(label), Xen_to_C_gboolean(track_links));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_context_create_pango_context(XEN context)
+static Xen gxg_gtk_label_get_track_visited_links(Xen label)
{
- #define H_gtk_print_context_create_pango_context "PangoContext* gtk_print_context_create_pango_context(GtkPrintContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_create_pango_context", "GtkPrintContext*");
- return(C_TO_XEN_PangoContext_(gtk_print_context_create_pango_context(XEN_TO_C_GtkPrintContext_(context))));
+ #define H_gtk_label_get_track_visited_links "gboolean gtk_label_get_track_visited_links(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_track_visited_links", "GtkLabel*");
+ return(C_to_Xen_gboolean(gtk_label_get_track_visited_links(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_print_context_create_pango_layout(XEN context)
+static Xen gxg_gtk_print_operation_set_embed_page_setup(Xen op, Xen embed)
{
- #define H_gtk_print_context_create_pango_layout "PangoLayout* gtk_print_context_create_pango_layout(GtkPrintContext* context)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_create_pango_layout", "GtkPrintContext*");
- return(C_TO_XEN_PangoLayout_(gtk_print_context_create_pango_layout(XEN_TO_C_GtkPrintContext_(context))));
+ #define H_gtk_print_operation_set_embed_page_setup "void gtk_print_operation_set_embed_page_setup(GtkPrintOperation* op, \
+gboolean embed)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_set_embed_page_setup", "GtkPrintOperation*");
+ Xen_check_type(Xen_is_gboolean(embed), embed, 2, "gtk_print_operation_set_embed_page_setup", "gboolean");
+ gtk_print_operation_set_embed_page_setup(Xen_to_C_GtkPrintOperation_(op), Xen_to_C_gboolean(embed));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_context_set_cairo_context(XEN context, XEN cr, XEN dpi_x, XEN dpi_y)
+static Xen gxg_gtk_print_operation_get_embed_page_setup(Xen op)
{
- #define H_gtk_print_context_set_cairo_context "void gtk_print_context_set_cairo_context(GtkPrintContext* context, \
-cairo_t* cr, double dpi_x, double dpi_y)"
- XEN_ASSERT_TYPE(XEN_GtkPrintContext__P(context), context, 1, "gtk_print_context_set_cairo_context", "GtkPrintContext*");
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 2, "gtk_print_context_set_cairo_context", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(dpi_x), dpi_x, 3, "gtk_print_context_set_cairo_context", "double");
- XEN_ASSERT_TYPE(XEN_double_P(dpi_y), dpi_y, 4, "gtk_print_context_set_cairo_context", "double");
- gtk_print_context_set_cairo_context(XEN_TO_C_GtkPrintContext_(context), XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(dpi_x),
- XEN_TO_C_double(dpi_y));
- return(XEN_FALSE);
+ #define H_gtk_print_operation_get_embed_page_setup "gboolean gtk_print_operation_get_embed_page_setup(GtkPrintOperation* op)"
+ Xen_check_type(Xen_is_GtkPrintOperation_(op), op, 1, "gtk_print_operation_get_embed_page_setup", "GtkPrintOperation*");
+ return(C_to_Xen_gboolean(gtk_print_operation_get_embed_page_setup(Xen_to_C_GtkPrintOperation_(op))));
}
-static XEN gxg_gtk_print_operation_new(void)
+static Xen gxg_gtk_entry_buffer_new(Xen initial_chars, Xen n_initial_chars)
{
- #define H_gtk_print_operation_new "GtkPrintOperation* gtk_print_operation_new( void)"
- return(C_TO_XEN_GtkPrintOperation_(gtk_print_operation_new()));
+ #define H_gtk_entry_buffer_new "GtkEntryBuffer* gtk_entry_buffer_new(gchar* initial_chars, gint n_initial_chars)"
+ Xen_check_type(Xen_is_gchar_(initial_chars), initial_chars, 1, "gtk_entry_buffer_new", "gchar*");
+ Xen_check_type(Xen_is_gint(n_initial_chars), n_initial_chars, 2, "gtk_entry_buffer_new", "gint");
+ return(C_to_Xen_GtkEntryBuffer_(gtk_entry_buffer_new(Xen_to_C_gchar_(initial_chars), Xen_to_C_gint(n_initial_chars))));
}
-static XEN gxg_gtk_print_operation_set_default_page_setup(XEN op, XEN default_page_setup)
+static Xen gxg_gtk_entry_buffer_get_bytes(Xen buffer)
{
- #define H_gtk_print_operation_set_default_page_setup "void gtk_print_operation_set_default_page_setup(GtkPrintOperation* op, \
-GtkPageSetup* default_page_setup)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_default_page_setup", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_GtkPageSetup__P(default_page_setup), default_page_setup, 2, "gtk_print_operation_set_default_page_setup", "GtkPageSetup*");
- gtk_print_operation_set_default_page_setup(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_GtkPageSetup_(default_page_setup));
- return(XEN_FALSE);
+ #define H_gtk_entry_buffer_get_bytes "gsize gtk_entry_buffer_get_bytes(GtkEntryBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_get_bytes", "GtkEntryBuffer*");
+ return(C_to_Xen_gsize(gtk_entry_buffer_get_bytes(Xen_to_C_GtkEntryBuffer_(buffer))));
}
-static XEN gxg_gtk_print_operation_get_default_page_setup(XEN op)
+static Xen gxg_gtk_entry_buffer_get_length(Xen buffer)
{
- #define H_gtk_print_operation_get_default_page_setup "GtkPageSetup* gtk_print_operation_get_default_page_setup(GtkPrintOperation* op)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_get_default_page_setup", "GtkPrintOperation*");
- return(C_TO_XEN_GtkPageSetup_(gtk_print_operation_get_default_page_setup(XEN_TO_C_GtkPrintOperation_(op))));
+ #define H_gtk_entry_buffer_get_length "guint gtk_entry_buffer_get_length(GtkEntryBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_get_length", "GtkEntryBuffer*");
+ return(C_to_Xen_guint(gtk_entry_buffer_get_length(Xen_to_C_GtkEntryBuffer_(buffer))));
}
-static XEN gxg_gtk_print_operation_set_print_settings(XEN op, XEN print_settings)
+static Xen gxg_gtk_entry_buffer_get_text(Xen buffer)
{
- #define H_gtk_print_operation_set_print_settings "void gtk_print_operation_set_print_settings(GtkPrintOperation* op, \
-GtkPrintSettings* print_settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_print_settings", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(print_settings), print_settings, 2, "gtk_print_operation_set_print_settings", "GtkPrintSettings*");
- gtk_print_operation_set_print_settings(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_GtkPrintSettings_(print_settings));
- return(XEN_FALSE);
+ #define H_gtk_entry_buffer_get_text "gchar* gtk_entry_buffer_get_text(GtkEntryBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_get_text", "GtkEntryBuffer*");
+ return(C_to_Xen_gchar_(gtk_entry_buffer_get_text(Xen_to_C_GtkEntryBuffer_(buffer))));
}
-static XEN gxg_gtk_print_operation_get_print_settings(XEN op)
+static Xen gxg_gtk_entry_buffer_set_text(Xen buffer, Xen chars, Xen n_chars)
{
- #define H_gtk_print_operation_get_print_settings "GtkPrintSettings* gtk_print_operation_get_print_settings(GtkPrintOperation* op)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_get_print_settings", "GtkPrintOperation*");
- return(C_TO_XEN_GtkPrintSettings_(gtk_print_operation_get_print_settings(XEN_TO_C_GtkPrintOperation_(op))));
+ #define H_gtk_entry_buffer_set_text "void gtk_entry_buffer_set_text(GtkEntryBuffer* buffer, gchar* chars, \
+gint n_chars)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_set_text", "GtkEntryBuffer*");
+ Xen_check_type(Xen_is_gchar_(chars), chars, 2, "gtk_entry_buffer_set_text", "gchar*");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 3, "gtk_entry_buffer_set_text", "gint");
+ gtk_entry_buffer_set_text(Xen_to_C_GtkEntryBuffer_(buffer), Xen_to_C_gchar_(chars), Xen_to_C_gint(n_chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_set_job_name(XEN op, XEN job_name)
+static Xen gxg_gtk_entry_buffer_set_max_length(Xen buffer, Xen max_length)
{
- #define H_gtk_print_operation_set_job_name "void gtk_print_operation_set_job_name(GtkPrintOperation* op, \
-gchar* job_name)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_job_name", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gchar__P(job_name), job_name, 2, "gtk_print_operation_set_job_name", "gchar*");
- gtk_print_operation_set_job_name(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gchar_(job_name));
- return(XEN_FALSE);
+ #define H_gtk_entry_buffer_set_max_length "void gtk_entry_buffer_set_max_length(GtkEntryBuffer* buffer, \
+guint max_length)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_set_max_length", "GtkEntryBuffer*");
+ Xen_check_type(Xen_is_guint(max_length), max_length, 2, "gtk_entry_buffer_set_max_length", "guint");
+ gtk_entry_buffer_set_max_length(Xen_to_C_GtkEntryBuffer_(buffer), Xen_to_C_guint(max_length));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_set_n_pages(XEN op, XEN n_pages)
+static Xen gxg_gtk_entry_buffer_get_max_length(Xen buffer)
{
- #define H_gtk_print_operation_set_n_pages "void gtk_print_operation_set_n_pages(GtkPrintOperation* op, \
-gint n_pages)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_n_pages", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_pages), n_pages, 2, "gtk_print_operation_set_n_pages", "gint");
- gtk_print_operation_set_n_pages(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gint(n_pages));
- return(XEN_FALSE);
+ #define H_gtk_entry_buffer_get_max_length "guint gtk_entry_buffer_get_max_length(GtkEntryBuffer* buffer)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_get_max_length", "GtkEntryBuffer*");
+ return(C_to_Xen_guint(gtk_entry_buffer_get_max_length(Xen_to_C_GtkEntryBuffer_(buffer))));
}
-static XEN gxg_gtk_print_operation_set_current_page(XEN op, XEN current_page)
+static Xen gxg_gtk_entry_buffer_insert_text(Xen buffer, Xen position, Xen chars, Xen n_chars)
{
- #define H_gtk_print_operation_set_current_page "void gtk_print_operation_set_current_page(GtkPrintOperation* op, \
-gint current_page)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_current_page", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gint_P(current_page), current_page, 2, "gtk_print_operation_set_current_page", "gint");
- gtk_print_operation_set_current_page(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gint(current_page));
- return(XEN_FALSE);
+ #define H_gtk_entry_buffer_insert_text "guint gtk_entry_buffer_insert_text(GtkEntryBuffer* buffer, \
+guint position, gchar* chars, gint n_chars)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_insert_text", "GtkEntryBuffer*");
+ Xen_check_type(Xen_is_guint(position), position, 2, "gtk_entry_buffer_insert_text", "guint");
+ Xen_check_type(Xen_is_gchar_(chars), chars, 3, "gtk_entry_buffer_insert_text", "gchar*");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 4, "gtk_entry_buffer_insert_text", "gint");
+ return(C_to_Xen_guint(gtk_entry_buffer_insert_text(Xen_to_C_GtkEntryBuffer_(buffer), Xen_to_C_guint(position), Xen_to_C_gchar_(chars),
+ Xen_to_C_gint(n_chars))));
}
-static XEN gxg_gtk_print_operation_set_use_full_page(XEN op, XEN full_page)
+static Xen gxg_gtk_entry_buffer_delete_text(Xen buffer, Xen position, Xen n_chars)
{
- #define H_gtk_print_operation_set_use_full_page "void gtk_print_operation_set_use_full_page(GtkPrintOperation* op, \
-gboolean full_page)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_use_full_page", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(full_page), full_page, 2, "gtk_print_operation_set_use_full_page", "gboolean");
- gtk_print_operation_set_use_full_page(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gboolean(full_page));
- return(XEN_FALSE);
+ #define H_gtk_entry_buffer_delete_text "guint gtk_entry_buffer_delete_text(GtkEntryBuffer* buffer, \
+guint position, gint n_chars)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_delete_text", "GtkEntryBuffer*");
+ Xen_check_type(Xen_is_guint(position), position, 2, "gtk_entry_buffer_delete_text", "guint");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 3, "gtk_entry_buffer_delete_text", "gint");
+ return(C_to_Xen_guint(gtk_entry_buffer_delete_text(Xen_to_C_GtkEntryBuffer_(buffer), Xen_to_C_guint(position), Xen_to_C_gint(n_chars))));
}
-static XEN gxg_gtk_print_operation_set_unit(XEN op, XEN unit)
+static Xen gxg_gtk_entry_buffer_emit_inserted_text(Xen buffer, Xen position, Xen chars, Xen n_chars)
{
- #define H_gtk_print_operation_set_unit "void gtk_print_operation_set_unit(GtkPrintOperation* op, GtkUnit unit)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_unit", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_GtkUnit_P(unit), unit, 2, "gtk_print_operation_set_unit", "GtkUnit");
- gtk_print_operation_set_unit(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_GtkUnit(unit));
- return(XEN_FALSE);
+ #define H_gtk_entry_buffer_emit_inserted_text "void gtk_entry_buffer_emit_inserted_text(GtkEntryBuffer* buffer, \
+guint position, gchar* chars, guint n_chars)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_emit_inserted_text", "GtkEntryBuffer*");
+ Xen_check_type(Xen_is_guint(position), position, 2, "gtk_entry_buffer_emit_inserted_text", "guint");
+ Xen_check_type(Xen_is_gchar_(chars), chars, 3, "gtk_entry_buffer_emit_inserted_text", "gchar*");
+ Xen_check_type(Xen_is_guint(n_chars), n_chars, 4, "gtk_entry_buffer_emit_inserted_text", "guint");
+ gtk_entry_buffer_emit_inserted_text(Xen_to_C_GtkEntryBuffer_(buffer), Xen_to_C_guint(position), Xen_to_C_gchar_(chars),
+ Xen_to_C_guint(n_chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_set_export_filename(XEN op, XEN filename)
+static Xen gxg_gtk_entry_buffer_emit_deleted_text(Xen buffer, Xen position, Xen n_chars)
{
- #define H_gtk_print_operation_set_export_filename "void gtk_print_operation_set_export_filename(GtkPrintOperation* op, \
-gchar* filename)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_export_filename", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 2, "gtk_print_operation_set_export_filename", "gchar*");
- gtk_print_operation_set_export_filename(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gchar_(filename));
- return(XEN_FALSE);
+ #define H_gtk_entry_buffer_emit_deleted_text "void gtk_entry_buffer_emit_deleted_text(GtkEntryBuffer* buffer, \
+guint position, guint n_chars)"
+ Xen_check_type(Xen_is_GtkEntryBuffer_(buffer), buffer, 1, "gtk_entry_buffer_emit_deleted_text", "GtkEntryBuffer*");
+ Xen_check_type(Xen_is_guint(position), position, 2, "gtk_entry_buffer_emit_deleted_text", "guint");
+ Xen_check_type(Xen_is_guint(n_chars), n_chars, 3, "gtk_entry_buffer_emit_deleted_text", "guint");
+ gtk_entry_buffer_emit_deleted_text(Xen_to_C_GtkEntryBuffer_(buffer), Xen_to_C_guint(position), Xen_to_C_guint(n_chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_set_track_print_status(XEN op, XEN track_status)
+static Xen gxg_gtk_cell_renderer_set_alignment(Xen cell, Xen xalign, Xen yalign)
{
- #define H_gtk_print_operation_set_track_print_status "void gtk_print_operation_set_track_print_status(GtkPrintOperation* op, \
-gboolean track_status)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_track_print_status", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(track_status), track_status, 2, "gtk_print_operation_set_track_print_status", "gboolean");
- gtk_print_operation_set_track_print_status(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gboolean(track_status));
- return(XEN_FALSE);
+ #define H_gtk_cell_renderer_set_alignment "void gtk_cell_renderer_set_alignment(GtkCellRenderer* cell, \
+gfloat xalign, gfloat yalign)"
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_set_alignment", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gfloat(xalign), xalign, 2, "gtk_cell_renderer_set_alignment", "gfloat");
+ Xen_check_type(Xen_is_gfloat(yalign), yalign, 3, "gtk_cell_renderer_set_alignment", "gfloat");
+ gtk_cell_renderer_set_alignment(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gfloat(xalign), Xen_to_C_gfloat(yalign));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_set_show_progress(XEN op, XEN show_progress)
+static Xen gxg_gtk_cell_renderer_get_alignment(Xen cell, Xen ignore_xalign, Xen ignore_yalign)
{
- #define H_gtk_print_operation_set_show_progress "void gtk_print_operation_set_show_progress(GtkPrintOperation* op, \
-gboolean show_progress)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_show_progress", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_progress), show_progress, 2, "gtk_print_operation_set_show_progress", "gboolean");
- gtk_print_operation_set_show_progress(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gboolean(show_progress));
- return(XEN_FALSE);
+ #define H_gtk_cell_renderer_get_alignment "void gtk_cell_renderer_get_alignment(GtkCellRenderer* cell, \
+gfloat* [xalign], gfloat* [yalign])"
+ gfloat ref_xalign;
+ gfloat ref_yalign;
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_alignment", "GtkCellRenderer*");
+ gtk_cell_renderer_get_alignment(Xen_to_C_GtkCellRenderer_(cell), &ref_xalign, &ref_yalign);
+ return(Xen_list_2(C_to_Xen_gfloat(ref_xalign), C_to_Xen_gfloat(ref_yalign)));
}
-static XEN gxg_gtk_print_operation_set_allow_async(XEN op, XEN allow_async)
+static Xen gxg_gtk_cell_renderer_set_padding(Xen cell, Xen xpad, Xen ypad)
{
- #define H_gtk_print_operation_set_allow_async "void gtk_print_operation_set_allow_async(GtkPrintOperation* op, \
-gboolean allow_async)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_allow_async", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(allow_async), allow_async, 2, "gtk_print_operation_set_allow_async", "gboolean");
- gtk_print_operation_set_allow_async(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gboolean(allow_async));
- return(XEN_FALSE);
+ #define H_gtk_cell_renderer_set_padding "void gtk_cell_renderer_set_padding(GtkCellRenderer* cell, \
+gint xpad, gint ypad)"
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_set_padding", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gint(xpad), xpad, 2, "gtk_cell_renderer_set_padding", "gint");
+ Xen_check_type(Xen_is_gint(ypad), ypad, 3, "gtk_cell_renderer_set_padding", "gint");
+ gtk_cell_renderer_set_padding(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gint(xpad), Xen_to_C_gint(ypad));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_set_custom_tab_label(XEN op, XEN label)
+static Xen gxg_gtk_cell_renderer_get_padding(Xen cell, Xen ignore_xpad, Xen ignore_ypad)
{
- #define H_gtk_print_operation_set_custom_tab_label "void gtk_print_operation_set_custom_tab_label(GtkPrintOperation* op, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_custom_tab_label", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_print_operation_set_custom_tab_label", "gchar*");
- gtk_print_operation_set_custom_tab_label(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gchar_(label));
- return(XEN_FALSE);
+ #define H_gtk_cell_renderer_get_padding "void gtk_cell_renderer_get_padding(GtkCellRenderer* cell, \
+gint* [xpad], gint* [ypad])"
+ gint ref_xpad;
+ gint ref_ypad;
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_padding", "GtkCellRenderer*");
+ gtk_cell_renderer_get_padding(Xen_to_C_GtkCellRenderer_(cell), &ref_xpad, &ref_ypad);
+ return(Xen_list_2(C_to_Xen_gint(ref_xpad), C_to_Xen_gint(ref_ypad)));
}
-static XEN gxg_gtk_print_operation_run(XEN op, XEN action, XEN parent, XEN ignore_error)
+static Xen gxg_gtk_cell_renderer_set_visible(Xen cell, Xen visible)
{
- #define H_gtk_print_operation_run "GtkPrintOperationResult gtk_print_operation_run(GtkPrintOperation* op, \
-GtkPrintOperationAction action, GtkWindow* parent, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_run", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_GtkPrintOperationAction_P(action), action, 2, "gtk_print_operation_run", "GtkPrintOperationAction");
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(parent), parent, 3, "gtk_print_operation_run", "GtkWindow*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GtkPrintOperationResult(gtk_print_operation_run(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_GtkPrintOperationAction(action),
- XEN_TO_C_GtkWindow_(parent), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_cell_renderer_set_visible "void gtk_cell_renderer_set_visible(GtkCellRenderer* cell, \
+gboolean visible)"
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_set_visible", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(visible), visible, 2, "gtk_cell_renderer_set_visible", "gboolean");
+ gtk_cell_renderer_set_visible(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gboolean(visible));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_get_error(XEN op, XEN ignore_error)
+static Xen gxg_gtk_cell_renderer_get_visible(Xen cell)
{
- #define H_gtk_print_operation_get_error "void gtk_print_operation_get_error(GtkPrintOperation* op, \
-GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_get_error", "GtkPrintOperation*");
- gtk_print_operation_get_error(XEN_TO_C_GtkPrintOperation_(op), &ref_error);
- return(XEN_LIST_1(C_TO_XEN_GError_(ref_error)));
+ #define H_gtk_cell_renderer_get_visible "gboolean gtk_cell_renderer_get_visible(GtkCellRenderer* cell)"
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_visible", "GtkCellRenderer*");
+ return(C_to_Xen_gboolean(gtk_cell_renderer_get_visible(Xen_to_C_GtkCellRenderer_(cell))));
}
-static XEN gxg_gtk_print_operation_get_status(XEN op)
+static Xen gxg_gtk_cell_renderer_set_sensitive(Xen cell, Xen sensitive)
{
- #define H_gtk_print_operation_get_status "GtkPrintStatus gtk_print_operation_get_status(GtkPrintOperation* op)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_get_status", "GtkPrintOperation*");
- return(C_TO_XEN_GtkPrintStatus(gtk_print_operation_get_status(XEN_TO_C_GtkPrintOperation_(op))));
+ #define H_gtk_cell_renderer_set_sensitive "void gtk_cell_renderer_set_sensitive(GtkCellRenderer* cell, \
+gboolean sensitive)"
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_set_sensitive", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(sensitive), sensitive, 2, "gtk_cell_renderer_set_sensitive", "gboolean");
+ gtk_cell_renderer_set_sensitive(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_gboolean(sensitive));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_get_status_string(XEN op)
+static Xen gxg_gtk_cell_renderer_get_sensitive(Xen cell)
{
- #define H_gtk_print_operation_get_status_string "gchar* gtk_print_operation_get_status_string(GtkPrintOperation* op)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_get_status_string", "GtkPrintOperation*");
- return(C_TO_XEN_gchar_(gtk_print_operation_get_status_string(XEN_TO_C_GtkPrintOperation_(op))));
+ #define H_gtk_cell_renderer_get_sensitive "gboolean gtk_cell_renderer_get_sensitive(GtkCellRenderer* cell)"
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_sensitive", "GtkCellRenderer*");
+ return(C_to_Xen_gboolean(gtk_cell_renderer_get_sensitive(Xen_to_C_GtkCellRenderer_(cell))));
}
-static XEN gxg_gtk_print_operation_is_finished(XEN op)
+static Xen gxg_gtk_cell_renderer_toggle_get_activatable(Xen toggle)
{
- #define H_gtk_print_operation_is_finished "gboolean gtk_print_operation_is_finished(GtkPrintOperation* op)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_is_finished", "GtkPrintOperation*");
- return(C_TO_XEN_gboolean(gtk_print_operation_is_finished(XEN_TO_C_GtkPrintOperation_(op))));
+ #define H_gtk_cell_renderer_toggle_get_activatable "gboolean gtk_cell_renderer_toggle_get_activatable(GtkCellRendererToggle* toggle)"
+ Xen_check_type(Xen_is_GtkCellRendererToggle_(toggle), toggle, 1, "gtk_cell_renderer_toggle_get_activatable", "GtkCellRendererToggle*");
+ return(C_to_Xen_gboolean(gtk_cell_renderer_toggle_get_activatable(Xen_to_C_GtkCellRendererToggle_(toggle))));
}
-static XEN gxg_gtk_print_operation_cancel(XEN op)
+static Xen gxg_gtk_cell_renderer_toggle_set_activatable(Xen toggle, Xen setting)
{
- #define H_gtk_print_operation_cancel "void gtk_print_operation_cancel(GtkPrintOperation* op)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_cancel", "GtkPrintOperation*");
- gtk_print_operation_cancel(XEN_TO_C_GtkPrintOperation_(op));
- return(XEN_FALSE);
+ #define H_gtk_cell_renderer_toggle_set_activatable "void gtk_cell_renderer_toggle_set_activatable(GtkCellRendererToggle* toggle, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkCellRendererToggle_(toggle), toggle, 1, "gtk_cell_renderer_toggle_set_activatable", "GtkCellRendererToggle*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_cell_renderer_toggle_set_activatable", "gboolean");
+ gtk_cell_renderer_toggle_set_activatable(Xen_to_C_GtkCellRendererToggle_(toggle), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_run_page_setup_dialog(XEN parent, XEN page_setup, XEN settings)
+static Xen gxg_gtk_widget_set_can_focus(Xen widget, Xen can_focus)
{
- #define H_gtk_print_run_page_setup_dialog "GtkPageSetup* gtk_print_run_page_setup_dialog(GtkWindow* parent, \
-GtkPageSetup* page_setup, GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(parent), parent, 1, "gtk_print_run_page_setup_dialog", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkPageSetup__P(page_setup), page_setup, 2, "gtk_print_run_page_setup_dialog", "GtkPageSetup*");
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 3, "gtk_print_run_page_setup_dialog", "GtkPrintSettings*");
- return(C_TO_XEN_GtkPageSetup_(gtk_print_run_page_setup_dialog(XEN_TO_C_GtkWindow_(parent), XEN_TO_C_GtkPageSetup_(page_setup),
- XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_widget_set_can_focus "void gtk_widget_set_can_focus(GtkWidget* widget, gboolean can_focus)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_can_focus", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(can_focus), can_focus, 2, "gtk_widget_set_can_focus", "gboolean");
+ gtk_widget_set_can_focus(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(can_focus));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_run_page_setup_dialog_async(XEN parent, XEN page_setup, XEN settings, XEN done_cb, XEN data)
+static Xen gxg_gtk_widget_get_can_focus(Xen widget)
{
- #define H_gtk_print_run_page_setup_dialog_async "void gtk_print_run_page_setup_dialog_async(GtkWindow* parent, \
-GtkPageSetup* page_setup, GtkPrintSettings* settings, GtkPageSetupDoneFunc done_cb, gpointer data)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(parent), parent, 1, "gtk_print_run_page_setup_dialog_async", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkPageSetup__P(page_setup), page_setup, 2, "gtk_print_run_page_setup_dialog_async", "GtkPageSetup*");
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 3, "gtk_print_run_page_setup_dialog_async", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPageSetupDoneFunc_P(done_cb), done_cb, 4, "gtk_print_run_page_setup_dialog_async", "GtkPageSetupDoneFunc");
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 5, "gtk_print_run_page_setup_dialog_async", "gpointer");
- gtk_print_run_page_setup_dialog_async(XEN_TO_C_GtkWindow_(parent), XEN_TO_C_GtkPageSetup_(page_setup), XEN_TO_C_GtkPrintSettings_(settings),
- XEN_TO_C_GtkPageSetupDoneFunc(done_cb), XEN_TO_C_gpointer(data));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_can_focus "gboolean gtk_widget_get_can_focus(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_can_focus", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_can_focus(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_operation_preview_render_page(XEN preview, XEN page_nr)
+static Xen gxg_gtk_widget_has_focus(Xen widget)
{
- #define H_gtk_print_operation_preview_render_page "void gtk_print_operation_preview_render_page(GtkPrintOperationPreview* preview, \
-gint page_nr)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperationPreview__P(preview), preview, 1, "gtk_print_operation_preview_render_page", "GtkPrintOperationPreview*");
- XEN_ASSERT_TYPE(XEN_gint_P(page_nr), page_nr, 2, "gtk_print_operation_preview_render_page", "gint");
- gtk_print_operation_preview_render_page(XEN_TO_C_GtkPrintOperationPreview_(preview), XEN_TO_C_gint(page_nr));
- return(XEN_FALSE);
+ #define H_gtk_widget_has_focus "gboolean gtk_widget_has_focus(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_has_focus", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_has_focus(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_operation_preview_end_preview(XEN preview)
+static Xen gxg_gtk_widget_set_can_default(Xen widget, Xen can_default)
{
- #define H_gtk_print_operation_preview_end_preview "void gtk_print_operation_preview_end_preview(GtkPrintOperationPreview* preview)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperationPreview__P(preview), preview, 1, "gtk_print_operation_preview_end_preview", "GtkPrintOperationPreview*");
- gtk_print_operation_preview_end_preview(XEN_TO_C_GtkPrintOperationPreview_(preview));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_can_default "void gtk_widget_set_can_default(GtkWidget* widget, gboolean can_default)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_can_default", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(can_default), can_default, 2, "gtk_widget_set_can_default", "gboolean");
+ gtk_widget_set_can_default(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(can_default));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_preview_is_selected(XEN preview, XEN page_nr)
+static Xen gxg_gtk_widget_get_can_default(Xen widget)
{
- #define H_gtk_print_operation_preview_is_selected "gboolean gtk_print_operation_preview_is_selected(GtkPrintOperationPreview* preview, \
-gint page_nr)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperationPreview__P(preview), preview, 1, "gtk_print_operation_preview_is_selected", "GtkPrintOperationPreview*");
- XEN_ASSERT_TYPE(XEN_gint_P(page_nr), page_nr, 2, "gtk_print_operation_preview_is_selected", "gint");
- return(C_TO_XEN_gboolean(gtk_print_operation_preview_is_selected(XEN_TO_C_GtkPrintOperationPreview_(preview), XEN_TO_C_gint(page_nr))));
+ #define H_gtk_widget_get_can_default "gboolean gtk_widget_get_can_default(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_can_default", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_can_default(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_new(void)
+static Xen gxg_gtk_widget_has_default(Xen widget)
{
- #define H_gtk_print_settings_new "GtkPrintSettings* gtk_print_settings_new( void)"
- return(C_TO_XEN_GtkPrintSettings_(gtk_print_settings_new()));
+ #define H_gtk_widget_has_default "gboolean gtk_widget_has_default(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_has_default", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_has_default(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_copy(XEN other)
+static Xen gxg_gtk_widget_get_sensitive(Xen widget)
{
- #define H_gtk_print_settings_copy "GtkPrintSettings* gtk_print_settings_copy(GtkPrintSettings* other)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(other), other, 1, "gtk_print_settings_copy", "GtkPrintSettings*");
- return(C_TO_XEN_GtkPrintSettings_(gtk_print_settings_copy(XEN_TO_C_GtkPrintSettings_(other))));
+ #define H_gtk_widget_get_sensitive "gboolean gtk_widget_get_sensitive(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_sensitive", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_sensitive(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_has_key(XEN settings, XEN key)
+static Xen gxg_gtk_widget_is_sensitive(Xen widget)
{
- #define H_gtk_print_settings_has_key "gboolean gtk_print_settings_has_key(GtkPrintSettings* settings, \
-gchar* key)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_has_key", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_has_key", "gchar*");
- return(C_TO_XEN_gboolean(gtk_print_settings_has_key(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key))));
+ #define H_gtk_widget_is_sensitive "gboolean gtk_widget_is_sensitive(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_is_sensitive", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_is_sensitive(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_get(XEN settings, XEN key)
+static Xen gxg_gtk_widget_set_has_window(Xen widget, Xen has_window)
{
- #define H_gtk_print_settings_get "gchar* gtk_print_settings_get(GtkPrintSettings* settings, gchar* key)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_get", "gchar*");
- return(C_TO_XEN_gchar_(gtk_print_settings_get(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key))));
+ #define H_gtk_widget_set_has_window "void gtk_widget_set_has_window(GtkWidget* widget, gboolean has_window)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_has_window", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(has_window), has_window, 2, "gtk_widget_set_has_window", "gboolean");
+ gtk_widget_set_has_window(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(has_window));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set(XEN settings, XEN key, XEN value)
+static Xen gxg_gtk_widget_get_has_window(Xen widget)
{
- #define H_gtk_print_settings_set "void gtk_print_settings_set(GtkPrintSettings* settings, gchar* key, \
-gchar* value)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_set", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(value), value, 3, "gtk_print_settings_set", "gchar*");
- gtk_print_settings_set(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key), XEN_TO_C_gchar_(value));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_has_window "gboolean gtk_widget_get_has_window(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_has_window", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_has_window(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_unset(XEN settings, XEN key)
+static Xen gxg_gtk_widget_get_app_paintable(Xen widget)
{
- #define H_gtk_print_settings_unset "void gtk_print_settings_unset(GtkPrintSettings* settings, gchar* key)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_unset", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_unset", "gchar*");
- gtk_print_settings_unset(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_app_paintable "gboolean gtk_widget_get_app_paintable(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_app_paintable", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_app_paintable(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_foreach(XEN settings, XEN func, XEN user_data)
+static Xen gxg_gdk_window_get_cursor(Xen window)
{
- #define H_gtk_print_settings_foreach "void gtk_print_settings_foreach(GtkPrintSettings* settings, GtkPrintSettingsFunc func, \
-gpointer user_data)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_foreach", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPrintSettingsFunc_P(func), func, 2, "gtk_print_settings_foreach", "GtkPrintSettingsFunc");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 3, "gtk_print_settings_foreach", "gpointer");
- gtk_print_settings_foreach(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkPrintSettingsFunc(func), XEN_TO_C_gpointer(user_data));
- return(XEN_FALSE);
+ #define H_gdk_window_get_cursor "GdkCursor* gdk_window_get_cursor(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_cursor", "GdkWindow*");
+ return(C_to_Xen_GdkCursor_(gdk_window_get_cursor(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_print_settings_get_bool(XEN settings, XEN key)
+static Xen gxg_gtk_file_chooser_set_create_folders(Xen chooser, Xen create_folders)
{
- #define H_gtk_print_settings_get_bool "gboolean gtk_print_settings_get_bool(GtkPrintSettings* settings, \
-gchar* key)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_bool", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_get_bool", "gchar*");
- return(C_TO_XEN_gboolean(gtk_print_settings_get_bool(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key))));
+ #define H_gtk_file_chooser_set_create_folders "void gtk_file_chooser_set_create_folders(GtkFileChooser* chooser, \
+gboolean create_folders)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_set_create_folders", "GtkFileChooser*");
+ Xen_check_type(Xen_is_gboolean(create_folders), create_folders, 2, "gtk_file_chooser_set_create_folders", "gboolean");
+ gtk_file_chooser_set_create_folders(Xen_to_C_GtkFileChooser_(chooser), Xen_to_C_gboolean(create_folders));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_bool(XEN settings, XEN key, XEN value)
+static Xen gxg_gtk_file_chooser_get_create_folders(Xen chooser)
{
- #define H_gtk_print_settings_set_bool "void gtk_print_settings_set_bool(GtkPrintSettings* settings, \
-gchar* key, gboolean value)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_bool", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_set_bool", "gchar*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(value), value, 3, "gtk_print_settings_set_bool", "gboolean");
- gtk_print_settings_set_bool(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key), XEN_TO_C_gboolean(value));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_get_create_folders "gboolean gtk_file_chooser_get_create_folders(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_create_folders", "GtkFileChooser*");
+ return(C_to_Xen_gboolean(gtk_file_chooser_get_create_folders(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_print_settings_get_double(XEN settings, XEN key)
+static Xen gxg_gtk_icon_view_set_item_padding(Xen icon_view, Xen item_padding)
{
- #define H_gtk_print_settings_get_double "gdouble gtk_print_settings_get_double(GtkPrintSettings* settings, \
-gchar* key)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_double", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_get_double", "gchar*");
- return(C_TO_XEN_gdouble(gtk_print_settings_get_double(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key))));
+ #define H_gtk_icon_view_set_item_padding "void gtk_icon_view_set_item_padding(GtkIconView* icon_view, \
+gint item_padding)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_item_padding", "GtkIconView*");
+ Xen_check_type(Xen_is_gint(item_padding), item_padding, 2, "gtk_icon_view_set_item_padding", "gint");
+ gtk_icon_view_set_item_padding(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(item_padding));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_double_with_default(XEN settings, XEN key, XEN def)
+static Xen gxg_gtk_icon_view_get_item_padding(Xen icon_view)
{
- #define H_gtk_print_settings_get_double_with_default "gdouble gtk_print_settings_get_double_with_default(GtkPrintSettings* settings, \
-gchar* key, gdouble def)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_double_with_default", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_get_double_with_default", "gchar*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(def), def, 3, "gtk_print_settings_get_double_with_default", "gdouble");
- return(C_TO_XEN_gdouble(gtk_print_settings_get_double_with_default(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key),
- XEN_TO_C_gdouble(def))));
+ #define H_gtk_icon_view_get_item_padding "gint gtk_icon_view_get_item_padding(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_item_padding", "GtkIconView*");
+ return(C_to_Xen_gint(gtk_icon_view_get_item_padding(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_print_settings_set_double(XEN settings, XEN key, XEN value)
+static Xen gxg_gtk_widget_has_grab(Xen widget)
{
- #define H_gtk_print_settings_set_double "void gtk_print_settings_set_double(GtkPrintSettings* settings, \
-gchar* key, gdouble value)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_double", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_set_double", "gchar*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 3, "gtk_print_settings_set_double", "gdouble");
- gtk_print_settings_set_double(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key), XEN_TO_C_gdouble(value));
- return(XEN_FALSE);
+ #define H_gtk_widget_has_grab "gboolean gtk_widget_has_grab(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_has_grab", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_has_grab(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_get_length(XEN settings, XEN key, XEN unit)
+static Xen gxg_gtk_widget_set_visible(Xen widget, Xen visible)
{
- #define H_gtk_print_settings_get_length "gdouble gtk_print_settings_get_length(GtkPrintSettings* settings, \
-gchar* key, GtkUnit unit)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_length", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_get_length", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkUnit_P(unit), unit, 3, "gtk_print_settings_get_length", "GtkUnit");
- return(C_TO_XEN_gdouble(gtk_print_settings_get_length(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key), XEN_TO_C_GtkUnit(unit))));
+ #define H_gtk_widget_set_visible "void gtk_widget_set_visible(GtkWidget* widget, gboolean visible)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_visible", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(visible), visible, 2, "gtk_widget_set_visible", "gboolean");
+ gtk_widget_set_visible(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(visible));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_length(XEN settings, XEN key, XEN value, XEN unit)
+static Xen gxg_gtk_widget_get_visible(Xen widget)
{
- #define H_gtk_print_settings_set_length "void gtk_print_settings_set_length(GtkPrintSettings* settings, \
-gchar* key, gdouble value, GtkUnit unit)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_length", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_set_length", "gchar*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 3, "gtk_print_settings_set_length", "gdouble");
- XEN_ASSERT_TYPE(XEN_GtkUnit_P(unit), unit, 4, "gtk_print_settings_set_length", "GtkUnit");
- gtk_print_settings_set_length(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key), XEN_TO_C_gdouble(value), XEN_TO_C_GtkUnit(unit));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_visible "gboolean gtk_widget_get_visible(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_visible", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_visible(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_get_int(XEN settings, XEN key)
+static Xen gxg_gtk_range_set_flippable(Xen range, Xen flippable)
{
- #define H_gtk_print_settings_get_int "gint gtk_print_settings_get_int(GtkPrintSettings* settings, gchar* key)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_int", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_get_int", "gchar*");
- return(C_TO_XEN_gint(gtk_print_settings_get_int(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key))));
+ #define H_gtk_range_set_flippable "void gtk_range_set_flippable(GtkRange* range, gboolean flippable)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_flippable", "GtkRange*");
+ Xen_check_type(Xen_is_gboolean(flippable), flippable, 2, "gtk_range_set_flippable", "gboolean");
+ gtk_range_set_flippable(Xen_to_C_GtkRange_(range), Xen_to_C_gboolean(flippable));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_int_with_default(XEN settings, XEN key, XEN def)
+static Xen gxg_gtk_range_get_flippable(Xen range)
{
- #define H_gtk_print_settings_get_int_with_default "gint gtk_print_settings_get_int_with_default(GtkPrintSettings* settings, \
-gchar* key, gint def)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_int_with_default", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_get_int_with_default", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(def), def, 3, "gtk_print_settings_get_int_with_default", "gint");
- return(C_TO_XEN_gint(gtk_print_settings_get_int_with_default(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key),
- XEN_TO_C_gint(def))));
+ #define H_gtk_range_get_flippable "gboolean gtk_range_get_flippable(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_flippable", "GtkRange*");
+ return(C_to_Xen_gboolean(gtk_range_get_flippable(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gtk_print_settings_set_int(XEN settings, XEN key, XEN value)
+static Xen gxg_gtk_widget_is_toplevel(Xen widget)
{
- #define H_gtk_print_settings_set_int "void gtk_print_settings_set_int(GtkPrintSettings* settings, gchar* key, \
-gint value)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_int", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(key), key, 2, "gtk_print_settings_set_int", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(value), value, 3, "gtk_print_settings_set_int", "gint");
- gtk_print_settings_set_int(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(key), XEN_TO_C_gint(value));
- return(XEN_FALSE);
+ #define H_gtk_widget_is_toplevel "gboolean gtk_widget_is_toplevel(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_is_toplevel", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_is_toplevel(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_get_printer(XEN settings)
+static Xen gxg_gtk_widget_is_drawable(Xen widget)
{
- #define H_gtk_print_settings_get_printer "gchar* gtk_print_settings_get_printer(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_printer", "GtkPrintSettings*");
- return(C_TO_XEN_gchar_(gtk_print_settings_get_printer(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_widget_is_drawable "gboolean gtk_widget_is_drawable(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_is_drawable", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_is_drawable(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_set_printer(XEN settings, XEN printer)
+static Xen gxg_gtk_widget_set_window(Xen widget, Xen window)
{
- #define H_gtk_print_settings_set_printer "void gtk_print_settings_set_printer(GtkPrintSettings* settings, \
-gchar* printer)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_printer", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(printer), printer, 2, "gtk_print_settings_set_printer", "gchar*");
- gtk_print_settings_set_printer(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(printer));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_window "void gtk_widget_set_window(GtkWidget* widget, GdkWindow* window)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_window", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 2, "gtk_widget_set_window", "GdkWindow*");
+ gtk_widget_set_window(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_orientation(XEN settings)
+static Xen gxg_gdk_window_is_destroyed(Xen window)
{
- #define H_gtk_print_settings_get_orientation "GtkPageOrientation gtk_print_settings_get_orientation(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_orientation", "GtkPrintSettings*");
- return(C_TO_XEN_GtkPageOrientation(gtk_print_settings_get_orientation(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gdk_window_is_destroyed "gboolean gdk_window_is_destroyed(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_is_destroyed", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_is_destroyed(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_print_settings_set_orientation(XEN settings, XEN orientation)
+static Xen gxg_gdk_window_restack(Xen window, Xen sibling, Xen above)
{
- #define H_gtk_print_settings_set_orientation "void gtk_print_settings_set_orientation(GtkPrintSettings* settings, \
-GtkPageOrientation orientation)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_orientation", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPageOrientation_P(orientation), orientation, 2, "gtk_print_settings_set_orientation", "GtkPageOrientation");
- gtk_print_settings_set_orientation(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkPageOrientation(orientation));
- return(XEN_FALSE);
+ #define H_gdk_window_restack "void gdk_window_restack(GdkWindow* window, GdkWindow* sibling, gboolean above)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_restack", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindow_(sibling), sibling, 2, "gdk_window_restack", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(above), above, 3, "gdk_window_restack", "gboolean");
+ gdk_window_restack(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWindow_(sibling), Xen_to_C_gboolean(above));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_paper_size(XEN settings)
+static Xen gxg_gtk_widget_set_receives_default(Xen widget, Xen receives_default)
{
- #define H_gtk_print_settings_get_paper_size "GtkPaperSize* gtk_print_settings_get_paper_size(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_paper_size", "GtkPrintSettings*");
- return(C_TO_XEN_GtkPaperSize_(gtk_print_settings_get_paper_size(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_widget_set_receives_default "void gtk_widget_set_receives_default(GtkWidget* widget, \
+gboolean receives_default)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_receives_default", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(receives_default), receives_default, 2, "gtk_widget_set_receives_default", "gboolean");
+ gtk_widget_set_receives_default(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(receives_default));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_paper_size(XEN settings, XEN paper_size)
+static Xen gxg_gtk_widget_get_receives_default(Xen widget)
{
- #define H_gtk_print_settings_set_paper_size "void gtk_print_settings_set_paper_size(GtkPrintSettings* settings, \
-GtkPaperSize* paper_size)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_paper_size", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPaperSize__P(paper_size), paper_size, 2, "gtk_print_settings_set_paper_size", "GtkPaperSize*");
- gtk_print_settings_set_paper_size(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkPaperSize_(paper_size));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_receives_default "gboolean gtk_widget_get_receives_default(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_receives_default", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_receives_default(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_print_settings_get_paper_width(XEN settings, XEN unit)
+#endif
+
+#if GTK_CHECK_VERSION(2, 20, 0)
+static Xen gxg_gtk_dialog_get_widget_for_response(Xen dialog, Xen response_id)
{
- #define H_gtk_print_settings_get_paper_width "gdouble gtk_print_settings_get_paper_width(GtkPrintSettings* settings, \
-GtkUnit unit)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_paper_width", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkUnit_P(unit), unit, 2, "gtk_print_settings_get_paper_width", "GtkUnit");
- return(C_TO_XEN_gdouble(gtk_print_settings_get_paper_width(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkUnit(unit))));
+ #define H_gtk_dialog_get_widget_for_response "GtkWidget* gtk_dialog_get_widget_for_response(GtkDialog* dialog, \
+gint response_id)"
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_get_widget_for_response", "GtkDialog*");
+ Xen_check_type(Xen_is_gint(response_id), response_id, 2, "gtk_dialog_get_widget_for_response", "gint");
+ return(C_to_Xen_GtkWidget_(gtk_dialog_get_widget_for_response(Xen_to_C_GtkDialog_(dialog), Xen_to_C_gint(response_id))));
}
-static XEN gxg_gtk_print_settings_set_paper_width(XEN settings, XEN width, XEN unit)
+static Xen gxg_gtk_viewport_get_bin_window(Xen viewport)
{
- #define H_gtk_print_settings_set_paper_width "void gtk_print_settings_set_paper_width(GtkPrintSettings* settings, \
-gdouble width, GtkUnit unit)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_paper_width", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(width), width, 2, "gtk_print_settings_set_paper_width", "gdouble");
- XEN_ASSERT_TYPE(XEN_GtkUnit_P(unit), unit, 3, "gtk_print_settings_set_paper_width", "GtkUnit");
- gtk_print_settings_set_paper_width(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gdouble(width), XEN_TO_C_GtkUnit(unit));
- return(XEN_FALSE);
+ #define H_gtk_viewport_get_bin_window "GdkWindow* gtk_viewport_get_bin_window(GtkViewport* viewport)"
+ Xen_check_type(Xen_is_GtkViewport_(viewport), viewport, 1, "gtk_viewport_get_bin_window", "GtkViewport*");
+ return(C_to_Xen_GdkWindow_(gtk_viewport_get_bin_window(Xen_to_C_GtkViewport_(viewport))));
}
-static XEN gxg_gtk_print_settings_get_paper_height(XEN settings, XEN unit)
+static Xen gxg_gtk_spinner_new(void)
{
- #define H_gtk_print_settings_get_paper_height "gdouble gtk_print_settings_get_paper_height(GtkPrintSettings* settings, \
-GtkUnit unit)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_paper_height", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkUnit_P(unit), unit, 2, "gtk_print_settings_get_paper_height", "GtkUnit");
- return(C_TO_XEN_gdouble(gtk_print_settings_get_paper_height(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkUnit(unit))));
+ #define H_gtk_spinner_new "GtkWidget* gtk_spinner_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_spinner_new()));
}
-static XEN gxg_gtk_print_settings_set_paper_height(XEN settings, XEN height, XEN unit)
+static Xen gxg_gtk_spinner_start(Xen spinner)
{
- #define H_gtk_print_settings_set_paper_height "void gtk_print_settings_set_paper_height(GtkPrintSettings* settings, \
-gdouble height, GtkUnit unit)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_paper_height", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(height), height, 2, "gtk_print_settings_set_paper_height", "gdouble");
- XEN_ASSERT_TYPE(XEN_GtkUnit_P(unit), unit, 3, "gtk_print_settings_set_paper_height", "GtkUnit");
- gtk_print_settings_set_paper_height(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gdouble(height), XEN_TO_C_GtkUnit(unit));
- return(XEN_FALSE);
+ #define H_gtk_spinner_start "void gtk_spinner_start(GtkSpinner* spinner)"
+ Xen_check_type(Xen_is_GtkSpinner_(spinner), spinner, 1, "gtk_spinner_start", "GtkSpinner*");
+ gtk_spinner_start(Xen_to_C_GtkSpinner_(spinner));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_use_color(XEN settings)
+static Xen gxg_gtk_spinner_stop(Xen spinner)
{
- #define H_gtk_print_settings_get_use_color "gboolean gtk_print_settings_get_use_color(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_use_color", "GtkPrintSettings*");
- return(C_TO_XEN_gboolean(gtk_print_settings_get_use_color(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_spinner_stop "void gtk_spinner_stop(GtkSpinner* spinner)"
+ Xen_check_type(Xen_is_GtkSpinner_(spinner), spinner, 1, "gtk_spinner_stop", "GtkSpinner*");
+ gtk_spinner_stop(Xen_to_C_GtkSpinner_(spinner));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_use_color(XEN settings, XEN use_color)
+static Xen gxg_gtk_cell_renderer_spinner_new(void)
{
- #define H_gtk_print_settings_set_use_color "void gtk_print_settings_set_use_color(GtkPrintSettings* settings, \
-gboolean use_color)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_use_color", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_color), use_color, 2, "gtk_print_settings_set_use_color", "gboolean");
- gtk_print_settings_set_use_color(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gboolean(use_color));
- return(XEN_FALSE);
+ #define H_gtk_cell_renderer_spinner_new "GtkCellRenderer* gtk_cell_renderer_spinner_new( void)"
+ return(C_to_Xen_GtkCellRenderer_(gtk_cell_renderer_spinner_new()));
}
-static XEN gxg_gtk_print_settings_get_collate(XEN settings)
+static Xen gxg_gtk_notebook_get_action_widget(Xen notebook, Xen pack_type)
{
- #define H_gtk_print_settings_get_collate "gboolean gtk_print_settings_get_collate(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_collate", "GtkPrintSettings*");
- return(C_TO_XEN_gboolean(gtk_print_settings_get_collate(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_notebook_get_action_widget "GtkWidget* gtk_notebook_get_action_widget(GtkNotebook* notebook, \
+GtkPackType pack_type)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_action_widget", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkPackType(pack_type), pack_type, 2, "gtk_notebook_get_action_widget", "GtkPackType");
+ return(C_to_Xen_GtkWidget_(gtk_notebook_get_action_widget(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkPackType(pack_type))));
}
-static XEN gxg_gtk_print_settings_set_collate(XEN settings, XEN collate)
+static Xen gxg_gtk_notebook_set_action_widget(Xen notebook, Xen widget, Xen pack_type)
{
- #define H_gtk_print_settings_set_collate "void gtk_print_settings_set_collate(GtkPrintSettings* settings, \
-gboolean collate)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_collate", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(collate), collate, 2, "gtk_print_settings_set_collate", "gboolean");
- gtk_print_settings_set_collate(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gboolean(collate));
- return(XEN_FALSE);
+ #define H_gtk_notebook_set_action_widget "void gtk_notebook_set_action_widget(GtkNotebook* notebook, \
+GtkWidget* widget, GtkPackType pack_type)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_action_widget", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_notebook_set_action_widget", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkPackType(pack_type), pack_type, 3, "gtk_notebook_set_action_widget", "GtkPackType");
+ gtk_notebook_set_action_widget(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkPackType(pack_type));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_reverse(XEN settings)
+static Xen gxg_gtk_statusbar_get_message_area(Xen statusbar)
{
- #define H_gtk_print_settings_get_reverse "gboolean gtk_print_settings_get_reverse(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_reverse", "GtkPrintSettings*");
- return(C_TO_XEN_gboolean(gtk_print_settings_get_reverse(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_statusbar_get_message_area "GtkWidget* gtk_statusbar_get_message_area(GtkStatusbar* statusbar)"
+ Xen_check_type(Xen_is_GtkStatusbar_(statusbar), statusbar, 1, "gtk_statusbar_get_message_area", "GtkStatusbar*");
+ return(C_to_Xen_GtkWidget_(gtk_statusbar_get_message_area(Xen_to_C_GtkStatusbar_(statusbar))));
}
-static XEN gxg_gtk_print_settings_set_reverse(XEN settings, XEN reverse)
+static Xen gxg_gtk_tool_item_get_ellipsize_mode(Xen tool_item)
{
- #define H_gtk_print_settings_set_reverse "void gtk_print_settings_set_reverse(GtkPrintSettings* settings, \
-gboolean reverse)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_reverse", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(reverse), reverse, 2, "gtk_print_settings_set_reverse", "gboolean");
- gtk_print_settings_set_reverse(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gboolean(reverse));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_get_ellipsize_mode "PangoEllipsizeMode gtk_tool_item_get_ellipsize_mode(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_ellipsize_mode", "GtkToolItem*");
+ return(C_to_Xen_PangoEllipsizeMode(gtk_tool_item_get_ellipsize_mode(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_print_settings_get_duplex(XEN settings)
+static Xen gxg_gtk_tool_item_get_text_alignment(Xen tool_item)
{
- #define H_gtk_print_settings_get_duplex "GtkPrintDuplex gtk_print_settings_get_duplex(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_duplex", "GtkPrintSettings*");
- return(C_TO_XEN_GtkPrintDuplex(gtk_print_settings_get_duplex(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_item_get_text_alignment "gfloat gtk_tool_item_get_text_alignment(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_text_alignment", "GtkToolItem*");
+ return(C_to_Xen_gfloat(gtk_tool_item_get_text_alignment(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_print_settings_set_duplex(XEN settings, XEN duplex)
+static Xen gxg_gtk_tool_item_get_text_orientation(Xen tool_item)
{
- #define H_gtk_print_settings_set_duplex "void gtk_print_settings_set_duplex(GtkPrintSettings* settings, \
-GtkPrintDuplex duplex)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_duplex", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPrintDuplex_P(duplex), duplex, 2, "gtk_print_settings_set_duplex", "GtkPrintDuplex");
- gtk_print_settings_set_duplex(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkPrintDuplex(duplex));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_get_text_orientation "GtkOrientation gtk_tool_item_get_text_orientation(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_text_orientation", "GtkToolItem*");
+ return(C_to_Xen_GtkOrientation(gtk_tool_item_get_text_orientation(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_print_settings_get_quality(XEN settings)
+static Xen gxg_gtk_tool_item_get_text_size_group(Xen tool_item)
{
- #define H_gtk_print_settings_get_quality "GtkPrintQuality gtk_print_settings_get_quality(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_quality", "GtkPrintSettings*");
- return(C_TO_XEN_GtkPrintQuality(gtk_print_settings_get_quality(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_item_get_text_size_group "GtkSizeGroup* gtk_tool_item_get_text_size_group(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_get_text_size_group", "GtkToolItem*");
+ return(C_to_Xen_GtkSizeGroup_(gtk_tool_item_get_text_size_group(Xen_to_C_GtkToolItem_(tool_item))));
}
-static XEN gxg_gtk_print_settings_set_quality(XEN settings, XEN quality)
+static Xen gxg_gtk_tool_palette_new(void)
{
- #define H_gtk_print_settings_set_quality "void gtk_print_settings_set_quality(GtkPrintSettings* settings, \
-GtkPrintQuality quality)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_quality", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPrintQuality_P(quality), quality, 2, "gtk_print_settings_set_quality", "GtkPrintQuality");
- gtk_print_settings_set_quality(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkPrintQuality(quality));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_new "GtkWidget* gtk_tool_palette_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_tool_palette_new()));
}
-static XEN gxg_gtk_print_settings_get_n_copies(XEN settings)
+static Xen gxg_gtk_tool_palette_set_group_position(Xen palette, Xen group, Xen position)
{
- #define H_gtk_print_settings_get_n_copies "gint gtk_print_settings_get_n_copies(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_n_copies", "GtkPrintSettings*");
- return(C_TO_XEN_gint(gtk_print_settings_get_n_copies(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_palette_set_group_position "void gtk_tool_palette_set_group_position(GtkToolPalette* palette, \
+GtkToolItemGroup* group, gint position)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_set_group_position", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 2, "gtk_tool_palette_set_group_position", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_tool_palette_set_group_position", "gint");
+ gtk_tool_palette_set_group_position(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_n_copies(XEN settings, XEN num_copies)
+static Xen gxg_gtk_tool_palette_set_exclusive(Xen palette, Xen group, Xen exclusive)
{
- #define H_gtk_print_settings_set_n_copies "void gtk_print_settings_set_n_copies(GtkPrintSettings* settings, \
-gint num_copies)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_n_copies", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gint_P(num_copies), num_copies, 2, "gtk_print_settings_set_n_copies", "gint");
- gtk_print_settings_set_n_copies(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gint(num_copies));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_set_exclusive "void gtk_tool_palette_set_exclusive(GtkToolPalette* palette, \
+GtkToolItemGroup* group, gboolean exclusive)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_set_exclusive", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 2, "gtk_tool_palette_set_exclusive", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_gboolean(exclusive), exclusive, 3, "gtk_tool_palette_set_exclusive", "gboolean");
+ gtk_tool_palette_set_exclusive(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_gboolean(exclusive));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_number_up(XEN settings)
+static Xen gxg_gtk_tool_palette_set_expand(Xen palette, Xen group, Xen expand)
{
- #define H_gtk_print_settings_get_number_up "gint gtk_print_settings_get_number_up(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_number_up", "GtkPrintSettings*");
- return(C_TO_XEN_gint(gtk_print_settings_get_number_up(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_palette_set_expand "void gtk_tool_palette_set_expand(GtkToolPalette* palette, GtkToolItemGroup* group, \
+gboolean expand)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_set_expand", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 2, "gtk_tool_palette_set_expand", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 3, "gtk_tool_palette_set_expand", "gboolean");
+ gtk_tool_palette_set_expand(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_gboolean(expand));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_number_up(XEN settings, XEN number_up)
+static Xen gxg_gtk_tool_palette_get_group_position(Xen palette, Xen group)
{
- #define H_gtk_print_settings_set_number_up "void gtk_print_settings_set_number_up(GtkPrintSettings* settings, \
-gint number_up)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_number_up", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gint_P(number_up), number_up, 2, "gtk_print_settings_set_number_up", "gint");
- gtk_print_settings_set_number_up(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gint(number_up));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_get_group_position "gint gtk_tool_palette_get_group_position(GtkToolPalette* palette, \
+GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_get_group_position", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 2, "gtk_tool_palette_get_group_position", "GtkToolItemGroup*");
+ return(C_to_Xen_gint(gtk_tool_palette_get_group_position(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_gtk_print_settings_get_resolution(XEN settings)
+static Xen gxg_gtk_tool_palette_get_exclusive(Xen palette, Xen group)
{
- #define H_gtk_print_settings_get_resolution "gint gtk_print_settings_get_resolution(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_resolution", "GtkPrintSettings*");
- return(C_TO_XEN_gint(gtk_print_settings_get_resolution(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_palette_get_exclusive "gboolean gtk_tool_palette_get_exclusive(GtkToolPalette* palette, \
+GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_get_exclusive", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 2, "gtk_tool_palette_get_exclusive", "GtkToolItemGroup*");
+ return(C_to_Xen_gboolean(gtk_tool_palette_get_exclusive(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_gtk_print_settings_set_resolution(XEN settings, XEN resolution)
+static Xen gxg_gtk_tool_palette_get_expand(Xen palette, Xen group)
{
- #define H_gtk_print_settings_set_resolution "void gtk_print_settings_set_resolution(GtkPrintSettings* settings, \
-gint resolution)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_resolution", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gint_P(resolution), resolution, 2, "gtk_print_settings_set_resolution", "gint");
- gtk_print_settings_set_resolution(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gint(resolution));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_get_expand "gboolean gtk_tool_palette_get_expand(GtkToolPalette* palette, \
+GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_get_expand", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 2, "gtk_tool_palette_get_expand", "GtkToolItemGroup*");
+ return(C_to_Xen_gboolean(gtk_tool_palette_get_expand(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_gtk_print_settings_get_scale(XEN settings)
+static Xen gxg_gtk_tool_palette_unset_icon_size(Xen palette)
{
- #define H_gtk_print_settings_get_scale "gdouble gtk_print_settings_get_scale(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_scale", "GtkPrintSettings*");
- return(C_TO_XEN_gdouble(gtk_print_settings_get_scale(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_palette_unset_icon_size "void gtk_tool_palette_unset_icon_size(GtkToolPalette* palette)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_unset_icon_size", "GtkToolPalette*");
+ gtk_tool_palette_unset_icon_size(Xen_to_C_GtkToolPalette_(palette));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_scale(XEN settings, XEN scale)
+static Xen gxg_gtk_tool_palette_set_style(Xen palette, Xen style)
{
- #define H_gtk_print_settings_set_scale "void gtk_print_settings_set_scale(GtkPrintSettings* settings, \
-gdouble scale)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_scale", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(scale), scale, 2, "gtk_print_settings_set_scale", "gdouble");
- gtk_print_settings_set_scale(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gdouble(scale));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_set_style "void gtk_tool_palette_set_style(GtkToolPalette* palette, GtkToolbarStyle style)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_set_style", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkToolbarStyle(style), style, 2, "gtk_tool_palette_set_style", "GtkToolbarStyle");
+ gtk_tool_palette_set_style(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkToolbarStyle(style));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_print_pages(XEN settings)
+static Xen gxg_gtk_tool_palette_unset_style(Xen palette)
{
- #define H_gtk_print_settings_get_print_pages "GtkPrintPages gtk_print_settings_get_print_pages(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_print_pages", "GtkPrintSettings*");
- return(C_TO_XEN_GtkPrintPages(gtk_print_settings_get_print_pages(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_palette_unset_style "void gtk_tool_palette_unset_style(GtkToolPalette* palette)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_unset_style", "GtkToolPalette*");
+ gtk_tool_palette_unset_style(Xen_to_C_GtkToolPalette_(palette));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_print_pages(XEN settings, XEN pages)
+static Xen gxg_gtk_tool_palette_get_style(Xen palette)
{
- #define H_gtk_print_settings_set_print_pages "void gtk_print_settings_set_print_pages(GtkPrintSettings* settings, \
-GtkPrintPages pages)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_print_pages", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPrintPages_P(pages), pages, 2, "gtk_print_settings_set_print_pages", "GtkPrintPages");
- gtk_print_settings_set_print_pages(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkPrintPages(pages));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_get_style "GtkToolbarStyle gtk_tool_palette_get_style(GtkToolPalette* palette)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_get_style", "GtkToolPalette*");
+ return(C_to_Xen_GtkToolbarStyle(gtk_tool_palette_get_style(Xen_to_C_GtkToolPalette_(palette))));
}
-static XEN gxg_gtk_print_settings_get_page_ranges(XEN settings, XEN num_ranges)
+static Xen gxg_gtk_tool_palette_get_drop_item(Xen palette, Xen x, Xen y)
{
- #define H_gtk_print_settings_get_page_ranges "GtkPageRange* gtk_print_settings_get_page_ranges(GtkPrintSettings* settings, \
-gint* num_ranges)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_page_ranges", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gint__P(num_ranges), num_ranges, 2, "gtk_print_settings_get_page_ranges", "gint*");
- return(C_TO_XEN_GtkPageRange_(gtk_print_settings_get_page_ranges(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gint_(num_ranges))));
+ #define H_gtk_tool_palette_get_drop_item "GtkToolItem* gtk_tool_palette_get_drop_item(GtkToolPalette* palette, \
+gint x, gint y)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_get_drop_item", "GtkToolPalette*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_tool_palette_get_drop_item", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_tool_palette_get_drop_item", "gint");
+ return(C_to_Xen_GtkToolItem_(gtk_tool_palette_get_drop_item(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_gint(x), Xen_to_C_gint(y))));
}
-static XEN gxg_gtk_print_settings_set_page_ranges(XEN settings, XEN page_ranges, XEN num_ranges)
+static Xen gxg_gtk_tool_palette_get_drop_group(Xen palette, Xen x, Xen y)
{
- #define H_gtk_print_settings_set_page_ranges "void gtk_print_settings_set_page_ranges(GtkPrintSettings* settings, \
-GtkPageRange* page_ranges, gint num_ranges)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_page_ranges", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPageRange__P(page_ranges), page_ranges, 2, "gtk_print_settings_set_page_ranges", "GtkPageRange*");
- XEN_ASSERT_TYPE(XEN_gint_P(num_ranges), num_ranges, 3, "gtk_print_settings_set_page_ranges", "gint");
- gtk_print_settings_set_page_ranges(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkPageRange_(page_ranges), XEN_TO_C_gint(num_ranges));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_get_drop_group "GtkToolItemGroup* gtk_tool_palette_get_drop_group(GtkToolPalette* palette, \
+gint x, gint y)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_get_drop_group", "GtkToolPalette*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_tool_palette_get_drop_group", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_tool_palette_get_drop_group", "gint");
+ return(C_to_Xen_GtkToolItemGroup_(gtk_tool_palette_get_drop_group(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_gint(x),
+ Xen_to_C_gint(y))));
}
-static XEN gxg_gtk_print_settings_get_page_set(XEN settings)
+static Xen gxg_gtk_tool_palette_get_drag_item(Xen palette, Xen selection)
{
- #define H_gtk_print_settings_get_page_set "GtkPageSet gtk_print_settings_get_page_set(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_page_set", "GtkPrintSettings*");
- return(C_TO_XEN_GtkPageSet(gtk_print_settings_get_page_set(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_palette_get_drag_item "GtkWidget* gtk_tool_palette_get_drag_item(GtkToolPalette* palette, \
+GtkSelectionData* selection)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_get_drag_item", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkSelectionData_(selection), selection, 2, "gtk_tool_palette_get_drag_item", "GtkSelectionData*");
+ return(C_to_Xen_GtkWidget_(gtk_tool_palette_get_drag_item(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkSelectionData_(selection))));
}
-static XEN gxg_gtk_print_settings_set_page_set(XEN settings, XEN page_set)
+static Xen gxg_gtk_tool_palette_set_drag_source(Xen palette, Xen targets)
{
- #define H_gtk_print_settings_set_page_set "void gtk_print_settings_set_page_set(GtkPrintSettings* settings, \
-GtkPageSet page_set)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_page_set", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_GtkPageSet_P(page_set), page_set, 2, "gtk_print_settings_set_page_set", "GtkPageSet");
- gtk_print_settings_set_page_set(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_GtkPageSet(page_set));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_set_drag_source "void gtk_tool_palette_set_drag_source(GtkToolPalette* palette, \
+GtkToolPaletteDragTargets targets)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_set_drag_source", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkToolPaletteDragTargets(targets), targets, 2, "gtk_tool_palette_set_drag_source", "GtkToolPaletteDragTargets");
+ gtk_tool_palette_set_drag_source(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkToolPaletteDragTargets(targets));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_default_source(XEN settings)
+static Xen gxg_gtk_tool_palette_add_drag_dest(Xen palette, Xen widget, Xen flags, Xen targets, Xen actions)
{
- #define H_gtk_print_settings_get_default_source "gchar* gtk_print_settings_get_default_source(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_default_source", "GtkPrintSettings*");
- return(C_TO_XEN_gchar_(gtk_print_settings_get_default_source(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_palette_add_drag_dest "void gtk_tool_palette_add_drag_dest(GtkToolPalette* palette, \
+GtkWidget* widget, GtkDestDefaults flags, GtkToolPaletteDragTargets targets, GdkDragAction actions)"
+ Xen_check_type(Xen_is_GtkToolPalette_(palette), palette, 1, "gtk_tool_palette_add_drag_dest", "GtkToolPalette*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_tool_palette_add_drag_dest", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkDestDefaults(flags), flags, 3, "gtk_tool_palette_add_drag_dest", "GtkDestDefaults");
+ Xen_check_type(Xen_is_GtkToolPaletteDragTargets(targets), targets, 4, "gtk_tool_palette_add_drag_dest", "GtkToolPaletteDragTargets");
+ Xen_check_type(Xen_is_GdkDragAction(actions), actions, 5, "gtk_tool_palette_add_drag_dest", "GdkDragAction");
+ gtk_tool_palette_add_drag_dest(Xen_to_C_GtkToolPalette_(palette), Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkDestDefaults(flags),
+ Xen_to_C_GtkToolPaletteDragTargets(targets), Xen_to_C_GdkDragAction(actions));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_default_source(XEN settings, XEN default_source)
+static Xen gxg_gtk_tool_palette_get_drag_target_item(void)
{
- #define H_gtk_print_settings_set_default_source "void gtk_print_settings_set_default_source(GtkPrintSettings* settings, \
-gchar* default_source)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_default_source", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(default_source), default_source, 2, "gtk_print_settings_set_default_source", "gchar*");
- gtk_print_settings_set_default_source(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(default_source));
- return(XEN_FALSE);
+ #define H_gtk_tool_palette_get_drag_target_item "GtkTargetEntry* gtk_tool_palette_get_drag_target_item( void)"
+ return(C_to_Xen_GtkTargetEntry_((GtkTargetEntry*)gtk_tool_palette_get_drag_target_item()));
}
-static XEN gxg_gtk_print_settings_get_media_type(XEN settings)
+static Xen gxg_gtk_tool_palette_get_drag_target_group(void)
{
- #define H_gtk_print_settings_get_media_type "gchar* gtk_print_settings_get_media_type(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_media_type", "GtkPrintSettings*");
- return(C_TO_XEN_gchar_(gtk_print_settings_get_media_type(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_palette_get_drag_target_group "GtkTargetEntry* gtk_tool_palette_get_drag_target_group( void)"
+ return(C_to_Xen_GtkTargetEntry_((GtkTargetEntry*)gtk_tool_palette_get_drag_target_group()));
}
-static XEN gxg_gtk_print_settings_set_media_type(XEN settings, XEN media_type)
+static Xen gxg_gtk_tool_item_group_new(Xen label)
{
- #define H_gtk_print_settings_set_media_type "void gtk_print_settings_set_media_type(GtkPrintSettings* settings, \
-gchar* media_type)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_media_type", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(media_type), media_type, 2, "gtk_print_settings_set_media_type", "gchar*");
- gtk_print_settings_set_media_type(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(media_type));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_new "GtkWidget* gtk_tool_item_group_new(gchar* label)"
+ Xen_check_type(Xen_is_gchar_(label), label, 1, "gtk_tool_item_group_new", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_tool_item_group_new((const gchar*)Xen_to_C_gchar_(label))));
}
-static XEN gxg_gtk_print_settings_get_dither(XEN settings)
+static Xen gxg_gtk_tool_item_group_set_label(Xen group, Xen label)
{
- #define H_gtk_print_settings_get_dither "gchar* gtk_print_settings_get_dither(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_dither", "GtkPrintSettings*");
- return(C_TO_XEN_gchar_(gtk_print_settings_get_dither(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_item_group_set_label "void gtk_tool_item_group_set_label(GtkToolItemGroup* group, \
+gchar* label)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_set_label", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_gchar_(label), label, 2, "gtk_tool_item_group_set_label", "gchar*");
+ gtk_tool_item_group_set_label(Xen_to_C_GtkToolItemGroup_(group), (const gchar*)Xen_to_C_gchar_(label));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_dither(XEN settings, XEN dither)
+static Xen gxg_gtk_tool_item_group_set_label_widget(Xen group, Xen label_widget)
{
- #define H_gtk_print_settings_set_dither "void gtk_print_settings_set_dither(GtkPrintSettings* settings, \
-gchar* dither)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_dither", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(dither), dither, 2, "gtk_print_settings_set_dither", "gchar*");
- gtk_print_settings_set_dither(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(dither));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_set_label_widget "void gtk_tool_item_group_set_label_widget(GtkToolItemGroup* group, \
+GtkWidget* label_widget)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_set_label_widget", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_GtkWidget_(label_widget), label_widget, 2, "gtk_tool_item_group_set_label_widget", "GtkWidget*");
+ gtk_tool_item_group_set_label_widget(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_GtkWidget_(label_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_finishings(XEN settings)
+static Xen gxg_gtk_tool_item_group_set_collapsed(Xen group, Xen collapsed)
{
- #define H_gtk_print_settings_get_finishings "gchar* gtk_print_settings_get_finishings(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_finishings", "GtkPrintSettings*");
- return(C_TO_XEN_gchar_(gtk_print_settings_get_finishings(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_item_group_set_collapsed "void gtk_tool_item_group_set_collapsed(GtkToolItemGroup* group, \
+gboolean collapsed)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_set_collapsed", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_gboolean(collapsed), collapsed, 2, "gtk_tool_item_group_set_collapsed", "gboolean");
+ gtk_tool_item_group_set_collapsed(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_gboolean(collapsed));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_finishings(XEN settings, XEN finishings)
+static Xen gxg_gtk_tool_item_group_set_ellipsize(Xen group, Xen ellipsize)
{
- #define H_gtk_print_settings_set_finishings "void gtk_print_settings_set_finishings(GtkPrintSettings* settings, \
-gchar* finishings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_finishings", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(finishings), finishings, 2, "gtk_print_settings_set_finishings", "gchar*");
- gtk_print_settings_set_finishings(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(finishings));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_set_ellipsize "void gtk_tool_item_group_set_ellipsize(GtkToolItemGroup* group, \
+PangoEllipsizeMode ellipsize)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_set_ellipsize", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_PangoEllipsizeMode(ellipsize), ellipsize, 2, "gtk_tool_item_group_set_ellipsize", "PangoEllipsizeMode");
+ gtk_tool_item_group_set_ellipsize(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_PangoEllipsizeMode(ellipsize));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_get_output_bin(XEN settings)
+static Xen gxg_gtk_tool_item_group_set_header_relief(Xen group, Xen style)
{
- #define H_gtk_print_settings_get_output_bin "gchar* gtk_print_settings_get_output_bin(GtkPrintSettings* settings)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_get_output_bin", "GtkPrintSettings*");
- return(C_TO_XEN_gchar_(gtk_print_settings_get_output_bin(XEN_TO_C_GtkPrintSettings_(settings))));
+ #define H_gtk_tool_item_group_set_header_relief "void gtk_tool_item_group_set_header_relief(GtkToolItemGroup* group, \
+GtkReliefStyle style)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_set_header_relief", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_GtkReliefStyle(style), style, 2, "gtk_tool_item_group_set_header_relief", "GtkReliefStyle");
+ gtk_tool_item_group_set_header_relief(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_GtkReliefStyle(style));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_settings_set_output_bin(XEN settings, XEN output_bin)
+static Xen gxg_gtk_tool_item_group_get_label(Xen group)
{
- #define H_gtk_print_settings_set_output_bin "void gtk_print_settings_set_output_bin(GtkPrintSettings* settings, \
-gchar* output_bin)"
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_set_output_bin", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(output_bin), output_bin, 2, "gtk_print_settings_set_output_bin", "gchar*");
- gtk_print_settings_set_output_bin(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(output_bin));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_get_label "gchar* gtk_tool_item_group_get_label(GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_label", "GtkToolItemGroup*");
+ return(C_to_Xen_gchar_(gtk_tool_item_group_get_label(Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_gtk_settings_get_for_screen(XEN screen)
+static Xen gxg_gtk_tool_item_group_get_label_widget(Xen group)
{
- #define H_gtk_settings_get_for_screen "GtkSettings* gtk_settings_get_for_screen(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gtk_settings_get_for_screen", "GdkScreen*");
- return(C_TO_XEN_GtkSettings_(gtk_settings_get_for_screen(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_tool_item_group_get_label_widget "GtkWidget* gtk_tool_item_group_get_label_widget(GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_label_widget", "GtkToolItemGroup*");
+ return(C_to_Xen_GtkWidget_(gtk_tool_item_group_get_label_widget(Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_pango_cairo_create_layout(XEN cr)
+static Xen gxg_gtk_tool_item_group_get_collapsed(Xen group)
{
- #define H_pango_cairo_create_layout "PangoLayout* pango_cairo_create_layout(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_create_layout", "cairo_t*");
- return(C_TO_XEN_PangoLayout_(pango_cairo_create_layout(XEN_TO_C_cairo_t_(cr))));
+ #define H_gtk_tool_item_group_get_collapsed "gboolean gtk_tool_item_group_get_collapsed(GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_collapsed", "GtkToolItemGroup*");
+ return(C_to_Xen_gboolean(gtk_tool_item_group_get_collapsed(Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_pango_cairo_update_layout(XEN cr, XEN layout)
+static Xen gxg_gtk_tool_item_group_get_ellipsize(Xen group)
{
- #define H_pango_cairo_update_layout "void pango_cairo_update_layout(cairo_t* cr, PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_update_layout", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 2, "pango_cairo_update_layout", "PangoLayout*");
- pango_cairo_update_layout(XEN_TO_C_cairo_t_(cr), XEN_TO_C_PangoLayout_(layout));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_get_ellipsize "PangoEllipsizeMode gtk_tool_item_group_get_ellipsize(GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_ellipsize", "GtkToolItemGroup*");
+ return(C_to_Xen_PangoEllipsizeMode(gtk_tool_item_group_get_ellipsize(Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_pango_cairo_update_context(XEN cr, XEN context)
+static Xen gxg_gtk_tool_item_group_get_header_relief(Xen group)
{
- #define H_pango_cairo_update_context "void pango_cairo_update_context(cairo_t* cr, PangoContext* context)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_update_context", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 2, "pango_cairo_update_context", "PangoContext*");
- pango_cairo_update_context(XEN_TO_C_cairo_t_(cr), XEN_TO_C_PangoContext_(context));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_get_header_relief "GtkReliefStyle gtk_tool_item_group_get_header_relief(GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_header_relief", "GtkToolItemGroup*");
+ return(C_to_Xen_GtkReliefStyle(gtk_tool_item_group_get_header_relief(Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_pango_cairo_context_set_font_options(XEN context, XEN options)
+static Xen gxg_gtk_tool_item_group_insert(Xen group, Xen item, Xen position)
{
- #define H_pango_cairo_context_set_font_options "void pango_cairo_context_set_font_options(PangoContext* context, \
-cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_cairo_context_set_font_options", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 2, "pango_cairo_context_set_font_options", "cairo_font_options_t*");
- pango_cairo_context_set_font_options(XEN_TO_C_PangoContext_(context), XEN_TO_C_cairo_font_options_t_(options));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_insert "void gtk_tool_item_group_insert(GtkToolItemGroup* group, GtkToolItem* item, \
+gint position)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_insert", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_GtkToolItem_(item), item, 2, "gtk_tool_item_group_insert", "GtkToolItem*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_tool_item_group_insert", "gint");
+ gtk_tool_item_group_insert(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_GtkToolItem_(item), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_pango_cairo_context_get_font_options(XEN context)
+static Xen gxg_gtk_tool_item_group_set_item_position(Xen group, Xen item, Xen position)
{
- #define H_pango_cairo_context_get_font_options "cairo_font_options_t* pango_cairo_context_get_font_options(PangoContext* context)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_cairo_context_get_font_options", "PangoContext*");
- return(C_TO_XEN_cairo_font_options_t_((cairo_font_options_t*)pango_cairo_context_get_font_options(XEN_TO_C_PangoContext_(context))));
+ #define H_gtk_tool_item_group_set_item_position "void gtk_tool_item_group_set_item_position(GtkToolItemGroup* group, \
+GtkToolItem* item, gint position)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_set_item_position", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_GtkToolItem_(item), item, 2, "gtk_tool_item_group_set_item_position", "GtkToolItem*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_tool_item_group_set_item_position", "gint");
+ gtk_tool_item_group_set_item_position(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_GtkToolItem_(item), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_pango_cairo_context_set_resolution(XEN context, XEN dpi)
+static Xen gxg_gtk_tool_item_group_get_item_position(Xen group, Xen item)
{
- #define H_pango_cairo_context_set_resolution "void pango_cairo_context_set_resolution(PangoContext* context, \
-gdouble dpi)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_cairo_context_set_resolution", "PangoContext*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(dpi), dpi, 2, "pango_cairo_context_set_resolution", "gdouble");
- pango_cairo_context_set_resolution(XEN_TO_C_PangoContext_(context), XEN_TO_C_gdouble(dpi));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_get_item_position "gint gtk_tool_item_group_get_item_position(GtkToolItemGroup* group, \
+GtkToolItem* item)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_item_position", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_GtkToolItem_(item), item, 2, "gtk_tool_item_group_get_item_position", "GtkToolItem*");
+ return(C_to_Xen_gint(gtk_tool_item_group_get_item_position(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_GtkToolItem_(item))));
}
-static XEN gxg_pango_cairo_context_get_resolution(XEN context)
+static Xen gxg_gtk_tool_item_group_get_n_items(Xen group)
{
- #define H_pango_cairo_context_get_resolution "gdouble pango_cairo_context_get_resolution(PangoContext* context)"
- XEN_ASSERT_TYPE(XEN_PangoContext__P(context), context, 1, "pango_cairo_context_get_resolution", "PangoContext*");
- return(C_TO_XEN_gdouble(pango_cairo_context_get_resolution(XEN_TO_C_PangoContext_(context))));
+ #define H_gtk_tool_item_group_get_n_items "guint gtk_tool_item_group_get_n_items(GtkToolItemGroup* group)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_n_items", "GtkToolItemGroup*");
+ return(C_to_Xen_guint(gtk_tool_item_group_get_n_items(Xen_to_C_GtkToolItemGroup_(group))));
}
-static XEN gxg_pango_cairo_show_glyph_string(XEN cr, XEN font, XEN glyphs)
+static Xen gxg_gtk_tool_item_group_get_nth_item(Xen group, Xen index)
{
- #define H_pango_cairo_show_glyph_string "void pango_cairo_show_glyph_string(cairo_t* cr, PangoFont* font, \
-PangoGlyphString* glyphs)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_show_glyph_string", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 2, "pango_cairo_show_glyph_string", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 3, "pango_cairo_show_glyph_string", "PangoGlyphString*");
- pango_cairo_show_glyph_string(XEN_TO_C_cairo_t_(cr), XEN_TO_C_PangoFont_(font), XEN_TO_C_PangoGlyphString_(glyphs));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_get_nth_item "GtkToolItem* gtk_tool_item_group_get_nth_item(GtkToolItemGroup* group, \
+guint index)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_nth_item", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_guint(index), index, 2, "gtk_tool_item_group_get_nth_item", "guint");
+ return(C_to_Xen_GtkToolItem_(gtk_tool_item_group_get_nth_item(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_guint(index))));
}
-static XEN gxg_pango_cairo_show_layout_line(XEN cr, XEN line)
+static Xen gxg_gtk_tool_item_group_get_drop_item(Xen group, Xen x, Xen y)
{
- #define H_pango_cairo_show_layout_line "void pango_cairo_show_layout_line(cairo_t* cr, PangoLayoutLine* line)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_show_layout_line", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 2, "pango_cairo_show_layout_line", "PangoLayoutLine*");
- pango_cairo_show_layout_line(XEN_TO_C_cairo_t_(cr), XEN_TO_C_PangoLayoutLine_(line));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_group_get_drop_item "GtkToolItem* gtk_tool_item_group_get_drop_item(GtkToolItemGroup* group, \
+gint x, gint y)"
+ Xen_check_type(Xen_is_GtkToolItemGroup_(group), group, 1, "gtk_tool_item_group_get_drop_item", "GtkToolItemGroup*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_tool_item_group_get_drop_item", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_tool_item_group_get_drop_item", "gint");
+ return(C_to_Xen_GtkToolItem_(gtk_tool_item_group_get_drop_item(Xen_to_C_GtkToolItemGroup_(group), Xen_to_C_gint(x), Xen_to_C_gint(y))));
}
-static XEN gxg_pango_cairo_show_layout(XEN cr, XEN layout)
+static Xen gxg_gdk_screen_get_primary_monitor(Xen screen)
{
- #define H_pango_cairo_show_layout "void pango_cairo_show_layout(cairo_t* cr, PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_show_layout", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 2, "pango_cairo_show_layout", "PangoLayout*");
- pango_cairo_show_layout(XEN_TO_C_cairo_t_(cr), XEN_TO_C_PangoLayout_(layout));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_primary_monitor "gint gdk_screen_get_primary_monitor(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_primary_monitor", "GdkScreen*");
+ return(C_to_Xen_gint(gdk_screen_get_primary_monitor(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_pango_cairo_show_error_underline(XEN cr, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_gtk_window_set_mnemonics_visible(Xen window, Xen setting)
{
- #define H_pango_cairo_show_error_underline "void pango_cairo_show_error_underline(cairo_t* cr, gdouble x, \
-gdouble y, gdouble width, gdouble height)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_show_error_underline", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(x), x, 2, "pango_cairo_show_error_underline", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(y), y, 3, "pango_cairo_show_error_underline", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(width), width, 4, "pango_cairo_show_error_underline", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(height), height, 5, "pango_cairo_show_error_underline", "gdouble");
- pango_cairo_show_error_underline(XEN_TO_C_cairo_t_(cr), XEN_TO_C_gdouble(x), XEN_TO_C_gdouble(y), XEN_TO_C_gdouble(width),
- XEN_TO_C_gdouble(height));
- return(XEN_FALSE);
+ #define H_gtk_window_set_mnemonics_visible "void gtk_window_set_mnemonics_visible(GtkWindow* window, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_mnemonics_visible", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_mnemonics_visible", "gboolean");
+ gtk_window_set_mnemonics_visible(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_pango_cairo_glyph_string_path(XEN cr, XEN font, XEN glyphs)
+static Xen gxg_gtk_window_get_mnemonics_visible(Xen window)
{
- #define H_pango_cairo_glyph_string_path "void pango_cairo_glyph_string_path(cairo_t* cr, PangoFont* font, \
-PangoGlyphString* glyphs)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_glyph_string_path", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_PangoFont__P(font), font, 2, "pango_cairo_glyph_string_path", "PangoFont*");
- XEN_ASSERT_TYPE(XEN_PangoGlyphString__P(glyphs), glyphs, 3, "pango_cairo_glyph_string_path", "PangoGlyphString*");
- pango_cairo_glyph_string_path(XEN_TO_C_cairo_t_(cr), XEN_TO_C_PangoFont_(font), XEN_TO_C_PangoGlyphString_(glyphs));
- return(XEN_FALSE);
+ #define H_gtk_window_get_mnemonics_visible "gboolean gtk_window_get_mnemonics_visible(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_mnemonics_visible", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_mnemonics_visible(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_pango_cairo_layout_line_path(XEN cr, XEN line)
+static Xen gxg_gtk_range_set_slider_size_fixed(Xen range, Xen size_fixed)
{
- #define H_pango_cairo_layout_line_path "void pango_cairo_layout_line_path(cairo_t* cr, PangoLayoutLine* line)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_layout_line_path", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 2, "pango_cairo_layout_line_path", "PangoLayoutLine*");
- pango_cairo_layout_line_path(XEN_TO_C_cairo_t_(cr), XEN_TO_C_PangoLayoutLine_(line));
- return(XEN_FALSE);
+ #define H_gtk_range_set_slider_size_fixed "void gtk_range_set_slider_size_fixed(GtkRange* range, gboolean size_fixed)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_slider_size_fixed", "GtkRange*");
+ Xen_check_type(Xen_is_gboolean(size_fixed), size_fixed, 2, "gtk_range_set_slider_size_fixed", "gboolean");
+ gtk_range_set_slider_size_fixed(Xen_to_C_GtkRange_(range), Xen_to_C_gboolean(size_fixed));
+ return(Xen_false);
}
-static XEN gxg_pango_cairo_layout_path(XEN cr, XEN layout)
+static Xen gxg_gtk_range_get_slider_size_fixed(Xen range)
{
- #define H_pango_cairo_layout_path "void pango_cairo_layout_path(cairo_t* cr, PangoLayout* layout)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_layout_path", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 2, "pango_cairo_layout_path", "PangoLayout*");
- pango_cairo_layout_path(XEN_TO_C_cairo_t_(cr), XEN_TO_C_PangoLayout_(layout));
- return(XEN_FALSE);
+ #define H_gtk_range_get_slider_size_fixed "gboolean gtk_range_get_slider_size_fixed(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_slider_size_fixed", "GtkRange*");
+ return(C_to_Xen_gboolean(gtk_range_get_slider_size_fixed(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_pango_cairo_error_underline_path(XEN cr, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_gtk_range_set_min_slider_size(Xen range, Xen min_size)
{
- #define H_pango_cairo_error_underline_path "void pango_cairo_error_underline_path(cairo_t* cr, gdouble x, \
-gdouble y, gdouble width, gdouble height)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "pango_cairo_error_underline_path", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(x), x, 2, "pango_cairo_error_underline_path", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(y), y, 3, "pango_cairo_error_underline_path", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(width), width, 4, "pango_cairo_error_underline_path", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(height), height, 5, "pango_cairo_error_underline_path", "gdouble");
- pango_cairo_error_underline_path(XEN_TO_C_cairo_t_(cr), XEN_TO_C_gdouble(x), XEN_TO_C_gdouble(y), XEN_TO_C_gdouble(width),
- XEN_TO_C_gdouble(height));
- return(XEN_FALSE);
+ #define H_gtk_range_set_min_slider_size "void gtk_range_set_min_slider_size(GtkRange* range, gboolean min_size)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_set_min_slider_size", "GtkRange*");
+ Xen_check_type(Xen_is_gboolean(min_size), min_size, 2, "gtk_range_set_min_slider_size", "gboolean");
+ gtk_range_set_min_slider_size(Xen_to_C_GtkRange_(range), Xen_to_C_gboolean(min_size));
+ return(Xen_false);
}
-static XEN gxg_gdk_cairo_set_source_color(XEN cr, XEN color)
+static Xen gxg_gtk_range_get_min_slider_size(Xen range)
{
- #define H_gdk_cairo_set_source_color "void gdk_cairo_set_source_color(cairo_t* cr, GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "gdk_cairo_set_source_color", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gdk_cairo_set_source_color", "GdkColor*");
- gdk_cairo_set_source_color(XEN_TO_C_cairo_t_(cr), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_range_get_min_slider_size "gint gtk_range_get_min_slider_size(GtkRange* range)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_min_slider_size", "GtkRange*");
+ return(C_to_Xen_gint(gtk_range_get_min_slider_size(Xen_to_C_GtkRange_(range))));
}
-static XEN gxg_gdk_cairo_set_source_pixbuf(XEN cr, XEN pixbuf, XEN pixbuf_x, XEN pixbuf_y)
+static Xen gxg_gtk_range_get_range_rect(Xen range, Xen range_rect)
{
- #define H_gdk_cairo_set_source_pixbuf "void gdk_cairo_set_source_pixbuf(cairo_t* cr, GdkPixbuf* pixbuf, \
-gdouble pixbuf_x, gdouble pixbuf_y)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "gdk_cairo_set_source_pixbuf", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gdk_cairo_set_source_pixbuf", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(pixbuf_x), pixbuf_x, 3, "gdk_cairo_set_source_pixbuf", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(pixbuf_y), pixbuf_y, 4, "gdk_cairo_set_source_pixbuf", "gdouble");
- gdk_cairo_set_source_pixbuf(XEN_TO_C_cairo_t_(cr), XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_gdouble(pixbuf_x), XEN_TO_C_gdouble(pixbuf_y));
- return(XEN_FALSE);
+ #define H_gtk_range_get_range_rect "void gtk_range_get_range_rect(GtkRange* range, GdkRectangle* range_rect)"
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_range_rect", "GtkRange*");
+ Xen_check_type(Xen_is_GdkRectangle_(range_rect), range_rect, 2, "gtk_range_get_range_rect", "GdkRectangle*");
+ gtk_range_get_range_rect(Xen_to_C_GtkRange_(range), Xen_to_C_GdkRectangle_(range_rect));
+ return(Xen_false);
}
-static XEN gxg_gdk_cairo_rectangle(XEN cr, XEN rectangle)
+static Xen gxg_gtk_range_get_slider_range(Xen range, Xen ignore_slider_start, Xen ignore_slider_end)
{
- #define H_gdk_cairo_rectangle "void gdk_cairo_rectangle(cairo_t* cr, GdkRectangle* rectangle)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "gdk_cairo_rectangle", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rectangle), rectangle, 2, "gdk_cairo_rectangle", "GdkRectangle*");
- gdk_cairo_rectangle(XEN_TO_C_cairo_t_(cr), XEN_TO_C_GdkRectangle_(rectangle));
- return(XEN_FALSE);
+ #define H_gtk_range_get_slider_range "void gtk_range_get_slider_range(GtkRange* range, gint* [slider_start], \
+gint* [slider_end])"
+ gint ref_slider_start;
+ gint ref_slider_end;
+ Xen_check_type(Xen_is_GtkRange_(range), range, 1, "gtk_range_get_slider_range", "GtkRange*");
+ gtk_range_get_slider_range(Xen_to_C_GtkRange_(range), &ref_slider_start, &ref_slider_end);
+ return(Xen_list_2(C_to_Xen_gint(ref_slider_start), C_to_Xen_gint(ref_slider_end)));
}
-static XEN gxg_gdk_color_to_string(XEN color)
+static Xen gxg_gtk_paned_get_handle_window(Xen paned)
{
- #define H_gdk_color_to_string "gchar* gdk_color_to_string(GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 1, "gdk_color_to_string", "GdkColor*");
- return(C_TO_XEN_gchar_(gdk_color_to_string(XEN_TO_C_GdkColor_(color))));
+ #define H_gtk_paned_get_handle_window "GdkWindow* gtk_paned_get_handle_window(GtkPaned* paned)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_get_handle_window", "GtkPaned*");
+ return(C_to_Xen_GdkWindow_(gtk_paned_get_handle_window(Xen_to_C_GtkPaned_(paned))));
}
-static XEN gxg_gdk_event_request_motions(XEN event)
+static Xen gxg_gtk_widget_set_realized(Xen widget, Xen realized)
{
- #define H_gdk_event_request_motions "void gdk_event_request_motions(GdkEventMotion* event)"
- XEN_ASSERT_TYPE(XEN_GdkEventMotion__P(event), event, 1, "gdk_event_request_motions", "GdkEventMotion*");
- gdk_event_request_motions(XEN_TO_C_GdkEventMotion_(event));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_realized "void gtk_widget_set_realized(GtkWidget* widget, gboolean realized)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_realized", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(realized), realized, 2, "gtk_widget_set_realized", "gboolean");
+ gtk_widget_set_realized(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(realized));
+ return(Xen_false);
}
-static XEN gxg_gdk_notify_startup_complete_with_id(XEN startup_id)
+static Xen gxg_gtk_widget_get_realized(Xen widget)
{
- #define H_gdk_notify_startup_complete_with_id "void gdk_notify_startup_complete_with_id(gchar* startup_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(startup_id), startup_id, 1, "gdk_notify_startup_complete_with_id", "gchar*");
- gdk_notify_startup_complete_with_id(XEN_TO_C_gchar_(startup_id));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_realized "gboolean gtk_widget_get_realized(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_realized", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_realized(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gdk_threads_add_idle_full(XEN priority, XEN func, XEN func_info, XEN notify)
+static Xen gxg_gtk_widget_set_mapped(Xen widget, Xen mapped)
{
- #define H_gdk_threads_add_idle_full "guint gdk_threads_add_idle_full(gint priority, GSourceFunc func, \
-lambda_data func_info, GDestroyNotify notify)"
- XEN_ASSERT_TYPE(XEN_gint_P(priority), priority, 1, "gdk_threads_add_idle_full", "gint");
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(func), func, 2, "gdk_threads_add_idle_full", "GSourceFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gdk_threads_add_idle_full", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(notify), notify, 4, "gdk_threads_add_idle_full", "GDestroyNotify");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(gdk_threads_add_idle_full(XEN_TO_C_gint(priority), XEN_TO_C_GSourceFunc(func), XEN_TO_C_lambda_data(func_info),
- XEN_TO_C_GDestroyNotify(notify)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gtk_widget_set_mapped "void gtk_widget_set_mapped(GtkWidget* widget, gboolean mapped)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_mapped", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(mapped), mapped, 2, "gtk_widget_set_mapped", "gboolean");
+ gtk_widget_set_mapped(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(mapped));
+ return(Xen_false);
}
-static XEN gxg_gdk_threads_add_idle(XEN func, XEN func_info)
+static Xen gxg_gtk_widget_get_mapped(Xen widget)
{
- #define H_gdk_threads_add_idle "guint gdk_threads_add_idle(GSourceFunc func, lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(func), func, 1, "gdk_threads_add_idle", "GSourceFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 2, "gdk_threads_add_idle", "lambda_data");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(gdk_threads_add_idle(XEN_TO_C_GSourceFunc(func), XEN_TO_C_lambda_data(func_info)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gtk_widget_get_mapped "gboolean gtk_widget_get_mapped(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_mapped", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_mapped(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gdk_threads_add_timeout_full(XEN priority, XEN interval, XEN func, XEN func_info, XEN notify)
+#endif
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+static Xen gxg_gdk_cairo_create(Xen window)
{
- #define H_gdk_threads_add_timeout_full "guint gdk_threads_add_timeout_full(gint priority, guint interval, \
-GSourceFunc func, lambda_data func_info, GDestroyNotify notify)"
- XEN_ASSERT_TYPE(XEN_gint_P(priority), priority, 1, "gdk_threads_add_timeout_full", "gint");
- XEN_ASSERT_TYPE(XEN_guint_P(interval), interval, 2, "gdk_threads_add_timeout_full", "guint");
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(func), func, 3, "gdk_threads_add_timeout_full", "GSourceFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gdk_threads_add_timeout_full", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(notify), notify, 5, "gdk_threads_add_timeout_full", "GDestroyNotify");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(gdk_threads_add_timeout_full(XEN_TO_C_gint(priority), XEN_TO_C_guint(interval), XEN_TO_C_GSourceFunc(func),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GDestroyNotify(notify)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gdk_cairo_create "cairo_t* gdk_cairo_create(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_cairo_create", "GdkWindow*");
+ return(C_to_Xen_cairo_t_(gdk_cairo_create(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gdk_threads_add_timeout(XEN interval, XEN func, XEN func_info)
+static Xen gxg_gdk_window_get_geometry(Xen window, Xen ignore_x, Xen ignore_y, Xen ignore_width, Xen ignore_height)
{
- #define H_gdk_threads_add_timeout "guint gdk_threads_add_timeout(guint interval, GSourceFunc func, \
-lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_guint_P(interval), interval, 1, "gdk_threads_add_timeout", "guint");
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(func), func, 2, "gdk_threads_add_timeout", "GSourceFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gdk_threads_add_timeout", "lambda_data");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(func, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(gdk_threads_add_timeout(XEN_TO_C_guint(interval), XEN_TO_C_GSourceFunc(func), XEN_TO_C_lambda_data(func_info)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gdk_window_get_geometry "void gdk_window_get_geometry(GdkWindow* window, gint* [x], gint* [y], \
+gint* [width], gint* [height])"
+ gint ref_x;
+ gint ref_y;
+ gint ref_width;
+ gint ref_height;
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_geometry", "GdkWindow*");
+ gdk_window_get_geometry(Xen_to_C_GdkWindow_(window), &ref_x, &ref_y, &ref_width, &ref_height);
+ return(Xen_list_4(C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y), C_to_Xen_gint(ref_width), C_to_Xen_gint(ref_height)));
}
-static XEN gxg_gdk_window_set_startup_id(XEN window, XEN startup_id)
+static Xen gxg_gdk_keymap_add_virtual_modifiers(Xen keymap, Xen state)
{
- #define H_gdk_window_set_startup_id "void gdk_window_set_startup_id(GdkWindow* window, gchar* startup_id)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_startup_id", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(startup_id), startup_id, 2, "gdk_window_set_startup_id", "gchar*");
- gdk_window_set_startup_id(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gchar_(startup_id));
- return(XEN_FALSE);
+ #define H_gdk_keymap_add_virtual_modifiers "void gdk_keymap_add_virtual_modifiers(GdkKeymap* keymap, \
+GdkModifierType* state)"
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_add_virtual_modifiers", "GdkKeymap*");
+ Xen_check_type(Xen_is_GdkModifierType_(state), state, 2, "gdk_keymap_add_virtual_modifiers", "GdkModifierType*");
+ gdk_keymap_add_virtual_modifiers(Xen_to_C_GdkKeymap_(keymap), Xen_to_C_GdkModifierType_(state));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_beep(XEN window)
+static Xen gxg_gdk_window_coords_to_parent(Xen window, Xen x, Xen y, Xen ignore_parent_x, Xen ignore_parent_y)
{
- #define H_gdk_window_beep "void gdk_window_beep(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_beep", "GdkWindow*");
- gdk_window_beep(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gdk_window_coords_to_parent "void gdk_window_coords_to_parent(GdkWindow* window, gdouble x, \
+gdouble y, gdouble* [parent_x], gdouble* [parent_y])"
+ gdouble ref_parent_x;
+ gdouble ref_parent_y;
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_coords_to_parent", "GdkWindow*");
+ Xen_check_type(Xen_is_gdouble(x), x, 2, "gdk_window_coords_to_parent", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 3, "gdk_window_coords_to_parent", "gdouble");
+ gdk_window_coords_to_parent(Xen_to_C_GdkWindow_(window), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y), &ref_parent_x, &ref_parent_y);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_parent_x), C_to_Xen_gdouble(ref_parent_y)));
}
-static XEN gxg_gdk_window_set_opacity(XEN window, XEN opacity)
+static Xen gxg_gdk_window_coords_from_parent(Xen window, Xen parent_x, Xen parent_y, Xen ignore_x, Xen ignore_y)
{
- #define H_gdk_window_set_opacity "void gdk_window_set_opacity(GdkWindow* window, gdouble opacity)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_opacity", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(opacity), opacity, 2, "gdk_window_set_opacity", "gdouble");
- gdk_window_set_opacity(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gdouble(opacity));
- return(XEN_FALSE);
+ #define H_gdk_window_coords_from_parent "void gdk_window_coords_from_parent(GdkWindow* window, gdouble parent_x, \
+gdouble parent_y, gdouble* [x], gdouble* [y])"
+ gdouble ref_x;
+ gdouble ref_y;
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_coords_from_parent", "GdkWindow*");
+ Xen_check_type(Xen_is_gdouble(parent_x), parent_x, 2, "gdk_window_coords_from_parent", "gdouble");
+ Xen_check_type(Xen_is_gdouble(parent_y), parent_y, 3, "gdk_window_coords_from_parent", "gdouble");
+ gdk_window_coords_from_parent(Xen_to_C_GdkWindow_(window), Xen_to_C_gdouble(parent_x), Xen_to_C_gdouble(parent_y), &ref_x,
+ &ref_y);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
}
-static XEN gxg_gtk_action_create_menu(XEN action)
+static Xen gxg_gdk_window_get_effective_parent(Xen window)
{
- #define H_gtk_action_create_menu "GtkWidget* gtk_action_create_menu(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_create_menu", "GtkAction*");
- return(C_TO_XEN_GtkWidget_(gtk_action_create_menu(XEN_TO_C_GtkAction_(action))));
+ #define H_gdk_window_get_effective_parent "GdkWindow* gdk_window_get_effective_parent(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_effective_parent", "GdkWindow*");
+ return(C_to_Xen_GdkWindow_(gdk_window_get_effective_parent(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_binding_entry_skip(XEN binding_set, XEN keyval, XEN modifiers)
+static Xen gxg_gdk_window_get_effective_toplevel(Xen window)
{
- #define H_gtk_binding_entry_skip "void gtk_binding_entry_skip(GtkBindingSet* binding_set, guint keyval, \
-GdkModifierType modifiers)"
- XEN_ASSERT_TYPE(XEN_GtkBindingSet__P(binding_set), binding_set, 1, "gtk_binding_entry_skip", "GtkBindingSet*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_binding_entry_skip", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifiers), modifiers, 3, "gtk_binding_entry_skip", "GdkModifierType");
- gtk_binding_entry_skip(XEN_TO_C_GtkBindingSet_(binding_set), XEN_TO_C_guint(keyval), XEN_TO_C_GdkModifierType(modifiers));
- return(XEN_FALSE);
+ #define H_gdk_window_get_effective_toplevel "GdkWindow* gdk_window_get_effective_toplevel(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_effective_toplevel", "GdkWindow*");
+ return(C_to_Xen_GdkWindow_(gdk_window_get_effective_toplevel(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_cell_layout_get_cells(XEN cell_layout)
+static Xen gxg_gtk_accessible_get_widget(Xen accessible)
{
- #define H_gtk_cell_layout_get_cells "GList* gtk_cell_layout_get_cells(GtkCellLayout* cell_layout)"
- XEN_ASSERT_TYPE(XEN_GtkCellLayout__P(cell_layout), cell_layout, 1, "gtk_cell_layout_get_cells", "GtkCellLayout*");
- return(C_TO_XEN_GList_(gtk_cell_layout_get_cells(XEN_TO_C_GtkCellLayout_(cell_layout))));
+ #define H_gtk_accessible_get_widget "GtkWidget* gtk_accessible_get_widget(GtkAccessible* accessible)"
+ Xen_check_type(Xen_is_GtkAccessible_(accessible), accessible, 1, "gtk_accessible_get_widget", "GtkAccessible*");
+ return(C_to_Xen_GtkWidget_(gtk_accessible_get_widget(Xen_to_C_GtkAccessible_(accessible))));
}
-static XEN gxg_gtk_entry_completion_set_inline_selection(XEN completion, XEN inline_selection)
+static Xen gxg_gtk_widget_send_focus_change(Xen widget, Xen event)
{
- #define H_gtk_entry_completion_set_inline_selection "void gtk_entry_completion_set_inline_selection(GtkEntryCompletion* completion, \
-gboolean inline_selection)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_set_inline_selection", "GtkEntryCompletion*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(inline_selection), inline_selection, 2, "gtk_entry_completion_set_inline_selection", "gboolean");
- gtk_entry_completion_set_inline_selection(XEN_TO_C_GtkEntryCompletion_(completion), XEN_TO_C_gboolean(inline_selection));
- return(XEN_FALSE);
+ #define H_gtk_widget_send_focus_change "gboolean gtk_widget_send_focus_change(GtkWidget* widget, GdkEvent* event)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_send_focus_change", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gtk_widget_send_focus_change", "GdkEvent*");
+ return(C_to_Xen_gboolean(gtk_widget_send_focus_change(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_entry_completion_get_inline_selection(XEN completion)
+static Xen gxg_gdk_display_get_device_manager(Xen display)
{
- #define H_gtk_entry_completion_get_inline_selection "gboolean gtk_entry_completion_get_inline_selection(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_inline_selection", "GtkEntryCompletion*");
- return(C_TO_XEN_gboolean(gtk_entry_completion_get_inline_selection(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gdk_display_get_device_manager "GdkDeviceManager* gdk_display_get_device_manager(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_get_device_manager", "GdkDisplay*");
+ return(C_to_Xen_GdkDeviceManager_(gdk_display_get_device_manager(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_gtk_entry_completion_get_completion_prefix(XEN completion)
+static Xen gxg_gdk_drag_context_set_device(Xen context, Xen device)
{
- #define H_gtk_entry_completion_get_completion_prefix "gchar* gtk_entry_completion_get_completion_prefix(GtkEntryCompletion* completion)"
- XEN_ASSERT_TYPE(XEN_GtkEntryCompletion__P(completion), completion, 1, "gtk_entry_completion_get_completion_prefix", "GtkEntryCompletion*");
- return(C_TO_XEN_gchar_(gtk_entry_completion_get_completion_prefix(XEN_TO_C_GtkEntryCompletion_(completion))));
+ #define H_gdk_drag_context_set_device "void gdk_drag_context_set_device(GdkDragContext* context, GdkDevice* device)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_context_set_device", "GdkDragContext*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_drag_context_set_device", "GdkDevice*");
+ gdk_drag_context_set_device(Xen_to_C_GdkDragContext_(context), Xen_to_C_GdkDevice_(device));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_cursor_hadjustment(XEN entry, XEN adjustment)
+static Xen gxg_gdk_drag_context_get_device(Xen context)
{
- #define H_gtk_entry_set_cursor_hadjustment "void gtk_entry_set_cursor_hadjustment(GtkEntry* entry, \
-GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_cursor_hadjustment", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 2, "gtk_entry_set_cursor_hadjustment", "GtkAdjustment*");
- gtk_entry_set_cursor_hadjustment(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkAdjustment_(adjustment));
- return(XEN_FALSE);
+ #define H_gdk_drag_context_get_device "GdkDevice* gdk_drag_context_get_device(GdkDragContext* context)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_context_get_device", "GdkDragContext*");
+ return(C_to_Xen_GdkDevice_(gdk_drag_context_get_device(Xen_to_C_GdkDragContext_(context))));
}
-static XEN gxg_gtk_entry_get_cursor_hadjustment(XEN entry)
+static Xen gxg_gdk_drag_context_list_targets(Xen context)
{
- #define H_gtk_entry_get_cursor_hadjustment "GtkAdjustment* gtk_entry_get_cursor_hadjustment(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_cursor_hadjustment", "GtkEntry*");
- return(C_TO_XEN_GtkAdjustment_(gtk_entry_get_cursor_hadjustment(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gdk_drag_context_list_targets "GList* gdk_drag_context_list_targets(GdkDragContext* context)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_context_list_targets", "GdkDragContext*");
+ return(C_to_Xen_GList_(gdk_drag_context_list_targets(Xen_to_C_GdkDragContext_(context))));
}
-static XEN gxg_gtk_icon_theme_list_contexts(XEN icon_theme)
+static Xen gxg_gdk_event_set_device(Xen event, Xen device)
{
- #define H_gtk_icon_theme_list_contexts "GList* gtk_icon_theme_list_contexts(GtkIconTheme* icon_theme)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_list_contexts", "GtkIconTheme*");
- return(C_TO_XEN_GList_(gtk_icon_theme_list_contexts(XEN_TO_C_GtkIconTheme_(icon_theme))));
+ #define H_gdk_event_set_device "void gdk_event_set_device(GdkEvent* event, GdkDevice* device)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_set_device", "GdkEvent*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_event_set_device", "GdkDevice*");
+ gdk_event_set_device(Xen_to_C_GdkEvent_(event), Xen_to_C_GdkDevice_(device));
+ return(Xen_false);
}
-static XEN gxg_gtk_page_setup_new_from_file(XEN file_name, XEN ignore_error)
+static Xen gxg_gdk_event_get_device(Xen event)
{
- #define H_gtk_page_setup_new_from_file "GtkPageSetup* gtk_page_setup_new_from_file(gchar* file_name, \
-GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_gchar__P(file_name), file_name, 1, "gtk_page_setup_new_from_file", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GtkPageSetup_(gtk_page_setup_new_from_file(XEN_TO_C_gchar_(file_name), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gdk_event_get_device "GdkDevice* gdk_event_get_device(GdkEvent* event)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_device", "GdkEvent*");
+ return(C_to_Xen_GdkDevice_(gdk_event_get_device(Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_page_setup_to_file(XEN setup, XEN file_name, XEN ignore_error)
+static Xen gxg_gdk_events_get_distance(Xen event1, Xen event2, Xen ignore_distance)
{
- #define H_gtk_page_setup_to_file "gboolean gtk_page_setup_to_file(GtkPageSetup* setup, char* file_name, \
-GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkPageSetup__P(setup), setup, 1, "gtk_page_setup_to_file", "GtkPageSetup*");
- XEN_ASSERT_TYPE(XEN_char__P(file_name), file_name, 2, "gtk_page_setup_to_file", "char*");
+ #define H_gdk_events_get_distance "gboolean gdk_events_get_distance(GdkEvent* event1, GdkEvent* event2, \
+gdouble* [distance])"
+ gdouble ref_distance;
+ Xen_check_type(Xen_is_GdkEvent_(event1), event1, 1, "gdk_events_get_distance", "GdkEvent*");
+ Xen_check_type(Xen_is_GdkEvent_(event2), event2, 2, "gdk_events_get_distance", "GdkEvent*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_page_setup_to_file(XEN_TO_C_GtkPageSetup_(setup), XEN_TO_C_char_(file_name), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_events_get_distance(Xen_to_C_GdkEvent_(event1), Xen_to_C_GdkEvent_(event2), &ref_distance));
+ return(Xen_list_2(result, C_to_Xen_gdouble(ref_distance)));
}
}
-static XEN gxg_gtk_print_settings_new_from_file(XEN file_name, XEN ignore_error)
+static Xen gxg_gdk_events_get_angle(Xen event1, Xen event2, Xen ignore_angle)
{
- #define H_gtk_print_settings_new_from_file "GtkPrintSettings* gtk_print_settings_new_from_file(gchar* file_name, \
-GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_gchar__P(file_name), file_name, 1, "gtk_print_settings_new_from_file", "gchar*");
+ #define H_gdk_events_get_angle "gboolean gdk_events_get_angle(GdkEvent* event1, GdkEvent* event2, gdouble* [angle])"
+ gdouble ref_angle;
+ Xen_check_type(Xen_is_GdkEvent_(event1), event1, 1, "gdk_events_get_angle", "GdkEvent*");
+ Xen_check_type(Xen_is_GdkEvent_(event2), event2, 2, "gdk_events_get_angle", "GdkEvent*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GtkPrintSettings_(gtk_print_settings_new_from_file(XEN_TO_C_gchar_(file_name), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_events_get_angle(Xen_to_C_GdkEvent_(event1), Xen_to_C_GdkEvent_(event2), &ref_angle));
+ return(Xen_list_2(result, C_to_Xen_gdouble(ref_angle)));
}
}
-static XEN gxg_gtk_print_settings_to_file(XEN settings, XEN file_name, XEN ignore_error)
+static Xen gxg_gdk_events_get_center(Xen event1, Xen event2, Xen ignore_x, Xen ignore_y)
{
- #define H_gtk_print_settings_to_file "gboolean gtk_print_settings_to_file(GtkPrintSettings* settings, \
-gchar* file_name, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkPrintSettings__P(settings), settings, 1, "gtk_print_settings_to_file", "GtkPrintSettings*");
- XEN_ASSERT_TYPE(XEN_gchar__P(file_name), file_name, 2, "gtk_print_settings_to_file", "gchar*");
+ #define H_gdk_events_get_center "gboolean gdk_events_get_center(GdkEvent* event1, GdkEvent* event2, \
+gdouble* [x], gdouble* [y])"
+ gdouble ref_x;
+ gdouble ref_y;
+ Xen_check_type(Xen_is_GdkEvent_(event1), event1, 1, "gdk_events_get_center", "GdkEvent*");
+ Xen_check_type(Xen_is_GdkEvent_(event2), event2, 2, "gdk_events_get_center", "GdkEvent*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_print_settings_to_file(XEN_TO_C_GtkPrintSettings_(settings), XEN_TO_C_gchar_(file_name),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_events_get_center(Xen_to_C_GdkEvent_(event1), Xen_to_C_GdkEvent_(event2), &ref_x, &ref_y));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
}
}
-static XEN gxg_gtk_range_set_show_fill_level(XEN range, XEN show_fill_level)
-{
- #define H_gtk_range_set_show_fill_level "void gtk_range_set_show_fill_level(GtkRange* range, gboolean, \
-show_fill_level)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_show_fill_level", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_fill_level), show_fill_level, 2, "gtk_range_set_show_fill_level", "gboolean");
- gtk_range_set_show_fill_level(XEN_TO_C_GtkRange_(range), XEN_TO_C_gboolean(show_fill_level));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_range_get_show_fill_level(XEN range)
-{
- #define H_gtk_range_get_show_fill_level "gboolean gtk_range_get_show_fill_level(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_show_fill_level", "GtkRange*");
- return(C_TO_XEN_gboolean(gtk_range_get_show_fill_level(XEN_TO_C_GtkRange_(range))));
-}
-
-static XEN gxg_gtk_range_set_restrict_to_fill_level(XEN range, XEN restrict_to_fill_level)
-{
- #define H_gtk_range_set_restrict_to_fill_level "void gtk_range_set_restrict_to_fill_level(GtkRange* range, \
- gboolean, restrict_to_fill_level)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_restrict_to_fill_level", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(restrict_to_fill_level), restrict_to_fill_level, 2, "gtk_range_set_restrict_to_fill_level", "gboolean");
- gtk_range_set_restrict_to_fill_level(XEN_TO_C_GtkRange_(range), XEN_TO_C_gboolean(restrict_to_fill_level));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_range_get_restrict_to_fill_level(XEN range)
-{
- #define H_gtk_range_get_restrict_to_fill_level "gboolean gtk_range_get_restrict_to_fill_level(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_restrict_to_fill_level", "GtkRange*");
- return(C_TO_XEN_gboolean(gtk_range_get_restrict_to_fill_level(XEN_TO_C_GtkRange_(range))));
-}
-
-static XEN gxg_gtk_range_set_fill_level(XEN range, XEN fill_level)
+static Xen gxg_gdk_window_get_accept_focus(Xen window)
{
- #define H_gtk_range_set_fill_level "void gtk_range_set_fill_level(GtkRange* range, gdouble, fill_level)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_fill_level", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(fill_level), fill_level, 2, "gtk_range_set_fill_level", "gdouble");
- gtk_range_set_fill_level(XEN_TO_C_GtkRange_(range), XEN_TO_C_gdouble(fill_level));
- return(XEN_FALSE);
+ #define H_gdk_window_get_accept_focus "gboolean gdk_window_get_accept_focus(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_accept_focus", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_get_accept_focus(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_range_get_fill_level(XEN range)
+static Xen gxg_gdk_window_get_focus_on_map(Xen window)
{
- #define H_gtk_range_get_fill_level "gdouble gtk_range_get_fill_level(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_fill_level", "GtkRange*");
- return(C_TO_XEN_gdouble(gtk_range_get_fill_level(XEN_TO_C_GtkRange_(range))));
+ #define H_gdk_window_get_focus_on_map "gboolean gdk_window_get_focus_on_map(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_focus_on_map", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_get_focus_on_map(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_status_icon_set_screen(XEN status_icon, XEN screen)
+static Xen gxg_gdk_window_is_input_only(Xen window)
{
- #define H_gtk_status_icon_set_screen "void gtk_status_icon_set_screen(GtkStatusIcon* status_icon, GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_screen", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 2, "gtk_status_icon_set_screen", "GdkScreen*");
- gtk_status_icon_set_screen(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_GdkScreen_(screen));
- return(XEN_FALSE);
+ #define H_gdk_window_is_input_only "gboolean gdk_window_is_input_only(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_is_input_only", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_is_input_only(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_status_icon_get_screen(XEN status_icon)
+static Xen gxg_gdk_window_is_shaped(Xen window)
{
- #define H_gtk_status_icon_get_screen "GdkScreen* gtk_status_icon_get_screen(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_screen", "GtkStatusIcon*");
- return(C_TO_XEN_GdkScreen_(gtk_status_icon_get_screen(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gdk_window_is_shaped "gboolean gdk_window_is_shaped(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_is_shaped", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_is_shaped(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_set_show_expanders(XEN tree_view, XEN enabled)
+static Xen gxg_gdk_window_get_modal_hint(Xen window)
{
- #define H_gtk_tree_view_set_show_expanders "void gtk_tree_view_set_show_expanders(GtkTreeView* tree_view, \
-gboolean enabled)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_show_expanders", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(enabled), enabled, 2, "gtk_tree_view_set_show_expanders", "gboolean");
- gtk_tree_view_set_show_expanders(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(enabled));
- return(XEN_FALSE);
+ #define H_gdk_window_get_modal_hint "gboolean gdk_window_get_modal_hint(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_modal_hint", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_get_modal_hint(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_get_show_expanders(XEN tree_view)
+static Xen gxg_gdk_window_set_device_cursor(Xen window, Xen device, Xen cursor)
{
- #define H_gtk_tree_view_get_show_expanders "gboolean gtk_tree_view_get_show_expanders(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_show_expanders", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_show_expanders(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gdk_window_set_device_cursor "void gdk_window_set_device_cursor(GdkWindow* window, GdkDevice* device, \
+GdkCursor* cursor)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_device_cursor", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_window_set_device_cursor", "GdkDevice*");
+ Xen_check_type(Xen_is_GdkCursor_(cursor), cursor, 3, "gdk_window_set_device_cursor", "GdkCursor*");
+ gdk_window_set_device_cursor(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkDevice_(device), Xen_to_C_GdkCursor_(cursor));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_level_indentation(XEN tree_view, XEN indentation)
+static Xen gxg_gdk_window_get_device_cursor(Xen window, Xen device)
{
- #define H_gtk_tree_view_set_level_indentation "void gtk_tree_view_set_level_indentation(GtkTreeView* tree_view, \
-gint indentation)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_level_indentation", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(indentation), indentation, 2, "gtk_tree_view_set_level_indentation", "gint");
- gtk_tree_view_set_level_indentation(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(indentation));
- return(XEN_FALSE);
+ #define H_gdk_window_get_device_cursor "GdkCursor* gdk_window_get_device_cursor(GdkWindow* window, \
+GdkDevice* device)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_device_cursor", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_window_get_device_cursor", "GdkDevice*");
+ return(C_to_Xen_GdkCursor_(gdk_window_get_device_cursor(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_tree_view_get_level_indentation(XEN tree_view)
+static Xen gxg_gdk_window_get_device_position(Xen window, Xen device, Xen ignore_x, Xen ignore_y, Xen ignore_mask)
{
- #define H_gtk_tree_view_get_level_indentation "gint gtk_tree_view_get_level_indentation(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_level_indentation", "GtkTreeView*");
- return(C_TO_XEN_gint(gtk_tree_view_get_level_indentation(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gdk_window_get_device_position "GdkWindow* gdk_window_get_device_position(GdkWindow* window, \
+GdkDevice* device, gint* [x], gint* [y], GdkModifierType* [mask])"
+ gint ref_x;
+ gint ref_y;
+ GdkModifierType ref_mask;
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_device_position", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_window_get_device_position", "GdkDevice*");
+ {
+ Xen result;
+ result = C_to_Xen_GdkWindow_(gdk_window_get_device_position(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkDevice_(device),
+ &ref_x, &ref_y, &ref_mask));
+ return(Xen_list_4(result, C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y), C_to_Xen_GdkModifierType(ref_mask)));
+ }
}
-static XEN gxg_gtk_widget_keynav_failed(XEN widget, XEN direction)
+static Xen gxg_gdk_window_set_device_events(Xen window, Xen device, Xen event_mask)
{
- #define H_gtk_widget_keynav_failed "gboolean gtk_widget_keynav_failed(GtkWidget* widget, GtkDirectionType direction)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_keynav_failed", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkDirectionType_P(direction), direction, 2, "gtk_widget_keynav_failed", "GtkDirectionType");
- return(C_TO_XEN_gboolean(gtk_widget_keynav_failed(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkDirectionType(direction))));
+ #define H_gdk_window_set_device_events "void gdk_window_set_device_events(GdkWindow* window, GdkDevice* device, \
+GdkEventMask event_mask)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_device_events", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_window_set_device_events", "GdkDevice*");
+ Xen_check_type(Xen_is_GdkEventMask(event_mask), event_mask, 3, "gdk_window_set_device_events", "GdkEventMask");
+ gdk_window_set_device_events(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkDevice_(device), Xen_to_C_GdkEventMask(event_mask));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_error_bell(XEN widget)
+static Xen gxg_gdk_window_get_device_events(Xen window, Xen device)
{
- #define H_gtk_widget_error_bell "void gtk_widget_error_bell(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_error_bell", "GtkWidget*");
- gtk_widget_error_bell(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gdk_window_get_device_events "GdkEventMask gdk_window_get_device_events(GdkWindow* window, \
+GdkDevice* device)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_device_events", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_window_get_device_events", "GdkDevice*");
+ return(C_to_Xen_GdkEventMask(gdk_window_get_device_events(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_widget_set_tooltip_window(XEN widget, XEN custom_window)
+static Xen gxg_gtk_combo_box_popup_for_device(Xen combo_box, Xen device)
{
- #define H_gtk_widget_set_tooltip_window "void gtk_widget_set_tooltip_window(GtkWidget* widget, GtkWindow* custom_window)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_tooltip_window", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(custom_window), custom_window, 2, "gtk_widget_set_tooltip_window", "GtkWindow*");
- gtk_widget_set_tooltip_window(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkWindow_(custom_window));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_popup_for_device "void gtk_combo_box_popup_for_device(GtkComboBox* combo_box, \
+GdkDevice* device)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_popup_for_device", "GtkComboBox*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_combo_box_popup_for_device", "GdkDevice*");
+ gtk_combo_box_popup_for_device(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_GdkDevice_(device));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_tooltip_window(XEN widget)
+static Xen gxg_gtk_device_grab_add(Xen widget, Xen device, Xen block_others)
{
- #define H_gtk_widget_get_tooltip_window "GtkWindow* gtk_widget_get_tooltip_window(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_tooltip_window", "GtkWidget*");
- return(C_TO_XEN_GtkWindow_(gtk_widget_get_tooltip_window(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_device_grab_add "void gtk_device_grab_add(GtkWidget* widget, GdkDevice* device, gboolean block_others)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_device_grab_add", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_device_grab_add", "GdkDevice*");
+ Xen_check_type(Xen_is_gboolean(block_others), block_others, 3, "gtk_device_grab_add", "gboolean");
+ gtk_device_grab_add(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDevice_(device), Xen_to_C_gboolean(block_others));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_trigger_tooltip_query(XEN widget)
+static Xen gxg_gtk_device_grab_remove(Xen widget, Xen device)
{
- #define H_gtk_widget_trigger_tooltip_query "void gtk_widget_trigger_tooltip_query(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_trigger_tooltip_query", "GtkWidget*");
- gtk_widget_trigger_tooltip_query(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_device_grab_remove "void gtk_device_grab_remove(GtkWidget* widget, GdkDevice* device)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_device_grab_remove", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_device_grab_remove", "GdkDevice*");
+ gtk_device_grab_remove(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDevice_(device));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_startup_id(XEN window, XEN startup_id)
+static Xen gxg_gtk_get_current_event_device(void)
{
- #define H_gtk_window_set_startup_id "void gtk_window_set_startup_id(GtkWindow* window, gchar* startup_id)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_startup_id", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(startup_id), startup_id, 2, "gtk_window_set_startup_id", "gchar*");
- gtk_window_set_startup_id(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gchar_(startup_id));
- return(XEN_FALSE);
+ #define H_gtk_get_current_event_device "GdkDevice* gtk_get_current_event_device( void)"
+ return(C_to_Xen_GdkDevice_(gtk_get_current_event_device()));
}
-static XEN gxg_gtk_window_set_opacity(XEN window, XEN opacity)
+static Xen gxg_gtk_paned_new(Xen orientation)
{
- #define H_gtk_window_set_opacity "void gtk_window_set_opacity(GtkWindow* window, gdouble opacity)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_opacity", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(opacity), opacity, 2, "gtk_window_set_opacity", "gdouble");
- gtk_window_set_opacity(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gdouble(opacity));
- return(XEN_FALSE);
+ #define H_gtk_paned_new "GtkWidget* gtk_paned_new(GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 1, "gtk_paned_new", "GtkOrientation");
+ return(C_to_Xen_GtkWidget_(gtk_paned_new(Xen_to_C_GtkOrientation(orientation))));
}
-static XEN gxg_gtk_window_get_opacity(XEN window)
+static Xen gxg_gtk_scale_new(Xen orientation, Xen adjustment)
{
- #define H_gtk_window_get_opacity "gdouble gtk_window_get_opacity(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_opacity", "GtkWindow*");
- return(C_TO_XEN_gdouble(gtk_window_get_opacity(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_scale_new "GtkWidget* gtk_scale_new(GtkOrientation orientation, GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 1, "gtk_scale_new", "GtkOrientation");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_scale_new", "GtkAdjustment*");
+ return(C_to_Xen_GtkWidget_(gtk_scale_new(Xen_to_C_GtkOrientation(orientation), Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gdk_display_supports_composite(XEN display)
+static Xen gxg_gtk_scale_new_with_range(Xen orientation, Xen min, Xen max, Xen step)
{
- #define H_gdk_display_supports_composite "gboolean gdk_display_supports_composite(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_supports_composite", "GdkDisplay*");
- return(C_TO_XEN_gboolean(gdk_display_supports_composite(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_scale_new_with_range "GtkWidget* gtk_scale_new_with_range(GtkOrientation orientation, \
+gdouble min, gdouble max, gdouble step)"
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 1, "gtk_scale_new_with_range", "GtkOrientation");
+ Xen_check_type(Xen_is_gdouble(min), min, 2, "gtk_scale_new_with_range", "gdouble");
+ Xen_check_type(Xen_is_gdouble(max), max, 3, "gtk_scale_new_with_range", "gdouble");
+ Xen_check_type(Xen_is_gdouble(step), step, 4, "gtk_scale_new_with_range", "gdouble");
+ return(C_to_Xen_GtkWidget_(gtk_scale_new_with_range(Xen_to_C_GtkOrientation(orientation), Xen_to_C_gdouble(min), Xen_to_C_gdouble(max),
+ Xen_to_C_gdouble(step))));
}
-static XEN gxg_gdk_window_set_composited(XEN window, XEN composited)
+static Xen gxg_gtk_scrollbar_new(Xen orientation, Xen adjustment)
{
- #define H_gdk_window_set_composited "void gdk_window_set_composited(GdkWindow* window, gboolean composited)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_composited", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(composited), composited, 2, "gdk_window_set_composited", "gboolean");
- gdk_window_set_composited(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(composited));
- return(XEN_FALSE);
+ #define H_gtk_scrollbar_new "GtkWidget* gtk_scrollbar_new(GtkOrientation orientation, GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 1, "gtk_scrollbar_new", "GtkOrientation");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_scrollbar_new", "GtkAdjustment*");
+ return(C_to_Xen_GtkWidget_(gtk_scrollbar_new(Xen_to_C_GtkOrientation(orientation), Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gtk_text_buffer_add_mark(XEN buffer, XEN mark, XEN where)
+static Xen gxg_gtk_separator_new(Xen orientation)
{
- #define H_gtk_text_buffer_add_mark "void gtk_text_buffer_add_mark(GtkTextBuffer* buffer, GtkTextMark* mark, \
-GtkTextIter* where)"
- XEN_ASSERT_TYPE(XEN_GtkTextBuffer__P(buffer), buffer, 1, "gtk_text_buffer_add_mark", "GtkTextBuffer*");
- XEN_ASSERT_TYPE(XEN_GtkTextMark__P(mark), mark, 2, "gtk_text_buffer_add_mark", "GtkTextMark*");
- XEN_ASSERT_TYPE(XEN_GtkTextIter__P(where), where, 3, "gtk_text_buffer_add_mark", "GtkTextIter*");
- gtk_text_buffer_add_mark(XEN_TO_C_GtkTextBuffer_(buffer), XEN_TO_C_GtkTextMark_(mark), XEN_TO_C_GtkTextIter_(where));
- return(XEN_FALSE);
+ #define H_gtk_separator_new "GtkWidget* gtk_separator_new(GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 1, "gtk_separator_new", "GtkOrientation");
+ return(C_to_Xen_GtkWidget_(gtk_separator_new(Xen_to_C_GtkOrientation(orientation))));
}
-static XEN gxg_gtk_text_mark_new(XEN name, XEN left_gravity)
+static Xen gxg_gtk_widget_device_is_shadowed(Xen widget, Xen device)
{
- #define H_gtk_text_mark_new "GtkTextMark* gtk_text_mark_new(gchar* name, gboolean left_gravity)"
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 1, "gtk_text_mark_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(left_gravity), left_gravity, 2, "gtk_text_mark_new", "gboolean");
- return(C_TO_XEN_GtkTextMark_(gtk_text_mark_new(XEN_TO_C_gchar_(name), XEN_TO_C_gboolean(left_gravity))));
+ #define H_gtk_widget_device_is_shadowed "gboolean gtk_widget_device_is_shadowed(GtkWidget* widget, \
+GdkDevice* device)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_device_is_shadowed", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_widget_device_is_shadowed", "GdkDevice*");
+ return(C_to_Xen_gboolean(gtk_widget_device_is_shadowed(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_tree_view_column_get_tree_view(XEN tree_column)
+static Xen gxg_gtk_widget_set_device_events(Xen widget, Xen device, Xen events)
{
- #define H_gtk_tree_view_column_get_tree_view "GtkWidget* gtk_tree_view_column_get_tree_view(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_tree_view", "GtkTreeViewColumn*");
- return(C_TO_XEN_GtkWidget_(gtk_tree_view_column_get_tree_view(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_widget_set_device_events "void gtk_widget_set_device_events(GtkWidget* widget, GdkDevice* device, \
+GdkEventMask events)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_device_events", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_widget_set_device_events", "GdkDevice*");
+ Xen_check_type(Xen_is_GdkEventMask(events), events, 3, "gtk_widget_set_device_events", "GdkEventMask");
+ gtk_widget_set_device_events(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDevice_(device), Xen_to_C_GdkEventMask(events));
+ return(Xen_false);
}
-static XEN gxg_gtk_tooltip_set_text(XEN tooltip, XEN text)
+static Xen gxg_gtk_widget_add_device_events(Xen widget, Xen device, Xen events)
{
- #define H_gtk_tooltip_set_text "void gtk_tooltip_set_text(GtkTooltip* tooltip, gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 1, "gtk_tooltip_set_text", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_tooltip_set_text", "gchar*");
- gtk_tooltip_set_text(XEN_TO_C_GtkTooltip_(tooltip), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_widget_add_device_events "void gtk_widget_add_device_events(GtkWidget* widget, GdkDevice* device, \
+GdkEventMask events)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_add_device_events", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_widget_add_device_events", "GdkDevice*");
+ Xen_check_type(Xen_is_GdkEventMask(events), events, 3, "gtk_widget_add_device_events", "GdkEventMask");
+ gtk_widget_add_device_events(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDevice_(device), Xen_to_C_GdkEventMask(events));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_convert_widget_to_tree_coords(XEN tree_view, XEN wx, XEN wy, XEN ignore_tx, XEN ignore_ty)
+static Xen gxg_gtk_widget_get_support_multidevice(Xen widget)
{
- #define H_gtk_tree_view_convert_widget_to_tree_coords "void gtk_tree_view_convert_widget_to_tree_coords(GtkTreeView* tree_view, \
-gint wx, gint wy, gint* [tx], gint* [ty])"
- gint ref_tx;
- gint ref_ty;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_convert_widget_to_tree_coords", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(wx), wx, 2, "gtk_tree_view_convert_widget_to_tree_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(wy), wy, 3, "gtk_tree_view_convert_widget_to_tree_coords", "gint");
- gtk_tree_view_convert_widget_to_tree_coords(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(wx), XEN_TO_C_gint(wy), &ref_tx,
- &ref_ty);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_tx), C_TO_XEN_gint(ref_ty)));
+ #define H_gtk_widget_get_support_multidevice "gboolean gtk_widget_get_support_multidevice(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_support_multidevice", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_support_multidevice(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tree_view_convert_tree_to_widget_coords(XEN tree_view, XEN tx, XEN ty, XEN ignore_wx, XEN ignore_wy)
+static Xen gxg_gtk_widget_set_support_multidevice(Xen widget, Xen support_multidevice)
{
- #define H_gtk_tree_view_convert_tree_to_widget_coords "void gtk_tree_view_convert_tree_to_widget_coords(GtkTreeView* tree_view, \
-gint tx, gint ty, gint* [wx], gint* [wy])"
- gint ref_wx;
- gint ref_wy;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_convert_tree_to_widget_coords", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(tx), tx, 2, "gtk_tree_view_convert_tree_to_widget_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(ty), ty, 3, "gtk_tree_view_convert_tree_to_widget_coords", "gint");
- gtk_tree_view_convert_tree_to_widget_coords(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(tx), XEN_TO_C_gint(ty), &ref_wx,
- &ref_wy);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_wx), C_TO_XEN_gint(ref_wy)));
+ #define H_gtk_widget_set_support_multidevice "void gtk_widget_set_support_multidevice(GtkWidget* widget, \
+gboolean support_multidevice)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_support_multidevice", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(support_multidevice), support_multidevice, 2, "gtk_widget_set_support_multidevice", "gboolean");
+ gtk_widget_set_support_multidevice(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(support_multidevice));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_convert_widget_to_bin_window_coords(XEN tree_view, XEN wx, XEN wy, XEN ignore_bx, XEN ignore_by)
+static Xen gxg_gtk_widget_get_device_events(Xen widget, Xen device)
{
- #define H_gtk_tree_view_convert_widget_to_bin_window_coords "void gtk_tree_view_convert_widget_to_bin_window_coords(GtkTreeView* tree_view, \
-gint wx, gint wy, gint* [bx], gint* [by])"
- gint ref_bx;
- gint ref_by;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_convert_widget_to_bin_window_coords", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(wx), wx, 2, "gtk_tree_view_convert_widget_to_bin_window_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(wy), wy, 3, "gtk_tree_view_convert_widget_to_bin_window_coords", "gint");
- gtk_tree_view_convert_widget_to_bin_window_coords(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(wx), XEN_TO_C_gint(wy),
- &ref_bx, &ref_by);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_bx), C_TO_XEN_gint(ref_by)));
+ #define H_gtk_widget_get_device_events "GdkEventMask gtk_widget_get_device_events(GtkWidget* widget, \
+GdkDevice* device)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_device_events", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_widget_get_device_events", "GdkDevice*");
+ return(C_to_Xen_GdkEventMask(gtk_widget_get_device_events(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_tree_view_convert_bin_window_to_widget_coords(XEN tree_view, XEN bx, XEN by, XEN ignore_wx, XEN ignore_wy)
+static Xen gxg_gtk_icon_view_get_item_row(Xen icon_view, Xen path)
{
- #define H_gtk_tree_view_convert_bin_window_to_widget_coords "void gtk_tree_view_convert_bin_window_to_widget_coords(GtkTreeView* tree_view, \
-gint bx, gint by, gint* [wx], gint* [wy])"
- gint ref_wx;
- gint ref_wy;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_convert_bin_window_to_widget_coords", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(bx), bx, 2, "gtk_tree_view_convert_bin_window_to_widget_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(by), by, 3, "gtk_tree_view_convert_bin_window_to_widget_coords", "gint");
- gtk_tree_view_convert_bin_window_to_widget_coords(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(bx), XEN_TO_C_gint(by),
- &ref_wx, &ref_wy);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_wx), C_TO_XEN_gint(ref_wy)));
+ #define H_gtk_icon_view_get_item_row "gint gtk_icon_view_get_item_row(GtkIconView* icon_view, GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_item_row", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_get_item_row", "GtkTreePath*");
+ return(C_to_Xen_gint(gtk_icon_view_get_item_row(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_tree_view_convert_tree_to_bin_window_coords(XEN tree_view, XEN tx, XEN ty, XEN ignore_bx, XEN ignore_by)
+static Xen gxg_gtk_icon_view_get_item_column(Xen icon_view, Xen path)
{
- #define H_gtk_tree_view_convert_tree_to_bin_window_coords "void gtk_tree_view_convert_tree_to_bin_window_coords(GtkTreeView* tree_view, \
-gint tx, gint ty, gint* [bx], gint* [by])"
- gint ref_bx;
- gint ref_by;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_convert_tree_to_bin_window_coords", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(tx), tx, 2, "gtk_tree_view_convert_tree_to_bin_window_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(ty), ty, 3, "gtk_tree_view_convert_tree_to_bin_window_coords", "gint");
- gtk_tree_view_convert_tree_to_bin_window_coords(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(tx), XEN_TO_C_gint(ty),
- &ref_bx, &ref_by);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_bx), C_TO_XEN_gint(ref_by)));
+ #define H_gtk_icon_view_get_item_column "gint gtk_icon_view_get_item_column(GtkIconView* icon_view, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_item_column", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_get_item_column", "GtkTreePath*");
+ return(C_to_Xen_gint(gtk_icon_view_get_item_column(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_tree_view_convert_bin_window_to_tree_coords(XEN tree_view, XEN bx, XEN by, XEN ignore_tx, XEN ignore_ty)
+static Xen gxg_gtk_statusbar_remove_all(Xen statusbar, Xen context_id)
{
- #define H_gtk_tree_view_convert_bin_window_to_tree_coords "void gtk_tree_view_convert_bin_window_to_tree_coords(GtkTreeView* tree_view, \
-gint bx, gint by, gint* [tx], gint* [ty])"
- gint ref_tx;
- gint ref_ty;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_convert_bin_window_to_tree_coords", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(bx), bx, 2, "gtk_tree_view_convert_bin_window_to_tree_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(by), by, 3, "gtk_tree_view_convert_bin_window_to_tree_coords", "gint");
- gtk_tree_view_convert_bin_window_to_tree_coords(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(bx), XEN_TO_C_gint(by),
- &ref_tx, &ref_ty);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_tx), C_TO_XEN_gint(ref_ty)));
+ #define H_gtk_statusbar_remove_all "void gtk_statusbar_remove_all(GtkStatusbar* statusbar, guint context_id)"
+ Xen_check_type(Xen_is_GtkStatusbar_(statusbar), statusbar, 1, "gtk_statusbar_remove_all", "GtkStatusbar*");
+ Xen_check_type(Xen_is_guint(context_id), context_id, 2, "gtk_statusbar_remove_all", "guint");
+ gtk_statusbar_remove_all(Xen_to_C_GtkStatusbar_(statusbar), Xen_to_C_guint(context_id));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_tooltip_text(XEN widget, XEN text)
+static Xen gxg_gtk_window_has_group(Xen window)
{
- #define H_gtk_widget_set_tooltip_text "void gtk_widget_set_tooltip_text(GtkWidget* widget, gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_tooltip_text", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_widget_set_tooltip_text", "gchar*");
- gtk_widget_set_tooltip_text(XEN_TO_C_GtkWidget_(widget), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_window_has_group "gboolean gtk_window_has_group(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_has_group", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_has_group(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_widget_get_tooltip_text(XEN widget)
+static Xen gxg_gtk_calendar_select_month(Xen calendar, Xen month, Xen year)
{
- #define H_gtk_widget_get_tooltip_text "gchar* gtk_widget_get_tooltip_text(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_tooltip_text", "GtkWidget*");
- return(C_TO_XEN_gchar_(gtk_widget_get_tooltip_text(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_calendar_select_month "void gtk_calendar_select_month(GtkCalendar* calendar, guint month, \
+guint year)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_select_month", "GtkCalendar*");
+ Xen_check_type(Xen_is_guint(month), month, 2, "gtk_calendar_select_month", "guint");
+ Xen_check_type(Xen_is_guint(year), year, 3, "gtk_calendar_select_month", "guint");
+ gtk_calendar_select_month(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_guint(month), Xen_to_C_guint(year));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_tooltip_markup(XEN widget, XEN markup)
+static Xen gxg_gtk_calendar_mark_day(Xen calendar, Xen day)
{
- #define H_gtk_widget_set_tooltip_markup "void gtk_widget_set_tooltip_markup(GtkWidget* widget, gchar* markup)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_tooltip_markup", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(markup), markup, 2, "gtk_widget_set_tooltip_markup", "gchar*");
- gtk_widget_set_tooltip_markup(XEN_TO_C_GtkWidget_(widget), (const gchar*)XEN_TO_C_gchar_(markup));
- return(XEN_FALSE);
+ #define H_gtk_calendar_mark_day "void gtk_calendar_mark_day(GtkCalendar* calendar, guint day)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_mark_day", "GtkCalendar*");
+ Xen_check_type(Xen_is_guint(day), day, 2, "gtk_calendar_mark_day", "guint");
+ gtk_calendar_mark_day(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_guint(day));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_tooltip_markup(XEN widget)
+static Xen gxg_gtk_calendar_unmark_day(Xen calendar, Xen day)
{
- #define H_gtk_widget_get_tooltip_markup "gchar* gtk_widget_get_tooltip_markup(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_tooltip_markup", "GtkWidget*");
- return(C_TO_XEN_gchar_(gtk_widget_get_tooltip_markup(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_calendar_unmark_day "void gtk_calendar_unmark_day(GtkCalendar* calendar, guint day)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_unmark_day", "GtkCalendar*");
+ Xen_check_type(Xen_is_guint(day), day, 2, "gtk_calendar_unmark_day", "guint");
+ gtk_calendar_unmark_day(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_guint(day));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_is_rubber_banding_active(XEN tree_view)
+static Xen gxg_gdk_drag_context_get_source_window(Xen context)
{
- #define H_gtk_tree_view_is_rubber_banding_active "gboolean gtk_tree_view_is_rubber_banding_active(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_is_rubber_banding_active", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_is_rubber_banding_active(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gdk_drag_context_get_source_window "GdkWindow* gdk_drag_context_get_source_window(GdkDragContext* context)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gdk_drag_context_get_source_window", "GdkDragContext*");
+ return(C_to_Xen_GdkWindow_(gdk_drag_context_get_source_window(Xen_to_C_GdkDragContext_(context))));
}
-static XEN gxg_gtk_icon_view_convert_widget_to_bin_window_coords(XEN icon_view, XEN wx, XEN wy, XEN ignore_bx, XEN ignore_by)
+static Xen gxg_gtk_viewport_get_view_window(Xen viewport)
{
- #define H_gtk_icon_view_convert_widget_to_bin_window_coords "void gtk_icon_view_convert_widget_to_bin_window_coords(GtkIconView* icon_view, \
-gint wx, gint wy, gint* [bx], gint* [by])"
- gint ref_bx;
- gint ref_by;
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_convert_widget_to_bin_window_coords", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(wx), wx, 2, "gtk_icon_view_convert_widget_to_bin_window_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(wy), wy, 3, "gtk_icon_view_convert_widget_to_bin_window_coords", "gint");
- gtk_icon_view_convert_widget_to_bin_window_coords(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(wx), XEN_TO_C_gint(wy),
- &ref_bx, &ref_by);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_bx), C_TO_XEN_gint(ref_by)));
+ #define H_gtk_viewport_get_view_window "GdkWindow* gtk_viewport_get_view_window(GtkViewport* viewport)"
+ Xen_check_type(Xen_is_GtkViewport_(viewport), viewport, 1, "gtk_viewport_get_view_window", "GtkViewport*");
+ return(C_to_Xen_GdkWindow_(gtk_viewport_get_view_window(Xen_to_C_GtkViewport_(viewport))));
}
-static XEN gxg_gtk_icon_view_set_tooltip_item(XEN icon_view, XEN tooltip, XEN path)
+static Xen gxg_gtk_accessible_set_widget(Xen accessible, Xen widget)
{
- #define H_gtk_icon_view_set_tooltip_item "void gtk_icon_view_set_tooltip_item(GtkIconView* icon_view, \
-GtkTooltip* tooltip, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_tooltip_item", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 2, "gtk_icon_view_set_tooltip_item", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 3, "gtk_icon_view_set_tooltip_item", "GtkTreePath*");
- gtk_icon_view_set_tooltip_item(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTooltip_(tooltip), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gtk_accessible_set_widget "void gtk_accessible_set_widget(GtkAccessible* accessible, GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkAccessible_(accessible), accessible, 1, "gtk_accessible_set_widget", "GtkAccessible*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_accessible_set_widget", "GtkWidget*");
+ gtk_accessible_set_widget(Xen_to_C_GtkAccessible_(accessible), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_set_tooltip_cell(XEN icon_view, XEN tooltip, XEN path, XEN cell)
+static Xen gxg_gtk_button_get_event_window(Xen button)
{
- #define H_gtk_icon_view_set_tooltip_cell "void gtk_icon_view_set_tooltip_cell(GtkIconView* icon_view, \
-GtkTooltip* tooltip, GtkTreePath* path, GtkCellRenderer* cell)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_tooltip_cell", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 2, "gtk_icon_view_set_tooltip_cell", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 3, "gtk_icon_view_set_tooltip_cell", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 4, "gtk_icon_view_set_tooltip_cell", "GtkCellRenderer*");
- gtk_icon_view_set_tooltip_cell(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTooltip_(tooltip), XEN_TO_C_GtkTreePath_(path),
- XEN_TO_C_GtkCellRenderer_(cell));
- return(XEN_FALSE);
+ #define H_gtk_button_get_event_window "GdkWindow* gtk_button_get_event_window(GtkButton* button)"
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_get_event_window", "GtkButton*");
+ return(C_to_Xen_GdkWindow_(gtk_button_get_event_window(Xen_to_C_GtkButton_(button))));
}
-static XEN gxg_gtk_icon_view_get_tooltip_context(XEN icon_view, XEN ignore_x, XEN ignore_y, XEN keyboard_tip, XEN ignore_model, XEN ignore_path, XEN iter)
+static Xen gxg_gtk_message_dialog_get_message_area(Xen message_dialog)
{
- #define H_gtk_icon_view_get_tooltip_context "gboolean gtk_icon_view_get_tooltip_context(GtkIconView* icon_view, \
-gint* [x], gint* [y], gboolean keyboard_tip, GtkTreeModel** [model], GtkTreePath** [path], GtkTreeIter* iter)"
- gint ref_x;
- gint ref_y;
- GtkTreeModel* ref_model = NULL;
- GtkTreePath* ref_path = NULL;
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_tooltip_context", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(keyboard_tip), keyboard_tip, 4, "gtk_icon_view_get_tooltip_context", "gboolean");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter) || XEN_FALSE_P(iter), iter, 7, "gtk_icon_view_get_tooltip_context", "GtkTreeIter*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_icon_view_get_tooltip_context(XEN_TO_C_GtkIconView_(icon_view), &ref_x, &ref_y, XEN_TO_C_gboolean(keyboard_tip),
- &ref_model, &ref_path, XEN_TO_C_GtkTreeIter_(iter)));
- return(XEN_LIST_5(result, C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_GtkTreeModel_(ref_model), C_TO_XEN_GtkTreePath_(ref_path)));
- }
+ #define H_gtk_message_dialog_get_message_area "GtkWidget* gtk_message_dialog_get_message_area(GtkMessageDialog* message_dialog)"
+ Xen_check_type(Xen_is_GtkMessageDialog_(message_dialog), message_dialog, 1, "gtk_message_dialog_get_message_area", "GtkMessageDialog*");
+ return(C_to_Xen_GtkWidget_(gtk_message_dialog_get_message_area(Xen_to_C_GtkMessageDialog_(message_dialog))));
}
-static XEN gxg_gtk_icon_view_set_tooltip_column(XEN icon_view, XEN column)
+static Xen gxg_gtk_selection_data_get_length(Xen selection_data)
{
- #define H_gtk_icon_view_set_tooltip_column "void gtk_icon_view_set_tooltip_column(GtkIconView* icon_view, \
-gint column)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_tooltip_column", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 2, "gtk_icon_view_set_tooltip_column", "gint");
- gtk_icon_view_set_tooltip_column(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_gtk_selection_data_get_length "gint gtk_selection_data_get_length(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_length", "GtkSelectionData*");
+ return(C_to_Xen_gint(gtk_selection_data_get_length(Xen_to_C_GtkSelectionData_(selection_data))));
}
-static XEN gxg_gtk_icon_view_get_tooltip_column(XEN icon_view )
+static Xen gxg_gdk_pango_layout_line_get_clip_region(Xen line, Xen x_origin, Xen y_origin, Xen index_ranges, Xen n_ranges)
{
- #define H_gtk_icon_view_get_tooltip_column "gint gtk_icon_view_get_tooltip_column(GtkIconView* icon_view, \
-)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view ), icon_view , 1, "gtk_icon_view_get_tooltip_column", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_tooltip_column(XEN_TO_C_GtkIconView_(icon_view ))));
+ #define H_gdk_pango_layout_line_get_clip_region "cairo_region_t* gdk_pango_layout_line_get_clip_region(PangoLayoutLine* line, \
+gint x_origin, gint y_origin, gint* index_ranges, gint n_ranges)"
+ Xen_check_type(Xen_is_PangoLayoutLine_(line), line, 1, "gdk_pango_layout_line_get_clip_region", "PangoLayoutLine*");
+ Xen_check_type(Xen_is_gint(x_origin), x_origin, 2, "gdk_pango_layout_line_get_clip_region", "gint");
+ Xen_check_type(Xen_is_gint(y_origin), y_origin, 3, "gdk_pango_layout_line_get_clip_region", "gint");
+ Xen_check_type(Xen_is_gint_(index_ranges), index_ranges, 4, "gdk_pango_layout_line_get_clip_region", "gint*");
+ Xen_check_type(Xen_is_gint(n_ranges), n_ranges, 5, "gdk_pango_layout_line_get_clip_region", "gint");
+ return(C_to_Xen_cairo_region_t_(gdk_pango_layout_line_get_clip_region(Xen_to_C_PangoLayoutLine_(line), Xen_to_C_gint(x_origin),
+ Xen_to_C_gint(y_origin), Xen_to_C_gint_(index_ranges),
+ Xen_to_C_gint(n_ranges))));
}
-static XEN gxg_gtk_menu_tool_button_set_arrow_tooltip_text(XEN button, XEN text)
+static Xen gxg_gdk_pango_layout_get_clip_region(Xen layout, Xen x_origin, Xen y_origin, Xen index_ranges, Xen n_ranges)
{
- #define H_gtk_menu_tool_button_set_arrow_tooltip_text "void gtk_menu_tool_button_set_arrow_tooltip_text(GtkMenuToolButton* button, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkMenuToolButton__P(button), button, 1, "gtk_menu_tool_button_set_arrow_tooltip_text", "GtkMenuToolButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_menu_tool_button_set_arrow_tooltip_text", "gchar*");
- gtk_menu_tool_button_set_arrow_tooltip_text(XEN_TO_C_GtkMenuToolButton_(button), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gdk_pango_layout_get_clip_region "cairo_region_t* gdk_pango_layout_get_clip_region(PangoLayout* layout, \
+gint x_origin, gint y_origin, gint* index_ranges, gint n_ranges)"
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 1, "gdk_pango_layout_get_clip_region", "PangoLayout*");
+ Xen_check_type(Xen_is_gint(x_origin), x_origin, 2, "gdk_pango_layout_get_clip_region", "gint");
+ Xen_check_type(Xen_is_gint(y_origin), y_origin, 3, "gdk_pango_layout_get_clip_region", "gint");
+ Xen_check_type(Xen_is_gint_(index_ranges), index_ranges, 4, "gdk_pango_layout_get_clip_region", "gint*");
+ Xen_check_type(Xen_is_gint(n_ranges), n_ranges, 5, "gdk_pango_layout_get_clip_region", "gint");
+ return(C_to_Xen_cairo_region_t_(gdk_pango_layout_get_clip_region(Xen_to_C_PangoLayout_(layout), Xen_to_C_gint(x_origin),
+ Xen_to_C_gint(y_origin), Xen_to_C_gint_(index_ranges),
+ Xen_to_C_gint(n_ranges))));
}
-static XEN gxg_gtk_menu_tool_button_set_arrow_tooltip_markup(XEN button, XEN markup)
+static Xen gxg_gdk_window_shape_combine_region(Xen window, Xen shape_region, Xen offset_x, Xen offset_y)
{
- #define H_gtk_menu_tool_button_set_arrow_tooltip_markup "void gtk_menu_tool_button_set_arrow_tooltip_markup(GtkMenuToolButton* button, \
-gchar* markup)"
- XEN_ASSERT_TYPE(XEN_GtkMenuToolButton__P(button), button, 1, "gtk_menu_tool_button_set_arrow_tooltip_markup", "GtkMenuToolButton*");
- XEN_ASSERT_TYPE(XEN_gchar__P(markup), markup, 2, "gtk_menu_tool_button_set_arrow_tooltip_markup", "gchar*");
- gtk_menu_tool_button_set_arrow_tooltip_markup(XEN_TO_C_GtkMenuToolButton_(button), (const gchar*)XEN_TO_C_gchar_(markup));
- return(XEN_FALSE);
+ #define H_gdk_window_shape_combine_region "void gdk_window_shape_combine_region(GdkWindow* window, \
+cairo_region_t* shape_region, gint offset_x, gint offset_y)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_shape_combine_region", "GdkWindow*");
+ Xen_check_type(Xen_is_cairo_region_t_(shape_region), shape_region, 2, "gdk_window_shape_combine_region", "cairo_region_t*");
+ Xen_check_type(Xen_is_gint(offset_x), offset_x, 3, "gdk_window_shape_combine_region", "gint");
+ Xen_check_type(Xen_is_gint(offset_y), offset_y, 4, "gdk_window_shape_combine_region", "gint");
+ gdk_window_shape_combine_region(Xen_to_C_GdkWindow_(window), Xen_to_C_cairo_region_t_(shape_region), Xen_to_C_gint(offset_x),
+ Xen_to_C_gint(offset_y));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_set_tooltip_text(XEN tool_item, XEN text)
+static Xen gxg_gdk_window_invalidate_region(Xen window, Xen region, Xen invalidate_children)
{
- #define H_gtk_tool_item_set_tooltip_text "void gtk_tool_item_set_tooltip_text(GtkToolItem* tool_item, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_set_tooltip_text", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_tool_item_set_tooltip_text", "gchar*");
- gtk_tool_item_set_tooltip_text(XEN_TO_C_GtkToolItem_(tool_item), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gdk_window_invalidate_region "void gdk_window_invalidate_region(GdkWindow* window, cairo_region_t* region, \
+gboolean invalidate_children)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_invalidate_region", "GdkWindow*");
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 2, "gdk_window_invalidate_region", "cairo_region_t*");
+ Xen_check_type(Xen_is_gboolean(invalidate_children), invalidate_children, 3, "gdk_window_invalidate_region", "gboolean");
+ gdk_window_invalidate_region(Xen_to_C_GdkWindow_(window), Xen_to_C_cairo_region_t_(region), Xen_to_C_gboolean(invalidate_children));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_set_tooltip_markup(XEN tool_item, XEN markup)
+static Xen gxg_gdk_window_get_update_area(Xen window)
{
- #define H_gtk_tool_item_set_tooltip_markup "void gtk_tool_item_set_tooltip_markup(GtkToolItem* tool_item, \
-gchar* markup)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_set_tooltip_markup", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gchar__P(markup), markup, 2, "gtk_tool_item_set_tooltip_markup", "gchar*");
- gtk_tool_item_set_tooltip_markup(XEN_TO_C_GtkToolItem_(tool_item), (const gchar*)XEN_TO_C_gchar_(markup));
- return(XEN_FALSE);
+ #define H_gdk_window_get_update_area "cairo_region_t* gdk_window_get_update_area(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_update_area", "GdkWindow*");
+ return(C_to_Xen_cairo_region_t_(gdk_window_get_update_area(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_tooltip_set_tip_area(XEN tooltip, XEN rect)
+static Xen gxg_gdk_window_begin_paint_region(Xen window, Xen region)
{
- #define H_gtk_tooltip_set_tip_area "void gtk_tooltip_set_tip_area(GtkTooltip* tooltip, GdkRectangle* rect)"
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 1, "gtk_tooltip_set_tip_area", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rect), rect, 2, "gtk_tooltip_set_tip_area", "GdkRectangle*");
- gtk_tooltip_set_tip_area(XEN_TO_C_GtkTooltip_(tooltip), XEN_TO_C_GdkRectangle_(rect));
- return(XEN_FALSE);
+ #define H_gdk_window_begin_paint_region "void gdk_window_begin_paint_region(GdkWindow* window, cairo_region_t* region)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_begin_paint_region", "GdkWindow*");
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 2, "gdk_window_begin_paint_region", "cairo_region_t*");
+ gdk_window_begin_paint_region(Xen_to_C_GdkWindow_(window), Xen_to_C_cairo_region_t_(region));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_tooltip_row(XEN tree_view, XEN tooltip, XEN path)
+static Xen gxg_gdk_window_move_region(Xen window, Xen region, Xen dx, Xen dy)
{
- #define H_gtk_tree_view_set_tooltip_row "void gtk_tree_view_set_tooltip_row(GtkTreeView* tree_view, \
-GtkTooltip* tooltip, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_tooltip_row", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 2, "gtk_tree_view_set_tooltip_row", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 3, "gtk_tree_view_set_tooltip_row", "GtkTreePath*");
- gtk_tree_view_set_tooltip_row(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTooltip_(tooltip), XEN_TO_C_GtkTreePath_(path));
- return(XEN_FALSE);
+ #define H_gdk_window_move_region "void gdk_window_move_region(GdkWindow* window, cairo_region_t* region, \
+gint dx, gint dy)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_move_region", "GdkWindow*");
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 2, "gdk_window_move_region", "cairo_region_t*");
+ Xen_check_type(Xen_is_gint(dx), dx, 3, "gdk_window_move_region", "gint");
+ Xen_check_type(Xen_is_gint(dy), dy, 4, "gdk_window_move_region", "gint");
+ gdk_window_move_region(Xen_to_C_GdkWindow_(window), Xen_to_C_cairo_region_t_(region), Xen_to_C_gint(dx), Xen_to_C_gint(dy));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_tooltip_cell(XEN tree_view, XEN tooltip, XEN path, XEN column, XEN cell)
+static Xen gxg_gdk_keymap_get_num_lock_state(Xen keymap)
{
- #define H_gtk_tree_view_set_tooltip_cell "void gtk_tree_view_set_tooltip_cell(GtkTreeView* tree_view, \
-GtkTooltip* tooltip, GtkTreePath* path, GtkTreeViewColumn* column, GtkCellRenderer* cell)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_tooltip_cell", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 2, "gtk_tree_view_set_tooltip_cell", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 3, "gtk_tree_view_set_tooltip_cell", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(column), column, 4, "gtk_tree_view_set_tooltip_cell", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 5, "gtk_tree_view_set_tooltip_cell", "GtkCellRenderer*");
- gtk_tree_view_set_tooltip_cell(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTooltip_(tooltip), XEN_TO_C_GtkTreePath_(path),
- XEN_TO_C_GtkTreeViewColumn_(column), XEN_TO_C_GtkCellRenderer_(cell));
- return(XEN_FALSE);
+ #define H_gdk_keymap_get_num_lock_state "gboolean gdk_keymap_get_num_lock_state(GdkKeymap* keymap)"
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_get_num_lock_state", "GdkKeymap*");
+ return(C_to_Xen_gboolean(gdk_keymap_get_num_lock_state(Xen_to_C_GdkKeymap_(keymap))));
}
-static XEN gxg_gtk_tree_view_get_tooltip_context(XEN tree_view, XEN ignore_x, XEN ignore_y, XEN keyboard_tip, XEN ignore_model, XEN ignore_path, XEN iter)
+static Xen gxg_gdk_window_has_native(Xen window)
{
- #define H_gtk_tree_view_get_tooltip_context "gboolean gtk_tree_view_get_tooltip_context(GtkTreeView* tree_view, \
-gint* [x], gint* [y], gboolean keyboard_tip, GtkTreeModel** [model], GtkTreePath** [path], GtkTreeIter* iter)"
- gint ref_x;
- gint ref_y;
- GtkTreeModel* ref_model = NULL;
- GtkTreePath* ref_path = NULL;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_tooltip_context", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(keyboard_tip), keyboard_tip, 4, "gtk_tree_view_get_tooltip_context", "gboolean");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter) || XEN_FALSE_P(iter), iter, 7, "gtk_tree_view_get_tooltip_context", "GtkTreeIter*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_tree_view_get_tooltip_context(XEN_TO_C_GtkTreeView_(tree_view), &ref_x, &ref_y, XEN_TO_C_gboolean(keyboard_tip),
- &ref_model, &ref_path, XEN_TO_C_GtkTreeIter_(iter)));
- return(XEN_LIST_5(result, C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_GtkTreeModel_(ref_model), C_TO_XEN_GtkTreePath_(ref_path)));
- }
+ #define H_gdk_window_has_native "gboolean gdk_window_has_native(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_has_native", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_has_native(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_tree_view_set_tooltip_column(XEN tree_view, XEN column)
+static Xen gxg_gdk_cursor_get_cursor_type(Xen cursor)
{
- #define H_gtk_tree_view_set_tooltip_column "void gtk_tree_view_set_tooltip_column(GtkTreeView* tree_view, \
-gint column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_tooltip_column", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(column), column, 2, "gtk_tree_view_set_tooltip_column", "gint");
- gtk_tree_view_set_tooltip_column(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(column));
- return(XEN_FALSE);
+ #define H_gdk_cursor_get_cursor_type "GdkCursorType gdk_cursor_get_cursor_type(GdkCursor* cursor)"
+ Xen_check_type(Xen_is_GdkCursor_(cursor), cursor, 1, "gdk_cursor_get_cursor_type", "GdkCursor*");
+ return(C_to_Xen_GdkCursorType(gdk_cursor_get_cursor_type(Xen_to_C_GdkCursor_(cursor))));
}
-static XEN gxg_gtk_tree_view_get_tooltip_column(XEN tree_view )
+static Xen gxg_gdk_display_is_closed(Xen display)
{
- #define H_gtk_tree_view_get_tooltip_column "gint gtk_tree_view_get_tooltip_column(GtkTreeView* tree_view, \
-)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view ), tree_view , 1, "gtk_tree_view_get_tooltip_column", "GtkTreeView*");
- return(C_TO_XEN_gint(gtk_tree_view_get_tooltip_column(XEN_TO_C_GtkTreeView_(tree_view ))));
+ #define H_gdk_display_is_closed "gboolean gdk_display_is_closed(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_display_is_closed", "GdkDisplay*");
+ return(C_to_Xen_gboolean(gdk_display_is_closed(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_gtk_widget_set_has_tooltip(XEN widget, XEN has_tooltip)
+static Xen gxg_gdk_window_get_background_pattern(Xen window)
{
- #define H_gtk_widget_set_has_tooltip "void gtk_widget_set_has_tooltip(GtkWidget* widget, gboolean has_tooltip)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_has_tooltip", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(has_tooltip), has_tooltip, 2, "gtk_widget_set_has_tooltip", "gboolean");
- gtk_widget_set_has_tooltip(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(has_tooltip));
- return(XEN_FALSE);
+ #define H_gdk_window_get_background_pattern "cairo_pattern_t* gdk_window_get_background_pattern(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_background_pattern", "GdkWindow*");
+ return(C_to_Xen_cairo_pattern_t_(gdk_window_get_background_pattern(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_widget_get_has_tooltip(XEN widget)
+static Xen gxg_gdk_window_create_similar_surface(Xen window, Xen content, Xen width, Xen height)
{
- #define H_gtk_widget_get_has_tooltip "gboolean gtk_widget_get_has_tooltip(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_has_tooltip", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_has_tooltip(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gdk_window_create_similar_surface "cairo_surface_t* gdk_window_create_similar_surface(GdkWindow* window, \
+cairo_content_t content, int width, int height)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_create_similar_surface", "GdkWindow*");
+ Xen_check_type(Xen_is_cairo_content_t(content), content, 2, "gdk_window_create_similar_surface", "cairo_content_t");
+ Xen_check_type(Xen_is_int(width), width, 3, "gdk_window_create_similar_surface", "int");
+ Xen_check_type(Xen_is_int(height), height, 4, "gdk_window_create_similar_surface", "int");
+ return(C_to_Xen_cairo_surface_t_(gdk_window_create_similar_surface(Xen_to_C_GdkWindow_(window), Xen_to_C_cairo_content_t(content),
+ Xen_to_C_int(width), Xen_to_C_int(height))));
}
-#if HAVE_GTK_TEST_WIDGET_CLICK
-static XEN gxg_gtk_calendar_set_detail_func(XEN calendar, XEN func, XEN data, XEN destroy)
+static Xen gxg_gtk_expander_set_label_fill(Xen expander, Xen label_fill)
{
- #define H_gtk_calendar_set_detail_func "void gtk_calendar_set_detail_func(GtkCalendar* calendar, GtkCalendarDetailFunc func, \
-gpointer data, GDestroyNotify destroy)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_set_detail_func", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_GtkCalendarDetailFunc_P(func), func, 2, "gtk_calendar_set_detail_func", "GtkCalendarDetailFunc");
- XEN_ASSERT_TYPE(XEN_gpointer_P(data), data, 3, "gtk_calendar_set_detail_func", "gpointer");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(destroy), destroy, 4, "gtk_calendar_set_detail_func", "GDestroyNotify");
- gtk_calendar_set_detail_func(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_GtkCalendarDetailFunc(func), XEN_TO_C_gpointer(data),
- XEN_TO_C_GDestroyNotify(destroy));
- return(XEN_FALSE);
+ #define H_gtk_expander_set_label_fill "void gtk_expander_set_label_fill(GtkExpander* expander, gboolean label_fill)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_set_label_fill", "GtkExpander*");
+ Xen_check_type(Xen_is_gboolean(label_fill), label_fill, 2, "gtk_expander_set_label_fill", "gboolean");
+ gtk_expander_set_label_fill(Xen_to_C_GtkExpander_(expander), Xen_to_C_gboolean(label_fill));
+ return(Xen_false);
}
-static XEN gxg_gtk_calendar_set_detail_width_chars(XEN calendar, XEN chars)
+static Xen gxg_gtk_expander_get_label_fill(Xen expander)
{
- #define H_gtk_calendar_set_detail_width_chars "void gtk_calendar_set_detail_width_chars(GtkCalendar* calendar, \
-gint chars)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_set_detail_width_chars", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_gint_P(chars), chars, 2, "gtk_calendar_set_detail_width_chars", "gint");
- gtk_calendar_set_detail_width_chars(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_gint(chars));
- return(XEN_FALSE);
+ #define H_gtk_expander_get_label_fill "gboolean gtk_expander_get_label_fill(GtkExpander* expander)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_get_label_fill", "GtkExpander*");
+ return(C_to_Xen_gboolean(gtk_expander_get_label_fill(Xen_to_C_GtkExpander_(expander))));
}
-static XEN gxg_gtk_calendar_set_detail_height_rows(XEN calendar, XEN rows)
+static Xen gxg_gtk_calendar_get_day_is_marked(Xen calendar, Xen day)
{
- #define H_gtk_calendar_set_detail_height_rows "void gtk_calendar_set_detail_height_rows(GtkCalendar* calendar, \
-gint rows)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_set_detail_height_rows", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_gint_P(rows), rows, 2, "gtk_calendar_set_detail_height_rows", "gint");
- gtk_calendar_set_detail_height_rows(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_gint(rows));
- return(XEN_FALSE);
+ #define H_gtk_calendar_get_day_is_marked "gboolean gtk_calendar_get_day_is_marked(GtkCalendar* calendar, \
+guint day)"
+ Xen_check_type(Xen_is_GtkCalendar_(calendar), calendar, 1, "gtk_calendar_get_day_is_marked", "GtkCalendar*");
+ Xen_check_type(Xen_is_guint(day), day, 2, "gtk_calendar_get_day_is_marked", "guint");
+ return(C_to_Xen_gboolean(gtk_calendar_get_day_is_marked(Xen_to_C_GtkCalendar_(calendar), Xen_to_C_guint(day))));
}
-static XEN gxg_gtk_calendar_get_detail_width_chars(XEN calendar)
+static Xen gxg_gtk_progress_bar_set_inverted(Xen pbar, Xen inverted)
{
- #define H_gtk_calendar_get_detail_width_chars "gint gtk_calendar_get_detail_width_chars(GtkCalendar* calendar)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_get_detail_width_chars", "GtkCalendar*");
- return(C_TO_XEN_gint(gtk_calendar_get_detail_width_chars(XEN_TO_C_GtkCalendar_(calendar))));
+ #define H_gtk_progress_bar_set_inverted "void gtk_progress_bar_set_inverted(GtkProgressBar* pbar, gboolean inverted)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_set_inverted", "GtkProgressBar*");
+ Xen_check_type(Xen_is_gboolean(inverted), inverted, 2, "gtk_progress_bar_set_inverted", "gboolean");
+ gtk_progress_bar_set_inverted(Xen_to_C_GtkProgressBar_(pbar), Xen_to_C_gboolean(inverted));
+ return(Xen_false);
}
-static XEN gxg_gtk_calendar_get_detail_height_rows(XEN calendar)
+static Xen gxg_gtk_progress_bar_get_inverted(Xen pbar)
{
- #define H_gtk_calendar_get_detail_height_rows "gint gtk_calendar_get_detail_height_rows(GtkCalendar* calendar)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_get_detail_height_rows", "GtkCalendar*");
- return(C_TO_XEN_gint(gtk_calendar_get_detail_height_rows(XEN_TO_C_GtkCalendar_(calendar))));
+ #define H_gtk_progress_bar_get_inverted "gboolean gtk_progress_bar_get_inverted(GtkProgressBar* pbar)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_get_inverted", "GtkProgressBar*");
+ return(C_to_Xen_gboolean(gtk_progress_bar_get_inverted(Xen_to_C_GtkProgressBar_(pbar))));
}
-static XEN gxg_gdk_screen_get_monitor_width_mm(XEN screen, XEN monitor_num)
+static Xen gxg_gtk_radio_button_join_group(Xen radio_button, Xen group_source)
{
- #define H_gdk_screen_get_monitor_width_mm "gint gdk_screen_get_monitor_width_mm(GdkScreen* screen, \
-gint monitor_num)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_monitor_width_mm", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_gint_P(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_width_mm", "gint");
- return(C_TO_XEN_gint(gdk_screen_get_monitor_width_mm(XEN_TO_C_GdkScreen_(screen), XEN_TO_C_gint(monitor_num))));
+ #define H_gtk_radio_button_join_group "void gtk_radio_button_join_group(GtkRadioButton* radio_button, \
+GtkRadioButton* group_source)"
+ Xen_check_type(Xen_is_GtkRadioButton_(radio_button), radio_button, 1, "gtk_radio_button_join_group", "GtkRadioButton*");
+ Xen_check_type(Xen_is_GtkRadioButton_(group_source), group_source, 2, "gtk_radio_button_join_group", "GtkRadioButton*");
+ gtk_radio_button_join_group(Xen_to_C_GtkRadioButton_(radio_button), Xen_to_C_GtkRadioButton_(group_source));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_monitor_height_mm(XEN screen, XEN monitor_num)
+static Xen gxg_gtk_adjustment_new(Xen value, Xen lower, Xen upper, Xen step_increment, Xen page_increment, Xen page_size)
{
- #define H_gdk_screen_get_monitor_height_mm "gint gdk_screen_get_monitor_height_mm(GdkScreen* screen, \
-gint monitor_num)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_monitor_height_mm", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_gint_P(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_height_mm", "gint");
- return(C_TO_XEN_gint(gdk_screen_get_monitor_height_mm(XEN_TO_C_GdkScreen_(screen), XEN_TO_C_gint(monitor_num))));
+ #define H_gtk_adjustment_new "GtkAdjustment* gtk_adjustment_new(gdouble value, gdouble lower, gdouble upper, \
+gdouble step_increment, gdouble page_increment, gdouble page_size)"
+ Xen_check_type(Xen_is_gdouble(value), value, 1, "gtk_adjustment_new", "gdouble");
+ Xen_check_type(Xen_is_gdouble(lower), lower, 2, "gtk_adjustment_new", "gdouble");
+ Xen_check_type(Xen_is_gdouble(upper), upper, 3, "gtk_adjustment_new", "gdouble");
+ Xen_check_type(Xen_is_gdouble(step_increment), step_increment, 4, "gtk_adjustment_new", "gdouble");
+ Xen_check_type(Xen_is_gdouble(page_increment), page_increment, 5, "gtk_adjustment_new", "gdouble");
+ Xen_check_type(Xen_is_gdouble(page_size), page_size, 6, "gtk_adjustment_new", "gdouble");
+ return(C_to_Xen_GtkAdjustment_(gtk_adjustment_new(Xen_to_C_gdouble(value), Xen_to_C_gdouble(lower), Xen_to_C_gdouble(upper),
+ Xen_to_C_gdouble(step_increment), Xen_to_C_gdouble(page_increment), Xen_to_C_gdouble(page_size))));
}
-static XEN gxg_gdk_screen_get_monitor_plug_name(XEN screen, XEN monitor_num)
+static Xen gxg_gtk_binding_set_activate(Xen binding_set, Xen keyval, Xen modifiers, Xen object)
{
- #define H_gdk_screen_get_monitor_plug_name "gchar* gdk_screen_get_monitor_plug_name(GdkScreen* screen, \
-gint monitor_num)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_monitor_plug_name", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_gint_P(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_plug_name", "gint");
- return(C_TO_XEN_gchar_(gdk_screen_get_monitor_plug_name(XEN_TO_C_GdkScreen_(screen), XEN_TO_C_gint(monitor_num))));
+ #define H_gtk_binding_set_activate "gboolean gtk_binding_set_activate(GtkBindingSet* binding_set, guint keyval, \
+GdkModifierType modifiers, GObject* object)"
+ Xen_check_type(Xen_is_GtkBindingSet_(binding_set), binding_set, 1, "gtk_binding_set_activate", "GtkBindingSet*");
+ Xen_check_type(Xen_is_guint(keyval), keyval, 2, "gtk_binding_set_activate", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(modifiers), modifiers, 3, "gtk_binding_set_activate", "GdkModifierType");
+ Xen_check_type(Xen_is_GObject_(object), object, 4, "gtk_binding_set_activate", "GObject*");
+ return(C_to_Xen_gboolean(gtk_binding_set_activate(Xen_to_C_GtkBindingSet_(binding_set), Xen_to_C_guint(keyval), Xen_to_C_GdkModifierType(modifiers),
+ Xen_to_C_GObject_(object))));
}
-static XEN gxg_gtk_tooltip_set_icon_from_icon_name(XEN tooltip, XEN icon_name, XEN size)
+static Xen gxg_gtk_bindings_activate(Xen object, Xen keyval, Xen modifiers)
{
- #define H_gtk_tooltip_set_icon_from_icon_name "void gtk_tooltip_set_icon_from_icon_name(GtkTooltip* tooltip, \
-gchar* icon_name, GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 1, "gtk_tooltip_set_icon_from_icon_name", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_tooltip_set_icon_from_icon_name", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 3, "gtk_tooltip_set_icon_from_icon_name", "GtkIconSize");
- gtk_tooltip_set_icon_from_icon_name(XEN_TO_C_GtkTooltip_(tooltip), (const gchar*)XEN_TO_C_gchar_(icon_name), XEN_TO_C_GtkIconSize(size));
- return(XEN_FALSE);
+ #define H_gtk_bindings_activate "gboolean gtk_bindings_activate(GObject* object, guint keyval, GdkModifierType modifiers)"
+ Xen_check_type(Xen_is_GObject_(object), object, 1, "gtk_bindings_activate", "GObject*");
+ Xen_check_type(Xen_is_guint(keyval), keyval, 2, "gtk_bindings_activate", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(modifiers), modifiers, 3, "gtk_bindings_activate", "GdkModifierType");
+ return(C_to_Xen_gboolean(gtk_bindings_activate(Xen_to_C_GObject_(object), Xen_to_C_guint(keyval), Xen_to_C_GdkModifierType(modifiers))));
}
-#endif
-
-#if HAVE_GTK_ADJUSTMENT_GET_UPPER
-static XEN gxg_gtk_accel_group_get_is_locked(XEN accel_group)
+static Xen gxg_gtk_icon_view_create_drag_icon(Xen icon_view, Xen path)
{
- #define H_gtk_accel_group_get_is_locked "gboolean gtk_accel_group_get_is_locked(GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_get_is_locked", "GtkAccelGroup*");
- return(C_TO_XEN_gboolean(gtk_accel_group_get_is_locked(XEN_TO_C_GtkAccelGroup_(accel_group))));
+ #define H_gtk_icon_view_create_drag_icon "cairo_surface_t* gtk_icon_view_create_drag_icon(GtkIconView* icon_view, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_create_drag_icon", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_icon_view_create_drag_icon", "GtkTreePath*");
+ return(C_to_Xen_cairo_surface_t_(gtk_icon_view_create_drag_icon(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_color_selection_dialog_get_color_selection(XEN colorsel)
+static Xen gxg_gtk_tree_view_create_row_drag_icon(Xen tree_view, Xen path)
{
- #define H_gtk_color_selection_dialog_get_color_selection "GtkWidget* gtk_color_selection_dialog_get_color_selection(GtkColorSelectionDialog* colorsel)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelectionDialog__P(colorsel), colorsel, 1, "gtk_color_selection_dialog_get_color_selection", "GtkColorSelectionDialog*");
- return(C_TO_XEN_GtkWidget_(gtk_color_selection_dialog_get_color_selection(XEN_TO_C_GtkColorSelectionDialog_(colorsel))));
+ #define H_gtk_tree_view_create_row_drag_icon "cairo_surface_t* gtk_tree_view_create_row_drag_icon(GtkTreeView* tree_view, \
+GtkTreePath* path)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_create_row_drag_icon", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_create_row_drag_icon", "GtkTreePath*");
+ return(C_to_Xen_cairo_surface_t_(gtk_tree_view_create_row_drag_icon(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path))));
}
-static XEN gxg_gtk_container_get_focus_child(XEN container)
+static Xen gxg_gdk_cairo_get_clip_rectangle(Xen cr, Xen rect)
{
- #define H_gtk_container_get_focus_child "GtkWidget* gtk_container_get_focus_child(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_get_focus_child", "GtkContainer*");
- return(C_TO_XEN_GtkWidget_(gtk_container_get_focus_child(XEN_TO_C_GtkContainer_(container))));
+ #define H_gdk_cairo_get_clip_rectangle "gboolean gdk_cairo_get_clip_rectangle(cairo_t* cr, GdkRectangle* rect)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "gdk_cairo_get_clip_rectangle", "cairo_t*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 2, "gdk_cairo_get_clip_rectangle", "GdkRectangle*");
+ return(C_to_Xen_gboolean(gdk_cairo_get_clip_rectangle(Xen_to_C_cairo_t_(cr), Xen_to_C_GdkRectangle_(rect))));
}
-static XEN gxg_gtk_dialog_get_action_area(XEN dialog)
+static Xen gxg_gdk_cairo_region_create_from_surface(Xen surface)
{
- #define H_gtk_dialog_get_action_area "GtkWidget* gtk_dialog_get_action_area(GtkDialog* dialog)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_get_action_area", "GtkDialog*");
- return(C_TO_XEN_GtkWidget_(gtk_dialog_get_action_area(XEN_TO_C_GtkDialog_(dialog))));
+ #define H_gdk_cairo_region_create_from_surface "cairo_region_t* gdk_cairo_region_create_from_surface(cairo_surface_t* surface)"
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "gdk_cairo_region_create_from_surface", "cairo_surface_t*");
+ return(C_to_Xen_cairo_region_t_(gdk_cairo_region_create_from_surface(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_gtk_dialog_get_content_area(XEN dialog)
+static Xen gxg_gdk_window_get_visual(Xen window)
{
- #define H_gtk_dialog_get_content_area "GtkWidget* gtk_dialog_get_content_area(GtkDialog* dialog)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_get_content_area", "GtkDialog*");
- return(C_TO_XEN_GtkWidget_(gtk_dialog_get_content_area(XEN_TO_C_GtkDialog_(dialog))));
+ #define H_gdk_window_get_visual "GdkVisual* gdk_window_get_visual(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_visual", "GdkWindow*");
+ return(C_to_Xen_GdkVisual_(gdk_window_get_visual(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_entry_set_overwrite_mode(XEN entry, XEN overwrite)
+static Xen gxg_gdk_window_get_screen(Xen window)
{
- #define H_gtk_entry_set_overwrite_mode "void gtk_entry_set_overwrite_mode(GtkEntry* entry, gboolean overwrite)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_overwrite_mode", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(overwrite), overwrite, 2, "gtk_entry_set_overwrite_mode", "gboolean");
- gtk_entry_set_overwrite_mode(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gboolean(overwrite));
- return(XEN_FALSE);
+ #define H_gdk_window_get_screen "GdkScreen* gdk_window_get_screen(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_screen", "GdkWindow*");
+ return(C_to_Xen_GdkScreen_(gdk_window_get_screen(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_entry_get_overwrite_mode(XEN entry)
+static Xen gxg_gdk_window_get_display(Xen window)
{
- #define H_gtk_entry_get_overwrite_mode "gboolean gtk_entry_get_overwrite_mode(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_overwrite_mode", "GtkEntry*");
- return(C_TO_XEN_gboolean(gtk_entry_get_overwrite_mode(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gdk_window_get_display "GdkDisplay* gdk_window_get_display(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_display", "GdkWindow*");
+ return(C_to_Xen_GdkDisplay_(gdk_window_get_display(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_entry_get_text_length(XEN entry)
+static Xen gxg_gdk_window_get_width(Xen window)
{
- #define H_gtk_entry_get_text_length "guint16 gtk_entry_get_text_length(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_text_length", "GtkEntry*");
- return(C_TO_XEN_guint16(gtk_entry_get_text_length(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gdk_window_get_width "int gdk_window_get_width(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_width", "GdkWindow*");
+ return(C_to_Xen_int(gdk_window_get_width(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_font_selection_get_family_list(XEN fontsel)
+static Xen gxg_gdk_window_get_height(Xen window)
{
- #define H_gtk_font_selection_get_family_list "GtkWidget* gtk_font_selection_get_family_list(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_family_list", "GtkFontSelection*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_get_family_list(XEN_TO_C_GtkFontSelection_(fontsel))));
+ #define H_gdk_window_get_height "int gdk_window_get_height(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_height", "GdkWindow*");
+ return(C_to_Xen_int(gdk_window_get_height(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_font_selection_get_face_list(XEN fontsel)
+static Xen gxg_gtk_cell_renderer_get_request_mode(Xen cell)
{
- #define H_gtk_font_selection_get_face_list "GtkWidget* gtk_font_selection_get_face_list(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_face_list", "GtkFontSelection*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_get_face_list(XEN_TO_C_GtkFontSelection_(fontsel))));
+ #define H_gtk_cell_renderer_get_request_mode "GtkSizeRequestMode gtk_cell_renderer_get_request_mode(GtkCellRenderer* cell)"
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_request_mode", "GtkCellRenderer*");
+ return(C_to_Xen_GtkSizeRequestMode(gtk_cell_renderer_get_request_mode(Xen_to_C_GtkCellRenderer_(cell))));
}
-static XEN gxg_gtk_font_selection_get_size_entry(XEN fontsel)
+static Xen gxg_gtk_cell_renderer_get_preferred_width(Xen cell, Xen widget, Xen ignore_minimum_size, Xen ignore_natural_size)
{
- #define H_gtk_font_selection_get_size_entry "GtkWidget* gtk_font_selection_get_size_entry(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_size_entry", "GtkFontSelection*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_get_size_entry(XEN_TO_C_GtkFontSelection_(fontsel))));
+ #define H_gtk_cell_renderer_get_preferred_width "void gtk_cell_renderer_get_preferred_width(GtkCellRenderer* cell, \
+GtkWidget* widget, gint* [minimum_size], gint* [natural_size])"
+ gint ref_minimum_size;
+ gint ref_natural_size;
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_preferred_width", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_cell_renderer_get_preferred_width", "GtkWidget*");
+ gtk_cell_renderer_get_preferred_width(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_GtkWidget_(widget), &ref_minimum_size,
+ &ref_natural_size);
+ return(Xen_list_2(C_to_Xen_gint(ref_minimum_size), C_to_Xen_gint(ref_natural_size)));
}
-static XEN gxg_gtk_font_selection_get_size_list(XEN fontsel)
+static Xen gxg_gtk_cell_renderer_get_preferred_height_for_width(Xen cell, Xen widget, Xen width, Xen ignore_minimum_height, Xen ignore_natural_height)
{
- #define H_gtk_font_selection_get_size_list "GtkWidget* gtk_font_selection_get_size_list(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_size_list", "GtkFontSelection*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_get_size_list(XEN_TO_C_GtkFontSelection_(fontsel))));
+ #define H_gtk_cell_renderer_get_preferred_height_for_width "void gtk_cell_renderer_get_preferred_height_for_width(GtkCellRenderer* cell, \
+GtkWidget* widget, gint width, gint* [minimum_height], gint* [natural_height])"
+ gint ref_minimum_height;
+ gint ref_natural_height;
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_preferred_height_for_width", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_cell_renderer_get_preferred_height_for_width", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(width), width, 3, "gtk_cell_renderer_get_preferred_height_for_width", "gint");
+ gtk_cell_renderer_get_preferred_height_for_width(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(width),
+ &ref_minimum_height, &ref_natural_height);
+ return(Xen_list_2(C_to_Xen_gint(ref_minimum_height), C_to_Xen_gint(ref_natural_height)));
}
-static XEN gxg_gtk_font_selection_get_preview_entry(XEN fontsel)
+static Xen gxg_gtk_cell_renderer_get_preferred_height(Xen cell, Xen widget, Xen ignore_minimum_size, Xen ignore_natural_size)
{
- #define H_gtk_font_selection_get_preview_entry "GtkWidget* gtk_font_selection_get_preview_entry(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_preview_entry", "GtkFontSelection*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_get_preview_entry(XEN_TO_C_GtkFontSelection_(fontsel))));
+ #define H_gtk_cell_renderer_get_preferred_height "void gtk_cell_renderer_get_preferred_height(GtkCellRenderer* cell, \
+GtkWidget* widget, gint* [minimum_size], gint* [natural_size])"
+ gint ref_minimum_size;
+ gint ref_natural_size;
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_preferred_height", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_cell_renderer_get_preferred_height", "GtkWidget*");
+ gtk_cell_renderer_get_preferred_height(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_GtkWidget_(widget), &ref_minimum_size,
+ &ref_natural_size);
+ return(Xen_list_2(C_to_Xen_gint(ref_minimum_size), C_to_Xen_gint(ref_natural_size)));
}
-static XEN gxg_gtk_font_selection_get_family(XEN fontsel)
+static Xen gxg_gtk_cell_renderer_get_preferred_width_for_height(Xen cell, Xen widget, Xen height, Xen ignore_minimum_width, Xen ignore_natural_width)
{
- #define H_gtk_font_selection_get_family "PangoFontFamily* gtk_font_selection_get_family(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_family", "GtkFontSelection*");
- return(C_TO_XEN_PangoFontFamily_(gtk_font_selection_get_family(XEN_TO_C_GtkFontSelection_(fontsel))));
+ #define H_gtk_cell_renderer_get_preferred_width_for_height "void gtk_cell_renderer_get_preferred_width_for_height(GtkCellRenderer* cell, \
+GtkWidget* widget, gint height, gint* [minimum_width], gint* [natural_width])"
+ gint ref_minimum_width;
+ gint ref_natural_width;
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 1, "gtk_cell_renderer_get_preferred_width_for_height", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_cell_renderer_get_preferred_width_for_height", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(height), height, 3, "gtk_cell_renderer_get_preferred_width_for_height", "gint");
+ gtk_cell_renderer_get_preferred_width_for_height(Xen_to_C_GtkCellRenderer_(cell), Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(height),
+ &ref_minimum_width, &ref_natural_width);
+ return(Xen_list_2(C_to_Xen_gint(ref_minimum_width), C_to_Xen_gint(ref_natural_width)));
}
-static XEN gxg_gtk_font_selection_get_face(XEN fontsel)
+static Xen gxg_gtk_container_class_handle_border_width(Xen klass)
{
- #define H_gtk_font_selection_get_face "PangoFontFace* gtk_font_selection_get_face(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_face", "GtkFontSelection*");
- return(C_TO_XEN_PangoFontFace_(gtk_font_selection_get_face(XEN_TO_C_GtkFontSelection_(fontsel))));
+ #define H_gtk_container_class_handle_border_width "void gtk_container_class_handle_border_width(GtkContainerClass* klass)"
+ Xen_check_type(Xen_is_GtkContainerClass_(klass), klass, 1, "gtk_container_class_handle_border_width", "GtkContainerClass*");
+ gtk_container_class_handle_border_width(Xen_to_C_GtkContainerClass_(klass));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_selection_get_size(XEN fontsel)
+static Xen gxg_gtk_drag_set_icon_surface(Xen context, Xen surface)
{
- #define H_gtk_font_selection_get_size "gint gtk_font_selection_get_size(GtkFontSelection* fontsel)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelection__P(fontsel), fontsel, 1, "gtk_font_selection_get_size", "GtkFontSelection*");
- return(C_TO_XEN_gint(gtk_font_selection_get_size(XEN_TO_C_GtkFontSelection_(fontsel))));
+ #define H_gtk_drag_set_icon_surface "void gtk_drag_set_icon_surface(GdkDragContext* context, cairo_surface_t* surface)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_set_icon_surface", "GdkDragContext*");
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 2, "gtk_drag_set_icon_surface", "cairo_surface_t*");
+ gtk_drag_set_icon_surface(Xen_to_C_GdkDragContext_(context), Xen_to_C_cairo_surface_t_(surface));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_selection_dialog_get_ok_button(XEN fsd)
+static Xen gxg_gtk_notebook_set_group_name(Xen notebook, Xen group_name)
{
- #define H_gtk_font_selection_dialog_get_ok_button "GtkWidget* gtk_font_selection_dialog_get_ok_button(GtkFontSelectionDialog* fsd)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelectionDialog__P(fsd), fsd, 1, "gtk_font_selection_dialog_get_ok_button", "GtkFontSelectionDialog*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_dialog_get_ok_button(XEN_TO_C_GtkFontSelectionDialog_(fsd))));
+ #define H_gtk_notebook_set_group_name "void gtk_notebook_set_group_name(GtkNotebook* notebook, gchar* group_name)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_set_group_name", "GtkNotebook*");
+ Xen_check_type(Xen_is_gchar_(group_name), group_name, 2, "gtk_notebook_set_group_name", "gchar*");
+ gtk_notebook_set_group_name(Xen_to_C_GtkNotebook_(notebook), (const gchar*)Xen_to_C_gchar_(group_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_font_selection_dialog_get_cancel_button(XEN fsd)
+static Xen gxg_gtk_notebook_get_group_name(Xen notebook)
{
- #define H_gtk_font_selection_dialog_get_cancel_button "GtkWidget* gtk_font_selection_dialog_get_cancel_button(GtkFontSelectionDialog* fsd)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelectionDialog__P(fsd), fsd, 1, "gtk_font_selection_dialog_get_cancel_button", "GtkFontSelectionDialog*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_dialog_get_cancel_button(XEN_TO_C_GtkFontSelectionDialog_(fsd))));
+ #define H_gtk_notebook_get_group_name "gchar* gtk_notebook_get_group_name(GtkNotebook* notebook)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_get_group_name", "GtkNotebook*");
+ return(C_to_Xen_gchar_((gchar*)gtk_notebook_get_group_name(Xen_to_C_GtkNotebook_(notebook))));
}
-static XEN gxg_gtk_handle_box_get_child_detached(XEN handle_box)
+static Xen gxg_gtk_widget_draw(Xen widget, Xen cr)
{
- #define H_gtk_handle_box_get_child_detached "gboolean gtk_handle_box_get_child_detached(GtkHandleBox* handle_box)"
- XEN_ASSERT_TYPE(XEN_GtkHandleBox__P(handle_box), handle_box, 1, "gtk_handle_box_get_child_detached", "GtkHandleBox*");
- return(C_TO_XEN_gboolean(gtk_handle_box_get_child_detached(XEN_TO_C_GtkHandleBox_(handle_box))));
+ #define H_gtk_widget_draw "void gtk_widget_draw(GtkWidget* widget, cairo_t* cr)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_draw", "GtkWidget*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_widget_draw", "cairo_t*");
+ gtk_widget_draw(Xen_to_C_GtkWidget_(widget), Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_gtk_layout_get_bin_window(XEN layout)
+static Xen gxg_gtk_widget_get_request_mode(Xen widget)
{
- #define H_gtk_layout_get_bin_window "GdkWindow* gtk_layout_get_bin_window(GtkLayout* layout)"
- XEN_ASSERT_TYPE(XEN_GtkLayout__P(layout), layout, 1, "gtk_layout_get_bin_window", "GtkLayout*");
- return(C_TO_XEN_GdkWindow_(gtk_layout_get_bin_window(XEN_TO_C_GtkLayout_(layout))));
+ #define H_gtk_widget_get_request_mode "GtkSizeRequestMode gtk_widget_get_request_mode(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_request_mode", "GtkWidget*");
+ return(C_to_Xen_GtkSizeRequestMode(gtk_widget_get_request_mode(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_menu_get_accel_path(XEN menu)
+static Xen gxg_gtk_widget_get_preferred_width(Xen widget, Xen ignore_minimum_width, Xen ignore_natural_width)
{
- #define H_gtk_menu_get_accel_path "gchar* gtk_menu_get_accel_path(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_get_accel_path", "GtkMenu*");
- return(C_TO_XEN_gchar_(gtk_menu_get_accel_path(XEN_TO_C_GtkMenu_(menu))));
+ #define H_gtk_widget_get_preferred_width "void gtk_widget_get_preferred_width(GtkWidget* widget, gint* [minimum_width], \
+gint* [natural_width])"
+ gint ref_minimum_width;
+ gint ref_natural_width;
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_width", "GtkWidget*");
+ gtk_widget_get_preferred_width(Xen_to_C_GtkWidget_(widget), &ref_minimum_width, &ref_natural_width);
+ return(Xen_list_2(C_to_Xen_gint(ref_minimum_width), C_to_Xen_gint(ref_natural_width)));
}
-static XEN gxg_gtk_menu_get_monitor(XEN menu)
+static Xen gxg_gtk_widget_get_preferred_height_for_width(Xen widget, Xen width, Xen ignore_minimum_height, Xen ignore_natural_height)
{
- #define H_gtk_menu_get_monitor "gint gtk_menu_get_monitor(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_get_monitor", "GtkMenu*");
- return(C_TO_XEN_gint(gtk_menu_get_monitor(XEN_TO_C_GtkMenu_(menu))));
+ #define H_gtk_widget_get_preferred_height_for_width "void gtk_widget_get_preferred_height_for_width(GtkWidget* widget, \
+gint width, gint* [minimum_height], gint* [natural_height])"
+ gint ref_minimum_height;
+ gint ref_natural_height;
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_height_for_width", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_widget_get_preferred_height_for_width", "gint");
+ gtk_widget_get_preferred_height_for_width(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(width), &ref_minimum_height, &ref_natural_height);
+ return(Xen_list_2(C_to_Xen_gint(ref_minimum_height), C_to_Xen_gint(ref_natural_height)));
}
-static XEN gxg_gtk_menu_item_get_accel_path(XEN menu_item)
+static Xen gxg_gtk_widget_get_preferred_height(Xen widget, Xen ignore_minimum_height, Xen ignore_natural_height)
{
- #define H_gtk_menu_item_get_accel_path "gchar* gtk_menu_item_get_accel_path(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_get_accel_path", "GtkMenuItem*");
- return(C_TO_XEN_gchar_(gtk_menu_item_get_accel_path(XEN_TO_C_GtkMenuItem_(menu_item))));
+ #define H_gtk_widget_get_preferred_height "void gtk_widget_get_preferred_height(GtkWidget* widget, \
+gint* [minimum_height], gint* [natural_height])"
+ gint ref_minimum_height;
+ gint ref_natural_height;
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_height", "GtkWidget*");
+ gtk_widget_get_preferred_height(Xen_to_C_GtkWidget_(widget), &ref_minimum_height, &ref_natural_height);
+ return(Xen_list_2(C_to_Xen_gint(ref_minimum_height), C_to_Xen_gint(ref_natural_height)));
}
-static XEN gxg_gtk_scale_button_get_plus_button(XEN button)
+static Xen gxg_gtk_widget_get_preferred_width_for_height(Xen widget, Xen height, Xen ignore_minimum_width, Xen ignore_natural_width)
{
- #define H_gtk_scale_button_get_plus_button "GtkWidget* gtk_scale_button_get_plus_button(GtkScaleButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkScaleButton__P(button), button, 1, "gtk_scale_button_get_plus_button", "GtkScaleButton*");
- return(C_TO_XEN_GtkWidget_(gtk_scale_button_get_plus_button(XEN_TO_C_GtkScaleButton_(button))));
+ #define H_gtk_widget_get_preferred_width_for_height "void gtk_widget_get_preferred_width_for_height(GtkWidget* widget, \
+gint height, gint* [minimum_width], gint* [natural_width])"
+ gint ref_minimum_width;
+ gint ref_natural_width;
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_width_for_height", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(height), height, 2, "gtk_widget_get_preferred_width_for_height", "gint");
+ gtk_widget_get_preferred_width_for_height(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(height), &ref_minimum_width, &ref_natural_width);
+ return(Xen_list_2(C_to_Xen_gint(ref_minimum_width), C_to_Xen_gint(ref_natural_width)));
}
-static XEN gxg_gtk_scale_button_get_minus_button(XEN button)
+static Xen gxg_gtk_widget_get_allocated_width(Xen widget)
{
- #define H_gtk_scale_button_get_minus_button "GtkWidget* gtk_scale_button_get_minus_button(GtkScaleButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkScaleButton__P(button), button, 1, "gtk_scale_button_get_minus_button", "GtkScaleButton*");
- return(C_TO_XEN_GtkWidget_(gtk_scale_button_get_minus_button(XEN_TO_C_GtkScaleButton_(button))));
+ #define H_gtk_widget_get_allocated_width "int gtk_widget_get_allocated_width(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_allocated_width", "GtkWidget*");
+ return(C_to_Xen_int(gtk_widget_get_allocated_width(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_scale_button_get_popup(XEN button)
+static Xen gxg_gtk_widget_get_allocated_height(Xen widget)
{
- #define H_gtk_scale_button_get_popup "GtkWidget* gtk_scale_button_get_popup(GtkScaleButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkScaleButton__P(button), button, 1, "gtk_scale_button_get_popup", "GtkScaleButton*");
- return(C_TO_XEN_GtkWidget_(gtk_scale_button_get_popup(XEN_TO_C_GtkScaleButton_(button))));
+ #define H_gtk_widget_get_allocated_height "int gtk_widget_get_allocated_height(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_allocated_height", "GtkWidget*");
+ return(C_to_Xen_int(gtk_widget_get_allocated_height(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_selection_data_get_target(XEN selection_data)
+static Xen gxg_gtk_widget_set_visual(Xen widget, Xen visual)
{
- #define H_gtk_selection_data_get_target "GdkAtom gtk_selection_data_get_target(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_target", "GtkSelectionData*");
- return(C_TO_XEN_GdkAtom(gtk_selection_data_get_target(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_widget_set_visual "void gtk_widget_set_visual(GtkWidget* widget, GdkVisual* visual)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_visual", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkVisual_(visual), visual, 2, "gtk_widget_set_visual", "GdkVisual*");
+ gtk_widget_set_visual(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkVisual_(visual));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_get_data_type(XEN selection_data)
+static Xen gxg_gtk_widget_get_halign(Xen widget)
{
- #define H_gtk_selection_data_get_data_type "GdkAtom gtk_selection_data_get_data_type(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_data_type", "GtkSelectionData*");
- return(C_TO_XEN_GdkAtom(gtk_selection_data_get_data_type(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_widget_get_halign "GtkAlign gtk_widget_get_halign(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_halign", "GtkWidget*");
+ return(C_to_Xen_GtkAlign(gtk_widget_get_halign(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_selection_data_get_format(XEN selection_data)
+static Xen gxg_gtk_widget_set_halign(Xen widget, Xen align)
{
- #define H_gtk_selection_data_get_format "gint gtk_selection_data_get_format(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_format", "GtkSelectionData*");
- return(C_TO_XEN_gint(gtk_selection_data_get_format(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_widget_set_halign "void gtk_widget_set_halign(GtkWidget* widget, GtkAlign align)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_halign", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAlign(align), align, 2, "gtk_widget_set_halign", "GtkAlign");
+ gtk_widget_set_halign(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAlign(align));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_get_display(XEN selection_data)
+static Xen gxg_gtk_widget_get_valign(Xen widget)
{
- #define H_gtk_selection_data_get_display "GdkDisplay* gtk_selection_data_get_display(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_display", "GtkSelectionData*");
- return(C_TO_XEN_GdkDisplay_(gtk_selection_data_get_display(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_widget_get_valign "GtkAlign gtk_widget_get_valign(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_valign", "GtkWidget*");
+ return(C_to_Xen_GtkAlign(gtk_widget_get_valign(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_widget_get_window(XEN widget)
+static Xen gxg_gtk_widget_set_valign(Xen widget, Xen align)
{
- #define H_gtk_widget_get_window "GdkWindow* gtk_widget_get_window(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_window", "GtkWidget*");
- return(C_TO_XEN_GdkWindow_(gtk_widget_get_window(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_widget_set_valign "void gtk_widget_set_valign(GtkWidget* widget, GtkAlign align)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_valign", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAlign(align), align, 2, "gtk_widget_set_valign", "GtkAlign");
+ gtk_widget_set_valign(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAlign(align));
+ return(Xen_false);
}
-static XEN gxg_gtk_accel_group_get_modifier_mask(XEN accel_group)
+static Xen gxg_gtk_widget_get_margin_top(Xen widget)
{
- #define H_gtk_accel_group_get_modifier_mask "GdkModifierType gtk_accel_group_get_modifier_mask(GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 1, "gtk_accel_group_get_modifier_mask", "GtkAccelGroup*");
- return(C_TO_XEN_GdkModifierType(gtk_accel_group_get_modifier_mask(XEN_TO_C_GtkAccelGroup_(accel_group))));
+ #define H_gtk_widget_get_margin_top "gint gtk_widget_get_margin_top(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_margin_top", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_widget_get_margin_top(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gdk_threads_add_timeout_seconds_full(XEN priority, XEN interval, XEN function, XEN func_info, XEN notify)
+static Xen gxg_gtk_widget_set_margin_top(Xen widget, Xen margin)
{
- #define H_gdk_threads_add_timeout_seconds_full "guint gdk_threads_add_timeout_seconds_full(gint priority, \
-guint interval, GSourceFunc function, lambda_data func_info, GDestroyNotify notify)"
- XEN_ASSERT_TYPE(XEN_gint_P(priority), priority, 1, "gdk_threads_add_timeout_seconds_full", "gint");
- XEN_ASSERT_TYPE(XEN_guint_P(interval), interval, 2, "gdk_threads_add_timeout_seconds_full", "guint");
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(function), function, 3, "gdk_threads_add_timeout_seconds_full", "GSourceFunc");
- XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 4, "gdk_threads_add_timeout_seconds_full", "lambda_data");
- XEN_ASSERT_TYPE(XEN_GDestroyNotify_P(notify), notify, 5, "gdk_threads_add_timeout_seconds_full", "GDestroyNotify");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(XEN_FALSE, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(gdk_threads_add_timeout_seconds_full(XEN_TO_C_gint(priority), XEN_TO_C_guint(interval), XEN_TO_C_GSourceFunc(function),
- XEN_TO_C_lambda_data(func_info), XEN_TO_C_GDestroyNotify(notify)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gtk_widget_set_margin_top "void gtk_widget_set_margin_top(GtkWidget* widget, gint margin)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_margin_top", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(margin), margin, 2, "gtk_widget_set_margin_top", "gint");
+ gtk_widget_set_margin_top(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(margin));
+ return(Xen_false);
}
-static XEN gxg_gdk_threads_add_timeout_seconds(XEN interval, XEN function, XEN func_info)
+static Xen gxg_gtk_widget_get_margin_bottom(Xen widget)
{
- #define H_gdk_threads_add_timeout_seconds "guint gdk_threads_add_timeout_seconds(guint interval, GSourceFunc function, \
-lambda_data func_info)"
- XEN_ASSERT_TYPE(XEN_guint_P(interval), interval, 1, "gdk_threads_add_timeout_seconds", "guint");
- XEN_ASSERT_TYPE(XEN_GSourceFunc_P(function), function, 2, "gdk_threads_add_timeout_seconds", "GSourceFunc");
- if (XEN_NOT_BOUND_P(func_info)) func_info = XEN_FALSE;
- else XEN_ASSERT_TYPE(XEN_lambda_data_P(func_info), func_info, 3, "gdk_threads_add_timeout_seconds", "lambda_data");
- {
- XEN result = XEN_FALSE;
- int loc;
- XEN gxg_ptr = XEN_LIST_5(XEN_FALSE, func_info, XEN_FALSE, XEN_FALSE, XEN_FALSE);
- loc = xm_protect(gxg_ptr);
- XEN_LIST_SET(gxg_ptr, 2, C_TO_XEN_INT(loc));
- result = C_TO_XEN_guint(gdk_threads_add_timeout_seconds(XEN_TO_C_guint(interval), XEN_TO_C_GSourceFunc(function), XEN_TO_C_lambda_data(func_info)));
- XEN_LIST_SET(gxg_ptr, 2, XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("idler"), result, C_TO_XEN_INT(loc)));
- return(result);
- }
+ #define H_gtk_widget_get_margin_bottom "gint gtk_widget_get_margin_bottom(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_margin_bottom", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_widget_get_margin_bottom(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_adjustment_get_lower(XEN adjustment)
+static Xen gxg_gtk_widget_set_margin_bottom(Xen widget, Xen margin)
{
- #define H_gtk_adjustment_get_lower "gdouble gtk_adjustment_get_lower(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_get_lower", "GtkAdjustment*");
- return(C_TO_XEN_gdouble(gtk_adjustment_get_lower(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_widget_set_margin_bottom "void gtk_widget_set_margin_bottom(GtkWidget* widget, gint margin)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_margin_bottom", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(margin), margin, 2, "gtk_widget_set_margin_bottom", "gint");
+ gtk_widget_set_margin_bottom(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(margin));
+ return(Xen_false);
}
-static XEN gxg_gtk_adjustment_set_lower(XEN adjustment, XEN lower)
+static Xen gxg_gtk_widget_shape_combine_region(Xen widget, Xen region)
{
- #define H_gtk_adjustment_set_lower "void gtk_adjustment_set_lower(GtkAdjustment* adjustment, gdouble lower)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_set_lower", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(lower), lower, 2, "gtk_adjustment_set_lower", "gdouble");
- gtk_adjustment_set_lower(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(lower));
- return(XEN_FALSE);
+ #define H_gtk_widget_shape_combine_region "void gtk_widget_shape_combine_region(GtkWidget* widget, \
+cairo_region_t* region)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_shape_combine_region", "GtkWidget*");
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 2, "gtk_widget_shape_combine_region", "cairo_region_t*");
+ gtk_widget_shape_combine_region(Xen_to_C_GtkWidget_(widget), Xen_to_C_cairo_region_t_(region));
+ return(Xen_false);
}
-static XEN gxg_gtk_adjustment_get_upper(XEN adjustment)
+static Xen gxg_gtk_widget_input_shape_combine_region(Xen widget, Xen region)
{
- #define H_gtk_adjustment_get_upper "gdouble gtk_adjustment_get_upper(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_get_upper", "GtkAdjustment*");
- return(C_TO_XEN_gdouble(gtk_adjustment_get_upper(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_widget_input_shape_combine_region "void gtk_widget_input_shape_combine_region(GtkWidget* widget, \
+cairo_region_t* region)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_input_shape_combine_region", "GtkWidget*");
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 2, "gtk_widget_input_shape_combine_region", "cairo_region_t*");
+ gtk_widget_input_shape_combine_region(Xen_to_C_GtkWidget_(widget), Xen_to_C_cairo_region_t_(region));
+ return(Xen_false);
}
-static XEN gxg_gtk_adjustment_set_upper(XEN adjustment, XEN upper)
+static Xen gxg_gtk_cairo_should_draw_window(Xen cr, Xen window)
{
- #define H_gtk_adjustment_set_upper "void gtk_adjustment_set_upper(GtkAdjustment* adjustment, gdouble upper)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_set_upper", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(upper), upper, 2, "gtk_adjustment_set_upper", "gdouble");
- gtk_adjustment_set_upper(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(upper));
- return(XEN_FALSE);
+ #define H_gtk_cairo_should_draw_window "gboolean gtk_cairo_should_draw_window(cairo_t* cr, GdkWindow* window)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "gtk_cairo_should_draw_window", "cairo_t*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 2, "gtk_cairo_should_draw_window", "GdkWindow*");
+ return(C_to_Xen_gboolean(gtk_cairo_should_draw_window(Xen_to_C_cairo_t_(cr), Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_adjustment_get_step_increment(XEN adjustment)
+static Xen gxg_gtk_cairo_transform_to_window(Xen cr, Xen widget, Xen window)
{
- #define H_gtk_adjustment_get_step_increment "gdouble gtk_adjustment_get_step_increment(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_get_step_increment", "GtkAdjustment*");
- return(C_TO_XEN_gdouble(gtk_adjustment_get_step_increment(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_cairo_transform_to_window "void gtk_cairo_transform_to_window(cairo_t* cr, GtkWidget* widget, \
+GdkWindow* window)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "gtk_cairo_transform_to_window", "cairo_t*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_cairo_transform_to_window", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 3, "gtk_cairo_transform_to_window", "GdkWindow*");
+ gtk_cairo_transform_to_window(Xen_to_C_cairo_t_(cr), Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_adjustment_set_step_increment(XEN adjustment, XEN step_increment)
+static Xen gxg_gtk_combo_box_new_with_entry(void)
{
- #define H_gtk_adjustment_set_step_increment "void gtk_adjustment_set_step_increment(GtkAdjustment* adjustment, \
-gdouble step_increment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_set_step_increment", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step_increment), step_increment, 2, "gtk_adjustment_set_step_increment", "gdouble");
- gtk_adjustment_set_step_increment(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(step_increment));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_new_with_entry "GtkWidget* gtk_combo_box_new_with_entry( void)"
+ return(C_to_Xen_GtkWidget_(gtk_combo_box_new_with_entry()));
}
-static XEN gxg_gtk_adjustment_get_page_increment(XEN adjustment)
+static Xen gxg_gtk_combo_box_get_has_entry(Xen combo_box)
{
- #define H_gtk_adjustment_get_page_increment "gdouble gtk_adjustment_get_page_increment(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_get_page_increment", "GtkAdjustment*");
- return(C_TO_XEN_gdouble(gtk_adjustment_get_page_increment(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_combo_box_get_has_entry "gboolean gtk_combo_box_get_has_entry(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_has_entry", "GtkComboBox*");
+ return(C_to_Xen_gboolean(gtk_combo_box_get_has_entry(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_adjustment_set_page_increment(XEN adjustment, XEN page_increment)
+static Xen gxg_gtk_combo_box_set_entry_text_column(Xen combo_box, Xen text_column)
{
- #define H_gtk_adjustment_set_page_increment "void gtk_adjustment_set_page_increment(GtkAdjustment* adjustment, \
-gdouble page_increment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_set_page_increment", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page_increment), page_increment, 2, "gtk_adjustment_set_page_increment", "gdouble");
- gtk_adjustment_set_page_increment(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(page_increment));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_set_entry_text_column "void gtk_combo_box_set_entry_text_column(GtkComboBox* combo_box, \
+gint text_column)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_entry_text_column", "GtkComboBox*");
+ Xen_check_type(Xen_is_gint(text_column), text_column, 2, "gtk_combo_box_set_entry_text_column", "gint");
+ gtk_combo_box_set_entry_text_column(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_gint(text_column));
+ return(Xen_false);
}
-static XEN gxg_gtk_adjustment_get_page_size(XEN adjustment)
+static Xen gxg_gtk_combo_box_get_entry_text_column(Xen combo_box)
{
- #define H_gtk_adjustment_get_page_size "gdouble gtk_adjustment_get_page_size(GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_get_page_size", "GtkAdjustment*");
- return(C_TO_XEN_gdouble(gtk_adjustment_get_page_size(XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_combo_box_get_entry_text_column "gint gtk_combo_box_get_entry_text_column(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_entry_text_column", "GtkComboBox*");
+ return(C_to_Xen_gint(gtk_combo_box_get_entry_text_column(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_adjustment_set_page_size(XEN adjustment, XEN page_size)
+static Xen gxg_gtk_target_entry_new(Xen target, Xen flags, Xen info)
{
- #define H_gtk_adjustment_set_page_size "void gtk_adjustment_set_page_size(GtkAdjustment* adjustment, \
-gdouble page_size)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_set_page_size", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page_size), page_size, 2, "gtk_adjustment_set_page_size", "gdouble");
- gtk_adjustment_set_page_size(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(page_size));
- return(XEN_FALSE);
+ #define H_gtk_target_entry_new "GtkTargetEntry* gtk_target_entry_new(char* target, guint flags, guint info)"
+ Xen_check_type(Xen_is_char_(target), target, 1, "gtk_target_entry_new", "char*");
+ Xen_check_type(Xen_is_guint(flags), flags, 2, "gtk_target_entry_new", "guint");
+ Xen_check_type(Xen_is_guint(info), info, 3, "gtk_target_entry_new", "guint");
+ return(C_to_Xen_GtkTargetEntry_(gtk_target_entry_new((const char*)Xen_to_C_char_(target), Xen_to_C_guint(flags), Xen_to_C_guint(info))));
}
-static XEN gxg_gtk_adjustment_configure(XEN adjustment, XEN value, XEN lower, XEN upper, XEN step_increment, XEN page_increment, XEN page_size)
+static Xen gxg_gtk_target_entry_copy(Xen data)
{
- #define H_gtk_adjustment_configure "void gtk_adjustment_configure(GtkAdjustment* adjustment, gdouble value, \
-gdouble lower, gdouble upper, gdouble step_increment, gdouble page_increment, gdouble page_size)"
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 1, "gtk_adjustment_configure", "GtkAdjustment*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 2, "gtk_adjustment_configure", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(lower), lower, 3, "gtk_adjustment_configure", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(upper), upper, 4, "gtk_adjustment_configure", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step_increment), step_increment, 5, "gtk_adjustment_configure", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page_increment), page_increment, 6, "gtk_adjustment_configure", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page_size), page_size, 7, "gtk_adjustment_configure", "gdouble");
- gtk_adjustment_configure(XEN_TO_C_GtkAdjustment_(adjustment), XEN_TO_C_gdouble(value), XEN_TO_C_gdouble(lower), XEN_TO_C_gdouble(upper),
- XEN_TO_C_gdouble(step_increment), XEN_TO_C_gdouble(page_increment), XEN_TO_C_gdouble(page_size));
- return(XEN_FALSE);
+ #define H_gtk_target_entry_copy "GtkTargetEntry* gtk_target_entry_copy(GtkTargetEntry* data)"
+ Xen_check_type(Xen_is_GtkTargetEntry_(data), data, 1, "gtk_target_entry_copy", "GtkTargetEntry*");
+ return(C_to_Xen_GtkTargetEntry_(gtk_target_entry_copy(Xen_to_C_GtkTargetEntry_(data))));
}
-static XEN gxg_gtk_combo_box_set_button_sensitivity(XEN combo_box, XEN sensitivity)
+static Xen gxg_gtk_target_entry_free(Xen data)
{
- #define H_gtk_combo_box_set_button_sensitivity "void gtk_combo_box_set_button_sensitivity(GtkComboBox* combo_box, \
-GtkSensitivityType sensitivity)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_button_sensitivity", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_GtkSensitivityType_P(sensitivity), sensitivity, 2, "gtk_combo_box_set_button_sensitivity", "GtkSensitivityType");
- gtk_combo_box_set_button_sensitivity(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_GtkSensitivityType(sensitivity));
- return(XEN_FALSE);
+ #define H_gtk_target_entry_free "void gtk_target_entry_free(GtkTargetEntry* data)"
+ Xen_check_type(Xen_is_GtkTargetEntry_(data), data, 1, "gtk_target_entry_free", "GtkTargetEntry*");
+ gtk_target_entry_free(Xen_to_C_GtkTargetEntry_(data));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_get_button_sensitivity(XEN combo_box)
+static Xen gxg_gtk_widget_get_hexpand(Xen widget)
{
- #define H_gtk_combo_box_get_button_sensitivity "GtkSensitivityType gtk_combo_box_get_button_sensitivity(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_button_sensitivity", "GtkComboBox*");
- return(C_TO_XEN_GtkSensitivityType(gtk_combo_box_get_button_sensitivity(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gtk_widget_get_hexpand "gboolean gtk_widget_get_hexpand(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_hexpand", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_hexpand(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_file_chooser_get_file(XEN chooser)
+static Xen gxg_gtk_widget_set_hexpand(Xen widget, Xen expand)
{
- #define H_gtk_file_chooser_get_file "GFile* gtk_file_chooser_get_file(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_file", "GtkFileChooser*");
- return(C_TO_XEN_GFile_(gtk_file_chooser_get_file(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_widget_set_hexpand "void gtk_widget_set_hexpand(GtkWidget* widget, gboolean expand)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_hexpand", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 2, "gtk_widget_set_hexpand", "gboolean");
+ gtk_widget_set_hexpand(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(expand));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_set_file(XEN chooser, XEN file, XEN ignore_error)
+static Xen gxg_gtk_widget_get_hexpand_set(Xen widget)
{
- #define H_gtk_file_chooser_set_file "gboolean gtk_file_chooser_set_file(GtkFileChooser* chooser, GFile* file, \
-GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_file", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GFile__P(file), file, 2, "gtk_file_chooser_set_file", "GFile*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_file_chooser_set_file(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GFile_(file), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_widget_get_hexpand_set "gboolean gtk_widget_get_hexpand_set(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_hexpand_set", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_hexpand_set(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_file_chooser_select_file(XEN chooser, XEN file, XEN ignore_error)
+static Xen gxg_gtk_widget_set_hexpand_set(Xen widget, Xen set)
{
- #define H_gtk_file_chooser_select_file "gboolean gtk_file_chooser_select_file(GtkFileChooser* chooser, \
-GFile* file, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_select_file", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GFile__P(file), file, 2, "gtk_file_chooser_select_file", "GFile*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_file_chooser_select_file(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GFile_(file), &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_widget_set_hexpand_set "void gtk_widget_set_hexpand_set(GtkWidget* widget, gboolean set)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_hexpand_set", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(set), set, 2, "gtk_widget_set_hexpand_set", "gboolean");
+ gtk_widget_set_hexpand_set(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(set));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_unselect_file(XEN chooser, XEN file)
+static Xen gxg_gtk_widget_get_vexpand(Xen widget)
{
- #define H_gtk_file_chooser_unselect_file "void gtk_file_chooser_unselect_file(GtkFileChooser* chooser, \
-GFile* file)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_unselect_file", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GFile__P(file), file, 2, "gtk_file_chooser_unselect_file", "GFile*");
- gtk_file_chooser_unselect_file(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GFile_(file));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_vexpand "gboolean gtk_widget_get_vexpand(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_vexpand", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_vexpand(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_file_chooser_get_files(XEN chooser)
+static Xen gxg_gtk_widget_set_vexpand(Xen widget, Xen expand)
{
- #define H_gtk_file_chooser_get_files "GSList* gtk_file_chooser_get_files(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_files", "GtkFileChooser*");
- return(C_TO_XEN_GSList_(gtk_file_chooser_get_files(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_widget_set_vexpand "void gtk_widget_set_vexpand(GtkWidget* widget, gboolean expand)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_vexpand", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(expand), expand, 2, "gtk_widget_set_vexpand", "gboolean");
+ gtk_widget_set_vexpand(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(expand));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_set_current_folder_file(XEN chooser, XEN file, XEN ignore_error)
+static Xen gxg_gtk_widget_get_vexpand_set(Xen widget)
{
- #define H_gtk_file_chooser_set_current_folder_file "gboolean gtk_file_chooser_set_current_folder_file(GtkFileChooser* chooser, \
-GFile* file, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_current_folder_file", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_GFile__P(file), file, 2, "gtk_file_chooser_set_current_folder_file", "GFile*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_file_chooser_set_current_folder_file(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_GFile_(file),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_widget_get_vexpand_set "gboolean gtk_widget_get_vexpand_set(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_vexpand_set", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_vexpand_set(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_file_chooser_get_current_folder_file(XEN chooser)
+static Xen gxg_gtk_widget_set_vexpand_set(Xen widget, Xen set)
{
- #define H_gtk_file_chooser_get_current_folder_file "GFile* gtk_file_chooser_get_current_folder_file(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_current_folder_file", "GtkFileChooser*");
- return(C_TO_XEN_GFile_(gtk_file_chooser_get_current_folder_file(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_widget_set_vexpand_set "void gtk_widget_set_vexpand_set(GtkWidget* widget, gboolean set)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_vexpand_set", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(set), set, 2, "gtk_widget_set_vexpand_set", "gboolean");
+ gtk_widget_set_vexpand_set(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(set));
+ return(Xen_false);
}
-static XEN gxg_gtk_file_chooser_get_preview_file(XEN chooser)
+static Xen gxg_gtk_widget_queue_compute_expand(Xen widget)
{
- #define H_gtk_file_chooser_get_preview_file "GFile* gtk_file_chooser_get_preview_file(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_preview_file", "GtkFileChooser*");
- return(C_TO_XEN_GFile_(gtk_file_chooser_get_preview_file(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_widget_queue_compute_expand "void gtk_widget_queue_compute_expand(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_queue_compute_expand", "GtkWidget*");
+ gtk_widget_queue_compute_expand(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_default_widget(XEN window)
+static Xen gxg_gtk_widget_compute_expand(Xen widget, Xen orientation)
{
- #define H_gtk_window_get_default_widget "GtkWidget* gtk_window_get_default_widget(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_default_widget", "GtkWindow*");
- return(C_TO_XEN_GtkWidget_(gtk_window_get_default_widget(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_widget_compute_expand "gboolean gtk_widget_compute_expand(GtkWidget* widget, GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_compute_expand", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 2, "gtk_widget_compute_expand", "GtkOrientation");
+ return(C_to_Xen_gboolean(gtk_widget_compute_expand(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkOrientation(orientation))));
}
-#endif
-
-#if HAVE_GTK_SCALE_ADD_MARK
-static XEN gxg_gtk_link_button_get_visited(XEN link_button)
+static Xen gxg_gtk_window_set_default_geometry(Xen window, Xen width, Xen height)
{
- #define H_gtk_link_button_get_visited "gboolean gtk_link_button_get_visited(GtkLinkButton* link_button)"
- XEN_ASSERT_TYPE(XEN_GtkLinkButton__P(link_button), link_button, 1, "gtk_link_button_get_visited", "GtkLinkButton*");
- return(C_TO_XEN_gboolean(gtk_link_button_get_visited(XEN_TO_C_GtkLinkButton_(link_button))));
+ #define H_gtk_window_set_default_geometry "void gtk_window_set_default_geometry(GtkWindow* window, \
+gint width, gint height)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_default_geometry", "GtkWindow*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_window_set_default_geometry", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 3, "gtk_window_set_default_geometry", "gint");
+ gtk_window_set_default_geometry(Xen_to_C_GtkWindow_(window), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_link_button_set_visited(XEN link_button, XEN visited)
+static Xen gxg_gtk_window_resize_to_geometry(Xen window, Xen width, Xen height)
{
- #define H_gtk_link_button_set_visited "void gtk_link_button_set_visited(GtkLinkButton* link_button, \
-bool visited)"
- XEN_ASSERT_TYPE(XEN_GtkLinkButton__P(link_button), link_button, 1, "gtk_link_button_set_visited", "GtkLinkButton*");
- XEN_ASSERT_TYPE(XEN_bool_P(visited), visited, 2, "gtk_link_button_set_visited", "bool");
- gtk_link_button_set_visited(XEN_TO_C_GtkLinkButton_(link_button), XEN_TO_C_bool(visited));
- return(XEN_FALSE);
+ #define H_gtk_window_resize_to_geometry "void gtk_window_resize_to_geometry(GtkWindow* window, gint width, \
+gint height)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_resize_to_geometry", "GtkWindow*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_window_resize_to_geometry", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 3, "gtk_window_resize_to_geometry", "gint");
+ gtk_window_resize_to_geometry(Xen_to_C_GtkWindow_(window), Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_keymap_get_caps_lock_state(XEN keymap)
+static Xen gxg_gtk_combo_box_text_new(void)
{
- #define H_gdk_keymap_get_caps_lock_state "gboolean gdk_keymap_get_caps_lock_state(GdkKeymap* keymap)"
- XEN_ASSERT_TYPE(XEN_GdkKeymap__P(keymap), keymap, 1, "gdk_keymap_get_caps_lock_state", "GdkKeymap*");
- return(C_TO_XEN_gboolean(gdk_keymap_get_caps_lock_state(XEN_TO_C_GdkKeymap_(keymap))));
+ #define H_gtk_combo_box_text_new "GtkWidget* gtk_combo_box_text_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_combo_box_text_new()));
}
-static XEN gxg_gtk_cell_view_get_model(XEN cell_view)
+static Xen gxg_gtk_combo_box_text_new_with_entry(void)
{
- #define H_gtk_cell_view_get_model "GtkTreeModel* gtk_cell_view_get_model(GtkCellView* cell_view)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_get_model", "GtkCellView*");
- return(C_TO_XEN_GtkTreeModel_(gtk_cell_view_get_model(XEN_TO_C_GtkCellView_(cell_view))));
+ #define H_gtk_combo_box_text_new_with_entry "GtkWidget* gtk_combo_box_text_new_with_entry( void)"
+ return(C_to_Xen_GtkWidget_(gtk_combo_box_text_new_with_entry()));
}
-static XEN gxg_gtk_entry_unset_invisible_char(XEN entry)
+static Xen gxg_gtk_combo_box_text_append_text(Xen combo_box, Xen text)
{
- #define H_gtk_entry_unset_invisible_char "void gtk_entry_unset_invisible_char(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_unset_invisible_char", "GtkEntry*");
- gtk_entry_unset_invisible_char(XEN_TO_C_GtkEntry_(entry));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_text_append_text "void gtk_combo_box_text_append_text(GtkComboBoxText* combo_box, \
+gchar* text)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_append_text", "GtkComboBoxText*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_combo_box_text_append_text", "gchar*");
+ gtk_combo_box_text_append_text(Xen_to_C_GtkComboBoxText_(combo_box), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_progress_fraction(XEN entry, XEN fraction)
+static Xen gxg_gtk_combo_box_text_insert_text(Xen combo_box, Xen position, Xen text)
{
- #define H_gtk_entry_set_progress_fraction "void gtk_entry_set_progress_fraction(GtkEntry* entry, gdouble fraction)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_progress_fraction", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(fraction), fraction, 2, "gtk_entry_set_progress_fraction", "gdouble");
- gtk_entry_set_progress_fraction(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gdouble(fraction));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_text_insert_text "void gtk_combo_box_text_insert_text(GtkComboBoxText* combo_box, \
+gint position, gchar* text)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_insert_text", "GtkComboBoxText*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_combo_box_text_insert_text", "gint");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_combo_box_text_insert_text", "gchar*");
+ gtk_combo_box_text_insert_text(Xen_to_C_GtkComboBoxText_(combo_box), Xen_to_C_gint(position), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_progress_fraction(XEN entry)
+static Xen gxg_gtk_combo_box_text_prepend_text(Xen combo_box, Xen text)
{
- #define H_gtk_entry_get_progress_fraction "gdouble gtk_entry_get_progress_fraction(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_progress_fraction", "GtkEntry*");
- return(C_TO_XEN_gdouble(gtk_entry_get_progress_fraction(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gtk_combo_box_text_prepend_text "void gtk_combo_box_text_prepend_text(GtkComboBoxText* combo_box, \
+gchar* text)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_prepend_text", "GtkComboBoxText*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_combo_box_text_prepend_text", "gchar*");
+ gtk_combo_box_text_prepend_text(Xen_to_C_GtkComboBoxText_(combo_box), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_progress_pulse_step(XEN entry, XEN fraction)
+static Xen gxg_gtk_combo_box_text_remove(Xen combo_box, Xen position)
{
- #define H_gtk_entry_set_progress_pulse_step "void gtk_entry_set_progress_pulse_step(GtkEntry* entry, \
-gdouble fraction)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_progress_pulse_step", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(fraction), fraction, 2, "gtk_entry_set_progress_pulse_step", "gdouble");
- gtk_entry_set_progress_pulse_step(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gdouble(fraction));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_text_remove "void gtk_combo_box_text_remove(GtkComboBoxText* combo_box, gint position)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_remove", "GtkComboBoxText*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_combo_box_text_remove", "gint");
+ gtk_combo_box_text_remove(Xen_to_C_GtkComboBoxText_(combo_box), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_progress_pulse_step(XEN entry)
+static Xen gxg_gtk_combo_box_text_get_active_text(Xen combo_box)
{
- #define H_gtk_entry_get_progress_pulse_step "gdouble gtk_entry_get_progress_pulse_step(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_progress_pulse_step", "GtkEntry*");
- return(C_TO_XEN_gdouble(gtk_entry_get_progress_pulse_step(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gtk_combo_box_text_get_active_text "gchar* gtk_combo_box_text_get_active_text(GtkComboBoxText* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_get_active_text", "GtkComboBoxText*");
+ return(C_to_Xen_gchar_(gtk_combo_box_text_get_active_text(Xen_to_C_GtkComboBoxText_(combo_box))));
}
-static XEN gxg_gtk_entry_progress_pulse(XEN entry)
+static Xen gxg_gdk_cairo_set_source_rgba(Xen cr, Xen rgba)
{
- #define H_gtk_entry_progress_pulse "void gtk_entry_progress_pulse(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_progress_pulse", "GtkEntry*");
- gtk_entry_progress_pulse(XEN_TO_C_GtkEntry_(entry));
- return(XEN_FALSE);
+ #define H_gdk_cairo_set_source_rgba "void gdk_cairo_set_source_rgba(cairo_t* cr, GdkRGBA* rgba)"
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "gdk_cairo_set_source_rgba", "cairo_t*");
+ Xen_check_type(Xen_is_GdkRGBA_(rgba), rgba, 2, "gdk_cairo_set_source_rgba", "GdkRGBA*");
+ gdk_cairo_set_source_rgba(Xen_to_C_cairo_t_(cr), Xen_to_C_GdkRGBA_(rgba));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_icon_from_pixbuf(XEN entry, XEN icon_pos, XEN pixbuf)
+static Xen gxg_gdk_window_set_background_rgba(Xen window, Xen rgba)
{
- #define H_gtk_entry_set_icon_from_pixbuf "void gtk_entry_set_icon_from_pixbuf(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
-GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_from_pixbuf", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_from_pixbuf", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 3, "gtk_entry_set_icon_from_pixbuf", "GdkPixbuf*");
- gtk_entry_set_icon_from_pixbuf(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gdk_window_set_background_rgba "void gdk_window_set_background_rgba(GdkWindow* window, GdkRGBA* rgba)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_background_rgba", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkRGBA_(rgba), rgba, 2, "gdk_window_set_background_rgba", "GdkRGBA*");
+ gdk_window_set_background_rgba(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkRGBA_(rgba));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_icon_from_stock(XEN entry, XEN icon_pos, XEN stock_id)
+static Xen gxg_gtk_cell_view_set_background_rgba(Xen cell_view, Xen rgba)
{
- #define H_gtk_entry_set_icon_from_stock "void gtk_entry_set_icon_from_stock(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
-gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_from_stock", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_from_stock", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 3, "gtk_entry_set_icon_from_stock", "gchar*");
- gtk_entry_set_icon_from_stock(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_gchar_(stock_id));
- return(XEN_FALSE);
+ #define H_gtk_cell_view_set_background_rgba "void gtk_cell_view_set_background_rgba(GtkCellView* cell_view, \
+GdkRGBA* rgba)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_set_background_rgba", "GtkCellView*");
+ Xen_check_type(Xen_is_GdkRGBA_(rgba), rgba, 2, "gtk_cell_view_set_background_rgba", "GdkRGBA*");
+ gtk_cell_view_set_background_rgba(Xen_to_C_GtkCellView_(cell_view), Xen_to_C_GdkRGBA_(rgba));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_icon_from_icon_name(XEN entry, XEN icon_pos, XEN icon_name)
+static Xen gxg_gtk_combo_box_text_remove_all(Xen combo_box)
{
- #define H_gtk_entry_set_icon_from_icon_name "void gtk_entry_set_icon_from_icon_name(GtkEntry* entry, \
-GtkEntryIconPosition icon_pos, gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_from_icon_name", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_from_icon_name", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 3, "gtk_entry_set_icon_from_icon_name", "gchar*");
- gtk_entry_set_icon_from_icon_name(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_gchar_(icon_name));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_text_remove_all "void gtk_combo_box_text_remove_all(GtkComboBoxText* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_remove_all", "GtkComboBoxText*");
+ gtk_combo_box_text_remove_all(Xen_to_C_GtkComboBoxText_(combo_box));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_icon_from_gicon(XEN entry, XEN icon_pos, XEN icon)
+static Xen gxg_gtk_combo_box_set_popup_fixed_width(Xen combo_box, Xen fixed)
{
- #define H_gtk_entry_set_icon_from_gicon "void gtk_entry_set_icon_from_gicon(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
-GIcon* icon)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_from_gicon", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_from_gicon", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_GIcon__P(icon), icon, 3, "gtk_entry_set_icon_from_gicon", "GIcon*");
- gtk_entry_set_icon_from_gicon(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_GIcon_(icon));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_set_popup_fixed_width "void gtk_combo_box_set_popup_fixed_width(GtkComboBox* combo_box, \
+gboolean fixed)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_popup_fixed_width", "GtkComboBox*");
+ Xen_check_type(Xen_is_gboolean(fixed), fixed, 2, "gtk_combo_box_set_popup_fixed_width", "gboolean");
+ gtk_combo_box_set_popup_fixed_width(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_gboolean(fixed));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_icon_name(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_combo_box_get_popup_fixed_width(Xen combo_box)
{
- #define H_gtk_entry_get_icon_name "gchar* gtk_entry_get_icon_name(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_name", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_name", "GtkEntryIconPosition");
- return(C_TO_XEN_gchar_(gtk_entry_get_icon_name(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_combo_box_get_popup_fixed_width "gboolean gtk_combo_box_get_popup_fixed_width(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_popup_fixed_width", "GtkComboBox*");
+ return(C_to_Xen_gboolean(gtk_combo_box_get_popup_fixed_width(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_entry_set_icon_activatable(XEN entry, XEN icon_pos, XEN activatable)
+static Xen gxg_gtk_scrolled_window_get_min_content_width(Xen scrolled_window)
{
- #define H_gtk_entry_set_icon_activatable "void gtk_entry_set_icon_activatable(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
-gboolean activatable)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_activatable", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_activatable", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_gboolean_P(activatable), activatable, 3, "gtk_entry_set_icon_activatable", "gboolean");
- gtk_entry_set_icon_activatable(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_gboolean(activatable));
- return(XEN_FALSE);
+ #define H_gtk_scrolled_window_get_min_content_width "gint gtk_scrolled_window_get_min_content_width(GtkScrolledWindow* scrolled_window)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_min_content_width", "GtkScrolledWindow*");
+ return(C_to_Xen_gint(gtk_scrolled_window_get_min_content_width(Xen_to_C_GtkScrolledWindow_(scrolled_window))));
}
-static XEN gxg_gtk_entry_get_icon_activatable(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_scrolled_window_set_min_content_width(Xen scrolled_window, Xen width)
{
- #define H_gtk_entry_get_icon_activatable "gboolean gtk_entry_get_icon_activatable(GtkEntry* entry, \
-GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_activatable", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_activatable", "GtkEntryIconPosition");
- return(C_TO_XEN_gboolean(gtk_entry_get_icon_activatable(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_scrolled_window_set_min_content_width "void gtk_scrolled_window_set_min_content_width(GtkScrolledWindow* scrolled_window, \
+gint width)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_min_content_width", "GtkScrolledWindow*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_scrolled_window_set_min_content_width", "gint");
+ gtk_scrolled_window_set_min_content_width(Xen_to_C_GtkScrolledWindow_(scrolled_window), Xen_to_C_gint(width));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_icon_sensitive(XEN entry, XEN icon_pos, XEN sensitive)
+static Xen gxg_gtk_scrolled_window_get_min_content_height(Xen scrolled_window)
{
- #define H_gtk_entry_set_icon_sensitive "void gtk_entry_set_icon_sensitive(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
-gboolean sensitive)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_sensitive", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_sensitive", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_gboolean_P(sensitive), sensitive, 3, "gtk_entry_set_icon_sensitive", "gboolean");
- gtk_entry_set_icon_sensitive(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_gboolean(sensitive));
- return(XEN_FALSE);
+ #define H_gtk_scrolled_window_get_min_content_height "gint gtk_scrolled_window_get_min_content_height(GtkScrolledWindow* scrolled_window)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_min_content_height", "GtkScrolledWindow*");
+ return(C_to_Xen_gint(gtk_scrolled_window_get_min_content_height(Xen_to_C_GtkScrolledWindow_(scrolled_window))));
}
-static XEN gxg_gtk_entry_get_icon_sensitive(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_scrolled_window_set_min_content_height(Xen scrolled_window, Xen height)
{
- #define H_gtk_entry_get_icon_sensitive "gboolean gtk_entry_get_icon_sensitive(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_sensitive", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_sensitive", "GtkEntryIconPosition");
- return(C_TO_XEN_gboolean(gtk_entry_get_icon_sensitive(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_scrolled_window_set_min_content_height "void gtk_scrolled_window_set_min_content_height(GtkScrolledWindow* scrolled_window, \
+gint height)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_min_content_height", "GtkScrolledWindow*");
+ Xen_check_type(Xen_is_gint(height), height, 2, "gtk_scrolled_window_set_min_content_height", "gint");
+ gtk_scrolled_window_set_min_content_height(Xen_to_C_GtkScrolledWindow_(scrolled_window), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_icon_at_pos(XEN entry, XEN x, XEN y)
+static Xen gxg_gtk_grid_new(void)
{
- #define H_gtk_entry_get_icon_at_pos "gint gtk_entry_get_icon_at_pos(GtkEntry* entry, gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_at_pos", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_entry_get_icon_at_pos", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_entry_get_icon_at_pos", "gint");
- return(C_TO_XEN_gint(gtk_entry_get_icon_at_pos(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_gint(x), XEN_TO_C_gint(y))));
+ #define H_gtk_grid_new "GtkWidget* gtk_grid_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_grid_new()));
}
-static XEN gxg_gtk_entry_set_icon_tooltip_text(XEN entry, XEN icon_pos, XEN tooltip)
+static Xen gxg_gtk_grid_attach(Xen grid, Xen child, Xen left, Xen top, Xen width, Xen height)
{
- #define H_gtk_entry_set_icon_tooltip_text "void gtk_entry_set_icon_tooltip_text(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
-gchar* tooltip)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_tooltip_text", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_tooltip_text", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_gchar__P(tooltip), tooltip, 3, "gtk_entry_set_icon_tooltip_text", "gchar*");
- gtk_entry_set_icon_tooltip_text(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_gchar_(tooltip));
- return(XEN_FALSE);
+ #define H_gtk_grid_attach "void gtk_grid_attach(GtkGrid* grid, GtkWidget* child, gint left, gint top, \
+gint width, gint height)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_attach", "GtkGrid*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_grid_attach", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(left), left, 3, "gtk_grid_attach", "gint");
+ Xen_check_type(Xen_is_gint(top), top, 4, "gtk_grid_attach", "gint");
+ Xen_check_type(Xen_is_gint(width), width, 5, "gtk_grid_attach", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 6, "gtk_grid_attach", "gint");
+ gtk_grid_attach(Xen_to_C_GtkGrid_(grid), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(left), Xen_to_C_gint(top), Xen_to_C_gint(width),
+ Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_icon_tooltip_markup(XEN entry, XEN icon_pos, XEN tooltip)
+static Xen gxg_gtk_grid_attach_next_to(Xen grid, Xen child, Xen sibling, Xen side, Xen width, Xen height)
{
- #define H_gtk_entry_set_icon_tooltip_markup "void gtk_entry_set_icon_tooltip_markup(GtkEntry* entry, \
-GtkEntryIconPosition icon_pos, gchar* tooltip)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_tooltip_markup", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_tooltip_markup", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_gchar__P(tooltip), tooltip, 3, "gtk_entry_set_icon_tooltip_markup", "gchar*");
- gtk_entry_set_icon_tooltip_markup(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_gchar_(tooltip));
- return(XEN_FALSE);
+ #define H_gtk_grid_attach_next_to "void gtk_grid_attach_next_to(GtkGrid* grid, GtkWidget* child, GtkWidget* sibling, \
+GtkPositionType side, gint width, gint height)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_attach_next_to", "GtkGrid*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_grid_attach_next_to", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkWidget_(sibling), sibling, 3, "gtk_grid_attach_next_to", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkPositionType(side), side, 4, "gtk_grid_attach_next_to", "GtkPositionType");
+ Xen_check_type(Xen_is_gint(width), width, 5, "gtk_grid_attach_next_to", "gint");
+ Xen_check_type(Xen_is_gint(height), height, 6, "gtk_grid_attach_next_to", "gint");
+ gtk_grid_attach_next_to(Xen_to_C_GtkGrid_(grid), Xen_to_C_GtkWidget_(child), Xen_to_C_GtkWidget_(sibling), Xen_to_C_GtkPositionType(side),
+ Xen_to_C_gint(width), Xen_to_C_gint(height));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_set_icon_drag_source(XEN entry, XEN icon_pos, XEN target_list, XEN actions)
+static Xen gxg_gtk_grid_set_row_homogeneous(Xen grid, Xen homogeneous)
{
- #define H_gtk_entry_set_icon_drag_source "void gtk_entry_set_icon_drag_source(GtkEntry* entry, GtkEntryIconPosition icon_pos, \
-GtkTargetList* target_list, GdkDragAction actions)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_icon_drag_source", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_set_icon_drag_source", "GtkEntryIconPosition");
- XEN_ASSERT_TYPE(XEN_GtkTargetList__P(target_list), target_list, 3, "gtk_entry_set_icon_drag_source", "GtkTargetList*");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 4, "gtk_entry_set_icon_drag_source", "GdkDragAction");
- gtk_entry_set_icon_drag_source(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos), XEN_TO_C_GtkTargetList_(target_list),
- XEN_TO_C_GdkDragAction(actions));
- return(XEN_FALSE);
+ #define H_gtk_grid_set_row_homogeneous "void gtk_grid_set_row_homogeneous(GtkGrid* grid, gboolean homogeneous)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_set_row_homogeneous", "GtkGrid*");
+ Xen_check_type(Xen_is_gboolean(homogeneous), homogeneous, 2, "gtk_grid_set_row_homogeneous", "gboolean");
+ gtk_grid_set_row_homogeneous(Xen_to_C_GtkGrid_(grid), Xen_to_C_gboolean(homogeneous));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_current_icon_drag_source(XEN entry)
+static Xen gxg_gtk_grid_get_row_homogeneous(Xen grid)
{
- #define H_gtk_entry_get_current_icon_drag_source "gint gtk_entry_get_current_icon_drag_source(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_current_icon_drag_source", "GtkEntry*");
- return(C_TO_XEN_gint(gtk_entry_get_current_icon_drag_source(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gtk_grid_get_row_homogeneous "gboolean gtk_grid_get_row_homogeneous(GtkGrid* grid)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_get_row_homogeneous", "GtkGrid*");
+ return(C_to_Xen_gboolean(gtk_grid_get_row_homogeneous(Xen_to_C_GtkGrid_(grid))));
}
-static XEN gxg_gtk_image_menu_item_set_use_stock(XEN image_menu_item, XEN use_stock)
+static Xen gxg_gtk_grid_set_row_spacing(Xen grid, Xen spacing)
{
- #define H_gtk_image_menu_item_set_use_stock "void gtk_image_menu_item_set_use_stock(GtkImageMenuItem* image_menu_item, \
-gboolean use_stock)"
- XEN_ASSERT_TYPE(XEN_GtkImageMenuItem__P(image_menu_item), image_menu_item, 1, "gtk_image_menu_item_set_use_stock", "GtkImageMenuItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_stock), use_stock, 2, "gtk_image_menu_item_set_use_stock", "gboolean");
- gtk_image_menu_item_set_use_stock(XEN_TO_C_GtkImageMenuItem_(image_menu_item), XEN_TO_C_gboolean(use_stock));
- return(XEN_FALSE);
+ #define H_gtk_grid_set_row_spacing "void gtk_grid_set_row_spacing(GtkGrid* grid, guint spacing)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_set_row_spacing", "GtkGrid*");
+ Xen_check_type(Xen_is_guint(spacing), spacing, 2, "gtk_grid_set_row_spacing", "guint");
+ gtk_grid_set_row_spacing(Xen_to_C_GtkGrid_(grid), Xen_to_C_guint(spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_menu_item_get_use_stock(XEN image_menu_item)
+static Xen gxg_gtk_grid_get_row_spacing(Xen grid)
{
- #define H_gtk_image_menu_item_get_use_stock "gboolean gtk_image_menu_item_get_use_stock(GtkImageMenuItem* image_menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkImageMenuItem__P(image_menu_item), image_menu_item, 1, "gtk_image_menu_item_get_use_stock", "GtkImageMenuItem*");
- return(C_TO_XEN_gboolean(gtk_image_menu_item_get_use_stock(XEN_TO_C_GtkImageMenuItem_(image_menu_item))));
+ #define H_gtk_grid_get_row_spacing "guint gtk_grid_get_row_spacing(GtkGrid* grid)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_get_row_spacing", "GtkGrid*");
+ return(C_to_Xen_guint(gtk_grid_get_row_spacing(Xen_to_C_GtkGrid_(grid))));
}
-static XEN gxg_gtk_image_menu_item_set_accel_group(XEN image_menu_item, XEN accel_group)
+static Xen gxg_gtk_grid_set_column_homogeneous(Xen grid, Xen homogeneous)
{
- #define H_gtk_image_menu_item_set_accel_group "void gtk_image_menu_item_set_accel_group(GtkImageMenuItem* image_menu_item, \
-GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkImageMenuItem__P(image_menu_item), image_menu_item, 1, "gtk_image_menu_item_set_accel_group", "GtkImageMenuItem*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 2, "gtk_image_menu_item_set_accel_group", "GtkAccelGroup*");
- gtk_image_menu_item_set_accel_group(XEN_TO_C_GtkImageMenuItem_(image_menu_item), XEN_TO_C_GtkAccelGroup_(accel_group));
- return(XEN_FALSE);
+ #define H_gtk_grid_set_column_homogeneous "void gtk_grid_set_column_homogeneous(GtkGrid* grid, gboolean homogeneous)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_set_column_homogeneous", "GtkGrid*");
+ Xen_check_type(Xen_is_gboolean(homogeneous), homogeneous, 2, "gtk_grid_set_column_homogeneous", "gboolean");
+ gtk_grid_set_column_homogeneous(Xen_to_C_GtkGrid_(grid), Xen_to_C_gboolean(homogeneous));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_item_set_label(XEN menu_item, XEN label)
+static Xen gxg_gtk_grid_get_column_homogeneous(Xen grid)
{
- #define H_gtk_menu_item_set_label "void gtk_menu_item_set_label(GtkMenuItem* menu_item, gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_set_label", "GtkMenuItem*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_menu_item_set_label", "gchar*");
- gtk_menu_item_set_label(XEN_TO_C_GtkMenuItem_(menu_item), XEN_TO_C_gchar_(label));
- return(XEN_FALSE);
+ #define H_gtk_grid_get_column_homogeneous "gboolean gtk_grid_get_column_homogeneous(GtkGrid* grid)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_get_column_homogeneous", "GtkGrid*");
+ return(C_to_Xen_gboolean(gtk_grid_get_column_homogeneous(Xen_to_C_GtkGrid_(grid))));
}
-static XEN gxg_gtk_menu_item_get_label(XEN menu_item)
+static Xen gxg_gtk_grid_set_column_spacing(Xen grid, Xen spacing)
{
- #define H_gtk_menu_item_get_label "gchar* gtk_menu_item_get_label(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_get_label", "GtkMenuItem*");
- return(C_TO_XEN_gchar_(gtk_menu_item_get_label(XEN_TO_C_GtkMenuItem_(menu_item))));
+ #define H_gtk_grid_set_column_spacing "void gtk_grid_set_column_spacing(GtkGrid* grid, guint spacing)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_set_column_spacing", "GtkGrid*");
+ Xen_check_type(Xen_is_guint(spacing), spacing, 2, "gtk_grid_set_column_spacing", "guint");
+ gtk_grid_set_column_spacing(Xen_to_C_GtkGrid_(grid), Xen_to_C_guint(spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_item_set_use_underline(XEN menu_item, XEN setting)
+static Xen gxg_gtk_grid_get_column_spacing(Xen grid)
{
- #define H_gtk_menu_item_set_use_underline "void gtk_menu_item_set_use_underline(GtkMenuItem* menu_item, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_set_use_underline", "GtkMenuItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_menu_item_set_use_underline", "gboolean");
- gtk_menu_item_set_use_underline(XEN_TO_C_GtkMenuItem_(menu_item), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_grid_get_column_spacing "guint gtk_grid_get_column_spacing(GtkGrid* grid)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_get_column_spacing", "GtkGrid*");
+ return(C_to_Xen_guint(gtk_grid_get_column_spacing(Xen_to_C_GtkGrid_(grid))));
}
-static XEN gxg_gtk_menu_item_get_use_underline(XEN menu_item)
+static Xen gxg_gtk_scrollable_get_hadjustment(Xen scrollable)
{
- #define H_gtk_menu_item_get_use_underline "gboolean gtk_menu_item_get_use_underline(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_get_use_underline", "GtkMenuItem*");
- return(C_TO_XEN_gboolean(gtk_menu_item_get_use_underline(XEN_TO_C_GtkMenuItem_(menu_item))));
+ #define H_gtk_scrollable_get_hadjustment "GtkAdjustment* gtk_scrollable_get_hadjustment(GtkScrollable* scrollable)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_get_hadjustment", "GtkScrollable*");
+ return(C_to_Xen_GtkAdjustment_(gtk_scrollable_get_hadjustment(Xen_to_C_GtkScrollable_(scrollable))));
}
-static XEN gxg_gtk_selection_data_get_selection(XEN selection_data)
+static Xen gxg_gtk_scrollable_set_hadjustment(Xen scrollable, Xen hadjustment)
{
- #define H_gtk_selection_data_get_selection "GdkAtom gtk_selection_data_get_selection(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_selection", "GtkSelectionData*");
- return(C_TO_XEN_GdkAtom(gtk_selection_data_get_selection(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_scrollable_set_hadjustment "void gtk_scrollable_set_hadjustment(GtkScrollable* scrollable, \
+GtkAdjustment* hadjustment)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_set_hadjustment", "GtkScrollable*");
+ Xen_check_type(Xen_is_GtkAdjustment_(hadjustment), hadjustment, 2, "gtk_scrollable_set_hadjustment", "GtkAdjustment*");
+ gtk_scrollable_set_hadjustment(Xen_to_C_GtkScrollable_(scrollable), Xen_to_C_GtkAdjustment_(hadjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_set_label(XEN action, XEN label)
+static Xen gxg_gtk_scrollable_get_vadjustment(Xen scrollable)
{
- #define H_gtk_action_set_label "void gtk_action_set_label(GtkAction* action, gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_label", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_action_set_label", "gchar*");
- gtk_action_set_label(XEN_TO_C_GtkAction_(action), XEN_TO_C_gchar_(label));
- return(XEN_FALSE);
+ #define H_gtk_scrollable_get_vadjustment "GtkAdjustment* gtk_scrollable_get_vadjustment(GtkScrollable* scrollable)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_get_vadjustment", "GtkScrollable*");
+ return(C_to_Xen_GtkAdjustment_(gtk_scrollable_get_vadjustment(Xen_to_C_GtkScrollable_(scrollable))));
}
-static XEN gxg_gtk_action_get_label(XEN action)
+static Xen gxg_gtk_scrollable_set_vadjustment(Xen scrollable, Xen vadjustment)
{
- #define H_gtk_action_get_label "gchar* gtk_action_get_label(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_label", "GtkAction*");
- return(C_TO_XEN_gchar_(gtk_action_get_label(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_scrollable_set_vadjustment "void gtk_scrollable_set_vadjustment(GtkScrollable* scrollable, \
+GtkAdjustment* vadjustment)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_set_vadjustment", "GtkScrollable*");
+ Xen_check_type(Xen_is_GtkAdjustment_(vadjustment), vadjustment, 2, "gtk_scrollable_set_vadjustment", "GtkAdjustment*");
+ gtk_scrollable_set_vadjustment(Xen_to_C_GtkScrollable_(scrollable), Xen_to_C_GtkAdjustment_(vadjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_set_short_label(XEN action, XEN short_label)
+static Xen gxg_gtk_assistant_next_page(Xen assistant)
{
- #define H_gtk_action_set_short_label "void gtk_action_set_short_label(GtkAction* action, gchar* short_label)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_short_label", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gchar__P(short_label), short_label, 2, "gtk_action_set_short_label", "gchar*");
- gtk_action_set_short_label(XEN_TO_C_GtkAction_(action), XEN_TO_C_gchar_(short_label));
- return(XEN_FALSE);
+ #define H_gtk_assistant_next_page "void gtk_assistant_next_page(GtkAssistant* assistant)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_next_page", "GtkAssistant*");
+ gtk_assistant_next_page(Xen_to_C_GtkAssistant_(assistant));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_get_short_label(XEN action)
+static Xen gxg_gtk_assistant_previous_page(Xen assistant)
{
- #define H_gtk_action_get_short_label "gchar* gtk_action_get_short_label(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_short_label", "GtkAction*");
- return(C_TO_XEN_gchar_(gtk_action_get_short_label(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_assistant_previous_page "void gtk_assistant_previous_page(GtkAssistant* assistant)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_previous_page", "GtkAssistant*");
+ gtk_assistant_previous_page(Xen_to_C_GtkAssistant_(assistant));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_set_tooltip(XEN action, XEN tooltip)
+static Xen gxg_gtk_combo_box_new_with_model_and_entry(Xen model)
{
- #define H_gtk_action_set_tooltip "void gtk_action_set_tooltip(GtkAction* action, gchar* tooltip)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_tooltip", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gchar__P(tooltip), tooltip, 2, "gtk_action_set_tooltip", "gchar*");
- gtk_action_set_tooltip(XEN_TO_C_GtkAction_(action), XEN_TO_C_gchar_(tooltip));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_new_with_model_and_entry "GtkWidget* gtk_combo_box_new_with_model_and_entry(GtkTreeModel* model)"
+ Xen_check_type(Xen_is_GtkTreeModel_(model), model, 1, "gtk_combo_box_new_with_model_and_entry", "GtkTreeModel*");
+ return(C_to_Xen_GtkWidget_(gtk_combo_box_new_with_model_and_entry(Xen_to_C_GtkTreeModel_(model))));
}
-static XEN gxg_gtk_action_get_tooltip(XEN action)
+static Xen gxg_gtk_scrollable_get_hscroll_policy(Xen scrollable)
{
- #define H_gtk_action_get_tooltip "gchar* gtk_action_get_tooltip(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_tooltip", "GtkAction*");
- return(C_TO_XEN_gchar_(gtk_action_get_tooltip(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_scrollable_get_hscroll_policy "GtkScrollablePolicy gtk_scrollable_get_hscroll_policy(GtkScrollable* scrollable)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_get_hscroll_policy", "GtkScrollable*");
+ return(C_to_Xen_GtkScrollablePolicy(gtk_scrollable_get_hscroll_policy(Xen_to_C_GtkScrollable_(scrollable))));
}
-static XEN gxg_gtk_action_set_stock_id(XEN action, XEN stock_id)
+static Xen gxg_gtk_scrollable_set_hscroll_policy(Xen scrollable, Xen policy)
{
- #define H_gtk_action_set_stock_id "void gtk_action_set_stock_id(GtkAction* action, gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_stock_id", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_action_set_stock_id", "gchar*");
- gtk_action_set_stock_id(XEN_TO_C_GtkAction_(action), XEN_TO_C_gchar_(stock_id));
- return(XEN_FALSE);
+ #define H_gtk_scrollable_set_hscroll_policy "void gtk_scrollable_set_hscroll_policy(GtkScrollable* scrollable, \
+GtkScrollablePolicy policy)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_set_hscroll_policy", "GtkScrollable*");
+ Xen_check_type(Xen_is_GtkScrollablePolicy(policy), policy, 2, "gtk_scrollable_set_hscroll_policy", "GtkScrollablePolicy");
+ gtk_scrollable_set_hscroll_policy(Xen_to_C_GtkScrollable_(scrollable), Xen_to_C_GtkScrollablePolicy(policy));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_get_stock_id(XEN action)
+static Xen gxg_gtk_scrollable_get_vscroll_policy(Xen scrollable)
{
- #define H_gtk_action_get_stock_id "gchar* gtk_action_get_stock_id(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_stock_id", "GtkAction*");
- return(C_TO_XEN_gchar_(gtk_action_get_stock_id(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_scrollable_get_vscroll_policy "GtkScrollablePolicy gtk_scrollable_get_vscroll_policy(GtkScrollable* scrollable)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_get_vscroll_policy", "GtkScrollable*");
+ return(C_to_Xen_GtkScrollablePolicy(gtk_scrollable_get_vscroll_policy(Xen_to_C_GtkScrollable_(scrollable))));
}
-static XEN gxg_gtk_action_set_gicon(XEN action, XEN icon)
+static Xen gxg_gtk_scrollable_set_vscroll_policy(Xen scrollable, Xen policy)
{
- #define H_gtk_action_set_gicon "void gtk_action_set_gicon(GtkAction* action, GIcon* icon)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_gicon", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_GIcon__P(icon), icon, 2, "gtk_action_set_gicon", "GIcon*");
- gtk_action_set_gicon(XEN_TO_C_GtkAction_(action), XEN_TO_C_GIcon_(icon));
- return(XEN_FALSE);
+ #define H_gtk_scrollable_set_vscroll_policy "void gtk_scrollable_set_vscroll_policy(GtkScrollable* scrollable, \
+GtkScrollablePolicy policy)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_set_vscroll_policy", "GtkScrollable*");
+ Xen_check_type(Xen_is_GtkScrollablePolicy(policy), policy, 2, "gtk_scrollable_set_vscroll_policy", "GtkScrollablePolicy");
+ gtk_scrollable_set_vscroll_policy(Xen_to_C_GtkScrollable_(scrollable), Xen_to_C_GtkScrollablePolicy(policy));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_get_gicon(XEN action)
+static Xen gxg_gtk_switch_new(void)
{
- #define H_gtk_action_get_gicon "GIcon* gtk_action_get_gicon(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_gicon", "GtkAction*");
- return(C_TO_XEN_GIcon_(gtk_action_get_gicon(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_switch_new "GtkWidget* gtk_switch_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_switch_new()));
}
-static XEN gxg_gtk_action_set_icon_name(XEN action, XEN icon_name)
+static Xen gxg_gtk_switch_set_active(Xen sw, Xen is_active)
{
- #define H_gtk_action_set_icon_name "void gtk_action_set_icon_name(GtkAction* action, gchar* icon_name)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_icon_name", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gchar__P(icon_name), icon_name, 2, "gtk_action_set_icon_name", "gchar*");
- gtk_action_set_icon_name(XEN_TO_C_GtkAction_(action), XEN_TO_C_gchar_(icon_name));
- return(XEN_FALSE);
+ #define H_gtk_switch_set_active "void gtk_switch_set_active(GtkSwitch* sw, gboolean is_active)"
+ Xen_check_type(Xen_is_GtkSwitch_(sw), sw, 1, "gtk_switch_set_active", "GtkSwitch*");
+ Xen_check_type(Xen_is_gboolean(is_active), is_active, 2, "gtk_switch_set_active", "gboolean");
+ gtk_switch_set_active(Xen_to_C_GtkSwitch_(sw), Xen_to_C_gboolean(is_active));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_get_icon_name(XEN action)
+static Xen gxg_gtk_switch_get_active(Xen sw)
{
- #define H_gtk_action_get_icon_name "gchar* gtk_action_get_icon_name(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_icon_name", "GtkAction*");
- return(C_TO_XEN_gchar_(gtk_action_get_icon_name(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_switch_get_active "gboolean gtk_switch_get_active(GtkSwitch* sw)"
+ Xen_check_type(Xen_is_GtkSwitch_(sw), sw, 1, "gtk_switch_get_active", "GtkSwitch*");
+ return(C_to_Xen_gboolean(gtk_switch_get_active(Xen_to_C_GtkSwitch_(sw))));
}
-static XEN gxg_gtk_action_set_visible_horizontal(XEN action, XEN visible_horizontal)
+static Xen gxg_gdk_window_get_clip_region(Xen window)
{
- #define H_gtk_action_set_visible_horizontal "void gtk_action_set_visible_horizontal(GtkAction* action, \
-gboolean visible_horizontal)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_visible_horizontal", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible_horizontal), visible_horizontal, 2, "gtk_action_set_visible_horizontal", "gboolean");
- gtk_action_set_visible_horizontal(XEN_TO_C_GtkAction_(action), XEN_TO_C_gboolean(visible_horizontal));
- return(XEN_FALSE);
+ #define H_gdk_window_get_clip_region "cairo_region_t* gdk_window_get_clip_region(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_clip_region", "GdkWindow*");
+ return(C_to_Xen_cairo_region_t_(gdk_window_get_clip_region(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_action_get_visible_horizontal(XEN action)
+static Xen gxg_gdk_window_get_visible_region(Xen window)
{
- #define H_gtk_action_get_visible_horizontal "gboolean gtk_action_get_visible_horizontal(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_visible_horizontal", "GtkAction*");
- return(C_TO_XEN_gboolean(gtk_action_get_visible_horizontal(XEN_TO_C_GtkAction_(action))));
+ #define H_gdk_window_get_visible_region "cairo_region_t* gdk_window_get_visible_region(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_visible_region", "GdkWindow*");
+ return(C_to_Xen_cairo_region_t_(gdk_window_get_visible_region(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_action_set_visible_vertical(XEN action, XEN visible_vertical)
+static Xen gxg_gtk_border_new(void)
{
- #define H_gtk_action_set_visible_vertical "void gtk_action_set_visible_vertical(GtkAction* action, \
-gboolean visible_vertical)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_visible_vertical", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible_vertical), visible_vertical, 2, "gtk_action_set_visible_vertical", "gboolean");
- gtk_action_set_visible_vertical(XEN_TO_C_GtkAction_(action), XEN_TO_C_gboolean(visible_vertical));
- return(XEN_FALSE);
+ #define H_gtk_border_new "GtkBorder* gtk_border_new( void)"
+ return(C_to_Xen_GtkBorder_(gtk_border_new()));
}
-static XEN gxg_gtk_action_get_visible_vertical(XEN action)
+static Xen gxg_gtk_border_copy(Xen border_)
{
- #define H_gtk_action_get_visible_vertical "gboolean gtk_action_get_visible_vertical(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_visible_vertical", "GtkAction*");
- return(C_TO_XEN_gboolean(gtk_action_get_visible_vertical(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_border_copy "GtkBorder* gtk_border_copy(GtkBorder* border_)"
+ Xen_check_type(Xen_is_GtkBorder_(border_), border_, 1, "gtk_border_copy", "GtkBorder*");
+ return(C_to_Xen_GtkBorder_(gtk_border_copy(Xen_to_C_GtkBorder_(border_))));
}
-static XEN gxg_gtk_action_set_is_important(XEN action, XEN is_important)
+static Xen gxg_gtk_border_free(Xen border_)
{
- #define H_gtk_action_set_is_important "void gtk_action_set_is_important(GtkAction* action, gboolean is_important)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_is_important", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_important), is_important, 2, "gtk_action_set_is_important", "gboolean");
- gtk_action_set_is_important(XEN_TO_C_GtkAction_(action), XEN_TO_C_gboolean(is_important));
- return(XEN_FALSE);
+ #define H_gtk_border_free "void gtk_border_free(GtkBorder* border_)"
+ Xen_check_type(Xen_is_GtkBorder_(border_), border_, 1, "gtk_border_free", "GtkBorder*");
+ gtk_border_free(Xen_to_C_GtkBorder_(border_));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_get_is_important(XEN action)
+static Xen gxg_gtk_combo_box_get_id_column(Xen combo_box)
{
- #define H_gtk_action_get_is_important "gboolean gtk_action_get_is_important(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_is_important", "GtkAction*");
- return(C_TO_XEN_gboolean(gtk_action_get_is_important(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_combo_box_get_id_column "gint gtk_combo_box_get_id_column(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_id_column", "GtkComboBox*");
+ return(C_to_Xen_gint(gtk_combo_box_get_id_column(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_entry_get_icon_tooltip_text(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_combo_box_set_id_column(Xen combo_box, Xen id_column)
{
- #define H_gtk_entry_get_icon_tooltip_text "gchar* gtk_entry_get_icon_tooltip_text(GtkEntry* entry, \
-GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_tooltip_text", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_tooltip_text", "GtkEntryIconPosition");
- return(C_TO_XEN_gchar_(gtk_entry_get_icon_tooltip_text(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_combo_box_set_id_column "void gtk_combo_box_set_id_column(GtkComboBox* combo_box, gint id_column)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_id_column", "GtkComboBox*");
+ Xen_check_type(Xen_is_gint(id_column), id_column, 2, "gtk_combo_box_set_id_column", "gint");
+ gtk_combo_box_set_id_column(Xen_to_C_GtkComboBox_(combo_box), Xen_to_C_gint(id_column));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_icon_tooltip_markup(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_combo_box_get_active_id(Xen combo_box)
{
- #define H_gtk_entry_get_icon_tooltip_markup "gchar* gtk_entry_get_icon_tooltip_markup(GtkEntry* entry, \
-GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_tooltip_markup", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_tooltip_markup", "GtkEntryIconPosition");
- return(C_TO_XEN_gchar_(gtk_entry_get_icon_tooltip_markup(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_combo_box_get_active_id "gchar* gtk_combo_box_get_active_id(GtkComboBox* combo_box)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_get_active_id", "GtkComboBox*");
+ return(C_to_Xen_gchar_(gtk_combo_box_get_active_id(Xen_to_C_GtkComboBox_(combo_box))));
}
-static XEN gxg_gtk_scale_add_mark(XEN scale, XEN value, XEN position, XEN markup)
+static Xen gxg_gtk_combo_box_text_insert(Xen combo_box, Xen position, Xen id, Xen text)
{
- #define H_gtk_scale_add_mark "void gtk_scale_add_mark(GtkScale* scale, gdouble value, GtkPositionType position, \
-gchar* markup)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_add_mark", "GtkScale*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 2, "gtk_scale_add_mark", "gdouble");
- XEN_ASSERT_TYPE(XEN_GtkPositionType_P(position), position, 3, "gtk_scale_add_mark", "GtkPositionType");
- XEN_ASSERT_TYPE(XEN_gchar__P(markup), markup, 4, "gtk_scale_add_mark", "gchar*");
- gtk_scale_add_mark(XEN_TO_C_GtkScale_(scale), XEN_TO_C_gdouble(value), XEN_TO_C_GtkPositionType(position), XEN_TO_C_gchar_(markup));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_text_insert "void gtk_combo_box_text_insert(GtkComboBoxText* combo_box, gint position, \
+gchar* id, gchar* text)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_insert", "GtkComboBoxText*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_combo_box_text_insert", "gint");
+ Xen_check_type(Xen_is_gchar_(id), id, 3, "gtk_combo_box_text_insert", "gchar*");
+ Xen_check_type(Xen_is_gchar_(text), text, 4, "gtk_combo_box_text_insert", "gchar*");
+ gtk_combo_box_text_insert(Xen_to_C_GtkComboBoxText_(combo_box), Xen_to_C_gint(position), (const gchar*)Xen_to_C_gchar_(id), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_scale_clear_marks(XEN scale)
+static Xen gxg_gtk_combo_box_text_append(Xen combo_box, Xen id, Xen text)
{
- #define H_gtk_scale_clear_marks "void gtk_scale_clear_marks(GtkScale* scale)"
- XEN_ASSERT_TYPE(XEN_GtkScale__P(scale), scale, 1, "gtk_scale_clear_marks", "GtkScale*");
- gtk_scale_clear_marks(XEN_TO_C_GtkScale_(scale));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_text_append "void gtk_combo_box_text_append(GtkComboBoxText* combo_box, gchar* id, \
+gchar* text)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_append", "GtkComboBoxText*");
+ Xen_check_type(Xen_is_gchar_(id), id, 2, "gtk_combo_box_text_append", "gchar*");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_combo_box_text_append", "gchar*");
+ gtk_combo_box_text_append(Xen_to_C_GtkComboBoxText_(combo_box), (const gchar*)Xen_to_C_gchar_(id), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-#endif
-
-#if HAVE_GTK_INFO_BAR_NEW
-static XEN gxg_gtk_image_menu_item_set_always_show_image(XEN image_menu_item, XEN always_show)
+static Xen gxg_gtk_combo_box_text_prepend(Xen combo_box, Xen id, Xen text)
{
- #define H_gtk_image_menu_item_set_always_show_image "void gtk_image_menu_item_set_always_show_image(GtkImageMenuItem* image_menu_item, \
-gboolean always_show)"
- XEN_ASSERT_TYPE(XEN_GtkImageMenuItem__P(image_menu_item), image_menu_item, 1, "gtk_image_menu_item_set_always_show_image", "GtkImageMenuItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(always_show), always_show, 2, "gtk_image_menu_item_set_always_show_image", "gboolean");
- gtk_image_menu_item_set_always_show_image(XEN_TO_C_GtkImageMenuItem_(image_menu_item), XEN_TO_C_gboolean(always_show));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_text_prepend "void gtk_combo_box_text_prepend(GtkComboBoxText* combo_box, gchar* id, \
+gchar* text)"
+ Xen_check_type(Xen_is_GtkComboBoxText_(combo_box), combo_box, 1, "gtk_combo_box_text_prepend", "GtkComboBoxText*");
+ Xen_check_type(Xen_is_gchar_(id), id, 2, "gtk_combo_box_text_prepend", "gchar*");
+ Xen_check_type(Xen_is_gchar_(text), text, 3, "gtk_combo_box_text_prepend", "gchar*");
+ gtk_combo_box_text_prepend(Xen_to_C_GtkComboBoxText_(combo_box), (const gchar*)Xen_to_C_gchar_(id), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_menu_item_get_always_show_image(XEN image_menu_item)
+static Xen gxg_gtk_button_box_new(Xen orientation)
{
- #define H_gtk_image_menu_item_get_always_show_image "gboolean gtk_image_menu_item_get_always_show_image(GtkImageMenuItem* image_menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkImageMenuItem__P(image_menu_item), image_menu_item, 1, "gtk_image_menu_item_get_always_show_image", "GtkImageMenuItem*");
- return(C_TO_XEN_gboolean(gtk_image_menu_item_get_always_show_image(XEN_TO_C_GtkImageMenuItem_(image_menu_item))));
+ #define H_gtk_button_box_new "GtkWidget* gtk_button_box_new(GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 1, "gtk_button_box_new", "GtkOrientation");
+ return(C_to_Xen_GtkWidget_(gtk_button_box_new(Xen_to_C_GtkOrientation(orientation))));
}
-static XEN gxg_gtk_window_get_default_icon_name(void)
+static Xen gxg_gtk_box_new(Xen orientation, Xen spacing)
{
- #define H_gtk_window_get_default_icon_name "gchar* gtk_window_get_default_icon_name( void)"
- return(C_TO_XEN_gchar_(gtk_window_get_default_icon_name()));
+ #define H_gtk_box_new "GtkWidget* gtk_box_new(GtkOrientation orientation, gint spacing)"
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 1, "gtk_box_new", "GtkOrientation");
+ Xen_check_type(Xen_is_gint(spacing), spacing, 2, "gtk_box_new", "gint");
+ return(C_to_Xen_GtkWidget_(gtk_box_new(Xen_to_C_GtkOrientation(orientation), Xen_to_C_gint(spacing))));
}
-static XEN gxg_gtk_label_get_current_uri(XEN label)
+static Xen gxg_gtk_tree_view_set_cursor_on_cell(Xen tree_view, Xen path, Xen focus_column, Xen focus_cell, Xen start_editing)
{
- #define H_gtk_label_get_current_uri "gchar* gtk_label_get_current_uri(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_current_uri", "GtkLabel*");
- return(C_TO_XEN_gchar_(gtk_label_get_current_uri(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_tree_view_set_cursor_on_cell "void gtk_tree_view_set_cursor_on_cell(GtkTreeView* tree_view, \
+GtkTreePath* path, GtkTreeViewColumn* focus_column, GtkCellRenderer* focus_cell, gboolean start_editing)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_cursor_on_cell", "GtkTreeView*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_view_set_cursor_on_cell", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(focus_column), focus_column, 3, "gtk_tree_view_set_cursor_on_cell", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(focus_cell), focus_cell, 4, "gtk_tree_view_set_cursor_on_cell", "GtkCellRenderer*");
+ Xen_check_type(Xen_is_gboolean(start_editing), start_editing, 5, "gtk_tree_view_set_cursor_on_cell", "gboolean");
+ gtk_tree_view_set_cursor_on_cell(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeViewColumn_(focus_column),
+ Xen_to_C_GtkCellRenderer_(focus_cell), Xen_to_C_gboolean(start_editing));
+ return(Xen_false);
}
-static XEN gxg_gtk_info_bar_new(void)
+static Xen gxg_gtk_tree_view_set_rubber_banding(Xen tree_view, Xen enable)
{
- #define H_gtk_info_bar_new "GtkWidget* gtk_info_bar_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_info_bar_new()));
+ #define H_gtk_tree_view_set_rubber_banding "void gtk_tree_view_set_rubber_banding(GtkTreeView* tree_view, \
+gboolean enable)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_rubber_banding", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(enable), enable, 2, "gtk_tree_view_set_rubber_banding", "gboolean");
+ gtk_tree_view_set_rubber_banding(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(enable));
+ return(Xen_false);
}
-static XEN gxg_gtk_info_bar_get_action_area(XEN info_bar)
+static Xen gxg_gtk_tree_view_get_rubber_banding(Xen tree_view)
{
- #define H_gtk_info_bar_get_action_area "GtkWidget* gtk_info_bar_get_action_area(GtkInfoBar* info_bar)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_get_action_area", "GtkInfoBar*");
- return(C_TO_XEN_GtkWidget_(gtk_info_bar_get_action_area(XEN_TO_C_GtkInfoBar_(info_bar))));
+ #define H_gtk_tree_view_get_rubber_banding "gboolean gtk_tree_view_get_rubber_banding(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_rubber_banding", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_rubber_banding(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_info_bar_get_content_area(XEN info_bar)
+static Xen gxg_gtk_tooltip_set_markup(Xen tooltip, Xen markup)
{
- #define H_gtk_info_bar_get_content_area "GtkWidget* gtk_info_bar_get_content_area(GtkInfoBar* info_bar)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_get_content_area", "GtkInfoBar*");
- return(C_TO_XEN_GtkWidget_(gtk_info_bar_get_content_area(XEN_TO_C_GtkInfoBar_(info_bar))));
+ #define H_gtk_tooltip_set_markup "void gtk_tooltip_set_markup(GtkTooltip* tooltip, gchar* markup)"
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 1, "gtk_tooltip_set_markup", "GtkTooltip*");
+ Xen_check_type(Xen_is_gchar_(markup), markup, 2, "gtk_tooltip_set_markup", "gchar*");
+ gtk_tooltip_set_markup(Xen_to_C_GtkTooltip_(tooltip), (const gchar*)Xen_to_C_gchar_(markup));
+ return(Xen_false);
}
-static XEN gxg_gtk_info_bar_add_action_widget(XEN info_bar, XEN child, XEN response_id)
+static Xen gxg_gtk_tooltip_set_icon(Xen tooltip, Xen pixbuf)
{
- #define H_gtk_info_bar_add_action_widget "void gtk_info_bar_add_action_widget(GtkInfoBar* info_bar, \
-GtkWidget* child, gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_add_action_widget", "GtkInfoBar*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_info_bar_add_action_widget", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 3, "gtk_info_bar_add_action_widget", "gint");
- gtk_info_bar_add_action_widget(XEN_TO_C_GtkInfoBar_(info_bar), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gint(response_id));
- return(XEN_FALSE);
+ #define H_gtk_tooltip_set_icon "void gtk_tooltip_set_icon(GtkTooltip* tooltip, GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 1, "gtk_tooltip_set_icon", "GtkTooltip*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 2, "gtk_tooltip_set_icon", "GdkPixbuf*");
+ gtk_tooltip_set_icon(Xen_to_C_GtkTooltip_(tooltip), Xen_to_C_GdkPixbuf_(pixbuf));
+ return(Xen_false);
}
-static XEN gxg_gtk_info_bar_add_button(XEN info_bar, XEN button_text, XEN response_id)
+static Xen gxg_gtk_tooltip_set_custom(Xen tooltip, Xen custom_widget)
{
- #define H_gtk_info_bar_add_button "GtkWidget* gtk_info_bar_add_button(GtkInfoBar* info_bar, gchar* button_text, \
-gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_add_button", "GtkInfoBar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(button_text), button_text, 2, "gtk_info_bar_add_button", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 3, "gtk_info_bar_add_button", "gint");
- return(C_TO_XEN_GtkWidget_(gtk_info_bar_add_button(XEN_TO_C_GtkInfoBar_(info_bar), XEN_TO_C_gchar_(button_text), XEN_TO_C_gint(response_id))));
+ #define H_gtk_tooltip_set_custom "void gtk_tooltip_set_custom(GtkTooltip* tooltip, GtkWidget* custom_widget)"
+ Xen_check_type(Xen_is_GtkTooltip_(tooltip), tooltip, 1, "gtk_tooltip_set_custom", "GtkTooltip*");
+ Xen_check_type(Xen_is_GtkWidget_(custom_widget), custom_widget, 2, "gtk_tooltip_set_custom", "GtkWidget*");
+ gtk_tooltip_set_custom(Xen_to_C_GtkTooltip_(tooltip), Xen_to_C_GtkWidget_(custom_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_info_bar_set_response_sensitive(XEN info_bar, XEN response_id, XEN setting)
+static Xen gxg_gtk_tooltip_trigger_tooltip_query(Xen display)
{
- #define H_gtk_info_bar_set_response_sensitive "void gtk_info_bar_set_response_sensitive(GtkInfoBar* info_bar, \
-gint response_id, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_set_response_sensitive", "GtkInfoBar*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 2, "gtk_info_bar_set_response_sensitive", "gint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 3, "gtk_info_bar_set_response_sensitive", "gboolean");
- gtk_info_bar_set_response_sensitive(XEN_TO_C_GtkInfoBar_(info_bar), XEN_TO_C_gint(response_id), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_tooltip_trigger_tooltip_query "void gtk_tooltip_trigger_tooltip_query(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gtk_tooltip_trigger_tooltip_query", "GdkDisplay*");
+ gtk_tooltip_trigger_tooltip_query(Xen_to_C_GdkDisplay_(display));
+ return(Xen_false);
}
-static XEN gxg_gtk_info_bar_set_default_response(XEN info_bar, XEN response_id)
+static Xen gxg_gtk_button_set_image_position(Xen button, Xen position)
{
- #define H_gtk_info_bar_set_default_response "void gtk_info_bar_set_default_response(GtkInfoBar* info_bar, \
-gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_set_default_response", "GtkInfoBar*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 2, "gtk_info_bar_set_default_response", "gint");
- gtk_info_bar_set_default_response(XEN_TO_C_GtkInfoBar_(info_bar), XEN_TO_C_gint(response_id));
- return(XEN_FALSE);
+ #define H_gtk_button_set_image_position "void gtk_button_set_image_position(GtkButton* button, GtkPositionType position)"
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_set_image_position", "GtkButton*");
+ Xen_check_type(Xen_is_GtkPositionType(position), position, 2, "gtk_button_set_image_position", "GtkPositionType");
+ gtk_button_set_image_position(Xen_to_C_GtkButton_(button), Xen_to_C_GtkPositionType(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_info_bar_response(XEN info_bar, XEN response_id)
+static Xen gxg_gtk_button_get_image_position(Xen button)
{
- #define H_gtk_info_bar_response "void gtk_info_bar_response(GtkInfoBar* info_bar, gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_response", "GtkInfoBar*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 2, "gtk_info_bar_response", "gint");
- gtk_info_bar_response(XEN_TO_C_GtkInfoBar_(info_bar), XEN_TO_C_gint(response_id));
- return(XEN_FALSE);
+ #define H_gtk_button_get_image_position "GtkPositionType gtk_button_get_image_position(GtkButton* button)"
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_get_image_position", "GtkButton*");
+ return(C_to_Xen_GtkPositionType(gtk_button_get_image_position(Xen_to_C_GtkButton_(button))));
}
-static XEN gxg_gtk_info_bar_set_message_type(XEN info_bar, XEN message_type)
+static Xen gxg_gtk_show_uri(Xen screen, Xen uri, Xen timestamp, Xen ignore_error)
{
- #define H_gtk_info_bar_set_message_type "void gtk_info_bar_set_message_type(GtkInfoBar* info_bar, GtkMessageType message_type)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_set_message_type", "GtkInfoBar*");
- XEN_ASSERT_TYPE(XEN_GtkMessageType_P(message_type), message_type, 2, "gtk_info_bar_set_message_type", "GtkMessageType");
- gtk_info_bar_set_message_type(XEN_TO_C_GtkInfoBar_(info_bar), XEN_TO_C_GtkMessageType(message_type));
- return(XEN_FALSE);
+ #define H_gtk_show_uri "gboolean gtk_show_uri(GdkScreen* screen, gchar* uri, guint32 timestamp, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gtk_show_uri", "GdkScreen*");
+ Xen_check_type(Xen_is_gchar_(uri), uri, 2, "gtk_show_uri", "gchar*");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 3, "gtk_show_uri", "guint32");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_show_uri(Xen_to_C_GdkScreen_(screen), (const gchar*)Xen_to_C_gchar_(uri), Xen_to_C_guint32(timestamp),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_info_bar_get_message_type(XEN info_bar)
+static Xen gxg_gtk_tree_view_column_new_with_area(Xen area)
{
- #define H_gtk_info_bar_get_message_type "GtkMessageType gtk_info_bar_get_message_type(GtkInfoBar* info_bar)"
- XEN_ASSERT_TYPE(XEN_GtkInfoBar__P(info_bar), info_bar, 1, "gtk_info_bar_get_message_type", "GtkInfoBar*");
- return(C_TO_XEN_GtkMessageType(gtk_info_bar_get_message_type(XEN_TO_C_GtkInfoBar_(info_bar))));
+ #define H_gtk_tree_view_column_new_with_area "GtkTreeViewColumn* gtk_tree_view_column_new_with_area(GtkCellArea* area)"
+ Xen_check_type(Xen_is_GtkCellArea_(area), area, 1, "gtk_tree_view_column_new_with_area", "GtkCellArea*");
+ return(C_to_Xen_GtkTreeViewColumn_(gtk_tree_view_column_new_with_area(Xen_to_C_GtkCellArea_(area))));
}
-#endif
-
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-static XEN gxg_gdk_window_ensure_native(XEN window)
+static Xen gxg_gtk_tree_view_column_get_button(Xen tree_column)
{
- #define H_gdk_window_ensure_native "gboolean gdk_window_ensure_native(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_ensure_native", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_ensure_native(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_tree_view_column_get_button "GtkWidget* gtk_tree_view_column_get_button(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_button", "GtkTreeViewColumn*");
+ return(C_to_Xen_GtkWidget_(gtk_tree_view_column_get_button(Xen_to_C_GtkTreeViewColumn_(tree_column))));
}
-static XEN gxg_gdk_window_get_root_coords(XEN window, XEN x, XEN y, XEN ignore_root_x, XEN ignore_root_y)
+static Xen gxg_gtk_tree_view_column_focus_cell(Xen tree_column, Xen cell)
{
- #define H_gdk_window_get_root_coords "void gdk_window_get_root_coords(GdkWindow* window, gint x, gint y, \
-gint* [root_x], gint* [root_y])"
- gint ref_root_x;
- gint ref_root_y;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_root_coords", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gdk_window_get_root_coords", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gdk_window_get_root_coords", "gint");
- gdk_window_get_root_coords(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gint(x), XEN_TO_C_gint(y), &ref_root_x, &ref_root_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_root_x), C_TO_XEN_gint(ref_root_y)));
+ #define H_gtk_tree_view_column_focus_cell "void gtk_tree_view_column_focus_cell(GtkTreeViewColumn* tree_column, \
+GtkCellRenderer* cell)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_focus_cell", "GtkTreeViewColumn*");
+ Xen_check_type(Xen_is_GtkCellRenderer_(cell), cell, 2, "gtk_tree_view_column_focus_cell", "GtkCellRenderer*");
+ gtk_tree_view_column_focus_cell(Xen_to_C_GtkTreeViewColumn_(tree_column), Xen_to_C_GtkCellRenderer_(cell));
+ return(Xen_false);
}
-static XEN gxg_gdk_offscreen_window_set_embedder(XEN window, XEN embedder)
+static Xen gxg_gtk_clipboard_wait_is_uris_available(Xen clipboard)
{
- #define H_gdk_offscreen_window_set_embedder "void gdk_offscreen_window_set_embedder(GdkWindow* window, \
-GdkWindow* embedder)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_offscreen_window_set_embedder", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(embedder), embedder, 2, "gdk_offscreen_window_set_embedder", "GdkWindow*");
- gdk_offscreen_window_set_embedder(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWindow_(embedder));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_wait_is_uris_available "gboolean gtk_clipboard_wait_is_uris_available(GtkClipboard* clipboard)"
+ Xen_check_type(Xen_is_GtkClipboard_(clipboard), clipboard, 1, "gtk_clipboard_wait_is_uris_available", "GtkClipboard*");
+ return(C_to_Xen_gboolean(gtk_clipboard_wait_is_uris_available(Xen_to_C_GtkClipboard_(clipboard))));
}
-static XEN gxg_gdk_offscreen_window_get_embedder(XEN window)
+static Xen gxg_gtk_toolbar_set_drop_highlight_item(Xen toolbar, Xen tool_item, Xen index)
{
- #define H_gdk_offscreen_window_get_embedder "GdkWindow* gdk_offscreen_window_get_embedder(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_offscreen_window_get_embedder", "GdkWindow*");
- return(C_TO_XEN_GdkWindow_(gdk_offscreen_window_get_embedder(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_toolbar_set_drop_highlight_item "void gtk_toolbar_set_drop_highlight_item(GtkToolbar* toolbar, \
+GtkToolItem* tool_item, gint index)"
+ Xen_check_type(Xen_is_GtkToolbar_(toolbar), toolbar, 1, "gtk_toolbar_set_drop_highlight_item", "GtkToolbar*");
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 2, "gtk_toolbar_set_drop_highlight_item", "GtkToolItem*");
+ Xen_check_type(Xen_is_gint(index), index, 3, "gtk_toolbar_set_drop_highlight_item", "gint");
+ gtk_toolbar_set_drop_highlight_item(Xen_to_C_GtkToolbar_(toolbar), Xen_to_C_GtkToolItem_(tool_item), Xen_to_C_gint(index));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_geometry_changed(XEN window)
+static Xen gxg_gtk_tool_item_toolbar_reconfigured(Xen tool_item)
{
- #define H_gdk_window_geometry_changed "void gdk_window_geometry_changed(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_geometry_changed", "GdkWindow*");
- gdk_window_geometry_changed(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gtk_tool_item_toolbar_reconfigured "void gtk_tool_item_toolbar_reconfigured(GtkToolItem* tool_item)"
+ Xen_check_type(Xen_is_GtkToolItem_(tool_item), tool_item, 1, "gtk_tool_item_toolbar_reconfigured", "GtkToolItem*");
+ gtk_tool_item_toolbar_reconfigured(Xen_to_C_GtkToolItem_(tool_item));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_set_reserve_toggle_size(XEN menu, XEN reserve_toggle_size)
+static Xen gxg_gtk_orientable_set_orientation(Xen orientable, Xen orientation)
{
- #define H_gtk_menu_set_reserve_toggle_size "void gtk_menu_set_reserve_toggle_size(GtkMenu* menu, gboolean reserve_toggle_size)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_set_reserve_toggle_size", "GtkMenu*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(reserve_toggle_size), reserve_toggle_size, 2, "gtk_menu_set_reserve_toggle_size", "gboolean");
- gtk_menu_set_reserve_toggle_size(XEN_TO_C_GtkMenu_(menu), XEN_TO_C_gboolean(reserve_toggle_size));
- return(XEN_FALSE);
+ #define H_gtk_orientable_set_orientation "void gtk_orientable_set_orientation(GtkOrientable* orientable, \
+GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkOrientable_(orientable), orientable, 1, "gtk_orientable_set_orientation", "GtkOrientable*");
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 2, "gtk_orientable_set_orientation", "GtkOrientation");
+ gtk_orientable_set_orientation(Xen_to_C_GtkOrientable_(orientable), Xen_to_C_GtkOrientation(orientation));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_get_reserve_toggle_size(XEN menu)
+static Xen gxg_gtk_orientable_get_orientation(Xen orientable)
{
- #define H_gtk_menu_get_reserve_toggle_size "gboolean gtk_menu_get_reserve_toggle_size(GtkMenu* menu)"
- XEN_ASSERT_TYPE(XEN_GtkMenu__P(menu), menu, 1, "gtk_menu_get_reserve_toggle_size", "GtkMenu*");
- return(C_TO_XEN_gboolean(gtk_menu_get_reserve_toggle_size(XEN_TO_C_GtkMenu_(menu))));
+ #define H_gtk_orientable_get_orientation "GtkOrientation gtk_orientable_get_orientation(GtkOrientable* orientable)"
+ Xen_check_type(Xen_is_GtkOrientable_(orientable), orientable, 1, "gtk_orientable_get_orientation", "GtkOrientable*");
+ return(C_to_Xen_GtkOrientation(gtk_orientable_get_orientation(Xen_to_C_GtkOrientable_(orientable))));
}
-static XEN gxg_gtk_status_icon_set_title(XEN status_icon, XEN title)
+static Xen gxg_gtk_parse_args(Xen argc, Xen argv)
{
- #define H_gtk_status_icon_set_title "void gtk_status_icon_set_title(GtkStatusIcon* status_icon, gchar* title)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_title", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gchar__P(title), title, 2, "gtk_status_icon_set_title", "gchar*");
- gtk_status_icon_set_title(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_gchar_(title));
- return(XEN_FALSE);
+ #define H_gtk_parse_args "void gtk_parse_args(int* {argc}, char*** |argv|)"
+ int ref_argc;
+ char** ref_argv = NULL;
+ ref_argc = Xen_to_C_int(argc);
+ ref_argv = (char**)calloc(ref_argc, sizeof(char*));
+ {
+ int i;
+ Xen lst;
+ lst = Xen_copy_arg(argv);
+ for (i = 0; i < ref_argc; i++, lst = Xen_cdr(lst)) ref_argv[i] = Xen_to_C_char_(Xen_car(lst));
+ }
+ gtk_parse_args(&ref_argc, &ref_argv);
+ return(Xen_list_2(C_to_Xen_int(ref_argc), C_to_Xen_char__(ref_argv)));
}
-static XEN gxg_gtk_status_icon_get_title(XEN status_icon)
+static Xen gxg_gtk_get_major_version(void)
{
- #define H_gtk_status_icon_get_title "gchar* gtk_status_icon_get_title(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_title", "GtkStatusIcon*");
- return(C_TO_XEN_gchar_(gtk_status_icon_get_title(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_get_major_version "guint gtk_get_major_version( void)"
+ return(C_to_Xen_guint((guint)gtk_get_major_version()));
}
-static XEN gxg_gtk_entry_new_with_buffer(XEN buffer)
+static Xen gxg_gtk_get_minor_version(void)
{
- #define H_gtk_entry_new_with_buffer "GtkWidget* gtk_entry_new_with_buffer(GtkEntryBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_new_with_buffer", "GtkEntryBuffer*");
- return(C_TO_XEN_GtkWidget_(gtk_entry_new_with_buffer(XEN_TO_C_GtkEntryBuffer_(buffer))));
+ #define H_gtk_get_minor_version "guint gtk_get_minor_version( void)"
+ return(C_to_Xen_guint((guint)gtk_get_minor_version()));
}
-static XEN gxg_gtk_entry_get_buffer(XEN entry)
+static Xen gxg_gtk_get_micro_version(void)
{
- #define H_gtk_entry_get_buffer "GtkEntryBuffer* gtk_entry_get_buffer(GtkEntry* entry)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_buffer", "GtkEntry*");
- return(C_TO_XEN_GtkEntryBuffer_(gtk_entry_get_buffer(XEN_TO_C_GtkEntry_(entry))));
+ #define H_gtk_get_micro_version "guint gtk_get_micro_version( void)"
+ return(C_to_Xen_guint((guint)gtk_get_micro_version()));
}
-static XEN gxg_gtk_entry_set_buffer(XEN entry, XEN buffer)
+static Xen gxg_gtk_get_binary_age(void)
{
- #define H_gtk_entry_set_buffer "void gtk_entry_set_buffer(GtkEntry* entry, GtkEntryBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_set_buffer", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 2, "gtk_entry_set_buffer", "GtkEntryBuffer*");
- gtk_entry_set_buffer(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryBuffer_(buffer));
- return(XEN_FALSE);
+ #define H_gtk_get_binary_age "guint gtk_get_binary_age( void)"
+ return(C_to_Xen_guint((guint)gtk_get_binary_age()));
}
-static XEN gxg_gtk_label_set_track_visited_links(XEN label, XEN track_links)
+static Xen gxg_gtk_get_interface_age(void)
{
- #define H_gtk_label_set_track_visited_links "void gtk_label_set_track_visited_links(GtkLabel* label, \
-gboolean track_links)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_set_track_visited_links", "GtkLabel*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(track_links), track_links, 2, "gtk_label_set_track_visited_links", "gboolean");
- gtk_label_set_track_visited_links(XEN_TO_C_GtkLabel_(label), XEN_TO_C_gboolean(track_links));
- return(XEN_FALSE);
+ #define H_gtk_get_interface_age "guint gtk_get_interface_age( void)"
+ return(C_to_Xen_guint((guint)gtk_get_interface_age()));
}
-static XEN gxg_gtk_label_get_track_visited_links(XEN label)
+static Xen gxg_gtk_progress_bar_set_show_text(Xen pbar, Xen show_text)
{
- #define H_gtk_label_get_track_visited_links "gboolean gtk_label_get_track_visited_links(GtkLabel* label)"
- XEN_ASSERT_TYPE(XEN_GtkLabel__P(label), label, 1, "gtk_label_get_track_visited_links", "GtkLabel*");
- return(C_TO_XEN_gboolean(gtk_label_get_track_visited_links(XEN_TO_C_GtkLabel_(label))));
+ #define H_gtk_progress_bar_set_show_text "void gtk_progress_bar_set_show_text(GtkProgressBar* pbar, \
+gboolean show_text)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_set_show_text", "GtkProgressBar*");
+ Xen_check_type(Xen_is_gboolean(show_text), show_text, 2, "gtk_progress_bar_set_show_text", "gboolean");
+ gtk_progress_bar_set_show_text(Xen_to_C_GtkProgressBar_(pbar), Xen_to_C_gboolean(show_text));
+ return(Xen_false);
}
-static XEN gxg_gtk_print_operation_set_embed_page_setup(XEN op, XEN embed)
+static Xen gxg_gtk_progress_bar_get_show_text(Xen pbar)
{
- #define H_gtk_print_operation_set_embed_page_setup "void gtk_print_operation_set_embed_page_setup(GtkPrintOperation* op, \
-gboolean embed)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_set_embed_page_setup", "GtkPrintOperation*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(embed), embed, 2, "gtk_print_operation_set_embed_page_setup", "gboolean");
- gtk_print_operation_set_embed_page_setup(XEN_TO_C_GtkPrintOperation_(op), XEN_TO_C_gboolean(embed));
- return(XEN_FALSE);
+ #define H_gtk_progress_bar_get_show_text "gboolean gtk_progress_bar_get_show_text(GtkProgressBar* pbar)"
+ Xen_check_type(Xen_is_GtkProgressBar_(pbar), pbar, 1, "gtk_progress_bar_get_show_text", "GtkProgressBar*");
+ return(C_to_Xen_gboolean(gtk_progress_bar_get_show_text(Xen_to_C_GtkProgressBar_(pbar))));
}
-static XEN gxg_gtk_print_operation_get_embed_page_setup(XEN op)
+static Xen gxg_gtk_invisible_new_for_screen(Xen screen)
{
- #define H_gtk_print_operation_get_embed_page_setup "gboolean gtk_print_operation_get_embed_page_setup(GtkPrintOperation* op)"
- XEN_ASSERT_TYPE(XEN_GtkPrintOperation__P(op), op, 1, "gtk_print_operation_get_embed_page_setup", "GtkPrintOperation*");
- return(C_TO_XEN_gboolean(gtk_print_operation_get_embed_page_setup(XEN_TO_C_GtkPrintOperation_(op))));
+ #define H_gtk_invisible_new_for_screen "GtkWidget* gtk_invisible_new_for_screen(GdkScreen* screen)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gtk_invisible_new_for_screen", "GdkScreen*");
+ return(C_to_Xen_GtkWidget_(gtk_invisible_new_for_screen(Xen_to_C_GdkScreen_(screen))));
}
-static XEN gxg_gtk_entry_buffer_new(XEN initial_chars, XEN n_initial_chars)
+static Xen gxg_gtk_invisible_set_screen(Xen invisible, Xen screen)
{
- #define H_gtk_entry_buffer_new "GtkEntryBuffer* gtk_entry_buffer_new(gchar* initial_chars, gint n_initial_chars)"
- XEN_ASSERT_TYPE(XEN_gchar__P(initial_chars), initial_chars, 1, "gtk_entry_buffer_new", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_initial_chars), n_initial_chars, 2, "gtk_entry_buffer_new", "gint");
- return(C_TO_XEN_GtkEntryBuffer_(gtk_entry_buffer_new(XEN_TO_C_gchar_(initial_chars), XEN_TO_C_gint(n_initial_chars))));
+ #define H_gtk_invisible_set_screen "void gtk_invisible_set_screen(GtkInvisible* invisible, GdkScreen* screen)"
+ Xen_check_type(Xen_is_GtkInvisible_(invisible), invisible, 1, "gtk_invisible_set_screen", "GtkInvisible*");
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 2, "gtk_invisible_set_screen", "GdkScreen*");
+ gtk_invisible_set_screen(Xen_to_C_GtkInvisible_(invisible), Xen_to_C_GdkScreen_(screen));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_buffer_get_bytes(XEN buffer)
+static Xen gxg_gtk_invisible_get_screen(Xen invisible)
{
- #define H_gtk_entry_buffer_get_bytes "gsize gtk_entry_buffer_get_bytes(GtkEntryBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_get_bytes", "GtkEntryBuffer*");
- return(C_TO_XEN_gsize(gtk_entry_buffer_get_bytes(XEN_TO_C_GtkEntryBuffer_(buffer))));
+ #define H_gtk_invisible_get_screen "GdkScreen* gtk_invisible_get_screen(GtkInvisible* invisible)"
+ Xen_check_type(Xen_is_GtkInvisible_(invisible), invisible, 1, "gtk_invisible_get_screen", "GtkInvisible*");
+ return(C_to_Xen_GdkScreen_(gtk_invisible_get_screen(Xen_to_C_GtkInvisible_(invisible))));
}
-static XEN gxg_gtk_entry_buffer_get_length(XEN buffer)
+static Xen gxg_gtk_entry_get_icon_storage_type(Xen entry, Xen icon_pos)
{
- #define H_gtk_entry_buffer_get_length "guint gtk_entry_buffer_get_length(GtkEntryBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_get_length", "GtkEntryBuffer*");
- return(C_TO_XEN_guint(gtk_entry_buffer_get_length(XEN_TO_C_GtkEntryBuffer_(buffer))));
+ #define H_gtk_entry_get_icon_storage_type "GtkImageType gtk_entry_get_icon_storage_type(GtkEntry* entry, \
+GtkEntryIconPosition icon_pos)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_storage_type", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_get_icon_storage_type", "GtkEntryIconPosition");
+ return(C_to_Xen_GtkImageType(gtk_entry_get_icon_storage_type(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos))));
}
-static XEN gxg_gtk_entry_buffer_get_text(XEN buffer)
+static Xen gxg_gtk_entry_get_icon_pixbuf(Xen entry, Xen icon_pos)
{
- #define H_gtk_entry_buffer_get_text "gchar* gtk_entry_buffer_get_text(GtkEntryBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_get_text", "GtkEntryBuffer*");
- return(C_TO_XEN_gchar_(gtk_entry_buffer_get_text(XEN_TO_C_GtkEntryBuffer_(buffer))));
+ #define H_gtk_entry_get_icon_pixbuf "GdkPixbuf* gtk_entry_get_icon_pixbuf(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_pixbuf", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_get_icon_pixbuf", "GtkEntryIconPosition");
+ return(C_to_Xen_GdkPixbuf_(gtk_entry_get_icon_pixbuf(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos))));
}
-static XEN gxg_gtk_entry_buffer_set_text(XEN buffer, XEN chars, XEN n_chars)
+static Xen gxg_gtk_entry_get_icon_gicon(Xen entry, Xen icon_pos)
{
- #define H_gtk_entry_buffer_set_text "void gtk_entry_buffer_set_text(GtkEntryBuffer* buffer, gchar* chars, \
-gint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_set_text", "GtkEntryBuffer*");
- XEN_ASSERT_TYPE(XEN_gchar__P(chars), chars, 2, "gtk_entry_buffer_set_text", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_chars), n_chars, 3, "gtk_entry_buffer_set_text", "gint");
- gtk_entry_buffer_set_text(XEN_TO_C_GtkEntryBuffer_(buffer), XEN_TO_C_gchar_(chars), XEN_TO_C_gint(n_chars));
- return(XEN_FALSE);
+ #define H_gtk_entry_get_icon_gicon "GIcon* gtk_entry_get_icon_gicon(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_icon_gicon", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkEntryIconPosition(icon_pos), icon_pos, 2, "gtk_entry_get_icon_gicon", "GtkEntryIconPosition");
+ return(C_to_Xen_GIcon_(gtk_entry_get_icon_gicon(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkEntryIconPosition(icon_pos))));
}
-static XEN gxg_gtk_entry_buffer_set_max_length(XEN buffer, XEN max_length)
+static Xen gxg_gtk_container_propagate_draw(Xen container, Xen child, Xen cr)
{
- #define H_gtk_entry_buffer_set_max_length "void gtk_entry_buffer_set_max_length(GtkEntryBuffer* buffer, \
-guint max_length)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_set_max_length", "GtkEntryBuffer*");
- XEN_ASSERT_TYPE(XEN_guint_P(max_length), max_length, 2, "gtk_entry_buffer_set_max_length", "guint");
- gtk_entry_buffer_set_max_length(XEN_TO_C_GtkEntryBuffer_(buffer), XEN_TO_C_guint(max_length));
- return(XEN_FALSE);
+ #define H_gtk_container_propagate_draw "void gtk_container_propagate_draw(GtkContainer* container, \
+GtkWidget* child, cairo_t* cr)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_propagate_draw", "GtkContainer*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_container_propagate_draw", "GtkWidget*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 3, "gtk_container_propagate_draw", "cairo_t*");
+ gtk_container_propagate_draw(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkWidget_(child), Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_buffer_get_max_length(XEN buffer)
+static Xen gxg_gtk_container_set_focus_chain(Xen container, Xen focusable_widgets)
{
- #define H_gtk_entry_buffer_get_max_length "guint gtk_entry_buffer_get_max_length(GtkEntryBuffer* buffer)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_get_max_length", "GtkEntryBuffer*");
- return(C_TO_XEN_guint(gtk_entry_buffer_get_max_length(XEN_TO_C_GtkEntryBuffer_(buffer))));
+ #define H_gtk_container_set_focus_chain "void gtk_container_set_focus_chain(GtkContainer* container, \
+GList* focusable_widgets)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_set_focus_chain", "GtkContainer*");
+ Xen_check_type(Xen_is_GList_(focusable_widgets), focusable_widgets, 2, "gtk_container_set_focus_chain", "GList*");
+ gtk_container_set_focus_chain(Xen_to_C_GtkContainer_(container), Xen_to_C_GList_(focusable_widgets));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_buffer_insert_text(XEN buffer, XEN position, XEN chars, XEN n_chars)
+static Xen gxg_gtk_container_get_focus_chain(Xen container, Xen ignore_focusable_widgets)
{
- #define H_gtk_entry_buffer_insert_text "guint gtk_entry_buffer_insert_text(GtkEntryBuffer* buffer, \
-guint position, gchar* chars, gint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_insert_text", "GtkEntryBuffer*");
- XEN_ASSERT_TYPE(XEN_guint_P(position), position, 2, "gtk_entry_buffer_insert_text", "guint");
- XEN_ASSERT_TYPE(XEN_gchar__P(chars), chars, 3, "gtk_entry_buffer_insert_text", "gchar*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_chars), n_chars, 4, "gtk_entry_buffer_insert_text", "gint");
- return(C_TO_XEN_guint(gtk_entry_buffer_insert_text(XEN_TO_C_GtkEntryBuffer_(buffer), XEN_TO_C_guint(position), XEN_TO_C_gchar_(chars),
- XEN_TO_C_gint(n_chars))));
+ #define H_gtk_container_get_focus_chain "gboolean gtk_container_get_focus_chain(GtkContainer* container, \
+GList** [focusable_widgets])"
+ GList* ref_focusable_widgets = NULL;
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_get_focus_chain", "GtkContainer*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_container_get_focus_chain(Xen_to_C_GtkContainer_(container), &ref_focusable_widgets));
+ return(Xen_list_2(result, C_to_Xen_GList_(ref_focusable_widgets)));
+ }
}
-static XEN gxg_gtk_entry_buffer_delete_text(XEN buffer, XEN position, XEN n_chars)
+static Xen gxg_gtk_container_unset_focus_chain(Xen container)
{
- #define H_gtk_entry_buffer_delete_text "guint gtk_entry_buffer_delete_text(GtkEntryBuffer* buffer, \
-guint position, gint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_delete_text", "GtkEntryBuffer*");
- XEN_ASSERT_TYPE(XEN_guint_P(position), position, 2, "gtk_entry_buffer_delete_text", "guint");
- XEN_ASSERT_TYPE(XEN_gint_P(n_chars), n_chars, 3, "gtk_entry_buffer_delete_text", "gint");
- return(C_TO_XEN_guint(gtk_entry_buffer_delete_text(XEN_TO_C_GtkEntryBuffer_(buffer), XEN_TO_C_guint(position), XEN_TO_C_gint(n_chars))));
+ #define H_gtk_container_unset_focus_chain "void gtk_container_unset_focus_chain(GtkContainer* container)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_unset_focus_chain", "GtkContainer*");
+ gtk_container_unset_focus_chain(Xen_to_C_GtkContainer_(container));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_buffer_emit_inserted_text(XEN buffer, XEN position, XEN chars, XEN n_chars)
+static Xen gxg_gtk_container_set_focus_child(Xen container, Xen child)
{
- #define H_gtk_entry_buffer_emit_inserted_text "void gtk_entry_buffer_emit_inserted_text(GtkEntryBuffer* buffer, \
-guint position, gchar* chars, guint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_emit_inserted_text", "GtkEntryBuffer*");
- XEN_ASSERT_TYPE(XEN_guint_P(position), position, 2, "gtk_entry_buffer_emit_inserted_text", "guint");
- XEN_ASSERT_TYPE(XEN_gchar__P(chars), chars, 3, "gtk_entry_buffer_emit_inserted_text", "gchar*");
- XEN_ASSERT_TYPE(XEN_guint_P(n_chars), n_chars, 4, "gtk_entry_buffer_emit_inserted_text", "guint");
- gtk_entry_buffer_emit_inserted_text(XEN_TO_C_GtkEntryBuffer_(buffer), XEN_TO_C_guint(position), XEN_TO_C_gchar_(chars),
- XEN_TO_C_guint(n_chars));
- return(XEN_FALSE);
+ #define H_gtk_container_set_focus_child "void gtk_container_set_focus_child(GtkContainer* container, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_set_focus_child", "GtkContainer*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_container_set_focus_child", "GtkWidget*");
+ gtk_container_set_focus_child(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_buffer_emit_deleted_text(XEN buffer, XEN position, XEN n_chars)
+static Xen gxg_gtk_container_set_focus_vadjustment(Xen container, Xen adjustment)
{
- #define H_gtk_entry_buffer_emit_deleted_text "void gtk_entry_buffer_emit_deleted_text(GtkEntryBuffer* buffer, \
-guint position, guint n_chars)"
- XEN_ASSERT_TYPE(XEN_GtkEntryBuffer__P(buffer), buffer, 1, "gtk_entry_buffer_emit_deleted_text", "GtkEntryBuffer*");
- XEN_ASSERT_TYPE(XEN_guint_P(position), position, 2, "gtk_entry_buffer_emit_deleted_text", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(n_chars), n_chars, 3, "gtk_entry_buffer_emit_deleted_text", "guint");
- gtk_entry_buffer_emit_deleted_text(XEN_TO_C_GtkEntryBuffer_(buffer), XEN_TO_C_guint(position), XEN_TO_C_guint(n_chars));
- return(XEN_FALSE);
+ #define H_gtk_container_set_focus_vadjustment "void gtk_container_set_focus_vadjustment(GtkContainer* container, \
+GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_set_focus_vadjustment", "GtkContainer*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_container_set_focus_vadjustment", "GtkAdjustment*");
+ gtk_container_set_focus_vadjustment(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_set_alignment(XEN cell, XEN xalign, XEN yalign)
+static Xen gxg_gtk_container_get_focus_vadjustment(Xen container)
{
- #define H_gtk_cell_renderer_set_alignment "void gtk_cell_renderer_set_alignment(GtkCellRenderer* cell, \
-gfloat xalign, gfloat yalign)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_set_alignment", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gfloat_P(xalign), xalign, 2, "gtk_cell_renderer_set_alignment", "gfloat");
- XEN_ASSERT_TYPE(XEN_gfloat_P(yalign), yalign, 3, "gtk_cell_renderer_set_alignment", "gfloat");
- gtk_cell_renderer_set_alignment(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gfloat(xalign), XEN_TO_C_gfloat(yalign));
- return(XEN_FALSE);
+ #define H_gtk_container_get_focus_vadjustment "GtkAdjustment* gtk_container_get_focus_vadjustment(GtkContainer* container)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_get_focus_vadjustment", "GtkContainer*");
+ return(C_to_Xen_GtkAdjustment_(gtk_container_get_focus_vadjustment(Xen_to_C_GtkContainer_(container))));
}
-static XEN gxg_gtk_cell_renderer_get_alignment(XEN cell, XEN ignore_xalign, XEN ignore_yalign)
+static Xen gxg_gtk_container_set_focus_hadjustment(Xen container, Xen adjustment)
{
- #define H_gtk_cell_renderer_get_alignment "void gtk_cell_renderer_get_alignment(GtkCellRenderer* cell, \
-gfloat* [xalign], gfloat* [yalign])"
- gfloat ref_xalign;
- gfloat ref_yalign;
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_alignment", "GtkCellRenderer*");
- gtk_cell_renderer_get_alignment(XEN_TO_C_GtkCellRenderer_(cell), &ref_xalign, &ref_yalign);
- return(XEN_LIST_2(C_TO_XEN_gfloat(ref_xalign), C_TO_XEN_gfloat(ref_yalign)));
+ #define H_gtk_container_set_focus_hadjustment "void gtk_container_set_focus_hadjustment(GtkContainer* container, \
+GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_set_focus_hadjustment", "GtkContainer*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_container_set_focus_hadjustment", "GtkAdjustment*");
+ gtk_container_set_focus_hadjustment(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_set_padding(XEN cell, XEN xpad, XEN ypad)
+static Xen gxg_gtk_container_get_focus_hadjustment(Xen container)
{
- #define H_gtk_cell_renderer_set_padding "void gtk_cell_renderer_set_padding(GtkCellRenderer* cell, \
-gint xpad, gint ypad)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_set_padding", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gint_P(xpad), xpad, 2, "gtk_cell_renderer_set_padding", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(ypad), ypad, 3, "gtk_cell_renderer_set_padding", "gint");
- gtk_cell_renderer_set_padding(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gint(xpad), XEN_TO_C_gint(ypad));
- return(XEN_FALSE);
+ #define H_gtk_container_get_focus_hadjustment "GtkAdjustment* gtk_container_get_focus_hadjustment(GtkContainer* container)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_get_focus_hadjustment", "GtkContainer*");
+ return(C_to_Xen_GtkAdjustment_(gtk_container_get_focus_hadjustment(Xen_to_C_GtkContainer_(container))));
}
-static XEN gxg_gtk_cell_renderer_get_padding(XEN cell, XEN ignore_xpad, XEN ignore_ypad)
+static Xen gxg_gtk_assistant_commit(Xen assistant)
{
- #define H_gtk_cell_renderer_get_padding "void gtk_cell_renderer_get_padding(GtkCellRenderer* cell, \
-gint* [xpad], gint* [ypad])"
- gint ref_xpad;
- gint ref_ypad;
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_padding", "GtkCellRenderer*");
- gtk_cell_renderer_get_padding(XEN_TO_C_GtkCellRenderer_(cell), &ref_xpad, &ref_ypad);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_xpad), C_TO_XEN_gint(ref_ypad)));
+ #define H_gtk_assistant_commit "void gtk_assistant_commit(GtkAssistant* assistant)"
+ Xen_check_type(Xen_is_GtkAssistant_(assistant), assistant, 1, "gtk_assistant_commit", "GtkAssistant*");
+ gtk_assistant_commit(Xen_to_C_GtkAssistant_(assistant));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_set_visible(XEN cell, XEN visible)
+static Xen gxg_gtk_window_set_skip_taskbar_hint(Xen window, Xen setting)
{
- #define H_gtk_cell_renderer_set_visible "void gtk_cell_renderer_set_visible(GtkCellRenderer* cell, \
-gboolean visible)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_set_visible", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible), visible, 2, "gtk_cell_renderer_set_visible", "gboolean");
- gtk_cell_renderer_set_visible(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gboolean(visible));
- return(XEN_FALSE);
+ #define H_gtk_window_set_skip_taskbar_hint "void gtk_window_set_skip_taskbar_hint(GtkWindow* window, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_skip_taskbar_hint", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_skip_taskbar_hint", "gboolean");
+ gtk_window_set_skip_taskbar_hint(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_get_visible(XEN cell)
+static Xen gxg_gtk_window_get_skip_taskbar_hint(Xen window)
{
- #define H_gtk_cell_renderer_get_visible "gboolean gtk_cell_renderer_get_visible(GtkCellRenderer* cell)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_visible", "GtkCellRenderer*");
- return(C_TO_XEN_gboolean(gtk_cell_renderer_get_visible(XEN_TO_C_GtkCellRenderer_(cell))));
+ #define H_gtk_window_get_skip_taskbar_hint "gboolean gtk_window_get_skip_taskbar_hint(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_skip_taskbar_hint", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_skip_taskbar_hint(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_cell_renderer_set_sensitive(XEN cell, XEN sensitive)
+static Xen gxg_gtk_window_set_skip_pager_hint(Xen window, Xen setting)
{
- #define H_gtk_cell_renderer_set_sensitive "void gtk_cell_renderer_set_sensitive(GtkCellRenderer* cell, \
-gboolean sensitive)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_set_sensitive", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(sensitive), sensitive, 2, "gtk_cell_renderer_set_sensitive", "gboolean");
- gtk_cell_renderer_set_sensitive(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_gboolean(sensitive));
- return(XEN_FALSE);
+ #define H_gtk_window_set_skip_pager_hint "void gtk_window_set_skip_pager_hint(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_skip_pager_hint", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_skip_pager_hint", "gboolean");
+ gtk_window_set_skip_pager_hint(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_get_sensitive(XEN cell)
+static Xen gxg_gtk_window_get_skip_pager_hint(Xen window)
{
- #define H_gtk_cell_renderer_get_sensitive "gboolean gtk_cell_renderer_get_sensitive(GtkCellRenderer* cell)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_sensitive", "GtkCellRenderer*");
- return(C_TO_XEN_gboolean(gtk_cell_renderer_get_sensitive(XEN_TO_C_GtkCellRenderer_(cell))));
+ #define H_gtk_window_get_skip_pager_hint "gboolean gtk_window_get_skip_pager_hint(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_skip_pager_hint", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_skip_pager_hint(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_cell_renderer_toggle_get_activatable(XEN toggle)
+static Xen gxg_gtk_window_set_screen(Xen window, Xen screen)
{
- #define H_gtk_cell_renderer_toggle_get_activatable "gboolean gtk_cell_renderer_toggle_get_activatable(GtkCellRendererToggle* toggle)"
- XEN_ASSERT_TYPE(XEN_GtkCellRendererToggle__P(toggle), toggle, 1, "gtk_cell_renderer_toggle_get_activatable", "GtkCellRendererToggle*");
- return(C_TO_XEN_gboolean(gtk_cell_renderer_toggle_get_activatable(XEN_TO_C_GtkCellRendererToggle_(toggle))));
+ #define H_gtk_window_set_screen "void gtk_window_set_screen(GtkWindow* window, GdkScreen* screen)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_screen", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 2, "gtk_window_set_screen", "GdkScreen*");
+ gtk_window_set_screen(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkScreen_(screen));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_toggle_set_activatable(XEN toggle, XEN setting)
+static Xen gxg_gtk_window_get_screen(Xen window)
{
- #define H_gtk_cell_renderer_toggle_set_activatable "void gtk_cell_renderer_toggle_set_activatable(GtkCellRendererToggle* toggle, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkCellRendererToggle__P(toggle), toggle, 1, "gtk_cell_renderer_toggle_set_activatable", "GtkCellRendererToggle*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_cell_renderer_toggle_set_activatable", "gboolean");
- gtk_cell_renderer_toggle_set_activatable(XEN_TO_C_GtkCellRendererToggle_(toggle), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_window_get_screen "GdkScreen* gtk_window_get_screen(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_screen", "GtkWindow*");
+ return(C_to_Xen_GdkScreen_(gtk_window_get_screen(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_widget_set_can_focus(XEN widget, XEN can_focus)
+static Xen gxg_gtk_window_set_icon_from_file(Xen window, Xen filename, Xen ignore_err)
{
- #define H_gtk_widget_set_can_focus "void gtk_widget_set_can_focus(GtkWidget* widget, gboolean can_focus)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_can_focus", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(can_focus), can_focus, 2, "gtk_widget_set_can_focus", "gboolean");
- gtk_widget_set_can_focus(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(can_focus));
- return(XEN_FALSE);
+ #define H_gtk_window_set_icon_from_file "gboolean gtk_window_set_icon_from_file(GtkWindow* window, \
+gchar* filename, GError** [err])"
+ GError* ref_err = NULL;
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_icon_from_file", "GtkWindow*");
+ Xen_check_type(Xen_is_gchar_(filename), filename, 2, "gtk_window_set_icon_from_file", "gchar*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_window_set_icon_from_file(Xen_to_C_GtkWindow_(window), (const gchar*)Xen_to_C_gchar_(filename), &ref_err));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_err)));
+ }
}
-static XEN gxg_gtk_widget_get_can_focus(XEN widget)
+static Xen gxg_gtk_window_set_default_icon_from_file(Xen filename, Xen ignore_err)
{
- #define H_gtk_widget_get_can_focus "gboolean gtk_widget_get_can_focus(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_can_focus", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_can_focus(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_set_default_icon_from_file "gboolean gtk_window_set_default_icon_from_file(gchar* filename, \
+GError** [err])"
+ GError* ref_err = NULL;
+ Xen_check_type(Xen_is_gchar_(filename), filename, 1, "gtk_window_set_default_icon_from_file", "gchar*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_window_set_default_icon_from_file((const gchar*)Xen_to_C_gchar_(filename), &ref_err));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_err)));
+ }
}
-static XEN gxg_gtk_widget_has_focus(XEN widget)
+static Xen gxg_gtk_window_fullscreen(Xen window)
{
- #define H_gtk_widget_has_focus "gboolean gtk_widget_has_focus(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_has_focus", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_has_focus(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_fullscreen "void gtk_window_fullscreen(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_fullscreen", "GtkWindow*");
+ gtk_window_fullscreen(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_can_default(XEN widget, XEN can_default)
+static Xen gxg_gtk_window_unfullscreen(Xen window)
{
- #define H_gtk_widget_set_can_default "void gtk_widget_set_can_default(GtkWidget* widget, gboolean can_default)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_can_default", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(can_default), can_default, 2, "gtk_widget_set_can_default", "gboolean");
- gtk_widget_set_can_default(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(can_default));
- return(XEN_FALSE);
+ #define H_gtk_window_unfullscreen "void gtk_window_unfullscreen(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_unfullscreen", "GtkWindow*");
+ gtk_window_unfullscreen(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_can_default(XEN widget)
+static Xen gxg_gtk_window_get_window_type(Xen window)
{
- #define H_gtk_widget_get_can_default "gboolean gtk_widget_get_can_default(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_can_default", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_can_default(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_get_window_type "GtkWindowType gtk_window_get_window_type(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_window_type", "GtkWindow*");
+ return(C_to_Xen_GtkWindowType(gtk_window_get_window_type(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_widget_has_default(XEN widget)
+static Xen gxg_gtk_window_group_add_window(Xen window_group, Xen window)
{
- #define H_gtk_widget_has_default "gboolean gtk_widget_has_default(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_has_default", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_has_default(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_group_add_window "void gtk_window_group_add_window(GtkWindowGroup* window_group, \
+GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindowGroup_(window_group), window_group, 1, "gtk_window_group_add_window", "GtkWindowGroup*");
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 2, "gtk_window_group_add_window", "GtkWindow*");
+ gtk_window_group_add_window(Xen_to_C_GtkWindowGroup_(window_group), Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_state(XEN widget)
+static Xen gxg_gtk_window_group_remove_window(Xen window_group, Xen window)
{
- #define H_gtk_widget_get_state "GtkStateType gtk_widget_get_state(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_state", "GtkWidget*");
- return(C_TO_XEN_GtkStateType(gtk_widget_get_state(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_group_remove_window "void gtk_window_group_remove_window(GtkWindowGroup* window_group, \
+GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindowGroup_(window_group), window_group, 1, "gtk_window_group_remove_window", "GtkWindowGroup*");
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 2, "gtk_window_group_remove_window", "GtkWindow*");
+ gtk_window_group_remove_window(Xen_to_C_GtkWindowGroup_(window_group), Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_sensitive(XEN widget)
+static Xen gxg_gtk_window_group_new(void)
{
- #define H_gtk_widget_get_sensitive "gboolean gtk_widget_get_sensitive(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_sensitive", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_sensitive(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_group_new "GtkWindowGroup* gtk_window_group_new( void)"
+ return(C_to_Xen_GtkWindowGroup_(gtk_window_group_new()));
}
-static XEN gxg_gtk_widget_is_sensitive(XEN widget)
+static Xen gxg_gtk_window_get_group(Xen window)
{
- #define H_gtk_widget_is_sensitive "gboolean gtk_widget_is_sensitive(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_is_sensitive", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_is_sensitive(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_get_group "GtkWindowGroup* gtk_window_get_group(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_group", "GtkWindow*");
+ return(C_to_Xen_GtkWindowGroup_(gtk_window_get_group(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_widget_set_has_window(XEN widget, XEN has_window)
+static Xen gxg_gtk_window_group_list_windows(Xen window_group)
{
- #define H_gtk_widget_set_has_window "void gtk_widget_set_has_window(GtkWidget* widget, gboolean has_window)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_has_window", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(has_window), has_window, 2, "gtk_widget_set_has_window", "gboolean");
- gtk_widget_set_has_window(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(has_window));
- return(XEN_FALSE);
+ #define H_gtk_window_group_list_windows "GList* gtk_window_group_list_windows(GtkWindowGroup* window_group)"
+ Xen_check_type(Xen_is_GtkWindowGroup_(window_group), window_group, 1, "gtk_window_group_list_windows", "GtkWindowGroup*");
+ return(C_to_Xen_GList_(gtk_window_group_list_windows(Xen_to_C_GtkWindowGroup_(window_group))));
}
-static XEN gxg_gtk_widget_get_has_window(XEN widget)
+static Xen gxg_gtk_window_group_get_current_device_grab(Xen window_group, Xen device)
{
- #define H_gtk_widget_get_has_window "gboolean gtk_widget_get_has_window(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_has_window", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_has_window(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_group_get_current_device_grab "GtkWidget* gtk_window_group_get_current_device_grab(GtkWindowGroup* window_group, \
+GdkDevice* device)"
+ Xen_check_type(Xen_is_GtkWindowGroup_(window_group), window_group, 1, "gtk_window_group_get_current_device_grab", "GtkWindowGroup*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_window_group_get_current_device_grab", "GdkDevice*");
+ return(C_to_Xen_GtkWidget_(gtk_window_group_get_current_device_grab(Xen_to_C_GtkWindowGroup_(window_group), Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_widget_get_app_paintable(XEN widget)
+static Xen gxg_gtk_window_group_get_current_grab(Xen window_group)
{
- #define H_gtk_widget_get_app_paintable "gboolean gtk_widget_get_app_paintable(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_app_paintable", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_app_paintable(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_window_group_get_current_grab "GtkWidget* gtk_window_group_get_current_grab(GtkWindowGroup* window_group)"
+ Xen_check_type(Xen_is_GtkWindowGroup_(window_group), window_group, 1, "gtk_window_group_get_current_grab", "GtkWindowGroup*");
+ return(C_to_Xen_GtkWidget_(gtk_window_group_get_current_grab(Xen_to_C_GtkWindowGroup_(window_group))));
}
-static XEN gxg_gtk_widget_get_double_buffered(XEN widget)
+static Xen gxg_gtk_selection_data_get_data(Xen selection_data)
{
- #define H_gtk_widget_get_double_buffered "gboolean gtk_widget_get_double_buffered(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_double_buffered", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_double_buffered(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_selection_data_get_data "guchar* gtk_selection_data_get_data(GtkSelectionData* selection_data)"
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_data", "GtkSelectionData*");
+ return(C_to_Xen_guchar_(gtk_selection_data_get_data(Xen_to_C_GtkSelectionData_(selection_data))));
}
-#endif
-
-#if HAVE_GTK_WIDGET_GET_VISIBLE
-static XEN gxg_gdk_window_get_cursor(XEN window)
+static Xen gxg_gtk_selection_owner_set_for_display(Xen display, Xen widget, Xen selection, Xen time)
{
- #define H_gdk_window_get_cursor "GdkCursor* gdk_window_get_cursor(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_cursor", "GdkWindow*");
- return(C_TO_XEN_GdkCursor_(gdk_window_get_cursor(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_selection_owner_set_for_display "gboolean gtk_selection_owner_set_for_display(GdkDisplay* display, \
+GtkWidget* widget, GdkAtom selection, guint32 time)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gtk_selection_owner_set_for_display", "GdkDisplay*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_selection_owner_set_for_display", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 3, "gtk_selection_owner_set_for_display", "GdkAtom");
+ Xen_check_type(Xen_is_guint32(time), time, 4, "gtk_selection_owner_set_for_display", "guint32");
+ return(C_to_Xen_gboolean(gtk_selection_owner_set_for_display(Xen_to_C_GdkDisplay_(display), Xen_to_C_GtkWidget_(widget),
+ Xen_to_C_GdkAtom(selection), Xen_to_C_guint32(time))));
}
-static XEN gxg_gtk_file_chooser_set_create_folders(XEN chooser, XEN create_folders)
+static Xen gxg_gtk_tool_shell_get_text_orientation(Xen shell)
{
- #define H_gtk_file_chooser_set_create_folders "void gtk_file_chooser_set_create_folders(GtkFileChooser* chooser, \
-gboolean create_folders)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_set_create_folders", "GtkFileChooser*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(create_folders), create_folders, 2, "gtk_file_chooser_set_create_folders", "gboolean");
- gtk_file_chooser_set_create_folders(XEN_TO_C_GtkFileChooser_(chooser), XEN_TO_C_gboolean(create_folders));
- return(XEN_FALSE);
+ #define H_gtk_tool_shell_get_text_orientation "GtkOrientation gtk_tool_shell_get_text_orientation(GtkToolShell* shell)"
+ Xen_check_type(Xen_is_GtkToolShell_(shell), shell, 1, "gtk_tool_shell_get_text_orientation", "GtkToolShell*");
+ return(C_to_Xen_GtkOrientation(gtk_tool_shell_get_text_orientation(Xen_to_C_GtkToolShell_(shell))));
}
-static XEN gxg_gtk_file_chooser_get_create_folders(XEN chooser)
+static Xen gxg_gtk_tool_shell_get_text_alignment(Xen shell)
{
- #define H_gtk_file_chooser_get_create_folders "gboolean gtk_file_chooser_get_create_folders(GtkFileChooser* chooser)"
- XEN_ASSERT_TYPE(XEN_GtkFileChooser__P(chooser), chooser, 1, "gtk_file_chooser_get_create_folders", "GtkFileChooser*");
- return(C_TO_XEN_gboolean(gtk_file_chooser_get_create_folders(XEN_TO_C_GtkFileChooser_(chooser))));
+ #define H_gtk_tool_shell_get_text_alignment "gfloat gtk_tool_shell_get_text_alignment(GtkToolShell* shell)"
+ Xen_check_type(Xen_is_GtkToolShell_(shell), shell, 1, "gtk_tool_shell_get_text_alignment", "GtkToolShell*");
+ return(C_to_Xen_gfloat(gtk_tool_shell_get_text_alignment(Xen_to_C_GtkToolShell_(shell))));
}
-static XEN gxg_gtk_icon_view_set_item_padding(XEN icon_view, XEN item_padding)
+static Xen gxg_gtk_tool_shell_get_ellipsize_mode(Xen shell)
{
- #define H_gtk_icon_view_set_item_padding "void gtk_icon_view_set_item_padding(GtkIconView* icon_view, \
-gint item_padding)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_item_padding", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_gint_P(item_padding), item_padding, 2, "gtk_icon_view_set_item_padding", "gint");
- gtk_icon_view_set_item_padding(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_gint(item_padding));
- return(XEN_FALSE);
+ #define H_gtk_tool_shell_get_ellipsize_mode "PangoEllipsizeMode gtk_tool_shell_get_ellipsize_mode(GtkToolShell* shell)"
+ Xen_check_type(Xen_is_GtkToolShell_(shell), shell, 1, "gtk_tool_shell_get_ellipsize_mode", "GtkToolShell*");
+ return(C_to_Xen_PangoEllipsizeMode(gtk_tool_shell_get_ellipsize_mode(Xen_to_C_GtkToolShell_(shell))));
}
-static XEN gxg_gtk_icon_view_get_item_padding(XEN icon_view)
+static Xen gxg_gtk_tool_shell_get_text_size_group(Xen shell)
{
- #define H_gtk_icon_view_get_item_padding "gint gtk_icon_view_get_item_padding(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_item_padding", "GtkIconView*");
- return(C_TO_XEN_gint(gtk_icon_view_get_item_padding(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_tool_shell_get_text_size_group "GtkSizeGroup* gtk_tool_shell_get_text_size_group(GtkToolShell* shell)"
+ Xen_check_type(Xen_is_GtkToolShell_(shell), shell, 1, "gtk_tool_shell_get_text_size_group", "GtkToolShell*");
+ return(C_to_Xen_GtkSizeGroup_(gtk_tool_shell_get_text_size_group(Xen_to_C_GtkToolShell_(shell))));
}
-static XEN gxg_gtk_widget_has_grab(XEN widget)
+static Xen gxg_gtk_tool_shell_get_orientation(Xen shell)
{
- #define H_gtk_widget_has_grab "gboolean gtk_widget_has_grab(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_has_grab", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_has_grab(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_tool_shell_get_orientation "GtkOrientation gtk_tool_shell_get_orientation(GtkToolShell* shell)"
+ Xen_check_type(Xen_is_GtkToolShell_(shell), shell, 1, "gtk_tool_shell_get_orientation", "GtkToolShell*");
+ return(C_to_Xen_GtkOrientation(gtk_tool_shell_get_orientation(Xen_to_C_GtkToolShell_(shell))));
}
-static XEN gxg_gtk_widget_set_visible(XEN widget, XEN visible)
+static Xen gxg_gtk_tool_shell_get_style(Xen shell)
{
- #define H_gtk_widget_set_visible "void gtk_widget_set_visible(GtkWidget* widget, gboolean visible)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_visible", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(visible), visible, 2, "gtk_widget_set_visible", "gboolean");
- gtk_widget_set_visible(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(visible));
- return(XEN_FALSE);
+ #define H_gtk_tool_shell_get_style "GtkToolbarStyle gtk_tool_shell_get_style(GtkToolShell* shell)"
+ Xen_check_type(Xen_is_GtkToolShell_(shell), shell, 1, "gtk_tool_shell_get_style", "GtkToolShell*");
+ return(C_to_Xen_GtkToolbarStyle(gtk_tool_shell_get_style(Xen_to_C_GtkToolShell_(shell))));
}
-static XEN gxg_gtk_widget_get_visible(XEN widget)
+static Xen gxg_gtk_tool_shell_get_relief_style(Xen shell)
{
- #define H_gtk_widget_get_visible "gboolean gtk_widget_get_visible(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_visible", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_visible(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_tool_shell_get_relief_style "GtkReliefStyle gtk_tool_shell_get_relief_style(GtkToolShell* shell)"
+ Xen_check_type(Xen_is_GtkToolShell_(shell), shell, 1, "gtk_tool_shell_get_relief_style", "GtkToolShell*");
+ return(C_to_Xen_GtkReliefStyle(gtk_tool_shell_get_relief_style(Xen_to_C_GtkToolShell_(shell))));
}
-static XEN gxg_gtk_range_set_flippable(XEN range, XEN flippable)
+static Xen gxg_gtk_tool_shell_rebuild_menu(Xen shell)
{
- #define H_gtk_range_set_flippable "void gtk_range_set_flippable(GtkRange* range, gboolean flippable)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_flippable", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(flippable), flippable, 2, "gtk_range_set_flippable", "gboolean");
- gtk_range_set_flippable(XEN_TO_C_GtkRange_(range), XEN_TO_C_gboolean(flippable));
- return(XEN_FALSE);
+ #define H_gtk_tool_shell_rebuild_menu "void gtk_tool_shell_rebuild_menu(GtkToolShell* shell)"
+ Xen_check_type(Xen_is_GtkToolShell_(shell), shell, 1, "gtk_tool_shell_rebuild_menu", "GtkToolShell*");
+ gtk_tool_shell_rebuild_menu(Xen_to_C_GtkToolShell_(shell));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_get_flippable(XEN range)
+static Xen gxg_gtk_accel_map_lock_path(Xen accel_path)
{
- #define H_gtk_range_get_flippable "gboolean gtk_range_get_flippable(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_flippable", "GtkRange*");
- return(C_TO_XEN_gboolean(gtk_range_get_flippable(XEN_TO_C_GtkRange_(range))));
+ #define H_gtk_accel_map_lock_path "void gtk_accel_map_lock_path(gchar* accel_path)"
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 1, "gtk_accel_map_lock_path", "gchar*");
+ gtk_accel_map_lock_path((const gchar*)Xen_to_C_gchar_(accel_path));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_is_toplevel(XEN widget)
+static Xen gxg_gtk_accel_map_unlock_path(Xen accel_path)
{
- #define H_gtk_widget_is_toplevel "gboolean gtk_widget_is_toplevel(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_is_toplevel", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_is_toplevel(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_accel_map_unlock_path "void gtk_accel_map_unlock_path(gchar* accel_path)"
+ Xen_check_type(Xen_is_gchar_(accel_path), accel_path, 1, "gtk_accel_map_unlock_path", "gchar*");
+ gtk_accel_map_unlock_path((const gchar*)Xen_to_C_gchar_(accel_path));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_is_drawable(XEN widget)
+static Xen gxg_gtk_icon_theme_lookup_by_gicon(Xen icon_theme, Xen icon, Xen size, Xen flags)
{
- #define H_gtk_widget_is_drawable "gboolean gtk_widget_is_drawable(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_is_drawable", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_is_drawable(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_icon_theme_lookup_by_gicon "GtkIconInfo* gtk_icon_theme_lookup_by_gicon(GtkIconTheme* icon_theme, \
+GIcon* icon, gint size, GtkIconLookupFlags flags)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_lookup_by_gicon", "GtkIconTheme*");
+ Xen_check_type(Xen_is_GIcon_(icon), icon, 2, "gtk_icon_theme_lookup_by_gicon", "GIcon*");
+ Xen_check_type(Xen_is_gint(size), size, 3, "gtk_icon_theme_lookup_by_gicon", "gint");
+ Xen_check_type(Xen_is_GtkIconLookupFlags(flags), flags, 4, "gtk_icon_theme_lookup_by_gicon", "GtkIconLookupFlags");
+ return(C_to_Xen_GtkIconInfo_(gtk_icon_theme_lookup_by_gicon(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_GIcon_(icon),
+ Xen_to_C_gint(size), Xen_to_C_GtkIconLookupFlags(flags))));
}
-static XEN gxg_gtk_widget_set_window(XEN widget, XEN window)
+static Xen gxg_gtk_icon_info_new_for_pixbuf(Xen icon_theme, Xen pixbuf)
{
- #define H_gtk_widget_set_window "void gtk_widget_set_window(GtkWidget* widget, GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_window", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 2, "gtk_widget_set_window", "GdkWindow*");
- gtk_widget_set_window(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gtk_icon_info_new_for_pixbuf "GtkIconInfo* gtk_icon_info_new_for_pixbuf(GtkIconTheme* icon_theme, \
+GdkPixbuf* pixbuf)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_info_new_for_pixbuf", "GtkIconTheme*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 2, "gtk_icon_info_new_for_pixbuf", "GdkPixbuf*");
+ return(C_to_Xen_GtkIconInfo_(gtk_icon_info_new_for_pixbuf(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_GdkPixbuf_(pixbuf))));
}
-static XEN gxg_gdk_window_is_destroyed(XEN window)
+static Xen gxg_gtk_icon_view_set_item_orientation(Xen icon_view, Xen orientation)
{
- #define H_gdk_window_is_destroyed "gboolean gdk_window_is_destroyed(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_is_destroyed", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_is_destroyed(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_icon_view_set_item_orientation "void gtk_icon_view_set_item_orientation(GtkIconView* icon_view, \
+GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_item_orientation", "GtkIconView*");
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 2, "gtk_icon_view_set_item_orientation", "GtkOrientation");
+ gtk_icon_view_set_item_orientation(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_GtkOrientation(orientation));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_restack(XEN window, XEN sibling, XEN above)
+static Xen gxg_gtk_icon_view_get_item_orientation(Xen icon_view)
{
- #define H_gdk_window_restack "void gdk_window_restack(GdkWindow* window, GdkWindow* sibling, gboolean above)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_restack", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(sibling), sibling, 2, "gdk_window_restack", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(above), above, 3, "gdk_window_restack", "gboolean");
- gdk_window_restack(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWindow_(sibling), XEN_TO_C_gboolean(above));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_get_item_orientation "GtkOrientation gtk_icon_view_get_item_orientation(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_item_orientation", "GtkIconView*");
+ return(C_to_Xen_GtkOrientation(gtk_icon_view_get_item_orientation(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_widget_set_receives_default(XEN widget, XEN receives_default)
+static Xen gxg_gtk_text_view_im_context_filter_keypress(Xen text_view, Xen event)
{
- #define H_gtk_widget_set_receives_default "void gtk_widget_set_receives_default(GtkWidget* widget, \
-gboolean receives_default)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_receives_default", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(receives_default), receives_default, 2, "gtk_widget_set_receives_default", "gboolean");
- gtk_widget_set_receives_default(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(receives_default));
- return(XEN_FALSE);
+ #define H_gtk_text_view_im_context_filter_keypress "gboolean gtk_text_view_im_context_filter_keypress(GtkTextView* text_view, \
+GdkEventKey* event)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_im_context_filter_keypress", "GtkTextView*");
+ Xen_check_type(Xen_is_GdkEventKey_(event), event, 2, "gtk_text_view_im_context_filter_keypress", "GdkEventKey*");
+ return(C_to_Xen_gboolean(gtk_text_view_im_context_filter_keypress(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GdkEventKey_(event))));
}
-static XEN gxg_gtk_widget_get_receives_default(XEN widget)
+static Xen gxg_gtk_text_view_reset_im_context(Xen text_view)
{
- #define H_gtk_widget_get_receives_default "gboolean gtk_widget_get_receives_default(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_receives_default", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_receives_default(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_text_view_reset_im_context "void gtk_text_view_reset_im_context(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_reset_im_context", "GtkTextView*");
+ gtk_text_view_reset_im_context(Xen_to_C_GtkTextView_(text_view));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_flush(XEN window)
+static Xen gxg_gdk_device_get_position(Xen device, Xen screen, Xen ignore_x, Xen ignore_y)
{
- #define H_gdk_window_flush "void gdk_window_flush(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_flush", "GdkWindow*");
- gdk_window_flush(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gdk_device_get_position "void gdk_device_get_position(GdkDevice* device, GdkScreen** screen, \
+gint* [x], gint* [y])"
+ gint ref_x;
+ gint ref_y;
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 1, "gdk_device_get_position", "GdkDevice*");
+ Xen_check_type(Xen_is_GdkScreen__(screen), screen, 2, "gdk_device_get_position", "GdkScreen**");
+ gdk_device_get_position(Xen_to_C_GdkDevice_(device), Xen_to_C_GdkScreen__(screen), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y)));
}
-#endif
-
-#if HAVE_GTK_WIDGET_GET_MAPPED
-static XEN gxg_gtk_dialog_get_widget_for_response(XEN dialog, XEN response_id)
+static Xen gxg_gdk_device_get_window_at_position(Xen device, Xen ignore_win_x, Xen ignore_win_y)
{
- #define H_gtk_dialog_get_widget_for_response "GtkWidget* gtk_dialog_get_widget_for_response(GtkDialog* dialog, \
-gint response_id)"
- XEN_ASSERT_TYPE(XEN_GtkDialog__P(dialog), dialog, 1, "gtk_dialog_get_widget_for_response", "GtkDialog*");
- XEN_ASSERT_TYPE(XEN_gint_P(response_id), response_id, 2, "gtk_dialog_get_widget_for_response", "gint");
- return(C_TO_XEN_GtkWidget_(gtk_dialog_get_widget_for_response(XEN_TO_C_GtkDialog_(dialog), XEN_TO_C_gint(response_id))));
+ #define H_gdk_device_get_window_at_position "GdkWindow* gdk_device_get_window_at_position(GdkDevice* device, \
+gint* [win_x], gint* [win_y])"
+ gint ref_win_x;
+ gint ref_win_y;
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 1, "gdk_device_get_window_at_position", "GdkDevice*");
+ {
+ Xen result;
+ result = C_to_Xen_GdkWindow_(gdk_device_get_window_at_position(Xen_to_C_GdkDevice_(device), &ref_win_x, &ref_win_y));
+ return(Xen_list_3(result, C_to_Xen_gint(ref_win_x), C_to_Xen_gint(ref_win_y)));
+ }
}
-static XEN gxg_gtk_tooltip_set_icon_from_gicon(XEN tooltip, XEN gicon, XEN size)
+static Xen gxg_gtk_cell_view_get_draw_sensitive(Xen cell_view)
{
- #define H_gtk_tooltip_set_icon_from_gicon "void gtk_tooltip_set_icon_from_gicon(GtkTooltip* tooltip, \
-GIcon* gicon, GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 1, "gtk_tooltip_set_icon_from_gicon", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_GIcon__P(gicon), gicon, 2, "gtk_tooltip_set_icon_from_gicon", "GIcon*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 3, "gtk_tooltip_set_icon_from_gicon", "GtkIconSize");
- gtk_tooltip_set_icon_from_gicon(XEN_TO_C_GtkTooltip_(tooltip), XEN_TO_C_GIcon_(gicon), XEN_TO_C_GtkIconSize(size));
- return(XEN_FALSE);
+ #define H_gtk_cell_view_get_draw_sensitive "gboolean gtk_cell_view_get_draw_sensitive(GtkCellView* cell_view)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_get_draw_sensitive", "GtkCellView*");
+ return(C_to_Xen_gboolean(gtk_cell_view_get_draw_sensitive(Xen_to_C_GtkCellView_(cell_view))));
}
-static XEN gxg_gtk_viewport_get_bin_window(XEN viewport)
+static Xen gxg_gtk_cell_view_set_draw_sensitive(Xen cell_view, Xen draw_sensitive)
{
- #define H_gtk_viewport_get_bin_window "GdkWindow* gtk_viewport_get_bin_window(GtkViewport* viewport)"
- XEN_ASSERT_TYPE(XEN_GtkViewport__P(viewport), viewport, 1, "gtk_viewport_get_bin_window", "GtkViewport*");
- return(C_TO_XEN_GdkWindow_(gtk_viewport_get_bin_window(XEN_TO_C_GtkViewport_(viewport))));
+ #define H_gtk_cell_view_set_draw_sensitive "void gtk_cell_view_set_draw_sensitive(GtkCellView* cell_view, \
+gboolean draw_sensitive)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_set_draw_sensitive", "GtkCellView*");
+ Xen_check_type(Xen_is_gboolean(draw_sensitive), draw_sensitive, 2, "gtk_cell_view_set_draw_sensitive", "gboolean");
+ gtk_cell_view_set_draw_sensitive(Xen_to_C_GtkCellView_(cell_view), Xen_to_C_gboolean(draw_sensitive));
+ return(Xen_false);
}
-static XEN gxg_gtk_spinner_new(void)
+static Xen gxg_gtk_cell_view_get_fit_model(Xen cell_view)
{
- #define H_gtk_spinner_new "GtkWidget* gtk_spinner_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_spinner_new()));
+ #define H_gtk_cell_view_get_fit_model "gboolean gtk_cell_view_get_fit_model(GtkCellView* cell_view)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_get_fit_model", "GtkCellView*");
+ return(C_to_Xen_gboolean(gtk_cell_view_get_fit_model(Xen_to_C_GtkCellView_(cell_view))));
}
-static XEN gxg_gtk_spinner_start(XEN spinner)
+static Xen gxg_gtk_cell_view_set_fit_model(Xen cell_view, Xen fit_model)
{
- #define H_gtk_spinner_start "void gtk_spinner_start(GtkSpinner* spinner)"
- XEN_ASSERT_TYPE(XEN_GtkSpinner__P(spinner), spinner, 1, "gtk_spinner_start", "GtkSpinner*");
- gtk_spinner_start(XEN_TO_C_GtkSpinner_(spinner));
- return(XEN_FALSE);
+ #define H_gtk_cell_view_set_fit_model "void gtk_cell_view_set_fit_model(GtkCellView* cell_view, gboolean fit_model)"
+ Xen_check_type(Xen_is_GtkCellView_(cell_view), cell_view, 1, "gtk_cell_view_set_fit_model", "GtkCellView*");
+ Xen_check_type(Xen_is_gboolean(fit_model), fit_model, 2, "gtk_cell_view_set_fit_model", "gboolean");
+ gtk_cell_view_set_fit_model(Xen_to_C_GtkCellView_(cell_view), Xen_to_C_gboolean(fit_model));
+ return(Xen_false);
}
-static XEN gxg_gtk_spinner_stop(XEN spinner)
+static Xen gxg_gtk_combo_box_new_with_area(Xen area)
{
- #define H_gtk_spinner_stop "void gtk_spinner_stop(GtkSpinner* spinner)"
- XEN_ASSERT_TYPE(XEN_GtkSpinner__P(spinner), spinner, 1, "gtk_spinner_stop", "GtkSpinner*");
- gtk_spinner_stop(XEN_TO_C_GtkSpinner_(spinner));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_new_with_area "GtkWidget* gtk_combo_box_new_with_area(GtkCellArea* area)"
+ Xen_check_type(Xen_is_GtkCellArea_(area), area, 1, "gtk_combo_box_new_with_area", "GtkCellArea*");
+ return(C_to_Xen_GtkWidget_(gtk_combo_box_new_with_area(Xen_to_C_GtkCellArea_(area))));
}
-static XEN gxg_gtk_cell_renderer_spinner_new(void)
+static Xen gxg_gtk_combo_box_new_with_area_and_entry(Xen area)
{
- #define H_gtk_cell_renderer_spinner_new "GtkCellRenderer* gtk_cell_renderer_spinner_new( void)"
- return(C_TO_XEN_GtkCellRenderer_(gtk_cell_renderer_spinner_new()));
+ #define H_gtk_combo_box_new_with_area_and_entry "GtkWidget* gtk_combo_box_new_with_area_and_entry(GtkCellArea* area)"
+ Xen_check_type(Xen_is_GtkCellArea_(area), area, 1, "gtk_combo_box_new_with_area_and_entry", "GtkCellArea*");
+ return(C_to_Xen_GtkWidget_(gtk_combo_box_new_with_area_and_entry(Xen_to_C_GtkCellArea_(area))));
}
-static XEN gxg_gtk_action_set_always_show_image(XEN action, XEN always_show)
+static Xen gxg_gtk_icon_view_new_with_area(Xen area)
{
- #define H_gtk_action_set_always_show_image "void gtk_action_set_always_show_image(GtkAction* action, \
-gboolean always_show)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_always_show_image", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(always_show), always_show, 2, "gtk_action_set_always_show_image", "gboolean");
- gtk_action_set_always_show_image(XEN_TO_C_GtkAction_(action), XEN_TO_C_gboolean(always_show));
- return(XEN_FALSE);
+ #define H_gtk_icon_view_new_with_area "GtkWidget* gtk_icon_view_new_with_area(GtkCellArea* area)"
+ Xen_check_type(Xen_is_GtkCellArea_(area), area, 1, "gtk_icon_view_new_with_area", "GtkCellArea*");
+ return(C_to_Xen_GtkWidget_(gtk_icon_view_new_with_area(Xen_to_C_GtkCellArea_(area))));
}
-static XEN gxg_gtk_action_get_always_show_image(XEN action)
+static Xen gxg_gtk_menu_item_set_reserve_indicator(Xen menu_item, Xen reserve)
{
- #define H_gtk_action_get_always_show_image "gboolean gtk_action_get_always_show_image(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_always_show_image", "GtkAction*");
- return(C_TO_XEN_gboolean(gtk_action_get_always_show_image(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_menu_item_set_reserve_indicator "void gtk_menu_item_set_reserve_indicator(GtkMenuItem* menu_item, \
+gboolean reserve)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_set_reserve_indicator", "GtkMenuItem*");
+ Xen_check_type(Xen_is_gboolean(reserve), reserve, 2, "gtk_menu_item_set_reserve_indicator", "gboolean");
+ gtk_menu_item_set_reserve_indicator(Xen_to_C_GtkMenuItem_(menu_item), Xen_to_C_gboolean(reserve));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_action_widget(XEN notebook, XEN pack_type)
+static Xen gxg_gtk_menu_item_get_reserve_indicator(Xen menu_item)
{
- #define H_gtk_notebook_get_action_widget "GtkWidget* gtk_notebook_get_action_widget(GtkNotebook* notebook, \
-GtkPackType pack_type)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_action_widget", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkPackType_P(pack_type), pack_type, 2, "gtk_notebook_get_action_widget", "GtkPackType");
- return(C_TO_XEN_GtkWidget_(gtk_notebook_get_action_widget(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkPackType(pack_type))));
+ #define H_gtk_menu_item_get_reserve_indicator "gboolean gtk_menu_item_get_reserve_indicator(GtkMenuItem* menu_item)"
+ Xen_check_type(Xen_is_GtkMenuItem_(menu_item), menu_item, 1, "gtk_menu_item_get_reserve_indicator", "GtkMenuItem*");
+ return(C_to_Xen_gboolean(gtk_menu_item_get_reserve_indicator(Xen_to_C_GtkMenuItem_(menu_item))));
}
-static XEN gxg_gtk_notebook_set_action_widget(XEN notebook, XEN widget, XEN pack_type)
+static Xen gxg_gtk_menu_shell_get_selected_item(Xen menu_shell)
{
- #define H_gtk_notebook_set_action_widget "void gtk_notebook_set_action_widget(GtkNotebook* notebook, \
-GtkWidget* widget, GtkPackType pack_type)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_action_widget", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_notebook_set_action_widget", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkPackType_P(pack_type), pack_type, 3, "gtk_notebook_set_action_widget", "GtkPackType");
- gtk_notebook_set_action_widget(XEN_TO_C_GtkNotebook_(notebook), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkPackType(pack_type));
- return(XEN_FALSE);
+ #define H_gtk_menu_shell_get_selected_item "GtkWidget* gtk_menu_shell_get_selected_item(GtkMenuShell* menu_shell)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_get_selected_item", "GtkMenuShell*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_shell_get_selected_item(Xen_to_C_GtkMenuShell_(menu_shell))));
}
-static XEN gxg_gtk_statusbar_get_message_area(XEN statusbar)
+static Xen gxg_gtk_menu_shell_get_parent_shell(Xen menu_shell)
{
- #define H_gtk_statusbar_get_message_area "GtkWidget* gtk_statusbar_get_message_area(GtkStatusbar* statusbar)"
- XEN_ASSERT_TYPE(XEN_GtkStatusbar__P(statusbar), statusbar, 1, "gtk_statusbar_get_message_area", "GtkStatusbar*");
- return(C_TO_XEN_GtkWidget_(gtk_statusbar_get_message_area(XEN_TO_C_GtkStatusbar_(statusbar))));
+ #define H_gtk_menu_shell_get_parent_shell "GtkWidget* gtk_menu_shell_get_parent_shell(GtkMenuShell* menu_shell)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_get_parent_shell", "GtkMenuShell*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_shell_get_parent_shell(Xen_to_C_GtkMenuShell_(menu_shell))));
}
-static XEN gxg_gtk_tool_item_get_ellipsize_mode(XEN tool_item)
+static Xen gxg_gtk_selection_data_get_data_with_length(Xen selection_data, Xen ignore_length)
{
- #define H_gtk_tool_item_get_ellipsize_mode "PangoEllipsizeMode gtk_tool_item_get_ellipsize_mode(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_ellipsize_mode", "GtkToolItem*");
- return(C_TO_XEN_PangoEllipsizeMode(gtk_tool_item_get_ellipsize_mode(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_selection_data_get_data_with_length "guchar* gtk_selection_data_get_data_with_length(GtkSelectionData* selection_data, \
+gint* [length])"
+ gint ref_length;
+ Xen_check_type(Xen_is_GtkSelectionData_(selection_data), selection_data, 1, "gtk_selection_data_get_data_with_length", "GtkSelectionData*");
+ {
+ Xen result;
+ result = C_to_Xen_guchar_(gtk_selection_data_get_data_with_length(Xen_to_C_GtkSelectionData_(selection_data), &ref_length));
+ return(Xen_list_2(result, C_to_Xen_gint(ref_length)));
+ }
}
-static XEN gxg_gtk_tool_item_get_text_alignment(XEN tool_item)
+static Xen gxg_gtk_tree_model_iter_previous(Xen tree_model, Xen iter)
{
- #define H_gtk_tool_item_get_text_alignment "gfloat gtk_tool_item_get_text_alignment(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_text_alignment", "GtkToolItem*");
- return(C_TO_XEN_gfloat(gtk_tool_item_get_text_alignment(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_tree_model_iter_previous "gboolean gtk_tree_model_iter_previous(GtkTreeModel* tree_model, \
+GtkTreeIter* iter)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_iter_previous", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 2, "gtk_tree_model_iter_previous", "GtkTreeIter*");
+ return(C_to_Xen_gboolean(gtk_tree_model_iter_previous(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreeIter_(iter))));
}
-static XEN gxg_gtk_tool_item_get_text_orientation(XEN tool_item)
+static Xen gxg_gtk_tree_view_is_blank_at_pos(Xen tree_view, Xen x, Xen y, Xen ignore_path, Xen ignore_column, Xen ignore_cell_x, Xen ignore_cell_y)
{
- #define H_gtk_tool_item_get_text_orientation "GtkOrientation gtk_tool_item_get_text_orientation(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_text_orientation", "GtkToolItem*");
- return(C_TO_XEN_GtkOrientation(gtk_tool_item_get_text_orientation(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_tree_view_is_blank_at_pos "gboolean gtk_tree_view_is_blank_at_pos(GtkTreeView* tree_view, \
+gint x, gint y, GtkTreePath** [path], GtkTreeViewColumn** [column], gint* [cell_x], gint* [cell_y])"
+ GtkTreePath* ref_path = NULL;
+ GtkTreeViewColumn* ref_column = NULL;
+ gint ref_cell_x;
+ gint ref_cell_y;
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_is_blank_at_pos", "GtkTreeView*");
+ Xen_check_type(Xen_is_gint(x), x, 2, "gtk_tree_view_is_blank_at_pos", "gint");
+ Xen_check_type(Xen_is_gint(y), y, 3, "gtk_tree_view_is_blank_at_pos", "gint");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_tree_view_is_blank_at_pos(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gint(x), Xen_to_C_gint(y),
+ &ref_path, &ref_column, &ref_cell_x, &ref_cell_y));
+ return(Xen_list_5(result, C_to_Xen_GtkTreePath_(ref_path), C_to_Xen_GtkTreeViewColumn_(ref_column), C_to_Xen_gint(ref_cell_x), C_to_Xen_gint(ref_cell_y)));
+ }
}
-static XEN gxg_gtk_tool_item_get_text_size_group(XEN tool_item)
+static Xen gxg_gtk_widget_set_device_enabled(Xen widget, Xen device, Xen enabled)
{
- #define H_gtk_tool_item_get_text_size_group "GtkSizeGroup* gtk_tool_item_get_text_size_group(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_get_text_size_group", "GtkToolItem*");
- return(C_TO_XEN_GtkSizeGroup_(gtk_tool_item_get_text_size_group(XEN_TO_C_GtkToolItem_(tool_item))));
+ #define H_gtk_widget_set_device_enabled "void gtk_widget_set_device_enabled(GtkWidget* widget, GdkDevice* device, \
+gboolean enabled)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_device_enabled", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_widget_set_device_enabled", "GdkDevice*");
+ Xen_check_type(Xen_is_gboolean(enabled), enabled, 3, "gtk_widget_set_device_enabled", "gboolean");
+ gtk_widget_set_device_enabled(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDevice_(device), Xen_to_C_gboolean(enabled));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_new(void)
+static Xen gxg_gtk_widget_get_device_enabled(Xen widget, Xen device)
{
- #define H_gtk_tool_palette_new "GtkWidget* gtk_tool_palette_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_tool_palette_new()));
+ #define H_gtk_widget_get_device_enabled "gboolean gtk_widget_get_device_enabled(GtkWidget* widget, \
+GdkDevice* device)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_device_enabled", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gtk_widget_get_device_enabled", "GdkDevice*");
+ return(C_to_Xen_gboolean(gtk_widget_get_device_enabled(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_tool_palette_set_group_position(XEN palette, XEN group, XEN position)
+static Xen gxg_gtk_window_set_has_user_ref_count(Xen window, Xen setting)
{
- #define H_gtk_tool_palette_set_group_position "void gtk_tool_palette_set_group_position(GtkToolPalette* palette, \
-GtkToolItemGroup* group, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_set_group_position", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 2, "gtk_tool_palette_set_group_position", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_tool_palette_set_group_position", "gint");
- gtk_tool_palette_set_group_position(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_window_set_has_user_ref_count "void gtk_window_set_has_user_ref_count(GtkWindow* window, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_has_user_ref_count", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_has_user_ref_count", "gboolean");
+ gtk_window_set_has_user_ref_count(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_set_exclusive(XEN palette, XEN group, XEN exclusive)
+static Xen gxg_gdk_selection_send_notify(Xen requestor, Xen selection, Xen target, Xen property, Xen time_)
{
- #define H_gtk_tool_palette_set_exclusive "void gtk_tool_palette_set_exclusive(GtkToolPalette* palette, \
-GtkToolItemGroup* group, gboolean exclusive)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_set_exclusive", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 2, "gtk_tool_palette_set_exclusive", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(exclusive), exclusive, 3, "gtk_tool_palette_set_exclusive", "gboolean");
- gtk_tool_palette_set_exclusive(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_gboolean(exclusive));
- return(XEN_FALSE);
+ #define H_gdk_selection_send_notify "void gdk_selection_send_notify(GdkWindow* requestor, GdkAtom selection, \
+GdkAtom target, GdkAtom property, guint32 time_)"
+ Xen_check_type(Xen_is_GdkWindow_(requestor), requestor, 1, "gdk_selection_send_notify", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 2, "gdk_selection_send_notify", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 3, "gdk_selection_send_notify", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(property), property, 4, "gdk_selection_send_notify", "GdkAtom");
+ Xen_check_type(Xen_is_guint32(time_), time_, 5, "gdk_selection_send_notify", "guint32");
+ gdk_selection_send_notify(Xen_to_C_GdkWindow_(requestor), Xen_to_C_GdkAtom(selection), Xen_to_C_GdkAtom(target), Xen_to_C_GdkAtom(property),
+ Xen_to_C_guint32(time_));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_set_expand(XEN palette, XEN group, XEN expand)
+static Xen gxg_gdk_selection_send_notify_for_display(Xen display, Xen requestor, Xen selection, Xen target, Xen property, Xen time_)
{
- #define H_gtk_tool_palette_set_expand "void gtk_tool_palette_set_expand(GtkToolPalette* palette, GtkToolItemGroup* group, \
-gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_set_expand", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 2, "gtk_tool_palette_set_expand", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 3, "gtk_tool_palette_set_expand", "gboolean");
- gtk_tool_palette_set_expand(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_gdk_selection_send_notify_for_display "void gdk_selection_send_notify_for_display(GdkDisplay* display, \
+GdkWindow* requestor, GdkAtom selection, GdkAtom target, GdkAtom property, guint32 time_)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_selection_send_notify_for_display", "GdkDisplay*");
+ Xen_check_type(Xen_is_GdkWindow_(requestor), requestor, 2, "gdk_selection_send_notify_for_display", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkAtom(selection), selection, 3, "gdk_selection_send_notify_for_display", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(target), target, 4, "gdk_selection_send_notify_for_display", "GdkAtom");
+ Xen_check_type(Xen_is_GdkAtom(property), property, 5, "gdk_selection_send_notify_for_display", "GdkAtom");
+ Xen_check_type(Xen_is_guint32(time_), time_, 6, "gdk_selection_send_notify_for_display", "guint32");
+ gdk_selection_send_notify_for_display(Xen_to_C_GdkDisplay_(display), Xen_to_C_GdkWindow_(requestor), Xen_to_C_GdkAtom(selection),
+ Xen_to_C_GdkAtom(target), Xen_to_C_GdkAtom(property), Xen_to_C_guint32(time_));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_get_group_position(XEN palette, XEN group)
+static Xen gxg_gdk_rgba_copy(Xen rgba)
{
- #define H_gtk_tool_palette_get_group_position "gint gtk_tool_palette_get_group_position(GtkToolPalette* palette, \
-GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_get_group_position", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 2, "gtk_tool_palette_get_group_position", "GtkToolItemGroup*");
- return(C_TO_XEN_gint(gtk_tool_palette_get_group_position(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gdk_rgba_copy "GdkRGBA* gdk_rgba_copy(GdkRGBA* rgba)"
+ Xen_check_type(Xen_is_GdkRGBA_(rgba), rgba, 1, "gdk_rgba_copy", "GdkRGBA*");
+ return(C_to_Xen_GdkRGBA_(gdk_rgba_copy(Xen_to_C_GdkRGBA_(rgba))));
}
-static XEN gxg_gtk_tool_palette_get_exclusive(XEN palette, XEN group)
+static Xen gxg_gdk_rgba_free(Xen rgba)
{
- #define H_gtk_tool_palette_get_exclusive "gboolean gtk_tool_palette_get_exclusive(GtkToolPalette* palette, \
-GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_get_exclusive", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 2, "gtk_tool_palette_get_exclusive", "GtkToolItemGroup*");
- return(C_TO_XEN_gboolean(gtk_tool_palette_get_exclusive(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gdk_rgba_free "void gdk_rgba_free(GdkRGBA* rgba)"
+ Xen_check_type(Xen_is_GdkRGBA_(rgba), rgba, 1, "gdk_rgba_free", "GdkRGBA*");
+ gdk_rgba_free(Xen_to_C_GdkRGBA_(rgba));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_get_expand(XEN palette, XEN group)
+static Xen gxg_gdk_rgba_parse(Xen rgba, Xen spec)
{
- #define H_gtk_tool_palette_get_expand "gboolean gtk_tool_palette_get_expand(GtkToolPalette* palette, \
-GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_get_expand", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 2, "gtk_tool_palette_get_expand", "GtkToolItemGroup*");
- return(C_TO_XEN_gboolean(gtk_tool_palette_get_expand(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gdk_rgba_parse "gboolean gdk_rgba_parse(GdkRGBA* rgba, gchar* spec)"
+ Xen_check_type(Xen_is_GdkRGBA_(rgba), rgba, 1, "gdk_rgba_parse", "GdkRGBA*");
+ Xen_check_type(Xen_is_gchar_(spec), spec, 2, "gdk_rgba_parse", "gchar*");
+ return(C_to_Xen_gboolean(gdk_rgba_parse(Xen_to_C_GdkRGBA_(rgba), (const gchar*)Xen_to_C_gchar_(spec))));
}
-static XEN gxg_gtk_tool_palette_set_icon_size(XEN palette, XEN icon_size)
+static Xen gxg_gdk_rgba_to_string(Xen rgba)
{
- #define H_gtk_tool_palette_set_icon_size "void gtk_tool_palette_set_icon_size(GtkToolPalette* palette, \
-GtkIconSize icon_size)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_set_icon_size", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(icon_size), icon_size, 2, "gtk_tool_palette_set_icon_size", "GtkIconSize");
- gtk_tool_palette_set_icon_size(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkIconSize(icon_size));
- return(XEN_FALSE);
+ #define H_gdk_rgba_to_string "gchar* gdk_rgba_to_string(GdkRGBA* rgba)"
+ Xen_check_type(Xen_is_GdkRGBA_(rgba), rgba, 1, "gdk_rgba_to_string", "GdkRGBA*");
+ return(C_to_Xen_gchar_(gdk_rgba_to_string(Xen_to_C_GdkRGBA_(rgba))));
}
-static XEN gxg_gtk_tool_palette_unset_icon_size(XEN palette)
+static Xen gxg_gtk_widget_set_state_flags(Xen widget, Xen flags, Xen clear)
{
- #define H_gtk_tool_palette_unset_icon_size "void gtk_tool_palette_unset_icon_size(GtkToolPalette* palette)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_unset_icon_size", "GtkToolPalette*");
- gtk_tool_palette_unset_icon_size(XEN_TO_C_GtkToolPalette_(palette));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_state_flags "void gtk_widget_set_state_flags(GtkWidget* widget, GtkStateFlags flags, \
+gboolean clear)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_state_flags", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkStateFlags(flags), flags, 2, "gtk_widget_set_state_flags", "GtkStateFlags");
+ Xen_check_type(Xen_is_gboolean(clear), clear, 3, "gtk_widget_set_state_flags", "gboolean");
+ gtk_widget_set_state_flags(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkStateFlags(flags), Xen_to_C_gboolean(clear));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_set_style(XEN palette, XEN style)
+static Xen gxg_gtk_widget_unset_state_flags(Xen widget, Xen flags)
{
- #define H_gtk_tool_palette_set_style "void gtk_tool_palette_set_style(GtkToolPalette* palette, GtkToolbarStyle style)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_set_style", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkToolbarStyle_P(style), style, 2, "gtk_tool_palette_set_style", "GtkToolbarStyle");
- gtk_tool_palette_set_style(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkToolbarStyle(style));
- return(XEN_FALSE);
+ #define H_gtk_widget_unset_state_flags "void gtk_widget_unset_state_flags(GtkWidget* widget, GtkStateFlags flags)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_unset_state_flags", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkStateFlags(flags), flags, 2, "gtk_widget_unset_state_flags", "GtkStateFlags");
+ gtk_widget_unset_state_flags(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkStateFlags(flags));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_unset_style(XEN palette)
+static Xen gxg_gtk_widget_get_state_flags(Xen widget)
{
- #define H_gtk_tool_palette_unset_style "void gtk_tool_palette_unset_style(GtkToolPalette* palette)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_unset_style", "GtkToolPalette*");
- gtk_tool_palette_unset_style(XEN_TO_C_GtkToolPalette_(palette));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_state_flags "GtkStateFlags gtk_widget_get_state_flags(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_state_flags", "GtkWidget*");
+ return(C_to_Xen_GtkStateFlags(gtk_widget_get_state_flags(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tool_palette_get_icon_size(XEN palette)
+#endif
+
+#if GTK_CHECK_VERSION(3, 2, 0)
+static Xen gxg_gtk_entry_get_placeholder_text(Xen entry)
{
- #define H_gtk_tool_palette_get_icon_size "GtkIconSize gtk_tool_palette_get_icon_size(GtkToolPalette* palette)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_get_icon_size", "GtkToolPalette*");
- return(C_TO_XEN_GtkIconSize(gtk_tool_palette_get_icon_size(XEN_TO_C_GtkToolPalette_(palette))));
+ #define H_gtk_entry_get_placeholder_text "gchar* gtk_entry_get_placeholder_text(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_placeholder_text", "GtkEntry*");
+ return(C_to_Xen_gchar_(gtk_entry_get_placeholder_text(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_tool_palette_get_style(XEN palette)
+static Xen gxg_gtk_entry_set_placeholder_text(Xen entry, Xen text)
{
- #define H_gtk_tool_palette_get_style "GtkToolbarStyle gtk_tool_palette_get_style(GtkToolPalette* palette)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_get_style", "GtkToolPalette*");
- return(C_TO_XEN_GtkToolbarStyle(gtk_tool_palette_get_style(XEN_TO_C_GtkToolPalette_(palette))));
+ #define H_gtk_entry_set_placeholder_text "void gtk_entry_set_placeholder_text(GtkEntry* entry, gchar* text)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_placeholder_text", "GtkEntry*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_entry_set_placeholder_text", "gchar*");
+ gtk_entry_set_placeholder_text(Xen_to_C_GtkEntry_(entry), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_get_drop_item(XEN palette, XEN x, XEN y)
+static Xen gxg_gtk_expander_set_resize_toplevel(Xen expander, Xen resize_toplevel)
{
- #define H_gtk_tool_palette_get_drop_item "GtkToolItem* gtk_tool_palette_get_drop_item(GtkToolPalette* palette, \
-gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_get_drop_item", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_tool_palette_get_drop_item", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_tool_palette_get_drop_item", "gint");
- return(C_TO_XEN_GtkToolItem_(gtk_tool_palette_get_drop_item(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_gint(x), XEN_TO_C_gint(y))));
+ #define H_gtk_expander_set_resize_toplevel "void gtk_expander_set_resize_toplevel(GtkExpander* expander, \
+gboolean resize_toplevel)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_set_resize_toplevel", "GtkExpander*");
+ Xen_check_type(Xen_is_gboolean(resize_toplevel), resize_toplevel, 2, "gtk_expander_set_resize_toplevel", "gboolean");
+ gtk_expander_set_resize_toplevel(Xen_to_C_GtkExpander_(expander), Xen_to_C_gboolean(resize_toplevel));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_get_drop_group(XEN palette, XEN x, XEN y)
+static Xen gxg_gtk_expander_get_resize_toplevel(Xen expander)
{
- #define H_gtk_tool_palette_get_drop_group "GtkToolItemGroup* gtk_tool_palette_get_drop_group(GtkToolPalette* palette, \
-gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_get_drop_group", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_tool_palette_get_drop_group", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_tool_palette_get_drop_group", "gint");
- return(C_TO_XEN_GtkToolItemGroup_(gtk_tool_palette_get_drop_group(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_gint(x),
- XEN_TO_C_gint(y))));
+ #define H_gtk_expander_get_resize_toplevel "gboolean gtk_expander_get_resize_toplevel(GtkExpander* expander)"
+ Xen_check_type(Xen_is_GtkExpander_(expander), expander, 1, "gtk_expander_get_resize_toplevel", "GtkExpander*");
+ return(C_to_Xen_gboolean(gtk_expander_get_resize_toplevel(Xen_to_C_GtkExpander_(expander))));
}
-static XEN gxg_gtk_tool_palette_get_drag_item(XEN palette, XEN selection)
+static Xen gxg_gtk_widget_path_to_string(Xen path)
{
- #define H_gtk_tool_palette_get_drag_item "GtkWidget* gtk_tool_palette_get_drag_item(GtkToolPalette* palette, \
-GtkSelectionData* selection)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_get_drag_item", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection), selection, 2, "gtk_tool_palette_get_drag_item", "GtkSelectionData*");
- return(C_TO_XEN_GtkWidget_(gtk_tool_palette_get_drag_item(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkSelectionData_(selection))));
+ #define H_gtk_widget_path_to_string "char* gtk_widget_path_to_string(GtkWidgetPath* path)"
+ Xen_check_type(Xen_is_GtkWidgetPath_(path), path, 1, "gtk_widget_path_to_string", "GtkWidgetPath*");
+ return(C_to_Xen_char_(gtk_widget_path_to_string(Xen_to_C_GtkWidgetPath_(path))));
}
-static XEN gxg_gtk_tool_palette_set_drag_source(XEN palette, XEN targets)
+static Xen gxg_gtk_button_box_get_child_non_homogeneous(Xen widget, Xen child)
{
- #define H_gtk_tool_palette_set_drag_source "void gtk_tool_palette_set_drag_source(GtkToolPalette* palette, \
-GtkToolPaletteDragTargets targets)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_set_drag_source", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkToolPaletteDragTargets_P(targets), targets, 2, "gtk_tool_palette_set_drag_source", "GtkToolPaletteDragTargets");
- gtk_tool_palette_set_drag_source(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkToolPaletteDragTargets(targets));
- return(XEN_FALSE);
+ #define H_gtk_button_box_get_child_non_homogeneous "gboolean gtk_button_box_get_child_non_homogeneous(GtkButtonBox* widget, \
+GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkButtonBox_(widget), widget, 1, "gtk_button_box_get_child_non_homogeneous", "GtkButtonBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_button_box_get_child_non_homogeneous", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_button_box_get_child_non_homogeneous(Xen_to_C_GtkButtonBox_(widget), Xen_to_C_GtkWidget_(child))));
}
-static XEN gxg_gtk_tool_palette_add_drag_dest(XEN palette, XEN widget, XEN flags, XEN targets, XEN actions)
+static Xen gxg_gtk_button_box_set_child_non_homogeneous(Xen widget, Xen child, Xen non_homogeneous)
{
- #define H_gtk_tool_palette_add_drag_dest "void gtk_tool_palette_add_drag_dest(GtkToolPalette* palette, \
-GtkWidget* widget, GtkDestDefaults flags, GtkToolPaletteDragTargets targets, GdkDragAction actions)"
- XEN_ASSERT_TYPE(XEN_GtkToolPalette__P(palette), palette, 1, "gtk_tool_palette_add_drag_dest", "GtkToolPalette*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_tool_palette_add_drag_dest", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkDestDefaults_P(flags), flags, 3, "gtk_tool_palette_add_drag_dest", "GtkDestDefaults");
- XEN_ASSERT_TYPE(XEN_GtkToolPaletteDragTargets_P(targets), targets, 4, "gtk_tool_palette_add_drag_dest", "GtkToolPaletteDragTargets");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(actions), actions, 5, "gtk_tool_palette_add_drag_dest", "GdkDragAction");
- gtk_tool_palette_add_drag_dest(XEN_TO_C_GtkToolPalette_(palette), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkDestDefaults(flags),
- XEN_TO_C_GtkToolPaletteDragTargets(targets), XEN_TO_C_GdkDragAction(actions));
- return(XEN_FALSE);
+ #define H_gtk_button_box_set_child_non_homogeneous "void gtk_button_box_set_child_non_homogeneous(GtkButtonBox* widget, \
+GtkWidget* child, gboolean non_homogeneous)"
+ Xen_check_type(Xen_is_GtkButtonBox_(widget), widget, 1, "gtk_button_box_set_child_non_homogeneous", "GtkButtonBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_button_box_set_child_non_homogeneous", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(non_homogeneous), non_homogeneous, 3, "gtk_button_box_set_child_non_homogeneous", "gboolean");
+ gtk_button_box_set_child_non_homogeneous(Xen_to_C_GtkButtonBox_(widget), Xen_to_C_GtkWidget_(child), Xen_to_C_gboolean(non_homogeneous));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_get_drag_target_item(void)
+static Xen gxg_gtk_container_child_notify(Xen container, Xen child, Xen property_name)
{
- #define H_gtk_tool_palette_get_drag_target_item "GtkTargetEntry* gtk_tool_palette_get_drag_target_item( void)"
- return(C_TO_XEN_GtkTargetEntry_((GtkTargetEntry*)gtk_tool_palette_get_drag_target_item()));
+ #define H_gtk_container_child_notify "void gtk_container_child_notify(GtkContainer* container, GtkWidget* child, \
+gchar* property_name)"
+ Xen_check_type(Xen_is_GtkContainer_(container), container, 1, "gtk_container_child_notify", "GtkContainer*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_container_child_notify", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(property_name), property_name, 3, "gtk_container_child_notify", "gchar*");
+ gtk_container_child_notify(Xen_to_C_GtkContainer_(container), Xen_to_C_GtkWidget_(child), (const gchar*)Xen_to_C_gchar_(property_name));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_palette_get_drag_target_group(void)
+static Xen gxg_gtk_drag_source_set_icon_gicon(Xen widget, Xen icon)
{
- #define H_gtk_tool_palette_get_drag_target_group "GtkTargetEntry* gtk_tool_palette_get_drag_target_group( void)"
- return(C_TO_XEN_GtkTargetEntry_((GtkTargetEntry*)gtk_tool_palette_get_drag_target_group()));
+ #define H_gtk_drag_source_set_icon_gicon "void gtk_drag_source_set_icon_gicon(GtkWidget* widget, GIcon* icon)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_drag_source_set_icon_gicon", "GtkWidget*");
+ Xen_check_type(Xen_is_GIcon_(icon), icon, 2, "gtk_drag_source_set_icon_gicon", "GIcon*");
+ gtk_drag_source_set_icon_gicon(Xen_to_C_GtkWidget_(widget), Xen_to_C_GIcon_(icon));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_group_new(XEN label)
+static Xen gxg_gtk_drag_set_icon_gicon(Xen context, Xen icon, Xen hot_x, Xen hot_y)
{
- #define H_gtk_tool_item_group_new "GtkWidget* gtk_tool_item_group_new(gchar* label)"
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 1, "gtk_tool_item_group_new", "gchar*");
- return(C_TO_XEN_GtkWidget_(gtk_tool_item_group_new((const gchar*)XEN_TO_C_gchar_(label))));
+ #define H_gtk_drag_set_icon_gicon "void gtk_drag_set_icon_gicon(GdkDragContext* context, GIcon* icon, \
+gint hot_x, gint hot_y)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_set_icon_gicon", "GdkDragContext*");
+ Xen_check_type(Xen_is_GIcon_(icon), icon, 2, "gtk_drag_set_icon_gicon", "GIcon*");
+ Xen_check_type(Xen_is_gint(hot_x), hot_x, 3, "gtk_drag_set_icon_gicon", "gint");
+ Xen_check_type(Xen_is_gint(hot_y), hot_y, 4, "gtk_drag_set_icon_gicon", "gint");
+ gtk_drag_set_icon_gicon(Xen_to_C_GdkDragContext_(context), Xen_to_C_GIcon_(icon), Xen_to_C_gint(hot_x), Xen_to_C_gint(hot_y));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_group_set_label(XEN group, XEN label)
+static Xen gxg_gtk_combo_box_set_active_id(Xen combo_box, Xen active_id)
{
- #define H_gtk_tool_item_group_set_label "void gtk_tool_item_group_set_label(GtkToolItemGroup* group, \
-gchar* label)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_set_label", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_gchar__P(label), label, 2, "gtk_tool_item_group_set_label", "gchar*");
- gtk_tool_item_group_set_label(XEN_TO_C_GtkToolItemGroup_(group), (const gchar*)XEN_TO_C_gchar_(label));
- return(XEN_FALSE);
+ #define H_gtk_combo_box_set_active_id "gboolean gtk_combo_box_set_active_id(GtkComboBox* combo_box, \
+gchar* active_id)"
+ Xen_check_type(Xen_is_GtkComboBox_(combo_box), combo_box, 1, "gtk_combo_box_set_active_id", "GtkComboBox*");
+ Xen_check_type(Xen_is_gchar_(active_id), active_id, 2, "gtk_combo_box_set_active_id", "gchar*");
+ return(C_to_Xen_gboolean(gtk_combo_box_set_active_id(Xen_to_C_GtkComboBox_(combo_box), (const gchar*)Xen_to_C_gchar_(active_id))));
}
-static XEN gxg_gtk_tool_item_group_set_label_widget(XEN group, XEN label_widget)
+static Xen gxg_gtk_tree_view_column_get_x_offset(Xen tree_column)
{
- #define H_gtk_tool_item_group_set_label_widget "void gtk_tool_item_group_set_label_widget(GtkToolItemGroup* group, \
-GtkWidget* label_widget)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_set_label_widget", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(label_widget), label_widget, 2, "gtk_tool_item_group_set_label_widget", "GtkWidget*");
- gtk_tool_item_group_set_label_widget(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_GtkWidget_(label_widget));
- return(XEN_FALSE);
+ #define H_gtk_tree_view_column_get_x_offset "gint gtk_tree_view_column_get_x_offset(GtkTreeViewColumn* tree_column)"
+ Xen_check_type(Xen_is_GtkTreeViewColumn_(tree_column), tree_column, 1, "gtk_tree_view_column_get_x_offset", "GtkTreeViewColumn*");
+ return(C_to_Xen_gint(gtk_tree_view_column_get_x_offset(Xen_to_C_GtkTreeViewColumn_(tree_column))));
}
-static XEN gxg_gtk_tool_item_group_set_collapsed(XEN group, XEN collapsed)
+static Xen gxg_gtk_overlay_new(void)
{
- #define H_gtk_tool_item_group_set_collapsed "void gtk_tool_item_group_set_collapsed(GtkToolItemGroup* group, \
-gboolean collapsed)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_set_collapsed", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(collapsed), collapsed, 2, "gtk_tool_item_group_set_collapsed", "gboolean");
- gtk_tool_item_group_set_collapsed(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_gboolean(collapsed));
- return(XEN_FALSE);
+ #define H_gtk_overlay_new "GtkWidget* gtk_overlay_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_overlay_new()));
}
-static XEN gxg_gtk_tool_item_group_set_ellipsize(XEN group, XEN ellipsize)
+static Xen gxg_gtk_overlay_add_overlay(Xen overlay, Xen widget)
{
- #define H_gtk_tool_item_group_set_ellipsize "void gtk_tool_item_group_set_ellipsize(GtkToolItemGroup* group, \
-PangoEllipsizeMode ellipsize)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_set_ellipsize", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_PangoEllipsizeMode_P(ellipsize), ellipsize, 2, "gtk_tool_item_group_set_ellipsize", "PangoEllipsizeMode");
- gtk_tool_item_group_set_ellipsize(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_PangoEllipsizeMode(ellipsize));
- return(XEN_FALSE);
+ #define H_gtk_overlay_add_overlay "void gtk_overlay_add_overlay(GtkOverlay* overlay, GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkOverlay_(overlay), overlay, 1, "gtk_overlay_add_overlay", "GtkOverlay*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_overlay_add_overlay", "GtkWidget*");
+ gtk_overlay_add_overlay(Xen_to_C_GtkOverlay_(overlay), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_group_set_header_relief(XEN group, XEN style)
+static Xen gxg_gtk_adjustment_get_minimum_increment(Xen adjustment)
{
- #define H_gtk_tool_item_group_set_header_relief "void gtk_tool_item_group_set_header_relief(GtkToolItemGroup* group, \
-GtkReliefStyle style)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_set_header_relief", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_GtkReliefStyle_P(style), style, 2, "gtk_tool_item_group_set_header_relief", "GtkReliefStyle");
- gtk_tool_item_group_set_header_relief(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_GtkReliefStyle(style));
- return(XEN_FALSE);
+ #define H_gtk_adjustment_get_minimum_increment "gdouble gtk_adjustment_get_minimum_increment(GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 1, "gtk_adjustment_get_minimum_increment", "GtkAdjustment*");
+ return(C_to_Xen_gdouble(gtk_adjustment_get_minimum_increment(Xen_to_C_GtkAdjustment_(adjustment))));
}
-static XEN gxg_gtk_tool_item_group_get_label(XEN group)
+static Xen gxg_gtk_grid_insert_row(Xen grid, Xen position)
{
- #define H_gtk_tool_item_group_get_label "gchar* gtk_tool_item_group_get_label(GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_label", "GtkToolItemGroup*");
- return(C_TO_XEN_gchar_(gtk_tool_item_group_get_label(XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gtk_grid_insert_row "void gtk_grid_insert_row(GtkGrid* grid, gint position)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_insert_row", "GtkGrid*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_grid_insert_row", "gint");
+ gtk_grid_insert_row(Xen_to_C_GtkGrid_(grid), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_group_get_label_widget(XEN group)
+static Xen gxg_gtk_grid_insert_column(Xen grid, Xen position)
{
- #define H_gtk_tool_item_group_get_label_widget "GtkWidget* gtk_tool_item_group_get_label_widget(GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_label_widget", "GtkToolItemGroup*");
- return(C_TO_XEN_GtkWidget_(gtk_tool_item_group_get_label_widget(XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gtk_grid_insert_column "void gtk_grid_insert_column(GtkGrid* grid, gint position)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_insert_column", "GtkGrid*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_grid_insert_column", "gint");
+ gtk_grid_insert_column(Xen_to_C_GtkGrid_(grid), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_group_get_collapsed(XEN group)
+static Xen gxg_gtk_grid_insert_next_to(Xen grid, Xen sibling, Xen side)
{
- #define H_gtk_tool_item_group_get_collapsed "gboolean gtk_tool_item_group_get_collapsed(GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_collapsed", "GtkToolItemGroup*");
- return(C_TO_XEN_gboolean(gtk_tool_item_group_get_collapsed(XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gtk_grid_insert_next_to "void gtk_grid_insert_next_to(GtkGrid* grid, GtkWidget* sibling, \
+GtkPositionType side)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_insert_next_to", "GtkGrid*");
+ Xen_check_type(Xen_is_GtkWidget_(sibling), sibling, 2, "gtk_grid_insert_next_to", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkPositionType(side), side, 3, "gtk_grid_insert_next_to", "GtkPositionType");
+ gtk_grid_insert_next_to(Xen_to_C_GtkGrid_(grid), Xen_to_C_GtkWidget_(sibling), Xen_to_C_GtkPositionType(side));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_group_get_ellipsize(XEN group)
+static Xen gxg_gtk_text_iter_assign(Xen iter, Xen other)
{
- #define H_gtk_tool_item_group_get_ellipsize "PangoEllipsizeMode gtk_tool_item_group_get_ellipsize(GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_ellipsize", "GtkToolItemGroup*");
- return(C_TO_XEN_PangoEllipsizeMode(gtk_tool_item_group_get_ellipsize(XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gtk_text_iter_assign "void gtk_text_iter_assign(GtkTextIter* iter, GtkTextIter* other)"
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 1, "gtk_text_iter_assign", "GtkTextIter*");
+ Xen_check_type(Xen_is_GtkTextIter_(other), other, 2, "gtk_text_iter_assign", "GtkTextIter*");
+ gtk_text_iter_assign(Xen_to_C_GtkTextIter_(iter), Xen_to_C_GtkTextIter_(other));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_group_get_header_relief(XEN group)
+static Xen gxg_gtk_widget_has_visible_focus(Xen widget)
{
- #define H_gtk_tool_item_group_get_header_relief "GtkReliefStyle gtk_tool_item_group_get_header_relief(GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_header_relief", "GtkToolItemGroup*");
- return(C_TO_XEN_GtkReliefStyle(gtk_tool_item_group_get_header_relief(XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gtk_widget_has_visible_focus "gboolean gtk_widget_has_visible_focus(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_has_visible_focus", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_has_visible_focus(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_tool_item_group_insert(XEN group, XEN item, XEN position)
+static Xen gxg_gtk_window_set_focus_visible(Xen window, Xen setting)
{
- #define H_gtk_tool_item_group_insert "void gtk_tool_item_group_insert(GtkToolItemGroup* group, GtkToolItem* item, \
-gint position)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_insert", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(item), item, 2, "gtk_tool_item_group_insert", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_tool_item_group_insert", "gint");
- gtk_tool_item_group_insert(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_GtkToolItem_(item), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_window_set_focus_visible "void gtk_window_set_focus_visible(GtkWindow* window, gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_focus_visible", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_focus_visible", "gboolean");
+ gtk_window_set_focus_visible(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_tool_item_group_set_item_position(XEN group, XEN item, XEN position)
+static Xen gxg_gtk_window_get_focus_visible(Xen window)
{
- #define H_gtk_tool_item_group_set_item_position "void gtk_tool_item_group_set_item_position(GtkToolItemGroup* group, \
-GtkToolItem* item, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_set_item_position", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(item), item, 2, "gtk_tool_item_group_set_item_position", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 3, "gtk_tool_item_group_set_item_position", "gint");
- gtk_tool_item_group_set_item_position(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_GtkToolItem_(item), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_window_get_focus_visible "gboolean gtk_window_get_focus_visible(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_focus_visible", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_focus_visible(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tool_item_group_get_item_position(XEN group, XEN item)
+static Xen gxg_gtk_font_chooser_dialog_new(Xen title, Xen window)
{
- #define H_gtk_tool_item_group_get_item_position "gint gtk_tool_item_group_get_item_position(GtkToolItemGroup* group, \
-GtkToolItem* item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_item_position", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(item), item, 2, "gtk_tool_item_group_get_item_position", "GtkToolItem*");
- return(C_TO_XEN_gint(gtk_tool_item_group_get_item_position(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_GtkToolItem_(item))));
+ #define H_gtk_font_chooser_dialog_new "GtkWidget* gtk_font_chooser_dialog_new(gchar* title, GtkWindow* window)"
+ Xen_check_type(Xen_is_gchar_(title), title, 1, "gtk_font_chooser_dialog_new", "gchar*");
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 2, "gtk_font_chooser_dialog_new", "GtkWindow*");
+ return(C_to_Xen_GtkWidget_(gtk_font_chooser_dialog_new((const gchar*)Xen_to_C_gchar_(title), Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_tool_item_group_get_n_items(XEN group)
+static Xen gxg_gdk_event_get_button(Xen event, Xen button)
{
- #define H_gtk_tool_item_group_get_n_items "guint gtk_tool_item_group_get_n_items(GtkToolItemGroup* group)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_n_items", "GtkToolItemGroup*");
- return(C_TO_XEN_guint(gtk_tool_item_group_get_n_items(XEN_TO_C_GtkToolItemGroup_(group))));
+ #define H_gdk_event_get_button "gboolean gdk_event_get_button(GdkEvent* event, guint* button)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_button", "GdkEvent*");
+ Xen_check_type(Xen_is_guint_(button), button, 2, "gdk_event_get_button", "guint*");
+ return(C_to_Xen_gboolean(gdk_event_get_button(Xen_to_C_GdkEvent_(event), Xen_to_C_guint_(button))));
}
-static XEN gxg_gtk_tool_item_group_get_nth_item(XEN group, XEN index)
+static Xen gxg_gdk_event_get_click_count(Xen event, Xen click_count)
{
- #define H_gtk_tool_item_group_get_nth_item "GtkToolItem* gtk_tool_item_group_get_nth_item(GtkToolItemGroup* group, \
-guint index)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_nth_item", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_guint_P(index), index, 2, "gtk_tool_item_group_get_nth_item", "guint");
- return(C_TO_XEN_GtkToolItem_(gtk_tool_item_group_get_nth_item(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_guint(index))));
+ #define H_gdk_event_get_click_count "gboolean gdk_event_get_click_count(GdkEvent* event, guint* click_count)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_click_count", "GdkEvent*");
+ Xen_check_type(Xen_is_guint_(click_count), click_count, 2, "gdk_event_get_click_count", "guint*");
+ return(C_to_Xen_gboolean(gdk_event_get_click_count(Xen_to_C_GdkEvent_(event), Xen_to_C_guint_(click_count))));
}
-static XEN gxg_gtk_tool_item_group_get_drop_item(XEN group, XEN x, XEN y)
+static Xen gxg_gdk_event_get_keyval(Xen event, Xen keyval)
{
- #define H_gtk_tool_item_group_get_drop_item "GtkToolItem* gtk_tool_item_group_get_drop_item(GtkToolItemGroup* group, \
-gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GtkToolItemGroup__P(group), group, 1, "gtk_tool_item_group_get_drop_item", "GtkToolItemGroup*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_tool_item_group_get_drop_item", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_tool_item_group_get_drop_item", "gint");
- return(C_TO_XEN_GtkToolItem_(gtk_tool_item_group_get_drop_item(XEN_TO_C_GtkToolItemGroup_(group), XEN_TO_C_gint(x), XEN_TO_C_gint(y))));
+ #define H_gdk_event_get_keyval "gboolean gdk_event_get_keyval(GdkEvent* event, guint* keyval)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_keyval", "GdkEvent*");
+ Xen_check_type(Xen_is_guint_(keyval), keyval, 2, "gdk_event_get_keyval", "guint*");
+ return(C_to_Xen_gboolean(gdk_event_get_keyval(Xen_to_C_GdkEvent_(event), Xen_to_C_guint_(keyval))));
}
-static XEN gxg_gdk_screen_get_primary_monitor(XEN screen)
+static Xen gxg_gdk_event_get_keycode(Xen event, Xen keycode)
{
- #define H_gdk_screen_get_primary_monitor "gint gdk_screen_get_primary_monitor(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_primary_monitor", "GdkScreen*");
- return(C_TO_XEN_gint(gdk_screen_get_primary_monitor(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gdk_event_get_keycode "gboolean gdk_event_get_keycode(GdkEvent* event, guint16* keycode)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_keycode", "GdkEvent*");
+ Xen_check_type(Xen_is_guint16_(keycode), keycode, 2, "gdk_event_get_keycode", "guint16*");
+ return(C_to_Xen_gboolean(gdk_event_get_keycode(Xen_to_C_GdkEvent_(event), Xen_to_C_guint16_(keycode))));
}
-static XEN gxg_gtk_window_set_mnemonics_visible(XEN window, XEN setting)
+static Xen gxg_gdk_event_get_scroll_direction(Xen event, Xen ignore_direction)
{
- #define H_gtk_window_set_mnemonics_visible "void gtk_window_set_mnemonics_visible(GtkWindow* window, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_mnemonics_visible", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_mnemonics_visible", "gboolean");
- gtk_window_set_mnemonics_visible(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gdk_event_get_scroll_direction "gboolean gdk_event_get_scroll_direction(GdkEvent* event, \
+GdkScrollDirection* [direction])"
+ GdkScrollDirection ref_direction;
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_scroll_direction", "GdkEvent*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_event_get_scroll_direction(Xen_to_C_GdkEvent_(event), &ref_direction));
+ return(Xen_list_2(result, C_to_Xen_GdkScrollDirection(ref_direction)));
+ }
}
-static XEN gxg_gtk_window_get_mnemonics_visible(XEN window)
+static Xen gxg_gtk_grid_get_child_at(Xen grid, Xen left, Xen top)
{
- #define H_gtk_window_get_mnemonics_visible "gboolean gtk_window_get_mnemonics_visible(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_mnemonics_visible", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_mnemonics_visible(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_grid_get_child_at "GtkWidget* gtk_grid_get_child_at(GtkGrid* grid, gint left, gint top)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_get_child_at", "GtkGrid*");
+ Xen_check_type(Xen_is_gint(left), left, 2, "gtk_grid_get_child_at", "gint");
+ Xen_check_type(Xen_is_gint(top), top, 3, "gtk_grid_get_child_at", "gint");
+ return(C_to_Xen_GtkWidget_(gtk_grid_get_child_at(Xen_to_C_GtkGrid_(grid), Xen_to_C_gint(left), Xen_to_C_gint(top))));
}
-static XEN gxg_gtk_range_set_slider_size_fixed(XEN range, XEN size_fixed)
+static Xen gxg_gtk_font_chooser_get_font_family(Xen fontchooser)
{
- #define H_gtk_range_set_slider_size_fixed "void gtk_range_set_slider_size_fixed(GtkRange* range, gboolean size_fixed)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_slider_size_fixed", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(size_fixed), size_fixed, 2, "gtk_range_set_slider_size_fixed", "gboolean");
- gtk_range_set_slider_size_fixed(XEN_TO_C_GtkRange_(range), XEN_TO_C_gboolean(size_fixed));
- return(XEN_FALSE);
+ #define H_gtk_font_chooser_get_font_family "PangoFontFamily* gtk_font_chooser_get_font_family(GtkFontChooser* fontchooser)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_get_font_family", "GtkFontChooser*");
+ return(C_to_Xen_PangoFontFamily_(gtk_font_chooser_get_font_family(Xen_to_C_GtkFontChooser_(fontchooser))));
}
-static XEN gxg_gtk_range_get_slider_size_fixed(XEN range)
+static Xen gxg_gtk_font_chooser_get_font_face(Xen fontchooser)
{
- #define H_gtk_range_get_slider_size_fixed "gboolean gtk_range_get_slider_size_fixed(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_slider_size_fixed", "GtkRange*");
- return(C_TO_XEN_gboolean(gtk_range_get_slider_size_fixed(XEN_TO_C_GtkRange_(range))));
+ #define H_gtk_font_chooser_get_font_face "PangoFontFace* gtk_font_chooser_get_font_face(GtkFontChooser* fontchooser)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_get_font_face", "GtkFontChooser*");
+ return(C_to_Xen_PangoFontFace_(gtk_font_chooser_get_font_face(Xen_to_C_GtkFontChooser_(fontchooser))));
}
-static XEN gxg_gtk_range_set_min_slider_size(XEN range, XEN min_size)
+static Xen gxg_gtk_font_chooser_get_font_size(Xen fontchooser)
{
- #define H_gtk_range_set_min_slider_size "void gtk_range_set_min_slider_size(GtkRange* range, gboolean min_size)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_min_slider_size", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(min_size), min_size, 2, "gtk_range_set_min_slider_size", "gboolean");
- gtk_range_set_min_slider_size(XEN_TO_C_GtkRange_(range), XEN_TO_C_gboolean(min_size));
- return(XEN_FALSE);
+ #define H_gtk_font_chooser_get_font_size "gint gtk_font_chooser_get_font_size(GtkFontChooser* fontchooser)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_get_font_size", "GtkFontChooser*");
+ return(C_to_Xen_gint(gtk_font_chooser_get_font_size(Xen_to_C_GtkFontChooser_(fontchooser))));
}
-static XEN gxg_gtk_range_get_min_slider_size(XEN range)
+static Xen gxg_gtk_font_chooser_get_font_desc(Xen fontchooser)
{
- #define H_gtk_range_get_min_slider_size "gint gtk_range_get_min_slider_size(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_min_slider_size", "GtkRange*");
- return(C_TO_XEN_gint(gtk_range_get_min_slider_size(XEN_TO_C_GtkRange_(range))));
+ #define H_gtk_font_chooser_get_font_desc "PangoFontDescription* gtk_font_chooser_get_font_desc(GtkFontChooser* fontchooser)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_get_font_desc", "GtkFontChooser*");
+ return(C_to_Xen_PangoFontDescription_(gtk_font_chooser_get_font_desc(Xen_to_C_GtkFontChooser_(fontchooser))));
}
-static XEN gxg_gtk_range_get_range_rect(XEN range, XEN range_rect)
+static Xen gxg_gtk_font_chooser_set_font_desc(Xen fontchooser, Xen font_desc)
{
- #define H_gtk_range_get_range_rect "void gtk_range_get_range_rect(GtkRange* range, GdkRectangle* range_rect)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_range_rect", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(range_rect), range_rect, 2, "gtk_range_get_range_rect", "GdkRectangle*");
- gtk_range_get_range_rect(XEN_TO_C_GtkRange_(range), XEN_TO_C_GdkRectangle_(range_rect));
- return(XEN_FALSE);
+ #define H_gtk_font_chooser_set_font_desc "void gtk_font_chooser_set_font_desc(GtkFontChooser* fontchooser, \
+PangoFontDescription* font_desc)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_set_font_desc", "GtkFontChooser*");
+ Xen_check_type(Xen_is_PangoFontDescription_(font_desc), font_desc, 2, "gtk_font_chooser_set_font_desc", "PangoFontDescription*");
+ gtk_font_chooser_set_font_desc(Xen_to_C_GtkFontChooser_(fontchooser), Xen_to_C_PangoFontDescription_(font_desc));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_get_slider_range(XEN range, XEN ignore_slider_start, XEN ignore_slider_end)
+static Xen gxg_gtk_font_chooser_get_font(Xen fontchooser)
{
- #define H_gtk_range_get_slider_range "void gtk_range_get_slider_range(GtkRange* range, gint* [slider_start], \
-gint* [slider_end])"
- gint ref_slider_start;
- gint ref_slider_end;
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_slider_range", "GtkRange*");
- gtk_range_get_slider_range(XEN_TO_C_GtkRange_(range), &ref_slider_start, &ref_slider_end);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_slider_start), C_TO_XEN_gint(ref_slider_end)));
+ #define H_gtk_font_chooser_get_font "gchar* gtk_font_chooser_get_font(GtkFontChooser* fontchooser)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_get_font", "GtkFontChooser*");
+ return(C_to_Xen_gchar_(gtk_font_chooser_get_font(Xen_to_C_GtkFontChooser_(fontchooser))));
}
-static XEN gxg_gtk_status_icon_set_name(XEN status_icon, XEN name)
+static Xen gxg_gtk_font_chooser_set_font(Xen fontchooser, Xen fontname)
{
- #define H_gtk_status_icon_set_name "void gtk_status_icon_set_name(GtkStatusIcon* status_icon, gchar* name)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_name", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gchar__P(name), name, 2, "gtk_status_icon_set_name", "gchar*");
- gtk_status_icon_set_name(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_gchar_(name));
- return(XEN_FALSE);
+ #define H_gtk_font_chooser_set_font "void gtk_font_chooser_set_font(GtkFontChooser* fontchooser, gchar* fontname)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_set_font", "GtkFontChooser*");
+ Xen_check_type(Xen_is_gchar_(fontname), fontname, 2, "gtk_font_chooser_set_font", "gchar*");
+ gtk_font_chooser_set_font(Xen_to_C_GtkFontChooser_(fontchooser), (const gchar*)Xen_to_C_gchar_(fontname));
+ return(Xen_false);
}
-static XEN gxg_gtk_paned_get_handle_window(XEN paned)
+static Xen gxg_gtk_font_chooser_get_preview_text(Xen fontchooser)
{
- #define H_gtk_paned_get_handle_window "GdkWindow* gtk_paned_get_handle_window(GtkPaned* paned)"
- XEN_ASSERT_TYPE(XEN_GtkPaned__P(paned), paned, 1, "gtk_paned_get_handle_window", "GtkPaned*");
- return(C_TO_XEN_GdkWindow_(gtk_paned_get_handle_window(XEN_TO_C_GtkPaned_(paned))));
+ #define H_gtk_font_chooser_get_preview_text "gchar* gtk_font_chooser_get_preview_text(GtkFontChooser* fontchooser)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_get_preview_text", "GtkFontChooser*");
+ return(C_to_Xen_gchar_(gtk_font_chooser_get_preview_text(Xen_to_C_GtkFontChooser_(fontchooser))));
}
-static XEN gxg_gtk_widget_set_realized(XEN widget, XEN realized)
+static Xen gxg_gtk_font_chooser_set_preview_text(Xen fontchooser, Xen text)
{
- #define H_gtk_widget_set_realized "void gtk_widget_set_realized(GtkWidget* widget, gboolean realized)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_realized", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(realized), realized, 2, "gtk_widget_set_realized", "gboolean");
- gtk_widget_set_realized(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(realized));
- return(XEN_FALSE);
+ #define H_gtk_font_chooser_set_preview_text "void gtk_font_chooser_set_preview_text(GtkFontChooser* fontchooser, \
+gchar* text)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_set_preview_text", "GtkFontChooser*");
+ Xen_check_type(Xen_is_gchar_(text), text, 2, "gtk_font_chooser_set_preview_text", "gchar*");
+ gtk_font_chooser_set_preview_text(Xen_to_C_GtkFontChooser_(fontchooser), (const gchar*)Xen_to_C_gchar_(text));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_realized(XEN widget)
+static Xen gxg_gtk_font_chooser_get_show_preview_entry(Xen fontchooser)
{
- #define H_gtk_widget_get_realized "gboolean gtk_widget_get_realized(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_realized", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_realized(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_font_chooser_get_show_preview_entry "gboolean gtk_font_chooser_get_show_preview_entry(GtkFontChooser* fontchooser)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_get_show_preview_entry", "GtkFontChooser*");
+ return(C_to_Xen_gboolean(gtk_font_chooser_get_show_preview_entry(Xen_to_C_GtkFontChooser_(fontchooser))));
}
-static XEN gxg_gtk_widget_set_mapped(XEN widget, XEN mapped)
+static Xen gxg_gtk_font_chooser_set_show_preview_entry(Xen fontchooser, Xen show_preview_entry)
{
- #define H_gtk_widget_set_mapped "void gtk_widget_set_mapped(GtkWidget* widget, gboolean mapped)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_mapped", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(mapped), mapped, 2, "gtk_widget_set_mapped", "gboolean");
- gtk_widget_set_mapped(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(mapped));
- return(XEN_FALSE);
+ #define H_gtk_font_chooser_set_show_preview_entry "void gtk_font_chooser_set_show_preview_entry(GtkFontChooser* fontchooser, \
+gboolean show_preview_entry)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_set_show_preview_entry", "GtkFontChooser*");
+ Xen_check_type(Xen_is_gboolean(show_preview_entry), show_preview_entry, 2, "gtk_font_chooser_set_show_preview_entry", "gboolean");
+ gtk_font_chooser_set_show_preview_entry(Xen_to_C_GtkFontChooser_(fontchooser), Xen_to_C_gboolean(show_preview_entry));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_mapped(XEN widget)
+static Xen gxg_gtk_font_chooser_widget_new(void)
{
- #define H_gtk_widget_get_mapped "gboolean gtk_widget_get_mapped(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_mapped", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_mapped(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_font_chooser_widget_new "GtkWidget* gtk_font_chooser_widget_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_font_chooser_widget_new()));
}
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-static XEN gxg_gdk_cairo_create(XEN window)
+#if GTK_CHECK_VERSION(3, 4, 0)
+static Xen gxg_gdk_keymap_get_modifier_mask(Xen keymap, Xen intent)
{
- #define H_gdk_cairo_create "cairo_t* gdk_cairo_create(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_cairo_create", "GdkWindow*");
- return(C_TO_XEN_cairo_t_(gdk_cairo_create(XEN_TO_C_GdkWindow_(window))));
+ #define H_gdk_keymap_get_modifier_mask "GdkModifierType gdk_keymap_get_modifier_mask(GdkKeymap* keymap, \
+GdkModifierIntent intent)"
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_get_modifier_mask", "GdkKeymap*");
+ Xen_check_type(Xen_is_GdkModifierIntent(intent), intent, 2, "gdk_keymap_get_modifier_mask", "GdkModifierIntent");
+ return(C_to_Xen_GdkModifierType(gdk_keymap_get_modifier_mask(Xen_to_C_GdkKeymap_(keymap), Xen_to_C_GdkModifierIntent(intent))));
}
-static XEN gxg_gdk_window_get_geometry(XEN window, XEN ignore_x, XEN ignore_y, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gdk_window_begin_resize_drag_for_device(Xen window, Xen edge, Xen device, Xen button, Xen root_x, Xen root_y, Xen timestamp)
{
- #define H_gdk_window_get_geometry "void gdk_window_get_geometry(GdkWindow* window, gint* [x], gint* [y], \
-gint* [width], gint* [height])"
- gint ref_x;
- gint ref_y;
- gint ref_width;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_geometry", "GdkWindow*");
- gdk_window_get_geometry(XEN_TO_C_GdkWindow_(window), &ref_x, &ref_y, &ref_width, &ref_height);
- return(XEN_LIST_4(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ #define H_gdk_window_begin_resize_drag_for_device "void gdk_window_begin_resize_drag_for_device(GdkWindow* window, \
+GdkWindowEdge edge, GdkDevice* device, gint button, gint root_x, gint root_y, guint32 timestamp)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_begin_resize_drag_for_device", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkWindowEdge(edge), edge, 2, "gdk_window_begin_resize_drag_for_device", "GdkWindowEdge");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 3, "gdk_window_begin_resize_drag_for_device", "GdkDevice*");
+ Xen_check_type(Xen_is_gint(button), button, 4, "gdk_window_begin_resize_drag_for_device", "gint");
+ Xen_check_type(Xen_is_gint(root_x), root_x, 5, "gdk_window_begin_resize_drag_for_device", "gint");
+ Xen_check_type(Xen_is_gint(root_y), root_y, 6, "gdk_window_begin_resize_drag_for_device", "gint");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 7, "gdk_window_begin_resize_drag_for_device", "guint32");
+ gdk_window_begin_resize_drag_for_device(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkWindowEdge(edge), Xen_to_C_GdkDevice_(device),
+ Xen_to_C_gint(button), Xen_to_C_gint(root_x), Xen_to_C_gint(root_y), Xen_to_C_guint32(timestamp));
+ return(Xen_false);
}
-static XEN gxg_gdk_keymap_add_virtual_modifiers(XEN keymap, XEN state)
+static Xen gxg_gdk_window_begin_move_drag_for_device(Xen window, Xen device, Xen button, Xen root_x, Xen root_y, Xen timestamp)
{
- #define H_gdk_keymap_add_virtual_modifiers "void gdk_keymap_add_virtual_modifiers(GdkKeymap* keymap, \
-GdkModifierType* state)"
- XEN_ASSERT_TYPE(XEN_GdkKeymap__P(keymap), keymap, 1, "gdk_keymap_add_virtual_modifiers", "GdkKeymap*");
- XEN_ASSERT_TYPE(XEN_GdkModifierType__P(state), state, 2, "gdk_keymap_add_virtual_modifiers", "GdkModifierType*");
- gdk_keymap_add_virtual_modifiers(XEN_TO_C_GdkKeymap_(keymap), XEN_TO_C_GdkModifierType_(state));
- return(XEN_FALSE);
+ #define H_gdk_window_begin_move_drag_for_device "void gdk_window_begin_move_drag_for_device(GdkWindow* window, \
+GdkDevice* device, gint button, gint root_x, gint root_y, guint32 timestamp)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_begin_move_drag_for_device", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_window_begin_move_drag_for_device", "GdkDevice*");
+ Xen_check_type(Xen_is_gint(button), button, 3, "gdk_window_begin_move_drag_for_device", "gint");
+ Xen_check_type(Xen_is_gint(root_x), root_x, 4, "gdk_window_begin_move_drag_for_device", "gint");
+ Xen_check_type(Xen_is_gint(root_y), root_y, 5, "gdk_window_begin_move_drag_for_device", "gint");
+ Xen_check_type(Xen_is_guint32(timestamp), timestamp, 6, "gdk_window_begin_move_drag_for_device", "guint32");
+ gdk_window_begin_move_drag_for_device(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkDevice_(device), Xen_to_C_gint(button),
+ Xen_to_C_gint(root_x), Xen_to_C_gint(root_y), Xen_to_C_guint32(timestamp));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_coords_to_parent(XEN window, XEN x, XEN y, XEN ignore_parent_x, XEN ignore_parent_y)
+static Xen gxg_gtk_accelerator_parse_with_keycode(Xen accelerator, Xen accelerator_key, Xen accelerator_codes, Xen accelerator_mods)
{
- #define H_gdk_window_coords_to_parent "void gdk_window_coords_to_parent(GdkWindow* window, gdouble x, \
-gdouble y, gdouble* [parent_x], gdouble* [parent_y])"
- gdouble ref_parent_x;
- gdouble ref_parent_y;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_coords_to_parent", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(x), x, 2, "gdk_window_coords_to_parent", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(y), y, 3, "gdk_window_coords_to_parent", "gdouble");
- gdk_window_coords_to_parent(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gdouble(x), XEN_TO_C_gdouble(y), &ref_parent_x, &ref_parent_y);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_parent_x), C_TO_XEN_gdouble(ref_parent_y)));
+ #define H_gtk_accelerator_parse_with_keycode "void gtk_accelerator_parse_with_keycode(gchar* accelerator, \
+guint* accelerator_key, guint** accelerator_codes, GdkModifierType* accelerator_mods)"
+ Xen_check_type(Xen_is_gchar_(accelerator), accelerator, 1, "gtk_accelerator_parse_with_keycode", "gchar*");
+ Xen_check_type(Xen_is_guint_(accelerator_key), accelerator_key, 2, "gtk_accelerator_parse_with_keycode", "guint*");
+ Xen_check_type(Xen_is_guint__(accelerator_codes), accelerator_codes, 3, "gtk_accelerator_parse_with_keycode", "guint**");
+ Xen_check_type(Xen_is_GdkModifierType_(accelerator_mods), accelerator_mods, 4, "gtk_accelerator_parse_with_keycode", "GdkModifierType*");
+ gtk_accelerator_parse_with_keycode((const gchar*)Xen_to_C_gchar_(accelerator), Xen_to_C_guint_(accelerator_key), Xen_to_C_guint__(accelerator_codes),
+ Xen_to_C_GdkModifierType_(accelerator_mods));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_coords_from_parent(XEN window, XEN parent_x, XEN parent_y, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gtk_accelerator_name_with_keycode(Xen display, Xen accelerator_key, Xen keycode, Xen accelerator_mods)
{
- #define H_gdk_window_coords_from_parent "void gdk_window_coords_from_parent(GdkWindow* window, gdouble parent_x, \
-gdouble parent_y, gdouble* [x], gdouble* [y])"
- gdouble ref_x;
- gdouble ref_y;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_coords_from_parent", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gdouble_P(parent_x), parent_x, 2, "gdk_window_coords_from_parent", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(parent_y), parent_y, 3, "gdk_window_coords_from_parent", "gdouble");
- gdk_window_coords_from_parent(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gdouble(parent_x), XEN_TO_C_gdouble(parent_y), &ref_x,
- &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_x), C_TO_XEN_gdouble(ref_y)));
+ #define H_gtk_accelerator_name_with_keycode "gchar* gtk_accelerator_name_with_keycode(GdkDisplay* display, \
+guint accelerator_key, guint keycode, GdkModifierType accelerator_mods)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gtk_accelerator_name_with_keycode", "GdkDisplay*");
+ Xen_check_type(Xen_is_guint(accelerator_key), accelerator_key, 2, "gtk_accelerator_name_with_keycode", "guint");
+ Xen_check_type(Xen_is_guint(keycode), keycode, 3, "gtk_accelerator_name_with_keycode", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accelerator_mods), accelerator_mods, 4, "gtk_accelerator_name_with_keycode", "GdkModifierType");
+ return(C_to_Xen_gchar_(gtk_accelerator_name_with_keycode(Xen_to_C_GdkDisplay_(display), Xen_to_C_guint(accelerator_key),
+ Xen_to_C_guint(keycode), Xen_to_C_GdkModifierType(accelerator_mods))));
+}
+
+static Xen gxg_gtk_accelerator_get_label_with_keycode(Xen display, Xen accelerator_key, Xen keycode, Xen accelerator_mods)
+{
+ #define H_gtk_accelerator_get_label_with_keycode "gchar* gtk_accelerator_get_label_with_keycode(GdkDisplay* display, \
+guint accelerator_key, guint keycode, GdkModifierType accelerator_mods)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gtk_accelerator_get_label_with_keycode", "GdkDisplay*");
+ Xen_check_type(Xen_is_guint(accelerator_key), accelerator_key, 2, "gtk_accelerator_get_label_with_keycode", "guint");
+ Xen_check_type(Xen_is_guint(keycode), keycode, 3, "gtk_accelerator_get_label_with_keycode", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accelerator_mods), accelerator_mods, 4, "gtk_accelerator_get_label_with_keycode", "GdkModifierType");
+ return(C_to_Xen_gchar_(gtk_accelerator_get_label_with_keycode(Xen_to_C_GdkDisplay_(display), Xen_to_C_guint(accelerator_key),
+ Xen_to_C_guint(keycode), Xen_to_C_GdkModifierType(accelerator_mods))));
}
-static XEN gxg_gdk_window_get_effective_parent(XEN window)
+static Xen gxg_gdk_screen_get_monitor_workarea(Xen screen, Xen monitor_num, Xen dest)
{
- #define H_gdk_window_get_effective_parent "GdkWindow* gdk_window_get_effective_parent(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_effective_parent", "GdkWindow*");
- return(C_TO_XEN_GdkWindow_(gdk_window_get_effective_parent(XEN_TO_C_GdkWindow_(window))));
+ #define H_gdk_screen_get_monitor_workarea "void gdk_screen_get_monitor_workarea(GdkScreen* screen, \
+gint monitor_num, GdkRectangle* dest)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_monitor_workarea", "GdkScreen*");
+ Xen_check_type(Xen_is_gint(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_workarea", "gint");
+ Xen_check_type(Xen_is_GdkRectangle_(dest), dest, 3, "gdk_screen_get_monitor_workarea", "GdkRectangle*");
+ gdk_screen_get_monitor_workarea(Xen_to_C_GdkScreen_(screen), Xen_to_C_gint(monitor_num), Xen_to_C_GdkRectangle_(dest));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_effective_toplevel(XEN window)
+static Xen gxg_gtk_application_get_app_menu(Xen application)
{
- #define H_gdk_window_get_effective_toplevel "GdkWindow* gdk_window_get_effective_toplevel(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_effective_toplevel", "GdkWindow*");
- return(C_TO_XEN_GdkWindow_(gdk_window_get_effective_toplevel(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_application_get_app_menu "GMenuModel* gtk_application_get_app_menu(GtkApplication* application)"
+ Xen_check_type(Xen_is_GtkApplication_(application), application, 1, "gtk_application_get_app_menu", "GtkApplication*");
+ return(C_to_Xen_GMenuModel_(gtk_application_get_app_menu(Xen_to_C_GtkApplication_(application))));
}
-static XEN gxg_gtk_accessible_get_widget(XEN accessible)
+static Xen gxg_gtk_application_set_app_menu(Xen application, Xen model)
{
- #define H_gtk_accessible_get_widget "GtkWidget* gtk_accessible_get_widget(GtkAccessible* accessible)"
- XEN_ASSERT_TYPE(XEN_GtkAccessible__P(accessible), accessible, 1, "gtk_accessible_get_widget", "GtkAccessible*");
- return(C_TO_XEN_GtkWidget_(gtk_accessible_get_widget(XEN_TO_C_GtkAccessible_(accessible))));
+ #define H_gtk_application_set_app_menu "void gtk_application_set_app_menu(GtkApplication* application, \
+GMenuModel* model)"
+ Xen_check_type(Xen_is_GtkApplication_(application), application, 1, "gtk_application_set_app_menu", "GtkApplication*");
+ Xen_check_type(Xen_is_GMenuModel_(model), model, 2, "gtk_application_set_app_menu", "GMenuModel*");
+ gtk_application_set_app_menu(Xen_to_C_GtkApplication_(application), Xen_to_C_GMenuModel_(model));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_send_focus_change(XEN widget, XEN event)
+static Xen gxg_gtk_application_get_menubar(Xen application)
{
- #define H_gtk_widget_send_focus_change "gboolean gtk_widget_send_focus_change(GtkWidget* widget, GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_send_focus_change", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 2, "gtk_widget_send_focus_change", "GdkEvent*");
- return(C_TO_XEN_gboolean(gtk_widget_send_focus_change(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkEvent_(event))));
+ #define H_gtk_application_get_menubar "GMenuModel* gtk_application_get_menubar(GtkApplication* application)"
+ Xen_check_type(Xen_is_GtkApplication_(application), application, 1, "gtk_application_get_menubar", "GtkApplication*");
+ return(C_to_Xen_GMenuModel_(gtk_application_get_menubar(Xen_to_C_GtkApplication_(application))));
}
-static XEN gxg_gdk_display_get_device_manager(XEN display)
+static Xen gxg_gtk_application_set_menubar(Xen application, Xen model)
{
- #define H_gdk_display_get_device_manager "GdkDeviceManager* gdk_display_get_device_manager(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_get_device_manager", "GdkDisplay*");
- return(C_TO_XEN_GdkDeviceManager_(gdk_display_get_device_manager(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_application_set_menubar "void gtk_application_set_menubar(GtkApplication* application, \
+GMenuModel* model)"
+ Xen_check_type(Xen_is_GtkApplication_(application), application, 1, "gtk_application_set_menubar", "GtkApplication*");
+ Xen_check_type(Xen_is_GMenuModel_(model), model, 2, "gtk_application_set_menubar", "GMenuModel*");
+ gtk_application_set_menubar(Xen_to_C_GtkApplication_(application), Xen_to_C_GMenuModel_(model));
+ return(Xen_false);
}
-static XEN gxg_gdk_drag_context_set_device(XEN context, XEN device)
+static Xen gxg_gtk_entry_completion_compute_prefix(Xen completion, Xen key)
{
- #define H_gdk_drag_context_set_device "void gdk_drag_context_set_device(GdkDragContext* context, GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_context_set_device", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_drag_context_set_device", "GdkDevice*");
- gdk_drag_context_set_device(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GdkDevice_(device));
- return(XEN_FALSE);
+ #define H_gtk_entry_completion_compute_prefix "gchar* gtk_entry_completion_compute_prefix(GtkEntryCompletion* completion, \
+char* key)"
+ Xen_check_type(Xen_is_GtkEntryCompletion_(completion), completion, 1, "gtk_entry_completion_compute_prefix", "GtkEntryCompletion*");
+ Xen_check_type(Xen_is_char_(key), key, 2, "gtk_entry_completion_compute_prefix", "char*");
+ return(C_to_Xen_gchar_(gtk_entry_completion_compute_prefix(Xen_to_C_GtkEntryCompletion_(completion), (const char*)Xen_to_C_char_(key))));
}
-static XEN gxg_gdk_drag_context_get_device(XEN context)
+static Xen gxg_gtk_scale_set_has_origin(Xen scale, Xen has_origin)
{
- #define H_gdk_drag_context_get_device "GdkDevice* gdk_drag_context_get_device(GdkDragContext* context)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_context_get_device", "GdkDragContext*");
- return(C_TO_XEN_GdkDevice_(gdk_drag_context_get_device(XEN_TO_C_GdkDragContext_(context))));
+ #define H_gtk_scale_set_has_origin "void gtk_scale_set_has_origin(GtkScale* scale, gboolean has_origin)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_set_has_origin", "GtkScale*");
+ Xen_check_type(Xen_is_gboolean(has_origin), has_origin, 2, "gtk_scale_set_has_origin", "gboolean");
+ gtk_scale_set_has_origin(Xen_to_C_GtkScale_(scale), Xen_to_C_gboolean(has_origin));
+ return(Xen_false);
}
-static XEN gxg_gdk_drag_context_list_targets(XEN context)
+static Xen gxg_gtk_scale_get_has_origin(Xen scale)
{
- #define H_gdk_drag_context_list_targets "GList* gdk_drag_context_list_targets(GdkDragContext* context)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_context_list_targets", "GdkDragContext*");
- return(C_TO_XEN_GList_(gdk_drag_context_list_targets(XEN_TO_C_GdkDragContext_(context))));
+ #define H_gtk_scale_get_has_origin "gboolean gtk_scale_get_has_origin(GtkScale* scale)"
+ Xen_check_type(Xen_is_GtkScale_(scale), scale, 1, "gtk_scale_get_has_origin", "GtkScale*");
+ return(C_to_Xen_gboolean(gtk_scale_get_has_origin(Xen_to_C_GtkScale_(scale))));
}
-static XEN gxg_gdk_event_set_device(XEN event, XEN device)
+static Xen gxg_gtk_window_set_hide_titlebar_when_maximized(Xen window, Xen setting)
{
- #define H_gdk_event_set_device "void gdk_event_set_device(GdkEvent* event, GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_set_device", "GdkEvent*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_event_set_device", "GdkDevice*");
- gdk_event_set_device(XEN_TO_C_GdkEvent_(event), XEN_TO_C_GdkDevice_(device));
- return(XEN_FALSE);
+ #define H_gtk_window_set_hide_titlebar_when_maximized "void gtk_window_set_hide_titlebar_when_maximized(GtkWindow* window, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_hide_titlebar_when_maximized", "GtkWindow*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_window_set_hide_titlebar_when_maximized", "gboolean");
+ gtk_window_set_hide_titlebar_when_maximized(Xen_to_C_GtkWindow_(window), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gdk_event_get_device(XEN event)
+static Xen gxg_gtk_window_get_hide_titlebar_when_maximized(Xen window)
{
- #define H_gdk_event_get_device "GdkDevice* gdk_event_get_device(GdkEvent* event)"
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event), event, 1, "gdk_event_get_device", "GdkEvent*");
- return(C_TO_XEN_GdkDevice_(gdk_event_get_device(XEN_TO_C_GdkEvent_(event))));
+ #define H_gtk_window_get_hide_titlebar_when_maximized "gboolean gtk_window_get_hide_titlebar_when_maximized(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_hide_titlebar_when_maximized", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_get_hide_titlebar_when_maximized(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gdk_events_get_distance(XEN event1, XEN event2, XEN ignore_distance)
+static Xen gxg_gtk_application_window_new(Xen application)
{
- #define H_gdk_events_get_distance "gboolean gdk_events_get_distance(GdkEvent* event1, GdkEvent* event2, \
-gdouble* [distance])"
- gdouble ref_distance;
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event1), event1, 1, "gdk_events_get_distance", "GdkEvent*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event2), event2, 2, "gdk_events_get_distance", "GdkEvent*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_events_get_distance(XEN_TO_C_GdkEvent_(event1), XEN_TO_C_GdkEvent_(event2), &ref_distance));
- return(XEN_LIST_2(result, C_TO_XEN_gdouble(ref_distance)));
- }
+ #define H_gtk_application_window_new "GtkWidget* gtk_application_window_new(GtkApplication* application)"
+ Xen_check_type(Xen_is_GtkApplication_(application), application, 1, "gtk_application_window_new", "GtkApplication*");
+ return(C_to_Xen_GtkWidget_(gtk_application_window_new(Xen_to_C_GtkApplication_(application))));
}
-static XEN gxg_gdk_events_get_angle(XEN event1, XEN event2, XEN ignore_angle)
+static Xen gxg_gtk_application_window_set_show_menubar(Xen window, Xen show_menubar)
{
- #define H_gdk_events_get_angle "gboolean gdk_events_get_angle(GdkEvent* event1, GdkEvent* event2, gdouble* [angle])"
- gdouble ref_angle;
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event1), event1, 1, "gdk_events_get_angle", "GdkEvent*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event2), event2, 2, "gdk_events_get_angle", "GdkEvent*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_events_get_angle(XEN_TO_C_GdkEvent_(event1), XEN_TO_C_GdkEvent_(event2), &ref_angle));
- return(XEN_LIST_2(result, C_TO_XEN_gdouble(ref_angle)));
- }
+ #define H_gtk_application_window_set_show_menubar "void gtk_application_window_set_show_menubar(GtkApplicationWindow* window, \
+gboolean show_menubar)"
+ Xen_check_type(Xen_is_GtkApplicationWindow_(window), window, 1, "gtk_application_window_set_show_menubar", "GtkApplicationWindow*");
+ Xen_check_type(Xen_is_gboolean(show_menubar), show_menubar, 2, "gtk_application_window_set_show_menubar", "gboolean");
+ gtk_application_window_set_show_menubar(Xen_to_C_GtkApplicationWindow_(window), Xen_to_C_gboolean(show_menubar));
+ return(Xen_false);
}
-static XEN gxg_gdk_events_get_center(XEN event1, XEN event2, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gtk_application_window_get_show_menubar(Xen window)
{
- #define H_gdk_events_get_center "gboolean gdk_events_get_center(GdkEvent* event1, GdkEvent* event2, \
-gdouble* [x], gdouble* [y])"
- gdouble ref_x;
- gdouble ref_y;
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event1), event1, 1, "gdk_events_get_center", "GdkEvent*");
- XEN_ASSERT_TYPE(XEN_GdkEvent__P(event2), event2, 2, "gdk_events_get_center", "GdkEvent*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gdk_events_get_center(XEN_TO_C_GdkEvent_(event1), XEN_TO_C_GdkEvent_(event2), &ref_x, &ref_y));
- return(XEN_LIST_3(result, C_TO_XEN_gdouble(ref_x), C_TO_XEN_gdouble(ref_y)));
- }
+ #define H_gtk_application_window_get_show_menubar "gboolean gtk_application_window_get_show_menubar(GtkApplicationWindow* window)"
+ Xen_check_type(Xen_is_GtkApplicationWindow_(window), window, 1, "gtk_application_window_get_show_menubar", "GtkApplicationWindow*");
+ return(C_to_Xen_gboolean(gtk_application_window_get_show_menubar(Xen_to_C_GtkApplicationWindow_(window))));
}
-static XEN gxg_gdk_window_get_accept_focus(XEN window)
+static Xen gxg_gtk_image_new_from_resource(Xen resource_path)
{
- #define H_gdk_window_get_accept_focus "gboolean gdk_window_get_accept_focus(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_accept_focus", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_get_accept_focus(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_image_new_from_resource "GtkWidget* gtk_image_new_from_resource(gchar* resource_path)"
+ Xen_check_type(Xen_is_gchar_(resource_path), resource_path, 1, "gtk_image_new_from_resource", "gchar*");
+ return(C_to_Xen_GtkWidget_(gtk_image_new_from_resource((const gchar*)Xen_to_C_gchar_(resource_path))));
}
-static XEN gxg_gdk_window_get_focus_on_map(XEN window)
+static Xen gxg_gtk_image_set_from_resource(Xen image, Xen resource_path)
{
- #define H_gdk_window_get_focus_on_map "gboolean gdk_window_get_focus_on_map(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_focus_on_map", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_get_focus_on_map(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_image_set_from_resource "void gtk_image_set_from_resource(GtkImage* image, gchar* resource_path)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_set_from_resource", "GtkImage*");
+ Xen_check_type(Xen_is_gchar_(resource_path), resource_path, 2, "gtk_image_set_from_resource", "gchar*");
+ gtk_image_set_from_resource(Xen_to_C_GtkImage_(image), (const gchar*)Xen_to_C_gchar_(resource_path));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_composited(XEN window)
+static Xen gxg_gtk_window_set_attached_to(Xen window, Xen attach_widget)
{
- #define H_gdk_window_get_composited "gboolean gdk_window_get_composited(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_composited", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_get_composited(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_window_set_attached_to "void gtk_window_set_attached_to(GtkWindow* window, GtkWidget* attach_widget)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_attached_to", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkWidget_(attach_widget), attach_widget, 2, "gtk_window_set_attached_to", "GtkWidget*");
+ gtk_window_set_attached_to(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkWidget_(attach_widget));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_is_input_only(XEN window)
+static Xen gxg_gtk_window_get_attached_to(Xen window)
{
- #define H_gdk_window_is_input_only "gboolean gdk_window_is_input_only(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_is_input_only", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_is_input_only(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_window_get_attached_to "GtkWidget* gtk_window_get_attached_to(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_attached_to", "GtkWindow*");
+ return(C_to_Xen_GtkWidget_(gtk_window_get_attached_to(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gdk_window_is_shaped(XEN window)
+static Xen gxg_gtk_about_dialog_add_credit_section(Xen about, Xen section_name, Xen people)
{
- #define H_gdk_window_is_shaped "gboolean gdk_window_is_shaped(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_is_shaped", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_is_shaped(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_about_dialog_add_credit_section "void gtk_about_dialog_add_credit_section(GtkAboutDialog* about, \
+gchar* section_name, gchar** people)"
+ Xen_check_type(Xen_is_GtkAboutDialog_(about), about, 1, "gtk_about_dialog_add_credit_section", "GtkAboutDialog*");
+ Xen_check_type(Xen_is_gchar_(section_name), section_name, 2, "gtk_about_dialog_add_credit_section", "gchar*");
+ Xen_check_type(Xen_is_gchar__(people), people, 3, "gtk_about_dialog_add_credit_section", "gchar**");
+ gtk_about_dialog_add_credit_section(Xen_to_C_GtkAboutDialog_(about), (const gchar*)Xen_to_C_gchar_(section_name), (const gchar**)Xen_to_C_gchar__(people));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_modal_hint(XEN window)
+static Xen gxg_gdk_keymap_get_modifier_state(Xen keymap)
{
- #define H_gdk_window_get_modal_hint "gboolean gdk_window_get_modal_hint(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_modal_hint", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_get_modal_hint(XEN_TO_C_GdkWindow_(window))));
+ #define H_gdk_keymap_get_modifier_state "guint gdk_keymap_get_modifier_state(GdkKeymap* keymap)"
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_get_modifier_state", "GdkKeymap*");
+ return(C_to_Xen_guint(gdk_keymap_get_modifier_state(Xen_to_C_GdkKeymap_(keymap))));
}
-static XEN gxg_gdk_window_set_device_cursor(XEN window, XEN device, XEN cursor)
+static Xen gxg_gtk_hsv_to_rgb(Xen h, Xen s, Xen v, Xen ignore_r, Xen ignore_g, Xen ignore_b)
{
- #define H_gdk_window_set_device_cursor "void gdk_window_set_device_cursor(GdkWindow* window, GdkDevice* device, \
-GdkCursor* cursor)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_device_cursor", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_set_device_cursor", "GdkDevice*");
- XEN_ASSERT_TYPE(XEN_GdkCursor__P(cursor), cursor, 3, "gdk_window_set_device_cursor", "GdkCursor*");
- gdk_window_set_device_cursor(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkCursor_(cursor));
- return(XEN_FALSE);
+ #define H_gtk_hsv_to_rgb "void gtk_hsv_to_rgb(gdouble h, gdouble s, gdouble v, gdouble* [r], gdouble* [g], \
+gdouble* [b])"
+ gdouble ref_r;
+ gdouble ref_g;
+ gdouble ref_b;
+ Xen_check_type(Xen_is_gdouble(h), h, 1, "gtk_hsv_to_rgb", "gdouble");
+ Xen_check_type(Xen_is_gdouble(s), s, 2, "gtk_hsv_to_rgb", "gdouble");
+ Xen_check_type(Xen_is_gdouble(v), v, 3, "gtk_hsv_to_rgb", "gdouble");
+ gtk_hsv_to_rgb(Xen_to_C_gdouble(h), Xen_to_C_gdouble(s), Xen_to_C_gdouble(v), &ref_r, &ref_g, &ref_b);
+ return(Xen_list_3(C_to_Xen_gdouble(ref_r), C_to_Xen_gdouble(ref_g), C_to_Xen_gdouble(ref_b)));
}
-static XEN gxg_gdk_window_get_device_cursor(XEN window, XEN device)
+static Xen gxg_gtk_rgb_to_hsv(Xen r, Xen g, Xen b, Xen ignore_h, Xen ignore_s, Xen ignore_v)
{
- #define H_gdk_window_get_device_cursor "GdkCursor* gdk_window_get_device_cursor(GdkWindow* window, \
-GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_device_cursor", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_get_device_cursor", "GdkDevice*");
- return(C_TO_XEN_GdkCursor_(gdk_window_get_device_cursor(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device))));
+ #define H_gtk_rgb_to_hsv "void gtk_rgb_to_hsv(gdouble r, gdouble g, gdouble b, gdouble* [h], gdouble* [s], \
+gdouble* [v])"
+ gdouble ref_h;
+ gdouble ref_s;
+ gdouble ref_v;
+ Xen_check_type(Xen_is_gdouble(r), r, 1, "gtk_rgb_to_hsv", "gdouble");
+ Xen_check_type(Xen_is_gdouble(g), g, 2, "gtk_rgb_to_hsv", "gdouble");
+ Xen_check_type(Xen_is_gdouble(b), b, 3, "gtk_rgb_to_hsv", "gdouble");
+ gtk_rgb_to_hsv(Xen_to_C_gdouble(r), Xen_to_C_gdouble(g), Xen_to_C_gdouble(b), &ref_h, &ref_s, &ref_v);
+ return(Xen_list_3(C_to_Xen_gdouble(ref_h), C_to_Xen_gdouble(ref_s), C_to_Xen_gdouble(ref_v)));
}
-static XEN gxg_gdk_window_get_device_position(XEN window, XEN device, XEN ignore_x, XEN ignore_y, XEN ignore_mask)
+static Xen gxg_gtk_color_chooser_get_rgba(Xen chooser, Xen color)
{
- #define H_gdk_window_get_device_position "GdkWindow* gdk_window_get_device_position(GdkWindow* window, \
-GdkDevice* device, gint* [x], gint* [y], GdkModifierType* [mask])"
- gint ref_x;
- gint ref_y;
- GdkModifierType ref_mask;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_device_position", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_get_device_position", "GdkDevice*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkWindow_(gdk_window_get_device_position(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device),
- &ref_x, &ref_y, &ref_mask));
- return(XEN_LIST_4(result, C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_GdkModifierType(ref_mask)));
- }
+ #define H_gtk_color_chooser_get_rgba "void gtk_color_chooser_get_rgba(GtkColorChooser* chooser, GdkRGBA* color)"
+ Xen_check_type(Xen_is_GtkColorChooser_(chooser), chooser, 1, "gtk_color_chooser_get_rgba", "GtkColorChooser*");
+ Xen_check_type(Xen_is_GdkRGBA_(color), color, 2, "gtk_color_chooser_get_rgba", "GdkRGBA*");
+ gtk_color_chooser_get_rgba(Xen_to_C_GtkColorChooser_(chooser), Xen_to_C_GdkRGBA_(color));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_device_events(XEN window, XEN device, XEN event_mask)
+static Xen gxg_gtk_color_chooser_set_rgba(Xen chooser, Xen color)
{
- #define H_gdk_window_set_device_events "void gdk_window_set_device_events(GdkWindow* window, GdkDevice* device, \
-GdkEventMask event_mask)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_device_events", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_set_device_events", "GdkDevice*");
- XEN_ASSERT_TYPE(XEN_GdkEventMask_P(event_mask), event_mask, 3, "gdk_window_set_device_events", "GdkEventMask");
- gdk_window_set_device_events(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkEventMask(event_mask));
- return(XEN_FALSE);
+ #define H_gtk_color_chooser_set_rgba "void gtk_color_chooser_set_rgba(GtkColorChooser* chooser, GdkRGBA* color)"
+ Xen_check_type(Xen_is_GtkColorChooser_(chooser), chooser, 1, "gtk_color_chooser_set_rgba", "GtkColorChooser*");
+ Xen_check_type(Xen_is_GdkRGBA_(color), color, 2, "gtk_color_chooser_set_rgba", "GdkRGBA*");
+ gtk_color_chooser_set_rgba(Xen_to_C_GtkColorChooser_(chooser), Xen_to_C_GdkRGBA_(color));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_device_events(XEN window, XEN device)
+static Xen gxg_gtk_color_chooser_get_use_alpha(Xen chooser)
{
- #define H_gdk_window_get_device_events "GdkEventMask gdk_window_get_device_events(GdkWindow* window, \
-GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_device_events", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gdk_window_get_device_events", "GdkDevice*");
- return(C_TO_XEN_GdkEventMask(gdk_window_get_device_events(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkDevice_(device))));
+ #define H_gtk_color_chooser_get_use_alpha "gboolean gtk_color_chooser_get_use_alpha(GtkColorChooser* chooser)"
+ Xen_check_type(Xen_is_GtkColorChooser_(chooser), chooser, 1, "gtk_color_chooser_get_use_alpha", "GtkColorChooser*");
+ return(C_to_Xen_gboolean(gtk_color_chooser_get_use_alpha(Xen_to_C_GtkColorChooser_(chooser))));
}
-static XEN gxg_gtk_combo_box_popup_for_device(XEN combo_box, XEN device)
+static Xen gxg_gtk_color_chooser_set_use_alpha(Xen chooser, Xen use_alpha)
{
- #define H_gtk_combo_box_popup_for_device "void gtk_combo_box_popup_for_device(GtkComboBox* combo_box, \
-GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_popup_for_device", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_combo_box_popup_for_device", "GdkDevice*");
- gtk_combo_box_popup_for_device(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_GdkDevice_(device));
- return(XEN_FALSE);
+ #define H_gtk_color_chooser_set_use_alpha "void gtk_color_chooser_set_use_alpha(GtkColorChooser* chooser, \
+gboolean use_alpha)"
+ Xen_check_type(Xen_is_GtkColorChooser_(chooser), chooser, 1, "gtk_color_chooser_set_use_alpha", "GtkColorChooser*");
+ Xen_check_type(Xen_is_gboolean(use_alpha), use_alpha, 2, "gtk_color_chooser_set_use_alpha", "gboolean");
+ gtk_color_chooser_set_use_alpha(Xen_to_C_GtkColorChooser_(chooser), Xen_to_C_gboolean(use_alpha));
+ return(Xen_false);
}
-static XEN gxg_gtk_device_grab_add(XEN widget, XEN device, XEN block_others)
+static Xen gxg_gtk_color_chooser_dialog_new(Xen title, Xen parent)
{
- #define H_gtk_device_grab_add "void gtk_device_grab_add(GtkWidget* widget, GdkDevice* device, gboolean block_others)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_device_grab_add", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_device_grab_add", "GdkDevice*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(block_others), block_others, 3, "gtk_device_grab_add", "gboolean");
- gtk_device_grab_add(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device), XEN_TO_C_gboolean(block_others));
- return(XEN_FALSE);
+ #define H_gtk_color_chooser_dialog_new "GtkWidget* gtk_color_chooser_dialog_new(gchar* title, GtkWindow* parent)"
+ Xen_check_type(Xen_is_gchar_(title), title, 1, "gtk_color_chooser_dialog_new", "gchar*");
+ Xen_check_type(Xen_is_GtkWindow_(parent), parent, 2, "gtk_color_chooser_dialog_new", "GtkWindow*");
+ return(C_to_Xen_GtkWidget_(gtk_color_chooser_dialog_new((const gchar*)Xen_to_C_gchar_(title), Xen_to_C_GtkWindow_(parent))));
}
-static XEN gxg_gtk_device_grab_remove(XEN widget, XEN device)
+static Xen gxg_gtk_color_chooser_widget_new(void)
{
- #define H_gtk_device_grab_remove "void gtk_device_grab_remove(GtkWidget* widget, GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_device_grab_remove", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_device_grab_remove", "GdkDevice*");
- gtk_device_grab_remove(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device));
- return(XEN_FALSE);
+ #define H_gtk_color_chooser_widget_new "GtkWidget* gtk_color_chooser_widget_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_color_chooser_widget_new()));
}
-static XEN gxg_gtk_get_current_event_device(void)
+#endif
+
+#if GTK_CHECK_VERSION(3, 6, 0)
+static Xen gxg_gdk_event_get_scroll_deltas(Xen event, Xen ignore_delta_x, Xen ignore_delta_y)
{
- #define H_gtk_get_current_event_device "GdkDevice* gtk_get_current_event_device( void)"
- return(C_TO_XEN_GdkDevice_(gtk_get_current_event_device()));
+ #define H_gdk_event_get_scroll_deltas "gboolean gdk_event_get_scroll_deltas(GdkEvent* event, gdouble* [delta_x], \
+gdouble* [delta_y])"
+ gdouble ref_delta_x;
+ gdouble ref_delta_y;
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_scroll_deltas", "GdkEvent*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_event_get_scroll_deltas(Xen_to_C_GdkEvent_(event), &ref_delta_x, &ref_delta_y));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_delta_x), C_to_Xen_gdouble(ref_delta_y)));
+ }
}
-static XEN gxg_gtk_paned_new(XEN orientation)
+static Xen gxg_gtk_color_chooser_add_palette(Xen chooser, Xen horizontal, Xen colors_per_line, Xen n_colors, Xen colors)
{
- #define H_gtk_paned_new "GtkWidget* gtk_paned_new(GtkOrientation orientation)"
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_paned_new", "GtkOrientation");
- return(C_TO_XEN_GtkWidget_(gtk_paned_new(XEN_TO_C_GtkOrientation(orientation))));
+ #define H_gtk_color_chooser_add_palette "void gtk_color_chooser_add_palette(GtkColorChooser* chooser, \
+GtkOrientation horizontal, gint colors_per_line, gint n_colors, GdkRGBA* colors)"
+ Xen_check_type(Xen_is_GtkColorChooser_(chooser), chooser, 1, "gtk_color_chooser_add_palette", "GtkColorChooser*");
+ Xen_check_type(Xen_is_GtkOrientation(horizontal), horizontal, 2, "gtk_color_chooser_add_palette", "GtkOrientation");
+ Xen_check_type(Xen_is_gint(colors_per_line), colors_per_line, 3, "gtk_color_chooser_add_palette", "gint");
+ Xen_check_type(Xen_is_gint(n_colors), n_colors, 4, "gtk_color_chooser_add_palette", "gint");
+ Xen_check_type(Xen_is_GdkRGBA_(colors), colors, 5, "gtk_color_chooser_add_palette", "GdkRGBA*");
+ gtk_color_chooser_add_palette(Xen_to_C_GtkColorChooser_(chooser), Xen_to_C_GtkOrientation(horizontal), Xen_to_C_gint(colors_per_line),
+ Xen_to_C_gint(n_colors), Xen_to_C_GdkRGBA_(colors));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_action_join_group(XEN action, XEN group_source)
+static Xen gxg_gtk_button_set_always_show_image(Xen button, Xen always_show)
{
- #define H_gtk_radio_action_join_group "void gtk_radio_action_join_group(GtkRadioAction* action, GtkRadioAction* group_source)"
- XEN_ASSERT_TYPE(XEN_GtkRadioAction__P(action), action, 1, "gtk_radio_action_join_group", "GtkRadioAction*");
- XEN_ASSERT_TYPE(XEN_GtkRadioAction__P(group_source), group_source, 2, "gtk_radio_action_join_group", "GtkRadioAction*");
- gtk_radio_action_join_group(XEN_TO_C_GtkRadioAction_(action), XEN_TO_C_GtkRadioAction_(group_source));
- return(XEN_FALSE);
+ #define H_gtk_button_set_always_show_image "void gtk_button_set_always_show_image(GtkButton* button, \
+gboolean always_show)"
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_set_always_show_image", "GtkButton*");
+ Xen_check_type(Xen_is_gboolean(always_show), always_show, 2, "gtk_button_set_always_show_image", "gboolean");
+ gtk_button_set_always_show_image(Xen_to_C_GtkButton_(button), Xen_to_C_gboolean(always_show));
+ return(Xen_false);
}
-static XEN gxg_gtk_scale_new(XEN orientation, XEN adjustment)
+static Xen gxg_gtk_button_get_always_show_image(Xen button)
{
- #define H_gtk_scale_new "GtkWidget* gtk_scale_new(GtkOrientation orientation, GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_scale_new", "GtkOrientation");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 2, "gtk_scale_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_scale_new(XEN_TO_C_GtkOrientation(orientation), XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_button_get_always_show_image "gboolean gtk_button_get_always_show_image(GtkButton* button)"
+ Xen_check_type(Xen_is_GtkButton_(button), button, 1, "gtk_button_get_always_show_image", "GtkButton*");
+ return(C_to_Xen_gboolean(gtk_button_get_always_show_image(Xen_to_C_GtkButton_(button))));
}
-static XEN gxg_gtk_scale_new_with_range(XEN orientation, XEN min, XEN max, XEN step)
+static Xen gxg_gtk_tree_view_get_n_columns(Xen tree_view)
{
- #define H_gtk_scale_new_with_range "GtkWidget* gtk_scale_new_with_range(GtkOrientation orientation, \
-gdouble min, gdouble max, gdouble step)"
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_scale_new_with_range", "GtkOrientation");
- XEN_ASSERT_TYPE(XEN_gdouble_P(min), min, 2, "gtk_scale_new_with_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(max), max, 3, "gtk_scale_new_with_range", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step), step, 4, "gtk_scale_new_with_range", "gdouble");
- return(C_TO_XEN_GtkWidget_(gtk_scale_new_with_range(XEN_TO_C_GtkOrientation(orientation), XEN_TO_C_gdouble(min), XEN_TO_C_gdouble(max),
- XEN_TO_C_gdouble(step))));
+ #define H_gtk_tree_view_get_n_columns "guint gtk_tree_view_get_n_columns(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_n_columns", "GtkTreeView*");
+ return(C_to_Xen_guint(gtk_tree_view_get_n_columns(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_scrollbar_new(XEN orientation, XEN adjustment)
+static Xen gxg_gtk_menu_button_new(void)
{
- #define H_gtk_scrollbar_new "GtkWidget* gtk_scrollbar_new(GtkOrientation orientation, GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_scrollbar_new", "GtkOrientation");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 2, "gtk_scrollbar_new", "GtkAdjustment*");
- return(C_TO_XEN_GtkWidget_(gtk_scrollbar_new(XEN_TO_C_GtkOrientation(orientation), XEN_TO_C_GtkAdjustment_(adjustment))));
+ #define H_gtk_menu_button_new "GtkWidget* gtk_menu_button_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_menu_button_new()));
}
-static XEN gxg_gtk_separator_new(XEN orientation)
+static Xen gxg_gtk_menu_button_set_menu_model(Xen menu_button, Xen menu_model)
{
- #define H_gtk_separator_new "GtkWidget* gtk_separator_new(GtkOrientation orientation)"
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_separator_new", "GtkOrientation");
- return(C_TO_XEN_GtkWidget_(gtk_separator_new(XEN_TO_C_GtkOrientation(orientation))));
+ #define H_gtk_menu_button_set_menu_model "void gtk_menu_button_set_menu_model(GtkMenuButton* menu_button, \
+GMenuModel* menu_model)"
+ Xen_check_type(Xen_is_GtkMenuButton_(menu_button), menu_button, 1, "gtk_menu_button_set_menu_model", "GtkMenuButton*");
+ Xen_check_type(Xen_is_GMenuModel_(menu_model), menu_model, 2, "gtk_menu_button_set_menu_model", "GMenuModel*");
+ gtk_menu_button_set_menu_model(Xen_to_C_GtkMenuButton_(menu_button), Xen_to_C_GMenuModel_(menu_model));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_device_is_shadowed(XEN widget, XEN device)
+static Xen gxg_gtk_menu_button_get_menu_model(Xen menu_button)
{
- #define H_gtk_widget_device_is_shadowed "gboolean gtk_widget_device_is_shadowed(GtkWidget* widget, \
-GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_device_is_shadowed", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_device_is_shadowed", "GdkDevice*");
- return(C_TO_XEN_gboolean(gtk_widget_device_is_shadowed(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device))));
+ #define H_gtk_menu_button_get_menu_model "GMenuModel* gtk_menu_button_get_menu_model(GtkMenuButton* menu_button)"
+ Xen_check_type(Xen_is_GtkMenuButton_(menu_button), menu_button, 1, "gtk_menu_button_get_menu_model", "GtkMenuButton*");
+ return(C_to_Xen_GMenuModel_(gtk_menu_button_get_menu_model(Xen_to_C_GtkMenuButton_(menu_button))));
}
-static XEN gxg_gtk_widget_set_device_events(XEN widget, XEN device, XEN events)
+static Xen gxg_gtk_menu_button_set_align_widget(Xen menu_button, Xen align_widget)
{
- #define H_gtk_widget_set_device_events "void gtk_widget_set_device_events(GtkWidget* widget, GdkDevice* device, \
-GdkEventMask events)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_device_events", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_set_device_events", "GdkDevice*");
- XEN_ASSERT_TYPE(XEN_GdkEventMask_P(events), events, 3, "gtk_widget_set_device_events", "GdkEventMask");
- gtk_widget_set_device_events(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkEventMask(events));
- return(XEN_FALSE);
+ #define H_gtk_menu_button_set_align_widget "void gtk_menu_button_set_align_widget(GtkMenuButton* menu_button, \
+GtkWidget* align_widget)"
+ Xen_check_type(Xen_is_GtkMenuButton_(menu_button), menu_button, 1, "gtk_menu_button_set_align_widget", "GtkMenuButton*");
+ Xen_check_type(Xen_is_GtkWidget_(align_widget), align_widget, 2, "gtk_menu_button_set_align_widget", "GtkWidget*");
+ gtk_menu_button_set_align_widget(Xen_to_C_GtkMenuButton_(menu_button), Xen_to_C_GtkWidget_(align_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_add_device_events(XEN widget, XEN device, XEN events)
+static Xen gxg_gtk_menu_button_get_align_widget(Xen menu_button)
{
- #define H_gtk_widget_add_device_events "void gtk_widget_add_device_events(GtkWidget* widget, GdkDevice* device, \
-GdkEventMask events)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_add_device_events", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_add_device_events", "GdkDevice*");
- XEN_ASSERT_TYPE(XEN_GdkEventMask_P(events), events, 3, "gtk_widget_add_device_events", "GdkEventMask");
- gtk_widget_add_device_events(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkEventMask(events));
- return(XEN_FALSE);
+ #define H_gtk_menu_button_get_align_widget "GtkWidget* gtk_menu_button_get_align_widget(GtkMenuButton* menu_button)"
+ Xen_check_type(Xen_is_GtkMenuButton_(menu_button), menu_button, 1, "gtk_menu_button_get_align_widget", "GtkMenuButton*");
+ return(C_to_Xen_GtkWidget_(gtk_menu_button_get_align_widget(Xen_to_C_GtkMenuButton_(menu_button))));
}
-static XEN gxg_gtk_widget_get_support_multidevice(XEN widget)
+static Xen gxg_gtk_search_entry_new(void)
{
- #define H_gtk_widget_get_support_multidevice "gboolean gtk_widget_get_support_multidevice(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_support_multidevice", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_support_multidevice(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_search_entry_new "GtkWidget* gtk_search_entry_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_search_entry_new()));
}
-static XEN gxg_gtk_widget_set_support_multidevice(XEN widget, XEN support_multidevice)
+static Xen gxg_gtk_level_bar_new(void)
{
- #define H_gtk_widget_set_support_multidevice "void gtk_widget_set_support_multidevice(GtkWidget* widget, \
-gboolean support_multidevice)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_support_multidevice", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(support_multidevice), support_multidevice, 2, "gtk_widget_set_support_multidevice", "gboolean");
- gtk_widget_set_support_multidevice(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(support_multidevice));
- return(XEN_FALSE);
+ #define H_gtk_level_bar_new "GtkWidget* gtk_level_bar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_level_bar_new()));
}
-static XEN gxg_gtk_widget_get_device_events(XEN widget, XEN device)
+static Xen gxg_gtk_level_bar_new_for_interval(Xen min_value, Xen max_value)
{
- #define H_gtk_widget_get_device_events "GdkEventMask gtk_widget_get_device_events(GtkWidget* widget, \
-GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_device_events", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_get_device_events", "GdkDevice*");
- return(C_TO_XEN_GdkEventMask(gtk_widget_get_device_events(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device))));
+ #define H_gtk_level_bar_new_for_interval "GtkWidget* gtk_level_bar_new_for_interval(gdouble min_value, \
+gdouble max_value)"
+ Xen_check_type(Xen_is_gdouble(min_value), min_value, 1, "gtk_level_bar_new_for_interval", "gdouble");
+ Xen_check_type(Xen_is_gdouble(max_value), max_value, 2, "gtk_level_bar_new_for_interval", "gdouble");
+ return(C_to_Xen_GtkWidget_(gtk_level_bar_new_for_interval(Xen_to_C_gdouble(min_value), Xen_to_C_gdouble(max_value))));
}
-static XEN gxg_gtk_icon_view_get_item_row(XEN icon_view, XEN path)
+static Xen gxg_gtk_level_bar_set_mode(Xen self, Xen mode)
{
- #define H_gtk_icon_view_get_item_row "gint gtk_icon_view_get_item_row(GtkIconView* icon_view, GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_item_row", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_get_item_row", "GtkTreePath*");
- return(C_TO_XEN_gint(gtk_icon_view_get_item_row(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_level_bar_set_mode "void gtk_level_bar_set_mode(GtkLevelBar* self, GtkLevelBarMode mode)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_set_mode", "GtkLevelBar*");
+ Xen_check_type(Xen_is_GtkLevelBarMode(mode), mode, 2, "gtk_level_bar_set_mode", "GtkLevelBarMode");
+ gtk_level_bar_set_mode(Xen_to_C_GtkLevelBar_(self), Xen_to_C_GtkLevelBarMode(mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_get_item_column(XEN icon_view, XEN path)
+static Xen gxg_gtk_level_bar_get_mode(Xen self)
{
- #define H_gtk_icon_view_get_item_column "gint gtk_icon_view_get_item_column(GtkIconView* icon_view, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_item_column", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_get_item_column", "GtkTreePath*");
- return(C_TO_XEN_gint(gtk_icon_view_get_item_column(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_level_bar_get_mode "GtkLevelBarMode gtk_level_bar_get_mode(GtkLevelBar* self)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_get_mode", "GtkLevelBar*");
+ return(C_to_Xen_GtkLevelBarMode(gtk_level_bar_get_mode(Xen_to_C_GtkLevelBar_(self))));
}
-static XEN gxg_gtk_statusbar_remove_all(XEN statusbar, XEN context_id)
+static Xen gxg_gtk_level_bar_set_value(Xen self, Xen value)
{
- #define H_gtk_statusbar_remove_all "void gtk_statusbar_remove_all(GtkStatusbar* statusbar, guint context_id)"
- XEN_ASSERT_TYPE(XEN_GtkStatusbar__P(statusbar), statusbar, 1, "gtk_statusbar_remove_all", "GtkStatusbar*");
- XEN_ASSERT_TYPE(XEN_guint_P(context_id), context_id, 2, "gtk_statusbar_remove_all", "guint");
- gtk_statusbar_remove_all(XEN_TO_C_GtkStatusbar_(statusbar), XEN_TO_C_guint(context_id));
- return(XEN_FALSE);
+ #define H_gtk_level_bar_set_value "void gtk_level_bar_set_value(GtkLevelBar* self, gdouble value)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_set_value", "GtkLevelBar*");
+ Xen_check_type(Xen_is_gdouble(value), value, 2, "gtk_level_bar_set_value", "gdouble");
+ gtk_level_bar_set_value(Xen_to_C_GtkLevelBar_(self), Xen_to_C_gdouble(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_has_group(XEN window)
+static Xen gxg_gtk_level_bar_get_value(Xen self)
{
- #define H_gtk_window_has_group "gboolean gtk_window_has_group(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_has_group", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_has_group(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_level_bar_get_value "gdouble gtk_level_bar_get_value(GtkLevelBar* self)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_get_value", "GtkLevelBar*");
+ return(C_to_Xen_gdouble(gtk_level_bar_get_value(Xen_to_C_GtkLevelBar_(self))));
}
-static XEN gxg_gtk_calendar_select_month(XEN calendar, XEN month, XEN year)
+static Xen gxg_gtk_level_bar_set_min_value(Xen self, Xen value)
{
- #define H_gtk_calendar_select_month "void gtk_calendar_select_month(GtkCalendar* calendar, guint month, \
-guint year)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_select_month", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_guint_P(month), month, 2, "gtk_calendar_select_month", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(year), year, 3, "gtk_calendar_select_month", "guint");
- gtk_calendar_select_month(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_guint(month), XEN_TO_C_guint(year));
- return(XEN_FALSE);
+ #define H_gtk_level_bar_set_min_value "void gtk_level_bar_set_min_value(GtkLevelBar* self, gdouble value)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_set_min_value", "GtkLevelBar*");
+ Xen_check_type(Xen_is_gdouble(value), value, 2, "gtk_level_bar_set_min_value", "gdouble");
+ gtk_level_bar_set_min_value(Xen_to_C_GtkLevelBar_(self), Xen_to_C_gdouble(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_calendar_mark_day(XEN calendar, XEN day)
+static Xen gxg_gtk_level_bar_get_min_value(Xen self)
{
- #define H_gtk_calendar_mark_day "void gtk_calendar_mark_day(GtkCalendar* calendar, guint day)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_mark_day", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_guint_P(day), day, 2, "gtk_calendar_mark_day", "guint");
- gtk_calendar_mark_day(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_guint(day));
- return(XEN_FALSE);
+ #define H_gtk_level_bar_get_min_value "gdouble gtk_level_bar_get_min_value(GtkLevelBar* self)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_get_min_value", "GtkLevelBar*");
+ return(C_to_Xen_gdouble(gtk_level_bar_get_min_value(Xen_to_C_GtkLevelBar_(self))));
}
-static XEN gxg_gtk_calendar_unmark_day(XEN calendar, XEN day)
+static Xen gxg_gtk_level_bar_set_max_value(Xen self, Xen value)
{
- #define H_gtk_calendar_unmark_day "void gtk_calendar_unmark_day(GtkCalendar* calendar, guint day)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_unmark_day", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_guint_P(day), day, 2, "gtk_calendar_unmark_day", "guint");
- gtk_calendar_unmark_day(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_guint(day));
- return(XEN_FALSE);
+ #define H_gtk_level_bar_set_max_value "void gtk_level_bar_set_max_value(GtkLevelBar* self, gdouble value)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_set_max_value", "GtkLevelBar*");
+ Xen_check_type(Xen_is_gdouble(value), value, 2, "gtk_level_bar_set_max_value", "gdouble");
+ gtk_level_bar_set_max_value(Xen_to_C_GtkLevelBar_(self), Xen_to_C_gdouble(value));
+ return(Xen_false);
}
-static XEN gxg_gdk_drag_context_get_source_window(XEN context)
+static Xen gxg_gtk_level_bar_get_max_value(Xen self)
{
- #define H_gdk_drag_context_get_source_window "GdkWindow* gdk_drag_context_get_source_window(GdkDragContext* context)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_context_get_source_window", "GdkDragContext*");
- return(C_TO_XEN_GdkWindow_(gdk_drag_context_get_source_window(XEN_TO_C_GdkDragContext_(context))));
+ #define H_gtk_level_bar_get_max_value "gdouble gtk_level_bar_get_max_value(GtkLevelBar* self)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_get_max_value", "GtkLevelBar*");
+ return(C_to_Xen_gdouble(gtk_level_bar_get_max_value(Xen_to_C_GtkLevelBar_(self))));
}
-static XEN gxg_gtk_viewport_get_view_window(XEN viewport)
+static Xen gxg_gtk_level_bar_add_offset_value(Xen self, Xen name, Xen value)
{
- #define H_gtk_viewport_get_view_window "GdkWindow* gtk_viewport_get_view_window(GtkViewport* viewport)"
- XEN_ASSERT_TYPE(XEN_GtkViewport__P(viewport), viewport, 1, "gtk_viewport_get_view_window", "GtkViewport*");
- return(C_TO_XEN_GdkWindow_(gtk_viewport_get_view_window(XEN_TO_C_GtkViewport_(viewport))));
+ #define H_gtk_level_bar_add_offset_value "void gtk_level_bar_add_offset_value(GtkLevelBar* self, gchar* name, \
+gdouble value)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_add_offset_value", "GtkLevelBar*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_level_bar_add_offset_value", "gchar*");
+ Xen_check_type(Xen_is_gdouble(value), value, 3, "gtk_level_bar_add_offset_value", "gdouble");
+ gtk_level_bar_add_offset_value(Xen_to_C_GtkLevelBar_(self), (const gchar*)Xen_to_C_gchar_(name), Xen_to_C_gdouble(value));
+ return(Xen_false);
}
-static XEN gxg_gtk_accessible_set_widget(XEN accessible, XEN widget)
+static Xen gxg_gtk_level_bar_remove_offset_value(Xen self, Xen name)
{
- #define H_gtk_accessible_set_widget "void gtk_accessible_set_widget(GtkAccessible* accessible, GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkAccessible__P(accessible), accessible, 1, "gtk_accessible_set_widget", "GtkAccessible*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_accessible_set_widget", "GtkWidget*");
- gtk_accessible_set_widget(XEN_TO_C_GtkAccessible_(accessible), XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_level_bar_remove_offset_value "void gtk_level_bar_remove_offset_value(GtkLevelBar* self, \
+gchar* name)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_remove_offset_value", "GtkLevelBar*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_level_bar_remove_offset_value", "gchar*");
+ gtk_level_bar_remove_offset_value(Xen_to_C_GtkLevelBar_(self), (const gchar*)Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_get_event_window(XEN button)
+static Xen gxg_gtk_level_bar_get_offset_value(Xen self, Xen name, Xen ignore_value)
{
- #define H_gtk_button_get_event_window "GdkWindow* gtk_button_get_event_window(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_event_window", "GtkButton*");
- return(C_TO_XEN_GdkWindow_(gtk_button_get_event_window(XEN_TO_C_GtkButton_(button))));
+ #define H_gtk_level_bar_get_offset_value "gboolean gtk_level_bar_get_offset_value(GtkLevelBar* self, \
+gchar* name, gdouble* [value])"
+ gdouble ref_value;
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_get_offset_value", "GtkLevelBar*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_level_bar_get_offset_value", "gchar*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_level_bar_get_offset_value(Xen_to_C_GtkLevelBar_(self), (const gchar*)Xen_to_C_gchar_(name), &ref_value));
+ return(Xen_list_2(result, C_to_Xen_gdouble(ref_value)));
+ }
}
-static XEN gxg_gtk_font_selection_dialog_get_font_selection(XEN fsd)
+static Xen gxg_gtk_application_get_active_window(Xen application)
{
- #define H_gtk_font_selection_dialog_get_font_selection "GtkWidget* gtk_font_selection_dialog_get_font_selection(GtkFontSelectionDialog* fsd)"
- XEN_ASSERT_TYPE(XEN_GtkFontSelectionDialog__P(fsd), fsd, 1, "gtk_font_selection_dialog_get_font_selection", "GtkFontSelectionDialog*");
- return(C_TO_XEN_GtkWidget_(gtk_font_selection_dialog_get_font_selection(XEN_TO_C_GtkFontSelectionDialog_(fsd))));
+ #define H_gtk_application_get_active_window "GtkWindow* gtk_application_get_active_window(GtkApplication* application)"
+ Xen_check_type(Xen_is_GtkApplication_(application), application, 1, "gtk_application_get_active_window", "GtkApplication*");
+ return(C_to_Xen_GtkWindow_(gtk_application_get_active_window(Xen_to_C_GtkApplication_(application))));
}
-static XEN gxg_gtk_message_dialog_get_message_area(XEN message_dialog)
+static Xen gxg_gtk_entry_set_input_purpose(Xen entry, Xen purpose)
{
- #define H_gtk_message_dialog_get_message_area "GtkWidget* gtk_message_dialog_get_message_area(GtkMessageDialog* message_dialog)"
- XEN_ASSERT_TYPE(XEN_GtkMessageDialog__P(message_dialog), message_dialog, 1, "gtk_message_dialog_get_message_area", "GtkMessageDialog*");
- return(C_TO_XEN_GtkWidget_(gtk_message_dialog_get_message_area(XEN_TO_C_GtkMessageDialog_(message_dialog))));
+ #define H_gtk_entry_set_input_purpose "void gtk_entry_set_input_purpose(GtkEntry* entry, GtkInputPurpose purpose)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_input_purpose", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkInputPurpose(purpose), purpose, 2, "gtk_entry_set_input_purpose", "GtkInputPurpose");
+ gtk_entry_set_input_purpose(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkInputPurpose(purpose));
+ return(Xen_false);
}
-static XEN gxg_gtk_table_get_size(XEN table, XEN ignore_rows, XEN ignore_columns)
+static Xen gxg_gtk_entry_get_input_purpose(Xen entry)
{
- #define H_gtk_table_get_size "void gtk_table_get_size(GtkTable* table, guint* [rows], guint* [columns])"
- guint ref_rows;
- guint ref_columns;
- XEN_ASSERT_TYPE(XEN_GtkTable__P(table), table, 1, "gtk_table_get_size", "GtkTable*");
- gtk_table_get_size(XEN_TO_C_GtkTable_(table), &ref_rows, &ref_columns);
- return(XEN_LIST_2(C_TO_XEN_guint(ref_rows), C_TO_XEN_guint(ref_columns)));
+ #define H_gtk_entry_get_input_purpose "GtkInputPurpose gtk_entry_get_input_purpose(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_input_purpose", "GtkEntry*");
+ return(C_to_Xen_GtkInputPurpose(gtk_entry_get_input_purpose(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_selection_data_get_length(XEN selection_data)
+static Xen gxg_gtk_entry_set_input_hints(Xen entry, Xen hints)
{
- #define H_gtk_selection_data_get_length "gint gtk_selection_data_get_length(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_length", "GtkSelectionData*");
- return(C_TO_XEN_gint(gtk_selection_data_get_length(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_entry_set_input_hints "void gtk_entry_set_input_hints(GtkEntry* entry, GtkInputHints hints)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_input_hints", "GtkEntry*");
+ Xen_check_type(Xen_is_GtkInputHints(hints), hints, 2, "gtk_entry_set_input_hints", "GtkInputHints");
+ gtk_entry_set_input_hints(Xen_to_C_GtkEntry_(entry), Xen_to_C_GtkInputHints(hints));
+ return(Xen_false);
}
-static XEN gxg_gdk_pango_layout_line_get_clip_region(XEN line, XEN x_origin, XEN y_origin, XEN index_ranges, XEN n_ranges)
+static Xen gxg_gtk_entry_get_input_hints(Xen entry)
{
- #define H_gdk_pango_layout_line_get_clip_region "cairo_region_t* gdk_pango_layout_line_get_clip_region(PangoLayoutLine* line, \
-gint x_origin, gint y_origin, gint* index_ranges, gint n_ranges)"
- XEN_ASSERT_TYPE(XEN_PangoLayoutLine__P(line), line, 1, "gdk_pango_layout_line_get_clip_region", "PangoLayoutLine*");
- XEN_ASSERT_TYPE(XEN_gint_P(x_origin), x_origin, 2, "gdk_pango_layout_line_get_clip_region", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y_origin), y_origin, 3, "gdk_pango_layout_line_get_clip_region", "gint");
- XEN_ASSERT_TYPE(XEN_gint__P(index_ranges), index_ranges, 4, "gdk_pango_layout_line_get_clip_region", "gint*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_ranges), n_ranges, 5, "gdk_pango_layout_line_get_clip_region", "gint");
- return(C_TO_XEN_cairo_region_t_(gdk_pango_layout_line_get_clip_region(XEN_TO_C_PangoLayoutLine_(line), XEN_TO_C_gint(x_origin),
- XEN_TO_C_gint(y_origin), XEN_TO_C_gint_(index_ranges),
- XEN_TO_C_gint(n_ranges))));
+ #define H_gtk_entry_get_input_hints "GtkInputHints gtk_entry_get_input_hints(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_input_hints", "GtkEntry*");
+ return(C_to_Xen_GtkInputHints(gtk_entry_get_input_hints(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gdk_pango_layout_get_clip_region(XEN layout, XEN x_origin, XEN y_origin, XEN index_ranges, XEN n_ranges)
+static Xen gxg_gtk_menu_button_get_popup(Xen menu_button)
{
- #define H_gdk_pango_layout_get_clip_region "cairo_region_t* gdk_pango_layout_get_clip_region(PangoLayout* layout, \
-gint x_origin, gint y_origin, gint* index_ranges, gint n_ranges)"
- XEN_ASSERT_TYPE(XEN_PangoLayout__P(layout), layout, 1, "gdk_pango_layout_get_clip_region", "PangoLayout*");
- XEN_ASSERT_TYPE(XEN_gint_P(x_origin), x_origin, 2, "gdk_pango_layout_get_clip_region", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y_origin), y_origin, 3, "gdk_pango_layout_get_clip_region", "gint");
- XEN_ASSERT_TYPE(XEN_gint__P(index_ranges), index_ranges, 4, "gdk_pango_layout_get_clip_region", "gint*");
- XEN_ASSERT_TYPE(XEN_gint_P(n_ranges), n_ranges, 5, "gdk_pango_layout_get_clip_region", "gint");
- return(C_TO_XEN_cairo_region_t_(gdk_pango_layout_get_clip_region(XEN_TO_C_PangoLayout_(layout), XEN_TO_C_gint(x_origin),
- XEN_TO_C_gint(y_origin), XEN_TO_C_gint_(index_ranges),
- XEN_TO_C_gint(n_ranges))));
+ #define H_gtk_menu_button_get_popup "GtkMenu* gtk_menu_button_get_popup(GtkMenuButton* menu_button)"
+ Xen_check_type(Xen_is_GtkMenuButton_(menu_button), menu_button, 1, "gtk_menu_button_get_popup", "GtkMenuButton*");
+ return(C_to_Xen_GtkMenu_(gtk_menu_button_get_popup(Xen_to_C_GtkMenuButton_(menu_button))));
}
-static XEN gxg_gdk_window_shape_combine_region(XEN window, XEN shape_region, XEN offset_x, XEN offset_y)
+static Xen gxg_gtk_text_view_set_input_purpose(Xen text_view, Xen purpose)
{
- #define H_gdk_window_shape_combine_region "void gdk_window_shape_combine_region(GdkWindow* window, \
-cairo_region_t* shape_region, gint offset_x, gint offset_y)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_shape_combine_region", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(shape_region), shape_region, 2, "gdk_window_shape_combine_region", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_gint_P(offset_x), offset_x, 3, "gdk_window_shape_combine_region", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(offset_y), offset_y, 4, "gdk_window_shape_combine_region", "gint");
- gdk_window_shape_combine_region(XEN_TO_C_GdkWindow_(window), XEN_TO_C_cairo_region_t_(shape_region), XEN_TO_C_gint(offset_x),
- XEN_TO_C_gint(offset_y));
- return(XEN_FALSE);
+ #define H_gtk_text_view_set_input_purpose "void gtk_text_view_set_input_purpose(GtkTextView* text_view, \
+GtkInputPurpose purpose)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_input_purpose", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkInputPurpose(purpose), purpose, 2, "gtk_text_view_set_input_purpose", "GtkInputPurpose");
+ gtk_text_view_set_input_purpose(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkInputPurpose(purpose));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_invalidate_region(XEN window, XEN region, XEN invalidate_children)
+static Xen gxg_gtk_text_view_get_input_purpose(Xen text_view)
{
- #define H_gdk_window_invalidate_region "void gdk_window_invalidate_region(GdkWindow* window, cairo_region_t* region, \
-gboolean invalidate_children)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_invalidate_region", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 2, "gdk_window_invalidate_region", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(invalidate_children), invalidate_children, 3, "gdk_window_invalidate_region", "gboolean");
- gdk_window_invalidate_region(XEN_TO_C_GdkWindow_(window), XEN_TO_C_cairo_region_t_(region), XEN_TO_C_gboolean(invalidate_children));
- return(XEN_FALSE);
+ #define H_gtk_text_view_get_input_purpose "GtkInputPurpose gtk_text_view_get_input_purpose(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_input_purpose", "GtkTextView*");
+ return(C_to_Xen_GtkInputPurpose(gtk_text_view_get_input_purpose(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gdk_window_get_update_area(XEN window)
+static Xen gxg_gtk_text_view_set_input_hints(Xen text_view, Xen hints)
{
- #define H_gdk_window_get_update_area "cairo_region_t* gdk_window_get_update_area(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_update_area", "GdkWindow*");
- return(C_TO_XEN_cairo_region_t_(gdk_window_get_update_area(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_text_view_set_input_hints "void gtk_text_view_set_input_hints(GtkTextView* text_view, \
+GtkInputHints hints)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_input_hints", "GtkTextView*");
+ Xen_check_type(Xen_is_GtkInputHints(hints), hints, 2, "gtk_text_view_set_input_hints", "GtkInputHints");
+ gtk_text_view_set_input_hints(Xen_to_C_GtkTextView_(text_view), Xen_to_C_GtkInputHints(hints));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_begin_paint_region(XEN window, XEN region)
+static Xen gxg_gtk_text_view_get_input_hints(Xen text_view)
{
- #define H_gdk_window_begin_paint_region "void gdk_window_begin_paint_region(GdkWindow* window, cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_begin_paint_region", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 2, "gdk_window_begin_paint_region", "cairo_region_t*");
- gdk_window_begin_paint_region(XEN_TO_C_GdkWindow_(window), XEN_TO_C_cairo_region_t_(region));
- return(XEN_FALSE);
+ #define H_gtk_text_view_get_input_hints "GtkInputHints gtk_text_view_get_input_hints(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_input_hints", "GtkTextView*");
+ return(C_to_Xen_GtkInputHints(gtk_text_view_get_input_hints(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_widget_region_intersect(XEN widget, XEN region)
+static Xen gxg_gtk_entry_set_attributes(Xen entry, Xen attrs)
{
- #define H_gtk_widget_region_intersect "cairo_region_t* gtk_widget_region_intersect(GtkWidget* widget, \
-cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_region_intersect", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 2, "gtk_widget_region_intersect", "cairo_region_t*");
- return(C_TO_XEN_cairo_region_t_(gtk_widget_region_intersect(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_cairo_region_t_(region))));
+ #define H_gtk_entry_set_attributes "void gtk_entry_set_attributes(GtkEntry* entry, PangoAttrList* attrs)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_attributes", "GtkEntry*");
+ Xen_check_type(Xen_is_PangoAttrList_(attrs), attrs, 2, "gtk_entry_set_attributes", "PangoAttrList*");
+ gtk_entry_set_attributes(Xen_to_C_GtkEntry_(entry), Xen_to_C_PangoAttrList_(attrs));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_move_region(XEN window, XEN region, XEN dx, XEN dy)
+static Xen gxg_gtk_entry_get_attributes(Xen entry)
{
- #define H_gdk_window_move_region "void gdk_window_move_region(GdkWindow* window, cairo_region_t* region, \
-gint dx, gint dy)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_move_region", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 2, "gdk_window_move_region", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_gint_P(dx), dx, 3, "gdk_window_move_region", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(dy), dy, 4, "gdk_window_move_region", "gint");
- gdk_window_move_region(XEN_TO_C_GdkWindow_(window), XEN_TO_C_cairo_region_t_(region), XEN_TO_C_gint(dx), XEN_TO_C_gint(dy));
- return(XEN_FALSE);
+ #define H_gtk_entry_get_attributes "PangoAttrList* gtk_entry_get_attributes(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_attributes", "GtkEntry*");
+ return(C_to_Xen_PangoAttrList_(gtk_entry_get_attributes(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gdk_keymap_get_num_lock_state(XEN keymap)
+static Xen gxg_gtk_accel_label_set_accel(Xen accel_label, Xen accelerator_key, Xen accelerator_mods)
{
- #define H_gdk_keymap_get_num_lock_state "gboolean gdk_keymap_get_num_lock_state(GdkKeymap* keymap)"
- XEN_ASSERT_TYPE(XEN_GdkKeymap__P(keymap), keymap, 1, "gdk_keymap_get_num_lock_state", "GdkKeymap*");
- return(C_TO_XEN_gboolean(gdk_keymap_get_num_lock_state(XEN_TO_C_GdkKeymap_(keymap))));
+ #define H_gtk_accel_label_set_accel "void gtk_accel_label_set_accel(GtkAccelLabel* accel_label, guint accelerator_key, \
+GdkModifierType accelerator_mods)"
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_set_accel", "GtkAccelLabel*");
+ Xen_check_type(Xen_is_guint(accelerator_key), accelerator_key, 2, "gtk_accel_label_set_accel", "guint");
+ Xen_check_type(Xen_is_GdkModifierType(accelerator_mods), accelerator_mods, 3, "gtk_accel_label_set_accel", "GdkModifierType");
+ gtk_accel_label_set_accel(Xen_to_C_GtkAccelLabel_(accel_label), Xen_to_C_guint(accelerator_key), Xen_to_C_GdkModifierType(accelerator_mods));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_has_native(XEN window)
+static Xen gxg_gtk_menu_shell_bind_model(Xen menu_shell, Xen model, Xen action_namespace, Xen with_separators)
{
- #define H_gdk_window_has_native "gboolean gdk_window_has_native(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_has_native", "GdkWindow*");
- return(C_TO_XEN_gboolean(gdk_window_has_native(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_menu_shell_bind_model "void gtk_menu_shell_bind_model(GtkMenuShell* menu_shell, GMenuModel* model, \
+gchar* action_namespace, gboolean with_separators)"
+ Xen_check_type(Xen_is_GtkMenuShell_(menu_shell), menu_shell, 1, "gtk_menu_shell_bind_model", "GtkMenuShell*");
+ Xen_check_type(Xen_is_GMenuModel_(model), model, 2, "gtk_menu_shell_bind_model", "GMenuModel*");
+ Xen_check_type(Xen_is_gchar_(action_namespace), action_namespace, 3, "gtk_menu_shell_bind_model", "gchar*");
+ Xen_check_type(Xen_is_gboolean(with_separators), with_separators, 4, "gtk_menu_shell_bind_model", "gboolean");
+ gtk_menu_shell_bind_model(Xen_to_C_GtkMenuShell_(menu_shell), Xen_to_C_GMenuModel_(model), (const gchar*)Xen_to_C_gchar_(action_namespace),
+ Xen_to_C_gboolean(with_separators));
+ return(Xen_false);
}
-static XEN gxg_gdk_cursor_get_cursor_type(XEN cursor)
+#endif
+
+#if GTK_CHECK_VERSION(3, 8, 0)
+static Xen gxg_gtk_level_bar_set_inverted(Xen self, Xen inverted)
{
- #define H_gdk_cursor_get_cursor_type "GdkCursorType gdk_cursor_get_cursor_type(GdkCursor* cursor)"
- XEN_ASSERT_TYPE(XEN_GdkCursor__P(cursor), cursor, 1, "gdk_cursor_get_cursor_type", "GdkCursor*");
- return(C_TO_XEN_GdkCursorType(gdk_cursor_get_cursor_type(XEN_TO_C_GdkCursor_(cursor))));
+ #define H_gtk_level_bar_set_inverted "void gtk_level_bar_set_inverted(GtkLevelBar* self, gboolean inverted)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_set_inverted", "GtkLevelBar*");
+ Xen_check_type(Xen_is_gboolean(inverted), inverted, 2, "gtk_level_bar_set_inverted", "gboolean");
+ gtk_level_bar_set_inverted(Xen_to_C_GtkLevelBar_(self), Xen_to_C_gboolean(inverted));
+ return(Xen_false);
}
-static XEN gxg_gdk_display_is_closed(XEN display)
+static Xen gxg_gtk_level_bar_get_inverted(Xen self)
{
- #define H_gdk_display_is_closed "gboolean gdk_display_is_closed(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_display_is_closed", "GdkDisplay*");
- return(C_TO_XEN_gboolean(gdk_display_is_closed(XEN_TO_C_GdkDisplay_(display))));
+ #define H_gtk_level_bar_get_inverted "gboolean gtk_level_bar_get_inverted(GtkLevelBar* self)"
+ Xen_check_type(Xen_is_GtkLevelBar_(self), self, 1, "gtk_level_bar_get_inverted", "GtkLevelBar*");
+ return(C_to_Xen_gboolean(gtk_level_bar_get_inverted(Xen_to_C_GtkLevelBar_(self))));
}
-static XEN gxg_gdk_window_get_background_pattern(XEN window)
+static Xen gxg_gtk_widget_is_visible(Xen widget)
{
- #define H_gdk_window_get_background_pattern "cairo_pattern_t* gdk_window_get_background_pattern(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_background_pattern", "GdkWindow*");
- return(C_TO_XEN_cairo_pattern_t_(gdk_window_get_background_pattern(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_widget_is_visible "gboolean gtk_widget_is_visible(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_is_visible", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_is_visible(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gdk_window_create_similar_surface(XEN window, XEN content, XEN width, XEN height)
+static Xen gxg_gdk_window_set_fullscreen_mode(Xen window, Xen mode)
{
- #define H_gdk_window_create_similar_surface "cairo_surface_t* gdk_window_create_similar_surface(GdkWindow* window, \
-cairo_content_t content, int width, int height)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_create_similar_surface", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_cairo_content_t_P(content), content, 2, "gdk_window_create_similar_surface", "cairo_content_t");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 3, "gdk_window_create_similar_surface", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 4, "gdk_window_create_similar_surface", "int");
- return(C_TO_XEN_cairo_surface_t_(gdk_window_create_similar_surface(XEN_TO_C_GdkWindow_(window), XEN_TO_C_cairo_content_t(content),
- XEN_TO_C_int(width), XEN_TO_C_int(height))));
+ #define H_gdk_window_set_fullscreen_mode "void gdk_window_set_fullscreen_mode(GdkWindow* window, GdkFullscreenMode mode)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_fullscreen_mode", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkFullscreenMode(mode), mode, 2, "gdk_window_set_fullscreen_mode", "GdkFullscreenMode");
+ gdk_window_set_fullscreen_mode(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkFullscreenMode(mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_expander_set_label_fill(XEN expander, XEN label_fill)
+static Xen gxg_gdk_window_get_fullscreen_mode(Xen window)
{
- #define H_gtk_expander_set_label_fill "void gtk_expander_set_label_fill(GtkExpander* expander, gboolean label_fill)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_set_label_fill", "GtkExpander*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(label_fill), label_fill, 2, "gtk_expander_set_label_fill", "gboolean");
- gtk_expander_set_label_fill(XEN_TO_C_GtkExpander_(expander), XEN_TO_C_gboolean(label_fill));
- return(XEN_FALSE);
+ #define H_gdk_window_get_fullscreen_mode "GdkFullscreenMode gdk_window_get_fullscreen_mode(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_fullscreen_mode", "GdkWindow*");
+ return(C_to_Xen_GdkFullscreenMode(gdk_window_get_fullscreen_mode(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_expander_get_label_fill(XEN expander)
+static Xen gxg_gtk_icon_view_set_activate_on_single_click(Xen icon_view, Xen single)
{
- #define H_gtk_expander_get_label_fill "gboolean gtk_expander_get_label_fill(GtkExpander* expander)"
- XEN_ASSERT_TYPE(XEN_GtkExpander__P(expander), expander, 1, "gtk_expander_get_label_fill", "GtkExpander*");
- return(C_TO_XEN_gboolean(gtk_expander_get_label_fill(XEN_TO_C_GtkExpander_(expander))));
+ #define H_gtk_icon_view_set_activate_on_single_click "void gtk_icon_view_set_activate_on_single_click(GtkIconView* icon_view, \
+gboolean single)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_set_activate_on_single_click", "GtkIconView*");
+ Xen_check_type(Xen_is_gboolean(single), single, 2, "gtk_icon_view_set_activate_on_single_click", "gboolean");
+ gtk_icon_view_set_activate_on_single_click(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gboolean(single));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_tab_hborder(XEN notebook)
+static Xen gxg_gtk_icon_view_get_activate_on_single_click(Xen icon_view)
{
- #define H_gtk_notebook_get_tab_hborder "guint16 gtk_notebook_get_tab_hborder(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_tab_hborder", "GtkNotebook*");
- return(C_TO_XEN_guint16(gtk_notebook_get_tab_hborder(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_icon_view_get_activate_on_single_click "gboolean gtk_icon_view_get_activate_on_single_click(GtkIconView* icon_view)"
+ Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_get_activate_on_single_click", "GtkIconView*");
+ return(C_to_Xen_gboolean(gtk_icon_view_get_activate_on_single_click(Xen_to_C_GtkIconView_(icon_view))));
}
-static XEN gxg_gtk_notebook_get_tab_vborder(XEN notebook)
+static Xen gxg_gtk_tree_view_get_activate_on_single_click(Xen tree_view)
{
- #define H_gtk_notebook_get_tab_vborder "guint16 gtk_notebook_get_tab_vborder(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_tab_vborder", "GtkNotebook*");
- return(C_TO_XEN_guint16(gtk_notebook_get_tab_vborder(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_tree_view_get_activate_on_single_click "gboolean gtk_tree_view_get_activate_on_single_click(GtkTreeView* tree_view)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_get_activate_on_single_click", "GtkTreeView*");
+ return(C_to_Xen_gboolean(gtk_tree_view_get_activate_on_single_click(Xen_to_C_GtkTreeView_(tree_view))));
}
-static XEN gxg_gtk_calendar_get_day_is_marked(XEN calendar, XEN day)
+static Xen gxg_gtk_tree_view_set_activate_on_single_click(Xen tree_view, Xen single)
{
- #define H_gtk_calendar_get_day_is_marked "gboolean gtk_calendar_get_day_is_marked(GtkCalendar* calendar, \
-guint day)"
- XEN_ASSERT_TYPE(XEN_GtkCalendar__P(calendar), calendar, 1, "gtk_calendar_get_day_is_marked", "GtkCalendar*");
- XEN_ASSERT_TYPE(XEN_guint_P(day), day, 2, "gtk_calendar_get_day_is_marked", "guint");
- return(C_TO_XEN_gboolean(gtk_calendar_get_day_is_marked(XEN_TO_C_GtkCalendar_(calendar), XEN_TO_C_guint(day))));
+ #define H_gtk_tree_view_set_activate_on_single_click "void gtk_tree_view_set_activate_on_single_click(GtkTreeView* tree_view, \
+gboolean single)"
+ Xen_check_type(Xen_is_GtkTreeView_(tree_view), tree_view, 1, "gtk_tree_view_set_activate_on_single_click", "GtkTreeView*");
+ Xen_check_type(Xen_is_gboolean(single), single, 2, "gtk_tree_view_set_activate_on_single_click", "gboolean");
+ gtk_tree_view_set_activate_on_single_click(Xen_to_C_GtkTreeView_(tree_view), Xen_to_C_gboolean(single));
+ return(Xen_false);
}
-static XEN gxg_gtk_progress_bar_set_inverted(XEN pbar, XEN inverted)
+static Xen gxg_gtk_widget_register_window(Xen widget, Xen window)
{
- #define H_gtk_progress_bar_set_inverted "void gtk_progress_bar_set_inverted(GtkProgressBar* pbar, gboolean inverted)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_set_inverted", "GtkProgressBar*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(inverted), inverted, 2, "gtk_progress_bar_set_inverted", "gboolean");
- gtk_progress_bar_set_inverted(XEN_TO_C_GtkProgressBar_(pbar), XEN_TO_C_gboolean(inverted));
- return(XEN_FALSE);
+ #define H_gtk_widget_register_window "void gtk_widget_register_window(GtkWidget* widget, GdkWindow* window)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_register_window", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 2, "gtk_widget_register_window", "GdkWindow*");
+ gtk_widget_register_window(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_progress_bar_get_inverted(XEN pbar)
+static Xen gxg_gtk_widget_unregister_window(Xen widget, Xen window)
{
- #define H_gtk_progress_bar_get_inverted "gboolean gtk_progress_bar_get_inverted(GtkProgressBar* pbar)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_get_inverted", "GtkProgressBar*");
- return(C_TO_XEN_gboolean(gtk_progress_bar_get_inverted(XEN_TO_C_GtkProgressBar_(pbar))));
+ #define H_gtk_widget_unregister_window "void gtk_widget_unregister_window(GtkWidget* widget, GdkWindow* window)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_unregister_window", "GtkWidget*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 2, "gtk_widget_unregister_window", "GdkWindow*");
+ gtk_widget_unregister_window(Xen_to_C_GtkWidget_(widget), Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_radio_button_join_group(XEN radio_button, XEN group_source)
+static Xen gxg_gtk_widget_set_opacity(Xen widget, Xen opacity)
{
- #define H_gtk_radio_button_join_group "void gtk_radio_button_join_group(GtkRadioButton* radio_button, \
-GtkRadioButton* group_source)"
- XEN_ASSERT_TYPE(XEN_GtkRadioButton__P(radio_button), radio_button, 1, "gtk_radio_button_join_group", "GtkRadioButton*");
- XEN_ASSERT_TYPE(XEN_GtkRadioButton__P(group_source), group_source, 2, "gtk_radio_button_join_group", "GtkRadioButton*");
- gtk_radio_button_join_group(XEN_TO_C_GtkRadioButton_(radio_button), XEN_TO_C_GtkRadioButton_(group_source));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_opacity "void gtk_widget_set_opacity(GtkWidget* widget, double opacity)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_opacity", "GtkWidget*");
+ Xen_check_type(Xen_is_double(opacity), opacity, 2, "gtk_widget_set_opacity", "double");
+ gtk_widget_set_opacity(Xen_to_C_GtkWidget_(widget), Xen_to_C_double(opacity));
+ return(Xen_false);
}
-static XEN gxg_gtk_adjustment_new(XEN value, XEN lower, XEN upper, XEN step_increment, XEN page_increment, XEN page_size)
+static Xen gxg_gtk_widget_get_opacity(Xen widget)
{
- #define H_gtk_adjustment_new "GtkAdjustment* gtk_adjustment_new(gdouble value, gdouble lower, gdouble upper, \
-gdouble step_increment, gdouble page_increment, gdouble page_size)"
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 1, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(lower), lower, 2, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(upper), upper, 3, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step_increment), step_increment, 4, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page_increment), page_increment, 5, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page_size), page_size, 6, "gtk_adjustment_new", "gdouble");
- return(C_TO_XEN_GtkAdjustment_(gtk_adjustment_new(XEN_TO_C_gdouble(value), XEN_TO_C_gdouble(lower), XEN_TO_C_gdouble(upper),
- XEN_TO_C_gdouble(step_increment), XEN_TO_C_gdouble(page_increment), XEN_TO_C_gdouble(page_size))));
+ #define H_gtk_widget_get_opacity "double gtk_widget_get_opacity(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_opacity", "GtkWidget*");
+ return(C_to_Xen_double(gtk_widget_get_opacity(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_binding_set_activate(XEN binding_set, XEN keyval, XEN modifiers, XEN object)
+static Xen gxg_pango_font_map_changed(Xen fontmap)
{
- #define H_gtk_binding_set_activate "gboolean gtk_binding_set_activate(GtkBindingSet* binding_set, guint keyval, \
-GdkModifierType modifiers, GObject* object)"
- XEN_ASSERT_TYPE(XEN_GtkBindingSet__P(binding_set), binding_set, 1, "gtk_binding_set_activate", "GtkBindingSet*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_binding_set_activate", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifiers), modifiers, 3, "gtk_binding_set_activate", "GdkModifierType");
- XEN_ASSERT_TYPE(XEN_GObject__P(object), object, 4, "gtk_binding_set_activate", "GObject*");
- return(C_TO_XEN_gboolean(gtk_binding_set_activate(XEN_TO_C_GtkBindingSet_(binding_set), XEN_TO_C_guint(keyval), XEN_TO_C_GdkModifierType(modifiers),
- XEN_TO_C_GObject_(object))));
+ #define H_pango_font_map_changed "void pango_font_map_changed(PangoFontMap* fontmap)"
+ Xen_check_type(Xen_is_PangoFontMap_(fontmap), fontmap, 1, "pango_font_map_changed", "PangoFontMap*");
+ pango_font_map_changed(Xen_to_C_PangoFontMap_(fontmap));
+ return(Xen_false);
}
-static XEN gxg_gtk_bindings_activate(XEN object, XEN keyval, XEN modifiers)
+#endif
+
+#if GTK_CHECK_VERSION(3, 10, 0)
+static Xen gxg_gdk_set_allowed_backends(Xen backends)
{
- #define H_gtk_bindings_activate "gboolean gtk_bindings_activate(GObject* object, guint keyval, GdkModifierType modifiers)"
- XEN_ASSERT_TYPE(XEN_GObject__P(object), object, 1, "gtk_bindings_activate", "GObject*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_bindings_activate", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifiers), modifiers, 3, "gtk_bindings_activate", "GdkModifierType");
- return(C_TO_XEN_gboolean(gtk_bindings_activate(XEN_TO_C_GObject_(object), XEN_TO_C_guint(keyval), XEN_TO_C_GdkModifierType(modifiers))));
+ #define H_gdk_set_allowed_backends "void gdk_set_allowed_backends(gchar* backends)"
+ Xen_check_type(Xen_is_gchar_(backends), backends, 1, "gdk_set_allowed_backends", "gchar*");
+ gdk_set_allowed_backends((const gchar*)Xen_to_C_gchar_(backends));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_create_drag_icon(XEN icon_view, XEN path)
+static Xen gxg_gtk_box_set_baseline_position(Xen box, Xen position)
{
- #define H_gtk_icon_view_create_drag_icon "cairo_surface_t* gtk_icon_view_create_drag_icon(GtkIconView* icon_view, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_create_drag_icon", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_icon_view_create_drag_icon", "GtkTreePath*");
- return(C_TO_XEN_cairo_surface_t_(gtk_icon_view_create_drag_icon(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_box_set_baseline_position "void gtk_box_set_baseline_position(GtkBox* box, GtkBaselinePosition position)"
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_set_baseline_position", "GtkBox*");
+ Xen_check_type(Xen_is_GtkBaselinePosition(position), position, 2, "gtk_box_set_baseline_position", "GtkBaselinePosition");
+ gtk_box_set_baseline_position(Xen_to_C_GtkBox_(box), Xen_to_C_GtkBaselinePosition(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_create_row_drag_icon(XEN tree_view, XEN path)
+static Xen gxg_gtk_box_get_baseline_position(Xen box)
{
- #define H_gtk_tree_view_create_row_drag_icon "cairo_surface_t* gtk_tree_view_create_row_drag_icon(GtkTreeView* tree_view, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_create_row_drag_icon", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_create_row_drag_icon", "GtkTreePath*");
- return(C_TO_XEN_cairo_surface_t_(gtk_tree_view_create_row_drag_icon(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_box_get_baseline_position "GtkBaselinePosition gtk_box_get_baseline_position(GtkBox* box)"
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_get_baseline_position", "GtkBox*");
+ return(C_to_Xen_GtkBaselinePosition(gtk_box_get_baseline_position(Xen_to_C_GtkBox_(box))));
}
-static XEN gxg_gdk_cairo_get_clip_rectangle(XEN cr, XEN rect)
+static Xen gxg_gtk_grid_remove_row(Xen grid, Xen position)
{
- #define H_gdk_cairo_get_clip_rectangle "gboolean gdk_cairo_get_clip_rectangle(cairo_t* cr, GdkRectangle* rect)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "gdk_cairo_get_clip_rectangle", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rect), rect, 2, "gdk_cairo_get_clip_rectangle", "GdkRectangle*");
- return(C_TO_XEN_gboolean(gdk_cairo_get_clip_rectangle(XEN_TO_C_cairo_t_(cr), XEN_TO_C_GdkRectangle_(rect))));
+ #define H_gtk_grid_remove_row "void gtk_grid_remove_row(GtkGrid* grid, gint position)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_remove_row", "GtkGrid*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_grid_remove_row", "gint");
+ gtk_grid_remove_row(Xen_to_C_GtkGrid_(grid), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gdk_cairo_region_create_from_surface(XEN surface)
+static Xen gxg_gtk_grid_remove_column(Xen grid, Xen position)
{
- #define H_gdk_cairo_region_create_from_surface "cairo_region_t* gdk_cairo_region_create_from_surface(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "gdk_cairo_region_create_from_surface", "cairo_surface_t*");
- return(C_TO_XEN_cairo_region_t_(gdk_cairo_region_create_from_surface(XEN_TO_C_cairo_surface_t_(surface))));
+ #define H_gtk_grid_remove_column "void gtk_grid_remove_column(GtkGrid* grid, gint position)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_remove_column", "GtkGrid*");
+ Xen_check_type(Xen_is_gint(position), position, 2, "gtk_grid_remove_column", "gint");
+ gtk_grid_remove_column(Xen_to_C_GtkGrid_(grid), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_visual(XEN window)
+static Xen gxg_gtk_grid_set_row_baseline_position(Xen grid, Xen row, Xen pos)
{
- #define H_gdk_window_get_visual "GdkVisual* gdk_window_get_visual(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_visual", "GdkWindow*");
- return(C_TO_XEN_GdkVisual_(gdk_window_get_visual(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_grid_set_row_baseline_position "void gtk_grid_set_row_baseline_position(GtkGrid* grid, \
+gint row, GtkBaselinePosition pos)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_set_row_baseline_position", "GtkGrid*");
+ Xen_check_type(Xen_is_gint(row), row, 2, "gtk_grid_set_row_baseline_position", "gint");
+ Xen_check_type(Xen_is_GtkBaselinePosition(pos), pos, 3, "gtk_grid_set_row_baseline_position", "GtkBaselinePosition");
+ gtk_grid_set_row_baseline_position(Xen_to_C_GtkGrid_(grid), Xen_to_C_gint(row), Xen_to_C_GtkBaselinePosition(pos));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_screen(XEN window)
+static Xen gxg_gtk_grid_get_row_baseline_position(Xen grid, Xen row)
{
- #define H_gdk_window_get_screen "GdkScreen* gdk_window_get_screen(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_screen", "GdkWindow*");
- return(C_TO_XEN_GdkScreen_(gdk_window_get_screen(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_grid_get_row_baseline_position "GtkBaselinePosition gtk_grid_get_row_baseline_position(GtkGrid* grid, \
+gint row)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_get_row_baseline_position", "GtkGrid*");
+ Xen_check_type(Xen_is_gint(row), row, 2, "gtk_grid_get_row_baseline_position", "gint");
+ return(C_to_Xen_GtkBaselinePosition(gtk_grid_get_row_baseline_position(Xen_to_C_GtkGrid_(grid), Xen_to_C_gint(row))));
}
-static XEN gxg_gdk_window_get_display(XEN window)
+static Xen gxg_gtk_grid_set_baseline_row(Xen grid, Xen row)
{
- #define H_gdk_window_get_display "GdkDisplay* gdk_window_get_display(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_display", "GdkWindow*");
- return(C_TO_XEN_GdkDisplay_(gdk_window_get_display(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_grid_set_baseline_row "void gtk_grid_set_baseline_row(GtkGrid* grid, gint row)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_set_baseline_row", "GtkGrid*");
+ Xen_check_type(Xen_is_gint(row), row, 2, "gtk_grid_set_baseline_row", "gint");
+ gtk_grid_set_baseline_row(Xen_to_C_GtkGrid_(grid), Xen_to_C_gint(row));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_width(XEN window)
+static Xen gxg_gtk_grid_get_baseline_row(Xen grid)
{
- #define H_gdk_window_get_width "int gdk_window_get_width(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_width", "GdkWindow*");
- return(C_TO_XEN_int(gdk_window_get_width(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_grid_get_baseline_row "gint gtk_grid_get_baseline_row(GtkGrid* grid)"
+ Xen_check_type(Xen_is_GtkGrid_(grid), grid, 1, "gtk_grid_get_baseline_row", "GtkGrid*");
+ return(C_to_Xen_gint(gtk_grid_get_baseline_row(Xen_to_C_GtkGrid_(grid))));
}
-static XEN gxg_gdk_window_get_height(XEN window)
+static Xen gxg_gtk_widget_size_allocate_with_baseline(Xen widget, Xen allocation, Xen baseline)
{
- #define H_gdk_window_get_height "int gdk_window_get_height(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_height", "GdkWindow*");
- return(C_TO_XEN_int(gdk_window_get_height(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_widget_size_allocate_with_baseline "void gtk_widget_size_allocate_with_baseline(GtkWidget* widget, \
+GtkAllocation* allocation, gint baseline)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_size_allocate_with_baseline", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAllocation_(allocation), allocation, 2, "gtk_widget_size_allocate_with_baseline", "GtkAllocation*");
+ Xen_check_type(Xen_is_gint(baseline), baseline, 3, "gtk_widget_size_allocate_with_baseline", "gint");
+ gtk_widget_size_allocate_with_baseline(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAllocation_(allocation), Xen_to_C_gint(baseline));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_get_request_mode(XEN cell)
+static Xen gxg_gtk_widget_get_preferred_height_and_baseline_for_width(Xen widget, Xen width, Xen ignore_minimum_height, Xen ignore_natural_height, Xen ignore_minimum_baseline, Xen ignore_natural_baseline)
{
- #define H_gtk_cell_renderer_get_request_mode "GtkSizeRequestMode gtk_cell_renderer_get_request_mode(GtkCellRenderer* cell)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_request_mode", "GtkCellRenderer*");
- return(C_TO_XEN_GtkSizeRequestMode(gtk_cell_renderer_get_request_mode(XEN_TO_C_GtkCellRenderer_(cell))));
+ #define H_gtk_widget_get_preferred_height_and_baseline_for_width "void gtk_widget_get_preferred_height_and_baseline_for_width(GtkWidget* widget, \
+gint width, gint* [minimum_height], gint* [natural_height], gint* [minimum_baseline], gint* [natural_baseline])"
+ gint ref_minimum_height;
+ gint ref_natural_height;
+ gint ref_minimum_baseline;
+ gint ref_natural_baseline;
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_preferred_height_and_baseline_for_width", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(width), width, 2, "gtk_widget_get_preferred_height_and_baseline_for_width", "gint");
+ gtk_widget_get_preferred_height_and_baseline_for_width(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(width), &ref_minimum_height,
+ &ref_natural_height, &ref_minimum_baseline, &ref_natural_baseline);
+ return(Xen_list_4(C_to_Xen_gint(ref_minimum_height), C_to_Xen_gint(ref_natural_height), C_to_Xen_gint(ref_minimum_baseline), C_to_Xen_gint(ref_natural_baseline)));
}
-static XEN gxg_gtk_cell_renderer_get_preferred_width(XEN cell, XEN widget, XEN ignore_minimum_size, XEN ignore_natural_size)
+static Xen gxg_gtk_widget_get_allocated_baseline(Xen widget)
{
- #define H_gtk_cell_renderer_get_preferred_width "void gtk_cell_renderer_get_preferred_width(GtkCellRenderer* cell, \
-GtkWidget* widget, gint* [minimum_size], gint* [natural_size])"
- gint ref_minimum_size;
- gint ref_natural_size;
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_preferred_width", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_cell_renderer_get_preferred_width", "GtkWidget*");
- gtk_cell_renderer_get_preferred_width(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GtkWidget_(widget), &ref_minimum_size,
- &ref_natural_size);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_minimum_size), C_TO_XEN_gint(ref_natural_size)));
+ #define H_gtk_widget_get_allocated_baseline "int gtk_widget_get_allocated_baseline(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_allocated_baseline", "GtkWidget*");
+ return(C_to_Xen_int(gtk_widget_get_allocated_baseline(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_cell_renderer_get_preferred_height_for_width(XEN cell, XEN widget, XEN width, XEN ignore_minimum_height, XEN ignore_natural_height)
+static Xen gxg_gtk_widget_get_valign_with_baseline(Xen widget)
{
- #define H_gtk_cell_renderer_get_preferred_height_for_width "void gtk_cell_renderer_get_preferred_height_for_width(GtkCellRenderer* cell, \
-GtkWidget* widget, gint width, gint* [minimum_height], gint* [natural_height])"
- gint ref_minimum_height;
- gint ref_natural_height;
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_preferred_height_for_width", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_cell_renderer_get_preferred_height_for_width", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 3, "gtk_cell_renderer_get_preferred_height_for_width", "gint");
- gtk_cell_renderer_get_preferred_height_for_width(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(width),
- &ref_minimum_height, &ref_natural_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_minimum_height), C_TO_XEN_gint(ref_natural_height)));
+ #define H_gtk_widget_get_valign_with_baseline "GtkAlign gtk_widget_get_valign_with_baseline(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_valign_with_baseline", "GtkWidget*");
+ return(C_to_Xen_GtkAlign(gtk_widget_get_valign_with_baseline(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_cell_renderer_get_preferred_height(XEN cell, XEN widget, XEN ignore_minimum_size, XEN ignore_natural_size)
+static Xen gxg_gtk_widget_init_template(Xen widget)
{
- #define H_gtk_cell_renderer_get_preferred_height "void gtk_cell_renderer_get_preferred_height(GtkCellRenderer* cell, \
-GtkWidget* widget, gint* [minimum_size], gint* [natural_size])"
- gint ref_minimum_size;
- gint ref_natural_size;
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_preferred_height", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_cell_renderer_get_preferred_height", "GtkWidget*");
- gtk_cell_renderer_get_preferred_height(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GtkWidget_(widget), &ref_minimum_size,
- &ref_natural_size);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_minimum_size), C_TO_XEN_gint(ref_natural_size)));
+ #define H_gtk_widget_init_template "void gtk_widget_init_template(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_init_template", "GtkWidget*");
+ gtk_widget_init_template(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_get_preferred_width_for_height(XEN cell, XEN widget, XEN height, XEN ignore_minimum_width, XEN ignore_natural_width)
+static Xen gxg_gtk_window_set_titlebar(Xen window, Xen titlebar)
{
- #define H_gtk_cell_renderer_get_preferred_width_for_height "void gtk_cell_renderer_get_preferred_width_for_height(GtkCellRenderer* cell, \
-GtkWidget* widget, gint height, gint* [minimum_width], gint* [natural_width])"
- gint ref_minimum_width;
- gint ref_natural_width;
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_preferred_width_for_height", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_cell_renderer_get_preferred_width_for_height", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gtk_cell_renderer_get_preferred_width_for_height", "gint");
- gtk_cell_renderer_get_preferred_width_for_height(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(height),
- &ref_minimum_width, &ref_natural_width);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_minimum_width), C_TO_XEN_gint(ref_natural_width)));
+ #define H_gtk_window_set_titlebar "void gtk_window_set_titlebar(GtkWindow* window, GtkWidget* titlebar)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_set_titlebar", "GtkWindow*");
+ Xen_check_type(Xen_is_GtkWidget_(titlebar), titlebar, 2, "gtk_window_set_titlebar", "GtkWidget*");
+ gtk_window_set_titlebar(Xen_to_C_GtkWindow_(window), Xen_to_C_GtkWidget_(titlebar));
+ return(Xen_false);
}
-static XEN gxg_gtk_container_class_handle_border_width(XEN klass)
+static Xen gxg_gtk_places_sidebar_new(void)
{
- #define H_gtk_container_class_handle_border_width "void gtk_container_class_handle_border_width(GtkContainerClass* klass)"
- XEN_ASSERT_TYPE(XEN_GtkContainerClass__P(klass), klass, 1, "gtk_container_class_handle_border_width", "GtkContainerClass*");
- gtk_container_class_handle_border_width(XEN_TO_C_GtkContainerClass_(klass));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_new "GtkWidget* gtk_places_sidebar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_places_sidebar_new()));
}
-static XEN gxg_gtk_drag_set_icon_surface(XEN context, XEN surface)
+static Xen gxg_gtk_places_sidebar_get_open_flags(Xen sidebar)
{
- #define H_gtk_drag_set_icon_surface "void gtk_drag_set_icon_surface(GdkDragContext* context, cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_set_icon_surface", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 2, "gtk_drag_set_icon_surface", "cairo_surface_t*");
- gtk_drag_set_icon_surface(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_cairo_surface_t_(surface));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_get_open_flags "GtkPlacesOpenFlags gtk_places_sidebar_get_open_flags(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_open_flags", "GtkPlacesSidebar*");
+ return(C_to_Xen_GtkPlacesOpenFlags(gtk_places_sidebar_get_open_flags(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_notebook_set_group_name(XEN notebook, XEN group_name)
+static Xen gxg_gtk_places_sidebar_set_open_flags(Xen sidebar, Xen flags)
{
- #define H_gtk_notebook_set_group_name "void gtk_notebook_set_group_name(GtkNotebook* notebook, gchar* group_name)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_set_group_name", "GtkNotebook*");
- XEN_ASSERT_TYPE(XEN_gchar__P(group_name), group_name, 2, "gtk_notebook_set_group_name", "gchar*");
- gtk_notebook_set_group_name(XEN_TO_C_GtkNotebook_(notebook), (const gchar*)XEN_TO_C_gchar_(group_name));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_set_open_flags "void gtk_places_sidebar_set_open_flags(GtkPlacesSidebar* sidebar, \
+GtkPlacesOpenFlags flags)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_open_flags", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_GtkPlacesOpenFlags(flags), flags, 2, "gtk_places_sidebar_set_open_flags", "GtkPlacesOpenFlags");
+ gtk_places_sidebar_set_open_flags(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_GtkPlacesOpenFlags(flags));
+ return(Xen_false);
}
-static XEN gxg_gtk_notebook_get_group_name(XEN notebook)
+static Xen gxg_gtk_places_sidebar_get_location(Xen sidebar)
{
- #define H_gtk_notebook_get_group_name "gchar* gtk_notebook_get_group_name(GtkNotebook* notebook)"
- XEN_ASSERT_TYPE(XEN_GtkNotebook__P(notebook), notebook, 1, "gtk_notebook_get_group_name", "GtkNotebook*");
- return(C_TO_XEN_gchar_((gchar*)gtk_notebook_get_group_name(XEN_TO_C_GtkNotebook_(notebook))));
+ #define H_gtk_places_sidebar_get_location "GFile* gtk_places_sidebar_get_location(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_location", "GtkPlacesSidebar*");
+ return(C_to_Xen_GFile_(gtk_places_sidebar_get_location(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_widget_draw(XEN widget, XEN cr)
+static Xen gxg_gtk_places_sidebar_set_location(Xen sidebar, Xen location)
{
- #define H_gtk_widget_draw "void gtk_widget_draw(GtkWidget* widget, cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_draw", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 2, "gtk_widget_draw", "cairo_t*");
- gtk_widget_draw(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_set_location "void gtk_places_sidebar_set_location(GtkPlacesSidebar* sidebar, \
+GFile* location)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_location", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_GFile_(location), location, 2, "gtk_places_sidebar_set_location", "GFile*");
+ gtk_places_sidebar_set_location(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_GFile_(location));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_request_mode(XEN widget)
+static Xen gxg_gtk_places_sidebar_get_show_desktop(Xen sidebar)
{
- #define H_gtk_widget_get_request_mode "GtkSizeRequestMode gtk_widget_get_request_mode(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_request_mode", "GtkWidget*");
- return(C_TO_XEN_GtkSizeRequestMode(gtk_widget_get_request_mode(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_places_sidebar_get_show_desktop "gboolean gtk_places_sidebar_get_show_desktop(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_show_desktop", "GtkPlacesSidebar*");
+ return(C_to_Xen_gboolean(gtk_places_sidebar_get_show_desktop(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_widget_get_preferred_width(XEN widget, XEN ignore_minimum_width, XEN ignore_natural_width)
+static Xen gxg_gtk_places_sidebar_set_show_desktop(Xen sidebar, Xen show_desktop)
{
- #define H_gtk_widget_get_preferred_width "void gtk_widget_get_preferred_width(GtkWidget* widget, gint* [minimum_width], \
-gint* [natural_width])"
- gint ref_minimum_width;
- gint ref_natural_width;
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_preferred_width", "GtkWidget*");
- gtk_widget_get_preferred_width(XEN_TO_C_GtkWidget_(widget), &ref_minimum_width, &ref_natural_width);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_minimum_width), C_TO_XEN_gint(ref_natural_width)));
+ #define H_gtk_places_sidebar_set_show_desktop "void gtk_places_sidebar_set_show_desktop(GtkPlacesSidebar* sidebar, \
+gboolean show_desktop)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_show_desktop", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_gboolean(show_desktop), show_desktop, 2, "gtk_places_sidebar_set_show_desktop", "gboolean");
+ gtk_places_sidebar_set_show_desktop(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_gboolean(show_desktop));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_preferred_height_for_width(XEN widget, XEN width, XEN ignore_minimum_height, XEN ignore_natural_height)
+static Xen gxg_gtk_places_sidebar_add_shortcut(Xen sidebar, Xen location)
{
- #define H_gtk_widget_get_preferred_height_for_width "void gtk_widget_get_preferred_height_for_width(GtkWidget* widget, \
-gint width, gint* [minimum_height], gint* [natural_height])"
- gint ref_minimum_height;
- gint ref_natural_height;
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_preferred_height_for_width", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_widget_get_preferred_height_for_width", "gint");
- gtk_widget_get_preferred_height_for_width(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(width), &ref_minimum_height, &ref_natural_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_minimum_height), C_TO_XEN_gint(ref_natural_height)));
+ #define H_gtk_places_sidebar_add_shortcut "void gtk_places_sidebar_add_shortcut(GtkPlacesSidebar* sidebar, \
+GFile* location)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_add_shortcut", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_GFile_(location), location, 2, "gtk_places_sidebar_add_shortcut", "GFile*");
+ gtk_places_sidebar_add_shortcut(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_GFile_(location));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_preferred_height(XEN widget, XEN ignore_minimum_height, XEN ignore_natural_height)
+static Xen gxg_gtk_places_sidebar_remove_shortcut(Xen sidebar, Xen location)
{
- #define H_gtk_widget_get_preferred_height "void gtk_widget_get_preferred_height(GtkWidget* widget, \
-gint* [minimum_height], gint* [natural_height])"
- gint ref_minimum_height;
- gint ref_natural_height;
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_preferred_height", "GtkWidget*");
- gtk_widget_get_preferred_height(XEN_TO_C_GtkWidget_(widget), &ref_minimum_height, &ref_natural_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_minimum_height), C_TO_XEN_gint(ref_natural_height)));
+ #define H_gtk_places_sidebar_remove_shortcut "void gtk_places_sidebar_remove_shortcut(GtkPlacesSidebar* sidebar, \
+GFile* location)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_remove_shortcut", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_GFile_(location), location, 2, "gtk_places_sidebar_remove_shortcut", "GFile*");
+ gtk_places_sidebar_remove_shortcut(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_GFile_(location));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_preferred_width_for_height(XEN widget, XEN height, XEN ignore_minimum_width, XEN ignore_natural_width)
+static Xen gxg_gtk_places_sidebar_list_shortcuts(Xen sidebar)
{
- #define H_gtk_widget_get_preferred_width_for_height "void gtk_widget_get_preferred_width_for_height(GtkWidget* widget, \
-gint height, gint* [minimum_width], gint* [natural_width])"
- gint ref_minimum_width;
- gint ref_natural_width;
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_preferred_width_for_height", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 2, "gtk_widget_get_preferred_width_for_height", "gint");
- gtk_widget_get_preferred_width_for_height(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(height), &ref_minimum_width, &ref_natural_width);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_minimum_width), C_TO_XEN_gint(ref_natural_width)));
+ #define H_gtk_places_sidebar_list_shortcuts "GSList* gtk_places_sidebar_list_shortcuts(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_list_shortcuts", "GtkPlacesSidebar*");
+ return(C_to_Xen_GSList_(gtk_places_sidebar_list_shortcuts(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_widget_get_allocated_width(XEN widget)
+static Xen gxg_gtk_places_sidebar_get_nth_bookmark(Xen sidebar, Xen n)
{
- #define H_gtk_widget_get_allocated_width "int gtk_widget_get_allocated_width(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_allocated_width", "GtkWidget*");
- return(C_TO_XEN_int(gtk_widget_get_allocated_width(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_places_sidebar_get_nth_bookmark "GFile* gtk_places_sidebar_get_nth_bookmark(GtkPlacesSidebar* sidebar, \
+gint n)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_nth_bookmark", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_gint(n), n, 2, "gtk_places_sidebar_get_nth_bookmark", "gint");
+ return(C_to_Xen_GFile_(gtk_places_sidebar_get_nth_bookmark(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_gint(n))));
}
-static XEN gxg_gtk_widget_get_allocated_height(XEN widget)
+static Xen gxg_gtk_stack_switcher_new(void)
{
- #define H_gtk_widget_get_allocated_height "int gtk_widget_get_allocated_height(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_allocated_height", "GtkWidget*");
- return(C_TO_XEN_int(gtk_widget_get_allocated_height(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_stack_switcher_new "GtkWidget* gtk_stack_switcher_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_stack_switcher_new()));
}
-static XEN gxg_gtk_widget_set_visual(XEN widget, XEN visual)
+static Xen gxg_gtk_stack_switcher_set_stack(Xen switcher, Xen stack)
{
- #define H_gtk_widget_set_visual "void gtk_widget_set_visual(GtkWidget* widget, GdkVisual* visual)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_visual", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkVisual__P(visual), visual, 2, "gtk_widget_set_visual", "GdkVisual*");
- gtk_widget_set_visual(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkVisual_(visual));
- return(XEN_FALSE);
+ #define H_gtk_stack_switcher_set_stack "void gtk_stack_switcher_set_stack(GtkStackSwitcher* switcher, \
+GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStackSwitcher_(switcher), switcher, 1, "gtk_stack_switcher_set_stack", "GtkStackSwitcher*");
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 2, "gtk_stack_switcher_set_stack", "GtkStack*");
+ gtk_stack_switcher_set_stack(Xen_to_C_GtkStackSwitcher_(switcher), Xen_to_C_GtkStack_(stack));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_halign(XEN widget)
+static Xen gxg_gtk_stack_switcher_get_stack(Xen switcher)
{
- #define H_gtk_widget_get_halign "GtkAlign gtk_widget_get_halign(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_halign", "GtkWidget*");
- return(C_TO_XEN_GtkAlign(gtk_widget_get_halign(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_stack_switcher_get_stack "GtkStack* gtk_stack_switcher_get_stack(GtkStackSwitcher* switcher)"
+ Xen_check_type(Xen_is_GtkStackSwitcher_(switcher), switcher, 1, "gtk_stack_switcher_get_stack", "GtkStackSwitcher*");
+ return(C_to_Xen_GtkStack_(gtk_stack_switcher_get_stack(Xen_to_C_GtkStackSwitcher_(switcher))));
}
-static XEN gxg_gtk_widget_set_halign(XEN widget, XEN align)
+static Xen gxg_gtk_stack_new(void)
{
- #define H_gtk_widget_set_halign "void gtk_widget_set_halign(GtkWidget* widget, GtkAlign align)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_halign", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkAlign_P(align), align, 2, "gtk_widget_set_halign", "GtkAlign");
- gtk_widget_set_halign(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkAlign(align));
- return(XEN_FALSE);
+ #define H_gtk_stack_new "GtkWidget* gtk_stack_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_stack_new()));
}
-static XEN gxg_gtk_widget_get_valign(XEN widget)
+static Xen gxg_gtk_stack_add_named(Xen stack, Xen child, Xen name)
{
- #define H_gtk_widget_get_valign "GtkAlign gtk_widget_get_valign(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_valign", "GtkWidget*");
- return(C_TO_XEN_GtkAlign(gtk_widget_get_valign(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_stack_add_named "void gtk_stack_add_named(GtkStack* stack, GtkWidget* child, gchar* name)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_add_named", "GtkStack*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_stack_add_named", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(name), name, 3, "gtk_stack_add_named", "gchar*");
+ gtk_stack_add_named(Xen_to_C_GtkStack_(stack), Xen_to_C_GtkWidget_(child), (const gchar*)Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_valign(XEN widget, XEN align)
+static Xen gxg_gtk_stack_add_titled(Xen stack, Xen child, Xen name, Xen title)
{
- #define H_gtk_widget_set_valign "void gtk_widget_set_valign(GtkWidget* widget, GtkAlign align)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_valign", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkAlign_P(align), align, 2, "gtk_widget_set_valign", "GtkAlign");
- gtk_widget_set_valign(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkAlign(align));
- return(XEN_FALSE);
+ #define H_gtk_stack_add_titled "void gtk_stack_add_titled(GtkStack* stack, GtkWidget* child, gchar* name, \
+gchar* title)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_add_titled", "GtkStack*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_stack_add_titled", "GtkWidget*");
+ Xen_check_type(Xen_is_gchar_(name), name, 3, "gtk_stack_add_titled", "gchar*");
+ Xen_check_type(Xen_is_gchar_(title), title, 4, "gtk_stack_add_titled", "gchar*");
+ gtk_stack_add_titled(Xen_to_C_GtkStack_(stack), Xen_to_C_GtkWidget_(child), (const gchar*)Xen_to_C_gchar_(name), (const gchar*)Xen_to_C_gchar_(title));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_margin_left(XEN widget)
+static Xen gxg_gtk_stack_set_visible_child(Xen stack, Xen child)
{
- #define H_gtk_widget_get_margin_left "gint gtk_widget_get_margin_left(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_margin_left", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_widget_get_margin_left(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_stack_set_visible_child "void gtk_stack_set_visible_child(GtkStack* stack, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_visible_child", "GtkStack*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_stack_set_visible_child", "GtkWidget*");
+ gtk_stack_set_visible_child(Xen_to_C_GtkStack_(stack), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_margin_left(XEN widget, XEN margin)
+static Xen gxg_gtk_stack_get_visible_child(Xen stack)
{
- #define H_gtk_widget_set_margin_left "void gtk_widget_set_margin_left(GtkWidget* widget, gint margin)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_margin_left", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(margin), margin, 2, "gtk_widget_set_margin_left", "gint");
- gtk_widget_set_margin_left(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(margin));
- return(XEN_FALSE);
+ #define H_gtk_stack_get_visible_child "GtkWidget* gtk_stack_get_visible_child(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_visible_child", "GtkStack*");
+ return(C_to_Xen_GtkWidget_(gtk_stack_get_visible_child(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gtk_widget_get_margin_right(XEN widget)
+static Xen gxg_gtk_stack_set_visible_child_name(Xen stack, Xen name)
{
- #define H_gtk_widget_get_margin_right "gint gtk_widget_get_margin_right(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_margin_right", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_widget_get_margin_right(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_stack_set_visible_child_name "void gtk_stack_set_visible_child_name(GtkStack* stack, \
+gchar* name)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_visible_child_name", "GtkStack*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_stack_set_visible_child_name", "gchar*");
+ gtk_stack_set_visible_child_name(Xen_to_C_GtkStack_(stack), (const gchar*)Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_margin_right(XEN widget, XEN margin)
+static Xen gxg_gtk_stack_get_visible_child_name(Xen stack)
{
- #define H_gtk_widget_set_margin_right "void gtk_widget_set_margin_right(GtkWidget* widget, gint margin)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_margin_right", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(margin), margin, 2, "gtk_widget_set_margin_right", "gint");
- gtk_widget_set_margin_right(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(margin));
- return(XEN_FALSE);
+ #define H_gtk_stack_get_visible_child_name "gchar* gtk_stack_get_visible_child_name(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_visible_child_name", "GtkStack*");
+ return(C_to_Xen_gchar_(gtk_stack_get_visible_child_name(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gtk_widget_get_margin_top(XEN widget)
+static Xen gxg_gtk_stack_set_visible_child_full(Xen stack, Xen name, Xen transition)
{
- #define H_gtk_widget_get_margin_top "gint gtk_widget_get_margin_top(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_margin_top", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_widget_get_margin_top(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_stack_set_visible_child_full "void gtk_stack_set_visible_child_full(GtkStack* stack, \
+gchar* name, GtkStackTransitionType transition)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_visible_child_full", "GtkStack*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_stack_set_visible_child_full", "gchar*");
+ Xen_check_type(Xen_is_GtkStackTransitionType(transition), transition, 3, "gtk_stack_set_visible_child_full", "GtkStackTransitionType");
+ gtk_stack_set_visible_child_full(Xen_to_C_GtkStack_(stack), (const gchar*)Xen_to_C_gchar_(name), Xen_to_C_GtkStackTransitionType(transition));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_margin_top(XEN widget, XEN margin)
+static Xen gxg_gtk_stack_set_homogeneous(Xen stack, Xen homogeneous)
{
- #define H_gtk_widget_set_margin_top "void gtk_widget_set_margin_top(GtkWidget* widget, gint margin)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_margin_top", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(margin), margin, 2, "gtk_widget_set_margin_top", "gint");
- gtk_widget_set_margin_top(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(margin));
- return(XEN_FALSE);
+ #define H_gtk_stack_set_homogeneous "void gtk_stack_set_homogeneous(GtkStack* stack, gboolean homogeneous)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_homogeneous", "GtkStack*");
+ Xen_check_type(Xen_is_gboolean(homogeneous), homogeneous, 2, "gtk_stack_set_homogeneous", "gboolean");
+ gtk_stack_set_homogeneous(Xen_to_C_GtkStack_(stack), Xen_to_C_gboolean(homogeneous));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_margin_bottom(XEN widget)
+static Xen gxg_gtk_stack_get_homogeneous(Xen stack)
{
- #define H_gtk_widget_get_margin_bottom "gint gtk_widget_get_margin_bottom(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_margin_bottom", "GtkWidget*");
- return(C_TO_XEN_gint(gtk_widget_get_margin_bottom(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_stack_get_homogeneous "gboolean gtk_stack_get_homogeneous(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_homogeneous", "GtkStack*");
+ return(C_to_Xen_gboolean(gtk_stack_get_homogeneous(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gtk_widget_set_margin_bottom(XEN widget, XEN margin)
+static Xen gxg_gtk_stack_set_transition_duration(Xen stack, Xen duration)
{
- #define H_gtk_widget_set_margin_bottom "void gtk_widget_set_margin_bottom(GtkWidget* widget, gint margin)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_margin_bottom", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(margin), margin, 2, "gtk_widget_set_margin_bottom", "gint");
- gtk_widget_set_margin_bottom(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gint(margin));
- return(XEN_FALSE);
+ #define H_gtk_stack_set_transition_duration "void gtk_stack_set_transition_duration(GtkStack* stack, \
+guint duration)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_transition_duration", "GtkStack*");
+ Xen_check_type(Xen_is_guint(duration), duration, 2, "gtk_stack_set_transition_duration", "guint");
+ gtk_stack_set_transition_duration(Xen_to_C_GtkStack_(stack), Xen_to_C_guint(duration));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_shape_combine_region(XEN widget, XEN region)
+static Xen gxg_gtk_stack_get_transition_duration(Xen stack)
{
- #define H_gtk_widget_shape_combine_region "void gtk_widget_shape_combine_region(GtkWidget* widget, \
-cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_shape_combine_region", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 2, "gtk_widget_shape_combine_region", "cairo_region_t*");
- gtk_widget_shape_combine_region(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_cairo_region_t_(region));
- return(XEN_FALSE);
+ #define H_gtk_stack_get_transition_duration "guint gtk_stack_get_transition_duration(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_transition_duration", "GtkStack*");
+ return(C_to_Xen_guint(gtk_stack_get_transition_duration(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gtk_widget_input_shape_combine_region(XEN widget, XEN region)
+static Xen gxg_gtk_stack_set_transition_type(Xen stack, Xen transition)
{
- #define H_gtk_widget_input_shape_combine_region "void gtk_widget_input_shape_combine_region(GtkWidget* widget, \
-cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_input_shape_combine_region", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 2, "gtk_widget_input_shape_combine_region", "cairo_region_t*");
- gtk_widget_input_shape_combine_region(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_cairo_region_t_(region));
- return(XEN_FALSE);
+ #define H_gtk_stack_set_transition_type "void gtk_stack_set_transition_type(GtkStack* stack, GtkStackTransitionType transition)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_transition_type", "GtkStack*");
+ Xen_check_type(Xen_is_GtkStackTransitionType(transition), transition, 2, "gtk_stack_set_transition_type", "GtkStackTransitionType");
+ gtk_stack_set_transition_type(Xen_to_C_GtkStack_(stack), Xen_to_C_GtkStackTransitionType(transition));
+ return(Xen_false);
}
-static XEN gxg_gtk_cairo_should_draw_window(XEN cr, XEN window)
+static Xen gxg_gtk_stack_get_transition_type(Xen stack)
{
- #define H_gtk_cairo_should_draw_window "gboolean gtk_cairo_should_draw_window(cairo_t* cr, GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "gtk_cairo_should_draw_window", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 2, "gtk_cairo_should_draw_window", "GdkWindow*");
- return(C_TO_XEN_gboolean(gtk_cairo_should_draw_window(XEN_TO_C_cairo_t_(cr), XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_stack_get_transition_type "GtkStackTransitionType gtk_stack_get_transition_type(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_transition_type", "GtkStack*");
+ return(C_to_Xen_GtkStackTransitionType(gtk_stack_get_transition_type(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gtk_cairo_transform_to_window(XEN cr, XEN widget, XEN window)
+static Xen gxg_gtk_revealer_new(void)
{
- #define H_gtk_cairo_transform_to_window "void gtk_cairo_transform_to_window(cairo_t* cr, GtkWidget* widget, \
-GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "gtk_cairo_transform_to_window", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_cairo_transform_to_window", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 3, "gtk_cairo_transform_to_window", "GdkWindow*");
- gtk_cairo_transform_to_window(XEN_TO_C_cairo_t_(cr), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gtk_revealer_new "GtkWidget* gtk_revealer_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_revealer_new()));
}
-static XEN gxg_gtk_combo_box_new_with_entry(void)
+static Xen gxg_gtk_revealer_get_reveal_child(Xen revealer)
{
- #define H_gtk_combo_box_new_with_entry "GtkWidget* gtk_combo_box_new_with_entry( void)"
- return(C_TO_XEN_GtkWidget_(gtk_combo_box_new_with_entry()));
+ #define H_gtk_revealer_get_reveal_child "gboolean gtk_revealer_get_reveal_child(GtkRevealer* revealer)"
+ Xen_check_type(Xen_is_GtkRevealer_(revealer), revealer, 1, "gtk_revealer_get_reveal_child", "GtkRevealer*");
+ return(C_to_Xen_gboolean(gtk_revealer_get_reveal_child(Xen_to_C_GtkRevealer_(revealer))));
}
-static XEN gxg_gtk_combo_box_get_has_entry(XEN combo_box)
+static Xen gxg_gtk_revealer_set_reveal_child(Xen revealer, Xen reveal_child)
{
- #define H_gtk_combo_box_get_has_entry "gboolean gtk_combo_box_get_has_entry(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_has_entry", "GtkComboBox*");
- return(C_TO_XEN_gboolean(gtk_combo_box_get_has_entry(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gtk_revealer_set_reveal_child "void gtk_revealer_set_reveal_child(GtkRevealer* revealer, \
+gboolean reveal_child)"
+ Xen_check_type(Xen_is_GtkRevealer_(revealer), revealer, 1, "gtk_revealer_set_reveal_child", "GtkRevealer*");
+ Xen_check_type(Xen_is_gboolean(reveal_child), reveal_child, 2, "gtk_revealer_set_reveal_child", "gboolean");
+ gtk_revealer_set_reveal_child(Xen_to_C_GtkRevealer_(revealer), Xen_to_C_gboolean(reveal_child));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_set_entry_text_column(XEN combo_box, XEN text_column)
+static Xen gxg_gtk_revealer_get_child_revealed(Xen revealer)
{
- #define H_gtk_combo_box_set_entry_text_column "void gtk_combo_box_set_entry_text_column(GtkComboBox* combo_box, \
-gint text_column)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_entry_text_column", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gint_P(text_column), text_column, 2, "gtk_combo_box_set_entry_text_column", "gint");
- gtk_combo_box_set_entry_text_column(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gint(text_column));
- return(XEN_FALSE);
+ #define H_gtk_revealer_get_child_revealed "gboolean gtk_revealer_get_child_revealed(GtkRevealer* revealer)"
+ Xen_check_type(Xen_is_GtkRevealer_(revealer), revealer, 1, "gtk_revealer_get_child_revealed", "GtkRevealer*");
+ return(C_to_Xen_gboolean(gtk_revealer_get_child_revealed(Xen_to_C_GtkRevealer_(revealer))));
}
-static XEN gxg_gtk_combo_box_get_entry_text_column(XEN combo_box)
+static Xen gxg_gtk_revealer_get_transition_duration(Xen revealer)
{
- #define H_gtk_combo_box_get_entry_text_column "gint gtk_combo_box_get_entry_text_column(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_entry_text_column", "GtkComboBox*");
- return(C_TO_XEN_gint(gtk_combo_box_get_entry_text_column(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gtk_revealer_get_transition_duration "guint gtk_revealer_get_transition_duration(GtkRevealer* revealer)"
+ Xen_check_type(Xen_is_GtkRevealer_(revealer), revealer, 1, "gtk_revealer_get_transition_duration", "GtkRevealer*");
+ return(C_to_Xen_guint(gtk_revealer_get_transition_duration(Xen_to_C_GtkRevealer_(revealer))));
}
-static XEN gxg_gtk_target_entry_new(XEN target, XEN flags, XEN info)
+static Xen gxg_gtk_revealer_set_transition_duration(Xen revealer, Xen duration)
{
- #define H_gtk_target_entry_new "GtkTargetEntry* gtk_target_entry_new(char* target, guint flags, guint info)"
- XEN_ASSERT_TYPE(XEN_char__P(target), target, 1, "gtk_target_entry_new", "char*");
- XEN_ASSERT_TYPE(XEN_guint_P(flags), flags, 2, "gtk_target_entry_new", "guint");
- XEN_ASSERT_TYPE(XEN_guint_P(info), info, 3, "gtk_target_entry_new", "guint");
- return(C_TO_XEN_GtkTargetEntry_(gtk_target_entry_new((const char*)XEN_TO_C_char_(target), XEN_TO_C_guint(flags), XEN_TO_C_guint(info))));
+ #define H_gtk_revealer_set_transition_duration "void gtk_revealer_set_transition_duration(GtkRevealer* revealer, \
+guint duration)"
+ Xen_check_type(Xen_is_GtkRevealer_(revealer), revealer, 1, "gtk_revealer_set_transition_duration", "GtkRevealer*");
+ Xen_check_type(Xen_is_guint(duration), duration, 2, "gtk_revealer_set_transition_duration", "guint");
+ gtk_revealer_set_transition_duration(Xen_to_C_GtkRevealer_(revealer), Xen_to_C_guint(duration));
+ return(Xen_false);
}
-static XEN gxg_gtk_target_entry_copy(XEN data)
+static Xen gxg_gtk_revealer_set_transition_type(Xen revealer, Xen transition)
{
- #define H_gtk_target_entry_copy "GtkTargetEntry* gtk_target_entry_copy(GtkTargetEntry* data)"
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(data), data, 1, "gtk_target_entry_copy", "GtkTargetEntry*");
- return(C_TO_XEN_GtkTargetEntry_(gtk_target_entry_copy(XEN_TO_C_GtkTargetEntry_(data))));
+ #define H_gtk_revealer_set_transition_type "void gtk_revealer_set_transition_type(GtkRevealer* revealer, \
+GtkRevealerTransitionType transition)"
+ Xen_check_type(Xen_is_GtkRevealer_(revealer), revealer, 1, "gtk_revealer_set_transition_type", "GtkRevealer*");
+ Xen_check_type(Xen_is_GtkRevealerTransitionType(transition), transition, 2, "gtk_revealer_set_transition_type", "GtkRevealerTransitionType");
+ gtk_revealer_set_transition_type(Xen_to_C_GtkRevealer_(revealer), Xen_to_C_GtkRevealerTransitionType(transition));
+ return(Xen_false);
}
-static XEN gxg_gtk_target_entry_free(XEN data)
+static Xen gxg_gtk_revealer_get_transition_type(Xen revealer)
{
- #define H_gtk_target_entry_free "void gtk_target_entry_free(GtkTargetEntry* data)"
- XEN_ASSERT_TYPE(XEN_GtkTargetEntry__P(data), data, 1, "gtk_target_entry_free", "GtkTargetEntry*");
- gtk_target_entry_free(XEN_TO_C_GtkTargetEntry_(data));
- return(XEN_FALSE);
+ #define H_gtk_revealer_get_transition_type "GtkRevealerTransitionType gtk_revealer_get_transition_type(GtkRevealer* revealer)"
+ Xen_check_type(Xen_is_GtkRevealer_(revealer), revealer, 1, "gtk_revealer_get_transition_type", "GtkRevealer*");
+ return(C_to_Xen_GtkRevealerTransitionType(gtk_revealer_get_transition_type(Xen_to_C_GtkRevealer_(revealer))));
}
-static XEN gxg_gtk_widget_get_hexpand(XEN widget)
+static Xen gxg_gtk_header_bar_new(void)
{
- #define H_gtk_widget_get_hexpand "gboolean gtk_widget_get_hexpand(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_hexpand", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_hexpand(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_header_bar_new "GtkWidget* gtk_header_bar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_header_bar_new()));
}
-static XEN gxg_gtk_widget_set_hexpand(XEN widget, XEN expand)
+static Xen gxg_gtk_header_bar_set_title(Xen bar, Xen title)
{
- #define H_gtk_widget_set_hexpand "void gtk_widget_set_hexpand(GtkWidget* widget, gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_hexpand", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 2, "gtk_widget_set_hexpand", "gboolean");
- gtk_widget_set_hexpand(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_gtk_header_bar_set_title "void gtk_header_bar_set_title(GtkHeaderBar* bar, gchar* title)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_set_title", "GtkHeaderBar*");
+ Xen_check_type(Xen_is_gchar_(title), title, 2, "gtk_header_bar_set_title", "gchar*");
+ gtk_header_bar_set_title(Xen_to_C_GtkHeaderBar_(bar), (const gchar*)Xen_to_C_gchar_(title));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_hexpand_set(XEN widget)
+static Xen gxg_gtk_header_bar_get_title(Xen bar)
{
- #define H_gtk_widget_get_hexpand_set "gboolean gtk_widget_get_hexpand_set(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_hexpand_set", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_hexpand_set(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_header_bar_get_title "gchar* gtk_header_bar_get_title(GtkHeaderBar* bar)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_get_title", "GtkHeaderBar*");
+ return(C_to_Xen_gchar_(gtk_header_bar_get_title(Xen_to_C_GtkHeaderBar_(bar))));
}
-static XEN gxg_gtk_widget_set_hexpand_set(XEN widget, XEN set)
+static Xen gxg_gtk_header_bar_set_subtitle(Xen bar, Xen subtitle)
{
- #define H_gtk_widget_set_hexpand_set "void gtk_widget_set_hexpand_set(GtkWidget* widget, gboolean set)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_hexpand_set", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(set), set, 2, "gtk_widget_set_hexpand_set", "gboolean");
- gtk_widget_set_hexpand_set(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(set));
- return(XEN_FALSE);
+ #define H_gtk_header_bar_set_subtitle "void gtk_header_bar_set_subtitle(GtkHeaderBar* bar, gchar* subtitle)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_set_subtitle", "GtkHeaderBar*");
+ Xen_check_type(Xen_is_gchar_(subtitle), subtitle, 2, "gtk_header_bar_set_subtitle", "gchar*");
+ gtk_header_bar_set_subtitle(Xen_to_C_GtkHeaderBar_(bar), (const gchar*)Xen_to_C_gchar_(subtitle));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_vexpand(XEN widget)
+static Xen gxg_gtk_header_bar_get_subtitle(Xen bar)
{
- #define H_gtk_widget_get_vexpand "gboolean gtk_widget_get_vexpand(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_vexpand", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_vexpand(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_header_bar_get_subtitle "gchar* gtk_header_bar_get_subtitle(GtkHeaderBar* bar)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_get_subtitle", "GtkHeaderBar*");
+ return(C_to_Xen_gchar_(gtk_header_bar_get_subtitle(Xen_to_C_GtkHeaderBar_(bar))));
}
-static XEN gxg_gtk_widget_set_vexpand(XEN widget, XEN expand)
+static Xen gxg_gtk_header_bar_set_custom_title(Xen bar, Xen title_widget)
{
- #define H_gtk_widget_set_vexpand "void gtk_widget_set_vexpand(GtkWidget* widget, gboolean expand)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_vexpand", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(expand), expand, 2, "gtk_widget_set_vexpand", "gboolean");
- gtk_widget_set_vexpand(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(expand));
- return(XEN_FALSE);
+ #define H_gtk_header_bar_set_custom_title "void gtk_header_bar_set_custom_title(GtkHeaderBar* bar, \
+GtkWidget* title_widget)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_set_custom_title", "GtkHeaderBar*");
+ Xen_check_type(Xen_is_GtkWidget_(title_widget), title_widget, 2, "gtk_header_bar_set_custom_title", "GtkWidget*");
+ gtk_header_bar_set_custom_title(Xen_to_C_GtkHeaderBar_(bar), Xen_to_C_GtkWidget_(title_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_vexpand_set(XEN widget)
+static Xen gxg_gtk_header_bar_get_custom_title(Xen bar)
{
- #define H_gtk_widget_get_vexpand_set "gboolean gtk_widget_get_vexpand_set(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_vexpand_set", "GtkWidget*");
- return(C_TO_XEN_gboolean(gtk_widget_get_vexpand_set(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_header_bar_get_custom_title "GtkWidget* gtk_header_bar_get_custom_title(GtkHeaderBar* bar)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_get_custom_title", "GtkHeaderBar*");
+ return(C_to_Xen_GtkWidget_(gtk_header_bar_get_custom_title(Xen_to_C_GtkHeaderBar_(bar))));
}
-static XEN gxg_gtk_widget_set_vexpand_set(XEN widget, XEN set)
+static Xen gxg_gtk_header_bar_pack_start(Xen bar, Xen child)
{
- #define H_gtk_widget_set_vexpand_set "void gtk_widget_set_vexpand_set(GtkWidget* widget, gboolean set)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_vexpand_set", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(set), set, 2, "gtk_widget_set_vexpand_set", "gboolean");
- gtk_widget_set_vexpand_set(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gboolean(set));
- return(XEN_FALSE);
+ #define H_gtk_header_bar_pack_start "void gtk_header_bar_pack_start(GtkHeaderBar* bar, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_pack_start", "GtkHeaderBar*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_header_bar_pack_start", "GtkWidget*");
+ gtk_header_bar_pack_start(Xen_to_C_GtkHeaderBar_(bar), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_queue_compute_expand(XEN widget)
+static Xen gxg_gtk_header_bar_pack_end(Xen bar, Xen child)
{
- #define H_gtk_widget_queue_compute_expand "void gtk_widget_queue_compute_expand(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_queue_compute_expand", "GtkWidget*");
- gtk_widget_queue_compute_expand(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_header_bar_pack_end "void gtk_header_bar_pack_end(GtkHeaderBar* bar, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_pack_end", "GtkHeaderBar*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_header_bar_pack_end", "GtkWidget*");
+ gtk_header_bar_pack_end(Xen_to_C_GtkHeaderBar_(bar), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_compute_expand(XEN widget, XEN orientation)
+static Xen gxg_gtk_list_box_row_new(void)
{
- #define H_gtk_widget_compute_expand "gboolean gtk_widget_compute_expand(GtkWidget* widget, GtkOrientation orientation)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_compute_expand", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 2, "gtk_widget_compute_expand", "GtkOrientation");
- return(C_TO_XEN_gboolean(gtk_widget_compute_expand(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkOrientation(orientation))));
+ #define H_gtk_list_box_row_new "GtkWidget* gtk_list_box_row_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_list_box_row_new()));
}
-static XEN gxg_gtk_window_set_default_geometry(XEN window, XEN width, XEN height)
+static Xen gxg_gtk_list_box_row_get_header(Xen row)
{
- #define H_gtk_window_set_default_geometry "void gtk_window_set_default_geometry(GtkWindow* window, \
-gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_default_geometry", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_window_set_default_geometry", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gtk_window_set_default_geometry", "gint");
- gtk_window_set_default_geometry(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_gtk_list_box_row_get_header "GtkWidget* gtk_list_box_row_get_header(GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_get_header", "GtkListBoxRow*");
+ return(C_to_Xen_GtkWidget_(gtk_list_box_row_get_header(Xen_to_C_GtkListBoxRow_(row))));
}
-static XEN gxg_gtk_window_resize_to_geometry(XEN window, XEN width, XEN height)
+static Xen gxg_gtk_list_box_row_set_header(Xen row, Xen header)
{
- #define H_gtk_window_resize_to_geometry "void gtk_window_resize_to_geometry(GtkWindow* window, gint width, \
-gint height)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_resize_to_geometry", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_window_resize_to_geometry", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 3, "gtk_window_resize_to_geometry", "gint");
- gtk_window_resize_to_geometry(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_gtk_list_box_row_set_header "void gtk_list_box_row_set_header(GtkListBoxRow* row, GtkWidget* header)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_set_header", "GtkListBoxRow*");
+ Xen_check_type(Xen_is_GtkWidget_(header), header, 2, "gtk_list_box_row_set_header", "GtkWidget*");
+ gtk_list_box_row_set_header(Xen_to_C_GtkListBoxRow_(row), Xen_to_C_GtkWidget_(header));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_has_resize_grip(XEN window, XEN value)
+static Xen gxg_gtk_list_box_row_changed(Xen row)
{
- #define H_gtk_window_set_has_resize_grip "void gtk_window_set_has_resize_grip(GtkWindow* window, gboolean value)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_has_resize_grip", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(value), value, 2, "gtk_window_set_has_resize_grip", "gboolean");
- gtk_window_set_has_resize_grip(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(value));
- return(XEN_FALSE);
+ #define H_gtk_list_box_row_changed "void gtk_list_box_row_changed(GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_changed", "GtkListBoxRow*");
+ gtk_list_box_row_changed(Xen_to_C_GtkListBoxRow_(row));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_has_resize_grip(XEN window)
+static Xen gxg_gtk_list_box_get_selected_row(Xen list_box)
{
- #define H_gtk_window_get_has_resize_grip "gboolean gtk_window_get_has_resize_grip(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_has_resize_grip", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_has_resize_grip(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_list_box_get_selected_row "GtkListBoxRow* gtk_list_box_get_selected_row(GtkListBox* list_box)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_get_selected_row", "GtkListBox*");
+ return(C_to_Xen_GtkListBoxRow_(gtk_list_box_get_selected_row(Xen_to_C_GtkListBox_(list_box))));
}
-static XEN gxg_gtk_window_resize_grip_is_visible(XEN window)
+static Xen gxg_gtk_list_box_get_row_at_index(Xen list_box, Xen index_)
{
- #define H_gtk_window_resize_grip_is_visible "gboolean gtk_window_resize_grip_is_visible(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_resize_grip_is_visible", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_resize_grip_is_visible(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_list_box_get_row_at_index "GtkListBoxRow* gtk_list_box_get_row_at_index(GtkListBox* list_box, \
+gint index_)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_get_row_at_index", "GtkListBox*");
+ Xen_check_type(Xen_is_gint(index_), index_, 2, "gtk_list_box_get_row_at_index", "gint");
+ return(C_to_Xen_GtkListBoxRow_(gtk_list_box_get_row_at_index(Xen_to_C_GtkListBox_(list_box), Xen_to_C_gint(index_))));
}
-static XEN gxg_gtk_window_get_resize_grip_area(XEN window, XEN rect)
+static Xen gxg_gtk_list_box_get_row_at_y(Xen list_box, Xen y)
{
- #define H_gtk_window_get_resize_grip_area "gboolean gtk_window_get_resize_grip_area(GtkWindow* window, \
-GdkRectangle* rect)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_resize_grip_area", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(rect), rect, 2, "gtk_window_get_resize_grip_area", "GdkRectangle*");
- return(C_TO_XEN_gboolean(gtk_window_get_resize_grip_area(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkRectangle_(rect))));
+ #define H_gtk_list_box_get_row_at_y "GtkListBoxRow* gtk_list_box_get_row_at_y(GtkListBox* list_box, \
+gint y)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_get_row_at_y", "GtkListBox*");
+ Xen_check_type(Xen_is_gint(y), y, 2, "gtk_list_box_get_row_at_y", "gint");
+ return(C_to_Xen_GtkListBoxRow_(gtk_list_box_get_row_at_y(Xen_to_C_GtkListBox_(list_box), Xen_to_C_gint(y))));
}
-static XEN gxg_gtk_combo_box_text_new(void)
+static Xen gxg_gtk_list_box_select_row(Xen list_box, Xen row)
{
- #define H_gtk_combo_box_text_new "GtkWidget* gtk_combo_box_text_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_combo_box_text_new()));
+ #define H_gtk_list_box_select_row "void gtk_list_box_select_row(GtkListBox* list_box, GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_select_row", "GtkListBox*");
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 2, "gtk_list_box_select_row", "GtkListBoxRow*");
+ gtk_list_box_select_row(Xen_to_C_GtkListBox_(list_box), Xen_to_C_GtkListBoxRow_(row));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_text_new_with_entry(void)
+static Xen gxg_gtk_list_box_set_placeholder(Xen list_box, Xen placeholder)
{
- #define H_gtk_combo_box_text_new_with_entry "GtkWidget* gtk_combo_box_text_new_with_entry( void)"
- return(C_TO_XEN_GtkWidget_(gtk_combo_box_text_new_with_entry()));
+ #define H_gtk_list_box_set_placeholder "void gtk_list_box_set_placeholder(GtkListBox* list_box, GtkWidget* placeholder)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_set_placeholder", "GtkListBox*");
+ Xen_check_type(Xen_is_GtkWidget_(placeholder), placeholder, 2, "gtk_list_box_set_placeholder", "GtkWidget*");
+ gtk_list_box_set_placeholder(Xen_to_C_GtkListBox_(list_box), Xen_to_C_GtkWidget_(placeholder));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_text_append_text(XEN combo_box, XEN text)
+static Xen gxg_gtk_list_box_set_adjustment(Xen list_box, Xen adjustment)
{
- #define H_gtk_combo_box_text_append_text "void gtk_combo_box_text_append_text(GtkComboBoxText* combo_box, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_append_text", "GtkComboBoxText*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_combo_box_text_append_text", "gchar*");
- gtk_combo_box_text_append_text(XEN_TO_C_GtkComboBoxText_(combo_box), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_list_box_set_adjustment "void gtk_list_box_set_adjustment(GtkListBox* list_box, GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_set_adjustment", "GtkListBox*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_list_box_set_adjustment", "GtkAdjustment*");
+ gtk_list_box_set_adjustment(Xen_to_C_GtkListBox_(list_box), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_text_insert_text(XEN combo_box, XEN position, XEN text)
+static Xen gxg_gtk_list_box_get_adjustment(Xen list_box)
{
- #define H_gtk_combo_box_text_insert_text "void gtk_combo_box_text_insert_text(GtkComboBoxText* combo_box, \
-gint position, gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_insert_text", "GtkComboBoxText*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 2, "gtk_combo_box_text_insert_text", "gint");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_combo_box_text_insert_text", "gchar*");
- gtk_combo_box_text_insert_text(XEN_TO_C_GtkComboBoxText_(combo_box), XEN_TO_C_gint(position), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_list_box_get_adjustment "GtkAdjustment* gtk_list_box_get_adjustment(GtkListBox* list_box)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_get_adjustment", "GtkListBox*");
+ return(C_to_Xen_GtkAdjustment_(gtk_list_box_get_adjustment(Xen_to_C_GtkListBox_(list_box))));
}
-static XEN gxg_gtk_combo_box_text_prepend_text(XEN combo_box, XEN text)
+static Xen gxg_gtk_list_box_set_selection_mode(Xen list_box, Xen mode)
{
- #define H_gtk_combo_box_text_prepend_text "void gtk_combo_box_text_prepend_text(GtkComboBoxText* combo_box, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_prepend_text", "GtkComboBoxText*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_combo_box_text_prepend_text", "gchar*");
- gtk_combo_box_text_prepend_text(XEN_TO_C_GtkComboBoxText_(combo_box), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_list_box_set_selection_mode "void gtk_list_box_set_selection_mode(GtkListBox* list_box, \
+GtkSelectionMode mode)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_set_selection_mode", "GtkListBox*");
+ Xen_check_type(Xen_is_GtkSelectionMode(mode), mode, 2, "gtk_list_box_set_selection_mode", "GtkSelectionMode");
+ gtk_list_box_set_selection_mode(Xen_to_C_GtkListBox_(list_box), Xen_to_C_GtkSelectionMode(mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_text_remove(XEN combo_box, XEN position)
+static Xen gxg_gtk_list_box_get_selection_mode(Xen list_box)
{
- #define H_gtk_combo_box_text_remove "void gtk_combo_box_text_remove(GtkComboBoxText* combo_box, gint position)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_remove", "GtkComboBoxText*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 2, "gtk_combo_box_text_remove", "gint");
- gtk_combo_box_text_remove(XEN_TO_C_GtkComboBoxText_(combo_box), XEN_TO_C_gint(position));
- return(XEN_FALSE);
+ #define H_gtk_list_box_get_selection_mode "GtkSelectionMode gtk_list_box_get_selection_mode(GtkListBox* list_box)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_get_selection_mode", "GtkListBox*");
+ return(C_to_Xen_GtkSelectionMode(gtk_list_box_get_selection_mode(Xen_to_C_GtkListBox_(list_box))));
}
-static XEN gxg_gtk_combo_box_text_get_active_text(XEN combo_box)
+static Xen gxg_gtk_list_box_invalidate_filter(Xen list_box)
{
- #define H_gtk_combo_box_text_get_active_text "gchar* gtk_combo_box_text_get_active_text(GtkComboBoxText* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_get_active_text", "GtkComboBoxText*");
- return(C_TO_XEN_gchar_(gtk_combo_box_text_get_active_text(XEN_TO_C_GtkComboBoxText_(combo_box))));
+ #define H_gtk_list_box_invalidate_filter "void gtk_list_box_invalidate_filter(GtkListBox* list_box)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_invalidate_filter", "GtkListBox*");
+ gtk_list_box_invalidate_filter(Xen_to_C_GtkListBox_(list_box));
+ return(Xen_false);
}
-static XEN gxg_gdk_cairo_set_source_rgba(XEN cr, XEN rgba)
+static Xen gxg_gtk_list_box_invalidate_sort(Xen list_box)
{
- #define H_gdk_cairo_set_source_rgba "void gdk_cairo_set_source_rgba(cairo_t* cr, GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "gdk_cairo_set_source_rgba", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 2, "gdk_cairo_set_source_rgba", "GdkRGBA*");
- gdk_cairo_set_source_rgba(XEN_TO_C_cairo_t_(cr), XEN_TO_C_GdkRGBA_(rgba));
- return(XEN_FALSE);
+ #define H_gtk_list_box_invalidate_sort "void gtk_list_box_invalidate_sort(GtkListBox* list_box)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_invalidate_sort", "GtkListBox*");
+ gtk_list_box_invalidate_sort(Xen_to_C_GtkListBox_(list_box));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_set_background_rgba(XEN window, XEN rgba)
+static Xen gxg_gtk_list_box_invalidate_headers(Xen list_box)
{
- #define H_gdk_window_set_background_rgba "void gdk_window_set_background_rgba(GdkWindow* window, GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_background_rgba", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 2, "gdk_window_set_background_rgba", "GdkRGBA*");
- gdk_window_set_background_rgba(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkRGBA_(rgba));
- return(XEN_FALSE);
+ #define H_gtk_list_box_invalidate_headers "void gtk_list_box_invalidate_headers(GtkListBox* list_box)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_invalidate_headers", "GtkListBox*");
+ gtk_list_box_invalidate_headers(Xen_to_C_GtkListBox_(list_box));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_view_set_background_rgba(XEN cell_view, XEN rgba)
+static Xen gxg_gtk_list_box_set_activate_on_single_click(Xen list_box, Xen single)
{
- #define H_gtk_cell_view_set_background_rgba "void gtk_cell_view_set_background_rgba(GtkCellView* cell_view, \
-GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_set_background_rgba", "GtkCellView*");
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 2, "gtk_cell_view_set_background_rgba", "GdkRGBA*");
- gtk_cell_view_set_background_rgba(XEN_TO_C_GtkCellView_(cell_view), XEN_TO_C_GdkRGBA_(rgba));
- return(XEN_FALSE);
+ #define H_gtk_list_box_set_activate_on_single_click "void gtk_list_box_set_activate_on_single_click(GtkListBox* list_box, \
+gboolean single)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_set_activate_on_single_click", "GtkListBox*");
+ Xen_check_type(Xen_is_gboolean(single), single, 2, "gtk_list_box_set_activate_on_single_click", "gboolean");
+ gtk_list_box_set_activate_on_single_click(Xen_to_C_GtkListBox_(list_box), Xen_to_C_gboolean(single));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_button_new_with_rgba(XEN rgba)
+static Xen gxg_gtk_list_box_get_activate_on_single_click(Xen list_box)
{
- #define H_gtk_color_button_new_with_rgba "GtkWidget* gtk_color_button_new_with_rgba(GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 1, "gtk_color_button_new_with_rgba", "GdkRGBA*");
- return(C_TO_XEN_GtkWidget_(gtk_color_button_new_with_rgba(XEN_TO_C_GdkRGBA_(rgba))));
+ #define H_gtk_list_box_get_activate_on_single_click "gboolean gtk_list_box_get_activate_on_single_click(GtkListBox* list_box)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_get_activate_on_single_click", "GtkListBox*");
+ return(C_to_Xen_gboolean(gtk_list_box_get_activate_on_single_click(Xen_to_C_GtkListBox_(list_box))));
}
-static XEN gxg_gtk_color_button_set_rgba(XEN color_button, XEN rgba)
+static Xen gxg_gtk_list_box_drag_unhighlight_row(Xen list_box)
{
- #define H_gtk_color_button_set_rgba "void gtk_color_button_set_rgba(GtkColorButton* color_button, GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GtkColorButton__P(color_button), color_button, 1, "gtk_color_button_set_rgba", "GtkColorButton*");
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 2, "gtk_color_button_set_rgba", "GdkRGBA*");
- gtk_color_button_set_rgba(XEN_TO_C_GtkColorButton_(color_button), XEN_TO_C_GdkRGBA_(rgba));
- return(XEN_FALSE);
+ #define H_gtk_list_box_drag_unhighlight_row "void gtk_list_box_drag_unhighlight_row(GtkListBox* list_box)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_drag_unhighlight_row", "GtkListBox*");
+ gtk_list_box_drag_unhighlight_row(Xen_to_C_GtkListBox_(list_box));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_selection_set_current_rgba(XEN colorsel, XEN rgba)
+static Xen gxg_gtk_list_box_drag_highlight_row(Xen list_box, Xen row)
{
- #define H_gtk_color_selection_set_current_rgba "void gtk_color_selection_set_current_rgba(GtkColorSelection* colorsel, \
-GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_set_current_rgba", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 2, "gtk_color_selection_set_current_rgba", "GdkRGBA*");
- gtk_color_selection_set_current_rgba(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_GdkRGBA_(rgba));
- return(XEN_FALSE);
+ #define H_gtk_list_box_drag_highlight_row "void gtk_list_box_drag_highlight_row(GtkListBox* list_box, \
+GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_drag_highlight_row", "GtkListBox*");
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 2, "gtk_list_box_drag_highlight_row", "GtkListBoxRow*");
+ gtk_list_box_drag_highlight_row(Xen_to_C_GtkListBox_(list_box), Xen_to_C_GtkListBoxRow_(row));
+ return(Xen_false);
}
-static XEN gxg_gtk_color_selection_set_previous_rgba(XEN colorsel, XEN rgba)
+static Xen gxg_gtk_list_box_new(void)
{
- #define H_gtk_color_selection_set_previous_rgba "void gtk_color_selection_set_previous_rgba(GtkColorSelection* colorsel, \
-GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GtkColorSelection__P(colorsel), colorsel, 1, "gtk_color_selection_set_previous_rgba", "GtkColorSelection*");
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 2, "gtk_color_selection_set_previous_rgba", "GdkRGBA*");
- gtk_color_selection_set_previous_rgba(XEN_TO_C_GtkColorSelection_(colorsel), XEN_TO_C_GdkRGBA_(rgba));
- return(XEN_FALSE);
+ #define H_gtk_list_box_new "GtkWidget* gtk_list_box_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_list_box_new()));
}
-static XEN gxg_gtk_combo_box_text_remove_all(XEN combo_box)
+static Xen gxg_gtk_search_bar_new(void)
{
- #define H_gtk_combo_box_text_remove_all "void gtk_combo_box_text_remove_all(GtkComboBoxText* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_remove_all", "GtkComboBoxText*");
- gtk_combo_box_text_remove_all(XEN_TO_C_GtkComboBoxText_(combo_box));
- return(XEN_FALSE);
+ #define H_gtk_search_bar_new "GtkWidget* gtk_search_bar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_search_bar_new()));
}
-static XEN gxg_gtk_combo_box_set_popup_fixed_width(XEN combo_box, XEN fixed)
+static Xen gxg_gtk_search_bar_connect_entry(Xen bar, Xen entry)
{
- #define H_gtk_combo_box_set_popup_fixed_width "void gtk_combo_box_set_popup_fixed_width(GtkComboBox* combo_box, \
-gboolean fixed)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_popup_fixed_width", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(fixed), fixed, 2, "gtk_combo_box_set_popup_fixed_width", "gboolean");
- gtk_combo_box_set_popup_fixed_width(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gboolean(fixed));
- return(XEN_FALSE);
+ #define H_gtk_search_bar_connect_entry "void gtk_search_bar_connect_entry(GtkSearchBar* bar, GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkSearchBar_(bar), bar, 1, "gtk_search_bar_connect_entry", "GtkSearchBar*");
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 2, "gtk_search_bar_connect_entry", "GtkEntry*");
+ gtk_search_bar_connect_entry(Xen_to_C_GtkSearchBar_(bar), Xen_to_C_GtkEntry_(entry));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_get_popup_fixed_width(XEN combo_box)
+static Xen gxg_gtk_search_bar_get_search_mode(Xen bar)
{
- #define H_gtk_combo_box_get_popup_fixed_width "gboolean gtk_combo_box_get_popup_fixed_width(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_popup_fixed_width", "GtkComboBox*");
- return(C_TO_XEN_gboolean(gtk_combo_box_get_popup_fixed_width(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gtk_search_bar_get_search_mode "gboolean gtk_search_bar_get_search_mode(GtkSearchBar* bar)"
+ Xen_check_type(Xen_is_GtkSearchBar_(bar), bar, 1, "gtk_search_bar_get_search_mode", "GtkSearchBar*");
+ return(C_to_Xen_gboolean(gtk_search_bar_get_search_mode(Xen_to_C_GtkSearchBar_(bar))));
+}
+
+static Xen gxg_gtk_search_bar_set_search_mode(Xen bar, Xen search_mode)
+{
+ #define H_gtk_search_bar_set_search_mode "void gtk_search_bar_set_search_mode(GtkSearchBar* bar, gboolean search_mode)"
+ Xen_check_type(Xen_is_GtkSearchBar_(bar), bar, 1, "gtk_search_bar_set_search_mode", "GtkSearchBar*");
+ Xen_check_type(Xen_is_gboolean(search_mode), search_mode, 2, "gtk_search_bar_set_search_mode", "gboolean");
+ gtk_search_bar_set_search_mode(Xen_to_C_GtkSearchBar_(bar), Xen_to_C_gboolean(search_mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrolled_window_get_min_content_width(XEN scrolled_window)
+static Xen gxg_gtk_search_bar_get_show_close_button(Xen bar)
{
- #define H_gtk_scrolled_window_get_min_content_width "gint gtk_scrolled_window_get_min_content_width(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_min_content_width", "GtkScrolledWindow*");
- return(C_TO_XEN_gint(gtk_scrolled_window_get_min_content_width(XEN_TO_C_GtkScrolledWindow_(scrolled_window))));
+ #define H_gtk_search_bar_get_show_close_button "gboolean gtk_search_bar_get_show_close_button(GtkSearchBar* bar)"
+ Xen_check_type(Xen_is_GtkSearchBar_(bar), bar, 1, "gtk_search_bar_get_show_close_button", "GtkSearchBar*");
+ return(C_to_Xen_gboolean(gtk_search_bar_get_show_close_button(Xen_to_C_GtkSearchBar_(bar))));
}
-static XEN gxg_gtk_scrolled_window_set_min_content_width(XEN scrolled_window, XEN width)
+static Xen gxg_gtk_search_bar_set_show_close_button(Xen bar, Xen visible)
{
- #define H_gtk_scrolled_window_set_min_content_width "void gtk_scrolled_window_set_min_content_width(GtkScrolledWindow* scrolled_window, \
-gint width)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_min_content_width", "GtkScrolledWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 2, "gtk_scrolled_window_set_min_content_width", "gint");
- gtk_scrolled_window_set_min_content_width(XEN_TO_C_GtkScrolledWindow_(scrolled_window), XEN_TO_C_gint(width));
- return(XEN_FALSE);
+ #define H_gtk_search_bar_set_show_close_button "void gtk_search_bar_set_show_close_button(GtkSearchBar* bar, \
+gboolean visible)"
+ Xen_check_type(Xen_is_GtkSearchBar_(bar), bar, 1, "gtk_search_bar_set_show_close_button", "GtkSearchBar*");
+ Xen_check_type(Xen_is_gboolean(visible), visible, 2, "gtk_search_bar_set_show_close_button", "gboolean");
+ gtk_search_bar_set_show_close_button(Xen_to_C_GtkSearchBar_(bar), Xen_to_C_gboolean(visible));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrolled_window_get_min_content_height(XEN scrolled_window)
+static Xen gxg_gtk_search_bar_handle_event(Xen bar, Xen event)
{
- #define H_gtk_scrolled_window_get_min_content_height "gint gtk_scrolled_window_get_min_content_height(GtkScrolledWindow* scrolled_window)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_min_content_height", "GtkScrolledWindow*");
- return(C_TO_XEN_gint(gtk_scrolled_window_get_min_content_height(XEN_TO_C_GtkScrolledWindow_(scrolled_window))));
+ #define H_gtk_search_bar_handle_event "gboolean gtk_search_bar_handle_event(GtkSearchBar* bar, GdkEvent* event)"
+ Xen_check_type(Xen_is_GtkSearchBar_(bar), bar, 1, "gtk_search_bar_handle_event", "GtkSearchBar*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gtk_search_bar_handle_event", "GdkEvent*");
+ return(C_to_Xen_gboolean(gtk_search_bar_handle_event(Xen_to_C_GtkSearchBar_(bar), Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_scrolled_window_set_min_content_height(XEN scrolled_window, XEN height)
+static Xen gxg_gtk_file_chooser_get_current_name(Xen chooser)
{
- #define H_gtk_scrolled_window_set_min_content_height "void gtk_scrolled_window_set_min_content_height(GtkScrolledWindow* scrolled_window, \
-gint height)"
- XEN_ASSERT_TYPE(XEN_GtkScrolledWindow__P(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_min_content_height", "GtkScrolledWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 2, "gtk_scrolled_window_set_min_content_height", "gint");
- gtk_scrolled_window_set_min_content_height(XEN_TO_C_GtkScrolledWindow_(scrolled_window), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_gtk_file_chooser_get_current_name "gchar* gtk_file_chooser_get_current_name(GtkFileChooser* chooser)"
+ Xen_check_type(Xen_is_GtkFileChooser_(chooser), chooser, 1, "gtk_file_chooser_get_current_name", "GtkFileChooser*");
+ return(C_to_Xen_gchar_(gtk_file_chooser_get_current_name(Xen_to_C_GtkFileChooser_(chooser))));
}
-static XEN gxg_gtk_grid_new(void)
+static Xen gxg_gdk_cairo_surface_create_from_pixbuf(Xen pixbuf, Xen scale, Xen for_window)
{
- #define H_gtk_grid_new "GtkWidget* gtk_grid_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_grid_new()));
+ #define H_gdk_cairo_surface_create_from_pixbuf "cairo_surface_t* gdk_cairo_surface_create_from_pixbuf(GdkPixbuf* pixbuf, \
+int scale, GdkWindow* for_window)"
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 1, "gdk_cairo_surface_create_from_pixbuf", "GdkPixbuf*");
+ Xen_check_type(Xen_is_int(scale), scale, 2, "gdk_cairo_surface_create_from_pixbuf", "int");
+ Xen_check_type(Xen_is_GdkWindow_(for_window), for_window, 3, "gdk_cairo_surface_create_from_pixbuf", "GdkWindow*");
+ return(C_to_Xen_cairo_surface_t_(gdk_cairo_surface_create_from_pixbuf(Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_int(scale),
+ Xen_to_C_GdkWindow_(for_window))));
}
-static XEN gxg_gtk_grid_attach(XEN grid, XEN child, XEN left, XEN top, XEN width, XEN height)
+static Xen gxg_gdk_device_get_position_double(Xen device, Xen ignore_screen, Xen ignore_x, Xen ignore_y)
{
- #define H_gtk_grid_attach "void gtk_grid_attach(GtkGrid* grid, GtkWidget* child, gint left, gint top, \
-gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_attach", "GtkGrid*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_grid_attach", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gint_P(left), left, 3, "gtk_grid_attach", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(top), top, 4, "gtk_grid_attach", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 5, "gtk_grid_attach", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 6, "gtk_grid_attach", "gint");
- gtk_grid_attach(XEN_TO_C_GtkGrid_(grid), XEN_TO_C_GtkWidget_(child), XEN_TO_C_gint(left), XEN_TO_C_gint(top), XEN_TO_C_gint(width),
- XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_gdk_device_get_position_double "void gdk_device_get_position_double(GdkDevice* device, GdkScreen** [screen], \
+gdouble* [x], gdouble* [y])"
+ GdkScreen* ref_screen = NULL;
+ gdouble ref_x;
+ gdouble ref_y;
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 1, "gdk_device_get_position_double", "GdkDevice*");
+ gdk_device_get_position_double(Xen_to_C_GdkDevice_(device), &ref_screen, &ref_x, &ref_y);
+ return(Xen_list_3(C_to_Xen_GdkScreen_(ref_screen), C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
}
-static XEN gxg_gtk_grid_attach_next_to(XEN grid, XEN child, XEN sibling, XEN side, XEN width, XEN height)
+static Xen gxg_gdk_device_get_window_at_position_double(Xen device, Xen ignore_win_x, Xen ignore_win_y)
{
- #define H_gtk_grid_attach_next_to "void gtk_grid_attach_next_to(GtkGrid* grid, GtkWidget* child, GtkWidget* sibling, \
-GtkPositionType side, gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_attach_next_to", "GtkGrid*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_grid_attach_next_to", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(sibling), sibling, 3, "gtk_grid_attach_next_to", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkPositionType_P(side), side, 4, "gtk_grid_attach_next_to", "GtkPositionType");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 5, "gtk_grid_attach_next_to", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 6, "gtk_grid_attach_next_to", "gint");
- gtk_grid_attach_next_to(XEN_TO_C_GtkGrid_(grid), XEN_TO_C_GtkWidget_(child), XEN_TO_C_GtkWidget_(sibling), XEN_TO_C_GtkPositionType(side),
- XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_gdk_device_get_window_at_position_double "GdkWindow* gdk_device_get_window_at_position_double(GdkDevice* device, \
+gdouble* [win_x], gdouble* [win_y])"
+ gdouble ref_win_x;
+ gdouble ref_win_y;
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 1, "gdk_device_get_window_at_position_double", "GdkDevice*");
+ {
+ Xen result;
+ result = C_to_Xen_GdkWindow_(gdk_device_get_window_at_position_double(Xen_to_C_GdkDevice_(device), &ref_win_x, &ref_win_y));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_win_x), C_to_Xen_gdouble(ref_win_y)));
+ }
}
-static XEN gxg_gtk_grid_set_row_homogeneous(XEN grid, XEN homogeneous)
+static Xen gxg_gdk_screen_get_monitor_scale_factor(Xen screen, Xen monitor_num)
{
- #define H_gtk_grid_set_row_homogeneous "void gtk_grid_set_row_homogeneous(GtkGrid* grid, gboolean homogeneous)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_set_row_homogeneous", "GtkGrid*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(homogeneous), homogeneous, 2, "gtk_grid_set_row_homogeneous", "gboolean");
- gtk_grid_set_row_homogeneous(XEN_TO_C_GtkGrid_(grid), XEN_TO_C_gboolean(homogeneous));
- return(XEN_FALSE);
+ #define H_gdk_screen_get_monitor_scale_factor "gint gdk_screen_get_monitor_scale_factor(GdkScreen* screen, \
+gint monitor_num)"
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 1, "gdk_screen_get_monitor_scale_factor", "GdkScreen*");
+ Xen_check_type(Xen_is_gint(monitor_num), monitor_num, 2, "gdk_screen_get_monitor_scale_factor", "gint");
+ return(C_to_Xen_gint(gdk_screen_get_monitor_scale_factor(Xen_to_C_GdkScreen_(screen), Xen_to_C_gint(monitor_num))));
}
-static XEN gxg_gtk_grid_get_row_homogeneous(XEN grid)
+static Xen gxg_gdk_window_get_scale_factor(Xen window)
{
- #define H_gtk_grid_get_row_homogeneous "gboolean gtk_grid_get_row_homogeneous(GtkGrid* grid)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_get_row_homogeneous", "GtkGrid*");
- return(C_TO_XEN_gboolean(gtk_grid_get_row_homogeneous(XEN_TO_C_GtkGrid_(grid))));
+ #define H_gdk_window_get_scale_factor "gint gdk_window_get_scale_factor(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_scale_factor", "GdkWindow*");
+ return(C_to_Xen_gint(gdk_window_get_scale_factor(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_grid_set_row_spacing(XEN grid, XEN spacing)
+static Xen gxg_gdk_window_get_device_position_double(Xen window, Xen device, Xen ignore_x, Xen ignore_y, Xen ignore_mask)
{
- #define H_gtk_grid_set_row_spacing "void gtk_grid_set_row_spacing(GtkGrid* grid, guint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_set_row_spacing", "GtkGrid*");
- XEN_ASSERT_TYPE(XEN_guint_P(spacing), spacing, 2, "gtk_grid_set_row_spacing", "guint");
- gtk_grid_set_row_spacing(XEN_TO_C_GtkGrid_(grid), XEN_TO_C_guint(spacing));
- return(XEN_FALSE);
+ #define H_gdk_window_get_device_position_double "GdkWindow* gdk_window_get_device_position_double(GdkWindow* window, \
+GdkDevice* device, gdouble* [x], gdouble* [y], GdkModifierType* [mask])"
+ gdouble ref_x;
+ gdouble ref_y;
+ GdkModifierType ref_mask;
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_device_position_double", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 2, "gdk_window_get_device_position_double", "GdkDevice*");
+ {
+ Xen result;
+ result = C_to_Xen_GdkWindow_(gdk_window_get_device_position_double(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkDevice_(device),
+ &ref_x, &ref_y, &ref_mask));
+ return(Xen_list_4(result, C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y), C_to_Xen_GdkModifierType(ref_mask)));
+ }
}
-static XEN gxg_gtk_grid_get_row_spacing(XEN grid)
+static Xen gxg_gdk_window_create_similar_image_surface(Xen window, Xen format, Xen width, Xen height, Xen scale)
{
- #define H_gtk_grid_get_row_spacing "guint gtk_grid_get_row_spacing(GtkGrid* grid)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_get_row_spacing", "GtkGrid*");
- return(C_TO_XEN_guint(gtk_grid_get_row_spacing(XEN_TO_C_GtkGrid_(grid))));
+ #define H_gdk_window_create_similar_image_surface "cairo_surface_t* gdk_window_create_similar_image_surface(GdkWindow* window, \
+cairo_format_t format, int width, int height, int scale)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_create_similar_image_surface", "GdkWindow*");
+ Xen_check_type(Xen_is_cairo_format_t(format), format, 2, "gdk_window_create_similar_image_surface", "cairo_format_t");
+ Xen_check_type(Xen_is_int(width), width, 3, "gdk_window_create_similar_image_surface", "int");
+ Xen_check_type(Xen_is_int(height), height, 4, "gdk_window_create_similar_image_surface", "int");
+ Xen_check_type(Xen_is_int(scale), scale, 5, "gdk_window_create_similar_image_surface", "int");
+ return(C_to_Xen_cairo_surface_t_(gdk_window_create_similar_image_surface(Xen_to_C_GdkWindow_(window), Xen_to_C_cairo_format_t(format),
+ Xen_to_C_int(width), Xen_to_C_int(height), Xen_to_C_int(scale))));
}
-static XEN gxg_gtk_grid_set_column_homogeneous(XEN grid, XEN homogeneous)
+static Xen gxg_gtk_icon_theme_lookup_icon_for_scale(Xen icon_theme, Xen icon_name, Xen size, Xen scale, Xen flags)
{
- #define H_gtk_grid_set_column_homogeneous "void gtk_grid_set_column_homogeneous(GtkGrid* grid, gboolean homogeneous)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_set_column_homogeneous", "GtkGrid*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(homogeneous), homogeneous, 2, "gtk_grid_set_column_homogeneous", "gboolean");
- gtk_grid_set_column_homogeneous(XEN_TO_C_GtkGrid_(grid), XEN_TO_C_gboolean(homogeneous));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_lookup_icon_for_scale "GtkIconInfo* gtk_icon_theme_lookup_icon_for_scale(GtkIconTheme* icon_theme, \
+gchar* icon_name, gint size, gint scale, GtkIconLookupFlags flags)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_lookup_icon_for_scale", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_icon_theme_lookup_icon_for_scale", "gchar*");
+ Xen_check_type(Xen_is_gint(size), size, 3, "gtk_icon_theme_lookup_icon_for_scale", "gint");
+ Xen_check_type(Xen_is_gint(scale), scale, 4, "gtk_icon_theme_lookup_icon_for_scale", "gint");
+ Xen_check_type(Xen_is_GtkIconLookupFlags(flags), flags, 5, "gtk_icon_theme_lookup_icon_for_scale", "GtkIconLookupFlags");
+ return(C_to_Xen_GtkIconInfo_(gtk_icon_theme_lookup_icon_for_scale(Xen_to_C_GtkIconTheme_(icon_theme), (const gchar*)Xen_to_C_gchar_(icon_name),
+ Xen_to_C_gint(size), Xen_to_C_gint(scale), Xen_to_C_GtkIconLookupFlags(flags))));
}
-static XEN gxg_gtk_grid_get_column_homogeneous(XEN grid)
+static Xen gxg_gtk_icon_theme_load_icon_for_scale(Xen icon_theme, Xen icon_name, Xen size, Xen scale, Xen flags, Xen ignore_error)
{
- #define H_gtk_grid_get_column_homogeneous "gboolean gtk_grid_get_column_homogeneous(GtkGrid* grid)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_get_column_homogeneous", "GtkGrid*");
- return(C_TO_XEN_gboolean(gtk_grid_get_column_homogeneous(XEN_TO_C_GtkGrid_(grid))));
+ #define H_gtk_icon_theme_load_icon_for_scale "GdkPixbuf* gtk_icon_theme_load_icon_for_scale(GtkIconTheme* icon_theme, \
+gchar* icon_name, gint size, gint scale, GtkIconLookupFlags flags, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_load_icon_for_scale", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_icon_theme_load_icon_for_scale", "gchar*");
+ Xen_check_type(Xen_is_gint(size), size, 3, "gtk_icon_theme_load_icon_for_scale", "gint");
+ Xen_check_type(Xen_is_gint(scale), scale, 4, "gtk_icon_theme_load_icon_for_scale", "gint");
+ Xen_check_type(Xen_is_GtkIconLookupFlags(flags), flags, 5, "gtk_icon_theme_load_icon_for_scale", "GtkIconLookupFlags");
+ {
+ Xen result;
+ result = C_to_Xen_GdkPixbuf_(gtk_icon_theme_load_icon_for_scale(Xen_to_C_GtkIconTheme_(icon_theme), (const gchar*)Xen_to_C_gchar_(icon_name),
+ Xen_to_C_gint(size), Xen_to_C_gint(scale), Xen_to_C_GtkIconLookupFlags(flags),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_grid_set_column_spacing(XEN grid, XEN spacing)
+static Xen gxg_gtk_icon_theme_load_surface(Xen icon_theme, Xen icon_name, Xen size, Xen scale, Xen for_window, Xen flags, Xen ignore_error)
{
- #define H_gtk_grid_set_column_spacing "void gtk_grid_set_column_spacing(GtkGrid* grid, guint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_set_column_spacing", "GtkGrid*");
- XEN_ASSERT_TYPE(XEN_guint_P(spacing), spacing, 2, "gtk_grid_set_column_spacing", "guint");
- gtk_grid_set_column_spacing(XEN_TO_C_GtkGrid_(grid), XEN_TO_C_guint(spacing));
- return(XEN_FALSE);
+ #define H_gtk_icon_theme_load_surface "cairo_surface_t* gtk_icon_theme_load_surface(GtkIconTheme* icon_theme, \
+gchar* icon_name, gint size, gint scale, GdkWindow* for_window, GtkIconLookupFlags flags, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_load_surface", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(icon_name), icon_name, 2, "gtk_icon_theme_load_surface", "gchar*");
+ Xen_check_type(Xen_is_gint(size), size, 3, "gtk_icon_theme_load_surface", "gint");
+ Xen_check_type(Xen_is_gint(scale), scale, 4, "gtk_icon_theme_load_surface", "gint");
+ Xen_check_type(Xen_is_GdkWindow_(for_window), for_window, 5, "gtk_icon_theme_load_surface", "GdkWindow*");
+ Xen_check_type(Xen_is_GtkIconLookupFlags(flags), flags, 6, "gtk_icon_theme_load_surface", "GtkIconLookupFlags");
+ {
+ Xen result;
+ result = C_to_Xen_cairo_surface_t_(gtk_icon_theme_load_surface(Xen_to_C_GtkIconTheme_(icon_theme), (const gchar*)Xen_to_C_gchar_(icon_name),
+ Xen_to_C_gint(size), Xen_to_C_gint(scale), Xen_to_C_GdkWindow_(for_window),
+ Xen_to_C_GtkIconLookupFlags(flags), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_grid_get_column_spacing(XEN grid)
+static Xen gxg_gtk_icon_theme_lookup_by_gicon_for_scale(Xen icon_theme, Xen icon, Xen size, Xen scale, Xen flags)
{
- #define H_gtk_grid_get_column_spacing "guint gtk_grid_get_column_spacing(GtkGrid* grid)"
- XEN_ASSERT_TYPE(XEN_GtkGrid__P(grid), grid, 1, "gtk_grid_get_column_spacing", "GtkGrid*");
- return(C_TO_XEN_guint(gtk_grid_get_column_spacing(XEN_TO_C_GtkGrid_(grid))));
+ #define H_gtk_icon_theme_lookup_by_gicon_for_scale "GtkIconInfo* gtk_icon_theme_lookup_by_gicon_for_scale(GtkIconTheme* icon_theme, \
+GIcon* icon, gint size, gint scale, GtkIconLookupFlags flags)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_lookup_by_gicon_for_scale", "GtkIconTheme*");
+ Xen_check_type(Xen_is_GIcon_(icon), icon, 2, "gtk_icon_theme_lookup_by_gicon_for_scale", "GIcon*");
+ Xen_check_type(Xen_is_gint(size), size, 3, "gtk_icon_theme_lookup_by_gicon_for_scale", "gint");
+ Xen_check_type(Xen_is_gint(scale), scale, 4, "gtk_icon_theme_lookup_by_gicon_for_scale", "gint");
+ Xen_check_type(Xen_is_GtkIconLookupFlags(flags), flags, 5, "gtk_icon_theme_lookup_by_gicon_for_scale", "GtkIconLookupFlags");
+ return(C_to_Xen_GtkIconInfo_(gtk_icon_theme_lookup_by_gicon_for_scale(Xen_to_C_GtkIconTheme_(icon_theme), Xen_to_C_GIcon_(icon),
+ Xen_to_C_gint(size), Xen_to_C_gint(scale), Xen_to_C_GtkIconLookupFlags(flags))));
}
-static XEN gxg_gtk_scrollable_get_hadjustment(XEN scrollable)
+static Xen gxg_gtk_icon_info_get_base_scale(Xen icon_info)
{
- #define H_gtk_scrollable_get_hadjustment "GtkAdjustment* gtk_scrollable_get_hadjustment(GtkScrollable* scrollable)"
- XEN_ASSERT_TYPE(XEN_GtkScrollable__P(scrollable), scrollable, 1, "gtk_scrollable_get_hadjustment", "GtkScrollable*");
- return(C_TO_XEN_GtkAdjustment_(gtk_scrollable_get_hadjustment(XEN_TO_C_GtkScrollable_(scrollable))));
+ #define H_gtk_icon_info_get_base_scale "gint gtk_icon_info_get_base_scale(GtkIconInfo* icon_info)"
+ Xen_check_type(Xen_is_GtkIconInfo_(icon_info), icon_info, 1, "gtk_icon_info_get_base_scale", "GtkIconInfo*");
+ return(C_to_Xen_gint(gtk_icon_info_get_base_scale(Xen_to_C_GtkIconInfo_(icon_info))));
}
-static XEN gxg_gtk_scrollable_set_hadjustment(XEN scrollable, XEN hadjustment)
+static Xen gxg_gtk_icon_info_load_surface(Xen icon_info, Xen for_window, Xen ignore_error)
{
- #define H_gtk_scrollable_set_hadjustment "void gtk_scrollable_set_hadjustment(GtkScrollable* scrollable, \
-GtkAdjustment* hadjustment)"
- XEN_ASSERT_TYPE(XEN_GtkScrollable__P(scrollable), scrollable, 1, "gtk_scrollable_set_hadjustment", "GtkScrollable*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(hadjustment), hadjustment, 2, "gtk_scrollable_set_hadjustment", "GtkAdjustment*");
- gtk_scrollable_set_hadjustment(XEN_TO_C_GtkScrollable_(scrollable), XEN_TO_C_GtkAdjustment_(hadjustment));
- return(XEN_FALSE);
+ #define H_gtk_icon_info_load_surface "cairo_surface_t* gtk_icon_info_load_surface(GtkIconInfo* icon_info, \
+GdkWindow* for_window, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GtkIconInfo_(icon_info), icon_info, 1, "gtk_icon_info_load_surface", "GtkIconInfo*");
+ Xen_check_type(Xen_is_GdkWindow_(for_window), for_window, 2, "gtk_icon_info_load_surface", "GdkWindow*");
+ {
+ Xen result;
+ result = C_to_Xen_cairo_surface_t_(gtk_icon_info_load_surface(Xen_to_C_GtkIconInfo_(icon_info), Xen_to_C_GdkWindow_(for_window),
+ &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_scrollable_get_vadjustment(XEN scrollable)
+static Xen gxg_gtk_image_new_from_surface(Xen surface)
{
- #define H_gtk_scrollable_get_vadjustment "GtkAdjustment* gtk_scrollable_get_vadjustment(GtkScrollable* scrollable)"
- XEN_ASSERT_TYPE(XEN_GtkScrollable__P(scrollable), scrollable, 1, "gtk_scrollable_get_vadjustment", "GtkScrollable*");
- return(C_TO_XEN_GtkAdjustment_(gtk_scrollable_get_vadjustment(XEN_TO_C_GtkScrollable_(scrollable))));
+ #define H_gtk_image_new_from_surface "GtkWidget* gtk_image_new_from_surface(cairo_surface_t* surface)"
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "gtk_image_new_from_surface", "cairo_surface_t*");
+ return(C_to_Xen_GtkWidget_(gtk_image_new_from_surface(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_gtk_scrollable_set_vadjustment(XEN scrollable, XEN vadjustment)
+static Xen gxg_gtk_image_set_from_surface(Xen image, Xen surface)
{
- #define H_gtk_scrollable_set_vadjustment "void gtk_scrollable_set_vadjustment(GtkScrollable* scrollable, \
-GtkAdjustment* vadjustment)"
- XEN_ASSERT_TYPE(XEN_GtkScrollable__P(scrollable), scrollable, 1, "gtk_scrollable_set_vadjustment", "GtkScrollable*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(vadjustment), vadjustment, 2, "gtk_scrollable_set_vadjustment", "GtkAdjustment*");
- gtk_scrollable_set_vadjustment(XEN_TO_C_GtkScrollable_(scrollable), XEN_TO_C_GtkAdjustment_(vadjustment));
- return(XEN_FALSE);
+ #define H_gtk_image_set_from_surface "void gtk_image_set_from_surface(GtkImage* image, cairo_surface_t* surface)"
+ Xen_check_type(Xen_is_GtkImage_(image), image, 1, "gtk_image_set_from_surface", "GtkImage*");
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 2, "gtk_image_set_from_surface", "cairo_surface_t*");
+ gtk_image_set_from_surface(Xen_to_C_GtkImage_(image), Xen_to_C_cairo_surface_t_(surface));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_next_page(XEN assistant)
+static Xen gxg_gtk_list_box_row_get_index(Xen row)
{
- #define H_gtk_assistant_next_page "void gtk_assistant_next_page(GtkAssistant* assistant)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_next_page", "GtkAssistant*");
- gtk_assistant_next_page(XEN_TO_C_GtkAssistant_(assistant));
- return(XEN_FALSE);
+ #define H_gtk_list_box_row_get_index "gint gtk_list_box_row_get_index(GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_get_index", "GtkListBoxRow*");
+ return(C_to_Xen_gint(gtk_list_box_row_get_index(Xen_to_C_GtkListBoxRow_(row))));
}
-static XEN gxg_gtk_assistant_previous_page(XEN assistant)
+static Xen gxg_gtk_widget_get_scale_factor(Xen widget)
{
- #define H_gtk_assistant_previous_page "void gtk_assistant_previous_page(GtkAssistant* assistant)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_previous_page", "GtkAssistant*");
- gtk_assistant_previous_page(XEN_TO_C_GtkAssistant_(assistant));
- return(XEN_FALSE);
+ #define H_gtk_widget_get_scale_factor "gint gtk_widget_get_scale_factor(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_scale_factor", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_widget_get_scale_factor(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_combo_box_new_with_model_and_entry(XEN model)
+static Xen gxg_gtk_window_close(Xen window)
{
- #define H_gtk_combo_box_new_with_model_and_entry "GtkWidget* gtk_combo_box_new_with_model_and_entry(GtkTreeModel* model)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(model), model, 1, "gtk_combo_box_new_with_model_and_entry", "GtkTreeModel*");
- return(C_TO_XEN_GtkWidget_(gtk_combo_box_new_with_model_and_entry(XEN_TO_C_GtkTreeModel_(model))));
+ #define H_gtk_window_close "void gtk_window_close(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_close", "GtkWindow*");
+ gtk_window_close(Xen_to_C_GtkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrollable_get_hscroll_policy(XEN scrollable)
+static Xen gxg_gtk_info_bar_set_show_close_button(Xen info_bar, Xen setting)
{
- #define H_gtk_scrollable_get_hscroll_policy "GtkScrollablePolicy gtk_scrollable_get_hscroll_policy(GtkScrollable* scrollable)"
- XEN_ASSERT_TYPE(XEN_GtkScrollable__P(scrollable), scrollable, 1, "gtk_scrollable_get_hscroll_policy", "GtkScrollable*");
- return(C_TO_XEN_GtkScrollablePolicy(gtk_scrollable_get_hscroll_policy(XEN_TO_C_GtkScrollable_(scrollable))));
+ #define H_gtk_info_bar_set_show_close_button "void gtk_info_bar_set_show_close_button(GtkInfoBar* info_bar, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_set_show_close_button", "GtkInfoBar*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_info_bar_set_show_close_button", "gboolean");
+ gtk_info_bar_set_show_close_button(Xen_to_C_GtkInfoBar_(info_bar), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrollable_set_hscroll_policy(XEN scrollable, XEN policy)
+static Xen gxg_gtk_info_bar_get_show_close_button(Xen info_bar)
{
- #define H_gtk_scrollable_set_hscroll_policy "void gtk_scrollable_set_hscroll_policy(GtkScrollable* scrollable, \
-GtkScrollablePolicy policy)"
- XEN_ASSERT_TYPE(XEN_GtkScrollable__P(scrollable), scrollable, 1, "gtk_scrollable_set_hscroll_policy", "GtkScrollable*");
- XEN_ASSERT_TYPE(XEN_GtkScrollablePolicy_P(policy), policy, 2, "gtk_scrollable_set_hscroll_policy", "GtkScrollablePolicy");
- gtk_scrollable_set_hscroll_policy(XEN_TO_C_GtkScrollable_(scrollable), XEN_TO_C_GtkScrollablePolicy(policy));
- return(XEN_FALSE);
+ #define H_gtk_info_bar_get_show_close_button "gboolean gtk_info_bar_get_show_close_button(GtkInfoBar* info_bar)"
+ Xen_check_type(Xen_is_GtkInfoBar_(info_bar), info_bar, 1, "gtk_info_bar_get_show_close_button", "GtkInfoBar*");
+ return(C_to_Xen_gboolean(gtk_info_bar_get_show_close_button(Xen_to_C_GtkInfoBar_(info_bar))));
}
-static XEN gxg_gtk_scrollable_get_vscroll_policy(XEN scrollable)
+static Xen gxg_gtk_tree_model_rows_reordered_with_length(Xen tree_model, Xen path, Xen iter, Xen new_order, Xen length)
{
- #define H_gtk_scrollable_get_vscroll_policy "GtkScrollablePolicy gtk_scrollable_get_vscroll_policy(GtkScrollable* scrollable)"
- XEN_ASSERT_TYPE(XEN_GtkScrollable__P(scrollable), scrollable, 1, "gtk_scrollable_get_vscroll_policy", "GtkScrollable*");
- return(C_TO_XEN_GtkScrollablePolicy(gtk_scrollable_get_vscroll_policy(XEN_TO_C_GtkScrollable_(scrollable))));
+ #define H_gtk_tree_model_rows_reordered_with_length "void gtk_tree_model_rows_reordered_with_length(GtkTreeModel* tree_model, \
+GtkTreePath* path, GtkTreeIter* iter, gint* new_order, gint length)"
+ Xen_check_type(Xen_is_GtkTreeModel_(tree_model), tree_model, 1, "gtk_tree_model_rows_reordered_with_length", "GtkTreeModel*");
+ Xen_check_type(Xen_is_GtkTreePath_(path), path, 2, "gtk_tree_model_rows_reordered_with_length", "GtkTreePath*");
+ Xen_check_type(Xen_is_GtkTreeIter_(iter), iter, 3, "gtk_tree_model_rows_reordered_with_length", "GtkTreeIter*");
+ Xen_check_type(Xen_is_gint_(new_order), new_order, 4, "gtk_tree_model_rows_reordered_with_length", "gint*");
+ Xen_check_type(Xen_is_gint(length), length, 5, "gtk_tree_model_rows_reordered_with_length", "gint");
+ gtk_tree_model_rows_reordered_with_length(Xen_to_C_GtkTreeModel_(tree_model), Xen_to_C_GtkTreePath_(path), Xen_to_C_GtkTreeIter_(iter),
+ Xen_to_C_gint_(new_order), Xen_to_C_gint(length));
+ return(Xen_false);
}
-static XEN gxg_gtk_scrollable_set_vscroll_policy(XEN scrollable, XEN policy)
+static Xen gxg_gdk_cursor_new_from_surface(Xen display, Xen surface, Xen x, Xen y)
{
- #define H_gtk_scrollable_set_vscroll_policy "void gtk_scrollable_set_vscroll_policy(GtkScrollable* scrollable, \
-GtkScrollablePolicy policy)"
- XEN_ASSERT_TYPE(XEN_GtkScrollable__P(scrollable), scrollable, 1, "gtk_scrollable_set_vscroll_policy", "GtkScrollable*");
- XEN_ASSERT_TYPE(XEN_GtkScrollablePolicy_P(policy), policy, 2, "gtk_scrollable_set_vscroll_policy", "GtkScrollablePolicy");
- gtk_scrollable_set_vscroll_policy(XEN_TO_C_GtkScrollable_(scrollable), XEN_TO_C_GtkScrollablePolicy(policy));
- return(XEN_FALSE);
+ #define H_gdk_cursor_new_from_surface "GdkCursor* gdk_cursor_new_from_surface(GdkDisplay* display, \
+cairo_surface_t* surface, gdouble x, gdouble y)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gdk_cursor_new_from_surface", "GdkDisplay*");
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 2, "gdk_cursor_new_from_surface", "cairo_surface_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gdk_cursor_new_from_surface", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gdk_cursor_new_from_surface", "gdouble");
+ return(C_to_Xen_GdkCursor_(gdk_cursor_new_from_surface(Xen_to_C_GdkDisplay_(display), Xen_to_C_cairo_surface_t_(surface),
+ Xen_to_C_gdouble(x), Xen_to_C_gdouble(y))));
}
-static XEN gxg_gtk_switch_new(void)
+static Xen gxg_gdk_cursor_get_surface(Xen cursor, Xen ignore_x_hot, Xen ignore_y_hot)
{
- #define H_gtk_switch_new "GtkWidget* gtk_switch_new( void)"
- return(C_TO_XEN_GtkWidget_(gtk_switch_new()));
+ #define H_gdk_cursor_get_surface "cairo_surface_t* gdk_cursor_get_surface(GdkCursor* cursor, gdouble* [x_hot], \
+gdouble* [y_hot])"
+ gdouble ref_x_hot;
+ gdouble ref_y_hot;
+ Xen_check_type(Xen_is_GdkCursor_(cursor), cursor, 1, "gdk_cursor_get_surface", "GdkCursor*");
+ {
+ Xen result;
+ result = C_to_Xen_cairo_surface_t_(gdk_cursor_get_surface(Xen_to_C_GdkCursor_(cursor), &ref_x_hot, &ref_y_hot));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_x_hot), C_to_Xen_gdouble(ref_y_hot)));
+ }
}
-static XEN gxg_gtk_switch_set_active(XEN sw, XEN is_active)
+static Xen gxg_gdk_event_get_event_type(Xen event)
{
- #define H_gtk_switch_set_active "void gtk_switch_set_active(GtkSwitch* sw, gboolean is_active)"
- XEN_ASSERT_TYPE(XEN_GtkSwitch__P(sw), sw, 1, "gtk_switch_set_active", "GtkSwitch*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(is_active), is_active, 2, "gtk_switch_set_active", "gboolean");
- gtk_switch_set_active(XEN_TO_C_GtkSwitch_(sw), XEN_TO_C_gboolean(is_active));
- return(XEN_FALSE);
+ #define H_gdk_event_get_event_type "GdkEventType gdk_event_get_event_type(GdkEvent* event)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_event_type", "GdkEvent*");
+ return(C_to_Xen_GdkEventType(gdk_event_get_event_type(Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_switch_get_active(XEN sw)
+static Xen gxg_gtk_entry_set_tabs(Xen entry, Xen tabs)
{
- #define H_gtk_switch_get_active "gboolean gtk_switch_get_active(GtkSwitch* sw)"
- XEN_ASSERT_TYPE(XEN_GtkSwitch__P(sw), sw, 1, "gtk_switch_get_active", "GtkSwitch*");
- return(C_TO_XEN_gboolean(gtk_switch_get_active(XEN_TO_C_GtkSwitch_(sw))));
+ #define H_gtk_entry_set_tabs "void gtk_entry_set_tabs(GtkEntry* entry, PangoTabArray* tabs)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_tabs", "GtkEntry*");
+ Xen_check_type(Xen_is_PangoTabArray_(tabs), tabs, 2, "gtk_entry_set_tabs", "PangoTabArray*");
+ gtk_entry_set_tabs(Xen_to_C_GtkEntry_(entry), Xen_to_C_PangoTabArray_(tabs));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_clip_region(XEN window)
+static Xen gxg_gtk_entry_get_tabs(Xen entry)
{
- #define H_gdk_window_get_clip_region "cairo_region_t* gdk_window_get_clip_region(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_clip_region", "GdkWindow*");
- return(C_TO_XEN_cairo_region_t_(gdk_window_get_clip_region(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_entry_get_tabs "PangoTabArray* gtk_entry_get_tabs(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_tabs", "GtkEntry*");
+ return(C_to_Xen_PangoTabArray_(gtk_entry_get_tabs(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gdk_window_get_visible_region(XEN window)
+static Xen gxg_gtk_header_bar_get_show_close_button(Xen bar)
{
- #define H_gdk_window_get_visible_region "cairo_region_t* gdk_window_get_visible_region(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_visible_region", "GdkWindow*");
- return(C_TO_XEN_cairo_region_t_(gdk_window_get_visible_region(XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_header_bar_get_show_close_button "gboolean gtk_header_bar_get_show_close_button(GtkHeaderBar* bar)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_get_show_close_button", "GtkHeaderBar*");
+ return(C_to_Xen_gboolean(gtk_header_bar_get_show_close_button(Xen_to_C_GtkHeaderBar_(bar))));
}
-static XEN gxg_gtk_border_new(void)
+static Xen gxg_gtk_header_bar_set_show_close_button(Xen bar, Xen setting)
{
- #define H_gtk_border_new "GtkBorder* gtk_border_new( void)"
- return(C_TO_XEN_GtkBorder_(gtk_border_new()));
+ #define H_gtk_header_bar_set_show_close_button "void gtk_header_bar_set_show_close_button(GtkHeaderBar* bar, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_set_show_close_button", "GtkHeaderBar*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_header_bar_set_show_close_button", "gboolean");
+ gtk_header_bar_set_show_close_button(Xen_to_C_GtkHeaderBar_(bar), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_border_copy(XEN border_)
+static Xen gxg_gtk_list_box_prepend(Xen list_box, Xen child)
{
- #define H_gtk_border_copy "GtkBorder* gtk_border_copy(GtkBorder* border_)"
- XEN_ASSERT_TYPE(XEN_GtkBorder__P(border_), border_, 1, "gtk_border_copy", "GtkBorder*");
- return(C_TO_XEN_GtkBorder_(gtk_border_copy(XEN_TO_C_GtkBorder_(border_))));
+ #define H_gtk_list_box_prepend "void gtk_list_box_prepend(GtkListBox* list_box, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_prepend", "GtkListBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_list_box_prepend", "GtkWidget*");
+ gtk_list_box_prepend(Xen_to_C_GtkListBox_(list_box), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_border_free(XEN border_)
+static Xen gxg_gtk_list_box_insert(Xen list_box, Xen child, Xen position)
{
- #define H_gtk_border_free "void gtk_border_free(GtkBorder* border_)"
- XEN_ASSERT_TYPE(XEN_GtkBorder__P(border_), border_, 1, "gtk_border_free", "GtkBorder*");
- gtk_border_free(XEN_TO_C_GtkBorder_(border_));
- return(XEN_FALSE);
+ #define H_gtk_list_box_insert "void gtk_list_box_insert(GtkListBox* list_box, GtkWidget* child, gint position)"
+ Xen_check_type(Xen_is_GtkListBox_(list_box), list_box, 1, "gtk_list_box_insert", "GtkListBox*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_list_box_insert", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_list_box_insert", "gint");
+ gtk_list_box_insert(Xen_to_C_GtkListBox_(list_box), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_get_id_column(XEN combo_box)
+static Xen gxg_gdk_window_set_opaque_region(Xen window, Xen region)
{
- #define H_gtk_combo_box_get_id_column "gint gtk_combo_box_get_id_column(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_id_column", "GtkComboBox*");
- return(C_TO_XEN_gint(gtk_combo_box_get_id_column(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gdk_window_set_opaque_region "void gdk_window_set_opaque_region(GdkWindow* window, cairo_region_t* region)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_opaque_region", "GdkWindow*");
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 2, "gdk_window_set_opaque_region", "cairo_region_t*");
+ gdk_window_set_opaque_region(Xen_to_C_GdkWindow_(window), Xen_to_C_cairo_region_t_(region));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_set_id_column(XEN combo_box, XEN id_column)
+static Xen gxg_gtk_label_set_lines(Xen label, Xen lines)
{
- #define H_gtk_combo_box_set_id_column "void gtk_combo_box_set_id_column(GtkComboBox* combo_box, gint id_column)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_id_column", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gint_P(id_column), id_column, 2, "gtk_combo_box_set_id_column", "gint");
- gtk_combo_box_set_id_column(XEN_TO_C_GtkComboBox_(combo_box), XEN_TO_C_gint(id_column));
- return(XEN_FALSE);
+ #define H_gtk_label_set_lines "void gtk_label_set_lines(GtkLabel* label, gint lines)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_lines", "GtkLabel*");
+ Xen_check_type(Xen_is_gint(lines), lines, 2, "gtk_label_set_lines", "gint");
+ gtk_label_set_lines(Xen_to_C_GtkLabel_(label), Xen_to_C_gint(lines));
+ return(Xen_false);
}
-static XEN gxg_gtk_combo_box_get_active_id(XEN combo_box)
+static Xen gxg_gtk_label_get_lines(Xen label)
{
- #define H_gtk_combo_box_get_active_id "gchar* gtk_combo_box_get_active_id(GtkComboBox* combo_box)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_get_active_id", "GtkComboBox*");
- return(C_TO_XEN_gchar_(gtk_combo_box_get_active_id(XEN_TO_C_GtkComboBox_(combo_box))));
+ #define H_gtk_label_get_lines "gint gtk_label_get_lines(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_lines", "GtkLabel*");
+ return(C_to_Xen_gint(gtk_label_get_lines(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gtk_combo_box_set_active_id(XEN combo_box, XEN active_id)
+static Xen gxg_gdk_event_get_window(Xen event)
{
- #define H_gtk_combo_box_set_active_id "void gtk_combo_box_set_active_id(GtkComboBox* combo_box, gchar* active_id)"
- XEN_ASSERT_TYPE(XEN_GtkComboBox__P(combo_box), combo_box, 1, "gtk_combo_box_set_active_id", "GtkComboBox*");
- XEN_ASSERT_TYPE(XEN_gchar__P(active_id), active_id, 2, "gtk_combo_box_set_active_id", "gchar*");
- gtk_combo_box_set_active_id(XEN_TO_C_GtkComboBox_(combo_box), (const gchar*)XEN_TO_C_gchar_(active_id));
- return(XEN_FALSE);
+ #define H_gdk_event_get_window "GdkWindow* gdk_event_get_window(GdkEvent* event)"
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 1, "gdk_event_get_window", "GdkEvent*");
+ return(C_to_Xen_GdkWindow_(gdk_event_get_window(Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_combo_box_text_insert(XEN combo_box, XEN position, XEN id, XEN text)
+#endif
+
+#if GTK_CHECK_VERSION(3, 12, 0)
+static Xen gxg_gtk_flow_box_child_new(void)
{
- #define H_gtk_combo_box_text_insert "void gtk_combo_box_text_insert(GtkComboBoxText* combo_box, gint position, \
-gchar* id, gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_insert", "GtkComboBoxText*");
- XEN_ASSERT_TYPE(XEN_gint_P(position), position, 2, "gtk_combo_box_text_insert", "gint");
- XEN_ASSERT_TYPE(XEN_gchar__P(id), id, 3, "gtk_combo_box_text_insert", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 4, "gtk_combo_box_text_insert", "gchar*");
- gtk_combo_box_text_insert(XEN_TO_C_GtkComboBoxText_(combo_box), XEN_TO_C_gint(position), (const gchar*)XEN_TO_C_gchar_(id), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_child_new "GtkWidget* gtk_flow_box_child_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_flow_box_child_new()));
}
-static XEN gxg_gtk_combo_box_text_append(XEN combo_box, XEN id, XEN text)
+static Xen gxg_gtk_flow_box_child_get_index(Xen child)
{
- #define H_gtk_combo_box_text_append "void gtk_combo_box_text_append(GtkComboBoxText* combo_box, gchar* id, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_append", "GtkComboBoxText*");
- XEN_ASSERT_TYPE(XEN_gchar__P(id), id, 2, "gtk_combo_box_text_append", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_combo_box_text_append", "gchar*");
- gtk_combo_box_text_append(XEN_TO_C_GtkComboBoxText_(combo_box), (const gchar*)XEN_TO_C_gchar_(id), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_child_get_index "gint gtk_flow_box_child_get_index(GtkFlowBoxChild* child)"
+ Xen_check_type(Xen_is_GtkFlowBoxChild_(child), child, 1, "gtk_flow_box_child_get_index", "GtkFlowBoxChild*");
+ return(C_to_Xen_gint(gtk_flow_box_child_get_index(Xen_to_C_GtkFlowBoxChild_(child))));
}
-static XEN gxg_gtk_combo_box_text_prepend(XEN combo_box, XEN id, XEN text)
+static Xen gxg_gtk_flow_box_child_is_selected(Xen child)
{
- #define H_gtk_combo_box_text_prepend "void gtk_combo_box_text_prepend(GtkComboBoxText* combo_box, gchar* id, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkComboBoxText__P(combo_box), combo_box, 1, "gtk_combo_box_text_prepend", "GtkComboBoxText*");
- XEN_ASSERT_TYPE(XEN_gchar__P(id), id, 2, "gtk_combo_box_text_prepend", "gchar*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 3, "gtk_combo_box_text_prepend", "gchar*");
- gtk_combo_box_text_prepend(XEN_TO_C_GtkComboBoxText_(combo_box), (const gchar*)XEN_TO_C_gchar_(id), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_child_is_selected "gboolean gtk_flow_box_child_is_selected(GtkFlowBoxChild* child)"
+ Xen_check_type(Xen_is_GtkFlowBoxChild_(child), child, 1, "gtk_flow_box_child_is_selected", "GtkFlowBoxChild*");
+ return(C_to_Xen_gboolean(gtk_flow_box_child_is_selected(Xen_to_C_GtkFlowBoxChild_(child))));
}
-static XEN gxg_gtk_button_box_new(XEN orientation)
+static Xen gxg_gtk_flow_box_child_changed(Xen child)
{
- #define H_gtk_button_box_new "GtkWidget* gtk_button_box_new(GtkOrientation orientation)"
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_button_box_new", "GtkOrientation");
- return(C_TO_XEN_GtkWidget_(gtk_button_box_new(XEN_TO_C_GtkOrientation(orientation))));
+ #define H_gtk_flow_box_child_changed "void gtk_flow_box_child_changed(GtkFlowBoxChild* child)"
+ Xen_check_type(Xen_is_GtkFlowBoxChild_(child), child, 1, "gtk_flow_box_child_changed", "GtkFlowBoxChild*");
+ gtk_flow_box_child_changed(Xen_to_C_GtkFlowBoxChild_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_box_new(XEN orientation, XEN spacing)
+static Xen gxg_gtk_flow_box_new(void)
{
- #define H_gtk_box_new "GtkWidget* gtk_box_new(GtkOrientation orientation, gint spacing)"
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 1, "gtk_box_new", "GtkOrientation");
- XEN_ASSERT_TYPE(XEN_gint_P(spacing), spacing, 2, "gtk_box_new", "gint");
- return(C_TO_XEN_GtkWidget_(gtk_box_new(XEN_TO_C_GtkOrientation(orientation), XEN_TO_C_gint(spacing))));
+ #define H_gtk_flow_box_new "GtkWidget* gtk_flow_box_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_flow_box_new()));
}
-static XEN gxg_gtk_activatable_sync_action_properties(XEN activatable, XEN action)
+static Xen gxg_gtk_flow_box_set_homogeneous(Xen box, Xen homogeneous)
{
- #define H_gtk_activatable_sync_action_properties "void gtk_activatable_sync_action_properties(GtkActivatable* activatable, \
-GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkActivatable__P(activatable), activatable, 1, "gtk_activatable_sync_action_properties", "GtkActivatable*");
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 2, "gtk_activatable_sync_action_properties", "GtkAction*");
- gtk_activatable_sync_action_properties(XEN_TO_C_GtkActivatable_(activatable), XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_set_homogeneous "void gtk_flow_box_set_homogeneous(GtkFlowBox* box, gboolean homogeneous)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_homogeneous", "GtkFlowBox*");
+ Xen_check_type(Xen_is_gboolean(homogeneous), homogeneous, 2, "gtk_flow_box_set_homogeneous", "gboolean");
+ gtk_flow_box_set_homogeneous(Xen_to_C_GtkFlowBox_(box), Xen_to_C_gboolean(homogeneous));
+ return(Xen_false);
}
-static XEN gxg_gtk_activatable_set_related_action(XEN activatable, XEN action)
+static Xen gxg_gtk_flow_box_get_homogeneous(Xen box)
{
- #define H_gtk_activatable_set_related_action "void gtk_activatable_set_related_action(GtkActivatable* activatable, \
-GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkActivatable__P(activatable), activatable, 1, "gtk_activatable_set_related_action", "GtkActivatable*");
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 2, "gtk_activatable_set_related_action", "GtkAction*");
- gtk_activatable_set_related_action(XEN_TO_C_GtkActivatable_(activatable), XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_get_homogeneous "gboolean gtk_flow_box_get_homogeneous(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_homogeneous", "GtkFlowBox*");
+ return(C_to_Xen_gboolean(gtk_flow_box_get_homogeneous(Xen_to_C_GtkFlowBox_(box))));
}
-static XEN gxg_gtk_activatable_get_related_action(XEN activatable)
+static Xen gxg_gtk_flow_box_set_row_spacing(Xen box, Xen spacing)
{
- #define H_gtk_activatable_get_related_action "GtkAction* gtk_activatable_get_related_action(GtkActivatable* activatable)"
- XEN_ASSERT_TYPE(XEN_GtkActivatable__P(activatable), activatable, 1, "gtk_activatable_get_related_action", "GtkActivatable*");
- return(C_TO_XEN_GtkAction_(gtk_activatable_get_related_action(XEN_TO_C_GtkActivatable_(activatable))));
+ #define H_gtk_flow_box_set_row_spacing "void gtk_flow_box_set_row_spacing(GtkFlowBox* box, guint spacing)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_row_spacing", "GtkFlowBox*");
+ Xen_check_type(Xen_is_guint(spacing), spacing, 2, "gtk_flow_box_set_row_spacing", "guint");
+ gtk_flow_box_set_row_spacing(Xen_to_C_GtkFlowBox_(box), Xen_to_C_guint(spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_activatable_set_use_action_appearance(XEN activatable, XEN use_appearance)
+static Xen gxg_gtk_flow_box_get_row_spacing(Xen box)
{
- #define H_gtk_activatable_set_use_action_appearance "void gtk_activatable_set_use_action_appearance(GtkActivatable* activatable, \
-gboolean use_appearance)"
- XEN_ASSERT_TYPE(XEN_GtkActivatable__P(activatable), activatable, 1, "gtk_activatable_set_use_action_appearance", "GtkActivatable*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_appearance), use_appearance, 2, "gtk_activatable_set_use_action_appearance", "gboolean");
- gtk_activatable_set_use_action_appearance(XEN_TO_C_GtkActivatable_(activatable), XEN_TO_C_gboolean(use_appearance));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_get_row_spacing "guint gtk_flow_box_get_row_spacing(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_row_spacing", "GtkFlowBox*");
+ return(C_to_Xen_guint(gtk_flow_box_get_row_spacing(Xen_to_C_GtkFlowBox_(box))));
}
-static XEN gxg_gtk_activatable_get_use_action_appearance(XEN activatable)
+static Xen gxg_gtk_flow_box_set_column_spacing(Xen box, Xen spacing)
{
- #define H_gtk_activatable_get_use_action_appearance "gboolean gtk_activatable_get_use_action_appearance(GtkActivatable* activatable)"
- XEN_ASSERT_TYPE(XEN_GtkActivatable__P(activatable), activatable, 1, "gtk_activatable_get_use_action_appearance", "GtkActivatable*");
- return(C_TO_XEN_gboolean(gtk_activatable_get_use_action_appearance(XEN_TO_C_GtkActivatable_(activatable))));
+ #define H_gtk_flow_box_set_column_spacing "void gtk_flow_box_set_column_spacing(GtkFlowBox* box, guint spacing)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_column_spacing", "GtkFlowBox*");
+ Xen_check_type(Xen_is_guint(spacing), spacing, 2, "gtk_flow_box_set_column_spacing", "guint");
+ gtk_flow_box_set_column_spacing(Xen_to_C_GtkFlowBox_(box), Xen_to_C_guint(spacing));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_set_cursor_on_cell(XEN tree_view, XEN path, XEN focus_column, XEN focus_cell, XEN start_editing)
+static Xen gxg_gtk_flow_box_get_column_spacing(Xen box)
{
- #define H_gtk_tree_view_set_cursor_on_cell "void gtk_tree_view_set_cursor_on_cell(GtkTreeView* tree_view, \
-GtkTreePath* path, GtkTreeViewColumn* focus_column, GtkCellRenderer* focus_cell, gboolean start_editing)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_cursor_on_cell", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_set_cursor_on_cell", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(focus_column), focus_column, 3, "gtk_tree_view_set_cursor_on_cell", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(focus_cell), focus_cell, 4, "gtk_tree_view_set_cursor_on_cell", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(start_editing), start_editing, 5, "gtk_tree_view_set_cursor_on_cell", "gboolean");
- gtk_tree_view_set_cursor_on_cell(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkTreeViewColumn_(focus_column),
- XEN_TO_C_GtkCellRenderer_(focus_cell), XEN_TO_C_gboolean(start_editing));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_get_column_spacing "guint gtk_flow_box_get_column_spacing(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_column_spacing", "GtkFlowBox*");
+ return(C_to_Xen_guint(gtk_flow_box_get_column_spacing(Xen_to_C_GtkFlowBox_(box))));
}
-static XEN gxg_gtk_tree_view_set_rubber_banding(XEN tree_view, XEN enable)
+static Xen gxg_gtk_flow_box_set_min_children_per_line(Xen box, Xen n_children)
{
- #define H_gtk_tree_view_set_rubber_banding "void gtk_tree_view_set_rubber_banding(GtkTreeView* tree_view, \
-gboolean enable)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_set_rubber_banding", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(enable), enable, 2, "gtk_tree_view_set_rubber_banding", "gboolean");
- gtk_tree_view_set_rubber_banding(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gboolean(enable));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_set_min_children_per_line "void gtk_flow_box_set_min_children_per_line(GtkFlowBox* box, \
+guint n_children)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_min_children_per_line", "GtkFlowBox*");
+ Xen_check_type(Xen_is_guint(n_children), n_children, 2, "gtk_flow_box_set_min_children_per_line", "guint");
+ gtk_flow_box_set_min_children_per_line(Xen_to_C_GtkFlowBox_(box), Xen_to_C_guint(n_children));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_get_rubber_banding(XEN tree_view)
+static Xen gxg_gtk_flow_box_get_min_children_per_line(Xen box)
{
- #define H_gtk_tree_view_get_rubber_banding "gboolean gtk_tree_view_get_rubber_banding(GtkTreeView* tree_view)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_get_rubber_banding", "GtkTreeView*");
- return(C_TO_XEN_gboolean(gtk_tree_view_get_rubber_banding(XEN_TO_C_GtkTreeView_(tree_view))));
+ #define H_gtk_flow_box_get_min_children_per_line "guint gtk_flow_box_get_min_children_per_line(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_min_children_per_line", "GtkFlowBox*");
+ return(C_to_Xen_guint(gtk_flow_box_get_min_children_per_line(Xen_to_C_GtkFlowBox_(box))));
}
-static XEN gxg_gtk_tooltip_set_markup(XEN tooltip, XEN markup)
+static Xen gxg_gtk_flow_box_set_max_children_per_line(Xen box, Xen n_children)
{
- #define H_gtk_tooltip_set_markup "void gtk_tooltip_set_markup(GtkTooltip* tooltip, gchar* markup)"
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 1, "gtk_tooltip_set_markup", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_gchar__P(markup), markup, 2, "gtk_tooltip_set_markup", "gchar*");
- gtk_tooltip_set_markup(XEN_TO_C_GtkTooltip_(tooltip), (const gchar*)XEN_TO_C_gchar_(markup));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_set_max_children_per_line "void gtk_flow_box_set_max_children_per_line(GtkFlowBox* box, \
+guint n_children)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_max_children_per_line", "GtkFlowBox*");
+ Xen_check_type(Xen_is_guint(n_children), n_children, 2, "gtk_flow_box_set_max_children_per_line", "guint");
+ gtk_flow_box_set_max_children_per_line(Xen_to_C_GtkFlowBox_(box), Xen_to_C_guint(n_children));
+ return(Xen_false);
}
-static XEN gxg_gtk_tooltip_set_icon(XEN tooltip, XEN pixbuf)
+static Xen gxg_gtk_flow_box_get_max_children_per_line(Xen box)
{
- #define H_gtk_tooltip_set_icon "void gtk_tooltip_set_icon(GtkTooltip* tooltip, GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 1, "gtk_tooltip_set_icon", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gtk_tooltip_set_icon", "GdkPixbuf*");
- gtk_tooltip_set_icon(XEN_TO_C_GtkTooltip_(tooltip), XEN_TO_C_GdkPixbuf_(pixbuf));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_get_max_children_per_line "guint gtk_flow_box_get_max_children_per_line(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_max_children_per_line", "GtkFlowBox*");
+ return(C_to_Xen_guint(gtk_flow_box_get_max_children_per_line(Xen_to_C_GtkFlowBox_(box))));
}
-static XEN gxg_gtk_tooltip_set_icon_from_stock(XEN tooltip, XEN stock_id, XEN size)
+static Xen gxg_gtk_flow_box_set_activate_on_single_click(Xen box, Xen single)
{
- #define H_gtk_tooltip_set_icon_from_stock "void gtk_tooltip_set_icon_from_stock(GtkTooltip* tooltip, \
-gchar* stock_id, GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 1, "gtk_tooltip_set_icon_from_stock", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_tooltip_set_icon_from_stock", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 3, "gtk_tooltip_set_icon_from_stock", "GtkIconSize");
- gtk_tooltip_set_icon_from_stock(XEN_TO_C_GtkTooltip_(tooltip), (const gchar*)XEN_TO_C_gchar_(stock_id), XEN_TO_C_GtkIconSize(size));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_set_activate_on_single_click "void gtk_flow_box_set_activate_on_single_click(GtkFlowBox* box, \
+gboolean single)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_activate_on_single_click", "GtkFlowBox*");
+ Xen_check_type(Xen_is_gboolean(single), single, 2, "gtk_flow_box_set_activate_on_single_click", "gboolean");
+ gtk_flow_box_set_activate_on_single_click(Xen_to_C_GtkFlowBox_(box), Xen_to_C_gboolean(single));
+ return(Xen_false);
}
-static XEN gxg_gtk_tooltip_set_custom(XEN tooltip, XEN custom_widget)
+static Xen gxg_gtk_flow_box_get_activate_on_single_click(Xen box)
{
- #define H_gtk_tooltip_set_custom "void gtk_tooltip_set_custom(GtkTooltip* tooltip, GtkWidget* custom_widget)"
- XEN_ASSERT_TYPE(XEN_GtkTooltip__P(tooltip), tooltip, 1, "gtk_tooltip_set_custom", "GtkTooltip*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(custom_widget), custom_widget, 2, "gtk_tooltip_set_custom", "GtkWidget*");
- gtk_tooltip_set_custom(XEN_TO_C_GtkTooltip_(tooltip), XEN_TO_C_GtkWidget_(custom_widget));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_get_activate_on_single_click "gboolean gtk_flow_box_get_activate_on_single_click(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_activate_on_single_click", "GtkFlowBox*");
+ return(C_to_Xen_gboolean(gtk_flow_box_get_activate_on_single_click(Xen_to_C_GtkFlowBox_(box))));
}
-static XEN gxg_gtk_tooltip_trigger_tooltip_query(XEN display)
+static Xen gxg_gtk_flow_box_insert(Xen box, Xen widget, Xen position)
{
- #define H_gtk_tooltip_trigger_tooltip_query "void gtk_tooltip_trigger_tooltip_query(GdkDisplay* display)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gtk_tooltip_trigger_tooltip_query", "GdkDisplay*");
- gtk_tooltip_trigger_tooltip_query(XEN_TO_C_GdkDisplay_(display));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_insert "void gtk_flow_box_insert(GtkFlowBox* box, GtkWidget* widget, gint position)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_insert", "GtkFlowBox*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_flow_box_insert", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_flow_box_insert", "gint");
+ gtk_flow_box_insert(Xen_to_C_GtkFlowBox_(box), Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_button_set_image_position(XEN button, XEN position)
+static Xen gxg_gtk_flow_box_get_child_at_index(Xen box, Xen idx)
{
- #define H_gtk_button_set_image_position "void gtk_button_set_image_position(GtkButton* button, GtkPositionType position)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_set_image_position", "GtkButton*");
- XEN_ASSERT_TYPE(XEN_GtkPositionType_P(position), position, 2, "gtk_button_set_image_position", "GtkPositionType");
- gtk_button_set_image_position(XEN_TO_C_GtkButton_(button), XEN_TO_C_GtkPositionType(position));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_get_child_at_index "GtkFlowBoxChild* gtk_flow_box_get_child_at_index(GtkFlowBox* box, \
+gint idx)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_child_at_index", "GtkFlowBox*");
+ Xen_check_type(Xen_is_gint(idx), idx, 2, "gtk_flow_box_get_child_at_index", "gint");
+ return(C_to_Xen_GtkFlowBoxChild_(gtk_flow_box_get_child_at_index(Xen_to_C_GtkFlowBox_(box), Xen_to_C_gint(idx))));
}
-static XEN gxg_gtk_button_get_image_position(XEN button)
+static Xen gxg_gtk_flow_box_get_selected_children(Xen box)
{
- #define H_gtk_button_get_image_position "GtkPositionType gtk_button_get_image_position(GtkButton* button)"
- XEN_ASSERT_TYPE(XEN_GtkButton__P(button), button, 1, "gtk_button_get_image_position", "GtkButton*");
- return(C_TO_XEN_GtkPositionType(gtk_button_get_image_position(XEN_TO_C_GtkButton_(button))));
+ #define H_gtk_flow_box_get_selected_children "GList* gtk_flow_box_get_selected_children(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_selected_children", "GtkFlowBox*");
+ return(C_to_Xen_GList_(gtk_flow_box_get_selected_children(Xen_to_C_GtkFlowBox_(box))));
}
-static XEN gxg_gtk_show_uri(XEN screen, XEN uri, XEN timestamp, XEN ignore_error)
+static Xen gxg_gtk_flow_box_select_child(Xen box, Xen child)
{
- #define H_gtk_show_uri "gboolean gtk_show_uri(GdkScreen* screen, gchar* uri, guint32 timestamp, GError** [error])"
- GError* ref_error = NULL;
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gtk_show_uri", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_gchar__P(uri), uri, 2, "gtk_show_uri", "gchar*");
- XEN_ASSERT_TYPE(XEN_guint32_P(timestamp), timestamp, 3, "gtk_show_uri", "guint32");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_show_uri(XEN_TO_C_GdkScreen_(screen), (const gchar*)XEN_TO_C_gchar_(uri), XEN_TO_C_guint32(timestamp),
- &ref_error));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_error)));
- }
+ #define H_gtk_flow_box_select_child "void gtk_flow_box_select_child(GtkFlowBox* box, GtkFlowBoxChild* child)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_select_child", "GtkFlowBox*");
+ Xen_check_type(Xen_is_GtkFlowBoxChild_(child), child, 2, "gtk_flow_box_select_child", "GtkFlowBoxChild*");
+ gtk_flow_box_select_child(Xen_to_C_GtkFlowBox_(box), Xen_to_C_GtkFlowBoxChild_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_new_with_area(XEN area)
+static Xen gxg_gtk_flow_box_unselect_child(Xen box, Xen child)
{
- #define H_gtk_tree_view_column_new_with_area "GtkTreeViewColumn* gtk_tree_view_column_new_with_area(GtkCellArea* area)"
- XEN_ASSERT_TYPE(XEN_GtkCellArea__P(area), area, 1, "gtk_tree_view_column_new_with_area", "GtkCellArea*");
- return(C_TO_XEN_GtkTreeViewColumn_(gtk_tree_view_column_new_with_area(XEN_TO_C_GtkCellArea_(area))));
+ #define H_gtk_flow_box_unselect_child "void gtk_flow_box_unselect_child(GtkFlowBox* box, GtkFlowBoxChild* child)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_unselect_child", "GtkFlowBox*");
+ Xen_check_type(Xen_is_GtkFlowBoxChild_(child), child, 2, "gtk_flow_box_unselect_child", "GtkFlowBoxChild*");
+ gtk_flow_box_unselect_child(Xen_to_C_GtkFlowBox_(box), Xen_to_C_GtkFlowBoxChild_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_get_button(XEN tree_column)
+static Xen gxg_gtk_flow_box_select_all(Xen box)
{
- #define H_gtk_tree_view_column_get_button "GtkWidget* gtk_tree_view_column_get_button(GtkTreeViewColumn* tree_column)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_get_button", "GtkTreeViewColumn*");
- return(C_TO_XEN_GtkWidget_(gtk_tree_view_column_get_button(XEN_TO_C_GtkTreeViewColumn_(tree_column))));
+ #define H_gtk_flow_box_select_all "void gtk_flow_box_select_all(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_select_all", "GtkFlowBox*");
+ gtk_flow_box_select_all(Xen_to_C_GtkFlowBox_(box));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_column_focus_cell(XEN tree_column, XEN cell)
+static Xen gxg_gtk_flow_box_unselect_all(Xen box)
{
- #define H_gtk_tree_view_column_focus_cell "void gtk_tree_view_column_focus_cell(GtkTreeViewColumn* tree_column, \
-GtkCellRenderer* cell)"
- XEN_ASSERT_TYPE(XEN_GtkTreeViewColumn__P(tree_column), tree_column, 1, "gtk_tree_view_column_focus_cell", "GtkTreeViewColumn*");
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 2, "gtk_tree_view_column_focus_cell", "GtkCellRenderer*");
- gtk_tree_view_column_focus_cell(XEN_TO_C_GtkTreeViewColumn_(tree_column), XEN_TO_C_GtkCellRenderer_(cell));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_unselect_all "void gtk_flow_box_unselect_all(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_unselect_all", "GtkFlowBox*");
+ gtk_flow_box_unselect_all(Xen_to_C_GtkFlowBox_(box));
+ return(Xen_false);
}
-static XEN gxg_gtk_clipboard_wait_is_uris_available(XEN clipboard)
+static Xen gxg_gtk_flow_box_set_selection_mode(Xen box, Xen mode)
{
- #define H_gtk_clipboard_wait_is_uris_available "gboolean gtk_clipboard_wait_is_uris_available(GtkClipboard* clipboard)"
- XEN_ASSERT_TYPE(XEN_GtkClipboard__P(clipboard), clipboard, 1, "gtk_clipboard_wait_is_uris_available", "GtkClipboard*");
- return(C_TO_XEN_gboolean(gtk_clipboard_wait_is_uris_available(XEN_TO_C_GtkClipboard_(clipboard))));
+ #define H_gtk_flow_box_set_selection_mode "void gtk_flow_box_set_selection_mode(GtkFlowBox* box, GtkSelectionMode mode)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_selection_mode", "GtkFlowBox*");
+ Xen_check_type(Xen_is_GtkSelectionMode(mode), mode, 2, "gtk_flow_box_set_selection_mode", "GtkSelectionMode");
+ gtk_flow_box_set_selection_mode(Xen_to_C_GtkFlowBox_(box), Xen_to_C_GtkSelectionMode(mode));
+ return(Xen_false);
}
-static XEN gxg_gtk_toolbar_set_drop_highlight_item(XEN toolbar, XEN tool_item, XEN index)
+static Xen gxg_gtk_flow_box_get_selection_mode(Xen box)
{
- #define H_gtk_toolbar_set_drop_highlight_item "void gtk_toolbar_set_drop_highlight_item(GtkToolbar* toolbar, \
-GtkToolItem* tool_item, gint index)"
- XEN_ASSERT_TYPE(XEN_GtkToolbar__P(toolbar), toolbar, 1, "gtk_toolbar_set_drop_highlight_item", "GtkToolbar*");
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 2, "gtk_toolbar_set_drop_highlight_item", "GtkToolItem*");
- XEN_ASSERT_TYPE(XEN_gint_P(index), index, 3, "gtk_toolbar_set_drop_highlight_item", "gint");
- gtk_toolbar_set_drop_highlight_item(XEN_TO_C_GtkToolbar_(toolbar), XEN_TO_C_GtkToolItem_(tool_item), XEN_TO_C_gint(index));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_get_selection_mode "GtkSelectionMode gtk_flow_box_get_selection_mode(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_get_selection_mode", "GtkFlowBox*");
+ return(C_to_Xen_GtkSelectionMode(gtk_flow_box_get_selection_mode(Xen_to_C_GtkFlowBox_(box))));
}
-static XEN gxg_gtk_tool_item_toolbar_reconfigured(XEN tool_item)
+static Xen gxg_gtk_flow_box_set_hadjustment(Xen box, Xen adjustment)
{
- #define H_gtk_tool_item_toolbar_reconfigured "void gtk_tool_item_toolbar_reconfigured(GtkToolItem* tool_item)"
- XEN_ASSERT_TYPE(XEN_GtkToolItem__P(tool_item), tool_item, 1, "gtk_tool_item_toolbar_reconfigured", "GtkToolItem*");
- gtk_tool_item_toolbar_reconfigured(XEN_TO_C_GtkToolItem_(tool_item));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_set_hadjustment "void gtk_flow_box_set_hadjustment(GtkFlowBox* box, GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_hadjustment", "GtkFlowBox*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_flow_box_set_hadjustment", "GtkAdjustment*");
+ gtk_flow_box_set_hadjustment(Xen_to_C_GtkFlowBox_(box), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_orientable_set_orientation(XEN orientable, XEN orientation)
+static Xen gxg_gtk_flow_box_set_vadjustment(Xen box, Xen adjustment)
{
- #define H_gtk_orientable_set_orientation "void gtk_orientable_set_orientation(GtkOrientable* orientable, \
-GtkOrientation orientation)"
- XEN_ASSERT_TYPE(XEN_GtkOrientable__P(orientable), orientable, 1, "gtk_orientable_set_orientation", "GtkOrientable*");
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 2, "gtk_orientable_set_orientation", "GtkOrientation");
- gtk_orientable_set_orientation(XEN_TO_C_GtkOrientable_(orientable), XEN_TO_C_GtkOrientation(orientation));
- return(XEN_FALSE);
+ #define H_gtk_flow_box_set_vadjustment "void gtk_flow_box_set_vadjustment(GtkFlowBox* box, GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_set_vadjustment", "GtkFlowBox*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_flow_box_set_vadjustment", "GtkAdjustment*");
+ gtk_flow_box_set_vadjustment(Xen_to_C_GtkFlowBox_(box), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
}
-static XEN gxg_gtk_orientable_get_orientation(XEN orientable)
+static Xen gxg_gtk_flow_box_invalidate_filter(Xen box)
{
- #define H_gtk_orientable_get_orientation "GtkOrientation gtk_orientable_get_orientation(GtkOrientable* orientable)"
- XEN_ASSERT_TYPE(XEN_GtkOrientable__P(orientable), orientable, 1, "gtk_orientable_get_orientation", "GtkOrientable*");
- return(C_TO_XEN_GtkOrientation(gtk_orientable_get_orientation(XEN_TO_C_GtkOrientable_(orientable))));
+ #define H_gtk_flow_box_invalidate_filter "void gtk_flow_box_invalidate_filter(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_invalidate_filter", "GtkFlowBox*");
+ gtk_flow_box_invalidate_filter(Xen_to_C_GtkFlowBox_(box));
+ return(Xen_false);
}
-static XEN gxg_gtk_parse_args(XEN argc, XEN argv)
+static Xen gxg_gtk_flow_box_invalidate_sort(Xen box)
{
- #define H_gtk_parse_args "void gtk_parse_args(int* {argc}, char*** |argv|)"
- int ref_argc;
- char** ref_argv = NULL;
- ref_argc = XEN_TO_C_int(argc);
- ref_argv = (char**)calloc(ref_argc, sizeof(char*));
- {
- int i;
- XEN lst;
- lst = XEN_COPY_ARG(argv);
- for (i = 0; i < ref_argc; i++, lst = XEN_CDR(lst)) ref_argv[i] = XEN_TO_C_char_(XEN_CAR(lst));
- }
- gtk_parse_args(&ref_argc, &ref_argv);
- return(XEN_LIST_2(C_TO_XEN_int(ref_argc), C_TO_XEN_char__(ref_argv)));
+ #define H_gtk_flow_box_invalidate_sort "void gtk_flow_box_invalidate_sort(GtkFlowBox* box)"
+ Xen_check_type(Xen_is_GtkFlowBox_(box), box, 1, "gtk_flow_box_invalidate_sort", "GtkFlowBox*");
+ gtk_flow_box_invalidate_sort(Xen_to_C_GtkFlowBox_(box));
+ return(Xen_false);
}
-static XEN gxg_gtk_get_major_version(void)
+static Xen gxg_gdk_window_set_event_compression(Xen window, Xen event_compression)
{
- #define H_gtk_get_major_version "guint gtk_get_major_version( void)"
- return(C_TO_XEN_guint((guint)gtk_get_major_version()));
+ #define H_gdk_window_set_event_compression "void gdk_window_set_event_compression(GdkWindow* window, \
+gboolean event_compression)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_event_compression", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(event_compression), event_compression, 2, "gdk_window_set_event_compression", "gboolean");
+ gdk_window_set_event_compression(Xen_to_C_GdkWindow_(window), Xen_to_C_gboolean(event_compression));
+ return(Xen_false);
}
-static XEN gxg_gtk_get_minor_version(void)
+static Xen gxg_gdk_window_get_event_compression(Xen window)
{
- #define H_gtk_get_minor_version "guint gtk_get_minor_version( void)"
- return(C_TO_XEN_guint((guint)gtk_get_minor_version()));
+ #define H_gdk_window_get_event_compression "gboolean gdk_window_get_event_compression(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_event_compression", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_get_event_compression(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_get_micro_version(void)
+static Xen gxg_gtk_places_sidebar_set_local_only(Xen sidebar, Xen local_only)
{
- #define H_gtk_get_micro_version "guint gtk_get_micro_version( void)"
- return(C_TO_XEN_guint((guint)gtk_get_micro_version()));
+ #define H_gtk_places_sidebar_set_local_only "void gtk_places_sidebar_set_local_only(GtkPlacesSidebar* sidebar, \
+gboolean local_only)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_local_only", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_gboolean(local_only), local_only, 2, "gtk_places_sidebar_set_local_only", "gboolean");
+ gtk_places_sidebar_set_local_only(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_gboolean(local_only));
+ return(Xen_false);
}
-static XEN gxg_gtk_get_binary_age(void)
+static Xen gxg_gtk_places_sidebar_get_local_only(Xen sidebar)
{
- #define H_gtk_get_binary_age "guint gtk_get_binary_age( void)"
- return(C_TO_XEN_guint((guint)gtk_get_binary_age()));
+ #define H_gtk_places_sidebar_get_local_only "gboolean gtk_places_sidebar_get_local_only(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_local_only", "GtkPlacesSidebar*");
+ return(C_to_Xen_gboolean(gtk_places_sidebar_get_local_only(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_get_interface_age(void)
+static Xen gxg_gtk_stack_get_transition_running(Xen stack)
{
- #define H_gtk_get_interface_age "guint gtk_get_interface_age( void)"
- return(C_TO_XEN_guint((guint)gtk_get_interface_age()));
+ #define H_gtk_stack_get_transition_running "gboolean gtk_stack_get_transition_running(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_transition_running", "GtkStack*");
+ return(C_to_Xen_gboolean(gtk_stack_get_transition_running(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gtk_image_new_from_gicon(XEN icon, XEN size)
+static Xen gxg_gtk_widget_get_margin_start(Xen widget)
{
- #define H_gtk_image_new_from_gicon "GtkWidget* gtk_image_new_from_gicon(GIcon* icon, GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GIcon__P(icon), icon, 1, "gtk_image_new_from_gicon", "GIcon*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 2, "gtk_image_new_from_gicon", "GtkIconSize");
- return(C_TO_XEN_GtkWidget_(gtk_image_new_from_gicon(XEN_TO_C_GIcon_(icon), XEN_TO_C_GtkIconSize(size))));
+ #define H_gtk_widget_get_margin_start "gint gtk_widget_get_margin_start(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_margin_start", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_widget_get_margin_start(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_image_set_from_gicon(XEN image, XEN icon, XEN size)
+static Xen gxg_gtk_widget_set_margin_start(Xen widget, Xen margin)
{
- #define H_gtk_image_set_from_gicon "void gtk_image_set_from_gicon(GtkImage* image, GIcon* icon, GtkIconSize size)"
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_set_from_gicon", "GtkImage*");
- XEN_ASSERT_TYPE(XEN_GIcon__P(icon), icon, 2, "gtk_image_set_from_gicon", "GIcon*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 3, "gtk_image_set_from_gicon", "GtkIconSize");
- gtk_image_set_from_gicon(XEN_TO_C_GtkImage_(image), XEN_TO_C_GIcon_(icon), XEN_TO_C_GtkIconSize(size));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_margin_start "void gtk_widget_set_margin_start(GtkWidget* widget, gint margin)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_margin_start", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(margin), margin, 2, "gtk_widget_set_margin_start", "gint");
+ gtk_widget_set_margin_start(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(margin));
+ return(Xen_false);
}
-static XEN gxg_gtk_image_get_gicon(XEN image, XEN ignore_gicon, XEN ignore_size)
+static Xen gxg_gtk_widget_get_margin_end(Xen widget)
{
- #define H_gtk_image_get_gicon "void gtk_image_get_gicon(GtkImage* image, GIcon** [gicon], GtkIconSize* [size])"
- GIcon* ref_gicon = NULL;
- GtkIconSize ref_size;
- XEN_ASSERT_TYPE(XEN_GtkImage__P(image), image, 1, "gtk_image_get_gicon", "GtkImage*");
- gtk_image_get_gicon(XEN_TO_C_GtkImage_(image), &ref_gicon, &ref_size);
- return(XEN_LIST_2(C_TO_XEN_GIcon_(ref_gicon), C_TO_XEN_GtkIconSize(ref_size)));
+ #define H_gtk_widget_get_margin_end "gint gtk_widget_get_margin_end(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_margin_end", "GtkWidget*");
+ return(C_to_Xen_gint(gtk_widget_get_margin_end(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_progress_bar_set_show_text(XEN pbar, XEN show_text)
+static Xen gxg_gtk_widget_set_margin_end(Xen widget, Xen margin)
{
- #define H_gtk_progress_bar_set_show_text "void gtk_progress_bar_set_show_text(GtkProgressBar* pbar, \
-gboolean show_text)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_set_show_text", "GtkProgressBar*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(show_text), show_text, 2, "gtk_progress_bar_set_show_text", "gboolean");
- gtk_progress_bar_set_show_text(XEN_TO_C_GtkProgressBar_(pbar), XEN_TO_C_gboolean(show_text));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_margin_end "void gtk_widget_set_margin_end(GtkWidget* widget, gint margin)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_margin_end", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(margin), margin, 2, "gtk_widget_set_margin_end", "gint");
+ gtk_widget_set_margin_end(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(margin));
+ return(Xen_false);
}
-static XEN gxg_gtk_progress_bar_get_show_text(XEN pbar)
+static Xen gxg_gtk_accel_label_get_accel(Xen accel_label, Xen ignore_accelerator_key, Xen ignore_accelerator_mods)
{
- #define H_gtk_progress_bar_get_show_text "gboolean gtk_progress_bar_get_show_text(GtkProgressBar* pbar)"
- XEN_ASSERT_TYPE(XEN_GtkProgressBar__P(pbar), pbar, 1, "gtk_progress_bar_get_show_text", "GtkProgressBar*");
- return(C_TO_XEN_gboolean(gtk_progress_bar_get_show_text(XEN_TO_C_GtkProgressBar_(pbar))));
+ #define H_gtk_accel_label_get_accel "void gtk_accel_label_get_accel(GtkAccelLabel* accel_label, guint* [accelerator_key], \
+GdkModifierType* [accelerator_mods])"
+ guint ref_accelerator_key;
+ GdkModifierType ref_accelerator_mods;
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_get_accel", "GtkAccelLabel*");
+ gtk_accel_label_get_accel(Xen_to_C_GtkAccelLabel_(accel_label), &ref_accelerator_key, &ref_accelerator_mods);
+ return(Xen_list_2(C_to_Xen_guint(ref_accelerator_key), C_to_Xen_GdkModifierType(ref_accelerator_mods)));
}
-static XEN gxg_gtk_invisible_new_for_screen(XEN screen)
+static Xen gxg_gdk_window_set_shadow_width(Xen window, Xen left, Xen right, Xen top, Xen bottom)
{
- #define H_gtk_invisible_new_for_screen "GtkWidget* gtk_invisible_new_for_screen(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gtk_invisible_new_for_screen", "GdkScreen*");
- return(C_TO_XEN_GtkWidget_(gtk_invisible_new_for_screen(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gdk_window_set_shadow_width "void gdk_window_set_shadow_width(GdkWindow* window, gint left, \
+gint right, gint top, gint bottom)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_shadow_width", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(left), left, 2, "gdk_window_set_shadow_width", "gint");
+ Xen_check_type(Xen_is_gint(right), right, 3, "gdk_window_set_shadow_width", "gint");
+ Xen_check_type(Xen_is_gint(top), top, 4, "gdk_window_set_shadow_width", "gint");
+ Xen_check_type(Xen_is_gint(bottom), bottom, 5, "gdk_window_set_shadow_width", "gint");
+ gdk_window_set_shadow_width(Xen_to_C_GdkWindow_(window), Xen_to_C_gint(left), Xen_to_C_gint(right), Xen_to_C_gint(top),
+ Xen_to_C_gint(bottom));
+ return(Xen_false);
}
-static XEN gxg_gtk_invisible_set_screen(XEN invisible, XEN screen)
+static Xen gxg_gtk_action_bar_new(void)
{
- #define H_gtk_invisible_set_screen "void gtk_invisible_set_screen(GtkInvisible* invisible, GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GtkInvisible__P(invisible), invisible, 1, "gtk_invisible_set_screen", "GtkInvisible*");
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 2, "gtk_invisible_set_screen", "GdkScreen*");
- gtk_invisible_set_screen(XEN_TO_C_GtkInvisible_(invisible), XEN_TO_C_GdkScreen_(screen));
- return(XEN_FALSE);
+ #define H_gtk_action_bar_new "GtkWidget* gtk_action_bar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_action_bar_new()));
}
-static XEN gxg_gtk_invisible_get_screen(XEN invisible)
+static Xen gxg_gtk_action_bar_get_center_widget(Xen bar)
{
- #define H_gtk_invisible_get_screen "GdkScreen* gtk_invisible_get_screen(GtkInvisible* invisible)"
- XEN_ASSERT_TYPE(XEN_GtkInvisible__P(invisible), invisible, 1, "gtk_invisible_get_screen", "GtkInvisible*");
- return(C_TO_XEN_GdkScreen_(gtk_invisible_get_screen(XEN_TO_C_GtkInvisible_(invisible))));
+ #define H_gtk_action_bar_get_center_widget "GtkWidget* gtk_action_bar_get_center_widget(GtkActionBar* bar)"
+ Xen_check_type(Xen_is_GtkActionBar_(bar), bar, 1, "gtk_action_bar_get_center_widget", "GtkActionBar*");
+ return(C_to_Xen_GtkWidget_(gtk_action_bar_get_center_widget(Xen_to_C_GtkActionBar_(bar))));
}
-static XEN gxg_gtk_entry_get_icon_storage_type(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_action_bar_set_center_widget(Xen bar, Xen center_widget)
{
- #define H_gtk_entry_get_icon_storage_type "GtkImageType gtk_entry_get_icon_storage_type(GtkEntry* entry, \
-GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_storage_type", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_storage_type", "GtkEntryIconPosition");
- return(C_TO_XEN_GtkImageType(gtk_entry_get_icon_storage_type(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_action_bar_set_center_widget "void gtk_action_bar_set_center_widget(GtkActionBar* bar, \
+GtkWidget* center_widget)"
+ Xen_check_type(Xen_is_GtkActionBar_(bar), bar, 1, "gtk_action_bar_set_center_widget", "GtkActionBar*");
+ Xen_check_type(Xen_is_GtkWidget_(center_widget), center_widget, 2, "gtk_action_bar_set_center_widget", "GtkWidget*");
+ gtk_action_bar_set_center_widget(Xen_to_C_GtkActionBar_(bar), Xen_to_C_GtkWidget_(center_widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_icon_pixbuf(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_action_bar_pack_start(Xen bar, Xen child)
{
- #define H_gtk_entry_get_icon_pixbuf "GdkPixbuf* gtk_entry_get_icon_pixbuf(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_pixbuf", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_pixbuf", "GtkEntryIconPosition");
- return(C_TO_XEN_GdkPixbuf_(gtk_entry_get_icon_pixbuf(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_action_bar_pack_start "void gtk_action_bar_pack_start(GtkActionBar* bar, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkActionBar_(bar), bar, 1, "gtk_action_bar_pack_start", "GtkActionBar*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_action_bar_pack_start", "GtkWidget*");
+ gtk_action_bar_pack_start(Xen_to_C_GtkActionBar_(bar), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_icon_stock(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_action_bar_pack_end(Xen bar, Xen child)
{
- #define H_gtk_entry_get_icon_stock "gchar* gtk_entry_get_icon_stock(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_stock", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_stock", "GtkEntryIconPosition");
- return(C_TO_XEN_gchar_((gchar*)gtk_entry_get_icon_stock(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_action_bar_pack_end "void gtk_action_bar_pack_end(GtkActionBar* bar, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkActionBar_(bar), bar, 1, "gtk_action_bar_pack_end", "GtkActionBar*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_action_bar_pack_end", "GtkWidget*");
+ gtk_action_bar_pack_end(Xen_to_C_GtkActionBar_(bar), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_entry_get_icon_gicon(XEN entry, XEN icon_pos)
+static Xen gxg_gtk_header_bar_set_has_subtitle(Xen bar, Xen setting)
{
- #define H_gtk_entry_get_icon_gicon "GIcon* gtk_entry_get_icon_gicon(GtkEntry* entry, GtkEntryIconPosition icon_pos)"
- XEN_ASSERT_TYPE(XEN_GtkEntry__P(entry), entry, 1, "gtk_entry_get_icon_gicon", "GtkEntry*");
- XEN_ASSERT_TYPE(XEN_GtkEntryIconPosition_P(icon_pos), icon_pos, 2, "gtk_entry_get_icon_gicon", "GtkEntryIconPosition");
- return(C_TO_XEN_GIcon_(gtk_entry_get_icon_gicon(XEN_TO_C_GtkEntry_(entry), XEN_TO_C_GtkEntryIconPosition(icon_pos))));
+ #define H_gtk_header_bar_set_has_subtitle "void gtk_header_bar_set_has_subtitle(GtkHeaderBar* bar, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_set_has_subtitle", "GtkHeaderBar*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_header_bar_set_has_subtitle", "gboolean");
+ gtk_header_bar_set_has_subtitle(Xen_to_C_GtkHeaderBar_(bar), Xen_to_C_gboolean(setting));
+ return(Xen_false);
}
-static XEN gxg_gtk_container_propagate_draw(XEN container, XEN child, XEN cr)
+static Xen gxg_gtk_header_bar_get_has_subtitle(Xen bar)
{
- #define H_gtk_container_propagate_draw "void gtk_container_propagate_draw(GtkContainer* container, \
-GtkWidget* child, cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_propagate_draw", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_container_propagate_draw", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 3, "gtk_container_propagate_draw", "cairo_t*");
- gtk_container_propagate_draw(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GtkWidget_(child), XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ #define H_gtk_header_bar_get_has_subtitle "gboolean gtk_header_bar_get_has_subtitle(GtkHeaderBar* bar)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_get_has_subtitle", "GtkHeaderBar*");
+ return(C_to_Xen_gboolean(gtk_header_bar_get_has_subtitle(Xen_to_C_GtkHeaderBar_(bar))));
}
-static XEN gxg_gtk_container_set_focus_chain(XEN container, XEN focusable_widgets)
+static Xen gxg_gtk_header_bar_set_decoration_layout(Xen bar, Xen layout)
{
- #define H_gtk_container_set_focus_chain "void gtk_container_set_focus_chain(GtkContainer* container, \
-GList* focusable_widgets)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_set_focus_chain", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GList__P(focusable_widgets), focusable_widgets, 2, "gtk_container_set_focus_chain", "GList*");
- gtk_container_set_focus_chain(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GList_(focusable_widgets));
- return(XEN_FALSE);
+ #define H_gtk_header_bar_set_decoration_layout "void gtk_header_bar_set_decoration_layout(GtkHeaderBar* bar, \
+gchar* layout)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_set_decoration_layout", "GtkHeaderBar*");
+ Xen_check_type(Xen_is_gchar_(layout), layout, 2, "gtk_header_bar_set_decoration_layout", "gchar*");
+ gtk_header_bar_set_decoration_layout(Xen_to_C_GtkHeaderBar_(bar), (const gchar*)Xen_to_C_gchar_(layout));
+ return(Xen_false);
}
-static XEN gxg_gtk_container_get_focus_chain(XEN container, XEN ignore_focusable_widgets)
+static Xen gxg_gtk_header_bar_get_decoration_layout(Xen bar)
{
- #define H_gtk_container_get_focus_chain "gboolean gtk_container_get_focus_chain(GtkContainer* container, \
-GList** [focusable_widgets])"
- GList* ref_focusable_widgets = NULL;
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_get_focus_chain", "GtkContainer*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_container_get_focus_chain(XEN_TO_C_GtkContainer_(container), &ref_focusable_widgets));
- return(XEN_LIST_2(result, C_TO_XEN_GList_(ref_focusable_widgets)));
- }
+ #define H_gtk_header_bar_get_decoration_layout "gchar* gtk_header_bar_get_decoration_layout(GtkHeaderBar* bar)"
+ Xen_check_type(Xen_is_GtkHeaderBar_(bar), bar, 1, "gtk_header_bar_get_decoration_layout", "GtkHeaderBar*");
+ return(C_to_Xen_gchar_(gtk_header_bar_get_decoration_layout(Xen_to_C_GtkHeaderBar_(bar))));
}
-static XEN gxg_gtk_container_unset_focus_chain(XEN container)
+static Xen gxg_gtk_icon_info_is_symbolic(Xen icon_info)
{
- #define H_gtk_container_unset_focus_chain "void gtk_container_unset_focus_chain(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_unset_focus_chain", "GtkContainer*");
- gtk_container_unset_focus_chain(XEN_TO_C_GtkContainer_(container));
- return(XEN_FALSE);
+ #define H_gtk_icon_info_is_symbolic "gboolean gtk_icon_info_is_symbolic(GtkIconInfo* icon_info)"
+ Xen_check_type(Xen_is_GtkIconInfo_(icon_info), icon_info, 1, "gtk_icon_info_is_symbolic", "GtkIconInfo*");
+ return(C_to_Xen_gboolean(gtk_icon_info_is_symbolic(Xen_to_C_GtkIconInfo_(icon_info))));
}
-static XEN gxg_gtk_container_set_reallocate_redraws(XEN container, XEN needs_redraws)
+static Xen gxg_gtk_get_locale_direction(void)
{
- #define H_gtk_container_set_reallocate_redraws "void gtk_container_set_reallocate_redraws(GtkContainer* container, \
-gboolean needs_redraws)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_set_reallocate_redraws", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(needs_redraws), needs_redraws, 2, "gtk_container_set_reallocate_redraws", "gboolean");
- gtk_container_set_reallocate_redraws(XEN_TO_C_GtkContainer_(container), XEN_TO_C_gboolean(needs_redraws));
- return(XEN_FALSE);
+ #define H_gtk_get_locale_direction "GtkTextDirection gtk_get_locale_direction( void)"
+ return(C_to_Xen_GtkTextDirection(gtk_get_locale_direction()));
}
-static XEN gxg_gtk_container_set_focus_child(XEN container, XEN child)
+static Xen gxg_gtk_window_is_maximized(Xen window)
{
- #define H_gtk_container_set_focus_child "void gtk_container_set_focus_child(GtkContainer* container, \
-GtkWidget* child)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_set_focus_child", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(child), child, 2, "gtk_container_set_focus_child", "GtkWidget*");
- gtk_container_set_focus_child(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GtkWidget_(child));
- return(XEN_FALSE);
+ #define H_gtk_window_is_maximized "gboolean gtk_window_is_maximized(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_is_maximized", "GtkWindow*");
+ return(C_to_Xen_gboolean(gtk_window_is_maximized(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gtk_container_set_focus_vadjustment(XEN container, XEN adjustment)
+static Xen gxg_gtk_dialog_get_header_bar(Xen dialog)
{
- #define H_gtk_container_set_focus_vadjustment "void gtk_container_set_focus_vadjustment(GtkContainer* container, \
-GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_set_focus_vadjustment", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 2, "gtk_container_set_focus_vadjustment", "GtkAdjustment*");
- gtk_container_set_focus_vadjustment(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GtkAdjustment_(adjustment));
- return(XEN_FALSE);
+ #define H_gtk_dialog_get_header_bar "GtkWidget* gtk_dialog_get_header_bar(GtkDialog* dialog)"
+ Xen_check_type(Xen_is_GtkDialog_(dialog), dialog, 1, "gtk_dialog_get_header_bar", "GtkDialog*");
+ return(C_to_Xen_GtkWidget_(gtk_dialog_get_header_bar(Xen_to_C_GtkDialog_(dialog))));
}
-static XEN gxg_gtk_container_get_focus_vadjustment(XEN container)
+static Xen gxg_gtk_popover_new(Xen relative_to)
{
- #define H_gtk_container_get_focus_vadjustment "GtkAdjustment* gtk_container_get_focus_vadjustment(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_get_focus_vadjustment", "GtkContainer*");
- return(C_TO_XEN_GtkAdjustment_(gtk_container_get_focus_vadjustment(XEN_TO_C_GtkContainer_(container))));
+ #define H_gtk_popover_new "GtkWidget* gtk_popover_new(GtkWidget* relative_to)"
+ Xen_check_type(Xen_is_GtkWidget_(relative_to), relative_to, 1, "gtk_popover_new", "GtkWidget*");
+ return(C_to_Xen_GtkWidget_(gtk_popover_new(Xen_to_C_GtkWidget_(relative_to))));
}
-static XEN gxg_gtk_container_set_focus_hadjustment(XEN container, XEN adjustment)
+static Xen gxg_gtk_popover_set_relative_to(Xen popover, Xen relative_to)
{
- #define H_gtk_container_set_focus_hadjustment "void gtk_container_set_focus_hadjustment(GtkContainer* container, \
-GtkAdjustment* adjustment)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_set_focus_hadjustment", "GtkContainer*");
- XEN_ASSERT_TYPE(XEN_GtkAdjustment__P(adjustment), adjustment, 2, "gtk_container_set_focus_hadjustment", "GtkAdjustment*");
- gtk_container_set_focus_hadjustment(XEN_TO_C_GtkContainer_(container), XEN_TO_C_GtkAdjustment_(adjustment));
- return(XEN_FALSE);
+ #define H_gtk_popover_set_relative_to "void gtk_popover_set_relative_to(GtkPopover* popover, GtkWidget* relative_to)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_set_relative_to", "GtkPopover*");
+ Xen_check_type(Xen_is_GtkWidget_(relative_to), relative_to, 2, "gtk_popover_set_relative_to", "GtkWidget*");
+ gtk_popover_set_relative_to(Xen_to_C_GtkPopover_(popover), Xen_to_C_GtkWidget_(relative_to));
+ return(Xen_false);
}
-static XEN gxg_gtk_container_get_focus_hadjustment(XEN container)
+static Xen gxg_gtk_popover_get_relative_to(Xen popover)
{
- #define H_gtk_container_get_focus_hadjustment "GtkAdjustment* gtk_container_get_focus_hadjustment(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_get_focus_hadjustment", "GtkContainer*");
- return(C_TO_XEN_GtkAdjustment_(gtk_container_get_focus_hadjustment(XEN_TO_C_GtkContainer_(container))));
+ #define H_gtk_popover_get_relative_to "GtkWidget* gtk_popover_get_relative_to(GtkPopover* popover)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_get_relative_to", "GtkPopover*");
+ return(C_to_Xen_GtkWidget_(gtk_popover_get_relative_to(Xen_to_C_GtkPopover_(popover))));
}
-static XEN gxg_gtk_container_resize_children(XEN container)
+static Xen gxg_gtk_popover_set_position(Xen popover, Xen position)
{
- #define H_gtk_container_resize_children "void gtk_container_resize_children(GtkContainer* container)"
- XEN_ASSERT_TYPE(XEN_GtkContainer__P(container), container, 1, "gtk_container_resize_children", "GtkContainer*");
- gtk_container_resize_children(XEN_TO_C_GtkContainer_(container));
- return(XEN_FALSE);
+ #define H_gtk_popover_set_position "void gtk_popover_set_position(GtkPopover* popover, GtkPositionType position)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_set_position", "GtkPopover*");
+ Xen_check_type(Xen_is_GtkPositionType(position), position, 2, "gtk_popover_set_position", "GtkPositionType");
+ gtk_popover_set_position(Xen_to_C_GtkPopover_(popover), Xen_to_C_GtkPositionType(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_assistant_commit(XEN assistant)
+static Xen gxg_gtk_popover_get_position(Xen popover)
{
- #define H_gtk_assistant_commit "void gtk_assistant_commit(GtkAssistant* assistant)"
- XEN_ASSERT_TYPE(XEN_GtkAssistant__P(assistant), assistant, 1, "gtk_assistant_commit", "GtkAssistant*");
- gtk_assistant_commit(XEN_TO_C_GtkAssistant_(assistant));
- return(XEN_FALSE);
+ #define H_gtk_popover_get_position "GtkPositionType gtk_popover_get_position(GtkPopover* popover)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_get_position", "GtkPopover*");
+ return(C_to_Xen_GtkPositionType(gtk_popover_get_position(Xen_to_C_GtkPopover_(popover))));
}
-static XEN gxg_gtk_im_multicontext_get_context_id(XEN context)
+static Xen gxg_gtk_popover_set_modal(Xen popover, Xen modal)
{
- #define H_gtk_im_multicontext_get_context_id "char* gtk_im_multicontext_get_context_id(GtkIMMulticontext* context)"
- XEN_ASSERT_TYPE(XEN_GtkIMMulticontext__P(context), context, 1, "gtk_im_multicontext_get_context_id", "GtkIMMulticontext*");
- return(C_TO_XEN_char_((char*)gtk_im_multicontext_get_context_id(XEN_TO_C_GtkIMMulticontext_(context))));
+ #define H_gtk_popover_set_modal "void gtk_popover_set_modal(GtkPopover* popover, gboolean modal)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_set_modal", "GtkPopover*");
+ Xen_check_type(Xen_is_gboolean(modal), modal, 2, "gtk_popover_set_modal", "gboolean");
+ gtk_popover_set_modal(Xen_to_C_GtkPopover_(popover), Xen_to_C_gboolean(modal));
+ return(Xen_false);
}
-static XEN gxg_gtk_im_multicontext_set_context_id(XEN context, XEN context_id)
+static Xen gxg_gtk_popover_get_modal(Xen popover)
{
- #define H_gtk_im_multicontext_set_context_id "void gtk_im_multicontext_set_context_id(GtkIMMulticontext* context, \
-char* context_id)"
- XEN_ASSERT_TYPE(XEN_GtkIMMulticontext__P(context), context, 1, "gtk_im_multicontext_set_context_id", "GtkIMMulticontext*");
- XEN_ASSERT_TYPE(XEN_char__P(context_id), context_id, 2, "gtk_im_multicontext_set_context_id", "char*");
- gtk_im_multicontext_set_context_id(XEN_TO_C_GtkIMMulticontext_(context), (const char*)XEN_TO_C_char_(context_id));
- return(XEN_FALSE);
+ #define H_gtk_popover_get_modal "gboolean gtk_popover_get_modal(GtkPopover* popover)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_get_modal", "GtkPopover*");
+ return(C_to_Xen_gboolean(gtk_popover_get_modal(Xen_to_C_GtkPopover_(popover))));
}
-static XEN gxg_gtk_about_dialog_set_license_type(XEN about, XEN license_type)
+static Xen gxg_gtk_box_set_center_widget(Xen box, Xen widget)
{
- #define H_gtk_about_dialog_set_license_type "void gtk_about_dialog_set_license_type(GtkAboutDialog* about, \
-GtkLicense license_type)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_set_license_type", "GtkAboutDialog*");
- XEN_ASSERT_TYPE(XEN_GtkLicense_P(license_type), license_type, 2, "gtk_about_dialog_set_license_type", "GtkLicense");
- gtk_about_dialog_set_license_type(XEN_TO_C_GtkAboutDialog_(about), XEN_TO_C_GtkLicense(license_type));
- return(XEN_FALSE);
+ #define H_gtk_box_set_center_widget "void gtk_box_set_center_widget(GtkBox* box, GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_set_center_widget", "GtkBox*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_box_set_center_widget", "GtkWidget*");
+ gtk_box_set_center_widget(Xen_to_C_GtkBox_(box), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_about_dialog_get_license_type(XEN about)
+static Xen gxg_gtk_box_get_center_widget(Xen box)
{
- #define H_gtk_about_dialog_get_license_type "GtkLicense gtk_about_dialog_get_license_type(GtkAboutDialog* about)"
- XEN_ASSERT_TYPE(XEN_GtkAboutDialog__P(about), about, 1, "gtk_about_dialog_get_license_type", "GtkAboutDialog*");
- return(C_TO_XEN_GtkLicense(gtk_about_dialog_get_license_type(XEN_TO_C_GtkAboutDialog_(about))));
+ #define H_gtk_box_get_center_widget "GtkWidget* gtk_box_get_center_widget(GtkBox* box)"
+ Xen_check_type(Xen_is_GtkBox_(box), box, 1, "gtk_box_get_center_widget", "GtkBox*");
+ return(C_to_Xen_GtkWidget_(gtk_box_get_center_widget(Xen_to_C_GtkBox_(box))));
}
-static XEN gxg_gtk_window_set_skip_taskbar_hint(XEN window, XEN setting)
+static Xen gxg_gtk_entry_set_max_width_chars(Xen entry, Xen n_chars)
{
- #define H_gtk_window_set_skip_taskbar_hint "void gtk_window_set_skip_taskbar_hint(GtkWindow* window, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_skip_taskbar_hint", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_skip_taskbar_hint", "gboolean");
- gtk_window_set_skip_taskbar_hint(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gtk_entry_set_max_width_chars "void gtk_entry_set_max_width_chars(GtkEntry* entry, gint n_chars)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_set_max_width_chars", "GtkEntry*");
+ Xen_check_type(Xen_is_gint(n_chars), n_chars, 2, "gtk_entry_set_max_width_chars", "gint");
+ gtk_entry_set_max_width_chars(Xen_to_C_GtkEntry_(entry), Xen_to_C_gint(n_chars));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_skip_taskbar_hint(XEN window)
+static Xen gxg_gtk_entry_get_max_width_chars(Xen entry)
{
- #define H_gtk_window_get_skip_taskbar_hint "gboolean gtk_window_get_skip_taskbar_hint(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_skip_taskbar_hint", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_skip_taskbar_hint(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_entry_get_max_width_chars "gint gtk_entry_get_max_width_chars(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_get_max_width_chars", "GtkEntry*");
+ return(C_to_Xen_gint(gtk_entry_get_max_width_chars(Xen_to_C_GtkEntry_(entry))));
}
-static XEN gxg_gtk_window_set_skip_pager_hint(XEN window, XEN setting)
+static Xen gxg_gdk_device_get_last_event_window(Xen device)
{
- #define H_gtk_window_set_skip_pager_hint "void gtk_window_set_skip_pager_hint(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_skip_pager_hint", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_skip_pager_hint", "gboolean");
- gtk_window_set_skip_pager_hint(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gdk_device_get_last_event_window "GdkWindow* gdk_device_get_last_event_window(GdkDevice* device)"
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 1, "gdk_device_get_last_event_window", "GdkDevice*");
+ return(C_to_Xen_GdkWindow_(gdk_device_get_last_event_window(Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_window_get_skip_pager_hint(XEN window)
+#endif
+
+#if GTK_CHECK_VERSION(3, 14, 0)
+static Xen gxg_gtk_list_box_row_is_selected(Xen row)
{
- #define H_gtk_window_get_skip_pager_hint "gboolean gtk_window_get_skip_pager_hint(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_skip_pager_hint", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_skip_pager_hint(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_list_box_row_is_selected "gboolean gtk_list_box_row_is_selected(GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_is_selected", "GtkListBoxRow*");
+ return(C_to_Xen_gboolean(gtk_list_box_row_is_selected(Xen_to_C_GtkListBoxRow_(row))));
}
-static XEN gxg_gtk_window_set_screen(XEN window, XEN screen)
+static Xen gxg_gtk_list_box_unselect_row(Xen box, Xen row)
{
- #define H_gtk_window_set_screen "void gtk_window_set_screen(GtkWindow* window, GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_screen", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 2, "gtk_window_set_screen", "GdkScreen*");
- gtk_window_set_screen(XEN_TO_C_GtkWindow_(window), XEN_TO_C_GdkScreen_(screen));
- return(XEN_FALSE);
+ #define H_gtk_list_box_unselect_row "void gtk_list_box_unselect_row(GtkListBox* box, GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBox_(box), box, 1, "gtk_list_box_unselect_row", "GtkListBox*");
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 2, "gtk_list_box_unselect_row", "GtkListBoxRow*");
+ gtk_list_box_unselect_row(Xen_to_C_GtkListBox_(box), Xen_to_C_GtkListBoxRow_(row));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_screen(XEN window)
+static Xen gxg_gtk_list_box_select_all(Xen box)
{
- #define H_gtk_window_get_screen "GdkScreen* gtk_window_get_screen(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_screen", "GtkWindow*");
- return(C_TO_XEN_GdkScreen_(gtk_window_get_screen(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_list_box_select_all "void gtk_list_box_select_all(GtkListBox* box)"
+ Xen_check_type(Xen_is_GtkListBox_(box), box, 1, "gtk_list_box_select_all", "GtkListBox*");
+ gtk_list_box_select_all(Xen_to_C_GtkListBox_(box));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_icon_from_file(XEN window, XEN filename, XEN ignore_err)
+static Xen gxg_gtk_list_box_unselect_all(Xen box)
{
- #define H_gtk_window_set_icon_from_file "gboolean gtk_window_set_icon_from_file(GtkWindow* window, \
-gchar* filename, GError** [err])"
- GError* ref_err = NULL;
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_icon_from_file", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 2, "gtk_window_set_icon_from_file", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_window_set_icon_from_file(XEN_TO_C_GtkWindow_(window), (const gchar*)XEN_TO_C_gchar_(filename), &ref_err));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_err)));
- }
+ #define H_gtk_list_box_unselect_all "void gtk_list_box_unselect_all(GtkListBox* box)"
+ Xen_check_type(Xen_is_GtkListBox_(box), box, 1, "gtk_list_box_unselect_all", "GtkListBox*");
+ gtk_list_box_unselect_all(Xen_to_C_GtkListBox_(box));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_default_icon_from_file(XEN filename, XEN ignore_err)
+static Xen gxg_gtk_places_sidebar_get_show_enter_location(Xen sidebar)
{
- #define H_gtk_window_set_default_icon_from_file "gboolean gtk_window_set_default_icon_from_file(gchar* filename, \
-GError** [err])"
- GError* ref_err = NULL;
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 1, "gtk_window_set_default_icon_from_file", "gchar*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_window_set_default_icon_from_file((const gchar*)XEN_TO_C_gchar_(filename), &ref_err));
- return(XEN_LIST_2(result, C_TO_XEN_GError_(ref_err)));
- }
+ #define H_gtk_places_sidebar_get_show_enter_location "gboolean gtk_places_sidebar_get_show_enter_location(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_show_enter_location", "GtkPlacesSidebar*");
+ return(C_to_Xen_gboolean(gtk_places_sidebar_get_show_enter_location(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_window_fullscreen(XEN window)
+static Xen gxg_gtk_places_sidebar_set_show_enter_location(Xen sidebar, Xen show_enter_location)
{
- #define H_gtk_window_fullscreen "void gtk_window_fullscreen(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_fullscreen", "GtkWindow*");
- gtk_window_fullscreen(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_set_show_enter_location "void gtk_places_sidebar_set_show_enter_location(GtkPlacesSidebar* sidebar, \
+gboolean show_enter_location)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_show_enter_location", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_gboolean(show_enter_location), show_enter_location, 2, "gtk_places_sidebar_set_show_enter_location", "gboolean");
+ gtk_places_sidebar_set_show_enter_location(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_gboolean(show_enter_location));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_unfullscreen(XEN window)
+static Xen gxg_gtk_switch_set_state(Xen sw, Xen state)
{
- #define H_gtk_window_unfullscreen "void gtk_window_unfullscreen(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_unfullscreen", "GtkWindow*");
- gtk_window_unfullscreen(XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_gtk_switch_set_state "void gtk_switch_set_state(GtkSwitch* sw, gboolean state)"
+ Xen_check_type(Xen_is_GtkSwitch_(sw), sw, 1, "gtk_switch_set_state", "GtkSwitch*");
+ Xen_check_type(Xen_is_gboolean(state), state, 2, "gtk_switch_set_state", "gboolean");
+ gtk_switch_set_state(Xen_to_C_GtkSwitch_(sw), Xen_to_C_gboolean(state));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_window_type(XEN window)
+static Xen gxg_gtk_switch_get_state(Xen sw)
{
- #define H_gtk_window_get_window_type "GtkWindowType gtk_window_get_window_type(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_window_type", "GtkWindow*");
- return(C_TO_XEN_GtkWindowType(gtk_window_get_window_type(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_switch_get_state "gboolean gtk_switch_get_state(GtkSwitch* sw)"
+ Xen_check_type(Xen_is_GtkSwitch_(sw), sw, 1, "gtk_switch_get_state", "GtkSwitch*");
+ return(C_to_Xen_gboolean(gtk_switch_get_state(Xen_to_C_GtkSwitch_(sw))));
}
-static XEN gxg_gtk_window_group_add_window(XEN window_group, XEN window)
+static Xen gxg_gdk_window_show_window_menu(Xen window, Xen event)
{
- #define H_gtk_window_group_add_window "void gtk_window_group_add_window(GtkWindowGroup* window_group, \
-GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindowGroup__P(window_group), window_group, 1, "gtk_window_group_add_window", "GtkWindowGroup*");
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 2, "gtk_window_group_add_window", "GtkWindow*");
- gtk_window_group_add_window(XEN_TO_C_GtkWindowGroup_(window_group), XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_gdk_window_show_window_menu "gboolean gdk_window_show_window_menu(GdkWindow* window, GdkEvent* event)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_show_window_menu", "GdkWindow*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gdk_window_show_window_menu", "GdkEvent*");
+ return(C_to_Xen_gboolean(gdk_window_show_window_menu(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_window_group_remove_window(XEN window_group, XEN window)
+static Xen gxg_gtk_widget_set_clip(Xen widget, Xen clip)
{
- #define H_gtk_window_group_remove_window "void gtk_window_group_remove_window(GtkWindowGroup* window_group, \
-GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindowGroup__P(window_group), window_group, 1, "gtk_window_group_remove_window", "GtkWindowGroup*");
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 2, "gtk_window_group_remove_window", "GtkWindow*");
- gtk_window_group_remove_window(XEN_TO_C_GtkWindowGroup_(window_group), XEN_TO_C_GtkWindow_(window));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_clip "void gtk_widget_set_clip(GtkWidget* widget, GtkAllocation* clip)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_clip", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAllocation_(clip), clip, 2, "gtk_widget_set_clip", "GtkAllocation*");
+ gtk_widget_set_clip(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAllocation_(clip));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_group_new(void)
+static Xen gxg_gtk_widget_get_clip(Xen widget, Xen clip)
{
- #define H_gtk_window_group_new "GtkWindowGroup* gtk_window_group_new( void)"
- return(C_TO_XEN_GtkWindowGroup_(gtk_window_group_new()));
+ #define H_gtk_widget_get_clip "void gtk_widget_get_clip(GtkWidget* widget, GtkAllocation* clip)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_clip", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAllocation_(clip), clip, 2, "gtk_widget_get_clip", "GtkAllocation*");
+ gtk_widget_get_clip(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAllocation_(clip));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_group(XEN window)
+static Xen gxg_gtk_gesture_get_device(Xen gesture)
{
- #define H_gtk_window_get_group "GtkWindowGroup* gtk_window_get_group(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_group", "GtkWindow*");
- return(C_TO_XEN_GtkWindowGroup_(gtk_window_get_group(XEN_TO_C_GtkWindow_(window))));
+ #define H_gtk_gesture_get_device "GdkDevice* gtk_gesture_get_device(GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_device", "GtkGesture*");
+ return(C_to_Xen_GdkDevice_(gtk_gesture_get_device(Xen_to_C_GtkGesture_(gesture))));
}
-static XEN gxg_gtk_window_group_list_windows(XEN window_group)
+static Xen gxg_gtk_gesture_set_state(Xen gesture, Xen state)
{
- #define H_gtk_window_group_list_windows "GList* gtk_window_group_list_windows(GtkWindowGroup* window_group)"
- XEN_ASSERT_TYPE(XEN_GtkWindowGroup__P(window_group), window_group, 1, "gtk_window_group_list_windows", "GtkWindowGroup*");
- return(C_TO_XEN_GList_(gtk_window_group_list_windows(XEN_TO_C_GtkWindowGroup_(window_group))));
+ #define H_gtk_gesture_set_state "gboolean gtk_gesture_set_state(GtkGesture* gesture, GtkEventSequenceState state)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_set_state", "GtkGesture*");
+ Xen_check_type(Xen_is_GtkEventSequenceState(state), state, 2, "gtk_gesture_set_state", "GtkEventSequenceState");
+ return(C_to_Xen_gboolean(gtk_gesture_set_state(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GtkEventSequenceState(state))));
}
-static XEN gxg_gtk_window_group_get_current_device_grab(XEN window_group, XEN device)
+static Xen gxg_gtk_gesture_get_sequence_state(Xen gesture, Xen sequence)
{
- #define H_gtk_window_group_get_current_device_grab "GtkWidget* gtk_window_group_get_current_device_grab(GtkWindowGroup* window_group, \
-GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GtkWindowGroup__P(window_group), window_group, 1, "gtk_window_group_get_current_device_grab", "GtkWindowGroup*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_window_group_get_current_device_grab", "GdkDevice*");
- return(C_TO_XEN_GtkWidget_(gtk_window_group_get_current_device_grab(XEN_TO_C_GtkWindowGroup_(window_group), XEN_TO_C_GdkDevice_(device))));
+ #define H_gtk_gesture_get_sequence_state "GtkEventSequenceState gtk_gesture_get_sequence_state(GtkGesture* gesture, \
+GdkEventSequence* sequence)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_sequence_state", "GtkGesture*");
+ Xen_check_type(Xen_is_GdkEventSequence_(sequence), sequence, 2, "gtk_gesture_get_sequence_state", "GdkEventSequence*");
+ return(C_to_Xen_GtkEventSequenceState(gtk_gesture_get_sequence_state(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GdkEventSequence_(sequence))));
}
-static XEN gxg_gtk_window_group_get_current_grab(XEN window_group)
+static Xen gxg_gtk_gesture_set_sequence_state(Xen gesture, Xen sequence, Xen state)
{
- #define H_gtk_window_group_get_current_grab "GtkWidget* gtk_window_group_get_current_grab(GtkWindowGroup* window_group)"
- XEN_ASSERT_TYPE(XEN_GtkWindowGroup__P(window_group), window_group, 1, "gtk_window_group_get_current_grab", "GtkWindowGroup*");
- return(C_TO_XEN_GtkWidget_(gtk_window_group_get_current_grab(XEN_TO_C_GtkWindowGroup_(window_group))));
+ #define H_gtk_gesture_set_sequence_state "gboolean gtk_gesture_set_sequence_state(GtkGesture* gesture, \
+GdkEventSequence* sequence, GtkEventSequenceState state)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_set_sequence_state", "GtkGesture*");
+ Xen_check_type(Xen_is_GdkEventSequence_(sequence), sequence, 2, "gtk_gesture_set_sequence_state", "GdkEventSequence*");
+ Xen_check_type(Xen_is_GtkEventSequenceState(state), state, 3, "gtk_gesture_set_sequence_state", "GtkEventSequenceState");
+ return(C_to_Xen_gboolean(gtk_gesture_set_sequence_state(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GdkEventSequence_(sequence),
+ Xen_to_C_GtkEventSequenceState(state))));
}
-static XEN gxg_gtk_selection_data_get_data(XEN selection_data)
+static Xen gxg_gtk_gesture_get_sequences(Xen gesture)
{
- #define H_gtk_selection_data_get_data "guchar* gtk_selection_data_get_data(GtkSelectionData* selection_data)"
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_data", "GtkSelectionData*");
- return(C_TO_XEN_guchar_(gtk_selection_data_get_data(XEN_TO_C_GtkSelectionData_(selection_data))));
+ #define H_gtk_gesture_get_sequences "GList* gtk_gesture_get_sequences(GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_sequences", "GtkGesture*");
+ return(C_to_Xen_GList_(gtk_gesture_get_sequences(Xen_to_C_GtkGesture_(gesture))));
}
-static XEN gxg_gtk_selection_owner_set_for_display(XEN display, XEN widget, XEN selection, XEN time)
+static Xen gxg_gtk_gesture_get_last_updated_sequence(Xen gesture)
{
- #define H_gtk_selection_owner_set_for_display "gboolean gtk_selection_owner_set_for_display(GdkDisplay* display, \
-GtkWidget* widget, GdkAtom selection, guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gtk_selection_owner_set_for_display", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_selection_owner_set_for_display", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 3, "gtk_selection_owner_set_for_display", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 4, "gtk_selection_owner_set_for_display", "guint32");
- return(C_TO_XEN_gboolean(gtk_selection_owner_set_for_display(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_GtkWidget_(widget),
- XEN_TO_C_GdkAtom(selection), XEN_TO_C_guint32(time))));
+ #define H_gtk_gesture_get_last_updated_sequence "GdkEventSequence* gtk_gesture_get_last_updated_sequence(GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_last_updated_sequence", "GtkGesture*");
+ return(C_to_Xen_GdkEventSequence_(gtk_gesture_get_last_updated_sequence(Xen_to_C_GtkGesture_(gesture))));
}
-static XEN gxg_gtk_tool_shell_get_text_orientation(XEN shell)
+static Xen gxg_gtk_gesture_handles_sequence(Xen gesture, Xen sequence)
{
- #define H_gtk_tool_shell_get_text_orientation "GtkOrientation gtk_tool_shell_get_text_orientation(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_get_text_orientation", "GtkToolShell*");
- return(C_TO_XEN_GtkOrientation(gtk_tool_shell_get_text_orientation(XEN_TO_C_GtkToolShell_(shell))));
+ #define H_gtk_gesture_handles_sequence "gboolean gtk_gesture_handles_sequence(GtkGesture* gesture, \
+GdkEventSequence* sequence)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_handles_sequence", "GtkGesture*");
+ Xen_check_type(Xen_is_GdkEventSequence_(sequence), sequence, 2, "gtk_gesture_handles_sequence", "GdkEventSequence*");
+ return(C_to_Xen_gboolean(gtk_gesture_handles_sequence(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GdkEventSequence_(sequence))));
}
-static XEN gxg_gtk_tool_shell_get_text_alignment(XEN shell)
+static Xen gxg_gtk_gesture_get_last_event(Xen gesture, Xen sequence)
{
- #define H_gtk_tool_shell_get_text_alignment "gfloat gtk_tool_shell_get_text_alignment(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_get_text_alignment", "GtkToolShell*");
- return(C_TO_XEN_gfloat(gtk_tool_shell_get_text_alignment(XEN_TO_C_GtkToolShell_(shell))));
+ #define H_gtk_gesture_get_last_event "GdkEvent* gtk_gesture_get_last_event(GtkGesture* gesture, GdkEventSequence* sequence)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_last_event", "GtkGesture*");
+ Xen_check_type(Xen_is_GdkEventSequence_(sequence), sequence, 2, "gtk_gesture_get_last_event", "GdkEventSequence*");
+ return(C_to_Xen_GdkEvent_((GdkEvent*)gtk_gesture_get_last_event(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GdkEventSequence_(sequence))));
}
-static XEN gxg_gtk_tool_shell_get_ellipsize_mode(XEN shell)
+static Xen gxg_gtk_gesture_get_point(Xen gesture, Xen sequence, Xen ignore_x, Xen ignore_y)
{
- #define H_gtk_tool_shell_get_ellipsize_mode "PangoEllipsizeMode gtk_tool_shell_get_ellipsize_mode(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_get_ellipsize_mode", "GtkToolShell*");
- return(C_TO_XEN_PangoEllipsizeMode(gtk_tool_shell_get_ellipsize_mode(XEN_TO_C_GtkToolShell_(shell))));
+ #define H_gtk_gesture_get_point "gboolean gtk_gesture_get_point(GtkGesture* gesture, GdkEventSequence* sequence, \
+gdouble* [x], gdouble* [y])"
+ gdouble ref_x;
+ gdouble ref_y;
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_point", "GtkGesture*");
+ Xen_check_type(Xen_is_GdkEventSequence_(sequence), sequence, 2, "gtk_gesture_get_point", "GdkEventSequence*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_gesture_get_point(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GdkEventSequence_(sequence),
+ &ref_x, &ref_y));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
+ }
}
-static XEN gxg_gtk_tool_shell_get_text_size_group(XEN shell)
+static Xen gxg_gtk_gesture_get_bounding_box(Xen gesture, Xen rect)
{
- #define H_gtk_tool_shell_get_text_size_group "GtkSizeGroup* gtk_tool_shell_get_text_size_group(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_get_text_size_group", "GtkToolShell*");
- return(C_TO_XEN_GtkSizeGroup_(gtk_tool_shell_get_text_size_group(XEN_TO_C_GtkToolShell_(shell))));
+ #define H_gtk_gesture_get_bounding_box "gboolean gtk_gesture_get_bounding_box(GtkGesture* gesture, \
+GdkRectangle* rect)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_bounding_box", "GtkGesture*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 2, "gtk_gesture_get_bounding_box", "GdkRectangle*");
+ return(C_to_Xen_gboolean(gtk_gesture_get_bounding_box(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GdkRectangle_(rect))));
}
-static XEN gxg_gtk_tool_shell_get_icon_size(XEN shell)
+static Xen gxg_gtk_gesture_get_bounding_box_center(Xen gesture, Xen ignore_x, Xen ignore_y)
{
- #define H_gtk_tool_shell_get_icon_size "GtkIconSize gtk_tool_shell_get_icon_size(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_get_icon_size", "GtkToolShell*");
- return(C_TO_XEN_GtkIconSize(gtk_tool_shell_get_icon_size(XEN_TO_C_GtkToolShell_(shell))));
+ #define H_gtk_gesture_get_bounding_box_center "gboolean gtk_gesture_get_bounding_box_center(GtkGesture* gesture, \
+gdouble* [x], gdouble* [y])"
+ gdouble ref_x;
+ gdouble ref_y;
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_bounding_box_center", "GtkGesture*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_gesture_get_bounding_box_center(Xen_to_C_GtkGesture_(gesture), &ref_x, &ref_y));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
+ }
}
-static XEN gxg_gtk_tool_shell_get_orientation(XEN shell)
+static Xen gxg_gtk_gesture_is_active(Xen gesture)
{
- #define H_gtk_tool_shell_get_orientation "GtkOrientation gtk_tool_shell_get_orientation(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_get_orientation", "GtkToolShell*");
- return(C_TO_XEN_GtkOrientation(gtk_tool_shell_get_orientation(XEN_TO_C_GtkToolShell_(shell))));
+ #define H_gtk_gesture_is_active "gboolean gtk_gesture_is_active(GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_is_active", "GtkGesture*");
+ return(C_to_Xen_gboolean(gtk_gesture_is_active(Xen_to_C_GtkGesture_(gesture))));
}
-static XEN gxg_gtk_tool_shell_get_style(XEN shell)
+static Xen gxg_gtk_gesture_is_recognized(Xen gesture)
{
- #define H_gtk_tool_shell_get_style "GtkToolbarStyle gtk_tool_shell_get_style(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_get_style", "GtkToolShell*");
- return(C_TO_XEN_GtkToolbarStyle(gtk_tool_shell_get_style(XEN_TO_C_GtkToolShell_(shell))));
+ #define H_gtk_gesture_is_recognized "gboolean gtk_gesture_is_recognized(GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_is_recognized", "GtkGesture*");
+ return(C_to_Xen_gboolean(gtk_gesture_is_recognized(Xen_to_C_GtkGesture_(gesture))));
}
-static XEN gxg_gtk_tool_shell_get_relief_style(XEN shell)
+static Xen gxg_gtk_gesture_get_window(Xen gesture)
{
- #define H_gtk_tool_shell_get_relief_style "GtkReliefStyle gtk_tool_shell_get_relief_style(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_get_relief_style", "GtkToolShell*");
- return(C_TO_XEN_GtkReliefStyle(gtk_tool_shell_get_relief_style(XEN_TO_C_GtkToolShell_(shell))));
+ #define H_gtk_gesture_get_window "GdkWindow* gtk_gesture_get_window(GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_window", "GtkGesture*");
+ return(C_to_Xen_GdkWindow_(gtk_gesture_get_window(Xen_to_C_GtkGesture_(gesture))));
}
-static XEN gxg_gtk_tool_shell_rebuild_menu(XEN shell)
+static Xen gxg_gtk_gesture_set_window(Xen gesture, Xen window)
{
- #define H_gtk_tool_shell_rebuild_menu "void gtk_tool_shell_rebuild_menu(GtkToolShell* shell)"
- XEN_ASSERT_TYPE(XEN_GtkToolShell__P(shell), shell, 1, "gtk_tool_shell_rebuild_menu", "GtkToolShell*");
- gtk_tool_shell_rebuild_menu(XEN_TO_C_GtkToolShell_(shell));
- return(XEN_FALSE);
+ #define H_gtk_gesture_set_window "void gtk_gesture_set_window(GtkGesture* gesture, GdkWindow* window)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_set_window", "GtkGesture*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 2, "gtk_gesture_set_window", "GdkWindow*");
+ gtk_gesture_set_window(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GdkWindow_(window));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_new_from_gicon(XEN icon)
+static Xen gxg_gtk_gesture_group(Xen group_gesture, Xen gesture)
{
- #define H_gtk_status_icon_new_from_gicon "GtkStatusIcon* gtk_status_icon_new_from_gicon(GIcon* icon)"
- XEN_ASSERT_TYPE(XEN_GIcon__P(icon), icon, 1, "gtk_status_icon_new_from_gicon", "GIcon*");
- return(C_TO_XEN_GtkStatusIcon_(gtk_status_icon_new_from_gicon(XEN_TO_C_GIcon_(icon))));
+ #define H_gtk_gesture_group "void gtk_gesture_group(GtkGesture* group_gesture, GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(group_gesture), group_gesture, 1, "gtk_gesture_group", "GtkGesture*");
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 2, "gtk_gesture_group", "GtkGesture*");
+ gtk_gesture_group(Xen_to_C_GtkGesture_(group_gesture), Xen_to_C_GtkGesture_(gesture));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_set_from_gicon(XEN status_icon, XEN icon)
+static Xen gxg_gtk_gesture_ungroup(Xen gesture)
{
- #define H_gtk_status_icon_set_from_gicon "void gtk_status_icon_set_from_gicon(GtkStatusIcon* status_icon, \
-GIcon* icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_from_gicon", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_GIcon__P(icon), icon, 2, "gtk_status_icon_set_from_gicon", "GIcon*");
- gtk_status_icon_set_from_gicon(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_GIcon_(icon));
- return(XEN_FALSE);
+ #define H_gtk_gesture_ungroup "void gtk_gesture_ungroup(GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_ungroup", "GtkGesture*");
+ gtk_gesture_ungroup(Xen_to_C_GtkGesture_(gesture));
+ return(Xen_false);
}
-static XEN gxg_gtk_status_icon_get_gicon(XEN status_icon)
+static Xen gxg_gtk_gesture_get_group(Xen gesture)
{
- #define H_gtk_status_icon_get_gicon "GIcon* gtk_status_icon_get_gicon(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_gicon", "GtkStatusIcon*");
- return(C_TO_XEN_GIcon_(gtk_status_icon_get_gicon(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_gesture_get_group "GList* gtk_gesture_get_group(GtkGesture* gesture)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_get_group", "GtkGesture*");
+ return(C_to_Xen_GList_(gtk_gesture_get_group(Xen_to_C_GtkGesture_(gesture))));
}
-static XEN gxg_gtk_status_icon_set_has_tooltip(XEN status_icon, XEN has_tooltip)
+static Xen gxg_gtk_gesture_is_grouped_with(Xen gesture, Xen other)
{
- #define H_gtk_status_icon_set_has_tooltip "void gtk_status_icon_set_has_tooltip(GtkStatusIcon* status_icon, \
-gboolean has_tooltip)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_has_tooltip", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(has_tooltip), has_tooltip, 2, "gtk_status_icon_set_has_tooltip", "gboolean");
- gtk_status_icon_set_has_tooltip(XEN_TO_C_GtkStatusIcon_(status_icon), XEN_TO_C_gboolean(has_tooltip));
- return(XEN_FALSE);
+ #define H_gtk_gesture_is_grouped_with "gboolean gtk_gesture_is_grouped_with(GtkGesture* gesture, GtkGesture* other)"
+ Xen_check_type(Xen_is_GtkGesture_(gesture), gesture, 1, "gtk_gesture_is_grouped_with", "GtkGesture*");
+ Xen_check_type(Xen_is_GtkGesture_(other), other, 2, "gtk_gesture_is_grouped_with", "GtkGesture*");
+ return(C_to_Xen_gboolean(gtk_gesture_is_grouped_with(Xen_to_C_GtkGesture_(gesture), Xen_to_C_GtkGesture_(other))));
}
-static XEN gxg_gtk_status_icon_set_tooltip_text(XEN status_icon, XEN text)
+static Xen gxg_gtk_gesture_drag_new(Xen widget)
{
- #define H_gtk_status_icon_set_tooltip_text "void gtk_status_icon_set_tooltip_text(GtkStatusIcon* status_icon, \
-gchar* text)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_tooltip_text", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gchar__P(text), text, 2, "gtk_status_icon_set_tooltip_text", "gchar*");
- gtk_status_icon_set_tooltip_text(XEN_TO_C_GtkStatusIcon_(status_icon), (const gchar*)XEN_TO_C_gchar_(text));
- return(XEN_FALSE);
+ #define H_gtk_gesture_drag_new "GtkGesture* gtk_gesture_drag_new(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_gesture_drag_new", "GtkWidget*");
+ return(C_to_Xen_GtkGesture_(gtk_gesture_drag_new(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_status_icon_set_tooltip_markup(XEN status_icon, XEN markup)
+static Xen gxg_gtk_gesture_drag_get_start_point(Xen gesture, Xen ignore_x, Xen ignore_y)
{
- #define H_gtk_status_icon_set_tooltip_markup "void gtk_status_icon_set_tooltip_markup(GtkStatusIcon* status_icon, \
-gchar* markup)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_set_tooltip_markup", "GtkStatusIcon*");
- XEN_ASSERT_TYPE(XEN_gchar__P(markup), markup, 2, "gtk_status_icon_set_tooltip_markup", "gchar*");
- gtk_status_icon_set_tooltip_markup(XEN_TO_C_GtkStatusIcon_(status_icon), (const gchar*)XEN_TO_C_gchar_(markup));
- return(XEN_FALSE);
+ #define H_gtk_gesture_drag_get_start_point "gboolean gtk_gesture_drag_get_start_point(GtkGestureDrag* gesture, \
+gdouble* [x], gdouble* [y])"
+ gdouble ref_x;
+ gdouble ref_y;
+ Xen_check_type(Xen_is_GtkGestureDrag_(gesture), gesture, 1, "gtk_gesture_drag_get_start_point", "GtkGestureDrag*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_gesture_drag_get_start_point(Xen_to_C_GtkGestureDrag_(gesture), &ref_x, &ref_y));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
+ }
}
-static XEN gxg_gtk_status_icon_get_has_tooltip(XEN status_icon)
+static Xen gxg_gtk_gesture_drag_get_offset(Xen gesture, Xen ignore_x, Xen ignore_y)
{
- #define H_gtk_status_icon_get_has_tooltip "gboolean gtk_status_icon_get_has_tooltip(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_has_tooltip", "GtkStatusIcon*");
- return(C_TO_XEN_gboolean(gtk_status_icon_get_has_tooltip(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_gesture_drag_get_offset "gboolean gtk_gesture_drag_get_offset(GtkGestureDrag* gesture, \
+gdouble* [x], gdouble* [y])"
+ gdouble ref_x;
+ gdouble ref_y;
+ Xen_check_type(Xen_is_GtkGestureDrag_(gesture), gesture, 1, "gtk_gesture_drag_get_offset", "GtkGestureDrag*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_gesture_drag_get_offset(Xen_to_C_GtkGestureDrag_(gesture), &ref_x, &ref_y));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
+ }
}
-static XEN gxg_gtk_status_icon_get_tooltip_text(XEN status_icon)
+static Xen gxg_gtk_gesture_long_press_new(Xen widget)
{
- #define H_gtk_status_icon_get_tooltip_text "gchar* gtk_status_icon_get_tooltip_text(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_tooltip_text", "GtkStatusIcon*");
- return(C_TO_XEN_gchar_(gtk_status_icon_get_tooltip_text(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_gesture_long_press_new "GtkGesture* gtk_gesture_long_press_new(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_gesture_long_press_new", "GtkWidget*");
+ return(C_to_Xen_GtkGesture_(gtk_gesture_long_press_new(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_status_icon_get_tooltip_markup(XEN status_icon)
+static Xen gxg_gtk_gesture_pan_new(Xen widget, Xen orientation)
{
- #define H_gtk_status_icon_get_tooltip_markup "gchar* gtk_status_icon_get_tooltip_markup(GtkStatusIcon* status_icon)"
- XEN_ASSERT_TYPE(XEN_GtkStatusIcon__P(status_icon), status_icon, 1, "gtk_status_icon_get_tooltip_markup", "GtkStatusIcon*");
- return(C_TO_XEN_gchar_(gtk_status_icon_get_tooltip_markup(XEN_TO_C_GtkStatusIcon_(status_icon))));
+ #define H_gtk_gesture_pan_new "GtkGesture* gtk_gesture_pan_new(GtkWidget* widget, GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_gesture_pan_new", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 2, "gtk_gesture_pan_new", "GtkOrientation");
+ return(C_to_Xen_GtkGesture_(gtk_gesture_pan_new(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkOrientation(orientation))));
}
-static XEN gxg_gtk_accel_map_lock_path(XEN accel_path)
+static Xen gxg_gtk_gesture_pan_get_orientation(Xen gesture)
{
- #define H_gtk_accel_map_lock_path "void gtk_accel_map_lock_path(gchar* accel_path)"
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 1, "gtk_accel_map_lock_path", "gchar*");
- gtk_accel_map_lock_path((const gchar*)XEN_TO_C_gchar_(accel_path));
- return(XEN_FALSE);
+ #define H_gtk_gesture_pan_get_orientation "GtkOrientation gtk_gesture_pan_get_orientation(GtkGesturePan* gesture)"
+ Xen_check_type(Xen_is_GtkGesturePan_(gesture), gesture, 1, "gtk_gesture_pan_get_orientation", "GtkGesturePan*");
+ return(C_to_Xen_GtkOrientation(gtk_gesture_pan_get_orientation(Xen_to_C_GtkGesturePan_(gesture))));
}
-static XEN gxg_gtk_accel_map_unlock_path(XEN accel_path)
+static Xen gxg_gtk_gesture_pan_set_orientation(Xen gesture, Xen orientation)
{
- #define H_gtk_accel_map_unlock_path "void gtk_accel_map_unlock_path(gchar* accel_path)"
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 1, "gtk_accel_map_unlock_path", "gchar*");
- gtk_accel_map_unlock_path((const gchar*)XEN_TO_C_gchar_(accel_path));
- return(XEN_FALSE);
+ #define H_gtk_gesture_pan_set_orientation "void gtk_gesture_pan_set_orientation(GtkGesturePan* gesture, \
+GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkGesturePan_(gesture), gesture, 1, "gtk_gesture_pan_set_orientation", "GtkGesturePan*");
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 2, "gtk_gesture_pan_set_orientation", "GtkOrientation");
+ gtk_gesture_pan_set_orientation(Xen_to_C_GtkGesturePan_(gesture), Xen_to_C_GtkOrientation(orientation));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_theme_lookup_by_gicon(XEN icon_theme, XEN icon, XEN size, XEN flags)
+static Xen gxg_gtk_gesture_multi_press_new(Xen widget)
{
- #define H_gtk_icon_theme_lookup_by_gicon "GtkIconInfo* gtk_icon_theme_lookup_by_gicon(GtkIconTheme* icon_theme, \
-GIcon* icon, gint size, GtkIconLookupFlags flags)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_theme_lookup_by_gicon", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_GIcon__P(icon), icon, 2, "gtk_icon_theme_lookup_by_gicon", "GIcon*");
- XEN_ASSERT_TYPE(XEN_gint_P(size), size, 3, "gtk_icon_theme_lookup_by_gicon", "gint");
- XEN_ASSERT_TYPE(XEN_GtkIconLookupFlags_P(flags), flags, 4, "gtk_icon_theme_lookup_by_gicon", "GtkIconLookupFlags");
- return(C_TO_XEN_GtkIconInfo_(gtk_icon_theme_lookup_by_gicon(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_GIcon_(icon),
- XEN_TO_C_gint(size), XEN_TO_C_GtkIconLookupFlags(flags))));
+ #define H_gtk_gesture_multi_press_new "GtkGesture* gtk_gesture_multi_press_new(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_gesture_multi_press_new", "GtkWidget*");
+ return(C_to_Xen_GtkGesture_(gtk_gesture_multi_press_new(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_icon_info_new_for_pixbuf(XEN icon_theme, XEN pixbuf)
+static Xen gxg_gtk_gesture_multi_press_set_area(Xen gesture, Xen rect)
{
- #define H_gtk_icon_info_new_for_pixbuf "GtkIconInfo* gtk_icon_info_new_for_pixbuf(GtkIconTheme* icon_theme, \
-GdkPixbuf* pixbuf)"
- XEN_ASSERT_TYPE(XEN_GtkIconTheme__P(icon_theme), icon_theme, 1, "gtk_icon_info_new_for_pixbuf", "GtkIconTheme*");
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 2, "gtk_icon_info_new_for_pixbuf", "GdkPixbuf*");
- return(C_TO_XEN_GtkIconInfo_(gtk_icon_info_new_for_pixbuf(XEN_TO_C_GtkIconTheme_(icon_theme), XEN_TO_C_GdkPixbuf_(pixbuf))));
+ #define H_gtk_gesture_multi_press_set_area "void gtk_gesture_multi_press_set_area(GtkGestureMultiPress* gesture, \
+GdkRectangle* rect)"
+ Xen_check_type(Xen_is_GtkGestureMultiPress_(gesture), gesture, 1, "gtk_gesture_multi_press_set_area", "GtkGestureMultiPress*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 2, "gtk_gesture_multi_press_set_area", "GdkRectangle*");
+ gtk_gesture_multi_press_set_area(Xen_to_C_GtkGestureMultiPress_(gesture), Xen_to_C_GdkRectangle_(rect));
+ return(Xen_false);
}
-static XEN gxg_gtk_icon_view_set_item_orientation(XEN icon_view, XEN orientation)
+static Xen gxg_gtk_gesture_multi_press_get_area(Xen gesture, Xen rect)
{
- #define H_gtk_icon_view_set_item_orientation "void gtk_icon_view_set_item_orientation(GtkIconView* icon_view, \
-GtkOrientation orientation)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_set_item_orientation", "GtkIconView*");
- XEN_ASSERT_TYPE(XEN_GtkOrientation_P(orientation), orientation, 2, "gtk_icon_view_set_item_orientation", "GtkOrientation");
- gtk_icon_view_set_item_orientation(XEN_TO_C_GtkIconView_(icon_view), XEN_TO_C_GtkOrientation(orientation));
- return(XEN_FALSE);
+ #define H_gtk_gesture_multi_press_get_area "gboolean gtk_gesture_multi_press_get_area(GtkGestureMultiPress* gesture, \
+GdkRectangle* rect)"
+ Xen_check_type(Xen_is_GtkGestureMultiPress_(gesture), gesture, 1, "gtk_gesture_multi_press_get_area", "GtkGestureMultiPress*");
+ Xen_check_type(Xen_is_GdkRectangle_(rect), rect, 2, "gtk_gesture_multi_press_get_area", "GdkRectangle*");
+ return(C_to_Xen_gboolean(gtk_gesture_multi_press_get_area(Xen_to_C_GtkGestureMultiPress_(gesture), Xen_to_C_GdkRectangle_(rect))));
}
-static XEN gxg_gtk_icon_view_get_item_orientation(XEN icon_view)
+static Xen gxg_gtk_gesture_rotate_new(Xen widget)
{
- #define H_gtk_icon_view_get_item_orientation "GtkOrientation gtk_icon_view_get_item_orientation(GtkIconView* icon_view)"
- XEN_ASSERT_TYPE(XEN_GtkIconView__P(icon_view), icon_view, 1, "gtk_icon_view_get_item_orientation", "GtkIconView*");
- return(C_TO_XEN_GtkOrientation(gtk_icon_view_get_item_orientation(XEN_TO_C_GtkIconView_(icon_view))));
+ #define H_gtk_gesture_rotate_new "GtkGesture* gtk_gesture_rotate_new(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_gesture_rotate_new", "GtkWidget*");
+ return(C_to_Xen_GtkGesture_(gtk_gesture_rotate_new(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_text_view_im_context_filter_keypress(XEN text_view, XEN event)
+static Xen gxg_gtk_gesture_rotate_get_angle_delta(Xen gesture)
{
- #define H_gtk_text_view_im_context_filter_keypress "gboolean gtk_text_view_im_context_filter_keypress(GtkTextView* text_view, \
-GdkEventKey* event)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_im_context_filter_keypress", "GtkTextView*");
- XEN_ASSERT_TYPE(XEN_GdkEventKey__P(event), event, 2, "gtk_text_view_im_context_filter_keypress", "GdkEventKey*");
- return(C_TO_XEN_gboolean(gtk_text_view_im_context_filter_keypress(XEN_TO_C_GtkTextView_(text_view), XEN_TO_C_GdkEventKey_(event))));
+ #define H_gtk_gesture_rotate_get_angle_delta "gdouble gtk_gesture_rotate_get_angle_delta(GtkGestureRotate* gesture)"
+ Xen_check_type(Xen_is_GtkGestureRotate_(gesture), gesture, 1, "gtk_gesture_rotate_get_angle_delta", "GtkGestureRotate*");
+ return(C_to_Xen_gdouble(gtk_gesture_rotate_get_angle_delta(Xen_to_C_GtkGestureRotate_(gesture))));
}
-static XEN gxg_gtk_text_view_reset_im_context(XEN text_view)
+static Xen gxg_gtk_gesture_single_get_touch_only(Xen gesture)
{
- #define H_gtk_text_view_reset_im_context "void gtk_text_view_reset_im_context(GtkTextView* text_view)"
- XEN_ASSERT_TYPE(XEN_GtkTextView__P(text_view), text_view, 1, "gtk_text_view_reset_im_context", "GtkTextView*");
- gtk_text_view_reset_im_context(XEN_TO_C_GtkTextView_(text_view));
- return(XEN_FALSE);
+ #define H_gtk_gesture_single_get_touch_only "gboolean gtk_gesture_single_get_touch_only(GtkGestureSingle* gesture)"
+ Xen_check_type(Xen_is_GtkGestureSingle_(gesture), gesture, 1, "gtk_gesture_single_get_touch_only", "GtkGestureSingle*");
+ return(C_to_Xen_gboolean(gtk_gesture_single_get_touch_only(Xen_to_C_GtkGestureSingle_(gesture))));
}
-static XEN gxg_gtk_action_get_accel_path(XEN action)
+static Xen gxg_gtk_gesture_single_set_touch_only(Xen gesture, Xen touch_only)
{
- #define H_gtk_action_get_accel_path "gchar* gtk_action_get_accel_path(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_get_accel_path", "GtkAction*");
- return(C_TO_XEN_gchar_((gchar*)gtk_action_get_accel_path(XEN_TO_C_GtkAction_(action))));
+ #define H_gtk_gesture_single_set_touch_only "void gtk_gesture_single_set_touch_only(GtkGestureSingle* gesture, \
+gboolean touch_only)"
+ Xen_check_type(Xen_is_GtkGestureSingle_(gesture), gesture, 1, "gtk_gesture_single_set_touch_only", "GtkGestureSingle*");
+ Xen_check_type(Xen_is_gboolean(touch_only), touch_only, 2, "gtk_gesture_single_set_touch_only", "gboolean");
+ gtk_gesture_single_set_touch_only(Xen_to_C_GtkGestureSingle_(gesture), Xen_to_C_gboolean(touch_only));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_block_activate(XEN action)
+static Xen gxg_gtk_gesture_single_get_exclusive(Xen gesture)
{
- #define H_gtk_action_block_activate "void gtk_action_block_activate(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_block_activate", "GtkAction*");
- gtk_action_block_activate(XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_gesture_single_get_exclusive "gboolean gtk_gesture_single_get_exclusive(GtkGestureSingle* gesture)"
+ Xen_check_type(Xen_is_GtkGestureSingle_(gesture), gesture, 1, "gtk_gesture_single_get_exclusive", "GtkGestureSingle*");
+ return(C_to_Xen_gboolean(gtk_gesture_single_get_exclusive(Xen_to_C_GtkGestureSingle_(gesture))));
}
-static XEN gxg_gtk_action_unblock_activate(XEN action)
+static Xen gxg_gtk_gesture_single_set_exclusive(Xen gesture, Xen exclusive)
{
- #define H_gtk_action_unblock_activate "void gtk_action_unblock_activate(GtkAction* action)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_unblock_activate", "GtkAction*");
- gtk_action_unblock_activate(XEN_TO_C_GtkAction_(action));
- return(XEN_FALSE);
+ #define H_gtk_gesture_single_set_exclusive "void gtk_gesture_single_set_exclusive(GtkGestureSingle* gesture, \
+gboolean exclusive)"
+ Xen_check_type(Xen_is_GtkGestureSingle_(gesture), gesture, 1, "gtk_gesture_single_set_exclusive", "GtkGestureSingle*");
+ Xen_check_type(Xen_is_gboolean(exclusive), exclusive, 2, "gtk_gesture_single_set_exclusive", "gboolean");
+ gtk_gesture_single_set_exclusive(Xen_to_C_GtkGestureSingle_(gesture), Xen_to_C_gboolean(exclusive));
+ return(Xen_false);
}
-static XEN gxg_gtk_action_set_accel_path(XEN action, XEN accel_path)
+static Xen gxg_gtk_gesture_single_get_button(Xen gesture)
{
- #define H_gtk_action_set_accel_path "void gtk_action_set_accel_path(GtkAction* action, gchar* accel_path)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_accel_path", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_gchar__P(accel_path), accel_path, 2, "gtk_action_set_accel_path", "gchar*");
- gtk_action_set_accel_path(XEN_TO_C_GtkAction_(action), (const gchar*)XEN_TO_C_gchar_(accel_path));
- return(XEN_FALSE);
+ #define H_gtk_gesture_single_get_button "guint gtk_gesture_single_get_button(GtkGestureSingle* gesture)"
+ Xen_check_type(Xen_is_GtkGestureSingle_(gesture), gesture, 1, "gtk_gesture_single_get_button", "GtkGestureSingle*");
+ return(C_to_Xen_guint(gtk_gesture_single_get_button(Xen_to_C_GtkGestureSingle_(gesture))));
}
-static XEN gxg_gtk_action_set_accel_group(XEN action, XEN accel_group)
+static Xen gxg_gtk_gesture_single_set_button(Xen gesture, Xen button)
{
- #define H_gtk_action_set_accel_group "void gtk_action_set_accel_group(GtkAction* action, GtkAccelGroup* accel_group)"
- XEN_ASSERT_TYPE(XEN_GtkAction__P(action), action, 1, "gtk_action_set_accel_group", "GtkAction*");
- XEN_ASSERT_TYPE(XEN_GtkAccelGroup__P(accel_group), accel_group, 2, "gtk_action_set_accel_group", "GtkAccelGroup*");
- gtk_action_set_accel_group(XEN_TO_C_GtkAction_(action), XEN_TO_C_GtkAccelGroup_(accel_group));
- return(XEN_FALSE);
+ #define H_gtk_gesture_single_set_button "void gtk_gesture_single_set_button(GtkGestureSingle* gesture, \
+guint button)"
+ Xen_check_type(Xen_is_GtkGestureSingle_(gesture), gesture, 1, "gtk_gesture_single_set_button", "GtkGestureSingle*");
+ Xen_check_type(Xen_is_guint(button), button, 2, "gtk_gesture_single_set_button", "guint");
+ gtk_gesture_single_set_button(Xen_to_C_GtkGestureSingle_(gesture), Xen_to_C_guint(button));
+ return(Xen_false);
}
-static XEN gxg_gdk_device_get_position(XEN device, XEN screen, XEN ignore_x, XEN ignore_y)
+static Xen gxg_gtk_gesture_single_get_current_button(Xen gesture)
{
- #define H_gdk_device_get_position "void gdk_device_get_position(GdkDevice* device, GdkScreen** screen, \
-gint* [x], gint* [y])"
- gint ref_x;
- gint ref_y;
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 1, "gdk_device_get_position", "GdkDevice*");
- XEN_ASSERT_TYPE(XEN_GdkScreen___P(screen), screen, 2, "gdk_device_get_position", "GdkScreen**");
- gdk_device_get_position(XEN_TO_C_GdkDevice_(device), XEN_TO_C_GdkScreen__(screen), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y)));
+ #define H_gtk_gesture_single_get_current_button "guint gtk_gesture_single_get_current_button(GtkGestureSingle* gesture)"
+ Xen_check_type(Xen_is_GtkGestureSingle_(gesture), gesture, 1, "gtk_gesture_single_get_current_button", "GtkGestureSingle*");
+ return(C_to_Xen_guint(gtk_gesture_single_get_current_button(Xen_to_C_GtkGestureSingle_(gesture))));
}
-static XEN gxg_gdk_device_get_window_at_position(XEN device, XEN ignore_win_x, XEN ignore_win_y)
+static Xen gxg_gtk_gesture_single_get_current_sequence(Xen gesture)
{
- #define H_gdk_device_get_window_at_position "GdkWindow* gdk_device_get_window_at_position(GdkDevice* device, \
-gint* [win_x], gint* [win_y])"
- gint ref_win_x;
- gint ref_win_y;
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 1, "gdk_device_get_window_at_position", "GdkDevice*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_GdkWindow_(gdk_device_get_window_at_position(XEN_TO_C_GdkDevice_(device), &ref_win_x, &ref_win_y));
- return(XEN_LIST_3(result, C_TO_XEN_gint(ref_win_x), C_TO_XEN_gint(ref_win_y)));
- }
+ #define H_gtk_gesture_single_get_current_sequence "GdkEventSequence* gtk_gesture_single_get_current_sequence(GtkGestureSingle* gesture)"
+ Xen_check_type(Xen_is_GtkGestureSingle_(gesture), gesture, 1, "gtk_gesture_single_get_current_sequence", "GtkGestureSingle*");
+ return(C_to_Xen_GdkEventSequence_(gtk_gesture_single_get_current_sequence(Xen_to_C_GtkGestureSingle_(gesture))));
}
-static XEN gxg_gtk_cell_view_get_draw_sensitive(XEN cell_view)
+static Xen gxg_gtk_gesture_swipe_new(Xen widget)
{
- #define H_gtk_cell_view_get_draw_sensitive "gboolean gtk_cell_view_get_draw_sensitive(GtkCellView* cell_view)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_get_draw_sensitive", "GtkCellView*");
- return(C_TO_XEN_gboolean(gtk_cell_view_get_draw_sensitive(XEN_TO_C_GtkCellView_(cell_view))));
+ #define H_gtk_gesture_swipe_new "GtkGesture* gtk_gesture_swipe_new(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_gesture_swipe_new", "GtkWidget*");
+ return(C_to_Xen_GtkGesture_(gtk_gesture_swipe_new(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_cell_view_set_draw_sensitive(XEN cell_view, XEN draw_sensitive)
+static Xen gxg_gtk_gesture_swipe_get_velocity(Xen gesture, Xen ignore_velocity_x, Xen ignore_velocity_y)
{
- #define H_gtk_cell_view_set_draw_sensitive "void gtk_cell_view_set_draw_sensitive(GtkCellView* cell_view, \
-gboolean draw_sensitive)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_set_draw_sensitive", "GtkCellView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(draw_sensitive), draw_sensitive, 2, "gtk_cell_view_set_draw_sensitive", "gboolean");
- gtk_cell_view_set_draw_sensitive(XEN_TO_C_GtkCellView_(cell_view), XEN_TO_C_gboolean(draw_sensitive));
- return(XEN_FALSE);
+ #define H_gtk_gesture_swipe_get_velocity "gboolean gtk_gesture_swipe_get_velocity(GtkGestureSwipe* gesture, \
+gdouble* [velocity_x], gdouble* [velocity_y])"
+ gdouble ref_velocity_x;
+ gdouble ref_velocity_y;
+ Xen_check_type(Xen_is_GtkGestureSwipe_(gesture), gesture, 1, "gtk_gesture_swipe_get_velocity", "GtkGestureSwipe*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_gesture_swipe_get_velocity(Xen_to_C_GtkGestureSwipe_(gesture), &ref_velocity_x, &ref_velocity_y));
+ return(Xen_list_3(result, C_to_Xen_gdouble(ref_velocity_x), C_to_Xen_gdouble(ref_velocity_y)));
+ }
}
-static XEN gxg_gtk_cell_view_get_fit_model(XEN cell_view)
+static Xen gxg_gtk_gesture_zoom_new(Xen widget)
{
- #define H_gtk_cell_view_get_fit_model "gboolean gtk_cell_view_get_fit_model(GtkCellView* cell_view)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_get_fit_model", "GtkCellView*");
- return(C_TO_XEN_gboolean(gtk_cell_view_get_fit_model(XEN_TO_C_GtkCellView_(cell_view))));
+ #define H_gtk_gesture_zoom_new "GtkGesture* gtk_gesture_zoom_new(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_gesture_zoom_new", "GtkWidget*");
+ return(C_to_Xen_GtkGesture_(gtk_gesture_zoom_new(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_cell_view_set_fit_model(XEN cell_view, XEN fit_model)
+static Xen gxg_gtk_gesture_zoom_get_scale_delta(Xen gesture)
{
- #define H_gtk_cell_view_set_fit_model "void gtk_cell_view_set_fit_model(GtkCellView* cell_view, gboolean fit_model)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_set_fit_model", "GtkCellView*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(fit_model), fit_model, 2, "gtk_cell_view_set_fit_model", "gboolean");
- gtk_cell_view_set_fit_model(XEN_TO_C_GtkCellView_(cell_view), XEN_TO_C_gboolean(fit_model));
- return(XEN_FALSE);
+ #define H_gtk_gesture_zoom_get_scale_delta "gdouble gtk_gesture_zoom_get_scale_delta(GtkGestureZoom* gesture)"
+ Xen_check_type(Xen_is_GtkGestureZoom_(gesture), gesture, 1, "gtk_gesture_zoom_get_scale_delta", "GtkGestureZoom*");
+ return(C_to_Xen_gdouble(gtk_gesture_zoom_get_scale_delta(Xen_to_C_GtkGestureZoom_(gesture))));
}
-static XEN gxg_gtk_combo_box_new_with_area(XEN area)
+static Xen gxg_gtk_event_controller_get_widget(Xen controller)
{
- #define H_gtk_combo_box_new_with_area "GtkWidget* gtk_combo_box_new_with_area(GtkCellArea* area)"
- XEN_ASSERT_TYPE(XEN_GtkCellArea__P(area), area, 1, "gtk_combo_box_new_with_area", "GtkCellArea*");
- return(C_TO_XEN_GtkWidget_(gtk_combo_box_new_with_area(XEN_TO_C_GtkCellArea_(area))));
+ #define H_gtk_event_controller_get_widget "GtkWidget* gtk_event_controller_get_widget(GtkEventController* controller)"
+ Xen_check_type(Xen_is_GtkEventController_(controller), controller, 1, "gtk_event_controller_get_widget", "GtkEventController*");
+ return(C_to_Xen_GtkWidget_(gtk_event_controller_get_widget(Xen_to_C_GtkEventController_(controller))));
}
-static XEN gxg_gtk_combo_box_new_with_area_and_entry(XEN area)
+static Xen gxg_gtk_event_controller_handle_event(Xen controller, Xen event)
{
- #define H_gtk_combo_box_new_with_area_and_entry "GtkWidget* gtk_combo_box_new_with_area_and_entry(GtkCellArea* area)"
- XEN_ASSERT_TYPE(XEN_GtkCellArea__P(area), area, 1, "gtk_combo_box_new_with_area_and_entry", "GtkCellArea*");
- return(C_TO_XEN_GtkWidget_(gtk_combo_box_new_with_area_and_entry(XEN_TO_C_GtkCellArea_(area))));
+ #define H_gtk_event_controller_handle_event "gboolean gtk_event_controller_handle_event(GtkEventController* controller, \
+GdkEvent* event)"
+ Xen_check_type(Xen_is_GtkEventController_(controller), controller, 1, "gtk_event_controller_handle_event", "GtkEventController*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gtk_event_controller_handle_event", "GdkEvent*");
+ return(C_to_Xen_gboolean(gtk_event_controller_handle_event(Xen_to_C_GtkEventController_(controller), Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_icon_view_new_with_area(XEN area)
+static Xen gxg_gtk_event_controller_reset(Xen controller)
{
- #define H_gtk_icon_view_new_with_area "GtkWidget* gtk_icon_view_new_with_area(GtkCellArea* area)"
- XEN_ASSERT_TYPE(XEN_GtkCellArea__P(area), area, 1, "gtk_icon_view_new_with_area", "GtkCellArea*");
- return(C_TO_XEN_GtkWidget_(gtk_icon_view_new_with_area(XEN_TO_C_GtkCellArea_(area))));
+ #define H_gtk_event_controller_reset "void gtk_event_controller_reset(GtkEventController* controller)"
+ Xen_check_type(Xen_is_GtkEventController_(controller), controller, 1, "gtk_event_controller_reset", "GtkEventController*");
+ gtk_event_controller_reset(Xen_to_C_GtkEventController_(controller));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_item_set_reserve_indicator(XEN menu_item, XEN reserve)
+static Xen gxg_gtk_event_controller_get_propagation_phase(Xen controller)
{
- #define H_gtk_menu_item_set_reserve_indicator "void gtk_menu_item_set_reserve_indicator(GtkMenuItem* menu_item, \
-gboolean reserve)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_set_reserve_indicator", "GtkMenuItem*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(reserve), reserve, 2, "gtk_menu_item_set_reserve_indicator", "gboolean");
- gtk_menu_item_set_reserve_indicator(XEN_TO_C_GtkMenuItem_(menu_item), XEN_TO_C_gboolean(reserve));
- return(XEN_FALSE);
+ #define H_gtk_event_controller_get_propagation_phase "GtkPropagationPhase gtk_event_controller_get_propagation_phase(GtkEventController* controller)"
+ Xen_check_type(Xen_is_GtkEventController_(controller), controller, 1, "gtk_event_controller_get_propagation_phase", "GtkEventController*");
+ return(C_to_Xen_GtkPropagationPhase(gtk_event_controller_get_propagation_phase(Xen_to_C_GtkEventController_(controller))));
}
-static XEN gxg_gtk_menu_item_get_reserve_indicator(XEN menu_item)
+static Xen gxg_gtk_event_controller_set_propagation_phase(Xen controller, Xen phase)
{
- #define H_gtk_menu_item_get_reserve_indicator "gboolean gtk_menu_item_get_reserve_indicator(GtkMenuItem* menu_item)"
- XEN_ASSERT_TYPE(XEN_GtkMenuItem__P(menu_item), menu_item, 1, "gtk_menu_item_get_reserve_indicator", "GtkMenuItem*");
- return(C_TO_XEN_gboolean(gtk_menu_item_get_reserve_indicator(XEN_TO_C_GtkMenuItem_(menu_item))));
+ #define H_gtk_event_controller_set_propagation_phase "void gtk_event_controller_set_propagation_phase(GtkEventController* controller, \
+GtkPropagationPhase phase)"
+ Xen_check_type(Xen_is_GtkEventController_(controller), controller, 1, "gtk_event_controller_set_propagation_phase", "GtkEventController*");
+ Xen_check_type(Xen_is_GtkPropagationPhase(phase), phase, 2, "gtk_event_controller_set_propagation_phase", "GtkPropagationPhase");
+ gtk_event_controller_set_propagation_phase(Xen_to_C_GtkEventController_(controller), Xen_to_C_GtkPropagationPhase(phase));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_shell_get_selected_item(XEN menu_shell)
+static Xen gxg_gtk_icon_theme_add_resource_path(Xen icon_theme, Xen path)
{
- #define H_gtk_menu_shell_get_selected_item "GtkWidget* gtk_menu_shell_get_selected_item(GtkMenuShell* menu_shell)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_get_selected_item", "GtkMenuShell*");
- return(C_TO_XEN_GtkWidget_(gtk_menu_shell_get_selected_item(XEN_TO_C_GtkMenuShell_(menu_shell))));
+ #define H_gtk_icon_theme_add_resource_path "void gtk_icon_theme_add_resource_path(GtkIconTheme* icon_theme, \
+gchar* path)"
+ Xen_check_type(Xen_is_GtkIconTheme_(icon_theme), icon_theme, 1, "gtk_icon_theme_add_resource_path", "GtkIconTheme*");
+ Xen_check_type(Xen_is_gchar_(path), path, 2, "gtk_icon_theme_add_resource_path", "gchar*");
+ gtk_icon_theme_add_resource_path(Xen_to_C_GtkIconTheme_(icon_theme), (const gchar*)Xen_to_C_gchar_(path));
+ return(Xen_false);
}
-static XEN gxg_gtk_menu_shell_get_parent_shell(XEN menu_shell)
+static Xen gxg_gtk_list_box_row_set_activatable(Xen row, Xen activatable)
{
- #define H_gtk_menu_shell_get_parent_shell "GtkWidget* gtk_menu_shell_get_parent_shell(GtkMenuShell* menu_shell)"
- XEN_ASSERT_TYPE(XEN_GtkMenuShell__P(menu_shell), menu_shell, 1, "gtk_menu_shell_get_parent_shell", "GtkMenuShell*");
- return(C_TO_XEN_GtkWidget_(gtk_menu_shell_get_parent_shell(XEN_TO_C_GtkMenuShell_(menu_shell))));
+ #define H_gtk_list_box_row_set_activatable "void gtk_list_box_row_set_activatable(GtkListBoxRow* row, \
+gboolean activatable)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_set_activatable", "GtkListBoxRow*");
+ Xen_check_type(Xen_is_gboolean(activatable), activatable, 2, "gtk_list_box_row_set_activatable", "gboolean");
+ gtk_list_box_row_set_activatable(Xen_to_C_GtkListBoxRow_(row), Xen_to_C_gboolean(activatable));
+ return(Xen_false);
}
-static XEN gxg_gtk_selection_data_get_data_with_length(XEN selection_data, XEN ignore_length)
+static Xen gxg_gtk_list_box_row_get_activatable(Xen row)
{
- #define H_gtk_selection_data_get_data_with_length "guchar* gtk_selection_data_get_data_with_length(GtkSelectionData* selection_data, \
-gint* [length])"
- gint ref_length;
- XEN_ASSERT_TYPE(XEN_GtkSelectionData__P(selection_data), selection_data, 1, "gtk_selection_data_get_data_with_length", "GtkSelectionData*");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_guchar_(gtk_selection_data_get_data_with_length(XEN_TO_C_GtkSelectionData_(selection_data), &ref_length));
- return(XEN_LIST_2(result, C_TO_XEN_gint(ref_length)));
- }
+ #define H_gtk_list_box_row_get_activatable "gboolean gtk_list_box_row_get_activatable(GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_get_activatable", "GtkListBoxRow*");
+ return(C_to_Xen_gboolean(gtk_list_box_row_get_activatable(Xen_to_C_GtkListBoxRow_(row))));
}
-static XEN gxg_gtk_tree_model_iter_previous(XEN tree_model, XEN iter)
+static Xen gxg_gtk_list_box_row_set_selectable(Xen row, Xen selectable)
{
- #define H_gtk_tree_model_iter_previous "gboolean gtk_tree_model_iter_previous(GtkTreeModel* tree_model, \
-GtkTreeIter* iter)"
- XEN_ASSERT_TYPE(XEN_GtkTreeModel__P(tree_model), tree_model, 1, "gtk_tree_model_iter_previous", "GtkTreeModel*");
- XEN_ASSERT_TYPE(XEN_GtkTreeIter__P(iter), iter, 2, "gtk_tree_model_iter_previous", "GtkTreeIter*");
- return(C_TO_XEN_gboolean(gtk_tree_model_iter_previous(XEN_TO_C_GtkTreeModel_(tree_model), XEN_TO_C_GtkTreeIter_(iter))));
+ #define H_gtk_list_box_row_set_selectable "void gtk_list_box_row_set_selectable(GtkListBoxRow* row, \
+gboolean selectable)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_set_selectable", "GtkListBoxRow*");
+ Xen_check_type(Xen_is_gboolean(selectable), selectable, 2, "gtk_list_box_row_set_selectable", "gboolean");
+ gtk_list_box_row_set_selectable(Xen_to_C_GtkListBoxRow_(row), Xen_to_C_gboolean(selectable));
+ return(Xen_false);
}
-static XEN gxg_gtk_tree_view_is_blank_at_pos(XEN tree_view, XEN x, XEN y, XEN ignore_path, XEN ignore_column, XEN ignore_cell_x, XEN ignore_cell_y)
+static Xen gxg_gtk_list_box_row_get_selectable(Xen row)
{
- #define H_gtk_tree_view_is_blank_at_pos "gboolean gtk_tree_view_is_blank_at_pos(GtkTreeView* tree_view, \
-gint x, gint y, GtkTreePath** [path], GtkTreeViewColumn** [column], gint* [cell_x], gint* [cell_y])"
- GtkTreePath* ref_path = NULL;
- GtkTreeViewColumn* ref_column = NULL;
- gint ref_cell_x;
- gint ref_cell_y;
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_is_blank_at_pos", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gtk_tree_view_is_blank_at_pos", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gtk_tree_view_is_blank_at_pos", "gint");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_tree_view_is_blank_at_pos(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_gint(x), XEN_TO_C_gint(y),
- &ref_path, &ref_column, &ref_cell_x, &ref_cell_y));
- return(XEN_LIST_5(result, C_TO_XEN_GtkTreePath_(ref_path), C_TO_XEN_GtkTreeViewColumn_(ref_column), C_TO_XEN_gint(ref_cell_x), C_TO_XEN_gint(ref_cell_y)));
- }
+ #define H_gtk_list_box_row_get_selectable "gboolean gtk_list_box_row_get_selectable(GtkListBoxRow* row)"
+ Xen_check_type(Xen_is_GtkListBoxRow_(row), row, 1, "gtk_list_box_row_get_selectable", "GtkListBoxRow*");
+ return(C_to_Xen_gboolean(gtk_list_box_row_get_selectable(Xen_to_C_GtkListBoxRow_(row))));
}
-static XEN gxg_gtk_widget_set_device_enabled(XEN widget, XEN device, XEN enabled)
+static Xen gxg_gtk_widget_path_iter_get_state(Xen path, Xen pos)
{
- #define H_gtk_widget_set_device_enabled "void gtk_widget_set_device_enabled(GtkWidget* widget, GdkDevice* device, \
-gboolean enabled)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_device_enabled", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_set_device_enabled", "GdkDevice*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(enabled), enabled, 3, "gtk_widget_set_device_enabled", "gboolean");
- gtk_widget_set_device_enabled(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device), XEN_TO_C_gboolean(enabled));
- return(XEN_FALSE);
+ #define H_gtk_widget_path_iter_get_state "GtkStateFlags gtk_widget_path_iter_get_state(GtkWidgetPath* path, \
+gint pos)"
+ Xen_check_type(Xen_is_GtkWidgetPath_(path), path, 1, "gtk_widget_path_iter_get_state", "GtkWidgetPath*");
+ Xen_check_type(Xen_is_gint(pos), pos, 2, "gtk_widget_path_iter_get_state", "gint");
+ return(C_to_Xen_GtkStateFlags(gtk_widget_path_iter_get_state(Xen_to_C_GtkWidgetPath_(path), Xen_to_C_gint(pos))));
}
-static XEN gxg_gtk_widget_get_device_enabled(XEN widget, XEN device)
+static Xen gxg_gtk_widget_path_iter_set_state(Xen path, Xen pos, Xen state)
{
- #define H_gtk_widget_get_device_enabled "gboolean gtk_widget_get_device_enabled(GtkWidget* widget, \
-GdkDevice* device)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_device_enabled", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkDevice__P(device), device, 2, "gtk_widget_get_device_enabled", "GdkDevice*");
- return(C_TO_XEN_gboolean(gtk_widget_get_device_enabled(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkDevice_(device))));
+ #define H_gtk_widget_path_iter_set_state "void gtk_widget_path_iter_set_state(GtkWidgetPath* path, \
+gint pos, GtkStateFlags state)"
+ Xen_check_type(Xen_is_GtkWidgetPath_(path), path, 1, "gtk_widget_path_iter_set_state", "GtkWidgetPath*");
+ Xen_check_type(Xen_is_gint(pos), pos, 2, "gtk_widget_path_iter_set_state", "gint");
+ Xen_check_type(Xen_is_GtkStateFlags(state), state, 3, "gtk_widget_path_iter_set_state", "GtkStateFlags");
+ gtk_widget_path_iter_set_state(Xen_to_C_GtkWidgetPath_(path), Xen_to_C_gint(pos), Xen_to_C_GtkStateFlags(state));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_set_has_user_ref_count(XEN window, XEN setting)
+#endif
+
+#if GTK_CHECK_VERSION(3, 16, 0)
+static Xen gxg_gdk_cairo_draw_from_gl(Xen arglist)
{
- #define H_gtk_window_set_has_user_ref_count "void gtk_window_set_has_user_ref_count(GtkWindow* window, \
-gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_has_user_ref_count", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_has_user_ref_count", "gboolean");
- gtk_window_set_has_user_ref_count(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gdk_cairo_draw_from_gl "void gdk_cairo_draw_from_gl(cairo_t* cr, GdkWindow* window, int source, \
+int source_type, int buffer_scale, int x, int y, int width, int height)"
+ Xen cr, window, source, source_type, buffer_scale, x, y, width, height;
+ cr = Xen_list_ref(arglist, 0);
+ window = Xen_list_ref(arglist, 1);
+ source = Xen_list_ref(arglist, 2);
+ source_type = Xen_list_ref(arglist, 3);
+ buffer_scale = Xen_list_ref(arglist, 4);
+ x = Xen_list_ref(arglist, 5);
+ y = Xen_list_ref(arglist, 6);
+ width = Xen_list_ref(arglist, 7);
+ height = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "gdk_cairo_draw_from_gl", "cairo_t*");
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 2, "gdk_cairo_draw_from_gl", "GdkWindow*");
+ Xen_check_type(Xen_is_int(source), source, 3, "gdk_cairo_draw_from_gl", "int");
+ Xen_check_type(Xen_is_int(source_type), source_type, 4, "gdk_cairo_draw_from_gl", "int");
+ Xen_check_type(Xen_is_int(buffer_scale), buffer_scale, 5, "gdk_cairo_draw_from_gl", "int");
+ Xen_check_type(Xen_is_int(x), x, 6, "gdk_cairo_draw_from_gl", "int");
+ Xen_check_type(Xen_is_int(y), y, 7, "gdk_cairo_draw_from_gl", "int");
+ Xen_check_type(Xen_is_int(width), width, 8, "gdk_cairo_draw_from_gl", "int");
+ Xen_check_type(Xen_is_int(height), height, 9, "gdk_cairo_draw_from_gl", "int");
+ gdk_cairo_draw_from_gl(Xen_to_C_cairo_t_(cr), Xen_to_C_GdkWindow_(window), Xen_to_C_int(source), Xen_to_C_int(source_type),
+ Xen_to_C_int(buffer_scale), Xen_to_C_int(x), Xen_to_C_int(y), Xen_to_C_int(width), Xen_to_C_int(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_selection_send_notify(XEN requestor, XEN selection, XEN target, XEN property, XEN time_)
+static Xen gxg_gdk_window_mark_paint_from_clip(Xen window, Xen cr)
{
- #define H_gdk_selection_send_notify "void gdk_selection_send_notify(GdkWindow* requestor, GdkAtom selection, \
-GdkAtom target, GdkAtom property, guint32 time_)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(requestor), requestor, 1, "gdk_selection_send_notify", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 2, "gdk_selection_send_notify", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 3, "gdk_selection_send_notify", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(property), property, 4, "gdk_selection_send_notify", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint32_P(time_), time_, 5, "gdk_selection_send_notify", "guint32");
- gdk_selection_send_notify(XEN_TO_C_GdkWindow_(requestor), XEN_TO_C_GdkAtom(selection), XEN_TO_C_GdkAtom(target), XEN_TO_C_GdkAtom(property),
- XEN_TO_C_guint32(time_));
- return(XEN_FALSE);
+ #define H_gdk_window_mark_paint_from_clip "void gdk_window_mark_paint_from_clip(GdkWindow* window, \
+cairo_t* cr)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_mark_paint_from_clip", "GdkWindow*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gdk_window_mark_paint_from_clip", "cairo_t*");
+ gdk_window_mark_paint_from_clip(Xen_to_C_GdkWindow_(window), Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_gdk_selection_send_notify_for_display(XEN display, XEN requestor, XEN selection, XEN target, XEN property, XEN time_)
+static Xen gxg_gtk_label_set_xalign(Xen label, Xen xalign)
{
- #define H_gdk_selection_send_notify_for_display "void gdk_selection_send_notify_for_display(GdkDisplay* display, \
-GdkWindow* requestor, GdkAtom selection, GdkAtom target, GdkAtom property, guint32 time_)"
- XEN_ASSERT_TYPE(XEN_GdkDisplay__P(display), display, 1, "gdk_selection_send_notify_for_display", "GdkDisplay*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(requestor), requestor, 2, "gdk_selection_send_notify_for_display", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(selection), selection, 3, "gdk_selection_send_notify_for_display", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(target), target, 4, "gdk_selection_send_notify_for_display", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_GdkAtom_P(property), property, 5, "gdk_selection_send_notify_for_display", "GdkAtom");
- XEN_ASSERT_TYPE(XEN_guint32_P(time_), time_, 6, "gdk_selection_send_notify_for_display", "guint32");
- gdk_selection_send_notify_for_display(XEN_TO_C_GdkDisplay_(display), XEN_TO_C_GdkWindow_(requestor), XEN_TO_C_GdkAtom(selection),
- XEN_TO_C_GdkAtom(target), XEN_TO_C_GdkAtom(property), XEN_TO_C_guint32(time_));
- return(XEN_FALSE);
+ #define H_gtk_label_set_xalign "void gtk_label_set_xalign(GtkLabel* label, gfloat xalign)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_xalign", "GtkLabel*");
+ Xen_check_type(Xen_is_gfloat(xalign), xalign, 2, "gtk_label_set_xalign", "gfloat");
+ gtk_label_set_xalign(Xen_to_C_GtkLabel_(label), Xen_to_C_gfloat(xalign));
+ return(Xen_false);
}
-static XEN gxg_gdk_rgba_copy(XEN rgba)
+static Xen gxg_gtk_label_get_xalign(Xen label)
{
- #define H_gdk_rgba_copy "GdkRGBA* gdk_rgba_copy(GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 1, "gdk_rgba_copy", "GdkRGBA*");
- return(C_TO_XEN_GdkRGBA_(gdk_rgba_copy(XEN_TO_C_GdkRGBA_(rgba))));
+ #define H_gtk_label_get_xalign "gfloat gtk_label_get_xalign(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_xalign", "GtkLabel*");
+ return(C_to_Xen_gfloat(gtk_label_get_xalign(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gdk_rgba_free(XEN rgba)
+static Xen gxg_gtk_label_set_yalign(Xen label, Xen xalign)
{
- #define H_gdk_rgba_free "void gdk_rgba_free(GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 1, "gdk_rgba_free", "GdkRGBA*");
- gdk_rgba_free(XEN_TO_C_GdkRGBA_(rgba));
- return(XEN_FALSE);
+ #define H_gtk_label_set_yalign "void gtk_label_set_yalign(GtkLabel* label, gfloat xalign)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_set_yalign", "GtkLabel*");
+ Xen_check_type(Xen_is_gfloat(xalign), xalign, 2, "gtk_label_set_yalign", "gfloat");
+ gtk_label_set_yalign(Xen_to_C_GtkLabel_(label), Xen_to_C_gfloat(xalign));
+ return(Xen_false);
}
-static XEN gxg_gdk_rgba_parse(XEN rgba, XEN spec)
+static Xen gxg_gtk_label_get_yalign(Xen label)
{
- #define H_gdk_rgba_parse "gboolean gdk_rgba_parse(GdkRGBA* rgba, gchar* spec)"
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 1, "gdk_rgba_parse", "GdkRGBA*");
- XEN_ASSERT_TYPE(XEN_gchar__P(spec), spec, 2, "gdk_rgba_parse", "gchar*");
- return(C_TO_XEN_gboolean(gdk_rgba_parse(XEN_TO_C_GdkRGBA_(rgba), (const gchar*)XEN_TO_C_gchar_(spec))));
+ #define H_gtk_label_get_yalign "gfloat gtk_label_get_yalign(GtkLabel* label)"
+ Xen_check_type(Xen_is_GtkLabel_(label), label, 1, "gtk_label_get_yalign", "GtkLabel*");
+ return(C_to_Xen_gfloat(gtk_label_get_yalign(Xen_to_C_GtkLabel_(label))));
}
-static XEN gxg_gdk_rgba_to_string(XEN rgba)
+static Xen gxg_gtk_paned_set_wide_handle(Xen paned, Xen wide)
{
- #define H_gdk_rgba_to_string "gchar* gdk_rgba_to_string(GdkRGBA* rgba)"
- XEN_ASSERT_TYPE(XEN_GdkRGBA__P(rgba), rgba, 1, "gdk_rgba_to_string", "GdkRGBA*");
- return(C_TO_XEN_gchar_(gdk_rgba_to_string(XEN_TO_C_GdkRGBA_(rgba))));
+ #define H_gtk_paned_set_wide_handle "void gtk_paned_set_wide_handle(GtkPaned* paned, gboolean wide)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_set_wide_handle", "GtkPaned*");
+ Xen_check_type(Xen_is_gboolean(wide), wide, 2, "gtk_paned_set_wide_handle", "gboolean");
+ gtk_paned_set_wide_handle(Xen_to_C_GtkPaned_(paned), Xen_to_C_gboolean(wide));
+ return(Xen_false);
}
-#endif
-
-#if (!HAVE_GTK_3)
-static XEN gxg_gdk_colormap_new(XEN visual, XEN allocate)
+static Xen gxg_gtk_paned_get_wide_handle(Xen paned)
{
- #define H_gdk_colormap_new "GdkColormap* gdk_colormap_new(GdkVisual* visual, gboolean allocate)"
- XEN_ASSERT_TYPE(XEN_GdkVisual__P(visual), visual, 1, "gdk_colormap_new", "GdkVisual*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(allocate), allocate, 2, "gdk_colormap_new", "gboolean");
- return(C_TO_XEN_GdkColormap_(gdk_colormap_new(XEN_TO_C_GdkVisual_(visual), XEN_TO_C_gboolean(allocate))));
+ #define H_gtk_paned_get_wide_handle "gboolean gtk_paned_get_wide_handle(GtkPaned* paned)"
+ Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_get_wide_handle", "GtkPaned*");
+ return(C_to_Xen_gboolean(gtk_paned_get_wide_handle(Xen_to_C_GtkPaned_(paned))));
}
-static XEN gxg_gdk_colormap_get_system(void)
+static Xen gxg_gtk_scrolled_window_set_overlay_scrolling(Xen scrolled_window, Xen overlay_scrolling)
{
- #define H_gdk_colormap_get_system "GdkColormap* gdk_colormap_get_system( void)"
- return(C_TO_XEN_GdkColormap_(gdk_colormap_get_system()));
+ #define H_gtk_scrolled_window_set_overlay_scrolling "void gtk_scrolled_window_set_overlay_scrolling(GtkScrolledWindow* scrolled_window, \
+gboolean overlay_scrolling)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_set_overlay_scrolling", "GtkScrolledWindow*");
+ Xen_check_type(Xen_is_gboolean(overlay_scrolling), overlay_scrolling, 2, "gtk_scrolled_window_set_overlay_scrolling", "gboolean");
+ gtk_scrolled_window_set_overlay_scrolling(Xen_to_C_GtkScrolledWindow_(scrolled_window), Xen_to_C_gboolean(overlay_scrolling));
+ return(Xen_false);
}
-static XEN gxg_gdk_colormap_alloc_colors(XEN colormap, XEN colors, XEN ncolors, XEN writeable, XEN best_match, XEN ignore_success)
+static Xen gxg_gtk_scrolled_window_get_overlay_scrolling(Xen scrolled_window)
{
- #define H_gdk_colormap_alloc_colors "gint gdk_colormap_alloc_colors(GdkColormap* colormap, GdkColor* colors, \
-gint ncolors, gboolean writeable, gboolean best_match, gboolean* [success])"
- gboolean ref_success;
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 1, "gdk_colormap_alloc_colors", "GdkColormap*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(colors), colors, 2, "gdk_colormap_alloc_colors", "GdkColor*");
- XEN_ASSERT_TYPE(XEN_gint_P(ncolors), ncolors, 3, "gdk_colormap_alloc_colors", "gint");
- XEN_ASSERT_TYPE(XEN_gboolean_P(writeable), writeable, 4, "gdk_colormap_alloc_colors", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(best_match), best_match, 5, "gdk_colormap_alloc_colors", "gboolean");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gint(gdk_colormap_alloc_colors(XEN_TO_C_GdkColormap_(colormap), XEN_TO_C_GdkColor_(colors), XEN_TO_C_gint(ncolors),
- XEN_TO_C_gboolean(writeable), XEN_TO_C_gboolean(best_match), &ref_success));
- return(XEN_LIST_2(result, C_TO_XEN_gboolean(ref_success)));
- }
+ #define H_gtk_scrolled_window_get_overlay_scrolling "gboolean gtk_scrolled_window_get_overlay_scrolling(GtkScrolledWindow* scrolled_window)"
+ Xen_check_type(Xen_is_GtkScrolledWindow_(scrolled_window), scrolled_window, 1, "gtk_scrolled_window_get_overlay_scrolling", "GtkScrolledWindow*");
+ return(C_to_Xen_gboolean(gtk_scrolled_window_get_overlay_scrolling(Xen_to_C_GtkScrolledWindow_(scrolled_window))));
}
-static XEN gxg_gdk_colormap_alloc_color(XEN colormap, XEN color, XEN writeable, XEN best_match)
+static Xen gxg_gtk_text_view_set_monospace(Xen text_view, Xen monospace)
{
- #define H_gdk_colormap_alloc_color "gboolean gdk_colormap_alloc_color(GdkColormap* colormap, GdkColor* color, \
-gboolean writeable, gboolean best_match)"
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 1, "gdk_colormap_alloc_color", "GdkColormap*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gdk_colormap_alloc_color", "GdkColor*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(writeable), writeable, 3, "gdk_colormap_alloc_color", "gboolean");
- XEN_ASSERT_TYPE(XEN_gboolean_P(best_match), best_match, 4, "gdk_colormap_alloc_color", "gboolean");
- return(C_TO_XEN_gboolean(gdk_colormap_alloc_color(XEN_TO_C_GdkColormap_(colormap), XEN_TO_C_GdkColor_(color), XEN_TO_C_gboolean(writeable),
- XEN_TO_C_gboolean(best_match))));
+ #define H_gtk_text_view_set_monospace "void gtk_text_view_set_monospace(GtkTextView* text_view, gboolean monospace)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_monospace", "GtkTextView*");
+ Xen_check_type(Xen_is_gboolean(monospace), monospace, 2, "gtk_text_view_set_monospace", "gboolean");
+ gtk_text_view_set_monospace(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gboolean(monospace));
+ return(Xen_false);
}
-static XEN gxg_gdk_colormap_get_visual(XEN colormap)
+static Xen gxg_gtk_text_view_get_monospace(Xen text_view)
{
- #define H_gdk_colormap_get_visual "GdkVisual* gdk_colormap_get_visual(GdkColormap* colormap)"
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 1, "gdk_colormap_get_visual", "GdkColormap*");
- return(C_TO_XEN_GdkVisual_(gdk_colormap_get_visual(XEN_TO_C_GdkColormap_(colormap))));
+ #define H_gtk_text_view_get_monospace "gboolean gtk_text_view_get_monospace(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_monospace", "GtkTextView*");
+ return(C_to_Xen_gboolean(gtk_text_view_get_monospace(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gdk_cursor_ref(XEN cursor)
+static Xen gxg_gtk_window_get_titlebar(Xen window)
{
- #define H_gdk_cursor_ref "GdkCursor* gdk_cursor_ref(GdkCursor* cursor)"
- XEN_ASSERT_TYPE(XEN_GdkCursor__P(cursor), cursor, 1, "gdk_cursor_ref", "GdkCursor*");
- return(C_TO_XEN_GdkCursor_(gdk_cursor_ref(XEN_TO_C_GdkCursor_(cursor))));
+ #define H_gtk_window_get_titlebar "GtkWidget* gtk_window_get_titlebar(GtkWindow* window)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_get_titlebar", "GtkWindow*");
+ return(C_to_Xen_GtkWidget_(gtk_window_get_titlebar(Xen_to_C_GtkWindow_(window))));
}
-static XEN gxg_gdk_cursor_unref(XEN cursor)
+static Xen gxg_gtk_gl_area_new(void)
{
- #define H_gdk_cursor_unref "void gdk_cursor_unref(GdkCursor* cursor)"
- XEN_ASSERT_TYPE(XEN_GdkCursor__P(cursor), cursor, 1, "gdk_cursor_unref", "GdkCursor*");
- gdk_cursor_unref(XEN_TO_C_GdkCursor_(cursor));
- return(XEN_FALSE);
+ #define H_gtk_gl_area_new "GtkWidget* gtk_gl_area_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_gl_area_new()));
}
-static XEN gxg_gdk_drag_context_new(void)
+static Xen gxg_gtk_gl_area_get_has_alpha(Xen area)
{
- #define H_gdk_drag_context_new "GdkDragContext* gdk_drag_context_new( void)"
- return(C_TO_XEN_GdkDragContext_(gdk_drag_context_new()));
+ #define H_gtk_gl_area_get_has_alpha "gboolean gtk_gl_area_get_has_alpha(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_get_has_alpha", "GtkGLArea*");
+ return(C_to_Xen_gboolean(gtk_gl_area_get_has_alpha(Xen_to_C_GtkGLArea_(area))));
}
-static XEN gxg_gdk_drag_get_protocol(XEN xid, XEN ignore_protocol)
+static Xen gxg_gtk_gl_area_set_has_alpha(Xen area, Xen has_alpha)
{
- #define H_gdk_drag_get_protocol "guint32 gdk_drag_get_protocol(guint32 xid, GdkDragProtocol* [protocol])"
- GdkDragProtocol ref_protocol;
- XEN_ASSERT_TYPE(XEN_guint32_P(xid), xid, 1, "gdk_drag_get_protocol", "guint32");
- {
- XEN result = XEN_FALSE;
- result = C_TO_XEN_guint32(gdk_drag_get_protocol(XEN_TO_C_guint32(xid), &ref_protocol));
- return(XEN_LIST_2(result, C_TO_XEN_GdkDragProtocol(ref_protocol)));
- }
+ #define H_gtk_gl_area_set_has_alpha "void gtk_gl_area_set_has_alpha(GtkGLArea* area, gboolean has_alpha)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_set_has_alpha", "GtkGLArea*");
+ Xen_check_type(Xen_is_gboolean(has_alpha), has_alpha, 2, "gtk_gl_area_set_has_alpha", "gboolean");
+ gtk_gl_area_set_has_alpha(Xen_to_C_GtkGLArea_(area), Xen_to_C_gboolean(has_alpha));
+ return(Xen_false);
}
-static XEN gxg_gdk_drag_find_window(XEN context, XEN drag_window, XEN x_root, XEN y_root, XEN ignore_dest_window, XEN ignore_protocol)
+static Xen gxg_gtk_gl_area_get_has_depth_buffer(Xen area)
{
- #define H_gdk_drag_find_window "void gdk_drag_find_window(GdkDragContext* context, GdkWindow* drag_window, \
-gint x_root, gint y_root, GdkWindow** [dest_window], GdkDragProtocol* [protocol])"
- GdkWindow* ref_dest_window = NULL;
- GdkDragProtocol ref_protocol;
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_find_window", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(drag_window), drag_window, 2, "gdk_drag_find_window", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(x_root), x_root, 3, "gdk_drag_find_window", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y_root), y_root, 4, "gdk_drag_find_window", "gint");
- gdk_drag_find_window(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GdkWindow_(drag_window), XEN_TO_C_gint(x_root), XEN_TO_C_gint(y_root),
- &ref_dest_window, &ref_protocol);
- return(XEN_LIST_2(C_TO_XEN_GdkWindow_(ref_dest_window), C_TO_XEN_GdkDragProtocol(ref_protocol)));
+ #define H_gtk_gl_area_get_has_depth_buffer "gboolean gtk_gl_area_get_has_depth_buffer(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_get_has_depth_buffer", "GtkGLArea*");
+ return(C_to_Xen_gboolean(gtk_gl_area_get_has_depth_buffer(Xen_to_C_GtkGLArea_(area))));
}
-static XEN gxg_gdk_drag_motion(XEN context, XEN dest_window, XEN protocol, XEN x_root, XEN y_root, XEN suggested_action, XEN possible_actions, XEN time)
+static Xen gxg_gtk_gl_area_set_has_depth_buffer(Xen area, Xen has_depth_buffer)
{
- #define H_gdk_drag_motion "gboolean gdk_drag_motion(GdkDragContext* context, GdkWindow* dest_window, \
-GdkDragProtocol protocol, gint x_root, gint y_root, GdkDragAction suggested_action, GdkDragAction possible_actions, \
-guint32 time)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gdk_drag_motion", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(dest_window), dest_window, 2, "gdk_drag_motion", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkDragProtocol_P(protocol), protocol, 3, "gdk_drag_motion", "GdkDragProtocol");
- XEN_ASSERT_TYPE(XEN_gint_P(x_root), x_root, 4, "gdk_drag_motion", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y_root), y_root, 5, "gdk_drag_motion", "gint");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(suggested_action), suggested_action, 6, "gdk_drag_motion", "GdkDragAction");
- XEN_ASSERT_TYPE(XEN_GdkDragAction_P(possible_actions), possible_actions, 7, "gdk_drag_motion", "GdkDragAction");
- XEN_ASSERT_TYPE(XEN_guint32_P(time), time, 8, "gdk_drag_motion", "guint32");
- return(C_TO_XEN_gboolean(gdk_drag_motion(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GdkWindow_(dest_window), XEN_TO_C_GdkDragProtocol(protocol),
- XEN_TO_C_gint(x_root), XEN_TO_C_gint(y_root), XEN_TO_C_GdkDragAction(suggested_action),
- XEN_TO_C_GdkDragAction(possible_actions), XEN_TO_C_guint32(time))));
+ #define H_gtk_gl_area_set_has_depth_buffer "void gtk_gl_area_set_has_depth_buffer(GtkGLArea* area, \
+gboolean has_depth_buffer)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_set_has_depth_buffer", "GtkGLArea*");
+ Xen_check_type(Xen_is_gboolean(has_depth_buffer), has_depth_buffer, 2, "gtk_gl_area_set_has_depth_buffer", "gboolean");
+ gtk_gl_area_set_has_depth_buffer(Xen_to_C_GtkGLArea_(area), Xen_to_C_gboolean(has_depth_buffer));
+ return(Xen_false);
}
-static XEN gxg_gdk_cairo_create(XEN drawable)
+static Xen gxg_gtk_gl_area_get_context(Xen area)
{
- #define H_gdk_cairo_create "cairo_t* gdk_cairo_create(GdkDrawable* drawable)"
- XEN_ASSERT_TYPE(XEN_GdkDrawable__P(drawable), drawable, 1, "gdk_cairo_create", "GdkDrawable*");
- return(C_TO_XEN_cairo_t_(gdk_cairo_create(XEN_TO_C_GdkDrawable_(drawable))));
+ #define H_gtk_gl_area_get_context "GdkGLContext* gtk_gl_area_get_context(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_get_context", "GtkGLArea*");
+ return(C_to_Xen_GdkGLContext_(gtk_gl_area_get_context(Xen_to_C_GtkGLArea_(area))));
}
-static XEN gxg_gdk_drawable_get_size(XEN drawable, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_gl_area_make_current(Xen area)
{
- #define H_gdk_drawable_get_size "void gdk_drawable_get_size(GdkDrawable* drawable, gint* [width], gint* [height])"
- gint ref_width;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GdkDrawable__P(drawable), drawable, 1, "gdk_drawable_get_size", "GdkDrawable*");
- gdk_drawable_get_size(XEN_TO_C_GdkDrawable_(drawable), &ref_width, &ref_height);
- return(XEN_LIST_2(C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ #define H_gtk_gl_area_make_current "void gtk_gl_area_make_current(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_make_current", "GtkGLArea*");
+ gtk_gl_area_make_current(Xen_to_C_GtkGLArea_(area));
+ return(Xen_false);
}
-static XEN gxg_gdk_drawable_set_colormap(XEN drawable, XEN colormap)
+static Xen gxg_gtk_render_check(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gdk_drawable_set_colormap "void gdk_drawable_set_colormap(GdkDrawable* drawable, GdkColormap* colormap)"
- XEN_ASSERT_TYPE(XEN_GdkDrawable__P(drawable), drawable, 1, "gdk_drawable_set_colormap", "GdkDrawable*");
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 2, "gdk_drawable_set_colormap", "GdkColormap*");
- gdk_drawable_set_colormap(XEN_TO_C_GdkDrawable_(drawable), XEN_TO_C_GdkColormap_(colormap));
- return(XEN_FALSE);
+ #define H_gtk_render_check "void gtk_render_check(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_check", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_check", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_check", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_check", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_check", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_check", "gdouble");
+ gtk_render_check(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y), Xen_to_C_gdouble(width),
+ Xen_to_C_gdouble(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_drawable_get_colormap(XEN drawable)
+static Xen gxg_gtk_render_option(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gdk_drawable_get_colormap "GdkColormap* gdk_drawable_get_colormap(GdkDrawable* drawable)"
- XEN_ASSERT_TYPE(XEN_GdkDrawable__P(drawable), drawable, 1, "gdk_drawable_get_colormap", "GdkDrawable*");
- return(C_TO_XEN_GdkColormap_(gdk_drawable_get_colormap(XEN_TO_C_GdkDrawable_(drawable))));
+ #define H_gtk_render_option "void gtk_render_option(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_option", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_option", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_option", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_option", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_option", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_option", "gdouble");
+ gtk_render_option(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_gdouble(width), Xen_to_C_gdouble(height));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_arrow(Xen context, Xen cr, Xen angle, Xen x, Xen y, Xen size)
+{
+ #define H_gtk_render_arrow "void gtk_render_arrow(GtkStyleContext* context, cairo_t* cr, gdouble angle, \
+gdouble x, gdouble y, gdouble size)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_arrow", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_arrow", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(angle), angle, 3, "gtk_render_arrow", "gdouble");
+ Xen_check_type(Xen_is_gdouble(x), x, 4, "gtk_render_arrow", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 5, "gtk_render_arrow", "gdouble");
+ Xen_check_type(Xen_is_gdouble(size), size, 6, "gtk_render_arrow", "gdouble");
+ gtk_render_arrow(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(angle), Xen_to_C_gdouble(x),
+ Xen_to_C_gdouble(y), Xen_to_C_gdouble(size));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_background(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height)
+{
+ #define H_gtk_render_background "void gtk_render_background(GtkStyleContext* context, cairo_t* cr, \
+gdouble x, gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_background", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_background", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_background", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_background", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_background", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_background", "gdouble");
+ gtk_render_background(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_gdouble(width), Xen_to_C_gdouble(height));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_frame(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height)
+{
+ #define H_gtk_render_frame "void gtk_render_frame(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_frame", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_frame", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_frame", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_frame", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_frame", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_frame", "gdouble");
+ gtk_render_frame(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y), Xen_to_C_gdouble(width),
+ Xen_to_C_gdouble(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_drawable_get_visual(XEN drawable)
+static Xen gxg_gtk_render_expander(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gdk_drawable_get_visual "GdkVisual* gdk_drawable_get_visual(GdkDrawable* drawable)"
- XEN_ASSERT_TYPE(XEN_GdkDrawable__P(drawable), drawable, 1, "gdk_drawable_get_visual", "GdkDrawable*");
- return(C_TO_XEN_GdkVisual_(gdk_drawable_get_visual(XEN_TO_C_GdkDrawable_(drawable))));
+ #define H_gtk_render_expander "void gtk_render_expander(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_expander", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_expander", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_expander", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_expander", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_expander", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_expander", "gdouble");
+ gtk_render_expander(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_gdouble(width), Xen_to_C_gdouble(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_drawable_get_depth(XEN drawable)
+static Xen gxg_gtk_render_focus(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gdk_drawable_get_depth "gint gdk_drawable_get_depth(GdkDrawable* drawable)"
- XEN_ASSERT_TYPE(XEN_GdkDrawable__P(drawable), drawable, 1, "gdk_drawable_get_depth", "GdkDrawable*");
- return(C_TO_XEN_gint(gdk_drawable_get_depth(XEN_TO_C_GdkDrawable_(drawable))));
+ #define H_gtk_render_focus "void gtk_render_focus(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_focus", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_focus", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_focus", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_focus", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_focus", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_focus", "gdouble");
+ gtk_render_focus(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y), Xen_to_C_gdouble(width),
+ Xen_to_C_gdouble(height));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_layout(Xen context, Xen cr, Xen x, Xen y, Xen layout)
+{
+ #define H_gtk_render_layout "void gtk_render_layout(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, PangoLayout* layout)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_layout", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_layout", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_layout", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_layout", "gdouble");
+ Xen_check_type(Xen_is_PangoLayout_(layout), layout, 5, "gtk_render_layout", "PangoLayout*");
+ gtk_render_layout(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_PangoLayout_(layout));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_line(Xen context, Xen cr, Xen x0, Xen y0, Xen x1, Xen y1)
+{
+ #define H_gtk_render_line "void gtk_render_line(GtkStyleContext* context, cairo_t* cr, gdouble x0, \
+gdouble y0, gdouble x1, gdouble y1)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_line", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_line", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x0), x0, 3, "gtk_render_line", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y0), y0, 4, "gtk_render_line", "gdouble");
+ Xen_check_type(Xen_is_gdouble(x1), x1, 5, "gtk_render_line", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y1), y1, 6, "gtk_render_line", "gdouble");
+ gtk_render_line(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x0), Xen_to_C_gdouble(y0),
+ Xen_to_C_gdouble(x1), Xen_to_C_gdouble(y1));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_slider(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height, Xen orientation)
+{
+ #define H_gtk_render_slider "void gtk_render_slider(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height, GtkOrientation orientation)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_slider", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_slider", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_slider", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_slider", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_slider", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_slider", "gdouble");
+ Xen_check_type(Xen_is_GtkOrientation(orientation), orientation, 7, "gtk_render_slider", "GtkOrientation");
+ gtk_render_slider(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_gdouble(width), Xen_to_C_gdouble(height), Xen_to_C_GtkOrientation(orientation));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_frame_gap(Xen arglist)
+{
+ #define H_gtk_render_frame_gap "void gtk_render_frame_gap(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height, GtkPositionType gap_side, gdouble xy0_gap, gdouble xy1_gap)"
+ Xen context, cr, x, y, width, height, gap_side, xy0_gap, xy1_gap;
+ context = Xen_list_ref(arglist, 0);
+ cr = Xen_list_ref(arglist, 1);
+ x = Xen_list_ref(arglist, 2);
+ y = Xen_list_ref(arglist, 3);
+ width = Xen_list_ref(arglist, 4);
+ height = Xen_list_ref(arglist, 5);
+ gap_side = Xen_list_ref(arglist, 6);
+ xy0_gap = Xen_list_ref(arglist, 7);
+ xy1_gap = Xen_list_ref(arglist, 8);
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_frame_gap", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_frame_gap", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_frame_gap", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_frame_gap", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_frame_gap", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_frame_gap", "gdouble");
+ Xen_check_type(Xen_is_GtkPositionType(gap_side), gap_side, 7, "gtk_render_frame_gap", "GtkPositionType");
+ Xen_check_type(Xen_is_gdouble(xy0_gap), xy0_gap, 8, "gtk_render_frame_gap", "gdouble");
+ Xen_check_type(Xen_is_gdouble(xy1_gap), xy1_gap, 9, "gtk_render_frame_gap", "gdouble");
+ gtk_render_frame_gap(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_gdouble(width), Xen_to_C_gdouble(height), Xen_to_C_GtkPositionType(gap_side), Xen_to_C_gdouble(xy0_gap),
+ Xen_to_C_gdouble(xy1_gap));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_extension(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height, Xen gap_side)
+{
+ #define H_gtk_render_extension "void gtk_render_extension(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height, GtkPositionType gap_side)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_extension", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_extension", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_extension", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_extension", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_extension", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_extension", "gdouble");
+ Xen_check_type(Xen_is_GtkPositionType(gap_side), gap_side, 7, "gtk_render_extension", "GtkPositionType");
+ gtk_render_extension(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_gdouble(width), Xen_to_C_gdouble(height), Xen_to_C_GtkPositionType(gap_side));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_render_handle(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height)
+{
+ #define H_gtk_render_handle "void gtk_render_handle(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_handle", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_handle", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_handle", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_handle", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_handle", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_handle", "gdouble");
+ gtk_render_handle(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_gdouble(width), Xen_to_C_gdouble(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_set_locale(void)
+static Xen gxg_gtk_render_activity(Xen context, Xen cr, Xen x, Xen y, Xen width, Xen height)
{
- #define H_gdk_set_locale "gchar* gdk_set_locale( void)"
- return(C_TO_XEN_gchar_(gdk_set_locale()));
+ #define H_gtk_render_activity "void gtk_render_activity(GtkStyleContext* context, cairo_t* cr, gdouble x, \
+gdouble y, gdouble width, gdouble height)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_activity", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_activity", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 3, "gtk_render_activity", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 4, "gtk_render_activity", "gdouble");
+ Xen_check_type(Xen_is_gdouble(width), width, 5, "gtk_render_activity", "gdouble");
+ Xen_check_type(Xen_is_gdouble(height), height, 6, "gtk_render_activity", "gdouble");
+ gtk_render_activity(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble(x), Xen_to_C_gdouble(y),
+ Xen_to_C_gdouble(width), Xen_to_C_gdouble(height));
+ return(Xen_false);
}
-static XEN gxg_gdk_pixbuf_render_threshold_alpha(XEN pixbuf, XEN bitmap, XEN src_x, XEN src_y, XEN dest_x, XEN dest_y, XEN width, XEN height, XEN alpha_threshold)
+static Xen gxg_gtk_render_icon(Xen context, Xen cr, Xen pixbuf, Xen x, Xen y)
{
- #define H_gdk_pixbuf_render_threshold_alpha "void gdk_pixbuf_render_threshold_alpha(GdkPixbuf* pixbuf, \
-GdkBitmap* bitmap, int src_x, int src_y, int dest_x, int dest_y, int width, int height, int alpha_threshold)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_render_threshold_alpha", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_GdkBitmap__P(bitmap), bitmap, 2, "gdk_pixbuf_render_threshold_alpha", "GdkBitmap*");
- XEN_ASSERT_TYPE(XEN_int_P(src_x), src_x, 3, "gdk_pixbuf_render_threshold_alpha", "int");
- XEN_ASSERT_TYPE(XEN_int_P(src_y), src_y, 4, "gdk_pixbuf_render_threshold_alpha", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_x), dest_x, 5, "gdk_pixbuf_render_threshold_alpha", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_y), dest_y, 6, "gdk_pixbuf_render_threshold_alpha", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 7, "gdk_pixbuf_render_threshold_alpha", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 8, "gdk_pixbuf_render_threshold_alpha", "int");
- XEN_ASSERT_TYPE(XEN_int_P(alpha_threshold), alpha_threshold, 9, "gdk_pixbuf_render_threshold_alpha", "int");
- gdk_pixbuf_render_threshold_alpha(XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_GdkBitmap_(bitmap), XEN_TO_C_int(src_x), XEN_TO_C_int(src_y),
- XEN_TO_C_int(dest_x), XEN_TO_C_int(dest_y), XEN_TO_C_int(width), XEN_TO_C_int(height),
- XEN_TO_C_int(alpha_threshold));
- return(XEN_FALSE);
+ #define H_gtk_render_icon "void gtk_render_icon(GtkStyleContext* context, cairo_t* cr, GdkPixbuf* pixbuf, \
+gdouble x, gdouble y)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_icon", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_icon", "cairo_t*");
+ Xen_check_type(Xen_is_GdkPixbuf_(pixbuf), pixbuf, 3, "gtk_render_icon", "GdkPixbuf*");
+ Xen_check_type(Xen_is_gdouble(x), x, 4, "gtk_render_icon", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 5, "gtk_render_icon", "gdouble");
+ gtk_render_icon(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_GdkPixbuf_(pixbuf), Xen_to_C_gdouble(x),
+ Xen_to_C_gdouble(y));
+ return(Xen_false);
}
-static XEN gxg_gdk_pixbuf_render_pixmap_and_mask_for_colormap(XEN pixbuf, XEN colormap, XEN ignore_pixmap_return, XEN ignore_mask_return, XEN alpha_threshold)
+static Xen gxg_gtk_render_icon_surface(Xen context, Xen cr, Xen surface, Xen x, Xen y)
{
- #define H_gdk_pixbuf_render_pixmap_and_mask_for_colormap "void gdk_pixbuf_render_pixmap_and_mask_for_colormap(GdkPixbuf* pixbuf, \
-GdkColormap* colormap, GdkPixmap** [pixmap_return], GdkBitmap** [mask_return], int alpha_threshold)"
- GdkPixmap* ref_pixmap_return = NULL;
- GdkBitmap* ref_mask_return = NULL;
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_render_pixmap_and_mask_for_colormap", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 2, "gdk_pixbuf_render_pixmap_and_mask_for_colormap", "GdkColormap*");
- XEN_ASSERT_TYPE(XEN_int_P(alpha_threshold), alpha_threshold, 5, "gdk_pixbuf_render_pixmap_and_mask_for_colormap", "int");
- gdk_pixbuf_render_pixmap_and_mask_for_colormap(XEN_TO_C_GdkPixbuf_(pixbuf), XEN_TO_C_GdkColormap_(colormap), &ref_pixmap_return,
- &ref_mask_return, XEN_TO_C_int(alpha_threshold));
- return(XEN_LIST_2(C_TO_XEN_GdkPixmap_(ref_pixmap_return), C_TO_XEN_GdkBitmap_(ref_mask_return)));
+ #define H_gtk_render_icon_surface "void gtk_render_icon_surface(GtkStyleContext* context, cairo_t* cr, \
+cairo_surface_t* surface, gdouble x, gdouble y)"
+ Xen_check_type(Xen_is_GtkStyleContext_(context), context, 1, "gtk_render_icon_surface", "GtkStyleContext*");
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 2, "gtk_render_icon_surface", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 3, "gtk_render_icon_surface", "cairo_surface_t*");
+ Xen_check_type(Xen_is_gdouble(x), x, 4, "gtk_render_icon_surface", "gdouble");
+ Xen_check_type(Xen_is_gdouble(y), y, 5, "gtk_render_icon_surface", "gdouble");
+ gtk_render_icon_surface(Xen_to_C_GtkStyleContext_(context), Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_surface_t_(surface),
+ Xen_to_C_gdouble(x), Xen_to_C_gdouble(y));
+ return(Xen_false);
}
-static XEN gxg_gdk_pixbuf_render_pixmap_and_mask(XEN pixbuf, XEN ignore_pixmap_return, XEN ignore_mask_return, XEN alpha_threshold)
+static Xen gxg_gdk_gl_context_get_window(Xen context)
{
- #define H_gdk_pixbuf_render_pixmap_and_mask "void gdk_pixbuf_render_pixmap_and_mask(GdkPixbuf* pixbuf, \
-GdkPixmap** [pixmap_return], GdkBitmap** [mask_return], int alpha_threshold)"
- GdkPixmap* ref_pixmap_return = NULL;
- GdkBitmap* ref_mask_return = NULL;
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(pixbuf), pixbuf, 1, "gdk_pixbuf_render_pixmap_and_mask", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_int_P(alpha_threshold), alpha_threshold, 4, "gdk_pixbuf_render_pixmap_and_mask", "int");
- gdk_pixbuf_render_pixmap_and_mask(XEN_TO_C_GdkPixbuf_(pixbuf), &ref_pixmap_return, &ref_mask_return, XEN_TO_C_int(alpha_threshold));
- return(XEN_LIST_2(C_TO_XEN_GdkPixmap_(ref_pixmap_return), C_TO_XEN_GdkBitmap_(ref_mask_return)));
+ #define H_gdk_gl_context_get_window "GdkWindow* gdk_gl_context_get_window(GdkGLContext* context)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_get_window", "GdkGLContext*");
+ return(C_to_Xen_GdkWindow_(gdk_gl_context_get_window(Xen_to_C_GdkGLContext_(context))));
}
-static XEN gxg_gdk_pixbuf_get_from_drawable(XEN dest, XEN src, XEN cmap, XEN src_x, XEN src_y, XEN dest_x, XEN dest_y, XEN width, XEN height)
+static Xen gxg_gdk_gl_context_make_current(Xen context)
{
- #define H_gdk_pixbuf_get_from_drawable "GdkPixbuf* gdk_pixbuf_get_from_drawable(GdkPixbuf* dest, GdkDrawable* src, \
-GdkColormap* cmap, int src_x, int src_y, int dest_x, int dest_y, int width, int height)"
- XEN_ASSERT_TYPE(XEN_GdkPixbuf__P(dest) || XEN_FALSE_P(dest), dest, 1, "gdk_pixbuf_get_from_drawable", "GdkPixbuf*");
- XEN_ASSERT_TYPE(XEN_GdkDrawable__P(src), src, 2, "gdk_pixbuf_get_from_drawable", "GdkDrawable*");
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(cmap) || XEN_FALSE_P(cmap), cmap, 3, "gdk_pixbuf_get_from_drawable", "GdkColormap*");
- XEN_ASSERT_TYPE(XEN_int_P(src_x), src_x, 4, "gdk_pixbuf_get_from_drawable", "int");
- XEN_ASSERT_TYPE(XEN_int_P(src_y), src_y, 5, "gdk_pixbuf_get_from_drawable", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_x), dest_x, 6, "gdk_pixbuf_get_from_drawable", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dest_y), dest_y, 7, "gdk_pixbuf_get_from_drawable", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 8, "gdk_pixbuf_get_from_drawable", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 9, "gdk_pixbuf_get_from_drawable", "int");
- return(C_TO_XEN_GdkPixbuf_(gdk_pixbuf_get_from_drawable(XEN_TO_C_GdkPixbuf_(dest), XEN_TO_C_GdkDrawable_(src), XEN_TO_C_GdkColormap_(cmap),
- XEN_TO_C_int(src_x), XEN_TO_C_int(src_y), XEN_TO_C_int(dest_x),
- XEN_TO_C_int(dest_y), XEN_TO_C_int(width), XEN_TO_C_int(height))));
+ #define H_gdk_gl_context_make_current "void gdk_gl_context_make_current(GdkGLContext* context)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_make_current", "GdkGLContext*");
+ gdk_gl_context_make_current(Xen_to_C_GdkGLContext_(context));
+ return(Xen_false);
}
-static XEN gxg_gdk_rgb_find_color(XEN colormap, XEN color)
+static Xen gxg_gdk_gl_context_get_current(void)
{
- #define H_gdk_rgb_find_color "void gdk_rgb_find_color(GdkColormap* colormap, GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 1, "gdk_rgb_find_color", "GdkColormap*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 2, "gdk_rgb_find_color", "GdkColor*");
- gdk_rgb_find_color(XEN_TO_C_GdkColormap_(colormap), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gdk_gl_context_get_current "GdkGLContext* gdk_gl_context_get_current( void)"
+ return(C_to_Xen_GdkGLContext_(gdk_gl_context_get_current()));
}
-static XEN gxg_gdk_window_clear(XEN window)
+static Xen gxg_gdk_gl_context_clear_current(void)
{
- #define H_gdk_window_clear "void gdk_window_clear(GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_clear", "GdkWindow*");
- gdk_window_clear(XEN_TO_C_GdkWindow_(window));
- return(XEN_FALSE);
+ #define H_gdk_gl_context_clear_current "void gdk_gl_context_clear_current( void)"
+ gdk_gl_context_clear_current();
+ return(Xen_false);
}
-static XEN gxg_gdk_window_clear_area(XEN window, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_gtk_stack_set_hhomogeneous(Xen stack, Xen hhomogeneous)
{
- #define H_gdk_window_clear_area "void gdk_window_clear_area(GdkWindow* window, gint x, gint y, gint width, \
-gint height)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_clear_area", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gdk_window_clear_area", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gdk_window_clear_area", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 4, "gdk_window_clear_area", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 5, "gdk_window_clear_area", "gint");
- gdk_window_clear_area(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gint(x), XEN_TO_C_gint(y), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_gtk_stack_set_hhomogeneous "void gtk_stack_set_hhomogeneous(GtkStack* stack, gboolean hhomogeneous)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_hhomogeneous", "GtkStack*");
+ Xen_check_type(Xen_is_gboolean(hhomogeneous), hhomogeneous, 2, "gtk_stack_set_hhomogeneous", "gboolean");
+ gtk_stack_set_hhomogeneous(Xen_to_C_GtkStack_(stack), Xen_to_C_gboolean(hhomogeneous));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_clear_area_e(XEN window, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_gtk_stack_get_hhomogeneous(Xen stack)
{
- #define H_gdk_window_clear_area_e "void gdk_window_clear_area_e(GdkWindow* window, gint x, gint y, \
-gint width, gint height)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_clear_area_e", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 2, "gdk_window_clear_area_e", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 3, "gdk_window_clear_area_e", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 4, "gdk_window_clear_area_e", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 5, "gdk_window_clear_area_e", "gint");
- gdk_window_clear_area_e(XEN_TO_C_GdkWindow_(window), XEN_TO_C_gint(x), XEN_TO_C_gint(y), XEN_TO_C_gint(width), XEN_TO_C_gint(height));
- return(XEN_FALSE);
+ #define H_gtk_stack_get_hhomogeneous "gboolean gtk_stack_get_hhomogeneous(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_hhomogeneous", "GtkStack*");
+ return(C_to_Xen_gboolean(gtk_stack_get_hhomogeneous(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gdk_window_shape_combine_mask(XEN window, XEN mask, XEN x, XEN y)
+static Xen gxg_gtk_stack_set_vhomogeneous(Xen stack, Xen vhomogeneous)
{
- #define H_gdk_window_shape_combine_mask "void gdk_window_shape_combine_mask(GdkWindow* window, GdkBitmap* mask, \
-gint x, gint y)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_shape_combine_mask", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkBitmap__P(mask), mask, 2, "gdk_window_shape_combine_mask", "GdkBitmap*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 3, "gdk_window_shape_combine_mask", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 4, "gdk_window_shape_combine_mask", "gint");
- gdk_window_shape_combine_mask(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkBitmap_(mask), XEN_TO_C_gint(x), XEN_TO_C_gint(y));
- return(XEN_FALSE);
+ #define H_gtk_stack_set_vhomogeneous "void gtk_stack_set_vhomogeneous(GtkStack* stack, gboolean vhomogeneous)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_vhomogeneous", "GtkStack*");
+ Xen_check_type(Xen_is_gboolean(vhomogeneous), vhomogeneous, 2, "gtk_stack_set_vhomogeneous", "gboolean");
+ gtk_stack_set_vhomogeneous(Xen_to_C_GtkStack_(stack), Xen_to_C_gboolean(vhomogeneous));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_foreign_new(XEN anid)
+static Xen gxg_gtk_stack_get_vhomogeneous(Xen stack)
{
- #define H_gdk_window_foreign_new "GdkWindow* gdk_window_foreign_new(GdkNativeWindow anid)"
- XEN_ASSERT_TYPE(XEN_GdkNativeWindow_P(anid), anid, 1, "gdk_window_foreign_new", "GdkNativeWindow");
- return(C_TO_XEN_GdkWindow_(gdk_window_foreign_new(XEN_TO_C_GdkNativeWindow(anid))));
+ #define H_gtk_stack_get_vhomogeneous "gboolean gtk_stack_get_vhomogeneous(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_vhomogeneous", "GtkStack*");
+ return(C_to_Xen_gboolean(gtk_stack_get_vhomogeneous(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gdk_window_lookup(XEN anid)
+static Xen gxg_gdk_gl_context_get_display(Xen context)
{
- #define H_gdk_window_lookup "GdkWindow* gdk_window_lookup(GdkNativeWindow anid)"
- XEN_ASSERT_TYPE(XEN_GdkNativeWindow_P(anid), anid, 1, "gdk_window_lookup", "GdkNativeWindow");
- return(C_TO_XEN_GdkWindow_(gdk_window_lookup(XEN_TO_C_GdkNativeWindow(anid))));
+ #define H_gdk_gl_context_get_display "GdkDisplay* gdk_gl_context_get_display(GdkGLContext* context)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_get_display", "GdkGLContext*");
+ return(C_to_Xen_GdkDisplay_(gdk_gl_context_get_display(Xen_to_C_GdkGLContext_(context))));
}
-static XEN gxg_gdk_window_set_icon(XEN window, XEN icon_window, XEN pixmap, XEN mask)
+static Xen gxg_gtk_gl_area_get_has_stencil_buffer(Xen area)
{
- #define H_gdk_window_set_icon "void gdk_window_set_icon(GdkWindow* window, GdkWindow* icon_window, \
-GdkPixmap* pixmap, GdkBitmap* mask)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_icon", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(icon_window), icon_window, 2, "gdk_window_set_icon", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkPixmap__P(pixmap), pixmap, 3, "gdk_window_set_icon", "GdkPixmap*");
- XEN_ASSERT_TYPE(XEN_GdkBitmap__P(mask), mask, 4, "gdk_window_set_icon", "GdkBitmap*");
- gdk_window_set_icon(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkWindow_(icon_window), XEN_TO_C_GdkPixmap_(pixmap), XEN_TO_C_GdkBitmap_(mask));
- return(XEN_FALSE);
+ #define H_gtk_gl_area_get_has_stencil_buffer "gboolean gtk_gl_area_get_has_stencil_buffer(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_get_has_stencil_buffer", "GtkGLArea*");
+ return(C_to_Xen_gboolean(gtk_gl_area_get_has_stencil_buffer(Xen_to_C_GtkGLArea_(area))));
}
-static XEN gxg_gdk_window_get_internal_paint_info(XEN window, XEN ignore_real_drawable, XEN ignore_x_offset, XEN ignore_y_offset)
+static Xen gxg_gtk_gl_area_set_has_stencil_buffer(Xen area, Xen has_stencil_buffer)
{
- #define H_gdk_window_get_internal_paint_info "void gdk_window_get_internal_paint_info(GdkWindow* window, \
-GdkDrawable** [real_drawable], gint* [x_offset], gint* [y_offset])"
- GdkDrawable* ref_real_drawable = NULL;
- gint ref_x_offset;
- gint ref_y_offset;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_internal_paint_info", "GdkWindow*");
- gdk_window_get_internal_paint_info(XEN_TO_C_GdkWindow_(window), &ref_real_drawable, &ref_x_offset, &ref_y_offset);
- return(XEN_LIST_3(C_TO_XEN_GdkDrawable_(ref_real_drawable), C_TO_XEN_gint(ref_x_offset), C_TO_XEN_gint(ref_y_offset)));
+ #define H_gtk_gl_area_set_has_stencil_buffer "void gtk_gl_area_set_has_stencil_buffer(GtkGLArea* area, \
+gboolean has_stencil_buffer)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_set_has_stencil_buffer", "GtkGLArea*");
+ Xen_check_type(Xen_is_gboolean(has_stencil_buffer), has_stencil_buffer, 2, "gtk_gl_area_set_has_stencil_buffer", "gboolean");
+ gtk_gl_area_set_has_stencil_buffer(Xen_to_C_GtkGLArea_(area), Xen_to_C_gboolean(has_stencil_buffer));
+ return(Xen_false);
}
-static XEN gxg_gdk_set_sm_client_id(XEN sm_client_id)
+static Xen gxg_gtk_gl_area_get_auto_render(Xen area)
{
- #define H_gdk_set_sm_client_id "void gdk_set_sm_client_id(gchar* sm_client_id)"
- XEN_ASSERT_TYPE(XEN_gchar__P(sm_client_id), sm_client_id, 1, "gdk_set_sm_client_id", "gchar*");
- gdk_set_sm_client_id(XEN_TO_C_gchar_(sm_client_id));
- return(XEN_FALSE);
+ #define H_gtk_gl_area_get_auto_render "gboolean gtk_gl_area_get_auto_render(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_get_auto_render", "GtkGLArea*");
+ return(C_to_Xen_gboolean(gtk_gl_area_get_auto_render(Xen_to_C_GtkGLArea_(area))));
}
-static XEN gxg_gdk_window_set_back_pixmap(XEN window, XEN pixmap, XEN parent_relative)
+static Xen gxg_gtk_gl_area_set_auto_render(Xen area, Xen auto_render)
{
- #define H_gdk_window_set_back_pixmap "void gdk_window_set_back_pixmap(GdkWindow* window, GdkPixmap* pixmap, \
-gboolean parent_relative)"
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_set_back_pixmap", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkPixmap__P(pixmap), pixmap, 2, "gdk_window_set_back_pixmap", "GdkPixmap*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(parent_relative), parent_relative, 3, "gdk_window_set_back_pixmap", "gboolean");
- gdk_window_set_back_pixmap(XEN_TO_C_GdkWindow_(window), XEN_TO_C_GdkPixmap_(pixmap), XEN_TO_C_gboolean(parent_relative));
- return(XEN_FALSE);
+ #define H_gtk_gl_area_set_auto_render "void gtk_gl_area_set_auto_render(GtkGLArea* area, gboolean auto_render)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_set_auto_render", "GtkGLArea*");
+ Xen_check_type(Xen_is_gboolean(auto_render), auto_render, 2, "gtk_gl_area_set_auto_render", "gboolean");
+ gtk_gl_area_set_auto_render(Xen_to_C_GtkGLArea_(area), Xen_to_C_gboolean(auto_render));
+ return(Xen_false);
}
-static XEN gxg_gdk_window_get_geometry(XEN window, XEN ignore_x, XEN ignore_y, XEN ignore_width, XEN ignore_height, XEN ignore_depth)
+static Xen gxg_gtk_gl_area_queue_render(Xen area)
{
- #define H_gdk_window_get_geometry "void gdk_window_get_geometry(GdkWindow* window, gint* [x], gint* [y], \
-gint* [width], gint* [height], gint* [depth])"
- gint ref_x;
- gint ref_y;
- gint ref_width;
- gint ref_height;
- gint ref_depth;
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 1, "gdk_window_get_geometry", "GdkWindow*");
- gdk_window_get_geometry(XEN_TO_C_GdkWindow_(window), &ref_x, &ref_y, &ref_width, &ref_height, &ref_depth);
- return(XEN_LIST_5(C_TO_XEN_gint(ref_x), C_TO_XEN_gint(ref_y), C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height), C_TO_XEN_gint(ref_depth)));
+ #define H_gtk_gl_area_queue_render "void gtk_gl_area_queue_render(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_queue_render", "GtkGLArea*");
+ gtk_gl_area_queue_render(Xen_to_C_GtkGLArea_(area));
+ return(Xen_false);
}
-static XEN gxg_gtk_adjustment_new(XEN value, XEN lower, XEN upper, XEN step_increment, XEN page_increment, XEN page_size)
+static Xen gxg_gtk_gl_area_attach_buffers(Xen area)
{
- #define H_gtk_adjustment_new "GtkObject* gtk_adjustment_new(gdouble value, gdouble lower, gdouble upper, \
-gdouble step_increment, gdouble page_increment, gdouble page_size)"
- XEN_ASSERT_TYPE(XEN_gdouble_P(value), value, 1, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(lower), lower, 2, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(upper), upper, 3, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(step_increment), step_increment, 4, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page_increment), page_increment, 5, "gtk_adjustment_new", "gdouble");
- XEN_ASSERT_TYPE(XEN_gdouble_P(page_size), page_size, 6, "gtk_adjustment_new", "gdouble");
- return(C_TO_XEN_GtkObject_(gtk_adjustment_new(XEN_TO_C_gdouble(value), XEN_TO_C_gdouble(lower), XEN_TO_C_gdouble(upper),
- XEN_TO_C_gdouble(step_increment), XEN_TO_C_gdouble(page_increment), XEN_TO_C_gdouble(page_size))));
+ #define H_gtk_gl_area_attach_buffers "void gtk_gl_area_attach_buffers(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_attach_buffers", "GtkGLArea*");
+ gtk_gl_area_attach_buffers(Xen_to_C_GtkGLArea_(area));
+ return(Xen_false);
}
-static XEN gxg_gtk_bindings_activate(XEN object, XEN keyval, XEN modifiers)
+static Xen gxg_gtk_gl_area_get_error(Xen area)
{
- #define H_gtk_bindings_activate "gboolean gtk_bindings_activate(GtkObject* object, guint keyval, GdkModifierType modifiers)"
- XEN_ASSERT_TYPE(XEN_GtkObject__P(object), object, 1, "gtk_bindings_activate", "GtkObject*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_bindings_activate", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifiers), modifiers, 3, "gtk_bindings_activate", "GdkModifierType");
- return(C_TO_XEN_gboolean(gtk_bindings_activate(XEN_TO_C_GtkObject_(object), XEN_TO_C_guint(keyval), XEN_TO_C_GdkModifierType(modifiers))));
+ #define H_gtk_gl_area_get_error "GError* gtk_gl_area_get_error(GtkGLArea* area)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_get_error", "GtkGLArea*");
+ return(C_to_Xen_GError_(gtk_gl_area_get_error(Xen_to_C_GtkGLArea_(area))));
}
-static XEN gxg_gtk_binding_set_activate(XEN binding_set, XEN keyval, XEN modifiers, XEN object)
+static Xen gxg_gtk_popover_menu_new(void)
{
- #define H_gtk_binding_set_activate "gboolean gtk_binding_set_activate(GtkBindingSet* binding_set, guint keyval, \
-GdkModifierType modifiers, GtkObject* object)"
- XEN_ASSERT_TYPE(XEN_GtkBindingSet__P(binding_set), binding_set, 1, "gtk_binding_set_activate", "GtkBindingSet*");
- XEN_ASSERT_TYPE(XEN_guint_P(keyval), keyval, 2, "gtk_binding_set_activate", "guint");
- XEN_ASSERT_TYPE(XEN_GdkModifierType_P(modifiers), modifiers, 3, "gtk_binding_set_activate", "GdkModifierType");
- XEN_ASSERT_TYPE(XEN_GtkObject__P(object), object, 4, "gtk_binding_set_activate", "GtkObject*");
- return(C_TO_XEN_gboolean(gtk_binding_set_activate(XEN_TO_C_GtkBindingSet_(binding_set), XEN_TO_C_guint(keyval), XEN_TO_C_GdkModifierType(modifiers),
- XEN_TO_C_GtkObject_(object))));
+ #define H_gtk_popover_menu_new "GtkWidget* gtk_popover_menu_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_popover_menu_new()));
}
-static XEN gxg_gtk_cell_renderer_get_size(XEN cell, XEN widget, XEN cell_area, XEN ignore_x_offset, XEN ignore_y_offset, XEN ignore_width, XEN ignore_height)
+static Xen gxg_gtk_popover_menu_open_submenu(Xen popover, Xen name)
{
- #define H_gtk_cell_renderer_get_size "void gtk_cell_renderer_get_size(GtkCellRenderer* cell, GtkWidget* widget, \
-GdkRectangle* cell_area, gint* [x_offset], gint* [y_offset], gint* [width], gint* [height])"
- gint ref_x_offset;
- gint ref_y_offset;
- gint ref_width;
- gint ref_height;
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_get_size", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 2, "gtk_cell_renderer_get_size", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(cell_area) || XEN_FALSE_P(cell_area), cell_area, 3, "gtk_cell_renderer_get_size", "GdkRectangle*");
- gtk_cell_renderer_get_size(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkRectangle_(cell_area),
- &ref_x_offset, &ref_y_offset, &ref_width, &ref_height);
- return(XEN_LIST_4(C_TO_XEN_gint(ref_x_offset), C_TO_XEN_gint(ref_y_offset), C_TO_XEN_gint(ref_width), C_TO_XEN_gint(ref_height)));
+ #define H_gtk_popover_menu_open_submenu "void gtk_popover_menu_open_submenu(GtkPopoverMenu* popover, \
+gchar* name)"
+ Xen_check_type(Xen_is_GtkPopoverMenu_(popover), popover, 1, "gtk_popover_menu_open_submenu", "GtkPopoverMenu*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_popover_menu_open_submenu", "gchar*");
+ gtk_popover_menu_open_submenu(Xen_to_C_GtkPopoverMenu_(popover), (const gchar*)Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_renderer_render(XEN cell, XEN window, XEN widget, XEN background_area, XEN cell_area, XEN expose_area, XEN flags)
+static Xen gxg_gtk_entry_grab_focus_without_selecting(Xen entry)
{
- #define H_gtk_cell_renderer_render "void gtk_cell_renderer_render(GtkCellRenderer* cell, GdkWindow* window, \
-GtkWidget* widget, GdkRectangle* background_area, GdkRectangle* cell_area, GdkRectangle* expose_area, \
-GtkCellRendererState flags)"
- XEN_ASSERT_TYPE(XEN_GtkCellRenderer__P(cell), cell, 1, "gtk_cell_renderer_render", "GtkCellRenderer*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 2, "gtk_cell_renderer_render", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 3, "gtk_cell_renderer_render", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(background_area), background_area, 4, "gtk_cell_renderer_render", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(cell_area), cell_area, 5, "gtk_cell_renderer_render", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(expose_area), expose_area, 6, "gtk_cell_renderer_render", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_GtkCellRendererState_P(flags), flags, 7, "gtk_cell_renderer_render", "GtkCellRendererState");
- gtk_cell_renderer_render(XEN_TO_C_GtkCellRenderer_(cell), XEN_TO_C_GdkWindow_(window), XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkRectangle_(background_area),
- XEN_TO_C_GdkRectangle_(cell_area), XEN_TO_C_GdkRectangle_(expose_area), XEN_TO_C_GtkCellRendererState(flags));
- return(XEN_FALSE);
+ #define H_gtk_entry_grab_focus_without_selecting "void gtk_entry_grab_focus_without_selecting(GtkEntry* entry)"
+ Xen_check_type(Xen_is_GtkEntry_(entry), entry, 1, "gtk_entry_grab_focus_without_selecting", "GtkEntry*");
+ gtk_entry_grab_focus_without_selecting(Xen_to_C_GtkEntry_(entry));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_dest_set_proxy(XEN widget, XEN proxy_window, XEN protocol, XEN use_coordinates)
+static Xen gxg_gtk_scrollable_get_border(Xen scrollable, Xen border)
{
- #define H_gtk_drag_dest_set_proxy "void gtk_drag_dest_set_proxy(GtkWidget* widget, GdkWindow* proxy_window, \
-GdkDragProtocol protocol, gboolean use_coordinates)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_dest_set_proxy", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(proxy_window), proxy_window, 2, "gtk_drag_dest_set_proxy", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GdkDragProtocol_P(protocol), protocol, 3, "gtk_drag_dest_set_proxy", "GdkDragProtocol");
- XEN_ASSERT_TYPE(XEN_gboolean_P(use_coordinates), use_coordinates, 4, "gtk_drag_dest_set_proxy", "gboolean");
- gtk_drag_dest_set_proxy(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkWindow_(proxy_window), XEN_TO_C_GdkDragProtocol(protocol),
- XEN_TO_C_gboolean(use_coordinates));
- return(XEN_FALSE);
+ #define H_gtk_scrollable_get_border "gboolean gtk_scrollable_get_border(GtkScrollable* scrollable, \
+GtkBorder* border)"
+ Xen_check_type(Xen_is_GtkScrollable_(scrollable), scrollable, 1, "gtk_scrollable_get_border", "GtkScrollable*");
+ Xen_check_type(Xen_is_GtkBorder_(border), border, 2, "gtk_scrollable_get_border", "GtkBorder*");
+ return(C_to_Xen_gboolean(gtk_scrollable_get_border(Xen_to_C_GtkScrollable_(scrollable), Xen_to_C_GtkBorder_(border))));
}
-static XEN gxg_gtk_drag_source_set_icon(XEN widget, XEN colormap, XEN pixmap, XEN mask)
+static Xen gxg_gtk_text_buffer_insert_markup(Xen buffer, Xen iter, Xen markup, Xen len)
{
- #define H_gtk_drag_source_set_icon "void gtk_drag_source_set_icon(GtkWidget* widget, GdkColormap* colormap, \
-GdkPixmap* pixmap, GdkBitmap* mask)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_drag_source_set_icon", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 2, "gtk_drag_source_set_icon", "GdkColormap*");
- XEN_ASSERT_TYPE(XEN_GdkPixmap__P(pixmap), pixmap, 3, "gtk_drag_source_set_icon", "GdkPixmap*");
- XEN_ASSERT_TYPE(XEN_GdkBitmap__P(mask), mask, 4, "gtk_drag_source_set_icon", "GdkBitmap*");
- gtk_drag_source_set_icon(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkColormap_(colormap), XEN_TO_C_GdkPixmap_(pixmap), XEN_TO_C_GdkBitmap_(mask));
- return(XEN_FALSE);
+ #define H_gtk_text_buffer_insert_markup "void gtk_text_buffer_insert_markup(GtkTextBuffer* buffer, \
+GtkTextIter* iter, gchar* markup, gint len)"
+ Xen_check_type(Xen_is_GtkTextBuffer_(buffer), buffer, 1, "gtk_text_buffer_insert_markup", "GtkTextBuffer*");
+ Xen_check_type(Xen_is_GtkTextIter_(iter), iter, 2, "gtk_text_buffer_insert_markup", "GtkTextIter*");
+ Xen_check_type(Xen_is_gchar_(markup), markup, 3, "gtk_text_buffer_insert_markup", "gchar*");
+ Xen_check_type(Xen_is_gint(len), len, 4, "gtk_text_buffer_insert_markup", "gint");
+ gtk_text_buffer_insert_markup(Xen_to_C_GtkTextBuffer_(buffer), Xen_to_C_GtkTextIter_(iter), (const gchar*)Xen_to_C_gchar_(markup), Xen_to_C_gint(len));
+ return(Xen_false);
}
-static XEN gxg_gtk_drag_set_icon_pixmap(XEN context, XEN colormap, XEN pixmap, XEN mask, XEN hot_x, XEN hot_y)
+static Xen gxg_gdk_device_get_vendor_id(Xen device)
{
- #define H_gtk_drag_set_icon_pixmap "void gtk_drag_set_icon_pixmap(GdkDragContext* context, GdkColormap* colormap, \
-GdkPixmap* pixmap, GdkBitmap* mask, gint hot_x, gint hot_y)"
- XEN_ASSERT_TYPE(XEN_GdkDragContext__P(context), context, 1, "gtk_drag_set_icon_pixmap", "GdkDragContext*");
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 2, "gtk_drag_set_icon_pixmap", "GdkColormap*");
- XEN_ASSERT_TYPE(XEN_GdkPixmap__P(pixmap), pixmap, 3, "gtk_drag_set_icon_pixmap", "GdkPixmap*");
- XEN_ASSERT_TYPE(XEN_GdkBitmap__P(mask), mask, 4, "gtk_drag_set_icon_pixmap", "GdkBitmap*");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_x), hot_x, 5, "gtk_drag_set_icon_pixmap", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(hot_y), hot_y, 6, "gtk_drag_set_icon_pixmap", "gint");
- gtk_drag_set_icon_pixmap(XEN_TO_C_GdkDragContext_(context), XEN_TO_C_GdkColormap_(colormap), XEN_TO_C_GdkPixmap_(pixmap),
- XEN_TO_C_GdkBitmap_(mask), XEN_TO_C_gint(hot_x), XEN_TO_C_gint(hot_y));
- return(XEN_FALSE);
+ #define H_gdk_device_get_vendor_id "gchar* gdk_device_get_vendor_id(GdkDevice* device)"
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 1, "gdk_device_get_vendor_id", "GdkDevice*");
+ return(C_to_Xen_gchar_((gchar*)gdk_device_get_vendor_id(Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_icon_set_render_icon(XEN icon_set, XEN style, XEN direction, XEN state, XEN size, XEN widget, XEN detail)
+static Xen gxg_gdk_device_get_product_id(Xen device)
{
- #define H_gtk_icon_set_render_icon "GdkPixbuf* gtk_icon_set_render_icon(GtkIconSet* icon_set, GtkStyle* style, \
-GtkTextDirection direction, GtkStateType state, GtkIconSize size, GtkWidget* widget, char* detail)"
- XEN_ASSERT_TYPE(XEN_GtkIconSet__P(icon_set), icon_set, 1, "gtk_icon_set_render_icon", "GtkIconSet*");
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style) || XEN_FALSE_P(style), style, 2, "gtk_icon_set_render_icon", "GtkStyle*");
- XEN_ASSERT_TYPE(XEN_GtkTextDirection_P(direction), direction, 3, "gtk_icon_set_render_icon", "GtkTextDirection");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state), state, 4, "gtk_icon_set_render_icon", "GtkStateType");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 5, "gtk_icon_set_render_icon", "GtkIconSize");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget) || XEN_FALSE_P(widget), widget, 6, "gtk_icon_set_render_icon", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_char__P(detail), detail, 7, "gtk_icon_set_render_icon", "char*");
- return(C_TO_XEN_GdkPixbuf_(gtk_icon_set_render_icon(XEN_TO_C_GtkIconSet_(icon_set), XEN_TO_C_GtkStyle_(style), XEN_TO_C_GtkTextDirection(direction),
- XEN_TO_C_GtkStateType(state), XEN_TO_C_GtkIconSize(size), XEN_TO_C_GtkWidget_(widget),
- XEN_TO_C_char_(detail))));
+ #define H_gdk_device_get_product_id "gchar* gdk_device_get_product_id(GdkDevice* device)"
+ Xen_check_type(Xen_is_GdkDevice_(device), device, 1, "gdk_device_get_product_id", "GdkDevice*");
+ return(C_to_Xen_gchar_((gchar*)gdk_device_get_product_id(Xen_to_C_GdkDevice_(device))));
}
-static XEN gxg_gtk_set_locale(void)
+static Xen gxg_gdk_gl_context_get_shared_context(Xen context)
{
- #define H_gtk_set_locale "gchar* gtk_set_locale( void)"
- return(C_TO_XEN_gchar_(gtk_set_locale()));
+ #define H_gdk_gl_context_get_shared_context "GdkGLContext* gdk_gl_context_get_shared_context(GdkGLContext* context)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_get_shared_context", "GdkGLContext*");
+ return(C_to_Xen_GdkGLContext_(gdk_gl_context_get_shared_context(Xen_to_C_GdkGLContext_(context))));
}
-static XEN gxg_gtk_range_set_update_policy(XEN range, XEN policy)
+static Xen gxg_gdk_gl_context_set_required_version(Xen context, Xen major, Xen minor)
{
- #define H_gtk_range_set_update_policy "void gtk_range_set_update_policy(GtkRange* range, GtkUpdateType policy)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_set_update_policy", "GtkRange*");
- XEN_ASSERT_TYPE(XEN_GtkUpdateType_P(policy), policy, 2, "gtk_range_set_update_policy", "GtkUpdateType");
- gtk_range_set_update_policy(XEN_TO_C_GtkRange_(range), XEN_TO_C_GtkUpdateType(policy));
- return(XEN_FALSE);
+ #define H_gdk_gl_context_set_required_version "void gdk_gl_context_set_required_version(GdkGLContext* context, \
+int major, int minor)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_set_required_version", "GdkGLContext*");
+ Xen_check_type(Xen_is_int(major), major, 2, "gdk_gl_context_set_required_version", "int");
+ Xen_check_type(Xen_is_int(minor), minor, 3, "gdk_gl_context_set_required_version", "int");
+ gdk_gl_context_set_required_version(Xen_to_C_GdkGLContext_(context), Xen_to_C_int(major), Xen_to_C_int(minor));
+ return(Xen_false);
}
-static XEN gxg_gtk_range_get_update_policy(XEN range)
+static Xen gxg_gdk_gl_context_get_required_version(Xen context, Xen ignore_major, Xen ignore_minor)
{
- #define H_gtk_range_get_update_policy "GtkUpdateType gtk_range_get_update_policy(GtkRange* range)"
- XEN_ASSERT_TYPE(XEN_GtkRange__P(range), range, 1, "gtk_range_get_update_policy", "GtkRange*");
- return(C_TO_XEN_GtkUpdateType(gtk_range_get_update_policy(XEN_TO_C_GtkRange_(range))));
+ #define H_gdk_gl_context_get_required_version "void gdk_gl_context_get_required_version(GdkGLContext* context, \
+int* [major], int* [minor])"
+ int ref_major;
+ int ref_minor;
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_get_required_version", "GdkGLContext*");
+ gdk_gl_context_get_required_version(Xen_to_C_GdkGLContext_(context), &ref_major, &ref_minor);
+ return(Xen_list_2(C_to_Xen_int(ref_major), C_to_Xen_int(ref_minor)));
}
-static XEN gxg_gtk_rc_add_default_file(XEN filename)
+static Xen gxg_gdk_gl_context_set_debug_enabled(Xen context, Xen enabled)
{
- #define H_gtk_rc_add_default_file "void gtk_rc_add_default_file(gchar* filename)"
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 1, "gtk_rc_add_default_file", "gchar*");
- gtk_rc_add_default_file(XEN_TO_C_gchar_(filename));
- return(XEN_FALSE);
+ #define H_gdk_gl_context_set_debug_enabled "void gdk_gl_context_set_debug_enabled(GdkGLContext* context, \
+gboolean enabled)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_set_debug_enabled", "GdkGLContext*");
+ Xen_check_type(Xen_is_gboolean(enabled), enabled, 2, "gdk_gl_context_set_debug_enabled", "gboolean");
+ gdk_gl_context_set_debug_enabled(Xen_to_C_GdkGLContext_(context), Xen_to_C_gboolean(enabled));
+ return(Xen_false);
}
-static XEN gxg_gtk_rc_set_default_files(XEN filenames)
+static Xen gxg_gdk_gl_context_get_debug_enabled(Xen context)
{
- #define H_gtk_rc_set_default_files "void gtk_rc_set_default_files(gchar** filenames)"
- XEN_ASSERT_TYPE(XEN_gchar___P(filenames), filenames, 1, "gtk_rc_set_default_files", "gchar**");
- gtk_rc_set_default_files(XEN_TO_C_gchar__(filenames));
- return(XEN_FALSE);
+ #define H_gdk_gl_context_get_debug_enabled "gboolean gdk_gl_context_get_debug_enabled(GdkGLContext* context)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_get_debug_enabled", "GdkGLContext*");
+ return(C_to_Xen_gboolean(gdk_gl_context_get_debug_enabled(Xen_to_C_GdkGLContext_(context))));
}
-static XEN gxg_gtk_rc_get_default_files(void)
+static Xen gxg_gdk_gl_context_set_forward_compatible(Xen context, Xen compatible)
{
- #define H_gtk_rc_get_default_files "gchar** gtk_rc_get_default_files( void)"
- return(C_TO_XEN_gchar__(gtk_rc_get_default_files()));
+ #define H_gdk_gl_context_set_forward_compatible "void gdk_gl_context_set_forward_compatible(GdkGLContext* context, \
+gboolean compatible)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_set_forward_compatible", "GdkGLContext*");
+ Xen_check_type(Xen_is_gboolean(compatible), compatible, 2, "gdk_gl_context_set_forward_compatible", "gboolean");
+ gdk_gl_context_set_forward_compatible(Xen_to_C_GdkGLContext_(context), Xen_to_C_gboolean(compatible));
+ return(Xen_false);
}
-static XEN gxg_gtk_rc_get_style(XEN widget)
+static Xen gxg_gdk_gl_context_get_forward_compatible(Xen context)
{
- #define H_gtk_rc_get_style "GtkStyle* gtk_rc_get_style(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_rc_get_style", "GtkWidget*");
- return(C_TO_XEN_GtkStyle_(gtk_rc_get_style(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gdk_gl_context_get_forward_compatible "gboolean gdk_gl_context_get_forward_compatible(GdkGLContext* context)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_get_forward_compatible", "GdkGLContext*");
+ return(C_to_Xen_gboolean(gdk_gl_context_get_forward_compatible(Xen_to_C_GdkGLContext_(context))));
}
-static XEN gxg_gtk_rc_parse(XEN filename)
+static Xen gxg_gdk_gl_context_realize(Xen context, Xen ignore_error)
{
- #define H_gtk_rc_parse "void gtk_rc_parse(gchar* filename)"
- XEN_ASSERT_TYPE(XEN_gchar__P(filename), filename, 1, "gtk_rc_parse", "gchar*");
- gtk_rc_parse(XEN_TO_C_gchar_(filename));
- return(XEN_FALSE);
+ #define H_gdk_gl_context_realize "gboolean gdk_gl_context_realize(GdkGLContext* context, GError** [error])"
+ GError* ref_error = NULL;
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_realize", "GdkGLContext*");
+ {
+ Xen result;
+ result = C_to_Xen_gboolean(gdk_gl_context_realize(Xen_to_C_GdkGLContext_(context), &ref_error));
+ return(Xen_list_2(result, C_to_Xen_GError_(ref_error)));
+ }
}
-static XEN gxg_gtk_rc_parse_string(XEN rc_string)
+static Xen gxg_gtk_clipboard_get_default(Xen display)
{
- #define H_gtk_rc_parse_string "void gtk_rc_parse_string(gchar* rc_string)"
- XEN_ASSERT_TYPE(XEN_gchar__P(rc_string), rc_string, 1, "gtk_rc_parse_string", "gchar*");
- gtk_rc_parse_string(XEN_TO_C_gchar_(rc_string));
- return(XEN_FALSE);
+ #define H_gtk_clipboard_get_default "GtkClipboard* gtk_clipboard_get_default(GdkDisplay* display)"
+ Xen_check_type(Xen_is_GdkDisplay_(display), display, 1, "gtk_clipboard_get_default", "GdkDisplay*");
+ return(C_to_Xen_GtkClipboard_(gtk_clipboard_get_default(Xen_to_C_GdkDisplay_(display))));
}
-static XEN gxg_gtk_rc_reparse_all(void)
+static Xen gxg_gtk_drag_cancel(Xen context)
{
- #define H_gtk_rc_reparse_all "gboolean gtk_rc_reparse_all( void)"
- return(C_TO_XEN_gboolean(gtk_rc_reparse_all()));
+ #define H_gtk_drag_cancel "void gtk_drag_cancel(GdkDragContext* context)"
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 1, "gtk_drag_cancel", "GdkDragContext*");
+ gtk_drag_cancel(Xen_to_C_GdkDragContext_(context));
+ return(Xen_false);
}
-static XEN gxg_gtk_rc_style_new(void)
+static Xen gxg_gtk_search_entry_handle_event(Xen entry, Xen event)
{
- #define H_gtk_rc_style_new "GtkRcStyle* gtk_rc_style_new( void)"
- return(C_TO_XEN_GtkRcStyle_(gtk_rc_style_new()));
+ #define H_gtk_search_entry_handle_event "gboolean gtk_search_entry_handle_event(GtkSearchEntry* entry, \
+GdkEvent* event)"
+ Xen_check_type(Xen_is_GtkSearchEntry_(entry), entry, 1, "gtk_search_entry_handle_event", "GtkSearchEntry*");
+ Xen_check_type(Xen_is_GdkEvent_(event), event, 2, "gtk_search_entry_handle_event", "GdkEvent*");
+ return(C_to_Xen_gboolean(gtk_search_entry_handle_event(Xen_to_C_GtkSearchEntry_(entry), Xen_to_C_GdkEvent_(event))));
}
-static XEN gxg_gtk_rc_style_copy(XEN orig)
+static Xen gxg_gdk_gl_context_get_version(Xen context, Xen ignore_major, Xen ignore_minor)
{
- #define H_gtk_rc_style_copy "GtkRcStyle* gtk_rc_style_copy(GtkRcStyle* orig)"
- XEN_ASSERT_TYPE(XEN_GtkRcStyle__P(orig), orig, 1, "gtk_rc_style_copy", "GtkRcStyle*");
- return(C_TO_XEN_GtkRcStyle_(gtk_rc_style_copy(XEN_TO_C_GtkRcStyle_(orig))));
+ #define H_gdk_gl_context_get_version "void gdk_gl_context_get_version(GdkGLContext* context, int* [major], \
+int* [minor])"
+ int ref_major;
+ int ref_minor;
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_get_version", "GdkGLContext*");
+ gdk_gl_context_get_version(Xen_to_C_GdkGLContext_(context), &ref_major, &ref_minor);
+ return(Xen_list_2(C_to_Xen_int(ref_major), C_to_Xen_int(ref_minor)));
}
-static XEN gxg_gtk_rc_find_module_in_path(XEN module_file)
+static Xen gxg_gtk_gl_area_set_required_version(Xen area, Xen major, Xen minor)
{
- #define H_gtk_rc_find_module_in_path "gchar* gtk_rc_find_module_in_path(gchar* module_file)"
- XEN_ASSERT_TYPE(XEN_gchar__P(module_file), module_file, 1, "gtk_rc_find_module_in_path", "gchar*");
- {
- gchar* result;
- XEN rtn;
- result = gtk_rc_find_module_in_path(XEN_TO_C_gchar_(module_file));
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_gl_area_set_required_version "void gtk_gl_area_set_required_version(GtkGLArea* area, \
+gint major, gint minor)"
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_set_required_version", "GtkGLArea*");
+ Xen_check_type(Xen_is_gint(major), major, 2, "gtk_gl_area_set_required_version", "gint");
+ Xen_check_type(Xen_is_gint(minor), minor, 3, "gtk_gl_area_set_required_version", "gint");
+ gtk_gl_area_set_required_version(Xen_to_C_GtkGLArea_(area), Xen_to_C_gint(major), Xen_to_C_gint(minor));
+ return(Xen_false);
}
-static XEN gxg_gtk_rc_get_theme_dir(void)
+static Xen gxg_gtk_gl_area_get_required_version(Xen area, Xen ignore_major, Xen ignore_minor)
{
- #define H_gtk_rc_get_theme_dir "gchar* gtk_rc_get_theme_dir( void)"
- {
- gchar* result;
- XEN rtn;
- result = gtk_rc_get_theme_dir();
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_gl_area_get_required_version "void gtk_gl_area_get_required_version(GtkGLArea* area, \
+gint* [major], gint* [minor])"
+ gint ref_major;
+ gint ref_minor;
+ Xen_check_type(Xen_is_GtkGLArea_(area), area, 1, "gtk_gl_area_get_required_version", "GtkGLArea*");
+ gtk_gl_area_get_required_version(Xen_to_C_GtkGLArea_(area), &ref_major, &ref_minor);
+ return(Xen_list_2(C_to_Xen_gint(ref_major), C_to_Xen_gint(ref_minor)));
}
-static XEN gxg_gtk_rc_get_module_dir(void)
+static Xen gxg_gtk_notebook_detach_tab(Xen notebook, Xen child)
{
- #define H_gtk_rc_get_module_dir "gchar* gtk_rc_get_module_dir( void)"
- {
- gchar* result;
- XEN rtn;
- result = gtk_rc_get_module_dir();
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_notebook_detach_tab "void gtk_notebook_detach_tab(GtkNotebook* notebook, GtkWidget* child)"
+ Xen_check_type(Xen_is_GtkNotebook_(notebook), notebook, 1, "gtk_notebook_detach_tab", "GtkNotebook*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_notebook_detach_tab", "GtkWidget*");
+ gtk_notebook_detach_tab(Xen_to_C_GtkNotebook_(notebook), Xen_to_C_GtkWidget_(child));
+ return(Xen_false);
}
-static XEN gxg_gtk_rc_get_im_module_path(void)
+static Xen gxg_gtk_stack_sidebar_new(void)
{
- #define H_gtk_rc_get_im_module_path "gchar* gtk_rc_get_im_module_path( void)"
- {
- gchar* result;
- XEN rtn;
- result = gtk_rc_get_im_module_path();
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_stack_sidebar_new "GtkWidget* gtk_stack_sidebar_new( void)"
+ return(C_to_Xen_GtkWidget_(gtk_stack_sidebar_new()));
}
-static XEN gxg_gtk_rc_get_im_module_file(void)
+static Xen gxg_gtk_stack_sidebar_set_stack(Xen sidebar, Xen stack)
{
- #define H_gtk_rc_get_im_module_file "gchar* gtk_rc_get_im_module_file( void)"
- {
- gchar* result;
- XEN rtn;
- result = gtk_rc_get_im_module_file();
- rtn = C_TO_XEN_gchar_(result);
- g_free(result);
- return(rtn);
- }
+ #define H_gtk_stack_sidebar_set_stack "void gtk_stack_sidebar_set_stack(GtkStackSidebar* sidebar, GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStackSidebar_(sidebar), sidebar, 1, "gtk_stack_sidebar_set_stack", "GtkStackSidebar*");
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 2, "gtk_stack_sidebar_set_stack", "GtkStack*");
+ gtk_stack_sidebar_set_stack(Xen_to_C_GtkStackSidebar_(sidebar), Xen_to_C_GtkStack_(stack));
+ return(Xen_false);
}
-static XEN gxg_gtk_style_new(void)
+static Xen gxg_gtk_stack_sidebar_get_stack(Xen sidebar)
{
- #define H_gtk_style_new "GtkStyle* gtk_style_new( void)"
- return(C_TO_XEN_GtkStyle_(gtk_style_new()));
+ #define H_gtk_stack_sidebar_get_stack "GtkStack* gtk_stack_sidebar_get_stack(GtkStackSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkStackSidebar_(sidebar), sidebar, 1, "gtk_stack_sidebar_get_stack", "GtkStackSidebar*");
+ return(C_to_Xen_GtkStack_(gtk_stack_sidebar_get_stack(Xen_to_C_GtkStackSidebar_(sidebar))));
}
-static XEN gxg_gtk_style_copy(XEN style)
+static Xen gxg_gtk_popover_set_transitions_enabled(Xen popover, Xen transitions_enabled)
{
- #define H_gtk_style_copy "GtkStyle* gtk_style_copy(GtkStyle* style)"
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style), style, 1, "gtk_style_copy", "GtkStyle*");
- return(C_TO_XEN_GtkStyle_(gtk_style_copy(XEN_TO_C_GtkStyle_(style))));
+ #define H_gtk_popover_set_transitions_enabled "void gtk_popover_set_transitions_enabled(GtkPopover* popover, \
+gboolean transitions_enabled)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_set_transitions_enabled", "GtkPopover*");
+ Xen_check_type(Xen_is_gboolean(transitions_enabled), transitions_enabled, 2, "gtk_popover_set_transitions_enabled", "gboolean");
+ gtk_popover_set_transitions_enabled(Xen_to_C_GtkPopover_(popover), Xen_to_C_gboolean(transitions_enabled));
+ return(Xen_false);
}
-static XEN gxg_gtk_style_attach(XEN style, XEN window)
+static Xen gxg_gtk_popover_get_transitions_enabled(Xen popover)
{
- #define H_gtk_style_attach "GtkStyle* gtk_style_attach(GtkStyle* style, GdkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style), style, 1, "gtk_style_attach", "GtkStyle*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 2, "gtk_style_attach", "GdkWindow*");
- return(C_TO_XEN_GtkStyle_(gtk_style_attach(XEN_TO_C_GtkStyle_(style), XEN_TO_C_GdkWindow_(window))));
+ #define H_gtk_popover_get_transitions_enabled "gboolean gtk_popover_get_transitions_enabled(GtkPopover* popover)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_get_transitions_enabled", "GtkPopover*");
+ return(C_to_Xen_gboolean(gtk_popover_get_transitions_enabled(Xen_to_C_GtkPopover_(popover))));
}
-static XEN gxg_gtk_style_detach(XEN style)
+#endif
+
+#if GTK_CHECK_VERSION(3, 18, 0)
+static Xen gxg_gdk_keymap_get_scroll_lock_state(Xen keymap)
{
- #define H_gtk_style_detach "void gtk_style_detach(GtkStyle* style)"
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style), style, 1, "gtk_style_detach", "GtkStyle*");
- gtk_style_detach(XEN_TO_C_GtkStyle_(style));
- return(XEN_FALSE);
+ #define H_gdk_keymap_get_scroll_lock_state "gboolean gdk_keymap_get_scroll_lock_state(GdkKeymap* keymap)"
+ Xen_check_type(Xen_is_GdkKeymap_(keymap), keymap, 1, "gdk_keymap_get_scroll_lock_state", "GdkKeymap*");
+ return(C_to_Xen_gboolean(gdk_keymap_get_scroll_lock_state(Xen_to_C_GdkKeymap_(keymap))));
}
-static XEN gxg_gtk_style_set_background(XEN style, XEN window, XEN state_type)
+static Xen gxg_gtk_radio_menu_item_join_group(Xen radio_menu_item, Xen group_source)
{
- #define H_gtk_style_set_background "void gtk_style_set_background(GtkStyle* style, GdkWindow* window, \
-GtkStateType state_type)"
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style), style, 1, "gtk_style_set_background", "GtkStyle*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 2, "gtk_style_set_background", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state_type), state_type, 3, "gtk_style_set_background", "GtkStateType");
- gtk_style_set_background(XEN_TO_C_GtkStyle_(style), XEN_TO_C_GdkWindow_(window), XEN_TO_C_GtkStateType(state_type));
- return(XEN_FALSE);
+ #define H_gtk_radio_menu_item_join_group "void gtk_radio_menu_item_join_group(GtkRadioMenuItem* radio_menu_item, \
+GtkRadioMenuItem* group_source)"
+ Xen_check_type(Xen_is_GtkRadioMenuItem_(radio_menu_item), radio_menu_item, 1, "gtk_radio_menu_item_join_group", "GtkRadioMenuItem*");
+ Xen_check_type(Xen_is_GtkRadioMenuItem_(group_source), group_source, 2, "gtk_radio_menu_item_join_group", "GtkRadioMenuItem*");
+ gtk_radio_menu_item_join_group(Xen_to_C_GtkRadioMenuItem_(radio_menu_item), Xen_to_C_GtkRadioMenuItem_(group_source));
+ return(Xen_false);
}
-static XEN gxg_gtk_style_apply_default_background(XEN style, XEN window, XEN set_bg, XEN state_type, XEN area, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_gtk_font_chooser_set_font_map(Xen fontchooser, Xen fontmap)
{
- #define H_gtk_style_apply_default_background "void gtk_style_apply_default_background(GtkStyle* style, \
-GdkWindow* window, gboolean set_bg, GtkStateType state_type, GdkRectangle* area, gint x, gint y, gint width, \
-gint height)"
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style), style, 1, "gtk_style_apply_default_background", "GtkStyle*");
- XEN_ASSERT_TYPE(XEN_GdkWindow__P(window), window, 2, "gtk_style_apply_default_background", "GdkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(set_bg), set_bg, 3, "gtk_style_apply_default_background", "gboolean");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state_type), state_type, 4, "gtk_style_apply_default_background", "GtkStateType");
- XEN_ASSERT_TYPE(XEN_GdkRectangle__P(area), area, 5, "gtk_style_apply_default_background", "GdkRectangle*");
- XEN_ASSERT_TYPE(XEN_gint_P(x), x, 6, "gtk_style_apply_default_background", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(y), y, 7, "gtk_style_apply_default_background", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(width), width, 8, "gtk_style_apply_default_background", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(height), height, 9, "gtk_style_apply_default_background", "gint");
- gtk_style_apply_default_background(XEN_TO_C_GtkStyle_(style), XEN_TO_C_GdkWindow_(window), XEN_TO_C_gboolean(set_bg), XEN_TO_C_GtkStateType(state_type),
- XEN_TO_C_GdkRectangle_(area), XEN_TO_C_gint(x), XEN_TO_C_gint(y), XEN_TO_C_gint(width),
- XEN_TO_C_gint(height));
- return(XEN_FALSE);
-}
-
-static XEN gxg_gtk_style_lookup_icon_set(XEN style, XEN stock_id)
-{
- #define H_gtk_style_lookup_icon_set "GtkIconSet* gtk_style_lookup_icon_set(GtkStyle* style, gchar* stock_id)"
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style), style, 1, "gtk_style_lookup_icon_set", "GtkStyle*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_style_lookup_icon_set", "gchar*");
- return(C_TO_XEN_GtkIconSet_(gtk_style_lookup_icon_set(XEN_TO_C_GtkStyle_(style), XEN_TO_C_gchar_(stock_id))));
-}
-
-static XEN gxg_gtk_style_render_icon(XEN style, XEN source, XEN direction, XEN state, XEN size, XEN widget, XEN detail)
-{
- #define H_gtk_style_render_icon "GdkPixbuf* gtk_style_render_icon(GtkStyle* style, GtkIconSource* source, \
-GtkTextDirection direction, GtkStateType state, GtkIconSize size, GtkWidget* widget, gchar* detail)"
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style), style, 1, "gtk_style_render_icon", "GtkStyle*");
- XEN_ASSERT_TYPE(XEN_GtkIconSource__P(source), source, 2, "gtk_style_render_icon", "GtkIconSource*");
- XEN_ASSERT_TYPE(XEN_GtkTextDirection_P(direction), direction, 3, "gtk_style_render_icon", "GtkTextDirection");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state), state, 4, "gtk_style_render_icon", "GtkStateType");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 5, "gtk_style_render_icon", "GtkIconSize");
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 6, "gtk_style_render_icon", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(detail), detail, 7, "gtk_style_render_icon", "gchar*");
- return(C_TO_XEN_GdkPixbuf_(gtk_style_render_icon(XEN_TO_C_GtkStyle_(style), XEN_TO_C_GtkIconSource_(source), XEN_TO_C_GtkTextDirection(direction),
- XEN_TO_C_GtkStateType(state), XEN_TO_C_GtkIconSize(size), XEN_TO_C_GtkWidget_(widget),
- XEN_TO_C_gchar_(detail))));
-}
-
-static XEN gxg_gtk_tree_view_create_row_drag_icon(XEN tree_view, XEN path)
-{
- #define H_gtk_tree_view_create_row_drag_icon "GdkPixmap* gtk_tree_view_create_row_drag_icon(GtkTreeView* tree_view, \
-GtkTreePath* path)"
- XEN_ASSERT_TYPE(XEN_GtkTreeView__P(tree_view), tree_view, 1, "gtk_tree_view_create_row_drag_icon", "GtkTreeView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_tree_view_create_row_drag_icon", "GtkTreePath*");
- return(C_TO_XEN_GdkPixmap_(gtk_tree_view_create_row_drag_icon(XEN_TO_C_GtkTreeView_(tree_view), XEN_TO_C_GtkTreePath_(path))));
+ #define H_gtk_font_chooser_set_font_map "void gtk_font_chooser_set_font_map(GtkFontChooser* fontchooser, \
+PangoFontMap* fontmap)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_set_font_map", "GtkFontChooser*");
+ Xen_check_type(Xen_is_PangoFontMap_(fontmap), fontmap, 2, "gtk_font_chooser_set_font_map", "PangoFontMap*");
+ gtk_font_chooser_set_font_map(Xen_to_C_GtkFontChooser_(fontchooser), Xen_to_C_PangoFontMap_(fontmap));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_hide_all(XEN widget)
+static Xen gxg_gtk_font_chooser_get_font_map(Xen fontchooser)
{
- #define H_gtk_widget_hide_all "void gtk_widget_hide_all(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_hide_all", "GtkWidget*");
- gtk_widget_hide_all(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_font_chooser_get_font_map "PangoFontMap* gtk_font_chooser_get_font_map(GtkFontChooser* fontchooser)"
+ Xen_check_type(Xen_is_GtkFontChooser_(fontchooser), fontchooser, 1, "gtk_font_chooser_get_font_map", "GtkFontChooser*");
+ return(C_to_Xen_PangoFontMap_(gtk_font_chooser_get_font_map(Xen_to_C_GtkFontChooser_(fontchooser))));
}
-static XEN gxg_gtk_widget_size_request(XEN widget, XEN requisition)
+static Xen gxg_gtk_popover_set_default_widget(Xen popover, Xen widget)
{
- #define H_gtk_widget_size_request "void gtk_widget_size_request(GtkWidget* widget, GtkRequisition* requisition)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_size_request", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkRequisition__P(requisition), requisition, 2, "gtk_widget_size_request", "GtkRequisition*");
- gtk_widget_size_request(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkRequisition_(requisition));
- return(XEN_FALSE);
+ #define H_gtk_popover_set_default_widget "void gtk_popover_set_default_widget(GtkPopover* popover, \
+GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_set_default_widget", "GtkPopover*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_popover_set_default_widget", "GtkWidget*");
+ gtk_popover_set_default_widget(Xen_to_C_GtkPopover_(popover), Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_child_requisition(XEN widget, XEN requisition)
+static Xen gxg_gtk_popover_get_default_widget(Xen popover)
{
- #define H_gtk_widget_get_child_requisition "void gtk_widget_get_child_requisition(GtkWidget* widget, \
-GtkRequisition* requisition)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_child_requisition", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkRequisition__P(requisition), requisition, 2, "gtk_widget_get_child_requisition", "GtkRequisition*");
- gtk_widget_get_child_requisition(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkRequisition_(requisition));
- return(XEN_FALSE);
+ #define H_gtk_popover_get_default_widget "GtkWidget* gtk_popover_get_default_widget(GtkPopover* popover)"
+ Xen_check_type(Xen_is_GtkPopover_(popover), popover, 1, "gtk_popover_get_default_widget", "GtkPopover*");
+ return(C_to_Xen_GtkWidget_(gtk_popover_get_default_widget(Xen_to_C_GtkPopover_(popover))));
}
-static XEN gxg_gtk_widget_get_colormap(XEN widget)
+static Xen gxg_gdk_window_set_pass_through(Xen window, Xen pass_through)
{
- #define H_gtk_widget_get_colormap "GdkColormap* gtk_widget_get_colormap(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_colormap", "GtkWidget*");
- return(C_TO_XEN_GdkColormap_(gtk_widget_get_colormap(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gdk_window_set_pass_through "void gdk_window_set_pass_through(GdkWindow* window, gboolean pass_through)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_set_pass_through", "GdkWindow*");
+ Xen_check_type(Xen_is_gboolean(pass_through), pass_through, 2, "gdk_window_set_pass_through", "gboolean");
+ gdk_window_set_pass_through(Xen_to_C_GdkWindow_(window), Xen_to_C_gboolean(pass_through));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_set_colormap(XEN widget, XEN colormap)
+static Xen gxg_gdk_window_get_pass_through(Xen window)
{
- #define H_gtk_widget_set_colormap "void gtk_widget_set_colormap(GtkWidget* widget, GdkColormap* colormap)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_colormap", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 2, "gtk_widget_set_colormap", "GdkColormap*");
- gtk_widget_set_colormap(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkColormap_(colormap));
- return(XEN_FALSE);
+ #define H_gdk_window_get_pass_through "gboolean gdk_window_get_pass_through(GdkWindow* window)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_get_pass_through", "GdkWindow*");
+ return(C_to_Xen_gboolean(gdk_window_get_pass_through(Xen_to_C_GdkWindow_(window))));
}
-static XEN gxg_gtk_widget_set_style(XEN widget, XEN style)
+static Xen gxg_gtk_overlay_reorder_overlay(Xen overlay, Xen child, Xen position)
{
- #define H_gtk_widget_set_style "void gtk_widget_set_style(GtkWidget* widget, GtkStyle* style)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_set_style", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style) || XEN_FALSE_P(style), style, 2, "gtk_widget_set_style", "GtkStyle*");
- gtk_widget_set_style(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkStyle_(style));
- return(XEN_FALSE);
+ #define H_gtk_overlay_reorder_overlay "void gtk_overlay_reorder_overlay(GtkOverlay* overlay, GtkWidget* child, \
+gint position)"
+ Xen_check_type(Xen_is_GtkOverlay_(overlay), overlay, 1, "gtk_overlay_reorder_overlay", "GtkOverlay*");
+ Xen_check_type(Xen_is_GtkWidget_(child), child, 2, "gtk_overlay_reorder_overlay", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(position), position, 3, "gtk_overlay_reorder_overlay", "gint");
+ gtk_overlay_reorder_overlay(Xen_to_C_GtkOverlay_(overlay), Xen_to_C_GtkWidget_(child), Xen_to_C_gint(position));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_ensure_style(XEN widget)
+static Xen gxg_gtk_overlay_get_overlay_pass_through(Xen overlay, Xen widget)
{
- #define H_gtk_widget_ensure_style "void gtk_widget_ensure_style(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_ensure_style", "GtkWidget*");
- gtk_widget_ensure_style(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_overlay_get_overlay_pass_through "gboolean gtk_overlay_get_overlay_pass_through(GtkOverlay* overlay, \
+GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkOverlay_(overlay), overlay, 1, "gtk_overlay_get_overlay_pass_through", "GtkOverlay*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_overlay_get_overlay_pass_through", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_overlay_get_overlay_pass_through(Xen_to_C_GtkOverlay_(overlay), Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_widget_get_style(XEN widget)
+static Xen gxg_gtk_overlay_set_overlay_pass_through(Xen overlay, Xen widget, Xen pass_through)
{
- #define H_gtk_widget_get_style "GtkStyle* gtk_widget_get_style(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_style", "GtkWidget*");
- return(C_TO_XEN_GtkStyle_(gtk_widget_get_style(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_overlay_set_overlay_pass_through "void gtk_overlay_set_overlay_pass_through(GtkOverlay* overlay, \
+GtkWidget* widget, gboolean pass_through)"
+ Xen_check_type(Xen_is_GtkOverlay_(overlay), overlay, 1, "gtk_overlay_set_overlay_pass_through", "GtkOverlay*");
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 2, "gtk_overlay_set_overlay_pass_through", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(pass_through), pass_through, 3, "gtk_overlay_set_overlay_pass_through", "gboolean");
+ gtk_overlay_set_overlay_pass_through(Xen_to_C_GtkOverlay_(overlay), Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(pass_through));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_modify_style(XEN widget, XEN style)
+static Xen gxg_gtk_places_sidebar_get_show_recent(Xen sidebar)
{
- #define H_gtk_widget_modify_style "void gtk_widget_modify_style(GtkWidget* widget, GtkRcStyle* style)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_modify_style", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkRcStyle__P(style), style, 2, "gtk_widget_modify_style", "GtkRcStyle*");
- gtk_widget_modify_style(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkRcStyle_(style));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_get_show_recent "gboolean gtk_places_sidebar_get_show_recent(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_show_recent", "GtkPlacesSidebar*");
+ return(C_to_Xen_gboolean(gtk_places_sidebar_get_show_recent(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_widget_get_modifier_style(XEN widget)
+static Xen gxg_gtk_places_sidebar_set_show_recent(Xen sidebar, Xen show_recent)
{
- #define H_gtk_widget_get_modifier_style "GtkRcStyle* gtk_widget_get_modifier_style(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_get_modifier_style", "GtkWidget*");
- return(C_TO_XEN_GtkRcStyle_(gtk_widget_get_modifier_style(XEN_TO_C_GtkWidget_(widget))));
+ #define H_gtk_places_sidebar_set_show_recent "void gtk_places_sidebar_set_show_recent(GtkPlacesSidebar* sidebar, \
+gboolean show_recent)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_show_recent", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_gboolean(show_recent), show_recent, 2, "gtk_places_sidebar_set_show_recent", "gboolean");
+ gtk_places_sidebar_set_show_recent(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_gboolean(show_recent));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_modify_fg(XEN widget, XEN state, XEN color)
+static Xen gxg_gtk_places_sidebar_set_drop_targets_visible(Xen sidebar, Xen visible, Xen context)
{
- #define H_gtk_widget_modify_fg "void gtk_widget_modify_fg(GtkWidget* widget, GtkStateType state, GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_modify_fg", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state), state, 2, "gtk_widget_modify_fg", "GtkStateType");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 3, "gtk_widget_modify_fg", "GdkColor*");
- gtk_widget_modify_fg(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkStateType(state), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_set_drop_targets_visible "void gtk_places_sidebar_set_drop_targets_visible(GtkPlacesSidebar* sidebar, \
+gboolean visible, GdkDragContext* context)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_drop_targets_visible", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_gboolean(visible), visible, 2, "gtk_places_sidebar_set_drop_targets_visible", "gboolean");
+ Xen_check_type(Xen_is_GdkDragContext_(context), context, 3, "gtk_places_sidebar_set_drop_targets_visible", "GdkDragContext*");
+ gtk_places_sidebar_set_drop_targets_visible(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_gboolean(visible), Xen_to_C_GdkDragContext_(context));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_modify_bg(XEN widget, XEN state, XEN color)
+static Xen gxg_gtk_places_sidebar_get_show_trash(Xen sidebar)
{
- #define H_gtk_widget_modify_bg "void gtk_widget_modify_bg(GtkWidget* widget, GtkStateType state, GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_modify_bg", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state), state, 2, "gtk_widget_modify_bg", "GtkStateType");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 3, "gtk_widget_modify_bg", "GdkColor*");
- gtk_widget_modify_bg(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkStateType(state), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_get_show_trash "gboolean gtk_places_sidebar_get_show_trash(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_show_trash", "GtkPlacesSidebar*");
+ return(C_to_Xen_gboolean(gtk_places_sidebar_get_show_trash(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_widget_modify_text(XEN widget, XEN state, XEN color)
+static Xen gxg_gtk_places_sidebar_set_show_trash(Xen sidebar, Xen show_trash)
{
- #define H_gtk_widget_modify_text "void gtk_widget_modify_text(GtkWidget* widget, GtkStateType state, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_modify_text", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state), state, 2, "gtk_widget_modify_text", "GtkStateType");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 3, "gtk_widget_modify_text", "GdkColor*");
- gtk_widget_modify_text(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkStateType(state), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_set_show_trash "void gtk_places_sidebar_set_show_trash(GtkPlacesSidebar* sidebar, \
+gboolean show_trash)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_show_trash", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_gboolean(show_trash), show_trash, 2, "gtk_places_sidebar_set_show_trash", "gboolean");
+ gtk_places_sidebar_set_show_trash(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_gboolean(show_trash));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_modify_base(XEN widget, XEN state, XEN color)
+static Xen gxg_gtk_places_sidebar_set_show_other_locations(Xen sidebar, Xen show_other_locations)
{
- #define H_gtk_widget_modify_base "void gtk_widget_modify_base(GtkWidget* widget, GtkStateType state, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_modify_base", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GtkStateType_P(state), state, 2, "gtk_widget_modify_base", "GtkStateType");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 3, "gtk_widget_modify_base", "GdkColor*");
- gtk_widget_modify_base(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GtkStateType(state), XEN_TO_C_GdkColor_(color));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_set_show_other_locations "void gtk_places_sidebar_set_show_other_locations(GtkPlacesSidebar* sidebar, \
+gboolean show_other_locations)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_set_show_other_locations", "GtkPlacesSidebar*");
+ Xen_check_type(Xen_is_gboolean(show_other_locations), show_other_locations, 2, "gtk_places_sidebar_set_show_other_locations", "gboolean");
+ gtk_places_sidebar_set_show_other_locations(Xen_to_C_GtkPlacesSidebar_(sidebar), Xen_to_C_gboolean(show_other_locations));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_modify_font(XEN widget, XEN font_desc)
+static Xen gxg_gtk_places_sidebar_get_show_other_locations(Xen sidebar)
{
- #define H_gtk_widget_modify_font "void gtk_widget_modify_font(GtkWidget* widget, PangoFontDescription* font_desc)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_modify_font", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_PangoFontDescription__P(font_desc), font_desc, 2, "gtk_widget_modify_font", "PangoFontDescription*");
- gtk_widget_modify_font(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_PangoFontDescription_(font_desc));
- return(XEN_FALSE);
+ #define H_gtk_places_sidebar_get_show_other_locations "gboolean gtk_places_sidebar_get_show_other_locations(GtkPlacesSidebar* sidebar)"
+ Xen_check_type(Xen_is_GtkPlacesSidebar_(sidebar), sidebar, 1, "gtk_places_sidebar_get_show_other_locations", "GtkPlacesSidebar*");
+ return(C_to_Xen_gboolean(gtk_places_sidebar_get_show_other_locations(Xen_to_C_GtkPlacesSidebar_(sidebar))));
}
-static XEN gxg_gtk_widget_render_icon(XEN widget, XEN stock_id, XEN size, XEN detail)
+static Xen gxg_gtk_stack_set_interpolate_size(Xen stack, Xen interpolate_size)
{
- #define H_gtk_widget_render_icon "GdkPixbuf* gtk_widget_render_icon(GtkWidget* widget, gchar* stock_id, \
-GtkIconSize size, gchar* detail)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_render_icon", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_gchar__P(stock_id), stock_id, 2, "gtk_widget_render_icon", "gchar*");
- XEN_ASSERT_TYPE(XEN_GtkIconSize_P(size), size, 3, "gtk_widget_render_icon", "GtkIconSize");
- XEN_ASSERT_TYPE(XEN_gchar__P(detail), detail, 4, "gtk_widget_render_icon", "gchar*");
- return(C_TO_XEN_GdkPixbuf_(gtk_widget_render_icon(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_gchar_(stock_id), XEN_TO_C_GtkIconSize(size),
- XEN_TO_C_gchar_(detail))));
+ #define H_gtk_stack_set_interpolate_size "void gtk_stack_set_interpolate_size(GtkStack* stack, gboolean interpolate_size)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_set_interpolate_size", "GtkStack*");
+ Xen_check_type(Xen_is_gboolean(interpolate_size), interpolate_size, 2, "gtk_stack_set_interpolate_size", "gboolean");
+ gtk_stack_set_interpolate_size(Xen_to_C_GtkStack_(stack), Xen_to_C_gboolean(interpolate_size));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_reset_rc_styles(XEN widget)
+static Xen gxg_gtk_stack_get_interpolate_size(Xen stack)
{
- #define H_gtk_widget_reset_rc_styles "void gtk_widget_reset_rc_styles(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_reset_rc_styles", "GtkWidget*");
- gtk_widget_reset_rc_styles(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_stack_get_interpolate_size "gboolean gtk_stack_get_interpolate_size(GtkStack* stack)"
+ Xen_check_type(Xen_is_GtkStack_(stack), stack, 1, "gtk_stack_get_interpolate_size", "GtkStack*");
+ return(C_to_Xen_gboolean(gtk_stack_get_interpolate_size(Xen_to_C_GtkStack_(stack))));
}
-static XEN gxg_gtk_widget_push_colormap(XEN cmap)
+static Xen gxg_gtk_widget_set_font_options(Xen widget, Xen options)
{
- #define H_gtk_widget_push_colormap "void gtk_widget_push_colormap(GdkColormap* cmap)"
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(cmap), cmap, 1, "gtk_widget_push_colormap", "GdkColormap*");
- gtk_widget_push_colormap(XEN_TO_C_GdkColormap_(cmap));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_font_options "void gtk_widget_set_font_options(GtkWidget* widget, cairo_font_options_t* options)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_font_options", "GtkWidget*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 2, "gtk_widget_set_font_options", "cairo_font_options_t*");
+ gtk_widget_set_font_options(Xen_to_C_GtkWidget_(widget), Xen_to_C_cairo_font_options_t_(options));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_pop_colormap(void)
+static Xen gxg_gtk_widget_get_font_options(Xen widget)
{
- #define H_gtk_widget_pop_colormap "void gtk_widget_pop_colormap( void)"
- gtk_widget_pop_colormap();
- return(XEN_FALSE);
+ #define H_gtk_widget_get_font_options "cairo_font_options_t* gtk_widget_get_font_options(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_font_options", "GtkWidget*");
+ return(C_to_Xen_cairo_font_options_t_((cairo_font_options_t*)gtk_widget_get_font_options(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_widget_set_default_colormap(XEN colormap)
+static Xen gxg_gtk_widget_set_font_map(Xen widget, Xen fontmap)
{
- #define H_gtk_widget_set_default_colormap "void gtk_widget_set_default_colormap(GdkColormap* colormap)"
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 1, "gtk_widget_set_default_colormap", "GdkColormap*");
- gtk_widget_set_default_colormap(XEN_TO_C_GdkColormap_(colormap));
- return(XEN_FALSE);
+ #define H_gtk_widget_set_font_map "void gtk_widget_set_font_map(GtkWidget* widget, PangoFontMap* fontmap)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_font_map", "GtkWidget*");
+ Xen_check_type(Xen_is_PangoFontMap_(fontmap), fontmap, 2, "gtk_widget_set_font_map", "PangoFontMap*");
+ gtk_widget_set_font_map(Xen_to_C_GtkWidget_(widget), Xen_to_C_PangoFontMap_(fontmap));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_default_style(void)
+static Xen gxg_gtk_widget_get_font_map(Xen widget)
{
- #define H_gtk_widget_get_default_style "GtkStyle* gtk_widget_get_default_style( void)"
- return(C_TO_XEN_GtkStyle_(gtk_widget_get_default_style()));
+ #define H_gtk_widget_get_font_map "PangoFontMap* gtk_widget_get_font_map(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_font_map", "GtkWidget*");
+ return(C_to_Xen_PangoFontMap_(gtk_widget_get_font_map(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_widget_get_default_colormap(void)
+static Xen gxg_gdk_window_fullscreen_on_monitor(Xen window, Xen monitor)
{
- #define H_gtk_widget_get_default_colormap "GdkColormap* gtk_widget_get_default_colormap( void)"
- return(C_TO_XEN_GdkColormap_(gtk_widget_get_default_colormap()));
+ #define H_gdk_window_fullscreen_on_monitor "void gdk_window_fullscreen_on_monitor(GdkWindow* window, \
+gint monitor)"
+ Xen_check_type(Xen_is_GdkWindow_(window), window, 1, "gdk_window_fullscreen_on_monitor", "GdkWindow*");
+ Xen_check_type(Xen_is_gint(monitor), monitor, 2, "gdk_window_fullscreen_on_monitor", "gint");
+ gdk_window_fullscreen_on_monitor(Xen_to_C_GdkWindow_(window), Xen_to_C_gint(monitor));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_get_default_visual(void)
+static Xen gxg_gtk_window_fullscreen_on_monitor(Xen window, Xen screen, Xen monitor)
{
- #define H_gtk_widget_get_default_visual "GdkVisual* gtk_widget_get_default_visual( void)"
- return(C_TO_XEN_GdkVisual_(gtk_widget_get_default_visual()));
+ #define H_gtk_window_fullscreen_on_monitor "void gtk_window_fullscreen_on_monitor(GtkWindow* window, \
+GdkScreen* screen, gint monitor)"
+ Xen_check_type(Xen_is_GtkWindow_(window), window, 1, "gtk_window_fullscreen_on_monitor", "GtkWindow*");
+ Xen_check_type(Xen_is_GdkScreen_(screen), screen, 2, "gtk_window_fullscreen_on_monitor", "GdkScreen*");
+ Xen_check_type(Xen_is_gint(monitor), monitor, 3, "gtk_window_fullscreen_on_monitor", "gint");
+ gtk_window_fullscreen_on_monitor(Xen_to_C_GtkWindow_(window), Xen_to_C_GdkScreen_(screen), Xen_to_C_gint(monitor));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_shape_combine_mask(XEN widget, XEN shape_mask, XEN offset_x, XEN offset_y)
+static Xen gxg_gtk_text_view_set_top_margin(Xen text_view, Xen top_margin)
{
- #define H_gtk_widget_shape_combine_mask "void gtk_widget_shape_combine_mask(GtkWidget* widget, GdkBitmap* shape_mask, \
-gint offset_x, gint offset_y)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_shape_combine_mask", "GtkWidget*");
- XEN_ASSERT_TYPE(XEN_GdkBitmap__P(shape_mask) || XEN_FALSE_P(shape_mask), shape_mask, 2, "gtk_widget_shape_combine_mask", "GdkBitmap*");
- XEN_ASSERT_TYPE(XEN_gint_P(offset_x), offset_x, 3, "gtk_widget_shape_combine_mask", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(offset_y), offset_y, 4, "gtk_widget_shape_combine_mask", "gint");
- gtk_widget_shape_combine_mask(XEN_TO_C_GtkWidget_(widget), XEN_TO_C_GdkBitmap_(shape_mask), XEN_TO_C_gint(offset_x), XEN_TO_C_gint(offset_y));
- return(XEN_FALSE);
+ #define H_gtk_text_view_set_top_margin "void gtk_text_view_set_top_margin(GtkTextView* text_view, gint top_margin)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_top_margin", "GtkTextView*");
+ Xen_check_type(Xen_is_gint(top_margin), top_margin, 2, "gtk_text_view_set_top_margin", "gint");
+ gtk_text_view_set_top_margin(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gint(top_margin));
+ return(Xen_false);
}
-static XEN gxg_gtk_widget_reset_shapes(XEN widget)
+static Xen gxg_gtk_text_view_get_top_margin(Xen text_view)
{
- #define H_gtk_widget_reset_shapes "void gtk_widget_reset_shapes(GtkWidget* widget)"
- XEN_ASSERT_TYPE(XEN_GtkWidget__P(widget), widget, 1, "gtk_widget_reset_shapes", "GtkWidget*");
- gtk_widget_reset_shapes(XEN_TO_C_GtkWidget_(widget));
- return(XEN_FALSE);
+ #define H_gtk_text_view_get_top_margin "gint gtk_text_view_get_top_margin(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_top_margin", "GtkTextView*");
+ return(C_to_Xen_gint(gtk_text_view_get_top_margin(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_requisition_copy(XEN requisition)
+static Xen gxg_gtk_text_view_set_bottom_margin(Xen text_view, Xen bottom_margin)
{
- #define H_gtk_requisition_copy "GtkRequisition* gtk_requisition_copy(GtkRequisition* requisition)"
- XEN_ASSERT_TYPE(XEN_GtkRequisition__P(requisition), requisition, 1, "gtk_requisition_copy", "GtkRequisition*");
- return(C_TO_XEN_GtkRequisition_(gtk_requisition_copy(XEN_TO_C_GtkRequisition_(requisition))));
+ #define H_gtk_text_view_set_bottom_margin "void gtk_text_view_set_bottom_margin(GtkTextView* text_view, \
+gint bottom_margin)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_set_bottom_margin", "GtkTextView*");
+ Xen_check_type(Xen_is_gint(bottom_margin), bottom_margin, 2, "gtk_text_view_set_bottom_margin", "gint");
+ gtk_text_view_set_bottom_margin(Xen_to_C_GtkTextView_(text_view), Xen_to_C_gint(bottom_margin));
+ return(Xen_false);
}
-static XEN gxg_gtk_requisition_free(XEN requisition)
+static Xen gxg_gtk_text_view_get_bottom_margin(Xen text_view)
{
- #define H_gtk_requisition_free "void gtk_requisition_free(GtkRequisition* requisition)"
- XEN_ASSERT_TYPE(XEN_GtkRequisition__P(requisition), requisition, 1, "gtk_requisition_free", "GtkRequisition*");
- gtk_requisition_free(XEN_TO_C_GtkRequisition_(requisition));
- return(XEN_FALSE);
+ #define H_gtk_text_view_get_bottom_margin "gint gtk_text_view_get_bottom_margin(GtkTextView* text_view)"
+ Xen_check_type(Xen_is_GtkTextView_(text_view), text_view, 1, "gtk_text_view_get_bottom_margin", "GtkTextView*");
+ return(C_to_Xen_gint(gtk_text_view_get_bottom_margin(Xen_to_C_GtkTextView_(text_view))));
}
-static XEN gxg_gtk_window_set_has_frame(XEN window, XEN setting)
+#endif
+
+#if GTK_CHECK_VERSION(3, 20, 0)
+static Xen gxg_gdk_gl_context_is_legacy(Xen context)
{
- #define H_gtk_window_set_has_frame "void gtk_window_set_has_frame(GtkWindow* window, gboolean setting)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_has_frame", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gboolean_P(setting), setting, 2, "gtk_window_set_has_frame", "gboolean");
- gtk_window_set_has_frame(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gboolean(setting));
- return(XEN_FALSE);
+ #define H_gdk_gl_context_is_legacy "gboolean gdk_gl_context_is_legacy(GdkGLContext* context)"
+ Xen_check_type(Xen_is_GdkGLContext_(context), context, 1, "gdk_gl_context_is_legacy", "GdkGLContext*");
+ return(C_to_Xen_gboolean(gdk_gl_context_is_legacy(Xen_to_C_GdkGLContext_(context))));
}
-static XEN gxg_gtk_window_get_has_frame(XEN window)
+static Xen gxg_gdk_rectangle_equal(Xen rect1)
{
- #define H_gtk_window_get_has_frame "gboolean gtk_window_get_has_frame(GtkWindow* window)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_has_frame", "GtkWindow*");
- return(C_TO_XEN_gboolean(gtk_window_get_has_frame(XEN_TO_C_GtkWindow_(window))));
+ #define H_gdk_rectangle_equal "gboolean gdk_rectangle_equal(GdkRectangle* rect1, GdkRectangle*rect2)"
+ Xen_check_type(Xen_is_GdkRectangle_(rect1), rect1, 1, "gdk_rectangle_equal", "GdkRectangle*");
+ return(C_to_Xen_gboolean(gdk_rectangle_equal(Xen_to_C_GdkRectangle_(rect1))));
}
-static XEN gxg_gtk_window_set_frame_dimensions(XEN window, XEN left, XEN top, XEN right, XEN bottom)
+static Xen gxg_gtk_application_window_set_help_overlay(Xen window, Xen help_overlay)
{
- #define H_gtk_window_set_frame_dimensions "void gtk_window_set_frame_dimensions(GtkWindow* window, \
-gint left, gint top, gint right, gint bottom)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_set_frame_dimensions", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_gint_P(left), left, 2, "gtk_window_set_frame_dimensions", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(top), top, 3, "gtk_window_set_frame_dimensions", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(right), right, 4, "gtk_window_set_frame_dimensions", "gint");
- XEN_ASSERT_TYPE(XEN_gint_P(bottom), bottom, 5, "gtk_window_set_frame_dimensions", "gint");
- gtk_window_set_frame_dimensions(XEN_TO_C_GtkWindow_(window), XEN_TO_C_gint(left), XEN_TO_C_gint(top), XEN_TO_C_gint(right),
- XEN_TO_C_gint(bottom));
- return(XEN_FALSE);
+ #define H_gtk_application_window_set_help_overlay "void gtk_application_window_set_help_overlay(GtkApplicationWindow* window, \
+GtkShortcutsWindow* help_overlay)"
+ Xen_check_type(Xen_is_GtkApplicationWindow_(window), window, 1, "gtk_application_window_set_help_overlay", "GtkApplicationWindow*");
+ Xen_check_type(Xen_is_GtkShortcutsWindow_(help_overlay), help_overlay, 2, "gtk_application_window_set_help_overlay", "GtkShortcutsWindow*");
+ gtk_application_window_set_help_overlay(Xen_to_C_GtkApplicationWindow_(window), Xen_to_C_GtkShortcutsWindow_(help_overlay));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_get_frame_dimensions(XEN window, XEN ignore_left, XEN ignore_top, XEN ignore_right, XEN ignore_bottom)
+static Xen gxg_gtk_settings_reset_property(Xen settings, Xen name)
{
- #define H_gtk_window_get_frame_dimensions "void gtk_window_get_frame_dimensions(GtkWindow* window, \
-gint* [left], gint* [top], gint* [right], gint* [bottom])"
- gint ref_left;
- gint ref_top;
- gint ref_right;
- gint ref_bottom;
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_get_frame_dimensions", "GtkWindow*");
- gtk_window_get_frame_dimensions(XEN_TO_C_GtkWindow_(window), &ref_left, &ref_top, &ref_right, &ref_bottom);
- return(XEN_LIST_4(C_TO_XEN_gint(ref_left), C_TO_XEN_gint(ref_top), C_TO_XEN_gint(ref_right), C_TO_XEN_gint(ref_bottom)));
+ #define H_gtk_settings_reset_property "void gtk_settings_reset_property(GtkSettings* settings, gchar* name)"
+ Xen_check_type(Xen_is_GtkSettings_(settings), settings, 1, "gtk_settings_reset_property", "GtkSettings*");
+ Xen_check_type(Xen_is_gchar_(name), name, 2, "gtk_settings_reset_property", "gchar*");
+ gtk_settings_reset_property(Xen_to_C_GtkSettings_(settings), (const gchar*)Xen_to_C_gchar_(name));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_remove_embedded_xid(XEN window, XEN xid)
+static Xen gxg_gtk_text_tag_changed(Xen tag, Xen size_changed)
{
- #define H_gtk_window_remove_embedded_xid "void gtk_window_remove_embedded_xid(GtkWindow* window, guint xid)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_remove_embedded_xid", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_guint_P(xid), xid, 2, "gtk_window_remove_embedded_xid", "guint");
- gtk_window_remove_embedded_xid(XEN_TO_C_GtkWindow_(window), XEN_TO_C_guint(xid));
- return(XEN_FALSE);
+ #define H_gtk_text_tag_changed "void gtk_text_tag_changed(GtkTextTag* tag, gboolean size_changed)"
+ Xen_check_type(Xen_is_GtkTextTag_(tag), tag, 1, "gtk_text_tag_changed", "GtkTextTag*");
+ Xen_check_type(Xen_is_gboolean(size_changed), size_changed, 2, "gtk_text_tag_changed", "gboolean");
+ gtk_text_tag_changed(Xen_to_C_GtkTextTag_(tag), Xen_to_C_gboolean(size_changed));
+ return(Xen_false);
}
-static XEN gxg_gtk_window_add_embedded_xid(XEN window, XEN xid)
+static Xen gxg_gtk_widget_path_iter_get_object_name(Xen path, Xen pos)
{
- #define H_gtk_window_add_embedded_xid "void gtk_window_add_embedded_xid(GtkWindow* window, guint xid)"
- XEN_ASSERT_TYPE(XEN_GtkWindow__P(window), window, 1, "gtk_window_add_embedded_xid", "GtkWindow*");
- XEN_ASSERT_TYPE(XEN_guint_P(xid), xid, 2, "gtk_window_add_embedded_xid", "guint");
- gtk_window_add_embedded_xid(XEN_TO_C_GtkWindow_(window), XEN_TO_C_guint(xid));
- return(XEN_FALSE);
+ #define H_gtk_widget_path_iter_get_object_name "char* gtk_widget_path_iter_get_object_name(GtkWidgetPath* path, \
+gint pos)"
+ Xen_check_type(Xen_is_GtkWidgetPath_(path), path, 1, "gtk_widget_path_iter_get_object_name", "GtkWidgetPath*");
+ Xen_check_type(Xen_is_gint(pos), pos, 2, "gtk_widget_path_iter_get_object_name", "gint");
+ return(C_to_Xen_char_((char*)gtk_widget_path_iter_get_object_name(Xen_to_C_GtkWidgetPath_(path), Xen_to_C_gint(pos))));
}
-static XEN gxg_gdk_screen_get_default_colormap(XEN screen)
+static Xen gxg_gtk_widget_path_iter_set_object_name(Xen path, Xen pos, Xen name)
{
- #define H_gdk_screen_get_default_colormap "GdkColormap* gdk_screen_get_default_colormap(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_default_colormap", "GdkScreen*");
- return(C_TO_XEN_GdkColormap_(gdk_screen_get_default_colormap(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_widget_path_iter_set_object_name "void gtk_widget_path_iter_set_object_name(GtkWidgetPath* path, \
+gint pos, char* name)"
+ Xen_check_type(Xen_is_GtkWidgetPath_(path), path, 1, "gtk_widget_path_iter_set_object_name", "GtkWidgetPath*");
+ Xen_check_type(Xen_is_gint(pos), pos, 2, "gtk_widget_path_iter_set_object_name", "gint");
+ Xen_check_type(Xen_is_char_(name), name, 3, "gtk_widget_path_iter_set_object_name", "char*");
+ gtk_widget_path_iter_set_object_name(Xen_to_C_GtkWidgetPath_(path), Xen_to_C_gint(pos), (const char*)Xen_to_C_char_(name));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_set_default_colormap(XEN screen, XEN colormap)
+static Xen gxg_gtk_widget_queue_allocate(Xen widget)
{
- #define H_gdk_screen_set_default_colormap "void gdk_screen_set_default_colormap(GdkScreen* screen, \
-GdkColormap* colormap)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_set_default_colormap", "GdkScreen*");
- XEN_ASSERT_TYPE(XEN_GdkColormap__P(colormap), colormap, 2, "gdk_screen_set_default_colormap", "GdkColormap*");
- gdk_screen_set_default_colormap(XEN_TO_C_GdkScreen_(screen), XEN_TO_C_GdkColormap_(colormap));
- return(XEN_FALSE);
+ #define H_gtk_widget_queue_allocate "void gtk_widget_queue_allocate(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_queue_allocate", "GtkWidget*");
+ gtk_widget_queue_allocate(Xen_to_C_GtkWidget_(widget));
+ return(Xen_false);
}
-static XEN gxg_gdk_screen_get_system_colormap(XEN screen)
+static Xen gxg_gtk_widget_set_focus_on_click(Xen widget, Xen focus_on_click)
{
- #define H_gdk_screen_get_system_colormap "GdkColormap* gdk_screen_get_system_colormap(GdkScreen* screen)"
- XEN_ASSERT_TYPE(XEN_GdkScreen__P(screen), screen, 1, "gdk_screen_get_system_colormap", "GdkScreen*");
- return(C_TO_XEN_GdkColormap_(gdk_screen_get_system_colormap(XEN_TO_C_GdkScreen_(screen))));
+ #define H_gtk_widget_set_focus_on_click "void gtk_widget_set_focus_on_click(GtkWidget* widget, gboolean focus_on_click)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_focus_on_click", "GtkWidget*");
+ Xen_check_type(Xen_is_gboolean(focus_on_click), focus_on_click, 2, "gtk_widget_set_focus_on_click", "gboolean");
+ gtk_widget_set_focus_on_click(Xen_to_C_GtkWidget_(widget), Xen_to_C_gboolean(focus_on_click));
+ return(Xen_false);
}
-static XEN gxg_gtk_cell_view_get_size_of_row(XEN cell_view, XEN path, XEN requisition)
+static Xen gxg_gtk_widget_get_focus_on_click(Xen widget)
{
- #define H_gtk_cell_view_get_size_of_row "gboolean gtk_cell_view_get_size_of_row(GtkCellView* cell_view, \
-GtkTreePath* path, GtkRequisition* requisition)"
- XEN_ASSERT_TYPE(XEN_GtkCellView__P(cell_view), cell_view, 1, "gtk_cell_view_get_size_of_row", "GtkCellView*");
- XEN_ASSERT_TYPE(XEN_GtkTreePath__P(path), path, 2, "gtk_cell_view_get_size_of_row", "GtkTreePath*");
- XEN_ASSERT_TYPE(XEN_GtkRequisition__P(requisition), requisition, 3, "gtk_cell_view_get_size_of_row", "GtkRequisition*");
- return(C_TO_XEN_gboolean(gtk_cell_view_get_size_of_row(XEN_TO_C_GtkCellView_(cell_view), XEN_TO_C_GtkTreePath_(path), XEN_TO_C_GtkRequisition_(requisition))));
+ #define H_gtk_widget_get_focus_on_click "gboolean gtk_widget_get_focus_on_click(GtkWidget* widget)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_focus_on_click", "GtkWidget*");
+ return(C_to_Xen_gboolean(gtk_widget_get_focus_on_click(Xen_to_C_GtkWidget_(widget))));
}
-static XEN gxg_gtk_style_lookup_color(XEN style, XEN color_name, XEN color)
+static Xen gxg_gtk_widget_get_allocated_size(Xen widget, Xen ignore_allocation, Xen ignore_baseline)
{
- #define H_gtk_style_lookup_color "gboolean gtk_style_lookup_color(GtkStyle* style, gchar* color_name, \
-GdkColor* color)"
- XEN_ASSERT_TYPE(XEN_GtkStyle__P(style), style, 1, "gtk_style_lookup_color", "GtkStyle*");
- XEN_ASSERT_TYPE(XEN_gchar__P(color_name), color_name, 2, "gtk_style_lookup_color", "gchar*");
- XEN_ASSERT_TYPE(XEN_GdkColor__P(color), color, 3, "gtk_style_lookup_color", "GdkColor*");
- return(C_TO_XEN_gboolean(gtk_style_lookup_color(XEN_TO_C_GtkStyle_(style), XEN_TO_C_gchar_(color_name), XEN_TO_C_GdkColor_(color))));
+ #define H_gtk_widget_get_allocated_size "void gtk_widget_get_allocated_size(GtkWidget* widget, GtkAllocation* [allocation], \
+int* [baseline])"
+ GtkAllocation ref_allocation;
+ int ref_baseline;
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_get_allocated_size", "GtkWidget*");
+ gtk_widget_get_allocated_size(Xen_to_C_GtkWidget_(widget), &ref_allocation, &ref_baseline);
+ return(Xen_list_2(C_to_Xen_GtkAllocation(ref_allocation), C_to_Xen_int(ref_baseline)));
}
#endif
-static XEN gxg_cairo_create(XEN target)
+static Xen gxg_cairo_create(Xen target)
{
#define H_cairo_create "cairo_t* cairo_create(cairo_surface_t* target)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(target), target, 1, "cairo_create", "cairo_surface_t*");
- return(C_TO_XEN_cairo_t_(cairo_create(XEN_TO_C_cairo_surface_t_(target))));
+ Xen_check_type(Xen_is_cairo_surface_t_(target), target, 1, "cairo_create", "cairo_surface_t*");
+ return(C_to_Xen_cairo_t_(cairo_create(Xen_to_C_cairo_surface_t_(target))));
}
-static XEN gxg_cairo_version(void)
+static Xen gxg_cairo_version(void)
{
#define H_cairo_version "int cairo_version( void)"
- return(C_TO_XEN_int(cairo_version()));
+ return(C_to_Xen_int(cairo_version()));
}
-static XEN gxg_cairo_version_string(void)
+static Xen gxg_cairo_version_string(void)
{
#define H_cairo_version_string "char* cairo_version_string( void)"
- return(C_TO_XEN_char_(cairo_version_string()));
+ return(C_to_Xen_char_(cairo_version_string()));
}
-static XEN gxg_cairo_reference(XEN cr)
+static Xen gxg_cairo_reference(Xen cr)
{
#define H_cairo_reference "cairo_t* cairo_reference(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_reference", "cairo_t*");
- return(C_TO_XEN_cairo_t_(cairo_reference(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_reference", "cairo_t*");
+ return(C_to_Xen_cairo_t_(cairo_reference(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_destroy(XEN cr)
+static Xen gxg_cairo_destroy(Xen cr)
{
#define H_cairo_destroy "void cairo_destroy(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_destroy", "cairo_t*");
- cairo_destroy(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_destroy", "cairo_t*");
+ cairo_destroy(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_save(XEN cr)
+static Xen gxg_cairo_save(Xen cr)
{
#define H_cairo_save "void cairo_save(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_save", "cairo_t*");
- cairo_save(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_save", "cairo_t*");
+ cairo_save(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_restore(XEN cr)
+static Xen gxg_cairo_restore(Xen cr)
{
#define H_cairo_restore "void cairo_restore(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_restore", "cairo_t*");
- cairo_restore(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_restore", "cairo_t*");
+ cairo_restore(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_push_group(XEN cr)
+static Xen gxg_cairo_push_group(Xen cr)
{
#define H_cairo_push_group "void cairo_push_group(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_push_group", "cairo_t*");
- cairo_push_group(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_push_group", "cairo_t*");
+ cairo_push_group(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_push_group_with_content(XEN cr, XEN content)
+static Xen gxg_cairo_push_group_with_content(Xen cr, Xen content)
{
#define H_cairo_push_group_with_content "void cairo_push_group_with_content(cairo_t* cr, cairo_content_t content)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_push_group_with_content", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_content_t_P(content), content, 2, "cairo_push_group_with_content", "cairo_content_t");
- cairo_push_group_with_content(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_content_t(content));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_push_group_with_content", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_content_t(content), content, 2, "cairo_push_group_with_content", "cairo_content_t");
+ cairo_push_group_with_content(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_content_t(content));
+ return(Xen_false);
}
-static XEN gxg_cairo_pop_group(XEN cr)
+static Xen gxg_cairo_pop_group(Xen cr)
{
#define H_cairo_pop_group "cairo_pattern_t* cairo_pop_group(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_pop_group", "cairo_t*");
- return(C_TO_XEN_cairo_pattern_t_(cairo_pop_group(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_pop_group", "cairo_t*");
+ return(C_to_Xen_cairo_pattern_t_(cairo_pop_group(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_pop_group_to_source(XEN cr)
+static Xen gxg_cairo_pop_group_to_source(Xen cr)
{
#define H_cairo_pop_group_to_source "void cairo_pop_group_to_source(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_pop_group_to_source", "cairo_t*");
- cairo_pop_group_to_source(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_pop_group_to_source", "cairo_t*");
+ cairo_pop_group_to_source(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_operator(XEN cr, XEN op)
+static Xen gxg_cairo_set_operator(Xen cr, Xen op)
{
#define H_cairo_set_operator "void cairo_set_operator(cairo_t* cr, cairo_operator_t op)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_operator", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_operator_t_P(op), op, 2, "cairo_set_operator", "cairo_operator_t");
- cairo_set_operator(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_operator_t(op));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_operator", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_operator_t(op), op, 2, "cairo_set_operator", "cairo_operator_t");
+ cairo_set_operator(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_operator_t(op));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_source(XEN cr, XEN source)
+static Xen gxg_cairo_set_source(Xen cr, Xen source)
{
#define H_cairo_set_source "void cairo_set_source(cairo_t* cr, cairo_pattern_t* source)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_source", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(source), source, 2, "cairo_set_source", "cairo_pattern_t*");
- cairo_set_source(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_pattern_t_(source));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_source", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_pattern_t_(source), source, 2, "cairo_set_source", "cairo_pattern_t*");
+ cairo_set_source(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_pattern_t_(source));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_source_rgb(XEN cr, XEN red, XEN green, XEN blue)
+static Xen gxg_cairo_set_source_rgb(Xen cr, Xen red, Xen green, Xen blue)
{
#define H_cairo_set_source_rgb "void cairo_set_source_rgb(cairo_t* cr, double red, double green, double blue)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_source_rgb", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(red), red, 2, "cairo_set_source_rgb", "double");
- XEN_ASSERT_TYPE(XEN_double_P(green), green, 3, "cairo_set_source_rgb", "double");
- XEN_ASSERT_TYPE(XEN_double_P(blue), blue, 4, "cairo_set_source_rgb", "double");
- cairo_set_source_rgb(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(red), XEN_TO_C_double(green), XEN_TO_C_double(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_source_rgb", "cairo_t*");
+ Xen_check_type(Xen_is_double(red), red, 2, "cairo_set_source_rgb", "double");
+ Xen_check_type(Xen_is_double(green), green, 3, "cairo_set_source_rgb", "double");
+ Xen_check_type(Xen_is_double(blue), blue, 4, "cairo_set_source_rgb", "double");
+ cairo_set_source_rgb(Xen_to_C_cairo_t_(cr), Xen_to_C_double(red), Xen_to_C_double(green), Xen_to_C_double(blue));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_source_rgba(XEN cr, XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_cairo_set_source_rgba(Xen cr, Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_cairo_set_source_rgba "void cairo_set_source_rgba(cairo_t* cr, double red, double green, \
double blue, double alpha)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_source_rgba", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(red), red, 2, "cairo_set_source_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(green), green, 3, "cairo_set_source_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(blue), blue, 4, "cairo_set_source_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(alpha), alpha, 5, "cairo_set_source_rgba", "double");
- cairo_set_source_rgba(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(red), XEN_TO_C_double(green), XEN_TO_C_double(blue), XEN_TO_C_double(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_source_rgba", "cairo_t*");
+ Xen_check_type(Xen_is_double(red), red, 2, "cairo_set_source_rgba", "double");
+ Xen_check_type(Xen_is_double(green), green, 3, "cairo_set_source_rgba", "double");
+ Xen_check_type(Xen_is_double(blue), blue, 4, "cairo_set_source_rgba", "double");
+ Xen_check_type(Xen_is_double(alpha), alpha, 5, "cairo_set_source_rgba", "double");
+ cairo_set_source_rgba(Xen_to_C_cairo_t_(cr), Xen_to_C_double(red), Xen_to_C_double(green), Xen_to_C_double(blue), Xen_to_C_double(alpha));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_source_surface(XEN cr, XEN surface, XEN x, XEN y)
+static Xen gxg_cairo_set_source_surface(Xen cr, Xen surface, Xen x, Xen y)
{
#define H_cairo_set_source_surface "void cairo_set_source_surface(cairo_t* cr, cairo_surface_t* surface, \
double x, double y)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_source_surface", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 2, "cairo_set_source_surface", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 3, "cairo_set_source_surface", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 4, "cairo_set_source_surface", "double");
- cairo_set_source_surface(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_double(x), XEN_TO_C_double(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_source_surface", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 2, "cairo_set_source_surface", "cairo_surface_t*");
+ Xen_check_type(Xen_is_double(x), x, 3, "cairo_set_source_surface", "double");
+ Xen_check_type(Xen_is_double(y), y, 4, "cairo_set_source_surface", "double");
+ cairo_set_source_surface(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_surface_t_(surface), Xen_to_C_double(x), Xen_to_C_double(y));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_tolerance(XEN cr, XEN tolerance)
+static Xen gxg_cairo_set_tolerance(Xen cr, Xen tolerance)
{
#define H_cairo_set_tolerance "void cairo_set_tolerance(cairo_t* cr, double tolerance)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_tolerance", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(tolerance), tolerance, 2, "cairo_set_tolerance", "double");
- cairo_set_tolerance(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(tolerance));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_tolerance", "cairo_t*");
+ Xen_check_type(Xen_is_double(tolerance), tolerance, 2, "cairo_set_tolerance", "double");
+ cairo_set_tolerance(Xen_to_C_cairo_t_(cr), Xen_to_C_double(tolerance));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_antialias(XEN cr, XEN antialias)
+static Xen gxg_cairo_set_antialias(Xen cr, Xen antialias)
{
#define H_cairo_set_antialias "void cairo_set_antialias(cairo_t* cr, cairo_antialias_t antialias)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_antialias", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_antialias_t_P(antialias), antialias, 2, "cairo_set_antialias", "cairo_antialias_t");
- cairo_set_antialias(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_antialias_t(antialias));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_antialias", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_antialias_t(antialias), antialias, 2, "cairo_set_antialias", "cairo_antialias_t");
+ cairo_set_antialias(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_antialias_t(antialias));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_fill_rule(XEN cr, XEN fill_rule)
+static Xen gxg_cairo_set_fill_rule(Xen cr, Xen fill_rule)
{
#define H_cairo_set_fill_rule "void cairo_set_fill_rule(cairo_t* cr, cairo_fill_rule_t fill_rule)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_fill_rule", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_fill_rule_t_P(fill_rule), fill_rule, 2, "cairo_set_fill_rule", "cairo_fill_rule_t");
- cairo_set_fill_rule(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_fill_rule_t(fill_rule));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_fill_rule", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_fill_rule_t(fill_rule), fill_rule, 2, "cairo_set_fill_rule", "cairo_fill_rule_t");
+ cairo_set_fill_rule(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_fill_rule_t(fill_rule));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_line_width(XEN cr, XEN width)
+static Xen gxg_cairo_set_line_width(Xen cr, Xen width)
{
#define H_cairo_set_line_width "void cairo_set_line_width(cairo_t* cr, double width)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_line_width", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(width), width, 2, "cairo_set_line_width", "double");
- cairo_set_line_width(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(width));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_line_width", "cairo_t*");
+ Xen_check_type(Xen_is_double(width), width, 2, "cairo_set_line_width", "double");
+ cairo_set_line_width(Xen_to_C_cairo_t_(cr), Xen_to_C_double(width));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_line_cap(XEN cr, XEN line_cap)
+static Xen gxg_cairo_set_line_cap(Xen cr, Xen line_cap)
{
#define H_cairo_set_line_cap "void cairo_set_line_cap(cairo_t* cr, cairo_line_cap_t line_cap)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_line_cap", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_line_cap_t_P(line_cap), line_cap, 2, "cairo_set_line_cap", "cairo_line_cap_t");
- cairo_set_line_cap(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_line_cap_t(line_cap));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_line_cap", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_line_cap_t(line_cap), line_cap, 2, "cairo_set_line_cap", "cairo_line_cap_t");
+ cairo_set_line_cap(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_line_cap_t(line_cap));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_line_join(XEN cr, XEN line_join)
+static Xen gxg_cairo_set_line_join(Xen cr, Xen line_join)
{
#define H_cairo_set_line_join "void cairo_set_line_join(cairo_t* cr, cairo_line_join_t line_join)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_line_join", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_line_join_t_P(line_join), line_join, 2, "cairo_set_line_join", "cairo_line_join_t");
- cairo_set_line_join(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_line_join_t(line_join));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_line_join", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_line_join_t(line_join), line_join, 2, "cairo_set_line_join", "cairo_line_join_t");
+ cairo_set_line_join(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_line_join_t(line_join));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_dash(XEN cr, XEN dashes, XEN num_dashes, XEN offset)
+static Xen gxg_cairo_set_dash(Xen cr, Xen dashes, Xen num_dashes, Xen offset)
{
#define H_cairo_set_dash "void cairo_set_dash(cairo_t* cr, gdouble* dashes, int num_dashes, double offset)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_dash", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_gdouble__P(dashes), dashes, 2, "cairo_set_dash", "gdouble*");
- XEN_ASSERT_TYPE(XEN_int_P(num_dashes), num_dashes, 3, "cairo_set_dash", "int");
- XEN_ASSERT_TYPE(XEN_double_P(offset), offset, 4, "cairo_set_dash", "double");
- cairo_set_dash(XEN_TO_C_cairo_t_(cr), XEN_TO_C_gdouble_(dashes), XEN_TO_C_int(num_dashes), XEN_TO_C_double(offset));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_dash", "cairo_t*");
+ Xen_check_type(Xen_is_gdouble_(dashes), dashes, 2, "cairo_set_dash", "gdouble*");
+ Xen_check_type(Xen_is_int(num_dashes), num_dashes, 3, "cairo_set_dash", "int");
+ Xen_check_type(Xen_is_double(offset), offset, 4, "cairo_set_dash", "double");
+ cairo_set_dash(Xen_to_C_cairo_t_(cr), Xen_to_C_gdouble_(dashes), Xen_to_C_int(num_dashes), Xen_to_C_double(offset));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_miter_limit(XEN cr, XEN limit)
+static Xen gxg_cairo_set_miter_limit(Xen cr, Xen limit)
{
#define H_cairo_set_miter_limit "void cairo_set_miter_limit(cairo_t* cr, double limit)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_miter_limit", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(limit), limit, 2, "cairo_set_miter_limit", "double");
- cairo_set_miter_limit(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(limit));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_miter_limit", "cairo_t*");
+ Xen_check_type(Xen_is_double(limit), limit, 2, "cairo_set_miter_limit", "double");
+ cairo_set_miter_limit(Xen_to_C_cairo_t_(cr), Xen_to_C_double(limit));
+ return(Xen_false);
}
-static XEN gxg_cairo_translate(XEN cr, XEN tx, XEN ty)
+static Xen gxg_cairo_translate(Xen cr, Xen tx, Xen ty)
{
#define H_cairo_translate "void cairo_translate(cairo_t* cr, double tx, double ty)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_translate", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(tx), tx, 2, "cairo_translate", "double");
- XEN_ASSERT_TYPE(XEN_double_P(ty), ty, 3, "cairo_translate", "double");
- cairo_translate(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(tx), XEN_TO_C_double(ty));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_translate", "cairo_t*");
+ Xen_check_type(Xen_is_double(tx), tx, 2, "cairo_translate", "double");
+ Xen_check_type(Xen_is_double(ty), ty, 3, "cairo_translate", "double");
+ cairo_translate(Xen_to_C_cairo_t_(cr), Xen_to_C_double(tx), Xen_to_C_double(ty));
+ return(Xen_false);
}
-static XEN gxg_cairo_scale(XEN cr, XEN sx, XEN sy)
+static Xen gxg_cairo_scale(Xen cr, Xen sx, Xen sy)
{
#define H_cairo_scale "void cairo_scale(cairo_t* cr, double sx, double sy)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_scale", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(sx), sx, 2, "cairo_scale", "double");
- XEN_ASSERT_TYPE(XEN_double_P(sy), sy, 3, "cairo_scale", "double");
- cairo_scale(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(sx), XEN_TO_C_double(sy));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_scale", "cairo_t*");
+ Xen_check_type(Xen_is_double(sx), sx, 2, "cairo_scale", "double");
+ Xen_check_type(Xen_is_double(sy), sy, 3, "cairo_scale", "double");
+ cairo_scale(Xen_to_C_cairo_t_(cr), Xen_to_C_double(sx), Xen_to_C_double(sy));
+ return(Xen_false);
}
-static XEN gxg_cairo_rotate(XEN cr, XEN angle)
+static Xen gxg_cairo_rotate(Xen cr, Xen angle)
{
#define H_cairo_rotate "void cairo_rotate(cairo_t* cr, double angle)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_rotate", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(angle), angle, 2, "cairo_rotate", "double");
- cairo_rotate(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(angle));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_rotate", "cairo_t*");
+ Xen_check_type(Xen_is_double(angle), angle, 2, "cairo_rotate", "double");
+ cairo_rotate(Xen_to_C_cairo_t_(cr), Xen_to_C_double(angle));
+ return(Xen_false);
}
-static XEN gxg_cairo_transform(XEN cr, XEN matrix)
+static Xen gxg_cairo_transform(Xen cr, Xen matrix)
{
#define H_cairo_transform "void cairo_transform(cairo_t* cr, cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_transform", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 2, "cairo_transform", "cairo_matrix_t*");
- cairo_transform(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_matrix_t_(matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_transform", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 2, "cairo_transform", "cairo_matrix_t*");
+ cairo_transform(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_matrix_t_(matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_matrix(XEN cr, XEN matrix)
+static Xen gxg_cairo_set_matrix(Xen cr, Xen matrix)
{
#define H_cairo_set_matrix "void cairo_set_matrix(cairo_t* cr, cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_matrix", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 2, "cairo_set_matrix", "cairo_matrix_t*");
- cairo_set_matrix(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_matrix_t_(matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_matrix", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 2, "cairo_set_matrix", "cairo_matrix_t*");
+ cairo_set_matrix(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_matrix_t_(matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_identity_matrix(XEN cr)
+static Xen gxg_cairo_identity_matrix(Xen cr)
{
#define H_cairo_identity_matrix "void cairo_identity_matrix(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_identity_matrix", "cairo_t*");
- cairo_identity_matrix(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_identity_matrix", "cairo_t*");
+ cairo_identity_matrix(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_user_to_device(XEN cr, XEN ignore_x, XEN ignore_y)
+static Xen gxg_cairo_user_to_device(Xen cr, Xen ignore_x, Xen ignore_y)
{
#define H_cairo_user_to_device "void cairo_user_to_device(cairo_t* cr, gdouble* [x], gdouble* [y])"
gdouble ref_x;
gdouble ref_y;
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_user_to_device", "cairo_t*");
- cairo_user_to_device(XEN_TO_C_cairo_t_(cr), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_x), C_TO_XEN_gdouble(ref_y)));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_user_to_device", "cairo_t*");
+ cairo_user_to_device(Xen_to_C_cairo_t_(cr), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
}
-static XEN gxg_cairo_user_to_device_distance(XEN cr, XEN ignore_dx, XEN ignore_dy)
+static Xen gxg_cairo_user_to_device_distance(Xen cr, Xen ignore_dx, Xen ignore_dy)
{
#define H_cairo_user_to_device_distance "void cairo_user_to_device_distance(cairo_t* cr, gdouble* [dx], \
gdouble* [dy])"
gdouble ref_dx;
gdouble ref_dy;
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_user_to_device_distance", "cairo_t*");
- cairo_user_to_device_distance(XEN_TO_C_cairo_t_(cr), &ref_dx, &ref_dy);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_dx), C_TO_XEN_gdouble(ref_dy)));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_user_to_device_distance", "cairo_t*");
+ cairo_user_to_device_distance(Xen_to_C_cairo_t_(cr), &ref_dx, &ref_dy);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_dx), C_to_Xen_gdouble(ref_dy)));
}
-static XEN gxg_cairo_device_to_user(XEN cr, XEN ignore_x, XEN ignore_y)
+static Xen gxg_cairo_device_to_user(Xen cr, Xen ignore_x, Xen ignore_y)
{
#define H_cairo_device_to_user "void cairo_device_to_user(cairo_t* cr, gdouble* [x], gdouble* [y])"
gdouble ref_x;
gdouble ref_y;
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_device_to_user", "cairo_t*");
- cairo_device_to_user(XEN_TO_C_cairo_t_(cr), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_x), C_TO_XEN_gdouble(ref_y)));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_device_to_user", "cairo_t*");
+ cairo_device_to_user(Xen_to_C_cairo_t_(cr), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
}
-static XEN gxg_cairo_device_to_user_distance(XEN cr, XEN ignore_dx, XEN ignore_dy)
+static Xen gxg_cairo_device_to_user_distance(Xen cr, Xen ignore_dx, Xen ignore_dy)
{
#define H_cairo_device_to_user_distance "void cairo_device_to_user_distance(cairo_t* cr, gdouble* [dx], \
gdouble* [dy])"
gdouble ref_dx;
gdouble ref_dy;
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_device_to_user_distance", "cairo_t*");
- cairo_device_to_user_distance(XEN_TO_C_cairo_t_(cr), &ref_dx, &ref_dy);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_dx), C_TO_XEN_gdouble(ref_dy)));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_device_to_user_distance", "cairo_t*");
+ cairo_device_to_user_distance(Xen_to_C_cairo_t_(cr), &ref_dx, &ref_dy);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_dx), C_to_Xen_gdouble(ref_dy)));
}
-static XEN gxg_cairo_new_path(XEN cr)
+static Xen gxg_cairo_new_path(Xen cr)
{
#define H_cairo_new_path "void cairo_new_path(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_new_path", "cairo_t*");
- cairo_new_path(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_new_path", "cairo_t*");
+ cairo_new_path(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_move_to(XEN cr, XEN x, XEN y)
+static Xen gxg_cairo_move_to(Xen cr, Xen x, Xen y)
{
#define H_cairo_move_to "void cairo_move_to(cairo_t* cr, double x, double y)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_move_to", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 2, "cairo_move_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 3, "cairo_move_to", "double");
- cairo_move_to(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(x), XEN_TO_C_double(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_move_to", "cairo_t*");
+ Xen_check_type(Xen_is_double(x), x, 2, "cairo_move_to", "double");
+ Xen_check_type(Xen_is_double(y), y, 3, "cairo_move_to", "double");
+ cairo_move_to(Xen_to_C_cairo_t_(cr), Xen_to_C_double(x), Xen_to_C_double(y));
+ return(Xen_false);
}
-static XEN gxg_cairo_new_sub_path(XEN cr)
+static Xen gxg_cairo_new_sub_path(Xen cr)
{
#define H_cairo_new_sub_path "void cairo_new_sub_path(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_new_sub_path", "cairo_t*");
- cairo_new_sub_path(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_new_sub_path", "cairo_t*");
+ cairo_new_sub_path(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_line_to(XEN cr, XEN x, XEN y)
+static Xen gxg_cairo_line_to(Xen cr, Xen x, Xen y)
{
#define H_cairo_line_to "void cairo_line_to(cairo_t* cr, double x, double y)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_line_to", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 2, "cairo_line_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 3, "cairo_line_to", "double");
- cairo_line_to(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(x), XEN_TO_C_double(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_line_to", "cairo_t*");
+ Xen_check_type(Xen_is_double(x), x, 2, "cairo_line_to", "double");
+ Xen_check_type(Xen_is_double(y), y, 3, "cairo_line_to", "double");
+ cairo_line_to(Xen_to_C_cairo_t_(cr), Xen_to_C_double(x), Xen_to_C_double(y));
+ return(Xen_false);
}
-static XEN gxg_cairo_curve_to(XEN cr, XEN x1, XEN y1, XEN x2, XEN y2, XEN x3, XEN y3)
+static Xen gxg_cairo_curve_to(Xen cr, Xen x1, Xen y1, Xen x2, Xen y2, Xen x3, Xen y3)
{
#define H_cairo_curve_to "void cairo_curve_to(cairo_t* cr, double x1, double y1, double x2, double y2, \
double x3, double y3)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_curve_to", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x1), x1, 2, "cairo_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y1), y1, 3, "cairo_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(x2), x2, 4, "cairo_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y2), y2, 5, "cairo_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(x3), x3, 6, "cairo_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y3), y3, 7, "cairo_curve_to", "double");
- cairo_curve_to(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(x1), XEN_TO_C_double(y1), XEN_TO_C_double(x2), XEN_TO_C_double(y2),
- XEN_TO_C_double(x3), XEN_TO_C_double(y3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_curve_to", "cairo_t*");
+ Xen_check_type(Xen_is_double(x1), x1, 2, "cairo_curve_to", "double");
+ Xen_check_type(Xen_is_double(y1), y1, 3, "cairo_curve_to", "double");
+ Xen_check_type(Xen_is_double(x2), x2, 4, "cairo_curve_to", "double");
+ Xen_check_type(Xen_is_double(y2), y2, 5, "cairo_curve_to", "double");
+ Xen_check_type(Xen_is_double(x3), x3, 6, "cairo_curve_to", "double");
+ Xen_check_type(Xen_is_double(y3), y3, 7, "cairo_curve_to", "double");
+ cairo_curve_to(Xen_to_C_cairo_t_(cr), Xen_to_C_double(x1), Xen_to_C_double(y1), Xen_to_C_double(x2), Xen_to_C_double(y2),
+ Xen_to_C_double(x3), Xen_to_C_double(y3));
+ return(Xen_false);
}
-static XEN gxg_cairo_arc(XEN cr, XEN xc, XEN yc, XEN radius, XEN angle1, XEN angle2)
+static Xen gxg_cairo_arc(Xen cr, Xen xc, Xen yc, Xen radius, Xen angle1, Xen angle2)
{
#define H_cairo_arc "void cairo_arc(cairo_t* cr, double xc, double yc, double radius, double angle1, \
double angle2)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_arc", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(xc), xc, 2, "cairo_arc", "double");
- XEN_ASSERT_TYPE(XEN_double_P(yc), yc, 3, "cairo_arc", "double");
- XEN_ASSERT_TYPE(XEN_double_P(radius), radius, 4, "cairo_arc", "double");
- XEN_ASSERT_TYPE(XEN_double_P(angle1), angle1, 5, "cairo_arc", "double");
- XEN_ASSERT_TYPE(XEN_double_P(angle2), angle2, 6, "cairo_arc", "double");
- cairo_arc(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(xc), XEN_TO_C_double(yc), XEN_TO_C_double(radius), XEN_TO_C_double(angle1),
- XEN_TO_C_double(angle2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_arc", "cairo_t*");
+ Xen_check_type(Xen_is_double(xc), xc, 2, "cairo_arc", "double");
+ Xen_check_type(Xen_is_double(yc), yc, 3, "cairo_arc", "double");
+ Xen_check_type(Xen_is_double(radius), radius, 4, "cairo_arc", "double");
+ Xen_check_type(Xen_is_double(angle1), angle1, 5, "cairo_arc", "double");
+ Xen_check_type(Xen_is_double(angle2), angle2, 6, "cairo_arc", "double");
+ cairo_arc(Xen_to_C_cairo_t_(cr), Xen_to_C_double(xc), Xen_to_C_double(yc), Xen_to_C_double(radius), Xen_to_C_double(angle1),
+ Xen_to_C_double(angle2));
+ return(Xen_false);
}
-static XEN gxg_cairo_arc_negative(XEN cr, XEN xc, XEN yc, XEN radius, XEN angle1, XEN angle2)
+static Xen gxg_cairo_arc_negative(Xen cr, Xen xc, Xen yc, Xen radius, Xen angle1, Xen angle2)
{
#define H_cairo_arc_negative "void cairo_arc_negative(cairo_t* cr, double xc, double yc, double radius, \
double angle1, double angle2)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_arc_negative", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(xc), xc, 2, "cairo_arc_negative", "double");
- XEN_ASSERT_TYPE(XEN_double_P(yc), yc, 3, "cairo_arc_negative", "double");
- XEN_ASSERT_TYPE(XEN_double_P(radius), radius, 4, "cairo_arc_negative", "double");
- XEN_ASSERT_TYPE(XEN_double_P(angle1), angle1, 5, "cairo_arc_negative", "double");
- XEN_ASSERT_TYPE(XEN_double_P(angle2), angle2, 6, "cairo_arc_negative", "double");
- cairo_arc_negative(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(xc), XEN_TO_C_double(yc), XEN_TO_C_double(radius), XEN_TO_C_double(angle1),
- XEN_TO_C_double(angle2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_arc_negative", "cairo_t*");
+ Xen_check_type(Xen_is_double(xc), xc, 2, "cairo_arc_negative", "double");
+ Xen_check_type(Xen_is_double(yc), yc, 3, "cairo_arc_negative", "double");
+ Xen_check_type(Xen_is_double(radius), radius, 4, "cairo_arc_negative", "double");
+ Xen_check_type(Xen_is_double(angle1), angle1, 5, "cairo_arc_negative", "double");
+ Xen_check_type(Xen_is_double(angle2), angle2, 6, "cairo_arc_negative", "double");
+ cairo_arc_negative(Xen_to_C_cairo_t_(cr), Xen_to_C_double(xc), Xen_to_C_double(yc), Xen_to_C_double(radius), Xen_to_C_double(angle1),
+ Xen_to_C_double(angle2));
+ return(Xen_false);
}
-static XEN gxg_cairo_rel_move_to(XEN cr, XEN dx, XEN dy)
+static Xen gxg_cairo_rel_move_to(Xen cr, Xen dx, Xen dy)
{
#define H_cairo_rel_move_to "void cairo_rel_move_to(cairo_t* cr, double dx, double dy)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_rel_move_to", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(dx), dx, 2, "cairo_rel_move_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(dy), dy, 3, "cairo_rel_move_to", "double");
- cairo_rel_move_to(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(dx), XEN_TO_C_double(dy));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_rel_move_to", "cairo_t*");
+ Xen_check_type(Xen_is_double(dx), dx, 2, "cairo_rel_move_to", "double");
+ Xen_check_type(Xen_is_double(dy), dy, 3, "cairo_rel_move_to", "double");
+ cairo_rel_move_to(Xen_to_C_cairo_t_(cr), Xen_to_C_double(dx), Xen_to_C_double(dy));
+ return(Xen_false);
}
-static XEN gxg_cairo_rel_line_to(XEN cr, XEN dx, XEN dy)
+static Xen gxg_cairo_rel_line_to(Xen cr, Xen dx, Xen dy)
{
#define H_cairo_rel_line_to "void cairo_rel_line_to(cairo_t* cr, double dx, double dy)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_rel_line_to", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(dx), dx, 2, "cairo_rel_line_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(dy), dy, 3, "cairo_rel_line_to", "double");
- cairo_rel_line_to(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(dx), XEN_TO_C_double(dy));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_rel_line_to", "cairo_t*");
+ Xen_check_type(Xen_is_double(dx), dx, 2, "cairo_rel_line_to", "double");
+ Xen_check_type(Xen_is_double(dy), dy, 3, "cairo_rel_line_to", "double");
+ cairo_rel_line_to(Xen_to_C_cairo_t_(cr), Xen_to_C_double(dx), Xen_to_C_double(dy));
+ return(Xen_false);
}
-static XEN gxg_cairo_rel_curve_to(XEN cr, XEN dx1, XEN dy1, XEN dx2, XEN dy2, XEN dx3, XEN dy3)
+static Xen gxg_cairo_rel_curve_to(Xen cr, Xen dx1, Xen dy1, Xen dx2, Xen dy2, Xen dx3, Xen dy3)
{
#define H_cairo_rel_curve_to "void cairo_rel_curve_to(cairo_t* cr, double dx1, double dy1, double dx2, \
double dy2, double dx3, double dy3)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_rel_curve_to", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(dx1), dx1, 2, "cairo_rel_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(dy1), dy1, 3, "cairo_rel_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(dx2), dx2, 4, "cairo_rel_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(dy2), dy2, 5, "cairo_rel_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(dx3), dx3, 6, "cairo_rel_curve_to", "double");
- XEN_ASSERT_TYPE(XEN_double_P(dy3), dy3, 7, "cairo_rel_curve_to", "double");
- cairo_rel_curve_to(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(dx1), XEN_TO_C_double(dy1), XEN_TO_C_double(dx2), XEN_TO_C_double(dy2),
- XEN_TO_C_double(dx3), XEN_TO_C_double(dy3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_rel_curve_to", "cairo_t*");
+ Xen_check_type(Xen_is_double(dx1), dx1, 2, "cairo_rel_curve_to", "double");
+ Xen_check_type(Xen_is_double(dy1), dy1, 3, "cairo_rel_curve_to", "double");
+ Xen_check_type(Xen_is_double(dx2), dx2, 4, "cairo_rel_curve_to", "double");
+ Xen_check_type(Xen_is_double(dy2), dy2, 5, "cairo_rel_curve_to", "double");
+ Xen_check_type(Xen_is_double(dx3), dx3, 6, "cairo_rel_curve_to", "double");
+ Xen_check_type(Xen_is_double(dy3), dy3, 7, "cairo_rel_curve_to", "double");
+ cairo_rel_curve_to(Xen_to_C_cairo_t_(cr), Xen_to_C_double(dx1), Xen_to_C_double(dy1), Xen_to_C_double(dx2), Xen_to_C_double(dy2),
+ Xen_to_C_double(dx3), Xen_to_C_double(dy3));
+ return(Xen_false);
}
-static XEN gxg_cairo_rectangle(XEN cr, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_cairo_rectangle(Xen cr, Xen x, Xen y, Xen width, Xen height)
{
#define H_cairo_rectangle "void cairo_rectangle(cairo_t* cr, double x, double y, double width, double height)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_rectangle", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 2, "cairo_rectangle", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 3, "cairo_rectangle", "double");
- XEN_ASSERT_TYPE(XEN_double_P(width), width, 4, "cairo_rectangle", "double");
- XEN_ASSERT_TYPE(XEN_double_P(height), height, 5, "cairo_rectangle", "double");
- cairo_rectangle(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(x), XEN_TO_C_double(y), XEN_TO_C_double(width), XEN_TO_C_double(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_rectangle", "cairo_t*");
+ Xen_check_type(Xen_is_double(x), x, 2, "cairo_rectangle", "double");
+ Xen_check_type(Xen_is_double(y), y, 3, "cairo_rectangle", "double");
+ Xen_check_type(Xen_is_double(width), width, 4, "cairo_rectangle", "double");
+ Xen_check_type(Xen_is_double(height), height, 5, "cairo_rectangle", "double");
+ cairo_rectangle(Xen_to_C_cairo_t_(cr), Xen_to_C_double(x), Xen_to_C_double(y), Xen_to_C_double(width), Xen_to_C_double(height));
+ return(Xen_false);
}
-static XEN gxg_cairo_close_path(XEN cr)
+static Xen gxg_cairo_close_path(Xen cr)
{
#define H_cairo_close_path "void cairo_close_path(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_close_path", "cairo_t*");
- cairo_close_path(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_close_path", "cairo_t*");
+ cairo_close_path(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_paint(XEN cr)
+static Xen gxg_cairo_paint(Xen cr)
{
#define H_cairo_paint "void cairo_paint(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_paint", "cairo_t*");
- cairo_paint(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_paint", "cairo_t*");
+ cairo_paint(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_paint_with_alpha(XEN cr, XEN alpha)
+static Xen gxg_cairo_paint_with_alpha(Xen cr, Xen alpha)
{
#define H_cairo_paint_with_alpha "void cairo_paint_with_alpha(cairo_t* cr, double alpha)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_paint_with_alpha", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(alpha), alpha, 2, "cairo_paint_with_alpha", "double");
- cairo_paint_with_alpha(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_paint_with_alpha", "cairo_t*");
+ Xen_check_type(Xen_is_double(alpha), alpha, 2, "cairo_paint_with_alpha", "double");
+ cairo_paint_with_alpha(Xen_to_C_cairo_t_(cr), Xen_to_C_double(alpha));
+ return(Xen_false);
}
-static XEN gxg_cairo_mask(XEN cr, XEN pattern)
+static Xen gxg_cairo_mask(Xen cr, Xen pattern)
{
#define H_cairo_mask "void cairo_mask(cairo_t* cr, cairo_pattern_t* pattern)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_mask", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 2, "cairo_mask", "cairo_pattern_t*");
- cairo_mask(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_pattern_t_(pattern));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_mask", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 2, "cairo_mask", "cairo_pattern_t*");
+ cairo_mask(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_pattern_t_(pattern));
+ return(Xen_false);
}
-static XEN gxg_cairo_mask_surface(XEN cr, XEN surface, XEN surface_x, XEN surface_y)
+static Xen gxg_cairo_mask_surface(Xen cr, Xen surface, Xen surface_x, Xen surface_y)
{
#define H_cairo_mask_surface "void cairo_mask_surface(cairo_t* cr, cairo_surface_t* surface, double surface_x, \
double surface_y)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_mask_surface", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 2, "cairo_mask_surface", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_double_P(surface_x), surface_x, 3, "cairo_mask_surface", "double");
- XEN_ASSERT_TYPE(XEN_double_P(surface_y), surface_y, 4, "cairo_mask_surface", "double");
- cairo_mask_surface(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_double(surface_x), XEN_TO_C_double(surface_y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_mask_surface", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 2, "cairo_mask_surface", "cairo_surface_t*");
+ Xen_check_type(Xen_is_double(surface_x), surface_x, 3, "cairo_mask_surface", "double");
+ Xen_check_type(Xen_is_double(surface_y), surface_y, 4, "cairo_mask_surface", "double");
+ cairo_mask_surface(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_surface_t_(surface), Xen_to_C_double(surface_x), Xen_to_C_double(surface_y));
+ return(Xen_false);
}
-static XEN gxg_cairo_stroke(XEN cr)
+static Xen gxg_cairo_stroke(Xen cr)
{
#define H_cairo_stroke "void cairo_stroke(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_stroke", "cairo_t*");
- cairo_stroke(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_stroke", "cairo_t*");
+ cairo_stroke(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_stroke_preserve(XEN cr)
+static Xen gxg_cairo_stroke_preserve(Xen cr)
{
#define H_cairo_stroke_preserve "void cairo_stroke_preserve(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_stroke_preserve", "cairo_t*");
- cairo_stroke_preserve(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_stroke_preserve", "cairo_t*");
+ cairo_stroke_preserve(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_fill(XEN cr)
+static Xen gxg_cairo_fill(Xen cr)
{
#define H_cairo_fill "void cairo_fill(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_fill", "cairo_t*");
- cairo_fill(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_fill", "cairo_t*");
+ cairo_fill(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_fill_preserve(XEN cr)
+static Xen gxg_cairo_fill_preserve(Xen cr)
{
#define H_cairo_fill_preserve "void cairo_fill_preserve(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_fill_preserve", "cairo_t*");
- cairo_fill_preserve(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_fill_preserve", "cairo_t*");
+ cairo_fill_preserve(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_copy_page(XEN cr)
+static Xen gxg_cairo_copy_page(Xen cr)
{
#define H_cairo_copy_page "void cairo_copy_page(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_copy_page", "cairo_t*");
- cairo_copy_page(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_copy_page", "cairo_t*");
+ cairo_copy_page(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_show_page(XEN cr)
+static Xen gxg_cairo_show_page(Xen cr)
{
#define H_cairo_show_page "void cairo_show_page(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_show_page", "cairo_t*");
- cairo_show_page(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_show_page", "cairo_t*");
+ cairo_show_page(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_in_stroke(XEN cr, XEN x, XEN y)
+static Xen gxg_cairo_in_stroke(Xen cr, Xen x, Xen y)
{
#define H_cairo_in_stroke "bool cairo_in_stroke(cairo_t* cr, double x, double y)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_in_stroke", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 2, "cairo_in_stroke", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 3, "cairo_in_stroke", "double");
- return(C_TO_XEN_bool(cairo_in_stroke(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(x), XEN_TO_C_double(y))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_in_stroke", "cairo_t*");
+ Xen_check_type(Xen_is_double(x), x, 2, "cairo_in_stroke", "double");
+ Xen_check_type(Xen_is_double(y), y, 3, "cairo_in_stroke", "double");
+ return(C_to_Xen_bool(cairo_in_stroke(Xen_to_C_cairo_t_(cr), Xen_to_C_double(x), Xen_to_C_double(y))));
}
-static XEN gxg_cairo_in_fill(XEN cr, XEN x, XEN y)
+static Xen gxg_cairo_in_fill(Xen cr, Xen x, Xen y)
{
#define H_cairo_in_fill "bool cairo_in_fill(cairo_t* cr, double x, double y)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_in_fill", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 2, "cairo_in_fill", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 3, "cairo_in_fill", "double");
- return(C_TO_XEN_bool(cairo_in_fill(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(x), XEN_TO_C_double(y))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_in_fill", "cairo_t*");
+ Xen_check_type(Xen_is_double(x), x, 2, "cairo_in_fill", "double");
+ Xen_check_type(Xen_is_double(y), y, 3, "cairo_in_fill", "double");
+ return(C_to_Xen_bool(cairo_in_fill(Xen_to_C_cairo_t_(cr), Xen_to_C_double(x), Xen_to_C_double(y))));
}
-static XEN gxg_cairo_reset_clip(XEN cr)
+static Xen gxg_cairo_reset_clip(Xen cr)
{
#define H_cairo_reset_clip "void cairo_reset_clip(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_reset_clip", "cairo_t*");
- cairo_reset_clip(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_reset_clip", "cairo_t*");
+ cairo_reset_clip(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_clip(XEN cr)
+static Xen gxg_cairo_clip(Xen cr)
{
#define H_cairo_clip "void cairo_clip(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_clip", "cairo_t*");
- cairo_clip(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_clip", "cairo_t*");
+ cairo_clip(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_clip_preserve(XEN cr)
+static Xen gxg_cairo_clip_preserve(Xen cr)
{
#define H_cairo_clip_preserve "void cairo_clip_preserve(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_clip_preserve", "cairo_t*");
- cairo_clip_preserve(XEN_TO_C_cairo_t_(cr));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_clip_preserve", "cairo_t*");
+ cairo_clip_preserve(Xen_to_C_cairo_t_(cr));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_options_create(void)
+static Xen gxg_cairo_font_options_create(void)
{
#define H_cairo_font_options_create "cairo_font_options_t* cairo_font_options_create( void)"
- return(C_TO_XEN_cairo_font_options_t_(cairo_font_options_create()));
+ return(C_to_Xen_cairo_font_options_t_(cairo_font_options_create()));
}
-static XEN gxg_cairo_font_options_copy(XEN original)
+static Xen gxg_cairo_font_options_copy(Xen original)
{
#define H_cairo_font_options_copy "cairo_font_options_t* cairo_font_options_copy(cairo_font_options_t* original)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(original), original, 1, "cairo_font_options_copy", "cairo_font_options_t*");
- return(C_TO_XEN_cairo_font_options_t_(cairo_font_options_copy(XEN_TO_C_cairo_font_options_t_(original))));
+ Xen_check_type(Xen_is_cairo_font_options_t_(original), original, 1, "cairo_font_options_copy", "cairo_font_options_t*");
+ return(C_to_Xen_cairo_font_options_t_(cairo_font_options_copy(Xen_to_C_cairo_font_options_t_(original))));
}
-static XEN gxg_cairo_font_options_destroy(XEN options)
+static Xen gxg_cairo_font_options_destroy(Xen options)
{
#define H_cairo_font_options_destroy "void cairo_font_options_destroy(cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_destroy", "cairo_font_options_t*");
- cairo_font_options_destroy(XEN_TO_C_cairo_font_options_t_(options));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_destroy", "cairo_font_options_t*");
+ cairo_font_options_destroy(Xen_to_C_cairo_font_options_t_(options));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_options_status(XEN options)
+static Xen gxg_cairo_font_options_status(Xen options)
{
#define H_cairo_font_options_status "cairo_status_t cairo_font_options_status(cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_status", "cairo_font_options_t*");
- return(C_TO_XEN_cairo_status_t(cairo_font_options_status(XEN_TO_C_cairo_font_options_t_(options))));
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_status", "cairo_font_options_t*");
+ return(C_to_Xen_cairo_status_t(cairo_font_options_status(Xen_to_C_cairo_font_options_t_(options))));
}
-static XEN gxg_cairo_font_options_merge(XEN options, XEN other)
+static Xen gxg_cairo_font_options_merge(Xen options, Xen other)
{
#define H_cairo_font_options_merge "void cairo_font_options_merge(cairo_font_options_t* options, cairo_font_options_t* other)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_merge", "cairo_font_options_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(other), other, 2, "cairo_font_options_merge", "cairo_font_options_t*");
- cairo_font_options_merge(XEN_TO_C_cairo_font_options_t_(options), XEN_TO_C_cairo_font_options_t_(other));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_merge", "cairo_font_options_t*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(other), other, 2, "cairo_font_options_merge", "cairo_font_options_t*");
+ cairo_font_options_merge(Xen_to_C_cairo_font_options_t_(options), Xen_to_C_cairo_font_options_t_(other));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_options_equal(XEN options, XEN other)
+static Xen gxg_cairo_font_options_equal(Xen options, Xen other)
{
#define H_cairo_font_options_equal "bool cairo_font_options_equal(cairo_font_options_t* options, cairo_font_options_t* other)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_equal", "cairo_font_options_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(other), other, 2, "cairo_font_options_equal", "cairo_font_options_t*");
- return(C_TO_XEN_bool(cairo_font_options_equal(XEN_TO_C_cairo_font_options_t_(options), XEN_TO_C_cairo_font_options_t_(other))));
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_equal", "cairo_font_options_t*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(other), other, 2, "cairo_font_options_equal", "cairo_font_options_t*");
+ return(C_to_Xen_bool(cairo_font_options_equal(Xen_to_C_cairo_font_options_t_(options), Xen_to_C_cairo_font_options_t_(other))));
}
-static XEN gxg_cairo_font_options_hash(XEN options)
+static Xen gxg_cairo_font_options_hash(Xen options)
{
#define H_cairo_font_options_hash "gulong cairo_font_options_hash(cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_hash", "cairo_font_options_t*");
- return(C_TO_XEN_gulong(cairo_font_options_hash(XEN_TO_C_cairo_font_options_t_(options))));
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_hash", "cairo_font_options_t*");
+ return(C_to_Xen_gulong(cairo_font_options_hash(Xen_to_C_cairo_font_options_t_(options))));
}
-static XEN gxg_cairo_font_options_set_antialias(XEN options, XEN antialias)
+static Xen gxg_cairo_font_options_set_antialias(Xen options, Xen antialias)
{
#define H_cairo_font_options_set_antialias "void cairo_font_options_set_antialias(cairo_font_options_t* options, \
cairo_antialias_t antialias)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_set_antialias", "cairo_font_options_t*");
- XEN_ASSERT_TYPE(XEN_cairo_antialias_t_P(antialias), antialias, 2, "cairo_font_options_set_antialias", "cairo_antialias_t");
- cairo_font_options_set_antialias(XEN_TO_C_cairo_font_options_t_(options), XEN_TO_C_cairo_antialias_t(antialias));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_set_antialias", "cairo_font_options_t*");
+ Xen_check_type(Xen_is_cairo_antialias_t(antialias), antialias, 2, "cairo_font_options_set_antialias", "cairo_antialias_t");
+ cairo_font_options_set_antialias(Xen_to_C_cairo_font_options_t_(options), Xen_to_C_cairo_antialias_t(antialias));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_options_get_antialias(XEN options)
+static Xen gxg_cairo_font_options_get_antialias(Xen options)
{
#define H_cairo_font_options_get_antialias "cairo_antialias_t cairo_font_options_get_antialias(cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_get_antialias", "cairo_font_options_t*");
- return(C_TO_XEN_cairo_antialias_t(cairo_font_options_get_antialias(XEN_TO_C_cairo_font_options_t_(options))));
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_get_antialias", "cairo_font_options_t*");
+ return(C_to_Xen_cairo_antialias_t(cairo_font_options_get_antialias(Xen_to_C_cairo_font_options_t_(options))));
}
-static XEN gxg_cairo_font_options_set_subpixel_order(XEN options, XEN subpixel_order)
+static Xen gxg_cairo_font_options_set_subpixel_order(Xen options, Xen subpixel_order)
{
#define H_cairo_font_options_set_subpixel_order "void cairo_font_options_set_subpixel_order(cairo_font_options_t* options, \
cairo_subpixel_order_t subpixel_order)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_set_subpixel_order", "cairo_font_options_t*");
- XEN_ASSERT_TYPE(XEN_cairo_subpixel_order_t_P(subpixel_order), subpixel_order, 2, "cairo_font_options_set_subpixel_order", "cairo_subpixel_order_t");
- cairo_font_options_set_subpixel_order(XEN_TO_C_cairo_font_options_t_(options), XEN_TO_C_cairo_subpixel_order_t(subpixel_order));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_set_subpixel_order", "cairo_font_options_t*");
+ Xen_check_type(Xen_is_cairo_subpixel_order_t(subpixel_order), subpixel_order, 2, "cairo_font_options_set_subpixel_order", "cairo_subpixel_order_t");
+ cairo_font_options_set_subpixel_order(Xen_to_C_cairo_font_options_t_(options), Xen_to_C_cairo_subpixel_order_t(subpixel_order));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_options_get_subpixel_order(XEN options)
+static Xen gxg_cairo_font_options_get_subpixel_order(Xen options)
{
#define H_cairo_font_options_get_subpixel_order "cairo_subpixel_order_t cairo_font_options_get_subpixel_order(cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_get_subpixel_order", "cairo_font_options_t*");
- return(C_TO_XEN_cairo_subpixel_order_t(cairo_font_options_get_subpixel_order(XEN_TO_C_cairo_font_options_t_(options))));
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_get_subpixel_order", "cairo_font_options_t*");
+ return(C_to_Xen_cairo_subpixel_order_t(cairo_font_options_get_subpixel_order(Xen_to_C_cairo_font_options_t_(options))));
}
-static XEN gxg_cairo_font_options_set_hint_style(XEN options, XEN hint_style)
+static Xen gxg_cairo_font_options_set_hint_style(Xen options, Xen hint_style)
{
#define H_cairo_font_options_set_hint_style "void cairo_font_options_set_hint_style(cairo_font_options_t* options, \
cairo_hint_style_t hint_style)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_set_hint_style", "cairo_font_options_t*");
- XEN_ASSERT_TYPE(XEN_cairo_hint_style_t_P(hint_style), hint_style, 2, "cairo_font_options_set_hint_style", "cairo_hint_style_t");
- cairo_font_options_set_hint_style(XEN_TO_C_cairo_font_options_t_(options), XEN_TO_C_cairo_hint_style_t(hint_style));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_set_hint_style", "cairo_font_options_t*");
+ Xen_check_type(Xen_is_cairo_hint_style_t(hint_style), hint_style, 2, "cairo_font_options_set_hint_style", "cairo_hint_style_t");
+ cairo_font_options_set_hint_style(Xen_to_C_cairo_font_options_t_(options), Xen_to_C_cairo_hint_style_t(hint_style));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_options_get_hint_style(XEN options)
+static Xen gxg_cairo_font_options_get_hint_style(Xen options)
{
#define H_cairo_font_options_get_hint_style "cairo_hint_style_t cairo_font_options_get_hint_style(cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_get_hint_style", "cairo_font_options_t*");
- return(C_TO_XEN_cairo_hint_style_t(cairo_font_options_get_hint_style(XEN_TO_C_cairo_font_options_t_(options))));
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_get_hint_style", "cairo_font_options_t*");
+ return(C_to_Xen_cairo_hint_style_t(cairo_font_options_get_hint_style(Xen_to_C_cairo_font_options_t_(options))));
}
-static XEN gxg_cairo_font_options_set_hint_metrics(XEN options, XEN hint_metrics)
+static Xen gxg_cairo_font_options_set_hint_metrics(Xen options, Xen hint_metrics)
{
#define H_cairo_font_options_set_hint_metrics "void cairo_font_options_set_hint_metrics(cairo_font_options_t* options, \
cairo_hint_metrics_t hint_metrics)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_set_hint_metrics", "cairo_font_options_t*");
- XEN_ASSERT_TYPE(XEN_cairo_hint_metrics_t_P(hint_metrics), hint_metrics, 2, "cairo_font_options_set_hint_metrics", "cairo_hint_metrics_t");
- cairo_font_options_set_hint_metrics(XEN_TO_C_cairo_font_options_t_(options), XEN_TO_C_cairo_hint_metrics_t(hint_metrics));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_set_hint_metrics", "cairo_font_options_t*");
+ Xen_check_type(Xen_is_cairo_hint_metrics_t(hint_metrics), hint_metrics, 2, "cairo_font_options_set_hint_metrics", "cairo_hint_metrics_t");
+ cairo_font_options_set_hint_metrics(Xen_to_C_cairo_font_options_t_(options), Xen_to_C_cairo_hint_metrics_t(hint_metrics));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_options_get_hint_metrics(XEN options)
+static Xen gxg_cairo_font_options_get_hint_metrics(Xen options)
{
#define H_cairo_font_options_get_hint_metrics "cairo_hint_metrics_t cairo_font_options_get_hint_metrics(cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 1, "cairo_font_options_get_hint_metrics", "cairo_font_options_t*");
- return(C_TO_XEN_cairo_hint_metrics_t(cairo_font_options_get_hint_metrics(XEN_TO_C_cairo_font_options_t_(options))));
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 1, "cairo_font_options_get_hint_metrics", "cairo_font_options_t*");
+ return(C_to_Xen_cairo_hint_metrics_t(cairo_font_options_get_hint_metrics(Xen_to_C_cairo_font_options_t_(options))));
}
-static XEN gxg_cairo_select_font_face(XEN cr, XEN family, XEN slant, XEN weight)
+static Xen gxg_cairo_select_font_face(Xen cr, Xen family, Xen slant, Xen weight)
{
#define H_cairo_select_font_face "void cairo_select_font_face(cairo_t* cr, char* family, cairo_font_slant_t slant, \
cairo_font_weight_t weight)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_select_font_face", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_char__P(family), family, 2, "cairo_select_font_face", "char*");
- XEN_ASSERT_TYPE(XEN_cairo_font_slant_t_P(slant), slant, 3, "cairo_select_font_face", "cairo_font_slant_t");
- XEN_ASSERT_TYPE(XEN_cairo_font_weight_t_P(weight), weight, 4, "cairo_select_font_face", "cairo_font_weight_t");
- cairo_select_font_face(XEN_TO_C_cairo_t_(cr), XEN_TO_C_char_(family), XEN_TO_C_cairo_font_slant_t(slant), XEN_TO_C_cairo_font_weight_t(weight));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_select_font_face", "cairo_t*");
+ Xen_check_type(Xen_is_char_(family), family, 2, "cairo_select_font_face", "char*");
+ Xen_check_type(Xen_is_cairo_font_slant_t(slant), slant, 3, "cairo_select_font_face", "cairo_font_slant_t");
+ Xen_check_type(Xen_is_cairo_font_weight_t(weight), weight, 4, "cairo_select_font_face", "cairo_font_weight_t");
+ cairo_select_font_face(Xen_to_C_cairo_t_(cr), Xen_to_C_char_(family), Xen_to_C_cairo_font_slant_t(slant), Xen_to_C_cairo_font_weight_t(weight));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_font_size(XEN cr, XEN size)
+static Xen gxg_cairo_set_font_size(Xen cr, Xen size)
{
#define H_cairo_set_font_size "void cairo_set_font_size(cairo_t* cr, double size)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_font_size", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(size), size, 2, "cairo_set_font_size", "double");
- cairo_set_font_size(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(size));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_font_size", "cairo_t*");
+ Xen_check_type(Xen_is_double(size), size, 2, "cairo_set_font_size", "double");
+ cairo_set_font_size(Xen_to_C_cairo_t_(cr), Xen_to_C_double(size));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_font_matrix(XEN cr, XEN matrix)
+static Xen gxg_cairo_set_font_matrix(Xen cr, Xen matrix)
{
#define H_cairo_set_font_matrix "void cairo_set_font_matrix(cairo_t* cr, cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_font_matrix", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 2, "cairo_set_font_matrix", "cairo_matrix_t*");
- cairo_set_font_matrix(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_matrix_t_(matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_font_matrix", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 2, "cairo_set_font_matrix", "cairo_matrix_t*");
+ cairo_set_font_matrix(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_matrix_t_(matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_get_font_matrix(XEN cr, XEN matrix)
+static Xen gxg_cairo_get_font_matrix(Xen cr, Xen matrix)
{
#define H_cairo_get_font_matrix "void cairo_get_font_matrix(cairo_t* cr, cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_font_matrix", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 2, "cairo_get_font_matrix", "cairo_matrix_t*");
- cairo_get_font_matrix(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_matrix_t_(matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_font_matrix", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 2, "cairo_get_font_matrix", "cairo_matrix_t*");
+ cairo_get_font_matrix(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_matrix_t_(matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_font_options(XEN cr, XEN options)
+static Xen gxg_cairo_set_font_options(Xen cr, Xen options)
{
#define H_cairo_set_font_options "void cairo_set_font_options(cairo_t* cr, cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_font_options", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 2, "cairo_set_font_options", "cairo_font_options_t*");
- cairo_set_font_options(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_font_options_t_(options));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_font_options", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 2, "cairo_set_font_options", "cairo_font_options_t*");
+ cairo_set_font_options(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_font_options_t_(options));
+ return(Xen_false);
}
-static XEN gxg_cairo_get_font_options(XEN cr, XEN options)
+static Xen gxg_cairo_get_font_options(Xen cr, Xen options)
{
#define H_cairo_get_font_options "void cairo_get_font_options(cairo_t* cr, cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_font_options", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 2, "cairo_get_font_options", "cairo_font_options_t*");
- cairo_get_font_options(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_font_options_t_(options));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_font_options", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 2, "cairo_get_font_options", "cairo_font_options_t*");
+ cairo_get_font_options(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_font_options_t_(options));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_scaled_font(XEN cr, XEN scaled_font)
+static Xen gxg_cairo_set_scaled_font(Xen cr, Xen scaled_font)
{
#define H_cairo_set_scaled_font "void cairo_set_scaled_font(cairo_t* cr, cairo_scaled_font_t* scaled_font)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_scaled_font", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 2, "cairo_set_scaled_font", "cairo_scaled_font_t*");
- cairo_set_scaled_font(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_scaled_font_t_(scaled_font));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_scaled_font", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 2, "cairo_set_scaled_font", "cairo_scaled_font_t*");
+ cairo_set_scaled_font(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_scaled_font_t_(scaled_font));
+ return(Xen_false);
}
-static XEN gxg_cairo_show_text(XEN cr, XEN utf8)
+static Xen gxg_cairo_show_text(Xen cr, Xen utf8)
{
#define H_cairo_show_text "void cairo_show_text(cairo_t* cr, char* utf8)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_show_text", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_char__P(utf8), utf8, 2, "cairo_show_text", "char*");
- cairo_show_text(XEN_TO_C_cairo_t_(cr), XEN_TO_C_char_(utf8));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_show_text", "cairo_t*");
+ Xen_check_type(Xen_is_char_(utf8), utf8, 2, "cairo_show_text", "char*");
+ cairo_show_text(Xen_to_C_cairo_t_(cr), Xen_to_C_char_(utf8));
+ return(Xen_false);
}
-static XEN gxg_cairo_show_glyphs(XEN cr, XEN glyphs, XEN num_glyphs)
+static Xen gxg_cairo_show_glyphs(Xen cr, Xen glyphs, Xen num_glyphs)
{
#define H_cairo_show_glyphs "void cairo_show_glyphs(cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_show_glyphs", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_glyph_t__P(glyphs), glyphs, 2, "cairo_show_glyphs", "cairo_glyph_t*");
- XEN_ASSERT_TYPE(XEN_int_P(num_glyphs), num_glyphs, 3, "cairo_show_glyphs", "int");
- cairo_show_glyphs(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_glyph_t_(glyphs), XEN_TO_C_int(num_glyphs));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_show_glyphs", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_glyph_t_(glyphs), glyphs, 2, "cairo_show_glyphs", "cairo_glyph_t*");
+ Xen_check_type(Xen_is_int(num_glyphs), num_glyphs, 3, "cairo_show_glyphs", "int");
+ cairo_show_glyphs(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_glyph_t_(glyphs), Xen_to_C_int(num_glyphs));
+ return(Xen_false);
}
-static XEN gxg_cairo_get_font_face(XEN cr)
+static Xen gxg_cairo_get_font_face(Xen cr)
{
#define H_cairo_get_font_face "cairo_font_face_t* cairo_get_font_face(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_font_face", "cairo_t*");
- return(C_TO_XEN_cairo_font_face_t_(cairo_get_font_face(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_font_face", "cairo_t*");
+ return(C_to_Xen_cairo_font_face_t_(cairo_get_font_face(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_font_extents(XEN cr, XEN extents)
+static Xen gxg_cairo_font_extents(Xen cr, Xen extents)
{
#define H_cairo_font_extents "void cairo_font_extents(cairo_t* cr, cairo_font_extents_t* extents)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_font_extents", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_extents_t__P(extents), extents, 2, "cairo_font_extents", "cairo_font_extents_t*");
- cairo_font_extents(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_font_extents_t_(extents));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_font_extents", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_font_extents_t_(extents), extents, 2, "cairo_font_extents", "cairo_font_extents_t*");
+ cairo_font_extents(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_font_extents_t_(extents));
+ return(Xen_false);
}
-static XEN gxg_cairo_set_font_face(XEN cr, XEN font_face)
+static Xen gxg_cairo_set_font_face(Xen cr, Xen font_face)
{
#define H_cairo_set_font_face "void cairo_set_font_face(cairo_t* cr, cairo_font_face_t* font_face)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_font_face", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 2, "cairo_set_font_face", "cairo_font_face_t*");
- cairo_set_font_face(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_font_face_t_(font_face));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_font_face", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 2, "cairo_set_font_face", "cairo_font_face_t*");
+ cairo_set_font_face(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_font_face_t_(font_face));
+ return(Xen_false);
}
-static XEN gxg_cairo_text_extents(XEN cr, XEN utf8, XEN extents)
+static Xen gxg_cairo_text_extents(Xen cr, Xen utf8, Xen extents)
{
#define H_cairo_text_extents "void cairo_text_extents(cairo_t* cr, char* utf8, cairo_text_extents_t* extents)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_text_extents", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_char__P(utf8), utf8, 2, "cairo_text_extents", "char*");
- XEN_ASSERT_TYPE(XEN_cairo_text_extents_t__P(extents), extents, 3, "cairo_text_extents", "cairo_text_extents_t*");
- cairo_text_extents(XEN_TO_C_cairo_t_(cr), XEN_TO_C_char_(utf8), XEN_TO_C_cairo_text_extents_t_(extents));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_text_extents", "cairo_t*");
+ Xen_check_type(Xen_is_char_(utf8), utf8, 2, "cairo_text_extents", "char*");
+ Xen_check_type(Xen_is_cairo_text_extents_t_(extents), extents, 3, "cairo_text_extents", "cairo_text_extents_t*");
+ cairo_text_extents(Xen_to_C_cairo_t_(cr), Xen_to_C_char_(utf8), Xen_to_C_cairo_text_extents_t_(extents));
+ return(Xen_false);
}
-static XEN gxg_cairo_glyph_extents(XEN cr, XEN glyphs, XEN num_glyphs, XEN extents)
+static Xen gxg_cairo_glyph_extents(Xen cr, Xen glyphs, Xen num_glyphs, Xen extents)
{
#define H_cairo_glyph_extents "void cairo_glyph_extents(cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs, \
cairo_text_extents_t* extents)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_glyph_extents", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_glyph_t__P(glyphs), glyphs, 2, "cairo_glyph_extents", "cairo_glyph_t*");
- XEN_ASSERT_TYPE(XEN_int_P(num_glyphs), num_glyphs, 3, "cairo_glyph_extents", "int");
- XEN_ASSERT_TYPE(XEN_cairo_text_extents_t__P(extents), extents, 4, "cairo_glyph_extents", "cairo_text_extents_t*");
- cairo_glyph_extents(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_glyph_t_(glyphs), XEN_TO_C_int(num_glyphs), XEN_TO_C_cairo_text_extents_t_(extents));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_glyph_extents", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_glyph_t_(glyphs), glyphs, 2, "cairo_glyph_extents", "cairo_glyph_t*");
+ Xen_check_type(Xen_is_int(num_glyphs), num_glyphs, 3, "cairo_glyph_extents", "int");
+ Xen_check_type(Xen_is_cairo_text_extents_t_(extents), extents, 4, "cairo_glyph_extents", "cairo_text_extents_t*");
+ cairo_glyph_extents(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_glyph_t_(glyphs), Xen_to_C_int(num_glyphs), Xen_to_C_cairo_text_extents_t_(extents));
+ return(Xen_false);
}
-static XEN gxg_cairo_text_path(XEN cr, XEN utf8)
+static Xen gxg_cairo_text_path(Xen cr, Xen utf8)
{
#define H_cairo_text_path "void cairo_text_path(cairo_t* cr, char* utf8)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_text_path", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_char__P(utf8), utf8, 2, "cairo_text_path", "char*");
- cairo_text_path(XEN_TO_C_cairo_t_(cr), XEN_TO_C_char_(utf8));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_text_path", "cairo_t*");
+ Xen_check_type(Xen_is_char_(utf8), utf8, 2, "cairo_text_path", "char*");
+ cairo_text_path(Xen_to_C_cairo_t_(cr), Xen_to_C_char_(utf8));
+ return(Xen_false);
}
-static XEN gxg_cairo_glyph_path(XEN cr, XEN glyphs, XEN num_glyphs)
+static Xen gxg_cairo_glyph_path(Xen cr, Xen glyphs, Xen num_glyphs)
{
#define H_cairo_glyph_path "void cairo_glyph_path(cairo_t* cr, cairo_glyph_t* glyphs, int num_glyphs)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_glyph_path", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_glyph_t__P(glyphs), glyphs, 2, "cairo_glyph_path", "cairo_glyph_t*");
- XEN_ASSERT_TYPE(XEN_int_P(num_glyphs), num_glyphs, 3, "cairo_glyph_path", "int");
- cairo_glyph_path(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_glyph_t_(glyphs), XEN_TO_C_int(num_glyphs));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_glyph_path", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_glyph_t_(glyphs), glyphs, 2, "cairo_glyph_path", "cairo_glyph_t*");
+ Xen_check_type(Xen_is_int(num_glyphs), num_glyphs, 3, "cairo_glyph_path", "int");
+ cairo_glyph_path(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_glyph_t_(glyphs), Xen_to_C_int(num_glyphs));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_face_reference(XEN font_face)
+static Xen gxg_cairo_font_face_reference(Xen font_face)
{
#define H_cairo_font_face_reference "cairo_font_face_t* cairo_font_face_reference(cairo_font_face_t* font_face)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_font_face_reference", "cairo_font_face_t*");
- return(C_TO_XEN_cairo_font_face_t_(cairo_font_face_reference(XEN_TO_C_cairo_font_face_t_(font_face))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_font_face_reference", "cairo_font_face_t*");
+ return(C_to_Xen_cairo_font_face_t_(cairo_font_face_reference(Xen_to_C_cairo_font_face_t_(font_face))));
}
-static XEN gxg_cairo_font_face_destroy(XEN font_face)
+static Xen gxg_cairo_font_face_destroy(Xen font_face)
{
#define H_cairo_font_face_destroy "void cairo_font_face_destroy(cairo_font_face_t* font_face)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_font_face_destroy", "cairo_font_face_t*");
- cairo_font_face_destroy(XEN_TO_C_cairo_font_face_t_(font_face));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_font_face_destroy", "cairo_font_face_t*");
+ cairo_font_face_destroy(Xen_to_C_cairo_font_face_t_(font_face));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_face_status(XEN font_face)
+static Xen gxg_cairo_font_face_status(Xen font_face)
{
#define H_cairo_font_face_status "cairo_status_t cairo_font_face_status(cairo_font_face_t* font_face)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_font_face_status", "cairo_font_face_t*");
- return(C_TO_XEN_cairo_status_t(cairo_font_face_status(XEN_TO_C_cairo_font_face_t_(font_face))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_font_face_status", "cairo_font_face_t*");
+ return(C_to_Xen_cairo_status_t(cairo_font_face_status(Xen_to_C_cairo_font_face_t_(font_face))));
}
-static XEN gxg_cairo_font_face_get_user_data(XEN font_face, XEN key)
+static Xen gxg_cairo_font_face_get_user_data(Xen font_face, Xen key)
{
#define H_cairo_font_face_get_user_data "gpointer cairo_font_face_get_user_data(cairo_font_face_t* font_face, \
cairo_user_data_key_t* key)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_font_face_get_user_data", "cairo_font_face_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_font_face_get_user_data", "cairo_user_data_key_t*");
- return(C_TO_XEN_gpointer(cairo_font_face_get_user_data(XEN_TO_C_cairo_font_face_t_(font_face), XEN_TO_C_cairo_user_data_key_t_(key))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_font_face_get_user_data", "cairo_font_face_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_font_face_get_user_data", "cairo_user_data_key_t*");
+ return(C_to_Xen_gpointer(cairo_font_face_get_user_data(Xen_to_C_cairo_font_face_t_(font_face), Xen_to_C_cairo_user_data_key_t_(key))));
}
-static XEN gxg_cairo_font_face_set_user_data(XEN font_face, XEN key, XEN user_data, XEN destroy)
+static Xen gxg_cairo_font_face_set_user_data(Xen font_face, Xen key, Xen user_data, Xen destroy)
{
#define H_cairo_font_face_set_user_data "cairo_status_t cairo_font_face_set_user_data(cairo_font_face_t* font_face, \
cairo_user_data_key_t* key, gpointer user_data, cairo_destroy_func_t destroy)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_font_face_set_user_data", "cairo_font_face_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_font_face_set_user_data", "cairo_user_data_key_t*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 3, "cairo_font_face_set_user_data", "gpointer");
- XEN_ASSERT_TYPE(XEN_cairo_destroy_func_t_P(destroy), destroy, 4, "cairo_font_face_set_user_data", "cairo_destroy_func_t");
- return(C_TO_XEN_cairo_status_t(cairo_font_face_set_user_data(XEN_TO_C_cairo_font_face_t_(font_face), XEN_TO_C_cairo_user_data_key_t_(key),
- XEN_TO_C_gpointer(user_data), XEN_TO_C_cairo_destroy_func_t(destroy))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_font_face_set_user_data", "cairo_font_face_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_font_face_set_user_data", "cairo_user_data_key_t*");
+ Xen_check_type(Xen_is_gpointer(user_data), user_data, 3, "cairo_font_face_set_user_data", "gpointer");
+ Xen_check_type(Xen_is_cairo_destroy_func_t(destroy), destroy, 4, "cairo_font_face_set_user_data", "cairo_destroy_func_t");
+ return(C_to_Xen_cairo_status_t(cairo_font_face_set_user_data(Xen_to_C_cairo_font_face_t_(font_face), Xen_to_C_cairo_user_data_key_t_(key),
+ Xen_to_C_gpointer(user_data), Xen_to_C_cairo_destroy_func_t(destroy))));
}
-static XEN gxg_cairo_scaled_font_create(XEN font_face, XEN font_matrix, XEN ctm, XEN options)
+static Xen gxg_cairo_scaled_font_create(Xen font_face, Xen font_matrix, Xen ctm, Xen options)
{
#define H_cairo_scaled_font_create "cairo_scaled_font_t* cairo_scaled_font_create(cairo_font_face_t* font_face, \
cairo_matrix_t* font_matrix, cairo_matrix_t* ctm, cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_scaled_font_create", "cairo_font_face_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(font_matrix), font_matrix, 2, "cairo_scaled_font_create", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(ctm), ctm, 3, "cairo_scaled_font_create", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 4, "cairo_scaled_font_create", "cairo_font_options_t*");
- return(C_TO_XEN_cairo_scaled_font_t_(cairo_scaled_font_create(XEN_TO_C_cairo_font_face_t_(font_face), XEN_TO_C_cairo_matrix_t_(font_matrix),
- XEN_TO_C_cairo_matrix_t_(ctm), XEN_TO_C_cairo_font_options_t_(options))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_scaled_font_create", "cairo_font_face_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(font_matrix), font_matrix, 2, "cairo_scaled_font_create", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(ctm), ctm, 3, "cairo_scaled_font_create", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 4, "cairo_scaled_font_create", "cairo_font_options_t*");
+ return(C_to_Xen_cairo_scaled_font_t_(cairo_scaled_font_create(Xen_to_C_cairo_font_face_t_(font_face), Xen_to_C_cairo_matrix_t_(font_matrix),
+ Xen_to_C_cairo_matrix_t_(ctm), Xen_to_C_cairo_font_options_t_(options))));
}
-static XEN gxg_cairo_scaled_font_reference(XEN scaled_font)
+static Xen gxg_cairo_scaled_font_reference(Xen scaled_font)
{
#define H_cairo_scaled_font_reference "cairo_scaled_font_t* cairo_scaled_font_reference(cairo_scaled_font_t* scaled_font)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_reference", "cairo_scaled_font_t*");
- return(C_TO_XEN_cairo_scaled_font_t_(cairo_scaled_font_reference(XEN_TO_C_cairo_scaled_font_t_(scaled_font))));
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_reference", "cairo_scaled_font_t*");
+ return(C_to_Xen_cairo_scaled_font_t_(cairo_scaled_font_reference(Xen_to_C_cairo_scaled_font_t_(scaled_font))));
}
-static XEN gxg_cairo_scaled_font_destroy(XEN scaled_font)
+static Xen gxg_cairo_scaled_font_destroy(Xen scaled_font)
{
#define H_cairo_scaled_font_destroy "void cairo_scaled_font_destroy(cairo_scaled_font_t* scaled_font)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_destroy", "cairo_scaled_font_t*");
- cairo_scaled_font_destroy(XEN_TO_C_cairo_scaled_font_t_(scaled_font));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_destroy", "cairo_scaled_font_t*");
+ cairo_scaled_font_destroy(Xen_to_C_cairo_scaled_font_t_(scaled_font));
+ return(Xen_false);
}
-static XEN gxg_cairo_scaled_font_status(XEN scaled_font)
+static Xen gxg_cairo_scaled_font_status(Xen scaled_font)
{
#define H_cairo_scaled_font_status "cairo_status_t cairo_scaled_font_status(cairo_scaled_font_t* scaled_font)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_status", "cairo_scaled_font_t*");
- return(C_TO_XEN_cairo_status_t(cairo_scaled_font_status(XEN_TO_C_cairo_scaled_font_t_(scaled_font))));
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_status", "cairo_scaled_font_t*");
+ return(C_to_Xen_cairo_status_t(cairo_scaled_font_status(Xen_to_C_cairo_scaled_font_t_(scaled_font))));
}
-static XEN gxg_cairo_scaled_font_extents(XEN scaled_font, XEN extents)
+static Xen gxg_cairo_scaled_font_extents(Xen scaled_font, Xen extents)
{
#define H_cairo_scaled_font_extents "void cairo_scaled_font_extents(cairo_scaled_font_t* scaled_font, \
cairo_font_extents_t* extents)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_extents", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_extents_t__P(extents), extents, 2, "cairo_scaled_font_extents", "cairo_font_extents_t*");
- cairo_scaled_font_extents(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_cairo_font_extents_t_(extents));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_extents", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_cairo_font_extents_t_(extents), extents, 2, "cairo_scaled_font_extents", "cairo_font_extents_t*");
+ cairo_scaled_font_extents(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_cairo_font_extents_t_(extents));
+ return(Xen_false);
}
-static XEN gxg_cairo_scaled_font_text_extents(XEN scaled_font, XEN utf8, XEN extents)
+static Xen gxg_cairo_scaled_font_text_extents(Xen scaled_font, Xen utf8, Xen extents)
{
#define H_cairo_scaled_font_text_extents "void cairo_scaled_font_text_extents(cairo_scaled_font_t* scaled_font, \
char* utf8, cairo_text_extents_t* extents)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_text_extents", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_char__P(utf8), utf8, 2, "cairo_scaled_font_text_extents", "char*");
- XEN_ASSERT_TYPE(XEN_cairo_text_extents_t__P(extents), extents, 3, "cairo_scaled_font_text_extents", "cairo_text_extents_t*");
- cairo_scaled_font_text_extents(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_char_(utf8), XEN_TO_C_cairo_text_extents_t_(extents));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_text_extents", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_char_(utf8), utf8, 2, "cairo_scaled_font_text_extents", "char*");
+ Xen_check_type(Xen_is_cairo_text_extents_t_(extents), extents, 3, "cairo_scaled_font_text_extents", "cairo_text_extents_t*");
+ cairo_scaled_font_text_extents(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_char_(utf8), Xen_to_C_cairo_text_extents_t_(extents));
+ return(Xen_false);
}
-static XEN gxg_cairo_scaled_font_glyph_extents(XEN scaled_font, XEN glyphs, XEN num_glyphs, XEN extents)
+static Xen gxg_cairo_scaled_font_glyph_extents(Xen scaled_font, Xen glyphs, Xen num_glyphs, Xen extents)
{
#define H_cairo_scaled_font_glyph_extents "void cairo_scaled_font_glyph_extents(cairo_scaled_font_t* scaled_font, \
cairo_glyph_t* glyphs, int num_glyphs, cairo_text_extents_t* extents)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_glyph_extents", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_cairo_glyph_t__P(glyphs), glyphs, 2, "cairo_scaled_font_glyph_extents", "cairo_glyph_t*");
- XEN_ASSERT_TYPE(XEN_int_P(num_glyphs), num_glyphs, 3, "cairo_scaled_font_glyph_extents", "int");
- XEN_ASSERT_TYPE(XEN_cairo_text_extents_t__P(extents), extents, 4, "cairo_scaled_font_glyph_extents", "cairo_text_extents_t*");
- cairo_scaled_font_glyph_extents(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_cairo_glyph_t_(glyphs), XEN_TO_C_int(num_glyphs),
- XEN_TO_C_cairo_text_extents_t_(extents));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_glyph_extents", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_cairo_glyph_t_(glyphs), glyphs, 2, "cairo_scaled_font_glyph_extents", "cairo_glyph_t*");
+ Xen_check_type(Xen_is_int(num_glyphs), num_glyphs, 3, "cairo_scaled_font_glyph_extents", "int");
+ Xen_check_type(Xen_is_cairo_text_extents_t_(extents), extents, 4, "cairo_scaled_font_glyph_extents", "cairo_text_extents_t*");
+ cairo_scaled_font_glyph_extents(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_cairo_glyph_t_(glyphs), Xen_to_C_int(num_glyphs),
+ Xen_to_C_cairo_text_extents_t_(extents));
+ return(Xen_false);
}
-static XEN gxg_cairo_scaled_font_get_font_face(XEN scaled_font)
+static Xen gxg_cairo_scaled_font_get_font_face(Xen scaled_font)
{
#define H_cairo_scaled_font_get_font_face "cairo_font_face_t* cairo_scaled_font_get_font_face(cairo_scaled_font_t* scaled_font)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_get_font_face", "cairo_scaled_font_t*");
- return(C_TO_XEN_cairo_font_face_t_(cairo_scaled_font_get_font_face(XEN_TO_C_cairo_scaled_font_t_(scaled_font))));
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_get_font_face", "cairo_scaled_font_t*");
+ return(C_to_Xen_cairo_font_face_t_(cairo_scaled_font_get_font_face(Xen_to_C_cairo_scaled_font_t_(scaled_font))));
}
-static XEN gxg_cairo_scaled_font_get_font_matrix(XEN scaled_font, XEN font_matrix)
+static Xen gxg_cairo_scaled_font_get_font_matrix(Xen scaled_font, Xen font_matrix)
{
#define H_cairo_scaled_font_get_font_matrix "void cairo_scaled_font_get_font_matrix(cairo_scaled_font_t* scaled_font, \
cairo_matrix_t* font_matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_get_font_matrix", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(font_matrix), font_matrix, 2, "cairo_scaled_font_get_font_matrix", "cairo_matrix_t*");
- cairo_scaled_font_get_font_matrix(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_cairo_matrix_t_(font_matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_get_font_matrix", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(font_matrix), font_matrix, 2, "cairo_scaled_font_get_font_matrix", "cairo_matrix_t*");
+ cairo_scaled_font_get_font_matrix(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_cairo_matrix_t_(font_matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_scaled_font_get_ctm(XEN scaled_font, XEN ctm)
+static Xen gxg_cairo_scaled_font_get_ctm(Xen scaled_font, Xen ctm)
{
#define H_cairo_scaled_font_get_ctm "void cairo_scaled_font_get_ctm(cairo_scaled_font_t* scaled_font, \
cairo_matrix_t* ctm)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_get_ctm", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(ctm), ctm, 2, "cairo_scaled_font_get_ctm", "cairo_matrix_t*");
- cairo_scaled_font_get_ctm(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_cairo_matrix_t_(ctm));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_get_ctm", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(ctm), ctm, 2, "cairo_scaled_font_get_ctm", "cairo_matrix_t*");
+ cairo_scaled_font_get_ctm(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_cairo_matrix_t_(ctm));
+ return(Xen_false);
}
-static XEN gxg_cairo_scaled_font_get_font_options(XEN scaled_font, XEN options)
+static Xen gxg_cairo_scaled_font_get_font_options(Xen scaled_font, Xen options)
{
#define H_cairo_scaled_font_get_font_options "void cairo_scaled_font_get_font_options(cairo_scaled_font_t* scaled_font, \
cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_get_font_options", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 2, "cairo_scaled_font_get_font_options", "cairo_font_options_t*");
- cairo_scaled_font_get_font_options(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_cairo_font_options_t_(options));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_get_font_options", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 2, "cairo_scaled_font_get_font_options", "cairo_font_options_t*");
+ cairo_scaled_font_get_font_options(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_cairo_font_options_t_(options));
+ return(Xen_false);
}
-static XEN gxg_cairo_get_operator(XEN cr)
+static Xen gxg_cairo_get_operator(Xen cr)
{
#define H_cairo_get_operator "cairo_operator_t cairo_get_operator(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_operator", "cairo_t*");
- return(C_TO_XEN_cairo_operator_t(cairo_get_operator(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_operator", "cairo_t*");
+ return(C_to_Xen_cairo_operator_t(cairo_get_operator(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_source(XEN cr)
+static Xen gxg_cairo_get_source(Xen cr)
{
#define H_cairo_get_source "cairo_pattern_t* cairo_get_source(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_source", "cairo_t*");
- return(C_TO_XEN_cairo_pattern_t_(cairo_get_source(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_source", "cairo_t*");
+ return(C_to_Xen_cairo_pattern_t_(cairo_get_source(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_tolerance(XEN cr)
+static Xen gxg_cairo_get_tolerance(Xen cr)
{
#define H_cairo_get_tolerance "gdouble cairo_get_tolerance(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_tolerance", "cairo_t*");
- return(C_TO_XEN_gdouble(cairo_get_tolerance(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_tolerance", "cairo_t*");
+ return(C_to_Xen_gdouble(cairo_get_tolerance(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_antialias(XEN cr)
+static Xen gxg_cairo_get_antialias(Xen cr)
{
#define H_cairo_get_antialias "cairo_antialias_t cairo_get_antialias(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_antialias", "cairo_t*");
- return(C_TO_XEN_cairo_antialias_t(cairo_get_antialias(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_antialias", "cairo_t*");
+ return(C_to_Xen_cairo_antialias_t(cairo_get_antialias(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_current_point(XEN cr, XEN ignore_x, XEN ignore_y)
+static Xen gxg_cairo_get_current_point(Xen cr, Xen ignore_x, Xen ignore_y)
{
#define H_cairo_get_current_point "void cairo_get_current_point(cairo_t* cr, gdouble* [x], gdouble* [y])"
gdouble ref_x;
gdouble ref_y;
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_current_point", "cairo_t*");
- cairo_get_current_point(XEN_TO_C_cairo_t_(cr), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_x), C_TO_XEN_gdouble(ref_y)));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_current_point", "cairo_t*");
+ cairo_get_current_point(Xen_to_C_cairo_t_(cr), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
}
-static XEN gxg_cairo_get_fill_rule(XEN cr)
+static Xen gxg_cairo_get_fill_rule(Xen cr)
{
#define H_cairo_get_fill_rule "cairo_fill_rule_t cairo_get_fill_rule(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_fill_rule", "cairo_t*");
- return(C_TO_XEN_cairo_fill_rule_t(cairo_get_fill_rule(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_fill_rule", "cairo_t*");
+ return(C_to_Xen_cairo_fill_rule_t(cairo_get_fill_rule(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_line_width(XEN cr)
+static Xen gxg_cairo_get_line_width(Xen cr)
{
#define H_cairo_get_line_width "gdouble cairo_get_line_width(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_line_width", "cairo_t*");
- return(C_TO_XEN_gdouble(cairo_get_line_width(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_line_width", "cairo_t*");
+ return(C_to_Xen_gdouble(cairo_get_line_width(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_line_cap(XEN cr)
+static Xen gxg_cairo_get_line_cap(Xen cr)
{
#define H_cairo_get_line_cap "cairo_line_cap_t cairo_get_line_cap(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_line_cap", "cairo_t*");
- return(C_TO_XEN_cairo_line_cap_t(cairo_get_line_cap(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_line_cap", "cairo_t*");
+ return(C_to_Xen_cairo_line_cap_t(cairo_get_line_cap(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_line_join(XEN cr)
+static Xen gxg_cairo_get_line_join(Xen cr)
{
#define H_cairo_get_line_join "cairo_line_join_t cairo_get_line_join(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_line_join", "cairo_t*");
- return(C_TO_XEN_cairo_line_join_t(cairo_get_line_join(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_line_join", "cairo_t*");
+ return(C_to_Xen_cairo_line_join_t(cairo_get_line_join(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_miter_limit(XEN cr)
+static Xen gxg_cairo_get_miter_limit(Xen cr)
{
#define H_cairo_get_miter_limit "gdouble cairo_get_miter_limit(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_miter_limit", "cairo_t*");
- return(C_TO_XEN_gdouble(cairo_get_miter_limit(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_miter_limit", "cairo_t*");
+ return(C_to_Xen_gdouble(cairo_get_miter_limit(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_matrix(XEN cr, XEN matrix)
+static Xen gxg_cairo_get_matrix(Xen cr, Xen matrix)
{
#define H_cairo_get_matrix "void cairo_get_matrix(cairo_t* cr, cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_matrix", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 2, "cairo_get_matrix", "cairo_matrix_t*");
- cairo_get_matrix(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_matrix_t_(matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_matrix", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 2, "cairo_get_matrix", "cairo_matrix_t*");
+ cairo_get_matrix(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_matrix_t_(matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_get_target(XEN cr)
+static Xen gxg_cairo_get_target(Xen cr)
{
#define H_cairo_get_target "cairo_surface_t* cairo_get_target(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_target", "cairo_t*");
- return(C_TO_XEN_cairo_surface_t_(cairo_get_target(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_target", "cairo_t*");
+ return(C_to_Xen_cairo_surface_t_(cairo_get_target(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_group_target(XEN cr)
+static Xen gxg_cairo_get_group_target(Xen cr)
{
#define H_cairo_get_group_target "cairo_surface_t* cairo_get_group_target(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_group_target", "cairo_t*");
- return(C_TO_XEN_cairo_surface_t_(cairo_get_group_target(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_group_target", "cairo_t*");
+ return(C_to_Xen_cairo_surface_t_(cairo_get_group_target(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_copy_path(XEN cr)
+static Xen gxg_cairo_copy_path(Xen cr)
{
#define H_cairo_copy_path "cairo_path_t* cairo_copy_path(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_copy_path", "cairo_t*");
- return(C_TO_XEN_cairo_path_t_(cairo_copy_path(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_copy_path", "cairo_t*");
+ return(C_to_Xen_cairo_path_t_(cairo_copy_path(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_copy_path_flat(XEN cr)
+static Xen gxg_cairo_copy_path_flat(Xen cr)
{
#define H_cairo_copy_path_flat "cairo_path_t* cairo_copy_path_flat(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_copy_path_flat", "cairo_t*");
- return(C_TO_XEN_cairo_path_t_(cairo_copy_path_flat(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_copy_path_flat", "cairo_t*");
+ return(C_to_Xen_cairo_path_t_(cairo_copy_path_flat(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_append_path(XEN cr, XEN path)
+static Xen gxg_cairo_append_path(Xen cr, Xen path)
{
#define H_cairo_append_path "void cairo_append_path(cairo_t* cr, cairo_path_t* path)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_append_path", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_path_t__P(path), path, 2, "cairo_append_path", "cairo_path_t*");
- cairo_append_path(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_path_t_(path));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_append_path", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_path_t_(path), path, 2, "cairo_append_path", "cairo_path_t*");
+ cairo_append_path(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_path_t_(path));
+ return(Xen_false);
}
-static XEN gxg_cairo_path_destroy(XEN path)
+static Xen gxg_cairo_path_destroy(Xen path)
{
#define H_cairo_path_destroy "void cairo_path_destroy(cairo_path_t* path)"
- XEN_ASSERT_TYPE(XEN_cairo_path_t__P(path), path, 1, "cairo_path_destroy", "cairo_path_t*");
- cairo_path_destroy(XEN_TO_C_cairo_path_t_(path));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_path_t_(path), path, 1, "cairo_path_destroy", "cairo_path_t*");
+ cairo_path_destroy(Xen_to_C_cairo_path_t_(path));
+ return(Xen_false);
}
-static XEN gxg_cairo_status(XEN cr)
+static Xen gxg_cairo_status(Xen cr)
{
#define H_cairo_status "cairo_status_t cairo_status(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_status", "cairo_t*");
- return(C_TO_XEN_cairo_status_t(cairo_status(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_status", "cairo_t*");
+ return(C_to_Xen_cairo_status_t(cairo_status(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_status_to_string(XEN status)
+static Xen gxg_cairo_status_to_string(Xen status)
{
#define H_cairo_status_to_string "char* cairo_status_to_string(cairo_status_t status)"
- XEN_ASSERT_TYPE(XEN_cairo_status_t_P(status), status, 1, "cairo_status_to_string", "cairo_status_t");
- return(C_TO_XEN_char_(cairo_status_to_string(XEN_TO_C_cairo_status_t(status))));
+ Xen_check_type(Xen_is_cairo_status_t(status), status, 1, "cairo_status_to_string", "cairo_status_t");
+ return(C_to_Xen_char_(cairo_status_to_string(Xen_to_C_cairo_status_t(status))));
}
-static XEN gxg_cairo_surface_create_similar(XEN other, XEN content, XEN width, XEN height)
+static Xen gxg_cairo_surface_create_similar(Xen other, Xen content, Xen width, Xen height)
{
#define H_cairo_surface_create_similar "cairo_surface_t* cairo_surface_create_similar(cairo_surface_t* other, \
cairo_content_t content, int width, int height)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(other), other, 1, "cairo_surface_create_similar", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_cairo_content_t_P(content), content, 2, "cairo_surface_create_similar", "cairo_content_t");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 3, "cairo_surface_create_similar", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 4, "cairo_surface_create_similar", "int");
- return(C_TO_XEN_cairo_surface_t_(cairo_surface_create_similar(XEN_TO_C_cairo_surface_t_(other), XEN_TO_C_cairo_content_t(content),
- XEN_TO_C_int(width), XEN_TO_C_int(height))));
+ Xen_check_type(Xen_is_cairo_surface_t_(other), other, 1, "cairo_surface_create_similar", "cairo_surface_t*");
+ Xen_check_type(Xen_is_cairo_content_t(content), content, 2, "cairo_surface_create_similar", "cairo_content_t");
+ Xen_check_type(Xen_is_int(width), width, 3, "cairo_surface_create_similar", "int");
+ Xen_check_type(Xen_is_int(height), height, 4, "cairo_surface_create_similar", "int");
+ return(C_to_Xen_cairo_surface_t_(cairo_surface_create_similar(Xen_to_C_cairo_surface_t_(other), Xen_to_C_cairo_content_t(content),
+ Xen_to_C_int(width), Xen_to_C_int(height))));
}
-static XEN gxg_cairo_surface_reference(XEN surface)
+static Xen gxg_cairo_surface_reference(Xen surface)
{
#define H_cairo_surface_reference "cairo_surface_t* cairo_surface_reference(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_reference", "cairo_surface_t*");
- return(C_TO_XEN_cairo_surface_t_(cairo_surface_reference(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_reference", "cairo_surface_t*");
+ return(C_to_Xen_cairo_surface_t_(cairo_surface_reference(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_surface_finish(XEN surface)
+static Xen gxg_cairo_surface_finish(Xen surface)
{
#define H_cairo_surface_finish "void cairo_surface_finish(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_finish", "cairo_surface_t*");
- cairo_surface_finish(XEN_TO_C_cairo_surface_t_(surface));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_finish", "cairo_surface_t*");
+ cairo_surface_finish(Xen_to_C_cairo_surface_t_(surface));
+ return(Xen_false);
}
-static XEN gxg_cairo_surface_destroy(XEN surface)
+static Xen gxg_cairo_surface_destroy(Xen surface)
{
#define H_cairo_surface_destroy "void cairo_surface_destroy(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_destroy", "cairo_surface_t*");
- cairo_surface_destroy(XEN_TO_C_cairo_surface_t_(surface));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_destroy", "cairo_surface_t*");
+ cairo_surface_destroy(Xen_to_C_cairo_surface_t_(surface));
+ return(Xen_false);
}
-static XEN gxg_cairo_surface_status(XEN surface)
+static Xen gxg_cairo_surface_status(Xen surface)
{
#define H_cairo_surface_status "cairo_status_t cairo_surface_status(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_status", "cairo_surface_t*");
- return(C_TO_XEN_cairo_status_t(cairo_surface_status(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_status", "cairo_surface_t*");
+ return(C_to_Xen_cairo_status_t(cairo_surface_status(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_surface_get_content(XEN surface)
+static Xen gxg_cairo_surface_get_content(Xen surface)
{
#define H_cairo_surface_get_content "cairo_content_t cairo_surface_get_content(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_get_content", "cairo_surface_t*");
- return(C_TO_XEN_cairo_content_t(cairo_surface_get_content(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_get_content", "cairo_surface_t*");
+ return(C_to_Xen_cairo_content_t(cairo_surface_get_content(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_surface_get_user_data(XEN surface, XEN key)
+static Xen gxg_cairo_surface_get_user_data(Xen surface, Xen key)
{
#define H_cairo_surface_get_user_data "gpointer cairo_surface_get_user_data(cairo_surface_t* surface, \
cairo_user_data_key_t* key)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_get_user_data", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_surface_get_user_data", "cairo_user_data_key_t*");
- return(C_TO_XEN_gpointer(cairo_surface_get_user_data(XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_cairo_user_data_key_t_(key))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_get_user_data", "cairo_surface_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_surface_get_user_data", "cairo_user_data_key_t*");
+ return(C_to_Xen_gpointer(cairo_surface_get_user_data(Xen_to_C_cairo_surface_t_(surface), Xen_to_C_cairo_user_data_key_t_(key))));
}
-static XEN gxg_cairo_surface_set_user_data(XEN surface, XEN key, XEN user_data, XEN destroy)
+static Xen gxg_cairo_surface_set_user_data(Xen surface, Xen key, Xen user_data, Xen destroy)
{
#define H_cairo_surface_set_user_data "cairo_status_t cairo_surface_set_user_data(cairo_surface_t* surface, \
cairo_user_data_key_t* key, gpointer user_data, cairo_destroy_func_t destroy)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_set_user_data", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_surface_set_user_data", "cairo_user_data_key_t*");
- XEN_ASSERT_TYPE(XEN_gpointer_P(user_data), user_data, 3, "cairo_surface_set_user_data", "gpointer");
- XEN_ASSERT_TYPE(XEN_cairo_destroy_func_t_P(destroy), destroy, 4, "cairo_surface_set_user_data", "cairo_destroy_func_t");
- return(C_TO_XEN_cairo_status_t(cairo_surface_set_user_data(XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_cairo_user_data_key_t_(key),
- XEN_TO_C_gpointer(user_data), XEN_TO_C_cairo_destroy_func_t(destroy))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_set_user_data", "cairo_surface_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_surface_set_user_data", "cairo_user_data_key_t*");
+ Xen_check_type(Xen_is_gpointer(user_data), user_data, 3, "cairo_surface_set_user_data", "gpointer");
+ Xen_check_type(Xen_is_cairo_destroy_func_t(destroy), destroy, 4, "cairo_surface_set_user_data", "cairo_destroy_func_t");
+ return(C_to_Xen_cairo_status_t(cairo_surface_set_user_data(Xen_to_C_cairo_surface_t_(surface), Xen_to_C_cairo_user_data_key_t_(key),
+ Xen_to_C_gpointer(user_data), Xen_to_C_cairo_destroy_func_t(destroy))));
}
-static XEN gxg_cairo_surface_get_font_options(XEN surface, XEN options)
+static Xen gxg_cairo_surface_get_font_options(Xen surface, Xen options)
{
#define H_cairo_surface_get_font_options "void cairo_surface_get_font_options(cairo_surface_t* surface, \
cairo_font_options_t* options)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_get_font_options", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_cairo_font_options_t__P(options), options, 2, "cairo_surface_get_font_options", "cairo_font_options_t*");
- cairo_surface_get_font_options(XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_cairo_font_options_t_(options));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_get_font_options", "cairo_surface_t*");
+ Xen_check_type(Xen_is_cairo_font_options_t_(options), options, 2, "cairo_surface_get_font_options", "cairo_font_options_t*");
+ cairo_surface_get_font_options(Xen_to_C_cairo_surface_t_(surface), Xen_to_C_cairo_font_options_t_(options));
+ return(Xen_false);
}
-static XEN gxg_cairo_surface_flush(XEN surface)
+static Xen gxg_cairo_surface_flush(Xen surface)
{
#define H_cairo_surface_flush "void cairo_surface_flush(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_flush", "cairo_surface_t*");
- cairo_surface_flush(XEN_TO_C_cairo_surface_t_(surface));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_flush", "cairo_surface_t*");
+ cairo_surface_flush(Xen_to_C_cairo_surface_t_(surface));
+ return(Xen_false);
}
-static XEN gxg_cairo_surface_mark_dirty(XEN surface)
+static Xen gxg_cairo_surface_mark_dirty(Xen surface)
{
#define H_cairo_surface_mark_dirty "void cairo_surface_mark_dirty(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_mark_dirty", "cairo_surface_t*");
- cairo_surface_mark_dirty(XEN_TO_C_cairo_surface_t_(surface));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_mark_dirty", "cairo_surface_t*");
+ cairo_surface_mark_dirty(Xen_to_C_cairo_surface_t_(surface));
+ return(Xen_false);
}
-static XEN gxg_cairo_surface_mark_dirty_rectangle(XEN surface, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_cairo_surface_mark_dirty_rectangle(Xen surface, Xen x, Xen y, Xen width, Xen height)
{
#define H_cairo_surface_mark_dirty_rectangle "void cairo_surface_mark_dirty_rectangle(cairo_surface_t* surface, \
int x, int y, int width, int height)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_mark_dirty_rectangle", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 2, "cairo_surface_mark_dirty_rectangle", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 3, "cairo_surface_mark_dirty_rectangle", "int");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 4, "cairo_surface_mark_dirty_rectangle", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 5, "cairo_surface_mark_dirty_rectangle", "int");
- cairo_surface_mark_dirty_rectangle(XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_int(x), XEN_TO_C_int(y), XEN_TO_C_int(width),
- XEN_TO_C_int(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_mark_dirty_rectangle", "cairo_surface_t*");
+ Xen_check_type(Xen_is_int(x), x, 2, "cairo_surface_mark_dirty_rectangle", "int");
+ Xen_check_type(Xen_is_int(y), y, 3, "cairo_surface_mark_dirty_rectangle", "int");
+ Xen_check_type(Xen_is_int(width), width, 4, "cairo_surface_mark_dirty_rectangle", "int");
+ Xen_check_type(Xen_is_int(height), height, 5, "cairo_surface_mark_dirty_rectangle", "int");
+ cairo_surface_mark_dirty_rectangle(Xen_to_C_cairo_surface_t_(surface), Xen_to_C_int(x), Xen_to_C_int(y), Xen_to_C_int(width),
+ Xen_to_C_int(height));
+ return(Xen_false);
}
-static XEN gxg_cairo_surface_set_device_offset(XEN surface, XEN x_offset, XEN y_offset)
+static Xen gxg_cairo_surface_set_device_offset(Xen surface, Xen x_offset, Xen y_offset)
{
#define H_cairo_surface_set_device_offset "void cairo_surface_set_device_offset(cairo_surface_t* surface, \
double x_offset, double y_offset)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_set_device_offset", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x_offset), x_offset, 2, "cairo_surface_set_device_offset", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y_offset), y_offset, 3, "cairo_surface_set_device_offset", "double");
- cairo_surface_set_device_offset(XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_double(x_offset), XEN_TO_C_double(y_offset));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_set_device_offset", "cairo_surface_t*");
+ Xen_check_type(Xen_is_double(x_offset), x_offset, 2, "cairo_surface_set_device_offset", "double");
+ Xen_check_type(Xen_is_double(y_offset), y_offset, 3, "cairo_surface_set_device_offset", "double");
+ cairo_surface_set_device_offset(Xen_to_C_cairo_surface_t_(surface), Xen_to_C_double(x_offset), Xen_to_C_double(y_offset));
+ return(Xen_false);
}
-static XEN gxg_cairo_surface_get_device_offset(XEN surface, XEN ignore_x_offset, XEN ignore_y_offset)
+static Xen gxg_cairo_surface_get_device_offset(Xen surface, Xen ignore_x_offset, Xen ignore_y_offset)
{
#define H_cairo_surface_get_device_offset "void cairo_surface_get_device_offset(cairo_surface_t* surface, \
gdouble* [x_offset], gdouble* [y_offset])"
gdouble ref_x_offset;
gdouble ref_y_offset;
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_get_device_offset", "cairo_surface_t*");
- cairo_surface_get_device_offset(XEN_TO_C_cairo_surface_t_(surface), &ref_x_offset, &ref_y_offset);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_x_offset), C_TO_XEN_gdouble(ref_y_offset)));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_get_device_offset", "cairo_surface_t*");
+ cairo_surface_get_device_offset(Xen_to_C_cairo_surface_t_(surface), &ref_x_offset, &ref_y_offset);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_x_offset), C_to_Xen_gdouble(ref_y_offset)));
}
-static XEN gxg_cairo_surface_set_fallback_resolution(XEN surface, XEN x_pixels_per_inch, XEN y_pixels_per_inch)
+static Xen gxg_cairo_surface_set_fallback_resolution(Xen surface, Xen x_pixels_per_inch, Xen y_pixels_per_inch)
{
#define H_cairo_surface_set_fallback_resolution "void cairo_surface_set_fallback_resolution(cairo_surface_t* surface, \
double x_pixels_per_inch, double y_pixels_per_inch)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_set_fallback_resolution", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x_pixels_per_inch), x_pixels_per_inch, 2, "cairo_surface_set_fallback_resolution", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y_pixels_per_inch), y_pixels_per_inch, 3, "cairo_surface_set_fallback_resolution", "double");
- cairo_surface_set_fallback_resolution(XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_double(x_pixels_per_inch), XEN_TO_C_double(y_pixels_per_inch));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_set_fallback_resolution", "cairo_surface_t*");
+ Xen_check_type(Xen_is_double(x_pixels_per_inch), x_pixels_per_inch, 2, "cairo_surface_set_fallback_resolution", "double");
+ Xen_check_type(Xen_is_double(y_pixels_per_inch), y_pixels_per_inch, 3, "cairo_surface_set_fallback_resolution", "double");
+ cairo_surface_set_fallback_resolution(Xen_to_C_cairo_surface_t_(surface), Xen_to_C_double(x_pixels_per_inch), Xen_to_C_double(y_pixels_per_inch));
+ return(Xen_false);
}
-static XEN gxg_cairo_image_surface_create(XEN format, XEN width, XEN height)
+static Xen gxg_cairo_image_surface_create(Xen format, Xen width, Xen height)
{
#define H_cairo_image_surface_create "cairo_surface_t* cairo_image_surface_create(cairo_format_t format, \
int width, int height)"
- XEN_ASSERT_TYPE(XEN_cairo_format_t_P(format), format, 1, "cairo_image_surface_create", "cairo_format_t");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 2, "cairo_image_surface_create", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 3, "cairo_image_surface_create", "int");
- return(C_TO_XEN_cairo_surface_t_(cairo_image_surface_create(XEN_TO_C_cairo_format_t(format), XEN_TO_C_int(width), XEN_TO_C_int(height))));
+ Xen_check_type(Xen_is_cairo_format_t(format), format, 1, "cairo_image_surface_create", "cairo_format_t");
+ Xen_check_type(Xen_is_int(width), width, 2, "cairo_image_surface_create", "int");
+ Xen_check_type(Xen_is_int(height), height, 3, "cairo_image_surface_create", "int");
+ return(C_to_Xen_cairo_surface_t_(cairo_image_surface_create(Xen_to_C_cairo_format_t(format), Xen_to_C_int(width), Xen_to_C_int(height))));
}
-static XEN gxg_cairo_image_surface_create_for_data(XEN data, XEN format, XEN width, XEN height, XEN stride)
+static Xen gxg_cairo_image_surface_create_for_data(Xen data, Xen format, Xen width, Xen height, Xen stride)
{
#define H_cairo_image_surface_create_for_data "cairo_surface_t* cairo_image_surface_create_for_data(guchar* data, \
cairo_format_t format, int width, int height, int stride)"
- XEN_ASSERT_TYPE(XEN_guchar__P(data), data, 1, "cairo_image_surface_create_for_data", "guchar*");
- XEN_ASSERT_TYPE(XEN_cairo_format_t_P(format), format, 2, "cairo_image_surface_create_for_data", "cairo_format_t");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 3, "cairo_image_surface_create_for_data", "int");
- XEN_ASSERT_TYPE(XEN_int_P(height), height, 4, "cairo_image_surface_create_for_data", "int");
- XEN_ASSERT_TYPE(XEN_int_P(stride), stride, 5, "cairo_image_surface_create_for_data", "int");
- return(C_TO_XEN_cairo_surface_t_(cairo_image_surface_create_for_data(XEN_TO_C_guchar_(data), XEN_TO_C_cairo_format_t(format),
- XEN_TO_C_int(width), XEN_TO_C_int(height), XEN_TO_C_int(stride))));
+ Xen_check_type(Xen_is_guchar_(data), data, 1, "cairo_image_surface_create_for_data", "guchar*");
+ Xen_check_type(Xen_is_cairo_format_t(format), format, 2, "cairo_image_surface_create_for_data", "cairo_format_t");
+ Xen_check_type(Xen_is_int(width), width, 3, "cairo_image_surface_create_for_data", "int");
+ Xen_check_type(Xen_is_int(height), height, 4, "cairo_image_surface_create_for_data", "int");
+ Xen_check_type(Xen_is_int(stride), stride, 5, "cairo_image_surface_create_for_data", "int");
+ return(C_to_Xen_cairo_surface_t_(cairo_image_surface_create_for_data(Xen_to_C_guchar_(data), Xen_to_C_cairo_format_t(format),
+ Xen_to_C_int(width), Xen_to_C_int(height), Xen_to_C_int(stride))));
}
-static XEN gxg_cairo_image_surface_get_data(XEN surface)
+static Xen gxg_cairo_image_surface_get_data(Xen surface)
{
#define H_cairo_image_surface_get_data "guchar* cairo_image_surface_get_data(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_image_surface_get_data", "cairo_surface_t*");
- return(C_TO_XEN_guchar_(cairo_image_surface_get_data(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_image_surface_get_data", "cairo_surface_t*");
+ return(C_to_Xen_guchar_(cairo_image_surface_get_data(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_image_surface_get_format(XEN surface)
+static Xen gxg_cairo_image_surface_get_format(Xen surface)
{
#define H_cairo_image_surface_get_format "cairo_format_t cairo_image_surface_get_format(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_image_surface_get_format", "cairo_surface_t*");
- return(C_TO_XEN_cairo_format_t(cairo_image_surface_get_format(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_image_surface_get_format", "cairo_surface_t*");
+ return(C_to_Xen_cairo_format_t(cairo_image_surface_get_format(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_image_surface_get_width(XEN surface)
+static Xen gxg_cairo_image_surface_get_width(Xen surface)
{
#define H_cairo_image_surface_get_width "int cairo_image_surface_get_width(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_image_surface_get_width", "cairo_surface_t*");
- return(C_TO_XEN_int(cairo_image_surface_get_width(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_image_surface_get_width", "cairo_surface_t*");
+ return(C_to_Xen_int(cairo_image_surface_get_width(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_image_surface_get_height(XEN surface)
+static Xen gxg_cairo_image_surface_get_height(Xen surface)
{
#define H_cairo_image_surface_get_height "int cairo_image_surface_get_height(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_image_surface_get_height", "cairo_surface_t*");
- return(C_TO_XEN_int(cairo_image_surface_get_height(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_image_surface_get_height", "cairo_surface_t*");
+ return(C_to_Xen_int(cairo_image_surface_get_height(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_image_surface_get_stride(XEN surface)
+static Xen gxg_cairo_image_surface_get_stride(Xen surface)
{
#define H_cairo_image_surface_get_stride "int cairo_image_surface_get_stride(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_image_surface_get_stride", "cairo_surface_t*");
- return(C_TO_XEN_int(cairo_image_surface_get_stride(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_image_surface_get_stride", "cairo_surface_t*");
+ return(C_to_Xen_int(cairo_image_surface_get_stride(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_pattern_create_rgb(XEN red, XEN green, XEN blue)
+static Xen gxg_cairo_pattern_create_rgb(Xen red, Xen green, Xen blue)
{
#define H_cairo_pattern_create_rgb "cairo_pattern_t* cairo_pattern_create_rgb(double red, double green, \
double blue)"
- XEN_ASSERT_TYPE(XEN_double_P(red), red, 1, "cairo_pattern_create_rgb", "double");
- XEN_ASSERT_TYPE(XEN_double_P(green), green, 2, "cairo_pattern_create_rgb", "double");
- XEN_ASSERT_TYPE(XEN_double_P(blue), blue, 3, "cairo_pattern_create_rgb", "double");
- return(C_TO_XEN_cairo_pattern_t_(cairo_pattern_create_rgb(XEN_TO_C_double(red), XEN_TO_C_double(green), XEN_TO_C_double(blue))));
+ Xen_check_type(Xen_is_double(red), red, 1, "cairo_pattern_create_rgb", "double");
+ Xen_check_type(Xen_is_double(green), green, 2, "cairo_pattern_create_rgb", "double");
+ Xen_check_type(Xen_is_double(blue), blue, 3, "cairo_pattern_create_rgb", "double");
+ return(C_to_Xen_cairo_pattern_t_(cairo_pattern_create_rgb(Xen_to_C_double(red), Xen_to_C_double(green), Xen_to_C_double(blue))));
}
-static XEN gxg_cairo_pattern_create_rgba(XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_cairo_pattern_create_rgba(Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_cairo_pattern_create_rgba "cairo_pattern_t* cairo_pattern_create_rgba(double red, double green, \
double blue, double alpha)"
- XEN_ASSERT_TYPE(XEN_double_P(red), red, 1, "cairo_pattern_create_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(green), green, 2, "cairo_pattern_create_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(blue), blue, 3, "cairo_pattern_create_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(alpha), alpha, 4, "cairo_pattern_create_rgba", "double");
- return(C_TO_XEN_cairo_pattern_t_(cairo_pattern_create_rgba(XEN_TO_C_double(red), XEN_TO_C_double(green), XEN_TO_C_double(blue),
- XEN_TO_C_double(alpha))));
+ Xen_check_type(Xen_is_double(red), red, 1, "cairo_pattern_create_rgba", "double");
+ Xen_check_type(Xen_is_double(green), green, 2, "cairo_pattern_create_rgba", "double");
+ Xen_check_type(Xen_is_double(blue), blue, 3, "cairo_pattern_create_rgba", "double");
+ Xen_check_type(Xen_is_double(alpha), alpha, 4, "cairo_pattern_create_rgba", "double");
+ return(C_to_Xen_cairo_pattern_t_(cairo_pattern_create_rgba(Xen_to_C_double(red), Xen_to_C_double(green), Xen_to_C_double(blue),
+ Xen_to_C_double(alpha))));
}
-static XEN gxg_cairo_pattern_create_for_surface(XEN surface)
+static Xen gxg_cairo_pattern_create_for_surface(Xen surface)
{
#define H_cairo_pattern_create_for_surface "cairo_pattern_t* cairo_pattern_create_for_surface(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_pattern_create_for_surface", "cairo_surface_t*");
- return(C_TO_XEN_cairo_pattern_t_(cairo_pattern_create_for_surface(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_pattern_create_for_surface", "cairo_surface_t*");
+ return(C_to_Xen_cairo_pattern_t_(cairo_pattern_create_for_surface(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_pattern_create_linear(XEN x0, XEN y0, XEN x1, XEN y1)
+static Xen gxg_cairo_pattern_create_linear(Xen x0, Xen y0, Xen x1, Xen y1)
{
#define H_cairo_pattern_create_linear "cairo_pattern_t* cairo_pattern_create_linear(double x0, double y0, \
double x1, double y1)"
- XEN_ASSERT_TYPE(XEN_double_P(x0), x0, 1, "cairo_pattern_create_linear", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y0), y0, 2, "cairo_pattern_create_linear", "double");
- XEN_ASSERT_TYPE(XEN_double_P(x1), x1, 3, "cairo_pattern_create_linear", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y1), y1, 4, "cairo_pattern_create_linear", "double");
- return(C_TO_XEN_cairo_pattern_t_(cairo_pattern_create_linear(XEN_TO_C_double(x0), XEN_TO_C_double(y0), XEN_TO_C_double(x1),
- XEN_TO_C_double(y1))));
+ Xen_check_type(Xen_is_double(x0), x0, 1, "cairo_pattern_create_linear", "double");
+ Xen_check_type(Xen_is_double(y0), y0, 2, "cairo_pattern_create_linear", "double");
+ Xen_check_type(Xen_is_double(x1), x1, 3, "cairo_pattern_create_linear", "double");
+ Xen_check_type(Xen_is_double(y1), y1, 4, "cairo_pattern_create_linear", "double");
+ return(C_to_Xen_cairo_pattern_t_(cairo_pattern_create_linear(Xen_to_C_double(x0), Xen_to_C_double(y0), Xen_to_C_double(x1),
+ Xen_to_C_double(y1))));
}
-static XEN gxg_cairo_pattern_create_radial(XEN cx0, XEN cy0, XEN radius0, XEN cx1, XEN cy1, XEN radius1)
+static Xen gxg_cairo_pattern_create_radial(Xen cx0, Xen cy0, Xen radius0, Xen cx1, Xen cy1, Xen radius1)
{
#define H_cairo_pattern_create_radial "cairo_pattern_t* cairo_pattern_create_radial(double cx0, double cy0, \
double radius0, double cx1, double cy1, double radius1)"
- XEN_ASSERT_TYPE(XEN_double_P(cx0), cx0, 1, "cairo_pattern_create_radial", "double");
- XEN_ASSERT_TYPE(XEN_double_P(cy0), cy0, 2, "cairo_pattern_create_radial", "double");
- XEN_ASSERT_TYPE(XEN_double_P(radius0), radius0, 3, "cairo_pattern_create_radial", "double");
- XEN_ASSERT_TYPE(XEN_double_P(cx1), cx1, 4, "cairo_pattern_create_radial", "double");
- XEN_ASSERT_TYPE(XEN_double_P(cy1), cy1, 5, "cairo_pattern_create_radial", "double");
- XEN_ASSERT_TYPE(XEN_double_P(radius1), radius1, 6, "cairo_pattern_create_radial", "double");
- return(C_TO_XEN_cairo_pattern_t_(cairo_pattern_create_radial(XEN_TO_C_double(cx0), XEN_TO_C_double(cy0), XEN_TO_C_double(radius0),
- XEN_TO_C_double(cx1), XEN_TO_C_double(cy1), XEN_TO_C_double(radius1))));
+ Xen_check_type(Xen_is_double(cx0), cx0, 1, "cairo_pattern_create_radial", "double");
+ Xen_check_type(Xen_is_double(cy0), cy0, 2, "cairo_pattern_create_radial", "double");
+ Xen_check_type(Xen_is_double(radius0), radius0, 3, "cairo_pattern_create_radial", "double");
+ Xen_check_type(Xen_is_double(cx1), cx1, 4, "cairo_pattern_create_radial", "double");
+ Xen_check_type(Xen_is_double(cy1), cy1, 5, "cairo_pattern_create_radial", "double");
+ Xen_check_type(Xen_is_double(radius1), radius1, 6, "cairo_pattern_create_radial", "double");
+ return(C_to_Xen_cairo_pattern_t_(cairo_pattern_create_radial(Xen_to_C_double(cx0), Xen_to_C_double(cy0), Xen_to_C_double(radius0),
+ Xen_to_C_double(cx1), Xen_to_C_double(cy1), Xen_to_C_double(radius1))));
}
-static XEN gxg_cairo_pattern_reference(XEN pattern)
+static Xen gxg_cairo_pattern_reference(Xen pattern)
{
#define H_cairo_pattern_reference "cairo_pattern_t* cairo_pattern_reference(cairo_pattern_t* pattern)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_reference", "cairo_pattern_t*");
- return(C_TO_XEN_cairo_pattern_t_(cairo_pattern_reference(XEN_TO_C_cairo_pattern_t_(pattern))));
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_reference", "cairo_pattern_t*");
+ return(C_to_Xen_cairo_pattern_t_(cairo_pattern_reference(Xen_to_C_cairo_pattern_t_(pattern))));
}
-static XEN gxg_cairo_pattern_destroy(XEN pattern)
+static Xen gxg_cairo_pattern_destroy(Xen pattern)
{
#define H_cairo_pattern_destroy "void cairo_pattern_destroy(cairo_pattern_t* pattern)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_destroy", "cairo_pattern_t*");
- cairo_pattern_destroy(XEN_TO_C_cairo_pattern_t_(pattern));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_destroy", "cairo_pattern_t*");
+ cairo_pattern_destroy(Xen_to_C_cairo_pattern_t_(pattern));
+ return(Xen_false);
}
-static XEN gxg_cairo_pattern_status(XEN pattern)
+static Xen gxg_cairo_pattern_status(Xen pattern)
{
#define H_cairo_pattern_status "cairo_status_t cairo_pattern_status(cairo_pattern_t* pattern)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_status", "cairo_pattern_t*");
- return(C_TO_XEN_cairo_status_t(cairo_pattern_status(XEN_TO_C_cairo_pattern_t_(pattern))));
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_status", "cairo_pattern_t*");
+ return(C_to_Xen_cairo_status_t(cairo_pattern_status(Xen_to_C_cairo_pattern_t_(pattern))));
}
-static XEN gxg_cairo_pattern_add_color_stop_rgb(XEN pattern, XEN offset, XEN red, XEN green, XEN blue)
+static Xen gxg_cairo_pattern_add_color_stop_rgb(Xen pattern, Xen offset, Xen red, Xen green, Xen blue)
{
#define H_cairo_pattern_add_color_stop_rgb "void cairo_pattern_add_color_stop_rgb(cairo_pattern_t* pattern, \
double offset, double red, double green, double blue)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_add_color_stop_rgb", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_double_P(offset), offset, 2, "cairo_pattern_add_color_stop_rgb", "double");
- XEN_ASSERT_TYPE(XEN_double_P(red), red, 3, "cairo_pattern_add_color_stop_rgb", "double");
- XEN_ASSERT_TYPE(XEN_double_P(green), green, 4, "cairo_pattern_add_color_stop_rgb", "double");
- XEN_ASSERT_TYPE(XEN_double_P(blue), blue, 5, "cairo_pattern_add_color_stop_rgb", "double");
- cairo_pattern_add_color_stop_rgb(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_double(offset), XEN_TO_C_double(red), XEN_TO_C_double(green),
- XEN_TO_C_double(blue));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_add_color_stop_rgb", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_double(offset), offset, 2, "cairo_pattern_add_color_stop_rgb", "double");
+ Xen_check_type(Xen_is_double(red), red, 3, "cairo_pattern_add_color_stop_rgb", "double");
+ Xen_check_type(Xen_is_double(green), green, 4, "cairo_pattern_add_color_stop_rgb", "double");
+ Xen_check_type(Xen_is_double(blue), blue, 5, "cairo_pattern_add_color_stop_rgb", "double");
+ cairo_pattern_add_color_stop_rgb(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_double(offset), Xen_to_C_double(red), Xen_to_C_double(green),
+ Xen_to_C_double(blue));
+ return(Xen_false);
}
-static XEN gxg_cairo_pattern_add_color_stop_rgba(XEN pattern, XEN offset, XEN red, XEN green, XEN blue, XEN alpha)
+static Xen gxg_cairo_pattern_add_color_stop_rgba(Xen pattern, Xen offset, Xen red, Xen green, Xen blue, Xen alpha)
{
#define H_cairo_pattern_add_color_stop_rgba "void cairo_pattern_add_color_stop_rgba(cairo_pattern_t* pattern, \
double offset, double red, double green, double blue, double alpha)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_add_color_stop_rgba", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_double_P(offset), offset, 2, "cairo_pattern_add_color_stop_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(red), red, 3, "cairo_pattern_add_color_stop_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(green), green, 4, "cairo_pattern_add_color_stop_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(blue), blue, 5, "cairo_pattern_add_color_stop_rgba", "double");
- XEN_ASSERT_TYPE(XEN_double_P(alpha), alpha, 6, "cairo_pattern_add_color_stop_rgba", "double");
- cairo_pattern_add_color_stop_rgba(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_double(offset), XEN_TO_C_double(red), XEN_TO_C_double(green),
- XEN_TO_C_double(blue), XEN_TO_C_double(alpha));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_add_color_stop_rgba", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_double(offset), offset, 2, "cairo_pattern_add_color_stop_rgba", "double");
+ Xen_check_type(Xen_is_double(red), red, 3, "cairo_pattern_add_color_stop_rgba", "double");
+ Xen_check_type(Xen_is_double(green), green, 4, "cairo_pattern_add_color_stop_rgba", "double");
+ Xen_check_type(Xen_is_double(blue), blue, 5, "cairo_pattern_add_color_stop_rgba", "double");
+ Xen_check_type(Xen_is_double(alpha), alpha, 6, "cairo_pattern_add_color_stop_rgba", "double");
+ cairo_pattern_add_color_stop_rgba(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_double(offset), Xen_to_C_double(red), Xen_to_C_double(green),
+ Xen_to_C_double(blue), Xen_to_C_double(alpha));
+ return(Xen_false);
}
-static XEN gxg_cairo_pattern_set_matrix(XEN pattern, XEN matrix)
+static Xen gxg_cairo_pattern_set_matrix(Xen pattern, Xen matrix)
{
#define H_cairo_pattern_set_matrix "void cairo_pattern_set_matrix(cairo_pattern_t* pattern, cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_set_matrix", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 2, "cairo_pattern_set_matrix", "cairo_matrix_t*");
- cairo_pattern_set_matrix(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_cairo_matrix_t_(matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_set_matrix", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 2, "cairo_pattern_set_matrix", "cairo_matrix_t*");
+ cairo_pattern_set_matrix(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_cairo_matrix_t_(matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_pattern_get_matrix(XEN pattern, XEN matrix)
+static Xen gxg_cairo_pattern_get_matrix(Xen pattern, Xen matrix)
{
#define H_cairo_pattern_get_matrix "void cairo_pattern_get_matrix(cairo_pattern_t* pattern, cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_matrix", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 2, "cairo_pattern_get_matrix", "cairo_matrix_t*");
- cairo_pattern_get_matrix(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_cairo_matrix_t_(matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_matrix", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 2, "cairo_pattern_get_matrix", "cairo_matrix_t*");
+ cairo_pattern_get_matrix(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_cairo_matrix_t_(matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_pattern_set_extend(XEN pattern, XEN extend)
+static Xen gxg_cairo_pattern_set_extend(Xen pattern, Xen extend)
{
#define H_cairo_pattern_set_extend "void cairo_pattern_set_extend(cairo_pattern_t* pattern, cairo_extend_t extend)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_set_extend", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_cairo_extend_t_P(extend), extend, 2, "cairo_pattern_set_extend", "cairo_extend_t");
- cairo_pattern_set_extend(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_cairo_extend_t(extend));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_set_extend", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_extend_t(extend), extend, 2, "cairo_pattern_set_extend", "cairo_extend_t");
+ cairo_pattern_set_extend(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_cairo_extend_t(extend));
+ return(Xen_false);
}
-static XEN gxg_cairo_pattern_get_extend(XEN pattern)
+static Xen gxg_cairo_pattern_get_extend(Xen pattern)
{
#define H_cairo_pattern_get_extend "cairo_extend_t cairo_pattern_get_extend(cairo_pattern_t* pattern)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_extend", "cairo_pattern_t*");
- return(C_TO_XEN_cairo_extend_t(cairo_pattern_get_extend(XEN_TO_C_cairo_pattern_t_(pattern))));
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_extend", "cairo_pattern_t*");
+ return(C_to_Xen_cairo_extend_t(cairo_pattern_get_extend(Xen_to_C_cairo_pattern_t_(pattern))));
}
-static XEN gxg_cairo_pattern_set_filter(XEN pattern, XEN filter)
+static Xen gxg_cairo_pattern_set_filter(Xen pattern, Xen filter)
{
#define H_cairo_pattern_set_filter "void cairo_pattern_set_filter(cairo_pattern_t* pattern, cairo_filter_t filter)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_set_filter", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_cairo_filter_t_P(filter), filter, 2, "cairo_pattern_set_filter", "cairo_filter_t");
- cairo_pattern_set_filter(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_cairo_filter_t(filter));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_set_filter", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_filter_t(filter), filter, 2, "cairo_pattern_set_filter", "cairo_filter_t");
+ cairo_pattern_set_filter(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_cairo_filter_t(filter));
+ return(Xen_false);
}
-static XEN gxg_cairo_pattern_get_filter(XEN pattern)
+static Xen gxg_cairo_pattern_get_filter(Xen pattern)
{
#define H_cairo_pattern_get_filter "cairo_filter_t cairo_pattern_get_filter(cairo_pattern_t* pattern)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_filter", "cairo_pattern_t*");
- return(C_TO_XEN_cairo_filter_t(cairo_pattern_get_filter(XEN_TO_C_cairo_pattern_t_(pattern))));
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_filter", "cairo_pattern_t*");
+ return(C_to_Xen_cairo_filter_t(cairo_pattern_get_filter(Xen_to_C_cairo_pattern_t_(pattern))));
}
-static XEN gxg_cairo_matrix_init(XEN matrix, XEN xx, XEN yx, XEN xy, XEN yy, XEN x0, XEN y0)
+static Xen gxg_cairo_matrix_init(Xen matrix, Xen xx, Xen yx, Xen xy, Xen yy, Xen x0, Xen y0)
{
#define H_cairo_matrix_init "void cairo_matrix_init(cairo_matrix_t* matrix, double xx, double yx, double xy, \
double yy, double x0, double y0)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_init", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_double_P(xx), xx, 2, "cairo_matrix_init", "double");
- XEN_ASSERT_TYPE(XEN_double_P(yx), yx, 3, "cairo_matrix_init", "double");
- XEN_ASSERT_TYPE(XEN_double_P(xy), xy, 4, "cairo_matrix_init", "double");
- XEN_ASSERT_TYPE(XEN_double_P(yy), yy, 5, "cairo_matrix_init", "double");
- XEN_ASSERT_TYPE(XEN_double_P(x0), x0, 6, "cairo_matrix_init", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y0), y0, 7, "cairo_matrix_init", "double");
- cairo_matrix_init(XEN_TO_C_cairo_matrix_t_(matrix), XEN_TO_C_double(xx), XEN_TO_C_double(yx), XEN_TO_C_double(xy), XEN_TO_C_double(yy),
- XEN_TO_C_double(x0), XEN_TO_C_double(y0));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_init", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_double(xx), xx, 2, "cairo_matrix_init", "double");
+ Xen_check_type(Xen_is_double(yx), yx, 3, "cairo_matrix_init", "double");
+ Xen_check_type(Xen_is_double(xy), xy, 4, "cairo_matrix_init", "double");
+ Xen_check_type(Xen_is_double(yy), yy, 5, "cairo_matrix_init", "double");
+ Xen_check_type(Xen_is_double(x0), x0, 6, "cairo_matrix_init", "double");
+ Xen_check_type(Xen_is_double(y0), y0, 7, "cairo_matrix_init", "double");
+ cairo_matrix_init(Xen_to_C_cairo_matrix_t_(matrix), Xen_to_C_double(xx), Xen_to_C_double(yx), Xen_to_C_double(xy), Xen_to_C_double(yy),
+ Xen_to_C_double(x0), Xen_to_C_double(y0));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_init_identity(XEN matrix)
+static Xen gxg_cairo_matrix_init_identity(Xen matrix)
{
#define H_cairo_matrix_init_identity "void cairo_matrix_init_identity(cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_init_identity", "cairo_matrix_t*");
- cairo_matrix_init_identity(XEN_TO_C_cairo_matrix_t_(matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_init_identity", "cairo_matrix_t*");
+ cairo_matrix_init_identity(Xen_to_C_cairo_matrix_t_(matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_init_translate(XEN matrix, XEN tx, XEN ty)
+static Xen gxg_cairo_matrix_init_translate(Xen matrix, Xen tx, Xen ty)
{
#define H_cairo_matrix_init_translate "void cairo_matrix_init_translate(cairo_matrix_t* matrix, double tx, \
double ty)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_init_translate", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_double_P(tx), tx, 2, "cairo_matrix_init_translate", "double");
- XEN_ASSERT_TYPE(XEN_double_P(ty), ty, 3, "cairo_matrix_init_translate", "double");
- cairo_matrix_init_translate(XEN_TO_C_cairo_matrix_t_(matrix), XEN_TO_C_double(tx), XEN_TO_C_double(ty));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_init_translate", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_double(tx), tx, 2, "cairo_matrix_init_translate", "double");
+ Xen_check_type(Xen_is_double(ty), ty, 3, "cairo_matrix_init_translate", "double");
+ cairo_matrix_init_translate(Xen_to_C_cairo_matrix_t_(matrix), Xen_to_C_double(tx), Xen_to_C_double(ty));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_init_scale(XEN matrix, XEN sx, XEN sy)
+static Xen gxg_cairo_matrix_init_scale(Xen matrix, Xen sx, Xen sy)
{
#define H_cairo_matrix_init_scale "void cairo_matrix_init_scale(cairo_matrix_t* matrix, double sx, \
double sy)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_init_scale", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_double_P(sx), sx, 2, "cairo_matrix_init_scale", "double");
- XEN_ASSERT_TYPE(XEN_double_P(sy), sy, 3, "cairo_matrix_init_scale", "double");
- cairo_matrix_init_scale(XEN_TO_C_cairo_matrix_t_(matrix), XEN_TO_C_double(sx), XEN_TO_C_double(sy));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_init_scale", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_double(sx), sx, 2, "cairo_matrix_init_scale", "double");
+ Xen_check_type(Xen_is_double(sy), sy, 3, "cairo_matrix_init_scale", "double");
+ cairo_matrix_init_scale(Xen_to_C_cairo_matrix_t_(matrix), Xen_to_C_double(sx), Xen_to_C_double(sy));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_init_rotate(XEN matrix, XEN radians)
+static Xen gxg_cairo_matrix_init_rotate(Xen matrix, Xen radians)
{
#define H_cairo_matrix_init_rotate "void cairo_matrix_init_rotate(cairo_matrix_t* matrix, double radians)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_init_rotate", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_double_P(radians), radians, 2, "cairo_matrix_init_rotate", "double");
- cairo_matrix_init_rotate(XEN_TO_C_cairo_matrix_t_(matrix), XEN_TO_C_double(radians));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_init_rotate", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_double(radians), radians, 2, "cairo_matrix_init_rotate", "double");
+ cairo_matrix_init_rotate(Xen_to_C_cairo_matrix_t_(matrix), Xen_to_C_double(radians));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_translate(XEN matrix, XEN tx, XEN ty)
+static Xen gxg_cairo_matrix_translate(Xen matrix, Xen tx, Xen ty)
{
#define H_cairo_matrix_translate "void cairo_matrix_translate(cairo_matrix_t* matrix, double tx, double ty)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_translate", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_double_P(tx), tx, 2, "cairo_matrix_translate", "double");
- XEN_ASSERT_TYPE(XEN_double_P(ty), ty, 3, "cairo_matrix_translate", "double");
- cairo_matrix_translate(XEN_TO_C_cairo_matrix_t_(matrix), XEN_TO_C_double(tx), XEN_TO_C_double(ty));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_translate", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_double(tx), tx, 2, "cairo_matrix_translate", "double");
+ Xen_check_type(Xen_is_double(ty), ty, 3, "cairo_matrix_translate", "double");
+ cairo_matrix_translate(Xen_to_C_cairo_matrix_t_(matrix), Xen_to_C_double(tx), Xen_to_C_double(ty));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_scale(XEN matrix, XEN sx, XEN sy)
+static Xen gxg_cairo_matrix_scale(Xen matrix, Xen sx, Xen sy)
{
#define H_cairo_matrix_scale "void cairo_matrix_scale(cairo_matrix_t* matrix, double sx, double sy)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_scale", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_double_P(sx), sx, 2, "cairo_matrix_scale", "double");
- XEN_ASSERT_TYPE(XEN_double_P(sy), sy, 3, "cairo_matrix_scale", "double");
- cairo_matrix_scale(XEN_TO_C_cairo_matrix_t_(matrix), XEN_TO_C_double(sx), XEN_TO_C_double(sy));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_scale", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_double(sx), sx, 2, "cairo_matrix_scale", "double");
+ Xen_check_type(Xen_is_double(sy), sy, 3, "cairo_matrix_scale", "double");
+ cairo_matrix_scale(Xen_to_C_cairo_matrix_t_(matrix), Xen_to_C_double(sx), Xen_to_C_double(sy));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_rotate(XEN matrix, XEN radians)
+static Xen gxg_cairo_matrix_rotate(Xen matrix, Xen radians)
{
#define H_cairo_matrix_rotate "void cairo_matrix_rotate(cairo_matrix_t* matrix, double radians)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_rotate", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_double_P(radians), radians, 2, "cairo_matrix_rotate", "double");
- cairo_matrix_rotate(XEN_TO_C_cairo_matrix_t_(matrix), XEN_TO_C_double(radians));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_rotate", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_double(radians), radians, 2, "cairo_matrix_rotate", "double");
+ cairo_matrix_rotate(Xen_to_C_cairo_matrix_t_(matrix), Xen_to_C_double(radians));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_invert(XEN matrix)
+static Xen gxg_cairo_matrix_invert(Xen matrix)
{
#define H_cairo_matrix_invert "cairo_status_t cairo_matrix_invert(cairo_matrix_t* matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_invert", "cairo_matrix_t*");
- return(C_TO_XEN_cairo_status_t(cairo_matrix_invert(XEN_TO_C_cairo_matrix_t_(matrix))));
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_invert", "cairo_matrix_t*");
+ return(C_to_Xen_cairo_status_t(cairo_matrix_invert(Xen_to_C_cairo_matrix_t_(matrix))));
}
-static XEN gxg_cairo_matrix_multiply(XEN result, XEN a, XEN b)
+static Xen gxg_cairo_matrix_multiply(Xen result, Xen a, Xen b)
{
#define H_cairo_matrix_multiply "void cairo_matrix_multiply(cairo_matrix_t* result, cairo_matrix_t* a, \
cairo_matrix_t* b)"
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(result), result, 1, "cairo_matrix_multiply", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(a), a, 2, "cairo_matrix_multiply", "cairo_matrix_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(b), b, 3, "cairo_matrix_multiply", "cairo_matrix_t*");
- cairo_matrix_multiply(XEN_TO_C_cairo_matrix_t_(result), XEN_TO_C_cairo_matrix_t_(a), XEN_TO_C_cairo_matrix_t_(b));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_matrix_t_(result), result, 1, "cairo_matrix_multiply", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(a), a, 2, "cairo_matrix_multiply", "cairo_matrix_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(b), b, 3, "cairo_matrix_multiply", "cairo_matrix_t*");
+ cairo_matrix_multiply(Xen_to_C_cairo_matrix_t_(result), Xen_to_C_cairo_matrix_t_(a), Xen_to_C_cairo_matrix_t_(b));
+ return(Xen_false);
}
-static XEN gxg_cairo_matrix_transform_distance(XEN matrix, XEN ignore_dx, XEN ignore_dy)
+static Xen gxg_cairo_matrix_transform_distance(Xen matrix, Xen ignore_dx, Xen ignore_dy)
{
#define H_cairo_matrix_transform_distance "void cairo_matrix_transform_distance(cairo_matrix_t* matrix, \
gdouble* [dx], gdouble* [dy])"
gdouble ref_dx;
gdouble ref_dy;
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_transform_distance", "cairo_matrix_t*");
- cairo_matrix_transform_distance(XEN_TO_C_cairo_matrix_t_(matrix), &ref_dx, &ref_dy);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_dx), C_TO_XEN_gdouble(ref_dy)));
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_transform_distance", "cairo_matrix_t*");
+ cairo_matrix_transform_distance(Xen_to_C_cairo_matrix_t_(matrix), &ref_dx, &ref_dy);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_dx), C_to_Xen_gdouble(ref_dy)));
}
-static XEN gxg_cairo_matrix_transform_point(XEN matrix, XEN ignore_x, XEN ignore_y)
+static Xen gxg_cairo_matrix_transform_point(Xen matrix, Xen ignore_x, Xen ignore_y)
{
#define H_cairo_matrix_transform_point "void cairo_matrix_transform_point(cairo_matrix_t* matrix, gdouble* [x], \
gdouble* [y])"
gdouble ref_x;
gdouble ref_y;
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(matrix), matrix, 1, "cairo_matrix_transform_point", "cairo_matrix_t*");
- cairo_matrix_transform_point(XEN_TO_C_cairo_matrix_t_(matrix), &ref_x, &ref_y);
- return(XEN_LIST_2(C_TO_XEN_gdouble(ref_x), C_TO_XEN_gdouble(ref_y)));
+ Xen_check_type(Xen_is_cairo_matrix_t_(matrix), matrix, 1, "cairo_matrix_transform_point", "cairo_matrix_t*");
+ cairo_matrix_transform_point(Xen_to_C_cairo_matrix_t_(matrix), &ref_x, &ref_y);
+ return(Xen_list_2(C_to_Xen_gdouble(ref_x), C_to_Xen_gdouble(ref_y)));
}
-static XEN gxg_cairo_get_reference_count(XEN cr)
+static Xen gxg_cairo_get_reference_count(Xen cr)
{
#define H_cairo_get_reference_count "guint cairo_get_reference_count(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_reference_count", "cairo_t*");
- return(C_TO_XEN_guint(cairo_get_reference_count(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_reference_count", "cairo_t*");
+ return(C_to_Xen_guint(cairo_get_reference_count(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_user_data(XEN cr, XEN key)
+static Xen gxg_cairo_get_user_data(Xen cr, Xen key)
{
#define H_cairo_get_user_data "void* cairo_get_user_data(cairo_t* cr, cairo_user_data_key_t* key)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_user_data", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_get_user_data", "cairo_user_data_key_t*");
- return(C_TO_XEN_void_(cairo_get_user_data(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_user_data_key_t_(key))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_user_data", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_get_user_data", "cairo_user_data_key_t*");
+ return(C_to_Xen_void_(cairo_get_user_data(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_user_data_key_t_(key))));
}
-static XEN gxg_cairo_set_user_data(XEN cr, XEN key, XEN user_data, XEN destroy)
+static Xen gxg_cairo_set_user_data(Xen cr, Xen key, Xen user_data, Xen destroy)
{
#define H_cairo_set_user_data "cairo_status_t cairo_set_user_data(cairo_t* cr, cairo_user_data_key_t* key, \
void* user_data, cairo_destroy_func_t destroy)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_set_user_data", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_set_user_data", "cairo_user_data_key_t*");
- XEN_ASSERT_TYPE(XEN_void__P(user_data), user_data, 3, "cairo_set_user_data", "void*");
- XEN_ASSERT_TYPE(XEN_cairo_destroy_func_t_P(destroy), destroy, 4, "cairo_set_user_data", "cairo_destroy_func_t");
- return(C_TO_XEN_cairo_status_t(cairo_set_user_data(XEN_TO_C_cairo_t_(cr), XEN_TO_C_cairo_user_data_key_t_(key), XEN_TO_C_void_(user_data),
- XEN_TO_C_cairo_destroy_func_t(destroy))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_set_user_data", "cairo_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_set_user_data", "cairo_user_data_key_t*");
+ Xen_check_type(Xen_is_void_(user_data), user_data, 3, "cairo_set_user_data", "void*");
+ Xen_check_type(Xen_is_cairo_destroy_func_t(destroy), destroy, 4, "cairo_set_user_data", "cairo_destroy_func_t");
+ return(C_to_Xen_cairo_status_t(cairo_set_user_data(Xen_to_C_cairo_t_(cr), Xen_to_C_cairo_user_data_key_t_(key), Xen_to_C_void_(user_data),
+ Xen_to_C_cairo_destroy_func_t(destroy))));
}
-static XEN gxg_cairo_clip_extents(XEN cr, XEN ignore_x1, XEN ignore_y1, XEN ignore_x2, XEN ignore_y2)
+static Xen gxg_cairo_clip_extents(Xen cr, Xen ignore_x1, Xen ignore_y1, Xen ignore_x2, Xen ignore_y2)
{
#define H_cairo_clip_extents "void cairo_clip_extents(cairo_t* cr, double* [x1], double* [y1], double* [x2], \
double* [y2])"
@@ -33551,114 +33761,114 @@ double* [y2])"
double ref_y1;
double ref_x2;
double ref_y2;
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_clip_extents", "cairo_t*");
- cairo_clip_extents(XEN_TO_C_cairo_t_(cr), &ref_x1, &ref_y1, &ref_x2, &ref_y2);
- return(XEN_LIST_4(C_TO_XEN_double(ref_x1), C_TO_XEN_double(ref_y1), C_TO_XEN_double(ref_x2), C_TO_XEN_double(ref_y2)));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_clip_extents", "cairo_t*");
+ cairo_clip_extents(Xen_to_C_cairo_t_(cr), &ref_x1, &ref_y1, &ref_x2, &ref_y2);
+ return(Xen_list_4(C_to_Xen_double(ref_x1), C_to_Xen_double(ref_y1), C_to_Xen_double(ref_x2), C_to_Xen_double(ref_y2)));
}
-static XEN gxg_cairo_copy_clip_rectangle_list(XEN cr)
+static Xen gxg_cairo_copy_clip_rectangle_list(Xen cr)
{
#define H_cairo_copy_clip_rectangle_list "cairo_rectangle_list_t* cairo_copy_clip_rectangle_list(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_copy_clip_rectangle_list", "cairo_t*");
- return(C_TO_XEN_cairo_rectangle_list_t_(cairo_copy_clip_rectangle_list(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_copy_clip_rectangle_list", "cairo_t*");
+ return(C_to_Xen_cairo_rectangle_list_t_(cairo_copy_clip_rectangle_list(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_rectangle_list_destroy(XEN rectangle_list)
+static Xen gxg_cairo_rectangle_list_destroy(Xen rectangle_list)
{
#define H_cairo_rectangle_list_destroy "void cairo_rectangle_list_destroy(cairo_rectangle_list_t* rectangle_list)"
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_list_t__P(rectangle_list), rectangle_list, 1, "cairo_rectangle_list_destroy", "cairo_rectangle_list_t*");
- cairo_rectangle_list_destroy(XEN_TO_C_cairo_rectangle_list_t_(rectangle_list));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_rectangle_list_t_(rectangle_list), rectangle_list, 1, "cairo_rectangle_list_destroy", "cairo_rectangle_list_t*");
+ cairo_rectangle_list_destroy(Xen_to_C_cairo_rectangle_list_t_(rectangle_list));
+ return(Xen_false);
}
-static XEN gxg_cairo_font_face_get_reference_count(XEN font_face)
+static Xen gxg_cairo_font_face_get_reference_count(Xen font_face)
{
#define H_cairo_font_face_get_reference_count "guint cairo_font_face_get_reference_count(cairo_font_face_t* font_face)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_font_face_get_reference_count", "cairo_font_face_t*");
- return(C_TO_XEN_guint(cairo_font_face_get_reference_count(XEN_TO_C_cairo_font_face_t_(font_face))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_font_face_get_reference_count", "cairo_font_face_t*");
+ return(C_to_Xen_guint(cairo_font_face_get_reference_count(Xen_to_C_cairo_font_face_t_(font_face))));
}
-static XEN gxg_cairo_scaled_font_get_reference_count(XEN scaled_font)
+static Xen gxg_cairo_scaled_font_get_reference_count(Xen scaled_font)
{
#define H_cairo_scaled_font_get_reference_count "guint cairo_scaled_font_get_reference_count(cairo_scaled_font_t* scaled_font)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_get_reference_count", "cairo_scaled_font_t*");
- return(C_TO_XEN_guint(cairo_scaled_font_get_reference_count(XEN_TO_C_cairo_scaled_font_t_(scaled_font))));
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_get_reference_count", "cairo_scaled_font_t*");
+ return(C_to_Xen_guint(cairo_scaled_font_get_reference_count(Xen_to_C_cairo_scaled_font_t_(scaled_font))));
}
-static XEN gxg_cairo_scaled_font_get_user_data(XEN scaled_font, XEN key)
+static Xen gxg_cairo_scaled_font_get_user_data(Xen scaled_font, Xen key)
{
#define H_cairo_scaled_font_get_user_data "void* cairo_scaled_font_get_user_data(cairo_scaled_font_t* scaled_font, \
cairo_user_data_key_t* key)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_get_user_data", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_scaled_font_get_user_data", "cairo_user_data_key_t*");
- return(C_TO_XEN_void_(cairo_scaled_font_get_user_data(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_cairo_user_data_key_t_(key))));
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_get_user_data", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_scaled_font_get_user_data", "cairo_user_data_key_t*");
+ return(C_to_Xen_void_(cairo_scaled_font_get_user_data(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_cairo_user_data_key_t_(key))));
}
-static XEN gxg_cairo_scaled_font_set_user_data(XEN scaled_font, XEN key, XEN user_data, XEN destroy)
+static Xen gxg_cairo_scaled_font_set_user_data(Xen scaled_font, Xen key, Xen user_data, Xen destroy)
{
#define H_cairo_scaled_font_set_user_data "cairo_status_t cairo_scaled_font_set_user_data(cairo_scaled_font_t* scaled_font, \
cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_set_user_data", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_scaled_font_set_user_data", "cairo_user_data_key_t*");
- XEN_ASSERT_TYPE(XEN_void__P(user_data), user_data, 3, "cairo_scaled_font_set_user_data", "void*");
- XEN_ASSERT_TYPE(XEN_cairo_destroy_func_t_P(destroy), destroy, 4, "cairo_scaled_font_set_user_data", "cairo_destroy_func_t");
- return(C_TO_XEN_cairo_status_t(cairo_scaled_font_set_user_data(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_cairo_user_data_key_t_(key),
- XEN_TO_C_void_(user_data), XEN_TO_C_cairo_destroy_func_t(destroy))));
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_set_user_data", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_scaled_font_set_user_data", "cairo_user_data_key_t*");
+ Xen_check_type(Xen_is_void_(user_data), user_data, 3, "cairo_scaled_font_set_user_data", "void*");
+ Xen_check_type(Xen_is_cairo_destroy_func_t(destroy), destroy, 4, "cairo_scaled_font_set_user_data", "cairo_destroy_func_t");
+ return(C_to_Xen_cairo_status_t(cairo_scaled_font_set_user_data(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_cairo_user_data_key_t_(key),
+ Xen_to_C_void_(user_data), Xen_to_C_cairo_destroy_func_t(destroy))));
}
-static XEN gxg_cairo_get_dash_count(XEN cr)
+static Xen gxg_cairo_get_dash_count(Xen cr)
{
#define H_cairo_get_dash_count "int cairo_get_dash_count(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_dash_count", "cairo_t*");
- return(C_TO_XEN_int(cairo_get_dash_count(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_dash_count", "cairo_t*");
+ return(C_to_Xen_int(cairo_get_dash_count(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_get_dash(XEN cr, XEN ignore_dashes, XEN ignore_offset)
+static Xen gxg_cairo_get_dash(Xen cr, Xen ignore_dashes, Xen ignore_offset)
{
#define H_cairo_get_dash "void cairo_get_dash(cairo_t* cr, double* [dashes], double* [offset])"
double ref_dashes;
double ref_offset;
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_dash", "cairo_t*");
- cairo_get_dash(XEN_TO_C_cairo_t_(cr), &ref_dashes, &ref_offset);
- return(XEN_LIST_2(C_TO_XEN_double(ref_dashes), C_TO_XEN_double(ref_offset)));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_dash", "cairo_t*");
+ cairo_get_dash(Xen_to_C_cairo_t_(cr), &ref_dashes, &ref_offset);
+ return(Xen_list_2(C_to_Xen_double(ref_dashes), C_to_Xen_double(ref_offset)));
}
-static XEN gxg_cairo_surface_get_reference_count(XEN surface)
+static Xen gxg_cairo_surface_get_reference_count(Xen surface)
{
#define H_cairo_surface_get_reference_count "guint cairo_surface_get_reference_count(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_get_reference_count", "cairo_surface_t*");
- return(C_TO_XEN_guint(cairo_surface_get_reference_count(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_get_reference_count", "cairo_surface_t*");
+ return(C_to_Xen_guint(cairo_surface_get_reference_count(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_pattern_get_reference_count(XEN pattern)
+static Xen gxg_cairo_pattern_get_reference_count(Xen pattern)
{
#define H_cairo_pattern_get_reference_count "guint cairo_pattern_get_reference_count(cairo_pattern_t* pattern)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_reference_count", "cairo_pattern_t*");
- return(C_TO_XEN_guint(cairo_pattern_get_reference_count(XEN_TO_C_cairo_pattern_t_(pattern))));
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_reference_count", "cairo_pattern_t*");
+ return(C_to_Xen_guint(cairo_pattern_get_reference_count(Xen_to_C_cairo_pattern_t_(pattern))));
}
-static XEN gxg_cairo_pattern_get_user_data(XEN pattern, XEN key)
+static Xen gxg_cairo_pattern_get_user_data(Xen pattern, Xen key)
{
#define H_cairo_pattern_get_user_data "void* cairo_pattern_get_user_data(cairo_pattern_t* pattern, \
cairo_user_data_key_t* key)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_user_data", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_pattern_get_user_data", "cairo_user_data_key_t*");
- return(C_TO_XEN_void_(cairo_pattern_get_user_data(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_cairo_user_data_key_t_(key))));
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_user_data", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_pattern_get_user_data", "cairo_user_data_key_t*");
+ return(C_to_Xen_void_(cairo_pattern_get_user_data(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_cairo_user_data_key_t_(key))));
}
-static XEN gxg_cairo_pattern_set_user_data(XEN pattern, XEN key, XEN user_data, XEN destroy)
+static Xen gxg_cairo_pattern_set_user_data(Xen pattern, Xen key, Xen user_data, Xen destroy)
{
#define H_cairo_pattern_set_user_data "cairo_status_t cairo_pattern_set_user_data(cairo_pattern_t* pattern, \
cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy)"
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_set_user_data", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_pattern_set_user_data", "cairo_user_data_key_t*");
- XEN_ASSERT_TYPE(XEN_void__P(user_data), user_data, 3, "cairo_pattern_set_user_data", "void*");
- XEN_ASSERT_TYPE(XEN_cairo_destroy_func_t_P(destroy), destroy, 4, "cairo_pattern_set_user_data", "cairo_destroy_func_t");
- return(C_TO_XEN_cairo_status_t(cairo_pattern_set_user_data(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_cairo_user_data_key_t_(key),
- XEN_TO_C_void_(user_data), XEN_TO_C_cairo_destroy_func_t(destroy))));
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_set_user_data", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_pattern_set_user_data", "cairo_user_data_key_t*");
+ Xen_check_type(Xen_is_void_(user_data), user_data, 3, "cairo_pattern_set_user_data", "void*");
+ Xen_check_type(Xen_is_cairo_destroy_func_t(destroy), destroy, 4, "cairo_pattern_set_user_data", "cairo_destroy_func_t");
+ return(C_to_Xen_cairo_status_t(cairo_pattern_set_user_data(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_cairo_user_data_key_t_(key),
+ Xen_to_C_void_(user_data), Xen_to_C_cairo_destroy_func_t(destroy))));
}
-static XEN gxg_cairo_pattern_get_rgba(XEN pattern, XEN ignore_red, XEN ignore_green, XEN ignore_blue, XEN ignore_alpha)
+static Xen gxg_cairo_pattern_get_rgba(Xen pattern, Xen ignore_red, Xen ignore_green, Xen ignore_blue, Xen ignore_alpha)
{
#define H_cairo_pattern_get_rgba "cairo_status_t cairo_pattern_get_rgba(cairo_pattern_t* pattern, double* [red], \
double* [green], double* [blue], double* [alpha])"
@@ -33666,29 +33876,29 @@ double* [green], double* [blue], double* [alpha])"
double ref_green;
double ref_blue;
double ref_alpha;
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_rgba", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_rgba", "cairo_pattern_t*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_cairo_status_t(cairo_pattern_get_rgba(XEN_TO_C_cairo_pattern_t_(pattern), &ref_red, &ref_green, &ref_blue,
+ Xen result;
+ result = C_to_Xen_cairo_status_t(cairo_pattern_get_rgba(Xen_to_C_cairo_pattern_t_(pattern), &ref_red, &ref_green, &ref_blue,
&ref_alpha));
- return(XEN_LIST_5(result, C_TO_XEN_double(ref_red), C_TO_XEN_double(ref_green), C_TO_XEN_double(ref_blue), C_TO_XEN_double(ref_alpha)));
+ return(Xen_list_5(result, C_to_Xen_double(ref_red), C_to_Xen_double(ref_green), C_to_Xen_double(ref_blue), C_to_Xen_double(ref_alpha)));
}
}
-static XEN gxg_cairo_pattern_get_surface(XEN pattern, XEN ignore_surface)
+static Xen gxg_cairo_pattern_get_surface(Xen pattern, Xen ignore_surface)
{
#define H_cairo_pattern_get_surface "cairo_status_t cairo_pattern_get_surface(cairo_pattern_t* pattern, \
cairo_surface_t** [surface])"
cairo_surface_t* ref_surface = NULL;
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_surface", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_surface", "cairo_pattern_t*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_cairo_status_t(cairo_pattern_get_surface(XEN_TO_C_cairo_pattern_t_(pattern), &ref_surface));
- return(XEN_LIST_2(result, C_TO_XEN_cairo_surface_t_(ref_surface)));
+ Xen result;
+ result = C_to_Xen_cairo_status_t(cairo_pattern_get_surface(Xen_to_C_cairo_pattern_t_(pattern), &ref_surface));
+ return(Xen_list_2(result, C_to_Xen_cairo_surface_t_(ref_surface)));
}
}
-static XEN gxg_cairo_pattern_get_color_stop_rgba(XEN pattern, XEN index, XEN ignore_offset, XEN ignore_red, XEN ignore_green, XEN ignore_blue, XEN ignore_alpha)
+static Xen gxg_cairo_pattern_get_color_stop_rgba(Xen pattern, Xen index, Xen ignore_offset, Xen ignore_red, Xen ignore_green, Xen ignore_blue, Xen ignore_alpha)
{
#define H_cairo_pattern_get_color_stop_rgba "cairo_status_t cairo_pattern_get_color_stop_rgba(cairo_pattern_t* pattern, \
int index, double* [offset], double* [red], double* [green], double* [blue], double* [alpha])"
@@ -33697,30 +33907,30 @@ int index, double* [offset], double* [red], double* [green], double* [blue], dou
double ref_green;
double ref_blue;
double ref_alpha;
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_color_stop_rgba", "cairo_pattern_t*");
- XEN_ASSERT_TYPE(XEN_int_P(index), index, 2, "cairo_pattern_get_color_stop_rgba", "int");
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_color_stop_rgba", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_int(index), index, 2, "cairo_pattern_get_color_stop_rgba", "int");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_cairo_status_t(cairo_pattern_get_color_stop_rgba(XEN_TO_C_cairo_pattern_t_(pattern), XEN_TO_C_int(index),
+ Xen result;
+ result = C_to_Xen_cairo_status_t(cairo_pattern_get_color_stop_rgba(Xen_to_C_cairo_pattern_t_(pattern), Xen_to_C_int(index),
&ref_offset, &ref_red, &ref_green, &ref_blue, &ref_alpha));
- return(XEN_LIST_6(result, C_TO_XEN_double(ref_offset), C_TO_XEN_double(ref_red), C_TO_XEN_double(ref_green), C_TO_XEN_double(ref_blue), C_TO_XEN_double(ref_alpha)));
+ return(Xen_list_6(result, C_to_Xen_double(ref_offset), C_to_Xen_double(ref_red), C_to_Xen_double(ref_green), C_to_Xen_double(ref_blue), C_to_Xen_double(ref_alpha)));
}
}
-static XEN gxg_cairo_pattern_get_color_stop_count(XEN pattern, XEN ignore_count)
+static Xen gxg_cairo_pattern_get_color_stop_count(Xen pattern, Xen ignore_count)
{
#define H_cairo_pattern_get_color_stop_count "cairo_status_t cairo_pattern_get_color_stop_count(cairo_pattern_t* pattern, \
int* [count])"
int ref_count;
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_color_stop_count", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_color_stop_count", "cairo_pattern_t*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_cairo_status_t(cairo_pattern_get_color_stop_count(XEN_TO_C_cairo_pattern_t_(pattern), &ref_count));
- return(XEN_LIST_2(result, C_TO_XEN_int(ref_count)));
+ Xen result;
+ result = C_to_Xen_cairo_status_t(cairo_pattern_get_color_stop_count(Xen_to_C_cairo_pattern_t_(pattern), &ref_count));
+ return(Xen_list_2(result, C_to_Xen_int(ref_count)));
}
}
-static XEN gxg_cairo_pattern_get_linear_points(XEN pattern, XEN ignore_x0, XEN ignore_y0, XEN ignore_x1, XEN ignore_y1)
+static Xen gxg_cairo_pattern_get_linear_points(Xen pattern, Xen ignore_x0, Xen ignore_y0, Xen ignore_x1, Xen ignore_y1)
{
#define H_cairo_pattern_get_linear_points "cairo_status_t cairo_pattern_get_linear_points(cairo_pattern_t* pattern, \
double* [x0], double* [y0], double* [x1], double* [y1])"
@@ -33728,16 +33938,16 @@ double* [x0], double* [y0], double* [x1], double* [y1])"
double ref_y0;
double ref_x1;
double ref_y1;
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_linear_points", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_linear_points", "cairo_pattern_t*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_cairo_status_t(cairo_pattern_get_linear_points(XEN_TO_C_cairo_pattern_t_(pattern), &ref_x0, &ref_y0,
+ Xen result;
+ result = C_to_Xen_cairo_status_t(cairo_pattern_get_linear_points(Xen_to_C_cairo_pattern_t_(pattern), &ref_x0, &ref_y0,
&ref_x1, &ref_y1));
- return(XEN_LIST_5(result, C_TO_XEN_double(ref_x0), C_TO_XEN_double(ref_y0), C_TO_XEN_double(ref_x1), C_TO_XEN_double(ref_y1)));
+ return(Xen_list_5(result, C_to_Xen_double(ref_x0), C_to_Xen_double(ref_y0), C_to_Xen_double(ref_x1), C_to_Xen_double(ref_y1)));
}
}
-static XEN gxg_cairo_pattern_get_radial_circles(XEN pattern, XEN ignore_x0, XEN ignore_y0, XEN ignore_r0, XEN ignore_x1, XEN ignore_y1, XEN ignore_r1)
+static Xen gxg_cairo_pattern_get_radial_circles(Xen pattern, Xen ignore_x0, Xen ignore_y0, Xen ignore_r0, Xen ignore_x1, Xen ignore_y1, Xen ignore_r1)
{
#define H_cairo_pattern_get_radial_circles "cairo_status_t cairo_pattern_get_radial_circles(cairo_pattern_t* pattern, \
double* [x0], double* [y0], double* [r0], double* [x1], double* [y1], double* [r1])"
@@ -33747,23 +33957,23 @@ double* [x0], double* [y0], double* [r0], double* [x1], double* [y1], double* [r
double ref_x1;
double ref_y1;
double ref_r1;
- XEN_ASSERT_TYPE(XEN_cairo_pattern_t__P(pattern), pattern, 1, "cairo_pattern_get_radial_circles", "cairo_pattern_t*");
+ Xen_check_type(Xen_is_cairo_pattern_t_(pattern), pattern, 1, "cairo_pattern_get_radial_circles", "cairo_pattern_t*");
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_cairo_status_t(cairo_pattern_get_radial_circles(XEN_TO_C_cairo_pattern_t_(pattern), &ref_x0, &ref_y0,
+ Xen result;
+ result = C_to_Xen_cairo_status_t(cairo_pattern_get_radial_circles(Xen_to_C_cairo_pattern_t_(pattern), &ref_x0, &ref_y0,
&ref_r0, &ref_x1, &ref_y1, &ref_r1));
- return(XEN_LIST_7(result, C_TO_XEN_double(ref_x0), C_TO_XEN_double(ref_y0), C_TO_XEN_double(ref_r0), C_TO_XEN_double(ref_x1), C_TO_XEN_double(ref_y1), C_TO_XEN_double(ref_r1)));
+ return(Xen_list_7(result, C_to_Xen_double(ref_x0), C_to_Xen_double(ref_y0), C_to_Xen_double(ref_r0), C_to_Xen_double(ref_x1), C_to_Xen_double(ref_y1), C_to_Xen_double(ref_r1)));
}
}
-static XEN gxg_cairo_get_scaled_font(XEN cr)
+static Xen gxg_cairo_get_scaled_font(Xen cr)
{
#define H_cairo_get_scaled_font "cairo_scaled_font_t* cairo_get_scaled_font(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_get_scaled_font", "cairo_t*");
- return(C_TO_XEN_cairo_scaled_font_t_(cairo_get_scaled_font(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_get_scaled_font", "cairo_t*");
+ return(C_to_Xen_cairo_scaled_font_t_(cairo_get_scaled_font(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_path_extents(XEN cr, XEN ignore_x1, XEN ignore_y1, XEN ignore_x2, XEN ignore_y2)
+static Xen gxg_cairo_path_extents(Xen cr, Xen ignore_x1, Xen ignore_y1, Xen ignore_x2, Xen ignore_y2)
{
#define H_cairo_path_extents "void cairo_path_extents(cairo_t* cr, double* [x1], double* [y1], double* [x2], \
double* [y2])"
@@ -33771,13521 +33981,9817 @@ double* [y2])"
double ref_y1;
double ref_x2;
double ref_y2;
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_path_extents", "cairo_t*");
- cairo_path_extents(XEN_TO_C_cairo_t_(cr), &ref_x1, &ref_y1, &ref_x2, &ref_y2);
- return(XEN_LIST_4(C_TO_XEN_double(ref_x1), C_TO_XEN_double(ref_y1), C_TO_XEN_double(ref_x2), C_TO_XEN_double(ref_y2)));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_path_extents", "cairo_t*");
+ cairo_path_extents(Xen_to_C_cairo_t_(cr), &ref_x1, &ref_y1, &ref_x2, &ref_y2);
+ return(Xen_list_4(C_to_Xen_double(ref_x1), C_to_Xen_double(ref_y1), C_to_Xen_double(ref_x2), C_to_Xen_double(ref_y2)));
}
-static XEN gxg_cairo_has_current_point(XEN cr)
+static Xen gxg_cairo_has_current_point(Xen cr)
{
#define H_cairo_has_current_point "bool cairo_has_current_point(cairo_t* cr)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_has_current_point", "cairo_t*");
- return(C_TO_XEN_bool(cairo_has_current_point(XEN_TO_C_cairo_t_(cr))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_has_current_point", "cairo_t*");
+ return(C_to_Xen_bool(cairo_has_current_point(Xen_to_C_cairo_t_(cr))));
}
-static XEN gxg_cairo_surface_copy_page(XEN surface)
+static Xen gxg_cairo_surface_copy_page(Xen surface)
{
#define H_cairo_surface_copy_page "void cairo_surface_copy_page(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_copy_page", "cairo_surface_t*");
- cairo_surface_copy_page(XEN_TO_C_cairo_surface_t_(surface));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_copy_page", "cairo_surface_t*");
+ cairo_surface_copy_page(Xen_to_C_cairo_surface_t_(surface));
+ return(Xen_false);
}
-static XEN gxg_cairo_surface_show_page(XEN surface)
+static Xen gxg_cairo_surface_show_page(Xen surface)
{
#define H_cairo_surface_show_page "void cairo_surface_show_page(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_show_page", "cairo_surface_t*");
- cairo_surface_show_page(XEN_TO_C_cairo_surface_t_(surface));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_show_page", "cairo_surface_t*");
+ cairo_surface_show_page(Xen_to_C_cairo_surface_t_(surface));
+ return(Xen_false);
}
-static XEN gxg_cairo_format_stride_for_width(XEN format, XEN width)
+static Xen gxg_cairo_format_stride_for_width(Xen format, Xen width)
{
#define H_cairo_format_stride_for_width "int cairo_format_stride_for_width(cairo_format_t format, int width)"
- XEN_ASSERT_TYPE(XEN_cairo_format_t_P(format), format, 1, "cairo_format_stride_for_width", "cairo_format_t");
- XEN_ASSERT_TYPE(XEN_int_P(width), width, 2, "cairo_format_stride_for_width", "int");
- return(C_TO_XEN_int(cairo_format_stride_for_width(XEN_TO_C_cairo_format_t(format), XEN_TO_C_int(width))));
+ Xen_check_type(Xen_is_cairo_format_t(format), format, 1, "cairo_format_stride_for_width", "cairo_format_t");
+ Xen_check_type(Xen_is_int(width), width, 2, "cairo_format_stride_for_width", "int");
+ return(C_to_Xen_int(cairo_format_stride_for_width(Xen_to_C_cairo_format_t(format), Xen_to_C_int(width))));
}
-static XEN gxg_cairo_image_surface_create_from_png(XEN filename)
+static Xen gxg_cairo_image_surface_create_from_png(Xen filename)
{
#define H_cairo_image_surface_create_from_png "cairo_surface_t* cairo_image_surface_create_from_png(char* filename)"
- XEN_ASSERT_TYPE(XEN_char__P(filename), filename, 1, "cairo_image_surface_create_from_png", "char*");
- return(C_TO_XEN_cairo_surface_t_(cairo_image_surface_create_from_png((const char*)XEN_TO_C_char_(filename))));
+ Xen_check_type(Xen_is_char_(filename), filename, 1, "cairo_image_surface_create_from_png", "char*");
+ return(C_to_Xen_cairo_surface_t_(cairo_image_surface_create_from_png((const char*)Xen_to_C_char_(filename))));
}
-static XEN gxg_cairo_surface_write_to_png(XEN surface, XEN filename)
+static Xen gxg_cairo_surface_write_to_png(Xen surface, Xen filename)
{
#define H_cairo_surface_write_to_png "cairo_status_t cairo_surface_write_to_png(cairo_surface_t* surface, \
char* filename)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_write_to_png", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_char__P(filename), filename, 2, "cairo_surface_write_to_png", "char*");
- return(C_TO_XEN_cairo_status_t(cairo_surface_write_to_png(XEN_TO_C_cairo_surface_t_(surface), (const char*)XEN_TO_C_char_(filename))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_write_to_png", "cairo_surface_t*");
+ Xen_check_type(Xen_is_char_(filename), filename, 2, "cairo_surface_write_to_png", "char*");
+ return(C_to_Xen_cairo_status_t(cairo_surface_write_to_png(Xen_to_C_cairo_surface_t_(surface), (const char*)Xen_to_C_char_(filename))));
}
-#if HAVE_CAIRO_GLYPH_ALLOCATE
-static XEN gxg_cairo_glyph_allocate(XEN num_glyphs)
+#if HAVE_CAIRO_1_8
+static Xen gxg_cairo_glyph_allocate(Xen num_glyphs)
{
#define H_cairo_glyph_allocate "cairo_glyph_t* cairo_glyph_allocate(int num_glyphs)"
- XEN_ASSERT_TYPE(XEN_int_P(num_glyphs), num_glyphs, 1, "cairo_glyph_allocate", "int");
- return(C_TO_XEN_cairo_glyph_t_(cairo_glyph_allocate(XEN_TO_C_int(num_glyphs))));
+ Xen_check_type(Xen_is_int(num_glyphs), num_glyphs, 1, "cairo_glyph_allocate", "int");
+ return(C_to_Xen_cairo_glyph_t_(cairo_glyph_allocate(Xen_to_C_int(num_glyphs))));
}
-static XEN gxg_cairo_glyph_free(XEN glyphs)
+static Xen gxg_cairo_glyph_free(Xen glyphs)
{
#define H_cairo_glyph_free "void cairo_glyph_free(cairo_glyph_t* glyphs)"
- XEN_ASSERT_TYPE(XEN_cairo_glyph_t__P(glyphs), glyphs, 1, "cairo_glyph_free", "cairo_glyph_t*");
- cairo_glyph_free(XEN_TO_C_cairo_glyph_t_(glyphs));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_glyph_t_(glyphs), glyphs, 1, "cairo_glyph_free", "cairo_glyph_t*");
+ cairo_glyph_free(Xen_to_C_cairo_glyph_t_(glyphs));
+ return(Xen_false);
}
-static XEN gxg_cairo_text_cluster_allocate(XEN num_clusters)
+static Xen gxg_cairo_text_cluster_allocate(Xen num_clusters)
{
#define H_cairo_text_cluster_allocate "cairo_text_cluster_t* cairo_text_cluster_allocate(int num_clusters)"
- XEN_ASSERT_TYPE(XEN_int_P(num_clusters), num_clusters, 1, "cairo_text_cluster_allocate", "int");
- return(C_TO_XEN_cairo_text_cluster_t_(cairo_text_cluster_allocate(XEN_TO_C_int(num_clusters))));
+ Xen_check_type(Xen_is_int(num_clusters), num_clusters, 1, "cairo_text_cluster_allocate", "int");
+ return(C_to_Xen_cairo_text_cluster_t_(cairo_text_cluster_allocate(Xen_to_C_int(num_clusters))));
}
-static XEN gxg_cairo_text_cluster_free(XEN clusters)
+static Xen gxg_cairo_text_cluster_free(Xen clusters)
{
#define H_cairo_text_cluster_free "void cairo_text_cluster_free(cairo_text_cluster_t* clusters)"
- XEN_ASSERT_TYPE(XEN_cairo_text_cluster_t__P(clusters), clusters, 1, "cairo_text_cluster_free", "cairo_text_cluster_t*");
- cairo_text_cluster_free(XEN_TO_C_cairo_text_cluster_t_(clusters));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_text_cluster_t_(clusters), clusters, 1, "cairo_text_cluster_free", "cairo_text_cluster_t*");
+ cairo_text_cluster_free(Xen_to_C_cairo_text_cluster_t_(clusters));
+ return(Xen_false);
}
-static XEN gxg_cairo_show_text_glyphs(XEN cr, XEN utf8, XEN utf8_len, XEN glyphs, XEN num_glyphs, XEN clusters, XEN num_clusters, XEN cluster_flags)
+static Xen gxg_cairo_show_text_glyphs(Xen arglist)
{
#define H_cairo_show_text_glyphs "void cairo_show_text_glyphs(cairo_t* cr, char* utf8, int utf8_len, \
cairo_glyph_t* glyphs, int num_glyphs, cairo_text_cluster_t* clusters, int num_clusters, cairo_text_cluster_flags_t cluster_flags)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_show_text_glyphs", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_char__P(utf8), utf8, 2, "cairo_show_text_glyphs", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(utf8_len), utf8_len, 3, "cairo_show_text_glyphs", "int");
- XEN_ASSERT_TYPE(XEN_cairo_glyph_t__P(glyphs), glyphs, 4, "cairo_show_text_glyphs", "cairo_glyph_t*");
- XEN_ASSERT_TYPE(XEN_int_P(num_glyphs), num_glyphs, 5, "cairo_show_text_glyphs", "int");
- XEN_ASSERT_TYPE(XEN_cairo_text_cluster_t__P(clusters), clusters, 6, "cairo_show_text_glyphs", "cairo_text_cluster_t*");
- XEN_ASSERT_TYPE(XEN_int_P(num_clusters), num_clusters, 7, "cairo_show_text_glyphs", "int");
- XEN_ASSERT_TYPE(XEN_cairo_text_cluster_flags_t_P(cluster_flags), cluster_flags, 8, "cairo_show_text_glyphs", "cairo_text_cluster_flags_t");
- cairo_show_text_glyphs(XEN_TO_C_cairo_t_(cr), (const char*)XEN_TO_C_char_(utf8), XEN_TO_C_int(utf8_len), XEN_TO_C_cairo_glyph_t_(glyphs),
- XEN_TO_C_int(num_glyphs), XEN_TO_C_cairo_text_cluster_t_(clusters), XEN_TO_C_int(num_clusters),
- XEN_TO_C_cairo_text_cluster_flags_t(cluster_flags));
- return(XEN_FALSE);
-}
-
-static XEN gxg_cairo_scaled_font_text_to_glyphs(XEN arglist)
+ Xen cr, utf8, utf8_len, glyphs, num_glyphs, clusters, num_clusters, cluster_flags;
+ cr = Xen_list_ref(arglist, 0);
+ utf8 = Xen_list_ref(arglist, 1);
+ utf8_len = Xen_list_ref(arglist, 2);
+ glyphs = Xen_list_ref(arglist, 3);
+ num_glyphs = Xen_list_ref(arglist, 4);
+ clusters = Xen_list_ref(arglist, 5);
+ num_clusters = Xen_list_ref(arglist, 6);
+ cluster_flags = Xen_list_ref(arglist, 7);
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_show_text_glyphs", "cairo_t*");
+ Xen_check_type(Xen_is_char_(utf8), utf8, 2, "cairo_show_text_glyphs", "char*");
+ Xen_check_type(Xen_is_int(utf8_len), utf8_len, 3, "cairo_show_text_glyphs", "int");
+ Xen_check_type(Xen_is_cairo_glyph_t_(glyphs), glyphs, 4, "cairo_show_text_glyphs", "cairo_glyph_t*");
+ Xen_check_type(Xen_is_int(num_glyphs), num_glyphs, 5, "cairo_show_text_glyphs", "int");
+ Xen_check_type(Xen_is_cairo_text_cluster_t_(clusters), clusters, 6, "cairo_show_text_glyphs", "cairo_text_cluster_t*");
+ Xen_check_type(Xen_is_int(num_clusters), num_clusters, 7, "cairo_show_text_glyphs", "int");
+ Xen_check_type(Xen_is_cairo_text_cluster_flags_t(cluster_flags), cluster_flags, 8, "cairo_show_text_glyphs", "cairo_text_cluster_flags_t");
+ cairo_show_text_glyphs(Xen_to_C_cairo_t_(cr), (const char*)Xen_to_C_char_(utf8), Xen_to_C_int(utf8_len), Xen_to_C_cairo_glyph_t_(glyphs),
+ Xen_to_C_int(num_glyphs), Xen_to_C_cairo_text_cluster_t_(clusters), Xen_to_C_int(num_clusters),
+ Xen_to_C_cairo_text_cluster_flags_t(cluster_flags));
+ return(Xen_false);
+}
+
+static Xen gxg_cairo_scaled_font_text_to_glyphs(Xen arglist)
{
#define H_cairo_scaled_font_text_to_glyphs "cairo_status_t cairo_scaled_font_text_to_glyphs(cairo_scaled_font_t* scaled_font, \
double x, double y, char* utf8, int utf8_len, cairo_glyph_t** glyphs, int* num_glyphs, cairo_text_cluster_t** clusters, \
int* num_clusters, cairo_text_cluster_flags_t* cluster_flags)"
- XEN scaled_font, x, y, utf8, utf8_len, glyphs, num_glyphs, clusters, num_clusters, cluster_flags;
- scaled_font = XEN_LIST_REF(arglist, 0);
- x = XEN_LIST_REF(arglist, 1);
- y = XEN_LIST_REF(arglist, 2);
- utf8 = XEN_LIST_REF(arglist, 3);
- utf8_len = XEN_LIST_REF(arglist, 4);
- glyphs = XEN_LIST_REF(arglist, 5);
- num_glyphs = XEN_LIST_REF(arglist, 6);
- clusters = XEN_LIST_REF(arglist, 7);
- num_clusters = XEN_LIST_REF(arglist, 8);
- cluster_flags = XEN_LIST_REF(arglist, 9);
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_text_to_glyphs", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 2, "cairo_scaled_font_text_to_glyphs", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 3, "cairo_scaled_font_text_to_glyphs", "double");
- XEN_ASSERT_TYPE(XEN_char__P(utf8), utf8, 4, "cairo_scaled_font_text_to_glyphs", "char*");
- XEN_ASSERT_TYPE(XEN_int_P(utf8_len), utf8_len, 5, "cairo_scaled_font_text_to_glyphs", "int");
- XEN_ASSERT_TYPE(XEN_cairo_glyph_t___P(glyphs), glyphs, 6, "cairo_scaled_font_text_to_glyphs", "cairo_glyph_t**");
- XEN_ASSERT_TYPE(XEN_int__P(num_glyphs), num_glyphs, 7, "cairo_scaled_font_text_to_glyphs", "int*");
- XEN_ASSERT_TYPE(XEN_cairo_text_cluster_t___P(clusters), clusters, 8, "cairo_scaled_font_text_to_glyphs", "cairo_text_cluster_t**");
- XEN_ASSERT_TYPE(XEN_int__P(num_clusters), num_clusters, 9, "cairo_scaled_font_text_to_glyphs", "int*");
- XEN_ASSERT_TYPE(XEN_cairo_text_cluster_flags_t__P(cluster_flags), cluster_flags, 10, "cairo_scaled_font_text_to_glyphs", "cairo_text_cluster_flags_t*");
- return(C_TO_XEN_cairo_status_t(cairo_scaled_font_text_to_glyphs(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_double(x),
- XEN_TO_C_double(y), (const char*)XEN_TO_C_char_(utf8), XEN_TO_C_int(utf8_len),
- XEN_TO_C_cairo_glyph_t__(glyphs), XEN_TO_C_int_(num_glyphs),
- XEN_TO_C_cairo_text_cluster_t__(clusters), XEN_TO_C_int_(num_clusters),
- XEN_TO_C_cairo_text_cluster_flags_t_(cluster_flags))));
-}
-
-static XEN gxg_cairo_scaled_font_get_scale_matrix(XEN scaled_font, XEN scale_matrix)
+ Xen scaled_font, x, y, utf8, utf8_len, glyphs, num_glyphs, clusters, num_clusters, cluster_flags;
+ scaled_font = Xen_list_ref(arglist, 0);
+ x = Xen_list_ref(arglist, 1);
+ y = Xen_list_ref(arglist, 2);
+ utf8 = Xen_list_ref(arglist, 3);
+ utf8_len = Xen_list_ref(arglist, 4);
+ glyphs = Xen_list_ref(arglist, 5);
+ num_glyphs = Xen_list_ref(arglist, 6);
+ clusters = Xen_list_ref(arglist, 7);
+ num_clusters = Xen_list_ref(arglist, 8);
+ cluster_flags = Xen_list_ref(arglist, 9);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_text_to_glyphs", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_double(x), x, 2, "cairo_scaled_font_text_to_glyphs", "double");
+ Xen_check_type(Xen_is_double(y), y, 3, "cairo_scaled_font_text_to_glyphs", "double");
+ Xen_check_type(Xen_is_char_(utf8), utf8, 4, "cairo_scaled_font_text_to_glyphs", "char*");
+ Xen_check_type(Xen_is_int(utf8_len), utf8_len, 5, "cairo_scaled_font_text_to_glyphs", "int");
+ Xen_check_type(Xen_is_cairo_glyph_t__(glyphs), glyphs, 6, "cairo_scaled_font_text_to_glyphs", "cairo_glyph_t**");
+ Xen_check_type(Xen_is_int_(num_glyphs), num_glyphs, 7, "cairo_scaled_font_text_to_glyphs", "int*");
+ Xen_check_type(Xen_is_cairo_text_cluster_t__(clusters), clusters, 8, "cairo_scaled_font_text_to_glyphs", "cairo_text_cluster_t**");
+ Xen_check_type(Xen_is_int_(num_clusters), num_clusters, 9, "cairo_scaled_font_text_to_glyphs", "int*");
+ Xen_check_type(Xen_is_cairo_text_cluster_flags_t_(cluster_flags), cluster_flags, 10, "cairo_scaled_font_text_to_glyphs", "cairo_text_cluster_flags_t*");
+ return(C_to_Xen_cairo_status_t(cairo_scaled_font_text_to_glyphs(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_double(x),
+ Xen_to_C_double(y), (const char*)Xen_to_C_char_(utf8), Xen_to_C_int(utf8_len),
+ Xen_to_C_cairo_glyph_t__(glyphs), Xen_to_C_int_(num_glyphs),
+ Xen_to_C_cairo_text_cluster_t__(clusters), Xen_to_C_int_(num_clusters),
+ Xen_to_C_cairo_text_cluster_flags_t_(cluster_flags))));
+}
+
+static Xen gxg_cairo_scaled_font_get_scale_matrix(Xen scaled_font, Xen scale_matrix)
{
#define H_cairo_scaled_font_get_scale_matrix "void cairo_scaled_font_get_scale_matrix(cairo_scaled_font_t* scaled_font, \
cairo_matrix_t* scale_matrix)"
- XEN_ASSERT_TYPE(XEN_cairo_scaled_font_t__P(scaled_font), scaled_font, 1, "cairo_scaled_font_get_scale_matrix", "cairo_scaled_font_t*");
- XEN_ASSERT_TYPE(XEN_cairo_matrix_t__P(scale_matrix), scale_matrix, 2, "cairo_scaled_font_get_scale_matrix", "cairo_matrix_t*");
- cairo_scaled_font_get_scale_matrix(XEN_TO_C_cairo_scaled_font_t_(scaled_font), XEN_TO_C_cairo_matrix_t_(scale_matrix));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_scaled_font_t_(scaled_font), scaled_font, 1, "cairo_scaled_font_get_scale_matrix", "cairo_scaled_font_t*");
+ Xen_check_type(Xen_is_cairo_matrix_t_(scale_matrix), scale_matrix, 2, "cairo_scaled_font_get_scale_matrix", "cairo_matrix_t*");
+ cairo_scaled_font_get_scale_matrix(Xen_to_C_cairo_scaled_font_t_(scaled_font), Xen_to_C_cairo_matrix_t_(scale_matrix));
+ return(Xen_false);
}
-static XEN gxg_cairo_toy_font_face_create(XEN family, XEN slant, XEN weight)
+static Xen gxg_cairo_toy_font_face_create(Xen family, Xen slant, Xen weight)
{
#define H_cairo_toy_font_face_create "cairo_font_face_t* cairo_toy_font_face_create(char* family, cairo_font_slant_t slant, \
cairo_font_weight_t weight)"
- XEN_ASSERT_TYPE(XEN_char__P(family), family, 1, "cairo_toy_font_face_create", "char*");
- XEN_ASSERT_TYPE(XEN_cairo_font_slant_t_P(slant), slant, 2, "cairo_toy_font_face_create", "cairo_font_slant_t");
- XEN_ASSERT_TYPE(XEN_cairo_font_weight_t_P(weight), weight, 3, "cairo_toy_font_face_create", "cairo_font_weight_t");
- return(C_TO_XEN_cairo_font_face_t_(cairo_toy_font_face_create((const char*)XEN_TO_C_char_(family), XEN_TO_C_cairo_font_slant_t(slant),
- XEN_TO_C_cairo_font_weight_t(weight))));
+ Xen_check_type(Xen_is_char_(family), family, 1, "cairo_toy_font_face_create", "char*");
+ Xen_check_type(Xen_is_cairo_font_slant_t(slant), slant, 2, "cairo_toy_font_face_create", "cairo_font_slant_t");
+ Xen_check_type(Xen_is_cairo_font_weight_t(weight), weight, 3, "cairo_toy_font_face_create", "cairo_font_weight_t");
+ return(C_to_Xen_cairo_font_face_t_(cairo_toy_font_face_create((const char*)Xen_to_C_char_(family), Xen_to_C_cairo_font_slant_t(slant),
+ Xen_to_C_cairo_font_weight_t(weight))));
}
-static XEN gxg_cairo_toy_font_face_get_family(XEN font_face)
+static Xen gxg_cairo_toy_font_face_get_family(Xen font_face)
{
#define H_cairo_toy_font_face_get_family "char* cairo_toy_font_face_get_family(cairo_font_face_t* font_face)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_toy_font_face_get_family", "cairo_font_face_t*");
- return(C_TO_XEN_char_(cairo_toy_font_face_get_family(XEN_TO_C_cairo_font_face_t_(font_face))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_toy_font_face_get_family", "cairo_font_face_t*");
+ return(C_to_Xen_char_(cairo_toy_font_face_get_family(Xen_to_C_cairo_font_face_t_(font_face))));
}
-static XEN gxg_cairo_toy_font_face_get_slant(XEN font_face)
+static Xen gxg_cairo_toy_font_face_get_slant(Xen font_face)
{
#define H_cairo_toy_font_face_get_slant "cairo_font_slant_t cairo_toy_font_face_get_slant(cairo_font_face_t* font_face)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_toy_font_face_get_slant", "cairo_font_face_t*");
- return(C_TO_XEN_cairo_font_slant_t(cairo_toy_font_face_get_slant(XEN_TO_C_cairo_font_face_t_(font_face))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_toy_font_face_get_slant", "cairo_font_face_t*");
+ return(C_to_Xen_cairo_font_slant_t(cairo_toy_font_face_get_slant(Xen_to_C_cairo_font_face_t_(font_face))));
}
-static XEN gxg_cairo_toy_font_face_get_weight(XEN font_face)
+static Xen gxg_cairo_toy_font_face_get_weight(Xen font_face)
{
#define H_cairo_toy_font_face_get_weight "cairo_font_weight_t cairo_toy_font_face_get_weight(cairo_font_face_t* font_face)"
- XEN_ASSERT_TYPE(XEN_cairo_font_face_t__P(font_face), font_face, 1, "cairo_toy_font_face_get_weight", "cairo_font_face_t*");
- return(C_TO_XEN_cairo_font_weight_t(cairo_toy_font_face_get_weight(XEN_TO_C_cairo_font_face_t_(font_face))));
+ Xen_check_type(Xen_is_cairo_font_face_t_(font_face), font_face, 1, "cairo_toy_font_face_get_weight", "cairo_font_face_t*");
+ return(C_to_Xen_cairo_font_weight_t(cairo_toy_font_face_get_weight(Xen_to_C_cairo_font_face_t_(font_face))));
}
-static XEN gxg_cairo_user_font_face_create(void)
+static Xen gxg_cairo_user_font_face_create(void)
{
#define H_cairo_user_font_face_create "cairo_font_face_t* cairo_user_font_face_create( void)"
- return(C_TO_XEN_cairo_font_face_t_(cairo_user_font_face_create()));
+ return(C_to_Xen_cairo_font_face_t_(cairo_user_font_face_create()));
}
-static XEN gxg_cairo_surface_get_fallback_resolution(XEN surface, XEN ignore_x_pixels_per_inch, XEN ignore_y_pixels_per_inch)
+static Xen gxg_cairo_surface_get_fallback_resolution(Xen surface, Xen ignore_x_pixels_per_inch, Xen ignore_y_pixels_per_inch)
{
#define H_cairo_surface_get_fallback_resolution "void cairo_surface_get_fallback_resolution(cairo_surface_t* surface, \
double* [x_pixels_per_inch], double* [y_pixels_per_inch])"
double ref_x_pixels_per_inch;
double ref_y_pixels_per_inch;
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_get_fallback_resolution", "cairo_surface_t*");
- cairo_surface_get_fallback_resolution(XEN_TO_C_cairo_surface_t_(surface), &ref_x_pixels_per_inch, &ref_y_pixels_per_inch);
- return(XEN_LIST_2(C_TO_XEN_double(ref_x_pixels_per_inch), C_TO_XEN_double(ref_y_pixels_per_inch)));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_get_fallback_resolution", "cairo_surface_t*");
+ cairo_surface_get_fallback_resolution(Xen_to_C_cairo_surface_t_(surface), &ref_x_pixels_per_inch, &ref_y_pixels_per_inch);
+ return(Xen_list_2(C_to_Xen_double(ref_x_pixels_per_inch), C_to_Xen_double(ref_y_pixels_per_inch)));
}
-static XEN gxg_cairo_surface_has_show_text_glyphs(XEN surface)
+static Xen gxg_cairo_surface_has_show_text_glyphs(Xen surface)
{
#define H_cairo_surface_has_show_text_glyphs "cairo_bool_t cairo_surface_has_show_text_glyphs(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_has_show_text_glyphs", "cairo_surface_t*");
- return(C_TO_XEN_cairo_bool_t(cairo_surface_has_show_text_glyphs(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_has_show_text_glyphs", "cairo_surface_t*");
+ return(C_to_Xen_cairo_bool_t(cairo_surface_has_show_text_glyphs(Xen_to_C_cairo_surface_t_(surface))));
}
#endif
-#if HAVE_CAIRO_REGION_XOR
-static XEN gxg_cairo_in_clip(XEN cr, XEN x, XEN y)
+#if HAVE_CAIRO_1_9_12 && GTK_CHECK_VERSION(3, 0, 0)
+static Xen gxg_cairo_in_clip(Xen cr, Xen x, Xen y)
{
#define H_cairo_in_clip "cairo_bool_t cairo_in_clip(cairo_t* cr, double x, double y)"
- XEN_ASSERT_TYPE(XEN_cairo_t__P(cr), cr, 1, "cairo_in_clip", "cairo_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 2, "cairo_in_clip", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 3, "cairo_in_clip", "double");
- return(C_TO_XEN_cairo_bool_t(cairo_in_clip(XEN_TO_C_cairo_t_(cr), XEN_TO_C_double(x), XEN_TO_C_double(y))));
+ Xen_check_type(Xen_is_cairo_t_(cr), cr, 1, "cairo_in_clip", "cairo_t*");
+ Xen_check_type(Xen_is_double(x), x, 2, "cairo_in_clip", "double");
+ Xen_check_type(Xen_is_double(y), y, 3, "cairo_in_clip", "double");
+ return(C_to_Xen_cairo_bool_t(cairo_in_clip(Xen_to_C_cairo_t_(cr), Xen_to_C_double(x), Xen_to_C_double(y))));
}
-static XEN gxg_cairo_device_reference(XEN device)
+static Xen gxg_cairo_device_reference(Xen device)
{
#define H_cairo_device_reference "cairo_device_t* cairo_device_reference(cairo_device_t* device)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_reference", "cairo_device_t*");
- return(C_TO_XEN_cairo_device_t_(cairo_device_reference(XEN_TO_C_cairo_device_t_(device))));
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_reference", "cairo_device_t*");
+ return(C_to_Xen_cairo_device_t_(cairo_device_reference(Xen_to_C_cairo_device_t_(device))));
}
-static XEN gxg_cairo_device_status(XEN device)
+static Xen gxg_cairo_device_status(Xen device)
{
#define H_cairo_device_status "cairo_status_t cairo_device_status(cairo_device_t* device)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_status", "cairo_device_t*");
- return(C_TO_XEN_cairo_status_t(cairo_device_status(XEN_TO_C_cairo_device_t_(device))));
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_status", "cairo_device_t*");
+ return(C_to_Xen_cairo_status_t(cairo_device_status(Xen_to_C_cairo_device_t_(device))));
}
-static XEN gxg_cairo_device_acquire(XEN device)
+static Xen gxg_cairo_device_acquire(Xen device)
{
#define H_cairo_device_acquire "cairo_status_t cairo_device_acquire(cairo_device_t* device)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_acquire", "cairo_device_t*");
- return(C_TO_XEN_cairo_status_t(cairo_device_acquire(XEN_TO_C_cairo_device_t_(device))));
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_acquire", "cairo_device_t*");
+ return(C_to_Xen_cairo_status_t(cairo_device_acquire(Xen_to_C_cairo_device_t_(device))));
}
-static XEN gxg_cairo_device_release(XEN device)
+static Xen gxg_cairo_device_release(Xen device)
{
#define H_cairo_device_release "void cairo_device_release(cairo_device_t* device)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_release", "cairo_device_t*");
- cairo_device_release(XEN_TO_C_cairo_device_t_(device));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_release", "cairo_device_t*");
+ cairo_device_release(Xen_to_C_cairo_device_t_(device));
+ return(Xen_false);
}
-static XEN gxg_cairo_device_flush(XEN device)
+static Xen gxg_cairo_device_flush(Xen device)
{
#define H_cairo_device_flush "void cairo_device_flush(cairo_device_t* device)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_flush", "cairo_device_t*");
- cairo_device_flush(XEN_TO_C_cairo_device_t_(device));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_flush", "cairo_device_t*");
+ cairo_device_flush(Xen_to_C_cairo_device_t_(device));
+ return(Xen_false);
}
-static XEN gxg_cairo_device_finish(XEN device)
+static Xen gxg_cairo_device_finish(Xen device)
{
#define H_cairo_device_finish "void cairo_device_finish(cairo_device_t* device)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_finish", "cairo_device_t*");
- cairo_device_finish(XEN_TO_C_cairo_device_t_(device));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_finish", "cairo_device_t*");
+ cairo_device_finish(Xen_to_C_cairo_device_t_(device));
+ return(Xen_false);
}
-static XEN gxg_cairo_device_destroy(XEN device)
+static Xen gxg_cairo_device_destroy(Xen device)
{
#define H_cairo_device_destroy "void cairo_device_destroy(cairo_device_t* device)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_destroy", "cairo_device_t*");
- cairo_device_destroy(XEN_TO_C_cairo_device_t_(device));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_destroy", "cairo_device_t*");
+ cairo_device_destroy(Xen_to_C_cairo_device_t_(device));
+ return(Xen_false);
}
-static XEN gxg_cairo_device_get_reference_count(XEN device)
+static Xen gxg_cairo_device_get_reference_count(Xen device)
{
#define H_cairo_device_get_reference_count "guint cairo_device_get_reference_count(cairo_device_t* device)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_get_reference_count", "cairo_device_t*");
- return(C_TO_XEN_guint(cairo_device_get_reference_count(XEN_TO_C_cairo_device_t_(device))));
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_get_reference_count", "cairo_device_t*");
+ return(C_to_Xen_guint(cairo_device_get_reference_count(Xen_to_C_cairo_device_t_(device))));
}
-static XEN gxg_cairo_device_get_user_data(XEN device, XEN key)
+static Xen gxg_cairo_device_get_user_data(Xen device, Xen key)
{
#define H_cairo_device_get_user_data "void* cairo_device_get_user_data(cairo_device_t* device, cairo_user_data_key_t* key)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_get_user_data", "cairo_device_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_device_get_user_data", "cairo_user_data_key_t*");
- return(C_TO_XEN_void_(cairo_device_get_user_data(XEN_TO_C_cairo_device_t_(device), XEN_TO_C_cairo_user_data_key_t_(key))));
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_get_user_data", "cairo_device_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_device_get_user_data", "cairo_user_data_key_t*");
+ return(C_to_Xen_void_(cairo_device_get_user_data(Xen_to_C_cairo_device_t_(device), Xen_to_C_cairo_user_data_key_t_(key))));
}
-static XEN gxg_cairo_device_set_user_data(XEN device, XEN key, XEN user_data, XEN destroy)
+static Xen gxg_cairo_device_set_user_data(Xen device, Xen key, Xen user_data, Xen destroy)
{
#define H_cairo_device_set_user_data "cairo_status_t cairo_device_set_user_data(cairo_device_t* device, \
cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy)"
- XEN_ASSERT_TYPE(XEN_cairo_device_t__P(device), device, 1, "cairo_device_set_user_data", "cairo_device_t*");
- XEN_ASSERT_TYPE(XEN_cairo_user_data_key_t__P(key), key, 2, "cairo_device_set_user_data", "cairo_user_data_key_t*");
- XEN_ASSERT_TYPE(XEN_void__P(user_data), user_data, 3, "cairo_device_set_user_data", "void*");
- XEN_ASSERT_TYPE(XEN_cairo_destroy_func_t_P(destroy), destroy, 4, "cairo_device_set_user_data", "cairo_destroy_func_t");
- return(C_TO_XEN_cairo_status_t(cairo_device_set_user_data(XEN_TO_C_cairo_device_t_(device), XEN_TO_C_cairo_user_data_key_t_(key),
- XEN_TO_C_void_(user_data), XEN_TO_C_cairo_destroy_func_t(destroy))));
+ Xen_check_type(Xen_is_cairo_device_t_(device), device, 1, "cairo_device_set_user_data", "cairo_device_t*");
+ Xen_check_type(Xen_is_cairo_user_data_key_t_(key), key, 2, "cairo_device_set_user_data", "cairo_user_data_key_t*");
+ Xen_check_type(Xen_is_void_(user_data), user_data, 3, "cairo_device_set_user_data", "void*");
+ Xen_check_type(Xen_is_cairo_destroy_func_t(destroy), destroy, 4, "cairo_device_set_user_data", "cairo_destroy_func_t");
+ return(C_to_Xen_cairo_status_t(cairo_device_set_user_data(Xen_to_C_cairo_device_t_(device), Xen_to_C_cairo_user_data_key_t_(key),
+ Xen_to_C_void_(user_data), Xen_to_C_cairo_destroy_func_t(destroy))));
}
-static XEN gxg_cairo_surface_create_for_rectangle(XEN target, XEN x, XEN y, XEN width, XEN height)
+static Xen gxg_cairo_surface_create_for_rectangle(Xen target, Xen x, Xen y, Xen width, Xen height)
{
#define H_cairo_surface_create_for_rectangle "cairo_surface_t* cairo_surface_create_for_rectangle(cairo_surface_t* target, \
double x, double y, double width, double height)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(target), target, 1, "cairo_surface_create_for_rectangle", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_double_P(x), x, 2, "cairo_surface_create_for_rectangle", "double");
- XEN_ASSERT_TYPE(XEN_double_P(y), y, 3, "cairo_surface_create_for_rectangle", "double");
- XEN_ASSERT_TYPE(XEN_double_P(width), width, 4, "cairo_surface_create_for_rectangle", "double");
- XEN_ASSERT_TYPE(XEN_double_P(height), height, 5, "cairo_surface_create_for_rectangle", "double");
- return(C_TO_XEN_cairo_surface_t_(cairo_surface_create_for_rectangle(XEN_TO_C_cairo_surface_t_(target), XEN_TO_C_double(x),
- XEN_TO_C_double(y), XEN_TO_C_double(width), XEN_TO_C_double(height))));
+ Xen_check_type(Xen_is_cairo_surface_t_(target), target, 1, "cairo_surface_create_for_rectangle", "cairo_surface_t*");
+ Xen_check_type(Xen_is_double(x), x, 2, "cairo_surface_create_for_rectangle", "double");
+ Xen_check_type(Xen_is_double(y), y, 3, "cairo_surface_create_for_rectangle", "double");
+ Xen_check_type(Xen_is_double(width), width, 4, "cairo_surface_create_for_rectangle", "double");
+ Xen_check_type(Xen_is_double(height), height, 5, "cairo_surface_create_for_rectangle", "double");
+ return(C_to_Xen_cairo_surface_t_(cairo_surface_create_for_rectangle(Xen_to_C_cairo_surface_t_(target), Xen_to_C_double(x),
+ Xen_to_C_double(y), Xen_to_C_double(width), Xen_to_C_double(height))));
}
-static XEN gxg_cairo_surface_get_device(XEN surface)
+static Xen gxg_cairo_surface_get_device(Xen surface)
{
#define H_cairo_surface_get_device "cairo_device_t* cairo_surface_get_device(cairo_surface_t* surface)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_get_device", "cairo_surface_t*");
- return(C_TO_XEN_cairo_device_t_(cairo_surface_get_device(XEN_TO_C_cairo_surface_t_(surface))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_get_device", "cairo_surface_t*");
+ return(C_to_Xen_cairo_device_t_(cairo_surface_get_device(Xen_to_C_cairo_surface_t_(surface))));
}
-static XEN gxg_cairo_surface_set_mime_data(XEN surface, XEN mime_type, XEN data, XEN length, XEN destroy, XEN closure)
+static Xen gxg_cairo_surface_set_mime_data(Xen surface, Xen mime_type, Xen data, Xen length, Xen destroy, Xen closure)
{
#define H_cairo_surface_set_mime_data "cairo_status_t cairo_surface_set_mime_data(cairo_surface_t* surface, \
char* mime_type, guchar* data, gulong length, cairo_destroy_func_t destroy, void* closure)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_surface_set_mime_data", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_char__P(mime_type), mime_type, 2, "cairo_surface_set_mime_data", "char*");
- XEN_ASSERT_TYPE(XEN_guchar__P(data), data, 3, "cairo_surface_set_mime_data", "guchar*");
- XEN_ASSERT_TYPE(XEN_gulong_P(length), length, 4, "cairo_surface_set_mime_data", "gulong");
- XEN_ASSERT_TYPE(XEN_cairo_destroy_func_t_P(destroy), destroy, 5, "cairo_surface_set_mime_data", "cairo_destroy_func_t");
- XEN_ASSERT_TYPE(XEN_void__P(closure), closure, 6, "cairo_surface_set_mime_data", "void*");
- return(C_TO_XEN_cairo_status_t(cairo_surface_set_mime_data(XEN_TO_C_cairo_surface_t_(surface), (const char*)XEN_TO_C_char_(mime_type),
- XEN_TO_C_guchar_(data), XEN_TO_C_gulong(length), XEN_TO_C_cairo_destroy_func_t(destroy),
- XEN_TO_C_void_(closure))));
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_surface_set_mime_data", "cairo_surface_t*");
+ Xen_check_type(Xen_is_char_(mime_type), mime_type, 2, "cairo_surface_set_mime_data", "char*");
+ Xen_check_type(Xen_is_guchar_(data), data, 3, "cairo_surface_set_mime_data", "guchar*");
+ Xen_check_type(Xen_is_gulong(length), length, 4, "cairo_surface_set_mime_data", "gulong");
+ Xen_check_type(Xen_is_cairo_destroy_func_t(destroy), destroy, 5, "cairo_surface_set_mime_data", "cairo_destroy_func_t");
+ Xen_check_type(Xen_is_void_(closure), closure, 6, "cairo_surface_set_mime_data", "void*");
+ return(C_to_Xen_cairo_status_t(cairo_surface_set_mime_data(Xen_to_C_cairo_surface_t_(surface), (const char*)Xen_to_C_char_(mime_type),
+ Xen_to_C_guchar_(data), Xen_to_C_gulong(length), Xen_to_C_cairo_destroy_func_t(destroy),
+ Xen_to_C_void_(closure))));
}
-static XEN gxg_cairo_recording_surface_create(XEN content, XEN extents)
+static Xen gxg_cairo_recording_surface_create(Xen content, Xen extents)
{
#define H_cairo_recording_surface_create "cairo_surface_t* cairo_recording_surface_create(cairo_content_t content, \
cairo_rectangle_t* extents)"
- XEN_ASSERT_TYPE(XEN_cairo_content_t_P(content), content, 1, "cairo_recording_surface_create", "cairo_content_t");
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_t__P(extents), extents, 2, "cairo_recording_surface_create", "cairo_rectangle_t*");
- return(C_TO_XEN_cairo_surface_t_(cairo_recording_surface_create(XEN_TO_C_cairo_content_t(content), XEN_TO_C_cairo_rectangle_t_(extents))));
+ Xen_check_type(Xen_is_cairo_content_t(content), content, 1, "cairo_recording_surface_create", "cairo_content_t");
+ Xen_check_type(Xen_is_cairo_rectangle_t_(extents), extents, 2, "cairo_recording_surface_create", "cairo_rectangle_t*");
+ return(C_to_Xen_cairo_surface_t_(cairo_recording_surface_create(Xen_to_C_cairo_content_t(content), Xen_to_C_cairo_rectangle_t_(extents))));
}
-static XEN gxg_cairo_recording_surface_ink_extents(XEN surface, XEN x0, XEN y0, XEN width, XEN height)
+static Xen gxg_cairo_recording_surface_ink_extents(Xen surface, Xen x0, Xen y0, Xen width, Xen height)
{
#define H_cairo_recording_surface_ink_extents "void cairo_recording_surface_ink_extents(cairo_surface_t* surface, \
double* x0, double* y0, double* width, double* height)"
- XEN_ASSERT_TYPE(XEN_cairo_surface_t__P(surface), surface, 1, "cairo_recording_surface_ink_extents", "cairo_surface_t*");
- XEN_ASSERT_TYPE(XEN_double__P(x0), x0, 2, "cairo_recording_surface_ink_extents", "double*");
- XEN_ASSERT_TYPE(XEN_double__P(y0), y0, 3, "cairo_recording_surface_ink_extents", "double*");
- XEN_ASSERT_TYPE(XEN_double__P(width), width, 4, "cairo_recording_surface_ink_extents", "double*");
- XEN_ASSERT_TYPE(XEN_double__P(height), height, 5, "cairo_recording_surface_ink_extents", "double*");
- cairo_recording_surface_ink_extents(XEN_TO_C_cairo_surface_t_(surface), XEN_TO_C_double_(x0), XEN_TO_C_double_(y0), XEN_TO_C_double_(width),
- XEN_TO_C_double_(height));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_surface_t_(surface), surface, 1, "cairo_recording_surface_ink_extents", "cairo_surface_t*");
+ Xen_check_type(Xen_is_double_(x0), x0, 2, "cairo_recording_surface_ink_extents", "double*");
+ Xen_check_type(Xen_is_double_(y0), y0, 3, "cairo_recording_surface_ink_extents", "double*");
+ Xen_check_type(Xen_is_double_(width), width, 4, "cairo_recording_surface_ink_extents", "double*");
+ Xen_check_type(Xen_is_double_(height), height, 5, "cairo_recording_surface_ink_extents", "double*");
+ cairo_recording_surface_ink_extents(Xen_to_C_cairo_surface_t_(surface), Xen_to_C_double_(x0), Xen_to_C_double_(y0), Xen_to_C_double_(width),
+ Xen_to_C_double_(height));
+ return(Xen_false);
}
-static XEN gxg_cairo_region_create(void)
+static Xen gxg_cairo_region_create(void)
{
#define H_cairo_region_create "cairo_region_t* cairo_region_create( void)"
- return(C_TO_XEN_cairo_region_t_(cairo_region_create()));
+ return(C_to_Xen_cairo_region_t_(cairo_region_create()));
}
-static XEN gxg_cairo_region_create_rectangle(XEN rectangle)
+static Xen gxg_cairo_region_create_rectangle(Xen rectangle)
{
#define H_cairo_region_create_rectangle "cairo_region_t* cairo_region_create_rectangle(cairo_rectangle_int_t* rectangle)"
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(rectangle), rectangle, 1, "cairo_region_create_rectangle", "cairo_rectangle_int_t*");
- return(C_TO_XEN_cairo_region_t_(cairo_region_create_rectangle(XEN_TO_C_cairo_rectangle_int_t_(rectangle))));
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(rectangle), rectangle, 1, "cairo_region_create_rectangle", "cairo_rectangle_int_t*");
+ return(C_to_Xen_cairo_region_t_(cairo_region_create_rectangle(Xen_to_C_cairo_rectangle_int_t_(rectangle))));
}
-static XEN gxg_cairo_region_create_rectangles(XEN rects, XEN count)
+static Xen gxg_cairo_region_create_rectangles(Xen rects, Xen count)
{
#define H_cairo_region_create_rectangles "cairo_region_t* cairo_region_create_rectangles(cairo_rectangle_int_t* rects, \
int count)"
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(rects), rects, 1, "cairo_region_create_rectangles", "cairo_rectangle_int_t*");
- XEN_ASSERT_TYPE(XEN_int_P(count), count, 2, "cairo_region_create_rectangles", "int");
- return(C_TO_XEN_cairo_region_t_(cairo_region_create_rectangles(XEN_TO_C_cairo_rectangle_int_t_(rects), XEN_TO_C_int(count))));
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(rects), rects, 1, "cairo_region_create_rectangles", "cairo_rectangle_int_t*");
+ Xen_check_type(Xen_is_int(count), count, 2, "cairo_region_create_rectangles", "int");
+ return(C_to_Xen_cairo_region_t_(cairo_region_create_rectangles(Xen_to_C_cairo_rectangle_int_t_(rects), Xen_to_C_int(count))));
}
-static XEN gxg_cairo_region_copy(XEN original)
+static Xen gxg_cairo_region_copy(Xen original)
{
#define H_cairo_region_copy "cairo_region_t* cairo_region_copy(cairo_region_t* original)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(original), original, 1, "cairo_region_copy", "cairo_region_t*");
- return(C_TO_XEN_cairo_region_t_(cairo_region_copy(XEN_TO_C_cairo_region_t_(original))));
+ Xen_check_type(Xen_is_cairo_region_t_(original), original, 1, "cairo_region_copy", "cairo_region_t*");
+ return(C_to_Xen_cairo_region_t_(cairo_region_copy(Xen_to_C_cairo_region_t_(original))));
}
-static XEN gxg_cairo_region_reference(XEN region)
+static Xen gxg_cairo_region_reference(Xen region)
{
#define H_cairo_region_reference "cairo_region_t* cairo_region_reference(cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_reference", "cairo_region_t*");
- return(C_TO_XEN_cairo_region_t_(cairo_region_reference(XEN_TO_C_cairo_region_t_(region))));
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_reference", "cairo_region_t*");
+ return(C_to_Xen_cairo_region_t_(cairo_region_reference(Xen_to_C_cairo_region_t_(region))));
}
-static XEN gxg_cairo_region_destroy(XEN region)
+static Xen gxg_cairo_region_destroy(Xen region)
{
#define H_cairo_region_destroy "void cairo_region_destroy(cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_destroy", "cairo_region_t*");
- cairo_region_destroy(XEN_TO_C_cairo_region_t_(region));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_destroy", "cairo_region_t*");
+ cairo_region_destroy(Xen_to_C_cairo_region_t_(region));
+ return(Xen_false);
}
-static XEN gxg_cairo_region_equal(XEN a, XEN b)
+static Xen gxg_cairo_region_equal(Xen a, Xen b)
{
#define H_cairo_region_equal "cairo_bool_t cairo_region_equal(cairo_region_t* a, cairo_region_t* b)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(a), a, 1, "cairo_region_equal", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(b), b, 2, "cairo_region_equal", "cairo_region_t*");
- return(C_TO_XEN_cairo_bool_t(cairo_region_equal(XEN_TO_C_cairo_region_t_(a), XEN_TO_C_cairo_region_t_(b))));
+ Xen_check_type(Xen_is_cairo_region_t_(a), a, 1, "cairo_region_equal", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_region_t_(b), b, 2, "cairo_region_equal", "cairo_region_t*");
+ return(C_to_Xen_cairo_bool_t(cairo_region_equal(Xen_to_C_cairo_region_t_(a), Xen_to_C_cairo_region_t_(b))));
}
-static XEN gxg_cairo_region_status(XEN region)
+static Xen gxg_cairo_region_status(Xen region)
{
#define H_cairo_region_status "cairo_status_t cairo_region_status(cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_status", "cairo_region_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_status(XEN_TO_C_cairo_region_t_(region))));
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_status", "cairo_region_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_status(Xen_to_C_cairo_region_t_(region))));
}
-static XEN gxg_cairo_region_get_extents(XEN region, XEN extents)
+static Xen gxg_cairo_region_get_extents(Xen region, Xen extents)
{
#define H_cairo_region_get_extents "void cairo_region_get_extents(cairo_region_t* region, cairo_rectangle_int_t* extents)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_get_extents", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(extents), extents, 2, "cairo_region_get_extents", "cairo_rectangle_int_t*");
- cairo_region_get_extents(XEN_TO_C_cairo_region_t_(region), XEN_TO_C_cairo_rectangle_int_t_(extents));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_get_extents", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(extents), extents, 2, "cairo_region_get_extents", "cairo_rectangle_int_t*");
+ cairo_region_get_extents(Xen_to_C_cairo_region_t_(region), Xen_to_C_cairo_rectangle_int_t_(extents));
+ return(Xen_false);
}
-static XEN gxg_cairo_region_num_rectangles(XEN region)
+static Xen gxg_cairo_region_num_rectangles(Xen region)
{
#define H_cairo_region_num_rectangles "int cairo_region_num_rectangles(cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_num_rectangles", "cairo_region_t*");
- return(C_TO_XEN_int(cairo_region_num_rectangles(XEN_TO_C_cairo_region_t_(region))));
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_num_rectangles", "cairo_region_t*");
+ return(C_to_Xen_int(cairo_region_num_rectangles(Xen_to_C_cairo_region_t_(region))));
}
-static XEN gxg_cairo_region_get_rectangle(XEN region, XEN nth, XEN rectangle)
+static Xen gxg_cairo_region_get_rectangle(Xen region, Xen nth, Xen rectangle)
{
#define H_cairo_region_get_rectangle "void cairo_region_get_rectangle(cairo_region_t* region, int nth, \
cairo_rectangle_int_t* rectangle)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_get_rectangle", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_int_P(nth), nth, 2, "cairo_region_get_rectangle", "int");
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(rectangle), rectangle, 3, "cairo_region_get_rectangle", "cairo_rectangle_int_t*");
- cairo_region_get_rectangle(XEN_TO_C_cairo_region_t_(region), XEN_TO_C_int(nth), XEN_TO_C_cairo_rectangle_int_t_(rectangle));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_get_rectangle", "cairo_region_t*");
+ Xen_check_type(Xen_is_int(nth), nth, 2, "cairo_region_get_rectangle", "int");
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(rectangle), rectangle, 3, "cairo_region_get_rectangle", "cairo_rectangle_int_t*");
+ cairo_region_get_rectangle(Xen_to_C_cairo_region_t_(region), Xen_to_C_int(nth), Xen_to_C_cairo_rectangle_int_t_(rectangle));
+ return(Xen_false);
}
-static XEN gxg_cairo_region_is_empty(XEN region)
+static Xen gxg_cairo_region_is_empty(Xen region)
{
#define H_cairo_region_is_empty "cairo_bool_t cairo_region_is_empty(cairo_region_t* region)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_is_empty", "cairo_region_t*");
- return(C_TO_XEN_cairo_bool_t(cairo_region_is_empty(XEN_TO_C_cairo_region_t_(region))));
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_is_empty", "cairo_region_t*");
+ return(C_to_Xen_cairo_bool_t(cairo_region_is_empty(Xen_to_C_cairo_region_t_(region))));
}
-static XEN gxg_cairo_region_contains_rectangle(XEN region, XEN rectangle)
+static Xen gxg_cairo_region_contains_rectangle(Xen region, Xen rectangle)
{
#define H_cairo_region_contains_rectangle "cairo_region_overlap_t cairo_region_contains_rectangle(cairo_region_t* region, \
cairo_rectangle_int_t* rectangle)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_contains_rectangle", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(rectangle), rectangle, 2, "cairo_region_contains_rectangle", "cairo_rectangle_int_t*");
- return(C_TO_XEN_cairo_region_overlap_t(cairo_region_contains_rectangle(XEN_TO_C_cairo_region_t_(region), XEN_TO_C_cairo_rectangle_int_t_(rectangle))));
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_contains_rectangle", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(rectangle), rectangle, 2, "cairo_region_contains_rectangle", "cairo_rectangle_int_t*");
+ return(C_to_Xen_cairo_region_overlap_t(cairo_region_contains_rectangle(Xen_to_C_cairo_region_t_(region), Xen_to_C_cairo_rectangle_int_t_(rectangle))));
}
-static XEN gxg_cairo_region_contains_point(XEN region, XEN x, XEN y)
+static Xen gxg_cairo_region_contains_point(Xen region, Xen x, Xen y)
{
#define H_cairo_region_contains_point "cairo_bool_t cairo_region_contains_point(cairo_region_t* region, \
int x, int y)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_contains_point", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_int_P(x), x, 2, "cairo_region_contains_point", "int");
- XEN_ASSERT_TYPE(XEN_int_P(y), y, 3, "cairo_region_contains_point", "int");
- return(C_TO_XEN_cairo_bool_t(cairo_region_contains_point(XEN_TO_C_cairo_region_t_(region), XEN_TO_C_int(x), XEN_TO_C_int(y))));
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_contains_point", "cairo_region_t*");
+ Xen_check_type(Xen_is_int(x), x, 2, "cairo_region_contains_point", "int");
+ Xen_check_type(Xen_is_int(y), y, 3, "cairo_region_contains_point", "int");
+ return(C_to_Xen_cairo_bool_t(cairo_region_contains_point(Xen_to_C_cairo_region_t_(region), Xen_to_C_int(x), Xen_to_C_int(y))));
}
-static XEN gxg_cairo_region_translate(XEN region, XEN dx, XEN dy)
+static Xen gxg_cairo_region_translate(Xen region, Xen dx, Xen dy)
{
#define H_cairo_region_translate "void cairo_region_translate(cairo_region_t* region, int dx, int dy)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(region), region, 1, "cairo_region_translate", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_int_P(dx), dx, 2, "cairo_region_translate", "int");
- XEN_ASSERT_TYPE(XEN_int_P(dy), dy, 3, "cairo_region_translate", "int");
- cairo_region_translate(XEN_TO_C_cairo_region_t_(region), XEN_TO_C_int(dx), XEN_TO_C_int(dy));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_cairo_region_t_(region), region, 1, "cairo_region_translate", "cairo_region_t*");
+ Xen_check_type(Xen_is_int(dx), dx, 2, "cairo_region_translate", "int");
+ Xen_check_type(Xen_is_int(dy), dy, 3, "cairo_region_translate", "int");
+ cairo_region_translate(Xen_to_C_cairo_region_t_(region), Xen_to_C_int(dx), Xen_to_C_int(dy));
+ return(Xen_false);
}
-static XEN gxg_cairo_region_subtract(XEN dst, XEN other)
+static Xen gxg_cairo_region_subtract(Xen dst, Xen other)
{
#define H_cairo_region_subtract "cairo_status_t cairo_region_subtract(cairo_region_t* dst, cairo_region_t* other)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(dst), dst, 1, "cairo_region_subtract", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(other), other, 2, "cairo_region_subtract", "cairo_region_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_subtract(XEN_TO_C_cairo_region_t_(dst), XEN_TO_C_cairo_region_t_(other))));
+ Xen_check_type(Xen_is_cairo_region_t_(dst), dst, 1, "cairo_region_subtract", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_region_t_(other), other, 2, "cairo_region_subtract", "cairo_region_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_subtract(Xen_to_C_cairo_region_t_(dst), Xen_to_C_cairo_region_t_(other))));
}
-static XEN gxg_cairo_region_subtract_rectangle(XEN dst, XEN rectangle)
+static Xen gxg_cairo_region_subtract_rectangle(Xen dst, Xen rectangle)
{
#define H_cairo_region_subtract_rectangle "cairo_status_t cairo_region_subtract_rectangle(cairo_region_t* dst, \
cairo_rectangle_int_t* rectangle)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(dst), dst, 1, "cairo_region_subtract_rectangle", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(rectangle), rectangle, 2, "cairo_region_subtract_rectangle", "cairo_rectangle_int_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_subtract_rectangle(XEN_TO_C_cairo_region_t_(dst), XEN_TO_C_cairo_rectangle_int_t_(rectangle))));
+ Xen_check_type(Xen_is_cairo_region_t_(dst), dst, 1, "cairo_region_subtract_rectangle", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(rectangle), rectangle, 2, "cairo_region_subtract_rectangle", "cairo_rectangle_int_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_subtract_rectangle(Xen_to_C_cairo_region_t_(dst), Xen_to_C_cairo_rectangle_int_t_(rectangle))));
}
-static XEN gxg_cairo_region_intersect(XEN dst, XEN other)
+static Xen gxg_cairo_region_intersect(Xen dst, Xen other)
{
#define H_cairo_region_intersect "cairo_status_t cairo_region_intersect(cairo_region_t* dst, cairo_region_t* other)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(dst), dst, 1, "cairo_region_intersect", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(other), other, 2, "cairo_region_intersect", "cairo_region_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_intersect(XEN_TO_C_cairo_region_t_(dst), XEN_TO_C_cairo_region_t_(other))));
+ Xen_check_type(Xen_is_cairo_region_t_(dst), dst, 1, "cairo_region_intersect", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_region_t_(other), other, 2, "cairo_region_intersect", "cairo_region_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_intersect(Xen_to_C_cairo_region_t_(dst), Xen_to_C_cairo_region_t_(other))));
}
-static XEN gxg_cairo_region_intersect_rectangle(XEN dst, XEN rectangle)
+static Xen gxg_cairo_region_intersect_rectangle(Xen dst, Xen rectangle)
{
#define H_cairo_region_intersect_rectangle "cairo_status_t cairo_region_intersect_rectangle(cairo_region_t* dst, \
cairo_rectangle_int_t* rectangle)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(dst), dst, 1, "cairo_region_intersect_rectangle", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(rectangle), rectangle, 2, "cairo_region_intersect_rectangle", "cairo_rectangle_int_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_intersect_rectangle(XEN_TO_C_cairo_region_t_(dst), XEN_TO_C_cairo_rectangle_int_t_(rectangle))));
+ Xen_check_type(Xen_is_cairo_region_t_(dst), dst, 1, "cairo_region_intersect_rectangle", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(rectangle), rectangle, 2, "cairo_region_intersect_rectangle", "cairo_rectangle_int_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_intersect_rectangle(Xen_to_C_cairo_region_t_(dst), Xen_to_C_cairo_rectangle_int_t_(rectangle))));
}
-static XEN gxg_cairo_region_union(XEN dst, XEN other)
+static Xen gxg_cairo_region_union(Xen dst, Xen other)
{
#define H_cairo_region_union "cairo_status_t cairo_region_union(cairo_region_t* dst, cairo_region_t* other)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(dst), dst, 1, "cairo_region_union", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(other), other, 2, "cairo_region_union", "cairo_region_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_union(XEN_TO_C_cairo_region_t_(dst), XEN_TO_C_cairo_region_t_(other))));
+ Xen_check_type(Xen_is_cairo_region_t_(dst), dst, 1, "cairo_region_union", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_region_t_(other), other, 2, "cairo_region_union", "cairo_region_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_union(Xen_to_C_cairo_region_t_(dst), Xen_to_C_cairo_region_t_(other))));
}
-static XEN gxg_cairo_region_union_rectangle(XEN dst, XEN rectangle)
+static Xen gxg_cairo_region_union_rectangle(Xen dst, Xen rectangle)
{
#define H_cairo_region_union_rectangle "cairo_status_t cairo_region_union_rectangle(cairo_region_t* dst, \
cairo_rectangle_int_t* rectangle)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(dst), dst, 1, "cairo_region_union_rectangle", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(rectangle), rectangle, 2, "cairo_region_union_rectangle", "cairo_rectangle_int_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_union_rectangle(XEN_TO_C_cairo_region_t_(dst), XEN_TO_C_cairo_rectangle_int_t_(rectangle))));
+ Xen_check_type(Xen_is_cairo_region_t_(dst), dst, 1, "cairo_region_union_rectangle", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(rectangle), rectangle, 2, "cairo_region_union_rectangle", "cairo_rectangle_int_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_union_rectangle(Xen_to_C_cairo_region_t_(dst), Xen_to_C_cairo_rectangle_int_t_(rectangle))));
}
-static XEN gxg_cairo_region_xor(XEN dst, XEN other)
+static Xen gxg_cairo_region_xor(Xen dst, Xen other)
{
#define H_cairo_region_xor "cairo_status_t cairo_region_xor(cairo_region_t* dst, cairo_region_t* other)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(dst), dst, 1, "cairo_region_xor", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(other), other, 2, "cairo_region_xor", "cairo_region_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_xor(XEN_TO_C_cairo_region_t_(dst), XEN_TO_C_cairo_region_t_(other))));
+ Xen_check_type(Xen_is_cairo_region_t_(dst), dst, 1, "cairo_region_xor", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_region_t_(other), other, 2, "cairo_region_xor", "cairo_region_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_xor(Xen_to_C_cairo_region_t_(dst), Xen_to_C_cairo_region_t_(other))));
}
-static XEN gxg_cairo_region_xor_rectangle(XEN dst, XEN rectangle)
+static Xen gxg_cairo_region_xor_rectangle(Xen dst, Xen rectangle)
{
#define H_cairo_region_xor_rectangle "cairo_status_t cairo_region_xor_rectangle(cairo_region_t* dst, \
cairo_rectangle_int_t* rectangle)"
- XEN_ASSERT_TYPE(XEN_cairo_region_t__P(dst), dst, 1, "cairo_region_xor_rectangle", "cairo_region_t*");
- XEN_ASSERT_TYPE(XEN_cairo_rectangle_int_t__P(rectangle), rectangle, 2, "cairo_region_xor_rectangle", "cairo_rectangle_int_t*");
- return(C_TO_XEN_cairo_status_t(cairo_region_xor_rectangle(XEN_TO_C_cairo_region_t_(dst), XEN_TO_C_cairo_rectangle_int_t_(rectangle))));
+ Xen_check_type(Xen_is_cairo_region_t_(dst), dst, 1, "cairo_region_xor_rectangle", "cairo_region_t*");
+ Xen_check_type(Xen_is_cairo_rectangle_int_t_(rectangle), rectangle, 2, "cairo_region_xor_rectangle", "cairo_rectangle_int_t*");
+ return(C_to_Xen_cairo_status_t(cairo_region_xor_rectangle(Xen_to_C_cairo_region_t_(dst), Xen_to_C_cairo_rectangle_int_t_(rectangle))));
}
#endif
-#define WRAPPED_OBJECT_P(Obj) (XEN_LIST_P(Obj) && (XEN_LIST_LENGTH(Obj) >= 2) && (XEN_SYMBOL_P(XEN_CAR(Obj))))
-
-static XEN gxg_GPOINTER(XEN obj) {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("gpointer"), (WRAPPED_OBJECT_P(obj)) ? XEN_CADR(obj) : XEN_WRAP_C_POINTER(obj)));}
-static XEN gxg_GDK_DRAG_CONTEXT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkDragContext_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_DEVICE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkDevice_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_KEYMAP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkKeymap_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_VISUAL(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkVisual_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_WINDOW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkWindow_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_PIXBUF(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkPixbuf_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_PIXBUF_ANIMATION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkPixbufAnimation_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_PIXBUF_ANIMATION_ITER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkPixbufAnimationIter_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_VBOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkVBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ACCEL_GROUP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAccelGroup_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ACCEL_LABEL(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAccelLabel_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ACCESSIBLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAccessible_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ADJUSTMENT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAdjustment_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ALIGNMENT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAlignment_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ARROW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkArrow_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ASPECT_FRAME(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAspectFrame_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_BUTTON_BOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkButtonBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_BIN(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkBin_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_BOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CALENDAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCalendar_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_EDITABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellEditable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRenderer_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER_PIXBUF(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRendererPixbuf_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER_TEXT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRendererText_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER_TOGGLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRendererToggle_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CHECK_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCheckButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CHECK_MENU_ITEM(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCheckMenuItem_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_COLOR_SELECTION_DIALOG(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkColorSelectionDialog_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_COLOR_SELECTION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkColorSelection_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CONTAINER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkContainer_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_DIALOG(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkDialog_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_DRAWING_AREA(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkDrawingArea_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_EDITABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkEditable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ENTRY(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkEntry_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_EVENT_BOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkEventBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FIXED(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFixed_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FONT_SELECTION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFontSelection_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FONT_SELECTION_DIALOG(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFontSelectionDialog_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FRAME(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFrame_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_HANDLE_BOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkHandleBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_HBUTTON_BOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkHButtonBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_HBOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkHBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_HPANED(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkHPaned_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_HSCALE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkHScale_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_HSCROLLBAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkHScrollbar_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_HSEPARATOR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkHSeparator_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ICON_FACTORY(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkIconFactory_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_IMAGE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkImage_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_IMAGE_MENU_ITEM(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkImageMenuItem_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_IM_CONTEXT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkIMContext_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_IM_CONTEXT_SIMPLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkIMContextSimple_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_IM_MULTICONTEXT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkIMMulticontext_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_INVISIBLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkInvisible_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_LABEL(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkLabel_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_LAYOUT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkLayout_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_LIST_STORE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkListStore_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_MENU_BAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkMenuBar_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_MENU(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkMenu_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_MENU_ITEM(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkMenuItem_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_MENU_SHELL(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkMenuShell_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_MISC(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkMisc_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_NOTEBOOK(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkNotebook_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_PANED(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkPaned_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_PROGRESS_BAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkProgressBar_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RADIO_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRadioButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RADIO_MENU_ITEM(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRadioMenuItem_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RANGE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRange_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SCALE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkScale_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SCROLLBAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkScrollbar_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SCROLLED_WINDOW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkScrolledWindow_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SEPARATOR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkSeparator_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SEPARATOR_MENU_ITEM(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkSeparatorMenuItem_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SIZE_GROUP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkSizeGroup_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SPIN_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkSpinButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_STATUSBAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkStatusbar_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TEAROFF_MENU_ITEM(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTearoffMenuItem_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TEXT_BUFFER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTextBuffer_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TEXT_CHILD_ANCHOR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTextChildAnchor_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TEXT_MARK(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTextMark_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TEXT_TAG(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTextTag_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TEXT_TAG_TABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTextTagTable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TEXT_VIEW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTextView_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOGGLE_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToggleButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOOLBAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToolbar_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_DRAG_SOURCE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeDragSource_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_DRAG_DEST(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeDragDest_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_MODEL(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeModel_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_MODEL_SORT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeModelSort_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_SELECTION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeSelection_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_SORTABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeSortable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_STORE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeStore_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_VIEW_COLUMN(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeViewColumn_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_VIEW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeView_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_VBUTTON_BOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkVButtonBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_VIEWPORT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkViewport_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_VPANED(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkVPaned_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_VSCALE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkVScale_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_VSCROLLBAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkVScrollbar_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_VSEPARATOR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkVSeparator_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_WIDGET(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkWidget_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_WINDOW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkWindow_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_PANGO_CONTEXT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("PangoContext_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_PANGO_FONT_FAMILY(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("PangoFontFamily_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_PANGO_FONT_FACE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("PangoFontFace_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_PANGO_FONT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("PangoFont_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_PANGO_FONT_MAP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("PangoFontMap_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_PANGO_LAYOUT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("PangoLayout_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_G_OBJECT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GObject_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_SCREEN(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkScreen_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_DISPLAY_OBJECT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkDisplay_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEvent_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_ANY(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventAny_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_EXPOSE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventExpose_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_NOEXPOSE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventNoExpose_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_VISIBILITY(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventVisibility_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_MOTION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventMotion_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_SCROLL(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventScroll_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_KEY(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventKey_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_CROSSING(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventCrossing_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_FOCUS(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventFocus_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_CONFIGURE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventConfigure_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_PROPERTY(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventProperty_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_SELECTION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventSelection_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_PROXIMITY(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventProximity_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_SETTING(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventSetting_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_WINDOWSTATE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventWindowState_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_EVENT_DND(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkEventDND_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FILE_CHOOSER_DIALOG(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFileChooserDialog_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FILE_CHOOSER_WIDGET(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFileChooserWidget_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TREE_MODEL_FILTER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTreeModelFilter_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ACTION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAction_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ACTION_GROUP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkActionGroup_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_COMBO_BOX(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkComboBox_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_EXPANDER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkExpander_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FONT_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFontButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_COLOR_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkColorButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ENTRY_COMPLETION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkEntryCompletion_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RADIO_TOOL_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRadioToolButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RADIO_ACTION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRadioAction_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SEPARATOR_TOOL_ITEM(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkSeparatorToolItem_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOGGLE_ACTION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToggleAction_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOGGLE_TOOL_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToggleToolButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FILE_FILTER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFileFilter_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_LAYOUT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellLayout_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CLIPBOARD(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkClipboard_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FILE_CHOOSER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFileChooser_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ICON_THEME(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkIconTheme_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOOL_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToolButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOOL_ITEM(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToolItem_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ACCEL_MAP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAccelMap"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_VIEW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellView_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ABOUT_DIALOG(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAboutDialog_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER_COMBO(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRendererCombo_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER_PROGRESS(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRendererProgress_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ICON_VIEW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkIconView_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_FILE_CHOOSER_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkFileChooserButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_MENU_TOOL_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkMenuToolButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ASSISTANT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkAssistant_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER_ACCEL(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRendererAccel_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER_SPIN(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRendererSpin_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_LINK_BUTTON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkLinkButton_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RECENT_CHOOSER_DIALOG(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRecentChooserDialog_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RECENT_CHOOSER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRecentChooser_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RECENT_CHOOSER_MENU(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRecentChooserMenu_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RECENT_CHOOSER_WIDGET(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRecentChooserWidget_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RECENT_FILTER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRecentFilter_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_RECENT_MANAGER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkRecentManager_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_STATUS_ICON(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkStatusIcon_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_PRINT_CONTEXT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkPrintContext_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_PRINT_OPERATION(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkPrintOperation_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_PRINT_OPERATION_PREVIEW(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkPrintOperationPreview_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_PRINT_SETTINGS(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkPrintSettings_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOOLTIP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkTooltip_"), XEN_CADR(obj)) : XEN_FALSE);}
-#if HAVE_GTK_INFO_BAR_NEW
-static XEN gxg_GTK_INFO_BAR(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkInfoBar_"), XEN_CADR(obj)) : XEN_FALSE);}
+#define Xen_is_wrapped_object(Obj) (Xen_is_list(Obj) && (Xen_list_length(Obj) >= 2) && (Xen_is_symbol(Xen_car(Obj))))
+
+static Xen gxg_GPOINTER(Xen obj) {return(Xen_list_2(xg_gpointer_symbol, (Xen_is_wrapped_object(obj)) ? Xen_cadr(obj) : Xen_wrap_C_pointer(obj)));}
+static Xen gxg_GDK_DRAG_CONTEXT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkDragContext__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_DEVICE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkDevice__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_KEYMAP(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkKeymap__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_VISUAL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkVisual__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_WINDOW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkWindow__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_PIXBUF(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkPixbuf__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_PIXBUF_ANIMATION(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkPixbufAnimation__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_PIXBUF_ANIMATION_ITER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkPixbufAnimationIter__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ACCEL_GROUP(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkAccelGroup__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ACCEL_LABEL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkAccelLabel__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ACCESSIBLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkAccessible__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ADJUSTMENT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkAdjustment__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ASPECT_FRAME(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkAspectFrame__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_BUTTON_BOX(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkButtonBox__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_BIN(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkBin__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_BOX(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkBox__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CALENDAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCalendar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_EDITABLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellEditable__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRenderer__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER_PIXBUF(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRendererPixbuf__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER_TEXT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRendererText__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER_TOGGLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRendererToggle__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CHECK_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCheckButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CHECK_MENU_ITEM(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCheckMenuItem__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CONTAINER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkContainer__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_DIALOG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkDialog__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_DRAWING_AREA(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkDrawingArea__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_EDITABLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEditable__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ENTRY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEntry__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_EVENT_BOX(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEventBox__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FIXED(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFixed__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FRAME(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFrame__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_IMAGE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkImage__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_IM_CONTEXT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkIMContext__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_IM_CONTEXT_SIMPLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkIMContextSimple__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_INVISIBLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkInvisible__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_LABEL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkLabel__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_LAYOUT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkLayout__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_LIST_STORE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkListStore__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_MENU_BAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkMenuBar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_MENU(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkMenu__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_MENU_ITEM(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkMenuItem__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_MENU_SHELL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkMenuShell__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_NOTEBOOK(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkNotebook__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_PANED(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPaned__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_PROGRESS_BAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkProgressBar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RADIO_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRadioButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RADIO_MENU_ITEM(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRadioMenuItem__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RANGE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRange__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SCALE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkScale__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SCROLLBAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkScrollbar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SCROLLED_WINDOW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkScrolledWindow__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SEPARATOR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSeparator__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SEPARATOR_MENU_ITEM(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSeparatorMenuItem__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SETTINGS(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSettings__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SIZE_GROUP(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSizeGroup__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SPIN_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSpinButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_STATUSBAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkStatusbar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TEXT_BUFFER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTextBuffer__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TEXT_CHILD_ANCHOR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTextChildAnchor__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TEXT_MARK(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTextMark__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TEXT_TAG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTextTag__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TEXT_TAG_TABLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTextTagTable__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TEXT_VIEW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTextView__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOGGLE_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkToggleButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOOLBAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkToolbar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_DRAG_SOURCE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeDragSource__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_DRAG_DEST(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeDragDest__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_MODEL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeModel__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_MODEL_SORT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeModelSort__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_SELECTION(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeSelection__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_SORTABLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeSortable__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_STORE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeStore__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_VIEW_COLUMN(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeViewColumn__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_VIEW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeView__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_VIEWPORT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkViewport__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_WIDGET(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkWidget__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_WINDOW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkWindow__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_PANGO_CONTEXT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_PangoContext__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_PANGO_FONT_FAMILY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_PangoFontFamily__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_PANGO_FONT_FACE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_PangoFontFace__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_PANGO_FONT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_PangoFont__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_PANGO_FONT_MAP(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_PangoFontMap__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_PANGO_LAYOUT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_PangoLayout__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_G_OBJECT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GObject__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_SCREEN(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkScreen__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_DISPLAY_OBJECT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkDisplay__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEvent__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_ANY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventAny__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_EXPOSE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventExpose__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_NOEXPOSE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventNoExpose__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_VISIBILITY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventVisibility__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_MOTION(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventMotion__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_SCROLL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventScroll__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_KEY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventKey__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_CROSSING(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventCrossing__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_FOCUS(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventFocus__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_CONFIGURE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventConfigure__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_PROPERTY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventProperty__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_SELECTION(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventSelection__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_PROXIMITY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventProximity__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_SETTING(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventSetting__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_WINDOWSTATE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventWindowState__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_EVENT_DND(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkEventDND__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FILE_CHOOSER_DIALOG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFileChooserDialog__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FILE_CHOOSER_WIDGET(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFileChooserWidget__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TREE_MODEL_FILTER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTreeModelFilter__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_COMBO_BOX(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkComboBox__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_EXPANDER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkExpander__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FONT_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFontButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_COLOR_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkColorButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ENTRY_COMPLETION(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEntryCompletion__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RADIO_TOOL_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRadioToolButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SEPARATOR_TOOL_ITEM(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSeparatorToolItem__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOGGLE_TOOL_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkToggleToolButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FILE_FILTER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFileFilter__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_LAYOUT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellLayout__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CLIPBOARD(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkClipboard__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FILE_CHOOSER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFileChooser__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ICON_THEME(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkIconTheme__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOOL_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkToolButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOOL_ITEM(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkToolItem__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ACCEL_MAP(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkAccelMap_symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_VIEW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellView__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ABOUT_DIALOG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkAboutDialog__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER_COMBO(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRendererCombo__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER_PROGRESS(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRendererProgress__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ICON_VIEW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkIconView__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FILE_CHOOSER_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFileChooserButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_MENU_TOOL_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkMenuToolButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ASSISTANT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkAssistant__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER_ACCEL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRendererAccel__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER_SPIN(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRendererSpin__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_LINK_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkLinkButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RECENT_CHOOSER_DIALOG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRecentChooserDialog__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RECENT_CHOOSER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRecentChooser__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RECENT_CHOOSER_MENU(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRecentChooserMenu__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RECENT_CHOOSER_WIDGET(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRecentChooserWidget__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RECENT_FILTER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRecentFilter__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_RECENT_MANAGER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRecentManager__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_PRINT_CONTEXT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPrintContext__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_PRINT_OPERATION(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPrintOperation__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_PRINT_OPERATION_PREVIEW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPrintOperationPreview__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_PRINT_SETTINGS(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPrintSettings__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOOLTIP(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkTooltip__symbol, Xen_cadr(obj)) : Xen_false);}
+#if GTK_CHECK_VERSION(2, 18, 0)
+static Xen gxg_GTK_INFO_BAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkInfoBar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ENTRY_BUFFER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEntryBuffer__symbol, Xen_cadr(obj)) : Xen_false);}
+#endif
+
+#if GTK_CHECK_VERSION(2, 20, 0)
+static Xen gxg_GTK_SPINNER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSpinner__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_CELL_RENDERER_SPINNER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkCellRendererSpinner__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOOL_PALETTE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkToolPalette__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOOL_ITEM_GROUP(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkToolItemGroup__symbol, Xen_cadr(obj)) : Xen_false);}
+#endif
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+static Xen gxg_GTK_COMBO_BOX_TEXT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkComboBoxText__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GRID(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGrid__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SCROLLABLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkScrollable__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_RGBA(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkRGBA__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SWITCH(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSwitch__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ORIENTABLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkOrientable__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_WINDOW_GROUP(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkWindowGroup__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_TOOL_SHELL(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkToolShell__symbol, Xen_cadr(obj)) : Xen_false);}
+#endif
+
+#if GTK_CHECK_VERSION(3, 2, 0)
+static Xen gxg_GTK_OVERLAY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkOverlay__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FONT_CHOOSER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFontChooser__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FONT_CHOOSER_DIALOG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFontChooserDialog__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FONT_CHOOSER_WIDGET(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFontChooserWidget__symbol, Xen_cadr(obj)) : Xen_false);}
+#endif
+
+#if GTK_CHECK_VERSION(3, 4, 0)
+static Xen gxg_GTK_APPLICATION_WINDOW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkApplicationWindow__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_COLOR_CHOOSER_DIALOG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkColorChooserDialog__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_COLOR_CHOOSER_WIDGET(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkColorWidget__symbol, Xen_cadr(obj)) : Xen_false);}
+#endif
+
+#if GTK_CHECK_VERSION(3, 6, 0)
+static Xen gxg_GTK_MENU_BUTTON(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkMenuButton__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SEARCH_ENTRY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkWidget__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_LEVEL_BAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkLevelBar__symbol, Xen_cadr(obj)) : Xen_false);}
+#endif
+
+#if GTK_CHECK_VERSION(3, 10, 0)
+static Xen gxg_GTK_PLACES_SIDEBAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPlacesSidebar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_STACK_SWITCHER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkStackSwitcher__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_STACK(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkStack__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_REVEALER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkRevealer__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_HEADER_BAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkHeaderBar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_LIST_BOX(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkListBox__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_LIST_BOX_ROW(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkListBoxRow__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_SEARCH_BAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkSearchBar__symbol, Xen_cadr(obj)) : Xen_false);}
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-static XEN gxg_GTK_ENTRY_BUFFER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkEntryBuffer_"), XEN_CADR(obj)) : XEN_FALSE);}
+#if GTK_CHECK_VERSION(3, 12, 0)
+static Xen gxg_GTK_FLOW_BOX(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFlowBox__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_FLOW_BOX_CHILD(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFlowBoxChild__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_ACTION_BAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkActionBar__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_POPOVER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPopover__symbol, Xen_cadr(obj)) : Xen_false);}
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-static XEN gxg_GTK_SPINNER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkSpinner_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_CELL_RENDERER_SPINNER(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkCellRendererSpinner_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOOL_PALETTE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToolPalette_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOOL_ITEM_GROUP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToolItemGroup_"), XEN_CADR(obj)) : XEN_FALSE);}
+#if GTK_CHECK_VERSION(3, 14, 0)
+static Xen gxg_GTK_GESTURE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGesture__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GESTURE_DRAG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGestureDrag__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GESTURE_LONG_PRESS(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGestureLongPress__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GESTURE_ZOOM(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGestureZoom__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GESTURE_SWIPE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGestureSwipe__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GESTURE_SINGLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGestureSingle__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GESTURE_PAN(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGesturePan__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GESTURE_MULTI_PRESS(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGestureMultiPress__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_GESTURE_ROTATE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGestureRotate__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_EVENT_CONTROLLER(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEventController__symbol, Xen_cadr(obj)) : Xen_false);}
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-static XEN gxg_GTK_COMBO_BOX_TEXT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkComboBoxText_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_GRID(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkGrid_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SCROLLABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkScrollable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_SWITCH(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkSwitch_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ACTIVATABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkActivatable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_ORIENTABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkOrientable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_WINDOW_GROUP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkWindowGroup_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_TOOL_SHELL(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkToolShell_"), XEN_CADR(obj)) : XEN_FALSE);}
+#if GTK_CHECK_VERSION(3, 16, 0)
+static Xen gxg_GTK_GL_AREA(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkGLArea__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GDK_GL_CONTEXT(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GdkGLContext__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_POPOVER_MENU(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkPopoverMenu__symbol, Xen_cadr(obj)) : Xen_false);}
+static Xen gxg_GTK_STACK_SIDEBAR(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkStackSidebar__symbol, Xen_cadr(obj)) : Xen_false);}
#endif
-#if (!HAVE_GTK_3)
-static XEN gxg_GDK_COLORMAP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkColormap_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_DRAWABLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkDrawable_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GDK_PIXMAP(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GdkPixmap_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_OBJECT(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkObject_"), XEN_CADR(obj)) : XEN_FALSE);}
-static XEN gxg_GTK_STYLE(XEN obj) {return((WRAPPED_OBJECT_P(obj)) ? XEN_LIST_2(C_STRING_TO_XEN_SYMBOL("GtkStyle_"), XEN_CADR(obj)) : XEN_FALSE);}
+static Xen gxg_GDK_IS_DRAG_CONTEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_DRAG_CONTEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_DEVICE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_DEVICE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_KEYMAP(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_KEYMAP((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_VISUAL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_VISUAL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_WINDOW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_WINDOW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_PIXBUF(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_PIXBUF((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_PIXBUF_ANIMATION(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_PIXBUF_ANIMATION((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_PIXBUF_ANIMATION_ITER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_PIXBUF_ANIMATION_ITER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ACCEL_GROUP(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ACCEL_GROUP((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ACCEL_LABEL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ACCEL_LABEL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ACCESSIBLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ACCESSIBLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ADJUSTMENT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ADJUSTMENT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ASPECT_FRAME(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ASPECT_FRAME((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_BUTTON_BOX(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_BUTTON_BOX((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_BIN(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_BIN((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_BOX(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_BOX((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CALENDAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CALENDAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_EDITABLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_EDITABLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER_PIXBUF(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER_PIXBUF((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER_TEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER_TEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER_TOGGLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER_TOGGLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CHECK_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CHECK_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CHECK_MENU_ITEM(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CHECK_MENU_ITEM((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CONTAINER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CONTAINER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_DIALOG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_DIALOG((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_DRAWING_AREA(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_DRAWING_AREA((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_EDITABLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_EDITABLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ENTRY(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ENTRY((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_EVENT_BOX(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_EVENT_BOX((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FIXED(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FIXED((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FRAME(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FRAME((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_IMAGE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_IMAGE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_IM_CONTEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_IM_CONTEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_IM_CONTEXT_SIMPLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_IM_CONTEXT_SIMPLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_INVISIBLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_INVISIBLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_LABEL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_LABEL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_LAYOUT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_LAYOUT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_LIST_STORE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_LIST_STORE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_MENU_BAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_MENU_BAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_MENU(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_MENU((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_MENU_ITEM(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_MENU_ITEM((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_MENU_SHELL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_MENU_SHELL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_NOTEBOOK(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_NOTEBOOK((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_PANED(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_PANED((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_PROGRESS_BAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_PROGRESS_BAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RADIO_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RADIO_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RADIO_MENU_ITEM(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RADIO_MENU_ITEM((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RANGE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RANGE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SCALE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SCALE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SCROLLBAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SCROLLBAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SCROLLED_WINDOW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SCROLLED_WINDOW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SEPARATOR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SEPARATOR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SEPARATOR_MENU_ITEM(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SEPARATOR_MENU_ITEM((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SETTINGS(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SETTINGS((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SIZE_GROUP(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SIZE_GROUP((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SPIN_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SPIN_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_STATUSBAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_STATUSBAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TEXT_BUFFER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TEXT_BUFFER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TEXT_CHILD_ANCHOR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TEXT_CHILD_ANCHOR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TEXT_MARK(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TEXT_MARK((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TEXT_TAG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TEXT_TAG((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TEXT_TAG_TABLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TEXT_TAG_TABLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TEXT_VIEW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TEXT_VIEW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOGGLE_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOGGLE_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOOLBAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOOLBAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_DRAG_SOURCE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_DRAG_SOURCE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_DRAG_DEST(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_DRAG_DEST((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_MODEL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_MODEL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_MODEL_SORT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_MODEL_SORT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_SELECTION(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_SELECTION((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_SORTABLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_SORTABLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_STORE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_STORE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_VIEW_COLUMN(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_VIEW_COLUMN((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_VIEW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_VIEW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_VIEWPORT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_VIEWPORT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_WIDGET(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_WIDGET((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_WINDOW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_WINDOW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_PANGO_IS_CONTEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && PANGO_IS_CONTEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_PANGO_IS_FONT_FAMILY(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && PANGO_IS_FONT_FAMILY((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_PANGO_IS_FONT_FACE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && PANGO_IS_FONT_FACE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_PANGO_IS_FONT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && PANGO_IS_FONT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_PANGO_IS_FONT_MAP(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && PANGO_IS_FONT_MAP((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_PANGO_IS_LAYOUT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && PANGO_IS_LAYOUT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_G_IS_OBJECT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && G_IS_OBJECT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_SCREEN(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_SCREEN((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_DISPLAY(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_DISPLAY((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FILE_CHOOSER_DIALOG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FILE_CHOOSER_DIALOG((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FILE_CHOOSER_WIDGET(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FILE_CHOOSER_WIDGET((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TREE_MODEL_FILTER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TREE_MODEL_FILTER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_COMBO_BOX(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_COMBO_BOX((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_EXPANDER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_EXPANDER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FONT_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FONT_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_COLOR_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_COLOR_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ENTRY_COMPLETION(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ENTRY_COMPLETION((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RADIO_TOOL_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RADIO_TOOL_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SEPARATOR_TOOL_ITEM(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SEPARATOR_TOOL_ITEM((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOGGLE_TOOL_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOGGLE_TOOL_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FILE_FILTER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FILE_FILTER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_LAYOUT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_LAYOUT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CLIPBOARD(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CLIPBOARD((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FILE_CHOOSER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FILE_CHOOSER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ICON_THEME(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ICON_THEME((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOOL_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOOL_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOOL_ITEM(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOOL_ITEM((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ACCEL_MAP(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ACCEL_MAP((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_VIEW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_VIEW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ABOUT_DIALOG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ABOUT_DIALOG((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER_COMBO(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER_COMBO((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER_PROGRESS(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER_PROGRESS((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ICON_VIEW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ICON_VIEW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FILE_CHOOSER_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FILE_CHOOSER_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_MENU_TOOL_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_MENU_TOOL_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ASSISTANT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ASSISTANT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER_ACCEL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER_ACCEL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER_SPIN(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER_SPIN((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_LINK_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_LINK_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RECENT_CHOOSER_DIALOG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RECENT_CHOOSER_DIALOG((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RECENT_CHOOSER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RECENT_CHOOSER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RECENT_CHOOSER_MENU(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RECENT_CHOOSER_MENU((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RECENT_CHOOSER_WIDGET(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RECENT_CHOOSER_WIDGET((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RECENT_FILTER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RECENT_FILTER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_RECENT_MANAGER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_RECENT_MANAGER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_PRINT_CONTEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_PRINT_CONTEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_PRINT_OPERATION(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_PRINT_OPERATION((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_PRINT_OPERATION_PREVIEW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_PRINT_OPERATION_PREVIEW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_PRINT_SETTINGS(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_PRINT_SETTINGS((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOOLTIP(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOOLTIP((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+#if GTK_CHECK_VERSION(2, 18, 0)
+static Xen gxg_GTK_IS_INFO_BAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_INFO_BAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ENTRY_BUFFER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ENTRY_BUFFER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
#endif
-static XEN gxg_GDK_IS_DRAG_CONTEXT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_DRAG_CONTEXT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_DEVICE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_DEVICE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_KEYMAP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_KEYMAP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_VISUAL(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_VISUAL((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_WINDOW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_WINDOW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_PIXBUF(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_PIXBUF((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_PIXBUF_ANIMATION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_PIXBUF_ANIMATION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_PIXBUF_ANIMATION_ITER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_PIXBUF_ANIMATION_ITER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_VBOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_VBOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ACCEL_GROUP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ACCEL_GROUP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ACCEL_LABEL(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ACCEL_LABEL((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ACCESSIBLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ACCESSIBLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ADJUSTMENT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ADJUSTMENT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ALIGNMENT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ALIGNMENT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ARROW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ARROW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ASPECT_FRAME(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ASPECT_FRAME((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_BUTTON_BOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_BUTTON_BOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_BIN(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_BIN((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_BOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_BOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CALENDAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CALENDAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_EDITABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_EDITABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER_PIXBUF(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER_PIXBUF((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER_TEXT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER_TEXT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER_TOGGLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER_TOGGLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CHECK_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CHECK_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CHECK_MENU_ITEM(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CHECK_MENU_ITEM((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_COLOR_SELECTION_DIALOG(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_COLOR_SELECTION_DIALOG((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_COLOR_SELECTION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_COLOR_SELECTION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CONTAINER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CONTAINER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_DIALOG(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_DIALOG((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_DRAWING_AREA(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_DRAWING_AREA((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_EDITABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_EDITABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ENTRY(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ENTRY((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_EVENT_BOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_EVENT_BOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FIXED(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FIXED((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FONT_SELECTION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FONT_SELECTION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FONT_SELECTION_DIALOG(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FONT_SELECTION_DIALOG((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FRAME(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FRAME((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_HANDLE_BOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_HANDLE_BOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_HBUTTON_BOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_HBUTTON_BOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_HBOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_HBOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_HPANED(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_HPANED((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_HSCALE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_HSCALE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_HSCROLLBAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_HSCROLLBAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_HSEPARATOR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_HSEPARATOR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ICON_FACTORY(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ICON_FACTORY((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_IMAGE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_IMAGE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_IMAGE_MENU_ITEM(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_IMAGE_MENU_ITEM((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_IM_CONTEXT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_IM_CONTEXT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_IM_CONTEXT_SIMPLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_IM_CONTEXT_SIMPLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_IM_MULTICONTEXT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_IM_MULTICONTEXT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_INVISIBLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_INVISIBLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_LABEL(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_LABEL((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_LAYOUT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_LAYOUT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_LIST_STORE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_LIST_STORE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_MENU_BAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_MENU_BAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_MENU(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_MENU((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_MENU_ITEM(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_MENU_ITEM((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_MENU_SHELL(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_MENU_SHELL((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_MISC(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_MISC((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_NOTEBOOK(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_NOTEBOOK((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_PANED(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_PANED((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_PROGRESS_BAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_PROGRESS_BAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RADIO_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RADIO_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RADIO_MENU_ITEM(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RADIO_MENU_ITEM((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RANGE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RANGE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SCALE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SCALE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SCROLLBAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SCROLLBAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SCROLLED_WINDOW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SCROLLED_WINDOW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SEPARATOR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SEPARATOR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SEPARATOR_MENU_ITEM(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SEPARATOR_MENU_ITEM((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SIZE_GROUP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SIZE_GROUP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SPIN_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SPIN_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_STATUSBAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_STATUSBAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TEAROFF_MENU_ITEM(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TEAROFF_MENU_ITEM((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TEXT_BUFFER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TEXT_BUFFER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TEXT_CHILD_ANCHOR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TEXT_CHILD_ANCHOR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TEXT_MARK(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TEXT_MARK((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TEXT_TAG(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TEXT_TAG((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TEXT_TAG_TABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TEXT_TAG_TABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TEXT_VIEW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TEXT_VIEW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOGGLE_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOGGLE_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOOLBAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOOLBAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_DRAG_SOURCE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_DRAG_SOURCE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_DRAG_DEST(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_DRAG_DEST((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_MODEL(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_MODEL((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_MODEL_SORT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_MODEL_SORT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_SELECTION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_SELECTION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_SORTABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_SORTABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_STORE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_STORE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_VIEW_COLUMN(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_VIEW_COLUMN((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_VIEW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_VIEW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_VBUTTON_BOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_VBUTTON_BOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_VIEWPORT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_VIEWPORT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_VPANED(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_VPANED((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_VSCALE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_VSCALE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_VSCROLLBAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_VSCROLLBAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_VSEPARATOR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_VSEPARATOR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_WIDGET(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_WIDGET((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_WINDOW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_WINDOW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_PANGO_IS_CONTEXT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && PANGO_IS_CONTEXT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_PANGO_IS_FONT_FAMILY(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && PANGO_IS_FONT_FAMILY((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_PANGO_IS_FONT_FACE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && PANGO_IS_FONT_FACE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_PANGO_IS_FONT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && PANGO_IS_FONT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_PANGO_IS_FONT_MAP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && PANGO_IS_FONT_MAP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_PANGO_IS_LAYOUT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && PANGO_IS_LAYOUT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_G_IS_OBJECT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && G_IS_OBJECT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_SCREEN(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_SCREEN((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_DISPLAY(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_DISPLAY((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FILE_CHOOSER_DIALOG(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FILE_CHOOSER_DIALOG((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FILE_CHOOSER_WIDGET(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FILE_CHOOSER_WIDGET((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TREE_MODEL_FILTER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TREE_MODEL_FILTER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ACTION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ACTION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ACTION_GROUP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ACTION_GROUP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_COMBO_BOX(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_COMBO_BOX((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_EXPANDER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_EXPANDER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FONT_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FONT_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_COLOR_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_COLOR_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ENTRY_COMPLETION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ENTRY_COMPLETION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RADIO_TOOL_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RADIO_TOOL_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RADIO_ACTION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RADIO_ACTION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SEPARATOR_TOOL_ITEM(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SEPARATOR_TOOL_ITEM((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOGGLE_ACTION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOGGLE_ACTION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOGGLE_TOOL_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOGGLE_TOOL_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FILE_FILTER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FILE_FILTER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_LAYOUT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_LAYOUT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CLIPBOARD(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CLIPBOARD((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FILE_CHOOSER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FILE_CHOOSER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ICON_THEME(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ICON_THEME((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOOL_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOOL_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOOL_ITEM(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOOL_ITEM((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ACCEL_MAP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ACCEL_MAP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_VIEW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_VIEW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ABOUT_DIALOG(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ABOUT_DIALOG((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER_COMBO(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER_COMBO((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER_PROGRESS(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER_PROGRESS((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ICON_VIEW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ICON_VIEW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_FILE_CHOOSER_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_FILE_CHOOSER_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_MENU_TOOL_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_MENU_TOOL_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ASSISTANT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ASSISTANT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER_ACCEL(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER_ACCEL((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER_SPIN(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER_SPIN((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_LINK_BUTTON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_LINK_BUTTON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RECENT_CHOOSER_DIALOG(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RECENT_CHOOSER_DIALOG((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RECENT_CHOOSER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RECENT_CHOOSER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RECENT_CHOOSER_MENU(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RECENT_CHOOSER_MENU((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RECENT_CHOOSER_WIDGET(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RECENT_CHOOSER_WIDGET((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RECENT_FILTER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RECENT_FILTER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RECENT_MANAGER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RECENT_MANAGER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_STATUS_ICON(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_STATUS_ICON((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_PRINT_CONTEXT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_PRINT_CONTEXT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_PRINT_OPERATION(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_PRINT_OPERATION((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_PRINT_OPERATION_PREVIEW(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_PRINT_OPERATION_PREVIEW((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_PRINT_SETTINGS(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_PRINT_SETTINGS((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOOLTIP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOOLTIP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-#if HAVE_GTK_INFO_BAR_NEW
-static XEN gxg_GTK_IS_INFO_BAR(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_INFO_BAR((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
+#if GTK_CHECK_VERSION(2, 20, 0)
+static Xen gxg_GTK_IS_SPINNER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SPINNER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_CELL_RENDERER_SPINNER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_CELL_RENDERER_SPINNER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOOL_PALETTE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOOL_PALETTE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOOL_ITEM_GROUP(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOOL_ITEM_GROUP((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-static XEN gxg_GTK_IS_ENTRY_BUFFER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ENTRY_BUFFER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
+#if GTK_CHECK_VERSION(3, 0, 0)
+static Xen gxg_GTK_IS_COMBO_BOX_TEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_COMBO_BOX_TEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GRID(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GRID((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SCROLLABLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SCROLLABLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SWITCH(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SWITCH((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ORIENTABLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ORIENTABLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_WINDOW_GROUP(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_WINDOW_GROUP((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_TOOL_SHELL(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_TOOL_SHELL((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-static XEN gxg_GTK_IS_SPINNER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SPINNER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_CELL_RENDERER_SPINNER(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_CELL_RENDERER_SPINNER((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOOL_PALETTE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOOL_PALETTE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOOL_ITEM_GROUP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOOL_ITEM_GROUP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
+#if GTK_CHECK_VERSION(3, 2, 0)
+static Xen gxg_GTK_IS_OVERLAY(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_OVERLAY((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FONT_CHOOSER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FONT_CHOOSER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FONT_CHOOSER_DIALOG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FONT_CHOOSER_DIALOG((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FONT_CHOOSER_WIDGET(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FONT_CHOOSER_WIDGET((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-static XEN gxg_GTK_IS_COMBO_BOX_TEXT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_COMBO_BOX_TEXT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_GRID(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_GRID((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SCROLLABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SCROLLABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_SWITCH(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_SWITCH((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ACTIVATABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ACTIVATABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_ORIENTABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_ORIENTABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_WINDOW_GROUP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_WINDOW_GROUP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_TOOL_SHELL(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_TOOL_SHELL((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
+#if GTK_CHECK_VERSION(3, 4, 0)
+static Xen gxg_GTK_IS_APPLICATION_WINDOW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_APPLICATION_WINDOW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_COLOR_CHOOSER_DIALOG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_COLOR_CHOOSER_DIALOG((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_COLOR_CHOOSER_WIDGET(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_COLOR_CHOOSER_WIDGET((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
#endif
-#if (!HAVE_GTK_3)
-static XEN gxg_GDK_IS_COLORMAP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_COLORMAP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_DRAWABLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_DRAWABLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GDK_IS_PIXMAP(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GDK_IS_PIXMAP((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_OBJECT(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_OBJECT((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_RC_STYLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_RC_STYLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
-static XEN gxg_GTK_IS_STYLE(XEN obj) {return(C_TO_XEN_BOOLEAN(WRAPPED_OBJECT_P(obj) && GTK_IS_STYLE((GTypeInstance *)XEN_UNWRAP_C_POINTER(XEN_CADR(obj)))));}
+#if GTK_CHECK_VERSION(3, 6, 0)
+static Xen gxg_GTK_IS_MENU_BUTTON(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_MENU_BUTTON((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SEARCH_ENTRY(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SEARCH_ENTRY((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_LEVEL_BAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_LEVEL_BAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+#endif
+
+#if GTK_CHECK_VERSION(3, 10, 0)
+static Xen gxg_GTK_IS_PLACES_SIDEBAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_PLACES_SIDEBAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_STACK_SWITCHER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_STACK_SWITCHER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_STACK(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_STACK((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_REVEALER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_REVEALER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_HEADER_BAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_HEADER_BAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_LIST_BOX(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_LIST_BOX((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_LIST_BOX_ROW(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_LIST_BOX_ROW((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_SEARCH_BAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_SEARCH_BAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+#endif
+
+#if GTK_CHECK_VERSION(3, 12, 0)
+static Xen gxg_GTK_IS_FLOW_BOX(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FLOW_BOX((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_FLOW_BOX_CHILD(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FLOW_BOX_CHILD((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_ACTION_BAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ACTION_BAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_POPOVER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_POPOVER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+#endif
+
+#if GTK_CHECK_VERSION(3, 14, 0)
+static Xen gxg_GTK_IS_GESTURE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GESTURE_DRAG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE_DRAG((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GESTURE_LONG_PRESS(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE_LONG_PRESS((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GESTURE_ZOOM(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE_ZOOM((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GESTURE_SWIPE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE_SWIPE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GESTURE_SINGLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE_SINGLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GESTURE_PAN(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE_PAN((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GESTURE_MULTI_PRESS(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE_MULTI_PRESS((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_GESTURE_ROTATE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GESTURE_ROTATE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_EVENT_CONTROLLER(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_EVENT_CONTROLLER((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+#endif
+
+#if GTK_CHECK_VERSION(3, 16, 0)
+static Xen gxg_GTK_IS_GL_AREA(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_GL_AREA((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GDK_IS_GL_CONTEXT(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GDK_IS_GL_CONTEXT((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_POPOVER_MENU(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_POPOVER_MENU((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
+static Xen gxg_GTK_IS_STACK_SIDEBAR(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_STACK_SIDEBAR((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
#endif
/* ---------------------------------------- special functions ---------------------------------------- */
-static XEN gxg_gtk_init(XEN argc, XEN argv)
+static Xen gxg_gtk_init(Xen argc, Xen argv)
{
#define H_gtk_init "void gtk_init(int* argc, char*** argv)"
int ref_argc = 0;
char** ref_argv = NULL;
- if (XEN_BOUND_P(argv))
+ if (Xen_is_bound(argv))
{
- if (XEN_BOUND_P(argc) && XEN_INTEGER_P(argc) && XEN_TO_C_int(argc) <= XEN_LIST_LENGTH(argv))
- ref_argc = XEN_TO_C_int(argc);
- else ref_argc = XEN_LIST_LENGTH(argv);
+ if (Xen_is_bound(argc) && Xen_is_integer(argc) && Xen_to_C_int(argc) <= Xen_list_length(argv))
+ ref_argc = Xen_to_C_int(argc);
+ else ref_argc = Xen_list_length(argv);
}
ref_argv = (char**)calloc(ref_argc, sizeof(char*));
{
int i;
- XEN lst;
- lst = XEN_COPY_ARG(argv);
- for (i = 0; i < ref_argc; i++, lst = XEN_CDR(lst)) ref_argv[i] = XEN_TO_C_char_(XEN_CAR(lst));
+ Xen lst;
+ lst = Xen_copy_arg(argv);
+ for (i = 0; i < ref_argc; i++, lst = Xen_cdr(lst)) ref_argv[i] = Xen_to_C_char_(Xen_car(lst));
}
gtk_init(&ref_argc, &ref_argv);
- return(XEN_LIST_2(C_TO_XEN_int(ref_argc), C_TO_XEN_char__(ref_argv)));
+ return(Xen_list_2(C_to_Xen_int(ref_argc), C_to_Xen_char__(ref_argv)));
}
-static XEN gxg_gtk_init_check(XEN argc, XEN argv)
+static Xen gxg_gtk_init_check(Xen argc, Xen argv)
{
#define H_gtk_init_check "gboolean gtk_init_check(int* argc, char*** argv)"
int ref_argc = 0;
char** ref_argv = NULL;
- if (XEN_BOUND_P(argc) && XEN_LIST_P(argc))
+ if (Xen_is_bound(argc) && Xen_is_list(argc))
{
argv = argc;
- ref_argc = XEN_LIST_LENGTH(argv);
+ ref_argc = Xen_list_length(argv);
}
else
{
- if (XEN_BOUND_P(argv))
+ if (Xen_is_bound(argv))
{
int len;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(argc), argc, 1, "gtk_init_check", "int argc");
- XEN_ASSERT_TYPE(XEN_LIST_P(argv), argv, 2, "gtk_init_check", "char *argv[]");
- len = XEN_LIST_LENGTH(argv);
- ref_argc = XEN_TO_C_int(argc);
+ Xen_check_type(Xen_is_integer(argc), argc, 1, "gtk_init_check", "int argc");
+ Xen_check_type(Xen_is_list(argv), argv, 2, "gtk_init_check", "char *argv[]");
+ len = Xen_list_length(argv);
+ ref_argc = Xen_to_C_int(argc);
if (ref_argc > len) ref_argc = len;
}
}
ref_argv = (char**)calloc(ref_argc, sizeof(char*));
{
int i;
- XEN lst;
- lst = XEN_COPY_ARG(argv);
- for (i = 0; i < ref_argc; i++, lst = XEN_CDR(lst)) ref_argv[i] = XEN_TO_C_char_(XEN_CAR(lst));
+ Xen lst;
+ lst = Xen_copy_arg(argv);
+ for (i = 0; i < ref_argc; i++, lst = Xen_cdr(lst)) ref_argv[i] = Xen_to_C_char_(Xen_car(lst));
}
{
- XEN result = XEN_FALSE;
- result = C_TO_XEN_gboolean(gtk_init_check(&ref_argc, &ref_argv));
- return(XEN_LIST_3(result, C_TO_XEN_int(ref_argc), C_TO_XEN_char__(ref_argv)));
+ Xen result;
+ result = C_to_Xen_gboolean(gtk_init_check(&ref_argc, &ref_argv));
+ return(Xen_list_3(result, C_to_Xen_int(ref_argc), C_to_Xen_char__(ref_argv)));
}
}
-static XEN gxg_make_target_entry(XEN lst)
+static Xen gxg_make_target_entry(Xen lst)
{
GtkTargetEntry* targets;
- XEN val;
int i, len;
#define H_make_target_entry "(make-target-entry lst): GtkTargetEntry*, each member of 'lst' should be (list target flags info)"
- XEN_ASSERT_TYPE(XEN_LIST_P(lst), lst, XEN_ONLY_ARG, "make-target-entry", "a list of lists describing each target");
- len = XEN_LIST_LENGTH(lst);
- if (len == 0) return(XEN_FALSE);
+ Xen_check_type(Xen_is_list(lst), lst, 1, "make-target-entry", "a list of lists describing each target");
+ len = Xen_list_length(lst);
+ if (len == 0) return(Xen_false);
targets = (GtkTargetEntry *)calloc(len, sizeof(GtkTargetEntry));
for (i = 0; i < len; i++)
{
- val = XEN_LIST_REF(lst, i);
- targets[i].target = xen_strdup(XEN_TO_C_STRING(XEN_LIST_REF(val, 0)));
- targets[i].flags = (guint)XEN_TO_C_ULONG(XEN_LIST_REF(val, 1));
- targets[i].info = (guint)XEN_TO_C_ULONG(XEN_LIST_REF(val, 2));
+ Xen val;
+ val = Xen_list_ref(lst, i);
+ targets[i].target = xen_strdup(Xen_string_to_C_string(Xen_list_ref(val, 0)));
+ targets[i].flags = (guint)Xen_ulong_to_C_ulong(Xen_list_ref(val, 1));
+ targets[i].info = (guint)Xen_ulong_to_C_ulong(Xen_list_ref(val, 2));
}
- return(C_TO_XEN_GtkTargetEntry_(targets));
+ return(C_to_Xen_GtkTargetEntry_(targets));
}
-/* ---------------------------------------- structs ---------------------------------------- */
-
- #if HAVE_RUBY
- #define XG_DEFINE_ACCESSOR(Name, Value, SetValue, A1, A2, A3, A4) \
- XEN_DEFINE_PROCEDURE_WITH_SETTER(XG_FIELD_PRE #Name XG_POST, Value, #Name " field accessor", XG_FIELD_PRE "set_" #Name XG_POST, SetValue, A1, A2, A3, A4)
- #endif
- #if HAVE_SCHEME
- #define XG_DEFINE_ACCESSOR(Name, Value, SetValue, A1, A2, A3, A4) \
- XEN_DEFINE_PROCEDURE_WITH_SETTER(XG_FIELD_PRE #Name XG_POST, Value, #Name " field accessor", "set! " XG_FIELD_PRE #Name XG_POST, SetValue, A1, A2, A3, A4)
- #endif
-
- #if HAVE_FORTH
- #define XG_DEFINE_ACCESSOR(Name, Value, SetValue, A1, A2, A3, A4) \
- XEN_DEFINE_PROCEDURE_WITH_SETTER(XG_FIELD_PRE #Name XG_POST, Value, #Name " field accessor", "set-" XG_FIELD_PRE #Name XG_POST, SetValue, A1, A2, A3, A4)
- #endif
/* conversions */
-static XEN c_array_to_xen_list(XEN val_1, XEN clen)
+static Xen c_array_to_xen_list(Xen val_1, Xen clen)
{
- XEN result = XEN_EMPTY_LIST;
- XEN val;
+ Xen result = Xen_empty_list;
+ Xen val, ctype;
int i, len = -1;
- const char *ctype;
- if (XEN_INTEGER_P(clen))
- len = XEN_TO_C_INT(clen);
- if (!(XEN_LIST_P(val_1))) return(XEN_FALSE); /* type:location cons */
- val = XEN_COPY_ARG(val_1); /* protect Ruby arg */
- ctype = XEN_SYMBOL_TO_C_STRING(XEN_CAR(val));
- if (strcmp(ctype, "gboolean_") == 0)
- {
- gboolean* arr; arr = (gboolean*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
- if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_gboolean(arr[i]), result);
- }
- if (strcmp(ctype, "gdouble_") == 0)
+ if (Xen_is_integer(clen))
+ len = Xen_integer_to_C_int(clen);
+ if (!(Xen_is_list(val_1))) return(Xen_false); /* type:location cons */
+ val = Xen_copy_arg(val_1); /* protect Ruby arg */
+ ctype = Xen_car(val);
+ if (ctype == xg_gboolean__symbol)
{
- gdouble* arr; arr = (gdouble*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ gboolean* arr; arr = (gboolean*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_gdouble(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_gboolean(arr[i]), result);
}
- if (strcmp(ctype, "GType_") == 0)
+ if (ctype == xg_gdouble__symbol)
{
- GType* arr; arr = (GType*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ gdouble* arr; arr = (gdouble*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_GType(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_gdouble(arr[i]), result);
}
- if (strcmp(ctype, "guint_") == 0)
+ if (ctype == xg_gunichar__symbol)
{
- guint* arr; arr = (guint*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ gunichar* arr; arr = (gunichar*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_guint(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_gunichar(arr[i]), result);
}
- if (strcmp(ctype, "gchar__") == 0)
+ if (ctype == xg_GType__symbol)
{
- gchar** arr; arr = (gchar**)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ GType* arr; arr = (GType*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_gchar_(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_GType(arr[i]), result);
}
- if (strcmp(ctype, "guchar_") == 0)
+ if (ctype == xg_guint__symbol)
{
- guchar* arr; arr = (guchar*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ guint* arr; arr = (guint*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_guchar(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_guint(arr[i]), result);
}
- if (strcmp(ctype, "gint_") == 0)
+ if (ctype == xg_gchar___symbol)
{
- gint* arr; arr = (gint*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ gchar** arr; arr = (gchar**)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_gint(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_gchar_(arr[i]), result);
}
- if (strcmp(ctype, "GdkVisualType_") == 0)
+ if (ctype == xg_guchar__symbol)
{
- GdkVisualType* arr; arr = (GdkVisualType*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ guchar* arr; arr = (guchar*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_GdkVisualType(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_guchar(arr[i]), result);
}
- if (strcmp(ctype, "char__") == 0)
+ if (ctype == xg_gint__symbol)
{
- char** arr; arr = (char**)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ gint* arr; arr = (gint*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_char_(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_gint(arr[i]), result);
}
- if (strcmp(ctype, "GtkIconSize_") == 0)
+ if (ctype == xg_GdkVisualType__symbol)
{
- GtkIconSize* arr; arr = (GtkIconSize*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ GdkVisualType* arr; arr = (GdkVisualType*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_GtkIconSize(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_GdkVisualType(arr[i]), result);
}
- if (strcmp(ctype, "guint16_") == 0)
+ if (ctype == xg_char___symbol)
{
- guint16* arr; arr = (guint16*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ char** arr; arr = (char**)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_guint16(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_char_(arr[i]), result);
}
- if (strcmp(ctype, "gunichar_") == 0)
+ if (ctype == xg_guint16__symbol)
{
- gunichar* arr; arr = (gunichar*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ guint16* arr; arr = (guint16*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_gunichar(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_guint16(arr[i]), result);
}
- if (strcmp(ctype, "int_") == 0)
+ if (ctype == xg_int__symbol)
{
- int* arr; arr = (int*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ int* arr; arr = (int*)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_int(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_int(arr[i]), result);
}
- if (strcmp(ctype, "PangoFontFace__") == 0)
+ if (ctype == xg_PangoFontFace___symbol)
{
- PangoFontFace** arr; arr = (PangoFontFace**)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ PangoFontFace** arr; arr = (PangoFontFace**)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_PangoFontFace_(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_PangoFontFace_(arr[i]), result);
}
- if (strcmp(ctype, "PangoFontDescription__") == 0)
+ if (ctype == xg_PangoFontDescription___symbol)
{
- PangoFontDescription** arr; arr = (PangoFontDescription**)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ PangoFontDescription** arr; arr = (PangoFontDescription**)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_PangoFontDescription_(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_PangoFontDescription_(arr[i]), result);
}
- if (strcmp(ctype, "PangoFontFamily__") == 0)
+ if (ctype == xg_PangoFontFamily___symbol)
{
- PangoFontFamily** arr; arr = (PangoFontFamily**)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ PangoFontFamily** arr; arr = (PangoFontFamily**)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_PangoFontFamily_(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_PangoFontFamily_(arr[i]), result);
}
- if (strcmp(ctype, "PangoAttrList__") == 0)
+ if (ctype == xg_PangoAttrList___symbol)
{
- PangoAttrList** arr; arr = (PangoAttrList**)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ PangoAttrList** arr; arr = (PangoAttrList**)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_PangoAttrList_(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_PangoAttrList_(arr[i]), result);
}
- if (strcmp(ctype, "GtkTreeModel__") == 0)
+ if (ctype == xg_GtkTreeModel___symbol)
{
- GtkTreeModel** arr; arr = (GtkTreeModel**)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ GtkTreeModel** arr; arr = (GtkTreeModel**)Xen_unwrap_C_pointer(Xen_cadr(val));
if (len == -1) {for (i = 0; arr[i]; i++) {}; len = i;}
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_GtkTreeModel_(arr[i]), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_to_Xen_GtkTreeModel_(arr[i]), result);
}
- if (strcmp(ctype, "GList_") == 0)
+ if (ctype == xg_GList__symbol)
{ /* tagging these pointers is currently up to the caller */
GList* lst;
- lst = (GList*)XEN_UNWRAP_C_POINTER(XEN_CADR(val));
+ lst = (GList*)Xen_unwrap_C_pointer(Xen_cadr(val));
len = g_list_length(lst);
- for (i = len - 1; i >= 0; i--) result = XEN_CONS(C_TO_XEN_ULONG(g_list_nth_data(lst, i)), result);
+ for (i = len - 1; i >= 0; i--) result = Xen_cons(C_ulong_to_Xen_ulong(g_list_nth_data(lst, i)), result);
}
return(result);
}
-static XEN xg_object_get(XEN val, XEN name, XEN string_type)
+static Xen xg_object_get(Xen val, Xen name, Xen string_type)
{
gint temp; gchar *str;
- XEN_ASSERT_TYPE(XEN_gpointer_P(val), val, 1, "g_object_get", "gpointer");
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, 2, "g_object_get", "string");
- if (XEN_FALSE_P(string_type))
- {g_object_get(XEN_TO_C_gpointer(val), (const gchar *)(XEN_TO_C_STRING(name)), &temp, NULL); return(C_TO_XEN_INT(temp));}
- else {g_object_get(XEN_TO_C_gpointer(val), (const gchar *)(XEN_TO_C_STRING(name)), &str, NULL); return(C_TO_XEN_STRING(str));}
+ Xen_check_type(Xen_is_gpointer(val), val, 1, "g_object_get", "gpointer");
+ Xen_check_type(Xen_is_string(name), name, 2, "g_object_get", "string");
+ if (Xen_is_false(string_type))
+ {g_object_get(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), &temp, NULL); return(C_int_to_Xen_integer(temp));}
+ else {g_object_get(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), &str, NULL); return(C_string_to_Xen_string(str));}
+}
+
+static Xen xg_object_set(Xen val, Xen name, Xen new_val)
+{
+ Xen_check_type(Xen_is_gpointer(val), val, 1, "g_object_set", "gpointer");
+ Xen_check_type(Xen_is_string(name), name, 2, "g_object_set", "string");
+ if (Xen_is_boolean(new_val))
+ g_object_set(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), Xen_boolean_to_C_bool(new_val), NULL);
+ else
+ {
+ if (Xen_is_number(new_val))
+ g_object_set(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), Xen_integer_to_C_int(new_val), NULL);
+ else g_object_set(Xen_to_C_gpointer(val), (const gchar *)(Xen_string_to_C_string(name)), Xen_string_to_C_string(new_val), NULL);
+ }
+ return(new_val);
}
-static XEN xg_gtk_event_keyval(XEN event)
+static Xen xg_gtk_event_keyval(Xen event)
{
GdkEventKey *e;
- e = XEN_TO_C_GdkEventKey_(event);
- return(C_TO_XEN_INT((int)(e->keyval)));
+ e = Xen_to_C_GdkEventKey_(event);
+ if (e) return(C_int_to_Xen_integer((int)(e->keyval))); return(XEN_ZERO);
}
-static XEN xen_list_to_c_array(XEN val, XEN type)
+static Xen xen_list_to_c_array(Xen val, Xen type)
{
int i, len;
- const char *ctype;
- len = XEN_LIST_LENGTH(val);
- ctype = XEN_TO_C_STRING(type);
- if (strcmp(ctype, "gboolean*") == 0)
+ len = Xen_list_length(val);
+ if (type == xg_gboolean__symbol)
{
gboolean* arr; arr = (gboolean*)calloc(len + 1, sizeof(gboolean));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_gboolean(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("gboolean_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_gboolean(Xen_car(val));
+ return(Xen_list_3(xg_gboolean__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "gdouble*") == 0)
+ if (type == xg_gdouble__symbol)
{
gdouble* arr; arr = (gdouble*)calloc(len + 1, sizeof(gdouble));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_gdouble(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("gdouble_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_gdouble(Xen_car(val));
+ return(Xen_list_3(xg_gdouble__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
+ }
+ if (type == xg_gunichar__symbol)
+ {
+ gunichar* arr; arr = (gunichar*)calloc(len + 1, sizeof(gunichar));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_gunichar(Xen_car(val));
+ return(Xen_list_3(xg_gunichar__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "GType*") == 0)
+ if (type == xg_GType__symbol)
{
GType* arr; arr = (GType*)calloc(len + 1, sizeof(GType));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_GType(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("GType_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_GType(Xen_car(val));
+ return(Xen_list_3(xg_GType__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "guint*") == 0)
+ if (type == xg_guint__symbol)
{
guint* arr; arr = (guint*)calloc(len + 1, sizeof(guint));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_guint(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("guint_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_guint(Xen_car(val));
+ return(Xen_list_3(xg_guint__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "gchar**") == 0)
+ if (type == xg_gchar___symbol)
{
gchar** arr; arr = (gchar**)calloc(len + 1, sizeof(gchar*));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_gchar_(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("gchar__"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_gchar_(Xen_car(val));
+ return(Xen_list_3(xg_gchar___symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "guchar*") == 0)
+ if (type == xg_guchar__symbol)
{
guchar* arr; arr = (guchar*)calloc(len + 1, sizeof(guchar));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_guchar(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("guchar_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_guchar(Xen_car(val));
+ return(Xen_list_3(xg_guchar__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "gint*") == 0)
+ if (type == xg_gint__symbol)
{
gint* arr; arr = (gint*)calloc(len + 1, sizeof(gint));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_gint(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("gint_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_gint(Xen_car(val));
+ return(Xen_list_3(xg_gint__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "GdkVisualType*") == 0)
+ if (type == xg_GdkVisualType__symbol)
{
GdkVisualType* arr; arr = (GdkVisualType*)calloc(len + 1, sizeof(GdkVisualType));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_GdkVisualType(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("GdkVisualType_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_GdkVisualType(Xen_car(val));
+ return(Xen_list_3(xg_GdkVisualType__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "char**") == 0)
+ if (type == xg_char___symbol)
{
char** arr; arr = (char**)calloc(len + 1, sizeof(char*));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_char_(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("char__"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
- }
- if (strcmp(ctype, "GtkIconSize*") == 0)
- {
- GtkIconSize* arr; arr = (GtkIconSize*)calloc(len + 1, sizeof(GtkIconSize));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_GtkIconSize(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("GtkIconSize_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_char_(Xen_car(val));
+ return(Xen_list_3(xg_char___symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "guint16*") == 0)
+ if (type == xg_guint16__symbol)
{
guint16* arr; arr = (guint16*)calloc(len + 1, sizeof(guint16));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_guint16(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("guint16_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
- }
- if (strcmp(ctype, "gunichar*") == 0)
- {
- gunichar* arr; arr = (gunichar*)calloc(len + 1, sizeof(gunichar));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_gunichar(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("gunichar_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_guint16(Xen_car(val));
+ return(Xen_list_3(xg_guint16__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "int*") == 0)
+ if (type == xg_int__symbol)
{
int* arr; arr = (int*)calloc(len + 1, sizeof(int));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_int(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("int_"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_int(Xen_car(val));
+ return(Xen_list_3(xg_int__symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "PangoFontFace**") == 0)
+ if (type == xg_PangoFontFace___symbol)
{
PangoFontFace** arr; arr = (PangoFontFace**)calloc(len + 1, sizeof(PangoFontFace*));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_PangoFontFace_(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("PangoFontFace__"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_PangoFontFace_(Xen_car(val));
+ return(Xen_list_3(xg_PangoFontFace___symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "PangoFontDescription**") == 0)
+ if (type == xg_PangoFontDescription___symbol)
{
PangoFontDescription** arr; arr = (PangoFontDescription**)calloc(len + 1, sizeof(PangoFontDescription*));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_PangoFontDescription_(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("PangoFontDescription__"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_PangoFontDescription_(Xen_car(val));
+ return(Xen_list_3(xg_PangoFontDescription___symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "PangoFontFamily**") == 0)
+ if (type == xg_PangoFontFamily___symbol)
{
PangoFontFamily** arr; arr = (PangoFontFamily**)calloc(len + 1, sizeof(PangoFontFamily*));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_PangoFontFamily_(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("PangoFontFamily__"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_PangoFontFamily_(Xen_car(val));
+ return(Xen_list_3(xg_PangoFontFamily___symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "PangoAttrList**") == 0)
+ if (type == xg_PangoAttrList___symbol)
{
PangoAttrList** arr; arr = (PangoAttrList**)calloc(len + 1, sizeof(PangoAttrList*));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_PangoAttrList_(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("PangoAttrList__"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_PangoAttrList_(Xen_car(val));
+ return(Xen_list_3(xg_PangoAttrList___symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- if (strcmp(ctype, "GtkTreeModel**") == 0)
+ if (type == xg_GtkTreeModel___symbol)
{
GtkTreeModel** arr; arr = (GtkTreeModel**)calloc(len + 1, sizeof(GtkTreeModel*));
- for (i = 0; i < len; i++, val = XEN_CDR(val)) arr[i] = XEN_TO_C_GtkTreeModel_(XEN_CAR(val));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("GtkTreeModel__"), XEN_WRAP_C_POINTER(arr), make_xm_obj(arr)));
+ for (i = 0; i < len; i++, val = Xen_cdr(val)) arr[i] = Xen_to_C_GtkTreeModel_(Xen_car(val));
+ return(Xen_list_3(xg_GtkTreeModel___symbol, Xen_wrap_C_pointer(arr), make_xm_obj(arr)));
}
- return(XEN_FALSE);
-}
-
-
-static XEN gxg_pixel(XEN ptr)
-{
- XEN_ASSERT_TYPE(XEN_GdkColor__P(ptr), ptr, XEN_ONLY_ARG, "pixel", "GdkColor");
- return(C_TO_XEN_guint32((guint32)((XEN_TO_C_GdkColor_(ptr))->pixel)));
-}
-
-static XEN gxg_red(XEN ptr)
-{
- XEN_ASSERT_TYPE(XEN_GdkColor__P(ptr), ptr, XEN_ONLY_ARG, "red", "GdkColor");
- return(C_TO_XEN_guint16((guint16)((XEN_TO_C_GdkColor_(ptr))->red)));
-}
-
-static XEN gxg_green(XEN ptr)
-{
- XEN_ASSERT_TYPE(XEN_GdkColor__P(ptr), ptr, XEN_ONLY_ARG, "green", "GdkColor");
- return(C_TO_XEN_guint16((guint16)((XEN_TO_C_GdkColor_(ptr))->green)));
-}
-
-static XEN gxg_blue(XEN ptr)
-{
- XEN_ASSERT_TYPE(XEN_GdkColor__P(ptr), ptr, XEN_ONLY_ARG, "blue", "GdkColor");
- return(C_TO_XEN_guint16((guint16)((XEN_TO_C_GdkColor_(ptr))->blue)));
-}
-
-static XEN gxg_set_pixel(XEN ptr, XEN val)
-{
- XEN_ASSERT_TYPE(XEN_GdkColor__P(ptr), ptr, XEN_ARG_1, "pixel", "GdkColor");
- (XEN_TO_C_GdkColor_(ptr))->pixel = XEN_TO_C_guint32(val);
- return(val);
-}
-
-static XEN gxg_set_red(XEN ptr, XEN val)
-{
- XEN_ASSERT_TYPE(XEN_GdkColor__P(ptr), ptr, XEN_ARG_1, "red", "GdkColor");
- (XEN_TO_C_GdkColor_(ptr))->red = XEN_TO_C_guint16(val);
- return(val);
-}
-
-static XEN gxg_set_green(XEN ptr, XEN val)
-{
- XEN_ASSERT_TYPE(XEN_GdkColor__P(ptr), ptr, XEN_ARG_1, "green", "GdkColor");
- (XEN_TO_C_GdkColor_(ptr))->green = XEN_TO_C_guint16(val);
- return(val);
-}
-
-static XEN gxg_set_blue(XEN ptr, XEN val)
-{
- XEN_ASSERT_TYPE(XEN_GdkColor__P(ptr), ptr, XEN_ARG_1, "blue", "GdkColor");
- (XEN_TO_C_GdkColor_(ptr))->blue = XEN_TO_C_guint16(val);
- return(val);
-}
-static XEN gxg_make_GdkColor(XEN arglist)
-{
- GdkColor* result;
- int i, len;
- result = (GdkColor*)calloc(1, sizeof(GdkColor));
- len = XEN_LIST_LENGTH(arglist);
- for (i = 0; i < len; i++)
- switch (i)
- {
- case 0: result->pixel = XEN_TO_C_guint32(XEN_LIST_REF(arglist, 0));
- case 1: result->red = XEN_TO_C_guint16(XEN_LIST_REF(arglist, 1));
- case 2: result->green = XEN_TO_C_guint16(XEN_LIST_REF(arglist, 2));
- case 3: result->blue = XEN_TO_C_guint16(XEN_LIST_REF(arglist, 3));
- }
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("GdkColor_"), XEN_WRAP_C_POINTER(result), make_xm_obj(result)));
+ return(Xen_false);
}
-
-static XEN gxg_make_GtkTextIter(void)
+static Xen gxg_make_GtkTextIter(void)
{
GtkTextIter* result;
result = (GtkTextIter*)calloc(1, sizeof(GtkTextIter));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("GtkTextIter_"), XEN_WRAP_C_POINTER(result), make_xm_obj(result)));
+ return(Xen_list_3(C_string_to_Xen_symbol("GtkTextIter_"), Xen_wrap_C_pointer(result), make_xm_obj(result)));
}
-static XEN gxg_make_GtkTreeIter(void)
+static Xen gxg_make_GtkTreeIter(void)
{
GtkTreeIter* result;
result = (GtkTreeIter*)calloc(1, sizeof(GtkTreeIter));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("GtkTreeIter_"), XEN_WRAP_C_POINTER(result), make_xm_obj(result)));
+ return(Xen_list_3(C_string_to_Xen_symbol("GtkTreeIter_"), Xen_wrap_C_pointer(result), make_xm_obj(result)));
}
-static XEN gxg_make_PangoRectangle(void)
+static Xen gxg_make_PangoRectangle(void)
{
PangoRectangle* result;
result = (PangoRectangle*)calloc(1, sizeof(PangoRectangle));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("PangoRectangle_"), XEN_WRAP_C_POINTER(result), make_xm_obj(result)));
+ return(Xen_list_3(C_string_to_Xen_symbol("PangoRectangle_"), Xen_wrap_C_pointer(result), make_xm_obj(result)));
}
-static XEN gxg_make_cairo_matrix_t(void)
+static Xen gxg_make_cairo_matrix_t(void)
{
cairo_matrix_t* result;
result = (cairo_matrix_t*)calloc(1, sizeof(cairo_matrix_t));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("cairo_matrix_t_"), XEN_WRAP_C_POINTER(result), make_xm_obj(result)));
+ return(Xen_list_3(C_string_to_Xen_symbol("cairo_matrix_t_"), Xen_wrap_C_pointer(result), make_xm_obj(result)));
}
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-static XEN gxg_make_GdkRGBA(void)
+#if GTK_CHECK_VERSION(3, 0, 0)
+static Xen gxg_make_GdkRGBA(void)
{
GdkRGBA* result;
result = (GdkRGBA*)calloc(1, sizeof(GdkRGBA));
- return(XEN_LIST_3(C_STRING_TO_XEN_SYMBOL("GdkRGBA_"), XEN_WRAP_C_POINTER(result), make_xm_obj(result)));
+ return(Xen_list_3(C_string_to_Xen_symbol("GdkRGBA_"), Xen_wrap_C_pointer(result), make_xm_obj(result)));
}
+#endif
+
+#if HAVE_SCHEME
+ #define Xg_define_procedure(Name, Value, A1, A2, A3, Help, Sig) s7_define_typed_function(s7, Xg_pre #Name Xg_post, Value, A1, A2, A3, Help, Sig)
+#else
+ #define Xg_define_procedure(Name, Value, A1, A2, A3, Help, Sig) Xen_define_safe_procedure(Xg_pre #Name Xg_post, Value, A1, A2, A3, Help)
+#endif
+Xen_wrap_no_args(gxg_make_GtkTextIter_w, gxg_make_GtkTextIter)
+Xen_wrap_no_args(gxg_make_GtkTreeIter_w, gxg_make_GtkTreeIter)
+Xen_wrap_no_args(gxg_make_PangoRectangle_w, gxg_make_PangoRectangle)
+Xen_wrap_no_args(gxg_make_cairo_matrix_t_w, gxg_make_cairo_matrix_t)
+#if GTK_CHECK_VERSION(3, 0, 0)
+Xen_wrap_no_args(gxg_make_GdkRGBA_w, gxg_make_GdkRGBA)
#endif
-#ifdef XEN_ARGIFY_1
-XEN_NARGIFY_1(gxg_g_type_name_w, gxg_g_type_name)
-XEN_NARGIFY_1(gxg_g_type_qname_w, gxg_g_type_qname)
-XEN_NARGIFY_1(gxg_g_type_from_name_w, gxg_g_type_from_name)
-XEN_NARGIFY_1(gxg_g_type_parent_w, gxg_g_type_parent)
-XEN_NARGIFY_2(gxg_g_type_is_a_w, gxg_g_type_is_a)
-XEN_NARGIFY_3(gxg_g_cclosure_new_w, gxg_g_cclosure_new)
-XEN_VARGIFY(gxg_g_signal_newv_w, gxg_g_signal_newv)
-XEN_NARGIFY_2(gxg_g_signal_lookup_w, gxg_g_signal_lookup)
-XEN_NARGIFY_1(gxg_g_signal_name_w, gxg_g_signal_name)
-XEN_NARGIFY_2(gxg_g_signal_query_w, gxg_g_signal_query)
-XEN_NARGIFY_2(gxg_g_signal_list_ids_w, gxg_g_signal_list_ids)
-XEN_ARGIFY_5(gxg_g_signal_parse_name_w, gxg_g_signal_parse_name)
-XEN_NARGIFY_1(gxg_g_signal_get_invocation_hint_w, gxg_g_signal_get_invocation_hint)
-XEN_NARGIFY_3(gxg_g_signal_stop_emission_w, gxg_g_signal_stop_emission)
-XEN_NARGIFY_2(gxg_g_signal_stop_emission_by_name_w, gxg_g_signal_stop_emission_by_name)
-XEN_NARGIFY_5(gxg_g_signal_add_emission_hook_w, gxg_g_signal_add_emission_hook)
-XEN_NARGIFY_2(gxg_g_signal_remove_emission_hook_w, gxg_g_signal_remove_emission_hook)
-XEN_NARGIFY_4(gxg_g_signal_has_handler_pending_w, gxg_g_signal_has_handler_pending)
-XEN_NARGIFY_5(gxg_g_signal_connect_closure_by_id_w, gxg_g_signal_connect_closure_by_id)
-XEN_NARGIFY_4(gxg_g_signal_connect_closure_w, gxg_g_signal_connect_closure)
-XEN_NARGIFY_6(gxg_g_signal_connect_data_w, gxg_g_signal_connect_data)
-XEN_NARGIFY_2(gxg_g_signal_handler_block_w, gxg_g_signal_handler_block)
-XEN_NARGIFY_2(gxg_g_signal_handler_unblock_w, gxg_g_signal_handler_unblock)
-XEN_NARGIFY_2(gxg_g_signal_handler_disconnect_w, gxg_g_signal_handler_disconnect)
-XEN_NARGIFY_2(gxg_g_signal_handler_is_connected_w, gxg_g_signal_handler_is_connected)
-XEN_NARGIFY_7(gxg_g_signal_handler_find_w, gxg_g_signal_handler_find)
-XEN_NARGIFY_7(gxg_g_signal_handlers_block_matched_w, gxg_g_signal_handlers_block_matched)
-XEN_NARGIFY_7(gxg_g_signal_handlers_unblock_matched_w, gxg_g_signal_handlers_unblock_matched)
-XEN_NARGIFY_7(gxg_g_signal_handlers_disconnect_matched_w, gxg_g_signal_handlers_disconnect_matched)
-XEN_NARGIFY_1(gxg_g_signal_handlers_destroy_w, gxg_g_signal_handlers_destroy)
-XEN_NARGIFY_1(gxg_g_object_ref_w, gxg_g_object_ref)
-XEN_NARGIFY_1(gxg_g_object_unref_w, gxg_g_object_unref)
-XEN_NARGIFY_0(gxg_gdk_visual_get_system_w, gxg_gdk_visual_get_system)
-XEN_NARGIFY_1(gxg_gdk_color_copy_w, gxg_gdk_color_copy)
-XEN_NARGIFY_1(gxg_gdk_color_free_w, gxg_gdk_color_free)
-XEN_NARGIFY_2(gxg_gdk_color_parse_w, gxg_gdk_color_parse)
-XEN_NARGIFY_1(gxg_gdk_color_hash_w, gxg_gdk_color_hash)
-XEN_NARGIFY_2(gxg_gdk_color_equal_w, gxg_gdk_color_equal)
-XEN_NARGIFY_1(gxg_gdk_cursor_new_w, gxg_gdk_cursor_new)
-XEN_NARGIFY_3(gxg_gdk_drag_status_w, gxg_gdk_drag_status)
-XEN_NARGIFY_3(gxg_gdk_drop_reply_w, gxg_gdk_drop_reply)
-XEN_NARGIFY_3(gxg_gdk_drop_finish_w, gxg_gdk_drop_finish)
-XEN_NARGIFY_1(gxg_gdk_drag_get_selection_w, gxg_gdk_drag_get_selection)
-XEN_NARGIFY_2(gxg_gdk_drag_begin_w, gxg_gdk_drag_begin)
-XEN_NARGIFY_2(gxg_gdk_drag_drop_w, gxg_gdk_drag_drop)
-XEN_NARGIFY_2(gxg_gdk_drag_abort_w, gxg_gdk_drag_abort)
-XEN_NARGIFY_0(gxg_gdk_events_pending_w, gxg_gdk_events_pending)
-XEN_NARGIFY_0(gxg_gdk_event_get_w, gxg_gdk_event_get)
-XEN_NARGIFY_0(gxg_gdk_event_peek_w, gxg_gdk_event_peek)
-XEN_NARGIFY_1(gxg_gdk_event_put_w, gxg_gdk_event_put)
-XEN_NARGIFY_1(gxg_gdk_event_copy_w, gxg_gdk_event_copy)
-XEN_NARGIFY_1(gxg_gdk_event_free_w, gxg_gdk_event_free)
-XEN_NARGIFY_1(gxg_gdk_event_get_time_w, gxg_gdk_event_get_time)
-XEN_ARGIFY_2(gxg_gdk_event_get_state_w, gxg_gdk_event_get_state)
-XEN_ARGIFY_3(gxg_gdk_event_get_coords_w, gxg_gdk_event_get_coords)
-XEN_ARGIFY_3(gxg_gdk_event_get_root_coords_w, gxg_gdk_event_get_root_coords)
-XEN_NARGIFY_3(gxg_gdk_event_handler_set_w, gxg_gdk_event_handler_set)
-XEN_NARGIFY_1(gxg_gdk_set_show_events_w, gxg_gdk_set_show_events)
-XEN_NARGIFY_0(gxg_gdk_get_show_events_w, gxg_gdk_get_show_events)
-XEN_ARGIFY_2(gxg_gdk_init_w, gxg_gdk_init)
-XEN_ARGIFY_2(gxg_gdk_init_check_w, gxg_gdk_init_check)
-XEN_NARGIFY_0(gxg_gdk_get_program_class_w, gxg_gdk_get_program_class)
-XEN_NARGIFY_1(gxg_gdk_set_program_class_w, gxg_gdk_set_program_class)
-XEN_NARGIFY_0(gxg_gdk_error_trap_push_w, gxg_gdk_error_trap_push)
-XEN_NARGIFY_0(gxg_gdk_error_trap_pop_w, gxg_gdk_error_trap_pop)
-XEN_NARGIFY_0(gxg_gdk_get_display_w, gxg_gdk_get_display)
-XEN_NARGIFY_0(gxg_gdk_get_display_arg_name_w, gxg_gdk_get_display_arg_name)
-XEN_NARGIFY_0(gxg_gdk_notify_startup_complete_w, gxg_gdk_notify_startup_complete)
-XEN_NARGIFY_0(gxg_gdk_screen_width_w, gxg_gdk_screen_width)
-XEN_NARGIFY_0(gxg_gdk_screen_height_w, gxg_gdk_screen_height)
-XEN_NARGIFY_0(gxg_gdk_screen_width_mm_w, gxg_gdk_screen_width_mm)
-XEN_NARGIFY_0(gxg_gdk_screen_height_mm_w, gxg_gdk_screen_height_mm)
-XEN_NARGIFY_0(gxg_gdk_flush_w, gxg_gdk_flush)
-XEN_NARGIFY_0(gxg_gdk_beep_w, gxg_gdk_beep)
-XEN_NARGIFY_1(gxg_gdk_set_double_click_time_w, gxg_gdk_set_double_click_time)
-XEN_NARGIFY_3(gxg_gdk_rectangle_intersect_w, gxg_gdk_rectangle_intersect)
-XEN_NARGIFY_3(gxg_gdk_rectangle_union_w, gxg_gdk_rectangle_union)
-XEN_NARGIFY_0(gxg_gdk_threads_enter_w, gxg_gdk_threads_enter)
-XEN_NARGIFY_0(gxg_gdk_threads_leave_w, gxg_gdk_threads_leave)
-XEN_NARGIFY_0(gxg_gdk_threads_init_w, gxg_gdk_threads_init)
-XEN_NARGIFY_0(gxg_gdk_keymap_get_default_w, gxg_gdk_keymap_get_default)
-XEN_NARGIFY_2(gxg_gdk_keymap_lookup_key_w, gxg_gdk_keymap_lookup_key)
-XEN_ARGIFY_4(gxg_gdk_keymap_get_entries_for_keyval_w, gxg_gdk_keymap_get_entries_for_keyval)
-XEN_ARGIFY_5(gxg_gdk_keymap_get_entries_for_keycode_w, gxg_gdk_keymap_get_entries_for_keycode)
-XEN_NARGIFY_1(gxg_gdk_keymap_get_direction_w, gxg_gdk_keymap_get_direction)
-XEN_NARGIFY_1(gxg_gdk_keyval_name_w, gxg_gdk_keyval_name)
-XEN_NARGIFY_1(gxg_gdk_keyval_from_name_w, gxg_gdk_keyval_from_name)
-XEN_ARGIFY_3(gxg_gdk_keyval_convert_case_w, gxg_gdk_keyval_convert_case)
-XEN_NARGIFY_1(gxg_gdk_keyval_to_upper_w, gxg_gdk_keyval_to_upper)
-XEN_NARGIFY_1(gxg_gdk_keyval_to_lower_w, gxg_gdk_keyval_to_lower)
-XEN_NARGIFY_1(gxg_gdk_keyval_is_upper_w, gxg_gdk_keyval_is_upper)
-XEN_NARGIFY_1(gxg_gdk_keyval_is_lower_w, gxg_gdk_keyval_is_lower)
-XEN_NARGIFY_1(gxg_gdk_keyval_to_unicode_w, gxg_gdk_keyval_to_unicode)
-XEN_NARGIFY_1(gxg_gdk_unicode_to_keyval_w, gxg_gdk_unicode_to_keyval)
-XEN_NARGIFY_0(gxg_gdk_pango_context_get_w, gxg_gdk_pango_context_get)
-XEN_NARGIFY_2(gxg_gdk_atom_intern_w, gxg_gdk_atom_intern)
-XEN_NARGIFY_1(gxg_gdk_atom_name_w, gxg_gdk_atom_name)
-XEN_VARGIFY(gxg_gdk_property_get_w, gxg_gdk_property_get)
-XEN_NARGIFY_7(gxg_gdk_property_change_w, gxg_gdk_property_change)
-XEN_NARGIFY_2(gxg_gdk_property_delete_w, gxg_gdk_property_delete)
-XEN_NARGIFY_1(gxg_gdk_utf8_to_string_target_w, gxg_gdk_utf8_to_string_target)
-XEN_NARGIFY_4(gxg_gdk_selection_owner_set_w, gxg_gdk_selection_owner_set)
-XEN_NARGIFY_1(gxg_gdk_selection_owner_get_w, gxg_gdk_selection_owner_get)
-XEN_NARGIFY_4(gxg_gdk_selection_convert_w, gxg_gdk_selection_convert)
-XEN_ARGIFY_4(gxg_gdk_selection_property_get_w, gxg_gdk_selection_property_get)
-XEN_NARGIFY_0(gxg_gdk_visual_get_best_depth_w, gxg_gdk_visual_get_best_depth)
-XEN_NARGIFY_0(gxg_gdk_visual_get_best_type_w, gxg_gdk_visual_get_best_type)
-XEN_NARGIFY_0(gxg_gdk_visual_get_best_w, gxg_gdk_visual_get_best)
-XEN_NARGIFY_1(gxg_gdk_visual_get_best_with_depth_w, gxg_gdk_visual_get_best_with_depth)
-XEN_NARGIFY_1(gxg_gdk_visual_get_best_with_type_w, gxg_gdk_visual_get_best_with_type)
-XEN_NARGIFY_2(gxg_gdk_visual_get_best_with_both_w, gxg_gdk_visual_get_best_with_both)
-XEN_ARGIFY_2(gxg_gdk_query_depths_w, gxg_gdk_query_depths)
-XEN_ARGIFY_2(gxg_gdk_query_visual_types_w, gxg_gdk_query_visual_types)
-XEN_NARGIFY_0(gxg_gdk_list_visuals_w, gxg_gdk_list_visuals)
-XEN_NARGIFY_3(gxg_gdk_window_new_w, gxg_gdk_window_new)
-XEN_NARGIFY_1(gxg_gdk_window_destroy_w, gxg_gdk_window_destroy)
-XEN_NARGIFY_1(gxg_gdk_window_get_window_type_w, gxg_gdk_window_get_window_type)
-XEN_ARGIFY_2(gxg_gdk_window_at_pointer_w, gxg_gdk_window_at_pointer)
-XEN_NARGIFY_1(gxg_gdk_window_show_w, gxg_gdk_window_show)
-XEN_NARGIFY_1(gxg_gdk_window_hide_w, gxg_gdk_window_hide)
-XEN_NARGIFY_1(gxg_gdk_window_withdraw_w, gxg_gdk_window_withdraw)
-XEN_NARGIFY_1(gxg_gdk_window_show_unraised_w, gxg_gdk_window_show_unraised)
-XEN_NARGIFY_3(gxg_gdk_window_move_w, gxg_gdk_window_move)
-XEN_NARGIFY_3(gxg_gdk_window_resize_w, gxg_gdk_window_resize)
-XEN_NARGIFY_5(gxg_gdk_window_move_resize_w, gxg_gdk_window_move_resize)
-XEN_NARGIFY_4(gxg_gdk_window_reparent_w, gxg_gdk_window_reparent)
-XEN_NARGIFY_1(gxg_gdk_window_raise_w, gxg_gdk_window_raise)
-XEN_NARGIFY_1(gxg_gdk_window_lower_w, gxg_gdk_window_lower)
-XEN_NARGIFY_2(gxg_gdk_window_focus_w, gxg_gdk_window_focus)
-XEN_NARGIFY_2(gxg_gdk_window_set_user_data_w, gxg_gdk_window_set_user_data)
-XEN_NARGIFY_2(gxg_gdk_window_set_override_redirect_w, gxg_gdk_window_set_override_redirect)
-XEN_ARGIFY_3(gxg_gdk_window_add_filter_w, gxg_gdk_window_add_filter)
-XEN_ARGIFY_3(gxg_gdk_window_remove_filter_w, gxg_gdk_window_remove_filter)
-XEN_NARGIFY_3(gxg_gdk_window_scroll_w, gxg_gdk_window_scroll)
-XEN_NARGIFY_1(gxg_gdk_window_set_child_shapes_w, gxg_gdk_window_set_child_shapes)
-XEN_NARGIFY_1(gxg_gdk_window_merge_child_shapes_w, gxg_gdk_window_merge_child_shapes)
-XEN_NARGIFY_1(gxg_gdk_window_is_visible_w, gxg_gdk_window_is_visible)
-XEN_NARGIFY_1(gxg_gdk_window_is_viewable_w, gxg_gdk_window_is_viewable)
-XEN_NARGIFY_1(gxg_gdk_window_get_state_w, gxg_gdk_window_get_state)
-XEN_NARGIFY_2(gxg_gdk_window_set_static_gravities_w, gxg_gdk_window_set_static_gravities)
-XEN_ARGIFY_3(gxg_gdk_window_get_root_origin_w, gxg_gdk_window_get_root_origin)
-XEN_NARGIFY_2(gxg_gdk_window_get_frame_extents_w, gxg_gdk_window_get_frame_extents)
-XEN_ARGIFY_4(gxg_gdk_window_get_pointer_w, gxg_gdk_window_get_pointer)
-XEN_NARGIFY_1(gxg_gdk_window_get_parent_w, gxg_gdk_window_get_parent)
-XEN_NARGIFY_1(gxg_gdk_window_get_toplevel_w, gxg_gdk_window_get_toplevel)
-XEN_NARGIFY_1(gxg_gdk_window_get_children_w, gxg_gdk_window_get_children)
-XEN_NARGIFY_1(gxg_gdk_window_peek_children_w, gxg_gdk_window_peek_children)
-XEN_NARGIFY_1(gxg_gdk_window_get_events_w, gxg_gdk_window_get_events)
-XEN_NARGIFY_2(gxg_gdk_window_set_events_w, gxg_gdk_window_set_events)
-XEN_NARGIFY_2(gxg_gdk_window_set_icon_list_w, gxg_gdk_window_set_icon_list)
-XEN_NARGIFY_2(gxg_gdk_window_set_icon_name_w, gxg_gdk_window_set_icon_name)
-XEN_NARGIFY_2(gxg_gdk_window_set_group_w, gxg_gdk_window_set_group)
-XEN_NARGIFY_2(gxg_gdk_window_set_decorations_w, gxg_gdk_window_set_decorations)
-XEN_ARGIFY_2(gxg_gdk_window_get_decorations_w, gxg_gdk_window_get_decorations)
-XEN_NARGIFY_2(gxg_gdk_window_set_functions_w, gxg_gdk_window_set_functions)
-XEN_NARGIFY_1(gxg_gdk_window_iconify_w, gxg_gdk_window_iconify)
-XEN_NARGIFY_1(gxg_gdk_window_deiconify_w, gxg_gdk_window_deiconify)
-XEN_NARGIFY_1(gxg_gdk_window_stick_w, gxg_gdk_window_stick)
-XEN_NARGIFY_1(gxg_gdk_window_unstick_w, gxg_gdk_window_unstick)
-XEN_NARGIFY_1(gxg_gdk_window_maximize_w, gxg_gdk_window_maximize)
-XEN_NARGIFY_1(gxg_gdk_window_unmaximize_w, gxg_gdk_window_unmaximize)
-XEN_NARGIFY_1(gxg_gdk_window_register_dnd_w, gxg_gdk_window_register_dnd)
-XEN_NARGIFY_6(gxg_gdk_window_begin_resize_drag_w, gxg_gdk_window_begin_resize_drag)
-XEN_NARGIFY_5(gxg_gdk_window_begin_move_drag_w, gxg_gdk_window_begin_move_drag)
-XEN_NARGIFY_3(gxg_gdk_window_invalidate_rect_w, gxg_gdk_window_invalidate_rect)
-XEN_NARGIFY_1(gxg_gdk_window_freeze_updates_w, gxg_gdk_window_freeze_updates)
-XEN_NARGIFY_1(gxg_gdk_window_thaw_updates_w, gxg_gdk_window_thaw_updates)
-XEN_NARGIFY_0(gxg_gdk_window_process_all_updates_w, gxg_gdk_window_process_all_updates)
-XEN_NARGIFY_2(gxg_gdk_window_process_updates_w, gxg_gdk_window_process_updates)
-XEN_NARGIFY_1(gxg_gdk_window_set_debug_updates_w, gxg_gdk_window_set_debug_updates)
-XEN_ARGIFY_6(gxg_gdk_window_constrain_size_w, gxg_gdk_window_constrain_size)
-XEN_NARGIFY_2(gxg_gdk_window_set_type_hint_w, gxg_gdk_window_set_type_hint)
-XEN_NARGIFY_2(gxg_gdk_window_set_modal_hint_w, gxg_gdk_window_set_modal_hint)
-XEN_NARGIFY_3(gxg_gdk_window_set_geometry_hints_w, gxg_gdk_window_set_geometry_hints)
-XEN_NARGIFY_2(gxg_gdk_window_begin_paint_rect_w, gxg_gdk_window_begin_paint_rect)
-XEN_NARGIFY_1(gxg_gdk_window_end_paint_w, gxg_gdk_window_end_paint)
-XEN_NARGIFY_2(gxg_gdk_window_set_title_w, gxg_gdk_window_set_title)
-XEN_NARGIFY_2(gxg_gdk_window_set_role_w, gxg_gdk_window_set_role)
-XEN_NARGIFY_2(gxg_gdk_window_set_transient_for_w, gxg_gdk_window_set_transient_for)
-XEN_NARGIFY_2(gxg_gdk_window_set_background_w, gxg_gdk_window_set_background)
-XEN_NARGIFY_2(gxg_gdk_window_set_cursor_w, gxg_gdk_window_set_cursor)
-XEN_ARGIFY_2(gxg_gdk_window_get_user_data_w, gxg_gdk_window_get_user_data)
-XEN_ARGIFY_3(gxg_gdk_window_get_position_w, gxg_gdk_window_get_position)
-XEN_ARGIFY_3(gxg_gdk_window_get_origin_w, gxg_gdk_window_get_origin)
-XEN_NARGIFY_0(gxg_gdk_get_default_root_window_w, gxg_gdk_get_default_root_window)
-XEN_NARGIFY_0(gxg_gdk_pixbuf_error_quark_w, gxg_gdk_pixbuf_error_quark)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_get_colorspace_w, gxg_gdk_pixbuf_get_colorspace)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_get_n_channels_w, gxg_gdk_pixbuf_get_n_channels)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_get_has_alpha_w, gxg_gdk_pixbuf_get_has_alpha)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_get_bits_per_sample_w, gxg_gdk_pixbuf_get_bits_per_sample)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_get_pixels_w, gxg_gdk_pixbuf_get_pixels)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_get_width_w, gxg_gdk_pixbuf_get_width)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_get_height_w, gxg_gdk_pixbuf_get_height)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_get_rowstride_w, gxg_gdk_pixbuf_get_rowstride)
-XEN_NARGIFY_5(gxg_gdk_pixbuf_new_w, gxg_gdk_pixbuf_new)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_copy_w, gxg_gdk_pixbuf_copy)
-XEN_NARGIFY_5(gxg_gdk_pixbuf_new_subpixbuf_w, gxg_gdk_pixbuf_new_subpixbuf)
-XEN_ARGIFY_2(gxg_gdk_pixbuf_new_from_file_w, gxg_gdk_pixbuf_new_from_file)
-XEN_NARGIFY_9(gxg_gdk_pixbuf_new_from_data_w, gxg_gdk_pixbuf_new_from_data)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_new_from_xpm_data_w, gxg_gdk_pixbuf_new_from_xpm_data)
-XEN_ARGIFY_4(gxg_gdk_pixbuf_new_from_inline_w, gxg_gdk_pixbuf_new_from_inline)
-XEN_NARGIFY_2(gxg_gdk_pixbuf_fill_w, gxg_gdk_pixbuf_fill)
-XEN_ARGIFY_6(gxg_gdk_pixbuf_savev_w, gxg_gdk_pixbuf_savev)
-XEN_NARGIFY_5(gxg_gdk_pixbuf_add_alpha_w, gxg_gdk_pixbuf_add_alpha)
-XEN_NARGIFY_8(gxg_gdk_pixbuf_copy_area_w, gxg_gdk_pixbuf_copy_area)
-XEN_NARGIFY_4(gxg_gdk_pixbuf_saturate_and_pixelate_w, gxg_gdk_pixbuf_saturate_and_pixelate)
-XEN_VARGIFY(gxg_gdk_pixbuf_scale_w, gxg_gdk_pixbuf_scale)
-XEN_VARGIFY(gxg_gdk_pixbuf_composite_w, gxg_gdk_pixbuf_composite)
-XEN_VARGIFY(gxg_gdk_pixbuf_composite_color_w, gxg_gdk_pixbuf_composite_color)
-XEN_NARGIFY_4(gxg_gdk_pixbuf_scale_simple_w, gxg_gdk_pixbuf_scale_simple)
-XEN_NARGIFY_8(gxg_gdk_pixbuf_composite_color_simple_w, gxg_gdk_pixbuf_composite_color_simple)
-XEN_ARGIFY_2(gxg_gdk_pixbuf_animation_new_from_file_w, gxg_gdk_pixbuf_animation_new_from_file)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_animation_get_width_w, gxg_gdk_pixbuf_animation_get_width)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_animation_get_height_w, gxg_gdk_pixbuf_animation_get_height)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_animation_is_static_image_w, gxg_gdk_pixbuf_animation_is_static_image)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_animation_get_static_image_w, gxg_gdk_pixbuf_animation_get_static_image)
-XEN_NARGIFY_2(gxg_gdk_pixbuf_animation_get_iter_w, gxg_gdk_pixbuf_animation_get_iter)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_animation_iter_get_delay_time_w, gxg_gdk_pixbuf_animation_iter_get_delay_time)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_animation_iter_get_pixbuf_w, gxg_gdk_pixbuf_animation_iter_get_pixbuf)
-XEN_NARGIFY_1(gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame_w, gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame)
-XEN_NARGIFY_2(gxg_gdk_pixbuf_animation_iter_advance_w, gxg_gdk_pixbuf_animation_iter_advance)
-XEN_NARGIFY_2(gxg_gdk_pixbuf_get_option_w, gxg_gdk_pixbuf_get_option)
-XEN_NARGIFY_2(gxg_gtk_vbox_new_w, gxg_gtk_vbox_new)
-XEN_NARGIFY_0(gxg_gtk_accel_group_new_w, gxg_gtk_accel_group_new)
-XEN_NARGIFY_1(gxg_gtk_accel_group_lock_w, gxg_gtk_accel_group_lock)
-XEN_NARGIFY_1(gxg_gtk_accel_group_unlock_w, gxg_gtk_accel_group_unlock)
-XEN_NARGIFY_5(gxg_gtk_accel_group_connect_w, gxg_gtk_accel_group_connect)
-XEN_NARGIFY_3(gxg_gtk_accel_group_connect_by_path_w, gxg_gtk_accel_group_connect_by_path)
-XEN_NARGIFY_2(gxg_gtk_accel_group_disconnect_w, gxg_gtk_accel_group_disconnect)
-XEN_NARGIFY_3(gxg_gtk_accel_group_disconnect_key_w, gxg_gtk_accel_group_disconnect_key)
-XEN_NARGIFY_3(gxg_gtk_accel_groups_activate_w, gxg_gtk_accel_groups_activate)
-XEN_NARGIFY_1(gxg_gtk_accel_groups_from_object_w, gxg_gtk_accel_groups_from_object)
-XEN_ARGIFY_3(gxg_gtk_accel_group_find_w, gxg_gtk_accel_group_find)
-XEN_NARGIFY_1(gxg_gtk_accel_group_from_accel_closure_w, gxg_gtk_accel_group_from_accel_closure)
-XEN_NARGIFY_2(gxg_gtk_accelerator_valid_w, gxg_gtk_accelerator_valid)
-XEN_ARGIFY_3(gxg_gtk_accelerator_parse_w, gxg_gtk_accelerator_parse)
-XEN_NARGIFY_2(gxg_gtk_accelerator_name_w, gxg_gtk_accelerator_name)
-XEN_NARGIFY_1(gxg_gtk_accelerator_set_default_mod_mask_w, gxg_gtk_accelerator_set_default_mod_mask)
-XEN_ARGIFY_4(gxg_gtk_accel_group_query_w, gxg_gtk_accel_group_query)
-XEN_NARGIFY_5(gxg_gtk_accel_group_activate_w, gxg_gtk_accel_group_activate)
-XEN_NARGIFY_1(gxg_gtk_accel_label_new_w, gxg_gtk_accel_label_new)
-XEN_NARGIFY_1(gxg_gtk_accel_label_get_accel_widget_w, gxg_gtk_accel_label_get_accel_widget)
-XEN_NARGIFY_1(gxg_gtk_accel_label_get_accel_width_w, gxg_gtk_accel_label_get_accel_width)
-XEN_NARGIFY_2(gxg_gtk_accel_label_set_accel_widget_w, gxg_gtk_accel_label_set_accel_widget)
-XEN_NARGIFY_2(gxg_gtk_accel_label_set_accel_closure_w, gxg_gtk_accel_label_set_accel_closure)
-XEN_NARGIFY_1(gxg_gtk_accel_label_refetch_w, gxg_gtk_accel_label_refetch)
-XEN_NARGIFY_3(gxg_gtk_accel_map_add_entry_w, gxg_gtk_accel_map_add_entry)
-XEN_NARGIFY_2(gxg_gtk_accel_map_lookup_entry_w, gxg_gtk_accel_map_lookup_entry)
-XEN_NARGIFY_4(gxg_gtk_accel_map_change_entry_w, gxg_gtk_accel_map_change_entry)
-XEN_NARGIFY_1(gxg_gtk_accel_map_load_w, gxg_gtk_accel_map_load)
-XEN_NARGIFY_1(gxg_gtk_accel_map_save_w, gxg_gtk_accel_map_save)
-XEN_NARGIFY_2(gxg_gtk_accel_map_foreach_w, gxg_gtk_accel_map_foreach)
-XEN_NARGIFY_1(gxg_gtk_accel_map_load_fd_w, gxg_gtk_accel_map_load_fd)
-XEN_NARGIFY_1(gxg_gtk_accel_map_save_fd_w, gxg_gtk_accel_map_save_fd)
-XEN_NARGIFY_1(gxg_gtk_accel_map_add_filter_w, gxg_gtk_accel_map_add_filter)
-XEN_NARGIFY_2(gxg_gtk_accel_map_foreach_unfiltered_w, gxg_gtk_accel_map_foreach_unfiltered)
-XEN_NARGIFY_1(gxg_gtk_accessible_connect_widget_destroyed_w, gxg_gtk_accessible_connect_widget_destroyed)
-XEN_NARGIFY_1(gxg_gtk_adjustment_changed_w, gxg_gtk_adjustment_changed)
-XEN_NARGIFY_1(gxg_gtk_adjustment_value_changed_w, gxg_gtk_adjustment_value_changed)
-XEN_NARGIFY_3(gxg_gtk_adjustment_clamp_page_w, gxg_gtk_adjustment_clamp_page)
-XEN_NARGIFY_1(gxg_gtk_adjustment_get_value_w, gxg_gtk_adjustment_get_value)
-XEN_NARGIFY_2(gxg_gtk_adjustment_set_value_w, gxg_gtk_adjustment_set_value)
-XEN_NARGIFY_4(gxg_gtk_alignment_new_w, gxg_gtk_alignment_new)
-XEN_NARGIFY_5(gxg_gtk_alignment_set_w, gxg_gtk_alignment_set)
-XEN_NARGIFY_2(gxg_gtk_arrow_new_w, gxg_gtk_arrow_new)
-XEN_NARGIFY_3(gxg_gtk_arrow_set_w, gxg_gtk_arrow_set)
-XEN_NARGIFY_5(gxg_gtk_aspect_frame_new_w, gxg_gtk_aspect_frame_new)
-XEN_NARGIFY_5(gxg_gtk_aspect_frame_set_w, gxg_gtk_aspect_frame_set)
-XEN_NARGIFY_1(gxg_gtk_button_box_get_layout_w, gxg_gtk_button_box_get_layout)
-XEN_NARGIFY_2(gxg_gtk_button_box_set_layout_w, gxg_gtk_button_box_set_layout)
-XEN_NARGIFY_3(gxg_gtk_button_box_set_child_secondary_w, gxg_gtk_button_box_set_child_secondary)
-XEN_NARGIFY_1(gxg_gtk_binding_set_new_w, gxg_gtk_binding_set_new)
-XEN_NARGIFY_1(gxg_gtk_binding_set_by_class_w, gxg_gtk_binding_set_by_class)
-XEN_NARGIFY_1(gxg_gtk_binding_set_find_w, gxg_gtk_binding_set_find)
-XEN_NARGIFY_3(gxg_gtk_binding_entry_remove_w, gxg_gtk_binding_entry_remove)
-XEN_NARGIFY_1(gxg_gtk_bin_get_child_w, gxg_gtk_bin_get_child)
-XEN_NARGIFY_5(gxg_gtk_box_pack_start_w, gxg_gtk_box_pack_start)
-XEN_NARGIFY_5(gxg_gtk_box_pack_end_w, gxg_gtk_box_pack_end)
-XEN_NARGIFY_2(gxg_gtk_box_set_homogeneous_w, gxg_gtk_box_set_homogeneous)
-XEN_NARGIFY_1(gxg_gtk_box_get_homogeneous_w, gxg_gtk_box_get_homogeneous)
-XEN_NARGIFY_2(gxg_gtk_box_set_spacing_w, gxg_gtk_box_set_spacing)
-XEN_NARGIFY_1(gxg_gtk_box_get_spacing_w, gxg_gtk_box_get_spacing)
-XEN_NARGIFY_3(gxg_gtk_box_reorder_child_w, gxg_gtk_box_reorder_child)
-XEN_ARGIFY_6(gxg_gtk_box_query_child_packing_w, gxg_gtk_box_query_child_packing)
-XEN_NARGIFY_6(gxg_gtk_box_set_child_packing_w, gxg_gtk_box_set_child_packing)
-XEN_NARGIFY_0(gxg_gtk_button_new_w, gxg_gtk_button_new)
-XEN_NARGIFY_1(gxg_gtk_button_new_with_label_w, gxg_gtk_button_new_with_label)
-XEN_NARGIFY_1(gxg_gtk_button_new_from_stock_w, gxg_gtk_button_new_from_stock)
-XEN_NARGIFY_1(gxg_gtk_button_new_with_mnemonic_w, gxg_gtk_button_new_with_mnemonic)
-XEN_NARGIFY_1(gxg_gtk_button_clicked_w, gxg_gtk_button_clicked)
-XEN_NARGIFY_2(gxg_gtk_button_set_relief_w, gxg_gtk_button_set_relief)
-XEN_NARGIFY_1(gxg_gtk_button_get_relief_w, gxg_gtk_button_get_relief)
-XEN_NARGIFY_2(gxg_gtk_button_set_label_w, gxg_gtk_button_set_label)
-XEN_NARGIFY_1(gxg_gtk_button_get_label_w, gxg_gtk_button_get_label)
-XEN_NARGIFY_2(gxg_gtk_button_set_use_underline_w, gxg_gtk_button_set_use_underline)
-XEN_NARGIFY_1(gxg_gtk_button_get_use_underline_w, gxg_gtk_button_get_use_underline)
-XEN_NARGIFY_2(gxg_gtk_button_set_use_stock_w, gxg_gtk_button_set_use_stock)
-XEN_NARGIFY_1(gxg_gtk_button_get_use_stock_w, gxg_gtk_button_get_use_stock)
-XEN_NARGIFY_0(gxg_gtk_calendar_new_w, gxg_gtk_calendar_new)
-XEN_NARGIFY_2(gxg_gtk_calendar_select_day_w, gxg_gtk_calendar_select_day)
-XEN_NARGIFY_1(gxg_gtk_calendar_clear_marks_w, gxg_gtk_calendar_clear_marks)
-XEN_ARGIFY_4(gxg_gtk_calendar_get_date_w, gxg_gtk_calendar_get_date)
-XEN_NARGIFY_2(gxg_gtk_cell_editable_start_editing_w, gxg_gtk_cell_editable_start_editing)
-XEN_NARGIFY_1(gxg_gtk_cell_editable_editing_done_w, gxg_gtk_cell_editable_editing_done)
-XEN_NARGIFY_1(gxg_gtk_cell_editable_remove_widget_w, gxg_gtk_cell_editable_remove_widget)
-XEN_NARGIFY_7(gxg_gtk_cell_renderer_activate_w, gxg_gtk_cell_renderer_activate)
-XEN_NARGIFY_7(gxg_gtk_cell_renderer_start_editing_w, gxg_gtk_cell_renderer_start_editing)
-XEN_NARGIFY_3(gxg_gtk_cell_renderer_set_fixed_size_w, gxg_gtk_cell_renderer_set_fixed_size)
-XEN_ARGIFY_3(gxg_gtk_cell_renderer_get_fixed_size_w, gxg_gtk_cell_renderer_get_fixed_size)
-XEN_NARGIFY_0(gxg_gtk_cell_renderer_pixbuf_new_w, gxg_gtk_cell_renderer_pixbuf_new)
-XEN_NARGIFY_0(gxg_gtk_cell_renderer_text_new_w, gxg_gtk_cell_renderer_text_new)
-XEN_NARGIFY_2(gxg_gtk_cell_renderer_text_set_fixed_height_from_font_w, gxg_gtk_cell_renderer_text_set_fixed_height_from_font)
-XEN_NARGIFY_0(gxg_gtk_cell_renderer_toggle_new_w, gxg_gtk_cell_renderer_toggle_new)
-XEN_NARGIFY_1(gxg_gtk_cell_renderer_toggle_get_radio_w, gxg_gtk_cell_renderer_toggle_get_radio)
-XEN_NARGIFY_2(gxg_gtk_cell_renderer_toggle_set_radio_w, gxg_gtk_cell_renderer_toggle_set_radio)
-XEN_NARGIFY_1(gxg_gtk_cell_renderer_toggle_get_active_w, gxg_gtk_cell_renderer_toggle_get_active)
-XEN_NARGIFY_2(gxg_gtk_cell_renderer_toggle_set_active_w, gxg_gtk_cell_renderer_toggle_set_active)
-XEN_NARGIFY_0(gxg_gtk_check_button_new_w, gxg_gtk_check_button_new)
-XEN_NARGIFY_1(gxg_gtk_check_button_new_with_label_w, gxg_gtk_check_button_new_with_label)
-XEN_NARGIFY_1(gxg_gtk_check_button_new_with_mnemonic_w, gxg_gtk_check_button_new_with_mnemonic)
-XEN_NARGIFY_0(gxg_gtk_check_menu_item_new_w, gxg_gtk_check_menu_item_new)
-XEN_NARGIFY_1(gxg_gtk_check_menu_item_new_with_label_w, gxg_gtk_check_menu_item_new_with_label)
-XEN_NARGIFY_1(gxg_gtk_check_menu_item_new_with_mnemonic_w, gxg_gtk_check_menu_item_new_with_mnemonic)
-XEN_NARGIFY_2(gxg_gtk_check_menu_item_set_active_w, gxg_gtk_check_menu_item_set_active)
-XEN_NARGIFY_1(gxg_gtk_check_menu_item_get_active_w, gxg_gtk_check_menu_item_get_active)
-XEN_NARGIFY_1(gxg_gtk_check_menu_item_toggled_w, gxg_gtk_check_menu_item_toggled)
-XEN_NARGIFY_2(gxg_gtk_check_menu_item_set_inconsistent_w, gxg_gtk_check_menu_item_set_inconsistent)
-XEN_NARGIFY_1(gxg_gtk_check_menu_item_get_inconsistent_w, gxg_gtk_check_menu_item_get_inconsistent)
-XEN_NARGIFY_1(gxg_gtk_clipboard_get_w, gxg_gtk_clipboard_get)
-XEN_ARGIFY_6(gxg_gtk_clipboard_set_with_data_w, gxg_gtk_clipboard_set_with_data)
-XEN_NARGIFY_1(gxg_gtk_clipboard_get_owner_w, gxg_gtk_clipboard_get_owner)
-XEN_NARGIFY_1(gxg_gtk_clipboard_clear_w, gxg_gtk_clipboard_clear)
-XEN_NARGIFY_3(gxg_gtk_clipboard_set_text_w, gxg_gtk_clipboard_set_text)
-XEN_ARGIFY_4(gxg_gtk_clipboard_request_contents_w, gxg_gtk_clipboard_request_contents)
-XEN_ARGIFY_3(gxg_gtk_clipboard_request_text_w, gxg_gtk_clipboard_request_text)
-XEN_NARGIFY_2(gxg_gtk_clipboard_wait_for_contents_w, gxg_gtk_clipboard_wait_for_contents)
-XEN_NARGIFY_1(gxg_gtk_clipboard_wait_for_text_w, gxg_gtk_clipboard_wait_for_text)
-XEN_NARGIFY_1(gxg_gtk_clipboard_wait_is_text_available_w, gxg_gtk_clipboard_wait_is_text_available)
-XEN_NARGIFY_1(gxg_gtk_color_selection_dialog_new_w, gxg_gtk_color_selection_dialog_new)
-XEN_NARGIFY_0(gxg_gtk_color_selection_new_w, gxg_gtk_color_selection_new)
-XEN_NARGIFY_1(gxg_gtk_color_selection_get_has_opacity_control_w, gxg_gtk_color_selection_get_has_opacity_control)
-XEN_NARGIFY_2(gxg_gtk_color_selection_set_has_opacity_control_w, gxg_gtk_color_selection_set_has_opacity_control)
-XEN_NARGIFY_1(gxg_gtk_color_selection_get_has_palette_w, gxg_gtk_color_selection_get_has_palette)
-XEN_NARGIFY_2(gxg_gtk_color_selection_set_has_palette_w, gxg_gtk_color_selection_set_has_palette)
-XEN_NARGIFY_2(gxg_gtk_color_selection_set_current_color_w, gxg_gtk_color_selection_set_current_color)
-XEN_NARGIFY_2(gxg_gtk_color_selection_set_current_alpha_w, gxg_gtk_color_selection_set_current_alpha)
-XEN_NARGIFY_2(gxg_gtk_color_selection_get_current_color_w, gxg_gtk_color_selection_get_current_color)
-XEN_NARGIFY_1(gxg_gtk_color_selection_get_current_alpha_w, gxg_gtk_color_selection_get_current_alpha)
-XEN_NARGIFY_2(gxg_gtk_color_selection_set_previous_color_w, gxg_gtk_color_selection_set_previous_color)
-XEN_NARGIFY_2(gxg_gtk_color_selection_set_previous_alpha_w, gxg_gtk_color_selection_set_previous_alpha)
-XEN_NARGIFY_2(gxg_gtk_color_selection_get_previous_color_w, gxg_gtk_color_selection_get_previous_color)
-XEN_NARGIFY_1(gxg_gtk_color_selection_get_previous_alpha_w, gxg_gtk_color_selection_get_previous_alpha)
-XEN_NARGIFY_1(gxg_gtk_color_selection_is_adjusting_w, gxg_gtk_color_selection_is_adjusting)
-XEN_ARGIFY_3(gxg_gtk_color_selection_palette_from_string_w, gxg_gtk_color_selection_palette_from_string)
-XEN_NARGIFY_2(gxg_gtk_color_selection_palette_to_string_w, gxg_gtk_color_selection_palette_to_string)
-XEN_NARGIFY_2(gxg_gtk_container_set_border_width_w, gxg_gtk_container_set_border_width)
-XEN_NARGIFY_1(gxg_gtk_container_get_border_width_w, gxg_gtk_container_get_border_width)
-XEN_NARGIFY_2(gxg_gtk_container_add_w, gxg_gtk_container_add)
-XEN_NARGIFY_2(gxg_gtk_container_remove_w, gxg_gtk_container_remove)
-XEN_NARGIFY_2(gxg_gtk_container_set_resize_mode_w, gxg_gtk_container_set_resize_mode)
-XEN_NARGIFY_1(gxg_gtk_container_get_resize_mode_w, gxg_gtk_container_get_resize_mode)
-XEN_NARGIFY_1(gxg_gtk_container_check_resize_w, gxg_gtk_container_check_resize)
-XEN_ARGIFY_3(gxg_gtk_container_foreach_w, gxg_gtk_container_foreach)
-XEN_NARGIFY_1(gxg_gtk_container_get_children_w, gxg_gtk_container_get_children)
-XEN_NARGIFY_0(gxg_gtk_dialog_new_w, gxg_gtk_dialog_new)
-XEN_ARGIFY_4(gxg_gtk_dialog_new_with_buttons_w, gxg_gtk_dialog_new_with_buttons)
-XEN_NARGIFY_3(gxg_gtk_dialog_add_action_widget_w, gxg_gtk_dialog_add_action_widget)
-XEN_NARGIFY_3(gxg_gtk_dialog_add_button_w, gxg_gtk_dialog_add_button)
-XEN_NARGIFY_2(gxg_gtk_dialog_add_buttons_w, gxg_gtk_dialog_add_buttons)
-XEN_NARGIFY_3(gxg_gtk_dialog_set_response_sensitive_w, gxg_gtk_dialog_set_response_sensitive)
-XEN_NARGIFY_2(gxg_gtk_dialog_set_default_response_w, gxg_gtk_dialog_set_default_response)
-XEN_NARGIFY_2(gxg_gtk_dialog_response_w, gxg_gtk_dialog_response)
-XEN_NARGIFY_1(gxg_gtk_dialog_run_w, gxg_gtk_dialog_run)
-XEN_NARGIFY_4(gxg_gtk_drag_get_data_w, gxg_gtk_drag_get_data)
-XEN_NARGIFY_4(gxg_gtk_drag_finish_w, gxg_gtk_drag_finish)
-XEN_NARGIFY_1(gxg_gtk_drag_get_source_widget_w, gxg_gtk_drag_get_source_widget)
-XEN_NARGIFY_1(gxg_gtk_drag_highlight_w, gxg_gtk_drag_highlight)
-XEN_NARGIFY_1(gxg_gtk_drag_unhighlight_w, gxg_gtk_drag_unhighlight)
-XEN_NARGIFY_5(gxg_gtk_drag_dest_set_w, gxg_gtk_drag_dest_set)
-XEN_NARGIFY_1(gxg_gtk_drag_dest_unset_w, gxg_gtk_drag_dest_unset)
-XEN_NARGIFY_3(gxg_gtk_drag_dest_find_target_w, gxg_gtk_drag_dest_find_target)
-XEN_NARGIFY_1(gxg_gtk_drag_dest_get_target_list_w, gxg_gtk_drag_dest_get_target_list)
-XEN_NARGIFY_2(gxg_gtk_drag_dest_set_target_list_w, gxg_gtk_drag_dest_set_target_list)
-XEN_NARGIFY_5(gxg_gtk_drag_source_set_w, gxg_gtk_drag_source_set)
-XEN_NARGIFY_1(gxg_gtk_drag_source_unset_w, gxg_gtk_drag_source_unset)
-XEN_NARGIFY_2(gxg_gtk_drag_source_set_icon_pixbuf_w, gxg_gtk_drag_source_set_icon_pixbuf)
-XEN_NARGIFY_2(gxg_gtk_drag_source_set_icon_stock_w, gxg_gtk_drag_source_set_icon_stock)
-XEN_NARGIFY_5(gxg_gtk_drag_begin_w, gxg_gtk_drag_begin)
-XEN_NARGIFY_4(gxg_gtk_drag_set_icon_widget_w, gxg_gtk_drag_set_icon_widget)
-XEN_NARGIFY_4(gxg_gtk_drag_set_icon_pixbuf_w, gxg_gtk_drag_set_icon_pixbuf)
-XEN_NARGIFY_4(gxg_gtk_drag_set_icon_stock_w, gxg_gtk_drag_set_icon_stock)
-XEN_NARGIFY_1(gxg_gtk_drag_set_icon_default_w, gxg_gtk_drag_set_icon_default)
-XEN_NARGIFY_5(gxg_gtk_drag_check_threshold_w, gxg_gtk_drag_check_threshold)
-XEN_NARGIFY_0(gxg_gtk_drawing_area_new_w, gxg_gtk_drawing_area_new)
-XEN_NARGIFY_3(gxg_gtk_editable_select_region_w, gxg_gtk_editable_select_region)
-XEN_ARGIFY_3(gxg_gtk_editable_get_selection_bounds_w, gxg_gtk_editable_get_selection_bounds)
-XEN_ARGIFY_4(gxg_gtk_editable_insert_text_w, gxg_gtk_editable_insert_text)
-XEN_NARGIFY_3(gxg_gtk_editable_delete_text_w, gxg_gtk_editable_delete_text)
-XEN_NARGIFY_3(gxg_gtk_editable_get_chars_w, gxg_gtk_editable_get_chars)
-XEN_NARGIFY_1(gxg_gtk_editable_cut_clipboard_w, gxg_gtk_editable_cut_clipboard)
-XEN_NARGIFY_1(gxg_gtk_editable_copy_clipboard_w, gxg_gtk_editable_copy_clipboard)
-XEN_NARGIFY_1(gxg_gtk_editable_paste_clipboard_w, gxg_gtk_editable_paste_clipboard)
-XEN_NARGIFY_1(gxg_gtk_editable_delete_selection_w, gxg_gtk_editable_delete_selection)
-XEN_NARGIFY_2(gxg_gtk_editable_set_position_w, gxg_gtk_editable_set_position)
-XEN_NARGIFY_1(gxg_gtk_editable_get_position_w, gxg_gtk_editable_get_position)
-XEN_NARGIFY_2(gxg_gtk_editable_set_editable_w, gxg_gtk_editable_set_editable)
-XEN_NARGIFY_1(gxg_gtk_editable_get_editable_w, gxg_gtk_editable_get_editable)
-XEN_NARGIFY_0(gxg_gtk_entry_new_w, gxg_gtk_entry_new)
-XEN_NARGIFY_2(gxg_gtk_entry_set_visibility_w, gxg_gtk_entry_set_visibility)
-XEN_NARGIFY_1(gxg_gtk_entry_get_visibility_w, gxg_gtk_entry_get_visibility)
-XEN_NARGIFY_2(gxg_gtk_entry_set_invisible_char_w, gxg_gtk_entry_set_invisible_char)
-XEN_NARGIFY_1(gxg_gtk_entry_get_invisible_char_w, gxg_gtk_entry_get_invisible_char)
-XEN_NARGIFY_2(gxg_gtk_entry_set_has_frame_w, gxg_gtk_entry_set_has_frame)
-XEN_NARGIFY_1(gxg_gtk_entry_get_has_frame_w, gxg_gtk_entry_get_has_frame)
-XEN_NARGIFY_2(gxg_gtk_entry_set_max_length_w, gxg_gtk_entry_set_max_length)
-XEN_NARGIFY_1(gxg_gtk_entry_get_max_length_w, gxg_gtk_entry_get_max_length)
-XEN_NARGIFY_2(gxg_gtk_entry_set_activates_default_w, gxg_gtk_entry_set_activates_default)
-XEN_NARGIFY_1(gxg_gtk_entry_get_activates_default_w, gxg_gtk_entry_get_activates_default)
-XEN_NARGIFY_2(gxg_gtk_entry_set_width_chars_w, gxg_gtk_entry_set_width_chars)
-XEN_NARGIFY_1(gxg_gtk_entry_get_width_chars_w, gxg_gtk_entry_get_width_chars)
-XEN_NARGIFY_2(gxg_gtk_entry_set_text_w, gxg_gtk_entry_set_text)
-XEN_NARGIFY_1(gxg_gtk_entry_get_text_w, gxg_gtk_entry_get_text)
-XEN_NARGIFY_1(gxg_gtk_entry_get_layout_w, gxg_gtk_entry_get_layout)
-XEN_ARGIFY_3(gxg_gtk_entry_get_layout_offsets_w, gxg_gtk_entry_get_layout_offsets)
-XEN_NARGIFY_0(gxg_gtk_event_box_new_w, gxg_gtk_event_box_new)
-XEN_NARGIFY_0(gxg_gtk_fixed_new_w, gxg_gtk_fixed_new)
-XEN_NARGIFY_4(gxg_gtk_fixed_put_w, gxg_gtk_fixed_put)
-XEN_NARGIFY_4(gxg_gtk_fixed_move_w, gxg_gtk_fixed_move)
-XEN_NARGIFY_0(gxg_gtk_font_selection_new_w, gxg_gtk_font_selection_new)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_font_name_w, gxg_gtk_font_selection_get_font_name)
-XEN_NARGIFY_2(gxg_gtk_font_selection_set_font_name_w, gxg_gtk_font_selection_set_font_name)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_preview_text_w, gxg_gtk_font_selection_get_preview_text)
-XEN_NARGIFY_2(gxg_gtk_font_selection_set_preview_text_w, gxg_gtk_font_selection_set_preview_text)
-XEN_NARGIFY_1(gxg_gtk_font_selection_dialog_new_w, gxg_gtk_font_selection_dialog_new)
-XEN_NARGIFY_1(gxg_gtk_font_selection_dialog_get_font_name_w, gxg_gtk_font_selection_dialog_get_font_name)
-XEN_NARGIFY_2(gxg_gtk_font_selection_dialog_set_font_name_w, gxg_gtk_font_selection_dialog_set_font_name)
-XEN_NARGIFY_1(gxg_gtk_font_selection_dialog_get_preview_text_w, gxg_gtk_font_selection_dialog_get_preview_text)
-XEN_NARGIFY_2(gxg_gtk_font_selection_dialog_set_preview_text_w, gxg_gtk_font_selection_dialog_set_preview_text)
-XEN_NARGIFY_1(gxg_gtk_frame_new_w, gxg_gtk_frame_new)
-XEN_NARGIFY_2(gxg_gtk_frame_set_label_w, gxg_gtk_frame_set_label)
-XEN_NARGIFY_1(gxg_gtk_frame_get_label_w, gxg_gtk_frame_get_label)
-XEN_NARGIFY_2(gxg_gtk_frame_set_label_widget_w, gxg_gtk_frame_set_label_widget)
-XEN_NARGIFY_1(gxg_gtk_frame_get_label_widget_w, gxg_gtk_frame_get_label_widget)
-XEN_NARGIFY_3(gxg_gtk_frame_set_label_align_w, gxg_gtk_frame_set_label_align)
-XEN_ARGIFY_3(gxg_gtk_frame_get_label_align_w, gxg_gtk_frame_get_label_align)
-XEN_NARGIFY_2(gxg_gtk_frame_set_shadow_type_w, gxg_gtk_frame_set_shadow_type)
-XEN_NARGIFY_1(gxg_gtk_frame_get_shadow_type_w, gxg_gtk_frame_get_shadow_type)
-XEN_NARGIFY_0(gxg_gtk_handle_box_new_w, gxg_gtk_handle_box_new)
-XEN_NARGIFY_2(gxg_gtk_handle_box_set_shadow_type_w, gxg_gtk_handle_box_set_shadow_type)
-XEN_NARGIFY_1(gxg_gtk_handle_box_get_shadow_type_w, gxg_gtk_handle_box_get_shadow_type)
-XEN_NARGIFY_2(gxg_gtk_handle_box_set_handle_position_w, gxg_gtk_handle_box_set_handle_position)
-XEN_NARGIFY_1(gxg_gtk_handle_box_get_handle_position_w, gxg_gtk_handle_box_get_handle_position)
-XEN_NARGIFY_2(gxg_gtk_handle_box_set_snap_edge_w, gxg_gtk_handle_box_set_snap_edge)
-XEN_NARGIFY_1(gxg_gtk_handle_box_get_snap_edge_w, gxg_gtk_handle_box_get_snap_edge)
-XEN_NARGIFY_0(gxg_gtk_hbutton_box_new_w, gxg_gtk_hbutton_box_new)
-XEN_NARGIFY_2(gxg_gtk_hbox_new_w, gxg_gtk_hbox_new)
-XEN_NARGIFY_0(gxg_gtk_hpaned_new_w, gxg_gtk_hpaned_new)
-XEN_NARGIFY_1(gxg_gtk_hscale_new_w, gxg_gtk_hscale_new)
-XEN_NARGIFY_3(gxg_gtk_hscale_new_with_range_w, gxg_gtk_hscale_new_with_range)
-XEN_NARGIFY_1(gxg_gtk_hscrollbar_new_w, gxg_gtk_hscrollbar_new)
-XEN_NARGIFY_0(gxg_gtk_hseparator_new_w, gxg_gtk_hseparator_new)
-XEN_NARGIFY_0(gxg_gtk_icon_factory_new_w, gxg_gtk_icon_factory_new)
-XEN_NARGIFY_3(gxg_gtk_icon_factory_add_w, gxg_gtk_icon_factory_add)
-XEN_NARGIFY_2(gxg_gtk_icon_factory_lookup_w, gxg_gtk_icon_factory_lookup)
-XEN_NARGIFY_1(gxg_gtk_icon_factory_add_default_w, gxg_gtk_icon_factory_add_default)
-XEN_NARGIFY_1(gxg_gtk_icon_factory_remove_default_w, gxg_gtk_icon_factory_remove_default)
-XEN_NARGIFY_1(gxg_gtk_icon_factory_lookup_default_w, gxg_gtk_icon_factory_lookup_default)
-XEN_ARGIFY_3(gxg_gtk_icon_size_lookup_w, gxg_gtk_icon_size_lookup)
-XEN_NARGIFY_3(gxg_gtk_icon_size_register_w, gxg_gtk_icon_size_register)
-XEN_NARGIFY_2(gxg_gtk_icon_size_register_alias_w, gxg_gtk_icon_size_register_alias)
-XEN_NARGIFY_1(gxg_gtk_icon_size_from_name_w, gxg_gtk_icon_size_from_name)
-XEN_NARGIFY_1(gxg_gtk_icon_size_get_name_w, gxg_gtk_icon_size_get_name)
-XEN_NARGIFY_0(gxg_gtk_icon_set_new_w, gxg_gtk_icon_set_new)
-XEN_NARGIFY_1(gxg_gtk_icon_set_new_from_pixbuf_w, gxg_gtk_icon_set_new_from_pixbuf)
-XEN_NARGIFY_1(gxg_gtk_icon_set_ref_w, gxg_gtk_icon_set_ref)
-XEN_NARGIFY_1(gxg_gtk_icon_set_unref_w, gxg_gtk_icon_set_unref)
-XEN_NARGIFY_1(gxg_gtk_icon_set_copy_w, gxg_gtk_icon_set_copy)
-XEN_NARGIFY_2(gxg_gtk_icon_set_add_source_w, gxg_gtk_icon_set_add_source)
-XEN_ARGIFY_3(gxg_gtk_icon_set_get_sizes_w, gxg_gtk_icon_set_get_sizes)
-XEN_NARGIFY_0(gxg_gtk_icon_source_new_w, gxg_gtk_icon_source_new)
-XEN_NARGIFY_1(gxg_gtk_icon_source_copy_w, gxg_gtk_icon_source_copy)
-XEN_NARGIFY_1(gxg_gtk_icon_source_free_w, gxg_gtk_icon_source_free)
-XEN_NARGIFY_2(gxg_gtk_icon_source_set_filename_w, gxg_gtk_icon_source_set_filename)
-XEN_NARGIFY_2(gxg_gtk_icon_source_set_pixbuf_w, gxg_gtk_icon_source_set_pixbuf)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_filename_w, gxg_gtk_icon_source_get_filename)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_pixbuf_w, gxg_gtk_icon_source_get_pixbuf)
-XEN_NARGIFY_2(gxg_gtk_icon_source_set_direction_wildcarded_w, gxg_gtk_icon_source_set_direction_wildcarded)
-XEN_NARGIFY_2(gxg_gtk_icon_source_set_state_wildcarded_w, gxg_gtk_icon_source_set_state_wildcarded)
-XEN_NARGIFY_2(gxg_gtk_icon_source_set_size_wildcarded_w, gxg_gtk_icon_source_set_size_wildcarded)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_size_wildcarded_w, gxg_gtk_icon_source_get_size_wildcarded)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_state_wildcarded_w, gxg_gtk_icon_source_get_state_wildcarded)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_direction_wildcarded_w, gxg_gtk_icon_source_get_direction_wildcarded)
-XEN_NARGIFY_2(gxg_gtk_icon_source_set_direction_w, gxg_gtk_icon_source_set_direction)
-XEN_NARGIFY_2(gxg_gtk_icon_source_set_state_w, gxg_gtk_icon_source_set_state)
-XEN_NARGIFY_2(gxg_gtk_icon_source_set_size_w, gxg_gtk_icon_source_set_size)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_direction_w, gxg_gtk_icon_source_get_direction)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_state_w, gxg_gtk_icon_source_get_state)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_size_w, gxg_gtk_icon_source_get_size)
-XEN_NARGIFY_0(gxg_gtk_image_new_w, gxg_gtk_image_new)
-XEN_NARGIFY_1(gxg_gtk_image_new_from_file_w, gxg_gtk_image_new_from_file)
-XEN_NARGIFY_1(gxg_gtk_image_new_from_pixbuf_w, gxg_gtk_image_new_from_pixbuf)
-XEN_NARGIFY_2(gxg_gtk_image_new_from_stock_w, gxg_gtk_image_new_from_stock)
-XEN_NARGIFY_2(gxg_gtk_image_new_from_icon_set_w, gxg_gtk_image_new_from_icon_set)
-XEN_NARGIFY_1(gxg_gtk_image_new_from_animation_w, gxg_gtk_image_new_from_animation)
-XEN_NARGIFY_2(gxg_gtk_image_set_from_file_w, gxg_gtk_image_set_from_file)
-XEN_NARGIFY_2(gxg_gtk_image_set_from_pixbuf_w, gxg_gtk_image_set_from_pixbuf)
-XEN_NARGIFY_3(gxg_gtk_image_set_from_stock_w, gxg_gtk_image_set_from_stock)
-XEN_NARGIFY_3(gxg_gtk_image_set_from_icon_set_w, gxg_gtk_image_set_from_icon_set)
-XEN_NARGIFY_2(gxg_gtk_image_set_from_animation_w, gxg_gtk_image_set_from_animation)
-XEN_NARGIFY_1(gxg_gtk_image_get_storage_type_w, gxg_gtk_image_get_storage_type)
-XEN_NARGIFY_1(gxg_gtk_image_get_pixbuf_w, gxg_gtk_image_get_pixbuf)
-XEN_ARGIFY_3(gxg_gtk_image_get_stock_w, gxg_gtk_image_get_stock)
-XEN_ARGIFY_3(gxg_gtk_image_get_icon_set_w, gxg_gtk_image_get_icon_set)
-XEN_NARGIFY_1(gxg_gtk_image_get_animation_w, gxg_gtk_image_get_animation)
-XEN_NARGIFY_0(gxg_gtk_image_menu_item_new_w, gxg_gtk_image_menu_item_new)
-XEN_NARGIFY_1(gxg_gtk_image_menu_item_new_with_label_w, gxg_gtk_image_menu_item_new_with_label)
-XEN_NARGIFY_1(gxg_gtk_image_menu_item_new_with_mnemonic_w, gxg_gtk_image_menu_item_new_with_mnemonic)
-XEN_NARGIFY_2(gxg_gtk_image_menu_item_new_from_stock_w, gxg_gtk_image_menu_item_new_from_stock)
-XEN_NARGIFY_2(gxg_gtk_image_menu_item_set_image_w, gxg_gtk_image_menu_item_set_image)
-XEN_NARGIFY_1(gxg_gtk_image_menu_item_get_image_w, gxg_gtk_image_menu_item_get_image)
-XEN_NARGIFY_2(gxg_gtk_im_context_set_client_window_w, gxg_gtk_im_context_set_client_window)
-XEN_ARGIFY_4(gxg_gtk_im_context_get_preedit_string_w, gxg_gtk_im_context_get_preedit_string)
-XEN_NARGIFY_2(gxg_gtk_im_context_filter_keypress_w, gxg_gtk_im_context_filter_keypress)
-XEN_NARGIFY_1(gxg_gtk_im_context_focus_in_w, gxg_gtk_im_context_focus_in)
-XEN_NARGIFY_1(gxg_gtk_im_context_focus_out_w, gxg_gtk_im_context_focus_out)
-XEN_NARGIFY_1(gxg_gtk_im_context_reset_w, gxg_gtk_im_context_reset)
-XEN_NARGIFY_2(gxg_gtk_im_context_set_cursor_location_w, gxg_gtk_im_context_set_cursor_location)
-XEN_NARGIFY_2(gxg_gtk_im_context_set_use_preedit_w, gxg_gtk_im_context_set_use_preedit)
-XEN_NARGIFY_4(gxg_gtk_im_context_set_surrounding_w, gxg_gtk_im_context_set_surrounding)
-XEN_ARGIFY_3(gxg_gtk_im_context_get_surrounding_w, gxg_gtk_im_context_get_surrounding)
-XEN_NARGIFY_3(gxg_gtk_im_context_delete_surrounding_w, gxg_gtk_im_context_delete_surrounding)
-XEN_NARGIFY_0(gxg_gtk_im_context_simple_new_w, gxg_gtk_im_context_simple_new)
-XEN_NARGIFY_4(gxg_gtk_im_context_simple_add_table_w, gxg_gtk_im_context_simple_add_table)
-XEN_NARGIFY_0(gxg_gtk_im_multicontext_new_w, gxg_gtk_im_multicontext_new)
-XEN_NARGIFY_2(gxg_gtk_im_multicontext_append_menuitems_w, gxg_gtk_im_multicontext_append_menuitems)
-XEN_NARGIFY_0(gxg_gtk_invisible_new_w, gxg_gtk_invisible_new)
-XEN_NARGIFY_1(gxg_gtk_label_new_w, gxg_gtk_label_new)
-XEN_NARGIFY_1(gxg_gtk_label_new_with_mnemonic_w, gxg_gtk_label_new_with_mnemonic)
-XEN_NARGIFY_2(gxg_gtk_label_set_text_w, gxg_gtk_label_set_text)
-XEN_NARGIFY_1(gxg_gtk_label_get_text_w, gxg_gtk_label_get_text)
-XEN_NARGIFY_2(gxg_gtk_label_set_attributes_w, gxg_gtk_label_set_attributes)
-XEN_NARGIFY_1(gxg_gtk_label_get_attributes_w, gxg_gtk_label_get_attributes)
-XEN_NARGIFY_2(gxg_gtk_label_set_label_w, gxg_gtk_label_set_label)
-XEN_NARGIFY_1(gxg_gtk_label_get_label_w, gxg_gtk_label_get_label)
-XEN_NARGIFY_2(gxg_gtk_label_set_markup_w, gxg_gtk_label_set_markup)
-XEN_NARGIFY_2(gxg_gtk_label_set_use_markup_w, gxg_gtk_label_set_use_markup)
-XEN_NARGIFY_1(gxg_gtk_label_get_use_markup_w, gxg_gtk_label_get_use_markup)
-XEN_NARGIFY_2(gxg_gtk_label_set_use_underline_w, gxg_gtk_label_set_use_underline)
-XEN_NARGIFY_1(gxg_gtk_label_get_use_underline_w, gxg_gtk_label_get_use_underline)
-XEN_NARGIFY_2(gxg_gtk_label_set_markup_with_mnemonic_w, gxg_gtk_label_set_markup_with_mnemonic)
-XEN_NARGIFY_1(gxg_gtk_label_get_mnemonic_keyval_w, gxg_gtk_label_get_mnemonic_keyval)
-XEN_NARGIFY_2(gxg_gtk_label_set_mnemonic_widget_w, gxg_gtk_label_set_mnemonic_widget)
-XEN_NARGIFY_1(gxg_gtk_label_get_mnemonic_widget_w, gxg_gtk_label_get_mnemonic_widget)
-XEN_NARGIFY_2(gxg_gtk_label_set_text_with_mnemonic_w, gxg_gtk_label_set_text_with_mnemonic)
-XEN_NARGIFY_2(gxg_gtk_label_set_justify_w, gxg_gtk_label_set_justify)
-XEN_NARGIFY_1(gxg_gtk_label_get_justify_w, gxg_gtk_label_get_justify)
-XEN_NARGIFY_2(gxg_gtk_label_set_pattern_w, gxg_gtk_label_set_pattern)
-XEN_NARGIFY_2(gxg_gtk_label_set_line_wrap_w, gxg_gtk_label_set_line_wrap)
-XEN_NARGIFY_1(gxg_gtk_label_get_line_wrap_w, gxg_gtk_label_get_line_wrap)
-XEN_NARGIFY_2(gxg_gtk_label_set_selectable_w, gxg_gtk_label_set_selectable)
-XEN_NARGIFY_1(gxg_gtk_label_get_selectable_w, gxg_gtk_label_get_selectable)
-XEN_NARGIFY_3(gxg_gtk_label_select_region_w, gxg_gtk_label_select_region)
-XEN_ARGIFY_3(gxg_gtk_label_get_selection_bounds_w, gxg_gtk_label_get_selection_bounds)
-XEN_NARGIFY_1(gxg_gtk_label_get_layout_w, gxg_gtk_label_get_layout)
-XEN_ARGIFY_3(gxg_gtk_label_get_layout_offsets_w, gxg_gtk_label_get_layout_offsets)
-XEN_NARGIFY_2(gxg_gtk_layout_new_w, gxg_gtk_layout_new)
-XEN_NARGIFY_4(gxg_gtk_layout_put_w, gxg_gtk_layout_put)
-XEN_NARGIFY_4(gxg_gtk_layout_move_w, gxg_gtk_layout_move)
-XEN_NARGIFY_3(gxg_gtk_layout_set_size_w, gxg_gtk_layout_set_size)
-XEN_ARGIFY_3(gxg_gtk_layout_get_size_w, gxg_gtk_layout_get_size)
-XEN_NARGIFY_2(gxg_gtk_list_store_new_w, gxg_gtk_list_store_new)
-XEN_NARGIFY_2(gxg_gtk_list_store_newv_w, gxg_gtk_list_store_newv)
-XEN_NARGIFY_3(gxg_gtk_list_store_set_column_types_w, gxg_gtk_list_store_set_column_types)
-XEN_NARGIFY_3(gxg_gtk_list_store_set_w, gxg_gtk_list_store_set)
-XEN_NARGIFY_3(gxg_gtk_list_store_insert_w, gxg_gtk_list_store_insert)
-XEN_NARGIFY_3(gxg_gtk_list_store_insert_before_w, gxg_gtk_list_store_insert_before)
-XEN_NARGIFY_3(gxg_gtk_list_store_insert_after_w, gxg_gtk_list_store_insert_after)
-XEN_NARGIFY_2(gxg_gtk_list_store_prepend_w, gxg_gtk_list_store_prepend)
-XEN_NARGIFY_2(gxg_gtk_list_store_append_w, gxg_gtk_list_store_append)
-XEN_NARGIFY_1(gxg_gtk_list_store_clear_w, gxg_gtk_list_store_clear)
-XEN_NARGIFY_3(gxg_gtk_check_version_w, gxg_gtk_check_version)
-XEN_NARGIFY_0(gxg_gtk_disable_setlocale_w, gxg_gtk_disable_setlocale)
-XEN_NARGIFY_0(gxg_gtk_get_default_language_w, gxg_gtk_get_default_language)
-XEN_NARGIFY_0(gxg_gtk_events_pending_w, gxg_gtk_events_pending)
-XEN_NARGIFY_1(gxg_gtk_main_do_event_w, gxg_gtk_main_do_event)
-XEN_NARGIFY_0(gxg_gtk_main_w, gxg_gtk_main)
-XEN_NARGIFY_0(gxg_gtk_main_level_w, gxg_gtk_main_level)
-XEN_NARGIFY_0(gxg_gtk_main_quit_w, gxg_gtk_main_quit)
-XEN_NARGIFY_0(gxg_gtk_main_iteration_w, gxg_gtk_main_iteration)
-XEN_NARGIFY_1(gxg_gtk_main_iteration_do_w, gxg_gtk_main_iteration_do)
-XEN_NARGIFY_0(gxg_gtk_true_w, gxg_gtk_true)
-XEN_NARGIFY_0(gxg_gtk_false_w, gxg_gtk_false)
-XEN_NARGIFY_1(gxg_gtk_grab_add_w, gxg_gtk_grab_add)
-XEN_NARGIFY_0(gxg_gtk_grab_get_current_w, gxg_gtk_grab_get_current)
-XEN_NARGIFY_1(gxg_gtk_grab_remove_w, gxg_gtk_grab_remove)
-XEN_ARGIFY_2(gxg_gtk_key_snooper_install_w, gxg_gtk_key_snooper_install)
-XEN_NARGIFY_1(gxg_gtk_key_snooper_remove_w, gxg_gtk_key_snooper_remove)
-XEN_NARGIFY_0(gxg_gtk_get_current_event_w, gxg_gtk_get_current_event)
-XEN_NARGIFY_0(gxg_gtk_get_current_event_time_w, gxg_gtk_get_current_event_time)
-XEN_ARGIFY_1(gxg_gtk_get_current_event_state_w, gxg_gtk_get_current_event_state)
-XEN_NARGIFY_1(gxg_gtk_get_event_widget_w, gxg_gtk_get_event_widget)
-XEN_NARGIFY_2(gxg_gtk_propagate_event_w, gxg_gtk_propagate_event)
-XEN_NARGIFY_0(gxg_gtk_menu_bar_new_w, gxg_gtk_menu_bar_new)
-XEN_NARGIFY_0(gxg_gtk_menu_new_w, gxg_gtk_menu_new)
-XEN_NARGIFY_7(gxg_gtk_menu_popup_w, gxg_gtk_menu_popup)
-XEN_NARGIFY_1(gxg_gtk_menu_reposition_w, gxg_gtk_menu_reposition)
-XEN_NARGIFY_1(gxg_gtk_menu_popdown_w, gxg_gtk_menu_popdown)
-XEN_NARGIFY_1(gxg_gtk_menu_get_active_w, gxg_gtk_menu_get_active)
-XEN_NARGIFY_2(gxg_gtk_menu_set_active_w, gxg_gtk_menu_set_active)
-XEN_NARGIFY_2(gxg_gtk_menu_set_accel_group_w, gxg_gtk_menu_set_accel_group)
-XEN_NARGIFY_1(gxg_gtk_menu_get_accel_group_w, gxg_gtk_menu_get_accel_group)
-XEN_NARGIFY_2(gxg_gtk_menu_set_accel_path_w, gxg_gtk_menu_set_accel_path)
-XEN_NARGIFY_1(gxg_gtk_menu_detach_w, gxg_gtk_menu_detach)
-XEN_NARGIFY_1(gxg_gtk_menu_get_attach_widget_w, gxg_gtk_menu_get_attach_widget)
-XEN_NARGIFY_2(gxg_gtk_menu_set_tearoff_state_w, gxg_gtk_menu_set_tearoff_state)
-XEN_NARGIFY_1(gxg_gtk_menu_get_tearoff_state_w, gxg_gtk_menu_get_tearoff_state)
-XEN_NARGIFY_2(gxg_gtk_menu_set_title_w, gxg_gtk_menu_set_title)
-XEN_NARGIFY_1(gxg_gtk_menu_get_title_w, gxg_gtk_menu_get_title)
-XEN_NARGIFY_3(gxg_gtk_menu_reorder_child_w, gxg_gtk_menu_reorder_child)
-XEN_NARGIFY_2(gxg_gtk_menu_set_monitor_w, gxg_gtk_menu_set_monitor)
-XEN_NARGIFY_0(gxg_gtk_menu_item_new_w, gxg_gtk_menu_item_new)
-XEN_NARGIFY_1(gxg_gtk_menu_item_new_with_label_w, gxg_gtk_menu_item_new_with_label)
-XEN_NARGIFY_1(gxg_gtk_menu_item_new_with_mnemonic_w, gxg_gtk_menu_item_new_with_mnemonic)
-XEN_NARGIFY_2(gxg_gtk_menu_item_set_submenu_w, gxg_gtk_menu_item_set_submenu)
-XEN_NARGIFY_1(gxg_gtk_menu_item_get_submenu_w, gxg_gtk_menu_item_get_submenu)
-XEN_NARGIFY_1(gxg_gtk_menu_item_select_w, gxg_gtk_menu_item_select)
-XEN_NARGIFY_1(gxg_gtk_menu_item_deselect_w, gxg_gtk_menu_item_deselect)
-XEN_NARGIFY_1(gxg_gtk_menu_item_activate_w, gxg_gtk_menu_item_activate)
-XEN_NARGIFY_2(gxg_gtk_menu_item_toggle_size_request_w, gxg_gtk_menu_item_toggle_size_request)
-XEN_NARGIFY_2(gxg_gtk_menu_item_toggle_size_allocate_w, gxg_gtk_menu_item_toggle_size_allocate)
-XEN_NARGIFY_2(gxg_gtk_menu_item_set_right_justified_w, gxg_gtk_menu_item_set_right_justified)
-XEN_NARGIFY_1(gxg_gtk_menu_item_get_right_justified_w, gxg_gtk_menu_item_get_right_justified)
-XEN_NARGIFY_2(gxg_gtk_menu_item_set_accel_path_w, gxg_gtk_menu_item_set_accel_path)
-XEN_NARGIFY_2(gxg_gtk_menu_shell_append_w, gxg_gtk_menu_shell_append)
-XEN_NARGIFY_2(gxg_gtk_menu_shell_prepend_w, gxg_gtk_menu_shell_prepend)
-XEN_NARGIFY_3(gxg_gtk_menu_shell_insert_w, gxg_gtk_menu_shell_insert)
-XEN_NARGIFY_1(gxg_gtk_menu_shell_deactivate_w, gxg_gtk_menu_shell_deactivate)
-XEN_NARGIFY_2(gxg_gtk_menu_shell_select_item_w, gxg_gtk_menu_shell_select_item)
-XEN_NARGIFY_1(gxg_gtk_menu_shell_deselect_w, gxg_gtk_menu_shell_deselect)
-XEN_NARGIFY_3(gxg_gtk_menu_shell_activate_item_w, gxg_gtk_menu_shell_activate_item)
-XEN_NARGIFY_3(gxg_gtk_misc_set_alignment_w, gxg_gtk_misc_set_alignment)
-XEN_ARGIFY_3(gxg_gtk_misc_get_alignment_w, gxg_gtk_misc_get_alignment)
-XEN_NARGIFY_3(gxg_gtk_misc_set_padding_w, gxg_gtk_misc_set_padding)
-XEN_ARGIFY_3(gxg_gtk_misc_get_padding_w, gxg_gtk_misc_get_padding)
-XEN_NARGIFY_0(gxg_gtk_notebook_new_w, gxg_gtk_notebook_new)
-XEN_NARGIFY_2(gxg_gtk_notebook_remove_page_w, gxg_gtk_notebook_remove_page)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_current_page_w, gxg_gtk_notebook_get_current_page)
-XEN_NARGIFY_2(gxg_gtk_notebook_get_nth_page_w, gxg_gtk_notebook_get_nth_page)
-XEN_NARGIFY_2(gxg_gtk_notebook_page_num_w, gxg_gtk_notebook_page_num)
-XEN_NARGIFY_2(gxg_gtk_notebook_set_current_page_w, gxg_gtk_notebook_set_current_page)
-XEN_NARGIFY_1(gxg_gtk_notebook_next_page_w, gxg_gtk_notebook_next_page)
-XEN_NARGIFY_1(gxg_gtk_notebook_prev_page_w, gxg_gtk_notebook_prev_page)
-XEN_NARGIFY_2(gxg_gtk_notebook_set_show_border_w, gxg_gtk_notebook_set_show_border)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_show_border_w, gxg_gtk_notebook_get_show_border)
-XEN_NARGIFY_2(gxg_gtk_notebook_set_show_tabs_w, gxg_gtk_notebook_set_show_tabs)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_show_tabs_w, gxg_gtk_notebook_get_show_tabs)
-XEN_NARGIFY_2(gxg_gtk_notebook_set_tab_pos_w, gxg_gtk_notebook_set_tab_pos)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_tab_pos_w, gxg_gtk_notebook_get_tab_pos)
-XEN_NARGIFY_2(gxg_gtk_notebook_set_scrollable_w, gxg_gtk_notebook_set_scrollable)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_scrollable_w, gxg_gtk_notebook_get_scrollable)
-XEN_NARGIFY_1(gxg_gtk_notebook_popup_enable_w, gxg_gtk_notebook_popup_enable)
-XEN_NARGIFY_1(gxg_gtk_notebook_popup_disable_w, gxg_gtk_notebook_popup_disable)
-XEN_NARGIFY_2(gxg_gtk_notebook_get_tab_label_w, gxg_gtk_notebook_get_tab_label)
-XEN_NARGIFY_3(gxg_gtk_notebook_set_tab_label_w, gxg_gtk_notebook_set_tab_label)
-XEN_NARGIFY_3(gxg_gtk_notebook_set_tab_label_text_w, gxg_gtk_notebook_set_tab_label_text)
-XEN_NARGIFY_2(gxg_gtk_notebook_get_tab_label_text_w, gxg_gtk_notebook_get_tab_label_text)
-XEN_NARGIFY_2(gxg_gtk_notebook_get_menu_label_w, gxg_gtk_notebook_get_menu_label)
-XEN_NARGIFY_3(gxg_gtk_notebook_set_menu_label_w, gxg_gtk_notebook_set_menu_label)
-XEN_NARGIFY_3(gxg_gtk_notebook_set_menu_label_text_w, gxg_gtk_notebook_set_menu_label_text)
-XEN_NARGIFY_2(gxg_gtk_notebook_get_menu_label_text_w, gxg_gtk_notebook_get_menu_label_text)
-XEN_NARGIFY_3(gxg_gtk_notebook_reorder_child_w, gxg_gtk_notebook_reorder_child)
-XEN_NARGIFY_3(gxg_gtk_notebook_append_page_w, gxg_gtk_notebook_append_page)
-XEN_NARGIFY_4(gxg_gtk_notebook_append_page_menu_w, gxg_gtk_notebook_append_page_menu)
-XEN_NARGIFY_3(gxg_gtk_notebook_prepend_page_w, gxg_gtk_notebook_prepend_page)
-XEN_NARGIFY_4(gxg_gtk_notebook_prepend_page_menu_w, gxg_gtk_notebook_prepend_page_menu)
-XEN_NARGIFY_4(gxg_gtk_notebook_insert_page_w, gxg_gtk_notebook_insert_page)
-XEN_NARGIFY_5(gxg_gtk_notebook_insert_page_menu_w, gxg_gtk_notebook_insert_page_menu)
-XEN_NARGIFY_2(gxg_gtk_paned_add1_w, gxg_gtk_paned_add1)
-XEN_NARGIFY_2(gxg_gtk_paned_add2_w, gxg_gtk_paned_add2)
-XEN_NARGIFY_4(gxg_gtk_paned_pack1_w, gxg_gtk_paned_pack1)
-XEN_NARGIFY_4(gxg_gtk_paned_pack2_w, gxg_gtk_paned_pack2)
-XEN_NARGIFY_1(gxg_gtk_paned_get_position_w, gxg_gtk_paned_get_position)
-XEN_NARGIFY_2(gxg_gtk_paned_set_position_w, gxg_gtk_paned_set_position)
-XEN_NARGIFY_0(gxg_gtk_progress_bar_new_w, gxg_gtk_progress_bar_new)
-XEN_NARGIFY_1(gxg_gtk_progress_bar_pulse_w, gxg_gtk_progress_bar_pulse)
-XEN_NARGIFY_2(gxg_gtk_progress_bar_set_text_w, gxg_gtk_progress_bar_set_text)
-XEN_NARGIFY_2(gxg_gtk_progress_bar_set_fraction_w, gxg_gtk_progress_bar_set_fraction)
-XEN_NARGIFY_2(gxg_gtk_progress_bar_set_pulse_step_w, gxg_gtk_progress_bar_set_pulse_step)
-XEN_NARGIFY_1(gxg_gtk_progress_bar_get_text_w, gxg_gtk_progress_bar_get_text)
-XEN_NARGIFY_1(gxg_gtk_progress_bar_get_fraction_w, gxg_gtk_progress_bar_get_fraction)
-XEN_NARGIFY_1(gxg_gtk_progress_bar_get_pulse_step_w, gxg_gtk_progress_bar_get_pulse_step)
-XEN_NARGIFY_1(gxg_gtk_radio_button_new_w, gxg_gtk_radio_button_new)
-XEN_NARGIFY_1(gxg_gtk_radio_button_new_from_widget_w, gxg_gtk_radio_button_new_from_widget)
-XEN_NARGIFY_2(gxg_gtk_radio_button_new_with_label_w, gxg_gtk_radio_button_new_with_label)
-XEN_NARGIFY_2(gxg_gtk_radio_button_new_with_label_from_widget_w, gxg_gtk_radio_button_new_with_label_from_widget)
-XEN_NARGIFY_2(gxg_gtk_radio_button_new_with_mnemonic_w, gxg_gtk_radio_button_new_with_mnemonic)
-XEN_NARGIFY_2(gxg_gtk_radio_button_new_with_mnemonic_from_widget_w, gxg_gtk_radio_button_new_with_mnemonic_from_widget)
-XEN_NARGIFY_1(gxg_gtk_radio_button_get_group_w, gxg_gtk_radio_button_get_group)
-XEN_NARGIFY_2(gxg_gtk_radio_button_set_group_w, gxg_gtk_radio_button_set_group)
-XEN_NARGIFY_1(gxg_gtk_radio_menu_item_new_w, gxg_gtk_radio_menu_item_new)
-XEN_NARGIFY_2(gxg_gtk_radio_menu_item_new_with_label_w, gxg_gtk_radio_menu_item_new_with_label)
-XEN_NARGIFY_2(gxg_gtk_radio_menu_item_new_with_mnemonic_w, gxg_gtk_radio_menu_item_new_with_mnemonic)
-XEN_NARGIFY_1(gxg_gtk_radio_menu_item_get_group_w, gxg_gtk_radio_menu_item_get_group)
-XEN_NARGIFY_2(gxg_gtk_radio_menu_item_set_group_w, gxg_gtk_radio_menu_item_set_group)
-XEN_NARGIFY_2(gxg_gtk_range_set_adjustment_w, gxg_gtk_range_set_adjustment)
-XEN_NARGIFY_1(gxg_gtk_range_get_adjustment_w, gxg_gtk_range_get_adjustment)
-XEN_NARGIFY_2(gxg_gtk_range_set_inverted_w, gxg_gtk_range_set_inverted)
-XEN_NARGIFY_1(gxg_gtk_range_get_inverted_w, gxg_gtk_range_get_inverted)
-XEN_NARGIFY_3(gxg_gtk_range_set_increments_w, gxg_gtk_range_set_increments)
-XEN_NARGIFY_3(gxg_gtk_range_set_range_w, gxg_gtk_range_set_range)
-XEN_NARGIFY_2(gxg_gtk_range_set_value_w, gxg_gtk_range_set_value)
-XEN_NARGIFY_1(gxg_gtk_range_get_value_w, gxg_gtk_range_get_value)
-XEN_NARGIFY_2(gxg_gtk_scale_set_digits_w, gxg_gtk_scale_set_digits)
-XEN_NARGIFY_1(gxg_gtk_scale_get_digits_w, gxg_gtk_scale_get_digits)
-XEN_NARGIFY_2(gxg_gtk_scale_set_draw_value_w, gxg_gtk_scale_set_draw_value)
-XEN_NARGIFY_1(gxg_gtk_scale_get_draw_value_w, gxg_gtk_scale_get_draw_value)
-XEN_NARGIFY_2(gxg_gtk_scale_set_value_pos_w, gxg_gtk_scale_set_value_pos)
-XEN_NARGIFY_1(gxg_gtk_scale_get_value_pos_w, gxg_gtk_scale_get_value_pos)
-XEN_NARGIFY_2(gxg_gtk_scrolled_window_new_w, gxg_gtk_scrolled_window_new)
-XEN_NARGIFY_2(gxg_gtk_scrolled_window_set_hadjustment_w, gxg_gtk_scrolled_window_set_hadjustment)
-XEN_NARGIFY_2(gxg_gtk_scrolled_window_set_vadjustment_w, gxg_gtk_scrolled_window_set_vadjustment)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_get_hadjustment_w, gxg_gtk_scrolled_window_get_hadjustment)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_get_vadjustment_w, gxg_gtk_scrolled_window_get_vadjustment)
-XEN_NARGIFY_3(gxg_gtk_scrolled_window_set_policy_w, gxg_gtk_scrolled_window_set_policy)
-XEN_ARGIFY_3(gxg_gtk_scrolled_window_get_policy_w, gxg_gtk_scrolled_window_get_policy)
-XEN_NARGIFY_2(gxg_gtk_scrolled_window_set_placement_w, gxg_gtk_scrolled_window_set_placement)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_get_placement_w, gxg_gtk_scrolled_window_get_placement)
-XEN_NARGIFY_2(gxg_gtk_scrolled_window_set_shadow_type_w, gxg_gtk_scrolled_window_set_shadow_type)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_get_shadow_type_w, gxg_gtk_scrolled_window_get_shadow_type)
-XEN_NARGIFY_2(gxg_gtk_scrolled_window_add_with_viewport_w, gxg_gtk_scrolled_window_add_with_viewport)
-XEN_NARGIFY_2(gxg_gtk_target_list_new_w, gxg_gtk_target_list_new)
-XEN_NARGIFY_1(gxg_gtk_target_list_unref_w, gxg_gtk_target_list_unref)
-XEN_NARGIFY_4(gxg_gtk_target_list_add_w, gxg_gtk_target_list_add)
-XEN_NARGIFY_3(gxg_gtk_target_list_add_table_w, gxg_gtk_target_list_add_table)
-XEN_NARGIFY_2(gxg_gtk_target_list_remove_w, gxg_gtk_target_list_remove)
-XEN_ARGIFY_3(gxg_gtk_target_list_find_w, gxg_gtk_target_list_find)
-XEN_NARGIFY_3(gxg_gtk_selection_owner_set_w, gxg_gtk_selection_owner_set)
-XEN_NARGIFY_4(gxg_gtk_selection_add_target_w, gxg_gtk_selection_add_target)
-XEN_NARGIFY_4(gxg_gtk_selection_add_targets_w, gxg_gtk_selection_add_targets)
-XEN_NARGIFY_2(gxg_gtk_selection_clear_targets_w, gxg_gtk_selection_clear_targets)
-XEN_NARGIFY_4(gxg_gtk_selection_convert_w, gxg_gtk_selection_convert)
-XEN_NARGIFY_5(gxg_gtk_selection_data_set_w, gxg_gtk_selection_data_set)
-XEN_NARGIFY_3(gxg_gtk_selection_data_set_text_w, gxg_gtk_selection_data_set_text)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_text_w, gxg_gtk_selection_data_get_text)
-XEN_ARGIFY_3(gxg_gtk_selection_data_get_targets_w, gxg_gtk_selection_data_get_targets)
-XEN_NARGIFY_1(gxg_gtk_selection_data_targets_include_text_w, gxg_gtk_selection_data_targets_include_text)
-XEN_NARGIFY_1(gxg_gtk_selection_remove_all_w, gxg_gtk_selection_remove_all)
-XEN_NARGIFY_1(gxg_gtk_selection_data_copy_w, gxg_gtk_selection_data_copy)
-XEN_NARGIFY_1(gxg_gtk_selection_data_free_w, gxg_gtk_selection_data_free)
-XEN_NARGIFY_0(gxg_gtk_separator_menu_item_new_w, gxg_gtk_separator_menu_item_new)
-XEN_NARGIFY_1(gxg_gtk_size_group_new_w, gxg_gtk_size_group_new)
-XEN_NARGIFY_2(gxg_gtk_size_group_set_mode_w, gxg_gtk_size_group_set_mode)
-XEN_NARGIFY_1(gxg_gtk_size_group_get_mode_w, gxg_gtk_size_group_get_mode)
-XEN_NARGIFY_2(gxg_gtk_size_group_add_widget_w, gxg_gtk_size_group_add_widget)
-XEN_NARGIFY_2(gxg_gtk_size_group_remove_widget_w, gxg_gtk_size_group_remove_widget)
-XEN_NARGIFY_4(gxg_gtk_spin_button_configure_w, gxg_gtk_spin_button_configure)
-XEN_NARGIFY_3(gxg_gtk_spin_button_new_w, gxg_gtk_spin_button_new)
-XEN_NARGIFY_3(gxg_gtk_spin_button_new_with_range_w, gxg_gtk_spin_button_new_with_range)
-XEN_NARGIFY_2(gxg_gtk_spin_button_set_adjustment_w, gxg_gtk_spin_button_set_adjustment)
-XEN_NARGIFY_1(gxg_gtk_spin_button_get_adjustment_w, gxg_gtk_spin_button_get_adjustment)
-XEN_NARGIFY_2(gxg_gtk_spin_button_set_digits_w, gxg_gtk_spin_button_set_digits)
-XEN_NARGIFY_1(gxg_gtk_spin_button_get_digits_w, gxg_gtk_spin_button_get_digits)
-XEN_NARGIFY_3(gxg_gtk_spin_button_set_increments_w, gxg_gtk_spin_button_set_increments)
-XEN_ARGIFY_3(gxg_gtk_spin_button_get_increments_w, gxg_gtk_spin_button_get_increments)
-XEN_NARGIFY_3(gxg_gtk_spin_button_set_range_w, gxg_gtk_spin_button_set_range)
-XEN_ARGIFY_3(gxg_gtk_spin_button_get_range_w, gxg_gtk_spin_button_get_range)
-XEN_NARGIFY_1(gxg_gtk_spin_button_get_value_w, gxg_gtk_spin_button_get_value)
-XEN_NARGIFY_1(gxg_gtk_spin_button_get_value_as_int_w, gxg_gtk_spin_button_get_value_as_int)
-XEN_NARGIFY_2(gxg_gtk_spin_button_set_value_w, gxg_gtk_spin_button_set_value)
-XEN_NARGIFY_2(gxg_gtk_spin_button_set_update_policy_w, gxg_gtk_spin_button_set_update_policy)
-XEN_NARGIFY_1(gxg_gtk_spin_button_get_update_policy_w, gxg_gtk_spin_button_get_update_policy)
-XEN_NARGIFY_2(gxg_gtk_spin_button_set_numeric_w, gxg_gtk_spin_button_set_numeric)
-XEN_NARGIFY_1(gxg_gtk_spin_button_get_numeric_w, gxg_gtk_spin_button_get_numeric)
-XEN_NARGIFY_3(gxg_gtk_spin_button_spin_w, gxg_gtk_spin_button_spin)
-XEN_NARGIFY_2(gxg_gtk_spin_button_set_wrap_w, gxg_gtk_spin_button_set_wrap)
-XEN_NARGIFY_1(gxg_gtk_spin_button_get_wrap_w, gxg_gtk_spin_button_get_wrap)
-XEN_NARGIFY_2(gxg_gtk_spin_button_set_snap_to_ticks_w, gxg_gtk_spin_button_set_snap_to_ticks)
-XEN_NARGIFY_1(gxg_gtk_spin_button_get_snap_to_ticks_w, gxg_gtk_spin_button_get_snap_to_ticks)
-XEN_NARGIFY_1(gxg_gtk_spin_button_update_w, gxg_gtk_spin_button_update)
-XEN_NARGIFY_0(gxg_gtk_statusbar_new_w, gxg_gtk_statusbar_new)
-XEN_NARGIFY_2(gxg_gtk_statusbar_get_context_id_w, gxg_gtk_statusbar_get_context_id)
-XEN_NARGIFY_3(gxg_gtk_statusbar_push_w, gxg_gtk_statusbar_push)
-XEN_NARGIFY_2(gxg_gtk_statusbar_pop_w, gxg_gtk_statusbar_pop)
-XEN_NARGIFY_3(gxg_gtk_statusbar_remove_w, gxg_gtk_statusbar_remove)
-XEN_NARGIFY_2(gxg_gtk_stock_add_w, gxg_gtk_stock_add)
-XEN_NARGIFY_2(gxg_gtk_stock_add_static_w, gxg_gtk_stock_add_static)
-XEN_NARGIFY_2(gxg_gtk_stock_lookup_w, gxg_gtk_stock_lookup)
-XEN_NARGIFY_0(gxg_gtk_stock_list_ids_w, gxg_gtk_stock_list_ids)
-XEN_NARGIFY_1(gxg_gtk_stock_item_copy_w, gxg_gtk_stock_item_copy)
-XEN_NARGIFY_1(gxg_gtk_stock_item_free_w, gxg_gtk_stock_item_free)
-XEN_NARGIFY_3(gxg_gtk_table_new_w, gxg_gtk_table_new)
-XEN_NARGIFY_3(gxg_gtk_table_resize_w, gxg_gtk_table_resize)
-XEN_VARGIFY(gxg_gtk_table_attach_w, gxg_gtk_table_attach)
-XEN_NARGIFY_6(gxg_gtk_table_attach_defaults_w, gxg_gtk_table_attach_defaults)
-XEN_NARGIFY_3(gxg_gtk_table_set_row_spacing_w, gxg_gtk_table_set_row_spacing)
-XEN_NARGIFY_2(gxg_gtk_table_get_row_spacing_w, gxg_gtk_table_get_row_spacing)
-XEN_NARGIFY_3(gxg_gtk_table_set_col_spacing_w, gxg_gtk_table_set_col_spacing)
-XEN_NARGIFY_2(gxg_gtk_table_get_col_spacing_w, gxg_gtk_table_get_col_spacing)
-XEN_NARGIFY_2(gxg_gtk_table_set_row_spacings_w, gxg_gtk_table_set_row_spacings)
-XEN_NARGIFY_1(gxg_gtk_table_get_default_row_spacing_w, gxg_gtk_table_get_default_row_spacing)
-XEN_NARGIFY_2(gxg_gtk_table_set_col_spacings_w, gxg_gtk_table_set_col_spacings)
-XEN_NARGIFY_1(gxg_gtk_table_get_default_col_spacing_w, gxg_gtk_table_get_default_col_spacing)
-XEN_NARGIFY_2(gxg_gtk_table_set_homogeneous_w, gxg_gtk_table_set_homogeneous)
-XEN_NARGIFY_1(gxg_gtk_table_get_homogeneous_w, gxg_gtk_table_get_homogeneous)
-XEN_NARGIFY_0(gxg_gtk_tearoff_menu_item_new_w, gxg_gtk_tearoff_menu_item_new)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_new_w, gxg_gtk_text_buffer_new)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_line_count_w, gxg_gtk_text_buffer_get_line_count)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_char_count_w, gxg_gtk_text_buffer_get_char_count)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_tag_table_w, gxg_gtk_text_buffer_get_tag_table)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_set_text_w, gxg_gtk_text_buffer_set_text)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_insert_w, gxg_gtk_text_buffer_insert)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_insert_at_cursor_w, gxg_gtk_text_buffer_insert_at_cursor)
-XEN_NARGIFY_5(gxg_gtk_text_buffer_insert_interactive_w, gxg_gtk_text_buffer_insert_interactive)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_insert_interactive_at_cursor_w, gxg_gtk_text_buffer_insert_interactive_at_cursor)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_insert_range_w, gxg_gtk_text_buffer_insert_range)
-XEN_NARGIFY_5(gxg_gtk_text_buffer_insert_range_interactive_w, gxg_gtk_text_buffer_insert_range_interactive)
-XEN_NARGIFY_5(gxg_gtk_text_buffer_insert_with_tags_w, gxg_gtk_text_buffer_insert_with_tags)
-XEN_NARGIFY_5(gxg_gtk_text_buffer_insert_with_tags_by_name_w, gxg_gtk_text_buffer_insert_with_tags_by_name)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_delete_w, gxg_gtk_text_buffer_delete)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_delete_interactive_w, gxg_gtk_text_buffer_delete_interactive)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_get_text_w, gxg_gtk_text_buffer_get_text)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_get_slice_w, gxg_gtk_text_buffer_get_slice)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_insert_pixbuf_w, gxg_gtk_text_buffer_insert_pixbuf)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_insert_child_anchor_w, gxg_gtk_text_buffer_insert_child_anchor)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_create_child_anchor_w, gxg_gtk_text_buffer_create_child_anchor)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_create_mark_w, gxg_gtk_text_buffer_create_mark)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_move_mark_w, gxg_gtk_text_buffer_move_mark)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_delete_mark_w, gxg_gtk_text_buffer_delete_mark)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_get_mark_w, gxg_gtk_text_buffer_get_mark)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_move_mark_by_name_w, gxg_gtk_text_buffer_move_mark_by_name)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_delete_mark_by_name_w, gxg_gtk_text_buffer_delete_mark_by_name)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_insert_w, gxg_gtk_text_buffer_get_insert)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_selection_bound_w, gxg_gtk_text_buffer_get_selection_bound)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_place_cursor_w, gxg_gtk_text_buffer_place_cursor)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_apply_tag_w, gxg_gtk_text_buffer_apply_tag)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_remove_tag_w, gxg_gtk_text_buffer_remove_tag)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_apply_tag_by_name_w, gxg_gtk_text_buffer_apply_tag_by_name)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_remove_tag_by_name_w, gxg_gtk_text_buffer_remove_tag_by_name)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_remove_all_tags_w, gxg_gtk_text_buffer_remove_all_tags)
-XEN_ARGIFY_3(gxg_gtk_text_buffer_create_tag_w, gxg_gtk_text_buffer_create_tag)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_get_iter_at_line_offset_w, gxg_gtk_text_buffer_get_iter_at_line_offset)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_get_iter_at_line_index_w, gxg_gtk_text_buffer_get_iter_at_line_index)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_get_iter_at_offset_w, gxg_gtk_text_buffer_get_iter_at_offset)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_get_iter_at_line_w, gxg_gtk_text_buffer_get_iter_at_line)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_get_start_iter_w, gxg_gtk_text_buffer_get_start_iter)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_get_end_iter_w, gxg_gtk_text_buffer_get_end_iter)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_get_bounds_w, gxg_gtk_text_buffer_get_bounds)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_get_iter_at_mark_w, gxg_gtk_text_buffer_get_iter_at_mark)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_get_iter_at_child_anchor_w, gxg_gtk_text_buffer_get_iter_at_child_anchor)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_modified_w, gxg_gtk_text_buffer_get_modified)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_set_modified_w, gxg_gtk_text_buffer_set_modified)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_add_selection_clipboard_w, gxg_gtk_text_buffer_add_selection_clipboard)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_remove_selection_clipboard_w, gxg_gtk_text_buffer_remove_selection_clipboard)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_cut_clipboard_w, gxg_gtk_text_buffer_cut_clipboard)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_copy_clipboard_w, gxg_gtk_text_buffer_copy_clipboard)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_paste_clipboard_w, gxg_gtk_text_buffer_paste_clipboard)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_get_selection_bounds_w, gxg_gtk_text_buffer_get_selection_bounds)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_delete_selection_w, gxg_gtk_text_buffer_delete_selection)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_begin_user_action_w, gxg_gtk_text_buffer_begin_user_action)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_end_user_action_w, gxg_gtk_text_buffer_end_user_action)
-XEN_NARGIFY_0(gxg_gtk_text_child_anchor_new_w, gxg_gtk_text_child_anchor_new)
-XEN_NARGIFY_1(gxg_gtk_text_child_anchor_get_widgets_w, gxg_gtk_text_child_anchor_get_widgets)
-XEN_NARGIFY_1(gxg_gtk_text_child_anchor_get_deleted_w, gxg_gtk_text_child_anchor_get_deleted)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_buffer_w, gxg_gtk_text_iter_get_buffer)
-XEN_NARGIFY_1(gxg_gtk_text_iter_copy_w, gxg_gtk_text_iter_copy)
-XEN_NARGIFY_1(gxg_gtk_text_iter_free_w, gxg_gtk_text_iter_free)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_offset_w, gxg_gtk_text_iter_get_offset)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_line_w, gxg_gtk_text_iter_get_line)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_line_offset_w, gxg_gtk_text_iter_get_line_offset)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_line_index_w, gxg_gtk_text_iter_get_line_index)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_visible_line_offset_w, gxg_gtk_text_iter_get_visible_line_offset)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_visible_line_index_w, gxg_gtk_text_iter_get_visible_line_index)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_char_w, gxg_gtk_text_iter_get_char)
-XEN_NARGIFY_2(gxg_gtk_text_iter_get_slice_w, gxg_gtk_text_iter_get_slice)
-XEN_NARGIFY_2(gxg_gtk_text_iter_get_text_w, gxg_gtk_text_iter_get_text)
-XEN_NARGIFY_2(gxg_gtk_text_iter_get_visible_slice_w, gxg_gtk_text_iter_get_visible_slice)
-XEN_NARGIFY_2(gxg_gtk_text_iter_get_visible_text_w, gxg_gtk_text_iter_get_visible_text)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_pixbuf_w, gxg_gtk_text_iter_get_pixbuf)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_marks_w, gxg_gtk_text_iter_get_marks)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_child_anchor_w, gxg_gtk_text_iter_get_child_anchor)
-XEN_NARGIFY_2(gxg_gtk_text_iter_get_toggled_tags_w, gxg_gtk_text_iter_get_toggled_tags)
-XEN_NARGIFY_2(gxg_gtk_text_iter_begins_tag_w, gxg_gtk_text_iter_begins_tag)
-XEN_NARGIFY_2(gxg_gtk_text_iter_ends_tag_w, gxg_gtk_text_iter_ends_tag)
-XEN_NARGIFY_2(gxg_gtk_text_iter_toggles_tag_w, gxg_gtk_text_iter_toggles_tag)
-XEN_NARGIFY_2(gxg_gtk_text_iter_has_tag_w, gxg_gtk_text_iter_has_tag)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_tags_w, gxg_gtk_text_iter_get_tags)
-XEN_NARGIFY_2(gxg_gtk_text_iter_editable_w, gxg_gtk_text_iter_editable)
-XEN_NARGIFY_2(gxg_gtk_text_iter_can_insert_w, gxg_gtk_text_iter_can_insert)
-XEN_NARGIFY_1(gxg_gtk_text_iter_starts_word_w, gxg_gtk_text_iter_starts_word)
-XEN_NARGIFY_1(gxg_gtk_text_iter_ends_word_w, gxg_gtk_text_iter_ends_word)
-XEN_NARGIFY_1(gxg_gtk_text_iter_inside_word_w, gxg_gtk_text_iter_inside_word)
-XEN_NARGIFY_1(gxg_gtk_text_iter_starts_sentence_w, gxg_gtk_text_iter_starts_sentence)
-XEN_NARGIFY_1(gxg_gtk_text_iter_ends_sentence_w, gxg_gtk_text_iter_ends_sentence)
-XEN_NARGIFY_1(gxg_gtk_text_iter_inside_sentence_w, gxg_gtk_text_iter_inside_sentence)
-XEN_NARGIFY_1(gxg_gtk_text_iter_starts_line_w, gxg_gtk_text_iter_starts_line)
-XEN_NARGIFY_1(gxg_gtk_text_iter_ends_line_w, gxg_gtk_text_iter_ends_line)
-XEN_NARGIFY_1(gxg_gtk_text_iter_is_cursor_position_w, gxg_gtk_text_iter_is_cursor_position)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_chars_in_line_w, gxg_gtk_text_iter_get_chars_in_line)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_bytes_in_line_w, gxg_gtk_text_iter_get_bytes_in_line)
-XEN_NARGIFY_2(gxg_gtk_text_iter_get_attributes_w, gxg_gtk_text_iter_get_attributes)
-XEN_NARGIFY_1(gxg_gtk_text_iter_get_language_w, gxg_gtk_text_iter_get_language)
-XEN_NARGIFY_1(gxg_gtk_text_iter_is_end_w, gxg_gtk_text_iter_is_end)
-XEN_NARGIFY_1(gxg_gtk_text_iter_is_start_w, gxg_gtk_text_iter_is_start)
-XEN_NARGIFY_1(gxg_gtk_text_iter_forward_char_w, gxg_gtk_text_iter_forward_char)
-XEN_NARGIFY_1(gxg_gtk_text_iter_backward_char_w, gxg_gtk_text_iter_backward_char)
-XEN_NARGIFY_2(gxg_gtk_text_iter_forward_chars_w, gxg_gtk_text_iter_forward_chars)
-XEN_NARGIFY_2(gxg_gtk_text_iter_backward_chars_w, gxg_gtk_text_iter_backward_chars)
-XEN_NARGIFY_1(gxg_gtk_text_iter_forward_line_w, gxg_gtk_text_iter_forward_line)
-XEN_NARGIFY_1(gxg_gtk_text_iter_backward_line_w, gxg_gtk_text_iter_backward_line)
-XEN_NARGIFY_2(gxg_gtk_text_iter_forward_lines_w, gxg_gtk_text_iter_forward_lines)
-XEN_NARGIFY_2(gxg_gtk_text_iter_backward_lines_w, gxg_gtk_text_iter_backward_lines)
-XEN_NARGIFY_1(gxg_gtk_text_iter_forward_word_end_w, gxg_gtk_text_iter_forward_word_end)
-XEN_NARGIFY_1(gxg_gtk_text_iter_backward_word_start_w, gxg_gtk_text_iter_backward_word_start)
-XEN_NARGIFY_2(gxg_gtk_text_iter_forward_word_ends_w, gxg_gtk_text_iter_forward_word_ends)
-XEN_NARGIFY_2(gxg_gtk_text_iter_backward_word_starts_w, gxg_gtk_text_iter_backward_word_starts)
-XEN_NARGIFY_1(gxg_gtk_text_iter_forward_sentence_end_w, gxg_gtk_text_iter_forward_sentence_end)
-XEN_NARGIFY_1(gxg_gtk_text_iter_backward_sentence_start_w, gxg_gtk_text_iter_backward_sentence_start)
-XEN_NARGIFY_2(gxg_gtk_text_iter_forward_sentence_ends_w, gxg_gtk_text_iter_forward_sentence_ends)
-XEN_NARGIFY_2(gxg_gtk_text_iter_backward_sentence_starts_w, gxg_gtk_text_iter_backward_sentence_starts)
-XEN_NARGIFY_1(gxg_gtk_text_iter_forward_cursor_position_w, gxg_gtk_text_iter_forward_cursor_position)
-XEN_NARGIFY_1(gxg_gtk_text_iter_backward_cursor_position_w, gxg_gtk_text_iter_backward_cursor_position)
-XEN_NARGIFY_2(gxg_gtk_text_iter_forward_cursor_positions_w, gxg_gtk_text_iter_forward_cursor_positions)
-XEN_NARGIFY_2(gxg_gtk_text_iter_backward_cursor_positions_w, gxg_gtk_text_iter_backward_cursor_positions)
-XEN_NARGIFY_2(gxg_gtk_text_iter_set_offset_w, gxg_gtk_text_iter_set_offset)
-XEN_NARGIFY_2(gxg_gtk_text_iter_set_line_w, gxg_gtk_text_iter_set_line)
-XEN_NARGIFY_2(gxg_gtk_text_iter_set_line_offset_w, gxg_gtk_text_iter_set_line_offset)
-XEN_NARGIFY_2(gxg_gtk_text_iter_set_line_index_w, gxg_gtk_text_iter_set_line_index)
-XEN_NARGIFY_1(gxg_gtk_text_iter_forward_to_end_w, gxg_gtk_text_iter_forward_to_end)
-XEN_NARGIFY_1(gxg_gtk_text_iter_forward_to_line_end_w, gxg_gtk_text_iter_forward_to_line_end)
-XEN_NARGIFY_2(gxg_gtk_text_iter_set_visible_line_offset_w, gxg_gtk_text_iter_set_visible_line_offset)
-XEN_NARGIFY_2(gxg_gtk_text_iter_set_visible_line_index_w, gxg_gtk_text_iter_set_visible_line_index)
-XEN_NARGIFY_2(gxg_gtk_text_iter_forward_to_tag_toggle_w, gxg_gtk_text_iter_forward_to_tag_toggle)
-XEN_NARGIFY_2(gxg_gtk_text_iter_backward_to_tag_toggle_w, gxg_gtk_text_iter_backward_to_tag_toggle)
-XEN_NARGIFY_4(gxg_gtk_text_iter_forward_find_char_w, gxg_gtk_text_iter_forward_find_char)
-XEN_NARGIFY_4(gxg_gtk_text_iter_backward_find_char_w, gxg_gtk_text_iter_backward_find_char)
-XEN_NARGIFY_6(gxg_gtk_text_iter_forward_search_w, gxg_gtk_text_iter_forward_search)
-XEN_NARGIFY_6(gxg_gtk_text_iter_backward_search_w, gxg_gtk_text_iter_backward_search)
-XEN_NARGIFY_2(gxg_gtk_text_iter_equal_w, gxg_gtk_text_iter_equal)
-XEN_NARGIFY_2(gxg_gtk_text_iter_compare_w, gxg_gtk_text_iter_compare)
-XEN_NARGIFY_3(gxg_gtk_text_iter_in_range_w, gxg_gtk_text_iter_in_range)
-XEN_NARGIFY_2(gxg_gtk_text_iter_order_w, gxg_gtk_text_iter_order)
-XEN_NARGIFY_2(gxg_gtk_text_mark_set_visible_w, gxg_gtk_text_mark_set_visible)
-XEN_NARGIFY_1(gxg_gtk_text_mark_get_visible_w, gxg_gtk_text_mark_get_visible)
-XEN_NARGIFY_1(gxg_gtk_text_mark_get_name_w, gxg_gtk_text_mark_get_name)
-XEN_NARGIFY_1(gxg_gtk_text_mark_get_deleted_w, gxg_gtk_text_mark_get_deleted)
-XEN_NARGIFY_1(gxg_gtk_text_mark_get_buffer_w, gxg_gtk_text_mark_get_buffer)
-XEN_NARGIFY_1(gxg_gtk_text_mark_get_left_gravity_w, gxg_gtk_text_mark_get_left_gravity)
-XEN_NARGIFY_1(gxg_gtk_text_tag_new_w, gxg_gtk_text_tag_new)
-XEN_NARGIFY_1(gxg_gtk_text_tag_get_priority_w, gxg_gtk_text_tag_get_priority)
-XEN_NARGIFY_2(gxg_gtk_text_tag_set_priority_w, gxg_gtk_text_tag_set_priority)
-XEN_NARGIFY_4(gxg_gtk_text_tag_event_w, gxg_gtk_text_tag_event)
-XEN_NARGIFY_0(gxg_gtk_text_attributes_new_w, gxg_gtk_text_attributes_new)
-XEN_NARGIFY_1(gxg_gtk_text_attributes_copy_w, gxg_gtk_text_attributes_copy)
-XEN_NARGIFY_2(gxg_gtk_text_attributes_copy_values_w, gxg_gtk_text_attributes_copy_values)
-XEN_NARGIFY_1(gxg_gtk_text_attributes_unref_w, gxg_gtk_text_attributes_unref)
-XEN_NARGIFY_0(gxg_gtk_text_tag_table_new_w, gxg_gtk_text_tag_table_new)
-XEN_NARGIFY_2(gxg_gtk_text_tag_table_add_w, gxg_gtk_text_tag_table_add)
-XEN_NARGIFY_2(gxg_gtk_text_tag_table_remove_w, gxg_gtk_text_tag_table_remove)
-XEN_NARGIFY_2(gxg_gtk_text_tag_table_lookup_w, gxg_gtk_text_tag_table_lookup)
-XEN_ARGIFY_3(gxg_gtk_text_tag_table_foreach_w, gxg_gtk_text_tag_table_foreach)
-XEN_NARGIFY_1(gxg_gtk_text_tag_table_get_size_w, gxg_gtk_text_tag_table_get_size)
-XEN_NARGIFY_0(gxg_gtk_text_view_new_w, gxg_gtk_text_view_new)
-XEN_NARGIFY_1(gxg_gtk_text_view_new_with_buffer_w, gxg_gtk_text_view_new_with_buffer)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_buffer_w, gxg_gtk_text_view_set_buffer)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_buffer_w, gxg_gtk_text_view_get_buffer)
-XEN_NARGIFY_6(gxg_gtk_text_view_scroll_to_iter_w, gxg_gtk_text_view_scroll_to_iter)
-XEN_NARGIFY_6(gxg_gtk_text_view_scroll_to_mark_w, gxg_gtk_text_view_scroll_to_mark)
-XEN_NARGIFY_2(gxg_gtk_text_view_scroll_mark_onscreen_w, gxg_gtk_text_view_scroll_mark_onscreen)
-XEN_NARGIFY_2(gxg_gtk_text_view_move_mark_onscreen_w, gxg_gtk_text_view_move_mark_onscreen)
-XEN_NARGIFY_1(gxg_gtk_text_view_place_cursor_onscreen_w, gxg_gtk_text_view_place_cursor_onscreen)
-XEN_NARGIFY_2(gxg_gtk_text_view_get_visible_rect_w, gxg_gtk_text_view_get_visible_rect)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_cursor_visible_w, gxg_gtk_text_view_set_cursor_visible)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_cursor_visible_w, gxg_gtk_text_view_get_cursor_visible)
-XEN_NARGIFY_3(gxg_gtk_text_view_get_iter_location_w, gxg_gtk_text_view_get_iter_location)
-XEN_NARGIFY_4(gxg_gtk_text_view_get_iter_at_location_w, gxg_gtk_text_view_get_iter_at_location)
-XEN_ARGIFY_4(gxg_gtk_text_view_get_line_yrange_w, gxg_gtk_text_view_get_line_yrange)
-XEN_ARGIFY_4(gxg_gtk_text_view_get_line_at_y_w, gxg_gtk_text_view_get_line_at_y)
-XEN_ARGIFY_6(gxg_gtk_text_view_buffer_to_window_coords_w, gxg_gtk_text_view_buffer_to_window_coords)
-XEN_ARGIFY_6(gxg_gtk_text_view_window_to_buffer_coords_w, gxg_gtk_text_view_window_to_buffer_coords)
-XEN_NARGIFY_2(gxg_gtk_text_view_get_window_w, gxg_gtk_text_view_get_window)
-XEN_NARGIFY_2(gxg_gtk_text_view_get_window_type_w, gxg_gtk_text_view_get_window_type)
-XEN_NARGIFY_3(gxg_gtk_text_view_set_border_window_size_w, gxg_gtk_text_view_set_border_window_size)
-XEN_NARGIFY_2(gxg_gtk_text_view_get_border_window_size_w, gxg_gtk_text_view_get_border_window_size)
-XEN_NARGIFY_2(gxg_gtk_text_view_forward_display_line_w, gxg_gtk_text_view_forward_display_line)
-XEN_NARGIFY_2(gxg_gtk_text_view_backward_display_line_w, gxg_gtk_text_view_backward_display_line)
-XEN_NARGIFY_2(gxg_gtk_text_view_forward_display_line_end_w, gxg_gtk_text_view_forward_display_line_end)
-XEN_NARGIFY_2(gxg_gtk_text_view_backward_display_line_start_w, gxg_gtk_text_view_backward_display_line_start)
-XEN_NARGIFY_2(gxg_gtk_text_view_starts_display_line_w, gxg_gtk_text_view_starts_display_line)
-XEN_NARGIFY_3(gxg_gtk_text_view_move_visually_w, gxg_gtk_text_view_move_visually)
-XEN_NARGIFY_3(gxg_gtk_text_view_add_child_at_anchor_w, gxg_gtk_text_view_add_child_at_anchor)
-XEN_NARGIFY_5(gxg_gtk_text_view_add_child_in_window_w, gxg_gtk_text_view_add_child_in_window)
-XEN_NARGIFY_4(gxg_gtk_text_view_move_child_w, gxg_gtk_text_view_move_child)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_wrap_mode_w, gxg_gtk_text_view_set_wrap_mode)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_wrap_mode_w, gxg_gtk_text_view_get_wrap_mode)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_editable_w, gxg_gtk_text_view_set_editable)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_editable_w, gxg_gtk_text_view_get_editable)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_pixels_above_lines_w, gxg_gtk_text_view_set_pixels_above_lines)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_pixels_above_lines_w, gxg_gtk_text_view_get_pixels_above_lines)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_pixels_below_lines_w, gxg_gtk_text_view_set_pixels_below_lines)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_pixels_below_lines_w, gxg_gtk_text_view_get_pixels_below_lines)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_pixels_inside_wrap_w, gxg_gtk_text_view_set_pixels_inside_wrap)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_pixels_inside_wrap_w, gxg_gtk_text_view_get_pixels_inside_wrap)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_justification_w, gxg_gtk_text_view_set_justification)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_justification_w, gxg_gtk_text_view_get_justification)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_left_margin_w, gxg_gtk_text_view_set_left_margin)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_left_margin_w, gxg_gtk_text_view_get_left_margin)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_right_margin_w, gxg_gtk_text_view_set_right_margin)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_right_margin_w, gxg_gtk_text_view_get_right_margin)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_indent_w, gxg_gtk_text_view_set_indent)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_indent_w, gxg_gtk_text_view_get_indent)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_tabs_w, gxg_gtk_text_view_set_tabs)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_tabs_w, gxg_gtk_text_view_get_tabs)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_default_attributes_w, gxg_gtk_text_view_get_default_attributes)
-XEN_NARGIFY_0(gxg_gtk_toggle_button_new_w, gxg_gtk_toggle_button_new)
-XEN_NARGIFY_1(gxg_gtk_toggle_button_new_with_label_w, gxg_gtk_toggle_button_new_with_label)
-XEN_NARGIFY_1(gxg_gtk_toggle_button_new_with_mnemonic_w, gxg_gtk_toggle_button_new_with_mnemonic)
-XEN_NARGIFY_2(gxg_gtk_toggle_button_set_mode_w, gxg_gtk_toggle_button_set_mode)
-XEN_NARGIFY_1(gxg_gtk_toggle_button_get_mode_w, gxg_gtk_toggle_button_get_mode)
-XEN_NARGIFY_2(gxg_gtk_toggle_button_set_active_w, gxg_gtk_toggle_button_set_active)
-XEN_NARGIFY_1(gxg_gtk_toggle_button_get_active_w, gxg_gtk_toggle_button_get_active)
-XEN_NARGIFY_1(gxg_gtk_toggle_button_toggled_w, gxg_gtk_toggle_button_toggled)
-XEN_NARGIFY_2(gxg_gtk_toggle_button_set_inconsistent_w, gxg_gtk_toggle_button_set_inconsistent)
-XEN_NARGIFY_1(gxg_gtk_toggle_button_get_inconsistent_w, gxg_gtk_toggle_button_get_inconsistent)
-XEN_NARGIFY_0(gxg_gtk_toolbar_new_w, gxg_gtk_toolbar_new)
-XEN_NARGIFY_2(gxg_gtk_toolbar_set_style_w, gxg_gtk_toolbar_set_style)
-XEN_NARGIFY_1(gxg_gtk_toolbar_unset_style_w, gxg_gtk_toolbar_unset_style)
-XEN_NARGIFY_1(gxg_gtk_toolbar_get_style_w, gxg_gtk_toolbar_get_style)
-XEN_NARGIFY_1(gxg_gtk_toolbar_get_icon_size_w, gxg_gtk_toolbar_get_icon_size)
-XEN_NARGIFY_2(gxg_gtk_tree_drag_source_row_draggable_w, gxg_gtk_tree_drag_source_row_draggable)
-XEN_NARGIFY_2(gxg_gtk_tree_drag_source_drag_data_delete_w, gxg_gtk_tree_drag_source_drag_data_delete)
-XEN_NARGIFY_3(gxg_gtk_tree_drag_source_drag_data_get_w, gxg_gtk_tree_drag_source_drag_data_get)
-XEN_NARGIFY_3(gxg_gtk_tree_drag_dest_drag_data_received_w, gxg_gtk_tree_drag_dest_drag_data_received)
-XEN_NARGIFY_3(gxg_gtk_tree_drag_dest_row_drop_possible_w, gxg_gtk_tree_drag_dest_row_drop_possible)
-XEN_NARGIFY_3(gxg_gtk_tree_set_row_drag_data_w, gxg_gtk_tree_set_row_drag_data)
-XEN_ARGIFY_3(gxg_gtk_tree_get_row_drag_data_w, gxg_gtk_tree_get_row_drag_data)
-XEN_NARGIFY_0(gxg_gtk_tree_path_new_w, gxg_gtk_tree_path_new)
-XEN_NARGIFY_1(gxg_gtk_tree_path_new_from_string_w, gxg_gtk_tree_path_new_from_string)
-XEN_NARGIFY_1(gxg_gtk_tree_path_to_string_w, gxg_gtk_tree_path_to_string)
-XEN_NARGIFY_0(gxg_gtk_tree_path_new_first_w, gxg_gtk_tree_path_new_first)
-XEN_NARGIFY_2(gxg_gtk_tree_path_append_index_w, gxg_gtk_tree_path_append_index)
-XEN_NARGIFY_2(gxg_gtk_tree_path_prepend_index_w, gxg_gtk_tree_path_prepend_index)
-XEN_NARGIFY_1(gxg_gtk_tree_path_get_depth_w, gxg_gtk_tree_path_get_depth)
-XEN_NARGIFY_1(gxg_gtk_tree_path_get_indices_w, gxg_gtk_tree_path_get_indices)
-XEN_NARGIFY_1(gxg_gtk_tree_path_free_w, gxg_gtk_tree_path_free)
-XEN_NARGIFY_1(gxg_gtk_tree_path_copy_w, gxg_gtk_tree_path_copy)
-XEN_NARGIFY_2(gxg_gtk_tree_path_compare_w, gxg_gtk_tree_path_compare)
-XEN_NARGIFY_1(gxg_gtk_tree_path_next_w, gxg_gtk_tree_path_next)
-XEN_NARGIFY_1(gxg_gtk_tree_path_prev_w, gxg_gtk_tree_path_prev)
-XEN_NARGIFY_1(gxg_gtk_tree_path_up_w, gxg_gtk_tree_path_up)
-XEN_NARGIFY_1(gxg_gtk_tree_path_down_w, gxg_gtk_tree_path_down)
-XEN_NARGIFY_2(gxg_gtk_tree_path_is_ancestor_w, gxg_gtk_tree_path_is_ancestor)
-XEN_NARGIFY_2(gxg_gtk_tree_path_is_descendant_w, gxg_gtk_tree_path_is_descendant)
-XEN_NARGIFY_2(gxg_gtk_tree_row_reference_new_w, gxg_gtk_tree_row_reference_new)
-XEN_NARGIFY_3(gxg_gtk_tree_row_reference_new_proxy_w, gxg_gtk_tree_row_reference_new_proxy)
-XEN_NARGIFY_1(gxg_gtk_tree_row_reference_get_path_w, gxg_gtk_tree_row_reference_get_path)
-XEN_NARGIFY_1(gxg_gtk_tree_row_reference_valid_w, gxg_gtk_tree_row_reference_valid)
-XEN_NARGIFY_1(gxg_gtk_tree_row_reference_free_w, gxg_gtk_tree_row_reference_free)
-XEN_NARGIFY_2(gxg_gtk_tree_row_reference_inserted_w, gxg_gtk_tree_row_reference_inserted)
-XEN_NARGIFY_2(gxg_gtk_tree_row_reference_deleted_w, gxg_gtk_tree_row_reference_deleted)
-XEN_NARGIFY_4(gxg_gtk_tree_row_reference_reordered_w, gxg_gtk_tree_row_reference_reordered)
-XEN_NARGIFY_1(gxg_gtk_tree_iter_copy_w, gxg_gtk_tree_iter_copy)
-XEN_NARGIFY_1(gxg_gtk_tree_iter_free_w, gxg_gtk_tree_iter_free)
-XEN_NARGIFY_1(gxg_gtk_tree_model_get_flags_w, gxg_gtk_tree_model_get_flags)
-XEN_NARGIFY_1(gxg_gtk_tree_model_get_n_columns_w, gxg_gtk_tree_model_get_n_columns)
-XEN_NARGIFY_2(gxg_gtk_tree_model_get_column_type_w, gxg_gtk_tree_model_get_column_type)
-XEN_NARGIFY_3(gxg_gtk_tree_model_get_iter_w, gxg_gtk_tree_model_get_iter)
-XEN_NARGIFY_3(gxg_gtk_tree_model_get_iter_from_string_w, gxg_gtk_tree_model_get_iter_from_string)
-XEN_NARGIFY_2(gxg_gtk_tree_model_get_iter_first_w, gxg_gtk_tree_model_get_iter_first)
-XEN_NARGIFY_2(gxg_gtk_tree_model_get_path_w, gxg_gtk_tree_model_get_path)
-XEN_NARGIFY_2(gxg_gtk_tree_model_iter_next_w, gxg_gtk_tree_model_iter_next)
-XEN_NARGIFY_3(gxg_gtk_tree_model_iter_children_w, gxg_gtk_tree_model_iter_children)
-XEN_NARGIFY_2(gxg_gtk_tree_model_iter_has_child_w, gxg_gtk_tree_model_iter_has_child)
-XEN_NARGIFY_2(gxg_gtk_tree_model_iter_n_children_w, gxg_gtk_tree_model_iter_n_children)
-XEN_NARGIFY_4(gxg_gtk_tree_model_iter_nth_child_w, gxg_gtk_tree_model_iter_nth_child)
-XEN_NARGIFY_3(gxg_gtk_tree_model_iter_parent_w, gxg_gtk_tree_model_iter_parent)
-XEN_NARGIFY_2(gxg_gtk_tree_model_ref_node_w, gxg_gtk_tree_model_ref_node)
-XEN_NARGIFY_2(gxg_gtk_tree_model_unref_node_w, gxg_gtk_tree_model_unref_node)
-XEN_ARGIFY_3(gxg_gtk_tree_model_foreach_w, gxg_gtk_tree_model_foreach)
-XEN_NARGIFY_3(gxg_gtk_tree_model_row_changed_w, gxg_gtk_tree_model_row_changed)
-XEN_NARGIFY_3(gxg_gtk_tree_model_row_inserted_w, gxg_gtk_tree_model_row_inserted)
-XEN_NARGIFY_3(gxg_gtk_tree_model_row_has_child_toggled_w, gxg_gtk_tree_model_row_has_child_toggled)
-XEN_NARGIFY_2(gxg_gtk_tree_model_row_deleted_w, gxg_gtk_tree_model_row_deleted)
-XEN_NARGIFY_4(gxg_gtk_tree_model_rows_reordered_w, gxg_gtk_tree_model_rows_reordered)
-XEN_NARGIFY_1(gxg_gtk_tree_model_sort_new_with_model_w, gxg_gtk_tree_model_sort_new_with_model)
-XEN_NARGIFY_1(gxg_gtk_tree_model_sort_get_model_w, gxg_gtk_tree_model_sort_get_model)
-XEN_NARGIFY_2(gxg_gtk_tree_model_sort_convert_child_path_to_path_w, gxg_gtk_tree_model_sort_convert_child_path_to_path)
-XEN_NARGIFY_3(gxg_gtk_tree_model_sort_convert_child_iter_to_iter_w, gxg_gtk_tree_model_sort_convert_child_iter_to_iter)
-XEN_NARGIFY_2(gxg_gtk_tree_model_sort_convert_path_to_child_path_w, gxg_gtk_tree_model_sort_convert_path_to_child_path)
-XEN_NARGIFY_3(gxg_gtk_tree_model_sort_convert_iter_to_child_iter_w, gxg_gtk_tree_model_sort_convert_iter_to_child_iter)
-XEN_NARGIFY_1(gxg_gtk_tree_model_sort_reset_default_sort_func_w, gxg_gtk_tree_model_sort_reset_default_sort_func)
-XEN_NARGIFY_1(gxg_gtk_tree_model_sort_clear_cache_w, gxg_gtk_tree_model_sort_clear_cache)
-XEN_NARGIFY_2(gxg_gtk_tree_selection_set_mode_w, gxg_gtk_tree_selection_set_mode)
-XEN_NARGIFY_1(gxg_gtk_tree_selection_get_mode_w, gxg_gtk_tree_selection_get_mode)
-XEN_NARGIFY_4(gxg_gtk_tree_selection_set_select_function_w, gxg_gtk_tree_selection_set_select_function)
-XEN_NARGIFY_1(gxg_gtk_tree_selection_get_user_data_w, gxg_gtk_tree_selection_get_user_data)
-XEN_NARGIFY_1(gxg_gtk_tree_selection_get_tree_view_w, gxg_gtk_tree_selection_get_tree_view)
-XEN_NARGIFY_3(gxg_gtk_tree_selection_get_selected_w, gxg_gtk_tree_selection_get_selected)
-XEN_ARGIFY_3(gxg_gtk_tree_selection_selected_foreach_w, gxg_gtk_tree_selection_selected_foreach)
-XEN_NARGIFY_2(gxg_gtk_tree_selection_select_path_w, gxg_gtk_tree_selection_select_path)
-XEN_NARGIFY_2(gxg_gtk_tree_selection_unselect_path_w, gxg_gtk_tree_selection_unselect_path)
-XEN_NARGIFY_2(gxg_gtk_tree_selection_select_iter_w, gxg_gtk_tree_selection_select_iter)
-XEN_NARGIFY_2(gxg_gtk_tree_selection_unselect_iter_w, gxg_gtk_tree_selection_unselect_iter)
-XEN_NARGIFY_2(gxg_gtk_tree_selection_path_is_selected_w, gxg_gtk_tree_selection_path_is_selected)
-XEN_NARGIFY_2(gxg_gtk_tree_selection_iter_is_selected_w, gxg_gtk_tree_selection_iter_is_selected)
-XEN_NARGIFY_1(gxg_gtk_tree_selection_select_all_w, gxg_gtk_tree_selection_select_all)
-XEN_NARGIFY_1(gxg_gtk_tree_selection_unselect_all_w, gxg_gtk_tree_selection_unselect_all)
-XEN_NARGIFY_3(gxg_gtk_tree_selection_select_range_w, gxg_gtk_tree_selection_select_range)
-XEN_NARGIFY_1(gxg_gtk_tree_sortable_sort_column_changed_w, gxg_gtk_tree_sortable_sort_column_changed)
-XEN_ARGIFY_3(gxg_gtk_tree_sortable_get_sort_column_id_w, gxg_gtk_tree_sortable_get_sort_column_id)
-XEN_NARGIFY_3(gxg_gtk_tree_sortable_set_sort_column_id_w, gxg_gtk_tree_sortable_set_sort_column_id)
-XEN_NARGIFY_5(gxg_gtk_tree_sortable_set_sort_func_w, gxg_gtk_tree_sortable_set_sort_func)
-XEN_NARGIFY_4(gxg_gtk_tree_sortable_set_default_sort_func_w, gxg_gtk_tree_sortable_set_default_sort_func)
-XEN_NARGIFY_1(gxg_gtk_tree_sortable_has_default_sort_func_w, gxg_gtk_tree_sortable_has_default_sort_func)
-XEN_NARGIFY_2(gxg_gtk_tree_store_new_w, gxg_gtk_tree_store_new)
-XEN_NARGIFY_2(gxg_gtk_tree_store_newv_w, gxg_gtk_tree_store_newv)
-XEN_NARGIFY_3(gxg_gtk_tree_store_set_column_types_w, gxg_gtk_tree_store_set_column_types)
-XEN_NARGIFY_3(gxg_gtk_tree_store_set_w, gxg_gtk_tree_store_set)
-XEN_NARGIFY_2(gxg_gtk_tree_store_remove_w, gxg_gtk_tree_store_remove)
-XEN_NARGIFY_4(gxg_gtk_tree_store_insert_w, gxg_gtk_tree_store_insert)
-XEN_NARGIFY_4(gxg_gtk_tree_store_insert_before_w, gxg_gtk_tree_store_insert_before)
-XEN_NARGIFY_4(gxg_gtk_tree_store_insert_after_w, gxg_gtk_tree_store_insert_after)
-XEN_NARGIFY_3(gxg_gtk_tree_store_prepend_w, gxg_gtk_tree_store_prepend)
-XEN_NARGIFY_3(gxg_gtk_tree_store_append_w, gxg_gtk_tree_store_append)
-XEN_NARGIFY_3(gxg_gtk_tree_store_is_ancestor_w, gxg_gtk_tree_store_is_ancestor)
-XEN_NARGIFY_2(gxg_gtk_tree_store_iter_depth_w, gxg_gtk_tree_store_iter_depth)
-XEN_NARGIFY_1(gxg_gtk_tree_store_clear_w, gxg_gtk_tree_store_clear)
-XEN_NARGIFY_0(gxg_gtk_tree_view_column_new_w, gxg_gtk_tree_view_column_new)
-XEN_NARGIFY_3(gxg_gtk_tree_view_column_new_with_attributes_w, gxg_gtk_tree_view_column_new_with_attributes)
-XEN_NARGIFY_3(gxg_gtk_tree_view_column_pack_start_w, gxg_gtk_tree_view_column_pack_start)
-XEN_NARGIFY_3(gxg_gtk_tree_view_column_pack_end_w, gxg_gtk_tree_view_column_pack_end)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_clear_w, gxg_gtk_tree_view_column_clear)
-XEN_NARGIFY_4(gxg_gtk_tree_view_column_add_attribute_w, gxg_gtk_tree_view_column_add_attribute)
-XEN_NARGIFY_3(gxg_gtk_tree_view_column_set_attributes_w, gxg_gtk_tree_view_column_set_attributes)
-XEN_NARGIFY_5(gxg_gtk_tree_view_column_set_cell_data_func_w, gxg_gtk_tree_view_column_set_cell_data_func)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_clear_attributes_w, gxg_gtk_tree_view_column_clear_attributes)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_spacing_w, gxg_gtk_tree_view_column_set_spacing)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_spacing_w, gxg_gtk_tree_view_column_get_spacing)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_visible_w, gxg_gtk_tree_view_column_set_visible)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_visible_w, gxg_gtk_tree_view_column_get_visible)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_resizable_w, gxg_gtk_tree_view_column_set_resizable)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_resizable_w, gxg_gtk_tree_view_column_get_resizable)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_sizing_w, gxg_gtk_tree_view_column_set_sizing)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_sizing_w, gxg_gtk_tree_view_column_get_sizing)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_width_w, gxg_gtk_tree_view_column_get_width)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_fixed_width_w, gxg_gtk_tree_view_column_get_fixed_width)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_fixed_width_w, gxg_gtk_tree_view_column_set_fixed_width)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_min_width_w, gxg_gtk_tree_view_column_set_min_width)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_min_width_w, gxg_gtk_tree_view_column_get_min_width)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_max_width_w, gxg_gtk_tree_view_column_set_max_width)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_max_width_w, gxg_gtk_tree_view_column_get_max_width)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_clicked_w, gxg_gtk_tree_view_column_clicked)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_title_w, gxg_gtk_tree_view_column_set_title)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_title_w, gxg_gtk_tree_view_column_get_title)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_clickable_w, gxg_gtk_tree_view_column_set_clickable)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_clickable_w, gxg_gtk_tree_view_column_get_clickable)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_widget_w, gxg_gtk_tree_view_column_set_widget)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_widget_w, gxg_gtk_tree_view_column_get_widget)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_alignment_w, gxg_gtk_tree_view_column_set_alignment)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_alignment_w, gxg_gtk_tree_view_column_get_alignment)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_reorderable_w, gxg_gtk_tree_view_column_set_reorderable)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_reorderable_w, gxg_gtk_tree_view_column_get_reorderable)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_sort_column_id_w, gxg_gtk_tree_view_column_set_sort_column_id)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_sort_column_id_w, gxg_gtk_tree_view_column_get_sort_column_id)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_sort_indicator_w, gxg_gtk_tree_view_column_set_sort_indicator)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_sort_indicator_w, gxg_gtk_tree_view_column_get_sort_indicator)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_sort_order_w, gxg_gtk_tree_view_column_set_sort_order)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_sort_order_w, gxg_gtk_tree_view_column_get_sort_order)
-XEN_NARGIFY_5(gxg_gtk_tree_view_column_cell_set_cell_data_w, gxg_gtk_tree_view_column_cell_set_cell_data)
-XEN_ARGIFY_6(gxg_gtk_tree_view_column_cell_get_size_w, gxg_gtk_tree_view_column_cell_get_size)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_cell_is_visible_w, gxg_gtk_tree_view_column_cell_is_visible)
-XEN_ARGIFY_4(gxg_gtk_tree_view_column_cell_get_position_w, gxg_gtk_tree_view_column_cell_get_position)
-XEN_NARGIFY_0(gxg_gtk_tree_view_new_w, gxg_gtk_tree_view_new)
-XEN_NARGIFY_1(gxg_gtk_tree_view_new_with_model_w, gxg_gtk_tree_view_new_with_model)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_model_w, gxg_gtk_tree_view_get_model)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_model_w, gxg_gtk_tree_view_set_model)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_selection_w, gxg_gtk_tree_view_get_selection)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_headers_visible_w, gxg_gtk_tree_view_get_headers_visible)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_headers_visible_w, gxg_gtk_tree_view_set_headers_visible)
-XEN_NARGIFY_1(gxg_gtk_tree_view_columns_autosize_w, gxg_gtk_tree_view_columns_autosize)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_headers_clickable_w, gxg_gtk_tree_view_set_headers_clickable)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_rules_hint_w, gxg_gtk_tree_view_set_rules_hint)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_rules_hint_w, gxg_gtk_tree_view_get_rules_hint)
-XEN_NARGIFY_2(gxg_gtk_tree_view_append_column_w, gxg_gtk_tree_view_append_column)
-XEN_NARGIFY_2(gxg_gtk_tree_view_remove_column_w, gxg_gtk_tree_view_remove_column)
-XEN_NARGIFY_3(gxg_gtk_tree_view_insert_column_w, gxg_gtk_tree_view_insert_column)
-XEN_NARGIFY_5(gxg_gtk_tree_view_insert_column_with_attributes_w, gxg_gtk_tree_view_insert_column_with_attributes)
-XEN_NARGIFY_7(gxg_gtk_tree_view_insert_column_with_data_func_w, gxg_gtk_tree_view_insert_column_with_data_func)
-XEN_NARGIFY_2(gxg_gtk_tree_view_get_column_w, gxg_gtk_tree_view_get_column)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_columns_w, gxg_gtk_tree_view_get_columns)
-XEN_NARGIFY_3(gxg_gtk_tree_view_move_column_after_w, gxg_gtk_tree_view_move_column_after)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_expander_column_w, gxg_gtk_tree_view_set_expander_column)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_expander_column_w, gxg_gtk_tree_view_get_expander_column)
-XEN_NARGIFY_4(gxg_gtk_tree_view_set_column_drag_function_w, gxg_gtk_tree_view_set_column_drag_function)
-XEN_NARGIFY_3(gxg_gtk_tree_view_scroll_to_point_w, gxg_gtk_tree_view_scroll_to_point)
-XEN_NARGIFY_6(gxg_gtk_tree_view_scroll_to_cell_w, gxg_gtk_tree_view_scroll_to_cell)
-XEN_NARGIFY_3(gxg_gtk_tree_view_row_activated_w, gxg_gtk_tree_view_row_activated)
-XEN_NARGIFY_1(gxg_gtk_tree_view_expand_all_w, gxg_gtk_tree_view_expand_all)
-XEN_NARGIFY_1(gxg_gtk_tree_view_collapse_all_w, gxg_gtk_tree_view_collapse_all)
-XEN_NARGIFY_3(gxg_gtk_tree_view_expand_row_w, gxg_gtk_tree_view_expand_row)
-XEN_NARGIFY_2(gxg_gtk_tree_view_collapse_row_w, gxg_gtk_tree_view_collapse_row)
-XEN_ARGIFY_3(gxg_gtk_tree_view_map_expanded_rows_w, gxg_gtk_tree_view_map_expanded_rows)
-XEN_NARGIFY_2(gxg_gtk_tree_view_row_expanded_w, gxg_gtk_tree_view_row_expanded)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_reorderable_w, gxg_gtk_tree_view_set_reorderable)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_reorderable_w, gxg_gtk_tree_view_get_reorderable)
-XEN_NARGIFY_4(gxg_gtk_tree_view_set_cursor_w, gxg_gtk_tree_view_set_cursor)
-XEN_ARGIFY_3(gxg_gtk_tree_view_get_cursor_w, gxg_gtk_tree_view_get_cursor)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_bin_window_w, gxg_gtk_tree_view_get_bin_window)
-XEN_ARGIFY_7(gxg_gtk_tree_view_get_path_at_pos_w, gxg_gtk_tree_view_get_path_at_pos)
-XEN_NARGIFY_4(gxg_gtk_tree_view_get_cell_area_w, gxg_gtk_tree_view_get_cell_area)
-XEN_NARGIFY_4(gxg_gtk_tree_view_get_background_area_w, gxg_gtk_tree_view_get_background_area)
-XEN_NARGIFY_2(gxg_gtk_tree_view_get_visible_rect_w, gxg_gtk_tree_view_get_visible_rect)
-XEN_NARGIFY_5(gxg_gtk_tree_view_enable_model_drag_source_w, gxg_gtk_tree_view_enable_model_drag_source)
-XEN_NARGIFY_4(gxg_gtk_tree_view_enable_model_drag_dest_w, gxg_gtk_tree_view_enable_model_drag_dest)
-XEN_NARGIFY_1(gxg_gtk_tree_view_unset_rows_drag_source_w, gxg_gtk_tree_view_unset_rows_drag_source)
-XEN_NARGIFY_1(gxg_gtk_tree_view_unset_rows_drag_dest_w, gxg_gtk_tree_view_unset_rows_drag_dest)
-XEN_NARGIFY_3(gxg_gtk_tree_view_set_drag_dest_row_w, gxg_gtk_tree_view_set_drag_dest_row)
-XEN_ARGIFY_3(gxg_gtk_tree_view_get_drag_dest_row_w, gxg_gtk_tree_view_get_drag_dest_row)
-XEN_ARGIFY_5(gxg_gtk_tree_view_get_dest_row_at_pos_w, gxg_gtk_tree_view_get_dest_row_at_pos)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_enable_search_w, gxg_gtk_tree_view_set_enable_search)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_enable_search_w, gxg_gtk_tree_view_get_enable_search)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_search_column_w, gxg_gtk_tree_view_get_search_column)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_search_column_w, gxg_gtk_tree_view_set_search_column)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_search_equal_func_w, gxg_gtk_tree_view_get_search_equal_func)
-XEN_NARGIFY_4(gxg_gtk_tree_view_set_search_equal_func_w, gxg_gtk_tree_view_set_search_equal_func)
-XEN_NARGIFY_0(gxg_gtk_vbutton_box_new_w, gxg_gtk_vbutton_box_new)
-XEN_NARGIFY_2(gxg_gtk_viewport_new_w, gxg_gtk_viewport_new)
-XEN_NARGIFY_2(gxg_gtk_viewport_set_shadow_type_w, gxg_gtk_viewport_set_shadow_type)
-XEN_NARGIFY_1(gxg_gtk_viewport_get_shadow_type_w, gxg_gtk_viewport_get_shadow_type)
-XEN_NARGIFY_0(gxg_gtk_vpaned_new_w, gxg_gtk_vpaned_new)
-XEN_NARGIFY_1(gxg_gtk_vscale_new_w, gxg_gtk_vscale_new)
-XEN_NARGIFY_3(gxg_gtk_vscale_new_with_range_w, gxg_gtk_vscale_new_with_range)
-XEN_NARGIFY_1(gxg_gtk_vscrollbar_new_w, gxg_gtk_vscrollbar_new)
-XEN_NARGIFY_0(gxg_gtk_vseparator_new_w, gxg_gtk_vseparator_new)
-XEN_NARGIFY_1(gxg_gtk_widget_destroy_w, gxg_gtk_widget_destroy)
-XEN_ARGIFY_2(gxg_gtk_widget_destroyed_w, gxg_gtk_widget_destroyed)
-XEN_NARGIFY_1(gxg_gtk_widget_unparent_w, gxg_gtk_widget_unparent)
-XEN_NARGIFY_1(gxg_gtk_widget_show_w, gxg_gtk_widget_show)
-XEN_NARGIFY_1(gxg_gtk_widget_show_now_w, gxg_gtk_widget_show_now)
-XEN_NARGIFY_1(gxg_gtk_widget_hide_w, gxg_gtk_widget_hide)
-XEN_NARGIFY_1(gxg_gtk_widget_show_all_w, gxg_gtk_widget_show_all)
-XEN_NARGIFY_1(gxg_gtk_widget_map_w, gxg_gtk_widget_map)
-XEN_NARGIFY_1(gxg_gtk_widget_unmap_w, gxg_gtk_widget_unmap)
-XEN_NARGIFY_1(gxg_gtk_widget_realize_w, gxg_gtk_widget_realize)
-XEN_NARGIFY_1(gxg_gtk_widget_unrealize_w, gxg_gtk_widget_unrealize)
-XEN_NARGIFY_1(gxg_gtk_widget_queue_draw_w, gxg_gtk_widget_queue_draw)
-XEN_NARGIFY_5(gxg_gtk_widget_queue_draw_area_w, gxg_gtk_widget_queue_draw_area)
-XEN_NARGIFY_1(gxg_gtk_widget_queue_resize_w, gxg_gtk_widget_queue_resize)
-XEN_NARGIFY_2(gxg_gtk_widget_size_allocate_w, gxg_gtk_widget_size_allocate)
-XEN_NARGIFY_6(gxg_gtk_widget_add_accelerator_w, gxg_gtk_widget_add_accelerator)
-XEN_NARGIFY_4(gxg_gtk_widget_remove_accelerator_w, gxg_gtk_widget_remove_accelerator)
-XEN_NARGIFY_1(gxg_gtk_widget_list_accel_closures_w, gxg_gtk_widget_list_accel_closures)
-XEN_NARGIFY_2(gxg_gtk_widget_mnemonic_activate_w, gxg_gtk_widget_mnemonic_activate)
-XEN_NARGIFY_2(gxg_gtk_widget_event_w, gxg_gtk_widget_event)
-XEN_NARGIFY_2(gxg_gtk_widget_send_expose_w, gxg_gtk_widget_send_expose)
-XEN_NARGIFY_1(gxg_gtk_widget_activate_w, gxg_gtk_widget_activate)
-XEN_NARGIFY_2(gxg_gtk_widget_reparent_w, gxg_gtk_widget_reparent)
-XEN_NARGIFY_3(gxg_gtk_widget_intersect_w, gxg_gtk_widget_intersect)
-XEN_NARGIFY_1(gxg_gtk_widget_freeze_child_notify_w, gxg_gtk_widget_freeze_child_notify)
-XEN_NARGIFY_2(gxg_gtk_widget_child_notify_w, gxg_gtk_widget_child_notify)
-XEN_NARGIFY_1(gxg_gtk_widget_thaw_child_notify_w, gxg_gtk_widget_thaw_child_notify)
-XEN_NARGIFY_1(gxg_gtk_widget_is_focus_w, gxg_gtk_widget_is_focus)
-XEN_NARGIFY_1(gxg_gtk_widget_grab_focus_w, gxg_gtk_widget_grab_focus)
-XEN_NARGIFY_1(gxg_gtk_widget_grab_default_w, gxg_gtk_widget_grab_default)
-XEN_NARGIFY_2(gxg_gtk_widget_set_name_w, gxg_gtk_widget_set_name)
-XEN_NARGIFY_1(gxg_gtk_widget_get_name_w, gxg_gtk_widget_get_name)
-XEN_NARGIFY_2(gxg_gtk_widget_set_state_w, gxg_gtk_widget_set_state)
-XEN_NARGIFY_2(gxg_gtk_widget_set_sensitive_w, gxg_gtk_widget_set_sensitive)
-XEN_NARGIFY_2(gxg_gtk_widget_set_app_paintable_w, gxg_gtk_widget_set_app_paintable)
-XEN_NARGIFY_2(gxg_gtk_widget_set_double_buffered_w, gxg_gtk_widget_set_double_buffered)
-XEN_NARGIFY_2(gxg_gtk_widget_set_redraw_on_allocate_w, gxg_gtk_widget_set_redraw_on_allocate)
-XEN_NARGIFY_2(gxg_gtk_widget_set_parent_w, gxg_gtk_widget_set_parent)
-XEN_NARGIFY_2(gxg_gtk_widget_set_parent_window_w, gxg_gtk_widget_set_parent_window)
-XEN_NARGIFY_2(gxg_gtk_widget_set_child_visible_w, gxg_gtk_widget_set_child_visible)
-XEN_NARGIFY_3(gxg_gtk_widget_set_accel_path_w, gxg_gtk_widget_set_accel_path)
-XEN_NARGIFY_1(gxg_gtk_widget_get_child_visible_w, gxg_gtk_widget_get_child_visible)
-XEN_NARGIFY_1(gxg_gtk_widget_get_parent_w, gxg_gtk_widget_get_parent)
-XEN_NARGIFY_1(gxg_gtk_widget_get_parent_window_w, gxg_gtk_widget_get_parent_window)
-XEN_NARGIFY_2(gxg_gtk_widget_child_focus_w, gxg_gtk_widget_child_focus)
-XEN_NARGIFY_3(gxg_gtk_widget_set_size_request_w, gxg_gtk_widget_set_size_request)
-XEN_ARGIFY_3(gxg_gtk_widget_get_size_request_w, gxg_gtk_widget_get_size_request)
-XEN_NARGIFY_2(gxg_gtk_widget_set_events_w, gxg_gtk_widget_set_events)
-XEN_NARGIFY_2(gxg_gtk_widget_add_events_w, gxg_gtk_widget_add_events)
-XEN_NARGIFY_1(gxg_gtk_widget_get_toplevel_w, gxg_gtk_widget_get_toplevel)
-XEN_NARGIFY_2(gxg_gtk_widget_get_ancestor_w, gxg_gtk_widget_get_ancestor)
-XEN_NARGIFY_1(gxg_gtk_widget_get_visual_w, gxg_gtk_widget_get_visual)
-XEN_NARGIFY_1(gxg_gtk_widget_get_accessible_w, gxg_gtk_widget_get_accessible)
-XEN_NARGIFY_1(gxg_gtk_widget_get_events_w, gxg_gtk_widget_get_events)
-XEN_ARGIFY_3(gxg_gtk_widget_get_pointer_w, gxg_gtk_widget_get_pointer)
-XEN_NARGIFY_2(gxg_gtk_widget_is_ancestor_w, gxg_gtk_widget_is_ancestor)
-XEN_ARGIFY_6(gxg_gtk_widget_translate_coordinates_w, gxg_gtk_widget_translate_coordinates)
-XEN_NARGIFY_1(gxg_gtk_widget_hide_on_delete_w, gxg_gtk_widget_hide_on_delete)
-XEN_NARGIFY_1(gxg_gtk_widget_create_pango_context_w, gxg_gtk_widget_create_pango_context)
-XEN_NARGIFY_1(gxg_gtk_widget_get_pango_context_w, gxg_gtk_widget_get_pango_context)
-XEN_NARGIFY_2(gxg_gtk_widget_create_pango_layout_w, gxg_gtk_widget_create_pango_layout)
-XEN_NARGIFY_2(gxg_gtk_widget_set_composite_name_w, gxg_gtk_widget_set_composite_name)
-XEN_NARGIFY_1(gxg_gtk_widget_get_composite_name_w, gxg_gtk_widget_get_composite_name)
-XEN_NARGIFY_0(gxg_gtk_widget_push_composite_child_w, gxg_gtk_widget_push_composite_child)
-XEN_NARGIFY_0(gxg_gtk_widget_pop_composite_child_w, gxg_gtk_widget_pop_composite_child)
-XEN_NARGIFY_2(gxg_gtk_widget_set_direction_w, gxg_gtk_widget_set_direction)
-XEN_NARGIFY_1(gxg_gtk_widget_get_direction_w, gxg_gtk_widget_get_direction)
-XEN_NARGIFY_1(gxg_gtk_widget_set_default_direction_w, gxg_gtk_widget_set_default_direction)
-XEN_NARGIFY_0(gxg_gtk_widget_get_default_direction_w, gxg_gtk_widget_get_default_direction)
-XEN_NARGIFY_2(gxg_gtk_widget_can_activate_accel_w, gxg_gtk_widget_can_activate_accel)
-XEN_NARGIFY_1(gxg_gtk_window_is_active_w, gxg_gtk_window_is_active)
-XEN_NARGIFY_1(gxg_gtk_window_has_toplevel_focus_w, gxg_gtk_window_has_toplevel_focus)
-XEN_NARGIFY_1(gxg_gtk_window_new_w, gxg_gtk_window_new)
-XEN_NARGIFY_2(gxg_gtk_window_set_title_w, gxg_gtk_window_set_title)
-XEN_NARGIFY_1(gxg_gtk_window_set_auto_startup_notification_w, gxg_gtk_window_set_auto_startup_notification)
-XEN_NARGIFY_1(gxg_gtk_window_get_title_w, gxg_gtk_window_get_title)
-XEN_NARGIFY_3(gxg_gtk_window_set_wmclass_w, gxg_gtk_window_set_wmclass)
-XEN_NARGIFY_2(gxg_gtk_window_set_role_w, gxg_gtk_window_set_role)
-XEN_NARGIFY_1(gxg_gtk_window_get_role_w, gxg_gtk_window_get_role)
-XEN_NARGIFY_2(gxg_gtk_window_add_accel_group_w, gxg_gtk_window_add_accel_group)
-XEN_NARGIFY_2(gxg_gtk_window_remove_accel_group_w, gxg_gtk_window_remove_accel_group)
-XEN_NARGIFY_2(gxg_gtk_window_set_position_w, gxg_gtk_window_set_position)
-XEN_NARGIFY_1(gxg_gtk_window_activate_focus_w, gxg_gtk_window_activate_focus)
-XEN_NARGIFY_2(gxg_gtk_window_set_focus_w, gxg_gtk_window_set_focus)
-XEN_NARGIFY_1(gxg_gtk_window_get_focus_w, gxg_gtk_window_get_focus)
-XEN_NARGIFY_2(gxg_gtk_window_set_default_w, gxg_gtk_window_set_default)
-XEN_NARGIFY_1(gxg_gtk_window_activate_default_w, gxg_gtk_window_activate_default)
-XEN_NARGIFY_2(gxg_gtk_window_set_transient_for_w, gxg_gtk_window_set_transient_for)
-XEN_NARGIFY_1(gxg_gtk_window_get_transient_for_w, gxg_gtk_window_get_transient_for)
-XEN_NARGIFY_2(gxg_gtk_window_set_type_hint_w, gxg_gtk_window_set_type_hint)
-XEN_NARGIFY_1(gxg_gtk_window_get_type_hint_w, gxg_gtk_window_get_type_hint)
-XEN_NARGIFY_2(gxg_gtk_window_set_destroy_with_parent_w, gxg_gtk_window_set_destroy_with_parent)
-XEN_NARGIFY_1(gxg_gtk_window_get_destroy_with_parent_w, gxg_gtk_window_get_destroy_with_parent)
-XEN_NARGIFY_2(gxg_gtk_window_set_resizable_w, gxg_gtk_window_set_resizable)
-XEN_NARGIFY_1(gxg_gtk_window_get_resizable_w, gxg_gtk_window_get_resizable)
-XEN_NARGIFY_2(gxg_gtk_window_set_gravity_w, gxg_gtk_window_set_gravity)
-XEN_NARGIFY_1(gxg_gtk_window_get_gravity_w, gxg_gtk_window_get_gravity)
-XEN_NARGIFY_4(gxg_gtk_window_set_geometry_hints_w, gxg_gtk_window_set_geometry_hints)
-XEN_NARGIFY_2(gxg_gtk_window_set_decorated_w, gxg_gtk_window_set_decorated)
-XEN_NARGIFY_1(gxg_gtk_window_get_decorated_w, gxg_gtk_window_get_decorated)
-XEN_NARGIFY_2(gxg_gtk_window_set_icon_list_w, gxg_gtk_window_set_icon_list)
-XEN_NARGIFY_1(gxg_gtk_window_get_icon_list_w, gxg_gtk_window_get_icon_list)
-XEN_NARGIFY_2(gxg_gtk_window_set_icon_w, gxg_gtk_window_set_icon)
-XEN_NARGIFY_1(gxg_gtk_window_get_icon_w, gxg_gtk_window_get_icon)
-XEN_NARGIFY_1(gxg_gtk_window_set_default_icon_list_w, gxg_gtk_window_set_default_icon_list)
-XEN_NARGIFY_0(gxg_gtk_window_get_default_icon_list_w, gxg_gtk_window_get_default_icon_list)
-XEN_NARGIFY_2(gxg_gtk_window_set_modal_w, gxg_gtk_window_set_modal)
-XEN_NARGIFY_1(gxg_gtk_window_get_modal_w, gxg_gtk_window_get_modal)
-XEN_NARGIFY_0(gxg_gtk_window_list_toplevels_w, gxg_gtk_window_list_toplevels)
-XEN_NARGIFY_3(gxg_gtk_window_add_mnemonic_w, gxg_gtk_window_add_mnemonic)
-XEN_NARGIFY_3(gxg_gtk_window_remove_mnemonic_w, gxg_gtk_window_remove_mnemonic)
-XEN_NARGIFY_3(gxg_gtk_window_mnemonic_activate_w, gxg_gtk_window_mnemonic_activate)
-XEN_NARGIFY_2(gxg_gtk_window_set_mnemonic_modifier_w, gxg_gtk_window_set_mnemonic_modifier)
-XEN_NARGIFY_1(gxg_gtk_window_get_mnemonic_modifier_w, gxg_gtk_window_get_mnemonic_modifier)
-XEN_NARGIFY_1(gxg_gtk_window_present_w, gxg_gtk_window_present)
-XEN_NARGIFY_1(gxg_gtk_window_iconify_w, gxg_gtk_window_iconify)
-XEN_NARGIFY_1(gxg_gtk_window_deiconify_w, gxg_gtk_window_deiconify)
-XEN_NARGIFY_1(gxg_gtk_window_stick_w, gxg_gtk_window_stick)
-XEN_NARGIFY_1(gxg_gtk_window_unstick_w, gxg_gtk_window_unstick)
-XEN_NARGIFY_1(gxg_gtk_window_maximize_w, gxg_gtk_window_maximize)
-XEN_NARGIFY_1(gxg_gtk_window_unmaximize_w, gxg_gtk_window_unmaximize)
-XEN_NARGIFY_6(gxg_gtk_window_begin_resize_drag_w, gxg_gtk_window_begin_resize_drag)
-XEN_NARGIFY_5(gxg_gtk_window_begin_move_drag_w, gxg_gtk_window_begin_move_drag)
-XEN_NARGIFY_3(gxg_gtk_window_set_default_size_w, gxg_gtk_window_set_default_size)
-XEN_ARGIFY_3(gxg_gtk_window_get_default_size_w, gxg_gtk_window_get_default_size)
-XEN_NARGIFY_3(gxg_gtk_window_resize_w, gxg_gtk_window_resize)
-XEN_ARGIFY_3(gxg_gtk_window_get_size_w, gxg_gtk_window_get_size)
-XEN_NARGIFY_3(gxg_gtk_window_move_w, gxg_gtk_window_move)
-XEN_ARGIFY_3(gxg_gtk_window_get_position_w, gxg_gtk_window_get_position)
-XEN_NARGIFY_2(gxg_gtk_window_parse_geometry_w, gxg_gtk_window_parse_geometry)
-XEN_NARGIFY_1(gxg_gtk_window_reshow_with_initial_size_w, gxg_gtk_window_reshow_with_initial_size)
-XEN_NARGIFY_1(gxg_pango_color_copy_w, gxg_pango_color_copy)
-XEN_NARGIFY_1(gxg_pango_color_free_w, gxg_pango_color_free)
-XEN_NARGIFY_2(gxg_pango_color_parse_w, gxg_pango_color_parse)
-XEN_NARGIFY_1(gxg_pango_attr_type_register_w, gxg_pango_attr_type_register)
-XEN_NARGIFY_1(gxg_pango_attribute_copy_w, gxg_pango_attribute_copy)
-XEN_NARGIFY_1(gxg_pango_attribute_destroy_w, gxg_pango_attribute_destroy)
-XEN_NARGIFY_2(gxg_pango_attribute_equal_w, gxg_pango_attribute_equal)
-XEN_NARGIFY_1(gxg_pango_attr_language_new_w, gxg_pango_attr_language_new)
-XEN_NARGIFY_1(gxg_pango_attr_family_new_w, gxg_pango_attr_family_new)
-XEN_NARGIFY_3(gxg_pango_attr_foreground_new_w, gxg_pango_attr_foreground_new)
-XEN_NARGIFY_3(gxg_pango_attr_background_new_w, gxg_pango_attr_background_new)
-XEN_NARGIFY_1(gxg_pango_attr_size_new_w, gxg_pango_attr_size_new)
-XEN_NARGIFY_1(gxg_pango_attr_style_new_w, gxg_pango_attr_style_new)
-XEN_NARGIFY_1(gxg_pango_attr_weight_new_w, gxg_pango_attr_weight_new)
-XEN_NARGIFY_1(gxg_pango_attr_variant_new_w, gxg_pango_attr_variant_new)
-XEN_NARGIFY_1(gxg_pango_attr_stretch_new_w, gxg_pango_attr_stretch_new)
-XEN_NARGIFY_1(gxg_pango_attr_font_desc_new_w, gxg_pango_attr_font_desc_new)
-XEN_NARGIFY_1(gxg_pango_attr_underline_new_w, gxg_pango_attr_underline_new)
-XEN_NARGIFY_1(gxg_pango_attr_strikethrough_new_w, gxg_pango_attr_strikethrough_new)
-XEN_NARGIFY_1(gxg_pango_attr_rise_new_w, gxg_pango_attr_rise_new)
-XEN_NARGIFY_2(gxg_pango_attr_shape_new_w, gxg_pango_attr_shape_new)
-XEN_NARGIFY_1(gxg_pango_attr_scale_new_w, gxg_pango_attr_scale_new)
-XEN_NARGIFY_0(gxg_pango_attr_list_new_w, gxg_pango_attr_list_new)
-XEN_NARGIFY_1(gxg_pango_attr_list_unref_w, gxg_pango_attr_list_unref)
-XEN_NARGIFY_1(gxg_pango_attr_list_copy_w, gxg_pango_attr_list_copy)
-XEN_NARGIFY_2(gxg_pango_attr_list_insert_w, gxg_pango_attr_list_insert)
-XEN_NARGIFY_2(gxg_pango_attr_list_insert_before_w, gxg_pango_attr_list_insert_before)
-XEN_NARGIFY_2(gxg_pango_attr_list_change_w, gxg_pango_attr_list_change)
-XEN_NARGIFY_4(gxg_pango_attr_list_splice_w, gxg_pango_attr_list_splice)
-XEN_NARGIFY_1(gxg_pango_attr_list_get_iterator_w, gxg_pango_attr_list_get_iterator)
-XEN_ARGIFY_3(gxg_pango_attr_iterator_range_w, gxg_pango_attr_iterator_range)
-XEN_NARGIFY_1(gxg_pango_attr_iterator_next_w, gxg_pango_attr_iterator_next)
-XEN_NARGIFY_1(gxg_pango_attr_iterator_copy_w, gxg_pango_attr_iterator_copy)
-XEN_NARGIFY_1(gxg_pango_attr_iterator_destroy_w, gxg_pango_attr_iterator_destroy)
-XEN_NARGIFY_2(gxg_pango_attr_iterator_get_w, gxg_pango_attr_iterator_get)
-XEN_ARGIFY_4(gxg_pango_attr_iterator_get_font_w, gxg_pango_attr_iterator_get_font)
-XEN_ARGIFY_7(gxg_pango_parse_markup_w, gxg_pango_parse_markup)
-XEN_NARGIFY_5(gxg_pango_break_w, gxg_pango_break)
-XEN_ARGIFY_4(gxg_pango_find_paragraph_boundary_w, gxg_pango_find_paragraph_boundary)
-XEN_NARGIFY_6(gxg_pango_get_log_attrs_w, gxg_pango_get_log_attrs)
-XEN_ARGIFY_3(gxg_pango_context_list_families_w, gxg_pango_context_list_families)
-XEN_NARGIFY_2(gxg_pango_context_load_font_w, gxg_pango_context_load_font)
-XEN_NARGIFY_3(gxg_pango_context_load_fontset_w, gxg_pango_context_load_fontset)
-XEN_NARGIFY_3(gxg_pango_context_get_metrics_w, gxg_pango_context_get_metrics)
-XEN_NARGIFY_2(gxg_pango_context_set_font_description_w, gxg_pango_context_set_font_description)
-XEN_NARGIFY_1(gxg_pango_context_get_font_description_w, gxg_pango_context_get_font_description)
-XEN_NARGIFY_1(gxg_pango_context_get_language_w, gxg_pango_context_get_language)
-XEN_NARGIFY_2(gxg_pango_context_set_language_w, gxg_pango_context_set_language)
-XEN_NARGIFY_2(gxg_pango_context_set_base_dir_w, gxg_pango_context_set_base_dir)
-XEN_NARGIFY_1(gxg_pango_context_get_base_dir_w, gxg_pango_context_get_base_dir)
-XEN_NARGIFY_6(gxg_pango_itemize_w, gxg_pango_itemize)
-XEN_NARGIFY_0(gxg_pango_coverage_new_w, gxg_pango_coverage_new)
-XEN_NARGIFY_1(gxg_pango_coverage_ref_w, gxg_pango_coverage_ref)
-XEN_NARGIFY_1(gxg_pango_coverage_unref_w, gxg_pango_coverage_unref)
-XEN_NARGIFY_1(gxg_pango_coverage_copy_w, gxg_pango_coverage_copy)
-XEN_NARGIFY_2(gxg_pango_coverage_get_w, gxg_pango_coverage_get)
-XEN_NARGIFY_3(gxg_pango_coverage_set_w, gxg_pango_coverage_set)
-XEN_NARGIFY_2(gxg_pango_coverage_max_w, gxg_pango_coverage_max)
-XEN_ARGIFY_3(gxg_pango_coverage_to_bytes_w, gxg_pango_coverage_to_bytes)
-XEN_NARGIFY_2(gxg_pango_coverage_from_bytes_w, gxg_pango_coverage_from_bytes)
-XEN_NARGIFY_0(gxg_pango_font_description_new_w, gxg_pango_font_description_new)
-XEN_NARGIFY_1(gxg_pango_font_description_copy_w, gxg_pango_font_description_copy)
-XEN_NARGIFY_1(gxg_pango_font_description_copy_static_w, gxg_pango_font_description_copy_static)
-XEN_NARGIFY_1(gxg_pango_font_description_hash_w, gxg_pango_font_description_hash)
-XEN_NARGIFY_2(gxg_pango_font_description_equal_w, gxg_pango_font_description_equal)
-XEN_NARGIFY_1(gxg_pango_font_description_free_w, gxg_pango_font_description_free)
-XEN_NARGIFY_2(gxg_pango_font_descriptions_free_w, gxg_pango_font_descriptions_free)
-XEN_NARGIFY_2(gxg_pango_font_description_set_family_w, gxg_pango_font_description_set_family)
-XEN_NARGIFY_2(gxg_pango_font_description_set_family_static_w, gxg_pango_font_description_set_family_static)
-XEN_NARGIFY_1(gxg_pango_font_description_get_family_w, gxg_pango_font_description_get_family)
-XEN_NARGIFY_2(gxg_pango_font_description_set_style_w, gxg_pango_font_description_set_style)
-XEN_NARGIFY_1(gxg_pango_font_description_get_style_w, gxg_pango_font_description_get_style)
-XEN_NARGIFY_2(gxg_pango_font_description_set_variant_w, gxg_pango_font_description_set_variant)
-XEN_NARGIFY_1(gxg_pango_font_description_get_variant_w, gxg_pango_font_description_get_variant)
-XEN_NARGIFY_2(gxg_pango_font_description_set_weight_w, gxg_pango_font_description_set_weight)
-XEN_NARGIFY_1(gxg_pango_font_description_get_weight_w, gxg_pango_font_description_get_weight)
-XEN_NARGIFY_2(gxg_pango_font_description_set_stretch_w, gxg_pango_font_description_set_stretch)
-XEN_NARGIFY_1(gxg_pango_font_description_get_stretch_w, gxg_pango_font_description_get_stretch)
-XEN_NARGIFY_2(gxg_pango_font_description_set_size_w, gxg_pango_font_description_set_size)
-XEN_NARGIFY_1(gxg_pango_font_description_get_size_w, gxg_pango_font_description_get_size)
-XEN_NARGIFY_1(gxg_pango_font_description_get_set_fields_w, gxg_pango_font_description_get_set_fields)
-XEN_NARGIFY_2(gxg_pango_font_description_unset_fields_w, gxg_pango_font_description_unset_fields)
-XEN_NARGIFY_3(gxg_pango_font_description_merge_w, gxg_pango_font_description_merge)
-XEN_NARGIFY_3(gxg_pango_font_description_merge_static_w, gxg_pango_font_description_merge_static)
-XEN_NARGIFY_3(gxg_pango_font_description_better_match_w, gxg_pango_font_description_better_match)
-XEN_NARGIFY_1(gxg_pango_font_description_from_string_w, gxg_pango_font_description_from_string)
-XEN_NARGIFY_1(gxg_pango_font_description_to_string_w, gxg_pango_font_description_to_string)
-XEN_NARGIFY_1(gxg_pango_font_description_to_filename_w, gxg_pango_font_description_to_filename)
-XEN_NARGIFY_1(gxg_pango_font_metrics_ref_w, gxg_pango_font_metrics_ref)
-XEN_NARGIFY_1(gxg_pango_font_metrics_unref_w, gxg_pango_font_metrics_unref)
-XEN_NARGIFY_1(gxg_pango_font_metrics_get_ascent_w, gxg_pango_font_metrics_get_ascent)
-XEN_NARGIFY_1(gxg_pango_font_metrics_get_descent_w, gxg_pango_font_metrics_get_descent)
-XEN_NARGIFY_1(gxg_pango_font_metrics_get_approximate_char_width_w, gxg_pango_font_metrics_get_approximate_char_width)
-XEN_NARGIFY_1(gxg_pango_font_metrics_get_approximate_digit_width_w, gxg_pango_font_metrics_get_approximate_digit_width)
-XEN_ARGIFY_3(gxg_pango_font_family_list_faces_w, gxg_pango_font_family_list_faces)
-XEN_NARGIFY_1(gxg_pango_font_family_get_name_w, gxg_pango_font_family_get_name)
-XEN_NARGIFY_1(gxg_pango_font_face_describe_w, gxg_pango_font_face_describe)
-XEN_NARGIFY_1(gxg_pango_font_face_get_face_name_w, gxg_pango_font_face_get_face_name)
-XEN_NARGIFY_1(gxg_pango_font_describe_w, gxg_pango_font_describe)
-XEN_NARGIFY_2(gxg_pango_font_get_coverage_w, gxg_pango_font_get_coverage)
-XEN_NARGIFY_2(gxg_pango_font_get_metrics_w, gxg_pango_font_get_metrics)
-XEN_NARGIFY_4(gxg_pango_font_get_glyph_extents_w, gxg_pango_font_get_glyph_extents)
-XEN_NARGIFY_3(gxg_pango_font_map_load_font_w, gxg_pango_font_map_load_font)
-XEN_NARGIFY_4(gxg_pango_font_map_load_fontset_w, gxg_pango_font_map_load_fontset)
-XEN_ARGIFY_3(gxg_pango_font_map_list_families_w, gxg_pango_font_map_list_families)
-XEN_NARGIFY_0(gxg_pango_glyph_string_new_w, gxg_pango_glyph_string_new)
-XEN_NARGIFY_2(gxg_pango_glyph_string_set_size_w, gxg_pango_glyph_string_set_size)
-XEN_NARGIFY_1(gxg_pango_glyph_string_copy_w, gxg_pango_glyph_string_copy)
-XEN_NARGIFY_1(gxg_pango_glyph_string_free_w, gxg_pango_glyph_string_free)
-XEN_NARGIFY_4(gxg_pango_glyph_string_extents_w, gxg_pango_glyph_string_extents)
-XEN_NARGIFY_6(gxg_pango_glyph_string_extents_range_w, gxg_pango_glyph_string_extents_range)
-XEN_ARGIFY_5(gxg_pango_glyph_string_get_logical_widths_w, gxg_pango_glyph_string_get_logical_widths)
-XEN_ARGIFY_7(gxg_pango_glyph_string_index_to_x_w, gxg_pango_glyph_string_index_to_x)
-XEN_ARGIFY_7(gxg_pango_glyph_string_x_to_index_w, gxg_pango_glyph_string_x_to_index)
-XEN_NARGIFY_4(gxg_pango_shape_w, gxg_pango_shape)
-XEN_NARGIFY_1(gxg_pango_reorder_items_w, gxg_pango_reorder_items)
-XEN_NARGIFY_0(gxg_pango_item_new_w, gxg_pango_item_new)
-XEN_NARGIFY_1(gxg_pango_item_copy_w, gxg_pango_item_copy)
-XEN_NARGIFY_1(gxg_pango_item_free_w, gxg_pango_item_free)
-XEN_NARGIFY_3(gxg_pango_item_split_w, gxg_pango_item_split)
-XEN_NARGIFY_1(gxg_pango_layout_new_w, gxg_pango_layout_new)
-XEN_NARGIFY_1(gxg_pango_layout_copy_w, gxg_pango_layout_copy)
-XEN_NARGIFY_1(gxg_pango_layout_get_context_w, gxg_pango_layout_get_context)
-XEN_NARGIFY_2(gxg_pango_layout_set_attributes_w, gxg_pango_layout_set_attributes)
-XEN_NARGIFY_1(gxg_pango_layout_get_attributes_w, gxg_pango_layout_get_attributes)
-XEN_NARGIFY_3(gxg_pango_layout_set_text_w, gxg_pango_layout_set_text)
-XEN_NARGIFY_1(gxg_pango_layout_get_text_w, gxg_pango_layout_get_text)
-XEN_NARGIFY_3(gxg_pango_layout_set_markup_w, gxg_pango_layout_set_markup)
-XEN_NARGIFY_5(gxg_pango_layout_set_markup_with_accel_w, gxg_pango_layout_set_markup_with_accel)
-XEN_NARGIFY_2(gxg_pango_layout_set_font_description_w, gxg_pango_layout_set_font_description)
-XEN_NARGIFY_2(gxg_pango_layout_set_width_w, gxg_pango_layout_set_width)
-XEN_NARGIFY_1(gxg_pango_layout_get_width_w, gxg_pango_layout_get_width)
-XEN_NARGIFY_2(gxg_pango_layout_set_wrap_w, gxg_pango_layout_set_wrap)
-XEN_NARGIFY_1(gxg_pango_layout_get_wrap_w, gxg_pango_layout_get_wrap)
-XEN_NARGIFY_2(gxg_pango_layout_set_indent_w, gxg_pango_layout_set_indent)
-XEN_NARGIFY_1(gxg_pango_layout_get_indent_w, gxg_pango_layout_get_indent)
-XEN_NARGIFY_2(gxg_pango_layout_set_spacing_w, gxg_pango_layout_set_spacing)
-XEN_NARGIFY_1(gxg_pango_layout_get_spacing_w, gxg_pango_layout_get_spacing)
-XEN_NARGIFY_2(gxg_pango_layout_set_justify_w, gxg_pango_layout_set_justify)
-XEN_NARGIFY_1(gxg_pango_layout_get_justify_w, gxg_pango_layout_get_justify)
-XEN_NARGIFY_2(gxg_pango_layout_set_alignment_w, gxg_pango_layout_set_alignment)
-XEN_NARGIFY_1(gxg_pango_layout_get_alignment_w, gxg_pango_layout_get_alignment)
-XEN_NARGIFY_2(gxg_pango_layout_set_tabs_w, gxg_pango_layout_set_tabs)
-XEN_NARGIFY_1(gxg_pango_layout_get_tabs_w, gxg_pango_layout_get_tabs)
-XEN_NARGIFY_2(gxg_pango_layout_set_single_paragraph_mode_w, gxg_pango_layout_set_single_paragraph_mode)
-XEN_NARGIFY_1(gxg_pango_layout_get_single_paragraph_mode_w, gxg_pango_layout_get_single_paragraph_mode)
-XEN_NARGIFY_1(gxg_pango_layout_context_changed_w, gxg_pango_layout_context_changed)
-XEN_ARGIFY_3(gxg_pango_layout_get_log_attrs_w, gxg_pango_layout_get_log_attrs)
-XEN_NARGIFY_3(gxg_pango_layout_index_to_pos_w, gxg_pango_layout_index_to_pos)
-XEN_NARGIFY_4(gxg_pango_layout_get_cursor_pos_w, gxg_pango_layout_get_cursor_pos)
-XEN_NARGIFY_7(gxg_pango_layout_move_cursor_visually_w, gxg_pango_layout_move_cursor_visually)
-XEN_ARGIFY_5(gxg_pango_layout_xy_to_index_w, gxg_pango_layout_xy_to_index)
-XEN_NARGIFY_3(gxg_pango_layout_get_extents_w, gxg_pango_layout_get_extents)
-XEN_NARGIFY_3(gxg_pango_layout_get_pixel_extents_w, gxg_pango_layout_get_pixel_extents)
-XEN_ARGIFY_3(gxg_pango_layout_get_size_w, gxg_pango_layout_get_size)
-XEN_ARGIFY_3(gxg_pango_layout_get_pixel_size_w, gxg_pango_layout_get_pixel_size)
-XEN_NARGIFY_1(gxg_pango_layout_get_line_count_w, gxg_pango_layout_get_line_count)
-XEN_NARGIFY_2(gxg_pango_layout_get_line_w, gxg_pango_layout_get_line)
-XEN_NARGIFY_1(gxg_pango_layout_get_lines_w, gxg_pango_layout_get_lines)
-XEN_NARGIFY_1(gxg_pango_layout_line_unref_w, gxg_pango_layout_line_unref)
-XEN_ARGIFY_4(gxg_pango_layout_line_x_to_index_w, gxg_pango_layout_line_x_to_index)
-XEN_ARGIFY_4(gxg_pango_layout_line_index_to_x_w, gxg_pango_layout_line_index_to_x)
-XEN_ARGIFY_5(gxg_pango_layout_line_get_x_ranges_w, gxg_pango_layout_line_get_x_ranges)
-XEN_NARGIFY_3(gxg_pango_layout_line_get_extents_w, gxg_pango_layout_line_get_extents)
-XEN_NARGIFY_3(gxg_pango_layout_line_get_pixel_extents_w, gxg_pango_layout_line_get_pixel_extents)
-XEN_NARGIFY_1(gxg_pango_layout_get_iter_w, gxg_pango_layout_get_iter)
-XEN_NARGIFY_1(gxg_pango_layout_iter_free_w, gxg_pango_layout_iter_free)
-XEN_NARGIFY_1(gxg_pango_layout_iter_get_index_w, gxg_pango_layout_iter_get_index)
-XEN_NARGIFY_1(gxg_pango_layout_iter_get_run_w, gxg_pango_layout_iter_get_run)
-XEN_NARGIFY_1(gxg_pango_layout_iter_get_line_w, gxg_pango_layout_iter_get_line)
-XEN_NARGIFY_1(gxg_pango_layout_iter_at_last_line_w, gxg_pango_layout_iter_at_last_line)
-XEN_NARGIFY_1(gxg_pango_layout_iter_next_char_w, gxg_pango_layout_iter_next_char)
-XEN_NARGIFY_1(gxg_pango_layout_iter_next_cluster_w, gxg_pango_layout_iter_next_cluster)
-XEN_NARGIFY_1(gxg_pango_layout_iter_next_run_w, gxg_pango_layout_iter_next_run)
-XEN_NARGIFY_1(gxg_pango_layout_iter_next_line_w, gxg_pango_layout_iter_next_line)
-XEN_NARGIFY_2(gxg_pango_layout_iter_get_char_extents_w, gxg_pango_layout_iter_get_char_extents)
-XEN_NARGIFY_3(gxg_pango_layout_iter_get_cluster_extents_w, gxg_pango_layout_iter_get_cluster_extents)
-XEN_NARGIFY_3(gxg_pango_layout_iter_get_run_extents_w, gxg_pango_layout_iter_get_run_extents)
-XEN_NARGIFY_3(gxg_pango_layout_iter_get_line_extents_w, gxg_pango_layout_iter_get_line_extents)
-XEN_ARGIFY_3(gxg_pango_layout_iter_get_line_yrange_w, gxg_pango_layout_iter_get_line_yrange)
-XEN_NARGIFY_3(gxg_pango_layout_iter_get_layout_extents_w, gxg_pango_layout_iter_get_layout_extents)
-XEN_NARGIFY_1(gxg_pango_layout_iter_get_baseline_w, gxg_pango_layout_iter_get_baseline)
-XEN_NARGIFY_1(gxg_pango_language_from_string_w, gxg_pango_language_from_string)
-XEN_NARGIFY_2(gxg_pango_language_matches_w, gxg_pango_language_matches)
-XEN_NARGIFY_1(gxg_G_OBJECT_TYPE_w, gxg_G_OBJECT_TYPE)
-XEN_ARGIFY_3(gxg_g_utf8_validate_w, gxg_g_utf8_validate)
-XEN_NARGIFY_2(gxg_gtk_tree_model_get_string_from_iter_w, gxg_gtk_tree_model_get_string_from_iter)
-XEN_NARGIFY_2(gxg_gtk_tree_model_sort_iter_is_valid_w, gxg_gtk_tree_model_sort_iter_is_valid)
-XEN_NARGIFY_2(gxg_gtk_tree_view_expand_to_path_w, gxg_gtk_tree_view_expand_to_path)
-XEN_NARGIFY_2(gxg_gtk_tree_selection_get_selected_rows_w, gxg_gtk_tree_selection_get_selected_rows)
-XEN_NARGIFY_1(gxg_gtk_tree_selection_count_selected_rows_w, gxg_gtk_tree_selection_count_selected_rows)
-XEN_NARGIFY_2(gxg_gtk_menu_shell_select_first_w, gxg_gtk_menu_shell_select_first)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_n_pages_w, gxg_gtk_notebook_get_n_pages)
-XEN_NARGIFY_2(gxg_gtk_list_store_reorder_w, gxg_gtk_list_store_reorder)
-XEN_NARGIFY_3(gxg_gtk_list_store_swap_w, gxg_gtk_list_store_swap)
-XEN_NARGIFY_3(gxg_gtk_list_store_move_after_w, gxg_gtk_list_store_move_after)
-XEN_NARGIFY_3(gxg_gtk_list_store_move_before_w, gxg_gtk_list_store_move_before)
-XEN_NARGIFY_3(gxg_gtk_tree_store_reorder_w, gxg_gtk_tree_store_reorder)
-XEN_NARGIFY_3(gxg_gtk_tree_store_swap_w, gxg_gtk_tree_store_swap)
-XEN_NARGIFY_1(gxg_gdk_display_open_w, gxg_gdk_display_open)
-XEN_NARGIFY_1(gxg_gdk_display_get_name_w, gxg_gdk_display_get_name)
-XEN_NARGIFY_1(gxg_gdk_display_get_n_screens_w, gxg_gdk_display_get_n_screens)
-XEN_NARGIFY_2(gxg_gdk_display_get_screen_w, gxg_gdk_display_get_screen)
-XEN_NARGIFY_1(gxg_gdk_display_get_default_screen_w, gxg_gdk_display_get_default_screen)
-XEN_NARGIFY_1(gxg_gdk_display_beep_w, gxg_gdk_display_beep)
-XEN_NARGIFY_1(gxg_gdk_display_sync_w, gxg_gdk_display_sync)
-XEN_NARGIFY_1(gxg_gdk_display_close_w, gxg_gdk_display_close)
-XEN_NARGIFY_1(gxg_gdk_display_get_event_w, gxg_gdk_display_get_event)
-XEN_NARGIFY_1(gxg_gdk_display_peek_event_w, gxg_gdk_display_peek_event)
-XEN_NARGIFY_2(gxg_gdk_display_put_event_w, gxg_gdk_display_put_event)
-XEN_NARGIFY_2(gxg_gdk_display_set_double_click_time_w, gxg_gdk_display_set_double_click_time)
-XEN_NARGIFY_0(gxg_gdk_display_get_default_w, gxg_gdk_display_get_default)
-XEN_NARGIFY_1(gxg_gdk_screen_get_system_visual_w, gxg_gdk_screen_get_system_visual)
-XEN_NARGIFY_1(gxg_gdk_screen_get_root_window_w, gxg_gdk_screen_get_root_window)
-XEN_NARGIFY_1(gxg_gdk_screen_get_display_w, gxg_gdk_screen_get_display)
-XEN_NARGIFY_1(gxg_gdk_screen_get_number_w, gxg_gdk_screen_get_number)
-XEN_NARGIFY_1(gxg_gdk_screen_get_width_w, gxg_gdk_screen_get_width)
-XEN_NARGIFY_1(gxg_gdk_screen_get_height_w, gxg_gdk_screen_get_height)
-XEN_NARGIFY_1(gxg_gdk_screen_get_width_mm_w, gxg_gdk_screen_get_width_mm)
-XEN_NARGIFY_1(gxg_gdk_screen_get_height_mm_w, gxg_gdk_screen_get_height_mm)
-XEN_NARGIFY_1(gxg_gdk_screen_list_visuals_w, gxg_gdk_screen_list_visuals)
-XEN_NARGIFY_1(gxg_gdk_screen_get_toplevel_windows_w, gxg_gdk_screen_get_toplevel_windows)
-XEN_NARGIFY_1(gxg_gdk_screen_make_display_name_w, gxg_gdk_screen_make_display_name)
-XEN_NARGIFY_1(gxg_gdk_screen_get_n_monitors_w, gxg_gdk_screen_get_n_monitors)
-XEN_NARGIFY_3(gxg_gdk_screen_get_monitor_geometry_w, gxg_gdk_screen_get_monitor_geometry)
-XEN_NARGIFY_3(gxg_gdk_screen_get_monitor_at_point_w, gxg_gdk_screen_get_monitor_at_point)
-XEN_NARGIFY_2(gxg_gdk_screen_get_monitor_at_window_w, gxg_gdk_screen_get_monitor_at_window)
-XEN_NARGIFY_0(gxg_gdk_screen_get_default_w, gxg_gdk_screen_get_default)
-XEN_NARGIFY_2(gxg_gtk_clipboard_get_for_display_w, gxg_gtk_clipboard_get_for_display)
-XEN_NARGIFY_1(gxg_gtk_clipboard_get_display_w, gxg_gtk_clipboard_get_display)
-XEN_NARGIFY_1(gxg_gtk_widget_get_screen_w, gxg_gtk_widget_get_screen)
-XEN_NARGIFY_1(gxg_gtk_widget_has_screen_w, gxg_gtk_widget_has_screen)
-XEN_NARGIFY_1(gxg_gtk_widget_get_display_w, gxg_gtk_widget_get_display)
-XEN_NARGIFY_1(gxg_gtk_widget_get_root_window_w, gxg_gtk_widget_get_root_window)
-XEN_NARGIFY_2(gxg_gtk_widget_get_clipboard_w, gxg_gtk_widget_get_clipboard)
-XEN_NARGIFY_1(gxg_g_list_free_w, gxg_g_list_free)
-XEN_NARGIFY_1(gxg_g_list_reverse_w, gxg_g_list_reverse)
-XEN_NARGIFY_1(gxg_g_list_copy_w, gxg_g_list_copy)
-XEN_NARGIFY_1(gxg_g_list_last_w, gxg_g_list_last)
-XEN_NARGIFY_1(gxg_g_list_first_w, gxg_g_list_first)
-XEN_NARGIFY_1(gxg_g_list_length_w, gxg_g_list_length)
-XEN_NARGIFY_1(gxg_g_free_w, gxg_g_free)
-XEN_NARGIFY_2(gxg_g_list_remove_link_w, gxg_g_list_remove_link)
-XEN_NARGIFY_2(gxg_g_object_get_data_w, gxg_g_object_get_data)
-XEN_NARGIFY_3(gxg_g_object_set_data_w, gxg_g_object_set_data)
-XEN_NARGIFY_4(gxg_gdk_cursor_new_from_pixbuf_w, gxg_gdk_cursor_new_from_pixbuf)
-XEN_NARGIFY_1(gxg_gdk_display_flush_w, gxg_gdk_display_flush)
-XEN_NARGIFY_1(gxg_gdk_display_supports_cursor_alpha_w, gxg_gdk_display_supports_cursor_alpha)
-XEN_NARGIFY_1(gxg_gdk_display_supports_cursor_color_w, gxg_gdk_display_supports_cursor_color)
-XEN_NARGIFY_1(gxg_gdk_display_get_default_cursor_size_w, gxg_gdk_display_get_default_cursor_size)
-XEN_ARGIFY_3(gxg_gdk_display_get_maximal_cursor_size_w, gxg_gdk_display_get_maximal_cursor_size)
-XEN_NARGIFY_2(gxg_gdk_window_set_keep_above_w, gxg_gdk_window_set_keep_above)
-XEN_NARGIFY_2(gxg_gdk_window_set_keep_below_w, gxg_gdk_window_set_keep_below)
-XEN_NARGIFY_5(gxg_gtk_alignment_set_padding_w, gxg_gtk_alignment_set_padding)
-XEN_ARGIFY_5(gxg_gtk_alignment_get_padding_w, gxg_gtk_alignment_get_padding)
-XEN_NARGIFY_2(gxg_gtk_button_box_get_child_secondary_w, gxg_gtk_button_box_get_child_secondary)
-XEN_NARGIFY_2(gxg_gtk_button_set_focus_on_click_w, gxg_gtk_button_set_focus_on_click)
-XEN_NARGIFY_1(gxg_gtk_button_get_focus_on_click_w, gxg_gtk_button_get_focus_on_click)
-XEN_NARGIFY_2(gxg_gtk_calendar_set_display_options_w, gxg_gtk_calendar_set_display_options)
-XEN_NARGIFY_1(gxg_gtk_calendar_get_display_options_w, gxg_gtk_calendar_get_display_options)
-XEN_NARGIFY_2(gxg_gtk_check_menu_item_set_draw_as_radio_w, gxg_gtk_check_menu_item_set_draw_as_radio)
-XEN_NARGIFY_1(gxg_gtk_check_menu_item_get_draw_as_radio_w, gxg_gtk_check_menu_item_get_draw_as_radio)
-XEN_NARGIFY_2(gxg_gtk_entry_set_completion_w, gxg_gtk_entry_set_completion)
-XEN_NARGIFY_1(gxg_gtk_entry_get_completion_w, gxg_gtk_entry_get_completion)
-XEN_NARGIFY_1(gxg_gtk_event_box_get_visible_window_w, gxg_gtk_event_box_get_visible_window)
-XEN_NARGIFY_2(gxg_gtk_event_box_set_visible_window_w, gxg_gtk_event_box_set_visible_window)
-XEN_NARGIFY_1(gxg_gtk_event_box_get_above_child_w, gxg_gtk_event_box_get_above_child)
-XEN_NARGIFY_2(gxg_gtk_event_box_set_above_child_w, gxg_gtk_event_box_set_above_child)
-XEN_NARGIFY_1(gxg_gtk_icon_source_get_icon_name_w, gxg_gtk_icon_source_get_icon_name)
-XEN_NARGIFY_6(gxg_gtk_menu_attach_w, gxg_gtk_menu_attach)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_select_range_w, gxg_gtk_text_buffer_select_range)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_overwrite_w, gxg_gtk_text_view_set_overwrite)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_overwrite_w, gxg_gtk_text_view_get_overwrite)
-XEN_NARGIFY_2(gxg_gtk_text_view_set_accepts_tab_w, gxg_gtk_text_view_set_accepts_tab)
-XEN_NARGIFY_1(gxg_gtk_text_view_get_accepts_tab_w, gxg_gtk_text_view_get_accepts_tab)
-XEN_NARGIFY_3(gxg_gtk_toolbar_insert_w, gxg_gtk_toolbar_insert)
-XEN_NARGIFY_2(gxg_gtk_toolbar_get_item_index_w, gxg_gtk_toolbar_get_item_index)
-XEN_NARGIFY_1(gxg_gtk_toolbar_get_n_items_w, gxg_gtk_toolbar_get_n_items)
-XEN_NARGIFY_2(gxg_gtk_toolbar_get_nth_item_w, gxg_gtk_toolbar_get_nth_item)
-XEN_NARGIFY_2(gxg_gtk_toolbar_set_show_arrow_w, gxg_gtk_toolbar_set_show_arrow)
-XEN_NARGIFY_1(gxg_gtk_toolbar_get_show_arrow_w, gxg_gtk_toolbar_get_show_arrow)
-XEN_NARGIFY_1(gxg_gtk_toolbar_get_relief_style_w, gxg_gtk_toolbar_get_relief_style)
-XEN_NARGIFY_3(gxg_gtk_toolbar_get_drop_index_w, gxg_gtk_toolbar_get_drop_index)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_set_expand_w, gxg_gtk_tree_view_column_set_expand)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_expand_w, gxg_gtk_tree_view_column_get_expand)
-XEN_NARGIFY_2(gxg_gtk_widget_set_no_show_all_w, gxg_gtk_widget_set_no_show_all)
-XEN_NARGIFY_1(gxg_gtk_widget_get_no_show_all_w, gxg_gtk_widget_get_no_show_all)
-XEN_NARGIFY_1(gxg_gtk_widget_queue_resize_no_redraw_w, gxg_gtk_widget_queue_resize_no_redraw)
-XEN_NARGIFY_1(gxg_gtk_window_set_default_icon_w, gxg_gtk_window_set_default_icon)
-XEN_NARGIFY_2(gxg_gtk_window_set_keep_above_w, gxg_gtk_window_set_keep_above)
-XEN_NARGIFY_2(gxg_gtk_window_set_keep_below_w, gxg_gtk_window_set_keep_below)
-XEN_ARGIFY_4(gxg_gtk_file_chooser_dialog_new_w, gxg_gtk_file_chooser_dialog_new)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_widget_new_w, gxg_gtk_file_chooser_widget_new)
-XEN_NARGIFY_2(gxg_gtk_tree_model_filter_new_w, gxg_gtk_tree_model_filter_new)
-XEN_NARGIFY_2(gxg_gtk_tree_model_filter_set_visible_column_w, gxg_gtk_tree_model_filter_set_visible_column)
-XEN_NARGIFY_1(gxg_gtk_tree_model_filter_get_model_w, gxg_gtk_tree_model_filter_get_model)
-XEN_NARGIFY_3(gxg_gtk_tree_model_filter_convert_iter_to_child_iter_w, gxg_gtk_tree_model_filter_convert_iter_to_child_iter)
-XEN_NARGIFY_2(gxg_gtk_tree_model_filter_convert_child_path_to_path_w, gxg_gtk_tree_model_filter_convert_child_path_to_path)
-XEN_NARGIFY_2(gxg_gtk_tree_model_filter_convert_path_to_child_path_w, gxg_gtk_tree_model_filter_convert_path_to_child_path)
-XEN_NARGIFY_1(gxg_gtk_tree_model_filter_refilter_w, gxg_gtk_tree_model_filter_refilter)
-XEN_NARGIFY_1(gxg_gtk_tree_model_filter_clear_cache_w, gxg_gtk_tree_model_filter_clear_cache)
-XEN_NARGIFY_1(gxg_gtk_action_get_name_w, gxg_gtk_action_get_name)
-XEN_NARGIFY_1(gxg_gtk_action_activate_w, gxg_gtk_action_activate)
-XEN_NARGIFY_2(gxg_gtk_action_create_icon_w, gxg_gtk_action_create_icon)
-XEN_NARGIFY_1(gxg_gtk_action_create_menu_item_w, gxg_gtk_action_create_menu_item)
-XEN_NARGIFY_1(gxg_gtk_action_create_tool_item_w, gxg_gtk_action_create_tool_item)
-XEN_NARGIFY_1(gxg_gtk_action_get_proxies_w, gxg_gtk_action_get_proxies)
-XEN_NARGIFY_1(gxg_gtk_action_connect_accelerator_w, gxg_gtk_action_connect_accelerator)
-XEN_NARGIFY_1(gxg_gtk_action_disconnect_accelerator_w, gxg_gtk_action_disconnect_accelerator)
-XEN_NARGIFY_1(gxg_gtk_action_group_new_w, gxg_gtk_action_group_new)
-XEN_NARGIFY_1(gxg_gtk_action_group_get_name_w, gxg_gtk_action_group_get_name)
-XEN_NARGIFY_2(gxg_gtk_action_group_get_action_w, gxg_gtk_action_group_get_action)
-XEN_NARGIFY_1(gxg_gtk_action_group_list_actions_w, gxg_gtk_action_group_list_actions)
-XEN_NARGIFY_2(gxg_gtk_action_group_add_action_w, gxg_gtk_action_group_add_action)
-XEN_NARGIFY_2(gxg_gtk_action_group_remove_action_w, gxg_gtk_action_group_remove_action)
-XEN_NARGIFY_4(gxg_gtk_action_group_add_actions_w, gxg_gtk_action_group_add_actions)
-XEN_NARGIFY_4(gxg_gtk_action_group_add_toggle_actions_w, gxg_gtk_action_group_add_toggle_actions)
-XEN_NARGIFY_5(gxg_gtk_action_group_add_toggle_actions_full_w, gxg_gtk_action_group_add_toggle_actions_full)
-XEN_NARGIFY_2(gxg_gtk_action_group_set_translation_domain_w, gxg_gtk_action_group_set_translation_domain)
-XEN_NARGIFY_0(gxg_gtk_combo_box_new_w, gxg_gtk_combo_box_new)
-XEN_NARGIFY_1(gxg_gtk_combo_box_new_with_model_w, gxg_gtk_combo_box_new_with_model)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_model_w, gxg_gtk_combo_box_set_model)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_wrap_width_w, gxg_gtk_combo_box_set_wrap_width)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_row_span_column_w, gxg_gtk_combo_box_set_row_span_column)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_column_span_column_w, gxg_gtk_combo_box_set_column_span_column)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_active_w, gxg_gtk_combo_box_get_active)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_active_w, gxg_gtk_combo_box_set_active)
-XEN_NARGIFY_2(gxg_gtk_combo_box_get_active_iter_w, gxg_gtk_combo_box_get_active_iter)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_active_iter_w, gxg_gtk_combo_box_set_active_iter)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_model_w, gxg_gtk_combo_box_get_model)
-XEN_NARGIFY_1(gxg_gtk_expander_new_w, gxg_gtk_expander_new)
-XEN_NARGIFY_1(gxg_gtk_expander_new_with_mnemonic_w, gxg_gtk_expander_new_with_mnemonic)
-XEN_NARGIFY_2(gxg_gtk_expander_set_expanded_w, gxg_gtk_expander_set_expanded)
-XEN_NARGIFY_1(gxg_gtk_expander_get_expanded_w, gxg_gtk_expander_get_expanded)
-XEN_NARGIFY_2(gxg_gtk_expander_set_spacing_w, gxg_gtk_expander_set_spacing)
-XEN_NARGIFY_1(gxg_gtk_expander_get_spacing_w, gxg_gtk_expander_get_spacing)
-XEN_NARGIFY_2(gxg_gtk_expander_set_label_w, gxg_gtk_expander_set_label)
-XEN_NARGIFY_1(gxg_gtk_expander_get_label_w, gxg_gtk_expander_get_label)
-XEN_NARGIFY_2(gxg_gtk_expander_set_use_underline_w, gxg_gtk_expander_set_use_underline)
-XEN_NARGIFY_1(gxg_gtk_expander_get_use_underline_w, gxg_gtk_expander_get_use_underline)
-XEN_NARGIFY_2(gxg_gtk_expander_set_label_widget_w, gxg_gtk_expander_set_label_widget)
-XEN_NARGIFY_1(gxg_gtk_expander_get_label_widget_w, gxg_gtk_expander_get_label_widget)
-XEN_NARGIFY_2(gxg_gtk_expander_set_use_markup_w, gxg_gtk_expander_set_use_markup)
-XEN_NARGIFY_1(gxg_gtk_expander_get_use_markup_w, gxg_gtk_expander_get_use_markup)
-XEN_NARGIFY_0(gxg_gtk_font_button_new_w, gxg_gtk_font_button_new)
-XEN_NARGIFY_1(gxg_gtk_font_button_new_with_font_w, gxg_gtk_font_button_new_with_font)
-XEN_NARGIFY_1(gxg_gtk_font_button_get_title_w, gxg_gtk_font_button_get_title)
-XEN_NARGIFY_2(gxg_gtk_font_button_set_title_w, gxg_gtk_font_button_set_title)
-XEN_NARGIFY_1(gxg_gtk_font_button_get_use_font_w, gxg_gtk_font_button_get_use_font)
-XEN_NARGIFY_2(gxg_gtk_font_button_set_use_font_w, gxg_gtk_font_button_set_use_font)
-XEN_NARGIFY_1(gxg_gtk_font_button_get_use_size_w, gxg_gtk_font_button_get_use_size)
-XEN_NARGIFY_2(gxg_gtk_font_button_set_use_size_w, gxg_gtk_font_button_set_use_size)
-XEN_NARGIFY_1(gxg_gtk_font_button_get_font_name_w, gxg_gtk_font_button_get_font_name)
-XEN_NARGIFY_2(gxg_gtk_font_button_set_font_name_w, gxg_gtk_font_button_set_font_name)
-XEN_NARGIFY_1(gxg_gtk_font_button_get_show_style_w, gxg_gtk_font_button_get_show_style)
-XEN_NARGIFY_2(gxg_gtk_font_button_set_show_style_w, gxg_gtk_font_button_set_show_style)
-XEN_NARGIFY_1(gxg_gtk_font_button_get_show_size_w, gxg_gtk_font_button_get_show_size)
-XEN_NARGIFY_2(gxg_gtk_font_button_set_show_size_w, gxg_gtk_font_button_set_show_size)
-XEN_NARGIFY_0(gxg_gtk_color_button_new_w, gxg_gtk_color_button_new)
-XEN_NARGIFY_1(gxg_gtk_color_button_new_with_color_w, gxg_gtk_color_button_new_with_color)
-XEN_NARGIFY_2(gxg_gtk_color_button_set_color_w, gxg_gtk_color_button_set_color)
-XEN_NARGIFY_2(gxg_gtk_color_button_set_alpha_w, gxg_gtk_color_button_set_alpha)
-XEN_NARGIFY_2(gxg_gtk_color_button_get_color_w, gxg_gtk_color_button_get_color)
-XEN_NARGIFY_1(gxg_gtk_color_button_get_alpha_w, gxg_gtk_color_button_get_alpha)
-XEN_NARGIFY_2(gxg_gtk_color_button_set_use_alpha_w, gxg_gtk_color_button_set_use_alpha)
-XEN_NARGIFY_1(gxg_gtk_color_button_get_use_alpha_w, gxg_gtk_color_button_get_use_alpha)
-XEN_NARGIFY_2(gxg_gtk_color_button_set_title_w, gxg_gtk_color_button_set_title)
-XEN_NARGIFY_1(gxg_gtk_color_button_get_title_w, gxg_gtk_color_button_get_title)
-XEN_NARGIFY_0(gxg_gtk_entry_completion_new_w, gxg_gtk_entry_completion_new)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_entry_w, gxg_gtk_entry_completion_get_entry)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_set_model_w, gxg_gtk_entry_completion_set_model)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_model_w, gxg_gtk_entry_completion_get_model)
-XEN_NARGIFY_4(gxg_gtk_entry_completion_set_match_func_w, gxg_gtk_entry_completion_set_match_func)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_set_minimum_key_length_w, gxg_gtk_entry_completion_set_minimum_key_length)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_minimum_key_length_w, gxg_gtk_entry_completion_get_minimum_key_length)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_complete_w, gxg_gtk_entry_completion_complete)
-XEN_NARGIFY_3(gxg_gtk_entry_completion_insert_action_text_w, gxg_gtk_entry_completion_insert_action_text)
-XEN_NARGIFY_3(gxg_gtk_entry_completion_insert_action_markup_w, gxg_gtk_entry_completion_insert_action_markup)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_delete_action_w, gxg_gtk_entry_completion_delete_action)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_set_text_column_w, gxg_gtk_entry_completion_set_text_column)
-XEN_NARGIFY_1(gxg_gtk_radio_tool_button_new_w, gxg_gtk_radio_tool_button_new)
-XEN_NARGIFY_2(gxg_gtk_radio_tool_button_new_from_stock_w, gxg_gtk_radio_tool_button_new_from_stock)
-XEN_NARGIFY_1(gxg_gtk_radio_tool_button_new_from_widget_w, gxg_gtk_radio_tool_button_new_from_widget)
-XEN_NARGIFY_2(gxg_gtk_radio_tool_button_new_with_stock_from_widget_w, gxg_gtk_radio_tool_button_new_with_stock_from_widget)
-XEN_NARGIFY_1(gxg_gtk_radio_tool_button_get_group_w, gxg_gtk_radio_tool_button_get_group)
-XEN_NARGIFY_2(gxg_gtk_radio_tool_button_set_group_w, gxg_gtk_radio_tool_button_set_group)
-XEN_NARGIFY_1(gxg_gtk_radio_action_get_group_w, gxg_gtk_radio_action_get_group)
-XEN_NARGIFY_2(gxg_gtk_radio_action_set_group_w, gxg_gtk_radio_action_set_group)
-XEN_NARGIFY_1(gxg_gtk_radio_action_get_current_value_w, gxg_gtk_radio_action_get_current_value)
-XEN_NARGIFY_0(gxg_gtk_separator_tool_item_new_w, gxg_gtk_separator_tool_item_new)
-XEN_NARGIFY_1(gxg_gtk_separator_tool_item_get_draw_w, gxg_gtk_separator_tool_item_get_draw)
-XEN_NARGIFY_2(gxg_gtk_separator_tool_item_set_draw_w, gxg_gtk_separator_tool_item_set_draw)
-XEN_NARGIFY_1(gxg_gtk_toggle_action_toggled_w, gxg_gtk_toggle_action_toggled)
-XEN_NARGIFY_2(gxg_gtk_toggle_action_set_active_w, gxg_gtk_toggle_action_set_active)
-XEN_NARGIFY_1(gxg_gtk_toggle_action_get_active_w, gxg_gtk_toggle_action_get_active)
-XEN_NARGIFY_2(gxg_gtk_toggle_action_set_draw_as_radio_w, gxg_gtk_toggle_action_set_draw_as_radio)
-XEN_NARGIFY_1(gxg_gtk_toggle_action_get_draw_as_radio_w, gxg_gtk_toggle_action_get_draw_as_radio)
-XEN_NARGIFY_0(gxg_gtk_toggle_tool_button_new_w, gxg_gtk_toggle_tool_button_new)
-XEN_NARGIFY_1(gxg_gtk_toggle_tool_button_new_from_stock_w, gxg_gtk_toggle_tool_button_new_from_stock)
-XEN_NARGIFY_2(gxg_gtk_toggle_tool_button_set_active_w, gxg_gtk_toggle_tool_button_set_active)
-XEN_NARGIFY_1(gxg_gtk_toggle_tool_button_get_active_w, gxg_gtk_toggle_tool_button_get_active)
-XEN_NARGIFY_5(gxg_g_timeout_add_full_w, gxg_g_timeout_add_full)
-XEN_ARGIFY_3(gxg_g_timeout_add_w, gxg_g_timeout_add)
-XEN_ARGIFY_2(gxg_g_idle_add_w, gxg_g_idle_add)
-XEN_NARGIFY_4(gxg_g_idle_add_full_w, gxg_g_idle_add_full)
-XEN_NARGIFY_1(gxg_g_idle_remove_by_data_w, gxg_g_idle_remove_by_data)
-XEN_NARGIFY_1(gxg_g_source_remove_w, gxg_g_source_remove)
-XEN_NARGIFY_0(gxg_gtk_file_filter_new_w, gxg_gtk_file_filter_new)
-XEN_NARGIFY_2(gxg_gtk_file_filter_set_name_w, gxg_gtk_file_filter_set_name)
-XEN_NARGIFY_1(gxg_gtk_file_filter_get_name_w, gxg_gtk_file_filter_get_name)
-XEN_NARGIFY_2(gxg_gtk_file_filter_add_mime_type_w, gxg_gtk_file_filter_add_mime_type)
-XEN_NARGIFY_2(gxg_gtk_file_filter_add_pattern_w, gxg_gtk_file_filter_add_pattern)
-XEN_NARGIFY_5(gxg_gtk_file_filter_add_custom_w, gxg_gtk_file_filter_add_custom)
-XEN_NARGIFY_1(gxg_gtk_file_filter_get_needed_w, gxg_gtk_file_filter_get_needed)
-XEN_NARGIFY_2(gxg_gtk_file_filter_filter_w, gxg_gtk_file_filter_filter)
-XEN_NARGIFY_3(gxg_gtk_cell_layout_pack_start_w, gxg_gtk_cell_layout_pack_start)
-XEN_NARGIFY_3(gxg_gtk_cell_layout_pack_end_w, gxg_gtk_cell_layout_pack_end)
-XEN_NARGIFY_1(gxg_gtk_cell_layout_clear_w, gxg_gtk_cell_layout_clear)
-XEN_NARGIFY_3(gxg_gtk_cell_layout_set_attributes_w, gxg_gtk_cell_layout_set_attributes)
-XEN_NARGIFY_4(gxg_gtk_cell_layout_add_attribute_w, gxg_gtk_cell_layout_add_attribute)
-XEN_NARGIFY_5(gxg_gtk_cell_layout_set_cell_data_func_w, gxg_gtk_cell_layout_set_cell_data_func)
-XEN_NARGIFY_2(gxg_gtk_cell_layout_clear_attributes_w, gxg_gtk_cell_layout_clear_attributes)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_action_w, gxg_gtk_file_chooser_set_action)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_action_w, gxg_gtk_file_chooser_get_action)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_local_only_w, gxg_gtk_file_chooser_set_local_only)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_local_only_w, gxg_gtk_file_chooser_get_local_only)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_select_multiple_w, gxg_gtk_file_chooser_set_select_multiple)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_select_multiple_w, gxg_gtk_file_chooser_get_select_multiple)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_current_name_w, gxg_gtk_file_chooser_set_current_name)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_filename_w, gxg_gtk_file_chooser_get_filename)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_filename_w, gxg_gtk_file_chooser_set_filename)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_select_filename_w, gxg_gtk_file_chooser_select_filename)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_unselect_filename_w, gxg_gtk_file_chooser_unselect_filename)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_select_all_w, gxg_gtk_file_chooser_select_all)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_unselect_all_w, gxg_gtk_file_chooser_unselect_all)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_filenames_w, gxg_gtk_file_chooser_get_filenames)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_current_folder_w, gxg_gtk_file_chooser_set_current_folder)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_current_folder_w, gxg_gtk_file_chooser_get_current_folder)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_uri_w, gxg_gtk_file_chooser_get_uri)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_uri_w, gxg_gtk_file_chooser_set_uri)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_select_uri_w, gxg_gtk_file_chooser_select_uri)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_unselect_uri_w, gxg_gtk_file_chooser_unselect_uri)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_uris_w, gxg_gtk_file_chooser_get_uris)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_current_folder_uri_w, gxg_gtk_file_chooser_set_current_folder_uri)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_current_folder_uri_w, gxg_gtk_file_chooser_get_current_folder_uri)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_preview_widget_w, gxg_gtk_file_chooser_set_preview_widget)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_preview_widget_w, gxg_gtk_file_chooser_get_preview_widget)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_preview_widget_active_w, gxg_gtk_file_chooser_set_preview_widget_active)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_preview_widget_active_w, gxg_gtk_file_chooser_get_preview_widget_active)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_preview_filename_w, gxg_gtk_file_chooser_get_preview_filename)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_preview_uri_w, gxg_gtk_file_chooser_get_preview_uri)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_extra_widget_w, gxg_gtk_file_chooser_set_extra_widget)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_extra_widget_w, gxg_gtk_file_chooser_get_extra_widget)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_add_filter_w, gxg_gtk_file_chooser_add_filter)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_remove_filter_w, gxg_gtk_file_chooser_remove_filter)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_list_filters_w, gxg_gtk_file_chooser_list_filters)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_filter_w, gxg_gtk_file_chooser_set_filter)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_filter_w, gxg_gtk_file_chooser_get_filter)
-XEN_ARGIFY_3(gxg_gtk_file_chooser_add_shortcut_folder_w, gxg_gtk_file_chooser_add_shortcut_folder)
-XEN_ARGIFY_3(gxg_gtk_file_chooser_remove_shortcut_folder_w, gxg_gtk_file_chooser_remove_shortcut_folder)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_list_shortcut_folders_w, gxg_gtk_file_chooser_list_shortcut_folders)
-XEN_ARGIFY_3(gxg_gtk_file_chooser_add_shortcut_folder_uri_w, gxg_gtk_file_chooser_add_shortcut_folder_uri)
-XEN_ARGIFY_3(gxg_gtk_file_chooser_remove_shortcut_folder_uri_w, gxg_gtk_file_chooser_remove_shortcut_folder_uri)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_list_shortcut_folder_uris_w, gxg_gtk_file_chooser_list_shortcut_folder_uris)
-XEN_NARGIFY_0(gxg_gtk_icon_theme_new_w, gxg_gtk_icon_theme_new)
-XEN_NARGIFY_0(gxg_gtk_icon_theme_get_default_w, gxg_gtk_icon_theme_get_default)
-XEN_NARGIFY_1(gxg_gtk_icon_theme_get_for_screen_w, gxg_gtk_icon_theme_get_for_screen)
-XEN_NARGIFY_2(gxg_gtk_icon_theme_set_screen_w, gxg_gtk_icon_theme_set_screen)
-XEN_ARGIFY_3(gxg_gtk_icon_theme_get_search_path_w, gxg_gtk_icon_theme_get_search_path)
-XEN_NARGIFY_2(gxg_gtk_icon_theme_append_search_path_w, gxg_gtk_icon_theme_append_search_path)
-XEN_NARGIFY_2(gxg_gtk_icon_theme_prepend_search_path_w, gxg_gtk_icon_theme_prepend_search_path)
-XEN_NARGIFY_2(gxg_gtk_icon_theme_set_custom_theme_w, gxg_gtk_icon_theme_set_custom_theme)
-XEN_NARGIFY_2(gxg_gtk_icon_theme_has_icon_w, gxg_gtk_icon_theme_has_icon)
-XEN_NARGIFY_4(gxg_gtk_icon_theme_lookup_icon_w, gxg_gtk_icon_theme_lookup_icon)
-XEN_ARGIFY_5(gxg_gtk_icon_theme_load_icon_w, gxg_gtk_icon_theme_load_icon)
-XEN_NARGIFY_2(gxg_gtk_icon_theme_list_icons_w, gxg_gtk_icon_theme_list_icons)
-XEN_NARGIFY_1(gxg_gtk_icon_theme_get_example_icon_name_w, gxg_gtk_icon_theme_get_example_icon_name)
-XEN_NARGIFY_1(gxg_gtk_icon_theme_rescan_if_needed_w, gxg_gtk_icon_theme_rescan_if_needed)
-XEN_NARGIFY_3(gxg_gtk_icon_theme_add_builtin_icon_w, gxg_gtk_icon_theme_add_builtin_icon)
-XEN_NARGIFY_1(gxg_gtk_icon_info_copy_w, gxg_gtk_icon_info_copy)
-XEN_NARGIFY_1(gxg_gtk_icon_info_free_w, gxg_gtk_icon_info_free)
-XEN_NARGIFY_1(gxg_gtk_icon_info_get_base_size_w, gxg_gtk_icon_info_get_base_size)
-XEN_NARGIFY_1(gxg_gtk_icon_info_get_filename_w, gxg_gtk_icon_info_get_filename)
-XEN_NARGIFY_1(gxg_gtk_icon_info_get_builtin_pixbuf_w, gxg_gtk_icon_info_get_builtin_pixbuf)
-XEN_ARGIFY_2(gxg_gtk_icon_info_load_icon_w, gxg_gtk_icon_info_load_icon)
-XEN_NARGIFY_2(gxg_gtk_icon_info_set_raw_coordinates_w, gxg_gtk_icon_info_set_raw_coordinates)
-XEN_NARGIFY_2(gxg_gtk_icon_info_get_embedded_rect_w, gxg_gtk_icon_info_get_embedded_rect)
-XEN_NARGIFY_1(gxg_gtk_icon_info_get_display_name_w, gxg_gtk_icon_info_get_display_name)
-XEN_NARGIFY_2(gxg_gtk_tool_button_new_w, gxg_gtk_tool_button_new)
-XEN_NARGIFY_1(gxg_gtk_tool_button_new_from_stock_w, gxg_gtk_tool_button_new_from_stock)
-XEN_NARGIFY_2(gxg_gtk_tool_button_set_label_w, gxg_gtk_tool_button_set_label)
-XEN_NARGIFY_1(gxg_gtk_tool_button_get_label_w, gxg_gtk_tool_button_get_label)
-XEN_NARGIFY_2(gxg_gtk_tool_button_set_use_underline_w, gxg_gtk_tool_button_set_use_underline)
-XEN_NARGIFY_1(gxg_gtk_tool_button_get_use_underline_w, gxg_gtk_tool_button_get_use_underline)
-XEN_NARGIFY_2(gxg_gtk_tool_button_set_stock_id_w, gxg_gtk_tool_button_set_stock_id)
-XEN_NARGIFY_1(gxg_gtk_tool_button_get_stock_id_w, gxg_gtk_tool_button_get_stock_id)
-XEN_NARGIFY_2(gxg_gtk_tool_button_set_icon_widget_w, gxg_gtk_tool_button_set_icon_widget)
-XEN_NARGIFY_1(gxg_gtk_tool_button_get_icon_widget_w, gxg_gtk_tool_button_get_icon_widget)
-XEN_NARGIFY_2(gxg_gtk_tool_button_set_label_widget_w, gxg_gtk_tool_button_set_label_widget)
-XEN_NARGIFY_1(gxg_gtk_tool_button_get_label_widget_w, gxg_gtk_tool_button_get_label_widget)
-XEN_NARGIFY_0(gxg_gtk_tool_item_new_w, gxg_gtk_tool_item_new)
-XEN_NARGIFY_2(gxg_gtk_tool_item_set_homogeneous_w, gxg_gtk_tool_item_set_homogeneous)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_homogeneous_w, gxg_gtk_tool_item_get_homogeneous)
-XEN_NARGIFY_2(gxg_gtk_tool_item_set_expand_w, gxg_gtk_tool_item_set_expand)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_expand_w, gxg_gtk_tool_item_get_expand)
-XEN_NARGIFY_2(gxg_gtk_tool_item_set_use_drag_window_w, gxg_gtk_tool_item_set_use_drag_window)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_use_drag_window_w, gxg_gtk_tool_item_get_use_drag_window)
-XEN_NARGIFY_2(gxg_gtk_tool_item_set_visible_horizontal_w, gxg_gtk_tool_item_set_visible_horizontal)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_visible_horizontal_w, gxg_gtk_tool_item_get_visible_horizontal)
-XEN_NARGIFY_2(gxg_gtk_tool_item_set_visible_vertical_w, gxg_gtk_tool_item_set_visible_vertical)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_visible_vertical_w, gxg_gtk_tool_item_get_visible_vertical)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_is_important_w, gxg_gtk_tool_item_get_is_important)
-XEN_NARGIFY_2(gxg_gtk_tool_item_set_is_important_w, gxg_gtk_tool_item_set_is_important)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_icon_size_w, gxg_gtk_tool_item_get_icon_size)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_orientation_w, gxg_gtk_tool_item_get_orientation)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_toolbar_style_w, gxg_gtk_tool_item_get_toolbar_style)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_relief_style_w, gxg_gtk_tool_item_get_relief_style)
-XEN_NARGIFY_1(gxg_gtk_tool_item_retrieve_proxy_menu_item_w, gxg_gtk_tool_item_retrieve_proxy_menu_item)
-XEN_NARGIFY_2(gxg_gtk_tool_item_get_proxy_menu_item_w, gxg_gtk_tool_item_get_proxy_menu_item)
-XEN_NARGIFY_3(gxg_gtk_tool_item_set_proxy_menu_item_w, gxg_gtk_tool_item_set_proxy_menu_item)
-XEN_NARGIFY_2(gxg_gtk_list_store_remove_w, gxg_gtk_list_store_remove)
-XEN_NARGIFY_2(gxg_gdk_display_set_double_click_distance_w, gxg_gdk_display_set_double_click_distance)
-XEN_NARGIFY_1(gxg_gdk_display_get_default_group_w, gxg_gdk_display_get_default_group)
-XEN_NARGIFY_1(gxg_gdk_window_get_group_w, gxg_gdk_window_get_group)
-XEN_NARGIFY_1(gxg_gtk_action_group_get_sensitive_w, gxg_gtk_action_group_get_sensitive)
-XEN_NARGIFY_2(gxg_gtk_action_group_set_sensitive_w, gxg_gtk_action_group_set_sensitive)
-XEN_NARGIFY_1(gxg_gtk_action_group_get_visible_w, gxg_gtk_action_group_get_visible)
-XEN_NARGIFY_2(gxg_gtk_action_group_set_visible_w, gxg_gtk_action_group_set_visible)
-XEN_NARGIFY_3(gxg_gtk_action_group_add_action_with_accel_w, gxg_gtk_action_group_add_action_with_accel)
-XEN_NARGIFY_4(gxg_gtk_action_new_w, gxg_gtk_action_new)
-XEN_NARGIFY_1(gxg_gtk_action_is_sensitive_w, gxg_gtk_action_is_sensitive)
-XEN_NARGIFY_1(gxg_gtk_action_get_sensitive_w, gxg_gtk_action_get_sensitive)
-XEN_NARGIFY_1(gxg_gtk_action_is_visible_w, gxg_gtk_action_is_visible)
-XEN_NARGIFY_1(gxg_gtk_action_get_visible_w, gxg_gtk_action_get_visible)
-XEN_NARGIFY_3(gxg_gtk_button_set_alignment_w, gxg_gtk_button_set_alignment)
-XEN_ARGIFY_3(gxg_gtk_button_get_alignment_w, gxg_gtk_button_get_alignment)
-XEN_NARGIFY_3(gxg_gtk_cell_layout_reorder_w, gxg_gtk_cell_layout_reorder)
-XEN_ARGIFY_3(gxg_gtk_clipboard_request_targets_w, gxg_gtk_clipboard_request_targets)
-XEN_ARGIFY_3(gxg_gtk_clipboard_wait_for_targets_w, gxg_gtk_clipboard_wait_for_targets)
-XEN_NARGIFY_1(gxg_gtk_menu_shell_cancel_w, gxg_gtk_menu_shell_cancel)
-XEN_NARGIFY_1(gxg_gtk_paned_get_child1_w, gxg_gtk_paned_get_child1)
-XEN_NARGIFY_1(gxg_gtk_paned_get_child2_w, gxg_gtk_paned_get_child2)
-XEN_NARGIFY_5(gxg_gtk_radio_action_new_w, gxg_gtk_radio_action_new)
-XEN_NARGIFY_4(gxg_gtk_toggle_action_new_w, gxg_gtk_toggle_action_new)
-XEN_NARGIFY_2(gxg_gtk_window_set_accept_focus_w, gxg_gtk_window_set_accept_focus)
-XEN_NARGIFY_1(gxg_gtk_window_get_accept_focus_w, gxg_gtk_window_get_accept_focus)
-XEN_NARGIFY_2(gxg_g_list_nth_data_w, gxg_g_list_nth_data)
-XEN_NARGIFY_0(gxg_gtk_accel_map_get_w, gxg_gtk_accel_map_get)
-XEN_NARGIFY_1(gxg_gtk_combo_box_popup_w, gxg_gtk_combo_box_popup)
-XEN_NARGIFY_1(gxg_gtk_combo_box_popdown_w, gxg_gtk_combo_box_popdown)
-XEN_NARGIFY_1(gxg_gtk_radio_menu_item_new_from_widget_w, gxg_gtk_radio_menu_item_new_from_widget)
-XEN_NARGIFY_2(gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget_w, gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget)
-XEN_NARGIFY_2(gxg_gtk_radio_menu_item_new_with_label_from_widget_w, gxg_gtk_radio_menu_item_new_with_label_from_widget)
-XEN_NARGIFY_1(gxg_gtk_scale_get_layout_w, gxg_gtk_scale_get_layout)
-XEN_ARGIFY_3(gxg_gtk_scale_get_layout_offsets_w, gxg_gtk_scale_get_layout_offsets)
-XEN_NARGIFY_1(gxg_gtk_drag_source_get_target_list_w, gxg_gtk_drag_source_get_target_list)
-XEN_NARGIFY_2(gxg_gtk_drag_source_set_target_list_w, gxg_gtk_drag_source_set_target_list)
-XEN_NARGIFY_2(gxg_gtk_entry_set_alignment_w, gxg_gtk_entry_set_alignment)
-XEN_NARGIFY_1(gxg_gtk_entry_get_alignment_w, gxg_gtk_entry_get_alignment)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_use_preview_label_w, gxg_gtk_file_chooser_set_use_preview_label)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_use_preview_label_w, gxg_gtk_file_chooser_get_use_preview_label)
-XEN_NARGIFY_1(gxg_gtk_widget_list_mnemonic_labels_w, gxg_gtk_widget_list_mnemonic_labels)
-XEN_NARGIFY_2(gxg_gtk_widget_add_mnemonic_label_w, gxg_gtk_widget_add_mnemonic_label)
-XEN_NARGIFY_2(gxg_gtk_widget_remove_mnemonic_label_w, gxg_gtk_widget_remove_mnemonic_label)
-XEN_NARGIFY_2(gxg_gtk_window_activate_key_w, gxg_gtk_window_activate_key)
-XEN_NARGIFY_2(gxg_gtk_window_propagate_key_event_w, gxg_gtk_window_propagate_key_event)
-XEN_NARGIFY_1(gxg_g_quark_from_string_w, gxg_g_quark_from_string)
-XEN_NARGIFY_1(gxg_g_quark_to_string_w, gxg_g_quark_to_string)
-XEN_NARGIFY_0(gxg_gtk_cell_view_new_w, gxg_gtk_cell_view_new)
-XEN_NARGIFY_1(gxg_gtk_cell_view_new_with_text_w, gxg_gtk_cell_view_new_with_text)
-XEN_NARGIFY_1(gxg_gtk_cell_view_new_with_markup_w, gxg_gtk_cell_view_new_with_markup)
-XEN_NARGIFY_1(gxg_gtk_cell_view_new_with_pixbuf_w, gxg_gtk_cell_view_new_with_pixbuf)
-XEN_NARGIFY_2(gxg_gtk_cell_view_set_model_w, gxg_gtk_cell_view_set_model)
-XEN_NARGIFY_2(gxg_gtk_cell_view_set_displayed_row_w, gxg_gtk_cell_view_set_displayed_row)
-XEN_NARGIFY_1(gxg_gtk_cell_view_get_displayed_row_w, gxg_gtk_cell_view_get_displayed_row)
-XEN_NARGIFY_2(gxg_gtk_cell_view_set_background_color_w, gxg_gtk_cell_view_set_background_color)
-XEN_NARGIFY_1(gxg_gdk_window_enable_synchronized_configure_w, gxg_gdk_window_enable_synchronized_configure)
-XEN_NARGIFY_1(gxg_gdk_window_configure_finished_w, gxg_gdk_window_configure_finished)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_wrap_width_w, gxg_gtk_combo_box_get_wrap_width)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_row_span_column_w, gxg_gtk_combo_box_get_row_span_column)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_column_span_column_w, gxg_gtk_combo_box_get_column_span_column)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_add_tearoffs_w, gxg_gtk_combo_box_get_add_tearoffs)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_add_tearoffs_w, gxg_gtk_combo_box_set_add_tearoffs)
-XEN_NARGIFY_1(gxg_gtk_drag_dest_add_text_targets_w, gxg_gtk_drag_dest_add_text_targets)
-XEN_NARGIFY_1(gxg_gtk_drag_source_add_text_targets_w, gxg_gtk_drag_source_add_text_targets)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_insert_prefix_w, gxg_gtk_entry_completion_insert_prefix)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_set_inline_completion_w, gxg_gtk_entry_completion_set_inline_completion)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_inline_completion_w, gxg_gtk_entry_completion_get_inline_completion)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_set_popup_completion_w, gxg_gtk_entry_completion_set_popup_completion)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_popup_completion_w, gxg_gtk_entry_completion_get_popup_completion)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_text_column_w, gxg_gtk_entry_completion_get_text_column)
-XEN_NARGIFY_2(gxg_gtk_icon_theme_get_icon_sizes_w, gxg_gtk_icon_theme_get_icon_sizes)
-XEN_NARGIFY_1(gxg_gtk_menu_get_for_attach_widget_w, gxg_gtk_menu_get_for_attach_widget)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_fixed_height_mode_w, gxg_gtk_tree_view_set_fixed_height_mode)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_fixed_height_mode_w, gxg_gtk_tree_view_get_fixed_height_mode)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_hover_selection_w, gxg_gtk_tree_view_set_hover_selection)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_hover_selection_w, gxg_gtk_tree_view_get_hover_selection)
-XEN_NARGIFY_4(gxg_gtk_tree_view_set_row_separator_func_w, gxg_gtk_tree_view_set_row_separator_func)
-XEN_NARGIFY_2(gxg_gtk_window_set_focus_on_map_w, gxg_gtk_window_set_focus_on_map)
-XEN_NARGIFY_1(gxg_gtk_window_get_focus_on_map_w, gxg_gtk_window_get_focus_on_map)
-XEN_NARGIFY_2(gxg_gtk_window_set_icon_name_w, gxg_gtk_window_set_icon_name)
-XEN_NARGIFY_1(gxg_gtk_window_get_icon_name_w, gxg_gtk_window_get_icon_name)
-XEN_NARGIFY_1(gxg_gtk_window_set_default_icon_name_w, gxg_gtk_window_set_default_icon_name)
-XEN_NARGIFY_0(gxg_gtk_about_dialog_new_w, gxg_gtk_about_dialog_new)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_version_w, gxg_gtk_about_dialog_get_version)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_version_w, gxg_gtk_about_dialog_set_version)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_copyright_w, gxg_gtk_about_dialog_get_copyright)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_copyright_w, gxg_gtk_about_dialog_set_copyright)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_comments_w, gxg_gtk_about_dialog_get_comments)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_comments_w, gxg_gtk_about_dialog_set_comments)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_license_w, gxg_gtk_about_dialog_get_license)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_license_w, gxg_gtk_about_dialog_set_license)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_website_w, gxg_gtk_about_dialog_get_website)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_website_w, gxg_gtk_about_dialog_set_website)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_website_label_w, gxg_gtk_about_dialog_get_website_label)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_website_label_w, gxg_gtk_about_dialog_set_website_label)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_authors_w, gxg_gtk_about_dialog_get_authors)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_authors_w, gxg_gtk_about_dialog_set_authors)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_documenters_w, gxg_gtk_about_dialog_get_documenters)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_documenters_w, gxg_gtk_about_dialog_set_documenters)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_artists_w, gxg_gtk_about_dialog_get_artists)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_artists_w, gxg_gtk_about_dialog_set_artists)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_translator_credits_w, gxg_gtk_about_dialog_get_translator_credits)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_translator_credits_w, gxg_gtk_about_dialog_set_translator_credits)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_logo_w, gxg_gtk_about_dialog_get_logo)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_logo_w, gxg_gtk_about_dialog_set_logo)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_program_name_w, gxg_gtk_about_dialog_get_program_name)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_program_name_w, gxg_gtk_about_dialog_set_program_name)
-XEN_NARGIFY_0(gxg_gtk_icon_view_new_w, gxg_gtk_icon_view_new)
-XEN_NARGIFY_1(gxg_gtk_icon_view_new_with_model_w, gxg_gtk_icon_view_new_with_model)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_model_w, gxg_gtk_icon_view_set_model)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_model_w, gxg_gtk_icon_view_get_model)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_text_column_w, gxg_gtk_icon_view_set_text_column)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_text_column_w, gxg_gtk_icon_view_get_text_column)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_markup_column_w, gxg_gtk_icon_view_set_markup_column)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_markup_column_w, gxg_gtk_icon_view_get_markup_column)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_pixbuf_column_w, gxg_gtk_icon_view_set_pixbuf_column)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_pixbuf_column_w, gxg_gtk_icon_view_get_pixbuf_column)
-XEN_NARGIFY_3(gxg_gtk_icon_view_get_path_at_pos_w, gxg_gtk_icon_view_get_path_at_pos)
-XEN_ARGIFY_3(gxg_gtk_icon_view_selected_foreach_w, gxg_gtk_icon_view_selected_foreach)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_selection_mode_w, gxg_gtk_icon_view_set_selection_mode)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_selection_mode_w, gxg_gtk_icon_view_get_selection_mode)
-XEN_NARGIFY_2(gxg_gtk_icon_view_select_path_w, gxg_gtk_icon_view_select_path)
-XEN_NARGIFY_2(gxg_gtk_icon_view_unselect_path_w, gxg_gtk_icon_view_unselect_path)
-XEN_NARGIFY_2(gxg_gtk_icon_view_path_is_selected_w, gxg_gtk_icon_view_path_is_selected)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_selected_items_w, gxg_gtk_icon_view_get_selected_items)
-XEN_NARGIFY_1(gxg_gtk_icon_view_select_all_w, gxg_gtk_icon_view_select_all)
-XEN_NARGIFY_1(gxg_gtk_icon_view_unselect_all_w, gxg_gtk_icon_view_unselect_all)
-XEN_NARGIFY_2(gxg_gtk_icon_view_item_activated_w, gxg_gtk_icon_view_item_activated)
-XEN_NARGIFY_0(gxg_gtk_cell_renderer_combo_new_w, gxg_gtk_cell_renderer_combo_new)
-XEN_NARGIFY_0(gxg_gtk_cell_renderer_progress_new_w, gxg_gtk_cell_renderer_progress_new)
-XEN_NARGIFY_4(gxg_gtk_combo_box_set_row_separator_func_w, gxg_gtk_combo_box_set_row_separator_func)
-XEN_NARGIFY_2(gxg_gtk_label_set_ellipsize_w, gxg_gtk_label_set_ellipsize)
-XEN_NARGIFY_1(gxg_gtk_label_get_ellipsize_w, gxg_gtk_label_get_ellipsize)
-XEN_NARGIFY_1(gxg_pango_attr_fallback_new_w, gxg_pango_attr_fallback_new)
-XEN_NARGIFY_1(gxg_pango_attr_letter_spacing_new_w, gxg_pango_attr_letter_spacing_new)
-XEN_NARGIFY_3(gxg_pango_attr_list_filter_w, gxg_pango_attr_list_filter)
-XEN_NARGIFY_1(gxg_pango_attr_iterator_get_attrs_w, gxg_pango_attr_iterator_get_attrs)
-XEN_NARGIFY_1(gxg_pango_font_metrics_get_underline_position_w, gxg_pango_font_metrics_get_underline_position)
-XEN_NARGIFY_1(gxg_pango_font_metrics_get_underline_thickness_w, gxg_pango_font_metrics_get_underline_thickness)
-XEN_NARGIFY_1(gxg_pango_font_metrics_get_strikethrough_position_w, gxg_pango_font_metrics_get_strikethrough_position)
-XEN_NARGIFY_1(gxg_pango_font_metrics_get_strikethrough_thickness_w, gxg_pango_font_metrics_get_strikethrough_thickness)
-XEN_NARGIFY_1(gxg_pango_font_family_is_monospace_w, gxg_pango_font_family_is_monospace)
-XEN_ARGIFY_3(gxg_pango_font_face_list_sizes_w, gxg_pango_font_face_list_sizes)
-XEN_NARGIFY_2(gxg_pango_layout_set_auto_dir_w, gxg_pango_layout_set_auto_dir)
-XEN_NARGIFY_1(gxg_pango_layout_get_auto_dir_w, gxg_pango_layout_get_auto_dir)
-XEN_NARGIFY_1(gxg_pango_script_for_unichar_w, gxg_pango_script_for_unichar)
-XEN_NARGIFY_2(gxg_pango_script_iter_new_w, gxg_pango_script_iter_new)
-XEN_ARGIFY_4(gxg_pango_script_iter_get_range_w, gxg_pango_script_iter_get_range)
-XEN_NARGIFY_1(gxg_pango_script_iter_next_w, gxg_pango_script_iter_next)
-XEN_NARGIFY_1(gxg_pango_script_iter_free_w, gxg_pango_script_iter_free)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_button_new_with_dialog_w, gxg_gtk_file_chooser_button_new_with_dialog)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_button_get_title_w, gxg_gtk_file_chooser_button_get_title)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_button_set_title_w, gxg_gtk_file_chooser_button_set_title)
-XEN_NARGIFY_1(gxg_gdk_drag_drop_succeeded_w, gxg_gdk_drag_drop_succeeded)
-XEN_NARGIFY_2(gxg_gtk_action_set_sensitive_w, gxg_gtk_action_set_sensitive)
-XEN_NARGIFY_2(gxg_gtk_action_set_visible_w, gxg_gtk_action_set_visible)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_focus_on_click_w, gxg_gtk_combo_box_get_focus_on_click)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_focus_on_click_w, gxg_gtk_combo_box_set_focus_on_click)
-XEN_NARGIFY_2(gxg_gtk_entry_layout_index_to_text_index_w, gxg_gtk_entry_layout_index_to_text_index)
-XEN_NARGIFY_2(gxg_gtk_entry_text_index_to_layout_index_w, gxg_gtk_entry_text_index_to_layout_index)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_show_hidden_w, gxg_gtk_file_chooser_set_show_hidden)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_show_hidden_w, gxg_gtk_file_chooser_get_show_hidden)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_hover_expand_w, gxg_gtk_tree_view_set_hover_expand)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_hover_expand_w, gxg_gtk_tree_view_get_hover_expand)
-XEN_NARGIFY_1(gxg_gtk_tool_item_rebuild_menu_w, gxg_gtk_tool_item_rebuild_menu)
-XEN_NARGIFY_2(gxg_gtk_menu_tool_button_new_w, gxg_gtk_menu_tool_button_new)
-XEN_NARGIFY_1(gxg_gtk_menu_tool_button_new_from_stock_w, gxg_gtk_menu_tool_button_new_from_stock)
-XEN_NARGIFY_2(gxg_gtk_menu_tool_button_set_menu_w, gxg_gtk_menu_tool_button_set_menu)
-XEN_NARGIFY_1(gxg_gtk_menu_tool_button_get_menu_w, gxg_gtk_menu_tool_button_get_menu)
-XEN_NARGIFY_1(gxg_gdk_display_supports_clipboard_persistence_w, gxg_gdk_display_supports_clipboard_persistence)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_logo_icon_name_w, gxg_gtk_about_dialog_get_logo_icon_name)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_logo_icon_name_w, gxg_gtk_about_dialog_set_logo_icon_name)
-XEN_NARGIFY_2(gxg_gtk_accelerator_get_label_w, gxg_gtk_accelerator_get_label)
-XEN_NARGIFY_2(gxg_gtk_clipboard_wait_is_target_available_w, gxg_gtk_clipboard_wait_is_target_available)
-XEN_NARGIFY_3(gxg_gtk_clipboard_set_can_store_w, gxg_gtk_clipboard_set_can_store)
-XEN_NARGIFY_1(gxg_gtk_clipboard_store_w, gxg_gtk_clipboard_store)
-XEN_NARGIFY_1(gxg_gtk_alternative_dialog_button_order_w, gxg_gtk_alternative_dialog_button_order)
-XEN_NARGIFY_1(gxg_gtk_drag_dest_add_image_targets_w, gxg_gtk_drag_dest_add_image_targets)
-XEN_NARGIFY_1(gxg_gtk_drag_dest_add_uri_targets_w, gxg_gtk_drag_dest_add_uri_targets)
-XEN_NARGIFY_1(gxg_gtk_drag_source_add_image_targets_w, gxg_gtk_drag_source_add_image_targets)
-XEN_NARGIFY_1(gxg_gtk_drag_source_add_uri_targets_w, gxg_gtk_drag_source_add_uri_targets)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_button_get_width_chars_w, gxg_gtk_file_chooser_button_get_width_chars)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_button_set_width_chars_w, gxg_gtk_file_chooser_button_set_width_chars)
-XEN_NARGIFY_2(gxg_gtk_image_new_from_icon_name_w, gxg_gtk_image_new_from_icon_name)
-XEN_NARGIFY_3(gxg_gtk_image_set_from_icon_name_w, gxg_gtk_image_set_from_icon_name)
-XEN_NARGIFY_2(gxg_gtk_image_set_pixel_size_w, gxg_gtk_image_set_pixel_size)
-XEN_NARGIFY_1(gxg_gtk_image_get_pixel_size_w, gxg_gtk_image_get_pixel_size)
-XEN_NARGIFY_2(gxg_gtk_label_set_width_chars_w, gxg_gtk_label_set_width_chars)
-XEN_NARGIFY_1(gxg_gtk_label_get_width_chars_w, gxg_gtk_label_get_width_chars)
-XEN_NARGIFY_2(gxg_gtk_target_list_add_text_targets_w, gxg_gtk_target_list_add_text_targets)
-XEN_NARGIFY_3(gxg_gtk_target_list_add_image_targets_w, gxg_gtk_target_list_add_image_targets)
-XEN_NARGIFY_2(gxg_gtk_target_list_add_uri_targets_w, gxg_gtk_target_list_add_uri_targets)
-XEN_NARGIFY_2(gxg_gtk_selection_data_set_pixbuf_w, gxg_gtk_selection_data_set_pixbuf)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_pixbuf_w, gxg_gtk_selection_data_get_pixbuf)
-XEN_NARGIFY_2(gxg_gtk_selection_data_set_uris_w, gxg_gtk_selection_data_set_uris)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_uris_w, gxg_gtk_selection_data_get_uris)
-XEN_NARGIFY_4(gxg_gtk_text_buffer_backspace_w, gxg_gtk_text_buffer_backspace)
-XEN_NARGIFY_2(gxg_gtk_clipboard_set_image_w, gxg_gtk_clipboard_set_image)
-XEN_ARGIFY_3(gxg_gtk_clipboard_request_image_w, gxg_gtk_clipboard_request_image)
-XEN_NARGIFY_1(gxg_gtk_clipboard_wait_for_image_w, gxg_gtk_clipboard_wait_for_image)
-XEN_NARGIFY_1(gxg_gtk_clipboard_wait_is_image_available_w, gxg_gtk_clipboard_wait_is_image_available)
-XEN_NARGIFY_1(gxg_gtk_file_filter_add_pixbuf_formats_w, gxg_gtk_file_filter_add_pixbuf_formats)
-XEN_NARGIFY_2(gxg_gtk_label_set_single_line_mode_w, gxg_gtk_label_set_single_line_mode)
-XEN_NARGIFY_1(gxg_gtk_label_get_single_line_mode_w, gxg_gtk_label_get_single_line_mode)
-XEN_NARGIFY_2(gxg_gtk_progress_bar_set_ellipsize_w, gxg_gtk_progress_bar_set_ellipsize)
-XEN_NARGIFY_1(gxg_gtk_progress_bar_get_ellipsize_w, gxg_gtk_progress_bar_get_ellipsize)
-XEN_NARGIFY_2(gxg_gtk_selection_data_targets_include_image_w, gxg_gtk_selection_data_targets_include_image)
-XEN_NARGIFY_2(gxg_gtk_button_set_image_w, gxg_gtk_button_set_image)
-XEN_NARGIFY_1(gxg_gtk_button_get_image_w, gxg_gtk_button_get_image)
-XEN_NARGIFY_3(gxg_gtk_dialog_set_alternative_button_order_from_array_w, gxg_gtk_dialog_set_alternative_button_order_from_array)
-XEN_NARGIFY_2(gxg_gtk_label_set_angle_w, gxg_gtk_label_set_angle)
-XEN_NARGIFY_1(gxg_gtk_label_get_angle_w, gxg_gtk_label_get_angle)
-XEN_NARGIFY_2(gxg_gtk_menu_set_screen_w, gxg_gtk_menu_set_screen)
-XEN_NARGIFY_3(gxg_pango_attr_underline_color_new_w, gxg_pango_attr_underline_color_new)
-XEN_NARGIFY_3(gxg_pango_attr_strikethrough_color_new_w, gxg_pango_attr_strikethrough_color_new)
-XEN_NARGIFY_4(gxg_pango_renderer_draw_layout_w, gxg_pango_renderer_draw_layout)
-XEN_NARGIFY_4(gxg_pango_renderer_draw_layout_line_w, gxg_pango_renderer_draw_layout_line)
-XEN_NARGIFY_5(gxg_pango_renderer_draw_glyphs_w, gxg_pango_renderer_draw_glyphs)
-XEN_NARGIFY_6(gxg_pango_renderer_draw_rectangle_w, gxg_pango_renderer_draw_rectangle)
-XEN_NARGIFY_5(gxg_pango_renderer_draw_error_underline_w, gxg_pango_renderer_draw_error_underline)
-XEN_NARGIFY_8(gxg_pango_renderer_draw_trapezoid_w, gxg_pango_renderer_draw_trapezoid)
-XEN_NARGIFY_5(gxg_pango_renderer_draw_glyph_w, gxg_pango_renderer_draw_glyph)
-XEN_NARGIFY_1(gxg_pango_renderer_activate_w, gxg_pango_renderer_activate)
-XEN_NARGIFY_1(gxg_pango_renderer_deactivate_w, gxg_pango_renderer_deactivate)
-XEN_NARGIFY_2(gxg_pango_renderer_part_changed_w, gxg_pango_renderer_part_changed)
-XEN_NARGIFY_3(gxg_pango_renderer_set_color_w, gxg_pango_renderer_set_color)
-XEN_NARGIFY_2(gxg_pango_renderer_get_color_w, gxg_pango_renderer_get_color)
-XEN_NARGIFY_2(gxg_pango_renderer_set_matrix_w, gxg_pango_renderer_set_matrix)
-XEN_ARGIFY_4(gxg_g_log_set_handler_w, gxg_g_log_set_handler)
-XEN_NARGIFY_2(gxg_g_log_remove_handler_w, gxg_g_log_remove_handler)
-XEN_NARGIFY_2(gxg_gtk_cell_renderer_stop_editing_w, gxg_gtk_cell_renderer_stop_editing)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_button_new_w, gxg_gtk_file_chooser_button_new)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_columns_w, gxg_gtk_icon_view_set_columns)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_columns_w, gxg_gtk_icon_view_get_columns)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_item_width_w, gxg_gtk_icon_view_set_item_width)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_item_width_w, gxg_gtk_icon_view_get_item_width)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_spacing_w, gxg_gtk_icon_view_set_spacing)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_spacing_w, gxg_gtk_icon_view_get_spacing)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_row_spacing_w, gxg_gtk_icon_view_set_row_spacing)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_row_spacing_w, gxg_gtk_icon_view_get_row_spacing)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_column_spacing_w, gxg_gtk_icon_view_set_column_spacing)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_column_spacing_w, gxg_gtk_icon_view_get_column_spacing)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_margin_w, gxg_gtk_icon_view_set_margin)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_margin_w, gxg_gtk_icon_view_get_margin)
-XEN_NARGIFY_2(gxg_gtk_label_set_max_width_chars_w, gxg_gtk_label_set_max_width_chars)
-XEN_NARGIFY_1(gxg_gtk_label_get_max_width_chars_w, gxg_gtk_label_get_max_width_chars)
-XEN_NARGIFY_3(gxg_gtk_list_store_insert_with_values_w, gxg_gtk_list_store_insert_with_values)
-XEN_NARGIFY_6(gxg_gtk_list_store_insert_with_valuesv_w, gxg_gtk_list_store_insert_with_valuesv)
-XEN_ARGIFY_5(gxg_gtk_text_view_get_iter_at_position_w, gxg_gtk_text_view_get_iter_at_position)
-XEN_NARGIFY_1(gxg_pango_attr_size_new_absolute_w, gxg_pango_attr_size_new_absolute)
-XEN_NARGIFY_2(gxg_pango_font_description_set_absolute_size_w, gxg_pango_font_description_set_absolute_size)
-XEN_NARGIFY_1(gxg_pango_layout_get_font_description_w, gxg_pango_layout_get_font_description)
-XEN_NARGIFY_2(gxg_gdk_cursor_new_from_name_w, gxg_gdk_cursor_new_from_name)
-XEN_NARGIFY_1(gxg_gdk_cursor_get_image_w, gxg_gdk_cursor_get_image)
-XEN_NARGIFY_1(gxg_gdk_screen_get_rgba_visual_w, gxg_gdk_screen_get_rgba_visual)
-XEN_NARGIFY_2(gxg_gdk_window_set_urgency_hint_w, gxg_gdk_window_set_urgency_hint)
-XEN_NARGIFY_1(gxg_gtk_action_get_accel_closure_w, gxg_gtk_action_get_accel_closure)
-XEN_NARGIFY_2(gxg_gtk_dialog_get_response_for_widget_w, gxg_gtk_dialog_get_response_for_widget)
-XEN_NARGIFY_2(gxg_gtk_drag_source_set_icon_name_w, gxg_gtk_drag_source_set_icon_name)
-XEN_NARGIFY_4(gxg_gtk_drag_set_icon_name_w, gxg_gtk_drag_set_icon_name)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_set_popup_set_width_w, gxg_gtk_entry_completion_set_popup_set_width)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_popup_set_width_w, gxg_gtk_entry_completion_get_popup_set_width)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_set_popup_single_match_w, gxg_gtk_entry_completion_set_popup_single_match)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_popup_single_match_w, gxg_gtk_entry_completion_get_popup_single_match)
-XEN_ARGIFY_5(gxg_gtk_icon_view_get_item_at_pos_w, gxg_gtk_icon_view_get_item_at_pos)
-XEN_ARGIFY_3(gxg_gtk_icon_view_get_visible_range_w, gxg_gtk_icon_view_get_visible_range)
-XEN_NARGIFY_4(gxg_gtk_icon_view_set_cursor_w, gxg_gtk_icon_view_set_cursor)
-XEN_ARGIFY_3(gxg_gtk_icon_view_get_cursor_w, gxg_gtk_icon_view_get_cursor)
-XEN_NARGIFY_5(gxg_gtk_icon_view_scroll_to_path_w, gxg_gtk_icon_view_scroll_to_path)
-XEN_NARGIFY_5(gxg_gtk_icon_view_enable_model_drag_source_w, gxg_gtk_icon_view_enable_model_drag_source)
-XEN_NARGIFY_4(gxg_gtk_icon_view_enable_model_drag_dest_w, gxg_gtk_icon_view_enable_model_drag_dest)
-XEN_NARGIFY_1(gxg_gtk_icon_view_unset_model_drag_source_w, gxg_gtk_icon_view_unset_model_drag_source)
-XEN_NARGIFY_1(gxg_gtk_icon_view_unset_model_drag_dest_w, gxg_gtk_icon_view_unset_model_drag_dest)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_reorderable_w, gxg_gtk_icon_view_set_reorderable)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_reorderable_w, gxg_gtk_icon_view_get_reorderable)
-XEN_NARGIFY_3(gxg_gtk_icon_view_set_drag_dest_item_w, gxg_gtk_icon_view_set_drag_dest_item)
-XEN_ARGIFY_3(gxg_gtk_icon_view_get_drag_dest_item_w, gxg_gtk_icon_view_get_drag_dest_item)
-XEN_ARGIFY_5(gxg_gtk_icon_view_get_dest_item_at_pos_w, gxg_gtk_icon_view_get_dest_item_at_pos)
-XEN_NARGIFY_1(gxg_gtk_image_clear_w, gxg_gtk_image_clear)
-XEN_NARGIFY_1(gxg_gtk_menu_bar_get_pack_direction_w, gxg_gtk_menu_bar_get_pack_direction)
-XEN_NARGIFY_2(gxg_gtk_menu_bar_set_pack_direction_w, gxg_gtk_menu_bar_set_pack_direction)
-XEN_NARGIFY_1(gxg_gtk_menu_bar_get_child_pack_direction_w, gxg_gtk_menu_bar_get_child_pack_direction)
-XEN_NARGIFY_2(gxg_gtk_menu_bar_set_child_pack_direction_w, gxg_gtk_menu_bar_set_child_pack_direction)
-XEN_NARGIFY_1(gxg_gtk_menu_shell_get_take_focus_w, gxg_gtk_menu_shell_get_take_focus)
-XEN_NARGIFY_2(gxg_gtk_menu_shell_set_take_focus_w, gxg_gtk_menu_shell_set_take_focus)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_get_hscrollbar_w, gxg_gtk_scrolled_window_get_hscrollbar)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_get_vscrollbar_w, gxg_gtk_scrolled_window_get_vscrollbar)
-XEN_NARGIFY_2(gxg_gtk_size_group_set_ignore_hidden_w, gxg_gtk_size_group_set_ignore_hidden)
-XEN_NARGIFY_1(gxg_gtk_size_group_get_ignore_hidden_w, gxg_gtk_size_group_get_ignore_hidden)
-XEN_NARGIFY_1(gxg_gtk_text_iter_forward_visible_line_w, gxg_gtk_text_iter_forward_visible_line)
-XEN_NARGIFY_1(gxg_gtk_text_iter_backward_visible_line_w, gxg_gtk_text_iter_backward_visible_line)
-XEN_NARGIFY_2(gxg_gtk_text_iter_forward_visible_lines_w, gxg_gtk_text_iter_forward_visible_lines)
-XEN_NARGIFY_2(gxg_gtk_text_iter_backward_visible_lines_w, gxg_gtk_text_iter_backward_visible_lines)
-XEN_NARGIFY_2(gxg_gtk_tool_button_set_icon_name_w, gxg_gtk_tool_button_set_icon_name)
-XEN_NARGIFY_1(gxg_gtk_tool_button_get_icon_name_w, gxg_gtk_tool_button_get_icon_name)
-XEN_NARGIFY_2(gxg_gtk_window_set_urgency_hint_w, gxg_gtk_window_set_urgency_hint)
-XEN_NARGIFY_1(gxg_gtk_window_get_urgency_hint_w, gxg_gtk_window_get_urgency_hint)
-XEN_NARGIFY_2(gxg_gtk_window_present_with_time_w, gxg_gtk_window_present_with_time)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_wrap_license_w, gxg_gtk_about_dialog_get_wrap_license)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_wrap_license_w, gxg_gtk_about_dialog_set_wrap_license)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_do_overwrite_confirmation_w, gxg_gtk_file_chooser_set_do_overwrite_confirmation)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_do_overwrite_confirmation_w, gxg_gtk_file_chooser_get_do_overwrite_confirmation)
-XEN_NARGIFY_1(gxg_gtk_tree_row_reference_get_model_w, gxg_gtk_tree_row_reference_get_model)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_queue_resize_w, gxg_gtk_tree_view_column_queue_resize)
-XEN_ARGIFY_3(gxg_gtk_tree_view_get_visible_range_w, gxg_gtk_tree_view_get_visible_range)
-XEN_NARGIFY_1(gxg_gtk_text_attributes_ref_w, gxg_gtk_text_attributes_ref)
-XEN_NARGIFY_1(gxg_pango_attr_list_ref_w, gxg_pango_attr_list_ref)
-XEN_NARGIFY_1(gxg_pango_layout_line_ref_w, gxg_pango_layout_line_ref)
-XEN_ARGIFY_5(gxg_pango_layout_index_to_line_x_w, gxg_pango_layout_index_to_line_x)
-XEN_NARGIFY_1(gxg_gtk_target_list_ref_w, gxg_gtk_target_list_ref)
-XEN_NARGIFY_1(gxg_gdk_display_supports_shapes_w, gxg_gdk_display_supports_shapes)
-XEN_NARGIFY_1(gxg_gdk_display_supports_input_shapes_w, gxg_gdk_display_supports_input_shapes)
-XEN_NARGIFY_1(gxg_gdk_screen_is_composited_w, gxg_gdk_screen_is_composited)
-XEN_NARGIFY_2(gxg_gdk_screen_set_resolution_w, gxg_gdk_screen_set_resolution)
-XEN_NARGIFY_1(gxg_gdk_screen_get_resolution_w, gxg_gdk_screen_get_resolution)
-XEN_NARGIFY_1(gxg_gdk_screen_get_active_window_w, gxg_gdk_screen_get_active_window)
-XEN_NARGIFY_1(gxg_gdk_screen_get_window_stack_w, gxg_gdk_screen_get_window_stack)
-XEN_NARGIFY_1(gxg_gdk_window_get_type_hint_w, gxg_gdk_window_get_type_hint)
-XEN_ARGIFY_4(gxg_gtk_clipboard_request_rich_text_w, gxg_gtk_clipboard_request_rich_text)
-XEN_ARGIFY_4(gxg_gtk_clipboard_wait_for_rich_text_w, gxg_gtk_clipboard_wait_for_rich_text)
-XEN_NARGIFY_2(gxg_gtk_clipboard_wait_is_rich_text_available_w, gxg_gtk_clipboard_wait_is_rich_text_available)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_title_w, gxg_gtk_combo_box_get_title)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_title_w, gxg_gtk_combo_box_set_title)
-XEN_NARGIFY_2(gxg_gtk_drag_dest_set_track_motion_w, gxg_gtk_drag_dest_set_track_motion)
-XEN_NARGIFY_1(gxg_gtk_drag_dest_get_track_motion_w, gxg_gtk_drag_dest_get_track_motion)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_button_get_focus_on_click_w, gxg_gtk_file_chooser_button_get_focus_on_click)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_button_set_focus_on_click_w, gxg_gtk_file_chooser_button_set_focus_on_click)
-XEN_NARGIFY_2(gxg_gtk_notebook_get_tab_reorderable_w, gxg_gtk_notebook_get_tab_reorderable)
-XEN_NARGIFY_3(gxg_gtk_notebook_set_tab_reorderable_w, gxg_gtk_notebook_set_tab_reorderable)
-XEN_NARGIFY_2(gxg_gtk_notebook_get_tab_detachable_w, gxg_gtk_notebook_get_tab_detachable)
-XEN_NARGIFY_3(gxg_gtk_notebook_set_tab_detachable_w, gxg_gtk_notebook_set_tab_detachable)
-XEN_NARGIFY_2(gxg_gtk_radio_action_set_current_value_w, gxg_gtk_radio_action_set_current_value)
-XEN_NARGIFY_2(gxg_gtk_range_set_lower_stepper_sensitivity_w, gxg_gtk_range_set_lower_stepper_sensitivity)
-XEN_NARGIFY_1(gxg_gtk_range_get_lower_stepper_sensitivity_w, gxg_gtk_range_get_lower_stepper_sensitivity)
-XEN_NARGIFY_2(gxg_gtk_range_set_upper_stepper_sensitivity_w, gxg_gtk_range_set_upper_stepper_sensitivity)
-XEN_NARGIFY_1(gxg_gtk_range_get_upper_stepper_sensitivity_w, gxg_gtk_range_get_upper_stepper_sensitivity)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_unset_placement_w, gxg_gtk_scrolled_window_unset_placement)
-XEN_NARGIFY_4(gxg_gtk_target_list_add_rich_text_targets_w, gxg_gtk_target_list_add_rich_text_targets)
-XEN_ARGIFY_2(gxg_gtk_target_table_new_from_list_w, gxg_gtk_target_table_new_from_list)
-XEN_NARGIFY_2(gxg_gtk_target_table_free_w, gxg_gtk_target_table_free)
-XEN_NARGIFY_2(gxg_gtk_selection_data_targets_include_rich_text_w, gxg_gtk_selection_data_targets_include_rich_text)
-XEN_NARGIFY_1(gxg_gtk_selection_data_targets_include_uri_w, gxg_gtk_selection_data_targets_include_uri)
-XEN_NARGIFY_2(gxg_gtk_targets_include_text_w, gxg_gtk_targets_include_text)
-XEN_NARGIFY_3(gxg_gtk_targets_include_rich_text_w, gxg_gtk_targets_include_rich_text)
-XEN_NARGIFY_3(gxg_gtk_targets_include_image_w, gxg_gtk_targets_include_image)
-XEN_NARGIFY_2(gxg_gtk_targets_include_uri_w, gxg_gtk_targets_include_uri)
-XEN_NARGIFY_1(gxg_gtk_size_group_get_widgets_w, gxg_gtk_size_group_get_widgets)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_has_selection_w, gxg_gtk_text_buffer_get_has_selection)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_copy_target_list_w, gxg_gtk_text_buffer_get_copy_target_list)
-XEN_NARGIFY_1(gxg_gtk_text_buffer_get_paste_target_list_w, gxg_gtk_text_buffer_get_paste_target_list)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_headers_clickable_w, gxg_gtk_tree_view_get_headers_clickable)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_search_entry_w, gxg_gtk_tree_view_get_search_entry)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_search_entry_w, gxg_gtk_tree_view_set_search_entry)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_search_position_func_w, gxg_gtk_tree_view_get_search_position_func)
-XEN_ARGIFY_4(gxg_gtk_tree_view_set_search_position_func_w, gxg_gtk_tree_view_set_search_position_func)
-XEN_NARGIFY_1(gxg_gtk_widget_is_composited_w, gxg_gtk_widget_is_composited)
-XEN_NARGIFY_2(gxg_gtk_window_set_deletable_w, gxg_gtk_window_set_deletable)
-XEN_NARGIFY_1(gxg_gtk_window_get_deletable_w, gxg_gtk_window_get_deletable)
-XEN_NARGIFY_0(gxg_gtk_assistant_new_w, gxg_gtk_assistant_new)
-XEN_NARGIFY_1(gxg_gtk_assistant_get_current_page_w, gxg_gtk_assistant_get_current_page)
-XEN_NARGIFY_2(gxg_gtk_assistant_set_current_page_w, gxg_gtk_assistant_set_current_page)
-XEN_NARGIFY_1(gxg_gtk_assistant_get_n_pages_w, gxg_gtk_assistant_get_n_pages)
-XEN_NARGIFY_2(gxg_gtk_assistant_get_nth_page_w, gxg_gtk_assistant_get_nth_page)
-XEN_NARGIFY_2(gxg_gtk_assistant_prepend_page_w, gxg_gtk_assistant_prepend_page)
-XEN_NARGIFY_2(gxg_gtk_assistant_append_page_w, gxg_gtk_assistant_append_page)
-XEN_NARGIFY_3(gxg_gtk_assistant_insert_page_w, gxg_gtk_assistant_insert_page)
-XEN_ARGIFY_4(gxg_gtk_assistant_set_forward_page_func_w, gxg_gtk_assistant_set_forward_page_func)
-XEN_NARGIFY_3(gxg_gtk_assistant_set_page_type_w, gxg_gtk_assistant_set_page_type)
-XEN_NARGIFY_2(gxg_gtk_assistant_get_page_type_w, gxg_gtk_assistant_get_page_type)
-XEN_NARGIFY_3(gxg_gtk_assistant_set_page_title_w, gxg_gtk_assistant_set_page_title)
-XEN_NARGIFY_2(gxg_gtk_assistant_get_page_title_w, gxg_gtk_assistant_get_page_title)
-XEN_NARGIFY_3(gxg_gtk_assistant_set_page_header_image_w, gxg_gtk_assistant_set_page_header_image)
-XEN_NARGIFY_2(gxg_gtk_assistant_get_page_header_image_w, gxg_gtk_assistant_get_page_header_image)
-XEN_NARGIFY_3(gxg_gtk_assistant_set_page_side_image_w, gxg_gtk_assistant_set_page_side_image)
-XEN_NARGIFY_2(gxg_gtk_assistant_get_page_side_image_w, gxg_gtk_assistant_get_page_side_image)
-XEN_NARGIFY_3(gxg_gtk_assistant_set_page_complete_w, gxg_gtk_assistant_set_page_complete)
-XEN_NARGIFY_2(gxg_gtk_assistant_get_page_complete_w, gxg_gtk_assistant_get_page_complete)
-XEN_NARGIFY_2(gxg_gtk_assistant_add_action_widget_w, gxg_gtk_assistant_add_action_widget)
-XEN_NARGIFY_2(gxg_gtk_assistant_remove_action_widget_w, gxg_gtk_assistant_remove_action_widget)
-XEN_NARGIFY_1(gxg_gtk_assistant_update_buttons_state_w, gxg_gtk_assistant_update_buttons_state)
-XEN_NARGIFY_0(gxg_gtk_cell_renderer_accel_new_w, gxg_gtk_cell_renderer_accel_new)
-XEN_NARGIFY_0(gxg_gtk_cell_renderer_spin_new_w, gxg_gtk_cell_renderer_spin_new)
-XEN_NARGIFY_1(gxg_gtk_link_button_new_w, gxg_gtk_link_button_new)
-XEN_NARGIFY_2(gxg_gtk_link_button_new_with_label_w, gxg_gtk_link_button_new_with_label)
-XEN_NARGIFY_1(gxg_gtk_link_button_get_uri_w, gxg_gtk_link_button_get_uri)
-XEN_NARGIFY_2(gxg_gtk_link_button_set_uri_w, gxg_gtk_link_button_set_uri)
-XEN_NARGIFY_0(gxg_gtk_recent_chooser_error_quark_w, gxg_gtk_recent_chooser_error_quark)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_show_private_w, gxg_gtk_recent_chooser_set_show_private)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_show_private_w, gxg_gtk_recent_chooser_get_show_private)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_show_not_found_w, gxg_gtk_recent_chooser_set_show_not_found)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_show_not_found_w, gxg_gtk_recent_chooser_get_show_not_found)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_select_multiple_w, gxg_gtk_recent_chooser_set_select_multiple)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_select_multiple_w, gxg_gtk_recent_chooser_get_select_multiple)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_limit_w, gxg_gtk_recent_chooser_set_limit)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_limit_w, gxg_gtk_recent_chooser_get_limit)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_local_only_w, gxg_gtk_recent_chooser_set_local_only)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_local_only_w, gxg_gtk_recent_chooser_get_local_only)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_show_tips_w, gxg_gtk_recent_chooser_set_show_tips)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_show_tips_w, gxg_gtk_recent_chooser_get_show_tips)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_show_icons_w, gxg_gtk_recent_chooser_set_show_icons)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_show_icons_w, gxg_gtk_recent_chooser_get_show_icons)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_sort_type_w, gxg_gtk_recent_chooser_set_sort_type)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_sort_type_w, gxg_gtk_recent_chooser_get_sort_type)
-XEN_ARGIFY_4(gxg_gtk_recent_chooser_set_sort_func_w, gxg_gtk_recent_chooser_set_sort_func)
-XEN_ARGIFY_3(gxg_gtk_recent_chooser_set_current_uri_w, gxg_gtk_recent_chooser_set_current_uri)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_current_uri_w, gxg_gtk_recent_chooser_get_current_uri)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_current_item_w, gxg_gtk_recent_chooser_get_current_item)
-XEN_ARGIFY_3(gxg_gtk_recent_chooser_select_uri_w, gxg_gtk_recent_chooser_select_uri)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_unselect_uri_w, gxg_gtk_recent_chooser_unselect_uri)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_select_all_w, gxg_gtk_recent_chooser_select_all)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_unselect_all_w, gxg_gtk_recent_chooser_unselect_all)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_items_w, gxg_gtk_recent_chooser_get_items)
-XEN_ARGIFY_2(gxg_gtk_recent_chooser_get_uris_w, gxg_gtk_recent_chooser_get_uris)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_add_filter_w, gxg_gtk_recent_chooser_add_filter)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_remove_filter_w, gxg_gtk_recent_chooser_remove_filter)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_list_filters_w, gxg_gtk_recent_chooser_list_filters)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_set_filter_w, gxg_gtk_recent_chooser_set_filter)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_get_filter_w, gxg_gtk_recent_chooser_get_filter)
-XEN_NARGIFY_0(gxg_gtk_recent_chooser_menu_new_w, gxg_gtk_recent_chooser_menu_new)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_menu_new_for_manager_w, gxg_gtk_recent_chooser_menu_new_for_manager)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_menu_get_show_numbers_w, gxg_gtk_recent_chooser_menu_get_show_numbers)
-XEN_NARGIFY_2(gxg_gtk_recent_chooser_menu_set_show_numbers_w, gxg_gtk_recent_chooser_menu_set_show_numbers)
-XEN_NARGIFY_0(gxg_gtk_recent_chooser_widget_new_w, gxg_gtk_recent_chooser_widget_new)
-XEN_NARGIFY_1(gxg_gtk_recent_chooser_widget_new_for_manager_w, gxg_gtk_recent_chooser_widget_new_for_manager)
-XEN_NARGIFY_0(gxg_gtk_recent_filter_new_w, gxg_gtk_recent_filter_new)
-XEN_NARGIFY_2(gxg_gtk_recent_filter_set_name_w, gxg_gtk_recent_filter_set_name)
-XEN_NARGIFY_1(gxg_gtk_recent_filter_get_name_w, gxg_gtk_recent_filter_get_name)
-XEN_NARGIFY_2(gxg_gtk_recent_filter_add_mime_type_w, gxg_gtk_recent_filter_add_mime_type)
-XEN_NARGIFY_2(gxg_gtk_recent_filter_add_pattern_w, gxg_gtk_recent_filter_add_pattern)
-XEN_NARGIFY_1(gxg_gtk_recent_filter_add_pixbuf_formats_w, gxg_gtk_recent_filter_add_pixbuf_formats)
-XEN_NARGIFY_2(gxg_gtk_recent_filter_add_application_w, gxg_gtk_recent_filter_add_application)
-XEN_NARGIFY_2(gxg_gtk_recent_filter_add_group_w, gxg_gtk_recent_filter_add_group)
-XEN_NARGIFY_2(gxg_gtk_recent_filter_add_age_w, gxg_gtk_recent_filter_add_age)
-XEN_ARGIFY_5(gxg_gtk_recent_filter_add_custom_w, gxg_gtk_recent_filter_add_custom)
-XEN_NARGIFY_1(gxg_gtk_recent_filter_get_needed_w, gxg_gtk_recent_filter_get_needed)
-XEN_NARGIFY_2(gxg_gtk_recent_filter_filter_w, gxg_gtk_recent_filter_filter)
-XEN_NARGIFY_0(gxg_gtk_recent_manager_error_quark_w, gxg_gtk_recent_manager_error_quark)
-XEN_NARGIFY_0(gxg_gtk_recent_manager_new_w, gxg_gtk_recent_manager_new)
-XEN_NARGIFY_0(gxg_gtk_recent_manager_get_default_w, gxg_gtk_recent_manager_get_default)
-XEN_ARGIFY_3(gxg_gtk_recent_manager_remove_item_w, gxg_gtk_recent_manager_remove_item)
-XEN_ARGIFY_3(gxg_gtk_recent_manager_lookup_item_w, gxg_gtk_recent_manager_lookup_item)
-XEN_NARGIFY_2(gxg_gtk_recent_manager_has_item_w, gxg_gtk_recent_manager_has_item)
-XEN_ARGIFY_4(gxg_gtk_recent_manager_move_item_w, gxg_gtk_recent_manager_move_item)
-XEN_NARGIFY_1(gxg_gtk_recent_manager_get_items_w, gxg_gtk_recent_manager_get_items)
-XEN_ARGIFY_2(gxg_gtk_recent_manager_purge_items_w, gxg_gtk_recent_manager_purge_items)
-XEN_NARGIFY_1(gxg_gtk_recent_info_ref_w, gxg_gtk_recent_info_ref)
-XEN_NARGIFY_1(gxg_gtk_recent_info_unref_w, gxg_gtk_recent_info_unref)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_uri_w, gxg_gtk_recent_info_get_uri)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_display_name_w, gxg_gtk_recent_info_get_display_name)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_description_w, gxg_gtk_recent_info_get_description)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_mime_type_w, gxg_gtk_recent_info_get_mime_type)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_added_w, gxg_gtk_recent_info_get_added)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_modified_w, gxg_gtk_recent_info_get_modified)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_visited_w, gxg_gtk_recent_info_get_visited)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_private_hint_w, gxg_gtk_recent_info_get_private_hint)
-XEN_ARGIFY_2(gxg_gtk_recent_info_get_applications_w, gxg_gtk_recent_info_get_applications)
-XEN_NARGIFY_1(gxg_gtk_recent_info_last_application_w, gxg_gtk_recent_info_last_application)
-XEN_NARGIFY_2(gxg_gtk_recent_info_has_application_w, gxg_gtk_recent_info_has_application)
-XEN_ARGIFY_2(gxg_gtk_recent_info_get_groups_w, gxg_gtk_recent_info_get_groups)
-XEN_NARGIFY_2(gxg_gtk_recent_info_has_group_w, gxg_gtk_recent_info_has_group)
-XEN_NARGIFY_2(gxg_gtk_recent_info_get_icon_w, gxg_gtk_recent_info_get_icon)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_short_name_w, gxg_gtk_recent_info_get_short_name)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_uri_display_w, gxg_gtk_recent_info_get_uri_display)
-XEN_NARGIFY_1(gxg_gtk_recent_info_get_age_w, gxg_gtk_recent_info_get_age)
-XEN_NARGIFY_1(gxg_gtk_recent_info_is_local_w, gxg_gtk_recent_info_is_local)
-XEN_NARGIFY_1(gxg_gtk_recent_info_exists_w, gxg_gtk_recent_info_exists)
-XEN_NARGIFY_2(gxg_gtk_recent_info_match_w, gxg_gtk_recent_info_match)
-XEN_NARGIFY_0(gxg_gtk_status_icon_new_w, gxg_gtk_status_icon_new)
-XEN_NARGIFY_1(gxg_gtk_status_icon_new_from_pixbuf_w, gxg_gtk_status_icon_new_from_pixbuf)
-XEN_NARGIFY_1(gxg_gtk_status_icon_new_from_file_w, gxg_gtk_status_icon_new_from_file)
-XEN_NARGIFY_1(gxg_gtk_status_icon_new_from_stock_w, gxg_gtk_status_icon_new_from_stock)
-XEN_NARGIFY_1(gxg_gtk_status_icon_new_from_icon_name_w, gxg_gtk_status_icon_new_from_icon_name)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_from_pixbuf_w, gxg_gtk_status_icon_set_from_pixbuf)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_from_file_w, gxg_gtk_status_icon_set_from_file)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_from_stock_w, gxg_gtk_status_icon_set_from_stock)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_from_icon_name_w, gxg_gtk_status_icon_set_from_icon_name)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_storage_type_w, gxg_gtk_status_icon_get_storage_type)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_pixbuf_w, gxg_gtk_status_icon_get_pixbuf)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_stock_w, gxg_gtk_status_icon_get_stock)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_icon_name_w, gxg_gtk_status_icon_get_icon_name)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_size_w, gxg_gtk_status_icon_get_size)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_visible_w, gxg_gtk_status_icon_set_visible)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_visible_w, gxg_gtk_status_icon_get_visible)
-XEN_NARGIFY_1(gxg_gtk_status_icon_is_embedded_w, gxg_gtk_status_icon_is_embedded)
-XEN_ARGIFY_5(gxg_gtk_status_icon_position_menu_w, gxg_gtk_status_icon_position_menu)
-XEN_NARGIFY_5(gxg_gtk_text_buffer_register_serialize_format_w, gxg_gtk_text_buffer_register_serialize_format)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_register_serialize_tagset_w, gxg_gtk_text_buffer_register_serialize_tagset)
-XEN_NARGIFY_5(gxg_gtk_text_buffer_register_deserialize_format_w, gxg_gtk_text_buffer_register_deserialize_format)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_register_deserialize_tagset_w, gxg_gtk_text_buffer_register_deserialize_tagset)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_unregister_serialize_format_w, gxg_gtk_text_buffer_unregister_serialize_format)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_unregister_deserialize_format_w, gxg_gtk_text_buffer_unregister_deserialize_format)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_deserialize_set_can_create_tags_w, gxg_gtk_text_buffer_deserialize_set_can_create_tags)
-XEN_NARGIFY_2(gxg_gtk_text_buffer_deserialize_get_can_create_tags_w, gxg_gtk_text_buffer_deserialize_get_can_create_tags)
-XEN_ARGIFY_2(gxg_gtk_text_buffer_get_serialize_formats_w, gxg_gtk_text_buffer_get_serialize_formats)
-XEN_ARGIFY_2(gxg_gtk_text_buffer_get_deserialize_formats_w, gxg_gtk_text_buffer_get_deserialize_formats)
-XEN_ARGIFY_6(gxg_gtk_text_buffer_serialize_w, gxg_gtk_text_buffer_serialize)
-XEN_ARGIFY_7(gxg_gtk_text_buffer_deserialize_w, gxg_gtk_text_buffer_deserialize)
-XEN_NARGIFY_2(gxg_gtk_recent_manager_add_item_w, gxg_gtk_recent_manager_add_item)
-XEN_NARGIFY_3(gxg_gtk_recent_manager_add_full_w, gxg_gtk_recent_manager_add_full)
-XEN_NARGIFY_3(gxg_gtk_tree_model_filter_convert_child_iter_to_iter_w, gxg_gtk_tree_model_filter_convert_child_iter_to_iter)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_grid_lines_w, gxg_gtk_tree_view_get_grid_lines)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_grid_lines_w, gxg_gtk_tree_view_set_grid_lines)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_enable_tree_lines_w, gxg_gtk_tree_view_get_enable_tree_lines)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_enable_tree_lines_w, gxg_gtk_tree_view_set_enable_tree_lines)
-XEN_NARGIFY_2(gxg_gtk_label_set_line_wrap_mode_w, gxg_gtk_label_set_line_wrap_mode)
-XEN_NARGIFY_1(gxg_gtk_label_get_line_wrap_mode_w, gxg_gtk_label_get_line_wrap_mode)
-XEN_NARGIFY_1(gxg_gtk_print_context_get_cairo_context_w, gxg_gtk_print_context_get_cairo_context)
-XEN_NARGIFY_1(gxg_gtk_print_context_get_page_setup_w, gxg_gtk_print_context_get_page_setup)
-XEN_NARGIFY_1(gxg_gtk_print_context_get_width_w, gxg_gtk_print_context_get_width)
-XEN_NARGIFY_1(gxg_gtk_print_context_get_height_w, gxg_gtk_print_context_get_height)
-XEN_NARGIFY_1(gxg_gtk_print_context_get_dpi_x_w, gxg_gtk_print_context_get_dpi_x)
-XEN_NARGIFY_1(gxg_gtk_print_context_get_dpi_y_w, gxg_gtk_print_context_get_dpi_y)
-XEN_NARGIFY_1(gxg_gtk_print_context_create_pango_context_w, gxg_gtk_print_context_create_pango_context)
-XEN_NARGIFY_1(gxg_gtk_print_context_create_pango_layout_w, gxg_gtk_print_context_create_pango_layout)
-XEN_NARGIFY_4(gxg_gtk_print_context_set_cairo_context_w, gxg_gtk_print_context_set_cairo_context)
-XEN_NARGIFY_0(gxg_gtk_print_operation_new_w, gxg_gtk_print_operation_new)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_default_page_setup_w, gxg_gtk_print_operation_set_default_page_setup)
-XEN_NARGIFY_1(gxg_gtk_print_operation_get_default_page_setup_w, gxg_gtk_print_operation_get_default_page_setup)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_print_settings_w, gxg_gtk_print_operation_set_print_settings)
-XEN_NARGIFY_1(gxg_gtk_print_operation_get_print_settings_w, gxg_gtk_print_operation_get_print_settings)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_job_name_w, gxg_gtk_print_operation_set_job_name)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_n_pages_w, gxg_gtk_print_operation_set_n_pages)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_current_page_w, gxg_gtk_print_operation_set_current_page)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_use_full_page_w, gxg_gtk_print_operation_set_use_full_page)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_unit_w, gxg_gtk_print_operation_set_unit)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_export_filename_w, gxg_gtk_print_operation_set_export_filename)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_track_print_status_w, gxg_gtk_print_operation_set_track_print_status)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_show_progress_w, gxg_gtk_print_operation_set_show_progress)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_allow_async_w, gxg_gtk_print_operation_set_allow_async)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_custom_tab_label_w, gxg_gtk_print_operation_set_custom_tab_label)
-XEN_ARGIFY_4(gxg_gtk_print_operation_run_w, gxg_gtk_print_operation_run)
-XEN_ARGIFY_2(gxg_gtk_print_operation_get_error_w, gxg_gtk_print_operation_get_error)
-XEN_NARGIFY_1(gxg_gtk_print_operation_get_status_w, gxg_gtk_print_operation_get_status)
-XEN_NARGIFY_1(gxg_gtk_print_operation_get_status_string_w, gxg_gtk_print_operation_get_status_string)
-XEN_NARGIFY_1(gxg_gtk_print_operation_is_finished_w, gxg_gtk_print_operation_is_finished)
-XEN_NARGIFY_1(gxg_gtk_print_operation_cancel_w, gxg_gtk_print_operation_cancel)
-XEN_NARGIFY_3(gxg_gtk_print_run_page_setup_dialog_w, gxg_gtk_print_run_page_setup_dialog)
-XEN_NARGIFY_5(gxg_gtk_print_run_page_setup_dialog_async_w, gxg_gtk_print_run_page_setup_dialog_async)
-XEN_NARGIFY_2(gxg_gtk_print_operation_preview_render_page_w, gxg_gtk_print_operation_preview_render_page)
-XEN_NARGIFY_1(gxg_gtk_print_operation_preview_end_preview_w, gxg_gtk_print_operation_preview_end_preview)
-XEN_NARGIFY_2(gxg_gtk_print_operation_preview_is_selected_w, gxg_gtk_print_operation_preview_is_selected)
-XEN_NARGIFY_0(gxg_gtk_print_settings_new_w, gxg_gtk_print_settings_new)
-XEN_NARGIFY_1(gxg_gtk_print_settings_copy_w, gxg_gtk_print_settings_copy)
-XEN_NARGIFY_2(gxg_gtk_print_settings_has_key_w, gxg_gtk_print_settings_has_key)
-XEN_NARGIFY_2(gxg_gtk_print_settings_get_w, gxg_gtk_print_settings_get)
-XEN_NARGIFY_3(gxg_gtk_print_settings_set_w, gxg_gtk_print_settings_set)
-XEN_NARGIFY_2(gxg_gtk_print_settings_unset_w, gxg_gtk_print_settings_unset)
-XEN_NARGIFY_3(gxg_gtk_print_settings_foreach_w, gxg_gtk_print_settings_foreach)
-XEN_NARGIFY_2(gxg_gtk_print_settings_get_bool_w, gxg_gtk_print_settings_get_bool)
-XEN_NARGIFY_3(gxg_gtk_print_settings_set_bool_w, gxg_gtk_print_settings_set_bool)
-XEN_NARGIFY_2(gxg_gtk_print_settings_get_double_w, gxg_gtk_print_settings_get_double)
-XEN_NARGIFY_3(gxg_gtk_print_settings_get_double_with_default_w, gxg_gtk_print_settings_get_double_with_default)
-XEN_NARGIFY_3(gxg_gtk_print_settings_set_double_w, gxg_gtk_print_settings_set_double)
-XEN_NARGIFY_3(gxg_gtk_print_settings_get_length_w, gxg_gtk_print_settings_get_length)
-XEN_NARGIFY_4(gxg_gtk_print_settings_set_length_w, gxg_gtk_print_settings_set_length)
-XEN_NARGIFY_2(gxg_gtk_print_settings_get_int_w, gxg_gtk_print_settings_get_int)
-XEN_NARGIFY_3(gxg_gtk_print_settings_get_int_with_default_w, gxg_gtk_print_settings_get_int_with_default)
-XEN_NARGIFY_3(gxg_gtk_print_settings_set_int_w, gxg_gtk_print_settings_set_int)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_printer_w, gxg_gtk_print_settings_get_printer)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_printer_w, gxg_gtk_print_settings_set_printer)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_orientation_w, gxg_gtk_print_settings_get_orientation)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_orientation_w, gxg_gtk_print_settings_set_orientation)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_paper_size_w, gxg_gtk_print_settings_get_paper_size)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_paper_size_w, gxg_gtk_print_settings_set_paper_size)
-XEN_NARGIFY_2(gxg_gtk_print_settings_get_paper_width_w, gxg_gtk_print_settings_get_paper_width)
-XEN_NARGIFY_3(gxg_gtk_print_settings_set_paper_width_w, gxg_gtk_print_settings_set_paper_width)
-XEN_NARGIFY_2(gxg_gtk_print_settings_get_paper_height_w, gxg_gtk_print_settings_get_paper_height)
-XEN_NARGIFY_3(gxg_gtk_print_settings_set_paper_height_w, gxg_gtk_print_settings_set_paper_height)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_use_color_w, gxg_gtk_print_settings_get_use_color)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_use_color_w, gxg_gtk_print_settings_set_use_color)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_collate_w, gxg_gtk_print_settings_get_collate)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_collate_w, gxg_gtk_print_settings_set_collate)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_reverse_w, gxg_gtk_print_settings_get_reverse)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_reverse_w, gxg_gtk_print_settings_set_reverse)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_duplex_w, gxg_gtk_print_settings_get_duplex)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_duplex_w, gxg_gtk_print_settings_set_duplex)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_quality_w, gxg_gtk_print_settings_get_quality)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_quality_w, gxg_gtk_print_settings_set_quality)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_n_copies_w, gxg_gtk_print_settings_get_n_copies)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_n_copies_w, gxg_gtk_print_settings_set_n_copies)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_number_up_w, gxg_gtk_print_settings_get_number_up)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_number_up_w, gxg_gtk_print_settings_set_number_up)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_resolution_w, gxg_gtk_print_settings_get_resolution)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_resolution_w, gxg_gtk_print_settings_set_resolution)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_scale_w, gxg_gtk_print_settings_get_scale)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_scale_w, gxg_gtk_print_settings_set_scale)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_print_pages_w, gxg_gtk_print_settings_get_print_pages)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_print_pages_w, gxg_gtk_print_settings_set_print_pages)
-XEN_NARGIFY_2(gxg_gtk_print_settings_get_page_ranges_w, gxg_gtk_print_settings_get_page_ranges)
-XEN_NARGIFY_3(gxg_gtk_print_settings_set_page_ranges_w, gxg_gtk_print_settings_set_page_ranges)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_page_set_w, gxg_gtk_print_settings_get_page_set)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_page_set_w, gxg_gtk_print_settings_set_page_set)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_default_source_w, gxg_gtk_print_settings_get_default_source)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_default_source_w, gxg_gtk_print_settings_set_default_source)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_media_type_w, gxg_gtk_print_settings_get_media_type)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_media_type_w, gxg_gtk_print_settings_set_media_type)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_dither_w, gxg_gtk_print_settings_get_dither)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_dither_w, gxg_gtk_print_settings_set_dither)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_finishings_w, gxg_gtk_print_settings_get_finishings)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_finishings_w, gxg_gtk_print_settings_set_finishings)
-XEN_NARGIFY_1(gxg_gtk_print_settings_get_output_bin_w, gxg_gtk_print_settings_get_output_bin)
-XEN_NARGIFY_2(gxg_gtk_print_settings_set_output_bin_w, gxg_gtk_print_settings_set_output_bin)
-XEN_NARGIFY_1(gxg_gtk_settings_get_for_screen_w, gxg_gtk_settings_get_for_screen)
-XEN_NARGIFY_1(gxg_pango_cairo_create_layout_w, gxg_pango_cairo_create_layout)
-XEN_NARGIFY_2(gxg_pango_cairo_update_layout_w, gxg_pango_cairo_update_layout)
-XEN_NARGIFY_2(gxg_pango_cairo_update_context_w, gxg_pango_cairo_update_context)
-XEN_NARGIFY_2(gxg_pango_cairo_context_set_font_options_w, gxg_pango_cairo_context_set_font_options)
-XEN_NARGIFY_1(gxg_pango_cairo_context_get_font_options_w, gxg_pango_cairo_context_get_font_options)
-XEN_NARGIFY_2(gxg_pango_cairo_context_set_resolution_w, gxg_pango_cairo_context_set_resolution)
-XEN_NARGIFY_1(gxg_pango_cairo_context_get_resolution_w, gxg_pango_cairo_context_get_resolution)
-XEN_NARGIFY_3(gxg_pango_cairo_show_glyph_string_w, gxg_pango_cairo_show_glyph_string)
-XEN_NARGIFY_2(gxg_pango_cairo_show_layout_line_w, gxg_pango_cairo_show_layout_line)
-XEN_NARGIFY_2(gxg_pango_cairo_show_layout_w, gxg_pango_cairo_show_layout)
-XEN_NARGIFY_5(gxg_pango_cairo_show_error_underline_w, gxg_pango_cairo_show_error_underline)
-XEN_NARGIFY_3(gxg_pango_cairo_glyph_string_path_w, gxg_pango_cairo_glyph_string_path)
-XEN_NARGIFY_2(gxg_pango_cairo_layout_line_path_w, gxg_pango_cairo_layout_line_path)
-XEN_NARGIFY_2(gxg_pango_cairo_layout_path_w, gxg_pango_cairo_layout_path)
-XEN_NARGIFY_5(gxg_pango_cairo_error_underline_path_w, gxg_pango_cairo_error_underline_path)
-XEN_NARGIFY_2(gxg_gdk_cairo_set_source_color_w, gxg_gdk_cairo_set_source_color)
-XEN_NARGIFY_4(gxg_gdk_cairo_set_source_pixbuf_w, gxg_gdk_cairo_set_source_pixbuf)
-XEN_NARGIFY_2(gxg_gdk_cairo_rectangle_w, gxg_gdk_cairo_rectangle)
-XEN_NARGIFY_1(gxg_gdk_color_to_string_w, gxg_gdk_color_to_string)
-XEN_NARGIFY_1(gxg_gdk_event_request_motions_w, gxg_gdk_event_request_motions)
-XEN_NARGIFY_1(gxg_gdk_notify_startup_complete_with_id_w, gxg_gdk_notify_startup_complete_with_id)
-XEN_NARGIFY_4(gxg_gdk_threads_add_idle_full_w, gxg_gdk_threads_add_idle_full)
-XEN_ARGIFY_2(gxg_gdk_threads_add_idle_w, gxg_gdk_threads_add_idle)
-XEN_NARGIFY_5(gxg_gdk_threads_add_timeout_full_w, gxg_gdk_threads_add_timeout_full)
-XEN_ARGIFY_3(gxg_gdk_threads_add_timeout_w, gxg_gdk_threads_add_timeout)
-XEN_NARGIFY_2(gxg_gdk_window_set_startup_id_w, gxg_gdk_window_set_startup_id)
-XEN_NARGIFY_1(gxg_gdk_window_beep_w, gxg_gdk_window_beep)
-XEN_NARGIFY_2(gxg_gdk_window_set_opacity_w, gxg_gdk_window_set_opacity)
-XEN_NARGIFY_1(gxg_gtk_action_create_menu_w, gxg_gtk_action_create_menu)
-XEN_NARGIFY_3(gxg_gtk_binding_entry_skip_w, gxg_gtk_binding_entry_skip)
-XEN_NARGIFY_1(gxg_gtk_cell_layout_get_cells_w, gxg_gtk_cell_layout_get_cells)
-XEN_NARGIFY_2(gxg_gtk_entry_completion_set_inline_selection_w, gxg_gtk_entry_completion_set_inline_selection)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_inline_selection_w, gxg_gtk_entry_completion_get_inline_selection)
-XEN_NARGIFY_1(gxg_gtk_entry_completion_get_completion_prefix_w, gxg_gtk_entry_completion_get_completion_prefix)
-XEN_NARGIFY_2(gxg_gtk_entry_set_cursor_hadjustment_w, gxg_gtk_entry_set_cursor_hadjustment)
-XEN_NARGIFY_1(gxg_gtk_entry_get_cursor_hadjustment_w, gxg_gtk_entry_get_cursor_hadjustment)
-XEN_NARGIFY_1(gxg_gtk_icon_theme_list_contexts_w, gxg_gtk_icon_theme_list_contexts)
-XEN_ARGIFY_2(gxg_gtk_page_setup_new_from_file_w, gxg_gtk_page_setup_new_from_file)
-XEN_ARGIFY_3(gxg_gtk_page_setup_to_file_w, gxg_gtk_page_setup_to_file)
-XEN_ARGIFY_2(gxg_gtk_print_settings_new_from_file_w, gxg_gtk_print_settings_new_from_file)
-XEN_ARGIFY_3(gxg_gtk_print_settings_to_file_w, gxg_gtk_print_settings_to_file)
-XEN_NARGIFY_2(gxg_gtk_range_set_show_fill_level_w, gxg_gtk_range_set_show_fill_level)
-XEN_NARGIFY_1(gxg_gtk_range_get_show_fill_level_w, gxg_gtk_range_get_show_fill_level)
-XEN_NARGIFY_2(gxg_gtk_range_set_restrict_to_fill_level_w, gxg_gtk_range_set_restrict_to_fill_level)
-XEN_NARGIFY_1(gxg_gtk_range_get_restrict_to_fill_level_w, gxg_gtk_range_get_restrict_to_fill_level)
-XEN_NARGIFY_2(gxg_gtk_range_set_fill_level_w, gxg_gtk_range_set_fill_level)
-XEN_NARGIFY_1(gxg_gtk_range_get_fill_level_w, gxg_gtk_range_get_fill_level)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_screen_w, gxg_gtk_status_icon_set_screen)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_screen_w, gxg_gtk_status_icon_get_screen)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_show_expanders_w, gxg_gtk_tree_view_set_show_expanders)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_show_expanders_w, gxg_gtk_tree_view_get_show_expanders)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_level_indentation_w, gxg_gtk_tree_view_set_level_indentation)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_level_indentation_w, gxg_gtk_tree_view_get_level_indentation)
-XEN_NARGIFY_2(gxg_gtk_widget_keynav_failed_w, gxg_gtk_widget_keynav_failed)
-XEN_NARGIFY_1(gxg_gtk_widget_error_bell_w, gxg_gtk_widget_error_bell)
-XEN_NARGIFY_2(gxg_gtk_widget_set_tooltip_window_w, gxg_gtk_widget_set_tooltip_window)
-XEN_NARGIFY_1(gxg_gtk_widget_get_tooltip_window_w, gxg_gtk_widget_get_tooltip_window)
-XEN_NARGIFY_1(gxg_gtk_widget_trigger_tooltip_query_w, gxg_gtk_widget_trigger_tooltip_query)
-XEN_NARGIFY_2(gxg_gtk_window_set_startup_id_w, gxg_gtk_window_set_startup_id)
-XEN_NARGIFY_2(gxg_gtk_window_set_opacity_w, gxg_gtk_window_set_opacity)
-XEN_NARGIFY_1(gxg_gtk_window_get_opacity_w, gxg_gtk_window_get_opacity)
-XEN_NARGIFY_1(gxg_gdk_display_supports_composite_w, gxg_gdk_display_supports_composite)
-XEN_NARGIFY_2(gxg_gdk_window_set_composited_w, gxg_gdk_window_set_composited)
-XEN_NARGIFY_3(gxg_gtk_text_buffer_add_mark_w, gxg_gtk_text_buffer_add_mark)
-XEN_NARGIFY_2(gxg_gtk_text_mark_new_w, gxg_gtk_text_mark_new)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_tree_view_w, gxg_gtk_tree_view_column_get_tree_view)
-XEN_NARGIFY_2(gxg_gtk_tooltip_set_text_w, gxg_gtk_tooltip_set_text)
-XEN_ARGIFY_5(gxg_gtk_tree_view_convert_widget_to_tree_coords_w, gxg_gtk_tree_view_convert_widget_to_tree_coords)
-XEN_ARGIFY_5(gxg_gtk_tree_view_convert_tree_to_widget_coords_w, gxg_gtk_tree_view_convert_tree_to_widget_coords)
-XEN_ARGIFY_5(gxg_gtk_tree_view_convert_widget_to_bin_window_coords_w, gxg_gtk_tree_view_convert_widget_to_bin_window_coords)
-XEN_ARGIFY_5(gxg_gtk_tree_view_convert_bin_window_to_widget_coords_w, gxg_gtk_tree_view_convert_bin_window_to_widget_coords)
-XEN_ARGIFY_5(gxg_gtk_tree_view_convert_tree_to_bin_window_coords_w, gxg_gtk_tree_view_convert_tree_to_bin_window_coords)
-XEN_ARGIFY_5(gxg_gtk_tree_view_convert_bin_window_to_tree_coords_w, gxg_gtk_tree_view_convert_bin_window_to_tree_coords)
-XEN_NARGIFY_2(gxg_gtk_widget_set_tooltip_text_w, gxg_gtk_widget_set_tooltip_text)
-XEN_NARGIFY_1(gxg_gtk_widget_get_tooltip_text_w, gxg_gtk_widget_get_tooltip_text)
-XEN_NARGIFY_2(gxg_gtk_widget_set_tooltip_markup_w, gxg_gtk_widget_set_tooltip_markup)
-XEN_NARGIFY_1(gxg_gtk_widget_get_tooltip_markup_w, gxg_gtk_widget_get_tooltip_markup)
-XEN_NARGIFY_1(gxg_gtk_tree_view_is_rubber_banding_active_w, gxg_gtk_tree_view_is_rubber_banding_active)
-XEN_ARGIFY_5(gxg_gtk_icon_view_convert_widget_to_bin_window_coords_w, gxg_gtk_icon_view_convert_widget_to_bin_window_coords)
-XEN_NARGIFY_3(gxg_gtk_icon_view_set_tooltip_item_w, gxg_gtk_icon_view_set_tooltip_item)
-XEN_NARGIFY_4(gxg_gtk_icon_view_set_tooltip_cell_w, gxg_gtk_icon_view_set_tooltip_cell)
-XEN_ARGIFY_7(gxg_gtk_icon_view_get_tooltip_context_w, gxg_gtk_icon_view_get_tooltip_context)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_tooltip_column_w, gxg_gtk_icon_view_set_tooltip_column)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_tooltip_column_w, gxg_gtk_icon_view_get_tooltip_column)
-XEN_NARGIFY_2(gxg_gtk_menu_tool_button_set_arrow_tooltip_text_w, gxg_gtk_menu_tool_button_set_arrow_tooltip_text)
-XEN_NARGIFY_2(gxg_gtk_menu_tool_button_set_arrow_tooltip_markup_w, gxg_gtk_menu_tool_button_set_arrow_tooltip_markup)
-XEN_NARGIFY_2(gxg_gtk_tool_item_set_tooltip_text_w, gxg_gtk_tool_item_set_tooltip_text)
-XEN_NARGIFY_2(gxg_gtk_tool_item_set_tooltip_markup_w, gxg_gtk_tool_item_set_tooltip_markup)
-XEN_NARGIFY_2(gxg_gtk_tooltip_set_tip_area_w, gxg_gtk_tooltip_set_tip_area)
-XEN_NARGIFY_3(gxg_gtk_tree_view_set_tooltip_row_w, gxg_gtk_tree_view_set_tooltip_row)
-XEN_NARGIFY_5(gxg_gtk_tree_view_set_tooltip_cell_w, gxg_gtk_tree_view_set_tooltip_cell)
-XEN_ARGIFY_7(gxg_gtk_tree_view_get_tooltip_context_w, gxg_gtk_tree_view_get_tooltip_context)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_tooltip_column_w, gxg_gtk_tree_view_set_tooltip_column)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_tooltip_column_w, gxg_gtk_tree_view_get_tooltip_column)
-XEN_NARGIFY_2(gxg_gtk_widget_set_has_tooltip_w, gxg_gtk_widget_set_has_tooltip)
-XEN_NARGIFY_1(gxg_gtk_widget_get_has_tooltip_w, gxg_gtk_widget_get_has_tooltip)
-#if HAVE_GTK_TEST_WIDGET_CLICK
-XEN_NARGIFY_4(gxg_gtk_calendar_set_detail_func_w, gxg_gtk_calendar_set_detail_func)
-XEN_NARGIFY_2(gxg_gtk_calendar_set_detail_width_chars_w, gxg_gtk_calendar_set_detail_width_chars)
-XEN_NARGIFY_2(gxg_gtk_calendar_set_detail_height_rows_w, gxg_gtk_calendar_set_detail_height_rows)
-XEN_NARGIFY_1(gxg_gtk_calendar_get_detail_width_chars_w, gxg_gtk_calendar_get_detail_width_chars)
-XEN_NARGIFY_1(gxg_gtk_calendar_get_detail_height_rows_w, gxg_gtk_calendar_get_detail_height_rows)
-XEN_NARGIFY_2(gxg_gdk_screen_get_monitor_width_mm_w, gxg_gdk_screen_get_monitor_width_mm)
-XEN_NARGIFY_2(gxg_gdk_screen_get_monitor_height_mm_w, gxg_gdk_screen_get_monitor_height_mm)
-XEN_NARGIFY_2(gxg_gdk_screen_get_monitor_plug_name_w, gxg_gdk_screen_get_monitor_plug_name)
-XEN_NARGIFY_3(gxg_gtk_tooltip_set_icon_from_icon_name_w, gxg_gtk_tooltip_set_icon_from_icon_name)
+static void define_structs(void)
+{
+ Xg_define_procedure(GtkTextIter, gxg_make_GtkTextIter_w, 0, 0, 0, "(GtkTextIter): a new GtkTextIter struct", NULL);
+ Xg_define_procedure(GtkTreeIter, gxg_make_GtkTreeIter_w, 0, 0, 0, "(GtkTreeIter): a new GtkTreeIter struct", NULL);
+ Xg_define_procedure(PangoRectangle, gxg_make_PangoRectangle_w, 0, 0, 0, "(PangoRectangle): a new PangoRectangle struct", NULL);
+ Xg_define_procedure(cairo_matrix_t, gxg_make_cairo_matrix_t_w, 0, 0, 0, "(cairo_matrix_t): a new cairo_matrix_t struct", NULL);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ Xg_define_procedure(GdkRGBA, gxg_make_GdkRGBA_w, 0, 0, 0, "(GdkRGBA): a new GdkRGBA struct", NULL);
+#endif
+}
+
+Xen_wrap_1_arg(gxg_g_unichar_validate_w, gxg_g_unichar_validate)
+Xen_wrap_1_arg(gxg_g_unichar_isalnum_w, gxg_g_unichar_isalnum)
+Xen_wrap_1_arg(gxg_g_unichar_isalpha_w, gxg_g_unichar_isalpha)
+Xen_wrap_1_arg(gxg_g_unichar_iscntrl_w, gxg_g_unichar_iscntrl)
+Xen_wrap_1_arg(gxg_g_unichar_isdefined_w, gxg_g_unichar_isdefined)
+Xen_wrap_1_arg(gxg_g_unichar_isdigit_w, gxg_g_unichar_isdigit)
+Xen_wrap_1_arg(gxg_g_unichar_isgraph_w, gxg_g_unichar_isgraph)
+Xen_wrap_1_arg(gxg_g_unichar_islower_w, gxg_g_unichar_islower)
+Xen_wrap_1_arg(gxg_g_unichar_ismark_w, gxg_g_unichar_ismark)
+Xen_wrap_1_arg(gxg_g_unichar_isprint_w, gxg_g_unichar_isprint)
+Xen_wrap_1_arg(gxg_g_unichar_ispunct_w, gxg_g_unichar_ispunct)
+Xen_wrap_1_arg(gxg_g_unichar_isspace_w, gxg_g_unichar_isspace)
+Xen_wrap_1_arg(gxg_g_unichar_istitle_w, gxg_g_unichar_istitle)
+Xen_wrap_1_arg(gxg_g_unichar_isupper_w, gxg_g_unichar_isupper)
+Xen_wrap_1_arg(gxg_g_unichar_isxdigit_w, gxg_g_unichar_isxdigit)
+Xen_wrap_1_arg(gxg_g_unichar_iswide_w, gxg_g_unichar_iswide)
+Xen_wrap_1_arg(gxg_g_unichar_iswide_cjk_w, gxg_g_unichar_iswide_cjk)
+Xen_wrap_1_arg(gxg_g_unichar_iszerowidth_w, gxg_g_unichar_iszerowidth)
+Xen_wrap_1_arg(gxg_g_unichar_toupper_w, gxg_g_unichar_toupper)
+Xen_wrap_1_arg(gxg_g_unichar_tolower_w, gxg_g_unichar_tolower)
+Xen_wrap_1_arg(gxg_g_unichar_totitle_w, gxg_g_unichar_totitle)
+Xen_wrap_1_arg(gxg_g_unichar_digit_value_w, gxg_g_unichar_digit_value)
+Xen_wrap_1_arg(gxg_g_unichar_xdigit_value_w, gxg_g_unichar_xdigit_value)
+Xen_wrap_1_arg(gxg_g_unichar_combining_class_w, gxg_g_unichar_combining_class)
+Xen_wrap_2_args(gxg_g_unicode_canonical_ordering_w, gxg_g_unicode_canonical_ordering)
+Xen_wrap_1_arg(gxg_g_utf8_get_char_w, gxg_g_utf8_get_char)
+Xen_wrap_2_args(gxg_g_utf8_get_char_validated_w, gxg_g_utf8_get_char_validated)
+Xen_wrap_1_arg(gxg_g_utf8_prev_char_w, gxg_g_utf8_prev_char)
+Xen_wrap_2_args(gxg_g_utf8_find_next_char_w, gxg_g_utf8_find_next_char)
+Xen_wrap_2_args(gxg_g_utf8_find_prev_char_w, gxg_g_utf8_find_prev_char)
+Xen_wrap_2_args(gxg_g_utf8_strlen_w, gxg_g_utf8_strlen)
+Xen_wrap_3_args(gxg_g_utf8_strchr_w, gxg_g_utf8_strchr)
+Xen_wrap_3_args(gxg_g_utf8_strrchr_w, gxg_g_utf8_strrchr)
+Xen_wrap_2_args(gxg_g_utf8_strreverse_w, gxg_g_utf8_strreverse)
+Xen_wrap_3_optional_args(gxg_g_utf8_validate_w, gxg_g_utf8_validate)
+Xen_wrap_2_args(gxg_g_utf8_strup_w, gxg_g_utf8_strup)
+Xen_wrap_2_args(gxg_g_utf8_strdown_w, gxg_g_utf8_strdown)
+Xen_wrap_2_args(gxg_g_utf8_casefold_w, gxg_g_utf8_casefold)
+Xen_wrap_3_args(gxg_g_utf8_normalize_w, gxg_g_utf8_normalize)
+Xen_wrap_2_args(gxg_g_utf8_collate_w, gxg_g_utf8_collate)
+Xen_wrap_2_args(gxg_g_utf8_collate_key_w, gxg_g_utf8_collate_key)
+Xen_wrap_2_args(gxg_g_utf8_collate_key_for_filename_w, gxg_g_utf8_collate_key_for_filename)
+Xen_wrap_3_args(gxg_g_cclosure_new_w, gxg_g_cclosure_new)
+Xen_wrap_any_args(gxg_g_signal_newv_w, gxg_g_signal_newv)
+Xen_wrap_2_args(gxg_g_signal_lookup_w, gxg_g_signal_lookup)
+Xen_wrap_1_arg(gxg_g_signal_name_w, gxg_g_signal_name)
+Xen_wrap_2_args(gxg_g_signal_query_w, gxg_g_signal_query)
+Xen_wrap_2_args(gxg_g_signal_list_ids_w, gxg_g_signal_list_ids)
+Xen_wrap_5_optional_args(gxg_g_signal_parse_name_w, gxg_g_signal_parse_name)
+Xen_wrap_1_arg(gxg_g_signal_get_invocation_hint_w, gxg_g_signal_get_invocation_hint)
+Xen_wrap_3_args(gxg_g_signal_stop_emission_w, gxg_g_signal_stop_emission)
+Xen_wrap_2_args(gxg_g_signal_stop_emission_by_name_w, gxg_g_signal_stop_emission_by_name)
+Xen_wrap_5_args(gxg_g_signal_add_emission_hook_w, gxg_g_signal_add_emission_hook)
+Xen_wrap_2_args(gxg_g_signal_remove_emission_hook_w, gxg_g_signal_remove_emission_hook)
+Xen_wrap_4_args(gxg_g_signal_has_handler_pending_w, gxg_g_signal_has_handler_pending)
+Xen_wrap_5_args(gxg_g_signal_connect_closure_by_id_w, gxg_g_signal_connect_closure_by_id)
+Xen_wrap_4_args(gxg_g_signal_connect_closure_w, gxg_g_signal_connect_closure)
+Xen_wrap_6_args(gxg_g_signal_connect_data_w, gxg_g_signal_connect_data)
+Xen_wrap_2_args(gxg_g_signal_handler_block_w, gxg_g_signal_handler_block)
+Xen_wrap_2_args(gxg_g_signal_handler_unblock_w, gxg_g_signal_handler_unblock)
+Xen_wrap_2_args(gxg_g_signal_handler_disconnect_w, gxg_g_signal_handler_disconnect)
+Xen_wrap_2_args(gxg_g_signal_handler_is_connected_w, gxg_g_signal_handler_is_connected)
+Xen_wrap_7_args(gxg_g_signal_handler_find_w, gxg_g_signal_handler_find)
+Xen_wrap_7_args(gxg_g_signal_handlers_block_matched_w, gxg_g_signal_handlers_block_matched)
+Xen_wrap_7_args(gxg_g_signal_handlers_unblock_matched_w, gxg_g_signal_handlers_unblock_matched)
+Xen_wrap_7_args(gxg_g_signal_handlers_disconnect_matched_w, gxg_g_signal_handlers_disconnect_matched)
+Xen_wrap_1_arg(gxg_g_signal_handlers_destroy_w, gxg_g_signal_handlers_destroy)
+Xen_wrap_1_arg(gxg_g_object_ref_w, gxg_g_object_ref)
+Xen_wrap_1_arg(gxg_g_object_unref_w, gxg_g_object_unref)
+Xen_wrap_no_args(gxg_gdk_visual_get_system_w, gxg_gdk_visual_get_system)
+Xen_wrap_2_args(gxg_gdk_cursor_new_for_display_w, gxg_gdk_cursor_new_for_display)
+Xen_wrap_1_arg(gxg_gdk_cursor_get_display_w, gxg_gdk_cursor_get_display)
+Xen_wrap_3_args(gxg_gdk_drag_status_w, gxg_gdk_drag_status)
+Xen_wrap_3_args(gxg_gdk_drop_reply_w, gxg_gdk_drop_reply)
+Xen_wrap_3_args(gxg_gdk_drop_finish_w, gxg_gdk_drop_finish)
+Xen_wrap_1_arg(gxg_gdk_drag_get_selection_w, gxg_gdk_drag_get_selection)
+Xen_wrap_2_args(gxg_gdk_drag_begin_w, gxg_gdk_drag_begin)
+Xen_wrap_2_args(gxg_gdk_drag_drop_w, gxg_gdk_drag_drop)
+Xen_wrap_2_args(gxg_gdk_drag_abort_w, gxg_gdk_drag_abort)
+Xen_wrap_no_args(gxg_gdk_events_pending_w, gxg_gdk_events_pending)
+Xen_wrap_no_args(gxg_gdk_event_get_w, gxg_gdk_event_get)
+Xen_wrap_no_args(gxg_gdk_event_peek_w, gxg_gdk_event_peek)
+Xen_wrap_1_arg(gxg_gdk_event_put_w, gxg_gdk_event_put)
+Xen_wrap_1_arg(gxg_gdk_event_copy_w, gxg_gdk_event_copy)
+Xen_wrap_1_arg(gxg_gdk_event_free_w, gxg_gdk_event_free)
+Xen_wrap_1_arg(gxg_gdk_event_get_time_w, gxg_gdk_event_get_time)
+Xen_wrap_2_optional_args(gxg_gdk_event_get_state_w, gxg_gdk_event_get_state)
+Xen_wrap_3_optional_args(gxg_gdk_event_get_coords_w, gxg_gdk_event_get_coords)
+Xen_wrap_3_optional_args(gxg_gdk_event_get_root_coords_w, gxg_gdk_event_get_root_coords)
+Xen_wrap_3_args(gxg_gdk_event_handler_set_w, gxg_gdk_event_handler_set)
+Xen_wrap_1_arg(gxg_gdk_set_show_events_w, gxg_gdk_set_show_events)
+Xen_wrap_no_args(gxg_gdk_get_show_events_w, gxg_gdk_get_show_events)
+Xen_wrap_2_optional_args(gxg_gdk_init_w, gxg_gdk_init)
+Xen_wrap_2_optional_args(gxg_gdk_init_check_w, gxg_gdk_init_check)
+Xen_wrap_no_args(gxg_gdk_get_program_class_w, gxg_gdk_get_program_class)
+Xen_wrap_1_arg(gxg_gdk_set_program_class_w, gxg_gdk_set_program_class)
+Xen_wrap_no_args(gxg_gdk_error_trap_push_w, gxg_gdk_error_trap_push)
+Xen_wrap_no_args(gxg_gdk_error_trap_pop_w, gxg_gdk_error_trap_pop)
+Xen_wrap_no_args(gxg_gdk_get_display_arg_name_w, gxg_gdk_get_display_arg_name)
+Xen_wrap_no_args(gxg_gdk_notify_startup_complete_w, gxg_gdk_notify_startup_complete)
+Xen_wrap_no_args(gxg_gdk_screen_width_w, gxg_gdk_screen_width)
+Xen_wrap_no_args(gxg_gdk_screen_height_w, gxg_gdk_screen_height)
+Xen_wrap_no_args(gxg_gdk_screen_width_mm_w, gxg_gdk_screen_width_mm)
+Xen_wrap_no_args(gxg_gdk_screen_height_mm_w, gxg_gdk_screen_height_mm)
+Xen_wrap_no_args(gxg_gdk_flush_w, gxg_gdk_flush)
+Xen_wrap_no_args(gxg_gdk_beep_w, gxg_gdk_beep)
+Xen_wrap_1_arg(gxg_gdk_set_double_click_time_w, gxg_gdk_set_double_click_time)
+Xen_wrap_3_args(gxg_gdk_rectangle_intersect_w, gxg_gdk_rectangle_intersect)
+Xen_wrap_3_args(gxg_gdk_rectangle_union_w, gxg_gdk_rectangle_union)
+Xen_wrap_no_args(gxg_gdk_keymap_get_default_w, gxg_gdk_keymap_get_default)
+Xen_wrap_2_args(gxg_gdk_keymap_lookup_key_w, gxg_gdk_keymap_lookup_key)
+Xen_wrap_4_optional_args(gxg_gdk_keymap_get_entries_for_keyval_w, gxg_gdk_keymap_get_entries_for_keyval)
+Xen_wrap_5_optional_args(gxg_gdk_keymap_get_entries_for_keycode_w, gxg_gdk_keymap_get_entries_for_keycode)
+Xen_wrap_1_arg(gxg_gdk_keymap_get_direction_w, gxg_gdk_keymap_get_direction)
+Xen_wrap_1_arg(gxg_gdk_keyval_name_w, gxg_gdk_keyval_name)
+Xen_wrap_1_arg(gxg_gdk_keyval_from_name_w, gxg_gdk_keyval_from_name)
+Xen_wrap_3_optional_args(gxg_gdk_keyval_convert_case_w, gxg_gdk_keyval_convert_case)
+Xen_wrap_1_arg(gxg_gdk_keyval_to_upper_w, gxg_gdk_keyval_to_upper)
+Xen_wrap_1_arg(gxg_gdk_keyval_to_lower_w, gxg_gdk_keyval_to_lower)
+Xen_wrap_1_arg(gxg_gdk_keyval_is_upper_w, gxg_gdk_keyval_is_upper)
+Xen_wrap_1_arg(gxg_gdk_keyval_is_lower_w, gxg_gdk_keyval_is_lower)
+Xen_wrap_1_arg(gxg_gdk_keyval_to_unicode_w, gxg_gdk_keyval_to_unicode)
+Xen_wrap_1_arg(gxg_gdk_unicode_to_keyval_w, gxg_gdk_unicode_to_keyval)
+Xen_wrap_no_args(gxg_gdk_pango_context_get_w, gxg_gdk_pango_context_get)
+Xen_wrap_2_args(gxg_gdk_atom_intern_w, gxg_gdk_atom_intern)
+Xen_wrap_1_arg(gxg_gdk_atom_name_w, gxg_gdk_atom_name)
+Xen_wrap_any_args(gxg_gdk_property_get_w, gxg_gdk_property_get)
+Xen_wrap_7_args(gxg_gdk_property_change_w, gxg_gdk_property_change)
+Xen_wrap_2_args(gxg_gdk_property_delete_w, gxg_gdk_property_delete)
+Xen_wrap_1_arg(gxg_gdk_utf8_to_string_target_w, gxg_gdk_utf8_to_string_target)
+Xen_wrap_4_args(gxg_gdk_selection_owner_set_w, gxg_gdk_selection_owner_set)
+Xen_wrap_1_arg(gxg_gdk_selection_owner_get_w, gxg_gdk_selection_owner_get)
+Xen_wrap_4_args(gxg_gdk_selection_convert_w, gxg_gdk_selection_convert)
+Xen_wrap_4_optional_args(gxg_gdk_selection_property_get_w, gxg_gdk_selection_property_get)
+Xen_wrap_no_args(gxg_gdk_visual_get_best_depth_w, gxg_gdk_visual_get_best_depth)
+Xen_wrap_no_args(gxg_gdk_visual_get_best_type_w, gxg_gdk_visual_get_best_type)
+Xen_wrap_no_args(gxg_gdk_visual_get_best_w, gxg_gdk_visual_get_best)
+Xen_wrap_1_arg(gxg_gdk_visual_get_best_with_depth_w, gxg_gdk_visual_get_best_with_depth)
+Xen_wrap_1_arg(gxg_gdk_visual_get_best_with_type_w, gxg_gdk_visual_get_best_with_type)
+Xen_wrap_2_args(gxg_gdk_visual_get_best_with_both_w, gxg_gdk_visual_get_best_with_both)
+Xen_wrap_2_optional_args(gxg_gdk_query_depths_w, gxg_gdk_query_depths)
+Xen_wrap_2_optional_args(gxg_gdk_query_visual_types_w, gxg_gdk_query_visual_types)
+Xen_wrap_no_args(gxg_gdk_list_visuals_w, gxg_gdk_list_visuals)
+Xen_wrap_3_args(gxg_gdk_window_new_w, gxg_gdk_window_new)
+Xen_wrap_1_arg(gxg_gdk_window_destroy_w, gxg_gdk_window_destroy)
+Xen_wrap_1_arg(gxg_gdk_window_get_window_type_w, gxg_gdk_window_get_window_type)
+Xen_wrap_1_arg(gxg_gdk_window_show_w, gxg_gdk_window_show)
+Xen_wrap_1_arg(gxg_gdk_window_hide_w, gxg_gdk_window_hide)
+Xen_wrap_1_arg(gxg_gdk_window_withdraw_w, gxg_gdk_window_withdraw)
+Xen_wrap_1_arg(gxg_gdk_window_show_unraised_w, gxg_gdk_window_show_unraised)
+Xen_wrap_3_args(gxg_gdk_window_move_w, gxg_gdk_window_move)
+Xen_wrap_3_args(gxg_gdk_window_resize_w, gxg_gdk_window_resize)
+Xen_wrap_5_args(gxg_gdk_window_move_resize_w, gxg_gdk_window_move_resize)
+Xen_wrap_4_args(gxg_gdk_window_reparent_w, gxg_gdk_window_reparent)
+Xen_wrap_1_arg(gxg_gdk_window_raise_w, gxg_gdk_window_raise)
+Xen_wrap_1_arg(gxg_gdk_window_lower_w, gxg_gdk_window_lower)
+Xen_wrap_2_args(gxg_gdk_window_focus_w, gxg_gdk_window_focus)
+Xen_wrap_2_args(gxg_gdk_window_set_user_data_w, gxg_gdk_window_set_user_data)
+Xen_wrap_2_args(gxg_gdk_window_set_override_redirect_w, gxg_gdk_window_set_override_redirect)
+Xen_wrap_3_optional_args(gxg_gdk_window_add_filter_w, gxg_gdk_window_add_filter)
+Xen_wrap_3_optional_args(gxg_gdk_window_remove_filter_w, gxg_gdk_window_remove_filter)
+Xen_wrap_3_args(gxg_gdk_window_scroll_w, gxg_gdk_window_scroll)
+Xen_wrap_1_arg(gxg_gdk_window_set_child_shapes_w, gxg_gdk_window_set_child_shapes)
+Xen_wrap_1_arg(gxg_gdk_window_merge_child_shapes_w, gxg_gdk_window_merge_child_shapes)
+Xen_wrap_1_arg(gxg_gdk_window_is_visible_w, gxg_gdk_window_is_visible)
+Xen_wrap_1_arg(gxg_gdk_window_is_viewable_w, gxg_gdk_window_is_viewable)
+Xen_wrap_1_arg(gxg_gdk_window_get_state_w, gxg_gdk_window_get_state)
+Xen_wrap_3_optional_args(gxg_gdk_window_get_root_origin_w, gxg_gdk_window_get_root_origin)
+Xen_wrap_2_args(gxg_gdk_window_get_frame_extents_w, gxg_gdk_window_get_frame_extents)
+Xen_wrap_1_arg(gxg_gdk_window_get_parent_w, gxg_gdk_window_get_parent)
+Xen_wrap_1_arg(gxg_gdk_window_get_toplevel_w, gxg_gdk_window_get_toplevel)
+Xen_wrap_1_arg(gxg_gdk_window_get_children_w, gxg_gdk_window_get_children)
+Xen_wrap_1_arg(gxg_gdk_window_peek_children_w, gxg_gdk_window_peek_children)
+Xen_wrap_1_arg(gxg_gdk_window_get_events_w, gxg_gdk_window_get_events)
+Xen_wrap_2_args(gxg_gdk_window_set_events_w, gxg_gdk_window_set_events)
+Xen_wrap_2_args(gxg_gdk_window_set_icon_list_w, gxg_gdk_window_set_icon_list)
+Xen_wrap_2_args(gxg_gdk_window_set_icon_name_w, gxg_gdk_window_set_icon_name)
+Xen_wrap_2_args(gxg_gdk_window_set_group_w, gxg_gdk_window_set_group)
+Xen_wrap_2_args(gxg_gdk_window_set_decorations_w, gxg_gdk_window_set_decorations)
+Xen_wrap_2_optional_args(gxg_gdk_window_get_decorations_w, gxg_gdk_window_get_decorations)
+Xen_wrap_2_args(gxg_gdk_window_set_functions_w, gxg_gdk_window_set_functions)
+Xen_wrap_1_arg(gxg_gdk_window_iconify_w, gxg_gdk_window_iconify)
+Xen_wrap_1_arg(gxg_gdk_window_deiconify_w, gxg_gdk_window_deiconify)
+Xen_wrap_1_arg(gxg_gdk_window_stick_w, gxg_gdk_window_stick)
+Xen_wrap_1_arg(gxg_gdk_window_unstick_w, gxg_gdk_window_unstick)
+Xen_wrap_1_arg(gxg_gdk_window_maximize_w, gxg_gdk_window_maximize)
+Xen_wrap_1_arg(gxg_gdk_window_unmaximize_w, gxg_gdk_window_unmaximize)
+Xen_wrap_1_arg(gxg_gdk_window_register_dnd_w, gxg_gdk_window_register_dnd)
+Xen_wrap_6_args(gxg_gdk_window_begin_resize_drag_w, gxg_gdk_window_begin_resize_drag)
+Xen_wrap_5_args(gxg_gdk_window_begin_move_drag_w, gxg_gdk_window_begin_move_drag)
+Xen_wrap_3_args(gxg_gdk_window_invalidate_rect_w, gxg_gdk_window_invalidate_rect)
+Xen_wrap_1_arg(gxg_gdk_window_freeze_updates_w, gxg_gdk_window_freeze_updates)
+Xen_wrap_1_arg(gxg_gdk_window_thaw_updates_w, gxg_gdk_window_thaw_updates)
+Xen_wrap_no_args(gxg_gdk_window_process_all_updates_w, gxg_gdk_window_process_all_updates)
+Xen_wrap_2_args(gxg_gdk_window_process_updates_w, gxg_gdk_window_process_updates)
+Xen_wrap_1_arg(gxg_gdk_window_set_debug_updates_w, gxg_gdk_window_set_debug_updates)
+Xen_wrap_6_optional_args(gxg_gdk_window_constrain_size_w, gxg_gdk_window_constrain_size)
+Xen_wrap_2_args(gxg_gdk_window_set_type_hint_w, gxg_gdk_window_set_type_hint)
+Xen_wrap_2_args(gxg_gdk_window_set_modal_hint_w, gxg_gdk_window_set_modal_hint)
+Xen_wrap_3_args(gxg_gdk_window_set_geometry_hints_w, gxg_gdk_window_set_geometry_hints)
+Xen_wrap_2_args(gxg_gdk_window_begin_paint_rect_w, gxg_gdk_window_begin_paint_rect)
+Xen_wrap_1_arg(gxg_gdk_window_end_paint_w, gxg_gdk_window_end_paint)
+Xen_wrap_2_args(gxg_gdk_window_set_title_w, gxg_gdk_window_set_title)
+Xen_wrap_2_args(gxg_gdk_window_set_role_w, gxg_gdk_window_set_role)
+Xen_wrap_2_args(gxg_gdk_window_set_transient_for_w, gxg_gdk_window_set_transient_for)
+Xen_wrap_2_args(gxg_gdk_window_set_cursor_w, gxg_gdk_window_set_cursor)
+Xen_wrap_2_optional_args(gxg_gdk_window_get_user_data_w, gxg_gdk_window_get_user_data)
+Xen_wrap_3_optional_args(gxg_gdk_window_get_position_w, gxg_gdk_window_get_position)
+Xen_wrap_3_optional_args(gxg_gdk_window_get_origin_w, gxg_gdk_window_get_origin)
+Xen_wrap_no_args(gxg_gdk_get_default_root_window_w, gxg_gdk_get_default_root_window)
+Xen_wrap_no_args(gxg_gdk_pixbuf_error_quark_w, gxg_gdk_pixbuf_error_quark)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_get_colorspace_w, gxg_gdk_pixbuf_get_colorspace)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_get_n_channels_w, gxg_gdk_pixbuf_get_n_channels)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_get_has_alpha_w, gxg_gdk_pixbuf_get_has_alpha)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_get_bits_per_sample_w, gxg_gdk_pixbuf_get_bits_per_sample)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_get_pixels_w, gxg_gdk_pixbuf_get_pixels)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_get_width_w, gxg_gdk_pixbuf_get_width)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_get_height_w, gxg_gdk_pixbuf_get_height)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_get_rowstride_w, gxg_gdk_pixbuf_get_rowstride)
+Xen_wrap_5_args(gxg_gdk_pixbuf_new_w, gxg_gdk_pixbuf_new)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_copy_w, gxg_gdk_pixbuf_copy)
+Xen_wrap_5_args(gxg_gdk_pixbuf_new_subpixbuf_w, gxg_gdk_pixbuf_new_subpixbuf)
+Xen_wrap_2_optional_args(gxg_gdk_pixbuf_new_from_file_w, gxg_gdk_pixbuf_new_from_file)
+Xen_wrap_any_args(gxg_gdk_pixbuf_new_from_data_w, gxg_gdk_pixbuf_new_from_data)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_new_from_xpm_data_w, gxg_gdk_pixbuf_new_from_xpm_data)
+Xen_wrap_2_args(gxg_gdk_pixbuf_fill_w, gxg_gdk_pixbuf_fill)
+Xen_wrap_6_optional_args(gxg_gdk_pixbuf_savev_w, gxg_gdk_pixbuf_savev)
+Xen_wrap_5_args(gxg_gdk_pixbuf_add_alpha_w, gxg_gdk_pixbuf_add_alpha)
+Xen_wrap_any_args(gxg_gdk_pixbuf_copy_area_w, gxg_gdk_pixbuf_copy_area)
+Xen_wrap_4_args(gxg_gdk_pixbuf_saturate_and_pixelate_w, gxg_gdk_pixbuf_saturate_and_pixelate)
+Xen_wrap_any_args(gxg_gdk_pixbuf_scale_w, gxg_gdk_pixbuf_scale)
+Xen_wrap_any_args(gxg_gdk_pixbuf_composite_w, gxg_gdk_pixbuf_composite)
+Xen_wrap_any_args(gxg_gdk_pixbuf_composite_color_w, gxg_gdk_pixbuf_composite_color)
+Xen_wrap_4_args(gxg_gdk_pixbuf_scale_simple_w, gxg_gdk_pixbuf_scale_simple)
+Xen_wrap_any_args(gxg_gdk_pixbuf_composite_color_simple_w, gxg_gdk_pixbuf_composite_color_simple)
+Xen_wrap_2_optional_args(gxg_gdk_pixbuf_animation_new_from_file_w, gxg_gdk_pixbuf_animation_new_from_file)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_animation_get_width_w, gxg_gdk_pixbuf_animation_get_width)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_animation_get_height_w, gxg_gdk_pixbuf_animation_get_height)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_animation_is_static_image_w, gxg_gdk_pixbuf_animation_is_static_image)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_animation_get_static_image_w, gxg_gdk_pixbuf_animation_get_static_image)
+Xen_wrap_2_args(gxg_gdk_pixbuf_animation_get_iter_w, gxg_gdk_pixbuf_animation_get_iter)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_animation_iter_get_delay_time_w, gxg_gdk_pixbuf_animation_iter_get_delay_time)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_animation_iter_get_pixbuf_w, gxg_gdk_pixbuf_animation_iter_get_pixbuf)
+Xen_wrap_1_arg(gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame_w, gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame)
+Xen_wrap_2_args(gxg_gdk_pixbuf_animation_iter_advance_w, gxg_gdk_pixbuf_animation_iter_advance)
+Xen_wrap_2_args(gxg_gdk_pixbuf_get_option_w, gxg_gdk_pixbuf_get_option)
+Xen_wrap_no_args(gxg_gtk_accel_group_new_w, gxg_gtk_accel_group_new)
+Xen_wrap_1_arg(gxg_gtk_accel_group_lock_w, gxg_gtk_accel_group_lock)
+Xen_wrap_1_arg(gxg_gtk_accel_group_unlock_w, gxg_gtk_accel_group_unlock)
+Xen_wrap_5_args(gxg_gtk_accel_group_connect_w, gxg_gtk_accel_group_connect)
+Xen_wrap_3_args(gxg_gtk_accel_group_connect_by_path_w, gxg_gtk_accel_group_connect_by_path)
+Xen_wrap_2_args(gxg_gtk_accel_group_disconnect_w, gxg_gtk_accel_group_disconnect)
+Xen_wrap_3_args(gxg_gtk_accel_group_disconnect_key_w, gxg_gtk_accel_group_disconnect_key)
+Xen_wrap_3_args(gxg_gtk_accel_groups_activate_w, gxg_gtk_accel_groups_activate)
+Xen_wrap_1_arg(gxg_gtk_accel_groups_from_object_w, gxg_gtk_accel_groups_from_object)
+Xen_wrap_3_optional_args(gxg_gtk_accel_group_find_w, gxg_gtk_accel_group_find)
+Xen_wrap_1_arg(gxg_gtk_accel_group_from_accel_closure_w, gxg_gtk_accel_group_from_accel_closure)
+Xen_wrap_2_args(gxg_gtk_accelerator_valid_w, gxg_gtk_accelerator_valid)
+Xen_wrap_3_optional_args(gxg_gtk_accelerator_parse_w, gxg_gtk_accelerator_parse)
+Xen_wrap_2_args(gxg_gtk_accelerator_name_w, gxg_gtk_accelerator_name)
+Xen_wrap_1_arg(gxg_gtk_accelerator_set_default_mod_mask_w, gxg_gtk_accelerator_set_default_mod_mask)
+Xen_wrap_4_optional_args(gxg_gtk_accel_group_query_w, gxg_gtk_accel_group_query)
+Xen_wrap_5_args(gxg_gtk_accel_group_activate_w, gxg_gtk_accel_group_activate)
+Xen_wrap_1_arg(gxg_gtk_accel_label_new_w, gxg_gtk_accel_label_new)
+Xen_wrap_1_arg(gxg_gtk_accel_label_get_accel_widget_w, gxg_gtk_accel_label_get_accel_widget)
+Xen_wrap_1_arg(gxg_gtk_accel_label_get_accel_width_w, gxg_gtk_accel_label_get_accel_width)
+Xen_wrap_2_args(gxg_gtk_accel_label_set_accel_widget_w, gxg_gtk_accel_label_set_accel_widget)
+Xen_wrap_2_args(gxg_gtk_accel_label_set_accel_closure_w, gxg_gtk_accel_label_set_accel_closure)
+Xen_wrap_1_arg(gxg_gtk_accel_label_refetch_w, gxg_gtk_accel_label_refetch)
+Xen_wrap_3_args(gxg_gtk_accel_map_add_entry_w, gxg_gtk_accel_map_add_entry)
+Xen_wrap_2_args(gxg_gtk_accel_map_lookup_entry_w, gxg_gtk_accel_map_lookup_entry)
+Xen_wrap_4_args(gxg_gtk_accel_map_change_entry_w, gxg_gtk_accel_map_change_entry)
+Xen_wrap_1_arg(gxg_gtk_accel_map_load_w, gxg_gtk_accel_map_load)
+Xen_wrap_1_arg(gxg_gtk_accel_map_save_w, gxg_gtk_accel_map_save)
+Xen_wrap_2_args(gxg_gtk_accel_map_foreach_w, gxg_gtk_accel_map_foreach)
+Xen_wrap_1_arg(gxg_gtk_accel_map_load_fd_w, gxg_gtk_accel_map_load_fd)
+Xen_wrap_1_arg(gxg_gtk_accel_map_save_fd_w, gxg_gtk_accel_map_save_fd)
+Xen_wrap_1_arg(gxg_gtk_accel_map_add_filter_w, gxg_gtk_accel_map_add_filter)
+Xen_wrap_2_args(gxg_gtk_accel_map_foreach_unfiltered_w, gxg_gtk_accel_map_foreach_unfiltered)
+Xen_wrap_3_args(gxg_gtk_adjustment_clamp_page_w, gxg_gtk_adjustment_clamp_page)
+Xen_wrap_1_arg(gxg_gtk_adjustment_get_value_w, gxg_gtk_adjustment_get_value)
+Xen_wrap_2_args(gxg_gtk_adjustment_set_value_w, gxg_gtk_adjustment_set_value)
+Xen_wrap_5_args(gxg_gtk_aspect_frame_new_w, gxg_gtk_aspect_frame_new)
+Xen_wrap_5_args(gxg_gtk_aspect_frame_set_w, gxg_gtk_aspect_frame_set)
+Xen_wrap_1_arg(gxg_gtk_button_box_get_layout_w, gxg_gtk_button_box_get_layout)
+Xen_wrap_2_args(gxg_gtk_button_box_set_layout_w, gxg_gtk_button_box_set_layout)
+Xen_wrap_3_args(gxg_gtk_button_box_set_child_secondary_w, gxg_gtk_button_box_set_child_secondary)
+Xen_wrap_1_arg(gxg_gtk_binding_set_new_w, gxg_gtk_binding_set_new)
+Xen_wrap_1_arg(gxg_gtk_binding_set_by_class_w, gxg_gtk_binding_set_by_class)
+Xen_wrap_1_arg(gxg_gtk_binding_set_find_w, gxg_gtk_binding_set_find)
+Xen_wrap_3_args(gxg_gtk_binding_entry_remove_w, gxg_gtk_binding_entry_remove)
+Xen_wrap_1_arg(gxg_gtk_bin_get_child_w, gxg_gtk_bin_get_child)
+Xen_wrap_5_args(gxg_gtk_box_pack_start_w, gxg_gtk_box_pack_start)
+Xen_wrap_5_args(gxg_gtk_box_pack_end_w, gxg_gtk_box_pack_end)
+Xen_wrap_2_args(gxg_gtk_box_set_homogeneous_w, gxg_gtk_box_set_homogeneous)
+Xen_wrap_1_arg(gxg_gtk_box_get_homogeneous_w, gxg_gtk_box_get_homogeneous)
+Xen_wrap_2_args(gxg_gtk_box_set_spacing_w, gxg_gtk_box_set_spacing)
+Xen_wrap_1_arg(gxg_gtk_box_get_spacing_w, gxg_gtk_box_get_spacing)
+Xen_wrap_3_args(gxg_gtk_box_reorder_child_w, gxg_gtk_box_reorder_child)
+Xen_wrap_6_optional_args(gxg_gtk_box_query_child_packing_w, gxg_gtk_box_query_child_packing)
+Xen_wrap_6_args(gxg_gtk_box_set_child_packing_w, gxg_gtk_box_set_child_packing)
+Xen_wrap_no_args(gxg_gtk_button_new_w, gxg_gtk_button_new)
+Xen_wrap_1_arg(gxg_gtk_button_new_with_label_w, gxg_gtk_button_new_with_label)
+Xen_wrap_1_arg(gxg_gtk_button_new_with_mnemonic_w, gxg_gtk_button_new_with_mnemonic)
+Xen_wrap_1_arg(gxg_gtk_button_clicked_w, gxg_gtk_button_clicked)
+Xen_wrap_2_args(gxg_gtk_button_set_relief_w, gxg_gtk_button_set_relief)
+Xen_wrap_1_arg(gxg_gtk_button_get_relief_w, gxg_gtk_button_get_relief)
+Xen_wrap_2_args(gxg_gtk_button_set_label_w, gxg_gtk_button_set_label)
+Xen_wrap_1_arg(gxg_gtk_button_get_label_w, gxg_gtk_button_get_label)
+Xen_wrap_2_args(gxg_gtk_button_set_use_underline_w, gxg_gtk_button_set_use_underline)
+Xen_wrap_1_arg(gxg_gtk_button_get_use_underline_w, gxg_gtk_button_get_use_underline)
+Xen_wrap_no_args(gxg_gtk_calendar_new_w, gxg_gtk_calendar_new)
+Xen_wrap_2_args(gxg_gtk_calendar_select_day_w, gxg_gtk_calendar_select_day)
+Xen_wrap_1_arg(gxg_gtk_calendar_clear_marks_w, gxg_gtk_calendar_clear_marks)
+Xen_wrap_4_optional_args(gxg_gtk_calendar_get_date_w, gxg_gtk_calendar_get_date)
+Xen_wrap_2_args(gxg_gtk_cell_editable_start_editing_w, gxg_gtk_cell_editable_start_editing)
+Xen_wrap_1_arg(gxg_gtk_cell_editable_editing_done_w, gxg_gtk_cell_editable_editing_done)
+Xen_wrap_1_arg(gxg_gtk_cell_editable_remove_widget_w, gxg_gtk_cell_editable_remove_widget)
+Xen_wrap_7_args(gxg_gtk_cell_renderer_activate_w, gxg_gtk_cell_renderer_activate)
+Xen_wrap_7_args(gxg_gtk_cell_renderer_start_editing_w, gxg_gtk_cell_renderer_start_editing)
+Xen_wrap_3_args(gxg_gtk_cell_renderer_set_fixed_size_w, gxg_gtk_cell_renderer_set_fixed_size)
+Xen_wrap_3_optional_args(gxg_gtk_cell_renderer_get_fixed_size_w, gxg_gtk_cell_renderer_get_fixed_size)
+Xen_wrap_no_args(gxg_gtk_cell_renderer_pixbuf_new_w, gxg_gtk_cell_renderer_pixbuf_new)
+Xen_wrap_no_args(gxg_gtk_cell_renderer_text_new_w, gxg_gtk_cell_renderer_text_new)
+Xen_wrap_2_args(gxg_gtk_cell_renderer_text_set_fixed_height_from_font_w, gxg_gtk_cell_renderer_text_set_fixed_height_from_font)
+Xen_wrap_no_args(gxg_gtk_cell_renderer_toggle_new_w, gxg_gtk_cell_renderer_toggle_new)
+Xen_wrap_1_arg(gxg_gtk_cell_renderer_toggle_get_radio_w, gxg_gtk_cell_renderer_toggle_get_radio)
+Xen_wrap_2_args(gxg_gtk_cell_renderer_toggle_set_radio_w, gxg_gtk_cell_renderer_toggle_set_radio)
+Xen_wrap_1_arg(gxg_gtk_cell_renderer_toggle_get_active_w, gxg_gtk_cell_renderer_toggle_get_active)
+Xen_wrap_2_args(gxg_gtk_cell_renderer_toggle_set_active_w, gxg_gtk_cell_renderer_toggle_set_active)
+Xen_wrap_no_args(gxg_gtk_check_button_new_w, gxg_gtk_check_button_new)
+Xen_wrap_1_arg(gxg_gtk_check_button_new_with_label_w, gxg_gtk_check_button_new_with_label)
+Xen_wrap_1_arg(gxg_gtk_check_button_new_with_mnemonic_w, gxg_gtk_check_button_new_with_mnemonic)
+Xen_wrap_no_args(gxg_gtk_check_menu_item_new_w, gxg_gtk_check_menu_item_new)
+Xen_wrap_1_arg(gxg_gtk_check_menu_item_new_with_label_w, gxg_gtk_check_menu_item_new_with_label)
+Xen_wrap_1_arg(gxg_gtk_check_menu_item_new_with_mnemonic_w, gxg_gtk_check_menu_item_new_with_mnemonic)
+Xen_wrap_2_args(gxg_gtk_check_menu_item_set_active_w, gxg_gtk_check_menu_item_set_active)
+Xen_wrap_1_arg(gxg_gtk_check_menu_item_get_active_w, gxg_gtk_check_menu_item_get_active)
+Xen_wrap_1_arg(gxg_gtk_check_menu_item_toggled_w, gxg_gtk_check_menu_item_toggled)
+Xen_wrap_2_args(gxg_gtk_check_menu_item_set_inconsistent_w, gxg_gtk_check_menu_item_set_inconsistent)
+Xen_wrap_1_arg(gxg_gtk_check_menu_item_get_inconsistent_w, gxg_gtk_check_menu_item_get_inconsistent)
+Xen_wrap_1_arg(gxg_gtk_clipboard_get_w, gxg_gtk_clipboard_get)
+Xen_wrap_6_optional_args(gxg_gtk_clipboard_set_with_data_w, gxg_gtk_clipboard_set_with_data)
+Xen_wrap_1_arg(gxg_gtk_clipboard_get_owner_w, gxg_gtk_clipboard_get_owner)
+Xen_wrap_1_arg(gxg_gtk_clipboard_clear_w, gxg_gtk_clipboard_clear)
+Xen_wrap_3_args(gxg_gtk_clipboard_set_text_w, gxg_gtk_clipboard_set_text)
+Xen_wrap_4_optional_args(gxg_gtk_clipboard_request_contents_w, gxg_gtk_clipboard_request_contents)
+Xen_wrap_3_optional_args(gxg_gtk_clipboard_request_text_w, gxg_gtk_clipboard_request_text)
+Xen_wrap_2_args(gxg_gtk_clipboard_wait_for_contents_w, gxg_gtk_clipboard_wait_for_contents)
+Xen_wrap_1_arg(gxg_gtk_clipboard_wait_for_text_w, gxg_gtk_clipboard_wait_for_text)
+Xen_wrap_1_arg(gxg_gtk_clipboard_wait_is_text_available_w, gxg_gtk_clipboard_wait_is_text_available)
+Xen_wrap_2_args(gxg_gtk_container_set_border_width_w, gxg_gtk_container_set_border_width)
+Xen_wrap_1_arg(gxg_gtk_container_get_border_width_w, gxg_gtk_container_get_border_width)
+Xen_wrap_2_args(gxg_gtk_container_add_w, gxg_gtk_container_add)
+Xen_wrap_2_args(gxg_gtk_container_remove_w, gxg_gtk_container_remove)
+Xen_wrap_1_arg(gxg_gtk_container_check_resize_w, gxg_gtk_container_check_resize)
+Xen_wrap_3_optional_args(gxg_gtk_container_foreach_w, gxg_gtk_container_foreach)
+Xen_wrap_1_arg(gxg_gtk_container_get_children_w, gxg_gtk_container_get_children)
+Xen_wrap_no_args(gxg_gtk_dialog_new_w, gxg_gtk_dialog_new)
+Xen_wrap_3_args(gxg_gtk_dialog_add_action_widget_w, gxg_gtk_dialog_add_action_widget)
+Xen_wrap_3_args(gxg_gtk_dialog_add_button_w, gxg_gtk_dialog_add_button)
+Xen_wrap_2_args(gxg_gtk_dialog_add_buttons_w, gxg_gtk_dialog_add_buttons)
+Xen_wrap_3_args(gxg_gtk_dialog_set_response_sensitive_w, gxg_gtk_dialog_set_response_sensitive)
+Xen_wrap_2_args(gxg_gtk_dialog_set_default_response_w, gxg_gtk_dialog_set_default_response)
+Xen_wrap_2_args(gxg_gtk_dialog_response_w, gxg_gtk_dialog_response)
+Xen_wrap_1_arg(gxg_gtk_dialog_run_w, gxg_gtk_dialog_run)
+Xen_wrap_4_args(gxg_gtk_drag_get_data_w, gxg_gtk_drag_get_data)
+Xen_wrap_4_args(gxg_gtk_drag_finish_w, gxg_gtk_drag_finish)
+Xen_wrap_1_arg(gxg_gtk_drag_get_source_widget_w, gxg_gtk_drag_get_source_widget)
+Xen_wrap_1_arg(gxg_gtk_drag_highlight_w, gxg_gtk_drag_highlight)
+Xen_wrap_1_arg(gxg_gtk_drag_unhighlight_w, gxg_gtk_drag_unhighlight)
+Xen_wrap_5_args(gxg_gtk_drag_dest_set_w, gxg_gtk_drag_dest_set)
+Xen_wrap_1_arg(gxg_gtk_drag_dest_unset_w, gxg_gtk_drag_dest_unset)
+Xen_wrap_3_args(gxg_gtk_drag_dest_find_target_w, gxg_gtk_drag_dest_find_target)
+Xen_wrap_1_arg(gxg_gtk_drag_dest_get_target_list_w, gxg_gtk_drag_dest_get_target_list)
+Xen_wrap_2_args(gxg_gtk_drag_dest_set_target_list_w, gxg_gtk_drag_dest_set_target_list)
+Xen_wrap_5_args(gxg_gtk_drag_source_set_w, gxg_gtk_drag_source_set)
+Xen_wrap_1_arg(gxg_gtk_drag_source_unset_w, gxg_gtk_drag_source_unset)
+Xen_wrap_2_args(gxg_gtk_drag_source_set_icon_pixbuf_w, gxg_gtk_drag_source_set_icon_pixbuf)
+Xen_wrap_4_args(gxg_gtk_drag_set_icon_widget_w, gxg_gtk_drag_set_icon_widget)
+Xen_wrap_4_args(gxg_gtk_drag_set_icon_pixbuf_w, gxg_gtk_drag_set_icon_pixbuf)
+Xen_wrap_1_arg(gxg_gtk_drag_set_icon_default_w, gxg_gtk_drag_set_icon_default)
+Xen_wrap_5_args(gxg_gtk_drag_check_threshold_w, gxg_gtk_drag_check_threshold)
+Xen_wrap_no_args(gxg_gtk_drawing_area_new_w, gxg_gtk_drawing_area_new)
+Xen_wrap_3_args(gxg_gtk_editable_select_region_w, gxg_gtk_editable_select_region)
+Xen_wrap_3_optional_args(gxg_gtk_editable_get_selection_bounds_w, gxg_gtk_editable_get_selection_bounds)
+Xen_wrap_4_optional_args(gxg_gtk_editable_insert_text_w, gxg_gtk_editable_insert_text)
+Xen_wrap_3_args(gxg_gtk_editable_delete_text_w, gxg_gtk_editable_delete_text)
+Xen_wrap_3_args(gxg_gtk_editable_get_chars_w, gxg_gtk_editable_get_chars)
+Xen_wrap_1_arg(gxg_gtk_editable_cut_clipboard_w, gxg_gtk_editable_cut_clipboard)
+Xen_wrap_1_arg(gxg_gtk_editable_copy_clipboard_w, gxg_gtk_editable_copy_clipboard)
+Xen_wrap_1_arg(gxg_gtk_editable_paste_clipboard_w, gxg_gtk_editable_paste_clipboard)
+Xen_wrap_1_arg(gxg_gtk_editable_delete_selection_w, gxg_gtk_editable_delete_selection)
+Xen_wrap_2_args(gxg_gtk_editable_set_position_w, gxg_gtk_editable_set_position)
+Xen_wrap_1_arg(gxg_gtk_editable_get_position_w, gxg_gtk_editable_get_position)
+Xen_wrap_2_args(gxg_gtk_editable_set_editable_w, gxg_gtk_editable_set_editable)
+Xen_wrap_1_arg(gxg_gtk_editable_get_editable_w, gxg_gtk_editable_get_editable)
+Xen_wrap_no_args(gxg_gtk_entry_new_w, gxg_gtk_entry_new)
+Xen_wrap_2_args(gxg_gtk_entry_set_visibility_w, gxg_gtk_entry_set_visibility)
+Xen_wrap_1_arg(gxg_gtk_entry_get_visibility_w, gxg_gtk_entry_get_visibility)
+Xen_wrap_2_args(gxg_gtk_entry_set_invisible_char_w, gxg_gtk_entry_set_invisible_char)
+Xen_wrap_1_arg(gxg_gtk_entry_get_invisible_char_w, gxg_gtk_entry_get_invisible_char)
+Xen_wrap_2_args(gxg_gtk_entry_set_has_frame_w, gxg_gtk_entry_set_has_frame)
+Xen_wrap_1_arg(gxg_gtk_entry_get_has_frame_w, gxg_gtk_entry_get_has_frame)
+Xen_wrap_2_args(gxg_gtk_entry_set_max_length_w, gxg_gtk_entry_set_max_length)
+Xen_wrap_1_arg(gxg_gtk_entry_get_max_length_w, gxg_gtk_entry_get_max_length)
+Xen_wrap_2_args(gxg_gtk_entry_set_activates_default_w, gxg_gtk_entry_set_activates_default)
+Xen_wrap_1_arg(gxg_gtk_entry_get_activates_default_w, gxg_gtk_entry_get_activates_default)
+Xen_wrap_2_args(gxg_gtk_entry_set_width_chars_w, gxg_gtk_entry_set_width_chars)
+Xen_wrap_1_arg(gxg_gtk_entry_get_width_chars_w, gxg_gtk_entry_get_width_chars)
+Xen_wrap_2_args(gxg_gtk_entry_set_text_w, gxg_gtk_entry_set_text)
+Xen_wrap_1_arg(gxg_gtk_entry_get_text_w, gxg_gtk_entry_get_text)
+Xen_wrap_1_arg(gxg_gtk_entry_get_layout_w, gxg_gtk_entry_get_layout)
+Xen_wrap_3_optional_args(gxg_gtk_entry_get_layout_offsets_w, gxg_gtk_entry_get_layout_offsets)
+Xen_wrap_no_args(gxg_gtk_event_box_new_w, gxg_gtk_event_box_new)
+Xen_wrap_no_args(gxg_gtk_fixed_new_w, gxg_gtk_fixed_new)
+Xen_wrap_4_args(gxg_gtk_fixed_put_w, gxg_gtk_fixed_put)
+Xen_wrap_4_args(gxg_gtk_fixed_move_w, gxg_gtk_fixed_move)
+Xen_wrap_1_arg(gxg_gtk_frame_new_w, gxg_gtk_frame_new)
+Xen_wrap_2_args(gxg_gtk_frame_set_label_w, gxg_gtk_frame_set_label)
+Xen_wrap_1_arg(gxg_gtk_frame_get_label_w, gxg_gtk_frame_get_label)
+Xen_wrap_2_args(gxg_gtk_frame_set_label_widget_w, gxg_gtk_frame_set_label_widget)
+Xen_wrap_1_arg(gxg_gtk_frame_get_label_widget_w, gxg_gtk_frame_get_label_widget)
+Xen_wrap_3_args(gxg_gtk_frame_set_label_align_w, gxg_gtk_frame_set_label_align)
+Xen_wrap_3_optional_args(gxg_gtk_frame_get_label_align_w, gxg_gtk_frame_get_label_align)
+Xen_wrap_2_args(gxg_gtk_frame_set_shadow_type_w, gxg_gtk_frame_set_shadow_type)
+Xen_wrap_1_arg(gxg_gtk_frame_get_shadow_type_w, gxg_gtk_frame_get_shadow_type)
+Xen_wrap_no_args(gxg_gtk_image_new_w, gxg_gtk_image_new)
+Xen_wrap_1_arg(gxg_gtk_image_new_from_file_w, gxg_gtk_image_new_from_file)
+Xen_wrap_1_arg(gxg_gtk_image_new_from_pixbuf_w, gxg_gtk_image_new_from_pixbuf)
+Xen_wrap_1_arg(gxg_gtk_image_new_from_animation_w, gxg_gtk_image_new_from_animation)
+Xen_wrap_2_args(gxg_gtk_image_set_from_file_w, gxg_gtk_image_set_from_file)
+Xen_wrap_2_args(gxg_gtk_image_set_from_pixbuf_w, gxg_gtk_image_set_from_pixbuf)
+Xen_wrap_2_args(gxg_gtk_image_set_from_animation_w, gxg_gtk_image_set_from_animation)
+Xen_wrap_1_arg(gxg_gtk_image_get_storage_type_w, gxg_gtk_image_get_storage_type)
+Xen_wrap_1_arg(gxg_gtk_image_get_pixbuf_w, gxg_gtk_image_get_pixbuf)
+Xen_wrap_1_arg(gxg_gtk_image_get_animation_w, gxg_gtk_image_get_animation)
+Xen_wrap_2_args(gxg_gtk_im_context_set_client_window_w, gxg_gtk_im_context_set_client_window)
+Xen_wrap_4_optional_args(gxg_gtk_im_context_get_preedit_string_w, gxg_gtk_im_context_get_preedit_string)
+Xen_wrap_2_args(gxg_gtk_im_context_filter_keypress_w, gxg_gtk_im_context_filter_keypress)
+Xen_wrap_1_arg(gxg_gtk_im_context_focus_in_w, gxg_gtk_im_context_focus_in)
+Xen_wrap_1_arg(gxg_gtk_im_context_focus_out_w, gxg_gtk_im_context_focus_out)
+Xen_wrap_1_arg(gxg_gtk_im_context_reset_w, gxg_gtk_im_context_reset)
+Xen_wrap_2_args(gxg_gtk_im_context_set_cursor_location_w, gxg_gtk_im_context_set_cursor_location)
+Xen_wrap_2_args(gxg_gtk_im_context_set_use_preedit_w, gxg_gtk_im_context_set_use_preedit)
+Xen_wrap_4_args(gxg_gtk_im_context_set_surrounding_w, gxg_gtk_im_context_set_surrounding)
+Xen_wrap_3_optional_args(gxg_gtk_im_context_get_surrounding_w, gxg_gtk_im_context_get_surrounding)
+Xen_wrap_3_args(gxg_gtk_im_context_delete_surrounding_w, gxg_gtk_im_context_delete_surrounding)
+Xen_wrap_no_args(gxg_gtk_im_context_simple_new_w, gxg_gtk_im_context_simple_new)
+Xen_wrap_4_args(gxg_gtk_im_context_simple_add_table_w, gxg_gtk_im_context_simple_add_table)
+Xen_wrap_no_args(gxg_gtk_invisible_new_w, gxg_gtk_invisible_new)
+Xen_wrap_1_arg(gxg_gtk_label_new_w, gxg_gtk_label_new)
+Xen_wrap_1_arg(gxg_gtk_label_new_with_mnemonic_w, gxg_gtk_label_new_with_mnemonic)
+Xen_wrap_2_args(gxg_gtk_label_set_text_w, gxg_gtk_label_set_text)
+Xen_wrap_1_arg(gxg_gtk_label_get_text_w, gxg_gtk_label_get_text)
+Xen_wrap_2_args(gxg_gtk_label_set_attributes_w, gxg_gtk_label_set_attributes)
+Xen_wrap_1_arg(gxg_gtk_label_get_attributes_w, gxg_gtk_label_get_attributes)
+Xen_wrap_2_args(gxg_gtk_label_set_label_w, gxg_gtk_label_set_label)
+Xen_wrap_1_arg(gxg_gtk_label_get_label_w, gxg_gtk_label_get_label)
+Xen_wrap_2_args(gxg_gtk_label_set_markup_w, gxg_gtk_label_set_markup)
+Xen_wrap_2_args(gxg_gtk_label_set_use_markup_w, gxg_gtk_label_set_use_markup)
+Xen_wrap_1_arg(gxg_gtk_label_get_use_markup_w, gxg_gtk_label_get_use_markup)
+Xen_wrap_2_args(gxg_gtk_label_set_use_underline_w, gxg_gtk_label_set_use_underline)
+Xen_wrap_1_arg(gxg_gtk_label_get_use_underline_w, gxg_gtk_label_get_use_underline)
+Xen_wrap_2_args(gxg_gtk_label_set_markup_with_mnemonic_w, gxg_gtk_label_set_markup_with_mnemonic)
+Xen_wrap_1_arg(gxg_gtk_label_get_mnemonic_keyval_w, gxg_gtk_label_get_mnemonic_keyval)
+Xen_wrap_2_args(gxg_gtk_label_set_mnemonic_widget_w, gxg_gtk_label_set_mnemonic_widget)
+Xen_wrap_1_arg(gxg_gtk_label_get_mnemonic_widget_w, gxg_gtk_label_get_mnemonic_widget)
+Xen_wrap_2_args(gxg_gtk_label_set_text_with_mnemonic_w, gxg_gtk_label_set_text_with_mnemonic)
+Xen_wrap_2_args(gxg_gtk_label_set_justify_w, gxg_gtk_label_set_justify)
+Xen_wrap_1_arg(gxg_gtk_label_get_justify_w, gxg_gtk_label_get_justify)
+Xen_wrap_2_args(gxg_gtk_label_set_pattern_w, gxg_gtk_label_set_pattern)
+Xen_wrap_2_args(gxg_gtk_label_set_line_wrap_w, gxg_gtk_label_set_line_wrap)
+Xen_wrap_1_arg(gxg_gtk_label_get_line_wrap_w, gxg_gtk_label_get_line_wrap)
+Xen_wrap_2_args(gxg_gtk_label_set_selectable_w, gxg_gtk_label_set_selectable)
+Xen_wrap_1_arg(gxg_gtk_label_get_selectable_w, gxg_gtk_label_get_selectable)
+Xen_wrap_3_args(gxg_gtk_label_select_region_w, gxg_gtk_label_select_region)
+Xen_wrap_3_optional_args(gxg_gtk_label_get_selection_bounds_w, gxg_gtk_label_get_selection_bounds)
+Xen_wrap_1_arg(gxg_gtk_label_get_layout_w, gxg_gtk_label_get_layout)
+Xen_wrap_3_optional_args(gxg_gtk_label_get_layout_offsets_w, gxg_gtk_label_get_layout_offsets)
+Xen_wrap_2_args(gxg_gtk_layout_new_w, gxg_gtk_layout_new)
+Xen_wrap_4_args(gxg_gtk_layout_put_w, gxg_gtk_layout_put)
+Xen_wrap_4_args(gxg_gtk_layout_move_w, gxg_gtk_layout_move)
+Xen_wrap_3_args(gxg_gtk_layout_set_size_w, gxg_gtk_layout_set_size)
+Xen_wrap_3_optional_args(gxg_gtk_layout_get_size_w, gxg_gtk_layout_get_size)
+Xen_wrap_2_args(gxg_gtk_list_store_new_w, gxg_gtk_list_store_new)
+Xen_wrap_2_args(gxg_gtk_list_store_newv_w, gxg_gtk_list_store_newv)
+Xen_wrap_3_args(gxg_gtk_list_store_set_column_types_w, gxg_gtk_list_store_set_column_types)
+Xen_wrap_3_args(gxg_gtk_list_store_set_w, gxg_gtk_list_store_set)
+Xen_wrap_3_args(gxg_gtk_list_store_insert_w, gxg_gtk_list_store_insert)
+Xen_wrap_3_args(gxg_gtk_list_store_insert_before_w, gxg_gtk_list_store_insert_before)
+Xen_wrap_3_args(gxg_gtk_list_store_insert_after_w, gxg_gtk_list_store_insert_after)
+Xen_wrap_2_args(gxg_gtk_list_store_prepend_w, gxg_gtk_list_store_prepend)
+Xen_wrap_2_args(gxg_gtk_list_store_append_w, gxg_gtk_list_store_append)
+Xen_wrap_1_arg(gxg_gtk_list_store_clear_w, gxg_gtk_list_store_clear)
+Xen_wrap_3_args(gxg_gtk_check_version_w, gxg_gtk_check_version)
+Xen_wrap_no_args(gxg_gtk_disable_setlocale_w, gxg_gtk_disable_setlocale)
+Xen_wrap_no_args(gxg_gtk_get_default_language_w, gxg_gtk_get_default_language)
+Xen_wrap_no_args(gxg_gtk_events_pending_w, gxg_gtk_events_pending)
+Xen_wrap_1_arg(gxg_gtk_main_do_event_w, gxg_gtk_main_do_event)
+Xen_wrap_no_args(gxg_gtk_main_w, gxg_gtk_main)
+Xen_wrap_no_args(gxg_gtk_main_level_w, gxg_gtk_main_level)
+Xen_wrap_no_args(gxg_gtk_main_quit_w, gxg_gtk_main_quit)
+Xen_wrap_no_args(gxg_gtk_main_iteration_w, gxg_gtk_main_iteration)
+Xen_wrap_1_arg(gxg_gtk_main_iteration_do_w, gxg_gtk_main_iteration_do)
+Xen_wrap_no_args(gxg_gtk_true_w, gxg_gtk_true)
+Xen_wrap_no_args(gxg_gtk_false_w, gxg_gtk_false)
+Xen_wrap_1_arg(gxg_gtk_grab_add_w, gxg_gtk_grab_add)
+Xen_wrap_no_args(gxg_gtk_grab_get_current_w, gxg_gtk_grab_get_current)
+Xen_wrap_1_arg(gxg_gtk_grab_remove_w, gxg_gtk_grab_remove)
+Xen_wrap_no_args(gxg_gtk_get_current_event_w, gxg_gtk_get_current_event)
+Xen_wrap_no_args(gxg_gtk_get_current_event_time_w, gxg_gtk_get_current_event_time)
+Xen_wrap_1_optional_arg(gxg_gtk_get_current_event_state_w, gxg_gtk_get_current_event_state)
+Xen_wrap_1_arg(gxg_gtk_get_event_widget_w, gxg_gtk_get_event_widget)
+Xen_wrap_2_args(gxg_gtk_propagate_event_w, gxg_gtk_propagate_event)
+Xen_wrap_no_args(gxg_gtk_menu_bar_new_w, gxg_gtk_menu_bar_new)
+Xen_wrap_no_args(gxg_gtk_menu_new_w, gxg_gtk_menu_new)
+Xen_wrap_7_args(gxg_gtk_menu_popup_w, gxg_gtk_menu_popup)
+Xen_wrap_1_arg(gxg_gtk_menu_reposition_w, gxg_gtk_menu_reposition)
+Xen_wrap_1_arg(gxg_gtk_menu_popdown_w, gxg_gtk_menu_popdown)
+Xen_wrap_1_arg(gxg_gtk_menu_get_active_w, gxg_gtk_menu_get_active)
+Xen_wrap_2_args(gxg_gtk_menu_set_active_w, gxg_gtk_menu_set_active)
+Xen_wrap_2_args(gxg_gtk_menu_set_accel_group_w, gxg_gtk_menu_set_accel_group)
+Xen_wrap_1_arg(gxg_gtk_menu_get_accel_group_w, gxg_gtk_menu_get_accel_group)
+Xen_wrap_2_args(gxg_gtk_menu_set_accel_path_w, gxg_gtk_menu_set_accel_path)
+Xen_wrap_1_arg(gxg_gtk_menu_detach_w, gxg_gtk_menu_detach)
+Xen_wrap_1_arg(gxg_gtk_menu_get_attach_widget_w, gxg_gtk_menu_get_attach_widget)
+Xen_wrap_3_args(gxg_gtk_menu_reorder_child_w, gxg_gtk_menu_reorder_child)
+Xen_wrap_2_args(gxg_gtk_menu_set_monitor_w, gxg_gtk_menu_set_monitor)
+Xen_wrap_no_args(gxg_gtk_menu_item_new_w, gxg_gtk_menu_item_new)
+Xen_wrap_1_arg(gxg_gtk_menu_item_new_with_label_w, gxg_gtk_menu_item_new_with_label)
+Xen_wrap_1_arg(gxg_gtk_menu_item_new_with_mnemonic_w, gxg_gtk_menu_item_new_with_mnemonic)
+Xen_wrap_2_args(gxg_gtk_menu_item_set_submenu_w, gxg_gtk_menu_item_set_submenu)
+Xen_wrap_1_arg(gxg_gtk_menu_item_get_submenu_w, gxg_gtk_menu_item_get_submenu)
+Xen_wrap_1_arg(gxg_gtk_menu_item_select_w, gxg_gtk_menu_item_select)
+Xen_wrap_1_arg(gxg_gtk_menu_item_deselect_w, gxg_gtk_menu_item_deselect)
+Xen_wrap_1_arg(gxg_gtk_menu_item_activate_w, gxg_gtk_menu_item_activate)
+Xen_wrap_2_args(gxg_gtk_menu_item_toggle_size_request_w, gxg_gtk_menu_item_toggle_size_request)
+Xen_wrap_2_args(gxg_gtk_menu_item_toggle_size_allocate_w, gxg_gtk_menu_item_toggle_size_allocate)
+Xen_wrap_2_args(gxg_gtk_menu_item_set_accel_path_w, gxg_gtk_menu_item_set_accel_path)
+Xen_wrap_2_args(gxg_gtk_menu_shell_append_w, gxg_gtk_menu_shell_append)
+Xen_wrap_2_args(gxg_gtk_menu_shell_prepend_w, gxg_gtk_menu_shell_prepend)
+Xen_wrap_3_args(gxg_gtk_menu_shell_insert_w, gxg_gtk_menu_shell_insert)
+Xen_wrap_1_arg(gxg_gtk_menu_shell_deactivate_w, gxg_gtk_menu_shell_deactivate)
+Xen_wrap_2_args(gxg_gtk_menu_shell_select_item_w, gxg_gtk_menu_shell_select_item)
+Xen_wrap_1_arg(gxg_gtk_menu_shell_deselect_w, gxg_gtk_menu_shell_deselect)
+Xen_wrap_3_args(gxg_gtk_menu_shell_activate_item_w, gxg_gtk_menu_shell_activate_item)
+Xen_wrap_no_args(gxg_gtk_notebook_new_w, gxg_gtk_notebook_new)
+Xen_wrap_2_args(gxg_gtk_notebook_remove_page_w, gxg_gtk_notebook_remove_page)
+Xen_wrap_1_arg(gxg_gtk_notebook_get_current_page_w, gxg_gtk_notebook_get_current_page)
+Xen_wrap_2_args(gxg_gtk_notebook_get_nth_page_w, gxg_gtk_notebook_get_nth_page)
+Xen_wrap_2_args(gxg_gtk_notebook_page_num_w, gxg_gtk_notebook_page_num)
+Xen_wrap_2_args(gxg_gtk_notebook_set_current_page_w, gxg_gtk_notebook_set_current_page)
+Xen_wrap_1_arg(gxg_gtk_notebook_next_page_w, gxg_gtk_notebook_next_page)
+Xen_wrap_1_arg(gxg_gtk_notebook_prev_page_w, gxg_gtk_notebook_prev_page)
+Xen_wrap_2_args(gxg_gtk_notebook_set_show_border_w, gxg_gtk_notebook_set_show_border)
+Xen_wrap_1_arg(gxg_gtk_notebook_get_show_border_w, gxg_gtk_notebook_get_show_border)
+Xen_wrap_2_args(gxg_gtk_notebook_set_show_tabs_w, gxg_gtk_notebook_set_show_tabs)
+Xen_wrap_1_arg(gxg_gtk_notebook_get_show_tabs_w, gxg_gtk_notebook_get_show_tabs)
+Xen_wrap_2_args(gxg_gtk_notebook_set_tab_pos_w, gxg_gtk_notebook_set_tab_pos)
+Xen_wrap_1_arg(gxg_gtk_notebook_get_tab_pos_w, gxg_gtk_notebook_get_tab_pos)
+Xen_wrap_2_args(gxg_gtk_notebook_set_scrollable_w, gxg_gtk_notebook_set_scrollable)
+Xen_wrap_1_arg(gxg_gtk_notebook_get_scrollable_w, gxg_gtk_notebook_get_scrollable)
+Xen_wrap_1_arg(gxg_gtk_notebook_popup_enable_w, gxg_gtk_notebook_popup_enable)
+Xen_wrap_1_arg(gxg_gtk_notebook_popup_disable_w, gxg_gtk_notebook_popup_disable)
+Xen_wrap_2_args(gxg_gtk_notebook_get_tab_label_w, gxg_gtk_notebook_get_tab_label)
+Xen_wrap_3_args(gxg_gtk_notebook_set_tab_label_w, gxg_gtk_notebook_set_tab_label)
+Xen_wrap_3_args(gxg_gtk_notebook_set_tab_label_text_w, gxg_gtk_notebook_set_tab_label_text)
+Xen_wrap_2_args(gxg_gtk_notebook_get_tab_label_text_w, gxg_gtk_notebook_get_tab_label_text)
+Xen_wrap_2_args(gxg_gtk_notebook_get_menu_label_w, gxg_gtk_notebook_get_menu_label)
+Xen_wrap_3_args(gxg_gtk_notebook_set_menu_label_w, gxg_gtk_notebook_set_menu_label)
+Xen_wrap_3_args(gxg_gtk_notebook_set_menu_label_text_w, gxg_gtk_notebook_set_menu_label_text)
+Xen_wrap_2_args(gxg_gtk_notebook_get_menu_label_text_w, gxg_gtk_notebook_get_menu_label_text)
+Xen_wrap_3_args(gxg_gtk_notebook_reorder_child_w, gxg_gtk_notebook_reorder_child)
+Xen_wrap_3_args(gxg_gtk_notebook_append_page_w, gxg_gtk_notebook_append_page)
+Xen_wrap_4_args(gxg_gtk_notebook_append_page_menu_w, gxg_gtk_notebook_append_page_menu)
+Xen_wrap_3_args(gxg_gtk_notebook_prepend_page_w, gxg_gtk_notebook_prepend_page)
+Xen_wrap_4_args(gxg_gtk_notebook_prepend_page_menu_w, gxg_gtk_notebook_prepend_page_menu)
+Xen_wrap_4_args(gxg_gtk_notebook_insert_page_w, gxg_gtk_notebook_insert_page)
+Xen_wrap_5_args(gxg_gtk_notebook_insert_page_menu_w, gxg_gtk_notebook_insert_page_menu)
+Xen_wrap_2_args(gxg_gtk_paned_add1_w, gxg_gtk_paned_add1)
+Xen_wrap_2_args(gxg_gtk_paned_add2_w, gxg_gtk_paned_add2)
+Xen_wrap_4_args(gxg_gtk_paned_pack1_w, gxg_gtk_paned_pack1)
+Xen_wrap_4_args(gxg_gtk_paned_pack2_w, gxg_gtk_paned_pack2)
+Xen_wrap_1_arg(gxg_gtk_paned_get_position_w, gxg_gtk_paned_get_position)
+Xen_wrap_2_args(gxg_gtk_paned_set_position_w, gxg_gtk_paned_set_position)
+Xen_wrap_no_args(gxg_gtk_progress_bar_new_w, gxg_gtk_progress_bar_new)
+Xen_wrap_1_arg(gxg_gtk_progress_bar_pulse_w, gxg_gtk_progress_bar_pulse)
+Xen_wrap_2_args(gxg_gtk_progress_bar_set_text_w, gxg_gtk_progress_bar_set_text)
+Xen_wrap_2_args(gxg_gtk_progress_bar_set_fraction_w, gxg_gtk_progress_bar_set_fraction)
+Xen_wrap_2_args(gxg_gtk_progress_bar_set_pulse_step_w, gxg_gtk_progress_bar_set_pulse_step)
+Xen_wrap_1_arg(gxg_gtk_progress_bar_get_text_w, gxg_gtk_progress_bar_get_text)
+Xen_wrap_1_arg(gxg_gtk_progress_bar_get_fraction_w, gxg_gtk_progress_bar_get_fraction)
+Xen_wrap_1_arg(gxg_gtk_progress_bar_get_pulse_step_w, gxg_gtk_progress_bar_get_pulse_step)
+Xen_wrap_1_arg(gxg_gtk_radio_button_new_w, gxg_gtk_radio_button_new)
+Xen_wrap_1_arg(gxg_gtk_radio_button_new_from_widget_w, gxg_gtk_radio_button_new_from_widget)
+Xen_wrap_2_args(gxg_gtk_radio_button_new_with_label_w, gxg_gtk_radio_button_new_with_label)
+Xen_wrap_2_args(gxg_gtk_radio_button_new_with_label_from_widget_w, gxg_gtk_radio_button_new_with_label_from_widget)
+Xen_wrap_2_args(gxg_gtk_radio_button_new_with_mnemonic_w, gxg_gtk_radio_button_new_with_mnemonic)
+Xen_wrap_2_args(gxg_gtk_radio_button_new_with_mnemonic_from_widget_w, gxg_gtk_radio_button_new_with_mnemonic_from_widget)
+Xen_wrap_1_arg(gxg_gtk_radio_button_get_group_w, gxg_gtk_radio_button_get_group)
+Xen_wrap_2_args(gxg_gtk_radio_button_set_group_w, gxg_gtk_radio_button_set_group)
+Xen_wrap_1_arg(gxg_gtk_radio_menu_item_new_w, gxg_gtk_radio_menu_item_new)
+Xen_wrap_2_args(gxg_gtk_radio_menu_item_new_with_label_w, gxg_gtk_radio_menu_item_new_with_label)
+Xen_wrap_2_args(gxg_gtk_radio_menu_item_new_with_mnemonic_w, gxg_gtk_radio_menu_item_new_with_mnemonic)
+Xen_wrap_1_arg(gxg_gtk_radio_menu_item_get_group_w, gxg_gtk_radio_menu_item_get_group)
+Xen_wrap_2_args(gxg_gtk_radio_menu_item_set_group_w, gxg_gtk_radio_menu_item_set_group)
+Xen_wrap_2_args(gxg_gtk_range_set_adjustment_w, gxg_gtk_range_set_adjustment)
+Xen_wrap_1_arg(gxg_gtk_range_get_adjustment_w, gxg_gtk_range_get_adjustment)
+Xen_wrap_2_args(gxg_gtk_range_set_inverted_w, gxg_gtk_range_set_inverted)
+Xen_wrap_1_arg(gxg_gtk_range_get_inverted_w, gxg_gtk_range_get_inverted)
+Xen_wrap_3_args(gxg_gtk_range_set_increments_w, gxg_gtk_range_set_increments)
+Xen_wrap_3_args(gxg_gtk_range_set_range_w, gxg_gtk_range_set_range)
+Xen_wrap_2_args(gxg_gtk_range_set_value_w, gxg_gtk_range_set_value)
+Xen_wrap_1_arg(gxg_gtk_range_get_value_w, gxg_gtk_range_get_value)
+Xen_wrap_2_args(gxg_gtk_scale_set_digits_w, gxg_gtk_scale_set_digits)
+Xen_wrap_1_arg(gxg_gtk_scale_get_digits_w, gxg_gtk_scale_get_digits)
+Xen_wrap_2_args(gxg_gtk_scale_set_draw_value_w, gxg_gtk_scale_set_draw_value)
+Xen_wrap_1_arg(gxg_gtk_scale_get_draw_value_w, gxg_gtk_scale_get_draw_value)
+Xen_wrap_2_args(gxg_gtk_scale_set_value_pos_w, gxg_gtk_scale_set_value_pos)
+Xen_wrap_1_arg(gxg_gtk_scale_get_value_pos_w, gxg_gtk_scale_get_value_pos)
+Xen_wrap_2_args(gxg_gtk_scrolled_window_new_w, gxg_gtk_scrolled_window_new)
+Xen_wrap_2_args(gxg_gtk_scrolled_window_set_hadjustment_w, gxg_gtk_scrolled_window_set_hadjustment)
+Xen_wrap_2_args(gxg_gtk_scrolled_window_set_vadjustment_w, gxg_gtk_scrolled_window_set_vadjustment)
+Xen_wrap_1_arg(gxg_gtk_scrolled_window_get_hadjustment_w, gxg_gtk_scrolled_window_get_hadjustment)
+Xen_wrap_1_arg(gxg_gtk_scrolled_window_get_vadjustment_w, gxg_gtk_scrolled_window_get_vadjustment)
+Xen_wrap_3_args(gxg_gtk_scrolled_window_set_policy_w, gxg_gtk_scrolled_window_set_policy)
+Xen_wrap_3_optional_args(gxg_gtk_scrolled_window_get_policy_w, gxg_gtk_scrolled_window_get_policy)
+Xen_wrap_2_args(gxg_gtk_scrolled_window_set_placement_w, gxg_gtk_scrolled_window_set_placement)
+Xen_wrap_1_arg(gxg_gtk_scrolled_window_get_placement_w, gxg_gtk_scrolled_window_get_placement)
+Xen_wrap_2_args(gxg_gtk_scrolled_window_set_shadow_type_w, gxg_gtk_scrolled_window_set_shadow_type)
+Xen_wrap_1_arg(gxg_gtk_scrolled_window_get_shadow_type_w, gxg_gtk_scrolled_window_get_shadow_type)
+Xen_wrap_2_args(gxg_gtk_target_list_new_w, gxg_gtk_target_list_new)
+Xen_wrap_1_arg(gxg_gtk_target_list_unref_w, gxg_gtk_target_list_unref)
+Xen_wrap_4_args(gxg_gtk_target_list_add_w, gxg_gtk_target_list_add)
+Xen_wrap_3_args(gxg_gtk_target_list_add_table_w, gxg_gtk_target_list_add_table)
+Xen_wrap_2_args(gxg_gtk_target_list_remove_w, gxg_gtk_target_list_remove)
+Xen_wrap_3_optional_args(gxg_gtk_target_list_find_w, gxg_gtk_target_list_find)
+Xen_wrap_3_args(gxg_gtk_selection_owner_set_w, gxg_gtk_selection_owner_set)
+Xen_wrap_4_args(gxg_gtk_selection_add_target_w, gxg_gtk_selection_add_target)
+Xen_wrap_4_args(gxg_gtk_selection_add_targets_w, gxg_gtk_selection_add_targets)
+Xen_wrap_2_args(gxg_gtk_selection_clear_targets_w, gxg_gtk_selection_clear_targets)
+Xen_wrap_4_args(gxg_gtk_selection_convert_w, gxg_gtk_selection_convert)
+Xen_wrap_5_args(gxg_gtk_selection_data_set_w, gxg_gtk_selection_data_set)
+Xen_wrap_3_args(gxg_gtk_selection_data_set_text_w, gxg_gtk_selection_data_set_text)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_text_w, gxg_gtk_selection_data_get_text)
+Xen_wrap_3_optional_args(gxg_gtk_selection_data_get_targets_w, gxg_gtk_selection_data_get_targets)
+Xen_wrap_1_arg(gxg_gtk_selection_data_targets_include_text_w, gxg_gtk_selection_data_targets_include_text)
+Xen_wrap_1_arg(gxg_gtk_selection_remove_all_w, gxg_gtk_selection_remove_all)
+Xen_wrap_1_arg(gxg_gtk_selection_data_copy_w, gxg_gtk_selection_data_copy)
+Xen_wrap_1_arg(gxg_gtk_selection_data_free_w, gxg_gtk_selection_data_free)
+Xen_wrap_no_args(gxg_gtk_separator_menu_item_new_w, gxg_gtk_separator_menu_item_new)
+Xen_wrap_no_args(gxg_gtk_settings_get_default_w, gxg_gtk_settings_get_default)
+Xen_wrap_1_arg(gxg_gtk_size_group_new_w, gxg_gtk_size_group_new)
+Xen_wrap_2_args(gxg_gtk_size_group_set_mode_w, gxg_gtk_size_group_set_mode)
+Xen_wrap_1_arg(gxg_gtk_size_group_get_mode_w, gxg_gtk_size_group_get_mode)
+Xen_wrap_2_args(gxg_gtk_size_group_add_widget_w, gxg_gtk_size_group_add_widget)
+Xen_wrap_2_args(gxg_gtk_size_group_remove_widget_w, gxg_gtk_size_group_remove_widget)
+Xen_wrap_4_args(gxg_gtk_spin_button_configure_w, gxg_gtk_spin_button_configure)
+Xen_wrap_3_args(gxg_gtk_spin_button_new_w, gxg_gtk_spin_button_new)
+Xen_wrap_3_args(gxg_gtk_spin_button_new_with_range_w, gxg_gtk_spin_button_new_with_range)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_adjustment_w, gxg_gtk_spin_button_set_adjustment)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_adjustment_w, gxg_gtk_spin_button_get_adjustment)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_digits_w, gxg_gtk_spin_button_set_digits)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_digits_w, gxg_gtk_spin_button_get_digits)
+Xen_wrap_3_args(gxg_gtk_spin_button_set_increments_w, gxg_gtk_spin_button_set_increments)
+Xen_wrap_3_optional_args(gxg_gtk_spin_button_get_increments_w, gxg_gtk_spin_button_get_increments)
+Xen_wrap_3_args(gxg_gtk_spin_button_set_range_w, gxg_gtk_spin_button_set_range)
+Xen_wrap_3_optional_args(gxg_gtk_spin_button_get_range_w, gxg_gtk_spin_button_get_range)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_value_w, gxg_gtk_spin_button_get_value)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_value_as_int_w, gxg_gtk_spin_button_get_value_as_int)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_value_w, gxg_gtk_spin_button_set_value)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_update_policy_w, gxg_gtk_spin_button_set_update_policy)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_update_policy_w, gxg_gtk_spin_button_get_update_policy)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_numeric_w, gxg_gtk_spin_button_set_numeric)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_numeric_w, gxg_gtk_spin_button_get_numeric)
+Xen_wrap_3_args(gxg_gtk_spin_button_spin_w, gxg_gtk_spin_button_spin)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_wrap_w, gxg_gtk_spin_button_set_wrap)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_wrap_w, gxg_gtk_spin_button_get_wrap)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_snap_to_ticks_w, gxg_gtk_spin_button_set_snap_to_ticks)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_snap_to_ticks_w, gxg_gtk_spin_button_get_snap_to_ticks)
+Xen_wrap_1_arg(gxg_gtk_spin_button_update_w, gxg_gtk_spin_button_update)
+Xen_wrap_no_args(gxg_gtk_statusbar_new_w, gxg_gtk_statusbar_new)
+Xen_wrap_2_args(gxg_gtk_statusbar_get_context_id_w, gxg_gtk_statusbar_get_context_id)
+Xen_wrap_3_args(gxg_gtk_statusbar_push_w, gxg_gtk_statusbar_push)
+Xen_wrap_2_args(gxg_gtk_statusbar_pop_w, gxg_gtk_statusbar_pop)
+Xen_wrap_3_args(gxg_gtk_statusbar_remove_w, gxg_gtk_statusbar_remove)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_new_w, gxg_gtk_text_buffer_new)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_line_count_w, gxg_gtk_text_buffer_get_line_count)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_char_count_w, gxg_gtk_text_buffer_get_char_count)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_tag_table_w, gxg_gtk_text_buffer_get_tag_table)
+Xen_wrap_3_args(gxg_gtk_text_buffer_set_text_w, gxg_gtk_text_buffer_set_text)
+Xen_wrap_4_args(gxg_gtk_text_buffer_insert_w, gxg_gtk_text_buffer_insert)
+Xen_wrap_3_args(gxg_gtk_text_buffer_insert_at_cursor_w, gxg_gtk_text_buffer_insert_at_cursor)
+Xen_wrap_5_args(gxg_gtk_text_buffer_insert_interactive_w, gxg_gtk_text_buffer_insert_interactive)
+Xen_wrap_4_args(gxg_gtk_text_buffer_insert_interactive_at_cursor_w, gxg_gtk_text_buffer_insert_interactive_at_cursor)
+Xen_wrap_4_args(gxg_gtk_text_buffer_insert_range_w, gxg_gtk_text_buffer_insert_range)
+Xen_wrap_5_args(gxg_gtk_text_buffer_insert_range_interactive_w, gxg_gtk_text_buffer_insert_range_interactive)
+Xen_wrap_5_args(gxg_gtk_text_buffer_insert_with_tags_w, gxg_gtk_text_buffer_insert_with_tags)
+Xen_wrap_5_args(gxg_gtk_text_buffer_insert_with_tags_by_name_w, gxg_gtk_text_buffer_insert_with_tags_by_name)
+Xen_wrap_3_args(gxg_gtk_text_buffer_delete_w, gxg_gtk_text_buffer_delete)
+Xen_wrap_4_args(gxg_gtk_text_buffer_delete_interactive_w, gxg_gtk_text_buffer_delete_interactive)
+Xen_wrap_4_args(gxg_gtk_text_buffer_get_text_w, gxg_gtk_text_buffer_get_text)
+Xen_wrap_4_args(gxg_gtk_text_buffer_get_slice_w, gxg_gtk_text_buffer_get_slice)
+Xen_wrap_3_args(gxg_gtk_text_buffer_insert_pixbuf_w, gxg_gtk_text_buffer_insert_pixbuf)
+Xen_wrap_3_args(gxg_gtk_text_buffer_insert_child_anchor_w, gxg_gtk_text_buffer_insert_child_anchor)
+Xen_wrap_2_args(gxg_gtk_text_buffer_create_child_anchor_w, gxg_gtk_text_buffer_create_child_anchor)
+Xen_wrap_4_args(gxg_gtk_text_buffer_create_mark_w, gxg_gtk_text_buffer_create_mark)
+Xen_wrap_3_args(gxg_gtk_text_buffer_move_mark_w, gxg_gtk_text_buffer_move_mark)
+Xen_wrap_2_args(gxg_gtk_text_buffer_delete_mark_w, gxg_gtk_text_buffer_delete_mark)
+Xen_wrap_2_args(gxg_gtk_text_buffer_get_mark_w, gxg_gtk_text_buffer_get_mark)
+Xen_wrap_3_args(gxg_gtk_text_buffer_move_mark_by_name_w, gxg_gtk_text_buffer_move_mark_by_name)
+Xen_wrap_2_args(gxg_gtk_text_buffer_delete_mark_by_name_w, gxg_gtk_text_buffer_delete_mark_by_name)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_insert_w, gxg_gtk_text_buffer_get_insert)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_selection_bound_w, gxg_gtk_text_buffer_get_selection_bound)
+Xen_wrap_2_args(gxg_gtk_text_buffer_place_cursor_w, gxg_gtk_text_buffer_place_cursor)
+Xen_wrap_4_args(gxg_gtk_text_buffer_apply_tag_w, gxg_gtk_text_buffer_apply_tag)
+Xen_wrap_4_args(gxg_gtk_text_buffer_remove_tag_w, gxg_gtk_text_buffer_remove_tag)
+Xen_wrap_4_args(gxg_gtk_text_buffer_apply_tag_by_name_w, gxg_gtk_text_buffer_apply_tag_by_name)
+Xen_wrap_4_args(gxg_gtk_text_buffer_remove_tag_by_name_w, gxg_gtk_text_buffer_remove_tag_by_name)
+Xen_wrap_3_args(gxg_gtk_text_buffer_remove_all_tags_w, gxg_gtk_text_buffer_remove_all_tags)
+Xen_wrap_3_optional_args(gxg_gtk_text_buffer_create_tag_w, gxg_gtk_text_buffer_create_tag)
+Xen_wrap_4_args(gxg_gtk_text_buffer_get_iter_at_line_offset_w, gxg_gtk_text_buffer_get_iter_at_line_offset)
+Xen_wrap_4_args(gxg_gtk_text_buffer_get_iter_at_line_index_w, gxg_gtk_text_buffer_get_iter_at_line_index)
+Xen_wrap_3_args(gxg_gtk_text_buffer_get_iter_at_offset_w, gxg_gtk_text_buffer_get_iter_at_offset)
+Xen_wrap_3_args(gxg_gtk_text_buffer_get_iter_at_line_w, gxg_gtk_text_buffer_get_iter_at_line)
+Xen_wrap_2_args(gxg_gtk_text_buffer_get_start_iter_w, gxg_gtk_text_buffer_get_start_iter)
+Xen_wrap_2_args(gxg_gtk_text_buffer_get_end_iter_w, gxg_gtk_text_buffer_get_end_iter)
+Xen_wrap_3_args(gxg_gtk_text_buffer_get_bounds_w, gxg_gtk_text_buffer_get_bounds)
+Xen_wrap_3_args(gxg_gtk_text_buffer_get_iter_at_mark_w, gxg_gtk_text_buffer_get_iter_at_mark)
+Xen_wrap_3_args(gxg_gtk_text_buffer_get_iter_at_child_anchor_w, gxg_gtk_text_buffer_get_iter_at_child_anchor)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_modified_w, gxg_gtk_text_buffer_get_modified)
+Xen_wrap_2_args(gxg_gtk_text_buffer_set_modified_w, gxg_gtk_text_buffer_set_modified)
+Xen_wrap_2_args(gxg_gtk_text_buffer_add_selection_clipboard_w, gxg_gtk_text_buffer_add_selection_clipboard)
+Xen_wrap_2_args(gxg_gtk_text_buffer_remove_selection_clipboard_w, gxg_gtk_text_buffer_remove_selection_clipboard)
+Xen_wrap_3_args(gxg_gtk_text_buffer_cut_clipboard_w, gxg_gtk_text_buffer_cut_clipboard)
+Xen_wrap_2_args(gxg_gtk_text_buffer_copy_clipboard_w, gxg_gtk_text_buffer_copy_clipboard)
+Xen_wrap_4_args(gxg_gtk_text_buffer_paste_clipboard_w, gxg_gtk_text_buffer_paste_clipboard)
+Xen_wrap_3_args(gxg_gtk_text_buffer_get_selection_bounds_w, gxg_gtk_text_buffer_get_selection_bounds)
+Xen_wrap_3_args(gxg_gtk_text_buffer_delete_selection_w, gxg_gtk_text_buffer_delete_selection)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_begin_user_action_w, gxg_gtk_text_buffer_begin_user_action)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_end_user_action_w, gxg_gtk_text_buffer_end_user_action)
+Xen_wrap_no_args(gxg_gtk_text_child_anchor_new_w, gxg_gtk_text_child_anchor_new)
+Xen_wrap_1_arg(gxg_gtk_text_child_anchor_get_widgets_w, gxg_gtk_text_child_anchor_get_widgets)
+Xen_wrap_1_arg(gxg_gtk_text_child_anchor_get_deleted_w, gxg_gtk_text_child_anchor_get_deleted)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_buffer_w, gxg_gtk_text_iter_get_buffer)
+Xen_wrap_1_arg(gxg_gtk_text_iter_copy_w, gxg_gtk_text_iter_copy)
+Xen_wrap_1_arg(gxg_gtk_text_iter_free_w, gxg_gtk_text_iter_free)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_offset_w, gxg_gtk_text_iter_get_offset)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_line_w, gxg_gtk_text_iter_get_line)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_line_offset_w, gxg_gtk_text_iter_get_line_offset)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_line_index_w, gxg_gtk_text_iter_get_line_index)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_visible_line_offset_w, gxg_gtk_text_iter_get_visible_line_offset)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_visible_line_index_w, gxg_gtk_text_iter_get_visible_line_index)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_char_w, gxg_gtk_text_iter_get_char)
+Xen_wrap_2_args(gxg_gtk_text_iter_get_slice_w, gxg_gtk_text_iter_get_slice)
+Xen_wrap_2_args(gxg_gtk_text_iter_get_text_w, gxg_gtk_text_iter_get_text)
+Xen_wrap_2_args(gxg_gtk_text_iter_get_visible_slice_w, gxg_gtk_text_iter_get_visible_slice)
+Xen_wrap_2_args(gxg_gtk_text_iter_get_visible_text_w, gxg_gtk_text_iter_get_visible_text)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_pixbuf_w, gxg_gtk_text_iter_get_pixbuf)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_marks_w, gxg_gtk_text_iter_get_marks)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_child_anchor_w, gxg_gtk_text_iter_get_child_anchor)
+Xen_wrap_2_args(gxg_gtk_text_iter_get_toggled_tags_w, gxg_gtk_text_iter_get_toggled_tags)
+Xen_wrap_2_args(gxg_gtk_text_iter_begins_tag_w, gxg_gtk_text_iter_begins_tag)
+Xen_wrap_2_args(gxg_gtk_text_iter_ends_tag_w, gxg_gtk_text_iter_ends_tag)
+Xen_wrap_2_args(gxg_gtk_text_iter_toggles_tag_w, gxg_gtk_text_iter_toggles_tag)
+Xen_wrap_2_args(gxg_gtk_text_iter_has_tag_w, gxg_gtk_text_iter_has_tag)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_tags_w, gxg_gtk_text_iter_get_tags)
+Xen_wrap_2_args(gxg_gtk_text_iter_editable_w, gxg_gtk_text_iter_editable)
+Xen_wrap_2_args(gxg_gtk_text_iter_can_insert_w, gxg_gtk_text_iter_can_insert)
+Xen_wrap_1_arg(gxg_gtk_text_iter_starts_word_w, gxg_gtk_text_iter_starts_word)
+Xen_wrap_1_arg(gxg_gtk_text_iter_ends_word_w, gxg_gtk_text_iter_ends_word)
+Xen_wrap_1_arg(gxg_gtk_text_iter_inside_word_w, gxg_gtk_text_iter_inside_word)
+Xen_wrap_1_arg(gxg_gtk_text_iter_starts_sentence_w, gxg_gtk_text_iter_starts_sentence)
+Xen_wrap_1_arg(gxg_gtk_text_iter_ends_sentence_w, gxg_gtk_text_iter_ends_sentence)
+Xen_wrap_1_arg(gxg_gtk_text_iter_inside_sentence_w, gxg_gtk_text_iter_inside_sentence)
+Xen_wrap_1_arg(gxg_gtk_text_iter_starts_line_w, gxg_gtk_text_iter_starts_line)
+Xen_wrap_1_arg(gxg_gtk_text_iter_ends_line_w, gxg_gtk_text_iter_ends_line)
+Xen_wrap_1_arg(gxg_gtk_text_iter_is_cursor_position_w, gxg_gtk_text_iter_is_cursor_position)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_chars_in_line_w, gxg_gtk_text_iter_get_chars_in_line)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_bytes_in_line_w, gxg_gtk_text_iter_get_bytes_in_line)
+Xen_wrap_2_args(gxg_gtk_text_iter_get_attributes_w, gxg_gtk_text_iter_get_attributes)
+Xen_wrap_1_arg(gxg_gtk_text_iter_get_language_w, gxg_gtk_text_iter_get_language)
+Xen_wrap_1_arg(gxg_gtk_text_iter_is_end_w, gxg_gtk_text_iter_is_end)
+Xen_wrap_1_arg(gxg_gtk_text_iter_is_start_w, gxg_gtk_text_iter_is_start)
+Xen_wrap_1_arg(gxg_gtk_text_iter_forward_char_w, gxg_gtk_text_iter_forward_char)
+Xen_wrap_1_arg(gxg_gtk_text_iter_backward_char_w, gxg_gtk_text_iter_backward_char)
+Xen_wrap_2_args(gxg_gtk_text_iter_forward_chars_w, gxg_gtk_text_iter_forward_chars)
+Xen_wrap_2_args(gxg_gtk_text_iter_backward_chars_w, gxg_gtk_text_iter_backward_chars)
+Xen_wrap_1_arg(gxg_gtk_text_iter_forward_line_w, gxg_gtk_text_iter_forward_line)
+Xen_wrap_1_arg(gxg_gtk_text_iter_backward_line_w, gxg_gtk_text_iter_backward_line)
+Xen_wrap_2_args(gxg_gtk_text_iter_forward_lines_w, gxg_gtk_text_iter_forward_lines)
+Xen_wrap_2_args(gxg_gtk_text_iter_backward_lines_w, gxg_gtk_text_iter_backward_lines)
+Xen_wrap_1_arg(gxg_gtk_text_iter_forward_word_end_w, gxg_gtk_text_iter_forward_word_end)
+Xen_wrap_1_arg(gxg_gtk_text_iter_backward_word_start_w, gxg_gtk_text_iter_backward_word_start)
+Xen_wrap_2_args(gxg_gtk_text_iter_forward_word_ends_w, gxg_gtk_text_iter_forward_word_ends)
+Xen_wrap_2_args(gxg_gtk_text_iter_backward_word_starts_w, gxg_gtk_text_iter_backward_word_starts)
+Xen_wrap_1_arg(gxg_gtk_text_iter_forward_sentence_end_w, gxg_gtk_text_iter_forward_sentence_end)
+Xen_wrap_1_arg(gxg_gtk_text_iter_backward_sentence_start_w, gxg_gtk_text_iter_backward_sentence_start)
+Xen_wrap_2_args(gxg_gtk_text_iter_forward_sentence_ends_w, gxg_gtk_text_iter_forward_sentence_ends)
+Xen_wrap_2_args(gxg_gtk_text_iter_backward_sentence_starts_w, gxg_gtk_text_iter_backward_sentence_starts)
+Xen_wrap_1_arg(gxg_gtk_text_iter_forward_cursor_position_w, gxg_gtk_text_iter_forward_cursor_position)
+Xen_wrap_1_arg(gxg_gtk_text_iter_backward_cursor_position_w, gxg_gtk_text_iter_backward_cursor_position)
+Xen_wrap_2_args(gxg_gtk_text_iter_forward_cursor_positions_w, gxg_gtk_text_iter_forward_cursor_positions)
+Xen_wrap_2_args(gxg_gtk_text_iter_backward_cursor_positions_w, gxg_gtk_text_iter_backward_cursor_positions)
+Xen_wrap_2_args(gxg_gtk_text_iter_set_offset_w, gxg_gtk_text_iter_set_offset)
+Xen_wrap_2_args(gxg_gtk_text_iter_set_line_w, gxg_gtk_text_iter_set_line)
+Xen_wrap_2_args(gxg_gtk_text_iter_set_line_offset_w, gxg_gtk_text_iter_set_line_offset)
+Xen_wrap_2_args(gxg_gtk_text_iter_set_line_index_w, gxg_gtk_text_iter_set_line_index)
+Xen_wrap_1_arg(gxg_gtk_text_iter_forward_to_end_w, gxg_gtk_text_iter_forward_to_end)
+Xen_wrap_1_arg(gxg_gtk_text_iter_forward_to_line_end_w, gxg_gtk_text_iter_forward_to_line_end)
+Xen_wrap_2_args(gxg_gtk_text_iter_set_visible_line_offset_w, gxg_gtk_text_iter_set_visible_line_offset)
+Xen_wrap_2_args(gxg_gtk_text_iter_set_visible_line_index_w, gxg_gtk_text_iter_set_visible_line_index)
+Xen_wrap_2_args(gxg_gtk_text_iter_forward_to_tag_toggle_w, gxg_gtk_text_iter_forward_to_tag_toggle)
+Xen_wrap_2_args(gxg_gtk_text_iter_backward_to_tag_toggle_w, gxg_gtk_text_iter_backward_to_tag_toggle)
+Xen_wrap_4_args(gxg_gtk_text_iter_forward_find_char_w, gxg_gtk_text_iter_forward_find_char)
+Xen_wrap_4_args(gxg_gtk_text_iter_backward_find_char_w, gxg_gtk_text_iter_backward_find_char)
+Xen_wrap_6_args(gxg_gtk_text_iter_forward_search_w, gxg_gtk_text_iter_forward_search)
+Xen_wrap_6_args(gxg_gtk_text_iter_backward_search_w, gxg_gtk_text_iter_backward_search)
+Xen_wrap_2_args(gxg_gtk_text_iter_equal_w, gxg_gtk_text_iter_equal)
+Xen_wrap_2_args(gxg_gtk_text_iter_compare_w, gxg_gtk_text_iter_compare)
+Xen_wrap_3_args(gxg_gtk_text_iter_in_range_w, gxg_gtk_text_iter_in_range)
+Xen_wrap_2_args(gxg_gtk_text_iter_order_w, gxg_gtk_text_iter_order)
+Xen_wrap_2_args(gxg_gtk_text_mark_set_visible_w, gxg_gtk_text_mark_set_visible)
+Xen_wrap_1_arg(gxg_gtk_text_mark_get_visible_w, gxg_gtk_text_mark_get_visible)
+Xen_wrap_1_arg(gxg_gtk_text_mark_get_name_w, gxg_gtk_text_mark_get_name)
+Xen_wrap_1_arg(gxg_gtk_text_mark_get_deleted_w, gxg_gtk_text_mark_get_deleted)
+Xen_wrap_1_arg(gxg_gtk_text_mark_get_buffer_w, gxg_gtk_text_mark_get_buffer)
+Xen_wrap_1_arg(gxg_gtk_text_mark_get_left_gravity_w, gxg_gtk_text_mark_get_left_gravity)
+Xen_wrap_1_arg(gxg_gtk_text_tag_new_w, gxg_gtk_text_tag_new)
+Xen_wrap_1_arg(gxg_gtk_text_tag_get_priority_w, gxg_gtk_text_tag_get_priority)
+Xen_wrap_2_args(gxg_gtk_text_tag_set_priority_w, gxg_gtk_text_tag_set_priority)
+Xen_wrap_4_args(gxg_gtk_text_tag_event_w, gxg_gtk_text_tag_event)
+Xen_wrap_no_args(gxg_gtk_text_attributes_new_w, gxg_gtk_text_attributes_new)
+Xen_wrap_1_arg(gxg_gtk_text_attributes_copy_w, gxg_gtk_text_attributes_copy)
+Xen_wrap_2_args(gxg_gtk_text_attributes_copy_values_w, gxg_gtk_text_attributes_copy_values)
+Xen_wrap_1_arg(gxg_gtk_text_attributes_unref_w, gxg_gtk_text_attributes_unref)
+Xen_wrap_no_args(gxg_gtk_text_tag_table_new_w, gxg_gtk_text_tag_table_new)
+Xen_wrap_2_args(gxg_gtk_text_tag_table_add_w, gxg_gtk_text_tag_table_add)
+Xen_wrap_2_args(gxg_gtk_text_tag_table_remove_w, gxg_gtk_text_tag_table_remove)
+Xen_wrap_2_args(gxg_gtk_text_tag_table_lookup_w, gxg_gtk_text_tag_table_lookup)
+Xen_wrap_3_optional_args(gxg_gtk_text_tag_table_foreach_w, gxg_gtk_text_tag_table_foreach)
+Xen_wrap_1_arg(gxg_gtk_text_tag_table_get_size_w, gxg_gtk_text_tag_table_get_size)
+Xen_wrap_no_args(gxg_gtk_text_view_new_w, gxg_gtk_text_view_new)
+Xen_wrap_1_arg(gxg_gtk_text_view_new_with_buffer_w, gxg_gtk_text_view_new_with_buffer)
+Xen_wrap_2_args(gxg_gtk_text_view_set_buffer_w, gxg_gtk_text_view_set_buffer)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_buffer_w, gxg_gtk_text_view_get_buffer)
+Xen_wrap_6_args(gxg_gtk_text_view_scroll_to_iter_w, gxg_gtk_text_view_scroll_to_iter)
+Xen_wrap_6_args(gxg_gtk_text_view_scroll_to_mark_w, gxg_gtk_text_view_scroll_to_mark)
+Xen_wrap_2_args(gxg_gtk_text_view_scroll_mark_onscreen_w, gxg_gtk_text_view_scroll_mark_onscreen)
+Xen_wrap_2_args(gxg_gtk_text_view_move_mark_onscreen_w, gxg_gtk_text_view_move_mark_onscreen)
+Xen_wrap_1_arg(gxg_gtk_text_view_place_cursor_onscreen_w, gxg_gtk_text_view_place_cursor_onscreen)
+Xen_wrap_2_args(gxg_gtk_text_view_get_visible_rect_w, gxg_gtk_text_view_get_visible_rect)
+Xen_wrap_2_args(gxg_gtk_text_view_set_cursor_visible_w, gxg_gtk_text_view_set_cursor_visible)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_cursor_visible_w, gxg_gtk_text_view_get_cursor_visible)
+Xen_wrap_3_args(gxg_gtk_text_view_get_iter_location_w, gxg_gtk_text_view_get_iter_location)
+Xen_wrap_4_args(gxg_gtk_text_view_get_iter_at_location_w, gxg_gtk_text_view_get_iter_at_location)
+Xen_wrap_4_optional_args(gxg_gtk_text_view_get_line_yrange_w, gxg_gtk_text_view_get_line_yrange)
+Xen_wrap_4_optional_args(gxg_gtk_text_view_get_line_at_y_w, gxg_gtk_text_view_get_line_at_y)
+Xen_wrap_6_optional_args(gxg_gtk_text_view_buffer_to_window_coords_w, gxg_gtk_text_view_buffer_to_window_coords)
+Xen_wrap_6_optional_args(gxg_gtk_text_view_window_to_buffer_coords_w, gxg_gtk_text_view_window_to_buffer_coords)
+Xen_wrap_2_args(gxg_gtk_text_view_get_window_w, gxg_gtk_text_view_get_window)
+Xen_wrap_2_args(gxg_gtk_text_view_get_window_type_w, gxg_gtk_text_view_get_window_type)
+Xen_wrap_3_args(gxg_gtk_text_view_set_border_window_size_w, gxg_gtk_text_view_set_border_window_size)
+Xen_wrap_2_args(gxg_gtk_text_view_get_border_window_size_w, gxg_gtk_text_view_get_border_window_size)
+Xen_wrap_2_args(gxg_gtk_text_view_forward_display_line_w, gxg_gtk_text_view_forward_display_line)
+Xen_wrap_2_args(gxg_gtk_text_view_backward_display_line_w, gxg_gtk_text_view_backward_display_line)
+Xen_wrap_2_args(gxg_gtk_text_view_forward_display_line_end_w, gxg_gtk_text_view_forward_display_line_end)
+Xen_wrap_2_args(gxg_gtk_text_view_backward_display_line_start_w, gxg_gtk_text_view_backward_display_line_start)
+Xen_wrap_2_args(gxg_gtk_text_view_starts_display_line_w, gxg_gtk_text_view_starts_display_line)
+Xen_wrap_3_args(gxg_gtk_text_view_move_visually_w, gxg_gtk_text_view_move_visually)
+Xen_wrap_3_args(gxg_gtk_text_view_add_child_at_anchor_w, gxg_gtk_text_view_add_child_at_anchor)
+Xen_wrap_5_args(gxg_gtk_text_view_add_child_in_window_w, gxg_gtk_text_view_add_child_in_window)
+Xen_wrap_4_args(gxg_gtk_text_view_move_child_w, gxg_gtk_text_view_move_child)
+Xen_wrap_2_args(gxg_gtk_text_view_set_wrap_mode_w, gxg_gtk_text_view_set_wrap_mode)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_wrap_mode_w, gxg_gtk_text_view_get_wrap_mode)
+Xen_wrap_2_args(gxg_gtk_text_view_set_editable_w, gxg_gtk_text_view_set_editable)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_editable_w, gxg_gtk_text_view_get_editable)
+Xen_wrap_2_args(gxg_gtk_text_view_set_pixels_above_lines_w, gxg_gtk_text_view_set_pixels_above_lines)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_pixels_above_lines_w, gxg_gtk_text_view_get_pixels_above_lines)
+Xen_wrap_2_args(gxg_gtk_text_view_set_pixels_below_lines_w, gxg_gtk_text_view_set_pixels_below_lines)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_pixels_below_lines_w, gxg_gtk_text_view_get_pixels_below_lines)
+Xen_wrap_2_args(gxg_gtk_text_view_set_pixels_inside_wrap_w, gxg_gtk_text_view_set_pixels_inside_wrap)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_pixels_inside_wrap_w, gxg_gtk_text_view_get_pixels_inside_wrap)
+Xen_wrap_2_args(gxg_gtk_text_view_set_justification_w, gxg_gtk_text_view_set_justification)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_justification_w, gxg_gtk_text_view_get_justification)
+Xen_wrap_2_args(gxg_gtk_text_view_set_left_margin_w, gxg_gtk_text_view_set_left_margin)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_left_margin_w, gxg_gtk_text_view_get_left_margin)
+Xen_wrap_2_args(gxg_gtk_text_view_set_right_margin_w, gxg_gtk_text_view_set_right_margin)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_right_margin_w, gxg_gtk_text_view_get_right_margin)
+Xen_wrap_2_args(gxg_gtk_text_view_set_indent_w, gxg_gtk_text_view_set_indent)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_indent_w, gxg_gtk_text_view_get_indent)
+Xen_wrap_2_args(gxg_gtk_text_view_set_tabs_w, gxg_gtk_text_view_set_tabs)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_tabs_w, gxg_gtk_text_view_get_tabs)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_default_attributes_w, gxg_gtk_text_view_get_default_attributes)
+Xen_wrap_no_args(gxg_gtk_toggle_button_new_w, gxg_gtk_toggle_button_new)
+Xen_wrap_1_arg(gxg_gtk_toggle_button_new_with_label_w, gxg_gtk_toggle_button_new_with_label)
+Xen_wrap_1_arg(gxg_gtk_toggle_button_new_with_mnemonic_w, gxg_gtk_toggle_button_new_with_mnemonic)
+Xen_wrap_2_args(gxg_gtk_toggle_button_set_mode_w, gxg_gtk_toggle_button_set_mode)
+Xen_wrap_1_arg(gxg_gtk_toggle_button_get_mode_w, gxg_gtk_toggle_button_get_mode)
+Xen_wrap_2_args(gxg_gtk_toggle_button_set_active_w, gxg_gtk_toggle_button_set_active)
+Xen_wrap_1_arg(gxg_gtk_toggle_button_get_active_w, gxg_gtk_toggle_button_get_active)
+Xen_wrap_1_arg(gxg_gtk_toggle_button_toggled_w, gxg_gtk_toggle_button_toggled)
+Xen_wrap_2_args(gxg_gtk_toggle_button_set_inconsistent_w, gxg_gtk_toggle_button_set_inconsistent)
+Xen_wrap_1_arg(gxg_gtk_toggle_button_get_inconsistent_w, gxg_gtk_toggle_button_get_inconsistent)
+Xen_wrap_no_args(gxg_gtk_toolbar_new_w, gxg_gtk_toolbar_new)
+Xen_wrap_2_args(gxg_gtk_toolbar_set_style_w, gxg_gtk_toolbar_set_style)
+Xen_wrap_1_arg(gxg_gtk_toolbar_unset_style_w, gxg_gtk_toolbar_unset_style)
+Xen_wrap_1_arg(gxg_gtk_toolbar_get_style_w, gxg_gtk_toolbar_get_style)
+Xen_wrap_2_args(gxg_gtk_tree_drag_source_row_draggable_w, gxg_gtk_tree_drag_source_row_draggable)
+Xen_wrap_2_args(gxg_gtk_tree_drag_source_drag_data_delete_w, gxg_gtk_tree_drag_source_drag_data_delete)
+Xen_wrap_3_args(gxg_gtk_tree_drag_source_drag_data_get_w, gxg_gtk_tree_drag_source_drag_data_get)
+Xen_wrap_3_args(gxg_gtk_tree_drag_dest_drag_data_received_w, gxg_gtk_tree_drag_dest_drag_data_received)
+Xen_wrap_3_args(gxg_gtk_tree_drag_dest_row_drop_possible_w, gxg_gtk_tree_drag_dest_row_drop_possible)
+Xen_wrap_3_args(gxg_gtk_tree_set_row_drag_data_w, gxg_gtk_tree_set_row_drag_data)
+Xen_wrap_3_optional_args(gxg_gtk_tree_get_row_drag_data_w, gxg_gtk_tree_get_row_drag_data)
+Xen_wrap_no_args(gxg_gtk_tree_path_new_w, gxg_gtk_tree_path_new)
+Xen_wrap_1_arg(gxg_gtk_tree_path_new_from_string_w, gxg_gtk_tree_path_new_from_string)
+Xen_wrap_1_arg(gxg_gtk_tree_path_to_string_w, gxg_gtk_tree_path_to_string)
+Xen_wrap_no_args(gxg_gtk_tree_path_new_first_w, gxg_gtk_tree_path_new_first)
+Xen_wrap_2_args(gxg_gtk_tree_path_append_index_w, gxg_gtk_tree_path_append_index)
+Xen_wrap_2_args(gxg_gtk_tree_path_prepend_index_w, gxg_gtk_tree_path_prepend_index)
+Xen_wrap_1_arg(gxg_gtk_tree_path_get_depth_w, gxg_gtk_tree_path_get_depth)
+Xen_wrap_1_arg(gxg_gtk_tree_path_get_indices_w, gxg_gtk_tree_path_get_indices)
+Xen_wrap_1_arg(gxg_gtk_tree_path_free_w, gxg_gtk_tree_path_free)
+Xen_wrap_1_arg(gxg_gtk_tree_path_copy_w, gxg_gtk_tree_path_copy)
+Xen_wrap_2_args(gxg_gtk_tree_path_compare_w, gxg_gtk_tree_path_compare)
+Xen_wrap_1_arg(gxg_gtk_tree_path_next_w, gxg_gtk_tree_path_next)
+Xen_wrap_1_arg(gxg_gtk_tree_path_prev_w, gxg_gtk_tree_path_prev)
+Xen_wrap_1_arg(gxg_gtk_tree_path_up_w, gxg_gtk_tree_path_up)
+Xen_wrap_1_arg(gxg_gtk_tree_path_down_w, gxg_gtk_tree_path_down)
+Xen_wrap_2_args(gxg_gtk_tree_path_is_ancestor_w, gxg_gtk_tree_path_is_ancestor)
+Xen_wrap_2_args(gxg_gtk_tree_path_is_descendant_w, gxg_gtk_tree_path_is_descendant)
+Xen_wrap_2_args(gxg_gtk_tree_row_reference_new_w, gxg_gtk_tree_row_reference_new)
+Xen_wrap_3_args(gxg_gtk_tree_row_reference_new_proxy_w, gxg_gtk_tree_row_reference_new_proxy)
+Xen_wrap_1_arg(gxg_gtk_tree_row_reference_get_path_w, gxg_gtk_tree_row_reference_get_path)
+Xen_wrap_1_arg(gxg_gtk_tree_row_reference_valid_w, gxg_gtk_tree_row_reference_valid)
+Xen_wrap_1_arg(gxg_gtk_tree_row_reference_free_w, gxg_gtk_tree_row_reference_free)
+Xen_wrap_2_args(gxg_gtk_tree_row_reference_inserted_w, gxg_gtk_tree_row_reference_inserted)
+Xen_wrap_2_args(gxg_gtk_tree_row_reference_deleted_w, gxg_gtk_tree_row_reference_deleted)
+Xen_wrap_4_args(gxg_gtk_tree_row_reference_reordered_w, gxg_gtk_tree_row_reference_reordered)
+Xen_wrap_1_arg(gxg_gtk_tree_iter_copy_w, gxg_gtk_tree_iter_copy)
+Xen_wrap_1_arg(gxg_gtk_tree_iter_free_w, gxg_gtk_tree_iter_free)
+Xen_wrap_1_arg(gxg_gtk_tree_model_get_flags_w, gxg_gtk_tree_model_get_flags)
+Xen_wrap_1_arg(gxg_gtk_tree_model_get_n_columns_w, gxg_gtk_tree_model_get_n_columns)
+Xen_wrap_2_args(gxg_gtk_tree_model_get_column_type_w, gxg_gtk_tree_model_get_column_type)
+Xen_wrap_3_args(gxg_gtk_tree_model_get_iter_w, gxg_gtk_tree_model_get_iter)
+Xen_wrap_3_args(gxg_gtk_tree_model_get_iter_from_string_w, gxg_gtk_tree_model_get_iter_from_string)
+Xen_wrap_2_args(gxg_gtk_tree_model_get_iter_first_w, gxg_gtk_tree_model_get_iter_first)
+Xen_wrap_2_args(gxg_gtk_tree_model_get_path_w, gxg_gtk_tree_model_get_path)
+Xen_wrap_2_args(gxg_gtk_tree_model_iter_next_w, gxg_gtk_tree_model_iter_next)
+Xen_wrap_3_args(gxg_gtk_tree_model_iter_children_w, gxg_gtk_tree_model_iter_children)
+Xen_wrap_2_args(gxg_gtk_tree_model_iter_has_child_w, gxg_gtk_tree_model_iter_has_child)
+Xen_wrap_2_args(gxg_gtk_tree_model_iter_n_children_w, gxg_gtk_tree_model_iter_n_children)
+Xen_wrap_4_args(gxg_gtk_tree_model_iter_nth_child_w, gxg_gtk_tree_model_iter_nth_child)
+Xen_wrap_3_args(gxg_gtk_tree_model_iter_parent_w, gxg_gtk_tree_model_iter_parent)
+Xen_wrap_2_args(gxg_gtk_tree_model_ref_node_w, gxg_gtk_tree_model_ref_node)
+Xen_wrap_2_args(gxg_gtk_tree_model_unref_node_w, gxg_gtk_tree_model_unref_node)
+Xen_wrap_3_optional_args(gxg_gtk_tree_model_foreach_w, gxg_gtk_tree_model_foreach)
+Xen_wrap_3_args(gxg_gtk_tree_model_row_changed_w, gxg_gtk_tree_model_row_changed)
+Xen_wrap_3_args(gxg_gtk_tree_model_row_inserted_w, gxg_gtk_tree_model_row_inserted)
+Xen_wrap_3_args(gxg_gtk_tree_model_row_has_child_toggled_w, gxg_gtk_tree_model_row_has_child_toggled)
+Xen_wrap_2_args(gxg_gtk_tree_model_row_deleted_w, gxg_gtk_tree_model_row_deleted)
+Xen_wrap_4_args(gxg_gtk_tree_model_rows_reordered_w, gxg_gtk_tree_model_rows_reordered)
+Xen_wrap_1_arg(gxg_gtk_tree_model_sort_new_with_model_w, gxg_gtk_tree_model_sort_new_with_model)
+Xen_wrap_1_arg(gxg_gtk_tree_model_sort_get_model_w, gxg_gtk_tree_model_sort_get_model)
+Xen_wrap_2_args(gxg_gtk_tree_model_sort_convert_child_path_to_path_w, gxg_gtk_tree_model_sort_convert_child_path_to_path)
+Xen_wrap_3_args(gxg_gtk_tree_model_sort_convert_child_iter_to_iter_w, gxg_gtk_tree_model_sort_convert_child_iter_to_iter)
+Xen_wrap_2_args(gxg_gtk_tree_model_sort_convert_path_to_child_path_w, gxg_gtk_tree_model_sort_convert_path_to_child_path)
+Xen_wrap_3_args(gxg_gtk_tree_model_sort_convert_iter_to_child_iter_w, gxg_gtk_tree_model_sort_convert_iter_to_child_iter)
+Xen_wrap_1_arg(gxg_gtk_tree_model_sort_reset_default_sort_func_w, gxg_gtk_tree_model_sort_reset_default_sort_func)
+Xen_wrap_1_arg(gxg_gtk_tree_model_sort_clear_cache_w, gxg_gtk_tree_model_sort_clear_cache)
+Xen_wrap_2_args(gxg_gtk_tree_selection_set_mode_w, gxg_gtk_tree_selection_set_mode)
+Xen_wrap_1_arg(gxg_gtk_tree_selection_get_mode_w, gxg_gtk_tree_selection_get_mode)
+Xen_wrap_4_args(gxg_gtk_tree_selection_set_select_function_w, gxg_gtk_tree_selection_set_select_function)
+Xen_wrap_1_arg(gxg_gtk_tree_selection_get_user_data_w, gxg_gtk_tree_selection_get_user_data)
+Xen_wrap_1_arg(gxg_gtk_tree_selection_get_tree_view_w, gxg_gtk_tree_selection_get_tree_view)
+Xen_wrap_3_args(gxg_gtk_tree_selection_get_selected_w, gxg_gtk_tree_selection_get_selected)
+Xen_wrap_3_optional_args(gxg_gtk_tree_selection_selected_foreach_w, gxg_gtk_tree_selection_selected_foreach)
+Xen_wrap_2_args(gxg_gtk_tree_selection_select_path_w, gxg_gtk_tree_selection_select_path)
+Xen_wrap_2_args(gxg_gtk_tree_selection_unselect_path_w, gxg_gtk_tree_selection_unselect_path)
+Xen_wrap_2_args(gxg_gtk_tree_selection_select_iter_w, gxg_gtk_tree_selection_select_iter)
+Xen_wrap_2_args(gxg_gtk_tree_selection_unselect_iter_w, gxg_gtk_tree_selection_unselect_iter)
+Xen_wrap_2_args(gxg_gtk_tree_selection_path_is_selected_w, gxg_gtk_tree_selection_path_is_selected)
+Xen_wrap_2_args(gxg_gtk_tree_selection_iter_is_selected_w, gxg_gtk_tree_selection_iter_is_selected)
+Xen_wrap_1_arg(gxg_gtk_tree_selection_select_all_w, gxg_gtk_tree_selection_select_all)
+Xen_wrap_1_arg(gxg_gtk_tree_selection_unselect_all_w, gxg_gtk_tree_selection_unselect_all)
+Xen_wrap_3_args(gxg_gtk_tree_selection_select_range_w, gxg_gtk_tree_selection_select_range)
+Xen_wrap_1_arg(gxg_gtk_tree_sortable_sort_column_changed_w, gxg_gtk_tree_sortable_sort_column_changed)
+Xen_wrap_3_optional_args(gxg_gtk_tree_sortable_get_sort_column_id_w, gxg_gtk_tree_sortable_get_sort_column_id)
+Xen_wrap_3_args(gxg_gtk_tree_sortable_set_sort_column_id_w, gxg_gtk_tree_sortable_set_sort_column_id)
+Xen_wrap_5_args(gxg_gtk_tree_sortable_set_sort_func_w, gxg_gtk_tree_sortable_set_sort_func)
+Xen_wrap_4_args(gxg_gtk_tree_sortable_set_default_sort_func_w, gxg_gtk_tree_sortable_set_default_sort_func)
+Xen_wrap_1_arg(gxg_gtk_tree_sortable_has_default_sort_func_w, gxg_gtk_tree_sortable_has_default_sort_func)
+Xen_wrap_2_args(gxg_gtk_tree_store_new_w, gxg_gtk_tree_store_new)
+Xen_wrap_2_args(gxg_gtk_tree_store_newv_w, gxg_gtk_tree_store_newv)
+Xen_wrap_3_args(gxg_gtk_tree_store_set_column_types_w, gxg_gtk_tree_store_set_column_types)
+Xen_wrap_3_args(gxg_gtk_tree_store_set_w, gxg_gtk_tree_store_set)
+Xen_wrap_2_args(gxg_gtk_tree_store_remove_w, gxg_gtk_tree_store_remove)
+Xen_wrap_4_args(gxg_gtk_tree_store_insert_w, gxg_gtk_tree_store_insert)
+Xen_wrap_4_args(gxg_gtk_tree_store_insert_before_w, gxg_gtk_tree_store_insert_before)
+Xen_wrap_4_args(gxg_gtk_tree_store_insert_after_w, gxg_gtk_tree_store_insert_after)
+Xen_wrap_3_args(gxg_gtk_tree_store_prepend_w, gxg_gtk_tree_store_prepend)
+Xen_wrap_3_args(gxg_gtk_tree_store_append_w, gxg_gtk_tree_store_append)
+Xen_wrap_3_args(gxg_gtk_tree_store_is_ancestor_w, gxg_gtk_tree_store_is_ancestor)
+Xen_wrap_2_args(gxg_gtk_tree_store_iter_depth_w, gxg_gtk_tree_store_iter_depth)
+Xen_wrap_1_arg(gxg_gtk_tree_store_clear_w, gxg_gtk_tree_store_clear)
+Xen_wrap_no_args(gxg_gtk_tree_view_column_new_w, gxg_gtk_tree_view_column_new)
+Xen_wrap_3_args(gxg_gtk_tree_view_column_new_with_attributes_w, gxg_gtk_tree_view_column_new_with_attributes)
+Xen_wrap_3_args(gxg_gtk_tree_view_column_pack_start_w, gxg_gtk_tree_view_column_pack_start)
+Xen_wrap_3_args(gxg_gtk_tree_view_column_pack_end_w, gxg_gtk_tree_view_column_pack_end)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_clear_w, gxg_gtk_tree_view_column_clear)
+Xen_wrap_4_args(gxg_gtk_tree_view_column_add_attribute_w, gxg_gtk_tree_view_column_add_attribute)
+Xen_wrap_3_args(gxg_gtk_tree_view_column_set_attributes_w, gxg_gtk_tree_view_column_set_attributes)
+Xen_wrap_5_args(gxg_gtk_tree_view_column_set_cell_data_func_w, gxg_gtk_tree_view_column_set_cell_data_func)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_clear_attributes_w, gxg_gtk_tree_view_column_clear_attributes)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_spacing_w, gxg_gtk_tree_view_column_set_spacing)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_spacing_w, gxg_gtk_tree_view_column_get_spacing)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_visible_w, gxg_gtk_tree_view_column_set_visible)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_visible_w, gxg_gtk_tree_view_column_get_visible)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_resizable_w, gxg_gtk_tree_view_column_set_resizable)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_resizable_w, gxg_gtk_tree_view_column_get_resizable)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_sizing_w, gxg_gtk_tree_view_column_set_sizing)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_sizing_w, gxg_gtk_tree_view_column_get_sizing)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_width_w, gxg_gtk_tree_view_column_get_width)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_fixed_width_w, gxg_gtk_tree_view_column_get_fixed_width)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_fixed_width_w, gxg_gtk_tree_view_column_set_fixed_width)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_min_width_w, gxg_gtk_tree_view_column_set_min_width)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_min_width_w, gxg_gtk_tree_view_column_get_min_width)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_max_width_w, gxg_gtk_tree_view_column_set_max_width)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_max_width_w, gxg_gtk_tree_view_column_get_max_width)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_clicked_w, gxg_gtk_tree_view_column_clicked)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_title_w, gxg_gtk_tree_view_column_set_title)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_title_w, gxg_gtk_tree_view_column_get_title)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_clickable_w, gxg_gtk_tree_view_column_set_clickable)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_clickable_w, gxg_gtk_tree_view_column_get_clickable)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_widget_w, gxg_gtk_tree_view_column_set_widget)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_widget_w, gxg_gtk_tree_view_column_get_widget)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_alignment_w, gxg_gtk_tree_view_column_set_alignment)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_alignment_w, gxg_gtk_tree_view_column_get_alignment)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_reorderable_w, gxg_gtk_tree_view_column_set_reorderable)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_reorderable_w, gxg_gtk_tree_view_column_get_reorderable)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_sort_column_id_w, gxg_gtk_tree_view_column_set_sort_column_id)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_sort_column_id_w, gxg_gtk_tree_view_column_get_sort_column_id)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_sort_indicator_w, gxg_gtk_tree_view_column_set_sort_indicator)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_sort_indicator_w, gxg_gtk_tree_view_column_get_sort_indicator)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_sort_order_w, gxg_gtk_tree_view_column_set_sort_order)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_sort_order_w, gxg_gtk_tree_view_column_get_sort_order)
+Xen_wrap_5_args(gxg_gtk_tree_view_column_cell_set_cell_data_w, gxg_gtk_tree_view_column_cell_set_cell_data)
+Xen_wrap_6_optional_args(gxg_gtk_tree_view_column_cell_get_size_w, gxg_gtk_tree_view_column_cell_get_size)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_cell_is_visible_w, gxg_gtk_tree_view_column_cell_is_visible)
+Xen_wrap_4_optional_args(gxg_gtk_tree_view_column_cell_get_position_w, gxg_gtk_tree_view_column_cell_get_position)
+Xen_wrap_no_args(gxg_gtk_tree_view_new_w, gxg_gtk_tree_view_new)
+Xen_wrap_1_arg(gxg_gtk_tree_view_new_with_model_w, gxg_gtk_tree_view_new_with_model)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_model_w, gxg_gtk_tree_view_get_model)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_model_w, gxg_gtk_tree_view_set_model)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_selection_w, gxg_gtk_tree_view_get_selection)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_headers_visible_w, gxg_gtk_tree_view_get_headers_visible)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_headers_visible_w, gxg_gtk_tree_view_set_headers_visible)
+Xen_wrap_1_arg(gxg_gtk_tree_view_columns_autosize_w, gxg_gtk_tree_view_columns_autosize)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_headers_clickable_w, gxg_gtk_tree_view_set_headers_clickable)
+Xen_wrap_2_args(gxg_gtk_tree_view_append_column_w, gxg_gtk_tree_view_append_column)
+Xen_wrap_2_args(gxg_gtk_tree_view_remove_column_w, gxg_gtk_tree_view_remove_column)
+Xen_wrap_3_args(gxg_gtk_tree_view_insert_column_w, gxg_gtk_tree_view_insert_column)
+Xen_wrap_5_args(gxg_gtk_tree_view_insert_column_with_attributes_w, gxg_gtk_tree_view_insert_column_with_attributes)
+Xen_wrap_7_args(gxg_gtk_tree_view_insert_column_with_data_func_w, gxg_gtk_tree_view_insert_column_with_data_func)
+Xen_wrap_2_args(gxg_gtk_tree_view_get_column_w, gxg_gtk_tree_view_get_column)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_columns_w, gxg_gtk_tree_view_get_columns)
+Xen_wrap_3_args(gxg_gtk_tree_view_move_column_after_w, gxg_gtk_tree_view_move_column_after)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_expander_column_w, gxg_gtk_tree_view_set_expander_column)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_expander_column_w, gxg_gtk_tree_view_get_expander_column)
+Xen_wrap_4_args(gxg_gtk_tree_view_set_column_drag_function_w, gxg_gtk_tree_view_set_column_drag_function)
+Xen_wrap_3_args(gxg_gtk_tree_view_scroll_to_point_w, gxg_gtk_tree_view_scroll_to_point)
+Xen_wrap_6_args(gxg_gtk_tree_view_scroll_to_cell_w, gxg_gtk_tree_view_scroll_to_cell)
+Xen_wrap_3_args(gxg_gtk_tree_view_row_activated_w, gxg_gtk_tree_view_row_activated)
+Xen_wrap_1_arg(gxg_gtk_tree_view_expand_all_w, gxg_gtk_tree_view_expand_all)
+Xen_wrap_1_arg(gxg_gtk_tree_view_collapse_all_w, gxg_gtk_tree_view_collapse_all)
+Xen_wrap_3_args(gxg_gtk_tree_view_expand_row_w, gxg_gtk_tree_view_expand_row)
+Xen_wrap_2_args(gxg_gtk_tree_view_collapse_row_w, gxg_gtk_tree_view_collapse_row)
+Xen_wrap_3_optional_args(gxg_gtk_tree_view_map_expanded_rows_w, gxg_gtk_tree_view_map_expanded_rows)
+Xen_wrap_2_args(gxg_gtk_tree_view_row_expanded_w, gxg_gtk_tree_view_row_expanded)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_reorderable_w, gxg_gtk_tree_view_set_reorderable)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_reorderable_w, gxg_gtk_tree_view_get_reorderable)
+Xen_wrap_4_args(gxg_gtk_tree_view_set_cursor_w, gxg_gtk_tree_view_set_cursor)
+Xen_wrap_3_optional_args(gxg_gtk_tree_view_get_cursor_w, gxg_gtk_tree_view_get_cursor)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_bin_window_w, gxg_gtk_tree_view_get_bin_window)
+Xen_wrap_7_optional_args(gxg_gtk_tree_view_get_path_at_pos_w, gxg_gtk_tree_view_get_path_at_pos)
+Xen_wrap_4_args(gxg_gtk_tree_view_get_cell_area_w, gxg_gtk_tree_view_get_cell_area)
+Xen_wrap_4_args(gxg_gtk_tree_view_get_background_area_w, gxg_gtk_tree_view_get_background_area)
+Xen_wrap_2_args(gxg_gtk_tree_view_get_visible_rect_w, gxg_gtk_tree_view_get_visible_rect)
+Xen_wrap_5_args(gxg_gtk_tree_view_enable_model_drag_source_w, gxg_gtk_tree_view_enable_model_drag_source)
+Xen_wrap_4_args(gxg_gtk_tree_view_enable_model_drag_dest_w, gxg_gtk_tree_view_enable_model_drag_dest)
+Xen_wrap_1_arg(gxg_gtk_tree_view_unset_rows_drag_source_w, gxg_gtk_tree_view_unset_rows_drag_source)
+Xen_wrap_1_arg(gxg_gtk_tree_view_unset_rows_drag_dest_w, gxg_gtk_tree_view_unset_rows_drag_dest)
+Xen_wrap_3_args(gxg_gtk_tree_view_set_drag_dest_row_w, gxg_gtk_tree_view_set_drag_dest_row)
+Xen_wrap_3_optional_args(gxg_gtk_tree_view_get_drag_dest_row_w, gxg_gtk_tree_view_get_drag_dest_row)
+Xen_wrap_5_optional_args(gxg_gtk_tree_view_get_dest_row_at_pos_w, gxg_gtk_tree_view_get_dest_row_at_pos)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_enable_search_w, gxg_gtk_tree_view_set_enable_search)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_enable_search_w, gxg_gtk_tree_view_get_enable_search)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_search_column_w, gxg_gtk_tree_view_get_search_column)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_search_column_w, gxg_gtk_tree_view_set_search_column)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_search_equal_func_w, gxg_gtk_tree_view_get_search_equal_func)
+Xen_wrap_4_args(gxg_gtk_tree_view_set_search_equal_func_w, gxg_gtk_tree_view_set_search_equal_func)
+Xen_wrap_2_args(gxg_gtk_viewport_new_w, gxg_gtk_viewport_new)
+Xen_wrap_2_args(gxg_gtk_viewport_set_shadow_type_w, gxg_gtk_viewport_set_shadow_type)
+Xen_wrap_1_arg(gxg_gtk_viewport_get_shadow_type_w, gxg_gtk_viewport_get_shadow_type)
+Xen_wrap_1_arg(gxg_gtk_widget_destroy_w, gxg_gtk_widget_destroy)
+Xen_wrap_2_optional_args(gxg_gtk_widget_destroyed_w, gxg_gtk_widget_destroyed)
+Xen_wrap_1_arg(gxg_gtk_widget_unparent_w, gxg_gtk_widget_unparent)
+Xen_wrap_1_arg(gxg_gtk_widget_show_w, gxg_gtk_widget_show)
+Xen_wrap_1_arg(gxg_gtk_widget_show_now_w, gxg_gtk_widget_show_now)
+Xen_wrap_1_arg(gxg_gtk_widget_hide_w, gxg_gtk_widget_hide)
+Xen_wrap_1_arg(gxg_gtk_widget_show_all_w, gxg_gtk_widget_show_all)
+Xen_wrap_1_arg(gxg_gtk_widget_map_w, gxg_gtk_widget_map)
+Xen_wrap_1_arg(gxg_gtk_widget_unmap_w, gxg_gtk_widget_unmap)
+Xen_wrap_1_arg(gxg_gtk_widget_realize_w, gxg_gtk_widget_realize)
+Xen_wrap_1_arg(gxg_gtk_widget_unrealize_w, gxg_gtk_widget_unrealize)
+Xen_wrap_1_arg(gxg_gtk_widget_queue_draw_w, gxg_gtk_widget_queue_draw)
+Xen_wrap_5_args(gxg_gtk_widget_queue_draw_area_w, gxg_gtk_widget_queue_draw_area)
+Xen_wrap_1_arg(gxg_gtk_widget_queue_resize_w, gxg_gtk_widget_queue_resize)
+Xen_wrap_2_args(gxg_gtk_widget_size_allocate_w, gxg_gtk_widget_size_allocate)
+Xen_wrap_6_args(gxg_gtk_widget_add_accelerator_w, gxg_gtk_widget_add_accelerator)
+Xen_wrap_4_args(gxg_gtk_widget_remove_accelerator_w, gxg_gtk_widget_remove_accelerator)
+Xen_wrap_1_arg(gxg_gtk_widget_list_accel_closures_w, gxg_gtk_widget_list_accel_closures)
+Xen_wrap_2_args(gxg_gtk_widget_mnemonic_activate_w, gxg_gtk_widget_mnemonic_activate)
+Xen_wrap_2_args(gxg_gtk_widget_event_w, gxg_gtk_widget_event)
+Xen_wrap_2_args(gxg_gtk_widget_send_expose_w, gxg_gtk_widget_send_expose)
+Xen_wrap_1_arg(gxg_gtk_widget_activate_w, gxg_gtk_widget_activate)
+Xen_wrap_3_args(gxg_gtk_widget_intersect_w, gxg_gtk_widget_intersect)
+Xen_wrap_1_arg(gxg_gtk_widget_freeze_child_notify_w, gxg_gtk_widget_freeze_child_notify)
+Xen_wrap_2_args(gxg_gtk_widget_child_notify_w, gxg_gtk_widget_child_notify)
+Xen_wrap_1_arg(gxg_gtk_widget_thaw_child_notify_w, gxg_gtk_widget_thaw_child_notify)
+Xen_wrap_1_arg(gxg_gtk_widget_is_focus_w, gxg_gtk_widget_is_focus)
+Xen_wrap_1_arg(gxg_gtk_widget_grab_focus_w, gxg_gtk_widget_grab_focus)
+Xen_wrap_1_arg(gxg_gtk_widget_grab_default_w, gxg_gtk_widget_grab_default)
+Xen_wrap_2_args(gxg_gtk_widget_set_name_w, gxg_gtk_widget_set_name)
+Xen_wrap_1_arg(gxg_gtk_widget_get_name_w, gxg_gtk_widget_get_name)
+Xen_wrap_2_args(gxg_gtk_widget_set_sensitive_w, gxg_gtk_widget_set_sensitive)
+Xen_wrap_2_args(gxg_gtk_widget_set_app_paintable_w, gxg_gtk_widget_set_app_paintable)
+Xen_wrap_2_args(gxg_gtk_widget_set_redraw_on_allocate_w, gxg_gtk_widget_set_redraw_on_allocate)
+Xen_wrap_2_args(gxg_gtk_widget_set_parent_w, gxg_gtk_widget_set_parent)
+Xen_wrap_2_args(gxg_gtk_widget_set_parent_window_w, gxg_gtk_widget_set_parent_window)
+Xen_wrap_2_args(gxg_gtk_widget_set_child_visible_w, gxg_gtk_widget_set_child_visible)
+Xen_wrap_3_args(gxg_gtk_widget_set_accel_path_w, gxg_gtk_widget_set_accel_path)
+Xen_wrap_1_arg(gxg_gtk_widget_get_child_visible_w, gxg_gtk_widget_get_child_visible)
+Xen_wrap_1_arg(gxg_gtk_widget_get_parent_w, gxg_gtk_widget_get_parent)
+Xen_wrap_1_arg(gxg_gtk_widget_get_parent_window_w, gxg_gtk_widget_get_parent_window)
+Xen_wrap_2_args(gxg_gtk_widget_child_focus_w, gxg_gtk_widget_child_focus)
+Xen_wrap_3_args(gxg_gtk_widget_set_size_request_w, gxg_gtk_widget_set_size_request)
+Xen_wrap_3_optional_args(gxg_gtk_widget_get_size_request_w, gxg_gtk_widget_get_size_request)
+Xen_wrap_2_args(gxg_gtk_widget_set_events_w, gxg_gtk_widget_set_events)
+Xen_wrap_2_args(gxg_gtk_widget_add_events_w, gxg_gtk_widget_add_events)
+Xen_wrap_1_arg(gxg_gtk_widget_get_toplevel_w, gxg_gtk_widget_get_toplevel)
+Xen_wrap_2_args(gxg_gtk_widget_get_ancestor_w, gxg_gtk_widget_get_ancestor)
+Xen_wrap_1_arg(gxg_gtk_widget_get_visual_w, gxg_gtk_widget_get_visual)
+Xen_wrap_1_arg(gxg_gtk_widget_get_settings_w, gxg_gtk_widget_get_settings)
+Xen_wrap_1_arg(gxg_gtk_widget_get_accessible_w, gxg_gtk_widget_get_accessible)
+Xen_wrap_1_arg(gxg_gtk_widget_get_events_w, gxg_gtk_widget_get_events)
+Xen_wrap_2_args(gxg_gtk_widget_is_ancestor_w, gxg_gtk_widget_is_ancestor)
+Xen_wrap_6_optional_args(gxg_gtk_widget_translate_coordinates_w, gxg_gtk_widget_translate_coordinates)
+Xen_wrap_1_arg(gxg_gtk_widget_hide_on_delete_w, gxg_gtk_widget_hide_on_delete)
+Xen_wrap_1_arg(gxg_gtk_widget_create_pango_context_w, gxg_gtk_widget_create_pango_context)
+Xen_wrap_1_arg(gxg_gtk_widget_get_pango_context_w, gxg_gtk_widget_get_pango_context)
+Xen_wrap_2_args(gxg_gtk_widget_create_pango_layout_w, gxg_gtk_widget_create_pango_layout)
+Xen_wrap_2_args(gxg_gtk_widget_set_direction_w, gxg_gtk_widget_set_direction)
+Xen_wrap_1_arg(gxg_gtk_widget_get_direction_w, gxg_gtk_widget_get_direction)
+Xen_wrap_1_arg(gxg_gtk_widget_set_default_direction_w, gxg_gtk_widget_set_default_direction)
+Xen_wrap_no_args(gxg_gtk_widget_get_default_direction_w, gxg_gtk_widget_get_default_direction)
+Xen_wrap_2_args(gxg_gtk_widget_can_activate_accel_w, gxg_gtk_widget_can_activate_accel)
+Xen_wrap_1_arg(gxg_gtk_window_is_active_w, gxg_gtk_window_is_active)
+Xen_wrap_1_arg(gxg_gtk_window_has_toplevel_focus_w, gxg_gtk_window_has_toplevel_focus)
+Xen_wrap_1_arg(gxg_gtk_window_new_w, gxg_gtk_window_new)
+Xen_wrap_2_args(gxg_gtk_window_set_title_w, gxg_gtk_window_set_title)
+Xen_wrap_1_arg(gxg_gtk_window_set_auto_startup_notification_w, gxg_gtk_window_set_auto_startup_notification)
+Xen_wrap_1_arg(gxg_gtk_window_get_title_w, gxg_gtk_window_get_title)
+Xen_wrap_3_args(gxg_gtk_window_set_wmclass_w, gxg_gtk_window_set_wmclass)
+Xen_wrap_2_args(gxg_gtk_window_set_role_w, gxg_gtk_window_set_role)
+Xen_wrap_1_arg(gxg_gtk_window_get_role_w, gxg_gtk_window_get_role)
+Xen_wrap_2_args(gxg_gtk_window_add_accel_group_w, gxg_gtk_window_add_accel_group)
+Xen_wrap_2_args(gxg_gtk_window_remove_accel_group_w, gxg_gtk_window_remove_accel_group)
+Xen_wrap_2_args(gxg_gtk_window_set_position_w, gxg_gtk_window_set_position)
+Xen_wrap_1_arg(gxg_gtk_window_activate_focus_w, gxg_gtk_window_activate_focus)
+Xen_wrap_2_args(gxg_gtk_window_set_focus_w, gxg_gtk_window_set_focus)
+Xen_wrap_1_arg(gxg_gtk_window_get_focus_w, gxg_gtk_window_get_focus)
+Xen_wrap_2_args(gxg_gtk_window_set_default_w, gxg_gtk_window_set_default)
+Xen_wrap_1_arg(gxg_gtk_window_activate_default_w, gxg_gtk_window_activate_default)
+Xen_wrap_2_args(gxg_gtk_window_set_transient_for_w, gxg_gtk_window_set_transient_for)
+Xen_wrap_1_arg(gxg_gtk_window_get_transient_for_w, gxg_gtk_window_get_transient_for)
+Xen_wrap_2_args(gxg_gtk_window_set_type_hint_w, gxg_gtk_window_set_type_hint)
+Xen_wrap_1_arg(gxg_gtk_window_get_type_hint_w, gxg_gtk_window_get_type_hint)
+Xen_wrap_2_args(gxg_gtk_window_set_destroy_with_parent_w, gxg_gtk_window_set_destroy_with_parent)
+Xen_wrap_1_arg(gxg_gtk_window_get_destroy_with_parent_w, gxg_gtk_window_get_destroy_with_parent)
+Xen_wrap_2_args(gxg_gtk_window_set_resizable_w, gxg_gtk_window_set_resizable)
+Xen_wrap_1_arg(gxg_gtk_window_get_resizable_w, gxg_gtk_window_get_resizable)
+Xen_wrap_2_args(gxg_gtk_window_set_gravity_w, gxg_gtk_window_set_gravity)
+Xen_wrap_1_arg(gxg_gtk_window_get_gravity_w, gxg_gtk_window_get_gravity)
+Xen_wrap_4_args(gxg_gtk_window_set_geometry_hints_w, gxg_gtk_window_set_geometry_hints)
+Xen_wrap_2_args(gxg_gtk_window_set_decorated_w, gxg_gtk_window_set_decorated)
+Xen_wrap_1_arg(gxg_gtk_window_get_decorated_w, gxg_gtk_window_get_decorated)
+Xen_wrap_2_args(gxg_gtk_window_set_icon_list_w, gxg_gtk_window_set_icon_list)
+Xen_wrap_1_arg(gxg_gtk_window_get_icon_list_w, gxg_gtk_window_get_icon_list)
+Xen_wrap_2_args(gxg_gtk_window_set_icon_w, gxg_gtk_window_set_icon)
+Xen_wrap_1_arg(gxg_gtk_window_get_icon_w, gxg_gtk_window_get_icon)
+Xen_wrap_1_arg(gxg_gtk_window_set_default_icon_list_w, gxg_gtk_window_set_default_icon_list)
+Xen_wrap_no_args(gxg_gtk_window_get_default_icon_list_w, gxg_gtk_window_get_default_icon_list)
+Xen_wrap_2_args(gxg_gtk_window_set_modal_w, gxg_gtk_window_set_modal)
+Xen_wrap_1_arg(gxg_gtk_window_get_modal_w, gxg_gtk_window_get_modal)
+Xen_wrap_no_args(gxg_gtk_window_list_toplevels_w, gxg_gtk_window_list_toplevels)
+Xen_wrap_3_args(gxg_gtk_window_add_mnemonic_w, gxg_gtk_window_add_mnemonic)
+Xen_wrap_3_args(gxg_gtk_window_remove_mnemonic_w, gxg_gtk_window_remove_mnemonic)
+Xen_wrap_3_args(gxg_gtk_window_mnemonic_activate_w, gxg_gtk_window_mnemonic_activate)
+Xen_wrap_2_args(gxg_gtk_window_set_mnemonic_modifier_w, gxg_gtk_window_set_mnemonic_modifier)
+Xen_wrap_1_arg(gxg_gtk_window_get_mnemonic_modifier_w, gxg_gtk_window_get_mnemonic_modifier)
+Xen_wrap_1_arg(gxg_gtk_window_present_w, gxg_gtk_window_present)
+Xen_wrap_1_arg(gxg_gtk_window_iconify_w, gxg_gtk_window_iconify)
+Xen_wrap_1_arg(gxg_gtk_window_deiconify_w, gxg_gtk_window_deiconify)
+Xen_wrap_1_arg(gxg_gtk_window_stick_w, gxg_gtk_window_stick)
+Xen_wrap_1_arg(gxg_gtk_window_unstick_w, gxg_gtk_window_unstick)
+Xen_wrap_1_arg(gxg_gtk_window_maximize_w, gxg_gtk_window_maximize)
+Xen_wrap_1_arg(gxg_gtk_window_unmaximize_w, gxg_gtk_window_unmaximize)
+Xen_wrap_6_args(gxg_gtk_window_begin_resize_drag_w, gxg_gtk_window_begin_resize_drag)
+Xen_wrap_5_args(gxg_gtk_window_begin_move_drag_w, gxg_gtk_window_begin_move_drag)
+Xen_wrap_3_args(gxg_gtk_window_set_default_size_w, gxg_gtk_window_set_default_size)
+Xen_wrap_3_optional_args(gxg_gtk_window_get_default_size_w, gxg_gtk_window_get_default_size)
+Xen_wrap_3_args(gxg_gtk_window_resize_w, gxg_gtk_window_resize)
+Xen_wrap_3_optional_args(gxg_gtk_window_get_size_w, gxg_gtk_window_get_size)
+Xen_wrap_3_args(gxg_gtk_window_move_w, gxg_gtk_window_move)
+Xen_wrap_3_optional_args(gxg_gtk_window_get_position_w, gxg_gtk_window_get_position)
+Xen_wrap_2_args(gxg_gtk_window_parse_geometry_w, gxg_gtk_window_parse_geometry)
+Xen_wrap_1_arg(gxg_pango_color_copy_w, gxg_pango_color_copy)
+Xen_wrap_1_arg(gxg_pango_color_free_w, gxg_pango_color_free)
+Xen_wrap_2_args(gxg_pango_color_parse_w, gxg_pango_color_parse)
+Xen_wrap_1_arg(gxg_pango_attr_type_register_w, gxg_pango_attr_type_register)
+Xen_wrap_1_arg(gxg_pango_attribute_copy_w, gxg_pango_attribute_copy)
+Xen_wrap_1_arg(gxg_pango_attribute_destroy_w, gxg_pango_attribute_destroy)
+Xen_wrap_2_args(gxg_pango_attribute_equal_w, gxg_pango_attribute_equal)
+Xen_wrap_1_arg(gxg_pango_attr_language_new_w, gxg_pango_attr_language_new)
+Xen_wrap_1_arg(gxg_pango_attr_family_new_w, gxg_pango_attr_family_new)
+Xen_wrap_3_args(gxg_pango_attr_foreground_new_w, gxg_pango_attr_foreground_new)
+Xen_wrap_3_args(gxg_pango_attr_background_new_w, gxg_pango_attr_background_new)
+Xen_wrap_1_arg(gxg_pango_attr_size_new_w, gxg_pango_attr_size_new)
+Xen_wrap_1_arg(gxg_pango_attr_style_new_w, gxg_pango_attr_style_new)
+Xen_wrap_1_arg(gxg_pango_attr_weight_new_w, gxg_pango_attr_weight_new)
+Xen_wrap_1_arg(gxg_pango_attr_variant_new_w, gxg_pango_attr_variant_new)
+Xen_wrap_1_arg(gxg_pango_attr_stretch_new_w, gxg_pango_attr_stretch_new)
+Xen_wrap_1_arg(gxg_pango_attr_font_desc_new_w, gxg_pango_attr_font_desc_new)
+Xen_wrap_1_arg(gxg_pango_attr_underline_new_w, gxg_pango_attr_underline_new)
+Xen_wrap_1_arg(gxg_pango_attr_strikethrough_new_w, gxg_pango_attr_strikethrough_new)
+Xen_wrap_1_arg(gxg_pango_attr_rise_new_w, gxg_pango_attr_rise_new)
+Xen_wrap_2_args(gxg_pango_attr_shape_new_w, gxg_pango_attr_shape_new)
+Xen_wrap_1_arg(gxg_pango_attr_scale_new_w, gxg_pango_attr_scale_new)
+Xen_wrap_no_args(gxg_pango_attr_list_new_w, gxg_pango_attr_list_new)
+Xen_wrap_1_arg(gxg_pango_attr_list_unref_w, gxg_pango_attr_list_unref)
+Xen_wrap_1_arg(gxg_pango_attr_list_copy_w, gxg_pango_attr_list_copy)
+Xen_wrap_2_args(gxg_pango_attr_list_insert_w, gxg_pango_attr_list_insert)
+Xen_wrap_2_args(gxg_pango_attr_list_insert_before_w, gxg_pango_attr_list_insert_before)
+Xen_wrap_2_args(gxg_pango_attr_list_change_w, gxg_pango_attr_list_change)
+Xen_wrap_4_args(gxg_pango_attr_list_splice_w, gxg_pango_attr_list_splice)
+Xen_wrap_1_arg(gxg_pango_attr_list_get_iterator_w, gxg_pango_attr_list_get_iterator)
+Xen_wrap_3_optional_args(gxg_pango_attr_iterator_range_w, gxg_pango_attr_iterator_range)
+Xen_wrap_1_arg(gxg_pango_attr_iterator_next_w, gxg_pango_attr_iterator_next)
+Xen_wrap_1_arg(gxg_pango_attr_iterator_copy_w, gxg_pango_attr_iterator_copy)
+Xen_wrap_1_arg(gxg_pango_attr_iterator_destroy_w, gxg_pango_attr_iterator_destroy)
+Xen_wrap_2_args(gxg_pango_attr_iterator_get_w, gxg_pango_attr_iterator_get)
+Xen_wrap_4_optional_args(gxg_pango_attr_iterator_get_font_w, gxg_pango_attr_iterator_get_font)
+Xen_wrap_7_optional_args(gxg_pango_parse_markup_w, gxg_pango_parse_markup)
+Xen_wrap_5_args(gxg_pango_break_w, gxg_pango_break)
+Xen_wrap_4_optional_args(gxg_pango_find_paragraph_boundary_w, gxg_pango_find_paragraph_boundary)
+Xen_wrap_6_args(gxg_pango_get_log_attrs_w, gxg_pango_get_log_attrs)
+Xen_wrap_3_optional_args(gxg_pango_context_list_families_w, gxg_pango_context_list_families)
+Xen_wrap_2_args(gxg_pango_context_load_font_w, gxg_pango_context_load_font)
+Xen_wrap_3_args(gxg_pango_context_load_fontset_w, gxg_pango_context_load_fontset)
+Xen_wrap_3_args(gxg_pango_context_get_metrics_w, gxg_pango_context_get_metrics)
+Xen_wrap_2_args(gxg_pango_context_set_font_description_w, gxg_pango_context_set_font_description)
+Xen_wrap_1_arg(gxg_pango_context_get_font_description_w, gxg_pango_context_get_font_description)
+Xen_wrap_1_arg(gxg_pango_context_get_language_w, gxg_pango_context_get_language)
+Xen_wrap_2_args(gxg_pango_context_set_language_w, gxg_pango_context_set_language)
+Xen_wrap_2_args(gxg_pango_context_set_base_dir_w, gxg_pango_context_set_base_dir)
+Xen_wrap_1_arg(gxg_pango_context_get_base_dir_w, gxg_pango_context_get_base_dir)
+Xen_wrap_6_args(gxg_pango_itemize_w, gxg_pango_itemize)
+Xen_wrap_no_args(gxg_pango_coverage_new_w, gxg_pango_coverage_new)
+Xen_wrap_1_arg(gxg_pango_coverage_ref_w, gxg_pango_coverage_ref)
+Xen_wrap_1_arg(gxg_pango_coverage_unref_w, gxg_pango_coverage_unref)
+Xen_wrap_1_arg(gxg_pango_coverage_copy_w, gxg_pango_coverage_copy)
+Xen_wrap_2_args(gxg_pango_coverage_get_w, gxg_pango_coverage_get)
+Xen_wrap_3_args(gxg_pango_coverage_set_w, gxg_pango_coverage_set)
+Xen_wrap_2_args(gxg_pango_coverage_max_w, gxg_pango_coverage_max)
+Xen_wrap_3_optional_args(gxg_pango_coverage_to_bytes_w, gxg_pango_coverage_to_bytes)
+Xen_wrap_2_args(gxg_pango_coverage_from_bytes_w, gxg_pango_coverage_from_bytes)
+Xen_wrap_no_args(gxg_pango_font_description_new_w, gxg_pango_font_description_new)
+Xen_wrap_1_arg(gxg_pango_font_description_copy_w, gxg_pango_font_description_copy)
+Xen_wrap_1_arg(gxg_pango_font_description_copy_static_w, gxg_pango_font_description_copy_static)
+Xen_wrap_1_arg(gxg_pango_font_description_hash_w, gxg_pango_font_description_hash)
+Xen_wrap_2_args(gxg_pango_font_description_equal_w, gxg_pango_font_description_equal)
+Xen_wrap_1_arg(gxg_pango_font_description_free_w, gxg_pango_font_description_free)
+Xen_wrap_2_args(gxg_pango_font_descriptions_free_w, gxg_pango_font_descriptions_free)
+Xen_wrap_2_args(gxg_pango_font_description_set_family_w, gxg_pango_font_description_set_family)
+Xen_wrap_2_args(gxg_pango_font_description_set_family_static_w, gxg_pango_font_description_set_family_static)
+Xen_wrap_1_arg(gxg_pango_font_description_get_family_w, gxg_pango_font_description_get_family)
+Xen_wrap_2_args(gxg_pango_font_description_set_style_w, gxg_pango_font_description_set_style)
+Xen_wrap_1_arg(gxg_pango_font_description_get_style_w, gxg_pango_font_description_get_style)
+Xen_wrap_2_args(gxg_pango_font_description_set_variant_w, gxg_pango_font_description_set_variant)
+Xen_wrap_1_arg(gxg_pango_font_description_get_variant_w, gxg_pango_font_description_get_variant)
+Xen_wrap_2_args(gxg_pango_font_description_set_weight_w, gxg_pango_font_description_set_weight)
+Xen_wrap_1_arg(gxg_pango_font_description_get_weight_w, gxg_pango_font_description_get_weight)
+Xen_wrap_2_args(gxg_pango_font_description_set_stretch_w, gxg_pango_font_description_set_stretch)
+Xen_wrap_1_arg(gxg_pango_font_description_get_stretch_w, gxg_pango_font_description_get_stretch)
+Xen_wrap_2_args(gxg_pango_font_description_set_size_w, gxg_pango_font_description_set_size)
+Xen_wrap_1_arg(gxg_pango_font_description_get_size_w, gxg_pango_font_description_get_size)
+Xen_wrap_1_arg(gxg_pango_font_description_get_set_fields_w, gxg_pango_font_description_get_set_fields)
+Xen_wrap_2_args(gxg_pango_font_description_unset_fields_w, gxg_pango_font_description_unset_fields)
+Xen_wrap_3_args(gxg_pango_font_description_merge_w, gxg_pango_font_description_merge)
+Xen_wrap_3_args(gxg_pango_font_description_merge_static_w, gxg_pango_font_description_merge_static)
+Xen_wrap_3_args(gxg_pango_font_description_better_match_w, gxg_pango_font_description_better_match)
+Xen_wrap_1_arg(gxg_pango_font_description_from_string_w, gxg_pango_font_description_from_string)
+Xen_wrap_1_arg(gxg_pango_font_description_to_string_w, gxg_pango_font_description_to_string)
+Xen_wrap_1_arg(gxg_pango_font_description_to_filename_w, gxg_pango_font_description_to_filename)
+Xen_wrap_1_arg(gxg_pango_font_metrics_ref_w, gxg_pango_font_metrics_ref)
+Xen_wrap_1_arg(gxg_pango_font_metrics_unref_w, gxg_pango_font_metrics_unref)
+Xen_wrap_1_arg(gxg_pango_font_metrics_get_ascent_w, gxg_pango_font_metrics_get_ascent)
+Xen_wrap_1_arg(gxg_pango_font_metrics_get_descent_w, gxg_pango_font_metrics_get_descent)
+Xen_wrap_1_arg(gxg_pango_font_metrics_get_approximate_char_width_w, gxg_pango_font_metrics_get_approximate_char_width)
+Xen_wrap_1_arg(gxg_pango_font_metrics_get_approximate_digit_width_w, gxg_pango_font_metrics_get_approximate_digit_width)
+Xen_wrap_3_optional_args(gxg_pango_font_family_list_faces_w, gxg_pango_font_family_list_faces)
+Xen_wrap_1_arg(gxg_pango_font_family_get_name_w, gxg_pango_font_family_get_name)
+Xen_wrap_1_arg(gxg_pango_font_face_describe_w, gxg_pango_font_face_describe)
+Xen_wrap_1_arg(gxg_pango_font_face_get_face_name_w, gxg_pango_font_face_get_face_name)
+Xen_wrap_1_arg(gxg_pango_font_describe_w, gxg_pango_font_describe)
+Xen_wrap_2_args(gxg_pango_font_get_coverage_w, gxg_pango_font_get_coverage)
+Xen_wrap_2_args(gxg_pango_font_get_metrics_w, gxg_pango_font_get_metrics)
+Xen_wrap_4_args(gxg_pango_font_get_glyph_extents_w, gxg_pango_font_get_glyph_extents)
+Xen_wrap_3_args(gxg_pango_font_map_load_font_w, gxg_pango_font_map_load_font)
+Xen_wrap_4_args(gxg_pango_font_map_load_fontset_w, gxg_pango_font_map_load_fontset)
+Xen_wrap_3_optional_args(gxg_pango_font_map_list_families_w, gxg_pango_font_map_list_families)
+Xen_wrap_no_args(gxg_pango_glyph_string_new_w, gxg_pango_glyph_string_new)
+Xen_wrap_2_args(gxg_pango_glyph_string_set_size_w, gxg_pango_glyph_string_set_size)
+Xen_wrap_1_arg(gxg_pango_glyph_string_copy_w, gxg_pango_glyph_string_copy)
+Xen_wrap_1_arg(gxg_pango_glyph_string_free_w, gxg_pango_glyph_string_free)
+Xen_wrap_4_args(gxg_pango_glyph_string_extents_w, gxg_pango_glyph_string_extents)
+Xen_wrap_6_args(gxg_pango_glyph_string_extents_range_w, gxg_pango_glyph_string_extents_range)
+Xen_wrap_5_optional_args(gxg_pango_glyph_string_get_logical_widths_w, gxg_pango_glyph_string_get_logical_widths)
+Xen_wrap_7_optional_args(gxg_pango_glyph_string_index_to_x_w, gxg_pango_glyph_string_index_to_x)
+Xen_wrap_7_optional_args(gxg_pango_glyph_string_x_to_index_w, gxg_pango_glyph_string_x_to_index)
+Xen_wrap_4_args(gxg_pango_shape_w, gxg_pango_shape)
+Xen_wrap_1_arg(gxg_pango_reorder_items_w, gxg_pango_reorder_items)
+Xen_wrap_no_args(gxg_pango_item_new_w, gxg_pango_item_new)
+Xen_wrap_1_arg(gxg_pango_item_copy_w, gxg_pango_item_copy)
+Xen_wrap_1_arg(gxg_pango_item_free_w, gxg_pango_item_free)
+Xen_wrap_3_args(gxg_pango_item_split_w, gxg_pango_item_split)
+Xen_wrap_1_arg(gxg_pango_layout_new_w, gxg_pango_layout_new)
+Xen_wrap_1_arg(gxg_pango_layout_copy_w, gxg_pango_layout_copy)
+Xen_wrap_1_arg(gxg_pango_layout_get_context_w, gxg_pango_layout_get_context)
+Xen_wrap_2_args(gxg_pango_layout_set_attributes_w, gxg_pango_layout_set_attributes)
+Xen_wrap_1_arg(gxg_pango_layout_get_attributes_w, gxg_pango_layout_get_attributes)
+Xen_wrap_3_args(gxg_pango_layout_set_text_w, gxg_pango_layout_set_text)
+Xen_wrap_1_arg(gxg_pango_layout_get_text_w, gxg_pango_layout_get_text)
+Xen_wrap_3_args(gxg_pango_layout_set_markup_w, gxg_pango_layout_set_markup)
+Xen_wrap_5_args(gxg_pango_layout_set_markup_with_accel_w, gxg_pango_layout_set_markup_with_accel)
+Xen_wrap_2_args(gxg_pango_layout_set_font_description_w, gxg_pango_layout_set_font_description)
+Xen_wrap_2_args(gxg_pango_layout_set_width_w, gxg_pango_layout_set_width)
+Xen_wrap_1_arg(gxg_pango_layout_get_width_w, gxg_pango_layout_get_width)
+Xen_wrap_2_args(gxg_pango_layout_set_wrap_w, gxg_pango_layout_set_wrap)
+Xen_wrap_1_arg(gxg_pango_layout_get_wrap_w, gxg_pango_layout_get_wrap)
+Xen_wrap_2_args(gxg_pango_layout_set_indent_w, gxg_pango_layout_set_indent)
+Xen_wrap_1_arg(gxg_pango_layout_get_indent_w, gxg_pango_layout_get_indent)
+Xen_wrap_2_args(gxg_pango_layout_set_spacing_w, gxg_pango_layout_set_spacing)
+Xen_wrap_1_arg(gxg_pango_layout_get_spacing_w, gxg_pango_layout_get_spacing)
+Xen_wrap_2_args(gxg_pango_layout_set_justify_w, gxg_pango_layout_set_justify)
+Xen_wrap_1_arg(gxg_pango_layout_get_justify_w, gxg_pango_layout_get_justify)
+Xen_wrap_2_args(gxg_pango_layout_set_alignment_w, gxg_pango_layout_set_alignment)
+Xen_wrap_1_arg(gxg_pango_layout_get_alignment_w, gxg_pango_layout_get_alignment)
+Xen_wrap_2_args(gxg_pango_layout_set_tabs_w, gxg_pango_layout_set_tabs)
+Xen_wrap_1_arg(gxg_pango_layout_get_tabs_w, gxg_pango_layout_get_tabs)
+Xen_wrap_2_args(gxg_pango_layout_set_single_paragraph_mode_w, gxg_pango_layout_set_single_paragraph_mode)
+Xen_wrap_1_arg(gxg_pango_layout_get_single_paragraph_mode_w, gxg_pango_layout_get_single_paragraph_mode)
+Xen_wrap_1_arg(gxg_pango_layout_context_changed_w, gxg_pango_layout_context_changed)
+Xen_wrap_3_optional_args(gxg_pango_layout_get_log_attrs_w, gxg_pango_layout_get_log_attrs)
+Xen_wrap_3_args(gxg_pango_layout_index_to_pos_w, gxg_pango_layout_index_to_pos)
+Xen_wrap_4_args(gxg_pango_layout_get_cursor_pos_w, gxg_pango_layout_get_cursor_pos)
+Xen_wrap_7_args(gxg_pango_layout_move_cursor_visually_w, gxg_pango_layout_move_cursor_visually)
+Xen_wrap_5_optional_args(gxg_pango_layout_xy_to_index_w, gxg_pango_layout_xy_to_index)
+Xen_wrap_3_args(gxg_pango_layout_get_extents_w, gxg_pango_layout_get_extents)
+Xen_wrap_3_args(gxg_pango_layout_get_pixel_extents_w, gxg_pango_layout_get_pixel_extents)
+Xen_wrap_3_optional_args(gxg_pango_layout_get_size_w, gxg_pango_layout_get_size)
+Xen_wrap_3_optional_args(gxg_pango_layout_get_pixel_size_w, gxg_pango_layout_get_pixel_size)
+Xen_wrap_1_arg(gxg_pango_layout_get_line_count_w, gxg_pango_layout_get_line_count)
+Xen_wrap_2_args(gxg_pango_layout_get_line_w, gxg_pango_layout_get_line)
+Xen_wrap_1_arg(gxg_pango_layout_get_lines_w, gxg_pango_layout_get_lines)
+Xen_wrap_1_arg(gxg_pango_layout_line_unref_w, gxg_pango_layout_line_unref)
+Xen_wrap_4_optional_args(gxg_pango_layout_line_x_to_index_w, gxg_pango_layout_line_x_to_index)
+Xen_wrap_4_optional_args(gxg_pango_layout_line_index_to_x_w, gxg_pango_layout_line_index_to_x)
+Xen_wrap_5_optional_args(gxg_pango_layout_line_get_x_ranges_w, gxg_pango_layout_line_get_x_ranges)
+Xen_wrap_3_args(gxg_pango_layout_line_get_extents_w, gxg_pango_layout_line_get_extents)
+Xen_wrap_3_args(gxg_pango_layout_line_get_pixel_extents_w, gxg_pango_layout_line_get_pixel_extents)
+Xen_wrap_1_arg(gxg_pango_layout_get_iter_w, gxg_pango_layout_get_iter)
+Xen_wrap_1_arg(gxg_pango_layout_iter_free_w, gxg_pango_layout_iter_free)
+Xen_wrap_1_arg(gxg_pango_layout_iter_get_index_w, gxg_pango_layout_iter_get_index)
+Xen_wrap_1_arg(gxg_pango_layout_iter_get_run_w, gxg_pango_layout_iter_get_run)
+Xen_wrap_1_arg(gxg_pango_layout_iter_get_line_w, gxg_pango_layout_iter_get_line)
+Xen_wrap_1_arg(gxg_pango_layout_iter_at_last_line_w, gxg_pango_layout_iter_at_last_line)
+Xen_wrap_1_arg(gxg_pango_layout_iter_next_char_w, gxg_pango_layout_iter_next_char)
+Xen_wrap_1_arg(gxg_pango_layout_iter_next_cluster_w, gxg_pango_layout_iter_next_cluster)
+Xen_wrap_1_arg(gxg_pango_layout_iter_next_run_w, gxg_pango_layout_iter_next_run)
+Xen_wrap_1_arg(gxg_pango_layout_iter_next_line_w, gxg_pango_layout_iter_next_line)
+Xen_wrap_2_args(gxg_pango_layout_iter_get_char_extents_w, gxg_pango_layout_iter_get_char_extents)
+Xen_wrap_3_args(gxg_pango_layout_iter_get_cluster_extents_w, gxg_pango_layout_iter_get_cluster_extents)
+Xen_wrap_3_args(gxg_pango_layout_iter_get_run_extents_w, gxg_pango_layout_iter_get_run_extents)
+Xen_wrap_3_args(gxg_pango_layout_iter_get_line_extents_w, gxg_pango_layout_iter_get_line_extents)
+Xen_wrap_3_optional_args(gxg_pango_layout_iter_get_line_yrange_w, gxg_pango_layout_iter_get_line_yrange)
+Xen_wrap_3_args(gxg_pango_layout_iter_get_layout_extents_w, gxg_pango_layout_iter_get_layout_extents)
+Xen_wrap_1_arg(gxg_pango_layout_iter_get_baseline_w, gxg_pango_layout_iter_get_baseline)
+Xen_wrap_1_arg(gxg_pango_language_from_string_w, gxg_pango_language_from_string)
+Xen_wrap_2_args(gxg_pango_language_matches_w, gxg_pango_language_matches)
+Xen_wrap_1_arg(gxg_G_OBJECT_TYPE_w, gxg_G_OBJECT_TYPE)
+Xen_wrap_2_args(gxg_gtk_tree_model_get_string_from_iter_w, gxg_gtk_tree_model_get_string_from_iter)
+Xen_wrap_2_args(gxg_gtk_tree_model_sort_iter_is_valid_w, gxg_gtk_tree_model_sort_iter_is_valid)
+Xen_wrap_2_args(gxg_gtk_tree_view_expand_to_path_w, gxg_gtk_tree_view_expand_to_path)
+Xen_wrap_2_args(gxg_gtk_tree_selection_get_selected_rows_w, gxg_gtk_tree_selection_get_selected_rows)
+Xen_wrap_1_arg(gxg_gtk_tree_selection_count_selected_rows_w, gxg_gtk_tree_selection_count_selected_rows)
+Xen_wrap_2_args(gxg_gtk_menu_shell_select_first_w, gxg_gtk_menu_shell_select_first)
+Xen_wrap_1_arg(gxg_gtk_notebook_get_n_pages_w, gxg_gtk_notebook_get_n_pages)
+Xen_wrap_2_args(gxg_gtk_list_store_reorder_w, gxg_gtk_list_store_reorder)
+Xen_wrap_3_args(gxg_gtk_list_store_swap_w, gxg_gtk_list_store_swap)
+Xen_wrap_3_args(gxg_gtk_list_store_move_after_w, gxg_gtk_list_store_move_after)
+Xen_wrap_3_args(gxg_gtk_list_store_move_before_w, gxg_gtk_list_store_move_before)
+Xen_wrap_3_args(gxg_gtk_tree_store_reorder_w, gxg_gtk_tree_store_reorder)
+Xen_wrap_3_args(gxg_gtk_tree_store_swap_w, gxg_gtk_tree_store_swap)
+Xen_wrap_1_arg(gxg_gdk_display_open_w, gxg_gdk_display_open)
+Xen_wrap_1_arg(gxg_gdk_display_get_name_w, gxg_gdk_display_get_name)
+Xen_wrap_2_args(gxg_gdk_display_get_screen_w, gxg_gdk_display_get_screen)
+Xen_wrap_1_arg(gxg_gdk_display_get_default_screen_w, gxg_gdk_display_get_default_screen)
+Xen_wrap_1_arg(gxg_gdk_display_beep_w, gxg_gdk_display_beep)
+Xen_wrap_1_arg(gxg_gdk_display_sync_w, gxg_gdk_display_sync)
+Xen_wrap_1_arg(gxg_gdk_display_close_w, gxg_gdk_display_close)
+Xen_wrap_1_arg(gxg_gdk_display_get_event_w, gxg_gdk_display_get_event)
+Xen_wrap_1_arg(gxg_gdk_display_peek_event_w, gxg_gdk_display_peek_event)
+Xen_wrap_2_args(gxg_gdk_display_put_event_w, gxg_gdk_display_put_event)
+Xen_wrap_2_args(gxg_gdk_display_set_double_click_time_w, gxg_gdk_display_set_double_click_time)
+Xen_wrap_no_args(gxg_gdk_display_get_default_w, gxg_gdk_display_get_default)
+Xen_wrap_1_arg(gxg_gdk_screen_get_system_visual_w, gxg_gdk_screen_get_system_visual)
+Xen_wrap_1_arg(gxg_gdk_screen_get_root_window_w, gxg_gdk_screen_get_root_window)
+Xen_wrap_1_arg(gxg_gdk_screen_get_display_w, gxg_gdk_screen_get_display)
+Xen_wrap_1_arg(gxg_gdk_screen_get_number_w, gxg_gdk_screen_get_number)
+Xen_wrap_1_arg(gxg_gdk_screen_get_width_w, gxg_gdk_screen_get_width)
+Xen_wrap_1_arg(gxg_gdk_screen_get_height_w, gxg_gdk_screen_get_height)
+Xen_wrap_1_arg(gxg_gdk_screen_get_width_mm_w, gxg_gdk_screen_get_width_mm)
+Xen_wrap_1_arg(gxg_gdk_screen_get_height_mm_w, gxg_gdk_screen_get_height_mm)
+Xen_wrap_1_arg(gxg_gdk_screen_list_visuals_w, gxg_gdk_screen_list_visuals)
+Xen_wrap_1_arg(gxg_gdk_screen_get_toplevel_windows_w, gxg_gdk_screen_get_toplevel_windows)
+Xen_wrap_1_arg(gxg_gdk_screen_make_display_name_w, gxg_gdk_screen_make_display_name)
+Xen_wrap_1_arg(gxg_gdk_screen_get_n_monitors_w, gxg_gdk_screen_get_n_monitors)
+Xen_wrap_3_args(gxg_gdk_screen_get_monitor_geometry_w, gxg_gdk_screen_get_monitor_geometry)
+Xen_wrap_3_args(gxg_gdk_screen_get_monitor_at_point_w, gxg_gdk_screen_get_monitor_at_point)
+Xen_wrap_2_args(gxg_gdk_screen_get_monitor_at_window_w, gxg_gdk_screen_get_monitor_at_window)
+Xen_wrap_no_args(gxg_gdk_screen_get_default_w, gxg_gdk_screen_get_default)
+Xen_wrap_2_args(gxg_gtk_clipboard_get_for_display_w, gxg_gtk_clipboard_get_for_display)
+Xen_wrap_1_arg(gxg_gtk_clipboard_get_display_w, gxg_gtk_clipboard_get_display)
+Xen_wrap_1_arg(gxg_gtk_widget_get_screen_w, gxg_gtk_widget_get_screen)
+Xen_wrap_1_arg(gxg_gtk_widget_has_screen_w, gxg_gtk_widget_has_screen)
+Xen_wrap_1_arg(gxg_gtk_widget_get_display_w, gxg_gtk_widget_get_display)
+Xen_wrap_2_args(gxg_gtk_widget_get_clipboard_w, gxg_gtk_widget_get_clipboard)
+Xen_wrap_1_arg(gxg_g_list_free_w, gxg_g_list_free)
+Xen_wrap_1_arg(gxg_g_list_reverse_w, gxg_g_list_reverse)
+Xen_wrap_1_arg(gxg_g_list_copy_w, gxg_g_list_copy)
+Xen_wrap_1_arg(gxg_g_list_last_w, gxg_g_list_last)
+Xen_wrap_1_arg(gxg_g_list_first_w, gxg_g_list_first)
+Xen_wrap_1_arg(gxg_g_list_length_w, gxg_g_list_length)
+Xen_wrap_1_arg(gxg_g_free_w, gxg_g_free)
+Xen_wrap_2_args(gxg_g_list_remove_link_w, gxg_g_list_remove_link)
+Xen_wrap_2_args(gxg_g_object_get_data_w, gxg_g_object_get_data)
+Xen_wrap_3_args(gxg_g_object_set_data_w, gxg_g_object_set_data)
+Xen_wrap_4_args(gxg_gdk_cursor_new_from_pixbuf_w, gxg_gdk_cursor_new_from_pixbuf)
+Xen_wrap_1_arg(gxg_gdk_display_flush_w, gxg_gdk_display_flush)
+Xen_wrap_1_arg(gxg_gdk_display_supports_cursor_alpha_w, gxg_gdk_display_supports_cursor_alpha)
+Xen_wrap_1_arg(gxg_gdk_display_supports_cursor_color_w, gxg_gdk_display_supports_cursor_color)
+Xen_wrap_1_arg(gxg_gdk_display_get_default_cursor_size_w, gxg_gdk_display_get_default_cursor_size)
+Xen_wrap_3_optional_args(gxg_gdk_display_get_maximal_cursor_size_w, gxg_gdk_display_get_maximal_cursor_size)
+Xen_wrap_2_args(gxg_gdk_window_set_keep_above_w, gxg_gdk_window_set_keep_above)
+Xen_wrap_2_args(gxg_gdk_window_set_keep_below_w, gxg_gdk_window_set_keep_below)
+Xen_wrap_2_args(gxg_gtk_button_box_get_child_secondary_w, gxg_gtk_button_box_get_child_secondary)
+Xen_wrap_2_args(gxg_gtk_calendar_set_display_options_w, gxg_gtk_calendar_set_display_options)
+Xen_wrap_1_arg(gxg_gtk_calendar_get_display_options_w, gxg_gtk_calendar_get_display_options)
+Xen_wrap_2_args(gxg_gtk_check_menu_item_set_draw_as_radio_w, gxg_gtk_check_menu_item_set_draw_as_radio)
+Xen_wrap_1_arg(gxg_gtk_check_menu_item_get_draw_as_radio_w, gxg_gtk_check_menu_item_get_draw_as_radio)
+Xen_wrap_2_args(gxg_gtk_entry_set_completion_w, gxg_gtk_entry_set_completion)
+Xen_wrap_1_arg(gxg_gtk_entry_get_completion_w, gxg_gtk_entry_get_completion)
+Xen_wrap_1_arg(gxg_gtk_event_box_get_visible_window_w, gxg_gtk_event_box_get_visible_window)
+Xen_wrap_2_args(gxg_gtk_event_box_set_visible_window_w, gxg_gtk_event_box_set_visible_window)
+Xen_wrap_1_arg(gxg_gtk_event_box_get_above_child_w, gxg_gtk_event_box_get_above_child)
+Xen_wrap_2_args(gxg_gtk_event_box_set_above_child_w, gxg_gtk_event_box_set_above_child)
+Xen_wrap_6_args(gxg_gtk_menu_attach_w, gxg_gtk_menu_attach)
+Xen_wrap_3_args(gxg_gtk_text_buffer_select_range_w, gxg_gtk_text_buffer_select_range)
+Xen_wrap_2_args(gxg_gtk_text_view_set_overwrite_w, gxg_gtk_text_view_set_overwrite)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_overwrite_w, gxg_gtk_text_view_get_overwrite)
+Xen_wrap_2_args(gxg_gtk_text_view_set_accepts_tab_w, gxg_gtk_text_view_set_accepts_tab)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_accepts_tab_w, gxg_gtk_text_view_get_accepts_tab)
+Xen_wrap_3_args(gxg_gtk_toolbar_insert_w, gxg_gtk_toolbar_insert)
+Xen_wrap_2_args(gxg_gtk_toolbar_get_item_index_w, gxg_gtk_toolbar_get_item_index)
+Xen_wrap_1_arg(gxg_gtk_toolbar_get_n_items_w, gxg_gtk_toolbar_get_n_items)
+Xen_wrap_2_args(gxg_gtk_toolbar_get_nth_item_w, gxg_gtk_toolbar_get_nth_item)
+Xen_wrap_2_args(gxg_gtk_toolbar_set_show_arrow_w, gxg_gtk_toolbar_set_show_arrow)
+Xen_wrap_1_arg(gxg_gtk_toolbar_get_show_arrow_w, gxg_gtk_toolbar_get_show_arrow)
+Xen_wrap_1_arg(gxg_gtk_toolbar_get_relief_style_w, gxg_gtk_toolbar_get_relief_style)
+Xen_wrap_3_args(gxg_gtk_toolbar_get_drop_index_w, gxg_gtk_toolbar_get_drop_index)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_set_expand_w, gxg_gtk_tree_view_column_set_expand)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_expand_w, gxg_gtk_tree_view_column_get_expand)
+Xen_wrap_2_args(gxg_gtk_widget_set_no_show_all_w, gxg_gtk_widget_set_no_show_all)
+Xen_wrap_1_arg(gxg_gtk_widget_get_no_show_all_w, gxg_gtk_widget_get_no_show_all)
+Xen_wrap_1_arg(gxg_gtk_widget_queue_resize_no_redraw_w, gxg_gtk_widget_queue_resize_no_redraw)
+Xen_wrap_1_arg(gxg_gtk_window_set_default_icon_w, gxg_gtk_window_set_default_icon)
+Xen_wrap_2_args(gxg_gtk_window_set_keep_above_w, gxg_gtk_window_set_keep_above)
+Xen_wrap_2_args(gxg_gtk_window_set_keep_below_w, gxg_gtk_window_set_keep_below)
+Xen_wrap_4_optional_args(gxg_gtk_file_chooser_dialog_new_w, gxg_gtk_file_chooser_dialog_new)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_widget_new_w, gxg_gtk_file_chooser_widget_new)
+Xen_wrap_2_args(gxg_gtk_tree_model_filter_new_w, gxg_gtk_tree_model_filter_new)
+Xen_wrap_2_args(gxg_gtk_tree_model_filter_set_visible_column_w, gxg_gtk_tree_model_filter_set_visible_column)
+Xen_wrap_1_arg(gxg_gtk_tree_model_filter_get_model_w, gxg_gtk_tree_model_filter_get_model)
+Xen_wrap_3_args(gxg_gtk_tree_model_filter_convert_iter_to_child_iter_w, gxg_gtk_tree_model_filter_convert_iter_to_child_iter)
+Xen_wrap_2_args(gxg_gtk_tree_model_filter_convert_child_path_to_path_w, gxg_gtk_tree_model_filter_convert_child_path_to_path)
+Xen_wrap_2_args(gxg_gtk_tree_model_filter_convert_path_to_child_path_w, gxg_gtk_tree_model_filter_convert_path_to_child_path)
+Xen_wrap_1_arg(gxg_gtk_tree_model_filter_refilter_w, gxg_gtk_tree_model_filter_refilter)
+Xen_wrap_1_arg(gxg_gtk_tree_model_filter_clear_cache_w, gxg_gtk_tree_model_filter_clear_cache)
+Xen_wrap_no_args(gxg_gtk_combo_box_new_w, gxg_gtk_combo_box_new)
+Xen_wrap_1_arg(gxg_gtk_combo_box_new_with_model_w, gxg_gtk_combo_box_new_with_model)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_model_w, gxg_gtk_combo_box_set_model)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_wrap_width_w, gxg_gtk_combo_box_set_wrap_width)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_row_span_column_w, gxg_gtk_combo_box_set_row_span_column)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_column_span_column_w, gxg_gtk_combo_box_set_column_span_column)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_active_w, gxg_gtk_combo_box_get_active)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_active_w, gxg_gtk_combo_box_set_active)
+Xen_wrap_2_args(gxg_gtk_combo_box_get_active_iter_w, gxg_gtk_combo_box_get_active_iter)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_active_iter_w, gxg_gtk_combo_box_set_active_iter)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_model_w, gxg_gtk_combo_box_get_model)
+Xen_wrap_1_arg(gxg_gtk_expander_new_w, gxg_gtk_expander_new)
+Xen_wrap_1_arg(gxg_gtk_expander_new_with_mnemonic_w, gxg_gtk_expander_new_with_mnemonic)
+Xen_wrap_2_args(gxg_gtk_expander_set_expanded_w, gxg_gtk_expander_set_expanded)
+Xen_wrap_1_arg(gxg_gtk_expander_get_expanded_w, gxg_gtk_expander_get_expanded)
+Xen_wrap_2_args(gxg_gtk_expander_set_spacing_w, gxg_gtk_expander_set_spacing)
+Xen_wrap_1_arg(gxg_gtk_expander_get_spacing_w, gxg_gtk_expander_get_spacing)
+Xen_wrap_2_args(gxg_gtk_expander_set_label_w, gxg_gtk_expander_set_label)
+Xen_wrap_1_arg(gxg_gtk_expander_get_label_w, gxg_gtk_expander_get_label)
+Xen_wrap_2_args(gxg_gtk_expander_set_use_underline_w, gxg_gtk_expander_set_use_underline)
+Xen_wrap_1_arg(gxg_gtk_expander_get_use_underline_w, gxg_gtk_expander_get_use_underline)
+Xen_wrap_2_args(gxg_gtk_expander_set_label_widget_w, gxg_gtk_expander_set_label_widget)
+Xen_wrap_1_arg(gxg_gtk_expander_get_label_widget_w, gxg_gtk_expander_get_label_widget)
+Xen_wrap_2_args(gxg_gtk_expander_set_use_markup_w, gxg_gtk_expander_set_use_markup)
+Xen_wrap_1_arg(gxg_gtk_expander_get_use_markup_w, gxg_gtk_expander_get_use_markup)
+Xen_wrap_no_args(gxg_gtk_font_button_new_w, gxg_gtk_font_button_new)
+Xen_wrap_1_arg(gxg_gtk_font_button_new_with_font_w, gxg_gtk_font_button_new_with_font)
+Xen_wrap_1_arg(gxg_gtk_font_button_get_title_w, gxg_gtk_font_button_get_title)
+Xen_wrap_2_args(gxg_gtk_font_button_set_title_w, gxg_gtk_font_button_set_title)
+Xen_wrap_1_arg(gxg_gtk_font_button_get_use_font_w, gxg_gtk_font_button_get_use_font)
+Xen_wrap_2_args(gxg_gtk_font_button_set_use_font_w, gxg_gtk_font_button_set_use_font)
+Xen_wrap_1_arg(gxg_gtk_font_button_get_use_size_w, gxg_gtk_font_button_get_use_size)
+Xen_wrap_2_args(gxg_gtk_font_button_set_use_size_w, gxg_gtk_font_button_set_use_size)
+Xen_wrap_1_arg(gxg_gtk_font_button_get_font_name_w, gxg_gtk_font_button_get_font_name)
+Xen_wrap_2_args(gxg_gtk_font_button_set_font_name_w, gxg_gtk_font_button_set_font_name)
+Xen_wrap_1_arg(gxg_gtk_font_button_get_show_style_w, gxg_gtk_font_button_get_show_style)
+Xen_wrap_2_args(gxg_gtk_font_button_set_show_style_w, gxg_gtk_font_button_set_show_style)
+Xen_wrap_1_arg(gxg_gtk_font_button_get_show_size_w, gxg_gtk_font_button_get_show_size)
+Xen_wrap_2_args(gxg_gtk_font_button_set_show_size_w, gxg_gtk_font_button_set_show_size)
+Xen_wrap_no_args(gxg_gtk_entry_completion_new_w, gxg_gtk_entry_completion_new)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_entry_w, gxg_gtk_entry_completion_get_entry)
+Xen_wrap_2_args(gxg_gtk_entry_completion_set_model_w, gxg_gtk_entry_completion_set_model)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_model_w, gxg_gtk_entry_completion_get_model)
+Xen_wrap_4_args(gxg_gtk_entry_completion_set_match_func_w, gxg_gtk_entry_completion_set_match_func)
+Xen_wrap_2_args(gxg_gtk_entry_completion_set_minimum_key_length_w, gxg_gtk_entry_completion_set_minimum_key_length)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_minimum_key_length_w, gxg_gtk_entry_completion_get_minimum_key_length)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_complete_w, gxg_gtk_entry_completion_complete)
+Xen_wrap_3_args(gxg_gtk_entry_completion_insert_action_text_w, gxg_gtk_entry_completion_insert_action_text)
+Xen_wrap_3_args(gxg_gtk_entry_completion_insert_action_markup_w, gxg_gtk_entry_completion_insert_action_markup)
+Xen_wrap_2_args(gxg_gtk_entry_completion_delete_action_w, gxg_gtk_entry_completion_delete_action)
+Xen_wrap_2_args(gxg_gtk_entry_completion_set_text_column_w, gxg_gtk_entry_completion_set_text_column)
+Xen_wrap_1_arg(gxg_gtk_radio_tool_button_new_w, gxg_gtk_radio_tool_button_new)
+Xen_wrap_1_arg(gxg_gtk_radio_tool_button_new_from_widget_w, gxg_gtk_radio_tool_button_new_from_widget)
+Xen_wrap_1_arg(gxg_gtk_radio_tool_button_get_group_w, gxg_gtk_radio_tool_button_get_group)
+Xen_wrap_2_args(gxg_gtk_radio_tool_button_set_group_w, gxg_gtk_radio_tool_button_set_group)
+Xen_wrap_no_args(gxg_gtk_separator_tool_item_new_w, gxg_gtk_separator_tool_item_new)
+Xen_wrap_1_arg(gxg_gtk_separator_tool_item_get_draw_w, gxg_gtk_separator_tool_item_get_draw)
+Xen_wrap_2_args(gxg_gtk_separator_tool_item_set_draw_w, gxg_gtk_separator_tool_item_set_draw)
+Xen_wrap_no_args(gxg_gtk_toggle_tool_button_new_w, gxg_gtk_toggle_tool_button_new)
+Xen_wrap_2_args(gxg_gtk_toggle_tool_button_set_active_w, gxg_gtk_toggle_tool_button_set_active)
+Xen_wrap_1_arg(gxg_gtk_toggle_tool_button_get_active_w, gxg_gtk_toggle_tool_button_get_active)
+Xen_wrap_5_args(gxg_g_timeout_add_full_w, gxg_g_timeout_add_full)
+Xen_wrap_3_optional_args(gxg_g_timeout_add_w, gxg_g_timeout_add)
+Xen_wrap_2_optional_args(gxg_g_idle_add_w, gxg_g_idle_add)
+Xen_wrap_4_args(gxg_g_idle_add_full_w, gxg_g_idle_add_full)
+Xen_wrap_1_arg(gxg_g_idle_remove_by_data_w, gxg_g_idle_remove_by_data)
+Xen_wrap_1_arg(gxg_g_source_remove_w, gxg_g_source_remove)
+Xen_wrap_no_args(gxg_gtk_file_filter_new_w, gxg_gtk_file_filter_new)
+Xen_wrap_2_args(gxg_gtk_file_filter_set_name_w, gxg_gtk_file_filter_set_name)
+Xen_wrap_1_arg(gxg_gtk_file_filter_get_name_w, gxg_gtk_file_filter_get_name)
+Xen_wrap_2_args(gxg_gtk_file_filter_add_mime_type_w, gxg_gtk_file_filter_add_mime_type)
+Xen_wrap_2_args(gxg_gtk_file_filter_add_pattern_w, gxg_gtk_file_filter_add_pattern)
+Xen_wrap_5_args(gxg_gtk_file_filter_add_custom_w, gxg_gtk_file_filter_add_custom)
+Xen_wrap_1_arg(gxg_gtk_file_filter_get_needed_w, gxg_gtk_file_filter_get_needed)
+Xen_wrap_2_args(gxg_gtk_file_filter_filter_w, gxg_gtk_file_filter_filter)
+Xen_wrap_3_args(gxg_gtk_cell_layout_pack_start_w, gxg_gtk_cell_layout_pack_start)
+Xen_wrap_3_args(gxg_gtk_cell_layout_pack_end_w, gxg_gtk_cell_layout_pack_end)
+Xen_wrap_1_arg(gxg_gtk_cell_layout_clear_w, gxg_gtk_cell_layout_clear)
+Xen_wrap_3_args(gxg_gtk_cell_layout_set_attributes_w, gxg_gtk_cell_layout_set_attributes)
+Xen_wrap_4_args(gxg_gtk_cell_layout_add_attribute_w, gxg_gtk_cell_layout_add_attribute)
+Xen_wrap_5_args(gxg_gtk_cell_layout_set_cell_data_func_w, gxg_gtk_cell_layout_set_cell_data_func)
+Xen_wrap_2_args(gxg_gtk_cell_layout_clear_attributes_w, gxg_gtk_cell_layout_clear_attributes)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_action_w, gxg_gtk_file_chooser_set_action)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_action_w, gxg_gtk_file_chooser_get_action)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_local_only_w, gxg_gtk_file_chooser_set_local_only)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_local_only_w, gxg_gtk_file_chooser_get_local_only)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_select_multiple_w, gxg_gtk_file_chooser_set_select_multiple)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_select_multiple_w, gxg_gtk_file_chooser_get_select_multiple)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_current_name_w, gxg_gtk_file_chooser_set_current_name)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_filename_w, gxg_gtk_file_chooser_get_filename)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_filename_w, gxg_gtk_file_chooser_set_filename)
+Xen_wrap_2_args(gxg_gtk_file_chooser_select_filename_w, gxg_gtk_file_chooser_select_filename)
+Xen_wrap_2_args(gxg_gtk_file_chooser_unselect_filename_w, gxg_gtk_file_chooser_unselect_filename)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_select_all_w, gxg_gtk_file_chooser_select_all)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_unselect_all_w, gxg_gtk_file_chooser_unselect_all)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_filenames_w, gxg_gtk_file_chooser_get_filenames)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_current_folder_w, gxg_gtk_file_chooser_set_current_folder)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_current_folder_w, gxg_gtk_file_chooser_get_current_folder)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_uri_w, gxg_gtk_file_chooser_get_uri)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_uri_w, gxg_gtk_file_chooser_set_uri)
+Xen_wrap_2_args(gxg_gtk_file_chooser_select_uri_w, gxg_gtk_file_chooser_select_uri)
+Xen_wrap_2_args(gxg_gtk_file_chooser_unselect_uri_w, gxg_gtk_file_chooser_unselect_uri)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_uris_w, gxg_gtk_file_chooser_get_uris)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_current_folder_uri_w, gxg_gtk_file_chooser_set_current_folder_uri)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_current_folder_uri_w, gxg_gtk_file_chooser_get_current_folder_uri)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_preview_widget_w, gxg_gtk_file_chooser_set_preview_widget)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_preview_widget_w, gxg_gtk_file_chooser_get_preview_widget)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_preview_widget_active_w, gxg_gtk_file_chooser_set_preview_widget_active)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_preview_widget_active_w, gxg_gtk_file_chooser_get_preview_widget_active)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_preview_filename_w, gxg_gtk_file_chooser_get_preview_filename)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_preview_uri_w, gxg_gtk_file_chooser_get_preview_uri)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_extra_widget_w, gxg_gtk_file_chooser_set_extra_widget)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_extra_widget_w, gxg_gtk_file_chooser_get_extra_widget)
+Xen_wrap_2_args(gxg_gtk_file_chooser_add_filter_w, gxg_gtk_file_chooser_add_filter)
+Xen_wrap_2_args(gxg_gtk_file_chooser_remove_filter_w, gxg_gtk_file_chooser_remove_filter)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_list_filters_w, gxg_gtk_file_chooser_list_filters)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_filter_w, gxg_gtk_file_chooser_set_filter)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_filter_w, gxg_gtk_file_chooser_get_filter)
+Xen_wrap_3_optional_args(gxg_gtk_file_chooser_add_shortcut_folder_w, gxg_gtk_file_chooser_add_shortcut_folder)
+Xen_wrap_3_optional_args(gxg_gtk_file_chooser_remove_shortcut_folder_w, gxg_gtk_file_chooser_remove_shortcut_folder)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_list_shortcut_folders_w, gxg_gtk_file_chooser_list_shortcut_folders)
+Xen_wrap_3_optional_args(gxg_gtk_file_chooser_add_shortcut_folder_uri_w, gxg_gtk_file_chooser_add_shortcut_folder_uri)
+Xen_wrap_3_optional_args(gxg_gtk_file_chooser_remove_shortcut_folder_uri_w, gxg_gtk_file_chooser_remove_shortcut_folder_uri)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_list_shortcut_folder_uris_w, gxg_gtk_file_chooser_list_shortcut_folder_uris)
+Xen_wrap_no_args(gxg_gtk_icon_theme_new_w, gxg_gtk_icon_theme_new)
+Xen_wrap_no_args(gxg_gtk_icon_theme_get_default_w, gxg_gtk_icon_theme_get_default)
+Xen_wrap_1_arg(gxg_gtk_icon_theme_get_for_screen_w, gxg_gtk_icon_theme_get_for_screen)
+Xen_wrap_2_args(gxg_gtk_icon_theme_set_screen_w, gxg_gtk_icon_theme_set_screen)
+Xen_wrap_3_optional_args(gxg_gtk_icon_theme_get_search_path_w, gxg_gtk_icon_theme_get_search_path)
+Xen_wrap_2_args(gxg_gtk_icon_theme_append_search_path_w, gxg_gtk_icon_theme_append_search_path)
+Xen_wrap_2_args(gxg_gtk_icon_theme_prepend_search_path_w, gxg_gtk_icon_theme_prepend_search_path)
+Xen_wrap_2_args(gxg_gtk_icon_theme_set_custom_theme_w, gxg_gtk_icon_theme_set_custom_theme)
+Xen_wrap_2_args(gxg_gtk_icon_theme_has_icon_w, gxg_gtk_icon_theme_has_icon)
+Xen_wrap_4_args(gxg_gtk_icon_theme_lookup_icon_w, gxg_gtk_icon_theme_lookup_icon)
+Xen_wrap_5_optional_args(gxg_gtk_icon_theme_load_icon_w, gxg_gtk_icon_theme_load_icon)
+Xen_wrap_2_args(gxg_gtk_icon_theme_list_icons_w, gxg_gtk_icon_theme_list_icons)
+Xen_wrap_1_arg(gxg_gtk_icon_theme_get_example_icon_name_w, gxg_gtk_icon_theme_get_example_icon_name)
+Xen_wrap_1_arg(gxg_gtk_icon_theme_rescan_if_needed_w, gxg_gtk_icon_theme_rescan_if_needed)
+Xen_wrap_1_arg(gxg_gtk_icon_info_get_base_size_w, gxg_gtk_icon_info_get_base_size)
+Xen_wrap_1_arg(gxg_gtk_icon_info_get_filename_w, gxg_gtk_icon_info_get_filename)
+Xen_wrap_2_optional_args(gxg_gtk_icon_info_load_icon_w, gxg_gtk_icon_info_load_icon)
+Xen_wrap_2_args(gxg_gtk_tool_button_new_w, gxg_gtk_tool_button_new)
+Xen_wrap_2_args(gxg_gtk_tool_button_set_label_w, gxg_gtk_tool_button_set_label)
+Xen_wrap_1_arg(gxg_gtk_tool_button_get_label_w, gxg_gtk_tool_button_get_label)
+Xen_wrap_2_args(gxg_gtk_tool_button_set_use_underline_w, gxg_gtk_tool_button_set_use_underline)
+Xen_wrap_1_arg(gxg_gtk_tool_button_get_use_underline_w, gxg_gtk_tool_button_get_use_underline)
+Xen_wrap_2_args(gxg_gtk_tool_button_set_icon_widget_w, gxg_gtk_tool_button_set_icon_widget)
+Xen_wrap_1_arg(gxg_gtk_tool_button_get_icon_widget_w, gxg_gtk_tool_button_get_icon_widget)
+Xen_wrap_2_args(gxg_gtk_tool_button_set_label_widget_w, gxg_gtk_tool_button_set_label_widget)
+Xen_wrap_1_arg(gxg_gtk_tool_button_get_label_widget_w, gxg_gtk_tool_button_get_label_widget)
+Xen_wrap_no_args(gxg_gtk_tool_item_new_w, gxg_gtk_tool_item_new)
+Xen_wrap_2_args(gxg_gtk_tool_item_set_homogeneous_w, gxg_gtk_tool_item_set_homogeneous)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_homogeneous_w, gxg_gtk_tool_item_get_homogeneous)
+Xen_wrap_2_args(gxg_gtk_tool_item_set_expand_w, gxg_gtk_tool_item_set_expand)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_expand_w, gxg_gtk_tool_item_get_expand)
+Xen_wrap_2_args(gxg_gtk_tool_item_set_use_drag_window_w, gxg_gtk_tool_item_set_use_drag_window)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_use_drag_window_w, gxg_gtk_tool_item_get_use_drag_window)
+Xen_wrap_2_args(gxg_gtk_tool_item_set_visible_horizontal_w, gxg_gtk_tool_item_set_visible_horizontal)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_visible_horizontal_w, gxg_gtk_tool_item_get_visible_horizontal)
+Xen_wrap_2_args(gxg_gtk_tool_item_set_visible_vertical_w, gxg_gtk_tool_item_set_visible_vertical)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_visible_vertical_w, gxg_gtk_tool_item_get_visible_vertical)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_is_important_w, gxg_gtk_tool_item_get_is_important)
+Xen_wrap_2_args(gxg_gtk_tool_item_set_is_important_w, gxg_gtk_tool_item_set_is_important)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_orientation_w, gxg_gtk_tool_item_get_orientation)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_toolbar_style_w, gxg_gtk_tool_item_get_toolbar_style)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_relief_style_w, gxg_gtk_tool_item_get_relief_style)
+Xen_wrap_1_arg(gxg_gtk_tool_item_retrieve_proxy_menu_item_w, gxg_gtk_tool_item_retrieve_proxy_menu_item)
+Xen_wrap_2_args(gxg_gtk_tool_item_get_proxy_menu_item_w, gxg_gtk_tool_item_get_proxy_menu_item)
+Xen_wrap_3_args(gxg_gtk_tool_item_set_proxy_menu_item_w, gxg_gtk_tool_item_set_proxy_menu_item)
+Xen_wrap_2_args(gxg_gtk_list_store_remove_w, gxg_gtk_list_store_remove)
+Xen_wrap_2_args(gxg_gdk_display_set_double_click_distance_w, gxg_gdk_display_set_double_click_distance)
+Xen_wrap_1_arg(gxg_gdk_display_get_default_group_w, gxg_gdk_display_get_default_group)
+Xen_wrap_1_arg(gxg_gdk_window_get_group_w, gxg_gdk_window_get_group)
+Xen_wrap_3_args(gxg_gtk_cell_layout_reorder_w, gxg_gtk_cell_layout_reorder)
+Xen_wrap_3_optional_args(gxg_gtk_clipboard_request_targets_w, gxg_gtk_clipboard_request_targets)
+Xen_wrap_3_optional_args(gxg_gtk_clipboard_wait_for_targets_w, gxg_gtk_clipboard_wait_for_targets)
+Xen_wrap_1_arg(gxg_gtk_menu_shell_cancel_w, gxg_gtk_menu_shell_cancel)
+Xen_wrap_1_arg(gxg_gtk_paned_get_child1_w, gxg_gtk_paned_get_child1)
+Xen_wrap_1_arg(gxg_gtk_paned_get_child2_w, gxg_gtk_paned_get_child2)
+Xen_wrap_2_args(gxg_gtk_window_set_accept_focus_w, gxg_gtk_window_set_accept_focus)
+Xen_wrap_1_arg(gxg_gtk_window_get_accept_focus_w, gxg_gtk_window_get_accept_focus)
+Xen_wrap_2_args(gxg_g_list_nth_data_w, gxg_g_list_nth_data)
+Xen_wrap_no_args(gxg_gtk_accel_map_get_w, gxg_gtk_accel_map_get)
+Xen_wrap_1_arg(gxg_gtk_combo_box_popup_w, gxg_gtk_combo_box_popup)
+Xen_wrap_1_arg(gxg_gtk_combo_box_popdown_w, gxg_gtk_combo_box_popdown)
+Xen_wrap_1_arg(gxg_gtk_radio_menu_item_new_from_widget_w, gxg_gtk_radio_menu_item_new_from_widget)
+Xen_wrap_2_args(gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget_w, gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget)
+Xen_wrap_2_args(gxg_gtk_radio_menu_item_new_with_label_from_widget_w, gxg_gtk_radio_menu_item_new_with_label_from_widget)
+Xen_wrap_1_arg(gxg_gtk_scale_get_layout_w, gxg_gtk_scale_get_layout)
+Xen_wrap_3_optional_args(gxg_gtk_scale_get_layout_offsets_w, gxg_gtk_scale_get_layout_offsets)
+Xen_wrap_1_arg(gxg_gtk_drag_source_get_target_list_w, gxg_gtk_drag_source_get_target_list)
+Xen_wrap_2_args(gxg_gtk_drag_source_set_target_list_w, gxg_gtk_drag_source_set_target_list)
+Xen_wrap_2_args(gxg_gtk_entry_set_alignment_w, gxg_gtk_entry_set_alignment)
+Xen_wrap_1_arg(gxg_gtk_entry_get_alignment_w, gxg_gtk_entry_get_alignment)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_use_preview_label_w, gxg_gtk_file_chooser_set_use_preview_label)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_use_preview_label_w, gxg_gtk_file_chooser_get_use_preview_label)
+Xen_wrap_1_arg(gxg_gtk_widget_list_mnemonic_labels_w, gxg_gtk_widget_list_mnemonic_labels)
+Xen_wrap_2_args(gxg_gtk_widget_add_mnemonic_label_w, gxg_gtk_widget_add_mnemonic_label)
+Xen_wrap_2_args(gxg_gtk_widget_remove_mnemonic_label_w, gxg_gtk_widget_remove_mnemonic_label)
+Xen_wrap_2_args(gxg_gtk_window_activate_key_w, gxg_gtk_window_activate_key)
+Xen_wrap_2_args(gxg_gtk_window_propagate_key_event_w, gxg_gtk_window_propagate_key_event)
+Xen_wrap_1_arg(gxg_g_quark_from_string_w, gxg_g_quark_from_string)
+Xen_wrap_1_arg(gxg_g_quark_to_string_w, gxg_g_quark_to_string)
+Xen_wrap_no_args(gxg_gtk_cell_view_new_w, gxg_gtk_cell_view_new)
+Xen_wrap_1_arg(gxg_gtk_cell_view_new_with_text_w, gxg_gtk_cell_view_new_with_text)
+Xen_wrap_1_arg(gxg_gtk_cell_view_new_with_markup_w, gxg_gtk_cell_view_new_with_markup)
+Xen_wrap_1_arg(gxg_gtk_cell_view_new_with_pixbuf_w, gxg_gtk_cell_view_new_with_pixbuf)
+Xen_wrap_2_args(gxg_gtk_cell_view_set_model_w, gxg_gtk_cell_view_set_model)
+Xen_wrap_2_args(gxg_gtk_cell_view_set_displayed_row_w, gxg_gtk_cell_view_set_displayed_row)
+Xen_wrap_1_arg(gxg_gtk_cell_view_get_displayed_row_w, gxg_gtk_cell_view_get_displayed_row)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_wrap_width_w, gxg_gtk_combo_box_get_wrap_width)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_row_span_column_w, gxg_gtk_combo_box_get_row_span_column)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_column_span_column_w, gxg_gtk_combo_box_get_column_span_column)
+Xen_wrap_1_arg(gxg_gtk_drag_dest_add_text_targets_w, gxg_gtk_drag_dest_add_text_targets)
+Xen_wrap_1_arg(gxg_gtk_drag_source_add_text_targets_w, gxg_gtk_drag_source_add_text_targets)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_insert_prefix_w, gxg_gtk_entry_completion_insert_prefix)
+Xen_wrap_2_args(gxg_gtk_entry_completion_set_inline_completion_w, gxg_gtk_entry_completion_set_inline_completion)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_inline_completion_w, gxg_gtk_entry_completion_get_inline_completion)
+Xen_wrap_2_args(gxg_gtk_entry_completion_set_popup_completion_w, gxg_gtk_entry_completion_set_popup_completion)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_popup_completion_w, gxg_gtk_entry_completion_get_popup_completion)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_text_column_w, gxg_gtk_entry_completion_get_text_column)
+Xen_wrap_2_args(gxg_gtk_icon_theme_get_icon_sizes_w, gxg_gtk_icon_theme_get_icon_sizes)
+Xen_wrap_1_arg(gxg_gtk_menu_get_for_attach_widget_w, gxg_gtk_menu_get_for_attach_widget)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_fixed_height_mode_w, gxg_gtk_tree_view_set_fixed_height_mode)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_fixed_height_mode_w, gxg_gtk_tree_view_get_fixed_height_mode)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_hover_selection_w, gxg_gtk_tree_view_set_hover_selection)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_hover_selection_w, gxg_gtk_tree_view_get_hover_selection)
+Xen_wrap_4_args(gxg_gtk_tree_view_set_row_separator_func_w, gxg_gtk_tree_view_set_row_separator_func)
+Xen_wrap_2_args(gxg_gtk_window_set_focus_on_map_w, gxg_gtk_window_set_focus_on_map)
+Xen_wrap_1_arg(gxg_gtk_window_get_focus_on_map_w, gxg_gtk_window_get_focus_on_map)
+Xen_wrap_2_args(gxg_gtk_window_set_icon_name_w, gxg_gtk_window_set_icon_name)
+Xen_wrap_1_arg(gxg_gtk_window_get_icon_name_w, gxg_gtk_window_get_icon_name)
+Xen_wrap_1_arg(gxg_gtk_window_set_default_icon_name_w, gxg_gtk_window_set_default_icon_name)
+Xen_wrap_no_args(gxg_gtk_about_dialog_new_w, gxg_gtk_about_dialog_new)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_version_w, gxg_gtk_about_dialog_get_version)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_version_w, gxg_gtk_about_dialog_set_version)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_copyright_w, gxg_gtk_about_dialog_get_copyright)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_copyright_w, gxg_gtk_about_dialog_set_copyright)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_comments_w, gxg_gtk_about_dialog_get_comments)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_comments_w, gxg_gtk_about_dialog_set_comments)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_website_w, gxg_gtk_about_dialog_get_website)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_website_w, gxg_gtk_about_dialog_set_website)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_website_label_w, gxg_gtk_about_dialog_get_website_label)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_website_label_w, gxg_gtk_about_dialog_set_website_label)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_authors_w, gxg_gtk_about_dialog_get_authors)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_authors_w, gxg_gtk_about_dialog_set_authors)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_documenters_w, gxg_gtk_about_dialog_get_documenters)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_documenters_w, gxg_gtk_about_dialog_set_documenters)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_artists_w, gxg_gtk_about_dialog_get_artists)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_artists_w, gxg_gtk_about_dialog_set_artists)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_translator_credits_w, gxg_gtk_about_dialog_get_translator_credits)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_translator_credits_w, gxg_gtk_about_dialog_set_translator_credits)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_logo_w, gxg_gtk_about_dialog_get_logo)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_logo_w, gxg_gtk_about_dialog_set_logo)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_program_name_w, gxg_gtk_about_dialog_get_program_name)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_program_name_w, gxg_gtk_about_dialog_set_program_name)
+Xen_wrap_no_args(gxg_gtk_icon_view_new_w, gxg_gtk_icon_view_new)
+Xen_wrap_1_arg(gxg_gtk_icon_view_new_with_model_w, gxg_gtk_icon_view_new_with_model)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_model_w, gxg_gtk_icon_view_set_model)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_model_w, gxg_gtk_icon_view_get_model)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_text_column_w, gxg_gtk_icon_view_set_text_column)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_text_column_w, gxg_gtk_icon_view_get_text_column)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_markup_column_w, gxg_gtk_icon_view_set_markup_column)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_markup_column_w, gxg_gtk_icon_view_get_markup_column)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_pixbuf_column_w, gxg_gtk_icon_view_set_pixbuf_column)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_pixbuf_column_w, gxg_gtk_icon_view_get_pixbuf_column)
+Xen_wrap_3_args(gxg_gtk_icon_view_get_path_at_pos_w, gxg_gtk_icon_view_get_path_at_pos)
+Xen_wrap_3_optional_args(gxg_gtk_icon_view_selected_foreach_w, gxg_gtk_icon_view_selected_foreach)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_selection_mode_w, gxg_gtk_icon_view_set_selection_mode)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_selection_mode_w, gxg_gtk_icon_view_get_selection_mode)
+Xen_wrap_2_args(gxg_gtk_icon_view_select_path_w, gxg_gtk_icon_view_select_path)
+Xen_wrap_2_args(gxg_gtk_icon_view_unselect_path_w, gxg_gtk_icon_view_unselect_path)
+Xen_wrap_2_args(gxg_gtk_icon_view_path_is_selected_w, gxg_gtk_icon_view_path_is_selected)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_selected_items_w, gxg_gtk_icon_view_get_selected_items)
+Xen_wrap_1_arg(gxg_gtk_icon_view_select_all_w, gxg_gtk_icon_view_select_all)
+Xen_wrap_1_arg(gxg_gtk_icon_view_unselect_all_w, gxg_gtk_icon_view_unselect_all)
+Xen_wrap_2_args(gxg_gtk_icon_view_item_activated_w, gxg_gtk_icon_view_item_activated)
+Xen_wrap_no_args(gxg_gtk_cell_renderer_combo_new_w, gxg_gtk_cell_renderer_combo_new)
+Xen_wrap_no_args(gxg_gtk_cell_renderer_progress_new_w, gxg_gtk_cell_renderer_progress_new)
+Xen_wrap_4_args(gxg_gtk_combo_box_set_row_separator_func_w, gxg_gtk_combo_box_set_row_separator_func)
+Xen_wrap_2_args(gxg_gtk_label_set_ellipsize_w, gxg_gtk_label_set_ellipsize)
+Xen_wrap_1_arg(gxg_gtk_label_get_ellipsize_w, gxg_gtk_label_get_ellipsize)
+Xen_wrap_1_arg(gxg_pango_attr_fallback_new_w, gxg_pango_attr_fallback_new)
+Xen_wrap_1_arg(gxg_pango_attr_letter_spacing_new_w, gxg_pango_attr_letter_spacing_new)
+Xen_wrap_3_args(gxg_pango_attr_list_filter_w, gxg_pango_attr_list_filter)
+Xen_wrap_1_arg(gxg_pango_attr_iterator_get_attrs_w, gxg_pango_attr_iterator_get_attrs)
+Xen_wrap_1_arg(gxg_pango_font_metrics_get_underline_position_w, gxg_pango_font_metrics_get_underline_position)
+Xen_wrap_1_arg(gxg_pango_font_metrics_get_underline_thickness_w, gxg_pango_font_metrics_get_underline_thickness)
+Xen_wrap_1_arg(gxg_pango_font_metrics_get_strikethrough_position_w, gxg_pango_font_metrics_get_strikethrough_position)
+Xen_wrap_1_arg(gxg_pango_font_metrics_get_strikethrough_thickness_w, gxg_pango_font_metrics_get_strikethrough_thickness)
+Xen_wrap_1_arg(gxg_pango_font_family_is_monospace_w, gxg_pango_font_family_is_monospace)
+Xen_wrap_3_optional_args(gxg_pango_font_face_list_sizes_w, gxg_pango_font_face_list_sizes)
+Xen_wrap_2_args(gxg_pango_layout_set_auto_dir_w, gxg_pango_layout_set_auto_dir)
+Xen_wrap_1_arg(gxg_pango_layout_get_auto_dir_w, gxg_pango_layout_get_auto_dir)
+Xen_wrap_1_arg(gxg_pango_script_for_unichar_w, gxg_pango_script_for_unichar)
+Xen_wrap_2_args(gxg_pango_script_iter_new_w, gxg_pango_script_iter_new)
+Xen_wrap_4_optional_args(gxg_pango_script_iter_get_range_w, gxg_pango_script_iter_get_range)
+Xen_wrap_1_arg(gxg_pango_script_iter_next_w, gxg_pango_script_iter_next)
+Xen_wrap_1_arg(gxg_pango_script_iter_free_w, gxg_pango_script_iter_free)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_button_new_with_dialog_w, gxg_gtk_file_chooser_button_new_with_dialog)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_button_get_title_w, gxg_gtk_file_chooser_button_get_title)
+Xen_wrap_2_args(gxg_gtk_file_chooser_button_set_title_w, gxg_gtk_file_chooser_button_set_title)
+Xen_wrap_1_arg(gxg_gdk_drag_drop_succeeded_w, gxg_gdk_drag_drop_succeeded)
+Xen_wrap_2_args(gxg_gtk_entry_layout_index_to_text_index_w, gxg_gtk_entry_layout_index_to_text_index)
+Xen_wrap_2_args(gxg_gtk_entry_text_index_to_layout_index_w, gxg_gtk_entry_text_index_to_layout_index)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_show_hidden_w, gxg_gtk_file_chooser_set_show_hidden)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_show_hidden_w, gxg_gtk_file_chooser_get_show_hidden)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_hover_expand_w, gxg_gtk_tree_view_set_hover_expand)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_hover_expand_w, gxg_gtk_tree_view_get_hover_expand)
+Xen_wrap_1_arg(gxg_gtk_tool_item_rebuild_menu_w, gxg_gtk_tool_item_rebuild_menu)
+Xen_wrap_2_args(gxg_gtk_menu_tool_button_new_w, gxg_gtk_menu_tool_button_new)
+Xen_wrap_2_args(gxg_gtk_menu_tool_button_set_menu_w, gxg_gtk_menu_tool_button_set_menu)
+Xen_wrap_1_arg(gxg_gtk_menu_tool_button_get_menu_w, gxg_gtk_menu_tool_button_get_menu)
+Xen_wrap_1_arg(gxg_gdk_display_supports_clipboard_persistence_w, gxg_gdk_display_supports_clipboard_persistence)
+Xen_wrap_1_arg(gxg_gtk_about_dialog_get_logo_icon_name_w, gxg_gtk_about_dialog_get_logo_icon_name)
+Xen_wrap_2_args(gxg_gtk_about_dialog_set_logo_icon_name_w, gxg_gtk_about_dialog_set_logo_icon_name)
+Xen_wrap_2_args(gxg_gtk_accelerator_get_label_w, gxg_gtk_accelerator_get_label)
+Xen_wrap_2_args(gxg_gtk_clipboard_wait_is_target_available_w, gxg_gtk_clipboard_wait_is_target_available)
+Xen_wrap_3_args(gxg_gtk_clipboard_set_can_store_w, gxg_gtk_clipboard_set_can_store)
+Xen_wrap_1_arg(gxg_gtk_clipboard_store_w, gxg_gtk_clipboard_store)
+Xen_wrap_1_arg(gxg_gtk_drag_dest_add_image_targets_w, gxg_gtk_drag_dest_add_image_targets)
+Xen_wrap_1_arg(gxg_gtk_drag_dest_add_uri_targets_w, gxg_gtk_drag_dest_add_uri_targets)
+Xen_wrap_1_arg(gxg_gtk_drag_source_add_image_targets_w, gxg_gtk_drag_source_add_image_targets)
+Xen_wrap_1_arg(gxg_gtk_drag_source_add_uri_targets_w, gxg_gtk_drag_source_add_uri_targets)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_button_get_width_chars_w, gxg_gtk_file_chooser_button_get_width_chars)
+Xen_wrap_2_args(gxg_gtk_file_chooser_button_set_width_chars_w, gxg_gtk_file_chooser_button_set_width_chars)
+Xen_wrap_2_args(gxg_gtk_image_set_pixel_size_w, gxg_gtk_image_set_pixel_size)
+Xen_wrap_1_arg(gxg_gtk_image_get_pixel_size_w, gxg_gtk_image_get_pixel_size)
+Xen_wrap_2_args(gxg_gtk_label_set_width_chars_w, gxg_gtk_label_set_width_chars)
+Xen_wrap_1_arg(gxg_gtk_label_get_width_chars_w, gxg_gtk_label_get_width_chars)
+Xen_wrap_2_args(gxg_gtk_target_list_add_text_targets_w, gxg_gtk_target_list_add_text_targets)
+Xen_wrap_3_args(gxg_gtk_target_list_add_image_targets_w, gxg_gtk_target_list_add_image_targets)
+Xen_wrap_2_args(gxg_gtk_target_list_add_uri_targets_w, gxg_gtk_target_list_add_uri_targets)
+Xen_wrap_2_args(gxg_gtk_selection_data_set_pixbuf_w, gxg_gtk_selection_data_set_pixbuf)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_pixbuf_w, gxg_gtk_selection_data_get_pixbuf)
+Xen_wrap_2_args(gxg_gtk_selection_data_set_uris_w, gxg_gtk_selection_data_set_uris)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_uris_w, gxg_gtk_selection_data_get_uris)
+Xen_wrap_4_args(gxg_gtk_text_buffer_backspace_w, gxg_gtk_text_buffer_backspace)
+Xen_wrap_2_args(gxg_gtk_clipboard_set_image_w, gxg_gtk_clipboard_set_image)
+Xen_wrap_3_optional_args(gxg_gtk_clipboard_request_image_w, gxg_gtk_clipboard_request_image)
+Xen_wrap_1_arg(gxg_gtk_clipboard_wait_for_image_w, gxg_gtk_clipboard_wait_for_image)
+Xen_wrap_1_arg(gxg_gtk_clipboard_wait_is_image_available_w, gxg_gtk_clipboard_wait_is_image_available)
+Xen_wrap_1_arg(gxg_gtk_file_filter_add_pixbuf_formats_w, gxg_gtk_file_filter_add_pixbuf_formats)
+Xen_wrap_2_args(gxg_gtk_label_set_single_line_mode_w, gxg_gtk_label_set_single_line_mode)
+Xen_wrap_1_arg(gxg_gtk_label_get_single_line_mode_w, gxg_gtk_label_get_single_line_mode)
+Xen_wrap_2_args(gxg_gtk_progress_bar_set_ellipsize_w, gxg_gtk_progress_bar_set_ellipsize)
+Xen_wrap_1_arg(gxg_gtk_progress_bar_get_ellipsize_w, gxg_gtk_progress_bar_get_ellipsize)
+Xen_wrap_2_args(gxg_gtk_selection_data_targets_include_image_w, gxg_gtk_selection_data_targets_include_image)
+Xen_wrap_2_args(gxg_gtk_button_set_image_w, gxg_gtk_button_set_image)
+Xen_wrap_1_arg(gxg_gtk_button_get_image_w, gxg_gtk_button_get_image)
+Xen_wrap_2_args(gxg_gtk_label_set_angle_w, gxg_gtk_label_set_angle)
+Xen_wrap_1_arg(gxg_gtk_label_get_angle_w, gxg_gtk_label_get_angle)
+Xen_wrap_2_args(gxg_gtk_menu_set_screen_w, gxg_gtk_menu_set_screen)
+Xen_wrap_3_args(gxg_pango_attr_underline_color_new_w, gxg_pango_attr_underline_color_new)
+Xen_wrap_3_args(gxg_pango_attr_strikethrough_color_new_w, gxg_pango_attr_strikethrough_color_new)
+Xen_wrap_4_args(gxg_pango_renderer_draw_layout_w, gxg_pango_renderer_draw_layout)
+Xen_wrap_4_args(gxg_pango_renderer_draw_layout_line_w, gxg_pango_renderer_draw_layout_line)
+Xen_wrap_5_args(gxg_pango_renderer_draw_glyphs_w, gxg_pango_renderer_draw_glyphs)
+Xen_wrap_6_args(gxg_pango_renderer_draw_rectangle_w, gxg_pango_renderer_draw_rectangle)
+Xen_wrap_5_args(gxg_pango_renderer_draw_error_underline_w, gxg_pango_renderer_draw_error_underline)
+Xen_wrap_any_args(gxg_pango_renderer_draw_trapezoid_w, gxg_pango_renderer_draw_trapezoid)
+Xen_wrap_5_args(gxg_pango_renderer_draw_glyph_w, gxg_pango_renderer_draw_glyph)
+Xen_wrap_1_arg(gxg_pango_renderer_activate_w, gxg_pango_renderer_activate)
+Xen_wrap_1_arg(gxg_pango_renderer_deactivate_w, gxg_pango_renderer_deactivate)
+Xen_wrap_2_args(gxg_pango_renderer_part_changed_w, gxg_pango_renderer_part_changed)
+Xen_wrap_3_args(gxg_pango_renderer_set_color_w, gxg_pango_renderer_set_color)
+Xen_wrap_2_args(gxg_pango_renderer_get_color_w, gxg_pango_renderer_get_color)
+Xen_wrap_2_args(gxg_pango_renderer_set_matrix_w, gxg_pango_renderer_set_matrix)
+Xen_wrap_4_optional_args(gxg_g_log_set_handler_w, gxg_g_log_set_handler)
+Xen_wrap_2_args(gxg_g_log_remove_handler_w, gxg_g_log_remove_handler)
+Xen_wrap_2_args(gxg_gtk_cell_renderer_stop_editing_w, gxg_gtk_cell_renderer_stop_editing)
+Xen_wrap_2_args(gxg_gtk_file_chooser_button_new_w, gxg_gtk_file_chooser_button_new)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_columns_w, gxg_gtk_icon_view_set_columns)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_columns_w, gxg_gtk_icon_view_get_columns)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_item_width_w, gxg_gtk_icon_view_set_item_width)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_item_width_w, gxg_gtk_icon_view_get_item_width)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_spacing_w, gxg_gtk_icon_view_set_spacing)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_spacing_w, gxg_gtk_icon_view_get_spacing)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_row_spacing_w, gxg_gtk_icon_view_set_row_spacing)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_row_spacing_w, gxg_gtk_icon_view_get_row_spacing)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_column_spacing_w, gxg_gtk_icon_view_set_column_spacing)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_column_spacing_w, gxg_gtk_icon_view_get_column_spacing)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_margin_w, gxg_gtk_icon_view_set_margin)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_margin_w, gxg_gtk_icon_view_get_margin)
+Xen_wrap_2_args(gxg_gtk_label_set_max_width_chars_w, gxg_gtk_label_set_max_width_chars)
+Xen_wrap_1_arg(gxg_gtk_label_get_max_width_chars_w, gxg_gtk_label_get_max_width_chars)
+Xen_wrap_3_args(gxg_gtk_list_store_insert_with_values_w, gxg_gtk_list_store_insert_with_values)
+Xen_wrap_6_args(gxg_gtk_list_store_insert_with_valuesv_w, gxg_gtk_list_store_insert_with_valuesv)
+Xen_wrap_5_optional_args(gxg_gtk_text_view_get_iter_at_position_w, gxg_gtk_text_view_get_iter_at_position)
+Xen_wrap_1_arg(gxg_pango_attr_size_new_absolute_w, gxg_pango_attr_size_new_absolute)
+Xen_wrap_2_args(gxg_pango_font_description_set_absolute_size_w, gxg_pango_font_description_set_absolute_size)
+Xen_wrap_1_arg(gxg_pango_layout_get_font_description_w, gxg_pango_layout_get_font_description)
+Xen_wrap_2_args(gxg_gdk_cursor_new_from_name_w, gxg_gdk_cursor_new_from_name)
+Xen_wrap_1_arg(gxg_gdk_cursor_get_image_w, gxg_gdk_cursor_get_image)
+Xen_wrap_1_arg(gxg_gdk_screen_get_rgba_visual_w, gxg_gdk_screen_get_rgba_visual)
+Xen_wrap_2_args(gxg_gdk_window_set_urgency_hint_w, gxg_gdk_window_set_urgency_hint)
+Xen_wrap_2_args(gxg_gtk_dialog_get_response_for_widget_w, gxg_gtk_dialog_get_response_for_widget)
+Xen_wrap_2_args(gxg_gtk_drag_source_set_icon_name_w, gxg_gtk_drag_source_set_icon_name)
+Xen_wrap_4_args(gxg_gtk_drag_set_icon_name_w, gxg_gtk_drag_set_icon_name)
+Xen_wrap_2_args(gxg_gtk_entry_completion_set_popup_set_width_w, gxg_gtk_entry_completion_set_popup_set_width)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_popup_set_width_w, gxg_gtk_entry_completion_get_popup_set_width)
+Xen_wrap_2_args(gxg_gtk_entry_completion_set_popup_single_match_w, gxg_gtk_entry_completion_set_popup_single_match)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_popup_single_match_w, gxg_gtk_entry_completion_get_popup_single_match)
+Xen_wrap_5_optional_args(gxg_gtk_icon_view_get_item_at_pos_w, gxg_gtk_icon_view_get_item_at_pos)
+Xen_wrap_3_optional_args(gxg_gtk_icon_view_get_visible_range_w, gxg_gtk_icon_view_get_visible_range)
+Xen_wrap_4_args(gxg_gtk_icon_view_set_cursor_w, gxg_gtk_icon_view_set_cursor)
+Xen_wrap_3_optional_args(gxg_gtk_icon_view_get_cursor_w, gxg_gtk_icon_view_get_cursor)
+Xen_wrap_5_args(gxg_gtk_icon_view_scroll_to_path_w, gxg_gtk_icon_view_scroll_to_path)
+Xen_wrap_5_args(gxg_gtk_icon_view_enable_model_drag_source_w, gxg_gtk_icon_view_enable_model_drag_source)
+Xen_wrap_4_args(gxg_gtk_icon_view_enable_model_drag_dest_w, gxg_gtk_icon_view_enable_model_drag_dest)
+Xen_wrap_1_arg(gxg_gtk_icon_view_unset_model_drag_source_w, gxg_gtk_icon_view_unset_model_drag_source)
+Xen_wrap_1_arg(gxg_gtk_icon_view_unset_model_drag_dest_w, gxg_gtk_icon_view_unset_model_drag_dest)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_reorderable_w, gxg_gtk_icon_view_set_reorderable)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_reorderable_w, gxg_gtk_icon_view_get_reorderable)
+Xen_wrap_3_args(gxg_gtk_icon_view_set_drag_dest_item_w, gxg_gtk_icon_view_set_drag_dest_item)
+Xen_wrap_3_optional_args(gxg_gtk_icon_view_get_drag_dest_item_w, gxg_gtk_icon_view_get_drag_dest_item)
+Xen_wrap_5_optional_args(gxg_gtk_icon_view_get_dest_item_at_pos_w, gxg_gtk_icon_view_get_dest_item_at_pos)
+Xen_wrap_1_arg(gxg_gtk_image_clear_w, gxg_gtk_image_clear)
+Xen_wrap_1_arg(gxg_gtk_menu_bar_get_pack_direction_w, gxg_gtk_menu_bar_get_pack_direction)
+Xen_wrap_2_args(gxg_gtk_menu_bar_set_pack_direction_w, gxg_gtk_menu_bar_set_pack_direction)
+Xen_wrap_1_arg(gxg_gtk_menu_bar_get_child_pack_direction_w, gxg_gtk_menu_bar_get_child_pack_direction)
+Xen_wrap_2_args(gxg_gtk_menu_bar_set_child_pack_direction_w, gxg_gtk_menu_bar_set_child_pack_direction)
+Xen_wrap_1_arg(gxg_gtk_menu_shell_get_take_focus_w, gxg_gtk_menu_shell_get_take_focus)
+Xen_wrap_2_args(gxg_gtk_menu_shell_set_take_focus_w, gxg_gtk_menu_shell_set_take_focus)
+Xen_wrap_2_args(gxg_gtk_size_group_set_ignore_hidden_w, gxg_gtk_size_group_set_ignore_hidden)
+Xen_wrap_1_arg(gxg_gtk_size_group_get_ignore_hidden_w, gxg_gtk_size_group_get_ignore_hidden)
+Xen_wrap_1_arg(gxg_gtk_text_iter_forward_visible_line_w, gxg_gtk_text_iter_forward_visible_line)
+Xen_wrap_1_arg(gxg_gtk_text_iter_backward_visible_line_w, gxg_gtk_text_iter_backward_visible_line)
+Xen_wrap_2_args(gxg_gtk_text_iter_forward_visible_lines_w, gxg_gtk_text_iter_forward_visible_lines)
+Xen_wrap_2_args(gxg_gtk_text_iter_backward_visible_lines_w, gxg_gtk_text_iter_backward_visible_lines)
+Xen_wrap_2_args(gxg_gtk_tool_button_set_icon_name_w, gxg_gtk_tool_button_set_icon_name)
+Xen_wrap_1_arg(gxg_gtk_tool_button_get_icon_name_w, gxg_gtk_tool_button_get_icon_name)
+Xen_wrap_2_args(gxg_gtk_window_set_urgency_hint_w, gxg_gtk_window_set_urgency_hint)
+Xen_wrap_1_arg(gxg_gtk_window_get_urgency_hint_w, gxg_gtk_window_get_urgency_hint)
+Xen_wrap_2_args(gxg_gtk_window_present_with_time_w, gxg_gtk_window_present_with_time)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_do_overwrite_confirmation_w, gxg_gtk_file_chooser_set_do_overwrite_confirmation)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_do_overwrite_confirmation_w, gxg_gtk_file_chooser_get_do_overwrite_confirmation)
+Xen_wrap_1_arg(gxg_gtk_tree_row_reference_get_model_w, gxg_gtk_tree_row_reference_get_model)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_queue_resize_w, gxg_gtk_tree_view_column_queue_resize)
+Xen_wrap_3_optional_args(gxg_gtk_tree_view_get_visible_range_w, gxg_gtk_tree_view_get_visible_range)
+Xen_wrap_1_arg(gxg_gtk_text_attributes_ref_w, gxg_gtk_text_attributes_ref)
+Xen_wrap_1_arg(gxg_pango_attr_list_ref_w, gxg_pango_attr_list_ref)
+Xen_wrap_1_arg(gxg_pango_layout_line_ref_w, gxg_pango_layout_line_ref)
+Xen_wrap_5_optional_args(gxg_pango_layout_index_to_line_x_w, gxg_pango_layout_index_to_line_x)
+Xen_wrap_1_arg(gxg_gtk_target_list_ref_w, gxg_gtk_target_list_ref)
+Xen_wrap_1_arg(gxg_gdk_display_supports_shapes_w, gxg_gdk_display_supports_shapes)
+Xen_wrap_1_arg(gxg_gdk_display_supports_input_shapes_w, gxg_gdk_display_supports_input_shapes)
+Xen_wrap_1_arg(gxg_gdk_screen_is_composited_w, gxg_gdk_screen_is_composited)
+Xen_wrap_2_args(gxg_gdk_screen_set_resolution_w, gxg_gdk_screen_set_resolution)
+Xen_wrap_1_arg(gxg_gdk_screen_get_resolution_w, gxg_gdk_screen_get_resolution)
+Xen_wrap_1_arg(gxg_gdk_screen_get_active_window_w, gxg_gdk_screen_get_active_window)
+Xen_wrap_1_arg(gxg_gdk_screen_get_window_stack_w, gxg_gdk_screen_get_window_stack)
+Xen_wrap_1_arg(gxg_gdk_window_get_type_hint_w, gxg_gdk_window_get_type_hint)
+Xen_wrap_4_optional_args(gxg_gtk_clipboard_request_rich_text_w, gxg_gtk_clipboard_request_rich_text)
+Xen_wrap_4_optional_args(gxg_gtk_clipboard_wait_for_rich_text_w, gxg_gtk_clipboard_wait_for_rich_text)
+Xen_wrap_2_args(gxg_gtk_clipboard_wait_is_rich_text_available_w, gxg_gtk_clipboard_wait_is_rich_text_available)
+Xen_wrap_2_args(gxg_gtk_drag_dest_set_track_motion_w, gxg_gtk_drag_dest_set_track_motion)
+Xen_wrap_1_arg(gxg_gtk_drag_dest_get_track_motion_w, gxg_gtk_drag_dest_get_track_motion)
+Xen_wrap_2_args(gxg_gtk_notebook_get_tab_reorderable_w, gxg_gtk_notebook_get_tab_reorderable)
+Xen_wrap_3_args(gxg_gtk_notebook_set_tab_reorderable_w, gxg_gtk_notebook_set_tab_reorderable)
+Xen_wrap_2_args(gxg_gtk_notebook_get_tab_detachable_w, gxg_gtk_notebook_get_tab_detachable)
+Xen_wrap_3_args(gxg_gtk_notebook_set_tab_detachable_w, gxg_gtk_notebook_set_tab_detachable)
+Xen_wrap_2_args(gxg_gtk_range_set_lower_stepper_sensitivity_w, gxg_gtk_range_set_lower_stepper_sensitivity)
+Xen_wrap_1_arg(gxg_gtk_range_get_lower_stepper_sensitivity_w, gxg_gtk_range_get_lower_stepper_sensitivity)
+Xen_wrap_2_args(gxg_gtk_range_set_upper_stepper_sensitivity_w, gxg_gtk_range_set_upper_stepper_sensitivity)
+Xen_wrap_1_arg(gxg_gtk_range_get_upper_stepper_sensitivity_w, gxg_gtk_range_get_upper_stepper_sensitivity)
+Xen_wrap_1_arg(gxg_gtk_scrolled_window_unset_placement_w, gxg_gtk_scrolled_window_unset_placement)
+Xen_wrap_4_args(gxg_gtk_target_list_add_rich_text_targets_w, gxg_gtk_target_list_add_rich_text_targets)
+Xen_wrap_2_optional_args(gxg_gtk_target_table_new_from_list_w, gxg_gtk_target_table_new_from_list)
+Xen_wrap_2_args(gxg_gtk_target_table_free_w, gxg_gtk_target_table_free)
+Xen_wrap_2_args(gxg_gtk_selection_data_targets_include_rich_text_w, gxg_gtk_selection_data_targets_include_rich_text)
+Xen_wrap_1_arg(gxg_gtk_selection_data_targets_include_uri_w, gxg_gtk_selection_data_targets_include_uri)
+Xen_wrap_2_args(gxg_gtk_targets_include_text_w, gxg_gtk_targets_include_text)
+Xen_wrap_3_args(gxg_gtk_targets_include_rich_text_w, gxg_gtk_targets_include_rich_text)
+Xen_wrap_3_args(gxg_gtk_targets_include_image_w, gxg_gtk_targets_include_image)
+Xen_wrap_2_args(gxg_gtk_targets_include_uri_w, gxg_gtk_targets_include_uri)
+Xen_wrap_1_arg(gxg_gtk_size_group_get_widgets_w, gxg_gtk_size_group_get_widgets)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_has_selection_w, gxg_gtk_text_buffer_get_has_selection)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_copy_target_list_w, gxg_gtk_text_buffer_get_copy_target_list)
+Xen_wrap_1_arg(gxg_gtk_text_buffer_get_paste_target_list_w, gxg_gtk_text_buffer_get_paste_target_list)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_headers_clickable_w, gxg_gtk_tree_view_get_headers_clickable)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_search_entry_w, gxg_gtk_tree_view_get_search_entry)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_search_entry_w, gxg_gtk_tree_view_set_search_entry)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_search_position_func_w, gxg_gtk_tree_view_get_search_position_func)
+Xen_wrap_4_optional_args(gxg_gtk_tree_view_set_search_position_func_w, gxg_gtk_tree_view_set_search_position_func)
+Xen_wrap_1_arg(gxg_gtk_widget_is_composited_w, gxg_gtk_widget_is_composited)
+Xen_wrap_2_args(gxg_gtk_window_set_deletable_w, gxg_gtk_window_set_deletable)
+Xen_wrap_1_arg(gxg_gtk_window_get_deletable_w, gxg_gtk_window_get_deletable)
+Xen_wrap_no_args(gxg_gtk_assistant_new_w, gxg_gtk_assistant_new)
+Xen_wrap_1_arg(gxg_gtk_assistant_get_current_page_w, gxg_gtk_assistant_get_current_page)
+Xen_wrap_2_args(gxg_gtk_assistant_set_current_page_w, gxg_gtk_assistant_set_current_page)
+Xen_wrap_1_arg(gxg_gtk_assistant_get_n_pages_w, gxg_gtk_assistant_get_n_pages)
+Xen_wrap_2_args(gxg_gtk_assistant_get_nth_page_w, gxg_gtk_assistant_get_nth_page)
+Xen_wrap_2_args(gxg_gtk_assistant_prepend_page_w, gxg_gtk_assistant_prepend_page)
+Xen_wrap_2_args(gxg_gtk_assistant_append_page_w, gxg_gtk_assistant_append_page)
+Xen_wrap_3_args(gxg_gtk_assistant_insert_page_w, gxg_gtk_assistant_insert_page)
+Xen_wrap_4_optional_args(gxg_gtk_assistant_set_forward_page_func_w, gxg_gtk_assistant_set_forward_page_func)
+Xen_wrap_3_args(gxg_gtk_assistant_set_page_type_w, gxg_gtk_assistant_set_page_type)
+Xen_wrap_2_args(gxg_gtk_assistant_get_page_type_w, gxg_gtk_assistant_get_page_type)
+Xen_wrap_3_args(gxg_gtk_assistant_set_page_title_w, gxg_gtk_assistant_set_page_title)
+Xen_wrap_2_args(gxg_gtk_assistant_get_page_title_w, gxg_gtk_assistant_get_page_title)
+Xen_wrap_3_args(gxg_gtk_assistant_set_page_complete_w, gxg_gtk_assistant_set_page_complete)
+Xen_wrap_2_args(gxg_gtk_assistant_get_page_complete_w, gxg_gtk_assistant_get_page_complete)
+Xen_wrap_2_args(gxg_gtk_assistant_add_action_widget_w, gxg_gtk_assistant_add_action_widget)
+Xen_wrap_2_args(gxg_gtk_assistant_remove_action_widget_w, gxg_gtk_assistant_remove_action_widget)
+Xen_wrap_1_arg(gxg_gtk_assistant_update_buttons_state_w, gxg_gtk_assistant_update_buttons_state)
+Xen_wrap_no_args(gxg_gtk_cell_renderer_accel_new_w, gxg_gtk_cell_renderer_accel_new)
+Xen_wrap_no_args(gxg_gtk_cell_renderer_spin_new_w, gxg_gtk_cell_renderer_spin_new)
+Xen_wrap_1_arg(gxg_gtk_link_button_new_w, gxg_gtk_link_button_new)
+Xen_wrap_2_args(gxg_gtk_link_button_new_with_label_w, gxg_gtk_link_button_new_with_label)
+Xen_wrap_1_arg(gxg_gtk_link_button_get_uri_w, gxg_gtk_link_button_get_uri)
+Xen_wrap_2_args(gxg_gtk_link_button_set_uri_w, gxg_gtk_link_button_set_uri)
+Xen_wrap_no_args(gxg_gtk_recent_chooser_error_quark_w, gxg_gtk_recent_chooser_error_quark)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_show_private_w, gxg_gtk_recent_chooser_set_show_private)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_show_private_w, gxg_gtk_recent_chooser_get_show_private)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_show_not_found_w, gxg_gtk_recent_chooser_set_show_not_found)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_show_not_found_w, gxg_gtk_recent_chooser_get_show_not_found)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_select_multiple_w, gxg_gtk_recent_chooser_set_select_multiple)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_select_multiple_w, gxg_gtk_recent_chooser_get_select_multiple)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_limit_w, gxg_gtk_recent_chooser_set_limit)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_limit_w, gxg_gtk_recent_chooser_get_limit)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_local_only_w, gxg_gtk_recent_chooser_set_local_only)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_local_only_w, gxg_gtk_recent_chooser_get_local_only)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_show_tips_w, gxg_gtk_recent_chooser_set_show_tips)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_show_tips_w, gxg_gtk_recent_chooser_get_show_tips)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_show_icons_w, gxg_gtk_recent_chooser_set_show_icons)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_show_icons_w, gxg_gtk_recent_chooser_get_show_icons)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_sort_type_w, gxg_gtk_recent_chooser_set_sort_type)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_sort_type_w, gxg_gtk_recent_chooser_get_sort_type)
+Xen_wrap_4_optional_args(gxg_gtk_recent_chooser_set_sort_func_w, gxg_gtk_recent_chooser_set_sort_func)
+Xen_wrap_3_optional_args(gxg_gtk_recent_chooser_set_current_uri_w, gxg_gtk_recent_chooser_set_current_uri)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_current_uri_w, gxg_gtk_recent_chooser_get_current_uri)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_current_item_w, gxg_gtk_recent_chooser_get_current_item)
+Xen_wrap_3_optional_args(gxg_gtk_recent_chooser_select_uri_w, gxg_gtk_recent_chooser_select_uri)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_unselect_uri_w, gxg_gtk_recent_chooser_unselect_uri)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_select_all_w, gxg_gtk_recent_chooser_select_all)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_unselect_all_w, gxg_gtk_recent_chooser_unselect_all)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_items_w, gxg_gtk_recent_chooser_get_items)
+Xen_wrap_2_optional_args(gxg_gtk_recent_chooser_get_uris_w, gxg_gtk_recent_chooser_get_uris)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_add_filter_w, gxg_gtk_recent_chooser_add_filter)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_remove_filter_w, gxg_gtk_recent_chooser_remove_filter)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_list_filters_w, gxg_gtk_recent_chooser_list_filters)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_set_filter_w, gxg_gtk_recent_chooser_set_filter)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_get_filter_w, gxg_gtk_recent_chooser_get_filter)
+Xen_wrap_no_args(gxg_gtk_recent_chooser_menu_new_w, gxg_gtk_recent_chooser_menu_new)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_menu_new_for_manager_w, gxg_gtk_recent_chooser_menu_new_for_manager)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_menu_get_show_numbers_w, gxg_gtk_recent_chooser_menu_get_show_numbers)
+Xen_wrap_2_args(gxg_gtk_recent_chooser_menu_set_show_numbers_w, gxg_gtk_recent_chooser_menu_set_show_numbers)
+Xen_wrap_no_args(gxg_gtk_recent_chooser_widget_new_w, gxg_gtk_recent_chooser_widget_new)
+Xen_wrap_1_arg(gxg_gtk_recent_chooser_widget_new_for_manager_w, gxg_gtk_recent_chooser_widget_new_for_manager)
+Xen_wrap_no_args(gxg_gtk_recent_filter_new_w, gxg_gtk_recent_filter_new)
+Xen_wrap_2_args(gxg_gtk_recent_filter_set_name_w, gxg_gtk_recent_filter_set_name)
+Xen_wrap_1_arg(gxg_gtk_recent_filter_get_name_w, gxg_gtk_recent_filter_get_name)
+Xen_wrap_2_args(gxg_gtk_recent_filter_add_mime_type_w, gxg_gtk_recent_filter_add_mime_type)
+Xen_wrap_2_args(gxg_gtk_recent_filter_add_pattern_w, gxg_gtk_recent_filter_add_pattern)
+Xen_wrap_1_arg(gxg_gtk_recent_filter_add_pixbuf_formats_w, gxg_gtk_recent_filter_add_pixbuf_formats)
+Xen_wrap_2_args(gxg_gtk_recent_filter_add_application_w, gxg_gtk_recent_filter_add_application)
+Xen_wrap_2_args(gxg_gtk_recent_filter_add_group_w, gxg_gtk_recent_filter_add_group)
+Xen_wrap_2_args(gxg_gtk_recent_filter_add_age_w, gxg_gtk_recent_filter_add_age)
+Xen_wrap_no_args(gxg_gtk_recent_manager_error_quark_w, gxg_gtk_recent_manager_error_quark)
+Xen_wrap_no_args(gxg_gtk_recent_manager_new_w, gxg_gtk_recent_manager_new)
+Xen_wrap_no_args(gxg_gtk_recent_manager_get_default_w, gxg_gtk_recent_manager_get_default)
+Xen_wrap_3_optional_args(gxg_gtk_recent_manager_remove_item_w, gxg_gtk_recent_manager_remove_item)
+Xen_wrap_3_optional_args(gxg_gtk_recent_manager_lookup_item_w, gxg_gtk_recent_manager_lookup_item)
+Xen_wrap_2_args(gxg_gtk_recent_manager_has_item_w, gxg_gtk_recent_manager_has_item)
+Xen_wrap_4_optional_args(gxg_gtk_recent_manager_move_item_w, gxg_gtk_recent_manager_move_item)
+Xen_wrap_1_arg(gxg_gtk_recent_manager_get_items_w, gxg_gtk_recent_manager_get_items)
+Xen_wrap_2_optional_args(gxg_gtk_recent_manager_purge_items_w, gxg_gtk_recent_manager_purge_items)
+Xen_wrap_1_arg(gxg_gtk_recent_info_ref_w, gxg_gtk_recent_info_ref)
+Xen_wrap_1_arg(gxg_gtk_recent_info_unref_w, gxg_gtk_recent_info_unref)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_uri_w, gxg_gtk_recent_info_get_uri)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_display_name_w, gxg_gtk_recent_info_get_display_name)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_description_w, gxg_gtk_recent_info_get_description)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_mime_type_w, gxg_gtk_recent_info_get_mime_type)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_added_w, gxg_gtk_recent_info_get_added)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_modified_w, gxg_gtk_recent_info_get_modified)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_visited_w, gxg_gtk_recent_info_get_visited)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_private_hint_w, gxg_gtk_recent_info_get_private_hint)
+Xen_wrap_2_optional_args(gxg_gtk_recent_info_get_applications_w, gxg_gtk_recent_info_get_applications)
+Xen_wrap_1_arg(gxg_gtk_recent_info_last_application_w, gxg_gtk_recent_info_last_application)
+Xen_wrap_2_args(gxg_gtk_recent_info_has_application_w, gxg_gtk_recent_info_has_application)
+Xen_wrap_2_optional_args(gxg_gtk_recent_info_get_groups_w, gxg_gtk_recent_info_get_groups)
+Xen_wrap_2_args(gxg_gtk_recent_info_has_group_w, gxg_gtk_recent_info_has_group)
+Xen_wrap_2_args(gxg_gtk_recent_info_get_icon_w, gxg_gtk_recent_info_get_icon)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_short_name_w, gxg_gtk_recent_info_get_short_name)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_uri_display_w, gxg_gtk_recent_info_get_uri_display)
+Xen_wrap_1_arg(gxg_gtk_recent_info_get_age_w, gxg_gtk_recent_info_get_age)
+Xen_wrap_1_arg(gxg_gtk_recent_info_is_local_w, gxg_gtk_recent_info_is_local)
+Xen_wrap_1_arg(gxg_gtk_recent_info_exists_w, gxg_gtk_recent_info_exists)
+Xen_wrap_2_args(gxg_gtk_recent_info_match_w, gxg_gtk_recent_info_match)
+Xen_wrap_5_args(gxg_gtk_text_buffer_register_serialize_format_w, gxg_gtk_text_buffer_register_serialize_format)
+Xen_wrap_2_args(gxg_gtk_text_buffer_register_serialize_tagset_w, gxg_gtk_text_buffer_register_serialize_tagset)
+Xen_wrap_5_args(gxg_gtk_text_buffer_register_deserialize_format_w, gxg_gtk_text_buffer_register_deserialize_format)
+Xen_wrap_2_args(gxg_gtk_text_buffer_register_deserialize_tagset_w, gxg_gtk_text_buffer_register_deserialize_tagset)
+Xen_wrap_2_args(gxg_gtk_text_buffer_unregister_serialize_format_w, gxg_gtk_text_buffer_unregister_serialize_format)
+Xen_wrap_2_args(gxg_gtk_text_buffer_unregister_deserialize_format_w, gxg_gtk_text_buffer_unregister_deserialize_format)
+Xen_wrap_3_args(gxg_gtk_text_buffer_deserialize_set_can_create_tags_w, gxg_gtk_text_buffer_deserialize_set_can_create_tags)
+Xen_wrap_2_args(gxg_gtk_text_buffer_deserialize_get_can_create_tags_w, gxg_gtk_text_buffer_deserialize_get_can_create_tags)
+Xen_wrap_2_optional_args(gxg_gtk_text_buffer_get_serialize_formats_w, gxg_gtk_text_buffer_get_serialize_formats)
+Xen_wrap_2_optional_args(gxg_gtk_text_buffer_get_deserialize_formats_w, gxg_gtk_text_buffer_get_deserialize_formats)
+Xen_wrap_6_optional_args(gxg_gtk_text_buffer_serialize_w, gxg_gtk_text_buffer_serialize)
+Xen_wrap_7_optional_args(gxg_gtk_text_buffer_deserialize_w, gxg_gtk_text_buffer_deserialize)
+Xen_wrap_2_args(gxg_gtk_recent_manager_add_item_w, gxg_gtk_recent_manager_add_item)
+Xen_wrap_3_args(gxg_gtk_recent_manager_add_full_w, gxg_gtk_recent_manager_add_full)
+Xen_wrap_3_args(gxg_gtk_tree_model_filter_convert_child_iter_to_iter_w, gxg_gtk_tree_model_filter_convert_child_iter_to_iter)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_grid_lines_w, gxg_gtk_tree_view_get_grid_lines)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_grid_lines_w, gxg_gtk_tree_view_set_grid_lines)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_enable_tree_lines_w, gxg_gtk_tree_view_get_enable_tree_lines)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_enable_tree_lines_w, gxg_gtk_tree_view_set_enable_tree_lines)
+Xen_wrap_2_args(gxg_gtk_label_set_line_wrap_mode_w, gxg_gtk_label_set_line_wrap_mode)
+Xen_wrap_1_arg(gxg_gtk_label_get_line_wrap_mode_w, gxg_gtk_label_get_line_wrap_mode)
+Xen_wrap_1_arg(gxg_gtk_print_context_get_cairo_context_w, gxg_gtk_print_context_get_cairo_context)
+Xen_wrap_1_arg(gxg_gtk_print_context_get_page_setup_w, gxg_gtk_print_context_get_page_setup)
+Xen_wrap_1_arg(gxg_gtk_print_context_get_width_w, gxg_gtk_print_context_get_width)
+Xen_wrap_1_arg(gxg_gtk_print_context_get_height_w, gxg_gtk_print_context_get_height)
+Xen_wrap_1_arg(gxg_gtk_print_context_get_dpi_x_w, gxg_gtk_print_context_get_dpi_x)
+Xen_wrap_1_arg(gxg_gtk_print_context_get_dpi_y_w, gxg_gtk_print_context_get_dpi_y)
+Xen_wrap_1_arg(gxg_gtk_print_context_create_pango_context_w, gxg_gtk_print_context_create_pango_context)
+Xen_wrap_1_arg(gxg_gtk_print_context_create_pango_layout_w, gxg_gtk_print_context_create_pango_layout)
+Xen_wrap_4_args(gxg_gtk_print_context_set_cairo_context_w, gxg_gtk_print_context_set_cairo_context)
+Xen_wrap_no_args(gxg_gtk_print_operation_new_w, gxg_gtk_print_operation_new)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_default_page_setup_w, gxg_gtk_print_operation_set_default_page_setup)
+Xen_wrap_1_arg(gxg_gtk_print_operation_get_default_page_setup_w, gxg_gtk_print_operation_get_default_page_setup)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_print_settings_w, gxg_gtk_print_operation_set_print_settings)
+Xen_wrap_1_arg(gxg_gtk_print_operation_get_print_settings_w, gxg_gtk_print_operation_get_print_settings)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_job_name_w, gxg_gtk_print_operation_set_job_name)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_n_pages_w, gxg_gtk_print_operation_set_n_pages)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_current_page_w, gxg_gtk_print_operation_set_current_page)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_use_full_page_w, gxg_gtk_print_operation_set_use_full_page)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_unit_w, gxg_gtk_print_operation_set_unit)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_export_filename_w, gxg_gtk_print_operation_set_export_filename)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_track_print_status_w, gxg_gtk_print_operation_set_track_print_status)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_show_progress_w, gxg_gtk_print_operation_set_show_progress)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_allow_async_w, gxg_gtk_print_operation_set_allow_async)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_custom_tab_label_w, gxg_gtk_print_operation_set_custom_tab_label)
+Xen_wrap_4_optional_args(gxg_gtk_print_operation_run_w, gxg_gtk_print_operation_run)
+Xen_wrap_2_optional_args(gxg_gtk_print_operation_get_error_w, gxg_gtk_print_operation_get_error)
+Xen_wrap_1_arg(gxg_gtk_print_operation_get_status_w, gxg_gtk_print_operation_get_status)
+Xen_wrap_1_arg(gxg_gtk_print_operation_get_status_string_w, gxg_gtk_print_operation_get_status_string)
+Xen_wrap_1_arg(gxg_gtk_print_operation_is_finished_w, gxg_gtk_print_operation_is_finished)
+Xen_wrap_1_arg(gxg_gtk_print_operation_cancel_w, gxg_gtk_print_operation_cancel)
+Xen_wrap_3_args(gxg_gtk_print_run_page_setup_dialog_w, gxg_gtk_print_run_page_setup_dialog)
+Xen_wrap_5_args(gxg_gtk_print_run_page_setup_dialog_async_w, gxg_gtk_print_run_page_setup_dialog_async)
+Xen_wrap_2_args(gxg_gtk_print_operation_preview_render_page_w, gxg_gtk_print_operation_preview_render_page)
+Xen_wrap_1_arg(gxg_gtk_print_operation_preview_end_preview_w, gxg_gtk_print_operation_preview_end_preview)
+Xen_wrap_2_args(gxg_gtk_print_operation_preview_is_selected_w, gxg_gtk_print_operation_preview_is_selected)
+Xen_wrap_no_args(gxg_gtk_print_settings_new_w, gxg_gtk_print_settings_new)
+Xen_wrap_1_arg(gxg_gtk_print_settings_copy_w, gxg_gtk_print_settings_copy)
+Xen_wrap_2_args(gxg_gtk_print_settings_has_key_w, gxg_gtk_print_settings_has_key)
+Xen_wrap_2_args(gxg_gtk_print_settings_get_w, gxg_gtk_print_settings_get)
+Xen_wrap_3_args(gxg_gtk_print_settings_set_w, gxg_gtk_print_settings_set)
+Xen_wrap_2_args(gxg_gtk_print_settings_unset_w, gxg_gtk_print_settings_unset)
+Xen_wrap_3_args(gxg_gtk_print_settings_foreach_w, gxg_gtk_print_settings_foreach)
+Xen_wrap_2_args(gxg_gtk_print_settings_get_bool_w, gxg_gtk_print_settings_get_bool)
+Xen_wrap_3_args(gxg_gtk_print_settings_set_bool_w, gxg_gtk_print_settings_set_bool)
+Xen_wrap_2_args(gxg_gtk_print_settings_get_double_w, gxg_gtk_print_settings_get_double)
+Xen_wrap_3_args(gxg_gtk_print_settings_get_double_with_default_w, gxg_gtk_print_settings_get_double_with_default)
+Xen_wrap_3_args(gxg_gtk_print_settings_set_double_w, gxg_gtk_print_settings_set_double)
+Xen_wrap_3_args(gxg_gtk_print_settings_get_length_w, gxg_gtk_print_settings_get_length)
+Xen_wrap_4_args(gxg_gtk_print_settings_set_length_w, gxg_gtk_print_settings_set_length)
+Xen_wrap_2_args(gxg_gtk_print_settings_get_int_w, gxg_gtk_print_settings_get_int)
+Xen_wrap_3_args(gxg_gtk_print_settings_get_int_with_default_w, gxg_gtk_print_settings_get_int_with_default)
+Xen_wrap_3_args(gxg_gtk_print_settings_set_int_w, gxg_gtk_print_settings_set_int)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_printer_w, gxg_gtk_print_settings_get_printer)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_printer_w, gxg_gtk_print_settings_set_printer)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_orientation_w, gxg_gtk_print_settings_get_orientation)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_orientation_w, gxg_gtk_print_settings_set_orientation)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_paper_size_w, gxg_gtk_print_settings_get_paper_size)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_paper_size_w, gxg_gtk_print_settings_set_paper_size)
+Xen_wrap_2_args(gxg_gtk_print_settings_get_paper_width_w, gxg_gtk_print_settings_get_paper_width)
+Xen_wrap_3_args(gxg_gtk_print_settings_set_paper_width_w, gxg_gtk_print_settings_set_paper_width)
+Xen_wrap_2_args(gxg_gtk_print_settings_get_paper_height_w, gxg_gtk_print_settings_get_paper_height)
+Xen_wrap_3_args(gxg_gtk_print_settings_set_paper_height_w, gxg_gtk_print_settings_set_paper_height)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_use_color_w, gxg_gtk_print_settings_get_use_color)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_use_color_w, gxg_gtk_print_settings_set_use_color)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_collate_w, gxg_gtk_print_settings_get_collate)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_collate_w, gxg_gtk_print_settings_set_collate)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_reverse_w, gxg_gtk_print_settings_get_reverse)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_reverse_w, gxg_gtk_print_settings_set_reverse)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_duplex_w, gxg_gtk_print_settings_get_duplex)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_duplex_w, gxg_gtk_print_settings_set_duplex)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_quality_w, gxg_gtk_print_settings_get_quality)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_quality_w, gxg_gtk_print_settings_set_quality)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_n_copies_w, gxg_gtk_print_settings_get_n_copies)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_n_copies_w, gxg_gtk_print_settings_set_n_copies)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_number_up_w, gxg_gtk_print_settings_get_number_up)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_number_up_w, gxg_gtk_print_settings_set_number_up)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_resolution_w, gxg_gtk_print_settings_get_resolution)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_resolution_w, gxg_gtk_print_settings_set_resolution)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_scale_w, gxg_gtk_print_settings_get_scale)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_scale_w, gxg_gtk_print_settings_set_scale)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_print_pages_w, gxg_gtk_print_settings_get_print_pages)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_print_pages_w, gxg_gtk_print_settings_set_print_pages)
+Xen_wrap_2_args(gxg_gtk_print_settings_get_page_ranges_w, gxg_gtk_print_settings_get_page_ranges)
+Xen_wrap_3_args(gxg_gtk_print_settings_set_page_ranges_w, gxg_gtk_print_settings_set_page_ranges)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_page_set_w, gxg_gtk_print_settings_get_page_set)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_page_set_w, gxg_gtk_print_settings_set_page_set)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_default_source_w, gxg_gtk_print_settings_get_default_source)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_default_source_w, gxg_gtk_print_settings_set_default_source)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_media_type_w, gxg_gtk_print_settings_get_media_type)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_media_type_w, gxg_gtk_print_settings_set_media_type)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_dither_w, gxg_gtk_print_settings_get_dither)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_dither_w, gxg_gtk_print_settings_set_dither)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_finishings_w, gxg_gtk_print_settings_get_finishings)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_finishings_w, gxg_gtk_print_settings_set_finishings)
+Xen_wrap_1_arg(gxg_gtk_print_settings_get_output_bin_w, gxg_gtk_print_settings_get_output_bin)
+Xen_wrap_2_args(gxg_gtk_print_settings_set_output_bin_w, gxg_gtk_print_settings_set_output_bin)
+Xen_wrap_1_arg(gxg_gtk_settings_get_for_screen_w, gxg_gtk_settings_get_for_screen)
+Xen_wrap_1_arg(gxg_pango_cairo_create_layout_w, gxg_pango_cairo_create_layout)
+Xen_wrap_2_args(gxg_pango_cairo_update_layout_w, gxg_pango_cairo_update_layout)
+Xen_wrap_2_args(gxg_pango_cairo_update_context_w, gxg_pango_cairo_update_context)
+Xen_wrap_2_args(gxg_pango_cairo_context_set_font_options_w, gxg_pango_cairo_context_set_font_options)
+Xen_wrap_1_arg(gxg_pango_cairo_context_get_font_options_w, gxg_pango_cairo_context_get_font_options)
+Xen_wrap_2_args(gxg_pango_cairo_context_set_resolution_w, gxg_pango_cairo_context_set_resolution)
+Xen_wrap_1_arg(gxg_pango_cairo_context_get_resolution_w, gxg_pango_cairo_context_get_resolution)
+Xen_wrap_3_args(gxg_pango_cairo_show_glyph_string_w, gxg_pango_cairo_show_glyph_string)
+Xen_wrap_2_args(gxg_pango_cairo_show_layout_line_w, gxg_pango_cairo_show_layout_line)
+Xen_wrap_2_args(gxg_pango_cairo_show_layout_w, gxg_pango_cairo_show_layout)
+Xen_wrap_5_args(gxg_pango_cairo_show_error_underline_w, gxg_pango_cairo_show_error_underline)
+Xen_wrap_3_args(gxg_pango_cairo_glyph_string_path_w, gxg_pango_cairo_glyph_string_path)
+Xen_wrap_2_args(gxg_pango_cairo_layout_line_path_w, gxg_pango_cairo_layout_line_path)
+Xen_wrap_2_args(gxg_pango_cairo_layout_path_w, gxg_pango_cairo_layout_path)
+Xen_wrap_5_args(gxg_pango_cairo_error_underline_path_w, gxg_pango_cairo_error_underline_path)
+Xen_wrap_4_args(gxg_gdk_cairo_set_source_pixbuf_w, gxg_gdk_cairo_set_source_pixbuf)
+Xen_wrap_2_args(gxg_gdk_cairo_rectangle_w, gxg_gdk_cairo_rectangle)
+Xen_wrap_1_arg(gxg_gdk_event_request_motions_w, gxg_gdk_event_request_motions)
+Xen_wrap_1_arg(gxg_gdk_notify_startup_complete_with_id_w, gxg_gdk_notify_startup_complete_with_id)
+Xen_wrap_4_args(gxg_gdk_threads_add_idle_full_w, gxg_gdk_threads_add_idle_full)
+Xen_wrap_2_optional_args(gxg_gdk_threads_add_idle_w, gxg_gdk_threads_add_idle)
+Xen_wrap_5_args(gxg_gdk_threads_add_timeout_full_w, gxg_gdk_threads_add_timeout_full)
+Xen_wrap_3_optional_args(gxg_gdk_threads_add_timeout_w, gxg_gdk_threads_add_timeout)
+Xen_wrap_2_args(gxg_gdk_window_set_startup_id_w, gxg_gdk_window_set_startup_id)
+Xen_wrap_1_arg(gxg_gdk_window_beep_w, gxg_gdk_window_beep)
+Xen_wrap_2_args(gxg_gdk_window_set_opacity_w, gxg_gdk_window_set_opacity)
+Xen_wrap_3_args(gxg_gtk_binding_entry_skip_w, gxg_gtk_binding_entry_skip)
+Xen_wrap_1_arg(gxg_gtk_cell_layout_get_cells_w, gxg_gtk_cell_layout_get_cells)
+Xen_wrap_2_args(gxg_gtk_entry_completion_set_inline_selection_w, gxg_gtk_entry_completion_set_inline_selection)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_inline_selection_w, gxg_gtk_entry_completion_get_inline_selection)
+Xen_wrap_1_arg(gxg_gtk_entry_completion_get_completion_prefix_w, gxg_gtk_entry_completion_get_completion_prefix)
+Xen_wrap_2_args(gxg_gtk_entry_set_cursor_hadjustment_w, gxg_gtk_entry_set_cursor_hadjustment)
+Xen_wrap_1_arg(gxg_gtk_entry_get_cursor_hadjustment_w, gxg_gtk_entry_get_cursor_hadjustment)
+Xen_wrap_1_arg(gxg_gtk_icon_theme_list_contexts_w, gxg_gtk_icon_theme_list_contexts)
+Xen_wrap_2_optional_args(gxg_gtk_print_settings_new_from_file_w, gxg_gtk_print_settings_new_from_file)
+Xen_wrap_3_optional_args(gxg_gtk_print_settings_to_file_w, gxg_gtk_print_settings_to_file)
+Xen_wrap_2_args(gxg_gtk_range_set_show_fill_level_w, gxg_gtk_range_set_show_fill_level)
+Xen_wrap_1_arg(gxg_gtk_range_get_show_fill_level_w, gxg_gtk_range_get_show_fill_level)
+Xen_wrap_2_args(gxg_gtk_range_set_restrict_to_fill_level_w, gxg_gtk_range_set_restrict_to_fill_level)
+Xen_wrap_1_arg(gxg_gtk_range_get_restrict_to_fill_level_w, gxg_gtk_range_get_restrict_to_fill_level)
+Xen_wrap_2_args(gxg_gtk_range_set_fill_level_w, gxg_gtk_range_set_fill_level)
+Xen_wrap_1_arg(gxg_gtk_range_get_fill_level_w, gxg_gtk_range_get_fill_level)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_show_expanders_w, gxg_gtk_tree_view_set_show_expanders)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_show_expanders_w, gxg_gtk_tree_view_get_show_expanders)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_level_indentation_w, gxg_gtk_tree_view_set_level_indentation)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_level_indentation_w, gxg_gtk_tree_view_get_level_indentation)
+Xen_wrap_2_args(gxg_gtk_widget_keynav_failed_w, gxg_gtk_widget_keynav_failed)
+Xen_wrap_1_arg(gxg_gtk_widget_error_bell_w, gxg_gtk_widget_error_bell)
+Xen_wrap_2_args(gxg_gtk_widget_set_tooltip_window_w, gxg_gtk_widget_set_tooltip_window)
+Xen_wrap_1_arg(gxg_gtk_widget_get_tooltip_window_w, gxg_gtk_widget_get_tooltip_window)
+Xen_wrap_1_arg(gxg_gtk_widget_trigger_tooltip_query_w, gxg_gtk_widget_trigger_tooltip_query)
+Xen_wrap_2_args(gxg_gtk_window_set_startup_id_w, gxg_gtk_window_set_startup_id)
+Xen_wrap_3_args(gxg_gtk_text_buffer_add_mark_w, gxg_gtk_text_buffer_add_mark)
+Xen_wrap_2_args(gxg_gtk_text_mark_new_w, gxg_gtk_text_mark_new)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_tree_view_w, gxg_gtk_tree_view_column_get_tree_view)
+Xen_wrap_2_args(gxg_gtk_tooltip_set_text_w, gxg_gtk_tooltip_set_text)
+Xen_wrap_5_optional_args(gxg_gtk_tree_view_convert_widget_to_tree_coords_w, gxg_gtk_tree_view_convert_widget_to_tree_coords)
+Xen_wrap_5_optional_args(gxg_gtk_tree_view_convert_tree_to_widget_coords_w, gxg_gtk_tree_view_convert_tree_to_widget_coords)
+Xen_wrap_5_optional_args(gxg_gtk_tree_view_convert_widget_to_bin_window_coords_w, gxg_gtk_tree_view_convert_widget_to_bin_window_coords)
+Xen_wrap_5_optional_args(gxg_gtk_tree_view_convert_bin_window_to_widget_coords_w, gxg_gtk_tree_view_convert_bin_window_to_widget_coords)
+Xen_wrap_5_optional_args(gxg_gtk_tree_view_convert_tree_to_bin_window_coords_w, gxg_gtk_tree_view_convert_tree_to_bin_window_coords)
+Xen_wrap_5_optional_args(gxg_gtk_tree_view_convert_bin_window_to_tree_coords_w, gxg_gtk_tree_view_convert_bin_window_to_tree_coords)
+Xen_wrap_2_args(gxg_gtk_widget_set_tooltip_text_w, gxg_gtk_widget_set_tooltip_text)
+Xen_wrap_1_arg(gxg_gtk_widget_get_tooltip_text_w, gxg_gtk_widget_get_tooltip_text)
+Xen_wrap_2_args(gxg_gtk_widget_set_tooltip_markup_w, gxg_gtk_widget_set_tooltip_markup)
+Xen_wrap_1_arg(gxg_gtk_widget_get_tooltip_markup_w, gxg_gtk_widget_get_tooltip_markup)
+Xen_wrap_1_arg(gxg_gtk_tree_view_is_rubber_banding_active_w, gxg_gtk_tree_view_is_rubber_banding_active)
+Xen_wrap_5_optional_args(gxg_gtk_icon_view_convert_widget_to_bin_window_coords_w, gxg_gtk_icon_view_convert_widget_to_bin_window_coords)
+Xen_wrap_3_args(gxg_gtk_icon_view_set_tooltip_item_w, gxg_gtk_icon_view_set_tooltip_item)
+Xen_wrap_4_args(gxg_gtk_icon_view_set_tooltip_cell_w, gxg_gtk_icon_view_set_tooltip_cell)
+Xen_wrap_7_optional_args(gxg_gtk_icon_view_get_tooltip_context_w, gxg_gtk_icon_view_get_tooltip_context)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_tooltip_column_w, gxg_gtk_icon_view_set_tooltip_column)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_tooltip_column_w, gxg_gtk_icon_view_get_tooltip_column)
+Xen_wrap_2_args(gxg_gtk_menu_tool_button_set_arrow_tooltip_text_w, gxg_gtk_menu_tool_button_set_arrow_tooltip_text)
+Xen_wrap_2_args(gxg_gtk_menu_tool_button_set_arrow_tooltip_markup_w, gxg_gtk_menu_tool_button_set_arrow_tooltip_markup)
+Xen_wrap_2_args(gxg_gtk_tool_item_set_tooltip_text_w, gxg_gtk_tool_item_set_tooltip_text)
+Xen_wrap_2_args(gxg_gtk_tool_item_set_tooltip_markup_w, gxg_gtk_tool_item_set_tooltip_markup)
+Xen_wrap_2_args(gxg_gtk_tooltip_set_tip_area_w, gxg_gtk_tooltip_set_tip_area)
+Xen_wrap_3_args(gxg_gtk_tree_view_set_tooltip_row_w, gxg_gtk_tree_view_set_tooltip_row)
+Xen_wrap_5_args(gxg_gtk_tree_view_set_tooltip_cell_w, gxg_gtk_tree_view_set_tooltip_cell)
+Xen_wrap_7_optional_args(gxg_gtk_tree_view_get_tooltip_context_w, gxg_gtk_tree_view_get_tooltip_context)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_tooltip_column_w, gxg_gtk_tree_view_set_tooltip_column)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_tooltip_column_w, gxg_gtk_tree_view_get_tooltip_column)
+Xen_wrap_2_args(gxg_gtk_widget_set_has_tooltip_w, gxg_gtk_widget_set_has_tooltip)
+Xen_wrap_1_arg(gxg_gtk_widget_get_has_tooltip_w, gxg_gtk_widget_get_has_tooltip)
+#if GTK_CHECK_VERSION(2, 14, 0)
+Xen_wrap_4_args(gxg_gtk_calendar_set_detail_func_w, gxg_gtk_calendar_set_detail_func)
+Xen_wrap_2_args(gxg_gtk_calendar_set_detail_width_chars_w, gxg_gtk_calendar_set_detail_width_chars)
+Xen_wrap_2_args(gxg_gtk_calendar_set_detail_height_rows_w, gxg_gtk_calendar_set_detail_height_rows)
+Xen_wrap_1_arg(gxg_gtk_calendar_get_detail_width_chars_w, gxg_gtk_calendar_get_detail_width_chars)
+Xen_wrap_1_arg(gxg_gtk_calendar_get_detail_height_rows_w, gxg_gtk_calendar_get_detail_height_rows)
+Xen_wrap_2_args(gxg_gdk_screen_get_monitor_width_mm_w, gxg_gdk_screen_get_monitor_width_mm)
+Xen_wrap_2_args(gxg_gdk_screen_get_monitor_height_mm_w, gxg_gdk_screen_get_monitor_height_mm)
+Xen_wrap_2_args(gxg_gdk_screen_get_monitor_plug_name_w, gxg_gdk_screen_get_monitor_plug_name)
+Xen_wrap_1_arg(gxg_gtk_accel_group_get_is_locked_w, gxg_gtk_accel_group_get_is_locked)
+Xen_wrap_1_arg(gxg_gtk_container_get_focus_child_w, gxg_gtk_container_get_focus_child)
+Xen_wrap_1_arg(gxg_gtk_dialog_get_content_area_w, gxg_gtk_dialog_get_content_area)
+Xen_wrap_2_args(gxg_gtk_entry_set_overwrite_mode_w, gxg_gtk_entry_set_overwrite_mode)
+Xen_wrap_1_arg(gxg_gtk_entry_get_overwrite_mode_w, gxg_gtk_entry_get_overwrite_mode)
+Xen_wrap_1_arg(gxg_gtk_entry_get_text_length_w, gxg_gtk_entry_get_text_length)
+Xen_wrap_1_arg(gxg_gtk_layout_get_bin_window_w, gxg_gtk_layout_get_bin_window)
+Xen_wrap_1_arg(gxg_gtk_menu_get_accel_path_w, gxg_gtk_menu_get_accel_path)
+Xen_wrap_1_arg(gxg_gtk_menu_get_monitor_w, gxg_gtk_menu_get_monitor)
+Xen_wrap_1_arg(gxg_gtk_menu_item_get_accel_path_w, gxg_gtk_menu_item_get_accel_path)
+Xen_wrap_1_arg(gxg_gtk_scale_button_get_plus_button_w, gxg_gtk_scale_button_get_plus_button)
+Xen_wrap_1_arg(gxg_gtk_scale_button_get_minus_button_w, gxg_gtk_scale_button_get_minus_button)
+Xen_wrap_1_arg(gxg_gtk_scale_button_get_popup_w, gxg_gtk_scale_button_get_popup)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_target_w, gxg_gtk_selection_data_get_target)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_data_type_w, gxg_gtk_selection_data_get_data_type)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_format_w, gxg_gtk_selection_data_get_format)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_display_w, gxg_gtk_selection_data_get_display)
+Xen_wrap_1_arg(gxg_gtk_widget_get_window_w, gxg_gtk_widget_get_window)
+Xen_wrap_1_arg(gxg_gtk_accel_group_get_modifier_mask_w, gxg_gtk_accel_group_get_modifier_mask)
+Xen_wrap_5_args(gxg_gdk_threads_add_timeout_seconds_full_w, gxg_gdk_threads_add_timeout_seconds_full)
+Xen_wrap_3_optional_args(gxg_gdk_threads_add_timeout_seconds_w, gxg_gdk_threads_add_timeout_seconds)
+Xen_wrap_1_arg(gxg_gtk_adjustment_get_lower_w, gxg_gtk_adjustment_get_lower)
+Xen_wrap_2_args(gxg_gtk_adjustment_set_lower_w, gxg_gtk_adjustment_set_lower)
+Xen_wrap_1_arg(gxg_gtk_adjustment_get_upper_w, gxg_gtk_adjustment_get_upper)
+Xen_wrap_2_args(gxg_gtk_adjustment_set_upper_w, gxg_gtk_adjustment_set_upper)
+Xen_wrap_1_arg(gxg_gtk_adjustment_get_step_increment_w, gxg_gtk_adjustment_get_step_increment)
+Xen_wrap_2_args(gxg_gtk_adjustment_set_step_increment_w, gxg_gtk_adjustment_set_step_increment)
+Xen_wrap_1_arg(gxg_gtk_adjustment_get_page_increment_w, gxg_gtk_adjustment_get_page_increment)
+Xen_wrap_2_args(gxg_gtk_adjustment_set_page_increment_w, gxg_gtk_adjustment_set_page_increment)
+Xen_wrap_1_arg(gxg_gtk_adjustment_get_page_size_w, gxg_gtk_adjustment_get_page_size)
+Xen_wrap_2_args(gxg_gtk_adjustment_set_page_size_w, gxg_gtk_adjustment_set_page_size)
+Xen_wrap_7_args(gxg_gtk_adjustment_configure_w, gxg_gtk_adjustment_configure)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_button_sensitivity_w, gxg_gtk_combo_box_set_button_sensitivity)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_button_sensitivity_w, gxg_gtk_combo_box_get_button_sensitivity)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_file_w, gxg_gtk_file_chooser_get_file)
+Xen_wrap_3_optional_args(gxg_gtk_file_chooser_set_file_w, gxg_gtk_file_chooser_set_file)
+Xen_wrap_3_optional_args(gxg_gtk_file_chooser_select_file_w, gxg_gtk_file_chooser_select_file)
+Xen_wrap_2_args(gxg_gtk_file_chooser_unselect_file_w, gxg_gtk_file_chooser_unselect_file)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_files_w, gxg_gtk_file_chooser_get_files)
+Xen_wrap_3_optional_args(gxg_gtk_file_chooser_set_current_folder_file_w, gxg_gtk_file_chooser_set_current_folder_file)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_current_folder_file_w, gxg_gtk_file_chooser_get_current_folder_file)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_preview_file_w, gxg_gtk_file_chooser_get_preview_file)
+Xen_wrap_1_arg(gxg_gtk_window_get_default_widget_w, gxg_gtk_window_get_default_widget)
#endif
-#if HAVE_GTK_ADJUSTMENT_GET_UPPER
-XEN_NARGIFY_1(gxg_gtk_accel_group_get_is_locked_w, gxg_gtk_accel_group_get_is_locked)
-XEN_NARGIFY_1(gxg_gtk_color_selection_dialog_get_color_selection_w, gxg_gtk_color_selection_dialog_get_color_selection)
-XEN_NARGIFY_1(gxg_gtk_container_get_focus_child_w, gxg_gtk_container_get_focus_child)
-XEN_NARGIFY_1(gxg_gtk_dialog_get_action_area_w, gxg_gtk_dialog_get_action_area)
-XEN_NARGIFY_1(gxg_gtk_dialog_get_content_area_w, gxg_gtk_dialog_get_content_area)
-XEN_NARGIFY_2(gxg_gtk_entry_set_overwrite_mode_w, gxg_gtk_entry_set_overwrite_mode)
-XEN_NARGIFY_1(gxg_gtk_entry_get_overwrite_mode_w, gxg_gtk_entry_get_overwrite_mode)
-XEN_NARGIFY_1(gxg_gtk_entry_get_text_length_w, gxg_gtk_entry_get_text_length)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_family_list_w, gxg_gtk_font_selection_get_family_list)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_face_list_w, gxg_gtk_font_selection_get_face_list)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_size_entry_w, gxg_gtk_font_selection_get_size_entry)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_size_list_w, gxg_gtk_font_selection_get_size_list)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_preview_entry_w, gxg_gtk_font_selection_get_preview_entry)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_family_w, gxg_gtk_font_selection_get_family)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_face_w, gxg_gtk_font_selection_get_face)
-XEN_NARGIFY_1(gxg_gtk_font_selection_get_size_w, gxg_gtk_font_selection_get_size)
-XEN_NARGIFY_1(gxg_gtk_font_selection_dialog_get_ok_button_w, gxg_gtk_font_selection_dialog_get_ok_button)
-XEN_NARGIFY_1(gxg_gtk_font_selection_dialog_get_cancel_button_w, gxg_gtk_font_selection_dialog_get_cancel_button)
-XEN_NARGIFY_1(gxg_gtk_handle_box_get_child_detached_w, gxg_gtk_handle_box_get_child_detached)
-XEN_NARGIFY_1(gxg_gtk_layout_get_bin_window_w, gxg_gtk_layout_get_bin_window)
-XEN_NARGIFY_1(gxg_gtk_menu_get_accel_path_w, gxg_gtk_menu_get_accel_path)
-XEN_NARGIFY_1(gxg_gtk_menu_get_monitor_w, gxg_gtk_menu_get_monitor)
-XEN_NARGIFY_1(gxg_gtk_menu_item_get_accel_path_w, gxg_gtk_menu_item_get_accel_path)
-XEN_NARGIFY_1(gxg_gtk_scale_button_get_plus_button_w, gxg_gtk_scale_button_get_plus_button)
-XEN_NARGIFY_1(gxg_gtk_scale_button_get_minus_button_w, gxg_gtk_scale_button_get_minus_button)
-XEN_NARGIFY_1(gxg_gtk_scale_button_get_popup_w, gxg_gtk_scale_button_get_popup)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_target_w, gxg_gtk_selection_data_get_target)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_data_type_w, gxg_gtk_selection_data_get_data_type)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_format_w, gxg_gtk_selection_data_get_format)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_display_w, gxg_gtk_selection_data_get_display)
-XEN_NARGIFY_1(gxg_gtk_widget_get_window_w, gxg_gtk_widget_get_window)
-XEN_NARGIFY_1(gxg_gtk_accel_group_get_modifier_mask_w, gxg_gtk_accel_group_get_modifier_mask)
-XEN_NARGIFY_5(gxg_gdk_threads_add_timeout_seconds_full_w, gxg_gdk_threads_add_timeout_seconds_full)
-XEN_ARGIFY_3(gxg_gdk_threads_add_timeout_seconds_w, gxg_gdk_threads_add_timeout_seconds)
-XEN_NARGIFY_1(gxg_gtk_adjustment_get_lower_w, gxg_gtk_adjustment_get_lower)
-XEN_NARGIFY_2(gxg_gtk_adjustment_set_lower_w, gxg_gtk_adjustment_set_lower)
-XEN_NARGIFY_1(gxg_gtk_adjustment_get_upper_w, gxg_gtk_adjustment_get_upper)
-XEN_NARGIFY_2(gxg_gtk_adjustment_set_upper_w, gxg_gtk_adjustment_set_upper)
-XEN_NARGIFY_1(gxg_gtk_adjustment_get_step_increment_w, gxg_gtk_adjustment_get_step_increment)
-XEN_NARGIFY_2(gxg_gtk_adjustment_set_step_increment_w, gxg_gtk_adjustment_set_step_increment)
-XEN_NARGIFY_1(gxg_gtk_adjustment_get_page_increment_w, gxg_gtk_adjustment_get_page_increment)
-XEN_NARGIFY_2(gxg_gtk_adjustment_set_page_increment_w, gxg_gtk_adjustment_set_page_increment)
-XEN_NARGIFY_1(gxg_gtk_adjustment_get_page_size_w, gxg_gtk_adjustment_get_page_size)
-XEN_NARGIFY_2(gxg_gtk_adjustment_set_page_size_w, gxg_gtk_adjustment_set_page_size)
-XEN_NARGIFY_7(gxg_gtk_adjustment_configure_w, gxg_gtk_adjustment_configure)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_button_sensitivity_w, gxg_gtk_combo_box_set_button_sensitivity)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_button_sensitivity_w, gxg_gtk_combo_box_get_button_sensitivity)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_file_w, gxg_gtk_file_chooser_get_file)
-XEN_ARGIFY_3(gxg_gtk_file_chooser_set_file_w, gxg_gtk_file_chooser_set_file)
-XEN_ARGIFY_3(gxg_gtk_file_chooser_select_file_w, gxg_gtk_file_chooser_select_file)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_unselect_file_w, gxg_gtk_file_chooser_unselect_file)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_files_w, gxg_gtk_file_chooser_get_files)
-XEN_ARGIFY_3(gxg_gtk_file_chooser_set_current_folder_file_w, gxg_gtk_file_chooser_set_current_folder_file)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_current_folder_file_w, gxg_gtk_file_chooser_get_current_folder_file)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_preview_file_w, gxg_gtk_file_chooser_get_preview_file)
-XEN_NARGIFY_1(gxg_gtk_window_get_default_widget_w, gxg_gtk_window_get_default_widget)
+#if GTK_CHECK_VERSION(2, 16, 0)
+Xen_wrap_1_arg(gxg_gtk_link_button_get_visited_w, gxg_gtk_link_button_get_visited)
+Xen_wrap_2_args(gxg_gtk_link_button_set_visited_w, gxg_gtk_link_button_set_visited)
+Xen_wrap_1_arg(gxg_gdk_keymap_get_caps_lock_state_w, gxg_gdk_keymap_get_caps_lock_state)
+Xen_wrap_1_arg(gxg_gtk_cell_view_get_model_w, gxg_gtk_cell_view_get_model)
+Xen_wrap_1_arg(gxg_gtk_entry_unset_invisible_char_w, gxg_gtk_entry_unset_invisible_char)
+Xen_wrap_2_args(gxg_gtk_entry_set_progress_fraction_w, gxg_gtk_entry_set_progress_fraction)
+Xen_wrap_1_arg(gxg_gtk_entry_get_progress_fraction_w, gxg_gtk_entry_get_progress_fraction)
+Xen_wrap_2_args(gxg_gtk_entry_set_progress_pulse_step_w, gxg_gtk_entry_set_progress_pulse_step)
+Xen_wrap_1_arg(gxg_gtk_entry_get_progress_pulse_step_w, gxg_gtk_entry_get_progress_pulse_step)
+Xen_wrap_1_arg(gxg_gtk_entry_progress_pulse_w, gxg_gtk_entry_progress_pulse)
+Xen_wrap_3_args(gxg_gtk_entry_set_icon_from_pixbuf_w, gxg_gtk_entry_set_icon_from_pixbuf)
+Xen_wrap_3_args(gxg_gtk_entry_set_icon_from_icon_name_w, gxg_gtk_entry_set_icon_from_icon_name)
+Xen_wrap_3_args(gxg_gtk_entry_set_icon_from_gicon_w, gxg_gtk_entry_set_icon_from_gicon)
+Xen_wrap_2_args(gxg_gtk_entry_get_icon_name_w, gxg_gtk_entry_get_icon_name)
+Xen_wrap_3_args(gxg_gtk_entry_set_icon_activatable_w, gxg_gtk_entry_set_icon_activatable)
+Xen_wrap_2_args(gxg_gtk_entry_get_icon_activatable_w, gxg_gtk_entry_get_icon_activatable)
+Xen_wrap_3_args(gxg_gtk_entry_set_icon_sensitive_w, gxg_gtk_entry_set_icon_sensitive)
+Xen_wrap_2_args(gxg_gtk_entry_get_icon_sensitive_w, gxg_gtk_entry_get_icon_sensitive)
+Xen_wrap_3_args(gxg_gtk_entry_get_icon_at_pos_w, gxg_gtk_entry_get_icon_at_pos)
+Xen_wrap_3_args(gxg_gtk_entry_set_icon_tooltip_text_w, gxg_gtk_entry_set_icon_tooltip_text)
+Xen_wrap_3_args(gxg_gtk_entry_set_icon_tooltip_markup_w, gxg_gtk_entry_set_icon_tooltip_markup)
+Xen_wrap_4_args(gxg_gtk_entry_set_icon_drag_source_w, gxg_gtk_entry_set_icon_drag_source)
+Xen_wrap_1_arg(gxg_gtk_entry_get_current_icon_drag_source_w, gxg_gtk_entry_get_current_icon_drag_source)
+Xen_wrap_2_args(gxg_gtk_menu_item_set_label_w, gxg_gtk_menu_item_set_label)
+Xen_wrap_1_arg(gxg_gtk_menu_item_get_label_w, gxg_gtk_menu_item_get_label)
+Xen_wrap_2_args(gxg_gtk_menu_item_set_use_underline_w, gxg_gtk_menu_item_set_use_underline)
+Xen_wrap_1_arg(gxg_gtk_menu_item_get_use_underline_w, gxg_gtk_menu_item_get_use_underline)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_selection_w, gxg_gtk_selection_data_get_selection)
+Xen_wrap_2_args(gxg_gtk_entry_get_icon_tooltip_text_w, gxg_gtk_entry_get_icon_tooltip_text)
+Xen_wrap_2_args(gxg_gtk_entry_get_icon_tooltip_markup_w, gxg_gtk_entry_get_icon_tooltip_markup)
+Xen_wrap_4_args(gxg_gtk_scale_add_mark_w, gxg_gtk_scale_add_mark)
+Xen_wrap_1_arg(gxg_gtk_scale_clear_marks_w, gxg_gtk_scale_clear_marks)
#endif
-#if HAVE_GTK_SCALE_ADD_MARK
-XEN_NARGIFY_1(gxg_gtk_link_button_get_visited_w, gxg_gtk_link_button_get_visited)
-XEN_NARGIFY_2(gxg_gtk_link_button_set_visited_w, gxg_gtk_link_button_set_visited)
-XEN_NARGIFY_1(gxg_gdk_keymap_get_caps_lock_state_w, gxg_gdk_keymap_get_caps_lock_state)
-XEN_NARGIFY_1(gxg_gtk_cell_view_get_model_w, gxg_gtk_cell_view_get_model)
-XEN_NARGIFY_1(gxg_gtk_entry_unset_invisible_char_w, gxg_gtk_entry_unset_invisible_char)
-XEN_NARGIFY_2(gxg_gtk_entry_set_progress_fraction_w, gxg_gtk_entry_set_progress_fraction)
-XEN_NARGIFY_1(gxg_gtk_entry_get_progress_fraction_w, gxg_gtk_entry_get_progress_fraction)
-XEN_NARGIFY_2(gxg_gtk_entry_set_progress_pulse_step_w, gxg_gtk_entry_set_progress_pulse_step)
-XEN_NARGIFY_1(gxg_gtk_entry_get_progress_pulse_step_w, gxg_gtk_entry_get_progress_pulse_step)
-XEN_NARGIFY_1(gxg_gtk_entry_progress_pulse_w, gxg_gtk_entry_progress_pulse)
-XEN_NARGIFY_3(gxg_gtk_entry_set_icon_from_pixbuf_w, gxg_gtk_entry_set_icon_from_pixbuf)
-XEN_NARGIFY_3(gxg_gtk_entry_set_icon_from_stock_w, gxg_gtk_entry_set_icon_from_stock)
-XEN_NARGIFY_3(gxg_gtk_entry_set_icon_from_icon_name_w, gxg_gtk_entry_set_icon_from_icon_name)
-XEN_NARGIFY_3(gxg_gtk_entry_set_icon_from_gicon_w, gxg_gtk_entry_set_icon_from_gicon)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_name_w, gxg_gtk_entry_get_icon_name)
-XEN_NARGIFY_3(gxg_gtk_entry_set_icon_activatable_w, gxg_gtk_entry_set_icon_activatable)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_activatable_w, gxg_gtk_entry_get_icon_activatable)
-XEN_NARGIFY_3(gxg_gtk_entry_set_icon_sensitive_w, gxg_gtk_entry_set_icon_sensitive)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_sensitive_w, gxg_gtk_entry_get_icon_sensitive)
-XEN_NARGIFY_3(gxg_gtk_entry_get_icon_at_pos_w, gxg_gtk_entry_get_icon_at_pos)
-XEN_NARGIFY_3(gxg_gtk_entry_set_icon_tooltip_text_w, gxg_gtk_entry_set_icon_tooltip_text)
-XEN_NARGIFY_3(gxg_gtk_entry_set_icon_tooltip_markup_w, gxg_gtk_entry_set_icon_tooltip_markup)
-XEN_NARGIFY_4(gxg_gtk_entry_set_icon_drag_source_w, gxg_gtk_entry_set_icon_drag_source)
-XEN_NARGIFY_1(gxg_gtk_entry_get_current_icon_drag_source_w, gxg_gtk_entry_get_current_icon_drag_source)
-XEN_NARGIFY_2(gxg_gtk_image_menu_item_set_use_stock_w, gxg_gtk_image_menu_item_set_use_stock)
-XEN_NARGIFY_1(gxg_gtk_image_menu_item_get_use_stock_w, gxg_gtk_image_menu_item_get_use_stock)
-XEN_NARGIFY_2(gxg_gtk_image_menu_item_set_accel_group_w, gxg_gtk_image_menu_item_set_accel_group)
-XEN_NARGIFY_2(gxg_gtk_menu_item_set_label_w, gxg_gtk_menu_item_set_label)
-XEN_NARGIFY_1(gxg_gtk_menu_item_get_label_w, gxg_gtk_menu_item_get_label)
-XEN_NARGIFY_2(gxg_gtk_menu_item_set_use_underline_w, gxg_gtk_menu_item_set_use_underline)
-XEN_NARGIFY_1(gxg_gtk_menu_item_get_use_underline_w, gxg_gtk_menu_item_get_use_underline)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_selection_w, gxg_gtk_selection_data_get_selection)
-XEN_NARGIFY_2(gxg_gtk_action_set_label_w, gxg_gtk_action_set_label)
-XEN_NARGIFY_1(gxg_gtk_action_get_label_w, gxg_gtk_action_get_label)
-XEN_NARGIFY_2(gxg_gtk_action_set_short_label_w, gxg_gtk_action_set_short_label)
-XEN_NARGIFY_1(gxg_gtk_action_get_short_label_w, gxg_gtk_action_get_short_label)
-XEN_NARGIFY_2(gxg_gtk_action_set_tooltip_w, gxg_gtk_action_set_tooltip)
-XEN_NARGIFY_1(gxg_gtk_action_get_tooltip_w, gxg_gtk_action_get_tooltip)
-XEN_NARGIFY_2(gxg_gtk_action_set_stock_id_w, gxg_gtk_action_set_stock_id)
-XEN_NARGIFY_1(gxg_gtk_action_get_stock_id_w, gxg_gtk_action_get_stock_id)
-XEN_NARGIFY_2(gxg_gtk_action_set_gicon_w, gxg_gtk_action_set_gicon)
-XEN_NARGIFY_1(gxg_gtk_action_get_gicon_w, gxg_gtk_action_get_gicon)
-XEN_NARGIFY_2(gxg_gtk_action_set_icon_name_w, gxg_gtk_action_set_icon_name)
-XEN_NARGIFY_1(gxg_gtk_action_get_icon_name_w, gxg_gtk_action_get_icon_name)
-XEN_NARGIFY_2(gxg_gtk_action_set_visible_horizontal_w, gxg_gtk_action_set_visible_horizontal)
-XEN_NARGIFY_1(gxg_gtk_action_get_visible_horizontal_w, gxg_gtk_action_get_visible_horizontal)
-XEN_NARGIFY_2(gxg_gtk_action_set_visible_vertical_w, gxg_gtk_action_set_visible_vertical)
-XEN_NARGIFY_1(gxg_gtk_action_get_visible_vertical_w, gxg_gtk_action_get_visible_vertical)
-XEN_NARGIFY_2(gxg_gtk_action_set_is_important_w, gxg_gtk_action_set_is_important)
-XEN_NARGIFY_1(gxg_gtk_action_get_is_important_w, gxg_gtk_action_get_is_important)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_tooltip_text_w, gxg_gtk_entry_get_icon_tooltip_text)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_tooltip_markup_w, gxg_gtk_entry_get_icon_tooltip_markup)
-XEN_NARGIFY_4(gxg_gtk_scale_add_mark_w, gxg_gtk_scale_add_mark)
-XEN_NARGIFY_1(gxg_gtk_scale_clear_marks_w, gxg_gtk_scale_clear_marks)
+#if GTK_CHECK_VERSION(2, 18, 0)
+Xen_wrap_no_args(gxg_gtk_window_get_default_icon_name_w, gxg_gtk_window_get_default_icon_name)
+Xen_wrap_1_arg(gxg_gtk_label_get_current_uri_w, gxg_gtk_label_get_current_uri)
+Xen_wrap_no_args(gxg_gtk_info_bar_new_w, gxg_gtk_info_bar_new)
+Xen_wrap_1_arg(gxg_gtk_info_bar_get_action_area_w, gxg_gtk_info_bar_get_action_area)
+Xen_wrap_1_arg(gxg_gtk_info_bar_get_content_area_w, gxg_gtk_info_bar_get_content_area)
+Xen_wrap_3_args(gxg_gtk_info_bar_add_action_widget_w, gxg_gtk_info_bar_add_action_widget)
+Xen_wrap_3_args(gxg_gtk_info_bar_add_button_w, gxg_gtk_info_bar_add_button)
+Xen_wrap_3_args(gxg_gtk_info_bar_set_response_sensitive_w, gxg_gtk_info_bar_set_response_sensitive)
+Xen_wrap_2_args(gxg_gtk_info_bar_set_default_response_w, gxg_gtk_info_bar_set_default_response)
+Xen_wrap_2_args(gxg_gtk_info_bar_response_w, gxg_gtk_info_bar_response)
+Xen_wrap_2_args(gxg_gtk_info_bar_set_message_type_w, gxg_gtk_info_bar_set_message_type)
+Xen_wrap_1_arg(gxg_gtk_info_bar_get_message_type_w, gxg_gtk_info_bar_get_message_type)
+Xen_wrap_1_arg(gxg_gdk_window_ensure_native_w, gxg_gdk_window_ensure_native)
+Xen_wrap_5_optional_args(gxg_gdk_window_get_root_coords_w, gxg_gdk_window_get_root_coords)
+Xen_wrap_2_args(gxg_gdk_offscreen_window_set_embedder_w, gxg_gdk_offscreen_window_set_embedder)
+Xen_wrap_1_arg(gxg_gdk_offscreen_window_get_embedder_w, gxg_gdk_offscreen_window_get_embedder)
+Xen_wrap_1_arg(gxg_gdk_window_geometry_changed_w, gxg_gdk_window_geometry_changed)
+Xen_wrap_2_args(gxg_gtk_menu_set_reserve_toggle_size_w, gxg_gtk_menu_set_reserve_toggle_size)
+Xen_wrap_1_arg(gxg_gtk_menu_get_reserve_toggle_size_w, gxg_gtk_menu_get_reserve_toggle_size)
+Xen_wrap_1_arg(gxg_gtk_entry_new_with_buffer_w, gxg_gtk_entry_new_with_buffer)
+Xen_wrap_1_arg(gxg_gtk_entry_get_buffer_w, gxg_gtk_entry_get_buffer)
+Xen_wrap_2_args(gxg_gtk_entry_set_buffer_w, gxg_gtk_entry_set_buffer)
+Xen_wrap_2_args(gxg_gtk_label_set_track_visited_links_w, gxg_gtk_label_set_track_visited_links)
+Xen_wrap_1_arg(gxg_gtk_label_get_track_visited_links_w, gxg_gtk_label_get_track_visited_links)
+Xen_wrap_2_args(gxg_gtk_print_operation_set_embed_page_setup_w, gxg_gtk_print_operation_set_embed_page_setup)
+Xen_wrap_1_arg(gxg_gtk_print_operation_get_embed_page_setup_w, gxg_gtk_print_operation_get_embed_page_setup)
+Xen_wrap_2_args(gxg_gtk_entry_buffer_new_w, gxg_gtk_entry_buffer_new)
+Xen_wrap_1_arg(gxg_gtk_entry_buffer_get_bytes_w, gxg_gtk_entry_buffer_get_bytes)
+Xen_wrap_1_arg(gxg_gtk_entry_buffer_get_length_w, gxg_gtk_entry_buffer_get_length)
+Xen_wrap_1_arg(gxg_gtk_entry_buffer_get_text_w, gxg_gtk_entry_buffer_get_text)
+Xen_wrap_3_args(gxg_gtk_entry_buffer_set_text_w, gxg_gtk_entry_buffer_set_text)
+Xen_wrap_2_args(gxg_gtk_entry_buffer_set_max_length_w, gxg_gtk_entry_buffer_set_max_length)
+Xen_wrap_1_arg(gxg_gtk_entry_buffer_get_max_length_w, gxg_gtk_entry_buffer_get_max_length)
+Xen_wrap_4_args(gxg_gtk_entry_buffer_insert_text_w, gxg_gtk_entry_buffer_insert_text)
+Xen_wrap_3_args(gxg_gtk_entry_buffer_delete_text_w, gxg_gtk_entry_buffer_delete_text)
+Xen_wrap_4_args(gxg_gtk_entry_buffer_emit_inserted_text_w, gxg_gtk_entry_buffer_emit_inserted_text)
+Xen_wrap_3_args(gxg_gtk_entry_buffer_emit_deleted_text_w, gxg_gtk_entry_buffer_emit_deleted_text)
+Xen_wrap_3_args(gxg_gtk_cell_renderer_set_alignment_w, gxg_gtk_cell_renderer_set_alignment)
+Xen_wrap_3_optional_args(gxg_gtk_cell_renderer_get_alignment_w, gxg_gtk_cell_renderer_get_alignment)
+Xen_wrap_3_args(gxg_gtk_cell_renderer_set_padding_w, gxg_gtk_cell_renderer_set_padding)
+Xen_wrap_3_optional_args(gxg_gtk_cell_renderer_get_padding_w, gxg_gtk_cell_renderer_get_padding)
+Xen_wrap_2_args(gxg_gtk_cell_renderer_set_visible_w, gxg_gtk_cell_renderer_set_visible)
+Xen_wrap_1_arg(gxg_gtk_cell_renderer_get_visible_w, gxg_gtk_cell_renderer_get_visible)
+Xen_wrap_2_args(gxg_gtk_cell_renderer_set_sensitive_w, gxg_gtk_cell_renderer_set_sensitive)
+Xen_wrap_1_arg(gxg_gtk_cell_renderer_get_sensitive_w, gxg_gtk_cell_renderer_get_sensitive)
+Xen_wrap_1_arg(gxg_gtk_cell_renderer_toggle_get_activatable_w, gxg_gtk_cell_renderer_toggle_get_activatable)
+Xen_wrap_2_args(gxg_gtk_cell_renderer_toggle_set_activatable_w, gxg_gtk_cell_renderer_toggle_set_activatable)
+Xen_wrap_2_args(gxg_gtk_widget_set_can_focus_w, gxg_gtk_widget_set_can_focus)
+Xen_wrap_1_arg(gxg_gtk_widget_get_can_focus_w, gxg_gtk_widget_get_can_focus)
+Xen_wrap_1_arg(gxg_gtk_widget_has_focus_w, gxg_gtk_widget_has_focus)
+Xen_wrap_2_args(gxg_gtk_widget_set_can_default_w, gxg_gtk_widget_set_can_default)
+Xen_wrap_1_arg(gxg_gtk_widget_get_can_default_w, gxg_gtk_widget_get_can_default)
+Xen_wrap_1_arg(gxg_gtk_widget_has_default_w, gxg_gtk_widget_has_default)
+Xen_wrap_1_arg(gxg_gtk_widget_get_sensitive_w, gxg_gtk_widget_get_sensitive)
+Xen_wrap_1_arg(gxg_gtk_widget_is_sensitive_w, gxg_gtk_widget_is_sensitive)
+Xen_wrap_2_args(gxg_gtk_widget_set_has_window_w, gxg_gtk_widget_set_has_window)
+Xen_wrap_1_arg(gxg_gtk_widget_get_has_window_w, gxg_gtk_widget_get_has_window)
+Xen_wrap_1_arg(gxg_gtk_widget_get_app_paintable_w, gxg_gtk_widget_get_app_paintable)
+Xen_wrap_1_arg(gxg_gdk_window_get_cursor_w, gxg_gdk_window_get_cursor)
+Xen_wrap_2_args(gxg_gtk_file_chooser_set_create_folders_w, gxg_gtk_file_chooser_set_create_folders)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_create_folders_w, gxg_gtk_file_chooser_get_create_folders)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_item_padding_w, gxg_gtk_icon_view_set_item_padding)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_item_padding_w, gxg_gtk_icon_view_get_item_padding)
+Xen_wrap_1_arg(gxg_gtk_widget_has_grab_w, gxg_gtk_widget_has_grab)
+Xen_wrap_2_args(gxg_gtk_widget_set_visible_w, gxg_gtk_widget_set_visible)
+Xen_wrap_1_arg(gxg_gtk_widget_get_visible_w, gxg_gtk_widget_get_visible)
+Xen_wrap_2_args(gxg_gtk_range_set_flippable_w, gxg_gtk_range_set_flippable)
+Xen_wrap_1_arg(gxg_gtk_range_get_flippable_w, gxg_gtk_range_get_flippable)
+Xen_wrap_1_arg(gxg_gtk_widget_is_toplevel_w, gxg_gtk_widget_is_toplevel)
+Xen_wrap_1_arg(gxg_gtk_widget_is_drawable_w, gxg_gtk_widget_is_drawable)
+Xen_wrap_2_args(gxg_gtk_widget_set_window_w, gxg_gtk_widget_set_window)
+Xen_wrap_1_arg(gxg_gdk_window_is_destroyed_w, gxg_gdk_window_is_destroyed)
+Xen_wrap_3_args(gxg_gdk_window_restack_w, gxg_gdk_window_restack)
+Xen_wrap_2_args(gxg_gtk_widget_set_receives_default_w, gxg_gtk_widget_set_receives_default)
+Xen_wrap_1_arg(gxg_gtk_widget_get_receives_default_w, gxg_gtk_widget_get_receives_default)
#endif
-#if HAVE_GTK_INFO_BAR_NEW
-XEN_NARGIFY_2(gxg_gtk_image_menu_item_set_always_show_image_w, gxg_gtk_image_menu_item_set_always_show_image)
-XEN_NARGIFY_1(gxg_gtk_image_menu_item_get_always_show_image_w, gxg_gtk_image_menu_item_get_always_show_image)
-XEN_NARGIFY_0(gxg_gtk_window_get_default_icon_name_w, gxg_gtk_window_get_default_icon_name)
-XEN_NARGIFY_1(gxg_gtk_label_get_current_uri_w, gxg_gtk_label_get_current_uri)
-XEN_NARGIFY_0(gxg_gtk_info_bar_new_w, gxg_gtk_info_bar_new)
-XEN_NARGIFY_1(gxg_gtk_info_bar_get_action_area_w, gxg_gtk_info_bar_get_action_area)
-XEN_NARGIFY_1(gxg_gtk_info_bar_get_content_area_w, gxg_gtk_info_bar_get_content_area)
-XEN_NARGIFY_3(gxg_gtk_info_bar_add_action_widget_w, gxg_gtk_info_bar_add_action_widget)
-XEN_NARGIFY_3(gxg_gtk_info_bar_add_button_w, gxg_gtk_info_bar_add_button)
-XEN_NARGIFY_3(gxg_gtk_info_bar_set_response_sensitive_w, gxg_gtk_info_bar_set_response_sensitive)
-XEN_NARGIFY_2(gxg_gtk_info_bar_set_default_response_w, gxg_gtk_info_bar_set_default_response)
-XEN_NARGIFY_2(gxg_gtk_info_bar_response_w, gxg_gtk_info_bar_response)
-XEN_NARGIFY_2(gxg_gtk_info_bar_set_message_type_w, gxg_gtk_info_bar_set_message_type)
-XEN_NARGIFY_1(gxg_gtk_info_bar_get_message_type_w, gxg_gtk_info_bar_get_message_type)
+#if GTK_CHECK_VERSION(2, 20, 0)
+Xen_wrap_2_args(gxg_gtk_dialog_get_widget_for_response_w, gxg_gtk_dialog_get_widget_for_response)
+Xen_wrap_1_arg(gxg_gtk_viewport_get_bin_window_w, gxg_gtk_viewport_get_bin_window)
+Xen_wrap_no_args(gxg_gtk_spinner_new_w, gxg_gtk_spinner_new)
+Xen_wrap_1_arg(gxg_gtk_spinner_start_w, gxg_gtk_spinner_start)
+Xen_wrap_1_arg(gxg_gtk_spinner_stop_w, gxg_gtk_spinner_stop)
+Xen_wrap_no_args(gxg_gtk_cell_renderer_spinner_new_w, gxg_gtk_cell_renderer_spinner_new)
+Xen_wrap_2_args(gxg_gtk_notebook_get_action_widget_w, gxg_gtk_notebook_get_action_widget)
+Xen_wrap_3_args(gxg_gtk_notebook_set_action_widget_w, gxg_gtk_notebook_set_action_widget)
+Xen_wrap_1_arg(gxg_gtk_statusbar_get_message_area_w, gxg_gtk_statusbar_get_message_area)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_ellipsize_mode_w, gxg_gtk_tool_item_get_ellipsize_mode)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_text_alignment_w, gxg_gtk_tool_item_get_text_alignment)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_text_orientation_w, gxg_gtk_tool_item_get_text_orientation)
+Xen_wrap_1_arg(gxg_gtk_tool_item_get_text_size_group_w, gxg_gtk_tool_item_get_text_size_group)
+Xen_wrap_no_args(gxg_gtk_tool_palette_new_w, gxg_gtk_tool_palette_new)
+Xen_wrap_3_args(gxg_gtk_tool_palette_set_group_position_w, gxg_gtk_tool_palette_set_group_position)
+Xen_wrap_3_args(gxg_gtk_tool_palette_set_exclusive_w, gxg_gtk_tool_palette_set_exclusive)
+Xen_wrap_3_args(gxg_gtk_tool_palette_set_expand_w, gxg_gtk_tool_palette_set_expand)
+Xen_wrap_2_args(gxg_gtk_tool_palette_get_group_position_w, gxg_gtk_tool_palette_get_group_position)
+Xen_wrap_2_args(gxg_gtk_tool_palette_get_exclusive_w, gxg_gtk_tool_palette_get_exclusive)
+Xen_wrap_2_args(gxg_gtk_tool_palette_get_expand_w, gxg_gtk_tool_palette_get_expand)
+Xen_wrap_1_arg(gxg_gtk_tool_palette_unset_icon_size_w, gxg_gtk_tool_palette_unset_icon_size)
+Xen_wrap_2_args(gxg_gtk_tool_palette_set_style_w, gxg_gtk_tool_palette_set_style)
+Xen_wrap_1_arg(gxg_gtk_tool_palette_unset_style_w, gxg_gtk_tool_palette_unset_style)
+Xen_wrap_1_arg(gxg_gtk_tool_palette_get_style_w, gxg_gtk_tool_palette_get_style)
+Xen_wrap_3_args(gxg_gtk_tool_palette_get_drop_item_w, gxg_gtk_tool_palette_get_drop_item)
+Xen_wrap_3_args(gxg_gtk_tool_palette_get_drop_group_w, gxg_gtk_tool_palette_get_drop_group)
+Xen_wrap_2_args(gxg_gtk_tool_palette_get_drag_item_w, gxg_gtk_tool_palette_get_drag_item)
+Xen_wrap_2_args(gxg_gtk_tool_palette_set_drag_source_w, gxg_gtk_tool_palette_set_drag_source)
+Xen_wrap_5_args(gxg_gtk_tool_palette_add_drag_dest_w, gxg_gtk_tool_palette_add_drag_dest)
+Xen_wrap_no_args(gxg_gtk_tool_palette_get_drag_target_item_w, gxg_gtk_tool_palette_get_drag_target_item)
+Xen_wrap_no_args(gxg_gtk_tool_palette_get_drag_target_group_w, gxg_gtk_tool_palette_get_drag_target_group)
+Xen_wrap_1_arg(gxg_gtk_tool_item_group_new_w, gxg_gtk_tool_item_group_new)
+Xen_wrap_2_args(gxg_gtk_tool_item_group_set_label_w, gxg_gtk_tool_item_group_set_label)
+Xen_wrap_2_args(gxg_gtk_tool_item_group_set_label_widget_w, gxg_gtk_tool_item_group_set_label_widget)
+Xen_wrap_2_args(gxg_gtk_tool_item_group_set_collapsed_w, gxg_gtk_tool_item_group_set_collapsed)
+Xen_wrap_2_args(gxg_gtk_tool_item_group_set_ellipsize_w, gxg_gtk_tool_item_group_set_ellipsize)
+Xen_wrap_2_args(gxg_gtk_tool_item_group_set_header_relief_w, gxg_gtk_tool_item_group_set_header_relief)
+Xen_wrap_1_arg(gxg_gtk_tool_item_group_get_label_w, gxg_gtk_tool_item_group_get_label)
+Xen_wrap_1_arg(gxg_gtk_tool_item_group_get_label_widget_w, gxg_gtk_tool_item_group_get_label_widget)
+Xen_wrap_1_arg(gxg_gtk_tool_item_group_get_collapsed_w, gxg_gtk_tool_item_group_get_collapsed)
+Xen_wrap_1_arg(gxg_gtk_tool_item_group_get_ellipsize_w, gxg_gtk_tool_item_group_get_ellipsize)
+Xen_wrap_1_arg(gxg_gtk_tool_item_group_get_header_relief_w, gxg_gtk_tool_item_group_get_header_relief)
+Xen_wrap_3_args(gxg_gtk_tool_item_group_insert_w, gxg_gtk_tool_item_group_insert)
+Xen_wrap_3_args(gxg_gtk_tool_item_group_set_item_position_w, gxg_gtk_tool_item_group_set_item_position)
+Xen_wrap_2_args(gxg_gtk_tool_item_group_get_item_position_w, gxg_gtk_tool_item_group_get_item_position)
+Xen_wrap_1_arg(gxg_gtk_tool_item_group_get_n_items_w, gxg_gtk_tool_item_group_get_n_items)
+Xen_wrap_2_args(gxg_gtk_tool_item_group_get_nth_item_w, gxg_gtk_tool_item_group_get_nth_item)
+Xen_wrap_3_args(gxg_gtk_tool_item_group_get_drop_item_w, gxg_gtk_tool_item_group_get_drop_item)
+Xen_wrap_1_arg(gxg_gdk_screen_get_primary_monitor_w, gxg_gdk_screen_get_primary_monitor)
+Xen_wrap_2_args(gxg_gtk_window_set_mnemonics_visible_w, gxg_gtk_window_set_mnemonics_visible)
+Xen_wrap_1_arg(gxg_gtk_window_get_mnemonics_visible_w, gxg_gtk_window_get_mnemonics_visible)
+Xen_wrap_2_args(gxg_gtk_range_set_slider_size_fixed_w, gxg_gtk_range_set_slider_size_fixed)
+Xen_wrap_1_arg(gxg_gtk_range_get_slider_size_fixed_w, gxg_gtk_range_get_slider_size_fixed)
+Xen_wrap_2_args(gxg_gtk_range_set_min_slider_size_w, gxg_gtk_range_set_min_slider_size)
+Xen_wrap_1_arg(gxg_gtk_range_get_min_slider_size_w, gxg_gtk_range_get_min_slider_size)
+Xen_wrap_2_args(gxg_gtk_range_get_range_rect_w, gxg_gtk_range_get_range_rect)
+Xen_wrap_3_optional_args(gxg_gtk_range_get_slider_range_w, gxg_gtk_range_get_slider_range)
+Xen_wrap_1_arg(gxg_gtk_paned_get_handle_window_w, gxg_gtk_paned_get_handle_window)
+Xen_wrap_2_args(gxg_gtk_widget_set_realized_w, gxg_gtk_widget_set_realized)
+Xen_wrap_1_arg(gxg_gtk_widget_get_realized_w, gxg_gtk_widget_get_realized)
+Xen_wrap_2_args(gxg_gtk_widget_set_mapped_w, gxg_gtk_widget_set_mapped)
+Xen_wrap_1_arg(gxg_gtk_widget_get_mapped_w, gxg_gtk_widget_get_mapped)
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-XEN_NARGIFY_1(gxg_gdk_window_ensure_native_w, gxg_gdk_window_ensure_native)
-XEN_ARGIFY_5(gxg_gdk_window_get_root_coords_w, gxg_gdk_window_get_root_coords)
-XEN_NARGIFY_2(gxg_gdk_offscreen_window_set_embedder_w, gxg_gdk_offscreen_window_set_embedder)
-XEN_NARGIFY_1(gxg_gdk_offscreen_window_get_embedder_w, gxg_gdk_offscreen_window_get_embedder)
-XEN_NARGIFY_1(gxg_gdk_window_geometry_changed_w, gxg_gdk_window_geometry_changed)
-XEN_NARGIFY_2(gxg_gtk_menu_set_reserve_toggle_size_w, gxg_gtk_menu_set_reserve_toggle_size)
-XEN_NARGIFY_1(gxg_gtk_menu_get_reserve_toggle_size_w, gxg_gtk_menu_get_reserve_toggle_size)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_title_w, gxg_gtk_status_icon_set_title)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_title_w, gxg_gtk_status_icon_get_title)
-XEN_NARGIFY_1(gxg_gtk_entry_new_with_buffer_w, gxg_gtk_entry_new_with_buffer)
-XEN_NARGIFY_1(gxg_gtk_entry_get_buffer_w, gxg_gtk_entry_get_buffer)
-XEN_NARGIFY_2(gxg_gtk_entry_set_buffer_w, gxg_gtk_entry_set_buffer)
-XEN_NARGIFY_2(gxg_gtk_label_set_track_visited_links_w, gxg_gtk_label_set_track_visited_links)
-XEN_NARGIFY_1(gxg_gtk_label_get_track_visited_links_w, gxg_gtk_label_get_track_visited_links)
-XEN_NARGIFY_2(gxg_gtk_print_operation_set_embed_page_setup_w, gxg_gtk_print_operation_set_embed_page_setup)
-XEN_NARGIFY_1(gxg_gtk_print_operation_get_embed_page_setup_w, gxg_gtk_print_operation_get_embed_page_setup)
-XEN_NARGIFY_2(gxg_gtk_entry_buffer_new_w, gxg_gtk_entry_buffer_new)
-XEN_NARGIFY_1(gxg_gtk_entry_buffer_get_bytes_w, gxg_gtk_entry_buffer_get_bytes)
-XEN_NARGIFY_1(gxg_gtk_entry_buffer_get_length_w, gxg_gtk_entry_buffer_get_length)
-XEN_NARGIFY_1(gxg_gtk_entry_buffer_get_text_w, gxg_gtk_entry_buffer_get_text)
-XEN_NARGIFY_3(gxg_gtk_entry_buffer_set_text_w, gxg_gtk_entry_buffer_set_text)
-XEN_NARGIFY_2(gxg_gtk_entry_buffer_set_max_length_w, gxg_gtk_entry_buffer_set_max_length)
-XEN_NARGIFY_1(gxg_gtk_entry_buffer_get_max_length_w, gxg_gtk_entry_buffer_get_max_length)
-XEN_NARGIFY_4(gxg_gtk_entry_buffer_insert_text_w, gxg_gtk_entry_buffer_insert_text)
-XEN_NARGIFY_3(gxg_gtk_entry_buffer_delete_text_w, gxg_gtk_entry_buffer_delete_text)
-XEN_NARGIFY_4(gxg_gtk_entry_buffer_emit_inserted_text_w, gxg_gtk_entry_buffer_emit_inserted_text)
-XEN_NARGIFY_3(gxg_gtk_entry_buffer_emit_deleted_text_w, gxg_gtk_entry_buffer_emit_deleted_text)
-XEN_NARGIFY_3(gxg_gtk_cell_renderer_set_alignment_w, gxg_gtk_cell_renderer_set_alignment)
-XEN_ARGIFY_3(gxg_gtk_cell_renderer_get_alignment_w, gxg_gtk_cell_renderer_get_alignment)
-XEN_NARGIFY_3(gxg_gtk_cell_renderer_set_padding_w, gxg_gtk_cell_renderer_set_padding)
-XEN_ARGIFY_3(gxg_gtk_cell_renderer_get_padding_w, gxg_gtk_cell_renderer_get_padding)
-XEN_NARGIFY_2(gxg_gtk_cell_renderer_set_visible_w, gxg_gtk_cell_renderer_set_visible)
-XEN_NARGIFY_1(gxg_gtk_cell_renderer_get_visible_w, gxg_gtk_cell_renderer_get_visible)
-XEN_NARGIFY_2(gxg_gtk_cell_renderer_set_sensitive_w, gxg_gtk_cell_renderer_set_sensitive)
-XEN_NARGIFY_1(gxg_gtk_cell_renderer_get_sensitive_w, gxg_gtk_cell_renderer_get_sensitive)
-XEN_NARGIFY_1(gxg_gtk_cell_renderer_toggle_get_activatable_w, gxg_gtk_cell_renderer_toggle_get_activatable)
-XEN_NARGIFY_2(gxg_gtk_cell_renderer_toggle_set_activatable_w, gxg_gtk_cell_renderer_toggle_set_activatable)
-XEN_NARGIFY_2(gxg_gtk_widget_set_can_focus_w, gxg_gtk_widget_set_can_focus)
-XEN_NARGIFY_1(gxg_gtk_widget_get_can_focus_w, gxg_gtk_widget_get_can_focus)
-XEN_NARGIFY_1(gxg_gtk_widget_has_focus_w, gxg_gtk_widget_has_focus)
-XEN_NARGIFY_2(gxg_gtk_widget_set_can_default_w, gxg_gtk_widget_set_can_default)
-XEN_NARGIFY_1(gxg_gtk_widget_get_can_default_w, gxg_gtk_widget_get_can_default)
-XEN_NARGIFY_1(gxg_gtk_widget_has_default_w, gxg_gtk_widget_has_default)
-XEN_NARGIFY_1(gxg_gtk_widget_get_state_w, gxg_gtk_widget_get_state)
-XEN_NARGIFY_1(gxg_gtk_widget_get_sensitive_w, gxg_gtk_widget_get_sensitive)
-XEN_NARGIFY_1(gxg_gtk_widget_is_sensitive_w, gxg_gtk_widget_is_sensitive)
-XEN_NARGIFY_2(gxg_gtk_widget_set_has_window_w, gxg_gtk_widget_set_has_window)
-XEN_NARGIFY_1(gxg_gtk_widget_get_has_window_w, gxg_gtk_widget_get_has_window)
-XEN_NARGIFY_1(gxg_gtk_widget_get_app_paintable_w, gxg_gtk_widget_get_app_paintable)
-XEN_NARGIFY_1(gxg_gtk_widget_get_double_buffered_w, gxg_gtk_widget_get_double_buffered)
+#if GTK_CHECK_VERSION(3, 0, 0)
+Xen_wrap_1_arg(gxg_gdk_cairo_create_w, gxg_gdk_cairo_create)
+Xen_wrap_5_optional_args(gxg_gdk_window_get_geometry_w, gxg_gdk_window_get_geometry)
+Xen_wrap_2_args(gxg_gdk_keymap_add_virtual_modifiers_w, gxg_gdk_keymap_add_virtual_modifiers)
+Xen_wrap_5_optional_args(gxg_gdk_window_coords_to_parent_w, gxg_gdk_window_coords_to_parent)
+Xen_wrap_5_optional_args(gxg_gdk_window_coords_from_parent_w, gxg_gdk_window_coords_from_parent)
+Xen_wrap_1_arg(gxg_gdk_window_get_effective_parent_w, gxg_gdk_window_get_effective_parent)
+Xen_wrap_1_arg(gxg_gdk_window_get_effective_toplevel_w, gxg_gdk_window_get_effective_toplevel)
+Xen_wrap_1_arg(gxg_gtk_accessible_get_widget_w, gxg_gtk_accessible_get_widget)
+Xen_wrap_2_args(gxg_gtk_widget_send_focus_change_w, gxg_gtk_widget_send_focus_change)
+Xen_wrap_1_arg(gxg_gdk_display_get_device_manager_w, gxg_gdk_display_get_device_manager)
+Xen_wrap_2_args(gxg_gdk_drag_context_set_device_w, gxg_gdk_drag_context_set_device)
+Xen_wrap_1_arg(gxg_gdk_drag_context_get_device_w, gxg_gdk_drag_context_get_device)
+Xen_wrap_1_arg(gxg_gdk_drag_context_list_targets_w, gxg_gdk_drag_context_list_targets)
+Xen_wrap_2_args(gxg_gdk_event_set_device_w, gxg_gdk_event_set_device)
+Xen_wrap_1_arg(gxg_gdk_event_get_device_w, gxg_gdk_event_get_device)
+Xen_wrap_3_optional_args(gxg_gdk_events_get_distance_w, gxg_gdk_events_get_distance)
+Xen_wrap_3_optional_args(gxg_gdk_events_get_angle_w, gxg_gdk_events_get_angle)
+Xen_wrap_4_optional_args(gxg_gdk_events_get_center_w, gxg_gdk_events_get_center)
+Xen_wrap_1_arg(gxg_gdk_window_get_accept_focus_w, gxg_gdk_window_get_accept_focus)
+Xen_wrap_1_arg(gxg_gdk_window_get_focus_on_map_w, gxg_gdk_window_get_focus_on_map)
+Xen_wrap_1_arg(gxg_gdk_window_is_input_only_w, gxg_gdk_window_is_input_only)
+Xen_wrap_1_arg(gxg_gdk_window_is_shaped_w, gxg_gdk_window_is_shaped)
+Xen_wrap_1_arg(gxg_gdk_window_get_modal_hint_w, gxg_gdk_window_get_modal_hint)
+Xen_wrap_3_args(gxg_gdk_window_set_device_cursor_w, gxg_gdk_window_set_device_cursor)
+Xen_wrap_2_args(gxg_gdk_window_get_device_cursor_w, gxg_gdk_window_get_device_cursor)
+Xen_wrap_5_optional_args(gxg_gdk_window_get_device_position_w, gxg_gdk_window_get_device_position)
+Xen_wrap_3_args(gxg_gdk_window_set_device_events_w, gxg_gdk_window_set_device_events)
+Xen_wrap_2_args(gxg_gdk_window_get_device_events_w, gxg_gdk_window_get_device_events)
+Xen_wrap_2_args(gxg_gtk_combo_box_popup_for_device_w, gxg_gtk_combo_box_popup_for_device)
+Xen_wrap_3_args(gxg_gtk_device_grab_add_w, gxg_gtk_device_grab_add)
+Xen_wrap_2_args(gxg_gtk_device_grab_remove_w, gxg_gtk_device_grab_remove)
+Xen_wrap_no_args(gxg_gtk_get_current_event_device_w, gxg_gtk_get_current_event_device)
+Xen_wrap_1_arg(gxg_gtk_paned_new_w, gxg_gtk_paned_new)
+Xen_wrap_2_args(gxg_gtk_scale_new_w, gxg_gtk_scale_new)
+Xen_wrap_4_args(gxg_gtk_scale_new_with_range_w, gxg_gtk_scale_new_with_range)
+Xen_wrap_2_args(gxg_gtk_scrollbar_new_w, gxg_gtk_scrollbar_new)
+Xen_wrap_1_arg(gxg_gtk_separator_new_w, gxg_gtk_separator_new)
+Xen_wrap_2_args(gxg_gtk_widget_device_is_shadowed_w, gxg_gtk_widget_device_is_shadowed)
+Xen_wrap_3_args(gxg_gtk_widget_set_device_events_w, gxg_gtk_widget_set_device_events)
+Xen_wrap_3_args(gxg_gtk_widget_add_device_events_w, gxg_gtk_widget_add_device_events)
+Xen_wrap_1_arg(gxg_gtk_widget_get_support_multidevice_w, gxg_gtk_widget_get_support_multidevice)
+Xen_wrap_2_args(gxg_gtk_widget_set_support_multidevice_w, gxg_gtk_widget_set_support_multidevice)
+Xen_wrap_2_args(gxg_gtk_widget_get_device_events_w, gxg_gtk_widget_get_device_events)
+Xen_wrap_2_args(gxg_gtk_icon_view_get_item_row_w, gxg_gtk_icon_view_get_item_row)
+Xen_wrap_2_args(gxg_gtk_icon_view_get_item_column_w, gxg_gtk_icon_view_get_item_column)
+Xen_wrap_2_args(gxg_gtk_statusbar_remove_all_w, gxg_gtk_statusbar_remove_all)
+Xen_wrap_1_arg(gxg_gtk_window_has_group_w, gxg_gtk_window_has_group)
+Xen_wrap_3_args(gxg_gtk_calendar_select_month_w, gxg_gtk_calendar_select_month)
+Xen_wrap_2_args(gxg_gtk_calendar_mark_day_w, gxg_gtk_calendar_mark_day)
+Xen_wrap_2_args(gxg_gtk_calendar_unmark_day_w, gxg_gtk_calendar_unmark_day)
+Xen_wrap_1_arg(gxg_gdk_drag_context_get_source_window_w, gxg_gdk_drag_context_get_source_window)
+Xen_wrap_1_arg(gxg_gtk_viewport_get_view_window_w, gxg_gtk_viewport_get_view_window)
+Xen_wrap_2_args(gxg_gtk_accessible_set_widget_w, gxg_gtk_accessible_set_widget)
+Xen_wrap_1_arg(gxg_gtk_button_get_event_window_w, gxg_gtk_button_get_event_window)
+Xen_wrap_1_arg(gxg_gtk_message_dialog_get_message_area_w, gxg_gtk_message_dialog_get_message_area)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_length_w, gxg_gtk_selection_data_get_length)
+Xen_wrap_5_args(gxg_gdk_pango_layout_line_get_clip_region_w, gxg_gdk_pango_layout_line_get_clip_region)
+Xen_wrap_5_args(gxg_gdk_pango_layout_get_clip_region_w, gxg_gdk_pango_layout_get_clip_region)
+Xen_wrap_4_args(gxg_gdk_window_shape_combine_region_w, gxg_gdk_window_shape_combine_region)
+Xen_wrap_3_args(gxg_gdk_window_invalidate_region_w, gxg_gdk_window_invalidate_region)
+Xen_wrap_1_arg(gxg_gdk_window_get_update_area_w, gxg_gdk_window_get_update_area)
+Xen_wrap_2_args(gxg_gdk_window_begin_paint_region_w, gxg_gdk_window_begin_paint_region)
+Xen_wrap_4_args(gxg_gdk_window_move_region_w, gxg_gdk_window_move_region)
+Xen_wrap_1_arg(gxg_gdk_keymap_get_num_lock_state_w, gxg_gdk_keymap_get_num_lock_state)
+Xen_wrap_1_arg(gxg_gdk_window_has_native_w, gxg_gdk_window_has_native)
+Xen_wrap_1_arg(gxg_gdk_cursor_get_cursor_type_w, gxg_gdk_cursor_get_cursor_type)
+Xen_wrap_1_arg(gxg_gdk_display_is_closed_w, gxg_gdk_display_is_closed)
+Xen_wrap_1_arg(gxg_gdk_window_get_background_pattern_w, gxg_gdk_window_get_background_pattern)
+Xen_wrap_4_args(gxg_gdk_window_create_similar_surface_w, gxg_gdk_window_create_similar_surface)
+Xen_wrap_2_args(gxg_gtk_expander_set_label_fill_w, gxg_gtk_expander_set_label_fill)
+Xen_wrap_1_arg(gxg_gtk_expander_get_label_fill_w, gxg_gtk_expander_get_label_fill)
+Xen_wrap_2_args(gxg_gtk_calendar_get_day_is_marked_w, gxg_gtk_calendar_get_day_is_marked)
+Xen_wrap_2_args(gxg_gtk_progress_bar_set_inverted_w, gxg_gtk_progress_bar_set_inverted)
+Xen_wrap_1_arg(gxg_gtk_progress_bar_get_inverted_w, gxg_gtk_progress_bar_get_inverted)
+Xen_wrap_2_args(gxg_gtk_radio_button_join_group_w, gxg_gtk_radio_button_join_group)
+Xen_wrap_6_args(gxg_gtk_adjustment_new_w, gxg_gtk_adjustment_new)
+Xen_wrap_4_args(gxg_gtk_binding_set_activate_w, gxg_gtk_binding_set_activate)
+Xen_wrap_3_args(gxg_gtk_bindings_activate_w, gxg_gtk_bindings_activate)
+Xen_wrap_2_args(gxg_gtk_icon_view_create_drag_icon_w, gxg_gtk_icon_view_create_drag_icon)
+Xen_wrap_2_args(gxg_gtk_tree_view_create_row_drag_icon_w, gxg_gtk_tree_view_create_row_drag_icon)
+Xen_wrap_2_args(gxg_gdk_cairo_get_clip_rectangle_w, gxg_gdk_cairo_get_clip_rectangle)
+Xen_wrap_1_arg(gxg_gdk_cairo_region_create_from_surface_w, gxg_gdk_cairo_region_create_from_surface)
+Xen_wrap_1_arg(gxg_gdk_window_get_visual_w, gxg_gdk_window_get_visual)
+Xen_wrap_1_arg(gxg_gdk_window_get_screen_w, gxg_gdk_window_get_screen)
+Xen_wrap_1_arg(gxg_gdk_window_get_display_w, gxg_gdk_window_get_display)
+Xen_wrap_1_arg(gxg_gdk_window_get_width_w, gxg_gdk_window_get_width)
+Xen_wrap_1_arg(gxg_gdk_window_get_height_w, gxg_gdk_window_get_height)
+Xen_wrap_1_arg(gxg_gtk_cell_renderer_get_request_mode_w, gxg_gtk_cell_renderer_get_request_mode)
+Xen_wrap_4_optional_args(gxg_gtk_cell_renderer_get_preferred_width_w, gxg_gtk_cell_renderer_get_preferred_width)
+Xen_wrap_5_optional_args(gxg_gtk_cell_renderer_get_preferred_height_for_width_w, gxg_gtk_cell_renderer_get_preferred_height_for_width)
+Xen_wrap_4_optional_args(gxg_gtk_cell_renderer_get_preferred_height_w, gxg_gtk_cell_renderer_get_preferred_height)
+Xen_wrap_5_optional_args(gxg_gtk_cell_renderer_get_preferred_width_for_height_w, gxg_gtk_cell_renderer_get_preferred_width_for_height)
+Xen_wrap_1_arg(gxg_gtk_container_class_handle_border_width_w, gxg_gtk_container_class_handle_border_width)
+Xen_wrap_2_args(gxg_gtk_drag_set_icon_surface_w, gxg_gtk_drag_set_icon_surface)
+Xen_wrap_2_args(gxg_gtk_notebook_set_group_name_w, gxg_gtk_notebook_set_group_name)
+Xen_wrap_1_arg(gxg_gtk_notebook_get_group_name_w, gxg_gtk_notebook_get_group_name)
+Xen_wrap_2_args(gxg_gtk_widget_draw_w, gxg_gtk_widget_draw)
+Xen_wrap_1_arg(gxg_gtk_widget_get_request_mode_w, gxg_gtk_widget_get_request_mode)
+Xen_wrap_3_optional_args(gxg_gtk_widget_get_preferred_width_w, gxg_gtk_widget_get_preferred_width)
+Xen_wrap_4_optional_args(gxg_gtk_widget_get_preferred_height_for_width_w, gxg_gtk_widget_get_preferred_height_for_width)
+Xen_wrap_3_optional_args(gxg_gtk_widget_get_preferred_height_w, gxg_gtk_widget_get_preferred_height)
+Xen_wrap_4_optional_args(gxg_gtk_widget_get_preferred_width_for_height_w, gxg_gtk_widget_get_preferred_width_for_height)
+Xen_wrap_1_arg(gxg_gtk_widget_get_allocated_width_w, gxg_gtk_widget_get_allocated_width)
+Xen_wrap_1_arg(gxg_gtk_widget_get_allocated_height_w, gxg_gtk_widget_get_allocated_height)
+Xen_wrap_2_args(gxg_gtk_widget_set_visual_w, gxg_gtk_widget_set_visual)
+Xen_wrap_1_arg(gxg_gtk_widget_get_halign_w, gxg_gtk_widget_get_halign)
+Xen_wrap_2_args(gxg_gtk_widget_set_halign_w, gxg_gtk_widget_set_halign)
+Xen_wrap_1_arg(gxg_gtk_widget_get_valign_w, gxg_gtk_widget_get_valign)
+Xen_wrap_2_args(gxg_gtk_widget_set_valign_w, gxg_gtk_widget_set_valign)
+Xen_wrap_1_arg(gxg_gtk_widget_get_margin_top_w, gxg_gtk_widget_get_margin_top)
+Xen_wrap_2_args(gxg_gtk_widget_set_margin_top_w, gxg_gtk_widget_set_margin_top)
+Xen_wrap_1_arg(gxg_gtk_widget_get_margin_bottom_w, gxg_gtk_widget_get_margin_bottom)
+Xen_wrap_2_args(gxg_gtk_widget_set_margin_bottom_w, gxg_gtk_widget_set_margin_bottom)
+Xen_wrap_2_args(gxg_gtk_widget_shape_combine_region_w, gxg_gtk_widget_shape_combine_region)
+Xen_wrap_2_args(gxg_gtk_widget_input_shape_combine_region_w, gxg_gtk_widget_input_shape_combine_region)
+Xen_wrap_2_args(gxg_gtk_cairo_should_draw_window_w, gxg_gtk_cairo_should_draw_window)
+Xen_wrap_3_args(gxg_gtk_cairo_transform_to_window_w, gxg_gtk_cairo_transform_to_window)
+Xen_wrap_no_args(gxg_gtk_combo_box_new_with_entry_w, gxg_gtk_combo_box_new_with_entry)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_has_entry_w, gxg_gtk_combo_box_get_has_entry)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_entry_text_column_w, gxg_gtk_combo_box_set_entry_text_column)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_entry_text_column_w, gxg_gtk_combo_box_get_entry_text_column)
+Xen_wrap_3_args(gxg_gtk_target_entry_new_w, gxg_gtk_target_entry_new)
+Xen_wrap_1_arg(gxg_gtk_target_entry_copy_w, gxg_gtk_target_entry_copy)
+Xen_wrap_1_arg(gxg_gtk_target_entry_free_w, gxg_gtk_target_entry_free)
+Xen_wrap_1_arg(gxg_gtk_widget_get_hexpand_w, gxg_gtk_widget_get_hexpand)
+Xen_wrap_2_args(gxg_gtk_widget_set_hexpand_w, gxg_gtk_widget_set_hexpand)
+Xen_wrap_1_arg(gxg_gtk_widget_get_hexpand_set_w, gxg_gtk_widget_get_hexpand_set)
+Xen_wrap_2_args(gxg_gtk_widget_set_hexpand_set_w, gxg_gtk_widget_set_hexpand_set)
+Xen_wrap_1_arg(gxg_gtk_widget_get_vexpand_w, gxg_gtk_widget_get_vexpand)
+Xen_wrap_2_args(gxg_gtk_widget_set_vexpand_w, gxg_gtk_widget_set_vexpand)
+Xen_wrap_1_arg(gxg_gtk_widget_get_vexpand_set_w, gxg_gtk_widget_get_vexpand_set)
+Xen_wrap_2_args(gxg_gtk_widget_set_vexpand_set_w, gxg_gtk_widget_set_vexpand_set)
+Xen_wrap_1_arg(gxg_gtk_widget_queue_compute_expand_w, gxg_gtk_widget_queue_compute_expand)
+Xen_wrap_2_args(gxg_gtk_widget_compute_expand_w, gxg_gtk_widget_compute_expand)
+Xen_wrap_3_args(gxg_gtk_window_set_default_geometry_w, gxg_gtk_window_set_default_geometry)
+Xen_wrap_3_args(gxg_gtk_window_resize_to_geometry_w, gxg_gtk_window_resize_to_geometry)
+Xen_wrap_no_args(gxg_gtk_combo_box_text_new_w, gxg_gtk_combo_box_text_new)
+Xen_wrap_no_args(gxg_gtk_combo_box_text_new_with_entry_w, gxg_gtk_combo_box_text_new_with_entry)
+Xen_wrap_2_args(gxg_gtk_combo_box_text_append_text_w, gxg_gtk_combo_box_text_append_text)
+Xen_wrap_3_args(gxg_gtk_combo_box_text_insert_text_w, gxg_gtk_combo_box_text_insert_text)
+Xen_wrap_2_args(gxg_gtk_combo_box_text_prepend_text_w, gxg_gtk_combo_box_text_prepend_text)
+Xen_wrap_2_args(gxg_gtk_combo_box_text_remove_w, gxg_gtk_combo_box_text_remove)
+Xen_wrap_1_arg(gxg_gtk_combo_box_text_get_active_text_w, gxg_gtk_combo_box_text_get_active_text)
+Xen_wrap_2_args(gxg_gdk_cairo_set_source_rgba_w, gxg_gdk_cairo_set_source_rgba)
+Xen_wrap_2_args(gxg_gdk_window_set_background_rgba_w, gxg_gdk_window_set_background_rgba)
+Xen_wrap_2_args(gxg_gtk_cell_view_set_background_rgba_w, gxg_gtk_cell_view_set_background_rgba)
+Xen_wrap_1_arg(gxg_gtk_combo_box_text_remove_all_w, gxg_gtk_combo_box_text_remove_all)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_popup_fixed_width_w, gxg_gtk_combo_box_set_popup_fixed_width)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_popup_fixed_width_w, gxg_gtk_combo_box_get_popup_fixed_width)
+Xen_wrap_1_arg(gxg_gtk_scrolled_window_get_min_content_width_w, gxg_gtk_scrolled_window_get_min_content_width)
+Xen_wrap_2_args(gxg_gtk_scrolled_window_set_min_content_width_w, gxg_gtk_scrolled_window_set_min_content_width)
+Xen_wrap_1_arg(gxg_gtk_scrolled_window_get_min_content_height_w, gxg_gtk_scrolled_window_get_min_content_height)
+Xen_wrap_2_args(gxg_gtk_scrolled_window_set_min_content_height_w, gxg_gtk_scrolled_window_set_min_content_height)
+Xen_wrap_no_args(gxg_gtk_grid_new_w, gxg_gtk_grid_new)
+Xen_wrap_6_args(gxg_gtk_grid_attach_w, gxg_gtk_grid_attach)
+Xen_wrap_6_args(gxg_gtk_grid_attach_next_to_w, gxg_gtk_grid_attach_next_to)
+Xen_wrap_2_args(gxg_gtk_grid_set_row_homogeneous_w, gxg_gtk_grid_set_row_homogeneous)
+Xen_wrap_1_arg(gxg_gtk_grid_get_row_homogeneous_w, gxg_gtk_grid_get_row_homogeneous)
+Xen_wrap_2_args(gxg_gtk_grid_set_row_spacing_w, gxg_gtk_grid_set_row_spacing)
+Xen_wrap_1_arg(gxg_gtk_grid_get_row_spacing_w, gxg_gtk_grid_get_row_spacing)
+Xen_wrap_2_args(gxg_gtk_grid_set_column_homogeneous_w, gxg_gtk_grid_set_column_homogeneous)
+Xen_wrap_1_arg(gxg_gtk_grid_get_column_homogeneous_w, gxg_gtk_grid_get_column_homogeneous)
+Xen_wrap_2_args(gxg_gtk_grid_set_column_spacing_w, gxg_gtk_grid_set_column_spacing)
+Xen_wrap_1_arg(gxg_gtk_grid_get_column_spacing_w, gxg_gtk_grid_get_column_spacing)
+Xen_wrap_1_arg(gxg_gtk_scrollable_get_hadjustment_w, gxg_gtk_scrollable_get_hadjustment)
+Xen_wrap_2_args(gxg_gtk_scrollable_set_hadjustment_w, gxg_gtk_scrollable_set_hadjustment)
+Xen_wrap_1_arg(gxg_gtk_scrollable_get_vadjustment_w, gxg_gtk_scrollable_get_vadjustment)
+Xen_wrap_2_args(gxg_gtk_scrollable_set_vadjustment_w, gxg_gtk_scrollable_set_vadjustment)
+Xen_wrap_1_arg(gxg_gtk_assistant_next_page_w, gxg_gtk_assistant_next_page)
+Xen_wrap_1_arg(gxg_gtk_assistant_previous_page_w, gxg_gtk_assistant_previous_page)
+Xen_wrap_1_arg(gxg_gtk_combo_box_new_with_model_and_entry_w, gxg_gtk_combo_box_new_with_model_and_entry)
+Xen_wrap_1_arg(gxg_gtk_scrollable_get_hscroll_policy_w, gxg_gtk_scrollable_get_hscroll_policy)
+Xen_wrap_2_args(gxg_gtk_scrollable_set_hscroll_policy_w, gxg_gtk_scrollable_set_hscroll_policy)
+Xen_wrap_1_arg(gxg_gtk_scrollable_get_vscroll_policy_w, gxg_gtk_scrollable_get_vscroll_policy)
+Xen_wrap_2_args(gxg_gtk_scrollable_set_vscroll_policy_w, gxg_gtk_scrollable_set_vscroll_policy)
+Xen_wrap_no_args(gxg_gtk_switch_new_w, gxg_gtk_switch_new)
+Xen_wrap_2_args(gxg_gtk_switch_set_active_w, gxg_gtk_switch_set_active)
+Xen_wrap_1_arg(gxg_gtk_switch_get_active_w, gxg_gtk_switch_get_active)
+Xen_wrap_1_arg(gxg_gdk_window_get_clip_region_w, gxg_gdk_window_get_clip_region)
+Xen_wrap_1_arg(gxg_gdk_window_get_visible_region_w, gxg_gdk_window_get_visible_region)
+Xen_wrap_no_args(gxg_gtk_border_new_w, gxg_gtk_border_new)
+Xen_wrap_1_arg(gxg_gtk_border_copy_w, gxg_gtk_border_copy)
+Xen_wrap_1_arg(gxg_gtk_border_free_w, gxg_gtk_border_free)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_id_column_w, gxg_gtk_combo_box_get_id_column)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_id_column_w, gxg_gtk_combo_box_set_id_column)
+Xen_wrap_1_arg(gxg_gtk_combo_box_get_active_id_w, gxg_gtk_combo_box_get_active_id)
+Xen_wrap_4_args(gxg_gtk_combo_box_text_insert_w, gxg_gtk_combo_box_text_insert)
+Xen_wrap_3_args(gxg_gtk_combo_box_text_append_w, gxg_gtk_combo_box_text_append)
+Xen_wrap_3_args(gxg_gtk_combo_box_text_prepend_w, gxg_gtk_combo_box_text_prepend)
+Xen_wrap_1_arg(gxg_gtk_button_box_new_w, gxg_gtk_button_box_new)
+Xen_wrap_2_args(gxg_gtk_box_new_w, gxg_gtk_box_new)
+Xen_wrap_5_args(gxg_gtk_tree_view_set_cursor_on_cell_w, gxg_gtk_tree_view_set_cursor_on_cell)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_rubber_banding_w, gxg_gtk_tree_view_set_rubber_banding)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_rubber_banding_w, gxg_gtk_tree_view_get_rubber_banding)
+Xen_wrap_2_args(gxg_gtk_tooltip_set_markup_w, gxg_gtk_tooltip_set_markup)
+Xen_wrap_2_args(gxg_gtk_tooltip_set_icon_w, gxg_gtk_tooltip_set_icon)
+Xen_wrap_2_args(gxg_gtk_tooltip_set_custom_w, gxg_gtk_tooltip_set_custom)
+Xen_wrap_1_arg(gxg_gtk_tooltip_trigger_tooltip_query_w, gxg_gtk_tooltip_trigger_tooltip_query)
+Xen_wrap_2_args(gxg_gtk_button_set_image_position_w, gxg_gtk_button_set_image_position)
+Xen_wrap_1_arg(gxg_gtk_button_get_image_position_w, gxg_gtk_button_get_image_position)
+Xen_wrap_4_optional_args(gxg_gtk_show_uri_w, gxg_gtk_show_uri)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_new_with_area_w, gxg_gtk_tree_view_column_new_with_area)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_button_w, gxg_gtk_tree_view_column_get_button)
+Xen_wrap_2_args(gxg_gtk_tree_view_column_focus_cell_w, gxg_gtk_tree_view_column_focus_cell)
+Xen_wrap_1_arg(gxg_gtk_clipboard_wait_is_uris_available_w, gxg_gtk_clipboard_wait_is_uris_available)
+Xen_wrap_3_args(gxg_gtk_toolbar_set_drop_highlight_item_w, gxg_gtk_toolbar_set_drop_highlight_item)
+Xen_wrap_1_arg(gxg_gtk_tool_item_toolbar_reconfigured_w, gxg_gtk_tool_item_toolbar_reconfigured)
+Xen_wrap_2_args(gxg_gtk_orientable_set_orientation_w, gxg_gtk_orientable_set_orientation)
+Xen_wrap_1_arg(gxg_gtk_orientable_get_orientation_w, gxg_gtk_orientable_get_orientation)
+Xen_wrap_2_optional_args(gxg_gtk_parse_args_w, gxg_gtk_parse_args)
+Xen_wrap_no_args(gxg_gtk_get_major_version_w, gxg_gtk_get_major_version)
+Xen_wrap_no_args(gxg_gtk_get_minor_version_w, gxg_gtk_get_minor_version)
+Xen_wrap_no_args(gxg_gtk_get_micro_version_w, gxg_gtk_get_micro_version)
+Xen_wrap_no_args(gxg_gtk_get_binary_age_w, gxg_gtk_get_binary_age)
+Xen_wrap_no_args(gxg_gtk_get_interface_age_w, gxg_gtk_get_interface_age)
+Xen_wrap_2_args(gxg_gtk_progress_bar_set_show_text_w, gxg_gtk_progress_bar_set_show_text)
+Xen_wrap_1_arg(gxg_gtk_progress_bar_get_show_text_w, gxg_gtk_progress_bar_get_show_text)
+Xen_wrap_1_arg(gxg_gtk_invisible_new_for_screen_w, gxg_gtk_invisible_new_for_screen)
+Xen_wrap_2_args(gxg_gtk_invisible_set_screen_w, gxg_gtk_invisible_set_screen)
+Xen_wrap_1_arg(gxg_gtk_invisible_get_screen_w, gxg_gtk_invisible_get_screen)
+Xen_wrap_2_args(gxg_gtk_entry_get_icon_storage_type_w, gxg_gtk_entry_get_icon_storage_type)
+Xen_wrap_2_args(gxg_gtk_entry_get_icon_pixbuf_w, gxg_gtk_entry_get_icon_pixbuf)
+Xen_wrap_2_args(gxg_gtk_entry_get_icon_gicon_w, gxg_gtk_entry_get_icon_gicon)
+Xen_wrap_3_args(gxg_gtk_container_propagate_draw_w, gxg_gtk_container_propagate_draw)
+Xen_wrap_2_args(gxg_gtk_container_set_focus_chain_w, gxg_gtk_container_set_focus_chain)
+Xen_wrap_2_optional_args(gxg_gtk_container_get_focus_chain_w, gxg_gtk_container_get_focus_chain)
+Xen_wrap_1_arg(gxg_gtk_container_unset_focus_chain_w, gxg_gtk_container_unset_focus_chain)
+Xen_wrap_2_args(gxg_gtk_container_set_focus_child_w, gxg_gtk_container_set_focus_child)
+Xen_wrap_2_args(gxg_gtk_container_set_focus_vadjustment_w, gxg_gtk_container_set_focus_vadjustment)
+Xen_wrap_1_arg(gxg_gtk_container_get_focus_vadjustment_w, gxg_gtk_container_get_focus_vadjustment)
+Xen_wrap_2_args(gxg_gtk_container_set_focus_hadjustment_w, gxg_gtk_container_set_focus_hadjustment)
+Xen_wrap_1_arg(gxg_gtk_container_get_focus_hadjustment_w, gxg_gtk_container_get_focus_hadjustment)
+Xen_wrap_1_arg(gxg_gtk_assistant_commit_w, gxg_gtk_assistant_commit)
+Xen_wrap_2_args(gxg_gtk_window_set_skip_taskbar_hint_w, gxg_gtk_window_set_skip_taskbar_hint)
+Xen_wrap_1_arg(gxg_gtk_window_get_skip_taskbar_hint_w, gxg_gtk_window_get_skip_taskbar_hint)
+Xen_wrap_2_args(gxg_gtk_window_set_skip_pager_hint_w, gxg_gtk_window_set_skip_pager_hint)
+Xen_wrap_1_arg(gxg_gtk_window_get_skip_pager_hint_w, gxg_gtk_window_get_skip_pager_hint)
+Xen_wrap_2_args(gxg_gtk_window_set_screen_w, gxg_gtk_window_set_screen)
+Xen_wrap_1_arg(gxg_gtk_window_get_screen_w, gxg_gtk_window_get_screen)
+Xen_wrap_3_optional_args(gxg_gtk_window_set_icon_from_file_w, gxg_gtk_window_set_icon_from_file)
+Xen_wrap_2_optional_args(gxg_gtk_window_set_default_icon_from_file_w, gxg_gtk_window_set_default_icon_from_file)
+Xen_wrap_1_arg(gxg_gtk_window_fullscreen_w, gxg_gtk_window_fullscreen)
+Xen_wrap_1_arg(gxg_gtk_window_unfullscreen_w, gxg_gtk_window_unfullscreen)
+Xen_wrap_1_arg(gxg_gtk_window_get_window_type_w, gxg_gtk_window_get_window_type)
+Xen_wrap_2_args(gxg_gtk_window_group_add_window_w, gxg_gtk_window_group_add_window)
+Xen_wrap_2_args(gxg_gtk_window_group_remove_window_w, gxg_gtk_window_group_remove_window)
+Xen_wrap_no_args(gxg_gtk_window_group_new_w, gxg_gtk_window_group_new)
+Xen_wrap_1_arg(gxg_gtk_window_get_group_w, gxg_gtk_window_get_group)
+Xen_wrap_1_arg(gxg_gtk_window_group_list_windows_w, gxg_gtk_window_group_list_windows)
+Xen_wrap_2_args(gxg_gtk_window_group_get_current_device_grab_w, gxg_gtk_window_group_get_current_device_grab)
+Xen_wrap_1_arg(gxg_gtk_window_group_get_current_grab_w, gxg_gtk_window_group_get_current_grab)
+Xen_wrap_1_arg(gxg_gtk_selection_data_get_data_w, gxg_gtk_selection_data_get_data)
+Xen_wrap_4_args(gxg_gtk_selection_owner_set_for_display_w, gxg_gtk_selection_owner_set_for_display)
+Xen_wrap_1_arg(gxg_gtk_tool_shell_get_text_orientation_w, gxg_gtk_tool_shell_get_text_orientation)
+Xen_wrap_1_arg(gxg_gtk_tool_shell_get_text_alignment_w, gxg_gtk_tool_shell_get_text_alignment)
+Xen_wrap_1_arg(gxg_gtk_tool_shell_get_ellipsize_mode_w, gxg_gtk_tool_shell_get_ellipsize_mode)
+Xen_wrap_1_arg(gxg_gtk_tool_shell_get_text_size_group_w, gxg_gtk_tool_shell_get_text_size_group)
+Xen_wrap_1_arg(gxg_gtk_tool_shell_get_orientation_w, gxg_gtk_tool_shell_get_orientation)
+Xen_wrap_1_arg(gxg_gtk_tool_shell_get_style_w, gxg_gtk_tool_shell_get_style)
+Xen_wrap_1_arg(gxg_gtk_tool_shell_get_relief_style_w, gxg_gtk_tool_shell_get_relief_style)
+Xen_wrap_1_arg(gxg_gtk_tool_shell_rebuild_menu_w, gxg_gtk_tool_shell_rebuild_menu)
+Xen_wrap_1_arg(gxg_gtk_accel_map_lock_path_w, gxg_gtk_accel_map_lock_path)
+Xen_wrap_1_arg(gxg_gtk_accel_map_unlock_path_w, gxg_gtk_accel_map_unlock_path)
+Xen_wrap_4_args(gxg_gtk_icon_theme_lookup_by_gicon_w, gxg_gtk_icon_theme_lookup_by_gicon)
+Xen_wrap_2_args(gxg_gtk_icon_info_new_for_pixbuf_w, gxg_gtk_icon_info_new_for_pixbuf)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_item_orientation_w, gxg_gtk_icon_view_set_item_orientation)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_item_orientation_w, gxg_gtk_icon_view_get_item_orientation)
+Xen_wrap_2_args(gxg_gtk_text_view_im_context_filter_keypress_w, gxg_gtk_text_view_im_context_filter_keypress)
+Xen_wrap_1_arg(gxg_gtk_text_view_reset_im_context_w, gxg_gtk_text_view_reset_im_context)
+Xen_wrap_4_optional_args(gxg_gdk_device_get_position_w, gxg_gdk_device_get_position)
+Xen_wrap_3_optional_args(gxg_gdk_device_get_window_at_position_w, gxg_gdk_device_get_window_at_position)
+Xen_wrap_1_arg(gxg_gtk_cell_view_get_draw_sensitive_w, gxg_gtk_cell_view_get_draw_sensitive)
+Xen_wrap_2_args(gxg_gtk_cell_view_set_draw_sensitive_w, gxg_gtk_cell_view_set_draw_sensitive)
+Xen_wrap_1_arg(gxg_gtk_cell_view_get_fit_model_w, gxg_gtk_cell_view_get_fit_model)
+Xen_wrap_2_args(gxg_gtk_cell_view_set_fit_model_w, gxg_gtk_cell_view_set_fit_model)
+Xen_wrap_1_arg(gxg_gtk_combo_box_new_with_area_w, gxg_gtk_combo_box_new_with_area)
+Xen_wrap_1_arg(gxg_gtk_combo_box_new_with_area_and_entry_w, gxg_gtk_combo_box_new_with_area_and_entry)
+Xen_wrap_1_arg(gxg_gtk_icon_view_new_with_area_w, gxg_gtk_icon_view_new_with_area)
+Xen_wrap_2_args(gxg_gtk_menu_item_set_reserve_indicator_w, gxg_gtk_menu_item_set_reserve_indicator)
+Xen_wrap_1_arg(gxg_gtk_menu_item_get_reserve_indicator_w, gxg_gtk_menu_item_get_reserve_indicator)
+Xen_wrap_1_arg(gxg_gtk_menu_shell_get_selected_item_w, gxg_gtk_menu_shell_get_selected_item)
+Xen_wrap_1_arg(gxg_gtk_menu_shell_get_parent_shell_w, gxg_gtk_menu_shell_get_parent_shell)
+Xen_wrap_2_optional_args(gxg_gtk_selection_data_get_data_with_length_w, gxg_gtk_selection_data_get_data_with_length)
+Xen_wrap_2_args(gxg_gtk_tree_model_iter_previous_w, gxg_gtk_tree_model_iter_previous)
+Xen_wrap_7_optional_args(gxg_gtk_tree_view_is_blank_at_pos_w, gxg_gtk_tree_view_is_blank_at_pos)
+Xen_wrap_3_args(gxg_gtk_widget_set_device_enabled_w, gxg_gtk_widget_set_device_enabled)
+Xen_wrap_2_args(gxg_gtk_widget_get_device_enabled_w, gxg_gtk_widget_get_device_enabled)
+Xen_wrap_2_args(gxg_gtk_window_set_has_user_ref_count_w, gxg_gtk_window_set_has_user_ref_count)
+Xen_wrap_5_args(gxg_gdk_selection_send_notify_w, gxg_gdk_selection_send_notify)
+Xen_wrap_6_args(gxg_gdk_selection_send_notify_for_display_w, gxg_gdk_selection_send_notify_for_display)
+Xen_wrap_1_arg(gxg_gdk_rgba_copy_w, gxg_gdk_rgba_copy)
+Xen_wrap_1_arg(gxg_gdk_rgba_free_w, gxg_gdk_rgba_free)
+Xen_wrap_2_args(gxg_gdk_rgba_parse_w, gxg_gdk_rgba_parse)
+Xen_wrap_1_arg(gxg_gdk_rgba_to_string_w, gxg_gdk_rgba_to_string)
+Xen_wrap_3_args(gxg_gtk_widget_set_state_flags_w, gxg_gtk_widget_set_state_flags)
+Xen_wrap_2_args(gxg_gtk_widget_unset_state_flags_w, gxg_gtk_widget_unset_state_flags)
+Xen_wrap_1_arg(gxg_gtk_widget_get_state_flags_w, gxg_gtk_widget_get_state_flags)
#endif
-#if HAVE_GTK_WIDGET_GET_VISIBLE
-XEN_NARGIFY_1(gxg_gdk_window_get_cursor_w, gxg_gdk_window_get_cursor)
-XEN_NARGIFY_2(gxg_gtk_file_chooser_set_create_folders_w, gxg_gtk_file_chooser_set_create_folders)
-XEN_NARGIFY_1(gxg_gtk_file_chooser_get_create_folders_w, gxg_gtk_file_chooser_get_create_folders)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_item_padding_w, gxg_gtk_icon_view_set_item_padding)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_item_padding_w, gxg_gtk_icon_view_get_item_padding)
-XEN_NARGIFY_1(gxg_gtk_widget_has_grab_w, gxg_gtk_widget_has_grab)
-XEN_NARGIFY_2(gxg_gtk_widget_set_visible_w, gxg_gtk_widget_set_visible)
-XEN_NARGIFY_1(gxg_gtk_widget_get_visible_w, gxg_gtk_widget_get_visible)
-XEN_NARGIFY_2(gxg_gtk_range_set_flippable_w, gxg_gtk_range_set_flippable)
-XEN_NARGIFY_1(gxg_gtk_range_get_flippable_w, gxg_gtk_range_get_flippable)
-XEN_NARGIFY_1(gxg_gtk_widget_is_toplevel_w, gxg_gtk_widget_is_toplevel)
-XEN_NARGIFY_1(gxg_gtk_widget_is_drawable_w, gxg_gtk_widget_is_drawable)
-XEN_NARGIFY_2(gxg_gtk_widget_set_window_w, gxg_gtk_widget_set_window)
-XEN_NARGIFY_1(gxg_gdk_window_is_destroyed_w, gxg_gdk_window_is_destroyed)
-XEN_NARGIFY_3(gxg_gdk_window_restack_w, gxg_gdk_window_restack)
-XEN_NARGIFY_2(gxg_gtk_widget_set_receives_default_w, gxg_gtk_widget_set_receives_default)
-XEN_NARGIFY_1(gxg_gtk_widget_get_receives_default_w, gxg_gtk_widget_get_receives_default)
-XEN_NARGIFY_1(gxg_gdk_window_flush_w, gxg_gdk_window_flush)
+#if GTK_CHECK_VERSION(3, 2, 0)
+Xen_wrap_1_arg(gxg_gtk_entry_get_placeholder_text_w, gxg_gtk_entry_get_placeholder_text)
+Xen_wrap_2_args(gxg_gtk_entry_set_placeholder_text_w, gxg_gtk_entry_set_placeholder_text)
+Xen_wrap_2_args(gxg_gtk_expander_set_resize_toplevel_w, gxg_gtk_expander_set_resize_toplevel)
+Xen_wrap_1_arg(gxg_gtk_expander_get_resize_toplevel_w, gxg_gtk_expander_get_resize_toplevel)
+Xen_wrap_1_arg(gxg_gtk_widget_path_to_string_w, gxg_gtk_widget_path_to_string)
+Xen_wrap_2_args(gxg_gtk_button_box_get_child_non_homogeneous_w, gxg_gtk_button_box_get_child_non_homogeneous)
+Xen_wrap_3_args(gxg_gtk_button_box_set_child_non_homogeneous_w, gxg_gtk_button_box_set_child_non_homogeneous)
+Xen_wrap_3_args(gxg_gtk_container_child_notify_w, gxg_gtk_container_child_notify)
+Xen_wrap_2_args(gxg_gtk_drag_source_set_icon_gicon_w, gxg_gtk_drag_source_set_icon_gicon)
+Xen_wrap_4_args(gxg_gtk_drag_set_icon_gicon_w, gxg_gtk_drag_set_icon_gicon)
+Xen_wrap_2_args(gxg_gtk_combo_box_set_active_id_w, gxg_gtk_combo_box_set_active_id)
+Xen_wrap_1_arg(gxg_gtk_tree_view_column_get_x_offset_w, gxg_gtk_tree_view_column_get_x_offset)
+Xen_wrap_no_args(gxg_gtk_overlay_new_w, gxg_gtk_overlay_new)
+Xen_wrap_2_args(gxg_gtk_overlay_add_overlay_w, gxg_gtk_overlay_add_overlay)
+Xen_wrap_1_arg(gxg_gtk_adjustment_get_minimum_increment_w, gxg_gtk_adjustment_get_minimum_increment)
+Xen_wrap_2_args(gxg_gtk_grid_insert_row_w, gxg_gtk_grid_insert_row)
+Xen_wrap_2_args(gxg_gtk_grid_insert_column_w, gxg_gtk_grid_insert_column)
+Xen_wrap_3_args(gxg_gtk_grid_insert_next_to_w, gxg_gtk_grid_insert_next_to)
+Xen_wrap_2_args(gxg_gtk_text_iter_assign_w, gxg_gtk_text_iter_assign)
+Xen_wrap_1_arg(gxg_gtk_widget_has_visible_focus_w, gxg_gtk_widget_has_visible_focus)
+Xen_wrap_2_args(gxg_gtk_window_set_focus_visible_w, gxg_gtk_window_set_focus_visible)
+Xen_wrap_1_arg(gxg_gtk_window_get_focus_visible_w, gxg_gtk_window_get_focus_visible)
+Xen_wrap_2_args(gxg_gtk_font_chooser_dialog_new_w, gxg_gtk_font_chooser_dialog_new)
+Xen_wrap_2_args(gxg_gdk_event_get_button_w, gxg_gdk_event_get_button)
+Xen_wrap_2_args(gxg_gdk_event_get_click_count_w, gxg_gdk_event_get_click_count)
+Xen_wrap_2_args(gxg_gdk_event_get_keyval_w, gxg_gdk_event_get_keyval)
+Xen_wrap_2_args(gxg_gdk_event_get_keycode_w, gxg_gdk_event_get_keycode)
+Xen_wrap_2_optional_args(gxg_gdk_event_get_scroll_direction_w, gxg_gdk_event_get_scroll_direction)
+Xen_wrap_3_args(gxg_gtk_grid_get_child_at_w, gxg_gtk_grid_get_child_at)
+Xen_wrap_1_arg(gxg_gtk_font_chooser_get_font_family_w, gxg_gtk_font_chooser_get_font_family)
+Xen_wrap_1_arg(gxg_gtk_font_chooser_get_font_face_w, gxg_gtk_font_chooser_get_font_face)
+Xen_wrap_1_arg(gxg_gtk_font_chooser_get_font_size_w, gxg_gtk_font_chooser_get_font_size)
+Xen_wrap_1_arg(gxg_gtk_font_chooser_get_font_desc_w, gxg_gtk_font_chooser_get_font_desc)
+Xen_wrap_2_args(gxg_gtk_font_chooser_set_font_desc_w, gxg_gtk_font_chooser_set_font_desc)
+Xen_wrap_1_arg(gxg_gtk_font_chooser_get_font_w, gxg_gtk_font_chooser_get_font)
+Xen_wrap_2_args(gxg_gtk_font_chooser_set_font_w, gxg_gtk_font_chooser_set_font)
+Xen_wrap_1_arg(gxg_gtk_font_chooser_get_preview_text_w, gxg_gtk_font_chooser_get_preview_text)
+Xen_wrap_2_args(gxg_gtk_font_chooser_set_preview_text_w, gxg_gtk_font_chooser_set_preview_text)
+Xen_wrap_1_arg(gxg_gtk_font_chooser_get_show_preview_entry_w, gxg_gtk_font_chooser_get_show_preview_entry)
+Xen_wrap_2_args(gxg_gtk_font_chooser_set_show_preview_entry_w, gxg_gtk_font_chooser_set_show_preview_entry)
+Xen_wrap_no_args(gxg_gtk_font_chooser_widget_new_w, gxg_gtk_font_chooser_widget_new)
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-XEN_NARGIFY_2(gxg_gtk_dialog_get_widget_for_response_w, gxg_gtk_dialog_get_widget_for_response)
-XEN_NARGIFY_3(gxg_gtk_tooltip_set_icon_from_gicon_w, gxg_gtk_tooltip_set_icon_from_gicon)
-XEN_NARGIFY_1(gxg_gtk_viewport_get_bin_window_w, gxg_gtk_viewport_get_bin_window)
-XEN_NARGIFY_0(gxg_gtk_spinner_new_w, gxg_gtk_spinner_new)
-XEN_NARGIFY_1(gxg_gtk_spinner_start_w, gxg_gtk_spinner_start)
-XEN_NARGIFY_1(gxg_gtk_spinner_stop_w, gxg_gtk_spinner_stop)
-XEN_NARGIFY_0(gxg_gtk_cell_renderer_spinner_new_w, gxg_gtk_cell_renderer_spinner_new)
-XEN_NARGIFY_2(gxg_gtk_action_set_always_show_image_w, gxg_gtk_action_set_always_show_image)
-XEN_NARGIFY_1(gxg_gtk_action_get_always_show_image_w, gxg_gtk_action_get_always_show_image)
-XEN_NARGIFY_2(gxg_gtk_notebook_get_action_widget_w, gxg_gtk_notebook_get_action_widget)
-XEN_NARGIFY_3(gxg_gtk_notebook_set_action_widget_w, gxg_gtk_notebook_set_action_widget)
-XEN_NARGIFY_1(gxg_gtk_statusbar_get_message_area_w, gxg_gtk_statusbar_get_message_area)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_ellipsize_mode_w, gxg_gtk_tool_item_get_ellipsize_mode)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_text_alignment_w, gxg_gtk_tool_item_get_text_alignment)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_text_orientation_w, gxg_gtk_tool_item_get_text_orientation)
-XEN_NARGIFY_1(gxg_gtk_tool_item_get_text_size_group_w, gxg_gtk_tool_item_get_text_size_group)
-XEN_NARGIFY_0(gxg_gtk_tool_palette_new_w, gxg_gtk_tool_palette_new)
-XEN_NARGIFY_3(gxg_gtk_tool_palette_set_group_position_w, gxg_gtk_tool_palette_set_group_position)
-XEN_NARGIFY_3(gxg_gtk_tool_palette_set_exclusive_w, gxg_gtk_tool_palette_set_exclusive)
-XEN_NARGIFY_3(gxg_gtk_tool_palette_set_expand_w, gxg_gtk_tool_palette_set_expand)
-XEN_NARGIFY_2(gxg_gtk_tool_palette_get_group_position_w, gxg_gtk_tool_palette_get_group_position)
-XEN_NARGIFY_2(gxg_gtk_tool_palette_get_exclusive_w, gxg_gtk_tool_palette_get_exclusive)
-XEN_NARGIFY_2(gxg_gtk_tool_palette_get_expand_w, gxg_gtk_tool_palette_get_expand)
-XEN_NARGIFY_2(gxg_gtk_tool_palette_set_icon_size_w, gxg_gtk_tool_palette_set_icon_size)
-XEN_NARGIFY_1(gxg_gtk_tool_palette_unset_icon_size_w, gxg_gtk_tool_palette_unset_icon_size)
-XEN_NARGIFY_2(gxg_gtk_tool_palette_set_style_w, gxg_gtk_tool_palette_set_style)
-XEN_NARGIFY_1(gxg_gtk_tool_palette_unset_style_w, gxg_gtk_tool_palette_unset_style)
-XEN_NARGIFY_1(gxg_gtk_tool_palette_get_icon_size_w, gxg_gtk_tool_palette_get_icon_size)
-XEN_NARGIFY_1(gxg_gtk_tool_palette_get_style_w, gxg_gtk_tool_palette_get_style)
-XEN_NARGIFY_3(gxg_gtk_tool_palette_get_drop_item_w, gxg_gtk_tool_palette_get_drop_item)
-XEN_NARGIFY_3(gxg_gtk_tool_palette_get_drop_group_w, gxg_gtk_tool_palette_get_drop_group)
-XEN_NARGIFY_2(gxg_gtk_tool_palette_get_drag_item_w, gxg_gtk_tool_palette_get_drag_item)
-XEN_NARGIFY_2(gxg_gtk_tool_palette_set_drag_source_w, gxg_gtk_tool_palette_set_drag_source)
-XEN_NARGIFY_5(gxg_gtk_tool_palette_add_drag_dest_w, gxg_gtk_tool_palette_add_drag_dest)
-XEN_NARGIFY_0(gxg_gtk_tool_palette_get_drag_target_item_w, gxg_gtk_tool_palette_get_drag_target_item)
-XEN_NARGIFY_0(gxg_gtk_tool_palette_get_drag_target_group_w, gxg_gtk_tool_palette_get_drag_target_group)
-XEN_NARGIFY_1(gxg_gtk_tool_item_group_new_w, gxg_gtk_tool_item_group_new)
-XEN_NARGIFY_2(gxg_gtk_tool_item_group_set_label_w, gxg_gtk_tool_item_group_set_label)
-XEN_NARGIFY_2(gxg_gtk_tool_item_group_set_label_widget_w, gxg_gtk_tool_item_group_set_label_widget)
-XEN_NARGIFY_2(gxg_gtk_tool_item_group_set_collapsed_w, gxg_gtk_tool_item_group_set_collapsed)
-XEN_NARGIFY_2(gxg_gtk_tool_item_group_set_ellipsize_w, gxg_gtk_tool_item_group_set_ellipsize)
-XEN_NARGIFY_2(gxg_gtk_tool_item_group_set_header_relief_w, gxg_gtk_tool_item_group_set_header_relief)
-XEN_NARGIFY_1(gxg_gtk_tool_item_group_get_label_w, gxg_gtk_tool_item_group_get_label)
-XEN_NARGIFY_1(gxg_gtk_tool_item_group_get_label_widget_w, gxg_gtk_tool_item_group_get_label_widget)
-XEN_NARGIFY_1(gxg_gtk_tool_item_group_get_collapsed_w, gxg_gtk_tool_item_group_get_collapsed)
-XEN_NARGIFY_1(gxg_gtk_tool_item_group_get_ellipsize_w, gxg_gtk_tool_item_group_get_ellipsize)
-XEN_NARGIFY_1(gxg_gtk_tool_item_group_get_header_relief_w, gxg_gtk_tool_item_group_get_header_relief)
-XEN_NARGIFY_3(gxg_gtk_tool_item_group_insert_w, gxg_gtk_tool_item_group_insert)
-XEN_NARGIFY_3(gxg_gtk_tool_item_group_set_item_position_w, gxg_gtk_tool_item_group_set_item_position)
-XEN_NARGIFY_2(gxg_gtk_tool_item_group_get_item_position_w, gxg_gtk_tool_item_group_get_item_position)
-XEN_NARGIFY_1(gxg_gtk_tool_item_group_get_n_items_w, gxg_gtk_tool_item_group_get_n_items)
-XEN_NARGIFY_2(gxg_gtk_tool_item_group_get_nth_item_w, gxg_gtk_tool_item_group_get_nth_item)
-XEN_NARGIFY_3(gxg_gtk_tool_item_group_get_drop_item_w, gxg_gtk_tool_item_group_get_drop_item)
-XEN_NARGIFY_1(gxg_gdk_screen_get_primary_monitor_w, gxg_gdk_screen_get_primary_monitor)
-XEN_NARGIFY_2(gxg_gtk_window_set_mnemonics_visible_w, gxg_gtk_window_set_mnemonics_visible)
-XEN_NARGIFY_1(gxg_gtk_window_get_mnemonics_visible_w, gxg_gtk_window_get_mnemonics_visible)
-XEN_NARGIFY_2(gxg_gtk_range_set_slider_size_fixed_w, gxg_gtk_range_set_slider_size_fixed)
-XEN_NARGIFY_1(gxg_gtk_range_get_slider_size_fixed_w, gxg_gtk_range_get_slider_size_fixed)
-XEN_NARGIFY_2(gxg_gtk_range_set_min_slider_size_w, gxg_gtk_range_set_min_slider_size)
-XEN_NARGIFY_1(gxg_gtk_range_get_min_slider_size_w, gxg_gtk_range_get_min_slider_size)
-XEN_NARGIFY_2(gxg_gtk_range_get_range_rect_w, gxg_gtk_range_get_range_rect)
-XEN_ARGIFY_3(gxg_gtk_range_get_slider_range_w, gxg_gtk_range_get_slider_range)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_name_w, gxg_gtk_status_icon_set_name)
-XEN_NARGIFY_1(gxg_gtk_paned_get_handle_window_w, gxg_gtk_paned_get_handle_window)
-XEN_NARGIFY_2(gxg_gtk_widget_set_realized_w, gxg_gtk_widget_set_realized)
-XEN_NARGIFY_1(gxg_gtk_widget_get_realized_w, gxg_gtk_widget_get_realized)
-XEN_NARGIFY_2(gxg_gtk_widget_set_mapped_w, gxg_gtk_widget_set_mapped)
-XEN_NARGIFY_1(gxg_gtk_widget_get_mapped_w, gxg_gtk_widget_get_mapped)
+#if GTK_CHECK_VERSION(3, 4, 0)
+Xen_wrap_2_args(gxg_gdk_keymap_get_modifier_mask_w, gxg_gdk_keymap_get_modifier_mask)
+Xen_wrap_7_args(gxg_gdk_window_begin_resize_drag_for_device_w, gxg_gdk_window_begin_resize_drag_for_device)
+Xen_wrap_6_args(gxg_gdk_window_begin_move_drag_for_device_w, gxg_gdk_window_begin_move_drag_for_device)
+Xen_wrap_4_args(gxg_gtk_accelerator_parse_with_keycode_w, gxg_gtk_accelerator_parse_with_keycode)
+Xen_wrap_4_args(gxg_gtk_accelerator_name_with_keycode_w, gxg_gtk_accelerator_name_with_keycode)
+Xen_wrap_4_args(gxg_gtk_accelerator_get_label_with_keycode_w, gxg_gtk_accelerator_get_label_with_keycode)
+Xen_wrap_3_args(gxg_gdk_screen_get_monitor_workarea_w, gxg_gdk_screen_get_monitor_workarea)
+Xen_wrap_1_arg(gxg_gtk_application_get_app_menu_w, gxg_gtk_application_get_app_menu)
+Xen_wrap_2_args(gxg_gtk_application_set_app_menu_w, gxg_gtk_application_set_app_menu)
+Xen_wrap_1_arg(gxg_gtk_application_get_menubar_w, gxg_gtk_application_get_menubar)
+Xen_wrap_2_args(gxg_gtk_application_set_menubar_w, gxg_gtk_application_set_menubar)
+Xen_wrap_2_args(gxg_gtk_entry_completion_compute_prefix_w, gxg_gtk_entry_completion_compute_prefix)
+Xen_wrap_2_args(gxg_gtk_scale_set_has_origin_w, gxg_gtk_scale_set_has_origin)
+Xen_wrap_1_arg(gxg_gtk_scale_get_has_origin_w, gxg_gtk_scale_get_has_origin)
+Xen_wrap_2_args(gxg_gtk_window_set_hide_titlebar_when_maximized_w, gxg_gtk_window_set_hide_titlebar_when_maximized)
+Xen_wrap_1_arg(gxg_gtk_window_get_hide_titlebar_when_maximized_w, gxg_gtk_window_get_hide_titlebar_when_maximized)
+Xen_wrap_1_arg(gxg_gtk_application_window_new_w, gxg_gtk_application_window_new)
+Xen_wrap_2_args(gxg_gtk_application_window_set_show_menubar_w, gxg_gtk_application_window_set_show_menubar)
+Xen_wrap_1_arg(gxg_gtk_application_window_get_show_menubar_w, gxg_gtk_application_window_get_show_menubar)
+Xen_wrap_1_arg(gxg_gtk_image_new_from_resource_w, gxg_gtk_image_new_from_resource)
+Xen_wrap_2_args(gxg_gtk_image_set_from_resource_w, gxg_gtk_image_set_from_resource)
+Xen_wrap_2_args(gxg_gtk_window_set_attached_to_w, gxg_gtk_window_set_attached_to)
+Xen_wrap_1_arg(gxg_gtk_window_get_attached_to_w, gxg_gtk_window_get_attached_to)
+Xen_wrap_3_args(gxg_gtk_about_dialog_add_credit_section_w, gxg_gtk_about_dialog_add_credit_section)
+Xen_wrap_1_arg(gxg_gdk_keymap_get_modifier_state_w, gxg_gdk_keymap_get_modifier_state)
+Xen_wrap_6_optional_args(gxg_gtk_hsv_to_rgb_w, gxg_gtk_hsv_to_rgb)
+Xen_wrap_6_optional_args(gxg_gtk_rgb_to_hsv_w, gxg_gtk_rgb_to_hsv)
+Xen_wrap_2_args(gxg_gtk_color_chooser_get_rgba_w, gxg_gtk_color_chooser_get_rgba)
+Xen_wrap_2_args(gxg_gtk_color_chooser_set_rgba_w, gxg_gtk_color_chooser_set_rgba)
+Xen_wrap_1_arg(gxg_gtk_color_chooser_get_use_alpha_w, gxg_gtk_color_chooser_get_use_alpha)
+Xen_wrap_2_args(gxg_gtk_color_chooser_set_use_alpha_w, gxg_gtk_color_chooser_set_use_alpha)
+Xen_wrap_2_args(gxg_gtk_color_chooser_dialog_new_w, gxg_gtk_color_chooser_dialog_new)
+Xen_wrap_no_args(gxg_gtk_color_chooser_widget_new_w, gxg_gtk_color_chooser_widget_new)
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-XEN_NARGIFY_1(gxg_gdk_cairo_create_w, gxg_gdk_cairo_create)
-XEN_ARGIFY_5(gxg_gdk_window_get_geometry_w, gxg_gdk_window_get_geometry)
-XEN_NARGIFY_2(gxg_gdk_keymap_add_virtual_modifiers_w, gxg_gdk_keymap_add_virtual_modifiers)
-XEN_ARGIFY_5(gxg_gdk_window_coords_to_parent_w, gxg_gdk_window_coords_to_parent)
-XEN_ARGIFY_5(gxg_gdk_window_coords_from_parent_w, gxg_gdk_window_coords_from_parent)
-XEN_NARGIFY_1(gxg_gdk_window_get_effective_parent_w, gxg_gdk_window_get_effective_parent)
-XEN_NARGIFY_1(gxg_gdk_window_get_effective_toplevel_w, gxg_gdk_window_get_effective_toplevel)
-XEN_NARGIFY_1(gxg_gtk_accessible_get_widget_w, gxg_gtk_accessible_get_widget)
-XEN_NARGIFY_2(gxg_gtk_widget_send_focus_change_w, gxg_gtk_widget_send_focus_change)
-XEN_NARGIFY_1(gxg_gdk_display_get_device_manager_w, gxg_gdk_display_get_device_manager)
-XEN_NARGIFY_2(gxg_gdk_drag_context_set_device_w, gxg_gdk_drag_context_set_device)
-XEN_NARGIFY_1(gxg_gdk_drag_context_get_device_w, gxg_gdk_drag_context_get_device)
-XEN_NARGIFY_1(gxg_gdk_drag_context_list_targets_w, gxg_gdk_drag_context_list_targets)
-XEN_NARGIFY_2(gxg_gdk_event_set_device_w, gxg_gdk_event_set_device)
-XEN_NARGIFY_1(gxg_gdk_event_get_device_w, gxg_gdk_event_get_device)
-XEN_ARGIFY_3(gxg_gdk_events_get_distance_w, gxg_gdk_events_get_distance)
-XEN_ARGIFY_3(gxg_gdk_events_get_angle_w, gxg_gdk_events_get_angle)
-XEN_ARGIFY_4(gxg_gdk_events_get_center_w, gxg_gdk_events_get_center)
-XEN_NARGIFY_1(gxg_gdk_window_get_accept_focus_w, gxg_gdk_window_get_accept_focus)
-XEN_NARGIFY_1(gxg_gdk_window_get_focus_on_map_w, gxg_gdk_window_get_focus_on_map)
-XEN_NARGIFY_1(gxg_gdk_window_get_composited_w, gxg_gdk_window_get_composited)
-XEN_NARGIFY_1(gxg_gdk_window_is_input_only_w, gxg_gdk_window_is_input_only)
-XEN_NARGIFY_1(gxg_gdk_window_is_shaped_w, gxg_gdk_window_is_shaped)
-XEN_NARGIFY_1(gxg_gdk_window_get_modal_hint_w, gxg_gdk_window_get_modal_hint)
-XEN_NARGIFY_3(gxg_gdk_window_set_device_cursor_w, gxg_gdk_window_set_device_cursor)
-XEN_NARGIFY_2(gxg_gdk_window_get_device_cursor_w, gxg_gdk_window_get_device_cursor)
-XEN_ARGIFY_5(gxg_gdk_window_get_device_position_w, gxg_gdk_window_get_device_position)
-XEN_NARGIFY_3(gxg_gdk_window_set_device_events_w, gxg_gdk_window_set_device_events)
-XEN_NARGIFY_2(gxg_gdk_window_get_device_events_w, gxg_gdk_window_get_device_events)
-XEN_NARGIFY_2(gxg_gtk_combo_box_popup_for_device_w, gxg_gtk_combo_box_popup_for_device)
-XEN_NARGIFY_3(gxg_gtk_device_grab_add_w, gxg_gtk_device_grab_add)
-XEN_NARGIFY_2(gxg_gtk_device_grab_remove_w, gxg_gtk_device_grab_remove)
-XEN_NARGIFY_0(gxg_gtk_get_current_event_device_w, gxg_gtk_get_current_event_device)
-XEN_NARGIFY_1(gxg_gtk_paned_new_w, gxg_gtk_paned_new)
-XEN_NARGIFY_2(gxg_gtk_radio_action_join_group_w, gxg_gtk_radio_action_join_group)
-XEN_NARGIFY_2(gxg_gtk_scale_new_w, gxg_gtk_scale_new)
-XEN_NARGIFY_4(gxg_gtk_scale_new_with_range_w, gxg_gtk_scale_new_with_range)
-XEN_NARGIFY_2(gxg_gtk_scrollbar_new_w, gxg_gtk_scrollbar_new)
-XEN_NARGIFY_1(gxg_gtk_separator_new_w, gxg_gtk_separator_new)
-XEN_NARGIFY_2(gxg_gtk_widget_device_is_shadowed_w, gxg_gtk_widget_device_is_shadowed)
-XEN_NARGIFY_3(gxg_gtk_widget_set_device_events_w, gxg_gtk_widget_set_device_events)
-XEN_NARGIFY_3(gxg_gtk_widget_add_device_events_w, gxg_gtk_widget_add_device_events)
-XEN_NARGIFY_1(gxg_gtk_widget_get_support_multidevice_w, gxg_gtk_widget_get_support_multidevice)
-XEN_NARGIFY_2(gxg_gtk_widget_set_support_multidevice_w, gxg_gtk_widget_set_support_multidevice)
-XEN_NARGIFY_2(gxg_gtk_widget_get_device_events_w, gxg_gtk_widget_get_device_events)
-XEN_NARGIFY_2(gxg_gtk_icon_view_get_item_row_w, gxg_gtk_icon_view_get_item_row)
-XEN_NARGIFY_2(gxg_gtk_icon_view_get_item_column_w, gxg_gtk_icon_view_get_item_column)
-XEN_NARGIFY_2(gxg_gtk_statusbar_remove_all_w, gxg_gtk_statusbar_remove_all)
-XEN_NARGIFY_1(gxg_gtk_window_has_group_w, gxg_gtk_window_has_group)
-XEN_NARGIFY_3(gxg_gtk_calendar_select_month_w, gxg_gtk_calendar_select_month)
-XEN_NARGIFY_2(gxg_gtk_calendar_mark_day_w, gxg_gtk_calendar_mark_day)
-XEN_NARGIFY_2(gxg_gtk_calendar_unmark_day_w, gxg_gtk_calendar_unmark_day)
-XEN_NARGIFY_1(gxg_gdk_drag_context_get_source_window_w, gxg_gdk_drag_context_get_source_window)
-XEN_NARGIFY_1(gxg_gtk_viewport_get_view_window_w, gxg_gtk_viewport_get_view_window)
-XEN_NARGIFY_2(gxg_gtk_accessible_set_widget_w, gxg_gtk_accessible_set_widget)
-XEN_NARGIFY_1(gxg_gtk_button_get_event_window_w, gxg_gtk_button_get_event_window)
-XEN_NARGIFY_1(gxg_gtk_font_selection_dialog_get_font_selection_w, gxg_gtk_font_selection_dialog_get_font_selection)
-XEN_NARGIFY_1(gxg_gtk_message_dialog_get_message_area_w, gxg_gtk_message_dialog_get_message_area)
-XEN_ARGIFY_3(gxg_gtk_table_get_size_w, gxg_gtk_table_get_size)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_length_w, gxg_gtk_selection_data_get_length)
-XEN_NARGIFY_5(gxg_gdk_pango_layout_line_get_clip_region_w, gxg_gdk_pango_layout_line_get_clip_region)
-XEN_NARGIFY_5(gxg_gdk_pango_layout_get_clip_region_w, gxg_gdk_pango_layout_get_clip_region)
-XEN_NARGIFY_4(gxg_gdk_window_shape_combine_region_w, gxg_gdk_window_shape_combine_region)
-XEN_NARGIFY_3(gxg_gdk_window_invalidate_region_w, gxg_gdk_window_invalidate_region)
-XEN_NARGIFY_1(gxg_gdk_window_get_update_area_w, gxg_gdk_window_get_update_area)
-XEN_NARGIFY_2(gxg_gdk_window_begin_paint_region_w, gxg_gdk_window_begin_paint_region)
-XEN_NARGIFY_2(gxg_gtk_widget_region_intersect_w, gxg_gtk_widget_region_intersect)
-XEN_NARGIFY_4(gxg_gdk_window_move_region_w, gxg_gdk_window_move_region)
-XEN_NARGIFY_1(gxg_gdk_keymap_get_num_lock_state_w, gxg_gdk_keymap_get_num_lock_state)
-XEN_NARGIFY_1(gxg_gdk_window_has_native_w, gxg_gdk_window_has_native)
-XEN_NARGIFY_1(gxg_gdk_cursor_get_cursor_type_w, gxg_gdk_cursor_get_cursor_type)
-XEN_NARGIFY_1(gxg_gdk_display_is_closed_w, gxg_gdk_display_is_closed)
-XEN_NARGIFY_1(gxg_gdk_window_get_background_pattern_w, gxg_gdk_window_get_background_pattern)
-XEN_NARGIFY_4(gxg_gdk_window_create_similar_surface_w, gxg_gdk_window_create_similar_surface)
-XEN_NARGIFY_2(gxg_gtk_expander_set_label_fill_w, gxg_gtk_expander_set_label_fill)
-XEN_NARGIFY_1(gxg_gtk_expander_get_label_fill_w, gxg_gtk_expander_get_label_fill)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_tab_hborder_w, gxg_gtk_notebook_get_tab_hborder)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_tab_vborder_w, gxg_gtk_notebook_get_tab_vborder)
-XEN_NARGIFY_2(gxg_gtk_calendar_get_day_is_marked_w, gxg_gtk_calendar_get_day_is_marked)
-XEN_NARGIFY_2(gxg_gtk_progress_bar_set_inverted_w, gxg_gtk_progress_bar_set_inverted)
-XEN_NARGIFY_1(gxg_gtk_progress_bar_get_inverted_w, gxg_gtk_progress_bar_get_inverted)
-XEN_NARGIFY_2(gxg_gtk_radio_button_join_group_w, gxg_gtk_radio_button_join_group)
-XEN_NARGIFY_6(gxg_gtk_adjustment_new_w, gxg_gtk_adjustment_new)
-XEN_NARGIFY_4(gxg_gtk_binding_set_activate_w, gxg_gtk_binding_set_activate)
-XEN_NARGIFY_3(gxg_gtk_bindings_activate_w, gxg_gtk_bindings_activate)
-XEN_NARGIFY_2(gxg_gtk_icon_view_create_drag_icon_w, gxg_gtk_icon_view_create_drag_icon)
-XEN_NARGIFY_2(gxg_gtk_tree_view_create_row_drag_icon_w, gxg_gtk_tree_view_create_row_drag_icon)
-XEN_NARGIFY_2(gxg_gdk_cairo_get_clip_rectangle_w, gxg_gdk_cairo_get_clip_rectangle)
-XEN_NARGIFY_1(gxg_gdk_cairo_region_create_from_surface_w, gxg_gdk_cairo_region_create_from_surface)
-XEN_NARGIFY_1(gxg_gdk_window_get_visual_w, gxg_gdk_window_get_visual)
-XEN_NARGIFY_1(gxg_gdk_window_get_screen_w, gxg_gdk_window_get_screen)
-XEN_NARGIFY_1(gxg_gdk_window_get_display_w, gxg_gdk_window_get_display)
-XEN_NARGIFY_1(gxg_gdk_window_get_width_w, gxg_gdk_window_get_width)
-XEN_NARGIFY_1(gxg_gdk_window_get_height_w, gxg_gdk_window_get_height)
-XEN_NARGIFY_1(gxg_gtk_cell_renderer_get_request_mode_w, gxg_gtk_cell_renderer_get_request_mode)
-XEN_ARGIFY_4(gxg_gtk_cell_renderer_get_preferred_width_w, gxg_gtk_cell_renderer_get_preferred_width)
-XEN_ARGIFY_5(gxg_gtk_cell_renderer_get_preferred_height_for_width_w, gxg_gtk_cell_renderer_get_preferred_height_for_width)
-XEN_ARGIFY_4(gxg_gtk_cell_renderer_get_preferred_height_w, gxg_gtk_cell_renderer_get_preferred_height)
-XEN_ARGIFY_5(gxg_gtk_cell_renderer_get_preferred_width_for_height_w, gxg_gtk_cell_renderer_get_preferred_width_for_height)
-XEN_NARGIFY_1(gxg_gtk_container_class_handle_border_width_w, gxg_gtk_container_class_handle_border_width)
-XEN_NARGIFY_2(gxg_gtk_drag_set_icon_surface_w, gxg_gtk_drag_set_icon_surface)
-XEN_NARGIFY_2(gxg_gtk_notebook_set_group_name_w, gxg_gtk_notebook_set_group_name)
-XEN_NARGIFY_1(gxg_gtk_notebook_get_group_name_w, gxg_gtk_notebook_get_group_name)
-XEN_NARGIFY_2(gxg_gtk_widget_draw_w, gxg_gtk_widget_draw)
-XEN_NARGIFY_1(gxg_gtk_widget_get_request_mode_w, gxg_gtk_widget_get_request_mode)
-XEN_ARGIFY_3(gxg_gtk_widget_get_preferred_width_w, gxg_gtk_widget_get_preferred_width)
-XEN_ARGIFY_4(gxg_gtk_widget_get_preferred_height_for_width_w, gxg_gtk_widget_get_preferred_height_for_width)
-XEN_ARGIFY_3(gxg_gtk_widget_get_preferred_height_w, gxg_gtk_widget_get_preferred_height)
-XEN_ARGIFY_4(gxg_gtk_widget_get_preferred_width_for_height_w, gxg_gtk_widget_get_preferred_width_for_height)
-XEN_NARGIFY_1(gxg_gtk_widget_get_allocated_width_w, gxg_gtk_widget_get_allocated_width)
-XEN_NARGIFY_1(gxg_gtk_widget_get_allocated_height_w, gxg_gtk_widget_get_allocated_height)
-XEN_NARGIFY_2(gxg_gtk_widget_set_visual_w, gxg_gtk_widget_set_visual)
-XEN_NARGIFY_1(gxg_gtk_widget_get_halign_w, gxg_gtk_widget_get_halign)
-XEN_NARGIFY_2(gxg_gtk_widget_set_halign_w, gxg_gtk_widget_set_halign)
-XEN_NARGIFY_1(gxg_gtk_widget_get_valign_w, gxg_gtk_widget_get_valign)
-XEN_NARGIFY_2(gxg_gtk_widget_set_valign_w, gxg_gtk_widget_set_valign)
-XEN_NARGIFY_1(gxg_gtk_widget_get_margin_left_w, gxg_gtk_widget_get_margin_left)
-XEN_NARGIFY_2(gxg_gtk_widget_set_margin_left_w, gxg_gtk_widget_set_margin_left)
-XEN_NARGIFY_1(gxg_gtk_widget_get_margin_right_w, gxg_gtk_widget_get_margin_right)
-XEN_NARGIFY_2(gxg_gtk_widget_set_margin_right_w, gxg_gtk_widget_set_margin_right)
-XEN_NARGIFY_1(gxg_gtk_widget_get_margin_top_w, gxg_gtk_widget_get_margin_top)
-XEN_NARGIFY_2(gxg_gtk_widget_set_margin_top_w, gxg_gtk_widget_set_margin_top)
-XEN_NARGIFY_1(gxg_gtk_widget_get_margin_bottom_w, gxg_gtk_widget_get_margin_bottom)
-XEN_NARGIFY_2(gxg_gtk_widget_set_margin_bottom_w, gxg_gtk_widget_set_margin_bottom)
-XEN_NARGIFY_2(gxg_gtk_widget_shape_combine_region_w, gxg_gtk_widget_shape_combine_region)
-XEN_NARGIFY_2(gxg_gtk_widget_input_shape_combine_region_w, gxg_gtk_widget_input_shape_combine_region)
-XEN_NARGIFY_2(gxg_gtk_cairo_should_draw_window_w, gxg_gtk_cairo_should_draw_window)
-XEN_NARGIFY_3(gxg_gtk_cairo_transform_to_window_w, gxg_gtk_cairo_transform_to_window)
-XEN_NARGIFY_0(gxg_gtk_combo_box_new_with_entry_w, gxg_gtk_combo_box_new_with_entry)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_has_entry_w, gxg_gtk_combo_box_get_has_entry)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_entry_text_column_w, gxg_gtk_combo_box_set_entry_text_column)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_entry_text_column_w, gxg_gtk_combo_box_get_entry_text_column)
-XEN_NARGIFY_3(gxg_gtk_target_entry_new_w, gxg_gtk_target_entry_new)
-XEN_NARGIFY_1(gxg_gtk_target_entry_copy_w, gxg_gtk_target_entry_copy)
-XEN_NARGIFY_1(gxg_gtk_target_entry_free_w, gxg_gtk_target_entry_free)
-XEN_NARGIFY_1(gxg_gtk_widget_get_hexpand_w, gxg_gtk_widget_get_hexpand)
-XEN_NARGIFY_2(gxg_gtk_widget_set_hexpand_w, gxg_gtk_widget_set_hexpand)
-XEN_NARGIFY_1(gxg_gtk_widget_get_hexpand_set_w, gxg_gtk_widget_get_hexpand_set)
-XEN_NARGIFY_2(gxg_gtk_widget_set_hexpand_set_w, gxg_gtk_widget_set_hexpand_set)
-XEN_NARGIFY_1(gxg_gtk_widget_get_vexpand_w, gxg_gtk_widget_get_vexpand)
-XEN_NARGIFY_2(gxg_gtk_widget_set_vexpand_w, gxg_gtk_widget_set_vexpand)
-XEN_NARGIFY_1(gxg_gtk_widget_get_vexpand_set_w, gxg_gtk_widget_get_vexpand_set)
-XEN_NARGIFY_2(gxg_gtk_widget_set_vexpand_set_w, gxg_gtk_widget_set_vexpand_set)
-XEN_NARGIFY_1(gxg_gtk_widget_queue_compute_expand_w, gxg_gtk_widget_queue_compute_expand)
-XEN_NARGIFY_2(gxg_gtk_widget_compute_expand_w, gxg_gtk_widget_compute_expand)
-XEN_NARGIFY_3(gxg_gtk_window_set_default_geometry_w, gxg_gtk_window_set_default_geometry)
-XEN_NARGIFY_3(gxg_gtk_window_resize_to_geometry_w, gxg_gtk_window_resize_to_geometry)
-XEN_NARGIFY_2(gxg_gtk_window_set_has_resize_grip_w, gxg_gtk_window_set_has_resize_grip)
-XEN_NARGIFY_1(gxg_gtk_window_get_has_resize_grip_w, gxg_gtk_window_get_has_resize_grip)
-XEN_NARGIFY_1(gxg_gtk_window_resize_grip_is_visible_w, gxg_gtk_window_resize_grip_is_visible)
-XEN_NARGIFY_2(gxg_gtk_window_get_resize_grip_area_w, gxg_gtk_window_get_resize_grip_area)
-XEN_NARGIFY_0(gxg_gtk_combo_box_text_new_w, gxg_gtk_combo_box_text_new)
-XEN_NARGIFY_0(gxg_gtk_combo_box_text_new_with_entry_w, gxg_gtk_combo_box_text_new_with_entry)
-XEN_NARGIFY_2(gxg_gtk_combo_box_text_append_text_w, gxg_gtk_combo_box_text_append_text)
-XEN_NARGIFY_3(gxg_gtk_combo_box_text_insert_text_w, gxg_gtk_combo_box_text_insert_text)
-XEN_NARGIFY_2(gxg_gtk_combo_box_text_prepend_text_w, gxg_gtk_combo_box_text_prepend_text)
-XEN_NARGIFY_2(gxg_gtk_combo_box_text_remove_w, gxg_gtk_combo_box_text_remove)
-XEN_NARGIFY_1(gxg_gtk_combo_box_text_get_active_text_w, gxg_gtk_combo_box_text_get_active_text)
-XEN_NARGIFY_2(gxg_gdk_cairo_set_source_rgba_w, gxg_gdk_cairo_set_source_rgba)
-XEN_NARGIFY_2(gxg_gdk_window_set_background_rgba_w, gxg_gdk_window_set_background_rgba)
-XEN_NARGIFY_2(gxg_gtk_cell_view_set_background_rgba_w, gxg_gtk_cell_view_set_background_rgba)
-XEN_NARGIFY_1(gxg_gtk_color_button_new_with_rgba_w, gxg_gtk_color_button_new_with_rgba)
-XEN_NARGIFY_2(gxg_gtk_color_button_set_rgba_w, gxg_gtk_color_button_set_rgba)
-XEN_NARGIFY_2(gxg_gtk_color_selection_set_current_rgba_w, gxg_gtk_color_selection_set_current_rgba)
-XEN_NARGIFY_2(gxg_gtk_color_selection_set_previous_rgba_w, gxg_gtk_color_selection_set_previous_rgba)
-XEN_NARGIFY_1(gxg_gtk_combo_box_text_remove_all_w, gxg_gtk_combo_box_text_remove_all)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_popup_fixed_width_w, gxg_gtk_combo_box_set_popup_fixed_width)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_popup_fixed_width_w, gxg_gtk_combo_box_get_popup_fixed_width)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_get_min_content_width_w, gxg_gtk_scrolled_window_get_min_content_width)
-XEN_NARGIFY_2(gxg_gtk_scrolled_window_set_min_content_width_w, gxg_gtk_scrolled_window_set_min_content_width)
-XEN_NARGIFY_1(gxg_gtk_scrolled_window_get_min_content_height_w, gxg_gtk_scrolled_window_get_min_content_height)
-XEN_NARGIFY_2(gxg_gtk_scrolled_window_set_min_content_height_w, gxg_gtk_scrolled_window_set_min_content_height)
-XEN_NARGIFY_0(gxg_gtk_grid_new_w, gxg_gtk_grid_new)
-XEN_NARGIFY_6(gxg_gtk_grid_attach_w, gxg_gtk_grid_attach)
-XEN_NARGIFY_6(gxg_gtk_grid_attach_next_to_w, gxg_gtk_grid_attach_next_to)
-XEN_NARGIFY_2(gxg_gtk_grid_set_row_homogeneous_w, gxg_gtk_grid_set_row_homogeneous)
-XEN_NARGIFY_1(gxg_gtk_grid_get_row_homogeneous_w, gxg_gtk_grid_get_row_homogeneous)
-XEN_NARGIFY_2(gxg_gtk_grid_set_row_spacing_w, gxg_gtk_grid_set_row_spacing)
-XEN_NARGIFY_1(gxg_gtk_grid_get_row_spacing_w, gxg_gtk_grid_get_row_spacing)
-XEN_NARGIFY_2(gxg_gtk_grid_set_column_homogeneous_w, gxg_gtk_grid_set_column_homogeneous)
-XEN_NARGIFY_1(gxg_gtk_grid_get_column_homogeneous_w, gxg_gtk_grid_get_column_homogeneous)
-XEN_NARGIFY_2(gxg_gtk_grid_set_column_spacing_w, gxg_gtk_grid_set_column_spacing)
-XEN_NARGIFY_1(gxg_gtk_grid_get_column_spacing_w, gxg_gtk_grid_get_column_spacing)
-XEN_NARGIFY_1(gxg_gtk_scrollable_get_hadjustment_w, gxg_gtk_scrollable_get_hadjustment)
-XEN_NARGIFY_2(gxg_gtk_scrollable_set_hadjustment_w, gxg_gtk_scrollable_set_hadjustment)
-XEN_NARGIFY_1(gxg_gtk_scrollable_get_vadjustment_w, gxg_gtk_scrollable_get_vadjustment)
-XEN_NARGIFY_2(gxg_gtk_scrollable_set_vadjustment_w, gxg_gtk_scrollable_set_vadjustment)
-XEN_NARGIFY_1(gxg_gtk_assistant_next_page_w, gxg_gtk_assistant_next_page)
-XEN_NARGIFY_1(gxg_gtk_assistant_previous_page_w, gxg_gtk_assistant_previous_page)
-XEN_NARGIFY_1(gxg_gtk_combo_box_new_with_model_and_entry_w, gxg_gtk_combo_box_new_with_model_and_entry)
-XEN_NARGIFY_1(gxg_gtk_scrollable_get_hscroll_policy_w, gxg_gtk_scrollable_get_hscroll_policy)
-XEN_NARGIFY_2(gxg_gtk_scrollable_set_hscroll_policy_w, gxg_gtk_scrollable_set_hscroll_policy)
-XEN_NARGIFY_1(gxg_gtk_scrollable_get_vscroll_policy_w, gxg_gtk_scrollable_get_vscroll_policy)
-XEN_NARGIFY_2(gxg_gtk_scrollable_set_vscroll_policy_w, gxg_gtk_scrollable_set_vscroll_policy)
-XEN_NARGIFY_0(gxg_gtk_switch_new_w, gxg_gtk_switch_new)
-XEN_NARGIFY_2(gxg_gtk_switch_set_active_w, gxg_gtk_switch_set_active)
-XEN_NARGIFY_1(gxg_gtk_switch_get_active_w, gxg_gtk_switch_get_active)
-XEN_NARGIFY_1(gxg_gdk_window_get_clip_region_w, gxg_gdk_window_get_clip_region)
-XEN_NARGIFY_1(gxg_gdk_window_get_visible_region_w, gxg_gdk_window_get_visible_region)
-XEN_NARGIFY_0(gxg_gtk_border_new_w, gxg_gtk_border_new)
-XEN_NARGIFY_1(gxg_gtk_border_copy_w, gxg_gtk_border_copy)
-XEN_NARGIFY_1(gxg_gtk_border_free_w, gxg_gtk_border_free)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_id_column_w, gxg_gtk_combo_box_get_id_column)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_id_column_w, gxg_gtk_combo_box_set_id_column)
-XEN_NARGIFY_1(gxg_gtk_combo_box_get_active_id_w, gxg_gtk_combo_box_get_active_id)
-XEN_NARGIFY_2(gxg_gtk_combo_box_set_active_id_w, gxg_gtk_combo_box_set_active_id)
-XEN_NARGIFY_4(gxg_gtk_combo_box_text_insert_w, gxg_gtk_combo_box_text_insert)
-XEN_NARGIFY_3(gxg_gtk_combo_box_text_append_w, gxg_gtk_combo_box_text_append)
-XEN_NARGIFY_3(gxg_gtk_combo_box_text_prepend_w, gxg_gtk_combo_box_text_prepend)
-XEN_NARGIFY_1(gxg_gtk_button_box_new_w, gxg_gtk_button_box_new)
-XEN_NARGIFY_2(gxg_gtk_box_new_w, gxg_gtk_box_new)
-XEN_NARGIFY_2(gxg_gtk_activatable_sync_action_properties_w, gxg_gtk_activatable_sync_action_properties)
-XEN_NARGIFY_2(gxg_gtk_activatable_set_related_action_w, gxg_gtk_activatable_set_related_action)
-XEN_NARGIFY_1(gxg_gtk_activatable_get_related_action_w, gxg_gtk_activatable_get_related_action)
-XEN_NARGIFY_2(gxg_gtk_activatable_set_use_action_appearance_w, gxg_gtk_activatable_set_use_action_appearance)
-XEN_NARGIFY_1(gxg_gtk_activatable_get_use_action_appearance_w, gxg_gtk_activatable_get_use_action_appearance)
-XEN_NARGIFY_5(gxg_gtk_tree_view_set_cursor_on_cell_w, gxg_gtk_tree_view_set_cursor_on_cell)
-XEN_NARGIFY_2(gxg_gtk_tree_view_set_rubber_banding_w, gxg_gtk_tree_view_set_rubber_banding)
-XEN_NARGIFY_1(gxg_gtk_tree_view_get_rubber_banding_w, gxg_gtk_tree_view_get_rubber_banding)
-XEN_NARGIFY_2(gxg_gtk_tooltip_set_markup_w, gxg_gtk_tooltip_set_markup)
-XEN_NARGIFY_2(gxg_gtk_tooltip_set_icon_w, gxg_gtk_tooltip_set_icon)
-XEN_NARGIFY_3(gxg_gtk_tooltip_set_icon_from_stock_w, gxg_gtk_tooltip_set_icon_from_stock)
-XEN_NARGIFY_2(gxg_gtk_tooltip_set_custom_w, gxg_gtk_tooltip_set_custom)
-XEN_NARGIFY_1(gxg_gtk_tooltip_trigger_tooltip_query_w, gxg_gtk_tooltip_trigger_tooltip_query)
-XEN_NARGIFY_2(gxg_gtk_button_set_image_position_w, gxg_gtk_button_set_image_position)
-XEN_NARGIFY_1(gxg_gtk_button_get_image_position_w, gxg_gtk_button_get_image_position)
-XEN_ARGIFY_4(gxg_gtk_show_uri_w, gxg_gtk_show_uri)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_new_with_area_w, gxg_gtk_tree_view_column_new_with_area)
-XEN_NARGIFY_1(gxg_gtk_tree_view_column_get_button_w, gxg_gtk_tree_view_column_get_button)
-XEN_NARGIFY_2(gxg_gtk_tree_view_column_focus_cell_w, gxg_gtk_tree_view_column_focus_cell)
-XEN_NARGIFY_1(gxg_gtk_clipboard_wait_is_uris_available_w, gxg_gtk_clipboard_wait_is_uris_available)
-XEN_NARGIFY_3(gxg_gtk_toolbar_set_drop_highlight_item_w, gxg_gtk_toolbar_set_drop_highlight_item)
-XEN_NARGIFY_1(gxg_gtk_tool_item_toolbar_reconfigured_w, gxg_gtk_tool_item_toolbar_reconfigured)
-XEN_NARGIFY_2(gxg_gtk_orientable_set_orientation_w, gxg_gtk_orientable_set_orientation)
-XEN_NARGIFY_1(gxg_gtk_orientable_get_orientation_w, gxg_gtk_orientable_get_orientation)
-XEN_ARGIFY_2(gxg_gtk_parse_args_w, gxg_gtk_parse_args)
-XEN_NARGIFY_0(gxg_gtk_get_major_version_w, gxg_gtk_get_major_version)
-XEN_NARGIFY_0(gxg_gtk_get_minor_version_w, gxg_gtk_get_minor_version)
-XEN_NARGIFY_0(gxg_gtk_get_micro_version_w, gxg_gtk_get_micro_version)
-XEN_NARGIFY_0(gxg_gtk_get_binary_age_w, gxg_gtk_get_binary_age)
-XEN_NARGIFY_0(gxg_gtk_get_interface_age_w, gxg_gtk_get_interface_age)
-XEN_NARGIFY_2(gxg_gtk_image_new_from_gicon_w, gxg_gtk_image_new_from_gicon)
-XEN_NARGIFY_3(gxg_gtk_image_set_from_gicon_w, gxg_gtk_image_set_from_gicon)
-XEN_ARGIFY_3(gxg_gtk_image_get_gicon_w, gxg_gtk_image_get_gicon)
-XEN_NARGIFY_2(gxg_gtk_progress_bar_set_show_text_w, gxg_gtk_progress_bar_set_show_text)
-XEN_NARGIFY_1(gxg_gtk_progress_bar_get_show_text_w, gxg_gtk_progress_bar_get_show_text)
-XEN_NARGIFY_1(gxg_gtk_invisible_new_for_screen_w, gxg_gtk_invisible_new_for_screen)
-XEN_NARGIFY_2(gxg_gtk_invisible_set_screen_w, gxg_gtk_invisible_set_screen)
-XEN_NARGIFY_1(gxg_gtk_invisible_get_screen_w, gxg_gtk_invisible_get_screen)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_storage_type_w, gxg_gtk_entry_get_icon_storage_type)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_pixbuf_w, gxg_gtk_entry_get_icon_pixbuf)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_stock_w, gxg_gtk_entry_get_icon_stock)
-XEN_NARGIFY_2(gxg_gtk_entry_get_icon_gicon_w, gxg_gtk_entry_get_icon_gicon)
-XEN_NARGIFY_3(gxg_gtk_container_propagate_draw_w, gxg_gtk_container_propagate_draw)
-XEN_NARGIFY_2(gxg_gtk_container_set_focus_chain_w, gxg_gtk_container_set_focus_chain)
-XEN_ARGIFY_2(gxg_gtk_container_get_focus_chain_w, gxg_gtk_container_get_focus_chain)
-XEN_NARGIFY_1(gxg_gtk_container_unset_focus_chain_w, gxg_gtk_container_unset_focus_chain)
-XEN_NARGIFY_2(gxg_gtk_container_set_reallocate_redraws_w, gxg_gtk_container_set_reallocate_redraws)
-XEN_NARGIFY_2(gxg_gtk_container_set_focus_child_w, gxg_gtk_container_set_focus_child)
-XEN_NARGIFY_2(gxg_gtk_container_set_focus_vadjustment_w, gxg_gtk_container_set_focus_vadjustment)
-XEN_NARGIFY_1(gxg_gtk_container_get_focus_vadjustment_w, gxg_gtk_container_get_focus_vadjustment)
-XEN_NARGIFY_2(gxg_gtk_container_set_focus_hadjustment_w, gxg_gtk_container_set_focus_hadjustment)
-XEN_NARGIFY_1(gxg_gtk_container_get_focus_hadjustment_w, gxg_gtk_container_get_focus_hadjustment)
-XEN_NARGIFY_1(gxg_gtk_container_resize_children_w, gxg_gtk_container_resize_children)
-XEN_NARGIFY_1(gxg_gtk_assistant_commit_w, gxg_gtk_assistant_commit)
-XEN_NARGIFY_1(gxg_gtk_im_multicontext_get_context_id_w, gxg_gtk_im_multicontext_get_context_id)
-XEN_NARGIFY_2(gxg_gtk_im_multicontext_set_context_id_w, gxg_gtk_im_multicontext_set_context_id)
-XEN_NARGIFY_2(gxg_gtk_about_dialog_set_license_type_w, gxg_gtk_about_dialog_set_license_type)
-XEN_NARGIFY_1(gxg_gtk_about_dialog_get_license_type_w, gxg_gtk_about_dialog_get_license_type)
-XEN_NARGIFY_2(gxg_gtk_window_set_skip_taskbar_hint_w, gxg_gtk_window_set_skip_taskbar_hint)
-XEN_NARGIFY_1(gxg_gtk_window_get_skip_taskbar_hint_w, gxg_gtk_window_get_skip_taskbar_hint)
-XEN_NARGIFY_2(gxg_gtk_window_set_skip_pager_hint_w, gxg_gtk_window_set_skip_pager_hint)
-XEN_NARGIFY_1(gxg_gtk_window_get_skip_pager_hint_w, gxg_gtk_window_get_skip_pager_hint)
-XEN_NARGIFY_2(gxg_gtk_window_set_screen_w, gxg_gtk_window_set_screen)
-XEN_NARGIFY_1(gxg_gtk_window_get_screen_w, gxg_gtk_window_get_screen)
-XEN_ARGIFY_3(gxg_gtk_window_set_icon_from_file_w, gxg_gtk_window_set_icon_from_file)
-XEN_ARGIFY_2(gxg_gtk_window_set_default_icon_from_file_w, gxg_gtk_window_set_default_icon_from_file)
-XEN_NARGIFY_1(gxg_gtk_window_fullscreen_w, gxg_gtk_window_fullscreen)
-XEN_NARGIFY_1(gxg_gtk_window_unfullscreen_w, gxg_gtk_window_unfullscreen)
-XEN_NARGIFY_1(gxg_gtk_window_get_window_type_w, gxg_gtk_window_get_window_type)
-XEN_NARGIFY_2(gxg_gtk_window_group_add_window_w, gxg_gtk_window_group_add_window)
-XEN_NARGIFY_2(gxg_gtk_window_group_remove_window_w, gxg_gtk_window_group_remove_window)
-XEN_NARGIFY_0(gxg_gtk_window_group_new_w, gxg_gtk_window_group_new)
-XEN_NARGIFY_1(gxg_gtk_window_get_group_w, gxg_gtk_window_get_group)
-XEN_NARGIFY_1(gxg_gtk_window_group_list_windows_w, gxg_gtk_window_group_list_windows)
-XEN_NARGIFY_2(gxg_gtk_window_group_get_current_device_grab_w, gxg_gtk_window_group_get_current_device_grab)
-XEN_NARGIFY_1(gxg_gtk_window_group_get_current_grab_w, gxg_gtk_window_group_get_current_grab)
-XEN_NARGIFY_1(gxg_gtk_selection_data_get_data_w, gxg_gtk_selection_data_get_data)
-XEN_NARGIFY_4(gxg_gtk_selection_owner_set_for_display_w, gxg_gtk_selection_owner_set_for_display)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_get_text_orientation_w, gxg_gtk_tool_shell_get_text_orientation)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_get_text_alignment_w, gxg_gtk_tool_shell_get_text_alignment)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_get_ellipsize_mode_w, gxg_gtk_tool_shell_get_ellipsize_mode)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_get_text_size_group_w, gxg_gtk_tool_shell_get_text_size_group)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_get_icon_size_w, gxg_gtk_tool_shell_get_icon_size)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_get_orientation_w, gxg_gtk_tool_shell_get_orientation)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_get_style_w, gxg_gtk_tool_shell_get_style)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_get_relief_style_w, gxg_gtk_tool_shell_get_relief_style)
-XEN_NARGIFY_1(gxg_gtk_tool_shell_rebuild_menu_w, gxg_gtk_tool_shell_rebuild_menu)
-XEN_NARGIFY_1(gxg_gtk_status_icon_new_from_gicon_w, gxg_gtk_status_icon_new_from_gicon)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_from_gicon_w, gxg_gtk_status_icon_set_from_gicon)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_gicon_w, gxg_gtk_status_icon_get_gicon)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_has_tooltip_w, gxg_gtk_status_icon_set_has_tooltip)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_tooltip_text_w, gxg_gtk_status_icon_set_tooltip_text)
-XEN_NARGIFY_2(gxg_gtk_status_icon_set_tooltip_markup_w, gxg_gtk_status_icon_set_tooltip_markup)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_has_tooltip_w, gxg_gtk_status_icon_get_has_tooltip)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_tooltip_text_w, gxg_gtk_status_icon_get_tooltip_text)
-XEN_NARGIFY_1(gxg_gtk_status_icon_get_tooltip_markup_w, gxg_gtk_status_icon_get_tooltip_markup)
-XEN_NARGIFY_1(gxg_gtk_accel_map_lock_path_w, gxg_gtk_accel_map_lock_path)
-XEN_NARGIFY_1(gxg_gtk_accel_map_unlock_path_w, gxg_gtk_accel_map_unlock_path)
-XEN_NARGIFY_4(gxg_gtk_icon_theme_lookup_by_gicon_w, gxg_gtk_icon_theme_lookup_by_gicon)
-XEN_NARGIFY_2(gxg_gtk_icon_info_new_for_pixbuf_w, gxg_gtk_icon_info_new_for_pixbuf)
-XEN_NARGIFY_2(gxg_gtk_icon_view_set_item_orientation_w, gxg_gtk_icon_view_set_item_orientation)
-XEN_NARGIFY_1(gxg_gtk_icon_view_get_item_orientation_w, gxg_gtk_icon_view_get_item_orientation)
-XEN_NARGIFY_2(gxg_gtk_text_view_im_context_filter_keypress_w, gxg_gtk_text_view_im_context_filter_keypress)
-XEN_NARGIFY_1(gxg_gtk_text_view_reset_im_context_w, gxg_gtk_text_view_reset_im_context)
-XEN_NARGIFY_1(gxg_gtk_action_get_accel_path_w, gxg_gtk_action_get_accel_path)
-XEN_NARGIFY_1(gxg_gtk_action_block_activate_w, gxg_gtk_action_block_activate)
-XEN_NARGIFY_1(gxg_gtk_action_unblock_activate_w, gxg_gtk_action_unblock_activate)
-XEN_NARGIFY_2(gxg_gtk_action_set_accel_path_w, gxg_gtk_action_set_accel_path)
-XEN_NARGIFY_2(gxg_gtk_action_set_accel_group_w, gxg_gtk_action_set_accel_group)
-XEN_ARGIFY_4(gxg_gdk_device_get_position_w, gxg_gdk_device_get_position)
-XEN_ARGIFY_3(gxg_gdk_device_get_window_at_position_w, gxg_gdk_device_get_window_at_position)
-XEN_NARGIFY_1(gxg_gtk_cell_view_get_draw_sensitive_w, gxg_gtk_cell_view_get_draw_sensitive)
-XEN_NARGIFY_2(gxg_gtk_cell_view_set_draw_sensitive_w, gxg_gtk_cell_view_set_draw_sensitive)
-XEN_NARGIFY_1(gxg_gtk_cell_view_get_fit_model_w, gxg_gtk_cell_view_get_fit_model)
-XEN_NARGIFY_2(gxg_gtk_cell_view_set_fit_model_w, gxg_gtk_cell_view_set_fit_model)
-XEN_NARGIFY_1(gxg_gtk_combo_box_new_with_area_w, gxg_gtk_combo_box_new_with_area)
-XEN_NARGIFY_1(gxg_gtk_combo_box_new_with_area_and_entry_w, gxg_gtk_combo_box_new_with_area_and_entry)
-XEN_NARGIFY_1(gxg_gtk_icon_view_new_with_area_w, gxg_gtk_icon_view_new_with_area)
-XEN_NARGIFY_2(gxg_gtk_menu_item_set_reserve_indicator_w, gxg_gtk_menu_item_set_reserve_indicator)
-XEN_NARGIFY_1(gxg_gtk_menu_item_get_reserve_indicator_w, gxg_gtk_menu_item_get_reserve_indicator)
-XEN_NARGIFY_1(gxg_gtk_menu_shell_get_selected_item_w, gxg_gtk_menu_shell_get_selected_item)
-XEN_NARGIFY_1(gxg_gtk_menu_shell_get_parent_shell_w, gxg_gtk_menu_shell_get_parent_shell)
-XEN_ARGIFY_2(gxg_gtk_selection_data_get_data_with_length_w, gxg_gtk_selection_data_get_data_with_length)
-XEN_NARGIFY_2(gxg_gtk_tree_model_iter_previous_w, gxg_gtk_tree_model_iter_previous)
-XEN_ARGIFY_7(gxg_gtk_tree_view_is_blank_at_pos_w, gxg_gtk_tree_view_is_blank_at_pos)
-XEN_NARGIFY_3(gxg_gtk_widget_set_device_enabled_w, gxg_gtk_widget_set_device_enabled)
-XEN_NARGIFY_2(gxg_gtk_widget_get_device_enabled_w, gxg_gtk_widget_get_device_enabled)
-XEN_NARGIFY_2(gxg_gtk_window_set_has_user_ref_count_w, gxg_gtk_window_set_has_user_ref_count)
-XEN_NARGIFY_5(gxg_gdk_selection_send_notify_w, gxg_gdk_selection_send_notify)
-XEN_NARGIFY_6(gxg_gdk_selection_send_notify_for_display_w, gxg_gdk_selection_send_notify_for_display)
-XEN_NARGIFY_1(gxg_gdk_rgba_copy_w, gxg_gdk_rgba_copy)
-XEN_NARGIFY_1(gxg_gdk_rgba_free_w, gxg_gdk_rgba_free)
-XEN_NARGIFY_2(gxg_gdk_rgba_parse_w, gxg_gdk_rgba_parse)
-XEN_NARGIFY_1(gxg_gdk_rgba_to_string_w, gxg_gdk_rgba_to_string)
+#if GTK_CHECK_VERSION(3, 6, 0)
+Xen_wrap_3_optional_args(gxg_gdk_event_get_scroll_deltas_w, gxg_gdk_event_get_scroll_deltas)
+Xen_wrap_5_args(gxg_gtk_color_chooser_add_palette_w, gxg_gtk_color_chooser_add_palette)
+Xen_wrap_2_args(gxg_gtk_button_set_always_show_image_w, gxg_gtk_button_set_always_show_image)
+Xen_wrap_1_arg(gxg_gtk_button_get_always_show_image_w, gxg_gtk_button_get_always_show_image)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_n_columns_w, gxg_gtk_tree_view_get_n_columns)
+Xen_wrap_no_args(gxg_gtk_menu_button_new_w, gxg_gtk_menu_button_new)
+Xen_wrap_2_args(gxg_gtk_menu_button_set_menu_model_w, gxg_gtk_menu_button_set_menu_model)
+Xen_wrap_1_arg(gxg_gtk_menu_button_get_menu_model_w, gxg_gtk_menu_button_get_menu_model)
+Xen_wrap_2_args(gxg_gtk_menu_button_set_align_widget_w, gxg_gtk_menu_button_set_align_widget)
+Xen_wrap_1_arg(gxg_gtk_menu_button_get_align_widget_w, gxg_gtk_menu_button_get_align_widget)
+Xen_wrap_no_args(gxg_gtk_search_entry_new_w, gxg_gtk_search_entry_new)
+Xen_wrap_no_args(gxg_gtk_level_bar_new_w, gxg_gtk_level_bar_new)
+Xen_wrap_2_args(gxg_gtk_level_bar_new_for_interval_w, gxg_gtk_level_bar_new_for_interval)
+Xen_wrap_2_args(gxg_gtk_level_bar_set_mode_w, gxg_gtk_level_bar_set_mode)
+Xen_wrap_1_arg(gxg_gtk_level_bar_get_mode_w, gxg_gtk_level_bar_get_mode)
+Xen_wrap_2_args(gxg_gtk_level_bar_set_value_w, gxg_gtk_level_bar_set_value)
+Xen_wrap_1_arg(gxg_gtk_level_bar_get_value_w, gxg_gtk_level_bar_get_value)
+Xen_wrap_2_args(gxg_gtk_level_bar_set_min_value_w, gxg_gtk_level_bar_set_min_value)
+Xen_wrap_1_arg(gxg_gtk_level_bar_get_min_value_w, gxg_gtk_level_bar_get_min_value)
+Xen_wrap_2_args(gxg_gtk_level_bar_set_max_value_w, gxg_gtk_level_bar_set_max_value)
+Xen_wrap_1_arg(gxg_gtk_level_bar_get_max_value_w, gxg_gtk_level_bar_get_max_value)
+Xen_wrap_3_args(gxg_gtk_level_bar_add_offset_value_w, gxg_gtk_level_bar_add_offset_value)
+Xen_wrap_2_args(gxg_gtk_level_bar_remove_offset_value_w, gxg_gtk_level_bar_remove_offset_value)
+Xen_wrap_3_optional_args(gxg_gtk_level_bar_get_offset_value_w, gxg_gtk_level_bar_get_offset_value)
+Xen_wrap_1_arg(gxg_gtk_application_get_active_window_w, gxg_gtk_application_get_active_window)
+Xen_wrap_2_args(gxg_gtk_entry_set_input_purpose_w, gxg_gtk_entry_set_input_purpose)
+Xen_wrap_1_arg(gxg_gtk_entry_get_input_purpose_w, gxg_gtk_entry_get_input_purpose)
+Xen_wrap_2_args(gxg_gtk_entry_set_input_hints_w, gxg_gtk_entry_set_input_hints)
+Xen_wrap_1_arg(gxg_gtk_entry_get_input_hints_w, gxg_gtk_entry_get_input_hints)
+Xen_wrap_1_arg(gxg_gtk_menu_button_get_popup_w, gxg_gtk_menu_button_get_popup)
+Xen_wrap_2_args(gxg_gtk_text_view_set_input_purpose_w, gxg_gtk_text_view_set_input_purpose)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_input_purpose_w, gxg_gtk_text_view_get_input_purpose)
+Xen_wrap_2_args(gxg_gtk_text_view_set_input_hints_w, gxg_gtk_text_view_set_input_hints)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_input_hints_w, gxg_gtk_text_view_get_input_hints)
+Xen_wrap_2_args(gxg_gtk_entry_set_attributes_w, gxg_gtk_entry_set_attributes)
+Xen_wrap_1_arg(gxg_gtk_entry_get_attributes_w, gxg_gtk_entry_get_attributes)
+Xen_wrap_3_args(gxg_gtk_accel_label_set_accel_w, gxg_gtk_accel_label_set_accel)
+Xen_wrap_4_args(gxg_gtk_menu_shell_bind_model_w, gxg_gtk_menu_shell_bind_model)
#endif
-#if (!HAVE_GTK_3)
-XEN_NARGIFY_2(gxg_gdk_colormap_new_w, gxg_gdk_colormap_new)
-XEN_NARGIFY_0(gxg_gdk_colormap_get_system_w, gxg_gdk_colormap_get_system)
-XEN_ARGIFY_6(gxg_gdk_colormap_alloc_colors_w, gxg_gdk_colormap_alloc_colors)
-XEN_NARGIFY_4(gxg_gdk_colormap_alloc_color_w, gxg_gdk_colormap_alloc_color)
-XEN_NARGIFY_1(gxg_gdk_colormap_get_visual_w, gxg_gdk_colormap_get_visual)
-XEN_NARGIFY_1(gxg_gdk_cursor_ref_w, gxg_gdk_cursor_ref)
-XEN_NARGIFY_1(gxg_gdk_cursor_unref_w, gxg_gdk_cursor_unref)
-XEN_NARGIFY_0(gxg_gdk_drag_context_new_w, gxg_gdk_drag_context_new)
-XEN_ARGIFY_2(gxg_gdk_drag_get_protocol_w, gxg_gdk_drag_get_protocol)
-XEN_ARGIFY_6(gxg_gdk_drag_find_window_w, gxg_gdk_drag_find_window)
-XEN_NARGIFY_8(gxg_gdk_drag_motion_w, gxg_gdk_drag_motion)
-XEN_NARGIFY_1(gxg_gdk_cairo_create_w, gxg_gdk_cairo_create)
-XEN_ARGIFY_3(gxg_gdk_drawable_get_size_w, gxg_gdk_drawable_get_size)
-XEN_NARGIFY_2(gxg_gdk_drawable_set_colormap_w, gxg_gdk_drawable_set_colormap)
-XEN_NARGIFY_1(gxg_gdk_drawable_get_colormap_w, gxg_gdk_drawable_get_colormap)
-XEN_NARGIFY_1(gxg_gdk_drawable_get_visual_w, gxg_gdk_drawable_get_visual)
-XEN_NARGIFY_1(gxg_gdk_drawable_get_depth_w, gxg_gdk_drawable_get_depth)
-XEN_NARGIFY_0(gxg_gdk_set_locale_w, gxg_gdk_set_locale)
-XEN_NARGIFY_9(gxg_gdk_pixbuf_render_threshold_alpha_w, gxg_gdk_pixbuf_render_threshold_alpha)
-XEN_ARGIFY_5(gxg_gdk_pixbuf_render_pixmap_and_mask_for_colormap_w, gxg_gdk_pixbuf_render_pixmap_and_mask_for_colormap)
-XEN_ARGIFY_4(gxg_gdk_pixbuf_render_pixmap_and_mask_w, gxg_gdk_pixbuf_render_pixmap_and_mask)
-XEN_NARGIFY_9(gxg_gdk_pixbuf_get_from_drawable_w, gxg_gdk_pixbuf_get_from_drawable)
-XEN_NARGIFY_2(gxg_gdk_rgb_find_color_w, gxg_gdk_rgb_find_color)
-XEN_NARGIFY_1(gxg_gdk_window_clear_w, gxg_gdk_window_clear)
-XEN_NARGIFY_5(gxg_gdk_window_clear_area_w, gxg_gdk_window_clear_area)
-XEN_NARGIFY_5(gxg_gdk_window_clear_area_e_w, gxg_gdk_window_clear_area_e)
-XEN_NARGIFY_4(gxg_gdk_window_shape_combine_mask_w, gxg_gdk_window_shape_combine_mask)
-XEN_NARGIFY_1(gxg_gdk_window_foreign_new_w, gxg_gdk_window_foreign_new)
-XEN_NARGIFY_1(gxg_gdk_window_lookup_w, gxg_gdk_window_lookup)
-XEN_NARGIFY_4(gxg_gdk_window_set_icon_w, gxg_gdk_window_set_icon)
-XEN_ARGIFY_4(gxg_gdk_window_get_internal_paint_info_w, gxg_gdk_window_get_internal_paint_info)
-XEN_NARGIFY_1(gxg_gdk_set_sm_client_id_w, gxg_gdk_set_sm_client_id)
-XEN_NARGIFY_3(gxg_gdk_window_set_back_pixmap_w, gxg_gdk_window_set_back_pixmap)
-XEN_ARGIFY_6(gxg_gdk_window_get_geometry_w, gxg_gdk_window_get_geometry)
-XEN_NARGIFY_6(gxg_gtk_adjustment_new_w, gxg_gtk_adjustment_new)
-XEN_NARGIFY_3(gxg_gtk_bindings_activate_w, gxg_gtk_bindings_activate)
-XEN_NARGIFY_4(gxg_gtk_binding_set_activate_w, gxg_gtk_binding_set_activate)
-XEN_ARGIFY_7(gxg_gtk_cell_renderer_get_size_w, gxg_gtk_cell_renderer_get_size)
-XEN_NARGIFY_7(gxg_gtk_cell_renderer_render_w, gxg_gtk_cell_renderer_render)
-XEN_NARGIFY_4(gxg_gtk_drag_dest_set_proxy_w, gxg_gtk_drag_dest_set_proxy)
-XEN_NARGIFY_4(gxg_gtk_drag_source_set_icon_w, gxg_gtk_drag_source_set_icon)
-XEN_NARGIFY_6(gxg_gtk_drag_set_icon_pixmap_w, gxg_gtk_drag_set_icon_pixmap)
-XEN_NARGIFY_7(gxg_gtk_icon_set_render_icon_w, gxg_gtk_icon_set_render_icon)
-XEN_NARGIFY_0(gxg_gtk_set_locale_w, gxg_gtk_set_locale)
-XEN_NARGIFY_2(gxg_gtk_range_set_update_policy_w, gxg_gtk_range_set_update_policy)
-XEN_NARGIFY_1(gxg_gtk_range_get_update_policy_w, gxg_gtk_range_get_update_policy)
-XEN_NARGIFY_1(gxg_gtk_rc_add_default_file_w, gxg_gtk_rc_add_default_file)
-XEN_NARGIFY_1(gxg_gtk_rc_set_default_files_w, gxg_gtk_rc_set_default_files)
-XEN_NARGIFY_0(gxg_gtk_rc_get_default_files_w, gxg_gtk_rc_get_default_files)
-XEN_NARGIFY_1(gxg_gtk_rc_get_style_w, gxg_gtk_rc_get_style)
-XEN_NARGIFY_1(gxg_gtk_rc_parse_w, gxg_gtk_rc_parse)
-XEN_NARGIFY_1(gxg_gtk_rc_parse_string_w, gxg_gtk_rc_parse_string)
-XEN_NARGIFY_0(gxg_gtk_rc_reparse_all_w, gxg_gtk_rc_reparse_all)
-XEN_NARGIFY_0(gxg_gtk_rc_style_new_w, gxg_gtk_rc_style_new)
-XEN_NARGIFY_1(gxg_gtk_rc_style_copy_w, gxg_gtk_rc_style_copy)
-XEN_NARGIFY_1(gxg_gtk_rc_find_module_in_path_w, gxg_gtk_rc_find_module_in_path)
-XEN_NARGIFY_0(gxg_gtk_rc_get_theme_dir_w, gxg_gtk_rc_get_theme_dir)
-XEN_NARGIFY_0(gxg_gtk_rc_get_module_dir_w, gxg_gtk_rc_get_module_dir)
-XEN_NARGIFY_0(gxg_gtk_rc_get_im_module_path_w, gxg_gtk_rc_get_im_module_path)
-XEN_NARGIFY_0(gxg_gtk_rc_get_im_module_file_w, gxg_gtk_rc_get_im_module_file)
-XEN_NARGIFY_0(gxg_gtk_style_new_w, gxg_gtk_style_new)
-XEN_NARGIFY_1(gxg_gtk_style_copy_w, gxg_gtk_style_copy)
-XEN_NARGIFY_2(gxg_gtk_style_attach_w, gxg_gtk_style_attach)
-XEN_NARGIFY_1(gxg_gtk_style_detach_w, gxg_gtk_style_detach)
-XEN_NARGIFY_3(gxg_gtk_style_set_background_w, gxg_gtk_style_set_background)
-XEN_NARGIFY_9(gxg_gtk_style_apply_default_background_w, gxg_gtk_style_apply_default_background)
-XEN_NARGIFY_2(gxg_gtk_style_lookup_icon_set_w, gxg_gtk_style_lookup_icon_set)
-XEN_NARGIFY_7(gxg_gtk_style_render_icon_w, gxg_gtk_style_render_icon)
-XEN_NARGIFY_2(gxg_gtk_tree_view_create_row_drag_icon_w, gxg_gtk_tree_view_create_row_drag_icon)
-XEN_NARGIFY_1(gxg_gtk_widget_hide_all_w, gxg_gtk_widget_hide_all)
-XEN_NARGIFY_2(gxg_gtk_widget_size_request_w, gxg_gtk_widget_size_request)
-XEN_NARGIFY_2(gxg_gtk_widget_get_child_requisition_w, gxg_gtk_widget_get_child_requisition)
-XEN_NARGIFY_1(gxg_gtk_widget_get_colormap_w, gxg_gtk_widget_get_colormap)
-XEN_NARGIFY_2(gxg_gtk_widget_set_colormap_w, gxg_gtk_widget_set_colormap)
-XEN_NARGIFY_2(gxg_gtk_widget_set_style_w, gxg_gtk_widget_set_style)
-XEN_NARGIFY_1(gxg_gtk_widget_ensure_style_w, gxg_gtk_widget_ensure_style)
-XEN_NARGIFY_1(gxg_gtk_widget_get_style_w, gxg_gtk_widget_get_style)
-XEN_NARGIFY_2(gxg_gtk_widget_modify_style_w, gxg_gtk_widget_modify_style)
-XEN_NARGIFY_1(gxg_gtk_widget_get_modifier_style_w, gxg_gtk_widget_get_modifier_style)
-XEN_NARGIFY_3(gxg_gtk_widget_modify_fg_w, gxg_gtk_widget_modify_fg)
-XEN_NARGIFY_3(gxg_gtk_widget_modify_bg_w, gxg_gtk_widget_modify_bg)
-XEN_NARGIFY_3(gxg_gtk_widget_modify_text_w, gxg_gtk_widget_modify_text)
-XEN_NARGIFY_3(gxg_gtk_widget_modify_base_w, gxg_gtk_widget_modify_base)
-XEN_NARGIFY_2(gxg_gtk_widget_modify_font_w, gxg_gtk_widget_modify_font)
-XEN_NARGIFY_4(gxg_gtk_widget_render_icon_w, gxg_gtk_widget_render_icon)
-XEN_NARGIFY_1(gxg_gtk_widget_reset_rc_styles_w, gxg_gtk_widget_reset_rc_styles)
-XEN_NARGIFY_1(gxg_gtk_widget_push_colormap_w, gxg_gtk_widget_push_colormap)
-XEN_NARGIFY_0(gxg_gtk_widget_pop_colormap_w, gxg_gtk_widget_pop_colormap)
-XEN_NARGIFY_1(gxg_gtk_widget_set_default_colormap_w, gxg_gtk_widget_set_default_colormap)
-XEN_NARGIFY_0(gxg_gtk_widget_get_default_style_w, gxg_gtk_widget_get_default_style)
-XEN_NARGIFY_0(gxg_gtk_widget_get_default_colormap_w, gxg_gtk_widget_get_default_colormap)
-XEN_NARGIFY_0(gxg_gtk_widget_get_default_visual_w, gxg_gtk_widget_get_default_visual)
-XEN_NARGIFY_4(gxg_gtk_widget_shape_combine_mask_w, gxg_gtk_widget_shape_combine_mask)
-XEN_NARGIFY_1(gxg_gtk_widget_reset_shapes_w, gxg_gtk_widget_reset_shapes)
-XEN_NARGIFY_1(gxg_gtk_requisition_copy_w, gxg_gtk_requisition_copy)
-XEN_NARGIFY_1(gxg_gtk_requisition_free_w, gxg_gtk_requisition_free)
-XEN_NARGIFY_2(gxg_gtk_window_set_has_frame_w, gxg_gtk_window_set_has_frame)
-XEN_NARGIFY_1(gxg_gtk_window_get_has_frame_w, gxg_gtk_window_get_has_frame)
-XEN_NARGIFY_5(gxg_gtk_window_set_frame_dimensions_w, gxg_gtk_window_set_frame_dimensions)
-XEN_ARGIFY_5(gxg_gtk_window_get_frame_dimensions_w, gxg_gtk_window_get_frame_dimensions)
-XEN_NARGIFY_2(gxg_gtk_window_remove_embedded_xid_w, gxg_gtk_window_remove_embedded_xid)
-XEN_NARGIFY_2(gxg_gtk_window_add_embedded_xid_w, gxg_gtk_window_add_embedded_xid)
-XEN_NARGIFY_1(gxg_gdk_screen_get_default_colormap_w, gxg_gdk_screen_get_default_colormap)
-XEN_NARGIFY_2(gxg_gdk_screen_set_default_colormap_w, gxg_gdk_screen_set_default_colormap)
-XEN_NARGIFY_1(gxg_gdk_screen_get_system_colormap_w, gxg_gdk_screen_get_system_colormap)
-XEN_NARGIFY_3(gxg_gtk_cell_view_get_size_of_row_w, gxg_gtk_cell_view_get_size_of_row)
-XEN_NARGIFY_3(gxg_gtk_style_lookup_color_w, gxg_gtk_style_lookup_color)
+#if GTK_CHECK_VERSION(3, 8, 0)
+Xen_wrap_2_args(gxg_gtk_level_bar_set_inverted_w, gxg_gtk_level_bar_set_inverted)
+Xen_wrap_1_arg(gxg_gtk_level_bar_get_inverted_w, gxg_gtk_level_bar_get_inverted)
+Xen_wrap_1_arg(gxg_gtk_widget_is_visible_w, gxg_gtk_widget_is_visible)
+Xen_wrap_2_args(gxg_gdk_window_set_fullscreen_mode_w, gxg_gdk_window_set_fullscreen_mode)
+Xen_wrap_1_arg(gxg_gdk_window_get_fullscreen_mode_w, gxg_gdk_window_get_fullscreen_mode)
+Xen_wrap_2_args(gxg_gtk_icon_view_set_activate_on_single_click_w, gxg_gtk_icon_view_set_activate_on_single_click)
+Xen_wrap_1_arg(gxg_gtk_icon_view_get_activate_on_single_click_w, gxg_gtk_icon_view_get_activate_on_single_click)
+Xen_wrap_1_arg(gxg_gtk_tree_view_get_activate_on_single_click_w, gxg_gtk_tree_view_get_activate_on_single_click)
+Xen_wrap_2_args(gxg_gtk_tree_view_set_activate_on_single_click_w, gxg_gtk_tree_view_set_activate_on_single_click)
+Xen_wrap_2_args(gxg_gtk_widget_register_window_w, gxg_gtk_widget_register_window)
+Xen_wrap_2_args(gxg_gtk_widget_unregister_window_w, gxg_gtk_widget_unregister_window)
+Xen_wrap_2_args(gxg_gtk_widget_set_opacity_w, gxg_gtk_widget_set_opacity)
+Xen_wrap_1_arg(gxg_gtk_widget_get_opacity_w, gxg_gtk_widget_get_opacity)
+Xen_wrap_1_arg(gxg_pango_font_map_changed_w, gxg_pango_font_map_changed)
#endif
-XEN_NARGIFY_1(gxg_cairo_create_w, gxg_cairo_create)
-XEN_NARGIFY_0(gxg_cairo_version_w, gxg_cairo_version)
-XEN_NARGIFY_0(gxg_cairo_version_string_w, gxg_cairo_version_string)
-XEN_NARGIFY_1(gxg_cairo_reference_w, gxg_cairo_reference)
-XEN_NARGIFY_1(gxg_cairo_destroy_w, gxg_cairo_destroy)
-XEN_NARGIFY_1(gxg_cairo_save_w, gxg_cairo_save)
-XEN_NARGIFY_1(gxg_cairo_restore_w, gxg_cairo_restore)
-XEN_NARGIFY_1(gxg_cairo_push_group_w, gxg_cairo_push_group)
-XEN_NARGIFY_2(gxg_cairo_push_group_with_content_w, gxg_cairo_push_group_with_content)
-XEN_NARGIFY_1(gxg_cairo_pop_group_w, gxg_cairo_pop_group)
-XEN_NARGIFY_1(gxg_cairo_pop_group_to_source_w, gxg_cairo_pop_group_to_source)
-XEN_NARGIFY_2(gxg_cairo_set_operator_w, gxg_cairo_set_operator)
-XEN_NARGIFY_2(gxg_cairo_set_source_w, gxg_cairo_set_source)
-XEN_NARGIFY_4(gxg_cairo_set_source_rgb_w, gxg_cairo_set_source_rgb)
-XEN_NARGIFY_5(gxg_cairo_set_source_rgba_w, gxg_cairo_set_source_rgba)
-XEN_NARGIFY_4(gxg_cairo_set_source_surface_w, gxg_cairo_set_source_surface)
-XEN_NARGIFY_2(gxg_cairo_set_tolerance_w, gxg_cairo_set_tolerance)
-XEN_NARGIFY_2(gxg_cairo_set_antialias_w, gxg_cairo_set_antialias)
-XEN_NARGIFY_2(gxg_cairo_set_fill_rule_w, gxg_cairo_set_fill_rule)
-XEN_NARGIFY_2(gxg_cairo_set_line_width_w, gxg_cairo_set_line_width)
-XEN_NARGIFY_2(gxg_cairo_set_line_cap_w, gxg_cairo_set_line_cap)
-XEN_NARGIFY_2(gxg_cairo_set_line_join_w, gxg_cairo_set_line_join)
-XEN_NARGIFY_4(gxg_cairo_set_dash_w, gxg_cairo_set_dash)
-XEN_NARGIFY_2(gxg_cairo_set_miter_limit_w, gxg_cairo_set_miter_limit)
-XEN_NARGIFY_3(gxg_cairo_translate_w, gxg_cairo_translate)
-XEN_NARGIFY_3(gxg_cairo_scale_w, gxg_cairo_scale)
-XEN_NARGIFY_2(gxg_cairo_rotate_w, gxg_cairo_rotate)
-XEN_NARGIFY_2(gxg_cairo_transform_w, gxg_cairo_transform)
-XEN_NARGIFY_2(gxg_cairo_set_matrix_w, gxg_cairo_set_matrix)
-XEN_NARGIFY_1(gxg_cairo_identity_matrix_w, gxg_cairo_identity_matrix)
-XEN_ARGIFY_3(gxg_cairo_user_to_device_w, gxg_cairo_user_to_device)
-XEN_ARGIFY_3(gxg_cairo_user_to_device_distance_w, gxg_cairo_user_to_device_distance)
-XEN_ARGIFY_3(gxg_cairo_device_to_user_w, gxg_cairo_device_to_user)
-XEN_ARGIFY_3(gxg_cairo_device_to_user_distance_w, gxg_cairo_device_to_user_distance)
-XEN_NARGIFY_1(gxg_cairo_new_path_w, gxg_cairo_new_path)
-XEN_NARGIFY_3(gxg_cairo_move_to_w, gxg_cairo_move_to)
-XEN_NARGIFY_1(gxg_cairo_new_sub_path_w, gxg_cairo_new_sub_path)
-XEN_NARGIFY_3(gxg_cairo_line_to_w, gxg_cairo_line_to)
-XEN_NARGIFY_7(gxg_cairo_curve_to_w, gxg_cairo_curve_to)
-XEN_NARGIFY_6(gxg_cairo_arc_w, gxg_cairo_arc)
-XEN_NARGIFY_6(gxg_cairo_arc_negative_w, gxg_cairo_arc_negative)
-XEN_NARGIFY_3(gxg_cairo_rel_move_to_w, gxg_cairo_rel_move_to)
-XEN_NARGIFY_3(gxg_cairo_rel_line_to_w, gxg_cairo_rel_line_to)
-XEN_NARGIFY_7(gxg_cairo_rel_curve_to_w, gxg_cairo_rel_curve_to)
-XEN_NARGIFY_5(gxg_cairo_rectangle_w, gxg_cairo_rectangle)
-XEN_NARGIFY_1(gxg_cairo_close_path_w, gxg_cairo_close_path)
-XEN_NARGIFY_1(gxg_cairo_paint_w, gxg_cairo_paint)
-XEN_NARGIFY_2(gxg_cairo_paint_with_alpha_w, gxg_cairo_paint_with_alpha)
-XEN_NARGIFY_2(gxg_cairo_mask_w, gxg_cairo_mask)
-XEN_NARGIFY_4(gxg_cairo_mask_surface_w, gxg_cairo_mask_surface)
-XEN_NARGIFY_1(gxg_cairo_stroke_w, gxg_cairo_stroke)
-XEN_NARGIFY_1(gxg_cairo_stroke_preserve_w, gxg_cairo_stroke_preserve)
-XEN_NARGIFY_1(gxg_cairo_fill_w, gxg_cairo_fill)
-XEN_NARGIFY_1(gxg_cairo_fill_preserve_w, gxg_cairo_fill_preserve)
-XEN_NARGIFY_1(gxg_cairo_copy_page_w, gxg_cairo_copy_page)
-XEN_NARGIFY_1(gxg_cairo_show_page_w, gxg_cairo_show_page)
-XEN_NARGIFY_3(gxg_cairo_in_stroke_w, gxg_cairo_in_stroke)
-XEN_NARGIFY_3(gxg_cairo_in_fill_w, gxg_cairo_in_fill)
-XEN_NARGIFY_1(gxg_cairo_reset_clip_w, gxg_cairo_reset_clip)
-XEN_NARGIFY_1(gxg_cairo_clip_w, gxg_cairo_clip)
-XEN_NARGIFY_1(gxg_cairo_clip_preserve_w, gxg_cairo_clip_preserve)
-XEN_NARGIFY_0(gxg_cairo_font_options_create_w, gxg_cairo_font_options_create)
-XEN_NARGIFY_1(gxg_cairo_font_options_copy_w, gxg_cairo_font_options_copy)
-XEN_NARGIFY_1(gxg_cairo_font_options_destroy_w, gxg_cairo_font_options_destroy)
-XEN_NARGIFY_1(gxg_cairo_font_options_status_w, gxg_cairo_font_options_status)
-XEN_NARGIFY_2(gxg_cairo_font_options_merge_w, gxg_cairo_font_options_merge)
-XEN_NARGIFY_2(gxg_cairo_font_options_equal_w, gxg_cairo_font_options_equal)
-XEN_NARGIFY_1(gxg_cairo_font_options_hash_w, gxg_cairo_font_options_hash)
-XEN_NARGIFY_2(gxg_cairo_font_options_set_antialias_w, gxg_cairo_font_options_set_antialias)
-XEN_NARGIFY_1(gxg_cairo_font_options_get_antialias_w, gxg_cairo_font_options_get_antialias)
-XEN_NARGIFY_2(gxg_cairo_font_options_set_subpixel_order_w, gxg_cairo_font_options_set_subpixel_order)
-XEN_NARGIFY_1(gxg_cairo_font_options_get_subpixel_order_w, gxg_cairo_font_options_get_subpixel_order)
-XEN_NARGIFY_2(gxg_cairo_font_options_set_hint_style_w, gxg_cairo_font_options_set_hint_style)
-XEN_NARGIFY_1(gxg_cairo_font_options_get_hint_style_w, gxg_cairo_font_options_get_hint_style)
-XEN_NARGIFY_2(gxg_cairo_font_options_set_hint_metrics_w, gxg_cairo_font_options_set_hint_metrics)
-XEN_NARGIFY_1(gxg_cairo_font_options_get_hint_metrics_w, gxg_cairo_font_options_get_hint_metrics)
-XEN_NARGIFY_4(gxg_cairo_select_font_face_w, gxg_cairo_select_font_face)
-XEN_NARGIFY_2(gxg_cairo_set_font_size_w, gxg_cairo_set_font_size)
-XEN_NARGIFY_2(gxg_cairo_set_font_matrix_w, gxg_cairo_set_font_matrix)
-XEN_NARGIFY_2(gxg_cairo_get_font_matrix_w, gxg_cairo_get_font_matrix)
-XEN_NARGIFY_2(gxg_cairo_set_font_options_w, gxg_cairo_set_font_options)
-XEN_NARGIFY_2(gxg_cairo_get_font_options_w, gxg_cairo_get_font_options)
-XEN_NARGIFY_2(gxg_cairo_set_scaled_font_w, gxg_cairo_set_scaled_font)
-XEN_NARGIFY_2(gxg_cairo_show_text_w, gxg_cairo_show_text)
-XEN_NARGIFY_3(gxg_cairo_show_glyphs_w, gxg_cairo_show_glyphs)
-XEN_NARGIFY_1(gxg_cairo_get_font_face_w, gxg_cairo_get_font_face)
-XEN_NARGIFY_2(gxg_cairo_font_extents_w, gxg_cairo_font_extents)
-XEN_NARGIFY_2(gxg_cairo_set_font_face_w, gxg_cairo_set_font_face)
-XEN_NARGIFY_3(gxg_cairo_text_extents_w, gxg_cairo_text_extents)
-XEN_NARGIFY_4(gxg_cairo_glyph_extents_w, gxg_cairo_glyph_extents)
-XEN_NARGIFY_2(gxg_cairo_text_path_w, gxg_cairo_text_path)
-XEN_NARGIFY_3(gxg_cairo_glyph_path_w, gxg_cairo_glyph_path)
-XEN_NARGIFY_1(gxg_cairo_font_face_reference_w, gxg_cairo_font_face_reference)
-XEN_NARGIFY_1(gxg_cairo_font_face_destroy_w, gxg_cairo_font_face_destroy)
-XEN_NARGIFY_1(gxg_cairo_font_face_status_w, gxg_cairo_font_face_status)
-XEN_NARGIFY_2(gxg_cairo_font_face_get_user_data_w, gxg_cairo_font_face_get_user_data)
-XEN_NARGIFY_4(gxg_cairo_font_face_set_user_data_w, gxg_cairo_font_face_set_user_data)
-XEN_NARGIFY_4(gxg_cairo_scaled_font_create_w, gxg_cairo_scaled_font_create)
-XEN_NARGIFY_1(gxg_cairo_scaled_font_reference_w, gxg_cairo_scaled_font_reference)
-XEN_NARGIFY_1(gxg_cairo_scaled_font_destroy_w, gxg_cairo_scaled_font_destroy)
-XEN_NARGIFY_1(gxg_cairo_scaled_font_status_w, gxg_cairo_scaled_font_status)
-XEN_NARGIFY_2(gxg_cairo_scaled_font_extents_w, gxg_cairo_scaled_font_extents)
-XEN_NARGIFY_3(gxg_cairo_scaled_font_text_extents_w, gxg_cairo_scaled_font_text_extents)
-XEN_NARGIFY_4(gxg_cairo_scaled_font_glyph_extents_w, gxg_cairo_scaled_font_glyph_extents)
-XEN_NARGIFY_1(gxg_cairo_scaled_font_get_font_face_w, gxg_cairo_scaled_font_get_font_face)
-XEN_NARGIFY_2(gxg_cairo_scaled_font_get_font_matrix_w, gxg_cairo_scaled_font_get_font_matrix)
-XEN_NARGIFY_2(gxg_cairo_scaled_font_get_ctm_w, gxg_cairo_scaled_font_get_ctm)
-XEN_NARGIFY_2(gxg_cairo_scaled_font_get_font_options_w, gxg_cairo_scaled_font_get_font_options)
-XEN_NARGIFY_1(gxg_cairo_get_operator_w, gxg_cairo_get_operator)
-XEN_NARGIFY_1(gxg_cairo_get_source_w, gxg_cairo_get_source)
-XEN_NARGIFY_1(gxg_cairo_get_tolerance_w, gxg_cairo_get_tolerance)
-XEN_NARGIFY_1(gxg_cairo_get_antialias_w, gxg_cairo_get_antialias)
-XEN_ARGIFY_3(gxg_cairo_get_current_point_w, gxg_cairo_get_current_point)
-XEN_NARGIFY_1(gxg_cairo_get_fill_rule_w, gxg_cairo_get_fill_rule)
-XEN_NARGIFY_1(gxg_cairo_get_line_width_w, gxg_cairo_get_line_width)
-XEN_NARGIFY_1(gxg_cairo_get_line_cap_w, gxg_cairo_get_line_cap)
-XEN_NARGIFY_1(gxg_cairo_get_line_join_w, gxg_cairo_get_line_join)
-XEN_NARGIFY_1(gxg_cairo_get_miter_limit_w, gxg_cairo_get_miter_limit)
-XEN_NARGIFY_2(gxg_cairo_get_matrix_w, gxg_cairo_get_matrix)
-XEN_NARGIFY_1(gxg_cairo_get_target_w, gxg_cairo_get_target)
-XEN_NARGIFY_1(gxg_cairo_get_group_target_w, gxg_cairo_get_group_target)
-XEN_NARGIFY_1(gxg_cairo_copy_path_w, gxg_cairo_copy_path)
-XEN_NARGIFY_1(gxg_cairo_copy_path_flat_w, gxg_cairo_copy_path_flat)
-XEN_NARGIFY_2(gxg_cairo_append_path_w, gxg_cairo_append_path)
-XEN_NARGIFY_1(gxg_cairo_path_destroy_w, gxg_cairo_path_destroy)
-XEN_NARGIFY_1(gxg_cairo_status_w, gxg_cairo_status)
-XEN_NARGIFY_1(gxg_cairo_status_to_string_w, gxg_cairo_status_to_string)
-XEN_NARGIFY_4(gxg_cairo_surface_create_similar_w, gxg_cairo_surface_create_similar)
-XEN_NARGIFY_1(gxg_cairo_surface_reference_w, gxg_cairo_surface_reference)
-XEN_NARGIFY_1(gxg_cairo_surface_finish_w, gxg_cairo_surface_finish)
-XEN_NARGIFY_1(gxg_cairo_surface_destroy_w, gxg_cairo_surface_destroy)
-XEN_NARGIFY_1(gxg_cairo_surface_status_w, gxg_cairo_surface_status)
-XEN_NARGIFY_1(gxg_cairo_surface_get_content_w, gxg_cairo_surface_get_content)
-XEN_NARGIFY_2(gxg_cairo_surface_get_user_data_w, gxg_cairo_surface_get_user_data)
-XEN_NARGIFY_4(gxg_cairo_surface_set_user_data_w, gxg_cairo_surface_set_user_data)
-XEN_NARGIFY_2(gxg_cairo_surface_get_font_options_w, gxg_cairo_surface_get_font_options)
-XEN_NARGIFY_1(gxg_cairo_surface_flush_w, gxg_cairo_surface_flush)
-XEN_NARGIFY_1(gxg_cairo_surface_mark_dirty_w, gxg_cairo_surface_mark_dirty)
-XEN_NARGIFY_5(gxg_cairo_surface_mark_dirty_rectangle_w, gxg_cairo_surface_mark_dirty_rectangle)
-XEN_NARGIFY_3(gxg_cairo_surface_set_device_offset_w, gxg_cairo_surface_set_device_offset)
-XEN_ARGIFY_3(gxg_cairo_surface_get_device_offset_w, gxg_cairo_surface_get_device_offset)
-XEN_NARGIFY_3(gxg_cairo_surface_set_fallback_resolution_w, gxg_cairo_surface_set_fallback_resolution)
-XEN_NARGIFY_3(gxg_cairo_image_surface_create_w, gxg_cairo_image_surface_create)
-XEN_NARGIFY_5(gxg_cairo_image_surface_create_for_data_w, gxg_cairo_image_surface_create_for_data)
-XEN_NARGIFY_1(gxg_cairo_image_surface_get_data_w, gxg_cairo_image_surface_get_data)
-XEN_NARGIFY_1(gxg_cairo_image_surface_get_format_w, gxg_cairo_image_surface_get_format)
-XEN_NARGIFY_1(gxg_cairo_image_surface_get_width_w, gxg_cairo_image_surface_get_width)
-XEN_NARGIFY_1(gxg_cairo_image_surface_get_height_w, gxg_cairo_image_surface_get_height)
-XEN_NARGIFY_1(gxg_cairo_image_surface_get_stride_w, gxg_cairo_image_surface_get_stride)
-XEN_NARGIFY_3(gxg_cairo_pattern_create_rgb_w, gxg_cairo_pattern_create_rgb)
-XEN_NARGIFY_4(gxg_cairo_pattern_create_rgba_w, gxg_cairo_pattern_create_rgba)
-XEN_NARGIFY_1(gxg_cairo_pattern_create_for_surface_w, gxg_cairo_pattern_create_for_surface)
-XEN_NARGIFY_4(gxg_cairo_pattern_create_linear_w, gxg_cairo_pattern_create_linear)
-XEN_NARGIFY_6(gxg_cairo_pattern_create_radial_w, gxg_cairo_pattern_create_radial)
-XEN_NARGIFY_1(gxg_cairo_pattern_reference_w, gxg_cairo_pattern_reference)
-XEN_NARGIFY_1(gxg_cairo_pattern_destroy_w, gxg_cairo_pattern_destroy)
-XEN_NARGIFY_1(gxg_cairo_pattern_status_w, gxg_cairo_pattern_status)
-XEN_NARGIFY_5(gxg_cairo_pattern_add_color_stop_rgb_w, gxg_cairo_pattern_add_color_stop_rgb)
-XEN_NARGIFY_6(gxg_cairo_pattern_add_color_stop_rgba_w, gxg_cairo_pattern_add_color_stop_rgba)
-XEN_NARGIFY_2(gxg_cairo_pattern_set_matrix_w, gxg_cairo_pattern_set_matrix)
-XEN_NARGIFY_2(gxg_cairo_pattern_get_matrix_w, gxg_cairo_pattern_get_matrix)
-XEN_NARGIFY_2(gxg_cairo_pattern_set_extend_w, gxg_cairo_pattern_set_extend)
-XEN_NARGIFY_1(gxg_cairo_pattern_get_extend_w, gxg_cairo_pattern_get_extend)
-XEN_NARGIFY_2(gxg_cairo_pattern_set_filter_w, gxg_cairo_pattern_set_filter)
-XEN_NARGIFY_1(gxg_cairo_pattern_get_filter_w, gxg_cairo_pattern_get_filter)
-XEN_NARGIFY_7(gxg_cairo_matrix_init_w, gxg_cairo_matrix_init)
-XEN_NARGIFY_1(gxg_cairo_matrix_init_identity_w, gxg_cairo_matrix_init_identity)
-XEN_NARGIFY_3(gxg_cairo_matrix_init_translate_w, gxg_cairo_matrix_init_translate)
-XEN_NARGIFY_3(gxg_cairo_matrix_init_scale_w, gxg_cairo_matrix_init_scale)
-XEN_NARGIFY_2(gxg_cairo_matrix_init_rotate_w, gxg_cairo_matrix_init_rotate)
-XEN_NARGIFY_3(gxg_cairo_matrix_translate_w, gxg_cairo_matrix_translate)
-XEN_NARGIFY_3(gxg_cairo_matrix_scale_w, gxg_cairo_matrix_scale)
-XEN_NARGIFY_2(gxg_cairo_matrix_rotate_w, gxg_cairo_matrix_rotate)
-XEN_NARGIFY_1(gxg_cairo_matrix_invert_w, gxg_cairo_matrix_invert)
-XEN_NARGIFY_3(gxg_cairo_matrix_multiply_w, gxg_cairo_matrix_multiply)
-XEN_ARGIFY_3(gxg_cairo_matrix_transform_distance_w, gxg_cairo_matrix_transform_distance)
-XEN_ARGIFY_3(gxg_cairo_matrix_transform_point_w, gxg_cairo_matrix_transform_point)
-XEN_NARGIFY_1(gxg_cairo_get_reference_count_w, gxg_cairo_get_reference_count)
-XEN_NARGIFY_2(gxg_cairo_get_user_data_w, gxg_cairo_get_user_data)
-XEN_NARGIFY_4(gxg_cairo_set_user_data_w, gxg_cairo_set_user_data)
-XEN_ARGIFY_5(gxg_cairo_clip_extents_w, gxg_cairo_clip_extents)
-XEN_NARGIFY_1(gxg_cairo_copy_clip_rectangle_list_w, gxg_cairo_copy_clip_rectangle_list)
-XEN_NARGIFY_1(gxg_cairo_rectangle_list_destroy_w, gxg_cairo_rectangle_list_destroy)
-XEN_NARGIFY_1(gxg_cairo_font_face_get_reference_count_w, gxg_cairo_font_face_get_reference_count)
-XEN_NARGIFY_1(gxg_cairo_scaled_font_get_reference_count_w, gxg_cairo_scaled_font_get_reference_count)
-XEN_NARGIFY_2(gxg_cairo_scaled_font_get_user_data_w, gxg_cairo_scaled_font_get_user_data)
-XEN_NARGIFY_4(gxg_cairo_scaled_font_set_user_data_w, gxg_cairo_scaled_font_set_user_data)
-XEN_NARGIFY_1(gxg_cairo_get_dash_count_w, gxg_cairo_get_dash_count)
-XEN_ARGIFY_3(gxg_cairo_get_dash_w, gxg_cairo_get_dash)
-XEN_NARGIFY_1(gxg_cairo_surface_get_reference_count_w, gxg_cairo_surface_get_reference_count)
-XEN_NARGIFY_1(gxg_cairo_pattern_get_reference_count_w, gxg_cairo_pattern_get_reference_count)
-XEN_NARGIFY_2(gxg_cairo_pattern_get_user_data_w, gxg_cairo_pattern_get_user_data)
-XEN_NARGIFY_4(gxg_cairo_pattern_set_user_data_w, gxg_cairo_pattern_set_user_data)
-XEN_ARGIFY_5(gxg_cairo_pattern_get_rgba_w, gxg_cairo_pattern_get_rgba)
-XEN_ARGIFY_2(gxg_cairo_pattern_get_surface_w, gxg_cairo_pattern_get_surface)
-XEN_ARGIFY_7(gxg_cairo_pattern_get_color_stop_rgba_w, gxg_cairo_pattern_get_color_stop_rgba)
-XEN_ARGIFY_2(gxg_cairo_pattern_get_color_stop_count_w, gxg_cairo_pattern_get_color_stop_count)
-XEN_ARGIFY_5(gxg_cairo_pattern_get_linear_points_w, gxg_cairo_pattern_get_linear_points)
-XEN_ARGIFY_7(gxg_cairo_pattern_get_radial_circles_w, gxg_cairo_pattern_get_radial_circles)
-XEN_NARGIFY_1(gxg_cairo_get_scaled_font_w, gxg_cairo_get_scaled_font)
-XEN_ARGIFY_5(gxg_cairo_path_extents_w, gxg_cairo_path_extents)
-XEN_NARGIFY_1(gxg_cairo_has_current_point_w, gxg_cairo_has_current_point)
-XEN_NARGIFY_1(gxg_cairo_surface_copy_page_w, gxg_cairo_surface_copy_page)
-XEN_NARGIFY_1(gxg_cairo_surface_show_page_w, gxg_cairo_surface_show_page)
-XEN_NARGIFY_2(gxg_cairo_format_stride_for_width_w, gxg_cairo_format_stride_for_width)
-XEN_NARGIFY_1(gxg_cairo_image_surface_create_from_png_w, gxg_cairo_image_surface_create_from_png)
-XEN_NARGIFY_2(gxg_cairo_surface_write_to_png_w, gxg_cairo_surface_write_to_png)
-#if HAVE_CAIRO_GLYPH_ALLOCATE
-XEN_NARGIFY_1(gxg_cairo_glyph_allocate_w, gxg_cairo_glyph_allocate)
-XEN_NARGIFY_1(gxg_cairo_glyph_free_w, gxg_cairo_glyph_free)
-XEN_NARGIFY_1(gxg_cairo_text_cluster_allocate_w, gxg_cairo_text_cluster_allocate)
-XEN_NARGIFY_1(gxg_cairo_text_cluster_free_w, gxg_cairo_text_cluster_free)
-XEN_NARGIFY_8(gxg_cairo_show_text_glyphs_w, gxg_cairo_show_text_glyphs)
-XEN_VARGIFY(gxg_cairo_scaled_font_text_to_glyphs_w, gxg_cairo_scaled_font_text_to_glyphs)
-XEN_NARGIFY_2(gxg_cairo_scaled_font_get_scale_matrix_w, gxg_cairo_scaled_font_get_scale_matrix)
-XEN_NARGIFY_3(gxg_cairo_toy_font_face_create_w, gxg_cairo_toy_font_face_create)
-XEN_NARGIFY_1(gxg_cairo_toy_font_face_get_family_w, gxg_cairo_toy_font_face_get_family)
-XEN_NARGIFY_1(gxg_cairo_toy_font_face_get_slant_w, gxg_cairo_toy_font_face_get_slant)
-XEN_NARGIFY_1(gxg_cairo_toy_font_face_get_weight_w, gxg_cairo_toy_font_face_get_weight)
-XEN_NARGIFY_0(gxg_cairo_user_font_face_create_w, gxg_cairo_user_font_face_create)
-XEN_ARGIFY_3(gxg_cairo_surface_get_fallback_resolution_w, gxg_cairo_surface_get_fallback_resolution)
-XEN_NARGIFY_1(gxg_cairo_surface_has_show_text_glyphs_w, gxg_cairo_surface_has_show_text_glyphs)
+#if GTK_CHECK_VERSION(3, 10, 0)
+Xen_wrap_1_arg(gxg_gdk_set_allowed_backends_w, gxg_gdk_set_allowed_backends)
+Xen_wrap_2_args(gxg_gtk_box_set_baseline_position_w, gxg_gtk_box_set_baseline_position)
+Xen_wrap_1_arg(gxg_gtk_box_get_baseline_position_w, gxg_gtk_box_get_baseline_position)
+Xen_wrap_2_args(gxg_gtk_grid_remove_row_w, gxg_gtk_grid_remove_row)
+Xen_wrap_2_args(gxg_gtk_grid_remove_column_w, gxg_gtk_grid_remove_column)
+Xen_wrap_3_args(gxg_gtk_grid_set_row_baseline_position_w, gxg_gtk_grid_set_row_baseline_position)
+Xen_wrap_2_args(gxg_gtk_grid_get_row_baseline_position_w, gxg_gtk_grid_get_row_baseline_position)
+Xen_wrap_2_args(gxg_gtk_grid_set_baseline_row_w, gxg_gtk_grid_set_baseline_row)
+Xen_wrap_1_arg(gxg_gtk_grid_get_baseline_row_w, gxg_gtk_grid_get_baseline_row)
+Xen_wrap_3_args(gxg_gtk_widget_size_allocate_with_baseline_w, gxg_gtk_widget_size_allocate_with_baseline)
+Xen_wrap_6_optional_args(gxg_gtk_widget_get_preferred_height_and_baseline_for_width_w, gxg_gtk_widget_get_preferred_height_and_baseline_for_width)
+Xen_wrap_1_arg(gxg_gtk_widget_get_allocated_baseline_w, gxg_gtk_widget_get_allocated_baseline)
+Xen_wrap_1_arg(gxg_gtk_widget_get_valign_with_baseline_w, gxg_gtk_widget_get_valign_with_baseline)
+Xen_wrap_1_arg(gxg_gtk_widget_init_template_w, gxg_gtk_widget_init_template)
+Xen_wrap_2_args(gxg_gtk_window_set_titlebar_w, gxg_gtk_window_set_titlebar)
+Xen_wrap_no_args(gxg_gtk_places_sidebar_new_w, gxg_gtk_places_sidebar_new)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_get_open_flags_w, gxg_gtk_places_sidebar_get_open_flags)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_set_open_flags_w, gxg_gtk_places_sidebar_set_open_flags)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_get_location_w, gxg_gtk_places_sidebar_get_location)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_set_location_w, gxg_gtk_places_sidebar_set_location)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_get_show_desktop_w, gxg_gtk_places_sidebar_get_show_desktop)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_set_show_desktop_w, gxg_gtk_places_sidebar_set_show_desktop)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_add_shortcut_w, gxg_gtk_places_sidebar_add_shortcut)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_remove_shortcut_w, gxg_gtk_places_sidebar_remove_shortcut)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_list_shortcuts_w, gxg_gtk_places_sidebar_list_shortcuts)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_get_nth_bookmark_w, gxg_gtk_places_sidebar_get_nth_bookmark)
+Xen_wrap_no_args(gxg_gtk_stack_switcher_new_w, gxg_gtk_stack_switcher_new)
+Xen_wrap_2_args(gxg_gtk_stack_switcher_set_stack_w, gxg_gtk_stack_switcher_set_stack)
+Xen_wrap_1_arg(gxg_gtk_stack_switcher_get_stack_w, gxg_gtk_stack_switcher_get_stack)
+Xen_wrap_no_args(gxg_gtk_stack_new_w, gxg_gtk_stack_new)
+Xen_wrap_3_args(gxg_gtk_stack_add_named_w, gxg_gtk_stack_add_named)
+Xen_wrap_4_args(gxg_gtk_stack_add_titled_w, gxg_gtk_stack_add_titled)
+Xen_wrap_2_args(gxg_gtk_stack_set_visible_child_w, gxg_gtk_stack_set_visible_child)
+Xen_wrap_1_arg(gxg_gtk_stack_get_visible_child_w, gxg_gtk_stack_get_visible_child)
+Xen_wrap_2_args(gxg_gtk_stack_set_visible_child_name_w, gxg_gtk_stack_set_visible_child_name)
+Xen_wrap_1_arg(gxg_gtk_stack_get_visible_child_name_w, gxg_gtk_stack_get_visible_child_name)
+Xen_wrap_3_args(gxg_gtk_stack_set_visible_child_full_w, gxg_gtk_stack_set_visible_child_full)
+Xen_wrap_2_args(gxg_gtk_stack_set_homogeneous_w, gxg_gtk_stack_set_homogeneous)
+Xen_wrap_1_arg(gxg_gtk_stack_get_homogeneous_w, gxg_gtk_stack_get_homogeneous)
+Xen_wrap_2_args(gxg_gtk_stack_set_transition_duration_w, gxg_gtk_stack_set_transition_duration)
+Xen_wrap_1_arg(gxg_gtk_stack_get_transition_duration_w, gxg_gtk_stack_get_transition_duration)
+Xen_wrap_2_args(gxg_gtk_stack_set_transition_type_w, gxg_gtk_stack_set_transition_type)
+Xen_wrap_1_arg(gxg_gtk_stack_get_transition_type_w, gxg_gtk_stack_get_transition_type)
+Xen_wrap_no_args(gxg_gtk_revealer_new_w, gxg_gtk_revealer_new)
+Xen_wrap_1_arg(gxg_gtk_revealer_get_reveal_child_w, gxg_gtk_revealer_get_reveal_child)
+Xen_wrap_2_args(gxg_gtk_revealer_set_reveal_child_w, gxg_gtk_revealer_set_reveal_child)
+Xen_wrap_1_arg(gxg_gtk_revealer_get_child_revealed_w, gxg_gtk_revealer_get_child_revealed)
+Xen_wrap_1_arg(gxg_gtk_revealer_get_transition_duration_w, gxg_gtk_revealer_get_transition_duration)
+Xen_wrap_2_args(gxg_gtk_revealer_set_transition_duration_w, gxg_gtk_revealer_set_transition_duration)
+Xen_wrap_2_args(gxg_gtk_revealer_set_transition_type_w, gxg_gtk_revealer_set_transition_type)
+Xen_wrap_1_arg(gxg_gtk_revealer_get_transition_type_w, gxg_gtk_revealer_get_transition_type)
+Xen_wrap_no_args(gxg_gtk_header_bar_new_w, gxg_gtk_header_bar_new)
+Xen_wrap_2_args(gxg_gtk_header_bar_set_title_w, gxg_gtk_header_bar_set_title)
+Xen_wrap_1_arg(gxg_gtk_header_bar_get_title_w, gxg_gtk_header_bar_get_title)
+Xen_wrap_2_args(gxg_gtk_header_bar_set_subtitle_w, gxg_gtk_header_bar_set_subtitle)
+Xen_wrap_1_arg(gxg_gtk_header_bar_get_subtitle_w, gxg_gtk_header_bar_get_subtitle)
+Xen_wrap_2_args(gxg_gtk_header_bar_set_custom_title_w, gxg_gtk_header_bar_set_custom_title)
+Xen_wrap_1_arg(gxg_gtk_header_bar_get_custom_title_w, gxg_gtk_header_bar_get_custom_title)
+Xen_wrap_2_args(gxg_gtk_header_bar_pack_start_w, gxg_gtk_header_bar_pack_start)
+Xen_wrap_2_args(gxg_gtk_header_bar_pack_end_w, gxg_gtk_header_bar_pack_end)
+Xen_wrap_no_args(gxg_gtk_list_box_row_new_w, gxg_gtk_list_box_row_new)
+Xen_wrap_1_arg(gxg_gtk_list_box_row_get_header_w, gxg_gtk_list_box_row_get_header)
+Xen_wrap_2_args(gxg_gtk_list_box_row_set_header_w, gxg_gtk_list_box_row_set_header)
+Xen_wrap_1_arg(gxg_gtk_list_box_row_changed_w, gxg_gtk_list_box_row_changed)
+Xen_wrap_1_arg(gxg_gtk_list_box_get_selected_row_w, gxg_gtk_list_box_get_selected_row)
+Xen_wrap_2_args(gxg_gtk_list_box_get_row_at_index_w, gxg_gtk_list_box_get_row_at_index)
+Xen_wrap_2_args(gxg_gtk_list_box_get_row_at_y_w, gxg_gtk_list_box_get_row_at_y)
+Xen_wrap_2_args(gxg_gtk_list_box_select_row_w, gxg_gtk_list_box_select_row)
+Xen_wrap_2_args(gxg_gtk_list_box_set_placeholder_w, gxg_gtk_list_box_set_placeholder)
+Xen_wrap_2_args(gxg_gtk_list_box_set_adjustment_w, gxg_gtk_list_box_set_adjustment)
+Xen_wrap_1_arg(gxg_gtk_list_box_get_adjustment_w, gxg_gtk_list_box_get_adjustment)
+Xen_wrap_2_args(gxg_gtk_list_box_set_selection_mode_w, gxg_gtk_list_box_set_selection_mode)
+Xen_wrap_1_arg(gxg_gtk_list_box_get_selection_mode_w, gxg_gtk_list_box_get_selection_mode)
+Xen_wrap_1_arg(gxg_gtk_list_box_invalidate_filter_w, gxg_gtk_list_box_invalidate_filter)
+Xen_wrap_1_arg(gxg_gtk_list_box_invalidate_sort_w, gxg_gtk_list_box_invalidate_sort)
+Xen_wrap_1_arg(gxg_gtk_list_box_invalidate_headers_w, gxg_gtk_list_box_invalidate_headers)
+Xen_wrap_2_args(gxg_gtk_list_box_set_activate_on_single_click_w, gxg_gtk_list_box_set_activate_on_single_click)
+Xen_wrap_1_arg(gxg_gtk_list_box_get_activate_on_single_click_w, gxg_gtk_list_box_get_activate_on_single_click)
+Xen_wrap_1_arg(gxg_gtk_list_box_drag_unhighlight_row_w, gxg_gtk_list_box_drag_unhighlight_row)
+Xen_wrap_2_args(gxg_gtk_list_box_drag_highlight_row_w, gxg_gtk_list_box_drag_highlight_row)
+Xen_wrap_no_args(gxg_gtk_list_box_new_w, gxg_gtk_list_box_new)
+Xen_wrap_no_args(gxg_gtk_search_bar_new_w, gxg_gtk_search_bar_new)
+Xen_wrap_2_args(gxg_gtk_search_bar_connect_entry_w, gxg_gtk_search_bar_connect_entry)
+Xen_wrap_1_arg(gxg_gtk_search_bar_get_search_mode_w, gxg_gtk_search_bar_get_search_mode)
+Xen_wrap_2_args(gxg_gtk_search_bar_set_search_mode_w, gxg_gtk_search_bar_set_search_mode)
+Xen_wrap_1_arg(gxg_gtk_search_bar_get_show_close_button_w, gxg_gtk_search_bar_get_show_close_button)
+Xen_wrap_2_args(gxg_gtk_search_bar_set_show_close_button_w, gxg_gtk_search_bar_set_show_close_button)
+Xen_wrap_2_args(gxg_gtk_search_bar_handle_event_w, gxg_gtk_search_bar_handle_event)
+Xen_wrap_1_arg(gxg_gtk_file_chooser_get_current_name_w, gxg_gtk_file_chooser_get_current_name)
+Xen_wrap_3_args(gxg_gdk_cairo_surface_create_from_pixbuf_w, gxg_gdk_cairo_surface_create_from_pixbuf)
+Xen_wrap_4_optional_args(gxg_gdk_device_get_position_double_w, gxg_gdk_device_get_position_double)
+Xen_wrap_3_optional_args(gxg_gdk_device_get_window_at_position_double_w, gxg_gdk_device_get_window_at_position_double)
+Xen_wrap_2_args(gxg_gdk_screen_get_monitor_scale_factor_w, gxg_gdk_screen_get_monitor_scale_factor)
+Xen_wrap_1_arg(gxg_gdk_window_get_scale_factor_w, gxg_gdk_window_get_scale_factor)
+Xen_wrap_5_optional_args(gxg_gdk_window_get_device_position_double_w, gxg_gdk_window_get_device_position_double)
+Xen_wrap_5_args(gxg_gdk_window_create_similar_image_surface_w, gxg_gdk_window_create_similar_image_surface)
+Xen_wrap_5_args(gxg_gtk_icon_theme_lookup_icon_for_scale_w, gxg_gtk_icon_theme_lookup_icon_for_scale)
+Xen_wrap_6_optional_args(gxg_gtk_icon_theme_load_icon_for_scale_w, gxg_gtk_icon_theme_load_icon_for_scale)
+Xen_wrap_7_optional_args(gxg_gtk_icon_theme_load_surface_w, gxg_gtk_icon_theme_load_surface)
+Xen_wrap_5_args(gxg_gtk_icon_theme_lookup_by_gicon_for_scale_w, gxg_gtk_icon_theme_lookup_by_gicon_for_scale)
+Xen_wrap_1_arg(gxg_gtk_icon_info_get_base_scale_w, gxg_gtk_icon_info_get_base_scale)
+Xen_wrap_3_optional_args(gxg_gtk_icon_info_load_surface_w, gxg_gtk_icon_info_load_surface)
+Xen_wrap_1_arg(gxg_gtk_image_new_from_surface_w, gxg_gtk_image_new_from_surface)
+Xen_wrap_2_args(gxg_gtk_image_set_from_surface_w, gxg_gtk_image_set_from_surface)
+Xen_wrap_1_arg(gxg_gtk_list_box_row_get_index_w, gxg_gtk_list_box_row_get_index)
+Xen_wrap_1_arg(gxg_gtk_widget_get_scale_factor_w, gxg_gtk_widget_get_scale_factor)
+Xen_wrap_1_arg(gxg_gtk_window_close_w, gxg_gtk_window_close)
+Xen_wrap_2_args(gxg_gtk_info_bar_set_show_close_button_w, gxg_gtk_info_bar_set_show_close_button)
+Xen_wrap_1_arg(gxg_gtk_info_bar_get_show_close_button_w, gxg_gtk_info_bar_get_show_close_button)
+Xen_wrap_5_args(gxg_gtk_tree_model_rows_reordered_with_length_w, gxg_gtk_tree_model_rows_reordered_with_length)
+Xen_wrap_4_args(gxg_gdk_cursor_new_from_surface_w, gxg_gdk_cursor_new_from_surface)
+Xen_wrap_3_optional_args(gxg_gdk_cursor_get_surface_w, gxg_gdk_cursor_get_surface)
+Xen_wrap_1_arg(gxg_gdk_event_get_event_type_w, gxg_gdk_event_get_event_type)
+Xen_wrap_2_args(gxg_gtk_entry_set_tabs_w, gxg_gtk_entry_set_tabs)
+Xen_wrap_1_arg(gxg_gtk_entry_get_tabs_w, gxg_gtk_entry_get_tabs)
+Xen_wrap_1_arg(gxg_gtk_header_bar_get_show_close_button_w, gxg_gtk_header_bar_get_show_close_button)
+Xen_wrap_2_args(gxg_gtk_header_bar_set_show_close_button_w, gxg_gtk_header_bar_set_show_close_button)
+Xen_wrap_2_args(gxg_gtk_list_box_prepend_w, gxg_gtk_list_box_prepend)
+Xen_wrap_3_args(gxg_gtk_list_box_insert_w, gxg_gtk_list_box_insert)
+Xen_wrap_2_args(gxg_gdk_window_set_opaque_region_w, gxg_gdk_window_set_opaque_region)
+Xen_wrap_2_args(gxg_gtk_label_set_lines_w, gxg_gtk_label_set_lines)
+Xen_wrap_1_arg(gxg_gtk_label_get_lines_w, gxg_gtk_label_get_lines)
+Xen_wrap_1_arg(gxg_gdk_event_get_window_w, gxg_gdk_event_get_window)
#endif
-#if HAVE_CAIRO_REGION_XOR
-XEN_NARGIFY_3(gxg_cairo_in_clip_w, gxg_cairo_in_clip)
-XEN_NARGIFY_1(gxg_cairo_device_reference_w, gxg_cairo_device_reference)
-XEN_NARGIFY_1(gxg_cairo_device_status_w, gxg_cairo_device_status)
-XEN_NARGIFY_1(gxg_cairo_device_acquire_w, gxg_cairo_device_acquire)
-XEN_NARGIFY_1(gxg_cairo_device_release_w, gxg_cairo_device_release)
-XEN_NARGIFY_1(gxg_cairo_device_flush_w, gxg_cairo_device_flush)
-XEN_NARGIFY_1(gxg_cairo_device_finish_w, gxg_cairo_device_finish)
-XEN_NARGIFY_1(gxg_cairo_device_destroy_w, gxg_cairo_device_destroy)
-XEN_NARGIFY_1(gxg_cairo_device_get_reference_count_w, gxg_cairo_device_get_reference_count)
-XEN_NARGIFY_2(gxg_cairo_device_get_user_data_w, gxg_cairo_device_get_user_data)
-XEN_NARGIFY_4(gxg_cairo_device_set_user_data_w, gxg_cairo_device_set_user_data)
-XEN_NARGIFY_5(gxg_cairo_surface_create_for_rectangle_w, gxg_cairo_surface_create_for_rectangle)
-XEN_NARGIFY_1(gxg_cairo_surface_get_device_w, gxg_cairo_surface_get_device)
-XEN_NARGIFY_6(gxg_cairo_surface_set_mime_data_w, gxg_cairo_surface_set_mime_data)
-XEN_NARGIFY_2(gxg_cairo_recording_surface_create_w, gxg_cairo_recording_surface_create)
-XEN_NARGIFY_5(gxg_cairo_recording_surface_ink_extents_w, gxg_cairo_recording_surface_ink_extents)
-XEN_NARGIFY_0(gxg_cairo_region_create_w, gxg_cairo_region_create)
-XEN_NARGIFY_1(gxg_cairo_region_create_rectangle_w, gxg_cairo_region_create_rectangle)
-XEN_NARGIFY_2(gxg_cairo_region_create_rectangles_w, gxg_cairo_region_create_rectangles)
-XEN_NARGIFY_1(gxg_cairo_region_copy_w, gxg_cairo_region_copy)
-XEN_NARGIFY_1(gxg_cairo_region_reference_w, gxg_cairo_region_reference)
-XEN_NARGIFY_1(gxg_cairo_region_destroy_w, gxg_cairo_region_destroy)
-XEN_NARGIFY_2(gxg_cairo_region_equal_w, gxg_cairo_region_equal)
-XEN_NARGIFY_1(gxg_cairo_region_status_w, gxg_cairo_region_status)
-XEN_NARGIFY_2(gxg_cairo_region_get_extents_w, gxg_cairo_region_get_extents)
-XEN_NARGIFY_1(gxg_cairo_region_num_rectangles_w, gxg_cairo_region_num_rectangles)
-XEN_NARGIFY_3(gxg_cairo_region_get_rectangle_w, gxg_cairo_region_get_rectangle)
-XEN_NARGIFY_1(gxg_cairo_region_is_empty_w, gxg_cairo_region_is_empty)
-XEN_NARGIFY_2(gxg_cairo_region_contains_rectangle_w, gxg_cairo_region_contains_rectangle)
-XEN_NARGIFY_3(gxg_cairo_region_contains_point_w, gxg_cairo_region_contains_point)
-XEN_NARGIFY_3(gxg_cairo_region_translate_w, gxg_cairo_region_translate)
-XEN_NARGIFY_2(gxg_cairo_region_subtract_w, gxg_cairo_region_subtract)
-XEN_NARGIFY_2(gxg_cairo_region_subtract_rectangle_w, gxg_cairo_region_subtract_rectangle)
-XEN_NARGIFY_2(gxg_cairo_region_intersect_w, gxg_cairo_region_intersect)
-XEN_NARGIFY_2(gxg_cairo_region_intersect_rectangle_w, gxg_cairo_region_intersect_rectangle)
-XEN_NARGIFY_2(gxg_cairo_region_union_w, gxg_cairo_region_union)
-XEN_NARGIFY_2(gxg_cairo_region_union_rectangle_w, gxg_cairo_region_union_rectangle)
-XEN_NARGIFY_2(gxg_cairo_region_xor_w, gxg_cairo_region_xor)
-XEN_NARGIFY_2(gxg_cairo_region_xor_rectangle_w, gxg_cairo_region_xor_rectangle)
+#if GTK_CHECK_VERSION(3, 12, 0)
+Xen_wrap_no_args(gxg_gtk_flow_box_child_new_w, gxg_gtk_flow_box_child_new)
+Xen_wrap_1_arg(gxg_gtk_flow_box_child_get_index_w, gxg_gtk_flow_box_child_get_index)
+Xen_wrap_1_arg(gxg_gtk_flow_box_child_is_selected_w, gxg_gtk_flow_box_child_is_selected)
+Xen_wrap_1_arg(gxg_gtk_flow_box_child_changed_w, gxg_gtk_flow_box_child_changed)
+Xen_wrap_no_args(gxg_gtk_flow_box_new_w, gxg_gtk_flow_box_new)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_homogeneous_w, gxg_gtk_flow_box_set_homogeneous)
+Xen_wrap_1_arg(gxg_gtk_flow_box_get_homogeneous_w, gxg_gtk_flow_box_get_homogeneous)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_row_spacing_w, gxg_gtk_flow_box_set_row_spacing)
+Xen_wrap_1_arg(gxg_gtk_flow_box_get_row_spacing_w, gxg_gtk_flow_box_get_row_spacing)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_column_spacing_w, gxg_gtk_flow_box_set_column_spacing)
+Xen_wrap_1_arg(gxg_gtk_flow_box_get_column_spacing_w, gxg_gtk_flow_box_get_column_spacing)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_min_children_per_line_w, gxg_gtk_flow_box_set_min_children_per_line)
+Xen_wrap_1_arg(gxg_gtk_flow_box_get_min_children_per_line_w, gxg_gtk_flow_box_get_min_children_per_line)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_max_children_per_line_w, gxg_gtk_flow_box_set_max_children_per_line)
+Xen_wrap_1_arg(gxg_gtk_flow_box_get_max_children_per_line_w, gxg_gtk_flow_box_get_max_children_per_line)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_activate_on_single_click_w, gxg_gtk_flow_box_set_activate_on_single_click)
+Xen_wrap_1_arg(gxg_gtk_flow_box_get_activate_on_single_click_w, gxg_gtk_flow_box_get_activate_on_single_click)
+Xen_wrap_3_args(gxg_gtk_flow_box_insert_w, gxg_gtk_flow_box_insert)
+Xen_wrap_2_args(gxg_gtk_flow_box_get_child_at_index_w, gxg_gtk_flow_box_get_child_at_index)
+Xen_wrap_1_arg(gxg_gtk_flow_box_get_selected_children_w, gxg_gtk_flow_box_get_selected_children)
+Xen_wrap_2_args(gxg_gtk_flow_box_select_child_w, gxg_gtk_flow_box_select_child)
+Xen_wrap_2_args(gxg_gtk_flow_box_unselect_child_w, gxg_gtk_flow_box_unselect_child)
+Xen_wrap_1_arg(gxg_gtk_flow_box_select_all_w, gxg_gtk_flow_box_select_all)
+Xen_wrap_1_arg(gxg_gtk_flow_box_unselect_all_w, gxg_gtk_flow_box_unselect_all)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_selection_mode_w, gxg_gtk_flow_box_set_selection_mode)
+Xen_wrap_1_arg(gxg_gtk_flow_box_get_selection_mode_w, gxg_gtk_flow_box_get_selection_mode)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_hadjustment_w, gxg_gtk_flow_box_set_hadjustment)
+Xen_wrap_2_args(gxg_gtk_flow_box_set_vadjustment_w, gxg_gtk_flow_box_set_vadjustment)
+Xen_wrap_1_arg(gxg_gtk_flow_box_invalidate_filter_w, gxg_gtk_flow_box_invalidate_filter)
+Xen_wrap_1_arg(gxg_gtk_flow_box_invalidate_sort_w, gxg_gtk_flow_box_invalidate_sort)
+Xen_wrap_2_args(gxg_gdk_window_set_event_compression_w, gxg_gdk_window_set_event_compression)
+Xen_wrap_1_arg(gxg_gdk_window_get_event_compression_w, gxg_gdk_window_get_event_compression)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_set_local_only_w, gxg_gtk_places_sidebar_set_local_only)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_get_local_only_w, gxg_gtk_places_sidebar_get_local_only)
+Xen_wrap_1_arg(gxg_gtk_stack_get_transition_running_w, gxg_gtk_stack_get_transition_running)
+Xen_wrap_1_arg(gxg_gtk_widget_get_margin_start_w, gxg_gtk_widget_get_margin_start)
+Xen_wrap_2_args(gxg_gtk_widget_set_margin_start_w, gxg_gtk_widget_set_margin_start)
+Xen_wrap_1_arg(gxg_gtk_widget_get_margin_end_w, gxg_gtk_widget_get_margin_end)
+Xen_wrap_2_args(gxg_gtk_widget_set_margin_end_w, gxg_gtk_widget_set_margin_end)
+Xen_wrap_3_optional_args(gxg_gtk_accel_label_get_accel_w, gxg_gtk_accel_label_get_accel)
+Xen_wrap_5_args(gxg_gdk_window_set_shadow_width_w, gxg_gdk_window_set_shadow_width)
+Xen_wrap_no_args(gxg_gtk_action_bar_new_w, gxg_gtk_action_bar_new)
+Xen_wrap_1_arg(gxg_gtk_action_bar_get_center_widget_w, gxg_gtk_action_bar_get_center_widget)
+Xen_wrap_2_args(gxg_gtk_action_bar_set_center_widget_w, gxg_gtk_action_bar_set_center_widget)
+Xen_wrap_2_args(gxg_gtk_action_bar_pack_start_w, gxg_gtk_action_bar_pack_start)
+Xen_wrap_2_args(gxg_gtk_action_bar_pack_end_w, gxg_gtk_action_bar_pack_end)
+Xen_wrap_2_args(gxg_gtk_header_bar_set_has_subtitle_w, gxg_gtk_header_bar_set_has_subtitle)
+Xen_wrap_1_arg(gxg_gtk_header_bar_get_has_subtitle_w, gxg_gtk_header_bar_get_has_subtitle)
+Xen_wrap_2_args(gxg_gtk_header_bar_set_decoration_layout_w, gxg_gtk_header_bar_set_decoration_layout)
+Xen_wrap_1_arg(gxg_gtk_header_bar_get_decoration_layout_w, gxg_gtk_header_bar_get_decoration_layout)
+Xen_wrap_1_arg(gxg_gtk_icon_info_is_symbolic_w, gxg_gtk_icon_info_is_symbolic)
+Xen_wrap_no_args(gxg_gtk_get_locale_direction_w, gxg_gtk_get_locale_direction)
+Xen_wrap_1_arg(gxg_gtk_window_is_maximized_w, gxg_gtk_window_is_maximized)
+Xen_wrap_1_arg(gxg_gtk_dialog_get_header_bar_w, gxg_gtk_dialog_get_header_bar)
+Xen_wrap_1_arg(gxg_gtk_popover_new_w, gxg_gtk_popover_new)
+Xen_wrap_2_args(gxg_gtk_popover_set_relative_to_w, gxg_gtk_popover_set_relative_to)
+Xen_wrap_1_arg(gxg_gtk_popover_get_relative_to_w, gxg_gtk_popover_get_relative_to)
+Xen_wrap_2_args(gxg_gtk_popover_set_position_w, gxg_gtk_popover_set_position)
+Xen_wrap_1_arg(gxg_gtk_popover_get_position_w, gxg_gtk_popover_get_position)
+Xen_wrap_2_args(gxg_gtk_popover_set_modal_w, gxg_gtk_popover_set_modal)
+Xen_wrap_1_arg(gxg_gtk_popover_get_modal_w, gxg_gtk_popover_get_modal)
+Xen_wrap_2_args(gxg_gtk_box_set_center_widget_w, gxg_gtk_box_set_center_widget)
+Xen_wrap_1_arg(gxg_gtk_box_get_center_widget_w, gxg_gtk_box_get_center_widget)
+Xen_wrap_2_args(gxg_gtk_entry_set_max_width_chars_w, gxg_gtk_entry_set_max_width_chars)
+Xen_wrap_1_arg(gxg_gtk_entry_get_max_width_chars_w, gxg_gtk_entry_get_max_width_chars)
+Xen_wrap_1_arg(gxg_gdk_device_get_last_event_window_w, gxg_gdk_device_get_last_event_window)
#endif
-XEN_NARGIFY_1(gxg_GPOINTER_w, gxg_GPOINTER)
-XEN_NARGIFY_2(c_array_to_xen_list_w, c_array_to_xen_list)
-XEN_NARGIFY_2(xen_list_to_c_array_w, xen_list_to_c_array)
-XEN_NARGIFY_1(gxg_make_target_entry_w, gxg_make_target_entry)
-XEN_NARGIFY_1(c_to_xen_string_w, c_to_xen_string)
-XEN_NARGIFY_3(xg_object_get_w, xg_object_get)
-XEN_NARGIFY_1(xg_gtk_event_keyval_w, xg_gtk_event_keyval)
-XEN_ARGIFY_2(gxg_gtk_init_w, gxg_gtk_init)
-XEN_ARGIFY_2(gxg_gtk_init_check_w, gxg_gtk_init_check)
-XEN_NARGIFY_1(gxg_GDK_DRAG_CONTEXT_w, gxg_GDK_DRAG_CONTEXT)
-XEN_NARGIFY_1(gxg_GDK_DEVICE_w, gxg_GDK_DEVICE)
-XEN_NARGIFY_1(gxg_GDK_KEYMAP_w, gxg_GDK_KEYMAP)
-XEN_NARGIFY_1(gxg_GDK_VISUAL_w, gxg_GDK_VISUAL)
-XEN_NARGIFY_1(gxg_GDK_WINDOW_w, gxg_GDK_WINDOW)
-XEN_NARGIFY_1(gxg_GDK_PIXBUF_w, gxg_GDK_PIXBUF)
-XEN_NARGIFY_1(gxg_GDK_PIXBUF_ANIMATION_w, gxg_GDK_PIXBUF_ANIMATION)
-XEN_NARGIFY_1(gxg_GDK_PIXBUF_ANIMATION_ITER_w, gxg_GDK_PIXBUF_ANIMATION_ITER)
-XEN_NARGIFY_1(gxg_GTK_VBOX_w, gxg_GTK_VBOX)
-XEN_NARGIFY_1(gxg_GTK_ACCEL_GROUP_w, gxg_GTK_ACCEL_GROUP)
-XEN_NARGIFY_1(gxg_GTK_ACCEL_LABEL_w, gxg_GTK_ACCEL_LABEL)
-XEN_NARGIFY_1(gxg_GTK_ACCESSIBLE_w, gxg_GTK_ACCESSIBLE)
-XEN_NARGIFY_1(gxg_GTK_ADJUSTMENT_w, gxg_GTK_ADJUSTMENT)
-XEN_NARGIFY_1(gxg_GTK_ALIGNMENT_w, gxg_GTK_ALIGNMENT)
-XEN_NARGIFY_1(gxg_GTK_ARROW_w, gxg_GTK_ARROW)
-XEN_NARGIFY_1(gxg_GTK_ASPECT_FRAME_w, gxg_GTK_ASPECT_FRAME)
-XEN_NARGIFY_1(gxg_GTK_BUTTON_BOX_w, gxg_GTK_BUTTON_BOX)
-XEN_NARGIFY_1(gxg_GTK_BIN_w, gxg_GTK_BIN)
-XEN_NARGIFY_1(gxg_GTK_BOX_w, gxg_GTK_BOX)
-XEN_NARGIFY_1(gxg_GTK_BUTTON_w, gxg_GTK_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_CALENDAR_w, gxg_GTK_CALENDAR)
-XEN_NARGIFY_1(gxg_GTK_CELL_EDITABLE_w, gxg_GTK_CELL_EDITABLE)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_w, gxg_GTK_CELL_RENDERER)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_PIXBUF_w, gxg_GTK_CELL_RENDERER_PIXBUF)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_TEXT_w, gxg_GTK_CELL_RENDERER_TEXT)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_TOGGLE_w, gxg_GTK_CELL_RENDERER_TOGGLE)
-XEN_NARGIFY_1(gxg_GTK_CHECK_BUTTON_w, gxg_GTK_CHECK_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_CHECK_MENU_ITEM_w, gxg_GTK_CHECK_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_COLOR_SELECTION_DIALOG_w, gxg_GTK_COLOR_SELECTION_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_COLOR_SELECTION_w, gxg_GTK_COLOR_SELECTION)
-XEN_NARGIFY_1(gxg_GTK_CONTAINER_w, gxg_GTK_CONTAINER)
-XEN_NARGIFY_1(gxg_GTK_DIALOG_w, gxg_GTK_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_DRAWING_AREA_w, gxg_GTK_DRAWING_AREA)
-XEN_NARGIFY_1(gxg_GTK_EDITABLE_w, gxg_GTK_EDITABLE)
-XEN_NARGIFY_1(gxg_GTK_ENTRY_w, gxg_GTK_ENTRY)
-XEN_NARGIFY_1(gxg_GTK_EVENT_BOX_w, gxg_GTK_EVENT_BOX)
-XEN_NARGIFY_1(gxg_GTK_FIXED_w, gxg_GTK_FIXED)
-XEN_NARGIFY_1(gxg_GTK_FONT_SELECTION_w, gxg_GTK_FONT_SELECTION)
-XEN_NARGIFY_1(gxg_GTK_FONT_SELECTION_DIALOG_w, gxg_GTK_FONT_SELECTION_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_FRAME_w, gxg_GTK_FRAME)
-XEN_NARGIFY_1(gxg_GTK_HANDLE_BOX_w, gxg_GTK_HANDLE_BOX)
-XEN_NARGIFY_1(gxg_GTK_HBUTTON_BOX_w, gxg_GTK_HBUTTON_BOX)
-XEN_NARGIFY_1(gxg_GTK_HBOX_w, gxg_GTK_HBOX)
-XEN_NARGIFY_1(gxg_GTK_HPANED_w, gxg_GTK_HPANED)
-XEN_NARGIFY_1(gxg_GTK_HSCALE_w, gxg_GTK_HSCALE)
-XEN_NARGIFY_1(gxg_GTK_HSCROLLBAR_w, gxg_GTK_HSCROLLBAR)
-XEN_NARGIFY_1(gxg_GTK_HSEPARATOR_w, gxg_GTK_HSEPARATOR)
-XEN_NARGIFY_1(gxg_GTK_ICON_FACTORY_w, gxg_GTK_ICON_FACTORY)
-XEN_NARGIFY_1(gxg_GTK_IMAGE_w, gxg_GTK_IMAGE)
-XEN_NARGIFY_1(gxg_GTK_IMAGE_MENU_ITEM_w, gxg_GTK_IMAGE_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IM_CONTEXT_w, gxg_GTK_IM_CONTEXT)
-XEN_NARGIFY_1(gxg_GTK_IM_CONTEXT_SIMPLE_w, gxg_GTK_IM_CONTEXT_SIMPLE)
-XEN_NARGIFY_1(gxg_GTK_IM_MULTICONTEXT_w, gxg_GTK_IM_MULTICONTEXT)
-XEN_NARGIFY_1(gxg_GTK_INVISIBLE_w, gxg_GTK_INVISIBLE)
-XEN_NARGIFY_1(gxg_GTK_LABEL_w, gxg_GTK_LABEL)
-XEN_NARGIFY_1(gxg_GTK_LAYOUT_w, gxg_GTK_LAYOUT)
-XEN_NARGIFY_1(gxg_GTK_LIST_STORE_w, gxg_GTK_LIST_STORE)
-XEN_NARGIFY_1(gxg_GTK_MENU_BAR_w, gxg_GTK_MENU_BAR)
-XEN_NARGIFY_1(gxg_GTK_MENU_w, gxg_GTK_MENU)
-XEN_NARGIFY_1(gxg_GTK_MENU_ITEM_w, gxg_GTK_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_MENU_SHELL_w, gxg_GTK_MENU_SHELL)
-XEN_NARGIFY_1(gxg_GTK_MISC_w, gxg_GTK_MISC)
-XEN_NARGIFY_1(gxg_GTK_NOTEBOOK_w, gxg_GTK_NOTEBOOK)
-XEN_NARGIFY_1(gxg_GTK_PANED_w, gxg_GTK_PANED)
-XEN_NARGIFY_1(gxg_GTK_PROGRESS_BAR_w, gxg_GTK_PROGRESS_BAR)
-XEN_NARGIFY_1(gxg_GTK_RADIO_BUTTON_w, gxg_GTK_RADIO_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_RADIO_MENU_ITEM_w, gxg_GTK_RADIO_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_RANGE_w, gxg_GTK_RANGE)
-XEN_NARGIFY_1(gxg_GTK_SCALE_w, gxg_GTK_SCALE)
-XEN_NARGIFY_1(gxg_GTK_SCROLLBAR_w, gxg_GTK_SCROLLBAR)
-XEN_NARGIFY_1(gxg_GTK_SCROLLED_WINDOW_w, gxg_GTK_SCROLLED_WINDOW)
-XEN_NARGIFY_1(gxg_GTK_SEPARATOR_w, gxg_GTK_SEPARATOR)
-XEN_NARGIFY_1(gxg_GTK_SEPARATOR_MENU_ITEM_w, gxg_GTK_SEPARATOR_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_SIZE_GROUP_w, gxg_GTK_SIZE_GROUP)
-XEN_NARGIFY_1(gxg_GTK_SPIN_BUTTON_w, gxg_GTK_SPIN_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_STATUSBAR_w, gxg_GTK_STATUSBAR)
-XEN_NARGIFY_1(gxg_GTK_TABLE_w, gxg_GTK_TABLE)
-XEN_NARGIFY_1(gxg_GTK_TEAROFF_MENU_ITEM_w, gxg_GTK_TEAROFF_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_TEXT_BUFFER_w, gxg_GTK_TEXT_BUFFER)
-XEN_NARGIFY_1(gxg_GTK_TEXT_CHILD_ANCHOR_w, gxg_GTK_TEXT_CHILD_ANCHOR)
-XEN_NARGIFY_1(gxg_GTK_TEXT_MARK_w, gxg_GTK_TEXT_MARK)
-XEN_NARGIFY_1(gxg_GTK_TEXT_TAG_w, gxg_GTK_TEXT_TAG)
-XEN_NARGIFY_1(gxg_GTK_TEXT_TAG_TABLE_w, gxg_GTK_TEXT_TAG_TABLE)
-XEN_NARGIFY_1(gxg_GTK_TEXT_VIEW_w, gxg_GTK_TEXT_VIEW)
-XEN_NARGIFY_1(gxg_GTK_TOGGLE_BUTTON_w, gxg_GTK_TOGGLE_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_TOOLBAR_w, gxg_GTK_TOOLBAR)
-XEN_NARGIFY_1(gxg_GTK_TREE_DRAG_SOURCE_w, gxg_GTK_TREE_DRAG_SOURCE)
-XEN_NARGIFY_1(gxg_GTK_TREE_DRAG_DEST_w, gxg_GTK_TREE_DRAG_DEST)
-XEN_NARGIFY_1(gxg_GTK_TREE_MODEL_w, gxg_GTK_TREE_MODEL)
-XEN_NARGIFY_1(gxg_GTK_TREE_MODEL_SORT_w, gxg_GTK_TREE_MODEL_SORT)
-XEN_NARGIFY_1(gxg_GTK_TREE_SELECTION_w, gxg_GTK_TREE_SELECTION)
-XEN_NARGIFY_1(gxg_GTK_TREE_SORTABLE_w, gxg_GTK_TREE_SORTABLE)
-XEN_NARGIFY_1(gxg_GTK_TREE_STORE_w, gxg_GTK_TREE_STORE)
-XEN_NARGIFY_1(gxg_GTK_TREE_VIEW_COLUMN_w, gxg_GTK_TREE_VIEW_COLUMN)
-XEN_NARGIFY_1(gxg_GTK_TREE_VIEW_w, gxg_GTK_TREE_VIEW)
-XEN_NARGIFY_1(gxg_GTK_VBUTTON_BOX_w, gxg_GTK_VBUTTON_BOX)
-XEN_NARGIFY_1(gxg_GTK_VIEWPORT_w, gxg_GTK_VIEWPORT)
-XEN_NARGIFY_1(gxg_GTK_VPANED_w, gxg_GTK_VPANED)
-XEN_NARGIFY_1(gxg_GTK_VSCALE_w, gxg_GTK_VSCALE)
-XEN_NARGIFY_1(gxg_GTK_VSCROLLBAR_w, gxg_GTK_VSCROLLBAR)
-XEN_NARGIFY_1(gxg_GTK_VSEPARATOR_w, gxg_GTK_VSEPARATOR)
-XEN_NARGIFY_1(gxg_GTK_WIDGET_w, gxg_GTK_WIDGET)
-XEN_NARGIFY_1(gxg_GTK_WINDOW_w, gxg_GTK_WINDOW)
-XEN_NARGIFY_1(gxg_PANGO_CONTEXT_w, gxg_PANGO_CONTEXT)
-XEN_NARGIFY_1(gxg_PANGO_FONT_FAMILY_w, gxg_PANGO_FONT_FAMILY)
-XEN_NARGIFY_1(gxg_PANGO_FONT_FACE_w, gxg_PANGO_FONT_FACE)
-XEN_NARGIFY_1(gxg_PANGO_FONT_w, gxg_PANGO_FONT)
-XEN_NARGIFY_1(gxg_PANGO_FONT_MAP_w, gxg_PANGO_FONT_MAP)
-XEN_NARGIFY_1(gxg_PANGO_LAYOUT_w, gxg_PANGO_LAYOUT)
-XEN_NARGIFY_1(gxg_G_OBJECT_w, gxg_G_OBJECT)
-XEN_NARGIFY_1(gxg_GDK_SCREEN_w, gxg_GDK_SCREEN)
-XEN_NARGIFY_1(gxg_GDK_DISPLAY_OBJECT_w, gxg_GDK_DISPLAY_OBJECT)
-XEN_NARGIFY_1(gxg_GDK_EVENT_w, gxg_GDK_EVENT)
-XEN_NARGIFY_1(gxg_GDK_EVENT_ANY_w, gxg_GDK_EVENT_ANY)
-XEN_NARGIFY_1(gxg_GDK_EVENT_EXPOSE_w, gxg_GDK_EVENT_EXPOSE)
-XEN_NARGIFY_1(gxg_GDK_EVENT_NOEXPOSE_w, gxg_GDK_EVENT_NOEXPOSE)
-XEN_NARGIFY_1(gxg_GDK_EVENT_VISIBILITY_w, gxg_GDK_EVENT_VISIBILITY)
-XEN_NARGIFY_1(gxg_GDK_EVENT_MOTION_w, gxg_GDK_EVENT_MOTION)
-XEN_NARGIFY_1(gxg_GDK_EVENT_BUTTON_w, gxg_GDK_EVENT_BUTTON)
-XEN_NARGIFY_1(gxg_GDK_EVENT_SCROLL_w, gxg_GDK_EVENT_SCROLL)
-XEN_NARGIFY_1(gxg_GDK_EVENT_KEY_w, gxg_GDK_EVENT_KEY)
-XEN_NARGIFY_1(gxg_GDK_EVENT_CROSSING_w, gxg_GDK_EVENT_CROSSING)
-XEN_NARGIFY_1(gxg_GDK_EVENT_FOCUS_w, gxg_GDK_EVENT_FOCUS)
-XEN_NARGIFY_1(gxg_GDK_EVENT_CONFIGURE_w, gxg_GDK_EVENT_CONFIGURE)
-XEN_NARGIFY_1(gxg_GDK_EVENT_PROPERTY_w, gxg_GDK_EVENT_PROPERTY)
-XEN_NARGIFY_1(gxg_GDK_EVENT_SELECTION_w, gxg_GDK_EVENT_SELECTION)
-XEN_NARGIFY_1(gxg_GDK_EVENT_PROXIMITY_w, gxg_GDK_EVENT_PROXIMITY)
-XEN_NARGIFY_1(gxg_GDK_EVENT_SETTING_w, gxg_GDK_EVENT_SETTING)
-XEN_NARGIFY_1(gxg_GDK_EVENT_WINDOWSTATE_w, gxg_GDK_EVENT_WINDOWSTATE)
-XEN_NARGIFY_1(gxg_GDK_EVENT_DND_w, gxg_GDK_EVENT_DND)
-XEN_NARGIFY_1(gxg_GTK_FILE_CHOOSER_DIALOG_w, gxg_GTK_FILE_CHOOSER_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_FILE_CHOOSER_WIDGET_w, gxg_GTK_FILE_CHOOSER_WIDGET)
-XEN_NARGIFY_1(gxg_GTK_TREE_MODEL_FILTER_w, gxg_GTK_TREE_MODEL_FILTER)
-XEN_NARGIFY_1(gxg_GTK_ACTION_w, gxg_GTK_ACTION)
-XEN_NARGIFY_1(gxg_GTK_ACTION_GROUP_w, gxg_GTK_ACTION_GROUP)
-XEN_NARGIFY_1(gxg_GTK_COMBO_BOX_w, gxg_GTK_COMBO_BOX)
-XEN_NARGIFY_1(gxg_GTK_EXPANDER_w, gxg_GTK_EXPANDER)
-XEN_NARGIFY_1(gxg_GTK_FONT_BUTTON_w, gxg_GTK_FONT_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_COLOR_BUTTON_w, gxg_GTK_COLOR_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_ENTRY_COMPLETION_w, gxg_GTK_ENTRY_COMPLETION)
-XEN_NARGIFY_1(gxg_GTK_RADIO_TOOL_BUTTON_w, gxg_GTK_RADIO_TOOL_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_RADIO_ACTION_w, gxg_GTK_RADIO_ACTION)
-XEN_NARGIFY_1(gxg_GTK_SEPARATOR_TOOL_ITEM_w, gxg_GTK_SEPARATOR_TOOL_ITEM)
-XEN_NARGIFY_1(gxg_GTK_TOGGLE_ACTION_w, gxg_GTK_TOGGLE_ACTION)
-XEN_NARGIFY_1(gxg_GTK_TOGGLE_TOOL_BUTTON_w, gxg_GTK_TOGGLE_TOOL_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_FILE_FILTER_w, gxg_GTK_FILE_FILTER)
-XEN_NARGIFY_1(gxg_GTK_CELL_LAYOUT_w, gxg_GTK_CELL_LAYOUT)
-XEN_NARGIFY_1(gxg_GTK_CLIPBOARD_w, gxg_GTK_CLIPBOARD)
-XEN_NARGIFY_1(gxg_GTK_FILE_CHOOSER_w, gxg_GTK_FILE_CHOOSER)
-XEN_NARGIFY_1(gxg_GTK_ICON_THEME_w, gxg_GTK_ICON_THEME)
-XEN_NARGIFY_1(gxg_GTK_TOOL_BUTTON_w, gxg_GTK_TOOL_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_TOOL_ITEM_w, gxg_GTK_TOOL_ITEM)
-XEN_NARGIFY_1(gxg_GTK_ACCEL_MAP_w, gxg_GTK_ACCEL_MAP)
-XEN_NARGIFY_1(gxg_GTK_CELL_VIEW_w, gxg_GTK_CELL_VIEW)
-XEN_NARGIFY_1(gxg_GTK_ABOUT_DIALOG_w, gxg_GTK_ABOUT_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_COMBO_w, gxg_GTK_CELL_RENDERER_COMBO)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_PROGRESS_w, gxg_GTK_CELL_RENDERER_PROGRESS)
-XEN_NARGIFY_1(gxg_GTK_ICON_VIEW_w, gxg_GTK_ICON_VIEW)
-XEN_NARGIFY_1(gxg_GTK_FILE_CHOOSER_BUTTON_w, gxg_GTK_FILE_CHOOSER_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_MENU_TOOL_BUTTON_w, gxg_GTK_MENU_TOOL_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_ASSISTANT_w, gxg_GTK_ASSISTANT)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_ACCEL_w, gxg_GTK_CELL_RENDERER_ACCEL)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_SPIN_w, gxg_GTK_CELL_RENDERER_SPIN)
-XEN_NARGIFY_1(gxg_GTK_LINK_BUTTON_w, gxg_GTK_LINK_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_RECENT_CHOOSER_DIALOG_w, gxg_GTK_RECENT_CHOOSER_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_RECENT_CHOOSER_w, gxg_GTK_RECENT_CHOOSER)
-XEN_NARGIFY_1(gxg_GTK_RECENT_CHOOSER_MENU_w, gxg_GTK_RECENT_CHOOSER_MENU)
-XEN_NARGIFY_1(gxg_GTK_RECENT_CHOOSER_WIDGET_w, gxg_GTK_RECENT_CHOOSER_WIDGET)
-XEN_NARGIFY_1(gxg_GTK_RECENT_FILTER_w, gxg_GTK_RECENT_FILTER)
-XEN_NARGIFY_1(gxg_GTK_RECENT_MANAGER_w, gxg_GTK_RECENT_MANAGER)
-XEN_NARGIFY_1(gxg_GTK_STATUS_ICON_w, gxg_GTK_STATUS_ICON)
-XEN_NARGIFY_1(gxg_GTK_PRINT_CONTEXT_w, gxg_GTK_PRINT_CONTEXT)
-XEN_NARGIFY_1(gxg_GTK_PRINT_OPERATION_w, gxg_GTK_PRINT_OPERATION)
-XEN_NARGIFY_1(gxg_GTK_PRINT_OPERATION_PREVIEW_w, gxg_GTK_PRINT_OPERATION_PREVIEW)
-XEN_NARGIFY_1(gxg_GTK_PRINT_SETTINGS_w, gxg_GTK_PRINT_SETTINGS)
-XEN_NARGIFY_1(gxg_GTK_TOOLTIP_w, gxg_GTK_TOOLTIP)
-#if HAVE_GTK_INFO_BAR_NEW
-XEN_NARGIFY_1(gxg_GTK_INFO_BAR_w, gxg_GTK_INFO_BAR)
+#if GTK_CHECK_VERSION(3, 14, 0)
+Xen_wrap_1_arg(gxg_gtk_list_box_row_is_selected_w, gxg_gtk_list_box_row_is_selected)
+Xen_wrap_2_args(gxg_gtk_list_box_unselect_row_w, gxg_gtk_list_box_unselect_row)
+Xen_wrap_1_arg(gxg_gtk_list_box_select_all_w, gxg_gtk_list_box_select_all)
+Xen_wrap_1_arg(gxg_gtk_list_box_unselect_all_w, gxg_gtk_list_box_unselect_all)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_get_show_enter_location_w, gxg_gtk_places_sidebar_get_show_enter_location)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_set_show_enter_location_w, gxg_gtk_places_sidebar_set_show_enter_location)
+Xen_wrap_2_args(gxg_gtk_switch_set_state_w, gxg_gtk_switch_set_state)
+Xen_wrap_1_arg(gxg_gtk_switch_get_state_w, gxg_gtk_switch_get_state)
+Xen_wrap_2_args(gxg_gdk_window_show_window_menu_w, gxg_gdk_window_show_window_menu)
+Xen_wrap_2_args(gxg_gtk_widget_set_clip_w, gxg_gtk_widget_set_clip)
+Xen_wrap_2_args(gxg_gtk_widget_get_clip_w, gxg_gtk_widget_get_clip)
+Xen_wrap_1_arg(gxg_gtk_gesture_get_device_w, gxg_gtk_gesture_get_device)
+Xen_wrap_2_args(gxg_gtk_gesture_set_state_w, gxg_gtk_gesture_set_state)
+Xen_wrap_2_args(gxg_gtk_gesture_get_sequence_state_w, gxg_gtk_gesture_get_sequence_state)
+Xen_wrap_3_args(gxg_gtk_gesture_set_sequence_state_w, gxg_gtk_gesture_set_sequence_state)
+Xen_wrap_1_arg(gxg_gtk_gesture_get_sequences_w, gxg_gtk_gesture_get_sequences)
+Xen_wrap_1_arg(gxg_gtk_gesture_get_last_updated_sequence_w, gxg_gtk_gesture_get_last_updated_sequence)
+Xen_wrap_2_args(gxg_gtk_gesture_handles_sequence_w, gxg_gtk_gesture_handles_sequence)
+Xen_wrap_2_args(gxg_gtk_gesture_get_last_event_w, gxg_gtk_gesture_get_last_event)
+Xen_wrap_4_optional_args(gxg_gtk_gesture_get_point_w, gxg_gtk_gesture_get_point)
+Xen_wrap_2_args(gxg_gtk_gesture_get_bounding_box_w, gxg_gtk_gesture_get_bounding_box)
+Xen_wrap_3_optional_args(gxg_gtk_gesture_get_bounding_box_center_w, gxg_gtk_gesture_get_bounding_box_center)
+Xen_wrap_1_arg(gxg_gtk_gesture_is_active_w, gxg_gtk_gesture_is_active)
+Xen_wrap_1_arg(gxg_gtk_gesture_is_recognized_w, gxg_gtk_gesture_is_recognized)
+Xen_wrap_1_arg(gxg_gtk_gesture_get_window_w, gxg_gtk_gesture_get_window)
+Xen_wrap_2_args(gxg_gtk_gesture_set_window_w, gxg_gtk_gesture_set_window)
+Xen_wrap_2_args(gxg_gtk_gesture_group_w, gxg_gtk_gesture_group)
+Xen_wrap_1_arg(gxg_gtk_gesture_ungroup_w, gxg_gtk_gesture_ungroup)
+Xen_wrap_1_arg(gxg_gtk_gesture_get_group_w, gxg_gtk_gesture_get_group)
+Xen_wrap_2_args(gxg_gtk_gesture_is_grouped_with_w, gxg_gtk_gesture_is_grouped_with)
+Xen_wrap_1_arg(gxg_gtk_gesture_drag_new_w, gxg_gtk_gesture_drag_new)
+Xen_wrap_3_optional_args(gxg_gtk_gesture_drag_get_start_point_w, gxg_gtk_gesture_drag_get_start_point)
+Xen_wrap_3_optional_args(gxg_gtk_gesture_drag_get_offset_w, gxg_gtk_gesture_drag_get_offset)
+Xen_wrap_1_arg(gxg_gtk_gesture_long_press_new_w, gxg_gtk_gesture_long_press_new)
+Xen_wrap_2_args(gxg_gtk_gesture_pan_new_w, gxg_gtk_gesture_pan_new)
+Xen_wrap_1_arg(gxg_gtk_gesture_pan_get_orientation_w, gxg_gtk_gesture_pan_get_orientation)
+Xen_wrap_2_args(gxg_gtk_gesture_pan_set_orientation_w, gxg_gtk_gesture_pan_set_orientation)
+Xen_wrap_1_arg(gxg_gtk_gesture_multi_press_new_w, gxg_gtk_gesture_multi_press_new)
+Xen_wrap_2_args(gxg_gtk_gesture_multi_press_set_area_w, gxg_gtk_gesture_multi_press_set_area)
+Xen_wrap_2_args(gxg_gtk_gesture_multi_press_get_area_w, gxg_gtk_gesture_multi_press_get_area)
+Xen_wrap_1_arg(gxg_gtk_gesture_rotate_new_w, gxg_gtk_gesture_rotate_new)
+Xen_wrap_1_arg(gxg_gtk_gesture_rotate_get_angle_delta_w, gxg_gtk_gesture_rotate_get_angle_delta)
+Xen_wrap_1_arg(gxg_gtk_gesture_single_get_touch_only_w, gxg_gtk_gesture_single_get_touch_only)
+Xen_wrap_2_args(gxg_gtk_gesture_single_set_touch_only_w, gxg_gtk_gesture_single_set_touch_only)
+Xen_wrap_1_arg(gxg_gtk_gesture_single_get_exclusive_w, gxg_gtk_gesture_single_get_exclusive)
+Xen_wrap_2_args(gxg_gtk_gesture_single_set_exclusive_w, gxg_gtk_gesture_single_set_exclusive)
+Xen_wrap_1_arg(gxg_gtk_gesture_single_get_button_w, gxg_gtk_gesture_single_get_button)
+Xen_wrap_2_args(gxg_gtk_gesture_single_set_button_w, gxg_gtk_gesture_single_set_button)
+Xen_wrap_1_arg(gxg_gtk_gesture_single_get_current_button_w, gxg_gtk_gesture_single_get_current_button)
+Xen_wrap_1_arg(gxg_gtk_gesture_single_get_current_sequence_w, gxg_gtk_gesture_single_get_current_sequence)
+Xen_wrap_1_arg(gxg_gtk_gesture_swipe_new_w, gxg_gtk_gesture_swipe_new)
+Xen_wrap_3_optional_args(gxg_gtk_gesture_swipe_get_velocity_w, gxg_gtk_gesture_swipe_get_velocity)
+Xen_wrap_1_arg(gxg_gtk_gesture_zoom_new_w, gxg_gtk_gesture_zoom_new)
+Xen_wrap_1_arg(gxg_gtk_gesture_zoom_get_scale_delta_w, gxg_gtk_gesture_zoom_get_scale_delta)
+Xen_wrap_1_arg(gxg_gtk_event_controller_get_widget_w, gxg_gtk_event_controller_get_widget)
+Xen_wrap_2_args(gxg_gtk_event_controller_handle_event_w, gxg_gtk_event_controller_handle_event)
+Xen_wrap_1_arg(gxg_gtk_event_controller_reset_w, gxg_gtk_event_controller_reset)
+Xen_wrap_1_arg(gxg_gtk_event_controller_get_propagation_phase_w, gxg_gtk_event_controller_get_propagation_phase)
+Xen_wrap_2_args(gxg_gtk_event_controller_set_propagation_phase_w, gxg_gtk_event_controller_set_propagation_phase)
+Xen_wrap_2_args(gxg_gtk_icon_theme_add_resource_path_w, gxg_gtk_icon_theme_add_resource_path)
+Xen_wrap_2_args(gxg_gtk_list_box_row_set_activatable_w, gxg_gtk_list_box_row_set_activatable)
+Xen_wrap_1_arg(gxg_gtk_list_box_row_get_activatable_w, gxg_gtk_list_box_row_get_activatable)
+Xen_wrap_2_args(gxg_gtk_list_box_row_set_selectable_w, gxg_gtk_list_box_row_set_selectable)
+Xen_wrap_1_arg(gxg_gtk_list_box_row_get_selectable_w, gxg_gtk_list_box_row_get_selectable)
+Xen_wrap_2_args(gxg_gtk_widget_path_iter_get_state_w, gxg_gtk_widget_path_iter_get_state)
+Xen_wrap_3_args(gxg_gtk_widget_path_iter_set_state_w, gxg_gtk_widget_path_iter_set_state)
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-XEN_NARGIFY_1(gxg_GTK_ENTRY_BUFFER_w, gxg_GTK_ENTRY_BUFFER)
+#if GTK_CHECK_VERSION(3, 16, 0)
+Xen_wrap_any_args(gxg_gdk_cairo_draw_from_gl_w, gxg_gdk_cairo_draw_from_gl)
+Xen_wrap_2_args(gxg_gdk_window_mark_paint_from_clip_w, gxg_gdk_window_mark_paint_from_clip)
+Xen_wrap_2_args(gxg_gtk_label_set_xalign_w, gxg_gtk_label_set_xalign)
+Xen_wrap_1_arg(gxg_gtk_label_get_xalign_w, gxg_gtk_label_get_xalign)
+Xen_wrap_2_args(gxg_gtk_label_set_yalign_w, gxg_gtk_label_set_yalign)
+Xen_wrap_1_arg(gxg_gtk_label_get_yalign_w, gxg_gtk_label_get_yalign)
+Xen_wrap_2_args(gxg_gtk_paned_set_wide_handle_w, gxg_gtk_paned_set_wide_handle)
+Xen_wrap_1_arg(gxg_gtk_paned_get_wide_handle_w, gxg_gtk_paned_get_wide_handle)
+Xen_wrap_2_args(gxg_gtk_scrolled_window_set_overlay_scrolling_w, gxg_gtk_scrolled_window_set_overlay_scrolling)
+Xen_wrap_1_arg(gxg_gtk_scrolled_window_get_overlay_scrolling_w, gxg_gtk_scrolled_window_get_overlay_scrolling)
+Xen_wrap_2_args(gxg_gtk_text_view_set_monospace_w, gxg_gtk_text_view_set_monospace)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_monospace_w, gxg_gtk_text_view_get_monospace)
+Xen_wrap_1_arg(gxg_gtk_window_get_titlebar_w, gxg_gtk_window_get_titlebar)
+Xen_wrap_no_args(gxg_gtk_gl_area_new_w, gxg_gtk_gl_area_new)
+Xen_wrap_1_arg(gxg_gtk_gl_area_get_has_alpha_w, gxg_gtk_gl_area_get_has_alpha)
+Xen_wrap_2_args(gxg_gtk_gl_area_set_has_alpha_w, gxg_gtk_gl_area_set_has_alpha)
+Xen_wrap_1_arg(gxg_gtk_gl_area_get_has_depth_buffer_w, gxg_gtk_gl_area_get_has_depth_buffer)
+Xen_wrap_2_args(gxg_gtk_gl_area_set_has_depth_buffer_w, gxg_gtk_gl_area_set_has_depth_buffer)
+Xen_wrap_1_arg(gxg_gtk_gl_area_get_context_w, gxg_gtk_gl_area_get_context)
+Xen_wrap_1_arg(gxg_gtk_gl_area_make_current_w, gxg_gtk_gl_area_make_current)
+Xen_wrap_6_args(gxg_gtk_render_check_w, gxg_gtk_render_check)
+Xen_wrap_6_args(gxg_gtk_render_option_w, gxg_gtk_render_option)
+Xen_wrap_6_args(gxg_gtk_render_arrow_w, gxg_gtk_render_arrow)
+Xen_wrap_6_args(gxg_gtk_render_background_w, gxg_gtk_render_background)
+Xen_wrap_6_args(gxg_gtk_render_frame_w, gxg_gtk_render_frame)
+Xen_wrap_6_args(gxg_gtk_render_expander_w, gxg_gtk_render_expander)
+Xen_wrap_6_args(gxg_gtk_render_focus_w, gxg_gtk_render_focus)
+Xen_wrap_5_args(gxg_gtk_render_layout_w, gxg_gtk_render_layout)
+Xen_wrap_6_args(gxg_gtk_render_line_w, gxg_gtk_render_line)
+Xen_wrap_7_args(gxg_gtk_render_slider_w, gxg_gtk_render_slider)
+Xen_wrap_any_args(gxg_gtk_render_frame_gap_w, gxg_gtk_render_frame_gap)
+Xen_wrap_7_args(gxg_gtk_render_extension_w, gxg_gtk_render_extension)
+Xen_wrap_6_args(gxg_gtk_render_handle_w, gxg_gtk_render_handle)
+Xen_wrap_6_args(gxg_gtk_render_activity_w, gxg_gtk_render_activity)
+Xen_wrap_5_args(gxg_gtk_render_icon_w, gxg_gtk_render_icon)
+Xen_wrap_5_args(gxg_gtk_render_icon_surface_w, gxg_gtk_render_icon_surface)
+Xen_wrap_1_arg(gxg_gdk_gl_context_get_window_w, gxg_gdk_gl_context_get_window)
+Xen_wrap_1_arg(gxg_gdk_gl_context_make_current_w, gxg_gdk_gl_context_make_current)
+Xen_wrap_no_args(gxg_gdk_gl_context_get_current_w, gxg_gdk_gl_context_get_current)
+Xen_wrap_no_args(gxg_gdk_gl_context_clear_current_w, gxg_gdk_gl_context_clear_current)
+Xen_wrap_2_args(gxg_gtk_stack_set_hhomogeneous_w, gxg_gtk_stack_set_hhomogeneous)
+Xen_wrap_1_arg(gxg_gtk_stack_get_hhomogeneous_w, gxg_gtk_stack_get_hhomogeneous)
+Xen_wrap_2_args(gxg_gtk_stack_set_vhomogeneous_w, gxg_gtk_stack_set_vhomogeneous)
+Xen_wrap_1_arg(gxg_gtk_stack_get_vhomogeneous_w, gxg_gtk_stack_get_vhomogeneous)
+Xen_wrap_1_arg(gxg_gdk_gl_context_get_display_w, gxg_gdk_gl_context_get_display)
+Xen_wrap_1_arg(gxg_gtk_gl_area_get_has_stencil_buffer_w, gxg_gtk_gl_area_get_has_stencil_buffer)
+Xen_wrap_2_args(gxg_gtk_gl_area_set_has_stencil_buffer_w, gxg_gtk_gl_area_set_has_stencil_buffer)
+Xen_wrap_1_arg(gxg_gtk_gl_area_get_auto_render_w, gxg_gtk_gl_area_get_auto_render)
+Xen_wrap_2_args(gxg_gtk_gl_area_set_auto_render_w, gxg_gtk_gl_area_set_auto_render)
+Xen_wrap_1_arg(gxg_gtk_gl_area_queue_render_w, gxg_gtk_gl_area_queue_render)
+Xen_wrap_1_arg(gxg_gtk_gl_area_attach_buffers_w, gxg_gtk_gl_area_attach_buffers)
+Xen_wrap_1_arg(gxg_gtk_gl_area_get_error_w, gxg_gtk_gl_area_get_error)
+Xen_wrap_no_args(gxg_gtk_popover_menu_new_w, gxg_gtk_popover_menu_new)
+Xen_wrap_2_args(gxg_gtk_popover_menu_open_submenu_w, gxg_gtk_popover_menu_open_submenu)
+Xen_wrap_1_arg(gxg_gtk_entry_grab_focus_without_selecting_w, gxg_gtk_entry_grab_focus_without_selecting)
+Xen_wrap_2_args(gxg_gtk_scrollable_get_border_w, gxg_gtk_scrollable_get_border)
+Xen_wrap_4_args(gxg_gtk_text_buffer_insert_markup_w, gxg_gtk_text_buffer_insert_markup)
+Xen_wrap_1_arg(gxg_gdk_device_get_vendor_id_w, gxg_gdk_device_get_vendor_id)
+Xen_wrap_1_arg(gxg_gdk_device_get_product_id_w, gxg_gdk_device_get_product_id)
+Xen_wrap_1_arg(gxg_gdk_gl_context_get_shared_context_w, gxg_gdk_gl_context_get_shared_context)
+Xen_wrap_3_args(gxg_gdk_gl_context_set_required_version_w, gxg_gdk_gl_context_set_required_version)
+Xen_wrap_3_optional_args(gxg_gdk_gl_context_get_required_version_w, gxg_gdk_gl_context_get_required_version)
+Xen_wrap_2_args(gxg_gdk_gl_context_set_debug_enabled_w, gxg_gdk_gl_context_set_debug_enabled)
+Xen_wrap_1_arg(gxg_gdk_gl_context_get_debug_enabled_w, gxg_gdk_gl_context_get_debug_enabled)
+Xen_wrap_2_args(gxg_gdk_gl_context_set_forward_compatible_w, gxg_gdk_gl_context_set_forward_compatible)
+Xen_wrap_1_arg(gxg_gdk_gl_context_get_forward_compatible_w, gxg_gdk_gl_context_get_forward_compatible)
+Xen_wrap_2_optional_args(gxg_gdk_gl_context_realize_w, gxg_gdk_gl_context_realize)
+Xen_wrap_1_arg(gxg_gtk_clipboard_get_default_w, gxg_gtk_clipboard_get_default)
+Xen_wrap_1_arg(gxg_gtk_drag_cancel_w, gxg_gtk_drag_cancel)
+Xen_wrap_2_args(gxg_gtk_search_entry_handle_event_w, gxg_gtk_search_entry_handle_event)
+Xen_wrap_3_optional_args(gxg_gdk_gl_context_get_version_w, gxg_gdk_gl_context_get_version)
+Xen_wrap_3_args(gxg_gtk_gl_area_set_required_version_w, gxg_gtk_gl_area_set_required_version)
+Xen_wrap_3_optional_args(gxg_gtk_gl_area_get_required_version_w, gxg_gtk_gl_area_get_required_version)
+Xen_wrap_2_args(gxg_gtk_notebook_detach_tab_w, gxg_gtk_notebook_detach_tab)
+Xen_wrap_no_args(gxg_gtk_stack_sidebar_new_w, gxg_gtk_stack_sidebar_new)
+Xen_wrap_2_args(gxg_gtk_stack_sidebar_set_stack_w, gxg_gtk_stack_sidebar_set_stack)
+Xen_wrap_1_arg(gxg_gtk_stack_sidebar_get_stack_w, gxg_gtk_stack_sidebar_get_stack)
+Xen_wrap_2_args(gxg_gtk_popover_set_transitions_enabled_w, gxg_gtk_popover_set_transitions_enabled)
+Xen_wrap_1_arg(gxg_gtk_popover_get_transitions_enabled_w, gxg_gtk_popover_get_transitions_enabled)
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-XEN_NARGIFY_1(gxg_GTK_SPINNER_w, gxg_GTK_SPINNER)
-XEN_NARGIFY_1(gxg_GTK_CELL_RENDERER_SPINNER_w, gxg_GTK_CELL_RENDERER_SPINNER)
-XEN_NARGIFY_1(gxg_GTK_TOOL_PALETTE_w, gxg_GTK_TOOL_PALETTE)
-XEN_NARGIFY_1(gxg_GTK_TOOL_ITEM_GROUP_w, gxg_GTK_TOOL_ITEM_GROUP)
+#if GTK_CHECK_VERSION(3, 18, 0)
+Xen_wrap_1_arg(gxg_gdk_keymap_get_scroll_lock_state_w, gxg_gdk_keymap_get_scroll_lock_state)
+Xen_wrap_2_args(gxg_gtk_radio_menu_item_join_group_w, gxg_gtk_radio_menu_item_join_group)
+Xen_wrap_2_args(gxg_gtk_font_chooser_set_font_map_w, gxg_gtk_font_chooser_set_font_map)
+Xen_wrap_1_arg(gxg_gtk_font_chooser_get_font_map_w, gxg_gtk_font_chooser_get_font_map)
+Xen_wrap_2_args(gxg_gtk_popover_set_default_widget_w, gxg_gtk_popover_set_default_widget)
+Xen_wrap_1_arg(gxg_gtk_popover_get_default_widget_w, gxg_gtk_popover_get_default_widget)
+Xen_wrap_2_args(gxg_gdk_window_set_pass_through_w, gxg_gdk_window_set_pass_through)
+Xen_wrap_1_arg(gxg_gdk_window_get_pass_through_w, gxg_gdk_window_get_pass_through)
+Xen_wrap_3_args(gxg_gtk_overlay_reorder_overlay_w, gxg_gtk_overlay_reorder_overlay)
+Xen_wrap_2_args(gxg_gtk_overlay_get_overlay_pass_through_w, gxg_gtk_overlay_get_overlay_pass_through)
+Xen_wrap_3_args(gxg_gtk_overlay_set_overlay_pass_through_w, gxg_gtk_overlay_set_overlay_pass_through)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_get_show_recent_w, gxg_gtk_places_sidebar_get_show_recent)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_set_show_recent_w, gxg_gtk_places_sidebar_set_show_recent)
+Xen_wrap_3_args(gxg_gtk_places_sidebar_set_drop_targets_visible_w, gxg_gtk_places_sidebar_set_drop_targets_visible)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_get_show_trash_w, gxg_gtk_places_sidebar_get_show_trash)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_set_show_trash_w, gxg_gtk_places_sidebar_set_show_trash)
+Xen_wrap_2_args(gxg_gtk_places_sidebar_set_show_other_locations_w, gxg_gtk_places_sidebar_set_show_other_locations)
+Xen_wrap_1_arg(gxg_gtk_places_sidebar_get_show_other_locations_w, gxg_gtk_places_sidebar_get_show_other_locations)
+Xen_wrap_2_args(gxg_gtk_stack_set_interpolate_size_w, gxg_gtk_stack_set_interpolate_size)
+Xen_wrap_1_arg(gxg_gtk_stack_get_interpolate_size_w, gxg_gtk_stack_get_interpolate_size)
+Xen_wrap_2_args(gxg_gtk_widget_set_font_options_w, gxg_gtk_widget_set_font_options)
+Xen_wrap_1_arg(gxg_gtk_widget_get_font_options_w, gxg_gtk_widget_get_font_options)
+Xen_wrap_2_args(gxg_gtk_widget_set_font_map_w, gxg_gtk_widget_set_font_map)
+Xen_wrap_1_arg(gxg_gtk_widget_get_font_map_w, gxg_gtk_widget_get_font_map)
+Xen_wrap_2_args(gxg_gdk_window_fullscreen_on_monitor_w, gxg_gdk_window_fullscreen_on_monitor)
+Xen_wrap_3_args(gxg_gtk_window_fullscreen_on_monitor_w, gxg_gtk_window_fullscreen_on_monitor)
+Xen_wrap_2_args(gxg_gtk_text_view_set_top_margin_w, gxg_gtk_text_view_set_top_margin)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_top_margin_w, gxg_gtk_text_view_get_top_margin)
+Xen_wrap_2_args(gxg_gtk_text_view_set_bottom_margin_w, gxg_gtk_text_view_set_bottom_margin)
+Xen_wrap_1_arg(gxg_gtk_text_view_get_bottom_margin_w, gxg_gtk_text_view_get_bottom_margin)
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-XEN_NARGIFY_1(gxg_GTK_COMBO_BOX_TEXT_w, gxg_GTK_COMBO_BOX_TEXT)
-XEN_NARGIFY_1(gxg_GTK_GRID_w, gxg_GTK_GRID)
-XEN_NARGIFY_1(gxg_GTK_SCROLLABLE_w, gxg_GTK_SCROLLABLE)
-XEN_NARGIFY_1(gxg_GTK_SWITCH_w, gxg_GTK_SWITCH)
-XEN_NARGIFY_1(gxg_GTK_ACTIVATABLE_w, gxg_GTK_ACTIVATABLE)
-XEN_NARGIFY_1(gxg_GTK_ORIENTABLE_w, gxg_GTK_ORIENTABLE)
-XEN_NARGIFY_1(gxg_GTK_WINDOW_GROUP_w, gxg_GTK_WINDOW_GROUP)
-XEN_NARGIFY_1(gxg_GTK_TOOL_SHELL_w, gxg_GTK_TOOL_SHELL)
+#if GTK_CHECK_VERSION(3, 20, 0)
+Xen_wrap_1_arg(gxg_gdk_gl_context_is_legacy_w, gxg_gdk_gl_context_is_legacy)
+Xen_wrap_1_arg(gxg_gdk_rectangle_equal_w, gxg_gdk_rectangle_equal)
+Xen_wrap_2_args(gxg_gtk_application_window_set_help_overlay_w, gxg_gtk_application_window_set_help_overlay)
+Xen_wrap_2_args(gxg_gtk_settings_reset_property_w, gxg_gtk_settings_reset_property)
+Xen_wrap_2_args(gxg_gtk_text_tag_changed_w, gxg_gtk_text_tag_changed)
+Xen_wrap_2_args(gxg_gtk_widget_path_iter_get_object_name_w, gxg_gtk_widget_path_iter_get_object_name)
+Xen_wrap_3_args(gxg_gtk_widget_path_iter_set_object_name_w, gxg_gtk_widget_path_iter_set_object_name)
+Xen_wrap_1_arg(gxg_gtk_widget_queue_allocate_w, gxg_gtk_widget_queue_allocate)
+Xen_wrap_2_args(gxg_gtk_widget_set_focus_on_click_w, gxg_gtk_widget_set_focus_on_click)
+Xen_wrap_1_arg(gxg_gtk_widget_get_focus_on_click_w, gxg_gtk_widget_get_focus_on_click)
+Xen_wrap_3_optional_args(gxg_gtk_widget_get_allocated_size_w, gxg_gtk_widget_get_allocated_size)
#endif
-#if (!HAVE_GTK_3)
-XEN_NARGIFY_1(gxg_GDK_COLORMAP_w, gxg_GDK_COLORMAP)
-XEN_NARGIFY_1(gxg_GDK_DRAWABLE_w, gxg_GDK_DRAWABLE)
-XEN_NARGIFY_1(gxg_GDK_PIXMAP_w, gxg_GDK_PIXMAP)
-XEN_NARGIFY_1(gxg_GTK_OBJECT_w, gxg_GTK_OBJECT)
-XEN_NARGIFY_1(gxg_GTK_STYLE_w, gxg_GTK_STYLE)
+Xen_wrap_1_arg(gxg_cairo_create_w, gxg_cairo_create)
+Xen_wrap_no_args(gxg_cairo_version_w, gxg_cairo_version)
+Xen_wrap_no_args(gxg_cairo_version_string_w, gxg_cairo_version_string)
+Xen_wrap_1_arg(gxg_cairo_reference_w, gxg_cairo_reference)
+Xen_wrap_1_arg(gxg_cairo_destroy_w, gxg_cairo_destroy)
+Xen_wrap_1_arg(gxg_cairo_save_w, gxg_cairo_save)
+Xen_wrap_1_arg(gxg_cairo_restore_w, gxg_cairo_restore)
+Xen_wrap_1_arg(gxg_cairo_push_group_w, gxg_cairo_push_group)
+Xen_wrap_2_args(gxg_cairo_push_group_with_content_w, gxg_cairo_push_group_with_content)
+Xen_wrap_1_arg(gxg_cairo_pop_group_w, gxg_cairo_pop_group)
+Xen_wrap_1_arg(gxg_cairo_pop_group_to_source_w, gxg_cairo_pop_group_to_source)
+Xen_wrap_2_args(gxg_cairo_set_operator_w, gxg_cairo_set_operator)
+Xen_wrap_2_args(gxg_cairo_set_source_w, gxg_cairo_set_source)
+Xen_wrap_4_args(gxg_cairo_set_source_rgb_w, gxg_cairo_set_source_rgb)
+Xen_wrap_5_args(gxg_cairo_set_source_rgba_w, gxg_cairo_set_source_rgba)
+Xen_wrap_4_args(gxg_cairo_set_source_surface_w, gxg_cairo_set_source_surface)
+Xen_wrap_2_args(gxg_cairo_set_tolerance_w, gxg_cairo_set_tolerance)
+Xen_wrap_2_args(gxg_cairo_set_antialias_w, gxg_cairo_set_antialias)
+Xen_wrap_2_args(gxg_cairo_set_fill_rule_w, gxg_cairo_set_fill_rule)
+Xen_wrap_2_args(gxg_cairo_set_line_width_w, gxg_cairo_set_line_width)
+Xen_wrap_2_args(gxg_cairo_set_line_cap_w, gxg_cairo_set_line_cap)
+Xen_wrap_2_args(gxg_cairo_set_line_join_w, gxg_cairo_set_line_join)
+Xen_wrap_4_args(gxg_cairo_set_dash_w, gxg_cairo_set_dash)
+Xen_wrap_2_args(gxg_cairo_set_miter_limit_w, gxg_cairo_set_miter_limit)
+Xen_wrap_3_args(gxg_cairo_translate_w, gxg_cairo_translate)
+Xen_wrap_3_args(gxg_cairo_scale_w, gxg_cairo_scale)
+Xen_wrap_2_args(gxg_cairo_rotate_w, gxg_cairo_rotate)
+Xen_wrap_2_args(gxg_cairo_transform_w, gxg_cairo_transform)
+Xen_wrap_2_args(gxg_cairo_set_matrix_w, gxg_cairo_set_matrix)
+Xen_wrap_1_arg(gxg_cairo_identity_matrix_w, gxg_cairo_identity_matrix)
+Xen_wrap_3_optional_args(gxg_cairo_user_to_device_w, gxg_cairo_user_to_device)
+Xen_wrap_3_optional_args(gxg_cairo_user_to_device_distance_w, gxg_cairo_user_to_device_distance)
+Xen_wrap_3_optional_args(gxg_cairo_device_to_user_w, gxg_cairo_device_to_user)
+Xen_wrap_3_optional_args(gxg_cairo_device_to_user_distance_w, gxg_cairo_device_to_user_distance)
+Xen_wrap_1_arg(gxg_cairo_new_path_w, gxg_cairo_new_path)
+Xen_wrap_3_args(gxg_cairo_move_to_w, gxg_cairo_move_to)
+Xen_wrap_1_arg(gxg_cairo_new_sub_path_w, gxg_cairo_new_sub_path)
+Xen_wrap_3_args(gxg_cairo_line_to_w, gxg_cairo_line_to)
+Xen_wrap_7_args(gxg_cairo_curve_to_w, gxg_cairo_curve_to)
+Xen_wrap_6_args(gxg_cairo_arc_w, gxg_cairo_arc)
+Xen_wrap_6_args(gxg_cairo_arc_negative_w, gxg_cairo_arc_negative)
+Xen_wrap_3_args(gxg_cairo_rel_move_to_w, gxg_cairo_rel_move_to)
+Xen_wrap_3_args(gxg_cairo_rel_line_to_w, gxg_cairo_rel_line_to)
+Xen_wrap_7_args(gxg_cairo_rel_curve_to_w, gxg_cairo_rel_curve_to)
+Xen_wrap_5_args(gxg_cairo_rectangle_w, gxg_cairo_rectangle)
+Xen_wrap_1_arg(gxg_cairo_close_path_w, gxg_cairo_close_path)
+Xen_wrap_1_arg(gxg_cairo_paint_w, gxg_cairo_paint)
+Xen_wrap_2_args(gxg_cairo_paint_with_alpha_w, gxg_cairo_paint_with_alpha)
+Xen_wrap_2_args(gxg_cairo_mask_w, gxg_cairo_mask)
+Xen_wrap_4_args(gxg_cairo_mask_surface_w, gxg_cairo_mask_surface)
+Xen_wrap_1_arg(gxg_cairo_stroke_w, gxg_cairo_stroke)
+Xen_wrap_1_arg(gxg_cairo_stroke_preserve_w, gxg_cairo_stroke_preserve)
+Xen_wrap_1_arg(gxg_cairo_fill_w, gxg_cairo_fill)
+Xen_wrap_1_arg(gxg_cairo_fill_preserve_w, gxg_cairo_fill_preserve)
+Xen_wrap_1_arg(gxg_cairo_copy_page_w, gxg_cairo_copy_page)
+Xen_wrap_1_arg(gxg_cairo_show_page_w, gxg_cairo_show_page)
+Xen_wrap_3_args(gxg_cairo_in_stroke_w, gxg_cairo_in_stroke)
+Xen_wrap_3_args(gxg_cairo_in_fill_w, gxg_cairo_in_fill)
+Xen_wrap_1_arg(gxg_cairo_reset_clip_w, gxg_cairo_reset_clip)
+Xen_wrap_1_arg(gxg_cairo_clip_w, gxg_cairo_clip)
+Xen_wrap_1_arg(gxg_cairo_clip_preserve_w, gxg_cairo_clip_preserve)
+Xen_wrap_no_args(gxg_cairo_font_options_create_w, gxg_cairo_font_options_create)
+Xen_wrap_1_arg(gxg_cairo_font_options_copy_w, gxg_cairo_font_options_copy)
+Xen_wrap_1_arg(gxg_cairo_font_options_destroy_w, gxg_cairo_font_options_destroy)
+Xen_wrap_1_arg(gxg_cairo_font_options_status_w, gxg_cairo_font_options_status)
+Xen_wrap_2_args(gxg_cairo_font_options_merge_w, gxg_cairo_font_options_merge)
+Xen_wrap_2_args(gxg_cairo_font_options_equal_w, gxg_cairo_font_options_equal)
+Xen_wrap_1_arg(gxg_cairo_font_options_hash_w, gxg_cairo_font_options_hash)
+Xen_wrap_2_args(gxg_cairo_font_options_set_antialias_w, gxg_cairo_font_options_set_antialias)
+Xen_wrap_1_arg(gxg_cairo_font_options_get_antialias_w, gxg_cairo_font_options_get_antialias)
+Xen_wrap_2_args(gxg_cairo_font_options_set_subpixel_order_w, gxg_cairo_font_options_set_subpixel_order)
+Xen_wrap_1_arg(gxg_cairo_font_options_get_subpixel_order_w, gxg_cairo_font_options_get_subpixel_order)
+Xen_wrap_2_args(gxg_cairo_font_options_set_hint_style_w, gxg_cairo_font_options_set_hint_style)
+Xen_wrap_1_arg(gxg_cairo_font_options_get_hint_style_w, gxg_cairo_font_options_get_hint_style)
+Xen_wrap_2_args(gxg_cairo_font_options_set_hint_metrics_w, gxg_cairo_font_options_set_hint_metrics)
+Xen_wrap_1_arg(gxg_cairo_font_options_get_hint_metrics_w, gxg_cairo_font_options_get_hint_metrics)
+Xen_wrap_4_args(gxg_cairo_select_font_face_w, gxg_cairo_select_font_face)
+Xen_wrap_2_args(gxg_cairo_set_font_size_w, gxg_cairo_set_font_size)
+Xen_wrap_2_args(gxg_cairo_set_font_matrix_w, gxg_cairo_set_font_matrix)
+Xen_wrap_2_args(gxg_cairo_get_font_matrix_w, gxg_cairo_get_font_matrix)
+Xen_wrap_2_args(gxg_cairo_set_font_options_w, gxg_cairo_set_font_options)
+Xen_wrap_2_args(gxg_cairo_get_font_options_w, gxg_cairo_get_font_options)
+Xen_wrap_2_args(gxg_cairo_set_scaled_font_w, gxg_cairo_set_scaled_font)
+Xen_wrap_2_args(gxg_cairo_show_text_w, gxg_cairo_show_text)
+Xen_wrap_3_args(gxg_cairo_show_glyphs_w, gxg_cairo_show_glyphs)
+Xen_wrap_1_arg(gxg_cairo_get_font_face_w, gxg_cairo_get_font_face)
+Xen_wrap_2_args(gxg_cairo_font_extents_w, gxg_cairo_font_extents)
+Xen_wrap_2_args(gxg_cairo_set_font_face_w, gxg_cairo_set_font_face)
+Xen_wrap_3_args(gxg_cairo_text_extents_w, gxg_cairo_text_extents)
+Xen_wrap_4_args(gxg_cairo_glyph_extents_w, gxg_cairo_glyph_extents)
+Xen_wrap_2_args(gxg_cairo_text_path_w, gxg_cairo_text_path)
+Xen_wrap_3_args(gxg_cairo_glyph_path_w, gxg_cairo_glyph_path)
+Xen_wrap_1_arg(gxg_cairo_font_face_reference_w, gxg_cairo_font_face_reference)
+Xen_wrap_1_arg(gxg_cairo_font_face_destroy_w, gxg_cairo_font_face_destroy)
+Xen_wrap_1_arg(gxg_cairo_font_face_status_w, gxg_cairo_font_face_status)
+Xen_wrap_2_args(gxg_cairo_font_face_get_user_data_w, gxg_cairo_font_face_get_user_data)
+Xen_wrap_4_args(gxg_cairo_font_face_set_user_data_w, gxg_cairo_font_face_set_user_data)
+Xen_wrap_4_args(gxg_cairo_scaled_font_create_w, gxg_cairo_scaled_font_create)
+Xen_wrap_1_arg(gxg_cairo_scaled_font_reference_w, gxg_cairo_scaled_font_reference)
+Xen_wrap_1_arg(gxg_cairo_scaled_font_destroy_w, gxg_cairo_scaled_font_destroy)
+Xen_wrap_1_arg(gxg_cairo_scaled_font_status_w, gxg_cairo_scaled_font_status)
+Xen_wrap_2_args(gxg_cairo_scaled_font_extents_w, gxg_cairo_scaled_font_extents)
+Xen_wrap_3_args(gxg_cairo_scaled_font_text_extents_w, gxg_cairo_scaled_font_text_extents)
+Xen_wrap_4_args(gxg_cairo_scaled_font_glyph_extents_w, gxg_cairo_scaled_font_glyph_extents)
+Xen_wrap_1_arg(gxg_cairo_scaled_font_get_font_face_w, gxg_cairo_scaled_font_get_font_face)
+Xen_wrap_2_args(gxg_cairo_scaled_font_get_font_matrix_w, gxg_cairo_scaled_font_get_font_matrix)
+Xen_wrap_2_args(gxg_cairo_scaled_font_get_ctm_w, gxg_cairo_scaled_font_get_ctm)
+Xen_wrap_2_args(gxg_cairo_scaled_font_get_font_options_w, gxg_cairo_scaled_font_get_font_options)
+Xen_wrap_1_arg(gxg_cairo_get_operator_w, gxg_cairo_get_operator)
+Xen_wrap_1_arg(gxg_cairo_get_source_w, gxg_cairo_get_source)
+Xen_wrap_1_arg(gxg_cairo_get_tolerance_w, gxg_cairo_get_tolerance)
+Xen_wrap_1_arg(gxg_cairo_get_antialias_w, gxg_cairo_get_antialias)
+Xen_wrap_3_optional_args(gxg_cairo_get_current_point_w, gxg_cairo_get_current_point)
+Xen_wrap_1_arg(gxg_cairo_get_fill_rule_w, gxg_cairo_get_fill_rule)
+Xen_wrap_1_arg(gxg_cairo_get_line_width_w, gxg_cairo_get_line_width)
+Xen_wrap_1_arg(gxg_cairo_get_line_cap_w, gxg_cairo_get_line_cap)
+Xen_wrap_1_arg(gxg_cairo_get_line_join_w, gxg_cairo_get_line_join)
+Xen_wrap_1_arg(gxg_cairo_get_miter_limit_w, gxg_cairo_get_miter_limit)
+Xen_wrap_2_args(gxg_cairo_get_matrix_w, gxg_cairo_get_matrix)
+Xen_wrap_1_arg(gxg_cairo_get_target_w, gxg_cairo_get_target)
+Xen_wrap_1_arg(gxg_cairo_get_group_target_w, gxg_cairo_get_group_target)
+Xen_wrap_1_arg(gxg_cairo_copy_path_w, gxg_cairo_copy_path)
+Xen_wrap_1_arg(gxg_cairo_copy_path_flat_w, gxg_cairo_copy_path_flat)
+Xen_wrap_2_args(gxg_cairo_append_path_w, gxg_cairo_append_path)
+Xen_wrap_1_arg(gxg_cairo_path_destroy_w, gxg_cairo_path_destroy)
+Xen_wrap_1_arg(gxg_cairo_status_w, gxg_cairo_status)
+Xen_wrap_1_arg(gxg_cairo_status_to_string_w, gxg_cairo_status_to_string)
+Xen_wrap_4_args(gxg_cairo_surface_create_similar_w, gxg_cairo_surface_create_similar)
+Xen_wrap_1_arg(gxg_cairo_surface_reference_w, gxg_cairo_surface_reference)
+Xen_wrap_1_arg(gxg_cairo_surface_finish_w, gxg_cairo_surface_finish)
+Xen_wrap_1_arg(gxg_cairo_surface_destroy_w, gxg_cairo_surface_destroy)
+Xen_wrap_1_arg(gxg_cairo_surface_status_w, gxg_cairo_surface_status)
+Xen_wrap_1_arg(gxg_cairo_surface_get_content_w, gxg_cairo_surface_get_content)
+Xen_wrap_2_args(gxg_cairo_surface_get_user_data_w, gxg_cairo_surface_get_user_data)
+Xen_wrap_4_args(gxg_cairo_surface_set_user_data_w, gxg_cairo_surface_set_user_data)
+Xen_wrap_2_args(gxg_cairo_surface_get_font_options_w, gxg_cairo_surface_get_font_options)
+Xen_wrap_1_arg(gxg_cairo_surface_flush_w, gxg_cairo_surface_flush)
+Xen_wrap_1_arg(gxg_cairo_surface_mark_dirty_w, gxg_cairo_surface_mark_dirty)
+Xen_wrap_5_args(gxg_cairo_surface_mark_dirty_rectangle_w, gxg_cairo_surface_mark_dirty_rectangle)
+Xen_wrap_3_args(gxg_cairo_surface_set_device_offset_w, gxg_cairo_surface_set_device_offset)
+Xen_wrap_3_optional_args(gxg_cairo_surface_get_device_offset_w, gxg_cairo_surface_get_device_offset)
+Xen_wrap_3_args(gxg_cairo_surface_set_fallback_resolution_w, gxg_cairo_surface_set_fallback_resolution)
+Xen_wrap_3_args(gxg_cairo_image_surface_create_w, gxg_cairo_image_surface_create)
+Xen_wrap_5_args(gxg_cairo_image_surface_create_for_data_w, gxg_cairo_image_surface_create_for_data)
+Xen_wrap_1_arg(gxg_cairo_image_surface_get_data_w, gxg_cairo_image_surface_get_data)
+Xen_wrap_1_arg(gxg_cairo_image_surface_get_format_w, gxg_cairo_image_surface_get_format)
+Xen_wrap_1_arg(gxg_cairo_image_surface_get_width_w, gxg_cairo_image_surface_get_width)
+Xen_wrap_1_arg(gxg_cairo_image_surface_get_height_w, gxg_cairo_image_surface_get_height)
+Xen_wrap_1_arg(gxg_cairo_image_surface_get_stride_w, gxg_cairo_image_surface_get_stride)
+Xen_wrap_3_args(gxg_cairo_pattern_create_rgb_w, gxg_cairo_pattern_create_rgb)
+Xen_wrap_4_args(gxg_cairo_pattern_create_rgba_w, gxg_cairo_pattern_create_rgba)
+Xen_wrap_1_arg(gxg_cairo_pattern_create_for_surface_w, gxg_cairo_pattern_create_for_surface)
+Xen_wrap_4_args(gxg_cairo_pattern_create_linear_w, gxg_cairo_pattern_create_linear)
+Xen_wrap_6_args(gxg_cairo_pattern_create_radial_w, gxg_cairo_pattern_create_radial)
+Xen_wrap_1_arg(gxg_cairo_pattern_reference_w, gxg_cairo_pattern_reference)
+Xen_wrap_1_arg(gxg_cairo_pattern_destroy_w, gxg_cairo_pattern_destroy)
+Xen_wrap_1_arg(gxg_cairo_pattern_status_w, gxg_cairo_pattern_status)
+Xen_wrap_5_args(gxg_cairo_pattern_add_color_stop_rgb_w, gxg_cairo_pattern_add_color_stop_rgb)
+Xen_wrap_6_args(gxg_cairo_pattern_add_color_stop_rgba_w, gxg_cairo_pattern_add_color_stop_rgba)
+Xen_wrap_2_args(gxg_cairo_pattern_set_matrix_w, gxg_cairo_pattern_set_matrix)
+Xen_wrap_2_args(gxg_cairo_pattern_get_matrix_w, gxg_cairo_pattern_get_matrix)
+Xen_wrap_2_args(gxg_cairo_pattern_set_extend_w, gxg_cairo_pattern_set_extend)
+Xen_wrap_1_arg(gxg_cairo_pattern_get_extend_w, gxg_cairo_pattern_get_extend)
+Xen_wrap_2_args(gxg_cairo_pattern_set_filter_w, gxg_cairo_pattern_set_filter)
+Xen_wrap_1_arg(gxg_cairo_pattern_get_filter_w, gxg_cairo_pattern_get_filter)
+Xen_wrap_7_args(gxg_cairo_matrix_init_w, gxg_cairo_matrix_init)
+Xen_wrap_1_arg(gxg_cairo_matrix_init_identity_w, gxg_cairo_matrix_init_identity)
+Xen_wrap_3_args(gxg_cairo_matrix_init_translate_w, gxg_cairo_matrix_init_translate)
+Xen_wrap_3_args(gxg_cairo_matrix_init_scale_w, gxg_cairo_matrix_init_scale)
+Xen_wrap_2_args(gxg_cairo_matrix_init_rotate_w, gxg_cairo_matrix_init_rotate)
+Xen_wrap_3_args(gxg_cairo_matrix_translate_w, gxg_cairo_matrix_translate)
+Xen_wrap_3_args(gxg_cairo_matrix_scale_w, gxg_cairo_matrix_scale)
+Xen_wrap_2_args(gxg_cairo_matrix_rotate_w, gxg_cairo_matrix_rotate)
+Xen_wrap_1_arg(gxg_cairo_matrix_invert_w, gxg_cairo_matrix_invert)
+Xen_wrap_3_args(gxg_cairo_matrix_multiply_w, gxg_cairo_matrix_multiply)
+Xen_wrap_3_optional_args(gxg_cairo_matrix_transform_distance_w, gxg_cairo_matrix_transform_distance)
+Xen_wrap_3_optional_args(gxg_cairo_matrix_transform_point_w, gxg_cairo_matrix_transform_point)
+Xen_wrap_1_arg(gxg_cairo_get_reference_count_w, gxg_cairo_get_reference_count)
+Xen_wrap_2_args(gxg_cairo_get_user_data_w, gxg_cairo_get_user_data)
+Xen_wrap_4_args(gxg_cairo_set_user_data_w, gxg_cairo_set_user_data)
+Xen_wrap_5_optional_args(gxg_cairo_clip_extents_w, gxg_cairo_clip_extents)
+Xen_wrap_1_arg(gxg_cairo_copy_clip_rectangle_list_w, gxg_cairo_copy_clip_rectangle_list)
+Xen_wrap_1_arg(gxg_cairo_rectangle_list_destroy_w, gxg_cairo_rectangle_list_destroy)
+Xen_wrap_1_arg(gxg_cairo_font_face_get_reference_count_w, gxg_cairo_font_face_get_reference_count)
+Xen_wrap_1_arg(gxg_cairo_scaled_font_get_reference_count_w, gxg_cairo_scaled_font_get_reference_count)
+Xen_wrap_2_args(gxg_cairo_scaled_font_get_user_data_w, gxg_cairo_scaled_font_get_user_data)
+Xen_wrap_4_args(gxg_cairo_scaled_font_set_user_data_w, gxg_cairo_scaled_font_set_user_data)
+Xen_wrap_1_arg(gxg_cairo_get_dash_count_w, gxg_cairo_get_dash_count)
+Xen_wrap_3_optional_args(gxg_cairo_get_dash_w, gxg_cairo_get_dash)
+Xen_wrap_1_arg(gxg_cairo_surface_get_reference_count_w, gxg_cairo_surface_get_reference_count)
+Xen_wrap_1_arg(gxg_cairo_pattern_get_reference_count_w, gxg_cairo_pattern_get_reference_count)
+Xen_wrap_2_args(gxg_cairo_pattern_get_user_data_w, gxg_cairo_pattern_get_user_data)
+Xen_wrap_4_args(gxg_cairo_pattern_set_user_data_w, gxg_cairo_pattern_set_user_data)
+Xen_wrap_5_optional_args(gxg_cairo_pattern_get_rgba_w, gxg_cairo_pattern_get_rgba)
+Xen_wrap_2_optional_args(gxg_cairo_pattern_get_surface_w, gxg_cairo_pattern_get_surface)
+Xen_wrap_7_optional_args(gxg_cairo_pattern_get_color_stop_rgba_w, gxg_cairo_pattern_get_color_stop_rgba)
+Xen_wrap_2_optional_args(gxg_cairo_pattern_get_color_stop_count_w, gxg_cairo_pattern_get_color_stop_count)
+Xen_wrap_5_optional_args(gxg_cairo_pattern_get_linear_points_w, gxg_cairo_pattern_get_linear_points)
+Xen_wrap_7_optional_args(gxg_cairo_pattern_get_radial_circles_w, gxg_cairo_pattern_get_radial_circles)
+Xen_wrap_1_arg(gxg_cairo_get_scaled_font_w, gxg_cairo_get_scaled_font)
+Xen_wrap_5_optional_args(gxg_cairo_path_extents_w, gxg_cairo_path_extents)
+Xen_wrap_1_arg(gxg_cairo_has_current_point_w, gxg_cairo_has_current_point)
+Xen_wrap_1_arg(gxg_cairo_surface_copy_page_w, gxg_cairo_surface_copy_page)
+Xen_wrap_1_arg(gxg_cairo_surface_show_page_w, gxg_cairo_surface_show_page)
+Xen_wrap_2_args(gxg_cairo_format_stride_for_width_w, gxg_cairo_format_stride_for_width)
+Xen_wrap_1_arg(gxg_cairo_image_surface_create_from_png_w, gxg_cairo_image_surface_create_from_png)
+Xen_wrap_2_args(gxg_cairo_surface_write_to_png_w, gxg_cairo_surface_write_to_png)
+#if HAVE_CAIRO_1_8
+Xen_wrap_1_arg(gxg_cairo_glyph_allocate_w, gxg_cairo_glyph_allocate)
+Xen_wrap_1_arg(gxg_cairo_glyph_free_w, gxg_cairo_glyph_free)
+Xen_wrap_1_arg(gxg_cairo_text_cluster_allocate_w, gxg_cairo_text_cluster_allocate)
+Xen_wrap_1_arg(gxg_cairo_text_cluster_free_w, gxg_cairo_text_cluster_free)
+Xen_wrap_any_args(gxg_cairo_show_text_glyphs_w, gxg_cairo_show_text_glyphs)
+Xen_wrap_any_args(gxg_cairo_scaled_font_text_to_glyphs_w, gxg_cairo_scaled_font_text_to_glyphs)
+Xen_wrap_2_args(gxg_cairo_scaled_font_get_scale_matrix_w, gxg_cairo_scaled_font_get_scale_matrix)
+Xen_wrap_3_args(gxg_cairo_toy_font_face_create_w, gxg_cairo_toy_font_face_create)
+Xen_wrap_1_arg(gxg_cairo_toy_font_face_get_family_w, gxg_cairo_toy_font_face_get_family)
+Xen_wrap_1_arg(gxg_cairo_toy_font_face_get_slant_w, gxg_cairo_toy_font_face_get_slant)
+Xen_wrap_1_arg(gxg_cairo_toy_font_face_get_weight_w, gxg_cairo_toy_font_face_get_weight)
+Xen_wrap_no_args(gxg_cairo_user_font_face_create_w, gxg_cairo_user_font_face_create)
+Xen_wrap_3_optional_args(gxg_cairo_surface_get_fallback_resolution_w, gxg_cairo_surface_get_fallback_resolution)
+Xen_wrap_1_arg(gxg_cairo_surface_has_show_text_glyphs_w, gxg_cairo_surface_has_show_text_glyphs)
#endif
-XEN_NARGIFY_1(gxg_GDK_IS_DRAG_CONTEXT_w, gxg_GDK_IS_DRAG_CONTEXT)
-XEN_NARGIFY_1(gxg_GDK_IS_DEVICE_w, gxg_GDK_IS_DEVICE)
-XEN_NARGIFY_1(gxg_GDK_IS_KEYMAP_w, gxg_GDK_IS_KEYMAP)
-XEN_NARGIFY_1(gxg_GDK_IS_VISUAL_w, gxg_GDK_IS_VISUAL)
-XEN_NARGIFY_1(gxg_GDK_IS_WINDOW_w, gxg_GDK_IS_WINDOW)
-XEN_NARGIFY_1(gxg_GDK_IS_PIXBUF_w, gxg_GDK_IS_PIXBUF)
-XEN_NARGIFY_1(gxg_GDK_IS_PIXBUF_ANIMATION_w, gxg_GDK_IS_PIXBUF_ANIMATION)
-XEN_NARGIFY_1(gxg_GDK_IS_PIXBUF_ANIMATION_ITER_w, gxg_GDK_IS_PIXBUF_ANIMATION_ITER)
-XEN_NARGIFY_1(gxg_GTK_IS_VBOX_w, gxg_GTK_IS_VBOX)
-XEN_NARGIFY_1(gxg_GTK_IS_ACCEL_GROUP_w, gxg_GTK_IS_ACCEL_GROUP)
-XEN_NARGIFY_1(gxg_GTK_IS_ACCEL_LABEL_w, gxg_GTK_IS_ACCEL_LABEL)
-XEN_NARGIFY_1(gxg_GTK_IS_ACCESSIBLE_w, gxg_GTK_IS_ACCESSIBLE)
-XEN_NARGIFY_1(gxg_GTK_IS_ADJUSTMENT_w, gxg_GTK_IS_ADJUSTMENT)
-XEN_NARGIFY_1(gxg_GTK_IS_ALIGNMENT_w, gxg_GTK_IS_ALIGNMENT)
-XEN_NARGIFY_1(gxg_GTK_IS_ARROW_w, gxg_GTK_IS_ARROW)
-XEN_NARGIFY_1(gxg_GTK_IS_ASPECT_FRAME_w, gxg_GTK_IS_ASPECT_FRAME)
-XEN_NARGIFY_1(gxg_GTK_IS_BUTTON_BOX_w, gxg_GTK_IS_BUTTON_BOX)
-XEN_NARGIFY_1(gxg_GTK_IS_BIN_w, gxg_GTK_IS_BIN)
-XEN_NARGIFY_1(gxg_GTK_IS_BOX_w, gxg_GTK_IS_BOX)
-XEN_NARGIFY_1(gxg_GTK_IS_BUTTON_w, gxg_GTK_IS_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_CALENDAR_w, gxg_GTK_IS_CALENDAR)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_EDITABLE_w, gxg_GTK_IS_CELL_EDITABLE)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_w, gxg_GTK_IS_CELL_RENDERER)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_PIXBUF_w, gxg_GTK_IS_CELL_RENDERER_PIXBUF)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_TEXT_w, gxg_GTK_IS_CELL_RENDERER_TEXT)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_TOGGLE_w, gxg_GTK_IS_CELL_RENDERER_TOGGLE)
-XEN_NARGIFY_1(gxg_GTK_IS_CHECK_BUTTON_w, gxg_GTK_IS_CHECK_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_CHECK_MENU_ITEM_w, gxg_GTK_IS_CHECK_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IS_COLOR_SELECTION_DIALOG_w, gxg_GTK_IS_COLOR_SELECTION_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_IS_COLOR_SELECTION_w, gxg_GTK_IS_COLOR_SELECTION)
-XEN_NARGIFY_1(gxg_GTK_IS_CONTAINER_w, gxg_GTK_IS_CONTAINER)
-XEN_NARGIFY_1(gxg_GTK_IS_DIALOG_w, gxg_GTK_IS_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_IS_DRAWING_AREA_w, gxg_GTK_IS_DRAWING_AREA)
-XEN_NARGIFY_1(gxg_GTK_IS_EDITABLE_w, gxg_GTK_IS_EDITABLE)
-XEN_NARGIFY_1(gxg_GTK_IS_ENTRY_w, gxg_GTK_IS_ENTRY)
-XEN_NARGIFY_1(gxg_GTK_IS_EVENT_BOX_w, gxg_GTK_IS_EVENT_BOX)
-XEN_NARGIFY_1(gxg_GTK_IS_FIXED_w, gxg_GTK_IS_FIXED)
-XEN_NARGIFY_1(gxg_GTK_IS_FONT_SELECTION_w, gxg_GTK_IS_FONT_SELECTION)
-XEN_NARGIFY_1(gxg_GTK_IS_FONT_SELECTION_DIALOG_w, gxg_GTK_IS_FONT_SELECTION_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_IS_FRAME_w, gxg_GTK_IS_FRAME)
-XEN_NARGIFY_1(gxg_GTK_IS_HANDLE_BOX_w, gxg_GTK_IS_HANDLE_BOX)
-XEN_NARGIFY_1(gxg_GTK_IS_HBUTTON_BOX_w, gxg_GTK_IS_HBUTTON_BOX)
-XEN_NARGIFY_1(gxg_GTK_IS_HBOX_w, gxg_GTK_IS_HBOX)
-XEN_NARGIFY_1(gxg_GTK_IS_HPANED_w, gxg_GTK_IS_HPANED)
-XEN_NARGIFY_1(gxg_GTK_IS_HSCALE_w, gxg_GTK_IS_HSCALE)
-XEN_NARGIFY_1(gxg_GTK_IS_HSCROLLBAR_w, gxg_GTK_IS_HSCROLLBAR)
-XEN_NARGIFY_1(gxg_GTK_IS_HSEPARATOR_w, gxg_GTK_IS_HSEPARATOR)
-XEN_NARGIFY_1(gxg_GTK_IS_ICON_FACTORY_w, gxg_GTK_IS_ICON_FACTORY)
-XEN_NARGIFY_1(gxg_GTK_IS_IMAGE_w, gxg_GTK_IS_IMAGE)
-XEN_NARGIFY_1(gxg_GTK_IS_IMAGE_MENU_ITEM_w, gxg_GTK_IS_IMAGE_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IS_IM_CONTEXT_w, gxg_GTK_IS_IM_CONTEXT)
-XEN_NARGIFY_1(gxg_GTK_IS_IM_CONTEXT_SIMPLE_w, gxg_GTK_IS_IM_CONTEXT_SIMPLE)
-XEN_NARGIFY_1(gxg_GTK_IS_IM_MULTICONTEXT_w, gxg_GTK_IS_IM_MULTICONTEXT)
-XEN_NARGIFY_1(gxg_GTK_IS_INVISIBLE_w, gxg_GTK_IS_INVISIBLE)
-XEN_NARGIFY_1(gxg_GTK_IS_LABEL_w, gxg_GTK_IS_LABEL)
-XEN_NARGIFY_1(gxg_GTK_IS_LAYOUT_w, gxg_GTK_IS_LAYOUT)
-XEN_NARGIFY_1(gxg_GTK_IS_LIST_STORE_w, gxg_GTK_IS_LIST_STORE)
-XEN_NARGIFY_1(gxg_GTK_IS_MENU_BAR_w, gxg_GTK_IS_MENU_BAR)
-XEN_NARGIFY_1(gxg_GTK_IS_MENU_w, gxg_GTK_IS_MENU)
-XEN_NARGIFY_1(gxg_GTK_IS_MENU_ITEM_w, gxg_GTK_IS_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IS_MENU_SHELL_w, gxg_GTK_IS_MENU_SHELL)
-XEN_NARGIFY_1(gxg_GTK_IS_MISC_w, gxg_GTK_IS_MISC)
-XEN_NARGIFY_1(gxg_GTK_IS_NOTEBOOK_w, gxg_GTK_IS_NOTEBOOK)
-XEN_NARGIFY_1(gxg_GTK_IS_PANED_w, gxg_GTK_IS_PANED)
-XEN_NARGIFY_1(gxg_GTK_IS_PROGRESS_BAR_w, gxg_GTK_IS_PROGRESS_BAR)
-XEN_NARGIFY_1(gxg_GTK_IS_RADIO_BUTTON_w, gxg_GTK_IS_RADIO_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_RADIO_MENU_ITEM_w, gxg_GTK_IS_RADIO_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IS_RANGE_w, gxg_GTK_IS_RANGE)
-XEN_NARGIFY_1(gxg_GTK_IS_SCALE_w, gxg_GTK_IS_SCALE)
-XEN_NARGIFY_1(gxg_GTK_IS_SCROLLBAR_w, gxg_GTK_IS_SCROLLBAR)
-XEN_NARGIFY_1(gxg_GTK_IS_SCROLLED_WINDOW_w, gxg_GTK_IS_SCROLLED_WINDOW)
-XEN_NARGIFY_1(gxg_GTK_IS_SEPARATOR_w, gxg_GTK_IS_SEPARATOR)
-XEN_NARGIFY_1(gxg_GTK_IS_SEPARATOR_MENU_ITEM_w, gxg_GTK_IS_SEPARATOR_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IS_SIZE_GROUP_w, gxg_GTK_IS_SIZE_GROUP)
-XEN_NARGIFY_1(gxg_GTK_IS_SPIN_BUTTON_w, gxg_GTK_IS_SPIN_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_STATUSBAR_w, gxg_GTK_IS_STATUSBAR)
-XEN_NARGIFY_1(gxg_GTK_IS_TABLE_w, gxg_GTK_IS_TABLE)
-XEN_NARGIFY_1(gxg_GTK_IS_TEAROFF_MENU_ITEM_w, gxg_GTK_IS_TEAROFF_MENU_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IS_TEXT_BUFFER_w, gxg_GTK_IS_TEXT_BUFFER)
-XEN_NARGIFY_1(gxg_GTK_IS_TEXT_CHILD_ANCHOR_w, gxg_GTK_IS_TEXT_CHILD_ANCHOR)
-XEN_NARGIFY_1(gxg_GTK_IS_TEXT_MARK_w, gxg_GTK_IS_TEXT_MARK)
-XEN_NARGIFY_1(gxg_GTK_IS_TEXT_TAG_w, gxg_GTK_IS_TEXT_TAG)
-XEN_NARGIFY_1(gxg_GTK_IS_TEXT_TAG_TABLE_w, gxg_GTK_IS_TEXT_TAG_TABLE)
-XEN_NARGIFY_1(gxg_GTK_IS_TEXT_VIEW_w, gxg_GTK_IS_TEXT_VIEW)
-XEN_NARGIFY_1(gxg_GTK_IS_TOGGLE_BUTTON_w, gxg_GTK_IS_TOGGLE_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_TOOLBAR_w, gxg_GTK_IS_TOOLBAR)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_DRAG_SOURCE_w, gxg_GTK_IS_TREE_DRAG_SOURCE)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_DRAG_DEST_w, gxg_GTK_IS_TREE_DRAG_DEST)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_MODEL_w, gxg_GTK_IS_TREE_MODEL)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_MODEL_SORT_w, gxg_GTK_IS_TREE_MODEL_SORT)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_SELECTION_w, gxg_GTK_IS_TREE_SELECTION)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_SORTABLE_w, gxg_GTK_IS_TREE_SORTABLE)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_STORE_w, gxg_GTK_IS_TREE_STORE)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_VIEW_COLUMN_w, gxg_GTK_IS_TREE_VIEW_COLUMN)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_VIEW_w, gxg_GTK_IS_TREE_VIEW)
-XEN_NARGIFY_1(gxg_GTK_IS_VBUTTON_BOX_w, gxg_GTK_IS_VBUTTON_BOX)
-XEN_NARGIFY_1(gxg_GTK_IS_VIEWPORT_w, gxg_GTK_IS_VIEWPORT)
-XEN_NARGIFY_1(gxg_GTK_IS_VPANED_w, gxg_GTK_IS_VPANED)
-XEN_NARGIFY_1(gxg_GTK_IS_VSCALE_w, gxg_GTK_IS_VSCALE)
-XEN_NARGIFY_1(gxg_GTK_IS_VSCROLLBAR_w, gxg_GTK_IS_VSCROLLBAR)
-XEN_NARGIFY_1(gxg_GTK_IS_VSEPARATOR_w, gxg_GTK_IS_VSEPARATOR)
-XEN_NARGIFY_1(gxg_GTK_IS_WIDGET_w, gxg_GTK_IS_WIDGET)
-XEN_NARGIFY_1(gxg_GTK_IS_WINDOW_w, gxg_GTK_IS_WINDOW)
-XEN_NARGIFY_1(gxg_PANGO_IS_CONTEXT_w, gxg_PANGO_IS_CONTEXT)
-XEN_NARGIFY_1(gxg_PANGO_IS_FONT_FAMILY_w, gxg_PANGO_IS_FONT_FAMILY)
-XEN_NARGIFY_1(gxg_PANGO_IS_FONT_FACE_w, gxg_PANGO_IS_FONT_FACE)
-XEN_NARGIFY_1(gxg_PANGO_IS_FONT_w, gxg_PANGO_IS_FONT)
-XEN_NARGIFY_1(gxg_PANGO_IS_FONT_MAP_w, gxg_PANGO_IS_FONT_MAP)
-XEN_NARGIFY_1(gxg_PANGO_IS_LAYOUT_w, gxg_PANGO_IS_LAYOUT)
-XEN_NARGIFY_1(gxg_G_IS_OBJECT_w, gxg_G_IS_OBJECT)
-XEN_NARGIFY_1(gxg_GDK_IS_SCREEN_w, gxg_GDK_IS_SCREEN)
-XEN_NARGIFY_1(gxg_GDK_IS_DISPLAY_w, gxg_GDK_IS_DISPLAY)
-XEN_NARGIFY_1(gxg_GTK_IS_FILE_CHOOSER_DIALOG_w, gxg_GTK_IS_FILE_CHOOSER_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_IS_FILE_CHOOSER_WIDGET_w, gxg_GTK_IS_FILE_CHOOSER_WIDGET)
-XEN_NARGIFY_1(gxg_GTK_IS_TREE_MODEL_FILTER_w, gxg_GTK_IS_TREE_MODEL_FILTER)
-XEN_NARGIFY_1(gxg_GTK_IS_ACTION_w, gxg_GTK_IS_ACTION)
-XEN_NARGIFY_1(gxg_GTK_IS_ACTION_GROUP_w, gxg_GTK_IS_ACTION_GROUP)
-XEN_NARGIFY_1(gxg_GTK_IS_COMBO_BOX_w, gxg_GTK_IS_COMBO_BOX)
-XEN_NARGIFY_1(gxg_GTK_IS_EXPANDER_w, gxg_GTK_IS_EXPANDER)
-XEN_NARGIFY_1(gxg_GTK_IS_FONT_BUTTON_w, gxg_GTK_IS_FONT_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_COLOR_BUTTON_w, gxg_GTK_IS_COLOR_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_ENTRY_COMPLETION_w, gxg_GTK_IS_ENTRY_COMPLETION)
-XEN_NARGIFY_1(gxg_GTK_IS_RADIO_TOOL_BUTTON_w, gxg_GTK_IS_RADIO_TOOL_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_RADIO_ACTION_w, gxg_GTK_IS_RADIO_ACTION)
-XEN_NARGIFY_1(gxg_GTK_IS_SEPARATOR_TOOL_ITEM_w, gxg_GTK_IS_SEPARATOR_TOOL_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IS_TOGGLE_ACTION_w, gxg_GTK_IS_TOGGLE_ACTION)
-XEN_NARGIFY_1(gxg_GTK_IS_TOGGLE_TOOL_BUTTON_w, gxg_GTK_IS_TOGGLE_TOOL_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_FILE_FILTER_w, gxg_GTK_IS_FILE_FILTER)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_LAYOUT_w, gxg_GTK_IS_CELL_LAYOUT)
-XEN_NARGIFY_1(gxg_GTK_IS_CLIPBOARD_w, gxg_GTK_IS_CLIPBOARD)
-XEN_NARGIFY_1(gxg_GTK_IS_FILE_CHOOSER_w, gxg_GTK_IS_FILE_CHOOSER)
-XEN_NARGIFY_1(gxg_GTK_IS_ICON_THEME_w, gxg_GTK_IS_ICON_THEME)
-XEN_NARGIFY_1(gxg_GTK_IS_TOOL_BUTTON_w, gxg_GTK_IS_TOOL_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_TOOL_ITEM_w, gxg_GTK_IS_TOOL_ITEM)
-XEN_NARGIFY_1(gxg_GTK_IS_ACCEL_MAP_w, gxg_GTK_IS_ACCEL_MAP)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_VIEW_w, gxg_GTK_IS_CELL_VIEW)
-XEN_NARGIFY_1(gxg_GTK_IS_ABOUT_DIALOG_w, gxg_GTK_IS_ABOUT_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_COMBO_w, gxg_GTK_IS_CELL_RENDERER_COMBO)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_PROGRESS_w, gxg_GTK_IS_CELL_RENDERER_PROGRESS)
-XEN_NARGIFY_1(gxg_GTK_IS_ICON_VIEW_w, gxg_GTK_IS_ICON_VIEW)
-XEN_NARGIFY_1(gxg_GTK_IS_FILE_CHOOSER_BUTTON_w, gxg_GTK_IS_FILE_CHOOSER_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_MENU_TOOL_BUTTON_w, gxg_GTK_IS_MENU_TOOL_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_ASSISTANT_w, gxg_GTK_IS_ASSISTANT)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_ACCEL_w, gxg_GTK_IS_CELL_RENDERER_ACCEL)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_SPIN_w, gxg_GTK_IS_CELL_RENDERER_SPIN)
-XEN_NARGIFY_1(gxg_GTK_IS_LINK_BUTTON_w, gxg_GTK_IS_LINK_BUTTON)
-XEN_NARGIFY_1(gxg_GTK_IS_RECENT_CHOOSER_DIALOG_w, gxg_GTK_IS_RECENT_CHOOSER_DIALOG)
-XEN_NARGIFY_1(gxg_GTK_IS_RECENT_CHOOSER_w, gxg_GTK_IS_RECENT_CHOOSER)
-XEN_NARGIFY_1(gxg_GTK_IS_RECENT_CHOOSER_MENU_w, gxg_GTK_IS_RECENT_CHOOSER_MENU)
-XEN_NARGIFY_1(gxg_GTK_IS_RECENT_CHOOSER_WIDGET_w, gxg_GTK_IS_RECENT_CHOOSER_WIDGET)
-XEN_NARGIFY_1(gxg_GTK_IS_RECENT_FILTER_w, gxg_GTK_IS_RECENT_FILTER)
-XEN_NARGIFY_1(gxg_GTK_IS_RECENT_MANAGER_w, gxg_GTK_IS_RECENT_MANAGER)
-XEN_NARGIFY_1(gxg_GTK_IS_STATUS_ICON_w, gxg_GTK_IS_STATUS_ICON)
-XEN_NARGIFY_1(gxg_GTK_IS_PRINT_CONTEXT_w, gxg_GTK_IS_PRINT_CONTEXT)
-XEN_NARGIFY_1(gxg_GTK_IS_PRINT_OPERATION_w, gxg_GTK_IS_PRINT_OPERATION)
-XEN_NARGIFY_1(gxg_GTK_IS_PRINT_OPERATION_PREVIEW_w, gxg_GTK_IS_PRINT_OPERATION_PREVIEW)
-XEN_NARGIFY_1(gxg_GTK_IS_PRINT_SETTINGS_w, gxg_GTK_IS_PRINT_SETTINGS)
-XEN_NARGIFY_1(gxg_GTK_IS_TOOLTIP_w, gxg_GTK_IS_TOOLTIP)
-#if HAVE_GTK_INFO_BAR_NEW
-XEN_NARGIFY_1(gxg_GTK_IS_INFO_BAR_w, gxg_GTK_IS_INFO_BAR)
+#if HAVE_CAIRO_1_9_12 && GTK_CHECK_VERSION(3, 0, 0)
+Xen_wrap_3_args(gxg_cairo_in_clip_w, gxg_cairo_in_clip)
+Xen_wrap_1_arg(gxg_cairo_device_reference_w, gxg_cairo_device_reference)
+Xen_wrap_1_arg(gxg_cairo_device_status_w, gxg_cairo_device_status)
+Xen_wrap_1_arg(gxg_cairo_device_acquire_w, gxg_cairo_device_acquire)
+Xen_wrap_1_arg(gxg_cairo_device_release_w, gxg_cairo_device_release)
+Xen_wrap_1_arg(gxg_cairo_device_flush_w, gxg_cairo_device_flush)
+Xen_wrap_1_arg(gxg_cairo_device_finish_w, gxg_cairo_device_finish)
+Xen_wrap_1_arg(gxg_cairo_device_destroy_w, gxg_cairo_device_destroy)
+Xen_wrap_1_arg(gxg_cairo_device_get_reference_count_w, gxg_cairo_device_get_reference_count)
+Xen_wrap_2_args(gxg_cairo_device_get_user_data_w, gxg_cairo_device_get_user_data)
+Xen_wrap_4_args(gxg_cairo_device_set_user_data_w, gxg_cairo_device_set_user_data)
+Xen_wrap_5_args(gxg_cairo_surface_create_for_rectangle_w, gxg_cairo_surface_create_for_rectangle)
+Xen_wrap_1_arg(gxg_cairo_surface_get_device_w, gxg_cairo_surface_get_device)
+Xen_wrap_6_args(gxg_cairo_surface_set_mime_data_w, gxg_cairo_surface_set_mime_data)
+Xen_wrap_2_args(gxg_cairo_recording_surface_create_w, gxg_cairo_recording_surface_create)
+Xen_wrap_5_args(gxg_cairo_recording_surface_ink_extents_w, gxg_cairo_recording_surface_ink_extents)
+Xen_wrap_no_args(gxg_cairo_region_create_w, gxg_cairo_region_create)
+Xen_wrap_1_arg(gxg_cairo_region_create_rectangle_w, gxg_cairo_region_create_rectangle)
+Xen_wrap_2_args(gxg_cairo_region_create_rectangles_w, gxg_cairo_region_create_rectangles)
+Xen_wrap_1_arg(gxg_cairo_region_copy_w, gxg_cairo_region_copy)
+Xen_wrap_1_arg(gxg_cairo_region_reference_w, gxg_cairo_region_reference)
+Xen_wrap_1_arg(gxg_cairo_region_destroy_w, gxg_cairo_region_destroy)
+Xen_wrap_2_args(gxg_cairo_region_equal_w, gxg_cairo_region_equal)
+Xen_wrap_1_arg(gxg_cairo_region_status_w, gxg_cairo_region_status)
+Xen_wrap_2_args(gxg_cairo_region_get_extents_w, gxg_cairo_region_get_extents)
+Xen_wrap_1_arg(gxg_cairo_region_num_rectangles_w, gxg_cairo_region_num_rectangles)
+Xen_wrap_3_args(gxg_cairo_region_get_rectangle_w, gxg_cairo_region_get_rectangle)
+Xen_wrap_1_arg(gxg_cairo_region_is_empty_w, gxg_cairo_region_is_empty)
+Xen_wrap_2_args(gxg_cairo_region_contains_rectangle_w, gxg_cairo_region_contains_rectangle)
+Xen_wrap_3_args(gxg_cairo_region_contains_point_w, gxg_cairo_region_contains_point)
+Xen_wrap_3_args(gxg_cairo_region_translate_w, gxg_cairo_region_translate)
+Xen_wrap_2_args(gxg_cairo_region_subtract_w, gxg_cairo_region_subtract)
+Xen_wrap_2_args(gxg_cairo_region_subtract_rectangle_w, gxg_cairo_region_subtract_rectangle)
+Xen_wrap_2_args(gxg_cairo_region_intersect_w, gxg_cairo_region_intersect)
+Xen_wrap_2_args(gxg_cairo_region_intersect_rectangle_w, gxg_cairo_region_intersect_rectangle)
+Xen_wrap_2_args(gxg_cairo_region_union_w, gxg_cairo_region_union)
+Xen_wrap_2_args(gxg_cairo_region_union_rectangle_w, gxg_cairo_region_union_rectangle)
+Xen_wrap_2_args(gxg_cairo_region_xor_w, gxg_cairo_region_xor)
+Xen_wrap_2_args(gxg_cairo_region_xor_rectangle_w, gxg_cairo_region_xor_rectangle)
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-XEN_NARGIFY_1(gxg_GTK_IS_ENTRY_BUFFER_w, gxg_GTK_IS_ENTRY_BUFFER)
+Xen_wrap_1_arg(gxg_GPOINTER_w, gxg_GPOINTER)
+Xen_wrap_2_args(c_array_to_xen_list_w, c_array_to_xen_list)
+Xen_wrap_2_args(xen_list_to_c_array_w, xen_list_to_c_array)
+Xen_wrap_1_arg(gxg_make_target_entry_w, gxg_make_target_entry)
+Xen_wrap_3_args(xg_object_get_w, xg_object_get)
+Xen_wrap_3_args(xg_object_set_w, xg_object_set)
+Xen_wrap_1_arg(xg_gtk_event_keyval_w, xg_gtk_event_keyval)
+Xen_wrap_2_optional_args(gxg_gtk_init_w, gxg_gtk_init)
+Xen_wrap_2_optional_args(gxg_gtk_init_check_w, gxg_gtk_init_check)
+Xen_wrap_1_arg(gxg_GDK_DRAG_CONTEXT_w, gxg_GDK_DRAG_CONTEXT)
+Xen_wrap_1_arg(gxg_GDK_DEVICE_w, gxg_GDK_DEVICE)
+Xen_wrap_1_arg(gxg_GDK_KEYMAP_w, gxg_GDK_KEYMAP)
+Xen_wrap_1_arg(gxg_GDK_VISUAL_w, gxg_GDK_VISUAL)
+Xen_wrap_1_arg(gxg_GDK_WINDOW_w, gxg_GDK_WINDOW)
+Xen_wrap_1_arg(gxg_GDK_PIXBUF_w, gxg_GDK_PIXBUF)
+Xen_wrap_1_arg(gxg_GDK_PIXBUF_ANIMATION_w, gxg_GDK_PIXBUF_ANIMATION)
+Xen_wrap_1_arg(gxg_GDK_PIXBUF_ANIMATION_ITER_w, gxg_GDK_PIXBUF_ANIMATION_ITER)
+Xen_wrap_1_arg(gxg_GTK_ACCEL_GROUP_w, gxg_GTK_ACCEL_GROUP)
+Xen_wrap_1_arg(gxg_GTK_ACCEL_LABEL_w, gxg_GTK_ACCEL_LABEL)
+Xen_wrap_1_arg(gxg_GTK_ACCESSIBLE_w, gxg_GTK_ACCESSIBLE)
+Xen_wrap_1_arg(gxg_GTK_ADJUSTMENT_w, gxg_GTK_ADJUSTMENT)
+Xen_wrap_1_arg(gxg_GTK_ASPECT_FRAME_w, gxg_GTK_ASPECT_FRAME)
+Xen_wrap_1_arg(gxg_GTK_BUTTON_BOX_w, gxg_GTK_BUTTON_BOX)
+Xen_wrap_1_arg(gxg_GTK_BIN_w, gxg_GTK_BIN)
+Xen_wrap_1_arg(gxg_GTK_BOX_w, gxg_GTK_BOX)
+Xen_wrap_1_arg(gxg_GTK_BUTTON_w, gxg_GTK_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_CALENDAR_w, gxg_GTK_CALENDAR)
+Xen_wrap_1_arg(gxg_GTK_CELL_EDITABLE_w, gxg_GTK_CELL_EDITABLE)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_w, gxg_GTK_CELL_RENDERER)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_PIXBUF_w, gxg_GTK_CELL_RENDERER_PIXBUF)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_TEXT_w, gxg_GTK_CELL_RENDERER_TEXT)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_TOGGLE_w, gxg_GTK_CELL_RENDERER_TOGGLE)
+Xen_wrap_1_arg(gxg_GTK_CHECK_BUTTON_w, gxg_GTK_CHECK_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_CHECK_MENU_ITEM_w, gxg_GTK_CHECK_MENU_ITEM)
+Xen_wrap_1_arg(gxg_GTK_CONTAINER_w, gxg_GTK_CONTAINER)
+Xen_wrap_1_arg(gxg_GTK_DIALOG_w, gxg_GTK_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_DRAWING_AREA_w, gxg_GTK_DRAWING_AREA)
+Xen_wrap_1_arg(gxg_GTK_EDITABLE_w, gxg_GTK_EDITABLE)
+Xen_wrap_1_arg(gxg_GTK_ENTRY_w, gxg_GTK_ENTRY)
+Xen_wrap_1_arg(gxg_GTK_EVENT_BOX_w, gxg_GTK_EVENT_BOX)
+Xen_wrap_1_arg(gxg_GTK_FIXED_w, gxg_GTK_FIXED)
+Xen_wrap_1_arg(gxg_GTK_FRAME_w, gxg_GTK_FRAME)
+Xen_wrap_1_arg(gxg_GTK_IMAGE_w, gxg_GTK_IMAGE)
+Xen_wrap_1_arg(gxg_GTK_IM_CONTEXT_w, gxg_GTK_IM_CONTEXT)
+Xen_wrap_1_arg(gxg_GTK_IM_CONTEXT_SIMPLE_w, gxg_GTK_IM_CONTEXT_SIMPLE)
+Xen_wrap_1_arg(gxg_GTK_INVISIBLE_w, gxg_GTK_INVISIBLE)
+Xen_wrap_1_arg(gxg_GTK_LABEL_w, gxg_GTK_LABEL)
+Xen_wrap_1_arg(gxg_GTK_LAYOUT_w, gxg_GTK_LAYOUT)
+Xen_wrap_1_arg(gxg_GTK_LIST_STORE_w, gxg_GTK_LIST_STORE)
+Xen_wrap_1_arg(gxg_GTK_MENU_BAR_w, gxg_GTK_MENU_BAR)
+Xen_wrap_1_arg(gxg_GTK_MENU_w, gxg_GTK_MENU)
+Xen_wrap_1_arg(gxg_GTK_MENU_ITEM_w, gxg_GTK_MENU_ITEM)
+Xen_wrap_1_arg(gxg_GTK_MENU_SHELL_w, gxg_GTK_MENU_SHELL)
+Xen_wrap_1_arg(gxg_GTK_NOTEBOOK_w, gxg_GTK_NOTEBOOK)
+Xen_wrap_1_arg(gxg_GTK_PANED_w, gxg_GTK_PANED)
+Xen_wrap_1_arg(gxg_GTK_PROGRESS_BAR_w, gxg_GTK_PROGRESS_BAR)
+Xen_wrap_1_arg(gxg_GTK_RADIO_BUTTON_w, gxg_GTK_RADIO_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_RADIO_MENU_ITEM_w, gxg_GTK_RADIO_MENU_ITEM)
+Xen_wrap_1_arg(gxg_GTK_RANGE_w, gxg_GTK_RANGE)
+Xen_wrap_1_arg(gxg_GTK_SCALE_w, gxg_GTK_SCALE)
+Xen_wrap_1_arg(gxg_GTK_SCROLLBAR_w, gxg_GTK_SCROLLBAR)
+Xen_wrap_1_arg(gxg_GTK_SCROLLED_WINDOW_w, gxg_GTK_SCROLLED_WINDOW)
+Xen_wrap_1_arg(gxg_GTK_SEPARATOR_w, gxg_GTK_SEPARATOR)
+Xen_wrap_1_arg(gxg_GTK_SEPARATOR_MENU_ITEM_w, gxg_GTK_SEPARATOR_MENU_ITEM)
+Xen_wrap_1_arg(gxg_GTK_SETTINGS_w, gxg_GTK_SETTINGS)
+Xen_wrap_1_arg(gxg_GTK_SIZE_GROUP_w, gxg_GTK_SIZE_GROUP)
+Xen_wrap_1_arg(gxg_GTK_SPIN_BUTTON_w, gxg_GTK_SPIN_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_STATUSBAR_w, gxg_GTK_STATUSBAR)
+Xen_wrap_1_arg(gxg_GTK_TEXT_BUFFER_w, gxg_GTK_TEXT_BUFFER)
+Xen_wrap_1_arg(gxg_GTK_TEXT_CHILD_ANCHOR_w, gxg_GTK_TEXT_CHILD_ANCHOR)
+Xen_wrap_1_arg(gxg_GTK_TEXT_MARK_w, gxg_GTK_TEXT_MARK)
+Xen_wrap_1_arg(gxg_GTK_TEXT_TAG_w, gxg_GTK_TEXT_TAG)
+Xen_wrap_1_arg(gxg_GTK_TEXT_TAG_TABLE_w, gxg_GTK_TEXT_TAG_TABLE)
+Xen_wrap_1_arg(gxg_GTK_TEXT_VIEW_w, gxg_GTK_TEXT_VIEW)
+Xen_wrap_1_arg(gxg_GTK_TOGGLE_BUTTON_w, gxg_GTK_TOGGLE_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_TOOLBAR_w, gxg_GTK_TOOLBAR)
+Xen_wrap_1_arg(gxg_GTK_TREE_DRAG_SOURCE_w, gxg_GTK_TREE_DRAG_SOURCE)
+Xen_wrap_1_arg(gxg_GTK_TREE_DRAG_DEST_w, gxg_GTK_TREE_DRAG_DEST)
+Xen_wrap_1_arg(gxg_GTK_TREE_MODEL_w, gxg_GTK_TREE_MODEL)
+Xen_wrap_1_arg(gxg_GTK_TREE_MODEL_SORT_w, gxg_GTK_TREE_MODEL_SORT)
+Xen_wrap_1_arg(gxg_GTK_TREE_SELECTION_w, gxg_GTK_TREE_SELECTION)
+Xen_wrap_1_arg(gxg_GTK_TREE_SORTABLE_w, gxg_GTK_TREE_SORTABLE)
+Xen_wrap_1_arg(gxg_GTK_TREE_STORE_w, gxg_GTK_TREE_STORE)
+Xen_wrap_1_arg(gxg_GTK_TREE_VIEW_COLUMN_w, gxg_GTK_TREE_VIEW_COLUMN)
+Xen_wrap_1_arg(gxg_GTK_TREE_VIEW_w, gxg_GTK_TREE_VIEW)
+Xen_wrap_1_arg(gxg_GTK_VIEWPORT_w, gxg_GTK_VIEWPORT)
+Xen_wrap_1_arg(gxg_GTK_WIDGET_w, gxg_GTK_WIDGET)
+Xen_wrap_1_arg(gxg_GTK_WINDOW_w, gxg_GTK_WINDOW)
+Xen_wrap_1_arg(gxg_PANGO_CONTEXT_w, gxg_PANGO_CONTEXT)
+Xen_wrap_1_arg(gxg_PANGO_FONT_FAMILY_w, gxg_PANGO_FONT_FAMILY)
+Xen_wrap_1_arg(gxg_PANGO_FONT_FACE_w, gxg_PANGO_FONT_FACE)
+Xen_wrap_1_arg(gxg_PANGO_FONT_w, gxg_PANGO_FONT)
+Xen_wrap_1_arg(gxg_PANGO_FONT_MAP_w, gxg_PANGO_FONT_MAP)
+Xen_wrap_1_arg(gxg_PANGO_LAYOUT_w, gxg_PANGO_LAYOUT)
+Xen_wrap_1_arg(gxg_G_OBJECT_w, gxg_G_OBJECT)
+Xen_wrap_1_arg(gxg_GDK_SCREEN_w, gxg_GDK_SCREEN)
+Xen_wrap_1_arg(gxg_GDK_DISPLAY_OBJECT_w, gxg_GDK_DISPLAY_OBJECT)
+Xen_wrap_1_arg(gxg_GDK_EVENT_w, gxg_GDK_EVENT)
+Xen_wrap_1_arg(gxg_GDK_EVENT_ANY_w, gxg_GDK_EVENT_ANY)
+Xen_wrap_1_arg(gxg_GDK_EVENT_EXPOSE_w, gxg_GDK_EVENT_EXPOSE)
+Xen_wrap_1_arg(gxg_GDK_EVENT_NOEXPOSE_w, gxg_GDK_EVENT_NOEXPOSE)
+Xen_wrap_1_arg(gxg_GDK_EVENT_VISIBILITY_w, gxg_GDK_EVENT_VISIBILITY)
+Xen_wrap_1_arg(gxg_GDK_EVENT_MOTION_w, gxg_GDK_EVENT_MOTION)
+Xen_wrap_1_arg(gxg_GDK_EVENT_BUTTON_w, gxg_GDK_EVENT_BUTTON)
+Xen_wrap_1_arg(gxg_GDK_EVENT_SCROLL_w, gxg_GDK_EVENT_SCROLL)
+Xen_wrap_1_arg(gxg_GDK_EVENT_KEY_w, gxg_GDK_EVENT_KEY)
+Xen_wrap_1_arg(gxg_GDK_EVENT_CROSSING_w, gxg_GDK_EVENT_CROSSING)
+Xen_wrap_1_arg(gxg_GDK_EVENT_FOCUS_w, gxg_GDK_EVENT_FOCUS)
+Xen_wrap_1_arg(gxg_GDK_EVENT_CONFIGURE_w, gxg_GDK_EVENT_CONFIGURE)
+Xen_wrap_1_arg(gxg_GDK_EVENT_PROPERTY_w, gxg_GDK_EVENT_PROPERTY)
+Xen_wrap_1_arg(gxg_GDK_EVENT_SELECTION_w, gxg_GDK_EVENT_SELECTION)
+Xen_wrap_1_arg(gxg_GDK_EVENT_PROXIMITY_w, gxg_GDK_EVENT_PROXIMITY)
+Xen_wrap_1_arg(gxg_GDK_EVENT_SETTING_w, gxg_GDK_EVENT_SETTING)
+Xen_wrap_1_arg(gxg_GDK_EVENT_WINDOWSTATE_w, gxg_GDK_EVENT_WINDOWSTATE)
+Xen_wrap_1_arg(gxg_GDK_EVENT_DND_w, gxg_GDK_EVENT_DND)
+Xen_wrap_1_arg(gxg_GTK_FILE_CHOOSER_DIALOG_w, gxg_GTK_FILE_CHOOSER_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_FILE_CHOOSER_WIDGET_w, gxg_GTK_FILE_CHOOSER_WIDGET)
+Xen_wrap_1_arg(gxg_GTK_TREE_MODEL_FILTER_w, gxg_GTK_TREE_MODEL_FILTER)
+Xen_wrap_1_arg(gxg_GTK_COMBO_BOX_w, gxg_GTK_COMBO_BOX)
+Xen_wrap_1_arg(gxg_GTK_EXPANDER_w, gxg_GTK_EXPANDER)
+Xen_wrap_1_arg(gxg_GTK_FONT_BUTTON_w, gxg_GTK_FONT_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_COLOR_BUTTON_w, gxg_GTK_COLOR_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_ENTRY_COMPLETION_w, gxg_GTK_ENTRY_COMPLETION)
+Xen_wrap_1_arg(gxg_GTK_RADIO_TOOL_BUTTON_w, gxg_GTK_RADIO_TOOL_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_SEPARATOR_TOOL_ITEM_w, gxg_GTK_SEPARATOR_TOOL_ITEM)
+Xen_wrap_1_arg(gxg_GTK_TOGGLE_TOOL_BUTTON_w, gxg_GTK_TOGGLE_TOOL_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_FILE_FILTER_w, gxg_GTK_FILE_FILTER)
+Xen_wrap_1_arg(gxg_GTK_CELL_LAYOUT_w, gxg_GTK_CELL_LAYOUT)
+Xen_wrap_1_arg(gxg_GTK_CLIPBOARD_w, gxg_GTK_CLIPBOARD)
+Xen_wrap_1_arg(gxg_GTK_FILE_CHOOSER_w, gxg_GTK_FILE_CHOOSER)
+Xen_wrap_1_arg(gxg_GTK_ICON_THEME_w, gxg_GTK_ICON_THEME)
+Xen_wrap_1_arg(gxg_GTK_TOOL_BUTTON_w, gxg_GTK_TOOL_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_TOOL_ITEM_w, gxg_GTK_TOOL_ITEM)
+Xen_wrap_1_arg(gxg_GTK_ACCEL_MAP_w, gxg_GTK_ACCEL_MAP)
+Xen_wrap_1_arg(gxg_GTK_CELL_VIEW_w, gxg_GTK_CELL_VIEW)
+Xen_wrap_1_arg(gxg_GTK_ABOUT_DIALOG_w, gxg_GTK_ABOUT_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_COMBO_w, gxg_GTK_CELL_RENDERER_COMBO)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_PROGRESS_w, gxg_GTK_CELL_RENDERER_PROGRESS)
+Xen_wrap_1_arg(gxg_GTK_ICON_VIEW_w, gxg_GTK_ICON_VIEW)
+Xen_wrap_1_arg(gxg_GTK_FILE_CHOOSER_BUTTON_w, gxg_GTK_FILE_CHOOSER_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_MENU_TOOL_BUTTON_w, gxg_GTK_MENU_TOOL_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_ASSISTANT_w, gxg_GTK_ASSISTANT)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_ACCEL_w, gxg_GTK_CELL_RENDERER_ACCEL)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_SPIN_w, gxg_GTK_CELL_RENDERER_SPIN)
+Xen_wrap_1_arg(gxg_GTK_LINK_BUTTON_w, gxg_GTK_LINK_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_RECENT_CHOOSER_DIALOG_w, gxg_GTK_RECENT_CHOOSER_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_RECENT_CHOOSER_w, gxg_GTK_RECENT_CHOOSER)
+Xen_wrap_1_arg(gxg_GTK_RECENT_CHOOSER_MENU_w, gxg_GTK_RECENT_CHOOSER_MENU)
+Xen_wrap_1_arg(gxg_GTK_RECENT_CHOOSER_WIDGET_w, gxg_GTK_RECENT_CHOOSER_WIDGET)
+Xen_wrap_1_arg(gxg_GTK_RECENT_FILTER_w, gxg_GTK_RECENT_FILTER)
+Xen_wrap_1_arg(gxg_GTK_RECENT_MANAGER_w, gxg_GTK_RECENT_MANAGER)
+Xen_wrap_1_arg(gxg_GTK_PRINT_CONTEXT_w, gxg_GTK_PRINT_CONTEXT)
+Xen_wrap_1_arg(gxg_GTK_PRINT_OPERATION_w, gxg_GTK_PRINT_OPERATION)
+Xen_wrap_1_arg(gxg_GTK_PRINT_OPERATION_PREVIEW_w, gxg_GTK_PRINT_OPERATION_PREVIEW)
+Xen_wrap_1_arg(gxg_GTK_PRINT_SETTINGS_w, gxg_GTK_PRINT_SETTINGS)
+Xen_wrap_1_arg(gxg_GTK_TOOLTIP_w, gxg_GTK_TOOLTIP)
+#if GTK_CHECK_VERSION(2, 18, 0)
+Xen_wrap_1_arg(gxg_GTK_INFO_BAR_w, gxg_GTK_INFO_BAR)
+Xen_wrap_1_arg(gxg_GTK_ENTRY_BUFFER_w, gxg_GTK_ENTRY_BUFFER)
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-XEN_NARGIFY_1(gxg_GTK_IS_SPINNER_w, gxg_GTK_IS_SPINNER)
-XEN_NARGIFY_1(gxg_GTK_IS_CELL_RENDERER_SPINNER_w, gxg_GTK_IS_CELL_RENDERER_SPINNER)
-XEN_NARGIFY_1(gxg_GTK_IS_TOOL_PALETTE_w, gxg_GTK_IS_TOOL_PALETTE)
-XEN_NARGIFY_1(gxg_GTK_IS_TOOL_ITEM_GROUP_w, gxg_GTK_IS_TOOL_ITEM_GROUP)
+#if GTK_CHECK_VERSION(2, 20, 0)
+Xen_wrap_1_arg(gxg_GTK_SPINNER_w, gxg_GTK_SPINNER)
+Xen_wrap_1_arg(gxg_GTK_CELL_RENDERER_SPINNER_w, gxg_GTK_CELL_RENDERER_SPINNER)
+Xen_wrap_1_arg(gxg_GTK_TOOL_PALETTE_w, gxg_GTK_TOOL_PALETTE)
+Xen_wrap_1_arg(gxg_GTK_TOOL_ITEM_GROUP_w, gxg_GTK_TOOL_ITEM_GROUP)
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-XEN_NARGIFY_1(gxg_GTK_IS_COMBO_BOX_TEXT_w, gxg_GTK_IS_COMBO_BOX_TEXT)
-XEN_NARGIFY_1(gxg_GTK_IS_GRID_w, gxg_GTK_IS_GRID)
-XEN_NARGIFY_1(gxg_GTK_IS_SCROLLABLE_w, gxg_GTK_IS_SCROLLABLE)
-XEN_NARGIFY_1(gxg_GTK_IS_SWITCH_w, gxg_GTK_IS_SWITCH)
-XEN_NARGIFY_1(gxg_GTK_IS_ACTIVATABLE_w, gxg_GTK_IS_ACTIVATABLE)
-XEN_NARGIFY_1(gxg_GTK_IS_ORIENTABLE_w, gxg_GTK_IS_ORIENTABLE)
-XEN_NARGIFY_1(gxg_GTK_IS_WINDOW_GROUP_w, gxg_GTK_IS_WINDOW_GROUP)
-XEN_NARGIFY_1(gxg_GTK_IS_TOOL_SHELL_w, gxg_GTK_IS_TOOL_SHELL)
+#if GTK_CHECK_VERSION(3, 0, 0)
+Xen_wrap_1_arg(gxg_GTK_COMBO_BOX_TEXT_w, gxg_GTK_COMBO_BOX_TEXT)
+Xen_wrap_1_arg(gxg_GTK_GRID_w, gxg_GTK_GRID)
+Xen_wrap_1_arg(gxg_GTK_SCROLLABLE_w, gxg_GTK_SCROLLABLE)
+Xen_wrap_1_arg(gxg_GDK_RGBA_w, gxg_GDK_RGBA)
+Xen_wrap_1_arg(gxg_GTK_SWITCH_w, gxg_GTK_SWITCH)
+Xen_wrap_1_arg(gxg_GTK_ORIENTABLE_w, gxg_GTK_ORIENTABLE)
+Xen_wrap_1_arg(gxg_GTK_WINDOW_GROUP_w, gxg_GTK_WINDOW_GROUP)
+Xen_wrap_1_arg(gxg_GTK_TOOL_SHELL_w, gxg_GTK_TOOL_SHELL)
#endif
-#if (!HAVE_GTK_3)
-XEN_NARGIFY_1(gxg_GDK_IS_COLORMAP_w, gxg_GDK_IS_COLORMAP)
-XEN_NARGIFY_1(gxg_GDK_IS_DRAWABLE_w, gxg_GDK_IS_DRAWABLE)
-XEN_NARGIFY_1(gxg_GDK_IS_PIXMAP_w, gxg_GDK_IS_PIXMAP)
-XEN_NARGIFY_1(gxg_GTK_IS_OBJECT_w, gxg_GTK_IS_OBJECT)
-XEN_NARGIFY_1(gxg_GTK_IS_RC_STYLE_w, gxg_GTK_IS_RC_STYLE)
-XEN_NARGIFY_1(gxg_GTK_IS_STYLE_w, gxg_GTK_IS_STYLE)
+#if GTK_CHECK_VERSION(3, 2, 0)
+Xen_wrap_1_arg(gxg_GTK_OVERLAY_w, gxg_GTK_OVERLAY)
+Xen_wrap_1_arg(gxg_GTK_FONT_CHOOSER_w, gxg_GTK_FONT_CHOOSER)
+Xen_wrap_1_arg(gxg_GTK_FONT_CHOOSER_DIALOG_w, gxg_GTK_FONT_CHOOSER_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_FONT_CHOOSER_WIDGET_w, gxg_GTK_FONT_CHOOSER_WIDGET)
#endif
-XEN_NARGIFY_1(gxg_blue_w, gxg_blue)
-XEN_NARGIFY_1(gxg_green_w, gxg_green)
-XEN_NARGIFY_1(gxg_red_w, gxg_red)
-XEN_NARGIFY_1(gxg_pixel_w, gxg_pixel)
-XEN_NARGIFY_2(gxg_set_blue_w, gxg_set_blue)
-XEN_NARGIFY_2(gxg_set_green_w, gxg_set_green)
-XEN_NARGIFY_2(gxg_set_red_w, gxg_set_red)
-XEN_NARGIFY_2(gxg_set_pixel_w, gxg_set_pixel)
-XEN_VARGIFY(gxg_make_GdkColor_w, gxg_make_GdkColor)
-XEN_NARGIFY_0(gxg_make_GtkTextIter_w, gxg_make_GtkTextIter)
-XEN_NARGIFY_0(gxg_make_GtkTreeIter_w, gxg_make_GtkTreeIter)
-XEN_NARGIFY_0(gxg_make_PangoRectangle_w, gxg_make_PangoRectangle)
+#if GTK_CHECK_VERSION(3, 4, 0)
+Xen_wrap_1_arg(gxg_GTK_APPLICATION_WINDOW_w, gxg_GTK_APPLICATION_WINDOW)
+Xen_wrap_1_arg(gxg_GTK_COLOR_CHOOSER_DIALOG_w, gxg_GTK_COLOR_CHOOSER_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_COLOR_CHOOSER_WIDGET_w, gxg_GTK_COLOR_CHOOSER_WIDGET)
+#endif
-XEN_NARGIFY_0(gxg_make_cairo_matrix_t_w, gxg_make_cairo_matrix_t)
+#if GTK_CHECK_VERSION(3, 6, 0)
+Xen_wrap_1_arg(gxg_GTK_MENU_BUTTON_w, gxg_GTK_MENU_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_SEARCH_ENTRY_w, gxg_GTK_SEARCH_ENTRY)
+Xen_wrap_1_arg(gxg_GTK_LEVEL_BAR_w, gxg_GTK_LEVEL_BAR)
+#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-XEN_NARGIFY_0(gxg_make_GdkRGBA_w, gxg_make_GdkRGBA)
+#if GTK_CHECK_VERSION(3, 10, 0)
+Xen_wrap_1_arg(gxg_GTK_PLACES_SIDEBAR_w, gxg_GTK_PLACES_SIDEBAR)
+Xen_wrap_1_arg(gxg_GTK_STACK_SWITCHER_w, gxg_GTK_STACK_SWITCHER)
+Xen_wrap_1_arg(gxg_GTK_STACK_w, gxg_GTK_STACK)
+Xen_wrap_1_arg(gxg_GTK_REVEALER_w, gxg_GTK_REVEALER)
+Xen_wrap_1_arg(gxg_GTK_HEADER_BAR_w, gxg_GTK_HEADER_BAR)
+Xen_wrap_1_arg(gxg_GTK_LIST_BOX_w, gxg_GTK_LIST_BOX)
+Xen_wrap_1_arg(gxg_GTK_LIST_BOX_ROW_w, gxg_GTK_LIST_BOX_ROW)
+Xen_wrap_1_arg(gxg_GTK_SEARCH_BAR_w, gxg_GTK_SEARCH_BAR)
+#endif
+#if GTK_CHECK_VERSION(3, 12, 0)
+Xen_wrap_1_arg(gxg_GTK_FLOW_BOX_w, gxg_GTK_FLOW_BOX)
+Xen_wrap_1_arg(gxg_GTK_FLOW_BOX_CHILD_w, gxg_GTK_FLOW_BOX_CHILD)
+Xen_wrap_1_arg(gxg_GTK_ACTION_BAR_w, gxg_GTK_ACTION_BAR)
+Xen_wrap_1_arg(gxg_GTK_POPOVER_w, gxg_GTK_POPOVER)
#endif
+#if GTK_CHECK_VERSION(3, 14, 0)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_w, gxg_GTK_GESTURE)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_DRAG_w, gxg_GTK_GESTURE_DRAG)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_LONG_PRESS_w, gxg_GTK_GESTURE_LONG_PRESS)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_ZOOM_w, gxg_GTK_GESTURE_ZOOM)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_SWIPE_w, gxg_GTK_GESTURE_SWIPE)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_SINGLE_w, gxg_GTK_GESTURE_SINGLE)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_PAN_w, gxg_GTK_GESTURE_PAN)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_MULTI_PRESS_w, gxg_GTK_GESTURE_MULTI_PRESS)
+Xen_wrap_1_arg(gxg_GTK_GESTURE_ROTATE_w, gxg_GTK_GESTURE_ROTATE)
+Xen_wrap_1_arg(gxg_GTK_EVENT_CONTROLLER_w, gxg_GTK_EVENT_CONTROLLER)
+#endif
-#else
-/* not XEN_ARGIFY_1 */
-#define gxg_g_type_name_w gxg_g_type_name
-#define gxg_g_type_qname_w gxg_g_type_qname
-#define gxg_g_type_from_name_w gxg_g_type_from_name
-#define gxg_g_type_parent_w gxg_g_type_parent
-#define gxg_g_type_is_a_w gxg_g_type_is_a
-#define gxg_g_cclosure_new_w gxg_g_cclosure_new
-#define gxg_g_signal_newv_w gxg_g_signal_newv
-#define gxg_g_signal_lookup_w gxg_g_signal_lookup
-#define gxg_g_signal_name_w gxg_g_signal_name
-#define gxg_g_signal_query_w gxg_g_signal_query
-#define gxg_g_signal_list_ids_w gxg_g_signal_list_ids
-#define gxg_g_signal_parse_name_w gxg_g_signal_parse_name
-#define gxg_g_signal_get_invocation_hint_w gxg_g_signal_get_invocation_hint
-#define gxg_g_signal_stop_emission_w gxg_g_signal_stop_emission
-#define gxg_g_signal_stop_emission_by_name_w gxg_g_signal_stop_emission_by_name
-#define gxg_g_signal_add_emission_hook_w gxg_g_signal_add_emission_hook
-#define gxg_g_signal_remove_emission_hook_w gxg_g_signal_remove_emission_hook
-#define gxg_g_signal_has_handler_pending_w gxg_g_signal_has_handler_pending
-#define gxg_g_signal_connect_closure_by_id_w gxg_g_signal_connect_closure_by_id
-#define gxg_g_signal_connect_closure_w gxg_g_signal_connect_closure
-#define gxg_g_signal_connect_data_w gxg_g_signal_connect_data
-#define gxg_g_signal_handler_block_w gxg_g_signal_handler_block
-#define gxg_g_signal_handler_unblock_w gxg_g_signal_handler_unblock
-#define gxg_g_signal_handler_disconnect_w gxg_g_signal_handler_disconnect
-#define gxg_g_signal_handler_is_connected_w gxg_g_signal_handler_is_connected
-#define gxg_g_signal_handler_find_w gxg_g_signal_handler_find
-#define gxg_g_signal_handlers_block_matched_w gxg_g_signal_handlers_block_matched
-#define gxg_g_signal_handlers_unblock_matched_w gxg_g_signal_handlers_unblock_matched
-#define gxg_g_signal_handlers_disconnect_matched_w gxg_g_signal_handlers_disconnect_matched
-#define gxg_g_signal_handlers_destroy_w gxg_g_signal_handlers_destroy
-#define gxg_g_object_ref_w gxg_g_object_ref
-#define gxg_g_object_unref_w gxg_g_object_unref
-#define gxg_gdk_visual_get_system_w gxg_gdk_visual_get_system
-#define gxg_gdk_color_copy_w gxg_gdk_color_copy
-#define gxg_gdk_color_free_w gxg_gdk_color_free
-#define gxg_gdk_color_parse_w gxg_gdk_color_parse
-#define gxg_gdk_color_hash_w gxg_gdk_color_hash
-#define gxg_gdk_color_equal_w gxg_gdk_color_equal
-#define gxg_gdk_cursor_new_w gxg_gdk_cursor_new
-#define gxg_gdk_drag_status_w gxg_gdk_drag_status
-#define gxg_gdk_drop_reply_w gxg_gdk_drop_reply
-#define gxg_gdk_drop_finish_w gxg_gdk_drop_finish
-#define gxg_gdk_drag_get_selection_w gxg_gdk_drag_get_selection
-#define gxg_gdk_drag_begin_w gxg_gdk_drag_begin
-#define gxg_gdk_drag_drop_w gxg_gdk_drag_drop
-#define gxg_gdk_drag_abort_w gxg_gdk_drag_abort
-#define gxg_gdk_events_pending_w gxg_gdk_events_pending
-#define gxg_gdk_event_get_w gxg_gdk_event_get
-#define gxg_gdk_event_peek_w gxg_gdk_event_peek
-#define gxg_gdk_event_put_w gxg_gdk_event_put
-#define gxg_gdk_event_copy_w gxg_gdk_event_copy
-#define gxg_gdk_event_free_w gxg_gdk_event_free
-#define gxg_gdk_event_get_time_w gxg_gdk_event_get_time
-#define gxg_gdk_event_get_state_w gxg_gdk_event_get_state
-#define gxg_gdk_event_get_coords_w gxg_gdk_event_get_coords
-#define gxg_gdk_event_get_root_coords_w gxg_gdk_event_get_root_coords
-#define gxg_gdk_event_handler_set_w gxg_gdk_event_handler_set
-#define gxg_gdk_set_show_events_w gxg_gdk_set_show_events
-#define gxg_gdk_get_show_events_w gxg_gdk_get_show_events
-#define gxg_gdk_init_w gxg_gdk_init
-#define gxg_gdk_init_check_w gxg_gdk_init_check
-#define gxg_gdk_get_program_class_w gxg_gdk_get_program_class
-#define gxg_gdk_set_program_class_w gxg_gdk_set_program_class
-#define gxg_gdk_error_trap_push_w gxg_gdk_error_trap_push
-#define gxg_gdk_error_trap_pop_w gxg_gdk_error_trap_pop
-#define gxg_gdk_get_display_w gxg_gdk_get_display
-#define gxg_gdk_get_display_arg_name_w gxg_gdk_get_display_arg_name
-#define gxg_gdk_notify_startup_complete_w gxg_gdk_notify_startup_complete
-#define gxg_gdk_screen_width_w gxg_gdk_screen_width
-#define gxg_gdk_screen_height_w gxg_gdk_screen_height
-#define gxg_gdk_screen_width_mm_w gxg_gdk_screen_width_mm
-#define gxg_gdk_screen_height_mm_w gxg_gdk_screen_height_mm
-#define gxg_gdk_flush_w gxg_gdk_flush
-#define gxg_gdk_beep_w gxg_gdk_beep
-#define gxg_gdk_set_double_click_time_w gxg_gdk_set_double_click_time
-#define gxg_gdk_rectangle_intersect_w gxg_gdk_rectangle_intersect
-#define gxg_gdk_rectangle_union_w gxg_gdk_rectangle_union
-#define gxg_gdk_threads_enter_w gxg_gdk_threads_enter
-#define gxg_gdk_threads_leave_w gxg_gdk_threads_leave
-#define gxg_gdk_threads_init_w gxg_gdk_threads_init
-#define gxg_gdk_keymap_get_default_w gxg_gdk_keymap_get_default
-#define gxg_gdk_keymap_lookup_key_w gxg_gdk_keymap_lookup_key
-#define gxg_gdk_keymap_get_entries_for_keyval_w gxg_gdk_keymap_get_entries_for_keyval
-#define gxg_gdk_keymap_get_entries_for_keycode_w gxg_gdk_keymap_get_entries_for_keycode
-#define gxg_gdk_keymap_get_direction_w gxg_gdk_keymap_get_direction
-#define gxg_gdk_keyval_name_w gxg_gdk_keyval_name
-#define gxg_gdk_keyval_from_name_w gxg_gdk_keyval_from_name
-#define gxg_gdk_keyval_convert_case_w gxg_gdk_keyval_convert_case
-#define gxg_gdk_keyval_to_upper_w gxg_gdk_keyval_to_upper
-#define gxg_gdk_keyval_to_lower_w gxg_gdk_keyval_to_lower
-#define gxg_gdk_keyval_is_upper_w gxg_gdk_keyval_is_upper
-#define gxg_gdk_keyval_is_lower_w gxg_gdk_keyval_is_lower
-#define gxg_gdk_keyval_to_unicode_w gxg_gdk_keyval_to_unicode
-#define gxg_gdk_unicode_to_keyval_w gxg_gdk_unicode_to_keyval
-#define gxg_gdk_pango_context_get_w gxg_gdk_pango_context_get
-#define gxg_gdk_atom_intern_w gxg_gdk_atom_intern
-#define gxg_gdk_atom_name_w gxg_gdk_atom_name
-#define gxg_gdk_property_get_w gxg_gdk_property_get
-#define gxg_gdk_property_change_w gxg_gdk_property_change
-#define gxg_gdk_property_delete_w gxg_gdk_property_delete
-#define gxg_gdk_utf8_to_string_target_w gxg_gdk_utf8_to_string_target
-#define gxg_gdk_selection_owner_set_w gxg_gdk_selection_owner_set
-#define gxg_gdk_selection_owner_get_w gxg_gdk_selection_owner_get
-#define gxg_gdk_selection_convert_w gxg_gdk_selection_convert
-#define gxg_gdk_selection_property_get_w gxg_gdk_selection_property_get
-#define gxg_gdk_visual_get_best_depth_w gxg_gdk_visual_get_best_depth
-#define gxg_gdk_visual_get_best_type_w gxg_gdk_visual_get_best_type
-#define gxg_gdk_visual_get_best_w gxg_gdk_visual_get_best
-#define gxg_gdk_visual_get_best_with_depth_w gxg_gdk_visual_get_best_with_depth
-#define gxg_gdk_visual_get_best_with_type_w gxg_gdk_visual_get_best_with_type
-#define gxg_gdk_visual_get_best_with_both_w gxg_gdk_visual_get_best_with_both
-#define gxg_gdk_query_depths_w gxg_gdk_query_depths
-#define gxg_gdk_query_visual_types_w gxg_gdk_query_visual_types
-#define gxg_gdk_list_visuals_w gxg_gdk_list_visuals
-#define gxg_gdk_window_new_w gxg_gdk_window_new
-#define gxg_gdk_window_destroy_w gxg_gdk_window_destroy
-#define gxg_gdk_window_get_window_type_w gxg_gdk_window_get_window_type
-#define gxg_gdk_window_at_pointer_w gxg_gdk_window_at_pointer
-#define gxg_gdk_window_show_w gxg_gdk_window_show
-#define gxg_gdk_window_hide_w gxg_gdk_window_hide
-#define gxg_gdk_window_withdraw_w gxg_gdk_window_withdraw
-#define gxg_gdk_window_show_unraised_w gxg_gdk_window_show_unraised
-#define gxg_gdk_window_move_w gxg_gdk_window_move
-#define gxg_gdk_window_resize_w gxg_gdk_window_resize
-#define gxg_gdk_window_move_resize_w gxg_gdk_window_move_resize
-#define gxg_gdk_window_reparent_w gxg_gdk_window_reparent
-#define gxg_gdk_window_raise_w gxg_gdk_window_raise
-#define gxg_gdk_window_lower_w gxg_gdk_window_lower
-#define gxg_gdk_window_focus_w gxg_gdk_window_focus
-#define gxg_gdk_window_set_user_data_w gxg_gdk_window_set_user_data
-#define gxg_gdk_window_set_override_redirect_w gxg_gdk_window_set_override_redirect
-#define gxg_gdk_window_add_filter_w gxg_gdk_window_add_filter
-#define gxg_gdk_window_remove_filter_w gxg_gdk_window_remove_filter
-#define gxg_gdk_window_scroll_w gxg_gdk_window_scroll
-#define gxg_gdk_window_set_child_shapes_w gxg_gdk_window_set_child_shapes
-#define gxg_gdk_window_merge_child_shapes_w gxg_gdk_window_merge_child_shapes
-#define gxg_gdk_window_is_visible_w gxg_gdk_window_is_visible
-#define gxg_gdk_window_is_viewable_w gxg_gdk_window_is_viewable
-#define gxg_gdk_window_get_state_w gxg_gdk_window_get_state
-#define gxg_gdk_window_set_static_gravities_w gxg_gdk_window_set_static_gravities
-#define gxg_gdk_window_get_root_origin_w gxg_gdk_window_get_root_origin
-#define gxg_gdk_window_get_frame_extents_w gxg_gdk_window_get_frame_extents
-#define gxg_gdk_window_get_pointer_w gxg_gdk_window_get_pointer
-#define gxg_gdk_window_get_parent_w gxg_gdk_window_get_parent
-#define gxg_gdk_window_get_toplevel_w gxg_gdk_window_get_toplevel
-#define gxg_gdk_window_get_children_w gxg_gdk_window_get_children
-#define gxg_gdk_window_peek_children_w gxg_gdk_window_peek_children
-#define gxg_gdk_window_get_events_w gxg_gdk_window_get_events
-#define gxg_gdk_window_set_events_w gxg_gdk_window_set_events
-#define gxg_gdk_window_set_icon_list_w gxg_gdk_window_set_icon_list
-#define gxg_gdk_window_set_icon_name_w gxg_gdk_window_set_icon_name
-#define gxg_gdk_window_set_group_w gxg_gdk_window_set_group
-#define gxg_gdk_window_set_decorations_w gxg_gdk_window_set_decorations
-#define gxg_gdk_window_get_decorations_w gxg_gdk_window_get_decorations
-#define gxg_gdk_window_set_functions_w gxg_gdk_window_set_functions
-#define gxg_gdk_window_iconify_w gxg_gdk_window_iconify
-#define gxg_gdk_window_deiconify_w gxg_gdk_window_deiconify
-#define gxg_gdk_window_stick_w gxg_gdk_window_stick
-#define gxg_gdk_window_unstick_w gxg_gdk_window_unstick
-#define gxg_gdk_window_maximize_w gxg_gdk_window_maximize
-#define gxg_gdk_window_unmaximize_w gxg_gdk_window_unmaximize
-#define gxg_gdk_window_register_dnd_w gxg_gdk_window_register_dnd
-#define gxg_gdk_window_begin_resize_drag_w gxg_gdk_window_begin_resize_drag
-#define gxg_gdk_window_begin_move_drag_w gxg_gdk_window_begin_move_drag
-#define gxg_gdk_window_invalidate_rect_w gxg_gdk_window_invalidate_rect
-#define gxg_gdk_window_freeze_updates_w gxg_gdk_window_freeze_updates
-#define gxg_gdk_window_thaw_updates_w gxg_gdk_window_thaw_updates
-#define gxg_gdk_window_process_all_updates_w gxg_gdk_window_process_all_updates
-#define gxg_gdk_window_process_updates_w gxg_gdk_window_process_updates
-#define gxg_gdk_window_set_debug_updates_w gxg_gdk_window_set_debug_updates
-#define gxg_gdk_window_constrain_size_w gxg_gdk_window_constrain_size
-#define gxg_gdk_window_set_type_hint_w gxg_gdk_window_set_type_hint
-#define gxg_gdk_window_set_modal_hint_w gxg_gdk_window_set_modal_hint
-#define gxg_gdk_window_set_geometry_hints_w gxg_gdk_window_set_geometry_hints
-#define gxg_gdk_window_begin_paint_rect_w gxg_gdk_window_begin_paint_rect
-#define gxg_gdk_window_end_paint_w gxg_gdk_window_end_paint
-#define gxg_gdk_window_set_title_w gxg_gdk_window_set_title
-#define gxg_gdk_window_set_role_w gxg_gdk_window_set_role
-#define gxg_gdk_window_set_transient_for_w gxg_gdk_window_set_transient_for
-#define gxg_gdk_window_set_background_w gxg_gdk_window_set_background
-#define gxg_gdk_window_set_cursor_w gxg_gdk_window_set_cursor
-#define gxg_gdk_window_get_user_data_w gxg_gdk_window_get_user_data
-#define gxg_gdk_window_get_position_w gxg_gdk_window_get_position
-#define gxg_gdk_window_get_origin_w gxg_gdk_window_get_origin
-#define gxg_gdk_get_default_root_window_w gxg_gdk_get_default_root_window
-#define gxg_gdk_pixbuf_error_quark_w gxg_gdk_pixbuf_error_quark
-#define gxg_gdk_pixbuf_get_colorspace_w gxg_gdk_pixbuf_get_colorspace
-#define gxg_gdk_pixbuf_get_n_channels_w gxg_gdk_pixbuf_get_n_channels
-#define gxg_gdk_pixbuf_get_has_alpha_w gxg_gdk_pixbuf_get_has_alpha
-#define gxg_gdk_pixbuf_get_bits_per_sample_w gxg_gdk_pixbuf_get_bits_per_sample
-#define gxg_gdk_pixbuf_get_pixels_w gxg_gdk_pixbuf_get_pixels
-#define gxg_gdk_pixbuf_get_width_w gxg_gdk_pixbuf_get_width
-#define gxg_gdk_pixbuf_get_height_w gxg_gdk_pixbuf_get_height
-#define gxg_gdk_pixbuf_get_rowstride_w gxg_gdk_pixbuf_get_rowstride
-#define gxg_gdk_pixbuf_new_w gxg_gdk_pixbuf_new
-#define gxg_gdk_pixbuf_copy_w gxg_gdk_pixbuf_copy
-#define gxg_gdk_pixbuf_new_subpixbuf_w gxg_gdk_pixbuf_new_subpixbuf
-#define gxg_gdk_pixbuf_new_from_file_w gxg_gdk_pixbuf_new_from_file
-#define gxg_gdk_pixbuf_new_from_data_w gxg_gdk_pixbuf_new_from_data
-#define gxg_gdk_pixbuf_new_from_xpm_data_w gxg_gdk_pixbuf_new_from_xpm_data
-#define gxg_gdk_pixbuf_new_from_inline_w gxg_gdk_pixbuf_new_from_inline
-#define gxg_gdk_pixbuf_fill_w gxg_gdk_pixbuf_fill
-#define gxg_gdk_pixbuf_savev_w gxg_gdk_pixbuf_savev
-#define gxg_gdk_pixbuf_add_alpha_w gxg_gdk_pixbuf_add_alpha
-#define gxg_gdk_pixbuf_copy_area_w gxg_gdk_pixbuf_copy_area
-#define gxg_gdk_pixbuf_saturate_and_pixelate_w gxg_gdk_pixbuf_saturate_and_pixelate
-#define gxg_gdk_pixbuf_scale_w gxg_gdk_pixbuf_scale
-#define gxg_gdk_pixbuf_composite_w gxg_gdk_pixbuf_composite
-#define gxg_gdk_pixbuf_composite_color_w gxg_gdk_pixbuf_composite_color
-#define gxg_gdk_pixbuf_scale_simple_w gxg_gdk_pixbuf_scale_simple
-#define gxg_gdk_pixbuf_composite_color_simple_w gxg_gdk_pixbuf_composite_color_simple
-#define gxg_gdk_pixbuf_animation_new_from_file_w gxg_gdk_pixbuf_animation_new_from_file
-#define gxg_gdk_pixbuf_animation_get_width_w gxg_gdk_pixbuf_animation_get_width
-#define gxg_gdk_pixbuf_animation_get_height_w gxg_gdk_pixbuf_animation_get_height
-#define gxg_gdk_pixbuf_animation_is_static_image_w gxg_gdk_pixbuf_animation_is_static_image
-#define gxg_gdk_pixbuf_animation_get_static_image_w gxg_gdk_pixbuf_animation_get_static_image
-#define gxg_gdk_pixbuf_animation_get_iter_w gxg_gdk_pixbuf_animation_get_iter
-#define gxg_gdk_pixbuf_animation_iter_get_delay_time_w gxg_gdk_pixbuf_animation_iter_get_delay_time
-#define gxg_gdk_pixbuf_animation_iter_get_pixbuf_w gxg_gdk_pixbuf_animation_iter_get_pixbuf
-#define gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame_w gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame
-#define gxg_gdk_pixbuf_animation_iter_advance_w gxg_gdk_pixbuf_animation_iter_advance
-#define gxg_gdk_pixbuf_get_option_w gxg_gdk_pixbuf_get_option
-#define gxg_gtk_vbox_new_w gxg_gtk_vbox_new
-#define gxg_gtk_accel_group_new_w gxg_gtk_accel_group_new
-#define gxg_gtk_accel_group_lock_w gxg_gtk_accel_group_lock
-#define gxg_gtk_accel_group_unlock_w gxg_gtk_accel_group_unlock
-#define gxg_gtk_accel_group_connect_w gxg_gtk_accel_group_connect
-#define gxg_gtk_accel_group_connect_by_path_w gxg_gtk_accel_group_connect_by_path
-#define gxg_gtk_accel_group_disconnect_w gxg_gtk_accel_group_disconnect
-#define gxg_gtk_accel_group_disconnect_key_w gxg_gtk_accel_group_disconnect_key
-#define gxg_gtk_accel_groups_activate_w gxg_gtk_accel_groups_activate
-#define gxg_gtk_accel_groups_from_object_w gxg_gtk_accel_groups_from_object
-#define gxg_gtk_accel_group_find_w gxg_gtk_accel_group_find
-#define gxg_gtk_accel_group_from_accel_closure_w gxg_gtk_accel_group_from_accel_closure
-#define gxg_gtk_accelerator_valid_w gxg_gtk_accelerator_valid
-#define gxg_gtk_accelerator_parse_w gxg_gtk_accelerator_parse
-#define gxg_gtk_accelerator_name_w gxg_gtk_accelerator_name
-#define gxg_gtk_accelerator_set_default_mod_mask_w gxg_gtk_accelerator_set_default_mod_mask
-#define gxg_gtk_accel_group_query_w gxg_gtk_accel_group_query
-#define gxg_gtk_accel_group_activate_w gxg_gtk_accel_group_activate
-#define gxg_gtk_accel_label_new_w gxg_gtk_accel_label_new
-#define gxg_gtk_accel_label_get_accel_widget_w gxg_gtk_accel_label_get_accel_widget
-#define gxg_gtk_accel_label_get_accel_width_w gxg_gtk_accel_label_get_accel_width
-#define gxg_gtk_accel_label_set_accel_widget_w gxg_gtk_accel_label_set_accel_widget
-#define gxg_gtk_accel_label_set_accel_closure_w gxg_gtk_accel_label_set_accel_closure
-#define gxg_gtk_accel_label_refetch_w gxg_gtk_accel_label_refetch
-#define gxg_gtk_accel_map_add_entry_w gxg_gtk_accel_map_add_entry
-#define gxg_gtk_accel_map_lookup_entry_w gxg_gtk_accel_map_lookup_entry
-#define gxg_gtk_accel_map_change_entry_w gxg_gtk_accel_map_change_entry
-#define gxg_gtk_accel_map_load_w gxg_gtk_accel_map_load
-#define gxg_gtk_accel_map_save_w gxg_gtk_accel_map_save
-#define gxg_gtk_accel_map_foreach_w gxg_gtk_accel_map_foreach
-#define gxg_gtk_accel_map_load_fd_w gxg_gtk_accel_map_load_fd
-#define gxg_gtk_accel_map_save_fd_w gxg_gtk_accel_map_save_fd
-#define gxg_gtk_accel_map_add_filter_w gxg_gtk_accel_map_add_filter
-#define gxg_gtk_accel_map_foreach_unfiltered_w gxg_gtk_accel_map_foreach_unfiltered
-#define gxg_gtk_accessible_connect_widget_destroyed_w gxg_gtk_accessible_connect_widget_destroyed
-#define gxg_gtk_adjustment_changed_w gxg_gtk_adjustment_changed
-#define gxg_gtk_adjustment_value_changed_w gxg_gtk_adjustment_value_changed
-#define gxg_gtk_adjustment_clamp_page_w gxg_gtk_adjustment_clamp_page
-#define gxg_gtk_adjustment_get_value_w gxg_gtk_adjustment_get_value
-#define gxg_gtk_adjustment_set_value_w gxg_gtk_adjustment_set_value
-#define gxg_gtk_alignment_new_w gxg_gtk_alignment_new
-#define gxg_gtk_alignment_set_w gxg_gtk_alignment_set
-#define gxg_gtk_arrow_new_w gxg_gtk_arrow_new
-#define gxg_gtk_arrow_set_w gxg_gtk_arrow_set
-#define gxg_gtk_aspect_frame_new_w gxg_gtk_aspect_frame_new
-#define gxg_gtk_aspect_frame_set_w gxg_gtk_aspect_frame_set
-#define gxg_gtk_button_box_get_layout_w gxg_gtk_button_box_get_layout
-#define gxg_gtk_button_box_set_layout_w gxg_gtk_button_box_set_layout
-#define gxg_gtk_button_box_set_child_secondary_w gxg_gtk_button_box_set_child_secondary
-#define gxg_gtk_binding_set_new_w gxg_gtk_binding_set_new
-#define gxg_gtk_binding_set_by_class_w gxg_gtk_binding_set_by_class
-#define gxg_gtk_binding_set_find_w gxg_gtk_binding_set_find
-#define gxg_gtk_binding_entry_remove_w gxg_gtk_binding_entry_remove
-#define gxg_gtk_bin_get_child_w gxg_gtk_bin_get_child
-#define gxg_gtk_box_pack_start_w gxg_gtk_box_pack_start
-#define gxg_gtk_box_pack_end_w gxg_gtk_box_pack_end
-#define gxg_gtk_box_set_homogeneous_w gxg_gtk_box_set_homogeneous
-#define gxg_gtk_box_get_homogeneous_w gxg_gtk_box_get_homogeneous
-#define gxg_gtk_box_set_spacing_w gxg_gtk_box_set_spacing
-#define gxg_gtk_box_get_spacing_w gxg_gtk_box_get_spacing
-#define gxg_gtk_box_reorder_child_w gxg_gtk_box_reorder_child
-#define gxg_gtk_box_query_child_packing_w gxg_gtk_box_query_child_packing
-#define gxg_gtk_box_set_child_packing_w gxg_gtk_box_set_child_packing
-#define gxg_gtk_button_new_w gxg_gtk_button_new
-#define gxg_gtk_button_new_with_label_w gxg_gtk_button_new_with_label
-#define gxg_gtk_button_new_from_stock_w gxg_gtk_button_new_from_stock
-#define gxg_gtk_button_new_with_mnemonic_w gxg_gtk_button_new_with_mnemonic
-#define gxg_gtk_button_clicked_w gxg_gtk_button_clicked
-#define gxg_gtk_button_set_relief_w gxg_gtk_button_set_relief
-#define gxg_gtk_button_get_relief_w gxg_gtk_button_get_relief
-#define gxg_gtk_button_set_label_w gxg_gtk_button_set_label
-#define gxg_gtk_button_get_label_w gxg_gtk_button_get_label
-#define gxg_gtk_button_set_use_underline_w gxg_gtk_button_set_use_underline
-#define gxg_gtk_button_get_use_underline_w gxg_gtk_button_get_use_underline
-#define gxg_gtk_button_set_use_stock_w gxg_gtk_button_set_use_stock
-#define gxg_gtk_button_get_use_stock_w gxg_gtk_button_get_use_stock
-#define gxg_gtk_calendar_new_w gxg_gtk_calendar_new
-#define gxg_gtk_calendar_select_day_w gxg_gtk_calendar_select_day
-#define gxg_gtk_calendar_clear_marks_w gxg_gtk_calendar_clear_marks
-#define gxg_gtk_calendar_get_date_w gxg_gtk_calendar_get_date
-#define gxg_gtk_cell_editable_start_editing_w gxg_gtk_cell_editable_start_editing
-#define gxg_gtk_cell_editable_editing_done_w gxg_gtk_cell_editable_editing_done
-#define gxg_gtk_cell_editable_remove_widget_w gxg_gtk_cell_editable_remove_widget
-#define gxg_gtk_cell_renderer_activate_w gxg_gtk_cell_renderer_activate
-#define gxg_gtk_cell_renderer_start_editing_w gxg_gtk_cell_renderer_start_editing
-#define gxg_gtk_cell_renderer_set_fixed_size_w gxg_gtk_cell_renderer_set_fixed_size
-#define gxg_gtk_cell_renderer_get_fixed_size_w gxg_gtk_cell_renderer_get_fixed_size
-#define gxg_gtk_cell_renderer_pixbuf_new_w gxg_gtk_cell_renderer_pixbuf_new
-#define gxg_gtk_cell_renderer_text_new_w gxg_gtk_cell_renderer_text_new
-#define gxg_gtk_cell_renderer_text_set_fixed_height_from_font_w gxg_gtk_cell_renderer_text_set_fixed_height_from_font
-#define gxg_gtk_cell_renderer_toggle_new_w gxg_gtk_cell_renderer_toggle_new
-#define gxg_gtk_cell_renderer_toggle_get_radio_w gxg_gtk_cell_renderer_toggle_get_radio
-#define gxg_gtk_cell_renderer_toggle_set_radio_w gxg_gtk_cell_renderer_toggle_set_radio
-#define gxg_gtk_cell_renderer_toggle_get_active_w gxg_gtk_cell_renderer_toggle_get_active
-#define gxg_gtk_cell_renderer_toggle_set_active_w gxg_gtk_cell_renderer_toggle_set_active
-#define gxg_gtk_check_button_new_w gxg_gtk_check_button_new
-#define gxg_gtk_check_button_new_with_label_w gxg_gtk_check_button_new_with_label
-#define gxg_gtk_check_button_new_with_mnemonic_w gxg_gtk_check_button_new_with_mnemonic
-#define gxg_gtk_check_menu_item_new_w gxg_gtk_check_menu_item_new
-#define gxg_gtk_check_menu_item_new_with_label_w gxg_gtk_check_menu_item_new_with_label
-#define gxg_gtk_check_menu_item_new_with_mnemonic_w gxg_gtk_check_menu_item_new_with_mnemonic
-#define gxg_gtk_check_menu_item_set_active_w gxg_gtk_check_menu_item_set_active
-#define gxg_gtk_check_menu_item_get_active_w gxg_gtk_check_menu_item_get_active
-#define gxg_gtk_check_menu_item_toggled_w gxg_gtk_check_menu_item_toggled
-#define gxg_gtk_check_menu_item_set_inconsistent_w gxg_gtk_check_menu_item_set_inconsistent
-#define gxg_gtk_check_menu_item_get_inconsistent_w gxg_gtk_check_menu_item_get_inconsistent
-#define gxg_gtk_clipboard_get_w gxg_gtk_clipboard_get
-#define gxg_gtk_clipboard_set_with_data_w gxg_gtk_clipboard_set_with_data
-#define gxg_gtk_clipboard_get_owner_w gxg_gtk_clipboard_get_owner
-#define gxg_gtk_clipboard_clear_w gxg_gtk_clipboard_clear
-#define gxg_gtk_clipboard_set_text_w gxg_gtk_clipboard_set_text
-#define gxg_gtk_clipboard_request_contents_w gxg_gtk_clipboard_request_contents
-#define gxg_gtk_clipboard_request_text_w gxg_gtk_clipboard_request_text
-#define gxg_gtk_clipboard_wait_for_contents_w gxg_gtk_clipboard_wait_for_contents
-#define gxg_gtk_clipboard_wait_for_text_w gxg_gtk_clipboard_wait_for_text
-#define gxg_gtk_clipboard_wait_is_text_available_w gxg_gtk_clipboard_wait_is_text_available
-#define gxg_gtk_color_selection_dialog_new_w gxg_gtk_color_selection_dialog_new
-#define gxg_gtk_color_selection_new_w gxg_gtk_color_selection_new
-#define gxg_gtk_color_selection_get_has_opacity_control_w gxg_gtk_color_selection_get_has_opacity_control
-#define gxg_gtk_color_selection_set_has_opacity_control_w gxg_gtk_color_selection_set_has_opacity_control
-#define gxg_gtk_color_selection_get_has_palette_w gxg_gtk_color_selection_get_has_palette
-#define gxg_gtk_color_selection_set_has_palette_w gxg_gtk_color_selection_set_has_palette
-#define gxg_gtk_color_selection_set_current_color_w gxg_gtk_color_selection_set_current_color
-#define gxg_gtk_color_selection_set_current_alpha_w gxg_gtk_color_selection_set_current_alpha
-#define gxg_gtk_color_selection_get_current_color_w gxg_gtk_color_selection_get_current_color
-#define gxg_gtk_color_selection_get_current_alpha_w gxg_gtk_color_selection_get_current_alpha
-#define gxg_gtk_color_selection_set_previous_color_w gxg_gtk_color_selection_set_previous_color
-#define gxg_gtk_color_selection_set_previous_alpha_w gxg_gtk_color_selection_set_previous_alpha
-#define gxg_gtk_color_selection_get_previous_color_w gxg_gtk_color_selection_get_previous_color
-#define gxg_gtk_color_selection_get_previous_alpha_w gxg_gtk_color_selection_get_previous_alpha
-#define gxg_gtk_color_selection_is_adjusting_w gxg_gtk_color_selection_is_adjusting
-#define gxg_gtk_color_selection_palette_from_string_w gxg_gtk_color_selection_palette_from_string
-#define gxg_gtk_color_selection_palette_to_string_w gxg_gtk_color_selection_palette_to_string
-#define gxg_gtk_container_set_border_width_w gxg_gtk_container_set_border_width
-#define gxg_gtk_container_get_border_width_w gxg_gtk_container_get_border_width
-#define gxg_gtk_container_add_w gxg_gtk_container_add
-#define gxg_gtk_container_remove_w gxg_gtk_container_remove
-#define gxg_gtk_container_set_resize_mode_w gxg_gtk_container_set_resize_mode
-#define gxg_gtk_container_get_resize_mode_w gxg_gtk_container_get_resize_mode
-#define gxg_gtk_container_check_resize_w gxg_gtk_container_check_resize
-#define gxg_gtk_container_foreach_w gxg_gtk_container_foreach
-#define gxg_gtk_container_get_children_w gxg_gtk_container_get_children
-#define gxg_gtk_dialog_new_w gxg_gtk_dialog_new
-#define gxg_gtk_dialog_new_with_buttons_w gxg_gtk_dialog_new_with_buttons
-#define gxg_gtk_dialog_add_action_widget_w gxg_gtk_dialog_add_action_widget
-#define gxg_gtk_dialog_add_button_w gxg_gtk_dialog_add_button
-#define gxg_gtk_dialog_add_buttons_w gxg_gtk_dialog_add_buttons
-#define gxg_gtk_dialog_set_response_sensitive_w gxg_gtk_dialog_set_response_sensitive
-#define gxg_gtk_dialog_set_default_response_w gxg_gtk_dialog_set_default_response
-#define gxg_gtk_dialog_response_w gxg_gtk_dialog_response
-#define gxg_gtk_dialog_run_w gxg_gtk_dialog_run
-#define gxg_gtk_drag_get_data_w gxg_gtk_drag_get_data
-#define gxg_gtk_drag_finish_w gxg_gtk_drag_finish
-#define gxg_gtk_drag_get_source_widget_w gxg_gtk_drag_get_source_widget
-#define gxg_gtk_drag_highlight_w gxg_gtk_drag_highlight
-#define gxg_gtk_drag_unhighlight_w gxg_gtk_drag_unhighlight
-#define gxg_gtk_drag_dest_set_w gxg_gtk_drag_dest_set
-#define gxg_gtk_drag_dest_unset_w gxg_gtk_drag_dest_unset
-#define gxg_gtk_drag_dest_find_target_w gxg_gtk_drag_dest_find_target
-#define gxg_gtk_drag_dest_get_target_list_w gxg_gtk_drag_dest_get_target_list
-#define gxg_gtk_drag_dest_set_target_list_w gxg_gtk_drag_dest_set_target_list
-#define gxg_gtk_drag_source_set_w gxg_gtk_drag_source_set
-#define gxg_gtk_drag_source_unset_w gxg_gtk_drag_source_unset
-#define gxg_gtk_drag_source_set_icon_pixbuf_w gxg_gtk_drag_source_set_icon_pixbuf
-#define gxg_gtk_drag_source_set_icon_stock_w gxg_gtk_drag_source_set_icon_stock
-#define gxg_gtk_drag_begin_w gxg_gtk_drag_begin
-#define gxg_gtk_drag_set_icon_widget_w gxg_gtk_drag_set_icon_widget
-#define gxg_gtk_drag_set_icon_pixbuf_w gxg_gtk_drag_set_icon_pixbuf
-#define gxg_gtk_drag_set_icon_stock_w gxg_gtk_drag_set_icon_stock
-#define gxg_gtk_drag_set_icon_default_w gxg_gtk_drag_set_icon_default
-#define gxg_gtk_drag_check_threshold_w gxg_gtk_drag_check_threshold
-#define gxg_gtk_drawing_area_new_w gxg_gtk_drawing_area_new
-#define gxg_gtk_editable_select_region_w gxg_gtk_editable_select_region
-#define gxg_gtk_editable_get_selection_bounds_w gxg_gtk_editable_get_selection_bounds
-#define gxg_gtk_editable_insert_text_w gxg_gtk_editable_insert_text
-#define gxg_gtk_editable_delete_text_w gxg_gtk_editable_delete_text
-#define gxg_gtk_editable_get_chars_w gxg_gtk_editable_get_chars
-#define gxg_gtk_editable_cut_clipboard_w gxg_gtk_editable_cut_clipboard
-#define gxg_gtk_editable_copy_clipboard_w gxg_gtk_editable_copy_clipboard
-#define gxg_gtk_editable_paste_clipboard_w gxg_gtk_editable_paste_clipboard
-#define gxg_gtk_editable_delete_selection_w gxg_gtk_editable_delete_selection
-#define gxg_gtk_editable_set_position_w gxg_gtk_editable_set_position
-#define gxg_gtk_editable_get_position_w gxg_gtk_editable_get_position
-#define gxg_gtk_editable_set_editable_w gxg_gtk_editable_set_editable
-#define gxg_gtk_editable_get_editable_w gxg_gtk_editable_get_editable
-#define gxg_gtk_entry_new_w gxg_gtk_entry_new
-#define gxg_gtk_entry_set_visibility_w gxg_gtk_entry_set_visibility
-#define gxg_gtk_entry_get_visibility_w gxg_gtk_entry_get_visibility
-#define gxg_gtk_entry_set_invisible_char_w gxg_gtk_entry_set_invisible_char
-#define gxg_gtk_entry_get_invisible_char_w gxg_gtk_entry_get_invisible_char
-#define gxg_gtk_entry_set_has_frame_w gxg_gtk_entry_set_has_frame
-#define gxg_gtk_entry_get_has_frame_w gxg_gtk_entry_get_has_frame
-#define gxg_gtk_entry_set_max_length_w gxg_gtk_entry_set_max_length
-#define gxg_gtk_entry_get_max_length_w gxg_gtk_entry_get_max_length
-#define gxg_gtk_entry_set_activates_default_w gxg_gtk_entry_set_activates_default
-#define gxg_gtk_entry_get_activates_default_w gxg_gtk_entry_get_activates_default
-#define gxg_gtk_entry_set_width_chars_w gxg_gtk_entry_set_width_chars
-#define gxg_gtk_entry_get_width_chars_w gxg_gtk_entry_get_width_chars
-#define gxg_gtk_entry_set_text_w gxg_gtk_entry_set_text
-#define gxg_gtk_entry_get_text_w gxg_gtk_entry_get_text
-#define gxg_gtk_entry_get_layout_w gxg_gtk_entry_get_layout
-#define gxg_gtk_entry_get_layout_offsets_w gxg_gtk_entry_get_layout_offsets
-#define gxg_gtk_event_box_new_w gxg_gtk_event_box_new
-#define gxg_gtk_fixed_new_w gxg_gtk_fixed_new
-#define gxg_gtk_fixed_put_w gxg_gtk_fixed_put
-#define gxg_gtk_fixed_move_w gxg_gtk_fixed_move
-#define gxg_gtk_font_selection_new_w gxg_gtk_font_selection_new
-#define gxg_gtk_font_selection_get_font_name_w gxg_gtk_font_selection_get_font_name
-#define gxg_gtk_font_selection_set_font_name_w gxg_gtk_font_selection_set_font_name
-#define gxg_gtk_font_selection_get_preview_text_w gxg_gtk_font_selection_get_preview_text
-#define gxg_gtk_font_selection_set_preview_text_w gxg_gtk_font_selection_set_preview_text
-#define gxg_gtk_font_selection_dialog_new_w gxg_gtk_font_selection_dialog_new
-#define gxg_gtk_font_selection_dialog_get_font_name_w gxg_gtk_font_selection_dialog_get_font_name
-#define gxg_gtk_font_selection_dialog_set_font_name_w gxg_gtk_font_selection_dialog_set_font_name
-#define gxg_gtk_font_selection_dialog_get_preview_text_w gxg_gtk_font_selection_dialog_get_preview_text
-#define gxg_gtk_font_selection_dialog_set_preview_text_w gxg_gtk_font_selection_dialog_set_preview_text
-#define gxg_gtk_frame_new_w gxg_gtk_frame_new
-#define gxg_gtk_frame_set_label_w gxg_gtk_frame_set_label
-#define gxg_gtk_frame_get_label_w gxg_gtk_frame_get_label
-#define gxg_gtk_frame_set_label_widget_w gxg_gtk_frame_set_label_widget
-#define gxg_gtk_frame_get_label_widget_w gxg_gtk_frame_get_label_widget
-#define gxg_gtk_frame_set_label_align_w gxg_gtk_frame_set_label_align
-#define gxg_gtk_frame_get_label_align_w gxg_gtk_frame_get_label_align
-#define gxg_gtk_frame_set_shadow_type_w gxg_gtk_frame_set_shadow_type
-#define gxg_gtk_frame_get_shadow_type_w gxg_gtk_frame_get_shadow_type
-#define gxg_gtk_handle_box_new_w gxg_gtk_handle_box_new
-#define gxg_gtk_handle_box_set_shadow_type_w gxg_gtk_handle_box_set_shadow_type
-#define gxg_gtk_handle_box_get_shadow_type_w gxg_gtk_handle_box_get_shadow_type
-#define gxg_gtk_handle_box_set_handle_position_w gxg_gtk_handle_box_set_handle_position
-#define gxg_gtk_handle_box_get_handle_position_w gxg_gtk_handle_box_get_handle_position
-#define gxg_gtk_handle_box_set_snap_edge_w gxg_gtk_handle_box_set_snap_edge
-#define gxg_gtk_handle_box_get_snap_edge_w gxg_gtk_handle_box_get_snap_edge
-#define gxg_gtk_hbutton_box_new_w gxg_gtk_hbutton_box_new
-#define gxg_gtk_hbox_new_w gxg_gtk_hbox_new
-#define gxg_gtk_hpaned_new_w gxg_gtk_hpaned_new
-#define gxg_gtk_hscale_new_w gxg_gtk_hscale_new
-#define gxg_gtk_hscale_new_with_range_w gxg_gtk_hscale_new_with_range
-#define gxg_gtk_hscrollbar_new_w gxg_gtk_hscrollbar_new
-#define gxg_gtk_hseparator_new_w gxg_gtk_hseparator_new
-#define gxg_gtk_icon_factory_new_w gxg_gtk_icon_factory_new
-#define gxg_gtk_icon_factory_add_w gxg_gtk_icon_factory_add
-#define gxg_gtk_icon_factory_lookup_w gxg_gtk_icon_factory_lookup
-#define gxg_gtk_icon_factory_add_default_w gxg_gtk_icon_factory_add_default
-#define gxg_gtk_icon_factory_remove_default_w gxg_gtk_icon_factory_remove_default
-#define gxg_gtk_icon_factory_lookup_default_w gxg_gtk_icon_factory_lookup_default
-#define gxg_gtk_icon_size_lookup_w gxg_gtk_icon_size_lookup
-#define gxg_gtk_icon_size_register_w gxg_gtk_icon_size_register
-#define gxg_gtk_icon_size_register_alias_w gxg_gtk_icon_size_register_alias
-#define gxg_gtk_icon_size_from_name_w gxg_gtk_icon_size_from_name
-#define gxg_gtk_icon_size_get_name_w gxg_gtk_icon_size_get_name
-#define gxg_gtk_icon_set_new_w gxg_gtk_icon_set_new
-#define gxg_gtk_icon_set_new_from_pixbuf_w gxg_gtk_icon_set_new_from_pixbuf
-#define gxg_gtk_icon_set_ref_w gxg_gtk_icon_set_ref
-#define gxg_gtk_icon_set_unref_w gxg_gtk_icon_set_unref
-#define gxg_gtk_icon_set_copy_w gxg_gtk_icon_set_copy
-#define gxg_gtk_icon_set_add_source_w gxg_gtk_icon_set_add_source
-#define gxg_gtk_icon_set_get_sizes_w gxg_gtk_icon_set_get_sizes
-#define gxg_gtk_icon_source_new_w gxg_gtk_icon_source_new
-#define gxg_gtk_icon_source_copy_w gxg_gtk_icon_source_copy
-#define gxg_gtk_icon_source_free_w gxg_gtk_icon_source_free
-#define gxg_gtk_icon_source_set_filename_w gxg_gtk_icon_source_set_filename
-#define gxg_gtk_icon_source_set_pixbuf_w gxg_gtk_icon_source_set_pixbuf
-#define gxg_gtk_icon_source_get_filename_w gxg_gtk_icon_source_get_filename
-#define gxg_gtk_icon_source_get_pixbuf_w gxg_gtk_icon_source_get_pixbuf
-#define gxg_gtk_icon_source_set_direction_wildcarded_w gxg_gtk_icon_source_set_direction_wildcarded
-#define gxg_gtk_icon_source_set_state_wildcarded_w gxg_gtk_icon_source_set_state_wildcarded
-#define gxg_gtk_icon_source_set_size_wildcarded_w gxg_gtk_icon_source_set_size_wildcarded
-#define gxg_gtk_icon_source_get_size_wildcarded_w gxg_gtk_icon_source_get_size_wildcarded
-#define gxg_gtk_icon_source_get_state_wildcarded_w gxg_gtk_icon_source_get_state_wildcarded
-#define gxg_gtk_icon_source_get_direction_wildcarded_w gxg_gtk_icon_source_get_direction_wildcarded
-#define gxg_gtk_icon_source_set_direction_w gxg_gtk_icon_source_set_direction
-#define gxg_gtk_icon_source_set_state_w gxg_gtk_icon_source_set_state
-#define gxg_gtk_icon_source_set_size_w gxg_gtk_icon_source_set_size
-#define gxg_gtk_icon_source_get_direction_w gxg_gtk_icon_source_get_direction
-#define gxg_gtk_icon_source_get_state_w gxg_gtk_icon_source_get_state
-#define gxg_gtk_icon_source_get_size_w gxg_gtk_icon_source_get_size
-#define gxg_gtk_image_new_w gxg_gtk_image_new
-#define gxg_gtk_image_new_from_file_w gxg_gtk_image_new_from_file
-#define gxg_gtk_image_new_from_pixbuf_w gxg_gtk_image_new_from_pixbuf
-#define gxg_gtk_image_new_from_stock_w gxg_gtk_image_new_from_stock
-#define gxg_gtk_image_new_from_icon_set_w gxg_gtk_image_new_from_icon_set
-#define gxg_gtk_image_new_from_animation_w gxg_gtk_image_new_from_animation
-#define gxg_gtk_image_set_from_file_w gxg_gtk_image_set_from_file
-#define gxg_gtk_image_set_from_pixbuf_w gxg_gtk_image_set_from_pixbuf
-#define gxg_gtk_image_set_from_stock_w gxg_gtk_image_set_from_stock
-#define gxg_gtk_image_set_from_icon_set_w gxg_gtk_image_set_from_icon_set
-#define gxg_gtk_image_set_from_animation_w gxg_gtk_image_set_from_animation
-#define gxg_gtk_image_get_storage_type_w gxg_gtk_image_get_storage_type
-#define gxg_gtk_image_get_pixbuf_w gxg_gtk_image_get_pixbuf
-#define gxg_gtk_image_get_stock_w gxg_gtk_image_get_stock
-#define gxg_gtk_image_get_icon_set_w gxg_gtk_image_get_icon_set
-#define gxg_gtk_image_get_animation_w gxg_gtk_image_get_animation
-#define gxg_gtk_image_menu_item_new_w gxg_gtk_image_menu_item_new
-#define gxg_gtk_image_menu_item_new_with_label_w gxg_gtk_image_menu_item_new_with_label
-#define gxg_gtk_image_menu_item_new_with_mnemonic_w gxg_gtk_image_menu_item_new_with_mnemonic
-#define gxg_gtk_image_menu_item_new_from_stock_w gxg_gtk_image_menu_item_new_from_stock
-#define gxg_gtk_image_menu_item_set_image_w gxg_gtk_image_menu_item_set_image
-#define gxg_gtk_image_menu_item_get_image_w gxg_gtk_image_menu_item_get_image
-#define gxg_gtk_im_context_set_client_window_w gxg_gtk_im_context_set_client_window
-#define gxg_gtk_im_context_get_preedit_string_w gxg_gtk_im_context_get_preedit_string
-#define gxg_gtk_im_context_filter_keypress_w gxg_gtk_im_context_filter_keypress
-#define gxg_gtk_im_context_focus_in_w gxg_gtk_im_context_focus_in
-#define gxg_gtk_im_context_focus_out_w gxg_gtk_im_context_focus_out
-#define gxg_gtk_im_context_reset_w gxg_gtk_im_context_reset
-#define gxg_gtk_im_context_set_cursor_location_w gxg_gtk_im_context_set_cursor_location
-#define gxg_gtk_im_context_set_use_preedit_w gxg_gtk_im_context_set_use_preedit
-#define gxg_gtk_im_context_set_surrounding_w gxg_gtk_im_context_set_surrounding
-#define gxg_gtk_im_context_get_surrounding_w gxg_gtk_im_context_get_surrounding
-#define gxg_gtk_im_context_delete_surrounding_w gxg_gtk_im_context_delete_surrounding
-#define gxg_gtk_im_context_simple_new_w gxg_gtk_im_context_simple_new
-#define gxg_gtk_im_context_simple_add_table_w gxg_gtk_im_context_simple_add_table
-#define gxg_gtk_im_multicontext_new_w gxg_gtk_im_multicontext_new
-#define gxg_gtk_im_multicontext_append_menuitems_w gxg_gtk_im_multicontext_append_menuitems
-#define gxg_gtk_invisible_new_w gxg_gtk_invisible_new
-#define gxg_gtk_label_new_w gxg_gtk_label_new
-#define gxg_gtk_label_new_with_mnemonic_w gxg_gtk_label_new_with_mnemonic
-#define gxg_gtk_label_set_text_w gxg_gtk_label_set_text
-#define gxg_gtk_label_get_text_w gxg_gtk_label_get_text
-#define gxg_gtk_label_set_attributes_w gxg_gtk_label_set_attributes
-#define gxg_gtk_label_get_attributes_w gxg_gtk_label_get_attributes
-#define gxg_gtk_label_set_label_w gxg_gtk_label_set_label
-#define gxg_gtk_label_get_label_w gxg_gtk_label_get_label
-#define gxg_gtk_label_set_markup_w gxg_gtk_label_set_markup
-#define gxg_gtk_label_set_use_markup_w gxg_gtk_label_set_use_markup
-#define gxg_gtk_label_get_use_markup_w gxg_gtk_label_get_use_markup
-#define gxg_gtk_label_set_use_underline_w gxg_gtk_label_set_use_underline
-#define gxg_gtk_label_get_use_underline_w gxg_gtk_label_get_use_underline
-#define gxg_gtk_label_set_markup_with_mnemonic_w gxg_gtk_label_set_markup_with_mnemonic
-#define gxg_gtk_label_get_mnemonic_keyval_w gxg_gtk_label_get_mnemonic_keyval
-#define gxg_gtk_label_set_mnemonic_widget_w gxg_gtk_label_set_mnemonic_widget
-#define gxg_gtk_label_get_mnemonic_widget_w gxg_gtk_label_get_mnemonic_widget
-#define gxg_gtk_label_set_text_with_mnemonic_w gxg_gtk_label_set_text_with_mnemonic
-#define gxg_gtk_label_set_justify_w gxg_gtk_label_set_justify
-#define gxg_gtk_label_get_justify_w gxg_gtk_label_get_justify
-#define gxg_gtk_label_set_pattern_w gxg_gtk_label_set_pattern
-#define gxg_gtk_label_set_line_wrap_w gxg_gtk_label_set_line_wrap
-#define gxg_gtk_label_get_line_wrap_w gxg_gtk_label_get_line_wrap
-#define gxg_gtk_label_set_selectable_w gxg_gtk_label_set_selectable
-#define gxg_gtk_label_get_selectable_w gxg_gtk_label_get_selectable
-#define gxg_gtk_label_select_region_w gxg_gtk_label_select_region
-#define gxg_gtk_label_get_selection_bounds_w gxg_gtk_label_get_selection_bounds
-#define gxg_gtk_label_get_layout_w gxg_gtk_label_get_layout
-#define gxg_gtk_label_get_layout_offsets_w gxg_gtk_label_get_layout_offsets
-#define gxg_gtk_layout_new_w gxg_gtk_layout_new
-#define gxg_gtk_layout_put_w gxg_gtk_layout_put
-#define gxg_gtk_layout_move_w gxg_gtk_layout_move
-#define gxg_gtk_layout_set_size_w gxg_gtk_layout_set_size
-#define gxg_gtk_layout_get_size_w gxg_gtk_layout_get_size
-#define gxg_gtk_list_store_new_w gxg_gtk_list_store_new
-#define gxg_gtk_list_store_newv_w gxg_gtk_list_store_newv
-#define gxg_gtk_list_store_set_column_types_w gxg_gtk_list_store_set_column_types
-#define gxg_gtk_list_store_set_w gxg_gtk_list_store_set
-#define gxg_gtk_list_store_insert_w gxg_gtk_list_store_insert
-#define gxg_gtk_list_store_insert_before_w gxg_gtk_list_store_insert_before
-#define gxg_gtk_list_store_insert_after_w gxg_gtk_list_store_insert_after
-#define gxg_gtk_list_store_prepend_w gxg_gtk_list_store_prepend
-#define gxg_gtk_list_store_append_w gxg_gtk_list_store_append
-#define gxg_gtk_list_store_clear_w gxg_gtk_list_store_clear
-#define gxg_gtk_check_version_w gxg_gtk_check_version
-#define gxg_gtk_disable_setlocale_w gxg_gtk_disable_setlocale
-#define gxg_gtk_get_default_language_w gxg_gtk_get_default_language
-#define gxg_gtk_events_pending_w gxg_gtk_events_pending
-#define gxg_gtk_main_do_event_w gxg_gtk_main_do_event
-#define gxg_gtk_main_w gxg_gtk_main
-#define gxg_gtk_main_level_w gxg_gtk_main_level
-#define gxg_gtk_main_quit_w gxg_gtk_main_quit
-#define gxg_gtk_main_iteration_w gxg_gtk_main_iteration
-#define gxg_gtk_main_iteration_do_w gxg_gtk_main_iteration_do
-#define gxg_gtk_true_w gxg_gtk_true
-#define gxg_gtk_false_w gxg_gtk_false
-#define gxg_gtk_grab_add_w gxg_gtk_grab_add
-#define gxg_gtk_grab_get_current_w gxg_gtk_grab_get_current
-#define gxg_gtk_grab_remove_w gxg_gtk_grab_remove
-#define gxg_gtk_key_snooper_install_w gxg_gtk_key_snooper_install
-#define gxg_gtk_key_snooper_remove_w gxg_gtk_key_snooper_remove
-#define gxg_gtk_get_current_event_w gxg_gtk_get_current_event
-#define gxg_gtk_get_current_event_time_w gxg_gtk_get_current_event_time
-#define gxg_gtk_get_current_event_state_w gxg_gtk_get_current_event_state
-#define gxg_gtk_get_event_widget_w gxg_gtk_get_event_widget
-#define gxg_gtk_propagate_event_w gxg_gtk_propagate_event
-#define gxg_gtk_menu_bar_new_w gxg_gtk_menu_bar_new
-#define gxg_gtk_menu_new_w gxg_gtk_menu_new
-#define gxg_gtk_menu_popup_w gxg_gtk_menu_popup
-#define gxg_gtk_menu_reposition_w gxg_gtk_menu_reposition
-#define gxg_gtk_menu_popdown_w gxg_gtk_menu_popdown
-#define gxg_gtk_menu_get_active_w gxg_gtk_menu_get_active
-#define gxg_gtk_menu_set_active_w gxg_gtk_menu_set_active
-#define gxg_gtk_menu_set_accel_group_w gxg_gtk_menu_set_accel_group
-#define gxg_gtk_menu_get_accel_group_w gxg_gtk_menu_get_accel_group
-#define gxg_gtk_menu_set_accel_path_w gxg_gtk_menu_set_accel_path
-#define gxg_gtk_menu_detach_w gxg_gtk_menu_detach
-#define gxg_gtk_menu_get_attach_widget_w gxg_gtk_menu_get_attach_widget
-#define gxg_gtk_menu_set_tearoff_state_w gxg_gtk_menu_set_tearoff_state
-#define gxg_gtk_menu_get_tearoff_state_w gxg_gtk_menu_get_tearoff_state
-#define gxg_gtk_menu_set_title_w gxg_gtk_menu_set_title
-#define gxg_gtk_menu_get_title_w gxg_gtk_menu_get_title
-#define gxg_gtk_menu_reorder_child_w gxg_gtk_menu_reorder_child
-#define gxg_gtk_menu_set_monitor_w gxg_gtk_menu_set_monitor
-#define gxg_gtk_menu_item_new_w gxg_gtk_menu_item_new
-#define gxg_gtk_menu_item_new_with_label_w gxg_gtk_menu_item_new_with_label
-#define gxg_gtk_menu_item_new_with_mnemonic_w gxg_gtk_menu_item_new_with_mnemonic
-#define gxg_gtk_menu_item_set_submenu_w gxg_gtk_menu_item_set_submenu
-#define gxg_gtk_menu_item_get_submenu_w gxg_gtk_menu_item_get_submenu
-#define gxg_gtk_menu_item_select_w gxg_gtk_menu_item_select
-#define gxg_gtk_menu_item_deselect_w gxg_gtk_menu_item_deselect
-#define gxg_gtk_menu_item_activate_w gxg_gtk_menu_item_activate
-#define gxg_gtk_menu_item_toggle_size_request_w gxg_gtk_menu_item_toggle_size_request
-#define gxg_gtk_menu_item_toggle_size_allocate_w gxg_gtk_menu_item_toggle_size_allocate
-#define gxg_gtk_menu_item_set_right_justified_w gxg_gtk_menu_item_set_right_justified
-#define gxg_gtk_menu_item_get_right_justified_w gxg_gtk_menu_item_get_right_justified
-#define gxg_gtk_menu_item_set_accel_path_w gxg_gtk_menu_item_set_accel_path
-#define gxg_gtk_menu_shell_append_w gxg_gtk_menu_shell_append
-#define gxg_gtk_menu_shell_prepend_w gxg_gtk_menu_shell_prepend
-#define gxg_gtk_menu_shell_insert_w gxg_gtk_menu_shell_insert
-#define gxg_gtk_menu_shell_deactivate_w gxg_gtk_menu_shell_deactivate
-#define gxg_gtk_menu_shell_select_item_w gxg_gtk_menu_shell_select_item
-#define gxg_gtk_menu_shell_deselect_w gxg_gtk_menu_shell_deselect
-#define gxg_gtk_menu_shell_activate_item_w gxg_gtk_menu_shell_activate_item
-#define gxg_gtk_misc_set_alignment_w gxg_gtk_misc_set_alignment
-#define gxg_gtk_misc_get_alignment_w gxg_gtk_misc_get_alignment
-#define gxg_gtk_misc_set_padding_w gxg_gtk_misc_set_padding
-#define gxg_gtk_misc_get_padding_w gxg_gtk_misc_get_padding
-#define gxg_gtk_notebook_new_w gxg_gtk_notebook_new
-#define gxg_gtk_notebook_remove_page_w gxg_gtk_notebook_remove_page
-#define gxg_gtk_notebook_get_current_page_w gxg_gtk_notebook_get_current_page
-#define gxg_gtk_notebook_get_nth_page_w gxg_gtk_notebook_get_nth_page
-#define gxg_gtk_notebook_page_num_w gxg_gtk_notebook_page_num
-#define gxg_gtk_notebook_set_current_page_w gxg_gtk_notebook_set_current_page
-#define gxg_gtk_notebook_next_page_w gxg_gtk_notebook_next_page
-#define gxg_gtk_notebook_prev_page_w gxg_gtk_notebook_prev_page
-#define gxg_gtk_notebook_set_show_border_w gxg_gtk_notebook_set_show_border
-#define gxg_gtk_notebook_get_show_border_w gxg_gtk_notebook_get_show_border
-#define gxg_gtk_notebook_set_show_tabs_w gxg_gtk_notebook_set_show_tabs
-#define gxg_gtk_notebook_get_show_tabs_w gxg_gtk_notebook_get_show_tabs
-#define gxg_gtk_notebook_set_tab_pos_w gxg_gtk_notebook_set_tab_pos
-#define gxg_gtk_notebook_get_tab_pos_w gxg_gtk_notebook_get_tab_pos
-#define gxg_gtk_notebook_set_scrollable_w gxg_gtk_notebook_set_scrollable
-#define gxg_gtk_notebook_get_scrollable_w gxg_gtk_notebook_get_scrollable
-#define gxg_gtk_notebook_popup_enable_w gxg_gtk_notebook_popup_enable
-#define gxg_gtk_notebook_popup_disable_w gxg_gtk_notebook_popup_disable
-#define gxg_gtk_notebook_get_tab_label_w gxg_gtk_notebook_get_tab_label
-#define gxg_gtk_notebook_set_tab_label_w gxg_gtk_notebook_set_tab_label
-#define gxg_gtk_notebook_set_tab_label_text_w gxg_gtk_notebook_set_tab_label_text
-#define gxg_gtk_notebook_get_tab_label_text_w gxg_gtk_notebook_get_tab_label_text
-#define gxg_gtk_notebook_get_menu_label_w gxg_gtk_notebook_get_menu_label
-#define gxg_gtk_notebook_set_menu_label_w gxg_gtk_notebook_set_menu_label
-#define gxg_gtk_notebook_set_menu_label_text_w gxg_gtk_notebook_set_menu_label_text
-#define gxg_gtk_notebook_get_menu_label_text_w gxg_gtk_notebook_get_menu_label_text
-#define gxg_gtk_notebook_reorder_child_w gxg_gtk_notebook_reorder_child
-#define gxg_gtk_notebook_append_page_w gxg_gtk_notebook_append_page
-#define gxg_gtk_notebook_append_page_menu_w gxg_gtk_notebook_append_page_menu
-#define gxg_gtk_notebook_prepend_page_w gxg_gtk_notebook_prepend_page
-#define gxg_gtk_notebook_prepend_page_menu_w gxg_gtk_notebook_prepend_page_menu
-#define gxg_gtk_notebook_insert_page_w gxg_gtk_notebook_insert_page
-#define gxg_gtk_notebook_insert_page_menu_w gxg_gtk_notebook_insert_page_menu
-#define gxg_gtk_paned_add1_w gxg_gtk_paned_add1
-#define gxg_gtk_paned_add2_w gxg_gtk_paned_add2
-#define gxg_gtk_paned_pack1_w gxg_gtk_paned_pack1
-#define gxg_gtk_paned_pack2_w gxg_gtk_paned_pack2
-#define gxg_gtk_paned_get_position_w gxg_gtk_paned_get_position
-#define gxg_gtk_paned_set_position_w gxg_gtk_paned_set_position
-#define gxg_gtk_progress_bar_new_w gxg_gtk_progress_bar_new
-#define gxg_gtk_progress_bar_pulse_w gxg_gtk_progress_bar_pulse
-#define gxg_gtk_progress_bar_set_text_w gxg_gtk_progress_bar_set_text
-#define gxg_gtk_progress_bar_set_fraction_w gxg_gtk_progress_bar_set_fraction
-#define gxg_gtk_progress_bar_set_pulse_step_w gxg_gtk_progress_bar_set_pulse_step
-#define gxg_gtk_progress_bar_get_text_w gxg_gtk_progress_bar_get_text
-#define gxg_gtk_progress_bar_get_fraction_w gxg_gtk_progress_bar_get_fraction
-#define gxg_gtk_progress_bar_get_pulse_step_w gxg_gtk_progress_bar_get_pulse_step
-#define gxg_gtk_radio_button_new_w gxg_gtk_radio_button_new
-#define gxg_gtk_radio_button_new_from_widget_w gxg_gtk_radio_button_new_from_widget
-#define gxg_gtk_radio_button_new_with_label_w gxg_gtk_radio_button_new_with_label
-#define gxg_gtk_radio_button_new_with_label_from_widget_w gxg_gtk_radio_button_new_with_label_from_widget
-#define gxg_gtk_radio_button_new_with_mnemonic_w gxg_gtk_radio_button_new_with_mnemonic
-#define gxg_gtk_radio_button_new_with_mnemonic_from_widget_w gxg_gtk_radio_button_new_with_mnemonic_from_widget
-#define gxg_gtk_radio_button_get_group_w gxg_gtk_radio_button_get_group
-#define gxg_gtk_radio_button_set_group_w gxg_gtk_radio_button_set_group
-#define gxg_gtk_radio_menu_item_new_w gxg_gtk_radio_menu_item_new
-#define gxg_gtk_radio_menu_item_new_with_label_w gxg_gtk_radio_menu_item_new_with_label
-#define gxg_gtk_radio_menu_item_new_with_mnemonic_w gxg_gtk_radio_menu_item_new_with_mnemonic
-#define gxg_gtk_radio_menu_item_get_group_w gxg_gtk_radio_menu_item_get_group
-#define gxg_gtk_radio_menu_item_set_group_w gxg_gtk_radio_menu_item_set_group
-#define gxg_gtk_range_set_adjustment_w gxg_gtk_range_set_adjustment
-#define gxg_gtk_range_get_adjustment_w gxg_gtk_range_get_adjustment
-#define gxg_gtk_range_set_inverted_w gxg_gtk_range_set_inverted
-#define gxg_gtk_range_get_inverted_w gxg_gtk_range_get_inverted
-#define gxg_gtk_range_set_increments_w gxg_gtk_range_set_increments
-#define gxg_gtk_range_set_range_w gxg_gtk_range_set_range
-#define gxg_gtk_range_set_value_w gxg_gtk_range_set_value
-#define gxg_gtk_range_get_value_w gxg_gtk_range_get_value
-#define gxg_gtk_scale_set_digits_w gxg_gtk_scale_set_digits
-#define gxg_gtk_scale_get_digits_w gxg_gtk_scale_get_digits
-#define gxg_gtk_scale_set_draw_value_w gxg_gtk_scale_set_draw_value
-#define gxg_gtk_scale_get_draw_value_w gxg_gtk_scale_get_draw_value
-#define gxg_gtk_scale_set_value_pos_w gxg_gtk_scale_set_value_pos
-#define gxg_gtk_scale_get_value_pos_w gxg_gtk_scale_get_value_pos
-#define gxg_gtk_scrolled_window_new_w gxg_gtk_scrolled_window_new
-#define gxg_gtk_scrolled_window_set_hadjustment_w gxg_gtk_scrolled_window_set_hadjustment
-#define gxg_gtk_scrolled_window_set_vadjustment_w gxg_gtk_scrolled_window_set_vadjustment
-#define gxg_gtk_scrolled_window_get_hadjustment_w gxg_gtk_scrolled_window_get_hadjustment
-#define gxg_gtk_scrolled_window_get_vadjustment_w gxg_gtk_scrolled_window_get_vadjustment
-#define gxg_gtk_scrolled_window_set_policy_w gxg_gtk_scrolled_window_set_policy
-#define gxg_gtk_scrolled_window_get_policy_w gxg_gtk_scrolled_window_get_policy
-#define gxg_gtk_scrolled_window_set_placement_w gxg_gtk_scrolled_window_set_placement
-#define gxg_gtk_scrolled_window_get_placement_w gxg_gtk_scrolled_window_get_placement
-#define gxg_gtk_scrolled_window_set_shadow_type_w gxg_gtk_scrolled_window_set_shadow_type
-#define gxg_gtk_scrolled_window_get_shadow_type_w gxg_gtk_scrolled_window_get_shadow_type
-#define gxg_gtk_scrolled_window_add_with_viewport_w gxg_gtk_scrolled_window_add_with_viewport
-#define gxg_gtk_target_list_new_w gxg_gtk_target_list_new
-#define gxg_gtk_target_list_unref_w gxg_gtk_target_list_unref
-#define gxg_gtk_target_list_add_w gxg_gtk_target_list_add
-#define gxg_gtk_target_list_add_table_w gxg_gtk_target_list_add_table
-#define gxg_gtk_target_list_remove_w gxg_gtk_target_list_remove
-#define gxg_gtk_target_list_find_w gxg_gtk_target_list_find
-#define gxg_gtk_selection_owner_set_w gxg_gtk_selection_owner_set
-#define gxg_gtk_selection_add_target_w gxg_gtk_selection_add_target
-#define gxg_gtk_selection_add_targets_w gxg_gtk_selection_add_targets
-#define gxg_gtk_selection_clear_targets_w gxg_gtk_selection_clear_targets
-#define gxg_gtk_selection_convert_w gxg_gtk_selection_convert
-#define gxg_gtk_selection_data_set_w gxg_gtk_selection_data_set
-#define gxg_gtk_selection_data_set_text_w gxg_gtk_selection_data_set_text
-#define gxg_gtk_selection_data_get_text_w gxg_gtk_selection_data_get_text
-#define gxg_gtk_selection_data_get_targets_w gxg_gtk_selection_data_get_targets
-#define gxg_gtk_selection_data_targets_include_text_w gxg_gtk_selection_data_targets_include_text
-#define gxg_gtk_selection_remove_all_w gxg_gtk_selection_remove_all
-#define gxg_gtk_selection_data_copy_w gxg_gtk_selection_data_copy
-#define gxg_gtk_selection_data_free_w gxg_gtk_selection_data_free
-#define gxg_gtk_separator_menu_item_new_w gxg_gtk_separator_menu_item_new
-#define gxg_gtk_size_group_new_w gxg_gtk_size_group_new
-#define gxg_gtk_size_group_set_mode_w gxg_gtk_size_group_set_mode
-#define gxg_gtk_size_group_get_mode_w gxg_gtk_size_group_get_mode
-#define gxg_gtk_size_group_add_widget_w gxg_gtk_size_group_add_widget
-#define gxg_gtk_size_group_remove_widget_w gxg_gtk_size_group_remove_widget
-#define gxg_gtk_spin_button_configure_w gxg_gtk_spin_button_configure
-#define gxg_gtk_spin_button_new_w gxg_gtk_spin_button_new
-#define gxg_gtk_spin_button_new_with_range_w gxg_gtk_spin_button_new_with_range
-#define gxg_gtk_spin_button_set_adjustment_w gxg_gtk_spin_button_set_adjustment
-#define gxg_gtk_spin_button_get_adjustment_w gxg_gtk_spin_button_get_adjustment
-#define gxg_gtk_spin_button_set_digits_w gxg_gtk_spin_button_set_digits
-#define gxg_gtk_spin_button_get_digits_w gxg_gtk_spin_button_get_digits
-#define gxg_gtk_spin_button_set_increments_w gxg_gtk_spin_button_set_increments
-#define gxg_gtk_spin_button_get_increments_w gxg_gtk_spin_button_get_increments
-#define gxg_gtk_spin_button_set_range_w gxg_gtk_spin_button_set_range
-#define gxg_gtk_spin_button_get_range_w gxg_gtk_spin_button_get_range
-#define gxg_gtk_spin_button_get_value_w gxg_gtk_spin_button_get_value
-#define gxg_gtk_spin_button_get_value_as_int_w gxg_gtk_spin_button_get_value_as_int
-#define gxg_gtk_spin_button_set_value_w gxg_gtk_spin_button_set_value
-#define gxg_gtk_spin_button_set_update_policy_w gxg_gtk_spin_button_set_update_policy
-#define gxg_gtk_spin_button_get_update_policy_w gxg_gtk_spin_button_get_update_policy
-#define gxg_gtk_spin_button_set_numeric_w gxg_gtk_spin_button_set_numeric
-#define gxg_gtk_spin_button_get_numeric_w gxg_gtk_spin_button_get_numeric
-#define gxg_gtk_spin_button_spin_w gxg_gtk_spin_button_spin
-#define gxg_gtk_spin_button_set_wrap_w gxg_gtk_spin_button_set_wrap
-#define gxg_gtk_spin_button_get_wrap_w gxg_gtk_spin_button_get_wrap
-#define gxg_gtk_spin_button_set_snap_to_ticks_w gxg_gtk_spin_button_set_snap_to_ticks
-#define gxg_gtk_spin_button_get_snap_to_ticks_w gxg_gtk_spin_button_get_snap_to_ticks
-#define gxg_gtk_spin_button_update_w gxg_gtk_spin_button_update
-#define gxg_gtk_statusbar_new_w gxg_gtk_statusbar_new
-#define gxg_gtk_statusbar_get_context_id_w gxg_gtk_statusbar_get_context_id
-#define gxg_gtk_statusbar_push_w gxg_gtk_statusbar_push
-#define gxg_gtk_statusbar_pop_w gxg_gtk_statusbar_pop
-#define gxg_gtk_statusbar_remove_w gxg_gtk_statusbar_remove
-#define gxg_gtk_stock_add_w gxg_gtk_stock_add
-#define gxg_gtk_stock_add_static_w gxg_gtk_stock_add_static
-#define gxg_gtk_stock_lookup_w gxg_gtk_stock_lookup
-#define gxg_gtk_stock_list_ids_w gxg_gtk_stock_list_ids
-#define gxg_gtk_stock_item_copy_w gxg_gtk_stock_item_copy
-#define gxg_gtk_stock_item_free_w gxg_gtk_stock_item_free
-#define gxg_gtk_table_new_w gxg_gtk_table_new
-#define gxg_gtk_table_resize_w gxg_gtk_table_resize
-#define gxg_gtk_table_attach_w gxg_gtk_table_attach
-#define gxg_gtk_table_attach_defaults_w gxg_gtk_table_attach_defaults
-#define gxg_gtk_table_set_row_spacing_w gxg_gtk_table_set_row_spacing
-#define gxg_gtk_table_get_row_spacing_w gxg_gtk_table_get_row_spacing
-#define gxg_gtk_table_set_col_spacing_w gxg_gtk_table_set_col_spacing
-#define gxg_gtk_table_get_col_spacing_w gxg_gtk_table_get_col_spacing
-#define gxg_gtk_table_set_row_spacings_w gxg_gtk_table_set_row_spacings
-#define gxg_gtk_table_get_default_row_spacing_w gxg_gtk_table_get_default_row_spacing
-#define gxg_gtk_table_set_col_spacings_w gxg_gtk_table_set_col_spacings
-#define gxg_gtk_table_get_default_col_spacing_w gxg_gtk_table_get_default_col_spacing
-#define gxg_gtk_table_set_homogeneous_w gxg_gtk_table_set_homogeneous
-#define gxg_gtk_table_get_homogeneous_w gxg_gtk_table_get_homogeneous
-#define gxg_gtk_tearoff_menu_item_new_w gxg_gtk_tearoff_menu_item_new
-#define gxg_gtk_text_buffer_new_w gxg_gtk_text_buffer_new
-#define gxg_gtk_text_buffer_get_line_count_w gxg_gtk_text_buffer_get_line_count
-#define gxg_gtk_text_buffer_get_char_count_w gxg_gtk_text_buffer_get_char_count
-#define gxg_gtk_text_buffer_get_tag_table_w gxg_gtk_text_buffer_get_tag_table
-#define gxg_gtk_text_buffer_set_text_w gxg_gtk_text_buffer_set_text
-#define gxg_gtk_text_buffer_insert_w gxg_gtk_text_buffer_insert
-#define gxg_gtk_text_buffer_insert_at_cursor_w gxg_gtk_text_buffer_insert_at_cursor
-#define gxg_gtk_text_buffer_insert_interactive_w gxg_gtk_text_buffer_insert_interactive
-#define gxg_gtk_text_buffer_insert_interactive_at_cursor_w gxg_gtk_text_buffer_insert_interactive_at_cursor
-#define gxg_gtk_text_buffer_insert_range_w gxg_gtk_text_buffer_insert_range
-#define gxg_gtk_text_buffer_insert_range_interactive_w gxg_gtk_text_buffer_insert_range_interactive
-#define gxg_gtk_text_buffer_insert_with_tags_w gxg_gtk_text_buffer_insert_with_tags
-#define gxg_gtk_text_buffer_insert_with_tags_by_name_w gxg_gtk_text_buffer_insert_with_tags_by_name
-#define gxg_gtk_text_buffer_delete_w gxg_gtk_text_buffer_delete
-#define gxg_gtk_text_buffer_delete_interactive_w gxg_gtk_text_buffer_delete_interactive
-#define gxg_gtk_text_buffer_get_text_w gxg_gtk_text_buffer_get_text
-#define gxg_gtk_text_buffer_get_slice_w gxg_gtk_text_buffer_get_slice
-#define gxg_gtk_text_buffer_insert_pixbuf_w gxg_gtk_text_buffer_insert_pixbuf
-#define gxg_gtk_text_buffer_insert_child_anchor_w gxg_gtk_text_buffer_insert_child_anchor
-#define gxg_gtk_text_buffer_create_child_anchor_w gxg_gtk_text_buffer_create_child_anchor
-#define gxg_gtk_text_buffer_create_mark_w gxg_gtk_text_buffer_create_mark
-#define gxg_gtk_text_buffer_move_mark_w gxg_gtk_text_buffer_move_mark
-#define gxg_gtk_text_buffer_delete_mark_w gxg_gtk_text_buffer_delete_mark
-#define gxg_gtk_text_buffer_get_mark_w gxg_gtk_text_buffer_get_mark
-#define gxg_gtk_text_buffer_move_mark_by_name_w gxg_gtk_text_buffer_move_mark_by_name
-#define gxg_gtk_text_buffer_delete_mark_by_name_w gxg_gtk_text_buffer_delete_mark_by_name
-#define gxg_gtk_text_buffer_get_insert_w gxg_gtk_text_buffer_get_insert
-#define gxg_gtk_text_buffer_get_selection_bound_w gxg_gtk_text_buffer_get_selection_bound
-#define gxg_gtk_text_buffer_place_cursor_w gxg_gtk_text_buffer_place_cursor
-#define gxg_gtk_text_buffer_apply_tag_w gxg_gtk_text_buffer_apply_tag
-#define gxg_gtk_text_buffer_remove_tag_w gxg_gtk_text_buffer_remove_tag
-#define gxg_gtk_text_buffer_apply_tag_by_name_w gxg_gtk_text_buffer_apply_tag_by_name
-#define gxg_gtk_text_buffer_remove_tag_by_name_w gxg_gtk_text_buffer_remove_tag_by_name
-#define gxg_gtk_text_buffer_remove_all_tags_w gxg_gtk_text_buffer_remove_all_tags
-#define gxg_gtk_text_buffer_create_tag_w gxg_gtk_text_buffer_create_tag
-#define gxg_gtk_text_buffer_get_iter_at_line_offset_w gxg_gtk_text_buffer_get_iter_at_line_offset
-#define gxg_gtk_text_buffer_get_iter_at_line_index_w gxg_gtk_text_buffer_get_iter_at_line_index
-#define gxg_gtk_text_buffer_get_iter_at_offset_w gxg_gtk_text_buffer_get_iter_at_offset
-#define gxg_gtk_text_buffer_get_iter_at_line_w gxg_gtk_text_buffer_get_iter_at_line
-#define gxg_gtk_text_buffer_get_start_iter_w gxg_gtk_text_buffer_get_start_iter
-#define gxg_gtk_text_buffer_get_end_iter_w gxg_gtk_text_buffer_get_end_iter
-#define gxg_gtk_text_buffer_get_bounds_w gxg_gtk_text_buffer_get_bounds
-#define gxg_gtk_text_buffer_get_iter_at_mark_w gxg_gtk_text_buffer_get_iter_at_mark
-#define gxg_gtk_text_buffer_get_iter_at_child_anchor_w gxg_gtk_text_buffer_get_iter_at_child_anchor
-#define gxg_gtk_text_buffer_get_modified_w gxg_gtk_text_buffer_get_modified
-#define gxg_gtk_text_buffer_set_modified_w gxg_gtk_text_buffer_set_modified
-#define gxg_gtk_text_buffer_add_selection_clipboard_w gxg_gtk_text_buffer_add_selection_clipboard
-#define gxg_gtk_text_buffer_remove_selection_clipboard_w gxg_gtk_text_buffer_remove_selection_clipboard
-#define gxg_gtk_text_buffer_cut_clipboard_w gxg_gtk_text_buffer_cut_clipboard
-#define gxg_gtk_text_buffer_copy_clipboard_w gxg_gtk_text_buffer_copy_clipboard
-#define gxg_gtk_text_buffer_paste_clipboard_w gxg_gtk_text_buffer_paste_clipboard
-#define gxg_gtk_text_buffer_get_selection_bounds_w gxg_gtk_text_buffer_get_selection_bounds
-#define gxg_gtk_text_buffer_delete_selection_w gxg_gtk_text_buffer_delete_selection
-#define gxg_gtk_text_buffer_begin_user_action_w gxg_gtk_text_buffer_begin_user_action
-#define gxg_gtk_text_buffer_end_user_action_w gxg_gtk_text_buffer_end_user_action
-#define gxg_gtk_text_child_anchor_new_w gxg_gtk_text_child_anchor_new
-#define gxg_gtk_text_child_anchor_get_widgets_w gxg_gtk_text_child_anchor_get_widgets
-#define gxg_gtk_text_child_anchor_get_deleted_w gxg_gtk_text_child_anchor_get_deleted
-#define gxg_gtk_text_iter_get_buffer_w gxg_gtk_text_iter_get_buffer
-#define gxg_gtk_text_iter_copy_w gxg_gtk_text_iter_copy
-#define gxg_gtk_text_iter_free_w gxg_gtk_text_iter_free
-#define gxg_gtk_text_iter_get_offset_w gxg_gtk_text_iter_get_offset
-#define gxg_gtk_text_iter_get_line_w gxg_gtk_text_iter_get_line
-#define gxg_gtk_text_iter_get_line_offset_w gxg_gtk_text_iter_get_line_offset
-#define gxg_gtk_text_iter_get_line_index_w gxg_gtk_text_iter_get_line_index
-#define gxg_gtk_text_iter_get_visible_line_offset_w gxg_gtk_text_iter_get_visible_line_offset
-#define gxg_gtk_text_iter_get_visible_line_index_w gxg_gtk_text_iter_get_visible_line_index
-#define gxg_gtk_text_iter_get_char_w gxg_gtk_text_iter_get_char
-#define gxg_gtk_text_iter_get_slice_w gxg_gtk_text_iter_get_slice
-#define gxg_gtk_text_iter_get_text_w gxg_gtk_text_iter_get_text
-#define gxg_gtk_text_iter_get_visible_slice_w gxg_gtk_text_iter_get_visible_slice
-#define gxg_gtk_text_iter_get_visible_text_w gxg_gtk_text_iter_get_visible_text
-#define gxg_gtk_text_iter_get_pixbuf_w gxg_gtk_text_iter_get_pixbuf
-#define gxg_gtk_text_iter_get_marks_w gxg_gtk_text_iter_get_marks
-#define gxg_gtk_text_iter_get_child_anchor_w gxg_gtk_text_iter_get_child_anchor
-#define gxg_gtk_text_iter_get_toggled_tags_w gxg_gtk_text_iter_get_toggled_tags
-#define gxg_gtk_text_iter_begins_tag_w gxg_gtk_text_iter_begins_tag
-#define gxg_gtk_text_iter_ends_tag_w gxg_gtk_text_iter_ends_tag
-#define gxg_gtk_text_iter_toggles_tag_w gxg_gtk_text_iter_toggles_tag
-#define gxg_gtk_text_iter_has_tag_w gxg_gtk_text_iter_has_tag
-#define gxg_gtk_text_iter_get_tags_w gxg_gtk_text_iter_get_tags
-#define gxg_gtk_text_iter_editable_w gxg_gtk_text_iter_editable
-#define gxg_gtk_text_iter_can_insert_w gxg_gtk_text_iter_can_insert
-#define gxg_gtk_text_iter_starts_word_w gxg_gtk_text_iter_starts_word
-#define gxg_gtk_text_iter_ends_word_w gxg_gtk_text_iter_ends_word
-#define gxg_gtk_text_iter_inside_word_w gxg_gtk_text_iter_inside_word
-#define gxg_gtk_text_iter_starts_sentence_w gxg_gtk_text_iter_starts_sentence
-#define gxg_gtk_text_iter_ends_sentence_w gxg_gtk_text_iter_ends_sentence
-#define gxg_gtk_text_iter_inside_sentence_w gxg_gtk_text_iter_inside_sentence
-#define gxg_gtk_text_iter_starts_line_w gxg_gtk_text_iter_starts_line
-#define gxg_gtk_text_iter_ends_line_w gxg_gtk_text_iter_ends_line
-#define gxg_gtk_text_iter_is_cursor_position_w gxg_gtk_text_iter_is_cursor_position
-#define gxg_gtk_text_iter_get_chars_in_line_w gxg_gtk_text_iter_get_chars_in_line
-#define gxg_gtk_text_iter_get_bytes_in_line_w gxg_gtk_text_iter_get_bytes_in_line
-#define gxg_gtk_text_iter_get_attributes_w gxg_gtk_text_iter_get_attributes
-#define gxg_gtk_text_iter_get_language_w gxg_gtk_text_iter_get_language
-#define gxg_gtk_text_iter_is_end_w gxg_gtk_text_iter_is_end
-#define gxg_gtk_text_iter_is_start_w gxg_gtk_text_iter_is_start
-#define gxg_gtk_text_iter_forward_char_w gxg_gtk_text_iter_forward_char
-#define gxg_gtk_text_iter_backward_char_w gxg_gtk_text_iter_backward_char
-#define gxg_gtk_text_iter_forward_chars_w gxg_gtk_text_iter_forward_chars
-#define gxg_gtk_text_iter_backward_chars_w gxg_gtk_text_iter_backward_chars
-#define gxg_gtk_text_iter_forward_line_w gxg_gtk_text_iter_forward_line
-#define gxg_gtk_text_iter_backward_line_w gxg_gtk_text_iter_backward_line
-#define gxg_gtk_text_iter_forward_lines_w gxg_gtk_text_iter_forward_lines
-#define gxg_gtk_text_iter_backward_lines_w gxg_gtk_text_iter_backward_lines
-#define gxg_gtk_text_iter_forward_word_end_w gxg_gtk_text_iter_forward_word_end
-#define gxg_gtk_text_iter_backward_word_start_w gxg_gtk_text_iter_backward_word_start
-#define gxg_gtk_text_iter_forward_word_ends_w gxg_gtk_text_iter_forward_word_ends
-#define gxg_gtk_text_iter_backward_word_starts_w gxg_gtk_text_iter_backward_word_starts
-#define gxg_gtk_text_iter_forward_sentence_end_w gxg_gtk_text_iter_forward_sentence_end
-#define gxg_gtk_text_iter_backward_sentence_start_w gxg_gtk_text_iter_backward_sentence_start
-#define gxg_gtk_text_iter_forward_sentence_ends_w gxg_gtk_text_iter_forward_sentence_ends
-#define gxg_gtk_text_iter_backward_sentence_starts_w gxg_gtk_text_iter_backward_sentence_starts
-#define gxg_gtk_text_iter_forward_cursor_position_w gxg_gtk_text_iter_forward_cursor_position
-#define gxg_gtk_text_iter_backward_cursor_position_w gxg_gtk_text_iter_backward_cursor_position
-#define gxg_gtk_text_iter_forward_cursor_positions_w gxg_gtk_text_iter_forward_cursor_positions
-#define gxg_gtk_text_iter_backward_cursor_positions_w gxg_gtk_text_iter_backward_cursor_positions
-#define gxg_gtk_text_iter_set_offset_w gxg_gtk_text_iter_set_offset
-#define gxg_gtk_text_iter_set_line_w gxg_gtk_text_iter_set_line
-#define gxg_gtk_text_iter_set_line_offset_w gxg_gtk_text_iter_set_line_offset
-#define gxg_gtk_text_iter_set_line_index_w gxg_gtk_text_iter_set_line_index
-#define gxg_gtk_text_iter_forward_to_end_w gxg_gtk_text_iter_forward_to_end
-#define gxg_gtk_text_iter_forward_to_line_end_w gxg_gtk_text_iter_forward_to_line_end
-#define gxg_gtk_text_iter_set_visible_line_offset_w gxg_gtk_text_iter_set_visible_line_offset
-#define gxg_gtk_text_iter_set_visible_line_index_w gxg_gtk_text_iter_set_visible_line_index
-#define gxg_gtk_text_iter_forward_to_tag_toggle_w gxg_gtk_text_iter_forward_to_tag_toggle
-#define gxg_gtk_text_iter_backward_to_tag_toggle_w gxg_gtk_text_iter_backward_to_tag_toggle
-#define gxg_gtk_text_iter_forward_find_char_w gxg_gtk_text_iter_forward_find_char
-#define gxg_gtk_text_iter_backward_find_char_w gxg_gtk_text_iter_backward_find_char
-#define gxg_gtk_text_iter_forward_search_w gxg_gtk_text_iter_forward_search
-#define gxg_gtk_text_iter_backward_search_w gxg_gtk_text_iter_backward_search
-#define gxg_gtk_text_iter_equal_w gxg_gtk_text_iter_equal
-#define gxg_gtk_text_iter_compare_w gxg_gtk_text_iter_compare
-#define gxg_gtk_text_iter_in_range_w gxg_gtk_text_iter_in_range
-#define gxg_gtk_text_iter_order_w gxg_gtk_text_iter_order
-#define gxg_gtk_text_mark_set_visible_w gxg_gtk_text_mark_set_visible
-#define gxg_gtk_text_mark_get_visible_w gxg_gtk_text_mark_get_visible
-#define gxg_gtk_text_mark_get_name_w gxg_gtk_text_mark_get_name
-#define gxg_gtk_text_mark_get_deleted_w gxg_gtk_text_mark_get_deleted
-#define gxg_gtk_text_mark_get_buffer_w gxg_gtk_text_mark_get_buffer
-#define gxg_gtk_text_mark_get_left_gravity_w gxg_gtk_text_mark_get_left_gravity
-#define gxg_gtk_text_tag_new_w gxg_gtk_text_tag_new
-#define gxg_gtk_text_tag_get_priority_w gxg_gtk_text_tag_get_priority
-#define gxg_gtk_text_tag_set_priority_w gxg_gtk_text_tag_set_priority
-#define gxg_gtk_text_tag_event_w gxg_gtk_text_tag_event
-#define gxg_gtk_text_attributes_new_w gxg_gtk_text_attributes_new
-#define gxg_gtk_text_attributes_copy_w gxg_gtk_text_attributes_copy
-#define gxg_gtk_text_attributes_copy_values_w gxg_gtk_text_attributes_copy_values
-#define gxg_gtk_text_attributes_unref_w gxg_gtk_text_attributes_unref
-#define gxg_gtk_text_tag_table_new_w gxg_gtk_text_tag_table_new
-#define gxg_gtk_text_tag_table_add_w gxg_gtk_text_tag_table_add
-#define gxg_gtk_text_tag_table_remove_w gxg_gtk_text_tag_table_remove
-#define gxg_gtk_text_tag_table_lookup_w gxg_gtk_text_tag_table_lookup
-#define gxg_gtk_text_tag_table_foreach_w gxg_gtk_text_tag_table_foreach
-#define gxg_gtk_text_tag_table_get_size_w gxg_gtk_text_tag_table_get_size
-#define gxg_gtk_text_view_new_w gxg_gtk_text_view_new
-#define gxg_gtk_text_view_new_with_buffer_w gxg_gtk_text_view_new_with_buffer
-#define gxg_gtk_text_view_set_buffer_w gxg_gtk_text_view_set_buffer
-#define gxg_gtk_text_view_get_buffer_w gxg_gtk_text_view_get_buffer
-#define gxg_gtk_text_view_scroll_to_iter_w gxg_gtk_text_view_scroll_to_iter
-#define gxg_gtk_text_view_scroll_to_mark_w gxg_gtk_text_view_scroll_to_mark
-#define gxg_gtk_text_view_scroll_mark_onscreen_w gxg_gtk_text_view_scroll_mark_onscreen
-#define gxg_gtk_text_view_move_mark_onscreen_w gxg_gtk_text_view_move_mark_onscreen
-#define gxg_gtk_text_view_place_cursor_onscreen_w gxg_gtk_text_view_place_cursor_onscreen
-#define gxg_gtk_text_view_get_visible_rect_w gxg_gtk_text_view_get_visible_rect
-#define gxg_gtk_text_view_set_cursor_visible_w gxg_gtk_text_view_set_cursor_visible
-#define gxg_gtk_text_view_get_cursor_visible_w gxg_gtk_text_view_get_cursor_visible
-#define gxg_gtk_text_view_get_iter_location_w gxg_gtk_text_view_get_iter_location
-#define gxg_gtk_text_view_get_iter_at_location_w gxg_gtk_text_view_get_iter_at_location
-#define gxg_gtk_text_view_get_line_yrange_w gxg_gtk_text_view_get_line_yrange
-#define gxg_gtk_text_view_get_line_at_y_w gxg_gtk_text_view_get_line_at_y
-#define gxg_gtk_text_view_buffer_to_window_coords_w gxg_gtk_text_view_buffer_to_window_coords
-#define gxg_gtk_text_view_window_to_buffer_coords_w gxg_gtk_text_view_window_to_buffer_coords
-#define gxg_gtk_text_view_get_window_w gxg_gtk_text_view_get_window
-#define gxg_gtk_text_view_get_window_type_w gxg_gtk_text_view_get_window_type
-#define gxg_gtk_text_view_set_border_window_size_w gxg_gtk_text_view_set_border_window_size
-#define gxg_gtk_text_view_get_border_window_size_w gxg_gtk_text_view_get_border_window_size
-#define gxg_gtk_text_view_forward_display_line_w gxg_gtk_text_view_forward_display_line
-#define gxg_gtk_text_view_backward_display_line_w gxg_gtk_text_view_backward_display_line
-#define gxg_gtk_text_view_forward_display_line_end_w gxg_gtk_text_view_forward_display_line_end
-#define gxg_gtk_text_view_backward_display_line_start_w gxg_gtk_text_view_backward_display_line_start
-#define gxg_gtk_text_view_starts_display_line_w gxg_gtk_text_view_starts_display_line
-#define gxg_gtk_text_view_move_visually_w gxg_gtk_text_view_move_visually
-#define gxg_gtk_text_view_add_child_at_anchor_w gxg_gtk_text_view_add_child_at_anchor
-#define gxg_gtk_text_view_add_child_in_window_w gxg_gtk_text_view_add_child_in_window
-#define gxg_gtk_text_view_move_child_w gxg_gtk_text_view_move_child
-#define gxg_gtk_text_view_set_wrap_mode_w gxg_gtk_text_view_set_wrap_mode
-#define gxg_gtk_text_view_get_wrap_mode_w gxg_gtk_text_view_get_wrap_mode
-#define gxg_gtk_text_view_set_editable_w gxg_gtk_text_view_set_editable
-#define gxg_gtk_text_view_get_editable_w gxg_gtk_text_view_get_editable
-#define gxg_gtk_text_view_set_pixels_above_lines_w gxg_gtk_text_view_set_pixels_above_lines
-#define gxg_gtk_text_view_get_pixels_above_lines_w gxg_gtk_text_view_get_pixels_above_lines
-#define gxg_gtk_text_view_set_pixels_below_lines_w gxg_gtk_text_view_set_pixels_below_lines
-#define gxg_gtk_text_view_get_pixels_below_lines_w gxg_gtk_text_view_get_pixels_below_lines
-#define gxg_gtk_text_view_set_pixels_inside_wrap_w gxg_gtk_text_view_set_pixels_inside_wrap
-#define gxg_gtk_text_view_get_pixels_inside_wrap_w gxg_gtk_text_view_get_pixels_inside_wrap
-#define gxg_gtk_text_view_set_justification_w gxg_gtk_text_view_set_justification
-#define gxg_gtk_text_view_get_justification_w gxg_gtk_text_view_get_justification
-#define gxg_gtk_text_view_set_left_margin_w gxg_gtk_text_view_set_left_margin
-#define gxg_gtk_text_view_get_left_margin_w gxg_gtk_text_view_get_left_margin
-#define gxg_gtk_text_view_set_right_margin_w gxg_gtk_text_view_set_right_margin
-#define gxg_gtk_text_view_get_right_margin_w gxg_gtk_text_view_get_right_margin
-#define gxg_gtk_text_view_set_indent_w gxg_gtk_text_view_set_indent
-#define gxg_gtk_text_view_get_indent_w gxg_gtk_text_view_get_indent
-#define gxg_gtk_text_view_set_tabs_w gxg_gtk_text_view_set_tabs
-#define gxg_gtk_text_view_get_tabs_w gxg_gtk_text_view_get_tabs
-#define gxg_gtk_text_view_get_default_attributes_w gxg_gtk_text_view_get_default_attributes
-#define gxg_gtk_toggle_button_new_w gxg_gtk_toggle_button_new
-#define gxg_gtk_toggle_button_new_with_label_w gxg_gtk_toggle_button_new_with_label
-#define gxg_gtk_toggle_button_new_with_mnemonic_w gxg_gtk_toggle_button_new_with_mnemonic
-#define gxg_gtk_toggle_button_set_mode_w gxg_gtk_toggle_button_set_mode
-#define gxg_gtk_toggle_button_get_mode_w gxg_gtk_toggle_button_get_mode
-#define gxg_gtk_toggle_button_set_active_w gxg_gtk_toggle_button_set_active
-#define gxg_gtk_toggle_button_get_active_w gxg_gtk_toggle_button_get_active
-#define gxg_gtk_toggle_button_toggled_w gxg_gtk_toggle_button_toggled
-#define gxg_gtk_toggle_button_set_inconsistent_w gxg_gtk_toggle_button_set_inconsistent
-#define gxg_gtk_toggle_button_get_inconsistent_w gxg_gtk_toggle_button_get_inconsistent
-#define gxg_gtk_toolbar_new_w gxg_gtk_toolbar_new
-#define gxg_gtk_toolbar_set_style_w gxg_gtk_toolbar_set_style
-#define gxg_gtk_toolbar_unset_style_w gxg_gtk_toolbar_unset_style
-#define gxg_gtk_toolbar_get_style_w gxg_gtk_toolbar_get_style
-#define gxg_gtk_toolbar_get_icon_size_w gxg_gtk_toolbar_get_icon_size
-#define gxg_gtk_tree_drag_source_row_draggable_w gxg_gtk_tree_drag_source_row_draggable
-#define gxg_gtk_tree_drag_source_drag_data_delete_w gxg_gtk_tree_drag_source_drag_data_delete
-#define gxg_gtk_tree_drag_source_drag_data_get_w gxg_gtk_tree_drag_source_drag_data_get
-#define gxg_gtk_tree_drag_dest_drag_data_received_w gxg_gtk_tree_drag_dest_drag_data_received
-#define gxg_gtk_tree_drag_dest_row_drop_possible_w gxg_gtk_tree_drag_dest_row_drop_possible
-#define gxg_gtk_tree_set_row_drag_data_w gxg_gtk_tree_set_row_drag_data
-#define gxg_gtk_tree_get_row_drag_data_w gxg_gtk_tree_get_row_drag_data
-#define gxg_gtk_tree_path_new_w gxg_gtk_tree_path_new
-#define gxg_gtk_tree_path_new_from_string_w gxg_gtk_tree_path_new_from_string
-#define gxg_gtk_tree_path_to_string_w gxg_gtk_tree_path_to_string
-#define gxg_gtk_tree_path_new_first_w gxg_gtk_tree_path_new_first
-#define gxg_gtk_tree_path_append_index_w gxg_gtk_tree_path_append_index
-#define gxg_gtk_tree_path_prepend_index_w gxg_gtk_tree_path_prepend_index
-#define gxg_gtk_tree_path_get_depth_w gxg_gtk_tree_path_get_depth
-#define gxg_gtk_tree_path_get_indices_w gxg_gtk_tree_path_get_indices
-#define gxg_gtk_tree_path_free_w gxg_gtk_tree_path_free
-#define gxg_gtk_tree_path_copy_w gxg_gtk_tree_path_copy
-#define gxg_gtk_tree_path_compare_w gxg_gtk_tree_path_compare
-#define gxg_gtk_tree_path_next_w gxg_gtk_tree_path_next
-#define gxg_gtk_tree_path_prev_w gxg_gtk_tree_path_prev
-#define gxg_gtk_tree_path_up_w gxg_gtk_tree_path_up
-#define gxg_gtk_tree_path_down_w gxg_gtk_tree_path_down
-#define gxg_gtk_tree_path_is_ancestor_w gxg_gtk_tree_path_is_ancestor
-#define gxg_gtk_tree_path_is_descendant_w gxg_gtk_tree_path_is_descendant
-#define gxg_gtk_tree_row_reference_new_w gxg_gtk_tree_row_reference_new
-#define gxg_gtk_tree_row_reference_new_proxy_w gxg_gtk_tree_row_reference_new_proxy
-#define gxg_gtk_tree_row_reference_get_path_w gxg_gtk_tree_row_reference_get_path
-#define gxg_gtk_tree_row_reference_valid_w gxg_gtk_tree_row_reference_valid
-#define gxg_gtk_tree_row_reference_free_w gxg_gtk_tree_row_reference_free
-#define gxg_gtk_tree_row_reference_inserted_w gxg_gtk_tree_row_reference_inserted
-#define gxg_gtk_tree_row_reference_deleted_w gxg_gtk_tree_row_reference_deleted
-#define gxg_gtk_tree_row_reference_reordered_w gxg_gtk_tree_row_reference_reordered
-#define gxg_gtk_tree_iter_copy_w gxg_gtk_tree_iter_copy
-#define gxg_gtk_tree_iter_free_w gxg_gtk_tree_iter_free
-#define gxg_gtk_tree_model_get_flags_w gxg_gtk_tree_model_get_flags
-#define gxg_gtk_tree_model_get_n_columns_w gxg_gtk_tree_model_get_n_columns
-#define gxg_gtk_tree_model_get_column_type_w gxg_gtk_tree_model_get_column_type
-#define gxg_gtk_tree_model_get_iter_w gxg_gtk_tree_model_get_iter
-#define gxg_gtk_tree_model_get_iter_from_string_w gxg_gtk_tree_model_get_iter_from_string
-#define gxg_gtk_tree_model_get_iter_first_w gxg_gtk_tree_model_get_iter_first
-#define gxg_gtk_tree_model_get_path_w gxg_gtk_tree_model_get_path
-#define gxg_gtk_tree_model_iter_next_w gxg_gtk_tree_model_iter_next
-#define gxg_gtk_tree_model_iter_children_w gxg_gtk_tree_model_iter_children
-#define gxg_gtk_tree_model_iter_has_child_w gxg_gtk_tree_model_iter_has_child
-#define gxg_gtk_tree_model_iter_n_children_w gxg_gtk_tree_model_iter_n_children
-#define gxg_gtk_tree_model_iter_nth_child_w gxg_gtk_tree_model_iter_nth_child
-#define gxg_gtk_tree_model_iter_parent_w gxg_gtk_tree_model_iter_parent
-#define gxg_gtk_tree_model_ref_node_w gxg_gtk_tree_model_ref_node
-#define gxg_gtk_tree_model_unref_node_w gxg_gtk_tree_model_unref_node
-#define gxg_gtk_tree_model_foreach_w gxg_gtk_tree_model_foreach
-#define gxg_gtk_tree_model_row_changed_w gxg_gtk_tree_model_row_changed
-#define gxg_gtk_tree_model_row_inserted_w gxg_gtk_tree_model_row_inserted
-#define gxg_gtk_tree_model_row_has_child_toggled_w gxg_gtk_tree_model_row_has_child_toggled
-#define gxg_gtk_tree_model_row_deleted_w gxg_gtk_tree_model_row_deleted
-#define gxg_gtk_tree_model_rows_reordered_w gxg_gtk_tree_model_rows_reordered
-#define gxg_gtk_tree_model_sort_new_with_model_w gxg_gtk_tree_model_sort_new_with_model
-#define gxg_gtk_tree_model_sort_get_model_w gxg_gtk_tree_model_sort_get_model
-#define gxg_gtk_tree_model_sort_convert_child_path_to_path_w gxg_gtk_tree_model_sort_convert_child_path_to_path
-#define gxg_gtk_tree_model_sort_convert_child_iter_to_iter_w gxg_gtk_tree_model_sort_convert_child_iter_to_iter
-#define gxg_gtk_tree_model_sort_convert_path_to_child_path_w gxg_gtk_tree_model_sort_convert_path_to_child_path
-#define gxg_gtk_tree_model_sort_convert_iter_to_child_iter_w gxg_gtk_tree_model_sort_convert_iter_to_child_iter
-#define gxg_gtk_tree_model_sort_reset_default_sort_func_w gxg_gtk_tree_model_sort_reset_default_sort_func
-#define gxg_gtk_tree_model_sort_clear_cache_w gxg_gtk_tree_model_sort_clear_cache
-#define gxg_gtk_tree_selection_set_mode_w gxg_gtk_tree_selection_set_mode
-#define gxg_gtk_tree_selection_get_mode_w gxg_gtk_tree_selection_get_mode
-#define gxg_gtk_tree_selection_set_select_function_w gxg_gtk_tree_selection_set_select_function
-#define gxg_gtk_tree_selection_get_user_data_w gxg_gtk_tree_selection_get_user_data
-#define gxg_gtk_tree_selection_get_tree_view_w gxg_gtk_tree_selection_get_tree_view
-#define gxg_gtk_tree_selection_get_selected_w gxg_gtk_tree_selection_get_selected
-#define gxg_gtk_tree_selection_selected_foreach_w gxg_gtk_tree_selection_selected_foreach
-#define gxg_gtk_tree_selection_select_path_w gxg_gtk_tree_selection_select_path
-#define gxg_gtk_tree_selection_unselect_path_w gxg_gtk_tree_selection_unselect_path
-#define gxg_gtk_tree_selection_select_iter_w gxg_gtk_tree_selection_select_iter
-#define gxg_gtk_tree_selection_unselect_iter_w gxg_gtk_tree_selection_unselect_iter
-#define gxg_gtk_tree_selection_path_is_selected_w gxg_gtk_tree_selection_path_is_selected
-#define gxg_gtk_tree_selection_iter_is_selected_w gxg_gtk_tree_selection_iter_is_selected
-#define gxg_gtk_tree_selection_select_all_w gxg_gtk_tree_selection_select_all
-#define gxg_gtk_tree_selection_unselect_all_w gxg_gtk_tree_selection_unselect_all
-#define gxg_gtk_tree_selection_select_range_w gxg_gtk_tree_selection_select_range
-#define gxg_gtk_tree_sortable_sort_column_changed_w gxg_gtk_tree_sortable_sort_column_changed
-#define gxg_gtk_tree_sortable_get_sort_column_id_w gxg_gtk_tree_sortable_get_sort_column_id
-#define gxg_gtk_tree_sortable_set_sort_column_id_w gxg_gtk_tree_sortable_set_sort_column_id
-#define gxg_gtk_tree_sortable_set_sort_func_w gxg_gtk_tree_sortable_set_sort_func
-#define gxg_gtk_tree_sortable_set_default_sort_func_w gxg_gtk_tree_sortable_set_default_sort_func
-#define gxg_gtk_tree_sortable_has_default_sort_func_w gxg_gtk_tree_sortable_has_default_sort_func
-#define gxg_gtk_tree_store_new_w gxg_gtk_tree_store_new
-#define gxg_gtk_tree_store_newv_w gxg_gtk_tree_store_newv
-#define gxg_gtk_tree_store_set_column_types_w gxg_gtk_tree_store_set_column_types
-#define gxg_gtk_tree_store_set_w gxg_gtk_tree_store_set
-#define gxg_gtk_tree_store_remove_w gxg_gtk_tree_store_remove
-#define gxg_gtk_tree_store_insert_w gxg_gtk_tree_store_insert
-#define gxg_gtk_tree_store_insert_before_w gxg_gtk_tree_store_insert_before
-#define gxg_gtk_tree_store_insert_after_w gxg_gtk_tree_store_insert_after
-#define gxg_gtk_tree_store_prepend_w gxg_gtk_tree_store_prepend
-#define gxg_gtk_tree_store_append_w gxg_gtk_tree_store_append
-#define gxg_gtk_tree_store_is_ancestor_w gxg_gtk_tree_store_is_ancestor
-#define gxg_gtk_tree_store_iter_depth_w gxg_gtk_tree_store_iter_depth
-#define gxg_gtk_tree_store_clear_w gxg_gtk_tree_store_clear
-#define gxg_gtk_tree_view_column_new_w gxg_gtk_tree_view_column_new
-#define gxg_gtk_tree_view_column_new_with_attributes_w gxg_gtk_tree_view_column_new_with_attributes
-#define gxg_gtk_tree_view_column_pack_start_w gxg_gtk_tree_view_column_pack_start
-#define gxg_gtk_tree_view_column_pack_end_w gxg_gtk_tree_view_column_pack_end
-#define gxg_gtk_tree_view_column_clear_w gxg_gtk_tree_view_column_clear
-#define gxg_gtk_tree_view_column_add_attribute_w gxg_gtk_tree_view_column_add_attribute
-#define gxg_gtk_tree_view_column_set_attributes_w gxg_gtk_tree_view_column_set_attributes
-#define gxg_gtk_tree_view_column_set_cell_data_func_w gxg_gtk_tree_view_column_set_cell_data_func
-#define gxg_gtk_tree_view_column_clear_attributes_w gxg_gtk_tree_view_column_clear_attributes
-#define gxg_gtk_tree_view_column_set_spacing_w gxg_gtk_tree_view_column_set_spacing
-#define gxg_gtk_tree_view_column_get_spacing_w gxg_gtk_tree_view_column_get_spacing
-#define gxg_gtk_tree_view_column_set_visible_w gxg_gtk_tree_view_column_set_visible
-#define gxg_gtk_tree_view_column_get_visible_w gxg_gtk_tree_view_column_get_visible
-#define gxg_gtk_tree_view_column_set_resizable_w gxg_gtk_tree_view_column_set_resizable
-#define gxg_gtk_tree_view_column_get_resizable_w gxg_gtk_tree_view_column_get_resizable
-#define gxg_gtk_tree_view_column_set_sizing_w gxg_gtk_tree_view_column_set_sizing
-#define gxg_gtk_tree_view_column_get_sizing_w gxg_gtk_tree_view_column_get_sizing
-#define gxg_gtk_tree_view_column_get_width_w gxg_gtk_tree_view_column_get_width
-#define gxg_gtk_tree_view_column_get_fixed_width_w gxg_gtk_tree_view_column_get_fixed_width
-#define gxg_gtk_tree_view_column_set_fixed_width_w gxg_gtk_tree_view_column_set_fixed_width
-#define gxg_gtk_tree_view_column_set_min_width_w gxg_gtk_tree_view_column_set_min_width
-#define gxg_gtk_tree_view_column_get_min_width_w gxg_gtk_tree_view_column_get_min_width
-#define gxg_gtk_tree_view_column_set_max_width_w gxg_gtk_tree_view_column_set_max_width
-#define gxg_gtk_tree_view_column_get_max_width_w gxg_gtk_tree_view_column_get_max_width
-#define gxg_gtk_tree_view_column_clicked_w gxg_gtk_tree_view_column_clicked
-#define gxg_gtk_tree_view_column_set_title_w gxg_gtk_tree_view_column_set_title
-#define gxg_gtk_tree_view_column_get_title_w gxg_gtk_tree_view_column_get_title
-#define gxg_gtk_tree_view_column_set_clickable_w gxg_gtk_tree_view_column_set_clickable
-#define gxg_gtk_tree_view_column_get_clickable_w gxg_gtk_tree_view_column_get_clickable
-#define gxg_gtk_tree_view_column_set_widget_w gxg_gtk_tree_view_column_set_widget
-#define gxg_gtk_tree_view_column_get_widget_w gxg_gtk_tree_view_column_get_widget
-#define gxg_gtk_tree_view_column_set_alignment_w gxg_gtk_tree_view_column_set_alignment
-#define gxg_gtk_tree_view_column_get_alignment_w gxg_gtk_tree_view_column_get_alignment
-#define gxg_gtk_tree_view_column_set_reorderable_w gxg_gtk_tree_view_column_set_reorderable
-#define gxg_gtk_tree_view_column_get_reorderable_w gxg_gtk_tree_view_column_get_reorderable
-#define gxg_gtk_tree_view_column_set_sort_column_id_w gxg_gtk_tree_view_column_set_sort_column_id
-#define gxg_gtk_tree_view_column_get_sort_column_id_w gxg_gtk_tree_view_column_get_sort_column_id
-#define gxg_gtk_tree_view_column_set_sort_indicator_w gxg_gtk_tree_view_column_set_sort_indicator
-#define gxg_gtk_tree_view_column_get_sort_indicator_w gxg_gtk_tree_view_column_get_sort_indicator
-#define gxg_gtk_tree_view_column_set_sort_order_w gxg_gtk_tree_view_column_set_sort_order
-#define gxg_gtk_tree_view_column_get_sort_order_w gxg_gtk_tree_view_column_get_sort_order
-#define gxg_gtk_tree_view_column_cell_set_cell_data_w gxg_gtk_tree_view_column_cell_set_cell_data
-#define gxg_gtk_tree_view_column_cell_get_size_w gxg_gtk_tree_view_column_cell_get_size
-#define gxg_gtk_tree_view_column_cell_is_visible_w gxg_gtk_tree_view_column_cell_is_visible
-#define gxg_gtk_tree_view_column_cell_get_position_w gxg_gtk_tree_view_column_cell_get_position
-#define gxg_gtk_tree_view_new_w gxg_gtk_tree_view_new
-#define gxg_gtk_tree_view_new_with_model_w gxg_gtk_tree_view_new_with_model
-#define gxg_gtk_tree_view_get_model_w gxg_gtk_tree_view_get_model
-#define gxg_gtk_tree_view_set_model_w gxg_gtk_tree_view_set_model
-#define gxg_gtk_tree_view_get_selection_w gxg_gtk_tree_view_get_selection
-#define gxg_gtk_tree_view_get_headers_visible_w gxg_gtk_tree_view_get_headers_visible
-#define gxg_gtk_tree_view_set_headers_visible_w gxg_gtk_tree_view_set_headers_visible
-#define gxg_gtk_tree_view_columns_autosize_w gxg_gtk_tree_view_columns_autosize
-#define gxg_gtk_tree_view_set_headers_clickable_w gxg_gtk_tree_view_set_headers_clickable
-#define gxg_gtk_tree_view_set_rules_hint_w gxg_gtk_tree_view_set_rules_hint
-#define gxg_gtk_tree_view_get_rules_hint_w gxg_gtk_tree_view_get_rules_hint
-#define gxg_gtk_tree_view_append_column_w gxg_gtk_tree_view_append_column
-#define gxg_gtk_tree_view_remove_column_w gxg_gtk_tree_view_remove_column
-#define gxg_gtk_tree_view_insert_column_w gxg_gtk_tree_view_insert_column
-#define gxg_gtk_tree_view_insert_column_with_attributes_w gxg_gtk_tree_view_insert_column_with_attributes
-#define gxg_gtk_tree_view_insert_column_with_data_func_w gxg_gtk_tree_view_insert_column_with_data_func
-#define gxg_gtk_tree_view_get_column_w gxg_gtk_tree_view_get_column
-#define gxg_gtk_tree_view_get_columns_w gxg_gtk_tree_view_get_columns
-#define gxg_gtk_tree_view_move_column_after_w gxg_gtk_tree_view_move_column_after
-#define gxg_gtk_tree_view_set_expander_column_w gxg_gtk_tree_view_set_expander_column
-#define gxg_gtk_tree_view_get_expander_column_w gxg_gtk_tree_view_get_expander_column
-#define gxg_gtk_tree_view_set_column_drag_function_w gxg_gtk_tree_view_set_column_drag_function
-#define gxg_gtk_tree_view_scroll_to_point_w gxg_gtk_tree_view_scroll_to_point
-#define gxg_gtk_tree_view_scroll_to_cell_w gxg_gtk_tree_view_scroll_to_cell
-#define gxg_gtk_tree_view_row_activated_w gxg_gtk_tree_view_row_activated
-#define gxg_gtk_tree_view_expand_all_w gxg_gtk_tree_view_expand_all
-#define gxg_gtk_tree_view_collapse_all_w gxg_gtk_tree_view_collapse_all
-#define gxg_gtk_tree_view_expand_row_w gxg_gtk_tree_view_expand_row
-#define gxg_gtk_tree_view_collapse_row_w gxg_gtk_tree_view_collapse_row
-#define gxg_gtk_tree_view_map_expanded_rows_w gxg_gtk_tree_view_map_expanded_rows
-#define gxg_gtk_tree_view_row_expanded_w gxg_gtk_tree_view_row_expanded
-#define gxg_gtk_tree_view_set_reorderable_w gxg_gtk_tree_view_set_reorderable
-#define gxg_gtk_tree_view_get_reorderable_w gxg_gtk_tree_view_get_reorderable
-#define gxg_gtk_tree_view_set_cursor_w gxg_gtk_tree_view_set_cursor
-#define gxg_gtk_tree_view_get_cursor_w gxg_gtk_tree_view_get_cursor
-#define gxg_gtk_tree_view_get_bin_window_w gxg_gtk_tree_view_get_bin_window
-#define gxg_gtk_tree_view_get_path_at_pos_w gxg_gtk_tree_view_get_path_at_pos
-#define gxg_gtk_tree_view_get_cell_area_w gxg_gtk_tree_view_get_cell_area
-#define gxg_gtk_tree_view_get_background_area_w gxg_gtk_tree_view_get_background_area
-#define gxg_gtk_tree_view_get_visible_rect_w gxg_gtk_tree_view_get_visible_rect
-#define gxg_gtk_tree_view_enable_model_drag_source_w gxg_gtk_tree_view_enable_model_drag_source
-#define gxg_gtk_tree_view_enable_model_drag_dest_w gxg_gtk_tree_view_enable_model_drag_dest
-#define gxg_gtk_tree_view_unset_rows_drag_source_w gxg_gtk_tree_view_unset_rows_drag_source
-#define gxg_gtk_tree_view_unset_rows_drag_dest_w gxg_gtk_tree_view_unset_rows_drag_dest
-#define gxg_gtk_tree_view_set_drag_dest_row_w gxg_gtk_tree_view_set_drag_dest_row
-#define gxg_gtk_tree_view_get_drag_dest_row_w gxg_gtk_tree_view_get_drag_dest_row
-#define gxg_gtk_tree_view_get_dest_row_at_pos_w gxg_gtk_tree_view_get_dest_row_at_pos
-#define gxg_gtk_tree_view_set_enable_search_w gxg_gtk_tree_view_set_enable_search
-#define gxg_gtk_tree_view_get_enable_search_w gxg_gtk_tree_view_get_enable_search
-#define gxg_gtk_tree_view_get_search_column_w gxg_gtk_tree_view_get_search_column
-#define gxg_gtk_tree_view_set_search_column_w gxg_gtk_tree_view_set_search_column
-#define gxg_gtk_tree_view_get_search_equal_func_w gxg_gtk_tree_view_get_search_equal_func
-#define gxg_gtk_tree_view_set_search_equal_func_w gxg_gtk_tree_view_set_search_equal_func
-#define gxg_gtk_vbutton_box_new_w gxg_gtk_vbutton_box_new
-#define gxg_gtk_viewport_new_w gxg_gtk_viewport_new
-#define gxg_gtk_viewport_set_shadow_type_w gxg_gtk_viewport_set_shadow_type
-#define gxg_gtk_viewport_get_shadow_type_w gxg_gtk_viewport_get_shadow_type
-#define gxg_gtk_vpaned_new_w gxg_gtk_vpaned_new
-#define gxg_gtk_vscale_new_w gxg_gtk_vscale_new
-#define gxg_gtk_vscale_new_with_range_w gxg_gtk_vscale_new_with_range
-#define gxg_gtk_vscrollbar_new_w gxg_gtk_vscrollbar_new
-#define gxg_gtk_vseparator_new_w gxg_gtk_vseparator_new
-#define gxg_gtk_widget_destroy_w gxg_gtk_widget_destroy
-#define gxg_gtk_widget_destroyed_w gxg_gtk_widget_destroyed
-#define gxg_gtk_widget_unparent_w gxg_gtk_widget_unparent
-#define gxg_gtk_widget_show_w gxg_gtk_widget_show
-#define gxg_gtk_widget_show_now_w gxg_gtk_widget_show_now
-#define gxg_gtk_widget_hide_w gxg_gtk_widget_hide
-#define gxg_gtk_widget_show_all_w gxg_gtk_widget_show_all
-#define gxg_gtk_widget_map_w gxg_gtk_widget_map
-#define gxg_gtk_widget_unmap_w gxg_gtk_widget_unmap
-#define gxg_gtk_widget_realize_w gxg_gtk_widget_realize
-#define gxg_gtk_widget_unrealize_w gxg_gtk_widget_unrealize
-#define gxg_gtk_widget_queue_draw_w gxg_gtk_widget_queue_draw
-#define gxg_gtk_widget_queue_draw_area_w gxg_gtk_widget_queue_draw_area
-#define gxg_gtk_widget_queue_resize_w gxg_gtk_widget_queue_resize
-#define gxg_gtk_widget_size_allocate_w gxg_gtk_widget_size_allocate
-#define gxg_gtk_widget_add_accelerator_w gxg_gtk_widget_add_accelerator
-#define gxg_gtk_widget_remove_accelerator_w gxg_gtk_widget_remove_accelerator
-#define gxg_gtk_widget_list_accel_closures_w gxg_gtk_widget_list_accel_closures
-#define gxg_gtk_widget_mnemonic_activate_w gxg_gtk_widget_mnemonic_activate
-#define gxg_gtk_widget_event_w gxg_gtk_widget_event
-#define gxg_gtk_widget_send_expose_w gxg_gtk_widget_send_expose
-#define gxg_gtk_widget_activate_w gxg_gtk_widget_activate
-#define gxg_gtk_widget_reparent_w gxg_gtk_widget_reparent
-#define gxg_gtk_widget_intersect_w gxg_gtk_widget_intersect
-#define gxg_gtk_widget_freeze_child_notify_w gxg_gtk_widget_freeze_child_notify
-#define gxg_gtk_widget_child_notify_w gxg_gtk_widget_child_notify
-#define gxg_gtk_widget_thaw_child_notify_w gxg_gtk_widget_thaw_child_notify
-#define gxg_gtk_widget_is_focus_w gxg_gtk_widget_is_focus
-#define gxg_gtk_widget_grab_focus_w gxg_gtk_widget_grab_focus
-#define gxg_gtk_widget_grab_default_w gxg_gtk_widget_grab_default
-#define gxg_gtk_widget_set_name_w gxg_gtk_widget_set_name
-#define gxg_gtk_widget_get_name_w gxg_gtk_widget_get_name
-#define gxg_gtk_widget_set_state_w gxg_gtk_widget_set_state
-#define gxg_gtk_widget_set_sensitive_w gxg_gtk_widget_set_sensitive
-#define gxg_gtk_widget_set_app_paintable_w gxg_gtk_widget_set_app_paintable
-#define gxg_gtk_widget_set_double_buffered_w gxg_gtk_widget_set_double_buffered
-#define gxg_gtk_widget_set_redraw_on_allocate_w gxg_gtk_widget_set_redraw_on_allocate
-#define gxg_gtk_widget_set_parent_w gxg_gtk_widget_set_parent
-#define gxg_gtk_widget_set_parent_window_w gxg_gtk_widget_set_parent_window
-#define gxg_gtk_widget_set_child_visible_w gxg_gtk_widget_set_child_visible
-#define gxg_gtk_widget_set_accel_path_w gxg_gtk_widget_set_accel_path
-#define gxg_gtk_widget_get_child_visible_w gxg_gtk_widget_get_child_visible
-#define gxg_gtk_widget_get_parent_w gxg_gtk_widget_get_parent
-#define gxg_gtk_widget_get_parent_window_w gxg_gtk_widget_get_parent_window
-#define gxg_gtk_widget_child_focus_w gxg_gtk_widget_child_focus
-#define gxg_gtk_widget_set_size_request_w gxg_gtk_widget_set_size_request
-#define gxg_gtk_widget_get_size_request_w gxg_gtk_widget_get_size_request
-#define gxg_gtk_widget_set_events_w gxg_gtk_widget_set_events
-#define gxg_gtk_widget_add_events_w gxg_gtk_widget_add_events
-#define gxg_gtk_widget_get_toplevel_w gxg_gtk_widget_get_toplevel
-#define gxg_gtk_widget_get_ancestor_w gxg_gtk_widget_get_ancestor
-#define gxg_gtk_widget_get_visual_w gxg_gtk_widget_get_visual
-#define gxg_gtk_widget_get_accessible_w gxg_gtk_widget_get_accessible
-#define gxg_gtk_widget_get_events_w gxg_gtk_widget_get_events
-#define gxg_gtk_widget_get_pointer_w gxg_gtk_widget_get_pointer
-#define gxg_gtk_widget_is_ancestor_w gxg_gtk_widget_is_ancestor
-#define gxg_gtk_widget_translate_coordinates_w gxg_gtk_widget_translate_coordinates
-#define gxg_gtk_widget_hide_on_delete_w gxg_gtk_widget_hide_on_delete
-#define gxg_gtk_widget_create_pango_context_w gxg_gtk_widget_create_pango_context
-#define gxg_gtk_widget_get_pango_context_w gxg_gtk_widget_get_pango_context
-#define gxg_gtk_widget_create_pango_layout_w gxg_gtk_widget_create_pango_layout
-#define gxg_gtk_widget_set_composite_name_w gxg_gtk_widget_set_composite_name
-#define gxg_gtk_widget_get_composite_name_w gxg_gtk_widget_get_composite_name
-#define gxg_gtk_widget_push_composite_child_w gxg_gtk_widget_push_composite_child
-#define gxg_gtk_widget_pop_composite_child_w gxg_gtk_widget_pop_composite_child
-#define gxg_gtk_widget_set_direction_w gxg_gtk_widget_set_direction
-#define gxg_gtk_widget_get_direction_w gxg_gtk_widget_get_direction
-#define gxg_gtk_widget_set_default_direction_w gxg_gtk_widget_set_default_direction
-#define gxg_gtk_widget_get_default_direction_w gxg_gtk_widget_get_default_direction
-#define gxg_gtk_widget_can_activate_accel_w gxg_gtk_widget_can_activate_accel
-#define gxg_gtk_window_is_active_w gxg_gtk_window_is_active
-#define gxg_gtk_window_has_toplevel_focus_w gxg_gtk_window_has_toplevel_focus
-#define gxg_gtk_window_new_w gxg_gtk_window_new
-#define gxg_gtk_window_set_title_w gxg_gtk_window_set_title
-#define gxg_gtk_window_set_auto_startup_notification_w gxg_gtk_window_set_auto_startup_notification
-#define gxg_gtk_window_get_title_w gxg_gtk_window_get_title
-#define gxg_gtk_window_set_wmclass_w gxg_gtk_window_set_wmclass
-#define gxg_gtk_window_set_role_w gxg_gtk_window_set_role
-#define gxg_gtk_window_get_role_w gxg_gtk_window_get_role
-#define gxg_gtk_window_add_accel_group_w gxg_gtk_window_add_accel_group
-#define gxg_gtk_window_remove_accel_group_w gxg_gtk_window_remove_accel_group
-#define gxg_gtk_window_set_position_w gxg_gtk_window_set_position
-#define gxg_gtk_window_activate_focus_w gxg_gtk_window_activate_focus
-#define gxg_gtk_window_set_focus_w gxg_gtk_window_set_focus
-#define gxg_gtk_window_get_focus_w gxg_gtk_window_get_focus
-#define gxg_gtk_window_set_default_w gxg_gtk_window_set_default
-#define gxg_gtk_window_activate_default_w gxg_gtk_window_activate_default
-#define gxg_gtk_window_set_transient_for_w gxg_gtk_window_set_transient_for
-#define gxg_gtk_window_get_transient_for_w gxg_gtk_window_get_transient_for
-#define gxg_gtk_window_set_type_hint_w gxg_gtk_window_set_type_hint
-#define gxg_gtk_window_get_type_hint_w gxg_gtk_window_get_type_hint
-#define gxg_gtk_window_set_destroy_with_parent_w gxg_gtk_window_set_destroy_with_parent
-#define gxg_gtk_window_get_destroy_with_parent_w gxg_gtk_window_get_destroy_with_parent
-#define gxg_gtk_window_set_resizable_w gxg_gtk_window_set_resizable
-#define gxg_gtk_window_get_resizable_w gxg_gtk_window_get_resizable
-#define gxg_gtk_window_set_gravity_w gxg_gtk_window_set_gravity
-#define gxg_gtk_window_get_gravity_w gxg_gtk_window_get_gravity
-#define gxg_gtk_window_set_geometry_hints_w gxg_gtk_window_set_geometry_hints
-#define gxg_gtk_window_set_decorated_w gxg_gtk_window_set_decorated
-#define gxg_gtk_window_get_decorated_w gxg_gtk_window_get_decorated
-#define gxg_gtk_window_set_icon_list_w gxg_gtk_window_set_icon_list
-#define gxg_gtk_window_get_icon_list_w gxg_gtk_window_get_icon_list
-#define gxg_gtk_window_set_icon_w gxg_gtk_window_set_icon
-#define gxg_gtk_window_get_icon_w gxg_gtk_window_get_icon
-#define gxg_gtk_window_set_default_icon_list_w gxg_gtk_window_set_default_icon_list
-#define gxg_gtk_window_get_default_icon_list_w gxg_gtk_window_get_default_icon_list
-#define gxg_gtk_window_set_modal_w gxg_gtk_window_set_modal
-#define gxg_gtk_window_get_modal_w gxg_gtk_window_get_modal
-#define gxg_gtk_window_list_toplevels_w gxg_gtk_window_list_toplevels
-#define gxg_gtk_window_add_mnemonic_w gxg_gtk_window_add_mnemonic
-#define gxg_gtk_window_remove_mnemonic_w gxg_gtk_window_remove_mnemonic
-#define gxg_gtk_window_mnemonic_activate_w gxg_gtk_window_mnemonic_activate
-#define gxg_gtk_window_set_mnemonic_modifier_w gxg_gtk_window_set_mnemonic_modifier
-#define gxg_gtk_window_get_mnemonic_modifier_w gxg_gtk_window_get_mnemonic_modifier
-#define gxg_gtk_window_present_w gxg_gtk_window_present
-#define gxg_gtk_window_iconify_w gxg_gtk_window_iconify
-#define gxg_gtk_window_deiconify_w gxg_gtk_window_deiconify
-#define gxg_gtk_window_stick_w gxg_gtk_window_stick
-#define gxg_gtk_window_unstick_w gxg_gtk_window_unstick
-#define gxg_gtk_window_maximize_w gxg_gtk_window_maximize
-#define gxg_gtk_window_unmaximize_w gxg_gtk_window_unmaximize
-#define gxg_gtk_window_begin_resize_drag_w gxg_gtk_window_begin_resize_drag
-#define gxg_gtk_window_begin_move_drag_w gxg_gtk_window_begin_move_drag
-#define gxg_gtk_window_set_default_size_w gxg_gtk_window_set_default_size
-#define gxg_gtk_window_get_default_size_w gxg_gtk_window_get_default_size
-#define gxg_gtk_window_resize_w gxg_gtk_window_resize
-#define gxg_gtk_window_get_size_w gxg_gtk_window_get_size
-#define gxg_gtk_window_move_w gxg_gtk_window_move
-#define gxg_gtk_window_get_position_w gxg_gtk_window_get_position
-#define gxg_gtk_window_parse_geometry_w gxg_gtk_window_parse_geometry
-#define gxg_gtk_window_reshow_with_initial_size_w gxg_gtk_window_reshow_with_initial_size
-#define gxg_pango_color_copy_w gxg_pango_color_copy
-#define gxg_pango_color_free_w gxg_pango_color_free
-#define gxg_pango_color_parse_w gxg_pango_color_parse
-#define gxg_pango_attr_type_register_w gxg_pango_attr_type_register
-#define gxg_pango_attribute_copy_w gxg_pango_attribute_copy
-#define gxg_pango_attribute_destroy_w gxg_pango_attribute_destroy
-#define gxg_pango_attribute_equal_w gxg_pango_attribute_equal
-#define gxg_pango_attr_language_new_w gxg_pango_attr_language_new
-#define gxg_pango_attr_family_new_w gxg_pango_attr_family_new
-#define gxg_pango_attr_foreground_new_w gxg_pango_attr_foreground_new
-#define gxg_pango_attr_background_new_w gxg_pango_attr_background_new
-#define gxg_pango_attr_size_new_w gxg_pango_attr_size_new
-#define gxg_pango_attr_style_new_w gxg_pango_attr_style_new
-#define gxg_pango_attr_weight_new_w gxg_pango_attr_weight_new
-#define gxg_pango_attr_variant_new_w gxg_pango_attr_variant_new
-#define gxg_pango_attr_stretch_new_w gxg_pango_attr_stretch_new
-#define gxg_pango_attr_font_desc_new_w gxg_pango_attr_font_desc_new
-#define gxg_pango_attr_underline_new_w gxg_pango_attr_underline_new
-#define gxg_pango_attr_strikethrough_new_w gxg_pango_attr_strikethrough_new
-#define gxg_pango_attr_rise_new_w gxg_pango_attr_rise_new
-#define gxg_pango_attr_shape_new_w gxg_pango_attr_shape_new
-#define gxg_pango_attr_scale_new_w gxg_pango_attr_scale_new
-#define gxg_pango_attr_list_new_w gxg_pango_attr_list_new
-#define gxg_pango_attr_list_unref_w gxg_pango_attr_list_unref
-#define gxg_pango_attr_list_copy_w gxg_pango_attr_list_copy
-#define gxg_pango_attr_list_insert_w gxg_pango_attr_list_insert
-#define gxg_pango_attr_list_insert_before_w gxg_pango_attr_list_insert_before
-#define gxg_pango_attr_list_change_w gxg_pango_attr_list_change
-#define gxg_pango_attr_list_splice_w gxg_pango_attr_list_splice
-#define gxg_pango_attr_list_get_iterator_w gxg_pango_attr_list_get_iterator
-#define gxg_pango_attr_iterator_range_w gxg_pango_attr_iterator_range
-#define gxg_pango_attr_iterator_next_w gxg_pango_attr_iterator_next
-#define gxg_pango_attr_iterator_copy_w gxg_pango_attr_iterator_copy
-#define gxg_pango_attr_iterator_destroy_w gxg_pango_attr_iterator_destroy
-#define gxg_pango_attr_iterator_get_w gxg_pango_attr_iterator_get
-#define gxg_pango_attr_iterator_get_font_w gxg_pango_attr_iterator_get_font
-#define gxg_pango_parse_markup_w gxg_pango_parse_markup
-#define gxg_pango_break_w gxg_pango_break
-#define gxg_pango_find_paragraph_boundary_w gxg_pango_find_paragraph_boundary
-#define gxg_pango_get_log_attrs_w gxg_pango_get_log_attrs
-#define gxg_pango_context_list_families_w gxg_pango_context_list_families
-#define gxg_pango_context_load_font_w gxg_pango_context_load_font
-#define gxg_pango_context_load_fontset_w gxg_pango_context_load_fontset
-#define gxg_pango_context_get_metrics_w gxg_pango_context_get_metrics
-#define gxg_pango_context_set_font_description_w gxg_pango_context_set_font_description
-#define gxg_pango_context_get_font_description_w gxg_pango_context_get_font_description
-#define gxg_pango_context_get_language_w gxg_pango_context_get_language
-#define gxg_pango_context_set_language_w gxg_pango_context_set_language
-#define gxg_pango_context_set_base_dir_w gxg_pango_context_set_base_dir
-#define gxg_pango_context_get_base_dir_w gxg_pango_context_get_base_dir
-#define gxg_pango_itemize_w gxg_pango_itemize
-#define gxg_pango_coverage_new_w gxg_pango_coverage_new
-#define gxg_pango_coverage_ref_w gxg_pango_coverage_ref
-#define gxg_pango_coverage_unref_w gxg_pango_coverage_unref
-#define gxg_pango_coverage_copy_w gxg_pango_coverage_copy
-#define gxg_pango_coverage_get_w gxg_pango_coverage_get
-#define gxg_pango_coverage_set_w gxg_pango_coverage_set
-#define gxg_pango_coverage_max_w gxg_pango_coverage_max
-#define gxg_pango_coverage_to_bytes_w gxg_pango_coverage_to_bytes
-#define gxg_pango_coverage_from_bytes_w gxg_pango_coverage_from_bytes
-#define gxg_pango_font_description_new_w gxg_pango_font_description_new
-#define gxg_pango_font_description_copy_w gxg_pango_font_description_copy
-#define gxg_pango_font_description_copy_static_w gxg_pango_font_description_copy_static
-#define gxg_pango_font_description_hash_w gxg_pango_font_description_hash
-#define gxg_pango_font_description_equal_w gxg_pango_font_description_equal
-#define gxg_pango_font_description_free_w gxg_pango_font_description_free
-#define gxg_pango_font_descriptions_free_w gxg_pango_font_descriptions_free
-#define gxg_pango_font_description_set_family_w gxg_pango_font_description_set_family
-#define gxg_pango_font_description_set_family_static_w gxg_pango_font_description_set_family_static
-#define gxg_pango_font_description_get_family_w gxg_pango_font_description_get_family
-#define gxg_pango_font_description_set_style_w gxg_pango_font_description_set_style
-#define gxg_pango_font_description_get_style_w gxg_pango_font_description_get_style
-#define gxg_pango_font_description_set_variant_w gxg_pango_font_description_set_variant
-#define gxg_pango_font_description_get_variant_w gxg_pango_font_description_get_variant
-#define gxg_pango_font_description_set_weight_w gxg_pango_font_description_set_weight
-#define gxg_pango_font_description_get_weight_w gxg_pango_font_description_get_weight
-#define gxg_pango_font_description_set_stretch_w gxg_pango_font_description_set_stretch
-#define gxg_pango_font_description_get_stretch_w gxg_pango_font_description_get_stretch
-#define gxg_pango_font_description_set_size_w gxg_pango_font_description_set_size
-#define gxg_pango_font_description_get_size_w gxg_pango_font_description_get_size
-#define gxg_pango_font_description_get_set_fields_w gxg_pango_font_description_get_set_fields
-#define gxg_pango_font_description_unset_fields_w gxg_pango_font_description_unset_fields
-#define gxg_pango_font_description_merge_w gxg_pango_font_description_merge
-#define gxg_pango_font_description_merge_static_w gxg_pango_font_description_merge_static
-#define gxg_pango_font_description_better_match_w gxg_pango_font_description_better_match
-#define gxg_pango_font_description_from_string_w gxg_pango_font_description_from_string
-#define gxg_pango_font_description_to_string_w gxg_pango_font_description_to_string
-#define gxg_pango_font_description_to_filename_w gxg_pango_font_description_to_filename
-#define gxg_pango_font_metrics_ref_w gxg_pango_font_metrics_ref
-#define gxg_pango_font_metrics_unref_w gxg_pango_font_metrics_unref
-#define gxg_pango_font_metrics_get_ascent_w gxg_pango_font_metrics_get_ascent
-#define gxg_pango_font_metrics_get_descent_w gxg_pango_font_metrics_get_descent
-#define gxg_pango_font_metrics_get_approximate_char_width_w gxg_pango_font_metrics_get_approximate_char_width
-#define gxg_pango_font_metrics_get_approximate_digit_width_w gxg_pango_font_metrics_get_approximate_digit_width
-#define gxg_pango_font_family_list_faces_w gxg_pango_font_family_list_faces
-#define gxg_pango_font_family_get_name_w gxg_pango_font_family_get_name
-#define gxg_pango_font_face_describe_w gxg_pango_font_face_describe
-#define gxg_pango_font_face_get_face_name_w gxg_pango_font_face_get_face_name
-#define gxg_pango_font_describe_w gxg_pango_font_describe
-#define gxg_pango_font_get_coverage_w gxg_pango_font_get_coverage
-#define gxg_pango_font_get_metrics_w gxg_pango_font_get_metrics
-#define gxg_pango_font_get_glyph_extents_w gxg_pango_font_get_glyph_extents
-#define gxg_pango_font_map_load_font_w gxg_pango_font_map_load_font
-#define gxg_pango_font_map_load_fontset_w gxg_pango_font_map_load_fontset
-#define gxg_pango_font_map_list_families_w gxg_pango_font_map_list_families
-#define gxg_pango_glyph_string_new_w gxg_pango_glyph_string_new
-#define gxg_pango_glyph_string_set_size_w gxg_pango_glyph_string_set_size
-#define gxg_pango_glyph_string_copy_w gxg_pango_glyph_string_copy
-#define gxg_pango_glyph_string_free_w gxg_pango_glyph_string_free
-#define gxg_pango_glyph_string_extents_w gxg_pango_glyph_string_extents
-#define gxg_pango_glyph_string_extents_range_w gxg_pango_glyph_string_extents_range
-#define gxg_pango_glyph_string_get_logical_widths_w gxg_pango_glyph_string_get_logical_widths
-#define gxg_pango_glyph_string_index_to_x_w gxg_pango_glyph_string_index_to_x
-#define gxg_pango_glyph_string_x_to_index_w gxg_pango_glyph_string_x_to_index
-#define gxg_pango_shape_w gxg_pango_shape
-#define gxg_pango_reorder_items_w gxg_pango_reorder_items
-#define gxg_pango_item_new_w gxg_pango_item_new
-#define gxg_pango_item_copy_w gxg_pango_item_copy
-#define gxg_pango_item_free_w gxg_pango_item_free
-#define gxg_pango_item_split_w gxg_pango_item_split
-#define gxg_pango_layout_new_w gxg_pango_layout_new
-#define gxg_pango_layout_copy_w gxg_pango_layout_copy
-#define gxg_pango_layout_get_context_w gxg_pango_layout_get_context
-#define gxg_pango_layout_set_attributes_w gxg_pango_layout_set_attributes
-#define gxg_pango_layout_get_attributes_w gxg_pango_layout_get_attributes
-#define gxg_pango_layout_set_text_w gxg_pango_layout_set_text
-#define gxg_pango_layout_get_text_w gxg_pango_layout_get_text
-#define gxg_pango_layout_set_markup_w gxg_pango_layout_set_markup
-#define gxg_pango_layout_set_markup_with_accel_w gxg_pango_layout_set_markup_with_accel
-#define gxg_pango_layout_set_font_description_w gxg_pango_layout_set_font_description
-#define gxg_pango_layout_set_width_w gxg_pango_layout_set_width
-#define gxg_pango_layout_get_width_w gxg_pango_layout_get_width
-#define gxg_pango_layout_set_wrap_w gxg_pango_layout_set_wrap
-#define gxg_pango_layout_get_wrap_w gxg_pango_layout_get_wrap
-#define gxg_pango_layout_set_indent_w gxg_pango_layout_set_indent
-#define gxg_pango_layout_get_indent_w gxg_pango_layout_get_indent
-#define gxg_pango_layout_set_spacing_w gxg_pango_layout_set_spacing
-#define gxg_pango_layout_get_spacing_w gxg_pango_layout_get_spacing
-#define gxg_pango_layout_set_justify_w gxg_pango_layout_set_justify
-#define gxg_pango_layout_get_justify_w gxg_pango_layout_get_justify
-#define gxg_pango_layout_set_alignment_w gxg_pango_layout_set_alignment
-#define gxg_pango_layout_get_alignment_w gxg_pango_layout_get_alignment
-#define gxg_pango_layout_set_tabs_w gxg_pango_layout_set_tabs
-#define gxg_pango_layout_get_tabs_w gxg_pango_layout_get_tabs
-#define gxg_pango_layout_set_single_paragraph_mode_w gxg_pango_layout_set_single_paragraph_mode
-#define gxg_pango_layout_get_single_paragraph_mode_w gxg_pango_layout_get_single_paragraph_mode
-#define gxg_pango_layout_context_changed_w gxg_pango_layout_context_changed
-#define gxg_pango_layout_get_log_attrs_w gxg_pango_layout_get_log_attrs
-#define gxg_pango_layout_index_to_pos_w gxg_pango_layout_index_to_pos
-#define gxg_pango_layout_get_cursor_pos_w gxg_pango_layout_get_cursor_pos
-#define gxg_pango_layout_move_cursor_visually_w gxg_pango_layout_move_cursor_visually
-#define gxg_pango_layout_xy_to_index_w gxg_pango_layout_xy_to_index
-#define gxg_pango_layout_get_extents_w gxg_pango_layout_get_extents
-#define gxg_pango_layout_get_pixel_extents_w gxg_pango_layout_get_pixel_extents
-#define gxg_pango_layout_get_size_w gxg_pango_layout_get_size
-#define gxg_pango_layout_get_pixel_size_w gxg_pango_layout_get_pixel_size
-#define gxg_pango_layout_get_line_count_w gxg_pango_layout_get_line_count
-#define gxg_pango_layout_get_line_w gxg_pango_layout_get_line
-#define gxg_pango_layout_get_lines_w gxg_pango_layout_get_lines
-#define gxg_pango_layout_line_unref_w gxg_pango_layout_line_unref
-#define gxg_pango_layout_line_x_to_index_w gxg_pango_layout_line_x_to_index
-#define gxg_pango_layout_line_index_to_x_w gxg_pango_layout_line_index_to_x
-#define gxg_pango_layout_line_get_x_ranges_w gxg_pango_layout_line_get_x_ranges
-#define gxg_pango_layout_line_get_extents_w gxg_pango_layout_line_get_extents
-#define gxg_pango_layout_line_get_pixel_extents_w gxg_pango_layout_line_get_pixel_extents
-#define gxg_pango_layout_get_iter_w gxg_pango_layout_get_iter
-#define gxg_pango_layout_iter_free_w gxg_pango_layout_iter_free
-#define gxg_pango_layout_iter_get_index_w gxg_pango_layout_iter_get_index
-#define gxg_pango_layout_iter_get_run_w gxg_pango_layout_iter_get_run
-#define gxg_pango_layout_iter_get_line_w gxg_pango_layout_iter_get_line
-#define gxg_pango_layout_iter_at_last_line_w gxg_pango_layout_iter_at_last_line
-#define gxg_pango_layout_iter_next_char_w gxg_pango_layout_iter_next_char
-#define gxg_pango_layout_iter_next_cluster_w gxg_pango_layout_iter_next_cluster
-#define gxg_pango_layout_iter_next_run_w gxg_pango_layout_iter_next_run
-#define gxg_pango_layout_iter_next_line_w gxg_pango_layout_iter_next_line
-#define gxg_pango_layout_iter_get_char_extents_w gxg_pango_layout_iter_get_char_extents
-#define gxg_pango_layout_iter_get_cluster_extents_w gxg_pango_layout_iter_get_cluster_extents
-#define gxg_pango_layout_iter_get_run_extents_w gxg_pango_layout_iter_get_run_extents
-#define gxg_pango_layout_iter_get_line_extents_w gxg_pango_layout_iter_get_line_extents
-#define gxg_pango_layout_iter_get_line_yrange_w gxg_pango_layout_iter_get_line_yrange
-#define gxg_pango_layout_iter_get_layout_extents_w gxg_pango_layout_iter_get_layout_extents
-#define gxg_pango_layout_iter_get_baseline_w gxg_pango_layout_iter_get_baseline
-#define gxg_pango_language_from_string_w gxg_pango_language_from_string
-#define gxg_pango_language_matches_w gxg_pango_language_matches
-#define gxg_G_OBJECT_TYPE_w gxg_G_OBJECT_TYPE
-#define gxg_g_utf8_validate_w gxg_g_utf8_validate
-#define gxg_gtk_tree_model_get_string_from_iter_w gxg_gtk_tree_model_get_string_from_iter
-#define gxg_gtk_tree_model_sort_iter_is_valid_w gxg_gtk_tree_model_sort_iter_is_valid
-#define gxg_gtk_tree_view_expand_to_path_w gxg_gtk_tree_view_expand_to_path
-#define gxg_gtk_tree_selection_get_selected_rows_w gxg_gtk_tree_selection_get_selected_rows
-#define gxg_gtk_tree_selection_count_selected_rows_w gxg_gtk_tree_selection_count_selected_rows
-#define gxg_gtk_menu_shell_select_first_w gxg_gtk_menu_shell_select_first
-#define gxg_gtk_notebook_get_n_pages_w gxg_gtk_notebook_get_n_pages
-#define gxg_gtk_list_store_reorder_w gxg_gtk_list_store_reorder
-#define gxg_gtk_list_store_swap_w gxg_gtk_list_store_swap
-#define gxg_gtk_list_store_move_after_w gxg_gtk_list_store_move_after
-#define gxg_gtk_list_store_move_before_w gxg_gtk_list_store_move_before
-#define gxg_gtk_tree_store_reorder_w gxg_gtk_tree_store_reorder
-#define gxg_gtk_tree_store_swap_w gxg_gtk_tree_store_swap
-#define gxg_gdk_display_open_w gxg_gdk_display_open
-#define gxg_gdk_display_get_name_w gxg_gdk_display_get_name
-#define gxg_gdk_display_get_n_screens_w gxg_gdk_display_get_n_screens
-#define gxg_gdk_display_get_screen_w gxg_gdk_display_get_screen
-#define gxg_gdk_display_get_default_screen_w gxg_gdk_display_get_default_screen
-#define gxg_gdk_display_beep_w gxg_gdk_display_beep
-#define gxg_gdk_display_sync_w gxg_gdk_display_sync
-#define gxg_gdk_display_close_w gxg_gdk_display_close
-#define gxg_gdk_display_get_event_w gxg_gdk_display_get_event
-#define gxg_gdk_display_peek_event_w gxg_gdk_display_peek_event
-#define gxg_gdk_display_put_event_w gxg_gdk_display_put_event
-#define gxg_gdk_display_set_double_click_time_w gxg_gdk_display_set_double_click_time
-#define gxg_gdk_display_get_default_w gxg_gdk_display_get_default
-#define gxg_gdk_screen_get_system_visual_w gxg_gdk_screen_get_system_visual
-#define gxg_gdk_screen_get_root_window_w gxg_gdk_screen_get_root_window
-#define gxg_gdk_screen_get_display_w gxg_gdk_screen_get_display
-#define gxg_gdk_screen_get_number_w gxg_gdk_screen_get_number
-#define gxg_gdk_screen_get_width_w gxg_gdk_screen_get_width
-#define gxg_gdk_screen_get_height_w gxg_gdk_screen_get_height
-#define gxg_gdk_screen_get_width_mm_w gxg_gdk_screen_get_width_mm
-#define gxg_gdk_screen_get_height_mm_w gxg_gdk_screen_get_height_mm
-#define gxg_gdk_screen_list_visuals_w gxg_gdk_screen_list_visuals
-#define gxg_gdk_screen_get_toplevel_windows_w gxg_gdk_screen_get_toplevel_windows
-#define gxg_gdk_screen_make_display_name_w gxg_gdk_screen_make_display_name
-#define gxg_gdk_screen_get_n_monitors_w gxg_gdk_screen_get_n_monitors
-#define gxg_gdk_screen_get_monitor_geometry_w gxg_gdk_screen_get_monitor_geometry
-#define gxg_gdk_screen_get_monitor_at_point_w gxg_gdk_screen_get_monitor_at_point
-#define gxg_gdk_screen_get_monitor_at_window_w gxg_gdk_screen_get_monitor_at_window
-#define gxg_gdk_screen_get_default_w gxg_gdk_screen_get_default
-#define gxg_gtk_clipboard_get_for_display_w gxg_gtk_clipboard_get_for_display
-#define gxg_gtk_clipboard_get_display_w gxg_gtk_clipboard_get_display
-#define gxg_gtk_widget_get_screen_w gxg_gtk_widget_get_screen
-#define gxg_gtk_widget_has_screen_w gxg_gtk_widget_has_screen
-#define gxg_gtk_widget_get_display_w gxg_gtk_widget_get_display
-#define gxg_gtk_widget_get_root_window_w gxg_gtk_widget_get_root_window
-#define gxg_gtk_widget_get_clipboard_w gxg_gtk_widget_get_clipboard
-#define gxg_g_list_free_w gxg_g_list_free
-#define gxg_g_list_reverse_w gxg_g_list_reverse
-#define gxg_g_list_copy_w gxg_g_list_copy
-#define gxg_g_list_last_w gxg_g_list_last
-#define gxg_g_list_first_w gxg_g_list_first
-#define gxg_g_list_length_w gxg_g_list_length
-#define gxg_g_free_w gxg_g_free
-#define gxg_g_list_remove_link_w gxg_g_list_remove_link
-#define gxg_g_object_get_data_w gxg_g_object_get_data
-#define gxg_g_object_set_data_w gxg_g_object_set_data
-#define gxg_gdk_cursor_new_from_pixbuf_w gxg_gdk_cursor_new_from_pixbuf
-#define gxg_gdk_display_flush_w gxg_gdk_display_flush
-#define gxg_gdk_display_supports_cursor_alpha_w gxg_gdk_display_supports_cursor_alpha
-#define gxg_gdk_display_supports_cursor_color_w gxg_gdk_display_supports_cursor_color
-#define gxg_gdk_display_get_default_cursor_size_w gxg_gdk_display_get_default_cursor_size
-#define gxg_gdk_display_get_maximal_cursor_size_w gxg_gdk_display_get_maximal_cursor_size
-#define gxg_gdk_window_set_keep_above_w gxg_gdk_window_set_keep_above
-#define gxg_gdk_window_set_keep_below_w gxg_gdk_window_set_keep_below
-#define gxg_gtk_alignment_set_padding_w gxg_gtk_alignment_set_padding
-#define gxg_gtk_alignment_get_padding_w gxg_gtk_alignment_get_padding
-#define gxg_gtk_button_box_get_child_secondary_w gxg_gtk_button_box_get_child_secondary
-#define gxg_gtk_button_set_focus_on_click_w gxg_gtk_button_set_focus_on_click
-#define gxg_gtk_button_get_focus_on_click_w gxg_gtk_button_get_focus_on_click
-#define gxg_gtk_calendar_set_display_options_w gxg_gtk_calendar_set_display_options
-#define gxg_gtk_calendar_get_display_options_w gxg_gtk_calendar_get_display_options
-#define gxg_gtk_check_menu_item_set_draw_as_radio_w gxg_gtk_check_menu_item_set_draw_as_radio
-#define gxg_gtk_check_menu_item_get_draw_as_radio_w gxg_gtk_check_menu_item_get_draw_as_radio
-#define gxg_gtk_entry_set_completion_w gxg_gtk_entry_set_completion
-#define gxg_gtk_entry_get_completion_w gxg_gtk_entry_get_completion
-#define gxg_gtk_event_box_get_visible_window_w gxg_gtk_event_box_get_visible_window
-#define gxg_gtk_event_box_set_visible_window_w gxg_gtk_event_box_set_visible_window
-#define gxg_gtk_event_box_get_above_child_w gxg_gtk_event_box_get_above_child
-#define gxg_gtk_event_box_set_above_child_w gxg_gtk_event_box_set_above_child
-#define gxg_gtk_icon_source_get_icon_name_w gxg_gtk_icon_source_get_icon_name
-#define gxg_gtk_menu_attach_w gxg_gtk_menu_attach
-#define gxg_gtk_text_buffer_select_range_w gxg_gtk_text_buffer_select_range
-#define gxg_gtk_text_view_set_overwrite_w gxg_gtk_text_view_set_overwrite
-#define gxg_gtk_text_view_get_overwrite_w gxg_gtk_text_view_get_overwrite
-#define gxg_gtk_text_view_set_accepts_tab_w gxg_gtk_text_view_set_accepts_tab
-#define gxg_gtk_text_view_get_accepts_tab_w gxg_gtk_text_view_get_accepts_tab
-#define gxg_gtk_toolbar_insert_w gxg_gtk_toolbar_insert
-#define gxg_gtk_toolbar_get_item_index_w gxg_gtk_toolbar_get_item_index
-#define gxg_gtk_toolbar_get_n_items_w gxg_gtk_toolbar_get_n_items
-#define gxg_gtk_toolbar_get_nth_item_w gxg_gtk_toolbar_get_nth_item
-#define gxg_gtk_toolbar_set_show_arrow_w gxg_gtk_toolbar_set_show_arrow
-#define gxg_gtk_toolbar_get_show_arrow_w gxg_gtk_toolbar_get_show_arrow
-#define gxg_gtk_toolbar_get_relief_style_w gxg_gtk_toolbar_get_relief_style
-#define gxg_gtk_toolbar_get_drop_index_w gxg_gtk_toolbar_get_drop_index
-#define gxg_gtk_tree_view_column_set_expand_w gxg_gtk_tree_view_column_set_expand
-#define gxg_gtk_tree_view_column_get_expand_w gxg_gtk_tree_view_column_get_expand
-#define gxg_gtk_widget_set_no_show_all_w gxg_gtk_widget_set_no_show_all
-#define gxg_gtk_widget_get_no_show_all_w gxg_gtk_widget_get_no_show_all
-#define gxg_gtk_widget_queue_resize_no_redraw_w gxg_gtk_widget_queue_resize_no_redraw
-#define gxg_gtk_window_set_default_icon_w gxg_gtk_window_set_default_icon
-#define gxg_gtk_window_set_keep_above_w gxg_gtk_window_set_keep_above
-#define gxg_gtk_window_set_keep_below_w gxg_gtk_window_set_keep_below
-#define gxg_gtk_file_chooser_dialog_new_w gxg_gtk_file_chooser_dialog_new
-#define gxg_gtk_file_chooser_widget_new_w gxg_gtk_file_chooser_widget_new
-#define gxg_gtk_tree_model_filter_new_w gxg_gtk_tree_model_filter_new
-#define gxg_gtk_tree_model_filter_set_visible_column_w gxg_gtk_tree_model_filter_set_visible_column
-#define gxg_gtk_tree_model_filter_get_model_w gxg_gtk_tree_model_filter_get_model
-#define gxg_gtk_tree_model_filter_convert_iter_to_child_iter_w gxg_gtk_tree_model_filter_convert_iter_to_child_iter
-#define gxg_gtk_tree_model_filter_convert_child_path_to_path_w gxg_gtk_tree_model_filter_convert_child_path_to_path
-#define gxg_gtk_tree_model_filter_convert_path_to_child_path_w gxg_gtk_tree_model_filter_convert_path_to_child_path
-#define gxg_gtk_tree_model_filter_refilter_w gxg_gtk_tree_model_filter_refilter
-#define gxg_gtk_tree_model_filter_clear_cache_w gxg_gtk_tree_model_filter_clear_cache
-#define gxg_gtk_action_get_name_w gxg_gtk_action_get_name
-#define gxg_gtk_action_activate_w gxg_gtk_action_activate
-#define gxg_gtk_action_create_icon_w gxg_gtk_action_create_icon
-#define gxg_gtk_action_create_menu_item_w gxg_gtk_action_create_menu_item
-#define gxg_gtk_action_create_tool_item_w gxg_gtk_action_create_tool_item
-#define gxg_gtk_action_get_proxies_w gxg_gtk_action_get_proxies
-#define gxg_gtk_action_connect_accelerator_w gxg_gtk_action_connect_accelerator
-#define gxg_gtk_action_disconnect_accelerator_w gxg_gtk_action_disconnect_accelerator
-#define gxg_gtk_action_group_new_w gxg_gtk_action_group_new
-#define gxg_gtk_action_group_get_name_w gxg_gtk_action_group_get_name
-#define gxg_gtk_action_group_get_action_w gxg_gtk_action_group_get_action
-#define gxg_gtk_action_group_list_actions_w gxg_gtk_action_group_list_actions
-#define gxg_gtk_action_group_add_action_w gxg_gtk_action_group_add_action
-#define gxg_gtk_action_group_remove_action_w gxg_gtk_action_group_remove_action
-#define gxg_gtk_action_group_add_actions_w gxg_gtk_action_group_add_actions
-#define gxg_gtk_action_group_add_toggle_actions_w gxg_gtk_action_group_add_toggle_actions
-#define gxg_gtk_action_group_add_toggle_actions_full_w gxg_gtk_action_group_add_toggle_actions_full
-#define gxg_gtk_action_group_set_translation_domain_w gxg_gtk_action_group_set_translation_domain
-#define gxg_gtk_combo_box_new_w gxg_gtk_combo_box_new
-#define gxg_gtk_combo_box_new_with_model_w gxg_gtk_combo_box_new_with_model
-#define gxg_gtk_combo_box_set_model_w gxg_gtk_combo_box_set_model
-#define gxg_gtk_combo_box_set_wrap_width_w gxg_gtk_combo_box_set_wrap_width
-#define gxg_gtk_combo_box_set_row_span_column_w gxg_gtk_combo_box_set_row_span_column
-#define gxg_gtk_combo_box_set_column_span_column_w gxg_gtk_combo_box_set_column_span_column
-#define gxg_gtk_combo_box_get_active_w gxg_gtk_combo_box_get_active
-#define gxg_gtk_combo_box_set_active_w gxg_gtk_combo_box_set_active
-#define gxg_gtk_combo_box_get_active_iter_w gxg_gtk_combo_box_get_active_iter
-#define gxg_gtk_combo_box_set_active_iter_w gxg_gtk_combo_box_set_active_iter
-#define gxg_gtk_combo_box_get_model_w gxg_gtk_combo_box_get_model
-#define gxg_gtk_expander_new_w gxg_gtk_expander_new
-#define gxg_gtk_expander_new_with_mnemonic_w gxg_gtk_expander_new_with_mnemonic
-#define gxg_gtk_expander_set_expanded_w gxg_gtk_expander_set_expanded
-#define gxg_gtk_expander_get_expanded_w gxg_gtk_expander_get_expanded
-#define gxg_gtk_expander_set_spacing_w gxg_gtk_expander_set_spacing
-#define gxg_gtk_expander_get_spacing_w gxg_gtk_expander_get_spacing
-#define gxg_gtk_expander_set_label_w gxg_gtk_expander_set_label
-#define gxg_gtk_expander_get_label_w gxg_gtk_expander_get_label
-#define gxg_gtk_expander_set_use_underline_w gxg_gtk_expander_set_use_underline
-#define gxg_gtk_expander_get_use_underline_w gxg_gtk_expander_get_use_underline
-#define gxg_gtk_expander_set_label_widget_w gxg_gtk_expander_set_label_widget
-#define gxg_gtk_expander_get_label_widget_w gxg_gtk_expander_get_label_widget
-#define gxg_gtk_expander_set_use_markup_w gxg_gtk_expander_set_use_markup
-#define gxg_gtk_expander_get_use_markup_w gxg_gtk_expander_get_use_markup
-#define gxg_gtk_font_button_new_w gxg_gtk_font_button_new
-#define gxg_gtk_font_button_new_with_font_w gxg_gtk_font_button_new_with_font
-#define gxg_gtk_font_button_get_title_w gxg_gtk_font_button_get_title
-#define gxg_gtk_font_button_set_title_w gxg_gtk_font_button_set_title
-#define gxg_gtk_font_button_get_use_font_w gxg_gtk_font_button_get_use_font
-#define gxg_gtk_font_button_set_use_font_w gxg_gtk_font_button_set_use_font
-#define gxg_gtk_font_button_get_use_size_w gxg_gtk_font_button_get_use_size
-#define gxg_gtk_font_button_set_use_size_w gxg_gtk_font_button_set_use_size
-#define gxg_gtk_font_button_get_font_name_w gxg_gtk_font_button_get_font_name
-#define gxg_gtk_font_button_set_font_name_w gxg_gtk_font_button_set_font_name
-#define gxg_gtk_font_button_get_show_style_w gxg_gtk_font_button_get_show_style
-#define gxg_gtk_font_button_set_show_style_w gxg_gtk_font_button_set_show_style
-#define gxg_gtk_font_button_get_show_size_w gxg_gtk_font_button_get_show_size
-#define gxg_gtk_font_button_set_show_size_w gxg_gtk_font_button_set_show_size
-#define gxg_gtk_color_button_new_w gxg_gtk_color_button_new
-#define gxg_gtk_color_button_new_with_color_w gxg_gtk_color_button_new_with_color
-#define gxg_gtk_color_button_set_color_w gxg_gtk_color_button_set_color
-#define gxg_gtk_color_button_set_alpha_w gxg_gtk_color_button_set_alpha
-#define gxg_gtk_color_button_get_color_w gxg_gtk_color_button_get_color
-#define gxg_gtk_color_button_get_alpha_w gxg_gtk_color_button_get_alpha
-#define gxg_gtk_color_button_set_use_alpha_w gxg_gtk_color_button_set_use_alpha
-#define gxg_gtk_color_button_get_use_alpha_w gxg_gtk_color_button_get_use_alpha
-#define gxg_gtk_color_button_set_title_w gxg_gtk_color_button_set_title
-#define gxg_gtk_color_button_get_title_w gxg_gtk_color_button_get_title
-#define gxg_gtk_entry_completion_new_w gxg_gtk_entry_completion_new
-#define gxg_gtk_entry_completion_get_entry_w gxg_gtk_entry_completion_get_entry
-#define gxg_gtk_entry_completion_set_model_w gxg_gtk_entry_completion_set_model
-#define gxg_gtk_entry_completion_get_model_w gxg_gtk_entry_completion_get_model
-#define gxg_gtk_entry_completion_set_match_func_w gxg_gtk_entry_completion_set_match_func
-#define gxg_gtk_entry_completion_set_minimum_key_length_w gxg_gtk_entry_completion_set_minimum_key_length
-#define gxg_gtk_entry_completion_get_minimum_key_length_w gxg_gtk_entry_completion_get_minimum_key_length
-#define gxg_gtk_entry_completion_complete_w gxg_gtk_entry_completion_complete
-#define gxg_gtk_entry_completion_insert_action_text_w gxg_gtk_entry_completion_insert_action_text
-#define gxg_gtk_entry_completion_insert_action_markup_w gxg_gtk_entry_completion_insert_action_markup
-#define gxg_gtk_entry_completion_delete_action_w gxg_gtk_entry_completion_delete_action
-#define gxg_gtk_entry_completion_set_text_column_w gxg_gtk_entry_completion_set_text_column
-#define gxg_gtk_radio_tool_button_new_w gxg_gtk_radio_tool_button_new
-#define gxg_gtk_radio_tool_button_new_from_stock_w gxg_gtk_radio_tool_button_new_from_stock
-#define gxg_gtk_radio_tool_button_new_from_widget_w gxg_gtk_radio_tool_button_new_from_widget
-#define gxg_gtk_radio_tool_button_new_with_stock_from_widget_w gxg_gtk_radio_tool_button_new_with_stock_from_widget
-#define gxg_gtk_radio_tool_button_get_group_w gxg_gtk_radio_tool_button_get_group
-#define gxg_gtk_radio_tool_button_set_group_w gxg_gtk_radio_tool_button_set_group
-#define gxg_gtk_radio_action_get_group_w gxg_gtk_radio_action_get_group
-#define gxg_gtk_radio_action_set_group_w gxg_gtk_radio_action_set_group
-#define gxg_gtk_radio_action_get_current_value_w gxg_gtk_radio_action_get_current_value
-#define gxg_gtk_separator_tool_item_new_w gxg_gtk_separator_tool_item_new
-#define gxg_gtk_separator_tool_item_get_draw_w gxg_gtk_separator_tool_item_get_draw
-#define gxg_gtk_separator_tool_item_set_draw_w gxg_gtk_separator_tool_item_set_draw
-#define gxg_gtk_toggle_action_toggled_w gxg_gtk_toggle_action_toggled
-#define gxg_gtk_toggle_action_set_active_w gxg_gtk_toggle_action_set_active
-#define gxg_gtk_toggle_action_get_active_w gxg_gtk_toggle_action_get_active
-#define gxg_gtk_toggle_action_set_draw_as_radio_w gxg_gtk_toggle_action_set_draw_as_radio
-#define gxg_gtk_toggle_action_get_draw_as_radio_w gxg_gtk_toggle_action_get_draw_as_radio
-#define gxg_gtk_toggle_tool_button_new_w gxg_gtk_toggle_tool_button_new
-#define gxg_gtk_toggle_tool_button_new_from_stock_w gxg_gtk_toggle_tool_button_new_from_stock
-#define gxg_gtk_toggle_tool_button_set_active_w gxg_gtk_toggle_tool_button_set_active
-#define gxg_gtk_toggle_tool_button_get_active_w gxg_gtk_toggle_tool_button_get_active
-#define gxg_g_timeout_add_full_w gxg_g_timeout_add_full
-#define gxg_g_timeout_add_w gxg_g_timeout_add
-#define gxg_g_idle_add_w gxg_g_idle_add
-#define gxg_g_idle_add_full_w gxg_g_idle_add_full
-#define gxg_g_idle_remove_by_data_w gxg_g_idle_remove_by_data
-#define gxg_g_source_remove_w gxg_g_source_remove
-#define gxg_gtk_file_filter_new_w gxg_gtk_file_filter_new
-#define gxg_gtk_file_filter_set_name_w gxg_gtk_file_filter_set_name
-#define gxg_gtk_file_filter_get_name_w gxg_gtk_file_filter_get_name
-#define gxg_gtk_file_filter_add_mime_type_w gxg_gtk_file_filter_add_mime_type
-#define gxg_gtk_file_filter_add_pattern_w gxg_gtk_file_filter_add_pattern
-#define gxg_gtk_file_filter_add_custom_w gxg_gtk_file_filter_add_custom
-#define gxg_gtk_file_filter_get_needed_w gxg_gtk_file_filter_get_needed
-#define gxg_gtk_file_filter_filter_w gxg_gtk_file_filter_filter
-#define gxg_gtk_cell_layout_pack_start_w gxg_gtk_cell_layout_pack_start
-#define gxg_gtk_cell_layout_pack_end_w gxg_gtk_cell_layout_pack_end
-#define gxg_gtk_cell_layout_clear_w gxg_gtk_cell_layout_clear
-#define gxg_gtk_cell_layout_set_attributes_w gxg_gtk_cell_layout_set_attributes
-#define gxg_gtk_cell_layout_add_attribute_w gxg_gtk_cell_layout_add_attribute
-#define gxg_gtk_cell_layout_set_cell_data_func_w gxg_gtk_cell_layout_set_cell_data_func
-#define gxg_gtk_cell_layout_clear_attributes_w gxg_gtk_cell_layout_clear_attributes
-#define gxg_gtk_file_chooser_set_action_w gxg_gtk_file_chooser_set_action
-#define gxg_gtk_file_chooser_get_action_w gxg_gtk_file_chooser_get_action
-#define gxg_gtk_file_chooser_set_local_only_w gxg_gtk_file_chooser_set_local_only
-#define gxg_gtk_file_chooser_get_local_only_w gxg_gtk_file_chooser_get_local_only
-#define gxg_gtk_file_chooser_set_select_multiple_w gxg_gtk_file_chooser_set_select_multiple
-#define gxg_gtk_file_chooser_get_select_multiple_w gxg_gtk_file_chooser_get_select_multiple
-#define gxg_gtk_file_chooser_set_current_name_w gxg_gtk_file_chooser_set_current_name
-#define gxg_gtk_file_chooser_get_filename_w gxg_gtk_file_chooser_get_filename
-#define gxg_gtk_file_chooser_set_filename_w gxg_gtk_file_chooser_set_filename
-#define gxg_gtk_file_chooser_select_filename_w gxg_gtk_file_chooser_select_filename
-#define gxg_gtk_file_chooser_unselect_filename_w gxg_gtk_file_chooser_unselect_filename
-#define gxg_gtk_file_chooser_select_all_w gxg_gtk_file_chooser_select_all
-#define gxg_gtk_file_chooser_unselect_all_w gxg_gtk_file_chooser_unselect_all
-#define gxg_gtk_file_chooser_get_filenames_w gxg_gtk_file_chooser_get_filenames
-#define gxg_gtk_file_chooser_set_current_folder_w gxg_gtk_file_chooser_set_current_folder
-#define gxg_gtk_file_chooser_get_current_folder_w gxg_gtk_file_chooser_get_current_folder
-#define gxg_gtk_file_chooser_get_uri_w gxg_gtk_file_chooser_get_uri
-#define gxg_gtk_file_chooser_set_uri_w gxg_gtk_file_chooser_set_uri
-#define gxg_gtk_file_chooser_select_uri_w gxg_gtk_file_chooser_select_uri
-#define gxg_gtk_file_chooser_unselect_uri_w gxg_gtk_file_chooser_unselect_uri
-#define gxg_gtk_file_chooser_get_uris_w gxg_gtk_file_chooser_get_uris
-#define gxg_gtk_file_chooser_set_current_folder_uri_w gxg_gtk_file_chooser_set_current_folder_uri
-#define gxg_gtk_file_chooser_get_current_folder_uri_w gxg_gtk_file_chooser_get_current_folder_uri
-#define gxg_gtk_file_chooser_set_preview_widget_w gxg_gtk_file_chooser_set_preview_widget
-#define gxg_gtk_file_chooser_get_preview_widget_w gxg_gtk_file_chooser_get_preview_widget
-#define gxg_gtk_file_chooser_set_preview_widget_active_w gxg_gtk_file_chooser_set_preview_widget_active
-#define gxg_gtk_file_chooser_get_preview_widget_active_w gxg_gtk_file_chooser_get_preview_widget_active
-#define gxg_gtk_file_chooser_get_preview_filename_w gxg_gtk_file_chooser_get_preview_filename
-#define gxg_gtk_file_chooser_get_preview_uri_w gxg_gtk_file_chooser_get_preview_uri
-#define gxg_gtk_file_chooser_set_extra_widget_w gxg_gtk_file_chooser_set_extra_widget
-#define gxg_gtk_file_chooser_get_extra_widget_w gxg_gtk_file_chooser_get_extra_widget
-#define gxg_gtk_file_chooser_add_filter_w gxg_gtk_file_chooser_add_filter
-#define gxg_gtk_file_chooser_remove_filter_w gxg_gtk_file_chooser_remove_filter
-#define gxg_gtk_file_chooser_list_filters_w gxg_gtk_file_chooser_list_filters
-#define gxg_gtk_file_chooser_set_filter_w gxg_gtk_file_chooser_set_filter
-#define gxg_gtk_file_chooser_get_filter_w gxg_gtk_file_chooser_get_filter
-#define gxg_gtk_file_chooser_add_shortcut_folder_w gxg_gtk_file_chooser_add_shortcut_folder
-#define gxg_gtk_file_chooser_remove_shortcut_folder_w gxg_gtk_file_chooser_remove_shortcut_folder
-#define gxg_gtk_file_chooser_list_shortcut_folders_w gxg_gtk_file_chooser_list_shortcut_folders
-#define gxg_gtk_file_chooser_add_shortcut_folder_uri_w gxg_gtk_file_chooser_add_shortcut_folder_uri
-#define gxg_gtk_file_chooser_remove_shortcut_folder_uri_w gxg_gtk_file_chooser_remove_shortcut_folder_uri
-#define gxg_gtk_file_chooser_list_shortcut_folder_uris_w gxg_gtk_file_chooser_list_shortcut_folder_uris
-#define gxg_gtk_icon_theme_new_w gxg_gtk_icon_theme_new
-#define gxg_gtk_icon_theme_get_default_w gxg_gtk_icon_theme_get_default
-#define gxg_gtk_icon_theme_get_for_screen_w gxg_gtk_icon_theme_get_for_screen
-#define gxg_gtk_icon_theme_set_screen_w gxg_gtk_icon_theme_set_screen
-#define gxg_gtk_icon_theme_get_search_path_w gxg_gtk_icon_theme_get_search_path
-#define gxg_gtk_icon_theme_append_search_path_w gxg_gtk_icon_theme_append_search_path
-#define gxg_gtk_icon_theme_prepend_search_path_w gxg_gtk_icon_theme_prepend_search_path
-#define gxg_gtk_icon_theme_set_custom_theme_w gxg_gtk_icon_theme_set_custom_theme
-#define gxg_gtk_icon_theme_has_icon_w gxg_gtk_icon_theme_has_icon
-#define gxg_gtk_icon_theme_lookup_icon_w gxg_gtk_icon_theme_lookup_icon
-#define gxg_gtk_icon_theme_load_icon_w gxg_gtk_icon_theme_load_icon
-#define gxg_gtk_icon_theme_list_icons_w gxg_gtk_icon_theme_list_icons
-#define gxg_gtk_icon_theme_get_example_icon_name_w gxg_gtk_icon_theme_get_example_icon_name
-#define gxg_gtk_icon_theme_rescan_if_needed_w gxg_gtk_icon_theme_rescan_if_needed
-#define gxg_gtk_icon_theme_add_builtin_icon_w gxg_gtk_icon_theme_add_builtin_icon
-#define gxg_gtk_icon_info_copy_w gxg_gtk_icon_info_copy
-#define gxg_gtk_icon_info_free_w gxg_gtk_icon_info_free
-#define gxg_gtk_icon_info_get_base_size_w gxg_gtk_icon_info_get_base_size
-#define gxg_gtk_icon_info_get_filename_w gxg_gtk_icon_info_get_filename
-#define gxg_gtk_icon_info_get_builtin_pixbuf_w gxg_gtk_icon_info_get_builtin_pixbuf
-#define gxg_gtk_icon_info_load_icon_w gxg_gtk_icon_info_load_icon
-#define gxg_gtk_icon_info_set_raw_coordinates_w gxg_gtk_icon_info_set_raw_coordinates
-#define gxg_gtk_icon_info_get_embedded_rect_w gxg_gtk_icon_info_get_embedded_rect
-#define gxg_gtk_icon_info_get_display_name_w gxg_gtk_icon_info_get_display_name
-#define gxg_gtk_tool_button_new_w gxg_gtk_tool_button_new
-#define gxg_gtk_tool_button_new_from_stock_w gxg_gtk_tool_button_new_from_stock
-#define gxg_gtk_tool_button_set_label_w gxg_gtk_tool_button_set_label
-#define gxg_gtk_tool_button_get_label_w gxg_gtk_tool_button_get_label
-#define gxg_gtk_tool_button_set_use_underline_w gxg_gtk_tool_button_set_use_underline
-#define gxg_gtk_tool_button_get_use_underline_w gxg_gtk_tool_button_get_use_underline
-#define gxg_gtk_tool_button_set_stock_id_w gxg_gtk_tool_button_set_stock_id
-#define gxg_gtk_tool_button_get_stock_id_w gxg_gtk_tool_button_get_stock_id
-#define gxg_gtk_tool_button_set_icon_widget_w gxg_gtk_tool_button_set_icon_widget
-#define gxg_gtk_tool_button_get_icon_widget_w gxg_gtk_tool_button_get_icon_widget
-#define gxg_gtk_tool_button_set_label_widget_w gxg_gtk_tool_button_set_label_widget
-#define gxg_gtk_tool_button_get_label_widget_w gxg_gtk_tool_button_get_label_widget
-#define gxg_gtk_tool_item_new_w gxg_gtk_tool_item_new
-#define gxg_gtk_tool_item_set_homogeneous_w gxg_gtk_tool_item_set_homogeneous
-#define gxg_gtk_tool_item_get_homogeneous_w gxg_gtk_tool_item_get_homogeneous
-#define gxg_gtk_tool_item_set_expand_w gxg_gtk_tool_item_set_expand
-#define gxg_gtk_tool_item_get_expand_w gxg_gtk_tool_item_get_expand
-#define gxg_gtk_tool_item_set_use_drag_window_w gxg_gtk_tool_item_set_use_drag_window
-#define gxg_gtk_tool_item_get_use_drag_window_w gxg_gtk_tool_item_get_use_drag_window
-#define gxg_gtk_tool_item_set_visible_horizontal_w gxg_gtk_tool_item_set_visible_horizontal
-#define gxg_gtk_tool_item_get_visible_horizontal_w gxg_gtk_tool_item_get_visible_horizontal
-#define gxg_gtk_tool_item_set_visible_vertical_w gxg_gtk_tool_item_set_visible_vertical
-#define gxg_gtk_tool_item_get_visible_vertical_w gxg_gtk_tool_item_get_visible_vertical
-#define gxg_gtk_tool_item_get_is_important_w gxg_gtk_tool_item_get_is_important
-#define gxg_gtk_tool_item_set_is_important_w gxg_gtk_tool_item_set_is_important
-#define gxg_gtk_tool_item_get_icon_size_w gxg_gtk_tool_item_get_icon_size
-#define gxg_gtk_tool_item_get_orientation_w gxg_gtk_tool_item_get_orientation
-#define gxg_gtk_tool_item_get_toolbar_style_w gxg_gtk_tool_item_get_toolbar_style
-#define gxg_gtk_tool_item_get_relief_style_w gxg_gtk_tool_item_get_relief_style
-#define gxg_gtk_tool_item_retrieve_proxy_menu_item_w gxg_gtk_tool_item_retrieve_proxy_menu_item
-#define gxg_gtk_tool_item_get_proxy_menu_item_w gxg_gtk_tool_item_get_proxy_menu_item
-#define gxg_gtk_tool_item_set_proxy_menu_item_w gxg_gtk_tool_item_set_proxy_menu_item
-#define gxg_gtk_list_store_remove_w gxg_gtk_list_store_remove
-#define gxg_gdk_display_set_double_click_distance_w gxg_gdk_display_set_double_click_distance
-#define gxg_gdk_display_get_default_group_w gxg_gdk_display_get_default_group
-#define gxg_gdk_window_get_group_w gxg_gdk_window_get_group
-#define gxg_gtk_action_group_get_sensitive_w gxg_gtk_action_group_get_sensitive
-#define gxg_gtk_action_group_set_sensitive_w gxg_gtk_action_group_set_sensitive
-#define gxg_gtk_action_group_get_visible_w gxg_gtk_action_group_get_visible
-#define gxg_gtk_action_group_set_visible_w gxg_gtk_action_group_set_visible
-#define gxg_gtk_action_group_add_action_with_accel_w gxg_gtk_action_group_add_action_with_accel
-#define gxg_gtk_action_new_w gxg_gtk_action_new
-#define gxg_gtk_action_is_sensitive_w gxg_gtk_action_is_sensitive
-#define gxg_gtk_action_get_sensitive_w gxg_gtk_action_get_sensitive
-#define gxg_gtk_action_is_visible_w gxg_gtk_action_is_visible
-#define gxg_gtk_action_get_visible_w gxg_gtk_action_get_visible
-#define gxg_gtk_button_set_alignment_w gxg_gtk_button_set_alignment
-#define gxg_gtk_button_get_alignment_w gxg_gtk_button_get_alignment
-#define gxg_gtk_cell_layout_reorder_w gxg_gtk_cell_layout_reorder
-#define gxg_gtk_clipboard_request_targets_w gxg_gtk_clipboard_request_targets
-#define gxg_gtk_clipboard_wait_for_targets_w gxg_gtk_clipboard_wait_for_targets
-#define gxg_gtk_menu_shell_cancel_w gxg_gtk_menu_shell_cancel
-#define gxg_gtk_paned_get_child1_w gxg_gtk_paned_get_child1
-#define gxg_gtk_paned_get_child2_w gxg_gtk_paned_get_child2
-#define gxg_gtk_radio_action_new_w gxg_gtk_radio_action_new
-#define gxg_gtk_toggle_action_new_w gxg_gtk_toggle_action_new
-#define gxg_gtk_window_set_accept_focus_w gxg_gtk_window_set_accept_focus
-#define gxg_gtk_window_get_accept_focus_w gxg_gtk_window_get_accept_focus
-#define gxg_g_list_nth_data_w gxg_g_list_nth_data
-#define gxg_gtk_accel_map_get_w gxg_gtk_accel_map_get
-#define gxg_gtk_combo_box_popup_w gxg_gtk_combo_box_popup
-#define gxg_gtk_combo_box_popdown_w gxg_gtk_combo_box_popdown
-#define gxg_gtk_radio_menu_item_new_from_widget_w gxg_gtk_radio_menu_item_new_from_widget
-#define gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget_w gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget
-#define gxg_gtk_radio_menu_item_new_with_label_from_widget_w gxg_gtk_radio_menu_item_new_with_label_from_widget
-#define gxg_gtk_scale_get_layout_w gxg_gtk_scale_get_layout
-#define gxg_gtk_scale_get_layout_offsets_w gxg_gtk_scale_get_layout_offsets
-#define gxg_gtk_drag_source_get_target_list_w gxg_gtk_drag_source_get_target_list
-#define gxg_gtk_drag_source_set_target_list_w gxg_gtk_drag_source_set_target_list
-#define gxg_gtk_entry_set_alignment_w gxg_gtk_entry_set_alignment
-#define gxg_gtk_entry_get_alignment_w gxg_gtk_entry_get_alignment
-#define gxg_gtk_file_chooser_set_use_preview_label_w gxg_gtk_file_chooser_set_use_preview_label
-#define gxg_gtk_file_chooser_get_use_preview_label_w gxg_gtk_file_chooser_get_use_preview_label
-#define gxg_gtk_widget_list_mnemonic_labels_w gxg_gtk_widget_list_mnemonic_labels
-#define gxg_gtk_widget_add_mnemonic_label_w gxg_gtk_widget_add_mnemonic_label
-#define gxg_gtk_widget_remove_mnemonic_label_w gxg_gtk_widget_remove_mnemonic_label
-#define gxg_gtk_window_activate_key_w gxg_gtk_window_activate_key
-#define gxg_gtk_window_propagate_key_event_w gxg_gtk_window_propagate_key_event
-#define gxg_g_quark_from_string_w gxg_g_quark_from_string
-#define gxg_g_quark_to_string_w gxg_g_quark_to_string
-#define gxg_gtk_cell_view_new_w gxg_gtk_cell_view_new
-#define gxg_gtk_cell_view_new_with_text_w gxg_gtk_cell_view_new_with_text
-#define gxg_gtk_cell_view_new_with_markup_w gxg_gtk_cell_view_new_with_markup
-#define gxg_gtk_cell_view_new_with_pixbuf_w gxg_gtk_cell_view_new_with_pixbuf
-#define gxg_gtk_cell_view_set_model_w gxg_gtk_cell_view_set_model
-#define gxg_gtk_cell_view_set_displayed_row_w gxg_gtk_cell_view_set_displayed_row
-#define gxg_gtk_cell_view_get_displayed_row_w gxg_gtk_cell_view_get_displayed_row
-#define gxg_gtk_cell_view_set_background_color_w gxg_gtk_cell_view_set_background_color
-#define gxg_gdk_window_enable_synchronized_configure_w gxg_gdk_window_enable_synchronized_configure
-#define gxg_gdk_window_configure_finished_w gxg_gdk_window_configure_finished
-#define gxg_gtk_combo_box_get_wrap_width_w gxg_gtk_combo_box_get_wrap_width
-#define gxg_gtk_combo_box_get_row_span_column_w gxg_gtk_combo_box_get_row_span_column
-#define gxg_gtk_combo_box_get_column_span_column_w gxg_gtk_combo_box_get_column_span_column
-#define gxg_gtk_combo_box_get_add_tearoffs_w gxg_gtk_combo_box_get_add_tearoffs
-#define gxg_gtk_combo_box_set_add_tearoffs_w gxg_gtk_combo_box_set_add_tearoffs
-#define gxg_gtk_drag_dest_add_text_targets_w gxg_gtk_drag_dest_add_text_targets
-#define gxg_gtk_drag_source_add_text_targets_w gxg_gtk_drag_source_add_text_targets
-#define gxg_gtk_entry_completion_insert_prefix_w gxg_gtk_entry_completion_insert_prefix
-#define gxg_gtk_entry_completion_set_inline_completion_w gxg_gtk_entry_completion_set_inline_completion
-#define gxg_gtk_entry_completion_get_inline_completion_w gxg_gtk_entry_completion_get_inline_completion
-#define gxg_gtk_entry_completion_set_popup_completion_w gxg_gtk_entry_completion_set_popup_completion
-#define gxg_gtk_entry_completion_get_popup_completion_w gxg_gtk_entry_completion_get_popup_completion
-#define gxg_gtk_entry_completion_get_text_column_w gxg_gtk_entry_completion_get_text_column
-#define gxg_gtk_icon_theme_get_icon_sizes_w gxg_gtk_icon_theme_get_icon_sizes
-#define gxg_gtk_menu_get_for_attach_widget_w gxg_gtk_menu_get_for_attach_widget
-#define gxg_gtk_tree_view_set_fixed_height_mode_w gxg_gtk_tree_view_set_fixed_height_mode
-#define gxg_gtk_tree_view_get_fixed_height_mode_w gxg_gtk_tree_view_get_fixed_height_mode
-#define gxg_gtk_tree_view_set_hover_selection_w gxg_gtk_tree_view_set_hover_selection
-#define gxg_gtk_tree_view_get_hover_selection_w gxg_gtk_tree_view_get_hover_selection
-#define gxg_gtk_tree_view_set_row_separator_func_w gxg_gtk_tree_view_set_row_separator_func
-#define gxg_gtk_window_set_focus_on_map_w gxg_gtk_window_set_focus_on_map
-#define gxg_gtk_window_get_focus_on_map_w gxg_gtk_window_get_focus_on_map
-#define gxg_gtk_window_set_icon_name_w gxg_gtk_window_set_icon_name
-#define gxg_gtk_window_get_icon_name_w gxg_gtk_window_get_icon_name
-#define gxg_gtk_window_set_default_icon_name_w gxg_gtk_window_set_default_icon_name
-#define gxg_gtk_about_dialog_new_w gxg_gtk_about_dialog_new
-#define gxg_gtk_about_dialog_get_version_w gxg_gtk_about_dialog_get_version
-#define gxg_gtk_about_dialog_set_version_w gxg_gtk_about_dialog_set_version
-#define gxg_gtk_about_dialog_get_copyright_w gxg_gtk_about_dialog_get_copyright
-#define gxg_gtk_about_dialog_set_copyright_w gxg_gtk_about_dialog_set_copyright
-#define gxg_gtk_about_dialog_get_comments_w gxg_gtk_about_dialog_get_comments
-#define gxg_gtk_about_dialog_set_comments_w gxg_gtk_about_dialog_set_comments
-#define gxg_gtk_about_dialog_get_license_w gxg_gtk_about_dialog_get_license
-#define gxg_gtk_about_dialog_set_license_w gxg_gtk_about_dialog_set_license
-#define gxg_gtk_about_dialog_get_website_w gxg_gtk_about_dialog_get_website
-#define gxg_gtk_about_dialog_set_website_w gxg_gtk_about_dialog_set_website
-#define gxg_gtk_about_dialog_get_website_label_w gxg_gtk_about_dialog_get_website_label
-#define gxg_gtk_about_dialog_set_website_label_w gxg_gtk_about_dialog_set_website_label
-#define gxg_gtk_about_dialog_get_authors_w gxg_gtk_about_dialog_get_authors
-#define gxg_gtk_about_dialog_set_authors_w gxg_gtk_about_dialog_set_authors
-#define gxg_gtk_about_dialog_get_documenters_w gxg_gtk_about_dialog_get_documenters
-#define gxg_gtk_about_dialog_set_documenters_w gxg_gtk_about_dialog_set_documenters
-#define gxg_gtk_about_dialog_get_artists_w gxg_gtk_about_dialog_get_artists
-#define gxg_gtk_about_dialog_set_artists_w gxg_gtk_about_dialog_set_artists
-#define gxg_gtk_about_dialog_get_translator_credits_w gxg_gtk_about_dialog_get_translator_credits
-#define gxg_gtk_about_dialog_set_translator_credits_w gxg_gtk_about_dialog_set_translator_credits
-#define gxg_gtk_about_dialog_get_logo_w gxg_gtk_about_dialog_get_logo
-#define gxg_gtk_about_dialog_set_logo_w gxg_gtk_about_dialog_set_logo
-#define gxg_gtk_about_dialog_get_program_name_w gxg_gtk_about_dialog_get_program_name
-#define gxg_gtk_about_dialog_set_program_name_w gxg_gtk_about_dialog_set_program_name
-#define gxg_gtk_icon_view_new_w gxg_gtk_icon_view_new
-#define gxg_gtk_icon_view_new_with_model_w gxg_gtk_icon_view_new_with_model
-#define gxg_gtk_icon_view_set_model_w gxg_gtk_icon_view_set_model
-#define gxg_gtk_icon_view_get_model_w gxg_gtk_icon_view_get_model
-#define gxg_gtk_icon_view_set_text_column_w gxg_gtk_icon_view_set_text_column
-#define gxg_gtk_icon_view_get_text_column_w gxg_gtk_icon_view_get_text_column
-#define gxg_gtk_icon_view_set_markup_column_w gxg_gtk_icon_view_set_markup_column
-#define gxg_gtk_icon_view_get_markup_column_w gxg_gtk_icon_view_get_markup_column
-#define gxg_gtk_icon_view_set_pixbuf_column_w gxg_gtk_icon_view_set_pixbuf_column
-#define gxg_gtk_icon_view_get_pixbuf_column_w gxg_gtk_icon_view_get_pixbuf_column
-#define gxg_gtk_icon_view_get_path_at_pos_w gxg_gtk_icon_view_get_path_at_pos
-#define gxg_gtk_icon_view_selected_foreach_w gxg_gtk_icon_view_selected_foreach
-#define gxg_gtk_icon_view_set_selection_mode_w gxg_gtk_icon_view_set_selection_mode
-#define gxg_gtk_icon_view_get_selection_mode_w gxg_gtk_icon_view_get_selection_mode
-#define gxg_gtk_icon_view_select_path_w gxg_gtk_icon_view_select_path
-#define gxg_gtk_icon_view_unselect_path_w gxg_gtk_icon_view_unselect_path
-#define gxg_gtk_icon_view_path_is_selected_w gxg_gtk_icon_view_path_is_selected
-#define gxg_gtk_icon_view_get_selected_items_w gxg_gtk_icon_view_get_selected_items
-#define gxg_gtk_icon_view_select_all_w gxg_gtk_icon_view_select_all
-#define gxg_gtk_icon_view_unselect_all_w gxg_gtk_icon_view_unselect_all
-#define gxg_gtk_icon_view_item_activated_w gxg_gtk_icon_view_item_activated
-#define gxg_gtk_cell_renderer_combo_new_w gxg_gtk_cell_renderer_combo_new
-#define gxg_gtk_cell_renderer_progress_new_w gxg_gtk_cell_renderer_progress_new
-#define gxg_gtk_combo_box_set_row_separator_func_w gxg_gtk_combo_box_set_row_separator_func
-#define gxg_gtk_label_set_ellipsize_w gxg_gtk_label_set_ellipsize
-#define gxg_gtk_label_get_ellipsize_w gxg_gtk_label_get_ellipsize
-#define gxg_pango_attr_fallback_new_w gxg_pango_attr_fallback_new
-#define gxg_pango_attr_letter_spacing_new_w gxg_pango_attr_letter_spacing_new
-#define gxg_pango_attr_list_filter_w gxg_pango_attr_list_filter
-#define gxg_pango_attr_iterator_get_attrs_w gxg_pango_attr_iterator_get_attrs
-#define gxg_pango_font_metrics_get_underline_position_w gxg_pango_font_metrics_get_underline_position
-#define gxg_pango_font_metrics_get_underline_thickness_w gxg_pango_font_metrics_get_underline_thickness
-#define gxg_pango_font_metrics_get_strikethrough_position_w gxg_pango_font_metrics_get_strikethrough_position
-#define gxg_pango_font_metrics_get_strikethrough_thickness_w gxg_pango_font_metrics_get_strikethrough_thickness
-#define gxg_pango_font_family_is_monospace_w gxg_pango_font_family_is_monospace
-#define gxg_pango_font_face_list_sizes_w gxg_pango_font_face_list_sizes
-#define gxg_pango_layout_set_auto_dir_w gxg_pango_layout_set_auto_dir
-#define gxg_pango_layout_get_auto_dir_w gxg_pango_layout_get_auto_dir
-#define gxg_pango_script_for_unichar_w gxg_pango_script_for_unichar
-#define gxg_pango_script_iter_new_w gxg_pango_script_iter_new
-#define gxg_pango_script_iter_get_range_w gxg_pango_script_iter_get_range
-#define gxg_pango_script_iter_next_w gxg_pango_script_iter_next
-#define gxg_pango_script_iter_free_w gxg_pango_script_iter_free
-#define gxg_gtk_file_chooser_button_new_with_dialog_w gxg_gtk_file_chooser_button_new_with_dialog
-#define gxg_gtk_file_chooser_button_get_title_w gxg_gtk_file_chooser_button_get_title
-#define gxg_gtk_file_chooser_button_set_title_w gxg_gtk_file_chooser_button_set_title
-#define gxg_gdk_drag_drop_succeeded_w gxg_gdk_drag_drop_succeeded
-#define gxg_gtk_action_set_sensitive_w gxg_gtk_action_set_sensitive
-#define gxg_gtk_action_set_visible_w gxg_gtk_action_set_visible
-#define gxg_gtk_combo_box_get_focus_on_click_w gxg_gtk_combo_box_get_focus_on_click
-#define gxg_gtk_combo_box_set_focus_on_click_w gxg_gtk_combo_box_set_focus_on_click
-#define gxg_gtk_entry_layout_index_to_text_index_w gxg_gtk_entry_layout_index_to_text_index
-#define gxg_gtk_entry_text_index_to_layout_index_w gxg_gtk_entry_text_index_to_layout_index
-#define gxg_gtk_file_chooser_set_show_hidden_w gxg_gtk_file_chooser_set_show_hidden
-#define gxg_gtk_file_chooser_get_show_hidden_w gxg_gtk_file_chooser_get_show_hidden
-#define gxg_gtk_tree_view_set_hover_expand_w gxg_gtk_tree_view_set_hover_expand
-#define gxg_gtk_tree_view_get_hover_expand_w gxg_gtk_tree_view_get_hover_expand
-#define gxg_gtk_tool_item_rebuild_menu_w gxg_gtk_tool_item_rebuild_menu
-#define gxg_gtk_menu_tool_button_new_w gxg_gtk_menu_tool_button_new
-#define gxg_gtk_menu_tool_button_new_from_stock_w gxg_gtk_menu_tool_button_new_from_stock
-#define gxg_gtk_menu_tool_button_set_menu_w gxg_gtk_menu_tool_button_set_menu
-#define gxg_gtk_menu_tool_button_get_menu_w gxg_gtk_menu_tool_button_get_menu
-#define gxg_gdk_display_supports_clipboard_persistence_w gxg_gdk_display_supports_clipboard_persistence
-#define gxg_gtk_about_dialog_get_logo_icon_name_w gxg_gtk_about_dialog_get_logo_icon_name
-#define gxg_gtk_about_dialog_set_logo_icon_name_w gxg_gtk_about_dialog_set_logo_icon_name
-#define gxg_gtk_accelerator_get_label_w gxg_gtk_accelerator_get_label
-#define gxg_gtk_clipboard_wait_is_target_available_w gxg_gtk_clipboard_wait_is_target_available
-#define gxg_gtk_clipboard_set_can_store_w gxg_gtk_clipboard_set_can_store
-#define gxg_gtk_clipboard_store_w gxg_gtk_clipboard_store
-#define gxg_gtk_alternative_dialog_button_order_w gxg_gtk_alternative_dialog_button_order
-#define gxg_gtk_drag_dest_add_image_targets_w gxg_gtk_drag_dest_add_image_targets
-#define gxg_gtk_drag_dest_add_uri_targets_w gxg_gtk_drag_dest_add_uri_targets
-#define gxg_gtk_drag_source_add_image_targets_w gxg_gtk_drag_source_add_image_targets
-#define gxg_gtk_drag_source_add_uri_targets_w gxg_gtk_drag_source_add_uri_targets
-#define gxg_gtk_file_chooser_button_get_width_chars_w gxg_gtk_file_chooser_button_get_width_chars
-#define gxg_gtk_file_chooser_button_set_width_chars_w gxg_gtk_file_chooser_button_set_width_chars
-#define gxg_gtk_image_new_from_icon_name_w gxg_gtk_image_new_from_icon_name
-#define gxg_gtk_image_set_from_icon_name_w gxg_gtk_image_set_from_icon_name
-#define gxg_gtk_image_set_pixel_size_w gxg_gtk_image_set_pixel_size
-#define gxg_gtk_image_get_pixel_size_w gxg_gtk_image_get_pixel_size
-#define gxg_gtk_label_set_width_chars_w gxg_gtk_label_set_width_chars
-#define gxg_gtk_label_get_width_chars_w gxg_gtk_label_get_width_chars
-#define gxg_gtk_target_list_add_text_targets_w gxg_gtk_target_list_add_text_targets
-#define gxg_gtk_target_list_add_image_targets_w gxg_gtk_target_list_add_image_targets
-#define gxg_gtk_target_list_add_uri_targets_w gxg_gtk_target_list_add_uri_targets
-#define gxg_gtk_selection_data_set_pixbuf_w gxg_gtk_selection_data_set_pixbuf
-#define gxg_gtk_selection_data_get_pixbuf_w gxg_gtk_selection_data_get_pixbuf
-#define gxg_gtk_selection_data_set_uris_w gxg_gtk_selection_data_set_uris
-#define gxg_gtk_selection_data_get_uris_w gxg_gtk_selection_data_get_uris
-#define gxg_gtk_text_buffer_backspace_w gxg_gtk_text_buffer_backspace
-#define gxg_gtk_clipboard_set_image_w gxg_gtk_clipboard_set_image
-#define gxg_gtk_clipboard_request_image_w gxg_gtk_clipboard_request_image
-#define gxg_gtk_clipboard_wait_for_image_w gxg_gtk_clipboard_wait_for_image
-#define gxg_gtk_clipboard_wait_is_image_available_w gxg_gtk_clipboard_wait_is_image_available
-#define gxg_gtk_file_filter_add_pixbuf_formats_w gxg_gtk_file_filter_add_pixbuf_formats
-#define gxg_gtk_label_set_single_line_mode_w gxg_gtk_label_set_single_line_mode
-#define gxg_gtk_label_get_single_line_mode_w gxg_gtk_label_get_single_line_mode
-#define gxg_gtk_progress_bar_set_ellipsize_w gxg_gtk_progress_bar_set_ellipsize
-#define gxg_gtk_progress_bar_get_ellipsize_w gxg_gtk_progress_bar_get_ellipsize
-#define gxg_gtk_selection_data_targets_include_image_w gxg_gtk_selection_data_targets_include_image
-#define gxg_gtk_button_set_image_w gxg_gtk_button_set_image
-#define gxg_gtk_button_get_image_w gxg_gtk_button_get_image
-#define gxg_gtk_dialog_set_alternative_button_order_from_array_w gxg_gtk_dialog_set_alternative_button_order_from_array
-#define gxg_gtk_label_set_angle_w gxg_gtk_label_set_angle
-#define gxg_gtk_label_get_angle_w gxg_gtk_label_get_angle
-#define gxg_gtk_menu_set_screen_w gxg_gtk_menu_set_screen
-#define gxg_pango_attr_underline_color_new_w gxg_pango_attr_underline_color_new
-#define gxg_pango_attr_strikethrough_color_new_w gxg_pango_attr_strikethrough_color_new
-#define gxg_pango_renderer_draw_layout_w gxg_pango_renderer_draw_layout
-#define gxg_pango_renderer_draw_layout_line_w gxg_pango_renderer_draw_layout_line
-#define gxg_pango_renderer_draw_glyphs_w gxg_pango_renderer_draw_glyphs
-#define gxg_pango_renderer_draw_rectangle_w gxg_pango_renderer_draw_rectangle
-#define gxg_pango_renderer_draw_error_underline_w gxg_pango_renderer_draw_error_underline
-#define gxg_pango_renderer_draw_trapezoid_w gxg_pango_renderer_draw_trapezoid
-#define gxg_pango_renderer_draw_glyph_w gxg_pango_renderer_draw_glyph
-#define gxg_pango_renderer_activate_w gxg_pango_renderer_activate
-#define gxg_pango_renderer_deactivate_w gxg_pango_renderer_deactivate
-#define gxg_pango_renderer_part_changed_w gxg_pango_renderer_part_changed
-#define gxg_pango_renderer_set_color_w gxg_pango_renderer_set_color
-#define gxg_pango_renderer_get_color_w gxg_pango_renderer_get_color
-#define gxg_pango_renderer_set_matrix_w gxg_pango_renderer_set_matrix
-#define gxg_g_log_set_handler_w gxg_g_log_set_handler
-#define gxg_g_log_remove_handler_w gxg_g_log_remove_handler
-#define gxg_gtk_cell_renderer_stop_editing_w gxg_gtk_cell_renderer_stop_editing
-#define gxg_gtk_file_chooser_button_new_w gxg_gtk_file_chooser_button_new
-#define gxg_gtk_icon_view_set_columns_w gxg_gtk_icon_view_set_columns
-#define gxg_gtk_icon_view_get_columns_w gxg_gtk_icon_view_get_columns
-#define gxg_gtk_icon_view_set_item_width_w gxg_gtk_icon_view_set_item_width
-#define gxg_gtk_icon_view_get_item_width_w gxg_gtk_icon_view_get_item_width
-#define gxg_gtk_icon_view_set_spacing_w gxg_gtk_icon_view_set_spacing
-#define gxg_gtk_icon_view_get_spacing_w gxg_gtk_icon_view_get_spacing
-#define gxg_gtk_icon_view_set_row_spacing_w gxg_gtk_icon_view_set_row_spacing
-#define gxg_gtk_icon_view_get_row_spacing_w gxg_gtk_icon_view_get_row_spacing
-#define gxg_gtk_icon_view_set_column_spacing_w gxg_gtk_icon_view_set_column_spacing
-#define gxg_gtk_icon_view_get_column_spacing_w gxg_gtk_icon_view_get_column_spacing
-#define gxg_gtk_icon_view_set_margin_w gxg_gtk_icon_view_set_margin
-#define gxg_gtk_icon_view_get_margin_w gxg_gtk_icon_view_get_margin
-#define gxg_gtk_label_set_max_width_chars_w gxg_gtk_label_set_max_width_chars
-#define gxg_gtk_label_get_max_width_chars_w gxg_gtk_label_get_max_width_chars
-#define gxg_gtk_list_store_insert_with_values_w gxg_gtk_list_store_insert_with_values
-#define gxg_gtk_list_store_insert_with_valuesv_w gxg_gtk_list_store_insert_with_valuesv
-#define gxg_gtk_text_view_get_iter_at_position_w gxg_gtk_text_view_get_iter_at_position
-#define gxg_pango_attr_size_new_absolute_w gxg_pango_attr_size_new_absolute
-#define gxg_pango_font_description_set_absolute_size_w gxg_pango_font_description_set_absolute_size
-#define gxg_pango_layout_get_font_description_w gxg_pango_layout_get_font_description
-#define gxg_gdk_cursor_new_from_name_w gxg_gdk_cursor_new_from_name
-#define gxg_gdk_cursor_get_image_w gxg_gdk_cursor_get_image
-#define gxg_gdk_screen_get_rgba_visual_w gxg_gdk_screen_get_rgba_visual
-#define gxg_gdk_window_set_urgency_hint_w gxg_gdk_window_set_urgency_hint
-#define gxg_gtk_action_get_accel_closure_w gxg_gtk_action_get_accel_closure
-#define gxg_gtk_dialog_get_response_for_widget_w gxg_gtk_dialog_get_response_for_widget
-#define gxg_gtk_drag_source_set_icon_name_w gxg_gtk_drag_source_set_icon_name
-#define gxg_gtk_drag_set_icon_name_w gxg_gtk_drag_set_icon_name
-#define gxg_gtk_entry_completion_set_popup_set_width_w gxg_gtk_entry_completion_set_popup_set_width
-#define gxg_gtk_entry_completion_get_popup_set_width_w gxg_gtk_entry_completion_get_popup_set_width
-#define gxg_gtk_entry_completion_set_popup_single_match_w gxg_gtk_entry_completion_set_popup_single_match
-#define gxg_gtk_entry_completion_get_popup_single_match_w gxg_gtk_entry_completion_get_popup_single_match
-#define gxg_gtk_icon_view_get_item_at_pos_w gxg_gtk_icon_view_get_item_at_pos
-#define gxg_gtk_icon_view_get_visible_range_w gxg_gtk_icon_view_get_visible_range
-#define gxg_gtk_icon_view_set_cursor_w gxg_gtk_icon_view_set_cursor
-#define gxg_gtk_icon_view_get_cursor_w gxg_gtk_icon_view_get_cursor
-#define gxg_gtk_icon_view_scroll_to_path_w gxg_gtk_icon_view_scroll_to_path
-#define gxg_gtk_icon_view_enable_model_drag_source_w gxg_gtk_icon_view_enable_model_drag_source
-#define gxg_gtk_icon_view_enable_model_drag_dest_w gxg_gtk_icon_view_enable_model_drag_dest
-#define gxg_gtk_icon_view_unset_model_drag_source_w gxg_gtk_icon_view_unset_model_drag_source
-#define gxg_gtk_icon_view_unset_model_drag_dest_w gxg_gtk_icon_view_unset_model_drag_dest
-#define gxg_gtk_icon_view_set_reorderable_w gxg_gtk_icon_view_set_reorderable
-#define gxg_gtk_icon_view_get_reorderable_w gxg_gtk_icon_view_get_reorderable
-#define gxg_gtk_icon_view_set_drag_dest_item_w gxg_gtk_icon_view_set_drag_dest_item
-#define gxg_gtk_icon_view_get_drag_dest_item_w gxg_gtk_icon_view_get_drag_dest_item
-#define gxg_gtk_icon_view_get_dest_item_at_pos_w gxg_gtk_icon_view_get_dest_item_at_pos
-#define gxg_gtk_image_clear_w gxg_gtk_image_clear
-#define gxg_gtk_menu_bar_get_pack_direction_w gxg_gtk_menu_bar_get_pack_direction
-#define gxg_gtk_menu_bar_set_pack_direction_w gxg_gtk_menu_bar_set_pack_direction
-#define gxg_gtk_menu_bar_get_child_pack_direction_w gxg_gtk_menu_bar_get_child_pack_direction
-#define gxg_gtk_menu_bar_set_child_pack_direction_w gxg_gtk_menu_bar_set_child_pack_direction
-#define gxg_gtk_menu_shell_get_take_focus_w gxg_gtk_menu_shell_get_take_focus
-#define gxg_gtk_menu_shell_set_take_focus_w gxg_gtk_menu_shell_set_take_focus
-#define gxg_gtk_scrolled_window_get_hscrollbar_w gxg_gtk_scrolled_window_get_hscrollbar
-#define gxg_gtk_scrolled_window_get_vscrollbar_w gxg_gtk_scrolled_window_get_vscrollbar
-#define gxg_gtk_size_group_set_ignore_hidden_w gxg_gtk_size_group_set_ignore_hidden
-#define gxg_gtk_size_group_get_ignore_hidden_w gxg_gtk_size_group_get_ignore_hidden
-#define gxg_gtk_text_iter_forward_visible_line_w gxg_gtk_text_iter_forward_visible_line
-#define gxg_gtk_text_iter_backward_visible_line_w gxg_gtk_text_iter_backward_visible_line
-#define gxg_gtk_text_iter_forward_visible_lines_w gxg_gtk_text_iter_forward_visible_lines
-#define gxg_gtk_text_iter_backward_visible_lines_w gxg_gtk_text_iter_backward_visible_lines
-#define gxg_gtk_tool_button_set_icon_name_w gxg_gtk_tool_button_set_icon_name
-#define gxg_gtk_tool_button_get_icon_name_w gxg_gtk_tool_button_get_icon_name
-#define gxg_gtk_window_set_urgency_hint_w gxg_gtk_window_set_urgency_hint
-#define gxg_gtk_window_get_urgency_hint_w gxg_gtk_window_get_urgency_hint
-#define gxg_gtk_window_present_with_time_w gxg_gtk_window_present_with_time
-#define gxg_gtk_about_dialog_get_wrap_license_w gxg_gtk_about_dialog_get_wrap_license
-#define gxg_gtk_about_dialog_set_wrap_license_w gxg_gtk_about_dialog_set_wrap_license
-#define gxg_gtk_file_chooser_set_do_overwrite_confirmation_w gxg_gtk_file_chooser_set_do_overwrite_confirmation
-#define gxg_gtk_file_chooser_get_do_overwrite_confirmation_w gxg_gtk_file_chooser_get_do_overwrite_confirmation
-#define gxg_gtk_tree_row_reference_get_model_w gxg_gtk_tree_row_reference_get_model
-#define gxg_gtk_tree_view_column_queue_resize_w gxg_gtk_tree_view_column_queue_resize
-#define gxg_gtk_tree_view_get_visible_range_w gxg_gtk_tree_view_get_visible_range
-#define gxg_gtk_text_attributes_ref_w gxg_gtk_text_attributes_ref
-#define gxg_pango_attr_list_ref_w gxg_pango_attr_list_ref
-#define gxg_pango_layout_line_ref_w gxg_pango_layout_line_ref
-#define gxg_pango_layout_index_to_line_x_w gxg_pango_layout_index_to_line_x
-#define gxg_gtk_target_list_ref_w gxg_gtk_target_list_ref
-#define gxg_gdk_display_supports_shapes_w gxg_gdk_display_supports_shapes
-#define gxg_gdk_display_supports_input_shapes_w gxg_gdk_display_supports_input_shapes
-#define gxg_gdk_screen_is_composited_w gxg_gdk_screen_is_composited
-#define gxg_gdk_screen_set_resolution_w gxg_gdk_screen_set_resolution
-#define gxg_gdk_screen_get_resolution_w gxg_gdk_screen_get_resolution
-#define gxg_gdk_screen_get_active_window_w gxg_gdk_screen_get_active_window
-#define gxg_gdk_screen_get_window_stack_w gxg_gdk_screen_get_window_stack
-#define gxg_gdk_window_get_type_hint_w gxg_gdk_window_get_type_hint
-#define gxg_gtk_clipboard_request_rich_text_w gxg_gtk_clipboard_request_rich_text
-#define gxg_gtk_clipboard_wait_for_rich_text_w gxg_gtk_clipboard_wait_for_rich_text
-#define gxg_gtk_clipboard_wait_is_rich_text_available_w gxg_gtk_clipboard_wait_is_rich_text_available
-#define gxg_gtk_combo_box_get_title_w gxg_gtk_combo_box_get_title
-#define gxg_gtk_combo_box_set_title_w gxg_gtk_combo_box_set_title
-#define gxg_gtk_drag_dest_set_track_motion_w gxg_gtk_drag_dest_set_track_motion
-#define gxg_gtk_drag_dest_get_track_motion_w gxg_gtk_drag_dest_get_track_motion
-#define gxg_gtk_file_chooser_button_get_focus_on_click_w gxg_gtk_file_chooser_button_get_focus_on_click
-#define gxg_gtk_file_chooser_button_set_focus_on_click_w gxg_gtk_file_chooser_button_set_focus_on_click
-#define gxg_gtk_notebook_get_tab_reorderable_w gxg_gtk_notebook_get_tab_reorderable
-#define gxg_gtk_notebook_set_tab_reorderable_w gxg_gtk_notebook_set_tab_reorderable
-#define gxg_gtk_notebook_get_tab_detachable_w gxg_gtk_notebook_get_tab_detachable
-#define gxg_gtk_notebook_set_tab_detachable_w gxg_gtk_notebook_set_tab_detachable
-#define gxg_gtk_radio_action_set_current_value_w gxg_gtk_radio_action_set_current_value
-#define gxg_gtk_range_set_lower_stepper_sensitivity_w gxg_gtk_range_set_lower_stepper_sensitivity
-#define gxg_gtk_range_get_lower_stepper_sensitivity_w gxg_gtk_range_get_lower_stepper_sensitivity
-#define gxg_gtk_range_set_upper_stepper_sensitivity_w gxg_gtk_range_set_upper_stepper_sensitivity
-#define gxg_gtk_range_get_upper_stepper_sensitivity_w gxg_gtk_range_get_upper_stepper_sensitivity
-#define gxg_gtk_scrolled_window_unset_placement_w gxg_gtk_scrolled_window_unset_placement
-#define gxg_gtk_target_list_add_rich_text_targets_w gxg_gtk_target_list_add_rich_text_targets
-#define gxg_gtk_target_table_new_from_list_w gxg_gtk_target_table_new_from_list
-#define gxg_gtk_target_table_free_w gxg_gtk_target_table_free
-#define gxg_gtk_selection_data_targets_include_rich_text_w gxg_gtk_selection_data_targets_include_rich_text
-#define gxg_gtk_selection_data_targets_include_uri_w gxg_gtk_selection_data_targets_include_uri
-#define gxg_gtk_targets_include_text_w gxg_gtk_targets_include_text
-#define gxg_gtk_targets_include_rich_text_w gxg_gtk_targets_include_rich_text
-#define gxg_gtk_targets_include_image_w gxg_gtk_targets_include_image
-#define gxg_gtk_targets_include_uri_w gxg_gtk_targets_include_uri
-#define gxg_gtk_size_group_get_widgets_w gxg_gtk_size_group_get_widgets
-#define gxg_gtk_text_buffer_get_has_selection_w gxg_gtk_text_buffer_get_has_selection
-#define gxg_gtk_text_buffer_get_copy_target_list_w gxg_gtk_text_buffer_get_copy_target_list
-#define gxg_gtk_text_buffer_get_paste_target_list_w gxg_gtk_text_buffer_get_paste_target_list
-#define gxg_gtk_tree_view_get_headers_clickable_w gxg_gtk_tree_view_get_headers_clickable
-#define gxg_gtk_tree_view_get_search_entry_w gxg_gtk_tree_view_get_search_entry
-#define gxg_gtk_tree_view_set_search_entry_w gxg_gtk_tree_view_set_search_entry
-#define gxg_gtk_tree_view_get_search_position_func_w gxg_gtk_tree_view_get_search_position_func
-#define gxg_gtk_tree_view_set_search_position_func_w gxg_gtk_tree_view_set_search_position_func
-#define gxg_gtk_widget_is_composited_w gxg_gtk_widget_is_composited
-#define gxg_gtk_window_set_deletable_w gxg_gtk_window_set_deletable
-#define gxg_gtk_window_get_deletable_w gxg_gtk_window_get_deletable
-#define gxg_gtk_assistant_new_w gxg_gtk_assistant_new
-#define gxg_gtk_assistant_get_current_page_w gxg_gtk_assistant_get_current_page
-#define gxg_gtk_assistant_set_current_page_w gxg_gtk_assistant_set_current_page
-#define gxg_gtk_assistant_get_n_pages_w gxg_gtk_assistant_get_n_pages
-#define gxg_gtk_assistant_get_nth_page_w gxg_gtk_assistant_get_nth_page
-#define gxg_gtk_assistant_prepend_page_w gxg_gtk_assistant_prepend_page
-#define gxg_gtk_assistant_append_page_w gxg_gtk_assistant_append_page
-#define gxg_gtk_assistant_insert_page_w gxg_gtk_assistant_insert_page
-#define gxg_gtk_assistant_set_forward_page_func_w gxg_gtk_assistant_set_forward_page_func
-#define gxg_gtk_assistant_set_page_type_w gxg_gtk_assistant_set_page_type
-#define gxg_gtk_assistant_get_page_type_w gxg_gtk_assistant_get_page_type
-#define gxg_gtk_assistant_set_page_title_w gxg_gtk_assistant_set_page_title
-#define gxg_gtk_assistant_get_page_title_w gxg_gtk_assistant_get_page_title
-#define gxg_gtk_assistant_set_page_header_image_w gxg_gtk_assistant_set_page_header_image
-#define gxg_gtk_assistant_get_page_header_image_w gxg_gtk_assistant_get_page_header_image
-#define gxg_gtk_assistant_set_page_side_image_w gxg_gtk_assistant_set_page_side_image
-#define gxg_gtk_assistant_get_page_side_image_w gxg_gtk_assistant_get_page_side_image
-#define gxg_gtk_assistant_set_page_complete_w gxg_gtk_assistant_set_page_complete
-#define gxg_gtk_assistant_get_page_complete_w gxg_gtk_assistant_get_page_complete
-#define gxg_gtk_assistant_add_action_widget_w gxg_gtk_assistant_add_action_widget
-#define gxg_gtk_assistant_remove_action_widget_w gxg_gtk_assistant_remove_action_widget
-#define gxg_gtk_assistant_update_buttons_state_w gxg_gtk_assistant_update_buttons_state
-#define gxg_gtk_cell_renderer_accel_new_w gxg_gtk_cell_renderer_accel_new
-#define gxg_gtk_cell_renderer_spin_new_w gxg_gtk_cell_renderer_spin_new
-#define gxg_gtk_link_button_new_w gxg_gtk_link_button_new
-#define gxg_gtk_link_button_new_with_label_w gxg_gtk_link_button_new_with_label
-#define gxg_gtk_link_button_get_uri_w gxg_gtk_link_button_get_uri
-#define gxg_gtk_link_button_set_uri_w gxg_gtk_link_button_set_uri
-#define gxg_gtk_recent_chooser_error_quark_w gxg_gtk_recent_chooser_error_quark
-#define gxg_gtk_recent_chooser_set_show_private_w gxg_gtk_recent_chooser_set_show_private
-#define gxg_gtk_recent_chooser_get_show_private_w gxg_gtk_recent_chooser_get_show_private
-#define gxg_gtk_recent_chooser_set_show_not_found_w gxg_gtk_recent_chooser_set_show_not_found
-#define gxg_gtk_recent_chooser_get_show_not_found_w gxg_gtk_recent_chooser_get_show_not_found
-#define gxg_gtk_recent_chooser_set_select_multiple_w gxg_gtk_recent_chooser_set_select_multiple
-#define gxg_gtk_recent_chooser_get_select_multiple_w gxg_gtk_recent_chooser_get_select_multiple
-#define gxg_gtk_recent_chooser_set_limit_w gxg_gtk_recent_chooser_set_limit
-#define gxg_gtk_recent_chooser_get_limit_w gxg_gtk_recent_chooser_get_limit
-#define gxg_gtk_recent_chooser_set_local_only_w gxg_gtk_recent_chooser_set_local_only
-#define gxg_gtk_recent_chooser_get_local_only_w gxg_gtk_recent_chooser_get_local_only
-#define gxg_gtk_recent_chooser_set_show_tips_w gxg_gtk_recent_chooser_set_show_tips
-#define gxg_gtk_recent_chooser_get_show_tips_w gxg_gtk_recent_chooser_get_show_tips
-#define gxg_gtk_recent_chooser_set_show_icons_w gxg_gtk_recent_chooser_set_show_icons
-#define gxg_gtk_recent_chooser_get_show_icons_w gxg_gtk_recent_chooser_get_show_icons
-#define gxg_gtk_recent_chooser_set_sort_type_w gxg_gtk_recent_chooser_set_sort_type
-#define gxg_gtk_recent_chooser_get_sort_type_w gxg_gtk_recent_chooser_get_sort_type
-#define gxg_gtk_recent_chooser_set_sort_func_w gxg_gtk_recent_chooser_set_sort_func
-#define gxg_gtk_recent_chooser_set_current_uri_w gxg_gtk_recent_chooser_set_current_uri
-#define gxg_gtk_recent_chooser_get_current_uri_w gxg_gtk_recent_chooser_get_current_uri
-#define gxg_gtk_recent_chooser_get_current_item_w gxg_gtk_recent_chooser_get_current_item
-#define gxg_gtk_recent_chooser_select_uri_w gxg_gtk_recent_chooser_select_uri
-#define gxg_gtk_recent_chooser_unselect_uri_w gxg_gtk_recent_chooser_unselect_uri
-#define gxg_gtk_recent_chooser_select_all_w gxg_gtk_recent_chooser_select_all
-#define gxg_gtk_recent_chooser_unselect_all_w gxg_gtk_recent_chooser_unselect_all
-#define gxg_gtk_recent_chooser_get_items_w gxg_gtk_recent_chooser_get_items
-#define gxg_gtk_recent_chooser_get_uris_w gxg_gtk_recent_chooser_get_uris
-#define gxg_gtk_recent_chooser_add_filter_w gxg_gtk_recent_chooser_add_filter
-#define gxg_gtk_recent_chooser_remove_filter_w gxg_gtk_recent_chooser_remove_filter
-#define gxg_gtk_recent_chooser_list_filters_w gxg_gtk_recent_chooser_list_filters
-#define gxg_gtk_recent_chooser_set_filter_w gxg_gtk_recent_chooser_set_filter
-#define gxg_gtk_recent_chooser_get_filter_w gxg_gtk_recent_chooser_get_filter
-#define gxg_gtk_recent_chooser_menu_new_w gxg_gtk_recent_chooser_menu_new
-#define gxg_gtk_recent_chooser_menu_new_for_manager_w gxg_gtk_recent_chooser_menu_new_for_manager
-#define gxg_gtk_recent_chooser_menu_get_show_numbers_w gxg_gtk_recent_chooser_menu_get_show_numbers
-#define gxg_gtk_recent_chooser_menu_set_show_numbers_w gxg_gtk_recent_chooser_menu_set_show_numbers
-#define gxg_gtk_recent_chooser_widget_new_w gxg_gtk_recent_chooser_widget_new
-#define gxg_gtk_recent_chooser_widget_new_for_manager_w gxg_gtk_recent_chooser_widget_new_for_manager
-#define gxg_gtk_recent_filter_new_w gxg_gtk_recent_filter_new
-#define gxg_gtk_recent_filter_set_name_w gxg_gtk_recent_filter_set_name
-#define gxg_gtk_recent_filter_get_name_w gxg_gtk_recent_filter_get_name
-#define gxg_gtk_recent_filter_add_mime_type_w gxg_gtk_recent_filter_add_mime_type
-#define gxg_gtk_recent_filter_add_pattern_w gxg_gtk_recent_filter_add_pattern
-#define gxg_gtk_recent_filter_add_pixbuf_formats_w gxg_gtk_recent_filter_add_pixbuf_formats
-#define gxg_gtk_recent_filter_add_application_w gxg_gtk_recent_filter_add_application
-#define gxg_gtk_recent_filter_add_group_w gxg_gtk_recent_filter_add_group
-#define gxg_gtk_recent_filter_add_age_w gxg_gtk_recent_filter_add_age
-#define gxg_gtk_recent_filter_add_custom_w gxg_gtk_recent_filter_add_custom
-#define gxg_gtk_recent_filter_get_needed_w gxg_gtk_recent_filter_get_needed
-#define gxg_gtk_recent_filter_filter_w gxg_gtk_recent_filter_filter
-#define gxg_gtk_recent_manager_error_quark_w gxg_gtk_recent_manager_error_quark
-#define gxg_gtk_recent_manager_new_w gxg_gtk_recent_manager_new
-#define gxg_gtk_recent_manager_get_default_w gxg_gtk_recent_manager_get_default
-#define gxg_gtk_recent_manager_remove_item_w gxg_gtk_recent_manager_remove_item
-#define gxg_gtk_recent_manager_lookup_item_w gxg_gtk_recent_manager_lookup_item
-#define gxg_gtk_recent_manager_has_item_w gxg_gtk_recent_manager_has_item
-#define gxg_gtk_recent_manager_move_item_w gxg_gtk_recent_manager_move_item
-#define gxg_gtk_recent_manager_get_items_w gxg_gtk_recent_manager_get_items
-#define gxg_gtk_recent_manager_purge_items_w gxg_gtk_recent_manager_purge_items
-#define gxg_gtk_recent_info_ref_w gxg_gtk_recent_info_ref
-#define gxg_gtk_recent_info_unref_w gxg_gtk_recent_info_unref
-#define gxg_gtk_recent_info_get_uri_w gxg_gtk_recent_info_get_uri
-#define gxg_gtk_recent_info_get_display_name_w gxg_gtk_recent_info_get_display_name
-#define gxg_gtk_recent_info_get_description_w gxg_gtk_recent_info_get_description
-#define gxg_gtk_recent_info_get_mime_type_w gxg_gtk_recent_info_get_mime_type
-#define gxg_gtk_recent_info_get_added_w gxg_gtk_recent_info_get_added
-#define gxg_gtk_recent_info_get_modified_w gxg_gtk_recent_info_get_modified
-#define gxg_gtk_recent_info_get_visited_w gxg_gtk_recent_info_get_visited
-#define gxg_gtk_recent_info_get_private_hint_w gxg_gtk_recent_info_get_private_hint
-#define gxg_gtk_recent_info_get_applications_w gxg_gtk_recent_info_get_applications
-#define gxg_gtk_recent_info_last_application_w gxg_gtk_recent_info_last_application
-#define gxg_gtk_recent_info_has_application_w gxg_gtk_recent_info_has_application
-#define gxg_gtk_recent_info_get_groups_w gxg_gtk_recent_info_get_groups
-#define gxg_gtk_recent_info_has_group_w gxg_gtk_recent_info_has_group
-#define gxg_gtk_recent_info_get_icon_w gxg_gtk_recent_info_get_icon
-#define gxg_gtk_recent_info_get_short_name_w gxg_gtk_recent_info_get_short_name
-#define gxg_gtk_recent_info_get_uri_display_w gxg_gtk_recent_info_get_uri_display
-#define gxg_gtk_recent_info_get_age_w gxg_gtk_recent_info_get_age
-#define gxg_gtk_recent_info_is_local_w gxg_gtk_recent_info_is_local
-#define gxg_gtk_recent_info_exists_w gxg_gtk_recent_info_exists
-#define gxg_gtk_recent_info_match_w gxg_gtk_recent_info_match
-#define gxg_gtk_status_icon_new_w gxg_gtk_status_icon_new
-#define gxg_gtk_status_icon_new_from_pixbuf_w gxg_gtk_status_icon_new_from_pixbuf
-#define gxg_gtk_status_icon_new_from_file_w gxg_gtk_status_icon_new_from_file
-#define gxg_gtk_status_icon_new_from_stock_w gxg_gtk_status_icon_new_from_stock
-#define gxg_gtk_status_icon_new_from_icon_name_w gxg_gtk_status_icon_new_from_icon_name
-#define gxg_gtk_status_icon_set_from_pixbuf_w gxg_gtk_status_icon_set_from_pixbuf
-#define gxg_gtk_status_icon_set_from_file_w gxg_gtk_status_icon_set_from_file
-#define gxg_gtk_status_icon_set_from_stock_w gxg_gtk_status_icon_set_from_stock
-#define gxg_gtk_status_icon_set_from_icon_name_w gxg_gtk_status_icon_set_from_icon_name
-#define gxg_gtk_status_icon_get_storage_type_w gxg_gtk_status_icon_get_storage_type
-#define gxg_gtk_status_icon_get_pixbuf_w gxg_gtk_status_icon_get_pixbuf
-#define gxg_gtk_status_icon_get_stock_w gxg_gtk_status_icon_get_stock
-#define gxg_gtk_status_icon_get_icon_name_w gxg_gtk_status_icon_get_icon_name
-#define gxg_gtk_status_icon_get_size_w gxg_gtk_status_icon_get_size
-#define gxg_gtk_status_icon_set_visible_w gxg_gtk_status_icon_set_visible
-#define gxg_gtk_status_icon_get_visible_w gxg_gtk_status_icon_get_visible
-#define gxg_gtk_status_icon_is_embedded_w gxg_gtk_status_icon_is_embedded
-#define gxg_gtk_status_icon_position_menu_w gxg_gtk_status_icon_position_menu
-#define gxg_gtk_text_buffer_register_serialize_format_w gxg_gtk_text_buffer_register_serialize_format
-#define gxg_gtk_text_buffer_register_serialize_tagset_w gxg_gtk_text_buffer_register_serialize_tagset
-#define gxg_gtk_text_buffer_register_deserialize_format_w gxg_gtk_text_buffer_register_deserialize_format
-#define gxg_gtk_text_buffer_register_deserialize_tagset_w gxg_gtk_text_buffer_register_deserialize_tagset
-#define gxg_gtk_text_buffer_unregister_serialize_format_w gxg_gtk_text_buffer_unregister_serialize_format
-#define gxg_gtk_text_buffer_unregister_deserialize_format_w gxg_gtk_text_buffer_unregister_deserialize_format
-#define gxg_gtk_text_buffer_deserialize_set_can_create_tags_w gxg_gtk_text_buffer_deserialize_set_can_create_tags
-#define gxg_gtk_text_buffer_deserialize_get_can_create_tags_w gxg_gtk_text_buffer_deserialize_get_can_create_tags
-#define gxg_gtk_text_buffer_get_serialize_formats_w gxg_gtk_text_buffer_get_serialize_formats
-#define gxg_gtk_text_buffer_get_deserialize_formats_w gxg_gtk_text_buffer_get_deserialize_formats
-#define gxg_gtk_text_buffer_serialize_w gxg_gtk_text_buffer_serialize
-#define gxg_gtk_text_buffer_deserialize_w gxg_gtk_text_buffer_deserialize
-#define gxg_gtk_recent_manager_add_item_w gxg_gtk_recent_manager_add_item
-#define gxg_gtk_recent_manager_add_full_w gxg_gtk_recent_manager_add_full
-#define gxg_gtk_tree_model_filter_convert_child_iter_to_iter_w gxg_gtk_tree_model_filter_convert_child_iter_to_iter
-#define gxg_gtk_tree_view_get_grid_lines_w gxg_gtk_tree_view_get_grid_lines
-#define gxg_gtk_tree_view_set_grid_lines_w gxg_gtk_tree_view_set_grid_lines
-#define gxg_gtk_tree_view_get_enable_tree_lines_w gxg_gtk_tree_view_get_enable_tree_lines
-#define gxg_gtk_tree_view_set_enable_tree_lines_w gxg_gtk_tree_view_set_enable_tree_lines
-#define gxg_gtk_label_set_line_wrap_mode_w gxg_gtk_label_set_line_wrap_mode
-#define gxg_gtk_label_get_line_wrap_mode_w gxg_gtk_label_get_line_wrap_mode
-#define gxg_gtk_print_context_get_cairo_context_w gxg_gtk_print_context_get_cairo_context
-#define gxg_gtk_print_context_get_page_setup_w gxg_gtk_print_context_get_page_setup
-#define gxg_gtk_print_context_get_width_w gxg_gtk_print_context_get_width
-#define gxg_gtk_print_context_get_height_w gxg_gtk_print_context_get_height
-#define gxg_gtk_print_context_get_dpi_x_w gxg_gtk_print_context_get_dpi_x
-#define gxg_gtk_print_context_get_dpi_y_w gxg_gtk_print_context_get_dpi_y
-#define gxg_gtk_print_context_create_pango_context_w gxg_gtk_print_context_create_pango_context
-#define gxg_gtk_print_context_create_pango_layout_w gxg_gtk_print_context_create_pango_layout
-#define gxg_gtk_print_context_set_cairo_context_w gxg_gtk_print_context_set_cairo_context
-#define gxg_gtk_print_operation_new_w gxg_gtk_print_operation_new
-#define gxg_gtk_print_operation_set_default_page_setup_w gxg_gtk_print_operation_set_default_page_setup
-#define gxg_gtk_print_operation_get_default_page_setup_w gxg_gtk_print_operation_get_default_page_setup
-#define gxg_gtk_print_operation_set_print_settings_w gxg_gtk_print_operation_set_print_settings
-#define gxg_gtk_print_operation_get_print_settings_w gxg_gtk_print_operation_get_print_settings
-#define gxg_gtk_print_operation_set_job_name_w gxg_gtk_print_operation_set_job_name
-#define gxg_gtk_print_operation_set_n_pages_w gxg_gtk_print_operation_set_n_pages
-#define gxg_gtk_print_operation_set_current_page_w gxg_gtk_print_operation_set_current_page
-#define gxg_gtk_print_operation_set_use_full_page_w gxg_gtk_print_operation_set_use_full_page
-#define gxg_gtk_print_operation_set_unit_w gxg_gtk_print_operation_set_unit
-#define gxg_gtk_print_operation_set_export_filename_w gxg_gtk_print_operation_set_export_filename
-#define gxg_gtk_print_operation_set_track_print_status_w gxg_gtk_print_operation_set_track_print_status
-#define gxg_gtk_print_operation_set_show_progress_w gxg_gtk_print_operation_set_show_progress
-#define gxg_gtk_print_operation_set_allow_async_w gxg_gtk_print_operation_set_allow_async
-#define gxg_gtk_print_operation_set_custom_tab_label_w gxg_gtk_print_operation_set_custom_tab_label
-#define gxg_gtk_print_operation_run_w gxg_gtk_print_operation_run
-#define gxg_gtk_print_operation_get_error_w gxg_gtk_print_operation_get_error
-#define gxg_gtk_print_operation_get_status_w gxg_gtk_print_operation_get_status
-#define gxg_gtk_print_operation_get_status_string_w gxg_gtk_print_operation_get_status_string
-#define gxg_gtk_print_operation_is_finished_w gxg_gtk_print_operation_is_finished
-#define gxg_gtk_print_operation_cancel_w gxg_gtk_print_operation_cancel
-#define gxg_gtk_print_run_page_setup_dialog_w gxg_gtk_print_run_page_setup_dialog
-#define gxg_gtk_print_run_page_setup_dialog_async_w gxg_gtk_print_run_page_setup_dialog_async
-#define gxg_gtk_print_operation_preview_render_page_w gxg_gtk_print_operation_preview_render_page
-#define gxg_gtk_print_operation_preview_end_preview_w gxg_gtk_print_operation_preview_end_preview
-#define gxg_gtk_print_operation_preview_is_selected_w gxg_gtk_print_operation_preview_is_selected
-#define gxg_gtk_print_settings_new_w gxg_gtk_print_settings_new
-#define gxg_gtk_print_settings_copy_w gxg_gtk_print_settings_copy
-#define gxg_gtk_print_settings_has_key_w gxg_gtk_print_settings_has_key
-#define gxg_gtk_print_settings_get_w gxg_gtk_print_settings_get
-#define gxg_gtk_print_settings_set_w gxg_gtk_print_settings_set
-#define gxg_gtk_print_settings_unset_w gxg_gtk_print_settings_unset
-#define gxg_gtk_print_settings_foreach_w gxg_gtk_print_settings_foreach
-#define gxg_gtk_print_settings_get_bool_w gxg_gtk_print_settings_get_bool
-#define gxg_gtk_print_settings_set_bool_w gxg_gtk_print_settings_set_bool
-#define gxg_gtk_print_settings_get_double_w gxg_gtk_print_settings_get_double
-#define gxg_gtk_print_settings_get_double_with_default_w gxg_gtk_print_settings_get_double_with_default
-#define gxg_gtk_print_settings_set_double_w gxg_gtk_print_settings_set_double
-#define gxg_gtk_print_settings_get_length_w gxg_gtk_print_settings_get_length
-#define gxg_gtk_print_settings_set_length_w gxg_gtk_print_settings_set_length
-#define gxg_gtk_print_settings_get_int_w gxg_gtk_print_settings_get_int
-#define gxg_gtk_print_settings_get_int_with_default_w gxg_gtk_print_settings_get_int_with_default
-#define gxg_gtk_print_settings_set_int_w gxg_gtk_print_settings_set_int
-#define gxg_gtk_print_settings_get_printer_w gxg_gtk_print_settings_get_printer
-#define gxg_gtk_print_settings_set_printer_w gxg_gtk_print_settings_set_printer
-#define gxg_gtk_print_settings_get_orientation_w gxg_gtk_print_settings_get_orientation
-#define gxg_gtk_print_settings_set_orientation_w gxg_gtk_print_settings_set_orientation
-#define gxg_gtk_print_settings_get_paper_size_w gxg_gtk_print_settings_get_paper_size
-#define gxg_gtk_print_settings_set_paper_size_w gxg_gtk_print_settings_set_paper_size
-#define gxg_gtk_print_settings_get_paper_width_w gxg_gtk_print_settings_get_paper_width
-#define gxg_gtk_print_settings_set_paper_width_w gxg_gtk_print_settings_set_paper_width
-#define gxg_gtk_print_settings_get_paper_height_w gxg_gtk_print_settings_get_paper_height
-#define gxg_gtk_print_settings_set_paper_height_w gxg_gtk_print_settings_set_paper_height
-#define gxg_gtk_print_settings_get_use_color_w gxg_gtk_print_settings_get_use_color
-#define gxg_gtk_print_settings_set_use_color_w gxg_gtk_print_settings_set_use_color
-#define gxg_gtk_print_settings_get_collate_w gxg_gtk_print_settings_get_collate
-#define gxg_gtk_print_settings_set_collate_w gxg_gtk_print_settings_set_collate
-#define gxg_gtk_print_settings_get_reverse_w gxg_gtk_print_settings_get_reverse
-#define gxg_gtk_print_settings_set_reverse_w gxg_gtk_print_settings_set_reverse
-#define gxg_gtk_print_settings_get_duplex_w gxg_gtk_print_settings_get_duplex
-#define gxg_gtk_print_settings_set_duplex_w gxg_gtk_print_settings_set_duplex
-#define gxg_gtk_print_settings_get_quality_w gxg_gtk_print_settings_get_quality
-#define gxg_gtk_print_settings_set_quality_w gxg_gtk_print_settings_set_quality
-#define gxg_gtk_print_settings_get_n_copies_w gxg_gtk_print_settings_get_n_copies
-#define gxg_gtk_print_settings_set_n_copies_w gxg_gtk_print_settings_set_n_copies
-#define gxg_gtk_print_settings_get_number_up_w gxg_gtk_print_settings_get_number_up
-#define gxg_gtk_print_settings_set_number_up_w gxg_gtk_print_settings_set_number_up
-#define gxg_gtk_print_settings_get_resolution_w gxg_gtk_print_settings_get_resolution
-#define gxg_gtk_print_settings_set_resolution_w gxg_gtk_print_settings_set_resolution
-#define gxg_gtk_print_settings_get_scale_w gxg_gtk_print_settings_get_scale
-#define gxg_gtk_print_settings_set_scale_w gxg_gtk_print_settings_set_scale
-#define gxg_gtk_print_settings_get_print_pages_w gxg_gtk_print_settings_get_print_pages
-#define gxg_gtk_print_settings_set_print_pages_w gxg_gtk_print_settings_set_print_pages
-#define gxg_gtk_print_settings_get_page_ranges_w gxg_gtk_print_settings_get_page_ranges
-#define gxg_gtk_print_settings_set_page_ranges_w gxg_gtk_print_settings_set_page_ranges
-#define gxg_gtk_print_settings_get_page_set_w gxg_gtk_print_settings_get_page_set
-#define gxg_gtk_print_settings_set_page_set_w gxg_gtk_print_settings_set_page_set
-#define gxg_gtk_print_settings_get_default_source_w gxg_gtk_print_settings_get_default_source
-#define gxg_gtk_print_settings_set_default_source_w gxg_gtk_print_settings_set_default_source
-#define gxg_gtk_print_settings_get_media_type_w gxg_gtk_print_settings_get_media_type
-#define gxg_gtk_print_settings_set_media_type_w gxg_gtk_print_settings_set_media_type
-#define gxg_gtk_print_settings_get_dither_w gxg_gtk_print_settings_get_dither
-#define gxg_gtk_print_settings_set_dither_w gxg_gtk_print_settings_set_dither
-#define gxg_gtk_print_settings_get_finishings_w gxg_gtk_print_settings_get_finishings
-#define gxg_gtk_print_settings_set_finishings_w gxg_gtk_print_settings_set_finishings
-#define gxg_gtk_print_settings_get_output_bin_w gxg_gtk_print_settings_get_output_bin
-#define gxg_gtk_print_settings_set_output_bin_w gxg_gtk_print_settings_set_output_bin
-#define gxg_gtk_settings_get_for_screen_w gxg_gtk_settings_get_for_screen
-#define gxg_pango_cairo_create_layout_w gxg_pango_cairo_create_layout
-#define gxg_pango_cairo_update_layout_w gxg_pango_cairo_update_layout
-#define gxg_pango_cairo_update_context_w gxg_pango_cairo_update_context
-#define gxg_pango_cairo_context_set_font_options_w gxg_pango_cairo_context_set_font_options
-#define gxg_pango_cairo_context_get_font_options_w gxg_pango_cairo_context_get_font_options
-#define gxg_pango_cairo_context_set_resolution_w gxg_pango_cairo_context_set_resolution
-#define gxg_pango_cairo_context_get_resolution_w gxg_pango_cairo_context_get_resolution
-#define gxg_pango_cairo_show_glyph_string_w gxg_pango_cairo_show_glyph_string
-#define gxg_pango_cairo_show_layout_line_w gxg_pango_cairo_show_layout_line
-#define gxg_pango_cairo_show_layout_w gxg_pango_cairo_show_layout
-#define gxg_pango_cairo_show_error_underline_w gxg_pango_cairo_show_error_underline
-#define gxg_pango_cairo_glyph_string_path_w gxg_pango_cairo_glyph_string_path
-#define gxg_pango_cairo_layout_line_path_w gxg_pango_cairo_layout_line_path
-#define gxg_pango_cairo_layout_path_w gxg_pango_cairo_layout_path
-#define gxg_pango_cairo_error_underline_path_w gxg_pango_cairo_error_underline_path
-#define gxg_gdk_cairo_set_source_color_w gxg_gdk_cairo_set_source_color
-#define gxg_gdk_cairo_set_source_pixbuf_w gxg_gdk_cairo_set_source_pixbuf
-#define gxg_gdk_cairo_rectangle_w gxg_gdk_cairo_rectangle
-#define gxg_gdk_color_to_string_w gxg_gdk_color_to_string
-#define gxg_gdk_event_request_motions_w gxg_gdk_event_request_motions
-#define gxg_gdk_notify_startup_complete_with_id_w gxg_gdk_notify_startup_complete_with_id
-#define gxg_gdk_threads_add_idle_full_w gxg_gdk_threads_add_idle_full
-#define gxg_gdk_threads_add_idle_w gxg_gdk_threads_add_idle
-#define gxg_gdk_threads_add_timeout_full_w gxg_gdk_threads_add_timeout_full
-#define gxg_gdk_threads_add_timeout_w gxg_gdk_threads_add_timeout
-#define gxg_gdk_window_set_startup_id_w gxg_gdk_window_set_startup_id
-#define gxg_gdk_window_beep_w gxg_gdk_window_beep
-#define gxg_gdk_window_set_opacity_w gxg_gdk_window_set_opacity
-#define gxg_gtk_action_create_menu_w gxg_gtk_action_create_menu
-#define gxg_gtk_binding_entry_skip_w gxg_gtk_binding_entry_skip
-#define gxg_gtk_cell_layout_get_cells_w gxg_gtk_cell_layout_get_cells
-#define gxg_gtk_entry_completion_set_inline_selection_w gxg_gtk_entry_completion_set_inline_selection
-#define gxg_gtk_entry_completion_get_inline_selection_w gxg_gtk_entry_completion_get_inline_selection
-#define gxg_gtk_entry_completion_get_completion_prefix_w gxg_gtk_entry_completion_get_completion_prefix
-#define gxg_gtk_entry_set_cursor_hadjustment_w gxg_gtk_entry_set_cursor_hadjustment
-#define gxg_gtk_entry_get_cursor_hadjustment_w gxg_gtk_entry_get_cursor_hadjustment
-#define gxg_gtk_icon_theme_list_contexts_w gxg_gtk_icon_theme_list_contexts
-#define gxg_gtk_page_setup_new_from_file_w gxg_gtk_page_setup_new_from_file
-#define gxg_gtk_page_setup_to_file_w gxg_gtk_page_setup_to_file
-#define gxg_gtk_print_settings_new_from_file_w gxg_gtk_print_settings_new_from_file
-#define gxg_gtk_print_settings_to_file_w gxg_gtk_print_settings_to_file
-#define gxg_gtk_range_set_show_fill_level_w gxg_gtk_range_set_show_fill_level
-#define gxg_gtk_range_get_show_fill_level_w gxg_gtk_range_get_show_fill_level
-#define gxg_gtk_range_set_restrict_to_fill_level_w gxg_gtk_range_set_restrict_to_fill_level
-#define gxg_gtk_range_get_restrict_to_fill_level_w gxg_gtk_range_get_restrict_to_fill_level
-#define gxg_gtk_range_set_fill_level_w gxg_gtk_range_set_fill_level
-#define gxg_gtk_range_get_fill_level_w gxg_gtk_range_get_fill_level
-#define gxg_gtk_status_icon_set_screen_w gxg_gtk_status_icon_set_screen
-#define gxg_gtk_status_icon_get_screen_w gxg_gtk_status_icon_get_screen
-#define gxg_gtk_tree_view_set_show_expanders_w gxg_gtk_tree_view_set_show_expanders
-#define gxg_gtk_tree_view_get_show_expanders_w gxg_gtk_tree_view_get_show_expanders
-#define gxg_gtk_tree_view_set_level_indentation_w gxg_gtk_tree_view_set_level_indentation
-#define gxg_gtk_tree_view_get_level_indentation_w gxg_gtk_tree_view_get_level_indentation
-#define gxg_gtk_widget_keynav_failed_w gxg_gtk_widget_keynav_failed
-#define gxg_gtk_widget_error_bell_w gxg_gtk_widget_error_bell
-#define gxg_gtk_widget_set_tooltip_window_w gxg_gtk_widget_set_tooltip_window
-#define gxg_gtk_widget_get_tooltip_window_w gxg_gtk_widget_get_tooltip_window
-#define gxg_gtk_widget_trigger_tooltip_query_w gxg_gtk_widget_trigger_tooltip_query
-#define gxg_gtk_window_set_startup_id_w gxg_gtk_window_set_startup_id
-#define gxg_gtk_window_set_opacity_w gxg_gtk_window_set_opacity
-#define gxg_gtk_window_get_opacity_w gxg_gtk_window_get_opacity
-#define gxg_gdk_display_supports_composite_w gxg_gdk_display_supports_composite
-#define gxg_gdk_window_set_composited_w gxg_gdk_window_set_composited
-#define gxg_gtk_text_buffer_add_mark_w gxg_gtk_text_buffer_add_mark
-#define gxg_gtk_text_mark_new_w gxg_gtk_text_mark_new
-#define gxg_gtk_tree_view_column_get_tree_view_w gxg_gtk_tree_view_column_get_tree_view
-#define gxg_gtk_tooltip_set_text_w gxg_gtk_tooltip_set_text
-#define gxg_gtk_tree_view_convert_widget_to_tree_coords_w gxg_gtk_tree_view_convert_widget_to_tree_coords
-#define gxg_gtk_tree_view_convert_tree_to_widget_coords_w gxg_gtk_tree_view_convert_tree_to_widget_coords
-#define gxg_gtk_tree_view_convert_widget_to_bin_window_coords_w gxg_gtk_tree_view_convert_widget_to_bin_window_coords
-#define gxg_gtk_tree_view_convert_bin_window_to_widget_coords_w gxg_gtk_tree_view_convert_bin_window_to_widget_coords
-#define gxg_gtk_tree_view_convert_tree_to_bin_window_coords_w gxg_gtk_tree_view_convert_tree_to_bin_window_coords
-#define gxg_gtk_tree_view_convert_bin_window_to_tree_coords_w gxg_gtk_tree_view_convert_bin_window_to_tree_coords
-#define gxg_gtk_widget_set_tooltip_text_w gxg_gtk_widget_set_tooltip_text
-#define gxg_gtk_widget_get_tooltip_text_w gxg_gtk_widget_get_tooltip_text
-#define gxg_gtk_widget_set_tooltip_markup_w gxg_gtk_widget_set_tooltip_markup
-#define gxg_gtk_widget_get_tooltip_markup_w gxg_gtk_widget_get_tooltip_markup
-#define gxg_gtk_tree_view_is_rubber_banding_active_w gxg_gtk_tree_view_is_rubber_banding_active
-#define gxg_gtk_icon_view_convert_widget_to_bin_window_coords_w gxg_gtk_icon_view_convert_widget_to_bin_window_coords
-#define gxg_gtk_icon_view_set_tooltip_item_w gxg_gtk_icon_view_set_tooltip_item
-#define gxg_gtk_icon_view_set_tooltip_cell_w gxg_gtk_icon_view_set_tooltip_cell
-#define gxg_gtk_icon_view_get_tooltip_context_w gxg_gtk_icon_view_get_tooltip_context
-#define gxg_gtk_icon_view_set_tooltip_column_w gxg_gtk_icon_view_set_tooltip_column
-#define gxg_gtk_icon_view_get_tooltip_column_w gxg_gtk_icon_view_get_tooltip_column
-#define gxg_gtk_menu_tool_button_set_arrow_tooltip_text_w gxg_gtk_menu_tool_button_set_arrow_tooltip_text
-#define gxg_gtk_menu_tool_button_set_arrow_tooltip_markup_w gxg_gtk_menu_tool_button_set_arrow_tooltip_markup
-#define gxg_gtk_tool_item_set_tooltip_text_w gxg_gtk_tool_item_set_tooltip_text
-#define gxg_gtk_tool_item_set_tooltip_markup_w gxg_gtk_tool_item_set_tooltip_markup
-#define gxg_gtk_tooltip_set_tip_area_w gxg_gtk_tooltip_set_tip_area
-#define gxg_gtk_tree_view_set_tooltip_row_w gxg_gtk_tree_view_set_tooltip_row
-#define gxg_gtk_tree_view_set_tooltip_cell_w gxg_gtk_tree_view_set_tooltip_cell
-#define gxg_gtk_tree_view_get_tooltip_context_w gxg_gtk_tree_view_get_tooltip_context
-#define gxg_gtk_tree_view_set_tooltip_column_w gxg_gtk_tree_view_set_tooltip_column
-#define gxg_gtk_tree_view_get_tooltip_column_w gxg_gtk_tree_view_get_tooltip_column
-#define gxg_gtk_widget_set_has_tooltip_w gxg_gtk_widget_set_has_tooltip
-#define gxg_gtk_widget_get_has_tooltip_w gxg_gtk_widget_get_has_tooltip
-#if HAVE_GTK_TEST_WIDGET_CLICK
-#define gxg_gtk_calendar_set_detail_func_w gxg_gtk_calendar_set_detail_func
-#define gxg_gtk_calendar_set_detail_width_chars_w gxg_gtk_calendar_set_detail_width_chars
-#define gxg_gtk_calendar_set_detail_height_rows_w gxg_gtk_calendar_set_detail_height_rows
-#define gxg_gtk_calendar_get_detail_width_chars_w gxg_gtk_calendar_get_detail_width_chars
-#define gxg_gtk_calendar_get_detail_height_rows_w gxg_gtk_calendar_get_detail_height_rows
-#define gxg_gdk_screen_get_monitor_width_mm_w gxg_gdk_screen_get_monitor_width_mm
-#define gxg_gdk_screen_get_monitor_height_mm_w gxg_gdk_screen_get_monitor_height_mm
-#define gxg_gdk_screen_get_monitor_plug_name_w gxg_gdk_screen_get_monitor_plug_name
-#define gxg_gtk_tooltip_set_icon_from_icon_name_w gxg_gtk_tooltip_set_icon_from_icon_name
+#if GTK_CHECK_VERSION(3, 16, 0)
+Xen_wrap_1_arg(gxg_GTK_GL_AREA_w, gxg_GTK_GL_AREA)
+Xen_wrap_1_arg(gxg_GDK_GL_CONTEXT_w, gxg_GDK_GL_CONTEXT)
+Xen_wrap_1_arg(gxg_GTK_POPOVER_MENU_w, gxg_GTK_POPOVER_MENU)
+Xen_wrap_1_arg(gxg_GTK_STACK_SIDEBAR_w, gxg_GTK_STACK_SIDEBAR)
#endif
-#if HAVE_GTK_ADJUSTMENT_GET_UPPER
-#define gxg_gtk_accel_group_get_is_locked_w gxg_gtk_accel_group_get_is_locked
-#define gxg_gtk_color_selection_dialog_get_color_selection_w gxg_gtk_color_selection_dialog_get_color_selection
-#define gxg_gtk_container_get_focus_child_w gxg_gtk_container_get_focus_child
-#define gxg_gtk_dialog_get_action_area_w gxg_gtk_dialog_get_action_area
-#define gxg_gtk_dialog_get_content_area_w gxg_gtk_dialog_get_content_area
-#define gxg_gtk_entry_set_overwrite_mode_w gxg_gtk_entry_set_overwrite_mode
-#define gxg_gtk_entry_get_overwrite_mode_w gxg_gtk_entry_get_overwrite_mode
-#define gxg_gtk_entry_get_text_length_w gxg_gtk_entry_get_text_length
-#define gxg_gtk_font_selection_get_family_list_w gxg_gtk_font_selection_get_family_list
-#define gxg_gtk_font_selection_get_face_list_w gxg_gtk_font_selection_get_face_list
-#define gxg_gtk_font_selection_get_size_entry_w gxg_gtk_font_selection_get_size_entry
-#define gxg_gtk_font_selection_get_size_list_w gxg_gtk_font_selection_get_size_list
-#define gxg_gtk_font_selection_get_preview_entry_w gxg_gtk_font_selection_get_preview_entry
-#define gxg_gtk_font_selection_get_family_w gxg_gtk_font_selection_get_family
-#define gxg_gtk_font_selection_get_face_w gxg_gtk_font_selection_get_face
-#define gxg_gtk_font_selection_get_size_w gxg_gtk_font_selection_get_size
-#define gxg_gtk_font_selection_dialog_get_ok_button_w gxg_gtk_font_selection_dialog_get_ok_button
-#define gxg_gtk_font_selection_dialog_get_cancel_button_w gxg_gtk_font_selection_dialog_get_cancel_button
-#define gxg_gtk_handle_box_get_child_detached_w gxg_gtk_handle_box_get_child_detached
-#define gxg_gtk_layout_get_bin_window_w gxg_gtk_layout_get_bin_window
-#define gxg_gtk_menu_get_accel_path_w gxg_gtk_menu_get_accel_path
-#define gxg_gtk_menu_get_monitor_w gxg_gtk_menu_get_monitor
-#define gxg_gtk_menu_item_get_accel_path_w gxg_gtk_menu_item_get_accel_path
-#define gxg_gtk_scale_button_get_plus_button_w gxg_gtk_scale_button_get_plus_button
-#define gxg_gtk_scale_button_get_minus_button_w gxg_gtk_scale_button_get_minus_button
-#define gxg_gtk_scale_button_get_popup_w gxg_gtk_scale_button_get_popup
-#define gxg_gtk_selection_data_get_target_w gxg_gtk_selection_data_get_target
-#define gxg_gtk_selection_data_get_data_type_w gxg_gtk_selection_data_get_data_type
-#define gxg_gtk_selection_data_get_format_w gxg_gtk_selection_data_get_format
-#define gxg_gtk_selection_data_get_display_w gxg_gtk_selection_data_get_display
-#define gxg_gtk_widget_get_window_w gxg_gtk_widget_get_window
-#define gxg_gtk_accel_group_get_modifier_mask_w gxg_gtk_accel_group_get_modifier_mask
-#define gxg_gdk_threads_add_timeout_seconds_full_w gxg_gdk_threads_add_timeout_seconds_full
-#define gxg_gdk_threads_add_timeout_seconds_w gxg_gdk_threads_add_timeout_seconds
-#define gxg_gtk_adjustment_get_lower_w gxg_gtk_adjustment_get_lower
-#define gxg_gtk_adjustment_set_lower_w gxg_gtk_adjustment_set_lower
-#define gxg_gtk_adjustment_get_upper_w gxg_gtk_adjustment_get_upper
-#define gxg_gtk_adjustment_set_upper_w gxg_gtk_adjustment_set_upper
-#define gxg_gtk_adjustment_get_step_increment_w gxg_gtk_adjustment_get_step_increment
-#define gxg_gtk_adjustment_set_step_increment_w gxg_gtk_adjustment_set_step_increment
-#define gxg_gtk_adjustment_get_page_increment_w gxg_gtk_adjustment_get_page_increment
-#define gxg_gtk_adjustment_set_page_increment_w gxg_gtk_adjustment_set_page_increment
-#define gxg_gtk_adjustment_get_page_size_w gxg_gtk_adjustment_get_page_size
-#define gxg_gtk_adjustment_set_page_size_w gxg_gtk_adjustment_set_page_size
-#define gxg_gtk_adjustment_configure_w gxg_gtk_adjustment_configure
-#define gxg_gtk_combo_box_set_button_sensitivity_w gxg_gtk_combo_box_set_button_sensitivity
-#define gxg_gtk_combo_box_get_button_sensitivity_w gxg_gtk_combo_box_get_button_sensitivity
-#define gxg_gtk_file_chooser_get_file_w gxg_gtk_file_chooser_get_file
-#define gxg_gtk_file_chooser_set_file_w gxg_gtk_file_chooser_set_file
-#define gxg_gtk_file_chooser_select_file_w gxg_gtk_file_chooser_select_file
-#define gxg_gtk_file_chooser_unselect_file_w gxg_gtk_file_chooser_unselect_file
-#define gxg_gtk_file_chooser_get_files_w gxg_gtk_file_chooser_get_files
-#define gxg_gtk_file_chooser_set_current_folder_file_w gxg_gtk_file_chooser_set_current_folder_file
-#define gxg_gtk_file_chooser_get_current_folder_file_w gxg_gtk_file_chooser_get_current_folder_file
-#define gxg_gtk_file_chooser_get_preview_file_w gxg_gtk_file_chooser_get_preview_file
-#define gxg_gtk_window_get_default_widget_w gxg_gtk_window_get_default_widget
+Xen_wrap_1_arg(gxg_GDK_IS_DRAG_CONTEXT_w, gxg_GDK_IS_DRAG_CONTEXT)
+Xen_wrap_1_arg(gxg_GDK_IS_DEVICE_w, gxg_GDK_IS_DEVICE)
+Xen_wrap_1_arg(gxg_GDK_IS_KEYMAP_w, gxg_GDK_IS_KEYMAP)
+Xen_wrap_1_arg(gxg_GDK_IS_VISUAL_w, gxg_GDK_IS_VISUAL)
+Xen_wrap_1_arg(gxg_GDK_IS_WINDOW_w, gxg_GDK_IS_WINDOW)
+Xen_wrap_1_arg(gxg_GDK_IS_PIXBUF_w, gxg_GDK_IS_PIXBUF)
+Xen_wrap_1_arg(gxg_GDK_IS_PIXBUF_ANIMATION_w, gxg_GDK_IS_PIXBUF_ANIMATION)
+Xen_wrap_1_arg(gxg_GDK_IS_PIXBUF_ANIMATION_ITER_w, gxg_GDK_IS_PIXBUF_ANIMATION_ITER)
+Xen_wrap_1_arg(gxg_GTK_IS_ACCEL_GROUP_w, gxg_GTK_IS_ACCEL_GROUP)
+Xen_wrap_1_arg(gxg_GTK_IS_ACCEL_LABEL_w, gxg_GTK_IS_ACCEL_LABEL)
+Xen_wrap_1_arg(gxg_GTK_IS_ACCESSIBLE_w, gxg_GTK_IS_ACCESSIBLE)
+Xen_wrap_1_arg(gxg_GTK_IS_ADJUSTMENT_w, gxg_GTK_IS_ADJUSTMENT)
+Xen_wrap_1_arg(gxg_GTK_IS_ASPECT_FRAME_w, gxg_GTK_IS_ASPECT_FRAME)
+Xen_wrap_1_arg(gxg_GTK_IS_BUTTON_BOX_w, gxg_GTK_IS_BUTTON_BOX)
+Xen_wrap_1_arg(gxg_GTK_IS_BIN_w, gxg_GTK_IS_BIN)
+Xen_wrap_1_arg(gxg_GTK_IS_BOX_w, gxg_GTK_IS_BOX)
+Xen_wrap_1_arg(gxg_GTK_IS_BUTTON_w, gxg_GTK_IS_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_CALENDAR_w, gxg_GTK_IS_CALENDAR)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_EDITABLE_w, gxg_GTK_IS_CELL_EDITABLE)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_w, gxg_GTK_IS_CELL_RENDERER)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_PIXBUF_w, gxg_GTK_IS_CELL_RENDERER_PIXBUF)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_TEXT_w, gxg_GTK_IS_CELL_RENDERER_TEXT)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_TOGGLE_w, gxg_GTK_IS_CELL_RENDERER_TOGGLE)
+Xen_wrap_1_arg(gxg_GTK_IS_CHECK_BUTTON_w, gxg_GTK_IS_CHECK_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_CHECK_MENU_ITEM_w, gxg_GTK_IS_CHECK_MENU_ITEM)
+Xen_wrap_1_arg(gxg_GTK_IS_CONTAINER_w, gxg_GTK_IS_CONTAINER)
+Xen_wrap_1_arg(gxg_GTK_IS_DIALOG_w, gxg_GTK_IS_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_IS_DRAWING_AREA_w, gxg_GTK_IS_DRAWING_AREA)
+Xen_wrap_1_arg(gxg_GTK_IS_EDITABLE_w, gxg_GTK_IS_EDITABLE)
+Xen_wrap_1_arg(gxg_GTK_IS_ENTRY_w, gxg_GTK_IS_ENTRY)
+Xen_wrap_1_arg(gxg_GTK_IS_EVENT_BOX_w, gxg_GTK_IS_EVENT_BOX)
+Xen_wrap_1_arg(gxg_GTK_IS_FIXED_w, gxg_GTK_IS_FIXED)
+Xen_wrap_1_arg(gxg_GTK_IS_FRAME_w, gxg_GTK_IS_FRAME)
+Xen_wrap_1_arg(gxg_GTK_IS_IMAGE_w, gxg_GTK_IS_IMAGE)
+Xen_wrap_1_arg(gxg_GTK_IS_IM_CONTEXT_w, gxg_GTK_IS_IM_CONTEXT)
+Xen_wrap_1_arg(gxg_GTK_IS_IM_CONTEXT_SIMPLE_w, gxg_GTK_IS_IM_CONTEXT_SIMPLE)
+Xen_wrap_1_arg(gxg_GTK_IS_INVISIBLE_w, gxg_GTK_IS_INVISIBLE)
+Xen_wrap_1_arg(gxg_GTK_IS_LABEL_w, gxg_GTK_IS_LABEL)
+Xen_wrap_1_arg(gxg_GTK_IS_LAYOUT_w, gxg_GTK_IS_LAYOUT)
+Xen_wrap_1_arg(gxg_GTK_IS_LIST_STORE_w, gxg_GTK_IS_LIST_STORE)
+Xen_wrap_1_arg(gxg_GTK_IS_MENU_BAR_w, gxg_GTK_IS_MENU_BAR)
+Xen_wrap_1_arg(gxg_GTK_IS_MENU_w, gxg_GTK_IS_MENU)
+Xen_wrap_1_arg(gxg_GTK_IS_MENU_ITEM_w, gxg_GTK_IS_MENU_ITEM)
+Xen_wrap_1_arg(gxg_GTK_IS_MENU_SHELL_w, gxg_GTK_IS_MENU_SHELL)
+Xen_wrap_1_arg(gxg_GTK_IS_NOTEBOOK_w, gxg_GTK_IS_NOTEBOOK)
+Xen_wrap_1_arg(gxg_GTK_IS_PANED_w, gxg_GTK_IS_PANED)
+Xen_wrap_1_arg(gxg_GTK_IS_PROGRESS_BAR_w, gxg_GTK_IS_PROGRESS_BAR)
+Xen_wrap_1_arg(gxg_GTK_IS_RADIO_BUTTON_w, gxg_GTK_IS_RADIO_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_RADIO_MENU_ITEM_w, gxg_GTK_IS_RADIO_MENU_ITEM)
+Xen_wrap_1_arg(gxg_GTK_IS_RANGE_w, gxg_GTK_IS_RANGE)
+Xen_wrap_1_arg(gxg_GTK_IS_SCALE_w, gxg_GTK_IS_SCALE)
+Xen_wrap_1_arg(gxg_GTK_IS_SCROLLBAR_w, gxg_GTK_IS_SCROLLBAR)
+Xen_wrap_1_arg(gxg_GTK_IS_SCROLLED_WINDOW_w, gxg_GTK_IS_SCROLLED_WINDOW)
+Xen_wrap_1_arg(gxg_GTK_IS_SEPARATOR_w, gxg_GTK_IS_SEPARATOR)
+Xen_wrap_1_arg(gxg_GTK_IS_SEPARATOR_MENU_ITEM_w, gxg_GTK_IS_SEPARATOR_MENU_ITEM)
+Xen_wrap_1_arg(gxg_GTK_IS_SETTINGS_w, gxg_GTK_IS_SETTINGS)
+Xen_wrap_1_arg(gxg_GTK_IS_SIZE_GROUP_w, gxg_GTK_IS_SIZE_GROUP)
+Xen_wrap_1_arg(gxg_GTK_IS_SPIN_BUTTON_w, gxg_GTK_IS_SPIN_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_STATUSBAR_w, gxg_GTK_IS_STATUSBAR)
+Xen_wrap_1_arg(gxg_GTK_IS_TEXT_BUFFER_w, gxg_GTK_IS_TEXT_BUFFER)
+Xen_wrap_1_arg(gxg_GTK_IS_TEXT_CHILD_ANCHOR_w, gxg_GTK_IS_TEXT_CHILD_ANCHOR)
+Xen_wrap_1_arg(gxg_GTK_IS_TEXT_MARK_w, gxg_GTK_IS_TEXT_MARK)
+Xen_wrap_1_arg(gxg_GTK_IS_TEXT_TAG_w, gxg_GTK_IS_TEXT_TAG)
+Xen_wrap_1_arg(gxg_GTK_IS_TEXT_TAG_TABLE_w, gxg_GTK_IS_TEXT_TAG_TABLE)
+Xen_wrap_1_arg(gxg_GTK_IS_TEXT_VIEW_w, gxg_GTK_IS_TEXT_VIEW)
+Xen_wrap_1_arg(gxg_GTK_IS_TOGGLE_BUTTON_w, gxg_GTK_IS_TOGGLE_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_TOOLBAR_w, gxg_GTK_IS_TOOLBAR)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_DRAG_SOURCE_w, gxg_GTK_IS_TREE_DRAG_SOURCE)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_DRAG_DEST_w, gxg_GTK_IS_TREE_DRAG_DEST)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_MODEL_w, gxg_GTK_IS_TREE_MODEL)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_MODEL_SORT_w, gxg_GTK_IS_TREE_MODEL_SORT)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_SELECTION_w, gxg_GTK_IS_TREE_SELECTION)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_SORTABLE_w, gxg_GTK_IS_TREE_SORTABLE)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_STORE_w, gxg_GTK_IS_TREE_STORE)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_VIEW_COLUMN_w, gxg_GTK_IS_TREE_VIEW_COLUMN)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_VIEW_w, gxg_GTK_IS_TREE_VIEW)
+Xen_wrap_1_arg(gxg_GTK_IS_VIEWPORT_w, gxg_GTK_IS_VIEWPORT)
+Xen_wrap_1_arg(gxg_GTK_IS_WIDGET_w, gxg_GTK_IS_WIDGET)
+Xen_wrap_1_arg(gxg_GTK_IS_WINDOW_w, gxg_GTK_IS_WINDOW)
+Xen_wrap_1_arg(gxg_PANGO_IS_CONTEXT_w, gxg_PANGO_IS_CONTEXT)
+Xen_wrap_1_arg(gxg_PANGO_IS_FONT_FAMILY_w, gxg_PANGO_IS_FONT_FAMILY)
+Xen_wrap_1_arg(gxg_PANGO_IS_FONT_FACE_w, gxg_PANGO_IS_FONT_FACE)
+Xen_wrap_1_arg(gxg_PANGO_IS_FONT_w, gxg_PANGO_IS_FONT)
+Xen_wrap_1_arg(gxg_PANGO_IS_FONT_MAP_w, gxg_PANGO_IS_FONT_MAP)
+Xen_wrap_1_arg(gxg_PANGO_IS_LAYOUT_w, gxg_PANGO_IS_LAYOUT)
+Xen_wrap_1_arg(gxg_G_IS_OBJECT_w, gxg_G_IS_OBJECT)
+Xen_wrap_1_arg(gxg_GDK_IS_SCREEN_w, gxg_GDK_IS_SCREEN)
+Xen_wrap_1_arg(gxg_GDK_IS_DISPLAY_w, gxg_GDK_IS_DISPLAY)
+Xen_wrap_1_arg(gxg_GTK_IS_FILE_CHOOSER_DIALOG_w, gxg_GTK_IS_FILE_CHOOSER_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_IS_FILE_CHOOSER_WIDGET_w, gxg_GTK_IS_FILE_CHOOSER_WIDGET)
+Xen_wrap_1_arg(gxg_GTK_IS_TREE_MODEL_FILTER_w, gxg_GTK_IS_TREE_MODEL_FILTER)
+Xen_wrap_1_arg(gxg_GTK_IS_COMBO_BOX_w, gxg_GTK_IS_COMBO_BOX)
+Xen_wrap_1_arg(gxg_GTK_IS_EXPANDER_w, gxg_GTK_IS_EXPANDER)
+Xen_wrap_1_arg(gxg_GTK_IS_FONT_BUTTON_w, gxg_GTK_IS_FONT_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_COLOR_BUTTON_w, gxg_GTK_IS_COLOR_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_ENTRY_COMPLETION_w, gxg_GTK_IS_ENTRY_COMPLETION)
+Xen_wrap_1_arg(gxg_GTK_IS_RADIO_TOOL_BUTTON_w, gxg_GTK_IS_RADIO_TOOL_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_SEPARATOR_TOOL_ITEM_w, gxg_GTK_IS_SEPARATOR_TOOL_ITEM)
+Xen_wrap_1_arg(gxg_GTK_IS_TOGGLE_TOOL_BUTTON_w, gxg_GTK_IS_TOGGLE_TOOL_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_FILE_FILTER_w, gxg_GTK_IS_FILE_FILTER)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_LAYOUT_w, gxg_GTK_IS_CELL_LAYOUT)
+Xen_wrap_1_arg(gxg_GTK_IS_CLIPBOARD_w, gxg_GTK_IS_CLIPBOARD)
+Xen_wrap_1_arg(gxg_GTK_IS_FILE_CHOOSER_w, gxg_GTK_IS_FILE_CHOOSER)
+Xen_wrap_1_arg(gxg_GTK_IS_ICON_THEME_w, gxg_GTK_IS_ICON_THEME)
+Xen_wrap_1_arg(gxg_GTK_IS_TOOL_BUTTON_w, gxg_GTK_IS_TOOL_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_TOOL_ITEM_w, gxg_GTK_IS_TOOL_ITEM)
+Xen_wrap_1_arg(gxg_GTK_IS_ACCEL_MAP_w, gxg_GTK_IS_ACCEL_MAP)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_VIEW_w, gxg_GTK_IS_CELL_VIEW)
+Xen_wrap_1_arg(gxg_GTK_IS_ABOUT_DIALOG_w, gxg_GTK_IS_ABOUT_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_COMBO_w, gxg_GTK_IS_CELL_RENDERER_COMBO)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_PROGRESS_w, gxg_GTK_IS_CELL_RENDERER_PROGRESS)
+Xen_wrap_1_arg(gxg_GTK_IS_ICON_VIEW_w, gxg_GTK_IS_ICON_VIEW)
+Xen_wrap_1_arg(gxg_GTK_IS_FILE_CHOOSER_BUTTON_w, gxg_GTK_IS_FILE_CHOOSER_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_MENU_TOOL_BUTTON_w, gxg_GTK_IS_MENU_TOOL_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_ASSISTANT_w, gxg_GTK_IS_ASSISTANT)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_ACCEL_w, gxg_GTK_IS_CELL_RENDERER_ACCEL)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_SPIN_w, gxg_GTK_IS_CELL_RENDERER_SPIN)
+Xen_wrap_1_arg(gxg_GTK_IS_LINK_BUTTON_w, gxg_GTK_IS_LINK_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_RECENT_CHOOSER_DIALOG_w, gxg_GTK_IS_RECENT_CHOOSER_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_IS_RECENT_CHOOSER_w, gxg_GTK_IS_RECENT_CHOOSER)
+Xen_wrap_1_arg(gxg_GTK_IS_RECENT_CHOOSER_MENU_w, gxg_GTK_IS_RECENT_CHOOSER_MENU)
+Xen_wrap_1_arg(gxg_GTK_IS_RECENT_CHOOSER_WIDGET_w, gxg_GTK_IS_RECENT_CHOOSER_WIDGET)
+Xen_wrap_1_arg(gxg_GTK_IS_RECENT_FILTER_w, gxg_GTK_IS_RECENT_FILTER)
+Xen_wrap_1_arg(gxg_GTK_IS_RECENT_MANAGER_w, gxg_GTK_IS_RECENT_MANAGER)
+Xen_wrap_1_arg(gxg_GTK_IS_PRINT_CONTEXT_w, gxg_GTK_IS_PRINT_CONTEXT)
+Xen_wrap_1_arg(gxg_GTK_IS_PRINT_OPERATION_w, gxg_GTK_IS_PRINT_OPERATION)
+Xen_wrap_1_arg(gxg_GTK_IS_PRINT_OPERATION_PREVIEW_w, gxg_GTK_IS_PRINT_OPERATION_PREVIEW)
+Xen_wrap_1_arg(gxg_GTK_IS_PRINT_SETTINGS_w, gxg_GTK_IS_PRINT_SETTINGS)
+Xen_wrap_1_arg(gxg_GTK_IS_TOOLTIP_w, gxg_GTK_IS_TOOLTIP)
+#if GTK_CHECK_VERSION(2, 18, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_INFO_BAR_w, gxg_GTK_IS_INFO_BAR)
+Xen_wrap_1_arg(gxg_GTK_IS_ENTRY_BUFFER_w, gxg_GTK_IS_ENTRY_BUFFER)
#endif
-#if HAVE_GTK_SCALE_ADD_MARK
-#define gxg_gtk_link_button_get_visited_w gxg_gtk_link_button_get_visited
-#define gxg_gtk_link_button_set_visited_w gxg_gtk_link_button_set_visited
-#define gxg_gdk_keymap_get_caps_lock_state_w gxg_gdk_keymap_get_caps_lock_state
-#define gxg_gtk_cell_view_get_model_w gxg_gtk_cell_view_get_model
-#define gxg_gtk_entry_unset_invisible_char_w gxg_gtk_entry_unset_invisible_char
-#define gxg_gtk_entry_set_progress_fraction_w gxg_gtk_entry_set_progress_fraction
-#define gxg_gtk_entry_get_progress_fraction_w gxg_gtk_entry_get_progress_fraction
-#define gxg_gtk_entry_set_progress_pulse_step_w gxg_gtk_entry_set_progress_pulse_step
-#define gxg_gtk_entry_get_progress_pulse_step_w gxg_gtk_entry_get_progress_pulse_step
-#define gxg_gtk_entry_progress_pulse_w gxg_gtk_entry_progress_pulse
-#define gxg_gtk_entry_set_icon_from_pixbuf_w gxg_gtk_entry_set_icon_from_pixbuf
-#define gxg_gtk_entry_set_icon_from_stock_w gxg_gtk_entry_set_icon_from_stock
-#define gxg_gtk_entry_set_icon_from_icon_name_w gxg_gtk_entry_set_icon_from_icon_name
-#define gxg_gtk_entry_set_icon_from_gicon_w gxg_gtk_entry_set_icon_from_gicon
-#define gxg_gtk_entry_get_icon_name_w gxg_gtk_entry_get_icon_name
-#define gxg_gtk_entry_set_icon_activatable_w gxg_gtk_entry_set_icon_activatable
-#define gxg_gtk_entry_get_icon_activatable_w gxg_gtk_entry_get_icon_activatable
-#define gxg_gtk_entry_set_icon_sensitive_w gxg_gtk_entry_set_icon_sensitive
-#define gxg_gtk_entry_get_icon_sensitive_w gxg_gtk_entry_get_icon_sensitive
-#define gxg_gtk_entry_get_icon_at_pos_w gxg_gtk_entry_get_icon_at_pos
-#define gxg_gtk_entry_set_icon_tooltip_text_w gxg_gtk_entry_set_icon_tooltip_text
-#define gxg_gtk_entry_set_icon_tooltip_markup_w gxg_gtk_entry_set_icon_tooltip_markup
-#define gxg_gtk_entry_set_icon_drag_source_w gxg_gtk_entry_set_icon_drag_source
-#define gxg_gtk_entry_get_current_icon_drag_source_w gxg_gtk_entry_get_current_icon_drag_source
-#define gxg_gtk_image_menu_item_set_use_stock_w gxg_gtk_image_menu_item_set_use_stock
-#define gxg_gtk_image_menu_item_get_use_stock_w gxg_gtk_image_menu_item_get_use_stock
-#define gxg_gtk_image_menu_item_set_accel_group_w gxg_gtk_image_menu_item_set_accel_group
-#define gxg_gtk_menu_item_set_label_w gxg_gtk_menu_item_set_label
-#define gxg_gtk_menu_item_get_label_w gxg_gtk_menu_item_get_label
-#define gxg_gtk_menu_item_set_use_underline_w gxg_gtk_menu_item_set_use_underline
-#define gxg_gtk_menu_item_get_use_underline_w gxg_gtk_menu_item_get_use_underline
-#define gxg_gtk_selection_data_get_selection_w gxg_gtk_selection_data_get_selection
-#define gxg_gtk_action_set_label_w gxg_gtk_action_set_label
-#define gxg_gtk_action_get_label_w gxg_gtk_action_get_label
-#define gxg_gtk_action_set_short_label_w gxg_gtk_action_set_short_label
-#define gxg_gtk_action_get_short_label_w gxg_gtk_action_get_short_label
-#define gxg_gtk_action_set_tooltip_w gxg_gtk_action_set_tooltip
-#define gxg_gtk_action_get_tooltip_w gxg_gtk_action_get_tooltip
-#define gxg_gtk_action_set_stock_id_w gxg_gtk_action_set_stock_id
-#define gxg_gtk_action_get_stock_id_w gxg_gtk_action_get_stock_id
-#define gxg_gtk_action_set_gicon_w gxg_gtk_action_set_gicon
-#define gxg_gtk_action_get_gicon_w gxg_gtk_action_get_gicon
-#define gxg_gtk_action_set_icon_name_w gxg_gtk_action_set_icon_name
-#define gxg_gtk_action_get_icon_name_w gxg_gtk_action_get_icon_name
-#define gxg_gtk_action_set_visible_horizontal_w gxg_gtk_action_set_visible_horizontal
-#define gxg_gtk_action_get_visible_horizontal_w gxg_gtk_action_get_visible_horizontal
-#define gxg_gtk_action_set_visible_vertical_w gxg_gtk_action_set_visible_vertical
-#define gxg_gtk_action_get_visible_vertical_w gxg_gtk_action_get_visible_vertical
-#define gxg_gtk_action_set_is_important_w gxg_gtk_action_set_is_important
-#define gxg_gtk_action_get_is_important_w gxg_gtk_action_get_is_important
-#define gxg_gtk_entry_get_icon_tooltip_text_w gxg_gtk_entry_get_icon_tooltip_text
-#define gxg_gtk_entry_get_icon_tooltip_markup_w gxg_gtk_entry_get_icon_tooltip_markup
-#define gxg_gtk_scale_add_mark_w gxg_gtk_scale_add_mark
-#define gxg_gtk_scale_clear_marks_w gxg_gtk_scale_clear_marks
+#if GTK_CHECK_VERSION(2, 20, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_SPINNER_w, gxg_GTK_IS_SPINNER)
+Xen_wrap_1_arg(gxg_GTK_IS_CELL_RENDERER_SPINNER_w, gxg_GTK_IS_CELL_RENDERER_SPINNER)
+Xen_wrap_1_arg(gxg_GTK_IS_TOOL_PALETTE_w, gxg_GTK_IS_TOOL_PALETTE)
+Xen_wrap_1_arg(gxg_GTK_IS_TOOL_ITEM_GROUP_w, gxg_GTK_IS_TOOL_ITEM_GROUP)
#endif
-#if HAVE_GTK_INFO_BAR_NEW
-#define gxg_gtk_image_menu_item_set_always_show_image_w gxg_gtk_image_menu_item_set_always_show_image
-#define gxg_gtk_image_menu_item_get_always_show_image_w gxg_gtk_image_menu_item_get_always_show_image
-#define gxg_gtk_window_get_default_icon_name_w gxg_gtk_window_get_default_icon_name
-#define gxg_gtk_label_get_current_uri_w gxg_gtk_label_get_current_uri
-#define gxg_gtk_info_bar_new_w gxg_gtk_info_bar_new
-#define gxg_gtk_info_bar_get_action_area_w gxg_gtk_info_bar_get_action_area
-#define gxg_gtk_info_bar_get_content_area_w gxg_gtk_info_bar_get_content_area
-#define gxg_gtk_info_bar_add_action_widget_w gxg_gtk_info_bar_add_action_widget
-#define gxg_gtk_info_bar_add_button_w gxg_gtk_info_bar_add_button
-#define gxg_gtk_info_bar_set_response_sensitive_w gxg_gtk_info_bar_set_response_sensitive
-#define gxg_gtk_info_bar_set_default_response_w gxg_gtk_info_bar_set_default_response
-#define gxg_gtk_info_bar_response_w gxg_gtk_info_bar_response
-#define gxg_gtk_info_bar_set_message_type_w gxg_gtk_info_bar_set_message_type
-#define gxg_gtk_info_bar_get_message_type_w gxg_gtk_info_bar_get_message_type
+#if GTK_CHECK_VERSION(3, 0, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_COMBO_BOX_TEXT_w, gxg_GTK_IS_COMBO_BOX_TEXT)
+Xen_wrap_1_arg(gxg_GTK_IS_GRID_w, gxg_GTK_IS_GRID)
+Xen_wrap_1_arg(gxg_GTK_IS_SCROLLABLE_w, gxg_GTK_IS_SCROLLABLE)
+Xen_wrap_1_arg(gxg_GTK_IS_SWITCH_w, gxg_GTK_IS_SWITCH)
+Xen_wrap_1_arg(gxg_GTK_IS_ORIENTABLE_w, gxg_GTK_IS_ORIENTABLE)
+Xen_wrap_1_arg(gxg_GTK_IS_WINDOW_GROUP_w, gxg_GTK_IS_WINDOW_GROUP)
+Xen_wrap_1_arg(gxg_GTK_IS_TOOL_SHELL_w, gxg_GTK_IS_TOOL_SHELL)
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-#define gxg_gdk_window_ensure_native_w gxg_gdk_window_ensure_native
-#define gxg_gdk_window_get_root_coords_w gxg_gdk_window_get_root_coords
-#define gxg_gdk_offscreen_window_set_embedder_w gxg_gdk_offscreen_window_set_embedder
-#define gxg_gdk_offscreen_window_get_embedder_w gxg_gdk_offscreen_window_get_embedder
-#define gxg_gdk_window_geometry_changed_w gxg_gdk_window_geometry_changed
-#define gxg_gtk_menu_set_reserve_toggle_size_w gxg_gtk_menu_set_reserve_toggle_size
-#define gxg_gtk_menu_get_reserve_toggle_size_w gxg_gtk_menu_get_reserve_toggle_size
-#define gxg_gtk_status_icon_set_title_w gxg_gtk_status_icon_set_title
-#define gxg_gtk_status_icon_get_title_w gxg_gtk_status_icon_get_title
-#define gxg_gtk_entry_new_with_buffer_w gxg_gtk_entry_new_with_buffer
-#define gxg_gtk_entry_get_buffer_w gxg_gtk_entry_get_buffer
-#define gxg_gtk_entry_set_buffer_w gxg_gtk_entry_set_buffer
-#define gxg_gtk_label_set_track_visited_links_w gxg_gtk_label_set_track_visited_links
-#define gxg_gtk_label_get_track_visited_links_w gxg_gtk_label_get_track_visited_links
-#define gxg_gtk_print_operation_set_embed_page_setup_w gxg_gtk_print_operation_set_embed_page_setup
-#define gxg_gtk_print_operation_get_embed_page_setup_w gxg_gtk_print_operation_get_embed_page_setup
-#define gxg_gtk_entry_buffer_new_w gxg_gtk_entry_buffer_new
-#define gxg_gtk_entry_buffer_get_bytes_w gxg_gtk_entry_buffer_get_bytes
-#define gxg_gtk_entry_buffer_get_length_w gxg_gtk_entry_buffer_get_length
-#define gxg_gtk_entry_buffer_get_text_w gxg_gtk_entry_buffer_get_text
-#define gxg_gtk_entry_buffer_set_text_w gxg_gtk_entry_buffer_set_text
-#define gxg_gtk_entry_buffer_set_max_length_w gxg_gtk_entry_buffer_set_max_length
-#define gxg_gtk_entry_buffer_get_max_length_w gxg_gtk_entry_buffer_get_max_length
-#define gxg_gtk_entry_buffer_insert_text_w gxg_gtk_entry_buffer_insert_text
-#define gxg_gtk_entry_buffer_delete_text_w gxg_gtk_entry_buffer_delete_text
-#define gxg_gtk_entry_buffer_emit_inserted_text_w gxg_gtk_entry_buffer_emit_inserted_text
-#define gxg_gtk_entry_buffer_emit_deleted_text_w gxg_gtk_entry_buffer_emit_deleted_text
-#define gxg_gtk_cell_renderer_set_alignment_w gxg_gtk_cell_renderer_set_alignment
-#define gxg_gtk_cell_renderer_get_alignment_w gxg_gtk_cell_renderer_get_alignment
-#define gxg_gtk_cell_renderer_set_padding_w gxg_gtk_cell_renderer_set_padding
-#define gxg_gtk_cell_renderer_get_padding_w gxg_gtk_cell_renderer_get_padding
-#define gxg_gtk_cell_renderer_set_visible_w gxg_gtk_cell_renderer_set_visible
-#define gxg_gtk_cell_renderer_get_visible_w gxg_gtk_cell_renderer_get_visible
-#define gxg_gtk_cell_renderer_set_sensitive_w gxg_gtk_cell_renderer_set_sensitive
-#define gxg_gtk_cell_renderer_get_sensitive_w gxg_gtk_cell_renderer_get_sensitive
-#define gxg_gtk_cell_renderer_toggle_get_activatable_w gxg_gtk_cell_renderer_toggle_get_activatable
-#define gxg_gtk_cell_renderer_toggle_set_activatable_w gxg_gtk_cell_renderer_toggle_set_activatable
-#define gxg_gtk_widget_set_can_focus_w gxg_gtk_widget_set_can_focus
-#define gxg_gtk_widget_get_can_focus_w gxg_gtk_widget_get_can_focus
-#define gxg_gtk_widget_has_focus_w gxg_gtk_widget_has_focus
-#define gxg_gtk_widget_set_can_default_w gxg_gtk_widget_set_can_default
-#define gxg_gtk_widget_get_can_default_w gxg_gtk_widget_get_can_default
-#define gxg_gtk_widget_has_default_w gxg_gtk_widget_has_default
-#define gxg_gtk_widget_get_state_w gxg_gtk_widget_get_state
-#define gxg_gtk_widget_get_sensitive_w gxg_gtk_widget_get_sensitive
-#define gxg_gtk_widget_is_sensitive_w gxg_gtk_widget_is_sensitive
-#define gxg_gtk_widget_set_has_window_w gxg_gtk_widget_set_has_window
-#define gxg_gtk_widget_get_has_window_w gxg_gtk_widget_get_has_window
-#define gxg_gtk_widget_get_app_paintable_w gxg_gtk_widget_get_app_paintable
-#define gxg_gtk_widget_get_double_buffered_w gxg_gtk_widget_get_double_buffered
+#if GTK_CHECK_VERSION(3, 2, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_OVERLAY_w, gxg_GTK_IS_OVERLAY)
+Xen_wrap_1_arg(gxg_GTK_IS_FONT_CHOOSER_w, gxg_GTK_IS_FONT_CHOOSER)
+Xen_wrap_1_arg(gxg_GTK_IS_FONT_CHOOSER_DIALOG_w, gxg_GTK_IS_FONT_CHOOSER_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_IS_FONT_CHOOSER_WIDGET_w, gxg_GTK_IS_FONT_CHOOSER_WIDGET)
#endif
-#if HAVE_GTK_WIDGET_GET_VISIBLE
-#define gxg_gdk_window_get_cursor_w gxg_gdk_window_get_cursor
-#define gxg_gtk_file_chooser_set_create_folders_w gxg_gtk_file_chooser_set_create_folders
-#define gxg_gtk_file_chooser_get_create_folders_w gxg_gtk_file_chooser_get_create_folders
-#define gxg_gtk_icon_view_set_item_padding_w gxg_gtk_icon_view_set_item_padding
-#define gxg_gtk_icon_view_get_item_padding_w gxg_gtk_icon_view_get_item_padding
-#define gxg_gtk_widget_has_grab_w gxg_gtk_widget_has_grab
-#define gxg_gtk_widget_set_visible_w gxg_gtk_widget_set_visible
-#define gxg_gtk_widget_get_visible_w gxg_gtk_widget_get_visible
-#define gxg_gtk_range_set_flippable_w gxg_gtk_range_set_flippable
-#define gxg_gtk_range_get_flippable_w gxg_gtk_range_get_flippable
-#define gxg_gtk_widget_is_toplevel_w gxg_gtk_widget_is_toplevel
-#define gxg_gtk_widget_is_drawable_w gxg_gtk_widget_is_drawable
-#define gxg_gtk_widget_set_window_w gxg_gtk_widget_set_window
-#define gxg_gdk_window_is_destroyed_w gxg_gdk_window_is_destroyed
-#define gxg_gdk_window_restack_w gxg_gdk_window_restack
-#define gxg_gtk_widget_set_receives_default_w gxg_gtk_widget_set_receives_default
-#define gxg_gtk_widget_get_receives_default_w gxg_gtk_widget_get_receives_default
-#define gxg_gdk_window_flush_w gxg_gdk_window_flush
+#if GTK_CHECK_VERSION(3, 4, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_APPLICATION_WINDOW_w, gxg_GTK_IS_APPLICATION_WINDOW)
+Xen_wrap_1_arg(gxg_GTK_IS_COLOR_CHOOSER_DIALOG_w, gxg_GTK_IS_COLOR_CHOOSER_DIALOG)
+Xen_wrap_1_arg(gxg_GTK_IS_COLOR_CHOOSER_WIDGET_w, gxg_GTK_IS_COLOR_CHOOSER_WIDGET)
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-#define gxg_gtk_dialog_get_widget_for_response_w gxg_gtk_dialog_get_widget_for_response
-#define gxg_gtk_tooltip_set_icon_from_gicon_w gxg_gtk_tooltip_set_icon_from_gicon
-#define gxg_gtk_viewport_get_bin_window_w gxg_gtk_viewport_get_bin_window
-#define gxg_gtk_spinner_new_w gxg_gtk_spinner_new
-#define gxg_gtk_spinner_start_w gxg_gtk_spinner_start
-#define gxg_gtk_spinner_stop_w gxg_gtk_spinner_stop
-#define gxg_gtk_cell_renderer_spinner_new_w gxg_gtk_cell_renderer_spinner_new
-#define gxg_gtk_action_set_always_show_image_w gxg_gtk_action_set_always_show_image
-#define gxg_gtk_action_get_always_show_image_w gxg_gtk_action_get_always_show_image
-#define gxg_gtk_notebook_get_action_widget_w gxg_gtk_notebook_get_action_widget
-#define gxg_gtk_notebook_set_action_widget_w gxg_gtk_notebook_set_action_widget
-#define gxg_gtk_statusbar_get_message_area_w gxg_gtk_statusbar_get_message_area
-#define gxg_gtk_tool_item_get_ellipsize_mode_w gxg_gtk_tool_item_get_ellipsize_mode
-#define gxg_gtk_tool_item_get_text_alignment_w gxg_gtk_tool_item_get_text_alignment
-#define gxg_gtk_tool_item_get_text_orientation_w gxg_gtk_tool_item_get_text_orientation
-#define gxg_gtk_tool_item_get_text_size_group_w gxg_gtk_tool_item_get_text_size_group
-#define gxg_gtk_tool_palette_new_w gxg_gtk_tool_palette_new
-#define gxg_gtk_tool_palette_set_group_position_w gxg_gtk_tool_palette_set_group_position
-#define gxg_gtk_tool_palette_set_exclusive_w gxg_gtk_tool_palette_set_exclusive
-#define gxg_gtk_tool_palette_set_expand_w gxg_gtk_tool_palette_set_expand
-#define gxg_gtk_tool_palette_get_group_position_w gxg_gtk_tool_palette_get_group_position
-#define gxg_gtk_tool_palette_get_exclusive_w gxg_gtk_tool_palette_get_exclusive
-#define gxg_gtk_tool_palette_get_expand_w gxg_gtk_tool_palette_get_expand
-#define gxg_gtk_tool_palette_set_icon_size_w gxg_gtk_tool_palette_set_icon_size
-#define gxg_gtk_tool_palette_unset_icon_size_w gxg_gtk_tool_palette_unset_icon_size
-#define gxg_gtk_tool_palette_set_style_w gxg_gtk_tool_palette_set_style
-#define gxg_gtk_tool_palette_unset_style_w gxg_gtk_tool_palette_unset_style
-#define gxg_gtk_tool_palette_get_icon_size_w gxg_gtk_tool_palette_get_icon_size
-#define gxg_gtk_tool_palette_get_style_w gxg_gtk_tool_palette_get_style
-#define gxg_gtk_tool_palette_get_drop_item_w gxg_gtk_tool_palette_get_drop_item
-#define gxg_gtk_tool_palette_get_drop_group_w gxg_gtk_tool_palette_get_drop_group
-#define gxg_gtk_tool_palette_get_drag_item_w gxg_gtk_tool_palette_get_drag_item
-#define gxg_gtk_tool_palette_set_drag_source_w gxg_gtk_tool_palette_set_drag_source
-#define gxg_gtk_tool_palette_add_drag_dest_w gxg_gtk_tool_palette_add_drag_dest
-#define gxg_gtk_tool_palette_get_drag_target_item_w gxg_gtk_tool_palette_get_drag_target_item
-#define gxg_gtk_tool_palette_get_drag_target_group_w gxg_gtk_tool_palette_get_drag_target_group
-#define gxg_gtk_tool_item_group_new_w gxg_gtk_tool_item_group_new
-#define gxg_gtk_tool_item_group_set_label_w gxg_gtk_tool_item_group_set_label
-#define gxg_gtk_tool_item_group_set_label_widget_w gxg_gtk_tool_item_group_set_label_widget
-#define gxg_gtk_tool_item_group_set_collapsed_w gxg_gtk_tool_item_group_set_collapsed
-#define gxg_gtk_tool_item_group_set_ellipsize_w gxg_gtk_tool_item_group_set_ellipsize
-#define gxg_gtk_tool_item_group_set_header_relief_w gxg_gtk_tool_item_group_set_header_relief
-#define gxg_gtk_tool_item_group_get_label_w gxg_gtk_tool_item_group_get_label
-#define gxg_gtk_tool_item_group_get_label_widget_w gxg_gtk_tool_item_group_get_label_widget
-#define gxg_gtk_tool_item_group_get_collapsed_w gxg_gtk_tool_item_group_get_collapsed
-#define gxg_gtk_tool_item_group_get_ellipsize_w gxg_gtk_tool_item_group_get_ellipsize
-#define gxg_gtk_tool_item_group_get_header_relief_w gxg_gtk_tool_item_group_get_header_relief
-#define gxg_gtk_tool_item_group_insert_w gxg_gtk_tool_item_group_insert
-#define gxg_gtk_tool_item_group_set_item_position_w gxg_gtk_tool_item_group_set_item_position
-#define gxg_gtk_tool_item_group_get_item_position_w gxg_gtk_tool_item_group_get_item_position
-#define gxg_gtk_tool_item_group_get_n_items_w gxg_gtk_tool_item_group_get_n_items
-#define gxg_gtk_tool_item_group_get_nth_item_w gxg_gtk_tool_item_group_get_nth_item
-#define gxg_gtk_tool_item_group_get_drop_item_w gxg_gtk_tool_item_group_get_drop_item
-#define gxg_gdk_screen_get_primary_monitor_w gxg_gdk_screen_get_primary_monitor
-#define gxg_gtk_window_set_mnemonics_visible_w gxg_gtk_window_set_mnemonics_visible
-#define gxg_gtk_window_get_mnemonics_visible_w gxg_gtk_window_get_mnemonics_visible
-#define gxg_gtk_range_set_slider_size_fixed_w gxg_gtk_range_set_slider_size_fixed
-#define gxg_gtk_range_get_slider_size_fixed_w gxg_gtk_range_get_slider_size_fixed
-#define gxg_gtk_range_set_min_slider_size_w gxg_gtk_range_set_min_slider_size
-#define gxg_gtk_range_get_min_slider_size_w gxg_gtk_range_get_min_slider_size
-#define gxg_gtk_range_get_range_rect_w gxg_gtk_range_get_range_rect
-#define gxg_gtk_range_get_slider_range_w gxg_gtk_range_get_slider_range
-#define gxg_gtk_status_icon_set_name_w gxg_gtk_status_icon_set_name
-#define gxg_gtk_paned_get_handle_window_w gxg_gtk_paned_get_handle_window
-#define gxg_gtk_widget_set_realized_w gxg_gtk_widget_set_realized
-#define gxg_gtk_widget_get_realized_w gxg_gtk_widget_get_realized
-#define gxg_gtk_widget_set_mapped_w gxg_gtk_widget_set_mapped
-#define gxg_gtk_widget_get_mapped_w gxg_gtk_widget_get_mapped
+#if GTK_CHECK_VERSION(3, 6, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_MENU_BUTTON_w, gxg_GTK_IS_MENU_BUTTON)
+Xen_wrap_1_arg(gxg_GTK_IS_SEARCH_ENTRY_w, gxg_GTK_IS_SEARCH_ENTRY)
+Xen_wrap_1_arg(gxg_GTK_IS_LEVEL_BAR_w, gxg_GTK_IS_LEVEL_BAR)
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-#define gxg_gdk_cairo_create_w gxg_gdk_cairo_create
-#define gxg_gdk_window_get_geometry_w gxg_gdk_window_get_geometry
-#define gxg_gdk_keymap_add_virtual_modifiers_w gxg_gdk_keymap_add_virtual_modifiers
-#define gxg_gdk_window_coords_to_parent_w gxg_gdk_window_coords_to_parent
-#define gxg_gdk_window_coords_from_parent_w gxg_gdk_window_coords_from_parent
-#define gxg_gdk_window_get_effective_parent_w gxg_gdk_window_get_effective_parent
-#define gxg_gdk_window_get_effective_toplevel_w gxg_gdk_window_get_effective_toplevel
-#define gxg_gtk_accessible_get_widget_w gxg_gtk_accessible_get_widget
-#define gxg_gtk_widget_send_focus_change_w gxg_gtk_widget_send_focus_change
-#define gxg_gdk_display_get_device_manager_w gxg_gdk_display_get_device_manager
-#define gxg_gdk_drag_context_set_device_w gxg_gdk_drag_context_set_device
-#define gxg_gdk_drag_context_get_device_w gxg_gdk_drag_context_get_device
-#define gxg_gdk_drag_context_list_targets_w gxg_gdk_drag_context_list_targets
-#define gxg_gdk_event_set_device_w gxg_gdk_event_set_device
-#define gxg_gdk_event_get_device_w gxg_gdk_event_get_device
-#define gxg_gdk_events_get_distance_w gxg_gdk_events_get_distance
-#define gxg_gdk_events_get_angle_w gxg_gdk_events_get_angle
-#define gxg_gdk_events_get_center_w gxg_gdk_events_get_center
-#define gxg_gdk_window_get_accept_focus_w gxg_gdk_window_get_accept_focus
-#define gxg_gdk_window_get_focus_on_map_w gxg_gdk_window_get_focus_on_map
-#define gxg_gdk_window_get_composited_w gxg_gdk_window_get_composited
-#define gxg_gdk_window_is_input_only_w gxg_gdk_window_is_input_only
-#define gxg_gdk_window_is_shaped_w gxg_gdk_window_is_shaped
-#define gxg_gdk_window_get_modal_hint_w gxg_gdk_window_get_modal_hint
-#define gxg_gdk_window_set_device_cursor_w gxg_gdk_window_set_device_cursor
-#define gxg_gdk_window_get_device_cursor_w gxg_gdk_window_get_device_cursor
-#define gxg_gdk_window_get_device_position_w gxg_gdk_window_get_device_position
-#define gxg_gdk_window_set_device_events_w gxg_gdk_window_set_device_events
-#define gxg_gdk_window_get_device_events_w gxg_gdk_window_get_device_events
-#define gxg_gtk_combo_box_popup_for_device_w gxg_gtk_combo_box_popup_for_device
-#define gxg_gtk_device_grab_add_w gxg_gtk_device_grab_add
-#define gxg_gtk_device_grab_remove_w gxg_gtk_device_grab_remove
-#define gxg_gtk_get_current_event_device_w gxg_gtk_get_current_event_device
-#define gxg_gtk_paned_new_w gxg_gtk_paned_new
-#define gxg_gtk_radio_action_join_group_w gxg_gtk_radio_action_join_group
-#define gxg_gtk_scale_new_w gxg_gtk_scale_new
-#define gxg_gtk_scale_new_with_range_w gxg_gtk_scale_new_with_range
-#define gxg_gtk_scrollbar_new_w gxg_gtk_scrollbar_new
-#define gxg_gtk_separator_new_w gxg_gtk_separator_new
-#define gxg_gtk_widget_device_is_shadowed_w gxg_gtk_widget_device_is_shadowed
-#define gxg_gtk_widget_set_device_events_w gxg_gtk_widget_set_device_events
-#define gxg_gtk_widget_add_device_events_w gxg_gtk_widget_add_device_events
-#define gxg_gtk_widget_get_support_multidevice_w gxg_gtk_widget_get_support_multidevice
-#define gxg_gtk_widget_set_support_multidevice_w gxg_gtk_widget_set_support_multidevice
-#define gxg_gtk_widget_get_device_events_w gxg_gtk_widget_get_device_events
-#define gxg_gtk_icon_view_get_item_row_w gxg_gtk_icon_view_get_item_row
-#define gxg_gtk_icon_view_get_item_column_w gxg_gtk_icon_view_get_item_column
-#define gxg_gtk_statusbar_remove_all_w gxg_gtk_statusbar_remove_all
-#define gxg_gtk_window_has_group_w gxg_gtk_window_has_group
-#define gxg_gtk_calendar_select_month_w gxg_gtk_calendar_select_month
-#define gxg_gtk_calendar_mark_day_w gxg_gtk_calendar_mark_day
-#define gxg_gtk_calendar_unmark_day_w gxg_gtk_calendar_unmark_day
-#define gxg_gdk_drag_context_get_source_window_w gxg_gdk_drag_context_get_source_window
-#define gxg_gtk_viewport_get_view_window_w gxg_gtk_viewport_get_view_window
-#define gxg_gtk_accessible_set_widget_w gxg_gtk_accessible_set_widget
-#define gxg_gtk_button_get_event_window_w gxg_gtk_button_get_event_window
-#define gxg_gtk_font_selection_dialog_get_font_selection_w gxg_gtk_font_selection_dialog_get_font_selection
-#define gxg_gtk_message_dialog_get_message_area_w gxg_gtk_message_dialog_get_message_area
-#define gxg_gtk_table_get_size_w gxg_gtk_table_get_size
-#define gxg_gtk_selection_data_get_length_w gxg_gtk_selection_data_get_length
-#define gxg_gdk_pango_layout_line_get_clip_region_w gxg_gdk_pango_layout_line_get_clip_region
-#define gxg_gdk_pango_layout_get_clip_region_w gxg_gdk_pango_layout_get_clip_region
-#define gxg_gdk_window_shape_combine_region_w gxg_gdk_window_shape_combine_region
-#define gxg_gdk_window_invalidate_region_w gxg_gdk_window_invalidate_region
-#define gxg_gdk_window_get_update_area_w gxg_gdk_window_get_update_area
-#define gxg_gdk_window_begin_paint_region_w gxg_gdk_window_begin_paint_region
-#define gxg_gtk_widget_region_intersect_w gxg_gtk_widget_region_intersect
-#define gxg_gdk_window_move_region_w gxg_gdk_window_move_region
-#define gxg_gdk_keymap_get_num_lock_state_w gxg_gdk_keymap_get_num_lock_state
-#define gxg_gdk_window_has_native_w gxg_gdk_window_has_native
-#define gxg_gdk_cursor_get_cursor_type_w gxg_gdk_cursor_get_cursor_type
-#define gxg_gdk_display_is_closed_w gxg_gdk_display_is_closed
-#define gxg_gdk_window_get_background_pattern_w gxg_gdk_window_get_background_pattern
-#define gxg_gdk_window_create_similar_surface_w gxg_gdk_window_create_similar_surface
-#define gxg_gtk_expander_set_label_fill_w gxg_gtk_expander_set_label_fill
-#define gxg_gtk_expander_get_label_fill_w gxg_gtk_expander_get_label_fill
-#define gxg_gtk_notebook_get_tab_hborder_w gxg_gtk_notebook_get_tab_hborder
-#define gxg_gtk_notebook_get_tab_vborder_w gxg_gtk_notebook_get_tab_vborder
-#define gxg_gtk_calendar_get_day_is_marked_w gxg_gtk_calendar_get_day_is_marked
-#define gxg_gtk_progress_bar_set_inverted_w gxg_gtk_progress_bar_set_inverted
-#define gxg_gtk_progress_bar_get_inverted_w gxg_gtk_progress_bar_get_inverted
-#define gxg_gtk_radio_button_join_group_w gxg_gtk_radio_button_join_group
-#define gxg_gtk_adjustment_new_w gxg_gtk_adjustment_new
-#define gxg_gtk_binding_set_activate_w gxg_gtk_binding_set_activate
-#define gxg_gtk_bindings_activate_w gxg_gtk_bindings_activate
-#define gxg_gtk_icon_view_create_drag_icon_w gxg_gtk_icon_view_create_drag_icon
-#define gxg_gtk_tree_view_create_row_drag_icon_w gxg_gtk_tree_view_create_row_drag_icon
-#define gxg_gdk_cairo_get_clip_rectangle_w gxg_gdk_cairo_get_clip_rectangle
-#define gxg_gdk_cairo_region_create_from_surface_w gxg_gdk_cairo_region_create_from_surface
-#define gxg_gdk_window_get_visual_w gxg_gdk_window_get_visual
-#define gxg_gdk_window_get_screen_w gxg_gdk_window_get_screen
-#define gxg_gdk_window_get_display_w gxg_gdk_window_get_display
-#define gxg_gdk_window_get_width_w gxg_gdk_window_get_width
-#define gxg_gdk_window_get_height_w gxg_gdk_window_get_height
-#define gxg_gtk_cell_renderer_get_request_mode_w gxg_gtk_cell_renderer_get_request_mode
-#define gxg_gtk_cell_renderer_get_preferred_width_w gxg_gtk_cell_renderer_get_preferred_width
-#define gxg_gtk_cell_renderer_get_preferred_height_for_width_w gxg_gtk_cell_renderer_get_preferred_height_for_width
-#define gxg_gtk_cell_renderer_get_preferred_height_w gxg_gtk_cell_renderer_get_preferred_height
-#define gxg_gtk_cell_renderer_get_preferred_width_for_height_w gxg_gtk_cell_renderer_get_preferred_width_for_height
-#define gxg_gtk_container_class_handle_border_width_w gxg_gtk_container_class_handle_border_width
-#define gxg_gtk_drag_set_icon_surface_w gxg_gtk_drag_set_icon_surface
-#define gxg_gtk_notebook_set_group_name_w gxg_gtk_notebook_set_group_name
-#define gxg_gtk_notebook_get_group_name_w gxg_gtk_notebook_get_group_name
-#define gxg_gtk_widget_draw_w gxg_gtk_widget_draw
-#define gxg_gtk_widget_get_request_mode_w gxg_gtk_widget_get_request_mode
-#define gxg_gtk_widget_get_preferred_width_w gxg_gtk_widget_get_preferred_width
-#define gxg_gtk_widget_get_preferred_height_for_width_w gxg_gtk_widget_get_preferred_height_for_width
-#define gxg_gtk_widget_get_preferred_height_w gxg_gtk_widget_get_preferred_height
-#define gxg_gtk_widget_get_preferred_width_for_height_w gxg_gtk_widget_get_preferred_width_for_height
-#define gxg_gtk_widget_get_allocated_width_w gxg_gtk_widget_get_allocated_width
-#define gxg_gtk_widget_get_allocated_height_w gxg_gtk_widget_get_allocated_height
-#define gxg_gtk_widget_set_visual_w gxg_gtk_widget_set_visual
-#define gxg_gtk_widget_get_halign_w gxg_gtk_widget_get_halign
-#define gxg_gtk_widget_set_halign_w gxg_gtk_widget_set_halign
-#define gxg_gtk_widget_get_valign_w gxg_gtk_widget_get_valign
-#define gxg_gtk_widget_set_valign_w gxg_gtk_widget_set_valign
-#define gxg_gtk_widget_get_margin_left_w gxg_gtk_widget_get_margin_left
-#define gxg_gtk_widget_set_margin_left_w gxg_gtk_widget_set_margin_left
-#define gxg_gtk_widget_get_margin_right_w gxg_gtk_widget_get_margin_right
-#define gxg_gtk_widget_set_margin_right_w gxg_gtk_widget_set_margin_right
-#define gxg_gtk_widget_get_margin_top_w gxg_gtk_widget_get_margin_top
-#define gxg_gtk_widget_set_margin_top_w gxg_gtk_widget_set_margin_top
-#define gxg_gtk_widget_get_margin_bottom_w gxg_gtk_widget_get_margin_bottom
-#define gxg_gtk_widget_set_margin_bottom_w gxg_gtk_widget_set_margin_bottom
-#define gxg_gtk_widget_shape_combine_region_w gxg_gtk_widget_shape_combine_region
-#define gxg_gtk_widget_input_shape_combine_region_w gxg_gtk_widget_input_shape_combine_region
-#define gxg_gtk_cairo_should_draw_window_w gxg_gtk_cairo_should_draw_window
-#define gxg_gtk_cairo_transform_to_window_w gxg_gtk_cairo_transform_to_window
-#define gxg_gtk_combo_box_new_with_entry_w gxg_gtk_combo_box_new_with_entry
-#define gxg_gtk_combo_box_get_has_entry_w gxg_gtk_combo_box_get_has_entry
-#define gxg_gtk_combo_box_set_entry_text_column_w gxg_gtk_combo_box_set_entry_text_column
-#define gxg_gtk_combo_box_get_entry_text_column_w gxg_gtk_combo_box_get_entry_text_column
-#define gxg_gtk_target_entry_new_w gxg_gtk_target_entry_new
-#define gxg_gtk_target_entry_copy_w gxg_gtk_target_entry_copy
-#define gxg_gtk_target_entry_free_w gxg_gtk_target_entry_free
-#define gxg_gtk_widget_get_hexpand_w gxg_gtk_widget_get_hexpand
-#define gxg_gtk_widget_set_hexpand_w gxg_gtk_widget_set_hexpand
-#define gxg_gtk_widget_get_hexpand_set_w gxg_gtk_widget_get_hexpand_set
-#define gxg_gtk_widget_set_hexpand_set_w gxg_gtk_widget_set_hexpand_set
-#define gxg_gtk_widget_get_vexpand_w gxg_gtk_widget_get_vexpand
-#define gxg_gtk_widget_set_vexpand_w gxg_gtk_widget_set_vexpand
-#define gxg_gtk_widget_get_vexpand_set_w gxg_gtk_widget_get_vexpand_set
-#define gxg_gtk_widget_set_vexpand_set_w gxg_gtk_widget_set_vexpand_set
-#define gxg_gtk_widget_queue_compute_expand_w gxg_gtk_widget_queue_compute_expand
-#define gxg_gtk_widget_compute_expand_w gxg_gtk_widget_compute_expand
-#define gxg_gtk_window_set_default_geometry_w gxg_gtk_window_set_default_geometry
-#define gxg_gtk_window_resize_to_geometry_w gxg_gtk_window_resize_to_geometry
-#define gxg_gtk_window_set_has_resize_grip_w gxg_gtk_window_set_has_resize_grip
-#define gxg_gtk_window_get_has_resize_grip_w gxg_gtk_window_get_has_resize_grip
-#define gxg_gtk_window_resize_grip_is_visible_w gxg_gtk_window_resize_grip_is_visible
-#define gxg_gtk_window_get_resize_grip_area_w gxg_gtk_window_get_resize_grip_area
-#define gxg_gtk_combo_box_text_new_w gxg_gtk_combo_box_text_new
-#define gxg_gtk_combo_box_text_new_with_entry_w gxg_gtk_combo_box_text_new_with_entry
-#define gxg_gtk_combo_box_text_append_text_w gxg_gtk_combo_box_text_append_text
-#define gxg_gtk_combo_box_text_insert_text_w gxg_gtk_combo_box_text_insert_text
-#define gxg_gtk_combo_box_text_prepend_text_w gxg_gtk_combo_box_text_prepend_text
-#define gxg_gtk_combo_box_text_remove_w gxg_gtk_combo_box_text_remove
-#define gxg_gtk_combo_box_text_get_active_text_w gxg_gtk_combo_box_text_get_active_text
-#define gxg_gdk_cairo_set_source_rgba_w gxg_gdk_cairo_set_source_rgba
-#define gxg_gdk_window_set_background_rgba_w gxg_gdk_window_set_background_rgba
-#define gxg_gtk_cell_view_set_background_rgba_w gxg_gtk_cell_view_set_background_rgba
-#define gxg_gtk_color_button_new_with_rgba_w gxg_gtk_color_button_new_with_rgba
-#define gxg_gtk_color_button_set_rgba_w gxg_gtk_color_button_set_rgba
-#define gxg_gtk_color_selection_set_current_rgba_w gxg_gtk_color_selection_set_current_rgba
-#define gxg_gtk_color_selection_set_previous_rgba_w gxg_gtk_color_selection_set_previous_rgba
-#define gxg_gtk_combo_box_text_remove_all_w gxg_gtk_combo_box_text_remove_all
-#define gxg_gtk_combo_box_set_popup_fixed_width_w gxg_gtk_combo_box_set_popup_fixed_width
-#define gxg_gtk_combo_box_get_popup_fixed_width_w gxg_gtk_combo_box_get_popup_fixed_width
-#define gxg_gtk_scrolled_window_get_min_content_width_w gxg_gtk_scrolled_window_get_min_content_width
-#define gxg_gtk_scrolled_window_set_min_content_width_w gxg_gtk_scrolled_window_set_min_content_width
-#define gxg_gtk_scrolled_window_get_min_content_height_w gxg_gtk_scrolled_window_get_min_content_height
-#define gxg_gtk_scrolled_window_set_min_content_height_w gxg_gtk_scrolled_window_set_min_content_height
-#define gxg_gtk_grid_new_w gxg_gtk_grid_new
-#define gxg_gtk_grid_attach_w gxg_gtk_grid_attach
-#define gxg_gtk_grid_attach_next_to_w gxg_gtk_grid_attach_next_to
-#define gxg_gtk_grid_set_row_homogeneous_w gxg_gtk_grid_set_row_homogeneous
-#define gxg_gtk_grid_get_row_homogeneous_w gxg_gtk_grid_get_row_homogeneous
-#define gxg_gtk_grid_set_row_spacing_w gxg_gtk_grid_set_row_spacing
-#define gxg_gtk_grid_get_row_spacing_w gxg_gtk_grid_get_row_spacing
-#define gxg_gtk_grid_set_column_homogeneous_w gxg_gtk_grid_set_column_homogeneous
-#define gxg_gtk_grid_get_column_homogeneous_w gxg_gtk_grid_get_column_homogeneous
-#define gxg_gtk_grid_set_column_spacing_w gxg_gtk_grid_set_column_spacing
-#define gxg_gtk_grid_get_column_spacing_w gxg_gtk_grid_get_column_spacing
-#define gxg_gtk_scrollable_get_hadjustment_w gxg_gtk_scrollable_get_hadjustment
-#define gxg_gtk_scrollable_set_hadjustment_w gxg_gtk_scrollable_set_hadjustment
-#define gxg_gtk_scrollable_get_vadjustment_w gxg_gtk_scrollable_get_vadjustment
-#define gxg_gtk_scrollable_set_vadjustment_w gxg_gtk_scrollable_set_vadjustment
-#define gxg_gtk_assistant_next_page_w gxg_gtk_assistant_next_page
-#define gxg_gtk_assistant_previous_page_w gxg_gtk_assistant_previous_page
-#define gxg_gtk_combo_box_new_with_model_and_entry_w gxg_gtk_combo_box_new_with_model_and_entry
-#define gxg_gtk_scrollable_get_hscroll_policy_w gxg_gtk_scrollable_get_hscroll_policy
-#define gxg_gtk_scrollable_set_hscroll_policy_w gxg_gtk_scrollable_set_hscroll_policy
-#define gxg_gtk_scrollable_get_vscroll_policy_w gxg_gtk_scrollable_get_vscroll_policy
-#define gxg_gtk_scrollable_set_vscroll_policy_w gxg_gtk_scrollable_set_vscroll_policy
-#define gxg_gtk_switch_new_w gxg_gtk_switch_new
-#define gxg_gtk_switch_set_active_w gxg_gtk_switch_set_active
-#define gxg_gtk_switch_get_active_w gxg_gtk_switch_get_active
-#define gxg_gdk_window_get_clip_region_w gxg_gdk_window_get_clip_region
-#define gxg_gdk_window_get_visible_region_w gxg_gdk_window_get_visible_region
-#define gxg_gtk_border_new_w gxg_gtk_border_new
-#define gxg_gtk_border_copy_w gxg_gtk_border_copy
-#define gxg_gtk_border_free_w gxg_gtk_border_free
-#define gxg_gtk_combo_box_get_id_column_w gxg_gtk_combo_box_get_id_column
-#define gxg_gtk_combo_box_set_id_column_w gxg_gtk_combo_box_set_id_column
-#define gxg_gtk_combo_box_get_active_id_w gxg_gtk_combo_box_get_active_id
-#define gxg_gtk_combo_box_set_active_id_w gxg_gtk_combo_box_set_active_id
-#define gxg_gtk_combo_box_text_insert_w gxg_gtk_combo_box_text_insert
-#define gxg_gtk_combo_box_text_append_w gxg_gtk_combo_box_text_append
-#define gxg_gtk_combo_box_text_prepend_w gxg_gtk_combo_box_text_prepend
-#define gxg_gtk_button_box_new_w gxg_gtk_button_box_new
-#define gxg_gtk_box_new_w gxg_gtk_box_new
-#define gxg_gtk_activatable_sync_action_properties_w gxg_gtk_activatable_sync_action_properties
-#define gxg_gtk_activatable_set_related_action_w gxg_gtk_activatable_set_related_action
-#define gxg_gtk_activatable_get_related_action_w gxg_gtk_activatable_get_related_action
-#define gxg_gtk_activatable_set_use_action_appearance_w gxg_gtk_activatable_set_use_action_appearance
-#define gxg_gtk_activatable_get_use_action_appearance_w gxg_gtk_activatable_get_use_action_appearance
-#define gxg_gtk_tree_view_set_cursor_on_cell_w gxg_gtk_tree_view_set_cursor_on_cell
-#define gxg_gtk_tree_view_set_rubber_banding_w gxg_gtk_tree_view_set_rubber_banding
-#define gxg_gtk_tree_view_get_rubber_banding_w gxg_gtk_tree_view_get_rubber_banding
-#define gxg_gtk_tooltip_set_markup_w gxg_gtk_tooltip_set_markup
-#define gxg_gtk_tooltip_set_icon_w gxg_gtk_tooltip_set_icon
-#define gxg_gtk_tooltip_set_icon_from_stock_w gxg_gtk_tooltip_set_icon_from_stock
-#define gxg_gtk_tooltip_set_custom_w gxg_gtk_tooltip_set_custom
-#define gxg_gtk_tooltip_trigger_tooltip_query_w gxg_gtk_tooltip_trigger_tooltip_query
-#define gxg_gtk_button_set_image_position_w gxg_gtk_button_set_image_position
-#define gxg_gtk_button_get_image_position_w gxg_gtk_button_get_image_position
-#define gxg_gtk_show_uri_w gxg_gtk_show_uri
-#define gxg_gtk_tree_view_column_new_with_area_w gxg_gtk_tree_view_column_new_with_area
-#define gxg_gtk_tree_view_column_get_button_w gxg_gtk_tree_view_column_get_button
-#define gxg_gtk_tree_view_column_focus_cell_w gxg_gtk_tree_view_column_focus_cell
-#define gxg_gtk_clipboard_wait_is_uris_available_w gxg_gtk_clipboard_wait_is_uris_available
-#define gxg_gtk_toolbar_set_drop_highlight_item_w gxg_gtk_toolbar_set_drop_highlight_item
-#define gxg_gtk_tool_item_toolbar_reconfigured_w gxg_gtk_tool_item_toolbar_reconfigured
-#define gxg_gtk_orientable_set_orientation_w gxg_gtk_orientable_set_orientation
-#define gxg_gtk_orientable_get_orientation_w gxg_gtk_orientable_get_orientation
-#define gxg_gtk_parse_args_w gxg_gtk_parse_args
-#define gxg_gtk_get_major_version_w gxg_gtk_get_major_version
-#define gxg_gtk_get_minor_version_w gxg_gtk_get_minor_version
-#define gxg_gtk_get_micro_version_w gxg_gtk_get_micro_version
-#define gxg_gtk_get_binary_age_w gxg_gtk_get_binary_age
-#define gxg_gtk_get_interface_age_w gxg_gtk_get_interface_age
-#define gxg_gtk_image_new_from_gicon_w gxg_gtk_image_new_from_gicon
-#define gxg_gtk_image_set_from_gicon_w gxg_gtk_image_set_from_gicon
-#define gxg_gtk_image_get_gicon_w gxg_gtk_image_get_gicon
-#define gxg_gtk_progress_bar_set_show_text_w gxg_gtk_progress_bar_set_show_text
-#define gxg_gtk_progress_bar_get_show_text_w gxg_gtk_progress_bar_get_show_text
-#define gxg_gtk_invisible_new_for_screen_w gxg_gtk_invisible_new_for_screen
-#define gxg_gtk_invisible_set_screen_w gxg_gtk_invisible_set_screen
-#define gxg_gtk_invisible_get_screen_w gxg_gtk_invisible_get_screen
-#define gxg_gtk_entry_get_icon_storage_type_w gxg_gtk_entry_get_icon_storage_type
-#define gxg_gtk_entry_get_icon_pixbuf_w gxg_gtk_entry_get_icon_pixbuf
-#define gxg_gtk_entry_get_icon_stock_w gxg_gtk_entry_get_icon_stock
-#define gxg_gtk_entry_get_icon_gicon_w gxg_gtk_entry_get_icon_gicon
-#define gxg_gtk_container_propagate_draw_w gxg_gtk_container_propagate_draw
-#define gxg_gtk_container_set_focus_chain_w gxg_gtk_container_set_focus_chain
-#define gxg_gtk_container_get_focus_chain_w gxg_gtk_container_get_focus_chain
-#define gxg_gtk_container_unset_focus_chain_w gxg_gtk_container_unset_focus_chain
-#define gxg_gtk_container_set_reallocate_redraws_w gxg_gtk_container_set_reallocate_redraws
-#define gxg_gtk_container_set_focus_child_w gxg_gtk_container_set_focus_child
-#define gxg_gtk_container_set_focus_vadjustment_w gxg_gtk_container_set_focus_vadjustment
-#define gxg_gtk_container_get_focus_vadjustment_w gxg_gtk_container_get_focus_vadjustment
-#define gxg_gtk_container_set_focus_hadjustment_w gxg_gtk_container_set_focus_hadjustment
-#define gxg_gtk_container_get_focus_hadjustment_w gxg_gtk_container_get_focus_hadjustment
-#define gxg_gtk_container_resize_children_w gxg_gtk_container_resize_children
-#define gxg_gtk_assistant_commit_w gxg_gtk_assistant_commit
-#define gxg_gtk_im_multicontext_get_context_id_w gxg_gtk_im_multicontext_get_context_id
-#define gxg_gtk_im_multicontext_set_context_id_w gxg_gtk_im_multicontext_set_context_id
-#define gxg_gtk_about_dialog_set_license_type_w gxg_gtk_about_dialog_set_license_type
-#define gxg_gtk_about_dialog_get_license_type_w gxg_gtk_about_dialog_get_license_type
-#define gxg_gtk_window_set_skip_taskbar_hint_w gxg_gtk_window_set_skip_taskbar_hint
-#define gxg_gtk_window_get_skip_taskbar_hint_w gxg_gtk_window_get_skip_taskbar_hint
-#define gxg_gtk_window_set_skip_pager_hint_w gxg_gtk_window_set_skip_pager_hint
-#define gxg_gtk_window_get_skip_pager_hint_w gxg_gtk_window_get_skip_pager_hint
-#define gxg_gtk_window_set_screen_w gxg_gtk_window_set_screen
-#define gxg_gtk_window_get_screen_w gxg_gtk_window_get_screen
-#define gxg_gtk_window_set_icon_from_file_w gxg_gtk_window_set_icon_from_file
-#define gxg_gtk_window_set_default_icon_from_file_w gxg_gtk_window_set_default_icon_from_file
-#define gxg_gtk_window_fullscreen_w gxg_gtk_window_fullscreen
-#define gxg_gtk_window_unfullscreen_w gxg_gtk_window_unfullscreen
-#define gxg_gtk_window_get_window_type_w gxg_gtk_window_get_window_type
-#define gxg_gtk_window_group_add_window_w gxg_gtk_window_group_add_window
-#define gxg_gtk_window_group_remove_window_w gxg_gtk_window_group_remove_window
-#define gxg_gtk_window_group_new_w gxg_gtk_window_group_new
-#define gxg_gtk_window_get_group_w gxg_gtk_window_get_group
-#define gxg_gtk_window_group_list_windows_w gxg_gtk_window_group_list_windows
-#define gxg_gtk_window_group_get_current_device_grab_w gxg_gtk_window_group_get_current_device_grab
-#define gxg_gtk_window_group_get_current_grab_w gxg_gtk_window_group_get_current_grab
-#define gxg_gtk_selection_data_get_data_w gxg_gtk_selection_data_get_data
-#define gxg_gtk_selection_owner_set_for_display_w gxg_gtk_selection_owner_set_for_display
-#define gxg_gtk_tool_shell_get_text_orientation_w gxg_gtk_tool_shell_get_text_orientation
-#define gxg_gtk_tool_shell_get_text_alignment_w gxg_gtk_tool_shell_get_text_alignment
-#define gxg_gtk_tool_shell_get_ellipsize_mode_w gxg_gtk_tool_shell_get_ellipsize_mode
-#define gxg_gtk_tool_shell_get_text_size_group_w gxg_gtk_tool_shell_get_text_size_group
-#define gxg_gtk_tool_shell_get_icon_size_w gxg_gtk_tool_shell_get_icon_size
-#define gxg_gtk_tool_shell_get_orientation_w gxg_gtk_tool_shell_get_orientation
-#define gxg_gtk_tool_shell_get_style_w gxg_gtk_tool_shell_get_style
-#define gxg_gtk_tool_shell_get_relief_style_w gxg_gtk_tool_shell_get_relief_style
-#define gxg_gtk_tool_shell_rebuild_menu_w gxg_gtk_tool_shell_rebuild_menu
-#define gxg_gtk_status_icon_new_from_gicon_w gxg_gtk_status_icon_new_from_gicon
-#define gxg_gtk_status_icon_set_from_gicon_w gxg_gtk_status_icon_set_from_gicon
-#define gxg_gtk_status_icon_get_gicon_w gxg_gtk_status_icon_get_gicon
-#define gxg_gtk_status_icon_set_has_tooltip_w gxg_gtk_status_icon_set_has_tooltip
-#define gxg_gtk_status_icon_set_tooltip_text_w gxg_gtk_status_icon_set_tooltip_text
-#define gxg_gtk_status_icon_set_tooltip_markup_w gxg_gtk_status_icon_set_tooltip_markup
-#define gxg_gtk_status_icon_get_has_tooltip_w gxg_gtk_status_icon_get_has_tooltip
-#define gxg_gtk_status_icon_get_tooltip_text_w gxg_gtk_status_icon_get_tooltip_text
-#define gxg_gtk_status_icon_get_tooltip_markup_w gxg_gtk_status_icon_get_tooltip_markup
-#define gxg_gtk_accel_map_lock_path_w gxg_gtk_accel_map_lock_path
-#define gxg_gtk_accel_map_unlock_path_w gxg_gtk_accel_map_unlock_path
-#define gxg_gtk_icon_theme_lookup_by_gicon_w gxg_gtk_icon_theme_lookup_by_gicon
-#define gxg_gtk_icon_info_new_for_pixbuf_w gxg_gtk_icon_info_new_for_pixbuf
-#define gxg_gtk_icon_view_set_item_orientation_w gxg_gtk_icon_view_set_item_orientation
-#define gxg_gtk_icon_view_get_item_orientation_w gxg_gtk_icon_view_get_item_orientation
-#define gxg_gtk_text_view_im_context_filter_keypress_w gxg_gtk_text_view_im_context_filter_keypress
-#define gxg_gtk_text_view_reset_im_context_w gxg_gtk_text_view_reset_im_context
-#define gxg_gtk_action_get_accel_path_w gxg_gtk_action_get_accel_path
-#define gxg_gtk_action_block_activate_w gxg_gtk_action_block_activate
-#define gxg_gtk_action_unblock_activate_w gxg_gtk_action_unblock_activate
-#define gxg_gtk_action_set_accel_path_w gxg_gtk_action_set_accel_path
-#define gxg_gtk_action_set_accel_group_w gxg_gtk_action_set_accel_group
-#define gxg_gdk_device_get_position_w gxg_gdk_device_get_position
-#define gxg_gdk_device_get_window_at_position_w gxg_gdk_device_get_window_at_position
-#define gxg_gtk_cell_view_get_draw_sensitive_w gxg_gtk_cell_view_get_draw_sensitive
-#define gxg_gtk_cell_view_set_draw_sensitive_w gxg_gtk_cell_view_set_draw_sensitive
-#define gxg_gtk_cell_view_get_fit_model_w gxg_gtk_cell_view_get_fit_model
-#define gxg_gtk_cell_view_set_fit_model_w gxg_gtk_cell_view_set_fit_model
-#define gxg_gtk_combo_box_new_with_area_w gxg_gtk_combo_box_new_with_area
-#define gxg_gtk_combo_box_new_with_area_and_entry_w gxg_gtk_combo_box_new_with_area_and_entry
-#define gxg_gtk_icon_view_new_with_area_w gxg_gtk_icon_view_new_with_area
-#define gxg_gtk_menu_item_set_reserve_indicator_w gxg_gtk_menu_item_set_reserve_indicator
-#define gxg_gtk_menu_item_get_reserve_indicator_w gxg_gtk_menu_item_get_reserve_indicator
-#define gxg_gtk_menu_shell_get_selected_item_w gxg_gtk_menu_shell_get_selected_item
-#define gxg_gtk_menu_shell_get_parent_shell_w gxg_gtk_menu_shell_get_parent_shell
-#define gxg_gtk_selection_data_get_data_with_length_w gxg_gtk_selection_data_get_data_with_length
-#define gxg_gtk_tree_model_iter_previous_w gxg_gtk_tree_model_iter_previous
-#define gxg_gtk_tree_view_is_blank_at_pos_w gxg_gtk_tree_view_is_blank_at_pos
-#define gxg_gtk_widget_set_device_enabled_w gxg_gtk_widget_set_device_enabled
-#define gxg_gtk_widget_get_device_enabled_w gxg_gtk_widget_get_device_enabled
-#define gxg_gtk_window_set_has_user_ref_count_w gxg_gtk_window_set_has_user_ref_count
-#define gxg_gdk_selection_send_notify_w gxg_gdk_selection_send_notify
-#define gxg_gdk_selection_send_notify_for_display_w gxg_gdk_selection_send_notify_for_display
-#define gxg_gdk_rgba_copy_w gxg_gdk_rgba_copy
-#define gxg_gdk_rgba_free_w gxg_gdk_rgba_free
-#define gxg_gdk_rgba_parse_w gxg_gdk_rgba_parse
-#define gxg_gdk_rgba_to_string_w gxg_gdk_rgba_to_string
+#if GTK_CHECK_VERSION(3, 10, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_PLACES_SIDEBAR_w, gxg_GTK_IS_PLACES_SIDEBAR)
+Xen_wrap_1_arg(gxg_GTK_IS_STACK_SWITCHER_w, gxg_GTK_IS_STACK_SWITCHER)
+Xen_wrap_1_arg(gxg_GTK_IS_STACK_w, gxg_GTK_IS_STACK)
+Xen_wrap_1_arg(gxg_GTK_IS_REVEALER_w, gxg_GTK_IS_REVEALER)
+Xen_wrap_1_arg(gxg_GTK_IS_HEADER_BAR_w, gxg_GTK_IS_HEADER_BAR)
+Xen_wrap_1_arg(gxg_GTK_IS_LIST_BOX_w, gxg_GTK_IS_LIST_BOX)
+Xen_wrap_1_arg(gxg_GTK_IS_LIST_BOX_ROW_w, gxg_GTK_IS_LIST_BOX_ROW)
+Xen_wrap_1_arg(gxg_GTK_IS_SEARCH_BAR_w, gxg_GTK_IS_SEARCH_BAR)
#endif
-#if (!HAVE_GTK_3)
-#define gxg_gdk_colormap_new_w gxg_gdk_colormap_new
-#define gxg_gdk_colormap_get_system_w gxg_gdk_colormap_get_system
-#define gxg_gdk_colormap_alloc_colors_w gxg_gdk_colormap_alloc_colors
-#define gxg_gdk_colormap_alloc_color_w gxg_gdk_colormap_alloc_color
-#define gxg_gdk_colormap_get_visual_w gxg_gdk_colormap_get_visual
-#define gxg_gdk_cursor_ref_w gxg_gdk_cursor_ref
-#define gxg_gdk_cursor_unref_w gxg_gdk_cursor_unref
-#define gxg_gdk_drag_context_new_w gxg_gdk_drag_context_new
-#define gxg_gdk_drag_get_protocol_w gxg_gdk_drag_get_protocol
-#define gxg_gdk_drag_find_window_w gxg_gdk_drag_find_window
-#define gxg_gdk_drag_motion_w gxg_gdk_drag_motion
-#define gxg_gdk_cairo_create_w gxg_gdk_cairo_create
-#define gxg_gdk_drawable_get_size_w gxg_gdk_drawable_get_size
-#define gxg_gdk_drawable_set_colormap_w gxg_gdk_drawable_set_colormap
-#define gxg_gdk_drawable_get_colormap_w gxg_gdk_drawable_get_colormap
-#define gxg_gdk_drawable_get_visual_w gxg_gdk_drawable_get_visual
-#define gxg_gdk_drawable_get_depth_w gxg_gdk_drawable_get_depth
-#define gxg_gdk_set_locale_w gxg_gdk_set_locale
-#define gxg_gdk_pixbuf_render_threshold_alpha_w gxg_gdk_pixbuf_render_threshold_alpha
-#define gxg_gdk_pixbuf_render_pixmap_and_mask_for_colormap_w gxg_gdk_pixbuf_render_pixmap_and_mask_for_colormap
-#define gxg_gdk_pixbuf_render_pixmap_and_mask_w gxg_gdk_pixbuf_render_pixmap_and_mask
-#define gxg_gdk_pixbuf_get_from_drawable_w gxg_gdk_pixbuf_get_from_drawable
-#define gxg_gdk_rgb_find_color_w gxg_gdk_rgb_find_color
-#define gxg_gdk_window_clear_w gxg_gdk_window_clear
-#define gxg_gdk_window_clear_area_w gxg_gdk_window_clear_area
-#define gxg_gdk_window_clear_area_e_w gxg_gdk_window_clear_area_e
-#define gxg_gdk_window_shape_combine_mask_w gxg_gdk_window_shape_combine_mask
-#define gxg_gdk_window_foreign_new_w gxg_gdk_window_foreign_new
-#define gxg_gdk_window_lookup_w gxg_gdk_window_lookup
-#define gxg_gdk_window_set_icon_w gxg_gdk_window_set_icon
-#define gxg_gdk_window_get_internal_paint_info_w gxg_gdk_window_get_internal_paint_info
-#define gxg_gdk_set_sm_client_id_w gxg_gdk_set_sm_client_id
-#define gxg_gdk_window_set_back_pixmap_w gxg_gdk_window_set_back_pixmap
-#define gxg_gdk_window_get_geometry_w gxg_gdk_window_get_geometry
-#define gxg_gtk_adjustment_new_w gxg_gtk_adjustment_new
-#define gxg_gtk_bindings_activate_w gxg_gtk_bindings_activate
-#define gxg_gtk_binding_set_activate_w gxg_gtk_binding_set_activate
-#define gxg_gtk_cell_renderer_get_size_w gxg_gtk_cell_renderer_get_size
-#define gxg_gtk_cell_renderer_render_w gxg_gtk_cell_renderer_render
-#define gxg_gtk_drag_dest_set_proxy_w gxg_gtk_drag_dest_set_proxy
-#define gxg_gtk_drag_source_set_icon_w gxg_gtk_drag_source_set_icon
-#define gxg_gtk_drag_set_icon_pixmap_w gxg_gtk_drag_set_icon_pixmap
-#define gxg_gtk_icon_set_render_icon_w gxg_gtk_icon_set_render_icon
-#define gxg_gtk_set_locale_w gxg_gtk_set_locale
-#define gxg_gtk_range_set_update_policy_w gxg_gtk_range_set_update_policy
-#define gxg_gtk_range_get_update_policy_w gxg_gtk_range_get_update_policy
-#define gxg_gtk_rc_add_default_file_w gxg_gtk_rc_add_default_file
-#define gxg_gtk_rc_set_default_files_w gxg_gtk_rc_set_default_files
-#define gxg_gtk_rc_get_default_files_w gxg_gtk_rc_get_default_files
-#define gxg_gtk_rc_get_style_w gxg_gtk_rc_get_style
-#define gxg_gtk_rc_parse_w gxg_gtk_rc_parse
-#define gxg_gtk_rc_parse_string_w gxg_gtk_rc_parse_string
-#define gxg_gtk_rc_reparse_all_w gxg_gtk_rc_reparse_all
-#define gxg_gtk_rc_style_new_w gxg_gtk_rc_style_new
-#define gxg_gtk_rc_style_copy_w gxg_gtk_rc_style_copy
-#define gxg_gtk_rc_find_module_in_path_w gxg_gtk_rc_find_module_in_path
-#define gxg_gtk_rc_get_theme_dir_w gxg_gtk_rc_get_theme_dir
-#define gxg_gtk_rc_get_module_dir_w gxg_gtk_rc_get_module_dir
-#define gxg_gtk_rc_get_im_module_path_w gxg_gtk_rc_get_im_module_path
-#define gxg_gtk_rc_get_im_module_file_w gxg_gtk_rc_get_im_module_file
-#define gxg_gtk_style_new_w gxg_gtk_style_new
-#define gxg_gtk_style_copy_w gxg_gtk_style_copy
-#define gxg_gtk_style_attach_w gxg_gtk_style_attach
-#define gxg_gtk_style_detach_w gxg_gtk_style_detach
-#define gxg_gtk_style_set_background_w gxg_gtk_style_set_background
-#define gxg_gtk_style_apply_default_background_w gxg_gtk_style_apply_default_background
-#define gxg_gtk_style_lookup_icon_set_w gxg_gtk_style_lookup_icon_set
-#define gxg_gtk_style_render_icon_w gxg_gtk_style_render_icon
-#define gxg_gtk_tree_view_create_row_drag_icon_w gxg_gtk_tree_view_create_row_drag_icon
-#define gxg_gtk_widget_hide_all_w gxg_gtk_widget_hide_all
-#define gxg_gtk_widget_size_request_w gxg_gtk_widget_size_request
-#define gxg_gtk_widget_get_child_requisition_w gxg_gtk_widget_get_child_requisition
-#define gxg_gtk_widget_get_colormap_w gxg_gtk_widget_get_colormap
-#define gxg_gtk_widget_set_colormap_w gxg_gtk_widget_set_colormap
-#define gxg_gtk_widget_set_style_w gxg_gtk_widget_set_style
-#define gxg_gtk_widget_ensure_style_w gxg_gtk_widget_ensure_style
-#define gxg_gtk_widget_get_style_w gxg_gtk_widget_get_style
-#define gxg_gtk_widget_modify_style_w gxg_gtk_widget_modify_style
-#define gxg_gtk_widget_get_modifier_style_w gxg_gtk_widget_get_modifier_style
-#define gxg_gtk_widget_modify_fg_w gxg_gtk_widget_modify_fg
-#define gxg_gtk_widget_modify_bg_w gxg_gtk_widget_modify_bg
-#define gxg_gtk_widget_modify_text_w gxg_gtk_widget_modify_text
-#define gxg_gtk_widget_modify_base_w gxg_gtk_widget_modify_base
-#define gxg_gtk_widget_modify_font_w gxg_gtk_widget_modify_font
-#define gxg_gtk_widget_render_icon_w gxg_gtk_widget_render_icon
-#define gxg_gtk_widget_reset_rc_styles_w gxg_gtk_widget_reset_rc_styles
-#define gxg_gtk_widget_push_colormap_w gxg_gtk_widget_push_colormap
-#define gxg_gtk_widget_pop_colormap_w gxg_gtk_widget_pop_colormap
-#define gxg_gtk_widget_set_default_colormap_w gxg_gtk_widget_set_default_colormap
-#define gxg_gtk_widget_get_default_style_w gxg_gtk_widget_get_default_style
-#define gxg_gtk_widget_get_default_colormap_w gxg_gtk_widget_get_default_colormap
-#define gxg_gtk_widget_get_default_visual_w gxg_gtk_widget_get_default_visual
-#define gxg_gtk_widget_shape_combine_mask_w gxg_gtk_widget_shape_combine_mask
-#define gxg_gtk_widget_reset_shapes_w gxg_gtk_widget_reset_shapes
-#define gxg_gtk_requisition_copy_w gxg_gtk_requisition_copy
-#define gxg_gtk_requisition_free_w gxg_gtk_requisition_free
-#define gxg_gtk_window_set_has_frame_w gxg_gtk_window_set_has_frame
-#define gxg_gtk_window_get_has_frame_w gxg_gtk_window_get_has_frame
-#define gxg_gtk_window_set_frame_dimensions_w gxg_gtk_window_set_frame_dimensions
-#define gxg_gtk_window_get_frame_dimensions_w gxg_gtk_window_get_frame_dimensions
-#define gxg_gtk_window_remove_embedded_xid_w gxg_gtk_window_remove_embedded_xid
-#define gxg_gtk_window_add_embedded_xid_w gxg_gtk_window_add_embedded_xid
-#define gxg_gdk_screen_get_default_colormap_w gxg_gdk_screen_get_default_colormap
-#define gxg_gdk_screen_set_default_colormap_w gxg_gdk_screen_set_default_colormap
-#define gxg_gdk_screen_get_system_colormap_w gxg_gdk_screen_get_system_colormap
-#define gxg_gtk_cell_view_get_size_of_row_w gxg_gtk_cell_view_get_size_of_row
-#define gxg_gtk_style_lookup_color_w gxg_gtk_style_lookup_color
+#if GTK_CHECK_VERSION(3, 12, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_FLOW_BOX_w, gxg_GTK_IS_FLOW_BOX)
+Xen_wrap_1_arg(gxg_GTK_IS_FLOW_BOX_CHILD_w, gxg_GTK_IS_FLOW_BOX_CHILD)
+Xen_wrap_1_arg(gxg_GTK_IS_ACTION_BAR_w, gxg_GTK_IS_ACTION_BAR)
+Xen_wrap_1_arg(gxg_GTK_IS_POPOVER_w, gxg_GTK_IS_POPOVER)
#endif
-#define gxg_cairo_create_w gxg_cairo_create
-#define gxg_cairo_version_w gxg_cairo_version
-#define gxg_cairo_version_string_w gxg_cairo_version_string
-#define gxg_cairo_reference_w gxg_cairo_reference
-#define gxg_cairo_destroy_w gxg_cairo_destroy
-#define gxg_cairo_save_w gxg_cairo_save
-#define gxg_cairo_restore_w gxg_cairo_restore
-#define gxg_cairo_push_group_w gxg_cairo_push_group
-#define gxg_cairo_push_group_with_content_w gxg_cairo_push_group_with_content
-#define gxg_cairo_pop_group_w gxg_cairo_pop_group
-#define gxg_cairo_pop_group_to_source_w gxg_cairo_pop_group_to_source
-#define gxg_cairo_set_operator_w gxg_cairo_set_operator
-#define gxg_cairo_set_source_w gxg_cairo_set_source
-#define gxg_cairo_set_source_rgb_w gxg_cairo_set_source_rgb
-#define gxg_cairo_set_source_rgba_w gxg_cairo_set_source_rgba
-#define gxg_cairo_set_source_surface_w gxg_cairo_set_source_surface
-#define gxg_cairo_set_tolerance_w gxg_cairo_set_tolerance
-#define gxg_cairo_set_antialias_w gxg_cairo_set_antialias
-#define gxg_cairo_set_fill_rule_w gxg_cairo_set_fill_rule
-#define gxg_cairo_set_line_width_w gxg_cairo_set_line_width
-#define gxg_cairo_set_line_cap_w gxg_cairo_set_line_cap
-#define gxg_cairo_set_line_join_w gxg_cairo_set_line_join
-#define gxg_cairo_set_dash_w gxg_cairo_set_dash
-#define gxg_cairo_set_miter_limit_w gxg_cairo_set_miter_limit
-#define gxg_cairo_translate_w gxg_cairo_translate
-#define gxg_cairo_scale_w gxg_cairo_scale
-#define gxg_cairo_rotate_w gxg_cairo_rotate
-#define gxg_cairo_transform_w gxg_cairo_transform
-#define gxg_cairo_set_matrix_w gxg_cairo_set_matrix
-#define gxg_cairo_identity_matrix_w gxg_cairo_identity_matrix
-#define gxg_cairo_user_to_device_w gxg_cairo_user_to_device
-#define gxg_cairo_user_to_device_distance_w gxg_cairo_user_to_device_distance
-#define gxg_cairo_device_to_user_w gxg_cairo_device_to_user
-#define gxg_cairo_device_to_user_distance_w gxg_cairo_device_to_user_distance
-#define gxg_cairo_new_path_w gxg_cairo_new_path
-#define gxg_cairo_move_to_w gxg_cairo_move_to
-#define gxg_cairo_new_sub_path_w gxg_cairo_new_sub_path
-#define gxg_cairo_line_to_w gxg_cairo_line_to
-#define gxg_cairo_curve_to_w gxg_cairo_curve_to
-#define gxg_cairo_arc_w gxg_cairo_arc
-#define gxg_cairo_arc_negative_w gxg_cairo_arc_negative
-#define gxg_cairo_rel_move_to_w gxg_cairo_rel_move_to
-#define gxg_cairo_rel_line_to_w gxg_cairo_rel_line_to
-#define gxg_cairo_rel_curve_to_w gxg_cairo_rel_curve_to
-#define gxg_cairo_rectangle_w gxg_cairo_rectangle
-#define gxg_cairo_close_path_w gxg_cairo_close_path
-#define gxg_cairo_paint_w gxg_cairo_paint
-#define gxg_cairo_paint_with_alpha_w gxg_cairo_paint_with_alpha
-#define gxg_cairo_mask_w gxg_cairo_mask
-#define gxg_cairo_mask_surface_w gxg_cairo_mask_surface
-#define gxg_cairo_stroke_w gxg_cairo_stroke
-#define gxg_cairo_stroke_preserve_w gxg_cairo_stroke_preserve
-#define gxg_cairo_fill_w gxg_cairo_fill
-#define gxg_cairo_fill_preserve_w gxg_cairo_fill_preserve
-#define gxg_cairo_copy_page_w gxg_cairo_copy_page
-#define gxg_cairo_show_page_w gxg_cairo_show_page
-#define gxg_cairo_in_stroke_w gxg_cairo_in_stroke
-#define gxg_cairo_in_fill_w gxg_cairo_in_fill
-#define gxg_cairo_reset_clip_w gxg_cairo_reset_clip
-#define gxg_cairo_clip_w gxg_cairo_clip
-#define gxg_cairo_clip_preserve_w gxg_cairo_clip_preserve
-#define gxg_cairo_font_options_create_w gxg_cairo_font_options_create
-#define gxg_cairo_font_options_copy_w gxg_cairo_font_options_copy
-#define gxg_cairo_font_options_destroy_w gxg_cairo_font_options_destroy
-#define gxg_cairo_font_options_status_w gxg_cairo_font_options_status
-#define gxg_cairo_font_options_merge_w gxg_cairo_font_options_merge
-#define gxg_cairo_font_options_equal_w gxg_cairo_font_options_equal
-#define gxg_cairo_font_options_hash_w gxg_cairo_font_options_hash
-#define gxg_cairo_font_options_set_antialias_w gxg_cairo_font_options_set_antialias
-#define gxg_cairo_font_options_get_antialias_w gxg_cairo_font_options_get_antialias
-#define gxg_cairo_font_options_set_subpixel_order_w gxg_cairo_font_options_set_subpixel_order
-#define gxg_cairo_font_options_get_subpixel_order_w gxg_cairo_font_options_get_subpixel_order
-#define gxg_cairo_font_options_set_hint_style_w gxg_cairo_font_options_set_hint_style
-#define gxg_cairo_font_options_get_hint_style_w gxg_cairo_font_options_get_hint_style
-#define gxg_cairo_font_options_set_hint_metrics_w gxg_cairo_font_options_set_hint_metrics
-#define gxg_cairo_font_options_get_hint_metrics_w gxg_cairo_font_options_get_hint_metrics
-#define gxg_cairo_select_font_face_w gxg_cairo_select_font_face
-#define gxg_cairo_set_font_size_w gxg_cairo_set_font_size
-#define gxg_cairo_set_font_matrix_w gxg_cairo_set_font_matrix
-#define gxg_cairo_get_font_matrix_w gxg_cairo_get_font_matrix
-#define gxg_cairo_set_font_options_w gxg_cairo_set_font_options
-#define gxg_cairo_get_font_options_w gxg_cairo_get_font_options
-#define gxg_cairo_set_scaled_font_w gxg_cairo_set_scaled_font
-#define gxg_cairo_show_text_w gxg_cairo_show_text
-#define gxg_cairo_show_glyphs_w gxg_cairo_show_glyphs
-#define gxg_cairo_get_font_face_w gxg_cairo_get_font_face
-#define gxg_cairo_font_extents_w gxg_cairo_font_extents
-#define gxg_cairo_set_font_face_w gxg_cairo_set_font_face
-#define gxg_cairo_text_extents_w gxg_cairo_text_extents
-#define gxg_cairo_glyph_extents_w gxg_cairo_glyph_extents
-#define gxg_cairo_text_path_w gxg_cairo_text_path
-#define gxg_cairo_glyph_path_w gxg_cairo_glyph_path
-#define gxg_cairo_font_face_reference_w gxg_cairo_font_face_reference
-#define gxg_cairo_font_face_destroy_w gxg_cairo_font_face_destroy
-#define gxg_cairo_font_face_status_w gxg_cairo_font_face_status
-#define gxg_cairo_font_face_get_user_data_w gxg_cairo_font_face_get_user_data
-#define gxg_cairo_font_face_set_user_data_w gxg_cairo_font_face_set_user_data
-#define gxg_cairo_scaled_font_create_w gxg_cairo_scaled_font_create
-#define gxg_cairo_scaled_font_reference_w gxg_cairo_scaled_font_reference
-#define gxg_cairo_scaled_font_destroy_w gxg_cairo_scaled_font_destroy
-#define gxg_cairo_scaled_font_status_w gxg_cairo_scaled_font_status
-#define gxg_cairo_scaled_font_extents_w gxg_cairo_scaled_font_extents
-#define gxg_cairo_scaled_font_text_extents_w gxg_cairo_scaled_font_text_extents
-#define gxg_cairo_scaled_font_glyph_extents_w gxg_cairo_scaled_font_glyph_extents
-#define gxg_cairo_scaled_font_get_font_face_w gxg_cairo_scaled_font_get_font_face
-#define gxg_cairo_scaled_font_get_font_matrix_w gxg_cairo_scaled_font_get_font_matrix
-#define gxg_cairo_scaled_font_get_ctm_w gxg_cairo_scaled_font_get_ctm
-#define gxg_cairo_scaled_font_get_font_options_w gxg_cairo_scaled_font_get_font_options
-#define gxg_cairo_get_operator_w gxg_cairo_get_operator
-#define gxg_cairo_get_source_w gxg_cairo_get_source
-#define gxg_cairo_get_tolerance_w gxg_cairo_get_tolerance
-#define gxg_cairo_get_antialias_w gxg_cairo_get_antialias
-#define gxg_cairo_get_current_point_w gxg_cairo_get_current_point
-#define gxg_cairo_get_fill_rule_w gxg_cairo_get_fill_rule
-#define gxg_cairo_get_line_width_w gxg_cairo_get_line_width
-#define gxg_cairo_get_line_cap_w gxg_cairo_get_line_cap
-#define gxg_cairo_get_line_join_w gxg_cairo_get_line_join
-#define gxg_cairo_get_miter_limit_w gxg_cairo_get_miter_limit
-#define gxg_cairo_get_matrix_w gxg_cairo_get_matrix
-#define gxg_cairo_get_target_w gxg_cairo_get_target
-#define gxg_cairo_get_group_target_w gxg_cairo_get_group_target
-#define gxg_cairo_copy_path_w gxg_cairo_copy_path
-#define gxg_cairo_copy_path_flat_w gxg_cairo_copy_path_flat
-#define gxg_cairo_append_path_w gxg_cairo_append_path
-#define gxg_cairo_path_destroy_w gxg_cairo_path_destroy
-#define gxg_cairo_status_w gxg_cairo_status
-#define gxg_cairo_status_to_string_w gxg_cairo_status_to_string
-#define gxg_cairo_surface_create_similar_w gxg_cairo_surface_create_similar
-#define gxg_cairo_surface_reference_w gxg_cairo_surface_reference
-#define gxg_cairo_surface_finish_w gxg_cairo_surface_finish
-#define gxg_cairo_surface_destroy_w gxg_cairo_surface_destroy
-#define gxg_cairo_surface_status_w gxg_cairo_surface_status
-#define gxg_cairo_surface_get_content_w gxg_cairo_surface_get_content
-#define gxg_cairo_surface_get_user_data_w gxg_cairo_surface_get_user_data
-#define gxg_cairo_surface_set_user_data_w gxg_cairo_surface_set_user_data
-#define gxg_cairo_surface_get_font_options_w gxg_cairo_surface_get_font_options
-#define gxg_cairo_surface_flush_w gxg_cairo_surface_flush
-#define gxg_cairo_surface_mark_dirty_w gxg_cairo_surface_mark_dirty
-#define gxg_cairo_surface_mark_dirty_rectangle_w gxg_cairo_surface_mark_dirty_rectangle
-#define gxg_cairo_surface_set_device_offset_w gxg_cairo_surface_set_device_offset
-#define gxg_cairo_surface_get_device_offset_w gxg_cairo_surface_get_device_offset
-#define gxg_cairo_surface_set_fallback_resolution_w gxg_cairo_surface_set_fallback_resolution
-#define gxg_cairo_image_surface_create_w gxg_cairo_image_surface_create
-#define gxg_cairo_image_surface_create_for_data_w gxg_cairo_image_surface_create_for_data
-#define gxg_cairo_image_surface_get_data_w gxg_cairo_image_surface_get_data
-#define gxg_cairo_image_surface_get_format_w gxg_cairo_image_surface_get_format
-#define gxg_cairo_image_surface_get_width_w gxg_cairo_image_surface_get_width
-#define gxg_cairo_image_surface_get_height_w gxg_cairo_image_surface_get_height
-#define gxg_cairo_image_surface_get_stride_w gxg_cairo_image_surface_get_stride
-#define gxg_cairo_pattern_create_rgb_w gxg_cairo_pattern_create_rgb
-#define gxg_cairo_pattern_create_rgba_w gxg_cairo_pattern_create_rgba
-#define gxg_cairo_pattern_create_for_surface_w gxg_cairo_pattern_create_for_surface
-#define gxg_cairo_pattern_create_linear_w gxg_cairo_pattern_create_linear
-#define gxg_cairo_pattern_create_radial_w gxg_cairo_pattern_create_radial
-#define gxg_cairo_pattern_reference_w gxg_cairo_pattern_reference
-#define gxg_cairo_pattern_destroy_w gxg_cairo_pattern_destroy
-#define gxg_cairo_pattern_status_w gxg_cairo_pattern_status
-#define gxg_cairo_pattern_add_color_stop_rgb_w gxg_cairo_pattern_add_color_stop_rgb
-#define gxg_cairo_pattern_add_color_stop_rgba_w gxg_cairo_pattern_add_color_stop_rgba
-#define gxg_cairo_pattern_set_matrix_w gxg_cairo_pattern_set_matrix
-#define gxg_cairo_pattern_get_matrix_w gxg_cairo_pattern_get_matrix
-#define gxg_cairo_pattern_set_extend_w gxg_cairo_pattern_set_extend
-#define gxg_cairo_pattern_get_extend_w gxg_cairo_pattern_get_extend
-#define gxg_cairo_pattern_set_filter_w gxg_cairo_pattern_set_filter
-#define gxg_cairo_pattern_get_filter_w gxg_cairo_pattern_get_filter
-#define gxg_cairo_matrix_init_w gxg_cairo_matrix_init
-#define gxg_cairo_matrix_init_identity_w gxg_cairo_matrix_init_identity
-#define gxg_cairo_matrix_init_translate_w gxg_cairo_matrix_init_translate
-#define gxg_cairo_matrix_init_scale_w gxg_cairo_matrix_init_scale
-#define gxg_cairo_matrix_init_rotate_w gxg_cairo_matrix_init_rotate
-#define gxg_cairo_matrix_translate_w gxg_cairo_matrix_translate
-#define gxg_cairo_matrix_scale_w gxg_cairo_matrix_scale
-#define gxg_cairo_matrix_rotate_w gxg_cairo_matrix_rotate
-#define gxg_cairo_matrix_invert_w gxg_cairo_matrix_invert
-#define gxg_cairo_matrix_multiply_w gxg_cairo_matrix_multiply
-#define gxg_cairo_matrix_transform_distance_w gxg_cairo_matrix_transform_distance
-#define gxg_cairo_matrix_transform_point_w gxg_cairo_matrix_transform_point
-#define gxg_cairo_get_reference_count_w gxg_cairo_get_reference_count
-#define gxg_cairo_get_user_data_w gxg_cairo_get_user_data
-#define gxg_cairo_set_user_data_w gxg_cairo_set_user_data
-#define gxg_cairo_clip_extents_w gxg_cairo_clip_extents
-#define gxg_cairo_copy_clip_rectangle_list_w gxg_cairo_copy_clip_rectangle_list
-#define gxg_cairo_rectangle_list_destroy_w gxg_cairo_rectangle_list_destroy
-#define gxg_cairo_font_face_get_reference_count_w gxg_cairo_font_face_get_reference_count
-#define gxg_cairo_scaled_font_get_reference_count_w gxg_cairo_scaled_font_get_reference_count
-#define gxg_cairo_scaled_font_get_user_data_w gxg_cairo_scaled_font_get_user_data
-#define gxg_cairo_scaled_font_set_user_data_w gxg_cairo_scaled_font_set_user_data
-#define gxg_cairo_get_dash_count_w gxg_cairo_get_dash_count
-#define gxg_cairo_get_dash_w gxg_cairo_get_dash
-#define gxg_cairo_surface_get_reference_count_w gxg_cairo_surface_get_reference_count
-#define gxg_cairo_pattern_get_reference_count_w gxg_cairo_pattern_get_reference_count
-#define gxg_cairo_pattern_get_user_data_w gxg_cairo_pattern_get_user_data
-#define gxg_cairo_pattern_set_user_data_w gxg_cairo_pattern_set_user_data
-#define gxg_cairo_pattern_get_rgba_w gxg_cairo_pattern_get_rgba
-#define gxg_cairo_pattern_get_surface_w gxg_cairo_pattern_get_surface
-#define gxg_cairo_pattern_get_color_stop_rgba_w gxg_cairo_pattern_get_color_stop_rgba
-#define gxg_cairo_pattern_get_color_stop_count_w gxg_cairo_pattern_get_color_stop_count
-#define gxg_cairo_pattern_get_linear_points_w gxg_cairo_pattern_get_linear_points
-#define gxg_cairo_pattern_get_radial_circles_w gxg_cairo_pattern_get_radial_circles
-#define gxg_cairo_get_scaled_font_w gxg_cairo_get_scaled_font
-#define gxg_cairo_path_extents_w gxg_cairo_path_extents
-#define gxg_cairo_has_current_point_w gxg_cairo_has_current_point
-#define gxg_cairo_surface_copy_page_w gxg_cairo_surface_copy_page
-#define gxg_cairo_surface_show_page_w gxg_cairo_surface_show_page
-#define gxg_cairo_format_stride_for_width_w gxg_cairo_format_stride_for_width
-#define gxg_cairo_image_surface_create_from_png_w gxg_cairo_image_surface_create_from_png
-#define gxg_cairo_surface_write_to_png_w gxg_cairo_surface_write_to_png
-#if HAVE_CAIRO_GLYPH_ALLOCATE
-#define gxg_cairo_glyph_allocate_w gxg_cairo_glyph_allocate
-#define gxg_cairo_glyph_free_w gxg_cairo_glyph_free
-#define gxg_cairo_text_cluster_allocate_w gxg_cairo_text_cluster_allocate
-#define gxg_cairo_text_cluster_free_w gxg_cairo_text_cluster_free
-#define gxg_cairo_show_text_glyphs_w gxg_cairo_show_text_glyphs
-#define gxg_cairo_scaled_font_text_to_glyphs_w gxg_cairo_scaled_font_text_to_glyphs
-#define gxg_cairo_scaled_font_get_scale_matrix_w gxg_cairo_scaled_font_get_scale_matrix
-#define gxg_cairo_toy_font_face_create_w gxg_cairo_toy_font_face_create
-#define gxg_cairo_toy_font_face_get_family_w gxg_cairo_toy_font_face_get_family
-#define gxg_cairo_toy_font_face_get_slant_w gxg_cairo_toy_font_face_get_slant
-#define gxg_cairo_toy_font_face_get_weight_w gxg_cairo_toy_font_face_get_weight
-#define gxg_cairo_user_font_face_create_w gxg_cairo_user_font_face_create
-#define gxg_cairo_surface_get_fallback_resolution_w gxg_cairo_surface_get_fallback_resolution
-#define gxg_cairo_surface_has_show_text_glyphs_w gxg_cairo_surface_has_show_text_glyphs
+#if GTK_CHECK_VERSION(3, 14, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_w, gxg_GTK_IS_GESTURE)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_DRAG_w, gxg_GTK_IS_GESTURE_DRAG)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_LONG_PRESS_w, gxg_GTK_IS_GESTURE_LONG_PRESS)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_ZOOM_w, gxg_GTK_IS_GESTURE_ZOOM)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_SWIPE_w, gxg_GTK_IS_GESTURE_SWIPE)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_SINGLE_w, gxg_GTK_IS_GESTURE_SINGLE)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_PAN_w, gxg_GTK_IS_GESTURE_PAN)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_MULTI_PRESS_w, gxg_GTK_IS_GESTURE_MULTI_PRESS)
+Xen_wrap_1_arg(gxg_GTK_IS_GESTURE_ROTATE_w, gxg_GTK_IS_GESTURE_ROTATE)
+Xen_wrap_1_arg(gxg_GTK_IS_EVENT_CONTROLLER_w, gxg_GTK_IS_EVENT_CONTROLLER)
#endif
-#if HAVE_CAIRO_REGION_XOR
-#define gxg_cairo_in_clip_w gxg_cairo_in_clip
-#define gxg_cairo_device_reference_w gxg_cairo_device_reference
-#define gxg_cairo_device_status_w gxg_cairo_device_status
-#define gxg_cairo_device_acquire_w gxg_cairo_device_acquire
-#define gxg_cairo_device_release_w gxg_cairo_device_release
-#define gxg_cairo_device_flush_w gxg_cairo_device_flush
-#define gxg_cairo_device_finish_w gxg_cairo_device_finish
-#define gxg_cairo_device_destroy_w gxg_cairo_device_destroy
-#define gxg_cairo_device_get_reference_count_w gxg_cairo_device_get_reference_count
-#define gxg_cairo_device_get_user_data_w gxg_cairo_device_get_user_data
-#define gxg_cairo_device_set_user_data_w gxg_cairo_device_set_user_data
-#define gxg_cairo_surface_create_for_rectangle_w gxg_cairo_surface_create_for_rectangle
-#define gxg_cairo_surface_get_device_w gxg_cairo_surface_get_device
-#define gxg_cairo_surface_set_mime_data_w gxg_cairo_surface_set_mime_data
-#define gxg_cairo_recording_surface_create_w gxg_cairo_recording_surface_create
-#define gxg_cairo_recording_surface_ink_extents_w gxg_cairo_recording_surface_ink_extents
-#define gxg_cairo_region_create_w gxg_cairo_region_create
-#define gxg_cairo_region_create_rectangle_w gxg_cairo_region_create_rectangle
-#define gxg_cairo_region_create_rectangles_w gxg_cairo_region_create_rectangles
-#define gxg_cairo_region_copy_w gxg_cairo_region_copy
-#define gxg_cairo_region_reference_w gxg_cairo_region_reference
-#define gxg_cairo_region_destroy_w gxg_cairo_region_destroy
-#define gxg_cairo_region_equal_w gxg_cairo_region_equal
-#define gxg_cairo_region_status_w gxg_cairo_region_status
-#define gxg_cairo_region_get_extents_w gxg_cairo_region_get_extents
-#define gxg_cairo_region_num_rectangles_w gxg_cairo_region_num_rectangles
-#define gxg_cairo_region_get_rectangle_w gxg_cairo_region_get_rectangle
-#define gxg_cairo_region_is_empty_w gxg_cairo_region_is_empty
-#define gxg_cairo_region_contains_rectangle_w gxg_cairo_region_contains_rectangle
-#define gxg_cairo_region_contains_point_w gxg_cairo_region_contains_point
-#define gxg_cairo_region_translate_w gxg_cairo_region_translate
-#define gxg_cairo_region_subtract_w gxg_cairo_region_subtract
-#define gxg_cairo_region_subtract_rectangle_w gxg_cairo_region_subtract_rectangle
-#define gxg_cairo_region_intersect_w gxg_cairo_region_intersect
-#define gxg_cairo_region_intersect_rectangle_w gxg_cairo_region_intersect_rectangle
-#define gxg_cairo_region_union_w gxg_cairo_region_union
-#define gxg_cairo_region_union_rectangle_w gxg_cairo_region_union_rectangle
-#define gxg_cairo_region_xor_w gxg_cairo_region_xor
-#define gxg_cairo_region_xor_rectangle_w gxg_cairo_region_xor_rectangle
+#if GTK_CHECK_VERSION(3, 16, 0)
+Xen_wrap_1_arg(gxg_GTK_IS_GL_AREA_w, gxg_GTK_IS_GL_AREA)
+Xen_wrap_1_arg(gxg_GDK_IS_GL_CONTEXT_w, gxg_GDK_IS_GL_CONTEXT)
+Xen_wrap_1_arg(gxg_GTK_IS_POPOVER_MENU_w, gxg_GTK_IS_POPOVER_MENU)
+Xen_wrap_1_arg(gxg_GTK_IS_STACK_SIDEBAR_w, gxg_GTK_IS_STACK_SIDEBAR)
#endif
-#define gxg_GPOINTER_w gxg_GPOINTER
-#define c_array_to_xen_list_w c_array_to_xen_list
-#define xen_list_to_c_array_w xen_list_to_c_array
-#define gxg_make_target_entry_w gxg_make_target_entry
-#define c_to_xen_string_w c_to_xen_string
-#define xg_object_get_w xg_object_get
-#define xg_gtk_event_keyval_w xg_gtk_event_keyval
-#define gxg_gtk_init_w gxg_gtk_init
-#define gxg_gtk_init_check_w gxg_gtk_init_check
-#define gxg_GDK_DRAG_CONTEXT_w gxg_GDK_DRAG_CONTEXT
-#define gxg_GDK_DEVICE_w gxg_GDK_DEVICE
-#define gxg_GDK_KEYMAP_w gxg_GDK_KEYMAP
-#define gxg_GDK_VISUAL_w gxg_GDK_VISUAL
-#define gxg_GDK_WINDOW_w gxg_GDK_WINDOW
-#define gxg_GDK_PIXBUF_w gxg_GDK_PIXBUF
-#define gxg_GDK_PIXBUF_ANIMATION_w gxg_GDK_PIXBUF_ANIMATION
-#define gxg_GDK_PIXBUF_ANIMATION_ITER_w gxg_GDK_PIXBUF_ANIMATION_ITER
-#define gxg_GTK_VBOX_w gxg_GTK_VBOX
-#define gxg_GTK_ACCEL_GROUP_w gxg_GTK_ACCEL_GROUP
-#define gxg_GTK_ACCEL_LABEL_w gxg_GTK_ACCEL_LABEL
-#define gxg_GTK_ACCESSIBLE_w gxg_GTK_ACCESSIBLE
-#define gxg_GTK_ADJUSTMENT_w gxg_GTK_ADJUSTMENT
-#define gxg_GTK_ALIGNMENT_w gxg_GTK_ALIGNMENT
-#define gxg_GTK_ARROW_w gxg_GTK_ARROW
-#define gxg_GTK_ASPECT_FRAME_w gxg_GTK_ASPECT_FRAME
-#define gxg_GTK_BUTTON_BOX_w gxg_GTK_BUTTON_BOX
-#define gxg_GTK_BIN_w gxg_GTK_BIN
-#define gxg_GTK_BOX_w gxg_GTK_BOX
-#define gxg_GTK_BUTTON_w gxg_GTK_BUTTON
-#define gxg_GTK_CALENDAR_w gxg_GTK_CALENDAR
-#define gxg_GTK_CELL_EDITABLE_w gxg_GTK_CELL_EDITABLE
-#define gxg_GTK_CELL_RENDERER_w gxg_GTK_CELL_RENDERER
-#define gxg_GTK_CELL_RENDERER_PIXBUF_w gxg_GTK_CELL_RENDERER_PIXBUF
-#define gxg_GTK_CELL_RENDERER_TEXT_w gxg_GTK_CELL_RENDERER_TEXT
-#define gxg_GTK_CELL_RENDERER_TOGGLE_w gxg_GTK_CELL_RENDERER_TOGGLE
-#define gxg_GTK_CHECK_BUTTON_w gxg_GTK_CHECK_BUTTON
-#define gxg_GTK_CHECK_MENU_ITEM_w gxg_GTK_CHECK_MENU_ITEM
-#define gxg_GTK_COLOR_SELECTION_DIALOG_w gxg_GTK_COLOR_SELECTION_DIALOG
-#define gxg_GTK_COLOR_SELECTION_w gxg_GTK_COLOR_SELECTION
-#define gxg_GTK_CONTAINER_w gxg_GTK_CONTAINER
-#define gxg_GTK_DIALOG_w gxg_GTK_DIALOG
-#define gxg_GTK_DRAWING_AREA_w gxg_GTK_DRAWING_AREA
-#define gxg_GTK_EDITABLE_w gxg_GTK_EDITABLE
-#define gxg_GTK_ENTRY_w gxg_GTK_ENTRY
-#define gxg_GTK_EVENT_BOX_w gxg_GTK_EVENT_BOX
-#define gxg_GTK_FIXED_w gxg_GTK_FIXED
-#define gxg_GTK_FONT_SELECTION_w gxg_GTK_FONT_SELECTION
-#define gxg_GTK_FONT_SELECTION_DIALOG_w gxg_GTK_FONT_SELECTION_DIALOG
-#define gxg_GTK_FRAME_w gxg_GTK_FRAME
-#define gxg_GTK_HANDLE_BOX_w gxg_GTK_HANDLE_BOX
-#define gxg_GTK_HBUTTON_BOX_w gxg_GTK_HBUTTON_BOX
-#define gxg_GTK_HBOX_w gxg_GTK_HBOX
-#define gxg_GTK_HPANED_w gxg_GTK_HPANED
-#define gxg_GTK_HSCALE_w gxg_GTK_HSCALE
-#define gxg_GTK_HSCROLLBAR_w gxg_GTK_HSCROLLBAR
-#define gxg_GTK_HSEPARATOR_w gxg_GTK_HSEPARATOR
-#define gxg_GTK_ICON_FACTORY_w gxg_GTK_ICON_FACTORY
-#define gxg_GTK_IMAGE_w gxg_GTK_IMAGE
-#define gxg_GTK_IMAGE_MENU_ITEM_w gxg_GTK_IMAGE_MENU_ITEM
-#define gxg_GTK_IM_CONTEXT_w gxg_GTK_IM_CONTEXT
-#define gxg_GTK_IM_CONTEXT_SIMPLE_w gxg_GTK_IM_CONTEXT_SIMPLE
-#define gxg_GTK_IM_MULTICONTEXT_w gxg_GTK_IM_MULTICONTEXT
-#define gxg_GTK_INVISIBLE_w gxg_GTK_INVISIBLE
-#define gxg_GTK_LABEL_w gxg_GTK_LABEL
-#define gxg_GTK_LAYOUT_w gxg_GTK_LAYOUT
-#define gxg_GTK_LIST_STORE_w gxg_GTK_LIST_STORE
-#define gxg_GTK_MENU_BAR_w gxg_GTK_MENU_BAR
-#define gxg_GTK_MENU_w gxg_GTK_MENU
-#define gxg_GTK_MENU_ITEM_w gxg_GTK_MENU_ITEM
-#define gxg_GTK_MENU_SHELL_w gxg_GTK_MENU_SHELL
-#define gxg_GTK_MISC_w gxg_GTK_MISC
-#define gxg_GTK_NOTEBOOK_w gxg_GTK_NOTEBOOK
-#define gxg_GTK_PANED_w gxg_GTK_PANED
-#define gxg_GTK_PROGRESS_BAR_w gxg_GTK_PROGRESS_BAR
-#define gxg_GTK_RADIO_BUTTON_w gxg_GTK_RADIO_BUTTON
-#define gxg_GTK_RADIO_MENU_ITEM_w gxg_GTK_RADIO_MENU_ITEM
-#define gxg_GTK_RANGE_w gxg_GTK_RANGE
-#define gxg_GTK_SCALE_w gxg_GTK_SCALE
-#define gxg_GTK_SCROLLBAR_w gxg_GTK_SCROLLBAR
-#define gxg_GTK_SCROLLED_WINDOW_w gxg_GTK_SCROLLED_WINDOW
-#define gxg_GTK_SEPARATOR_w gxg_GTK_SEPARATOR
-#define gxg_GTK_SEPARATOR_MENU_ITEM_w gxg_GTK_SEPARATOR_MENU_ITEM
-#define gxg_GTK_SIZE_GROUP_w gxg_GTK_SIZE_GROUP
-#define gxg_GTK_SPIN_BUTTON_w gxg_GTK_SPIN_BUTTON
-#define gxg_GTK_STATUSBAR_w gxg_GTK_STATUSBAR
-#define gxg_GTK_TABLE_w gxg_GTK_TABLE
-#define gxg_GTK_TEAROFF_MENU_ITEM_w gxg_GTK_TEAROFF_MENU_ITEM
-#define gxg_GTK_TEXT_BUFFER_w gxg_GTK_TEXT_BUFFER
-#define gxg_GTK_TEXT_CHILD_ANCHOR_w gxg_GTK_TEXT_CHILD_ANCHOR
-#define gxg_GTK_TEXT_MARK_w gxg_GTK_TEXT_MARK
-#define gxg_GTK_TEXT_TAG_w gxg_GTK_TEXT_TAG
-#define gxg_GTK_TEXT_TAG_TABLE_w gxg_GTK_TEXT_TAG_TABLE
-#define gxg_GTK_TEXT_VIEW_w gxg_GTK_TEXT_VIEW
-#define gxg_GTK_TOGGLE_BUTTON_w gxg_GTK_TOGGLE_BUTTON
-#define gxg_GTK_TOOLBAR_w gxg_GTK_TOOLBAR
-#define gxg_GTK_TREE_DRAG_SOURCE_w gxg_GTK_TREE_DRAG_SOURCE
-#define gxg_GTK_TREE_DRAG_DEST_w gxg_GTK_TREE_DRAG_DEST
-#define gxg_GTK_TREE_MODEL_w gxg_GTK_TREE_MODEL
-#define gxg_GTK_TREE_MODEL_SORT_w gxg_GTK_TREE_MODEL_SORT
-#define gxg_GTK_TREE_SELECTION_w gxg_GTK_TREE_SELECTION
-#define gxg_GTK_TREE_SORTABLE_w gxg_GTK_TREE_SORTABLE
-#define gxg_GTK_TREE_STORE_w gxg_GTK_TREE_STORE
-#define gxg_GTK_TREE_VIEW_COLUMN_w gxg_GTK_TREE_VIEW_COLUMN
-#define gxg_GTK_TREE_VIEW_w gxg_GTK_TREE_VIEW
-#define gxg_GTK_VBUTTON_BOX_w gxg_GTK_VBUTTON_BOX
-#define gxg_GTK_VIEWPORT_w gxg_GTK_VIEWPORT
-#define gxg_GTK_VPANED_w gxg_GTK_VPANED
-#define gxg_GTK_VSCALE_w gxg_GTK_VSCALE
-#define gxg_GTK_VSCROLLBAR_w gxg_GTK_VSCROLLBAR
-#define gxg_GTK_VSEPARATOR_w gxg_GTK_VSEPARATOR
-#define gxg_GTK_WIDGET_w gxg_GTK_WIDGET
-#define gxg_GTK_WINDOW_w gxg_GTK_WINDOW
-#define gxg_PANGO_CONTEXT_w gxg_PANGO_CONTEXT
-#define gxg_PANGO_FONT_FAMILY_w gxg_PANGO_FONT_FAMILY
-#define gxg_PANGO_FONT_FACE_w gxg_PANGO_FONT_FACE
-#define gxg_PANGO_FONT_w gxg_PANGO_FONT
-#define gxg_PANGO_FONT_MAP_w gxg_PANGO_FONT_MAP
-#define gxg_PANGO_LAYOUT_w gxg_PANGO_LAYOUT
-#define gxg_G_OBJECT_w gxg_G_OBJECT
-#define gxg_GDK_SCREEN_w gxg_GDK_SCREEN
-#define gxg_GDK_DISPLAY_OBJECT_w gxg_GDK_DISPLAY_OBJECT
-#define gxg_GDK_EVENT_w gxg_GDK_EVENT
-#define gxg_GDK_EVENT_ANY_w gxg_GDK_EVENT_ANY
-#define gxg_GDK_EVENT_EXPOSE_w gxg_GDK_EVENT_EXPOSE
-#define gxg_GDK_EVENT_NOEXPOSE_w gxg_GDK_EVENT_NOEXPOSE
-#define gxg_GDK_EVENT_VISIBILITY_w gxg_GDK_EVENT_VISIBILITY
-#define gxg_GDK_EVENT_MOTION_w gxg_GDK_EVENT_MOTION
-#define gxg_GDK_EVENT_BUTTON_w gxg_GDK_EVENT_BUTTON
-#define gxg_GDK_EVENT_SCROLL_w gxg_GDK_EVENT_SCROLL
-#define gxg_GDK_EVENT_KEY_w gxg_GDK_EVENT_KEY
-#define gxg_GDK_EVENT_CROSSING_w gxg_GDK_EVENT_CROSSING
-#define gxg_GDK_EVENT_FOCUS_w gxg_GDK_EVENT_FOCUS
-#define gxg_GDK_EVENT_CONFIGURE_w gxg_GDK_EVENT_CONFIGURE
-#define gxg_GDK_EVENT_PROPERTY_w gxg_GDK_EVENT_PROPERTY
-#define gxg_GDK_EVENT_SELECTION_w gxg_GDK_EVENT_SELECTION
-#define gxg_GDK_EVENT_PROXIMITY_w gxg_GDK_EVENT_PROXIMITY
-#define gxg_GDK_EVENT_SETTING_w gxg_GDK_EVENT_SETTING
-#define gxg_GDK_EVENT_WINDOWSTATE_w gxg_GDK_EVENT_WINDOWSTATE
-#define gxg_GDK_EVENT_DND_w gxg_GDK_EVENT_DND
-#define gxg_GTK_FILE_CHOOSER_DIALOG_w gxg_GTK_FILE_CHOOSER_DIALOG
-#define gxg_GTK_FILE_CHOOSER_WIDGET_w gxg_GTK_FILE_CHOOSER_WIDGET
-#define gxg_GTK_TREE_MODEL_FILTER_w gxg_GTK_TREE_MODEL_FILTER
-#define gxg_GTK_ACTION_w gxg_GTK_ACTION
-#define gxg_GTK_ACTION_GROUP_w gxg_GTK_ACTION_GROUP
-#define gxg_GTK_COMBO_BOX_w gxg_GTK_COMBO_BOX
-#define gxg_GTK_EXPANDER_w gxg_GTK_EXPANDER
-#define gxg_GTK_FONT_BUTTON_w gxg_GTK_FONT_BUTTON
-#define gxg_GTK_COLOR_BUTTON_w gxg_GTK_COLOR_BUTTON
-#define gxg_GTK_ENTRY_COMPLETION_w gxg_GTK_ENTRY_COMPLETION
-#define gxg_GTK_RADIO_TOOL_BUTTON_w gxg_GTK_RADIO_TOOL_BUTTON
-#define gxg_GTK_RADIO_ACTION_w gxg_GTK_RADIO_ACTION
-#define gxg_GTK_SEPARATOR_TOOL_ITEM_w gxg_GTK_SEPARATOR_TOOL_ITEM
-#define gxg_GTK_TOGGLE_ACTION_w gxg_GTK_TOGGLE_ACTION
-#define gxg_GTK_TOGGLE_TOOL_BUTTON_w gxg_GTK_TOGGLE_TOOL_BUTTON
-#define gxg_GTK_FILE_FILTER_w gxg_GTK_FILE_FILTER
-#define gxg_GTK_CELL_LAYOUT_w gxg_GTK_CELL_LAYOUT
-#define gxg_GTK_CLIPBOARD_w gxg_GTK_CLIPBOARD
-#define gxg_GTK_FILE_CHOOSER_w gxg_GTK_FILE_CHOOSER
-#define gxg_GTK_ICON_THEME_w gxg_GTK_ICON_THEME
-#define gxg_GTK_TOOL_BUTTON_w gxg_GTK_TOOL_BUTTON
-#define gxg_GTK_TOOL_ITEM_w gxg_GTK_TOOL_ITEM
-#define gxg_GTK_ACCEL_MAP_w gxg_GTK_ACCEL_MAP
-#define gxg_GTK_CELL_VIEW_w gxg_GTK_CELL_VIEW
-#define gxg_GTK_ABOUT_DIALOG_w gxg_GTK_ABOUT_DIALOG
-#define gxg_GTK_CELL_RENDERER_COMBO_w gxg_GTK_CELL_RENDERER_COMBO
-#define gxg_GTK_CELL_RENDERER_PROGRESS_w gxg_GTK_CELL_RENDERER_PROGRESS
-#define gxg_GTK_ICON_VIEW_w gxg_GTK_ICON_VIEW
-#define gxg_GTK_FILE_CHOOSER_BUTTON_w gxg_GTK_FILE_CHOOSER_BUTTON
-#define gxg_GTK_MENU_TOOL_BUTTON_w gxg_GTK_MENU_TOOL_BUTTON
-#define gxg_GTK_ASSISTANT_w gxg_GTK_ASSISTANT
-#define gxg_GTK_CELL_RENDERER_ACCEL_w gxg_GTK_CELL_RENDERER_ACCEL
-#define gxg_GTK_CELL_RENDERER_SPIN_w gxg_GTK_CELL_RENDERER_SPIN
-#define gxg_GTK_LINK_BUTTON_w gxg_GTK_LINK_BUTTON
-#define gxg_GTK_RECENT_CHOOSER_DIALOG_w gxg_GTK_RECENT_CHOOSER_DIALOG
-#define gxg_GTK_RECENT_CHOOSER_w gxg_GTK_RECENT_CHOOSER
-#define gxg_GTK_RECENT_CHOOSER_MENU_w gxg_GTK_RECENT_CHOOSER_MENU
-#define gxg_GTK_RECENT_CHOOSER_WIDGET_w gxg_GTK_RECENT_CHOOSER_WIDGET
-#define gxg_GTK_RECENT_FILTER_w gxg_GTK_RECENT_FILTER
-#define gxg_GTK_RECENT_MANAGER_w gxg_GTK_RECENT_MANAGER
-#define gxg_GTK_STATUS_ICON_w gxg_GTK_STATUS_ICON
-#define gxg_GTK_PRINT_CONTEXT_w gxg_GTK_PRINT_CONTEXT
-#define gxg_GTK_PRINT_OPERATION_w gxg_GTK_PRINT_OPERATION
-#define gxg_GTK_PRINT_OPERATION_PREVIEW_w gxg_GTK_PRINT_OPERATION_PREVIEW
-#define gxg_GTK_PRINT_SETTINGS_w gxg_GTK_PRINT_SETTINGS
-#define gxg_GTK_TOOLTIP_w gxg_GTK_TOOLTIP
-#if HAVE_GTK_INFO_BAR_NEW
-#define gxg_GTK_INFO_BAR_w gxg_GTK_INFO_BAR
+#if HAVE_SCHEME
+static s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_pair_false;
+static s7_pointer pl_tsb, pl_st, pl_tsu, pl_ts, pl_tsi, pl_tsiu, pl_tsiiuui, pl_tsiuui, pl_t, pl_psibiiiit, pl_psrrrb, pl_sui, pl_psu, pl_psb, pl_su, pl_sus, pl_ps, pl_psi, pl_psuit, pl_psut, pl_suuub, pl_p, pl_tts, pl_tti, pl_tusiuiuit, pl_tubu, pl_tuurru, pl_tuurrrrir, pl_tuurrrri, pl_tuuur, pl_tuuuui, pl_tuusb, pl_turru, pl_tuuuub, pl_tuttti, pl_tuuttti, pl_tuisi, pl_turis, pl_tubi, pl_tuttiisi, pl_tuiiiiui, pl_tuurb, pl_tuuiiiirrrri, pl_turrrb, pl_tuubbi, pl_pt, pl_tuuti, pl_tubbi, pl_tusiu, pl_tuuutti, pl_tuti, pl_tutti, pl_tutui, pl_tutisi, pl_tuuri, pl_tusr, pl_tusrt, pl_tusi, pl_turt, pl_tuui, pl_tut, pl_tuur, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tuiiu, pl_tusb, pl_tuuut, pl_tutb, pl_tust, pl_tuub, pl_tuus, pl_tuibu, pl_tuut, pl_tuiui, pl_tuubr, pl_tuuub, pl_tuuui, pl_tuuiuui, pl_tuiu, pl_tuuir, pl_tuir, pl_tuib, pl_tusu, pl_tuusi, pl_tuit, pl_tuis, pl_tubiiiu, pl_tusiis, pl_tusiuiu, pl_tusiuibu, pl_tusiiu, pl_tusui, pl_tuuubr, pl_tuiiiu, pl_tuuiu, pl_tuurbr, pl_tuusit, pl_pur, pl_puiu, pl_pusiiiu, pl_pusiiuiu, pl_puur, pl_puiiui, pl_pubi, pl_puiiu, pl_puuusuui, pl_pu, pl_puutu, pl_pui, pl_pusu, pl_pus, pl_put, pl_pusiiu, pl_pusi, pl_puui, pl_pub, pl_pust, pl_pusub, pl_puri, pl_bi, pl_bsiu, pl_bsiuub, pl_bsu, pl_bsiib, pl_bsiiuusu, pl_b, pl_btiib, pl_bti, pl_bt, pl_tb, pl_bur, pl_buut, pl_buuti, pl_buttiiiu, pl_butib, pl_buiui, pl_buuusuui, pl_buuit, pl_butu, pl_buti, pl_butti, pl_busi, pl_busu, pl_bui, pl_bu, pl_buuubu, pl_bus, pl_buutuuiu, pl_but, pl_bussu, pl_buib, pl_buiu, pl_buiiu, pl_bub, pl_buub, pl_pb, pl_buuiiu, pl_buui, pl_buuui, pl_buus, pl_buurbr, pl_busiu, pl_buttu, pl_buuub, pl_buuuub, pl_busib, pl_buusib, pl_iiit, pl_iit, pl_isiiutttiiu, pl_isi, pl_isit, pl_si, pl_is, pl_i, pl_itiiub, pl_itsub, pl_itsttti, pl_itiiiut, pl_tiu, pl_it, pl_ti, pl_iur, pl_iussitu, pl_iurrsiu, pl_iuut, pl_iuuut, pl_pir, pl_iuisi, pl_pibi, pl_iuuui, pl_iuuuui, pl_ius, pl_iusi, pl_iu, pl_iuiu, pl_iuui, pl_pi, pl_iui, pl_iuisut, pl_piu, pl_pit, pl_iuis, pl_trrru, pl_dusr, pl_dust, pl_dut, pl_du, pl_dus, pl_pr, pl_ssi, pl_s, pl_unused;
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-#define gxg_GTK_ENTRY_BUFFER_w gxg_GTK_ENTRY_BUFFER
+static void define_functions(void)
+{
+ xm_gc_table = Xen_make_vector(1, Xen_false);
+ Xen_GC_protect(xm_gc_table);
+ xm_protected_size = 512;
+ xm_protected = Xen_make_vector(xm_protected_size, Xen_false);
+ Xen_vector_set(xm_gc_table, 0, xm_protected);
+
+#if HAVE_SCHEME
+ s_boolean = s7_make_symbol(s7, "boolean?");
+ s_integer = s7_make_symbol(s7, "integer?");
+ s_real = s7_make_symbol(s7, "real?");
+ s_float = s7_make_symbol(s7, "float?");
+ s_string = s7_make_symbol(s7, "string?");
+ s_pair = s7_make_symbol(s7, "pair?");
+ s_pair_false = s7_make_signature(s7, 2, s_pair, s_boolean);
+ s_any = s7_t(s7);
+
+ pl_tsb = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_boolean);
+ pl_st = s7_make_circular_signature(s7, 1, 2, s_string, s_any);
+ pl_tsu = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_pair_false);
+ pl_ts = s7_make_circular_signature(s7, 1, 2, s_any, s_string);
+ pl_tsi = s7_make_circular_signature(s7, 2, 3, s_any, s_string, s_integer);
+ pl_tsiu = s7_make_circular_signature(s7, 3, 4, s_any, s_string, s_integer, s_pair_false);
+ pl_tsiiuui = s7_make_circular_signature(s7, 6, 7, s_any, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_integer);
+ pl_tsiuui = s7_make_circular_signature(s7, 5, 6, s_any, s_string, s_integer, s_pair_false, s_pair_false, s_integer);
+ pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
+ pl_psibiiiit = s7_make_circular_signature(s7, 8, 9, s_pair, s_string, s_integer, s_boolean, s_integer, s_integer, s_integer, s_integer, s_any);
+ pl_psrrrb = s7_make_circular_signature(s7, 5, 6, s_pair, s_string, s_real, s_real, s_real, s_boolean);
+ pl_sui = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_integer);
+ pl_psu = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_pair_false);
+ pl_psb = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_boolean);
+ pl_su = s7_make_circular_signature(s7, 1, 2, s_string, s_pair_false);
+ pl_sus = s7_make_circular_signature(s7, 2, 3, s_string, s_pair_false, s_string);
+ pl_ps = s7_make_circular_signature(s7, 1, 2, s_pair, s_string);
+ pl_psi = s7_make_circular_signature(s7, 2, 3, s_pair, s_string, s_integer);
+ pl_psuit = s7_make_circular_signature(s7, 4, 5, s_pair, s_string, s_pair_false, s_integer, s_any);
+ pl_psut = s7_make_circular_signature(s7, 3, 4, s_pair, s_string, s_pair_false, s_any);
+ pl_suuub = s7_make_circular_signature(s7, 4, 5, s_string, s_pair_false, s_pair_false, s_pair_false, s_boolean);
+ pl_p = s7_make_circular_signature(s7, 0, 1, s_pair);
+ pl_tts = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_string);
+ pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer);
+ pl_tusiuiuit = s7_make_circular_signature(s7, 8, 9, s_any, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false, s_integer, s_any);
+ pl_tubu = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_boolean, s_pair_false);
+ pl_tuurru = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_real, s_real, s_pair_false);
+ pl_tuurrrrir = s7_make_circular_signature(s7, 8, 9, s_any, s_pair_false, s_pair_false, s_real, s_real, s_real, s_real, s_integer, s_real);
+ pl_tuurrrri = s7_make_circular_signature(s7, 7, 8, s_any, s_pair_false, s_pair_false, s_real, s_real, s_real, s_real, s_integer);
+ pl_tuuur = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_pair_false, s_real);
+ pl_tuuuui = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_integer);
+ pl_tuusb = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_string, s_boolean);
+ pl_turru = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_real, s_real, s_pair_false);
+ pl_tuuuub = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean);
+ pl_tuttti = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_any, s_any, s_any, s_integer);
+ pl_tuuttti = s7_make_circular_signature(s7, 6, 7, s_any, s_pair_false, s_pair_false, s_any, s_any, s_any, s_integer);
+ pl_tuisi = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_integer, s_string, s_integer);
+ pl_turis = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_real, s_integer, s_string);
+ pl_tubi = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_boolean, s_integer);
+ pl_tuttiisi = s7_make_circular_signature(s7, 7, 8, s_any, s_pair_false, s_any, s_any, s_integer, s_integer, s_string, s_integer);
+ pl_tuiiiiui = s7_make_circular_signature(s7, 7, 8, s_any, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_pair_false, s_integer);
+ pl_tuurb = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_real, s_boolean);
+ pl_tuuiiiirrrri = s7_make_circular_signature(s7, 11, 12, s_any, s_pair_false, s_pair_false, s_integer, s_integer, s_integer, s_integer, s_real, s_real, s_real, s_real, s_integer);
+ pl_turrrb = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_real, s_real, s_real, s_boolean);
+ pl_tuubbi = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_boolean, s_boolean, s_integer);
+ pl_pt = s7_make_circular_signature(s7, 1, 2, s_pair, s_any);
+ pl_tuuti = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_any, s_integer);
+ pl_tubbi = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_boolean, s_boolean, s_integer);
+ pl_tusiu = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_string, s_integer, s_pair_false);
+ pl_tuuutti = s7_make_circular_signature(s7, 6, 7, s_any, s_pair_false, s_pair_false, s_pair_false, s_any, s_any, s_integer);
+ pl_tuti = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_any, s_integer);
+ pl_tutti = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_any, s_any, s_integer);
+ pl_tutui = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_any, s_pair_false, s_integer);
+ pl_tutisi = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_any, s_integer, s_string, s_integer);
+ pl_tuuri = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_real, s_integer);
+ pl_tusr = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_string, s_real);
+ pl_tusrt = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_string, s_real, s_any);
+ pl_tusi = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_string, s_integer);
+ pl_turt = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_real, s_any);
+ pl_tuui = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_pair_false, s_integer);
+ pl_tut = s7_make_circular_signature(s7, 2, 3, s_any, s_pair_false, s_any);
+ pl_tuur = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_pair_false, s_real);
+ pl_tur = s7_make_circular_signature(s7, 2, 3, s_any, s_pair_false, s_real);
+ pl_tub = s7_make_circular_signature(s7, 2, 3, s_any, s_pair_false, s_boolean);
+ pl_tui = s7_make_circular_signature(s7, 2, 3, s_any, s_pair_false, s_integer);
+ pl_tu = s7_make_circular_signature(s7, 1, 2, s_any, s_pair_false);
+ pl_tus = s7_make_circular_signature(s7, 2, 3, s_any, s_pair_false, s_string);
+ pl_tuiiu = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_integer, s_integer, s_pair_false);
+ pl_tusb = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_string, s_boolean);
+ pl_tuuut = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_pair_false, s_any);
+ pl_tutb = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_any, s_boolean);
+ pl_tust = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_string, s_any);
+ pl_tuub = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_pair_false, s_boolean);
+ pl_tuus = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_pair_false, s_string);
+ pl_tuibu = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_integer, s_boolean, s_pair_false);
+ pl_tuut = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_pair_false, s_any);
+ pl_tuiui = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_integer, s_pair_false, s_integer);
+ pl_tuubr = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_boolean, s_real);
+ pl_tuuub = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_pair_false, s_boolean);
+ pl_tuuui = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_pair_false, s_integer);
+ pl_tuuiuui = s7_make_circular_signature(s7, 6, 7, s_any, s_pair_false, s_pair_false, s_integer, s_pair_false, s_pair_false, s_integer);
+ pl_tuiu = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_integer, s_pair_false);
+ pl_tuuir = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_integer, s_real);
+ pl_tuir = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_integer, s_real);
+ pl_tuib = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_integer, s_boolean);
+ pl_tusu = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_string, s_pair_false);
+ pl_tuusi = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_string, s_integer);
+ pl_tuit = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_integer, s_any);
+ pl_tuis = s7_make_circular_signature(s7, 3, 4, s_any, s_pair_false, s_integer, s_string);
+ pl_tubiiiu = s7_make_circular_signature(s7, 6, 7, s_any, s_pair_false, s_boolean, s_integer, s_integer, s_integer, s_pair_false);
+ pl_tusiis = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_string, s_integer, s_integer, s_string);
+ pl_tusiuiu = s7_make_circular_signature(s7, 6, 7, s_any, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_pair_false);
+ pl_tusiuibu = s7_make_circular_signature(s7, 7, 8, s_any, s_pair_false, s_string, s_integer, s_pair_false, s_integer, s_boolean, s_pair_false);
+ pl_tusiiu = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_string, s_integer, s_integer, s_pair_false);
+ pl_tusui = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_string, s_pair_false, s_integer);
+ pl_tuuubr = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_real);
+ pl_tuiiiu = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_integer, s_integer, s_integer, s_pair_false);
+ pl_tuuiu = s7_make_circular_signature(s7, 4, 5, s_any, s_pair_false, s_pair_false, s_integer, s_pair_false);
+ pl_tuurbr = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_real, s_boolean, s_real);
+ pl_tuusit = s7_make_circular_signature(s7, 5, 6, s_any, s_pair_false, s_pair_false, s_string, s_integer, s_any);
+ pl_pur = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_real);
+ pl_puiu = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_integer, s_pair_false);
+ pl_pusiiiu = s7_make_circular_signature(s7, 6, 7, s_pair, s_pair_false, s_string, s_integer, s_integer, s_integer, s_pair_false);
+ pl_pusiiuiu = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false, s_integer, s_pair_false);
+ pl_puur = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_pair_false, s_real);
+ pl_puiiui = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_integer, s_integer, s_pair_false, s_integer);
+ pl_pubi = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_boolean, s_integer);
+ pl_puiiu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_integer, s_integer, s_pair_false);
+ pl_puuusuui = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_integer);
+ pl_pu = s7_make_circular_signature(s7, 1, 2, s_pair, s_pair_false);
+ pl_puutu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_any, s_pair_false);
+ pl_pui = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_integer);
+ pl_pusu = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_string, s_pair_false);
+ pl_pus = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_string);
+ pl_put = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_any);
+ pl_pusiiu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_string, s_integer, s_integer, s_pair_false);
+ pl_pusi = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_string, s_integer);
+ pl_puui = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_pair_false, s_integer);
+ pl_pub = s7_make_circular_signature(s7, 2, 3, s_pair, s_pair_false, s_boolean);
+ pl_pust = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_string, s_any);
+ pl_pusub = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_string, s_pair_false, s_boolean);
+ pl_puri = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_real, s_integer);
+ pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
+ pl_bsiu = s7_make_circular_signature(s7, 3, 4, s_boolean, s_string, s_integer, s_pair_false);
+ pl_bsiuub = s7_make_circular_signature(s7, 5, 6, s_boolean, s_string, s_integer, s_pair_false, s_pair_false, s_boolean);
+ pl_bsu = s7_make_circular_signature(s7, 2, 3, s_boolean, s_string, s_pair_false);
+ pl_bsiib = s7_make_circular_signature(s7, 4, 5, s_boolean, s_string, s_integer, s_integer, s_boolean);
+ pl_bsiiuusu = s7_make_circular_signature(s7, 7, 8, s_boolean, s_string, s_integer, s_integer, s_pair_false, s_pair_false, s_string, s_pair_false);
+ pl_b = s7_make_circular_signature(s7, 0, 1, s_boolean);
+ pl_btiib = s7_make_circular_signature(s7, 4, 5, s_boolean, s_any, s_integer, s_integer, s_boolean);
+ pl_bti = s7_make_circular_signature(s7, 2, 3, s_boolean, s_any, s_integer);
+ pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any);
+ pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean);
+ pl_bur = s7_make_circular_signature(s7, 2, 3, s_boolean, s_pair_false, s_real);
+ pl_buut = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_pair_false, s_any);
+ pl_buuti = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_pair_false, s_any, s_integer);
+ pl_buttiiiu = s7_make_circular_signature(s7, 7, 8, s_boolean, s_pair_false, s_any, s_any, s_integer, s_integer, s_integer, s_pair_false);
+ pl_butib = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_any, s_integer, s_boolean);
+ pl_buiui = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_integer, s_pair_false, s_integer);
+ pl_buuusuui = s7_make_circular_signature(s7, 7, 8, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_string, s_pair_false, s_pair_false, s_integer);
+ pl_buuit = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_pair_false, s_integer, s_any);
+ pl_butu = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_any, s_pair_false);
+ pl_buti = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_any, s_integer);
+ pl_butti = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_any, s_any, s_integer);
+ pl_busi = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_string, s_integer);
+ pl_busu = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_string, s_pair_false);
+ pl_bui = s7_make_circular_signature(s7, 2, 3, s_boolean, s_pair_false, s_integer);
+ pl_bu = s7_make_circular_signature(s7, 1, 2, s_boolean, s_pair_false);
+ pl_buuubu = s7_make_circular_signature(s7, 5, 6, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_pair_false);
+ pl_bus = s7_make_circular_signature(s7, 2, 3, s_boolean, s_pair_false, s_string);
+ pl_buutuuiu = s7_make_circular_signature(s7, 7, 8, s_boolean, s_pair_false, s_pair_false, s_any, s_pair_false, s_pair_false, s_integer, s_pair_false);
+ pl_but = s7_make_circular_signature(s7, 2, 3, s_boolean, s_pair_false, s_any);
+ pl_bussu = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_string, s_string, s_pair_false);
+ pl_buib = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_integer, s_boolean);
+ pl_buiu = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_integer, s_pair_false);
+ pl_buiiu = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_integer, s_integer, s_pair_false);
+ pl_bub = s7_make_circular_signature(s7, 2, 3, s_boolean, s_pair_false, s_boolean);
+ pl_buub = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_pair_false, s_boolean);
+ pl_pb = s7_make_circular_signature(s7, 1, 2, s_pair, s_boolean);
+ pl_buuiiu = s7_make_circular_signature(s7, 5, 6, s_boolean, s_pair_false, s_pair_false, s_integer, s_integer, s_pair_false);
+ pl_buui = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_pair_false, s_integer);
+ pl_buuui = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_integer);
+ pl_buus = s7_make_circular_signature(s7, 3, 4, s_boolean, s_pair_false, s_pair_false, s_string);
+ pl_buurbr = s7_make_circular_signature(s7, 5, 6, s_boolean, s_pair_false, s_pair_false, s_real, s_boolean, s_real);
+ pl_busiu = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_string, s_integer, s_pair_false);
+ pl_buttu = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_any, s_any, s_pair_false);
+ pl_buuub = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_boolean);
+ pl_buuuub = s7_make_circular_signature(s7, 5, 6, s_boolean, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_boolean);
+ pl_busib = s7_make_circular_signature(s7, 4, 5, s_boolean, s_pair_false, s_string, s_integer, s_boolean);
+ pl_buusib = s7_make_circular_signature(s7, 5, 6, s_boolean, s_pair_false, s_pair_false, s_string, s_integer, s_boolean);
+ pl_iiit = s7_make_circular_signature(s7, 3, 4, s_integer, s_integer, s_integer, s_any);
+ pl_iit = s7_make_circular_signature(s7, 2, 3, s_integer, s_integer, s_any);
+ pl_isiiutttiiu = s7_make_circular_signature(s7, 10, 11, s_integer, s_string, s_integer, s_integer, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false);
+ pl_isi = s7_make_circular_signature(s7, 2, 3, s_integer, s_string, s_integer);
+ pl_isit = s7_make_circular_signature(s7, 3, 4, s_integer, s_string, s_integer, s_any);
+ pl_si = s7_make_circular_signature(s7, 1, 2, s_string, s_integer);
+ pl_is = s7_make_circular_signature(s7, 1, 2, s_integer, s_string);
+ pl_i = s7_make_circular_signature(s7, 0, 1, s_integer);
+ pl_itiiub = s7_make_circular_signature(s7, 5, 6, s_integer, s_any, s_integer, s_integer, s_pair_false, s_boolean);
+ pl_itsub = s7_make_circular_signature(s7, 4, 5, s_integer, s_any, s_string, s_pair_false, s_boolean);
+ pl_itsttti = s7_make_circular_signature(s7, 6, 7, s_integer, s_any, s_string, s_any, s_any, s_any, s_integer);
+ pl_itiiiut = s7_make_circular_signature(s7, 6, 7, s_integer, s_any, s_integer, s_integer, s_integer, s_pair_false, s_any);
+ pl_tiu = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_pair_false);
+ pl_it = s7_make_circular_signature(s7, 1, 2, s_integer, s_any);
+ pl_ti = s7_make_circular_signature(s7, 1, 2, s_any, s_integer);
+ pl_iur = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_real);
+ pl_iussitu = s7_make_circular_signature(s7, 6, 7, s_integer, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false);
+ pl_iurrsiu = s7_make_circular_signature(s7, 6, 7, s_integer, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false);
+ pl_iuut = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_pair_false, s_any);
+ pl_iuuut = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_pair_false, s_pair_false, s_any);
+ pl_pir = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_real);
+ pl_iuisi = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_integer, s_string, s_integer);
+ pl_pibi = s7_make_circular_signature(s7, 3, 4, s_pair, s_integer, s_boolean, s_integer);
+ pl_iuuui = s7_make_circular_signature(s7, 4, 5, s_integer, s_pair_false, s_pair_false, s_pair_false, s_integer);
+ pl_iuuuui = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_pair_false, s_pair_false, s_pair_false, s_integer);
+ pl_ius = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_string);
+ pl_iusi = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_string, s_integer);
+ pl_iu = s7_make_circular_signature(s7, 1, 2, s_integer, s_pair_false);
+ pl_iuiu = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_integer, s_pair_false);
+ pl_iuui = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_pair_false, s_integer);
+ pl_pi = s7_make_circular_signature(s7, 1, 2, s_pair, s_integer);
+ pl_iui = s7_make_circular_signature(s7, 2, 3, s_integer, s_pair_false, s_integer);
+ pl_iuisut = s7_make_circular_signature(s7, 5, 6, s_integer, s_pair_false, s_integer, s_string, s_pair_false, s_any);
+ pl_piu = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_pair_false);
+ pl_pit = s7_make_circular_signature(s7, 2, 3, s_pair, s_integer, s_any);
+ pl_iuis = s7_make_circular_signature(s7, 3, 4, s_integer, s_pair_false, s_integer, s_string);
+ pl_trrru = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_pair_false);
+ pl_dusr = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_real);
+ pl_dust = s7_make_circular_signature(s7, 3, 4, s_float, s_pair_false, s_string, s_any);
+ pl_dut = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_any);
+ pl_du = s7_make_circular_signature(s7, 1, 2, s_float, s_pair_false);
+ pl_dus = s7_make_circular_signature(s7, 2, 3, s_float, s_pair_false, s_string);
+ pl_pr = s7_make_circular_signature(s7, 1, 2, s_pair, s_real);
+ pl_ssi = s7_make_circular_signature(s7, 2, 3, s_string, s_string, s_integer);
+ pl_s = s7_make_circular_signature(s7, 0, 1, s_string);
+pl_unused = NULL;
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-#define gxg_GTK_SPINNER_w gxg_GTK_SPINNER
-#define gxg_GTK_CELL_RENDERER_SPINNER_w gxg_GTK_CELL_RENDERER_SPINNER
-#define gxg_GTK_TOOL_PALETTE_w gxg_GTK_TOOL_PALETTE
-#define gxg_GTK_TOOL_ITEM_GROUP_w gxg_GTK_TOOL_ITEM_GROUP
+ Xg_define_procedure(g_unichar_validate, gxg_g_unichar_validate_w, 1, 0, 0, H_g_unichar_validate, pl_bi);
+ Xg_define_procedure(g_unichar_isalnum, gxg_g_unichar_isalnum_w, 1, 0, 0, H_g_unichar_isalnum, pl_bi);
+ Xg_define_procedure(g_unichar_isalpha, gxg_g_unichar_isalpha_w, 1, 0, 0, H_g_unichar_isalpha, pl_bi);
+ Xg_define_procedure(g_unichar_iscntrl, gxg_g_unichar_iscntrl_w, 1, 0, 0, H_g_unichar_iscntrl, pl_bi);
+ Xg_define_procedure(g_unichar_isdefined, gxg_g_unichar_isdefined_w, 1, 0, 0, H_g_unichar_isdefined, pl_bi);
+ Xg_define_procedure(g_unichar_isdigit, gxg_g_unichar_isdigit_w, 1, 0, 0, H_g_unichar_isdigit, pl_bi);
+ Xg_define_procedure(g_unichar_isgraph, gxg_g_unichar_isgraph_w, 1, 0, 0, H_g_unichar_isgraph, pl_bi);
+ Xg_define_procedure(g_unichar_islower, gxg_g_unichar_islower_w, 1, 0, 0, H_g_unichar_islower, pl_bi);
+ Xg_define_procedure(g_unichar_ismark, gxg_g_unichar_ismark_w, 1, 0, 0, H_g_unichar_ismark, pl_bi);
+ Xg_define_procedure(g_unichar_isprint, gxg_g_unichar_isprint_w, 1, 0, 0, H_g_unichar_isprint, pl_bi);
+ Xg_define_procedure(g_unichar_ispunct, gxg_g_unichar_ispunct_w, 1, 0, 0, H_g_unichar_ispunct, pl_bi);
+ Xg_define_procedure(g_unichar_isspace, gxg_g_unichar_isspace_w, 1, 0, 0, H_g_unichar_isspace, pl_bi);
+ Xg_define_procedure(g_unichar_istitle, gxg_g_unichar_istitle_w, 1, 0, 0, H_g_unichar_istitle, pl_bi);
+ Xg_define_procedure(g_unichar_isupper, gxg_g_unichar_isupper_w, 1, 0, 0, H_g_unichar_isupper, pl_bi);
+ Xg_define_procedure(g_unichar_isxdigit, gxg_g_unichar_isxdigit_w, 1, 0, 0, H_g_unichar_isxdigit, pl_bi);
+ Xg_define_procedure(g_unichar_iswide, gxg_g_unichar_iswide_w, 1, 0, 0, H_g_unichar_iswide, pl_bi);
+ Xg_define_procedure(g_unichar_iswide_cjk, gxg_g_unichar_iswide_cjk_w, 1, 0, 0, H_g_unichar_iswide_cjk, pl_bi);
+ Xg_define_procedure(g_unichar_iszerowidth, gxg_g_unichar_iszerowidth_w, 1, 0, 0, H_g_unichar_iszerowidth, pl_bi);
+ Xg_define_procedure(g_unichar_toupper, gxg_g_unichar_toupper_w, 1, 0, 0, H_g_unichar_toupper, pl_i);
+ Xg_define_procedure(g_unichar_tolower, gxg_g_unichar_tolower_w, 1, 0, 0, H_g_unichar_tolower, pl_i);
+ Xg_define_procedure(g_unichar_totitle, gxg_g_unichar_totitle_w, 1, 0, 0, H_g_unichar_totitle, pl_i);
+ Xg_define_procedure(g_unichar_digit_value, gxg_g_unichar_digit_value_w, 1, 0, 0, H_g_unichar_digit_value, pl_i);
+ Xg_define_procedure(g_unichar_xdigit_value, gxg_g_unichar_xdigit_value_w, 1, 0, 0, H_g_unichar_xdigit_value, pl_i);
+ Xg_define_procedure(g_unichar_combining_class, gxg_g_unichar_combining_class_w, 1, 0, 0, H_g_unichar_combining_class, pl_i);
+ Xg_define_procedure(g_unicode_canonical_ordering, gxg_g_unicode_canonical_ordering_w, 2, 0, 0, H_g_unicode_canonical_ordering, pl_tsi);
+ Xg_define_procedure(g_utf8_get_char, gxg_g_utf8_get_char_w, 1, 0, 0, H_g_utf8_get_char, pl_is);
+ Xg_define_procedure(g_utf8_get_char_validated, gxg_g_utf8_get_char_validated_w, 2, 0, 0, H_g_utf8_get_char_validated, pl_isi);
+ Xg_define_procedure(g_utf8_prev_char, gxg_g_utf8_prev_char_w, 1, 0, 0, H_g_utf8_prev_char, pl_s);
+ Xg_define_procedure(g_utf8_find_next_char, gxg_g_utf8_find_next_char_w, 2, 0, 0, H_g_utf8_find_next_char, pl_s);
+ Xg_define_procedure(g_utf8_find_prev_char, gxg_g_utf8_find_prev_char_w, 2, 0, 0, H_g_utf8_find_prev_char, pl_s);
+ Xg_define_procedure(g_utf8_strlen, gxg_g_utf8_strlen_w, 2, 0, 0, H_g_utf8_strlen, pl_isi);
+ Xg_define_procedure(g_utf8_strchr, gxg_g_utf8_strchr_w, 3, 0, 0, H_g_utf8_strchr, pl_ssi);
+ Xg_define_procedure(g_utf8_strrchr, gxg_g_utf8_strrchr_w, 3, 0, 0, H_g_utf8_strrchr, pl_ssi);
+ Xg_define_procedure(g_utf8_strreverse, gxg_g_utf8_strreverse_w, 2, 0, 0, H_g_utf8_strreverse, pl_ssi);
+ Xg_define_procedure(g_utf8_validate, gxg_g_utf8_validate_w, 2, 1, 0, H_g_utf8_validate, pl_bsiu);
+ Xg_define_procedure(g_utf8_strup, gxg_g_utf8_strup_w, 2, 0, 0, H_g_utf8_strup, pl_ssi);
+ Xg_define_procedure(g_utf8_strdown, gxg_g_utf8_strdown_w, 2, 0, 0, H_g_utf8_strdown, pl_ssi);
+ Xg_define_procedure(g_utf8_casefold, gxg_g_utf8_casefold_w, 2, 0, 0, H_g_utf8_casefold, pl_ssi);
+ Xg_define_procedure(g_utf8_normalize, gxg_g_utf8_normalize_w, 3, 0, 0, H_g_utf8_normalize, pl_ssi);
+ Xg_define_procedure(g_utf8_collate, gxg_g_utf8_collate_w, 2, 0, 0, H_g_utf8_collate, pl_is);
+ Xg_define_procedure(g_utf8_collate_key, gxg_g_utf8_collate_key_w, 2, 0, 0, H_g_utf8_collate_key, pl_ssi);
+ Xg_define_procedure(g_utf8_collate_key_for_filename, gxg_g_utf8_collate_key_for_filename_w, 2, 0, 0, H_g_utf8_collate_key_for_filename, pl_ssi);
+ Xg_define_procedure(g_cclosure_new, gxg_g_cclosure_new_w, 3, 0, 0, H_g_cclosure_new, pl_pt);
+ Xg_define_procedure(g_signal_newv, gxg_g_signal_newv_w, 0, 0, 1, H_g_signal_newv, pl_isiiutttiiu);
+ Xg_define_procedure(g_signal_lookup, gxg_g_signal_lookup_w, 2, 0, 0, H_g_signal_lookup, pl_isi);
+ Xg_define_procedure(g_signal_name, gxg_g_signal_name_w, 1, 0, 0, H_g_signal_name, pl_si);
+ Xg_define_procedure(g_signal_query, gxg_g_signal_query_w, 2, 0, 0, H_g_signal_query, pl_tiu);
+ Xg_define_procedure(g_signal_list_ids, gxg_g_signal_list_ids_w, 2, 0, 0, H_g_signal_list_ids, pl_piu);
+ Xg_define_procedure(g_signal_parse_name, gxg_g_signal_parse_name_w, 3, 2, 0, H_g_signal_parse_name, pl_bsiuub);
+ Xg_define_procedure(g_signal_get_invocation_hint, gxg_g_signal_get_invocation_hint_w, 1, 0, 0, H_g_signal_get_invocation_hint, pl_pt);
+ Xg_define_procedure(g_signal_stop_emission, gxg_g_signal_stop_emission_w, 3, 0, 0, H_g_signal_stop_emission, pl_tti);
+ Xg_define_procedure(g_signal_stop_emission_by_name, gxg_g_signal_stop_emission_by_name_w, 2, 0, 0, H_g_signal_stop_emission_by_name, pl_tts);
+ Xg_define_procedure(g_signal_add_emission_hook, gxg_g_signal_add_emission_hook_w, 5, 0, 0, H_g_signal_add_emission_hook, pl_iiit);
+ Xg_define_procedure(g_signal_remove_emission_hook, gxg_g_signal_remove_emission_hook_w, 2, 0, 0, H_g_signal_remove_emission_hook, pl_ti);
+ Xg_define_procedure(g_signal_has_handler_pending, gxg_g_signal_has_handler_pending_w, 4, 0, 0, H_g_signal_has_handler_pending, pl_btiib);
+ Xg_define_procedure(g_signal_connect_closure_by_id, gxg_g_signal_connect_closure_by_id_w, 5, 0, 0, H_g_signal_connect_closure_by_id, pl_itiiub);
+ Xg_define_procedure(g_signal_connect_closure, gxg_g_signal_connect_closure_w, 4, 0, 0, H_g_signal_connect_closure, pl_itsub);
+ Xg_define_procedure(g_signal_connect_data, gxg_g_signal_connect_data_w, 6, 0, 0, H_g_signal_connect_data, pl_itsttti);
+ Xg_define_procedure(g_signal_handler_block, gxg_g_signal_handler_block_w, 2, 0, 0, H_g_signal_handler_block, pl_tti);
+ Xg_define_procedure(g_signal_handler_unblock, gxg_g_signal_handler_unblock_w, 2, 0, 0, H_g_signal_handler_unblock, pl_tti);
+ Xg_define_procedure(g_signal_handler_disconnect, gxg_g_signal_handler_disconnect_w, 2, 0, 0, H_g_signal_handler_disconnect, pl_tti);
+ Xg_define_procedure(g_signal_handler_is_connected, gxg_g_signal_handler_is_connected_w, 2, 0, 0, H_g_signal_handler_is_connected, pl_bti);
+ Xg_define_procedure(g_signal_handler_find, gxg_g_signal_handler_find_w, 7, 0, 0, H_g_signal_handler_find, pl_itiiiut);
+ Xg_define_procedure(g_signal_handlers_block_matched, gxg_g_signal_handlers_block_matched_w, 7, 0, 0, H_g_signal_handlers_block_matched, pl_itiiiut);
+ Xg_define_procedure(g_signal_handlers_unblock_matched, gxg_g_signal_handlers_unblock_matched_w, 7, 0, 0, H_g_signal_handlers_unblock_matched, pl_itiiiut);
+ Xg_define_procedure(g_signal_handlers_disconnect_matched, gxg_g_signal_handlers_disconnect_matched_w, 7, 0, 0, H_g_signal_handlers_disconnect_matched, pl_itiiiut);
+ Xg_define_procedure(g_signal_handlers_destroy, gxg_g_signal_handlers_destroy_w, 1, 0, 0, H_g_signal_handlers_destroy, pl_t);
+ Xg_define_procedure(g_object_ref, gxg_g_object_ref_w, 1, 0, 0, H_g_object_ref, pl_t);
+ Xg_define_procedure(g_object_unref, gxg_g_object_unref_w, 1, 0, 0, H_g_object_unref, pl_t);
+ Xg_define_procedure(gdk_visual_get_system, gxg_gdk_visual_get_system_w, 0, 0, 0, H_gdk_visual_get_system, pl_p);
+ Xg_define_procedure(gdk_cursor_new_for_display, gxg_gdk_cursor_new_for_display_w, 2, 0, 0, H_gdk_cursor_new_for_display, pl_pui);
+ Xg_define_procedure(gdk_cursor_get_display, gxg_gdk_cursor_get_display_w, 1, 0, 0, H_gdk_cursor_get_display, pl_pu);
+ Xg_define_procedure(gdk_drag_status, gxg_gdk_drag_status_w, 3, 0, 0, H_gdk_drag_status, pl_tui);
+ Xg_define_procedure(gdk_drop_reply, gxg_gdk_drop_reply_w, 3, 0, 0, H_gdk_drop_reply, pl_tubi);
+ Xg_define_procedure(gdk_drop_finish, gxg_gdk_drop_finish_w, 3, 0, 0, H_gdk_drop_finish, pl_tubi);
+ Xg_define_procedure(gdk_drag_get_selection, gxg_gdk_drag_get_selection_w, 1, 0, 0, H_gdk_drag_get_selection, pl_tu);
+ Xg_define_procedure(gdk_drag_begin, gxg_gdk_drag_begin_w, 2, 0, 0, H_gdk_drag_begin, pl_pu);
+ Xg_define_procedure(gdk_drag_drop, gxg_gdk_drag_drop_w, 2, 0, 0, H_gdk_drag_drop, pl_tui);
+ Xg_define_procedure(gdk_drag_abort, gxg_gdk_drag_abort_w, 2, 0, 0, H_gdk_drag_abort, pl_tui);
+ Xg_define_procedure(gdk_events_pending, gxg_gdk_events_pending_w, 0, 0, 0, H_gdk_events_pending, pl_b);
+ Xg_define_procedure(gdk_event_get, gxg_gdk_event_get_w, 0, 0, 0, H_gdk_event_get, pl_p);
+ Xg_define_procedure(gdk_event_peek, gxg_gdk_event_peek_w, 0, 0, 0, H_gdk_event_peek, pl_p);
+ Xg_define_procedure(gdk_event_put, gxg_gdk_event_put_w, 1, 0, 0, H_gdk_event_put, pl_tu);
+ Xg_define_procedure(gdk_event_copy, gxg_gdk_event_copy_w, 1, 0, 0, H_gdk_event_copy, pl_pu);
+ Xg_define_procedure(gdk_event_free, gxg_gdk_event_free_w, 1, 0, 0, H_gdk_event_free, pl_tu);
+ Xg_define_procedure(gdk_event_get_time, gxg_gdk_event_get_time_w, 1, 0, 0, H_gdk_event_get_time, pl_iu);
+ Xg_define_procedure(gdk_event_get_state, gxg_gdk_event_get_state_w, 1, 1, 0, H_gdk_event_get_state, pl_bu);
+ Xg_define_procedure(gdk_event_get_coords, gxg_gdk_event_get_coords_w, 1, 2, 0, H_gdk_event_get_coords, pl_bu);
+ Xg_define_procedure(gdk_event_get_root_coords, gxg_gdk_event_get_root_coords_w, 1, 2, 0, H_gdk_event_get_root_coords, pl_bu);
+ Xg_define_procedure(gdk_event_handler_set, gxg_gdk_event_handler_set_w, 3, 0, 0, H_gdk_event_handler_set, pl_t);
+ Xg_define_procedure(gdk_set_show_events, gxg_gdk_set_show_events_w, 1, 0, 0, H_gdk_set_show_events, pl_tb);
+ Xg_define_procedure(gdk_get_show_events, gxg_gdk_get_show_events_w, 0, 0, 0, H_gdk_get_show_events, pl_b);
+ Xg_define_procedure(gdk_init, gxg_gdk_init_w, 0, 2, 0, H_gdk_init, pl_tu);
+ Xg_define_procedure(gdk_init_check, gxg_gdk_init_check_w, 0, 2, 0, H_gdk_init_check, pl_bu);
+ Xg_define_procedure(gdk_get_program_class, gxg_gdk_get_program_class_w, 0, 0, 0, H_gdk_get_program_class, pl_s);
+ Xg_define_procedure(gdk_set_program_class, gxg_gdk_set_program_class_w, 1, 0, 0, H_gdk_set_program_class, pl_ts);
+ Xg_define_procedure(gdk_error_trap_push, gxg_gdk_error_trap_push_w, 0, 0, 0, H_gdk_error_trap_push, pl_t);
+ Xg_define_procedure(gdk_error_trap_pop, gxg_gdk_error_trap_pop_w, 0, 0, 0, H_gdk_error_trap_pop, pl_i);
+ Xg_define_procedure(gdk_get_display_arg_name, gxg_gdk_get_display_arg_name_w, 0, 0, 0, H_gdk_get_display_arg_name, pl_s);
+ Xg_define_procedure(gdk_notify_startup_complete, gxg_gdk_notify_startup_complete_w, 0, 0, 0, H_gdk_notify_startup_complete, pl_t);
+ Xg_define_procedure(gdk_screen_width, gxg_gdk_screen_width_w, 0, 0, 0, H_gdk_screen_width, pl_i);
+ Xg_define_procedure(gdk_screen_height, gxg_gdk_screen_height_w, 0, 0, 0, H_gdk_screen_height, pl_i);
+ Xg_define_procedure(gdk_screen_width_mm, gxg_gdk_screen_width_mm_w, 0, 0, 0, H_gdk_screen_width_mm, pl_i);
+ Xg_define_procedure(gdk_screen_height_mm, gxg_gdk_screen_height_mm_w, 0, 0, 0, H_gdk_screen_height_mm, pl_i);
+ Xg_define_procedure(gdk_flush, gxg_gdk_flush_w, 0, 0, 0, H_gdk_flush, pl_t);
+ Xg_define_procedure(gdk_beep, gxg_gdk_beep_w, 0, 0, 0, H_gdk_beep, pl_t);
+ Xg_define_procedure(gdk_set_double_click_time, gxg_gdk_set_double_click_time_w, 1, 0, 0, H_gdk_set_double_click_time, pl_ti);
+ Xg_define_procedure(gdk_rectangle_intersect, gxg_gdk_rectangle_intersect_w, 3, 0, 0, H_gdk_rectangle_intersect, pl_bu);
+ Xg_define_procedure(gdk_rectangle_union, gxg_gdk_rectangle_union_w, 3, 0, 0, H_gdk_rectangle_union, pl_tu);
+ Xg_define_procedure(gdk_keymap_get_default, gxg_gdk_keymap_get_default_w, 0, 0, 0, H_gdk_keymap_get_default, pl_p);
+ Xg_define_procedure(gdk_keymap_lookup_key, gxg_gdk_keymap_lookup_key_w, 2, 0, 0, H_gdk_keymap_lookup_key, pl_iu);
+ Xg_define_procedure(gdk_keymap_get_entries_for_keyval, gxg_gdk_keymap_get_entries_for_keyval_w, 2, 2, 0, H_gdk_keymap_get_entries_for_keyval, pl_buiu);
+ Xg_define_procedure(gdk_keymap_get_entries_for_keycode, gxg_gdk_keymap_get_entries_for_keycode_w, 2, 3, 0, H_gdk_keymap_get_entries_for_keycode, pl_buiu);
+ Xg_define_procedure(gdk_keymap_get_direction, gxg_gdk_keymap_get_direction_w, 1, 0, 0, H_gdk_keymap_get_direction, pl_iu);
+ Xg_define_procedure(gdk_keyval_name, gxg_gdk_keyval_name_w, 1, 0, 0, H_gdk_keyval_name, pl_si);
+ Xg_define_procedure(gdk_keyval_from_name, gxg_gdk_keyval_from_name_w, 1, 0, 0, H_gdk_keyval_from_name, pl_is);
+ Xg_define_procedure(gdk_keyval_convert_case, gxg_gdk_keyval_convert_case_w, 1, 2, 0, H_gdk_keyval_convert_case, pl_tiu);
+ Xg_define_procedure(gdk_keyval_to_upper, gxg_gdk_keyval_to_upper_w, 1, 0, 0, H_gdk_keyval_to_upper, pl_i);
+ Xg_define_procedure(gdk_keyval_to_lower, gxg_gdk_keyval_to_lower_w, 1, 0, 0, H_gdk_keyval_to_lower, pl_i);
+ Xg_define_procedure(gdk_keyval_is_upper, gxg_gdk_keyval_is_upper_w, 1, 0, 0, H_gdk_keyval_is_upper, pl_bi);
+ Xg_define_procedure(gdk_keyval_is_lower, gxg_gdk_keyval_is_lower_w, 1, 0, 0, H_gdk_keyval_is_lower, pl_bi);
+ Xg_define_procedure(gdk_keyval_to_unicode, gxg_gdk_keyval_to_unicode_w, 1, 0, 0, H_gdk_keyval_to_unicode, pl_i);
+ Xg_define_procedure(gdk_unicode_to_keyval, gxg_gdk_unicode_to_keyval_w, 1, 0, 0, H_gdk_unicode_to_keyval, pl_i);
+ Xg_define_procedure(gdk_pango_context_get, gxg_gdk_pango_context_get_w, 0, 0, 0, H_gdk_pango_context_get, pl_p);
+ Xg_define_procedure(gdk_atom_intern, gxg_gdk_atom_intern_w, 2, 0, 0, H_gdk_atom_intern, pl_tsb);
+ Xg_define_procedure(gdk_atom_name, gxg_gdk_atom_name_w, 1, 0, 0, H_gdk_atom_name, pl_st);
+ Xg_define_procedure(gdk_property_get, gxg_gdk_property_get_w, 0, 0, 1, H_gdk_property_get, pl_buttiiiu);
+ Xg_define_procedure(gdk_property_change, gxg_gdk_property_change_w, 7, 0, 0, H_gdk_property_change, pl_tuttiisi);
+ Xg_define_procedure(gdk_property_delete, gxg_gdk_property_delete_w, 2, 0, 0, H_gdk_property_delete, pl_tut);
+ Xg_define_procedure(gdk_utf8_to_string_target, gxg_gdk_utf8_to_string_target_w, 1, 0, 0, H_gdk_utf8_to_string_target, pl_s);
+ Xg_define_procedure(gdk_selection_owner_set, gxg_gdk_selection_owner_set_w, 4, 0, 0, H_gdk_selection_owner_set, pl_butib);
+ Xg_define_procedure(gdk_selection_owner_get, gxg_gdk_selection_owner_get_w, 1, 0, 0, H_gdk_selection_owner_get, pl_pt);
+ Xg_define_procedure(gdk_selection_convert, gxg_gdk_selection_convert_w, 4, 0, 0, H_gdk_selection_convert, pl_tutti);
+ Xg_define_procedure(gdk_selection_property_get, gxg_gdk_selection_property_get_w, 1, 3, 0, H_gdk_selection_property_get, pl_bu);
+ Xg_define_procedure(gdk_visual_get_best_depth, gxg_gdk_visual_get_best_depth_w, 0, 0, 0, H_gdk_visual_get_best_depth, pl_i);
+ Xg_define_procedure(gdk_visual_get_best_type, gxg_gdk_visual_get_best_type_w, 0, 0, 0, H_gdk_visual_get_best_type, pl_i);
+ Xg_define_procedure(gdk_visual_get_best, gxg_gdk_visual_get_best_w, 0, 0, 0, H_gdk_visual_get_best, pl_p);
+ Xg_define_procedure(gdk_visual_get_best_with_depth, gxg_gdk_visual_get_best_with_depth_w, 1, 0, 0, H_gdk_visual_get_best_with_depth, pl_pi);
+ Xg_define_procedure(gdk_visual_get_best_with_type, gxg_gdk_visual_get_best_with_type_w, 1, 0, 0, H_gdk_visual_get_best_with_type, pl_pi);
+ Xg_define_procedure(gdk_visual_get_best_with_both, gxg_gdk_visual_get_best_with_both_w, 2, 0, 0, H_gdk_visual_get_best_with_both, pl_pi);
+ Xg_define_procedure(gdk_query_depths, gxg_gdk_query_depths_w, 0, 2, 0, H_gdk_query_depths, pl_tu);
+ Xg_define_procedure(gdk_query_visual_types, gxg_gdk_query_visual_types_w, 0, 2, 0, H_gdk_query_visual_types, pl_tu);
+ Xg_define_procedure(gdk_list_visuals, gxg_gdk_list_visuals_w, 0, 0, 0, H_gdk_list_visuals, pl_p);
+ Xg_define_procedure(gdk_window_new, gxg_gdk_window_new_w, 3, 0, 0, H_gdk_window_new, pl_puui);
+ Xg_define_procedure(gdk_window_destroy, gxg_gdk_window_destroy_w, 1, 0, 0, H_gdk_window_destroy, pl_tu);
+ Xg_define_procedure(gdk_window_get_window_type, gxg_gdk_window_get_window_type_w, 1, 0, 0, H_gdk_window_get_window_type, pl_iu);
+ Xg_define_procedure(gdk_window_show, gxg_gdk_window_show_w, 1, 0, 0, H_gdk_window_show, pl_tu);
+ Xg_define_procedure(gdk_window_hide, gxg_gdk_window_hide_w, 1, 0, 0, H_gdk_window_hide, pl_tu);
+ Xg_define_procedure(gdk_window_withdraw, gxg_gdk_window_withdraw_w, 1, 0, 0, H_gdk_window_withdraw, pl_tu);
+ Xg_define_procedure(gdk_window_show_unraised, gxg_gdk_window_show_unraised_w, 1, 0, 0, H_gdk_window_show_unraised, pl_tu);
+ Xg_define_procedure(gdk_window_move, gxg_gdk_window_move_w, 3, 0, 0, H_gdk_window_move, pl_tui);
+ Xg_define_procedure(gdk_window_resize, gxg_gdk_window_resize_w, 3, 0, 0, H_gdk_window_resize, pl_tui);
+ Xg_define_procedure(gdk_window_move_resize, gxg_gdk_window_move_resize_w, 5, 0, 0, H_gdk_window_move_resize, pl_tui);
+ Xg_define_procedure(gdk_window_reparent, gxg_gdk_window_reparent_w, 4, 0, 0, H_gdk_window_reparent, pl_tuui);
+ Xg_define_procedure(gdk_window_raise, gxg_gdk_window_raise_w, 1, 0, 0, H_gdk_window_raise, pl_tu);
+ Xg_define_procedure(gdk_window_lower, gxg_gdk_window_lower_w, 1, 0, 0, H_gdk_window_lower, pl_tu);
+ Xg_define_procedure(gdk_window_focus, gxg_gdk_window_focus_w, 2, 0, 0, H_gdk_window_focus, pl_tui);
+ Xg_define_procedure(gdk_window_set_user_data, gxg_gdk_window_set_user_data_w, 2, 0, 0, H_gdk_window_set_user_data, pl_tut);
+ Xg_define_procedure(gdk_window_set_override_redirect, gxg_gdk_window_set_override_redirect_w, 2, 0, 0, H_gdk_window_set_override_redirect, pl_tub);
+ Xg_define_procedure(gdk_window_add_filter, gxg_gdk_window_add_filter_w, 2, 1, 0, H_gdk_window_add_filter, pl_tut);
+ Xg_define_procedure(gdk_window_remove_filter, gxg_gdk_window_remove_filter_w, 2, 1, 0, H_gdk_window_remove_filter, pl_tut);
+ Xg_define_procedure(gdk_window_scroll, gxg_gdk_window_scroll_w, 3, 0, 0, H_gdk_window_scroll, pl_tui);
+ Xg_define_procedure(gdk_window_set_child_shapes, gxg_gdk_window_set_child_shapes_w, 1, 0, 0, H_gdk_window_set_child_shapes, pl_tu);
+ Xg_define_procedure(gdk_window_merge_child_shapes, gxg_gdk_window_merge_child_shapes_w, 1, 0, 0, H_gdk_window_merge_child_shapes, pl_tu);
+ Xg_define_procedure(gdk_window_is_visible, gxg_gdk_window_is_visible_w, 1, 0, 0, H_gdk_window_is_visible, pl_bu);
+ Xg_define_procedure(gdk_window_is_viewable, gxg_gdk_window_is_viewable_w, 1, 0, 0, H_gdk_window_is_viewable, pl_bu);
+ Xg_define_procedure(gdk_window_get_state, gxg_gdk_window_get_state_w, 1, 0, 0, H_gdk_window_get_state, pl_iu);
+ Xg_define_procedure(gdk_window_get_root_origin, gxg_gdk_window_get_root_origin_w, 1, 2, 0, H_gdk_window_get_root_origin, pl_tu);
+ Xg_define_procedure(gdk_window_get_frame_extents, gxg_gdk_window_get_frame_extents_w, 2, 0, 0, H_gdk_window_get_frame_extents, pl_tu);
+ Xg_define_procedure(gdk_window_get_parent, gxg_gdk_window_get_parent_w, 1, 0, 0, H_gdk_window_get_parent, pl_pu);
+ Xg_define_procedure(gdk_window_get_toplevel, gxg_gdk_window_get_toplevel_w, 1, 0, 0, H_gdk_window_get_toplevel, pl_pu);
+ Xg_define_procedure(gdk_window_get_children, gxg_gdk_window_get_children_w, 1, 0, 0, H_gdk_window_get_children, pl_pu);
+ Xg_define_procedure(gdk_window_peek_children, gxg_gdk_window_peek_children_w, 1, 0, 0, H_gdk_window_peek_children, pl_pu);
+ Xg_define_procedure(gdk_window_get_events, gxg_gdk_window_get_events_w, 1, 0, 0, H_gdk_window_get_events, pl_iu);
+ Xg_define_procedure(gdk_window_set_events, gxg_gdk_window_set_events_w, 2, 0, 0, H_gdk_window_set_events, pl_tui);
+ Xg_define_procedure(gdk_window_set_icon_list, gxg_gdk_window_set_icon_list_w, 2, 0, 0, H_gdk_window_set_icon_list, pl_tu);
+ Xg_define_procedure(gdk_window_set_icon_name, gxg_gdk_window_set_icon_name_w, 2, 0, 0, H_gdk_window_set_icon_name, pl_tus);
+ Xg_define_procedure(gdk_window_set_group, gxg_gdk_window_set_group_w, 2, 0, 0, H_gdk_window_set_group, pl_tu);
+ Xg_define_procedure(gdk_window_set_decorations, gxg_gdk_window_set_decorations_w, 2, 0, 0, H_gdk_window_set_decorations, pl_tui);
+ Xg_define_procedure(gdk_window_get_decorations, gxg_gdk_window_get_decorations_w, 1, 1, 0, H_gdk_window_get_decorations, pl_bu);
+ Xg_define_procedure(gdk_window_set_functions, gxg_gdk_window_set_functions_w, 2, 0, 0, H_gdk_window_set_functions, pl_tui);
+ Xg_define_procedure(gdk_window_iconify, gxg_gdk_window_iconify_w, 1, 0, 0, H_gdk_window_iconify, pl_tu);
+ Xg_define_procedure(gdk_window_deiconify, gxg_gdk_window_deiconify_w, 1, 0, 0, H_gdk_window_deiconify, pl_tu);
+ Xg_define_procedure(gdk_window_stick, gxg_gdk_window_stick_w, 1, 0, 0, H_gdk_window_stick, pl_tu);
+ Xg_define_procedure(gdk_window_unstick, gxg_gdk_window_unstick_w, 1, 0, 0, H_gdk_window_unstick, pl_tu);
+ Xg_define_procedure(gdk_window_maximize, gxg_gdk_window_maximize_w, 1, 0, 0, H_gdk_window_maximize, pl_tu);
+ Xg_define_procedure(gdk_window_unmaximize, gxg_gdk_window_unmaximize_w, 1, 0, 0, H_gdk_window_unmaximize, pl_tu);
+ Xg_define_procedure(gdk_window_register_dnd, gxg_gdk_window_register_dnd_w, 1, 0, 0, H_gdk_window_register_dnd, pl_tu);
+ Xg_define_procedure(gdk_window_begin_resize_drag, gxg_gdk_window_begin_resize_drag_w, 6, 0, 0, H_gdk_window_begin_resize_drag, pl_tui);
+ Xg_define_procedure(gdk_window_begin_move_drag, gxg_gdk_window_begin_move_drag_w, 5, 0, 0, H_gdk_window_begin_move_drag, pl_tui);
+ Xg_define_procedure(gdk_window_invalidate_rect, gxg_gdk_window_invalidate_rect_w, 3, 0, 0, H_gdk_window_invalidate_rect, pl_tuub);
+ Xg_define_procedure(gdk_window_freeze_updates, gxg_gdk_window_freeze_updates_w, 1, 0, 0, H_gdk_window_freeze_updates, pl_tu);
+ Xg_define_procedure(gdk_window_thaw_updates, gxg_gdk_window_thaw_updates_w, 1, 0, 0, H_gdk_window_thaw_updates, pl_tu);
+ Xg_define_procedure(gdk_window_process_all_updates, gxg_gdk_window_process_all_updates_w, 0, 0, 0, H_gdk_window_process_all_updates, pl_t);
+ Xg_define_procedure(gdk_window_process_updates, gxg_gdk_window_process_updates_w, 2, 0, 0, H_gdk_window_process_updates, pl_tub);
+ Xg_define_procedure(gdk_window_set_debug_updates, gxg_gdk_window_set_debug_updates_w, 1, 0, 0, H_gdk_window_set_debug_updates, pl_tb);
+ Xg_define_procedure(gdk_window_constrain_size, gxg_gdk_window_constrain_size_w, 4, 2, 0, H_gdk_window_constrain_size, pl_tuiiiu);
+ Xg_define_procedure(gdk_window_set_type_hint, gxg_gdk_window_set_type_hint_w, 2, 0, 0, H_gdk_window_set_type_hint, pl_tui);
+ Xg_define_procedure(gdk_window_set_modal_hint, gxg_gdk_window_set_modal_hint_w, 2, 0, 0, H_gdk_window_set_modal_hint, pl_tub);
+ Xg_define_procedure(gdk_window_set_geometry_hints, gxg_gdk_window_set_geometry_hints_w, 3, 0, 0, H_gdk_window_set_geometry_hints, pl_tuui);
+ Xg_define_procedure(gdk_window_begin_paint_rect, gxg_gdk_window_begin_paint_rect_w, 2, 0, 0, H_gdk_window_begin_paint_rect, pl_tu);
+ Xg_define_procedure(gdk_window_end_paint, gxg_gdk_window_end_paint_w, 1, 0, 0, H_gdk_window_end_paint, pl_tu);
+ Xg_define_procedure(gdk_window_set_title, gxg_gdk_window_set_title_w, 2, 0, 0, H_gdk_window_set_title, pl_tus);
+ Xg_define_procedure(gdk_window_set_role, gxg_gdk_window_set_role_w, 2, 0, 0, H_gdk_window_set_role, pl_tus);
+ Xg_define_procedure(gdk_window_set_transient_for, gxg_gdk_window_set_transient_for_w, 2, 0, 0, H_gdk_window_set_transient_for, pl_tu);
+ Xg_define_procedure(gdk_window_set_cursor, gxg_gdk_window_set_cursor_w, 2, 0, 0, H_gdk_window_set_cursor, pl_tu);
+ Xg_define_procedure(gdk_window_get_user_data, gxg_gdk_window_get_user_data_w, 1, 1, 0, H_gdk_window_get_user_data, pl_tu);
+ Xg_define_procedure(gdk_window_get_position, gxg_gdk_window_get_position_w, 1, 2, 0, H_gdk_window_get_position, pl_tu);
+ Xg_define_procedure(gdk_window_get_origin, gxg_gdk_window_get_origin_w, 1, 2, 0, H_gdk_window_get_origin, pl_iu);
+ Xg_define_procedure(gdk_get_default_root_window, gxg_gdk_get_default_root_window_w, 0, 0, 0, H_gdk_get_default_root_window, pl_p);
+ Xg_define_procedure(gdk_pixbuf_error_quark, gxg_gdk_pixbuf_error_quark_w, 0, 0, 0, H_gdk_pixbuf_error_quark, pl_i);
+ Xg_define_procedure(gdk_pixbuf_get_colorspace, gxg_gdk_pixbuf_get_colorspace_w, 1, 0, 0, H_gdk_pixbuf_get_colorspace, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_get_n_channels, gxg_gdk_pixbuf_get_n_channels_w, 1, 0, 0, H_gdk_pixbuf_get_n_channels, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_get_has_alpha, gxg_gdk_pixbuf_get_has_alpha_w, 1, 0, 0, H_gdk_pixbuf_get_has_alpha, pl_bu);
+ Xg_define_procedure(gdk_pixbuf_get_bits_per_sample, gxg_gdk_pixbuf_get_bits_per_sample_w, 1, 0, 0, H_gdk_pixbuf_get_bits_per_sample, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_get_pixels, gxg_gdk_pixbuf_get_pixels_w, 1, 0, 0, H_gdk_pixbuf_get_pixels, pl_su);
+ Xg_define_procedure(gdk_pixbuf_get_width, gxg_gdk_pixbuf_get_width_w, 1, 0, 0, H_gdk_pixbuf_get_width, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_get_height, gxg_gdk_pixbuf_get_height_w, 1, 0, 0, H_gdk_pixbuf_get_height, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_get_rowstride, gxg_gdk_pixbuf_get_rowstride_w, 1, 0, 0, H_gdk_pixbuf_get_rowstride, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_new, gxg_gdk_pixbuf_new_w, 5, 0, 0, H_gdk_pixbuf_new, pl_pibi);
+ Xg_define_procedure(gdk_pixbuf_copy, gxg_gdk_pixbuf_copy_w, 1, 0, 0, H_gdk_pixbuf_copy, pl_pu);
+ Xg_define_procedure(gdk_pixbuf_new_subpixbuf, gxg_gdk_pixbuf_new_subpixbuf_w, 5, 0, 0, H_gdk_pixbuf_new_subpixbuf, pl_pui);
+ Xg_define_procedure(gdk_pixbuf_new_from_file, gxg_gdk_pixbuf_new_from_file_w, 1, 1, 0, H_gdk_pixbuf_new_from_file, pl_psu);
+ Xg_define_procedure(gdk_pixbuf_new_from_data, gxg_gdk_pixbuf_new_from_data_w, 0, 0, 1, H_gdk_pixbuf_new_from_data, pl_psibiiiit);
+ Xg_define_procedure(gdk_pixbuf_new_from_xpm_data, gxg_gdk_pixbuf_new_from_xpm_data_w, 1, 0, 0, H_gdk_pixbuf_new_from_xpm_data, pl_pu);
+ Xg_define_procedure(gdk_pixbuf_fill, gxg_gdk_pixbuf_fill_w, 2, 0, 0, H_gdk_pixbuf_fill, pl_tui);
+ Xg_define_procedure(gdk_pixbuf_savev, gxg_gdk_pixbuf_savev_w, 5, 1, 0, H_gdk_pixbuf_savev, pl_bussu);
+ Xg_define_procedure(gdk_pixbuf_add_alpha, gxg_gdk_pixbuf_add_alpha_w, 5, 0, 0, H_gdk_pixbuf_add_alpha, pl_pubi);
+ Xg_define_procedure(gdk_pixbuf_copy_area, gxg_gdk_pixbuf_copy_area_w, 0, 0, 1, H_gdk_pixbuf_copy_area, pl_tuiiiiui);
+ Xg_define_procedure(gdk_pixbuf_saturate_and_pixelate, gxg_gdk_pixbuf_saturate_and_pixelate_w, 4, 0, 0, H_gdk_pixbuf_saturate_and_pixelate, pl_tuurb);
+ Xg_define_procedure(gdk_pixbuf_scale, gxg_gdk_pixbuf_scale_w, 0, 0, 1, H_gdk_pixbuf_scale, pl_tuuiiiirrrri);
+ Xg_define_procedure(gdk_pixbuf_composite, gxg_gdk_pixbuf_composite_w, 0, 0, 1, H_gdk_pixbuf_composite, pl_tuuiiiirrrri);
+ Xg_define_procedure(gdk_pixbuf_composite_color, gxg_gdk_pixbuf_composite_color_w, 0, 0, 1, H_gdk_pixbuf_composite_color, pl_tuuiiiirrrri);
+ Xg_define_procedure(gdk_pixbuf_scale_simple, gxg_gdk_pixbuf_scale_simple_w, 4, 0, 0, H_gdk_pixbuf_scale_simple, pl_pui);
+ Xg_define_procedure(gdk_pixbuf_composite_color_simple, gxg_gdk_pixbuf_composite_color_simple_w, 0, 0, 1, H_gdk_pixbuf_composite_color_simple, pl_pui);
+ Xg_define_procedure(gdk_pixbuf_animation_new_from_file, gxg_gdk_pixbuf_animation_new_from_file_w, 1, 1, 0, H_gdk_pixbuf_animation_new_from_file, pl_psu);
+ Xg_define_procedure(gdk_pixbuf_animation_get_width, gxg_gdk_pixbuf_animation_get_width_w, 1, 0, 0, H_gdk_pixbuf_animation_get_width, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_animation_get_height, gxg_gdk_pixbuf_animation_get_height_w, 1, 0, 0, H_gdk_pixbuf_animation_get_height, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_animation_is_static_image, gxg_gdk_pixbuf_animation_is_static_image_w, 1, 0, 0, H_gdk_pixbuf_animation_is_static_image, pl_bu);
+ Xg_define_procedure(gdk_pixbuf_animation_get_static_image, gxg_gdk_pixbuf_animation_get_static_image_w, 1, 0, 0, H_gdk_pixbuf_animation_get_static_image, pl_pu);
+ Xg_define_procedure(gdk_pixbuf_animation_get_iter, gxg_gdk_pixbuf_animation_get_iter_w, 2, 0, 0, H_gdk_pixbuf_animation_get_iter, pl_pu);
+ Xg_define_procedure(gdk_pixbuf_animation_iter_get_delay_time, gxg_gdk_pixbuf_animation_iter_get_delay_time_w, 1, 0, 0, H_gdk_pixbuf_animation_iter_get_delay_time, pl_iu);
+ Xg_define_procedure(gdk_pixbuf_animation_iter_get_pixbuf, gxg_gdk_pixbuf_animation_iter_get_pixbuf_w, 1, 0, 0, H_gdk_pixbuf_animation_iter_get_pixbuf, pl_pu);
+ Xg_define_procedure(gdk_pixbuf_animation_iter_on_currently_loading_frame, gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame_w, 1, 0, 0, H_gdk_pixbuf_animation_iter_on_currently_loading_frame, pl_bu);
+ Xg_define_procedure(gdk_pixbuf_animation_iter_advance, gxg_gdk_pixbuf_animation_iter_advance_w, 2, 0, 0, H_gdk_pixbuf_animation_iter_advance, pl_bu);
+ Xg_define_procedure(gdk_pixbuf_get_option, gxg_gdk_pixbuf_get_option_w, 2, 0, 0, H_gdk_pixbuf_get_option, pl_sus);
+ Xg_define_procedure(gtk_accel_group_new, gxg_gtk_accel_group_new_w, 0, 0, 0, H_gtk_accel_group_new, pl_p);
+ Xg_define_procedure(gtk_accel_group_lock, gxg_gtk_accel_group_lock_w, 1, 0, 0, H_gtk_accel_group_lock, pl_tu);
+ Xg_define_procedure(gtk_accel_group_unlock, gxg_gtk_accel_group_unlock_w, 1, 0, 0, H_gtk_accel_group_unlock, pl_tu);
+ Xg_define_procedure(gtk_accel_group_connect, gxg_gtk_accel_group_connect_w, 5, 0, 0, H_gtk_accel_group_connect, pl_tuiiiu);
+ Xg_define_procedure(gtk_accel_group_connect_by_path, gxg_gtk_accel_group_connect_by_path_w, 3, 0, 0, H_gtk_accel_group_connect_by_path, pl_tusu);
+ Xg_define_procedure(gtk_accel_group_disconnect, gxg_gtk_accel_group_disconnect_w, 2, 0, 0, H_gtk_accel_group_disconnect, pl_bu);
+ Xg_define_procedure(gtk_accel_group_disconnect_key, gxg_gtk_accel_group_disconnect_key_w, 3, 0, 0, H_gtk_accel_group_disconnect_key, pl_bui);
+ Xg_define_procedure(gtk_accel_groups_activate, gxg_gtk_accel_groups_activate_w, 3, 0, 0, H_gtk_accel_groups_activate, pl_bui);
+ Xg_define_procedure(gtk_accel_groups_from_object, gxg_gtk_accel_groups_from_object_w, 1, 0, 0, H_gtk_accel_groups_from_object, pl_pu);
+ Xg_define_procedure(gtk_accel_group_find, gxg_gtk_accel_group_find_w, 2, 1, 0, H_gtk_accel_group_find, pl_put);
+ Xg_define_procedure(gtk_accel_group_from_accel_closure, gxg_gtk_accel_group_from_accel_closure_w, 1, 0, 0, H_gtk_accel_group_from_accel_closure, pl_pu);
+ Xg_define_procedure(gtk_accelerator_valid, gxg_gtk_accelerator_valid_w, 2, 0, 0, H_gtk_accelerator_valid, pl_bi);
+ Xg_define_procedure(gtk_accelerator_parse, gxg_gtk_accelerator_parse_w, 1, 2, 0, H_gtk_accelerator_parse, pl_tsu);
+ Xg_define_procedure(gtk_accelerator_name, gxg_gtk_accelerator_name_w, 2, 0, 0, H_gtk_accelerator_name, pl_si);
+ Xg_define_procedure(gtk_accelerator_set_default_mod_mask, gxg_gtk_accelerator_set_default_mod_mask_w, 1, 0, 0, H_gtk_accelerator_set_default_mod_mask, pl_ti);
+ Xg_define_procedure(gtk_accel_group_query, gxg_gtk_accel_group_query_w, 3, 1, 0, H_gtk_accel_group_query, pl_puiiu);
+ Xg_define_procedure(gtk_accel_group_activate, gxg_gtk_accel_group_activate_w, 5, 0, 0, H_gtk_accel_group_activate, pl_buiui);
+ Xg_define_procedure(gtk_accel_label_new, gxg_gtk_accel_label_new_w, 1, 0, 0, H_gtk_accel_label_new, pl_ps);
+ Xg_define_procedure(gtk_accel_label_get_accel_widget, gxg_gtk_accel_label_get_accel_widget_w, 1, 0, 0, H_gtk_accel_label_get_accel_widget, pl_pu);
+ Xg_define_procedure(gtk_accel_label_get_accel_width, gxg_gtk_accel_label_get_accel_width_w, 1, 0, 0, H_gtk_accel_label_get_accel_width, pl_iu);
+ Xg_define_procedure(gtk_accel_label_set_accel_widget, gxg_gtk_accel_label_set_accel_widget_w, 2, 0, 0, H_gtk_accel_label_set_accel_widget, pl_tu);
+ Xg_define_procedure(gtk_accel_label_set_accel_closure, gxg_gtk_accel_label_set_accel_closure_w, 2, 0, 0, H_gtk_accel_label_set_accel_closure, pl_tu);
+ Xg_define_procedure(gtk_accel_label_refetch, gxg_gtk_accel_label_refetch_w, 1, 0, 0, H_gtk_accel_label_refetch, pl_bu);
+ Xg_define_procedure(gtk_accel_map_add_entry, gxg_gtk_accel_map_add_entry_w, 3, 0, 0, H_gtk_accel_map_add_entry, pl_tsi);
+ Xg_define_procedure(gtk_accel_map_lookup_entry, gxg_gtk_accel_map_lookup_entry_w, 2, 0, 0, H_gtk_accel_map_lookup_entry, pl_bsu);
+ Xg_define_procedure(gtk_accel_map_change_entry, gxg_gtk_accel_map_change_entry_w, 4, 0, 0, H_gtk_accel_map_change_entry, pl_bsiib);
+ Xg_define_procedure(gtk_accel_map_load, gxg_gtk_accel_map_load_w, 1, 0, 0, H_gtk_accel_map_load, pl_ts);
+ Xg_define_procedure(gtk_accel_map_save, gxg_gtk_accel_map_save_w, 1, 0, 0, H_gtk_accel_map_save, pl_ts);
+ Xg_define_procedure(gtk_accel_map_foreach, gxg_gtk_accel_map_foreach_w, 2, 0, 0, H_gtk_accel_map_foreach, pl_t);
+ Xg_define_procedure(gtk_accel_map_load_fd, gxg_gtk_accel_map_load_fd_w, 1, 0, 0, H_gtk_accel_map_load_fd, pl_ti);
+ Xg_define_procedure(gtk_accel_map_save_fd, gxg_gtk_accel_map_save_fd_w, 1, 0, 0, H_gtk_accel_map_save_fd, pl_ti);
+ Xg_define_procedure(gtk_accel_map_add_filter, gxg_gtk_accel_map_add_filter_w, 1, 0, 0, H_gtk_accel_map_add_filter, pl_ts);
+ Xg_define_procedure(gtk_accel_map_foreach_unfiltered, gxg_gtk_accel_map_foreach_unfiltered_w, 2, 0, 0, H_gtk_accel_map_foreach_unfiltered, pl_t);
+ Xg_define_procedure(gtk_adjustment_clamp_page, gxg_gtk_adjustment_clamp_page_w, 3, 0, 0, H_gtk_adjustment_clamp_page, pl_tur);
+ Xg_define_procedure(gtk_adjustment_get_value, gxg_gtk_adjustment_get_value_w, 1, 0, 0, H_gtk_adjustment_get_value, pl_du);
+ Xg_define_procedure(gtk_adjustment_set_value, gxg_gtk_adjustment_set_value_w, 2, 0, 0, H_gtk_adjustment_set_value, pl_tur);
+ Xg_define_procedure(gtk_aspect_frame_new, gxg_gtk_aspect_frame_new_w, 5, 0, 0, H_gtk_aspect_frame_new, pl_psrrrb);
+ Xg_define_procedure(gtk_aspect_frame_set, gxg_gtk_aspect_frame_set_w, 5, 0, 0, H_gtk_aspect_frame_set, pl_turrrb);
+ Xg_define_procedure(gtk_button_box_get_layout, gxg_gtk_button_box_get_layout_w, 1, 0, 0, H_gtk_button_box_get_layout, pl_iu);
+ Xg_define_procedure(gtk_button_box_set_layout, gxg_gtk_button_box_set_layout_w, 2, 0, 0, H_gtk_button_box_set_layout, pl_tui);
+ Xg_define_procedure(gtk_button_box_set_child_secondary, gxg_gtk_button_box_set_child_secondary_w, 3, 0, 0, H_gtk_button_box_set_child_secondary, pl_tuub);
+ Xg_define_procedure(gtk_binding_set_new, gxg_gtk_binding_set_new_w, 1, 0, 0, H_gtk_binding_set_new, pl_ps);
+ Xg_define_procedure(gtk_binding_set_by_class, gxg_gtk_binding_set_by_class_w, 1, 0, 0, H_gtk_binding_set_by_class, pl_pt);
+ Xg_define_procedure(gtk_binding_set_find, gxg_gtk_binding_set_find_w, 1, 0, 0, H_gtk_binding_set_find, pl_ps);
+ Xg_define_procedure(gtk_binding_entry_remove, gxg_gtk_binding_entry_remove_w, 3, 0, 0, H_gtk_binding_entry_remove, pl_tui);
+ Xg_define_procedure(gtk_bin_get_child, gxg_gtk_bin_get_child_w, 1, 0, 0, H_gtk_bin_get_child, pl_pu);
+ Xg_define_procedure(gtk_box_pack_start, gxg_gtk_box_pack_start_w, 5, 0, 0, H_gtk_box_pack_start, pl_tuubbi);
+ Xg_define_procedure(gtk_box_pack_end, gxg_gtk_box_pack_end_w, 5, 0, 0, H_gtk_box_pack_end, pl_tuubbi);
+ Xg_define_procedure(gtk_box_set_homogeneous, gxg_gtk_box_set_homogeneous_w, 2, 0, 0, H_gtk_box_set_homogeneous, pl_tub);
+ Xg_define_procedure(gtk_box_get_homogeneous, gxg_gtk_box_get_homogeneous_w, 1, 0, 0, H_gtk_box_get_homogeneous, pl_bu);
+ Xg_define_procedure(gtk_box_set_spacing, gxg_gtk_box_set_spacing_w, 2, 0, 0, H_gtk_box_set_spacing, pl_tui);
+ Xg_define_procedure(gtk_box_get_spacing, gxg_gtk_box_get_spacing_w, 1, 0, 0, H_gtk_box_get_spacing, pl_iu);
+ Xg_define_procedure(gtk_box_reorder_child, gxg_gtk_box_reorder_child_w, 3, 0, 0, H_gtk_box_reorder_child, pl_tuui);
+ Xg_define_procedure(gtk_box_query_child_packing, gxg_gtk_box_query_child_packing_w, 2, 4, 0, H_gtk_box_query_child_packing, pl_tu);
+ Xg_define_procedure(gtk_box_set_child_packing, gxg_gtk_box_set_child_packing_w, 6, 0, 0, H_gtk_box_set_child_packing, pl_tuubbi);
+ Xg_define_procedure(gtk_button_new, gxg_gtk_button_new_w, 0, 0, 0, H_gtk_button_new, pl_p);
+ Xg_define_procedure(gtk_button_new_with_label, gxg_gtk_button_new_with_label_w, 1, 0, 0, H_gtk_button_new_with_label, pl_ps);
+ Xg_define_procedure(gtk_button_new_with_mnemonic, gxg_gtk_button_new_with_mnemonic_w, 1, 0, 0, H_gtk_button_new_with_mnemonic, pl_ps);
+ Xg_define_procedure(gtk_button_clicked, gxg_gtk_button_clicked_w, 1, 0, 0, H_gtk_button_clicked, pl_tu);
+ Xg_define_procedure(gtk_button_set_relief, gxg_gtk_button_set_relief_w, 2, 0, 0, H_gtk_button_set_relief, pl_tui);
+ Xg_define_procedure(gtk_button_get_relief, gxg_gtk_button_get_relief_w, 1, 0, 0, H_gtk_button_get_relief, pl_iu);
+ Xg_define_procedure(gtk_button_set_label, gxg_gtk_button_set_label_w, 2, 0, 0, H_gtk_button_set_label, pl_tus);
+ Xg_define_procedure(gtk_button_get_label, gxg_gtk_button_get_label_w, 1, 0, 0, H_gtk_button_get_label, pl_su);
+ Xg_define_procedure(gtk_button_set_use_underline, gxg_gtk_button_set_use_underline_w, 2, 0, 0, H_gtk_button_set_use_underline, pl_tub);
+ Xg_define_procedure(gtk_button_get_use_underline, gxg_gtk_button_get_use_underline_w, 1, 0, 0, H_gtk_button_get_use_underline, pl_bu);
+ Xg_define_procedure(gtk_calendar_new, gxg_gtk_calendar_new_w, 0, 0, 0, H_gtk_calendar_new, pl_p);
+ Xg_define_procedure(gtk_calendar_select_day, gxg_gtk_calendar_select_day_w, 2, 0, 0, H_gtk_calendar_select_day, pl_tui);
+ Xg_define_procedure(gtk_calendar_clear_marks, gxg_gtk_calendar_clear_marks_w, 1, 0, 0, H_gtk_calendar_clear_marks, pl_tu);
+ Xg_define_procedure(gtk_calendar_get_date, gxg_gtk_calendar_get_date_w, 1, 3, 0, H_gtk_calendar_get_date, pl_tu);
+ Xg_define_procedure(gtk_cell_editable_start_editing, gxg_gtk_cell_editable_start_editing_w, 2, 0, 0, H_gtk_cell_editable_start_editing, pl_tu);
+ Xg_define_procedure(gtk_cell_editable_editing_done, gxg_gtk_cell_editable_editing_done_w, 1, 0, 0, H_gtk_cell_editable_editing_done, pl_tu);
+ Xg_define_procedure(gtk_cell_editable_remove_widget, gxg_gtk_cell_editable_remove_widget_w, 1, 0, 0, H_gtk_cell_editable_remove_widget, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_activate, gxg_gtk_cell_renderer_activate_w, 7, 0, 0, H_gtk_cell_renderer_activate, pl_buuusuui);
+ Xg_define_procedure(gtk_cell_renderer_start_editing, gxg_gtk_cell_renderer_start_editing_w, 7, 0, 0, H_gtk_cell_renderer_start_editing, pl_puuusuui);
+ Xg_define_procedure(gtk_cell_renderer_set_fixed_size, gxg_gtk_cell_renderer_set_fixed_size_w, 3, 0, 0, H_gtk_cell_renderer_set_fixed_size, pl_tui);
+ Xg_define_procedure(gtk_cell_renderer_get_fixed_size, gxg_gtk_cell_renderer_get_fixed_size_w, 1, 2, 0, H_gtk_cell_renderer_get_fixed_size, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_pixbuf_new, gxg_gtk_cell_renderer_pixbuf_new_w, 0, 0, 0, H_gtk_cell_renderer_pixbuf_new, pl_p);
+ Xg_define_procedure(gtk_cell_renderer_text_new, gxg_gtk_cell_renderer_text_new_w, 0, 0, 0, H_gtk_cell_renderer_text_new, pl_p);
+ Xg_define_procedure(gtk_cell_renderer_text_set_fixed_height_from_font, gxg_gtk_cell_renderer_text_set_fixed_height_from_font_w, 2, 0, 0, H_gtk_cell_renderer_text_set_fixed_height_from_font, pl_tui);
+ Xg_define_procedure(gtk_cell_renderer_toggle_new, gxg_gtk_cell_renderer_toggle_new_w, 0, 0, 0, H_gtk_cell_renderer_toggle_new, pl_p);
+ Xg_define_procedure(gtk_cell_renderer_toggle_get_radio, gxg_gtk_cell_renderer_toggle_get_radio_w, 1, 0, 0, H_gtk_cell_renderer_toggle_get_radio, pl_bu);
+ Xg_define_procedure(gtk_cell_renderer_toggle_set_radio, gxg_gtk_cell_renderer_toggle_set_radio_w, 2, 0, 0, H_gtk_cell_renderer_toggle_set_radio, pl_tub);
+ Xg_define_procedure(gtk_cell_renderer_toggle_get_active, gxg_gtk_cell_renderer_toggle_get_active_w, 1, 0, 0, H_gtk_cell_renderer_toggle_get_active, pl_bu);
+ Xg_define_procedure(gtk_cell_renderer_toggle_set_active, gxg_gtk_cell_renderer_toggle_set_active_w, 2, 0, 0, H_gtk_cell_renderer_toggle_set_active, pl_tub);
+ Xg_define_procedure(gtk_check_button_new, gxg_gtk_check_button_new_w, 0, 0, 0, H_gtk_check_button_new, pl_p);
+ Xg_define_procedure(gtk_check_button_new_with_label, gxg_gtk_check_button_new_with_label_w, 1, 0, 0, H_gtk_check_button_new_with_label, pl_ps);
+ Xg_define_procedure(gtk_check_button_new_with_mnemonic, gxg_gtk_check_button_new_with_mnemonic_w, 1, 0, 0, H_gtk_check_button_new_with_mnemonic, pl_ps);
+ Xg_define_procedure(gtk_check_menu_item_new, gxg_gtk_check_menu_item_new_w, 0, 0, 0, H_gtk_check_menu_item_new, pl_p);
+ Xg_define_procedure(gtk_check_menu_item_new_with_label, gxg_gtk_check_menu_item_new_with_label_w, 1, 0, 0, H_gtk_check_menu_item_new_with_label, pl_ps);
+ Xg_define_procedure(gtk_check_menu_item_new_with_mnemonic, gxg_gtk_check_menu_item_new_with_mnemonic_w, 1, 0, 0, H_gtk_check_menu_item_new_with_mnemonic, pl_ps);
+ Xg_define_procedure(gtk_check_menu_item_set_active, gxg_gtk_check_menu_item_set_active_w, 2, 0, 0, H_gtk_check_menu_item_set_active, pl_tub);
+ Xg_define_procedure(gtk_check_menu_item_get_active, gxg_gtk_check_menu_item_get_active_w, 1, 0, 0, H_gtk_check_menu_item_get_active, pl_bu);
+ Xg_define_procedure(gtk_check_menu_item_toggled, gxg_gtk_check_menu_item_toggled_w, 1, 0, 0, H_gtk_check_menu_item_toggled, pl_tu);
+ Xg_define_procedure(gtk_check_menu_item_set_inconsistent, gxg_gtk_check_menu_item_set_inconsistent_w, 2, 0, 0, H_gtk_check_menu_item_set_inconsistent, pl_tub);
+ Xg_define_procedure(gtk_check_menu_item_get_inconsistent, gxg_gtk_check_menu_item_get_inconsistent_w, 1, 0, 0, H_gtk_check_menu_item_get_inconsistent, pl_bu);
+ Xg_define_procedure(gtk_clipboard_get, gxg_gtk_clipboard_get_w, 1, 0, 0, H_gtk_clipboard_get, pl_pt);
+ Xg_define_procedure(gtk_clipboard_set_with_data, gxg_gtk_clipboard_set_with_data_w, 5, 1, 0, H_gtk_clipboard_set_with_data, pl_buuit);
+ Xg_define_procedure(gtk_clipboard_get_owner, gxg_gtk_clipboard_get_owner_w, 1, 0, 0, H_gtk_clipboard_get_owner, pl_pu);
+ Xg_define_procedure(gtk_clipboard_clear, gxg_gtk_clipboard_clear_w, 1, 0, 0, H_gtk_clipboard_clear, pl_tu);
+ Xg_define_procedure(gtk_clipboard_set_text, gxg_gtk_clipboard_set_text_w, 3, 0, 0, H_gtk_clipboard_set_text, pl_tusi);
+ Xg_define_procedure(gtk_clipboard_request_contents, gxg_gtk_clipboard_request_contents_w, 3, 1, 0, H_gtk_clipboard_request_contents, pl_tut);
+ Xg_define_procedure(gtk_clipboard_request_text, gxg_gtk_clipboard_request_text_w, 2, 1, 0, H_gtk_clipboard_request_text, pl_tut);
+ Xg_define_procedure(gtk_clipboard_wait_for_contents, gxg_gtk_clipboard_wait_for_contents_w, 2, 0, 0, H_gtk_clipboard_wait_for_contents, pl_put);
+ Xg_define_procedure(gtk_clipboard_wait_for_text, gxg_gtk_clipboard_wait_for_text_w, 1, 0, 0, H_gtk_clipboard_wait_for_text, pl_su);
+ Xg_define_procedure(gtk_clipboard_wait_is_text_available, gxg_gtk_clipboard_wait_is_text_available_w, 1, 0, 0, H_gtk_clipboard_wait_is_text_available, pl_bu);
+ Xg_define_procedure(gtk_container_set_border_width, gxg_gtk_container_set_border_width_w, 2, 0, 0, H_gtk_container_set_border_width, pl_tui);
+ Xg_define_procedure(gtk_container_get_border_width, gxg_gtk_container_get_border_width_w, 1, 0, 0, H_gtk_container_get_border_width, pl_iu);
+ Xg_define_procedure(gtk_container_add, gxg_gtk_container_add_w, 2, 0, 0, H_gtk_container_add, pl_tu);
+ Xg_define_procedure(gtk_container_remove, gxg_gtk_container_remove_w, 2, 0, 0, H_gtk_container_remove, pl_tu);
+ Xg_define_procedure(gtk_container_check_resize, gxg_gtk_container_check_resize_w, 1, 0, 0, H_gtk_container_check_resize, pl_tu);
+ Xg_define_procedure(gtk_container_foreach, gxg_gtk_container_foreach_w, 2, 1, 0, H_gtk_container_foreach, pl_tut);
+ Xg_define_procedure(gtk_container_get_children, gxg_gtk_container_get_children_w, 1, 0, 0, H_gtk_container_get_children, pl_pu);
+ Xg_define_procedure(gtk_dialog_new, gxg_gtk_dialog_new_w, 0, 0, 0, H_gtk_dialog_new, pl_p);
+ Xg_define_procedure(gtk_dialog_add_action_widget, gxg_gtk_dialog_add_action_widget_w, 3, 0, 0, H_gtk_dialog_add_action_widget, pl_tuui);
+ Xg_define_procedure(gtk_dialog_add_button, gxg_gtk_dialog_add_button_w, 3, 0, 0, H_gtk_dialog_add_button, pl_pusi);
+ Xg_define_procedure(gtk_dialog_add_buttons, gxg_gtk_dialog_add_buttons_w, 2, 0, 0, H_gtk_dialog_add_buttons, pl_tut);
+ Xg_define_procedure(gtk_dialog_set_response_sensitive, gxg_gtk_dialog_set_response_sensitive_w, 3, 0, 0, H_gtk_dialog_set_response_sensitive, pl_tuib);
+ Xg_define_procedure(gtk_dialog_set_default_response, gxg_gtk_dialog_set_default_response_w, 2, 0, 0, H_gtk_dialog_set_default_response, pl_tui);
+ Xg_define_procedure(gtk_dialog_response, gxg_gtk_dialog_response_w, 2, 0, 0, H_gtk_dialog_response, pl_tui);
+ Xg_define_procedure(gtk_dialog_run, gxg_gtk_dialog_run_w, 1, 0, 0, H_gtk_dialog_run, pl_iu);
+ Xg_define_procedure(gtk_drag_get_data, gxg_gtk_drag_get_data_w, 4, 0, 0, H_gtk_drag_get_data, pl_tuuti);
+ Xg_define_procedure(gtk_drag_finish, gxg_gtk_drag_finish_w, 4, 0, 0, H_gtk_drag_finish, pl_tubbi);
+ Xg_define_procedure(gtk_drag_get_source_widget, gxg_gtk_drag_get_source_widget_w, 1, 0, 0, H_gtk_drag_get_source_widget, pl_pu);
+ Xg_define_procedure(gtk_drag_highlight, gxg_gtk_drag_highlight_w, 1, 0, 0, H_gtk_drag_highlight, pl_tu);
+ Xg_define_procedure(gtk_drag_unhighlight, gxg_gtk_drag_unhighlight_w, 1, 0, 0, H_gtk_drag_unhighlight, pl_tu);
+ Xg_define_procedure(gtk_drag_dest_set, gxg_gtk_drag_dest_set_w, 5, 0, 0, H_gtk_drag_dest_set, pl_tuiui);
+ Xg_define_procedure(gtk_drag_dest_unset, gxg_gtk_drag_dest_unset_w, 1, 0, 0, H_gtk_drag_dest_unset, pl_tu);
+ Xg_define_procedure(gtk_drag_dest_find_target, gxg_gtk_drag_dest_find_target_w, 3, 0, 0, H_gtk_drag_dest_find_target, pl_tu);
+ Xg_define_procedure(gtk_drag_dest_get_target_list, gxg_gtk_drag_dest_get_target_list_w, 1, 0, 0, H_gtk_drag_dest_get_target_list, pl_pu);
+ Xg_define_procedure(gtk_drag_dest_set_target_list, gxg_gtk_drag_dest_set_target_list_w, 2, 0, 0, H_gtk_drag_dest_set_target_list, pl_tu);
+ Xg_define_procedure(gtk_drag_source_set, gxg_gtk_drag_source_set_w, 5, 0, 0, H_gtk_drag_source_set, pl_tuiui);
+ Xg_define_procedure(gtk_drag_source_unset, gxg_gtk_drag_source_unset_w, 1, 0, 0, H_gtk_drag_source_unset, pl_tu);
+ Xg_define_procedure(gtk_drag_source_set_icon_pixbuf, gxg_gtk_drag_source_set_icon_pixbuf_w, 2, 0, 0, H_gtk_drag_source_set_icon_pixbuf, pl_tu);
+ Xg_define_procedure(gtk_drag_set_icon_widget, gxg_gtk_drag_set_icon_widget_w, 4, 0, 0, H_gtk_drag_set_icon_widget, pl_tuui);
+ Xg_define_procedure(gtk_drag_set_icon_pixbuf, gxg_gtk_drag_set_icon_pixbuf_w, 4, 0, 0, H_gtk_drag_set_icon_pixbuf, pl_tuui);
+ Xg_define_procedure(gtk_drag_set_icon_default, gxg_gtk_drag_set_icon_default_w, 1, 0, 0, H_gtk_drag_set_icon_default, pl_tu);
+ Xg_define_procedure(gtk_drag_check_threshold, gxg_gtk_drag_check_threshold_w, 5, 0, 0, H_gtk_drag_check_threshold, pl_bui);
+ Xg_define_procedure(gtk_drawing_area_new, gxg_gtk_drawing_area_new_w, 0, 0, 0, H_gtk_drawing_area_new, pl_p);
+ Xg_define_procedure(gtk_editable_select_region, gxg_gtk_editable_select_region_w, 3, 0, 0, H_gtk_editable_select_region, pl_tui);
+ Xg_define_procedure(gtk_editable_get_selection_bounds, gxg_gtk_editable_get_selection_bounds_w, 1, 2, 0, H_gtk_editable_get_selection_bounds, pl_bu);
+ Xg_define_procedure(gtk_editable_insert_text, gxg_gtk_editable_insert_text_w, 3, 1, 0, H_gtk_editable_insert_text, pl_tusiu);
+ Xg_define_procedure(gtk_editable_delete_text, gxg_gtk_editable_delete_text_w, 3, 0, 0, H_gtk_editable_delete_text, pl_tui);
+ Xg_define_procedure(gtk_editable_get_chars, gxg_gtk_editable_get_chars_w, 3, 0, 0, H_gtk_editable_get_chars, pl_sui);
+ Xg_define_procedure(gtk_editable_cut_clipboard, gxg_gtk_editable_cut_clipboard_w, 1, 0, 0, H_gtk_editable_cut_clipboard, pl_tu);
+ Xg_define_procedure(gtk_editable_copy_clipboard, gxg_gtk_editable_copy_clipboard_w, 1, 0, 0, H_gtk_editable_copy_clipboard, pl_tu);
+ Xg_define_procedure(gtk_editable_paste_clipboard, gxg_gtk_editable_paste_clipboard_w, 1, 0, 0, H_gtk_editable_paste_clipboard, pl_tu);
+ Xg_define_procedure(gtk_editable_delete_selection, gxg_gtk_editable_delete_selection_w, 1, 0, 0, H_gtk_editable_delete_selection, pl_tu);
+ Xg_define_procedure(gtk_editable_set_position, gxg_gtk_editable_set_position_w, 2, 0, 0, H_gtk_editable_set_position, pl_tui);
+ Xg_define_procedure(gtk_editable_get_position, gxg_gtk_editable_get_position_w, 1, 0, 0, H_gtk_editable_get_position, pl_iu);
+ Xg_define_procedure(gtk_editable_set_editable, gxg_gtk_editable_set_editable_w, 2, 0, 0, H_gtk_editable_set_editable, pl_tub);
+ Xg_define_procedure(gtk_editable_get_editable, gxg_gtk_editable_get_editable_w, 1, 0, 0, H_gtk_editable_get_editable, pl_bu);
+ Xg_define_procedure(gtk_entry_new, gxg_gtk_entry_new_w, 0, 0, 0, H_gtk_entry_new, pl_p);
+ Xg_define_procedure(gtk_entry_set_visibility, gxg_gtk_entry_set_visibility_w, 2, 0, 0, H_gtk_entry_set_visibility, pl_tub);
+ Xg_define_procedure(gtk_entry_get_visibility, gxg_gtk_entry_get_visibility_w, 1, 0, 0, H_gtk_entry_get_visibility, pl_bu);
+ Xg_define_procedure(gtk_entry_set_invisible_char, gxg_gtk_entry_set_invisible_char_w, 2, 0, 0, H_gtk_entry_set_invisible_char, pl_tui);
+ Xg_define_procedure(gtk_entry_get_invisible_char, gxg_gtk_entry_get_invisible_char_w, 1, 0, 0, H_gtk_entry_get_invisible_char, pl_iu);
+ Xg_define_procedure(gtk_entry_set_has_frame, gxg_gtk_entry_set_has_frame_w, 2, 0, 0, H_gtk_entry_set_has_frame, pl_tub);
+ Xg_define_procedure(gtk_entry_get_has_frame, gxg_gtk_entry_get_has_frame_w, 1, 0, 0, H_gtk_entry_get_has_frame, pl_bu);
+ Xg_define_procedure(gtk_entry_set_max_length, gxg_gtk_entry_set_max_length_w, 2, 0, 0, H_gtk_entry_set_max_length, pl_tui);
+ Xg_define_procedure(gtk_entry_get_max_length, gxg_gtk_entry_get_max_length_w, 1, 0, 0, H_gtk_entry_get_max_length, pl_iu);
+ Xg_define_procedure(gtk_entry_set_activates_default, gxg_gtk_entry_set_activates_default_w, 2, 0, 0, H_gtk_entry_set_activates_default, pl_tub);
+ Xg_define_procedure(gtk_entry_get_activates_default, gxg_gtk_entry_get_activates_default_w, 1, 0, 0, H_gtk_entry_get_activates_default, pl_bu);
+ Xg_define_procedure(gtk_entry_set_width_chars, gxg_gtk_entry_set_width_chars_w, 2, 0, 0, H_gtk_entry_set_width_chars, pl_tui);
+ Xg_define_procedure(gtk_entry_get_width_chars, gxg_gtk_entry_get_width_chars_w, 1, 0, 0, H_gtk_entry_get_width_chars, pl_iu);
+ Xg_define_procedure(gtk_entry_set_text, gxg_gtk_entry_set_text_w, 2, 0, 0, H_gtk_entry_set_text, pl_tus);
+ Xg_define_procedure(gtk_entry_get_text, gxg_gtk_entry_get_text_w, 1, 0, 0, H_gtk_entry_get_text, pl_su);
+ Xg_define_procedure(gtk_entry_get_layout, gxg_gtk_entry_get_layout_w, 1, 0, 0, H_gtk_entry_get_layout, pl_pu);
+ Xg_define_procedure(gtk_entry_get_layout_offsets, gxg_gtk_entry_get_layout_offsets_w, 1, 2, 0, H_gtk_entry_get_layout_offsets, pl_tu);
+ Xg_define_procedure(gtk_event_box_new, gxg_gtk_event_box_new_w, 0, 0, 0, H_gtk_event_box_new, pl_p);
+ Xg_define_procedure(gtk_fixed_new, gxg_gtk_fixed_new_w, 0, 0, 0, H_gtk_fixed_new, pl_p);
+ Xg_define_procedure(gtk_fixed_put, gxg_gtk_fixed_put_w, 4, 0, 0, H_gtk_fixed_put, pl_tuui);
+ Xg_define_procedure(gtk_fixed_move, gxg_gtk_fixed_move_w, 4, 0, 0, H_gtk_fixed_move, pl_tuui);
+ Xg_define_procedure(gtk_frame_new, gxg_gtk_frame_new_w, 1, 0, 0, H_gtk_frame_new, pl_ps);
+ Xg_define_procedure(gtk_frame_set_label, gxg_gtk_frame_set_label_w, 2, 0, 0, H_gtk_frame_set_label, pl_tus);
+ Xg_define_procedure(gtk_frame_get_label, gxg_gtk_frame_get_label_w, 1, 0, 0, H_gtk_frame_get_label, pl_su);
+ Xg_define_procedure(gtk_frame_set_label_widget, gxg_gtk_frame_set_label_widget_w, 2, 0, 0, H_gtk_frame_set_label_widget, pl_tu);
+ Xg_define_procedure(gtk_frame_get_label_widget, gxg_gtk_frame_get_label_widget_w, 1, 0, 0, H_gtk_frame_get_label_widget, pl_pu);
+ Xg_define_procedure(gtk_frame_set_label_align, gxg_gtk_frame_set_label_align_w, 3, 0, 0, H_gtk_frame_set_label_align, pl_tur);
+ Xg_define_procedure(gtk_frame_get_label_align, gxg_gtk_frame_get_label_align_w, 1, 2, 0, H_gtk_frame_get_label_align, pl_tu);
+ Xg_define_procedure(gtk_frame_set_shadow_type, gxg_gtk_frame_set_shadow_type_w, 2, 0, 0, H_gtk_frame_set_shadow_type, pl_tui);
+ Xg_define_procedure(gtk_frame_get_shadow_type, gxg_gtk_frame_get_shadow_type_w, 1, 0, 0, H_gtk_frame_get_shadow_type, pl_iu);
+ Xg_define_procedure(gtk_image_new, gxg_gtk_image_new_w, 0, 0, 0, H_gtk_image_new, pl_p);
+ Xg_define_procedure(gtk_image_new_from_file, gxg_gtk_image_new_from_file_w, 1, 0, 0, H_gtk_image_new_from_file, pl_ps);
+ Xg_define_procedure(gtk_image_new_from_pixbuf, gxg_gtk_image_new_from_pixbuf_w, 1, 0, 0, H_gtk_image_new_from_pixbuf, pl_pu);
+ Xg_define_procedure(gtk_image_new_from_animation, gxg_gtk_image_new_from_animation_w, 1, 0, 0, H_gtk_image_new_from_animation, pl_pu);
+ Xg_define_procedure(gtk_image_set_from_file, gxg_gtk_image_set_from_file_w, 2, 0, 0, H_gtk_image_set_from_file, pl_tus);
+ Xg_define_procedure(gtk_image_set_from_pixbuf, gxg_gtk_image_set_from_pixbuf_w, 2, 0, 0, H_gtk_image_set_from_pixbuf, pl_tu);
+ Xg_define_procedure(gtk_image_set_from_animation, gxg_gtk_image_set_from_animation_w, 2, 0, 0, H_gtk_image_set_from_animation, pl_tu);
+ Xg_define_procedure(gtk_image_get_storage_type, gxg_gtk_image_get_storage_type_w, 1, 0, 0, H_gtk_image_get_storage_type, pl_iu);
+ Xg_define_procedure(gtk_image_get_pixbuf, gxg_gtk_image_get_pixbuf_w, 1, 0, 0, H_gtk_image_get_pixbuf, pl_pu);
+ Xg_define_procedure(gtk_image_get_animation, gxg_gtk_image_get_animation_w, 1, 0, 0, H_gtk_image_get_animation, pl_pu);
+ Xg_define_procedure(gtk_im_context_set_client_window, gxg_gtk_im_context_set_client_window_w, 2, 0, 0, H_gtk_im_context_set_client_window, pl_tu);
+ Xg_define_procedure(gtk_im_context_get_preedit_string, gxg_gtk_im_context_get_preedit_string_w, 1, 3, 0, H_gtk_im_context_get_preedit_string, pl_tu);
+ Xg_define_procedure(gtk_im_context_filter_keypress, gxg_gtk_im_context_filter_keypress_w, 2, 0, 0, H_gtk_im_context_filter_keypress, pl_bu);
+ Xg_define_procedure(gtk_im_context_focus_in, gxg_gtk_im_context_focus_in_w, 1, 0, 0, H_gtk_im_context_focus_in, pl_tu);
+ Xg_define_procedure(gtk_im_context_focus_out, gxg_gtk_im_context_focus_out_w, 1, 0, 0, H_gtk_im_context_focus_out, pl_tu);
+ Xg_define_procedure(gtk_im_context_reset, gxg_gtk_im_context_reset_w, 1, 0, 0, H_gtk_im_context_reset, pl_tu);
+ Xg_define_procedure(gtk_im_context_set_cursor_location, gxg_gtk_im_context_set_cursor_location_w, 2, 0, 0, H_gtk_im_context_set_cursor_location, pl_tu);
+ Xg_define_procedure(gtk_im_context_set_use_preedit, gxg_gtk_im_context_set_use_preedit_w, 2, 0, 0, H_gtk_im_context_set_use_preedit, pl_tub);
+ Xg_define_procedure(gtk_im_context_set_surrounding, gxg_gtk_im_context_set_surrounding_w, 4, 0, 0, H_gtk_im_context_set_surrounding, pl_tusi);
+ Xg_define_procedure(gtk_im_context_get_surrounding, gxg_gtk_im_context_get_surrounding_w, 1, 2, 0, H_gtk_im_context_get_surrounding, pl_bu);
+ Xg_define_procedure(gtk_im_context_delete_surrounding, gxg_gtk_im_context_delete_surrounding_w, 3, 0, 0, H_gtk_im_context_delete_surrounding, pl_bui);
+ Xg_define_procedure(gtk_im_context_simple_new, gxg_gtk_im_context_simple_new_w, 0, 0, 0, H_gtk_im_context_simple_new, pl_p);
+ Xg_define_procedure(gtk_im_context_simple_add_table, gxg_gtk_im_context_simple_add_table_w, 4, 0, 0, H_gtk_im_context_simple_add_table, pl_tuui);
+ Xg_define_procedure(gtk_invisible_new, gxg_gtk_invisible_new_w, 0, 0, 0, H_gtk_invisible_new, pl_p);
+ Xg_define_procedure(gtk_label_new, gxg_gtk_label_new_w, 1, 0, 0, H_gtk_label_new, pl_ps);
+ Xg_define_procedure(gtk_label_new_with_mnemonic, gxg_gtk_label_new_with_mnemonic_w, 1, 0, 0, H_gtk_label_new_with_mnemonic, pl_ps);
+ Xg_define_procedure(gtk_label_set_text, gxg_gtk_label_set_text_w, 2, 0, 0, H_gtk_label_set_text, pl_tus);
+ Xg_define_procedure(gtk_label_get_text, gxg_gtk_label_get_text_w, 1, 0, 0, H_gtk_label_get_text, pl_su);
+ Xg_define_procedure(gtk_label_set_attributes, gxg_gtk_label_set_attributes_w, 2, 0, 0, H_gtk_label_set_attributes, pl_tu);
+ Xg_define_procedure(gtk_label_get_attributes, gxg_gtk_label_get_attributes_w, 1, 0, 0, H_gtk_label_get_attributes, pl_pu);
+ Xg_define_procedure(gtk_label_set_label, gxg_gtk_label_set_label_w, 2, 0, 0, H_gtk_label_set_label, pl_tus);
+ Xg_define_procedure(gtk_label_get_label, gxg_gtk_label_get_label_w, 1, 0, 0, H_gtk_label_get_label, pl_su);
+ Xg_define_procedure(gtk_label_set_markup, gxg_gtk_label_set_markup_w, 2, 0, 0, H_gtk_label_set_markup, pl_tus);
+ Xg_define_procedure(gtk_label_set_use_markup, gxg_gtk_label_set_use_markup_w, 2, 0, 0, H_gtk_label_set_use_markup, pl_tub);
+ Xg_define_procedure(gtk_label_get_use_markup, gxg_gtk_label_get_use_markup_w, 1, 0, 0, H_gtk_label_get_use_markup, pl_bu);
+ Xg_define_procedure(gtk_label_set_use_underline, gxg_gtk_label_set_use_underline_w, 2, 0, 0, H_gtk_label_set_use_underline, pl_tub);
+ Xg_define_procedure(gtk_label_get_use_underline, gxg_gtk_label_get_use_underline_w, 1, 0, 0, H_gtk_label_get_use_underline, pl_bu);
+ Xg_define_procedure(gtk_label_set_markup_with_mnemonic, gxg_gtk_label_set_markup_with_mnemonic_w, 2, 0, 0, H_gtk_label_set_markup_with_mnemonic, pl_tus);
+ Xg_define_procedure(gtk_label_get_mnemonic_keyval, gxg_gtk_label_get_mnemonic_keyval_w, 1, 0, 0, H_gtk_label_get_mnemonic_keyval, pl_iu);
+ Xg_define_procedure(gtk_label_set_mnemonic_widget, gxg_gtk_label_set_mnemonic_widget_w, 2, 0, 0, H_gtk_label_set_mnemonic_widget, pl_tu);
+ Xg_define_procedure(gtk_label_get_mnemonic_widget, gxg_gtk_label_get_mnemonic_widget_w, 1, 0, 0, H_gtk_label_get_mnemonic_widget, pl_pu);
+ Xg_define_procedure(gtk_label_set_text_with_mnemonic, gxg_gtk_label_set_text_with_mnemonic_w, 2, 0, 0, H_gtk_label_set_text_with_mnemonic, pl_tus);
+ Xg_define_procedure(gtk_label_set_justify, gxg_gtk_label_set_justify_w, 2, 0, 0, H_gtk_label_set_justify, pl_tui);
+ Xg_define_procedure(gtk_label_get_justify, gxg_gtk_label_get_justify_w, 1, 0, 0, H_gtk_label_get_justify, pl_iu);
+ Xg_define_procedure(gtk_label_set_pattern, gxg_gtk_label_set_pattern_w, 2, 0, 0, H_gtk_label_set_pattern, pl_tus);
+ Xg_define_procedure(gtk_label_set_line_wrap, gxg_gtk_label_set_line_wrap_w, 2, 0, 0, H_gtk_label_set_line_wrap, pl_tub);
+ Xg_define_procedure(gtk_label_get_line_wrap, gxg_gtk_label_get_line_wrap_w, 1, 0, 0, H_gtk_label_get_line_wrap, pl_bu);
+ Xg_define_procedure(gtk_label_set_selectable, gxg_gtk_label_set_selectable_w, 2, 0, 0, H_gtk_label_set_selectable, pl_tub);
+ Xg_define_procedure(gtk_label_get_selectable, gxg_gtk_label_get_selectable_w, 1, 0, 0, H_gtk_label_get_selectable, pl_bu);
+ Xg_define_procedure(gtk_label_select_region, gxg_gtk_label_select_region_w, 3, 0, 0, H_gtk_label_select_region, pl_tui);
+ Xg_define_procedure(gtk_label_get_selection_bounds, gxg_gtk_label_get_selection_bounds_w, 1, 2, 0, H_gtk_label_get_selection_bounds, pl_bu);
+ Xg_define_procedure(gtk_label_get_layout, gxg_gtk_label_get_layout_w, 1, 0, 0, H_gtk_label_get_layout, pl_pu);
+ Xg_define_procedure(gtk_label_get_layout_offsets, gxg_gtk_label_get_layout_offsets_w, 1, 2, 0, H_gtk_label_get_layout_offsets, pl_tu);
+ Xg_define_procedure(gtk_layout_new, gxg_gtk_layout_new_w, 2, 0, 0, H_gtk_layout_new, pl_pu);
+ Xg_define_procedure(gtk_layout_put, gxg_gtk_layout_put_w, 4, 0, 0, H_gtk_layout_put, pl_tuui);
+ Xg_define_procedure(gtk_layout_move, gxg_gtk_layout_move_w, 4, 0, 0, H_gtk_layout_move, pl_tuui);
+ Xg_define_procedure(gtk_layout_set_size, gxg_gtk_layout_set_size_w, 3, 0, 0, H_gtk_layout_set_size, pl_tui);
+ Xg_define_procedure(gtk_layout_get_size, gxg_gtk_layout_get_size_w, 1, 2, 0, H_gtk_layout_get_size, pl_tu);
+ Xg_define_procedure(gtk_list_store_new, gxg_gtk_list_store_new_w, 2, 0, 0, H_gtk_list_store_new, pl_pit);
+ Xg_define_procedure(gtk_list_store_newv, gxg_gtk_list_store_newv_w, 2, 0, 0, H_gtk_list_store_newv, pl_piu);
+ Xg_define_procedure(gtk_list_store_set_column_types, gxg_gtk_list_store_set_column_types_w, 3, 0, 0, H_gtk_list_store_set_column_types, pl_tuiu);
+ Xg_define_procedure(gtk_list_store_set, gxg_gtk_list_store_set_w, 3, 0, 0, H_gtk_list_store_set, pl_tuut);
+ Xg_define_procedure(gtk_list_store_insert, gxg_gtk_list_store_insert_w, 3, 0, 0, H_gtk_list_store_insert, pl_tuui);
+ Xg_define_procedure(gtk_list_store_insert_before, gxg_gtk_list_store_insert_before_w, 3, 0, 0, H_gtk_list_store_insert_before, pl_tu);
+ Xg_define_procedure(gtk_list_store_insert_after, gxg_gtk_list_store_insert_after_w, 3, 0, 0, H_gtk_list_store_insert_after, pl_tu);
+ Xg_define_procedure(gtk_list_store_prepend, gxg_gtk_list_store_prepend_w, 2, 0, 0, H_gtk_list_store_prepend, pl_tu);
+ Xg_define_procedure(gtk_list_store_append, gxg_gtk_list_store_append_w, 2, 0, 0, H_gtk_list_store_append, pl_tu);
+ Xg_define_procedure(gtk_list_store_clear, gxg_gtk_list_store_clear_w, 1, 0, 0, H_gtk_list_store_clear, pl_tu);
+ Xg_define_procedure(gtk_check_version, gxg_gtk_check_version_w, 3, 0, 0, H_gtk_check_version, pl_si);
+ Xg_define_procedure(gtk_disable_setlocale, gxg_gtk_disable_setlocale_w, 0, 0, 0, H_gtk_disable_setlocale, pl_t);
+ Xg_define_procedure(gtk_get_default_language, gxg_gtk_get_default_language_w, 0, 0, 0, H_gtk_get_default_language, pl_p);
+ Xg_define_procedure(gtk_events_pending, gxg_gtk_events_pending_w, 0, 0, 0, H_gtk_events_pending, pl_i);
+ Xg_define_procedure(gtk_main_do_event, gxg_gtk_main_do_event_w, 1, 0, 0, H_gtk_main_do_event, pl_tu);
+ Xg_define_procedure(gtk_main, gxg_gtk_main_w, 0, 0, 0, H_gtk_main, pl_t);
+ Xg_define_procedure(gtk_main_level, gxg_gtk_main_level_w, 0, 0, 0, H_gtk_main_level, pl_i);
+ Xg_define_procedure(gtk_main_quit, gxg_gtk_main_quit_w, 0, 0, 0, H_gtk_main_quit, pl_t);
+ Xg_define_procedure(gtk_main_iteration, gxg_gtk_main_iteration_w, 0, 0, 0, H_gtk_main_iteration, pl_b);
+ Xg_define_procedure(gtk_main_iteration_do, gxg_gtk_main_iteration_do_w, 1, 0, 0, H_gtk_main_iteration_do, pl_b);
+ Xg_define_procedure(gtk_true, gxg_gtk_true_w, 0, 0, 0, H_gtk_true, pl_b);
+ Xg_define_procedure(gtk_false, gxg_gtk_false_w, 0, 0, 0, H_gtk_false, pl_b);
+ Xg_define_procedure(gtk_grab_add, gxg_gtk_grab_add_w, 1, 0, 0, H_gtk_grab_add, pl_tu);
+ Xg_define_procedure(gtk_grab_get_current, gxg_gtk_grab_get_current_w, 0, 0, 0, H_gtk_grab_get_current, pl_p);
+ Xg_define_procedure(gtk_grab_remove, gxg_gtk_grab_remove_w, 1, 0, 0, H_gtk_grab_remove, pl_tu);
+ Xg_define_procedure(gtk_get_current_event, gxg_gtk_get_current_event_w, 0, 0, 0, H_gtk_get_current_event, pl_p);
+ Xg_define_procedure(gtk_get_current_event_time, gxg_gtk_get_current_event_time_w, 0, 0, 0, H_gtk_get_current_event_time, pl_i);
+ Xg_define_procedure(gtk_get_current_event_state, gxg_gtk_get_current_event_state_w, 0, 1, 0, H_gtk_get_current_event_state, pl_bu);
+ Xg_define_procedure(gtk_get_event_widget, gxg_gtk_get_event_widget_w, 1, 0, 0, H_gtk_get_event_widget, pl_pu);
+ Xg_define_procedure(gtk_propagate_event, gxg_gtk_propagate_event_w, 2, 0, 0, H_gtk_propagate_event, pl_tu);
+ Xg_define_procedure(gtk_menu_bar_new, gxg_gtk_menu_bar_new_w, 0, 0, 0, H_gtk_menu_bar_new, pl_p);
+ Xg_define_procedure(gtk_menu_new, gxg_gtk_menu_new_w, 0, 0, 0, H_gtk_menu_new, pl_p);
+ Xg_define_procedure(gtk_menu_popup, gxg_gtk_menu_popup_w, 7, 0, 0, H_gtk_menu_popup, pl_tuuutti);
+ Xg_define_procedure(gtk_menu_reposition, gxg_gtk_menu_reposition_w, 1, 0, 0, H_gtk_menu_reposition, pl_tu);
+ Xg_define_procedure(gtk_menu_popdown, gxg_gtk_menu_popdown_w, 1, 0, 0, H_gtk_menu_popdown, pl_tu);
+ Xg_define_procedure(gtk_menu_get_active, gxg_gtk_menu_get_active_w, 1, 0, 0, H_gtk_menu_get_active, pl_pu);
+ Xg_define_procedure(gtk_menu_set_active, gxg_gtk_menu_set_active_w, 2, 0, 0, H_gtk_menu_set_active, pl_tui);
+ Xg_define_procedure(gtk_menu_set_accel_group, gxg_gtk_menu_set_accel_group_w, 2, 0, 0, H_gtk_menu_set_accel_group, pl_tu);
+ Xg_define_procedure(gtk_menu_get_accel_group, gxg_gtk_menu_get_accel_group_w, 1, 0, 0, H_gtk_menu_get_accel_group, pl_pu);
+ Xg_define_procedure(gtk_menu_set_accel_path, gxg_gtk_menu_set_accel_path_w, 2, 0, 0, H_gtk_menu_set_accel_path, pl_tus);
+ Xg_define_procedure(gtk_menu_detach, gxg_gtk_menu_detach_w, 1, 0, 0, H_gtk_menu_detach, pl_tu);
+ Xg_define_procedure(gtk_menu_get_attach_widget, gxg_gtk_menu_get_attach_widget_w, 1, 0, 0, H_gtk_menu_get_attach_widget, pl_pu);
+ Xg_define_procedure(gtk_menu_reorder_child, gxg_gtk_menu_reorder_child_w, 3, 0, 0, H_gtk_menu_reorder_child, pl_tuui);
+ Xg_define_procedure(gtk_menu_set_monitor, gxg_gtk_menu_set_monitor_w, 2, 0, 0, H_gtk_menu_set_monitor, pl_tui);
+ Xg_define_procedure(gtk_menu_item_new, gxg_gtk_menu_item_new_w, 0, 0, 0, H_gtk_menu_item_new, pl_p);
+ Xg_define_procedure(gtk_menu_item_new_with_label, gxg_gtk_menu_item_new_with_label_w, 1, 0, 0, H_gtk_menu_item_new_with_label, pl_ps);
+ Xg_define_procedure(gtk_menu_item_new_with_mnemonic, gxg_gtk_menu_item_new_with_mnemonic_w, 1, 0, 0, H_gtk_menu_item_new_with_mnemonic, pl_ps);
+ Xg_define_procedure(gtk_menu_item_set_submenu, gxg_gtk_menu_item_set_submenu_w, 2, 0, 0, H_gtk_menu_item_set_submenu, pl_tu);
+ Xg_define_procedure(gtk_menu_item_get_submenu, gxg_gtk_menu_item_get_submenu_w, 1, 0, 0, H_gtk_menu_item_get_submenu, pl_pu);
+ Xg_define_procedure(gtk_menu_item_select, gxg_gtk_menu_item_select_w, 1, 0, 0, H_gtk_menu_item_select, pl_tu);
+ Xg_define_procedure(gtk_menu_item_deselect, gxg_gtk_menu_item_deselect_w, 1, 0, 0, H_gtk_menu_item_deselect, pl_tu);
+ Xg_define_procedure(gtk_menu_item_activate, gxg_gtk_menu_item_activate_w, 1, 0, 0, H_gtk_menu_item_activate, pl_tu);
+ Xg_define_procedure(gtk_menu_item_toggle_size_request, gxg_gtk_menu_item_toggle_size_request_w, 2, 0, 0, H_gtk_menu_item_toggle_size_request, pl_tu);
+ Xg_define_procedure(gtk_menu_item_toggle_size_allocate, gxg_gtk_menu_item_toggle_size_allocate_w, 2, 0, 0, H_gtk_menu_item_toggle_size_allocate, pl_tui);
+ Xg_define_procedure(gtk_menu_item_set_accel_path, gxg_gtk_menu_item_set_accel_path_w, 2, 0, 0, H_gtk_menu_item_set_accel_path, pl_tus);
+ Xg_define_procedure(gtk_menu_shell_append, gxg_gtk_menu_shell_append_w, 2, 0, 0, H_gtk_menu_shell_append, pl_tu);
+ Xg_define_procedure(gtk_menu_shell_prepend, gxg_gtk_menu_shell_prepend_w, 2, 0, 0, H_gtk_menu_shell_prepend, pl_tu);
+ Xg_define_procedure(gtk_menu_shell_insert, gxg_gtk_menu_shell_insert_w, 3, 0, 0, H_gtk_menu_shell_insert, pl_tuui);
+ Xg_define_procedure(gtk_menu_shell_deactivate, gxg_gtk_menu_shell_deactivate_w, 1, 0, 0, H_gtk_menu_shell_deactivate, pl_tu);
+ Xg_define_procedure(gtk_menu_shell_select_item, gxg_gtk_menu_shell_select_item_w, 2, 0, 0, H_gtk_menu_shell_select_item, pl_tu);
+ Xg_define_procedure(gtk_menu_shell_deselect, gxg_gtk_menu_shell_deselect_w, 1, 0, 0, H_gtk_menu_shell_deselect, pl_tu);
+ Xg_define_procedure(gtk_menu_shell_activate_item, gxg_gtk_menu_shell_activate_item_w, 3, 0, 0, H_gtk_menu_shell_activate_item, pl_tuub);
+ Xg_define_procedure(gtk_notebook_new, gxg_gtk_notebook_new_w, 0, 0, 0, H_gtk_notebook_new, pl_p);
+ Xg_define_procedure(gtk_notebook_remove_page, gxg_gtk_notebook_remove_page_w, 2, 0, 0, H_gtk_notebook_remove_page, pl_tui);
+ Xg_define_procedure(gtk_notebook_get_current_page, gxg_gtk_notebook_get_current_page_w, 1, 0, 0, H_gtk_notebook_get_current_page, pl_iu);
+ Xg_define_procedure(gtk_notebook_get_nth_page, gxg_gtk_notebook_get_nth_page_w, 2, 0, 0, H_gtk_notebook_get_nth_page, pl_pui);
+ Xg_define_procedure(gtk_notebook_page_num, gxg_gtk_notebook_page_num_w, 2, 0, 0, H_gtk_notebook_page_num, pl_iu);
+ Xg_define_procedure(gtk_notebook_set_current_page, gxg_gtk_notebook_set_current_page_w, 2, 0, 0, H_gtk_notebook_set_current_page, pl_tui);
+ Xg_define_procedure(gtk_notebook_next_page, gxg_gtk_notebook_next_page_w, 1, 0, 0, H_gtk_notebook_next_page, pl_tu);
+ Xg_define_procedure(gtk_notebook_prev_page, gxg_gtk_notebook_prev_page_w, 1, 0, 0, H_gtk_notebook_prev_page, pl_tu);
+ Xg_define_procedure(gtk_notebook_set_show_border, gxg_gtk_notebook_set_show_border_w, 2, 0, 0, H_gtk_notebook_set_show_border, pl_tub);
+ Xg_define_procedure(gtk_notebook_get_show_border, gxg_gtk_notebook_get_show_border_w, 1, 0, 0, H_gtk_notebook_get_show_border, pl_bu);
+ Xg_define_procedure(gtk_notebook_set_show_tabs, gxg_gtk_notebook_set_show_tabs_w, 2, 0, 0, H_gtk_notebook_set_show_tabs, pl_tub);
+ Xg_define_procedure(gtk_notebook_get_show_tabs, gxg_gtk_notebook_get_show_tabs_w, 1, 0, 0, H_gtk_notebook_get_show_tabs, pl_bu);
+ Xg_define_procedure(gtk_notebook_set_tab_pos, gxg_gtk_notebook_set_tab_pos_w, 2, 0, 0, H_gtk_notebook_set_tab_pos, pl_tui);
+ Xg_define_procedure(gtk_notebook_get_tab_pos, gxg_gtk_notebook_get_tab_pos_w, 1, 0, 0, H_gtk_notebook_get_tab_pos, pl_iu);
+ Xg_define_procedure(gtk_notebook_set_scrollable, gxg_gtk_notebook_set_scrollable_w, 2, 0, 0, H_gtk_notebook_set_scrollable, pl_tub);
+ Xg_define_procedure(gtk_notebook_get_scrollable, gxg_gtk_notebook_get_scrollable_w, 1, 0, 0, H_gtk_notebook_get_scrollable, pl_bu);
+ Xg_define_procedure(gtk_notebook_popup_enable, gxg_gtk_notebook_popup_enable_w, 1, 0, 0, H_gtk_notebook_popup_enable, pl_tu);
+ Xg_define_procedure(gtk_notebook_popup_disable, gxg_gtk_notebook_popup_disable_w, 1, 0, 0, H_gtk_notebook_popup_disable, pl_tu);
+ Xg_define_procedure(gtk_notebook_get_tab_label, gxg_gtk_notebook_get_tab_label_w, 2, 0, 0, H_gtk_notebook_get_tab_label, pl_pu);
+ Xg_define_procedure(gtk_notebook_set_tab_label, gxg_gtk_notebook_set_tab_label_w, 3, 0, 0, H_gtk_notebook_set_tab_label, pl_tu);
+ Xg_define_procedure(gtk_notebook_set_tab_label_text, gxg_gtk_notebook_set_tab_label_text_w, 3, 0, 0, H_gtk_notebook_set_tab_label_text, pl_tuus);
+ Xg_define_procedure(gtk_notebook_get_tab_label_text, gxg_gtk_notebook_get_tab_label_text_w, 2, 0, 0, H_gtk_notebook_get_tab_label_text, pl_su);
+ Xg_define_procedure(gtk_notebook_get_menu_label, gxg_gtk_notebook_get_menu_label_w, 2, 0, 0, H_gtk_notebook_get_menu_label, pl_pu);
+ Xg_define_procedure(gtk_notebook_set_menu_label, gxg_gtk_notebook_set_menu_label_w, 3, 0, 0, H_gtk_notebook_set_menu_label, pl_tu);
+ Xg_define_procedure(gtk_notebook_set_menu_label_text, gxg_gtk_notebook_set_menu_label_text_w, 3, 0, 0, H_gtk_notebook_set_menu_label_text, pl_tuus);
+ Xg_define_procedure(gtk_notebook_get_menu_label_text, gxg_gtk_notebook_get_menu_label_text_w, 2, 0, 0, H_gtk_notebook_get_menu_label_text, pl_su);
+ Xg_define_procedure(gtk_notebook_reorder_child, gxg_gtk_notebook_reorder_child_w, 3, 0, 0, H_gtk_notebook_reorder_child, pl_tuui);
+ Xg_define_procedure(gtk_notebook_append_page, gxg_gtk_notebook_append_page_w, 3, 0, 0, H_gtk_notebook_append_page, pl_iu);
+ Xg_define_procedure(gtk_notebook_append_page_menu, gxg_gtk_notebook_append_page_menu_w, 4, 0, 0, H_gtk_notebook_append_page_menu, pl_iu);
+ Xg_define_procedure(gtk_notebook_prepend_page, gxg_gtk_notebook_prepend_page_w, 3, 0, 0, H_gtk_notebook_prepend_page, pl_iu);
+ Xg_define_procedure(gtk_notebook_prepend_page_menu, gxg_gtk_notebook_prepend_page_menu_w, 4, 0, 0, H_gtk_notebook_prepend_page_menu, pl_iu);
+ Xg_define_procedure(gtk_notebook_insert_page, gxg_gtk_notebook_insert_page_w, 4, 0, 0, H_gtk_notebook_insert_page, pl_iuuui);
+ Xg_define_procedure(gtk_notebook_insert_page_menu, gxg_gtk_notebook_insert_page_menu_w, 5, 0, 0, H_gtk_notebook_insert_page_menu, pl_iuuuui);
+ Xg_define_procedure(gtk_paned_add1, gxg_gtk_paned_add1_w, 2, 0, 0, H_gtk_paned_add1, pl_tu);
+ Xg_define_procedure(gtk_paned_add2, gxg_gtk_paned_add2_w, 2, 0, 0, H_gtk_paned_add2, pl_tu);
+ Xg_define_procedure(gtk_paned_pack1, gxg_gtk_paned_pack1_w, 4, 0, 0, H_gtk_paned_pack1, pl_tuub);
+ Xg_define_procedure(gtk_paned_pack2, gxg_gtk_paned_pack2_w, 4, 0, 0, H_gtk_paned_pack2, pl_tuub);
+ Xg_define_procedure(gtk_paned_get_position, gxg_gtk_paned_get_position_w, 1, 0, 0, H_gtk_paned_get_position, pl_iu);
+ Xg_define_procedure(gtk_paned_set_position, gxg_gtk_paned_set_position_w, 2, 0, 0, H_gtk_paned_set_position, pl_tui);
+ Xg_define_procedure(gtk_progress_bar_new, gxg_gtk_progress_bar_new_w, 0, 0, 0, H_gtk_progress_bar_new, pl_p);
+ Xg_define_procedure(gtk_progress_bar_pulse, gxg_gtk_progress_bar_pulse_w, 1, 0, 0, H_gtk_progress_bar_pulse, pl_tu);
+ Xg_define_procedure(gtk_progress_bar_set_text, gxg_gtk_progress_bar_set_text_w, 2, 0, 0, H_gtk_progress_bar_set_text, pl_tus);
+ Xg_define_procedure(gtk_progress_bar_set_fraction, gxg_gtk_progress_bar_set_fraction_w, 2, 0, 0, H_gtk_progress_bar_set_fraction, pl_tur);
+ Xg_define_procedure(gtk_progress_bar_set_pulse_step, gxg_gtk_progress_bar_set_pulse_step_w, 2, 0, 0, H_gtk_progress_bar_set_pulse_step, pl_tur);
+ Xg_define_procedure(gtk_progress_bar_get_text, gxg_gtk_progress_bar_get_text_w, 1, 0, 0, H_gtk_progress_bar_get_text, pl_su);
+ Xg_define_procedure(gtk_progress_bar_get_fraction, gxg_gtk_progress_bar_get_fraction_w, 1, 0, 0, H_gtk_progress_bar_get_fraction, pl_du);
+ Xg_define_procedure(gtk_progress_bar_get_pulse_step, gxg_gtk_progress_bar_get_pulse_step_w, 1, 0, 0, H_gtk_progress_bar_get_pulse_step, pl_du);
+ Xg_define_procedure(gtk_radio_button_new, gxg_gtk_radio_button_new_w, 1, 0, 0, H_gtk_radio_button_new, pl_pu);
+ Xg_define_procedure(gtk_radio_button_new_from_widget, gxg_gtk_radio_button_new_from_widget_w, 1, 0, 0, H_gtk_radio_button_new_from_widget, pl_pu);
+ Xg_define_procedure(gtk_radio_button_new_with_label, gxg_gtk_radio_button_new_with_label_w, 2, 0, 0, H_gtk_radio_button_new_with_label, pl_pus);
+ Xg_define_procedure(gtk_radio_button_new_with_label_from_widget, gxg_gtk_radio_button_new_with_label_from_widget_w, 2, 0, 0, H_gtk_radio_button_new_with_label_from_widget, pl_pus);
+ Xg_define_procedure(gtk_radio_button_new_with_mnemonic, gxg_gtk_radio_button_new_with_mnemonic_w, 2, 0, 0, H_gtk_radio_button_new_with_mnemonic, pl_pus);
+ Xg_define_procedure(gtk_radio_button_new_with_mnemonic_from_widget, gxg_gtk_radio_button_new_with_mnemonic_from_widget_w, 2, 0, 0, H_gtk_radio_button_new_with_mnemonic_from_widget, pl_pus);
+ Xg_define_procedure(gtk_radio_button_get_group, gxg_gtk_radio_button_get_group_w, 1, 0, 0, H_gtk_radio_button_get_group, pl_pu);
+ Xg_define_procedure(gtk_radio_button_set_group, gxg_gtk_radio_button_set_group_w, 2, 0, 0, H_gtk_radio_button_set_group, pl_tu);
+ Xg_define_procedure(gtk_radio_menu_item_new, gxg_gtk_radio_menu_item_new_w, 1, 0, 0, H_gtk_radio_menu_item_new, pl_pu);
+ Xg_define_procedure(gtk_radio_menu_item_new_with_label, gxg_gtk_radio_menu_item_new_with_label_w, 2, 0, 0, H_gtk_radio_menu_item_new_with_label, pl_pus);
+ Xg_define_procedure(gtk_radio_menu_item_new_with_mnemonic, gxg_gtk_radio_menu_item_new_with_mnemonic_w, 2, 0, 0, H_gtk_radio_menu_item_new_with_mnemonic, pl_pus);
+ Xg_define_procedure(gtk_radio_menu_item_get_group, gxg_gtk_radio_menu_item_get_group_w, 1, 0, 0, H_gtk_radio_menu_item_get_group, pl_pu);
+ Xg_define_procedure(gtk_radio_menu_item_set_group, gxg_gtk_radio_menu_item_set_group_w, 2, 0, 0, H_gtk_radio_menu_item_set_group, pl_tu);
+ Xg_define_procedure(gtk_range_set_adjustment, gxg_gtk_range_set_adjustment_w, 2, 0, 0, H_gtk_range_set_adjustment, pl_tu);
+ Xg_define_procedure(gtk_range_get_adjustment, gxg_gtk_range_get_adjustment_w, 1, 0, 0, H_gtk_range_get_adjustment, pl_pu);
+ Xg_define_procedure(gtk_range_set_inverted, gxg_gtk_range_set_inverted_w, 2, 0, 0, H_gtk_range_set_inverted, pl_tub);
+ Xg_define_procedure(gtk_range_get_inverted, gxg_gtk_range_get_inverted_w, 1, 0, 0, H_gtk_range_get_inverted, pl_bu);
+ Xg_define_procedure(gtk_range_set_increments, gxg_gtk_range_set_increments_w, 3, 0, 0, H_gtk_range_set_increments, pl_tur);
+ Xg_define_procedure(gtk_range_set_range, gxg_gtk_range_set_range_w, 3, 0, 0, H_gtk_range_set_range, pl_tur);
+ Xg_define_procedure(gtk_range_set_value, gxg_gtk_range_set_value_w, 2, 0, 0, H_gtk_range_set_value, pl_tur);
+ Xg_define_procedure(gtk_range_get_value, gxg_gtk_range_get_value_w, 1, 0, 0, H_gtk_range_get_value, pl_du);
+ Xg_define_procedure(gtk_scale_set_digits, gxg_gtk_scale_set_digits_w, 2, 0, 0, H_gtk_scale_set_digits, pl_tui);
+ Xg_define_procedure(gtk_scale_get_digits, gxg_gtk_scale_get_digits_w, 1, 0, 0, H_gtk_scale_get_digits, pl_iu);
+ Xg_define_procedure(gtk_scale_set_draw_value, gxg_gtk_scale_set_draw_value_w, 2, 0, 0, H_gtk_scale_set_draw_value, pl_tub);
+ Xg_define_procedure(gtk_scale_get_draw_value, gxg_gtk_scale_get_draw_value_w, 1, 0, 0, H_gtk_scale_get_draw_value, pl_bu);
+ Xg_define_procedure(gtk_scale_set_value_pos, gxg_gtk_scale_set_value_pos_w, 2, 0, 0, H_gtk_scale_set_value_pos, pl_tui);
+ Xg_define_procedure(gtk_scale_get_value_pos, gxg_gtk_scale_get_value_pos_w, 1, 0, 0, H_gtk_scale_get_value_pos, pl_iu);
+ Xg_define_procedure(gtk_scrolled_window_new, gxg_gtk_scrolled_window_new_w, 2, 0, 0, H_gtk_scrolled_window_new, pl_pu);
+ Xg_define_procedure(gtk_scrolled_window_set_hadjustment, gxg_gtk_scrolled_window_set_hadjustment_w, 2, 0, 0, H_gtk_scrolled_window_set_hadjustment, pl_tu);
+ Xg_define_procedure(gtk_scrolled_window_set_vadjustment, gxg_gtk_scrolled_window_set_vadjustment_w, 2, 0, 0, H_gtk_scrolled_window_set_vadjustment, pl_tu);
+ Xg_define_procedure(gtk_scrolled_window_get_hadjustment, gxg_gtk_scrolled_window_get_hadjustment_w, 1, 0, 0, H_gtk_scrolled_window_get_hadjustment, pl_pu);
+ Xg_define_procedure(gtk_scrolled_window_get_vadjustment, gxg_gtk_scrolled_window_get_vadjustment_w, 1, 0, 0, H_gtk_scrolled_window_get_vadjustment, pl_pu);
+ Xg_define_procedure(gtk_scrolled_window_set_policy, gxg_gtk_scrolled_window_set_policy_w, 3, 0, 0, H_gtk_scrolled_window_set_policy, pl_tui);
+ Xg_define_procedure(gtk_scrolled_window_get_policy, gxg_gtk_scrolled_window_get_policy_w, 1, 2, 0, H_gtk_scrolled_window_get_policy, pl_tu);
+ Xg_define_procedure(gtk_scrolled_window_set_placement, gxg_gtk_scrolled_window_set_placement_w, 2, 0, 0, H_gtk_scrolled_window_set_placement, pl_tui);
+ Xg_define_procedure(gtk_scrolled_window_get_placement, gxg_gtk_scrolled_window_get_placement_w, 1, 0, 0, H_gtk_scrolled_window_get_placement, pl_iu);
+ Xg_define_procedure(gtk_scrolled_window_set_shadow_type, gxg_gtk_scrolled_window_set_shadow_type_w, 2, 0, 0, H_gtk_scrolled_window_set_shadow_type, pl_tui);
+ Xg_define_procedure(gtk_scrolled_window_get_shadow_type, gxg_gtk_scrolled_window_get_shadow_type_w, 1, 0, 0, H_gtk_scrolled_window_get_shadow_type, pl_iu);
+ Xg_define_procedure(gtk_target_list_new, gxg_gtk_target_list_new_w, 2, 0, 0, H_gtk_target_list_new, pl_pui);
+ Xg_define_procedure(gtk_target_list_unref, gxg_gtk_target_list_unref_w, 1, 0, 0, H_gtk_target_list_unref, pl_tu);
+ Xg_define_procedure(gtk_target_list_add, gxg_gtk_target_list_add_w, 4, 0, 0, H_gtk_target_list_add, pl_tuti);
+ Xg_define_procedure(gtk_target_list_add_table, gxg_gtk_target_list_add_table_w, 3, 0, 0, H_gtk_target_list_add_table, pl_tuui);
+ Xg_define_procedure(gtk_target_list_remove, gxg_gtk_target_list_remove_w, 2, 0, 0, H_gtk_target_list_remove, pl_tut);
+ Xg_define_procedure(gtk_target_list_find, gxg_gtk_target_list_find_w, 2, 1, 0, H_gtk_target_list_find, pl_butu);
+ Xg_define_procedure(gtk_selection_owner_set, gxg_gtk_selection_owner_set_w, 3, 0, 0, H_gtk_selection_owner_set, pl_buti);
+ Xg_define_procedure(gtk_selection_add_target, gxg_gtk_selection_add_target_w, 4, 0, 0, H_gtk_selection_add_target, pl_tutti);
+ Xg_define_procedure(gtk_selection_add_targets, gxg_gtk_selection_add_targets_w, 4, 0, 0, H_gtk_selection_add_targets, pl_tutui);
+ Xg_define_procedure(gtk_selection_clear_targets, gxg_gtk_selection_clear_targets_w, 2, 0, 0, H_gtk_selection_clear_targets, pl_tut);
+ Xg_define_procedure(gtk_selection_convert, gxg_gtk_selection_convert_w, 4, 0, 0, H_gtk_selection_convert, pl_butti);
+ Xg_define_procedure(gtk_selection_data_set, gxg_gtk_selection_data_set_w, 5, 0, 0, H_gtk_selection_data_set, pl_tutisi);
+ Xg_define_procedure(gtk_selection_data_set_text, gxg_gtk_selection_data_set_text_w, 3, 0, 0, H_gtk_selection_data_set_text, pl_busi);
+ Xg_define_procedure(gtk_selection_data_get_text, gxg_gtk_selection_data_get_text_w, 1, 0, 0, H_gtk_selection_data_get_text, pl_su);
+ Xg_define_procedure(gtk_selection_data_get_targets, gxg_gtk_selection_data_get_targets_w, 1, 2, 0, H_gtk_selection_data_get_targets, pl_bu);
+ Xg_define_procedure(gtk_selection_data_targets_include_text, gxg_gtk_selection_data_targets_include_text_w, 1, 0, 0, H_gtk_selection_data_targets_include_text, pl_bu);
+ Xg_define_procedure(gtk_selection_remove_all, gxg_gtk_selection_remove_all_w, 1, 0, 0, H_gtk_selection_remove_all, pl_tu);
+ Xg_define_procedure(gtk_selection_data_copy, gxg_gtk_selection_data_copy_w, 1, 0, 0, H_gtk_selection_data_copy, pl_pu);
+ Xg_define_procedure(gtk_selection_data_free, gxg_gtk_selection_data_free_w, 1, 0, 0, H_gtk_selection_data_free, pl_tu);
+ Xg_define_procedure(gtk_separator_menu_item_new, gxg_gtk_separator_menu_item_new_w, 0, 0, 0, H_gtk_separator_menu_item_new, pl_p);
+ Xg_define_procedure(gtk_settings_get_default, gxg_gtk_settings_get_default_w, 0, 0, 0, H_gtk_settings_get_default, pl_p);
+ Xg_define_procedure(gtk_size_group_new, gxg_gtk_size_group_new_w, 1, 0, 0, H_gtk_size_group_new, pl_pi);
+ Xg_define_procedure(gtk_size_group_set_mode, gxg_gtk_size_group_set_mode_w, 2, 0, 0, H_gtk_size_group_set_mode, pl_tui);
+ Xg_define_procedure(gtk_size_group_get_mode, gxg_gtk_size_group_get_mode_w, 1, 0, 0, H_gtk_size_group_get_mode, pl_iu);
+ Xg_define_procedure(gtk_size_group_add_widget, gxg_gtk_size_group_add_widget_w, 2, 0, 0, H_gtk_size_group_add_widget, pl_tu);
+ Xg_define_procedure(gtk_size_group_remove_widget, gxg_gtk_size_group_remove_widget_w, 2, 0, 0, H_gtk_size_group_remove_widget, pl_tu);
+ Xg_define_procedure(gtk_spin_button_configure, gxg_gtk_spin_button_configure_w, 4, 0, 0, H_gtk_spin_button_configure, pl_tuuri);
+ Xg_define_procedure(gtk_spin_button_new, gxg_gtk_spin_button_new_w, 3, 0, 0, H_gtk_spin_button_new, pl_puri);
+ Xg_define_procedure(gtk_spin_button_new_with_range, gxg_gtk_spin_button_new_with_range_w, 3, 0, 0, H_gtk_spin_button_new_with_range, pl_pr);
+ Xg_define_procedure(gtk_spin_button_set_adjustment, gxg_gtk_spin_button_set_adjustment_w, 2, 0, 0, H_gtk_spin_button_set_adjustment, pl_tu);
+ Xg_define_procedure(gtk_spin_button_get_adjustment, gxg_gtk_spin_button_get_adjustment_w, 1, 0, 0, H_gtk_spin_button_get_adjustment, pl_pu);
+ Xg_define_procedure(gtk_spin_button_set_digits, gxg_gtk_spin_button_set_digits_w, 2, 0, 0, H_gtk_spin_button_set_digits, pl_tui);
+ Xg_define_procedure(gtk_spin_button_get_digits, gxg_gtk_spin_button_get_digits_w, 1, 0, 0, H_gtk_spin_button_get_digits, pl_iu);
+ Xg_define_procedure(gtk_spin_button_set_increments, gxg_gtk_spin_button_set_increments_w, 3, 0, 0, H_gtk_spin_button_set_increments, pl_tur);
+ Xg_define_procedure(gtk_spin_button_get_increments, gxg_gtk_spin_button_get_increments_w, 1, 2, 0, H_gtk_spin_button_get_increments, pl_tu);
+ Xg_define_procedure(gtk_spin_button_set_range, gxg_gtk_spin_button_set_range_w, 3, 0, 0, H_gtk_spin_button_set_range, pl_tur);
+ Xg_define_procedure(gtk_spin_button_get_range, gxg_gtk_spin_button_get_range_w, 1, 2, 0, H_gtk_spin_button_get_range, pl_tu);
+ Xg_define_procedure(gtk_spin_button_get_value, gxg_gtk_spin_button_get_value_w, 1, 0, 0, H_gtk_spin_button_get_value, pl_du);
+ Xg_define_procedure(gtk_spin_button_get_value_as_int, gxg_gtk_spin_button_get_value_as_int_w, 1, 0, 0, H_gtk_spin_button_get_value_as_int, pl_iu);
+ Xg_define_procedure(gtk_spin_button_set_value, gxg_gtk_spin_button_set_value_w, 2, 0, 0, H_gtk_spin_button_set_value, pl_tur);
+ Xg_define_procedure(gtk_spin_button_set_update_policy, gxg_gtk_spin_button_set_update_policy_w, 2, 0, 0, H_gtk_spin_button_set_update_policy, pl_tui);
+ Xg_define_procedure(gtk_spin_button_get_update_policy, gxg_gtk_spin_button_get_update_policy_w, 1, 0, 0, H_gtk_spin_button_get_update_policy, pl_iu);
+ Xg_define_procedure(gtk_spin_button_set_numeric, gxg_gtk_spin_button_set_numeric_w, 2, 0, 0, H_gtk_spin_button_set_numeric, pl_tub);
+ Xg_define_procedure(gtk_spin_button_get_numeric, gxg_gtk_spin_button_get_numeric_w, 1, 0, 0, H_gtk_spin_button_get_numeric, pl_bu);
+ Xg_define_procedure(gtk_spin_button_spin, gxg_gtk_spin_button_spin_w, 3, 0, 0, H_gtk_spin_button_spin, pl_tuir);
+ Xg_define_procedure(gtk_spin_button_set_wrap, gxg_gtk_spin_button_set_wrap_w, 2, 0, 0, H_gtk_spin_button_set_wrap, pl_tub);
+ Xg_define_procedure(gtk_spin_button_get_wrap, gxg_gtk_spin_button_get_wrap_w, 1, 0, 0, H_gtk_spin_button_get_wrap, pl_bu);
+ Xg_define_procedure(gtk_spin_button_set_snap_to_ticks, gxg_gtk_spin_button_set_snap_to_ticks_w, 2, 0, 0, H_gtk_spin_button_set_snap_to_ticks, pl_tub);
+ Xg_define_procedure(gtk_spin_button_get_snap_to_ticks, gxg_gtk_spin_button_get_snap_to_ticks_w, 1, 0, 0, H_gtk_spin_button_get_snap_to_ticks, pl_bu);
+ Xg_define_procedure(gtk_spin_button_update, gxg_gtk_spin_button_update_w, 1, 0, 0, H_gtk_spin_button_update, pl_tu);
+ Xg_define_procedure(gtk_statusbar_new, gxg_gtk_statusbar_new_w, 0, 0, 0, H_gtk_statusbar_new, pl_p);
+ Xg_define_procedure(gtk_statusbar_get_context_id, gxg_gtk_statusbar_get_context_id_w, 2, 0, 0, H_gtk_statusbar_get_context_id, pl_ius);
+ Xg_define_procedure(gtk_statusbar_push, gxg_gtk_statusbar_push_w, 3, 0, 0, H_gtk_statusbar_push, pl_iuis);
+ Xg_define_procedure(gtk_statusbar_pop, gxg_gtk_statusbar_pop_w, 2, 0, 0, H_gtk_statusbar_pop, pl_tui);
+ Xg_define_procedure(gtk_statusbar_remove, gxg_gtk_statusbar_remove_w, 3, 0, 0, H_gtk_statusbar_remove, pl_tui);
+ Xg_define_procedure(gtk_text_buffer_new, gxg_gtk_text_buffer_new_w, 1, 0, 0, H_gtk_text_buffer_new, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_get_line_count, gxg_gtk_text_buffer_get_line_count_w, 1, 0, 0, H_gtk_text_buffer_get_line_count, pl_iu);
+ Xg_define_procedure(gtk_text_buffer_get_char_count, gxg_gtk_text_buffer_get_char_count_w, 1, 0, 0, H_gtk_text_buffer_get_char_count, pl_iu);
+ Xg_define_procedure(gtk_text_buffer_get_tag_table, gxg_gtk_text_buffer_get_tag_table_w, 1, 0, 0, H_gtk_text_buffer_get_tag_table, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_set_text, gxg_gtk_text_buffer_set_text_w, 3, 0, 0, H_gtk_text_buffer_set_text, pl_tusi);
+ Xg_define_procedure(gtk_text_buffer_insert, gxg_gtk_text_buffer_insert_w, 4, 0, 0, H_gtk_text_buffer_insert, pl_tuusi);
+ Xg_define_procedure(gtk_text_buffer_insert_at_cursor, gxg_gtk_text_buffer_insert_at_cursor_w, 3, 0, 0, H_gtk_text_buffer_insert_at_cursor, pl_tusi);
+ Xg_define_procedure(gtk_text_buffer_insert_interactive, gxg_gtk_text_buffer_insert_interactive_w, 5, 0, 0, H_gtk_text_buffer_insert_interactive, pl_buusib);
+ Xg_define_procedure(gtk_text_buffer_insert_interactive_at_cursor, gxg_gtk_text_buffer_insert_interactive_at_cursor_w, 4, 0, 0, H_gtk_text_buffer_insert_interactive_at_cursor, pl_busib);
+ Xg_define_procedure(gtk_text_buffer_insert_range, gxg_gtk_text_buffer_insert_range_w, 4, 0, 0, H_gtk_text_buffer_insert_range, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_insert_range_interactive, gxg_gtk_text_buffer_insert_range_interactive_w, 5, 0, 0, H_gtk_text_buffer_insert_range_interactive, pl_buuuub);
+ Xg_define_procedure(gtk_text_buffer_insert_with_tags, gxg_gtk_text_buffer_insert_with_tags_w, 5, 0, 0, H_gtk_text_buffer_insert_with_tags, pl_tuusit);
+ Xg_define_procedure(gtk_text_buffer_insert_with_tags_by_name, gxg_gtk_text_buffer_insert_with_tags_by_name_w, 5, 0, 0, H_gtk_text_buffer_insert_with_tags_by_name, pl_tuusit);
+ Xg_define_procedure(gtk_text_buffer_delete, gxg_gtk_text_buffer_delete_w, 3, 0, 0, H_gtk_text_buffer_delete, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_delete_interactive, gxg_gtk_text_buffer_delete_interactive_w, 4, 0, 0, H_gtk_text_buffer_delete_interactive, pl_buuub);
+ Xg_define_procedure(gtk_text_buffer_get_text, gxg_gtk_text_buffer_get_text_w, 4, 0, 0, H_gtk_text_buffer_get_text, pl_suuub);
+ Xg_define_procedure(gtk_text_buffer_get_slice, gxg_gtk_text_buffer_get_slice_w, 4, 0, 0, H_gtk_text_buffer_get_slice, pl_suuub);
+ Xg_define_procedure(gtk_text_buffer_insert_pixbuf, gxg_gtk_text_buffer_insert_pixbuf_w, 3, 0, 0, H_gtk_text_buffer_insert_pixbuf, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_insert_child_anchor, gxg_gtk_text_buffer_insert_child_anchor_w, 3, 0, 0, H_gtk_text_buffer_insert_child_anchor, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_create_child_anchor, gxg_gtk_text_buffer_create_child_anchor_w, 2, 0, 0, H_gtk_text_buffer_create_child_anchor, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_create_mark, gxg_gtk_text_buffer_create_mark_w, 4, 0, 0, H_gtk_text_buffer_create_mark, pl_pusub);
+ Xg_define_procedure(gtk_text_buffer_move_mark, gxg_gtk_text_buffer_move_mark_w, 3, 0, 0, H_gtk_text_buffer_move_mark, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_delete_mark, gxg_gtk_text_buffer_delete_mark_w, 2, 0, 0, H_gtk_text_buffer_delete_mark, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_get_mark, gxg_gtk_text_buffer_get_mark_w, 2, 0, 0, H_gtk_text_buffer_get_mark, pl_pus);
+ Xg_define_procedure(gtk_text_buffer_move_mark_by_name, gxg_gtk_text_buffer_move_mark_by_name_w, 3, 0, 0, H_gtk_text_buffer_move_mark_by_name, pl_tusu);
+ Xg_define_procedure(gtk_text_buffer_delete_mark_by_name, gxg_gtk_text_buffer_delete_mark_by_name_w, 2, 0, 0, H_gtk_text_buffer_delete_mark_by_name, pl_tus);
+ Xg_define_procedure(gtk_text_buffer_get_insert, gxg_gtk_text_buffer_get_insert_w, 1, 0, 0, H_gtk_text_buffer_get_insert, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_get_selection_bound, gxg_gtk_text_buffer_get_selection_bound_w, 1, 0, 0, H_gtk_text_buffer_get_selection_bound, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_place_cursor, gxg_gtk_text_buffer_place_cursor_w, 2, 0, 0, H_gtk_text_buffer_place_cursor, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_apply_tag, gxg_gtk_text_buffer_apply_tag_w, 4, 0, 0, H_gtk_text_buffer_apply_tag, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_remove_tag, gxg_gtk_text_buffer_remove_tag_w, 4, 0, 0, H_gtk_text_buffer_remove_tag, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_apply_tag_by_name, gxg_gtk_text_buffer_apply_tag_by_name_w, 4, 0, 0, H_gtk_text_buffer_apply_tag_by_name, pl_tusu);
+ Xg_define_procedure(gtk_text_buffer_remove_tag_by_name, gxg_gtk_text_buffer_remove_tag_by_name_w, 4, 0, 0, H_gtk_text_buffer_remove_tag_by_name, pl_tusu);
+ Xg_define_procedure(gtk_text_buffer_remove_all_tags, gxg_gtk_text_buffer_remove_all_tags_w, 3, 0, 0, H_gtk_text_buffer_remove_all_tags, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_create_tag, gxg_gtk_text_buffer_create_tag_w, 2, 1, 0, H_gtk_text_buffer_create_tag, pl_pust);
+ Xg_define_procedure(gtk_text_buffer_get_iter_at_line_offset, gxg_gtk_text_buffer_get_iter_at_line_offset_w, 4, 0, 0, H_gtk_text_buffer_get_iter_at_line_offset, pl_tuui);
+ Xg_define_procedure(gtk_text_buffer_get_iter_at_line_index, gxg_gtk_text_buffer_get_iter_at_line_index_w, 4, 0, 0, H_gtk_text_buffer_get_iter_at_line_index, pl_tuui);
+ Xg_define_procedure(gtk_text_buffer_get_iter_at_offset, gxg_gtk_text_buffer_get_iter_at_offset_w, 3, 0, 0, H_gtk_text_buffer_get_iter_at_offset, pl_tuui);
+ Xg_define_procedure(gtk_text_buffer_get_iter_at_line, gxg_gtk_text_buffer_get_iter_at_line_w, 3, 0, 0, H_gtk_text_buffer_get_iter_at_line, pl_tuui);
+ Xg_define_procedure(gtk_text_buffer_get_start_iter, gxg_gtk_text_buffer_get_start_iter_w, 2, 0, 0, H_gtk_text_buffer_get_start_iter, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_get_end_iter, gxg_gtk_text_buffer_get_end_iter_w, 2, 0, 0, H_gtk_text_buffer_get_end_iter, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_get_bounds, gxg_gtk_text_buffer_get_bounds_w, 3, 0, 0, H_gtk_text_buffer_get_bounds, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_get_iter_at_mark, gxg_gtk_text_buffer_get_iter_at_mark_w, 3, 0, 0, H_gtk_text_buffer_get_iter_at_mark, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_get_iter_at_child_anchor, gxg_gtk_text_buffer_get_iter_at_child_anchor_w, 3, 0, 0, H_gtk_text_buffer_get_iter_at_child_anchor, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_get_modified, gxg_gtk_text_buffer_get_modified_w, 1, 0, 0, H_gtk_text_buffer_get_modified, pl_bu);
+ Xg_define_procedure(gtk_text_buffer_set_modified, gxg_gtk_text_buffer_set_modified_w, 2, 0, 0, H_gtk_text_buffer_set_modified, pl_tub);
+ Xg_define_procedure(gtk_text_buffer_add_selection_clipboard, gxg_gtk_text_buffer_add_selection_clipboard_w, 2, 0, 0, H_gtk_text_buffer_add_selection_clipboard, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_remove_selection_clipboard, gxg_gtk_text_buffer_remove_selection_clipboard_w, 2, 0, 0, H_gtk_text_buffer_remove_selection_clipboard, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_cut_clipboard, gxg_gtk_text_buffer_cut_clipboard_w, 3, 0, 0, H_gtk_text_buffer_cut_clipboard, pl_tuub);
+ Xg_define_procedure(gtk_text_buffer_copy_clipboard, gxg_gtk_text_buffer_copy_clipboard_w, 2, 0, 0, H_gtk_text_buffer_copy_clipboard, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_paste_clipboard, gxg_gtk_text_buffer_paste_clipboard_w, 4, 0, 0, H_gtk_text_buffer_paste_clipboard, pl_tuuub);
+ Xg_define_procedure(gtk_text_buffer_get_selection_bounds, gxg_gtk_text_buffer_get_selection_bounds_w, 3, 0, 0, H_gtk_text_buffer_get_selection_bounds, pl_bu);
+ Xg_define_procedure(gtk_text_buffer_delete_selection, gxg_gtk_text_buffer_delete_selection_w, 3, 0, 0, H_gtk_text_buffer_delete_selection, pl_bub);
+ Xg_define_procedure(gtk_text_buffer_begin_user_action, gxg_gtk_text_buffer_begin_user_action_w, 1, 0, 0, H_gtk_text_buffer_begin_user_action, pl_tu);
+ Xg_define_procedure(gtk_text_buffer_end_user_action, gxg_gtk_text_buffer_end_user_action_w, 1, 0, 0, H_gtk_text_buffer_end_user_action, pl_tu);
+ Xg_define_procedure(gtk_text_child_anchor_new, gxg_gtk_text_child_anchor_new_w, 0, 0, 0, H_gtk_text_child_anchor_new, pl_p);
+ Xg_define_procedure(gtk_text_child_anchor_get_widgets, gxg_gtk_text_child_anchor_get_widgets_w, 1, 0, 0, H_gtk_text_child_anchor_get_widgets, pl_pu);
+ Xg_define_procedure(gtk_text_child_anchor_get_deleted, gxg_gtk_text_child_anchor_get_deleted_w, 1, 0, 0, H_gtk_text_child_anchor_get_deleted, pl_bu);
+ Xg_define_procedure(gtk_text_iter_get_buffer, gxg_gtk_text_iter_get_buffer_w, 1, 0, 0, H_gtk_text_iter_get_buffer, pl_pu);
+ Xg_define_procedure(gtk_text_iter_copy, gxg_gtk_text_iter_copy_w, 1, 0, 0, H_gtk_text_iter_copy, pl_pu);
+ Xg_define_procedure(gtk_text_iter_free, gxg_gtk_text_iter_free_w, 1, 0, 0, H_gtk_text_iter_free, pl_tu);
+ Xg_define_procedure(gtk_text_iter_get_offset, gxg_gtk_text_iter_get_offset_w, 1, 0, 0, H_gtk_text_iter_get_offset, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_line, gxg_gtk_text_iter_get_line_w, 1, 0, 0, H_gtk_text_iter_get_line, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_line_offset, gxg_gtk_text_iter_get_line_offset_w, 1, 0, 0, H_gtk_text_iter_get_line_offset, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_line_index, gxg_gtk_text_iter_get_line_index_w, 1, 0, 0, H_gtk_text_iter_get_line_index, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_visible_line_offset, gxg_gtk_text_iter_get_visible_line_offset_w, 1, 0, 0, H_gtk_text_iter_get_visible_line_offset, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_visible_line_index, gxg_gtk_text_iter_get_visible_line_index_w, 1, 0, 0, H_gtk_text_iter_get_visible_line_index, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_char, gxg_gtk_text_iter_get_char_w, 1, 0, 0, H_gtk_text_iter_get_char, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_slice, gxg_gtk_text_iter_get_slice_w, 2, 0, 0, H_gtk_text_iter_get_slice, pl_su);
+ Xg_define_procedure(gtk_text_iter_get_text, gxg_gtk_text_iter_get_text_w, 2, 0, 0, H_gtk_text_iter_get_text, pl_su);
+ Xg_define_procedure(gtk_text_iter_get_visible_slice, gxg_gtk_text_iter_get_visible_slice_w, 2, 0, 0, H_gtk_text_iter_get_visible_slice, pl_su);
+ Xg_define_procedure(gtk_text_iter_get_visible_text, gxg_gtk_text_iter_get_visible_text_w, 2, 0, 0, H_gtk_text_iter_get_visible_text, pl_su);
+ Xg_define_procedure(gtk_text_iter_get_pixbuf, gxg_gtk_text_iter_get_pixbuf_w, 1, 0, 0, H_gtk_text_iter_get_pixbuf, pl_pu);
+ Xg_define_procedure(gtk_text_iter_get_marks, gxg_gtk_text_iter_get_marks_w, 1, 0, 0, H_gtk_text_iter_get_marks, pl_pu);
+ Xg_define_procedure(gtk_text_iter_get_child_anchor, gxg_gtk_text_iter_get_child_anchor_w, 1, 0, 0, H_gtk_text_iter_get_child_anchor, pl_pu);
+ Xg_define_procedure(gtk_text_iter_get_toggled_tags, gxg_gtk_text_iter_get_toggled_tags_w, 2, 0, 0, H_gtk_text_iter_get_toggled_tags, pl_pub);
+ Xg_define_procedure(gtk_text_iter_begins_tag, gxg_gtk_text_iter_begins_tag_w, 2, 0, 0, H_gtk_text_iter_begins_tag, pl_bu);
+ Xg_define_procedure(gtk_text_iter_ends_tag, gxg_gtk_text_iter_ends_tag_w, 2, 0, 0, H_gtk_text_iter_ends_tag, pl_bu);
+ Xg_define_procedure(gtk_text_iter_toggles_tag, gxg_gtk_text_iter_toggles_tag_w, 2, 0, 0, H_gtk_text_iter_toggles_tag, pl_bu);
+ Xg_define_procedure(gtk_text_iter_has_tag, gxg_gtk_text_iter_has_tag_w, 2, 0, 0, H_gtk_text_iter_has_tag, pl_bu);
+ Xg_define_procedure(gtk_text_iter_get_tags, gxg_gtk_text_iter_get_tags_w, 1, 0, 0, H_gtk_text_iter_get_tags, pl_pu);
+ Xg_define_procedure(gtk_text_iter_editable, gxg_gtk_text_iter_editable_w, 2, 0, 0, H_gtk_text_iter_editable, pl_bub);
+ Xg_define_procedure(gtk_text_iter_can_insert, gxg_gtk_text_iter_can_insert_w, 2, 0, 0, H_gtk_text_iter_can_insert, pl_bub);
+ Xg_define_procedure(gtk_text_iter_starts_word, gxg_gtk_text_iter_starts_word_w, 1, 0, 0, H_gtk_text_iter_starts_word, pl_bu);
+ Xg_define_procedure(gtk_text_iter_ends_word, gxg_gtk_text_iter_ends_word_w, 1, 0, 0, H_gtk_text_iter_ends_word, pl_bu);
+ Xg_define_procedure(gtk_text_iter_inside_word, gxg_gtk_text_iter_inside_word_w, 1, 0, 0, H_gtk_text_iter_inside_word, pl_bu);
+ Xg_define_procedure(gtk_text_iter_starts_sentence, gxg_gtk_text_iter_starts_sentence_w, 1, 0, 0, H_gtk_text_iter_starts_sentence, pl_bu);
+ Xg_define_procedure(gtk_text_iter_ends_sentence, gxg_gtk_text_iter_ends_sentence_w, 1, 0, 0, H_gtk_text_iter_ends_sentence, pl_bu);
+ Xg_define_procedure(gtk_text_iter_inside_sentence, gxg_gtk_text_iter_inside_sentence_w, 1, 0, 0, H_gtk_text_iter_inside_sentence, pl_bu);
+ Xg_define_procedure(gtk_text_iter_starts_line, gxg_gtk_text_iter_starts_line_w, 1, 0, 0, H_gtk_text_iter_starts_line, pl_bu);
+ Xg_define_procedure(gtk_text_iter_ends_line, gxg_gtk_text_iter_ends_line_w, 1, 0, 0, H_gtk_text_iter_ends_line, pl_bu);
+ Xg_define_procedure(gtk_text_iter_is_cursor_position, gxg_gtk_text_iter_is_cursor_position_w, 1, 0, 0, H_gtk_text_iter_is_cursor_position, pl_bu);
+ Xg_define_procedure(gtk_text_iter_get_chars_in_line, gxg_gtk_text_iter_get_chars_in_line_w, 1, 0, 0, H_gtk_text_iter_get_chars_in_line, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_bytes_in_line, gxg_gtk_text_iter_get_bytes_in_line_w, 1, 0, 0, H_gtk_text_iter_get_bytes_in_line, pl_iu);
+ Xg_define_procedure(gtk_text_iter_get_attributes, gxg_gtk_text_iter_get_attributes_w, 2, 0, 0, H_gtk_text_iter_get_attributes, pl_bu);
+ Xg_define_procedure(gtk_text_iter_get_language, gxg_gtk_text_iter_get_language_w, 1, 0, 0, H_gtk_text_iter_get_language, pl_pu);
+ Xg_define_procedure(gtk_text_iter_is_end, gxg_gtk_text_iter_is_end_w, 1, 0, 0, H_gtk_text_iter_is_end, pl_bu);
+ Xg_define_procedure(gtk_text_iter_is_start, gxg_gtk_text_iter_is_start_w, 1, 0, 0, H_gtk_text_iter_is_start, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_char, gxg_gtk_text_iter_forward_char_w, 1, 0, 0, H_gtk_text_iter_forward_char, pl_bu);
+ Xg_define_procedure(gtk_text_iter_backward_char, gxg_gtk_text_iter_backward_char_w, 1, 0, 0, H_gtk_text_iter_backward_char, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_chars, gxg_gtk_text_iter_forward_chars_w, 2, 0, 0, H_gtk_text_iter_forward_chars, pl_bui);
+ Xg_define_procedure(gtk_text_iter_backward_chars, gxg_gtk_text_iter_backward_chars_w, 2, 0, 0, H_gtk_text_iter_backward_chars, pl_bui);
+ Xg_define_procedure(gtk_text_iter_forward_line, gxg_gtk_text_iter_forward_line_w, 1, 0, 0, H_gtk_text_iter_forward_line, pl_bu);
+ Xg_define_procedure(gtk_text_iter_backward_line, gxg_gtk_text_iter_backward_line_w, 1, 0, 0, H_gtk_text_iter_backward_line, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_lines, gxg_gtk_text_iter_forward_lines_w, 2, 0, 0, H_gtk_text_iter_forward_lines, pl_bui);
+ Xg_define_procedure(gtk_text_iter_backward_lines, gxg_gtk_text_iter_backward_lines_w, 2, 0, 0, H_gtk_text_iter_backward_lines, pl_bui);
+ Xg_define_procedure(gtk_text_iter_forward_word_end, gxg_gtk_text_iter_forward_word_end_w, 1, 0, 0, H_gtk_text_iter_forward_word_end, pl_bu);
+ Xg_define_procedure(gtk_text_iter_backward_word_start, gxg_gtk_text_iter_backward_word_start_w, 1, 0, 0, H_gtk_text_iter_backward_word_start, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_word_ends, gxg_gtk_text_iter_forward_word_ends_w, 2, 0, 0, H_gtk_text_iter_forward_word_ends, pl_bui);
+ Xg_define_procedure(gtk_text_iter_backward_word_starts, gxg_gtk_text_iter_backward_word_starts_w, 2, 0, 0, H_gtk_text_iter_backward_word_starts, pl_bui);
+ Xg_define_procedure(gtk_text_iter_forward_sentence_end, gxg_gtk_text_iter_forward_sentence_end_w, 1, 0, 0, H_gtk_text_iter_forward_sentence_end, pl_bu);
+ Xg_define_procedure(gtk_text_iter_backward_sentence_start, gxg_gtk_text_iter_backward_sentence_start_w, 1, 0, 0, H_gtk_text_iter_backward_sentence_start, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_sentence_ends, gxg_gtk_text_iter_forward_sentence_ends_w, 2, 0, 0, H_gtk_text_iter_forward_sentence_ends, pl_bui);
+ Xg_define_procedure(gtk_text_iter_backward_sentence_starts, gxg_gtk_text_iter_backward_sentence_starts_w, 2, 0, 0, H_gtk_text_iter_backward_sentence_starts, pl_bui);
+ Xg_define_procedure(gtk_text_iter_forward_cursor_position, gxg_gtk_text_iter_forward_cursor_position_w, 1, 0, 0, H_gtk_text_iter_forward_cursor_position, pl_bu);
+ Xg_define_procedure(gtk_text_iter_backward_cursor_position, gxg_gtk_text_iter_backward_cursor_position_w, 1, 0, 0, H_gtk_text_iter_backward_cursor_position, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_cursor_positions, gxg_gtk_text_iter_forward_cursor_positions_w, 2, 0, 0, H_gtk_text_iter_forward_cursor_positions, pl_bui);
+ Xg_define_procedure(gtk_text_iter_backward_cursor_positions, gxg_gtk_text_iter_backward_cursor_positions_w, 2, 0, 0, H_gtk_text_iter_backward_cursor_positions, pl_bui);
+ Xg_define_procedure(gtk_text_iter_set_offset, gxg_gtk_text_iter_set_offset_w, 2, 0, 0, H_gtk_text_iter_set_offset, pl_tui);
+ Xg_define_procedure(gtk_text_iter_set_line, gxg_gtk_text_iter_set_line_w, 2, 0, 0, H_gtk_text_iter_set_line, pl_tui);
+ Xg_define_procedure(gtk_text_iter_set_line_offset, gxg_gtk_text_iter_set_line_offset_w, 2, 0, 0, H_gtk_text_iter_set_line_offset, pl_tui);
+ Xg_define_procedure(gtk_text_iter_set_line_index, gxg_gtk_text_iter_set_line_index_w, 2, 0, 0, H_gtk_text_iter_set_line_index, pl_tui);
+ Xg_define_procedure(gtk_text_iter_forward_to_end, gxg_gtk_text_iter_forward_to_end_w, 1, 0, 0, H_gtk_text_iter_forward_to_end, pl_tu);
+ Xg_define_procedure(gtk_text_iter_forward_to_line_end, gxg_gtk_text_iter_forward_to_line_end_w, 1, 0, 0, H_gtk_text_iter_forward_to_line_end, pl_bu);
+ Xg_define_procedure(gtk_text_iter_set_visible_line_offset, gxg_gtk_text_iter_set_visible_line_offset_w, 2, 0, 0, H_gtk_text_iter_set_visible_line_offset, pl_tui);
+ Xg_define_procedure(gtk_text_iter_set_visible_line_index, gxg_gtk_text_iter_set_visible_line_index_w, 2, 0, 0, H_gtk_text_iter_set_visible_line_index, pl_tui);
+ Xg_define_procedure(gtk_text_iter_forward_to_tag_toggle, gxg_gtk_text_iter_forward_to_tag_toggle_w, 2, 0, 0, H_gtk_text_iter_forward_to_tag_toggle, pl_bu);
+ Xg_define_procedure(gtk_text_iter_backward_to_tag_toggle, gxg_gtk_text_iter_backward_to_tag_toggle_w, 2, 0, 0, H_gtk_text_iter_backward_to_tag_toggle, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_find_char, gxg_gtk_text_iter_forward_find_char_w, 4, 0, 0, H_gtk_text_iter_forward_find_char, pl_buttu);
+ Xg_define_procedure(gtk_text_iter_backward_find_char, gxg_gtk_text_iter_backward_find_char_w, 4, 0, 0, H_gtk_text_iter_backward_find_char, pl_buttu);
+ Xg_define_procedure(gtk_text_iter_forward_search, gxg_gtk_text_iter_forward_search_w, 6, 0, 0, H_gtk_text_iter_forward_search, pl_busiu);
+ Xg_define_procedure(gtk_text_iter_backward_search, gxg_gtk_text_iter_backward_search_w, 6, 0, 0, H_gtk_text_iter_backward_search, pl_busiu);
+ Xg_define_procedure(gtk_text_iter_equal, gxg_gtk_text_iter_equal_w, 2, 0, 0, H_gtk_text_iter_equal, pl_bu);
+ Xg_define_procedure(gtk_text_iter_compare, gxg_gtk_text_iter_compare_w, 2, 0, 0, H_gtk_text_iter_compare, pl_iu);
+ Xg_define_procedure(gtk_text_iter_in_range, gxg_gtk_text_iter_in_range_w, 3, 0, 0, H_gtk_text_iter_in_range, pl_bu);
+ Xg_define_procedure(gtk_text_iter_order, gxg_gtk_text_iter_order_w, 2, 0, 0, H_gtk_text_iter_order, pl_tu);
+ Xg_define_procedure(gtk_text_mark_set_visible, gxg_gtk_text_mark_set_visible_w, 2, 0, 0, H_gtk_text_mark_set_visible, pl_tub);
+ Xg_define_procedure(gtk_text_mark_get_visible, gxg_gtk_text_mark_get_visible_w, 1, 0, 0, H_gtk_text_mark_get_visible, pl_bu);
+ Xg_define_procedure(gtk_text_mark_get_name, gxg_gtk_text_mark_get_name_w, 1, 0, 0, H_gtk_text_mark_get_name, pl_su);
+ Xg_define_procedure(gtk_text_mark_get_deleted, gxg_gtk_text_mark_get_deleted_w, 1, 0, 0, H_gtk_text_mark_get_deleted, pl_bu);
+ Xg_define_procedure(gtk_text_mark_get_buffer, gxg_gtk_text_mark_get_buffer_w, 1, 0, 0, H_gtk_text_mark_get_buffer, pl_pu);
+ Xg_define_procedure(gtk_text_mark_get_left_gravity, gxg_gtk_text_mark_get_left_gravity_w, 1, 0, 0, H_gtk_text_mark_get_left_gravity, pl_bu);
+ Xg_define_procedure(gtk_text_tag_new, gxg_gtk_text_tag_new_w, 1, 0, 0, H_gtk_text_tag_new, pl_ps);
+ Xg_define_procedure(gtk_text_tag_get_priority, gxg_gtk_text_tag_get_priority_w, 1, 0, 0, H_gtk_text_tag_get_priority, pl_iu);
+ Xg_define_procedure(gtk_text_tag_set_priority, gxg_gtk_text_tag_set_priority_w, 2, 0, 0, H_gtk_text_tag_set_priority, pl_tui);
+ Xg_define_procedure(gtk_text_tag_event, gxg_gtk_text_tag_event_w, 4, 0, 0, H_gtk_text_tag_event, pl_bu);
+ Xg_define_procedure(gtk_text_attributes_new, gxg_gtk_text_attributes_new_w, 0, 0, 0, H_gtk_text_attributes_new, pl_p);
+ Xg_define_procedure(gtk_text_attributes_copy, gxg_gtk_text_attributes_copy_w, 1, 0, 0, H_gtk_text_attributes_copy, pl_pu);
+ Xg_define_procedure(gtk_text_attributes_copy_values, gxg_gtk_text_attributes_copy_values_w, 2, 0, 0, H_gtk_text_attributes_copy_values, pl_tu);
+ Xg_define_procedure(gtk_text_attributes_unref, gxg_gtk_text_attributes_unref_w, 1, 0, 0, H_gtk_text_attributes_unref, pl_tu);
+ Xg_define_procedure(gtk_text_tag_table_new, gxg_gtk_text_tag_table_new_w, 0, 0, 0, H_gtk_text_tag_table_new, pl_p);
+ Xg_define_procedure(gtk_text_tag_table_add, gxg_gtk_text_tag_table_add_w, 2, 0, 0, H_gtk_text_tag_table_add, pl_tu);
+ Xg_define_procedure(gtk_text_tag_table_remove, gxg_gtk_text_tag_table_remove_w, 2, 0, 0, H_gtk_text_tag_table_remove, pl_tu);
+ Xg_define_procedure(gtk_text_tag_table_lookup, gxg_gtk_text_tag_table_lookup_w, 2, 0, 0, H_gtk_text_tag_table_lookup, pl_pus);
+ Xg_define_procedure(gtk_text_tag_table_foreach, gxg_gtk_text_tag_table_foreach_w, 2, 1, 0, H_gtk_text_tag_table_foreach, pl_tut);
+ Xg_define_procedure(gtk_text_tag_table_get_size, gxg_gtk_text_tag_table_get_size_w, 1, 0, 0, H_gtk_text_tag_table_get_size, pl_iu);
+ Xg_define_procedure(gtk_text_view_new, gxg_gtk_text_view_new_w, 0, 0, 0, H_gtk_text_view_new, pl_p);
+ Xg_define_procedure(gtk_text_view_new_with_buffer, gxg_gtk_text_view_new_with_buffer_w, 1, 0, 0, H_gtk_text_view_new_with_buffer, pl_pu);
+ Xg_define_procedure(gtk_text_view_set_buffer, gxg_gtk_text_view_set_buffer_w, 2, 0, 0, H_gtk_text_view_set_buffer, pl_tu);
+ Xg_define_procedure(gtk_text_view_get_buffer, gxg_gtk_text_view_get_buffer_w, 1, 0, 0, H_gtk_text_view_get_buffer, pl_pu);
+ Xg_define_procedure(gtk_text_view_scroll_to_iter, gxg_gtk_text_view_scroll_to_iter_w, 6, 0, 0, H_gtk_text_view_scroll_to_iter, pl_buurbr);
+ Xg_define_procedure(gtk_text_view_scroll_to_mark, gxg_gtk_text_view_scroll_to_mark_w, 6, 0, 0, H_gtk_text_view_scroll_to_mark, pl_tuurbr);
+ Xg_define_procedure(gtk_text_view_scroll_mark_onscreen, gxg_gtk_text_view_scroll_mark_onscreen_w, 2, 0, 0, H_gtk_text_view_scroll_mark_onscreen, pl_tu);
+ Xg_define_procedure(gtk_text_view_move_mark_onscreen, gxg_gtk_text_view_move_mark_onscreen_w, 2, 0, 0, H_gtk_text_view_move_mark_onscreen, pl_bu);
+ Xg_define_procedure(gtk_text_view_place_cursor_onscreen, gxg_gtk_text_view_place_cursor_onscreen_w, 1, 0, 0, H_gtk_text_view_place_cursor_onscreen, pl_bu);
+ Xg_define_procedure(gtk_text_view_get_visible_rect, gxg_gtk_text_view_get_visible_rect_w, 2, 0, 0, H_gtk_text_view_get_visible_rect, pl_tu);
+ Xg_define_procedure(gtk_text_view_set_cursor_visible, gxg_gtk_text_view_set_cursor_visible_w, 2, 0, 0, H_gtk_text_view_set_cursor_visible, pl_tub);
+ Xg_define_procedure(gtk_text_view_get_cursor_visible, gxg_gtk_text_view_get_cursor_visible_w, 1, 0, 0, H_gtk_text_view_get_cursor_visible, pl_bu);
+ Xg_define_procedure(gtk_text_view_get_iter_location, gxg_gtk_text_view_get_iter_location_w, 3, 0, 0, H_gtk_text_view_get_iter_location, pl_tu);
+ Xg_define_procedure(gtk_text_view_get_iter_at_location, gxg_gtk_text_view_get_iter_at_location_w, 4, 0, 0, H_gtk_text_view_get_iter_at_location, pl_tuui);
+ Xg_define_procedure(gtk_text_view_get_line_yrange, gxg_gtk_text_view_get_line_yrange_w, 2, 2, 0, H_gtk_text_view_get_line_yrange, pl_tu);
+ Xg_define_procedure(gtk_text_view_get_line_at_y, gxg_gtk_text_view_get_line_at_y_w, 3, 1, 0, H_gtk_text_view_get_line_at_y, pl_tuuiu);
+ Xg_define_procedure(gtk_text_view_buffer_to_window_coords, gxg_gtk_text_view_buffer_to_window_coords_w, 4, 2, 0, H_gtk_text_view_buffer_to_window_coords, pl_tuiiiu);
+ Xg_define_procedure(gtk_text_view_window_to_buffer_coords, gxg_gtk_text_view_window_to_buffer_coords_w, 4, 2, 0, H_gtk_text_view_window_to_buffer_coords, pl_tuiiiu);
+ Xg_define_procedure(gtk_text_view_get_window, gxg_gtk_text_view_get_window_w, 2, 0, 0, H_gtk_text_view_get_window, pl_pui);
+ Xg_define_procedure(gtk_text_view_get_window_type, gxg_gtk_text_view_get_window_type_w, 2, 0, 0, H_gtk_text_view_get_window_type, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_border_window_size, gxg_gtk_text_view_set_border_window_size_w, 3, 0, 0, H_gtk_text_view_set_border_window_size, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_border_window_size, gxg_gtk_text_view_get_border_window_size_w, 2, 0, 0, H_gtk_text_view_get_border_window_size, pl_iui);
+ Xg_define_procedure(gtk_text_view_forward_display_line, gxg_gtk_text_view_forward_display_line_w, 2, 0, 0, H_gtk_text_view_forward_display_line, pl_bu);
+ Xg_define_procedure(gtk_text_view_backward_display_line, gxg_gtk_text_view_backward_display_line_w, 2, 0, 0, H_gtk_text_view_backward_display_line, pl_bu);
+ Xg_define_procedure(gtk_text_view_forward_display_line_end, gxg_gtk_text_view_forward_display_line_end_w, 2, 0, 0, H_gtk_text_view_forward_display_line_end, pl_bu);
+ Xg_define_procedure(gtk_text_view_backward_display_line_start, gxg_gtk_text_view_backward_display_line_start_w, 2, 0, 0, H_gtk_text_view_backward_display_line_start, pl_bu);
+ Xg_define_procedure(gtk_text_view_starts_display_line, gxg_gtk_text_view_starts_display_line_w, 2, 0, 0, H_gtk_text_view_starts_display_line, pl_bu);
+ Xg_define_procedure(gtk_text_view_move_visually, gxg_gtk_text_view_move_visually_w, 3, 0, 0, H_gtk_text_view_move_visually, pl_buui);
+ Xg_define_procedure(gtk_text_view_add_child_at_anchor, gxg_gtk_text_view_add_child_at_anchor_w, 3, 0, 0, H_gtk_text_view_add_child_at_anchor, pl_tu);
+ Xg_define_procedure(gtk_text_view_add_child_in_window, gxg_gtk_text_view_add_child_in_window_w, 5, 0, 0, H_gtk_text_view_add_child_in_window, pl_tuui);
+ Xg_define_procedure(gtk_text_view_move_child, gxg_gtk_text_view_move_child_w, 4, 0, 0, H_gtk_text_view_move_child, pl_tuui);
+ Xg_define_procedure(gtk_text_view_set_wrap_mode, gxg_gtk_text_view_set_wrap_mode_w, 2, 0, 0, H_gtk_text_view_set_wrap_mode, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_wrap_mode, gxg_gtk_text_view_get_wrap_mode_w, 1, 0, 0, H_gtk_text_view_get_wrap_mode, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_editable, gxg_gtk_text_view_set_editable_w, 2, 0, 0, H_gtk_text_view_set_editable, pl_tub);
+ Xg_define_procedure(gtk_text_view_get_editable, gxg_gtk_text_view_get_editable_w, 1, 0, 0, H_gtk_text_view_get_editable, pl_bu);
+ Xg_define_procedure(gtk_text_view_set_pixels_above_lines, gxg_gtk_text_view_set_pixels_above_lines_w, 2, 0, 0, H_gtk_text_view_set_pixels_above_lines, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_pixels_above_lines, gxg_gtk_text_view_get_pixels_above_lines_w, 1, 0, 0, H_gtk_text_view_get_pixels_above_lines, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_pixels_below_lines, gxg_gtk_text_view_set_pixels_below_lines_w, 2, 0, 0, H_gtk_text_view_set_pixels_below_lines, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_pixels_below_lines, gxg_gtk_text_view_get_pixels_below_lines_w, 1, 0, 0, H_gtk_text_view_get_pixels_below_lines, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_pixels_inside_wrap, gxg_gtk_text_view_set_pixels_inside_wrap_w, 2, 0, 0, H_gtk_text_view_set_pixels_inside_wrap, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_pixels_inside_wrap, gxg_gtk_text_view_get_pixels_inside_wrap_w, 1, 0, 0, H_gtk_text_view_get_pixels_inside_wrap, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_justification, gxg_gtk_text_view_set_justification_w, 2, 0, 0, H_gtk_text_view_set_justification, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_justification, gxg_gtk_text_view_get_justification_w, 1, 0, 0, H_gtk_text_view_get_justification, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_left_margin, gxg_gtk_text_view_set_left_margin_w, 2, 0, 0, H_gtk_text_view_set_left_margin, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_left_margin, gxg_gtk_text_view_get_left_margin_w, 1, 0, 0, H_gtk_text_view_get_left_margin, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_right_margin, gxg_gtk_text_view_set_right_margin_w, 2, 0, 0, H_gtk_text_view_set_right_margin, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_right_margin, gxg_gtk_text_view_get_right_margin_w, 1, 0, 0, H_gtk_text_view_get_right_margin, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_indent, gxg_gtk_text_view_set_indent_w, 2, 0, 0, H_gtk_text_view_set_indent, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_indent, gxg_gtk_text_view_get_indent_w, 1, 0, 0, H_gtk_text_view_get_indent, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_tabs, gxg_gtk_text_view_set_tabs_w, 2, 0, 0, H_gtk_text_view_set_tabs, pl_tu);
+ Xg_define_procedure(gtk_text_view_get_tabs, gxg_gtk_text_view_get_tabs_w, 1, 0, 0, H_gtk_text_view_get_tabs, pl_pu);
+ Xg_define_procedure(gtk_text_view_get_default_attributes, gxg_gtk_text_view_get_default_attributes_w, 1, 0, 0, H_gtk_text_view_get_default_attributes, pl_pu);
+ Xg_define_procedure(gtk_toggle_button_new, gxg_gtk_toggle_button_new_w, 0, 0, 0, H_gtk_toggle_button_new, pl_p);
+ Xg_define_procedure(gtk_toggle_button_new_with_label, gxg_gtk_toggle_button_new_with_label_w, 1, 0, 0, H_gtk_toggle_button_new_with_label, pl_ps);
+ Xg_define_procedure(gtk_toggle_button_new_with_mnemonic, gxg_gtk_toggle_button_new_with_mnemonic_w, 1, 0, 0, H_gtk_toggle_button_new_with_mnemonic, pl_ps);
+ Xg_define_procedure(gtk_toggle_button_set_mode, gxg_gtk_toggle_button_set_mode_w, 2, 0, 0, H_gtk_toggle_button_set_mode, pl_tub);
+ Xg_define_procedure(gtk_toggle_button_get_mode, gxg_gtk_toggle_button_get_mode_w, 1, 0, 0, H_gtk_toggle_button_get_mode, pl_bu);
+ Xg_define_procedure(gtk_toggle_button_set_active, gxg_gtk_toggle_button_set_active_w, 2, 0, 0, H_gtk_toggle_button_set_active, pl_tub);
+ Xg_define_procedure(gtk_toggle_button_get_active, gxg_gtk_toggle_button_get_active_w, 1, 0, 0, H_gtk_toggle_button_get_active, pl_bu);
+ Xg_define_procedure(gtk_toggle_button_toggled, gxg_gtk_toggle_button_toggled_w, 1, 0, 0, H_gtk_toggle_button_toggled, pl_tu);
+ Xg_define_procedure(gtk_toggle_button_set_inconsistent, gxg_gtk_toggle_button_set_inconsistent_w, 2, 0, 0, H_gtk_toggle_button_set_inconsistent, pl_tub);
+ Xg_define_procedure(gtk_toggle_button_get_inconsistent, gxg_gtk_toggle_button_get_inconsistent_w, 1, 0, 0, H_gtk_toggle_button_get_inconsistent, pl_bu);
+ Xg_define_procedure(gtk_toolbar_new, gxg_gtk_toolbar_new_w, 0, 0, 0, H_gtk_toolbar_new, pl_p);
+ Xg_define_procedure(gtk_toolbar_set_style, gxg_gtk_toolbar_set_style_w, 2, 0, 0, H_gtk_toolbar_set_style, pl_tui);
+ Xg_define_procedure(gtk_toolbar_unset_style, gxg_gtk_toolbar_unset_style_w, 1, 0, 0, H_gtk_toolbar_unset_style, pl_tu);
+ Xg_define_procedure(gtk_toolbar_get_style, gxg_gtk_toolbar_get_style_w, 1, 0, 0, H_gtk_toolbar_get_style, pl_iu);
+ Xg_define_procedure(gtk_tree_drag_source_row_draggable, gxg_gtk_tree_drag_source_row_draggable_w, 2, 0, 0, H_gtk_tree_drag_source_row_draggable, pl_bu);
+ Xg_define_procedure(gtk_tree_drag_source_drag_data_delete, gxg_gtk_tree_drag_source_drag_data_delete_w, 2, 0, 0, H_gtk_tree_drag_source_drag_data_delete, pl_bu);
+ Xg_define_procedure(gtk_tree_drag_source_drag_data_get, gxg_gtk_tree_drag_source_drag_data_get_w, 3, 0, 0, H_gtk_tree_drag_source_drag_data_get, pl_bu);
+ Xg_define_procedure(gtk_tree_drag_dest_drag_data_received, gxg_gtk_tree_drag_dest_drag_data_received_w, 3, 0, 0, H_gtk_tree_drag_dest_drag_data_received, pl_bu);
+ Xg_define_procedure(gtk_tree_drag_dest_row_drop_possible, gxg_gtk_tree_drag_dest_row_drop_possible_w, 3, 0, 0, H_gtk_tree_drag_dest_row_drop_possible, pl_bu);
+ Xg_define_procedure(gtk_tree_set_row_drag_data, gxg_gtk_tree_set_row_drag_data_w, 3, 0, 0, H_gtk_tree_set_row_drag_data, pl_bu);
+ Xg_define_procedure(gtk_tree_get_row_drag_data, gxg_gtk_tree_get_row_drag_data_w, 1, 2, 0, H_gtk_tree_get_row_drag_data, pl_bu);
+ Xg_define_procedure(gtk_tree_path_new, gxg_gtk_tree_path_new_w, 0, 0, 0, H_gtk_tree_path_new, pl_p);
+ Xg_define_procedure(gtk_tree_path_new_from_string, gxg_gtk_tree_path_new_from_string_w, 1, 0, 0, H_gtk_tree_path_new_from_string, pl_ps);
+ Xg_define_procedure(gtk_tree_path_to_string, gxg_gtk_tree_path_to_string_w, 1, 0, 0, H_gtk_tree_path_to_string, pl_su);
+ Xg_define_procedure(gtk_tree_path_new_first, gxg_gtk_tree_path_new_first_w, 0, 0, 0, H_gtk_tree_path_new_first, pl_p);
+ Xg_define_procedure(gtk_tree_path_append_index, gxg_gtk_tree_path_append_index_w, 2, 0, 0, H_gtk_tree_path_append_index, pl_tui);
+ Xg_define_procedure(gtk_tree_path_prepend_index, gxg_gtk_tree_path_prepend_index_w, 2, 0, 0, H_gtk_tree_path_prepend_index, pl_tui);
+ Xg_define_procedure(gtk_tree_path_get_depth, gxg_gtk_tree_path_get_depth_w, 1, 0, 0, H_gtk_tree_path_get_depth, pl_iu);
+ Xg_define_procedure(gtk_tree_path_get_indices, gxg_gtk_tree_path_get_indices_w, 1, 0, 0, H_gtk_tree_path_get_indices, pl_pu);
+ Xg_define_procedure(gtk_tree_path_free, gxg_gtk_tree_path_free_w, 1, 0, 0, H_gtk_tree_path_free, pl_tu);
+ Xg_define_procedure(gtk_tree_path_copy, gxg_gtk_tree_path_copy_w, 1, 0, 0, H_gtk_tree_path_copy, pl_pu);
+ Xg_define_procedure(gtk_tree_path_compare, gxg_gtk_tree_path_compare_w, 2, 0, 0, H_gtk_tree_path_compare, pl_iu);
+ Xg_define_procedure(gtk_tree_path_next, gxg_gtk_tree_path_next_w, 1, 0, 0, H_gtk_tree_path_next, pl_tu);
+ Xg_define_procedure(gtk_tree_path_prev, gxg_gtk_tree_path_prev_w, 1, 0, 0, H_gtk_tree_path_prev, pl_bu);
+ Xg_define_procedure(gtk_tree_path_up, gxg_gtk_tree_path_up_w, 1, 0, 0, H_gtk_tree_path_up, pl_bu);
+ Xg_define_procedure(gtk_tree_path_down, gxg_gtk_tree_path_down_w, 1, 0, 0, H_gtk_tree_path_down, pl_tu);
+ Xg_define_procedure(gtk_tree_path_is_ancestor, gxg_gtk_tree_path_is_ancestor_w, 2, 0, 0, H_gtk_tree_path_is_ancestor, pl_bu);
+ Xg_define_procedure(gtk_tree_path_is_descendant, gxg_gtk_tree_path_is_descendant_w, 2, 0, 0, H_gtk_tree_path_is_descendant, pl_bu);
+ Xg_define_procedure(gtk_tree_row_reference_new, gxg_gtk_tree_row_reference_new_w, 2, 0, 0, H_gtk_tree_row_reference_new, pl_pu);
+ Xg_define_procedure(gtk_tree_row_reference_new_proxy, gxg_gtk_tree_row_reference_new_proxy_w, 3, 0, 0, H_gtk_tree_row_reference_new_proxy, pl_pu);
+ Xg_define_procedure(gtk_tree_row_reference_get_path, gxg_gtk_tree_row_reference_get_path_w, 1, 0, 0, H_gtk_tree_row_reference_get_path, pl_pu);
+ Xg_define_procedure(gtk_tree_row_reference_valid, gxg_gtk_tree_row_reference_valid_w, 1, 0, 0, H_gtk_tree_row_reference_valid, pl_bu);
+ Xg_define_procedure(gtk_tree_row_reference_free, gxg_gtk_tree_row_reference_free_w, 1, 0, 0, H_gtk_tree_row_reference_free, pl_tu);
+ Xg_define_procedure(gtk_tree_row_reference_inserted, gxg_gtk_tree_row_reference_inserted_w, 2, 0, 0, H_gtk_tree_row_reference_inserted, pl_tu);
+ Xg_define_procedure(gtk_tree_row_reference_deleted, gxg_gtk_tree_row_reference_deleted_w, 2, 0, 0, H_gtk_tree_row_reference_deleted, pl_tu);
+ Xg_define_procedure(gtk_tree_row_reference_reordered, gxg_gtk_tree_row_reference_reordered_w, 4, 0, 0, H_gtk_tree_row_reference_reordered, pl_tu);
+ Xg_define_procedure(gtk_tree_iter_copy, gxg_gtk_tree_iter_copy_w, 1, 0, 0, H_gtk_tree_iter_copy, pl_pu);
+ Xg_define_procedure(gtk_tree_iter_free, gxg_gtk_tree_iter_free_w, 1, 0, 0, H_gtk_tree_iter_free, pl_tu);
+ Xg_define_procedure(gtk_tree_model_get_flags, gxg_gtk_tree_model_get_flags_w, 1, 0, 0, H_gtk_tree_model_get_flags, pl_iu);
+ Xg_define_procedure(gtk_tree_model_get_n_columns, gxg_gtk_tree_model_get_n_columns_w, 1, 0, 0, H_gtk_tree_model_get_n_columns, pl_iu);
+ Xg_define_procedure(gtk_tree_model_get_column_type, gxg_gtk_tree_model_get_column_type_w, 2, 0, 0, H_gtk_tree_model_get_column_type, pl_iui);
+ Xg_define_procedure(gtk_tree_model_get_iter, gxg_gtk_tree_model_get_iter_w, 3, 0, 0, H_gtk_tree_model_get_iter, pl_bu);
+ Xg_define_procedure(gtk_tree_model_get_iter_from_string, gxg_gtk_tree_model_get_iter_from_string_w, 3, 0, 0, H_gtk_tree_model_get_iter_from_string, pl_buus);
+ Xg_define_procedure(gtk_tree_model_get_iter_first, gxg_gtk_tree_model_get_iter_first_w, 2, 0, 0, H_gtk_tree_model_get_iter_first, pl_bu);
+ Xg_define_procedure(gtk_tree_model_get_path, gxg_gtk_tree_model_get_path_w, 2, 0, 0, H_gtk_tree_model_get_path, pl_pu);
+ Xg_define_procedure(gtk_tree_model_iter_next, gxg_gtk_tree_model_iter_next_w, 2, 0, 0, H_gtk_tree_model_iter_next, pl_bu);
+ Xg_define_procedure(gtk_tree_model_iter_children, gxg_gtk_tree_model_iter_children_w, 3, 0, 0, H_gtk_tree_model_iter_children, pl_bu);
+ Xg_define_procedure(gtk_tree_model_iter_has_child, gxg_gtk_tree_model_iter_has_child_w, 2, 0, 0, H_gtk_tree_model_iter_has_child, pl_bu);
+ Xg_define_procedure(gtk_tree_model_iter_n_children, gxg_gtk_tree_model_iter_n_children_w, 2, 0, 0, H_gtk_tree_model_iter_n_children, pl_iu);
+ Xg_define_procedure(gtk_tree_model_iter_nth_child, gxg_gtk_tree_model_iter_nth_child_w, 4, 0, 0, H_gtk_tree_model_iter_nth_child, pl_buuui);
+ Xg_define_procedure(gtk_tree_model_iter_parent, gxg_gtk_tree_model_iter_parent_w, 3, 0, 0, H_gtk_tree_model_iter_parent, pl_bu);
+ Xg_define_procedure(gtk_tree_model_ref_node, gxg_gtk_tree_model_ref_node_w, 2, 0, 0, H_gtk_tree_model_ref_node, pl_tu);
+ Xg_define_procedure(gtk_tree_model_unref_node, gxg_gtk_tree_model_unref_node_w, 2, 0, 0, H_gtk_tree_model_unref_node, pl_tu);
+ Xg_define_procedure(gtk_tree_model_foreach, gxg_gtk_tree_model_foreach_w, 2, 1, 0, H_gtk_tree_model_foreach, pl_tut);
+ Xg_define_procedure(gtk_tree_model_row_changed, gxg_gtk_tree_model_row_changed_w, 3, 0, 0, H_gtk_tree_model_row_changed, pl_tu);
+ Xg_define_procedure(gtk_tree_model_row_inserted, gxg_gtk_tree_model_row_inserted_w, 3, 0, 0, H_gtk_tree_model_row_inserted, pl_tu);
+ Xg_define_procedure(gtk_tree_model_row_has_child_toggled, gxg_gtk_tree_model_row_has_child_toggled_w, 3, 0, 0, H_gtk_tree_model_row_has_child_toggled, pl_tu);
+ Xg_define_procedure(gtk_tree_model_row_deleted, gxg_gtk_tree_model_row_deleted_w, 2, 0, 0, H_gtk_tree_model_row_deleted, pl_tu);
+ Xg_define_procedure(gtk_tree_model_rows_reordered, gxg_gtk_tree_model_rows_reordered_w, 4, 0, 0, H_gtk_tree_model_rows_reordered, pl_tu);
+ Xg_define_procedure(gtk_tree_model_sort_new_with_model, gxg_gtk_tree_model_sort_new_with_model_w, 1, 0, 0, H_gtk_tree_model_sort_new_with_model, pl_pu);
+ Xg_define_procedure(gtk_tree_model_sort_get_model, gxg_gtk_tree_model_sort_get_model_w, 1, 0, 0, H_gtk_tree_model_sort_get_model, pl_pu);
+ Xg_define_procedure(gtk_tree_model_sort_convert_child_path_to_path, gxg_gtk_tree_model_sort_convert_child_path_to_path_w, 2, 0, 0, H_gtk_tree_model_sort_convert_child_path_to_path, pl_pu);
+ Xg_define_procedure(gtk_tree_model_sort_convert_child_iter_to_iter, gxg_gtk_tree_model_sort_convert_child_iter_to_iter_w, 3, 0, 0, H_gtk_tree_model_sort_convert_child_iter_to_iter, pl_tu);
+ Xg_define_procedure(gtk_tree_model_sort_convert_path_to_child_path, gxg_gtk_tree_model_sort_convert_path_to_child_path_w, 2, 0, 0, H_gtk_tree_model_sort_convert_path_to_child_path, pl_pu);
+ Xg_define_procedure(gtk_tree_model_sort_convert_iter_to_child_iter, gxg_gtk_tree_model_sort_convert_iter_to_child_iter_w, 3, 0, 0, H_gtk_tree_model_sort_convert_iter_to_child_iter, pl_tu);
+ Xg_define_procedure(gtk_tree_model_sort_reset_default_sort_func, gxg_gtk_tree_model_sort_reset_default_sort_func_w, 1, 0, 0, H_gtk_tree_model_sort_reset_default_sort_func, pl_tu);
+ Xg_define_procedure(gtk_tree_model_sort_clear_cache, gxg_gtk_tree_model_sort_clear_cache_w, 1, 0, 0, H_gtk_tree_model_sort_clear_cache, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_set_mode, gxg_gtk_tree_selection_set_mode_w, 2, 0, 0, H_gtk_tree_selection_set_mode, pl_tui);
+ Xg_define_procedure(gtk_tree_selection_get_mode, gxg_gtk_tree_selection_get_mode_w, 1, 0, 0, H_gtk_tree_selection_get_mode, pl_iu);
+ Xg_define_procedure(gtk_tree_selection_set_select_function, gxg_gtk_tree_selection_set_select_function_w, 4, 0, 0, H_gtk_tree_selection_set_select_function, pl_tut);
+ Xg_define_procedure(gtk_tree_selection_get_user_data, gxg_gtk_tree_selection_get_user_data_w, 1, 0, 0, H_gtk_tree_selection_get_user_data, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_get_tree_view, gxg_gtk_tree_selection_get_tree_view_w, 1, 0, 0, H_gtk_tree_selection_get_tree_view, pl_pu);
+ Xg_define_procedure(gtk_tree_selection_get_selected, gxg_gtk_tree_selection_get_selected_w, 3, 0, 0, H_gtk_tree_selection_get_selected, pl_bu);
+ Xg_define_procedure(gtk_tree_selection_selected_foreach, gxg_gtk_tree_selection_selected_foreach_w, 2, 1, 0, H_gtk_tree_selection_selected_foreach, pl_tut);
+ Xg_define_procedure(gtk_tree_selection_select_path, gxg_gtk_tree_selection_select_path_w, 2, 0, 0, H_gtk_tree_selection_select_path, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_unselect_path, gxg_gtk_tree_selection_unselect_path_w, 2, 0, 0, H_gtk_tree_selection_unselect_path, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_select_iter, gxg_gtk_tree_selection_select_iter_w, 2, 0, 0, H_gtk_tree_selection_select_iter, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_unselect_iter, gxg_gtk_tree_selection_unselect_iter_w, 2, 0, 0, H_gtk_tree_selection_unselect_iter, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_path_is_selected, gxg_gtk_tree_selection_path_is_selected_w, 2, 0, 0, H_gtk_tree_selection_path_is_selected, pl_bu);
+ Xg_define_procedure(gtk_tree_selection_iter_is_selected, gxg_gtk_tree_selection_iter_is_selected_w, 2, 0, 0, H_gtk_tree_selection_iter_is_selected, pl_bu);
+ Xg_define_procedure(gtk_tree_selection_select_all, gxg_gtk_tree_selection_select_all_w, 1, 0, 0, H_gtk_tree_selection_select_all, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_unselect_all, gxg_gtk_tree_selection_unselect_all_w, 1, 0, 0, H_gtk_tree_selection_unselect_all, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_select_range, gxg_gtk_tree_selection_select_range_w, 3, 0, 0, H_gtk_tree_selection_select_range, pl_tu);
+ Xg_define_procedure(gtk_tree_sortable_sort_column_changed, gxg_gtk_tree_sortable_sort_column_changed_w, 1, 0, 0, H_gtk_tree_sortable_sort_column_changed, pl_tu);
+ Xg_define_procedure(gtk_tree_sortable_get_sort_column_id, gxg_gtk_tree_sortable_get_sort_column_id_w, 1, 2, 0, H_gtk_tree_sortable_get_sort_column_id, pl_bu);
+ Xg_define_procedure(gtk_tree_sortable_set_sort_column_id, gxg_gtk_tree_sortable_set_sort_column_id_w, 3, 0, 0, H_gtk_tree_sortable_set_sort_column_id, pl_tui);
+ Xg_define_procedure(gtk_tree_sortable_set_sort_func, gxg_gtk_tree_sortable_set_sort_func_w, 5, 0, 0, H_gtk_tree_sortable_set_sort_func, pl_tuit);
+ Xg_define_procedure(gtk_tree_sortable_set_default_sort_func, gxg_gtk_tree_sortable_set_default_sort_func_w, 4, 0, 0, H_gtk_tree_sortable_set_default_sort_func, pl_tut);
+ Xg_define_procedure(gtk_tree_sortable_has_default_sort_func, gxg_gtk_tree_sortable_has_default_sort_func_w, 1, 0, 0, H_gtk_tree_sortable_has_default_sort_func, pl_bu);
+ Xg_define_procedure(gtk_tree_store_new, gxg_gtk_tree_store_new_w, 2, 0, 0, H_gtk_tree_store_new, pl_pit);
+ Xg_define_procedure(gtk_tree_store_newv, gxg_gtk_tree_store_newv_w, 2, 0, 0, H_gtk_tree_store_newv, pl_piu);
+ Xg_define_procedure(gtk_tree_store_set_column_types, gxg_gtk_tree_store_set_column_types_w, 3, 0, 0, H_gtk_tree_store_set_column_types, pl_tuiu);
+ Xg_define_procedure(gtk_tree_store_set, gxg_gtk_tree_store_set_w, 3, 0, 0, H_gtk_tree_store_set, pl_tuut);
+ Xg_define_procedure(gtk_tree_store_remove, gxg_gtk_tree_store_remove_w, 2, 0, 0, H_gtk_tree_store_remove, pl_tu);
+ Xg_define_procedure(gtk_tree_store_insert, gxg_gtk_tree_store_insert_w, 4, 0, 0, H_gtk_tree_store_insert, pl_tuuui);
+ Xg_define_procedure(gtk_tree_store_insert_before, gxg_gtk_tree_store_insert_before_w, 4, 0, 0, H_gtk_tree_store_insert_before, pl_tu);
+ Xg_define_procedure(gtk_tree_store_insert_after, gxg_gtk_tree_store_insert_after_w, 4, 0, 0, H_gtk_tree_store_insert_after, pl_tu);
+ Xg_define_procedure(gtk_tree_store_prepend, gxg_gtk_tree_store_prepend_w, 3, 0, 0, H_gtk_tree_store_prepend, pl_tu);
+ Xg_define_procedure(gtk_tree_store_append, gxg_gtk_tree_store_append_w, 3, 0, 0, H_gtk_tree_store_append, pl_tu);
+ Xg_define_procedure(gtk_tree_store_is_ancestor, gxg_gtk_tree_store_is_ancestor_w, 3, 0, 0, H_gtk_tree_store_is_ancestor, pl_bu);
+ Xg_define_procedure(gtk_tree_store_iter_depth, gxg_gtk_tree_store_iter_depth_w, 2, 0, 0, H_gtk_tree_store_iter_depth, pl_iu);
+ Xg_define_procedure(gtk_tree_store_clear, gxg_gtk_tree_store_clear_w, 1, 0, 0, H_gtk_tree_store_clear, pl_tu);
+ Xg_define_procedure(gtk_tree_view_column_new, gxg_gtk_tree_view_column_new_w, 0, 0, 0, H_gtk_tree_view_column_new, pl_p);
+ Xg_define_procedure(gtk_tree_view_column_new_with_attributes, gxg_gtk_tree_view_column_new_with_attributes_w, 3, 0, 0, H_gtk_tree_view_column_new_with_attributes, pl_psut);
+ Xg_define_procedure(gtk_tree_view_column_pack_start, gxg_gtk_tree_view_column_pack_start_w, 3, 0, 0, H_gtk_tree_view_column_pack_start, pl_tuub);
+ Xg_define_procedure(gtk_tree_view_column_pack_end, gxg_gtk_tree_view_column_pack_end_w, 3, 0, 0, H_gtk_tree_view_column_pack_end, pl_tuub);
+ Xg_define_procedure(gtk_tree_view_column_clear, gxg_gtk_tree_view_column_clear_w, 1, 0, 0, H_gtk_tree_view_column_clear, pl_tu);
+ Xg_define_procedure(gtk_tree_view_column_add_attribute, gxg_gtk_tree_view_column_add_attribute_w, 4, 0, 0, H_gtk_tree_view_column_add_attribute, pl_tuusi);
+ Xg_define_procedure(gtk_tree_view_column_set_attributes, gxg_gtk_tree_view_column_set_attributes_w, 3, 0, 0, H_gtk_tree_view_column_set_attributes, pl_tuut);
+ Xg_define_procedure(gtk_tree_view_column_set_cell_data_func, gxg_gtk_tree_view_column_set_cell_data_func_w, 5, 0, 0, H_gtk_tree_view_column_set_cell_data_func, pl_tuut);
+ Xg_define_procedure(gtk_tree_view_column_clear_attributes, gxg_gtk_tree_view_column_clear_attributes_w, 2, 0, 0, H_gtk_tree_view_column_clear_attributes, pl_tu);
+ Xg_define_procedure(gtk_tree_view_column_set_spacing, gxg_gtk_tree_view_column_set_spacing_w, 2, 0, 0, H_gtk_tree_view_column_set_spacing, pl_tui);
+ Xg_define_procedure(gtk_tree_view_column_get_spacing, gxg_gtk_tree_view_column_get_spacing_w, 1, 0, 0, H_gtk_tree_view_column_get_spacing, pl_iu);
+ Xg_define_procedure(gtk_tree_view_column_set_visible, gxg_gtk_tree_view_column_set_visible_w, 2, 0, 0, H_gtk_tree_view_column_set_visible, pl_tub);
+ Xg_define_procedure(gtk_tree_view_column_get_visible, gxg_gtk_tree_view_column_get_visible_w, 1, 0, 0, H_gtk_tree_view_column_get_visible, pl_bu);
+ Xg_define_procedure(gtk_tree_view_column_set_resizable, gxg_gtk_tree_view_column_set_resizable_w, 2, 0, 0, H_gtk_tree_view_column_set_resizable, pl_tub);
+ Xg_define_procedure(gtk_tree_view_column_get_resizable, gxg_gtk_tree_view_column_get_resizable_w, 1, 0, 0, H_gtk_tree_view_column_get_resizable, pl_bu);
+ Xg_define_procedure(gtk_tree_view_column_set_sizing, gxg_gtk_tree_view_column_set_sizing_w, 2, 0, 0, H_gtk_tree_view_column_set_sizing, pl_tui);
+ Xg_define_procedure(gtk_tree_view_column_get_sizing, gxg_gtk_tree_view_column_get_sizing_w, 1, 0, 0, H_gtk_tree_view_column_get_sizing, pl_iu);
+ Xg_define_procedure(gtk_tree_view_column_get_width, gxg_gtk_tree_view_column_get_width_w, 1, 0, 0, H_gtk_tree_view_column_get_width, pl_iu);
+ Xg_define_procedure(gtk_tree_view_column_get_fixed_width, gxg_gtk_tree_view_column_get_fixed_width_w, 1, 0, 0, H_gtk_tree_view_column_get_fixed_width, pl_iu);
+ Xg_define_procedure(gtk_tree_view_column_set_fixed_width, gxg_gtk_tree_view_column_set_fixed_width_w, 2, 0, 0, H_gtk_tree_view_column_set_fixed_width, pl_tui);
+ Xg_define_procedure(gtk_tree_view_column_set_min_width, gxg_gtk_tree_view_column_set_min_width_w, 2, 0, 0, H_gtk_tree_view_column_set_min_width, pl_tui);
+ Xg_define_procedure(gtk_tree_view_column_get_min_width, gxg_gtk_tree_view_column_get_min_width_w, 1, 0, 0, H_gtk_tree_view_column_get_min_width, pl_iu);
+ Xg_define_procedure(gtk_tree_view_column_set_max_width, gxg_gtk_tree_view_column_set_max_width_w, 2, 0, 0, H_gtk_tree_view_column_set_max_width, pl_tui);
+ Xg_define_procedure(gtk_tree_view_column_get_max_width, gxg_gtk_tree_view_column_get_max_width_w, 1, 0, 0, H_gtk_tree_view_column_get_max_width, pl_iu);
+ Xg_define_procedure(gtk_tree_view_column_clicked, gxg_gtk_tree_view_column_clicked_w, 1, 0, 0, H_gtk_tree_view_column_clicked, pl_tu);
+ Xg_define_procedure(gtk_tree_view_column_set_title, gxg_gtk_tree_view_column_set_title_w, 2, 0, 0, H_gtk_tree_view_column_set_title, pl_tus);
+ Xg_define_procedure(gtk_tree_view_column_get_title, gxg_gtk_tree_view_column_get_title_w, 1, 0, 0, H_gtk_tree_view_column_get_title, pl_su);
+ Xg_define_procedure(gtk_tree_view_column_set_clickable, gxg_gtk_tree_view_column_set_clickable_w, 2, 0, 0, H_gtk_tree_view_column_set_clickable, pl_tub);
+ Xg_define_procedure(gtk_tree_view_column_get_clickable, gxg_gtk_tree_view_column_get_clickable_w, 1, 0, 0, H_gtk_tree_view_column_get_clickable, pl_bu);
+ Xg_define_procedure(gtk_tree_view_column_set_widget, gxg_gtk_tree_view_column_set_widget_w, 2, 0, 0, H_gtk_tree_view_column_set_widget, pl_tu);
+ Xg_define_procedure(gtk_tree_view_column_get_widget, gxg_gtk_tree_view_column_get_widget_w, 1, 0, 0, H_gtk_tree_view_column_get_widget, pl_pu);
+ Xg_define_procedure(gtk_tree_view_column_set_alignment, gxg_gtk_tree_view_column_set_alignment_w, 2, 0, 0, H_gtk_tree_view_column_set_alignment, pl_tur);
+ Xg_define_procedure(gtk_tree_view_column_get_alignment, gxg_gtk_tree_view_column_get_alignment_w, 1, 0, 0, H_gtk_tree_view_column_get_alignment, pl_du);
+ Xg_define_procedure(gtk_tree_view_column_set_reorderable, gxg_gtk_tree_view_column_set_reorderable_w, 2, 0, 0, H_gtk_tree_view_column_set_reorderable, pl_tub);
+ Xg_define_procedure(gtk_tree_view_column_get_reorderable, gxg_gtk_tree_view_column_get_reorderable_w, 1, 0, 0, H_gtk_tree_view_column_get_reorderable, pl_bu);
+ Xg_define_procedure(gtk_tree_view_column_set_sort_column_id, gxg_gtk_tree_view_column_set_sort_column_id_w, 2, 0, 0, H_gtk_tree_view_column_set_sort_column_id, pl_tui);
+ Xg_define_procedure(gtk_tree_view_column_get_sort_column_id, gxg_gtk_tree_view_column_get_sort_column_id_w, 1, 0, 0, H_gtk_tree_view_column_get_sort_column_id, pl_iu);
+ Xg_define_procedure(gtk_tree_view_column_set_sort_indicator, gxg_gtk_tree_view_column_set_sort_indicator_w, 2, 0, 0, H_gtk_tree_view_column_set_sort_indicator, pl_tub);
+ Xg_define_procedure(gtk_tree_view_column_get_sort_indicator, gxg_gtk_tree_view_column_get_sort_indicator_w, 1, 0, 0, H_gtk_tree_view_column_get_sort_indicator, pl_bu);
+ Xg_define_procedure(gtk_tree_view_column_set_sort_order, gxg_gtk_tree_view_column_set_sort_order_w, 2, 0, 0, H_gtk_tree_view_column_set_sort_order, pl_tui);
+ Xg_define_procedure(gtk_tree_view_column_get_sort_order, gxg_gtk_tree_view_column_get_sort_order_w, 1, 0, 0, H_gtk_tree_view_column_get_sort_order, pl_iu);
+ Xg_define_procedure(gtk_tree_view_column_cell_set_cell_data, gxg_gtk_tree_view_column_cell_set_cell_data_w, 5, 0, 0, H_gtk_tree_view_column_cell_set_cell_data, pl_tuuub);
+ Xg_define_procedure(gtk_tree_view_column_cell_get_size, gxg_gtk_tree_view_column_cell_get_size_w, 2, 4, 0, H_gtk_tree_view_column_cell_get_size, pl_tu);
+ Xg_define_procedure(gtk_tree_view_column_cell_is_visible, gxg_gtk_tree_view_column_cell_is_visible_w, 1, 0, 0, H_gtk_tree_view_column_cell_is_visible, pl_bu);
+ Xg_define_procedure(gtk_tree_view_column_cell_get_position, gxg_gtk_tree_view_column_cell_get_position_w, 2, 2, 0, H_gtk_tree_view_column_cell_get_position, pl_bu);
+ Xg_define_procedure(gtk_tree_view_new, gxg_gtk_tree_view_new_w, 0, 0, 0, H_gtk_tree_view_new, pl_p);
+ Xg_define_procedure(gtk_tree_view_new_with_model, gxg_gtk_tree_view_new_with_model_w, 1, 0, 0, H_gtk_tree_view_new_with_model, pl_pu);
+ Xg_define_procedure(gtk_tree_view_get_model, gxg_gtk_tree_view_get_model_w, 1, 0, 0, H_gtk_tree_view_get_model, pl_pu);
+ Xg_define_procedure(gtk_tree_view_set_model, gxg_gtk_tree_view_set_model_w, 2, 0, 0, H_gtk_tree_view_set_model, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_selection, gxg_gtk_tree_view_get_selection_w, 1, 0, 0, H_gtk_tree_view_get_selection, pl_pu);
+ Xg_define_procedure(gtk_tree_view_get_headers_visible, gxg_gtk_tree_view_get_headers_visible_w, 1, 0, 0, H_gtk_tree_view_get_headers_visible, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_headers_visible, gxg_gtk_tree_view_set_headers_visible_w, 2, 0, 0, H_gtk_tree_view_set_headers_visible, pl_tub);
+ Xg_define_procedure(gtk_tree_view_columns_autosize, gxg_gtk_tree_view_columns_autosize_w, 1, 0, 0, H_gtk_tree_view_columns_autosize, pl_tu);
+ Xg_define_procedure(gtk_tree_view_set_headers_clickable, gxg_gtk_tree_view_set_headers_clickable_w, 2, 0, 0, H_gtk_tree_view_set_headers_clickable, pl_tub);
+ Xg_define_procedure(gtk_tree_view_append_column, gxg_gtk_tree_view_append_column_w, 2, 0, 0, H_gtk_tree_view_append_column, pl_iu);
+ Xg_define_procedure(gtk_tree_view_remove_column, gxg_gtk_tree_view_remove_column_w, 2, 0, 0, H_gtk_tree_view_remove_column, pl_iu);
+ Xg_define_procedure(gtk_tree_view_insert_column, gxg_gtk_tree_view_insert_column_w, 3, 0, 0, H_gtk_tree_view_insert_column, pl_iuui);
+ Xg_define_procedure(gtk_tree_view_insert_column_with_attributes, gxg_gtk_tree_view_insert_column_with_attributes_w, 5, 0, 0, H_gtk_tree_view_insert_column_with_attributes, pl_iuisut);
+ Xg_define_procedure(gtk_tree_view_insert_column_with_data_func, gxg_gtk_tree_view_insert_column_with_data_func_w, 7, 0, 0, H_gtk_tree_view_insert_column_with_data_func, pl_iuisut);
+ Xg_define_procedure(gtk_tree_view_get_column, gxg_gtk_tree_view_get_column_w, 2, 0, 0, H_gtk_tree_view_get_column, pl_pui);
+ Xg_define_procedure(gtk_tree_view_get_columns, gxg_gtk_tree_view_get_columns_w, 1, 0, 0, H_gtk_tree_view_get_columns, pl_pu);
+ Xg_define_procedure(gtk_tree_view_move_column_after, gxg_gtk_tree_view_move_column_after_w, 3, 0, 0, H_gtk_tree_view_move_column_after, pl_tu);
+ Xg_define_procedure(gtk_tree_view_set_expander_column, gxg_gtk_tree_view_set_expander_column_w, 2, 0, 0, H_gtk_tree_view_set_expander_column, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_expander_column, gxg_gtk_tree_view_get_expander_column_w, 1, 0, 0, H_gtk_tree_view_get_expander_column, pl_pu);
+ Xg_define_procedure(gtk_tree_view_set_column_drag_function, gxg_gtk_tree_view_set_column_drag_function_w, 4, 0, 0, H_gtk_tree_view_set_column_drag_function, pl_tut);
+ Xg_define_procedure(gtk_tree_view_scroll_to_point, gxg_gtk_tree_view_scroll_to_point_w, 3, 0, 0, H_gtk_tree_view_scroll_to_point, pl_tui);
+ Xg_define_procedure(gtk_tree_view_scroll_to_cell, gxg_gtk_tree_view_scroll_to_cell_w, 6, 0, 0, H_gtk_tree_view_scroll_to_cell, pl_tuuubr);
+ Xg_define_procedure(gtk_tree_view_row_activated, gxg_gtk_tree_view_row_activated_w, 3, 0, 0, H_gtk_tree_view_row_activated, pl_tu);
+ Xg_define_procedure(gtk_tree_view_expand_all, gxg_gtk_tree_view_expand_all_w, 1, 0, 0, H_gtk_tree_view_expand_all, pl_tu);
+ Xg_define_procedure(gtk_tree_view_collapse_all, gxg_gtk_tree_view_collapse_all_w, 1, 0, 0, H_gtk_tree_view_collapse_all, pl_tu);
+ Xg_define_procedure(gtk_tree_view_expand_row, gxg_gtk_tree_view_expand_row_w, 3, 0, 0, H_gtk_tree_view_expand_row, pl_buub);
+ Xg_define_procedure(gtk_tree_view_collapse_row, gxg_gtk_tree_view_collapse_row_w, 2, 0, 0, H_gtk_tree_view_collapse_row, pl_bu);
+ Xg_define_procedure(gtk_tree_view_map_expanded_rows, gxg_gtk_tree_view_map_expanded_rows_w, 2, 1, 0, H_gtk_tree_view_map_expanded_rows, pl_tut);
+ Xg_define_procedure(gtk_tree_view_row_expanded, gxg_gtk_tree_view_row_expanded_w, 2, 0, 0, H_gtk_tree_view_row_expanded, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_reorderable, gxg_gtk_tree_view_set_reorderable_w, 2, 0, 0, H_gtk_tree_view_set_reorderable, pl_tub);
+ Xg_define_procedure(gtk_tree_view_get_reorderable, gxg_gtk_tree_view_get_reorderable_w, 1, 0, 0, H_gtk_tree_view_get_reorderable, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_cursor, gxg_gtk_tree_view_set_cursor_w, 4, 0, 0, H_gtk_tree_view_set_cursor, pl_tuuub);
+ Xg_define_procedure(gtk_tree_view_get_cursor, gxg_gtk_tree_view_get_cursor_w, 1, 2, 0, H_gtk_tree_view_get_cursor, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_bin_window, gxg_gtk_tree_view_get_bin_window_w, 1, 0, 0, H_gtk_tree_view_get_bin_window, pl_pu);
+ Xg_define_procedure(gtk_tree_view_get_path_at_pos, gxg_gtk_tree_view_get_path_at_pos_w, 3, 4, 0, H_gtk_tree_view_get_path_at_pos, pl_buiiu);
+ Xg_define_procedure(gtk_tree_view_get_cell_area, gxg_gtk_tree_view_get_cell_area_w, 4, 0, 0, H_gtk_tree_view_get_cell_area, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_background_area, gxg_gtk_tree_view_get_background_area_w, 4, 0, 0, H_gtk_tree_view_get_background_area, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_visible_rect, gxg_gtk_tree_view_get_visible_rect_w, 2, 0, 0, H_gtk_tree_view_get_visible_rect, pl_tu);
+ Xg_define_procedure(gtk_tree_view_enable_model_drag_source, gxg_gtk_tree_view_enable_model_drag_source_w, 5, 0, 0, H_gtk_tree_view_enable_model_drag_source, pl_tuiui);
+ Xg_define_procedure(gtk_tree_view_enable_model_drag_dest, gxg_gtk_tree_view_enable_model_drag_dest_w, 4, 0, 0, H_gtk_tree_view_enable_model_drag_dest, pl_tuui);
+ Xg_define_procedure(gtk_tree_view_unset_rows_drag_source, gxg_gtk_tree_view_unset_rows_drag_source_w, 1, 0, 0, H_gtk_tree_view_unset_rows_drag_source, pl_tu);
+ Xg_define_procedure(gtk_tree_view_unset_rows_drag_dest, gxg_gtk_tree_view_unset_rows_drag_dest_w, 1, 0, 0, H_gtk_tree_view_unset_rows_drag_dest, pl_tu);
+ Xg_define_procedure(gtk_tree_view_set_drag_dest_row, gxg_gtk_tree_view_set_drag_dest_row_w, 3, 0, 0, H_gtk_tree_view_set_drag_dest_row, pl_tuui);
+ Xg_define_procedure(gtk_tree_view_get_drag_dest_row, gxg_gtk_tree_view_get_drag_dest_row_w, 1, 2, 0, H_gtk_tree_view_get_drag_dest_row, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_dest_row_at_pos, gxg_gtk_tree_view_get_dest_row_at_pos_w, 3, 2, 0, H_gtk_tree_view_get_dest_row_at_pos, pl_buiiu);
+ Xg_define_procedure(gtk_tree_view_set_enable_search, gxg_gtk_tree_view_set_enable_search_w, 2, 0, 0, H_gtk_tree_view_set_enable_search, pl_tub);
+ Xg_define_procedure(gtk_tree_view_get_enable_search, gxg_gtk_tree_view_get_enable_search_w, 1, 0, 0, H_gtk_tree_view_get_enable_search, pl_bu);
+ Xg_define_procedure(gtk_tree_view_get_search_column, gxg_gtk_tree_view_get_search_column_w, 1, 0, 0, H_gtk_tree_view_get_search_column, pl_iu);
+ Xg_define_procedure(gtk_tree_view_set_search_column, gxg_gtk_tree_view_set_search_column_w, 2, 0, 0, H_gtk_tree_view_set_search_column, pl_tui);
+ Xg_define_procedure(gtk_tree_view_get_search_equal_func, gxg_gtk_tree_view_get_search_equal_func_w, 1, 0, 0, H_gtk_tree_view_get_search_equal_func, pl_tu);
+ Xg_define_procedure(gtk_tree_view_set_search_equal_func, gxg_gtk_tree_view_set_search_equal_func_w, 4, 0, 0, H_gtk_tree_view_set_search_equal_func, pl_tut);
+ Xg_define_procedure(gtk_viewport_new, gxg_gtk_viewport_new_w, 2, 0, 0, H_gtk_viewport_new, pl_pu);
+ Xg_define_procedure(gtk_viewport_set_shadow_type, gxg_gtk_viewport_set_shadow_type_w, 2, 0, 0, H_gtk_viewport_set_shadow_type, pl_tui);
+ Xg_define_procedure(gtk_viewport_get_shadow_type, gxg_gtk_viewport_get_shadow_type_w, 1, 0, 0, H_gtk_viewport_get_shadow_type, pl_iu);
+ Xg_define_procedure(gtk_widget_destroy, gxg_gtk_widget_destroy_w, 1, 0, 0, H_gtk_widget_destroy, pl_tu);
+ Xg_define_procedure(gtk_widget_destroyed, gxg_gtk_widget_destroyed_w, 1, 1, 0, H_gtk_widget_destroyed, pl_tu);
+ Xg_define_procedure(gtk_widget_unparent, gxg_gtk_widget_unparent_w, 1, 0, 0, H_gtk_widget_unparent, pl_tu);
+ Xg_define_procedure(gtk_widget_show, gxg_gtk_widget_show_w, 1, 0, 0, H_gtk_widget_show, pl_tu);
+ Xg_define_procedure(gtk_widget_show_now, gxg_gtk_widget_show_now_w, 1, 0, 0, H_gtk_widget_show_now, pl_tu);
+ Xg_define_procedure(gtk_widget_hide, gxg_gtk_widget_hide_w, 1, 0, 0, H_gtk_widget_hide, pl_tu);
+ Xg_define_procedure(gtk_widget_show_all, gxg_gtk_widget_show_all_w, 1, 0, 0, H_gtk_widget_show_all, pl_tu);
+ Xg_define_procedure(gtk_widget_map, gxg_gtk_widget_map_w, 1, 0, 0, H_gtk_widget_map, pl_tu);
+ Xg_define_procedure(gtk_widget_unmap, gxg_gtk_widget_unmap_w, 1, 0, 0, H_gtk_widget_unmap, pl_tu);
+ Xg_define_procedure(gtk_widget_realize, gxg_gtk_widget_realize_w, 1, 0, 0, H_gtk_widget_realize, pl_tu);
+ Xg_define_procedure(gtk_widget_unrealize, gxg_gtk_widget_unrealize_w, 1, 0, 0, H_gtk_widget_unrealize, pl_tu);
+ Xg_define_procedure(gtk_widget_queue_draw, gxg_gtk_widget_queue_draw_w, 1, 0, 0, H_gtk_widget_queue_draw, pl_tu);
+ Xg_define_procedure(gtk_widget_queue_draw_area, gxg_gtk_widget_queue_draw_area_w, 5, 0, 0, H_gtk_widget_queue_draw_area, pl_tui);
+ Xg_define_procedure(gtk_widget_queue_resize, gxg_gtk_widget_queue_resize_w, 1, 0, 0, H_gtk_widget_queue_resize, pl_tu);
+ Xg_define_procedure(gtk_widget_size_allocate, gxg_gtk_widget_size_allocate_w, 2, 0, 0, H_gtk_widget_size_allocate, pl_tu);
+ Xg_define_procedure(gtk_widget_add_accelerator, gxg_gtk_widget_add_accelerator_w, 6, 0, 0, H_gtk_widget_add_accelerator, pl_tusui);
+ Xg_define_procedure(gtk_widget_remove_accelerator, gxg_gtk_widget_remove_accelerator_w, 4, 0, 0, H_gtk_widget_remove_accelerator, pl_buui);
+ Xg_define_procedure(gtk_widget_list_accel_closures, gxg_gtk_widget_list_accel_closures_w, 1, 0, 0, H_gtk_widget_list_accel_closures, pl_pu);
+ Xg_define_procedure(gtk_widget_mnemonic_activate, gxg_gtk_widget_mnemonic_activate_w, 2, 0, 0, H_gtk_widget_mnemonic_activate, pl_bub);
+ Xg_define_procedure(gtk_widget_event, gxg_gtk_widget_event_w, 2, 0, 0, H_gtk_widget_event, pl_bu);
+ Xg_define_procedure(gtk_widget_send_expose, gxg_gtk_widget_send_expose_w, 2, 0, 0, H_gtk_widget_send_expose, pl_iu);
+ Xg_define_procedure(gtk_widget_activate, gxg_gtk_widget_activate_w, 1, 0, 0, H_gtk_widget_activate, pl_bu);
+ Xg_define_procedure(gtk_widget_intersect, gxg_gtk_widget_intersect_w, 3, 0, 0, H_gtk_widget_intersect, pl_bu);
+ Xg_define_procedure(gtk_widget_freeze_child_notify, gxg_gtk_widget_freeze_child_notify_w, 1, 0, 0, H_gtk_widget_freeze_child_notify, pl_tu);
+ Xg_define_procedure(gtk_widget_child_notify, gxg_gtk_widget_child_notify_w, 2, 0, 0, H_gtk_widget_child_notify, pl_tus);
+ Xg_define_procedure(gtk_widget_thaw_child_notify, gxg_gtk_widget_thaw_child_notify_w, 1, 0, 0, H_gtk_widget_thaw_child_notify, pl_tu);
+ Xg_define_procedure(gtk_widget_is_focus, gxg_gtk_widget_is_focus_w, 1, 0, 0, H_gtk_widget_is_focus, pl_bu);
+ Xg_define_procedure(gtk_widget_grab_focus, gxg_gtk_widget_grab_focus_w, 1, 0, 0, H_gtk_widget_grab_focus, pl_tu);
+ Xg_define_procedure(gtk_widget_grab_default, gxg_gtk_widget_grab_default_w, 1, 0, 0, H_gtk_widget_grab_default, pl_tu);
+ Xg_define_procedure(gtk_widget_set_name, gxg_gtk_widget_set_name_w, 2, 0, 0, H_gtk_widget_set_name, pl_tus);
+ Xg_define_procedure(gtk_widget_get_name, gxg_gtk_widget_get_name_w, 1, 0, 0, H_gtk_widget_get_name, pl_su);
+ Xg_define_procedure(gtk_widget_set_sensitive, gxg_gtk_widget_set_sensitive_w, 2, 0, 0, H_gtk_widget_set_sensitive, pl_tub);
+ Xg_define_procedure(gtk_widget_set_app_paintable, gxg_gtk_widget_set_app_paintable_w, 2, 0, 0, H_gtk_widget_set_app_paintable, pl_tub);
+ Xg_define_procedure(gtk_widget_set_redraw_on_allocate, gxg_gtk_widget_set_redraw_on_allocate_w, 2, 0, 0, H_gtk_widget_set_redraw_on_allocate, pl_tub);
+ Xg_define_procedure(gtk_widget_set_parent, gxg_gtk_widget_set_parent_w, 2, 0, 0, H_gtk_widget_set_parent, pl_tu);
+ Xg_define_procedure(gtk_widget_set_parent_window, gxg_gtk_widget_set_parent_window_w, 2, 0, 0, H_gtk_widget_set_parent_window, pl_tu);
+ Xg_define_procedure(gtk_widget_set_child_visible, gxg_gtk_widget_set_child_visible_w, 2, 0, 0, H_gtk_widget_set_child_visible, pl_tub);
+ Xg_define_procedure(gtk_widget_set_accel_path, gxg_gtk_widget_set_accel_path_w, 3, 0, 0, H_gtk_widget_set_accel_path, pl_tusu);
+ Xg_define_procedure(gtk_widget_get_child_visible, gxg_gtk_widget_get_child_visible_w, 1, 0, 0, H_gtk_widget_get_child_visible, pl_bu);
+ Xg_define_procedure(gtk_widget_get_parent, gxg_gtk_widget_get_parent_w, 1, 0, 0, H_gtk_widget_get_parent, pl_pu);
+ Xg_define_procedure(gtk_widget_get_parent_window, gxg_gtk_widget_get_parent_window_w, 1, 0, 0, H_gtk_widget_get_parent_window, pl_pu);
+ Xg_define_procedure(gtk_widget_child_focus, gxg_gtk_widget_child_focus_w, 2, 0, 0, H_gtk_widget_child_focus, pl_bui);
+ Xg_define_procedure(gtk_widget_set_size_request, gxg_gtk_widget_set_size_request_w, 3, 0, 0, H_gtk_widget_set_size_request, pl_tui);
+ Xg_define_procedure(gtk_widget_get_size_request, gxg_gtk_widget_get_size_request_w, 1, 2, 0, H_gtk_widget_get_size_request, pl_tu);
+ Xg_define_procedure(gtk_widget_set_events, gxg_gtk_widget_set_events_w, 2, 0, 0, H_gtk_widget_set_events, pl_tui);
+ Xg_define_procedure(gtk_widget_add_events, gxg_gtk_widget_add_events_w, 2, 0, 0, H_gtk_widget_add_events, pl_tui);
+ Xg_define_procedure(gtk_widget_get_toplevel, gxg_gtk_widget_get_toplevel_w, 1, 0, 0, H_gtk_widget_get_toplevel, pl_pu);
+ Xg_define_procedure(gtk_widget_get_ancestor, gxg_gtk_widget_get_ancestor_w, 2, 0, 0, H_gtk_widget_get_ancestor, pl_pui);
+ Xg_define_procedure(gtk_widget_get_visual, gxg_gtk_widget_get_visual_w, 1, 0, 0, H_gtk_widget_get_visual, pl_pu);
+ Xg_define_procedure(gtk_widget_get_settings, gxg_gtk_widget_get_settings_w, 1, 0, 0, H_gtk_widget_get_settings, pl_pu);
+ Xg_define_procedure(gtk_widget_get_accessible, gxg_gtk_widget_get_accessible_w, 1, 0, 0, H_gtk_widget_get_accessible, pl_pu);
+ Xg_define_procedure(gtk_widget_get_events, gxg_gtk_widget_get_events_w, 1, 0, 0, H_gtk_widget_get_events, pl_iu);
+ Xg_define_procedure(gtk_widget_is_ancestor, gxg_gtk_widget_is_ancestor_w, 2, 0, 0, H_gtk_widget_is_ancestor, pl_bu);
+ Xg_define_procedure(gtk_widget_translate_coordinates, gxg_gtk_widget_translate_coordinates_w, 4, 2, 0, H_gtk_widget_translate_coordinates, pl_buuiiu);
+ Xg_define_procedure(gtk_widget_hide_on_delete, gxg_gtk_widget_hide_on_delete_w, 1, 0, 0, H_gtk_widget_hide_on_delete, pl_bu);
+ Xg_define_procedure(gtk_widget_create_pango_context, gxg_gtk_widget_create_pango_context_w, 1, 0, 0, H_gtk_widget_create_pango_context, pl_pu);
+ Xg_define_procedure(gtk_widget_get_pango_context, gxg_gtk_widget_get_pango_context_w, 1, 0, 0, H_gtk_widget_get_pango_context, pl_pu);
+ Xg_define_procedure(gtk_widget_create_pango_layout, gxg_gtk_widget_create_pango_layout_w, 2, 0, 0, H_gtk_widget_create_pango_layout, pl_pus);
+ Xg_define_procedure(gtk_widget_set_direction, gxg_gtk_widget_set_direction_w, 2, 0, 0, H_gtk_widget_set_direction, pl_tui);
+ Xg_define_procedure(gtk_widget_get_direction, gxg_gtk_widget_get_direction_w, 1, 0, 0, H_gtk_widget_get_direction, pl_iu);
+ Xg_define_procedure(gtk_widget_set_default_direction, gxg_gtk_widget_set_default_direction_w, 1, 0, 0, H_gtk_widget_set_default_direction, pl_ti);
+ Xg_define_procedure(gtk_widget_get_default_direction, gxg_gtk_widget_get_default_direction_w, 0, 0, 0, H_gtk_widget_get_default_direction, pl_i);
+ Xg_define_procedure(gtk_widget_can_activate_accel, gxg_gtk_widget_can_activate_accel_w, 2, 0, 0, H_gtk_widget_can_activate_accel, pl_bui);
+ Xg_define_procedure(gtk_window_is_active, gxg_gtk_window_is_active_w, 1, 0, 0, H_gtk_window_is_active, pl_bu);
+ Xg_define_procedure(gtk_window_has_toplevel_focus, gxg_gtk_window_has_toplevel_focus_w, 1, 0, 0, H_gtk_window_has_toplevel_focus, pl_bu);
+ Xg_define_procedure(gtk_window_new, gxg_gtk_window_new_w, 1, 0, 0, H_gtk_window_new, pl_pi);
+ Xg_define_procedure(gtk_window_set_title, gxg_gtk_window_set_title_w, 2, 0, 0, H_gtk_window_set_title, pl_tus);
+ Xg_define_procedure(gtk_window_set_auto_startup_notification, gxg_gtk_window_set_auto_startup_notification_w, 1, 0, 0, H_gtk_window_set_auto_startup_notification, pl_tb);
+ Xg_define_procedure(gtk_window_get_title, gxg_gtk_window_get_title_w, 1, 0, 0, H_gtk_window_get_title, pl_su);
+ Xg_define_procedure(gtk_window_set_wmclass, gxg_gtk_window_set_wmclass_w, 3, 0, 0, H_gtk_window_set_wmclass, pl_tus);
+ Xg_define_procedure(gtk_window_set_role, gxg_gtk_window_set_role_w, 2, 0, 0, H_gtk_window_set_role, pl_tus);
+ Xg_define_procedure(gtk_window_get_role, gxg_gtk_window_get_role_w, 1, 0, 0, H_gtk_window_get_role, pl_su);
+ Xg_define_procedure(gtk_window_add_accel_group, gxg_gtk_window_add_accel_group_w, 2, 0, 0, H_gtk_window_add_accel_group, pl_tu);
+ Xg_define_procedure(gtk_window_remove_accel_group, gxg_gtk_window_remove_accel_group_w, 2, 0, 0, H_gtk_window_remove_accel_group, pl_tu);
+ Xg_define_procedure(gtk_window_set_position, gxg_gtk_window_set_position_w, 2, 0, 0, H_gtk_window_set_position, pl_tui);
+ Xg_define_procedure(gtk_window_activate_focus, gxg_gtk_window_activate_focus_w, 1, 0, 0, H_gtk_window_activate_focus, pl_bu);
+ Xg_define_procedure(gtk_window_set_focus, gxg_gtk_window_set_focus_w, 2, 0, 0, H_gtk_window_set_focus, pl_tu);
+ Xg_define_procedure(gtk_window_get_focus, gxg_gtk_window_get_focus_w, 1, 0, 0, H_gtk_window_get_focus, pl_pu);
+ Xg_define_procedure(gtk_window_set_default, gxg_gtk_window_set_default_w, 2, 0, 0, H_gtk_window_set_default, pl_tu);
+ Xg_define_procedure(gtk_window_activate_default, gxg_gtk_window_activate_default_w, 1, 0, 0, H_gtk_window_activate_default, pl_bu);
+ Xg_define_procedure(gtk_window_set_transient_for, gxg_gtk_window_set_transient_for_w, 2, 0, 0, H_gtk_window_set_transient_for, pl_tu);
+ Xg_define_procedure(gtk_window_get_transient_for, gxg_gtk_window_get_transient_for_w, 1, 0, 0, H_gtk_window_get_transient_for, pl_pu);
+ Xg_define_procedure(gtk_window_set_type_hint, gxg_gtk_window_set_type_hint_w, 2, 0, 0, H_gtk_window_set_type_hint, pl_tui);
+ Xg_define_procedure(gtk_window_get_type_hint, gxg_gtk_window_get_type_hint_w, 1, 0, 0, H_gtk_window_get_type_hint, pl_iu);
+ Xg_define_procedure(gtk_window_set_destroy_with_parent, gxg_gtk_window_set_destroy_with_parent_w, 2, 0, 0, H_gtk_window_set_destroy_with_parent, pl_tub);
+ Xg_define_procedure(gtk_window_get_destroy_with_parent, gxg_gtk_window_get_destroy_with_parent_w, 1, 0, 0, H_gtk_window_get_destroy_with_parent, pl_bu);
+ Xg_define_procedure(gtk_window_set_resizable, gxg_gtk_window_set_resizable_w, 2, 0, 0, H_gtk_window_set_resizable, pl_tub);
+ Xg_define_procedure(gtk_window_get_resizable, gxg_gtk_window_get_resizable_w, 1, 0, 0, H_gtk_window_get_resizable, pl_bu);
+ Xg_define_procedure(gtk_window_set_gravity, gxg_gtk_window_set_gravity_w, 2, 0, 0, H_gtk_window_set_gravity, pl_tui);
+ Xg_define_procedure(gtk_window_get_gravity, gxg_gtk_window_get_gravity_w, 1, 0, 0, H_gtk_window_get_gravity, pl_iu);
+ Xg_define_procedure(gtk_window_set_geometry_hints, gxg_gtk_window_set_geometry_hints_w, 4, 0, 0, H_gtk_window_set_geometry_hints, pl_tuuui);
+ Xg_define_procedure(gtk_window_set_decorated, gxg_gtk_window_set_decorated_w, 2, 0, 0, H_gtk_window_set_decorated, pl_tub);
+ Xg_define_procedure(gtk_window_get_decorated, gxg_gtk_window_get_decorated_w, 1, 0, 0, H_gtk_window_get_decorated, pl_bu);
+ Xg_define_procedure(gtk_window_set_icon_list, gxg_gtk_window_set_icon_list_w, 2, 0, 0, H_gtk_window_set_icon_list, pl_tu);
+ Xg_define_procedure(gtk_window_get_icon_list, gxg_gtk_window_get_icon_list_w, 1, 0, 0, H_gtk_window_get_icon_list, pl_pu);
+ Xg_define_procedure(gtk_window_set_icon, gxg_gtk_window_set_icon_w, 2, 0, 0, H_gtk_window_set_icon, pl_tu);
+ Xg_define_procedure(gtk_window_get_icon, gxg_gtk_window_get_icon_w, 1, 0, 0, H_gtk_window_get_icon, pl_pu);
+ Xg_define_procedure(gtk_window_set_default_icon_list, gxg_gtk_window_set_default_icon_list_w, 1, 0, 0, H_gtk_window_set_default_icon_list, pl_tu);
+ Xg_define_procedure(gtk_window_get_default_icon_list, gxg_gtk_window_get_default_icon_list_w, 0, 0, 0, H_gtk_window_get_default_icon_list, pl_p);
+ Xg_define_procedure(gtk_window_set_modal, gxg_gtk_window_set_modal_w, 2, 0, 0, H_gtk_window_set_modal, pl_tub);
+ Xg_define_procedure(gtk_window_get_modal, gxg_gtk_window_get_modal_w, 1, 0, 0, H_gtk_window_get_modal, pl_bu);
+ Xg_define_procedure(gtk_window_list_toplevels, gxg_gtk_window_list_toplevels_w, 0, 0, 0, H_gtk_window_list_toplevels, pl_p);
+ Xg_define_procedure(gtk_window_add_mnemonic, gxg_gtk_window_add_mnemonic_w, 3, 0, 0, H_gtk_window_add_mnemonic, pl_tuiu);
+ Xg_define_procedure(gtk_window_remove_mnemonic, gxg_gtk_window_remove_mnemonic_w, 3, 0, 0, H_gtk_window_remove_mnemonic, pl_tuiu);
+ Xg_define_procedure(gtk_window_mnemonic_activate, gxg_gtk_window_mnemonic_activate_w, 3, 0, 0, H_gtk_window_mnemonic_activate, pl_bui);
+ Xg_define_procedure(gtk_window_set_mnemonic_modifier, gxg_gtk_window_set_mnemonic_modifier_w, 2, 0, 0, H_gtk_window_set_mnemonic_modifier, pl_tui);
+ Xg_define_procedure(gtk_window_get_mnemonic_modifier, gxg_gtk_window_get_mnemonic_modifier_w, 1, 0, 0, H_gtk_window_get_mnemonic_modifier, pl_iu);
+ Xg_define_procedure(gtk_window_present, gxg_gtk_window_present_w, 1, 0, 0, H_gtk_window_present, pl_tu);
+ Xg_define_procedure(gtk_window_iconify, gxg_gtk_window_iconify_w, 1, 0, 0, H_gtk_window_iconify, pl_tu);
+ Xg_define_procedure(gtk_window_deiconify, gxg_gtk_window_deiconify_w, 1, 0, 0, H_gtk_window_deiconify, pl_tu);
+ Xg_define_procedure(gtk_window_stick, gxg_gtk_window_stick_w, 1, 0, 0, H_gtk_window_stick, pl_tu);
+ Xg_define_procedure(gtk_window_unstick, gxg_gtk_window_unstick_w, 1, 0, 0, H_gtk_window_unstick, pl_tu);
+ Xg_define_procedure(gtk_window_maximize, gxg_gtk_window_maximize_w, 1, 0, 0, H_gtk_window_maximize, pl_tu);
+ Xg_define_procedure(gtk_window_unmaximize, gxg_gtk_window_unmaximize_w, 1, 0, 0, H_gtk_window_unmaximize, pl_tu);
+ Xg_define_procedure(gtk_window_begin_resize_drag, gxg_gtk_window_begin_resize_drag_w, 6, 0, 0, H_gtk_window_begin_resize_drag, pl_tui);
+ Xg_define_procedure(gtk_window_begin_move_drag, gxg_gtk_window_begin_move_drag_w, 5, 0, 0, H_gtk_window_begin_move_drag, pl_tui);
+ Xg_define_procedure(gtk_window_set_default_size, gxg_gtk_window_set_default_size_w, 3, 0, 0, H_gtk_window_set_default_size, pl_tui);
+ Xg_define_procedure(gtk_window_get_default_size, gxg_gtk_window_get_default_size_w, 1, 2, 0, H_gtk_window_get_default_size, pl_tu);
+ Xg_define_procedure(gtk_window_resize, gxg_gtk_window_resize_w, 3, 0, 0, H_gtk_window_resize, pl_tui);
+ Xg_define_procedure(gtk_window_get_size, gxg_gtk_window_get_size_w, 1, 2, 0, H_gtk_window_get_size, pl_tu);
+ Xg_define_procedure(gtk_window_move, gxg_gtk_window_move_w, 3, 0, 0, H_gtk_window_move, pl_tui);
+ Xg_define_procedure(gtk_window_get_position, gxg_gtk_window_get_position_w, 1, 2, 0, H_gtk_window_get_position, pl_tu);
+ Xg_define_procedure(gtk_window_parse_geometry, gxg_gtk_window_parse_geometry_w, 2, 0, 0, H_gtk_window_parse_geometry, pl_bus);
+ Xg_define_procedure(pango_color_copy, gxg_pango_color_copy_w, 1, 0, 0, H_pango_color_copy, pl_pu);
+ Xg_define_procedure(pango_color_free, gxg_pango_color_free_w, 1, 0, 0, H_pango_color_free, pl_tu);
+ Xg_define_procedure(pango_color_parse, gxg_pango_color_parse_w, 2, 0, 0, H_pango_color_parse, pl_bus);
+ Xg_define_procedure(pango_attr_type_register, gxg_pango_attr_type_register_w, 1, 0, 0, H_pango_attr_type_register, pl_is);
+ Xg_define_procedure(pango_attribute_copy, gxg_pango_attribute_copy_w, 1, 0, 0, H_pango_attribute_copy, pl_pu);
+ Xg_define_procedure(pango_attribute_destroy, gxg_pango_attribute_destroy_w, 1, 0, 0, H_pango_attribute_destroy, pl_tu);
+ Xg_define_procedure(pango_attribute_equal, gxg_pango_attribute_equal_w, 2, 0, 0, H_pango_attribute_equal, pl_bu);
+ Xg_define_procedure(pango_attr_language_new, gxg_pango_attr_language_new_w, 1, 0, 0, H_pango_attr_language_new, pl_pu);
+ Xg_define_procedure(pango_attr_family_new, gxg_pango_attr_family_new_w, 1, 0, 0, H_pango_attr_family_new, pl_ps);
+ Xg_define_procedure(pango_attr_foreground_new, gxg_pango_attr_foreground_new_w, 3, 0, 0, H_pango_attr_foreground_new, pl_pi);
+ Xg_define_procedure(pango_attr_background_new, gxg_pango_attr_background_new_w, 3, 0, 0, H_pango_attr_background_new, pl_pi);
+ Xg_define_procedure(pango_attr_size_new, gxg_pango_attr_size_new_w, 1, 0, 0, H_pango_attr_size_new, pl_pi);
+ Xg_define_procedure(pango_attr_style_new, gxg_pango_attr_style_new_w, 1, 0, 0, H_pango_attr_style_new, pl_pi);
+ Xg_define_procedure(pango_attr_weight_new, gxg_pango_attr_weight_new_w, 1, 0, 0, H_pango_attr_weight_new, pl_pi);
+ Xg_define_procedure(pango_attr_variant_new, gxg_pango_attr_variant_new_w, 1, 0, 0, H_pango_attr_variant_new, pl_pi);
+ Xg_define_procedure(pango_attr_stretch_new, gxg_pango_attr_stretch_new_w, 1, 0, 0, H_pango_attr_stretch_new, pl_pi);
+ Xg_define_procedure(pango_attr_font_desc_new, gxg_pango_attr_font_desc_new_w, 1, 0, 0, H_pango_attr_font_desc_new, pl_pu);
+ Xg_define_procedure(pango_attr_underline_new, gxg_pango_attr_underline_new_w, 1, 0, 0, H_pango_attr_underline_new, pl_pi);
+ Xg_define_procedure(pango_attr_strikethrough_new, gxg_pango_attr_strikethrough_new_w, 1, 0, 0, H_pango_attr_strikethrough_new, pl_pb);
+ Xg_define_procedure(pango_attr_rise_new, gxg_pango_attr_rise_new_w, 1, 0, 0, H_pango_attr_rise_new, pl_pi);
+ Xg_define_procedure(pango_attr_shape_new, gxg_pango_attr_shape_new_w, 2, 0, 0, H_pango_attr_shape_new, pl_pu);
+ Xg_define_procedure(pango_attr_scale_new, gxg_pango_attr_scale_new_w, 1, 0, 0, H_pango_attr_scale_new, pl_pr);
+ Xg_define_procedure(pango_attr_list_new, gxg_pango_attr_list_new_w, 0, 0, 0, H_pango_attr_list_new, pl_p);
+ Xg_define_procedure(pango_attr_list_unref, gxg_pango_attr_list_unref_w, 1, 0, 0, H_pango_attr_list_unref, pl_tu);
+ Xg_define_procedure(pango_attr_list_copy, gxg_pango_attr_list_copy_w, 1, 0, 0, H_pango_attr_list_copy, pl_pu);
+ Xg_define_procedure(pango_attr_list_insert, gxg_pango_attr_list_insert_w, 2, 0, 0, H_pango_attr_list_insert, pl_tu);
+ Xg_define_procedure(pango_attr_list_insert_before, gxg_pango_attr_list_insert_before_w, 2, 0, 0, H_pango_attr_list_insert_before, pl_tu);
+ Xg_define_procedure(pango_attr_list_change, gxg_pango_attr_list_change_w, 2, 0, 0, H_pango_attr_list_change, pl_tu);
+ Xg_define_procedure(pango_attr_list_splice, gxg_pango_attr_list_splice_w, 4, 0, 0, H_pango_attr_list_splice, pl_tuui);
+ Xg_define_procedure(pango_attr_list_get_iterator, gxg_pango_attr_list_get_iterator_w, 1, 0, 0, H_pango_attr_list_get_iterator, pl_pu);
+ Xg_define_procedure(pango_attr_iterator_range, gxg_pango_attr_iterator_range_w, 1, 2, 0, H_pango_attr_iterator_range, pl_tu);
+ Xg_define_procedure(pango_attr_iterator_next, gxg_pango_attr_iterator_next_w, 1, 0, 0, H_pango_attr_iterator_next, pl_bu);
+ Xg_define_procedure(pango_attr_iterator_copy, gxg_pango_attr_iterator_copy_w, 1, 0, 0, H_pango_attr_iterator_copy, pl_pu);
+ Xg_define_procedure(pango_attr_iterator_destroy, gxg_pango_attr_iterator_destroy_w, 1, 0, 0, H_pango_attr_iterator_destroy, pl_tu);
+ Xg_define_procedure(pango_attr_iterator_get, gxg_pango_attr_iterator_get_w, 2, 0, 0, H_pango_attr_iterator_get, pl_pui);
+ Xg_define_procedure(pango_attr_iterator_get_font, gxg_pango_attr_iterator_get_font_w, 2, 2, 0, H_pango_attr_iterator_get_font, pl_tu);
+ Xg_define_procedure(pango_parse_markup, gxg_pango_parse_markup_w, 6, 1, 0, H_pango_parse_markup, pl_bsiiuusu);
+ Xg_define_procedure(pango_break, gxg_pango_break_w, 5, 0, 0, H_pango_break, pl_tsiuui);
+ Xg_define_procedure(pango_find_paragraph_boundary, gxg_pango_find_paragraph_boundary_w, 2, 2, 0, H_pango_find_paragraph_boundary, pl_tsiu);
+ Xg_define_procedure(pango_get_log_attrs, gxg_pango_get_log_attrs_w, 6, 0, 0, H_pango_get_log_attrs, pl_tsiiuui);
+ Xg_define_procedure(pango_context_list_families, gxg_pango_context_list_families_w, 1, 2, 0, H_pango_context_list_families, pl_tu);
+ Xg_define_procedure(pango_context_load_font, gxg_pango_context_load_font_w, 2, 0, 0, H_pango_context_load_font, pl_pu);
+ Xg_define_procedure(pango_context_load_fontset, gxg_pango_context_load_fontset_w, 3, 0, 0, H_pango_context_load_fontset, pl_pu);
+ Xg_define_procedure(pango_context_get_metrics, gxg_pango_context_get_metrics_w, 3, 0, 0, H_pango_context_get_metrics, pl_pu);
+ Xg_define_procedure(pango_context_set_font_description, gxg_pango_context_set_font_description_w, 2, 0, 0, H_pango_context_set_font_description, pl_tu);
+ Xg_define_procedure(pango_context_get_font_description, gxg_pango_context_get_font_description_w, 1, 0, 0, H_pango_context_get_font_description, pl_pu);
+ Xg_define_procedure(pango_context_get_language, gxg_pango_context_get_language_w, 1, 0, 0, H_pango_context_get_language, pl_pu);
+ Xg_define_procedure(pango_context_set_language, gxg_pango_context_set_language_w, 2, 0, 0, H_pango_context_set_language, pl_tu);
+ Xg_define_procedure(pango_context_set_base_dir, gxg_pango_context_set_base_dir_w, 2, 0, 0, H_pango_context_set_base_dir, pl_tui);
+ Xg_define_procedure(pango_context_get_base_dir, gxg_pango_context_get_base_dir_w, 1, 0, 0, H_pango_context_get_base_dir, pl_iu);
+ Xg_define_procedure(pango_itemize, gxg_pango_itemize_w, 6, 0, 0, H_pango_itemize, pl_pusiiu);
+ Xg_define_procedure(pango_coverage_new, gxg_pango_coverage_new_w, 0, 0, 0, H_pango_coverage_new, pl_p);
+ Xg_define_procedure(pango_coverage_ref, gxg_pango_coverage_ref_w, 1, 0, 0, H_pango_coverage_ref, pl_pu);
+ Xg_define_procedure(pango_coverage_unref, gxg_pango_coverage_unref_w, 1, 0, 0, H_pango_coverage_unref, pl_tu);
+ Xg_define_procedure(pango_coverage_copy, gxg_pango_coverage_copy_w, 1, 0, 0, H_pango_coverage_copy, pl_pu);
+ Xg_define_procedure(pango_coverage_get, gxg_pango_coverage_get_w, 2, 0, 0, H_pango_coverage_get, pl_iui);
+ Xg_define_procedure(pango_coverage_set, gxg_pango_coverage_set_w, 3, 0, 0, H_pango_coverage_set, pl_tui);
+ Xg_define_procedure(pango_coverage_max, gxg_pango_coverage_max_w, 2, 0, 0, H_pango_coverage_max, pl_tu);
+ Xg_define_procedure(pango_coverage_to_bytes, gxg_pango_coverage_to_bytes_w, 1, 2, 0, H_pango_coverage_to_bytes, pl_tu);
+ Xg_define_procedure(pango_coverage_from_bytes, gxg_pango_coverage_from_bytes_w, 2, 0, 0, H_pango_coverage_from_bytes, pl_psi);
+ Xg_define_procedure(pango_font_description_new, gxg_pango_font_description_new_w, 0, 0, 0, H_pango_font_description_new, pl_p);
+ Xg_define_procedure(pango_font_description_copy, gxg_pango_font_description_copy_w, 1, 0, 0, H_pango_font_description_copy, pl_pu);
+ Xg_define_procedure(pango_font_description_copy_static, gxg_pango_font_description_copy_static_w, 1, 0, 0, H_pango_font_description_copy_static, pl_pu);
+ Xg_define_procedure(pango_font_description_hash, gxg_pango_font_description_hash_w, 1, 0, 0, H_pango_font_description_hash, pl_iu);
+ Xg_define_procedure(pango_font_description_equal, gxg_pango_font_description_equal_w, 2, 0, 0, H_pango_font_description_equal, pl_bu);
+ Xg_define_procedure(pango_font_description_free, gxg_pango_font_description_free_w, 1, 0, 0, H_pango_font_description_free, pl_tu);
+ Xg_define_procedure(pango_font_descriptions_free, gxg_pango_font_descriptions_free_w, 2, 0, 0, H_pango_font_descriptions_free, pl_tui);
+ Xg_define_procedure(pango_font_description_set_family, gxg_pango_font_description_set_family_w, 2, 0, 0, H_pango_font_description_set_family, pl_tus);
+ Xg_define_procedure(pango_font_description_set_family_static, gxg_pango_font_description_set_family_static_w, 2, 0, 0, H_pango_font_description_set_family_static, pl_tus);
+ Xg_define_procedure(pango_font_description_get_family, gxg_pango_font_description_get_family_w, 1, 0, 0, H_pango_font_description_get_family, pl_su);
+ Xg_define_procedure(pango_font_description_set_style, gxg_pango_font_description_set_style_w, 2, 0, 0, H_pango_font_description_set_style, pl_tui);
+ Xg_define_procedure(pango_font_description_get_style, gxg_pango_font_description_get_style_w, 1, 0, 0, H_pango_font_description_get_style, pl_iu);
+ Xg_define_procedure(pango_font_description_set_variant, gxg_pango_font_description_set_variant_w, 2, 0, 0, H_pango_font_description_set_variant, pl_tui);
+ Xg_define_procedure(pango_font_description_get_variant, gxg_pango_font_description_get_variant_w, 1, 0, 0, H_pango_font_description_get_variant, pl_iu);
+ Xg_define_procedure(pango_font_description_set_weight, gxg_pango_font_description_set_weight_w, 2, 0, 0, H_pango_font_description_set_weight, pl_tui);
+ Xg_define_procedure(pango_font_description_get_weight, gxg_pango_font_description_get_weight_w, 1, 0, 0, H_pango_font_description_get_weight, pl_iu);
+ Xg_define_procedure(pango_font_description_set_stretch, gxg_pango_font_description_set_stretch_w, 2, 0, 0, H_pango_font_description_set_stretch, pl_tui);
+ Xg_define_procedure(pango_font_description_get_stretch, gxg_pango_font_description_get_stretch_w, 1, 0, 0, H_pango_font_description_get_stretch, pl_iu);
+ Xg_define_procedure(pango_font_description_set_size, gxg_pango_font_description_set_size_w, 2, 0, 0, H_pango_font_description_set_size, pl_tui);
+ Xg_define_procedure(pango_font_description_get_size, gxg_pango_font_description_get_size_w, 1, 0, 0, H_pango_font_description_get_size, pl_iu);
+ Xg_define_procedure(pango_font_description_get_set_fields, gxg_pango_font_description_get_set_fields_w, 1, 0, 0, H_pango_font_description_get_set_fields, pl_iu);
+ Xg_define_procedure(pango_font_description_unset_fields, gxg_pango_font_description_unset_fields_w, 2, 0, 0, H_pango_font_description_unset_fields, pl_tui);
+ Xg_define_procedure(pango_font_description_merge, gxg_pango_font_description_merge_w, 3, 0, 0, H_pango_font_description_merge, pl_tuub);
+ Xg_define_procedure(pango_font_description_merge_static, gxg_pango_font_description_merge_static_w, 3, 0, 0, H_pango_font_description_merge_static, pl_tuub);
+ Xg_define_procedure(pango_font_description_better_match, gxg_pango_font_description_better_match_w, 3, 0, 0, H_pango_font_description_better_match, pl_bu);
+ Xg_define_procedure(pango_font_description_from_string, gxg_pango_font_description_from_string_w, 1, 0, 0, H_pango_font_description_from_string, pl_ps);
+ Xg_define_procedure(pango_font_description_to_string, gxg_pango_font_description_to_string_w, 1, 0, 0, H_pango_font_description_to_string, pl_su);
+ Xg_define_procedure(pango_font_description_to_filename, gxg_pango_font_description_to_filename_w, 1, 0, 0, H_pango_font_description_to_filename, pl_su);
+ Xg_define_procedure(pango_font_metrics_ref, gxg_pango_font_metrics_ref_w, 1, 0, 0, H_pango_font_metrics_ref, pl_pu);
+ Xg_define_procedure(pango_font_metrics_unref, gxg_pango_font_metrics_unref_w, 1, 0, 0, H_pango_font_metrics_unref, pl_tu);
+ Xg_define_procedure(pango_font_metrics_get_ascent, gxg_pango_font_metrics_get_ascent_w, 1, 0, 0, H_pango_font_metrics_get_ascent, pl_iu);
+ Xg_define_procedure(pango_font_metrics_get_descent, gxg_pango_font_metrics_get_descent_w, 1, 0, 0, H_pango_font_metrics_get_descent, pl_iu);
+ Xg_define_procedure(pango_font_metrics_get_approximate_char_width, gxg_pango_font_metrics_get_approximate_char_width_w, 1, 0, 0, H_pango_font_metrics_get_approximate_char_width, pl_iu);
+ Xg_define_procedure(pango_font_metrics_get_approximate_digit_width, gxg_pango_font_metrics_get_approximate_digit_width_w, 1, 0, 0, H_pango_font_metrics_get_approximate_digit_width, pl_iu);
+ Xg_define_procedure(pango_font_family_list_faces, gxg_pango_font_family_list_faces_w, 1, 2, 0, H_pango_font_family_list_faces, pl_tu);
+ Xg_define_procedure(pango_font_family_get_name, gxg_pango_font_family_get_name_w, 1, 0, 0, H_pango_font_family_get_name, pl_su);
+ Xg_define_procedure(pango_font_face_describe, gxg_pango_font_face_describe_w, 1, 0, 0, H_pango_font_face_describe, pl_pu);
+ Xg_define_procedure(pango_font_face_get_face_name, gxg_pango_font_face_get_face_name_w, 1, 0, 0, H_pango_font_face_get_face_name, pl_su);
+ Xg_define_procedure(pango_font_describe, gxg_pango_font_describe_w, 1, 0, 0, H_pango_font_describe, pl_pu);
+ Xg_define_procedure(pango_font_get_coverage, gxg_pango_font_get_coverage_w, 2, 0, 0, H_pango_font_get_coverage, pl_pu);
+ Xg_define_procedure(pango_font_get_metrics, gxg_pango_font_get_metrics_w, 2, 0, 0, H_pango_font_get_metrics, pl_pu);
+ Xg_define_procedure(pango_font_get_glyph_extents, gxg_pango_font_get_glyph_extents_w, 4, 0, 0, H_pango_font_get_glyph_extents, pl_tuiu);
+ Xg_define_procedure(pango_font_map_load_font, gxg_pango_font_map_load_font_w, 3, 0, 0, H_pango_font_map_load_font, pl_pu);
+ Xg_define_procedure(pango_font_map_load_fontset, gxg_pango_font_map_load_fontset_w, 4, 0, 0, H_pango_font_map_load_fontset, pl_pu);
+ Xg_define_procedure(pango_font_map_list_families, gxg_pango_font_map_list_families_w, 1, 2, 0, H_pango_font_map_list_families, pl_tu);
+ Xg_define_procedure(pango_glyph_string_new, gxg_pango_glyph_string_new_w, 0, 0, 0, H_pango_glyph_string_new, pl_p);
+ Xg_define_procedure(pango_glyph_string_set_size, gxg_pango_glyph_string_set_size_w, 2, 0, 0, H_pango_glyph_string_set_size, pl_tui);
+ Xg_define_procedure(pango_glyph_string_copy, gxg_pango_glyph_string_copy_w, 1, 0, 0, H_pango_glyph_string_copy, pl_pu);
+ Xg_define_procedure(pango_glyph_string_free, gxg_pango_glyph_string_free_w, 1, 0, 0, H_pango_glyph_string_free, pl_tu);
+ Xg_define_procedure(pango_glyph_string_extents, gxg_pango_glyph_string_extents_w, 4, 0, 0, H_pango_glyph_string_extents, pl_tu);
+ Xg_define_procedure(pango_glyph_string_extents_range, gxg_pango_glyph_string_extents_range_w, 6, 0, 0, H_pango_glyph_string_extents_range, pl_tuiiu);
+ Xg_define_procedure(pango_glyph_string_get_logical_widths, gxg_pango_glyph_string_get_logical_widths_w, 4, 1, 0, H_pango_glyph_string_get_logical_widths, pl_tusiiu);
+ Xg_define_procedure(pango_glyph_string_index_to_x, gxg_pango_glyph_string_index_to_x_w, 6, 1, 0, H_pango_glyph_string_index_to_x, pl_tusiuibu);
+ Xg_define_procedure(pango_glyph_string_x_to_index, gxg_pango_glyph_string_x_to_index_w, 5, 2, 0, H_pango_glyph_string_x_to_index, pl_tusiuiu);
+ Xg_define_procedure(pango_shape, gxg_pango_shape_w, 4, 0, 0, H_pango_shape, pl_tsiu);
+ Xg_define_procedure(pango_reorder_items, gxg_pango_reorder_items_w, 1, 0, 0, H_pango_reorder_items, pl_pu);
+ Xg_define_procedure(pango_item_new, gxg_pango_item_new_w, 0, 0, 0, H_pango_item_new, pl_p);
+ Xg_define_procedure(pango_item_copy, gxg_pango_item_copy_w, 1, 0, 0, H_pango_item_copy, pl_pu);
+ Xg_define_procedure(pango_item_free, gxg_pango_item_free_w, 1, 0, 0, H_pango_item_free, pl_tu);
+ Xg_define_procedure(pango_item_split, gxg_pango_item_split_w, 3, 0, 0, H_pango_item_split, pl_pui);
+ Xg_define_procedure(pango_layout_new, gxg_pango_layout_new_w, 1, 0, 0, H_pango_layout_new, pl_pu);
+ Xg_define_procedure(pango_layout_copy, gxg_pango_layout_copy_w, 1, 0, 0, H_pango_layout_copy, pl_pu);
+ Xg_define_procedure(pango_layout_get_context, gxg_pango_layout_get_context_w, 1, 0, 0, H_pango_layout_get_context, pl_pu);
+ Xg_define_procedure(pango_layout_set_attributes, gxg_pango_layout_set_attributes_w, 2, 0, 0, H_pango_layout_set_attributes, pl_tu);
+ Xg_define_procedure(pango_layout_get_attributes, gxg_pango_layout_get_attributes_w, 1, 0, 0, H_pango_layout_get_attributes, pl_pu);
+ Xg_define_procedure(pango_layout_set_text, gxg_pango_layout_set_text_w, 3, 0, 0, H_pango_layout_set_text, pl_tusi);
+ Xg_define_procedure(pango_layout_get_text, gxg_pango_layout_get_text_w, 1, 0, 0, H_pango_layout_get_text, pl_su);
+ Xg_define_procedure(pango_layout_set_markup, gxg_pango_layout_set_markup_w, 3, 0, 0, H_pango_layout_set_markup, pl_tusi);
+ Xg_define_procedure(pango_layout_set_markup_with_accel, gxg_pango_layout_set_markup_with_accel_w, 5, 0, 0, H_pango_layout_set_markup_with_accel, pl_tusiis);
+ Xg_define_procedure(pango_layout_set_font_description, gxg_pango_layout_set_font_description_w, 2, 0, 0, H_pango_layout_set_font_description, pl_tu);
+ Xg_define_procedure(pango_layout_set_width, gxg_pango_layout_set_width_w, 2, 0, 0, H_pango_layout_set_width, pl_tui);
+ Xg_define_procedure(pango_layout_get_width, gxg_pango_layout_get_width_w, 1, 0, 0, H_pango_layout_get_width, pl_iu);
+ Xg_define_procedure(pango_layout_set_wrap, gxg_pango_layout_set_wrap_w, 2, 0, 0, H_pango_layout_set_wrap, pl_tui);
+ Xg_define_procedure(pango_layout_get_wrap, gxg_pango_layout_get_wrap_w, 1, 0, 0, H_pango_layout_get_wrap, pl_iu);
+ Xg_define_procedure(pango_layout_set_indent, gxg_pango_layout_set_indent_w, 2, 0, 0, H_pango_layout_set_indent, pl_tui);
+ Xg_define_procedure(pango_layout_get_indent, gxg_pango_layout_get_indent_w, 1, 0, 0, H_pango_layout_get_indent, pl_iu);
+ Xg_define_procedure(pango_layout_set_spacing, gxg_pango_layout_set_spacing_w, 2, 0, 0, H_pango_layout_set_spacing, pl_tui);
+ Xg_define_procedure(pango_layout_get_spacing, gxg_pango_layout_get_spacing_w, 1, 0, 0, H_pango_layout_get_spacing, pl_iu);
+ Xg_define_procedure(pango_layout_set_justify, gxg_pango_layout_set_justify_w, 2, 0, 0, H_pango_layout_set_justify, pl_tub);
+ Xg_define_procedure(pango_layout_get_justify, gxg_pango_layout_get_justify_w, 1, 0, 0, H_pango_layout_get_justify, pl_bu);
+ Xg_define_procedure(pango_layout_set_alignment, gxg_pango_layout_set_alignment_w, 2, 0, 0, H_pango_layout_set_alignment, pl_tui);
+ Xg_define_procedure(pango_layout_get_alignment, gxg_pango_layout_get_alignment_w, 1, 0, 0, H_pango_layout_get_alignment, pl_iu);
+ Xg_define_procedure(pango_layout_set_tabs, gxg_pango_layout_set_tabs_w, 2, 0, 0, H_pango_layout_set_tabs, pl_tu);
+ Xg_define_procedure(pango_layout_get_tabs, gxg_pango_layout_get_tabs_w, 1, 0, 0, H_pango_layout_get_tabs, pl_pu);
+ Xg_define_procedure(pango_layout_set_single_paragraph_mode, gxg_pango_layout_set_single_paragraph_mode_w, 2, 0, 0, H_pango_layout_set_single_paragraph_mode, pl_tub);
+ Xg_define_procedure(pango_layout_get_single_paragraph_mode, gxg_pango_layout_get_single_paragraph_mode_w, 1, 0, 0, H_pango_layout_get_single_paragraph_mode, pl_bu);
+ Xg_define_procedure(pango_layout_context_changed, gxg_pango_layout_context_changed_w, 1, 0, 0, H_pango_layout_context_changed, pl_tu);
+ Xg_define_procedure(pango_layout_get_log_attrs, gxg_pango_layout_get_log_attrs_w, 1, 2, 0, H_pango_layout_get_log_attrs, pl_tu);
+ Xg_define_procedure(pango_layout_index_to_pos, gxg_pango_layout_index_to_pos_w, 3, 0, 0, H_pango_layout_index_to_pos, pl_tuiu);
+ Xg_define_procedure(pango_layout_get_cursor_pos, gxg_pango_layout_get_cursor_pos_w, 4, 0, 0, H_pango_layout_get_cursor_pos, pl_tuiu);
+ Xg_define_procedure(pango_layout_move_cursor_visually, gxg_pango_layout_move_cursor_visually_w, 7, 0, 0, H_pango_layout_move_cursor_visually, pl_tubiiiu);
+ Xg_define_procedure(pango_layout_xy_to_index, gxg_pango_layout_xy_to_index_w, 3, 2, 0, H_pango_layout_xy_to_index, pl_buiiu);
+ Xg_define_procedure(pango_layout_get_extents, gxg_pango_layout_get_extents_w, 3, 0, 0, H_pango_layout_get_extents, pl_tu);
+ Xg_define_procedure(pango_layout_get_pixel_extents, gxg_pango_layout_get_pixel_extents_w, 3, 0, 0, H_pango_layout_get_pixel_extents, pl_tu);
+ Xg_define_procedure(pango_layout_get_size, gxg_pango_layout_get_size_w, 1, 2, 0, H_pango_layout_get_size, pl_tu);
+ Xg_define_procedure(pango_layout_get_pixel_size, gxg_pango_layout_get_pixel_size_w, 1, 2, 0, H_pango_layout_get_pixel_size, pl_tu);
+ Xg_define_procedure(pango_layout_get_line_count, gxg_pango_layout_get_line_count_w, 1, 0, 0, H_pango_layout_get_line_count, pl_iu);
+ Xg_define_procedure(pango_layout_get_line, gxg_pango_layout_get_line_w, 2, 0, 0, H_pango_layout_get_line, pl_pui);
+ Xg_define_procedure(pango_layout_get_lines, gxg_pango_layout_get_lines_w, 1, 0, 0, H_pango_layout_get_lines, pl_pu);
+ Xg_define_procedure(pango_layout_line_unref, gxg_pango_layout_line_unref_w, 1, 0, 0, H_pango_layout_line_unref, pl_tu);
+ Xg_define_procedure(pango_layout_line_x_to_index, gxg_pango_layout_line_x_to_index_w, 2, 2, 0, H_pango_layout_line_x_to_index, pl_buiu);
+ Xg_define_procedure(pango_layout_line_index_to_x, gxg_pango_layout_line_index_to_x_w, 3, 1, 0, H_pango_layout_line_index_to_x, pl_tuibu);
+ Xg_define_procedure(pango_layout_line_get_x_ranges, gxg_pango_layout_line_get_x_ranges_w, 3, 2, 0, H_pango_layout_line_get_x_ranges, pl_tuiiu);
+ Xg_define_procedure(pango_layout_line_get_extents, gxg_pango_layout_line_get_extents_w, 3, 0, 0, H_pango_layout_line_get_extents, pl_tu);
+ Xg_define_procedure(pango_layout_line_get_pixel_extents, gxg_pango_layout_line_get_pixel_extents_w, 3, 0, 0, H_pango_layout_line_get_pixel_extents, pl_tu);
+ Xg_define_procedure(pango_layout_get_iter, gxg_pango_layout_get_iter_w, 1, 0, 0, H_pango_layout_get_iter, pl_pu);
+ Xg_define_procedure(pango_layout_iter_free, gxg_pango_layout_iter_free_w, 1, 0, 0, H_pango_layout_iter_free, pl_tu);
+ Xg_define_procedure(pango_layout_iter_get_index, gxg_pango_layout_iter_get_index_w, 1, 0, 0, H_pango_layout_iter_get_index, pl_iu);
+ Xg_define_procedure(pango_layout_iter_get_run, gxg_pango_layout_iter_get_run_w, 1, 0, 0, H_pango_layout_iter_get_run, pl_pu);
+ Xg_define_procedure(pango_layout_iter_get_line, gxg_pango_layout_iter_get_line_w, 1, 0, 0, H_pango_layout_iter_get_line, pl_pu);
+ Xg_define_procedure(pango_layout_iter_at_last_line, gxg_pango_layout_iter_at_last_line_w, 1, 0, 0, H_pango_layout_iter_at_last_line, pl_bu);
+ Xg_define_procedure(pango_layout_iter_next_char, gxg_pango_layout_iter_next_char_w, 1, 0, 0, H_pango_layout_iter_next_char, pl_bu);
+ Xg_define_procedure(pango_layout_iter_next_cluster, gxg_pango_layout_iter_next_cluster_w, 1, 0, 0, H_pango_layout_iter_next_cluster, pl_bu);
+ Xg_define_procedure(pango_layout_iter_next_run, gxg_pango_layout_iter_next_run_w, 1, 0, 0, H_pango_layout_iter_next_run, pl_bu);
+ Xg_define_procedure(pango_layout_iter_next_line, gxg_pango_layout_iter_next_line_w, 1, 0, 0, H_pango_layout_iter_next_line, pl_bu);
+ Xg_define_procedure(pango_layout_iter_get_char_extents, gxg_pango_layout_iter_get_char_extents_w, 2, 0, 0, H_pango_layout_iter_get_char_extents, pl_tu);
+ Xg_define_procedure(pango_layout_iter_get_cluster_extents, gxg_pango_layout_iter_get_cluster_extents_w, 3, 0, 0, H_pango_layout_iter_get_cluster_extents, pl_tu);
+ Xg_define_procedure(pango_layout_iter_get_run_extents, gxg_pango_layout_iter_get_run_extents_w, 3, 0, 0, H_pango_layout_iter_get_run_extents, pl_tu);
+ Xg_define_procedure(pango_layout_iter_get_line_extents, gxg_pango_layout_iter_get_line_extents_w, 3, 0, 0, H_pango_layout_iter_get_line_extents, pl_tu);
+ Xg_define_procedure(pango_layout_iter_get_line_yrange, gxg_pango_layout_iter_get_line_yrange_w, 1, 2, 0, H_pango_layout_iter_get_line_yrange, pl_tu);
+ Xg_define_procedure(pango_layout_iter_get_layout_extents, gxg_pango_layout_iter_get_layout_extents_w, 3, 0, 0, H_pango_layout_iter_get_layout_extents, pl_tu);
+ Xg_define_procedure(pango_layout_iter_get_baseline, gxg_pango_layout_iter_get_baseline_w, 1, 0, 0, H_pango_layout_iter_get_baseline, pl_iu);
+ Xg_define_procedure(pango_language_from_string, gxg_pango_language_from_string_w, 1, 0, 0, H_pango_language_from_string, pl_ps);
+ Xg_define_procedure(pango_language_matches, gxg_pango_language_matches_w, 2, 0, 0, H_pango_language_matches, pl_bus);
+ Xg_define_procedure(G_OBJECT_TYPE, gxg_G_OBJECT_TYPE_w, 1, 0, 0, H_G_OBJECT_TYPE, pl_iu);
+ Xg_define_procedure(gtk_tree_model_get_string_from_iter, gxg_gtk_tree_model_get_string_from_iter_w, 2, 0, 0, H_gtk_tree_model_get_string_from_iter, pl_su);
+ Xg_define_procedure(gtk_tree_model_sort_iter_is_valid, gxg_gtk_tree_model_sort_iter_is_valid_w, 2, 0, 0, H_gtk_tree_model_sort_iter_is_valid, pl_bu);
+ Xg_define_procedure(gtk_tree_view_expand_to_path, gxg_gtk_tree_view_expand_to_path_w, 2, 0, 0, H_gtk_tree_view_expand_to_path, pl_tu);
+ Xg_define_procedure(gtk_tree_selection_get_selected_rows, gxg_gtk_tree_selection_get_selected_rows_w, 2, 0, 0, H_gtk_tree_selection_get_selected_rows, pl_pu);
+ Xg_define_procedure(gtk_tree_selection_count_selected_rows, gxg_gtk_tree_selection_count_selected_rows_w, 1, 0, 0, H_gtk_tree_selection_count_selected_rows, pl_iu);
+ Xg_define_procedure(gtk_menu_shell_select_first, gxg_gtk_menu_shell_select_first_w, 2, 0, 0, H_gtk_menu_shell_select_first, pl_tub);
+ Xg_define_procedure(gtk_notebook_get_n_pages, gxg_gtk_notebook_get_n_pages_w, 1, 0, 0, H_gtk_notebook_get_n_pages, pl_iu);
+ Xg_define_procedure(gtk_list_store_reorder, gxg_gtk_list_store_reorder_w, 2, 0, 0, H_gtk_list_store_reorder, pl_tu);
+ Xg_define_procedure(gtk_list_store_swap, gxg_gtk_list_store_swap_w, 3, 0, 0, H_gtk_list_store_swap, pl_tu);
+ Xg_define_procedure(gtk_list_store_move_after, gxg_gtk_list_store_move_after_w, 3, 0, 0, H_gtk_list_store_move_after, pl_tu);
+ Xg_define_procedure(gtk_list_store_move_before, gxg_gtk_list_store_move_before_w, 3, 0, 0, H_gtk_list_store_move_before, pl_tu);
+ Xg_define_procedure(gtk_tree_store_reorder, gxg_gtk_tree_store_reorder_w, 3, 0, 0, H_gtk_tree_store_reorder, pl_tu);
+ Xg_define_procedure(gtk_tree_store_swap, gxg_gtk_tree_store_swap_w, 3, 0, 0, H_gtk_tree_store_swap, pl_tu);
+ Xg_define_procedure(gdk_display_open, gxg_gdk_display_open_w, 1, 0, 0, H_gdk_display_open, pl_ps);
+ Xg_define_procedure(gdk_display_get_name, gxg_gdk_display_get_name_w, 1, 0, 0, H_gdk_display_get_name, pl_su);
+ Xg_define_procedure(gdk_display_get_screen, gxg_gdk_display_get_screen_w, 2, 0, 0, H_gdk_display_get_screen, pl_pui);
+ Xg_define_procedure(gdk_display_get_default_screen, gxg_gdk_display_get_default_screen_w, 1, 0, 0, H_gdk_display_get_default_screen, pl_pu);
+ Xg_define_procedure(gdk_display_beep, gxg_gdk_display_beep_w, 1, 0, 0, H_gdk_display_beep, pl_tu);
+ Xg_define_procedure(gdk_display_sync, gxg_gdk_display_sync_w, 1, 0, 0, H_gdk_display_sync, pl_tu);
+ Xg_define_procedure(gdk_display_close, gxg_gdk_display_close_w, 1, 0, 0, H_gdk_display_close, pl_tu);
+ Xg_define_procedure(gdk_display_get_event, gxg_gdk_display_get_event_w, 1, 0, 0, H_gdk_display_get_event, pl_pu);
+ Xg_define_procedure(gdk_display_peek_event, gxg_gdk_display_peek_event_w, 1, 0, 0, H_gdk_display_peek_event, pl_pu);
+ Xg_define_procedure(gdk_display_put_event, gxg_gdk_display_put_event_w, 2, 0, 0, H_gdk_display_put_event, pl_tu);
+ Xg_define_procedure(gdk_display_set_double_click_time, gxg_gdk_display_set_double_click_time_w, 2, 0, 0, H_gdk_display_set_double_click_time, pl_tui);
+ Xg_define_procedure(gdk_display_get_default, gxg_gdk_display_get_default_w, 0, 0, 0, H_gdk_display_get_default, pl_p);
+ Xg_define_procedure(gdk_screen_get_system_visual, gxg_gdk_screen_get_system_visual_w, 1, 0, 0, H_gdk_screen_get_system_visual, pl_pu);
+ Xg_define_procedure(gdk_screen_get_root_window, gxg_gdk_screen_get_root_window_w, 1, 0, 0, H_gdk_screen_get_root_window, pl_pu);
+ Xg_define_procedure(gdk_screen_get_display, gxg_gdk_screen_get_display_w, 1, 0, 0, H_gdk_screen_get_display, pl_pu);
+ Xg_define_procedure(gdk_screen_get_number, gxg_gdk_screen_get_number_w, 1, 0, 0, H_gdk_screen_get_number, pl_iu);
+ Xg_define_procedure(gdk_screen_get_width, gxg_gdk_screen_get_width_w, 1, 0, 0, H_gdk_screen_get_width, pl_iu);
+ Xg_define_procedure(gdk_screen_get_height, gxg_gdk_screen_get_height_w, 1, 0, 0, H_gdk_screen_get_height, pl_iu);
+ Xg_define_procedure(gdk_screen_get_width_mm, gxg_gdk_screen_get_width_mm_w, 1, 0, 0, H_gdk_screen_get_width_mm, pl_iu);
+ Xg_define_procedure(gdk_screen_get_height_mm, gxg_gdk_screen_get_height_mm_w, 1, 0, 0, H_gdk_screen_get_height_mm, pl_iu);
+ Xg_define_procedure(gdk_screen_list_visuals, gxg_gdk_screen_list_visuals_w, 1, 0, 0, H_gdk_screen_list_visuals, pl_pu);
+ Xg_define_procedure(gdk_screen_get_toplevel_windows, gxg_gdk_screen_get_toplevel_windows_w, 1, 0, 0, H_gdk_screen_get_toplevel_windows, pl_pu);
+ Xg_define_procedure(gdk_screen_make_display_name, gxg_gdk_screen_make_display_name_w, 1, 0, 0, H_gdk_screen_make_display_name, pl_su);
+ Xg_define_procedure(gdk_screen_get_n_monitors, gxg_gdk_screen_get_n_monitors_w, 1, 0, 0, H_gdk_screen_get_n_monitors, pl_iu);
+ Xg_define_procedure(gdk_screen_get_monitor_geometry, gxg_gdk_screen_get_monitor_geometry_w, 3, 0, 0, H_gdk_screen_get_monitor_geometry, pl_tuiu);
+ Xg_define_procedure(gdk_screen_get_monitor_at_point, gxg_gdk_screen_get_monitor_at_point_w, 3, 0, 0, H_gdk_screen_get_monitor_at_point, pl_iui);
+ Xg_define_procedure(gdk_screen_get_monitor_at_window, gxg_gdk_screen_get_monitor_at_window_w, 2, 0, 0, H_gdk_screen_get_monitor_at_window, pl_iu);
+ Xg_define_procedure(gdk_screen_get_default, gxg_gdk_screen_get_default_w, 0, 0, 0, H_gdk_screen_get_default, pl_p);
+ Xg_define_procedure(gtk_clipboard_get_for_display, gxg_gtk_clipboard_get_for_display_w, 2, 0, 0, H_gtk_clipboard_get_for_display, pl_put);
+ Xg_define_procedure(gtk_clipboard_get_display, gxg_gtk_clipboard_get_display_w, 1, 0, 0, H_gtk_clipboard_get_display, pl_pu);
+ Xg_define_procedure(gtk_widget_get_screen, gxg_gtk_widget_get_screen_w, 1, 0, 0, H_gtk_widget_get_screen, pl_pu);
+ Xg_define_procedure(gtk_widget_has_screen, gxg_gtk_widget_has_screen_w, 1, 0, 0, H_gtk_widget_has_screen, pl_bu);
+ Xg_define_procedure(gtk_widget_get_display, gxg_gtk_widget_get_display_w, 1, 0, 0, H_gtk_widget_get_display, pl_pu);
+ Xg_define_procedure(gtk_widget_get_clipboard, gxg_gtk_widget_get_clipboard_w, 2, 0, 0, H_gtk_widget_get_clipboard, pl_put);
+ Xg_define_procedure(g_list_free, gxg_g_list_free_w, 1, 0, 0, H_g_list_free, pl_tu);
+ Xg_define_procedure(g_list_reverse, gxg_g_list_reverse_w, 1, 0, 0, H_g_list_reverse, pl_pu);
+ Xg_define_procedure(g_list_copy, gxg_g_list_copy_w, 1, 0, 0, H_g_list_copy, pl_pu);
+ Xg_define_procedure(g_list_last, gxg_g_list_last_w, 1, 0, 0, H_g_list_last, pl_pu);
+ Xg_define_procedure(g_list_first, gxg_g_list_first_w, 1, 0, 0, H_g_list_first, pl_pu);
+ Xg_define_procedure(g_list_length, gxg_g_list_length_w, 1, 0, 0, H_g_list_length, pl_iu);
+ Xg_define_procedure(g_free, gxg_g_free_w, 1, 0, 0, H_g_free, pl_t);
+ Xg_define_procedure(g_list_remove_link, gxg_g_list_remove_link_w, 2, 0, 0, H_g_list_remove_link, pl_pu);
+ Xg_define_procedure(g_object_get_data, gxg_g_object_get_data_w, 2, 0, 0, H_g_object_get_data, pl_tus);
+ Xg_define_procedure(g_object_set_data, gxg_g_object_set_data_w, 3, 0, 0, H_g_object_set_data, pl_tust);
+ Xg_define_procedure(gdk_cursor_new_from_pixbuf, gxg_gdk_cursor_new_from_pixbuf_w, 4, 0, 0, H_gdk_cursor_new_from_pixbuf, pl_puui);
+ Xg_define_procedure(gdk_display_flush, gxg_gdk_display_flush_w, 1, 0, 0, H_gdk_display_flush, pl_tu);
+ Xg_define_procedure(gdk_display_supports_cursor_alpha, gxg_gdk_display_supports_cursor_alpha_w, 1, 0, 0, H_gdk_display_supports_cursor_alpha, pl_bu);
+ Xg_define_procedure(gdk_display_supports_cursor_color, gxg_gdk_display_supports_cursor_color_w, 1, 0, 0, H_gdk_display_supports_cursor_color, pl_bu);
+ Xg_define_procedure(gdk_display_get_default_cursor_size, gxg_gdk_display_get_default_cursor_size_w, 1, 0, 0, H_gdk_display_get_default_cursor_size, pl_iu);
+ Xg_define_procedure(gdk_display_get_maximal_cursor_size, gxg_gdk_display_get_maximal_cursor_size_w, 1, 2, 0, H_gdk_display_get_maximal_cursor_size, pl_tu);
+ Xg_define_procedure(gdk_window_set_keep_above, gxg_gdk_window_set_keep_above_w, 2, 0, 0, H_gdk_window_set_keep_above, pl_tub);
+ Xg_define_procedure(gdk_window_set_keep_below, gxg_gdk_window_set_keep_below_w, 2, 0, 0, H_gdk_window_set_keep_below, pl_tub);
+ Xg_define_procedure(gtk_button_box_get_child_secondary, gxg_gtk_button_box_get_child_secondary_w, 2, 0, 0, H_gtk_button_box_get_child_secondary, pl_bu);
+ Xg_define_procedure(gtk_calendar_set_display_options, gxg_gtk_calendar_set_display_options_w, 2, 0, 0, H_gtk_calendar_set_display_options, pl_tui);
+ Xg_define_procedure(gtk_calendar_get_display_options, gxg_gtk_calendar_get_display_options_w, 1, 0, 0, H_gtk_calendar_get_display_options, pl_iu);
+ Xg_define_procedure(gtk_check_menu_item_set_draw_as_radio, gxg_gtk_check_menu_item_set_draw_as_radio_w, 2, 0, 0, H_gtk_check_menu_item_set_draw_as_radio, pl_tub);
+ Xg_define_procedure(gtk_check_menu_item_get_draw_as_radio, gxg_gtk_check_menu_item_get_draw_as_radio_w, 1, 0, 0, H_gtk_check_menu_item_get_draw_as_radio, pl_bu);
+ Xg_define_procedure(gtk_entry_set_completion, gxg_gtk_entry_set_completion_w, 2, 0, 0, H_gtk_entry_set_completion, pl_tu);
+ Xg_define_procedure(gtk_entry_get_completion, gxg_gtk_entry_get_completion_w, 1, 0, 0, H_gtk_entry_get_completion, pl_pu);
+ Xg_define_procedure(gtk_event_box_get_visible_window, gxg_gtk_event_box_get_visible_window_w, 1, 0, 0, H_gtk_event_box_get_visible_window, pl_bu);
+ Xg_define_procedure(gtk_event_box_set_visible_window, gxg_gtk_event_box_set_visible_window_w, 2, 0, 0, H_gtk_event_box_set_visible_window, pl_tub);
+ Xg_define_procedure(gtk_event_box_get_above_child, gxg_gtk_event_box_get_above_child_w, 1, 0, 0, H_gtk_event_box_get_above_child, pl_bu);
+ Xg_define_procedure(gtk_event_box_set_above_child, gxg_gtk_event_box_set_above_child_w, 2, 0, 0, H_gtk_event_box_set_above_child, pl_tub);
+ Xg_define_procedure(gtk_menu_attach, gxg_gtk_menu_attach_w, 6, 0, 0, H_gtk_menu_attach, pl_tuui);
+ Xg_define_procedure(gtk_text_buffer_select_range, gxg_gtk_text_buffer_select_range_w, 3, 0, 0, H_gtk_text_buffer_select_range, pl_tu);
+ Xg_define_procedure(gtk_text_view_set_overwrite, gxg_gtk_text_view_set_overwrite_w, 2, 0, 0, H_gtk_text_view_set_overwrite, pl_tub);
+ Xg_define_procedure(gtk_text_view_get_overwrite, gxg_gtk_text_view_get_overwrite_w, 1, 0, 0, H_gtk_text_view_get_overwrite, pl_bu);
+ Xg_define_procedure(gtk_text_view_set_accepts_tab, gxg_gtk_text_view_set_accepts_tab_w, 2, 0, 0, H_gtk_text_view_set_accepts_tab, pl_tub);
+ Xg_define_procedure(gtk_text_view_get_accepts_tab, gxg_gtk_text_view_get_accepts_tab_w, 1, 0, 0, H_gtk_text_view_get_accepts_tab, pl_bu);
+ Xg_define_procedure(gtk_toolbar_insert, gxg_gtk_toolbar_insert_w, 3, 0, 0, H_gtk_toolbar_insert, pl_tuui);
+ Xg_define_procedure(gtk_toolbar_get_item_index, gxg_gtk_toolbar_get_item_index_w, 2, 0, 0, H_gtk_toolbar_get_item_index, pl_iu);
+ Xg_define_procedure(gtk_toolbar_get_n_items, gxg_gtk_toolbar_get_n_items_w, 1, 0, 0, H_gtk_toolbar_get_n_items, pl_iu);
+ Xg_define_procedure(gtk_toolbar_get_nth_item, gxg_gtk_toolbar_get_nth_item_w, 2, 0, 0, H_gtk_toolbar_get_nth_item, pl_pui);
+ Xg_define_procedure(gtk_toolbar_set_show_arrow, gxg_gtk_toolbar_set_show_arrow_w, 2, 0, 0, H_gtk_toolbar_set_show_arrow, pl_tub);
+ Xg_define_procedure(gtk_toolbar_get_show_arrow, gxg_gtk_toolbar_get_show_arrow_w, 1, 0, 0, H_gtk_toolbar_get_show_arrow, pl_bu);
+ Xg_define_procedure(gtk_toolbar_get_relief_style, gxg_gtk_toolbar_get_relief_style_w, 1, 0, 0, H_gtk_toolbar_get_relief_style, pl_iu);
+ Xg_define_procedure(gtk_toolbar_get_drop_index, gxg_gtk_toolbar_get_drop_index_w, 3, 0, 0, H_gtk_toolbar_get_drop_index, pl_iui);
+ Xg_define_procedure(gtk_tree_view_column_set_expand, gxg_gtk_tree_view_column_set_expand_w, 2, 0, 0, H_gtk_tree_view_column_set_expand, pl_tub);
+ Xg_define_procedure(gtk_tree_view_column_get_expand, gxg_gtk_tree_view_column_get_expand_w, 1, 0, 0, H_gtk_tree_view_column_get_expand, pl_bu);
+ Xg_define_procedure(gtk_widget_set_no_show_all, gxg_gtk_widget_set_no_show_all_w, 2, 0, 0, H_gtk_widget_set_no_show_all, pl_tub);
+ Xg_define_procedure(gtk_widget_get_no_show_all, gxg_gtk_widget_get_no_show_all_w, 1, 0, 0, H_gtk_widget_get_no_show_all, pl_bu);
+ Xg_define_procedure(gtk_widget_queue_resize_no_redraw, gxg_gtk_widget_queue_resize_no_redraw_w, 1, 0, 0, H_gtk_widget_queue_resize_no_redraw, pl_tu);
+ Xg_define_procedure(gtk_window_set_default_icon, gxg_gtk_window_set_default_icon_w, 1, 0, 0, H_gtk_window_set_default_icon, pl_tu);
+ Xg_define_procedure(gtk_window_set_keep_above, gxg_gtk_window_set_keep_above_w, 2, 0, 0, H_gtk_window_set_keep_above, pl_tub);
+ Xg_define_procedure(gtk_window_set_keep_below, gxg_gtk_window_set_keep_below_w, 2, 0, 0, H_gtk_window_set_keep_below, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_dialog_new, gxg_gtk_file_chooser_dialog_new_w, 3, 1, 0, H_gtk_file_chooser_dialog_new, pl_psuit);
+ Xg_define_procedure(gtk_file_chooser_widget_new, gxg_gtk_file_chooser_widget_new_w, 1, 0, 0, H_gtk_file_chooser_widget_new, pl_pi);
+ Xg_define_procedure(gtk_tree_model_filter_new, gxg_gtk_tree_model_filter_new_w, 2, 0, 0, H_gtk_tree_model_filter_new, pl_pu);
+ Xg_define_procedure(gtk_tree_model_filter_set_visible_column, gxg_gtk_tree_model_filter_set_visible_column_w, 2, 0, 0, H_gtk_tree_model_filter_set_visible_column, pl_tui);
+ Xg_define_procedure(gtk_tree_model_filter_get_model, gxg_gtk_tree_model_filter_get_model_w, 1, 0, 0, H_gtk_tree_model_filter_get_model, pl_pu);
+ Xg_define_procedure(gtk_tree_model_filter_convert_iter_to_child_iter, gxg_gtk_tree_model_filter_convert_iter_to_child_iter_w, 3, 0, 0, H_gtk_tree_model_filter_convert_iter_to_child_iter, pl_tu);
+ Xg_define_procedure(gtk_tree_model_filter_convert_child_path_to_path, gxg_gtk_tree_model_filter_convert_child_path_to_path_w, 2, 0, 0, H_gtk_tree_model_filter_convert_child_path_to_path, pl_pu);
+ Xg_define_procedure(gtk_tree_model_filter_convert_path_to_child_path, gxg_gtk_tree_model_filter_convert_path_to_child_path_w, 2, 0, 0, H_gtk_tree_model_filter_convert_path_to_child_path, pl_pu);
+ Xg_define_procedure(gtk_tree_model_filter_refilter, gxg_gtk_tree_model_filter_refilter_w, 1, 0, 0, H_gtk_tree_model_filter_refilter, pl_tu);
+ Xg_define_procedure(gtk_tree_model_filter_clear_cache, gxg_gtk_tree_model_filter_clear_cache_w, 1, 0, 0, H_gtk_tree_model_filter_clear_cache, pl_tu);
+ Xg_define_procedure(gtk_combo_box_new, gxg_gtk_combo_box_new_w, 0, 0, 0, H_gtk_combo_box_new, pl_p);
+ Xg_define_procedure(gtk_combo_box_new_with_model, gxg_gtk_combo_box_new_with_model_w, 1, 0, 0, H_gtk_combo_box_new_with_model, pl_pu);
+ Xg_define_procedure(gtk_combo_box_set_model, gxg_gtk_combo_box_set_model_w, 2, 0, 0, H_gtk_combo_box_set_model, pl_tu);
+ Xg_define_procedure(gtk_combo_box_set_wrap_width, gxg_gtk_combo_box_set_wrap_width_w, 2, 0, 0, H_gtk_combo_box_set_wrap_width, pl_tui);
+ Xg_define_procedure(gtk_combo_box_set_row_span_column, gxg_gtk_combo_box_set_row_span_column_w, 2, 0, 0, H_gtk_combo_box_set_row_span_column, pl_tui);
+ Xg_define_procedure(gtk_combo_box_set_column_span_column, gxg_gtk_combo_box_set_column_span_column_w, 2, 0, 0, H_gtk_combo_box_set_column_span_column, pl_tui);
+ Xg_define_procedure(gtk_combo_box_get_active, gxg_gtk_combo_box_get_active_w, 1, 0, 0, H_gtk_combo_box_get_active, pl_iu);
+ Xg_define_procedure(gtk_combo_box_set_active, gxg_gtk_combo_box_set_active_w, 2, 0, 0, H_gtk_combo_box_set_active, pl_tui);
+ Xg_define_procedure(gtk_combo_box_get_active_iter, gxg_gtk_combo_box_get_active_iter_w, 2, 0, 0, H_gtk_combo_box_get_active_iter, pl_bu);
+ Xg_define_procedure(gtk_combo_box_set_active_iter, gxg_gtk_combo_box_set_active_iter_w, 2, 0, 0, H_gtk_combo_box_set_active_iter, pl_tu);
+ Xg_define_procedure(gtk_combo_box_get_model, gxg_gtk_combo_box_get_model_w, 1, 0, 0, H_gtk_combo_box_get_model, pl_pu);
+ Xg_define_procedure(gtk_expander_new, gxg_gtk_expander_new_w, 1, 0, 0, H_gtk_expander_new, pl_ps);
+ Xg_define_procedure(gtk_expander_new_with_mnemonic, gxg_gtk_expander_new_with_mnemonic_w, 1, 0, 0, H_gtk_expander_new_with_mnemonic, pl_ps);
+ Xg_define_procedure(gtk_expander_set_expanded, gxg_gtk_expander_set_expanded_w, 2, 0, 0, H_gtk_expander_set_expanded, pl_tub);
+ Xg_define_procedure(gtk_expander_get_expanded, gxg_gtk_expander_get_expanded_w, 1, 0, 0, H_gtk_expander_get_expanded, pl_bu);
+ Xg_define_procedure(gtk_expander_set_spacing, gxg_gtk_expander_set_spacing_w, 2, 0, 0, H_gtk_expander_set_spacing, pl_tui);
+ Xg_define_procedure(gtk_expander_get_spacing, gxg_gtk_expander_get_spacing_w, 1, 0, 0, H_gtk_expander_get_spacing, pl_iu);
+ Xg_define_procedure(gtk_expander_set_label, gxg_gtk_expander_set_label_w, 2, 0, 0, H_gtk_expander_set_label, pl_tus);
+ Xg_define_procedure(gtk_expander_get_label, gxg_gtk_expander_get_label_w, 1, 0, 0, H_gtk_expander_get_label, pl_su);
+ Xg_define_procedure(gtk_expander_set_use_underline, gxg_gtk_expander_set_use_underline_w, 2, 0, 0, H_gtk_expander_set_use_underline, pl_tub);
+ Xg_define_procedure(gtk_expander_get_use_underline, gxg_gtk_expander_get_use_underline_w, 1, 0, 0, H_gtk_expander_get_use_underline, pl_bu);
+ Xg_define_procedure(gtk_expander_set_label_widget, gxg_gtk_expander_set_label_widget_w, 2, 0, 0, H_gtk_expander_set_label_widget, pl_tu);
+ Xg_define_procedure(gtk_expander_get_label_widget, gxg_gtk_expander_get_label_widget_w, 1, 0, 0, H_gtk_expander_get_label_widget, pl_pu);
+ Xg_define_procedure(gtk_expander_set_use_markup, gxg_gtk_expander_set_use_markup_w, 2, 0, 0, H_gtk_expander_set_use_markup, pl_tub);
+ Xg_define_procedure(gtk_expander_get_use_markup, gxg_gtk_expander_get_use_markup_w, 1, 0, 0, H_gtk_expander_get_use_markup, pl_bu);
+ Xg_define_procedure(gtk_font_button_new, gxg_gtk_font_button_new_w, 0, 0, 0, H_gtk_font_button_new, pl_p);
+ Xg_define_procedure(gtk_font_button_new_with_font, gxg_gtk_font_button_new_with_font_w, 1, 0, 0, H_gtk_font_button_new_with_font, pl_ps);
+ Xg_define_procedure(gtk_font_button_get_title, gxg_gtk_font_button_get_title_w, 1, 0, 0, H_gtk_font_button_get_title, pl_su);
+ Xg_define_procedure(gtk_font_button_set_title, gxg_gtk_font_button_set_title_w, 2, 0, 0, H_gtk_font_button_set_title, pl_tus);
+ Xg_define_procedure(gtk_font_button_get_use_font, gxg_gtk_font_button_get_use_font_w, 1, 0, 0, H_gtk_font_button_get_use_font, pl_bu);
+ Xg_define_procedure(gtk_font_button_set_use_font, gxg_gtk_font_button_set_use_font_w, 2, 0, 0, H_gtk_font_button_set_use_font, pl_tub);
+ Xg_define_procedure(gtk_font_button_get_use_size, gxg_gtk_font_button_get_use_size_w, 1, 0, 0, H_gtk_font_button_get_use_size, pl_bu);
+ Xg_define_procedure(gtk_font_button_set_use_size, gxg_gtk_font_button_set_use_size_w, 2, 0, 0, H_gtk_font_button_set_use_size, pl_tub);
+ Xg_define_procedure(gtk_font_button_get_font_name, gxg_gtk_font_button_get_font_name_w, 1, 0, 0, H_gtk_font_button_get_font_name, pl_su);
+ Xg_define_procedure(gtk_font_button_set_font_name, gxg_gtk_font_button_set_font_name_w, 2, 0, 0, H_gtk_font_button_set_font_name, pl_bus);
+ Xg_define_procedure(gtk_font_button_get_show_style, gxg_gtk_font_button_get_show_style_w, 1, 0, 0, H_gtk_font_button_get_show_style, pl_bu);
+ Xg_define_procedure(gtk_font_button_set_show_style, gxg_gtk_font_button_set_show_style_w, 2, 0, 0, H_gtk_font_button_set_show_style, pl_tub);
+ Xg_define_procedure(gtk_font_button_get_show_size, gxg_gtk_font_button_get_show_size_w, 1, 0, 0, H_gtk_font_button_get_show_size, pl_bu);
+ Xg_define_procedure(gtk_font_button_set_show_size, gxg_gtk_font_button_set_show_size_w, 2, 0, 0, H_gtk_font_button_set_show_size, pl_tub);
+ Xg_define_procedure(gtk_entry_completion_new, gxg_gtk_entry_completion_new_w, 0, 0, 0, H_gtk_entry_completion_new, pl_p);
+ Xg_define_procedure(gtk_entry_completion_get_entry, gxg_gtk_entry_completion_get_entry_w, 1, 0, 0, H_gtk_entry_completion_get_entry, pl_pu);
+ Xg_define_procedure(gtk_entry_completion_set_model, gxg_gtk_entry_completion_set_model_w, 2, 0, 0, H_gtk_entry_completion_set_model, pl_tu);
+ Xg_define_procedure(gtk_entry_completion_get_model, gxg_gtk_entry_completion_get_model_w, 1, 0, 0, H_gtk_entry_completion_get_model, pl_pu);
+ Xg_define_procedure(gtk_entry_completion_set_match_func, gxg_gtk_entry_completion_set_match_func_w, 4, 0, 0, H_gtk_entry_completion_set_match_func, pl_tut);
+ Xg_define_procedure(gtk_entry_completion_set_minimum_key_length, gxg_gtk_entry_completion_set_minimum_key_length_w, 2, 0, 0, H_gtk_entry_completion_set_minimum_key_length, pl_tui);
+ Xg_define_procedure(gtk_entry_completion_get_minimum_key_length, gxg_gtk_entry_completion_get_minimum_key_length_w, 1, 0, 0, H_gtk_entry_completion_get_minimum_key_length, pl_iu);
+ Xg_define_procedure(gtk_entry_completion_complete, gxg_gtk_entry_completion_complete_w, 1, 0, 0, H_gtk_entry_completion_complete, pl_tu);
+ Xg_define_procedure(gtk_entry_completion_insert_action_text, gxg_gtk_entry_completion_insert_action_text_w, 3, 0, 0, H_gtk_entry_completion_insert_action_text, pl_tuis);
+ Xg_define_procedure(gtk_entry_completion_insert_action_markup, gxg_gtk_entry_completion_insert_action_markup_w, 3, 0, 0, H_gtk_entry_completion_insert_action_markup, pl_tuis);
+ Xg_define_procedure(gtk_entry_completion_delete_action, gxg_gtk_entry_completion_delete_action_w, 2, 0, 0, H_gtk_entry_completion_delete_action, pl_tui);
+ Xg_define_procedure(gtk_entry_completion_set_text_column, gxg_gtk_entry_completion_set_text_column_w, 2, 0, 0, H_gtk_entry_completion_set_text_column, pl_tui);
+ Xg_define_procedure(gtk_radio_tool_button_new, gxg_gtk_radio_tool_button_new_w, 1, 0, 0, H_gtk_radio_tool_button_new, pl_pu);
+ Xg_define_procedure(gtk_radio_tool_button_new_from_widget, gxg_gtk_radio_tool_button_new_from_widget_w, 1, 0, 0, H_gtk_radio_tool_button_new_from_widget, pl_pu);
+ Xg_define_procedure(gtk_radio_tool_button_get_group, gxg_gtk_radio_tool_button_get_group_w, 1, 0, 0, H_gtk_radio_tool_button_get_group, pl_pu);
+ Xg_define_procedure(gtk_radio_tool_button_set_group, gxg_gtk_radio_tool_button_set_group_w, 2, 0, 0, H_gtk_radio_tool_button_set_group, pl_tu);
+ Xg_define_procedure(gtk_separator_tool_item_new, gxg_gtk_separator_tool_item_new_w, 0, 0, 0, H_gtk_separator_tool_item_new, pl_p);
+ Xg_define_procedure(gtk_separator_tool_item_get_draw, gxg_gtk_separator_tool_item_get_draw_w, 1, 0, 0, H_gtk_separator_tool_item_get_draw, pl_bu);
+ Xg_define_procedure(gtk_separator_tool_item_set_draw, gxg_gtk_separator_tool_item_set_draw_w, 2, 0, 0, H_gtk_separator_tool_item_set_draw, pl_tub);
+ Xg_define_procedure(gtk_toggle_tool_button_new, gxg_gtk_toggle_tool_button_new_w, 0, 0, 0, H_gtk_toggle_tool_button_new, pl_p);
+ Xg_define_procedure(gtk_toggle_tool_button_set_active, gxg_gtk_toggle_tool_button_set_active_w, 2, 0, 0, H_gtk_toggle_tool_button_set_active, pl_tub);
+ Xg_define_procedure(gtk_toggle_tool_button_get_active, gxg_gtk_toggle_tool_button_get_active_w, 1, 0, 0, H_gtk_toggle_tool_button_get_active, pl_bu);
+ Xg_define_procedure(g_timeout_add_full, gxg_g_timeout_add_full_w, 5, 0, 0, H_g_timeout_add_full, pl_iiit);
+ Xg_define_procedure(g_timeout_add, gxg_g_timeout_add_w, 2, 1, 0, H_g_timeout_add, pl_iit);
+ Xg_define_procedure(g_idle_add, gxg_g_idle_add_w, 1, 1, 0, H_g_idle_add, pl_it);
+ Xg_define_procedure(g_idle_add_full, gxg_g_idle_add_full_w, 4, 0, 0, H_g_idle_add_full, pl_iit);
+ Xg_define_procedure(g_idle_remove_by_data, gxg_g_idle_remove_by_data_w, 1, 0, 0, H_g_idle_remove_by_data, pl_bt);
+ Xg_define_procedure(g_source_remove, gxg_g_source_remove_w, 1, 0, 0, H_g_source_remove, pl_bi);
+ Xg_define_procedure(gtk_file_filter_new, gxg_gtk_file_filter_new_w, 0, 0, 0, H_gtk_file_filter_new, pl_p);
+ Xg_define_procedure(gtk_file_filter_set_name, gxg_gtk_file_filter_set_name_w, 2, 0, 0, H_gtk_file_filter_set_name, pl_tus);
+ Xg_define_procedure(gtk_file_filter_get_name, gxg_gtk_file_filter_get_name_w, 1, 0, 0, H_gtk_file_filter_get_name, pl_su);
+ Xg_define_procedure(gtk_file_filter_add_mime_type, gxg_gtk_file_filter_add_mime_type_w, 2, 0, 0, H_gtk_file_filter_add_mime_type, pl_tus);
+ Xg_define_procedure(gtk_file_filter_add_pattern, gxg_gtk_file_filter_add_pattern_w, 2, 0, 0, H_gtk_file_filter_add_pattern, pl_tus);
+ Xg_define_procedure(gtk_file_filter_add_custom, gxg_gtk_file_filter_add_custom_w, 5, 0, 0, H_gtk_file_filter_add_custom, pl_tuit);
+ Xg_define_procedure(gtk_file_filter_get_needed, gxg_gtk_file_filter_get_needed_w, 1, 0, 0, H_gtk_file_filter_get_needed, pl_iu);
+ Xg_define_procedure(gtk_file_filter_filter, gxg_gtk_file_filter_filter_w, 2, 0, 0, H_gtk_file_filter_filter, pl_bu);
+ Xg_define_procedure(gtk_cell_layout_pack_start, gxg_gtk_cell_layout_pack_start_w, 3, 0, 0, H_gtk_cell_layout_pack_start, pl_tuub);
+ Xg_define_procedure(gtk_cell_layout_pack_end, gxg_gtk_cell_layout_pack_end_w, 3, 0, 0, H_gtk_cell_layout_pack_end, pl_tuub);
+ Xg_define_procedure(gtk_cell_layout_clear, gxg_gtk_cell_layout_clear_w, 1, 0, 0, H_gtk_cell_layout_clear, pl_tu);
+ Xg_define_procedure(gtk_cell_layout_set_attributes, gxg_gtk_cell_layout_set_attributes_w, 3, 0, 0, H_gtk_cell_layout_set_attributes, pl_tuut);
+ Xg_define_procedure(gtk_cell_layout_add_attribute, gxg_gtk_cell_layout_add_attribute_w, 4, 0, 0, H_gtk_cell_layout_add_attribute, pl_tuusi);
+ Xg_define_procedure(gtk_cell_layout_set_cell_data_func, gxg_gtk_cell_layout_set_cell_data_func_w, 5, 0, 0, H_gtk_cell_layout_set_cell_data_func, pl_tuut);
+ Xg_define_procedure(gtk_cell_layout_clear_attributes, gxg_gtk_cell_layout_clear_attributes_w, 2, 0, 0, H_gtk_cell_layout_clear_attributes, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_set_action, gxg_gtk_file_chooser_set_action_w, 2, 0, 0, H_gtk_file_chooser_set_action, pl_tui);
+ Xg_define_procedure(gtk_file_chooser_get_action, gxg_gtk_file_chooser_get_action_w, 1, 0, 0, H_gtk_file_chooser_get_action, pl_iu);
+ Xg_define_procedure(gtk_file_chooser_set_local_only, gxg_gtk_file_chooser_set_local_only_w, 2, 0, 0, H_gtk_file_chooser_set_local_only, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_get_local_only, gxg_gtk_file_chooser_get_local_only_w, 1, 0, 0, H_gtk_file_chooser_get_local_only, pl_bu);
+ Xg_define_procedure(gtk_file_chooser_set_select_multiple, gxg_gtk_file_chooser_set_select_multiple_w, 2, 0, 0, H_gtk_file_chooser_set_select_multiple, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_get_select_multiple, gxg_gtk_file_chooser_get_select_multiple_w, 1, 0, 0, H_gtk_file_chooser_get_select_multiple, pl_bu);
+ Xg_define_procedure(gtk_file_chooser_set_current_name, gxg_gtk_file_chooser_set_current_name_w, 2, 0, 0, H_gtk_file_chooser_set_current_name, pl_tus);
+ Xg_define_procedure(gtk_file_chooser_get_filename, gxg_gtk_file_chooser_get_filename_w, 1, 0, 0, H_gtk_file_chooser_get_filename, pl_su);
+ Xg_define_procedure(gtk_file_chooser_set_filename, gxg_gtk_file_chooser_set_filename_w, 2, 0, 0, H_gtk_file_chooser_set_filename, pl_bus);
+ Xg_define_procedure(gtk_file_chooser_select_filename, gxg_gtk_file_chooser_select_filename_w, 2, 0, 0, H_gtk_file_chooser_select_filename, pl_bus);
+ Xg_define_procedure(gtk_file_chooser_unselect_filename, gxg_gtk_file_chooser_unselect_filename_w, 2, 0, 0, H_gtk_file_chooser_unselect_filename, pl_tus);
+ Xg_define_procedure(gtk_file_chooser_select_all, gxg_gtk_file_chooser_select_all_w, 1, 0, 0, H_gtk_file_chooser_select_all, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_unselect_all, gxg_gtk_file_chooser_unselect_all_w, 1, 0, 0, H_gtk_file_chooser_unselect_all, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_get_filenames, gxg_gtk_file_chooser_get_filenames_w, 1, 0, 0, H_gtk_file_chooser_get_filenames, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_set_current_folder, gxg_gtk_file_chooser_set_current_folder_w, 2, 0, 0, H_gtk_file_chooser_set_current_folder, pl_bus);
+ Xg_define_procedure(gtk_file_chooser_get_current_folder, gxg_gtk_file_chooser_get_current_folder_w, 1, 0, 0, H_gtk_file_chooser_get_current_folder, pl_su);
+ Xg_define_procedure(gtk_file_chooser_get_uri, gxg_gtk_file_chooser_get_uri_w, 1, 0, 0, H_gtk_file_chooser_get_uri, pl_su);
+ Xg_define_procedure(gtk_file_chooser_set_uri, gxg_gtk_file_chooser_set_uri_w, 2, 0, 0, H_gtk_file_chooser_set_uri, pl_bus);
+ Xg_define_procedure(gtk_file_chooser_select_uri, gxg_gtk_file_chooser_select_uri_w, 2, 0, 0, H_gtk_file_chooser_select_uri, pl_bus);
+ Xg_define_procedure(gtk_file_chooser_unselect_uri, gxg_gtk_file_chooser_unselect_uri_w, 2, 0, 0, H_gtk_file_chooser_unselect_uri, pl_tus);
+ Xg_define_procedure(gtk_file_chooser_get_uris, gxg_gtk_file_chooser_get_uris_w, 1, 0, 0, H_gtk_file_chooser_get_uris, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_set_current_folder_uri, gxg_gtk_file_chooser_set_current_folder_uri_w, 2, 0, 0, H_gtk_file_chooser_set_current_folder_uri, pl_bus);
+ Xg_define_procedure(gtk_file_chooser_get_current_folder_uri, gxg_gtk_file_chooser_get_current_folder_uri_w, 1, 0, 0, H_gtk_file_chooser_get_current_folder_uri, pl_su);
+ Xg_define_procedure(gtk_file_chooser_set_preview_widget, gxg_gtk_file_chooser_set_preview_widget_w, 2, 0, 0, H_gtk_file_chooser_set_preview_widget, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_get_preview_widget, gxg_gtk_file_chooser_get_preview_widget_w, 1, 0, 0, H_gtk_file_chooser_get_preview_widget, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_set_preview_widget_active, gxg_gtk_file_chooser_set_preview_widget_active_w, 2, 0, 0, H_gtk_file_chooser_set_preview_widget_active, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_get_preview_widget_active, gxg_gtk_file_chooser_get_preview_widget_active_w, 1, 0, 0, H_gtk_file_chooser_get_preview_widget_active, pl_bu);
+ Xg_define_procedure(gtk_file_chooser_get_preview_filename, gxg_gtk_file_chooser_get_preview_filename_w, 1, 0, 0, H_gtk_file_chooser_get_preview_filename, pl_su);
+ Xg_define_procedure(gtk_file_chooser_get_preview_uri, gxg_gtk_file_chooser_get_preview_uri_w, 1, 0, 0, H_gtk_file_chooser_get_preview_uri, pl_su);
+ Xg_define_procedure(gtk_file_chooser_set_extra_widget, gxg_gtk_file_chooser_set_extra_widget_w, 2, 0, 0, H_gtk_file_chooser_set_extra_widget, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_get_extra_widget, gxg_gtk_file_chooser_get_extra_widget_w, 1, 0, 0, H_gtk_file_chooser_get_extra_widget, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_add_filter, gxg_gtk_file_chooser_add_filter_w, 2, 0, 0, H_gtk_file_chooser_add_filter, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_remove_filter, gxg_gtk_file_chooser_remove_filter_w, 2, 0, 0, H_gtk_file_chooser_remove_filter, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_list_filters, gxg_gtk_file_chooser_list_filters_w, 1, 0, 0, H_gtk_file_chooser_list_filters, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_set_filter, gxg_gtk_file_chooser_set_filter_w, 2, 0, 0, H_gtk_file_chooser_set_filter, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_get_filter, gxg_gtk_file_chooser_get_filter_w, 1, 0, 0, H_gtk_file_chooser_get_filter, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_add_shortcut_folder, gxg_gtk_file_chooser_add_shortcut_folder_w, 2, 1, 0, H_gtk_file_chooser_add_shortcut_folder, pl_busu);
+ Xg_define_procedure(gtk_file_chooser_remove_shortcut_folder, gxg_gtk_file_chooser_remove_shortcut_folder_w, 2, 1, 0, H_gtk_file_chooser_remove_shortcut_folder, pl_busu);
+ Xg_define_procedure(gtk_file_chooser_list_shortcut_folders, gxg_gtk_file_chooser_list_shortcut_folders_w, 1, 0, 0, H_gtk_file_chooser_list_shortcut_folders, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_add_shortcut_folder_uri, gxg_gtk_file_chooser_add_shortcut_folder_uri_w, 2, 1, 0, H_gtk_file_chooser_add_shortcut_folder_uri, pl_busu);
+ Xg_define_procedure(gtk_file_chooser_remove_shortcut_folder_uri, gxg_gtk_file_chooser_remove_shortcut_folder_uri_w, 2, 1, 0, H_gtk_file_chooser_remove_shortcut_folder_uri, pl_busu);
+ Xg_define_procedure(gtk_file_chooser_list_shortcut_folder_uris, gxg_gtk_file_chooser_list_shortcut_folder_uris_w, 1, 0, 0, H_gtk_file_chooser_list_shortcut_folder_uris, pl_pu);
+ Xg_define_procedure(gtk_icon_theme_new, gxg_gtk_icon_theme_new_w, 0, 0, 0, H_gtk_icon_theme_new, pl_p);
+ Xg_define_procedure(gtk_icon_theme_get_default, gxg_gtk_icon_theme_get_default_w, 0, 0, 0, H_gtk_icon_theme_get_default, pl_p);
+ Xg_define_procedure(gtk_icon_theme_get_for_screen, gxg_gtk_icon_theme_get_for_screen_w, 1, 0, 0, H_gtk_icon_theme_get_for_screen, pl_pu);
+ Xg_define_procedure(gtk_icon_theme_set_screen, gxg_gtk_icon_theme_set_screen_w, 2, 0, 0, H_gtk_icon_theme_set_screen, pl_tu);
+ Xg_define_procedure(gtk_icon_theme_get_search_path, gxg_gtk_icon_theme_get_search_path_w, 1, 2, 0, H_gtk_icon_theme_get_search_path, pl_tu);
+ Xg_define_procedure(gtk_icon_theme_append_search_path, gxg_gtk_icon_theme_append_search_path_w, 2, 0, 0, H_gtk_icon_theme_append_search_path, pl_tus);
+ Xg_define_procedure(gtk_icon_theme_prepend_search_path, gxg_gtk_icon_theme_prepend_search_path_w, 2, 0, 0, H_gtk_icon_theme_prepend_search_path, pl_tus);
+ Xg_define_procedure(gtk_icon_theme_set_custom_theme, gxg_gtk_icon_theme_set_custom_theme_w, 2, 0, 0, H_gtk_icon_theme_set_custom_theme, pl_tus);
+ Xg_define_procedure(gtk_icon_theme_has_icon, gxg_gtk_icon_theme_has_icon_w, 2, 0, 0, H_gtk_icon_theme_has_icon, pl_bus);
+ Xg_define_procedure(gtk_icon_theme_lookup_icon, gxg_gtk_icon_theme_lookup_icon_w, 4, 0, 0, H_gtk_icon_theme_lookup_icon, pl_pusi);
+ Xg_define_procedure(gtk_icon_theme_load_icon, gxg_gtk_icon_theme_load_icon_w, 4, 1, 0, H_gtk_icon_theme_load_icon, pl_pusiiu);
+ Xg_define_procedure(gtk_icon_theme_list_icons, gxg_gtk_icon_theme_list_icons_w, 2, 0, 0, H_gtk_icon_theme_list_icons, pl_pus);
+ Xg_define_procedure(gtk_icon_theme_get_example_icon_name, gxg_gtk_icon_theme_get_example_icon_name_w, 1, 0, 0, H_gtk_icon_theme_get_example_icon_name, pl_su);
+ Xg_define_procedure(gtk_icon_theme_rescan_if_needed, gxg_gtk_icon_theme_rescan_if_needed_w, 1, 0, 0, H_gtk_icon_theme_rescan_if_needed, pl_bu);
+ Xg_define_procedure(gtk_icon_info_get_base_size, gxg_gtk_icon_info_get_base_size_w, 1, 0, 0, H_gtk_icon_info_get_base_size, pl_iu);
+ Xg_define_procedure(gtk_icon_info_get_filename, gxg_gtk_icon_info_get_filename_w, 1, 0, 0, H_gtk_icon_info_get_filename, pl_su);
+ Xg_define_procedure(gtk_icon_info_load_icon, gxg_gtk_icon_info_load_icon_w, 1, 1, 0, H_gtk_icon_info_load_icon, pl_pu);
+ Xg_define_procedure(gtk_tool_button_new, gxg_gtk_tool_button_new_w, 2, 0, 0, H_gtk_tool_button_new, pl_pus);
+ Xg_define_procedure(gtk_tool_button_set_label, gxg_gtk_tool_button_set_label_w, 2, 0, 0, H_gtk_tool_button_set_label, pl_tus);
+ Xg_define_procedure(gtk_tool_button_get_label, gxg_gtk_tool_button_get_label_w, 1, 0, 0, H_gtk_tool_button_get_label, pl_su);
+ Xg_define_procedure(gtk_tool_button_set_use_underline, gxg_gtk_tool_button_set_use_underline_w, 2, 0, 0, H_gtk_tool_button_set_use_underline, pl_tub);
+ Xg_define_procedure(gtk_tool_button_get_use_underline, gxg_gtk_tool_button_get_use_underline_w, 1, 0, 0, H_gtk_tool_button_get_use_underline, pl_bu);
+ Xg_define_procedure(gtk_tool_button_set_icon_widget, gxg_gtk_tool_button_set_icon_widget_w, 2, 0, 0, H_gtk_tool_button_set_icon_widget, pl_tu);
+ Xg_define_procedure(gtk_tool_button_get_icon_widget, gxg_gtk_tool_button_get_icon_widget_w, 1, 0, 0, H_gtk_tool_button_get_icon_widget, pl_pu);
+ Xg_define_procedure(gtk_tool_button_set_label_widget, gxg_gtk_tool_button_set_label_widget_w, 2, 0, 0, H_gtk_tool_button_set_label_widget, pl_tu);
+ Xg_define_procedure(gtk_tool_button_get_label_widget, gxg_gtk_tool_button_get_label_widget_w, 1, 0, 0, H_gtk_tool_button_get_label_widget, pl_pu);
+ Xg_define_procedure(gtk_tool_item_new, gxg_gtk_tool_item_new_w, 0, 0, 0, H_gtk_tool_item_new, pl_p);
+ Xg_define_procedure(gtk_tool_item_set_homogeneous, gxg_gtk_tool_item_set_homogeneous_w, 2, 0, 0, H_gtk_tool_item_set_homogeneous, pl_tub);
+ Xg_define_procedure(gtk_tool_item_get_homogeneous, gxg_gtk_tool_item_get_homogeneous_w, 1, 0, 0, H_gtk_tool_item_get_homogeneous, pl_bu);
+ Xg_define_procedure(gtk_tool_item_set_expand, gxg_gtk_tool_item_set_expand_w, 2, 0, 0, H_gtk_tool_item_set_expand, pl_tub);
+ Xg_define_procedure(gtk_tool_item_get_expand, gxg_gtk_tool_item_get_expand_w, 1, 0, 0, H_gtk_tool_item_get_expand, pl_bu);
+ Xg_define_procedure(gtk_tool_item_set_use_drag_window, gxg_gtk_tool_item_set_use_drag_window_w, 2, 0, 0, H_gtk_tool_item_set_use_drag_window, pl_tub);
+ Xg_define_procedure(gtk_tool_item_get_use_drag_window, gxg_gtk_tool_item_get_use_drag_window_w, 1, 0, 0, H_gtk_tool_item_get_use_drag_window, pl_bu);
+ Xg_define_procedure(gtk_tool_item_set_visible_horizontal, gxg_gtk_tool_item_set_visible_horizontal_w, 2, 0, 0, H_gtk_tool_item_set_visible_horizontal, pl_tub);
+ Xg_define_procedure(gtk_tool_item_get_visible_horizontal, gxg_gtk_tool_item_get_visible_horizontal_w, 1, 0, 0, H_gtk_tool_item_get_visible_horizontal, pl_bu);
+ Xg_define_procedure(gtk_tool_item_set_visible_vertical, gxg_gtk_tool_item_set_visible_vertical_w, 2, 0, 0, H_gtk_tool_item_set_visible_vertical, pl_tub);
+ Xg_define_procedure(gtk_tool_item_get_visible_vertical, gxg_gtk_tool_item_get_visible_vertical_w, 1, 0, 0, H_gtk_tool_item_get_visible_vertical, pl_bu);
+ Xg_define_procedure(gtk_tool_item_get_is_important, gxg_gtk_tool_item_get_is_important_w, 1, 0, 0, H_gtk_tool_item_get_is_important, pl_bu);
+ Xg_define_procedure(gtk_tool_item_set_is_important, gxg_gtk_tool_item_set_is_important_w, 2, 0, 0, H_gtk_tool_item_set_is_important, pl_tub);
+ Xg_define_procedure(gtk_tool_item_get_orientation, gxg_gtk_tool_item_get_orientation_w, 1, 0, 0, H_gtk_tool_item_get_orientation, pl_iu);
+ Xg_define_procedure(gtk_tool_item_get_toolbar_style, gxg_gtk_tool_item_get_toolbar_style_w, 1, 0, 0, H_gtk_tool_item_get_toolbar_style, pl_iu);
+ Xg_define_procedure(gtk_tool_item_get_relief_style, gxg_gtk_tool_item_get_relief_style_w, 1, 0, 0, H_gtk_tool_item_get_relief_style, pl_iu);
+ Xg_define_procedure(gtk_tool_item_retrieve_proxy_menu_item, gxg_gtk_tool_item_retrieve_proxy_menu_item_w, 1, 0, 0, H_gtk_tool_item_retrieve_proxy_menu_item, pl_pu);
+ Xg_define_procedure(gtk_tool_item_get_proxy_menu_item, gxg_gtk_tool_item_get_proxy_menu_item_w, 2, 0, 0, H_gtk_tool_item_get_proxy_menu_item, pl_pus);
+ Xg_define_procedure(gtk_tool_item_set_proxy_menu_item, gxg_gtk_tool_item_set_proxy_menu_item_w, 3, 0, 0, H_gtk_tool_item_set_proxy_menu_item, pl_tusu);
+ Xg_define_procedure(gtk_list_store_remove, gxg_gtk_list_store_remove_w, 2, 0, 0, H_gtk_list_store_remove, pl_bu);
+ Xg_define_procedure(gdk_display_set_double_click_distance, gxg_gdk_display_set_double_click_distance_w, 2, 0, 0, H_gdk_display_set_double_click_distance, pl_tui);
+ Xg_define_procedure(gdk_display_get_default_group, gxg_gdk_display_get_default_group_w, 1, 0, 0, H_gdk_display_get_default_group, pl_pu);
+ Xg_define_procedure(gdk_window_get_group, gxg_gdk_window_get_group_w, 1, 0, 0, H_gdk_window_get_group, pl_pu);
+ Xg_define_procedure(gtk_cell_layout_reorder, gxg_gtk_cell_layout_reorder_w, 3, 0, 0, H_gtk_cell_layout_reorder, pl_tuui);
+ Xg_define_procedure(gtk_clipboard_request_targets, gxg_gtk_clipboard_request_targets_w, 2, 1, 0, H_gtk_clipboard_request_targets, pl_tut);
+ Xg_define_procedure(gtk_clipboard_wait_for_targets, gxg_gtk_clipboard_wait_for_targets_w, 1, 2, 0, H_gtk_clipboard_wait_for_targets, pl_bu);
+ Xg_define_procedure(gtk_menu_shell_cancel, gxg_gtk_menu_shell_cancel_w, 1, 0, 0, H_gtk_menu_shell_cancel, pl_tu);
+ Xg_define_procedure(gtk_paned_get_child1, gxg_gtk_paned_get_child1_w, 1, 0, 0, H_gtk_paned_get_child1, pl_pu);
+ Xg_define_procedure(gtk_paned_get_child2, gxg_gtk_paned_get_child2_w, 1, 0, 0, H_gtk_paned_get_child2, pl_pu);
+ Xg_define_procedure(gtk_window_set_accept_focus, gxg_gtk_window_set_accept_focus_w, 2, 0, 0, H_gtk_window_set_accept_focus, pl_tub);
+ Xg_define_procedure(gtk_window_get_accept_focus, gxg_gtk_window_get_accept_focus_w, 1, 0, 0, H_gtk_window_get_accept_focus, pl_bu);
+ Xg_define_procedure(g_list_nth_data, gxg_g_list_nth_data_w, 2, 0, 0, H_g_list_nth_data, pl_tui);
+ Xg_define_procedure(gtk_accel_map_get, gxg_gtk_accel_map_get_w, 0, 0, 0, H_gtk_accel_map_get, pl_p);
+ Xg_define_procedure(gtk_combo_box_popup, gxg_gtk_combo_box_popup_w, 1, 0, 0, H_gtk_combo_box_popup, pl_tu);
+ Xg_define_procedure(gtk_combo_box_popdown, gxg_gtk_combo_box_popdown_w, 1, 0, 0, H_gtk_combo_box_popdown, pl_tu);
+ Xg_define_procedure(gtk_radio_menu_item_new_from_widget, gxg_gtk_radio_menu_item_new_from_widget_w, 1, 0, 0, H_gtk_radio_menu_item_new_from_widget, pl_pu);
+ Xg_define_procedure(gtk_radio_menu_item_new_with_mnemonic_from_widget, gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget_w, 2, 0, 0, H_gtk_radio_menu_item_new_with_mnemonic_from_widget, pl_pus);
+ Xg_define_procedure(gtk_radio_menu_item_new_with_label_from_widget, gxg_gtk_radio_menu_item_new_with_label_from_widget_w, 2, 0, 0, H_gtk_radio_menu_item_new_with_label_from_widget, pl_pus);
+ Xg_define_procedure(gtk_scale_get_layout, gxg_gtk_scale_get_layout_w, 1, 0, 0, H_gtk_scale_get_layout, pl_pu);
+ Xg_define_procedure(gtk_scale_get_layout_offsets, gxg_gtk_scale_get_layout_offsets_w, 1, 2, 0, H_gtk_scale_get_layout_offsets, pl_tu);
+ Xg_define_procedure(gtk_drag_source_get_target_list, gxg_gtk_drag_source_get_target_list_w, 1, 0, 0, H_gtk_drag_source_get_target_list, pl_pu);
+ Xg_define_procedure(gtk_drag_source_set_target_list, gxg_gtk_drag_source_set_target_list_w, 2, 0, 0, H_gtk_drag_source_set_target_list, pl_tu);
+ Xg_define_procedure(gtk_entry_set_alignment, gxg_gtk_entry_set_alignment_w, 2, 0, 0, H_gtk_entry_set_alignment, pl_tur);
+ Xg_define_procedure(gtk_entry_get_alignment, gxg_gtk_entry_get_alignment_w, 1, 0, 0, H_gtk_entry_get_alignment, pl_du);
+ Xg_define_procedure(gtk_file_chooser_set_use_preview_label, gxg_gtk_file_chooser_set_use_preview_label_w, 2, 0, 0, H_gtk_file_chooser_set_use_preview_label, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_get_use_preview_label, gxg_gtk_file_chooser_get_use_preview_label_w, 1, 0, 0, H_gtk_file_chooser_get_use_preview_label, pl_bu);
+ Xg_define_procedure(gtk_widget_list_mnemonic_labels, gxg_gtk_widget_list_mnemonic_labels_w, 1, 0, 0, H_gtk_widget_list_mnemonic_labels, pl_pu);
+ Xg_define_procedure(gtk_widget_add_mnemonic_label, gxg_gtk_widget_add_mnemonic_label_w, 2, 0, 0, H_gtk_widget_add_mnemonic_label, pl_tu);
+ Xg_define_procedure(gtk_widget_remove_mnemonic_label, gxg_gtk_widget_remove_mnemonic_label_w, 2, 0, 0, H_gtk_widget_remove_mnemonic_label, pl_tu);
+ Xg_define_procedure(gtk_window_activate_key, gxg_gtk_window_activate_key_w, 2, 0, 0, H_gtk_window_activate_key, pl_bu);
+ Xg_define_procedure(gtk_window_propagate_key_event, gxg_gtk_window_propagate_key_event_w, 2, 0, 0, H_gtk_window_propagate_key_event, pl_bu);
+ Xg_define_procedure(g_quark_from_string, gxg_g_quark_from_string_w, 1, 0, 0, H_g_quark_from_string, pl_is);
+ Xg_define_procedure(g_quark_to_string, gxg_g_quark_to_string_w, 1, 0, 0, H_g_quark_to_string, pl_si);
+ Xg_define_procedure(gtk_cell_view_new, gxg_gtk_cell_view_new_w, 0, 0, 0, H_gtk_cell_view_new, pl_p);
+ Xg_define_procedure(gtk_cell_view_new_with_text, gxg_gtk_cell_view_new_with_text_w, 1, 0, 0, H_gtk_cell_view_new_with_text, pl_ps);
+ Xg_define_procedure(gtk_cell_view_new_with_markup, gxg_gtk_cell_view_new_with_markup_w, 1, 0, 0, H_gtk_cell_view_new_with_markup, pl_ps);
+ Xg_define_procedure(gtk_cell_view_new_with_pixbuf, gxg_gtk_cell_view_new_with_pixbuf_w, 1, 0, 0, H_gtk_cell_view_new_with_pixbuf, pl_pu);
+ Xg_define_procedure(gtk_cell_view_set_model, gxg_gtk_cell_view_set_model_w, 2, 0, 0, H_gtk_cell_view_set_model, pl_tu);
+ Xg_define_procedure(gtk_cell_view_set_displayed_row, gxg_gtk_cell_view_set_displayed_row_w, 2, 0, 0, H_gtk_cell_view_set_displayed_row, pl_tu);
+ Xg_define_procedure(gtk_cell_view_get_displayed_row, gxg_gtk_cell_view_get_displayed_row_w, 1, 0, 0, H_gtk_cell_view_get_displayed_row, pl_pu);
+ Xg_define_procedure(gtk_combo_box_get_wrap_width, gxg_gtk_combo_box_get_wrap_width_w, 1, 0, 0, H_gtk_combo_box_get_wrap_width, pl_iu);
+ Xg_define_procedure(gtk_combo_box_get_row_span_column, gxg_gtk_combo_box_get_row_span_column_w, 1, 0, 0, H_gtk_combo_box_get_row_span_column, pl_iu);
+ Xg_define_procedure(gtk_combo_box_get_column_span_column, gxg_gtk_combo_box_get_column_span_column_w, 1, 0, 0, H_gtk_combo_box_get_column_span_column, pl_iu);
+ Xg_define_procedure(gtk_drag_dest_add_text_targets, gxg_gtk_drag_dest_add_text_targets_w, 1, 0, 0, H_gtk_drag_dest_add_text_targets, pl_tu);
+ Xg_define_procedure(gtk_drag_source_add_text_targets, gxg_gtk_drag_source_add_text_targets_w, 1, 0, 0, H_gtk_drag_source_add_text_targets, pl_tu);
+ Xg_define_procedure(gtk_entry_completion_insert_prefix, gxg_gtk_entry_completion_insert_prefix_w, 1, 0, 0, H_gtk_entry_completion_insert_prefix, pl_tu);
+ Xg_define_procedure(gtk_entry_completion_set_inline_completion, gxg_gtk_entry_completion_set_inline_completion_w, 2, 0, 0, H_gtk_entry_completion_set_inline_completion, pl_tub);
+ Xg_define_procedure(gtk_entry_completion_get_inline_completion, gxg_gtk_entry_completion_get_inline_completion_w, 1, 0, 0, H_gtk_entry_completion_get_inline_completion, pl_bu);
+ Xg_define_procedure(gtk_entry_completion_set_popup_completion, gxg_gtk_entry_completion_set_popup_completion_w, 2, 0, 0, H_gtk_entry_completion_set_popup_completion, pl_tub);
+ Xg_define_procedure(gtk_entry_completion_get_popup_completion, gxg_gtk_entry_completion_get_popup_completion_w, 1, 0, 0, H_gtk_entry_completion_get_popup_completion, pl_bu);
+ Xg_define_procedure(gtk_entry_completion_get_text_column, gxg_gtk_entry_completion_get_text_column_w, 1, 0, 0, H_gtk_entry_completion_get_text_column, pl_iu);
+ Xg_define_procedure(gtk_icon_theme_get_icon_sizes, gxg_gtk_icon_theme_get_icon_sizes_w, 2, 0, 0, H_gtk_icon_theme_get_icon_sizes, pl_pus);
+ Xg_define_procedure(gtk_menu_get_for_attach_widget, gxg_gtk_menu_get_for_attach_widget_w, 1, 0, 0, H_gtk_menu_get_for_attach_widget, pl_pu);
+ Xg_define_procedure(gtk_tree_view_set_fixed_height_mode, gxg_gtk_tree_view_set_fixed_height_mode_w, 2, 0, 0, H_gtk_tree_view_set_fixed_height_mode, pl_tub);
+ Xg_define_procedure(gtk_tree_view_get_fixed_height_mode, gxg_gtk_tree_view_get_fixed_height_mode_w, 1, 0, 0, H_gtk_tree_view_get_fixed_height_mode, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_hover_selection, gxg_gtk_tree_view_set_hover_selection_w, 2, 0, 0, H_gtk_tree_view_set_hover_selection, pl_tub);
+ Xg_define_procedure(gtk_tree_view_get_hover_selection, gxg_gtk_tree_view_get_hover_selection_w, 1, 0, 0, H_gtk_tree_view_get_hover_selection, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_row_separator_func, gxg_gtk_tree_view_set_row_separator_func_w, 4, 0, 0, H_gtk_tree_view_set_row_separator_func, pl_tut);
+ Xg_define_procedure(gtk_window_set_focus_on_map, gxg_gtk_window_set_focus_on_map_w, 2, 0, 0, H_gtk_window_set_focus_on_map, pl_tub);
+ Xg_define_procedure(gtk_window_get_focus_on_map, gxg_gtk_window_get_focus_on_map_w, 1, 0, 0, H_gtk_window_get_focus_on_map, pl_bu);
+ Xg_define_procedure(gtk_window_set_icon_name, gxg_gtk_window_set_icon_name_w, 2, 0, 0, H_gtk_window_set_icon_name, pl_tus);
+ Xg_define_procedure(gtk_window_get_icon_name, gxg_gtk_window_get_icon_name_w, 1, 0, 0, H_gtk_window_get_icon_name, pl_su);
+ Xg_define_procedure(gtk_window_set_default_icon_name, gxg_gtk_window_set_default_icon_name_w, 1, 0, 0, H_gtk_window_set_default_icon_name, pl_ts);
+ Xg_define_procedure(gtk_about_dialog_new, gxg_gtk_about_dialog_new_w, 0, 0, 0, H_gtk_about_dialog_new, pl_p);
+ Xg_define_procedure(gtk_about_dialog_get_version, gxg_gtk_about_dialog_get_version_w, 1, 0, 0, H_gtk_about_dialog_get_version, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_version, gxg_gtk_about_dialog_set_version_w, 2, 0, 0, H_gtk_about_dialog_set_version, pl_tus);
+ Xg_define_procedure(gtk_about_dialog_get_copyright, gxg_gtk_about_dialog_get_copyright_w, 1, 0, 0, H_gtk_about_dialog_get_copyright, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_copyright, gxg_gtk_about_dialog_set_copyright_w, 2, 0, 0, H_gtk_about_dialog_set_copyright, pl_tus);
+ Xg_define_procedure(gtk_about_dialog_get_comments, gxg_gtk_about_dialog_get_comments_w, 1, 0, 0, H_gtk_about_dialog_get_comments, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_comments, gxg_gtk_about_dialog_set_comments_w, 2, 0, 0, H_gtk_about_dialog_set_comments, pl_tus);
+ Xg_define_procedure(gtk_about_dialog_get_website, gxg_gtk_about_dialog_get_website_w, 1, 0, 0, H_gtk_about_dialog_get_website, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_website, gxg_gtk_about_dialog_set_website_w, 2, 0, 0, H_gtk_about_dialog_set_website, pl_tus);
+ Xg_define_procedure(gtk_about_dialog_get_website_label, gxg_gtk_about_dialog_get_website_label_w, 1, 0, 0, H_gtk_about_dialog_get_website_label, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_website_label, gxg_gtk_about_dialog_set_website_label_w, 2, 0, 0, H_gtk_about_dialog_set_website_label, pl_tus);
+ Xg_define_procedure(gtk_about_dialog_get_authors, gxg_gtk_about_dialog_get_authors_w, 1, 0, 0, H_gtk_about_dialog_get_authors, pl_pu);
+ Xg_define_procedure(gtk_about_dialog_set_authors, gxg_gtk_about_dialog_set_authors_w, 2, 0, 0, H_gtk_about_dialog_set_authors, pl_tu);
+ Xg_define_procedure(gtk_about_dialog_get_documenters, gxg_gtk_about_dialog_get_documenters_w, 1, 0, 0, H_gtk_about_dialog_get_documenters, pl_pu);
+ Xg_define_procedure(gtk_about_dialog_set_documenters, gxg_gtk_about_dialog_set_documenters_w, 2, 0, 0, H_gtk_about_dialog_set_documenters, pl_tu);
+ Xg_define_procedure(gtk_about_dialog_get_artists, gxg_gtk_about_dialog_get_artists_w, 1, 0, 0, H_gtk_about_dialog_get_artists, pl_pu);
+ Xg_define_procedure(gtk_about_dialog_set_artists, gxg_gtk_about_dialog_set_artists_w, 2, 0, 0, H_gtk_about_dialog_set_artists, pl_tu);
+ Xg_define_procedure(gtk_about_dialog_get_translator_credits, gxg_gtk_about_dialog_get_translator_credits_w, 1, 0, 0, H_gtk_about_dialog_get_translator_credits, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_translator_credits, gxg_gtk_about_dialog_set_translator_credits_w, 2, 0, 0, H_gtk_about_dialog_set_translator_credits, pl_tus);
+ Xg_define_procedure(gtk_about_dialog_get_logo, gxg_gtk_about_dialog_get_logo_w, 1, 0, 0, H_gtk_about_dialog_get_logo, pl_pu);
+ Xg_define_procedure(gtk_about_dialog_set_logo, gxg_gtk_about_dialog_set_logo_w, 2, 0, 0, H_gtk_about_dialog_set_logo, pl_tu);
+ Xg_define_procedure(gtk_about_dialog_get_program_name, gxg_gtk_about_dialog_get_program_name_w, 1, 0, 0, H_gtk_about_dialog_get_program_name, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_program_name, gxg_gtk_about_dialog_set_program_name_w, 2, 0, 0, H_gtk_about_dialog_set_program_name, pl_tus);
+ Xg_define_procedure(gtk_icon_view_new, gxg_gtk_icon_view_new_w, 0, 0, 0, H_gtk_icon_view_new, pl_p);
+ Xg_define_procedure(gtk_icon_view_new_with_model, gxg_gtk_icon_view_new_with_model_w, 1, 0, 0, H_gtk_icon_view_new_with_model, pl_pu);
+ Xg_define_procedure(gtk_icon_view_set_model, gxg_gtk_icon_view_set_model_w, 2, 0, 0, H_gtk_icon_view_set_model, pl_tu);
+ Xg_define_procedure(gtk_icon_view_get_model, gxg_gtk_icon_view_get_model_w, 1, 0, 0, H_gtk_icon_view_get_model, pl_pu);
+ Xg_define_procedure(gtk_icon_view_set_text_column, gxg_gtk_icon_view_set_text_column_w, 2, 0, 0, H_gtk_icon_view_set_text_column, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_text_column, gxg_gtk_icon_view_get_text_column_w, 1, 0, 0, H_gtk_icon_view_get_text_column, pl_iu);
+ Xg_define_procedure(gtk_icon_view_set_markup_column, gxg_gtk_icon_view_set_markup_column_w, 2, 0, 0, H_gtk_icon_view_set_markup_column, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_markup_column, gxg_gtk_icon_view_get_markup_column_w, 1, 0, 0, H_gtk_icon_view_get_markup_column, pl_iu);
+ Xg_define_procedure(gtk_icon_view_set_pixbuf_column, gxg_gtk_icon_view_set_pixbuf_column_w, 2, 0, 0, H_gtk_icon_view_set_pixbuf_column, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_pixbuf_column, gxg_gtk_icon_view_get_pixbuf_column_w, 1, 0, 0, H_gtk_icon_view_get_pixbuf_column, pl_iu);
+ Xg_define_procedure(gtk_icon_view_get_path_at_pos, gxg_gtk_icon_view_get_path_at_pos_w, 3, 0, 0, H_gtk_icon_view_get_path_at_pos, pl_pui);
+ Xg_define_procedure(gtk_icon_view_selected_foreach, gxg_gtk_icon_view_selected_foreach_w, 2, 1, 0, H_gtk_icon_view_selected_foreach, pl_tut);
+ Xg_define_procedure(gtk_icon_view_set_selection_mode, gxg_gtk_icon_view_set_selection_mode_w, 2, 0, 0, H_gtk_icon_view_set_selection_mode, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_selection_mode, gxg_gtk_icon_view_get_selection_mode_w, 1, 0, 0, H_gtk_icon_view_get_selection_mode, pl_iu);
+ Xg_define_procedure(gtk_icon_view_select_path, gxg_gtk_icon_view_select_path_w, 2, 0, 0, H_gtk_icon_view_select_path, pl_tu);
+ Xg_define_procedure(gtk_icon_view_unselect_path, gxg_gtk_icon_view_unselect_path_w, 2, 0, 0, H_gtk_icon_view_unselect_path, pl_tu);
+ Xg_define_procedure(gtk_icon_view_path_is_selected, gxg_gtk_icon_view_path_is_selected_w, 2, 0, 0, H_gtk_icon_view_path_is_selected, pl_bu);
+ Xg_define_procedure(gtk_icon_view_get_selected_items, gxg_gtk_icon_view_get_selected_items_w, 1, 0, 0, H_gtk_icon_view_get_selected_items, pl_pu);
+ Xg_define_procedure(gtk_icon_view_select_all, gxg_gtk_icon_view_select_all_w, 1, 0, 0, H_gtk_icon_view_select_all, pl_tu);
+ Xg_define_procedure(gtk_icon_view_unselect_all, gxg_gtk_icon_view_unselect_all_w, 1, 0, 0, H_gtk_icon_view_unselect_all, pl_tu);
+ Xg_define_procedure(gtk_icon_view_item_activated, gxg_gtk_icon_view_item_activated_w, 2, 0, 0, H_gtk_icon_view_item_activated, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_combo_new, gxg_gtk_cell_renderer_combo_new_w, 0, 0, 0, H_gtk_cell_renderer_combo_new, pl_p);
+ Xg_define_procedure(gtk_cell_renderer_progress_new, gxg_gtk_cell_renderer_progress_new_w, 0, 0, 0, H_gtk_cell_renderer_progress_new, pl_p);
+ Xg_define_procedure(gtk_combo_box_set_row_separator_func, gxg_gtk_combo_box_set_row_separator_func_w, 4, 0, 0, H_gtk_combo_box_set_row_separator_func, pl_tut);
+ Xg_define_procedure(gtk_label_set_ellipsize, gxg_gtk_label_set_ellipsize_w, 2, 0, 0, H_gtk_label_set_ellipsize, pl_tui);
+ Xg_define_procedure(gtk_label_get_ellipsize, gxg_gtk_label_get_ellipsize_w, 1, 0, 0, H_gtk_label_get_ellipsize, pl_iu);
+ Xg_define_procedure(pango_attr_fallback_new, gxg_pango_attr_fallback_new_w, 1, 0, 0, H_pango_attr_fallback_new, pl_pb);
+ Xg_define_procedure(pango_attr_letter_spacing_new, gxg_pango_attr_letter_spacing_new_w, 1, 0, 0, H_pango_attr_letter_spacing_new, pl_pi);
+ Xg_define_procedure(pango_attr_list_filter, gxg_pango_attr_list_filter_w, 3, 0, 0, H_pango_attr_list_filter, pl_put);
+ Xg_define_procedure(pango_attr_iterator_get_attrs, gxg_pango_attr_iterator_get_attrs_w, 1, 0, 0, H_pango_attr_iterator_get_attrs, pl_pu);
+ Xg_define_procedure(pango_font_metrics_get_underline_position, gxg_pango_font_metrics_get_underline_position_w, 1, 0, 0, H_pango_font_metrics_get_underline_position, pl_iu);
+ Xg_define_procedure(pango_font_metrics_get_underline_thickness, gxg_pango_font_metrics_get_underline_thickness_w, 1, 0, 0, H_pango_font_metrics_get_underline_thickness, pl_iu);
+ Xg_define_procedure(pango_font_metrics_get_strikethrough_position, gxg_pango_font_metrics_get_strikethrough_position_w, 1, 0, 0, H_pango_font_metrics_get_strikethrough_position, pl_iu);
+ Xg_define_procedure(pango_font_metrics_get_strikethrough_thickness, gxg_pango_font_metrics_get_strikethrough_thickness_w, 1, 0, 0, H_pango_font_metrics_get_strikethrough_thickness, pl_iu);
+ Xg_define_procedure(pango_font_family_is_monospace, gxg_pango_font_family_is_monospace_w, 1, 0, 0, H_pango_font_family_is_monospace, pl_bu);
+ Xg_define_procedure(pango_font_face_list_sizes, gxg_pango_font_face_list_sizes_w, 1, 2, 0, H_pango_font_face_list_sizes, pl_tu);
+ Xg_define_procedure(pango_layout_set_auto_dir, gxg_pango_layout_set_auto_dir_w, 2, 0, 0, H_pango_layout_set_auto_dir, pl_tub);
+ Xg_define_procedure(pango_layout_get_auto_dir, gxg_pango_layout_get_auto_dir_w, 1, 0, 0, H_pango_layout_get_auto_dir, pl_bu);
+ Xg_define_procedure(pango_script_for_unichar, gxg_pango_script_for_unichar_w, 1, 0, 0, H_pango_script_for_unichar, pl_i);
+ Xg_define_procedure(pango_script_iter_new, gxg_pango_script_iter_new_w, 2, 0, 0, H_pango_script_iter_new, pl_psi);
+ Xg_define_procedure(pango_script_iter_get_range, gxg_pango_script_iter_get_range_w, 1, 3, 0, H_pango_script_iter_get_range, pl_tu);
+ Xg_define_procedure(pango_script_iter_next, gxg_pango_script_iter_next_w, 1, 0, 0, H_pango_script_iter_next, pl_bu);
+ Xg_define_procedure(pango_script_iter_free, gxg_pango_script_iter_free_w, 1, 0, 0, H_pango_script_iter_free, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_button_new_with_dialog, gxg_gtk_file_chooser_button_new_with_dialog_w, 1, 0, 0, H_gtk_file_chooser_button_new_with_dialog, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_button_get_title, gxg_gtk_file_chooser_button_get_title_w, 1, 0, 0, H_gtk_file_chooser_button_get_title, pl_su);
+ Xg_define_procedure(gtk_file_chooser_button_set_title, gxg_gtk_file_chooser_button_set_title_w, 2, 0, 0, H_gtk_file_chooser_button_set_title, pl_tus);
+ Xg_define_procedure(gdk_drag_drop_succeeded, gxg_gdk_drag_drop_succeeded_w, 1, 0, 0, H_gdk_drag_drop_succeeded, pl_bu);
+ Xg_define_procedure(gtk_entry_layout_index_to_text_index, gxg_gtk_entry_layout_index_to_text_index_w, 2, 0, 0, H_gtk_entry_layout_index_to_text_index, pl_iui);
+ Xg_define_procedure(gtk_entry_text_index_to_layout_index, gxg_gtk_entry_text_index_to_layout_index_w, 2, 0, 0, H_gtk_entry_text_index_to_layout_index, pl_iui);
+ Xg_define_procedure(gtk_file_chooser_set_show_hidden, gxg_gtk_file_chooser_set_show_hidden_w, 2, 0, 0, H_gtk_file_chooser_set_show_hidden, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_get_show_hidden, gxg_gtk_file_chooser_get_show_hidden_w, 1, 0, 0, H_gtk_file_chooser_get_show_hidden, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_hover_expand, gxg_gtk_tree_view_set_hover_expand_w, 2, 0, 0, H_gtk_tree_view_set_hover_expand, pl_tub);
+ Xg_define_procedure(gtk_tree_view_get_hover_expand, gxg_gtk_tree_view_get_hover_expand_w, 1, 0, 0, H_gtk_tree_view_get_hover_expand, pl_bu);
+ Xg_define_procedure(gtk_tool_item_rebuild_menu, gxg_gtk_tool_item_rebuild_menu_w, 1, 0, 0, H_gtk_tool_item_rebuild_menu, pl_tu);
+ Xg_define_procedure(gtk_menu_tool_button_new, gxg_gtk_menu_tool_button_new_w, 2, 0, 0, H_gtk_menu_tool_button_new, pl_pus);
+ Xg_define_procedure(gtk_menu_tool_button_set_menu, gxg_gtk_menu_tool_button_set_menu_w, 2, 0, 0, H_gtk_menu_tool_button_set_menu, pl_tu);
+ Xg_define_procedure(gtk_menu_tool_button_get_menu, gxg_gtk_menu_tool_button_get_menu_w, 1, 0, 0, H_gtk_menu_tool_button_get_menu, pl_pu);
+ Xg_define_procedure(gdk_display_supports_clipboard_persistence, gxg_gdk_display_supports_clipboard_persistence_w, 1, 0, 0, H_gdk_display_supports_clipboard_persistence, pl_bu);
+ Xg_define_procedure(gtk_about_dialog_get_logo_icon_name, gxg_gtk_about_dialog_get_logo_icon_name_w, 1, 0, 0, H_gtk_about_dialog_get_logo_icon_name, pl_su);
+ Xg_define_procedure(gtk_about_dialog_set_logo_icon_name, gxg_gtk_about_dialog_set_logo_icon_name_w, 2, 0, 0, H_gtk_about_dialog_set_logo_icon_name, pl_tus);
+ Xg_define_procedure(gtk_accelerator_get_label, gxg_gtk_accelerator_get_label_w, 2, 0, 0, H_gtk_accelerator_get_label, pl_si);
+ Xg_define_procedure(gtk_clipboard_wait_is_target_available, gxg_gtk_clipboard_wait_is_target_available_w, 2, 0, 0, H_gtk_clipboard_wait_is_target_available, pl_but);
+ Xg_define_procedure(gtk_clipboard_set_can_store, gxg_gtk_clipboard_set_can_store_w, 3, 0, 0, H_gtk_clipboard_set_can_store, pl_tuui);
+ Xg_define_procedure(gtk_clipboard_store, gxg_gtk_clipboard_store_w, 1, 0, 0, H_gtk_clipboard_store, pl_tu);
+ Xg_define_procedure(gtk_drag_dest_add_image_targets, gxg_gtk_drag_dest_add_image_targets_w, 1, 0, 0, H_gtk_drag_dest_add_image_targets, pl_tu);
+ Xg_define_procedure(gtk_drag_dest_add_uri_targets, gxg_gtk_drag_dest_add_uri_targets_w, 1, 0, 0, H_gtk_drag_dest_add_uri_targets, pl_tu);
+ Xg_define_procedure(gtk_drag_source_add_image_targets, gxg_gtk_drag_source_add_image_targets_w, 1, 0, 0, H_gtk_drag_source_add_image_targets, pl_tu);
+ Xg_define_procedure(gtk_drag_source_add_uri_targets, gxg_gtk_drag_source_add_uri_targets_w, 1, 0, 0, H_gtk_drag_source_add_uri_targets, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_button_get_width_chars, gxg_gtk_file_chooser_button_get_width_chars_w, 1, 0, 0, H_gtk_file_chooser_button_get_width_chars, pl_iu);
+ Xg_define_procedure(gtk_file_chooser_button_set_width_chars, gxg_gtk_file_chooser_button_set_width_chars_w, 2, 0, 0, H_gtk_file_chooser_button_set_width_chars, pl_tui);
+ Xg_define_procedure(gtk_image_set_pixel_size, gxg_gtk_image_set_pixel_size_w, 2, 0, 0, H_gtk_image_set_pixel_size, pl_tui);
+ Xg_define_procedure(gtk_image_get_pixel_size, gxg_gtk_image_get_pixel_size_w, 1, 0, 0, H_gtk_image_get_pixel_size, pl_iu);
+ Xg_define_procedure(gtk_label_set_width_chars, gxg_gtk_label_set_width_chars_w, 2, 0, 0, H_gtk_label_set_width_chars, pl_tui);
+ Xg_define_procedure(gtk_label_get_width_chars, gxg_gtk_label_get_width_chars_w, 1, 0, 0, H_gtk_label_get_width_chars, pl_iu);
+ Xg_define_procedure(gtk_target_list_add_text_targets, gxg_gtk_target_list_add_text_targets_w, 2, 0, 0, H_gtk_target_list_add_text_targets, pl_tui);
+ Xg_define_procedure(gtk_target_list_add_image_targets, gxg_gtk_target_list_add_image_targets_w, 3, 0, 0, H_gtk_target_list_add_image_targets, pl_tuib);
+ Xg_define_procedure(gtk_target_list_add_uri_targets, gxg_gtk_target_list_add_uri_targets_w, 2, 0, 0, H_gtk_target_list_add_uri_targets, pl_tui);
+ Xg_define_procedure(gtk_selection_data_set_pixbuf, gxg_gtk_selection_data_set_pixbuf_w, 2, 0, 0, H_gtk_selection_data_set_pixbuf, pl_bu);
+ Xg_define_procedure(gtk_selection_data_get_pixbuf, gxg_gtk_selection_data_get_pixbuf_w, 1, 0, 0, H_gtk_selection_data_get_pixbuf, pl_pu);
+ Xg_define_procedure(gtk_selection_data_set_uris, gxg_gtk_selection_data_set_uris_w, 2, 0, 0, H_gtk_selection_data_set_uris, pl_bu);
+ Xg_define_procedure(gtk_selection_data_get_uris, gxg_gtk_selection_data_get_uris_w, 1, 0, 0, H_gtk_selection_data_get_uris, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_backspace, gxg_gtk_text_buffer_backspace_w, 4, 0, 0, H_gtk_text_buffer_backspace, pl_buub);
+ Xg_define_procedure(gtk_clipboard_set_image, gxg_gtk_clipboard_set_image_w, 2, 0, 0, H_gtk_clipboard_set_image, pl_tu);
+ Xg_define_procedure(gtk_clipboard_request_image, gxg_gtk_clipboard_request_image_w, 2, 1, 0, H_gtk_clipboard_request_image, pl_tut);
+ Xg_define_procedure(gtk_clipboard_wait_for_image, gxg_gtk_clipboard_wait_for_image_w, 1, 0, 0, H_gtk_clipboard_wait_for_image, pl_pu);
+ Xg_define_procedure(gtk_clipboard_wait_is_image_available, gxg_gtk_clipboard_wait_is_image_available_w, 1, 0, 0, H_gtk_clipboard_wait_is_image_available, pl_bu);
+ Xg_define_procedure(gtk_file_filter_add_pixbuf_formats, gxg_gtk_file_filter_add_pixbuf_formats_w, 1, 0, 0, H_gtk_file_filter_add_pixbuf_formats, pl_tu);
+ Xg_define_procedure(gtk_label_set_single_line_mode, gxg_gtk_label_set_single_line_mode_w, 2, 0, 0, H_gtk_label_set_single_line_mode, pl_tub);
+ Xg_define_procedure(gtk_label_get_single_line_mode, gxg_gtk_label_get_single_line_mode_w, 1, 0, 0, H_gtk_label_get_single_line_mode, pl_bu);
+ Xg_define_procedure(gtk_progress_bar_set_ellipsize, gxg_gtk_progress_bar_set_ellipsize_w, 2, 0, 0, H_gtk_progress_bar_set_ellipsize, pl_tui);
+ Xg_define_procedure(gtk_progress_bar_get_ellipsize, gxg_gtk_progress_bar_get_ellipsize_w, 1, 0, 0, H_gtk_progress_bar_get_ellipsize, pl_iu);
+ Xg_define_procedure(gtk_selection_data_targets_include_image, gxg_gtk_selection_data_targets_include_image_w, 2, 0, 0, H_gtk_selection_data_targets_include_image, pl_bub);
+ Xg_define_procedure(gtk_button_set_image, gxg_gtk_button_set_image_w, 2, 0, 0, H_gtk_button_set_image, pl_tu);
+ Xg_define_procedure(gtk_button_get_image, gxg_gtk_button_get_image_w, 1, 0, 0, H_gtk_button_get_image, pl_pu);
+ Xg_define_procedure(gtk_label_set_angle, gxg_gtk_label_set_angle_w, 2, 0, 0, H_gtk_label_set_angle, pl_tur);
+ Xg_define_procedure(gtk_label_get_angle, gxg_gtk_label_get_angle_w, 1, 0, 0, H_gtk_label_get_angle, pl_du);
+ Xg_define_procedure(gtk_menu_set_screen, gxg_gtk_menu_set_screen_w, 2, 0, 0, H_gtk_menu_set_screen, pl_tu);
+ Xg_define_procedure(pango_attr_underline_color_new, gxg_pango_attr_underline_color_new_w, 3, 0, 0, H_pango_attr_underline_color_new, pl_pi);
+ Xg_define_procedure(pango_attr_strikethrough_color_new, gxg_pango_attr_strikethrough_color_new_w, 3, 0, 0, H_pango_attr_strikethrough_color_new, pl_pi);
+ Xg_define_procedure(pango_renderer_draw_layout, gxg_pango_renderer_draw_layout_w, 4, 0, 0, H_pango_renderer_draw_layout, pl_tuui);
+ Xg_define_procedure(pango_renderer_draw_layout_line, gxg_pango_renderer_draw_layout_line_w, 4, 0, 0, H_pango_renderer_draw_layout_line, pl_tuui);
+ Xg_define_procedure(pango_renderer_draw_glyphs, gxg_pango_renderer_draw_glyphs_w, 5, 0, 0, H_pango_renderer_draw_glyphs, pl_tuuui);
+ Xg_define_procedure(pango_renderer_draw_rectangle, gxg_pango_renderer_draw_rectangle_w, 6, 0, 0, H_pango_renderer_draw_rectangle, pl_tui);
+ Xg_define_procedure(pango_renderer_draw_error_underline, gxg_pango_renderer_draw_error_underline_w, 5, 0, 0, H_pango_renderer_draw_error_underline, pl_tui);
+ Xg_define_procedure(pango_renderer_draw_trapezoid, gxg_pango_renderer_draw_trapezoid_w, 0, 0, 1, H_pango_renderer_draw_trapezoid, pl_tuir);
+ Xg_define_procedure(pango_renderer_draw_glyph, gxg_pango_renderer_draw_glyph_w, 5, 0, 0, H_pango_renderer_draw_glyph, pl_tuuir);
+ Xg_define_procedure(pango_renderer_activate, gxg_pango_renderer_activate_w, 1, 0, 0, H_pango_renderer_activate, pl_tu);
+ Xg_define_procedure(pango_renderer_deactivate, gxg_pango_renderer_deactivate_w, 1, 0, 0, H_pango_renderer_deactivate, pl_tu);
+ Xg_define_procedure(pango_renderer_part_changed, gxg_pango_renderer_part_changed_w, 2, 0, 0, H_pango_renderer_part_changed, pl_tui);
+ Xg_define_procedure(pango_renderer_set_color, gxg_pango_renderer_set_color_w, 3, 0, 0, H_pango_renderer_set_color, pl_tuiu);
+ Xg_define_procedure(pango_renderer_get_color, gxg_pango_renderer_get_color_w, 2, 0, 0, H_pango_renderer_get_color, pl_pui);
+ Xg_define_procedure(pango_renderer_set_matrix, gxg_pango_renderer_set_matrix_w, 2, 0, 0, H_pango_renderer_set_matrix, pl_tu);
+ Xg_define_procedure(g_log_set_handler, gxg_g_log_set_handler_w, 3, 1, 0, H_g_log_set_handler, pl_isit);
+ Xg_define_procedure(g_log_remove_handler, gxg_g_log_remove_handler_w, 2, 0, 0, H_g_log_remove_handler, pl_tsi);
+ Xg_define_procedure(gtk_cell_renderer_stop_editing, gxg_gtk_cell_renderer_stop_editing_w, 2, 0, 0, H_gtk_cell_renderer_stop_editing, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_button_new, gxg_gtk_file_chooser_button_new_w, 2, 0, 0, H_gtk_file_chooser_button_new, pl_psi);
+ Xg_define_procedure(gtk_icon_view_set_columns, gxg_gtk_icon_view_set_columns_w, 2, 0, 0, H_gtk_icon_view_set_columns, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_columns, gxg_gtk_icon_view_get_columns_w, 1, 0, 0, H_gtk_icon_view_get_columns, pl_iu);
+ Xg_define_procedure(gtk_icon_view_set_item_width, gxg_gtk_icon_view_set_item_width_w, 2, 0, 0, H_gtk_icon_view_set_item_width, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_item_width, gxg_gtk_icon_view_get_item_width_w, 1, 0, 0, H_gtk_icon_view_get_item_width, pl_iu);
+ Xg_define_procedure(gtk_icon_view_set_spacing, gxg_gtk_icon_view_set_spacing_w, 2, 0, 0, H_gtk_icon_view_set_spacing, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_spacing, gxg_gtk_icon_view_get_spacing_w, 1, 0, 0, H_gtk_icon_view_get_spacing, pl_iu);
+ Xg_define_procedure(gtk_icon_view_set_row_spacing, gxg_gtk_icon_view_set_row_spacing_w, 2, 0, 0, H_gtk_icon_view_set_row_spacing, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_row_spacing, gxg_gtk_icon_view_get_row_spacing_w, 1, 0, 0, H_gtk_icon_view_get_row_spacing, pl_iu);
+ Xg_define_procedure(gtk_icon_view_set_column_spacing, gxg_gtk_icon_view_set_column_spacing_w, 2, 0, 0, H_gtk_icon_view_set_column_spacing, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_column_spacing, gxg_gtk_icon_view_get_column_spacing_w, 1, 0, 0, H_gtk_icon_view_get_column_spacing, pl_iu);
+ Xg_define_procedure(gtk_icon_view_set_margin, gxg_gtk_icon_view_set_margin_w, 2, 0, 0, H_gtk_icon_view_set_margin, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_margin, gxg_gtk_icon_view_get_margin_w, 1, 0, 0, H_gtk_icon_view_get_margin, pl_iu);
+ Xg_define_procedure(gtk_label_set_max_width_chars, gxg_gtk_label_set_max_width_chars_w, 2, 0, 0, H_gtk_label_set_max_width_chars, pl_tui);
+ Xg_define_procedure(gtk_label_get_max_width_chars, gxg_gtk_label_get_max_width_chars_w, 1, 0, 0, H_gtk_label_get_max_width_chars, pl_iu);
+ Xg_define_procedure(gtk_list_store_insert_with_values, gxg_gtk_list_store_insert_with_values_w, 3, 0, 0, H_gtk_list_store_insert_with_values, pl_tuui);
+ Xg_define_procedure(gtk_list_store_insert_with_valuesv, gxg_gtk_list_store_insert_with_valuesv_w, 6, 0, 0, H_gtk_list_store_insert_with_valuesv, pl_tuuiuui);
+ Xg_define_procedure(gtk_text_view_get_iter_at_position, gxg_gtk_text_view_get_iter_at_position_w, 4, 1, 0, H_gtk_text_view_get_iter_at_position, pl_tuuui);
+ Xg_define_procedure(pango_attr_size_new_absolute, gxg_pango_attr_size_new_absolute_w, 1, 0, 0, H_pango_attr_size_new_absolute, pl_pi);
+ Xg_define_procedure(pango_font_description_set_absolute_size, gxg_pango_font_description_set_absolute_size_w, 2, 0, 0, H_pango_font_description_set_absolute_size, pl_tur);
+ Xg_define_procedure(pango_layout_get_font_description, gxg_pango_layout_get_font_description_w, 1, 0, 0, H_pango_layout_get_font_description, pl_pu);
+ Xg_define_procedure(gdk_cursor_new_from_name, gxg_gdk_cursor_new_from_name_w, 2, 0, 0, H_gdk_cursor_new_from_name, pl_pus);
+ Xg_define_procedure(gdk_cursor_get_image, gxg_gdk_cursor_get_image_w, 1, 0, 0, H_gdk_cursor_get_image, pl_pu);
+ Xg_define_procedure(gdk_screen_get_rgba_visual, gxg_gdk_screen_get_rgba_visual_w, 1, 0, 0, H_gdk_screen_get_rgba_visual, pl_pu);
+ Xg_define_procedure(gdk_window_set_urgency_hint, gxg_gdk_window_set_urgency_hint_w, 2, 0, 0, H_gdk_window_set_urgency_hint, pl_tub);
+ Xg_define_procedure(gtk_dialog_get_response_for_widget, gxg_gtk_dialog_get_response_for_widget_w, 2, 0, 0, H_gtk_dialog_get_response_for_widget, pl_iu);
+ Xg_define_procedure(gtk_drag_source_set_icon_name, gxg_gtk_drag_source_set_icon_name_w, 2, 0, 0, H_gtk_drag_source_set_icon_name, pl_tus);
+ Xg_define_procedure(gtk_drag_set_icon_name, gxg_gtk_drag_set_icon_name_w, 4, 0, 0, H_gtk_drag_set_icon_name, pl_tusi);
+ Xg_define_procedure(gtk_entry_completion_set_popup_set_width, gxg_gtk_entry_completion_set_popup_set_width_w, 2, 0, 0, H_gtk_entry_completion_set_popup_set_width, pl_tub);
+ Xg_define_procedure(gtk_entry_completion_get_popup_set_width, gxg_gtk_entry_completion_get_popup_set_width_w, 1, 0, 0, H_gtk_entry_completion_get_popup_set_width, pl_bu);
+ Xg_define_procedure(gtk_entry_completion_set_popup_single_match, gxg_gtk_entry_completion_set_popup_single_match_w, 2, 0, 0, H_gtk_entry_completion_set_popup_single_match, pl_tub);
+ Xg_define_procedure(gtk_entry_completion_get_popup_single_match, gxg_gtk_entry_completion_get_popup_single_match_w, 1, 0, 0, H_gtk_entry_completion_get_popup_single_match, pl_bu);
+ Xg_define_procedure(gtk_icon_view_get_item_at_pos, gxg_gtk_icon_view_get_item_at_pos_w, 3, 2, 0, H_gtk_icon_view_get_item_at_pos, pl_buiiu);
+ Xg_define_procedure(gtk_icon_view_get_visible_range, gxg_gtk_icon_view_get_visible_range_w, 1, 2, 0, H_gtk_icon_view_get_visible_range, pl_bu);
+ Xg_define_procedure(gtk_icon_view_set_cursor, gxg_gtk_icon_view_set_cursor_w, 4, 0, 0, H_gtk_icon_view_set_cursor, pl_tuuub);
+ Xg_define_procedure(gtk_icon_view_get_cursor, gxg_gtk_icon_view_get_cursor_w, 1, 2, 0, H_gtk_icon_view_get_cursor, pl_bu);
+ Xg_define_procedure(gtk_icon_view_scroll_to_path, gxg_gtk_icon_view_scroll_to_path_w, 5, 0, 0, H_gtk_icon_view_scroll_to_path, pl_tuubr);
+ Xg_define_procedure(gtk_icon_view_enable_model_drag_source, gxg_gtk_icon_view_enable_model_drag_source_w, 5, 0, 0, H_gtk_icon_view_enable_model_drag_source, pl_tuiui);
+ Xg_define_procedure(gtk_icon_view_enable_model_drag_dest, gxg_gtk_icon_view_enable_model_drag_dest_w, 4, 0, 0, H_gtk_icon_view_enable_model_drag_dest, pl_tuui);
+ Xg_define_procedure(gtk_icon_view_unset_model_drag_source, gxg_gtk_icon_view_unset_model_drag_source_w, 1, 0, 0, H_gtk_icon_view_unset_model_drag_source, pl_tu);
+ Xg_define_procedure(gtk_icon_view_unset_model_drag_dest, gxg_gtk_icon_view_unset_model_drag_dest_w, 1, 0, 0, H_gtk_icon_view_unset_model_drag_dest, pl_tu);
+ Xg_define_procedure(gtk_icon_view_set_reorderable, gxg_gtk_icon_view_set_reorderable_w, 2, 0, 0, H_gtk_icon_view_set_reorderable, pl_tub);
+ Xg_define_procedure(gtk_icon_view_get_reorderable, gxg_gtk_icon_view_get_reorderable_w, 1, 0, 0, H_gtk_icon_view_get_reorderable, pl_bu);
+ Xg_define_procedure(gtk_icon_view_set_drag_dest_item, gxg_gtk_icon_view_set_drag_dest_item_w, 3, 0, 0, H_gtk_icon_view_set_drag_dest_item, pl_tuui);
+ Xg_define_procedure(gtk_icon_view_get_drag_dest_item, gxg_gtk_icon_view_get_drag_dest_item_w, 1, 2, 0, H_gtk_icon_view_get_drag_dest_item, pl_tu);
+ Xg_define_procedure(gtk_icon_view_get_dest_item_at_pos, gxg_gtk_icon_view_get_dest_item_at_pos_w, 3, 2, 0, H_gtk_icon_view_get_dest_item_at_pos, pl_buiiu);
+ Xg_define_procedure(gtk_image_clear, gxg_gtk_image_clear_w, 1, 0, 0, H_gtk_image_clear, pl_tu);
+ Xg_define_procedure(gtk_menu_bar_get_pack_direction, gxg_gtk_menu_bar_get_pack_direction_w, 1, 0, 0, H_gtk_menu_bar_get_pack_direction, pl_iu);
+ Xg_define_procedure(gtk_menu_bar_set_pack_direction, gxg_gtk_menu_bar_set_pack_direction_w, 2, 0, 0, H_gtk_menu_bar_set_pack_direction, pl_tui);
+ Xg_define_procedure(gtk_menu_bar_get_child_pack_direction, gxg_gtk_menu_bar_get_child_pack_direction_w, 1, 0, 0, H_gtk_menu_bar_get_child_pack_direction, pl_iu);
+ Xg_define_procedure(gtk_menu_bar_set_child_pack_direction, gxg_gtk_menu_bar_set_child_pack_direction_w, 2, 0, 0, H_gtk_menu_bar_set_child_pack_direction, pl_tui);
+ Xg_define_procedure(gtk_menu_shell_get_take_focus, gxg_gtk_menu_shell_get_take_focus_w, 1, 0, 0, H_gtk_menu_shell_get_take_focus, pl_bu);
+ Xg_define_procedure(gtk_menu_shell_set_take_focus, gxg_gtk_menu_shell_set_take_focus_w, 2, 0, 0, H_gtk_menu_shell_set_take_focus, pl_tub);
+ Xg_define_procedure(gtk_size_group_set_ignore_hidden, gxg_gtk_size_group_set_ignore_hidden_w, 2, 0, 0, H_gtk_size_group_set_ignore_hidden, pl_tub);
+ Xg_define_procedure(gtk_size_group_get_ignore_hidden, gxg_gtk_size_group_get_ignore_hidden_w, 1, 0, 0, H_gtk_size_group_get_ignore_hidden, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_visible_line, gxg_gtk_text_iter_forward_visible_line_w, 1, 0, 0, H_gtk_text_iter_forward_visible_line, pl_bu);
+ Xg_define_procedure(gtk_text_iter_backward_visible_line, gxg_gtk_text_iter_backward_visible_line_w, 1, 0, 0, H_gtk_text_iter_backward_visible_line, pl_bu);
+ Xg_define_procedure(gtk_text_iter_forward_visible_lines, gxg_gtk_text_iter_forward_visible_lines_w, 2, 0, 0, H_gtk_text_iter_forward_visible_lines, pl_bui);
+ Xg_define_procedure(gtk_text_iter_backward_visible_lines, gxg_gtk_text_iter_backward_visible_lines_w, 2, 0, 0, H_gtk_text_iter_backward_visible_lines, pl_bui);
+ Xg_define_procedure(gtk_tool_button_set_icon_name, gxg_gtk_tool_button_set_icon_name_w, 2, 0, 0, H_gtk_tool_button_set_icon_name, pl_tus);
+ Xg_define_procedure(gtk_tool_button_get_icon_name, gxg_gtk_tool_button_get_icon_name_w, 1, 0, 0, H_gtk_tool_button_get_icon_name, pl_su);
+ Xg_define_procedure(gtk_window_set_urgency_hint, gxg_gtk_window_set_urgency_hint_w, 2, 0, 0, H_gtk_window_set_urgency_hint, pl_tub);
+ Xg_define_procedure(gtk_window_get_urgency_hint, gxg_gtk_window_get_urgency_hint_w, 1, 0, 0, H_gtk_window_get_urgency_hint, pl_bu);
+ Xg_define_procedure(gtk_window_present_with_time, gxg_gtk_window_present_with_time_w, 2, 0, 0, H_gtk_window_present_with_time, pl_tui);
+ Xg_define_procedure(gtk_file_chooser_set_do_overwrite_confirmation, gxg_gtk_file_chooser_set_do_overwrite_confirmation_w, 2, 0, 0, H_gtk_file_chooser_set_do_overwrite_confirmation, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_get_do_overwrite_confirmation, gxg_gtk_file_chooser_get_do_overwrite_confirmation_w, 1, 0, 0, H_gtk_file_chooser_get_do_overwrite_confirmation, pl_bu);
+ Xg_define_procedure(gtk_tree_row_reference_get_model, gxg_gtk_tree_row_reference_get_model_w, 1, 0, 0, H_gtk_tree_row_reference_get_model, pl_pu);
+ Xg_define_procedure(gtk_tree_view_column_queue_resize, gxg_gtk_tree_view_column_queue_resize_w, 1, 0, 0, H_gtk_tree_view_column_queue_resize, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_visible_range, gxg_gtk_tree_view_get_visible_range_w, 1, 2, 0, H_gtk_tree_view_get_visible_range, pl_bu);
+ Xg_define_procedure(gtk_text_attributes_ref, gxg_gtk_text_attributes_ref_w, 1, 0, 0, H_gtk_text_attributes_ref, pl_pu);
+ Xg_define_procedure(pango_attr_list_ref, gxg_pango_attr_list_ref_w, 1, 0, 0, H_pango_attr_list_ref, pl_pu);
+ Xg_define_procedure(pango_layout_line_ref, gxg_pango_layout_line_ref_w, 1, 0, 0, H_pango_layout_line_ref, pl_pu);
+ Xg_define_procedure(pango_layout_index_to_line_x, gxg_pango_layout_index_to_line_x_w, 3, 2, 0, H_pango_layout_index_to_line_x, pl_tuibu);
+ Xg_define_procedure(gtk_target_list_ref, gxg_gtk_target_list_ref_w, 1, 0, 0, H_gtk_target_list_ref, pl_pu);
+ Xg_define_procedure(gdk_display_supports_shapes, gxg_gdk_display_supports_shapes_w, 1, 0, 0, H_gdk_display_supports_shapes, pl_bu);
+ Xg_define_procedure(gdk_display_supports_input_shapes, gxg_gdk_display_supports_input_shapes_w, 1, 0, 0, H_gdk_display_supports_input_shapes, pl_bu);
+ Xg_define_procedure(gdk_screen_is_composited, gxg_gdk_screen_is_composited_w, 1, 0, 0, H_gdk_screen_is_composited, pl_bu);
+ Xg_define_procedure(gdk_screen_set_resolution, gxg_gdk_screen_set_resolution_w, 2, 0, 0, H_gdk_screen_set_resolution, pl_tur);
+ Xg_define_procedure(gdk_screen_get_resolution, gxg_gdk_screen_get_resolution_w, 1, 0, 0, H_gdk_screen_get_resolution, pl_du);
+ Xg_define_procedure(gdk_screen_get_active_window, gxg_gdk_screen_get_active_window_w, 1, 0, 0, H_gdk_screen_get_active_window, pl_pu);
+ Xg_define_procedure(gdk_screen_get_window_stack, gxg_gdk_screen_get_window_stack_w, 1, 0, 0, H_gdk_screen_get_window_stack, pl_pu);
+ Xg_define_procedure(gdk_window_get_type_hint, gxg_gdk_window_get_type_hint_w, 1, 0, 0, H_gdk_window_get_type_hint, pl_iu);
+ Xg_define_procedure(gtk_clipboard_request_rich_text, gxg_gtk_clipboard_request_rich_text_w, 3, 1, 0, H_gtk_clipboard_request_rich_text, pl_tuut);
+ Xg_define_procedure(gtk_clipboard_wait_for_rich_text, gxg_gtk_clipboard_wait_for_rich_text_w, 3, 1, 0, H_gtk_clipboard_wait_for_rich_text, pl_pu);
+ Xg_define_procedure(gtk_clipboard_wait_is_rich_text_available, gxg_gtk_clipboard_wait_is_rich_text_available_w, 2, 0, 0, H_gtk_clipboard_wait_is_rich_text_available, pl_bu);
+ Xg_define_procedure(gtk_drag_dest_set_track_motion, gxg_gtk_drag_dest_set_track_motion_w, 2, 0, 0, H_gtk_drag_dest_set_track_motion, pl_tub);
+ Xg_define_procedure(gtk_drag_dest_get_track_motion, gxg_gtk_drag_dest_get_track_motion_w, 1, 0, 0, H_gtk_drag_dest_get_track_motion, pl_bu);
+ Xg_define_procedure(gtk_notebook_get_tab_reorderable, gxg_gtk_notebook_get_tab_reorderable_w, 2, 0, 0, H_gtk_notebook_get_tab_reorderable, pl_bu);
+ Xg_define_procedure(gtk_notebook_set_tab_reorderable, gxg_gtk_notebook_set_tab_reorderable_w, 3, 0, 0, H_gtk_notebook_set_tab_reorderable, pl_tuub);
+ Xg_define_procedure(gtk_notebook_get_tab_detachable, gxg_gtk_notebook_get_tab_detachable_w, 2, 0, 0, H_gtk_notebook_get_tab_detachable, pl_bu);
+ Xg_define_procedure(gtk_notebook_set_tab_detachable, gxg_gtk_notebook_set_tab_detachable_w, 3, 0, 0, H_gtk_notebook_set_tab_detachable, pl_tuub);
+ Xg_define_procedure(gtk_range_set_lower_stepper_sensitivity, gxg_gtk_range_set_lower_stepper_sensitivity_w, 2, 0, 0, H_gtk_range_set_lower_stepper_sensitivity, pl_tui);
+ Xg_define_procedure(gtk_range_get_lower_stepper_sensitivity, gxg_gtk_range_get_lower_stepper_sensitivity_w, 1, 0, 0, H_gtk_range_get_lower_stepper_sensitivity, pl_iu);
+ Xg_define_procedure(gtk_range_set_upper_stepper_sensitivity, gxg_gtk_range_set_upper_stepper_sensitivity_w, 2, 0, 0, H_gtk_range_set_upper_stepper_sensitivity, pl_tui);
+ Xg_define_procedure(gtk_range_get_upper_stepper_sensitivity, gxg_gtk_range_get_upper_stepper_sensitivity_w, 1, 0, 0, H_gtk_range_get_upper_stepper_sensitivity, pl_iu);
+ Xg_define_procedure(gtk_scrolled_window_unset_placement, gxg_gtk_scrolled_window_unset_placement_w, 1, 0, 0, H_gtk_scrolled_window_unset_placement, pl_tu);
+ Xg_define_procedure(gtk_target_list_add_rich_text_targets, gxg_gtk_target_list_add_rich_text_targets_w, 4, 0, 0, H_gtk_target_list_add_rich_text_targets, pl_tuibu);
+ Xg_define_procedure(gtk_target_table_new_from_list, gxg_gtk_target_table_new_from_list_w, 1, 1, 0, H_gtk_target_table_new_from_list, pl_pu);
+ Xg_define_procedure(gtk_target_table_free, gxg_gtk_target_table_free_w, 2, 0, 0, H_gtk_target_table_free, pl_tui);
+ Xg_define_procedure(gtk_selection_data_targets_include_rich_text, gxg_gtk_selection_data_targets_include_rich_text_w, 2, 0, 0, H_gtk_selection_data_targets_include_rich_text, pl_bu);
+ Xg_define_procedure(gtk_selection_data_targets_include_uri, gxg_gtk_selection_data_targets_include_uri_w, 1, 0, 0, H_gtk_selection_data_targets_include_uri, pl_bu);
+ Xg_define_procedure(gtk_targets_include_text, gxg_gtk_targets_include_text_w, 2, 0, 0, H_gtk_targets_include_text, pl_bui);
+ Xg_define_procedure(gtk_targets_include_rich_text, gxg_gtk_targets_include_rich_text_w, 3, 0, 0, H_gtk_targets_include_rich_text, pl_buiu);
+ Xg_define_procedure(gtk_targets_include_image, gxg_gtk_targets_include_image_w, 3, 0, 0, H_gtk_targets_include_image, pl_buib);
+ Xg_define_procedure(gtk_targets_include_uri, gxg_gtk_targets_include_uri_w, 2, 0, 0, H_gtk_targets_include_uri, pl_bui);
+ Xg_define_procedure(gtk_size_group_get_widgets, gxg_gtk_size_group_get_widgets_w, 1, 0, 0, H_gtk_size_group_get_widgets, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_get_has_selection, gxg_gtk_text_buffer_get_has_selection_w, 1, 0, 0, H_gtk_text_buffer_get_has_selection, pl_bu);
+ Xg_define_procedure(gtk_text_buffer_get_copy_target_list, gxg_gtk_text_buffer_get_copy_target_list_w, 1, 0, 0, H_gtk_text_buffer_get_copy_target_list, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_get_paste_target_list, gxg_gtk_text_buffer_get_paste_target_list_w, 1, 0, 0, H_gtk_text_buffer_get_paste_target_list, pl_pu);
+ Xg_define_procedure(gtk_tree_view_get_headers_clickable, gxg_gtk_tree_view_get_headers_clickable_w, 1, 0, 0, H_gtk_tree_view_get_headers_clickable, pl_bu);
+ Xg_define_procedure(gtk_tree_view_get_search_entry, gxg_gtk_tree_view_get_search_entry_w, 1, 0, 0, H_gtk_tree_view_get_search_entry, pl_pu);
+ Xg_define_procedure(gtk_tree_view_set_search_entry, gxg_gtk_tree_view_set_search_entry_w, 2, 0, 0, H_gtk_tree_view_set_search_entry, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_search_position_func, gxg_gtk_tree_view_get_search_position_func_w, 1, 0, 0, H_gtk_tree_view_get_search_position_func, pl_tu);
+ Xg_define_procedure(gtk_tree_view_set_search_position_func, gxg_gtk_tree_view_set_search_position_func_w, 3, 1, 0, H_gtk_tree_view_set_search_position_func, pl_tut);
+ Xg_define_procedure(gtk_widget_is_composited, gxg_gtk_widget_is_composited_w, 1, 0, 0, H_gtk_widget_is_composited, pl_bu);
+ Xg_define_procedure(gtk_window_set_deletable, gxg_gtk_window_set_deletable_w, 2, 0, 0, H_gtk_window_set_deletable, pl_tub);
+ Xg_define_procedure(gtk_window_get_deletable, gxg_gtk_window_get_deletable_w, 1, 0, 0, H_gtk_window_get_deletable, pl_bu);
+ Xg_define_procedure(gtk_assistant_new, gxg_gtk_assistant_new_w, 0, 0, 0, H_gtk_assistant_new, pl_p);
+ Xg_define_procedure(gtk_assistant_get_current_page, gxg_gtk_assistant_get_current_page_w, 1, 0, 0, H_gtk_assistant_get_current_page, pl_iu);
+ Xg_define_procedure(gtk_assistant_set_current_page, gxg_gtk_assistant_set_current_page_w, 2, 0, 0, H_gtk_assistant_set_current_page, pl_tui);
+ Xg_define_procedure(gtk_assistant_get_n_pages, gxg_gtk_assistant_get_n_pages_w, 1, 0, 0, H_gtk_assistant_get_n_pages, pl_iu);
+ Xg_define_procedure(gtk_assistant_get_nth_page, gxg_gtk_assistant_get_nth_page_w, 2, 0, 0, H_gtk_assistant_get_nth_page, pl_pui);
+ Xg_define_procedure(gtk_assistant_prepend_page, gxg_gtk_assistant_prepend_page_w, 2, 0, 0, H_gtk_assistant_prepend_page, pl_iu);
+ Xg_define_procedure(gtk_assistant_append_page, gxg_gtk_assistant_append_page_w, 2, 0, 0, H_gtk_assistant_append_page, pl_iu);
+ Xg_define_procedure(gtk_assistant_insert_page, gxg_gtk_assistant_insert_page_w, 3, 0, 0, H_gtk_assistant_insert_page, pl_iuui);
+ Xg_define_procedure(gtk_assistant_set_forward_page_func, gxg_gtk_assistant_set_forward_page_func_w, 3, 1, 0, H_gtk_assistant_set_forward_page_func, pl_tut);
+ Xg_define_procedure(gtk_assistant_set_page_type, gxg_gtk_assistant_set_page_type_w, 3, 0, 0, H_gtk_assistant_set_page_type, pl_tuui);
+ Xg_define_procedure(gtk_assistant_get_page_type, gxg_gtk_assistant_get_page_type_w, 2, 0, 0, H_gtk_assistant_get_page_type, pl_iu);
+ Xg_define_procedure(gtk_assistant_set_page_title, gxg_gtk_assistant_set_page_title_w, 3, 0, 0, H_gtk_assistant_set_page_title, pl_tuus);
+ Xg_define_procedure(gtk_assistant_get_page_title, gxg_gtk_assistant_get_page_title_w, 2, 0, 0, H_gtk_assistant_get_page_title, pl_su);
+ Xg_define_procedure(gtk_assistant_set_page_complete, gxg_gtk_assistant_set_page_complete_w, 3, 0, 0, H_gtk_assistant_set_page_complete, pl_tuub);
+ Xg_define_procedure(gtk_assistant_get_page_complete, gxg_gtk_assistant_get_page_complete_w, 2, 0, 0, H_gtk_assistant_get_page_complete, pl_bu);
+ Xg_define_procedure(gtk_assistant_add_action_widget, gxg_gtk_assistant_add_action_widget_w, 2, 0, 0, H_gtk_assistant_add_action_widget, pl_tu);
+ Xg_define_procedure(gtk_assistant_remove_action_widget, gxg_gtk_assistant_remove_action_widget_w, 2, 0, 0, H_gtk_assistant_remove_action_widget, pl_tu);
+ Xg_define_procedure(gtk_assistant_update_buttons_state, gxg_gtk_assistant_update_buttons_state_w, 1, 0, 0, H_gtk_assistant_update_buttons_state, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_accel_new, gxg_gtk_cell_renderer_accel_new_w, 0, 0, 0, H_gtk_cell_renderer_accel_new, pl_p);
+ Xg_define_procedure(gtk_cell_renderer_spin_new, gxg_gtk_cell_renderer_spin_new_w, 0, 0, 0, H_gtk_cell_renderer_spin_new, pl_p);
+ Xg_define_procedure(gtk_link_button_new, gxg_gtk_link_button_new_w, 1, 0, 0, H_gtk_link_button_new, pl_ps);
+ Xg_define_procedure(gtk_link_button_new_with_label, gxg_gtk_link_button_new_with_label_w, 2, 0, 0, H_gtk_link_button_new_with_label, pl_ps);
+ Xg_define_procedure(gtk_link_button_get_uri, gxg_gtk_link_button_get_uri_w, 1, 0, 0, H_gtk_link_button_get_uri, pl_su);
+ Xg_define_procedure(gtk_link_button_set_uri, gxg_gtk_link_button_set_uri_w, 2, 0, 0, H_gtk_link_button_set_uri, pl_tus);
+ Xg_define_procedure(gtk_recent_chooser_error_quark, gxg_gtk_recent_chooser_error_quark_w, 0, 0, 0, H_gtk_recent_chooser_error_quark, pl_i);
+ Xg_define_procedure(gtk_recent_chooser_set_show_private, gxg_gtk_recent_chooser_set_show_private_w, 2, 0, 0, H_gtk_recent_chooser_set_show_private, pl_tub);
+ Xg_define_procedure(gtk_recent_chooser_get_show_private, gxg_gtk_recent_chooser_get_show_private_w, 1, 0, 0, H_gtk_recent_chooser_get_show_private, pl_bu);
+ Xg_define_procedure(gtk_recent_chooser_set_show_not_found, gxg_gtk_recent_chooser_set_show_not_found_w, 2, 0, 0, H_gtk_recent_chooser_set_show_not_found, pl_tub);
+ Xg_define_procedure(gtk_recent_chooser_get_show_not_found, gxg_gtk_recent_chooser_get_show_not_found_w, 1, 0, 0, H_gtk_recent_chooser_get_show_not_found, pl_bu);
+ Xg_define_procedure(gtk_recent_chooser_set_select_multiple, gxg_gtk_recent_chooser_set_select_multiple_w, 2, 0, 0, H_gtk_recent_chooser_set_select_multiple, pl_tub);
+ Xg_define_procedure(gtk_recent_chooser_get_select_multiple, gxg_gtk_recent_chooser_get_select_multiple_w, 1, 0, 0, H_gtk_recent_chooser_get_select_multiple, pl_bu);
+ Xg_define_procedure(gtk_recent_chooser_set_limit, gxg_gtk_recent_chooser_set_limit_w, 2, 0, 0, H_gtk_recent_chooser_set_limit, pl_tui);
+ Xg_define_procedure(gtk_recent_chooser_get_limit, gxg_gtk_recent_chooser_get_limit_w, 1, 0, 0, H_gtk_recent_chooser_get_limit, pl_iu);
+ Xg_define_procedure(gtk_recent_chooser_set_local_only, gxg_gtk_recent_chooser_set_local_only_w, 2, 0, 0, H_gtk_recent_chooser_set_local_only, pl_tub);
+ Xg_define_procedure(gtk_recent_chooser_get_local_only, gxg_gtk_recent_chooser_get_local_only_w, 1, 0, 0, H_gtk_recent_chooser_get_local_only, pl_bu);
+ Xg_define_procedure(gtk_recent_chooser_set_show_tips, gxg_gtk_recent_chooser_set_show_tips_w, 2, 0, 0, H_gtk_recent_chooser_set_show_tips, pl_tub);
+ Xg_define_procedure(gtk_recent_chooser_get_show_tips, gxg_gtk_recent_chooser_get_show_tips_w, 1, 0, 0, H_gtk_recent_chooser_get_show_tips, pl_bu);
+ Xg_define_procedure(gtk_recent_chooser_set_show_icons, gxg_gtk_recent_chooser_set_show_icons_w, 2, 0, 0, H_gtk_recent_chooser_set_show_icons, pl_tub);
+ Xg_define_procedure(gtk_recent_chooser_get_show_icons, gxg_gtk_recent_chooser_get_show_icons_w, 1, 0, 0, H_gtk_recent_chooser_get_show_icons, pl_bu);
+ Xg_define_procedure(gtk_recent_chooser_set_sort_type, gxg_gtk_recent_chooser_set_sort_type_w, 2, 0, 0, H_gtk_recent_chooser_set_sort_type, pl_tui);
+ Xg_define_procedure(gtk_recent_chooser_get_sort_type, gxg_gtk_recent_chooser_get_sort_type_w, 1, 0, 0, H_gtk_recent_chooser_get_sort_type, pl_iu);
+ Xg_define_procedure(gtk_recent_chooser_set_sort_func, gxg_gtk_recent_chooser_set_sort_func_w, 3, 1, 0, H_gtk_recent_chooser_set_sort_func, pl_tut);
+ Xg_define_procedure(gtk_recent_chooser_set_current_uri, gxg_gtk_recent_chooser_set_current_uri_w, 2, 1, 0, H_gtk_recent_chooser_set_current_uri, pl_busu);
+ Xg_define_procedure(gtk_recent_chooser_get_current_uri, gxg_gtk_recent_chooser_get_current_uri_w, 1, 0, 0, H_gtk_recent_chooser_get_current_uri, pl_su);
+ Xg_define_procedure(gtk_recent_chooser_get_current_item, gxg_gtk_recent_chooser_get_current_item_w, 1, 0, 0, H_gtk_recent_chooser_get_current_item, pl_pu);
+ Xg_define_procedure(gtk_recent_chooser_select_uri, gxg_gtk_recent_chooser_select_uri_w, 2, 1, 0, H_gtk_recent_chooser_select_uri, pl_busu);
+ Xg_define_procedure(gtk_recent_chooser_unselect_uri, gxg_gtk_recent_chooser_unselect_uri_w, 2, 0, 0, H_gtk_recent_chooser_unselect_uri, pl_tus);
+ Xg_define_procedure(gtk_recent_chooser_select_all, gxg_gtk_recent_chooser_select_all_w, 1, 0, 0, H_gtk_recent_chooser_select_all, pl_tu);
+ Xg_define_procedure(gtk_recent_chooser_unselect_all, gxg_gtk_recent_chooser_unselect_all_w, 1, 0, 0, H_gtk_recent_chooser_unselect_all, pl_tu);
+ Xg_define_procedure(gtk_recent_chooser_get_items, gxg_gtk_recent_chooser_get_items_w, 1, 0, 0, H_gtk_recent_chooser_get_items, pl_pu);
+ Xg_define_procedure(gtk_recent_chooser_get_uris, gxg_gtk_recent_chooser_get_uris_w, 1, 1, 0, H_gtk_recent_chooser_get_uris, pl_pu);
+ Xg_define_procedure(gtk_recent_chooser_add_filter, gxg_gtk_recent_chooser_add_filter_w, 2, 0, 0, H_gtk_recent_chooser_add_filter, pl_tu);
+ Xg_define_procedure(gtk_recent_chooser_remove_filter, gxg_gtk_recent_chooser_remove_filter_w, 2, 0, 0, H_gtk_recent_chooser_remove_filter, pl_tu);
+ Xg_define_procedure(gtk_recent_chooser_list_filters, gxg_gtk_recent_chooser_list_filters_w, 1, 0, 0, H_gtk_recent_chooser_list_filters, pl_pu);
+ Xg_define_procedure(gtk_recent_chooser_set_filter, gxg_gtk_recent_chooser_set_filter_w, 2, 0, 0, H_gtk_recent_chooser_set_filter, pl_tu);
+ Xg_define_procedure(gtk_recent_chooser_get_filter, gxg_gtk_recent_chooser_get_filter_w, 1, 0, 0, H_gtk_recent_chooser_get_filter, pl_pu);
+ Xg_define_procedure(gtk_recent_chooser_menu_new, gxg_gtk_recent_chooser_menu_new_w, 0, 0, 0, H_gtk_recent_chooser_menu_new, pl_p);
+ Xg_define_procedure(gtk_recent_chooser_menu_new_for_manager, gxg_gtk_recent_chooser_menu_new_for_manager_w, 1, 0, 0, H_gtk_recent_chooser_menu_new_for_manager, pl_pu);
+ Xg_define_procedure(gtk_recent_chooser_menu_get_show_numbers, gxg_gtk_recent_chooser_menu_get_show_numbers_w, 1, 0, 0, H_gtk_recent_chooser_menu_get_show_numbers, pl_bu);
+ Xg_define_procedure(gtk_recent_chooser_menu_set_show_numbers, gxg_gtk_recent_chooser_menu_set_show_numbers_w, 2, 0, 0, H_gtk_recent_chooser_menu_set_show_numbers, pl_tub);
+ Xg_define_procedure(gtk_recent_chooser_widget_new, gxg_gtk_recent_chooser_widget_new_w, 0, 0, 0, H_gtk_recent_chooser_widget_new, pl_p);
+ Xg_define_procedure(gtk_recent_chooser_widget_new_for_manager, gxg_gtk_recent_chooser_widget_new_for_manager_w, 1, 0, 0, H_gtk_recent_chooser_widget_new_for_manager, pl_pu);
+ Xg_define_procedure(gtk_recent_filter_new, gxg_gtk_recent_filter_new_w, 0, 0, 0, H_gtk_recent_filter_new, pl_p);
+ Xg_define_procedure(gtk_recent_filter_set_name, gxg_gtk_recent_filter_set_name_w, 2, 0, 0, H_gtk_recent_filter_set_name, pl_tus);
+ Xg_define_procedure(gtk_recent_filter_get_name, gxg_gtk_recent_filter_get_name_w, 1, 0, 0, H_gtk_recent_filter_get_name, pl_su);
+ Xg_define_procedure(gtk_recent_filter_add_mime_type, gxg_gtk_recent_filter_add_mime_type_w, 2, 0, 0, H_gtk_recent_filter_add_mime_type, pl_tus);
+ Xg_define_procedure(gtk_recent_filter_add_pattern, gxg_gtk_recent_filter_add_pattern_w, 2, 0, 0, H_gtk_recent_filter_add_pattern, pl_tus);
+ Xg_define_procedure(gtk_recent_filter_add_pixbuf_formats, gxg_gtk_recent_filter_add_pixbuf_formats_w, 1, 0, 0, H_gtk_recent_filter_add_pixbuf_formats, pl_tu);
+ Xg_define_procedure(gtk_recent_filter_add_application, gxg_gtk_recent_filter_add_application_w, 2, 0, 0, H_gtk_recent_filter_add_application, pl_tus);
+ Xg_define_procedure(gtk_recent_filter_add_group, gxg_gtk_recent_filter_add_group_w, 2, 0, 0, H_gtk_recent_filter_add_group, pl_tus);
+ Xg_define_procedure(gtk_recent_filter_add_age, gxg_gtk_recent_filter_add_age_w, 2, 0, 0, H_gtk_recent_filter_add_age, pl_tui);
+ Xg_define_procedure(gtk_recent_manager_error_quark, gxg_gtk_recent_manager_error_quark_w, 0, 0, 0, H_gtk_recent_manager_error_quark, pl_i);
+ Xg_define_procedure(gtk_recent_manager_new, gxg_gtk_recent_manager_new_w, 0, 0, 0, H_gtk_recent_manager_new, pl_p);
+ Xg_define_procedure(gtk_recent_manager_get_default, gxg_gtk_recent_manager_get_default_w, 0, 0, 0, H_gtk_recent_manager_get_default, pl_p);
+ Xg_define_procedure(gtk_recent_manager_remove_item, gxg_gtk_recent_manager_remove_item_w, 2, 1, 0, H_gtk_recent_manager_remove_item, pl_busu);
+ Xg_define_procedure(gtk_recent_manager_lookup_item, gxg_gtk_recent_manager_lookup_item_w, 2, 1, 0, H_gtk_recent_manager_lookup_item, pl_pusu);
+ Xg_define_procedure(gtk_recent_manager_has_item, gxg_gtk_recent_manager_has_item_w, 2, 0, 0, H_gtk_recent_manager_has_item, pl_bus);
+ Xg_define_procedure(gtk_recent_manager_move_item, gxg_gtk_recent_manager_move_item_w, 3, 1, 0, H_gtk_recent_manager_move_item, pl_bussu);
+ Xg_define_procedure(gtk_recent_manager_get_items, gxg_gtk_recent_manager_get_items_w, 1, 0, 0, H_gtk_recent_manager_get_items, pl_pu);
+ Xg_define_procedure(gtk_recent_manager_purge_items, gxg_gtk_recent_manager_purge_items_w, 1, 1, 0, H_gtk_recent_manager_purge_items, pl_iu);
+ Xg_define_procedure(gtk_recent_info_ref, gxg_gtk_recent_info_ref_w, 1, 0, 0, H_gtk_recent_info_ref, pl_pu);
+ Xg_define_procedure(gtk_recent_info_unref, gxg_gtk_recent_info_unref_w, 1, 0, 0, H_gtk_recent_info_unref, pl_tu);
+ Xg_define_procedure(gtk_recent_info_get_uri, gxg_gtk_recent_info_get_uri_w, 1, 0, 0, H_gtk_recent_info_get_uri, pl_su);
+ Xg_define_procedure(gtk_recent_info_get_display_name, gxg_gtk_recent_info_get_display_name_w, 1, 0, 0, H_gtk_recent_info_get_display_name, pl_su);
+ Xg_define_procedure(gtk_recent_info_get_description, gxg_gtk_recent_info_get_description_w, 1, 0, 0, H_gtk_recent_info_get_description, pl_su);
+ Xg_define_procedure(gtk_recent_info_get_mime_type, gxg_gtk_recent_info_get_mime_type_w, 1, 0, 0, H_gtk_recent_info_get_mime_type, pl_su);
+ Xg_define_procedure(gtk_recent_info_get_added, gxg_gtk_recent_info_get_added_w, 1, 0, 0, H_gtk_recent_info_get_added, pl_tu);
+ Xg_define_procedure(gtk_recent_info_get_modified, gxg_gtk_recent_info_get_modified_w, 1, 0, 0, H_gtk_recent_info_get_modified, pl_tu);
+ Xg_define_procedure(gtk_recent_info_get_visited, gxg_gtk_recent_info_get_visited_w, 1, 0, 0, H_gtk_recent_info_get_visited, pl_tu);
+ Xg_define_procedure(gtk_recent_info_get_private_hint, gxg_gtk_recent_info_get_private_hint_w, 1, 0, 0, H_gtk_recent_info_get_private_hint, pl_bu);
+ Xg_define_procedure(gtk_recent_info_get_applications, gxg_gtk_recent_info_get_applications_w, 1, 1, 0, H_gtk_recent_info_get_applications, pl_pu);
+ Xg_define_procedure(gtk_recent_info_last_application, gxg_gtk_recent_info_last_application_w, 1, 0, 0, H_gtk_recent_info_last_application, pl_su);
+ Xg_define_procedure(gtk_recent_info_has_application, gxg_gtk_recent_info_has_application_w, 2, 0, 0, H_gtk_recent_info_has_application, pl_bus);
+ Xg_define_procedure(gtk_recent_info_get_groups, gxg_gtk_recent_info_get_groups_w, 1, 1, 0, H_gtk_recent_info_get_groups, pl_pu);
+ Xg_define_procedure(gtk_recent_info_has_group, gxg_gtk_recent_info_has_group_w, 2, 0, 0, H_gtk_recent_info_has_group, pl_bus);
+ Xg_define_procedure(gtk_recent_info_get_icon, gxg_gtk_recent_info_get_icon_w, 2, 0, 0, H_gtk_recent_info_get_icon, pl_pui);
+ Xg_define_procedure(gtk_recent_info_get_short_name, gxg_gtk_recent_info_get_short_name_w, 1, 0, 0, H_gtk_recent_info_get_short_name, pl_su);
+ Xg_define_procedure(gtk_recent_info_get_uri_display, gxg_gtk_recent_info_get_uri_display_w, 1, 0, 0, H_gtk_recent_info_get_uri_display, pl_su);
+ Xg_define_procedure(gtk_recent_info_get_age, gxg_gtk_recent_info_get_age_w, 1, 0, 0, H_gtk_recent_info_get_age, pl_iu);
+ Xg_define_procedure(gtk_recent_info_is_local, gxg_gtk_recent_info_is_local_w, 1, 0, 0, H_gtk_recent_info_is_local, pl_bu);
+ Xg_define_procedure(gtk_recent_info_exists, gxg_gtk_recent_info_exists_w, 1, 0, 0, H_gtk_recent_info_exists, pl_bu);
+ Xg_define_procedure(gtk_recent_info_match, gxg_gtk_recent_info_match_w, 2, 0, 0, H_gtk_recent_info_match, pl_bu);
+ Xg_define_procedure(gtk_text_buffer_register_serialize_format, gxg_gtk_text_buffer_register_serialize_format_w, 5, 0, 0, H_gtk_text_buffer_register_serialize_format, pl_tust);
+ Xg_define_procedure(gtk_text_buffer_register_serialize_tagset, gxg_gtk_text_buffer_register_serialize_tagset_w, 2, 0, 0, H_gtk_text_buffer_register_serialize_tagset, pl_tus);
+ Xg_define_procedure(gtk_text_buffer_register_deserialize_format, gxg_gtk_text_buffer_register_deserialize_format_w, 5, 0, 0, H_gtk_text_buffer_register_deserialize_format, pl_tust);
+ Xg_define_procedure(gtk_text_buffer_register_deserialize_tagset, gxg_gtk_text_buffer_register_deserialize_tagset_w, 2, 0, 0, H_gtk_text_buffer_register_deserialize_tagset, pl_tus);
+ Xg_define_procedure(gtk_text_buffer_unregister_serialize_format, gxg_gtk_text_buffer_unregister_serialize_format_w, 2, 0, 0, H_gtk_text_buffer_unregister_serialize_format, pl_tut);
+ Xg_define_procedure(gtk_text_buffer_unregister_deserialize_format, gxg_gtk_text_buffer_unregister_deserialize_format_w, 2, 0, 0, H_gtk_text_buffer_unregister_deserialize_format, pl_tut);
+ Xg_define_procedure(gtk_text_buffer_deserialize_set_can_create_tags, gxg_gtk_text_buffer_deserialize_set_can_create_tags_w, 3, 0, 0, H_gtk_text_buffer_deserialize_set_can_create_tags, pl_tutb);
+ Xg_define_procedure(gtk_text_buffer_deserialize_get_can_create_tags, gxg_gtk_text_buffer_deserialize_get_can_create_tags_w, 2, 0, 0, H_gtk_text_buffer_deserialize_get_can_create_tags, pl_but);
+ Xg_define_procedure(gtk_text_buffer_get_serialize_formats, gxg_gtk_text_buffer_get_serialize_formats_w, 1, 1, 0, H_gtk_text_buffer_get_serialize_formats, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_get_deserialize_formats, gxg_gtk_text_buffer_get_deserialize_formats_w, 1, 1, 0, H_gtk_text_buffer_get_deserialize_formats, pl_pu);
+ Xg_define_procedure(gtk_text_buffer_serialize, gxg_gtk_text_buffer_serialize_w, 5, 1, 0, H_gtk_text_buffer_serialize, pl_puutu);
+ Xg_define_procedure(gtk_text_buffer_deserialize, gxg_gtk_text_buffer_deserialize_w, 6, 1, 0, H_gtk_text_buffer_deserialize, pl_buutuuiu);
+ Xg_define_procedure(gtk_recent_manager_add_item, gxg_gtk_recent_manager_add_item_w, 2, 0, 0, H_gtk_recent_manager_add_item, pl_bus);
+ Xg_define_procedure(gtk_recent_manager_add_full, gxg_gtk_recent_manager_add_full_w, 3, 0, 0, H_gtk_recent_manager_add_full, pl_busu);
+ Xg_define_procedure(gtk_tree_model_filter_convert_child_iter_to_iter, gxg_gtk_tree_model_filter_convert_child_iter_to_iter_w, 3, 0, 0, H_gtk_tree_model_filter_convert_child_iter_to_iter, pl_bu);
+ Xg_define_procedure(gtk_tree_view_get_grid_lines, gxg_gtk_tree_view_get_grid_lines_w, 1, 0, 0, H_gtk_tree_view_get_grid_lines, pl_iu);
+ Xg_define_procedure(gtk_tree_view_set_grid_lines, gxg_gtk_tree_view_set_grid_lines_w, 2, 0, 0, H_gtk_tree_view_set_grid_lines, pl_tui);
+ Xg_define_procedure(gtk_tree_view_get_enable_tree_lines, gxg_gtk_tree_view_get_enable_tree_lines_w, 1, 0, 0, H_gtk_tree_view_get_enable_tree_lines, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_enable_tree_lines, gxg_gtk_tree_view_set_enable_tree_lines_w, 2, 0, 0, H_gtk_tree_view_set_enable_tree_lines, pl_tub);
+ Xg_define_procedure(gtk_label_set_line_wrap_mode, gxg_gtk_label_set_line_wrap_mode_w, 2, 0, 0, H_gtk_label_set_line_wrap_mode, pl_tui);
+ Xg_define_procedure(gtk_label_get_line_wrap_mode, gxg_gtk_label_get_line_wrap_mode_w, 1, 0, 0, H_gtk_label_get_line_wrap_mode, pl_iu);
+ Xg_define_procedure(gtk_print_context_get_cairo_context, gxg_gtk_print_context_get_cairo_context_w, 1, 0, 0, H_gtk_print_context_get_cairo_context, pl_pu);
+ Xg_define_procedure(gtk_print_context_get_page_setup, gxg_gtk_print_context_get_page_setup_w, 1, 0, 0, H_gtk_print_context_get_page_setup, pl_pu);
+ Xg_define_procedure(gtk_print_context_get_width, gxg_gtk_print_context_get_width_w, 1, 0, 0, H_gtk_print_context_get_width, pl_du);
+ Xg_define_procedure(gtk_print_context_get_height, gxg_gtk_print_context_get_height_w, 1, 0, 0, H_gtk_print_context_get_height, pl_du);
+ Xg_define_procedure(gtk_print_context_get_dpi_x, gxg_gtk_print_context_get_dpi_x_w, 1, 0, 0, H_gtk_print_context_get_dpi_x, pl_du);
+ Xg_define_procedure(gtk_print_context_get_dpi_y, gxg_gtk_print_context_get_dpi_y_w, 1, 0, 0, H_gtk_print_context_get_dpi_y, pl_du);
+ Xg_define_procedure(gtk_print_context_create_pango_context, gxg_gtk_print_context_create_pango_context_w, 1, 0, 0, H_gtk_print_context_create_pango_context, pl_pu);
+ Xg_define_procedure(gtk_print_context_create_pango_layout, gxg_gtk_print_context_create_pango_layout_w, 1, 0, 0, H_gtk_print_context_create_pango_layout, pl_pu);
+ Xg_define_procedure(gtk_print_context_set_cairo_context, gxg_gtk_print_context_set_cairo_context_w, 4, 0, 0, H_gtk_print_context_set_cairo_context, pl_tuur);
+ Xg_define_procedure(gtk_print_operation_new, gxg_gtk_print_operation_new_w, 0, 0, 0, H_gtk_print_operation_new, pl_p);
+ Xg_define_procedure(gtk_print_operation_set_default_page_setup, gxg_gtk_print_operation_set_default_page_setup_w, 2, 0, 0, H_gtk_print_operation_set_default_page_setup, pl_tu);
+ Xg_define_procedure(gtk_print_operation_get_default_page_setup, gxg_gtk_print_operation_get_default_page_setup_w, 1, 0, 0, H_gtk_print_operation_get_default_page_setup, pl_pu);
+ Xg_define_procedure(gtk_print_operation_set_print_settings, gxg_gtk_print_operation_set_print_settings_w, 2, 0, 0, H_gtk_print_operation_set_print_settings, pl_tu);
+ Xg_define_procedure(gtk_print_operation_get_print_settings, gxg_gtk_print_operation_get_print_settings_w, 1, 0, 0, H_gtk_print_operation_get_print_settings, pl_pu);
+ Xg_define_procedure(gtk_print_operation_set_job_name, gxg_gtk_print_operation_set_job_name_w, 2, 0, 0, H_gtk_print_operation_set_job_name, pl_tus);
+ Xg_define_procedure(gtk_print_operation_set_n_pages, gxg_gtk_print_operation_set_n_pages_w, 2, 0, 0, H_gtk_print_operation_set_n_pages, pl_tui);
+ Xg_define_procedure(gtk_print_operation_set_current_page, gxg_gtk_print_operation_set_current_page_w, 2, 0, 0, H_gtk_print_operation_set_current_page, pl_tui);
+ Xg_define_procedure(gtk_print_operation_set_use_full_page, gxg_gtk_print_operation_set_use_full_page_w, 2, 0, 0, H_gtk_print_operation_set_use_full_page, pl_tub);
+ Xg_define_procedure(gtk_print_operation_set_unit, gxg_gtk_print_operation_set_unit_w, 2, 0, 0, H_gtk_print_operation_set_unit, pl_tut);
+ Xg_define_procedure(gtk_print_operation_set_export_filename, gxg_gtk_print_operation_set_export_filename_w, 2, 0, 0, H_gtk_print_operation_set_export_filename, pl_tus);
+ Xg_define_procedure(gtk_print_operation_set_track_print_status, gxg_gtk_print_operation_set_track_print_status_w, 2, 0, 0, H_gtk_print_operation_set_track_print_status, pl_tub);
+ Xg_define_procedure(gtk_print_operation_set_show_progress, gxg_gtk_print_operation_set_show_progress_w, 2, 0, 0, H_gtk_print_operation_set_show_progress, pl_tub);
+ Xg_define_procedure(gtk_print_operation_set_allow_async, gxg_gtk_print_operation_set_allow_async_w, 2, 0, 0, H_gtk_print_operation_set_allow_async, pl_tub);
+ Xg_define_procedure(gtk_print_operation_set_custom_tab_label, gxg_gtk_print_operation_set_custom_tab_label_w, 2, 0, 0, H_gtk_print_operation_set_custom_tab_label, pl_tus);
+ Xg_define_procedure(gtk_print_operation_run, gxg_gtk_print_operation_run_w, 3, 1, 0, H_gtk_print_operation_run, pl_iuiu);
+ Xg_define_procedure(gtk_print_operation_get_error, gxg_gtk_print_operation_get_error_w, 1, 1, 0, H_gtk_print_operation_get_error, pl_tu);
+ Xg_define_procedure(gtk_print_operation_get_status, gxg_gtk_print_operation_get_status_w, 1, 0, 0, H_gtk_print_operation_get_status, pl_iu);
+ Xg_define_procedure(gtk_print_operation_get_status_string, gxg_gtk_print_operation_get_status_string_w, 1, 0, 0, H_gtk_print_operation_get_status_string, pl_su);
+ Xg_define_procedure(gtk_print_operation_is_finished, gxg_gtk_print_operation_is_finished_w, 1, 0, 0, H_gtk_print_operation_is_finished, pl_bu);
+ Xg_define_procedure(gtk_print_operation_cancel, gxg_gtk_print_operation_cancel_w, 1, 0, 0, H_gtk_print_operation_cancel, pl_tu);
+ Xg_define_procedure(gtk_print_run_page_setup_dialog, gxg_gtk_print_run_page_setup_dialog_w, 3, 0, 0, H_gtk_print_run_page_setup_dialog, pl_pu);
+ Xg_define_procedure(gtk_print_run_page_setup_dialog_async, gxg_gtk_print_run_page_setup_dialog_async_w, 5, 0, 0, H_gtk_print_run_page_setup_dialog_async, pl_tuuut);
+ Xg_define_procedure(gtk_print_operation_preview_render_page, gxg_gtk_print_operation_preview_render_page_w, 2, 0, 0, H_gtk_print_operation_preview_render_page, pl_tui);
+ Xg_define_procedure(gtk_print_operation_preview_end_preview, gxg_gtk_print_operation_preview_end_preview_w, 1, 0, 0, H_gtk_print_operation_preview_end_preview, pl_tu);
+ Xg_define_procedure(gtk_print_operation_preview_is_selected, gxg_gtk_print_operation_preview_is_selected_w, 2, 0, 0, H_gtk_print_operation_preview_is_selected, pl_bui);
+ Xg_define_procedure(gtk_print_settings_new, gxg_gtk_print_settings_new_w, 0, 0, 0, H_gtk_print_settings_new, pl_p);
+ Xg_define_procedure(gtk_print_settings_copy, gxg_gtk_print_settings_copy_w, 1, 0, 0, H_gtk_print_settings_copy, pl_pu);
+ Xg_define_procedure(gtk_print_settings_has_key, gxg_gtk_print_settings_has_key_w, 2, 0, 0, H_gtk_print_settings_has_key, pl_bus);
+ Xg_define_procedure(gtk_print_settings_get, gxg_gtk_print_settings_get_w, 2, 0, 0, H_gtk_print_settings_get, pl_sus);
+ Xg_define_procedure(gtk_print_settings_set, gxg_gtk_print_settings_set_w, 3, 0, 0, H_gtk_print_settings_set, pl_tus);
+ Xg_define_procedure(gtk_print_settings_unset, gxg_gtk_print_settings_unset_w, 2, 0, 0, H_gtk_print_settings_unset, pl_tus);
+ Xg_define_procedure(gtk_print_settings_foreach, gxg_gtk_print_settings_foreach_w, 3, 0, 0, H_gtk_print_settings_foreach, pl_tut);
+ Xg_define_procedure(gtk_print_settings_get_bool, gxg_gtk_print_settings_get_bool_w, 2, 0, 0, H_gtk_print_settings_get_bool, pl_bus);
+ Xg_define_procedure(gtk_print_settings_set_bool, gxg_gtk_print_settings_set_bool_w, 3, 0, 0, H_gtk_print_settings_set_bool, pl_tusb);
+ Xg_define_procedure(gtk_print_settings_get_double, gxg_gtk_print_settings_get_double_w, 2, 0, 0, H_gtk_print_settings_get_double, pl_dus);
+ Xg_define_procedure(gtk_print_settings_get_double_with_default, gxg_gtk_print_settings_get_double_with_default_w, 3, 0, 0, H_gtk_print_settings_get_double_with_default, pl_dusr);
+ Xg_define_procedure(gtk_print_settings_set_double, gxg_gtk_print_settings_set_double_w, 3, 0, 0, H_gtk_print_settings_set_double, pl_tusr);
+ Xg_define_procedure(gtk_print_settings_get_length, gxg_gtk_print_settings_get_length_w, 3, 0, 0, H_gtk_print_settings_get_length, pl_dust);
+ Xg_define_procedure(gtk_print_settings_set_length, gxg_gtk_print_settings_set_length_w, 4, 0, 0, H_gtk_print_settings_set_length, pl_tusrt);
+ Xg_define_procedure(gtk_print_settings_get_int, gxg_gtk_print_settings_get_int_w, 2, 0, 0, H_gtk_print_settings_get_int, pl_ius);
+ Xg_define_procedure(gtk_print_settings_get_int_with_default, gxg_gtk_print_settings_get_int_with_default_w, 3, 0, 0, H_gtk_print_settings_get_int_with_default, pl_iusi);
+ Xg_define_procedure(gtk_print_settings_set_int, gxg_gtk_print_settings_set_int_w, 3, 0, 0, H_gtk_print_settings_set_int, pl_tusi);
+ Xg_define_procedure(gtk_print_settings_get_printer, gxg_gtk_print_settings_get_printer_w, 1, 0, 0, H_gtk_print_settings_get_printer, pl_su);
+ Xg_define_procedure(gtk_print_settings_set_printer, gxg_gtk_print_settings_set_printer_w, 2, 0, 0, H_gtk_print_settings_set_printer, pl_tus);
+ Xg_define_procedure(gtk_print_settings_get_orientation, gxg_gtk_print_settings_get_orientation_w, 1, 0, 0, H_gtk_print_settings_get_orientation, pl_tu);
+ Xg_define_procedure(gtk_print_settings_set_orientation, gxg_gtk_print_settings_set_orientation_w, 2, 0, 0, H_gtk_print_settings_set_orientation, pl_tut);
+ Xg_define_procedure(gtk_print_settings_get_paper_size, gxg_gtk_print_settings_get_paper_size_w, 1, 0, 0, H_gtk_print_settings_get_paper_size, pl_pu);
+ Xg_define_procedure(gtk_print_settings_set_paper_size, gxg_gtk_print_settings_set_paper_size_w, 2, 0, 0, H_gtk_print_settings_set_paper_size, pl_tu);
+ Xg_define_procedure(gtk_print_settings_get_paper_width, gxg_gtk_print_settings_get_paper_width_w, 2, 0, 0, H_gtk_print_settings_get_paper_width, pl_dut);
+ Xg_define_procedure(gtk_print_settings_set_paper_width, gxg_gtk_print_settings_set_paper_width_w, 3, 0, 0, H_gtk_print_settings_set_paper_width, pl_turt);
+ Xg_define_procedure(gtk_print_settings_get_paper_height, gxg_gtk_print_settings_get_paper_height_w, 2, 0, 0, H_gtk_print_settings_get_paper_height, pl_dut);
+ Xg_define_procedure(gtk_print_settings_set_paper_height, gxg_gtk_print_settings_set_paper_height_w, 3, 0, 0, H_gtk_print_settings_set_paper_height, pl_turt);
+ Xg_define_procedure(gtk_print_settings_get_use_color, gxg_gtk_print_settings_get_use_color_w, 1, 0, 0, H_gtk_print_settings_get_use_color, pl_bu);
+ Xg_define_procedure(gtk_print_settings_set_use_color, gxg_gtk_print_settings_set_use_color_w, 2, 0, 0, H_gtk_print_settings_set_use_color, pl_tub);
+ Xg_define_procedure(gtk_print_settings_get_collate, gxg_gtk_print_settings_get_collate_w, 1, 0, 0, H_gtk_print_settings_get_collate, pl_bu);
+ Xg_define_procedure(gtk_print_settings_set_collate, gxg_gtk_print_settings_set_collate_w, 2, 0, 0, H_gtk_print_settings_set_collate, pl_tub);
+ Xg_define_procedure(gtk_print_settings_get_reverse, gxg_gtk_print_settings_get_reverse_w, 1, 0, 0, H_gtk_print_settings_get_reverse, pl_bu);
+ Xg_define_procedure(gtk_print_settings_set_reverse, gxg_gtk_print_settings_set_reverse_w, 2, 0, 0, H_gtk_print_settings_set_reverse, pl_tub);
+ Xg_define_procedure(gtk_print_settings_get_duplex, gxg_gtk_print_settings_get_duplex_w, 1, 0, 0, H_gtk_print_settings_get_duplex, pl_tu);
+ Xg_define_procedure(gtk_print_settings_set_duplex, gxg_gtk_print_settings_set_duplex_w, 2, 0, 0, H_gtk_print_settings_set_duplex, pl_tut);
+ Xg_define_procedure(gtk_print_settings_get_quality, gxg_gtk_print_settings_get_quality_w, 1, 0, 0, H_gtk_print_settings_get_quality, pl_tu);
+ Xg_define_procedure(gtk_print_settings_set_quality, gxg_gtk_print_settings_set_quality_w, 2, 0, 0, H_gtk_print_settings_set_quality, pl_tut);
+ Xg_define_procedure(gtk_print_settings_get_n_copies, gxg_gtk_print_settings_get_n_copies_w, 1, 0, 0, H_gtk_print_settings_get_n_copies, pl_iu);
+ Xg_define_procedure(gtk_print_settings_set_n_copies, gxg_gtk_print_settings_set_n_copies_w, 2, 0, 0, H_gtk_print_settings_set_n_copies, pl_tui);
+ Xg_define_procedure(gtk_print_settings_get_number_up, gxg_gtk_print_settings_get_number_up_w, 1, 0, 0, H_gtk_print_settings_get_number_up, pl_iu);
+ Xg_define_procedure(gtk_print_settings_set_number_up, gxg_gtk_print_settings_set_number_up_w, 2, 0, 0, H_gtk_print_settings_set_number_up, pl_tui);
+ Xg_define_procedure(gtk_print_settings_get_resolution, gxg_gtk_print_settings_get_resolution_w, 1, 0, 0, H_gtk_print_settings_get_resolution, pl_iu);
+ Xg_define_procedure(gtk_print_settings_set_resolution, gxg_gtk_print_settings_set_resolution_w, 2, 0, 0, H_gtk_print_settings_set_resolution, pl_tui);
+ Xg_define_procedure(gtk_print_settings_get_scale, gxg_gtk_print_settings_get_scale_w, 1, 0, 0, H_gtk_print_settings_get_scale, pl_du);
+ Xg_define_procedure(gtk_print_settings_set_scale, gxg_gtk_print_settings_set_scale_w, 2, 0, 0, H_gtk_print_settings_set_scale, pl_tur);
+ Xg_define_procedure(gtk_print_settings_get_print_pages, gxg_gtk_print_settings_get_print_pages_w, 1, 0, 0, H_gtk_print_settings_get_print_pages, pl_tu);
+ Xg_define_procedure(gtk_print_settings_set_print_pages, gxg_gtk_print_settings_set_print_pages_w, 2, 0, 0, H_gtk_print_settings_set_print_pages, pl_tut);
+ Xg_define_procedure(gtk_print_settings_get_page_ranges, gxg_gtk_print_settings_get_page_ranges_w, 2, 0, 0, H_gtk_print_settings_get_page_ranges, pl_pu);
+ Xg_define_procedure(gtk_print_settings_set_page_ranges, gxg_gtk_print_settings_set_page_ranges_w, 3, 0, 0, H_gtk_print_settings_set_page_ranges, pl_tuui);
+ Xg_define_procedure(gtk_print_settings_get_page_set, gxg_gtk_print_settings_get_page_set_w, 1, 0, 0, H_gtk_print_settings_get_page_set, pl_tu);
+ Xg_define_procedure(gtk_print_settings_set_page_set, gxg_gtk_print_settings_set_page_set_w, 2, 0, 0, H_gtk_print_settings_set_page_set, pl_tut);
+ Xg_define_procedure(gtk_print_settings_get_default_source, gxg_gtk_print_settings_get_default_source_w, 1, 0, 0, H_gtk_print_settings_get_default_source, pl_su);
+ Xg_define_procedure(gtk_print_settings_set_default_source, gxg_gtk_print_settings_set_default_source_w, 2, 0, 0, H_gtk_print_settings_set_default_source, pl_tus);
+ Xg_define_procedure(gtk_print_settings_get_media_type, gxg_gtk_print_settings_get_media_type_w, 1, 0, 0, H_gtk_print_settings_get_media_type, pl_su);
+ Xg_define_procedure(gtk_print_settings_set_media_type, gxg_gtk_print_settings_set_media_type_w, 2, 0, 0, H_gtk_print_settings_set_media_type, pl_tus);
+ Xg_define_procedure(gtk_print_settings_get_dither, gxg_gtk_print_settings_get_dither_w, 1, 0, 0, H_gtk_print_settings_get_dither, pl_su);
+ Xg_define_procedure(gtk_print_settings_set_dither, gxg_gtk_print_settings_set_dither_w, 2, 0, 0, H_gtk_print_settings_set_dither, pl_tus);
+ Xg_define_procedure(gtk_print_settings_get_finishings, gxg_gtk_print_settings_get_finishings_w, 1, 0, 0, H_gtk_print_settings_get_finishings, pl_su);
+ Xg_define_procedure(gtk_print_settings_set_finishings, gxg_gtk_print_settings_set_finishings_w, 2, 0, 0, H_gtk_print_settings_set_finishings, pl_tus);
+ Xg_define_procedure(gtk_print_settings_get_output_bin, gxg_gtk_print_settings_get_output_bin_w, 1, 0, 0, H_gtk_print_settings_get_output_bin, pl_su);
+ Xg_define_procedure(gtk_print_settings_set_output_bin, gxg_gtk_print_settings_set_output_bin_w, 2, 0, 0, H_gtk_print_settings_set_output_bin, pl_tus);
+ Xg_define_procedure(gtk_settings_get_for_screen, gxg_gtk_settings_get_for_screen_w, 1, 0, 0, H_gtk_settings_get_for_screen, pl_pu);
+ Xg_define_procedure(pango_cairo_create_layout, gxg_pango_cairo_create_layout_w, 1, 0, 0, H_pango_cairo_create_layout, pl_pu);
+ Xg_define_procedure(pango_cairo_update_layout, gxg_pango_cairo_update_layout_w, 2, 0, 0, H_pango_cairo_update_layout, pl_tu);
+ Xg_define_procedure(pango_cairo_update_context, gxg_pango_cairo_update_context_w, 2, 0, 0, H_pango_cairo_update_context, pl_tu);
+ Xg_define_procedure(pango_cairo_context_set_font_options, gxg_pango_cairo_context_set_font_options_w, 2, 0, 0, H_pango_cairo_context_set_font_options, pl_tu);
+ Xg_define_procedure(pango_cairo_context_get_font_options, gxg_pango_cairo_context_get_font_options_w, 1, 0, 0, H_pango_cairo_context_get_font_options, pl_pu);
+ Xg_define_procedure(pango_cairo_context_set_resolution, gxg_pango_cairo_context_set_resolution_w, 2, 0, 0, H_pango_cairo_context_set_resolution, pl_tur);
+ Xg_define_procedure(pango_cairo_context_get_resolution, gxg_pango_cairo_context_get_resolution_w, 1, 0, 0, H_pango_cairo_context_get_resolution, pl_du);
+ Xg_define_procedure(pango_cairo_show_glyph_string, gxg_pango_cairo_show_glyph_string_w, 3, 0, 0, H_pango_cairo_show_glyph_string, pl_tu);
+ Xg_define_procedure(pango_cairo_show_layout_line, gxg_pango_cairo_show_layout_line_w, 2, 0, 0, H_pango_cairo_show_layout_line, pl_tu);
+ Xg_define_procedure(pango_cairo_show_layout, gxg_pango_cairo_show_layout_w, 2, 0, 0, H_pango_cairo_show_layout, pl_tu);
+ Xg_define_procedure(pango_cairo_show_error_underline, gxg_pango_cairo_show_error_underline_w, 5, 0, 0, H_pango_cairo_show_error_underline, pl_tur);
+ Xg_define_procedure(pango_cairo_glyph_string_path, gxg_pango_cairo_glyph_string_path_w, 3, 0, 0, H_pango_cairo_glyph_string_path, pl_tu);
+ Xg_define_procedure(pango_cairo_layout_line_path, gxg_pango_cairo_layout_line_path_w, 2, 0, 0, H_pango_cairo_layout_line_path, pl_tu);
+ Xg_define_procedure(pango_cairo_layout_path, gxg_pango_cairo_layout_path_w, 2, 0, 0, H_pango_cairo_layout_path, pl_tu);
+ Xg_define_procedure(pango_cairo_error_underline_path, gxg_pango_cairo_error_underline_path_w, 5, 0, 0, H_pango_cairo_error_underline_path, pl_tur);
+ Xg_define_procedure(gdk_cairo_set_source_pixbuf, gxg_gdk_cairo_set_source_pixbuf_w, 4, 0, 0, H_gdk_cairo_set_source_pixbuf, pl_tuur);
+ Xg_define_procedure(gdk_cairo_rectangle, gxg_gdk_cairo_rectangle_w, 2, 0, 0, H_gdk_cairo_rectangle, pl_tu);
+ Xg_define_procedure(gdk_event_request_motions, gxg_gdk_event_request_motions_w, 1, 0, 0, H_gdk_event_request_motions, pl_tu);
+ Xg_define_procedure(gdk_notify_startup_complete_with_id, gxg_gdk_notify_startup_complete_with_id_w, 1, 0, 0, H_gdk_notify_startup_complete_with_id, pl_ts);
+ Xg_define_procedure(gdk_threads_add_idle_full, gxg_gdk_threads_add_idle_full_w, 4, 0, 0, H_gdk_threads_add_idle_full, pl_iit);
+ Xg_define_procedure(gdk_threads_add_idle, gxg_gdk_threads_add_idle_w, 1, 1, 0, H_gdk_threads_add_idle, pl_it);
+ Xg_define_procedure(gdk_threads_add_timeout_full, gxg_gdk_threads_add_timeout_full_w, 5, 0, 0, H_gdk_threads_add_timeout_full, pl_iiit);
+ Xg_define_procedure(gdk_threads_add_timeout, gxg_gdk_threads_add_timeout_w, 2, 1, 0, H_gdk_threads_add_timeout, pl_iit);
+ Xg_define_procedure(gdk_window_set_startup_id, gxg_gdk_window_set_startup_id_w, 2, 0, 0, H_gdk_window_set_startup_id, pl_tus);
+ Xg_define_procedure(gdk_window_beep, gxg_gdk_window_beep_w, 1, 0, 0, H_gdk_window_beep, pl_tu);
+ Xg_define_procedure(gdk_window_set_opacity, gxg_gdk_window_set_opacity_w, 2, 0, 0, H_gdk_window_set_opacity, pl_tur);
+ Xg_define_procedure(gtk_binding_entry_skip, gxg_gtk_binding_entry_skip_w, 3, 0, 0, H_gtk_binding_entry_skip, pl_tui);
+ Xg_define_procedure(gtk_cell_layout_get_cells, gxg_gtk_cell_layout_get_cells_w, 1, 0, 0, H_gtk_cell_layout_get_cells, pl_pu);
+ Xg_define_procedure(gtk_entry_completion_set_inline_selection, gxg_gtk_entry_completion_set_inline_selection_w, 2, 0, 0, H_gtk_entry_completion_set_inline_selection, pl_tub);
+ Xg_define_procedure(gtk_entry_completion_get_inline_selection, gxg_gtk_entry_completion_get_inline_selection_w, 1, 0, 0, H_gtk_entry_completion_get_inline_selection, pl_bu);
+ Xg_define_procedure(gtk_entry_completion_get_completion_prefix, gxg_gtk_entry_completion_get_completion_prefix_w, 1, 0, 0, H_gtk_entry_completion_get_completion_prefix, pl_su);
+ Xg_define_procedure(gtk_entry_set_cursor_hadjustment, gxg_gtk_entry_set_cursor_hadjustment_w, 2, 0, 0, H_gtk_entry_set_cursor_hadjustment, pl_tu);
+ Xg_define_procedure(gtk_entry_get_cursor_hadjustment, gxg_gtk_entry_get_cursor_hadjustment_w, 1, 0, 0, H_gtk_entry_get_cursor_hadjustment, pl_pu);
+ Xg_define_procedure(gtk_icon_theme_list_contexts, gxg_gtk_icon_theme_list_contexts_w, 1, 0, 0, H_gtk_icon_theme_list_contexts, pl_pu);
+ Xg_define_procedure(gtk_print_settings_new_from_file, gxg_gtk_print_settings_new_from_file_w, 1, 1, 0, H_gtk_print_settings_new_from_file, pl_psu);
+ Xg_define_procedure(gtk_print_settings_to_file, gxg_gtk_print_settings_to_file_w, 2, 1, 0, H_gtk_print_settings_to_file, pl_busu);
+ Xg_define_procedure(gtk_range_set_show_fill_level, gxg_gtk_range_set_show_fill_level_w, 2, 0, 0, H_gtk_range_set_show_fill_level, pl_tub);
+ Xg_define_procedure(gtk_range_get_show_fill_level, gxg_gtk_range_get_show_fill_level_w, 1, 0, 0, H_gtk_range_get_show_fill_level, pl_bu);
+ Xg_define_procedure(gtk_range_set_restrict_to_fill_level, gxg_gtk_range_set_restrict_to_fill_level_w, 2, 0, 0, H_gtk_range_set_restrict_to_fill_level, pl_tub);
+ Xg_define_procedure(gtk_range_get_restrict_to_fill_level, gxg_gtk_range_get_restrict_to_fill_level_w, 1, 0, 0, H_gtk_range_get_restrict_to_fill_level, pl_bu);
+ Xg_define_procedure(gtk_range_set_fill_level, gxg_gtk_range_set_fill_level_w, 2, 0, 0, H_gtk_range_set_fill_level, pl_tur);
+ Xg_define_procedure(gtk_range_get_fill_level, gxg_gtk_range_get_fill_level_w, 1, 0, 0, H_gtk_range_get_fill_level, pl_du);
+ Xg_define_procedure(gtk_tree_view_set_show_expanders, gxg_gtk_tree_view_set_show_expanders_w, 2, 0, 0, H_gtk_tree_view_set_show_expanders, pl_tub);
+ Xg_define_procedure(gtk_tree_view_get_show_expanders, gxg_gtk_tree_view_get_show_expanders_w, 1, 0, 0, H_gtk_tree_view_get_show_expanders, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_level_indentation, gxg_gtk_tree_view_set_level_indentation_w, 2, 0, 0, H_gtk_tree_view_set_level_indentation, pl_tui);
+ Xg_define_procedure(gtk_tree_view_get_level_indentation, gxg_gtk_tree_view_get_level_indentation_w, 1, 0, 0, H_gtk_tree_view_get_level_indentation, pl_iu);
+ Xg_define_procedure(gtk_widget_keynav_failed, gxg_gtk_widget_keynav_failed_w, 2, 0, 0, H_gtk_widget_keynav_failed, pl_bui);
+ Xg_define_procedure(gtk_widget_error_bell, gxg_gtk_widget_error_bell_w, 1, 0, 0, H_gtk_widget_error_bell, pl_tu);
+ Xg_define_procedure(gtk_widget_set_tooltip_window, gxg_gtk_widget_set_tooltip_window_w, 2, 0, 0, H_gtk_widget_set_tooltip_window, pl_tu);
+ Xg_define_procedure(gtk_widget_get_tooltip_window, gxg_gtk_widget_get_tooltip_window_w, 1, 0, 0, H_gtk_widget_get_tooltip_window, pl_pu);
+ Xg_define_procedure(gtk_widget_trigger_tooltip_query, gxg_gtk_widget_trigger_tooltip_query_w, 1, 0, 0, H_gtk_widget_trigger_tooltip_query, pl_tu);
+ Xg_define_procedure(gtk_window_set_startup_id, gxg_gtk_window_set_startup_id_w, 2, 0, 0, H_gtk_window_set_startup_id, pl_tus);
+ Xg_define_procedure(gtk_text_buffer_add_mark, gxg_gtk_text_buffer_add_mark_w, 3, 0, 0, H_gtk_text_buffer_add_mark, pl_tu);
+ Xg_define_procedure(gtk_text_mark_new, gxg_gtk_text_mark_new_w, 2, 0, 0, H_gtk_text_mark_new, pl_psb);
+ Xg_define_procedure(gtk_tree_view_column_get_tree_view, gxg_gtk_tree_view_column_get_tree_view_w, 1, 0, 0, H_gtk_tree_view_column_get_tree_view, pl_pu);
+ Xg_define_procedure(gtk_tooltip_set_text, gxg_gtk_tooltip_set_text_w, 2, 0, 0, H_gtk_tooltip_set_text, pl_tus);
+ Xg_define_procedure(gtk_tree_view_convert_widget_to_tree_coords, gxg_gtk_tree_view_convert_widget_to_tree_coords_w, 3, 2, 0, H_gtk_tree_view_convert_widget_to_tree_coords, pl_tuiiu);
+ Xg_define_procedure(gtk_tree_view_convert_tree_to_widget_coords, gxg_gtk_tree_view_convert_tree_to_widget_coords_w, 3, 2, 0, H_gtk_tree_view_convert_tree_to_widget_coords, pl_tuiiu);
+ Xg_define_procedure(gtk_tree_view_convert_widget_to_bin_window_coords, gxg_gtk_tree_view_convert_widget_to_bin_window_coords_w, 3, 2, 0, H_gtk_tree_view_convert_widget_to_bin_window_coords, pl_tuiiu);
+ Xg_define_procedure(gtk_tree_view_convert_bin_window_to_widget_coords, gxg_gtk_tree_view_convert_bin_window_to_widget_coords_w, 3, 2, 0, H_gtk_tree_view_convert_bin_window_to_widget_coords, pl_tuiiu);
+ Xg_define_procedure(gtk_tree_view_convert_tree_to_bin_window_coords, gxg_gtk_tree_view_convert_tree_to_bin_window_coords_w, 3, 2, 0, H_gtk_tree_view_convert_tree_to_bin_window_coords, pl_tuiiu);
+ Xg_define_procedure(gtk_tree_view_convert_bin_window_to_tree_coords, gxg_gtk_tree_view_convert_bin_window_to_tree_coords_w, 3, 2, 0, H_gtk_tree_view_convert_bin_window_to_tree_coords, pl_tuiiu);
+ Xg_define_procedure(gtk_widget_set_tooltip_text, gxg_gtk_widget_set_tooltip_text_w, 2, 0, 0, H_gtk_widget_set_tooltip_text, pl_tus);
+ Xg_define_procedure(gtk_widget_get_tooltip_text, gxg_gtk_widget_get_tooltip_text_w, 1, 0, 0, H_gtk_widget_get_tooltip_text, pl_su);
+ Xg_define_procedure(gtk_widget_set_tooltip_markup, gxg_gtk_widget_set_tooltip_markup_w, 2, 0, 0, H_gtk_widget_set_tooltip_markup, pl_tus);
+ Xg_define_procedure(gtk_widget_get_tooltip_markup, gxg_gtk_widget_get_tooltip_markup_w, 1, 0, 0, H_gtk_widget_get_tooltip_markup, pl_su);
+ Xg_define_procedure(gtk_tree_view_is_rubber_banding_active, gxg_gtk_tree_view_is_rubber_banding_active_w, 1, 0, 0, H_gtk_tree_view_is_rubber_banding_active, pl_bu);
+ Xg_define_procedure(gtk_icon_view_convert_widget_to_bin_window_coords, gxg_gtk_icon_view_convert_widget_to_bin_window_coords_w, 3, 2, 0, H_gtk_icon_view_convert_widget_to_bin_window_coords, pl_tuiiu);
+ Xg_define_procedure(gtk_icon_view_set_tooltip_item, gxg_gtk_icon_view_set_tooltip_item_w, 3, 0, 0, H_gtk_icon_view_set_tooltip_item, pl_tu);
+ Xg_define_procedure(gtk_icon_view_set_tooltip_cell, gxg_gtk_icon_view_set_tooltip_cell_w, 4, 0, 0, H_gtk_icon_view_set_tooltip_cell, pl_tu);
+ Xg_define_procedure(gtk_icon_view_get_tooltip_context, gxg_gtk_icon_view_get_tooltip_context_w, 3, 4, 0, H_gtk_icon_view_get_tooltip_context, pl_buuubu);
+ Xg_define_procedure(gtk_icon_view_set_tooltip_column, gxg_gtk_icon_view_set_tooltip_column_w, 2, 0, 0, H_gtk_icon_view_set_tooltip_column, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_tooltip_column, gxg_gtk_icon_view_get_tooltip_column_w, 1, 0, 0, H_gtk_icon_view_get_tooltip_column, pl_iu);
+ Xg_define_procedure(gtk_menu_tool_button_set_arrow_tooltip_text, gxg_gtk_menu_tool_button_set_arrow_tooltip_text_w, 2, 0, 0, H_gtk_menu_tool_button_set_arrow_tooltip_text, pl_tus);
+ Xg_define_procedure(gtk_menu_tool_button_set_arrow_tooltip_markup, gxg_gtk_menu_tool_button_set_arrow_tooltip_markup_w, 2, 0, 0, H_gtk_menu_tool_button_set_arrow_tooltip_markup, pl_tus);
+ Xg_define_procedure(gtk_tool_item_set_tooltip_text, gxg_gtk_tool_item_set_tooltip_text_w, 2, 0, 0, H_gtk_tool_item_set_tooltip_text, pl_tus);
+ Xg_define_procedure(gtk_tool_item_set_tooltip_markup, gxg_gtk_tool_item_set_tooltip_markup_w, 2, 0, 0, H_gtk_tool_item_set_tooltip_markup, pl_tus);
+ Xg_define_procedure(gtk_tooltip_set_tip_area, gxg_gtk_tooltip_set_tip_area_w, 2, 0, 0, H_gtk_tooltip_set_tip_area, pl_tu);
+ Xg_define_procedure(gtk_tree_view_set_tooltip_row, gxg_gtk_tree_view_set_tooltip_row_w, 3, 0, 0, H_gtk_tree_view_set_tooltip_row, pl_tu);
+ Xg_define_procedure(gtk_tree_view_set_tooltip_cell, gxg_gtk_tree_view_set_tooltip_cell_w, 5, 0, 0, H_gtk_tree_view_set_tooltip_cell, pl_tu);
+ Xg_define_procedure(gtk_tree_view_get_tooltip_context, gxg_gtk_tree_view_get_tooltip_context_w, 3, 4, 0, H_gtk_tree_view_get_tooltip_context, pl_buuubu);
+ Xg_define_procedure(gtk_tree_view_set_tooltip_column, gxg_gtk_tree_view_set_tooltip_column_w, 2, 0, 0, H_gtk_tree_view_set_tooltip_column, pl_tui);
+ Xg_define_procedure(gtk_tree_view_get_tooltip_column, gxg_gtk_tree_view_get_tooltip_column_w, 1, 0, 0, H_gtk_tree_view_get_tooltip_column, pl_iu);
+ Xg_define_procedure(gtk_widget_set_has_tooltip, gxg_gtk_widget_set_has_tooltip_w, 2, 0, 0, H_gtk_widget_set_has_tooltip, pl_tub);
+ Xg_define_procedure(gtk_widget_get_has_tooltip, gxg_gtk_widget_get_has_tooltip_w, 1, 0, 0, H_gtk_widget_get_has_tooltip, pl_bu);
+#if GTK_CHECK_VERSION(2, 14, 0)
+ Xg_define_procedure(gtk_calendar_set_detail_func, gxg_gtk_calendar_set_detail_func_w, 4, 0, 0, H_gtk_calendar_set_detail_func, pl_tut);
+ Xg_define_procedure(gtk_calendar_set_detail_width_chars, gxg_gtk_calendar_set_detail_width_chars_w, 2, 0, 0, H_gtk_calendar_set_detail_width_chars, pl_tui);
+ Xg_define_procedure(gtk_calendar_set_detail_height_rows, gxg_gtk_calendar_set_detail_height_rows_w, 2, 0, 0, H_gtk_calendar_set_detail_height_rows, pl_tui);
+ Xg_define_procedure(gtk_calendar_get_detail_width_chars, gxg_gtk_calendar_get_detail_width_chars_w, 1, 0, 0, H_gtk_calendar_get_detail_width_chars, pl_iu);
+ Xg_define_procedure(gtk_calendar_get_detail_height_rows, gxg_gtk_calendar_get_detail_height_rows_w, 1, 0, 0, H_gtk_calendar_get_detail_height_rows, pl_iu);
+ Xg_define_procedure(gdk_screen_get_monitor_width_mm, gxg_gdk_screen_get_monitor_width_mm_w, 2, 0, 0, H_gdk_screen_get_monitor_width_mm, pl_iui);
+ Xg_define_procedure(gdk_screen_get_monitor_height_mm, gxg_gdk_screen_get_monitor_height_mm_w, 2, 0, 0, H_gdk_screen_get_monitor_height_mm, pl_iui);
+ Xg_define_procedure(gdk_screen_get_monitor_plug_name, gxg_gdk_screen_get_monitor_plug_name_w, 2, 0, 0, H_gdk_screen_get_monitor_plug_name, pl_sui);
+ Xg_define_procedure(gtk_accel_group_get_is_locked, gxg_gtk_accel_group_get_is_locked_w, 1, 0, 0, H_gtk_accel_group_get_is_locked, pl_bu);
+ Xg_define_procedure(gtk_container_get_focus_child, gxg_gtk_container_get_focus_child_w, 1, 0, 0, H_gtk_container_get_focus_child, pl_pu);
+ Xg_define_procedure(gtk_dialog_get_content_area, gxg_gtk_dialog_get_content_area_w, 1, 0, 0, H_gtk_dialog_get_content_area, pl_pu);
+ Xg_define_procedure(gtk_entry_set_overwrite_mode, gxg_gtk_entry_set_overwrite_mode_w, 2, 0, 0, H_gtk_entry_set_overwrite_mode, pl_tub);
+ Xg_define_procedure(gtk_entry_get_overwrite_mode, gxg_gtk_entry_get_overwrite_mode_w, 1, 0, 0, H_gtk_entry_get_overwrite_mode, pl_bu);
+ Xg_define_procedure(gtk_entry_get_text_length, gxg_gtk_entry_get_text_length_w, 1, 0, 0, H_gtk_entry_get_text_length, pl_iu);
+ Xg_define_procedure(gtk_layout_get_bin_window, gxg_gtk_layout_get_bin_window_w, 1, 0, 0, H_gtk_layout_get_bin_window, pl_pu);
+ Xg_define_procedure(gtk_menu_get_accel_path, gxg_gtk_menu_get_accel_path_w, 1, 0, 0, H_gtk_menu_get_accel_path, pl_su);
+ Xg_define_procedure(gtk_menu_get_monitor, gxg_gtk_menu_get_monitor_w, 1, 0, 0, H_gtk_menu_get_monitor, pl_iu);
+ Xg_define_procedure(gtk_menu_item_get_accel_path, gxg_gtk_menu_item_get_accel_path_w, 1, 0, 0, H_gtk_menu_item_get_accel_path, pl_su);
+ Xg_define_procedure(gtk_scale_button_get_plus_button, gxg_gtk_scale_button_get_plus_button_w, 1, 0, 0, H_gtk_scale_button_get_plus_button, pl_pu);
+ Xg_define_procedure(gtk_scale_button_get_minus_button, gxg_gtk_scale_button_get_minus_button_w, 1, 0, 0, H_gtk_scale_button_get_minus_button, pl_pu);
+ Xg_define_procedure(gtk_scale_button_get_popup, gxg_gtk_scale_button_get_popup_w, 1, 0, 0, H_gtk_scale_button_get_popup, pl_pu);
+ Xg_define_procedure(gtk_selection_data_get_target, gxg_gtk_selection_data_get_target_w, 1, 0, 0, H_gtk_selection_data_get_target, pl_tu);
+ Xg_define_procedure(gtk_selection_data_get_data_type, gxg_gtk_selection_data_get_data_type_w, 1, 0, 0, H_gtk_selection_data_get_data_type, pl_tu);
+ Xg_define_procedure(gtk_selection_data_get_format, gxg_gtk_selection_data_get_format_w, 1, 0, 0, H_gtk_selection_data_get_format, pl_iu);
+ Xg_define_procedure(gtk_selection_data_get_display, gxg_gtk_selection_data_get_display_w, 1, 0, 0, H_gtk_selection_data_get_display, pl_pu);
+ Xg_define_procedure(gtk_widget_get_window, gxg_gtk_widget_get_window_w, 1, 0, 0, H_gtk_widget_get_window, pl_pu);
+ Xg_define_procedure(gtk_accel_group_get_modifier_mask, gxg_gtk_accel_group_get_modifier_mask_w, 1, 0, 0, H_gtk_accel_group_get_modifier_mask, pl_iu);
+ Xg_define_procedure(gdk_threads_add_timeout_seconds_full, gxg_gdk_threads_add_timeout_seconds_full_w, 5, 0, 0, H_gdk_threads_add_timeout_seconds_full, pl_iiit);
+ Xg_define_procedure(gdk_threads_add_timeout_seconds, gxg_gdk_threads_add_timeout_seconds_w, 2, 1, 0, H_gdk_threads_add_timeout_seconds, pl_iit);
+ Xg_define_procedure(gtk_adjustment_get_lower, gxg_gtk_adjustment_get_lower_w, 1, 0, 0, H_gtk_adjustment_get_lower, pl_du);
+ Xg_define_procedure(gtk_adjustment_set_lower, gxg_gtk_adjustment_set_lower_w, 2, 0, 0, H_gtk_adjustment_set_lower, pl_tur);
+ Xg_define_procedure(gtk_adjustment_get_upper, gxg_gtk_adjustment_get_upper_w, 1, 0, 0, H_gtk_adjustment_get_upper, pl_du);
+ Xg_define_procedure(gtk_adjustment_set_upper, gxg_gtk_adjustment_set_upper_w, 2, 0, 0, H_gtk_adjustment_set_upper, pl_tur);
+ Xg_define_procedure(gtk_adjustment_get_step_increment, gxg_gtk_adjustment_get_step_increment_w, 1, 0, 0, H_gtk_adjustment_get_step_increment, pl_du);
+ Xg_define_procedure(gtk_adjustment_set_step_increment, gxg_gtk_adjustment_set_step_increment_w, 2, 0, 0, H_gtk_adjustment_set_step_increment, pl_tur);
+ Xg_define_procedure(gtk_adjustment_get_page_increment, gxg_gtk_adjustment_get_page_increment_w, 1, 0, 0, H_gtk_adjustment_get_page_increment, pl_du);
+ Xg_define_procedure(gtk_adjustment_set_page_increment, gxg_gtk_adjustment_set_page_increment_w, 2, 0, 0, H_gtk_adjustment_set_page_increment, pl_tur);
+ Xg_define_procedure(gtk_adjustment_get_page_size, gxg_gtk_adjustment_get_page_size_w, 1, 0, 0, H_gtk_adjustment_get_page_size, pl_du);
+ Xg_define_procedure(gtk_adjustment_set_page_size, gxg_gtk_adjustment_set_page_size_w, 2, 0, 0, H_gtk_adjustment_set_page_size, pl_tur);
+ Xg_define_procedure(gtk_adjustment_configure, gxg_gtk_adjustment_configure_w, 7, 0, 0, H_gtk_adjustment_configure, pl_tur);
+ Xg_define_procedure(gtk_combo_box_set_button_sensitivity, gxg_gtk_combo_box_set_button_sensitivity_w, 2, 0, 0, H_gtk_combo_box_set_button_sensitivity, pl_tui);
+ Xg_define_procedure(gtk_combo_box_get_button_sensitivity, gxg_gtk_combo_box_get_button_sensitivity_w, 1, 0, 0, H_gtk_combo_box_get_button_sensitivity, pl_iu);
+ Xg_define_procedure(gtk_file_chooser_get_file, gxg_gtk_file_chooser_get_file_w, 1, 0, 0, H_gtk_file_chooser_get_file, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_set_file, gxg_gtk_file_chooser_set_file_w, 2, 1, 0, H_gtk_file_chooser_set_file, pl_bu);
+ Xg_define_procedure(gtk_file_chooser_select_file, gxg_gtk_file_chooser_select_file_w, 2, 1, 0, H_gtk_file_chooser_select_file, pl_bu);
+ Xg_define_procedure(gtk_file_chooser_unselect_file, gxg_gtk_file_chooser_unselect_file_w, 2, 0, 0, H_gtk_file_chooser_unselect_file, pl_tu);
+ Xg_define_procedure(gtk_file_chooser_get_files, gxg_gtk_file_chooser_get_files_w, 1, 0, 0, H_gtk_file_chooser_get_files, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_set_current_folder_file, gxg_gtk_file_chooser_set_current_folder_file_w, 2, 1, 0, H_gtk_file_chooser_set_current_folder_file, pl_bu);
+ Xg_define_procedure(gtk_file_chooser_get_current_folder_file, gxg_gtk_file_chooser_get_current_folder_file_w, 1, 0, 0, H_gtk_file_chooser_get_current_folder_file, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_get_preview_file, gxg_gtk_file_chooser_get_preview_file_w, 1, 0, 0, H_gtk_file_chooser_get_preview_file, pl_pu);
+ Xg_define_procedure(gtk_window_get_default_widget, gxg_gtk_window_get_default_widget_w, 1, 0, 0, H_gtk_window_get_default_widget, pl_pu);
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-#define gxg_GTK_COMBO_BOX_TEXT_w gxg_GTK_COMBO_BOX_TEXT
-#define gxg_GTK_GRID_w gxg_GTK_GRID
-#define gxg_GTK_SCROLLABLE_w gxg_GTK_SCROLLABLE
-#define gxg_GTK_SWITCH_w gxg_GTK_SWITCH
-#define gxg_GTK_ACTIVATABLE_w gxg_GTK_ACTIVATABLE
-#define gxg_GTK_ORIENTABLE_w gxg_GTK_ORIENTABLE
-#define gxg_GTK_WINDOW_GROUP_w gxg_GTK_WINDOW_GROUP
-#define gxg_GTK_TOOL_SHELL_w gxg_GTK_TOOL_SHELL
+#if GTK_CHECK_VERSION(2, 16, 0)
+ Xg_define_procedure(gtk_link_button_get_visited, gxg_gtk_link_button_get_visited_w, 1, 0, 0, H_gtk_link_button_get_visited, pl_bu);
+ Xg_define_procedure(gtk_link_button_set_visited, gxg_gtk_link_button_set_visited_w, 2, 0, 0, H_gtk_link_button_set_visited, pl_tub);
+ Xg_define_procedure(gdk_keymap_get_caps_lock_state, gxg_gdk_keymap_get_caps_lock_state_w, 1, 0, 0, H_gdk_keymap_get_caps_lock_state, pl_bu);
+ Xg_define_procedure(gtk_cell_view_get_model, gxg_gtk_cell_view_get_model_w, 1, 0, 0, H_gtk_cell_view_get_model, pl_pu);
+ Xg_define_procedure(gtk_entry_unset_invisible_char, gxg_gtk_entry_unset_invisible_char_w, 1, 0, 0, H_gtk_entry_unset_invisible_char, pl_tu);
+ Xg_define_procedure(gtk_entry_set_progress_fraction, gxg_gtk_entry_set_progress_fraction_w, 2, 0, 0, H_gtk_entry_set_progress_fraction, pl_tur);
+ Xg_define_procedure(gtk_entry_get_progress_fraction, gxg_gtk_entry_get_progress_fraction_w, 1, 0, 0, H_gtk_entry_get_progress_fraction, pl_du);
+ Xg_define_procedure(gtk_entry_set_progress_pulse_step, gxg_gtk_entry_set_progress_pulse_step_w, 2, 0, 0, H_gtk_entry_set_progress_pulse_step, pl_tur);
+ Xg_define_procedure(gtk_entry_get_progress_pulse_step, gxg_gtk_entry_get_progress_pulse_step_w, 1, 0, 0, H_gtk_entry_get_progress_pulse_step, pl_du);
+ Xg_define_procedure(gtk_entry_progress_pulse, gxg_gtk_entry_progress_pulse_w, 1, 0, 0, H_gtk_entry_progress_pulse, pl_tu);
+ Xg_define_procedure(gtk_entry_set_icon_from_pixbuf, gxg_gtk_entry_set_icon_from_pixbuf_w, 3, 0, 0, H_gtk_entry_set_icon_from_pixbuf, pl_tuiu);
+ Xg_define_procedure(gtk_entry_set_icon_from_icon_name, gxg_gtk_entry_set_icon_from_icon_name_w, 3, 0, 0, H_gtk_entry_set_icon_from_icon_name, pl_tuis);
+ Xg_define_procedure(gtk_entry_set_icon_from_gicon, gxg_gtk_entry_set_icon_from_gicon_w, 3, 0, 0, H_gtk_entry_set_icon_from_gicon, pl_tuiu);
+ Xg_define_procedure(gtk_entry_get_icon_name, gxg_gtk_entry_get_icon_name_w, 2, 0, 0, H_gtk_entry_get_icon_name, pl_sui);
+ Xg_define_procedure(gtk_entry_set_icon_activatable, gxg_gtk_entry_set_icon_activatable_w, 3, 0, 0, H_gtk_entry_set_icon_activatable, pl_tuib);
+ Xg_define_procedure(gtk_entry_get_icon_activatable, gxg_gtk_entry_get_icon_activatable_w, 2, 0, 0, H_gtk_entry_get_icon_activatable, pl_bui);
+ Xg_define_procedure(gtk_entry_set_icon_sensitive, gxg_gtk_entry_set_icon_sensitive_w, 3, 0, 0, H_gtk_entry_set_icon_sensitive, pl_tuib);
+ Xg_define_procedure(gtk_entry_get_icon_sensitive, gxg_gtk_entry_get_icon_sensitive_w, 2, 0, 0, H_gtk_entry_get_icon_sensitive, pl_bui);
+ Xg_define_procedure(gtk_entry_get_icon_at_pos, gxg_gtk_entry_get_icon_at_pos_w, 3, 0, 0, H_gtk_entry_get_icon_at_pos, pl_iui);
+ Xg_define_procedure(gtk_entry_set_icon_tooltip_text, gxg_gtk_entry_set_icon_tooltip_text_w, 3, 0, 0, H_gtk_entry_set_icon_tooltip_text, pl_tuis);
+ Xg_define_procedure(gtk_entry_set_icon_tooltip_markup, gxg_gtk_entry_set_icon_tooltip_markup_w, 3, 0, 0, H_gtk_entry_set_icon_tooltip_markup, pl_tuis);
+ Xg_define_procedure(gtk_entry_set_icon_drag_source, gxg_gtk_entry_set_icon_drag_source_w, 4, 0, 0, H_gtk_entry_set_icon_drag_source, pl_tuiui);
+ Xg_define_procedure(gtk_entry_get_current_icon_drag_source, gxg_gtk_entry_get_current_icon_drag_source_w, 1, 0, 0, H_gtk_entry_get_current_icon_drag_source, pl_iu);
+ Xg_define_procedure(gtk_menu_item_set_label, gxg_gtk_menu_item_set_label_w, 2, 0, 0, H_gtk_menu_item_set_label, pl_tus);
+ Xg_define_procedure(gtk_menu_item_get_label, gxg_gtk_menu_item_get_label_w, 1, 0, 0, H_gtk_menu_item_get_label, pl_su);
+ Xg_define_procedure(gtk_menu_item_set_use_underline, gxg_gtk_menu_item_set_use_underline_w, 2, 0, 0, H_gtk_menu_item_set_use_underline, pl_tub);
+ Xg_define_procedure(gtk_menu_item_get_use_underline, gxg_gtk_menu_item_get_use_underline_w, 1, 0, 0, H_gtk_menu_item_get_use_underline, pl_bu);
+ Xg_define_procedure(gtk_selection_data_get_selection, gxg_gtk_selection_data_get_selection_w, 1, 0, 0, H_gtk_selection_data_get_selection, pl_tu);
+ Xg_define_procedure(gtk_entry_get_icon_tooltip_text, gxg_gtk_entry_get_icon_tooltip_text_w, 2, 0, 0, H_gtk_entry_get_icon_tooltip_text, pl_sui);
+ Xg_define_procedure(gtk_entry_get_icon_tooltip_markup, gxg_gtk_entry_get_icon_tooltip_markup_w, 2, 0, 0, H_gtk_entry_get_icon_tooltip_markup, pl_sui);
+ Xg_define_procedure(gtk_scale_add_mark, gxg_gtk_scale_add_mark_w, 4, 0, 0, H_gtk_scale_add_mark, pl_turis);
+ Xg_define_procedure(gtk_scale_clear_marks, gxg_gtk_scale_clear_marks_w, 1, 0, 0, H_gtk_scale_clear_marks, pl_tu);
#endif
-#if (!HAVE_GTK_3)
-#define gxg_GDK_COLORMAP_w gxg_GDK_COLORMAP
-#define gxg_GDK_DRAWABLE_w gxg_GDK_DRAWABLE
-#define gxg_GDK_PIXMAP_w gxg_GDK_PIXMAP
-#define gxg_GTK_OBJECT_w gxg_GTK_OBJECT
-#define gxg_GTK_STYLE_w gxg_GTK_STYLE
+#if GTK_CHECK_VERSION(2, 18, 0)
+ Xg_define_procedure(gtk_window_get_default_icon_name, gxg_gtk_window_get_default_icon_name_w, 0, 0, 0, H_gtk_window_get_default_icon_name, pl_s);
+ Xg_define_procedure(gtk_label_get_current_uri, gxg_gtk_label_get_current_uri_w, 1, 0, 0, H_gtk_label_get_current_uri, pl_su);
+ Xg_define_procedure(gtk_info_bar_new, gxg_gtk_info_bar_new_w, 0, 0, 0, H_gtk_info_bar_new, pl_p);
+ Xg_define_procedure(gtk_info_bar_get_action_area, gxg_gtk_info_bar_get_action_area_w, 1, 0, 0, H_gtk_info_bar_get_action_area, pl_pu);
+ Xg_define_procedure(gtk_info_bar_get_content_area, gxg_gtk_info_bar_get_content_area_w, 1, 0, 0, H_gtk_info_bar_get_content_area, pl_pu);
+ Xg_define_procedure(gtk_info_bar_add_action_widget, gxg_gtk_info_bar_add_action_widget_w, 3, 0, 0, H_gtk_info_bar_add_action_widget, pl_tuui);
+ Xg_define_procedure(gtk_info_bar_add_button, gxg_gtk_info_bar_add_button_w, 3, 0, 0, H_gtk_info_bar_add_button, pl_pusi);
+ Xg_define_procedure(gtk_info_bar_set_response_sensitive, gxg_gtk_info_bar_set_response_sensitive_w, 3, 0, 0, H_gtk_info_bar_set_response_sensitive, pl_tuib);
+ Xg_define_procedure(gtk_info_bar_set_default_response, gxg_gtk_info_bar_set_default_response_w, 2, 0, 0, H_gtk_info_bar_set_default_response, pl_tui);
+ Xg_define_procedure(gtk_info_bar_response, gxg_gtk_info_bar_response_w, 2, 0, 0, H_gtk_info_bar_response, pl_tui);
+ Xg_define_procedure(gtk_info_bar_set_message_type, gxg_gtk_info_bar_set_message_type_w, 2, 0, 0, H_gtk_info_bar_set_message_type, pl_tui);
+ Xg_define_procedure(gtk_info_bar_get_message_type, gxg_gtk_info_bar_get_message_type_w, 1, 0, 0, H_gtk_info_bar_get_message_type, pl_iu);
+ Xg_define_procedure(gdk_window_ensure_native, gxg_gdk_window_ensure_native_w, 1, 0, 0, H_gdk_window_ensure_native, pl_bu);
+ Xg_define_procedure(gdk_window_get_root_coords, gxg_gdk_window_get_root_coords_w, 3, 2, 0, H_gdk_window_get_root_coords, pl_tuiiu);
+ Xg_define_procedure(gdk_offscreen_window_set_embedder, gxg_gdk_offscreen_window_set_embedder_w, 2, 0, 0, H_gdk_offscreen_window_set_embedder, pl_tu);
+ Xg_define_procedure(gdk_offscreen_window_get_embedder, gxg_gdk_offscreen_window_get_embedder_w, 1, 0, 0, H_gdk_offscreen_window_get_embedder, pl_pu);
+ Xg_define_procedure(gdk_window_geometry_changed, gxg_gdk_window_geometry_changed_w, 1, 0, 0, H_gdk_window_geometry_changed, pl_tu);
+ Xg_define_procedure(gtk_menu_set_reserve_toggle_size, gxg_gtk_menu_set_reserve_toggle_size_w, 2, 0, 0, H_gtk_menu_set_reserve_toggle_size, pl_tub);
+ Xg_define_procedure(gtk_menu_get_reserve_toggle_size, gxg_gtk_menu_get_reserve_toggle_size_w, 1, 0, 0, H_gtk_menu_get_reserve_toggle_size, pl_bu);
+ Xg_define_procedure(gtk_entry_new_with_buffer, gxg_gtk_entry_new_with_buffer_w, 1, 0, 0, H_gtk_entry_new_with_buffer, pl_pu);
+ Xg_define_procedure(gtk_entry_get_buffer, gxg_gtk_entry_get_buffer_w, 1, 0, 0, H_gtk_entry_get_buffer, pl_pu);
+ Xg_define_procedure(gtk_entry_set_buffer, gxg_gtk_entry_set_buffer_w, 2, 0, 0, H_gtk_entry_set_buffer, pl_tu);
+ Xg_define_procedure(gtk_label_set_track_visited_links, gxg_gtk_label_set_track_visited_links_w, 2, 0, 0, H_gtk_label_set_track_visited_links, pl_tub);
+ Xg_define_procedure(gtk_label_get_track_visited_links, gxg_gtk_label_get_track_visited_links_w, 1, 0, 0, H_gtk_label_get_track_visited_links, pl_bu);
+ Xg_define_procedure(gtk_print_operation_set_embed_page_setup, gxg_gtk_print_operation_set_embed_page_setup_w, 2, 0, 0, H_gtk_print_operation_set_embed_page_setup, pl_tub);
+ Xg_define_procedure(gtk_print_operation_get_embed_page_setup, gxg_gtk_print_operation_get_embed_page_setup_w, 1, 0, 0, H_gtk_print_operation_get_embed_page_setup, pl_bu);
+ Xg_define_procedure(gtk_entry_buffer_new, gxg_gtk_entry_buffer_new_w, 2, 0, 0, H_gtk_entry_buffer_new, pl_psi);
+ Xg_define_procedure(gtk_entry_buffer_get_bytes, gxg_gtk_entry_buffer_get_bytes_w, 1, 0, 0, H_gtk_entry_buffer_get_bytes, pl_iu);
+ Xg_define_procedure(gtk_entry_buffer_get_length, gxg_gtk_entry_buffer_get_length_w, 1, 0, 0, H_gtk_entry_buffer_get_length, pl_iu);
+ Xg_define_procedure(gtk_entry_buffer_get_text, gxg_gtk_entry_buffer_get_text_w, 1, 0, 0, H_gtk_entry_buffer_get_text, pl_su);
+ Xg_define_procedure(gtk_entry_buffer_set_text, gxg_gtk_entry_buffer_set_text_w, 3, 0, 0, H_gtk_entry_buffer_set_text, pl_tusi);
+ Xg_define_procedure(gtk_entry_buffer_set_max_length, gxg_gtk_entry_buffer_set_max_length_w, 2, 0, 0, H_gtk_entry_buffer_set_max_length, pl_tui);
+ Xg_define_procedure(gtk_entry_buffer_get_max_length, gxg_gtk_entry_buffer_get_max_length_w, 1, 0, 0, H_gtk_entry_buffer_get_max_length, pl_iu);
+ Xg_define_procedure(gtk_entry_buffer_insert_text, gxg_gtk_entry_buffer_insert_text_w, 4, 0, 0, H_gtk_entry_buffer_insert_text, pl_iuisi);
+ Xg_define_procedure(gtk_entry_buffer_delete_text, gxg_gtk_entry_buffer_delete_text_w, 3, 0, 0, H_gtk_entry_buffer_delete_text, pl_iui);
+ Xg_define_procedure(gtk_entry_buffer_emit_inserted_text, gxg_gtk_entry_buffer_emit_inserted_text_w, 4, 0, 0, H_gtk_entry_buffer_emit_inserted_text, pl_tuisi);
+ Xg_define_procedure(gtk_entry_buffer_emit_deleted_text, gxg_gtk_entry_buffer_emit_deleted_text_w, 3, 0, 0, H_gtk_entry_buffer_emit_deleted_text, pl_tui);
+ Xg_define_procedure(gtk_cell_renderer_set_alignment, gxg_gtk_cell_renderer_set_alignment_w, 3, 0, 0, H_gtk_cell_renderer_set_alignment, pl_tur);
+ Xg_define_procedure(gtk_cell_renderer_get_alignment, gxg_gtk_cell_renderer_get_alignment_w, 1, 2, 0, H_gtk_cell_renderer_get_alignment, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_set_padding, gxg_gtk_cell_renderer_set_padding_w, 3, 0, 0, H_gtk_cell_renderer_set_padding, pl_tui);
+ Xg_define_procedure(gtk_cell_renderer_get_padding, gxg_gtk_cell_renderer_get_padding_w, 1, 2, 0, H_gtk_cell_renderer_get_padding, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_set_visible, gxg_gtk_cell_renderer_set_visible_w, 2, 0, 0, H_gtk_cell_renderer_set_visible, pl_tub);
+ Xg_define_procedure(gtk_cell_renderer_get_visible, gxg_gtk_cell_renderer_get_visible_w, 1, 0, 0, H_gtk_cell_renderer_get_visible, pl_bu);
+ Xg_define_procedure(gtk_cell_renderer_set_sensitive, gxg_gtk_cell_renderer_set_sensitive_w, 2, 0, 0, H_gtk_cell_renderer_set_sensitive, pl_tub);
+ Xg_define_procedure(gtk_cell_renderer_get_sensitive, gxg_gtk_cell_renderer_get_sensitive_w, 1, 0, 0, H_gtk_cell_renderer_get_sensitive, pl_bu);
+ Xg_define_procedure(gtk_cell_renderer_toggle_get_activatable, gxg_gtk_cell_renderer_toggle_get_activatable_w, 1, 0, 0, H_gtk_cell_renderer_toggle_get_activatable, pl_bu);
+ Xg_define_procedure(gtk_cell_renderer_toggle_set_activatable, gxg_gtk_cell_renderer_toggle_set_activatable_w, 2, 0, 0, H_gtk_cell_renderer_toggle_set_activatable, pl_tub);
+ Xg_define_procedure(gtk_widget_set_can_focus, gxg_gtk_widget_set_can_focus_w, 2, 0, 0, H_gtk_widget_set_can_focus, pl_tub);
+ Xg_define_procedure(gtk_widget_get_can_focus, gxg_gtk_widget_get_can_focus_w, 1, 0, 0, H_gtk_widget_get_can_focus, pl_bu);
+ Xg_define_procedure(gtk_widget_has_focus, gxg_gtk_widget_has_focus_w, 1, 0, 0, H_gtk_widget_has_focus, pl_bu);
+ Xg_define_procedure(gtk_widget_set_can_default, gxg_gtk_widget_set_can_default_w, 2, 0, 0, H_gtk_widget_set_can_default, pl_tub);
+ Xg_define_procedure(gtk_widget_get_can_default, gxg_gtk_widget_get_can_default_w, 1, 0, 0, H_gtk_widget_get_can_default, pl_bu);
+ Xg_define_procedure(gtk_widget_has_default, gxg_gtk_widget_has_default_w, 1, 0, 0, H_gtk_widget_has_default, pl_bu);
+ Xg_define_procedure(gtk_widget_get_sensitive, gxg_gtk_widget_get_sensitive_w, 1, 0, 0, H_gtk_widget_get_sensitive, pl_bu);
+ Xg_define_procedure(gtk_widget_is_sensitive, gxg_gtk_widget_is_sensitive_w, 1, 0, 0, H_gtk_widget_is_sensitive, pl_bu);
+ Xg_define_procedure(gtk_widget_set_has_window, gxg_gtk_widget_set_has_window_w, 2, 0, 0, H_gtk_widget_set_has_window, pl_tub);
+ Xg_define_procedure(gtk_widget_get_has_window, gxg_gtk_widget_get_has_window_w, 1, 0, 0, H_gtk_widget_get_has_window, pl_bu);
+ Xg_define_procedure(gtk_widget_get_app_paintable, gxg_gtk_widget_get_app_paintable_w, 1, 0, 0, H_gtk_widget_get_app_paintable, pl_bu);
+ Xg_define_procedure(gdk_window_get_cursor, gxg_gdk_window_get_cursor_w, 1, 0, 0, H_gdk_window_get_cursor, pl_pu);
+ Xg_define_procedure(gtk_file_chooser_set_create_folders, gxg_gtk_file_chooser_set_create_folders_w, 2, 0, 0, H_gtk_file_chooser_set_create_folders, pl_tub);
+ Xg_define_procedure(gtk_file_chooser_get_create_folders, gxg_gtk_file_chooser_get_create_folders_w, 1, 0, 0, H_gtk_file_chooser_get_create_folders, pl_bu);
+ Xg_define_procedure(gtk_icon_view_set_item_padding, gxg_gtk_icon_view_set_item_padding_w, 2, 0, 0, H_gtk_icon_view_set_item_padding, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_item_padding, gxg_gtk_icon_view_get_item_padding_w, 1, 0, 0, H_gtk_icon_view_get_item_padding, pl_iu);
+ Xg_define_procedure(gtk_widget_has_grab, gxg_gtk_widget_has_grab_w, 1, 0, 0, H_gtk_widget_has_grab, pl_bu);
+ Xg_define_procedure(gtk_widget_set_visible, gxg_gtk_widget_set_visible_w, 2, 0, 0, H_gtk_widget_set_visible, pl_tub);
+ Xg_define_procedure(gtk_widget_get_visible, gxg_gtk_widget_get_visible_w, 1, 0, 0, H_gtk_widget_get_visible, pl_bu);
+ Xg_define_procedure(gtk_range_set_flippable, gxg_gtk_range_set_flippable_w, 2, 0, 0, H_gtk_range_set_flippable, pl_tub);
+ Xg_define_procedure(gtk_range_get_flippable, gxg_gtk_range_get_flippable_w, 1, 0, 0, H_gtk_range_get_flippable, pl_bu);
+ Xg_define_procedure(gtk_widget_is_toplevel, gxg_gtk_widget_is_toplevel_w, 1, 0, 0, H_gtk_widget_is_toplevel, pl_bu);
+ Xg_define_procedure(gtk_widget_is_drawable, gxg_gtk_widget_is_drawable_w, 1, 0, 0, H_gtk_widget_is_drawable, pl_bu);
+ Xg_define_procedure(gtk_widget_set_window, gxg_gtk_widget_set_window_w, 2, 0, 0, H_gtk_widget_set_window, pl_tu);
+ Xg_define_procedure(gdk_window_is_destroyed, gxg_gdk_window_is_destroyed_w, 1, 0, 0, H_gdk_window_is_destroyed, pl_bu);
+ Xg_define_procedure(gdk_window_restack, gxg_gdk_window_restack_w, 3, 0, 0, H_gdk_window_restack, pl_tuub);
+ Xg_define_procedure(gtk_widget_set_receives_default, gxg_gtk_widget_set_receives_default_w, 2, 0, 0, H_gtk_widget_set_receives_default, pl_tub);
+ Xg_define_procedure(gtk_widget_get_receives_default, gxg_gtk_widget_get_receives_default_w, 1, 0, 0, H_gtk_widget_get_receives_default, pl_bu);
#endif
-#define gxg_GDK_IS_DRAG_CONTEXT_w gxg_GDK_IS_DRAG_CONTEXT
-#define gxg_GDK_IS_DEVICE_w gxg_GDK_IS_DEVICE
-#define gxg_GDK_IS_KEYMAP_w gxg_GDK_IS_KEYMAP
-#define gxg_GDK_IS_VISUAL_w gxg_GDK_IS_VISUAL
-#define gxg_GDK_IS_WINDOW_w gxg_GDK_IS_WINDOW
-#define gxg_GDK_IS_PIXBUF_w gxg_GDK_IS_PIXBUF
-#define gxg_GDK_IS_PIXBUF_ANIMATION_w gxg_GDK_IS_PIXBUF_ANIMATION
-#define gxg_GDK_IS_PIXBUF_ANIMATION_ITER_w gxg_GDK_IS_PIXBUF_ANIMATION_ITER
-#define gxg_GTK_IS_VBOX_w gxg_GTK_IS_VBOX
-#define gxg_GTK_IS_ACCEL_GROUP_w gxg_GTK_IS_ACCEL_GROUP
-#define gxg_GTK_IS_ACCEL_LABEL_w gxg_GTK_IS_ACCEL_LABEL
-#define gxg_GTK_IS_ACCESSIBLE_w gxg_GTK_IS_ACCESSIBLE
-#define gxg_GTK_IS_ADJUSTMENT_w gxg_GTK_IS_ADJUSTMENT
-#define gxg_GTK_IS_ALIGNMENT_w gxg_GTK_IS_ALIGNMENT
-#define gxg_GTK_IS_ARROW_w gxg_GTK_IS_ARROW
-#define gxg_GTK_IS_ASPECT_FRAME_w gxg_GTK_IS_ASPECT_FRAME
-#define gxg_GTK_IS_BUTTON_BOX_w gxg_GTK_IS_BUTTON_BOX
-#define gxg_GTK_IS_BIN_w gxg_GTK_IS_BIN
-#define gxg_GTK_IS_BOX_w gxg_GTK_IS_BOX
-#define gxg_GTK_IS_BUTTON_w gxg_GTK_IS_BUTTON
-#define gxg_GTK_IS_CALENDAR_w gxg_GTK_IS_CALENDAR
-#define gxg_GTK_IS_CELL_EDITABLE_w gxg_GTK_IS_CELL_EDITABLE
-#define gxg_GTK_IS_CELL_RENDERER_w gxg_GTK_IS_CELL_RENDERER
-#define gxg_GTK_IS_CELL_RENDERER_PIXBUF_w gxg_GTK_IS_CELL_RENDERER_PIXBUF
-#define gxg_GTK_IS_CELL_RENDERER_TEXT_w gxg_GTK_IS_CELL_RENDERER_TEXT
-#define gxg_GTK_IS_CELL_RENDERER_TOGGLE_w gxg_GTK_IS_CELL_RENDERER_TOGGLE
-#define gxg_GTK_IS_CHECK_BUTTON_w gxg_GTK_IS_CHECK_BUTTON
-#define gxg_GTK_IS_CHECK_MENU_ITEM_w gxg_GTK_IS_CHECK_MENU_ITEM
-#define gxg_GTK_IS_COLOR_SELECTION_DIALOG_w gxg_GTK_IS_COLOR_SELECTION_DIALOG
-#define gxg_GTK_IS_COLOR_SELECTION_w gxg_GTK_IS_COLOR_SELECTION
-#define gxg_GTK_IS_CONTAINER_w gxg_GTK_IS_CONTAINER
-#define gxg_GTK_IS_DIALOG_w gxg_GTK_IS_DIALOG
-#define gxg_GTK_IS_DRAWING_AREA_w gxg_GTK_IS_DRAWING_AREA
-#define gxg_GTK_IS_EDITABLE_w gxg_GTK_IS_EDITABLE
-#define gxg_GTK_IS_ENTRY_w gxg_GTK_IS_ENTRY
-#define gxg_GTK_IS_EVENT_BOX_w gxg_GTK_IS_EVENT_BOX
-#define gxg_GTK_IS_FIXED_w gxg_GTK_IS_FIXED
-#define gxg_GTK_IS_FONT_SELECTION_w gxg_GTK_IS_FONT_SELECTION
-#define gxg_GTK_IS_FONT_SELECTION_DIALOG_w gxg_GTK_IS_FONT_SELECTION_DIALOG
-#define gxg_GTK_IS_FRAME_w gxg_GTK_IS_FRAME
-#define gxg_GTK_IS_HANDLE_BOX_w gxg_GTK_IS_HANDLE_BOX
-#define gxg_GTK_IS_HBUTTON_BOX_w gxg_GTK_IS_HBUTTON_BOX
-#define gxg_GTK_IS_HBOX_w gxg_GTK_IS_HBOX
-#define gxg_GTK_IS_HPANED_w gxg_GTK_IS_HPANED
-#define gxg_GTK_IS_HSCALE_w gxg_GTK_IS_HSCALE
-#define gxg_GTK_IS_HSCROLLBAR_w gxg_GTK_IS_HSCROLLBAR
-#define gxg_GTK_IS_HSEPARATOR_w gxg_GTK_IS_HSEPARATOR
-#define gxg_GTK_IS_ICON_FACTORY_w gxg_GTK_IS_ICON_FACTORY
-#define gxg_GTK_IS_IMAGE_w gxg_GTK_IS_IMAGE
-#define gxg_GTK_IS_IMAGE_MENU_ITEM_w gxg_GTK_IS_IMAGE_MENU_ITEM
-#define gxg_GTK_IS_IM_CONTEXT_w gxg_GTK_IS_IM_CONTEXT
-#define gxg_GTK_IS_IM_CONTEXT_SIMPLE_w gxg_GTK_IS_IM_CONTEXT_SIMPLE
-#define gxg_GTK_IS_IM_MULTICONTEXT_w gxg_GTK_IS_IM_MULTICONTEXT
-#define gxg_GTK_IS_INVISIBLE_w gxg_GTK_IS_INVISIBLE
-#define gxg_GTK_IS_LABEL_w gxg_GTK_IS_LABEL
-#define gxg_GTK_IS_LAYOUT_w gxg_GTK_IS_LAYOUT
-#define gxg_GTK_IS_LIST_STORE_w gxg_GTK_IS_LIST_STORE
-#define gxg_GTK_IS_MENU_BAR_w gxg_GTK_IS_MENU_BAR
-#define gxg_GTK_IS_MENU_w gxg_GTK_IS_MENU
-#define gxg_GTK_IS_MENU_ITEM_w gxg_GTK_IS_MENU_ITEM
-#define gxg_GTK_IS_MENU_SHELL_w gxg_GTK_IS_MENU_SHELL
-#define gxg_GTK_IS_MISC_w gxg_GTK_IS_MISC
-#define gxg_GTK_IS_NOTEBOOK_w gxg_GTK_IS_NOTEBOOK
-#define gxg_GTK_IS_PANED_w gxg_GTK_IS_PANED
-#define gxg_GTK_IS_PROGRESS_BAR_w gxg_GTK_IS_PROGRESS_BAR
-#define gxg_GTK_IS_RADIO_BUTTON_w gxg_GTK_IS_RADIO_BUTTON
-#define gxg_GTK_IS_RADIO_MENU_ITEM_w gxg_GTK_IS_RADIO_MENU_ITEM
-#define gxg_GTK_IS_RANGE_w gxg_GTK_IS_RANGE
-#define gxg_GTK_IS_SCALE_w gxg_GTK_IS_SCALE
-#define gxg_GTK_IS_SCROLLBAR_w gxg_GTK_IS_SCROLLBAR
-#define gxg_GTK_IS_SCROLLED_WINDOW_w gxg_GTK_IS_SCROLLED_WINDOW
-#define gxg_GTK_IS_SEPARATOR_w gxg_GTK_IS_SEPARATOR
-#define gxg_GTK_IS_SEPARATOR_MENU_ITEM_w gxg_GTK_IS_SEPARATOR_MENU_ITEM
-#define gxg_GTK_IS_SIZE_GROUP_w gxg_GTK_IS_SIZE_GROUP
-#define gxg_GTK_IS_SPIN_BUTTON_w gxg_GTK_IS_SPIN_BUTTON
-#define gxg_GTK_IS_STATUSBAR_w gxg_GTK_IS_STATUSBAR
-#define gxg_GTK_IS_TABLE_w gxg_GTK_IS_TABLE
-#define gxg_GTK_IS_TEAROFF_MENU_ITEM_w gxg_GTK_IS_TEAROFF_MENU_ITEM
-#define gxg_GTK_IS_TEXT_BUFFER_w gxg_GTK_IS_TEXT_BUFFER
-#define gxg_GTK_IS_TEXT_CHILD_ANCHOR_w gxg_GTK_IS_TEXT_CHILD_ANCHOR
-#define gxg_GTK_IS_TEXT_MARK_w gxg_GTK_IS_TEXT_MARK
-#define gxg_GTK_IS_TEXT_TAG_w gxg_GTK_IS_TEXT_TAG
-#define gxg_GTK_IS_TEXT_TAG_TABLE_w gxg_GTK_IS_TEXT_TAG_TABLE
-#define gxg_GTK_IS_TEXT_VIEW_w gxg_GTK_IS_TEXT_VIEW
-#define gxg_GTK_IS_TOGGLE_BUTTON_w gxg_GTK_IS_TOGGLE_BUTTON
-#define gxg_GTK_IS_TOOLBAR_w gxg_GTK_IS_TOOLBAR
-#define gxg_GTK_IS_TREE_DRAG_SOURCE_w gxg_GTK_IS_TREE_DRAG_SOURCE
-#define gxg_GTK_IS_TREE_DRAG_DEST_w gxg_GTK_IS_TREE_DRAG_DEST
-#define gxg_GTK_IS_TREE_MODEL_w gxg_GTK_IS_TREE_MODEL
-#define gxg_GTK_IS_TREE_MODEL_SORT_w gxg_GTK_IS_TREE_MODEL_SORT
-#define gxg_GTK_IS_TREE_SELECTION_w gxg_GTK_IS_TREE_SELECTION
-#define gxg_GTK_IS_TREE_SORTABLE_w gxg_GTK_IS_TREE_SORTABLE
-#define gxg_GTK_IS_TREE_STORE_w gxg_GTK_IS_TREE_STORE
-#define gxg_GTK_IS_TREE_VIEW_COLUMN_w gxg_GTK_IS_TREE_VIEW_COLUMN
-#define gxg_GTK_IS_TREE_VIEW_w gxg_GTK_IS_TREE_VIEW
-#define gxg_GTK_IS_VBUTTON_BOX_w gxg_GTK_IS_VBUTTON_BOX
-#define gxg_GTK_IS_VIEWPORT_w gxg_GTK_IS_VIEWPORT
-#define gxg_GTK_IS_VPANED_w gxg_GTK_IS_VPANED
-#define gxg_GTK_IS_VSCALE_w gxg_GTK_IS_VSCALE
-#define gxg_GTK_IS_VSCROLLBAR_w gxg_GTK_IS_VSCROLLBAR
-#define gxg_GTK_IS_VSEPARATOR_w gxg_GTK_IS_VSEPARATOR
-#define gxg_GTK_IS_WIDGET_w gxg_GTK_IS_WIDGET
-#define gxg_GTK_IS_WINDOW_w gxg_GTK_IS_WINDOW
-#define gxg_PANGO_IS_CONTEXT_w gxg_PANGO_IS_CONTEXT
-#define gxg_PANGO_IS_FONT_FAMILY_w gxg_PANGO_IS_FONT_FAMILY
-#define gxg_PANGO_IS_FONT_FACE_w gxg_PANGO_IS_FONT_FACE
-#define gxg_PANGO_IS_FONT_w gxg_PANGO_IS_FONT
-#define gxg_PANGO_IS_FONT_MAP_w gxg_PANGO_IS_FONT_MAP
-#define gxg_PANGO_IS_LAYOUT_w gxg_PANGO_IS_LAYOUT
-#define gxg_G_IS_OBJECT_w gxg_G_IS_OBJECT
-#define gxg_GDK_IS_SCREEN_w gxg_GDK_IS_SCREEN
-#define gxg_GDK_IS_DISPLAY_w gxg_GDK_IS_DISPLAY
-#define gxg_GTK_IS_FILE_CHOOSER_DIALOG_w gxg_GTK_IS_FILE_CHOOSER_DIALOG
-#define gxg_GTK_IS_FILE_CHOOSER_WIDGET_w gxg_GTK_IS_FILE_CHOOSER_WIDGET
-#define gxg_GTK_IS_TREE_MODEL_FILTER_w gxg_GTK_IS_TREE_MODEL_FILTER
-#define gxg_GTK_IS_ACTION_w gxg_GTK_IS_ACTION
-#define gxg_GTK_IS_ACTION_GROUP_w gxg_GTK_IS_ACTION_GROUP
-#define gxg_GTK_IS_COMBO_BOX_w gxg_GTK_IS_COMBO_BOX
-#define gxg_GTK_IS_EXPANDER_w gxg_GTK_IS_EXPANDER
-#define gxg_GTK_IS_FONT_BUTTON_w gxg_GTK_IS_FONT_BUTTON
-#define gxg_GTK_IS_COLOR_BUTTON_w gxg_GTK_IS_COLOR_BUTTON
-#define gxg_GTK_IS_ENTRY_COMPLETION_w gxg_GTK_IS_ENTRY_COMPLETION
-#define gxg_GTK_IS_RADIO_TOOL_BUTTON_w gxg_GTK_IS_RADIO_TOOL_BUTTON
-#define gxg_GTK_IS_RADIO_ACTION_w gxg_GTK_IS_RADIO_ACTION
-#define gxg_GTK_IS_SEPARATOR_TOOL_ITEM_w gxg_GTK_IS_SEPARATOR_TOOL_ITEM
-#define gxg_GTK_IS_TOGGLE_ACTION_w gxg_GTK_IS_TOGGLE_ACTION
-#define gxg_GTK_IS_TOGGLE_TOOL_BUTTON_w gxg_GTK_IS_TOGGLE_TOOL_BUTTON
-#define gxg_GTK_IS_FILE_FILTER_w gxg_GTK_IS_FILE_FILTER
-#define gxg_GTK_IS_CELL_LAYOUT_w gxg_GTK_IS_CELL_LAYOUT
-#define gxg_GTK_IS_CLIPBOARD_w gxg_GTK_IS_CLIPBOARD
-#define gxg_GTK_IS_FILE_CHOOSER_w gxg_GTK_IS_FILE_CHOOSER
-#define gxg_GTK_IS_ICON_THEME_w gxg_GTK_IS_ICON_THEME
-#define gxg_GTK_IS_TOOL_BUTTON_w gxg_GTK_IS_TOOL_BUTTON
-#define gxg_GTK_IS_TOOL_ITEM_w gxg_GTK_IS_TOOL_ITEM
-#define gxg_GTK_IS_ACCEL_MAP_w gxg_GTK_IS_ACCEL_MAP
-#define gxg_GTK_IS_CELL_VIEW_w gxg_GTK_IS_CELL_VIEW
-#define gxg_GTK_IS_ABOUT_DIALOG_w gxg_GTK_IS_ABOUT_DIALOG
-#define gxg_GTK_IS_CELL_RENDERER_COMBO_w gxg_GTK_IS_CELL_RENDERER_COMBO
-#define gxg_GTK_IS_CELL_RENDERER_PROGRESS_w gxg_GTK_IS_CELL_RENDERER_PROGRESS
-#define gxg_GTK_IS_ICON_VIEW_w gxg_GTK_IS_ICON_VIEW
-#define gxg_GTK_IS_FILE_CHOOSER_BUTTON_w gxg_GTK_IS_FILE_CHOOSER_BUTTON
-#define gxg_GTK_IS_MENU_TOOL_BUTTON_w gxg_GTK_IS_MENU_TOOL_BUTTON
-#define gxg_GTK_IS_ASSISTANT_w gxg_GTK_IS_ASSISTANT
-#define gxg_GTK_IS_CELL_RENDERER_ACCEL_w gxg_GTK_IS_CELL_RENDERER_ACCEL
-#define gxg_GTK_IS_CELL_RENDERER_SPIN_w gxg_GTK_IS_CELL_RENDERER_SPIN
-#define gxg_GTK_IS_LINK_BUTTON_w gxg_GTK_IS_LINK_BUTTON
-#define gxg_GTK_IS_RECENT_CHOOSER_DIALOG_w gxg_GTK_IS_RECENT_CHOOSER_DIALOG
-#define gxg_GTK_IS_RECENT_CHOOSER_w gxg_GTK_IS_RECENT_CHOOSER
-#define gxg_GTK_IS_RECENT_CHOOSER_MENU_w gxg_GTK_IS_RECENT_CHOOSER_MENU
-#define gxg_GTK_IS_RECENT_CHOOSER_WIDGET_w gxg_GTK_IS_RECENT_CHOOSER_WIDGET
-#define gxg_GTK_IS_RECENT_FILTER_w gxg_GTK_IS_RECENT_FILTER
-#define gxg_GTK_IS_RECENT_MANAGER_w gxg_GTK_IS_RECENT_MANAGER
-#define gxg_GTK_IS_STATUS_ICON_w gxg_GTK_IS_STATUS_ICON
-#define gxg_GTK_IS_PRINT_CONTEXT_w gxg_GTK_IS_PRINT_CONTEXT
-#define gxg_GTK_IS_PRINT_OPERATION_w gxg_GTK_IS_PRINT_OPERATION
-#define gxg_GTK_IS_PRINT_OPERATION_PREVIEW_w gxg_GTK_IS_PRINT_OPERATION_PREVIEW
-#define gxg_GTK_IS_PRINT_SETTINGS_w gxg_GTK_IS_PRINT_SETTINGS
-#define gxg_GTK_IS_TOOLTIP_w gxg_GTK_IS_TOOLTIP
-#if HAVE_GTK_INFO_BAR_NEW
-#define gxg_GTK_IS_INFO_BAR_w gxg_GTK_IS_INFO_BAR
+#if GTK_CHECK_VERSION(2, 20, 0)
+ Xg_define_procedure(gtk_dialog_get_widget_for_response, gxg_gtk_dialog_get_widget_for_response_w, 2, 0, 0, H_gtk_dialog_get_widget_for_response, pl_pui);
+ Xg_define_procedure(gtk_viewport_get_bin_window, gxg_gtk_viewport_get_bin_window_w, 1, 0, 0, H_gtk_viewport_get_bin_window, pl_pu);
+ Xg_define_procedure(gtk_spinner_new, gxg_gtk_spinner_new_w, 0, 0, 0, H_gtk_spinner_new, pl_p);
+ Xg_define_procedure(gtk_spinner_start, gxg_gtk_spinner_start_w, 1, 0, 0, H_gtk_spinner_start, pl_tu);
+ Xg_define_procedure(gtk_spinner_stop, gxg_gtk_spinner_stop_w, 1, 0, 0, H_gtk_spinner_stop, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_spinner_new, gxg_gtk_cell_renderer_spinner_new_w, 0, 0, 0, H_gtk_cell_renderer_spinner_new, pl_p);
+ Xg_define_procedure(gtk_notebook_get_action_widget, gxg_gtk_notebook_get_action_widget_w, 2, 0, 0, H_gtk_notebook_get_action_widget, pl_pui);
+ Xg_define_procedure(gtk_notebook_set_action_widget, gxg_gtk_notebook_set_action_widget_w, 3, 0, 0, H_gtk_notebook_set_action_widget, pl_tuui);
+ Xg_define_procedure(gtk_statusbar_get_message_area, gxg_gtk_statusbar_get_message_area_w, 1, 0, 0, H_gtk_statusbar_get_message_area, pl_pu);
+ Xg_define_procedure(gtk_tool_item_get_ellipsize_mode, gxg_gtk_tool_item_get_ellipsize_mode_w, 1, 0, 0, H_gtk_tool_item_get_ellipsize_mode, pl_iu);
+ Xg_define_procedure(gtk_tool_item_get_text_alignment, gxg_gtk_tool_item_get_text_alignment_w, 1, 0, 0, H_gtk_tool_item_get_text_alignment, pl_du);
+ Xg_define_procedure(gtk_tool_item_get_text_orientation, gxg_gtk_tool_item_get_text_orientation_w, 1, 0, 0, H_gtk_tool_item_get_text_orientation, pl_iu);
+ Xg_define_procedure(gtk_tool_item_get_text_size_group, gxg_gtk_tool_item_get_text_size_group_w, 1, 0, 0, H_gtk_tool_item_get_text_size_group, pl_pu);
+ Xg_define_procedure(gtk_tool_palette_new, gxg_gtk_tool_palette_new_w, 0, 0, 0, H_gtk_tool_palette_new, pl_p);
+ Xg_define_procedure(gtk_tool_palette_set_group_position, gxg_gtk_tool_palette_set_group_position_w, 3, 0, 0, H_gtk_tool_palette_set_group_position, pl_tuui);
+ Xg_define_procedure(gtk_tool_palette_set_exclusive, gxg_gtk_tool_palette_set_exclusive_w, 3, 0, 0, H_gtk_tool_palette_set_exclusive, pl_tuub);
+ Xg_define_procedure(gtk_tool_palette_set_expand, gxg_gtk_tool_palette_set_expand_w, 3, 0, 0, H_gtk_tool_palette_set_expand, pl_tuub);
+ Xg_define_procedure(gtk_tool_palette_get_group_position, gxg_gtk_tool_palette_get_group_position_w, 2, 0, 0, H_gtk_tool_palette_get_group_position, pl_iu);
+ Xg_define_procedure(gtk_tool_palette_get_exclusive, gxg_gtk_tool_palette_get_exclusive_w, 2, 0, 0, H_gtk_tool_palette_get_exclusive, pl_bu);
+ Xg_define_procedure(gtk_tool_palette_get_expand, gxg_gtk_tool_palette_get_expand_w, 2, 0, 0, H_gtk_tool_palette_get_expand, pl_bu);
+ Xg_define_procedure(gtk_tool_palette_unset_icon_size, gxg_gtk_tool_palette_unset_icon_size_w, 1, 0, 0, H_gtk_tool_palette_unset_icon_size, pl_tu);
+ Xg_define_procedure(gtk_tool_palette_set_style, gxg_gtk_tool_palette_set_style_w, 2, 0, 0, H_gtk_tool_palette_set_style, pl_tui);
+ Xg_define_procedure(gtk_tool_palette_unset_style, gxg_gtk_tool_palette_unset_style_w, 1, 0, 0, H_gtk_tool_palette_unset_style, pl_tu);
+ Xg_define_procedure(gtk_tool_palette_get_style, gxg_gtk_tool_palette_get_style_w, 1, 0, 0, H_gtk_tool_palette_get_style, pl_iu);
+ Xg_define_procedure(gtk_tool_palette_get_drop_item, gxg_gtk_tool_palette_get_drop_item_w, 3, 0, 0, H_gtk_tool_palette_get_drop_item, pl_pui);
+ Xg_define_procedure(gtk_tool_palette_get_drop_group, gxg_gtk_tool_palette_get_drop_group_w, 3, 0, 0, H_gtk_tool_palette_get_drop_group, pl_pui);
+ Xg_define_procedure(gtk_tool_palette_get_drag_item, gxg_gtk_tool_palette_get_drag_item_w, 2, 0, 0, H_gtk_tool_palette_get_drag_item, pl_pu);
+ Xg_define_procedure(gtk_tool_palette_set_drag_source, gxg_gtk_tool_palette_set_drag_source_w, 2, 0, 0, H_gtk_tool_palette_set_drag_source, pl_tui);
+ Xg_define_procedure(gtk_tool_palette_add_drag_dest, gxg_gtk_tool_palette_add_drag_dest_w, 5, 0, 0, H_gtk_tool_palette_add_drag_dest, pl_tuui);
+ Xg_define_procedure(gtk_tool_palette_get_drag_target_item, gxg_gtk_tool_palette_get_drag_target_item_w, 0, 0, 0, H_gtk_tool_palette_get_drag_target_item, pl_p);
+ Xg_define_procedure(gtk_tool_palette_get_drag_target_group, gxg_gtk_tool_palette_get_drag_target_group_w, 0, 0, 0, H_gtk_tool_palette_get_drag_target_group, pl_p);
+ Xg_define_procedure(gtk_tool_item_group_new, gxg_gtk_tool_item_group_new_w, 1, 0, 0, H_gtk_tool_item_group_new, pl_ps);
+ Xg_define_procedure(gtk_tool_item_group_set_label, gxg_gtk_tool_item_group_set_label_w, 2, 0, 0, H_gtk_tool_item_group_set_label, pl_tus);
+ Xg_define_procedure(gtk_tool_item_group_set_label_widget, gxg_gtk_tool_item_group_set_label_widget_w, 2, 0, 0, H_gtk_tool_item_group_set_label_widget, pl_tu);
+ Xg_define_procedure(gtk_tool_item_group_set_collapsed, gxg_gtk_tool_item_group_set_collapsed_w, 2, 0, 0, H_gtk_tool_item_group_set_collapsed, pl_tub);
+ Xg_define_procedure(gtk_tool_item_group_set_ellipsize, gxg_gtk_tool_item_group_set_ellipsize_w, 2, 0, 0, H_gtk_tool_item_group_set_ellipsize, pl_tui);
+ Xg_define_procedure(gtk_tool_item_group_set_header_relief, gxg_gtk_tool_item_group_set_header_relief_w, 2, 0, 0, H_gtk_tool_item_group_set_header_relief, pl_tui);
+ Xg_define_procedure(gtk_tool_item_group_get_label, gxg_gtk_tool_item_group_get_label_w, 1, 0, 0, H_gtk_tool_item_group_get_label, pl_su);
+ Xg_define_procedure(gtk_tool_item_group_get_label_widget, gxg_gtk_tool_item_group_get_label_widget_w, 1, 0, 0, H_gtk_tool_item_group_get_label_widget, pl_pu);
+ Xg_define_procedure(gtk_tool_item_group_get_collapsed, gxg_gtk_tool_item_group_get_collapsed_w, 1, 0, 0, H_gtk_tool_item_group_get_collapsed, pl_bu);
+ Xg_define_procedure(gtk_tool_item_group_get_ellipsize, gxg_gtk_tool_item_group_get_ellipsize_w, 1, 0, 0, H_gtk_tool_item_group_get_ellipsize, pl_iu);
+ Xg_define_procedure(gtk_tool_item_group_get_header_relief, gxg_gtk_tool_item_group_get_header_relief_w, 1, 0, 0, H_gtk_tool_item_group_get_header_relief, pl_iu);
+ Xg_define_procedure(gtk_tool_item_group_insert, gxg_gtk_tool_item_group_insert_w, 3, 0, 0, H_gtk_tool_item_group_insert, pl_tuui);
+ Xg_define_procedure(gtk_tool_item_group_set_item_position, gxg_gtk_tool_item_group_set_item_position_w, 3, 0, 0, H_gtk_tool_item_group_set_item_position, pl_tuui);
+ Xg_define_procedure(gtk_tool_item_group_get_item_position, gxg_gtk_tool_item_group_get_item_position_w, 2, 0, 0, H_gtk_tool_item_group_get_item_position, pl_iu);
+ Xg_define_procedure(gtk_tool_item_group_get_n_items, gxg_gtk_tool_item_group_get_n_items_w, 1, 0, 0, H_gtk_tool_item_group_get_n_items, pl_iu);
+ Xg_define_procedure(gtk_tool_item_group_get_nth_item, gxg_gtk_tool_item_group_get_nth_item_w, 2, 0, 0, H_gtk_tool_item_group_get_nth_item, pl_pui);
+ Xg_define_procedure(gtk_tool_item_group_get_drop_item, gxg_gtk_tool_item_group_get_drop_item_w, 3, 0, 0, H_gtk_tool_item_group_get_drop_item, pl_pui);
+ Xg_define_procedure(gdk_screen_get_primary_monitor, gxg_gdk_screen_get_primary_monitor_w, 1, 0, 0, H_gdk_screen_get_primary_monitor, pl_iu);
+ Xg_define_procedure(gtk_window_set_mnemonics_visible, gxg_gtk_window_set_mnemonics_visible_w, 2, 0, 0, H_gtk_window_set_mnemonics_visible, pl_tub);
+ Xg_define_procedure(gtk_window_get_mnemonics_visible, gxg_gtk_window_get_mnemonics_visible_w, 1, 0, 0, H_gtk_window_get_mnemonics_visible, pl_bu);
+ Xg_define_procedure(gtk_range_set_slider_size_fixed, gxg_gtk_range_set_slider_size_fixed_w, 2, 0, 0, H_gtk_range_set_slider_size_fixed, pl_tub);
+ Xg_define_procedure(gtk_range_get_slider_size_fixed, gxg_gtk_range_get_slider_size_fixed_w, 1, 0, 0, H_gtk_range_get_slider_size_fixed, pl_bu);
+ Xg_define_procedure(gtk_range_set_min_slider_size, gxg_gtk_range_set_min_slider_size_w, 2, 0, 0, H_gtk_range_set_min_slider_size, pl_tub);
+ Xg_define_procedure(gtk_range_get_min_slider_size, gxg_gtk_range_get_min_slider_size_w, 1, 0, 0, H_gtk_range_get_min_slider_size, pl_iu);
+ Xg_define_procedure(gtk_range_get_range_rect, gxg_gtk_range_get_range_rect_w, 2, 0, 0, H_gtk_range_get_range_rect, pl_tu);
+ Xg_define_procedure(gtk_range_get_slider_range, gxg_gtk_range_get_slider_range_w, 1, 2, 0, H_gtk_range_get_slider_range, pl_tu);
+ Xg_define_procedure(gtk_paned_get_handle_window, gxg_gtk_paned_get_handle_window_w, 1, 0, 0, H_gtk_paned_get_handle_window, pl_pu);
+ Xg_define_procedure(gtk_widget_set_realized, gxg_gtk_widget_set_realized_w, 2, 0, 0, H_gtk_widget_set_realized, pl_tub);
+ Xg_define_procedure(gtk_widget_get_realized, gxg_gtk_widget_get_realized_w, 1, 0, 0, H_gtk_widget_get_realized, pl_bu);
+ Xg_define_procedure(gtk_widget_set_mapped, gxg_gtk_widget_set_mapped_w, 2, 0, 0, H_gtk_widget_set_mapped, pl_tub);
+ Xg_define_procedure(gtk_widget_get_mapped, gxg_gtk_widget_get_mapped_w, 1, 0, 0, H_gtk_widget_get_mapped, pl_bu);
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
-#define gxg_GTK_IS_ENTRY_BUFFER_w gxg_GTK_IS_ENTRY_BUFFER
+#if GTK_CHECK_VERSION(3, 0, 0)
+ Xg_define_procedure(gdk_cairo_create, gxg_gdk_cairo_create_w, 1, 0, 0, H_gdk_cairo_create, pl_pu);
+ Xg_define_procedure(gdk_window_get_geometry, gxg_gdk_window_get_geometry_w, 1, 4, 0, H_gdk_window_get_geometry, pl_tu);
+ Xg_define_procedure(gdk_keymap_add_virtual_modifiers, gxg_gdk_keymap_add_virtual_modifiers_w, 2, 0, 0, H_gdk_keymap_add_virtual_modifiers, pl_tu);
+ Xg_define_procedure(gdk_window_coords_to_parent, gxg_gdk_window_coords_to_parent_w, 3, 2, 0, H_gdk_window_coords_to_parent, pl_turru);
+ Xg_define_procedure(gdk_window_coords_from_parent, gxg_gdk_window_coords_from_parent_w, 3, 2, 0, H_gdk_window_coords_from_parent, pl_turru);
+ Xg_define_procedure(gdk_window_get_effective_parent, gxg_gdk_window_get_effective_parent_w, 1, 0, 0, H_gdk_window_get_effective_parent, pl_pu);
+ Xg_define_procedure(gdk_window_get_effective_toplevel, gxg_gdk_window_get_effective_toplevel_w, 1, 0, 0, H_gdk_window_get_effective_toplevel, pl_pu);
+ Xg_define_procedure(gtk_accessible_get_widget, gxg_gtk_accessible_get_widget_w, 1, 0, 0, H_gtk_accessible_get_widget, pl_pu);
+ Xg_define_procedure(gtk_widget_send_focus_change, gxg_gtk_widget_send_focus_change_w, 2, 0, 0, H_gtk_widget_send_focus_change, pl_bu);
+ Xg_define_procedure(gdk_display_get_device_manager, gxg_gdk_display_get_device_manager_w, 1, 0, 0, H_gdk_display_get_device_manager, pl_pu);
+ Xg_define_procedure(gdk_drag_context_set_device, gxg_gdk_drag_context_set_device_w, 2, 0, 0, H_gdk_drag_context_set_device, pl_tu);
+ Xg_define_procedure(gdk_drag_context_get_device, gxg_gdk_drag_context_get_device_w, 1, 0, 0, H_gdk_drag_context_get_device, pl_pu);
+ Xg_define_procedure(gdk_drag_context_list_targets, gxg_gdk_drag_context_list_targets_w, 1, 0, 0, H_gdk_drag_context_list_targets, pl_pu);
+ Xg_define_procedure(gdk_event_set_device, gxg_gdk_event_set_device_w, 2, 0, 0, H_gdk_event_set_device, pl_tu);
+ Xg_define_procedure(gdk_event_get_device, gxg_gdk_event_get_device_w, 1, 0, 0, H_gdk_event_get_device, pl_pu);
+ Xg_define_procedure(gdk_events_get_distance, gxg_gdk_events_get_distance_w, 2, 1, 0, H_gdk_events_get_distance, pl_bu);
+ Xg_define_procedure(gdk_events_get_angle, gxg_gdk_events_get_angle_w, 2, 1, 0, H_gdk_events_get_angle, pl_bu);
+ Xg_define_procedure(gdk_events_get_center, gxg_gdk_events_get_center_w, 2, 2, 0, H_gdk_events_get_center, pl_bu);
+ Xg_define_procedure(gdk_window_get_accept_focus, gxg_gdk_window_get_accept_focus_w, 1, 0, 0, H_gdk_window_get_accept_focus, pl_bu);
+ Xg_define_procedure(gdk_window_get_focus_on_map, gxg_gdk_window_get_focus_on_map_w, 1, 0, 0, H_gdk_window_get_focus_on_map, pl_bu);
+ Xg_define_procedure(gdk_window_is_input_only, gxg_gdk_window_is_input_only_w, 1, 0, 0, H_gdk_window_is_input_only, pl_bu);
+ Xg_define_procedure(gdk_window_is_shaped, gxg_gdk_window_is_shaped_w, 1, 0, 0, H_gdk_window_is_shaped, pl_bu);
+ Xg_define_procedure(gdk_window_get_modal_hint, gxg_gdk_window_get_modal_hint_w, 1, 0, 0, H_gdk_window_get_modal_hint, pl_bu);
+ Xg_define_procedure(gdk_window_set_device_cursor, gxg_gdk_window_set_device_cursor_w, 3, 0, 0, H_gdk_window_set_device_cursor, pl_tu);
+ Xg_define_procedure(gdk_window_get_device_cursor, gxg_gdk_window_get_device_cursor_w, 2, 0, 0, H_gdk_window_get_device_cursor, pl_pu);
+ Xg_define_procedure(gdk_window_get_device_position, gxg_gdk_window_get_device_position_w, 2, 3, 0, H_gdk_window_get_device_position, pl_pu);
+ Xg_define_procedure(gdk_window_set_device_events, gxg_gdk_window_set_device_events_w, 3, 0, 0, H_gdk_window_set_device_events, pl_tuui);
+ Xg_define_procedure(gdk_window_get_device_events, gxg_gdk_window_get_device_events_w, 2, 0, 0, H_gdk_window_get_device_events, pl_iu);
+ Xg_define_procedure(gtk_combo_box_popup_for_device, gxg_gtk_combo_box_popup_for_device_w, 2, 0, 0, H_gtk_combo_box_popup_for_device, pl_tu);
+ Xg_define_procedure(gtk_device_grab_add, gxg_gtk_device_grab_add_w, 3, 0, 0, H_gtk_device_grab_add, pl_tuub);
+ Xg_define_procedure(gtk_device_grab_remove, gxg_gtk_device_grab_remove_w, 2, 0, 0, H_gtk_device_grab_remove, pl_tu);
+ Xg_define_procedure(gtk_get_current_event_device, gxg_gtk_get_current_event_device_w, 0, 0, 0, H_gtk_get_current_event_device, pl_p);
+ Xg_define_procedure(gtk_paned_new, gxg_gtk_paned_new_w, 1, 0, 0, H_gtk_paned_new, pl_pi);
+ Xg_define_procedure(gtk_scale_new, gxg_gtk_scale_new_w, 2, 0, 0, H_gtk_scale_new, pl_piu);
+ Xg_define_procedure(gtk_scale_new_with_range, gxg_gtk_scale_new_with_range_w, 4, 0, 0, H_gtk_scale_new_with_range, pl_pir);
+ Xg_define_procedure(gtk_scrollbar_new, gxg_gtk_scrollbar_new_w, 2, 0, 0, H_gtk_scrollbar_new, pl_piu);
+ Xg_define_procedure(gtk_separator_new, gxg_gtk_separator_new_w, 1, 0, 0, H_gtk_separator_new, pl_pi);
+ Xg_define_procedure(gtk_widget_device_is_shadowed, gxg_gtk_widget_device_is_shadowed_w, 2, 0, 0, H_gtk_widget_device_is_shadowed, pl_bu);
+ Xg_define_procedure(gtk_widget_set_device_events, gxg_gtk_widget_set_device_events_w, 3, 0, 0, H_gtk_widget_set_device_events, pl_tuui);
+ Xg_define_procedure(gtk_widget_add_device_events, gxg_gtk_widget_add_device_events_w, 3, 0, 0, H_gtk_widget_add_device_events, pl_tuui);
+ Xg_define_procedure(gtk_widget_get_support_multidevice, gxg_gtk_widget_get_support_multidevice_w, 1, 0, 0, H_gtk_widget_get_support_multidevice, pl_bu);
+ Xg_define_procedure(gtk_widget_set_support_multidevice, gxg_gtk_widget_set_support_multidevice_w, 2, 0, 0, H_gtk_widget_set_support_multidevice, pl_tub);
+ Xg_define_procedure(gtk_widget_get_device_events, gxg_gtk_widget_get_device_events_w, 2, 0, 0, H_gtk_widget_get_device_events, pl_iu);
+ Xg_define_procedure(gtk_icon_view_get_item_row, gxg_gtk_icon_view_get_item_row_w, 2, 0, 0, H_gtk_icon_view_get_item_row, pl_iu);
+ Xg_define_procedure(gtk_icon_view_get_item_column, gxg_gtk_icon_view_get_item_column_w, 2, 0, 0, H_gtk_icon_view_get_item_column, pl_iu);
+ Xg_define_procedure(gtk_statusbar_remove_all, gxg_gtk_statusbar_remove_all_w, 2, 0, 0, H_gtk_statusbar_remove_all, pl_tui);
+ Xg_define_procedure(gtk_window_has_group, gxg_gtk_window_has_group_w, 1, 0, 0, H_gtk_window_has_group, pl_bu);
+ Xg_define_procedure(gtk_calendar_select_month, gxg_gtk_calendar_select_month_w, 3, 0, 0, H_gtk_calendar_select_month, pl_tui);
+ Xg_define_procedure(gtk_calendar_mark_day, gxg_gtk_calendar_mark_day_w, 2, 0, 0, H_gtk_calendar_mark_day, pl_tui);
+ Xg_define_procedure(gtk_calendar_unmark_day, gxg_gtk_calendar_unmark_day_w, 2, 0, 0, H_gtk_calendar_unmark_day, pl_tui);
+ Xg_define_procedure(gdk_drag_context_get_source_window, gxg_gdk_drag_context_get_source_window_w, 1, 0, 0, H_gdk_drag_context_get_source_window, pl_pu);
+ Xg_define_procedure(gtk_viewport_get_view_window, gxg_gtk_viewport_get_view_window_w, 1, 0, 0, H_gtk_viewport_get_view_window, pl_pu);
+ Xg_define_procedure(gtk_accessible_set_widget, gxg_gtk_accessible_set_widget_w, 2, 0, 0, H_gtk_accessible_set_widget, pl_tu);
+ Xg_define_procedure(gtk_button_get_event_window, gxg_gtk_button_get_event_window_w, 1, 0, 0, H_gtk_button_get_event_window, pl_pu);
+ Xg_define_procedure(gtk_message_dialog_get_message_area, gxg_gtk_message_dialog_get_message_area_w, 1, 0, 0, H_gtk_message_dialog_get_message_area, pl_pu);
+ Xg_define_procedure(gtk_selection_data_get_length, gxg_gtk_selection_data_get_length_w, 1, 0, 0, H_gtk_selection_data_get_length, pl_iu);
+ Xg_define_procedure(gdk_pango_layout_line_get_clip_region, gxg_gdk_pango_layout_line_get_clip_region_w, 5, 0, 0, H_gdk_pango_layout_line_get_clip_region, pl_puiiui);
+ Xg_define_procedure(gdk_pango_layout_get_clip_region, gxg_gdk_pango_layout_get_clip_region_w, 5, 0, 0, H_gdk_pango_layout_get_clip_region, pl_puiiui);
+ Xg_define_procedure(gdk_window_shape_combine_region, gxg_gdk_window_shape_combine_region_w, 4, 0, 0, H_gdk_window_shape_combine_region, pl_tuui);
+ Xg_define_procedure(gdk_window_invalidate_region, gxg_gdk_window_invalidate_region_w, 3, 0, 0, H_gdk_window_invalidate_region, pl_tuub);
+ Xg_define_procedure(gdk_window_get_update_area, gxg_gdk_window_get_update_area_w, 1, 0, 0, H_gdk_window_get_update_area, pl_pu);
+ Xg_define_procedure(gdk_window_begin_paint_region, gxg_gdk_window_begin_paint_region_w, 2, 0, 0, H_gdk_window_begin_paint_region, pl_tu);
+ Xg_define_procedure(gdk_window_move_region, gxg_gdk_window_move_region_w, 4, 0, 0, H_gdk_window_move_region, pl_tuui);
+ Xg_define_procedure(gdk_keymap_get_num_lock_state, gxg_gdk_keymap_get_num_lock_state_w, 1, 0, 0, H_gdk_keymap_get_num_lock_state, pl_bu);
+ Xg_define_procedure(gdk_window_has_native, gxg_gdk_window_has_native_w, 1, 0, 0, H_gdk_window_has_native, pl_bu);
+ Xg_define_procedure(gdk_cursor_get_cursor_type, gxg_gdk_cursor_get_cursor_type_w, 1, 0, 0, H_gdk_cursor_get_cursor_type, pl_iu);
+ Xg_define_procedure(gdk_display_is_closed, gxg_gdk_display_is_closed_w, 1, 0, 0, H_gdk_display_is_closed, pl_bu);
+ Xg_define_procedure(gdk_window_get_background_pattern, gxg_gdk_window_get_background_pattern_w, 1, 0, 0, H_gdk_window_get_background_pattern, pl_pu);
+ Xg_define_procedure(gdk_window_create_similar_surface, gxg_gdk_window_create_similar_surface_w, 4, 0, 0, H_gdk_window_create_similar_surface, pl_pui);
+ Xg_define_procedure(gtk_expander_set_label_fill, gxg_gtk_expander_set_label_fill_w, 2, 0, 0, H_gtk_expander_set_label_fill, pl_tub);
+ Xg_define_procedure(gtk_expander_get_label_fill, gxg_gtk_expander_get_label_fill_w, 1, 0, 0, H_gtk_expander_get_label_fill, pl_bu);
+ Xg_define_procedure(gtk_calendar_get_day_is_marked, gxg_gtk_calendar_get_day_is_marked_w, 2, 0, 0, H_gtk_calendar_get_day_is_marked, pl_bui);
+ Xg_define_procedure(gtk_progress_bar_set_inverted, gxg_gtk_progress_bar_set_inverted_w, 2, 0, 0, H_gtk_progress_bar_set_inverted, pl_tub);
+ Xg_define_procedure(gtk_progress_bar_get_inverted, gxg_gtk_progress_bar_get_inverted_w, 1, 0, 0, H_gtk_progress_bar_get_inverted, pl_bu);
+ Xg_define_procedure(gtk_radio_button_join_group, gxg_gtk_radio_button_join_group_w, 2, 0, 0, H_gtk_radio_button_join_group, pl_tu);
+ Xg_define_procedure(gtk_adjustment_new, gxg_gtk_adjustment_new_w, 6, 0, 0, H_gtk_adjustment_new, pl_pr);
+ Xg_define_procedure(gtk_binding_set_activate, gxg_gtk_binding_set_activate_w, 4, 0, 0, H_gtk_binding_set_activate, pl_buiiu);
+ Xg_define_procedure(gtk_bindings_activate, gxg_gtk_bindings_activate_w, 3, 0, 0, H_gtk_bindings_activate, pl_bui);
+ Xg_define_procedure(gtk_icon_view_create_drag_icon, gxg_gtk_icon_view_create_drag_icon_w, 2, 0, 0, H_gtk_icon_view_create_drag_icon, pl_pu);
+ Xg_define_procedure(gtk_tree_view_create_row_drag_icon, gxg_gtk_tree_view_create_row_drag_icon_w, 2, 0, 0, H_gtk_tree_view_create_row_drag_icon, pl_pu);
+ Xg_define_procedure(gdk_cairo_get_clip_rectangle, gxg_gdk_cairo_get_clip_rectangle_w, 2, 0, 0, H_gdk_cairo_get_clip_rectangle, pl_bu);
+ Xg_define_procedure(gdk_cairo_region_create_from_surface, gxg_gdk_cairo_region_create_from_surface_w, 1, 0, 0, H_gdk_cairo_region_create_from_surface, pl_pu);
+ Xg_define_procedure(gdk_window_get_visual, gxg_gdk_window_get_visual_w, 1, 0, 0, H_gdk_window_get_visual, pl_pu);
+ Xg_define_procedure(gdk_window_get_screen, gxg_gdk_window_get_screen_w, 1, 0, 0, H_gdk_window_get_screen, pl_pu);
+ Xg_define_procedure(gdk_window_get_display, gxg_gdk_window_get_display_w, 1, 0, 0, H_gdk_window_get_display, pl_pu);
+ Xg_define_procedure(gdk_window_get_width, gxg_gdk_window_get_width_w, 1, 0, 0, H_gdk_window_get_width, pl_iu);
+ Xg_define_procedure(gdk_window_get_height, gxg_gdk_window_get_height_w, 1, 0, 0, H_gdk_window_get_height, pl_iu);
+ Xg_define_procedure(gtk_cell_renderer_get_request_mode, gxg_gtk_cell_renderer_get_request_mode_w, 1, 0, 0, H_gtk_cell_renderer_get_request_mode, pl_iu);
+ Xg_define_procedure(gtk_cell_renderer_get_preferred_width, gxg_gtk_cell_renderer_get_preferred_width_w, 2, 2, 0, H_gtk_cell_renderer_get_preferred_width, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_get_preferred_height_for_width, gxg_gtk_cell_renderer_get_preferred_height_for_width_w, 3, 2, 0, H_gtk_cell_renderer_get_preferred_height_for_width, pl_tuuiu);
+ Xg_define_procedure(gtk_cell_renderer_get_preferred_height, gxg_gtk_cell_renderer_get_preferred_height_w, 2, 2, 0, H_gtk_cell_renderer_get_preferred_height, pl_tu);
+ Xg_define_procedure(gtk_cell_renderer_get_preferred_width_for_height, gxg_gtk_cell_renderer_get_preferred_width_for_height_w, 3, 2, 0, H_gtk_cell_renderer_get_preferred_width_for_height, pl_tuuiu);
+ Xg_define_procedure(gtk_container_class_handle_border_width, gxg_gtk_container_class_handle_border_width_w, 1, 0, 0, H_gtk_container_class_handle_border_width, pl_tu);
+ Xg_define_procedure(gtk_drag_set_icon_surface, gxg_gtk_drag_set_icon_surface_w, 2, 0, 0, H_gtk_drag_set_icon_surface, pl_tu);
+ Xg_define_procedure(gtk_notebook_set_group_name, gxg_gtk_notebook_set_group_name_w, 2, 0, 0, H_gtk_notebook_set_group_name, pl_tus);
+ Xg_define_procedure(gtk_notebook_get_group_name, gxg_gtk_notebook_get_group_name_w, 1, 0, 0, H_gtk_notebook_get_group_name, pl_su);
+ Xg_define_procedure(gtk_widget_draw, gxg_gtk_widget_draw_w, 2, 0, 0, H_gtk_widget_draw, pl_tu);
+ Xg_define_procedure(gtk_widget_get_request_mode, gxg_gtk_widget_get_request_mode_w, 1, 0, 0, H_gtk_widget_get_request_mode, pl_iu);
+ Xg_define_procedure(gtk_widget_get_preferred_width, gxg_gtk_widget_get_preferred_width_w, 1, 2, 0, H_gtk_widget_get_preferred_width, pl_tu);
+ Xg_define_procedure(gtk_widget_get_preferred_height_for_width, gxg_gtk_widget_get_preferred_height_for_width_w, 2, 2, 0, H_gtk_widget_get_preferred_height_for_width, pl_tuiu);
+ Xg_define_procedure(gtk_widget_get_preferred_height, gxg_gtk_widget_get_preferred_height_w, 1, 2, 0, H_gtk_widget_get_preferred_height, pl_tu);
+ Xg_define_procedure(gtk_widget_get_preferred_width_for_height, gxg_gtk_widget_get_preferred_width_for_height_w, 2, 2, 0, H_gtk_widget_get_preferred_width_for_height, pl_tuiu);
+ Xg_define_procedure(gtk_widget_get_allocated_width, gxg_gtk_widget_get_allocated_width_w, 1, 0, 0, H_gtk_widget_get_allocated_width, pl_iu);
+ Xg_define_procedure(gtk_widget_get_allocated_height, gxg_gtk_widget_get_allocated_height_w, 1, 0, 0, H_gtk_widget_get_allocated_height, pl_iu);
+ Xg_define_procedure(gtk_widget_set_visual, gxg_gtk_widget_set_visual_w, 2, 0, 0, H_gtk_widget_set_visual, pl_tu);
+ Xg_define_procedure(gtk_widget_get_halign, gxg_gtk_widget_get_halign_w, 1, 0, 0, H_gtk_widget_get_halign, pl_iu);
+ Xg_define_procedure(gtk_widget_set_halign, gxg_gtk_widget_set_halign_w, 2, 0, 0, H_gtk_widget_set_halign, pl_tui);
+ Xg_define_procedure(gtk_widget_get_valign, gxg_gtk_widget_get_valign_w, 1, 0, 0, H_gtk_widget_get_valign, pl_iu);
+ Xg_define_procedure(gtk_widget_set_valign, gxg_gtk_widget_set_valign_w, 2, 0, 0, H_gtk_widget_set_valign, pl_tui);
+ Xg_define_procedure(gtk_widget_get_margin_top, gxg_gtk_widget_get_margin_top_w, 1, 0, 0, H_gtk_widget_get_margin_top, pl_iu);
+ Xg_define_procedure(gtk_widget_set_margin_top, gxg_gtk_widget_set_margin_top_w, 2, 0, 0, H_gtk_widget_set_margin_top, pl_tui);
+ Xg_define_procedure(gtk_widget_get_margin_bottom, gxg_gtk_widget_get_margin_bottom_w, 1, 0, 0, H_gtk_widget_get_margin_bottom, pl_iu);
+ Xg_define_procedure(gtk_widget_set_margin_bottom, gxg_gtk_widget_set_margin_bottom_w, 2, 0, 0, H_gtk_widget_set_margin_bottom, pl_tui);
+ Xg_define_procedure(gtk_widget_shape_combine_region, gxg_gtk_widget_shape_combine_region_w, 2, 0, 0, H_gtk_widget_shape_combine_region, pl_tu);
+ Xg_define_procedure(gtk_widget_input_shape_combine_region, gxg_gtk_widget_input_shape_combine_region_w, 2, 0, 0, H_gtk_widget_input_shape_combine_region, pl_tu);
+ Xg_define_procedure(gtk_cairo_should_draw_window, gxg_gtk_cairo_should_draw_window_w, 2, 0, 0, H_gtk_cairo_should_draw_window, pl_bu);
+ Xg_define_procedure(gtk_cairo_transform_to_window, gxg_gtk_cairo_transform_to_window_w, 3, 0, 0, H_gtk_cairo_transform_to_window, pl_tu);
+ Xg_define_procedure(gtk_combo_box_new_with_entry, gxg_gtk_combo_box_new_with_entry_w, 0, 0, 0, H_gtk_combo_box_new_with_entry, pl_p);
+ Xg_define_procedure(gtk_combo_box_get_has_entry, gxg_gtk_combo_box_get_has_entry_w, 1, 0, 0, H_gtk_combo_box_get_has_entry, pl_bu);
+ Xg_define_procedure(gtk_combo_box_set_entry_text_column, gxg_gtk_combo_box_set_entry_text_column_w, 2, 0, 0, H_gtk_combo_box_set_entry_text_column, pl_tui);
+ Xg_define_procedure(gtk_combo_box_get_entry_text_column, gxg_gtk_combo_box_get_entry_text_column_w, 1, 0, 0, H_gtk_combo_box_get_entry_text_column, pl_iu);
+ Xg_define_procedure(gtk_target_entry_new, gxg_gtk_target_entry_new_w, 3, 0, 0, H_gtk_target_entry_new, pl_psi);
+ Xg_define_procedure(gtk_target_entry_copy, gxg_gtk_target_entry_copy_w, 1, 0, 0, H_gtk_target_entry_copy, pl_pu);
+ Xg_define_procedure(gtk_target_entry_free, gxg_gtk_target_entry_free_w, 1, 0, 0, H_gtk_target_entry_free, pl_tu);
+ Xg_define_procedure(gtk_widget_get_hexpand, gxg_gtk_widget_get_hexpand_w, 1, 0, 0, H_gtk_widget_get_hexpand, pl_bu);
+ Xg_define_procedure(gtk_widget_set_hexpand, gxg_gtk_widget_set_hexpand_w, 2, 0, 0, H_gtk_widget_set_hexpand, pl_tub);
+ Xg_define_procedure(gtk_widget_get_hexpand_set, gxg_gtk_widget_get_hexpand_set_w, 1, 0, 0, H_gtk_widget_get_hexpand_set, pl_bu);
+ Xg_define_procedure(gtk_widget_set_hexpand_set, gxg_gtk_widget_set_hexpand_set_w, 2, 0, 0, H_gtk_widget_set_hexpand_set, pl_tub);
+ Xg_define_procedure(gtk_widget_get_vexpand, gxg_gtk_widget_get_vexpand_w, 1, 0, 0, H_gtk_widget_get_vexpand, pl_bu);
+ Xg_define_procedure(gtk_widget_set_vexpand, gxg_gtk_widget_set_vexpand_w, 2, 0, 0, H_gtk_widget_set_vexpand, pl_tub);
+ Xg_define_procedure(gtk_widget_get_vexpand_set, gxg_gtk_widget_get_vexpand_set_w, 1, 0, 0, H_gtk_widget_get_vexpand_set, pl_bu);
+ Xg_define_procedure(gtk_widget_set_vexpand_set, gxg_gtk_widget_set_vexpand_set_w, 2, 0, 0, H_gtk_widget_set_vexpand_set, pl_tub);
+ Xg_define_procedure(gtk_widget_queue_compute_expand, gxg_gtk_widget_queue_compute_expand_w, 1, 0, 0, H_gtk_widget_queue_compute_expand, pl_tu);
+ Xg_define_procedure(gtk_widget_compute_expand, gxg_gtk_widget_compute_expand_w, 2, 0, 0, H_gtk_widget_compute_expand, pl_bui);
+ Xg_define_procedure(gtk_window_set_default_geometry, gxg_gtk_window_set_default_geometry_w, 3, 0, 0, H_gtk_window_set_default_geometry, pl_tui);
+ Xg_define_procedure(gtk_window_resize_to_geometry, gxg_gtk_window_resize_to_geometry_w, 3, 0, 0, H_gtk_window_resize_to_geometry, pl_tui);
+ Xg_define_procedure(gtk_combo_box_text_new, gxg_gtk_combo_box_text_new_w, 0, 0, 0, H_gtk_combo_box_text_new, pl_p);
+ Xg_define_procedure(gtk_combo_box_text_new_with_entry, gxg_gtk_combo_box_text_new_with_entry_w, 0, 0, 0, H_gtk_combo_box_text_new_with_entry, pl_p);
+ Xg_define_procedure(gtk_combo_box_text_append_text, gxg_gtk_combo_box_text_append_text_w, 2, 0, 0, H_gtk_combo_box_text_append_text, pl_tus);
+ Xg_define_procedure(gtk_combo_box_text_insert_text, gxg_gtk_combo_box_text_insert_text_w, 3, 0, 0, H_gtk_combo_box_text_insert_text, pl_tuis);
+ Xg_define_procedure(gtk_combo_box_text_prepend_text, gxg_gtk_combo_box_text_prepend_text_w, 2, 0, 0, H_gtk_combo_box_text_prepend_text, pl_tus);
+ Xg_define_procedure(gtk_combo_box_text_remove, gxg_gtk_combo_box_text_remove_w, 2, 0, 0, H_gtk_combo_box_text_remove, pl_tui);
+ Xg_define_procedure(gtk_combo_box_text_get_active_text, gxg_gtk_combo_box_text_get_active_text_w, 1, 0, 0, H_gtk_combo_box_text_get_active_text, pl_su);
+ Xg_define_procedure(gdk_cairo_set_source_rgba, gxg_gdk_cairo_set_source_rgba_w, 2, 0, 0, H_gdk_cairo_set_source_rgba, pl_tu);
+ Xg_define_procedure(gdk_window_set_background_rgba, gxg_gdk_window_set_background_rgba_w, 2, 0, 0, H_gdk_window_set_background_rgba, pl_tu);
+ Xg_define_procedure(gtk_cell_view_set_background_rgba, gxg_gtk_cell_view_set_background_rgba_w, 2, 0, 0, H_gtk_cell_view_set_background_rgba, pl_tu);
+ Xg_define_procedure(gtk_combo_box_text_remove_all, gxg_gtk_combo_box_text_remove_all_w, 1, 0, 0, H_gtk_combo_box_text_remove_all, pl_tu);
+ Xg_define_procedure(gtk_combo_box_set_popup_fixed_width, gxg_gtk_combo_box_set_popup_fixed_width_w, 2, 0, 0, H_gtk_combo_box_set_popup_fixed_width, pl_tub);
+ Xg_define_procedure(gtk_combo_box_get_popup_fixed_width, gxg_gtk_combo_box_get_popup_fixed_width_w, 1, 0, 0, H_gtk_combo_box_get_popup_fixed_width, pl_bu);
+ Xg_define_procedure(gtk_scrolled_window_get_min_content_width, gxg_gtk_scrolled_window_get_min_content_width_w, 1, 0, 0, H_gtk_scrolled_window_get_min_content_width, pl_iu);
+ Xg_define_procedure(gtk_scrolled_window_set_min_content_width, gxg_gtk_scrolled_window_set_min_content_width_w, 2, 0, 0, H_gtk_scrolled_window_set_min_content_width, pl_tui);
+ Xg_define_procedure(gtk_scrolled_window_get_min_content_height, gxg_gtk_scrolled_window_get_min_content_height_w, 1, 0, 0, H_gtk_scrolled_window_get_min_content_height, pl_iu);
+ Xg_define_procedure(gtk_scrolled_window_set_min_content_height, gxg_gtk_scrolled_window_set_min_content_height_w, 2, 0, 0, H_gtk_scrolled_window_set_min_content_height, pl_tui);
+ Xg_define_procedure(gtk_grid_new, gxg_gtk_grid_new_w, 0, 0, 0, H_gtk_grid_new, pl_p);
+ Xg_define_procedure(gtk_grid_attach, gxg_gtk_grid_attach_w, 6, 0, 0, H_gtk_grid_attach, pl_tuui);
+ Xg_define_procedure(gtk_grid_attach_next_to, gxg_gtk_grid_attach_next_to_w, 6, 0, 0, H_gtk_grid_attach_next_to, pl_tuuui);
+ Xg_define_procedure(gtk_grid_set_row_homogeneous, gxg_gtk_grid_set_row_homogeneous_w, 2, 0, 0, H_gtk_grid_set_row_homogeneous, pl_tub);
+ Xg_define_procedure(gtk_grid_get_row_homogeneous, gxg_gtk_grid_get_row_homogeneous_w, 1, 0, 0, H_gtk_grid_get_row_homogeneous, pl_bu);
+ Xg_define_procedure(gtk_grid_set_row_spacing, gxg_gtk_grid_set_row_spacing_w, 2, 0, 0, H_gtk_grid_set_row_spacing, pl_tui);
+ Xg_define_procedure(gtk_grid_get_row_spacing, gxg_gtk_grid_get_row_spacing_w, 1, 0, 0, H_gtk_grid_get_row_spacing, pl_iu);
+ Xg_define_procedure(gtk_grid_set_column_homogeneous, gxg_gtk_grid_set_column_homogeneous_w, 2, 0, 0, H_gtk_grid_set_column_homogeneous, pl_tub);
+ Xg_define_procedure(gtk_grid_get_column_homogeneous, gxg_gtk_grid_get_column_homogeneous_w, 1, 0, 0, H_gtk_grid_get_column_homogeneous, pl_bu);
+ Xg_define_procedure(gtk_grid_set_column_spacing, gxg_gtk_grid_set_column_spacing_w, 2, 0, 0, H_gtk_grid_set_column_spacing, pl_tui);
+ Xg_define_procedure(gtk_grid_get_column_spacing, gxg_gtk_grid_get_column_spacing_w, 1, 0, 0, H_gtk_grid_get_column_spacing, pl_iu);
+ Xg_define_procedure(gtk_scrollable_get_hadjustment, gxg_gtk_scrollable_get_hadjustment_w, 1, 0, 0, H_gtk_scrollable_get_hadjustment, pl_pu);
+ Xg_define_procedure(gtk_scrollable_set_hadjustment, gxg_gtk_scrollable_set_hadjustment_w, 2, 0, 0, H_gtk_scrollable_set_hadjustment, pl_tu);
+ Xg_define_procedure(gtk_scrollable_get_vadjustment, gxg_gtk_scrollable_get_vadjustment_w, 1, 0, 0, H_gtk_scrollable_get_vadjustment, pl_pu);
+ Xg_define_procedure(gtk_scrollable_set_vadjustment, gxg_gtk_scrollable_set_vadjustment_w, 2, 0, 0, H_gtk_scrollable_set_vadjustment, pl_tu);
+ Xg_define_procedure(gtk_assistant_next_page, gxg_gtk_assistant_next_page_w, 1, 0, 0, H_gtk_assistant_next_page, pl_tu);
+ Xg_define_procedure(gtk_assistant_previous_page, gxg_gtk_assistant_previous_page_w, 1, 0, 0, H_gtk_assistant_previous_page, pl_tu);
+ Xg_define_procedure(gtk_combo_box_new_with_model_and_entry, gxg_gtk_combo_box_new_with_model_and_entry_w, 1, 0, 0, H_gtk_combo_box_new_with_model_and_entry, pl_pu);
+ Xg_define_procedure(gtk_scrollable_get_hscroll_policy, gxg_gtk_scrollable_get_hscroll_policy_w, 1, 0, 0, H_gtk_scrollable_get_hscroll_policy, pl_iu);
+ Xg_define_procedure(gtk_scrollable_set_hscroll_policy, gxg_gtk_scrollable_set_hscroll_policy_w, 2, 0, 0, H_gtk_scrollable_set_hscroll_policy, pl_tui);
+ Xg_define_procedure(gtk_scrollable_get_vscroll_policy, gxg_gtk_scrollable_get_vscroll_policy_w, 1, 0, 0, H_gtk_scrollable_get_vscroll_policy, pl_iu);
+ Xg_define_procedure(gtk_scrollable_set_vscroll_policy, gxg_gtk_scrollable_set_vscroll_policy_w, 2, 0, 0, H_gtk_scrollable_set_vscroll_policy, pl_tui);
+ Xg_define_procedure(gtk_switch_new, gxg_gtk_switch_new_w, 0, 0, 0, H_gtk_switch_new, pl_p);
+ Xg_define_procedure(gtk_switch_set_active, gxg_gtk_switch_set_active_w, 2, 0, 0, H_gtk_switch_set_active, pl_tub);
+ Xg_define_procedure(gtk_switch_get_active, gxg_gtk_switch_get_active_w, 1, 0, 0, H_gtk_switch_get_active, pl_bu);
+ Xg_define_procedure(gdk_window_get_clip_region, gxg_gdk_window_get_clip_region_w, 1, 0, 0, H_gdk_window_get_clip_region, pl_pu);
+ Xg_define_procedure(gdk_window_get_visible_region, gxg_gdk_window_get_visible_region_w, 1, 0, 0, H_gdk_window_get_visible_region, pl_pu);
+ Xg_define_procedure(gtk_border_new, gxg_gtk_border_new_w, 0, 0, 0, H_gtk_border_new, pl_p);
+ Xg_define_procedure(gtk_border_copy, gxg_gtk_border_copy_w, 1, 0, 0, H_gtk_border_copy, pl_pu);
+ Xg_define_procedure(gtk_border_free, gxg_gtk_border_free_w, 1, 0, 0, H_gtk_border_free, pl_tu);
+ Xg_define_procedure(gtk_combo_box_get_id_column, gxg_gtk_combo_box_get_id_column_w, 1, 0, 0, H_gtk_combo_box_get_id_column, pl_iu);
+ Xg_define_procedure(gtk_combo_box_set_id_column, gxg_gtk_combo_box_set_id_column_w, 2, 0, 0, H_gtk_combo_box_set_id_column, pl_tui);
+ Xg_define_procedure(gtk_combo_box_get_active_id, gxg_gtk_combo_box_get_active_id_w, 1, 0, 0, H_gtk_combo_box_get_active_id, pl_su);
+ Xg_define_procedure(gtk_combo_box_text_insert, gxg_gtk_combo_box_text_insert_w, 4, 0, 0, H_gtk_combo_box_text_insert, pl_tuis);
+ Xg_define_procedure(gtk_combo_box_text_append, gxg_gtk_combo_box_text_append_w, 3, 0, 0, H_gtk_combo_box_text_append, pl_tus);
+ Xg_define_procedure(gtk_combo_box_text_prepend, gxg_gtk_combo_box_text_prepend_w, 3, 0, 0, H_gtk_combo_box_text_prepend, pl_tus);
+ Xg_define_procedure(gtk_button_box_new, gxg_gtk_button_box_new_w, 1, 0, 0, H_gtk_button_box_new, pl_pi);
+ Xg_define_procedure(gtk_box_new, gxg_gtk_box_new_w, 2, 0, 0, H_gtk_box_new, pl_pi);
+ Xg_define_procedure(gtk_tree_view_set_cursor_on_cell, gxg_gtk_tree_view_set_cursor_on_cell_w, 5, 0, 0, H_gtk_tree_view_set_cursor_on_cell, pl_tuuuub);
+ Xg_define_procedure(gtk_tree_view_set_rubber_banding, gxg_gtk_tree_view_set_rubber_banding_w, 2, 0, 0, H_gtk_tree_view_set_rubber_banding, pl_tub);
+ Xg_define_procedure(gtk_tree_view_get_rubber_banding, gxg_gtk_tree_view_get_rubber_banding_w, 1, 0, 0, H_gtk_tree_view_get_rubber_banding, pl_bu);
+ Xg_define_procedure(gtk_tooltip_set_markup, gxg_gtk_tooltip_set_markup_w, 2, 0, 0, H_gtk_tooltip_set_markup, pl_tus);
+ Xg_define_procedure(gtk_tooltip_set_icon, gxg_gtk_tooltip_set_icon_w, 2, 0, 0, H_gtk_tooltip_set_icon, pl_tu);
+ Xg_define_procedure(gtk_tooltip_set_custom, gxg_gtk_tooltip_set_custom_w, 2, 0, 0, H_gtk_tooltip_set_custom, pl_tu);
+ Xg_define_procedure(gtk_tooltip_trigger_tooltip_query, gxg_gtk_tooltip_trigger_tooltip_query_w, 1, 0, 0, H_gtk_tooltip_trigger_tooltip_query, pl_tu);
+ Xg_define_procedure(gtk_button_set_image_position, gxg_gtk_button_set_image_position_w, 2, 0, 0, H_gtk_button_set_image_position, pl_tui);
+ Xg_define_procedure(gtk_button_get_image_position, gxg_gtk_button_get_image_position_w, 1, 0, 0, H_gtk_button_get_image_position, pl_iu);
+ Xg_define_procedure(gtk_show_uri, gxg_gtk_show_uri_w, 3, 1, 0, H_gtk_show_uri, pl_busiu);
+ Xg_define_procedure(gtk_tree_view_column_new_with_area, gxg_gtk_tree_view_column_new_with_area_w, 1, 0, 0, H_gtk_tree_view_column_new_with_area, pl_pu);
+ Xg_define_procedure(gtk_tree_view_column_get_button, gxg_gtk_tree_view_column_get_button_w, 1, 0, 0, H_gtk_tree_view_column_get_button, pl_pu);
+ Xg_define_procedure(gtk_tree_view_column_focus_cell, gxg_gtk_tree_view_column_focus_cell_w, 2, 0, 0, H_gtk_tree_view_column_focus_cell, pl_tu);
+ Xg_define_procedure(gtk_clipboard_wait_is_uris_available, gxg_gtk_clipboard_wait_is_uris_available_w, 1, 0, 0, H_gtk_clipboard_wait_is_uris_available, pl_bu);
+ Xg_define_procedure(gtk_toolbar_set_drop_highlight_item, gxg_gtk_toolbar_set_drop_highlight_item_w, 3, 0, 0, H_gtk_toolbar_set_drop_highlight_item, pl_tuui);
+ Xg_define_procedure(gtk_tool_item_toolbar_reconfigured, gxg_gtk_tool_item_toolbar_reconfigured_w, 1, 0, 0, H_gtk_tool_item_toolbar_reconfigured, pl_tu);
+ Xg_define_procedure(gtk_orientable_set_orientation, gxg_gtk_orientable_set_orientation_w, 2, 0, 0, H_gtk_orientable_set_orientation, pl_tui);
+ Xg_define_procedure(gtk_orientable_get_orientation, gxg_gtk_orientable_get_orientation_w, 1, 0, 0, H_gtk_orientable_get_orientation, pl_iu);
+ Xg_define_procedure(gtk_parse_args, gxg_gtk_parse_args_w, 0, 2, 0, H_gtk_parse_args, pl_tu);
+ Xg_define_procedure(gtk_get_major_version, gxg_gtk_get_major_version_w, 0, 0, 0, H_gtk_get_major_version, pl_i);
+ Xg_define_procedure(gtk_get_minor_version, gxg_gtk_get_minor_version_w, 0, 0, 0, H_gtk_get_minor_version, pl_i);
+ Xg_define_procedure(gtk_get_micro_version, gxg_gtk_get_micro_version_w, 0, 0, 0, H_gtk_get_micro_version, pl_i);
+ Xg_define_procedure(gtk_get_binary_age, gxg_gtk_get_binary_age_w, 0, 0, 0, H_gtk_get_binary_age, pl_i);
+ Xg_define_procedure(gtk_get_interface_age, gxg_gtk_get_interface_age_w, 0, 0, 0, H_gtk_get_interface_age, pl_i);
+ Xg_define_procedure(gtk_progress_bar_set_show_text, gxg_gtk_progress_bar_set_show_text_w, 2, 0, 0, H_gtk_progress_bar_set_show_text, pl_tub);
+ Xg_define_procedure(gtk_progress_bar_get_show_text, gxg_gtk_progress_bar_get_show_text_w, 1, 0, 0, H_gtk_progress_bar_get_show_text, pl_bu);
+ Xg_define_procedure(gtk_invisible_new_for_screen, gxg_gtk_invisible_new_for_screen_w, 1, 0, 0, H_gtk_invisible_new_for_screen, pl_pu);
+ Xg_define_procedure(gtk_invisible_set_screen, gxg_gtk_invisible_set_screen_w, 2, 0, 0, H_gtk_invisible_set_screen, pl_tu);
+ Xg_define_procedure(gtk_invisible_get_screen, gxg_gtk_invisible_get_screen_w, 1, 0, 0, H_gtk_invisible_get_screen, pl_pu);
+ Xg_define_procedure(gtk_entry_get_icon_storage_type, gxg_gtk_entry_get_icon_storage_type_w, 2, 0, 0, H_gtk_entry_get_icon_storage_type, pl_iui);
+ Xg_define_procedure(gtk_entry_get_icon_pixbuf, gxg_gtk_entry_get_icon_pixbuf_w, 2, 0, 0, H_gtk_entry_get_icon_pixbuf, pl_pui);
+ Xg_define_procedure(gtk_entry_get_icon_gicon, gxg_gtk_entry_get_icon_gicon_w, 2, 0, 0, H_gtk_entry_get_icon_gicon, pl_pui);
+ Xg_define_procedure(gtk_container_propagate_draw, gxg_gtk_container_propagate_draw_w, 3, 0, 0, H_gtk_container_propagate_draw, pl_tu);
+ Xg_define_procedure(gtk_container_set_focus_chain, gxg_gtk_container_set_focus_chain_w, 2, 0, 0, H_gtk_container_set_focus_chain, pl_tu);
+ Xg_define_procedure(gtk_container_get_focus_chain, gxg_gtk_container_get_focus_chain_w, 1, 1, 0, H_gtk_container_get_focus_chain, pl_bu);
+ Xg_define_procedure(gtk_container_unset_focus_chain, gxg_gtk_container_unset_focus_chain_w, 1, 0, 0, H_gtk_container_unset_focus_chain, pl_tu);
+ Xg_define_procedure(gtk_container_set_focus_child, gxg_gtk_container_set_focus_child_w, 2, 0, 0, H_gtk_container_set_focus_child, pl_tu);
+ Xg_define_procedure(gtk_container_set_focus_vadjustment, gxg_gtk_container_set_focus_vadjustment_w, 2, 0, 0, H_gtk_container_set_focus_vadjustment, pl_tu);
+ Xg_define_procedure(gtk_container_get_focus_vadjustment, gxg_gtk_container_get_focus_vadjustment_w, 1, 0, 0, H_gtk_container_get_focus_vadjustment, pl_pu);
+ Xg_define_procedure(gtk_container_set_focus_hadjustment, gxg_gtk_container_set_focus_hadjustment_w, 2, 0, 0, H_gtk_container_set_focus_hadjustment, pl_tu);
+ Xg_define_procedure(gtk_container_get_focus_hadjustment, gxg_gtk_container_get_focus_hadjustment_w, 1, 0, 0, H_gtk_container_get_focus_hadjustment, pl_pu);
+ Xg_define_procedure(gtk_assistant_commit, gxg_gtk_assistant_commit_w, 1, 0, 0, H_gtk_assistant_commit, pl_tu);
+ Xg_define_procedure(gtk_window_set_skip_taskbar_hint, gxg_gtk_window_set_skip_taskbar_hint_w, 2, 0, 0, H_gtk_window_set_skip_taskbar_hint, pl_tub);
+ Xg_define_procedure(gtk_window_get_skip_taskbar_hint, gxg_gtk_window_get_skip_taskbar_hint_w, 1, 0, 0, H_gtk_window_get_skip_taskbar_hint, pl_bu);
+ Xg_define_procedure(gtk_window_set_skip_pager_hint, gxg_gtk_window_set_skip_pager_hint_w, 2, 0, 0, H_gtk_window_set_skip_pager_hint, pl_tub);
+ Xg_define_procedure(gtk_window_get_skip_pager_hint, gxg_gtk_window_get_skip_pager_hint_w, 1, 0, 0, H_gtk_window_get_skip_pager_hint, pl_bu);
+ Xg_define_procedure(gtk_window_set_screen, gxg_gtk_window_set_screen_w, 2, 0, 0, H_gtk_window_set_screen, pl_tu);
+ Xg_define_procedure(gtk_window_get_screen, gxg_gtk_window_get_screen_w, 1, 0, 0, H_gtk_window_get_screen, pl_pu);
+ Xg_define_procedure(gtk_window_set_icon_from_file, gxg_gtk_window_set_icon_from_file_w, 2, 1, 0, H_gtk_window_set_icon_from_file, pl_busu);
+ Xg_define_procedure(gtk_window_set_default_icon_from_file, gxg_gtk_window_set_default_icon_from_file_w, 1, 1, 0, H_gtk_window_set_default_icon_from_file, pl_bsu);
+ Xg_define_procedure(gtk_window_fullscreen, gxg_gtk_window_fullscreen_w, 1, 0, 0, H_gtk_window_fullscreen, pl_tu);
+ Xg_define_procedure(gtk_window_unfullscreen, gxg_gtk_window_unfullscreen_w, 1, 0, 0, H_gtk_window_unfullscreen, pl_tu);
+ Xg_define_procedure(gtk_window_get_window_type, gxg_gtk_window_get_window_type_w, 1, 0, 0, H_gtk_window_get_window_type, pl_iu);
+ Xg_define_procedure(gtk_window_group_add_window, gxg_gtk_window_group_add_window_w, 2, 0, 0, H_gtk_window_group_add_window, pl_tu);
+ Xg_define_procedure(gtk_window_group_remove_window, gxg_gtk_window_group_remove_window_w, 2, 0, 0, H_gtk_window_group_remove_window, pl_tu);
+ Xg_define_procedure(gtk_window_group_new, gxg_gtk_window_group_new_w, 0, 0, 0, H_gtk_window_group_new, pl_p);
+ Xg_define_procedure(gtk_window_get_group, gxg_gtk_window_get_group_w, 1, 0, 0, H_gtk_window_get_group, pl_pu);
+ Xg_define_procedure(gtk_window_group_list_windows, gxg_gtk_window_group_list_windows_w, 1, 0, 0, H_gtk_window_group_list_windows, pl_pu);
+ Xg_define_procedure(gtk_window_group_get_current_device_grab, gxg_gtk_window_group_get_current_device_grab_w, 2, 0, 0, H_gtk_window_group_get_current_device_grab, pl_pu);
+ Xg_define_procedure(gtk_window_group_get_current_grab, gxg_gtk_window_group_get_current_grab_w, 1, 0, 0, H_gtk_window_group_get_current_grab, pl_pu);
+ Xg_define_procedure(gtk_selection_data_get_data, gxg_gtk_selection_data_get_data_w, 1, 0, 0, H_gtk_selection_data_get_data, pl_su);
+ Xg_define_procedure(gtk_selection_owner_set_for_display, gxg_gtk_selection_owner_set_for_display_w, 4, 0, 0, H_gtk_selection_owner_set_for_display, pl_buuti);
+ Xg_define_procedure(gtk_tool_shell_get_text_orientation, gxg_gtk_tool_shell_get_text_orientation_w, 1, 0, 0, H_gtk_tool_shell_get_text_orientation, pl_iu);
+ Xg_define_procedure(gtk_tool_shell_get_text_alignment, gxg_gtk_tool_shell_get_text_alignment_w, 1, 0, 0, H_gtk_tool_shell_get_text_alignment, pl_du);
+ Xg_define_procedure(gtk_tool_shell_get_ellipsize_mode, gxg_gtk_tool_shell_get_ellipsize_mode_w, 1, 0, 0, H_gtk_tool_shell_get_ellipsize_mode, pl_iu);
+ Xg_define_procedure(gtk_tool_shell_get_text_size_group, gxg_gtk_tool_shell_get_text_size_group_w, 1, 0, 0, H_gtk_tool_shell_get_text_size_group, pl_pu);
+ Xg_define_procedure(gtk_tool_shell_get_orientation, gxg_gtk_tool_shell_get_orientation_w, 1, 0, 0, H_gtk_tool_shell_get_orientation, pl_iu);
+ Xg_define_procedure(gtk_tool_shell_get_style, gxg_gtk_tool_shell_get_style_w, 1, 0, 0, H_gtk_tool_shell_get_style, pl_iu);
+ Xg_define_procedure(gtk_tool_shell_get_relief_style, gxg_gtk_tool_shell_get_relief_style_w, 1, 0, 0, H_gtk_tool_shell_get_relief_style, pl_iu);
+ Xg_define_procedure(gtk_tool_shell_rebuild_menu, gxg_gtk_tool_shell_rebuild_menu_w, 1, 0, 0, H_gtk_tool_shell_rebuild_menu, pl_tu);
+ Xg_define_procedure(gtk_accel_map_lock_path, gxg_gtk_accel_map_lock_path_w, 1, 0, 0, H_gtk_accel_map_lock_path, pl_ts);
+ Xg_define_procedure(gtk_accel_map_unlock_path, gxg_gtk_accel_map_unlock_path_w, 1, 0, 0, H_gtk_accel_map_unlock_path, pl_ts);
+ Xg_define_procedure(gtk_icon_theme_lookup_by_gicon, gxg_gtk_icon_theme_lookup_by_gicon_w, 4, 0, 0, H_gtk_icon_theme_lookup_by_gicon, pl_puui);
+ Xg_define_procedure(gtk_icon_info_new_for_pixbuf, gxg_gtk_icon_info_new_for_pixbuf_w, 2, 0, 0, H_gtk_icon_info_new_for_pixbuf, pl_pu);
+ Xg_define_procedure(gtk_icon_view_set_item_orientation, gxg_gtk_icon_view_set_item_orientation_w, 2, 0, 0, H_gtk_icon_view_set_item_orientation, pl_tui);
+ Xg_define_procedure(gtk_icon_view_get_item_orientation, gxg_gtk_icon_view_get_item_orientation_w, 1, 0, 0, H_gtk_icon_view_get_item_orientation, pl_iu);
+ Xg_define_procedure(gtk_text_view_im_context_filter_keypress, gxg_gtk_text_view_im_context_filter_keypress_w, 2, 0, 0, H_gtk_text_view_im_context_filter_keypress, pl_bu);
+ Xg_define_procedure(gtk_text_view_reset_im_context, gxg_gtk_text_view_reset_im_context_w, 1, 0, 0, H_gtk_text_view_reset_im_context, pl_tu);
+ Xg_define_procedure(gdk_device_get_position, gxg_gdk_device_get_position_w, 2, 2, 0, H_gdk_device_get_position, pl_tu);
+ Xg_define_procedure(gdk_device_get_window_at_position, gxg_gdk_device_get_window_at_position_w, 1, 2, 0, H_gdk_device_get_window_at_position, pl_pu);
+ Xg_define_procedure(gtk_cell_view_get_draw_sensitive, gxg_gtk_cell_view_get_draw_sensitive_w, 1, 0, 0, H_gtk_cell_view_get_draw_sensitive, pl_bu);
+ Xg_define_procedure(gtk_cell_view_set_draw_sensitive, gxg_gtk_cell_view_set_draw_sensitive_w, 2, 0, 0, H_gtk_cell_view_set_draw_sensitive, pl_tub);
+ Xg_define_procedure(gtk_cell_view_get_fit_model, gxg_gtk_cell_view_get_fit_model_w, 1, 0, 0, H_gtk_cell_view_get_fit_model, pl_bu);
+ Xg_define_procedure(gtk_cell_view_set_fit_model, gxg_gtk_cell_view_set_fit_model_w, 2, 0, 0, H_gtk_cell_view_set_fit_model, pl_tub);
+ Xg_define_procedure(gtk_combo_box_new_with_area, gxg_gtk_combo_box_new_with_area_w, 1, 0, 0, H_gtk_combo_box_new_with_area, pl_pu);
+ Xg_define_procedure(gtk_combo_box_new_with_area_and_entry, gxg_gtk_combo_box_new_with_area_and_entry_w, 1, 0, 0, H_gtk_combo_box_new_with_area_and_entry, pl_pu);
+ Xg_define_procedure(gtk_icon_view_new_with_area, gxg_gtk_icon_view_new_with_area_w, 1, 0, 0, H_gtk_icon_view_new_with_area, pl_pu);
+ Xg_define_procedure(gtk_menu_item_set_reserve_indicator, gxg_gtk_menu_item_set_reserve_indicator_w, 2, 0, 0, H_gtk_menu_item_set_reserve_indicator, pl_tub);
+ Xg_define_procedure(gtk_menu_item_get_reserve_indicator, gxg_gtk_menu_item_get_reserve_indicator_w, 1, 0, 0, H_gtk_menu_item_get_reserve_indicator, pl_bu);
+ Xg_define_procedure(gtk_menu_shell_get_selected_item, gxg_gtk_menu_shell_get_selected_item_w, 1, 0, 0, H_gtk_menu_shell_get_selected_item, pl_pu);
+ Xg_define_procedure(gtk_menu_shell_get_parent_shell, gxg_gtk_menu_shell_get_parent_shell_w, 1, 0, 0, H_gtk_menu_shell_get_parent_shell, pl_pu);
+ Xg_define_procedure(gtk_selection_data_get_data_with_length, gxg_gtk_selection_data_get_data_with_length_w, 1, 1, 0, H_gtk_selection_data_get_data_with_length, pl_su);
+ Xg_define_procedure(gtk_tree_model_iter_previous, gxg_gtk_tree_model_iter_previous_w, 2, 0, 0, H_gtk_tree_model_iter_previous, pl_bu);
+ Xg_define_procedure(gtk_tree_view_is_blank_at_pos, gxg_gtk_tree_view_is_blank_at_pos_w, 3, 4, 0, H_gtk_tree_view_is_blank_at_pos, pl_buiiu);
+ Xg_define_procedure(gtk_widget_set_device_enabled, gxg_gtk_widget_set_device_enabled_w, 3, 0, 0, H_gtk_widget_set_device_enabled, pl_tuub);
+ Xg_define_procedure(gtk_widget_get_device_enabled, gxg_gtk_widget_get_device_enabled_w, 2, 0, 0, H_gtk_widget_get_device_enabled, pl_bu);
+ Xg_define_procedure(gtk_window_set_has_user_ref_count, gxg_gtk_window_set_has_user_ref_count_w, 2, 0, 0, H_gtk_window_set_has_user_ref_count, pl_tub);
+ Xg_define_procedure(gdk_selection_send_notify, gxg_gdk_selection_send_notify_w, 5, 0, 0, H_gdk_selection_send_notify, pl_tuttti);
+ Xg_define_procedure(gdk_selection_send_notify_for_display, gxg_gdk_selection_send_notify_for_display_w, 6, 0, 0, H_gdk_selection_send_notify_for_display, pl_tuuttti);
+ Xg_define_procedure(gdk_rgba_copy, gxg_gdk_rgba_copy_w, 1, 0, 0, H_gdk_rgba_copy, pl_pu);
+ Xg_define_procedure(gdk_rgba_free, gxg_gdk_rgba_free_w, 1, 0, 0, H_gdk_rgba_free, pl_tu);
+ Xg_define_procedure(gdk_rgba_parse, gxg_gdk_rgba_parse_w, 2, 0, 0, H_gdk_rgba_parse, pl_bus);
+ Xg_define_procedure(gdk_rgba_to_string, gxg_gdk_rgba_to_string_w, 1, 0, 0, H_gdk_rgba_to_string, pl_su);
+ Xg_define_procedure(gtk_widget_set_state_flags, gxg_gtk_widget_set_state_flags_w, 3, 0, 0, H_gtk_widget_set_state_flags, pl_tuib);
+ Xg_define_procedure(gtk_widget_unset_state_flags, gxg_gtk_widget_unset_state_flags_w, 2, 0, 0, H_gtk_widget_unset_state_flags, pl_tui);
+ Xg_define_procedure(gtk_widget_get_state_flags, gxg_gtk_widget_get_state_flags_w, 1, 0, 0, H_gtk_widget_get_state_flags, pl_iu);
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
-#define gxg_GTK_IS_SPINNER_w gxg_GTK_IS_SPINNER
-#define gxg_GTK_IS_CELL_RENDERER_SPINNER_w gxg_GTK_IS_CELL_RENDERER_SPINNER
-#define gxg_GTK_IS_TOOL_PALETTE_w gxg_GTK_IS_TOOL_PALETTE
-#define gxg_GTK_IS_TOOL_ITEM_GROUP_w gxg_GTK_IS_TOOL_ITEM_GROUP
+#if GTK_CHECK_VERSION(3, 2, 0)
+ Xg_define_procedure(gtk_entry_get_placeholder_text, gxg_gtk_entry_get_placeholder_text_w, 1, 0, 0, H_gtk_entry_get_placeholder_text, pl_su);
+ Xg_define_procedure(gtk_entry_set_placeholder_text, gxg_gtk_entry_set_placeholder_text_w, 2, 0, 0, H_gtk_entry_set_placeholder_text, pl_tus);
+ Xg_define_procedure(gtk_expander_set_resize_toplevel, gxg_gtk_expander_set_resize_toplevel_w, 2, 0, 0, H_gtk_expander_set_resize_toplevel, pl_tub);
+ Xg_define_procedure(gtk_expander_get_resize_toplevel, gxg_gtk_expander_get_resize_toplevel_w, 1, 0, 0, H_gtk_expander_get_resize_toplevel, pl_bu);
+ Xg_define_procedure(gtk_widget_path_to_string, gxg_gtk_widget_path_to_string_w, 1, 0, 0, H_gtk_widget_path_to_string, pl_su);
+ Xg_define_procedure(gtk_button_box_get_child_non_homogeneous, gxg_gtk_button_box_get_child_non_homogeneous_w, 2, 0, 0, H_gtk_button_box_get_child_non_homogeneous, pl_bu);
+ Xg_define_procedure(gtk_button_box_set_child_non_homogeneous, gxg_gtk_button_box_set_child_non_homogeneous_w, 3, 0, 0, H_gtk_button_box_set_child_non_homogeneous, pl_tuub);
+ Xg_define_procedure(gtk_container_child_notify, gxg_gtk_container_child_notify_w, 3, 0, 0, H_gtk_container_child_notify, pl_tuus);
+ Xg_define_procedure(gtk_drag_source_set_icon_gicon, gxg_gtk_drag_source_set_icon_gicon_w, 2, 0, 0, H_gtk_drag_source_set_icon_gicon, pl_tu);
+ Xg_define_procedure(gtk_drag_set_icon_gicon, gxg_gtk_drag_set_icon_gicon_w, 4, 0, 0, H_gtk_drag_set_icon_gicon, pl_tuui);
+ Xg_define_procedure(gtk_combo_box_set_active_id, gxg_gtk_combo_box_set_active_id_w, 2, 0, 0, H_gtk_combo_box_set_active_id, pl_bus);
+ Xg_define_procedure(gtk_tree_view_column_get_x_offset, gxg_gtk_tree_view_column_get_x_offset_w, 1, 0, 0, H_gtk_tree_view_column_get_x_offset, pl_iu);
+ Xg_define_procedure(gtk_overlay_new, gxg_gtk_overlay_new_w, 0, 0, 0, H_gtk_overlay_new, pl_p);
+ Xg_define_procedure(gtk_overlay_add_overlay, gxg_gtk_overlay_add_overlay_w, 2, 0, 0, H_gtk_overlay_add_overlay, pl_tu);
+ Xg_define_procedure(gtk_adjustment_get_minimum_increment, gxg_gtk_adjustment_get_minimum_increment_w, 1, 0, 0, H_gtk_adjustment_get_minimum_increment, pl_du);
+ Xg_define_procedure(gtk_grid_insert_row, gxg_gtk_grid_insert_row_w, 2, 0, 0, H_gtk_grid_insert_row, pl_tui);
+ Xg_define_procedure(gtk_grid_insert_column, gxg_gtk_grid_insert_column_w, 2, 0, 0, H_gtk_grid_insert_column, pl_tui);
+ Xg_define_procedure(gtk_grid_insert_next_to, gxg_gtk_grid_insert_next_to_w, 3, 0, 0, H_gtk_grid_insert_next_to, pl_tuui);
+ Xg_define_procedure(gtk_text_iter_assign, gxg_gtk_text_iter_assign_w, 2, 0, 0, H_gtk_text_iter_assign, pl_tu);
+ Xg_define_procedure(gtk_widget_has_visible_focus, gxg_gtk_widget_has_visible_focus_w, 1, 0, 0, H_gtk_widget_has_visible_focus, pl_bu);
+ Xg_define_procedure(gtk_window_set_focus_visible, gxg_gtk_window_set_focus_visible_w, 2, 0, 0, H_gtk_window_set_focus_visible, pl_tub);
+ Xg_define_procedure(gtk_window_get_focus_visible, gxg_gtk_window_get_focus_visible_w, 1, 0, 0, H_gtk_window_get_focus_visible, pl_bu);
+ Xg_define_procedure(gtk_font_chooser_dialog_new, gxg_gtk_font_chooser_dialog_new_w, 2, 0, 0, H_gtk_font_chooser_dialog_new, pl_psu);
+ Xg_define_procedure(gdk_event_get_button, gxg_gdk_event_get_button_w, 2, 0, 0, H_gdk_event_get_button, pl_bu);
+ Xg_define_procedure(gdk_event_get_click_count, gxg_gdk_event_get_click_count_w, 2, 0, 0, H_gdk_event_get_click_count, pl_bu);
+ Xg_define_procedure(gdk_event_get_keyval, gxg_gdk_event_get_keyval_w, 2, 0, 0, H_gdk_event_get_keyval, pl_bu);
+ Xg_define_procedure(gdk_event_get_keycode, gxg_gdk_event_get_keycode_w, 2, 0, 0, H_gdk_event_get_keycode, pl_bu);
+ Xg_define_procedure(gdk_event_get_scroll_direction, gxg_gdk_event_get_scroll_direction_w, 1, 1, 0, H_gdk_event_get_scroll_direction, pl_bu);
+ Xg_define_procedure(gtk_grid_get_child_at, gxg_gtk_grid_get_child_at_w, 3, 0, 0, H_gtk_grid_get_child_at, pl_pui);
+ Xg_define_procedure(gtk_font_chooser_get_font_family, gxg_gtk_font_chooser_get_font_family_w, 1, 0, 0, H_gtk_font_chooser_get_font_family, pl_pu);
+ Xg_define_procedure(gtk_font_chooser_get_font_face, gxg_gtk_font_chooser_get_font_face_w, 1, 0, 0, H_gtk_font_chooser_get_font_face, pl_pu);
+ Xg_define_procedure(gtk_font_chooser_get_font_size, gxg_gtk_font_chooser_get_font_size_w, 1, 0, 0, H_gtk_font_chooser_get_font_size, pl_iu);
+ Xg_define_procedure(gtk_font_chooser_get_font_desc, gxg_gtk_font_chooser_get_font_desc_w, 1, 0, 0, H_gtk_font_chooser_get_font_desc, pl_pu);
+ Xg_define_procedure(gtk_font_chooser_set_font_desc, gxg_gtk_font_chooser_set_font_desc_w, 2, 0, 0, H_gtk_font_chooser_set_font_desc, pl_tu);
+ Xg_define_procedure(gtk_font_chooser_get_font, gxg_gtk_font_chooser_get_font_w, 1, 0, 0, H_gtk_font_chooser_get_font, pl_su);
+ Xg_define_procedure(gtk_font_chooser_set_font, gxg_gtk_font_chooser_set_font_w, 2, 0, 0, H_gtk_font_chooser_set_font, pl_tus);
+ Xg_define_procedure(gtk_font_chooser_get_preview_text, gxg_gtk_font_chooser_get_preview_text_w, 1, 0, 0, H_gtk_font_chooser_get_preview_text, pl_su);
+ Xg_define_procedure(gtk_font_chooser_set_preview_text, gxg_gtk_font_chooser_set_preview_text_w, 2, 0, 0, H_gtk_font_chooser_set_preview_text, pl_tus);
+ Xg_define_procedure(gtk_font_chooser_get_show_preview_entry, gxg_gtk_font_chooser_get_show_preview_entry_w, 1, 0, 0, H_gtk_font_chooser_get_show_preview_entry, pl_bu);
+ Xg_define_procedure(gtk_font_chooser_set_show_preview_entry, gxg_gtk_font_chooser_set_show_preview_entry_w, 2, 0, 0, H_gtk_font_chooser_set_show_preview_entry, pl_tub);
+ Xg_define_procedure(gtk_font_chooser_widget_new, gxg_gtk_font_chooser_widget_new_w, 0, 0, 0, H_gtk_font_chooser_widget_new, pl_p);
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-#define gxg_GTK_IS_COMBO_BOX_TEXT_w gxg_GTK_IS_COMBO_BOX_TEXT
-#define gxg_GTK_IS_GRID_w gxg_GTK_IS_GRID
-#define gxg_GTK_IS_SCROLLABLE_w gxg_GTK_IS_SCROLLABLE
-#define gxg_GTK_IS_SWITCH_w gxg_GTK_IS_SWITCH
-#define gxg_GTK_IS_ACTIVATABLE_w gxg_GTK_IS_ACTIVATABLE
-#define gxg_GTK_IS_ORIENTABLE_w gxg_GTK_IS_ORIENTABLE
-#define gxg_GTK_IS_WINDOW_GROUP_w gxg_GTK_IS_WINDOW_GROUP
-#define gxg_GTK_IS_TOOL_SHELL_w gxg_GTK_IS_TOOL_SHELL
+#if GTK_CHECK_VERSION(3, 4, 0)
+ Xg_define_procedure(gdk_keymap_get_modifier_mask, gxg_gdk_keymap_get_modifier_mask_w, 2, 0, 0, H_gdk_keymap_get_modifier_mask, pl_iui);
+ Xg_define_procedure(gdk_window_begin_resize_drag_for_device, gxg_gdk_window_begin_resize_drag_for_device_w, 7, 0, 0, H_gdk_window_begin_resize_drag_for_device, pl_tuiui);
+ Xg_define_procedure(gdk_window_begin_move_drag_for_device, gxg_gdk_window_begin_move_drag_for_device_w, 6, 0, 0, H_gdk_window_begin_move_drag_for_device, pl_tuui);
+ Xg_define_procedure(gtk_accelerator_parse_with_keycode, gxg_gtk_accelerator_parse_with_keycode_w, 4, 0, 0, H_gtk_accelerator_parse_with_keycode, pl_tsu);
+ Xg_define_procedure(gtk_accelerator_name_with_keycode, gxg_gtk_accelerator_name_with_keycode_w, 4, 0, 0, H_gtk_accelerator_name_with_keycode, pl_sui);
+ Xg_define_procedure(gtk_accelerator_get_label_with_keycode, gxg_gtk_accelerator_get_label_with_keycode_w, 4, 0, 0, H_gtk_accelerator_get_label_with_keycode, pl_sui);
+ Xg_define_procedure(gdk_screen_get_monitor_workarea, gxg_gdk_screen_get_monitor_workarea_w, 3, 0, 0, H_gdk_screen_get_monitor_workarea, pl_tuiu);
+ Xg_define_procedure(gtk_application_get_app_menu, gxg_gtk_application_get_app_menu_w, 1, 0, 0, H_gtk_application_get_app_menu, pl_pu);
+ Xg_define_procedure(gtk_application_set_app_menu, gxg_gtk_application_set_app_menu_w, 2, 0, 0, H_gtk_application_set_app_menu, pl_tu);
+ Xg_define_procedure(gtk_application_get_menubar, gxg_gtk_application_get_menubar_w, 1, 0, 0, H_gtk_application_get_menubar, pl_pu);
+ Xg_define_procedure(gtk_application_set_menubar, gxg_gtk_application_set_menubar_w, 2, 0, 0, H_gtk_application_set_menubar, pl_tu);
+ Xg_define_procedure(gtk_entry_completion_compute_prefix, gxg_gtk_entry_completion_compute_prefix_w, 2, 0, 0, H_gtk_entry_completion_compute_prefix, pl_sus);
+ Xg_define_procedure(gtk_scale_set_has_origin, gxg_gtk_scale_set_has_origin_w, 2, 0, 0, H_gtk_scale_set_has_origin, pl_tub);
+ Xg_define_procedure(gtk_scale_get_has_origin, gxg_gtk_scale_get_has_origin_w, 1, 0, 0, H_gtk_scale_get_has_origin, pl_bu);
+ Xg_define_procedure(gtk_window_set_hide_titlebar_when_maximized, gxg_gtk_window_set_hide_titlebar_when_maximized_w, 2, 0, 0, H_gtk_window_set_hide_titlebar_when_maximized, pl_tub);
+ Xg_define_procedure(gtk_window_get_hide_titlebar_when_maximized, gxg_gtk_window_get_hide_titlebar_when_maximized_w, 1, 0, 0, H_gtk_window_get_hide_titlebar_when_maximized, pl_bu);
+ Xg_define_procedure(gtk_application_window_new, gxg_gtk_application_window_new_w, 1, 0, 0, H_gtk_application_window_new, pl_pu);
+ Xg_define_procedure(gtk_application_window_set_show_menubar, gxg_gtk_application_window_set_show_menubar_w, 2, 0, 0, H_gtk_application_window_set_show_menubar, pl_tub);
+ Xg_define_procedure(gtk_application_window_get_show_menubar, gxg_gtk_application_window_get_show_menubar_w, 1, 0, 0, H_gtk_application_window_get_show_menubar, pl_bu);
+ Xg_define_procedure(gtk_image_new_from_resource, gxg_gtk_image_new_from_resource_w, 1, 0, 0, H_gtk_image_new_from_resource, pl_ps);
+ Xg_define_procedure(gtk_image_set_from_resource, gxg_gtk_image_set_from_resource_w, 2, 0, 0, H_gtk_image_set_from_resource, pl_tus);
+ Xg_define_procedure(gtk_window_set_attached_to, gxg_gtk_window_set_attached_to_w, 2, 0, 0, H_gtk_window_set_attached_to, pl_tu);
+ Xg_define_procedure(gtk_window_get_attached_to, gxg_gtk_window_get_attached_to_w, 1, 0, 0, H_gtk_window_get_attached_to, pl_pu);
+ Xg_define_procedure(gtk_about_dialog_add_credit_section, gxg_gtk_about_dialog_add_credit_section_w, 3, 0, 0, H_gtk_about_dialog_add_credit_section, pl_tusu);
+ Xg_define_procedure(gdk_keymap_get_modifier_state, gxg_gdk_keymap_get_modifier_state_w, 1, 0, 0, H_gdk_keymap_get_modifier_state, pl_iu);
+ Xg_define_procedure(gtk_hsv_to_rgb, gxg_gtk_hsv_to_rgb_w, 3, 3, 0, H_gtk_hsv_to_rgb, pl_trrru);
+ Xg_define_procedure(gtk_rgb_to_hsv, gxg_gtk_rgb_to_hsv_w, 3, 3, 0, H_gtk_rgb_to_hsv, pl_trrru);
+ Xg_define_procedure(gtk_color_chooser_get_rgba, gxg_gtk_color_chooser_get_rgba_w, 2, 0, 0, H_gtk_color_chooser_get_rgba, pl_tu);
+ Xg_define_procedure(gtk_color_chooser_set_rgba, gxg_gtk_color_chooser_set_rgba_w, 2, 0, 0, H_gtk_color_chooser_set_rgba, pl_tu);
+ Xg_define_procedure(gtk_color_chooser_get_use_alpha, gxg_gtk_color_chooser_get_use_alpha_w, 1, 0, 0, H_gtk_color_chooser_get_use_alpha, pl_bu);
+ Xg_define_procedure(gtk_color_chooser_set_use_alpha, gxg_gtk_color_chooser_set_use_alpha_w, 2, 0, 0, H_gtk_color_chooser_set_use_alpha, pl_tub);
+ Xg_define_procedure(gtk_color_chooser_dialog_new, gxg_gtk_color_chooser_dialog_new_w, 2, 0, 0, H_gtk_color_chooser_dialog_new, pl_psu);
+ Xg_define_procedure(gtk_color_chooser_widget_new, gxg_gtk_color_chooser_widget_new_w, 0, 0, 0, H_gtk_color_chooser_widget_new, pl_p);
#endif
-#if (!HAVE_GTK_3)
-#define gxg_GDK_IS_COLORMAP_w gxg_GDK_IS_COLORMAP
-#define gxg_GDK_IS_DRAWABLE_w gxg_GDK_IS_DRAWABLE
-#define gxg_GDK_IS_PIXMAP_w gxg_GDK_IS_PIXMAP
-#define gxg_GTK_IS_OBJECT_w gxg_GTK_IS_OBJECT
-#define gxg_GTK_IS_RC_STYLE_w gxg_GTK_IS_RC_STYLE
-#define gxg_GTK_IS_STYLE_w gxg_GTK_IS_STYLE
+#if GTK_CHECK_VERSION(3, 6, 0)
+ Xg_define_procedure(gdk_event_get_scroll_deltas, gxg_gdk_event_get_scroll_deltas_w, 1, 2, 0, H_gdk_event_get_scroll_deltas, pl_bu);
+ Xg_define_procedure(gtk_color_chooser_add_palette, gxg_gtk_color_chooser_add_palette_w, 5, 0, 0, H_gtk_color_chooser_add_palette, pl_tuiiiu);
+ Xg_define_procedure(gtk_button_set_always_show_image, gxg_gtk_button_set_always_show_image_w, 2, 0, 0, H_gtk_button_set_always_show_image, pl_tub);
+ Xg_define_procedure(gtk_button_get_always_show_image, gxg_gtk_button_get_always_show_image_w, 1, 0, 0, H_gtk_button_get_always_show_image, pl_bu);
+ Xg_define_procedure(gtk_tree_view_get_n_columns, gxg_gtk_tree_view_get_n_columns_w, 1, 0, 0, H_gtk_tree_view_get_n_columns, pl_iu);
+ Xg_define_procedure(gtk_menu_button_new, gxg_gtk_menu_button_new_w, 0, 0, 0, H_gtk_menu_button_new, pl_p);
+ Xg_define_procedure(gtk_menu_button_set_menu_model, gxg_gtk_menu_button_set_menu_model_w, 2, 0, 0, H_gtk_menu_button_set_menu_model, pl_tu);
+ Xg_define_procedure(gtk_menu_button_get_menu_model, gxg_gtk_menu_button_get_menu_model_w, 1, 0, 0, H_gtk_menu_button_get_menu_model, pl_pu);
+ Xg_define_procedure(gtk_menu_button_set_align_widget, gxg_gtk_menu_button_set_align_widget_w, 2, 0, 0, H_gtk_menu_button_set_align_widget, pl_tu);
+ Xg_define_procedure(gtk_menu_button_get_align_widget, gxg_gtk_menu_button_get_align_widget_w, 1, 0, 0, H_gtk_menu_button_get_align_widget, pl_pu);
+ Xg_define_procedure(gtk_search_entry_new, gxg_gtk_search_entry_new_w, 0, 0, 0, H_gtk_search_entry_new, pl_p);
+ Xg_define_procedure(gtk_level_bar_new, gxg_gtk_level_bar_new_w, 0, 0, 0, H_gtk_level_bar_new, pl_p);
+ Xg_define_procedure(gtk_level_bar_new_for_interval, gxg_gtk_level_bar_new_for_interval_w, 2, 0, 0, H_gtk_level_bar_new_for_interval, pl_pr);
+ Xg_define_procedure(gtk_level_bar_set_mode, gxg_gtk_level_bar_set_mode_w, 2, 0, 0, H_gtk_level_bar_set_mode, pl_tui);
+ Xg_define_procedure(gtk_level_bar_get_mode, gxg_gtk_level_bar_get_mode_w, 1, 0, 0, H_gtk_level_bar_get_mode, pl_iu);
+ Xg_define_procedure(gtk_level_bar_set_value, gxg_gtk_level_bar_set_value_w, 2, 0, 0, H_gtk_level_bar_set_value, pl_tur);
+ Xg_define_procedure(gtk_level_bar_get_value, gxg_gtk_level_bar_get_value_w, 1, 0, 0, H_gtk_level_bar_get_value, pl_du);
+ Xg_define_procedure(gtk_level_bar_set_min_value, gxg_gtk_level_bar_set_min_value_w, 2, 0, 0, H_gtk_level_bar_set_min_value, pl_tur);
+ Xg_define_procedure(gtk_level_bar_get_min_value, gxg_gtk_level_bar_get_min_value_w, 1, 0, 0, H_gtk_level_bar_get_min_value, pl_du);
+ Xg_define_procedure(gtk_level_bar_set_max_value, gxg_gtk_level_bar_set_max_value_w, 2, 0, 0, H_gtk_level_bar_set_max_value, pl_tur);
+ Xg_define_procedure(gtk_level_bar_get_max_value, gxg_gtk_level_bar_get_max_value_w, 1, 0, 0, H_gtk_level_bar_get_max_value, pl_du);
+ Xg_define_procedure(gtk_level_bar_add_offset_value, gxg_gtk_level_bar_add_offset_value_w, 3, 0, 0, H_gtk_level_bar_add_offset_value, pl_tusr);
+ Xg_define_procedure(gtk_level_bar_remove_offset_value, gxg_gtk_level_bar_remove_offset_value_w, 2, 0, 0, H_gtk_level_bar_remove_offset_value, pl_tus);
+ Xg_define_procedure(gtk_level_bar_get_offset_value, gxg_gtk_level_bar_get_offset_value_w, 2, 1, 0, H_gtk_level_bar_get_offset_value, pl_busu);
+ Xg_define_procedure(gtk_application_get_active_window, gxg_gtk_application_get_active_window_w, 1, 0, 0, H_gtk_application_get_active_window, pl_pu);
+ Xg_define_procedure(gtk_entry_set_input_purpose, gxg_gtk_entry_set_input_purpose_w, 2, 0, 0, H_gtk_entry_set_input_purpose, pl_tui);
+ Xg_define_procedure(gtk_entry_get_input_purpose, gxg_gtk_entry_get_input_purpose_w, 1, 0, 0, H_gtk_entry_get_input_purpose, pl_iu);
+ Xg_define_procedure(gtk_entry_set_input_hints, gxg_gtk_entry_set_input_hints_w, 2, 0, 0, H_gtk_entry_set_input_hints, pl_tui);
+ Xg_define_procedure(gtk_entry_get_input_hints, gxg_gtk_entry_get_input_hints_w, 1, 0, 0, H_gtk_entry_get_input_hints, pl_iu);
+ Xg_define_procedure(gtk_menu_button_get_popup, gxg_gtk_menu_button_get_popup_w, 1, 0, 0, H_gtk_menu_button_get_popup, pl_pu);
+ Xg_define_procedure(gtk_text_view_set_input_purpose, gxg_gtk_text_view_set_input_purpose_w, 2, 0, 0, H_gtk_text_view_set_input_purpose, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_input_purpose, gxg_gtk_text_view_get_input_purpose_w, 1, 0, 0, H_gtk_text_view_get_input_purpose, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_input_hints, gxg_gtk_text_view_set_input_hints_w, 2, 0, 0, H_gtk_text_view_set_input_hints, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_input_hints, gxg_gtk_text_view_get_input_hints_w, 1, 0, 0, H_gtk_text_view_get_input_hints, pl_iu);
+ Xg_define_procedure(gtk_entry_set_attributes, gxg_gtk_entry_set_attributes_w, 2, 0, 0, H_gtk_entry_set_attributes, pl_tu);
+ Xg_define_procedure(gtk_entry_get_attributes, gxg_gtk_entry_get_attributes_w, 1, 0, 0, H_gtk_entry_get_attributes, pl_pu);
+ Xg_define_procedure(gtk_accel_label_set_accel, gxg_gtk_accel_label_set_accel_w, 3, 0, 0, H_gtk_accel_label_set_accel, pl_tui);
+ Xg_define_procedure(gtk_menu_shell_bind_model, gxg_gtk_menu_shell_bind_model_w, 4, 0, 0, H_gtk_menu_shell_bind_model, pl_tuusb);
#endif
-#define gxg_blue_w gxg_blue
-#define gxg_green_w gxg_green
-#define gxg_red_w gxg_red
-#define gxg_pixel_w gxg_pixel
-#define gxg_set_blue_w gxg_set_blue
-#define gxg_set_green_w gxg_set_green
-#define gxg_set_red_w gxg_set_red
-#define gxg_set_pixel_w gxg_set_pixel
-#define gxg_make_GdkColor_w gxg_make_GdkColor
-#define gxg_make_GtkTextIter_w gxg_make_GtkTextIter
-#define gxg_make_GtkTreeIter_w gxg_make_GtkTreeIter
-#define gxg_make_PangoRectangle_w gxg_make_PangoRectangle
+#if GTK_CHECK_VERSION(3, 8, 0)
+ Xg_define_procedure(gtk_level_bar_set_inverted, gxg_gtk_level_bar_set_inverted_w, 2, 0, 0, H_gtk_level_bar_set_inverted, pl_tub);
+ Xg_define_procedure(gtk_level_bar_get_inverted, gxg_gtk_level_bar_get_inverted_w, 1, 0, 0, H_gtk_level_bar_get_inverted, pl_bu);
+ Xg_define_procedure(gtk_widget_is_visible, gxg_gtk_widget_is_visible_w, 1, 0, 0, H_gtk_widget_is_visible, pl_bu);
+ Xg_define_procedure(gdk_window_set_fullscreen_mode, gxg_gdk_window_set_fullscreen_mode_w, 2, 0, 0, H_gdk_window_set_fullscreen_mode, pl_tui);
+ Xg_define_procedure(gdk_window_get_fullscreen_mode, gxg_gdk_window_get_fullscreen_mode_w, 1, 0, 0, H_gdk_window_get_fullscreen_mode, pl_iu);
+ Xg_define_procedure(gtk_icon_view_set_activate_on_single_click, gxg_gtk_icon_view_set_activate_on_single_click_w, 2, 0, 0, H_gtk_icon_view_set_activate_on_single_click, pl_tub);
+ Xg_define_procedure(gtk_icon_view_get_activate_on_single_click, gxg_gtk_icon_view_get_activate_on_single_click_w, 1, 0, 0, H_gtk_icon_view_get_activate_on_single_click, pl_bu);
+ Xg_define_procedure(gtk_tree_view_get_activate_on_single_click, gxg_gtk_tree_view_get_activate_on_single_click_w, 1, 0, 0, H_gtk_tree_view_get_activate_on_single_click, pl_bu);
+ Xg_define_procedure(gtk_tree_view_set_activate_on_single_click, gxg_gtk_tree_view_set_activate_on_single_click_w, 2, 0, 0, H_gtk_tree_view_set_activate_on_single_click, pl_tub);
+ Xg_define_procedure(gtk_widget_register_window, gxg_gtk_widget_register_window_w, 2, 0, 0, H_gtk_widget_register_window, pl_tu);
+ Xg_define_procedure(gtk_widget_unregister_window, gxg_gtk_widget_unregister_window_w, 2, 0, 0, H_gtk_widget_unregister_window, pl_tu);
+ Xg_define_procedure(gtk_widget_set_opacity, gxg_gtk_widget_set_opacity_w, 2, 0, 0, H_gtk_widget_set_opacity, pl_tur);
+ Xg_define_procedure(gtk_widget_get_opacity, gxg_gtk_widget_get_opacity_w, 1, 0, 0, H_gtk_widget_get_opacity, pl_du);
+ Xg_define_procedure(pango_font_map_changed, gxg_pango_font_map_changed_w, 1, 0, 0, H_pango_font_map_changed, pl_tu);
+#endif
-#define gxg_make_cairo_matrix_t_w gxg_make_cairo_matrix_t
+#if GTK_CHECK_VERSION(3, 10, 0)
+ Xg_define_procedure(gdk_set_allowed_backends, gxg_gdk_set_allowed_backends_w, 1, 0, 0, H_gdk_set_allowed_backends, pl_ts);
+ Xg_define_procedure(gtk_box_set_baseline_position, gxg_gtk_box_set_baseline_position_w, 2, 0, 0, H_gtk_box_set_baseline_position, pl_tui);
+ Xg_define_procedure(gtk_box_get_baseline_position, gxg_gtk_box_get_baseline_position_w, 1, 0, 0, H_gtk_box_get_baseline_position, pl_iu);
+ Xg_define_procedure(gtk_grid_remove_row, gxg_gtk_grid_remove_row_w, 2, 0, 0, H_gtk_grid_remove_row, pl_tui);
+ Xg_define_procedure(gtk_grid_remove_column, gxg_gtk_grid_remove_column_w, 2, 0, 0, H_gtk_grid_remove_column, pl_tui);
+ Xg_define_procedure(gtk_grid_set_row_baseline_position, gxg_gtk_grid_set_row_baseline_position_w, 3, 0, 0, H_gtk_grid_set_row_baseline_position, pl_tui);
+ Xg_define_procedure(gtk_grid_get_row_baseline_position, gxg_gtk_grid_get_row_baseline_position_w, 2, 0, 0, H_gtk_grid_get_row_baseline_position, pl_iui);
+ Xg_define_procedure(gtk_grid_set_baseline_row, gxg_gtk_grid_set_baseline_row_w, 2, 0, 0, H_gtk_grid_set_baseline_row, pl_tui);
+ Xg_define_procedure(gtk_grid_get_baseline_row, gxg_gtk_grid_get_baseline_row_w, 1, 0, 0, H_gtk_grid_get_baseline_row, pl_iu);
+ Xg_define_procedure(gtk_widget_size_allocate_with_baseline, gxg_gtk_widget_size_allocate_with_baseline_w, 3, 0, 0, H_gtk_widget_size_allocate_with_baseline, pl_tuui);
+ Xg_define_procedure(gtk_widget_get_preferred_height_and_baseline_for_width, gxg_gtk_widget_get_preferred_height_and_baseline_for_width_w, 2, 4, 0, H_gtk_widget_get_preferred_height_and_baseline_for_width, pl_tuiu);
+ Xg_define_procedure(gtk_widget_get_allocated_baseline, gxg_gtk_widget_get_allocated_baseline_w, 1, 0, 0, H_gtk_widget_get_allocated_baseline, pl_iu);
+ Xg_define_procedure(gtk_widget_get_valign_with_baseline, gxg_gtk_widget_get_valign_with_baseline_w, 1, 0, 0, H_gtk_widget_get_valign_with_baseline, pl_iu);
+ Xg_define_procedure(gtk_widget_init_template, gxg_gtk_widget_init_template_w, 1, 0, 0, H_gtk_widget_init_template, pl_tu);
+ Xg_define_procedure(gtk_window_set_titlebar, gxg_gtk_window_set_titlebar_w, 2, 0, 0, H_gtk_window_set_titlebar, pl_tu);
+ Xg_define_procedure(gtk_places_sidebar_new, gxg_gtk_places_sidebar_new_w, 0, 0, 0, H_gtk_places_sidebar_new, pl_p);
+ Xg_define_procedure(gtk_places_sidebar_get_open_flags, gxg_gtk_places_sidebar_get_open_flags_w, 1, 0, 0, H_gtk_places_sidebar_get_open_flags, pl_iu);
+ Xg_define_procedure(gtk_places_sidebar_set_open_flags, gxg_gtk_places_sidebar_set_open_flags_w, 2, 0, 0, H_gtk_places_sidebar_set_open_flags, pl_tui);
+ Xg_define_procedure(gtk_places_sidebar_get_location, gxg_gtk_places_sidebar_get_location_w, 1, 0, 0, H_gtk_places_sidebar_get_location, pl_pu);
+ Xg_define_procedure(gtk_places_sidebar_set_location, gxg_gtk_places_sidebar_set_location_w, 2, 0, 0, H_gtk_places_sidebar_set_location, pl_tu);
+ Xg_define_procedure(gtk_places_sidebar_get_show_desktop, gxg_gtk_places_sidebar_get_show_desktop_w, 1, 0, 0, H_gtk_places_sidebar_get_show_desktop, pl_bu);
+ Xg_define_procedure(gtk_places_sidebar_set_show_desktop, gxg_gtk_places_sidebar_set_show_desktop_w, 2, 0, 0, H_gtk_places_sidebar_set_show_desktop, pl_tub);
+ Xg_define_procedure(gtk_places_sidebar_add_shortcut, gxg_gtk_places_sidebar_add_shortcut_w, 2, 0, 0, H_gtk_places_sidebar_add_shortcut, pl_tu);
+ Xg_define_procedure(gtk_places_sidebar_remove_shortcut, gxg_gtk_places_sidebar_remove_shortcut_w, 2, 0, 0, H_gtk_places_sidebar_remove_shortcut, pl_tu);
+ Xg_define_procedure(gtk_places_sidebar_list_shortcuts, gxg_gtk_places_sidebar_list_shortcuts_w, 1, 0, 0, H_gtk_places_sidebar_list_shortcuts, pl_pu);
+ Xg_define_procedure(gtk_places_sidebar_get_nth_bookmark, gxg_gtk_places_sidebar_get_nth_bookmark_w, 2, 0, 0, H_gtk_places_sidebar_get_nth_bookmark, pl_pui);
+ Xg_define_procedure(gtk_stack_switcher_new, gxg_gtk_stack_switcher_new_w, 0, 0, 0, H_gtk_stack_switcher_new, pl_p);
+ Xg_define_procedure(gtk_stack_switcher_set_stack, gxg_gtk_stack_switcher_set_stack_w, 2, 0, 0, H_gtk_stack_switcher_set_stack, pl_tu);
+ Xg_define_procedure(gtk_stack_switcher_get_stack, gxg_gtk_stack_switcher_get_stack_w, 1, 0, 0, H_gtk_stack_switcher_get_stack, pl_pu);
+ Xg_define_procedure(gtk_stack_new, gxg_gtk_stack_new_w, 0, 0, 0, H_gtk_stack_new, pl_p);
+ Xg_define_procedure(gtk_stack_add_named, gxg_gtk_stack_add_named_w, 3, 0, 0, H_gtk_stack_add_named, pl_tuus);
+ Xg_define_procedure(gtk_stack_add_titled, gxg_gtk_stack_add_titled_w, 4, 0, 0, H_gtk_stack_add_titled, pl_tuus);
+ Xg_define_procedure(gtk_stack_set_visible_child, gxg_gtk_stack_set_visible_child_w, 2, 0, 0, H_gtk_stack_set_visible_child, pl_tu);
+ Xg_define_procedure(gtk_stack_get_visible_child, gxg_gtk_stack_get_visible_child_w, 1, 0, 0, H_gtk_stack_get_visible_child, pl_pu);
+ Xg_define_procedure(gtk_stack_set_visible_child_name, gxg_gtk_stack_set_visible_child_name_w, 2, 0, 0, H_gtk_stack_set_visible_child_name, pl_tus);
+ Xg_define_procedure(gtk_stack_get_visible_child_name, gxg_gtk_stack_get_visible_child_name_w, 1, 0, 0, H_gtk_stack_get_visible_child_name, pl_su);
+ Xg_define_procedure(gtk_stack_set_visible_child_full, gxg_gtk_stack_set_visible_child_full_w, 3, 0, 0, H_gtk_stack_set_visible_child_full, pl_tusi);
+ Xg_define_procedure(gtk_stack_set_homogeneous, gxg_gtk_stack_set_homogeneous_w, 2, 0, 0, H_gtk_stack_set_homogeneous, pl_tub);
+ Xg_define_procedure(gtk_stack_get_homogeneous, gxg_gtk_stack_get_homogeneous_w, 1, 0, 0, H_gtk_stack_get_homogeneous, pl_bu);
+ Xg_define_procedure(gtk_stack_set_transition_duration, gxg_gtk_stack_set_transition_duration_w, 2, 0, 0, H_gtk_stack_set_transition_duration, pl_tui);
+ Xg_define_procedure(gtk_stack_get_transition_duration, gxg_gtk_stack_get_transition_duration_w, 1, 0, 0, H_gtk_stack_get_transition_duration, pl_iu);
+ Xg_define_procedure(gtk_stack_set_transition_type, gxg_gtk_stack_set_transition_type_w, 2, 0, 0, H_gtk_stack_set_transition_type, pl_tui);
+ Xg_define_procedure(gtk_stack_get_transition_type, gxg_gtk_stack_get_transition_type_w, 1, 0, 0, H_gtk_stack_get_transition_type, pl_iu);
+ Xg_define_procedure(gtk_revealer_new, gxg_gtk_revealer_new_w, 0, 0, 0, H_gtk_revealer_new, pl_p);
+ Xg_define_procedure(gtk_revealer_get_reveal_child, gxg_gtk_revealer_get_reveal_child_w, 1, 0, 0, H_gtk_revealer_get_reveal_child, pl_bu);
+ Xg_define_procedure(gtk_revealer_set_reveal_child, gxg_gtk_revealer_set_reveal_child_w, 2, 0, 0, H_gtk_revealer_set_reveal_child, pl_tub);
+ Xg_define_procedure(gtk_revealer_get_child_revealed, gxg_gtk_revealer_get_child_revealed_w, 1, 0, 0, H_gtk_revealer_get_child_revealed, pl_bu);
+ Xg_define_procedure(gtk_revealer_get_transition_duration, gxg_gtk_revealer_get_transition_duration_w, 1, 0, 0, H_gtk_revealer_get_transition_duration, pl_iu);
+ Xg_define_procedure(gtk_revealer_set_transition_duration, gxg_gtk_revealer_set_transition_duration_w, 2, 0, 0, H_gtk_revealer_set_transition_duration, pl_tui);
+ Xg_define_procedure(gtk_revealer_set_transition_type, gxg_gtk_revealer_set_transition_type_w, 2, 0, 0, H_gtk_revealer_set_transition_type, pl_tui);
+ Xg_define_procedure(gtk_revealer_get_transition_type, gxg_gtk_revealer_get_transition_type_w, 1, 0, 0, H_gtk_revealer_get_transition_type, pl_iu);
+ Xg_define_procedure(gtk_header_bar_new, gxg_gtk_header_bar_new_w, 0, 0, 0, H_gtk_header_bar_new, pl_p);
+ Xg_define_procedure(gtk_header_bar_set_title, gxg_gtk_header_bar_set_title_w, 2, 0, 0, H_gtk_header_bar_set_title, pl_tus);
+ Xg_define_procedure(gtk_header_bar_get_title, gxg_gtk_header_bar_get_title_w, 1, 0, 0, H_gtk_header_bar_get_title, pl_su);
+ Xg_define_procedure(gtk_header_bar_set_subtitle, gxg_gtk_header_bar_set_subtitle_w, 2, 0, 0, H_gtk_header_bar_set_subtitle, pl_tus);
+ Xg_define_procedure(gtk_header_bar_get_subtitle, gxg_gtk_header_bar_get_subtitle_w, 1, 0, 0, H_gtk_header_bar_get_subtitle, pl_su);
+ Xg_define_procedure(gtk_header_bar_set_custom_title, gxg_gtk_header_bar_set_custom_title_w, 2, 0, 0, H_gtk_header_bar_set_custom_title, pl_tu);
+ Xg_define_procedure(gtk_header_bar_get_custom_title, gxg_gtk_header_bar_get_custom_title_w, 1, 0, 0, H_gtk_header_bar_get_custom_title, pl_pu);
+ Xg_define_procedure(gtk_header_bar_pack_start, gxg_gtk_header_bar_pack_start_w, 2, 0, 0, H_gtk_header_bar_pack_start, pl_tu);
+ Xg_define_procedure(gtk_header_bar_pack_end, gxg_gtk_header_bar_pack_end_w, 2, 0, 0, H_gtk_header_bar_pack_end, pl_tu);
+ Xg_define_procedure(gtk_list_box_row_new, gxg_gtk_list_box_row_new_w, 0, 0, 0, H_gtk_list_box_row_new, pl_p);
+ Xg_define_procedure(gtk_list_box_row_get_header, gxg_gtk_list_box_row_get_header_w, 1, 0, 0, H_gtk_list_box_row_get_header, pl_pu);
+ Xg_define_procedure(gtk_list_box_row_set_header, gxg_gtk_list_box_row_set_header_w, 2, 0, 0, H_gtk_list_box_row_set_header, pl_tu);
+ Xg_define_procedure(gtk_list_box_row_changed, gxg_gtk_list_box_row_changed_w, 1, 0, 0, H_gtk_list_box_row_changed, pl_tu);
+ Xg_define_procedure(gtk_list_box_get_selected_row, gxg_gtk_list_box_get_selected_row_w, 1, 0, 0, H_gtk_list_box_get_selected_row, pl_pu);
+ Xg_define_procedure(gtk_list_box_get_row_at_index, gxg_gtk_list_box_get_row_at_index_w, 2, 0, 0, H_gtk_list_box_get_row_at_index, pl_pui);
+ Xg_define_procedure(gtk_list_box_get_row_at_y, gxg_gtk_list_box_get_row_at_y_w, 2, 0, 0, H_gtk_list_box_get_row_at_y, pl_pui);
+ Xg_define_procedure(gtk_list_box_select_row, gxg_gtk_list_box_select_row_w, 2, 0, 0, H_gtk_list_box_select_row, pl_tu);
+ Xg_define_procedure(gtk_list_box_set_placeholder, gxg_gtk_list_box_set_placeholder_w, 2, 0, 0, H_gtk_list_box_set_placeholder, pl_tu);
+ Xg_define_procedure(gtk_list_box_set_adjustment, gxg_gtk_list_box_set_adjustment_w, 2, 0, 0, H_gtk_list_box_set_adjustment, pl_tu);
+ Xg_define_procedure(gtk_list_box_get_adjustment, gxg_gtk_list_box_get_adjustment_w, 1, 0, 0, H_gtk_list_box_get_adjustment, pl_pu);
+ Xg_define_procedure(gtk_list_box_set_selection_mode, gxg_gtk_list_box_set_selection_mode_w, 2, 0, 0, H_gtk_list_box_set_selection_mode, pl_tui);
+ Xg_define_procedure(gtk_list_box_get_selection_mode, gxg_gtk_list_box_get_selection_mode_w, 1, 0, 0, H_gtk_list_box_get_selection_mode, pl_iu);
+ Xg_define_procedure(gtk_list_box_invalidate_filter, gxg_gtk_list_box_invalidate_filter_w, 1, 0, 0, H_gtk_list_box_invalidate_filter, pl_tu);
+ Xg_define_procedure(gtk_list_box_invalidate_sort, gxg_gtk_list_box_invalidate_sort_w, 1, 0, 0, H_gtk_list_box_invalidate_sort, pl_tu);
+ Xg_define_procedure(gtk_list_box_invalidate_headers, gxg_gtk_list_box_invalidate_headers_w, 1, 0, 0, H_gtk_list_box_invalidate_headers, pl_tu);
+ Xg_define_procedure(gtk_list_box_set_activate_on_single_click, gxg_gtk_list_box_set_activate_on_single_click_w, 2, 0, 0, H_gtk_list_box_set_activate_on_single_click, pl_tub);
+ Xg_define_procedure(gtk_list_box_get_activate_on_single_click, gxg_gtk_list_box_get_activate_on_single_click_w, 1, 0, 0, H_gtk_list_box_get_activate_on_single_click, pl_bu);
+ Xg_define_procedure(gtk_list_box_drag_unhighlight_row, gxg_gtk_list_box_drag_unhighlight_row_w, 1, 0, 0, H_gtk_list_box_drag_unhighlight_row, pl_tu);
+ Xg_define_procedure(gtk_list_box_drag_highlight_row, gxg_gtk_list_box_drag_highlight_row_w, 2, 0, 0, H_gtk_list_box_drag_highlight_row, pl_tu);
+ Xg_define_procedure(gtk_list_box_new, gxg_gtk_list_box_new_w, 0, 0, 0, H_gtk_list_box_new, pl_p);
+ Xg_define_procedure(gtk_search_bar_new, gxg_gtk_search_bar_new_w, 0, 0, 0, H_gtk_search_bar_new, pl_p);
+ Xg_define_procedure(gtk_search_bar_connect_entry, gxg_gtk_search_bar_connect_entry_w, 2, 0, 0, H_gtk_search_bar_connect_entry, pl_tu);
+ Xg_define_procedure(gtk_search_bar_get_search_mode, gxg_gtk_search_bar_get_search_mode_w, 1, 0, 0, H_gtk_search_bar_get_search_mode, pl_bu);
+ Xg_define_procedure(gtk_search_bar_set_search_mode, gxg_gtk_search_bar_set_search_mode_w, 2, 0, 0, H_gtk_search_bar_set_search_mode, pl_tub);
+ Xg_define_procedure(gtk_search_bar_get_show_close_button, gxg_gtk_search_bar_get_show_close_button_w, 1, 0, 0, H_gtk_search_bar_get_show_close_button, pl_bu);
+ Xg_define_procedure(gtk_search_bar_set_show_close_button, gxg_gtk_search_bar_set_show_close_button_w, 2, 0, 0, H_gtk_search_bar_set_show_close_button, pl_tub);
+ Xg_define_procedure(gtk_search_bar_handle_event, gxg_gtk_search_bar_handle_event_w, 2, 0, 0, H_gtk_search_bar_handle_event, pl_bu);
+ Xg_define_procedure(gtk_file_chooser_get_current_name, gxg_gtk_file_chooser_get_current_name_w, 1, 0, 0, H_gtk_file_chooser_get_current_name, pl_su);
+ Xg_define_procedure(gdk_cairo_surface_create_from_pixbuf, gxg_gdk_cairo_surface_create_from_pixbuf_w, 3, 0, 0, H_gdk_cairo_surface_create_from_pixbuf, pl_puiu);
+ Xg_define_procedure(gdk_device_get_position_double, gxg_gdk_device_get_position_double_w, 1, 3, 0, H_gdk_device_get_position_double, pl_tu);
+ Xg_define_procedure(gdk_device_get_window_at_position_double, gxg_gdk_device_get_window_at_position_double_w, 1, 2, 0, H_gdk_device_get_window_at_position_double, pl_pu);
+ Xg_define_procedure(gdk_screen_get_monitor_scale_factor, gxg_gdk_screen_get_monitor_scale_factor_w, 2, 0, 0, H_gdk_screen_get_monitor_scale_factor, pl_iui);
+ Xg_define_procedure(gdk_window_get_scale_factor, gxg_gdk_window_get_scale_factor_w, 1, 0, 0, H_gdk_window_get_scale_factor, pl_iu);
+ Xg_define_procedure(gdk_window_get_device_position_double, gxg_gdk_window_get_device_position_double_w, 2, 3, 0, H_gdk_window_get_device_position_double, pl_pu);
+ Xg_define_procedure(gdk_window_create_similar_image_surface, gxg_gdk_window_create_similar_image_surface_w, 5, 0, 0, H_gdk_window_create_similar_image_surface, pl_pui);
+ Xg_define_procedure(gtk_icon_theme_lookup_icon_for_scale, gxg_gtk_icon_theme_lookup_icon_for_scale_w, 5, 0, 0, H_gtk_icon_theme_lookup_icon_for_scale, pl_pusi);
+ Xg_define_procedure(gtk_icon_theme_load_icon_for_scale, gxg_gtk_icon_theme_load_icon_for_scale_w, 5, 1, 0, H_gtk_icon_theme_load_icon_for_scale, pl_pusiiiu);
+ Xg_define_procedure(gtk_icon_theme_load_surface, gxg_gtk_icon_theme_load_surface_w, 6, 1, 0, H_gtk_icon_theme_load_surface, pl_pusiiuiu);
+ Xg_define_procedure(gtk_icon_theme_lookup_by_gicon_for_scale, gxg_gtk_icon_theme_lookup_by_gicon_for_scale_w, 5, 0, 0, H_gtk_icon_theme_lookup_by_gicon_for_scale, pl_puui);
+ Xg_define_procedure(gtk_icon_info_get_base_scale, gxg_gtk_icon_info_get_base_scale_w, 1, 0, 0, H_gtk_icon_info_get_base_scale, pl_iu);
+ Xg_define_procedure(gtk_icon_info_load_surface, gxg_gtk_icon_info_load_surface_w, 2, 1, 0, H_gtk_icon_info_load_surface, pl_pu);
+ Xg_define_procedure(gtk_image_new_from_surface, gxg_gtk_image_new_from_surface_w, 1, 0, 0, H_gtk_image_new_from_surface, pl_pu);
+ Xg_define_procedure(gtk_image_set_from_surface, gxg_gtk_image_set_from_surface_w, 2, 0, 0, H_gtk_image_set_from_surface, pl_tu);
+ Xg_define_procedure(gtk_list_box_row_get_index, gxg_gtk_list_box_row_get_index_w, 1, 0, 0, H_gtk_list_box_row_get_index, pl_iu);
+ Xg_define_procedure(gtk_widget_get_scale_factor, gxg_gtk_widget_get_scale_factor_w, 1, 0, 0, H_gtk_widget_get_scale_factor, pl_iu);
+ Xg_define_procedure(gtk_window_close, gxg_gtk_window_close_w, 1, 0, 0, H_gtk_window_close, pl_tu);
+ Xg_define_procedure(gtk_info_bar_set_show_close_button, gxg_gtk_info_bar_set_show_close_button_w, 2, 0, 0, H_gtk_info_bar_set_show_close_button, pl_tub);
+ Xg_define_procedure(gtk_info_bar_get_show_close_button, gxg_gtk_info_bar_get_show_close_button_w, 1, 0, 0, H_gtk_info_bar_get_show_close_button, pl_bu);
+ Xg_define_procedure(gtk_tree_model_rows_reordered_with_length, gxg_gtk_tree_model_rows_reordered_with_length_w, 5, 0, 0, H_gtk_tree_model_rows_reordered_with_length, pl_tuuuui);
+ Xg_define_procedure(gdk_cursor_new_from_surface, gxg_gdk_cursor_new_from_surface_w, 4, 0, 0, H_gdk_cursor_new_from_surface, pl_puur);
+ Xg_define_procedure(gdk_cursor_get_surface, gxg_gdk_cursor_get_surface_w, 1, 2, 0, H_gdk_cursor_get_surface, pl_pu);
+ Xg_define_procedure(gdk_event_get_event_type, gxg_gdk_event_get_event_type_w, 1, 0, 0, H_gdk_event_get_event_type, pl_iu);
+ Xg_define_procedure(gtk_entry_set_tabs, gxg_gtk_entry_set_tabs_w, 2, 0, 0, H_gtk_entry_set_tabs, pl_tu);
+ Xg_define_procedure(gtk_entry_get_tabs, gxg_gtk_entry_get_tabs_w, 1, 0, 0, H_gtk_entry_get_tabs, pl_pu);
+ Xg_define_procedure(gtk_header_bar_get_show_close_button, gxg_gtk_header_bar_get_show_close_button_w, 1, 0, 0, H_gtk_header_bar_get_show_close_button, pl_bu);
+ Xg_define_procedure(gtk_header_bar_set_show_close_button, gxg_gtk_header_bar_set_show_close_button_w, 2, 0, 0, H_gtk_header_bar_set_show_close_button, pl_tub);
+ Xg_define_procedure(gtk_list_box_prepend, gxg_gtk_list_box_prepend_w, 2, 0, 0, H_gtk_list_box_prepend, pl_tu);
+ Xg_define_procedure(gtk_list_box_insert, gxg_gtk_list_box_insert_w, 3, 0, 0, H_gtk_list_box_insert, pl_tuui);
+ Xg_define_procedure(gdk_window_set_opaque_region, gxg_gdk_window_set_opaque_region_w, 2, 0, 0, H_gdk_window_set_opaque_region, pl_tu);
+ Xg_define_procedure(gtk_label_set_lines, gxg_gtk_label_set_lines_w, 2, 0, 0, H_gtk_label_set_lines, pl_tui);
+ Xg_define_procedure(gtk_label_get_lines, gxg_gtk_label_get_lines_w, 1, 0, 0, H_gtk_label_get_lines, pl_iu);
+ Xg_define_procedure(gdk_event_get_window, gxg_gdk_event_get_window_w, 1, 0, 0, H_gdk_event_get_window, pl_pu);
+#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
-#define gxg_make_GdkRGBA_w gxg_make_GdkRGBA
+#if GTK_CHECK_VERSION(3, 12, 0)
+ Xg_define_procedure(gtk_flow_box_child_new, gxg_gtk_flow_box_child_new_w, 0, 0, 0, H_gtk_flow_box_child_new, pl_p);
+ Xg_define_procedure(gtk_flow_box_child_get_index, gxg_gtk_flow_box_child_get_index_w, 1, 0, 0, H_gtk_flow_box_child_get_index, pl_iu);
+ Xg_define_procedure(gtk_flow_box_child_is_selected, gxg_gtk_flow_box_child_is_selected_w, 1, 0, 0, H_gtk_flow_box_child_is_selected, pl_bu);
+ Xg_define_procedure(gtk_flow_box_child_changed, gxg_gtk_flow_box_child_changed_w, 1, 0, 0, H_gtk_flow_box_child_changed, pl_tu);
+ Xg_define_procedure(gtk_flow_box_new, gxg_gtk_flow_box_new_w, 0, 0, 0, H_gtk_flow_box_new, pl_p);
+ Xg_define_procedure(gtk_flow_box_set_homogeneous, gxg_gtk_flow_box_set_homogeneous_w, 2, 0, 0, H_gtk_flow_box_set_homogeneous, pl_tub);
+ Xg_define_procedure(gtk_flow_box_get_homogeneous, gxg_gtk_flow_box_get_homogeneous_w, 1, 0, 0, H_gtk_flow_box_get_homogeneous, pl_bu);
+ Xg_define_procedure(gtk_flow_box_set_row_spacing, gxg_gtk_flow_box_set_row_spacing_w, 2, 0, 0, H_gtk_flow_box_set_row_spacing, pl_tui);
+ Xg_define_procedure(gtk_flow_box_get_row_spacing, gxg_gtk_flow_box_get_row_spacing_w, 1, 0, 0, H_gtk_flow_box_get_row_spacing, pl_iu);
+ Xg_define_procedure(gtk_flow_box_set_column_spacing, gxg_gtk_flow_box_set_column_spacing_w, 2, 0, 0, H_gtk_flow_box_set_column_spacing, pl_tui);
+ Xg_define_procedure(gtk_flow_box_get_column_spacing, gxg_gtk_flow_box_get_column_spacing_w, 1, 0, 0, H_gtk_flow_box_get_column_spacing, pl_iu);
+ Xg_define_procedure(gtk_flow_box_set_min_children_per_line, gxg_gtk_flow_box_set_min_children_per_line_w, 2, 0, 0, H_gtk_flow_box_set_min_children_per_line, pl_tui);
+ Xg_define_procedure(gtk_flow_box_get_min_children_per_line, gxg_gtk_flow_box_get_min_children_per_line_w, 1, 0, 0, H_gtk_flow_box_get_min_children_per_line, pl_iu);
+ Xg_define_procedure(gtk_flow_box_set_max_children_per_line, gxg_gtk_flow_box_set_max_children_per_line_w, 2, 0, 0, H_gtk_flow_box_set_max_children_per_line, pl_tui);
+ Xg_define_procedure(gtk_flow_box_get_max_children_per_line, gxg_gtk_flow_box_get_max_children_per_line_w, 1, 0, 0, H_gtk_flow_box_get_max_children_per_line, pl_iu);
+ Xg_define_procedure(gtk_flow_box_set_activate_on_single_click, gxg_gtk_flow_box_set_activate_on_single_click_w, 2, 0, 0, H_gtk_flow_box_set_activate_on_single_click, pl_tub);
+ Xg_define_procedure(gtk_flow_box_get_activate_on_single_click, gxg_gtk_flow_box_get_activate_on_single_click_w, 1, 0, 0, H_gtk_flow_box_get_activate_on_single_click, pl_bu);
+ Xg_define_procedure(gtk_flow_box_insert, gxg_gtk_flow_box_insert_w, 3, 0, 0, H_gtk_flow_box_insert, pl_tuui);
+ Xg_define_procedure(gtk_flow_box_get_child_at_index, gxg_gtk_flow_box_get_child_at_index_w, 2, 0, 0, H_gtk_flow_box_get_child_at_index, pl_pui);
+ Xg_define_procedure(gtk_flow_box_get_selected_children, gxg_gtk_flow_box_get_selected_children_w, 1, 0, 0, H_gtk_flow_box_get_selected_children, pl_pu);
+ Xg_define_procedure(gtk_flow_box_select_child, gxg_gtk_flow_box_select_child_w, 2, 0, 0, H_gtk_flow_box_select_child, pl_tu);
+ Xg_define_procedure(gtk_flow_box_unselect_child, gxg_gtk_flow_box_unselect_child_w, 2, 0, 0, H_gtk_flow_box_unselect_child, pl_tu);
+ Xg_define_procedure(gtk_flow_box_select_all, gxg_gtk_flow_box_select_all_w, 1, 0, 0, H_gtk_flow_box_select_all, pl_tu);
+ Xg_define_procedure(gtk_flow_box_unselect_all, gxg_gtk_flow_box_unselect_all_w, 1, 0, 0, H_gtk_flow_box_unselect_all, pl_tu);
+ Xg_define_procedure(gtk_flow_box_set_selection_mode, gxg_gtk_flow_box_set_selection_mode_w, 2, 0, 0, H_gtk_flow_box_set_selection_mode, pl_tui);
+ Xg_define_procedure(gtk_flow_box_get_selection_mode, gxg_gtk_flow_box_get_selection_mode_w, 1, 0, 0, H_gtk_flow_box_get_selection_mode, pl_iu);
+ Xg_define_procedure(gtk_flow_box_set_hadjustment, gxg_gtk_flow_box_set_hadjustment_w, 2, 0, 0, H_gtk_flow_box_set_hadjustment, pl_tu);
+ Xg_define_procedure(gtk_flow_box_set_vadjustment, gxg_gtk_flow_box_set_vadjustment_w, 2, 0, 0, H_gtk_flow_box_set_vadjustment, pl_tu);
+ Xg_define_procedure(gtk_flow_box_invalidate_filter, gxg_gtk_flow_box_invalidate_filter_w, 1, 0, 0, H_gtk_flow_box_invalidate_filter, pl_tu);
+ Xg_define_procedure(gtk_flow_box_invalidate_sort, gxg_gtk_flow_box_invalidate_sort_w, 1, 0, 0, H_gtk_flow_box_invalidate_sort, pl_tu);
+ Xg_define_procedure(gdk_window_set_event_compression, gxg_gdk_window_set_event_compression_w, 2, 0, 0, H_gdk_window_set_event_compression, pl_tub);
+ Xg_define_procedure(gdk_window_get_event_compression, gxg_gdk_window_get_event_compression_w, 1, 0, 0, H_gdk_window_get_event_compression, pl_bu);
+ Xg_define_procedure(gtk_places_sidebar_set_local_only, gxg_gtk_places_sidebar_set_local_only_w, 2, 0, 0, H_gtk_places_sidebar_set_local_only, pl_tub);
+ Xg_define_procedure(gtk_places_sidebar_get_local_only, gxg_gtk_places_sidebar_get_local_only_w, 1, 0, 0, H_gtk_places_sidebar_get_local_only, pl_bu);
+ Xg_define_procedure(gtk_stack_get_transition_running, gxg_gtk_stack_get_transition_running_w, 1, 0, 0, H_gtk_stack_get_transition_running, pl_bu);
+ Xg_define_procedure(gtk_widget_get_margin_start, gxg_gtk_widget_get_margin_start_w, 1, 0, 0, H_gtk_widget_get_margin_start, pl_iu);
+ Xg_define_procedure(gtk_widget_set_margin_start, gxg_gtk_widget_set_margin_start_w, 2, 0, 0, H_gtk_widget_set_margin_start, pl_tui);
+ Xg_define_procedure(gtk_widget_get_margin_end, gxg_gtk_widget_get_margin_end_w, 1, 0, 0, H_gtk_widget_get_margin_end, pl_iu);
+ Xg_define_procedure(gtk_widget_set_margin_end, gxg_gtk_widget_set_margin_end_w, 2, 0, 0, H_gtk_widget_set_margin_end, pl_tui);
+ Xg_define_procedure(gtk_accel_label_get_accel, gxg_gtk_accel_label_get_accel_w, 1, 2, 0, H_gtk_accel_label_get_accel, pl_tu);
+ Xg_define_procedure(gdk_window_set_shadow_width, gxg_gdk_window_set_shadow_width_w, 5, 0, 0, H_gdk_window_set_shadow_width, pl_tui);
+ Xg_define_procedure(gtk_action_bar_new, gxg_gtk_action_bar_new_w, 0, 0, 0, H_gtk_action_bar_new, pl_p);
+ Xg_define_procedure(gtk_action_bar_get_center_widget, gxg_gtk_action_bar_get_center_widget_w, 1, 0, 0, H_gtk_action_bar_get_center_widget, pl_pu);
+ Xg_define_procedure(gtk_action_bar_set_center_widget, gxg_gtk_action_bar_set_center_widget_w, 2, 0, 0, H_gtk_action_bar_set_center_widget, pl_tu);
+ Xg_define_procedure(gtk_action_bar_pack_start, gxg_gtk_action_bar_pack_start_w, 2, 0, 0, H_gtk_action_bar_pack_start, pl_tu);
+ Xg_define_procedure(gtk_action_bar_pack_end, gxg_gtk_action_bar_pack_end_w, 2, 0, 0, H_gtk_action_bar_pack_end, pl_tu);
+ Xg_define_procedure(gtk_header_bar_set_has_subtitle, gxg_gtk_header_bar_set_has_subtitle_w, 2, 0, 0, H_gtk_header_bar_set_has_subtitle, pl_tub);
+ Xg_define_procedure(gtk_header_bar_get_has_subtitle, gxg_gtk_header_bar_get_has_subtitle_w, 1, 0, 0, H_gtk_header_bar_get_has_subtitle, pl_bu);
+ Xg_define_procedure(gtk_header_bar_set_decoration_layout, gxg_gtk_header_bar_set_decoration_layout_w, 2, 0, 0, H_gtk_header_bar_set_decoration_layout, pl_tus);
+ Xg_define_procedure(gtk_header_bar_get_decoration_layout, gxg_gtk_header_bar_get_decoration_layout_w, 1, 0, 0, H_gtk_header_bar_get_decoration_layout, pl_su);
+ Xg_define_procedure(gtk_icon_info_is_symbolic, gxg_gtk_icon_info_is_symbolic_w, 1, 0, 0, H_gtk_icon_info_is_symbolic, pl_bu);
+ Xg_define_procedure(gtk_get_locale_direction, gxg_gtk_get_locale_direction_w, 0, 0, 0, H_gtk_get_locale_direction, pl_i);
+ Xg_define_procedure(gtk_window_is_maximized, gxg_gtk_window_is_maximized_w, 1, 0, 0, H_gtk_window_is_maximized, pl_bu);
+ Xg_define_procedure(gtk_dialog_get_header_bar, gxg_gtk_dialog_get_header_bar_w, 1, 0, 0, H_gtk_dialog_get_header_bar, pl_pu);
+ Xg_define_procedure(gtk_popover_new, gxg_gtk_popover_new_w, 1, 0, 0, H_gtk_popover_new, pl_pu);
+ Xg_define_procedure(gtk_popover_set_relative_to, gxg_gtk_popover_set_relative_to_w, 2, 0, 0, H_gtk_popover_set_relative_to, pl_tu);
+ Xg_define_procedure(gtk_popover_get_relative_to, gxg_gtk_popover_get_relative_to_w, 1, 0, 0, H_gtk_popover_get_relative_to, pl_pu);
+ Xg_define_procedure(gtk_popover_set_position, gxg_gtk_popover_set_position_w, 2, 0, 0, H_gtk_popover_set_position, pl_tui);
+ Xg_define_procedure(gtk_popover_get_position, gxg_gtk_popover_get_position_w, 1, 0, 0, H_gtk_popover_get_position, pl_iu);
+ Xg_define_procedure(gtk_popover_set_modal, gxg_gtk_popover_set_modal_w, 2, 0, 0, H_gtk_popover_set_modal, pl_tub);
+ Xg_define_procedure(gtk_popover_get_modal, gxg_gtk_popover_get_modal_w, 1, 0, 0, H_gtk_popover_get_modal, pl_bu);
+ Xg_define_procedure(gtk_box_set_center_widget, gxg_gtk_box_set_center_widget_w, 2, 0, 0, H_gtk_box_set_center_widget, pl_tu);
+ Xg_define_procedure(gtk_box_get_center_widget, gxg_gtk_box_get_center_widget_w, 1, 0, 0, H_gtk_box_get_center_widget, pl_pu);
+ Xg_define_procedure(gtk_entry_set_max_width_chars, gxg_gtk_entry_set_max_width_chars_w, 2, 0, 0, H_gtk_entry_set_max_width_chars, pl_tui);
+ Xg_define_procedure(gtk_entry_get_max_width_chars, gxg_gtk_entry_get_max_width_chars_w, 1, 0, 0, H_gtk_entry_get_max_width_chars, pl_iu);
+ Xg_define_procedure(gdk_device_get_last_event_window, gxg_gdk_device_get_last_event_window_w, 1, 0, 0, H_gdk_device_get_last_event_window, pl_pu);
+#endif
+#if GTK_CHECK_VERSION(3, 14, 0)
+ Xg_define_procedure(gtk_list_box_row_is_selected, gxg_gtk_list_box_row_is_selected_w, 1, 0, 0, H_gtk_list_box_row_is_selected, pl_bu);
+ Xg_define_procedure(gtk_list_box_unselect_row, gxg_gtk_list_box_unselect_row_w, 2, 0, 0, H_gtk_list_box_unselect_row, pl_tu);
+ Xg_define_procedure(gtk_list_box_select_all, gxg_gtk_list_box_select_all_w, 1, 0, 0, H_gtk_list_box_select_all, pl_tu);
+ Xg_define_procedure(gtk_list_box_unselect_all, gxg_gtk_list_box_unselect_all_w, 1, 0, 0, H_gtk_list_box_unselect_all, pl_tu);
+ Xg_define_procedure(gtk_places_sidebar_get_show_enter_location, gxg_gtk_places_sidebar_get_show_enter_location_w, 1, 0, 0, H_gtk_places_sidebar_get_show_enter_location, pl_bu);
+ Xg_define_procedure(gtk_places_sidebar_set_show_enter_location, gxg_gtk_places_sidebar_set_show_enter_location_w, 2, 0, 0, H_gtk_places_sidebar_set_show_enter_location, pl_tub);
+ Xg_define_procedure(gtk_switch_set_state, gxg_gtk_switch_set_state_w, 2, 0, 0, H_gtk_switch_set_state, pl_tub);
+ Xg_define_procedure(gtk_switch_get_state, gxg_gtk_switch_get_state_w, 1, 0, 0, H_gtk_switch_get_state, pl_bu);
+ Xg_define_procedure(gdk_window_show_window_menu, gxg_gdk_window_show_window_menu_w, 2, 0, 0, H_gdk_window_show_window_menu, pl_bu);
+ Xg_define_procedure(gtk_widget_set_clip, gxg_gtk_widget_set_clip_w, 2, 0, 0, H_gtk_widget_set_clip, pl_tu);
+ Xg_define_procedure(gtk_widget_get_clip, gxg_gtk_widget_get_clip_w, 2, 0, 0, H_gtk_widget_get_clip, pl_tu);
+ Xg_define_procedure(gtk_gesture_get_device, gxg_gtk_gesture_get_device_w, 1, 0, 0, H_gtk_gesture_get_device, pl_pu);
+ Xg_define_procedure(gtk_gesture_set_state, gxg_gtk_gesture_set_state_w, 2, 0, 0, H_gtk_gesture_set_state, pl_but);
+ Xg_define_procedure(gtk_gesture_get_sequence_state, gxg_gtk_gesture_get_sequence_state_w, 2, 0, 0, H_gtk_gesture_get_sequence_state, pl_tu);
+ Xg_define_procedure(gtk_gesture_set_sequence_state, gxg_gtk_gesture_set_sequence_state_w, 3, 0, 0, H_gtk_gesture_set_sequence_state, pl_buut);
+ Xg_define_procedure(gtk_gesture_get_sequences, gxg_gtk_gesture_get_sequences_w, 1, 0, 0, H_gtk_gesture_get_sequences, pl_pu);
+ Xg_define_procedure(gtk_gesture_get_last_updated_sequence, gxg_gtk_gesture_get_last_updated_sequence_w, 1, 0, 0, H_gtk_gesture_get_last_updated_sequence, pl_pu);
+ Xg_define_procedure(gtk_gesture_handles_sequence, gxg_gtk_gesture_handles_sequence_w, 2, 0, 0, H_gtk_gesture_handles_sequence, pl_bu);
+ Xg_define_procedure(gtk_gesture_get_last_event, gxg_gtk_gesture_get_last_event_w, 2, 0, 0, H_gtk_gesture_get_last_event, pl_pu);
+ Xg_define_procedure(gtk_gesture_get_point, gxg_gtk_gesture_get_point_w, 2, 2, 0, H_gtk_gesture_get_point, pl_bu);
+ Xg_define_procedure(gtk_gesture_get_bounding_box, gxg_gtk_gesture_get_bounding_box_w, 2, 0, 0, H_gtk_gesture_get_bounding_box, pl_bu);
+ Xg_define_procedure(gtk_gesture_get_bounding_box_center, gxg_gtk_gesture_get_bounding_box_center_w, 1, 2, 0, H_gtk_gesture_get_bounding_box_center, pl_bu);
+ Xg_define_procedure(gtk_gesture_is_active, gxg_gtk_gesture_is_active_w, 1, 0, 0, H_gtk_gesture_is_active, pl_bu);
+ Xg_define_procedure(gtk_gesture_is_recognized, gxg_gtk_gesture_is_recognized_w, 1, 0, 0, H_gtk_gesture_is_recognized, pl_bu);
+ Xg_define_procedure(gtk_gesture_get_window, gxg_gtk_gesture_get_window_w, 1, 0, 0, H_gtk_gesture_get_window, pl_pu);
+ Xg_define_procedure(gtk_gesture_set_window, gxg_gtk_gesture_set_window_w, 2, 0, 0, H_gtk_gesture_set_window, pl_tu);
+ Xg_define_procedure(gtk_gesture_group, gxg_gtk_gesture_group_w, 2, 0, 0, H_gtk_gesture_group, pl_tu);
+ Xg_define_procedure(gtk_gesture_ungroup, gxg_gtk_gesture_ungroup_w, 1, 0, 0, H_gtk_gesture_ungroup, pl_tu);
+ Xg_define_procedure(gtk_gesture_get_group, gxg_gtk_gesture_get_group_w, 1, 0, 0, H_gtk_gesture_get_group, pl_pu);
+ Xg_define_procedure(gtk_gesture_is_grouped_with, gxg_gtk_gesture_is_grouped_with_w, 2, 0, 0, H_gtk_gesture_is_grouped_with, pl_bu);
+ Xg_define_procedure(gtk_gesture_drag_new, gxg_gtk_gesture_drag_new_w, 1, 0, 0, H_gtk_gesture_drag_new, pl_pu);
+ Xg_define_procedure(gtk_gesture_drag_get_start_point, gxg_gtk_gesture_drag_get_start_point_w, 1, 2, 0, H_gtk_gesture_drag_get_start_point, pl_bu);
+ Xg_define_procedure(gtk_gesture_drag_get_offset, gxg_gtk_gesture_drag_get_offset_w, 1, 2, 0, H_gtk_gesture_drag_get_offset, pl_bu);
+ Xg_define_procedure(gtk_gesture_long_press_new, gxg_gtk_gesture_long_press_new_w, 1, 0, 0, H_gtk_gesture_long_press_new, pl_pu);
+ Xg_define_procedure(gtk_gesture_pan_new, gxg_gtk_gesture_pan_new_w, 2, 0, 0, H_gtk_gesture_pan_new, pl_pui);
+ Xg_define_procedure(gtk_gesture_pan_get_orientation, gxg_gtk_gesture_pan_get_orientation_w, 1, 0, 0, H_gtk_gesture_pan_get_orientation, pl_iu);
+ Xg_define_procedure(gtk_gesture_pan_set_orientation, gxg_gtk_gesture_pan_set_orientation_w, 2, 0, 0, H_gtk_gesture_pan_set_orientation, pl_tui);
+ Xg_define_procedure(gtk_gesture_multi_press_new, gxg_gtk_gesture_multi_press_new_w, 1, 0, 0, H_gtk_gesture_multi_press_new, pl_pu);
+ Xg_define_procedure(gtk_gesture_multi_press_set_area, gxg_gtk_gesture_multi_press_set_area_w, 2, 0, 0, H_gtk_gesture_multi_press_set_area, pl_tu);
+ Xg_define_procedure(gtk_gesture_multi_press_get_area, gxg_gtk_gesture_multi_press_get_area_w, 2, 0, 0, H_gtk_gesture_multi_press_get_area, pl_bu);
+ Xg_define_procedure(gtk_gesture_rotate_new, gxg_gtk_gesture_rotate_new_w, 1, 0, 0, H_gtk_gesture_rotate_new, pl_pu);
+ Xg_define_procedure(gtk_gesture_rotate_get_angle_delta, gxg_gtk_gesture_rotate_get_angle_delta_w, 1, 0, 0, H_gtk_gesture_rotate_get_angle_delta, pl_du);
+ Xg_define_procedure(gtk_gesture_single_get_touch_only, gxg_gtk_gesture_single_get_touch_only_w, 1, 0, 0, H_gtk_gesture_single_get_touch_only, pl_bu);
+ Xg_define_procedure(gtk_gesture_single_set_touch_only, gxg_gtk_gesture_single_set_touch_only_w, 2, 0, 0, H_gtk_gesture_single_set_touch_only, pl_tub);
+ Xg_define_procedure(gtk_gesture_single_get_exclusive, gxg_gtk_gesture_single_get_exclusive_w, 1, 0, 0, H_gtk_gesture_single_get_exclusive, pl_bu);
+ Xg_define_procedure(gtk_gesture_single_set_exclusive, gxg_gtk_gesture_single_set_exclusive_w, 2, 0, 0, H_gtk_gesture_single_set_exclusive, pl_tub);
+ Xg_define_procedure(gtk_gesture_single_get_button, gxg_gtk_gesture_single_get_button_w, 1, 0, 0, H_gtk_gesture_single_get_button, pl_iu);
+ Xg_define_procedure(gtk_gesture_single_set_button, gxg_gtk_gesture_single_set_button_w, 2, 0, 0, H_gtk_gesture_single_set_button, pl_tui);
+ Xg_define_procedure(gtk_gesture_single_get_current_button, gxg_gtk_gesture_single_get_current_button_w, 1, 0, 0, H_gtk_gesture_single_get_current_button, pl_iu);
+ Xg_define_procedure(gtk_gesture_single_get_current_sequence, gxg_gtk_gesture_single_get_current_sequence_w, 1, 0, 0, H_gtk_gesture_single_get_current_sequence, pl_pu);
+ Xg_define_procedure(gtk_gesture_swipe_new, gxg_gtk_gesture_swipe_new_w, 1, 0, 0, H_gtk_gesture_swipe_new, pl_pu);
+ Xg_define_procedure(gtk_gesture_swipe_get_velocity, gxg_gtk_gesture_swipe_get_velocity_w, 1, 2, 0, H_gtk_gesture_swipe_get_velocity, pl_bu);
+ Xg_define_procedure(gtk_gesture_zoom_new, gxg_gtk_gesture_zoom_new_w, 1, 0, 0, H_gtk_gesture_zoom_new, pl_pu);
+ Xg_define_procedure(gtk_gesture_zoom_get_scale_delta, gxg_gtk_gesture_zoom_get_scale_delta_w, 1, 0, 0, H_gtk_gesture_zoom_get_scale_delta, pl_du);
+ Xg_define_procedure(gtk_event_controller_get_widget, gxg_gtk_event_controller_get_widget_w, 1, 0, 0, H_gtk_event_controller_get_widget, pl_pu);
+ Xg_define_procedure(gtk_event_controller_handle_event, gxg_gtk_event_controller_handle_event_w, 2, 0, 0, H_gtk_event_controller_handle_event, pl_bu);
+ Xg_define_procedure(gtk_event_controller_reset, gxg_gtk_event_controller_reset_w, 1, 0, 0, H_gtk_event_controller_reset, pl_tu);
+ Xg_define_procedure(gtk_event_controller_get_propagation_phase, gxg_gtk_event_controller_get_propagation_phase_w, 1, 0, 0, H_gtk_event_controller_get_propagation_phase, pl_tu);
+ Xg_define_procedure(gtk_event_controller_set_propagation_phase, gxg_gtk_event_controller_set_propagation_phase_w, 2, 0, 0, H_gtk_event_controller_set_propagation_phase, pl_tut);
+ Xg_define_procedure(gtk_icon_theme_add_resource_path, gxg_gtk_icon_theme_add_resource_path_w, 2, 0, 0, H_gtk_icon_theme_add_resource_path, pl_tus);
+ Xg_define_procedure(gtk_list_box_row_set_activatable, gxg_gtk_list_box_row_set_activatable_w, 2, 0, 0, H_gtk_list_box_row_set_activatable, pl_tub);
+ Xg_define_procedure(gtk_list_box_row_get_activatable, gxg_gtk_list_box_row_get_activatable_w, 1, 0, 0, H_gtk_list_box_row_get_activatable, pl_bu);
+ Xg_define_procedure(gtk_list_box_row_set_selectable, gxg_gtk_list_box_row_set_selectable_w, 2, 0, 0, H_gtk_list_box_row_set_selectable, pl_tub);
+ Xg_define_procedure(gtk_list_box_row_get_selectable, gxg_gtk_list_box_row_get_selectable_w, 1, 0, 0, H_gtk_list_box_row_get_selectable, pl_bu);
+ Xg_define_procedure(gtk_widget_path_iter_get_state, gxg_gtk_widget_path_iter_get_state_w, 2, 0, 0, H_gtk_widget_path_iter_get_state, pl_iui);
+ Xg_define_procedure(gtk_widget_path_iter_set_state, gxg_gtk_widget_path_iter_set_state_w, 3, 0, 0, H_gtk_widget_path_iter_set_state, pl_tui);
#endif
+#if GTK_CHECK_VERSION(3, 16, 0)
+ Xg_define_procedure(gdk_cairo_draw_from_gl, gxg_gdk_cairo_draw_from_gl_w, 0, 0, 1, H_gdk_cairo_draw_from_gl, pl_tuui);
+ Xg_define_procedure(gdk_window_mark_paint_from_clip, gxg_gdk_window_mark_paint_from_clip_w, 2, 0, 0, H_gdk_window_mark_paint_from_clip, pl_tu);
+ Xg_define_procedure(gtk_label_set_xalign, gxg_gtk_label_set_xalign_w, 2, 0, 0, H_gtk_label_set_xalign, pl_tur);
+ Xg_define_procedure(gtk_label_get_xalign, gxg_gtk_label_get_xalign_w, 1, 0, 0, H_gtk_label_get_xalign, pl_du);
+ Xg_define_procedure(gtk_label_set_yalign, gxg_gtk_label_set_yalign_w, 2, 0, 0, H_gtk_label_set_yalign, pl_tur);
+ Xg_define_procedure(gtk_label_get_yalign, gxg_gtk_label_get_yalign_w, 1, 0, 0, H_gtk_label_get_yalign, pl_du);
+ Xg_define_procedure(gtk_paned_set_wide_handle, gxg_gtk_paned_set_wide_handle_w, 2, 0, 0, H_gtk_paned_set_wide_handle, pl_tub);
+ Xg_define_procedure(gtk_paned_get_wide_handle, gxg_gtk_paned_get_wide_handle_w, 1, 0, 0, H_gtk_paned_get_wide_handle, pl_bu);
+ Xg_define_procedure(gtk_scrolled_window_set_overlay_scrolling, gxg_gtk_scrolled_window_set_overlay_scrolling_w, 2, 0, 0, H_gtk_scrolled_window_set_overlay_scrolling, pl_tub);
+ Xg_define_procedure(gtk_scrolled_window_get_overlay_scrolling, gxg_gtk_scrolled_window_get_overlay_scrolling_w, 1, 0, 0, H_gtk_scrolled_window_get_overlay_scrolling, pl_bu);
+ Xg_define_procedure(gtk_text_view_set_monospace, gxg_gtk_text_view_set_monospace_w, 2, 0, 0, H_gtk_text_view_set_monospace, pl_tub);
+ Xg_define_procedure(gtk_text_view_get_monospace, gxg_gtk_text_view_get_monospace_w, 1, 0, 0, H_gtk_text_view_get_monospace, pl_bu);
+ Xg_define_procedure(gtk_window_get_titlebar, gxg_gtk_window_get_titlebar_w, 1, 0, 0, H_gtk_window_get_titlebar, pl_pu);
+ Xg_define_procedure(gtk_gl_area_new, gxg_gtk_gl_area_new_w, 0, 0, 0, H_gtk_gl_area_new, pl_p);
+ Xg_define_procedure(gtk_gl_area_get_has_alpha, gxg_gtk_gl_area_get_has_alpha_w, 1, 0, 0, H_gtk_gl_area_get_has_alpha, pl_bu);
+ Xg_define_procedure(gtk_gl_area_set_has_alpha, gxg_gtk_gl_area_set_has_alpha_w, 2, 0, 0, H_gtk_gl_area_set_has_alpha, pl_tub);
+ Xg_define_procedure(gtk_gl_area_get_has_depth_buffer, gxg_gtk_gl_area_get_has_depth_buffer_w, 1, 0, 0, H_gtk_gl_area_get_has_depth_buffer, pl_bu);
+ Xg_define_procedure(gtk_gl_area_set_has_depth_buffer, gxg_gtk_gl_area_set_has_depth_buffer_w, 2, 0, 0, H_gtk_gl_area_set_has_depth_buffer, pl_tub);
+ Xg_define_procedure(gtk_gl_area_get_context, gxg_gtk_gl_area_get_context_w, 1, 0, 0, H_gtk_gl_area_get_context, pl_pu);
+ Xg_define_procedure(gtk_gl_area_make_current, gxg_gtk_gl_area_make_current_w, 1, 0, 0, H_gtk_gl_area_make_current, pl_tu);
+ Xg_define_procedure(gtk_render_check, gxg_gtk_render_check_w, 6, 0, 0, H_gtk_render_check, pl_tuur);
+ Xg_define_procedure(gtk_render_option, gxg_gtk_render_option_w, 6, 0, 0, H_gtk_render_option, pl_tuur);
+ Xg_define_procedure(gtk_render_arrow, gxg_gtk_render_arrow_w, 6, 0, 0, H_gtk_render_arrow, pl_tuur);
+ Xg_define_procedure(gtk_render_background, gxg_gtk_render_background_w, 6, 0, 0, H_gtk_render_background, pl_tuur);
+ Xg_define_procedure(gtk_render_frame, gxg_gtk_render_frame_w, 6, 0, 0, H_gtk_render_frame, pl_tuur);
+ Xg_define_procedure(gtk_render_expander, gxg_gtk_render_expander_w, 6, 0, 0, H_gtk_render_expander, pl_tuur);
+ Xg_define_procedure(gtk_render_focus, gxg_gtk_render_focus_w, 6, 0, 0, H_gtk_render_focus, pl_tuur);
+ Xg_define_procedure(gtk_render_layout, gxg_gtk_render_layout_w, 5, 0, 0, H_gtk_render_layout, pl_tuurru);
+ Xg_define_procedure(gtk_render_line, gxg_gtk_render_line_w, 6, 0, 0, H_gtk_render_line, pl_tuur);
+ Xg_define_procedure(gtk_render_slider, gxg_gtk_render_slider_w, 7, 0, 0, H_gtk_render_slider, pl_tuurrrri);
+ Xg_define_procedure(gtk_render_frame_gap, gxg_gtk_render_frame_gap_w, 0, 0, 1, H_gtk_render_frame_gap, pl_tuurrrrir);
+ Xg_define_procedure(gtk_render_extension, gxg_gtk_render_extension_w, 7, 0, 0, H_gtk_render_extension, pl_tuurrrri);
+ Xg_define_procedure(gtk_render_handle, gxg_gtk_render_handle_w, 6, 0, 0, H_gtk_render_handle, pl_tuur);
+ Xg_define_procedure(gtk_render_activity, gxg_gtk_render_activity_w, 6, 0, 0, H_gtk_render_activity, pl_tuur);
+ Xg_define_procedure(gtk_render_icon, gxg_gtk_render_icon_w, 5, 0, 0, H_gtk_render_icon, pl_tuuur);
+ Xg_define_procedure(gtk_render_icon_surface, gxg_gtk_render_icon_surface_w, 5, 0, 0, H_gtk_render_icon_surface, pl_tuuur);
+ Xg_define_procedure(gdk_gl_context_get_window, gxg_gdk_gl_context_get_window_w, 1, 0, 0, H_gdk_gl_context_get_window, pl_pu);
+ Xg_define_procedure(gdk_gl_context_make_current, gxg_gdk_gl_context_make_current_w, 1, 0, 0, H_gdk_gl_context_make_current, pl_tu);
+ Xg_define_procedure(gdk_gl_context_get_current, gxg_gdk_gl_context_get_current_w, 0, 0, 0, H_gdk_gl_context_get_current, pl_p);
+ Xg_define_procedure(gdk_gl_context_clear_current, gxg_gdk_gl_context_clear_current_w, 0, 0, 0, H_gdk_gl_context_clear_current, pl_t);
+ Xg_define_procedure(gtk_stack_set_hhomogeneous, gxg_gtk_stack_set_hhomogeneous_w, 2, 0, 0, H_gtk_stack_set_hhomogeneous, pl_tub);
+ Xg_define_procedure(gtk_stack_get_hhomogeneous, gxg_gtk_stack_get_hhomogeneous_w, 1, 0, 0, H_gtk_stack_get_hhomogeneous, pl_bu);
+ Xg_define_procedure(gtk_stack_set_vhomogeneous, gxg_gtk_stack_set_vhomogeneous_w, 2, 0, 0, H_gtk_stack_set_vhomogeneous, pl_tub);
+ Xg_define_procedure(gtk_stack_get_vhomogeneous, gxg_gtk_stack_get_vhomogeneous_w, 1, 0, 0, H_gtk_stack_get_vhomogeneous, pl_bu);
+ Xg_define_procedure(gdk_gl_context_get_display, gxg_gdk_gl_context_get_display_w, 1, 0, 0, H_gdk_gl_context_get_display, pl_pu);
+ Xg_define_procedure(gtk_gl_area_get_has_stencil_buffer, gxg_gtk_gl_area_get_has_stencil_buffer_w, 1, 0, 0, H_gtk_gl_area_get_has_stencil_buffer, pl_bu);
+ Xg_define_procedure(gtk_gl_area_set_has_stencil_buffer, gxg_gtk_gl_area_set_has_stencil_buffer_w, 2, 0, 0, H_gtk_gl_area_set_has_stencil_buffer, pl_tub);
+ Xg_define_procedure(gtk_gl_area_get_auto_render, gxg_gtk_gl_area_get_auto_render_w, 1, 0, 0, H_gtk_gl_area_get_auto_render, pl_bu);
+ Xg_define_procedure(gtk_gl_area_set_auto_render, gxg_gtk_gl_area_set_auto_render_w, 2, 0, 0, H_gtk_gl_area_set_auto_render, pl_tub);
+ Xg_define_procedure(gtk_gl_area_queue_render, gxg_gtk_gl_area_queue_render_w, 1, 0, 0, H_gtk_gl_area_queue_render, pl_tu);
+ Xg_define_procedure(gtk_gl_area_attach_buffers, gxg_gtk_gl_area_attach_buffers_w, 1, 0, 0, H_gtk_gl_area_attach_buffers, pl_tu);
+ Xg_define_procedure(gtk_gl_area_get_error, gxg_gtk_gl_area_get_error_w, 1, 0, 0, H_gtk_gl_area_get_error, pl_pu);
+ Xg_define_procedure(gtk_popover_menu_new, gxg_gtk_popover_menu_new_w, 0, 0, 0, H_gtk_popover_menu_new, pl_p);
+ Xg_define_procedure(gtk_popover_menu_open_submenu, gxg_gtk_popover_menu_open_submenu_w, 2, 0, 0, H_gtk_popover_menu_open_submenu, pl_tus);
+ Xg_define_procedure(gtk_entry_grab_focus_without_selecting, gxg_gtk_entry_grab_focus_without_selecting_w, 1, 0, 0, H_gtk_entry_grab_focus_without_selecting, pl_tu);
+ Xg_define_procedure(gtk_scrollable_get_border, gxg_gtk_scrollable_get_border_w, 2, 0, 0, H_gtk_scrollable_get_border, pl_bu);
+ Xg_define_procedure(gtk_text_buffer_insert_markup, gxg_gtk_text_buffer_insert_markup_w, 4, 0, 0, H_gtk_text_buffer_insert_markup, pl_tuusi);
+ Xg_define_procedure(gdk_device_get_vendor_id, gxg_gdk_device_get_vendor_id_w, 1, 0, 0, H_gdk_device_get_vendor_id, pl_su);
+ Xg_define_procedure(gdk_device_get_product_id, gxg_gdk_device_get_product_id_w, 1, 0, 0, H_gdk_device_get_product_id, pl_su);
+ Xg_define_procedure(gdk_gl_context_get_shared_context, gxg_gdk_gl_context_get_shared_context_w, 1, 0, 0, H_gdk_gl_context_get_shared_context, pl_pu);
+ Xg_define_procedure(gdk_gl_context_set_required_version, gxg_gdk_gl_context_set_required_version_w, 3, 0, 0, H_gdk_gl_context_set_required_version, pl_tui);
+ Xg_define_procedure(gdk_gl_context_get_required_version, gxg_gdk_gl_context_get_required_version_w, 1, 2, 0, H_gdk_gl_context_get_required_version, pl_tu);
+ Xg_define_procedure(gdk_gl_context_set_debug_enabled, gxg_gdk_gl_context_set_debug_enabled_w, 2, 0, 0, H_gdk_gl_context_set_debug_enabled, pl_tub);
+ Xg_define_procedure(gdk_gl_context_get_debug_enabled, gxg_gdk_gl_context_get_debug_enabled_w, 1, 0, 0, H_gdk_gl_context_get_debug_enabled, pl_bu);
+ Xg_define_procedure(gdk_gl_context_set_forward_compatible, gxg_gdk_gl_context_set_forward_compatible_w, 2, 0, 0, H_gdk_gl_context_set_forward_compatible, pl_tub);
+ Xg_define_procedure(gdk_gl_context_get_forward_compatible, gxg_gdk_gl_context_get_forward_compatible_w, 1, 0, 0, H_gdk_gl_context_get_forward_compatible, pl_bu);
+ Xg_define_procedure(gdk_gl_context_realize, gxg_gdk_gl_context_realize_w, 1, 1, 0, H_gdk_gl_context_realize, pl_bu);
+ Xg_define_procedure(gtk_clipboard_get_default, gxg_gtk_clipboard_get_default_w, 1, 0, 0, H_gtk_clipboard_get_default, pl_pu);
+ Xg_define_procedure(gtk_drag_cancel, gxg_gtk_drag_cancel_w, 1, 0, 0, H_gtk_drag_cancel, pl_tu);
+ Xg_define_procedure(gtk_search_entry_handle_event, gxg_gtk_search_entry_handle_event_w, 2, 0, 0, H_gtk_search_entry_handle_event, pl_bu);
+ Xg_define_procedure(gdk_gl_context_get_version, gxg_gdk_gl_context_get_version_w, 1, 2, 0, H_gdk_gl_context_get_version, pl_tu);
+ Xg_define_procedure(gtk_gl_area_set_required_version, gxg_gtk_gl_area_set_required_version_w, 3, 0, 0, H_gtk_gl_area_set_required_version, pl_tui);
+ Xg_define_procedure(gtk_gl_area_get_required_version, gxg_gtk_gl_area_get_required_version_w, 1, 2, 0, H_gtk_gl_area_get_required_version, pl_tu);
+ Xg_define_procedure(gtk_notebook_detach_tab, gxg_gtk_notebook_detach_tab_w, 2, 0, 0, H_gtk_notebook_detach_tab, pl_tu);
+ Xg_define_procedure(gtk_stack_sidebar_new, gxg_gtk_stack_sidebar_new_w, 0, 0, 0, H_gtk_stack_sidebar_new, pl_p);
+ Xg_define_procedure(gtk_stack_sidebar_set_stack, gxg_gtk_stack_sidebar_set_stack_w, 2, 0, 0, H_gtk_stack_sidebar_set_stack, pl_tu);
+ Xg_define_procedure(gtk_stack_sidebar_get_stack, gxg_gtk_stack_sidebar_get_stack_w, 1, 0, 0, H_gtk_stack_sidebar_get_stack, pl_pu);
+ Xg_define_procedure(gtk_popover_set_transitions_enabled, gxg_gtk_popover_set_transitions_enabled_w, 2, 0, 0, H_gtk_popover_set_transitions_enabled, pl_tub);
+ Xg_define_procedure(gtk_popover_get_transitions_enabled, gxg_gtk_popover_get_transitions_enabled_w, 1, 0, 0, H_gtk_popover_get_transitions_enabled, pl_bu);
+#endif
+#if GTK_CHECK_VERSION(3, 18, 0)
+ Xg_define_procedure(gdk_keymap_get_scroll_lock_state, gxg_gdk_keymap_get_scroll_lock_state_w, 1, 0, 0, H_gdk_keymap_get_scroll_lock_state, pl_bu);
+ Xg_define_procedure(gtk_radio_menu_item_join_group, gxg_gtk_radio_menu_item_join_group_w, 2, 0, 0, H_gtk_radio_menu_item_join_group, pl_tu);
+ Xg_define_procedure(gtk_font_chooser_set_font_map, gxg_gtk_font_chooser_set_font_map_w, 2, 0, 0, H_gtk_font_chooser_set_font_map, pl_tu);
+ Xg_define_procedure(gtk_font_chooser_get_font_map, gxg_gtk_font_chooser_get_font_map_w, 1, 0, 0, H_gtk_font_chooser_get_font_map, pl_pu);
+ Xg_define_procedure(gtk_popover_set_default_widget, gxg_gtk_popover_set_default_widget_w, 2, 0, 0, H_gtk_popover_set_default_widget, pl_tu);
+ Xg_define_procedure(gtk_popover_get_default_widget, gxg_gtk_popover_get_default_widget_w, 1, 0, 0, H_gtk_popover_get_default_widget, pl_pu);
+ Xg_define_procedure(gdk_window_set_pass_through, gxg_gdk_window_set_pass_through_w, 2, 0, 0, H_gdk_window_set_pass_through, pl_tub);
+ Xg_define_procedure(gdk_window_get_pass_through, gxg_gdk_window_get_pass_through_w, 1, 0, 0, H_gdk_window_get_pass_through, pl_bu);
+ Xg_define_procedure(gtk_overlay_reorder_overlay, gxg_gtk_overlay_reorder_overlay_w, 3, 0, 0, H_gtk_overlay_reorder_overlay, pl_tuui);
+ Xg_define_procedure(gtk_overlay_get_overlay_pass_through, gxg_gtk_overlay_get_overlay_pass_through_w, 2, 0, 0, H_gtk_overlay_get_overlay_pass_through, pl_bu);
+ Xg_define_procedure(gtk_overlay_set_overlay_pass_through, gxg_gtk_overlay_set_overlay_pass_through_w, 3, 0, 0, H_gtk_overlay_set_overlay_pass_through, pl_tuub);
+ Xg_define_procedure(gtk_places_sidebar_get_show_recent, gxg_gtk_places_sidebar_get_show_recent_w, 1, 0, 0, H_gtk_places_sidebar_get_show_recent, pl_bu);
+ Xg_define_procedure(gtk_places_sidebar_set_show_recent, gxg_gtk_places_sidebar_set_show_recent_w, 2, 0, 0, H_gtk_places_sidebar_set_show_recent, pl_tub);
+ Xg_define_procedure(gtk_places_sidebar_set_drop_targets_visible, gxg_gtk_places_sidebar_set_drop_targets_visible_w, 3, 0, 0, H_gtk_places_sidebar_set_drop_targets_visible, pl_tubu);
+ Xg_define_procedure(gtk_places_sidebar_get_show_trash, gxg_gtk_places_sidebar_get_show_trash_w, 1, 0, 0, H_gtk_places_sidebar_get_show_trash, pl_bu);
+ Xg_define_procedure(gtk_places_sidebar_set_show_trash, gxg_gtk_places_sidebar_set_show_trash_w, 2, 0, 0, H_gtk_places_sidebar_set_show_trash, pl_tub);
+ Xg_define_procedure(gtk_places_sidebar_set_show_other_locations, gxg_gtk_places_sidebar_set_show_other_locations_w, 2, 0, 0, H_gtk_places_sidebar_set_show_other_locations, pl_tub);
+ Xg_define_procedure(gtk_places_sidebar_get_show_other_locations, gxg_gtk_places_sidebar_get_show_other_locations_w, 1, 0, 0, H_gtk_places_sidebar_get_show_other_locations, pl_bu);
+ Xg_define_procedure(gtk_stack_set_interpolate_size, gxg_gtk_stack_set_interpolate_size_w, 2, 0, 0, H_gtk_stack_set_interpolate_size, pl_tub);
+ Xg_define_procedure(gtk_stack_get_interpolate_size, gxg_gtk_stack_get_interpolate_size_w, 1, 0, 0, H_gtk_stack_get_interpolate_size, pl_bu);
+ Xg_define_procedure(gtk_widget_set_font_options, gxg_gtk_widget_set_font_options_w, 2, 0, 0, H_gtk_widget_set_font_options, pl_tu);
+ Xg_define_procedure(gtk_widget_get_font_options, gxg_gtk_widget_get_font_options_w, 1, 0, 0, H_gtk_widget_get_font_options, pl_pu);
+ Xg_define_procedure(gtk_widget_set_font_map, gxg_gtk_widget_set_font_map_w, 2, 0, 0, H_gtk_widget_set_font_map, pl_tu);
+ Xg_define_procedure(gtk_widget_get_font_map, gxg_gtk_widget_get_font_map_w, 1, 0, 0, H_gtk_widget_get_font_map, pl_pu);
+ Xg_define_procedure(gdk_window_fullscreen_on_monitor, gxg_gdk_window_fullscreen_on_monitor_w, 2, 0, 0, H_gdk_window_fullscreen_on_monitor, pl_tui);
+ Xg_define_procedure(gtk_window_fullscreen_on_monitor, gxg_gtk_window_fullscreen_on_monitor_w, 3, 0, 0, H_gtk_window_fullscreen_on_monitor, pl_tuui);
+ Xg_define_procedure(gtk_text_view_set_top_margin, gxg_gtk_text_view_set_top_margin_w, 2, 0, 0, H_gtk_text_view_set_top_margin, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_top_margin, gxg_gtk_text_view_get_top_margin_w, 1, 0, 0, H_gtk_text_view_get_top_margin, pl_iu);
+ Xg_define_procedure(gtk_text_view_set_bottom_margin, gxg_gtk_text_view_set_bottom_margin_w, 2, 0, 0, H_gtk_text_view_set_bottom_margin, pl_tui);
+ Xg_define_procedure(gtk_text_view_get_bottom_margin, gxg_gtk_text_view_get_bottom_margin_w, 1, 0, 0, H_gtk_text_view_get_bottom_margin, pl_iu);
#endif
- #define XG_DEFINE_PROCEDURE(Name, Value, A1, A2, A3, Help) XEN_DEFINE_PROCEDURE(XG_PRE #Name XG_POST, Value, A1, A2, A3, Help)
-static void define_functions(void)
-{
- xm_gc_table = XEN_MAKE_VECTOR(1, XEN_FALSE);
- XEN_PROTECT_FROM_GC(xm_gc_table);
- xm_protected_size = 512;
- xm_protected = XEN_MAKE_VECTOR(xm_protected_size, XEN_FALSE);
- XEN_VECTOR_SET(xm_gc_table, 0, xm_protected);
- XG_DEFINE_PROCEDURE(g_type_name, gxg_g_type_name_w, 1, 0, 0, H_g_type_name);
- XG_DEFINE_PROCEDURE(g_type_qname, gxg_g_type_qname_w, 1, 0, 0, H_g_type_qname);
- XG_DEFINE_PROCEDURE(g_type_from_name, gxg_g_type_from_name_w, 1, 0, 0, H_g_type_from_name);
- XG_DEFINE_PROCEDURE(g_type_parent, gxg_g_type_parent_w, 1, 0, 0, H_g_type_parent);
- XG_DEFINE_PROCEDURE(g_type_is_a, gxg_g_type_is_a_w, 2, 0, 0, H_g_type_is_a);
- XG_DEFINE_PROCEDURE(g_cclosure_new, gxg_g_cclosure_new_w, 3, 0, 0, H_g_cclosure_new);
- XG_DEFINE_PROCEDURE(g_signal_newv, gxg_g_signal_newv_w, 0, 0, 1, H_g_signal_newv);
- XG_DEFINE_PROCEDURE(g_signal_lookup, gxg_g_signal_lookup_w, 2, 0, 0, H_g_signal_lookup);
- XG_DEFINE_PROCEDURE(g_signal_name, gxg_g_signal_name_w, 1, 0, 0, H_g_signal_name);
- XG_DEFINE_PROCEDURE(g_signal_query, gxg_g_signal_query_w, 2, 0, 0, H_g_signal_query);
- XG_DEFINE_PROCEDURE(g_signal_list_ids, gxg_g_signal_list_ids_w, 2, 0, 0, H_g_signal_list_ids);
- XG_DEFINE_PROCEDURE(g_signal_parse_name, gxg_g_signal_parse_name_w, 3, 2, 0, H_g_signal_parse_name);
- XG_DEFINE_PROCEDURE(g_signal_get_invocation_hint, gxg_g_signal_get_invocation_hint_w, 1, 0, 0, H_g_signal_get_invocation_hint);
- XG_DEFINE_PROCEDURE(g_signal_stop_emission, gxg_g_signal_stop_emission_w, 3, 0, 0, H_g_signal_stop_emission);
- XG_DEFINE_PROCEDURE(g_signal_stop_emission_by_name, gxg_g_signal_stop_emission_by_name_w, 2, 0, 0, H_g_signal_stop_emission_by_name);
- XG_DEFINE_PROCEDURE(g_signal_add_emission_hook, gxg_g_signal_add_emission_hook_w, 5, 0, 0, H_g_signal_add_emission_hook);
- XG_DEFINE_PROCEDURE(g_signal_remove_emission_hook, gxg_g_signal_remove_emission_hook_w, 2, 0, 0, H_g_signal_remove_emission_hook);
- XG_DEFINE_PROCEDURE(g_signal_has_handler_pending, gxg_g_signal_has_handler_pending_w, 4, 0, 0, H_g_signal_has_handler_pending);
- XG_DEFINE_PROCEDURE(g_signal_connect_closure_by_id, gxg_g_signal_connect_closure_by_id_w, 5, 0, 0, H_g_signal_connect_closure_by_id);
- XG_DEFINE_PROCEDURE(g_signal_connect_closure, gxg_g_signal_connect_closure_w, 4, 0, 0, H_g_signal_connect_closure);
- XG_DEFINE_PROCEDURE(g_signal_connect_data, gxg_g_signal_connect_data_w, 6, 0, 0, H_g_signal_connect_data);
- XG_DEFINE_PROCEDURE(g_signal_handler_block, gxg_g_signal_handler_block_w, 2, 0, 0, H_g_signal_handler_block);
- XG_DEFINE_PROCEDURE(g_signal_handler_unblock, gxg_g_signal_handler_unblock_w, 2, 0, 0, H_g_signal_handler_unblock);
- XG_DEFINE_PROCEDURE(g_signal_handler_disconnect, gxg_g_signal_handler_disconnect_w, 2, 0, 0, H_g_signal_handler_disconnect);
- XG_DEFINE_PROCEDURE(g_signal_handler_is_connected, gxg_g_signal_handler_is_connected_w, 2, 0, 0, H_g_signal_handler_is_connected);
- XG_DEFINE_PROCEDURE(g_signal_handler_find, gxg_g_signal_handler_find_w, 7, 0, 0, H_g_signal_handler_find);
- XG_DEFINE_PROCEDURE(g_signal_handlers_block_matched, gxg_g_signal_handlers_block_matched_w, 7, 0, 0, H_g_signal_handlers_block_matched);
- XG_DEFINE_PROCEDURE(g_signal_handlers_unblock_matched, gxg_g_signal_handlers_unblock_matched_w, 7, 0, 0, H_g_signal_handlers_unblock_matched);
- XG_DEFINE_PROCEDURE(g_signal_handlers_disconnect_matched, gxg_g_signal_handlers_disconnect_matched_w, 7, 0, 0, H_g_signal_handlers_disconnect_matched);
- XG_DEFINE_PROCEDURE(g_signal_handlers_destroy, gxg_g_signal_handlers_destroy_w, 1, 0, 0, H_g_signal_handlers_destroy);
- XG_DEFINE_PROCEDURE(g_object_ref, gxg_g_object_ref_w, 1, 0, 0, H_g_object_ref);
- XG_DEFINE_PROCEDURE(g_object_unref, gxg_g_object_unref_w, 1, 0, 0, H_g_object_unref);
- XG_DEFINE_PROCEDURE(gdk_visual_get_system, gxg_gdk_visual_get_system_w, 0, 0, 0, H_gdk_visual_get_system);
- XG_DEFINE_PROCEDURE(gdk_color_copy, gxg_gdk_color_copy_w, 1, 0, 0, H_gdk_color_copy);
- XG_DEFINE_PROCEDURE(gdk_color_free, gxg_gdk_color_free_w, 1, 0, 0, H_gdk_color_free);
- XG_DEFINE_PROCEDURE(gdk_color_parse, gxg_gdk_color_parse_w, 2, 0, 0, H_gdk_color_parse);
- XG_DEFINE_PROCEDURE(gdk_color_hash, gxg_gdk_color_hash_w, 1, 0, 0, H_gdk_color_hash);
- XG_DEFINE_PROCEDURE(gdk_color_equal, gxg_gdk_color_equal_w, 2, 0, 0, H_gdk_color_equal);
- XG_DEFINE_PROCEDURE(gdk_cursor_new, gxg_gdk_cursor_new_w, 1, 0, 0, H_gdk_cursor_new);
- XG_DEFINE_PROCEDURE(gdk_drag_status, gxg_gdk_drag_status_w, 3, 0, 0, H_gdk_drag_status);
- XG_DEFINE_PROCEDURE(gdk_drop_reply, gxg_gdk_drop_reply_w, 3, 0, 0, H_gdk_drop_reply);
- XG_DEFINE_PROCEDURE(gdk_drop_finish, gxg_gdk_drop_finish_w, 3, 0, 0, H_gdk_drop_finish);
- XG_DEFINE_PROCEDURE(gdk_drag_get_selection, gxg_gdk_drag_get_selection_w, 1, 0, 0, H_gdk_drag_get_selection);
- XG_DEFINE_PROCEDURE(gdk_drag_begin, gxg_gdk_drag_begin_w, 2, 0, 0, H_gdk_drag_begin);
- XG_DEFINE_PROCEDURE(gdk_drag_drop, gxg_gdk_drag_drop_w, 2, 0, 0, H_gdk_drag_drop);
- XG_DEFINE_PROCEDURE(gdk_drag_abort, gxg_gdk_drag_abort_w, 2, 0, 0, H_gdk_drag_abort);
- XG_DEFINE_PROCEDURE(gdk_events_pending, gxg_gdk_events_pending_w, 0, 0, 0, H_gdk_events_pending);
- XG_DEFINE_PROCEDURE(gdk_event_get, gxg_gdk_event_get_w, 0, 0, 0, H_gdk_event_get);
- XG_DEFINE_PROCEDURE(gdk_event_peek, gxg_gdk_event_peek_w, 0, 0, 0, H_gdk_event_peek);
- XG_DEFINE_PROCEDURE(gdk_event_put, gxg_gdk_event_put_w, 1, 0, 0, H_gdk_event_put);
- XG_DEFINE_PROCEDURE(gdk_event_copy, gxg_gdk_event_copy_w, 1, 0, 0, H_gdk_event_copy);
- XG_DEFINE_PROCEDURE(gdk_event_free, gxg_gdk_event_free_w, 1, 0, 0, H_gdk_event_free);
- XG_DEFINE_PROCEDURE(gdk_event_get_time, gxg_gdk_event_get_time_w, 1, 0, 0, H_gdk_event_get_time);
- XG_DEFINE_PROCEDURE(gdk_event_get_state, gxg_gdk_event_get_state_w, 1, 1, 0, H_gdk_event_get_state);
- XG_DEFINE_PROCEDURE(gdk_event_get_coords, gxg_gdk_event_get_coords_w, 1, 2, 0, H_gdk_event_get_coords);
- XG_DEFINE_PROCEDURE(gdk_event_get_root_coords, gxg_gdk_event_get_root_coords_w, 1, 2, 0, H_gdk_event_get_root_coords);
- XG_DEFINE_PROCEDURE(gdk_event_handler_set, gxg_gdk_event_handler_set_w, 3, 0, 0, H_gdk_event_handler_set);
- XG_DEFINE_PROCEDURE(gdk_set_show_events, gxg_gdk_set_show_events_w, 1, 0, 0, H_gdk_set_show_events);
- XG_DEFINE_PROCEDURE(gdk_get_show_events, gxg_gdk_get_show_events_w, 0, 0, 0, H_gdk_get_show_events);
- XG_DEFINE_PROCEDURE(gdk_init, gxg_gdk_init_w, 0, 2, 0, H_gdk_init);
- XG_DEFINE_PROCEDURE(gdk_init_check, gxg_gdk_init_check_w, 0, 2, 0, H_gdk_init_check);
- XG_DEFINE_PROCEDURE(gdk_get_program_class, gxg_gdk_get_program_class_w, 0, 0, 0, H_gdk_get_program_class);
- XG_DEFINE_PROCEDURE(gdk_set_program_class, gxg_gdk_set_program_class_w, 1, 0, 0, H_gdk_set_program_class);
- XG_DEFINE_PROCEDURE(gdk_error_trap_push, gxg_gdk_error_trap_push_w, 0, 0, 0, H_gdk_error_trap_push);
- XG_DEFINE_PROCEDURE(gdk_error_trap_pop, gxg_gdk_error_trap_pop_w, 0, 0, 0, H_gdk_error_trap_pop);
- XG_DEFINE_PROCEDURE(gdk_get_display, gxg_gdk_get_display_w, 0, 0, 0, H_gdk_get_display);
- XG_DEFINE_PROCEDURE(gdk_get_display_arg_name, gxg_gdk_get_display_arg_name_w, 0, 0, 0, H_gdk_get_display_arg_name);
- XG_DEFINE_PROCEDURE(gdk_notify_startup_complete, gxg_gdk_notify_startup_complete_w, 0, 0, 0, H_gdk_notify_startup_complete);
- XG_DEFINE_PROCEDURE(gdk_screen_width, gxg_gdk_screen_width_w, 0, 0, 0, H_gdk_screen_width);
- XG_DEFINE_PROCEDURE(gdk_screen_height, gxg_gdk_screen_height_w, 0, 0, 0, H_gdk_screen_height);
- XG_DEFINE_PROCEDURE(gdk_screen_width_mm, gxg_gdk_screen_width_mm_w, 0, 0, 0, H_gdk_screen_width_mm);
- XG_DEFINE_PROCEDURE(gdk_screen_height_mm, gxg_gdk_screen_height_mm_w, 0, 0, 0, H_gdk_screen_height_mm);
- XG_DEFINE_PROCEDURE(gdk_flush, gxg_gdk_flush_w, 0, 0, 0, H_gdk_flush);
- XG_DEFINE_PROCEDURE(gdk_beep, gxg_gdk_beep_w, 0, 0, 0, H_gdk_beep);
- XG_DEFINE_PROCEDURE(gdk_set_double_click_time, gxg_gdk_set_double_click_time_w, 1, 0, 0, H_gdk_set_double_click_time);
- XG_DEFINE_PROCEDURE(gdk_rectangle_intersect, gxg_gdk_rectangle_intersect_w, 3, 0, 0, H_gdk_rectangle_intersect);
- XG_DEFINE_PROCEDURE(gdk_rectangle_union, gxg_gdk_rectangle_union_w, 3, 0, 0, H_gdk_rectangle_union);
- XG_DEFINE_PROCEDURE(gdk_threads_enter, gxg_gdk_threads_enter_w, 0, 0, 0, H_gdk_threads_enter);
- XG_DEFINE_PROCEDURE(gdk_threads_leave, gxg_gdk_threads_leave_w, 0, 0, 0, H_gdk_threads_leave);
- XG_DEFINE_PROCEDURE(gdk_threads_init, gxg_gdk_threads_init_w, 0, 0, 0, H_gdk_threads_init);
- XG_DEFINE_PROCEDURE(gdk_keymap_get_default, gxg_gdk_keymap_get_default_w, 0, 0, 0, H_gdk_keymap_get_default);
- XG_DEFINE_PROCEDURE(gdk_keymap_lookup_key, gxg_gdk_keymap_lookup_key_w, 2, 0, 0, H_gdk_keymap_lookup_key);
- XG_DEFINE_PROCEDURE(gdk_keymap_get_entries_for_keyval, gxg_gdk_keymap_get_entries_for_keyval_w, 2, 2, 0, H_gdk_keymap_get_entries_for_keyval);
- XG_DEFINE_PROCEDURE(gdk_keymap_get_entries_for_keycode, gxg_gdk_keymap_get_entries_for_keycode_w, 2, 3, 0, H_gdk_keymap_get_entries_for_keycode);
- XG_DEFINE_PROCEDURE(gdk_keymap_get_direction, gxg_gdk_keymap_get_direction_w, 1, 0, 0, H_gdk_keymap_get_direction);
- XG_DEFINE_PROCEDURE(gdk_keyval_name, gxg_gdk_keyval_name_w, 1, 0, 0, H_gdk_keyval_name);
- XG_DEFINE_PROCEDURE(gdk_keyval_from_name, gxg_gdk_keyval_from_name_w, 1, 0, 0, H_gdk_keyval_from_name);
- XG_DEFINE_PROCEDURE(gdk_keyval_convert_case, gxg_gdk_keyval_convert_case_w, 1, 2, 0, H_gdk_keyval_convert_case);
- XG_DEFINE_PROCEDURE(gdk_keyval_to_upper, gxg_gdk_keyval_to_upper_w, 1, 0, 0, H_gdk_keyval_to_upper);
- XG_DEFINE_PROCEDURE(gdk_keyval_to_lower, gxg_gdk_keyval_to_lower_w, 1, 0, 0, H_gdk_keyval_to_lower);
- XG_DEFINE_PROCEDURE(gdk_keyval_is_upper, gxg_gdk_keyval_is_upper_w, 1, 0, 0, H_gdk_keyval_is_upper);
- XG_DEFINE_PROCEDURE(gdk_keyval_is_lower, gxg_gdk_keyval_is_lower_w, 1, 0, 0, H_gdk_keyval_is_lower);
- XG_DEFINE_PROCEDURE(gdk_keyval_to_unicode, gxg_gdk_keyval_to_unicode_w, 1, 0, 0, H_gdk_keyval_to_unicode);
- XG_DEFINE_PROCEDURE(gdk_unicode_to_keyval, gxg_gdk_unicode_to_keyval_w, 1, 0, 0, H_gdk_unicode_to_keyval);
- XG_DEFINE_PROCEDURE(gdk_pango_context_get, gxg_gdk_pango_context_get_w, 0, 0, 0, H_gdk_pango_context_get);
- XG_DEFINE_PROCEDURE(gdk_atom_intern, gxg_gdk_atom_intern_w, 2, 0, 0, H_gdk_atom_intern);
- XG_DEFINE_PROCEDURE(gdk_atom_name, gxg_gdk_atom_name_w, 1, 0, 0, H_gdk_atom_name);
- XG_DEFINE_PROCEDURE(gdk_property_get, gxg_gdk_property_get_w, 0, 0, 1, H_gdk_property_get);
- XG_DEFINE_PROCEDURE(gdk_property_change, gxg_gdk_property_change_w, 7, 0, 0, H_gdk_property_change);
- XG_DEFINE_PROCEDURE(gdk_property_delete, gxg_gdk_property_delete_w, 2, 0, 0, H_gdk_property_delete);
- XG_DEFINE_PROCEDURE(gdk_utf8_to_string_target, gxg_gdk_utf8_to_string_target_w, 1, 0, 0, H_gdk_utf8_to_string_target);
- XG_DEFINE_PROCEDURE(gdk_selection_owner_set, gxg_gdk_selection_owner_set_w, 4, 0, 0, H_gdk_selection_owner_set);
- XG_DEFINE_PROCEDURE(gdk_selection_owner_get, gxg_gdk_selection_owner_get_w, 1, 0, 0, H_gdk_selection_owner_get);
- XG_DEFINE_PROCEDURE(gdk_selection_convert, gxg_gdk_selection_convert_w, 4, 0, 0, H_gdk_selection_convert);
- XG_DEFINE_PROCEDURE(gdk_selection_property_get, gxg_gdk_selection_property_get_w, 1, 3, 0, H_gdk_selection_property_get);
- XG_DEFINE_PROCEDURE(gdk_visual_get_best_depth, gxg_gdk_visual_get_best_depth_w, 0, 0, 0, H_gdk_visual_get_best_depth);
- XG_DEFINE_PROCEDURE(gdk_visual_get_best_type, gxg_gdk_visual_get_best_type_w, 0, 0, 0, H_gdk_visual_get_best_type);
- XG_DEFINE_PROCEDURE(gdk_visual_get_best, gxg_gdk_visual_get_best_w, 0, 0, 0, H_gdk_visual_get_best);
- XG_DEFINE_PROCEDURE(gdk_visual_get_best_with_depth, gxg_gdk_visual_get_best_with_depth_w, 1, 0, 0, H_gdk_visual_get_best_with_depth);
- XG_DEFINE_PROCEDURE(gdk_visual_get_best_with_type, gxg_gdk_visual_get_best_with_type_w, 1, 0, 0, H_gdk_visual_get_best_with_type);
- XG_DEFINE_PROCEDURE(gdk_visual_get_best_with_both, gxg_gdk_visual_get_best_with_both_w, 2, 0, 0, H_gdk_visual_get_best_with_both);
- XG_DEFINE_PROCEDURE(gdk_query_depths, gxg_gdk_query_depths_w, 0, 2, 0, H_gdk_query_depths);
- XG_DEFINE_PROCEDURE(gdk_query_visual_types, gxg_gdk_query_visual_types_w, 0, 2, 0, H_gdk_query_visual_types);
- XG_DEFINE_PROCEDURE(gdk_list_visuals, gxg_gdk_list_visuals_w, 0, 0, 0, H_gdk_list_visuals);
- XG_DEFINE_PROCEDURE(gdk_window_new, gxg_gdk_window_new_w, 3, 0, 0, H_gdk_window_new);
- XG_DEFINE_PROCEDURE(gdk_window_destroy, gxg_gdk_window_destroy_w, 1, 0, 0, H_gdk_window_destroy);
- XG_DEFINE_PROCEDURE(gdk_window_get_window_type, gxg_gdk_window_get_window_type_w, 1, 0, 0, H_gdk_window_get_window_type);
- XG_DEFINE_PROCEDURE(gdk_window_at_pointer, gxg_gdk_window_at_pointer_w, 0, 2, 0, H_gdk_window_at_pointer);
- XG_DEFINE_PROCEDURE(gdk_window_show, gxg_gdk_window_show_w, 1, 0, 0, H_gdk_window_show);
- XG_DEFINE_PROCEDURE(gdk_window_hide, gxg_gdk_window_hide_w, 1, 0, 0, H_gdk_window_hide);
- XG_DEFINE_PROCEDURE(gdk_window_withdraw, gxg_gdk_window_withdraw_w, 1, 0, 0, H_gdk_window_withdraw);
- XG_DEFINE_PROCEDURE(gdk_window_show_unraised, gxg_gdk_window_show_unraised_w, 1, 0, 0, H_gdk_window_show_unraised);
- XG_DEFINE_PROCEDURE(gdk_window_move, gxg_gdk_window_move_w, 3, 0, 0, H_gdk_window_move);
- XG_DEFINE_PROCEDURE(gdk_window_resize, gxg_gdk_window_resize_w, 3, 0, 0, H_gdk_window_resize);
- XG_DEFINE_PROCEDURE(gdk_window_move_resize, gxg_gdk_window_move_resize_w, 5, 0, 0, H_gdk_window_move_resize);
- XG_DEFINE_PROCEDURE(gdk_window_reparent, gxg_gdk_window_reparent_w, 4, 0, 0, H_gdk_window_reparent);
- XG_DEFINE_PROCEDURE(gdk_window_raise, gxg_gdk_window_raise_w, 1, 0, 0, H_gdk_window_raise);
- XG_DEFINE_PROCEDURE(gdk_window_lower, gxg_gdk_window_lower_w, 1, 0, 0, H_gdk_window_lower);
- XG_DEFINE_PROCEDURE(gdk_window_focus, gxg_gdk_window_focus_w, 2, 0, 0, H_gdk_window_focus);
- XG_DEFINE_PROCEDURE(gdk_window_set_user_data, gxg_gdk_window_set_user_data_w, 2, 0, 0, H_gdk_window_set_user_data);
- XG_DEFINE_PROCEDURE(gdk_window_set_override_redirect, gxg_gdk_window_set_override_redirect_w, 2, 0, 0, H_gdk_window_set_override_redirect);
- XG_DEFINE_PROCEDURE(gdk_window_add_filter, gxg_gdk_window_add_filter_w, 2, 1, 0, H_gdk_window_add_filter);
- XG_DEFINE_PROCEDURE(gdk_window_remove_filter, gxg_gdk_window_remove_filter_w, 2, 1, 0, H_gdk_window_remove_filter);
- XG_DEFINE_PROCEDURE(gdk_window_scroll, gxg_gdk_window_scroll_w, 3, 0, 0, H_gdk_window_scroll);
- XG_DEFINE_PROCEDURE(gdk_window_set_child_shapes, gxg_gdk_window_set_child_shapes_w, 1, 0, 0, H_gdk_window_set_child_shapes);
- XG_DEFINE_PROCEDURE(gdk_window_merge_child_shapes, gxg_gdk_window_merge_child_shapes_w, 1, 0, 0, H_gdk_window_merge_child_shapes);
- XG_DEFINE_PROCEDURE(gdk_window_is_visible, gxg_gdk_window_is_visible_w, 1, 0, 0, H_gdk_window_is_visible);
- XG_DEFINE_PROCEDURE(gdk_window_is_viewable, gxg_gdk_window_is_viewable_w, 1, 0, 0, H_gdk_window_is_viewable);
- XG_DEFINE_PROCEDURE(gdk_window_get_state, gxg_gdk_window_get_state_w, 1, 0, 0, H_gdk_window_get_state);
- XG_DEFINE_PROCEDURE(gdk_window_set_static_gravities, gxg_gdk_window_set_static_gravities_w, 2, 0, 0, H_gdk_window_set_static_gravities);
- XG_DEFINE_PROCEDURE(gdk_window_get_root_origin, gxg_gdk_window_get_root_origin_w, 1, 2, 0, H_gdk_window_get_root_origin);
- XG_DEFINE_PROCEDURE(gdk_window_get_frame_extents, gxg_gdk_window_get_frame_extents_w, 2, 0, 0, H_gdk_window_get_frame_extents);
- XG_DEFINE_PROCEDURE(gdk_window_get_pointer, gxg_gdk_window_get_pointer_w, 1, 3, 0, H_gdk_window_get_pointer);
- XG_DEFINE_PROCEDURE(gdk_window_get_parent, gxg_gdk_window_get_parent_w, 1, 0, 0, H_gdk_window_get_parent);
- XG_DEFINE_PROCEDURE(gdk_window_get_toplevel, gxg_gdk_window_get_toplevel_w, 1, 0, 0, H_gdk_window_get_toplevel);
- XG_DEFINE_PROCEDURE(gdk_window_get_children, gxg_gdk_window_get_children_w, 1, 0, 0, H_gdk_window_get_children);
- XG_DEFINE_PROCEDURE(gdk_window_peek_children, gxg_gdk_window_peek_children_w, 1, 0, 0, H_gdk_window_peek_children);
- XG_DEFINE_PROCEDURE(gdk_window_get_events, gxg_gdk_window_get_events_w, 1, 0, 0, H_gdk_window_get_events);
- XG_DEFINE_PROCEDURE(gdk_window_set_events, gxg_gdk_window_set_events_w, 2, 0, 0, H_gdk_window_set_events);
- XG_DEFINE_PROCEDURE(gdk_window_set_icon_list, gxg_gdk_window_set_icon_list_w, 2, 0, 0, H_gdk_window_set_icon_list);
- XG_DEFINE_PROCEDURE(gdk_window_set_icon_name, gxg_gdk_window_set_icon_name_w, 2, 0, 0, H_gdk_window_set_icon_name);
- XG_DEFINE_PROCEDURE(gdk_window_set_group, gxg_gdk_window_set_group_w, 2, 0, 0, H_gdk_window_set_group);
- XG_DEFINE_PROCEDURE(gdk_window_set_decorations, gxg_gdk_window_set_decorations_w, 2, 0, 0, H_gdk_window_set_decorations);
- XG_DEFINE_PROCEDURE(gdk_window_get_decorations, gxg_gdk_window_get_decorations_w, 1, 1, 0, H_gdk_window_get_decorations);
- XG_DEFINE_PROCEDURE(gdk_window_set_functions, gxg_gdk_window_set_functions_w, 2, 0, 0, H_gdk_window_set_functions);
- XG_DEFINE_PROCEDURE(gdk_window_iconify, gxg_gdk_window_iconify_w, 1, 0, 0, H_gdk_window_iconify);
- XG_DEFINE_PROCEDURE(gdk_window_deiconify, gxg_gdk_window_deiconify_w, 1, 0, 0, H_gdk_window_deiconify);
- XG_DEFINE_PROCEDURE(gdk_window_stick, gxg_gdk_window_stick_w, 1, 0, 0, H_gdk_window_stick);
- XG_DEFINE_PROCEDURE(gdk_window_unstick, gxg_gdk_window_unstick_w, 1, 0, 0, H_gdk_window_unstick);
- XG_DEFINE_PROCEDURE(gdk_window_maximize, gxg_gdk_window_maximize_w, 1, 0, 0, H_gdk_window_maximize);
- XG_DEFINE_PROCEDURE(gdk_window_unmaximize, gxg_gdk_window_unmaximize_w, 1, 0, 0, H_gdk_window_unmaximize);
- XG_DEFINE_PROCEDURE(gdk_window_register_dnd, gxg_gdk_window_register_dnd_w, 1, 0, 0, H_gdk_window_register_dnd);
- XG_DEFINE_PROCEDURE(gdk_window_begin_resize_drag, gxg_gdk_window_begin_resize_drag_w, 6, 0, 0, H_gdk_window_begin_resize_drag);
- XG_DEFINE_PROCEDURE(gdk_window_begin_move_drag, gxg_gdk_window_begin_move_drag_w, 5, 0, 0, H_gdk_window_begin_move_drag);
- XG_DEFINE_PROCEDURE(gdk_window_invalidate_rect, gxg_gdk_window_invalidate_rect_w, 3, 0, 0, H_gdk_window_invalidate_rect);
- XG_DEFINE_PROCEDURE(gdk_window_freeze_updates, gxg_gdk_window_freeze_updates_w, 1, 0, 0, H_gdk_window_freeze_updates);
- XG_DEFINE_PROCEDURE(gdk_window_thaw_updates, gxg_gdk_window_thaw_updates_w, 1, 0, 0, H_gdk_window_thaw_updates);
- XG_DEFINE_PROCEDURE(gdk_window_process_all_updates, gxg_gdk_window_process_all_updates_w, 0, 0, 0, H_gdk_window_process_all_updates);
- XG_DEFINE_PROCEDURE(gdk_window_process_updates, gxg_gdk_window_process_updates_w, 2, 0, 0, H_gdk_window_process_updates);
- XG_DEFINE_PROCEDURE(gdk_window_set_debug_updates, gxg_gdk_window_set_debug_updates_w, 1, 0, 0, H_gdk_window_set_debug_updates);
- XG_DEFINE_PROCEDURE(gdk_window_constrain_size, gxg_gdk_window_constrain_size_w, 4, 2, 0, H_gdk_window_constrain_size);
- XG_DEFINE_PROCEDURE(gdk_window_set_type_hint, gxg_gdk_window_set_type_hint_w, 2, 0, 0, H_gdk_window_set_type_hint);
- XG_DEFINE_PROCEDURE(gdk_window_set_modal_hint, gxg_gdk_window_set_modal_hint_w, 2, 0, 0, H_gdk_window_set_modal_hint);
- XG_DEFINE_PROCEDURE(gdk_window_set_geometry_hints, gxg_gdk_window_set_geometry_hints_w, 3, 0, 0, H_gdk_window_set_geometry_hints);
- XG_DEFINE_PROCEDURE(gdk_window_begin_paint_rect, gxg_gdk_window_begin_paint_rect_w, 2, 0, 0, H_gdk_window_begin_paint_rect);
- XG_DEFINE_PROCEDURE(gdk_window_end_paint, gxg_gdk_window_end_paint_w, 1, 0, 0, H_gdk_window_end_paint);
- XG_DEFINE_PROCEDURE(gdk_window_set_title, gxg_gdk_window_set_title_w, 2, 0, 0, H_gdk_window_set_title);
- XG_DEFINE_PROCEDURE(gdk_window_set_role, gxg_gdk_window_set_role_w, 2, 0, 0, H_gdk_window_set_role);
- XG_DEFINE_PROCEDURE(gdk_window_set_transient_for, gxg_gdk_window_set_transient_for_w, 2, 0, 0, H_gdk_window_set_transient_for);
- XG_DEFINE_PROCEDURE(gdk_window_set_background, gxg_gdk_window_set_background_w, 2, 0, 0, H_gdk_window_set_background);
- XG_DEFINE_PROCEDURE(gdk_window_set_cursor, gxg_gdk_window_set_cursor_w, 2, 0, 0, H_gdk_window_set_cursor);
- XG_DEFINE_PROCEDURE(gdk_window_get_user_data, gxg_gdk_window_get_user_data_w, 1, 1, 0, H_gdk_window_get_user_data);
- XG_DEFINE_PROCEDURE(gdk_window_get_position, gxg_gdk_window_get_position_w, 1, 2, 0, H_gdk_window_get_position);
- XG_DEFINE_PROCEDURE(gdk_window_get_origin, gxg_gdk_window_get_origin_w, 1, 2, 0, H_gdk_window_get_origin);
- XG_DEFINE_PROCEDURE(gdk_get_default_root_window, gxg_gdk_get_default_root_window_w, 0, 0, 0, H_gdk_get_default_root_window);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_error_quark, gxg_gdk_pixbuf_error_quark_w, 0, 0, 0, H_gdk_pixbuf_error_quark);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_colorspace, gxg_gdk_pixbuf_get_colorspace_w, 1, 0, 0, H_gdk_pixbuf_get_colorspace);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_n_channels, gxg_gdk_pixbuf_get_n_channels_w, 1, 0, 0, H_gdk_pixbuf_get_n_channels);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_has_alpha, gxg_gdk_pixbuf_get_has_alpha_w, 1, 0, 0, H_gdk_pixbuf_get_has_alpha);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_bits_per_sample, gxg_gdk_pixbuf_get_bits_per_sample_w, 1, 0, 0, H_gdk_pixbuf_get_bits_per_sample);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_pixels, gxg_gdk_pixbuf_get_pixels_w, 1, 0, 0, H_gdk_pixbuf_get_pixels);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_width, gxg_gdk_pixbuf_get_width_w, 1, 0, 0, H_gdk_pixbuf_get_width);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_height, gxg_gdk_pixbuf_get_height_w, 1, 0, 0, H_gdk_pixbuf_get_height);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_rowstride, gxg_gdk_pixbuf_get_rowstride_w, 1, 0, 0, H_gdk_pixbuf_get_rowstride);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_new, gxg_gdk_pixbuf_new_w, 5, 0, 0, H_gdk_pixbuf_new);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_copy, gxg_gdk_pixbuf_copy_w, 1, 0, 0, H_gdk_pixbuf_copy);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_new_subpixbuf, gxg_gdk_pixbuf_new_subpixbuf_w, 5, 0, 0, H_gdk_pixbuf_new_subpixbuf);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_new_from_file, gxg_gdk_pixbuf_new_from_file_w, 1, 1, 0, H_gdk_pixbuf_new_from_file);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_new_from_data, gxg_gdk_pixbuf_new_from_data_w, 9, 0, 0, H_gdk_pixbuf_new_from_data);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_new_from_xpm_data, gxg_gdk_pixbuf_new_from_xpm_data_w, 1, 0, 0, H_gdk_pixbuf_new_from_xpm_data);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_new_from_inline, gxg_gdk_pixbuf_new_from_inline_w, 3, 1, 0, H_gdk_pixbuf_new_from_inline);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_fill, gxg_gdk_pixbuf_fill_w, 2, 0, 0, H_gdk_pixbuf_fill);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_savev, gxg_gdk_pixbuf_savev_w, 5, 1, 0, H_gdk_pixbuf_savev);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_add_alpha, gxg_gdk_pixbuf_add_alpha_w, 5, 0, 0, H_gdk_pixbuf_add_alpha);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_copy_area, gxg_gdk_pixbuf_copy_area_w, 8, 0, 0, H_gdk_pixbuf_copy_area);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_saturate_and_pixelate, gxg_gdk_pixbuf_saturate_and_pixelate_w, 4, 0, 0, H_gdk_pixbuf_saturate_and_pixelate);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_scale, gxg_gdk_pixbuf_scale_w, 0, 0, 1, H_gdk_pixbuf_scale);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_composite, gxg_gdk_pixbuf_composite_w, 0, 0, 1, H_gdk_pixbuf_composite);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_composite_color, gxg_gdk_pixbuf_composite_color_w, 0, 0, 1, H_gdk_pixbuf_composite_color);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_scale_simple, gxg_gdk_pixbuf_scale_simple_w, 4, 0, 0, H_gdk_pixbuf_scale_simple);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_composite_color_simple, gxg_gdk_pixbuf_composite_color_simple_w, 8, 0, 0, H_gdk_pixbuf_composite_color_simple);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_new_from_file, gxg_gdk_pixbuf_animation_new_from_file_w, 1, 1, 0, H_gdk_pixbuf_animation_new_from_file);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_get_width, gxg_gdk_pixbuf_animation_get_width_w, 1, 0, 0, H_gdk_pixbuf_animation_get_width);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_get_height, gxg_gdk_pixbuf_animation_get_height_w, 1, 0, 0, H_gdk_pixbuf_animation_get_height);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_is_static_image, gxg_gdk_pixbuf_animation_is_static_image_w, 1, 0, 0, H_gdk_pixbuf_animation_is_static_image);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_get_static_image, gxg_gdk_pixbuf_animation_get_static_image_w, 1, 0, 0, H_gdk_pixbuf_animation_get_static_image);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_get_iter, gxg_gdk_pixbuf_animation_get_iter_w, 2, 0, 0, H_gdk_pixbuf_animation_get_iter);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_iter_get_delay_time, gxg_gdk_pixbuf_animation_iter_get_delay_time_w, 1, 0, 0, H_gdk_pixbuf_animation_iter_get_delay_time);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_iter_get_pixbuf, gxg_gdk_pixbuf_animation_iter_get_pixbuf_w, 1, 0, 0, H_gdk_pixbuf_animation_iter_get_pixbuf);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_iter_on_currently_loading_frame, gxg_gdk_pixbuf_animation_iter_on_currently_loading_frame_w, 1, 0, 0, H_gdk_pixbuf_animation_iter_on_currently_loading_frame);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_animation_iter_advance, gxg_gdk_pixbuf_animation_iter_advance_w, 2, 0, 0, H_gdk_pixbuf_animation_iter_advance);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_option, gxg_gdk_pixbuf_get_option_w, 2, 0, 0, H_gdk_pixbuf_get_option);
- XG_DEFINE_PROCEDURE(gtk_vbox_new, gxg_gtk_vbox_new_w, 2, 0, 0, H_gtk_vbox_new);
- XG_DEFINE_PROCEDURE(gtk_accel_group_new, gxg_gtk_accel_group_new_w, 0, 0, 0, H_gtk_accel_group_new);
- XG_DEFINE_PROCEDURE(gtk_accel_group_lock, gxg_gtk_accel_group_lock_w, 1, 0, 0, H_gtk_accel_group_lock);
- XG_DEFINE_PROCEDURE(gtk_accel_group_unlock, gxg_gtk_accel_group_unlock_w, 1, 0, 0, H_gtk_accel_group_unlock);
- XG_DEFINE_PROCEDURE(gtk_accel_group_connect, gxg_gtk_accel_group_connect_w, 5, 0, 0, H_gtk_accel_group_connect);
- XG_DEFINE_PROCEDURE(gtk_accel_group_connect_by_path, gxg_gtk_accel_group_connect_by_path_w, 3, 0, 0, H_gtk_accel_group_connect_by_path);
- XG_DEFINE_PROCEDURE(gtk_accel_group_disconnect, gxg_gtk_accel_group_disconnect_w, 2, 0, 0, H_gtk_accel_group_disconnect);
- XG_DEFINE_PROCEDURE(gtk_accel_group_disconnect_key, gxg_gtk_accel_group_disconnect_key_w, 3, 0, 0, H_gtk_accel_group_disconnect_key);
- XG_DEFINE_PROCEDURE(gtk_accel_groups_activate, gxg_gtk_accel_groups_activate_w, 3, 0, 0, H_gtk_accel_groups_activate);
- XG_DEFINE_PROCEDURE(gtk_accel_groups_from_object, gxg_gtk_accel_groups_from_object_w, 1, 0, 0, H_gtk_accel_groups_from_object);
- XG_DEFINE_PROCEDURE(gtk_accel_group_find, gxg_gtk_accel_group_find_w, 2, 1, 0, H_gtk_accel_group_find);
- XG_DEFINE_PROCEDURE(gtk_accel_group_from_accel_closure, gxg_gtk_accel_group_from_accel_closure_w, 1, 0, 0, H_gtk_accel_group_from_accel_closure);
- XG_DEFINE_PROCEDURE(gtk_accelerator_valid, gxg_gtk_accelerator_valid_w, 2, 0, 0, H_gtk_accelerator_valid);
- XG_DEFINE_PROCEDURE(gtk_accelerator_parse, gxg_gtk_accelerator_parse_w, 1, 2, 0, H_gtk_accelerator_parse);
- XG_DEFINE_PROCEDURE(gtk_accelerator_name, gxg_gtk_accelerator_name_w, 2, 0, 0, H_gtk_accelerator_name);
- XG_DEFINE_PROCEDURE(gtk_accelerator_set_default_mod_mask, gxg_gtk_accelerator_set_default_mod_mask_w, 1, 0, 0, H_gtk_accelerator_set_default_mod_mask);
- XG_DEFINE_PROCEDURE(gtk_accel_group_query, gxg_gtk_accel_group_query_w, 3, 1, 0, H_gtk_accel_group_query);
- XG_DEFINE_PROCEDURE(gtk_accel_group_activate, gxg_gtk_accel_group_activate_w, 5, 0, 0, H_gtk_accel_group_activate);
- XG_DEFINE_PROCEDURE(gtk_accel_label_new, gxg_gtk_accel_label_new_w, 1, 0, 0, H_gtk_accel_label_new);
- XG_DEFINE_PROCEDURE(gtk_accel_label_get_accel_widget, gxg_gtk_accel_label_get_accel_widget_w, 1, 0, 0, H_gtk_accel_label_get_accel_widget);
- XG_DEFINE_PROCEDURE(gtk_accel_label_get_accel_width, gxg_gtk_accel_label_get_accel_width_w, 1, 0, 0, H_gtk_accel_label_get_accel_width);
- XG_DEFINE_PROCEDURE(gtk_accel_label_set_accel_widget, gxg_gtk_accel_label_set_accel_widget_w, 2, 0, 0, H_gtk_accel_label_set_accel_widget);
- XG_DEFINE_PROCEDURE(gtk_accel_label_set_accel_closure, gxg_gtk_accel_label_set_accel_closure_w, 2, 0, 0, H_gtk_accel_label_set_accel_closure);
- XG_DEFINE_PROCEDURE(gtk_accel_label_refetch, gxg_gtk_accel_label_refetch_w, 1, 0, 0, H_gtk_accel_label_refetch);
- XG_DEFINE_PROCEDURE(gtk_accel_map_add_entry, gxg_gtk_accel_map_add_entry_w, 3, 0, 0, H_gtk_accel_map_add_entry);
- XG_DEFINE_PROCEDURE(gtk_accel_map_lookup_entry, gxg_gtk_accel_map_lookup_entry_w, 2, 0, 0, H_gtk_accel_map_lookup_entry);
- XG_DEFINE_PROCEDURE(gtk_accel_map_change_entry, gxg_gtk_accel_map_change_entry_w, 4, 0, 0, H_gtk_accel_map_change_entry);
- XG_DEFINE_PROCEDURE(gtk_accel_map_load, gxg_gtk_accel_map_load_w, 1, 0, 0, H_gtk_accel_map_load);
- XG_DEFINE_PROCEDURE(gtk_accel_map_save, gxg_gtk_accel_map_save_w, 1, 0, 0, H_gtk_accel_map_save);
- XG_DEFINE_PROCEDURE(gtk_accel_map_foreach, gxg_gtk_accel_map_foreach_w, 2, 0, 0, H_gtk_accel_map_foreach);
- XG_DEFINE_PROCEDURE(gtk_accel_map_load_fd, gxg_gtk_accel_map_load_fd_w, 1, 0, 0, H_gtk_accel_map_load_fd);
- XG_DEFINE_PROCEDURE(gtk_accel_map_save_fd, gxg_gtk_accel_map_save_fd_w, 1, 0, 0, H_gtk_accel_map_save_fd);
- XG_DEFINE_PROCEDURE(gtk_accel_map_add_filter, gxg_gtk_accel_map_add_filter_w, 1, 0, 0, H_gtk_accel_map_add_filter);
- XG_DEFINE_PROCEDURE(gtk_accel_map_foreach_unfiltered, gxg_gtk_accel_map_foreach_unfiltered_w, 2, 0, 0, H_gtk_accel_map_foreach_unfiltered);
- XG_DEFINE_PROCEDURE(gtk_accessible_connect_widget_destroyed, gxg_gtk_accessible_connect_widget_destroyed_w, 1, 0, 0, H_gtk_accessible_connect_widget_destroyed);
- XG_DEFINE_PROCEDURE(gtk_adjustment_changed, gxg_gtk_adjustment_changed_w, 1, 0, 0, H_gtk_adjustment_changed);
- XG_DEFINE_PROCEDURE(gtk_adjustment_value_changed, gxg_gtk_adjustment_value_changed_w, 1, 0, 0, H_gtk_adjustment_value_changed);
- XG_DEFINE_PROCEDURE(gtk_adjustment_clamp_page, gxg_gtk_adjustment_clamp_page_w, 3, 0, 0, H_gtk_adjustment_clamp_page);
- XG_DEFINE_PROCEDURE(gtk_adjustment_get_value, gxg_gtk_adjustment_get_value_w, 1, 0, 0, H_gtk_adjustment_get_value);
- XG_DEFINE_PROCEDURE(gtk_adjustment_set_value, gxg_gtk_adjustment_set_value_w, 2, 0, 0, H_gtk_adjustment_set_value);
- XG_DEFINE_PROCEDURE(gtk_alignment_new, gxg_gtk_alignment_new_w, 4, 0, 0, H_gtk_alignment_new);
- XG_DEFINE_PROCEDURE(gtk_alignment_set, gxg_gtk_alignment_set_w, 5, 0, 0, H_gtk_alignment_set);
- XG_DEFINE_PROCEDURE(gtk_arrow_new, gxg_gtk_arrow_new_w, 2, 0, 0, H_gtk_arrow_new);
- XG_DEFINE_PROCEDURE(gtk_arrow_set, gxg_gtk_arrow_set_w, 3, 0, 0, H_gtk_arrow_set);
- XG_DEFINE_PROCEDURE(gtk_aspect_frame_new, gxg_gtk_aspect_frame_new_w, 5, 0, 0, H_gtk_aspect_frame_new);
- XG_DEFINE_PROCEDURE(gtk_aspect_frame_set, gxg_gtk_aspect_frame_set_w, 5, 0, 0, H_gtk_aspect_frame_set);
- XG_DEFINE_PROCEDURE(gtk_button_box_get_layout, gxg_gtk_button_box_get_layout_w, 1, 0, 0, H_gtk_button_box_get_layout);
- XG_DEFINE_PROCEDURE(gtk_button_box_set_layout, gxg_gtk_button_box_set_layout_w, 2, 0, 0, H_gtk_button_box_set_layout);
- XG_DEFINE_PROCEDURE(gtk_button_box_set_child_secondary, gxg_gtk_button_box_set_child_secondary_w, 3, 0, 0, H_gtk_button_box_set_child_secondary);
- XG_DEFINE_PROCEDURE(gtk_binding_set_new, gxg_gtk_binding_set_new_w, 1, 0, 0, H_gtk_binding_set_new);
- XG_DEFINE_PROCEDURE(gtk_binding_set_by_class, gxg_gtk_binding_set_by_class_w, 1, 0, 0, H_gtk_binding_set_by_class);
- XG_DEFINE_PROCEDURE(gtk_binding_set_find, gxg_gtk_binding_set_find_w, 1, 0, 0, H_gtk_binding_set_find);
- XG_DEFINE_PROCEDURE(gtk_binding_entry_remove, gxg_gtk_binding_entry_remove_w, 3, 0, 0, H_gtk_binding_entry_remove);
- XG_DEFINE_PROCEDURE(gtk_bin_get_child, gxg_gtk_bin_get_child_w, 1, 0, 0, H_gtk_bin_get_child);
- XG_DEFINE_PROCEDURE(gtk_box_pack_start, gxg_gtk_box_pack_start_w, 5, 0, 0, H_gtk_box_pack_start);
- XG_DEFINE_PROCEDURE(gtk_box_pack_end, gxg_gtk_box_pack_end_w, 5, 0, 0, H_gtk_box_pack_end);
- XG_DEFINE_PROCEDURE(gtk_box_set_homogeneous, gxg_gtk_box_set_homogeneous_w, 2, 0, 0, H_gtk_box_set_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_box_get_homogeneous, gxg_gtk_box_get_homogeneous_w, 1, 0, 0, H_gtk_box_get_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_box_set_spacing, gxg_gtk_box_set_spacing_w, 2, 0, 0, H_gtk_box_set_spacing);
- XG_DEFINE_PROCEDURE(gtk_box_get_spacing, gxg_gtk_box_get_spacing_w, 1, 0, 0, H_gtk_box_get_spacing);
- XG_DEFINE_PROCEDURE(gtk_box_reorder_child, gxg_gtk_box_reorder_child_w, 3, 0, 0, H_gtk_box_reorder_child);
- XG_DEFINE_PROCEDURE(gtk_box_query_child_packing, gxg_gtk_box_query_child_packing_w, 2, 4, 0, H_gtk_box_query_child_packing);
- XG_DEFINE_PROCEDURE(gtk_box_set_child_packing, gxg_gtk_box_set_child_packing_w, 6, 0, 0, H_gtk_box_set_child_packing);
- XG_DEFINE_PROCEDURE(gtk_button_new, gxg_gtk_button_new_w, 0, 0, 0, H_gtk_button_new);
- XG_DEFINE_PROCEDURE(gtk_button_new_with_label, gxg_gtk_button_new_with_label_w, 1, 0, 0, H_gtk_button_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_button_new_from_stock, gxg_gtk_button_new_from_stock_w, 1, 0, 0, H_gtk_button_new_from_stock);
- XG_DEFINE_PROCEDURE(gtk_button_new_with_mnemonic, gxg_gtk_button_new_with_mnemonic_w, 1, 0, 0, H_gtk_button_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_button_clicked, gxg_gtk_button_clicked_w, 1, 0, 0, H_gtk_button_clicked);
- XG_DEFINE_PROCEDURE(gtk_button_set_relief, gxg_gtk_button_set_relief_w, 2, 0, 0, H_gtk_button_set_relief);
- XG_DEFINE_PROCEDURE(gtk_button_get_relief, gxg_gtk_button_get_relief_w, 1, 0, 0, H_gtk_button_get_relief);
- XG_DEFINE_PROCEDURE(gtk_button_set_label, gxg_gtk_button_set_label_w, 2, 0, 0, H_gtk_button_set_label);
- XG_DEFINE_PROCEDURE(gtk_button_get_label, gxg_gtk_button_get_label_w, 1, 0, 0, H_gtk_button_get_label);
- XG_DEFINE_PROCEDURE(gtk_button_set_use_underline, gxg_gtk_button_set_use_underline_w, 2, 0, 0, H_gtk_button_set_use_underline);
- XG_DEFINE_PROCEDURE(gtk_button_get_use_underline, gxg_gtk_button_get_use_underline_w, 1, 0, 0, H_gtk_button_get_use_underline);
- XG_DEFINE_PROCEDURE(gtk_button_set_use_stock, gxg_gtk_button_set_use_stock_w, 2, 0, 0, H_gtk_button_set_use_stock);
- XG_DEFINE_PROCEDURE(gtk_button_get_use_stock, gxg_gtk_button_get_use_stock_w, 1, 0, 0, H_gtk_button_get_use_stock);
- XG_DEFINE_PROCEDURE(gtk_calendar_new, gxg_gtk_calendar_new_w, 0, 0, 0, H_gtk_calendar_new);
- XG_DEFINE_PROCEDURE(gtk_calendar_select_day, gxg_gtk_calendar_select_day_w, 2, 0, 0, H_gtk_calendar_select_day);
- XG_DEFINE_PROCEDURE(gtk_calendar_clear_marks, gxg_gtk_calendar_clear_marks_w, 1, 0, 0, H_gtk_calendar_clear_marks);
- XG_DEFINE_PROCEDURE(gtk_calendar_get_date, gxg_gtk_calendar_get_date_w, 1, 3, 0, H_gtk_calendar_get_date);
- XG_DEFINE_PROCEDURE(gtk_cell_editable_start_editing, gxg_gtk_cell_editable_start_editing_w, 2, 0, 0, H_gtk_cell_editable_start_editing);
- XG_DEFINE_PROCEDURE(gtk_cell_editable_editing_done, gxg_gtk_cell_editable_editing_done_w, 1, 0, 0, H_gtk_cell_editable_editing_done);
- XG_DEFINE_PROCEDURE(gtk_cell_editable_remove_widget, gxg_gtk_cell_editable_remove_widget_w, 1, 0, 0, H_gtk_cell_editable_remove_widget);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_activate, gxg_gtk_cell_renderer_activate_w, 7, 0, 0, H_gtk_cell_renderer_activate);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_start_editing, gxg_gtk_cell_renderer_start_editing_w, 7, 0, 0, H_gtk_cell_renderer_start_editing);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_set_fixed_size, gxg_gtk_cell_renderer_set_fixed_size_w, 3, 0, 0, H_gtk_cell_renderer_set_fixed_size);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_fixed_size, gxg_gtk_cell_renderer_get_fixed_size_w, 1, 2, 0, H_gtk_cell_renderer_get_fixed_size);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_pixbuf_new, gxg_gtk_cell_renderer_pixbuf_new_w, 0, 0, 0, H_gtk_cell_renderer_pixbuf_new);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_text_new, gxg_gtk_cell_renderer_text_new_w, 0, 0, 0, H_gtk_cell_renderer_text_new);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_text_set_fixed_height_from_font, gxg_gtk_cell_renderer_text_set_fixed_height_from_font_w, 2, 0, 0, H_gtk_cell_renderer_text_set_fixed_height_from_font);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_toggle_new, gxg_gtk_cell_renderer_toggle_new_w, 0, 0, 0, H_gtk_cell_renderer_toggle_new);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_toggle_get_radio, gxg_gtk_cell_renderer_toggle_get_radio_w, 1, 0, 0, H_gtk_cell_renderer_toggle_get_radio);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_toggle_set_radio, gxg_gtk_cell_renderer_toggle_set_radio_w, 2, 0, 0, H_gtk_cell_renderer_toggle_set_radio);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_toggle_get_active, gxg_gtk_cell_renderer_toggle_get_active_w, 1, 0, 0, H_gtk_cell_renderer_toggle_get_active);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_toggle_set_active, gxg_gtk_cell_renderer_toggle_set_active_w, 2, 0, 0, H_gtk_cell_renderer_toggle_set_active);
- XG_DEFINE_PROCEDURE(gtk_check_button_new, gxg_gtk_check_button_new_w, 0, 0, 0, H_gtk_check_button_new);
- XG_DEFINE_PROCEDURE(gtk_check_button_new_with_label, gxg_gtk_check_button_new_with_label_w, 1, 0, 0, H_gtk_check_button_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_check_button_new_with_mnemonic, gxg_gtk_check_button_new_with_mnemonic_w, 1, 0, 0, H_gtk_check_button_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_new, gxg_gtk_check_menu_item_new_w, 0, 0, 0, H_gtk_check_menu_item_new);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_new_with_label, gxg_gtk_check_menu_item_new_with_label_w, 1, 0, 0, H_gtk_check_menu_item_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_new_with_mnemonic, gxg_gtk_check_menu_item_new_with_mnemonic_w, 1, 0, 0, H_gtk_check_menu_item_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_set_active, gxg_gtk_check_menu_item_set_active_w, 2, 0, 0, H_gtk_check_menu_item_set_active);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_get_active, gxg_gtk_check_menu_item_get_active_w, 1, 0, 0, H_gtk_check_menu_item_get_active);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_toggled, gxg_gtk_check_menu_item_toggled_w, 1, 0, 0, H_gtk_check_menu_item_toggled);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_set_inconsistent, gxg_gtk_check_menu_item_set_inconsistent_w, 2, 0, 0, H_gtk_check_menu_item_set_inconsistent);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_get_inconsistent, gxg_gtk_check_menu_item_get_inconsistent_w, 1, 0, 0, H_gtk_check_menu_item_get_inconsistent);
- XG_DEFINE_PROCEDURE(gtk_clipboard_get, gxg_gtk_clipboard_get_w, 1, 0, 0, H_gtk_clipboard_get);
- XG_DEFINE_PROCEDURE(gtk_clipboard_set_with_data, gxg_gtk_clipboard_set_with_data_w, 5, 1, 0, H_gtk_clipboard_set_with_data);
- XG_DEFINE_PROCEDURE(gtk_clipboard_get_owner, gxg_gtk_clipboard_get_owner_w, 1, 0, 0, H_gtk_clipboard_get_owner);
- XG_DEFINE_PROCEDURE(gtk_clipboard_clear, gxg_gtk_clipboard_clear_w, 1, 0, 0, H_gtk_clipboard_clear);
- XG_DEFINE_PROCEDURE(gtk_clipboard_set_text, gxg_gtk_clipboard_set_text_w, 3, 0, 0, H_gtk_clipboard_set_text);
- XG_DEFINE_PROCEDURE(gtk_clipboard_request_contents, gxg_gtk_clipboard_request_contents_w, 3, 1, 0, H_gtk_clipboard_request_contents);
- XG_DEFINE_PROCEDURE(gtk_clipboard_request_text, gxg_gtk_clipboard_request_text_w, 2, 1, 0, H_gtk_clipboard_request_text);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_for_contents, gxg_gtk_clipboard_wait_for_contents_w, 2, 0, 0, H_gtk_clipboard_wait_for_contents);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_for_text, gxg_gtk_clipboard_wait_for_text_w, 1, 0, 0, H_gtk_clipboard_wait_for_text);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_is_text_available, gxg_gtk_clipboard_wait_is_text_available_w, 1, 0, 0, H_gtk_clipboard_wait_is_text_available);
- XG_DEFINE_PROCEDURE(gtk_color_selection_dialog_new, gxg_gtk_color_selection_dialog_new_w, 1, 0, 0, H_gtk_color_selection_dialog_new);
- XG_DEFINE_PROCEDURE(gtk_color_selection_new, gxg_gtk_color_selection_new_w, 0, 0, 0, H_gtk_color_selection_new);
- XG_DEFINE_PROCEDURE(gtk_color_selection_get_has_opacity_control, gxg_gtk_color_selection_get_has_opacity_control_w, 1, 0, 0, H_gtk_color_selection_get_has_opacity_control);
- XG_DEFINE_PROCEDURE(gtk_color_selection_set_has_opacity_control, gxg_gtk_color_selection_set_has_opacity_control_w, 2, 0, 0, H_gtk_color_selection_set_has_opacity_control);
- XG_DEFINE_PROCEDURE(gtk_color_selection_get_has_palette, gxg_gtk_color_selection_get_has_palette_w, 1, 0, 0, H_gtk_color_selection_get_has_palette);
- XG_DEFINE_PROCEDURE(gtk_color_selection_set_has_palette, gxg_gtk_color_selection_set_has_palette_w, 2, 0, 0, H_gtk_color_selection_set_has_palette);
- XG_DEFINE_PROCEDURE(gtk_color_selection_set_current_color, gxg_gtk_color_selection_set_current_color_w, 2, 0, 0, H_gtk_color_selection_set_current_color);
- XG_DEFINE_PROCEDURE(gtk_color_selection_set_current_alpha, gxg_gtk_color_selection_set_current_alpha_w, 2, 0, 0, H_gtk_color_selection_set_current_alpha);
- XG_DEFINE_PROCEDURE(gtk_color_selection_get_current_color, gxg_gtk_color_selection_get_current_color_w, 2, 0, 0, H_gtk_color_selection_get_current_color);
- XG_DEFINE_PROCEDURE(gtk_color_selection_get_current_alpha, gxg_gtk_color_selection_get_current_alpha_w, 1, 0, 0, H_gtk_color_selection_get_current_alpha);
- XG_DEFINE_PROCEDURE(gtk_color_selection_set_previous_color, gxg_gtk_color_selection_set_previous_color_w, 2, 0, 0, H_gtk_color_selection_set_previous_color);
- XG_DEFINE_PROCEDURE(gtk_color_selection_set_previous_alpha, gxg_gtk_color_selection_set_previous_alpha_w, 2, 0, 0, H_gtk_color_selection_set_previous_alpha);
- XG_DEFINE_PROCEDURE(gtk_color_selection_get_previous_color, gxg_gtk_color_selection_get_previous_color_w, 2, 0, 0, H_gtk_color_selection_get_previous_color);
- XG_DEFINE_PROCEDURE(gtk_color_selection_get_previous_alpha, gxg_gtk_color_selection_get_previous_alpha_w, 1, 0, 0, H_gtk_color_selection_get_previous_alpha);
- XG_DEFINE_PROCEDURE(gtk_color_selection_is_adjusting, gxg_gtk_color_selection_is_adjusting_w, 1, 0, 0, H_gtk_color_selection_is_adjusting);
- XG_DEFINE_PROCEDURE(gtk_color_selection_palette_from_string, gxg_gtk_color_selection_palette_from_string_w, 1, 2, 0, H_gtk_color_selection_palette_from_string);
- XG_DEFINE_PROCEDURE(gtk_color_selection_palette_to_string, gxg_gtk_color_selection_palette_to_string_w, 2, 0, 0, H_gtk_color_selection_palette_to_string);
- XG_DEFINE_PROCEDURE(gtk_container_set_border_width, gxg_gtk_container_set_border_width_w, 2, 0, 0, H_gtk_container_set_border_width);
- XG_DEFINE_PROCEDURE(gtk_container_get_border_width, gxg_gtk_container_get_border_width_w, 1, 0, 0, H_gtk_container_get_border_width);
- XG_DEFINE_PROCEDURE(gtk_container_add, gxg_gtk_container_add_w, 2, 0, 0, H_gtk_container_add);
- XG_DEFINE_PROCEDURE(gtk_container_remove, gxg_gtk_container_remove_w, 2, 0, 0, H_gtk_container_remove);
- XG_DEFINE_PROCEDURE(gtk_container_set_resize_mode, gxg_gtk_container_set_resize_mode_w, 2, 0, 0, H_gtk_container_set_resize_mode);
- XG_DEFINE_PROCEDURE(gtk_container_get_resize_mode, gxg_gtk_container_get_resize_mode_w, 1, 0, 0, H_gtk_container_get_resize_mode);
- XG_DEFINE_PROCEDURE(gtk_container_check_resize, gxg_gtk_container_check_resize_w, 1, 0, 0, H_gtk_container_check_resize);
- XG_DEFINE_PROCEDURE(gtk_container_foreach, gxg_gtk_container_foreach_w, 2, 1, 0, H_gtk_container_foreach);
- XG_DEFINE_PROCEDURE(gtk_container_get_children, gxg_gtk_container_get_children_w, 1, 0, 0, H_gtk_container_get_children);
- XG_DEFINE_PROCEDURE(gtk_dialog_new, gxg_gtk_dialog_new_w, 0, 0, 0, H_gtk_dialog_new);
- XG_DEFINE_PROCEDURE(gtk_dialog_new_with_buttons, gxg_gtk_dialog_new_with_buttons_w, 3, 1, 0, H_gtk_dialog_new_with_buttons);
- XG_DEFINE_PROCEDURE(gtk_dialog_add_action_widget, gxg_gtk_dialog_add_action_widget_w, 3, 0, 0, H_gtk_dialog_add_action_widget);
- XG_DEFINE_PROCEDURE(gtk_dialog_add_button, gxg_gtk_dialog_add_button_w, 3, 0, 0, H_gtk_dialog_add_button);
- XG_DEFINE_PROCEDURE(gtk_dialog_add_buttons, gxg_gtk_dialog_add_buttons_w, 2, 0, 0, H_gtk_dialog_add_buttons);
- XG_DEFINE_PROCEDURE(gtk_dialog_set_response_sensitive, gxg_gtk_dialog_set_response_sensitive_w, 3, 0, 0, H_gtk_dialog_set_response_sensitive);
- XG_DEFINE_PROCEDURE(gtk_dialog_set_default_response, gxg_gtk_dialog_set_default_response_w, 2, 0, 0, H_gtk_dialog_set_default_response);
- XG_DEFINE_PROCEDURE(gtk_dialog_response, gxg_gtk_dialog_response_w, 2, 0, 0, H_gtk_dialog_response);
- XG_DEFINE_PROCEDURE(gtk_dialog_run, gxg_gtk_dialog_run_w, 1, 0, 0, H_gtk_dialog_run);
- XG_DEFINE_PROCEDURE(gtk_drag_get_data, gxg_gtk_drag_get_data_w, 4, 0, 0, H_gtk_drag_get_data);
- XG_DEFINE_PROCEDURE(gtk_drag_finish, gxg_gtk_drag_finish_w, 4, 0, 0, H_gtk_drag_finish);
- XG_DEFINE_PROCEDURE(gtk_drag_get_source_widget, gxg_gtk_drag_get_source_widget_w, 1, 0, 0, H_gtk_drag_get_source_widget);
- XG_DEFINE_PROCEDURE(gtk_drag_highlight, gxg_gtk_drag_highlight_w, 1, 0, 0, H_gtk_drag_highlight);
- XG_DEFINE_PROCEDURE(gtk_drag_unhighlight, gxg_gtk_drag_unhighlight_w, 1, 0, 0, H_gtk_drag_unhighlight);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_set, gxg_gtk_drag_dest_set_w, 5, 0, 0, H_gtk_drag_dest_set);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_unset, gxg_gtk_drag_dest_unset_w, 1, 0, 0, H_gtk_drag_dest_unset);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_find_target, gxg_gtk_drag_dest_find_target_w, 3, 0, 0, H_gtk_drag_dest_find_target);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_get_target_list, gxg_gtk_drag_dest_get_target_list_w, 1, 0, 0, H_gtk_drag_dest_get_target_list);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_set_target_list, gxg_gtk_drag_dest_set_target_list_w, 2, 0, 0, H_gtk_drag_dest_set_target_list);
- XG_DEFINE_PROCEDURE(gtk_drag_source_set, gxg_gtk_drag_source_set_w, 5, 0, 0, H_gtk_drag_source_set);
- XG_DEFINE_PROCEDURE(gtk_drag_source_unset, gxg_gtk_drag_source_unset_w, 1, 0, 0, H_gtk_drag_source_unset);
- XG_DEFINE_PROCEDURE(gtk_drag_source_set_icon_pixbuf, gxg_gtk_drag_source_set_icon_pixbuf_w, 2, 0, 0, H_gtk_drag_source_set_icon_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_drag_source_set_icon_stock, gxg_gtk_drag_source_set_icon_stock_w, 2, 0, 0, H_gtk_drag_source_set_icon_stock);
- XG_DEFINE_PROCEDURE(gtk_drag_begin, gxg_gtk_drag_begin_w, 5, 0, 0, H_gtk_drag_begin);
- XG_DEFINE_PROCEDURE(gtk_drag_set_icon_widget, gxg_gtk_drag_set_icon_widget_w, 4, 0, 0, H_gtk_drag_set_icon_widget);
- XG_DEFINE_PROCEDURE(gtk_drag_set_icon_pixbuf, gxg_gtk_drag_set_icon_pixbuf_w, 4, 0, 0, H_gtk_drag_set_icon_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_drag_set_icon_stock, gxg_gtk_drag_set_icon_stock_w, 4, 0, 0, H_gtk_drag_set_icon_stock);
- XG_DEFINE_PROCEDURE(gtk_drag_set_icon_default, gxg_gtk_drag_set_icon_default_w, 1, 0, 0, H_gtk_drag_set_icon_default);
- XG_DEFINE_PROCEDURE(gtk_drag_check_threshold, gxg_gtk_drag_check_threshold_w, 5, 0, 0, H_gtk_drag_check_threshold);
- XG_DEFINE_PROCEDURE(gtk_drawing_area_new, gxg_gtk_drawing_area_new_w, 0, 0, 0, H_gtk_drawing_area_new);
- XG_DEFINE_PROCEDURE(gtk_editable_select_region, gxg_gtk_editable_select_region_w, 3, 0, 0, H_gtk_editable_select_region);
- XG_DEFINE_PROCEDURE(gtk_editable_get_selection_bounds, gxg_gtk_editable_get_selection_bounds_w, 1, 2, 0, H_gtk_editable_get_selection_bounds);
- XG_DEFINE_PROCEDURE(gtk_editable_insert_text, gxg_gtk_editable_insert_text_w, 3, 1, 0, H_gtk_editable_insert_text);
- XG_DEFINE_PROCEDURE(gtk_editable_delete_text, gxg_gtk_editable_delete_text_w, 3, 0, 0, H_gtk_editable_delete_text);
- XG_DEFINE_PROCEDURE(gtk_editable_get_chars, gxg_gtk_editable_get_chars_w, 3, 0, 0, H_gtk_editable_get_chars);
- XG_DEFINE_PROCEDURE(gtk_editable_cut_clipboard, gxg_gtk_editable_cut_clipboard_w, 1, 0, 0, H_gtk_editable_cut_clipboard);
- XG_DEFINE_PROCEDURE(gtk_editable_copy_clipboard, gxg_gtk_editable_copy_clipboard_w, 1, 0, 0, H_gtk_editable_copy_clipboard);
- XG_DEFINE_PROCEDURE(gtk_editable_paste_clipboard, gxg_gtk_editable_paste_clipboard_w, 1, 0, 0, H_gtk_editable_paste_clipboard);
- XG_DEFINE_PROCEDURE(gtk_editable_delete_selection, gxg_gtk_editable_delete_selection_w, 1, 0, 0, H_gtk_editable_delete_selection);
- XG_DEFINE_PROCEDURE(gtk_editable_set_position, gxg_gtk_editable_set_position_w, 2, 0, 0, H_gtk_editable_set_position);
- XG_DEFINE_PROCEDURE(gtk_editable_get_position, gxg_gtk_editable_get_position_w, 1, 0, 0, H_gtk_editable_get_position);
- XG_DEFINE_PROCEDURE(gtk_editable_set_editable, gxg_gtk_editable_set_editable_w, 2, 0, 0, H_gtk_editable_set_editable);
- XG_DEFINE_PROCEDURE(gtk_editable_get_editable, gxg_gtk_editable_get_editable_w, 1, 0, 0, H_gtk_editable_get_editable);
- XG_DEFINE_PROCEDURE(gtk_entry_new, gxg_gtk_entry_new_w, 0, 0, 0, H_gtk_entry_new);
- XG_DEFINE_PROCEDURE(gtk_entry_set_visibility, gxg_gtk_entry_set_visibility_w, 2, 0, 0, H_gtk_entry_set_visibility);
- XG_DEFINE_PROCEDURE(gtk_entry_get_visibility, gxg_gtk_entry_get_visibility_w, 1, 0, 0, H_gtk_entry_get_visibility);
- XG_DEFINE_PROCEDURE(gtk_entry_set_invisible_char, gxg_gtk_entry_set_invisible_char_w, 2, 0, 0, H_gtk_entry_set_invisible_char);
- XG_DEFINE_PROCEDURE(gtk_entry_get_invisible_char, gxg_gtk_entry_get_invisible_char_w, 1, 0, 0, H_gtk_entry_get_invisible_char);
- XG_DEFINE_PROCEDURE(gtk_entry_set_has_frame, gxg_gtk_entry_set_has_frame_w, 2, 0, 0, H_gtk_entry_set_has_frame);
- XG_DEFINE_PROCEDURE(gtk_entry_get_has_frame, gxg_gtk_entry_get_has_frame_w, 1, 0, 0, H_gtk_entry_get_has_frame);
- XG_DEFINE_PROCEDURE(gtk_entry_set_max_length, gxg_gtk_entry_set_max_length_w, 2, 0, 0, H_gtk_entry_set_max_length);
- XG_DEFINE_PROCEDURE(gtk_entry_get_max_length, gxg_gtk_entry_get_max_length_w, 1, 0, 0, H_gtk_entry_get_max_length);
- XG_DEFINE_PROCEDURE(gtk_entry_set_activates_default, gxg_gtk_entry_set_activates_default_w, 2, 0, 0, H_gtk_entry_set_activates_default);
- XG_DEFINE_PROCEDURE(gtk_entry_get_activates_default, gxg_gtk_entry_get_activates_default_w, 1, 0, 0, H_gtk_entry_get_activates_default);
- XG_DEFINE_PROCEDURE(gtk_entry_set_width_chars, gxg_gtk_entry_set_width_chars_w, 2, 0, 0, H_gtk_entry_set_width_chars);
- XG_DEFINE_PROCEDURE(gtk_entry_get_width_chars, gxg_gtk_entry_get_width_chars_w, 1, 0, 0, H_gtk_entry_get_width_chars);
- XG_DEFINE_PROCEDURE(gtk_entry_set_text, gxg_gtk_entry_set_text_w, 2, 0, 0, H_gtk_entry_set_text);
- XG_DEFINE_PROCEDURE(gtk_entry_get_text, gxg_gtk_entry_get_text_w, 1, 0, 0, H_gtk_entry_get_text);
- XG_DEFINE_PROCEDURE(gtk_entry_get_layout, gxg_gtk_entry_get_layout_w, 1, 0, 0, H_gtk_entry_get_layout);
- XG_DEFINE_PROCEDURE(gtk_entry_get_layout_offsets, gxg_gtk_entry_get_layout_offsets_w, 1, 2, 0, H_gtk_entry_get_layout_offsets);
- XG_DEFINE_PROCEDURE(gtk_event_box_new, gxg_gtk_event_box_new_w, 0, 0, 0, H_gtk_event_box_new);
- XG_DEFINE_PROCEDURE(gtk_fixed_new, gxg_gtk_fixed_new_w, 0, 0, 0, H_gtk_fixed_new);
- XG_DEFINE_PROCEDURE(gtk_fixed_put, gxg_gtk_fixed_put_w, 4, 0, 0, H_gtk_fixed_put);
- XG_DEFINE_PROCEDURE(gtk_fixed_move, gxg_gtk_fixed_move_w, 4, 0, 0, H_gtk_fixed_move);
- XG_DEFINE_PROCEDURE(gtk_font_selection_new, gxg_gtk_font_selection_new_w, 0, 0, 0, H_gtk_font_selection_new);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_font_name, gxg_gtk_font_selection_get_font_name_w, 1, 0, 0, H_gtk_font_selection_get_font_name);
- XG_DEFINE_PROCEDURE(gtk_font_selection_set_font_name, gxg_gtk_font_selection_set_font_name_w, 2, 0, 0, H_gtk_font_selection_set_font_name);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_preview_text, gxg_gtk_font_selection_get_preview_text_w, 1, 0, 0, H_gtk_font_selection_get_preview_text);
- XG_DEFINE_PROCEDURE(gtk_font_selection_set_preview_text, gxg_gtk_font_selection_set_preview_text_w, 2, 0, 0, H_gtk_font_selection_set_preview_text);
- XG_DEFINE_PROCEDURE(gtk_font_selection_dialog_new, gxg_gtk_font_selection_dialog_new_w, 1, 0, 0, H_gtk_font_selection_dialog_new);
- XG_DEFINE_PROCEDURE(gtk_font_selection_dialog_get_font_name, gxg_gtk_font_selection_dialog_get_font_name_w, 1, 0, 0, H_gtk_font_selection_dialog_get_font_name);
- XG_DEFINE_PROCEDURE(gtk_font_selection_dialog_set_font_name, gxg_gtk_font_selection_dialog_set_font_name_w, 2, 0, 0, H_gtk_font_selection_dialog_set_font_name);
- XG_DEFINE_PROCEDURE(gtk_font_selection_dialog_get_preview_text, gxg_gtk_font_selection_dialog_get_preview_text_w, 1, 0, 0, H_gtk_font_selection_dialog_get_preview_text);
- XG_DEFINE_PROCEDURE(gtk_font_selection_dialog_set_preview_text, gxg_gtk_font_selection_dialog_set_preview_text_w, 2, 0, 0, H_gtk_font_selection_dialog_set_preview_text);
- XG_DEFINE_PROCEDURE(gtk_frame_new, gxg_gtk_frame_new_w, 1, 0, 0, H_gtk_frame_new);
- XG_DEFINE_PROCEDURE(gtk_frame_set_label, gxg_gtk_frame_set_label_w, 2, 0, 0, H_gtk_frame_set_label);
- XG_DEFINE_PROCEDURE(gtk_frame_get_label, gxg_gtk_frame_get_label_w, 1, 0, 0, H_gtk_frame_get_label);
- XG_DEFINE_PROCEDURE(gtk_frame_set_label_widget, gxg_gtk_frame_set_label_widget_w, 2, 0, 0, H_gtk_frame_set_label_widget);
- XG_DEFINE_PROCEDURE(gtk_frame_get_label_widget, gxg_gtk_frame_get_label_widget_w, 1, 0, 0, H_gtk_frame_get_label_widget);
- XG_DEFINE_PROCEDURE(gtk_frame_set_label_align, gxg_gtk_frame_set_label_align_w, 3, 0, 0, H_gtk_frame_set_label_align);
- XG_DEFINE_PROCEDURE(gtk_frame_get_label_align, gxg_gtk_frame_get_label_align_w, 1, 2, 0, H_gtk_frame_get_label_align);
- XG_DEFINE_PROCEDURE(gtk_frame_set_shadow_type, gxg_gtk_frame_set_shadow_type_w, 2, 0, 0, H_gtk_frame_set_shadow_type);
- XG_DEFINE_PROCEDURE(gtk_frame_get_shadow_type, gxg_gtk_frame_get_shadow_type_w, 1, 0, 0, H_gtk_frame_get_shadow_type);
- XG_DEFINE_PROCEDURE(gtk_handle_box_new, gxg_gtk_handle_box_new_w, 0, 0, 0, H_gtk_handle_box_new);
- XG_DEFINE_PROCEDURE(gtk_handle_box_set_shadow_type, gxg_gtk_handle_box_set_shadow_type_w, 2, 0, 0, H_gtk_handle_box_set_shadow_type);
- XG_DEFINE_PROCEDURE(gtk_handle_box_get_shadow_type, gxg_gtk_handle_box_get_shadow_type_w, 1, 0, 0, H_gtk_handle_box_get_shadow_type);
- XG_DEFINE_PROCEDURE(gtk_handle_box_set_handle_position, gxg_gtk_handle_box_set_handle_position_w, 2, 0, 0, H_gtk_handle_box_set_handle_position);
- XG_DEFINE_PROCEDURE(gtk_handle_box_get_handle_position, gxg_gtk_handle_box_get_handle_position_w, 1, 0, 0, H_gtk_handle_box_get_handle_position);
- XG_DEFINE_PROCEDURE(gtk_handle_box_set_snap_edge, gxg_gtk_handle_box_set_snap_edge_w, 2, 0, 0, H_gtk_handle_box_set_snap_edge);
- XG_DEFINE_PROCEDURE(gtk_handle_box_get_snap_edge, gxg_gtk_handle_box_get_snap_edge_w, 1, 0, 0, H_gtk_handle_box_get_snap_edge);
- XG_DEFINE_PROCEDURE(gtk_hbutton_box_new, gxg_gtk_hbutton_box_new_w, 0, 0, 0, H_gtk_hbutton_box_new);
- XG_DEFINE_PROCEDURE(gtk_hbox_new, gxg_gtk_hbox_new_w, 2, 0, 0, H_gtk_hbox_new);
- XG_DEFINE_PROCEDURE(gtk_hpaned_new, gxg_gtk_hpaned_new_w, 0, 0, 0, H_gtk_hpaned_new);
- XG_DEFINE_PROCEDURE(gtk_hscale_new, gxg_gtk_hscale_new_w, 1, 0, 0, H_gtk_hscale_new);
- XG_DEFINE_PROCEDURE(gtk_hscale_new_with_range, gxg_gtk_hscale_new_with_range_w, 3, 0, 0, H_gtk_hscale_new_with_range);
- XG_DEFINE_PROCEDURE(gtk_hscrollbar_new, gxg_gtk_hscrollbar_new_w, 1, 0, 0, H_gtk_hscrollbar_new);
- XG_DEFINE_PROCEDURE(gtk_hseparator_new, gxg_gtk_hseparator_new_w, 0, 0, 0, H_gtk_hseparator_new);
- XG_DEFINE_PROCEDURE(gtk_icon_factory_new, gxg_gtk_icon_factory_new_w, 0, 0, 0, H_gtk_icon_factory_new);
- XG_DEFINE_PROCEDURE(gtk_icon_factory_add, gxg_gtk_icon_factory_add_w, 3, 0, 0, H_gtk_icon_factory_add);
- XG_DEFINE_PROCEDURE(gtk_icon_factory_lookup, gxg_gtk_icon_factory_lookup_w, 2, 0, 0, H_gtk_icon_factory_lookup);
- XG_DEFINE_PROCEDURE(gtk_icon_factory_add_default, gxg_gtk_icon_factory_add_default_w, 1, 0, 0, H_gtk_icon_factory_add_default);
- XG_DEFINE_PROCEDURE(gtk_icon_factory_remove_default, gxg_gtk_icon_factory_remove_default_w, 1, 0, 0, H_gtk_icon_factory_remove_default);
- XG_DEFINE_PROCEDURE(gtk_icon_factory_lookup_default, gxg_gtk_icon_factory_lookup_default_w, 1, 0, 0, H_gtk_icon_factory_lookup_default);
- XG_DEFINE_PROCEDURE(gtk_icon_size_lookup, gxg_gtk_icon_size_lookup_w, 1, 2, 0, H_gtk_icon_size_lookup);
- XG_DEFINE_PROCEDURE(gtk_icon_size_register, gxg_gtk_icon_size_register_w, 3, 0, 0, H_gtk_icon_size_register);
- XG_DEFINE_PROCEDURE(gtk_icon_size_register_alias, gxg_gtk_icon_size_register_alias_w, 2, 0, 0, H_gtk_icon_size_register_alias);
- XG_DEFINE_PROCEDURE(gtk_icon_size_from_name, gxg_gtk_icon_size_from_name_w, 1, 0, 0, H_gtk_icon_size_from_name);
- XG_DEFINE_PROCEDURE(gtk_icon_size_get_name, gxg_gtk_icon_size_get_name_w, 1, 0, 0, H_gtk_icon_size_get_name);
- XG_DEFINE_PROCEDURE(gtk_icon_set_new, gxg_gtk_icon_set_new_w, 0, 0, 0, H_gtk_icon_set_new);
- XG_DEFINE_PROCEDURE(gtk_icon_set_new_from_pixbuf, gxg_gtk_icon_set_new_from_pixbuf_w, 1, 0, 0, H_gtk_icon_set_new_from_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_icon_set_ref, gxg_gtk_icon_set_ref_w, 1, 0, 0, H_gtk_icon_set_ref);
- XG_DEFINE_PROCEDURE(gtk_icon_set_unref, gxg_gtk_icon_set_unref_w, 1, 0, 0, H_gtk_icon_set_unref);
- XG_DEFINE_PROCEDURE(gtk_icon_set_copy, gxg_gtk_icon_set_copy_w, 1, 0, 0, H_gtk_icon_set_copy);
- XG_DEFINE_PROCEDURE(gtk_icon_set_add_source, gxg_gtk_icon_set_add_source_w, 2, 0, 0, H_gtk_icon_set_add_source);
- XG_DEFINE_PROCEDURE(gtk_icon_set_get_sizes, gxg_gtk_icon_set_get_sizes_w, 1, 2, 0, H_gtk_icon_set_get_sizes);
- XG_DEFINE_PROCEDURE(gtk_icon_source_new, gxg_gtk_icon_source_new_w, 0, 0, 0, H_gtk_icon_source_new);
- XG_DEFINE_PROCEDURE(gtk_icon_source_copy, gxg_gtk_icon_source_copy_w, 1, 0, 0, H_gtk_icon_source_copy);
- XG_DEFINE_PROCEDURE(gtk_icon_source_free, gxg_gtk_icon_source_free_w, 1, 0, 0, H_gtk_icon_source_free);
- XG_DEFINE_PROCEDURE(gtk_icon_source_set_filename, gxg_gtk_icon_source_set_filename_w, 2, 0, 0, H_gtk_icon_source_set_filename);
- XG_DEFINE_PROCEDURE(gtk_icon_source_set_pixbuf, gxg_gtk_icon_source_set_pixbuf_w, 2, 0, 0, H_gtk_icon_source_set_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_filename, gxg_gtk_icon_source_get_filename_w, 1, 0, 0, H_gtk_icon_source_get_filename);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_pixbuf, gxg_gtk_icon_source_get_pixbuf_w, 1, 0, 0, H_gtk_icon_source_get_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_icon_source_set_direction_wildcarded, gxg_gtk_icon_source_set_direction_wildcarded_w, 2, 0, 0, H_gtk_icon_source_set_direction_wildcarded);
- XG_DEFINE_PROCEDURE(gtk_icon_source_set_state_wildcarded, gxg_gtk_icon_source_set_state_wildcarded_w, 2, 0, 0, H_gtk_icon_source_set_state_wildcarded);
- XG_DEFINE_PROCEDURE(gtk_icon_source_set_size_wildcarded, gxg_gtk_icon_source_set_size_wildcarded_w, 2, 0, 0, H_gtk_icon_source_set_size_wildcarded);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_size_wildcarded, gxg_gtk_icon_source_get_size_wildcarded_w, 1, 0, 0, H_gtk_icon_source_get_size_wildcarded);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_state_wildcarded, gxg_gtk_icon_source_get_state_wildcarded_w, 1, 0, 0, H_gtk_icon_source_get_state_wildcarded);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_direction_wildcarded, gxg_gtk_icon_source_get_direction_wildcarded_w, 1, 0, 0, H_gtk_icon_source_get_direction_wildcarded);
- XG_DEFINE_PROCEDURE(gtk_icon_source_set_direction, gxg_gtk_icon_source_set_direction_w, 2, 0, 0, H_gtk_icon_source_set_direction);
- XG_DEFINE_PROCEDURE(gtk_icon_source_set_state, gxg_gtk_icon_source_set_state_w, 2, 0, 0, H_gtk_icon_source_set_state);
- XG_DEFINE_PROCEDURE(gtk_icon_source_set_size, gxg_gtk_icon_source_set_size_w, 2, 0, 0, H_gtk_icon_source_set_size);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_direction, gxg_gtk_icon_source_get_direction_w, 1, 0, 0, H_gtk_icon_source_get_direction);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_state, gxg_gtk_icon_source_get_state_w, 1, 0, 0, H_gtk_icon_source_get_state);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_size, gxg_gtk_icon_source_get_size_w, 1, 0, 0, H_gtk_icon_source_get_size);
- XG_DEFINE_PROCEDURE(gtk_image_new, gxg_gtk_image_new_w, 0, 0, 0, H_gtk_image_new);
- XG_DEFINE_PROCEDURE(gtk_image_new_from_file, gxg_gtk_image_new_from_file_w, 1, 0, 0, H_gtk_image_new_from_file);
- XG_DEFINE_PROCEDURE(gtk_image_new_from_pixbuf, gxg_gtk_image_new_from_pixbuf_w, 1, 0, 0, H_gtk_image_new_from_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_image_new_from_stock, gxg_gtk_image_new_from_stock_w, 2, 0, 0, H_gtk_image_new_from_stock);
- XG_DEFINE_PROCEDURE(gtk_image_new_from_icon_set, gxg_gtk_image_new_from_icon_set_w, 2, 0, 0, H_gtk_image_new_from_icon_set);
- XG_DEFINE_PROCEDURE(gtk_image_new_from_animation, gxg_gtk_image_new_from_animation_w, 1, 0, 0, H_gtk_image_new_from_animation);
- XG_DEFINE_PROCEDURE(gtk_image_set_from_file, gxg_gtk_image_set_from_file_w, 2, 0, 0, H_gtk_image_set_from_file);
- XG_DEFINE_PROCEDURE(gtk_image_set_from_pixbuf, gxg_gtk_image_set_from_pixbuf_w, 2, 0, 0, H_gtk_image_set_from_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_image_set_from_stock, gxg_gtk_image_set_from_stock_w, 3, 0, 0, H_gtk_image_set_from_stock);
- XG_DEFINE_PROCEDURE(gtk_image_set_from_icon_set, gxg_gtk_image_set_from_icon_set_w, 3, 0, 0, H_gtk_image_set_from_icon_set);
- XG_DEFINE_PROCEDURE(gtk_image_set_from_animation, gxg_gtk_image_set_from_animation_w, 2, 0, 0, H_gtk_image_set_from_animation);
- XG_DEFINE_PROCEDURE(gtk_image_get_storage_type, gxg_gtk_image_get_storage_type_w, 1, 0, 0, H_gtk_image_get_storage_type);
- XG_DEFINE_PROCEDURE(gtk_image_get_pixbuf, gxg_gtk_image_get_pixbuf_w, 1, 0, 0, H_gtk_image_get_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_image_get_stock, gxg_gtk_image_get_stock_w, 1, 2, 0, H_gtk_image_get_stock);
- XG_DEFINE_PROCEDURE(gtk_image_get_icon_set, gxg_gtk_image_get_icon_set_w, 1, 2, 0, H_gtk_image_get_icon_set);
- XG_DEFINE_PROCEDURE(gtk_image_get_animation, gxg_gtk_image_get_animation_w, 1, 0, 0, H_gtk_image_get_animation);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_new, gxg_gtk_image_menu_item_new_w, 0, 0, 0, H_gtk_image_menu_item_new);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_new_with_label, gxg_gtk_image_menu_item_new_with_label_w, 1, 0, 0, H_gtk_image_menu_item_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_new_with_mnemonic, gxg_gtk_image_menu_item_new_with_mnemonic_w, 1, 0, 0, H_gtk_image_menu_item_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_new_from_stock, gxg_gtk_image_menu_item_new_from_stock_w, 2, 0, 0, H_gtk_image_menu_item_new_from_stock);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_set_image, gxg_gtk_image_menu_item_set_image_w, 2, 0, 0, H_gtk_image_menu_item_set_image);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_get_image, gxg_gtk_image_menu_item_get_image_w, 1, 0, 0, H_gtk_image_menu_item_get_image);
- XG_DEFINE_PROCEDURE(gtk_im_context_set_client_window, gxg_gtk_im_context_set_client_window_w, 2, 0, 0, H_gtk_im_context_set_client_window);
- XG_DEFINE_PROCEDURE(gtk_im_context_get_preedit_string, gxg_gtk_im_context_get_preedit_string_w, 1, 3, 0, H_gtk_im_context_get_preedit_string);
- XG_DEFINE_PROCEDURE(gtk_im_context_filter_keypress, gxg_gtk_im_context_filter_keypress_w, 2, 0, 0, H_gtk_im_context_filter_keypress);
- XG_DEFINE_PROCEDURE(gtk_im_context_focus_in, gxg_gtk_im_context_focus_in_w, 1, 0, 0, H_gtk_im_context_focus_in);
- XG_DEFINE_PROCEDURE(gtk_im_context_focus_out, gxg_gtk_im_context_focus_out_w, 1, 0, 0, H_gtk_im_context_focus_out);
- XG_DEFINE_PROCEDURE(gtk_im_context_reset, gxg_gtk_im_context_reset_w, 1, 0, 0, H_gtk_im_context_reset);
- XG_DEFINE_PROCEDURE(gtk_im_context_set_cursor_location, gxg_gtk_im_context_set_cursor_location_w, 2, 0, 0, H_gtk_im_context_set_cursor_location);
- XG_DEFINE_PROCEDURE(gtk_im_context_set_use_preedit, gxg_gtk_im_context_set_use_preedit_w, 2, 0, 0, H_gtk_im_context_set_use_preedit);
- XG_DEFINE_PROCEDURE(gtk_im_context_set_surrounding, gxg_gtk_im_context_set_surrounding_w, 4, 0, 0, H_gtk_im_context_set_surrounding);
- XG_DEFINE_PROCEDURE(gtk_im_context_get_surrounding, gxg_gtk_im_context_get_surrounding_w, 1, 2, 0, H_gtk_im_context_get_surrounding);
- XG_DEFINE_PROCEDURE(gtk_im_context_delete_surrounding, gxg_gtk_im_context_delete_surrounding_w, 3, 0, 0, H_gtk_im_context_delete_surrounding);
- XG_DEFINE_PROCEDURE(gtk_im_context_simple_new, gxg_gtk_im_context_simple_new_w, 0, 0, 0, H_gtk_im_context_simple_new);
- XG_DEFINE_PROCEDURE(gtk_im_context_simple_add_table, gxg_gtk_im_context_simple_add_table_w, 4, 0, 0, H_gtk_im_context_simple_add_table);
- XG_DEFINE_PROCEDURE(gtk_im_multicontext_new, gxg_gtk_im_multicontext_new_w, 0, 0, 0, H_gtk_im_multicontext_new);
- XG_DEFINE_PROCEDURE(gtk_im_multicontext_append_menuitems, gxg_gtk_im_multicontext_append_menuitems_w, 2, 0, 0, H_gtk_im_multicontext_append_menuitems);
- XG_DEFINE_PROCEDURE(gtk_invisible_new, gxg_gtk_invisible_new_w, 0, 0, 0, H_gtk_invisible_new);
- XG_DEFINE_PROCEDURE(gtk_label_new, gxg_gtk_label_new_w, 1, 0, 0, H_gtk_label_new);
- XG_DEFINE_PROCEDURE(gtk_label_new_with_mnemonic, gxg_gtk_label_new_with_mnemonic_w, 1, 0, 0, H_gtk_label_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_label_set_text, gxg_gtk_label_set_text_w, 2, 0, 0, H_gtk_label_set_text);
- XG_DEFINE_PROCEDURE(gtk_label_get_text, gxg_gtk_label_get_text_w, 1, 0, 0, H_gtk_label_get_text);
- XG_DEFINE_PROCEDURE(gtk_label_set_attributes, gxg_gtk_label_set_attributes_w, 2, 0, 0, H_gtk_label_set_attributes);
- XG_DEFINE_PROCEDURE(gtk_label_get_attributes, gxg_gtk_label_get_attributes_w, 1, 0, 0, H_gtk_label_get_attributes);
- XG_DEFINE_PROCEDURE(gtk_label_set_label, gxg_gtk_label_set_label_w, 2, 0, 0, H_gtk_label_set_label);
- XG_DEFINE_PROCEDURE(gtk_label_get_label, gxg_gtk_label_get_label_w, 1, 0, 0, H_gtk_label_get_label);
- XG_DEFINE_PROCEDURE(gtk_label_set_markup, gxg_gtk_label_set_markup_w, 2, 0, 0, H_gtk_label_set_markup);
- XG_DEFINE_PROCEDURE(gtk_label_set_use_markup, gxg_gtk_label_set_use_markup_w, 2, 0, 0, H_gtk_label_set_use_markup);
- XG_DEFINE_PROCEDURE(gtk_label_get_use_markup, gxg_gtk_label_get_use_markup_w, 1, 0, 0, H_gtk_label_get_use_markup);
- XG_DEFINE_PROCEDURE(gtk_label_set_use_underline, gxg_gtk_label_set_use_underline_w, 2, 0, 0, H_gtk_label_set_use_underline);
- XG_DEFINE_PROCEDURE(gtk_label_get_use_underline, gxg_gtk_label_get_use_underline_w, 1, 0, 0, H_gtk_label_get_use_underline);
- XG_DEFINE_PROCEDURE(gtk_label_set_markup_with_mnemonic, gxg_gtk_label_set_markup_with_mnemonic_w, 2, 0, 0, H_gtk_label_set_markup_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_label_get_mnemonic_keyval, gxg_gtk_label_get_mnemonic_keyval_w, 1, 0, 0, H_gtk_label_get_mnemonic_keyval);
- XG_DEFINE_PROCEDURE(gtk_label_set_mnemonic_widget, gxg_gtk_label_set_mnemonic_widget_w, 2, 0, 0, H_gtk_label_set_mnemonic_widget);
- XG_DEFINE_PROCEDURE(gtk_label_get_mnemonic_widget, gxg_gtk_label_get_mnemonic_widget_w, 1, 0, 0, H_gtk_label_get_mnemonic_widget);
- XG_DEFINE_PROCEDURE(gtk_label_set_text_with_mnemonic, gxg_gtk_label_set_text_with_mnemonic_w, 2, 0, 0, H_gtk_label_set_text_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_label_set_justify, gxg_gtk_label_set_justify_w, 2, 0, 0, H_gtk_label_set_justify);
- XG_DEFINE_PROCEDURE(gtk_label_get_justify, gxg_gtk_label_get_justify_w, 1, 0, 0, H_gtk_label_get_justify);
- XG_DEFINE_PROCEDURE(gtk_label_set_pattern, gxg_gtk_label_set_pattern_w, 2, 0, 0, H_gtk_label_set_pattern);
- XG_DEFINE_PROCEDURE(gtk_label_set_line_wrap, gxg_gtk_label_set_line_wrap_w, 2, 0, 0, H_gtk_label_set_line_wrap);
- XG_DEFINE_PROCEDURE(gtk_label_get_line_wrap, gxg_gtk_label_get_line_wrap_w, 1, 0, 0, H_gtk_label_get_line_wrap);
- XG_DEFINE_PROCEDURE(gtk_label_set_selectable, gxg_gtk_label_set_selectable_w, 2, 0, 0, H_gtk_label_set_selectable);
- XG_DEFINE_PROCEDURE(gtk_label_get_selectable, gxg_gtk_label_get_selectable_w, 1, 0, 0, H_gtk_label_get_selectable);
- XG_DEFINE_PROCEDURE(gtk_label_select_region, gxg_gtk_label_select_region_w, 3, 0, 0, H_gtk_label_select_region);
- XG_DEFINE_PROCEDURE(gtk_label_get_selection_bounds, gxg_gtk_label_get_selection_bounds_w, 1, 2, 0, H_gtk_label_get_selection_bounds);
- XG_DEFINE_PROCEDURE(gtk_label_get_layout, gxg_gtk_label_get_layout_w, 1, 0, 0, H_gtk_label_get_layout);
- XG_DEFINE_PROCEDURE(gtk_label_get_layout_offsets, gxg_gtk_label_get_layout_offsets_w, 1, 2, 0, H_gtk_label_get_layout_offsets);
- XG_DEFINE_PROCEDURE(gtk_layout_new, gxg_gtk_layout_new_w, 2, 0, 0, H_gtk_layout_new);
- XG_DEFINE_PROCEDURE(gtk_layout_put, gxg_gtk_layout_put_w, 4, 0, 0, H_gtk_layout_put);
- XG_DEFINE_PROCEDURE(gtk_layout_move, gxg_gtk_layout_move_w, 4, 0, 0, H_gtk_layout_move);
- XG_DEFINE_PROCEDURE(gtk_layout_set_size, gxg_gtk_layout_set_size_w, 3, 0, 0, H_gtk_layout_set_size);
- XG_DEFINE_PROCEDURE(gtk_layout_get_size, gxg_gtk_layout_get_size_w, 1, 2, 0, H_gtk_layout_get_size);
- XG_DEFINE_PROCEDURE(gtk_list_store_new, gxg_gtk_list_store_new_w, 2, 0, 0, H_gtk_list_store_new);
- XG_DEFINE_PROCEDURE(gtk_list_store_newv, gxg_gtk_list_store_newv_w, 2, 0, 0, H_gtk_list_store_newv);
- XG_DEFINE_PROCEDURE(gtk_list_store_set_column_types, gxg_gtk_list_store_set_column_types_w, 3, 0, 0, H_gtk_list_store_set_column_types);
- XG_DEFINE_PROCEDURE(gtk_list_store_set, gxg_gtk_list_store_set_w, 3, 0, 0, H_gtk_list_store_set);
- XG_DEFINE_PROCEDURE(gtk_list_store_insert, gxg_gtk_list_store_insert_w, 3, 0, 0, H_gtk_list_store_insert);
- XG_DEFINE_PROCEDURE(gtk_list_store_insert_before, gxg_gtk_list_store_insert_before_w, 3, 0, 0, H_gtk_list_store_insert_before);
- XG_DEFINE_PROCEDURE(gtk_list_store_insert_after, gxg_gtk_list_store_insert_after_w, 3, 0, 0, H_gtk_list_store_insert_after);
- XG_DEFINE_PROCEDURE(gtk_list_store_prepend, gxg_gtk_list_store_prepend_w, 2, 0, 0, H_gtk_list_store_prepend);
- XG_DEFINE_PROCEDURE(gtk_list_store_append, gxg_gtk_list_store_append_w, 2, 0, 0, H_gtk_list_store_append);
- XG_DEFINE_PROCEDURE(gtk_list_store_clear, gxg_gtk_list_store_clear_w, 1, 0, 0, H_gtk_list_store_clear);
- XG_DEFINE_PROCEDURE(gtk_check_version, gxg_gtk_check_version_w, 3, 0, 0, H_gtk_check_version);
- XG_DEFINE_PROCEDURE(gtk_disable_setlocale, gxg_gtk_disable_setlocale_w, 0, 0, 0, H_gtk_disable_setlocale);
- XG_DEFINE_PROCEDURE(gtk_get_default_language, gxg_gtk_get_default_language_w, 0, 0, 0, H_gtk_get_default_language);
- XG_DEFINE_PROCEDURE(gtk_events_pending, gxg_gtk_events_pending_w, 0, 0, 0, H_gtk_events_pending);
- XG_DEFINE_PROCEDURE(gtk_main_do_event, gxg_gtk_main_do_event_w, 1, 0, 0, H_gtk_main_do_event);
- XG_DEFINE_PROCEDURE(gtk_main, gxg_gtk_main_w, 0, 0, 0, H_gtk_main);
- XG_DEFINE_PROCEDURE(gtk_main_level, gxg_gtk_main_level_w, 0, 0, 0, H_gtk_main_level);
- XG_DEFINE_PROCEDURE(gtk_main_quit, gxg_gtk_main_quit_w, 0, 0, 0, H_gtk_main_quit);
- XG_DEFINE_PROCEDURE(gtk_main_iteration, gxg_gtk_main_iteration_w, 0, 0, 0, H_gtk_main_iteration);
- XG_DEFINE_PROCEDURE(gtk_main_iteration_do, gxg_gtk_main_iteration_do_w, 1, 0, 0, H_gtk_main_iteration_do);
- XG_DEFINE_PROCEDURE(gtk_true, gxg_gtk_true_w, 0, 0, 0, H_gtk_true);
- XG_DEFINE_PROCEDURE(gtk_false, gxg_gtk_false_w, 0, 0, 0, H_gtk_false);
- XG_DEFINE_PROCEDURE(gtk_grab_add, gxg_gtk_grab_add_w, 1, 0, 0, H_gtk_grab_add);
- XG_DEFINE_PROCEDURE(gtk_grab_get_current, gxg_gtk_grab_get_current_w, 0, 0, 0, H_gtk_grab_get_current);
- XG_DEFINE_PROCEDURE(gtk_grab_remove, gxg_gtk_grab_remove_w, 1, 0, 0, H_gtk_grab_remove);
- XG_DEFINE_PROCEDURE(gtk_key_snooper_install, gxg_gtk_key_snooper_install_w, 1, 1, 0, H_gtk_key_snooper_install);
- XG_DEFINE_PROCEDURE(gtk_key_snooper_remove, gxg_gtk_key_snooper_remove_w, 1, 0, 0, H_gtk_key_snooper_remove);
- XG_DEFINE_PROCEDURE(gtk_get_current_event, gxg_gtk_get_current_event_w, 0, 0, 0, H_gtk_get_current_event);
- XG_DEFINE_PROCEDURE(gtk_get_current_event_time, gxg_gtk_get_current_event_time_w, 0, 0, 0, H_gtk_get_current_event_time);
- XG_DEFINE_PROCEDURE(gtk_get_current_event_state, gxg_gtk_get_current_event_state_w, 0, 1, 0, H_gtk_get_current_event_state);
- XG_DEFINE_PROCEDURE(gtk_get_event_widget, gxg_gtk_get_event_widget_w, 1, 0, 0, H_gtk_get_event_widget);
- XG_DEFINE_PROCEDURE(gtk_propagate_event, gxg_gtk_propagate_event_w, 2, 0, 0, H_gtk_propagate_event);
- XG_DEFINE_PROCEDURE(gtk_menu_bar_new, gxg_gtk_menu_bar_new_w, 0, 0, 0, H_gtk_menu_bar_new);
- XG_DEFINE_PROCEDURE(gtk_menu_new, gxg_gtk_menu_new_w, 0, 0, 0, H_gtk_menu_new);
- XG_DEFINE_PROCEDURE(gtk_menu_popup, gxg_gtk_menu_popup_w, 7, 0, 0, H_gtk_menu_popup);
- XG_DEFINE_PROCEDURE(gtk_menu_reposition, gxg_gtk_menu_reposition_w, 1, 0, 0, H_gtk_menu_reposition);
- XG_DEFINE_PROCEDURE(gtk_menu_popdown, gxg_gtk_menu_popdown_w, 1, 0, 0, H_gtk_menu_popdown);
- XG_DEFINE_PROCEDURE(gtk_menu_get_active, gxg_gtk_menu_get_active_w, 1, 0, 0, H_gtk_menu_get_active);
- XG_DEFINE_PROCEDURE(gtk_menu_set_active, gxg_gtk_menu_set_active_w, 2, 0, 0, H_gtk_menu_set_active);
- XG_DEFINE_PROCEDURE(gtk_menu_set_accel_group, gxg_gtk_menu_set_accel_group_w, 2, 0, 0, H_gtk_menu_set_accel_group);
- XG_DEFINE_PROCEDURE(gtk_menu_get_accel_group, gxg_gtk_menu_get_accel_group_w, 1, 0, 0, H_gtk_menu_get_accel_group);
- XG_DEFINE_PROCEDURE(gtk_menu_set_accel_path, gxg_gtk_menu_set_accel_path_w, 2, 0, 0, H_gtk_menu_set_accel_path);
- XG_DEFINE_PROCEDURE(gtk_menu_detach, gxg_gtk_menu_detach_w, 1, 0, 0, H_gtk_menu_detach);
- XG_DEFINE_PROCEDURE(gtk_menu_get_attach_widget, gxg_gtk_menu_get_attach_widget_w, 1, 0, 0, H_gtk_menu_get_attach_widget);
- XG_DEFINE_PROCEDURE(gtk_menu_set_tearoff_state, gxg_gtk_menu_set_tearoff_state_w, 2, 0, 0, H_gtk_menu_set_tearoff_state);
- XG_DEFINE_PROCEDURE(gtk_menu_get_tearoff_state, gxg_gtk_menu_get_tearoff_state_w, 1, 0, 0, H_gtk_menu_get_tearoff_state);
- XG_DEFINE_PROCEDURE(gtk_menu_set_title, gxg_gtk_menu_set_title_w, 2, 0, 0, H_gtk_menu_set_title);
- XG_DEFINE_PROCEDURE(gtk_menu_get_title, gxg_gtk_menu_get_title_w, 1, 0, 0, H_gtk_menu_get_title);
- XG_DEFINE_PROCEDURE(gtk_menu_reorder_child, gxg_gtk_menu_reorder_child_w, 3, 0, 0, H_gtk_menu_reorder_child);
- XG_DEFINE_PROCEDURE(gtk_menu_set_monitor, gxg_gtk_menu_set_monitor_w, 2, 0, 0, H_gtk_menu_set_monitor);
- XG_DEFINE_PROCEDURE(gtk_menu_item_new, gxg_gtk_menu_item_new_w, 0, 0, 0, H_gtk_menu_item_new);
- XG_DEFINE_PROCEDURE(gtk_menu_item_new_with_label, gxg_gtk_menu_item_new_with_label_w, 1, 0, 0, H_gtk_menu_item_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_menu_item_new_with_mnemonic, gxg_gtk_menu_item_new_with_mnemonic_w, 1, 0, 0, H_gtk_menu_item_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_menu_item_set_submenu, gxg_gtk_menu_item_set_submenu_w, 2, 0, 0, H_gtk_menu_item_set_submenu);
- XG_DEFINE_PROCEDURE(gtk_menu_item_get_submenu, gxg_gtk_menu_item_get_submenu_w, 1, 0, 0, H_gtk_menu_item_get_submenu);
- XG_DEFINE_PROCEDURE(gtk_menu_item_select, gxg_gtk_menu_item_select_w, 1, 0, 0, H_gtk_menu_item_select);
- XG_DEFINE_PROCEDURE(gtk_menu_item_deselect, gxg_gtk_menu_item_deselect_w, 1, 0, 0, H_gtk_menu_item_deselect);
- XG_DEFINE_PROCEDURE(gtk_menu_item_activate, gxg_gtk_menu_item_activate_w, 1, 0, 0, H_gtk_menu_item_activate);
- XG_DEFINE_PROCEDURE(gtk_menu_item_toggle_size_request, gxg_gtk_menu_item_toggle_size_request_w, 2, 0, 0, H_gtk_menu_item_toggle_size_request);
- XG_DEFINE_PROCEDURE(gtk_menu_item_toggle_size_allocate, gxg_gtk_menu_item_toggle_size_allocate_w, 2, 0, 0, H_gtk_menu_item_toggle_size_allocate);
- XG_DEFINE_PROCEDURE(gtk_menu_item_set_right_justified, gxg_gtk_menu_item_set_right_justified_w, 2, 0, 0, H_gtk_menu_item_set_right_justified);
- XG_DEFINE_PROCEDURE(gtk_menu_item_get_right_justified, gxg_gtk_menu_item_get_right_justified_w, 1, 0, 0, H_gtk_menu_item_get_right_justified);
- XG_DEFINE_PROCEDURE(gtk_menu_item_set_accel_path, gxg_gtk_menu_item_set_accel_path_w, 2, 0, 0, H_gtk_menu_item_set_accel_path);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_append, gxg_gtk_menu_shell_append_w, 2, 0, 0, H_gtk_menu_shell_append);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_prepend, gxg_gtk_menu_shell_prepend_w, 2, 0, 0, H_gtk_menu_shell_prepend);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_insert, gxg_gtk_menu_shell_insert_w, 3, 0, 0, H_gtk_menu_shell_insert);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_deactivate, gxg_gtk_menu_shell_deactivate_w, 1, 0, 0, H_gtk_menu_shell_deactivate);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_select_item, gxg_gtk_menu_shell_select_item_w, 2, 0, 0, H_gtk_menu_shell_select_item);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_deselect, gxg_gtk_menu_shell_deselect_w, 1, 0, 0, H_gtk_menu_shell_deselect);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_activate_item, gxg_gtk_menu_shell_activate_item_w, 3, 0, 0, H_gtk_menu_shell_activate_item);
- XG_DEFINE_PROCEDURE(gtk_misc_set_alignment, gxg_gtk_misc_set_alignment_w, 3, 0, 0, H_gtk_misc_set_alignment);
- XG_DEFINE_PROCEDURE(gtk_misc_get_alignment, gxg_gtk_misc_get_alignment_w, 1, 2, 0, H_gtk_misc_get_alignment);
- XG_DEFINE_PROCEDURE(gtk_misc_set_padding, gxg_gtk_misc_set_padding_w, 3, 0, 0, H_gtk_misc_set_padding);
- XG_DEFINE_PROCEDURE(gtk_misc_get_padding, gxg_gtk_misc_get_padding_w, 1, 2, 0, H_gtk_misc_get_padding);
- XG_DEFINE_PROCEDURE(gtk_notebook_new, gxg_gtk_notebook_new_w, 0, 0, 0, H_gtk_notebook_new);
- XG_DEFINE_PROCEDURE(gtk_notebook_remove_page, gxg_gtk_notebook_remove_page_w, 2, 0, 0, H_gtk_notebook_remove_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_current_page, gxg_gtk_notebook_get_current_page_w, 1, 0, 0, H_gtk_notebook_get_current_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_nth_page, gxg_gtk_notebook_get_nth_page_w, 2, 0, 0, H_gtk_notebook_get_nth_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_page_num, gxg_gtk_notebook_page_num_w, 2, 0, 0, H_gtk_notebook_page_num);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_current_page, gxg_gtk_notebook_set_current_page_w, 2, 0, 0, H_gtk_notebook_set_current_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_next_page, gxg_gtk_notebook_next_page_w, 1, 0, 0, H_gtk_notebook_next_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_prev_page, gxg_gtk_notebook_prev_page_w, 1, 0, 0, H_gtk_notebook_prev_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_show_border, gxg_gtk_notebook_set_show_border_w, 2, 0, 0, H_gtk_notebook_set_show_border);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_show_border, gxg_gtk_notebook_get_show_border_w, 1, 0, 0, H_gtk_notebook_get_show_border);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_show_tabs, gxg_gtk_notebook_set_show_tabs_w, 2, 0, 0, H_gtk_notebook_set_show_tabs);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_show_tabs, gxg_gtk_notebook_get_show_tabs_w, 1, 0, 0, H_gtk_notebook_get_show_tabs);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_tab_pos, gxg_gtk_notebook_set_tab_pos_w, 2, 0, 0, H_gtk_notebook_set_tab_pos);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_tab_pos, gxg_gtk_notebook_get_tab_pos_w, 1, 0, 0, H_gtk_notebook_get_tab_pos);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_scrollable, gxg_gtk_notebook_set_scrollable_w, 2, 0, 0, H_gtk_notebook_set_scrollable);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_scrollable, gxg_gtk_notebook_get_scrollable_w, 1, 0, 0, H_gtk_notebook_get_scrollable);
- XG_DEFINE_PROCEDURE(gtk_notebook_popup_enable, gxg_gtk_notebook_popup_enable_w, 1, 0, 0, H_gtk_notebook_popup_enable);
- XG_DEFINE_PROCEDURE(gtk_notebook_popup_disable, gxg_gtk_notebook_popup_disable_w, 1, 0, 0, H_gtk_notebook_popup_disable);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_tab_label, gxg_gtk_notebook_get_tab_label_w, 2, 0, 0, H_gtk_notebook_get_tab_label);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_tab_label, gxg_gtk_notebook_set_tab_label_w, 3, 0, 0, H_gtk_notebook_set_tab_label);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_tab_label_text, gxg_gtk_notebook_set_tab_label_text_w, 3, 0, 0, H_gtk_notebook_set_tab_label_text);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_tab_label_text, gxg_gtk_notebook_get_tab_label_text_w, 2, 0, 0, H_gtk_notebook_get_tab_label_text);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_menu_label, gxg_gtk_notebook_get_menu_label_w, 2, 0, 0, H_gtk_notebook_get_menu_label);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_menu_label, gxg_gtk_notebook_set_menu_label_w, 3, 0, 0, H_gtk_notebook_set_menu_label);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_menu_label_text, gxg_gtk_notebook_set_menu_label_text_w, 3, 0, 0, H_gtk_notebook_set_menu_label_text);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_menu_label_text, gxg_gtk_notebook_get_menu_label_text_w, 2, 0, 0, H_gtk_notebook_get_menu_label_text);
- XG_DEFINE_PROCEDURE(gtk_notebook_reorder_child, gxg_gtk_notebook_reorder_child_w, 3, 0, 0, H_gtk_notebook_reorder_child);
- XG_DEFINE_PROCEDURE(gtk_notebook_append_page, gxg_gtk_notebook_append_page_w, 3, 0, 0, H_gtk_notebook_append_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_append_page_menu, gxg_gtk_notebook_append_page_menu_w, 4, 0, 0, H_gtk_notebook_append_page_menu);
- XG_DEFINE_PROCEDURE(gtk_notebook_prepend_page, gxg_gtk_notebook_prepend_page_w, 3, 0, 0, H_gtk_notebook_prepend_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_prepend_page_menu, gxg_gtk_notebook_prepend_page_menu_w, 4, 0, 0, H_gtk_notebook_prepend_page_menu);
- XG_DEFINE_PROCEDURE(gtk_notebook_insert_page, gxg_gtk_notebook_insert_page_w, 4, 0, 0, H_gtk_notebook_insert_page);
- XG_DEFINE_PROCEDURE(gtk_notebook_insert_page_menu, gxg_gtk_notebook_insert_page_menu_w, 5, 0, 0, H_gtk_notebook_insert_page_menu);
- XG_DEFINE_PROCEDURE(gtk_paned_add1, gxg_gtk_paned_add1_w, 2, 0, 0, H_gtk_paned_add1);
- XG_DEFINE_PROCEDURE(gtk_paned_add2, gxg_gtk_paned_add2_w, 2, 0, 0, H_gtk_paned_add2);
- XG_DEFINE_PROCEDURE(gtk_paned_pack1, gxg_gtk_paned_pack1_w, 4, 0, 0, H_gtk_paned_pack1);
- XG_DEFINE_PROCEDURE(gtk_paned_pack2, gxg_gtk_paned_pack2_w, 4, 0, 0, H_gtk_paned_pack2);
- XG_DEFINE_PROCEDURE(gtk_paned_get_position, gxg_gtk_paned_get_position_w, 1, 0, 0, H_gtk_paned_get_position);
- XG_DEFINE_PROCEDURE(gtk_paned_set_position, gxg_gtk_paned_set_position_w, 2, 0, 0, H_gtk_paned_set_position);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_new, gxg_gtk_progress_bar_new_w, 0, 0, 0, H_gtk_progress_bar_new);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_pulse, gxg_gtk_progress_bar_pulse_w, 1, 0, 0, H_gtk_progress_bar_pulse);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_set_text, gxg_gtk_progress_bar_set_text_w, 2, 0, 0, H_gtk_progress_bar_set_text);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_set_fraction, gxg_gtk_progress_bar_set_fraction_w, 2, 0, 0, H_gtk_progress_bar_set_fraction);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_set_pulse_step, gxg_gtk_progress_bar_set_pulse_step_w, 2, 0, 0, H_gtk_progress_bar_set_pulse_step);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_get_text, gxg_gtk_progress_bar_get_text_w, 1, 0, 0, H_gtk_progress_bar_get_text);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_get_fraction, gxg_gtk_progress_bar_get_fraction_w, 1, 0, 0, H_gtk_progress_bar_get_fraction);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_get_pulse_step, gxg_gtk_progress_bar_get_pulse_step_w, 1, 0, 0, H_gtk_progress_bar_get_pulse_step);
- XG_DEFINE_PROCEDURE(gtk_radio_button_new, gxg_gtk_radio_button_new_w, 1, 0, 0, H_gtk_radio_button_new);
- XG_DEFINE_PROCEDURE(gtk_radio_button_new_from_widget, gxg_gtk_radio_button_new_from_widget_w, 1, 0, 0, H_gtk_radio_button_new_from_widget);
- XG_DEFINE_PROCEDURE(gtk_radio_button_new_with_label, gxg_gtk_radio_button_new_with_label_w, 2, 0, 0, H_gtk_radio_button_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_radio_button_new_with_label_from_widget, gxg_gtk_radio_button_new_with_label_from_widget_w, 2, 0, 0, H_gtk_radio_button_new_with_label_from_widget);
- XG_DEFINE_PROCEDURE(gtk_radio_button_new_with_mnemonic, gxg_gtk_radio_button_new_with_mnemonic_w, 2, 0, 0, H_gtk_radio_button_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_radio_button_new_with_mnemonic_from_widget, gxg_gtk_radio_button_new_with_mnemonic_from_widget_w, 2, 0, 0, H_gtk_radio_button_new_with_mnemonic_from_widget);
- XG_DEFINE_PROCEDURE(gtk_radio_button_get_group, gxg_gtk_radio_button_get_group_w, 1, 0, 0, H_gtk_radio_button_get_group);
- XG_DEFINE_PROCEDURE(gtk_radio_button_set_group, gxg_gtk_radio_button_set_group_w, 2, 0, 0, H_gtk_radio_button_set_group);
- XG_DEFINE_PROCEDURE(gtk_radio_menu_item_new, gxg_gtk_radio_menu_item_new_w, 1, 0, 0, H_gtk_radio_menu_item_new);
- XG_DEFINE_PROCEDURE(gtk_radio_menu_item_new_with_label, gxg_gtk_radio_menu_item_new_with_label_w, 2, 0, 0, H_gtk_radio_menu_item_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_radio_menu_item_new_with_mnemonic, gxg_gtk_radio_menu_item_new_with_mnemonic_w, 2, 0, 0, H_gtk_radio_menu_item_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_radio_menu_item_get_group, gxg_gtk_radio_menu_item_get_group_w, 1, 0, 0, H_gtk_radio_menu_item_get_group);
- XG_DEFINE_PROCEDURE(gtk_radio_menu_item_set_group, gxg_gtk_radio_menu_item_set_group_w, 2, 0, 0, H_gtk_radio_menu_item_set_group);
- XG_DEFINE_PROCEDURE(gtk_range_set_adjustment, gxg_gtk_range_set_adjustment_w, 2, 0, 0, H_gtk_range_set_adjustment);
- XG_DEFINE_PROCEDURE(gtk_range_get_adjustment, gxg_gtk_range_get_adjustment_w, 1, 0, 0, H_gtk_range_get_adjustment);
- XG_DEFINE_PROCEDURE(gtk_range_set_inverted, gxg_gtk_range_set_inverted_w, 2, 0, 0, H_gtk_range_set_inverted);
- XG_DEFINE_PROCEDURE(gtk_range_get_inverted, gxg_gtk_range_get_inverted_w, 1, 0, 0, H_gtk_range_get_inverted);
- XG_DEFINE_PROCEDURE(gtk_range_set_increments, gxg_gtk_range_set_increments_w, 3, 0, 0, H_gtk_range_set_increments);
- XG_DEFINE_PROCEDURE(gtk_range_set_range, gxg_gtk_range_set_range_w, 3, 0, 0, H_gtk_range_set_range);
- XG_DEFINE_PROCEDURE(gtk_range_set_value, gxg_gtk_range_set_value_w, 2, 0, 0, H_gtk_range_set_value);
- XG_DEFINE_PROCEDURE(gtk_range_get_value, gxg_gtk_range_get_value_w, 1, 0, 0, H_gtk_range_get_value);
- XG_DEFINE_PROCEDURE(gtk_scale_set_digits, gxg_gtk_scale_set_digits_w, 2, 0, 0, H_gtk_scale_set_digits);
- XG_DEFINE_PROCEDURE(gtk_scale_get_digits, gxg_gtk_scale_get_digits_w, 1, 0, 0, H_gtk_scale_get_digits);
- XG_DEFINE_PROCEDURE(gtk_scale_set_draw_value, gxg_gtk_scale_set_draw_value_w, 2, 0, 0, H_gtk_scale_set_draw_value);
- XG_DEFINE_PROCEDURE(gtk_scale_get_draw_value, gxg_gtk_scale_get_draw_value_w, 1, 0, 0, H_gtk_scale_get_draw_value);
- XG_DEFINE_PROCEDURE(gtk_scale_set_value_pos, gxg_gtk_scale_set_value_pos_w, 2, 0, 0, H_gtk_scale_set_value_pos);
- XG_DEFINE_PROCEDURE(gtk_scale_get_value_pos, gxg_gtk_scale_get_value_pos_w, 1, 0, 0, H_gtk_scale_get_value_pos);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_new, gxg_gtk_scrolled_window_new_w, 2, 0, 0, H_gtk_scrolled_window_new);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_set_hadjustment, gxg_gtk_scrolled_window_set_hadjustment_w, 2, 0, 0, H_gtk_scrolled_window_set_hadjustment);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_set_vadjustment, gxg_gtk_scrolled_window_set_vadjustment_w, 2, 0, 0, H_gtk_scrolled_window_set_vadjustment);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_hadjustment, gxg_gtk_scrolled_window_get_hadjustment_w, 1, 0, 0, H_gtk_scrolled_window_get_hadjustment);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_vadjustment, gxg_gtk_scrolled_window_get_vadjustment_w, 1, 0, 0, H_gtk_scrolled_window_get_vadjustment);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_set_policy, gxg_gtk_scrolled_window_set_policy_w, 3, 0, 0, H_gtk_scrolled_window_set_policy);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_policy, gxg_gtk_scrolled_window_get_policy_w, 1, 2, 0, H_gtk_scrolled_window_get_policy);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_set_placement, gxg_gtk_scrolled_window_set_placement_w, 2, 0, 0, H_gtk_scrolled_window_set_placement);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_placement, gxg_gtk_scrolled_window_get_placement_w, 1, 0, 0, H_gtk_scrolled_window_get_placement);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_set_shadow_type, gxg_gtk_scrolled_window_set_shadow_type_w, 2, 0, 0, H_gtk_scrolled_window_set_shadow_type);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_shadow_type, gxg_gtk_scrolled_window_get_shadow_type_w, 1, 0, 0, H_gtk_scrolled_window_get_shadow_type);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_add_with_viewport, gxg_gtk_scrolled_window_add_with_viewport_w, 2, 0, 0, H_gtk_scrolled_window_add_with_viewport);
- XG_DEFINE_PROCEDURE(gtk_target_list_new, gxg_gtk_target_list_new_w, 2, 0, 0, H_gtk_target_list_new);
- XG_DEFINE_PROCEDURE(gtk_target_list_unref, gxg_gtk_target_list_unref_w, 1, 0, 0, H_gtk_target_list_unref);
- XG_DEFINE_PROCEDURE(gtk_target_list_add, gxg_gtk_target_list_add_w, 4, 0, 0, H_gtk_target_list_add);
- XG_DEFINE_PROCEDURE(gtk_target_list_add_table, gxg_gtk_target_list_add_table_w, 3, 0, 0, H_gtk_target_list_add_table);
- XG_DEFINE_PROCEDURE(gtk_target_list_remove, gxg_gtk_target_list_remove_w, 2, 0, 0, H_gtk_target_list_remove);
- XG_DEFINE_PROCEDURE(gtk_target_list_find, gxg_gtk_target_list_find_w, 2, 1, 0, H_gtk_target_list_find);
- XG_DEFINE_PROCEDURE(gtk_selection_owner_set, gxg_gtk_selection_owner_set_w, 3, 0, 0, H_gtk_selection_owner_set);
- XG_DEFINE_PROCEDURE(gtk_selection_add_target, gxg_gtk_selection_add_target_w, 4, 0, 0, H_gtk_selection_add_target);
- XG_DEFINE_PROCEDURE(gtk_selection_add_targets, gxg_gtk_selection_add_targets_w, 4, 0, 0, H_gtk_selection_add_targets);
- XG_DEFINE_PROCEDURE(gtk_selection_clear_targets, gxg_gtk_selection_clear_targets_w, 2, 0, 0, H_gtk_selection_clear_targets);
- XG_DEFINE_PROCEDURE(gtk_selection_convert, gxg_gtk_selection_convert_w, 4, 0, 0, H_gtk_selection_convert);
- XG_DEFINE_PROCEDURE(gtk_selection_data_set, gxg_gtk_selection_data_set_w, 5, 0, 0, H_gtk_selection_data_set);
- XG_DEFINE_PROCEDURE(gtk_selection_data_set_text, gxg_gtk_selection_data_set_text_w, 3, 0, 0, H_gtk_selection_data_set_text);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_text, gxg_gtk_selection_data_get_text_w, 1, 0, 0, H_gtk_selection_data_get_text);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_targets, gxg_gtk_selection_data_get_targets_w, 1, 2, 0, H_gtk_selection_data_get_targets);
- XG_DEFINE_PROCEDURE(gtk_selection_data_targets_include_text, gxg_gtk_selection_data_targets_include_text_w, 1, 0, 0, H_gtk_selection_data_targets_include_text);
- XG_DEFINE_PROCEDURE(gtk_selection_remove_all, gxg_gtk_selection_remove_all_w, 1, 0, 0, H_gtk_selection_remove_all);
- XG_DEFINE_PROCEDURE(gtk_selection_data_copy, gxg_gtk_selection_data_copy_w, 1, 0, 0, H_gtk_selection_data_copy);
- XG_DEFINE_PROCEDURE(gtk_selection_data_free, gxg_gtk_selection_data_free_w, 1, 0, 0, H_gtk_selection_data_free);
- XG_DEFINE_PROCEDURE(gtk_separator_menu_item_new, gxg_gtk_separator_menu_item_new_w, 0, 0, 0, H_gtk_separator_menu_item_new);
- XG_DEFINE_PROCEDURE(gtk_size_group_new, gxg_gtk_size_group_new_w, 1, 0, 0, H_gtk_size_group_new);
- XG_DEFINE_PROCEDURE(gtk_size_group_set_mode, gxg_gtk_size_group_set_mode_w, 2, 0, 0, H_gtk_size_group_set_mode);
- XG_DEFINE_PROCEDURE(gtk_size_group_get_mode, gxg_gtk_size_group_get_mode_w, 1, 0, 0, H_gtk_size_group_get_mode);
- XG_DEFINE_PROCEDURE(gtk_size_group_add_widget, gxg_gtk_size_group_add_widget_w, 2, 0, 0, H_gtk_size_group_add_widget);
- XG_DEFINE_PROCEDURE(gtk_size_group_remove_widget, gxg_gtk_size_group_remove_widget_w, 2, 0, 0, H_gtk_size_group_remove_widget);
- XG_DEFINE_PROCEDURE(gtk_spin_button_configure, gxg_gtk_spin_button_configure_w, 4, 0, 0, H_gtk_spin_button_configure);
- XG_DEFINE_PROCEDURE(gtk_spin_button_new, gxg_gtk_spin_button_new_w, 3, 0, 0, H_gtk_spin_button_new);
- XG_DEFINE_PROCEDURE(gtk_spin_button_new_with_range, gxg_gtk_spin_button_new_with_range_w, 3, 0, 0, H_gtk_spin_button_new_with_range);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_adjustment, gxg_gtk_spin_button_set_adjustment_w, 2, 0, 0, H_gtk_spin_button_set_adjustment);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_adjustment, gxg_gtk_spin_button_get_adjustment_w, 1, 0, 0, H_gtk_spin_button_get_adjustment);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_digits, gxg_gtk_spin_button_set_digits_w, 2, 0, 0, H_gtk_spin_button_set_digits);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_digits, gxg_gtk_spin_button_get_digits_w, 1, 0, 0, H_gtk_spin_button_get_digits);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_increments, gxg_gtk_spin_button_set_increments_w, 3, 0, 0, H_gtk_spin_button_set_increments);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_increments, gxg_gtk_spin_button_get_increments_w, 1, 2, 0, H_gtk_spin_button_get_increments);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_range, gxg_gtk_spin_button_set_range_w, 3, 0, 0, H_gtk_spin_button_set_range);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_range, gxg_gtk_spin_button_get_range_w, 1, 2, 0, H_gtk_spin_button_get_range);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_value, gxg_gtk_spin_button_get_value_w, 1, 0, 0, H_gtk_spin_button_get_value);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_value_as_int, gxg_gtk_spin_button_get_value_as_int_w, 1, 0, 0, H_gtk_spin_button_get_value_as_int);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_value, gxg_gtk_spin_button_set_value_w, 2, 0, 0, H_gtk_spin_button_set_value);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_update_policy, gxg_gtk_spin_button_set_update_policy_w, 2, 0, 0, H_gtk_spin_button_set_update_policy);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_update_policy, gxg_gtk_spin_button_get_update_policy_w, 1, 0, 0, H_gtk_spin_button_get_update_policy);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_numeric, gxg_gtk_spin_button_set_numeric_w, 2, 0, 0, H_gtk_spin_button_set_numeric);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_numeric, gxg_gtk_spin_button_get_numeric_w, 1, 0, 0, H_gtk_spin_button_get_numeric);
- XG_DEFINE_PROCEDURE(gtk_spin_button_spin, gxg_gtk_spin_button_spin_w, 3, 0, 0, H_gtk_spin_button_spin);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_wrap, gxg_gtk_spin_button_set_wrap_w, 2, 0, 0, H_gtk_spin_button_set_wrap);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_wrap, gxg_gtk_spin_button_get_wrap_w, 1, 0, 0, H_gtk_spin_button_get_wrap);
- XG_DEFINE_PROCEDURE(gtk_spin_button_set_snap_to_ticks, gxg_gtk_spin_button_set_snap_to_ticks_w, 2, 0, 0, H_gtk_spin_button_set_snap_to_ticks);
- XG_DEFINE_PROCEDURE(gtk_spin_button_get_snap_to_ticks, gxg_gtk_spin_button_get_snap_to_ticks_w, 1, 0, 0, H_gtk_spin_button_get_snap_to_ticks);
- XG_DEFINE_PROCEDURE(gtk_spin_button_update, gxg_gtk_spin_button_update_w, 1, 0, 0, H_gtk_spin_button_update);
- XG_DEFINE_PROCEDURE(gtk_statusbar_new, gxg_gtk_statusbar_new_w, 0, 0, 0, H_gtk_statusbar_new);
- XG_DEFINE_PROCEDURE(gtk_statusbar_get_context_id, gxg_gtk_statusbar_get_context_id_w, 2, 0, 0, H_gtk_statusbar_get_context_id);
- XG_DEFINE_PROCEDURE(gtk_statusbar_push, gxg_gtk_statusbar_push_w, 3, 0, 0, H_gtk_statusbar_push);
- XG_DEFINE_PROCEDURE(gtk_statusbar_pop, gxg_gtk_statusbar_pop_w, 2, 0, 0, H_gtk_statusbar_pop);
- XG_DEFINE_PROCEDURE(gtk_statusbar_remove, gxg_gtk_statusbar_remove_w, 3, 0, 0, H_gtk_statusbar_remove);
- XG_DEFINE_PROCEDURE(gtk_stock_add, gxg_gtk_stock_add_w, 2, 0, 0, H_gtk_stock_add);
- XG_DEFINE_PROCEDURE(gtk_stock_add_static, gxg_gtk_stock_add_static_w, 2, 0, 0, H_gtk_stock_add_static);
- XG_DEFINE_PROCEDURE(gtk_stock_lookup, gxg_gtk_stock_lookup_w, 2, 0, 0, H_gtk_stock_lookup);
- XG_DEFINE_PROCEDURE(gtk_stock_list_ids, gxg_gtk_stock_list_ids_w, 0, 0, 0, H_gtk_stock_list_ids);
- XG_DEFINE_PROCEDURE(gtk_stock_item_copy, gxg_gtk_stock_item_copy_w, 1, 0, 0, H_gtk_stock_item_copy);
- XG_DEFINE_PROCEDURE(gtk_stock_item_free, gxg_gtk_stock_item_free_w, 1, 0, 0, H_gtk_stock_item_free);
- XG_DEFINE_PROCEDURE(gtk_table_new, gxg_gtk_table_new_w, 3, 0, 0, H_gtk_table_new);
- XG_DEFINE_PROCEDURE(gtk_table_resize, gxg_gtk_table_resize_w, 3, 0, 0, H_gtk_table_resize);
- XG_DEFINE_PROCEDURE(gtk_table_attach, gxg_gtk_table_attach_w, 0, 0, 1, H_gtk_table_attach);
- XG_DEFINE_PROCEDURE(gtk_table_attach_defaults, gxg_gtk_table_attach_defaults_w, 6, 0, 0, H_gtk_table_attach_defaults);
- XG_DEFINE_PROCEDURE(gtk_table_set_row_spacing, gxg_gtk_table_set_row_spacing_w, 3, 0, 0, H_gtk_table_set_row_spacing);
- XG_DEFINE_PROCEDURE(gtk_table_get_row_spacing, gxg_gtk_table_get_row_spacing_w, 2, 0, 0, H_gtk_table_get_row_spacing);
- XG_DEFINE_PROCEDURE(gtk_table_set_col_spacing, gxg_gtk_table_set_col_spacing_w, 3, 0, 0, H_gtk_table_set_col_spacing);
- XG_DEFINE_PROCEDURE(gtk_table_get_col_spacing, gxg_gtk_table_get_col_spacing_w, 2, 0, 0, H_gtk_table_get_col_spacing);
- XG_DEFINE_PROCEDURE(gtk_table_set_row_spacings, gxg_gtk_table_set_row_spacings_w, 2, 0, 0, H_gtk_table_set_row_spacings);
- XG_DEFINE_PROCEDURE(gtk_table_get_default_row_spacing, gxg_gtk_table_get_default_row_spacing_w, 1, 0, 0, H_gtk_table_get_default_row_spacing);
- XG_DEFINE_PROCEDURE(gtk_table_set_col_spacings, gxg_gtk_table_set_col_spacings_w, 2, 0, 0, H_gtk_table_set_col_spacings);
- XG_DEFINE_PROCEDURE(gtk_table_get_default_col_spacing, gxg_gtk_table_get_default_col_spacing_w, 1, 0, 0, H_gtk_table_get_default_col_spacing);
- XG_DEFINE_PROCEDURE(gtk_table_set_homogeneous, gxg_gtk_table_set_homogeneous_w, 2, 0, 0, H_gtk_table_set_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_table_get_homogeneous, gxg_gtk_table_get_homogeneous_w, 1, 0, 0, H_gtk_table_get_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_tearoff_menu_item_new, gxg_gtk_tearoff_menu_item_new_w, 0, 0, 0, H_gtk_tearoff_menu_item_new);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_new, gxg_gtk_text_buffer_new_w, 1, 0, 0, H_gtk_text_buffer_new);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_line_count, gxg_gtk_text_buffer_get_line_count_w, 1, 0, 0, H_gtk_text_buffer_get_line_count);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_char_count, gxg_gtk_text_buffer_get_char_count_w, 1, 0, 0, H_gtk_text_buffer_get_char_count);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_tag_table, gxg_gtk_text_buffer_get_tag_table_w, 1, 0, 0, H_gtk_text_buffer_get_tag_table);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_set_text, gxg_gtk_text_buffer_set_text_w, 3, 0, 0, H_gtk_text_buffer_set_text);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert, gxg_gtk_text_buffer_insert_w, 4, 0, 0, H_gtk_text_buffer_insert);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_at_cursor, gxg_gtk_text_buffer_insert_at_cursor_w, 3, 0, 0, H_gtk_text_buffer_insert_at_cursor);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_interactive, gxg_gtk_text_buffer_insert_interactive_w, 5, 0, 0, H_gtk_text_buffer_insert_interactive);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_interactive_at_cursor, gxg_gtk_text_buffer_insert_interactive_at_cursor_w, 4, 0, 0, H_gtk_text_buffer_insert_interactive_at_cursor);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_range, gxg_gtk_text_buffer_insert_range_w, 4, 0, 0, H_gtk_text_buffer_insert_range);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_range_interactive, gxg_gtk_text_buffer_insert_range_interactive_w, 5, 0, 0, H_gtk_text_buffer_insert_range_interactive);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_with_tags, gxg_gtk_text_buffer_insert_with_tags_w, 5, 0, 0, H_gtk_text_buffer_insert_with_tags);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_with_tags_by_name, gxg_gtk_text_buffer_insert_with_tags_by_name_w, 5, 0, 0, H_gtk_text_buffer_insert_with_tags_by_name);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_delete, gxg_gtk_text_buffer_delete_w, 3, 0, 0, H_gtk_text_buffer_delete);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_delete_interactive, gxg_gtk_text_buffer_delete_interactive_w, 4, 0, 0, H_gtk_text_buffer_delete_interactive);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_text, gxg_gtk_text_buffer_get_text_w, 4, 0, 0, H_gtk_text_buffer_get_text);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_slice, gxg_gtk_text_buffer_get_slice_w, 4, 0, 0, H_gtk_text_buffer_get_slice);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_pixbuf, gxg_gtk_text_buffer_insert_pixbuf_w, 3, 0, 0, H_gtk_text_buffer_insert_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_insert_child_anchor, gxg_gtk_text_buffer_insert_child_anchor_w, 3, 0, 0, H_gtk_text_buffer_insert_child_anchor);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_create_child_anchor, gxg_gtk_text_buffer_create_child_anchor_w, 2, 0, 0, H_gtk_text_buffer_create_child_anchor);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_create_mark, gxg_gtk_text_buffer_create_mark_w, 4, 0, 0, H_gtk_text_buffer_create_mark);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_move_mark, gxg_gtk_text_buffer_move_mark_w, 3, 0, 0, H_gtk_text_buffer_move_mark);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_delete_mark, gxg_gtk_text_buffer_delete_mark_w, 2, 0, 0, H_gtk_text_buffer_delete_mark);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_mark, gxg_gtk_text_buffer_get_mark_w, 2, 0, 0, H_gtk_text_buffer_get_mark);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_move_mark_by_name, gxg_gtk_text_buffer_move_mark_by_name_w, 3, 0, 0, H_gtk_text_buffer_move_mark_by_name);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_delete_mark_by_name, gxg_gtk_text_buffer_delete_mark_by_name_w, 2, 0, 0, H_gtk_text_buffer_delete_mark_by_name);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_insert, gxg_gtk_text_buffer_get_insert_w, 1, 0, 0, H_gtk_text_buffer_get_insert);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_selection_bound, gxg_gtk_text_buffer_get_selection_bound_w, 1, 0, 0, H_gtk_text_buffer_get_selection_bound);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_place_cursor, gxg_gtk_text_buffer_place_cursor_w, 2, 0, 0, H_gtk_text_buffer_place_cursor);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_apply_tag, gxg_gtk_text_buffer_apply_tag_w, 4, 0, 0, H_gtk_text_buffer_apply_tag);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_remove_tag, gxg_gtk_text_buffer_remove_tag_w, 4, 0, 0, H_gtk_text_buffer_remove_tag);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_apply_tag_by_name, gxg_gtk_text_buffer_apply_tag_by_name_w, 4, 0, 0, H_gtk_text_buffer_apply_tag_by_name);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_remove_tag_by_name, gxg_gtk_text_buffer_remove_tag_by_name_w, 4, 0, 0, H_gtk_text_buffer_remove_tag_by_name);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_remove_all_tags, gxg_gtk_text_buffer_remove_all_tags_w, 3, 0, 0, H_gtk_text_buffer_remove_all_tags);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_create_tag, gxg_gtk_text_buffer_create_tag_w, 2, 1, 0, H_gtk_text_buffer_create_tag);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_iter_at_line_offset, gxg_gtk_text_buffer_get_iter_at_line_offset_w, 4, 0, 0, H_gtk_text_buffer_get_iter_at_line_offset);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_iter_at_line_index, gxg_gtk_text_buffer_get_iter_at_line_index_w, 4, 0, 0, H_gtk_text_buffer_get_iter_at_line_index);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_iter_at_offset, gxg_gtk_text_buffer_get_iter_at_offset_w, 3, 0, 0, H_gtk_text_buffer_get_iter_at_offset);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_iter_at_line, gxg_gtk_text_buffer_get_iter_at_line_w, 3, 0, 0, H_gtk_text_buffer_get_iter_at_line);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_start_iter, gxg_gtk_text_buffer_get_start_iter_w, 2, 0, 0, H_gtk_text_buffer_get_start_iter);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_end_iter, gxg_gtk_text_buffer_get_end_iter_w, 2, 0, 0, H_gtk_text_buffer_get_end_iter);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_bounds, gxg_gtk_text_buffer_get_bounds_w, 3, 0, 0, H_gtk_text_buffer_get_bounds);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_iter_at_mark, gxg_gtk_text_buffer_get_iter_at_mark_w, 3, 0, 0, H_gtk_text_buffer_get_iter_at_mark);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_iter_at_child_anchor, gxg_gtk_text_buffer_get_iter_at_child_anchor_w, 3, 0, 0, H_gtk_text_buffer_get_iter_at_child_anchor);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_modified, gxg_gtk_text_buffer_get_modified_w, 1, 0, 0, H_gtk_text_buffer_get_modified);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_set_modified, gxg_gtk_text_buffer_set_modified_w, 2, 0, 0, H_gtk_text_buffer_set_modified);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_add_selection_clipboard, gxg_gtk_text_buffer_add_selection_clipboard_w, 2, 0, 0, H_gtk_text_buffer_add_selection_clipboard);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_remove_selection_clipboard, gxg_gtk_text_buffer_remove_selection_clipboard_w, 2, 0, 0, H_gtk_text_buffer_remove_selection_clipboard);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_cut_clipboard, gxg_gtk_text_buffer_cut_clipboard_w, 3, 0, 0, H_gtk_text_buffer_cut_clipboard);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_copy_clipboard, gxg_gtk_text_buffer_copy_clipboard_w, 2, 0, 0, H_gtk_text_buffer_copy_clipboard);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_paste_clipboard, gxg_gtk_text_buffer_paste_clipboard_w, 4, 0, 0, H_gtk_text_buffer_paste_clipboard);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_selection_bounds, gxg_gtk_text_buffer_get_selection_bounds_w, 3, 0, 0, H_gtk_text_buffer_get_selection_bounds);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_delete_selection, gxg_gtk_text_buffer_delete_selection_w, 3, 0, 0, H_gtk_text_buffer_delete_selection);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_begin_user_action, gxg_gtk_text_buffer_begin_user_action_w, 1, 0, 0, H_gtk_text_buffer_begin_user_action);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_end_user_action, gxg_gtk_text_buffer_end_user_action_w, 1, 0, 0, H_gtk_text_buffer_end_user_action);
- XG_DEFINE_PROCEDURE(gtk_text_child_anchor_new, gxg_gtk_text_child_anchor_new_w, 0, 0, 0, H_gtk_text_child_anchor_new);
- XG_DEFINE_PROCEDURE(gtk_text_child_anchor_get_widgets, gxg_gtk_text_child_anchor_get_widgets_w, 1, 0, 0, H_gtk_text_child_anchor_get_widgets);
- XG_DEFINE_PROCEDURE(gtk_text_child_anchor_get_deleted, gxg_gtk_text_child_anchor_get_deleted_w, 1, 0, 0, H_gtk_text_child_anchor_get_deleted);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_buffer, gxg_gtk_text_iter_get_buffer_w, 1, 0, 0, H_gtk_text_iter_get_buffer);
- XG_DEFINE_PROCEDURE(gtk_text_iter_copy, gxg_gtk_text_iter_copy_w, 1, 0, 0, H_gtk_text_iter_copy);
- XG_DEFINE_PROCEDURE(gtk_text_iter_free, gxg_gtk_text_iter_free_w, 1, 0, 0, H_gtk_text_iter_free);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_offset, gxg_gtk_text_iter_get_offset_w, 1, 0, 0, H_gtk_text_iter_get_offset);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_line, gxg_gtk_text_iter_get_line_w, 1, 0, 0, H_gtk_text_iter_get_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_line_offset, gxg_gtk_text_iter_get_line_offset_w, 1, 0, 0, H_gtk_text_iter_get_line_offset);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_line_index, gxg_gtk_text_iter_get_line_index_w, 1, 0, 0, H_gtk_text_iter_get_line_index);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_visible_line_offset, gxg_gtk_text_iter_get_visible_line_offset_w, 1, 0, 0, H_gtk_text_iter_get_visible_line_offset);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_visible_line_index, gxg_gtk_text_iter_get_visible_line_index_w, 1, 0, 0, H_gtk_text_iter_get_visible_line_index);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_char, gxg_gtk_text_iter_get_char_w, 1, 0, 0, H_gtk_text_iter_get_char);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_slice, gxg_gtk_text_iter_get_slice_w, 2, 0, 0, H_gtk_text_iter_get_slice);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_text, gxg_gtk_text_iter_get_text_w, 2, 0, 0, H_gtk_text_iter_get_text);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_visible_slice, gxg_gtk_text_iter_get_visible_slice_w, 2, 0, 0, H_gtk_text_iter_get_visible_slice);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_visible_text, gxg_gtk_text_iter_get_visible_text_w, 2, 0, 0, H_gtk_text_iter_get_visible_text);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_pixbuf, gxg_gtk_text_iter_get_pixbuf_w, 1, 0, 0, H_gtk_text_iter_get_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_marks, gxg_gtk_text_iter_get_marks_w, 1, 0, 0, H_gtk_text_iter_get_marks);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_child_anchor, gxg_gtk_text_iter_get_child_anchor_w, 1, 0, 0, H_gtk_text_iter_get_child_anchor);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_toggled_tags, gxg_gtk_text_iter_get_toggled_tags_w, 2, 0, 0, H_gtk_text_iter_get_toggled_tags);
- XG_DEFINE_PROCEDURE(gtk_text_iter_begins_tag, gxg_gtk_text_iter_begins_tag_w, 2, 0, 0, H_gtk_text_iter_begins_tag);
- XG_DEFINE_PROCEDURE(gtk_text_iter_ends_tag, gxg_gtk_text_iter_ends_tag_w, 2, 0, 0, H_gtk_text_iter_ends_tag);
- XG_DEFINE_PROCEDURE(gtk_text_iter_toggles_tag, gxg_gtk_text_iter_toggles_tag_w, 2, 0, 0, H_gtk_text_iter_toggles_tag);
- XG_DEFINE_PROCEDURE(gtk_text_iter_has_tag, gxg_gtk_text_iter_has_tag_w, 2, 0, 0, H_gtk_text_iter_has_tag);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_tags, gxg_gtk_text_iter_get_tags_w, 1, 0, 0, H_gtk_text_iter_get_tags);
- XG_DEFINE_PROCEDURE(gtk_text_iter_editable, gxg_gtk_text_iter_editable_w, 2, 0, 0, H_gtk_text_iter_editable);
- XG_DEFINE_PROCEDURE(gtk_text_iter_can_insert, gxg_gtk_text_iter_can_insert_w, 2, 0, 0, H_gtk_text_iter_can_insert);
- XG_DEFINE_PROCEDURE(gtk_text_iter_starts_word, gxg_gtk_text_iter_starts_word_w, 1, 0, 0, H_gtk_text_iter_starts_word);
- XG_DEFINE_PROCEDURE(gtk_text_iter_ends_word, gxg_gtk_text_iter_ends_word_w, 1, 0, 0, H_gtk_text_iter_ends_word);
- XG_DEFINE_PROCEDURE(gtk_text_iter_inside_word, gxg_gtk_text_iter_inside_word_w, 1, 0, 0, H_gtk_text_iter_inside_word);
- XG_DEFINE_PROCEDURE(gtk_text_iter_starts_sentence, gxg_gtk_text_iter_starts_sentence_w, 1, 0, 0, H_gtk_text_iter_starts_sentence);
- XG_DEFINE_PROCEDURE(gtk_text_iter_ends_sentence, gxg_gtk_text_iter_ends_sentence_w, 1, 0, 0, H_gtk_text_iter_ends_sentence);
- XG_DEFINE_PROCEDURE(gtk_text_iter_inside_sentence, gxg_gtk_text_iter_inside_sentence_w, 1, 0, 0, H_gtk_text_iter_inside_sentence);
- XG_DEFINE_PROCEDURE(gtk_text_iter_starts_line, gxg_gtk_text_iter_starts_line_w, 1, 0, 0, H_gtk_text_iter_starts_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_ends_line, gxg_gtk_text_iter_ends_line_w, 1, 0, 0, H_gtk_text_iter_ends_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_is_cursor_position, gxg_gtk_text_iter_is_cursor_position_w, 1, 0, 0, H_gtk_text_iter_is_cursor_position);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_chars_in_line, gxg_gtk_text_iter_get_chars_in_line_w, 1, 0, 0, H_gtk_text_iter_get_chars_in_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_bytes_in_line, gxg_gtk_text_iter_get_bytes_in_line_w, 1, 0, 0, H_gtk_text_iter_get_bytes_in_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_attributes, gxg_gtk_text_iter_get_attributes_w, 2, 0, 0, H_gtk_text_iter_get_attributes);
- XG_DEFINE_PROCEDURE(gtk_text_iter_get_language, gxg_gtk_text_iter_get_language_w, 1, 0, 0, H_gtk_text_iter_get_language);
- XG_DEFINE_PROCEDURE(gtk_text_iter_is_end, gxg_gtk_text_iter_is_end_w, 1, 0, 0, H_gtk_text_iter_is_end);
- XG_DEFINE_PROCEDURE(gtk_text_iter_is_start, gxg_gtk_text_iter_is_start_w, 1, 0, 0, H_gtk_text_iter_is_start);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_char, gxg_gtk_text_iter_forward_char_w, 1, 0, 0, H_gtk_text_iter_forward_char);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_char, gxg_gtk_text_iter_backward_char_w, 1, 0, 0, H_gtk_text_iter_backward_char);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_chars, gxg_gtk_text_iter_forward_chars_w, 2, 0, 0, H_gtk_text_iter_forward_chars);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_chars, gxg_gtk_text_iter_backward_chars_w, 2, 0, 0, H_gtk_text_iter_backward_chars);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_line, gxg_gtk_text_iter_forward_line_w, 1, 0, 0, H_gtk_text_iter_forward_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_line, gxg_gtk_text_iter_backward_line_w, 1, 0, 0, H_gtk_text_iter_backward_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_lines, gxg_gtk_text_iter_forward_lines_w, 2, 0, 0, H_gtk_text_iter_forward_lines);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_lines, gxg_gtk_text_iter_backward_lines_w, 2, 0, 0, H_gtk_text_iter_backward_lines);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_word_end, gxg_gtk_text_iter_forward_word_end_w, 1, 0, 0, H_gtk_text_iter_forward_word_end);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_word_start, gxg_gtk_text_iter_backward_word_start_w, 1, 0, 0, H_gtk_text_iter_backward_word_start);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_word_ends, gxg_gtk_text_iter_forward_word_ends_w, 2, 0, 0, H_gtk_text_iter_forward_word_ends);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_word_starts, gxg_gtk_text_iter_backward_word_starts_w, 2, 0, 0, H_gtk_text_iter_backward_word_starts);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_sentence_end, gxg_gtk_text_iter_forward_sentence_end_w, 1, 0, 0, H_gtk_text_iter_forward_sentence_end);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_sentence_start, gxg_gtk_text_iter_backward_sentence_start_w, 1, 0, 0, H_gtk_text_iter_backward_sentence_start);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_sentence_ends, gxg_gtk_text_iter_forward_sentence_ends_w, 2, 0, 0, H_gtk_text_iter_forward_sentence_ends);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_sentence_starts, gxg_gtk_text_iter_backward_sentence_starts_w, 2, 0, 0, H_gtk_text_iter_backward_sentence_starts);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_cursor_position, gxg_gtk_text_iter_forward_cursor_position_w, 1, 0, 0, H_gtk_text_iter_forward_cursor_position);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_cursor_position, gxg_gtk_text_iter_backward_cursor_position_w, 1, 0, 0, H_gtk_text_iter_backward_cursor_position);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_cursor_positions, gxg_gtk_text_iter_forward_cursor_positions_w, 2, 0, 0, H_gtk_text_iter_forward_cursor_positions);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_cursor_positions, gxg_gtk_text_iter_backward_cursor_positions_w, 2, 0, 0, H_gtk_text_iter_backward_cursor_positions);
- XG_DEFINE_PROCEDURE(gtk_text_iter_set_offset, gxg_gtk_text_iter_set_offset_w, 2, 0, 0, H_gtk_text_iter_set_offset);
- XG_DEFINE_PROCEDURE(gtk_text_iter_set_line, gxg_gtk_text_iter_set_line_w, 2, 0, 0, H_gtk_text_iter_set_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_set_line_offset, gxg_gtk_text_iter_set_line_offset_w, 2, 0, 0, H_gtk_text_iter_set_line_offset);
- XG_DEFINE_PROCEDURE(gtk_text_iter_set_line_index, gxg_gtk_text_iter_set_line_index_w, 2, 0, 0, H_gtk_text_iter_set_line_index);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_to_end, gxg_gtk_text_iter_forward_to_end_w, 1, 0, 0, H_gtk_text_iter_forward_to_end);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_to_line_end, gxg_gtk_text_iter_forward_to_line_end_w, 1, 0, 0, H_gtk_text_iter_forward_to_line_end);
- XG_DEFINE_PROCEDURE(gtk_text_iter_set_visible_line_offset, gxg_gtk_text_iter_set_visible_line_offset_w, 2, 0, 0, H_gtk_text_iter_set_visible_line_offset);
- XG_DEFINE_PROCEDURE(gtk_text_iter_set_visible_line_index, gxg_gtk_text_iter_set_visible_line_index_w, 2, 0, 0, H_gtk_text_iter_set_visible_line_index);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_to_tag_toggle, gxg_gtk_text_iter_forward_to_tag_toggle_w, 2, 0, 0, H_gtk_text_iter_forward_to_tag_toggle);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_to_tag_toggle, gxg_gtk_text_iter_backward_to_tag_toggle_w, 2, 0, 0, H_gtk_text_iter_backward_to_tag_toggle);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_find_char, gxg_gtk_text_iter_forward_find_char_w, 4, 0, 0, H_gtk_text_iter_forward_find_char);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_find_char, gxg_gtk_text_iter_backward_find_char_w, 4, 0, 0, H_gtk_text_iter_backward_find_char);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_search, gxg_gtk_text_iter_forward_search_w, 6, 0, 0, H_gtk_text_iter_forward_search);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_search, gxg_gtk_text_iter_backward_search_w, 6, 0, 0, H_gtk_text_iter_backward_search);
- XG_DEFINE_PROCEDURE(gtk_text_iter_equal, gxg_gtk_text_iter_equal_w, 2, 0, 0, H_gtk_text_iter_equal);
- XG_DEFINE_PROCEDURE(gtk_text_iter_compare, gxg_gtk_text_iter_compare_w, 2, 0, 0, H_gtk_text_iter_compare);
- XG_DEFINE_PROCEDURE(gtk_text_iter_in_range, gxg_gtk_text_iter_in_range_w, 3, 0, 0, H_gtk_text_iter_in_range);
- XG_DEFINE_PROCEDURE(gtk_text_iter_order, gxg_gtk_text_iter_order_w, 2, 0, 0, H_gtk_text_iter_order);
- XG_DEFINE_PROCEDURE(gtk_text_mark_set_visible, gxg_gtk_text_mark_set_visible_w, 2, 0, 0, H_gtk_text_mark_set_visible);
- XG_DEFINE_PROCEDURE(gtk_text_mark_get_visible, gxg_gtk_text_mark_get_visible_w, 1, 0, 0, H_gtk_text_mark_get_visible);
- XG_DEFINE_PROCEDURE(gtk_text_mark_get_name, gxg_gtk_text_mark_get_name_w, 1, 0, 0, H_gtk_text_mark_get_name);
- XG_DEFINE_PROCEDURE(gtk_text_mark_get_deleted, gxg_gtk_text_mark_get_deleted_w, 1, 0, 0, H_gtk_text_mark_get_deleted);
- XG_DEFINE_PROCEDURE(gtk_text_mark_get_buffer, gxg_gtk_text_mark_get_buffer_w, 1, 0, 0, H_gtk_text_mark_get_buffer);
- XG_DEFINE_PROCEDURE(gtk_text_mark_get_left_gravity, gxg_gtk_text_mark_get_left_gravity_w, 1, 0, 0, H_gtk_text_mark_get_left_gravity);
- XG_DEFINE_PROCEDURE(gtk_text_tag_new, gxg_gtk_text_tag_new_w, 1, 0, 0, H_gtk_text_tag_new);
- XG_DEFINE_PROCEDURE(gtk_text_tag_get_priority, gxg_gtk_text_tag_get_priority_w, 1, 0, 0, H_gtk_text_tag_get_priority);
- XG_DEFINE_PROCEDURE(gtk_text_tag_set_priority, gxg_gtk_text_tag_set_priority_w, 2, 0, 0, H_gtk_text_tag_set_priority);
- XG_DEFINE_PROCEDURE(gtk_text_tag_event, gxg_gtk_text_tag_event_w, 4, 0, 0, H_gtk_text_tag_event);
- XG_DEFINE_PROCEDURE(gtk_text_attributes_new, gxg_gtk_text_attributes_new_w, 0, 0, 0, H_gtk_text_attributes_new);
- XG_DEFINE_PROCEDURE(gtk_text_attributes_copy, gxg_gtk_text_attributes_copy_w, 1, 0, 0, H_gtk_text_attributes_copy);
- XG_DEFINE_PROCEDURE(gtk_text_attributes_copy_values, gxg_gtk_text_attributes_copy_values_w, 2, 0, 0, H_gtk_text_attributes_copy_values);
- XG_DEFINE_PROCEDURE(gtk_text_attributes_unref, gxg_gtk_text_attributes_unref_w, 1, 0, 0, H_gtk_text_attributes_unref);
- XG_DEFINE_PROCEDURE(gtk_text_tag_table_new, gxg_gtk_text_tag_table_new_w, 0, 0, 0, H_gtk_text_tag_table_new);
- XG_DEFINE_PROCEDURE(gtk_text_tag_table_add, gxg_gtk_text_tag_table_add_w, 2, 0, 0, H_gtk_text_tag_table_add);
- XG_DEFINE_PROCEDURE(gtk_text_tag_table_remove, gxg_gtk_text_tag_table_remove_w, 2, 0, 0, H_gtk_text_tag_table_remove);
- XG_DEFINE_PROCEDURE(gtk_text_tag_table_lookup, gxg_gtk_text_tag_table_lookup_w, 2, 0, 0, H_gtk_text_tag_table_lookup);
- XG_DEFINE_PROCEDURE(gtk_text_tag_table_foreach, gxg_gtk_text_tag_table_foreach_w, 2, 1, 0, H_gtk_text_tag_table_foreach);
- XG_DEFINE_PROCEDURE(gtk_text_tag_table_get_size, gxg_gtk_text_tag_table_get_size_w, 1, 0, 0, H_gtk_text_tag_table_get_size);
- XG_DEFINE_PROCEDURE(gtk_text_view_new, gxg_gtk_text_view_new_w, 0, 0, 0, H_gtk_text_view_new);
- XG_DEFINE_PROCEDURE(gtk_text_view_new_with_buffer, gxg_gtk_text_view_new_with_buffer_w, 1, 0, 0, H_gtk_text_view_new_with_buffer);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_buffer, gxg_gtk_text_view_set_buffer_w, 2, 0, 0, H_gtk_text_view_set_buffer);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_buffer, gxg_gtk_text_view_get_buffer_w, 1, 0, 0, H_gtk_text_view_get_buffer);
- XG_DEFINE_PROCEDURE(gtk_text_view_scroll_to_iter, gxg_gtk_text_view_scroll_to_iter_w, 6, 0, 0, H_gtk_text_view_scroll_to_iter);
- XG_DEFINE_PROCEDURE(gtk_text_view_scroll_to_mark, gxg_gtk_text_view_scroll_to_mark_w, 6, 0, 0, H_gtk_text_view_scroll_to_mark);
- XG_DEFINE_PROCEDURE(gtk_text_view_scroll_mark_onscreen, gxg_gtk_text_view_scroll_mark_onscreen_w, 2, 0, 0, H_gtk_text_view_scroll_mark_onscreen);
- XG_DEFINE_PROCEDURE(gtk_text_view_move_mark_onscreen, gxg_gtk_text_view_move_mark_onscreen_w, 2, 0, 0, H_gtk_text_view_move_mark_onscreen);
- XG_DEFINE_PROCEDURE(gtk_text_view_place_cursor_onscreen, gxg_gtk_text_view_place_cursor_onscreen_w, 1, 0, 0, H_gtk_text_view_place_cursor_onscreen);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_visible_rect, gxg_gtk_text_view_get_visible_rect_w, 2, 0, 0, H_gtk_text_view_get_visible_rect);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_cursor_visible, gxg_gtk_text_view_set_cursor_visible_w, 2, 0, 0, H_gtk_text_view_set_cursor_visible);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_cursor_visible, gxg_gtk_text_view_get_cursor_visible_w, 1, 0, 0, H_gtk_text_view_get_cursor_visible);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_iter_location, gxg_gtk_text_view_get_iter_location_w, 3, 0, 0, H_gtk_text_view_get_iter_location);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_iter_at_location, gxg_gtk_text_view_get_iter_at_location_w, 4, 0, 0, H_gtk_text_view_get_iter_at_location);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_line_yrange, gxg_gtk_text_view_get_line_yrange_w, 2, 2, 0, H_gtk_text_view_get_line_yrange);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_line_at_y, gxg_gtk_text_view_get_line_at_y_w, 3, 1, 0, H_gtk_text_view_get_line_at_y);
- XG_DEFINE_PROCEDURE(gtk_text_view_buffer_to_window_coords, gxg_gtk_text_view_buffer_to_window_coords_w, 4, 2, 0, H_gtk_text_view_buffer_to_window_coords);
- XG_DEFINE_PROCEDURE(gtk_text_view_window_to_buffer_coords, gxg_gtk_text_view_window_to_buffer_coords_w, 4, 2, 0, H_gtk_text_view_window_to_buffer_coords);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_window, gxg_gtk_text_view_get_window_w, 2, 0, 0, H_gtk_text_view_get_window);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_window_type, gxg_gtk_text_view_get_window_type_w, 2, 0, 0, H_gtk_text_view_get_window_type);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_border_window_size, gxg_gtk_text_view_set_border_window_size_w, 3, 0, 0, H_gtk_text_view_set_border_window_size);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_border_window_size, gxg_gtk_text_view_get_border_window_size_w, 2, 0, 0, H_gtk_text_view_get_border_window_size);
- XG_DEFINE_PROCEDURE(gtk_text_view_forward_display_line, gxg_gtk_text_view_forward_display_line_w, 2, 0, 0, H_gtk_text_view_forward_display_line);
- XG_DEFINE_PROCEDURE(gtk_text_view_backward_display_line, gxg_gtk_text_view_backward_display_line_w, 2, 0, 0, H_gtk_text_view_backward_display_line);
- XG_DEFINE_PROCEDURE(gtk_text_view_forward_display_line_end, gxg_gtk_text_view_forward_display_line_end_w, 2, 0, 0, H_gtk_text_view_forward_display_line_end);
- XG_DEFINE_PROCEDURE(gtk_text_view_backward_display_line_start, gxg_gtk_text_view_backward_display_line_start_w, 2, 0, 0, H_gtk_text_view_backward_display_line_start);
- XG_DEFINE_PROCEDURE(gtk_text_view_starts_display_line, gxg_gtk_text_view_starts_display_line_w, 2, 0, 0, H_gtk_text_view_starts_display_line);
- XG_DEFINE_PROCEDURE(gtk_text_view_move_visually, gxg_gtk_text_view_move_visually_w, 3, 0, 0, H_gtk_text_view_move_visually);
- XG_DEFINE_PROCEDURE(gtk_text_view_add_child_at_anchor, gxg_gtk_text_view_add_child_at_anchor_w, 3, 0, 0, H_gtk_text_view_add_child_at_anchor);
- XG_DEFINE_PROCEDURE(gtk_text_view_add_child_in_window, gxg_gtk_text_view_add_child_in_window_w, 5, 0, 0, H_gtk_text_view_add_child_in_window);
- XG_DEFINE_PROCEDURE(gtk_text_view_move_child, gxg_gtk_text_view_move_child_w, 4, 0, 0, H_gtk_text_view_move_child);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_wrap_mode, gxg_gtk_text_view_set_wrap_mode_w, 2, 0, 0, H_gtk_text_view_set_wrap_mode);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_wrap_mode, gxg_gtk_text_view_get_wrap_mode_w, 1, 0, 0, H_gtk_text_view_get_wrap_mode);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_editable, gxg_gtk_text_view_set_editable_w, 2, 0, 0, H_gtk_text_view_set_editable);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_editable, gxg_gtk_text_view_get_editable_w, 1, 0, 0, H_gtk_text_view_get_editable);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_pixels_above_lines, gxg_gtk_text_view_set_pixels_above_lines_w, 2, 0, 0, H_gtk_text_view_set_pixels_above_lines);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_pixels_above_lines, gxg_gtk_text_view_get_pixels_above_lines_w, 1, 0, 0, H_gtk_text_view_get_pixels_above_lines);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_pixels_below_lines, gxg_gtk_text_view_set_pixels_below_lines_w, 2, 0, 0, H_gtk_text_view_set_pixels_below_lines);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_pixels_below_lines, gxg_gtk_text_view_get_pixels_below_lines_w, 1, 0, 0, H_gtk_text_view_get_pixels_below_lines);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_pixels_inside_wrap, gxg_gtk_text_view_set_pixels_inside_wrap_w, 2, 0, 0, H_gtk_text_view_set_pixels_inside_wrap);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_pixels_inside_wrap, gxg_gtk_text_view_get_pixels_inside_wrap_w, 1, 0, 0, H_gtk_text_view_get_pixels_inside_wrap);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_justification, gxg_gtk_text_view_set_justification_w, 2, 0, 0, H_gtk_text_view_set_justification);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_justification, gxg_gtk_text_view_get_justification_w, 1, 0, 0, H_gtk_text_view_get_justification);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_left_margin, gxg_gtk_text_view_set_left_margin_w, 2, 0, 0, H_gtk_text_view_set_left_margin);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_left_margin, gxg_gtk_text_view_get_left_margin_w, 1, 0, 0, H_gtk_text_view_get_left_margin);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_right_margin, gxg_gtk_text_view_set_right_margin_w, 2, 0, 0, H_gtk_text_view_set_right_margin);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_right_margin, gxg_gtk_text_view_get_right_margin_w, 1, 0, 0, H_gtk_text_view_get_right_margin);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_indent, gxg_gtk_text_view_set_indent_w, 2, 0, 0, H_gtk_text_view_set_indent);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_indent, gxg_gtk_text_view_get_indent_w, 1, 0, 0, H_gtk_text_view_get_indent);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_tabs, gxg_gtk_text_view_set_tabs_w, 2, 0, 0, H_gtk_text_view_set_tabs);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_tabs, gxg_gtk_text_view_get_tabs_w, 1, 0, 0, H_gtk_text_view_get_tabs);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_default_attributes, gxg_gtk_text_view_get_default_attributes_w, 1, 0, 0, H_gtk_text_view_get_default_attributes);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_new, gxg_gtk_toggle_button_new_w, 0, 0, 0, H_gtk_toggle_button_new);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_new_with_label, gxg_gtk_toggle_button_new_with_label_w, 1, 0, 0, H_gtk_toggle_button_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_new_with_mnemonic, gxg_gtk_toggle_button_new_with_mnemonic_w, 1, 0, 0, H_gtk_toggle_button_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_set_mode, gxg_gtk_toggle_button_set_mode_w, 2, 0, 0, H_gtk_toggle_button_set_mode);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_get_mode, gxg_gtk_toggle_button_get_mode_w, 1, 0, 0, H_gtk_toggle_button_get_mode);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_set_active, gxg_gtk_toggle_button_set_active_w, 2, 0, 0, H_gtk_toggle_button_set_active);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_get_active, gxg_gtk_toggle_button_get_active_w, 1, 0, 0, H_gtk_toggle_button_get_active);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_toggled, gxg_gtk_toggle_button_toggled_w, 1, 0, 0, H_gtk_toggle_button_toggled);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_set_inconsistent, gxg_gtk_toggle_button_set_inconsistent_w, 2, 0, 0, H_gtk_toggle_button_set_inconsistent);
- XG_DEFINE_PROCEDURE(gtk_toggle_button_get_inconsistent, gxg_gtk_toggle_button_get_inconsistent_w, 1, 0, 0, H_gtk_toggle_button_get_inconsistent);
- XG_DEFINE_PROCEDURE(gtk_toolbar_new, gxg_gtk_toolbar_new_w, 0, 0, 0, H_gtk_toolbar_new);
- XG_DEFINE_PROCEDURE(gtk_toolbar_set_style, gxg_gtk_toolbar_set_style_w, 2, 0, 0, H_gtk_toolbar_set_style);
- XG_DEFINE_PROCEDURE(gtk_toolbar_unset_style, gxg_gtk_toolbar_unset_style_w, 1, 0, 0, H_gtk_toolbar_unset_style);
- XG_DEFINE_PROCEDURE(gtk_toolbar_get_style, gxg_gtk_toolbar_get_style_w, 1, 0, 0, H_gtk_toolbar_get_style);
- XG_DEFINE_PROCEDURE(gtk_toolbar_get_icon_size, gxg_gtk_toolbar_get_icon_size_w, 1, 0, 0, H_gtk_toolbar_get_icon_size);
- XG_DEFINE_PROCEDURE(gtk_tree_drag_source_row_draggable, gxg_gtk_tree_drag_source_row_draggable_w, 2, 0, 0, H_gtk_tree_drag_source_row_draggable);
- XG_DEFINE_PROCEDURE(gtk_tree_drag_source_drag_data_delete, gxg_gtk_tree_drag_source_drag_data_delete_w, 2, 0, 0, H_gtk_tree_drag_source_drag_data_delete);
- XG_DEFINE_PROCEDURE(gtk_tree_drag_source_drag_data_get, gxg_gtk_tree_drag_source_drag_data_get_w, 3, 0, 0, H_gtk_tree_drag_source_drag_data_get);
- XG_DEFINE_PROCEDURE(gtk_tree_drag_dest_drag_data_received, gxg_gtk_tree_drag_dest_drag_data_received_w, 3, 0, 0, H_gtk_tree_drag_dest_drag_data_received);
- XG_DEFINE_PROCEDURE(gtk_tree_drag_dest_row_drop_possible, gxg_gtk_tree_drag_dest_row_drop_possible_w, 3, 0, 0, H_gtk_tree_drag_dest_row_drop_possible);
- XG_DEFINE_PROCEDURE(gtk_tree_set_row_drag_data, gxg_gtk_tree_set_row_drag_data_w, 3, 0, 0, H_gtk_tree_set_row_drag_data);
- XG_DEFINE_PROCEDURE(gtk_tree_get_row_drag_data, gxg_gtk_tree_get_row_drag_data_w, 1, 2, 0, H_gtk_tree_get_row_drag_data);
- XG_DEFINE_PROCEDURE(gtk_tree_path_new, gxg_gtk_tree_path_new_w, 0, 0, 0, H_gtk_tree_path_new);
- XG_DEFINE_PROCEDURE(gtk_tree_path_new_from_string, gxg_gtk_tree_path_new_from_string_w, 1, 0, 0, H_gtk_tree_path_new_from_string);
- XG_DEFINE_PROCEDURE(gtk_tree_path_to_string, gxg_gtk_tree_path_to_string_w, 1, 0, 0, H_gtk_tree_path_to_string);
- XG_DEFINE_PROCEDURE(gtk_tree_path_new_first, gxg_gtk_tree_path_new_first_w, 0, 0, 0, H_gtk_tree_path_new_first);
- XG_DEFINE_PROCEDURE(gtk_tree_path_append_index, gxg_gtk_tree_path_append_index_w, 2, 0, 0, H_gtk_tree_path_append_index);
- XG_DEFINE_PROCEDURE(gtk_tree_path_prepend_index, gxg_gtk_tree_path_prepend_index_w, 2, 0, 0, H_gtk_tree_path_prepend_index);
- XG_DEFINE_PROCEDURE(gtk_tree_path_get_depth, gxg_gtk_tree_path_get_depth_w, 1, 0, 0, H_gtk_tree_path_get_depth);
- XG_DEFINE_PROCEDURE(gtk_tree_path_get_indices, gxg_gtk_tree_path_get_indices_w, 1, 0, 0, H_gtk_tree_path_get_indices);
- XG_DEFINE_PROCEDURE(gtk_tree_path_free, gxg_gtk_tree_path_free_w, 1, 0, 0, H_gtk_tree_path_free);
- XG_DEFINE_PROCEDURE(gtk_tree_path_copy, gxg_gtk_tree_path_copy_w, 1, 0, 0, H_gtk_tree_path_copy);
- XG_DEFINE_PROCEDURE(gtk_tree_path_compare, gxg_gtk_tree_path_compare_w, 2, 0, 0, H_gtk_tree_path_compare);
- XG_DEFINE_PROCEDURE(gtk_tree_path_next, gxg_gtk_tree_path_next_w, 1, 0, 0, H_gtk_tree_path_next);
- XG_DEFINE_PROCEDURE(gtk_tree_path_prev, gxg_gtk_tree_path_prev_w, 1, 0, 0, H_gtk_tree_path_prev);
- XG_DEFINE_PROCEDURE(gtk_tree_path_up, gxg_gtk_tree_path_up_w, 1, 0, 0, H_gtk_tree_path_up);
- XG_DEFINE_PROCEDURE(gtk_tree_path_down, gxg_gtk_tree_path_down_w, 1, 0, 0, H_gtk_tree_path_down);
- XG_DEFINE_PROCEDURE(gtk_tree_path_is_ancestor, gxg_gtk_tree_path_is_ancestor_w, 2, 0, 0, H_gtk_tree_path_is_ancestor);
- XG_DEFINE_PROCEDURE(gtk_tree_path_is_descendant, gxg_gtk_tree_path_is_descendant_w, 2, 0, 0, H_gtk_tree_path_is_descendant);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_new, gxg_gtk_tree_row_reference_new_w, 2, 0, 0, H_gtk_tree_row_reference_new);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_new_proxy, gxg_gtk_tree_row_reference_new_proxy_w, 3, 0, 0, H_gtk_tree_row_reference_new_proxy);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_get_path, gxg_gtk_tree_row_reference_get_path_w, 1, 0, 0, H_gtk_tree_row_reference_get_path);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_valid, gxg_gtk_tree_row_reference_valid_w, 1, 0, 0, H_gtk_tree_row_reference_valid);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_free, gxg_gtk_tree_row_reference_free_w, 1, 0, 0, H_gtk_tree_row_reference_free);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_inserted, gxg_gtk_tree_row_reference_inserted_w, 2, 0, 0, H_gtk_tree_row_reference_inserted);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_deleted, gxg_gtk_tree_row_reference_deleted_w, 2, 0, 0, H_gtk_tree_row_reference_deleted);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_reordered, gxg_gtk_tree_row_reference_reordered_w, 4, 0, 0, H_gtk_tree_row_reference_reordered);
- XG_DEFINE_PROCEDURE(gtk_tree_iter_copy, gxg_gtk_tree_iter_copy_w, 1, 0, 0, H_gtk_tree_iter_copy);
- XG_DEFINE_PROCEDURE(gtk_tree_iter_free, gxg_gtk_tree_iter_free_w, 1, 0, 0, H_gtk_tree_iter_free);
- XG_DEFINE_PROCEDURE(gtk_tree_model_get_flags, gxg_gtk_tree_model_get_flags_w, 1, 0, 0, H_gtk_tree_model_get_flags);
- XG_DEFINE_PROCEDURE(gtk_tree_model_get_n_columns, gxg_gtk_tree_model_get_n_columns_w, 1, 0, 0, H_gtk_tree_model_get_n_columns);
- XG_DEFINE_PROCEDURE(gtk_tree_model_get_column_type, gxg_gtk_tree_model_get_column_type_w, 2, 0, 0, H_gtk_tree_model_get_column_type);
- XG_DEFINE_PROCEDURE(gtk_tree_model_get_iter, gxg_gtk_tree_model_get_iter_w, 3, 0, 0, H_gtk_tree_model_get_iter);
- XG_DEFINE_PROCEDURE(gtk_tree_model_get_iter_from_string, gxg_gtk_tree_model_get_iter_from_string_w, 3, 0, 0, H_gtk_tree_model_get_iter_from_string);
- XG_DEFINE_PROCEDURE(gtk_tree_model_get_iter_first, gxg_gtk_tree_model_get_iter_first_w, 2, 0, 0, H_gtk_tree_model_get_iter_first);
- XG_DEFINE_PROCEDURE(gtk_tree_model_get_path, gxg_gtk_tree_model_get_path_w, 2, 0, 0, H_gtk_tree_model_get_path);
- XG_DEFINE_PROCEDURE(gtk_tree_model_iter_next, gxg_gtk_tree_model_iter_next_w, 2, 0, 0, H_gtk_tree_model_iter_next);
- XG_DEFINE_PROCEDURE(gtk_tree_model_iter_children, gxg_gtk_tree_model_iter_children_w, 3, 0, 0, H_gtk_tree_model_iter_children);
- XG_DEFINE_PROCEDURE(gtk_tree_model_iter_has_child, gxg_gtk_tree_model_iter_has_child_w, 2, 0, 0, H_gtk_tree_model_iter_has_child);
- XG_DEFINE_PROCEDURE(gtk_tree_model_iter_n_children, gxg_gtk_tree_model_iter_n_children_w, 2, 0, 0, H_gtk_tree_model_iter_n_children);
- XG_DEFINE_PROCEDURE(gtk_tree_model_iter_nth_child, gxg_gtk_tree_model_iter_nth_child_w, 4, 0, 0, H_gtk_tree_model_iter_nth_child);
- XG_DEFINE_PROCEDURE(gtk_tree_model_iter_parent, gxg_gtk_tree_model_iter_parent_w, 3, 0, 0, H_gtk_tree_model_iter_parent);
- XG_DEFINE_PROCEDURE(gtk_tree_model_ref_node, gxg_gtk_tree_model_ref_node_w, 2, 0, 0, H_gtk_tree_model_ref_node);
- XG_DEFINE_PROCEDURE(gtk_tree_model_unref_node, gxg_gtk_tree_model_unref_node_w, 2, 0, 0, H_gtk_tree_model_unref_node);
- XG_DEFINE_PROCEDURE(gtk_tree_model_foreach, gxg_gtk_tree_model_foreach_w, 2, 1, 0, H_gtk_tree_model_foreach);
- XG_DEFINE_PROCEDURE(gtk_tree_model_row_changed, gxg_gtk_tree_model_row_changed_w, 3, 0, 0, H_gtk_tree_model_row_changed);
- XG_DEFINE_PROCEDURE(gtk_tree_model_row_inserted, gxg_gtk_tree_model_row_inserted_w, 3, 0, 0, H_gtk_tree_model_row_inserted);
- XG_DEFINE_PROCEDURE(gtk_tree_model_row_has_child_toggled, gxg_gtk_tree_model_row_has_child_toggled_w, 3, 0, 0, H_gtk_tree_model_row_has_child_toggled);
- XG_DEFINE_PROCEDURE(gtk_tree_model_row_deleted, gxg_gtk_tree_model_row_deleted_w, 2, 0, 0, H_gtk_tree_model_row_deleted);
- XG_DEFINE_PROCEDURE(gtk_tree_model_rows_reordered, gxg_gtk_tree_model_rows_reordered_w, 4, 0, 0, H_gtk_tree_model_rows_reordered);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_new_with_model, gxg_gtk_tree_model_sort_new_with_model_w, 1, 0, 0, H_gtk_tree_model_sort_new_with_model);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_get_model, gxg_gtk_tree_model_sort_get_model_w, 1, 0, 0, H_gtk_tree_model_sort_get_model);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_convert_child_path_to_path, gxg_gtk_tree_model_sort_convert_child_path_to_path_w, 2, 0, 0, H_gtk_tree_model_sort_convert_child_path_to_path);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_convert_child_iter_to_iter, gxg_gtk_tree_model_sort_convert_child_iter_to_iter_w, 3, 0, 0, H_gtk_tree_model_sort_convert_child_iter_to_iter);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_convert_path_to_child_path, gxg_gtk_tree_model_sort_convert_path_to_child_path_w, 2, 0, 0, H_gtk_tree_model_sort_convert_path_to_child_path);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_convert_iter_to_child_iter, gxg_gtk_tree_model_sort_convert_iter_to_child_iter_w, 3, 0, 0, H_gtk_tree_model_sort_convert_iter_to_child_iter);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_reset_default_sort_func, gxg_gtk_tree_model_sort_reset_default_sort_func_w, 1, 0, 0, H_gtk_tree_model_sort_reset_default_sort_func);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_clear_cache, gxg_gtk_tree_model_sort_clear_cache_w, 1, 0, 0, H_gtk_tree_model_sort_clear_cache);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_set_mode, gxg_gtk_tree_selection_set_mode_w, 2, 0, 0, H_gtk_tree_selection_set_mode);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_get_mode, gxg_gtk_tree_selection_get_mode_w, 1, 0, 0, H_gtk_tree_selection_get_mode);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_set_select_function, gxg_gtk_tree_selection_set_select_function_w, 4, 0, 0, H_gtk_tree_selection_set_select_function);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_get_user_data, gxg_gtk_tree_selection_get_user_data_w, 1, 0, 0, H_gtk_tree_selection_get_user_data);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_get_tree_view, gxg_gtk_tree_selection_get_tree_view_w, 1, 0, 0, H_gtk_tree_selection_get_tree_view);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_get_selected, gxg_gtk_tree_selection_get_selected_w, 3, 0, 0, H_gtk_tree_selection_get_selected);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_selected_foreach, gxg_gtk_tree_selection_selected_foreach_w, 2, 1, 0, H_gtk_tree_selection_selected_foreach);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_select_path, gxg_gtk_tree_selection_select_path_w, 2, 0, 0, H_gtk_tree_selection_select_path);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_unselect_path, gxg_gtk_tree_selection_unselect_path_w, 2, 0, 0, H_gtk_tree_selection_unselect_path);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_select_iter, gxg_gtk_tree_selection_select_iter_w, 2, 0, 0, H_gtk_tree_selection_select_iter);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_unselect_iter, gxg_gtk_tree_selection_unselect_iter_w, 2, 0, 0, H_gtk_tree_selection_unselect_iter);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_path_is_selected, gxg_gtk_tree_selection_path_is_selected_w, 2, 0, 0, H_gtk_tree_selection_path_is_selected);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_iter_is_selected, gxg_gtk_tree_selection_iter_is_selected_w, 2, 0, 0, H_gtk_tree_selection_iter_is_selected);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_select_all, gxg_gtk_tree_selection_select_all_w, 1, 0, 0, H_gtk_tree_selection_select_all);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_unselect_all, gxg_gtk_tree_selection_unselect_all_w, 1, 0, 0, H_gtk_tree_selection_unselect_all);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_select_range, gxg_gtk_tree_selection_select_range_w, 3, 0, 0, H_gtk_tree_selection_select_range);
- XG_DEFINE_PROCEDURE(gtk_tree_sortable_sort_column_changed, gxg_gtk_tree_sortable_sort_column_changed_w, 1, 0, 0, H_gtk_tree_sortable_sort_column_changed);
- XG_DEFINE_PROCEDURE(gtk_tree_sortable_get_sort_column_id, gxg_gtk_tree_sortable_get_sort_column_id_w, 1, 2, 0, H_gtk_tree_sortable_get_sort_column_id);
- XG_DEFINE_PROCEDURE(gtk_tree_sortable_set_sort_column_id, gxg_gtk_tree_sortable_set_sort_column_id_w, 3, 0, 0, H_gtk_tree_sortable_set_sort_column_id);
- XG_DEFINE_PROCEDURE(gtk_tree_sortable_set_sort_func, gxg_gtk_tree_sortable_set_sort_func_w, 5, 0, 0, H_gtk_tree_sortable_set_sort_func);
- XG_DEFINE_PROCEDURE(gtk_tree_sortable_set_default_sort_func, gxg_gtk_tree_sortable_set_default_sort_func_w, 4, 0, 0, H_gtk_tree_sortable_set_default_sort_func);
- XG_DEFINE_PROCEDURE(gtk_tree_sortable_has_default_sort_func, gxg_gtk_tree_sortable_has_default_sort_func_w, 1, 0, 0, H_gtk_tree_sortable_has_default_sort_func);
- XG_DEFINE_PROCEDURE(gtk_tree_store_new, gxg_gtk_tree_store_new_w, 2, 0, 0, H_gtk_tree_store_new);
- XG_DEFINE_PROCEDURE(gtk_tree_store_newv, gxg_gtk_tree_store_newv_w, 2, 0, 0, H_gtk_tree_store_newv);
- XG_DEFINE_PROCEDURE(gtk_tree_store_set_column_types, gxg_gtk_tree_store_set_column_types_w, 3, 0, 0, H_gtk_tree_store_set_column_types);
- XG_DEFINE_PROCEDURE(gtk_tree_store_set, gxg_gtk_tree_store_set_w, 3, 0, 0, H_gtk_tree_store_set);
- XG_DEFINE_PROCEDURE(gtk_tree_store_remove, gxg_gtk_tree_store_remove_w, 2, 0, 0, H_gtk_tree_store_remove);
- XG_DEFINE_PROCEDURE(gtk_tree_store_insert, gxg_gtk_tree_store_insert_w, 4, 0, 0, H_gtk_tree_store_insert);
- XG_DEFINE_PROCEDURE(gtk_tree_store_insert_before, gxg_gtk_tree_store_insert_before_w, 4, 0, 0, H_gtk_tree_store_insert_before);
- XG_DEFINE_PROCEDURE(gtk_tree_store_insert_after, gxg_gtk_tree_store_insert_after_w, 4, 0, 0, H_gtk_tree_store_insert_after);
- XG_DEFINE_PROCEDURE(gtk_tree_store_prepend, gxg_gtk_tree_store_prepend_w, 3, 0, 0, H_gtk_tree_store_prepend);
- XG_DEFINE_PROCEDURE(gtk_tree_store_append, gxg_gtk_tree_store_append_w, 3, 0, 0, H_gtk_tree_store_append);
- XG_DEFINE_PROCEDURE(gtk_tree_store_is_ancestor, gxg_gtk_tree_store_is_ancestor_w, 3, 0, 0, H_gtk_tree_store_is_ancestor);
- XG_DEFINE_PROCEDURE(gtk_tree_store_iter_depth, gxg_gtk_tree_store_iter_depth_w, 2, 0, 0, H_gtk_tree_store_iter_depth);
- XG_DEFINE_PROCEDURE(gtk_tree_store_clear, gxg_gtk_tree_store_clear_w, 1, 0, 0, H_gtk_tree_store_clear);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_new, gxg_gtk_tree_view_column_new_w, 0, 0, 0, H_gtk_tree_view_column_new);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_new_with_attributes, gxg_gtk_tree_view_column_new_with_attributes_w, 3, 0, 0, H_gtk_tree_view_column_new_with_attributes);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_pack_start, gxg_gtk_tree_view_column_pack_start_w, 3, 0, 0, H_gtk_tree_view_column_pack_start);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_pack_end, gxg_gtk_tree_view_column_pack_end_w, 3, 0, 0, H_gtk_tree_view_column_pack_end);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_clear, gxg_gtk_tree_view_column_clear_w, 1, 0, 0, H_gtk_tree_view_column_clear);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_add_attribute, gxg_gtk_tree_view_column_add_attribute_w, 4, 0, 0, H_gtk_tree_view_column_add_attribute);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_attributes, gxg_gtk_tree_view_column_set_attributes_w, 3, 0, 0, H_gtk_tree_view_column_set_attributes);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_cell_data_func, gxg_gtk_tree_view_column_set_cell_data_func_w, 5, 0, 0, H_gtk_tree_view_column_set_cell_data_func);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_clear_attributes, gxg_gtk_tree_view_column_clear_attributes_w, 2, 0, 0, H_gtk_tree_view_column_clear_attributes);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_spacing, gxg_gtk_tree_view_column_set_spacing_w, 2, 0, 0, H_gtk_tree_view_column_set_spacing);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_spacing, gxg_gtk_tree_view_column_get_spacing_w, 1, 0, 0, H_gtk_tree_view_column_get_spacing);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_visible, gxg_gtk_tree_view_column_set_visible_w, 2, 0, 0, H_gtk_tree_view_column_set_visible);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_visible, gxg_gtk_tree_view_column_get_visible_w, 1, 0, 0, H_gtk_tree_view_column_get_visible);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_resizable, gxg_gtk_tree_view_column_set_resizable_w, 2, 0, 0, H_gtk_tree_view_column_set_resizable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_resizable, gxg_gtk_tree_view_column_get_resizable_w, 1, 0, 0, H_gtk_tree_view_column_get_resizable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_sizing, gxg_gtk_tree_view_column_set_sizing_w, 2, 0, 0, H_gtk_tree_view_column_set_sizing);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_sizing, gxg_gtk_tree_view_column_get_sizing_w, 1, 0, 0, H_gtk_tree_view_column_get_sizing);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_width, gxg_gtk_tree_view_column_get_width_w, 1, 0, 0, H_gtk_tree_view_column_get_width);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_fixed_width, gxg_gtk_tree_view_column_get_fixed_width_w, 1, 0, 0, H_gtk_tree_view_column_get_fixed_width);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_fixed_width, gxg_gtk_tree_view_column_set_fixed_width_w, 2, 0, 0, H_gtk_tree_view_column_set_fixed_width);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_min_width, gxg_gtk_tree_view_column_set_min_width_w, 2, 0, 0, H_gtk_tree_view_column_set_min_width);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_min_width, gxg_gtk_tree_view_column_get_min_width_w, 1, 0, 0, H_gtk_tree_view_column_get_min_width);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_max_width, gxg_gtk_tree_view_column_set_max_width_w, 2, 0, 0, H_gtk_tree_view_column_set_max_width);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_max_width, gxg_gtk_tree_view_column_get_max_width_w, 1, 0, 0, H_gtk_tree_view_column_get_max_width);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_clicked, gxg_gtk_tree_view_column_clicked_w, 1, 0, 0, H_gtk_tree_view_column_clicked);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_title, gxg_gtk_tree_view_column_set_title_w, 2, 0, 0, H_gtk_tree_view_column_set_title);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_title, gxg_gtk_tree_view_column_get_title_w, 1, 0, 0, H_gtk_tree_view_column_get_title);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_clickable, gxg_gtk_tree_view_column_set_clickable_w, 2, 0, 0, H_gtk_tree_view_column_set_clickable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_clickable, gxg_gtk_tree_view_column_get_clickable_w, 1, 0, 0, H_gtk_tree_view_column_get_clickable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_widget, gxg_gtk_tree_view_column_set_widget_w, 2, 0, 0, H_gtk_tree_view_column_set_widget);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_widget, gxg_gtk_tree_view_column_get_widget_w, 1, 0, 0, H_gtk_tree_view_column_get_widget);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_alignment, gxg_gtk_tree_view_column_set_alignment_w, 2, 0, 0, H_gtk_tree_view_column_set_alignment);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_alignment, gxg_gtk_tree_view_column_get_alignment_w, 1, 0, 0, H_gtk_tree_view_column_get_alignment);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_reorderable, gxg_gtk_tree_view_column_set_reorderable_w, 2, 0, 0, H_gtk_tree_view_column_set_reorderable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_reorderable, gxg_gtk_tree_view_column_get_reorderable_w, 1, 0, 0, H_gtk_tree_view_column_get_reorderable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_sort_column_id, gxg_gtk_tree_view_column_set_sort_column_id_w, 2, 0, 0, H_gtk_tree_view_column_set_sort_column_id);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_sort_column_id, gxg_gtk_tree_view_column_get_sort_column_id_w, 1, 0, 0, H_gtk_tree_view_column_get_sort_column_id);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_sort_indicator, gxg_gtk_tree_view_column_set_sort_indicator_w, 2, 0, 0, H_gtk_tree_view_column_set_sort_indicator);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_sort_indicator, gxg_gtk_tree_view_column_get_sort_indicator_w, 1, 0, 0, H_gtk_tree_view_column_get_sort_indicator);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_sort_order, gxg_gtk_tree_view_column_set_sort_order_w, 2, 0, 0, H_gtk_tree_view_column_set_sort_order);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_sort_order, gxg_gtk_tree_view_column_get_sort_order_w, 1, 0, 0, H_gtk_tree_view_column_get_sort_order);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_cell_set_cell_data, gxg_gtk_tree_view_column_cell_set_cell_data_w, 5, 0, 0, H_gtk_tree_view_column_cell_set_cell_data);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_cell_get_size, gxg_gtk_tree_view_column_cell_get_size_w, 2, 4, 0, H_gtk_tree_view_column_cell_get_size);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_cell_is_visible, gxg_gtk_tree_view_column_cell_is_visible_w, 1, 0, 0, H_gtk_tree_view_column_cell_is_visible);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_cell_get_position, gxg_gtk_tree_view_column_cell_get_position_w, 2, 2, 0, H_gtk_tree_view_column_cell_get_position);
- XG_DEFINE_PROCEDURE(gtk_tree_view_new, gxg_gtk_tree_view_new_w, 0, 0, 0, H_gtk_tree_view_new);
- XG_DEFINE_PROCEDURE(gtk_tree_view_new_with_model, gxg_gtk_tree_view_new_with_model_w, 1, 0, 0, H_gtk_tree_view_new_with_model);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_model, gxg_gtk_tree_view_get_model_w, 1, 0, 0, H_gtk_tree_view_get_model);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_model, gxg_gtk_tree_view_set_model_w, 2, 0, 0, H_gtk_tree_view_set_model);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_selection, gxg_gtk_tree_view_get_selection_w, 1, 0, 0, H_gtk_tree_view_get_selection);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_headers_visible, gxg_gtk_tree_view_get_headers_visible_w, 1, 0, 0, H_gtk_tree_view_get_headers_visible);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_headers_visible, gxg_gtk_tree_view_set_headers_visible_w, 2, 0, 0, H_gtk_tree_view_set_headers_visible);
- XG_DEFINE_PROCEDURE(gtk_tree_view_columns_autosize, gxg_gtk_tree_view_columns_autosize_w, 1, 0, 0, H_gtk_tree_view_columns_autosize);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_headers_clickable, gxg_gtk_tree_view_set_headers_clickable_w, 2, 0, 0, H_gtk_tree_view_set_headers_clickable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_rules_hint, gxg_gtk_tree_view_set_rules_hint_w, 2, 0, 0, H_gtk_tree_view_set_rules_hint);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_rules_hint, gxg_gtk_tree_view_get_rules_hint_w, 1, 0, 0, H_gtk_tree_view_get_rules_hint);
- XG_DEFINE_PROCEDURE(gtk_tree_view_append_column, gxg_gtk_tree_view_append_column_w, 2, 0, 0, H_gtk_tree_view_append_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_remove_column, gxg_gtk_tree_view_remove_column_w, 2, 0, 0, H_gtk_tree_view_remove_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_insert_column, gxg_gtk_tree_view_insert_column_w, 3, 0, 0, H_gtk_tree_view_insert_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_insert_column_with_attributes, gxg_gtk_tree_view_insert_column_with_attributes_w, 5, 0, 0, H_gtk_tree_view_insert_column_with_attributes);
- XG_DEFINE_PROCEDURE(gtk_tree_view_insert_column_with_data_func, gxg_gtk_tree_view_insert_column_with_data_func_w, 7, 0, 0, H_gtk_tree_view_insert_column_with_data_func);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_column, gxg_gtk_tree_view_get_column_w, 2, 0, 0, H_gtk_tree_view_get_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_columns, gxg_gtk_tree_view_get_columns_w, 1, 0, 0, H_gtk_tree_view_get_columns);
- XG_DEFINE_PROCEDURE(gtk_tree_view_move_column_after, gxg_gtk_tree_view_move_column_after_w, 3, 0, 0, H_gtk_tree_view_move_column_after);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_expander_column, gxg_gtk_tree_view_set_expander_column_w, 2, 0, 0, H_gtk_tree_view_set_expander_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_expander_column, gxg_gtk_tree_view_get_expander_column_w, 1, 0, 0, H_gtk_tree_view_get_expander_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_column_drag_function, gxg_gtk_tree_view_set_column_drag_function_w, 4, 0, 0, H_gtk_tree_view_set_column_drag_function);
- XG_DEFINE_PROCEDURE(gtk_tree_view_scroll_to_point, gxg_gtk_tree_view_scroll_to_point_w, 3, 0, 0, H_gtk_tree_view_scroll_to_point);
- XG_DEFINE_PROCEDURE(gtk_tree_view_scroll_to_cell, gxg_gtk_tree_view_scroll_to_cell_w, 6, 0, 0, H_gtk_tree_view_scroll_to_cell);
- XG_DEFINE_PROCEDURE(gtk_tree_view_row_activated, gxg_gtk_tree_view_row_activated_w, 3, 0, 0, H_gtk_tree_view_row_activated);
- XG_DEFINE_PROCEDURE(gtk_tree_view_expand_all, gxg_gtk_tree_view_expand_all_w, 1, 0, 0, H_gtk_tree_view_expand_all);
- XG_DEFINE_PROCEDURE(gtk_tree_view_collapse_all, gxg_gtk_tree_view_collapse_all_w, 1, 0, 0, H_gtk_tree_view_collapse_all);
- XG_DEFINE_PROCEDURE(gtk_tree_view_expand_row, gxg_gtk_tree_view_expand_row_w, 3, 0, 0, H_gtk_tree_view_expand_row);
- XG_DEFINE_PROCEDURE(gtk_tree_view_collapse_row, gxg_gtk_tree_view_collapse_row_w, 2, 0, 0, H_gtk_tree_view_collapse_row);
- XG_DEFINE_PROCEDURE(gtk_tree_view_map_expanded_rows, gxg_gtk_tree_view_map_expanded_rows_w, 2, 1, 0, H_gtk_tree_view_map_expanded_rows);
- XG_DEFINE_PROCEDURE(gtk_tree_view_row_expanded, gxg_gtk_tree_view_row_expanded_w, 2, 0, 0, H_gtk_tree_view_row_expanded);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_reorderable, gxg_gtk_tree_view_set_reorderable_w, 2, 0, 0, H_gtk_tree_view_set_reorderable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_reorderable, gxg_gtk_tree_view_get_reorderable_w, 1, 0, 0, H_gtk_tree_view_get_reorderable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_cursor, gxg_gtk_tree_view_set_cursor_w, 4, 0, 0, H_gtk_tree_view_set_cursor);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_cursor, gxg_gtk_tree_view_get_cursor_w, 1, 2, 0, H_gtk_tree_view_get_cursor);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_bin_window, gxg_gtk_tree_view_get_bin_window_w, 1, 0, 0, H_gtk_tree_view_get_bin_window);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_path_at_pos, gxg_gtk_tree_view_get_path_at_pos_w, 3, 4, 0, H_gtk_tree_view_get_path_at_pos);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_cell_area, gxg_gtk_tree_view_get_cell_area_w, 4, 0, 0, H_gtk_tree_view_get_cell_area);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_background_area, gxg_gtk_tree_view_get_background_area_w, 4, 0, 0, H_gtk_tree_view_get_background_area);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_visible_rect, gxg_gtk_tree_view_get_visible_rect_w, 2, 0, 0, H_gtk_tree_view_get_visible_rect);
- XG_DEFINE_PROCEDURE(gtk_tree_view_enable_model_drag_source, gxg_gtk_tree_view_enable_model_drag_source_w, 5, 0, 0, H_gtk_tree_view_enable_model_drag_source);
- XG_DEFINE_PROCEDURE(gtk_tree_view_enable_model_drag_dest, gxg_gtk_tree_view_enable_model_drag_dest_w, 4, 0, 0, H_gtk_tree_view_enable_model_drag_dest);
- XG_DEFINE_PROCEDURE(gtk_tree_view_unset_rows_drag_source, gxg_gtk_tree_view_unset_rows_drag_source_w, 1, 0, 0, H_gtk_tree_view_unset_rows_drag_source);
- XG_DEFINE_PROCEDURE(gtk_tree_view_unset_rows_drag_dest, gxg_gtk_tree_view_unset_rows_drag_dest_w, 1, 0, 0, H_gtk_tree_view_unset_rows_drag_dest);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_drag_dest_row, gxg_gtk_tree_view_set_drag_dest_row_w, 3, 0, 0, H_gtk_tree_view_set_drag_dest_row);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_drag_dest_row, gxg_gtk_tree_view_get_drag_dest_row_w, 1, 2, 0, H_gtk_tree_view_get_drag_dest_row);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_dest_row_at_pos, gxg_gtk_tree_view_get_dest_row_at_pos_w, 3, 2, 0, H_gtk_tree_view_get_dest_row_at_pos);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_enable_search, gxg_gtk_tree_view_set_enable_search_w, 2, 0, 0, H_gtk_tree_view_set_enable_search);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_enable_search, gxg_gtk_tree_view_get_enable_search_w, 1, 0, 0, H_gtk_tree_view_get_enable_search);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_search_column, gxg_gtk_tree_view_get_search_column_w, 1, 0, 0, H_gtk_tree_view_get_search_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_search_column, gxg_gtk_tree_view_set_search_column_w, 2, 0, 0, H_gtk_tree_view_set_search_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_search_equal_func, gxg_gtk_tree_view_get_search_equal_func_w, 1, 0, 0, H_gtk_tree_view_get_search_equal_func);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_search_equal_func, gxg_gtk_tree_view_set_search_equal_func_w, 4, 0, 0, H_gtk_tree_view_set_search_equal_func);
- XG_DEFINE_PROCEDURE(gtk_vbutton_box_new, gxg_gtk_vbutton_box_new_w, 0, 0, 0, H_gtk_vbutton_box_new);
- XG_DEFINE_PROCEDURE(gtk_viewport_new, gxg_gtk_viewport_new_w, 2, 0, 0, H_gtk_viewport_new);
- XG_DEFINE_PROCEDURE(gtk_viewport_set_shadow_type, gxg_gtk_viewport_set_shadow_type_w, 2, 0, 0, H_gtk_viewport_set_shadow_type);
- XG_DEFINE_PROCEDURE(gtk_viewport_get_shadow_type, gxg_gtk_viewport_get_shadow_type_w, 1, 0, 0, H_gtk_viewport_get_shadow_type);
- XG_DEFINE_PROCEDURE(gtk_vpaned_new, gxg_gtk_vpaned_new_w, 0, 0, 0, H_gtk_vpaned_new);
- XG_DEFINE_PROCEDURE(gtk_vscale_new, gxg_gtk_vscale_new_w, 1, 0, 0, H_gtk_vscale_new);
- XG_DEFINE_PROCEDURE(gtk_vscale_new_with_range, gxg_gtk_vscale_new_with_range_w, 3, 0, 0, H_gtk_vscale_new_with_range);
- XG_DEFINE_PROCEDURE(gtk_vscrollbar_new, gxg_gtk_vscrollbar_new_w, 1, 0, 0, H_gtk_vscrollbar_new);
- XG_DEFINE_PROCEDURE(gtk_vseparator_new, gxg_gtk_vseparator_new_w, 0, 0, 0, H_gtk_vseparator_new);
- XG_DEFINE_PROCEDURE(gtk_widget_destroy, gxg_gtk_widget_destroy_w, 1, 0, 0, H_gtk_widget_destroy);
- XG_DEFINE_PROCEDURE(gtk_widget_destroyed, gxg_gtk_widget_destroyed_w, 1, 1, 0, H_gtk_widget_destroyed);
- XG_DEFINE_PROCEDURE(gtk_widget_unparent, gxg_gtk_widget_unparent_w, 1, 0, 0, H_gtk_widget_unparent);
- XG_DEFINE_PROCEDURE(gtk_widget_show, gxg_gtk_widget_show_w, 1, 0, 0, H_gtk_widget_show);
- XG_DEFINE_PROCEDURE(gtk_widget_show_now, gxg_gtk_widget_show_now_w, 1, 0, 0, H_gtk_widget_show_now);
- XG_DEFINE_PROCEDURE(gtk_widget_hide, gxg_gtk_widget_hide_w, 1, 0, 0, H_gtk_widget_hide);
- XG_DEFINE_PROCEDURE(gtk_widget_show_all, gxg_gtk_widget_show_all_w, 1, 0, 0, H_gtk_widget_show_all);
- XG_DEFINE_PROCEDURE(gtk_widget_map, gxg_gtk_widget_map_w, 1, 0, 0, H_gtk_widget_map);
- XG_DEFINE_PROCEDURE(gtk_widget_unmap, gxg_gtk_widget_unmap_w, 1, 0, 0, H_gtk_widget_unmap);
- XG_DEFINE_PROCEDURE(gtk_widget_realize, gxg_gtk_widget_realize_w, 1, 0, 0, H_gtk_widget_realize);
- XG_DEFINE_PROCEDURE(gtk_widget_unrealize, gxg_gtk_widget_unrealize_w, 1, 0, 0, H_gtk_widget_unrealize);
- XG_DEFINE_PROCEDURE(gtk_widget_queue_draw, gxg_gtk_widget_queue_draw_w, 1, 0, 0, H_gtk_widget_queue_draw);
- XG_DEFINE_PROCEDURE(gtk_widget_queue_draw_area, gxg_gtk_widget_queue_draw_area_w, 5, 0, 0, H_gtk_widget_queue_draw_area);
- XG_DEFINE_PROCEDURE(gtk_widget_queue_resize, gxg_gtk_widget_queue_resize_w, 1, 0, 0, H_gtk_widget_queue_resize);
- XG_DEFINE_PROCEDURE(gtk_widget_size_allocate, gxg_gtk_widget_size_allocate_w, 2, 0, 0, H_gtk_widget_size_allocate);
- XG_DEFINE_PROCEDURE(gtk_widget_add_accelerator, gxg_gtk_widget_add_accelerator_w, 6, 0, 0, H_gtk_widget_add_accelerator);
- XG_DEFINE_PROCEDURE(gtk_widget_remove_accelerator, gxg_gtk_widget_remove_accelerator_w, 4, 0, 0, H_gtk_widget_remove_accelerator);
- XG_DEFINE_PROCEDURE(gtk_widget_list_accel_closures, gxg_gtk_widget_list_accel_closures_w, 1, 0, 0, H_gtk_widget_list_accel_closures);
- XG_DEFINE_PROCEDURE(gtk_widget_mnemonic_activate, gxg_gtk_widget_mnemonic_activate_w, 2, 0, 0, H_gtk_widget_mnemonic_activate);
- XG_DEFINE_PROCEDURE(gtk_widget_event, gxg_gtk_widget_event_w, 2, 0, 0, H_gtk_widget_event);
- XG_DEFINE_PROCEDURE(gtk_widget_send_expose, gxg_gtk_widget_send_expose_w, 2, 0, 0, H_gtk_widget_send_expose);
- XG_DEFINE_PROCEDURE(gtk_widget_activate, gxg_gtk_widget_activate_w, 1, 0, 0, H_gtk_widget_activate);
- XG_DEFINE_PROCEDURE(gtk_widget_reparent, gxg_gtk_widget_reparent_w, 2, 0, 0, H_gtk_widget_reparent);
- XG_DEFINE_PROCEDURE(gtk_widget_intersect, gxg_gtk_widget_intersect_w, 3, 0, 0, H_gtk_widget_intersect);
- XG_DEFINE_PROCEDURE(gtk_widget_freeze_child_notify, gxg_gtk_widget_freeze_child_notify_w, 1, 0, 0, H_gtk_widget_freeze_child_notify);
- XG_DEFINE_PROCEDURE(gtk_widget_child_notify, gxg_gtk_widget_child_notify_w, 2, 0, 0, H_gtk_widget_child_notify);
- XG_DEFINE_PROCEDURE(gtk_widget_thaw_child_notify, gxg_gtk_widget_thaw_child_notify_w, 1, 0, 0, H_gtk_widget_thaw_child_notify);
- XG_DEFINE_PROCEDURE(gtk_widget_is_focus, gxg_gtk_widget_is_focus_w, 1, 0, 0, H_gtk_widget_is_focus);
- XG_DEFINE_PROCEDURE(gtk_widget_grab_focus, gxg_gtk_widget_grab_focus_w, 1, 0, 0, H_gtk_widget_grab_focus);
- XG_DEFINE_PROCEDURE(gtk_widget_grab_default, gxg_gtk_widget_grab_default_w, 1, 0, 0, H_gtk_widget_grab_default);
- XG_DEFINE_PROCEDURE(gtk_widget_set_name, gxg_gtk_widget_set_name_w, 2, 0, 0, H_gtk_widget_set_name);
- XG_DEFINE_PROCEDURE(gtk_widget_get_name, gxg_gtk_widget_get_name_w, 1, 0, 0, H_gtk_widget_get_name);
- XG_DEFINE_PROCEDURE(gtk_widget_set_state, gxg_gtk_widget_set_state_w, 2, 0, 0, H_gtk_widget_set_state);
- XG_DEFINE_PROCEDURE(gtk_widget_set_sensitive, gxg_gtk_widget_set_sensitive_w, 2, 0, 0, H_gtk_widget_set_sensitive);
- XG_DEFINE_PROCEDURE(gtk_widget_set_app_paintable, gxg_gtk_widget_set_app_paintable_w, 2, 0, 0, H_gtk_widget_set_app_paintable);
- XG_DEFINE_PROCEDURE(gtk_widget_set_double_buffered, gxg_gtk_widget_set_double_buffered_w, 2, 0, 0, H_gtk_widget_set_double_buffered);
- XG_DEFINE_PROCEDURE(gtk_widget_set_redraw_on_allocate, gxg_gtk_widget_set_redraw_on_allocate_w, 2, 0, 0, H_gtk_widget_set_redraw_on_allocate);
- XG_DEFINE_PROCEDURE(gtk_widget_set_parent, gxg_gtk_widget_set_parent_w, 2, 0, 0, H_gtk_widget_set_parent);
- XG_DEFINE_PROCEDURE(gtk_widget_set_parent_window, gxg_gtk_widget_set_parent_window_w, 2, 0, 0, H_gtk_widget_set_parent_window);
- XG_DEFINE_PROCEDURE(gtk_widget_set_child_visible, gxg_gtk_widget_set_child_visible_w, 2, 0, 0, H_gtk_widget_set_child_visible);
- XG_DEFINE_PROCEDURE(gtk_widget_set_accel_path, gxg_gtk_widget_set_accel_path_w, 3, 0, 0, H_gtk_widget_set_accel_path);
- XG_DEFINE_PROCEDURE(gtk_widget_get_child_visible, gxg_gtk_widget_get_child_visible_w, 1, 0, 0, H_gtk_widget_get_child_visible);
- XG_DEFINE_PROCEDURE(gtk_widget_get_parent, gxg_gtk_widget_get_parent_w, 1, 0, 0, H_gtk_widget_get_parent);
- XG_DEFINE_PROCEDURE(gtk_widget_get_parent_window, gxg_gtk_widget_get_parent_window_w, 1, 0, 0, H_gtk_widget_get_parent_window);
- XG_DEFINE_PROCEDURE(gtk_widget_child_focus, gxg_gtk_widget_child_focus_w, 2, 0, 0, H_gtk_widget_child_focus);
- XG_DEFINE_PROCEDURE(gtk_widget_set_size_request, gxg_gtk_widget_set_size_request_w, 3, 0, 0, H_gtk_widget_set_size_request);
- XG_DEFINE_PROCEDURE(gtk_widget_get_size_request, gxg_gtk_widget_get_size_request_w, 1, 2, 0, H_gtk_widget_get_size_request);
- XG_DEFINE_PROCEDURE(gtk_widget_set_events, gxg_gtk_widget_set_events_w, 2, 0, 0, H_gtk_widget_set_events);
- XG_DEFINE_PROCEDURE(gtk_widget_add_events, gxg_gtk_widget_add_events_w, 2, 0, 0, H_gtk_widget_add_events);
- XG_DEFINE_PROCEDURE(gtk_widget_get_toplevel, gxg_gtk_widget_get_toplevel_w, 1, 0, 0, H_gtk_widget_get_toplevel);
- XG_DEFINE_PROCEDURE(gtk_widget_get_ancestor, gxg_gtk_widget_get_ancestor_w, 2, 0, 0, H_gtk_widget_get_ancestor);
- XG_DEFINE_PROCEDURE(gtk_widget_get_visual, gxg_gtk_widget_get_visual_w, 1, 0, 0, H_gtk_widget_get_visual);
- XG_DEFINE_PROCEDURE(gtk_widget_get_accessible, gxg_gtk_widget_get_accessible_w, 1, 0, 0, H_gtk_widget_get_accessible);
- XG_DEFINE_PROCEDURE(gtk_widget_get_events, gxg_gtk_widget_get_events_w, 1, 0, 0, H_gtk_widget_get_events);
- XG_DEFINE_PROCEDURE(gtk_widget_get_pointer, gxg_gtk_widget_get_pointer_w, 1, 2, 0, H_gtk_widget_get_pointer);
- XG_DEFINE_PROCEDURE(gtk_widget_is_ancestor, gxg_gtk_widget_is_ancestor_w, 2, 0, 0, H_gtk_widget_is_ancestor);
- XG_DEFINE_PROCEDURE(gtk_widget_translate_coordinates, gxg_gtk_widget_translate_coordinates_w, 4, 2, 0, H_gtk_widget_translate_coordinates);
- XG_DEFINE_PROCEDURE(gtk_widget_hide_on_delete, gxg_gtk_widget_hide_on_delete_w, 1, 0, 0, H_gtk_widget_hide_on_delete);
- XG_DEFINE_PROCEDURE(gtk_widget_create_pango_context, gxg_gtk_widget_create_pango_context_w, 1, 0, 0, H_gtk_widget_create_pango_context);
- XG_DEFINE_PROCEDURE(gtk_widget_get_pango_context, gxg_gtk_widget_get_pango_context_w, 1, 0, 0, H_gtk_widget_get_pango_context);
- XG_DEFINE_PROCEDURE(gtk_widget_create_pango_layout, gxg_gtk_widget_create_pango_layout_w, 2, 0, 0, H_gtk_widget_create_pango_layout);
- XG_DEFINE_PROCEDURE(gtk_widget_set_composite_name, gxg_gtk_widget_set_composite_name_w, 2, 0, 0, H_gtk_widget_set_composite_name);
- XG_DEFINE_PROCEDURE(gtk_widget_get_composite_name, gxg_gtk_widget_get_composite_name_w, 1, 0, 0, H_gtk_widget_get_composite_name);
- XG_DEFINE_PROCEDURE(gtk_widget_push_composite_child, gxg_gtk_widget_push_composite_child_w, 0, 0, 0, H_gtk_widget_push_composite_child);
- XG_DEFINE_PROCEDURE(gtk_widget_pop_composite_child, gxg_gtk_widget_pop_composite_child_w, 0, 0, 0, H_gtk_widget_pop_composite_child);
- XG_DEFINE_PROCEDURE(gtk_widget_set_direction, gxg_gtk_widget_set_direction_w, 2, 0, 0, H_gtk_widget_set_direction);
- XG_DEFINE_PROCEDURE(gtk_widget_get_direction, gxg_gtk_widget_get_direction_w, 1, 0, 0, H_gtk_widget_get_direction);
- XG_DEFINE_PROCEDURE(gtk_widget_set_default_direction, gxg_gtk_widget_set_default_direction_w, 1, 0, 0, H_gtk_widget_set_default_direction);
- XG_DEFINE_PROCEDURE(gtk_widget_get_default_direction, gxg_gtk_widget_get_default_direction_w, 0, 0, 0, H_gtk_widget_get_default_direction);
- XG_DEFINE_PROCEDURE(gtk_widget_can_activate_accel, gxg_gtk_widget_can_activate_accel_w, 2, 0, 0, H_gtk_widget_can_activate_accel);
- XG_DEFINE_PROCEDURE(gtk_window_is_active, gxg_gtk_window_is_active_w, 1, 0, 0, H_gtk_window_is_active);
- XG_DEFINE_PROCEDURE(gtk_window_has_toplevel_focus, gxg_gtk_window_has_toplevel_focus_w, 1, 0, 0, H_gtk_window_has_toplevel_focus);
- XG_DEFINE_PROCEDURE(gtk_window_new, gxg_gtk_window_new_w, 1, 0, 0, H_gtk_window_new);
- XG_DEFINE_PROCEDURE(gtk_window_set_title, gxg_gtk_window_set_title_w, 2, 0, 0, H_gtk_window_set_title);
- XG_DEFINE_PROCEDURE(gtk_window_set_auto_startup_notification, gxg_gtk_window_set_auto_startup_notification_w, 1, 0, 0, H_gtk_window_set_auto_startup_notification);
- XG_DEFINE_PROCEDURE(gtk_window_get_title, gxg_gtk_window_get_title_w, 1, 0, 0, H_gtk_window_get_title);
- XG_DEFINE_PROCEDURE(gtk_window_set_wmclass, gxg_gtk_window_set_wmclass_w, 3, 0, 0, H_gtk_window_set_wmclass);
- XG_DEFINE_PROCEDURE(gtk_window_set_role, gxg_gtk_window_set_role_w, 2, 0, 0, H_gtk_window_set_role);
- XG_DEFINE_PROCEDURE(gtk_window_get_role, gxg_gtk_window_get_role_w, 1, 0, 0, H_gtk_window_get_role);
- XG_DEFINE_PROCEDURE(gtk_window_add_accel_group, gxg_gtk_window_add_accel_group_w, 2, 0, 0, H_gtk_window_add_accel_group);
- XG_DEFINE_PROCEDURE(gtk_window_remove_accel_group, gxg_gtk_window_remove_accel_group_w, 2, 0, 0, H_gtk_window_remove_accel_group);
- XG_DEFINE_PROCEDURE(gtk_window_set_position, gxg_gtk_window_set_position_w, 2, 0, 0, H_gtk_window_set_position);
- XG_DEFINE_PROCEDURE(gtk_window_activate_focus, gxg_gtk_window_activate_focus_w, 1, 0, 0, H_gtk_window_activate_focus);
- XG_DEFINE_PROCEDURE(gtk_window_set_focus, gxg_gtk_window_set_focus_w, 2, 0, 0, H_gtk_window_set_focus);
- XG_DEFINE_PROCEDURE(gtk_window_get_focus, gxg_gtk_window_get_focus_w, 1, 0, 0, H_gtk_window_get_focus);
- XG_DEFINE_PROCEDURE(gtk_window_set_default, gxg_gtk_window_set_default_w, 2, 0, 0, H_gtk_window_set_default);
- XG_DEFINE_PROCEDURE(gtk_window_activate_default, gxg_gtk_window_activate_default_w, 1, 0, 0, H_gtk_window_activate_default);
- XG_DEFINE_PROCEDURE(gtk_window_set_transient_for, gxg_gtk_window_set_transient_for_w, 2, 0, 0, H_gtk_window_set_transient_for);
- XG_DEFINE_PROCEDURE(gtk_window_get_transient_for, gxg_gtk_window_get_transient_for_w, 1, 0, 0, H_gtk_window_get_transient_for);
- XG_DEFINE_PROCEDURE(gtk_window_set_type_hint, gxg_gtk_window_set_type_hint_w, 2, 0, 0, H_gtk_window_set_type_hint);
- XG_DEFINE_PROCEDURE(gtk_window_get_type_hint, gxg_gtk_window_get_type_hint_w, 1, 0, 0, H_gtk_window_get_type_hint);
- XG_DEFINE_PROCEDURE(gtk_window_set_destroy_with_parent, gxg_gtk_window_set_destroy_with_parent_w, 2, 0, 0, H_gtk_window_set_destroy_with_parent);
- XG_DEFINE_PROCEDURE(gtk_window_get_destroy_with_parent, gxg_gtk_window_get_destroy_with_parent_w, 1, 0, 0, H_gtk_window_get_destroy_with_parent);
- XG_DEFINE_PROCEDURE(gtk_window_set_resizable, gxg_gtk_window_set_resizable_w, 2, 0, 0, H_gtk_window_set_resizable);
- XG_DEFINE_PROCEDURE(gtk_window_get_resizable, gxg_gtk_window_get_resizable_w, 1, 0, 0, H_gtk_window_get_resizable);
- XG_DEFINE_PROCEDURE(gtk_window_set_gravity, gxg_gtk_window_set_gravity_w, 2, 0, 0, H_gtk_window_set_gravity);
- XG_DEFINE_PROCEDURE(gtk_window_get_gravity, gxg_gtk_window_get_gravity_w, 1, 0, 0, H_gtk_window_get_gravity);
- XG_DEFINE_PROCEDURE(gtk_window_set_geometry_hints, gxg_gtk_window_set_geometry_hints_w, 4, 0, 0, H_gtk_window_set_geometry_hints);
- XG_DEFINE_PROCEDURE(gtk_window_set_decorated, gxg_gtk_window_set_decorated_w, 2, 0, 0, H_gtk_window_set_decorated);
- XG_DEFINE_PROCEDURE(gtk_window_get_decorated, gxg_gtk_window_get_decorated_w, 1, 0, 0, H_gtk_window_get_decorated);
- XG_DEFINE_PROCEDURE(gtk_window_set_icon_list, gxg_gtk_window_set_icon_list_w, 2, 0, 0, H_gtk_window_set_icon_list);
- XG_DEFINE_PROCEDURE(gtk_window_get_icon_list, gxg_gtk_window_get_icon_list_w, 1, 0, 0, H_gtk_window_get_icon_list);
- XG_DEFINE_PROCEDURE(gtk_window_set_icon, gxg_gtk_window_set_icon_w, 2, 0, 0, H_gtk_window_set_icon);
- XG_DEFINE_PROCEDURE(gtk_window_get_icon, gxg_gtk_window_get_icon_w, 1, 0, 0, H_gtk_window_get_icon);
- XG_DEFINE_PROCEDURE(gtk_window_set_default_icon_list, gxg_gtk_window_set_default_icon_list_w, 1, 0, 0, H_gtk_window_set_default_icon_list);
- XG_DEFINE_PROCEDURE(gtk_window_get_default_icon_list, gxg_gtk_window_get_default_icon_list_w, 0, 0, 0, H_gtk_window_get_default_icon_list);
- XG_DEFINE_PROCEDURE(gtk_window_set_modal, gxg_gtk_window_set_modal_w, 2, 0, 0, H_gtk_window_set_modal);
- XG_DEFINE_PROCEDURE(gtk_window_get_modal, gxg_gtk_window_get_modal_w, 1, 0, 0, H_gtk_window_get_modal);
- XG_DEFINE_PROCEDURE(gtk_window_list_toplevels, gxg_gtk_window_list_toplevels_w, 0, 0, 0, H_gtk_window_list_toplevels);
- XG_DEFINE_PROCEDURE(gtk_window_add_mnemonic, gxg_gtk_window_add_mnemonic_w, 3, 0, 0, H_gtk_window_add_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_window_remove_mnemonic, gxg_gtk_window_remove_mnemonic_w, 3, 0, 0, H_gtk_window_remove_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_window_mnemonic_activate, gxg_gtk_window_mnemonic_activate_w, 3, 0, 0, H_gtk_window_mnemonic_activate);
- XG_DEFINE_PROCEDURE(gtk_window_set_mnemonic_modifier, gxg_gtk_window_set_mnemonic_modifier_w, 2, 0, 0, H_gtk_window_set_mnemonic_modifier);
- XG_DEFINE_PROCEDURE(gtk_window_get_mnemonic_modifier, gxg_gtk_window_get_mnemonic_modifier_w, 1, 0, 0, H_gtk_window_get_mnemonic_modifier);
- XG_DEFINE_PROCEDURE(gtk_window_present, gxg_gtk_window_present_w, 1, 0, 0, H_gtk_window_present);
- XG_DEFINE_PROCEDURE(gtk_window_iconify, gxg_gtk_window_iconify_w, 1, 0, 0, H_gtk_window_iconify);
- XG_DEFINE_PROCEDURE(gtk_window_deiconify, gxg_gtk_window_deiconify_w, 1, 0, 0, H_gtk_window_deiconify);
- XG_DEFINE_PROCEDURE(gtk_window_stick, gxg_gtk_window_stick_w, 1, 0, 0, H_gtk_window_stick);
- XG_DEFINE_PROCEDURE(gtk_window_unstick, gxg_gtk_window_unstick_w, 1, 0, 0, H_gtk_window_unstick);
- XG_DEFINE_PROCEDURE(gtk_window_maximize, gxg_gtk_window_maximize_w, 1, 0, 0, H_gtk_window_maximize);
- XG_DEFINE_PROCEDURE(gtk_window_unmaximize, gxg_gtk_window_unmaximize_w, 1, 0, 0, H_gtk_window_unmaximize);
- XG_DEFINE_PROCEDURE(gtk_window_begin_resize_drag, gxg_gtk_window_begin_resize_drag_w, 6, 0, 0, H_gtk_window_begin_resize_drag);
- XG_DEFINE_PROCEDURE(gtk_window_begin_move_drag, gxg_gtk_window_begin_move_drag_w, 5, 0, 0, H_gtk_window_begin_move_drag);
- XG_DEFINE_PROCEDURE(gtk_window_set_default_size, gxg_gtk_window_set_default_size_w, 3, 0, 0, H_gtk_window_set_default_size);
- XG_DEFINE_PROCEDURE(gtk_window_get_default_size, gxg_gtk_window_get_default_size_w, 1, 2, 0, H_gtk_window_get_default_size);
- XG_DEFINE_PROCEDURE(gtk_window_resize, gxg_gtk_window_resize_w, 3, 0, 0, H_gtk_window_resize);
- XG_DEFINE_PROCEDURE(gtk_window_get_size, gxg_gtk_window_get_size_w, 1, 2, 0, H_gtk_window_get_size);
- XG_DEFINE_PROCEDURE(gtk_window_move, gxg_gtk_window_move_w, 3, 0, 0, H_gtk_window_move);
- XG_DEFINE_PROCEDURE(gtk_window_get_position, gxg_gtk_window_get_position_w, 1, 2, 0, H_gtk_window_get_position);
- XG_DEFINE_PROCEDURE(gtk_window_parse_geometry, gxg_gtk_window_parse_geometry_w, 2, 0, 0, H_gtk_window_parse_geometry);
- XG_DEFINE_PROCEDURE(gtk_window_reshow_with_initial_size, gxg_gtk_window_reshow_with_initial_size_w, 1, 0, 0, H_gtk_window_reshow_with_initial_size);
- XG_DEFINE_PROCEDURE(pango_color_copy, gxg_pango_color_copy_w, 1, 0, 0, H_pango_color_copy);
- XG_DEFINE_PROCEDURE(pango_color_free, gxg_pango_color_free_w, 1, 0, 0, H_pango_color_free);
- XG_DEFINE_PROCEDURE(pango_color_parse, gxg_pango_color_parse_w, 2, 0, 0, H_pango_color_parse);
- XG_DEFINE_PROCEDURE(pango_attr_type_register, gxg_pango_attr_type_register_w, 1, 0, 0, H_pango_attr_type_register);
- XG_DEFINE_PROCEDURE(pango_attribute_copy, gxg_pango_attribute_copy_w, 1, 0, 0, H_pango_attribute_copy);
- XG_DEFINE_PROCEDURE(pango_attribute_destroy, gxg_pango_attribute_destroy_w, 1, 0, 0, H_pango_attribute_destroy);
- XG_DEFINE_PROCEDURE(pango_attribute_equal, gxg_pango_attribute_equal_w, 2, 0, 0, H_pango_attribute_equal);
- XG_DEFINE_PROCEDURE(pango_attr_language_new, gxg_pango_attr_language_new_w, 1, 0, 0, H_pango_attr_language_new);
- XG_DEFINE_PROCEDURE(pango_attr_family_new, gxg_pango_attr_family_new_w, 1, 0, 0, H_pango_attr_family_new);
- XG_DEFINE_PROCEDURE(pango_attr_foreground_new, gxg_pango_attr_foreground_new_w, 3, 0, 0, H_pango_attr_foreground_new);
- XG_DEFINE_PROCEDURE(pango_attr_background_new, gxg_pango_attr_background_new_w, 3, 0, 0, H_pango_attr_background_new);
- XG_DEFINE_PROCEDURE(pango_attr_size_new, gxg_pango_attr_size_new_w, 1, 0, 0, H_pango_attr_size_new);
- XG_DEFINE_PROCEDURE(pango_attr_style_new, gxg_pango_attr_style_new_w, 1, 0, 0, H_pango_attr_style_new);
- XG_DEFINE_PROCEDURE(pango_attr_weight_new, gxg_pango_attr_weight_new_w, 1, 0, 0, H_pango_attr_weight_new);
- XG_DEFINE_PROCEDURE(pango_attr_variant_new, gxg_pango_attr_variant_new_w, 1, 0, 0, H_pango_attr_variant_new);
- XG_DEFINE_PROCEDURE(pango_attr_stretch_new, gxg_pango_attr_stretch_new_w, 1, 0, 0, H_pango_attr_stretch_new);
- XG_DEFINE_PROCEDURE(pango_attr_font_desc_new, gxg_pango_attr_font_desc_new_w, 1, 0, 0, H_pango_attr_font_desc_new);
- XG_DEFINE_PROCEDURE(pango_attr_underline_new, gxg_pango_attr_underline_new_w, 1, 0, 0, H_pango_attr_underline_new);
- XG_DEFINE_PROCEDURE(pango_attr_strikethrough_new, gxg_pango_attr_strikethrough_new_w, 1, 0, 0, H_pango_attr_strikethrough_new);
- XG_DEFINE_PROCEDURE(pango_attr_rise_new, gxg_pango_attr_rise_new_w, 1, 0, 0, H_pango_attr_rise_new);
- XG_DEFINE_PROCEDURE(pango_attr_shape_new, gxg_pango_attr_shape_new_w, 2, 0, 0, H_pango_attr_shape_new);
- XG_DEFINE_PROCEDURE(pango_attr_scale_new, gxg_pango_attr_scale_new_w, 1, 0, 0, H_pango_attr_scale_new);
- XG_DEFINE_PROCEDURE(pango_attr_list_new, gxg_pango_attr_list_new_w, 0, 0, 0, H_pango_attr_list_new);
- XG_DEFINE_PROCEDURE(pango_attr_list_unref, gxg_pango_attr_list_unref_w, 1, 0, 0, H_pango_attr_list_unref);
- XG_DEFINE_PROCEDURE(pango_attr_list_copy, gxg_pango_attr_list_copy_w, 1, 0, 0, H_pango_attr_list_copy);
- XG_DEFINE_PROCEDURE(pango_attr_list_insert, gxg_pango_attr_list_insert_w, 2, 0, 0, H_pango_attr_list_insert);
- XG_DEFINE_PROCEDURE(pango_attr_list_insert_before, gxg_pango_attr_list_insert_before_w, 2, 0, 0, H_pango_attr_list_insert_before);
- XG_DEFINE_PROCEDURE(pango_attr_list_change, gxg_pango_attr_list_change_w, 2, 0, 0, H_pango_attr_list_change);
- XG_DEFINE_PROCEDURE(pango_attr_list_splice, gxg_pango_attr_list_splice_w, 4, 0, 0, H_pango_attr_list_splice);
- XG_DEFINE_PROCEDURE(pango_attr_list_get_iterator, gxg_pango_attr_list_get_iterator_w, 1, 0, 0, H_pango_attr_list_get_iterator);
- XG_DEFINE_PROCEDURE(pango_attr_iterator_range, gxg_pango_attr_iterator_range_w, 1, 2, 0, H_pango_attr_iterator_range);
- XG_DEFINE_PROCEDURE(pango_attr_iterator_next, gxg_pango_attr_iterator_next_w, 1, 0, 0, H_pango_attr_iterator_next);
- XG_DEFINE_PROCEDURE(pango_attr_iterator_copy, gxg_pango_attr_iterator_copy_w, 1, 0, 0, H_pango_attr_iterator_copy);
- XG_DEFINE_PROCEDURE(pango_attr_iterator_destroy, gxg_pango_attr_iterator_destroy_w, 1, 0, 0, H_pango_attr_iterator_destroy);
- XG_DEFINE_PROCEDURE(pango_attr_iterator_get, gxg_pango_attr_iterator_get_w, 2, 0, 0, H_pango_attr_iterator_get);
- XG_DEFINE_PROCEDURE(pango_attr_iterator_get_font, gxg_pango_attr_iterator_get_font_w, 2, 2, 0, H_pango_attr_iterator_get_font);
- XG_DEFINE_PROCEDURE(pango_parse_markup, gxg_pango_parse_markup_w, 6, 1, 0, H_pango_parse_markup);
- XG_DEFINE_PROCEDURE(pango_break, gxg_pango_break_w, 5, 0, 0, H_pango_break);
- XG_DEFINE_PROCEDURE(pango_find_paragraph_boundary, gxg_pango_find_paragraph_boundary_w, 2, 2, 0, H_pango_find_paragraph_boundary);
- XG_DEFINE_PROCEDURE(pango_get_log_attrs, gxg_pango_get_log_attrs_w, 6, 0, 0, H_pango_get_log_attrs);
- XG_DEFINE_PROCEDURE(pango_context_list_families, gxg_pango_context_list_families_w, 1, 2, 0, H_pango_context_list_families);
- XG_DEFINE_PROCEDURE(pango_context_load_font, gxg_pango_context_load_font_w, 2, 0, 0, H_pango_context_load_font);
- XG_DEFINE_PROCEDURE(pango_context_load_fontset, gxg_pango_context_load_fontset_w, 3, 0, 0, H_pango_context_load_fontset);
- XG_DEFINE_PROCEDURE(pango_context_get_metrics, gxg_pango_context_get_metrics_w, 3, 0, 0, H_pango_context_get_metrics);
- XG_DEFINE_PROCEDURE(pango_context_set_font_description, gxg_pango_context_set_font_description_w, 2, 0, 0, H_pango_context_set_font_description);
- XG_DEFINE_PROCEDURE(pango_context_get_font_description, gxg_pango_context_get_font_description_w, 1, 0, 0, H_pango_context_get_font_description);
- XG_DEFINE_PROCEDURE(pango_context_get_language, gxg_pango_context_get_language_w, 1, 0, 0, H_pango_context_get_language);
- XG_DEFINE_PROCEDURE(pango_context_set_language, gxg_pango_context_set_language_w, 2, 0, 0, H_pango_context_set_language);
- XG_DEFINE_PROCEDURE(pango_context_set_base_dir, gxg_pango_context_set_base_dir_w, 2, 0, 0, H_pango_context_set_base_dir);
- XG_DEFINE_PROCEDURE(pango_context_get_base_dir, gxg_pango_context_get_base_dir_w, 1, 0, 0, H_pango_context_get_base_dir);
- XG_DEFINE_PROCEDURE(pango_itemize, gxg_pango_itemize_w, 6, 0, 0, H_pango_itemize);
- XG_DEFINE_PROCEDURE(pango_coverage_new, gxg_pango_coverage_new_w, 0, 0, 0, H_pango_coverage_new);
- XG_DEFINE_PROCEDURE(pango_coverage_ref, gxg_pango_coverage_ref_w, 1, 0, 0, H_pango_coverage_ref);
- XG_DEFINE_PROCEDURE(pango_coverage_unref, gxg_pango_coverage_unref_w, 1, 0, 0, H_pango_coverage_unref);
- XG_DEFINE_PROCEDURE(pango_coverage_copy, gxg_pango_coverage_copy_w, 1, 0, 0, H_pango_coverage_copy);
- XG_DEFINE_PROCEDURE(pango_coverage_get, gxg_pango_coverage_get_w, 2, 0, 0, H_pango_coverage_get);
- XG_DEFINE_PROCEDURE(pango_coverage_set, gxg_pango_coverage_set_w, 3, 0, 0, H_pango_coverage_set);
- XG_DEFINE_PROCEDURE(pango_coverage_max, gxg_pango_coverage_max_w, 2, 0, 0, H_pango_coverage_max);
- XG_DEFINE_PROCEDURE(pango_coverage_to_bytes, gxg_pango_coverage_to_bytes_w, 1, 2, 0, H_pango_coverage_to_bytes);
- XG_DEFINE_PROCEDURE(pango_coverage_from_bytes, gxg_pango_coverage_from_bytes_w, 2, 0, 0, H_pango_coverage_from_bytes);
- XG_DEFINE_PROCEDURE(pango_font_description_new, gxg_pango_font_description_new_w, 0, 0, 0, H_pango_font_description_new);
- XG_DEFINE_PROCEDURE(pango_font_description_copy, gxg_pango_font_description_copy_w, 1, 0, 0, H_pango_font_description_copy);
- XG_DEFINE_PROCEDURE(pango_font_description_copy_static, gxg_pango_font_description_copy_static_w, 1, 0, 0, H_pango_font_description_copy_static);
- XG_DEFINE_PROCEDURE(pango_font_description_hash, gxg_pango_font_description_hash_w, 1, 0, 0, H_pango_font_description_hash);
- XG_DEFINE_PROCEDURE(pango_font_description_equal, gxg_pango_font_description_equal_w, 2, 0, 0, H_pango_font_description_equal);
- XG_DEFINE_PROCEDURE(pango_font_description_free, gxg_pango_font_description_free_w, 1, 0, 0, H_pango_font_description_free);
- XG_DEFINE_PROCEDURE(pango_font_descriptions_free, gxg_pango_font_descriptions_free_w, 2, 0, 0, H_pango_font_descriptions_free);
- XG_DEFINE_PROCEDURE(pango_font_description_set_family, gxg_pango_font_description_set_family_w, 2, 0, 0, H_pango_font_description_set_family);
- XG_DEFINE_PROCEDURE(pango_font_description_set_family_static, gxg_pango_font_description_set_family_static_w, 2, 0, 0, H_pango_font_description_set_family_static);
- XG_DEFINE_PROCEDURE(pango_font_description_get_family, gxg_pango_font_description_get_family_w, 1, 0, 0, H_pango_font_description_get_family);
- XG_DEFINE_PROCEDURE(pango_font_description_set_style, gxg_pango_font_description_set_style_w, 2, 0, 0, H_pango_font_description_set_style);
- XG_DEFINE_PROCEDURE(pango_font_description_get_style, gxg_pango_font_description_get_style_w, 1, 0, 0, H_pango_font_description_get_style);
- XG_DEFINE_PROCEDURE(pango_font_description_set_variant, gxg_pango_font_description_set_variant_w, 2, 0, 0, H_pango_font_description_set_variant);
- XG_DEFINE_PROCEDURE(pango_font_description_get_variant, gxg_pango_font_description_get_variant_w, 1, 0, 0, H_pango_font_description_get_variant);
- XG_DEFINE_PROCEDURE(pango_font_description_set_weight, gxg_pango_font_description_set_weight_w, 2, 0, 0, H_pango_font_description_set_weight);
- XG_DEFINE_PROCEDURE(pango_font_description_get_weight, gxg_pango_font_description_get_weight_w, 1, 0, 0, H_pango_font_description_get_weight);
- XG_DEFINE_PROCEDURE(pango_font_description_set_stretch, gxg_pango_font_description_set_stretch_w, 2, 0, 0, H_pango_font_description_set_stretch);
- XG_DEFINE_PROCEDURE(pango_font_description_get_stretch, gxg_pango_font_description_get_stretch_w, 1, 0, 0, H_pango_font_description_get_stretch);
- XG_DEFINE_PROCEDURE(pango_font_description_set_size, gxg_pango_font_description_set_size_w, 2, 0, 0, H_pango_font_description_set_size);
- XG_DEFINE_PROCEDURE(pango_font_description_get_size, gxg_pango_font_description_get_size_w, 1, 0, 0, H_pango_font_description_get_size);
- XG_DEFINE_PROCEDURE(pango_font_description_get_set_fields, gxg_pango_font_description_get_set_fields_w, 1, 0, 0, H_pango_font_description_get_set_fields);
- XG_DEFINE_PROCEDURE(pango_font_description_unset_fields, gxg_pango_font_description_unset_fields_w, 2, 0, 0, H_pango_font_description_unset_fields);
- XG_DEFINE_PROCEDURE(pango_font_description_merge, gxg_pango_font_description_merge_w, 3, 0, 0, H_pango_font_description_merge);
- XG_DEFINE_PROCEDURE(pango_font_description_merge_static, gxg_pango_font_description_merge_static_w, 3, 0, 0, H_pango_font_description_merge_static);
- XG_DEFINE_PROCEDURE(pango_font_description_better_match, gxg_pango_font_description_better_match_w, 3, 0, 0, H_pango_font_description_better_match);
- XG_DEFINE_PROCEDURE(pango_font_description_from_string, gxg_pango_font_description_from_string_w, 1, 0, 0, H_pango_font_description_from_string);
- XG_DEFINE_PROCEDURE(pango_font_description_to_string, gxg_pango_font_description_to_string_w, 1, 0, 0, H_pango_font_description_to_string);
- XG_DEFINE_PROCEDURE(pango_font_description_to_filename, gxg_pango_font_description_to_filename_w, 1, 0, 0, H_pango_font_description_to_filename);
- XG_DEFINE_PROCEDURE(pango_font_metrics_ref, gxg_pango_font_metrics_ref_w, 1, 0, 0, H_pango_font_metrics_ref);
- XG_DEFINE_PROCEDURE(pango_font_metrics_unref, gxg_pango_font_metrics_unref_w, 1, 0, 0, H_pango_font_metrics_unref);
- XG_DEFINE_PROCEDURE(pango_font_metrics_get_ascent, gxg_pango_font_metrics_get_ascent_w, 1, 0, 0, H_pango_font_metrics_get_ascent);
- XG_DEFINE_PROCEDURE(pango_font_metrics_get_descent, gxg_pango_font_metrics_get_descent_w, 1, 0, 0, H_pango_font_metrics_get_descent);
- XG_DEFINE_PROCEDURE(pango_font_metrics_get_approximate_char_width, gxg_pango_font_metrics_get_approximate_char_width_w, 1, 0, 0, H_pango_font_metrics_get_approximate_char_width);
- XG_DEFINE_PROCEDURE(pango_font_metrics_get_approximate_digit_width, gxg_pango_font_metrics_get_approximate_digit_width_w, 1, 0, 0, H_pango_font_metrics_get_approximate_digit_width);
- XG_DEFINE_PROCEDURE(pango_font_family_list_faces, gxg_pango_font_family_list_faces_w, 1, 2, 0, H_pango_font_family_list_faces);
- XG_DEFINE_PROCEDURE(pango_font_family_get_name, gxg_pango_font_family_get_name_w, 1, 0, 0, H_pango_font_family_get_name);
- XG_DEFINE_PROCEDURE(pango_font_face_describe, gxg_pango_font_face_describe_w, 1, 0, 0, H_pango_font_face_describe);
- XG_DEFINE_PROCEDURE(pango_font_face_get_face_name, gxg_pango_font_face_get_face_name_w, 1, 0, 0, H_pango_font_face_get_face_name);
- XG_DEFINE_PROCEDURE(pango_font_describe, gxg_pango_font_describe_w, 1, 0, 0, H_pango_font_describe);
- XG_DEFINE_PROCEDURE(pango_font_get_coverage, gxg_pango_font_get_coverage_w, 2, 0, 0, H_pango_font_get_coverage);
- XG_DEFINE_PROCEDURE(pango_font_get_metrics, gxg_pango_font_get_metrics_w, 2, 0, 0, H_pango_font_get_metrics);
- XG_DEFINE_PROCEDURE(pango_font_get_glyph_extents, gxg_pango_font_get_glyph_extents_w, 4, 0, 0, H_pango_font_get_glyph_extents);
- XG_DEFINE_PROCEDURE(pango_font_map_load_font, gxg_pango_font_map_load_font_w, 3, 0, 0, H_pango_font_map_load_font);
- XG_DEFINE_PROCEDURE(pango_font_map_load_fontset, gxg_pango_font_map_load_fontset_w, 4, 0, 0, H_pango_font_map_load_fontset);
- XG_DEFINE_PROCEDURE(pango_font_map_list_families, gxg_pango_font_map_list_families_w, 1, 2, 0, H_pango_font_map_list_families);
- XG_DEFINE_PROCEDURE(pango_glyph_string_new, gxg_pango_glyph_string_new_w, 0, 0, 0, H_pango_glyph_string_new);
- XG_DEFINE_PROCEDURE(pango_glyph_string_set_size, gxg_pango_glyph_string_set_size_w, 2, 0, 0, H_pango_glyph_string_set_size);
- XG_DEFINE_PROCEDURE(pango_glyph_string_copy, gxg_pango_glyph_string_copy_w, 1, 0, 0, H_pango_glyph_string_copy);
- XG_DEFINE_PROCEDURE(pango_glyph_string_free, gxg_pango_glyph_string_free_w, 1, 0, 0, H_pango_glyph_string_free);
- XG_DEFINE_PROCEDURE(pango_glyph_string_extents, gxg_pango_glyph_string_extents_w, 4, 0, 0, H_pango_glyph_string_extents);
- XG_DEFINE_PROCEDURE(pango_glyph_string_extents_range, gxg_pango_glyph_string_extents_range_w, 6, 0, 0, H_pango_glyph_string_extents_range);
- XG_DEFINE_PROCEDURE(pango_glyph_string_get_logical_widths, gxg_pango_glyph_string_get_logical_widths_w, 4, 1, 0, H_pango_glyph_string_get_logical_widths);
- XG_DEFINE_PROCEDURE(pango_glyph_string_index_to_x, gxg_pango_glyph_string_index_to_x_w, 6, 1, 0, H_pango_glyph_string_index_to_x);
- XG_DEFINE_PROCEDURE(pango_glyph_string_x_to_index, gxg_pango_glyph_string_x_to_index_w, 5, 2, 0, H_pango_glyph_string_x_to_index);
- XG_DEFINE_PROCEDURE(pango_shape, gxg_pango_shape_w, 4, 0, 0, H_pango_shape);
- XG_DEFINE_PROCEDURE(pango_reorder_items, gxg_pango_reorder_items_w, 1, 0, 0, H_pango_reorder_items);
- XG_DEFINE_PROCEDURE(pango_item_new, gxg_pango_item_new_w, 0, 0, 0, H_pango_item_new);
- XG_DEFINE_PROCEDURE(pango_item_copy, gxg_pango_item_copy_w, 1, 0, 0, H_pango_item_copy);
- XG_DEFINE_PROCEDURE(pango_item_free, gxg_pango_item_free_w, 1, 0, 0, H_pango_item_free);
- XG_DEFINE_PROCEDURE(pango_item_split, gxg_pango_item_split_w, 3, 0, 0, H_pango_item_split);
- XG_DEFINE_PROCEDURE(pango_layout_new, gxg_pango_layout_new_w, 1, 0, 0, H_pango_layout_new);
- XG_DEFINE_PROCEDURE(pango_layout_copy, gxg_pango_layout_copy_w, 1, 0, 0, H_pango_layout_copy);
- XG_DEFINE_PROCEDURE(pango_layout_get_context, gxg_pango_layout_get_context_w, 1, 0, 0, H_pango_layout_get_context);
- XG_DEFINE_PROCEDURE(pango_layout_set_attributes, gxg_pango_layout_set_attributes_w, 2, 0, 0, H_pango_layout_set_attributes);
- XG_DEFINE_PROCEDURE(pango_layout_get_attributes, gxg_pango_layout_get_attributes_w, 1, 0, 0, H_pango_layout_get_attributes);
- XG_DEFINE_PROCEDURE(pango_layout_set_text, gxg_pango_layout_set_text_w, 3, 0, 0, H_pango_layout_set_text);
- XG_DEFINE_PROCEDURE(pango_layout_get_text, gxg_pango_layout_get_text_w, 1, 0, 0, H_pango_layout_get_text);
- XG_DEFINE_PROCEDURE(pango_layout_set_markup, gxg_pango_layout_set_markup_w, 3, 0, 0, H_pango_layout_set_markup);
- XG_DEFINE_PROCEDURE(pango_layout_set_markup_with_accel, gxg_pango_layout_set_markup_with_accel_w, 5, 0, 0, H_pango_layout_set_markup_with_accel);
- XG_DEFINE_PROCEDURE(pango_layout_set_font_description, gxg_pango_layout_set_font_description_w, 2, 0, 0, H_pango_layout_set_font_description);
- XG_DEFINE_PROCEDURE(pango_layout_set_width, gxg_pango_layout_set_width_w, 2, 0, 0, H_pango_layout_set_width);
- XG_DEFINE_PROCEDURE(pango_layout_get_width, gxg_pango_layout_get_width_w, 1, 0, 0, H_pango_layout_get_width);
- XG_DEFINE_PROCEDURE(pango_layout_set_wrap, gxg_pango_layout_set_wrap_w, 2, 0, 0, H_pango_layout_set_wrap);
- XG_DEFINE_PROCEDURE(pango_layout_get_wrap, gxg_pango_layout_get_wrap_w, 1, 0, 0, H_pango_layout_get_wrap);
- XG_DEFINE_PROCEDURE(pango_layout_set_indent, gxg_pango_layout_set_indent_w, 2, 0, 0, H_pango_layout_set_indent);
- XG_DEFINE_PROCEDURE(pango_layout_get_indent, gxg_pango_layout_get_indent_w, 1, 0, 0, H_pango_layout_get_indent);
- XG_DEFINE_PROCEDURE(pango_layout_set_spacing, gxg_pango_layout_set_spacing_w, 2, 0, 0, H_pango_layout_set_spacing);
- XG_DEFINE_PROCEDURE(pango_layout_get_spacing, gxg_pango_layout_get_spacing_w, 1, 0, 0, H_pango_layout_get_spacing);
- XG_DEFINE_PROCEDURE(pango_layout_set_justify, gxg_pango_layout_set_justify_w, 2, 0, 0, H_pango_layout_set_justify);
- XG_DEFINE_PROCEDURE(pango_layout_get_justify, gxg_pango_layout_get_justify_w, 1, 0, 0, H_pango_layout_get_justify);
- XG_DEFINE_PROCEDURE(pango_layout_set_alignment, gxg_pango_layout_set_alignment_w, 2, 0, 0, H_pango_layout_set_alignment);
- XG_DEFINE_PROCEDURE(pango_layout_get_alignment, gxg_pango_layout_get_alignment_w, 1, 0, 0, H_pango_layout_get_alignment);
- XG_DEFINE_PROCEDURE(pango_layout_set_tabs, gxg_pango_layout_set_tabs_w, 2, 0, 0, H_pango_layout_set_tabs);
- XG_DEFINE_PROCEDURE(pango_layout_get_tabs, gxg_pango_layout_get_tabs_w, 1, 0, 0, H_pango_layout_get_tabs);
- XG_DEFINE_PROCEDURE(pango_layout_set_single_paragraph_mode, gxg_pango_layout_set_single_paragraph_mode_w, 2, 0, 0, H_pango_layout_set_single_paragraph_mode);
- XG_DEFINE_PROCEDURE(pango_layout_get_single_paragraph_mode, gxg_pango_layout_get_single_paragraph_mode_w, 1, 0, 0, H_pango_layout_get_single_paragraph_mode);
- XG_DEFINE_PROCEDURE(pango_layout_context_changed, gxg_pango_layout_context_changed_w, 1, 0, 0, H_pango_layout_context_changed);
- XG_DEFINE_PROCEDURE(pango_layout_get_log_attrs, gxg_pango_layout_get_log_attrs_w, 1, 2, 0, H_pango_layout_get_log_attrs);
- XG_DEFINE_PROCEDURE(pango_layout_index_to_pos, gxg_pango_layout_index_to_pos_w, 3, 0, 0, H_pango_layout_index_to_pos);
- XG_DEFINE_PROCEDURE(pango_layout_get_cursor_pos, gxg_pango_layout_get_cursor_pos_w, 4, 0, 0, H_pango_layout_get_cursor_pos);
- XG_DEFINE_PROCEDURE(pango_layout_move_cursor_visually, gxg_pango_layout_move_cursor_visually_w, 7, 0, 0, H_pango_layout_move_cursor_visually);
- XG_DEFINE_PROCEDURE(pango_layout_xy_to_index, gxg_pango_layout_xy_to_index_w, 3, 2, 0, H_pango_layout_xy_to_index);
- XG_DEFINE_PROCEDURE(pango_layout_get_extents, gxg_pango_layout_get_extents_w, 3, 0, 0, H_pango_layout_get_extents);
- XG_DEFINE_PROCEDURE(pango_layout_get_pixel_extents, gxg_pango_layout_get_pixel_extents_w, 3, 0, 0, H_pango_layout_get_pixel_extents);
- XG_DEFINE_PROCEDURE(pango_layout_get_size, gxg_pango_layout_get_size_w, 1, 2, 0, H_pango_layout_get_size);
- XG_DEFINE_PROCEDURE(pango_layout_get_pixel_size, gxg_pango_layout_get_pixel_size_w, 1, 2, 0, H_pango_layout_get_pixel_size);
- XG_DEFINE_PROCEDURE(pango_layout_get_line_count, gxg_pango_layout_get_line_count_w, 1, 0, 0, H_pango_layout_get_line_count);
- XG_DEFINE_PROCEDURE(pango_layout_get_line, gxg_pango_layout_get_line_w, 2, 0, 0, H_pango_layout_get_line);
- XG_DEFINE_PROCEDURE(pango_layout_get_lines, gxg_pango_layout_get_lines_w, 1, 0, 0, H_pango_layout_get_lines);
- XG_DEFINE_PROCEDURE(pango_layout_line_unref, gxg_pango_layout_line_unref_w, 1, 0, 0, H_pango_layout_line_unref);
- XG_DEFINE_PROCEDURE(pango_layout_line_x_to_index, gxg_pango_layout_line_x_to_index_w, 2, 2, 0, H_pango_layout_line_x_to_index);
- XG_DEFINE_PROCEDURE(pango_layout_line_index_to_x, gxg_pango_layout_line_index_to_x_w, 3, 1, 0, H_pango_layout_line_index_to_x);
- XG_DEFINE_PROCEDURE(pango_layout_line_get_x_ranges, gxg_pango_layout_line_get_x_ranges_w, 3, 2, 0, H_pango_layout_line_get_x_ranges);
- XG_DEFINE_PROCEDURE(pango_layout_line_get_extents, gxg_pango_layout_line_get_extents_w, 3, 0, 0, H_pango_layout_line_get_extents);
- XG_DEFINE_PROCEDURE(pango_layout_line_get_pixel_extents, gxg_pango_layout_line_get_pixel_extents_w, 3, 0, 0, H_pango_layout_line_get_pixel_extents);
- XG_DEFINE_PROCEDURE(pango_layout_get_iter, gxg_pango_layout_get_iter_w, 1, 0, 0, H_pango_layout_get_iter);
- XG_DEFINE_PROCEDURE(pango_layout_iter_free, gxg_pango_layout_iter_free_w, 1, 0, 0, H_pango_layout_iter_free);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_index, gxg_pango_layout_iter_get_index_w, 1, 0, 0, H_pango_layout_iter_get_index);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_run, gxg_pango_layout_iter_get_run_w, 1, 0, 0, H_pango_layout_iter_get_run);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_line, gxg_pango_layout_iter_get_line_w, 1, 0, 0, H_pango_layout_iter_get_line);
- XG_DEFINE_PROCEDURE(pango_layout_iter_at_last_line, gxg_pango_layout_iter_at_last_line_w, 1, 0, 0, H_pango_layout_iter_at_last_line);
- XG_DEFINE_PROCEDURE(pango_layout_iter_next_char, gxg_pango_layout_iter_next_char_w, 1, 0, 0, H_pango_layout_iter_next_char);
- XG_DEFINE_PROCEDURE(pango_layout_iter_next_cluster, gxg_pango_layout_iter_next_cluster_w, 1, 0, 0, H_pango_layout_iter_next_cluster);
- XG_DEFINE_PROCEDURE(pango_layout_iter_next_run, gxg_pango_layout_iter_next_run_w, 1, 0, 0, H_pango_layout_iter_next_run);
- XG_DEFINE_PROCEDURE(pango_layout_iter_next_line, gxg_pango_layout_iter_next_line_w, 1, 0, 0, H_pango_layout_iter_next_line);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_char_extents, gxg_pango_layout_iter_get_char_extents_w, 2, 0, 0, H_pango_layout_iter_get_char_extents);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_cluster_extents, gxg_pango_layout_iter_get_cluster_extents_w, 3, 0, 0, H_pango_layout_iter_get_cluster_extents);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_run_extents, gxg_pango_layout_iter_get_run_extents_w, 3, 0, 0, H_pango_layout_iter_get_run_extents);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_line_extents, gxg_pango_layout_iter_get_line_extents_w, 3, 0, 0, H_pango_layout_iter_get_line_extents);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_line_yrange, gxg_pango_layout_iter_get_line_yrange_w, 1, 2, 0, H_pango_layout_iter_get_line_yrange);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_layout_extents, gxg_pango_layout_iter_get_layout_extents_w, 3, 0, 0, H_pango_layout_iter_get_layout_extents);
- XG_DEFINE_PROCEDURE(pango_layout_iter_get_baseline, gxg_pango_layout_iter_get_baseline_w, 1, 0, 0, H_pango_layout_iter_get_baseline);
- XG_DEFINE_PROCEDURE(pango_language_from_string, gxg_pango_language_from_string_w, 1, 0, 0, H_pango_language_from_string);
- XG_DEFINE_PROCEDURE(pango_language_matches, gxg_pango_language_matches_w, 2, 0, 0, H_pango_language_matches);
- XG_DEFINE_PROCEDURE(G_OBJECT_TYPE, gxg_G_OBJECT_TYPE_w, 1, 0, 0, H_G_OBJECT_TYPE);
- XG_DEFINE_PROCEDURE(g_utf8_validate, gxg_g_utf8_validate_w, 2, 1, 0, H_g_utf8_validate);
- XG_DEFINE_PROCEDURE(gtk_tree_model_get_string_from_iter, gxg_gtk_tree_model_get_string_from_iter_w, 2, 0, 0, H_gtk_tree_model_get_string_from_iter);
- XG_DEFINE_PROCEDURE(gtk_tree_model_sort_iter_is_valid, gxg_gtk_tree_model_sort_iter_is_valid_w, 2, 0, 0, H_gtk_tree_model_sort_iter_is_valid);
- XG_DEFINE_PROCEDURE(gtk_tree_view_expand_to_path, gxg_gtk_tree_view_expand_to_path_w, 2, 0, 0, H_gtk_tree_view_expand_to_path);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_get_selected_rows, gxg_gtk_tree_selection_get_selected_rows_w, 2, 0, 0, H_gtk_tree_selection_get_selected_rows);
- XG_DEFINE_PROCEDURE(gtk_tree_selection_count_selected_rows, gxg_gtk_tree_selection_count_selected_rows_w, 1, 0, 0, H_gtk_tree_selection_count_selected_rows);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_select_first, gxg_gtk_menu_shell_select_first_w, 2, 0, 0, H_gtk_menu_shell_select_first);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_n_pages, gxg_gtk_notebook_get_n_pages_w, 1, 0, 0, H_gtk_notebook_get_n_pages);
- XG_DEFINE_PROCEDURE(gtk_list_store_reorder, gxg_gtk_list_store_reorder_w, 2, 0, 0, H_gtk_list_store_reorder);
- XG_DEFINE_PROCEDURE(gtk_list_store_swap, gxg_gtk_list_store_swap_w, 3, 0, 0, H_gtk_list_store_swap);
- XG_DEFINE_PROCEDURE(gtk_list_store_move_after, gxg_gtk_list_store_move_after_w, 3, 0, 0, H_gtk_list_store_move_after);
- XG_DEFINE_PROCEDURE(gtk_list_store_move_before, gxg_gtk_list_store_move_before_w, 3, 0, 0, H_gtk_list_store_move_before);
- XG_DEFINE_PROCEDURE(gtk_tree_store_reorder, gxg_gtk_tree_store_reorder_w, 3, 0, 0, H_gtk_tree_store_reorder);
- XG_DEFINE_PROCEDURE(gtk_tree_store_swap, gxg_gtk_tree_store_swap_w, 3, 0, 0, H_gtk_tree_store_swap);
- XG_DEFINE_PROCEDURE(gdk_display_open, gxg_gdk_display_open_w, 1, 0, 0, H_gdk_display_open);
- XG_DEFINE_PROCEDURE(gdk_display_get_name, gxg_gdk_display_get_name_w, 1, 0, 0, H_gdk_display_get_name);
- XG_DEFINE_PROCEDURE(gdk_display_get_n_screens, gxg_gdk_display_get_n_screens_w, 1, 0, 0, H_gdk_display_get_n_screens);
- XG_DEFINE_PROCEDURE(gdk_display_get_screen, gxg_gdk_display_get_screen_w, 2, 0, 0, H_gdk_display_get_screen);
- XG_DEFINE_PROCEDURE(gdk_display_get_default_screen, gxg_gdk_display_get_default_screen_w, 1, 0, 0, H_gdk_display_get_default_screen);
- XG_DEFINE_PROCEDURE(gdk_display_beep, gxg_gdk_display_beep_w, 1, 0, 0, H_gdk_display_beep);
- XG_DEFINE_PROCEDURE(gdk_display_sync, gxg_gdk_display_sync_w, 1, 0, 0, H_gdk_display_sync);
- XG_DEFINE_PROCEDURE(gdk_display_close, gxg_gdk_display_close_w, 1, 0, 0, H_gdk_display_close);
- XG_DEFINE_PROCEDURE(gdk_display_get_event, gxg_gdk_display_get_event_w, 1, 0, 0, H_gdk_display_get_event);
- XG_DEFINE_PROCEDURE(gdk_display_peek_event, gxg_gdk_display_peek_event_w, 1, 0, 0, H_gdk_display_peek_event);
- XG_DEFINE_PROCEDURE(gdk_display_put_event, gxg_gdk_display_put_event_w, 2, 0, 0, H_gdk_display_put_event);
- XG_DEFINE_PROCEDURE(gdk_display_set_double_click_time, gxg_gdk_display_set_double_click_time_w, 2, 0, 0, H_gdk_display_set_double_click_time);
- XG_DEFINE_PROCEDURE(gdk_display_get_default, gxg_gdk_display_get_default_w, 0, 0, 0, H_gdk_display_get_default);
- XG_DEFINE_PROCEDURE(gdk_screen_get_system_visual, gxg_gdk_screen_get_system_visual_w, 1, 0, 0, H_gdk_screen_get_system_visual);
- XG_DEFINE_PROCEDURE(gdk_screen_get_root_window, gxg_gdk_screen_get_root_window_w, 1, 0, 0, H_gdk_screen_get_root_window);
- XG_DEFINE_PROCEDURE(gdk_screen_get_display, gxg_gdk_screen_get_display_w, 1, 0, 0, H_gdk_screen_get_display);
- XG_DEFINE_PROCEDURE(gdk_screen_get_number, gxg_gdk_screen_get_number_w, 1, 0, 0, H_gdk_screen_get_number);
- XG_DEFINE_PROCEDURE(gdk_screen_get_width, gxg_gdk_screen_get_width_w, 1, 0, 0, H_gdk_screen_get_width);
- XG_DEFINE_PROCEDURE(gdk_screen_get_height, gxg_gdk_screen_get_height_w, 1, 0, 0, H_gdk_screen_get_height);
- XG_DEFINE_PROCEDURE(gdk_screen_get_width_mm, gxg_gdk_screen_get_width_mm_w, 1, 0, 0, H_gdk_screen_get_width_mm);
- XG_DEFINE_PROCEDURE(gdk_screen_get_height_mm, gxg_gdk_screen_get_height_mm_w, 1, 0, 0, H_gdk_screen_get_height_mm);
- XG_DEFINE_PROCEDURE(gdk_screen_list_visuals, gxg_gdk_screen_list_visuals_w, 1, 0, 0, H_gdk_screen_list_visuals);
- XG_DEFINE_PROCEDURE(gdk_screen_get_toplevel_windows, gxg_gdk_screen_get_toplevel_windows_w, 1, 0, 0, H_gdk_screen_get_toplevel_windows);
- XG_DEFINE_PROCEDURE(gdk_screen_make_display_name, gxg_gdk_screen_make_display_name_w, 1, 0, 0, H_gdk_screen_make_display_name);
- XG_DEFINE_PROCEDURE(gdk_screen_get_n_monitors, gxg_gdk_screen_get_n_monitors_w, 1, 0, 0, H_gdk_screen_get_n_monitors);
- XG_DEFINE_PROCEDURE(gdk_screen_get_monitor_geometry, gxg_gdk_screen_get_monitor_geometry_w, 3, 0, 0, H_gdk_screen_get_monitor_geometry);
- XG_DEFINE_PROCEDURE(gdk_screen_get_monitor_at_point, gxg_gdk_screen_get_monitor_at_point_w, 3, 0, 0, H_gdk_screen_get_monitor_at_point);
- XG_DEFINE_PROCEDURE(gdk_screen_get_monitor_at_window, gxg_gdk_screen_get_monitor_at_window_w, 2, 0, 0, H_gdk_screen_get_monitor_at_window);
- XG_DEFINE_PROCEDURE(gdk_screen_get_default, gxg_gdk_screen_get_default_w, 0, 0, 0, H_gdk_screen_get_default);
- XG_DEFINE_PROCEDURE(gtk_clipboard_get_for_display, gxg_gtk_clipboard_get_for_display_w, 2, 0, 0, H_gtk_clipboard_get_for_display);
- XG_DEFINE_PROCEDURE(gtk_clipboard_get_display, gxg_gtk_clipboard_get_display_w, 1, 0, 0, H_gtk_clipboard_get_display);
- XG_DEFINE_PROCEDURE(gtk_widget_get_screen, gxg_gtk_widget_get_screen_w, 1, 0, 0, H_gtk_widget_get_screen);
- XG_DEFINE_PROCEDURE(gtk_widget_has_screen, gxg_gtk_widget_has_screen_w, 1, 0, 0, H_gtk_widget_has_screen);
- XG_DEFINE_PROCEDURE(gtk_widget_get_display, gxg_gtk_widget_get_display_w, 1, 0, 0, H_gtk_widget_get_display);
- XG_DEFINE_PROCEDURE(gtk_widget_get_root_window, gxg_gtk_widget_get_root_window_w, 1, 0, 0, H_gtk_widget_get_root_window);
- XG_DEFINE_PROCEDURE(gtk_widget_get_clipboard, gxg_gtk_widget_get_clipboard_w, 2, 0, 0, H_gtk_widget_get_clipboard);
- XG_DEFINE_PROCEDURE(g_list_free, gxg_g_list_free_w, 1, 0, 0, H_g_list_free);
- XG_DEFINE_PROCEDURE(g_list_reverse, gxg_g_list_reverse_w, 1, 0, 0, H_g_list_reverse);
- XG_DEFINE_PROCEDURE(g_list_copy, gxg_g_list_copy_w, 1, 0, 0, H_g_list_copy);
- XG_DEFINE_PROCEDURE(g_list_last, gxg_g_list_last_w, 1, 0, 0, H_g_list_last);
- XG_DEFINE_PROCEDURE(g_list_first, gxg_g_list_first_w, 1, 0, 0, H_g_list_first);
- XG_DEFINE_PROCEDURE(g_list_length, gxg_g_list_length_w, 1, 0, 0, H_g_list_length);
- XG_DEFINE_PROCEDURE(g_free, gxg_g_free_w, 1, 0, 0, H_g_free);
- XG_DEFINE_PROCEDURE(g_list_remove_link, gxg_g_list_remove_link_w, 2, 0, 0, H_g_list_remove_link);
- XG_DEFINE_PROCEDURE(g_object_get_data, gxg_g_object_get_data_w, 2, 0, 0, H_g_object_get_data);
- XG_DEFINE_PROCEDURE(g_object_set_data, gxg_g_object_set_data_w, 3, 0, 0, H_g_object_set_data);
- XG_DEFINE_PROCEDURE(gdk_cursor_new_from_pixbuf, gxg_gdk_cursor_new_from_pixbuf_w, 4, 0, 0, H_gdk_cursor_new_from_pixbuf);
- XG_DEFINE_PROCEDURE(gdk_display_flush, gxg_gdk_display_flush_w, 1, 0, 0, H_gdk_display_flush);
- XG_DEFINE_PROCEDURE(gdk_display_supports_cursor_alpha, gxg_gdk_display_supports_cursor_alpha_w, 1, 0, 0, H_gdk_display_supports_cursor_alpha);
- XG_DEFINE_PROCEDURE(gdk_display_supports_cursor_color, gxg_gdk_display_supports_cursor_color_w, 1, 0, 0, H_gdk_display_supports_cursor_color);
- XG_DEFINE_PROCEDURE(gdk_display_get_default_cursor_size, gxg_gdk_display_get_default_cursor_size_w, 1, 0, 0, H_gdk_display_get_default_cursor_size);
- XG_DEFINE_PROCEDURE(gdk_display_get_maximal_cursor_size, gxg_gdk_display_get_maximal_cursor_size_w, 1, 2, 0, H_gdk_display_get_maximal_cursor_size);
- XG_DEFINE_PROCEDURE(gdk_window_set_keep_above, gxg_gdk_window_set_keep_above_w, 2, 0, 0, H_gdk_window_set_keep_above);
- XG_DEFINE_PROCEDURE(gdk_window_set_keep_below, gxg_gdk_window_set_keep_below_w, 2, 0, 0, H_gdk_window_set_keep_below);
- XG_DEFINE_PROCEDURE(gtk_alignment_set_padding, gxg_gtk_alignment_set_padding_w, 5, 0, 0, H_gtk_alignment_set_padding);
- XG_DEFINE_PROCEDURE(gtk_alignment_get_padding, gxg_gtk_alignment_get_padding_w, 1, 4, 0, H_gtk_alignment_get_padding);
- XG_DEFINE_PROCEDURE(gtk_button_box_get_child_secondary, gxg_gtk_button_box_get_child_secondary_w, 2, 0, 0, H_gtk_button_box_get_child_secondary);
- XG_DEFINE_PROCEDURE(gtk_button_set_focus_on_click, gxg_gtk_button_set_focus_on_click_w, 2, 0, 0, H_gtk_button_set_focus_on_click);
- XG_DEFINE_PROCEDURE(gtk_button_get_focus_on_click, gxg_gtk_button_get_focus_on_click_w, 1, 0, 0, H_gtk_button_get_focus_on_click);
- XG_DEFINE_PROCEDURE(gtk_calendar_set_display_options, gxg_gtk_calendar_set_display_options_w, 2, 0, 0, H_gtk_calendar_set_display_options);
- XG_DEFINE_PROCEDURE(gtk_calendar_get_display_options, gxg_gtk_calendar_get_display_options_w, 1, 0, 0, H_gtk_calendar_get_display_options);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_set_draw_as_radio, gxg_gtk_check_menu_item_set_draw_as_radio_w, 2, 0, 0, H_gtk_check_menu_item_set_draw_as_radio);
- XG_DEFINE_PROCEDURE(gtk_check_menu_item_get_draw_as_radio, gxg_gtk_check_menu_item_get_draw_as_radio_w, 1, 0, 0, H_gtk_check_menu_item_get_draw_as_radio);
- XG_DEFINE_PROCEDURE(gtk_entry_set_completion, gxg_gtk_entry_set_completion_w, 2, 0, 0, H_gtk_entry_set_completion);
- XG_DEFINE_PROCEDURE(gtk_entry_get_completion, gxg_gtk_entry_get_completion_w, 1, 0, 0, H_gtk_entry_get_completion);
- XG_DEFINE_PROCEDURE(gtk_event_box_get_visible_window, gxg_gtk_event_box_get_visible_window_w, 1, 0, 0, H_gtk_event_box_get_visible_window);
- XG_DEFINE_PROCEDURE(gtk_event_box_set_visible_window, gxg_gtk_event_box_set_visible_window_w, 2, 0, 0, H_gtk_event_box_set_visible_window);
- XG_DEFINE_PROCEDURE(gtk_event_box_get_above_child, gxg_gtk_event_box_get_above_child_w, 1, 0, 0, H_gtk_event_box_get_above_child);
- XG_DEFINE_PROCEDURE(gtk_event_box_set_above_child, gxg_gtk_event_box_set_above_child_w, 2, 0, 0, H_gtk_event_box_set_above_child);
- XG_DEFINE_PROCEDURE(gtk_icon_source_get_icon_name, gxg_gtk_icon_source_get_icon_name_w, 1, 0, 0, H_gtk_icon_source_get_icon_name);
- XG_DEFINE_PROCEDURE(gtk_menu_attach, gxg_gtk_menu_attach_w, 6, 0, 0, H_gtk_menu_attach);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_select_range, gxg_gtk_text_buffer_select_range_w, 3, 0, 0, H_gtk_text_buffer_select_range);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_overwrite, gxg_gtk_text_view_set_overwrite_w, 2, 0, 0, H_gtk_text_view_set_overwrite);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_overwrite, gxg_gtk_text_view_get_overwrite_w, 1, 0, 0, H_gtk_text_view_get_overwrite);
- XG_DEFINE_PROCEDURE(gtk_text_view_set_accepts_tab, gxg_gtk_text_view_set_accepts_tab_w, 2, 0, 0, H_gtk_text_view_set_accepts_tab);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_accepts_tab, gxg_gtk_text_view_get_accepts_tab_w, 1, 0, 0, H_gtk_text_view_get_accepts_tab);
- XG_DEFINE_PROCEDURE(gtk_toolbar_insert, gxg_gtk_toolbar_insert_w, 3, 0, 0, H_gtk_toolbar_insert);
- XG_DEFINE_PROCEDURE(gtk_toolbar_get_item_index, gxg_gtk_toolbar_get_item_index_w, 2, 0, 0, H_gtk_toolbar_get_item_index);
- XG_DEFINE_PROCEDURE(gtk_toolbar_get_n_items, gxg_gtk_toolbar_get_n_items_w, 1, 0, 0, H_gtk_toolbar_get_n_items);
- XG_DEFINE_PROCEDURE(gtk_toolbar_get_nth_item, gxg_gtk_toolbar_get_nth_item_w, 2, 0, 0, H_gtk_toolbar_get_nth_item);
- XG_DEFINE_PROCEDURE(gtk_toolbar_set_show_arrow, gxg_gtk_toolbar_set_show_arrow_w, 2, 0, 0, H_gtk_toolbar_set_show_arrow);
- XG_DEFINE_PROCEDURE(gtk_toolbar_get_show_arrow, gxg_gtk_toolbar_get_show_arrow_w, 1, 0, 0, H_gtk_toolbar_get_show_arrow);
- XG_DEFINE_PROCEDURE(gtk_toolbar_get_relief_style, gxg_gtk_toolbar_get_relief_style_w, 1, 0, 0, H_gtk_toolbar_get_relief_style);
- XG_DEFINE_PROCEDURE(gtk_toolbar_get_drop_index, gxg_gtk_toolbar_get_drop_index_w, 3, 0, 0, H_gtk_toolbar_get_drop_index);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_set_expand, gxg_gtk_tree_view_column_set_expand_w, 2, 0, 0, H_gtk_tree_view_column_set_expand);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_expand, gxg_gtk_tree_view_column_get_expand_w, 1, 0, 0, H_gtk_tree_view_column_get_expand);
- XG_DEFINE_PROCEDURE(gtk_widget_set_no_show_all, gxg_gtk_widget_set_no_show_all_w, 2, 0, 0, H_gtk_widget_set_no_show_all);
- XG_DEFINE_PROCEDURE(gtk_widget_get_no_show_all, gxg_gtk_widget_get_no_show_all_w, 1, 0, 0, H_gtk_widget_get_no_show_all);
- XG_DEFINE_PROCEDURE(gtk_widget_queue_resize_no_redraw, gxg_gtk_widget_queue_resize_no_redraw_w, 1, 0, 0, H_gtk_widget_queue_resize_no_redraw);
- XG_DEFINE_PROCEDURE(gtk_window_set_default_icon, gxg_gtk_window_set_default_icon_w, 1, 0, 0, H_gtk_window_set_default_icon);
- XG_DEFINE_PROCEDURE(gtk_window_set_keep_above, gxg_gtk_window_set_keep_above_w, 2, 0, 0, H_gtk_window_set_keep_above);
- XG_DEFINE_PROCEDURE(gtk_window_set_keep_below, gxg_gtk_window_set_keep_below_w, 2, 0, 0, H_gtk_window_set_keep_below);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_dialog_new, gxg_gtk_file_chooser_dialog_new_w, 3, 1, 0, H_gtk_file_chooser_dialog_new);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_widget_new, gxg_gtk_file_chooser_widget_new_w, 1, 0, 0, H_gtk_file_chooser_widget_new);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_new, gxg_gtk_tree_model_filter_new_w, 2, 0, 0, H_gtk_tree_model_filter_new);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_set_visible_column, gxg_gtk_tree_model_filter_set_visible_column_w, 2, 0, 0, H_gtk_tree_model_filter_set_visible_column);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_get_model, gxg_gtk_tree_model_filter_get_model_w, 1, 0, 0, H_gtk_tree_model_filter_get_model);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_convert_iter_to_child_iter, gxg_gtk_tree_model_filter_convert_iter_to_child_iter_w, 3, 0, 0, H_gtk_tree_model_filter_convert_iter_to_child_iter);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_convert_child_path_to_path, gxg_gtk_tree_model_filter_convert_child_path_to_path_w, 2, 0, 0, H_gtk_tree_model_filter_convert_child_path_to_path);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_convert_path_to_child_path, gxg_gtk_tree_model_filter_convert_path_to_child_path_w, 2, 0, 0, H_gtk_tree_model_filter_convert_path_to_child_path);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_refilter, gxg_gtk_tree_model_filter_refilter_w, 1, 0, 0, H_gtk_tree_model_filter_refilter);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_clear_cache, gxg_gtk_tree_model_filter_clear_cache_w, 1, 0, 0, H_gtk_tree_model_filter_clear_cache);
- XG_DEFINE_PROCEDURE(gtk_action_get_name, gxg_gtk_action_get_name_w, 1, 0, 0, H_gtk_action_get_name);
- XG_DEFINE_PROCEDURE(gtk_action_activate, gxg_gtk_action_activate_w, 1, 0, 0, H_gtk_action_activate);
- XG_DEFINE_PROCEDURE(gtk_action_create_icon, gxg_gtk_action_create_icon_w, 2, 0, 0, H_gtk_action_create_icon);
- XG_DEFINE_PROCEDURE(gtk_action_create_menu_item, gxg_gtk_action_create_menu_item_w, 1, 0, 0, H_gtk_action_create_menu_item);
- XG_DEFINE_PROCEDURE(gtk_action_create_tool_item, gxg_gtk_action_create_tool_item_w, 1, 0, 0, H_gtk_action_create_tool_item);
- XG_DEFINE_PROCEDURE(gtk_action_get_proxies, gxg_gtk_action_get_proxies_w, 1, 0, 0, H_gtk_action_get_proxies);
- XG_DEFINE_PROCEDURE(gtk_action_connect_accelerator, gxg_gtk_action_connect_accelerator_w, 1, 0, 0, H_gtk_action_connect_accelerator);
- XG_DEFINE_PROCEDURE(gtk_action_disconnect_accelerator, gxg_gtk_action_disconnect_accelerator_w, 1, 0, 0, H_gtk_action_disconnect_accelerator);
- XG_DEFINE_PROCEDURE(gtk_action_group_new, gxg_gtk_action_group_new_w, 1, 0, 0, H_gtk_action_group_new);
- XG_DEFINE_PROCEDURE(gtk_action_group_get_name, gxg_gtk_action_group_get_name_w, 1, 0, 0, H_gtk_action_group_get_name);
- XG_DEFINE_PROCEDURE(gtk_action_group_get_action, gxg_gtk_action_group_get_action_w, 2, 0, 0, H_gtk_action_group_get_action);
- XG_DEFINE_PROCEDURE(gtk_action_group_list_actions, gxg_gtk_action_group_list_actions_w, 1, 0, 0, H_gtk_action_group_list_actions);
- XG_DEFINE_PROCEDURE(gtk_action_group_add_action, gxg_gtk_action_group_add_action_w, 2, 0, 0, H_gtk_action_group_add_action);
- XG_DEFINE_PROCEDURE(gtk_action_group_remove_action, gxg_gtk_action_group_remove_action_w, 2, 0, 0, H_gtk_action_group_remove_action);
- XG_DEFINE_PROCEDURE(gtk_action_group_add_actions, gxg_gtk_action_group_add_actions_w, 4, 0, 0, H_gtk_action_group_add_actions);
- XG_DEFINE_PROCEDURE(gtk_action_group_add_toggle_actions, gxg_gtk_action_group_add_toggle_actions_w, 4, 0, 0, H_gtk_action_group_add_toggle_actions);
- XG_DEFINE_PROCEDURE(gtk_action_group_add_toggle_actions_full, gxg_gtk_action_group_add_toggle_actions_full_w, 5, 0, 0, H_gtk_action_group_add_toggle_actions_full);
- XG_DEFINE_PROCEDURE(gtk_action_group_set_translation_domain, gxg_gtk_action_group_set_translation_domain_w, 2, 0, 0, H_gtk_action_group_set_translation_domain);
- XG_DEFINE_PROCEDURE(gtk_combo_box_new, gxg_gtk_combo_box_new_w, 0, 0, 0, H_gtk_combo_box_new);
- XG_DEFINE_PROCEDURE(gtk_combo_box_new_with_model, gxg_gtk_combo_box_new_with_model_w, 1, 0, 0, H_gtk_combo_box_new_with_model);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_model, gxg_gtk_combo_box_set_model_w, 2, 0, 0, H_gtk_combo_box_set_model);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_wrap_width, gxg_gtk_combo_box_set_wrap_width_w, 2, 0, 0, H_gtk_combo_box_set_wrap_width);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_row_span_column, gxg_gtk_combo_box_set_row_span_column_w, 2, 0, 0, H_gtk_combo_box_set_row_span_column);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_column_span_column, gxg_gtk_combo_box_set_column_span_column_w, 2, 0, 0, H_gtk_combo_box_set_column_span_column);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_active, gxg_gtk_combo_box_get_active_w, 1, 0, 0, H_gtk_combo_box_get_active);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_active, gxg_gtk_combo_box_set_active_w, 2, 0, 0, H_gtk_combo_box_set_active);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_active_iter, gxg_gtk_combo_box_get_active_iter_w, 2, 0, 0, H_gtk_combo_box_get_active_iter);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_active_iter, gxg_gtk_combo_box_set_active_iter_w, 2, 0, 0, H_gtk_combo_box_set_active_iter);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_model, gxg_gtk_combo_box_get_model_w, 1, 0, 0, H_gtk_combo_box_get_model);
- XG_DEFINE_PROCEDURE(gtk_expander_new, gxg_gtk_expander_new_w, 1, 0, 0, H_gtk_expander_new);
- XG_DEFINE_PROCEDURE(gtk_expander_new_with_mnemonic, gxg_gtk_expander_new_with_mnemonic_w, 1, 0, 0, H_gtk_expander_new_with_mnemonic);
- XG_DEFINE_PROCEDURE(gtk_expander_set_expanded, gxg_gtk_expander_set_expanded_w, 2, 0, 0, H_gtk_expander_set_expanded);
- XG_DEFINE_PROCEDURE(gtk_expander_get_expanded, gxg_gtk_expander_get_expanded_w, 1, 0, 0, H_gtk_expander_get_expanded);
- XG_DEFINE_PROCEDURE(gtk_expander_set_spacing, gxg_gtk_expander_set_spacing_w, 2, 0, 0, H_gtk_expander_set_spacing);
- XG_DEFINE_PROCEDURE(gtk_expander_get_spacing, gxg_gtk_expander_get_spacing_w, 1, 0, 0, H_gtk_expander_get_spacing);
- XG_DEFINE_PROCEDURE(gtk_expander_set_label, gxg_gtk_expander_set_label_w, 2, 0, 0, H_gtk_expander_set_label);
- XG_DEFINE_PROCEDURE(gtk_expander_get_label, gxg_gtk_expander_get_label_w, 1, 0, 0, H_gtk_expander_get_label);
- XG_DEFINE_PROCEDURE(gtk_expander_set_use_underline, gxg_gtk_expander_set_use_underline_w, 2, 0, 0, H_gtk_expander_set_use_underline);
- XG_DEFINE_PROCEDURE(gtk_expander_get_use_underline, gxg_gtk_expander_get_use_underline_w, 1, 0, 0, H_gtk_expander_get_use_underline);
- XG_DEFINE_PROCEDURE(gtk_expander_set_label_widget, gxg_gtk_expander_set_label_widget_w, 2, 0, 0, H_gtk_expander_set_label_widget);
- XG_DEFINE_PROCEDURE(gtk_expander_get_label_widget, gxg_gtk_expander_get_label_widget_w, 1, 0, 0, H_gtk_expander_get_label_widget);
- XG_DEFINE_PROCEDURE(gtk_expander_set_use_markup, gxg_gtk_expander_set_use_markup_w, 2, 0, 0, H_gtk_expander_set_use_markup);
- XG_DEFINE_PROCEDURE(gtk_expander_get_use_markup, gxg_gtk_expander_get_use_markup_w, 1, 0, 0, H_gtk_expander_get_use_markup);
- XG_DEFINE_PROCEDURE(gtk_font_button_new, gxg_gtk_font_button_new_w, 0, 0, 0, H_gtk_font_button_new);
- XG_DEFINE_PROCEDURE(gtk_font_button_new_with_font, gxg_gtk_font_button_new_with_font_w, 1, 0, 0, H_gtk_font_button_new_with_font);
- XG_DEFINE_PROCEDURE(gtk_font_button_get_title, gxg_gtk_font_button_get_title_w, 1, 0, 0, H_gtk_font_button_get_title);
- XG_DEFINE_PROCEDURE(gtk_font_button_set_title, gxg_gtk_font_button_set_title_w, 2, 0, 0, H_gtk_font_button_set_title);
- XG_DEFINE_PROCEDURE(gtk_font_button_get_use_font, gxg_gtk_font_button_get_use_font_w, 1, 0, 0, H_gtk_font_button_get_use_font);
- XG_DEFINE_PROCEDURE(gtk_font_button_set_use_font, gxg_gtk_font_button_set_use_font_w, 2, 0, 0, H_gtk_font_button_set_use_font);
- XG_DEFINE_PROCEDURE(gtk_font_button_get_use_size, gxg_gtk_font_button_get_use_size_w, 1, 0, 0, H_gtk_font_button_get_use_size);
- XG_DEFINE_PROCEDURE(gtk_font_button_set_use_size, gxg_gtk_font_button_set_use_size_w, 2, 0, 0, H_gtk_font_button_set_use_size);
- XG_DEFINE_PROCEDURE(gtk_font_button_get_font_name, gxg_gtk_font_button_get_font_name_w, 1, 0, 0, H_gtk_font_button_get_font_name);
- XG_DEFINE_PROCEDURE(gtk_font_button_set_font_name, gxg_gtk_font_button_set_font_name_w, 2, 0, 0, H_gtk_font_button_set_font_name);
- XG_DEFINE_PROCEDURE(gtk_font_button_get_show_style, gxg_gtk_font_button_get_show_style_w, 1, 0, 0, H_gtk_font_button_get_show_style);
- XG_DEFINE_PROCEDURE(gtk_font_button_set_show_style, gxg_gtk_font_button_set_show_style_w, 2, 0, 0, H_gtk_font_button_set_show_style);
- XG_DEFINE_PROCEDURE(gtk_font_button_get_show_size, gxg_gtk_font_button_get_show_size_w, 1, 0, 0, H_gtk_font_button_get_show_size);
- XG_DEFINE_PROCEDURE(gtk_font_button_set_show_size, gxg_gtk_font_button_set_show_size_w, 2, 0, 0, H_gtk_font_button_set_show_size);
- XG_DEFINE_PROCEDURE(gtk_color_button_new, gxg_gtk_color_button_new_w, 0, 0, 0, H_gtk_color_button_new);
- XG_DEFINE_PROCEDURE(gtk_color_button_new_with_color, gxg_gtk_color_button_new_with_color_w, 1, 0, 0, H_gtk_color_button_new_with_color);
- XG_DEFINE_PROCEDURE(gtk_color_button_set_color, gxg_gtk_color_button_set_color_w, 2, 0, 0, H_gtk_color_button_set_color);
- XG_DEFINE_PROCEDURE(gtk_color_button_set_alpha, gxg_gtk_color_button_set_alpha_w, 2, 0, 0, H_gtk_color_button_set_alpha);
- XG_DEFINE_PROCEDURE(gtk_color_button_get_color, gxg_gtk_color_button_get_color_w, 2, 0, 0, H_gtk_color_button_get_color);
- XG_DEFINE_PROCEDURE(gtk_color_button_get_alpha, gxg_gtk_color_button_get_alpha_w, 1, 0, 0, H_gtk_color_button_get_alpha);
- XG_DEFINE_PROCEDURE(gtk_color_button_set_use_alpha, gxg_gtk_color_button_set_use_alpha_w, 2, 0, 0, H_gtk_color_button_set_use_alpha);
- XG_DEFINE_PROCEDURE(gtk_color_button_get_use_alpha, gxg_gtk_color_button_get_use_alpha_w, 1, 0, 0, H_gtk_color_button_get_use_alpha);
- XG_DEFINE_PROCEDURE(gtk_color_button_set_title, gxg_gtk_color_button_set_title_w, 2, 0, 0, H_gtk_color_button_set_title);
- XG_DEFINE_PROCEDURE(gtk_color_button_get_title, gxg_gtk_color_button_get_title_w, 1, 0, 0, H_gtk_color_button_get_title);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_new, gxg_gtk_entry_completion_new_w, 0, 0, 0, H_gtk_entry_completion_new);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_entry, gxg_gtk_entry_completion_get_entry_w, 1, 0, 0, H_gtk_entry_completion_get_entry);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_model, gxg_gtk_entry_completion_set_model_w, 2, 0, 0, H_gtk_entry_completion_set_model);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_model, gxg_gtk_entry_completion_get_model_w, 1, 0, 0, H_gtk_entry_completion_get_model);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_match_func, gxg_gtk_entry_completion_set_match_func_w, 4, 0, 0, H_gtk_entry_completion_set_match_func);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_minimum_key_length, gxg_gtk_entry_completion_set_minimum_key_length_w, 2, 0, 0, H_gtk_entry_completion_set_minimum_key_length);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_minimum_key_length, gxg_gtk_entry_completion_get_minimum_key_length_w, 1, 0, 0, H_gtk_entry_completion_get_minimum_key_length);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_complete, gxg_gtk_entry_completion_complete_w, 1, 0, 0, H_gtk_entry_completion_complete);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_insert_action_text, gxg_gtk_entry_completion_insert_action_text_w, 3, 0, 0, H_gtk_entry_completion_insert_action_text);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_insert_action_markup, gxg_gtk_entry_completion_insert_action_markup_w, 3, 0, 0, H_gtk_entry_completion_insert_action_markup);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_delete_action, gxg_gtk_entry_completion_delete_action_w, 2, 0, 0, H_gtk_entry_completion_delete_action);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_text_column, gxg_gtk_entry_completion_set_text_column_w, 2, 0, 0, H_gtk_entry_completion_set_text_column);
- XG_DEFINE_PROCEDURE(gtk_radio_tool_button_new, gxg_gtk_radio_tool_button_new_w, 1, 0, 0, H_gtk_radio_tool_button_new);
- XG_DEFINE_PROCEDURE(gtk_radio_tool_button_new_from_stock, gxg_gtk_radio_tool_button_new_from_stock_w, 2, 0, 0, H_gtk_radio_tool_button_new_from_stock);
- XG_DEFINE_PROCEDURE(gtk_radio_tool_button_new_from_widget, gxg_gtk_radio_tool_button_new_from_widget_w, 1, 0, 0, H_gtk_radio_tool_button_new_from_widget);
- XG_DEFINE_PROCEDURE(gtk_radio_tool_button_new_with_stock_from_widget, gxg_gtk_radio_tool_button_new_with_stock_from_widget_w, 2, 0, 0, H_gtk_radio_tool_button_new_with_stock_from_widget);
- XG_DEFINE_PROCEDURE(gtk_radio_tool_button_get_group, gxg_gtk_radio_tool_button_get_group_w, 1, 0, 0, H_gtk_radio_tool_button_get_group);
- XG_DEFINE_PROCEDURE(gtk_radio_tool_button_set_group, gxg_gtk_radio_tool_button_set_group_w, 2, 0, 0, H_gtk_radio_tool_button_set_group);
- XG_DEFINE_PROCEDURE(gtk_radio_action_get_group, gxg_gtk_radio_action_get_group_w, 1, 0, 0, H_gtk_radio_action_get_group);
- XG_DEFINE_PROCEDURE(gtk_radio_action_set_group, gxg_gtk_radio_action_set_group_w, 2, 0, 0, H_gtk_radio_action_set_group);
- XG_DEFINE_PROCEDURE(gtk_radio_action_get_current_value, gxg_gtk_radio_action_get_current_value_w, 1, 0, 0, H_gtk_radio_action_get_current_value);
- XG_DEFINE_PROCEDURE(gtk_separator_tool_item_new, gxg_gtk_separator_tool_item_new_w, 0, 0, 0, H_gtk_separator_tool_item_new);
- XG_DEFINE_PROCEDURE(gtk_separator_tool_item_get_draw, gxg_gtk_separator_tool_item_get_draw_w, 1, 0, 0, H_gtk_separator_tool_item_get_draw);
- XG_DEFINE_PROCEDURE(gtk_separator_tool_item_set_draw, gxg_gtk_separator_tool_item_set_draw_w, 2, 0, 0, H_gtk_separator_tool_item_set_draw);
- XG_DEFINE_PROCEDURE(gtk_toggle_action_toggled, gxg_gtk_toggle_action_toggled_w, 1, 0, 0, H_gtk_toggle_action_toggled);
- XG_DEFINE_PROCEDURE(gtk_toggle_action_set_active, gxg_gtk_toggle_action_set_active_w, 2, 0, 0, H_gtk_toggle_action_set_active);
- XG_DEFINE_PROCEDURE(gtk_toggle_action_get_active, gxg_gtk_toggle_action_get_active_w, 1, 0, 0, H_gtk_toggle_action_get_active);
- XG_DEFINE_PROCEDURE(gtk_toggle_action_set_draw_as_radio, gxg_gtk_toggle_action_set_draw_as_radio_w, 2, 0, 0, H_gtk_toggle_action_set_draw_as_radio);
- XG_DEFINE_PROCEDURE(gtk_toggle_action_get_draw_as_radio, gxg_gtk_toggle_action_get_draw_as_radio_w, 1, 0, 0, H_gtk_toggle_action_get_draw_as_radio);
- XG_DEFINE_PROCEDURE(gtk_toggle_tool_button_new, gxg_gtk_toggle_tool_button_new_w, 0, 0, 0, H_gtk_toggle_tool_button_new);
- XG_DEFINE_PROCEDURE(gtk_toggle_tool_button_new_from_stock, gxg_gtk_toggle_tool_button_new_from_stock_w, 1, 0, 0, H_gtk_toggle_tool_button_new_from_stock);
- XG_DEFINE_PROCEDURE(gtk_toggle_tool_button_set_active, gxg_gtk_toggle_tool_button_set_active_w, 2, 0, 0, H_gtk_toggle_tool_button_set_active);
- XG_DEFINE_PROCEDURE(gtk_toggle_tool_button_get_active, gxg_gtk_toggle_tool_button_get_active_w, 1, 0, 0, H_gtk_toggle_tool_button_get_active);
- XG_DEFINE_PROCEDURE(g_timeout_add_full, gxg_g_timeout_add_full_w, 5, 0, 0, H_g_timeout_add_full);
- XG_DEFINE_PROCEDURE(g_timeout_add, gxg_g_timeout_add_w, 2, 1, 0, H_g_timeout_add);
- XG_DEFINE_PROCEDURE(g_idle_add, gxg_g_idle_add_w, 1, 1, 0, H_g_idle_add);
- XG_DEFINE_PROCEDURE(g_idle_add_full, gxg_g_idle_add_full_w, 4, 0, 0, H_g_idle_add_full);
- XG_DEFINE_PROCEDURE(g_idle_remove_by_data, gxg_g_idle_remove_by_data_w, 1, 0, 0, H_g_idle_remove_by_data);
- XG_DEFINE_PROCEDURE(g_source_remove, gxg_g_source_remove_w, 1, 0, 0, H_g_source_remove);
- XG_DEFINE_PROCEDURE(gtk_file_filter_new, gxg_gtk_file_filter_new_w, 0, 0, 0, H_gtk_file_filter_new);
- XG_DEFINE_PROCEDURE(gtk_file_filter_set_name, gxg_gtk_file_filter_set_name_w, 2, 0, 0, H_gtk_file_filter_set_name);
- XG_DEFINE_PROCEDURE(gtk_file_filter_get_name, gxg_gtk_file_filter_get_name_w, 1, 0, 0, H_gtk_file_filter_get_name);
- XG_DEFINE_PROCEDURE(gtk_file_filter_add_mime_type, gxg_gtk_file_filter_add_mime_type_w, 2, 0, 0, H_gtk_file_filter_add_mime_type);
- XG_DEFINE_PROCEDURE(gtk_file_filter_add_pattern, gxg_gtk_file_filter_add_pattern_w, 2, 0, 0, H_gtk_file_filter_add_pattern);
- XG_DEFINE_PROCEDURE(gtk_file_filter_add_custom, gxg_gtk_file_filter_add_custom_w, 5, 0, 0, H_gtk_file_filter_add_custom);
- XG_DEFINE_PROCEDURE(gtk_file_filter_get_needed, gxg_gtk_file_filter_get_needed_w, 1, 0, 0, H_gtk_file_filter_get_needed);
- XG_DEFINE_PROCEDURE(gtk_file_filter_filter, gxg_gtk_file_filter_filter_w, 2, 0, 0, H_gtk_file_filter_filter);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_pack_start, gxg_gtk_cell_layout_pack_start_w, 3, 0, 0, H_gtk_cell_layout_pack_start);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_pack_end, gxg_gtk_cell_layout_pack_end_w, 3, 0, 0, H_gtk_cell_layout_pack_end);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_clear, gxg_gtk_cell_layout_clear_w, 1, 0, 0, H_gtk_cell_layout_clear);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_set_attributes, gxg_gtk_cell_layout_set_attributes_w, 3, 0, 0, H_gtk_cell_layout_set_attributes);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_add_attribute, gxg_gtk_cell_layout_add_attribute_w, 4, 0, 0, H_gtk_cell_layout_add_attribute);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_set_cell_data_func, gxg_gtk_cell_layout_set_cell_data_func_w, 5, 0, 0, H_gtk_cell_layout_set_cell_data_func);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_clear_attributes, gxg_gtk_cell_layout_clear_attributes_w, 2, 0, 0, H_gtk_cell_layout_clear_attributes);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_action, gxg_gtk_file_chooser_set_action_w, 2, 0, 0, H_gtk_file_chooser_set_action);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_action, gxg_gtk_file_chooser_get_action_w, 1, 0, 0, H_gtk_file_chooser_get_action);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_local_only, gxg_gtk_file_chooser_set_local_only_w, 2, 0, 0, H_gtk_file_chooser_set_local_only);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_local_only, gxg_gtk_file_chooser_get_local_only_w, 1, 0, 0, H_gtk_file_chooser_get_local_only);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_select_multiple, gxg_gtk_file_chooser_set_select_multiple_w, 2, 0, 0, H_gtk_file_chooser_set_select_multiple);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_select_multiple, gxg_gtk_file_chooser_get_select_multiple_w, 1, 0, 0, H_gtk_file_chooser_get_select_multiple);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_current_name, gxg_gtk_file_chooser_set_current_name_w, 2, 0, 0, H_gtk_file_chooser_set_current_name);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_filename, gxg_gtk_file_chooser_get_filename_w, 1, 0, 0, H_gtk_file_chooser_get_filename);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_filename, gxg_gtk_file_chooser_set_filename_w, 2, 0, 0, H_gtk_file_chooser_set_filename);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_select_filename, gxg_gtk_file_chooser_select_filename_w, 2, 0, 0, H_gtk_file_chooser_select_filename);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_unselect_filename, gxg_gtk_file_chooser_unselect_filename_w, 2, 0, 0, H_gtk_file_chooser_unselect_filename);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_select_all, gxg_gtk_file_chooser_select_all_w, 1, 0, 0, H_gtk_file_chooser_select_all);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_unselect_all, gxg_gtk_file_chooser_unselect_all_w, 1, 0, 0, H_gtk_file_chooser_unselect_all);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_filenames, gxg_gtk_file_chooser_get_filenames_w, 1, 0, 0, H_gtk_file_chooser_get_filenames);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_current_folder, gxg_gtk_file_chooser_set_current_folder_w, 2, 0, 0, H_gtk_file_chooser_set_current_folder);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_current_folder, gxg_gtk_file_chooser_get_current_folder_w, 1, 0, 0, H_gtk_file_chooser_get_current_folder);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_uri, gxg_gtk_file_chooser_get_uri_w, 1, 0, 0, H_gtk_file_chooser_get_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_uri, gxg_gtk_file_chooser_set_uri_w, 2, 0, 0, H_gtk_file_chooser_set_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_select_uri, gxg_gtk_file_chooser_select_uri_w, 2, 0, 0, H_gtk_file_chooser_select_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_unselect_uri, gxg_gtk_file_chooser_unselect_uri_w, 2, 0, 0, H_gtk_file_chooser_unselect_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_uris, gxg_gtk_file_chooser_get_uris_w, 1, 0, 0, H_gtk_file_chooser_get_uris);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_current_folder_uri, gxg_gtk_file_chooser_set_current_folder_uri_w, 2, 0, 0, H_gtk_file_chooser_set_current_folder_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_current_folder_uri, gxg_gtk_file_chooser_get_current_folder_uri_w, 1, 0, 0, H_gtk_file_chooser_get_current_folder_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_preview_widget, gxg_gtk_file_chooser_set_preview_widget_w, 2, 0, 0, H_gtk_file_chooser_set_preview_widget);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_preview_widget, gxg_gtk_file_chooser_get_preview_widget_w, 1, 0, 0, H_gtk_file_chooser_get_preview_widget);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_preview_widget_active, gxg_gtk_file_chooser_set_preview_widget_active_w, 2, 0, 0, H_gtk_file_chooser_set_preview_widget_active);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_preview_widget_active, gxg_gtk_file_chooser_get_preview_widget_active_w, 1, 0, 0, H_gtk_file_chooser_get_preview_widget_active);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_preview_filename, gxg_gtk_file_chooser_get_preview_filename_w, 1, 0, 0, H_gtk_file_chooser_get_preview_filename);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_preview_uri, gxg_gtk_file_chooser_get_preview_uri_w, 1, 0, 0, H_gtk_file_chooser_get_preview_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_extra_widget, gxg_gtk_file_chooser_set_extra_widget_w, 2, 0, 0, H_gtk_file_chooser_set_extra_widget);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_extra_widget, gxg_gtk_file_chooser_get_extra_widget_w, 1, 0, 0, H_gtk_file_chooser_get_extra_widget);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_add_filter, gxg_gtk_file_chooser_add_filter_w, 2, 0, 0, H_gtk_file_chooser_add_filter);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_remove_filter, gxg_gtk_file_chooser_remove_filter_w, 2, 0, 0, H_gtk_file_chooser_remove_filter);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_list_filters, gxg_gtk_file_chooser_list_filters_w, 1, 0, 0, H_gtk_file_chooser_list_filters);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_filter, gxg_gtk_file_chooser_set_filter_w, 2, 0, 0, H_gtk_file_chooser_set_filter);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_filter, gxg_gtk_file_chooser_get_filter_w, 1, 0, 0, H_gtk_file_chooser_get_filter);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_add_shortcut_folder, gxg_gtk_file_chooser_add_shortcut_folder_w, 2, 1, 0, H_gtk_file_chooser_add_shortcut_folder);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_remove_shortcut_folder, gxg_gtk_file_chooser_remove_shortcut_folder_w, 2, 1, 0, H_gtk_file_chooser_remove_shortcut_folder);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_list_shortcut_folders, gxg_gtk_file_chooser_list_shortcut_folders_w, 1, 0, 0, H_gtk_file_chooser_list_shortcut_folders);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_add_shortcut_folder_uri, gxg_gtk_file_chooser_add_shortcut_folder_uri_w, 2, 1, 0, H_gtk_file_chooser_add_shortcut_folder_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_remove_shortcut_folder_uri, gxg_gtk_file_chooser_remove_shortcut_folder_uri_w, 2, 1, 0, H_gtk_file_chooser_remove_shortcut_folder_uri);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_list_shortcut_folder_uris, gxg_gtk_file_chooser_list_shortcut_folder_uris_w, 1, 0, 0, H_gtk_file_chooser_list_shortcut_folder_uris);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_new, gxg_gtk_icon_theme_new_w, 0, 0, 0, H_gtk_icon_theme_new);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_get_default, gxg_gtk_icon_theme_get_default_w, 0, 0, 0, H_gtk_icon_theme_get_default);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_get_for_screen, gxg_gtk_icon_theme_get_for_screen_w, 1, 0, 0, H_gtk_icon_theme_get_for_screen);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_set_screen, gxg_gtk_icon_theme_set_screen_w, 2, 0, 0, H_gtk_icon_theme_set_screen);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_get_search_path, gxg_gtk_icon_theme_get_search_path_w, 1, 2, 0, H_gtk_icon_theme_get_search_path);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_append_search_path, gxg_gtk_icon_theme_append_search_path_w, 2, 0, 0, H_gtk_icon_theme_append_search_path);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_prepend_search_path, gxg_gtk_icon_theme_prepend_search_path_w, 2, 0, 0, H_gtk_icon_theme_prepend_search_path);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_set_custom_theme, gxg_gtk_icon_theme_set_custom_theme_w, 2, 0, 0, H_gtk_icon_theme_set_custom_theme);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_has_icon, gxg_gtk_icon_theme_has_icon_w, 2, 0, 0, H_gtk_icon_theme_has_icon);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_lookup_icon, gxg_gtk_icon_theme_lookup_icon_w, 4, 0, 0, H_gtk_icon_theme_lookup_icon);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_load_icon, gxg_gtk_icon_theme_load_icon_w, 4, 1, 0, H_gtk_icon_theme_load_icon);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_list_icons, gxg_gtk_icon_theme_list_icons_w, 2, 0, 0, H_gtk_icon_theme_list_icons);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_get_example_icon_name, gxg_gtk_icon_theme_get_example_icon_name_w, 1, 0, 0, H_gtk_icon_theme_get_example_icon_name);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_rescan_if_needed, gxg_gtk_icon_theme_rescan_if_needed_w, 1, 0, 0, H_gtk_icon_theme_rescan_if_needed);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_add_builtin_icon, gxg_gtk_icon_theme_add_builtin_icon_w, 3, 0, 0, H_gtk_icon_theme_add_builtin_icon);
- XG_DEFINE_PROCEDURE(gtk_icon_info_copy, gxg_gtk_icon_info_copy_w, 1, 0, 0, H_gtk_icon_info_copy);
- XG_DEFINE_PROCEDURE(gtk_icon_info_free, gxg_gtk_icon_info_free_w, 1, 0, 0, H_gtk_icon_info_free);
- XG_DEFINE_PROCEDURE(gtk_icon_info_get_base_size, gxg_gtk_icon_info_get_base_size_w, 1, 0, 0, H_gtk_icon_info_get_base_size);
- XG_DEFINE_PROCEDURE(gtk_icon_info_get_filename, gxg_gtk_icon_info_get_filename_w, 1, 0, 0, H_gtk_icon_info_get_filename);
- XG_DEFINE_PROCEDURE(gtk_icon_info_get_builtin_pixbuf, gxg_gtk_icon_info_get_builtin_pixbuf_w, 1, 0, 0, H_gtk_icon_info_get_builtin_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_icon_info_load_icon, gxg_gtk_icon_info_load_icon_w, 1, 1, 0, H_gtk_icon_info_load_icon);
- XG_DEFINE_PROCEDURE(gtk_icon_info_set_raw_coordinates, gxg_gtk_icon_info_set_raw_coordinates_w, 2, 0, 0, H_gtk_icon_info_set_raw_coordinates);
- XG_DEFINE_PROCEDURE(gtk_icon_info_get_embedded_rect, gxg_gtk_icon_info_get_embedded_rect_w, 2, 0, 0, H_gtk_icon_info_get_embedded_rect);
- XG_DEFINE_PROCEDURE(gtk_icon_info_get_display_name, gxg_gtk_icon_info_get_display_name_w, 1, 0, 0, H_gtk_icon_info_get_display_name);
- XG_DEFINE_PROCEDURE(gtk_tool_button_new, gxg_gtk_tool_button_new_w, 2, 0, 0, H_gtk_tool_button_new);
- XG_DEFINE_PROCEDURE(gtk_tool_button_new_from_stock, gxg_gtk_tool_button_new_from_stock_w, 1, 0, 0, H_gtk_tool_button_new_from_stock);
- XG_DEFINE_PROCEDURE(gtk_tool_button_set_label, gxg_gtk_tool_button_set_label_w, 2, 0, 0, H_gtk_tool_button_set_label);
- XG_DEFINE_PROCEDURE(gtk_tool_button_get_label, gxg_gtk_tool_button_get_label_w, 1, 0, 0, H_gtk_tool_button_get_label);
- XG_DEFINE_PROCEDURE(gtk_tool_button_set_use_underline, gxg_gtk_tool_button_set_use_underline_w, 2, 0, 0, H_gtk_tool_button_set_use_underline);
- XG_DEFINE_PROCEDURE(gtk_tool_button_get_use_underline, gxg_gtk_tool_button_get_use_underline_w, 1, 0, 0, H_gtk_tool_button_get_use_underline);
- XG_DEFINE_PROCEDURE(gtk_tool_button_set_stock_id, gxg_gtk_tool_button_set_stock_id_w, 2, 0, 0, H_gtk_tool_button_set_stock_id);
- XG_DEFINE_PROCEDURE(gtk_tool_button_get_stock_id, gxg_gtk_tool_button_get_stock_id_w, 1, 0, 0, H_gtk_tool_button_get_stock_id);
- XG_DEFINE_PROCEDURE(gtk_tool_button_set_icon_widget, gxg_gtk_tool_button_set_icon_widget_w, 2, 0, 0, H_gtk_tool_button_set_icon_widget);
- XG_DEFINE_PROCEDURE(gtk_tool_button_get_icon_widget, gxg_gtk_tool_button_get_icon_widget_w, 1, 0, 0, H_gtk_tool_button_get_icon_widget);
- XG_DEFINE_PROCEDURE(gtk_tool_button_set_label_widget, gxg_gtk_tool_button_set_label_widget_w, 2, 0, 0, H_gtk_tool_button_set_label_widget);
- XG_DEFINE_PROCEDURE(gtk_tool_button_get_label_widget, gxg_gtk_tool_button_get_label_widget_w, 1, 0, 0, H_gtk_tool_button_get_label_widget);
- XG_DEFINE_PROCEDURE(gtk_tool_item_new, gxg_gtk_tool_item_new_w, 0, 0, 0, H_gtk_tool_item_new);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_homogeneous, gxg_gtk_tool_item_set_homogeneous_w, 2, 0, 0, H_gtk_tool_item_set_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_homogeneous, gxg_gtk_tool_item_get_homogeneous_w, 1, 0, 0, H_gtk_tool_item_get_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_expand, gxg_gtk_tool_item_set_expand_w, 2, 0, 0, H_gtk_tool_item_set_expand);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_expand, gxg_gtk_tool_item_get_expand_w, 1, 0, 0, H_gtk_tool_item_get_expand);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_use_drag_window, gxg_gtk_tool_item_set_use_drag_window_w, 2, 0, 0, H_gtk_tool_item_set_use_drag_window);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_use_drag_window, gxg_gtk_tool_item_get_use_drag_window_w, 1, 0, 0, H_gtk_tool_item_get_use_drag_window);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_visible_horizontal, gxg_gtk_tool_item_set_visible_horizontal_w, 2, 0, 0, H_gtk_tool_item_set_visible_horizontal);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_visible_horizontal, gxg_gtk_tool_item_get_visible_horizontal_w, 1, 0, 0, H_gtk_tool_item_get_visible_horizontal);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_visible_vertical, gxg_gtk_tool_item_set_visible_vertical_w, 2, 0, 0, H_gtk_tool_item_set_visible_vertical);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_visible_vertical, gxg_gtk_tool_item_get_visible_vertical_w, 1, 0, 0, H_gtk_tool_item_get_visible_vertical);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_is_important, gxg_gtk_tool_item_get_is_important_w, 1, 0, 0, H_gtk_tool_item_get_is_important);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_is_important, gxg_gtk_tool_item_set_is_important_w, 2, 0, 0, H_gtk_tool_item_set_is_important);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_icon_size, gxg_gtk_tool_item_get_icon_size_w, 1, 0, 0, H_gtk_tool_item_get_icon_size);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_orientation, gxg_gtk_tool_item_get_orientation_w, 1, 0, 0, H_gtk_tool_item_get_orientation);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_toolbar_style, gxg_gtk_tool_item_get_toolbar_style_w, 1, 0, 0, H_gtk_tool_item_get_toolbar_style);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_relief_style, gxg_gtk_tool_item_get_relief_style_w, 1, 0, 0, H_gtk_tool_item_get_relief_style);
- XG_DEFINE_PROCEDURE(gtk_tool_item_retrieve_proxy_menu_item, gxg_gtk_tool_item_retrieve_proxy_menu_item_w, 1, 0, 0, H_gtk_tool_item_retrieve_proxy_menu_item);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_proxy_menu_item, gxg_gtk_tool_item_get_proxy_menu_item_w, 2, 0, 0, H_gtk_tool_item_get_proxy_menu_item);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_proxy_menu_item, gxg_gtk_tool_item_set_proxy_menu_item_w, 3, 0, 0, H_gtk_tool_item_set_proxy_menu_item);
- XG_DEFINE_PROCEDURE(gtk_list_store_remove, gxg_gtk_list_store_remove_w, 2, 0, 0, H_gtk_list_store_remove);
- XG_DEFINE_PROCEDURE(gdk_display_set_double_click_distance, gxg_gdk_display_set_double_click_distance_w, 2, 0, 0, H_gdk_display_set_double_click_distance);
- XG_DEFINE_PROCEDURE(gdk_display_get_default_group, gxg_gdk_display_get_default_group_w, 1, 0, 0, H_gdk_display_get_default_group);
- XG_DEFINE_PROCEDURE(gdk_window_get_group, gxg_gdk_window_get_group_w, 1, 0, 0, H_gdk_window_get_group);
- XG_DEFINE_PROCEDURE(gtk_action_group_get_sensitive, gxg_gtk_action_group_get_sensitive_w, 1, 0, 0, H_gtk_action_group_get_sensitive);
- XG_DEFINE_PROCEDURE(gtk_action_group_set_sensitive, gxg_gtk_action_group_set_sensitive_w, 2, 0, 0, H_gtk_action_group_set_sensitive);
- XG_DEFINE_PROCEDURE(gtk_action_group_get_visible, gxg_gtk_action_group_get_visible_w, 1, 0, 0, H_gtk_action_group_get_visible);
- XG_DEFINE_PROCEDURE(gtk_action_group_set_visible, gxg_gtk_action_group_set_visible_w, 2, 0, 0, H_gtk_action_group_set_visible);
- XG_DEFINE_PROCEDURE(gtk_action_group_add_action_with_accel, gxg_gtk_action_group_add_action_with_accel_w, 3, 0, 0, H_gtk_action_group_add_action_with_accel);
- XG_DEFINE_PROCEDURE(gtk_action_new, gxg_gtk_action_new_w, 4, 0, 0, H_gtk_action_new);
- XG_DEFINE_PROCEDURE(gtk_action_is_sensitive, gxg_gtk_action_is_sensitive_w, 1, 0, 0, H_gtk_action_is_sensitive);
- XG_DEFINE_PROCEDURE(gtk_action_get_sensitive, gxg_gtk_action_get_sensitive_w, 1, 0, 0, H_gtk_action_get_sensitive);
- XG_DEFINE_PROCEDURE(gtk_action_is_visible, gxg_gtk_action_is_visible_w, 1, 0, 0, H_gtk_action_is_visible);
- XG_DEFINE_PROCEDURE(gtk_action_get_visible, gxg_gtk_action_get_visible_w, 1, 0, 0, H_gtk_action_get_visible);
- XG_DEFINE_PROCEDURE(gtk_button_set_alignment, gxg_gtk_button_set_alignment_w, 3, 0, 0, H_gtk_button_set_alignment);
- XG_DEFINE_PROCEDURE(gtk_button_get_alignment, gxg_gtk_button_get_alignment_w, 1, 2, 0, H_gtk_button_get_alignment);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_reorder, gxg_gtk_cell_layout_reorder_w, 3, 0, 0, H_gtk_cell_layout_reorder);
- XG_DEFINE_PROCEDURE(gtk_clipboard_request_targets, gxg_gtk_clipboard_request_targets_w, 2, 1, 0, H_gtk_clipboard_request_targets);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_for_targets, gxg_gtk_clipboard_wait_for_targets_w, 1, 2, 0, H_gtk_clipboard_wait_for_targets);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_cancel, gxg_gtk_menu_shell_cancel_w, 1, 0, 0, H_gtk_menu_shell_cancel);
- XG_DEFINE_PROCEDURE(gtk_paned_get_child1, gxg_gtk_paned_get_child1_w, 1, 0, 0, H_gtk_paned_get_child1);
- XG_DEFINE_PROCEDURE(gtk_paned_get_child2, gxg_gtk_paned_get_child2_w, 1, 0, 0, H_gtk_paned_get_child2);
- XG_DEFINE_PROCEDURE(gtk_radio_action_new, gxg_gtk_radio_action_new_w, 5, 0, 0, H_gtk_radio_action_new);
- XG_DEFINE_PROCEDURE(gtk_toggle_action_new, gxg_gtk_toggle_action_new_w, 4, 0, 0, H_gtk_toggle_action_new);
- XG_DEFINE_PROCEDURE(gtk_window_set_accept_focus, gxg_gtk_window_set_accept_focus_w, 2, 0, 0, H_gtk_window_set_accept_focus);
- XG_DEFINE_PROCEDURE(gtk_window_get_accept_focus, gxg_gtk_window_get_accept_focus_w, 1, 0, 0, H_gtk_window_get_accept_focus);
- XG_DEFINE_PROCEDURE(g_list_nth_data, gxg_g_list_nth_data_w, 2, 0, 0, H_g_list_nth_data);
- XG_DEFINE_PROCEDURE(gtk_accel_map_get, gxg_gtk_accel_map_get_w, 0, 0, 0, H_gtk_accel_map_get);
- XG_DEFINE_PROCEDURE(gtk_combo_box_popup, gxg_gtk_combo_box_popup_w, 1, 0, 0, H_gtk_combo_box_popup);
- XG_DEFINE_PROCEDURE(gtk_combo_box_popdown, gxg_gtk_combo_box_popdown_w, 1, 0, 0, H_gtk_combo_box_popdown);
- XG_DEFINE_PROCEDURE(gtk_radio_menu_item_new_from_widget, gxg_gtk_radio_menu_item_new_from_widget_w, 1, 0, 0, H_gtk_radio_menu_item_new_from_widget);
- XG_DEFINE_PROCEDURE(gtk_radio_menu_item_new_with_mnemonic_from_widget, gxg_gtk_radio_menu_item_new_with_mnemonic_from_widget_w, 2, 0, 0, H_gtk_radio_menu_item_new_with_mnemonic_from_widget);
- XG_DEFINE_PROCEDURE(gtk_radio_menu_item_new_with_label_from_widget, gxg_gtk_radio_menu_item_new_with_label_from_widget_w, 2, 0, 0, H_gtk_radio_menu_item_new_with_label_from_widget);
- XG_DEFINE_PROCEDURE(gtk_scale_get_layout, gxg_gtk_scale_get_layout_w, 1, 0, 0, H_gtk_scale_get_layout);
- XG_DEFINE_PROCEDURE(gtk_scale_get_layout_offsets, gxg_gtk_scale_get_layout_offsets_w, 1, 2, 0, H_gtk_scale_get_layout_offsets);
- XG_DEFINE_PROCEDURE(gtk_drag_source_get_target_list, gxg_gtk_drag_source_get_target_list_w, 1, 0, 0, H_gtk_drag_source_get_target_list);
- XG_DEFINE_PROCEDURE(gtk_drag_source_set_target_list, gxg_gtk_drag_source_set_target_list_w, 2, 0, 0, H_gtk_drag_source_set_target_list);
- XG_DEFINE_PROCEDURE(gtk_entry_set_alignment, gxg_gtk_entry_set_alignment_w, 2, 0, 0, H_gtk_entry_set_alignment);
- XG_DEFINE_PROCEDURE(gtk_entry_get_alignment, gxg_gtk_entry_get_alignment_w, 1, 0, 0, H_gtk_entry_get_alignment);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_use_preview_label, gxg_gtk_file_chooser_set_use_preview_label_w, 2, 0, 0, H_gtk_file_chooser_set_use_preview_label);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_use_preview_label, gxg_gtk_file_chooser_get_use_preview_label_w, 1, 0, 0, H_gtk_file_chooser_get_use_preview_label);
- XG_DEFINE_PROCEDURE(gtk_widget_list_mnemonic_labels, gxg_gtk_widget_list_mnemonic_labels_w, 1, 0, 0, H_gtk_widget_list_mnemonic_labels);
- XG_DEFINE_PROCEDURE(gtk_widget_add_mnemonic_label, gxg_gtk_widget_add_mnemonic_label_w, 2, 0, 0, H_gtk_widget_add_mnemonic_label);
- XG_DEFINE_PROCEDURE(gtk_widget_remove_mnemonic_label, gxg_gtk_widget_remove_mnemonic_label_w, 2, 0, 0, H_gtk_widget_remove_mnemonic_label);
- XG_DEFINE_PROCEDURE(gtk_window_activate_key, gxg_gtk_window_activate_key_w, 2, 0, 0, H_gtk_window_activate_key);
- XG_DEFINE_PROCEDURE(gtk_window_propagate_key_event, gxg_gtk_window_propagate_key_event_w, 2, 0, 0, H_gtk_window_propagate_key_event);
- XG_DEFINE_PROCEDURE(g_quark_from_string, gxg_g_quark_from_string_w, 1, 0, 0, H_g_quark_from_string);
- XG_DEFINE_PROCEDURE(g_quark_to_string, gxg_g_quark_to_string_w, 1, 0, 0, H_g_quark_to_string);
- XG_DEFINE_PROCEDURE(gtk_cell_view_new, gxg_gtk_cell_view_new_w, 0, 0, 0, H_gtk_cell_view_new);
- XG_DEFINE_PROCEDURE(gtk_cell_view_new_with_text, gxg_gtk_cell_view_new_with_text_w, 1, 0, 0, H_gtk_cell_view_new_with_text);
- XG_DEFINE_PROCEDURE(gtk_cell_view_new_with_markup, gxg_gtk_cell_view_new_with_markup_w, 1, 0, 0, H_gtk_cell_view_new_with_markup);
- XG_DEFINE_PROCEDURE(gtk_cell_view_new_with_pixbuf, gxg_gtk_cell_view_new_with_pixbuf_w, 1, 0, 0, H_gtk_cell_view_new_with_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_cell_view_set_model, gxg_gtk_cell_view_set_model_w, 2, 0, 0, H_gtk_cell_view_set_model);
- XG_DEFINE_PROCEDURE(gtk_cell_view_set_displayed_row, gxg_gtk_cell_view_set_displayed_row_w, 2, 0, 0, H_gtk_cell_view_set_displayed_row);
- XG_DEFINE_PROCEDURE(gtk_cell_view_get_displayed_row, gxg_gtk_cell_view_get_displayed_row_w, 1, 0, 0, H_gtk_cell_view_get_displayed_row);
- XG_DEFINE_PROCEDURE(gtk_cell_view_set_background_color, gxg_gtk_cell_view_set_background_color_w, 2, 0, 0, H_gtk_cell_view_set_background_color);
- XG_DEFINE_PROCEDURE(gdk_window_enable_synchronized_configure, gxg_gdk_window_enable_synchronized_configure_w, 1, 0, 0, H_gdk_window_enable_synchronized_configure);
- XG_DEFINE_PROCEDURE(gdk_window_configure_finished, gxg_gdk_window_configure_finished_w, 1, 0, 0, H_gdk_window_configure_finished);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_wrap_width, gxg_gtk_combo_box_get_wrap_width_w, 1, 0, 0, H_gtk_combo_box_get_wrap_width);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_row_span_column, gxg_gtk_combo_box_get_row_span_column_w, 1, 0, 0, H_gtk_combo_box_get_row_span_column);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_column_span_column, gxg_gtk_combo_box_get_column_span_column_w, 1, 0, 0, H_gtk_combo_box_get_column_span_column);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_add_tearoffs, gxg_gtk_combo_box_get_add_tearoffs_w, 1, 0, 0, H_gtk_combo_box_get_add_tearoffs);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_add_tearoffs, gxg_gtk_combo_box_set_add_tearoffs_w, 2, 0, 0, H_gtk_combo_box_set_add_tearoffs);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_add_text_targets, gxg_gtk_drag_dest_add_text_targets_w, 1, 0, 0, H_gtk_drag_dest_add_text_targets);
- XG_DEFINE_PROCEDURE(gtk_drag_source_add_text_targets, gxg_gtk_drag_source_add_text_targets_w, 1, 0, 0, H_gtk_drag_source_add_text_targets);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_insert_prefix, gxg_gtk_entry_completion_insert_prefix_w, 1, 0, 0, H_gtk_entry_completion_insert_prefix);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_inline_completion, gxg_gtk_entry_completion_set_inline_completion_w, 2, 0, 0, H_gtk_entry_completion_set_inline_completion);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_inline_completion, gxg_gtk_entry_completion_get_inline_completion_w, 1, 0, 0, H_gtk_entry_completion_get_inline_completion);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_popup_completion, gxg_gtk_entry_completion_set_popup_completion_w, 2, 0, 0, H_gtk_entry_completion_set_popup_completion);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_popup_completion, gxg_gtk_entry_completion_get_popup_completion_w, 1, 0, 0, H_gtk_entry_completion_get_popup_completion);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_text_column, gxg_gtk_entry_completion_get_text_column_w, 1, 0, 0, H_gtk_entry_completion_get_text_column);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_get_icon_sizes, gxg_gtk_icon_theme_get_icon_sizes_w, 2, 0, 0, H_gtk_icon_theme_get_icon_sizes);
- XG_DEFINE_PROCEDURE(gtk_menu_get_for_attach_widget, gxg_gtk_menu_get_for_attach_widget_w, 1, 0, 0, H_gtk_menu_get_for_attach_widget);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_fixed_height_mode, gxg_gtk_tree_view_set_fixed_height_mode_w, 2, 0, 0, H_gtk_tree_view_set_fixed_height_mode);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_fixed_height_mode, gxg_gtk_tree_view_get_fixed_height_mode_w, 1, 0, 0, H_gtk_tree_view_get_fixed_height_mode);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_hover_selection, gxg_gtk_tree_view_set_hover_selection_w, 2, 0, 0, H_gtk_tree_view_set_hover_selection);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_hover_selection, gxg_gtk_tree_view_get_hover_selection_w, 1, 0, 0, H_gtk_tree_view_get_hover_selection);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_row_separator_func, gxg_gtk_tree_view_set_row_separator_func_w, 4, 0, 0, H_gtk_tree_view_set_row_separator_func);
- XG_DEFINE_PROCEDURE(gtk_window_set_focus_on_map, gxg_gtk_window_set_focus_on_map_w, 2, 0, 0, H_gtk_window_set_focus_on_map);
- XG_DEFINE_PROCEDURE(gtk_window_get_focus_on_map, gxg_gtk_window_get_focus_on_map_w, 1, 0, 0, H_gtk_window_get_focus_on_map);
- XG_DEFINE_PROCEDURE(gtk_window_set_icon_name, gxg_gtk_window_set_icon_name_w, 2, 0, 0, H_gtk_window_set_icon_name);
- XG_DEFINE_PROCEDURE(gtk_window_get_icon_name, gxg_gtk_window_get_icon_name_w, 1, 0, 0, H_gtk_window_get_icon_name);
- XG_DEFINE_PROCEDURE(gtk_window_set_default_icon_name, gxg_gtk_window_set_default_icon_name_w, 1, 0, 0, H_gtk_window_set_default_icon_name);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_new, gxg_gtk_about_dialog_new_w, 0, 0, 0, H_gtk_about_dialog_new);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_version, gxg_gtk_about_dialog_get_version_w, 1, 0, 0, H_gtk_about_dialog_get_version);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_version, gxg_gtk_about_dialog_set_version_w, 2, 0, 0, H_gtk_about_dialog_set_version);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_copyright, gxg_gtk_about_dialog_get_copyright_w, 1, 0, 0, H_gtk_about_dialog_get_copyright);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_copyright, gxg_gtk_about_dialog_set_copyright_w, 2, 0, 0, H_gtk_about_dialog_set_copyright);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_comments, gxg_gtk_about_dialog_get_comments_w, 1, 0, 0, H_gtk_about_dialog_get_comments);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_comments, gxg_gtk_about_dialog_set_comments_w, 2, 0, 0, H_gtk_about_dialog_set_comments);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_license, gxg_gtk_about_dialog_get_license_w, 1, 0, 0, H_gtk_about_dialog_get_license);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_license, gxg_gtk_about_dialog_set_license_w, 2, 0, 0, H_gtk_about_dialog_set_license);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_website, gxg_gtk_about_dialog_get_website_w, 1, 0, 0, H_gtk_about_dialog_get_website);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_website, gxg_gtk_about_dialog_set_website_w, 2, 0, 0, H_gtk_about_dialog_set_website);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_website_label, gxg_gtk_about_dialog_get_website_label_w, 1, 0, 0, H_gtk_about_dialog_get_website_label);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_website_label, gxg_gtk_about_dialog_set_website_label_w, 2, 0, 0, H_gtk_about_dialog_set_website_label);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_authors, gxg_gtk_about_dialog_get_authors_w, 1, 0, 0, H_gtk_about_dialog_get_authors);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_authors, gxg_gtk_about_dialog_set_authors_w, 2, 0, 0, H_gtk_about_dialog_set_authors);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_documenters, gxg_gtk_about_dialog_get_documenters_w, 1, 0, 0, H_gtk_about_dialog_get_documenters);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_documenters, gxg_gtk_about_dialog_set_documenters_w, 2, 0, 0, H_gtk_about_dialog_set_documenters);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_artists, gxg_gtk_about_dialog_get_artists_w, 1, 0, 0, H_gtk_about_dialog_get_artists);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_artists, gxg_gtk_about_dialog_set_artists_w, 2, 0, 0, H_gtk_about_dialog_set_artists);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_translator_credits, gxg_gtk_about_dialog_get_translator_credits_w, 1, 0, 0, H_gtk_about_dialog_get_translator_credits);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_translator_credits, gxg_gtk_about_dialog_set_translator_credits_w, 2, 0, 0, H_gtk_about_dialog_set_translator_credits);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_logo, gxg_gtk_about_dialog_get_logo_w, 1, 0, 0, H_gtk_about_dialog_get_logo);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_logo, gxg_gtk_about_dialog_set_logo_w, 2, 0, 0, H_gtk_about_dialog_set_logo);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_program_name, gxg_gtk_about_dialog_get_program_name_w, 1, 0, 0, H_gtk_about_dialog_get_program_name);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_program_name, gxg_gtk_about_dialog_set_program_name_w, 2, 0, 0, H_gtk_about_dialog_set_program_name);
- XG_DEFINE_PROCEDURE(gtk_icon_view_new, gxg_gtk_icon_view_new_w, 0, 0, 0, H_gtk_icon_view_new);
- XG_DEFINE_PROCEDURE(gtk_icon_view_new_with_model, gxg_gtk_icon_view_new_with_model_w, 1, 0, 0, H_gtk_icon_view_new_with_model);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_model, gxg_gtk_icon_view_set_model_w, 2, 0, 0, H_gtk_icon_view_set_model);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_model, gxg_gtk_icon_view_get_model_w, 1, 0, 0, H_gtk_icon_view_get_model);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_text_column, gxg_gtk_icon_view_set_text_column_w, 2, 0, 0, H_gtk_icon_view_set_text_column);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_text_column, gxg_gtk_icon_view_get_text_column_w, 1, 0, 0, H_gtk_icon_view_get_text_column);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_markup_column, gxg_gtk_icon_view_set_markup_column_w, 2, 0, 0, H_gtk_icon_view_set_markup_column);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_markup_column, gxg_gtk_icon_view_get_markup_column_w, 1, 0, 0, H_gtk_icon_view_get_markup_column);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_pixbuf_column, gxg_gtk_icon_view_set_pixbuf_column_w, 2, 0, 0, H_gtk_icon_view_set_pixbuf_column);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_pixbuf_column, gxg_gtk_icon_view_get_pixbuf_column_w, 1, 0, 0, H_gtk_icon_view_get_pixbuf_column);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_path_at_pos, gxg_gtk_icon_view_get_path_at_pos_w, 3, 0, 0, H_gtk_icon_view_get_path_at_pos);
- XG_DEFINE_PROCEDURE(gtk_icon_view_selected_foreach, gxg_gtk_icon_view_selected_foreach_w, 2, 1, 0, H_gtk_icon_view_selected_foreach);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_selection_mode, gxg_gtk_icon_view_set_selection_mode_w, 2, 0, 0, H_gtk_icon_view_set_selection_mode);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_selection_mode, gxg_gtk_icon_view_get_selection_mode_w, 1, 0, 0, H_gtk_icon_view_get_selection_mode);
- XG_DEFINE_PROCEDURE(gtk_icon_view_select_path, gxg_gtk_icon_view_select_path_w, 2, 0, 0, H_gtk_icon_view_select_path);
- XG_DEFINE_PROCEDURE(gtk_icon_view_unselect_path, gxg_gtk_icon_view_unselect_path_w, 2, 0, 0, H_gtk_icon_view_unselect_path);
- XG_DEFINE_PROCEDURE(gtk_icon_view_path_is_selected, gxg_gtk_icon_view_path_is_selected_w, 2, 0, 0, H_gtk_icon_view_path_is_selected);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_selected_items, gxg_gtk_icon_view_get_selected_items_w, 1, 0, 0, H_gtk_icon_view_get_selected_items);
- XG_DEFINE_PROCEDURE(gtk_icon_view_select_all, gxg_gtk_icon_view_select_all_w, 1, 0, 0, H_gtk_icon_view_select_all);
- XG_DEFINE_PROCEDURE(gtk_icon_view_unselect_all, gxg_gtk_icon_view_unselect_all_w, 1, 0, 0, H_gtk_icon_view_unselect_all);
- XG_DEFINE_PROCEDURE(gtk_icon_view_item_activated, gxg_gtk_icon_view_item_activated_w, 2, 0, 0, H_gtk_icon_view_item_activated);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_combo_new, gxg_gtk_cell_renderer_combo_new_w, 0, 0, 0, H_gtk_cell_renderer_combo_new);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_progress_new, gxg_gtk_cell_renderer_progress_new_w, 0, 0, 0, H_gtk_cell_renderer_progress_new);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_row_separator_func, gxg_gtk_combo_box_set_row_separator_func_w, 4, 0, 0, H_gtk_combo_box_set_row_separator_func);
- XG_DEFINE_PROCEDURE(gtk_label_set_ellipsize, gxg_gtk_label_set_ellipsize_w, 2, 0, 0, H_gtk_label_set_ellipsize);
- XG_DEFINE_PROCEDURE(gtk_label_get_ellipsize, gxg_gtk_label_get_ellipsize_w, 1, 0, 0, H_gtk_label_get_ellipsize);
- XG_DEFINE_PROCEDURE(pango_attr_fallback_new, gxg_pango_attr_fallback_new_w, 1, 0, 0, H_pango_attr_fallback_new);
- XG_DEFINE_PROCEDURE(pango_attr_letter_spacing_new, gxg_pango_attr_letter_spacing_new_w, 1, 0, 0, H_pango_attr_letter_spacing_new);
- XG_DEFINE_PROCEDURE(pango_attr_list_filter, gxg_pango_attr_list_filter_w, 3, 0, 0, H_pango_attr_list_filter);
- XG_DEFINE_PROCEDURE(pango_attr_iterator_get_attrs, gxg_pango_attr_iterator_get_attrs_w, 1, 0, 0, H_pango_attr_iterator_get_attrs);
- XG_DEFINE_PROCEDURE(pango_font_metrics_get_underline_position, gxg_pango_font_metrics_get_underline_position_w, 1, 0, 0, H_pango_font_metrics_get_underline_position);
- XG_DEFINE_PROCEDURE(pango_font_metrics_get_underline_thickness, gxg_pango_font_metrics_get_underline_thickness_w, 1, 0, 0, H_pango_font_metrics_get_underline_thickness);
- XG_DEFINE_PROCEDURE(pango_font_metrics_get_strikethrough_position, gxg_pango_font_metrics_get_strikethrough_position_w, 1, 0, 0, H_pango_font_metrics_get_strikethrough_position);
- XG_DEFINE_PROCEDURE(pango_font_metrics_get_strikethrough_thickness, gxg_pango_font_metrics_get_strikethrough_thickness_w, 1, 0, 0, H_pango_font_metrics_get_strikethrough_thickness);
- XG_DEFINE_PROCEDURE(pango_font_family_is_monospace, gxg_pango_font_family_is_monospace_w, 1, 0, 0, H_pango_font_family_is_monospace);
- XG_DEFINE_PROCEDURE(pango_font_face_list_sizes, gxg_pango_font_face_list_sizes_w, 1, 2, 0, H_pango_font_face_list_sizes);
- XG_DEFINE_PROCEDURE(pango_layout_set_auto_dir, gxg_pango_layout_set_auto_dir_w, 2, 0, 0, H_pango_layout_set_auto_dir);
- XG_DEFINE_PROCEDURE(pango_layout_get_auto_dir, gxg_pango_layout_get_auto_dir_w, 1, 0, 0, H_pango_layout_get_auto_dir);
- XG_DEFINE_PROCEDURE(pango_script_for_unichar, gxg_pango_script_for_unichar_w, 1, 0, 0, H_pango_script_for_unichar);
- XG_DEFINE_PROCEDURE(pango_script_iter_new, gxg_pango_script_iter_new_w, 2, 0, 0, H_pango_script_iter_new);
- XG_DEFINE_PROCEDURE(pango_script_iter_get_range, gxg_pango_script_iter_get_range_w, 1, 3, 0, H_pango_script_iter_get_range);
- XG_DEFINE_PROCEDURE(pango_script_iter_next, gxg_pango_script_iter_next_w, 1, 0, 0, H_pango_script_iter_next);
- XG_DEFINE_PROCEDURE(pango_script_iter_free, gxg_pango_script_iter_free_w, 1, 0, 0, H_pango_script_iter_free);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_button_new_with_dialog, gxg_gtk_file_chooser_button_new_with_dialog_w, 1, 0, 0, H_gtk_file_chooser_button_new_with_dialog);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_button_get_title, gxg_gtk_file_chooser_button_get_title_w, 1, 0, 0, H_gtk_file_chooser_button_get_title);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_button_set_title, gxg_gtk_file_chooser_button_set_title_w, 2, 0, 0, H_gtk_file_chooser_button_set_title);
- XG_DEFINE_PROCEDURE(gdk_drag_drop_succeeded, gxg_gdk_drag_drop_succeeded_w, 1, 0, 0, H_gdk_drag_drop_succeeded);
- XG_DEFINE_PROCEDURE(gtk_action_set_sensitive, gxg_gtk_action_set_sensitive_w, 2, 0, 0, H_gtk_action_set_sensitive);
- XG_DEFINE_PROCEDURE(gtk_action_set_visible, gxg_gtk_action_set_visible_w, 2, 0, 0, H_gtk_action_set_visible);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_focus_on_click, gxg_gtk_combo_box_get_focus_on_click_w, 1, 0, 0, H_gtk_combo_box_get_focus_on_click);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_focus_on_click, gxg_gtk_combo_box_set_focus_on_click_w, 2, 0, 0, H_gtk_combo_box_set_focus_on_click);
- XG_DEFINE_PROCEDURE(gtk_entry_layout_index_to_text_index, gxg_gtk_entry_layout_index_to_text_index_w, 2, 0, 0, H_gtk_entry_layout_index_to_text_index);
- XG_DEFINE_PROCEDURE(gtk_entry_text_index_to_layout_index, gxg_gtk_entry_text_index_to_layout_index_w, 2, 0, 0, H_gtk_entry_text_index_to_layout_index);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_show_hidden, gxg_gtk_file_chooser_set_show_hidden_w, 2, 0, 0, H_gtk_file_chooser_set_show_hidden);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_show_hidden, gxg_gtk_file_chooser_get_show_hidden_w, 1, 0, 0, H_gtk_file_chooser_get_show_hidden);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_hover_expand, gxg_gtk_tree_view_set_hover_expand_w, 2, 0, 0, H_gtk_tree_view_set_hover_expand);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_hover_expand, gxg_gtk_tree_view_get_hover_expand_w, 1, 0, 0, H_gtk_tree_view_get_hover_expand);
- XG_DEFINE_PROCEDURE(gtk_tool_item_rebuild_menu, gxg_gtk_tool_item_rebuild_menu_w, 1, 0, 0, H_gtk_tool_item_rebuild_menu);
- XG_DEFINE_PROCEDURE(gtk_menu_tool_button_new, gxg_gtk_menu_tool_button_new_w, 2, 0, 0, H_gtk_menu_tool_button_new);
- XG_DEFINE_PROCEDURE(gtk_menu_tool_button_new_from_stock, gxg_gtk_menu_tool_button_new_from_stock_w, 1, 0, 0, H_gtk_menu_tool_button_new_from_stock);
- XG_DEFINE_PROCEDURE(gtk_menu_tool_button_set_menu, gxg_gtk_menu_tool_button_set_menu_w, 2, 0, 0, H_gtk_menu_tool_button_set_menu);
- XG_DEFINE_PROCEDURE(gtk_menu_tool_button_get_menu, gxg_gtk_menu_tool_button_get_menu_w, 1, 0, 0, H_gtk_menu_tool_button_get_menu);
- XG_DEFINE_PROCEDURE(gdk_display_supports_clipboard_persistence, gxg_gdk_display_supports_clipboard_persistence_w, 1, 0, 0, H_gdk_display_supports_clipboard_persistence);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_logo_icon_name, gxg_gtk_about_dialog_get_logo_icon_name_w, 1, 0, 0, H_gtk_about_dialog_get_logo_icon_name);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_logo_icon_name, gxg_gtk_about_dialog_set_logo_icon_name_w, 2, 0, 0, H_gtk_about_dialog_set_logo_icon_name);
- XG_DEFINE_PROCEDURE(gtk_accelerator_get_label, gxg_gtk_accelerator_get_label_w, 2, 0, 0, H_gtk_accelerator_get_label);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_is_target_available, gxg_gtk_clipboard_wait_is_target_available_w, 2, 0, 0, H_gtk_clipboard_wait_is_target_available);
- XG_DEFINE_PROCEDURE(gtk_clipboard_set_can_store, gxg_gtk_clipboard_set_can_store_w, 3, 0, 0, H_gtk_clipboard_set_can_store);
- XG_DEFINE_PROCEDURE(gtk_clipboard_store, gxg_gtk_clipboard_store_w, 1, 0, 0, H_gtk_clipboard_store);
- XG_DEFINE_PROCEDURE(gtk_alternative_dialog_button_order, gxg_gtk_alternative_dialog_button_order_w, 1, 0, 0, H_gtk_alternative_dialog_button_order);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_add_image_targets, gxg_gtk_drag_dest_add_image_targets_w, 1, 0, 0, H_gtk_drag_dest_add_image_targets);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_add_uri_targets, gxg_gtk_drag_dest_add_uri_targets_w, 1, 0, 0, H_gtk_drag_dest_add_uri_targets);
- XG_DEFINE_PROCEDURE(gtk_drag_source_add_image_targets, gxg_gtk_drag_source_add_image_targets_w, 1, 0, 0, H_gtk_drag_source_add_image_targets);
- XG_DEFINE_PROCEDURE(gtk_drag_source_add_uri_targets, gxg_gtk_drag_source_add_uri_targets_w, 1, 0, 0, H_gtk_drag_source_add_uri_targets);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_button_get_width_chars, gxg_gtk_file_chooser_button_get_width_chars_w, 1, 0, 0, H_gtk_file_chooser_button_get_width_chars);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_button_set_width_chars, gxg_gtk_file_chooser_button_set_width_chars_w, 2, 0, 0, H_gtk_file_chooser_button_set_width_chars);
- XG_DEFINE_PROCEDURE(gtk_image_new_from_icon_name, gxg_gtk_image_new_from_icon_name_w, 2, 0, 0, H_gtk_image_new_from_icon_name);
- XG_DEFINE_PROCEDURE(gtk_image_set_from_icon_name, gxg_gtk_image_set_from_icon_name_w, 3, 0, 0, H_gtk_image_set_from_icon_name);
- XG_DEFINE_PROCEDURE(gtk_image_set_pixel_size, gxg_gtk_image_set_pixel_size_w, 2, 0, 0, H_gtk_image_set_pixel_size);
- XG_DEFINE_PROCEDURE(gtk_image_get_pixel_size, gxg_gtk_image_get_pixel_size_w, 1, 0, 0, H_gtk_image_get_pixel_size);
- XG_DEFINE_PROCEDURE(gtk_label_set_width_chars, gxg_gtk_label_set_width_chars_w, 2, 0, 0, H_gtk_label_set_width_chars);
- XG_DEFINE_PROCEDURE(gtk_label_get_width_chars, gxg_gtk_label_get_width_chars_w, 1, 0, 0, H_gtk_label_get_width_chars);
- XG_DEFINE_PROCEDURE(gtk_target_list_add_text_targets, gxg_gtk_target_list_add_text_targets_w, 2, 0, 0, H_gtk_target_list_add_text_targets);
- XG_DEFINE_PROCEDURE(gtk_target_list_add_image_targets, gxg_gtk_target_list_add_image_targets_w, 3, 0, 0, H_gtk_target_list_add_image_targets);
- XG_DEFINE_PROCEDURE(gtk_target_list_add_uri_targets, gxg_gtk_target_list_add_uri_targets_w, 2, 0, 0, H_gtk_target_list_add_uri_targets);
- XG_DEFINE_PROCEDURE(gtk_selection_data_set_pixbuf, gxg_gtk_selection_data_set_pixbuf_w, 2, 0, 0, H_gtk_selection_data_set_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_pixbuf, gxg_gtk_selection_data_get_pixbuf_w, 1, 0, 0, H_gtk_selection_data_get_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_selection_data_set_uris, gxg_gtk_selection_data_set_uris_w, 2, 0, 0, H_gtk_selection_data_set_uris);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_uris, gxg_gtk_selection_data_get_uris_w, 1, 0, 0, H_gtk_selection_data_get_uris);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_backspace, gxg_gtk_text_buffer_backspace_w, 4, 0, 0, H_gtk_text_buffer_backspace);
- XG_DEFINE_PROCEDURE(gtk_clipboard_set_image, gxg_gtk_clipboard_set_image_w, 2, 0, 0, H_gtk_clipboard_set_image);
- XG_DEFINE_PROCEDURE(gtk_clipboard_request_image, gxg_gtk_clipboard_request_image_w, 2, 1, 0, H_gtk_clipboard_request_image);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_for_image, gxg_gtk_clipboard_wait_for_image_w, 1, 0, 0, H_gtk_clipboard_wait_for_image);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_is_image_available, gxg_gtk_clipboard_wait_is_image_available_w, 1, 0, 0, H_gtk_clipboard_wait_is_image_available);
- XG_DEFINE_PROCEDURE(gtk_file_filter_add_pixbuf_formats, gxg_gtk_file_filter_add_pixbuf_formats_w, 1, 0, 0, H_gtk_file_filter_add_pixbuf_formats);
- XG_DEFINE_PROCEDURE(gtk_label_set_single_line_mode, gxg_gtk_label_set_single_line_mode_w, 2, 0, 0, H_gtk_label_set_single_line_mode);
- XG_DEFINE_PROCEDURE(gtk_label_get_single_line_mode, gxg_gtk_label_get_single_line_mode_w, 1, 0, 0, H_gtk_label_get_single_line_mode);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_set_ellipsize, gxg_gtk_progress_bar_set_ellipsize_w, 2, 0, 0, H_gtk_progress_bar_set_ellipsize);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_get_ellipsize, gxg_gtk_progress_bar_get_ellipsize_w, 1, 0, 0, H_gtk_progress_bar_get_ellipsize);
- XG_DEFINE_PROCEDURE(gtk_selection_data_targets_include_image, gxg_gtk_selection_data_targets_include_image_w, 2, 0, 0, H_gtk_selection_data_targets_include_image);
- XG_DEFINE_PROCEDURE(gtk_button_set_image, gxg_gtk_button_set_image_w, 2, 0, 0, H_gtk_button_set_image);
- XG_DEFINE_PROCEDURE(gtk_button_get_image, gxg_gtk_button_get_image_w, 1, 0, 0, H_gtk_button_get_image);
- XG_DEFINE_PROCEDURE(gtk_dialog_set_alternative_button_order_from_array, gxg_gtk_dialog_set_alternative_button_order_from_array_w, 3, 0, 0, H_gtk_dialog_set_alternative_button_order_from_array);
- XG_DEFINE_PROCEDURE(gtk_label_set_angle, gxg_gtk_label_set_angle_w, 2, 0, 0, H_gtk_label_set_angle);
- XG_DEFINE_PROCEDURE(gtk_label_get_angle, gxg_gtk_label_get_angle_w, 1, 0, 0, H_gtk_label_get_angle);
- XG_DEFINE_PROCEDURE(gtk_menu_set_screen, gxg_gtk_menu_set_screen_w, 2, 0, 0, H_gtk_menu_set_screen);
- XG_DEFINE_PROCEDURE(pango_attr_underline_color_new, gxg_pango_attr_underline_color_new_w, 3, 0, 0, H_pango_attr_underline_color_new);
- XG_DEFINE_PROCEDURE(pango_attr_strikethrough_color_new, gxg_pango_attr_strikethrough_color_new_w, 3, 0, 0, H_pango_attr_strikethrough_color_new);
- XG_DEFINE_PROCEDURE(pango_renderer_draw_layout, gxg_pango_renderer_draw_layout_w, 4, 0, 0, H_pango_renderer_draw_layout);
- XG_DEFINE_PROCEDURE(pango_renderer_draw_layout_line, gxg_pango_renderer_draw_layout_line_w, 4, 0, 0, H_pango_renderer_draw_layout_line);
- XG_DEFINE_PROCEDURE(pango_renderer_draw_glyphs, gxg_pango_renderer_draw_glyphs_w, 5, 0, 0, H_pango_renderer_draw_glyphs);
- XG_DEFINE_PROCEDURE(pango_renderer_draw_rectangle, gxg_pango_renderer_draw_rectangle_w, 6, 0, 0, H_pango_renderer_draw_rectangle);
- XG_DEFINE_PROCEDURE(pango_renderer_draw_error_underline, gxg_pango_renderer_draw_error_underline_w, 5, 0, 0, H_pango_renderer_draw_error_underline);
- XG_DEFINE_PROCEDURE(pango_renderer_draw_trapezoid, gxg_pango_renderer_draw_trapezoid_w, 8, 0, 0, H_pango_renderer_draw_trapezoid);
- XG_DEFINE_PROCEDURE(pango_renderer_draw_glyph, gxg_pango_renderer_draw_glyph_w, 5, 0, 0, H_pango_renderer_draw_glyph);
- XG_DEFINE_PROCEDURE(pango_renderer_activate, gxg_pango_renderer_activate_w, 1, 0, 0, H_pango_renderer_activate);
- XG_DEFINE_PROCEDURE(pango_renderer_deactivate, gxg_pango_renderer_deactivate_w, 1, 0, 0, H_pango_renderer_deactivate);
- XG_DEFINE_PROCEDURE(pango_renderer_part_changed, gxg_pango_renderer_part_changed_w, 2, 0, 0, H_pango_renderer_part_changed);
- XG_DEFINE_PROCEDURE(pango_renderer_set_color, gxg_pango_renderer_set_color_w, 3, 0, 0, H_pango_renderer_set_color);
- XG_DEFINE_PROCEDURE(pango_renderer_get_color, gxg_pango_renderer_get_color_w, 2, 0, 0, H_pango_renderer_get_color);
- XG_DEFINE_PROCEDURE(pango_renderer_set_matrix, gxg_pango_renderer_set_matrix_w, 2, 0, 0, H_pango_renderer_set_matrix);
- XG_DEFINE_PROCEDURE(g_log_set_handler, gxg_g_log_set_handler_w, 3, 1, 0, H_g_log_set_handler);
- XG_DEFINE_PROCEDURE(g_log_remove_handler, gxg_g_log_remove_handler_w, 2, 0, 0, H_g_log_remove_handler);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_stop_editing, gxg_gtk_cell_renderer_stop_editing_w, 2, 0, 0, H_gtk_cell_renderer_stop_editing);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_button_new, gxg_gtk_file_chooser_button_new_w, 2, 0, 0, H_gtk_file_chooser_button_new);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_columns, gxg_gtk_icon_view_set_columns_w, 2, 0, 0, H_gtk_icon_view_set_columns);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_columns, gxg_gtk_icon_view_get_columns_w, 1, 0, 0, H_gtk_icon_view_get_columns);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_item_width, gxg_gtk_icon_view_set_item_width_w, 2, 0, 0, H_gtk_icon_view_set_item_width);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_item_width, gxg_gtk_icon_view_get_item_width_w, 1, 0, 0, H_gtk_icon_view_get_item_width);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_spacing, gxg_gtk_icon_view_set_spacing_w, 2, 0, 0, H_gtk_icon_view_set_spacing);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_spacing, gxg_gtk_icon_view_get_spacing_w, 1, 0, 0, H_gtk_icon_view_get_spacing);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_row_spacing, gxg_gtk_icon_view_set_row_spacing_w, 2, 0, 0, H_gtk_icon_view_set_row_spacing);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_row_spacing, gxg_gtk_icon_view_get_row_spacing_w, 1, 0, 0, H_gtk_icon_view_get_row_spacing);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_column_spacing, gxg_gtk_icon_view_set_column_spacing_w, 2, 0, 0, H_gtk_icon_view_set_column_spacing);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_column_spacing, gxg_gtk_icon_view_get_column_spacing_w, 1, 0, 0, H_gtk_icon_view_get_column_spacing);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_margin, gxg_gtk_icon_view_set_margin_w, 2, 0, 0, H_gtk_icon_view_set_margin);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_margin, gxg_gtk_icon_view_get_margin_w, 1, 0, 0, H_gtk_icon_view_get_margin);
- XG_DEFINE_PROCEDURE(gtk_label_set_max_width_chars, gxg_gtk_label_set_max_width_chars_w, 2, 0, 0, H_gtk_label_set_max_width_chars);
- XG_DEFINE_PROCEDURE(gtk_label_get_max_width_chars, gxg_gtk_label_get_max_width_chars_w, 1, 0, 0, H_gtk_label_get_max_width_chars);
- XG_DEFINE_PROCEDURE(gtk_list_store_insert_with_values, gxg_gtk_list_store_insert_with_values_w, 3, 0, 0, H_gtk_list_store_insert_with_values);
- XG_DEFINE_PROCEDURE(gtk_list_store_insert_with_valuesv, gxg_gtk_list_store_insert_with_valuesv_w, 6, 0, 0, H_gtk_list_store_insert_with_valuesv);
- XG_DEFINE_PROCEDURE(gtk_text_view_get_iter_at_position, gxg_gtk_text_view_get_iter_at_position_w, 4, 1, 0, H_gtk_text_view_get_iter_at_position);
- XG_DEFINE_PROCEDURE(pango_attr_size_new_absolute, gxg_pango_attr_size_new_absolute_w, 1, 0, 0, H_pango_attr_size_new_absolute);
- XG_DEFINE_PROCEDURE(pango_font_description_set_absolute_size, gxg_pango_font_description_set_absolute_size_w, 2, 0, 0, H_pango_font_description_set_absolute_size);
- XG_DEFINE_PROCEDURE(pango_layout_get_font_description, gxg_pango_layout_get_font_description_w, 1, 0, 0, H_pango_layout_get_font_description);
- XG_DEFINE_PROCEDURE(gdk_cursor_new_from_name, gxg_gdk_cursor_new_from_name_w, 2, 0, 0, H_gdk_cursor_new_from_name);
- XG_DEFINE_PROCEDURE(gdk_cursor_get_image, gxg_gdk_cursor_get_image_w, 1, 0, 0, H_gdk_cursor_get_image);
- XG_DEFINE_PROCEDURE(gdk_screen_get_rgba_visual, gxg_gdk_screen_get_rgba_visual_w, 1, 0, 0, H_gdk_screen_get_rgba_visual);
- XG_DEFINE_PROCEDURE(gdk_window_set_urgency_hint, gxg_gdk_window_set_urgency_hint_w, 2, 0, 0, H_gdk_window_set_urgency_hint);
- XG_DEFINE_PROCEDURE(gtk_action_get_accel_closure, gxg_gtk_action_get_accel_closure_w, 1, 0, 0, H_gtk_action_get_accel_closure);
- XG_DEFINE_PROCEDURE(gtk_dialog_get_response_for_widget, gxg_gtk_dialog_get_response_for_widget_w, 2, 0, 0, H_gtk_dialog_get_response_for_widget);
- XG_DEFINE_PROCEDURE(gtk_drag_source_set_icon_name, gxg_gtk_drag_source_set_icon_name_w, 2, 0, 0, H_gtk_drag_source_set_icon_name);
- XG_DEFINE_PROCEDURE(gtk_drag_set_icon_name, gxg_gtk_drag_set_icon_name_w, 4, 0, 0, H_gtk_drag_set_icon_name);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_popup_set_width, gxg_gtk_entry_completion_set_popup_set_width_w, 2, 0, 0, H_gtk_entry_completion_set_popup_set_width);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_popup_set_width, gxg_gtk_entry_completion_get_popup_set_width_w, 1, 0, 0, H_gtk_entry_completion_get_popup_set_width);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_popup_single_match, gxg_gtk_entry_completion_set_popup_single_match_w, 2, 0, 0, H_gtk_entry_completion_set_popup_single_match);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_popup_single_match, gxg_gtk_entry_completion_get_popup_single_match_w, 1, 0, 0, H_gtk_entry_completion_get_popup_single_match);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_item_at_pos, gxg_gtk_icon_view_get_item_at_pos_w, 3, 2, 0, H_gtk_icon_view_get_item_at_pos);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_visible_range, gxg_gtk_icon_view_get_visible_range_w, 1, 2, 0, H_gtk_icon_view_get_visible_range);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_cursor, gxg_gtk_icon_view_set_cursor_w, 4, 0, 0, H_gtk_icon_view_set_cursor);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_cursor, gxg_gtk_icon_view_get_cursor_w, 1, 2, 0, H_gtk_icon_view_get_cursor);
- XG_DEFINE_PROCEDURE(gtk_icon_view_scroll_to_path, gxg_gtk_icon_view_scroll_to_path_w, 5, 0, 0, H_gtk_icon_view_scroll_to_path);
- XG_DEFINE_PROCEDURE(gtk_icon_view_enable_model_drag_source, gxg_gtk_icon_view_enable_model_drag_source_w, 5, 0, 0, H_gtk_icon_view_enable_model_drag_source);
- XG_DEFINE_PROCEDURE(gtk_icon_view_enable_model_drag_dest, gxg_gtk_icon_view_enable_model_drag_dest_w, 4, 0, 0, H_gtk_icon_view_enable_model_drag_dest);
- XG_DEFINE_PROCEDURE(gtk_icon_view_unset_model_drag_source, gxg_gtk_icon_view_unset_model_drag_source_w, 1, 0, 0, H_gtk_icon_view_unset_model_drag_source);
- XG_DEFINE_PROCEDURE(gtk_icon_view_unset_model_drag_dest, gxg_gtk_icon_view_unset_model_drag_dest_w, 1, 0, 0, H_gtk_icon_view_unset_model_drag_dest);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_reorderable, gxg_gtk_icon_view_set_reorderable_w, 2, 0, 0, H_gtk_icon_view_set_reorderable);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_reorderable, gxg_gtk_icon_view_get_reorderable_w, 1, 0, 0, H_gtk_icon_view_get_reorderable);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_drag_dest_item, gxg_gtk_icon_view_set_drag_dest_item_w, 3, 0, 0, H_gtk_icon_view_set_drag_dest_item);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_drag_dest_item, gxg_gtk_icon_view_get_drag_dest_item_w, 1, 2, 0, H_gtk_icon_view_get_drag_dest_item);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_dest_item_at_pos, gxg_gtk_icon_view_get_dest_item_at_pos_w, 3, 2, 0, H_gtk_icon_view_get_dest_item_at_pos);
- XG_DEFINE_PROCEDURE(gtk_image_clear, gxg_gtk_image_clear_w, 1, 0, 0, H_gtk_image_clear);
- XG_DEFINE_PROCEDURE(gtk_menu_bar_get_pack_direction, gxg_gtk_menu_bar_get_pack_direction_w, 1, 0, 0, H_gtk_menu_bar_get_pack_direction);
- XG_DEFINE_PROCEDURE(gtk_menu_bar_set_pack_direction, gxg_gtk_menu_bar_set_pack_direction_w, 2, 0, 0, H_gtk_menu_bar_set_pack_direction);
- XG_DEFINE_PROCEDURE(gtk_menu_bar_get_child_pack_direction, gxg_gtk_menu_bar_get_child_pack_direction_w, 1, 0, 0, H_gtk_menu_bar_get_child_pack_direction);
- XG_DEFINE_PROCEDURE(gtk_menu_bar_set_child_pack_direction, gxg_gtk_menu_bar_set_child_pack_direction_w, 2, 0, 0, H_gtk_menu_bar_set_child_pack_direction);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_get_take_focus, gxg_gtk_menu_shell_get_take_focus_w, 1, 0, 0, H_gtk_menu_shell_get_take_focus);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_set_take_focus, gxg_gtk_menu_shell_set_take_focus_w, 2, 0, 0, H_gtk_menu_shell_set_take_focus);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_hscrollbar, gxg_gtk_scrolled_window_get_hscrollbar_w, 1, 0, 0, H_gtk_scrolled_window_get_hscrollbar);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_vscrollbar, gxg_gtk_scrolled_window_get_vscrollbar_w, 1, 0, 0, H_gtk_scrolled_window_get_vscrollbar);
- XG_DEFINE_PROCEDURE(gtk_size_group_set_ignore_hidden, gxg_gtk_size_group_set_ignore_hidden_w, 2, 0, 0, H_gtk_size_group_set_ignore_hidden);
- XG_DEFINE_PROCEDURE(gtk_size_group_get_ignore_hidden, gxg_gtk_size_group_get_ignore_hidden_w, 1, 0, 0, H_gtk_size_group_get_ignore_hidden);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_visible_line, gxg_gtk_text_iter_forward_visible_line_w, 1, 0, 0, H_gtk_text_iter_forward_visible_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_visible_line, gxg_gtk_text_iter_backward_visible_line_w, 1, 0, 0, H_gtk_text_iter_backward_visible_line);
- XG_DEFINE_PROCEDURE(gtk_text_iter_forward_visible_lines, gxg_gtk_text_iter_forward_visible_lines_w, 2, 0, 0, H_gtk_text_iter_forward_visible_lines);
- XG_DEFINE_PROCEDURE(gtk_text_iter_backward_visible_lines, gxg_gtk_text_iter_backward_visible_lines_w, 2, 0, 0, H_gtk_text_iter_backward_visible_lines);
- XG_DEFINE_PROCEDURE(gtk_tool_button_set_icon_name, gxg_gtk_tool_button_set_icon_name_w, 2, 0, 0, H_gtk_tool_button_set_icon_name);
- XG_DEFINE_PROCEDURE(gtk_tool_button_get_icon_name, gxg_gtk_tool_button_get_icon_name_w, 1, 0, 0, H_gtk_tool_button_get_icon_name);
- XG_DEFINE_PROCEDURE(gtk_window_set_urgency_hint, gxg_gtk_window_set_urgency_hint_w, 2, 0, 0, H_gtk_window_set_urgency_hint);
- XG_DEFINE_PROCEDURE(gtk_window_get_urgency_hint, gxg_gtk_window_get_urgency_hint_w, 1, 0, 0, H_gtk_window_get_urgency_hint);
- XG_DEFINE_PROCEDURE(gtk_window_present_with_time, gxg_gtk_window_present_with_time_w, 2, 0, 0, H_gtk_window_present_with_time);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_wrap_license, gxg_gtk_about_dialog_get_wrap_license_w, 1, 0, 0, H_gtk_about_dialog_get_wrap_license);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_wrap_license, gxg_gtk_about_dialog_set_wrap_license_w, 2, 0, 0, H_gtk_about_dialog_set_wrap_license);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_do_overwrite_confirmation, gxg_gtk_file_chooser_set_do_overwrite_confirmation_w, 2, 0, 0, H_gtk_file_chooser_set_do_overwrite_confirmation);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_do_overwrite_confirmation, gxg_gtk_file_chooser_get_do_overwrite_confirmation_w, 1, 0, 0, H_gtk_file_chooser_get_do_overwrite_confirmation);
- XG_DEFINE_PROCEDURE(gtk_tree_row_reference_get_model, gxg_gtk_tree_row_reference_get_model_w, 1, 0, 0, H_gtk_tree_row_reference_get_model);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_queue_resize, gxg_gtk_tree_view_column_queue_resize_w, 1, 0, 0, H_gtk_tree_view_column_queue_resize);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_visible_range, gxg_gtk_tree_view_get_visible_range_w, 1, 2, 0, H_gtk_tree_view_get_visible_range);
- XG_DEFINE_PROCEDURE(gtk_text_attributes_ref, gxg_gtk_text_attributes_ref_w, 1, 0, 0, H_gtk_text_attributes_ref);
- XG_DEFINE_PROCEDURE(pango_attr_list_ref, gxg_pango_attr_list_ref_w, 1, 0, 0, H_pango_attr_list_ref);
- XG_DEFINE_PROCEDURE(pango_layout_line_ref, gxg_pango_layout_line_ref_w, 1, 0, 0, H_pango_layout_line_ref);
- XG_DEFINE_PROCEDURE(pango_layout_index_to_line_x, gxg_pango_layout_index_to_line_x_w, 3, 2, 0, H_pango_layout_index_to_line_x);
- XG_DEFINE_PROCEDURE(gtk_target_list_ref, gxg_gtk_target_list_ref_w, 1, 0, 0, H_gtk_target_list_ref);
- XG_DEFINE_PROCEDURE(gdk_display_supports_shapes, gxg_gdk_display_supports_shapes_w, 1, 0, 0, H_gdk_display_supports_shapes);
- XG_DEFINE_PROCEDURE(gdk_display_supports_input_shapes, gxg_gdk_display_supports_input_shapes_w, 1, 0, 0, H_gdk_display_supports_input_shapes);
- XG_DEFINE_PROCEDURE(gdk_screen_is_composited, gxg_gdk_screen_is_composited_w, 1, 0, 0, H_gdk_screen_is_composited);
- XG_DEFINE_PROCEDURE(gdk_screen_set_resolution, gxg_gdk_screen_set_resolution_w, 2, 0, 0, H_gdk_screen_set_resolution);
- XG_DEFINE_PROCEDURE(gdk_screen_get_resolution, gxg_gdk_screen_get_resolution_w, 1, 0, 0, H_gdk_screen_get_resolution);
- XG_DEFINE_PROCEDURE(gdk_screen_get_active_window, gxg_gdk_screen_get_active_window_w, 1, 0, 0, H_gdk_screen_get_active_window);
- XG_DEFINE_PROCEDURE(gdk_screen_get_window_stack, gxg_gdk_screen_get_window_stack_w, 1, 0, 0, H_gdk_screen_get_window_stack);
- XG_DEFINE_PROCEDURE(gdk_window_get_type_hint, gxg_gdk_window_get_type_hint_w, 1, 0, 0, H_gdk_window_get_type_hint);
- XG_DEFINE_PROCEDURE(gtk_clipboard_request_rich_text, gxg_gtk_clipboard_request_rich_text_w, 3, 1, 0, H_gtk_clipboard_request_rich_text);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_for_rich_text, gxg_gtk_clipboard_wait_for_rich_text_w, 3, 1, 0, H_gtk_clipboard_wait_for_rich_text);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_is_rich_text_available, gxg_gtk_clipboard_wait_is_rich_text_available_w, 2, 0, 0, H_gtk_clipboard_wait_is_rich_text_available);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_title, gxg_gtk_combo_box_get_title_w, 1, 0, 0, H_gtk_combo_box_get_title);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_title, gxg_gtk_combo_box_set_title_w, 2, 0, 0, H_gtk_combo_box_set_title);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_set_track_motion, gxg_gtk_drag_dest_set_track_motion_w, 2, 0, 0, H_gtk_drag_dest_set_track_motion);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_get_track_motion, gxg_gtk_drag_dest_get_track_motion_w, 1, 0, 0, H_gtk_drag_dest_get_track_motion);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_button_get_focus_on_click, gxg_gtk_file_chooser_button_get_focus_on_click_w, 1, 0, 0, H_gtk_file_chooser_button_get_focus_on_click);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_button_set_focus_on_click, gxg_gtk_file_chooser_button_set_focus_on_click_w, 2, 0, 0, H_gtk_file_chooser_button_set_focus_on_click);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_tab_reorderable, gxg_gtk_notebook_get_tab_reorderable_w, 2, 0, 0, H_gtk_notebook_get_tab_reorderable);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_tab_reorderable, gxg_gtk_notebook_set_tab_reorderable_w, 3, 0, 0, H_gtk_notebook_set_tab_reorderable);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_tab_detachable, gxg_gtk_notebook_get_tab_detachable_w, 2, 0, 0, H_gtk_notebook_get_tab_detachable);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_tab_detachable, gxg_gtk_notebook_set_tab_detachable_w, 3, 0, 0, H_gtk_notebook_set_tab_detachable);
- XG_DEFINE_PROCEDURE(gtk_radio_action_set_current_value, gxg_gtk_radio_action_set_current_value_w, 2, 0, 0, H_gtk_radio_action_set_current_value);
- XG_DEFINE_PROCEDURE(gtk_range_set_lower_stepper_sensitivity, gxg_gtk_range_set_lower_stepper_sensitivity_w, 2, 0, 0, H_gtk_range_set_lower_stepper_sensitivity);
- XG_DEFINE_PROCEDURE(gtk_range_get_lower_stepper_sensitivity, gxg_gtk_range_get_lower_stepper_sensitivity_w, 1, 0, 0, H_gtk_range_get_lower_stepper_sensitivity);
- XG_DEFINE_PROCEDURE(gtk_range_set_upper_stepper_sensitivity, gxg_gtk_range_set_upper_stepper_sensitivity_w, 2, 0, 0, H_gtk_range_set_upper_stepper_sensitivity);
- XG_DEFINE_PROCEDURE(gtk_range_get_upper_stepper_sensitivity, gxg_gtk_range_get_upper_stepper_sensitivity_w, 1, 0, 0, H_gtk_range_get_upper_stepper_sensitivity);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_unset_placement, gxg_gtk_scrolled_window_unset_placement_w, 1, 0, 0, H_gtk_scrolled_window_unset_placement);
- XG_DEFINE_PROCEDURE(gtk_target_list_add_rich_text_targets, gxg_gtk_target_list_add_rich_text_targets_w, 4, 0, 0, H_gtk_target_list_add_rich_text_targets);
- XG_DEFINE_PROCEDURE(gtk_target_table_new_from_list, gxg_gtk_target_table_new_from_list_w, 1, 1, 0, H_gtk_target_table_new_from_list);
- XG_DEFINE_PROCEDURE(gtk_target_table_free, gxg_gtk_target_table_free_w, 2, 0, 0, H_gtk_target_table_free);
- XG_DEFINE_PROCEDURE(gtk_selection_data_targets_include_rich_text, gxg_gtk_selection_data_targets_include_rich_text_w, 2, 0, 0, H_gtk_selection_data_targets_include_rich_text);
- XG_DEFINE_PROCEDURE(gtk_selection_data_targets_include_uri, gxg_gtk_selection_data_targets_include_uri_w, 1, 0, 0, H_gtk_selection_data_targets_include_uri);
- XG_DEFINE_PROCEDURE(gtk_targets_include_text, gxg_gtk_targets_include_text_w, 2, 0, 0, H_gtk_targets_include_text);
- XG_DEFINE_PROCEDURE(gtk_targets_include_rich_text, gxg_gtk_targets_include_rich_text_w, 3, 0, 0, H_gtk_targets_include_rich_text);
- XG_DEFINE_PROCEDURE(gtk_targets_include_image, gxg_gtk_targets_include_image_w, 3, 0, 0, H_gtk_targets_include_image);
- XG_DEFINE_PROCEDURE(gtk_targets_include_uri, gxg_gtk_targets_include_uri_w, 2, 0, 0, H_gtk_targets_include_uri);
- XG_DEFINE_PROCEDURE(gtk_size_group_get_widgets, gxg_gtk_size_group_get_widgets_w, 1, 0, 0, H_gtk_size_group_get_widgets);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_has_selection, gxg_gtk_text_buffer_get_has_selection_w, 1, 0, 0, H_gtk_text_buffer_get_has_selection);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_copy_target_list, gxg_gtk_text_buffer_get_copy_target_list_w, 1, 0, 0, H_gtk_text_buffer_get_copy_target_list);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_paste_target_list, gxg_gtk_text_buffer_get_paste_target_list_w, 1, 0, 0, H_gtk_text_buffer_get_paste_target_list);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_headers_clickable, gxg_gtk_tree_view_get_headers_clickable_w, 1, 0, 0, H_gtk_tree_view_get_headers_clickable);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_search_entry, gxg_gtk_tree_view_get_search_entry_w, 1, 0, 0, H_gtk_tree_view_get_search_entry);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_search_entry, gxg_gtk_tree_view_set_search_entry_w, 2, 0, 0, H_gtk_tree_view_set_search_entry);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_search_position_func, gxg_gtk_tree_view_get_search_position_func_w, 1, 0, 0, H_gtk_tree_view_get_search_position_func);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_search_position_func, gxg_gtk_tree_view_set_search_position_func_w, 3, 1, 0, H_gtk_tree_view_set_search_position_func);
- XG_DEFINE_PROCEDURE(gtk_widget_is_composited, gxg_gtk_widget_is_composited_w, 1, 0, 0, H_gtk_widget_is_composited);
- XG_DEFINE_PROCEDURE(gtk_window_set_deletable, gxg_gtk_window_set_deletable_w, 2, 0, 0, H_gtk_window_set_deletable);
- XG_DEFINE_PROCEDURE(gtk_window_get_deletable, gxg_gtk_window_get_deletable_w, 1, 0, 0, H_gtk_window_get_deletable);
- XG_DEFINE_PROCEDURE(gtk_assistant_new, gxg_gtk_assistant_new_w, 0, 0, 0, H_gtk_assistant_new);
- XG_DEFINE_PROCEDURE(gtk_assistant_get_current_page, gxg_gtk_assistant_get_current_page_w, 1, 0, 0, H_gtk_assistant_get_current_page);
- XG_DEFINE_PROCEDURE(gtk_assistant_set_current_page, gxg_gtk_assistant_set_current_page_w, 2, 0, 0, H_gtk_assistant_set_current_page);
- XG_DEFINE_PROCEDURE(gtk_assistant_get_n_pages, gxg_gtk_assistant_get_n_pages_w, 1, 0, 0, H_gtk_assistant_get_n_pages);
- XG_DEFINE_PROCEDURE(gtk_assistant_get_nth_page, gxg_gtk_assistant_get_nth_page_w, 2, 0, 0, H_gtk_assistant_get_nth_page);
- XG_DEFINE_PROCEDURE(gtk_assistant_prepend_page, gxg_gtk_assistant_prepend_page_w, 2, 0, 0, H_gtk_assistant_prepend_page);
- XG_DEFINE_PROCEDURE(gtk_assistant_append_page, gxg_gtk_assistant_append_page_w, 2, 0, 0, H_gtk_assistant_append_page);
- XG_DEFINE_PROCEDURE(gtk_assistant_insert_page, gxg_gtk_assistant_insert_page_w, 3, 0, 0, H_gtk_assistant_insert_page);
- XG_DEFINE_PROCEDURE(gtk_assistant_set_forward_page_func, gxg_gtk_assistant_set_forward_page_func_w, 3, 1, 0, H_gtk_assistant_set_forward_page_func);
- XG_DEFINE_PROCEDURE(gtk_assistant_set_page_type, gxg_gtk_assistant_set_page_type_w, 3, 0, 0, H_gtk_assistant_set_page_type);
- XG_DEFINE_PROCEDURE(gtk_assistant_get_page_type, gxg_gtk_assistant_get_page_type_w, 2, 0, 0, H_gtk_assistant_get_page_type);
- XG_DEFINE_PROCEDURE(gtk_assistant_set_page_title, gxg_gtk_assistant_set_page_title_w, 3, 0, 0, H_gtk_assistant_set_page_title);
- XG_DEFINE_PROCEDURE(gtk_assistant_get_page_title, gxg_gtk_assistant_get_page_title_w, 2, 0, 0, H_gtk_assistant_get_page_title);
- XG_DEFINE_PROCEDURE(gtk_assistant_set_page_header_image, gxg_gtk_assistant_set_page_header_image_w, 3, 0, 0, H_gtk_assistant_set_page_header_image);
- XG_DEFINE_PROCEDURE(gtk_assistant_get_page_header_image, gxg_gtk_assistant_get_page_header_image_w, 2, 0, 0, H_gtk_assistant_get_page_header_image);
- XG_DEFINE_PROCEDURE(gtk_assistant_set_page_side_image, gxg_gtk_assistant_set_page_side_image_w, 3, 0, 0, H_gtk_assistant_set_page_side_image);
- XG_DEFINE_PROCEDURE(gtk_assistant_get_page_side_image, gxg_gtk_assistant_get_page_side_image_w, 2, 0, 0, H_gtk_assistant_get_page_side_image);
- XG_DEFINE_PROCEDURE(gtk_assistant_set_page_complete, gxg_gtk_assistant_set_page_complete_w, 3, 0, 0, H_gtk_assistant_set_page_complete);
- XG_DEFINE_PROCEDURE(gtk_assistant_get_page_complete, gxg_gtk_assistant_get_page_complete_w, 2, 0, 0, H_gtk_assistant_get_page_complete);
- XG_DEFINE_PROCEDURE(gtk_assistant_add_action_widget, gxg_gtk_assistant_add_action_widget_w, 2, 0, 0, H_gtk_assistant_add_action_widget);
- XG_DEFINE_PROCEDURE(gtk_assistant_remove_action_widget, gxg_gtk_assistant_remove_action_widget_w, 2, 0, 0, H_gtk_assistant_remove_action_widget);
- XG_DEFINE_PROCEDURE(gtk_assistant_update_buttons_state, gxg_gtk_assistant_update_buttons_state_w, 1, 0, 0, H_gtk_assistant_update_buttons_state);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_accel_new, gxg_gtk_cell_renderer_accel_new_w, 0, 0, 0, H_gtk_cell_renderer_accel_new);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_spin_new, gxg_gtk_cell_renderer_spin_new_w, 0, 0, 0, H_gtk_cell_renderer_spin_new);
- XG_DEFINE_PROCEDURE(gtk_link_button_new, gxg_gtk_link_button_new_w, 1, 0, 0, H_gtk_link_button_new);
- XG_DEFINE_PROCEDURE(gtk_link_button_new_with_label, gxg_gtk_link_button_new_with_label_w, 2, 0, 0, H_gtk_link_button_new_with_label);
- XG_DEFINE_PROCEDURE(gtk_link_button_get_uri, gxg_gtk_link_button_get_uri_w, 1, 0, 0, H_gtk_link_button_get_uri);
- XG_DEFINE_PROCEDURE(gtk_link_button_set_uri, gxg_gtk_link_button_set_uri_w, 2, 0, 0, H_gtk_link_button_set_uri);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_error_quark, gxg_gtk_recent_chooser_error_quark_w, 0, 0, 0, H_gtk_recent_chooser_error_quark);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_show_private, gxg_gtk_recent_chooser_set_show_private_w, 2, 0, 0, H_gtk_recent_chooser_set_show_private);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_show_private, gxg_gtk_recent_chooser_get_show_private_w, 1, 0, 0, H_gtk_recent_chooser_get_show_private);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_show_not_found, gxg_gtk_recent_chooser_set_show_not_found_w, 2, 0, 0, H_gtk_recent_chooser_set_show_not_found);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_show_not_found, gxg_gtk_recent_chooser_get_show_not_found_w, 1, 0, 0, H_gtk_recent_chooser_get_show_not_found);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_select_multiple, gxg_gtk_recent_chooser_set_select_multiple_w, 2, 0, 0, H_gtk_recent_chooser_set_select_multiple);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_select_multiple, gxg_gtk_recent_chooser_get_select_multiple_w, 1, 0, 0, H_gtk_recent_chooser_get_select_multiple);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_limit, gxg_gtk_recent_chooser_set_limit_w, 2, 0, 0, H_gtk_recent_chooser_set_limit);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_limit, gxg_gtk_recent_chooser_get_limit_w, 1, 0, 0, H_gtk_recent_chooser_get_limit);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_local_only, gxg_gtk_recent_chooser_set_local_only_w, 2, 0, 0, H_gtk_recent_chooser_set_local_only);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_local_only, gxg_gtk_recent_chooser_get_local_only_w, 1, 0, 0, H_gtk_recent_chooser_get_local_only);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_show_tips, gxg_gtk_recent_chooser_set_show_tips_w, 2, 0, 0, H_gtk_recent_chooser_set_show_tips);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_show_tips, gxg_gtk_recent_chooser_get_show_tips_w, 1, 0, 0, H_gtk_recent_chooser_get_show_tips);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_show_icons, gxg_gtk_recent_chooser_set_show_icons_w, 2, 0, 0, H_gtk_recent_chooser_set_show_icons);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_show_icons, gxg_gtk_recent_chooser_get_show_icons_w, 1, 0, 0, H_gtk_recent_chooser_get_show_icons);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_sort_type, gxg_gtk_recent_chooser_set_sort_type_w, 2, 0, 0, H_gtk_recent_chooser_set_sort_type);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_sort_type, gxg_gtk_recent_chooser_get_sort_type_w, 1, 0, 0, H_gtk_recent_chooser_get_sort_type);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_sort_func, gxg_gtk_recent_chooser_set_sort_func_w, 3, 1, 0, H_gtk_recent_chooser_set_sort_func);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_current_uri, gxg_gtk_recent_chooser_set_current_uri_w, 2, 1, 0, H_gtk_recent_chooser_set_current_uri);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_current_uri, gxg_gtk_recent_chooser_get_current_uri_w, 1, 0, 0, H_gtk_recent_chooser_get_current_uri);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_current_item, gxg_gtk_recent_chooser_get_current_item_w, 1, 0, 0, H_gtk_recent_chooser_get_current_item);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_select_uri, gxg_gtk_recent_chooser_select_uri_w, 2, 1, 0, H_gtk_recent_chooser_select_uri);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_unselect_uri, gxg_gtk_recent_chooser_unselect_uri_w, 2, 0, 0, H_gtk_recent_chooser_unselect_uri);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_select_all, gxg_gtk_recent_chooser_select_all_w, 1, 0, 0, H_gtk_recent_chooser_select_all);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_unselect_all, gxg_gtk_recent_chooser_unselect_all_w, 1, 0, 0, H_gtk_recent_chooser_unselect_all);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_items, gxg_gtk_recent_chooser_get_items_w, 1, 0, 0, H_gtk_recent_chooser_get_items);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_uris, gxg_gtk_recent_chooser_get_uris_w, 1, 1, 0, H_gtk_recent_chooser_get_uris);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_add_filter, gxg_gtk_recent_chooser_add_filter_w, 2, 0, 0, H_gtk_recent_chooser_add_filter);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_remove_filter, gxg_gtk_recent_chooser_remove_filter_w, 2, 0, 0, H_gtk_recent_chooser_remove_filter);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_list_filters, gxg_gtk_recent_chooser_list_filters_w, 1, 0, 0, H_gtk_recent_chooser_list_filters);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_set_filter, gxg_gtk_recent_chooser_set_filter_w, 2, 0, 0, H_gtk_recent_chooser_set_filter);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_get_filter, gxg_gtk_recent_chooser_get_filter_w, 1, 0, 0, H_gtk_recent_chooser_get_filter);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_menu_new, gxg_gtk_recent_chooser_menu_new_w, 0, 0, 0, H_gtk_recent_chooser_menu_new);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_menu_new_for_manager, gxg_gtk_recent_chooser_menu_new_for_manager_w, 1, 0, 0, H_gtk_recent_chooser_menu_new_for_manager);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_menu_get_show_numbers, gxg_gtk_recent_chooser_menu_get_show_numbers_w, 1, 0, 0, H_gtk_recent_chooser_menu_get_show_numbers);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_menu_set_show_numbers, gxg_gtk_recent_chooser_menu_set_show_numbers_w, 2, 0, 0, H_gtk_recent_chooser_menu_set_show_numbers);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_widget_new, gxg_gtk_recent_chooser_widget_new_w, 0, 0, 0, H_gtk_recent_chooser_widget_new);
- XG_DEFINE_PROCEDURE(gtk_recent_chooser_widget_new_for_manager, gxg_gtk_recent_chooser_widget_new_for_manager_w, 1, 0, 0, H_gtk_recent_chooser_widget_new_for_manager);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_new, gxg_gtk_recent_filter_new_w, 0, 0, 0, H_gtk_recent_filter_new);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_set_name, gxg_gtk_recent_filter_set_name_w, 2, 0, 0, H_gtk_recent_filter_set_name);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_get_name, gxg_gtk_recent_filter_get_name_w, 1, 0, 0, H_gtk_recent_filter_get_name);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_add_mime_type, gxg_gtk_recent_filter_add_mime_type_w, 2, 0, 0, H_gtk_recent_filter_add_mime_type);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_add_pattern, gxg_gtk_recent_filter_add_pattern_w, 2, 0, 0, H_gtk_recent_filter_add_pattern);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_add_pixbuf_formats, gxg_gtk_recent_filter_add_pixbuf_formats_w, 1, 0, 0, H_gtk_recent_filter_add_pixbuf_formats);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_add_application, gxg_gtk_recent_filter_add_application_w, 2, 0, 0, H_gtk_recent_filter_add_application);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_add_group, gxg_gtk_recent_filter_add_group_w, 2, 0, 0, H_gtk_recent_filter_add_group);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_add_age, gxg_gtk_recent_filter_add_age_w, 2, 0, 0, H_gtk_recent_filter_add_age);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_add_custom, gxg_gtk_recent_filter_add_custom_w, 4, 1, 0, H_gtk_recent_filter_add_custom);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_get_needed, gxg_gtk_recent_filter_get_needed_w, 1, 0, 0, H_gtk_recent_filter_get_needed);
- XG_DEFINE_PROCEDURE(gtk_recent_filter_filter, gxg_gtk_recent_filter_filter_w, 2, 0, 0, H_gtk_recent_filter_filter);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_error_quark, gxg_gtk_recent_manager_error_quark_w, 0, 0, 0, H_gtk_recent_manager_error_quark);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_new, gxg_gtk_recent_manager_new_w, 0, 0, 0, H_gtk_recent_manager_new);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_get_default, gxg_gtk_recent_manager_get_default_w, 0, 0, 0, H_gtk_recent_manager_get_default);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_remove_item, gxg_gtk_recent_manager_remove_item_w, 2, 1, 0, H_gtk_recent_manager_remove_item);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_lookup_item, gxg_gtk_recent_manager_lookup_item_w, 2, 1, 0, H_gtk_recent_manager_lookup_item);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_has_item, gxg_gtk_recent_manager_has_item_w, 2, 0, 0, H_gtk_recent_manager_has_item);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_move_item, gxg_gtk_recent_manager_move_item_w, 3, 1, 0, H_gtk_recent_manager_move_item);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_get_items, gxg_gtk_recent_manager_get_items_w, 1, 0, 0, H_gtk_recent_manager_get_items);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_purge_items, gxg_gtk_recent_manager_purge_items_w, 1, 1, 0, H_gtk_recent_manager_purge_items);
- XG_DEFINE_PROCEDURE(gtk_recent_info_ref, gxg_gtk_recent_info_ref_w, 1, 0, 0, H_gtk_recent_info_ref);
- XG_DEFINE_PROCEDURE(gtk_recent_info_unref, gxg_gtk_recent_info_unref_w, 1, 0, 0, H_gtk_recent_info_unref);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_uri, gxg_gtk_recent_info_get_uri_w, 1, 0, 0, H_gtk_recent_info_get_uri);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_display_name, gxg_gtk_recent_info_get_display_name_w, 1, 0, 0, H_gtk_recent_info_get_display_name);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_description, gxg_gtk_recent_info_get_description_w, 1, 0, 0, H_gtk_recent_info_get_description);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_mime_type, gxg_gtk_recent_info_get_mime_type_w, 1, 0, 0, H_gtk_recent_info_get_mime_type);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_added, gxg_gtk_recent_info_get_added_w, 1, 0, 0, H_gtk_recent_info_get_added);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_modified, gxg_gtk_recent_info_get_modified_w, 1, 0, 0, H_gtk_recent_info_get_modified);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_visited, gxg_gtk_recent_info_get_visited_w, 1, 0, 0, H_gtk_recent_info_get_visited);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_private_hint, gxg_gtk_recent_info_get_private_hint_w, 1, 0, 0, H_gtk_recent_info_get_private_hint);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_applications, gxg_gtk_recent_info_get_applications_w, 1, 1, 0, H_gtk_recent_info_get_applications);
- XG_DEFINE_PROCEDURE(gtk_recent_info_last_application, gxg_gtk_recent_info_last_application_w, 1, 0, 0, H_gtk_recent_info_last_application);
- XG_DEFINE_PROCEDURE(gtk_recent_info_has_application, gxg_gtk_recent_info_has_application_w, 2, 0, 0, H_gtk_recent_info_has_application);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_groups, gxg_gtk_recent_info_get_groups_w, 1, 1, 0, H_gtk_recent_info_get_groups);
- XG_DEFINE_PROCEDURE(gtk_recent_info_has_group, gxg_gtk_recent_info_has_group_w, 2, 0, 0, H_gtk_recent_info_has_group);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_icon, gxg_gtk_recent_info_get_icon_w, 2, 0, 0, H_gtk_recent_info_get_icon);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_short_name, gxg_gtk_recent_info_get_short_name_w, 1, 0, 0, H_gtk_recent_info_get_short_name);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_uri_display, gxg_gtk_recent_info_get_uri_display_w, 1, 0, 0, H_gtk_recent_info_get_uri_display);
- XG_DEFINE_PROCEDURE(gtk_recent_info_get_age, gxg_gtk_recent_info_get_age_w, 1, 0, 0, H_gtk_recent_info_get_age);
- XG_DEFINE_PROCEDURE(gtk_recent_info_is_local, gxg_gtk_recent_info_is_local_w, 1, 0, 0, H_gtk_recent_info_is_local);
- XG_DEFINE_PROCEDURE(gtk_recent_info_exists, gxg_gtk_recent_info_exists_w, 1, 0, 0, H_gtk_recent_info_exists);
- XG_DEFINE_PROCEDURE(gtk_recent_info_match, gxg_gtk_recent_info_match_w, 2, 0, 0, H_gtk_recent_info_match);
- XG_DEFINE_PROCEDURE(gtk_status_icon_new, gxg_gtk_status_icon_new_w, 0, 0, 0, H_gtk_status_icon_new);
- XG_DEFINE_PROCEDURE(gtk_status_icon_new_from_pixbuf, gxg_gtk_status_icon_new_from_pixbuf_w, 1, 0, 0, H_gtk_status_icon_new_from_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_status_icon_new_from_file, gxg_gtk_status_icon_new_from_file_w, 1, 0, 0, H_gtk_status_icon_new_from_file);
- XG_DEFINE_PROCEDURE(gtk_status_icon_new_from_stock, gxg_gtk_status_icon_new_from_stock_w, 1, 0, 0, H_gtk_status_icon_new_from_stock);
- XG_DEFINE_PROCEDURE(gtk_status_icon_new_from_icon_name, gxg_gtk_status_icon_new_from_icon_name_w, 1, 0, 0, H_gtk_status_icon_new_from_icon_name);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_from_pixbuf, gxg_gtk_status_icon_set_from_pixbuf_w, 2, 0, 0, H_gtk_status_icon_set_from_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_from_file, gxg_gtk_status_icon_set_from_file_w, 2, 0, 0, H_gtk_status_icon_set_from_file);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_from_stock, gxg_gtk_status_icon_set_from_stock_w, 2, 0, 0, H_gtk_status_icon_set_from_stock);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_from_icon_name, gxg_gtk_status_icon_set_from_icon_name_w, 2, 0, 0, H_gtk_status_icon_set_from_icon_name);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_storage_type, gxg_gtk_status_icon_get_storage_type_w, 1, 0, 0, H_gtk_status_icon_get_storage_type);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_pixbuf, gxg_gtk_status_icon_get_pixbuf_w, 1, 0, 0, H_gtk_status_icon_get_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_stock, gxg_gtk_status_icon_get_stock_w, 1, 0, 0, H_gtk_status_icon_get_stock);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_icon_name, gxg_gtk_status_icon_get_icon_name_w, 1, 0, 0, H_gtk_status_icon_get_icon_name);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_size, gxg_gtk_status_icon_get_size_w, 1, 0, 0, H_gtk_status_icon_get_size);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_visible, gxg_gtk_status_icon_set_visible_w, 2, 0, 0, H_gtk_status_icon_set_visible);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_visible, gxg_gtk_status_icon_get_visible_w, 1, 0, 0, H_gtk_status_icon_get_visible);
- XG_DEFINE_PROCEDURE(gtk_status_icon_is_embedded, gxg_gtk_status_icon_is_embedded_w, 1, 0, 0, H_gtk_status_icon_is_embedded);
- XG_DEFINE_PROCEDURE(gtk_status_icon_position_menu, gxg_gtk_status_icon_position_menu_w, 2, 3, 0, H_gtk_status_icon_position_menu);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_register_serialize_format, gxg_gtk_text_buffer_register_serialize_format_w, 5, 0, 0, H_gtk_text_buffer_register_serialize_format);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_register_serialize_tagset, gxg_gtk_text_buffer_register_serialize_tagset_w, 2, 0, 0, H_gtk_text_buffer_register_serialize_tagset);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_register_deserialize_format, gxg_gtk_text_buffer_register_deserialize_format_w, 5, 0, 0, H_gtk_text_buffer_register_deserialize_format);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_register_deserialize_tagset, gxg_gtk_text_buffer_register_deserialize_tagset_w, 2, 0, 0, H_gtk_text_buffer_register_deserialize_tagset);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_unregister_serialize_format, gxg_gtk_text_buffer_unregister_serialize_format_w, 2, 0, 0, H_gtk_text_buffer_unregister_serialize_format);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_unregister_deserialize_format, gxg_gtk_text_buffer_unregister_deserialize_format_w, 2, 0, 0, H_gtk_text_buffer_unregister_deserialize_format);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_deserialize_set_can_create_tags, gxg_gtk_text_buffer_deserialize_set_can_create_tags_w, 3, 0, 0, H_gtk_text_buffer_deserialize_set_can_create_tags);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_deserialize_get_can_create_tags, gxg_gtk_text_buffer_deserialize_get_can_create_tags_w, 2, 0, 0, H_gtk_text_buffer_deserialize_get_can_create_tags);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_serialize_formats, gxg_gtk_text_buffer_get_serialize_formats_w, 1, 1, 0, H_gtk_text_buffer_get_serialize_formats);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_get_deserialize_formats, gxg_gtk_text_buffer_get_deserialize_formats_w, 1, 1, 0, H_gtk_text_buffer_get_deserialize_formats);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_serialize, gxg_gtk_text_buffer_serialize_w, 5, 1, 0, H_gtk_text_buffer_serialize);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_deserialize, gxg_gtk_text_buffer_deserialize_w, 6, 1, 0, H_gtk_text_buffer_deserialize);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_add_item, gxg_gtk_recent_manager_add_item_w, 2, 0, 0, H_gtk_recent_manager_add_item);
- XG_DEFINE_PROCEDURE(gtk_recent_manager_add_full, gxg_gtk_recent_manager_add_full_w, 3, 0, 0, H_gtk_recent_manager_add_full);
- XG_DEFINE_PROCEDURE(gtk_tree_model_filter_convert_child_iter_to_iter, gxg_gtk_tree_model_filter_convert_child_iter_to_iter_w, 3, 0, 0, H_gtk_tree_model_filter_convert_child_iter_to_iter);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_grid_lines, gxg_gtk_tree_view_get_grid_lines_w, 1, 0, 0, H_gtk_tree_view_get_grid_lines);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_grid_lines, gxg_gtk_tree_view_set_grid_lines_w, 2, 0, 0, H_gtk_tree_view_set_grid_lines);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_enable_tree_lines, gxg_gtk_tree_view_get_enable_tree_lines_w, 1, 0, 0, H_gtk_tree_view_get_enable_tree_lines);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_enable_tree_lines, gxg_gtk_tree_view_set_enable_tree_lines_w, 2, 0, 0, H_gtk_tree_view_set_enable_tree_lines);
- XG_DEFINE_PROCEDURE(gtk_label_set_line_wrap_mode, gxg_gtk_label_set_line_wrap_mode_w, 2, 0, 0, H_gtk_label_set_line_wrap_mode);
- XG_DEFINE_PROCEDURE(gtk_label_get_line_wrap_mode, gxg_gtk_label_get_line_wrap_mode_w, 1, 0, 0, H_gtk_label_get_line_wrap_mode);
- XG_DEFINE_PROCEDURE(gtk_print_context_get_cairo_context, gxg_gtk_print_context_get_cairo_context_w, 1, 0, 0, H_gtk_print_context_get_cairo_context);
- XG_DEFINE_PROCEDURE(gtk_print_context_get_page_setup, gxg_gtk_print_context_get_page_setup_w, 1, 0, 0, H_gtk_print_context_get_page_setup);
- XG_DEFINE_PROCEDURE(gtk_print_context_get_width, gxg_gtk_print_context_get_width_w, 1, 0, 0, H_gtk_print_context_get_width);
- XG_DEFINE_PROCEDURE(gtk_print_context_get_height, gxg_gtk_print_context_get_height_w, 1, 0, 0, H_gtk_print_context_get_height);
- XG_DEFINE_PROCEDURE(gtk_print_context_get_dpi_x, gxg_gtk_print_context_get_dpi_x_w, 1, 0, 0, H_gtk_print_context_get_dpi_x);
- XG_DEFINE_PROCEDURE(gtk_print_context_get_dpi_y, gxg_gtk_print_context_get_dpi_y_w, 1, 0, 0, H_gtk_print_context_get_dpi_y);
- XG_DEFINE_PROCEDURE(gtk_print_context_create_pango_context, gxg_gtk_print_context_create_pango_context_w, 1, 0, 0, H_gtk_print_context_create_pango_context);
- XG_DEFINE_PROCEDURE(gtk_print_context_create_pango_layout, gxg_gtk_print_context_create_pango_layout_w, 1, 0, 0, H_gtk_print_context_create_pango_layout);
- XG_DEFINE_PROCEDURE(gtk_print_context_set_cairo_context, gxg_gtk_print_context_set_cairo_context_w, 4, 0, 0, H_gtk_print_context_set_cairo_context);
- XG_DEFINE_PROCEDURE(gtk_print_operation_new, gxg_gtk_print_operation_new_w, 0, 0, 0, H_gtk_print_operation_new);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_default_page_setup, gxg_gtk_print_operation_set_default_page_setup_w, 2, 0, 0, H_gtk_print_operation_set_default_page_setup);
- XG_DEFINE_PROCEDURE(gtk_print_operation_get_default_page_setup, gxg_gtk_print_operation_get_default_page_setup_w, 1, 0, 0, H_gtk_print_operation_get_default_page_setup);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_print_settings, gxg_gtk_print_operation_set_print_settings_w, 2, 0, 0, H_gtk_print_operation_set_print_settings);
- XG_DEFINE_PROCEDURE(gtk_print_operation_get_print_settings, gxg_gtk_print_operation_get_print_settings_w, 1, 0, 0, H_gtk_print_operation_get_print_settings);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_job_name, gxg_gtk_print_operation_set_job_name_w, 2, 0, 0, H_gtk_print_operation_set_job_name);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_n_pages, gxg_gtk_print_operation_set_n_pages_w, 2, 0, 0, H_gtk_print_operation_set_n_pages);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_current_page, gxg_gtk_print_operation_set_current_page_w, 2, 0, 0, H_gtk_print_operation_set_current_page);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_use_full_page, gxg_gtk_print_operation_set_use_full_page_w, 2, 0, 0, H_gtk_print_operation_set_use_full_page);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_unit, gxg_gtk_print_operation_set_unit_w, 2, 0, 0, H_gtk_print_operation_set_unit);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_export_filename, gxg_gtk_print_operation_set_export_filename_w, 2, 0, 0, H_gtk_print_operation_set_export_filename);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_track_print_status, gxg_gtk_print_operation_set_track_print_status_w, 2, 0, 0, H_gtk_print_operation_set_track_print_status);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_show_progress, gxg_gtk_print_operation_set_show_progress_w, 2, 0, 0, H_gtk_print_operation_set_show_progress);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_allow_async, gxg_gtk_print_operation_set_allow_async_w, 2, 0, 0, H_gtk_print_operation_set_allow_async);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_custom_tab_label, gxg_gtk_print_operation_set_custom_tab_label_w, 2, 0, 0, H_gtk_print_operation_set_custom_tab_label);
- XG_DEFINE_PROCEDURE(gtk_print_operation_run, gxg_gtk_print_operation_run_w, 3, 1, 0, H_gtk_print_operation_run);
- XG_DEFINE_PROCEDURE(gtk_print_operation_get_error, gxg_gtk_print_operation_get_error_w, 1, 1, 0, H_gtk_print_operation_get_error);
- XG_DEFINE_PROCEDURE(gtk_print_operation_get_status, gxg_gtk_print_operation_get_status_w, 1, 0, 0, H_gtk_print_operation_get_status);
- XG_DEFINE_PROCEDURE(gtk_print_operation_get_status_string, gxg_gtk_print_operation_get_status_string_w, 1, 0, 0, H_gtk_print_operation_get_status_string);
- XG_DEFINE_PROCEDURE(gtk_print_operation_is_finished, gxg_gtk_print_operation_is_finished_w, 1, 0, 0, H_gtk_print_operation_is_finished);
- XG_DEFINE_PROCEDURE(gtk_print_operation_cancel, gxg_gtk_print_operation_cancel_w, 1, 0, 0, H_gtk_print_operation_cancel);
- XG_DEFINE_PROCEDURE(gtk_print_run_page_setup_dialog, gxg_gtk_print_run_page_setup_dialog_w, 3, 0, 0, H_gtk_print_run_page_setup_dialog);
- XG_DEFINE_PROCEDURE(gtk_print_run_page_setup_dialog_async, gxg_gtk_print_run_page_setup_dialog_async_w, 5, 0, 0, H_gtk_print_run_page_setup_dialog_async);
- XG_DEFINE_PROCEDURE(gtk_print_operation_preview_render_page, gxg_gtk_print_operation_preview_render_page_w, 2, 0, 0, H_gtk_print_operation_preview_render_page);
- XG_DEFINE_PROCEDURE(gtk_print_operation_preview_end_preview, gxg_gtk_print_operation_preview_end_preview_w, 1, 0, 0, H_gtk_print_operation_preview_end_preview);
- XG_DEFINE_PROCEDURE(gtk_print_operation_preview_is_selected, gxg_gtk_print_operation_preview_is_selected_w, 2, 0, 0, H_gtk_print_operation_preview_is_selected);
- XG_DEFINE_PROCEDURE(gtk_print_settings_new, gxg_gtk_print_settings_new_w, 0, 0, 0, H_gtk_print_settings_new);
- XG_DEFINE_PROCEDURE(gtk_print_settings_copy, gxg_gtk_print_settings_copy_w, 1, 0, 0, H_gtk_print_settings_copy);
- XG_DEFINE_PROCEDURE(gtk_print_settings_has_key, gxg_gtk_print_settings_has_key_w, 2, 0, 0, H_gtk_print_settings_has_key);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get, gxg_gtk_print_settings_get_w, 2, 0, 0, H_gtk_print_settings_get);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set, gxg_gtk_print_settings_set_w, 3, 0, 0, H_gtk_print_settings_set);
- XG_DEFINE_PROCEDURE(gtk_print_settings_unset, gxg_gtk_print_settings_unset_w, 2, 0, 0, H_gtk_print_settings_unset);
- XG_DEFINE_PROCEDURE(gtk_print_settings_foreach, gxg_gtk_print_settings_foreach_w, 3, 0, 0, H_gtk_print_settings_foreach);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_bool, gxg_gtk_print_settings_get_bool_w, 2, 0, 0, H_gtk_print_settings_get_bool);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_bool, gxg_gtk_print_settings_set_bool_w, 3, 0, 0, H_gtk_print_settings_set_bool);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_double, gxg_gtk_print_settings_get_double_w, 2, 0, 0, H_gtk_print_settings_get_double);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_double_with_default, gxg_gtk_print_settings_get_double_with_default_w, 3, 0, 0, H_gtk_print_settings_get_double_with_default);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_double, gxg_gtk_print_settings_set_double_w, 3, 0, 0, H_gtk_print_settings_set_double);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_length, gxg_gtk_print_settings_get_length_w, 3, 0, 0, H_gtk_print_settings_get_length);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_length, gxg_gtk_print_settings_set_length_w, 4, 0, 0, H_gtk_print_settings_set_length);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_int, gxg_gtk_print_settings_get_int_w, 2, 0, 0, H_gtk_print_settings_get_int);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_int_with_default, gxg_gtk_print_settings_get_int_with_default_w, 3, 0, 0, H_gtk_print_settings_get_int_with_default);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_int, gxg_gtk_print_settings_set_int_w, 3, 0, 0, H_gtk_print_settings_set_int);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_printer, gxg_gtk_print_settings_get_printer_w, 1, 0, 0, H_gtk_print_settings_get_printer);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_printer, gxg_gtk_print_settings_set_printer_w, 2, 0, 0, H_gtk_print_settings_set_printer);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_orientation, gxg_gtk_print_settings_get_orientation_w, 1, 0, 0, H_gtk_print_settings_get_orientation);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_orientation, gxg_gtk_print_settings_set_orientation_w, 2, 0, 0, H_gtk_print_settings_set_orientation);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_paper_size, gxg_gtk_print_settings_get_paper_size_w, 1, 0, 0, H_gtk_print_settings_get_paper_size);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_paper_size, gxg_gtk_print_settings_set_paper_size_w, 2, 0, 0, H_gtk_print_settings_set_paper_size);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_paper_width, gxg_gtk_print_settings_get_paper_width_w, 2, 0, 0, H_gtk_print_settings_get_paper_width);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_paper_width, gxg_gtk_print_settings_set_paper_width_w, 3, 0, 0, H_gtk_print_settings_set_paper_width);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_paper_height, gxg_gtk_print_settings_get_paper_height_w, 2, 0, 0, H_gtk_print_settings_get_paper_height);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_paper_height, gxg_gtk_print_settings_set_paper_height_w, 3, 0, 0, H_gtk_print_settings_set_paper_height);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_use_color, gxg_gtk_print_settings_get_use_color_w, 1, 0, 0, H_gtk_print_settings_get_use_color);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_use_color, gxg_gtk_print_settings_set_use_color_w, 2, 0, 0, H_gtk_print_settings_set_use_color);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_collate, gxg_gtk_print_settings_get_collate_w, 1, 0, 0, H_gtk_print_settings_get_collate);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_collate, gxg_gtk_print_settings_set_collate_w, 2, 0, 0, H_gtk_print_settings_set_collate);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_reverse, gxg_gtk_print_settings_get_reverse_w, 1, 0, 0, H_gtk_print_settings_get_reverse);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_reverse, gxg_gtk_print_settings_set_reverse_w, 2, 0, 0, H_gtk_print_settings_set_reverse);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_duplex, gxg_gtk_print_settings_get_duplex_w, 1, 0, 0, H_gtk_print_settings_get_duplex);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_duplex, gxg_gtk_print_settings_set_duplex_w, 2, 0, 0, H_gtk_print_settings_set_duplex);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_quality, gxg_gtk_print_settings_get_quality_w, 1, 0, 0, H_gtk_print_settings_get_quality);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_quality, gxg_gtk_print_settings_set_quality_w, 2, 0, 0, H_gtk_print_settings_set_quality);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_n_copies, gxg_gtk_print_settings_get_n_copies_w, 1, 0, 0, H_gtk_print_settings_get_n_copies);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_n_copies, gxg_gtk_print_settings_set_n_copies_w, 2, 0, 0, H_gtk_print_settings_set_n_copies);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_number_up, gxg_gtk_print_settings_get_number_up_w, 1, 0, 0, H_gtk_print_settings_get_number_up);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_number_up, gxg_gtk_print_settings_set_number_up_w, 2, 0, 0, H_gtk_print_settings_set_number_up);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_resolution, gxg_gtk_print_settings_get_resolution_w, 1, 0, 0, H_gtk_print_settings_get_resolution);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_resolution, gxg_gtk_print_settings_set_resolution_w, 2, 0, 0, H_gtk_print_settings_set_resolution);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_scale, gxg_gtk_print_settings_get_scale_w, 1, 0, 0, H_gtk_print_settings_get_scale);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_scale, gxg_gtk_print_settings_set_scale_w, 2, 0, 0, H_gtk_print_settings_set_scale);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_print_pages, gxg_gtk_print_settings_get_print_pages_w, 1, 0, 0, H_gtk_print_settings_get_print_pages);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_print_pages, gxg_gtk_print_settings_set_print_pages_w, 2, 0, 0, H_gtk_print_settings_set_print_pages);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_page_ranges, gxg_gtk_print_settings_get_page_ranges_w, 2, 0, 0, H_gtk_print_settings_get_page_ranges);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_page_ranges, gxg_gtk_print_settings_set_page_ranges_w, 3, 0, 0, H_gtk_print_settings_set_page_ranges);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_page_set, gxg_gtk_print_settings_get_page_set_w, 1, 0, 0, H_gtk_print_settings_get_page_set);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_page_set, gxg_gtk_print_settings_set_page_set_w, 2, 0, 0, H_gtk_print_settings_set_page_set);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_default_source, gxg_gtk_print_settings_get_default_source_w, 1, 0, 0, H_gtk_print_settings_get_default_source);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_default_source, gxg_gtk_print_settings_set_default_source_w, 2, 0, 0, H_gtk_print_settings_set_default_source);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_media_type, gxg_gtk_print_settings_get_media_type_w, 1, 0, 0, H_gtk_print_settings_get_media_type);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_media_type, gxg_gtk_print_settings_set_media_type_w, 2, 0, 0, H_gtk_print_settings_set_media_type);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_dither, gxg_gtk_print_settings_get_dither_w, 1, 0, 0, H_gtk_print_settings_get_dither);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_dither, gxg_gtk_print_settings_set_dither_w, 2, 0, 0, H_gtk_print_settings_set_dither);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_finishings, gxg_gtk_print_settings_get_finishings_w, 1, 0, 0, H_gtk_print_settings_get_finishings);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_finishings, gxg_gtk_print_settings_set_finishings_w, 2, 0, 0, H_gtk_print_settings_set_finishings);
- XG_DEFINE_PROCEDURE(gtk_print_settings_get_output_bin, gxg_gtk_print_settings_get_output_bin_w, 1, 0, 0, H_gtk_print_settings_get_output_bin);
- XG_DEFINE_PROCEDURE(gtk_print_settings_set_output_bin, gxg_gtk_print_settings_set_output_bin_w, 2, 0, 0, H_gtk_print_settings_set_output_bin);
- XG_DEFINE_PROCEDURE(gtk_settings_get_for_screen, gxg_gtk_settings_get_for_screen_w, 1, 0, 0, H_gtk_settings_get_for_screen);
- XG_DEFINE_PROCEDURE(pango_cairo_create_layout, gxg_pango_cairo_create_layout_w, 1, 0, 0, H_pango_cairo_create_layout);
- XG_DEFINE_PROCEDURE(pango_cairo_update_layout, gxg_pango_cairo_update_layout_w, 2, 0, 0, H_pango_cairo_update_layout);
- XG_DEFINE_PROCEDURE(pango_cairo_update_context, gxg_pango_cairo_update_context_w, 2, 0, 0, H_pango_cairo_update_context);
- XG_DEFINE_PROCEDURE(pango_cairo_context_set_font_options, gxg_pango_cairo_context_set_font_options_w, 2, 0, 0, H_pango_cairo_context_set_font_options);
- XG_DEFINE_PROCEDURE(pango_cairo_context_get_font_options, gxg_pango_cairo_context_get_font_options_w, 1, 0, 0, H_pango_cairo_context_get_font_options);
- XG_DEFINE_PROCEDURE(pango_cairo_context_set_resolution, gxg_pango_cairo_context_set_resolution_w, 2, 0, 0, H_pango_cairo_context_set_resolution);
- XG_DEFINE_PROCEDURE(pango_cairo_context_get_resolution, gxg_pango_cairo_context_get_resolution_w, 1, 0, 0, H_pango_cairo_context_get_resolution);
- XG_DEFINE_PROCEDURE(pango_cairo_show_glyph_string, gxg_pango_cairo_show_glyph_string_w, 3, 0, 0, H_pango_cairo_show_glyph_string);
- XG_DEFINE_PROCEDURE(pango_cairo_show_layout_line, gxg_pango_cairo_show_layout_line_w, 2, 0, 0, H_pango_cairo_show_layout_line);
- XG_DEFINE_PROCEDURE(pango_cairo_show_layout, gxg_pango_cairo_show_layout_w, 2, 0, 0, H_pango_cairo_show_layout);
- XG_DEFINE_PROCEDURE(pango_cairo_show_error_underline, gxg_pango_cairo_show_error_underline_w, 5, 0, 0, H_pango_cairo_show_error_underline);
- XG_DEFINE_PROCEDURE(pango_cairo_glyph_string_path, gxg_pango_cairo_glyph_string_path_w, 3, 0, 0, H_pango_cairo_glyph_string_path);
- XG_DEFINE_PROCEDURE(pango_cairo_layout_line_path, gxg_pango_cairo_layout_line_path_w, 2, 0, 0, H_pango_cairo_layout_line_path);
- XG_DEFINE_PROCEDURE(pango_cairo_layout_path, gxg_pango_cairo_layout_path_w, 2, 0, 0, H_pango_cairo_layout_path);
- XG_DEFINE_PROCEDURE(pango_cairo_error_underline_path, gxg_pango_cairo_error_underline_path_w, 5, 0, 0, H_pango_cairo_error_underline_path);
- XG_DEFINE_PROCEDURE(gdk_cairo_set_source_color, gxg_gdk_cairo_set_source_color_w, 2, 0, 0, H_gdk_cairo_set_source_color);
- XG_DEFINE_PROCEDURE(gdk_cairo_set_source_pixbuf, gxg_gdk_cairo_set_source_pixbuf_w, 4, 0, 0, H_gdk_cairo_set_source_pixbuf);
- XG_DEFINE_PROCEDURE(gdk_cairo_rectangle, gxg_gdk_cairo_rectangle_w, 2, 0, 0, H_gdk_cairo_rectangle);
- XG_DEFINE_PROCEDURE(gdk_color_to_string, gxg_gdk_color_to_string_w, 1, 0, 0, H_gdk_color_to_string);
- XG_DEFINE_PROCEDURE(gdk_event_request_motions, gxg_gdk_event_request_motions_w, 1, 0, 0, H_gdk_event_request_motions);
- XG_DEFINE_PROCEDURE(gdk_notify_startup_complete_with_id, gxg_gdk_notify_startup_complete_with_id_w, 1, 0, 0, H_gdk_notify_startup_complete_with_id);
- XG_DEFINE_PROCEDURE(gdk_threads_add_idle_full, gxg_gdk_threads_add_idle_full_w, 4, 0, 0, H_gdk_threads_add_idle_full);
- XG_DEFINE_PROCEDURE(gdk_threads_add_idle, gxg_gdk_threads_add_idle_w, 1, 1, 0, H_gdk_threads_add_idle);
- XG_DEFINE_PROCEDURE(gdk_threads_add_timeout_full, gxg_gdk_threads_add_timeout_full_w, 5, 0, 0, H_gdk_threads_add_timeout_full);
- XG_DEFINE_PROCEDURE(gdk_threads_add_timeout, gxg_gdk_threads_add_timeout_w, 2, 1, 0, H_gdk_threads_add_timeout);
- XG_DEFINE_PROCEDURE(gdk_window_set_startup_id, gxg_gdk_window_set_startup_id_w, 2, 0, 0, H_gdk_window_set_startup_id);
- XG_DEFINE_PROCEDURE(gdk_window_beep, gxg_gdk_window_beep_w, 1, 0, 0, H_gdk_window_beep);
- XG_DEFINE_PROCEDURE(gdk_window_set_opacity, gxg_gdk_window_set_opacity_w, 2, 0, 0, H_gdk_window_set_opacity);
- XG_DEFINE_PROCEDURE(gtk_action_create_menu, gxg_gtk_action_create_menu_w, 1, 0, 0, H_gtk_action_create_menu);
- XG_DEFINE_PROCEDURE(gtk_binding_entry_skip, gxg_gtk_binding_entry_skip_w, 3, 0, 0, H_gtk_binding_entry_skip);
- XG_DEFINE_PROCEDURE(gtk_cell_layout_get_cells, gxg_gtk_cell_layout_get_cells_w, 1, 0, 0, H_gtk_cell_layout_get_cells);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_set_inline_selection, gxg_gtk_entry_completion_set_inline_selection_w, 2, 0, 0, H_gtk_entry_completion_set_inline_selection);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_inline_selection, gxg_gtk_entry_completion_get_inline_selection_w, 1, 0, 0, H_gtk_entry_completion_get_inline_selection);
- XG_DEFINE_PROCEDURE(gtk_entry_completion_get_completion_prefix, gxg_gtk_entry_completion_get_completion_prefix_w, 1, 0, 0, H_gtk_entry_completion_get_completion_prefix);
- XG_DEFINE_PROCEDURE(gtk_entry_set_cursor_hadjustment, gxg_gtk_entry_set_cursor_hadjustment_w, 2, 0, 0, H_gtk_entry_set_cursor_hadjustment);
- XG_DEFINE_PROCEDURE(gtk_entry_get_cursor_hadjustment, gxg_gtk_entry_get_cursor_hadjustment_w, 1, 0, 0, H_gtk_entry_get_cursor_hadjustment);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_list_contexts, gxg_gtk_icon_theme_list_contexts_w, 1, 0, 0, H_gtk_icon_theme_list_contexts);
- XG_DEFINE_PROCEDURE(gtk_page_setup_new_from_file, gxg_gtk_page_setup_new_from_file_w, 1, 1, 0, H_gtk_page_setup_new_from_file);
- XG_DEFINE_PROCEDURE(gtk_page_setup_to_file, gxg_gtk_page_setup_to_file_w, 2, 1, 0, H_gtk_page_setup_to_file);
- XG_DEFINE_PROCEDURE(gtk_print_settings_new_from_file, gxg_gtk_print_settings_new_from_file_w, 1, 1, 0, H_gtk_print_settings_new_from_file);
- XG_DEFINE_PROCEDURE(gtk_print_settings_to_file, gxg_gtk_print_settings_to_file_w, 2, 1, 0, H_gtk_print_settings_to_file);
- XG_DEFINE_PROCEDURE(gtk_range_set_show_fill_level, gxg_gtk_range_set_show_fill_level_w, 2, 0, 0, H_gtk_range_set_show_fill_level);
- XG_DEFINE_PROCEDURE(gtk_range_get_show_fill_level, gxg_gtk_range_get_show_fill_level_w, 1, 0, 0, H_gtk_range_get_show_fill_level);
- XG_DEFINE_PROCEDURE(gtk_range_set_restrict_to_fill_level, gxg_gtk_range_set_restrict_to_fill_level_w, 2, 0, 0, H_gtk_range_set_restrict_to_fill_level);
- XG_DEFINE_PROCEDURE(gtk_range_get_restrict_to_fill_level, gxg_gtk_range_get_restrict_to_fill_level_w, 1, 0, 0, H_gtk_range_get_restrict_to_fill_level);
- XG_DEFINE_PROCEDURE(gtk_range_set_fill_level, gxg_gtk_range_set_fill_level_w, 2, 0, 0, H_gtk_range_set_fill_level);
- XG_DEFINE_PROCEDURE(gtk_range_get_fill_level, gxg_gtk_range_get_fill_level_w, 1, 0, 0, H_gtk_range_get_fill_level);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_screen, gxg_gtk_status_icon_set_screen_w, 2, 0, 0, H_gtk_status_icon_set_screen);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_screen, gxg_gtk_status_icon_get_screen_w, 1, 0, 0, H_gtk_status_icon_get_screen);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_show_expanders, gxg_gtk_tree_view_set_show_expanders_w, 2, 0, 0, H_gtk_tree_view_set_show_expanders);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_show_expanders, gxg_gtk_tree_view_get_show_expanders_w, 1, 0, 0, H_gtk_tree_view_get_show_expanders);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_level_indentation, gxg_gtk_tree_view_set_level_indentation_w, 2, 0, 0, H_gtk_tree_view_set_level_indentation);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_level_indentation, gxg_gtk_tree_view_get_level_indentation_w, 1, 0, 0, H_gtk_tree_view_get_level_indentation);
- XG_DEFINE_PROCEDURE(gtk_widget_keynav_failed, gxg_gtk_widget_keynav_failed_w, 2, 0, 0, H_gtk_widget_keynav_failed);
- XG_DEFINE_PROCEDURE(gtk_widget_error_bell, gxg_gtk_widget_error_bell_w, 1, 0, 0, H_gtk_widget_error_bell);
- XG_DEFINE_PROCEDURE(gtk_widget_set_tooltip_window, gxg_gtk_widget_set_tooltip_window_w, 2, 0, 0, H_gtk_widget_set_tooltip_window);
- XG_DEFINE_PROCEDURE(gtk_widget_get_tooltip_window, gxg_gtk_widget_get_tooltip_window_w, 1, 0, 0, H_gtk_widget_get_tooltip_window);
- XG_DEFINE_PROCEDURE(gtk_widget_trigger_tooltip_query, gxg_gtk_widget_trigger_tooltip_query_w, 1, 0, 0, H_gtk_widget_trigger_tooltip_query);
- XG_DEFINE_PROCEDURE(gtk_window_set_startup_id, gxg_gtk_window_set_startup_id_w, 2, 0, 0, H_gtk_window_set_startup_id);
- XG_DEFINE_PROCEDURE(gtk_window_set_opacity, gxg_gtk_window_set_opacity_w, 2, 0, 0, H_gtk_window_set_opacity);
- XG_DEFINE_PROCEDURE(gtk_window_get_opacity, gxg_gtk_window_get_opacity_w, 1, 0, 0, H_gtk_window_get_opacity);
- XG_DEFINE_PROCEDURE(gdk_display_supports_composite, gxg_gdk_display_supports_composite_w, 1, 0, 0, H_gdk_display_supports_composite);
- XG_DEFINE_PROCEDURE(gdk_window_set_composited, gxg_gdk_window_set_composited_w, 2, 0, 0, H_gdk_window_set_composited);
- XG_DEFINE_PROCEDURE(gtk_text_buffer_add_mark, gxg_gtk_text_buffer_add_mark_w, 3, 0, 0, H_gtk_text_buffer_add_mark);
- XG_DEFINE_PROCEDURE(gtk_text_mark_new, gxg_gtk_text_mark_new_w, 2, 0, 0, H_gtk_text_mark_new);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_tree_view, gxg_gtk_tree_view_column_get_tree_view_w, 1, 0, 0, H_gtk_tree_view_column_get_tree_view);
- XG_DEFINE_PROCEDURE(gtk_tooltip_set_text, gxg_gtk_tooltip_set_text_w, 2, 0, 0, H_gtk_tooltip_set_text);
- XG_DEFINE_PROCEDURE(gtk_tree_view_convert_widget_to_tree_coords, gxg_gtk_tree_view_convert_widget_to_tree_coords_w, 3, 2, 0, H_gtk_tree_view_convert_widget_to_tree_coords);
- XG_DEFINE_PROCEDURE(gtk_tree_view_convert_tree_to_widget_coords, gxg_gtk_tree_view_convert_tree_to_widget_coords_w, 3, 2, 0, H_gtk_tree_view_convert_tree_to_widget_coords);
- XG_DEFINE_PROCEDURE(gtk_tree_view_convert_widget_to_bin_window_coords, gxg_gtk_tree_view_convert_widget_to_bin_window_coords_w, 3, 2, 0, H_gtk_tree_view_convert_widget_to_bin_window_coords);
- XG_DEFINE_PROCEDURE(gtk_tree_view_convert_bin_window_to_widget_coords, gxg_gtk_tree_view_convert_bin_window_to_widget_coords_w, 3, 2, 0, H_gtk_tree_view_convert_bin_window_to_widget_coords);
- XG_DEFINE_PROCEDURE(gtk_tree_view_convert_tree_to_bin_window_coords, gxg_gtk_tree_view_convert_tree_to_bin_window_coords_w, 3, 2, 0, H_gtk_tree_view_convert_tree_to_bin_window_coords);
- XG_DEFINE_PROCEDURE(gtk_tree_view_convert_bin_window_to_tree_coords, gxg_gtk_tree_view_convert_bin_window_to_tree_coords_w, 3, 2, 0, H_gtk_tree_view_convert_bin_window_to_tree_coords);
- XG_DEFINE_PROCEDURE(gtk_widget_set_tooltip_text, gxg_gtk_widget_set_tooltip_text_w, 2, 0, 0, H_gtk_widget_set_tooltip_text);
- XG_DEFINE_PROCEDURE(gtk_widget_get_tooltip_text, gxg_gtk_widget_get_tooltip_text_w, 1, 0, 0, H_gtk_widget_get_tooltip_text);
- XG_DEFINE_PROCEDURE(gtk_widget_set_tooltip_markup, gxg_gtk_widget_set_tooltip_markup_w, 2, 0, 0, H_gtk_widget_set_tooltip_markup);
- XG_DEFINE_PROCEDURE(gtk_widget_get_tooltip_markup, gxg_gtk_widget_get_tooltip_markup_w, 1, 0, 0, H_gtk_widget_get_tooltip_markup);
- XG_DEFINE_PROCEDURE(gtk_tree_view_is_rubber_banding_active, gxg_gtk_tree_view_is_rubber_banding_active_w, 1, 0, 0, H_gtk_tree_view_is_rubber_banding_active);
- XG_DEFINE_PROCEDURE(gtk_icon_view_convert_widget_to_bin_window_coords, gxg_gtk_icon_view_convert_widget_to_bin_window_coords_w, 3, 2, 0, H_gtk_icon_view_convert_widget_to_bin_window_coords);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_tooltip_item, gxg_gtk_icon_view_set_tooltip_item_w, 3, 0, 0, H_gtk_icon_view_set_tooltip_item);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_tooltip_cell, gxg_gtk_icon_view_set_tooltip_cell_w, 4, 0, 0, H_gtk_icon_view_set_tooltip_cell);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_tooltip_context, gxg_gtk_icon_view_get_tooltip_context_w, 3, 4, 0, H_gtk_icon_view_get_tooltip_context);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_tooltip_column, gxg_gtk_icon_view_set_tooltip_column_w, 2, 0, 0, H_gtk_icon_view_set_tooltip_column);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_tooltip_column, gxg_gtk_icon_view_get_tooltip_column_w, 1, 0, 0, H_gtk_icon_view_get_tooltip_column);
- XG_DEFINE_PROCEDURE(gtk_menu_tool_button_set_arrow_tooltip_text, gxg_gtk_menu_tool_button_set_arrow_tooltip_text_w, 2, 0, 0, H_gtk_menu_tool_button_set_arrow_tooltip_text);
- XG_DEFINE_PROCEDURE(gtk_menu_tool_button_set_arrow_tooltip_markup, gxg_gtk_menu_tool_button_set_arrow_tooltip_markup_w, 2, 0, 0, H_gtk_menu_tool_button_set_arrow_tooltip_markup);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_tooltip_text, gxg_gtk_tool_item_set_tooltip_text_w, 2, 0, 0, H_gtk_tool_item_set_tooltip_text);
- XG_DEFINE_PROCEDURE(gtk_tool_item_set_tooltip_markup, gxg_gtk_tool_item_set_tooltip_markup_w, 2, 0, 0, H_gtk_tool_item_set_tooltip_markup);
- XG_DEFINE_PROCEDURE(gtk_tooltip_set_tip_area, gxg_gtk_tooltip_set_tip_area_w, 2, 0, 0, H_gtk_tooltip_set_tip_area);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_tooltip_row, gxg_gtk_tree_view_set_tooltip_row_w, 3, 0, 0, H_gtk_tree_view_set_tooltip_row);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_tooltip_cell, gxg_gtk_tree_view_set_tooltip_cell_w, 5, 0, 0, H_gtk_tree_view_set_tooltip_cell);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_tooltip_context, gxg_gtk_tree_view_get_tooltip_context_w, 3, 4, 0, H_gtk_tree_view_get_tooltip_context);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_tooltip_column, gxg_gtk_tree_view_set_tooltip_column_w, 2, 0, 0, H_gtk_tree_view_set_tooltip_column);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_tooltip_column, gxg_gtk_tree_view_get_tooltip_column_w, 1, 0, 0, H_gtk_tree_view_get_tooltip_column);
- XG_DEFINE_PROCEDURE(gtk_widget_set_has_tooltip, gxg_gtk_widget_set_has_tooltip_w, 2, 0, 0, H_gtk_widget_set_has_tooltip);
- XG_DEFINE_PROCEDURE(gtk_widget_get_has_tooltip, gxg_gtk_widget_get_has_tooltip_w, 1, 0, 0, H_gtk_widget_get_has_tooltip);
-#if HAVE_GTK_TEST_WIDGET_CLICK
- XG_DEFINE_PROCEDURE(gtk_calendar_set_detail_func, gxg_gtk_calendar_set_detail_func_w, 4, 0, 0, H_gtk_calendar_set_detail_func);
- XG_DEFINE_PROCEDURE(gtk_calendar_set_detail_width_chars, gxg_gtk_calendar_set_detail_width_chars_w, 2, 0, 0, H_gtk_calendar_set_detail_width_chars);
- XG_DEFINE_PROCEDURE(gtk_calendar_set_detail_height_rows, gxg_gtk_calendar_set_detail_height_rows_w, 2, 0, 0, H_gtk_calendar_set_detail_height_rows);
- XG_DEFINE_PROCEDURE(gtk_calendar_get_detail_width_chars, gxg_gtk_calendar_get_detail_width_chars_w, 1, 0, 0, H_gtk_calendar_get_detail_width_chars);
- XG_DEFINE_PROCEDURE(gtk_calendar_get_detail_height_rows, gxg_gtk_calendar_get_detail_height_rows_w, 1, 0, 0, H_gtk_calendar_get_detail_height_rows);
- XG_DEFINE_PROCEDURE(gdk_screen_get_monitor_width_mm, gxg_gdk_screen_get_monitor_width_mm_w, 2, 0, 0, H_gdk_screen_get_monitor_width_mm);
- XG_DEFINE_PROCEDURE(gdk_screen_get_monitor_height_mm, gxg_gdk_screen_get_monitor_height_mm_w, 2, 0, 0, H_gdk_screen_get_monitor_height_mm);
- XG_DEFINE_PROCEDURE(gdk_screen_get_monitor_plug_name, gxg_gdk_screen_get_monitor_plug_name_w, 2, 0, 0, H_gdk_screen_get_monitor_plug_name);
- XG_DEFINE_PROCEDURE(gtk_tooltip_set_icon_from_icon_name, gxg_gtk_tooltip_set_icon_from_icon_name_w, 3, 0, 0, H_gtk_tooltip_set_icon_from_icon_name);
+
+#if GTK_CHECK_VERSION(3, 20, 0)
+ Xg_define_procedure(gdk_gl_context_is_legacy, gxg_gdk_gl_context_is_legacy_w, 1, 0, 0, H_gdk_gl_context_is_legacy, pl_bu);
+ Xg_define_procedure(gdk_rectangle_equal, gxg_gdk_rectangle_equal_w, 1, 0, 0, H_gdk_rectangle_equal, pl_bu);
+ Xg_define_procedure(gtk_application_window_set_help_overlay, gxg_gtk_application_window_set_help_overlay_w, 2, 0, 0, H_gtk_application_window_set_help_overlay, pl_tu);
+ Xg_define_procedure(gtk_settings_reset_property, gxg_gtk_settings_reset_property_w, 2, 0, 0, H_gtk_settings_reset_property, pl_tus);
+ Xg_define_procedure(gtk_text_tag_changed, gxg_gtk_text_tag_changed_w, 2, 0, 0, H_gtk_text_tag_changed, pl_tub);
+ Xg_define_procedure(gtk_widget_path_iter_get_object_name, gxg_gtk_widget_path_iter_get_object_name_w, 2, 0, 0, H_gtk_widget_path_iter_get_object_name, pl_sui);
+ Xg_define_procedure(gtk_widget_path_iter_set_object_name, gxg_gtk_widget_path_iter_set_object_name_w, 3, 0, 0, H_gtk_widget_path_iter_set_object_name, pl_tuis);
+ Xg_define_procedure(gtk_widget_queue_allocate, gxg_gtk_widget_queue_allocate_w, 1, 0, 0, H_gtk_widget_queue_allocate, pl_tu);
+ Xg_define_procedure(gtk_widget_set_focus_on_click, gxg_gtk_widget_set_focus_on_click_w, 2, 0, 0, H_gtk_widget_set_focus_on_click, pl_tub);
+ Xg_define_procedure(gtk_widget_get_focus_on_click, gxg_gtk_widget_get_focus_on_click_w, 1, 0, 0, H_gtk_widget_get_focus_on_click, pl_bu);
+ Xg_define_procedure(gtk_widget_get_allocated_size, gxg_gtk_widget_get_allocated_size_w, 1, 2, 0, H_gtk_widget_get_allocated_size, pl_tu);
#endif
-#if HAVE_GTK_ADJUSTMENT_GET_UPPER
- XG_DEFINE_PROCEDURE(gtk_accel_group_get_is_locked, gxg_gtk_accel_group_get_is_locked_w, 1, 0, 0, H_gtk_accel_group_get_is_locked);
- XG_DEFINE_PROCEDURE(gtk_color_selection_dialog_get_color_selection, gxg_gtk_color_selection_dialog_get_color_selection_w, 1, 0, 0, H_gtk_color_selection_dialog_get_color_selection);
- XG_DEFINE_PROCEDURE(gtk_container_get_focus_child, gxg_gtk_container_get_focus_child_w, 1, 0, 0, H_gtk_container_get_focus_child);
- XG_DEFINE_PROCEDURE(gtk_dialog_get_action_area, gxg_gtk_dialog_get_action_area_w, 1, 0, 0, H_gtk_dialog_get_action_area);
- XG_DEFINE_PROCEDURE(gtk_dialog_get_content_area, gxg_gtk_dialog_get_content_area_w, 1, 0, 0, H_gtk_dialog_get_content_area);
- XG_DEFINE_PROCEDURE(gtk_entry_set_overwrite_mode, gxg_gtk_entry_set_overwrite_mode_w, 2, 0, 0, H_gtk_entry_set_overwrite_mode);
- XG_DEFINE_PROCEDURE(gtk_entry_get_overwrite_mode, gxg_gtk_entry_get_overwrite_mode_w, 1, 0, 0, H_gtk_entry_get_overwrite_mode);
- XG_DEFINE_PROCEDURE(gtk_entry_get_text_length, gxg_gtk_entry_get_text_length_w, 1, 0, 0, H_gtk_entry_get_text_length);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_family_list, gxg_gtk_font_selection_get_family_list_w, 1, 0, 0, H_gtk_font_selection_get_family_list);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_face_list, gxg_gtk_font_selection_get_face_list_w, 1, 0, 0, H_gtk_font_selection_get_face_list);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_size_entry, gxg_gtk_font_selection_get_size_entry_w, 1, 0, 0, H_gtk_font_selection_get_size_entry);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_size_list, gxg_gtk_font_selection_get_size_list_w, 1, 0, 0, H_gtk_font_selection_get_size_list);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_preview_entry, gxg_gtk_font_selection_get_preview_entry_w, 1, 0, 0, H_gtk_font_selection_get_preview_entry);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_family, gxg_gtk_font_selection_get_family_w, 1, 0, 0, H_gtk_font_selection_get_family);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_face, gxg_gtk_font_selection_get_face_w, 1, 0, 0, H_gtk_font_selection_get_face);
- XG_DEFINE_PROCEDURE(gtk_font_selection_get_size, gxg_gtk_font_selection_get_size_w, 1, 0, 0, H_gtk_font_selection_get_size);
- XG_DEFINE_PROCEDURE(gtk_font_selection_dialog_get_ok_button, gxg_gtk_font_selection_dialog_get_ok_button_w, 1, 0, 0, H_gtk_font_selection_dialog_get_ok_button);
- XG_DEFINE_PROCEDURE(gtk_font_selection_dialog_get_cancel_button, gxg_gtk_font_selection_dialog_get_cancel_button_w, 1, 0, 0, H_gtk_font_selection_dialog_get_cancel_button);
- XG_DEFINE_PROCEDURE(gtk_handle_box_get_child_detached, gxg_gtk_handle_box_get_child_detached_w, 1, 0, 0, H_gtk_handle_box_get_child_detached);
- XG_DEFINE_PROCEDURE(gtk_layout_get_bin_window, gxg_gtk_layout_get_bin_window_w, 1, 0, 0, H_gtk_layout_get_bin_window);
- XG_DEFINE_PROCEDURE(gtk_menu_get_accel_path, gxg_gtk_menu_get_accel_path_w, 1, 0, 0, H_gtk_menu_get_accel_path);
- XG_DEFINE_PROCEDURE(gtk_menu_get_monitor, gxg_gtk_menu_get_monitor_w, 1, 0, 0, H_gtk_menu_get_monitor);
- XG_DEFINE_PROCEDURE(gtk_menu_item_get_accel_path, gxg_gtk_menu_item_get_accel_path_w, 1, 0, 0, H_gtk_menu_item_get_accel_path);
- XG_DEFINE_PROCEDURE(gtk_scale_button_get_plus_button, gxg_gtk_scale_button_get_plus_button_w, 1, 0, 0, H_gtk_scale_button_get_plus_button);
- XG_DEFINE_PROCEDURE(gtk_scale_button_get_minus_button, gxg_gtk_scale_button_get_minus_button_w, 1, 0, 0, H_gtk_scale_button_get_minus_button);
- XG_DEFINE_PROCEDURE(gtk_scale_button_get_popup, gxg_gtk_scale_button_get_popup_w, 1, 0, 0, H_gtk_scale_button_get_popup);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_target, gxg_gtk_selection_data_get_target_w, 1, 0, 0, H_gtk_selection_data_get_target);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_data_type, gxg_gtk_selection_data_get_data_type_w, 1, 0, 0, H_gtk_selection_data_get_data_type);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_format, gxg_gtk_selection_data_get_format_w, 1, 0, 0, H_gtk_selection_data_get_format);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_display, gxg_gtk_selection_data_get_display_w, 1, 0, 0, H_gtk_selection_data_get_display);
- XG_DEFINE_PROCEDURE(gtk_widget_get_window, gxg_gtk_widget_get_window_w, 1, 0, 0, H_gtk_widget_get_window);
- XG_DEFINE_PROCEDURE(gtk_accel_group_get_modifier_mask, gxg_gtk_accel_group_get_modifier_mask_w, 1, 0, 0, H_gtk_accel_group_get_modifier_mask);
- XG_DEFINE_PROCEDURE(gdk_threads_add_timeout_seconds_full, gxg_gdk_threads_add_timeout_seconds_full_w, 5, 0, 0, H_gdk_threads_add_timeout_seconds_full);
- XG_DEFINE_PROCEDURE(gdk_threads_add_timeout_seconds, gxg_gdk_threads_add_timeout_seconds_w, 2, 1, 0, H_gdk_threads_add_timeout_seconds);
- XG_DEFINE_PROCEDURE(gtk_adjustment_get_lower, gxg_gtk_adjustment_get_lower_w, 1, 0, 0, H_gtk_adjustment_get_lower);
- XG_DEFINE_PROCEDURE(gtk_adjustment_set_lower, gxg_gtk_adjustment_set_lower_w, 2, 0, 0, H_gtk_adjustment_set_lower);
- XG_DEFINE_PROCEDURE(gtk_adjustment_get_upper, gxg_gtk_adjustment_get_upper_w, 1, 0, 0, H_gtk_adjustment_get_upper);
- XG_DEFINE_PROCEDURE(gtk_adjustment_set_upper, gxg_gtk_adjustment_set_upper_w, 2, 0, 0, H_gtk_adjustment_set_upper);
- XG_DEFINE_PROCEDURE(gtk_adjustment_get_step_increment, gxg_gtk_adjustment_get_step_increment_w, 1, 0, 0, H_gtk_adjustment_get_step_increment);
- XG_DEFINE_PROCEDURE(gtk_adjustment_set_step_increment, gxg_gtk_adjustment_set_step_increment_w, 2, 0, 0, H_gtk_adjustment_set_step_increment);
- XG_DEFINE_PROCEDURE(gtk_adjustment_get_page_increment, gxg_gtk_adjustment_get_page_increment_w, 1, 0, 0, H_gtk_adjustment_get_page_increment);
- XG_DEFINE_PROCEDURE(gtk_adjustment_set_page_increment, gxg_gtk_adjustment_set_page_increment_w, 2, 0, 0, H_gtk_adjustment_set_page_increment);
- XG_DEFINE_PROCEDURE(gtk_adjustment_get_page_size, gxg_gtk_adjustment_get_page_size_w, 1, 0, 0, H_gtk_adjustment_get_page_size);
- XG_DEFINE_PROCEDURE(gtk_adjustment_set_page_size, gxg_gtk_adjustment_set_page_size_w, 2, 0, 0, H_gtk_adjustment_set_page_size);
- XG_DEFINE_PROCEDURE(gtk_adjustment_configure, gxg_gtk_adjustment_configure_w, 7, 0, 0, H_gtk_adjustment_configure);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_button_sensitivity, gxg_gtk_combo_box_set_button_sensitivity_w, 2, 0, 0, H_gtk_combo_box_set_button_sensitivity);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_button_sensitivity, gxg_gtk_combo_box_get_button_sensitivity_w, 1, 0, 0, H_gtk_combo_box_get_button_sensitivity);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_file, gxg_gtk_file_chooser_get_file_w, 1, 0, 0, H_gtk_file_chooser_get_file);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_file, gxg_gtk_file_chooser_set_file_w, 2, 1, 0, H_gtk_file_chooser_set_file);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_select_file, gxg_gtk_file_chooser_select_file_w, 2, 1, 0, H_gtk_file_chooser_select_file);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_unselect_file, gxg_gtk_file_chooser_unselect_file_w, 2, 0, 0, H_gtk_file_chooser_unselect_file);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_files, gxg_gtk_file_chooser_get_files_w, 1, 0, 0, H_gtk_file_chooser_get_files);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_current_folder_file, gxg_gtk_file_chooser_set_current_folder_file_w, 2, 1, 0, H_gtk_file_chooser_set_current_folder_file);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_current_folder_file, gxg_gtk_file_chooser_get_current_folder_file_w, 1, 0, 0, H_gtk_file_chooser_get_current_folder_file);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_preview_file, gxg_gtk_file_chooser_get_preview_file_w, 1, 0, 0, H_gtk_file_chooser_get_preview_file);
- XG_DEFINE_PROCEDURE(gtk_window_get_default_widget, gxg_gtk_window_get_default_widget_w, 1, 0, 0, H_gtk_window_get_default_widget);
+ Xg_define_procedure(cairo_create, gxg_cairo_create_w, 1, 0, 0, H_cairo_create, pl_pu);
+ Xg_define_procedure(cairo_version, gxg_cairo_version_w, 0, 0, 0, H_cairo_version, pl_i);
+ Xg_define_procedure(cairo_version_string, gxg_cairo_version_string_w, 0, 0, 0, H_cairo_version_string, pl_s);
+ Xg_define_procedure(cairo_reference, gxg_cairo_reference_w, 1, 0, 0, H_cairo_reference, pl_pu);
+ Xg_define_procedure(cairo_destroy, gxg_cairo_destroy_w, 1, 0, 0, H_cairo_destroy, pl_tu);
+ Xg_define_procedure(cairo_save, gxg_cairo_save_w, 1, 0, 0, H_cairo_save, pl_tu);
+ Xg_define_procedure(cairo_restore, gxg_cairo_restore_w, 1, 0, 0, H_cairo_restore, pl_tu);
+ Xg_define_procedure(cairo_push_group, gxg_cairo_push_group_w, 1, 0, 0, H_cairo_push_group, pl_tu);
+ Xg_define_procedure(cairo_push_group_with_content, gxg_cairo_push_group_with_content_w, 2, 0, 0, H_cairo_push_group_with_content, pl_tui);
+ Xg_define_procedure(cairo_pop_group, gxg_cairo_pop_group_w, 1, 0, 0, H_cairo_pop_group, pl_pu);
+ Xg_define_procedure(cairo_pop_group_to_source, gxg_cairo_pop_group_to_source_w, 1, 0, 0, H_cairo_pop_group_to_source, pl_tu);
+ Xg_define_procedure(cairo_set_operator, gxg_cairo_set_operator_w, 2, 0, 0, H_cairo_set_operator, pl_tui);
+ Xg_define_procedure(cairo_set_source, gxg_cairo_set_source_w, 2, 0, 0, H_cairo_set_source, pl_tu);
+ Xg_define_procedure(cairo_set_source_rgb, gxg_cairo_set_source_rgb_w, 4, 0, 0, H_cairo_set_source_rgb, pl_tur);
+ Xg_define_procedure(cairo_set_source_rgba, gxg_cairo_set_source_rgba_w, 5, 0, 0, H_cairo_set_source_rgba, pl_tur);
+ Xg_define_procedure(cairo_set_source_surface, gxg_cairo_set_source_surface_w, 4, 0, 0, H_cairo_set_source_surface, pl_tuur);
+ Xg_define_procedure(cairo_set_tolerance, gxg_cairo_set_tolerance_w, 2, 0, 0, H_cairo_set_tolerance, pl_tur);
+ Xg_define_procedure(cairo_set_antialias, gxg_cairo_set_antialias_w, 2, 0, 0, H_cairo_set_antialias, pl_tui);
+ Xg_define_procedure(cairo_set_fill_rule, gxg_cairo_set_fill_rule_w, 2, 0, 0, H_cairo_set_fill_rule, pl_tui);
+ Xg_define_procedure(cairo_set_line_width, gxg_cairo_set_line_width_w, 2, 0, 0, H_cairo_set_line_width, pl_tur);
+ Xg_define_procedure(cairo_set_line_cap, gxg_cairo_set_line_cap_w, 2, 0, 0, H_cairo_set_line_cap, pl_tui);
+ Xg_define_procedure(cairo_set_line_join, gxg_cairo_set_line_join_w, 2, 0, 0, H_cairo_set_line_join, pl_tui);
+ Xg_define_procedure(cairo_set_dash, gxg_cairo_set_dash_w, 4, 0, 0, H_cairo_set_dash, pl_tuuir);
+ Xg_define_procedure(cairo_set_miter_limit, gxg_cairo_set_miter_limit_w, 2, 0, 0, H_cairo_set_miter_limit, pl_tur);
+ Xg_define_procedure(cairo_translate, gxg_cairo_translate_w, 3, 0, 0, H_cairo_translate, pl_tur);
+ Xg_define_procedure(cairo_scale, gxg_cairo_scale_w, 3, 0, 0, H_cairo_scale, pl_tur);
+ Xg_define_procedure(cairo_rotate, gxg_cairo_rotate_w, 2, 0, 0, H_cairo_rotate, pl_tur);
+ Xg_define_procedure(cairo_transform, gxg_cairo_transform_w, 2, 0, 0, H_cairo_transform, pl_tu);
+ Xg_define_procedure(cairo_set_matrix, gxg_cairo_set_matrix_w, 2, 0, 0, H_cairo_set_matrix, pl_tu);
+ Xg_define_procedure(cairo_identity_matrix, gxg_cairo_identity_matrix_w, 1, 0, 0, H_cairo_identity_matrix, pl_tu);
+ Xg_define_procedure(cairo_user_to_device, gxg_cairo_user_to_device_w, 1, 2, 0, H_cairo_user_to_device, pl_tu);
+ Xg_define_procedure(cairo_user_to_device_distance, gxg_cairo_user_to_device_distance_w, 1, 2, 0, H_cairo_user_to_device_distance, pl_tu);
+ Xg_define_procedure(cairo_device_to_user, gxg_cairo_device_to_user_w, 1, 2, 0, H_cairo_device_to_user, pl_tu);
+ Xg_define_procedure(cairo_device_to_user_distance, gxg_cairo_device_to_user_distance_w, 1, 2, 0, H_cairo_device_to_user_distance, pl_tu);
+ Xg_define_procedure(cairo_new_path, gxg_cairo_new_path_w, 1, 0, 0, H_cairo_new_path, pl_tu);
+ Xg_define_procedure(cairo_move_to, gxg_cairo_move_to_w, 3, 0, 0, H_cairo_move_to, pl_tur);
+ Xg_define_procedure(cairo_new_sub_path, gxg_cairo_new_sub_path_w, 1, 0, 0, H_cairo_new_sub_path, pl_tu);
+ Xg_define_procedure(cairo_line_to, gxg_cairo_line_to_w, 3, 0, 0, H_cairo_line_to, pl_tur);
+ Xg_define_procedure(cairo_curve_to, gxg_cairo_curve_to_w, 7, 0, 0, H_cairo_curve_to, pl_tur);
+ Xg_define_procedure(cairo_arc, gxg_cairo_arc_w, 6, 0, 0, H_cairo_arc, pl_tur);
+ Xg_define_procedure(cairo_arc_negative, gxg_cairo_arc_negative_w, 6, 0, 0, H_cairo_arc_negative, pl_tur);
+ Xg_define_procedure(cairo_rel_move_to, gxg_cairo_rel_move_to_w, 3, 0, 0, H_cairo_rel_move_to, pl_tur);
+ Xg_define_procedure(cairo_rel_line_to, gxg_cairo_rel_line_to_w, 3, 0, 0, H_cairo_rel_line_to, pl_tur);
+ Xg_define_procedure(cairo_rel_curve_to, gxg_cairo_rel_curve_to_w, 7, 0, 0, H_cairo_rel_curve_to, pl_tur);
+ Xg_define_procedure(cairo_rectangle, gxg_cairo_rectangle_w, 5, 0, 0, H_cairo_rectangle, pl_tur);
+ Xg_define_procedure(cairo_close_path, gxg_cairo_close_path_w, 1, 0, 0, H_cairo_close_path, pl_tu);
+ Xg_define_procedure(cairo_paint, gxg_cairo_paint_w, 1, 0, 0, H_cairo_paint, pl_tu);
+ Xg_define_procedure(cairo_paint_with_alpha, gxg_cairo_paint_with_alpha_w, 2, 0, 0, H_cairo_paint_with_alpha, pl_tur);
+ Xg_define_procedure(cairo_mask, gxg_cairo_mask_w, 2, 0, 0, H_cairo_mask, pl_tu);
+ Xg_define_procedure(cairo_mask_surface, gxg_cairo_mask_surface_w, 4, 0, 0, H_cairo_mask_surface, pl_tuur);
+ Xg_define_procedure(cairo_stroke, gxg_cairo_stroke_w, 1, 0, 0, H_cairo_stroke, pl_tu);
+ Xg_define_procedure(cairo_stroke_preserve, gxg_cairo_stroke_preserve_w, 1, 0, 0, H_cairo_stroke_preserve, pl_tu);
+ Xg_define_procedure(cairo_fill, gxg_cairo_fill_w, 1, 0, 0, H_cairo_fill, pl_tu);
+ Xg_define_procedure(cairo_fill_preserve, gxg_cairo_fill_preserve_w, 1, 0, 0, H_cairo_fill_preserve, pl_tu);
+ Xg_define_procedure(cairo_copy_page, gxg_cairo_copy_page_w, 1, 0, 0, H_cairo_copy_page, pl_tu);
+ Xg_define_procedure(cairo_show_page, gxg_cairo_show_page_w, 1, 0, 0, H_cairo_show_page, pl_tu);
+ Xg_define_procedure(cairo_in_stroke, gxg_cairo_in_stroke_w, 3, 0, 0, H_cairo_in_stroke, pl_bur);
+ Xg_define_procedure(cairo_in_fill, gxg_cairo_in_fill_w, 3, 0, 0, H_cairo_in_fill, pl_bur);
+ Xg_define_procedure(cairo_reset_clip, gxg_cairo_reset_clip_w, 1, 0, 0, H_cairo_reset_clip, pl_tu);
+ Xg_define_procedure(cairo_clip, gxg_cairo_clip_w, 1, 0, 0, H_cairo_clip, pl_tu);
+ Xg_define_procedure(cairo_clip_preserve, gxg_cairo_clip_preserve_w, 1, 0, 0, H_cairo_clip_preserve, pl_tu);
+ Xg_define_procedure(cairo_font_options_create, gxg_cairo_font_options_create_w, 0, 0, 0, H_cairo_font_options_create, pl_p);
+ Xg_define_procedure(cairo_font_options_copy, gxg_cairo_font_options_copy_w, 1, 0, 0, H_cairo_font_options_copy, pl_pu);
+ Xg_define_procedure(cairo_font_options_destroy, gxg_cairo_font_options_destroy_w, 1, 0, 0, H_cairo_font_options_destroy, pl_tu);
+ Xg_define_procedure(cairo_font_options_status, gxg_cairo_font_options_status_w, 1, 0, 0, H_cairo_font_options_status, pl_iu);
+ Xg_define_procedure(cairo_font_options_merge, gxg_cairo_font_options_merge_w, 2, 0, 0, H_cairo_font_options_merge, pl_tu);
+ Xg_define_procedure(cairo_font_options_equal, gxg_cairo_font_options_equal_w, 2, 0, 0, H_cairo_font_options_equal, pl_bu);
+ Xg_define_procedure(cairo_font_options_hash, gxg_cairo_font_options_hash_w, 1, 0, 0, H_cairo_font_options_hash, pl_iu);
+ Xg_define_procedure(cairo_font_options_set_antialias, gxg_cairo_font_options_set_antialias_w, 2, 0, 0, H_cairo_font_options_set_antialias, pl_tui);
+ Xg_define_procedure(cairo_font_options_get_antialias, gxg_cairo_font_options_get_antialias_w, 1, 0, 0, H_cairo_font_options_get_antialias, pl_iu);
+ Xg_define_procedure(cairo_font_options_set_subpixel_order, gxg_cairo_font_options_set_subpixel_order_w, 2, 0, 0, H_cairo_font_options_set_subpixel_order, pl_tui);
+ Xg_define_procedure(cairo_font_options_get_subpixel_order, gxg_cairo_font_options_get_subpixel_order_w, 1, 0, 0, H_cairo_font_options_get_subpixel_order, pl_iu);
+ Xg_define_procedure(cairo_font_options_set_hint_style, gxg_cairo_font_options_set_hint_style_w, 2, 0, 0, H_cairo_font_options_set_hint_style, pl_tui);
+ Xg_define_procedure(cairo_font_options_get_hint_style, gxg_cairo_font_options_get_hint_style_w, 1, 0, 0, H_cairo_font_options_get_hint_style, pl_iu);
+ Xg_define_procedure(cairo_font_options_set_hint_metrics, gxg_cairo_font_options_set_hint_metrics_w, 2, 0, 0, H_cairo_font_options_set_hint_metrics, pl_tui);
+ Xg_define_procedure(cairo_font_options_get_hint_metrics, gxg_cairo_font_options_get_hint_metrics_w, 1, 0, 0, H_cairo_font_options_get_hint_metrics, pl_iu);
+ Xg_define_procedure(cairo_select_font_face, gxg_cairo_select_font_face_w, 4, 0, 0, H_cairo_select_font_face, pl_tusi);
+ Xg_define_procedure(cairo_set_font_size, gxg_cairo_set_font_size_w, 2, 0, 0, H_cairo_set_font_size, pl_tur);
+ Xg_define_procedure(cairo_set_font_matrix, gxg_cairo_set_font_matrix_w, 2, 0, 0, H_cairo_set_font_matrix, pl_tu);
+ Xg_define_procedure(cairo_get_font_matrix, gxg_cairo_get_font_matrix_w, 2, 0, 0, H_cairo_get_font_matrix, pl_tu);
+ Xg_define_procedure(cairo_set_font_options, gxg_cairo_set_font_options_w, 2, 0, 0, H_cairo_set_font_options, pl_tu);
+ Xg_define_procedure(cairo_get_font_options, gxg_cairo_get_font_options_w, 2, 0, 0, H_cairo_get_font_options, pl_tu);
+ Xg_define_procedure(cairo_set_scaled_font, gxg_cairo_set_scaled_font_w, 2, 0, 0, H_cairo_set_scaled_font, pl_tu);
+ Xg_define_procedure(cairo_show_text, gxg_cairo_show_text_w, 2, 0, 0, H_cairo_show_text, pl_tus);
+ Xg_define_procedure(cairo_show_glyphs, gxg_cairo_show_glyphs_w, 3, 0, 0, H_cairo_show_glyphs, pl_tuui);
+ Xg_define_procedure(cairo_get_font_face, gxg_cairo_get_font_face_w, 1, 0, 0, H_cairo_get_font_face, pl_pu);
+ Xg_define_procedure(cairo_font_extents, gxg_cairo_font_extents_w, 2, 0, 0, H_cairo_font_extents, pl_tu);
+ Xg_define_procedure(cairo_set_font_face, gxg_cairo_set_font_face_w, 2, 0, 0, H_cairo_set_font_face, pl_tu);
+ Xg_define_procedure(cairo_text_extents, gxg_cairo_text_extents_w, 3, 0, 0, H_cairo_text_extents, pl_tusu);
+ Xg_define_procedure(cairo_glyph_extents, gxg_cairo_glyph_extents_w, 4, 0, 0, H_cairo_glyph_extents, pl_tuuiu);
+ Xg_define_procedure(cairo_text_path, gxg_cairo_text_path_w, 2, 0, 0, H_cairo_text_path, pl_tus);
+ Xg_define_procedure(cairo_glyph_path, gxg_cairo_glyph_path_w, 3, 0, 0, H_cairo_glyph_path, pl_tuui);
+ Xg_define_procedure(cairo_font_face_reference, gxg_cairo_font_face_reference_w, 1, 0, 0, H_cairo_font_face_reference, pl_pu);
+ Xg_define_procedure(cairo_font_face_destroy, gxg_cairo_font_face_destroy_w, 1, 0, 0, H_cairo_font_face_destroy, pl_tu);
+ Xg_define_procedure(cairo_font_face_status, gxg_cairo_font_face_status_w, 1, 0, 0, H_cairo_font_face_status, pl_iu);
+ Xg_define_procedure(cairo_font_face_get_user_data, gxg_cairo_font_face_get_user_data_w, 2, 0, 0, H_cairo_font_face_get_user_data, pl_tu);
+ Xg_define_procedure(cairo_font_face_set_user_data, gxg_cairo_font_face_set_user_data_w, 4, 0, 0, H_cairo_font_face_set_user_data, pl_iuut);
+ Xg_define_procedure(cairo_scaled_font_create, gxg_cairo_scaled_font_create_w, 4, 0, 0, H_cairo_scaled_font_create, pl_pu);
+ Xg_define_procedure(cairo_scaled_font_reference, gxg_cairo_scaled_font_reference_w, 1, 0, 0, H_cairo_scaled_font_reference, pl_pu);
+ Xg_define_procedure(cairo_scaled_font_destroy, gxg_cairo_scaled_font_destroy_w, 1, 0, 0, H_cairo_scaled_font_destroy, pl_tu);
+ Xg_define_procedure(cairo_scaled_font_status, gxg_cairo_scaled_font_status_w, 1, 0, 0, H_cairo_scaled_font_status, pl_iu);
+ Xg_define_procedure(cairo_scaled_font_extents, gxg_cairo_scaled_font_extents_w, 2, 0, 0, H_cairo_scaled_font_extents, pl_tu);
+ Xg_define_procedure(cairo_scaled_font_text_extents, gxg_cairo_scaled_font_text_extents_w, 3, 0, 0, H_cairo_scaled_font_text_extents, pl_tusu);
+ Xg_define_procedure(cairo_scaled_font_glyph_extents, gxg_cairo_scaled_font_glyph_extents_w, 4, 0, 0, H_cairo_scaled_font_glyph_extents, pl_tuuiu);
+ Xg_define_procedure(cairo_scaled_font_get_font_face, gxg_cairo_scaled_font_get_font_face_w, 1, 0, 0, H_cairo_scaled_font_get_font_face, pl_pu);
+ Xg_define_procedure(cairo_scaled_font_get_font_matrix, gxg_cairo_scaled_font_get_font_matrix_w, 2, 0, 0, H_cairo_scaled_font_get_font_matrix, pl_tu);
+ Xg_define_procedure(cairo_scaled_font_get_ctm, gxg_cairo_scaled_font_get_ctm_w, 2, 0, 0, H_cairo_scaled_font_get_ctm, pl_tu);
+ Xg_define_procedure(cairo_scaled_font_get_font_options, gxg_cairo_scaled_font_get_font_options_w, 2, 0, 0, H_cairo_scaled_font_get_font_options, pl_tu);
+ Xg_define_procedure(cairo_get_operator, gxg_cairo_get_operator_w, 1, 0, 0, H_cairo_get_operator, pl_iu);
+ Xg_define_procedure(cairo_get_source, gxg_cairo_get_source_w, 1, 0, 0, H_cairo_get_source, pl_pu);
+ Xg_define_procedure(cairo_get_tolerance, gxg_cairo_get_tolerance_w, 1, 0, 0, H_cairo_get_tolerance, pl_du);
+ Xg_define_procedure(cairo_get_antialias, gxg_cairo_get_antialias_w, 1, 0, 0, H_cairo_get_antialias, pl_iu);
+ Xg_define_procedure(cairo_get_current_point, gxg_cairo_get_current_point_w, 1, 2, 0, H_cairo_get_current_point, pl_tu);
+ Xg_define_procedure(cairo_get_fill_rule, gxg_cairo_get_fill_rule_w, 1, 0, 0, H_cairo_get_fill_rule, pl_iu);
+ Xg_define_procedure(cairo_get_line_width, gxg_cairo_get_line_width_w, 1, 0, 0, H_cairo_get_line_width, pl_du);
+ Xg_define_procedure(cairo_get_line_cap, gxg_cairo_get_line_cap_w, 1, 0, 0, H_cairo_get_line_cap, pl_iu);
+ Xg_define_procedure(cairo_get_line_join, gxg_cairo_get_line_join_w, 1, 0, 0, H_cairo_get_line_join, pl_iu);
+ Xg_define_procedure(cairo_get_miter_limit, gxg_cairo_get_miter_limit_w, 1, 0, 0, H_cairo_get_miter_limit, pl_du);
+ Xg_define_procedure(cairo_get_matrix, gxg_cairo_get_matrix_w, 2, 0, 0, H_cairo_get_matrix, pl_tu);
+ Xg_define_procedure(cairo_get_target, gxg_cairo_get_target_w, 1, 0, 0, H_cairo_get_target, pl_pu);
+ Xg_define_procedure(cairo_get_group_target, gxg_cairo_get_group_target_w, 1, 0, 0, H_cairo_get_group_target, pl_pu);
+ Xg_define_procedure(cairo_copy_path, gxg_cairo_copy_path_w, 1, 0, 0, H_cairo_copy_path, pl_pu);
+ Xg_define_procedure(cairo_copy_path_flat, gxg_cairo_copy_path_flat_w, 1, 0, 0, H_cairo_copy_path_flat, pl_pu);
+ Xg_define_procedure(cairo_append_path, gxg_cairo_append_path_w, 2, 0, 0, H_cairo_append_path, pl_tu);
+ Xg_define_procedure(cairo_path_destroy, gxg_cairo_path_destroy_w, 1, 0, 0, H_cairo_path_destroy, pl_tu);
+ Xg_define_procedure(cairo_status, gxg_cairo_status_w, 1, 0, 0, H_cairo_status, pl_iu);
+ Xg_define_procedure(cairo_status_to_string, gxg_cairo_status_to_string_w, 1, 0, 0, H_cairo_status_to_string, pl_si);
+ Xg_define_procedure(cairo_surface_create_similar, gxg_cairo_surface_create_similar_w, 4, 0, 0, H_cairo_surface_create_similar, pl_pui);
+ Xg_define_procedure(cairo_surface_reference, gxg_cairo_surface_reference_w, 1, 0, 0, H_cairo_surface_reference, pl_pu);
+ Xg_define_procedure(cairo_surface_finish, gxg_cairo_surface_finish_w, 1, 0, 0, H_cairo_surface_finish, pl_tu);
+ Xg_define_procedure(cairo_surface_destroy, gxg_cairo_surface_destroy_w, 1, 0, 0, H_cairo_surface_destroy, pl_tu);
+ Xg_define_procedure(cairo_surface_status, gxg_cairo_surface_status_w, 1, 0, 0, H_cairo_surface_status, pl_iu);
+ Xg_define_procedure(cairo_surface_get_content, gxg_cairo_surface_get_content_w, 1, 0, 0, H_cairo_surface_get_content, pl_iu);
+ Xg_define_procedure(cairo_surface_get_user_data, gxg_cairo_surface_get_user_data_w, 2, 0, 0, H_cairo_surface_get_user_data, pl_tu);
+ Xg_define_procedure(cairo_surface_set_user_data, gxg_cairo_surface_set_user_data_w, 4, 0, 0, H_cairo_surface_set_user_data, pl_iuut);
+ Xg_define_procedure(cairo_surface_get_font_options, gxg_cairo_surface_get_font_options_w, 2, 0, 0, H_cairo_surface_get_font_options, pl_tu);
+ Xg_define_procedure(cairo_surface_flush, gxg_cairo_surface_flush_w, 1, 0, 0, H_cairo_surface_flush, pl_tu);
+ Xg_define_procedure(cairo_surface_mark_dirty, gxg_cairo_surface_mark_dirty_w, 1, 0, 0, H_cairo_surface_mark_dirty, pl_tu);
+ Xg_define_procedure(cairo_surface_mark_dirty_rectangle, gxg_cairo_surface_mark_dirty_rectangle_w, 5, 0, 0, H_cairo_surface_mark_dirty_rectangle, pl_tui);
+ Xg_define_procedure(cairo_surface_set_device_offset, gxg_cairo_surface_set_device_offset_w, 3, 0, 0, H_cairo_surface_set_device_offset, pl_tur);
+ Xg_define_procedure(cairo_surface_get_device_offset, gxg_cairo_surface_get_device_offset_w, 1, 2, 0, H_cairo_surface_get_device_offset, pl_tu);
+ Xg_define_procedure(cairo_surface_set_fallback_resolution, gxg_cairo_surface_set_fallback_resolution_w, 3, 0, 0, H_cairo_surface_set_fallback_resolution, pl_tur);
+ Xg_define_procedure(cairo_image_surface_create, gxg_cairo_image_surface_create_w, 3, 0, 0, H_cairo_image_surface_create, pl_pi);
+ Xg_define_procedure(cairo_image_surface_create_for_data, gxg_cairo_image_surface_create_for_data_w, 5, 0, 0, H_cairo_image_surface_create_for_data, pl_psi);
+ Xg_define_procedure(cairo_image_surface_get_data, gxg_cairo_image_surface_get_data_w, 1, 0, 0, H_cairo_image_surface_get_data, pl_su);
+ Xg_define_procedure(cairo_image_surface_get_format, gxg_cairo_image_surface_get_format_w, 1, 0, 0, H_cairo_image_surface_get_format, pl_iu);
+ Xg_define_procedure(cairo_image_surface_get_width, gxg_cairo_image_surface_get_width_w, 1, 0, 0, H_cairo_image_surface_get_width, pl_iu);
+ Xg_define_procedure(cairo_image_surface_get_height, gxg_cairo_image_surface_get_height_w, 1, 0, 0, H_cairo_image_surface_get_height, pl_iu);
+ Xg_define_procedure(cairo_image_surface_get_stride, gxg_cairo_image_surface_get_stride_w, 1, 0, 0, H_cairo_image_surface_get_stride, pl_iu);
+ Xg_define_procedure(cairo_pattern_create_rgb, gxg_cairo_pattern_create_rgb_w, 3, 0, 0, H_cairo_pattern_create_rgb, pl_pr);
+ Xg_define_procedure(cairo_pattern_create_rgba, gxg_cairo_pattern_create_rgba_w, 4, 0, 0, H_cairo_pattern_create_rgba, pl_pr);
+ Xg_define_procedure(cairo_pattern_create_for_surface, gxg_cairo_pattern_create_for_surface_w, 1, 0, 0, H_cairo_pattern_create_for_surface, pl_pu);
+ Xg_define_procedure(cairo_pattern_create_linear, gxg_cairo_pattern_create_linear_w, 4, 0, 0, H_cairo_pattern_create_linear, pl_pr);
+ Xg_define_procedure(cairo_pattern_create_radial, gxg_cairo_pattern_create_radial_w, 6, 0, 0, H_cairo_pattern_create_radial, pl_pr);
+ Xg_define_procedure(cairo_pattern_reference, gxg_cairo_pattern_reference_w, 1, 0, 0, H_cairo_pattern_reference, pl_pu);
+ Xg_define_procedure(cairo_pattern_destroy, gxg_cairo_pattern_destroy_w, 1, 0, 0, H_cairo_pattern_destroy, pl_tu);
+ Xg_define_procedure(cairo_pattern_status, gxg_cairo_pattern_status_w, 1, 0, 0, H_cairo_pattern_status, pl_iu);
+ Xg_define_procedure(cairo_pattern_add_color_stop_rgb, gxg_cairo_pattern_add_color_stop_rgb_w, 5, 0, 0, H_cairo_pattern_add_color_stop_rgb, pl_tur);
+ Xg_define_procedure(cairo_pattern_add_color_stop_rgba, gxg_cairo_pattern_add_color_stop_rgba_w, 6, 0, 0, H_cairo_pattern_add_color_stop_rgba, pl_tur);
+ Xg_define_procedure(cairo_pattern_set_matrix, gxg_cairo_pattern_set_matrix_w, 2, 0, 0, H_cairo_pattern_set_matrix, pl_tu);
+ Xg_define_procedure(cairo_pattern_get_matrix, gxg_cairo_pattern_get_matrix_w, 2, 0, 0, H_cairo_pattern_get_matrix, pl_tu);
+ Xg_define_procedure(cairo_pattern_set_extend, gxg_cairo_pattern_set_extend_w, 2, 0, 0, H_cairo_pattern_set_extend, pl_tui);
+ Xg_define_procedure(cairo_pattern_get_extend, gxg_cairo_pattern_get_extend_w, 1, 0, 0, H_cairo_pattern_get_extend, pl_iu);
+ Xg_define_procedure(cairo_pattern_set_filter, gxg_cairo_pattern_set_filter_w, 2, 0, 0, H_cairo_pattern_set_filter, pl_tui);
+ Xg_define_procedure(cairo_pattern_get_filter, gxg_cairo_pattern_get_filter_w, 1, 0, 0, H_cairo_pattern_get_filter, pl_iu);
+ Xg_define_procedure(cairo_matrix_init, gxg_cairo_matrix_init_w, 7, 0, 0, H_cairo_matrix_init, pl_tur);
+ Xg_define_procedure(cairo_matrix_init_identity, gxg_cairo_matrix_init_identity_w, 1, 0, 0, H_cairo_matrix_init_identity, pl_tu);
+ Xg_define_procedure(cairo_matrix_init_translate, gxg_cairo_matrix_init_translate_w, 3, 0, 0, H_cairo_matrix_init_translate, pl_tur);
+ Xg_define_procedure(cairo_matrix_init_scale, gxg_cairo_matrix_init_scale_w, 3, 0, 0, H_cairo_matrix_init_scale, pl_tur);
+ Xg_define_procedure(cairo_matrix_init_rotate, gxg_cairo_matrix_init_rotate_w, 2, 0, 0, H_cairo_matrix_init_rotate, pl_tur);
+ Xg_define_procedure(cairo_matrix_translate, gxg_cairo_matrix_translate_w, 3, 0, 0, H_cairo_matrix_translate, pl_tur);
+ Xg_define_procedure(cairo_matrix_scale, gxg_cairo_matrix_scale_w, 3, 0, 0, H_cairo_matrix_scale, pl_tur);
+ Xg_define_procedure(cairo_matrix_rotate, gxg_cairo_matrix_rotate_w, 2, 0, 0, H_cairo_matrix_rotate, pl_tur);
+ Xg_define_procedure(cairo_matrix_invert, gxg_cairo_matrix_invert_w, 1, 0, 0, H_cairo_matrix_invert, pl_iu);
+ Xg_define_procedure(cairo_matrix_multiply, gxg_cairo_matrix_multiply_w, 3, 0, 0, H_cairo_matrix_multiply, pl_tu);
+ Xg_define_procedure(cairo_matrix_transform_distance, gxg_cairo_matrix_transform_distance_w, 1, 2, 0, H_cairo_matrix_transform_distance, pl_tu);
+ Xg_define_procedure(cairo_matrix_transform_point, gxg_cairo_matrix_transform_point_w, 1, 2, 0, H_cairo_matrix_transform_point, pl_tu);
+ Xg_define_procedure(cairo_get_reference_count, gxg_cairo_get_reference_count_w, 1, 0, 0, H_cairo_get_reference_count, pl_iu);
+ Xg_define_procedure(cairo_get_user_data, gxg_cairo_get_user_data_w, 2, 0, 0, H_cairo_get_user_data, pl_pu);
+ Xg_define_procedure(cairo_set_user_data, gxg_cairo_set_user_data_w, 4, 0, 0, H_cairo_set_user_data, pl_iuuut);
+ Xg_define_procedure(cairo_clip_extents, gxg_cairo_clip_extents_w, 1, 4, 0, H_cairo_clip_extents, pl_tu);
+ Xg_define_procedure(cairo_copy_clip_rectangle_list, gxg_cairo_copy_clip_rectangle_list_w, 1, 0, 0, H_cairo_copy_clip_rectangle_list, pl_pu);
+ Xg_define_procedure(cairo_rectangle_list_destroy, gxg_cairo_rectangle_list_destroy_w, 1, 0, 0, H_cairo_rectangle_list_destroy, pl_tu);
+ Xg_define_procedure(cairo_font_face_get_reference_count, gxg_cairo_font_face_get_reference_count_w, 1, 0, 0, H_cairo_font_face_get_reference_count, pl_iu);
+ Xg_define_procedure(cairo_scaled_font_get_reference_count, gxg_cairo_scaled_font_get_reference_count_w, 1, 0, 0, H_cairo_scaled_font_get_reference_count, pl_iu);
+ Xg_define_procedure(cairo_scaled_font_get_user_data, gxg_cairo_scaled_font_get_user_data_w, 2, 0, 0, H_cairo_scaled_font_get_user_data, pl_pu);
+ Xg_define_procedure(cairo_scaled_font_set_user_data, gxg_cairo_scaled_font_set_user_data_w, 4, 0, 0, H_cairo_scaled_font_set_user_data, pl_iuuut);
+ Xg_define_procedure(cairo_get_dash_count, gxg_cairo_get_dash_count_w, 1, 0, 0, H_cairo_get_dash_count, pl_iu);
+ Xg_define_procedure(cairo_get_dash, gxg_cairo_get_dash_w, 1, 2, 0, H_cairo_get_dash, pl_tu);
+ Xg_define_procedure(cairo_surface_get_reference_count, gxg_cairo_surface_get_reference_count_w, 1, 0, 0, H_cairo_surface_get_reference_count, pl_iu);
+ Xg_define_procedure(cairo_pattern_get_reference_count, gxg_cairo_pattern_get_reference_count_w, 1, 0, 0, H_cairo_pattern_get_reference_count, pl_iu);
+ Xg_define_procedure(cairo_pattern_get_user_data, gxg_cairo_pattern_get_user_data_w, 2, 0, 0, H_cairo_pattern_get_user_data, pl_pu);
+ Xg_define_procedure(cairo_pattern_set_user_data, gxg_cairo_pattern_set_user_data_w, 4, 0, 0, H_cairo_pattern_set_user_data, pl_iuuut);
+ Xg_define_procedure(cairo_pattern_get_rgba, gxg_cairo_pattern_get_rgba_w, 1, 4, 0, H_cairo_pattern_get_rgba, pl_iu);
+ Xg_define_procedure(cairo_pattern_get_surface, gxg_cairo_pattern_get_surface_w, 1, 1, 0, H_cairo_pattern_get_surface, pl_iu);
+ Xg_define_procedure(cairo_pattern_get_color_stop_rgba, gxg_cairo_pattern_get_color_stop_rgba_w, 2, 5, 0, H_cairo_pattern_get_color_stop_rgba, pl_iuiu);
+ Xg_define_procedure(cairo_pattern_get_color_stop_count, gxg_cairo_pattern_get_color_stop_count_w, 1, 1, 0, H_cairo_pattern_get_color_stop_count, pl_iu);
+ Xg_define_procedure(cairo_pattern_get_linear_points, gxg_cairo_pattern_get_linear_points_w, 1, 4, 0, H_cairo_pattern_get_linear_points, pl_iu);
+ Xg_define_procedure(cairo_pattern_get_radial_circles, gxg_cairo_pattern_get_radial_circles_w, 1, 6, 0, H_cairo_pattern_get_radial_circles, pl_iu);
+ Xg_define_procedure(cairo_get_scaled_font, gxg_cairo_get_scaled_font_w, 1, 0, 0, H_cairo_get_scaled_font, pl_pu);
+ Xg_define_procedure(cairo_path_extents, gxg_cairo_path_extents_w, 1, 4, 0, H_cairo_path_extents, pl_tu);
+ Xg_define_procedure(cairo_has_current_point, gxg_cairo_has_current_point_w, 1, 0, 0, H_cairo_has_current_point, pl_bu);
+ Xg_define_procedure(cairo_surface_copy_page, gxg_cairo_surface_copy_page_w, 1, 0, 0, H_cairo_surface_copy_page, pl_tu);
+ Xg_define_procedure(cairo_surface_show_page, gxg_cairo_surface_show_page_w, 1, 0, 0, H_cairo_surface_show_page, pl_tu);
+ Xg_define_procedure(cairo_format_stride_for_width, gxg_cairo_format_stride_for_width_w, 2, 0, 0, H_cairo_format_stride_for_width, pl_i);
+ Xg_define_procedure(cairo_image_surface_create_from_png, gxg_cairo_image_surface_create_from_png_w, 1, 0, 0, H_cairo_image_surface_create_from_png, pl_ps);
+ Xg_define_procedure(cairo_surface_write_to_png, gxg_cairo_surface_write_to_png_w, 2, 0, 0, H_cairo_surface_write_to_png, pl_ius);
+#if HAVE_CAIRO_1_8
+ Xg_define_procedure(cairo_glyph_allocate, gxg_cairo_glyph_allocate_w, 1, 0, 0, H_cairo_glyph_allocate, pl_pi);
+ Xg_define_procedure(cairo_glyph_free, gxg_cairo_glyph_free_w, 1, 0, 0, H_cairo_glyph_free, pl_tu);
+ Xg_define_procedure(cairo_text_cluster_allocate, gxg_cairo_text_cluster_allocate_w, 1, 0, 0, H_cairo_text_cluster_allocate, pl_pi);
+ Xg_define_procedure(cairo_text_cluster_free, gxg_cairo_text_cluster_free_w, 1, 0, 0, H_cairo_text_cluster_free, pl_tu);
+ Xg_define_procedure(cairo_show_text_glyphs, gxg_cairo_show_text_glyphs_w, 0, 0, 1, H_cairo_show_text_glyphs, pl_tusiuiuit);
+ Xg_define_procedure(cairo_scaled_font_text_to_glyphs, gxg_cairo_scaled_font_text_to_glyphs_w, 0, 0, 1, H_cairo_scaled_font_text_to_glyphs, pl_iurrsiu);
+ Xg_define_procedure(cairo_scaled_font_get_scale_matrix, gxg_cairo_scaled_font_get_scale_matrix_w, 2, 0, 0, H_cairo_scaled_font_get_scale_matrix, pl_tu);
+ Xg_define_procedure(cairo_toy_font_face_create, gxg_cairo_toy_font_face_create_w, 3, 0, 0, H_cairo_toy_font_face_create, pl_psi);
+ Xg_define_procedure(cairo_toy_font_face_get_family, gxg_cairo_toy_font_face_get_family_w, 1, 0, 0, H_cairo_toy_font_face_get_family, pl_su);
+ Xg_define_procedure(cairo_toy_font_face_get_slant, gxg_cairo_toy_font_face_get_slant_w, 1, 0, 0, H_cairo_toy_font_face_get_slant, pl_iu);
+ Xg_define_procedure(cairo_toy_font_face_get_weight, gxg_cairo_toy_font_face_get_weight_w, 1, 0, 0, H_cairo_toy_font_face_get_weight, pl_iu);
+ Xg_define_procedure(cairo_user_font_face_create, gxg_cairo_user_font_face_create_w, 0, 0, 0, H_cairo_user_font_face_create, pl_p);
+ Xg_define_procedure(cairo_surface_get_fallback_resolution, gxg_cairo_surface_get_fallback_resolution_w, 1, 2, 0, H_cairo_surface_get_fallback_resolution, pl_tu);
+ Xg_define_procedure(cairo_surface_has_show_text_glyphs, gxg_cairo_surface_has_show_text_glyphs_w, 1, 0, 0, H_cairo_surface_has_show_text_glyphs, pl_iu);
#endif
-#if HAVE_GTK_SCALE_ADD_MARK
- XG_DEFINE_PROCEDURE(gtk_link_button_get_visited, gxg_gtk_link_button_get_visited_w, 1, 0, 0, H_gtk_link_button_get_visited);
- XG_DEFINE_PROCEDURE(gtk_link_button_set_visited, gxg_gtk_link_button_set_visited_w, 2, 0, 0, H_gtk_link_button_set_visited);
- XG_DEFINE_PROCEDURE(gdk_keymap_get_caps_lock_state, gxg_gdk_keymap_get_caps_lock_state_w, 1, 0, 0, H_gdk_keymap_get_caps_lock_state);
- XG_DEFINE_PROCEDURE(gtk_cell_view_get_model, gxg_gtk_cell_view_get_model_w, 1, 0, 0, H_gtk_cell_view_get_model);
- XG_DEFINE_PROCEDURE(gtk_entry_unset_invisible_char, gxg_gtk_entry_unset_invisible_char_w, 1, 0, 0, H_gtk_entry_unset_invisible_char);
- XG_DEFINE_PROCEDURE(gtk_entry_set_progress_fraction, gxg_gtk_entry_set_progress_fraction_w, 2, 0, 0, H_gtk_entry_set_progress_fraction);
- XG_DEFINE_PROCEDURE(gtk_entry_get_progress_fraction, gxg_gtk_entry_get_progress_fraction_w, 1, 0, 0, H_gtk_entry_get_progress_fraction);
- XG_DEFINE_PROCEDURE(gtk_entry_set_progress_pulse_step, gxg_gtk_entry_set_progress_pulse_step_w, 2, 0, 0, H_gtk_entry_set_progress_pulse_step);
- XG_DEFINE_PROCEDURE(gtk_entry_get_progress_pulse_step, gxg_gtk_entry_get_progress_pulse_step_w, 1, 0, 0, H_gtk_entry_get_progress_pulse_step);
- XG_DEFINE_PROCEDURE(gtk_entry_progress_pulse, gxg_gtk_entry_progress_pulse_w, 1, 0, 0, H_gtk_entry_progress_pulse);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_from_pixbuf, gxg_gtk_entry_set_icon_from_pixbuf_w, 3, 0, 0, H_gtk_entry_set_icon_from_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_from_stock, gxg_gtk_entry_set_icon_from_stock_w, 3, 0, 0, H_gtk_entry_set_icon_from_stock);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_from_icon_name, gxg_gtk_entry_set_icon_from_icon_name_w, 3, 0, 0, H_gtk_entry_set_icon_from_icon_name);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_from_gicon, gxg_gtk_entry_set_icon_from_gicon_w, 3, 0, 0, H_gtk_entry_set_icon_from_gicon);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_name, gxg_gtk_entry_get_icon_name_w, 2, 0, 0, H_gtk_entry_get_icon_name);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_activatable, gxg_gtk_entry_set_icon_activatable_w, 3, 0, 0, H_gtk_entry_set_icon_activatable);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_activatable, gxg_gtk_entry_get_icon_activatable_w, 2, 0, 0, H_gtk_entry_get_icon_activatable);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_sensitive, gxg_gtk_entry_set_icon_sensitive_w, 3, 0, 0, H_gtk_entry_set_icon_sensitive);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_sensitive, gxg_gtk_entry_get_icon_sensitive_w, 2, 0, 0, H_gtk_entry_get_icon_sensitive);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_at_pos, gxg_gtk_entry_get_icon_at_pos_w, 3, 0, 0, H_gtk_entry_get_icon_at_pos);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_tooltip_text, gxg_gtk_entry_set_icon_tooltip_text_w, 3, 0, 0, H_gtk_entry_set_icon_tooltip_text);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_tooltip_markup, gxg_gtk_entry_set_icon_tooltip_markup_w, 3, 0, 0, H_gtk_entry_set_icon_tooltip_markup);
- XG_DEFINE_PROCEDURE(gtk_entry_set_icon_drag_source, gxg_gtk_entry_set_icon_drag_source_w, 4, 0, 0, H_gtk_entry_set_icon_drag_source);
- XG_DEFINE_PROCEDURE(gtk_entry_get_current_icon_drag_source, gxg_gtk_entry_get_current_icon_drag_source_w, 1, 0, 0, H_gtk_entry_get_current_icon_drag_source);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_set_use_stock, gxg_gtk_image_menu_item_set_use_stock_w, 2, 0, 0, H_gtk_image_menu_item_set_use_stock);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_get_use_stock, gxg_gtk_image_menu_item_get_use_stock_w, 1, 0, 0, H_gtk_image_menu_item_get_use_stock);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_set_accel_group, gxg_gtk_image_menu_item_set_accel_group_w, 2, 0, 0, H_gtk_image_menu_item_set_accel_group);
- XG_DEFINE_PROCEDURE(gtk_menu_item_set_label, gxg_gtk_menu_item_set_label_w, 2, 0, 0, H_gtk_menu_item_set_label);
- XG_DEFINE_PROCEDURE(gtk_menu_item_get_label, gxg_gtk_menu_item_get_label_w, 1, 0, 0, H_gtk_menu_item_get_label);
- XG_DEFINE_PROCEDURE(gtk_menu_item_set_use_underline, gxg_gtk_menu_item_set_use_underline_w, 2, 0, 0, H_gtk_menu_item_set_use_underline);
- XG_DEFINE_PROCEDURE(gtk_menu_item_get_use_underline, gxg_gtk_menu_item_get_use_underline_w, 1, 0, 0, H_gtk_menu_item_get_use_underline);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_selection, gxg_gtk_selection_data_get_selection_w, 1, 0, 0, H_gtk_selection_data_get_selection);
- XG_DEFINE_PROCEDURE(gtk_action_set_label, gxg_gtk_action_set_label_w, 2, 0, 0, H_gtk_action_set_label);
- XG_DEFINE_PROCEDURE(gtk_action_get_label, gxg_gtk_action_get_label_w, 1, 0, 0, H_gtk_action_get_label);
- XG_DEFINE_PROCEDURE(gtk_action_set_short_label, gxg_gtk_action_set_short_label_w, 2, 0, 0, H_gtk_action_set_short_label);
- XG_DEFINE_PROCEDURE(gtk_action_get_short_label, gxg_gtk_action_get_short_label_w, 1, 0, 0, H_gtk_action_get_short_label);
- XG_DEFINE_PROCEDURE(gtk_action_set_tooltip, gxg_gtk_action_set_tooltip_w, 2, 0, 0, H_gtk_action_set_tooltip);
- XG_DEFINE_PROCEDURE(gtk_action_get_tooltip, gxg_gtk_action_get_tooltip_w, 1, 0, 0, H_gtk_action_get_tooltip);
- XG_DEFINE_PROCEDURE(gtk_action_set_stock_id, gxg_gtk_action_set_stock_id_w, 2, 0, 0, H_gtk_action_set_stock_id);
- XG_DEFINE_PROCEDURE(gtk_action_get_stock_id, gxg_gtk_action_get_stock_id_w, 1, 0, 0, H_gtk_action_get_stock_id);
- XG_DEFINE_PROCEDURE(gtk_action_set_gicon, gxg_gtk_action_set_gicon_w, 2, 0, 0, H_gtk_action_set_gicon);
- XG_DEFINE_PROCEDURE(gtk_action_get_gicon, gxg_gtk_action_get_gicon_w, 1, 0, 0, H_gtk_action_get_gicon);
- XG_DEFINE_PROCEDURE(gtk_action_set_icon_name, gxg_gtk_action_set_icon_name_w, 2, 0, 0, H_gtk_action_set_icon_name);
- XG_DEFINE_PROCEDURE(gtk_action_get_icon_name, gxg_gtk_action_get_icon_name_w, 1, 0, 0, H_gtk_action_get_icon_name);
- XG_DEFINE_PROCEDURE(gtk_action_set_visible_horizontal, gxg_gtk_action_set_visible_horizontal_w, 2, 0, 0, H_gtk_action_set_visible_horizontal);
- XG_DEFINE_PROCEDURE(gtk_action_get_visible_horizontal, gxg_gtk_action_get_visible_horizontal_w, 1, 0, 0, H_gtk_action_get_visible_horizontal);
- XG_DEFINE_PROCEDURE(gtk_action_set_visible_vertical, gxg_gtk_action_set_visible_vertical_w, 2, 0, 0, H_gtk_action_set_visible_vertical);
- XG_DEFINE_PROCEDURE(gtk_action_get_visible_vertical, gxg_gtk_action_get_visible_vertical_w, 1, 0, 0, H_gtk_action_get_visible_vertical);
- XG_DEFINE_PROCEDURE(gtk_action_set_is_important, gxg_gtk_action_set_is_important_w, 2, 0, 0, H_gtk_action_set_is_important);
- XG_DEFINE_PROCEDURE(gtk_action_get_is_important, gxg_gtk_action_get_is_important_w, 1, 0, 0, H_gtk_action_get_is_important);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_tooltip_text, gxg_gtk_entry_get_icon_tooltip_text_w, 2, 0, 0, H_gtk_entry_get_icon_tooltip_text);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_tooltip_markup, gxg_gtk_entry_get_icon_tooltip_markup_w, 2, 0, 0, H_gtk_entry_get_icon_tooltip_markup);
- XG_DEFINE_PROCEDURE(gtk_scale_add_mark, gxg_gtk_scale_add_mark_w, 4, 0, 0, H_gtk_scale_add_mark);
- XG_DEFINE_PROCEDURE(gtk_scale_clear_marks, gxg_gtk_scale_clear_marks_w, 1, 0, 0, H_gtk_scale_clear_marks);
+#if HAVE_CAIRO_1_9_12 && GTK_CHECK_VERSION(3, 0, 0)
+ Xg_define_procedure(cairo_in_clip, gxg_cairo_in_clip_w, 3, 0, 0, H_cairo_in_clip, pl_iur);
+ Xg_define_procedure(cairo_device_reference, gxg_cairo_device_reference_w, 1, 0, 0, H_cairo_device_reference, pl_pu);
+ Xg_define_procedure(cairo_device_status, gxg_cairo_device_status_w, 1, 0, 0, H_cairo_device_status, pl_iu);
+ Xg_define_procedure(cairo_device_acquire, gxg_cairo_device_acquire_w, 1, 0, 0, H_cairo_device_acquire, pl_iu);
+ Xg_define_procedure(cairo_device_release, gxg_cairo_device_release_w, 1, 0, 0, H_cairo_device_release, pl_tu);
+ Xg_define_procedure(cairo_device_flush, gxg_cairo_device_flush_w, 1, 0, 0, H_cairo_device_flush, pl_tu);
+ Xg_define_procedure(cairo_device_finish, gxg_cairo_device_finish_w, 1, 0, 0, H_cairo_device_finish, pl_tu);
+ Xg_define_procedure(cairo_device_destroy, gxg_cairo_device_destroy_w, 1, 0, 0, H_cairo_device_destroy, pl_tu);
+ Xg_define_procedure(cairo_device_get_reference_count, gxg_cairo_device_get_reference_count_w, 1, 0, 0, H_cairo_device_get_reference_count, pl_iu);
+ Xg_define_procedure(cairo_device_get_user_data, gxg_cairo_device_get_user_data_w, 2, 0, 0, H_cairo_device_get_user_data, pl_pu);
+ Xg_define_procedure(cairo_device_set_user_data, gxg_cairo_device_set_user_data_w, 4, 0, 0, H_cairo_device_set_user_data, pl_iuuut);
+ Xg_define_procedure(cairo_surface_create_for_rectangle, gxg_cairo_surface_create_for_rectangle_w, 5, 0, 0, H_cairo_surface_create_for_rectangle, pl_pur);
+ Xg_define_procedure(cairo_surface_get_device, gxg_cairo_surface_get_device_w, 1, 0, 0, H_cairo_surface_get_device, pl_pu);
+ Xg_define_procedure(cairo_surface_set_mime_data, gxg_cairo_surface_set_mime_data_w, 6, 0, 0, H_cairo_surface_set_mime_data, pl_iussitu);
+ Xg_define_procedure(cairo_recording_surface_create, gxg_cairo_recording_surface_create_w, 2, 0, 0, H_cairo_recording_surface_create, pl_piu);
+ Xg_define_procedure(cairo_recording_surface_ink_extents, gxg_cairo_recording_surface_ink_extents_w, 5, 0, 0, H_cairo_recording_surface_ink_extents, pl_tu);
+ Xg_define_procedure(cairo_region_create, gxg_cairo_region_create_w, 0, 0, 0, H_cairo_region_create, pl_p);
+ Xg_define_procedure(cairo_region_create_rectangle, gxg_cairo_region_create_rectangle_w, 1, 0, 0, H_cairo_region_create_rectangle, pl_pu);
+ Xg_define_procedure(cairo_region_create_rectangles, gxg_cairo_region_create_rectangles_w, 2, 0, 0, H_cairo_region_create_rectangles, pl_pui);
+ Xg_define_procedure(cairo_region_copy, gxg_cairo_region_copy_w, 1, 0, 0, H_cairo_region_copy, pl_pu);
+ Xg_define_procedure(cairo_region_reference, gxg_cairo_region_reference_w, 1, 0, 0, H_cairo_region_reference, pl_pu);
+ Xg_define_procedure(cairo_region_destroy, gxg_cairo_region_destroy_w, 1, 0, 0, H_cairo_region_destroy, pl_tu);
+ Xg_define_procedure(cairo_region_equal, gxg_cairo_region_equal_w, 2, 0, 0, H_cairo_region_equal, pl_iu);
+ Xg_define_procedure(cairo_region_status, gxg_cairo_region_status_w, 1, 0, 0, H_cairo_region_status, pl_iu);
+ Xg_define_procedure(cairo_region_get_extents, gxg_cairo_region_get_extents_w, 2, 0, 0, H_cairo_region_get_extents, pl_tu);
+ Xg_define_procedure(cairo_region_num_rectangles, gxg_cairo_region_num_rectangles_w, 1, 0, 0, H_cairo_region_num_rectangles, pl_iu);
+ Xg_define_procedure(cairo_region_get_rectangle, gxg_cairo_region_get_rectangle_w, 3, 0, 0, H_cairo_region_get_rectangle, pl_tuiu);
+ Xg_define_procedure(cairo_region_is_empty, gxg_cairo_region_is_empty_w, 1, 0, 0, H_cairo_region_is_empty, pl_iu);
+ Xg_define_procedure(cairo_region_contains_rectangle, gxg_cairo_region_contains_rectangle_w, 2, 0, 0, H_cairo_region_contains_rectangle, pl_tu);
+ Xg_define_procedure(cairo_region_contains_point, gxg_cairo_region_contains_point_w, 3, 0, 0, H_cairo_region_contains_point, pl_iui);
+ Xg_define_procedure(cairo_region_translate, gxg_cairo_region_translate_w, 3, 0, 0, H_cairo_region_translate, pl_tui);
+ Xg_define_procedure(cairo_region_subtract, gxg_cairo_region_subtract_w, 2, 0, 0, H_cairo_region_subtract, pl_iu);
+ Xg_define_procedure(cairo_region_subtract_rectangle, gxg_cairo_region_subtract_rectangle_w, 2, 0, 0, H_cairo_region_subtract_rectangle, pl_iu);
+ Xg_define_procedure(cairo_region_intersect, gxg_cairo_region_intersect_w, 2, 0, 0, H_cairo_region_intersect, pl_iu);
+ Xg_define_procedure(cairo_region_intersect_rectangle, gxg_cairo_region_intersect_rectangle_w, 2, 0, 0, H_cairo_region_intersect_rectangle, pl_iu);
+ Xg_define_procedure(cairo_region_union, gxg_cairo_region_union_w, 2, 0, 0, H_cairo_region_union, pl_iu);
+ Xg_define_procedure(cairo_region_union_rectangle, gxg_cairo_region_union_rectangle_w, 2, 0, 0, H_cairo_region_union_rectangle, pl_iu);
+ Xg_define_procedure(cairo_region_xor, gxg_cairo_region_xor_w, 2, 0, 0, H_cairo_region_xor, pl_iu);
+ Xg_define_procedure(cairo_region_xor_rectangle, gxg_cairo_region_xor_rectangle_w, 2, 0, 0, H_cairo_region_xor_rectangle, pl_iu);
#endif
-#if HAVE_GTK_INFO_BAR_NEW
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_set_always_show_image, gxg_gtk_image_menu_item_set_always_show_image_w, 2, 0, 0, H_gtk_image_menu_item_set_always_show_image);
- XG_DEFINE_PROCEDURE(gtk_image_menu_item_get_always_show_image, gxg_gtk_image_menu_item_get_always_show_image_w, 1, 0, 0, H_gtk_image_menu_item_get_always_show_image);
- XG_DEFINE_PROCEDURE(gtk_window_get_default_icon_name, gxg_gtk_window_get_default_icon_name_w, 0, 0, 0, H_gtk_window_get_default_icon_name);
- XG_DEFINE_PROCEDURE(gtk_label_get_current_uri, gxg_gtk_label_get_current_uri_w, 1, 0, 0, H_gtk_label_get_current_uri);
- XG_DEFINE_PROCEDURE(gtk_info_bar_new, gxg_gtk_info_bar_new_w, 0, 0, 0, H_gtk_info_bar_new);
- XG_DEFINE_PROCEDURE(gtk_info_bar_get_action_area, gxg_gtk_info_bar_get_action_area_w, 1, 0, 0, H_gtk_info_bar_get_action_area);
- XG_DEFINE_PROCEDURE(gtk_info_bar_get_content_area, gxg_gtk_info_bar_get_content_area_w, 1, 0, 0, H_gtk_info_bar_get_content_area);
- XG_DEFINE_PROCEDURE(gtk_info_bar_add_action_widget, gxg_gtk_info_bar_add_action_widget_w, 3, 0, 0, H_gtk_info_bar_add_action_widget);
- XG_DEFINE_PROCEDURE(gtk_info_bar_add_button, gxg_gtk_info_bar_add_button_w, 3, 0, 0, H_gtk_info_bar_add_button);
- XG_DEFINE_PROCEDURE(gtk_info_bar_set_response_sensitive, gxg_gtk_info_bar_set_response_sensitive_w, 3, 0, 0, H_gtk_info_bar_set_response_sensitive);
- XG_DEFINE_PROCEDURE(gtk_info_bar_set_default_response, gxg_gtk_info_bar_set_default_response_w, 2, 0, 0, H_gtk_info_bar_set_default_response);
- XG_DEFINE_PROCEDURE(gtk_info_bar_response, gxg_gtk_info_bar_response_w, 2, 0, 0, H_gtk_info_bar_response);
- XG_DEFINE_PROCEDURE(gtk_info_bar_set_message_type, gxg_gtk_info_bar_set_message_type_w, 2, 0, 0, H_gtk_info_bar_set_message_type);
- XG_DEFINE_PROCEDURE(gtk_info_bar_get_message_type, gxg_gtk_info_bar_get_message_type_w, 1, 0, 0, H_gtk_info_bar_get_message_type);
+ Xg_define_procedure(GPOINTER, gxg_GPOINTER_w, 1, 0, 0, "(GPOINTER obj) casts obj to GPOINTER", NULL);
+ Xg_define_procedure(GDK_DRAG_CONTEXT, gxg_GDK_DRAG_CONTEXT_w, 1, 0, 0, "(GDK_DRAG_CONTEXT obj) casts obj to GDK_DRAG_CONTEXT", NULL);
+ Xg_define_procedure(GDK_DEVICE, gxg_GDK_DEVICE_w, 1, 0, 0, "(GDK_DEVICE obj) casts obj to GDK_DEVICE", NULL);
+ Xg_define_procedure(GDK_KEYMAP, gxg_GDK_KEYMAP_w, 1, 0, 0, "(GDK_KEYMAP obj) casts obj to GDK_KEYMAP", NULL);
+ Xg_define_procedure(GDK_VISUAL, gxg_GDK_VISUAL_w, 1, 0, 0, "(GDK_VISUAL obj) casts obj to GDK_VISUAL", NULL);
+ Xg_define_procedure(GDK_WINDOW, gxg_GDK_WINDOW_w, 1, 0, 0, "(GDK_WINDOW obj) casts obj to GDK_WINDOW", NULL);
+ Xg_define_procedure(GDK_PIXBUF, gxg_GDK_PIXBUF_w, 1, 0, 0, "(GDK_PIXBUF obj) casts obj to GDK_PIXBUF", NULL);
+ Xg_define_procedure(GDK_PIXBUF_ANIMATION, gxg_GDK_PIXBUF_ANIMATION_w, 1, 0, 0, "(GDK_PIXBUF_ANIMATION obj) casts obj to GDK_PIXBUF_ANIMATION", NULL);
+ Xg_define_procedure(GDK_PIXBUF_ANIMATION_ITER, gxg_GDK_PIXBUF_ANIMATION_ITER_w, 1, 0, 0, "(GDK_PIXBUF_ANIMATION_ITER obj) casts obj to GDK_PIXBUF_ANIMATION_ITER", NULL);
+ Xg_define_procedure(GTK_ACCEL_GROUP, gxg_GTK_ACCEL_GROUP_w, 1, 0, 0, "(GTK_ACCEL_GROUP obj) casts obj to GTK_ACCEL_GROUP", NULL);
+ Xg_define_procedure(GTK_ACCEL_LABEL, gxg_GTK_ACCEL_LABEL_w, 1, 0, 0, "(GTK_ACCEL_LABEL obj) casts obj to GTK_ACCEL_LABEL", NULL);
+ Xg_define_procedure(GTK_ACCESSIBLE, gxg_GTK_ACCESSIBLE_w, 1, 0, 0, "(GTK_ACCESSIBLE obj) casts obj to GTK_ACCESSIBLE", NULL);
+ Xg_define_procedure(GTK_ADJUSTMENT, gxg_GTK_ADJUSTMENT_w, 1, 0, 0, "(GTK_ADJUSTMENT obj) casts obj to GTK_ADJUSTMENT", NULL);
+ Xg_define_procedure(GTK_ASPECT_FRAME, gxg_GTK_ASPECT_FRAME_w, 1, 0, 0, "(GTK_ASPECT_FRAME obj) casts obj to GTK_ASPECT_FRAME", NULL);
+ Xg_define_procedure(GTK_BUTTON_BOX, gxg_GTK_BUTTON_BOX_w, 1, 0, 0, "(GTK_BUTTON_BOX obj) casts obj to GTK_BUTTON_BOX", NULL);
+ Xg_define_procedure(GTK_BIN, gxg_GTK_BIN_w, 1, 0, 0, "(GTK_BIN obj) casts obj to GTK_BIN", NULL);
+ Xg_define_procedure(GTK_BOX, gxg_GTK_BOX_w, 1, 0, 0, "(GTK_BOX obj) casts obj to GTK_BOX", NULL);
+ Xg_define_procedure(GTK_BUTTON, gxg_GTK_BUTTON_w, 1, 0, 0, "(GTK_BUTTON obj) casts obj to GTK_BUTTON", NULL);
+ Xg_define_procedure(GTK_CALENDAR, gxg_GTK_CALENDAR_w, 1, 0, 0, "(GTK_CALENDAR obj) casts obj to GTK_CALENDAR", NULL);
+ Xg_define_procedure(GTK_CELL_EDITABLE, gxg_GTK_CELL_EDITABLE_w, 1, 0, 0, "(GTK_CELL_EDITABLE obj) casts obj to GTK_CELL_EDITABLE", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER, gxg_GTK_CELL_RENDERER_w, 1, 0, 0, "(GTK_CELL_RENDERER obj) casts obj to GTK_CELL_RENDERER", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER_PIXBUF, gxg_GTK_CELL_RENDERER_PIXBUF_w, 1, 0, 0, "(GTK_CELL_RENDERER_PIXBUF obj) casts obj to GTK_CELL_RENDERER_PIXBUF", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER_TEXT, gxg_GTK_CELL_RENDERER_TEXT_w, 1, 0, 0, "(GTK_CELL_RENDERER_TEXT obj) casts obj to GTK_CELL_RENDERER_TEXT", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER_TOGGLE, gxg_GTK_CELL_RENDERER_TOGGLE_w, 1, 0, 0, "(GTK_CELL_RENDERER_TOGGLE obj) casts obj to GTK_CELL_RENDERER_TOGGLE", NULL);
+ Xg_define_procedure(GTK_CHECK_BUTTON, gxg_GTK_CHECK_BUTTON_w, 1, 0, 0, "(GTK_CHECK_BUTTON obj) casts obj to GTK_CHECK_BUTTON", NULL);
+ Xg_define_procedure(GTK_CHECK_MENU_ITEM, gxg_GTK_CHECK_MENU_ITEM_w, 1, 0, 0, "(GTK_CHECK_MENU_ITEM obj) casts obj to GTK_CHECK_MENU_ITEM", NULL);
+ Xg_define_procedure(GTK_CONTAINER, gxg_GTK_CONTAINER_w, 1, 0, 0, "(GTK_CONTAINER obj) casts obj to GTK_CONTAINER", NULL);
+ Xg_define_procedure(GTK_DIALOG, gxg_GTK_DIALOG_w, 1, 0, 0, "(GTK_DIALOG obj) casts obj to GTK_DIALOG", NULL);
+ Xg_define_procedure(GTK_DRAWING_AREA, gxg_GTK_DRAWING_AREA_w, 1, 0, 0, "(GTK_DRAWING_AREA obj) casts obj to GTK_DRAWING_AREA", NULL);
+ Xg_define_procedure(GTK_EDITABLE, gxg_GTK_EDITABLE_w, 1, 0, 0, "(GTK_EDITABLE obj) casts obj to GTK_EDITABLE", NULL);
+ Xg_define_procedure(GTK_ENTRY, gxg_GTK_ENTRY_w, 1, 0, 0, "(GTK_ENTRY obj) casts obj to GTK_ENTRY", NULL);
+ Xg_define_procedure(GTK_EVENT_BOX, gxg_GTK_EVENT_BOX_w, 1, 0, 0, "(GTK_EVENT_BOX obj) casts obj to GTK_EVENT_BOX", NULL);
+ Xg_define_procedure(GTK_FIXED, gxg_GTK_FIXED_w, 1, 0, 0, "(GTK_FIXED obj) casts obj to GTK_FIXED", NULL);
+ Xg_define_procedure(GTK_FRAME, gxg_GTK_FRAME_w, 1, 0, 0, "(GTK_FRAME obj) casts obj to GTK_FRAME", NULL);
+ Xg_define_procedure(GTK_IMAGE, gxg_GTK_IMAGE_w, 1, 0, 0, "(GTK_IMAGE obj) casts obj to GTK_IMAGE", NULL);
+ Xg_define_procedure(GTK_IM_CONTEXT, gxg_GTK_IM_CONTEXT_w, 1, 0, 0, "(GTK_IM_CONTEXT obj) casts obj to GTK_IM_CONTEXT", NULL);
+ Xg_define_procedure(GTK_IM_CONTEXT_SIMPLE, gxg_GTK_IM_CONTEXT_SIMPLE_w, 1, 0, 0, "(GTK_IM_CONTEXT_SIMPLE obj) casts obj to GTK_IM_CONTEXT_SIMPLE", NULL);
+ Xg_define_procedure(GTK_INVISIBLE, gxg_GTK_INVISIBLE_w, 1, 0, 0, "(GTK_INVISIBLE obj) casts obj to GTK_INVISIBLE", NULL);
+ Xg_define_procedure(GTK_LABEL, gxg_GTK_LABEL_w, 1, 0, 0, "(GTK_LABEL obj) casts obj to GTK_LABEL", NULL);
+ Xg_define_procedure(GTK_LAYOUT, gxg_GTK_LAYOUT_w, 1, 0, 0, "(GTK_LAYOUT obj) casts obj to GTK_LAYOUT", NULL);
+ Xg_define_procedure(GTK_LIST_STORE, gxg_GTK_LIST_STORE_w, 1, 0, 0, "(GTK_LIST_STORE obj) casts obj to GTK_LIST_STORE", NULL);
+ Xg_define_procedure(GTK_MENU_BAR, gxg_GTK_MENU_BAR_w, 1, 0, 0, "(GTK_MENU_BAR obj) casts obj to GTK_MENU_BAR", NULL);
+ Xg_define_procedure(GTK_MENU, gxg_GTK_MENU_w, 1, 0, 0, "(GTK_MENU obj) casts obj to GTK_MENU", NULL);
+ Xg_define_procedure(GTK_MENU_ITEM, gxg_GTK_MENU_ITEM_w, 1, 0, 0, "(GTK_MENU_ITEM obj) casts obj to GTK_MENU_ITEM", NULL);
+ Xg_define_procedure(GTK_MENU_SHELL, gxg_GTK_MENU_SHELL_w, 1, 0, 0, "(GTK_MENU_SHELL obj) casts obj to GTK_MENU_SHELL", NULL);
+ Xg_define_procedure(GTK_NOTEBOOK, gxg_GTK_NOTEBOOK_w, 1, 0, 0, "(GTK_NOTEBOOK obj) casts obj to GTK_NOTEBOOK", NULL);
+ Xg_define_procedure(GTK_PANED, gxg_GTK_PANED_w, 1, 0, 0, "(GTK_PANED obj) casts obj to GTK_PANED", NULL);
+ Xg_define_procedure(GTK_PROGRESS_BAR, gxg_GTK_PROGRESS_BAR_w, 1, 0, 0, "(GTK_PROGRESS_BAR obj) casts obj to GTK_PROGRESS_BAR", NULL);
+ Xg_define_procedure(GTK_RADIO_BUTTON, gxg_GTK_RADIO_BUTTON_w, 1, 0, 0, "(GTK_RADIO_BUTTON obj) casts obj to GTK_RADIO_BUTTON", NULL);
+ Xg_define_procedure(GTK_RADIO_MENU_ITEM, gxg_GTK_RADIO_MENU_ITEM_w, 1, 0, 0, "(GTK_RADIO_MENU_ITEM obj) casts obj to GTK_RADIO_MENU_ITEM", NULL);
+ Xg_define_procedure(GTK_RANGE, gxg_GTK_RANGE_w, 1, 0, 0, "(GTK_RANGE obj) casts obj to GTK_RANGE", NULL);
+ Xg_define_procedure(GTK_SCALE, gxg_GTK_SCALE_w, 1, 0, 0, "(GTK_SCALE obj) casts obj to GTK_SCALE", NULL);
+ Xg_define_procedure(GTK_SCROLLBAR, gxg_GTK_SCROLLBAR_w, 1, 0, 0, "(GTK_SCROLLBAR obj) casts obj to GTK_SCROLLBAR", NULL);
+ Xg_define_procedure(GTK_SCROLLED_WINDOW, gxg_GTK_SCROLLED_WINDOW_w, 1, 0, 0, "(GTK_SCROLLED_WINDOW obj) casts obj to GTK_SCROLLED_WINDOW", NULL);
+ Xg_define_procedure(GTK_SEPARATOR, gxg_GTK_SEPARATOR_w, 1, 0, 0, "(GTK_SEPARATOR obj) casts obj to GTK_SEPARATOR", NULL);
+ Xg_define_procedure(GTK_SEPARATOR_MENU_ITEM, gxg_GTK_SEPARATOR_MENU_ITEM_w, 1, 0, 0, "(GTK_SEPARATOR_MENU_ITEM obj) casts obj to GTK_SEPARATOR_MENU_ITEM", NULL);
+ Xg_define_procedure(GTK_SETTINGS, gxg_GTK_SETTINGS_w, 1, 0, 0, "(GTK_SETTINGS obj) casts obj to GTK_SETTINGS", NULL);
+ Xg_define_procedure(GTK_SIZE_GROUP, gxg_GTK_SIZE_GROUP_w, 1, 0, 0, "(GTK_SIZE_GROUP obj) casts obj to GTK_SIZE_GROUP", NULL);
+ Xg_define_procedure(GTK_SPIN_BUTTON, gxg_GTK_SPIN_BUTTON_w, 1, 0, 0, "(GTK_SPIN_BUTTON obj) casts obj to GTK_SPIN_BUTTON", NULL);
+ Xg_define_procedure(GTK_STATUSBAR, gxg_GTK_STATUSBAR_w, 1, 0, 0, "(GTK_STATUSBAR obj) casts obj to GTK_STATUSBAR", NULL);
+ Xg_define_procedure(GTK_TEXT_BUFFER, gxg_GTK_TEXT_BUFFER_w, 1, 0, 0, "(GTK_TEXT_BUFFER obj) casts obj to GTK_TEXT_BUFFER", NULL);
+ Xg_define_procedure(GTK_TEXT_CHILD_ANCHOR, gxg_GTK_TEXT_CHILD_ANCHOR_w, 1, 0, 0, "(GTK_TEXT_CHILD_ANCHOR obj) casts obj to GTK_TEXT_CHILD_ANCHOR", NULL);
+ Xg_define_procedure(GTK_TEXT_MARK, gxg_GTK_TEXT_MARK_w, 1, 0, 0, "(GTK_TEXT_MARK obj) casts obj to GTK_TEXT_MARK", NULL);
+ Xg_define_procedure(GTK_TEXT_TAG, gxg_GTK_TEXT_TAG_w, 1, 0, 0, "(GTK_TEXT_TAG obj) casts obj to GTK_TEXT_TAG", NULL);
+ Xg_define_procedure(GTK_TEXT_TAG_TABLE, gxg_GTK_TEXT_TAG_TABLE_w, 1, 0, 0, "(GTK_TEXT_TAG_TABLE obj) casts obj to GTK_TEXT_TAG_TABLE", NULL);
+ Xg_define_procedure(GTK_TEXT_VIEW, gxg_GTK_TEXT_VIEW_w, 1, 0, 0, "(GTK_TEXT_VIEW obj) casts obj to GTK_TEXT_VIEW", NULL);
+ Xg_define_procedure(GTK_TOGGLE_BUTTON, gxg_GTK_TOGGLE_BUTTON_w, 1, 0, 0, "(GTK_TOGGLE_BUTTON obj) casts obj to GTK_TOGGLE_BUTTON", NULL);
+ Xg_define_procedure(GTK_TOOLBAR, gxg_GTK_TOOLBAR_w, 1, 0, 0, "(GTK_TOOLBAR obj) casts obj to GTK_TOOLBAR", NULL);
+ Xg_define_procedure(GTK_TREE_DRAG_SOURCE, gxg_GTK_TREE_DRAG_SOURCE_w, 1, 0, 0, "(GTK_TREE_DRAG_SOURCE obj) casts obj to GTK_TREE_DRAG_SOURCE", NULL);
+ Xg_define_procedure(GTK_TREE_DRAG_DEST, gxg_GTK_TREE_DRAG_DEST_w, 1, 0, 0, "(GTK_TREE_DRAG_DEST obj) casts obj to GTK_TREE_DRAG_DEST", NULL);
+ Xg_define_procedure(GTK_TREE_MODEL, gxg_GTK_TREE_MODEL_w, 1, 0, 0, "(GTK_TREE_MODEL obj) casts obj to GTK_TREE_MODEL", NULL);
+ Xg_define_procedure(GTK_TREE_MODEL_SORT, gxg_GTK_TREE_MODEL_SORT_w, 1, 0, 0, "(GTK_TREE_MODEL_SORT obj) casts obj to GTK_TREE_MODEL_SORT", NULL);
+ Xg_define_procedure(GTK_TREE_SELECTION, gxg_GTK_TREE_SELECTION_w, 1, 0, 0, "(GTK_TREE_SELECTION obj) casts obj to GTK_TREE_SELECTION", NULL);
+ Xg_define_procedure(GTK_TREE_SORTABLE, gxg_GTK_TREE_SORTABLE_w, 1, 0, 0, "(GTK_TREE_SORTABLE obj) casts obj to GTK_TREE_SORTABLE", NULL);
+ Xg_define_procedure(GTK_TREE_STORE, gxg_GTK_TREE_STORE_w, 1, 0, 0, "(GTK_TREE_STORE obj) casts obj to GTK_TREE_STORE", NULL);
+ Xg_define_procedure(GTK_TREE_VIEW_COLUMN, gxg_GTK_TREE_VIEW_COLUMN_w, 1, 0, 0, "(GTK_TREE_VIEW_COLUMN obj) casts obj to GTK_TREE_VIEW_COLUMN", NULL);
+ Xg_define_procedure(GTK_TREE_VIEW, gxg_GTK_TREE_VIEW_w, 1, 0, 0, "(GTK_TREE_VIEW obj) casts obj to GTK_TREE_VIEW", NULL);
+ Xg_define_procedure(GTK_VIEWPORT, gxg_GTK_VIEWPORT_w, 1, 0, 0, "(GTK_VIEWPORT obj) casts obj to GTK_VIEWPORT", NULL);
+ Xg_define_procedure(GTK_WIDGET, gxg_GTK_WIDGET_w, 1, 0, 0, "(GTK_WIDGET obj) casts obj to GTK_WIDGET", NULL);
+ Xg_define_procedure(GTK_WINDOW, gxg_GTK_WINDOW_w, 1, 0, 0, "(GTK_WINDOW obj) casts obj to GTK_WINDOW", NULL);
+ Xg_define_procedure(PANGO_CONTEXT, gxg_PANGO_CONTEXT_w, 1, 0, 0, "(PANGO_CONTEXT obj) casts obj to PANGO_CONTEXT", NULL);
+ Xg_define_procedure(PANGO_FONT_FAMILY, gxg_PANGO_FONT_FAMILY_w, 1, 0, 0, "(PANGO_FONT_FAMILY obj) casts obj to PANGO_FONT_FAMILY", NULL);
+ Xg_define_procedure(PANGO_FONT_FACE, gxg_PANGO_FONT_FACE_w, 1, 0, 0, "(PANGO_FONT_FACE obj) casts obj to PANGO_FONT_FACE", NULL);
+ Xg_define_procedure(PANGO_FONT, gxg_PANGO_FONT_w, 1, 0, 0, "(PANGO_FONT obj) casts obj to PANGO_FONT", NULL);
+ Xg_define_procedure(PANGO_FONT_MAP, gxg_PANGO_FONT_MAP_w, 1, 0, 0, "(PANGO_FONT_MAP obj) casts obj to PANGO_FONT_MAP", NULL);
+ Xg_define_procedure(PANGO_LAYOUT, gxg_PANGO_LAYOUT_w, 1, 0, 0, "(PANGO_LAYOUT obj) casts obj to PANGO_LAYOUT", NULL);
+ Xg_define_procedure(G_OBJECT, gxg_G_OBJECT_w, 1, 0, 0, "(G_OBJECT obj) casts obj to G_OBJECT", NULL);
+ Xg_define_procedure(GDK_SCREEN, gxg_GDK_SCREEN_w, 1, 0, 0, "(GDK_SCREEN obj) casts obj to GDK_SCREEN", NULL);
+ Xg_define_procedure(GDK_DISPLAY_OBJECT, gxg_GDK_DISPLAY_OBJECT_w, 1, 0, 0, "(GDK_DISPLAY_OBJECT obj) casts obj to GDK_DISPLAY_OBJECT", NULL);
+ Xg_define_procedure(GDK_EVENT, gxg_GDK_EVENT_w, 1, 0, 0, "(GDK_EVENT obj) casts obj to GDK_EVENT", NULL);
+ Xg_define_procedure(GDK_EVENT_ANY, gxg_GDK_EVENT_ANY_w, 1, 0, 0, "(GDK_EVENT_ANY obj) casts obj to GDK_EVENT_ANY", NULL);
+ Xg_define_procedure(GDK_EVENT_EXPOSE, gxg_GDK_EVENT_EXPOSE_w, 1, 0, 0, "(GDK_EVENT_EXPOSE obj) casts obj to GDK_EVENT_EXPOSE", NULL);
+ Xg_define_procedure(GDK_EVENT_NOEXPOSE, gxg_GDK_EVENT_NOEXPOSE_w, 1, 0, 0, "(GDK_EVENT_NOEXPOSE obj) casts obj to GDK_EVENT_NOEXPOSE", NULL);
+ Xg_define_procedure(GDK_EVENT_VISIBILITY, gxg_GDK_EVENT_VISIBILITY_w, 1, 0, 0, "(GDK_EVENT_VISIBILITY obj) casts obj to GDK_EVENT_VISIBILITY", NULL);
+ Xg_define_procedure(GDK_EVENT_MOTION, gxg_GDK_EVENT_MOTION_w, 1, 0, 0, "(GDK_EVENT_MOTION obj) casts obj to GDK_EVENT_MOTION", NULL);
+ Xg_define_procedure(GDK_EVENT_BUTTON, gxg_GDK_EVENT_BUTTON_w, 1, 0, 0, "(GDK_EVENT_BUTTON obj) casts obj to GDK_EVENT_BUTTON", NULL);
+ Xg_define_procedure(GDK_EVENT_SCROLL, gxg_GDK_EVENT_SCROLL_w, 1, 0, 0, "(GDK_EVENT_SCROLL obj) casts obj to GDK_EVENT_SCROLL", NULL);
+ Xg_define_procedure(GDK_EVENT_KEY, gxg_GDK_EVENT_KEY_w, 1, 0, 0, "(GDK_EVENT_KEY obj) casts obj to GDK_EVENT_KEY", NULL);
+ Xg_define_procedure(GDK_EVENT_CROSSING, gxg_GDK_EVENT_CROSSING_w, 1, 0, 0, "(GDK_EVENT_CROSSING obj) casts obj to GDK_EVENT_CROSSING", NULL);
+ Xg_define_procedure(GDK_EVENT_FOCUS, gxg_GDK_EVENT_FOCUS_w, 1, 0, 0, "(GDK_EVENT_FOCUS obj) casts obj to GDK_EVENT_FOCUS", NULL);
+ Xg_define_procedure(GDK_EVENT_CONFIGURE, gxg_GDK_EVENT_CONFIGURE_w, 1, 0, 0, "(GDK_EVENT_CONFIGURE obj) casts obj to GDK_EVENT_CONFIGURE", NULL);
+ Xg_define_procedure(GDK_EVENT_PROPERTY, gxg_GDK_EVENT_PROPERTY_w, 1, 0, 0, "(GDK_EVENT_PROPERTY obj) casts obj to GDK_EVENT_PROPERTY", NULL);
+ Xg_define_procedure(GDK_EVENT_SELECTION, gxg_GDK_EVENT_SELECTION_w, 1, 0, 0, "(GDK_EVENT_SELECTION obj) casts obj to GDK_EVENT_SELECTION", NULL);
+ Xg_define_procedure(GDK_EVENT_PROXIMITY, gxg_GDK_EVENT_PROXIMITY_w, 1, 0, 0, "(GDK_EVENT_PROXIMITY obj) casts obj to GDK_EVENT_PROXIMITY", NULL);
+ Xg_define_procedure(GDK_EVENT_SETTING, gxg_GDK_EVENT_SETTING_w, 1, 0, 0, "(GDK_EVENT_SETTING obj) casts obj to GDK_EVENT_SETTING", NULL);
+ Xg_define_procedure(GDK_EVENT_WINDOWSTATE, gxg_GDK_EVENT_WINDOWSTATE_w, 1, 0, 0, "(GDK_EVENT_WINDOWSTATE obj) casts obj to GDK_EVENT_WINDOWSTATE", NULL);
+ Xg_define_procedure(GDK_EVENT_DND, gxg_GDK_EVENT_DND_w, 1, 0, 0, "(GDK_EVENT_DND obj) casts obj to GDK_EVENT_DND", NULL);
+ Xg_define_procedure(GTK_FILE_CHOOSER_DIALOG, gxg_GTK_FILE_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_FILE_CHOOSER_DIALOG obj) casts obj to GTK_FILE_CHOOSER_DIALOG", NULL);
+ Xg_define_procedure(GTK_FILE_CHOOSER_WIDGET, gxg_GTK_FILE_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_FILE_CHOOSER_WIDGET obj) casts obj to GTK_FILE_CHOOSER_WIDGET", NULL);
+ Xg_define_procedure(GTK_TREE_MODEL_FILTER, gxg_GTK_TREE_MODEL_FILTER_w, 1, 0, 0, "(GTK_TREE_MODEL_FILTER obj) casts obj to GTK_TREE_MODEL_FILTER", NULL);
+ Xg_define_procedure(GTK_COMBO_BOX, gxg_GTK_COMBO_BOX_w, 1, 0, 0, "(GTK_COMBO_BOX obj) casts obj to GTK_COMBO_BOX", NULL);
+ Xg_define_procedure(GTK_EXPANDER, gxg_GTK_EXPANDER_w, 1, 0, 0, "(GTK_EXPANDER obj) casts obj to GTK_EXPANDER", NULL);
+ Xg_define_procedure(GTK_FONT_BUTTON, gxg_GTK_FONT_BUTTON_w, 1, 0, 0, "(GTK_FONT_BUTTON obj) casts obj to GTK_FONT_BUTTON", NULL);
+ Xg_define_procedure(GTK_COLOR_BUTTON, gxg_GTK_COLOR_BUTTON_w, 1, 0, 0, "(GTK_COLOR_BUTTON obj) casts obj to GTK_COLOR_BUTTON", NULL);
+ Xg_define_procedure(GTK_ENTRY_COMPLETION, gxg_GTK_ENTRY_COMPLETION_w, 1, 0, 0, "(GTK_ENTRY_COMPLETION obj) casts obj to GTK_ENTRY_COMPLETION", NULL);
+ Xg_define_procedure(GTK_RADIO_TOOL_BUTTON, gxg_GTK_RADIO_TOOL_BUTTON_w, 1, 0, 0, "(GTK_RADIO_TOOL_BUTTON obj) casts obj to GTK_RADIO_TOOL_BUTTON", NULL);
+ Xg_define_procedure(GTK_SEPARATOR_TOOL_ITEM, gxg_GTK_SEPARATOR_TOOL_ITEM_w, 1, 0, 0, "(GTK_SEPARATOR_TOOL_ITEM obj) casts obj to GTK_SEPARATOR_TOOL_ITEM", NULL);
+ Xg_define_procedure(GTK_TOGGLE_TOOL_BUTTON, gxg_GTK_TOGGLE_TOOL_BUTTON_w, 1, 0, 0, "(GTK_TOGGLE_TOOL_BUTTON obj) casts obj to GTK_TOGGLE_TOOL_BUTTON", NULL);
+ Xg_define_procedure(GTK_FILE_FILTER, gxg_GTK_FILE_FILTER_w, 1, 0, 0, "(GTK_FILE_FILTER obj) casts obj to GTK_FILE_FILTER", NULL);
+ Xg_define_procedure(GTK_CELL_LAYOUT, gxg_GTK_CELL_LAYOUT_w, 1, 0, 0, "(GTK_CELL_LAYOUT obj) casts obj to GTK_CELL_LAYOUT", NULL);
+ Xg_define_procedure(GTK_CLIPBOARD, gxg_GTK_CLIPBOARD_w, 1, 0, 0, "(GTK_CLIPBOARD obj) casts obj to GTK_CLIPBOARD", NULL);
+ Xg_define_procedure(GTK_FILE_CHOOSER, gxg_GTK_FILE_CHOOSER_w, 1, 0, 0, "(GTK_FILE_CHOOSER obj) casts obj to GTK_FILE_CHOOSER", NULL);
+ Xg_define_procedure(GTK_ICON_THEME, gxg_GTK_ICON_THEME_w, 1, 0, 0, "(GTK_ICON_THEME obj) casts obj to GTK_ICON_THEME", NULL);
+ Xg_define_procedure(GTK_TOOL_BUTTON, gxg_GTK_TOOL_BUTTON_w, 1, 0, 0, "(GTK_TOOL_BUTTON obj) casts obj to GTK_TOOL_BUTTON", NULL);
+ Xg_define_procedure(GTK_TOOL_ITEM, gxg_GTK_TOOL_ITEM_w, 1, 0, 0, "(GTK_TOOL_ITEM obj) casts obj to GTK_TOOL_ITEM", NULL);
+ Xg_define_procedure(GTK_ACCEL_MAP, gxg_GTK_ACCEL_MAP_w, 1, 0, 0, "(GTK_ACCEL_MAP obj) casts obj to GTK_ACCEL_MAP", NULL);
+ Xg_define_procedure(GTK_CELL_VIEW, gxg_GTK_CELL_VIEW_w, 1, 0, 0, "(GTK_CELL_VIEW obj) casts obj to GTK_CELL_VIEW", NULL);
+ Xg_define_procedure(GTK_ABOUT_DIALOG, gxg_GTK_ABOUT_DIALOG_w, 1, 0, 0, "(GTK_ABOUT_DIALOG obj) casts obj to GTK_ABOUT_DIALOG", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER_COMBO, gxg_GTK_CELL_RENDERER_COMBO_w, 1, 0, 0, "(GTK_CELL_RENDERER_COMBO obj) casts obj to GTK_CELL_RENDERER_COMBO", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER_PROGRESS, gxg_GTK_CELL_RENDERER_PROGRESS_w, 1, 0, 0, "(GTK_CELL_RENDERER_PROGRESS obj) casts obj to GTK_CELL_RENDERER_PROGRESS", NULL);
+ Xg_define_procedure(GTK_ICON_VIEW, gxg_GTK_ICON_VIEW_w, 1, 0, 0, "(GTK_ICON_VIEW obj) casts obj to GTK_ICON_VIEW", NULL);
+ Xg_define_procedure(GTK_FILE_CHOOSER_BUTTON, gxg_GTK_FILE_CHOOSER_BUTTON_w, 1, 0, 0, "(GTK_FILE_CHOOSER_BUTTON obj) casts obj to GTK_FILE_CHOOSER_BUTTON", NULL);
+ Xg_define_procedure(GTK_MENU_TOOL_BUTTON, gxg_GTK_MENU_TOOL_BUTTON_w, 1, 0, 0, "(GTK_MENU_TOOL_BUTTON obj) casts obj to GTK_MENU_TOOL_BUTTON", NULL);
+ Xg_define_procedure(GTK_ASSISTANT, gxg_GTK_ASSISTANT_w, 1, 0, 0, "(GTK_ASSISTANT obj) casts obj to GTK_ASSISTANT", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER_ACCEL, gxg_GTK_CELL_RENDERER_ACCEL_w, 1, 0, 0, "(GTK_CELL_RENDERER_ACCEL obj) casts obj to GTK_CELL_RENDERER_ACCEL", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER_SPIN, gxg_GTK_CELL_RENDERER_SPIN_w, 1, 0, 0, "(GTK_CELL_RENDERER_SPIN obj) casts obj to GTK_CELL_RENDERER_SPIN", NULL);
+ Xg_define_procedure(GTK_LINK_BUTTON, gxg_GTK_LINK_BUTTON_w, 1, 0, 0, "(GTK_LINK_BUTTON obj) casts obj to GTK_LINK_BUTTON", NULL);
+ Xg_define_procedure(GTK_RECENT_CHOOSER_DIALOG, gxg_GTK_RECENT_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_RECENT_CHOOSER_DIALOG obj) casts obj to GTK_RECENT_CHOOSER_DIALOG", NULL);
+ Xg_define_procedure(GTK_RECENT_CHOOSER, gxg_GTK_RECENT_CHOOSER_w, 1, 0, 0, "(GTK_RECENT_CHOOSER obj) casts obj to GTK_RECENT_CHOOSER", NULL);
+ Xg_define_procedure(GTK_RECENT_CHOOSER_MENU, gxg_GTK_RECENT_CHOOSER_MENU_w, 1, 0, 0, "(GTK_RECENT_CHOOSER_MENU obj) casts obj to GTK_RECENT_CHOOSER_MENU", NULL);
+ Xg_define_procedure(GTK_RECENT_CHOOSER_WIDGET, gxg_GTK_RECENT_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_RECENT_CHOOSER_WIDGET obj) casts obj to GTK_RECENT_CHOOSER_WIDGET", NULL);
+ Xg_define_procedure(GTK_RECENT_FILTER, gxg_GTK_RECENT_FILTER_w, 1, 0, 0, "(GTK_RECENT_FILTER obj) casts obj to GTK_RECENT_FILTER", NULL);
+ Xg_define_procedure(GTK_RECENT_MANAGER, gxg_GTK_RECENT_MANAGER_w, 1, 0, 0, "(GTK_RECENT_MANAGER obj) casts obj to GTK_RECENT_MANAGER", NULL);
+ Xg_define_procedure(GTK_PRINT_CONTEXT, gxg_GTK_PRINT_CONTEXT_w, 1, 0, 0, "(GTK_PRINT_CONTEXT obj) casts obj to GTK_PRINT_CONTEXT", NULL);
+ Xg_define_procedure(GTK_PRINT_OPERATION, gxg_GTK_PRINT_OPERATION_w, 1, 0, 0, "(GTK_PRINT_OPERATION obj) casts obj to GTK_PRINT_OPERATION", NULL);
+ Xg_define_procedure(GTK_PRINT_OPERATION_PREVIEW, gxg_GTK_PRINT_OPERATION_PREVIEW_w, 1, 0, 0, "(GTK_PRINT_OPERATION_PREVIEW obj) casts obj to GTK_PRINT_OPERATION_PREVIEW", NULL);
+ Xg_define_procedure(GTK_PRINT_SETTINGS, gxg_GTK_PRINT_SETTINGS_w, 1, 0, 0, "(GTK_PRINT_SETTINGS obj) casts obj to GTK_PRINT_SETTINGS", NULL);
+ Xg_define_procedure(GTK_TOOLTIP, gxg_GTK_TOOLTIP_w, 1, 0, 0, "(GTK_TOOLTIP obj) casts obj to GTK_TOOLTIP", NULL);
+#if GTK_CHECK_VERSION(2, 18, 0)
+ Xg_define_procedure(GTK_INFO_BAR, gxg_GTK_INFO_BAR_w, 1, 0, 0, "(GTK_INFO_BAR obj) casts obj to GTK_INFO_BAR", NULL);
+ Xg_define_procedure(GTK_ENTRY_BUFFER, gxg_GTK_ENTRY_BUFFER_w, 1, 0, 0, "(GTK_ENTRY_BUFFER obj) casts obj to GTK_ENTRY_BUFFER", NULL);
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
- XG_DEFINE_PROCEDURE(gdk_window_ensure_native, gxg_gdk_window_ensure_native_w, 1, 0, 0, H_gdk_window_ensure_native);
- XG_DEFINE_PROCEDURE(gdk_window_get_root_coords, gxg_gdk_window_get_root_coords_w, 3, 2, 0, H_gdk_window_get_root_coords);
- XG_DEFINE_PROCEDURE(gdk_offscreen_window_set_embedder, gxg_gdk_offscreen_window_set_embedder_w, 2, 0, 0, H_gdk_offscreen_window_set_embedder);
- XG_DEFINE_PROCEDURE(gdk_offscreen_window_get_embedder, gxg_gdk_offscreen_window_get_embedder_w, 1, 0, 0, H_gdk_offscreen_window_get_embedder);
- XG_DEFINE_PROCEDURE(gdk_window_geometry_changed, gxg_gdk_window_geometry_changed_w, 1, 0, 0, H_gdk_window_geometry_changed);
- XG_DEFINE_PROCEDURE(gtk_menu_set_reserve_toggle_size, gxg_gtk_menu_set_reserve_toggle_size_w, 2, 0, 0, H_gtk_menu_set_reserve_toggle_size);
- XG_DEFINE_PROCEDURE(gtk_menu_get_reserve_toggle_size, gxg_gtk_menu_get_reserve_toggle_size_w, 1, 0, 0, H_gtk_menu_get_reserve_toggle_size);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_title, gxg_gtk_status_icon_set_title_w, 2, 0, 0, H_gtk_status_icon_set_title);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_title, gxg_gtk_status_icon_get_title_w, 1, 0, 0, H_gtk_status_icon_get_title);
- XG_DEFINE_PROCEDURE(gtk_entry_new_with_buffer, gxg_gtk_entry_new_with_buffer_w, 1, 0, 0, H_gtk_entry_new_with_buffer);
- XG_DEFINE_PROCEDURE(gtk_entry_get_buffer, gxg_gtk_entry_get_buffer_w, 1, 0, 0, H_gtk_entry_get_buffer);
- XG_DEFINE_PROCEDURE(gtk_entry_set_buffer, gxg_gtk_entry_set_buffer_w, 2, 0, 0, H_gtk_entry_set_buffer);
- XG_DEFINE_PROCEDURE(gtk_label_set_track_visited_links, gxg_gtk_label_set_track_visited_links_w, 2, 0, 0, H_gtk_label_set_track_visited_links);
- XG_DEFINE_PROCEDURE(gtk_label_get_track_visited_links, gxg_gtk_label_get_track_visited_links_w, 1, 0, 0, H_gtk_label_get_track_visited_links);
- XG_DEFINE_PROCEDURE(gtk_print_operation_set_embed_page_setup, gxg_gtk_print_operation_set_embed_page_setup_w, 2, 0, 0, H_gtk_print_operation_set_embed_page_setup);
- XG_DEFINE_PROCEDURE(gtk_print_operation_get_embed_page_setup, gxg_gtk_print_operation_get_embed_page_setup_w, 1, 0, 0, H_gtk_print_operation_get_embed_page_setup);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_new, gxg_gtk_entry_buffer_new_w, 2, 0, 0, H_gtk_entry_buffer_new);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_get_bytes, gxg_gtk_entry_buffer_get_bytes_w, 1, 0, 0, H_gtk_entry_buffer_get_bytes);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_get_length, gxg_gtk_entry_buffer_get_length_w, 1, 0, 0, H_gtk_entry_buffer_get_length);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_get_text, gxg_gtk_entry_buffer_get_text_w, 1, 0, 0, H_gtk_entry_buffer_get_text);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_set_text, gxg_gtk_entry_buffer_set_text_w, 3, 0, 0, H_gtk_entry_buffer_set_text);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_set_max_length, gxg_gtk_entry_buffer_set_max_length_w, 2, 0, 0, H_gtk_entry_buffer_set_max_length);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_get_max_length, gxg_gtk_entry_buffer_get_max_length_w, 1, 0, 0, H_gtk_entry_buffer_get_max_length);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_insert_text, gxg_gtk_entry_buffer_insert_text_w, 4, 0, 0, H_gtk_entry_buffer_insert_text);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_delete_text, gxg_gtk_entry_buffer_delete_text_w, 3, 0, 0, H_gtk_entry_buffer_delete_text);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_emit_inserted_text, gxg_gtk_entry_buffer_emit_inserted_text_w, 4, 0, 0, H_gtk_entry_buffer_emit_inserted_text);
- XG_DEFINE_PROCEDURE(gtk_entry_buffer_emit_deleted_text, gxg_gtk_entry_buffer_emit_deleted_text_w, 3, 0, 0, H_gtk_entry_buffer_emit_deleted_text);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_set_alignment, gxg_gtk_cell_renderer_set_alignment_w, 3, 0, 0, H_gtk_cell_renderer_set_alignment);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_alignment, gxg_gtk_cell_renderer_get_alignment_w, 1, 2, 0, H_gtk_cell_renderer_get_alignment);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_set_padding, gxg_gtk_cell_renderer_set_padding_w, 3, 0, 0, H_gtk_cell_renderer_set_padding);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_padding, gxg_gtk_cell_renderer_get_padding_w, 1, 2, 0, H_gtk_cell_renderer_get_padding);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_set_visible, gxg_gtk_cell_renderer_set_visible_w, 2, 0, 0, H_gtk_cell_renderer_set_visible);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_visible, gxg_gtk_cell_renderer_get_visible_w, 1, 0, 0, H_gtk_cell_renderer_get_visible);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_set_sensitive, gxg_gtk_cell_renderer_set_sensitive_w, 2, 0, 0, H_gtk_cell_renderer_set_sensitive);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_sensitive, gxg_gtk_cell_renderer_get_sensitive_w, 1, 0, 0, H_gtk_cell_renderer_get_sensitive);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_toggle_get_activatable, gxg_gtk_cell_renderer_toggle_get_activatable_w, 1, 0, 0, H_gtk_cell_renderer_toggle_get_activatable);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_toggle_set_activatable, gxg_gtk_cell_renderer_toggle_set_activatable_w, 2, 0, 0, H_gtk_cell_renderer_toggle_set_activatable);
- XG_DEFINE_PROCEDURE(gtk_widget_set_can_focus, gxg_gtk_widget_set_can_focus_w, 2, 0, 0, H_gtk_widget_set_can_focus);
- XG_DEFINE_PROCEDURE(gtk_widget_get_can_focus, gxg_gtk_widget_get_can_focus_w, 1, 0, 0, H_gtk_widget_get_can_focus);
- XG_DEFINE_PROCEDURE(gtk_widget_has_focus, gxg_gtk_widget_has_focus_w, 1, 0, 0, H_gtk_widget_has_focus);
- XG_DEFINE_PROCEDURE(gtk_widget_set_can_default, gxg_gtk_widget_set_can_default_w, 2, 0, 0, H_gtk_widget_set_can_default);
- XG_DEFINE_PROCEDURE(gtk_widget_get_can_default, gxg_gtk_widget_get_can_default_w, 1, 0, 0, H_gtk_widget_get_can_default);
- XG_DEFINE_PROCEDURE(gtk_widget_has_default, gxg_gtk_widget_has_default_w, 1, 0, 0, H_gtk_widget_has_default);
- XG_DEFINE_PROCEDURE(gtk_widget_get_state, gxg_gtk_widget_get_state_w, 1, 0, 0, H_gtk_widget_get_state);
- XG_DEFINE_PROCEDURE(gtk_widget_get_sensitive, gxg_gtk_widget_get_sensitive_w, 1, 0, 0, H_gtk_widget_get_sensitive);
- XG_DEFINE_PROCEDURE(gtk_widget_is_sensitive, gxg_gtk_widget_is_sensitive_w, 1, 0, 0, H_gtk_widget_is_sensitive);
- XG_DEFINE_PROCEDURE(gtk_widget_set_has_window, gxg_gtk_widget_set_has_window_w, 2, 0, 0, H_gtk_widget_set_has_window);
- XG_DEFINE_PROCEDURE(gtk_widget_get_has_window, gxg_gtk_widget_get_has_window_w, 1, 0, 0, H_gtk_widget_get_has_window);
- XG_DEFINE_PROCEDURE(gtk_widget_get_app_paintable, gxg_gtk_widget_get_app_paintable_w, 1, 0, 0, H_gtk_widget_get_app_paintable);
- XG_DEFINE_PROCEDURE(gtk_widget_get_double_buffered, gxg_gtk_widget_get_double_buffered_w, 1, 0, 0, H_gtk_widget_get_double_buffered);
+#if GTK_CHECK_VERSION(2, 20, 0)
+ Xg_define_procedure(GTK_SPINNER, gxg_GTK_SPINNER_w, 1, 0, 0, "(GTK_SPINNER obj) casts obj to GTK_SPINNER", NULL);
+ Xg_define_procedure(GTK_CELL_RENDERER_SPINNER, gxg_GTK_CELL_RENDERER_SPINNER_w, 1, 0, 0, "(GTK_CELL_RENDERER_SPINNER obj) casts obj to GTK_CELL_RENDERER_SPINNER", NULL);
+ Xg_define_procedure(GTK_TOOL_PALETTE, gxg_GTK_TOOL_PALETTE_w, 1, 0, 0, "(GTK_TOOL_PALETTE obj) casts obj to GTK_TOOL_PALETTE", NULL);
+ Xg_define_procedure(GTK_TOOL_ITEM_GROUP, gxg_GTK_TOOL_ITEM_GROUP_w, 1, 0, 0, "(GTK_TOOL_ITEM_GROUP obj) casts obj to GTK_TOOL_ITEM_GROUP", NULL);
#endif
-#if HAVE_GTK_WIDGET_GET_VISIBLE
- XG_DEFINE_PROCEDURE(gdk_window_get_cursor, gxg_gdk_window_get_cursor_w, 1, 0, 0, H_gdk_window_get_cursor);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_set_create_folders, gxg_gtk_file_chooser_set_create_folders_w, 2, 0, 0, H_gtk_file_chooser_set_create_folders);
- XG_DEFINE_PROCEDURE(gtk_file_chooser_get_create_folders, gxg_gtk_file_chooser_get_create_folders_w, 1, 0, 0, H_gtk_file_chooser_get_create_folders);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_item_padding, gxg_gtk_icon_view_set_item_padding_w, 2, 0, 0, H_gtk_icon_view_set_item_padding);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_item_padding, gxg_gtk_icon_view_get_item_padding_w, 1, 0, 0, H_gtk_icon_view_get_item_padding);
- XG_DEFINE_PROCEDURE(gtk_widget_has_grab, gxg_gtk_widget_has_grab_w, 1, 0, 0, H_gtk_widget_has_grab);
- XG_DEFINE_PROCEDURE(gtk_widget_set_visible, gxg_gtk_widget_set_visible_w, 2, 0, 0, H_gtk_widget_set_visible);
- XG_DEFINE_PROCEDURE(gtk_widget_get_visible, gxg_gtk_widget_get_visible_w, 1, 0, 0, H_gtk_widget_get_visible);
- XG_DEFINE_PROCEDURE(gtk_range_set_flippable, gxg_gtk_range_set_flippable_w, 2, 0, 0, H_gtk_range_set_flippable);
- XG_DEFINE_PROCEDURE(gtk_range_get_flippable, gxg_gtk_range_get_flippable_w, 1, 0, 0, H_gtk_range_get_flippable);
- XG_DEFINE_PROCEDURE(gtk_widget_is_toplevel, gxg_gtk_widget_is_toplevel_w, 1, 0, 0, H_gtk_widget_is_toplevel);
- XG_DEFINE_PROCEDURE(gtk_widget_is_drawable, gxg_gtk_widget_is_drawable_w, 1, 0, 0, H_gtk_widget_is_drawable);
- XG_DEFINE_PROCEDURE(gtk_widget_set_window, gxg_gtk_widget_set_window_w, 2, 0, 0, H_gtk_widget_set_window);
- XG_DEFINE_PROCEDURE(gdk_window_is_destroyed, gxg_gdk_window_is_destroyed_w, 1, 0, 0, H_gdk_window_is_destroyed);
- XG_DEFINE_PROCEDURE(gdk_window_restack, gxg_gdk_window_restack_w, 3, 0, 0, H_gdk_window_restack);
- XG_DEFINE_PROCEDURE(gtk_widget_set_receives_default, gxg_gtk_widget_set_receives_default_w, 2, 0, 0, H_gtk_widget_set_receives_default);
- XG_DEFINE_PROCEDURE(gtk_widget_get_receives_default, gxg_gtk_widget_get_receives_default_w, 1, 0, 0, H_gtk_widget_get_receives_default);
- XG_DEFINE_PROCEDURE(gdk_window_flush, gxg_gdk_window_flush_w, 1, 0, 0, H_gdk_window_flush);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ Xg_define_procedure(GTK_COMBO_BOX_TEXT, gxg_GTK_COMBO_BOX_TEXT_w, 1, 0, 0, "(GTK_COMBO_BOX_TEXT obj) casts obj to GTK_COMBO_BOX_TEXT", NULL);
+ Xg_define_procedure(GTK_GRID, gxg_GTK_GRID_w, 1, 0, 0, "(GTK_GRID obj) casts obj to GTK_GRID", NULL);
+ Xg_define_procedure(GTK_SCROLLABLE, gxg_GTK_SCROLLABLE_w, 1, 0, 0, "(GTK_SCROLLABLE obj) casts obj to GTK_SCROLLABLE", NULL);
+ Xg_define_procedure(GDK_RGBA, gxg_GDK_RGBA_w, 1, 0, 0, "(GDK_RGBA obj) casts obj to GDK_RGBA", NULL);
+ Xg_define_procedure(GTK_SWITCH, gxg_GTK_SWITCH_w, 1, 0, 0, "(GTK_SWITCH obj) casts obj to GTK_SWITCH", NULL);
+ Xg_define_procedure(GTK_ORIENTABLE, gxg_GTK_ORIENTABLE_w, 1, 0, 0, "(GTK_ORIENTABLE obj) casts obj to GTK_ORIENTABLE", NULL);
+ Xg_define_procedure(GTK_WINDOW_GROUP, gxg_GTK_WINDOW_GROUP_w, 1, 0, 0, "(GTK_WINDOW_GROUP obj) casts obj to GTK_WINDOW_GROUP", NULL);
+ Xg_define_procedure(GTK_TOOL_SHELL, gxg_GTK_TOOL_SHELL_w, 1, 0, 0, "(GTK_TOOL_SHELL obj) casts obj to GTK_TOOL_SHELL", NULL);
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
- XG_DEFINE_PROCEDURE(gtk_dialog_get_widget_for_response, gxg_gtk_dialog_get_widget_for_response_w, 2, 0, 0, H_gtk_dialog_get_widget_for_response);
- XG_DEFINE_PROCEDURE(gtk_tooltip_set_icon_from_gicon, gxg_gtk_tooltip_set_icon_from_gicon_w, 3, 0, 0, H_gtk_tooltip_set_icon_from_gicon);
- XG_DEFINE_PROCEDURE(gtk_viewport_get_bin_window, gxg_gtk_viewport_get_bin_window_w, 1, 0, 0, H_gtk_viewport_get_bin_window);
- XG_DEFINE_PROCEDURE(gtk_spinner_new, gxg_gtk_spinner_new_w, 0, 0, 0, H_gtk_spinner_new);
- XG_DEFINE_PROCEDURE(gtk_spinner_start, gxg_gtk_spinner_start_w, 1, 0, 0, H_gtk_spinner_start);
- XG_DEFINE_PROCEDURE(gtk_spinner_stop, gxg_gtk_spinner_stop_w, 1, 0, 0, H_gtk_spinner_stop);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_spinner_new, gxg_gtk_cell_renderer_spinner_new_w, 0, 0, 0, H_gtk_cell_renderer_spinner_new);
- XG_DEFINE_PROCEDURE(gtk_action_set_always_show_image, gxg_gtk_action_set_always_show_image_w, 2, 0, 0, H_gtk_action_set_always_show_image);
- XG_DEFINE_PROCEDURE(gtk_action_get_always_show_image, gxg_gtk_action_get_always_show_image_w, 1, 0, 0, H_gtk_action_get_always_show_image);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_action_widget, gxg_gtk_notebook_get_action_widget_w, 2, 0, 0, H_gtk_notebook_get_action_widget);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_action_widget, gxg_gtk_notebook_set_action_widget_w, 3, 0, 0, H_gtk_notebook_set_action_widget);
- XG_DEFINE_PROCEDURE(gtk_statusbar_get_message_area, gxg_gtk_statusbar_get_message_area_w, 1, 0, 0, H_gtk_statusbar_get_message_area);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_ellipsize_mode, gxg_gtk_tool_item_get_ellipsize_mode_w, 1, 0, 0, H_gtk_tool_item_get_ellipsize_mode);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_text_alignment, gxg_gtk_tool_item_get_text_alignment_w, 1, 0, 0, H_gtk_tool_item_get_text_alignment);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_text_orientation, gxg_gtk_tool_item_get_text_orientation_w, 1, 0, 0, H_gtk_tool_item_get_text_orientation);
- XG_DEFINE_PROCEDURE(gtk_tool_item_get_text_size_group, gxg_gtk_tool_item_get_text_size_group_w, 1, 0, 0, H_gtk_tool_item_get_text_size_group);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_new, gxg_gtk_tool_palette_new_w, 0, 0, 0, H_gtk_tool_palette_new);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_set_group_position, gxg_gtk_tool_palette_set_group_position_w, 3, 0, 0, H_gtk_tool_palette_set_group_position);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_set_exclusive, gxg_gtk_tool_palette_set_exclusive_w, 3, 0, 0, H_gtk_tool_palette_set_exclusive);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_set_expand, gxg_gtk_tool_palette_set_expand_w, 3, 0, 0, H_gtk_tool_palette_set_expand);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_group_position, gxg_gtk_tool_palette_get_group_position_w, 2, 0, 0, H_gtk_tool_palette_get_group_position);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_exclusive, gxg_gtk_tool_palette_get_exclusive_w, 2, 0, 0, H_gtk_tool_palette_get_exclusive);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_expand, gxg_gtk_tool_palette_get_expand_w, 2, 0, 0, H_gtk_tool_palette_get_expand);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_set_icon_size, gxg_gtk_tool_palette_set_icon_size_w, 2, 0, 0, H_gtk_tool_palette_set_icon_size);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_unset_icon_size, gxg_gtk_tool_palette_unset_icon_size_w, 1, 0, 0, H_gtk_tool_palette_unset_icon_size);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_set_style, gxg_gtk_tool_palette_set_style_w, 2, 0, 0, H_gtk_tool_palette_set_style);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_unset_style, gxg_gtk_tool_palette_unset_style_w, 1, 0, 0, H_gtk_tool_palette_unset_style);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_icon_size, gxg_gtk_tool_palette_get_icon_size_w, 1, 0, 0, H_gtk_tool_palette_get_icon_size);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_style, gxg_gtk_tool_palette_get_style_w, 1, 0, 0, H_gtk_tool_palette_get_style);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_drop_item, gxg_gtk_tool_palette_get_drop_item_w, 3, 0, 0, H_gtk_tool_palette_get_drop_item);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_drop_group, gxg_gtk_tool_palette_get_drop_group_w, 3, 0, 0, H_gtk_tool_palette_get_drop_group);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_drag_item, gxg_gtk_tool_palette_get_drag_item_w, 2, 0, 0, H_gtk_tool_palette_get_drag_item);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_set_drag_source, gxg_gtk_tool_palette_set_drag_source_w, 2, 0, 0, H_gtk_tool_palette_set_drag_source);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_add_drag_dest, gxg_gtk_tool_palette_add_drag_dest_w, 5, 0, 0, H_gtk_tool_palette_add_drag_dest);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_drag_target_item, gxg_gtk_tool_palette_get_drag_target_item_w, 0, 0, 0, H_gtk_tool_palette_get_drag_target_item);
- XG_DEFINE_PROCEDURE(gtk_tool_palette_get_drag_target_group, gxg_gtk_tool_palette_get_drag_target_group_w, 0, 0, 0, H_gtk_tool_palette_get_drag_target_group);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_new, gxg_gtk_tool_item_group_new_w, 1, 0, 0, H_gtk_tool_item_group_new);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_set_label, gxg_gtk_tool_item_group_set_label_w, 2, 0, 0, H_gtk_tool_item_group_set_label);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_set_label_widget, gxg_gtk_tool_item_group_set_label_widget_w, 2, 0, 0, H_gtk_tool_item_group_set_label_widget);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_set_collapsed, gxg_gtk_tool_item_group_set_collapsed_w, 2, 0, 0, H_gtk_tool_item_group_set_collapsed);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_set_ellipsize, gxg_gtk_tool_item_group_set_ellipsize_w, 2, 0, 0, H_gtk_tool_item_group_set_ellipsize);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_set_header_relief, gxg_gtk_tool_item_group_set_header_relief_w, 2, 0, 0, H_gtk_tool_item_group_set_header_relief);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_label, gxg_gtk_tool_item_group_get_label_w, 1, 0, 0, H_gtk_tool_item_group_get_label);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_label_widget, gxg_gtk_tool_item_group_get_label_widget_w, 1, 0, 0, H_gtk_tool_item_group_get_label_widget);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_collapsed, gxg_gtk_tool_item_group_get_collapsed_w, 1, 0, 0, H_gtk_tool_item_group_get_collapsed);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_ellipsize, gxg_gtk_tool_item_group_get_ellipsize_w, 1, 0, 0, H_gtk_tool_item_group_get_ellipsize);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_header_relief, gxg_gtk_tool_item_group_get_header_relief_w, 1, 0, 0, H_gtk_tool_item_group_get_header_relief);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_insert, gxg_gtk_tool_item_group_insert_w, 3, 0, 0, H_gtk_tool_item_group_insert);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_set_item_position, gxg_gtk_tool_item_group_set_item_position_w, 3, 0, 0, H_gtk_tool_item_group_set_item_position);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_item_position, gxg_gtk_tool_item_group_get_item_position_w, 2, 0, 0, H_gtk_tool_item_group_get_item_position);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_n_items, gxg_gtk_tool_item_group_get_n_items_w, 1, 0, 0, H_gtk_tool_item_group_get_n_items);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_nth_item, gxg_gtk_tool_item_group_get_nth_item_w, 2, 0, 0, H_gtk_tool_item_group_get_nth_item);
- XG_DEFINE_PROCEDURE(gtk_tool_item_group_get_drop_item, gxg_gtk_tool_item_group_get_drop_item_w, 3, 0, 0, H_gtk_tool_item_group_get_drop_item);
- XG_DEFINE_PROCEDURE(gdk_screen_get_primary_monitor, gxg_gdk_screen_get_primary_monitor_w, 1, 0, 0, H_gdk_screen_get_primary_monitor);
- XG_DEFINE_PROCEDURE(gtk_window_set_mnemonics_visible, gxg_gtk_window_set_mnemonics_visible_w, 2, 0, 0, H_gtk_window_set_mnemonics_visible);
- XG_DEFINE_PROCEDURE(gtk_window_get_mnemonics_visible, gxg_gtk_window_get_mnemonics_visible_w, 1, 0, 0, H_gtk_window_get_mnemonics_visible);
- XG_DEFINE_PROCEDURE(gtk_range_set_slider_size_fixed, gxg_gtk_range_set_slider_size_fixed_w, 2, 0, 0, H_gtk_range_set_slider_size_fixed);
- XG_DEFINE_PROCEDURE(gtk_range_get_slider_size_fixed, gxg_gtk_range_get_slider_size_fixed_w, 1, 0, 0, H_gtk_range_get_slider_size_fixed);
- XG_DEFINE_PROCEDURE(gtk_range_set_min_slider_size, gxg_gtk_range_set_min_slider_size_w, 2, 0, 0, H_gtk_range_set_min_slider_size);
- XG_DEFINE_PROCEDURE(gtk_range_get_min_slider_size, gxg_gtk_range_get_min_slider_size_w, 1, 0, 0, H_gtk_range_get_min_slider_size);
- XG_DEFINE_PROCEDURE(gtk_range_get_range_rect, gxg_gtk_range_get_range_rect_w, 2, 0, 0, H_gtk_range_get_range_rect);
- XG_DEFINE_PROCEDURE(gtk_range_get_slider_range, gxg_gtk_range_get_slider_range_w, 1, 2, 0, H_gtk_range_get_slider_range);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_name, gxg_gtk_status_icon_set_name_w, 2, 0, 0, H_gtk_status_icon_set_name);
- XG_DEFINE_PROCEDURE(gtk_paned_get_handle_window, gxg_gtk_paned_get_handle_window_w, 1, 0, 0, H_gtk_paned_get_handle_window);
- XG_DEFINE_PROCEDURE(gtk_widget_set_realized, gxg_gtk_widget_set_realized_w, 2, 0, 0, H_gtk_widget_set_realized);
- XG_DEFINE_PROCEDURE(gtk_widget_get_realized, gxg_gtk_widget_get_realized_w, 1, 0, 0, H_gtk_widget_get_realized);
- XG_DEFINE_PROCEDURE(gtk_widget_set_mapped, gxg_gtk_widget_set_mapped_w, 2, 0, 0, H_gtk_widget_set_mapped);
- XG_DEFINE_PROCEDURE(gtk_widget_get_mapped, gxg_gtk_widget_get_mapped_w, 1, 0, 0, H_gtk_widget_get_mapped);
+#if GTK_CHECK_VERSION(3, 2, 0)
+ Xg_define_procedure(GTK_OVERLAY, gxg_GTK_OVERLAY_w, 1, 0, 0, "(GTK_OVERLAY obj) casts obj to GTK_OVERLAY", NULL);
+ Xg_define_procedure(GTK_FONT_CHOOSER, gxg_GTK_FONT_CHOOSER_w, 1, 0, 0, "(GTK_FONT_CHOOSER obj) casts obj to GTK_FONT_CHOOSER", NULL);
+ Xg_define_procedure(GTK_FONT_CHOOSER_DIALOG, gxg_GTK_FONT_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_FONT_CHOOSER_DIALOG obj) casts obj to GTK_FONT_CHOOSER_DIALOG", NULL);
+ Xg_define_procedure(GTK_FONT_CHOOSER_WIDGET, gxg_GTK_FONT_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_FONT_CHOOSER_WIDGET obj) casts obj to GTK_FONT_CHOOSER_WIDGET", NULL);
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
- XG_DEFINE_PROCEDURE(gdk_cairo_create, gxg_gdk_cairo_create_w, 1, 0, 0, H_gdk_cairo_create);
- XG_DEFINE_PROCEDURE(gdk_window_get_geometry, gxg_gdk_window_get_geometry_w, 1, 4, 0, H_gdk_window_get_geometry);
- XG_DEFINE_PROCEDURE(gdk_keymap_add_virtual_modifiers, gxg_gdk_keymap_add_virtual_modifiers_w, 2, 0, 0, H_gdk_keymap_add_virtual_modifiers);
- XG_DEFINE_PROCEDURE(gdk_window_coords_to_parent, gxg_gdk_window_coords_to_parent_w, 3, 2, 0, H_gdk_window_coords_to_parent);
- XG_DEFINE_PROCEDURE(gdk_window_coords_from_parent, gxg_gdk_window_coords_from_parent_w, 3, 2, 0, H_gdk_window_coords_from_parent);
- XG_DEFINE_PROCEDURE(gdk_window_get_effective_parent, gxg_gdk_window_get_effective_parent_w, 1, 0, 0, H_gdk_window_get_effective_parent);
- XG_DEFINE_PROCEDURE(gdk_window_get_effective_toplevel, gxg_gdk_window_get_effective_toplevel_w, 1, 0, 0, H_gdk_window_get_effective_toplevel);
- XG_DEFINE_PROCEDURE(gtk_accessible_get_widget, gxg_gtk_accessible_get_widget_w, 1, 0, 0, H_gtk_accessible_get_widget);
- XG_DEFINE_PROCEDURE(gtk_widget_send_focus_change, gxg_gtk_widget_send_focus_change_w, 2, 0, 0, H_gtk_widget_send_focus_change);
- XG_DEFINE_PROCEDURE(gdk_display_get_device_manager, gxg_gdk_display_get_device_manager_w, 1, 0, 0, H_gdk_display_get_device_manager);
- XG_DEFINE_PROCEDURE(gdk_drag_context_set_device, gxg_gdk_drag_context_set_device_w, 2, 0, 0, H_gdk_drag_context_set_device);
- XG_DEFINE_PROCEDURE(gdk_drag_context_get_device, gxg_gdk_drag_context_get_device_w, 1, 0, 0, H_gdk_drag_context_get_device);
- XG_DEFINE_PROCEDURE(gdk_drag_context_list_targets, gxg_gdk_drag_context_list_targets_w, 1, 0, 0, H_gdk_drag_context_list_targets);
- XG_DEFINE_PROCEDURE(gdk_event_set_device, gxg_gdk_event_set_device_w, 2, 0, 0, H_gdk_event_set_device);
- XG_DEFINE_PROCEDURE(gdk_event_get_device, gxg_gdk_event_get_device_w, 1, 0, 0, H_gdk_event_get_device);
- XG_DEFINE_PROCEDURE(gdk_events_get_distance, gxg_gdk_events_get_distance_w, 2, 1, 0, H_gdk_events_get_distance);
- XG_DEFINE_PROCEDURE(gdk_events_get_angle, gxg_gdk_events_get_angle_w, 2, 1, 0, H_gdk_events_get_angle);
- XG_DEFINE_PROCEDURE(gdk_events_get_center, gxg_gdk_events_get_center_w, 2, 2, 0, H_gdk_events_get_center);
- XG_DEFINE_PROCEDURE(gdk_window_get_accept_focus, gxg_gdk_window_get_accept_focus_w, 1, 0, 0, H_gdk_window_get_accept_focus);
- XG_DEFINE_PROCEDURE(gdk_window_get_focus_on_map, gxg_gdk_window_get_focus_on_map_w, 1, 0, 0, H_gdk_window_get_focus_on_map);
- XG_DEFINE_PROCEDURE(gdk_window_get_composited, gxg_gdk_window_get_composited_w, 1, 0, 0, H_gdk_window_get_composited);
- XG_DEFINE_PROCEDURE(gdk_window_is_input_only, gxg_gdk_window_is_input_only_w, 1, 0, 0, H_gdk_window_is_input_only);
- XG_DEFINE_PROCEDURE(gdk_window_is_shaped, gxg_gdk_window_is_shaped_w, 1, 0, 0, H_gdk_window_is_shaped);
- XG_DEFINE_PROCEDURE(gdk_window_get_modal_hint, gxg_gdk_window_get_modal_hint_w, 1, 0, 0, H_gdk_window_get_modal_hint);
- XG_DEFINE_PROCEDURE(gdk_window_set_device_cursor, gxg_gdk_window_set_device_cursor_w, 3, 0, 0, H_gdk_window_set_device_cursor);
- XG_DEFINE_PROCEDURE(gdk_window_get_device_cursor, gxg_gdk_window_get_device_cursor_w, 2, 0, 0, H_gdk_window_get_device_cursor);
- XG_DEFINE_PROCEDURE(gdk_window_get_device_position, gxg_gdk_window_get_device_position_w, 2, 3, 0, H_gdk_window_get_device_position);
- XG_DEFINE_PROCEDURE(gdk_window_set_device_events, gxg_gdk_window_set_device_events_w, 3, 0, 0, H_gdk_window_set_device_events);
- XG_DEFINE_PROCEDURE(gdk_window_get_device_events, gxg_gdk_window_get_device_events_w, 2, 0, 0, H_gdk_window_get_device_events);
- XG_DEFINE_PROCEDURE(gtk_combo_box_popup_for_device, gxg_gtk_combo_box_popup_for_device_w, 2, 0, 0, H_gtk_combo_box_popup_for_device);
- XG_DEFINE_PROCEDURE(gtk_device_grab_add, gxg_gtk_device_grab_add_w, 3, 0, 0, H_gtk_device_grab_add);
- XG_DEFINE_PROCEDURE(gtk_device_grab_remove, gxg_gtk_device_grab_remove_w, 2, 0, 0, H_gtk_device_grab_remove);
- XG_DEFINE_PROCEDURE(gtk_get_current_event_device, gxg_gtk_get_current_event_device_w, 0, 0, 0, H_gtk_get_current_event_device);
- XG_DEFINE_PROCEDURE(gtk_paned_new, gxg_gtk_paned_new_w, 1, 0, 0, H_gtk_paned_new);
- XG_DEFINE_PROCEDURE(gtk_radio_action_join_group, gxg_gtk_radio_action_join_group_w, 2, 0, 0, H_gtk_radio_action_join_group);
- XG_DEFINE_PROCEDURE(gtk_scale_new, gxg_gtk_scale_new_w, 2, 0, 0, H_gtk_scale_new);
- XG_DEFINE_PROCEDURE(gtk_scale_new_with_range, gxg_gtk_scale_new_with_range_w, 4, 0, 0, H_gtk_scale_new_with_range);
- XG_DEFINE_PROCEDURE(gtk_scrollbar_new, gxg_gtk_scrollbar_new_w, 2, 0, 0, H_gtk_scrollbar_new);
- XG_DEFINE_PROCEDURE(gtk_separator_new, gxg_gtk_separator_new_w, 1, 0, 0, H_gtk_separator_new);
- XG_DEFINE_PROCEDURE(gtk_widget_device_is_shadowed, gxg_gtk_widget_device_is_shadowed_w, 2, 0, 0, H_gtk_widget_device_is_shadowed);
- XG_DEFINE_PROCEDURE(gtk_widget_set_device_events, gxg_gtk_widget_set_device_events_w, 3, 0, 0, H_gtk_widget_set_device_events);
- XG_DEFINE_PROCEDURE(gtk_widget_add_device_events, gxg_gtk_widget_add_device_events_w, 3, 0, 0, H_gtk_widget_add_device_events);
- XG_DEFINE_PROCEDURE(gtk_widget_get_support_multidevice, gxg_gtk_widget_get_support_multidevice_w, 1, 0, 0, H_gtk_widget_get_support_multidevice);
- XG_DEFINE_PROCEDURE(gtk_widget_set_support_multidevice, gxg_gtk_widget_set_support_multidevice_w, 2, 0, 0, H_gtk_widget_set_support_multidevice);
- XG_DEFINE_PROCEDURE(gtk_widget_get_device_events, gxg_gtk_widget_get_device_events_w, 2, 0, 0, H_gtk_widget_get_device_events);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_item_row, gxg_gtk_icon_view_get_item_row_w, 2, 0, 0, H_gtk_icon_view_get_item_row);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_item_column, gxg_gtk_icon_view_get_item_column_w, 2, 0, 0, H_gtk_icon_view_get_item_column);
- XG_DEFINE_PROCEDURE(gtk_statusbar_remove_all, gxg_gtk_statusbar_remove_all_w, 2, 0, 0, H_gtk_statusbar_remove_all);
- XG_DEFINE_PROCEDURE(gtk_window_has_group, gxg_gtk_window_has_group_w, 1, 0, 0, H_gtk_window_has_group);
- XG_DEFINE_PROCEDURE(gtk_calendar_select_month, gxg_gtk_calendar_select_month_w, 3, 0, 0, H_gtk_calendar_select_month);
- XG_DEFINE_PROCEDURE(gtk_calendar_mark_day, gxg_gtk_calendar_mark_day_w, 2, 0, 0, H_gtk_calendar_mark_day);
- XG_DEFINE_PROCEDURE(gtk_calendar_unmark_day, gxg_gtk_calendar_unmark_day_w, 2, 0, 0, H_gtk_calendar_unmark_day);
- XG_DEFINE_PROCEDURE(gdk_drag_context_get_source_window, gxg_gdk_drag_context_get_source_window_w, 1, 0, 0, H_gdk_drag_context_get_source_window);
- XG_DEFINE_PROCEDURE(gtk_viewport_get_view_window, gxg_gtk_viewport_get_view_window_w, 1, 0, 0, H_gtk_viewport_get_view_window);
- XG_DEFINE_PROCEDURE(gtk_accessible_set_widget, gxg_gtk_accessible_set_widget_w, 2, 0, 0, H_gtk_accessible_set_widget);
- XG_DEFINE_PROCEDURE(gtk_button_get_event_window, gxg_gtk_button_get_event_window_w, 1, 0, 0, H_gtk_button_get_event_window);
- XG_DEFINE_PROCEDURE(gtk_font_selection_dialog_get_font_selection, gxg_gtk_font_selection_dialog_get_font_selection_w, 1, 0, 0, H_gtk_font_selection_dialog_get_font_selection);
- XG_DEFINE_PROCEDURE(gtk_message_dialog_get_message_area, gxg_gtk_message_dialog_get_message_area_w, 1, 0, 0, H_gtk_message_dialog_get_message_area);
- XG_DEFINE_PROCEDURE(gtk_table_get_size, gxg_gtk_table_get_size_w, 1, 2, 0, H_gtk_table_get_size);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_length, gxg_gtk_selection_data_get_length_w, 1, 0, 0, H_gtk_selection_data_get_length);
- XG_DEFINE_PROCEDURE(gdk_pango_layout_line_get_clip_region, gxg_gdk_pango_layout_line_get_clip_region_w, 5, 0, 0, H_gdk_pango_layout_line_get_clip_region);
- XG_DEFINE_PROCEDURE(gdk_pango_layout_get_clip_region, gxg_gdk_pango_layout_get_clip_region_w, 5, 0, 0, H_gdk_pango_layout_get_clip_region);
- XG_DEFINE_PROCEDURE(gdk_window_shape_combine_region, gxg_gdk_window_shape_combine_region_w, 4, 0, 0, H_gdk_window_shape_combine_region);
- XG_DEFINE_PROCEDURE(gdk_window_invalidate_region, gxg_gdk_window_invalidate_region_w, 3, 0, 0, H_gdk_window_invalidate_region);
- XG_DEFINE_PROCEDURE(gdk_window_get_update_area, gxg_gdk_window_get_update_area_w, 1, 0, 0, H_gdk_window_get_update_area);
- XG_DEFINE_PROCEDURE(gdk_window_begin_paint_region, gxg_gdk_window_begin_paint_region_w, 2, 0, 0, H_gdk_window_begin_paint_region);
- XG_DEFINE_PROCEDURE(gtk_widget_region_intersect, gxg_gtk_widget_region_intersect_w, 2, 0, 0, H_gtk_widget_region_intersect);
- XG_DEFINE_PROCEDURE(gdk_window_move_region, gxg_gdk_window_move_region_w, 4, 0, 0, H_gdk_window_move_region);
- XG_DEFINE_PROCEDURE(gdk_keymap_get_num_lock_state, gxg_gdk_keymap_get_num_lock_state_w, 1, 0, 0, H_gdk_keymap_get_num_lock_state);
- XG_DEFINE_PROCEDURE(gdk_window_has_native, gxg_gdk_window_has_native_w, 1, 0, 0, H_gdk_window_has_native);
- XG_DEFINE_PROCEDURE(gdk_cursor_get_cursor_type, gxg_gdk_cursor_get_cursor_type_w, 1, 0, 0, H_gdk_cursor_get_cursor_type);
- XG_DEFINE_PROCEDURE(gdk_display_is_closed, gxg_gdk_display_is_closed_w, 1, 0, 0, H_gdk_display_is_closed);
- XG_DEFINE_PROCEDURE(gdk_window_get_background_pattern, gxg_gdk_window_get_background_pattern_w, 1, 0, 0, H_gdk_window_get_background_pattern);
- XG_DEFINE_PROCEDURE(gdk_window_create_similar_surface, gxg_gdk_window_create_similar_surface_w, 4, 0, 0, H_gdk_window_create_similar_surface);
- XG_DEFINE_PROCEDURE(gtk_expander_set_label_fill, gxg_gtk_expander_set_label_fill_w, 2, 0, 0, H_gtk_expander_set_label_fill);
- XG_DEFINE_PROCEDURE(gtk_expander_get_label_fill, gxg_gtk_expander_get_label_fill_w, 1, 0, 0, H_gtk_expander_get_label_fill);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_tab_hborder, gxg_gtk_notebook_get_tab_hborder_w, 1, 0, 0, H_gtk_notebook_get_tab_hborder);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_tab_vborder, gxg_gtk_notebook_get_tab_vborder_w, 1, 0, 0, H_gtk_notebook_get_tab_vborder);
- XG_DEFINE_PROCEDURE(gtk_calendar_get_day_is_marked, gxg_gtk_calendar_get_day_is_marked_w, 2, 0, 0, H_gtk_calendar_get_day_is_marked);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_set_inverted, gxg_gtk_progress_bar_set_inverted_w, 2, 0, 0, H_gtk_progress_bar_set_inverted);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_get_inverted, gxg_gtk_progress_bar_get_inverted_w, 1, 0, 0, H_gtk_progress_bar_get_inverted);
- XG_DEFINE_PROCEDURE(gtk_radio_button_join_group, gxg_gtk_radio_button_join_group_w, 2, 0, 0, H_gtk_radio_button_join_group);
- XG_DEFINE_PROCEDURE(gtk_adjustment_new, gxg_gtk_adjustment_new_w, 6, 0, 0, H_gtk_adjustment_new);
- XG_DEFINE_PROCEDURE(gtk_binding_set_activate, gxg_gtk_binding_set_activate_w, 4, 0, 0, H_gtk_binding_set_activate);
- XG_DEFINE_PROCEDURE(gtk_bindings_activate, gxg_gtk_bindings_activate_w, 3, 0, 0, H_gtk_bindings_activate);
- XG_DEFINE_PROCEDURE(gtk_icon_view_create_drag_icon, gxg_gtk_icon_view_create_drag_icon_w, 2, 0, 0, H_gtk_icon_view_create_drag_icon);
- XG_DEFINE_PROCEDURE(gtk_tree_view_create_row_drag_icon, gxg_gtk_tree_view_create_row_drag_icon_w, 2, 0, 0, H_gtk_tree_view_create_row_drag_icon);
- XG_DEFINE_PROCEDURE(gdk_cairo_get_clip_rectangle, gxg_gdk_cairo_get_clip_rectangle_w, 2, 0, 0, H_gdk_cairo_get_clip_rectangle);
- XG_DEFINE_PROCEDURE(gdk_cairo_region_create_from_surface, gxg_gdk_cairo_region_create_from_surface_w, 1, 0, 0, H_gdk_cairo_region_create_from_surface);
- XG_DEFINE_PROCEDURE(gdk_window_get_visual, gxg_gdk_window_get_visual_w, 1, 0, 0, H_gdk_window_get_visual);
- XG_DEFINE_PROCEDURE(gdk_window_get_screen, gxg_gdk_window_get_screen_w, 1, 0, 0, H_gdk_window_get_screen);
- XG_DEFINE_PROCEDURE(gdk_window_get_display, gxg_gdk_window_get_display_w, 1, 0, 0, H_gdk_window_get_display);
- XG_DEFINE_PROCEDURE(gdk_window_get_width, gxg_gdk_window_get_width_w, 1, 0, 0, H_gdk_window_get_width);
- XG_DEFINE_PROCEDURE(gdk_window_get_height, gxg_gdk_window_get_height_w, 1, 0, 0, H_gdk_window_get_height);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_request_mode, gxg_gtk_cell_renderer_get_request_mode_w, 1, 0, 0, H_gtk_cell_renderer_get_request_mode);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_preferred_width, gxg_gtk_cell_renderer_get_preferred_width_w, 2, 2, 0, H_gtk_cell_renderer_get_preferred_width);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_preferred_height_for_width, gxg_gtk_cell_renderer_get_preferred_height_for_width_w, 3, 2, 0, H_gtk_cell_renderer_get_preferred_height_for_width);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_preferred_height, gxg_gtk_cell_renderer_get_preferred_height_w, 2, 2, 0, H_gtk_cell_renderer_get_preferred_height);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_preferred_width_for_height, gxg_gtk_cell_renderer_get_preferred_width_for_height_w, 3, 2, 0, H_gtk_cell_renderer_get_preferred_width_for_height);
- XG_DEFINE_PROCEDURE(gtk_container_class_handle_border_width, gxg_gtk_container_class_handle_border_width_w, 1, 0, 0, H_gtk_container_class_handle_border_width);
- XG_DEFINE_PROCEDURE(gtk_drag_set_icon_surface, gxg_gtk_drag_set_icon_surface_w, 2, 0, 0, H_gtk_drag_set_icon_surface);
- XG_DEFINE_PROCEDURE(gtk_notebook_set_group_name, gxg_gtk_notebook_set_group_name_w, 2, 0, 0, H_gtk_notebook_set_group_name);
- XG_DEFINE_PROCEDURE(gtk_notebook_get_group_name, gxg_gtk_notebook_get_group_name_w, 1, 0, 0, H_gtk_notebook_get_group_name);
- XG_DEFINE_PROCEDURE(gtk_widget_draw, gxg_gtk_widget_draw_w, 2, 0, 0, H_gtk_widget_draw);
- XG_DEFINE_PROCEDURE(gtk_widget_get_request_mode, gxg_gtk_widget_get_request_mode_w, 1, 0, 0, H_gtk_widget_get_request_mode);
- XG_DEFINE_PROCEDURE(gtk_widget_get_preferred_width, gxg_gtk_widget_get_preferred_width_w, 1, 2, 0, H_gtk_widget_get_preferred_width);
- XG_DEFINE_PROCEDURE(gtk_widget_get_preferred_height_for_width, gxg_gtk_widget_get_preferred_height_for_width_w, 2, 2, 0, H_gtk_widget_get_preferred_height_for_width);
- XG_DEFINE_PROCEDURE(gtk_widget_get_preferred_height, gxg_gtk_widget_get_preferred_height_w, 1, 2, 0, H_gtk_widget_get_preferred_height);
- XG_DEFINE_PROCEDURE(gtk_widget_get_preferred_width_for_height, gxg_gtk_widget_get_preferred_width_for_height_w, 2, 2, 0, H_gtk_widget_get_preferred_width_for_height);
- XG_DEFINE_PROCEDURE(gtk_widget_get_allocated_width, gxg_gtk_widget_get_allocated_width_w, 1, 0, 0, H_gtk_widget_get_allocated_width);
- XG_DEFINE_PROCEDURE(gtk_widget_get_allocated_height, gxg_gtk_widget_get_allocated_height_w, 1, 0, 0, H_gtk_widget_get_allocated_height);
- XG_DEFINE_PROCEDURE(gtk_widget_set_visual, gxg_gtk_widget_set_visual_w, 2, 0, 0, H_gtk_widget_set_visual);
- XG_DEFINE_PROCEDURE(gtk_widget_get_halign, gxg_gtk_widget_get_halign_w, 1, 0, 0, H_gtk_widget_get_halign);
- XG_DEFINE_PROCEDURE(gtk_widget_set_halign, gxg_gtk_widget_set_halign_w, 2, 0, 0, H_gtk_widget_set_halign);
- XG_DEFINE_PROCEDURE(gtk_widget_get_valign, gxg_gtk_widget_get_valign_w, 1, 0, 0, H_gtk_widget_get_valign);
- XG_DEFINE_PROCEDURE(gtk_widget_set_valign, gxg_gtk_widget_set_valign_w, 2, 0, 0, H_gtk_widget_set_valign);
- XG_DEFINE_PROCEDURE(gtk_widget_get_margin_left, gxg_gtk_widget_get_margin_left_w, 1, 0, 0, H_gtk_widget_get_margin_left);
- XG_DEFINE_PROCEDURE(gtk_widget_set_margin_left, gxg_gtk_widget_set_margin_left_w, 2, 0, 0, H_gtk_widget_set_margin_left);
- XG_DEFINE_PROCEDURE(gtk_widget_get_margin_right, gxg_gtk_widget_get_margin_right_w, 1, 0, 0, H_gtk_widget_get_margin_right);
- XG_DEFINE_PROCEDURE(gtk_widget_set_margin_right, gxg_gtk_widget_set_margin_right_w, 2, 0, 0, H_gtk_widget_set_margin_right);
- XG_DEFINE_PROCEDURE(gtk_widget_get_margin_top, gxg_gtk_widget_get_margin_top_w, 1, 0, 0, H_gtk_widget_get_margin_top);
- XG_DEFINE_PROCEDURE(gtk_widget_set_margin_top, gxg_gtk_widget_set_margin_top_w, 2, 0, 0, H_gtk_widget_set_margin_top);
- XG_DEFINE_PROCEDURE(gtk_widget_get_margin_bottom, gxg_gtk_widget_get_margin_bottom_w, 1, 0, 0, H_gtk_widget_get_margin_bottom);
- XG_DEFINE_PROCEDURE(gtk_widget_set_margin_bottom, gxg_gtk_widget_set_margin_bottom_w, 2, 0, 0, H_gtk_widget_set_margin_bottom);
- XG_DEFINE_PROCEDURE(gtk_widget_shape_combine_region, gxg_gtk_widget_shape_combine_region_w, 2, 0, 0, H_gtk_widget_shape_combine_region);
- XG_DEFINE_PROCEDURE(gtk_widget_input_shape_combine_region, gxg_gtk_widget_input_shape_combine_region_w, 2, 0, 0, H_gtk_widget_input_shape_combine_region);
- XG_DEFINE_PROCEDURE(gtk_cairo_should_draw_window, gxg_gtk_cairo_should_draw_window_w, 2, 0, 0, H_gtk_cairo_should_draw_window);
- XG_DEFINE_PROCEDURE(gtk_cairo_transform_to_window, gxg_gtk_cairo_transform_to_window_w, 3, 0, 0, H_gtk_cairo_transform_to_window);
- XG_DEFINE_PROCEDURE(gtk_combo_box_new_with_entry, gxg_gtk_combo_box_new_with_entry_w, 0, 0, 0, H_gtk_combo_box_new_with_entry);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_has_entry, gxg_gtk_combo_box_get_has_entry_w, 1, 0, 0, H_gtk_combo_box_get_has_entry);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_entry_text_column, gxg_gtk_combo_box_set_entry_text_column_w, 2, 0, 0, H_gtk_combo_box_set_entry_text_column);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_entry_text_column, gxg_gtk_combo_box_get_entry_text_column_w, 1, 0, 0, H_gtk_combo_box_get_entry_text_column);
- XG_DEFINE_PROCEDURE(gtk_target_entry_new, gxg_gtk_target_entry_new_w, 3, 0, 0, H_gtk_target_entry_new);
- XG_DEFINE_PROCEDURE(gtk_target_entry_copy, gxg_gtk_target_entry_copy_w, 1, 0, 0, H_gtk_target_entry_copy);
- XG_DEFINE_PROCEDURE(gtk_target_entry_free, gxg_gtk_target_entry_free_w, 1, 0, 0, H_gtk_target_entry_free);
- XG_DEFINE_PROCEDURE(gtk_widget_get_hexpand, gxg_gtk_widget_get_hexpand_w, 1, 0, 0, H_gtk_widget_get_hexpand);
- XG_DEFINE_PROCEDURE(gtk_widget_set_hexpand, gxg_gtk_widget_set_hexpand_w, 2, 0, 0, H_gtk_widget_set_hexpand);
- XG_DEFINE_PROCEDURE(gtk_widget_get_hexpand_set, gxg_gtk_widget_get_hexpand_set_w, 1, 0, 0, H_gtk_widget_get_hexpand_set);
- XG_DEFINE_PROCEDURE(gtk_widget_set_hexpand_set, gxg_gtk_widget_set_hexpand_set_w, 2, 0, 0, H_gtk_widget_set_hexpand_set);
- XG_DEFINE_PROCEDURE(gtk_widget_get_vexpand, gxg_gtk_widget_get_vexpand_w, 1, 0, 0, H_gtk_widget_get_vexpand);
- XG_DEFINE_PROCEDURE(gtk_widget_set_vexpand, gxg_gtk_widget_set_vexpand_w, 2, 0, 0, H_gtk_widget_set_vexpand);
- XG_DEFINE_PROCEDURE(gtk_widget_get_vexpand_set, gxg_gtk_widget_get_vexpand_set_w, 1, 0, 0, H_gtk_widget_get_vexpand_set);
- XG_DEFINE_PROCEDURE(gtk_widget_set_vexpand_set, gxg_gtk_widget_set_vexpand_set_w, 2, 0, 0, H_gtk_widget_set_vexpand_set);
- XG_DEFINE_PROCEDURE(gtk_widget_queue_compute_expand, gxg_gtk_widget_queue_compute_expand_w, 1, 0, 0, H_gtk_widget_queue_compute_expand);
- XG_DEFINE_PROCEDURE(gtk_widget_compute_expand, gxg_gtk_widget_compute_expand_w, 2, 0, 0, H_gtk_widget_compute_expand);
- XG_DEFINE_PROCEDURE(gtk_window_set_default_geometry, gxg_gtk_window_set_default_geometry_w, 3, 0, 0, H_gtk_window_set_default_geometry);
- XG_DEFINE_PROCEDURE(gtk_window_resize_to_geometry, gxg_gtk_window_resize_to_geometry_w, 3, 0, 0, H_gtk_window_resize_to_geometry);
- XG_DEFINE_PROCEDURE(gtk_window_set_has_resize_grip, gxg_gtk_window_set_has_resize_grip_w, 2, 0, 0, H_gtk_window_set_has_resize_grip);
- XG_DEFINE_PROCEDURE(gtk_window_get_has_resize_grip, gxg_gtk_window_get_has_resize_grip_w, 1, 0, 0, H_gtk_window_get_has_resize_grip);
- XG_DEFINE_PROCEDURE(gtk_window_resize_grip_is_visible, gxg_gtk_window_resize_grip_is_visible_w, 1, 0, 0, H_gtk_window_resize_grip_is_visible);
- XG_DEFINE_PROCEDURE(gtk_window_get_resize_grip_area, gxg_gtk_window_get_resize_grip_area_w, 2, 0, 0, H_gtk_window_get_resize_grip_area);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_new, gxg_gtk_combo_box_text_new_w, 0, 0, 0, H_gtk_combo_box_text_new);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_new_with_entry, gxg_gtk_combo_box_text_new_with_entry_w, 0, 0, 0, H_gtk_combo_box_text_new_with_entry);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_append_text, gxg_gtk_combo_box_text_append_text_w, 2, 0, 0, H_gtk_combo_box_text_append_text);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_insert_text, gxg_gtk_combo_box_text_insert_text_w, 3, 0, 0, H_gtk_combo_box_text_insert_text);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_prepend_text, gxg_gtk_combo_box_text_prepend_text_w, 2, 0, 0, H_gtk_combo_box_text_prepend_text);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_remove, gxg_gtk_combo_box_text_remove_w, 2, 0, 0, H_gtk_combo_box_text_remove);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_get_active_text, gxg_gtk_combo_box_text_get_active_text_w, 1, 0, 0, H_gtk_combo_box_text_get_active_text);
- XG_DEFINE_PROCEDURE(gdk_cairo_set_source_rgba, gxg_gdk_cairo_set_source_rgba_w, 2, 0, 0, H_gdk_cairo_set_source_rgba);
- XG_DEFINE_PROCEDURE(gdk_window_set_background_rgba, gxg_gdk_window_set_background_rgba_w, 2, 0, 0, H_gdk_window_set_background_rgba);
- XG_DEFINE_PROCEDURE(gtk_cell_view_set_background_rgba, gxg_gtk_cell_view_set_background_rgba_w, 2, 0, 0, H_gtk_cell_view_set_background_rgba);
- XG_DEFINE_PROCEDURE(gtk_color_button_new_with_rgba, gxg_gtk_color_button_new_with_rgba_w, 1, 0, 0, H_gtk_color_button_new_with_rgba);
- XG_DEFINE_PROCEDURE(gtk_color_button_set_rgba, gxg_gtk_color_button_set_rgba_w, 2, 0, 0, H_gtk_color_button_set_rgba);
- XG_DEFINE_PROCEDURE(gtk_color_selection_set_current_rgba, gxg_gtk_color_selection_set_current_rgba_w, 2, 0, 0, H_gtk_color_selection_set_current_rgba);
- XG_DEFINE_PROCEDURE(gtk_color_selection_set_previous_rgba, gxg_gtk_color_selection_set_previous_rgba_w, 2, 0, 0, H_gtk_color_selection_set_previous_rgba);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_remove_all, gxg_gtk_combo_box_text_remove_all_w, 1, 0, 0, H_gtk_combo_box_text_remove_all);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_popup_fixed_width, gxg_gtk_combo_box_set_popup_fixed_width_w, 2, 0, 0, H_gtk_combo_box_set_popup_fixed_width);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_popup_fixed_width, gxg_gtk_combo_box_get_popup_fixed_width_w, 1, 0, 0, H_gtk_combo_box_get_popup_fixed_width);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_min_content_width, gxg_gtk_scrolled_window_get_min_content_width_w, 1, 0, 0, H_gtk_scrolled_window_get_min_content_width);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_set_min_content_width, gxg_gtk_scrolled_window_set_min_content_width_w, 2, 0, 0, H_gtk_scrolled_window_set_min_content_width);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_get_min_content_height, gxg_gtk_scrolled_window_get_min_content_height_w, 1, 0, 0, H_gtk_scrolled_window_get_min_content_height);
- XG_DEFINE_PROCEDURE(gtk_scrolled_window_set_min_content_height, gxg_gtk_scrolled_window_set_min_content_height_w, 2, 0, 0, H_gtk_scrolled_window_set_min_content_height);
- XG_DEFINE_PROCEDURE(gtk_grid_new, gxg_gtk_grid_new_w, 0, 0, 0, H_gtk_grid_new);
- XG_DEFINE_PROCEDURE(gtk_grid_attach, gxg_gtk_grid_attach_w, 6, 0, 0, H_gtk_grid_attach);
- XG_DEFINE_PROCEDURE(gtk_grid_attach_next_to, gxg_gtk_grid_attach_next_to_w, 6, 0, 0, H_gtk_grid_attach_next_to);
- XG_DEFINE_PROCEDURE(gtk_grid_set_row_homogeneous, gxg_gtk_grid_set_row_homogeneous_w, 2, 0, 0, H_gtk_grid_set_row_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_grid_get_row_homogeneous, gxg_gtk_grid_get_row_homogeneous_w, 1, 0, 0, H_gtk_grid_get_row_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_grid_set_row_spacing, gxg_gtk_grid_set_row_spacing_w, 2, 0, 0, H_gtk_grid_set_row_spacing);
- XG_DEFINE_PROCEDURE(gtk_grid_get_row_spacing, gxg_gtk_grid_get_row_spacing_w, 1, 0, 0, H_gtk_grid_get_row_spacing);
- XG_DEFINE_PROCEDURE(gtk_grid_set_column_homogeneous, gxg_gtk_grid_set_column_homogeneous_w, 2, 0, 0, H_gtk_grid_set_column_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_grid_get_column_homogeneous, gxg_gtk_grid_get_column_homogeneous_w, 1, 0, 0, H_gtk_grid_get_column_homogeneous);
- XG_DEFINE_PROCEDURE(gtk_grid_set_column_spacing, gxg_gtk_grid_set_column_spacing_w, 2, 0, 0, H_gtk_grid_set_column_spacing);
- XG_DEFINE_PROCEDURE(gtk_grid_get_column_spacing, gxg_gtk_grid_get_column_spacing_w, 1, 0, 0, H_gtk_grid_get_column_spacing);
- XG_DEFINE_PROCEDURE(gtk_scrollable_get_hadjustment, gxg_gtk_scrollable_get_hadjustment_w, 1, 0, 0, H_gtk_scrollable_get_hadjustment);
- XG_DEFINE_PROCEDURE(gtk_scrollable_set_hadjustment, gxg_gtk_scrollable_set_hadjustment_w, 2, 0, 0, H_gtk_scrollable_set_hadjustment);
- XG_DEFINE_PROCEDURE(gtk_scrollable_get_vadjustment, gxg_gtk_scrollable_get_vadjustment_w, 1, 0, 0, H_gtk_scrollable_get_vadjustment);
- XG_DEFINE_PROCEDURE(gtk_scrollable_set_vadjustment, gxg_gtk_scrollable_set_vadjustment_w, 2, 0, 0, H_gtk_scrollable_set_vadjustment);
- XG_DEFINE_PROCEDURE(gtk_assistant_next_page, gxg_gtk_assistant_next_page_w, 1, 0, 0, H_gtk_assistant_next_page);
- XG_DEFINE_PROCEDURE(gtk_assistant_previous_page, gxg_gtk_assistant_previous_page_w, 1, 0, 0, H_gtk_assistant_previous_page);
- XG_DEFINE_PROCEDURE(gtk_combo_box_new_with_model_and_entry, gxg_gtk_combo_box_new_with_model_and_entry_w, 1, 0, 0, H_gtk_combo_box_new_with_model_and_entry);
- XG_DEFINE_PROCEDURE(gtk_scrollable_get_hscroll_policy, gxg_gtk_scrollable_get_hscroll_policy_w, 1, 0, 0, H_gtk_scrollable_get_hscroll_policy);
- XG_DEFINE_PROCEDURE(gtk_scrollable_set_hscroll_policy, gxg_gtk_scrollable_set_hscroll_policy_w, 2, 0, 0, H_gtk_scrollable_set_hscroll_policy);
- XG_DEFINE_PROCEDURE(gtk_scrollable_get_vscroll_policy, gxg_gtk_scrollable_get_vscroll_policy_w, 1, 0, 0, H_gtk_scrollable_get_vscroll_policy);
- XG_DEFINE_PROCEDURE(gtk_scrollable_set_vscroll_policy, gxg_gtk_scrollable_set_vscroll_policy_w, 2, 0, 0, H_gtk_scrollable_set_vscroll_policy);
- XG_DEFINE_PROCEDURE(gtk_switch_new, gxg_gtk_switch_new_w, 0, 0, 0, H_gtk_switch_new);
- XG_DEFINE_PROCEDURE(gtk_switch_set_active, gxg_gtk_switch_set_active_w, 2, 0, 0, H_gtk_switch_set_active);
- XG_DEFINE_PROCEDURE(gtk_switch_get_active, gxg_gtk_switch_get_active_w, 1, 0, 0, H_gtk_switch_get_active);
- XG_DEFINE_PROCEDURE(gdk_window_get_clip_region, gxg_gdk_window_get_clip_region_w, 1, 0, 0, H_gdk_window_get_clip_region);
- XG_DEFINE_PROCEDURE(gdk_window_get_visible_region, gxg_gdk_window_get_visible_region_w, 1, 0, 0, H_gdk_window_get_visible_region);
- XG_DEFINE_PROCEDURE(gtk_border_new, gxg_gtk_border_new_w, 0, 0, 0, H_gtk_border_new);
- XG_DEFINE_PROCEDURE(gtk_border_copy, gxg_gtk_border_copy_w, 1, 0, 0, H_gtk_border_copy);
- XG_DEFINE_PROCEDURE(gtk_border_free, gxg_gtk_border_free_w, 1, 0, 0, H_gtk_border_free);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_id_column, gxg_gtk_combo_box_get_id_column_w, 1, 0, 0, H_gtk_combo_box_get_id_column);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_id_column, gxg_gtk_combo_box_set_id_column_w, 2, 0, 0, H_gtk_combo_box_set_id_column);
- XG_DEFINE_PROCEDURE(gtk_combo_box_get_active_id, gxg_gtk_combo_box_get_active_id_w, 1, 0, 0, H_gtk_combo_box_get_active_id);
- XG_DEFINE_PROCEDURE(gtk_combo_box_set_active_id, gxg_gtk_combo_box_set_active_id_w, 2, 0, 0, H_gtk_combo_box_set_active_id);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_insert, gxg_gtk_combo_box_text_insert_w, 4, 0, 0, H_gtk_combo_box_text_insert);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_append, gxg_gtk_combo_box_text_append_w, 3, 0, 0, H_gtk_combo_box_text_append);
- XG_DEFINE_PROCEDURE(gtk_combo_box_text_prepend, gxg_gtk_combo_box_text_prepend_w, 3, 0, 0, H_gtk_combo_box_text_prepend);
- XG_DEFINE_PROCEDURE(gtk_button_box_new, gxg_gtk_button_box_new_w, 1, 0, 0, H_gtk_button_box_new);
- XG_DEFINE_PROCEDURE(gtk_box_new, gxg_gtk_box_new_w, 2, 0, 0, H_gtk_box_new);
- XG_DEFINE_PROCEDURE(gtk_activatable_sync_action_properties, gxg_gtk_activatable_sync_action_properties_w, 2, 0, 0, H_gtk_activatable_sync_action_properties);
- XG_DEFINE_PROCEDURE(gtk_activatable_set_related_action, gxg_gtk_activatable_set_related_action_w, 2, 0, 0, H_gtk_activatable_set_related_action);
- XG_DEFINE_PROCEDURE(gtk_activatable_get_related_action, gxg_gtk_activatable_get_related_action_w, 1, 0, 0, H_gtk_activatable_get_related_action);
- XG_DEFINE_PROCEDURE(gtk_activatable_set_use_action_appearance, gxg_gtk_activatable_set_use_action_appearance_w, 2, 0, 0, H_gtk_activatable_set_use_action_appearance);
- XG_DEFINE_PROCEDURE(gtk_activatable_get_use_action_appearance, gxg_gtk_activatable_get_use_action_appearance_w, 1, 0, 0, H_gtk_activatable_get_use_action_appearance);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_cursor_on_cell, gxg_gtk_tree_view_set_cursor_on_cell_w, 5, 0, 0, H_gtk_tree_view_set_cursor_on_cell);
- XG_DEFINE_PROCEDURE(gtk_tree_view_set_rubber_banding, gxg_gtk_tree_view_set_rubber_banding_w, 2, 0, 0, H_gtk_tree_view_set_rubber_banding);
- XG_DEFINE_PROCEDURE(gtk_tree_view_get_rubber_banding, gxg_gtk_tree_view_get_rubber_banding_w, 1, 0, 0, H_gtk_tree_view_get_rubber_banding);
- XG_DEFINE_PROCEDURE(gtk_tooltip_set_markup, gxg_gtk_tooltip_set_markup_w, 2, 0, 0, H_gtk_tooltip_set_markup);
- XG_DEFINE_PROCEDURE(gtk_tooltip_set_icon, gxg_gtk_tooltip_set_icon_w, 2, 0, 0, H_gtk_tooltip_set_icon);
- XG_DEFINE_PROCEDURE(gtk_tooltip_set_icon_from_stock, gxg_gtk_tooltip_set_icon_from_stock_w, 3, 0, 0, H_gtk_tooltip_set_icon_from_stock);
- XG_DEFINE_PROCEDURE(gtk_tooltip_set_custom, gxg_gtk_tooltip_set_custom_w, 2, 0, 0, H_gtk_tooltip_set_custom);
- XG_DEFINE_PROCEDURE(gtk_tooltip_trigger_tooltip_query, gxg_gtk_tooltip_trigger_tooltip_query_w, 1, 0, 0, H_gtk_tooltip_trigger_tooltip_query);
- XG_DEFINE_PROCEDURE(gtk_button_set_image_position, gxg_gtk_button_set_image_position_w, 2, 0, 0, H_gtk_button_set_image_position);
- XG_DEFINE_PROCEDURE(gtk_button_get_image_position, gxg_gtk_button_get_image_position_w, 1, 0, 0, H_gtk_button_get_image_position);
- XG_DEFINE_PROCEDURE(gtk_show_uri, gxg_gtk_show_uri_w, 3, 1, 0, H_gtk_show_uri);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_new_with_area, gxg_gtk_tree_view_column_new_with_area_w, 1, 0, 0, H_gtk_tree_view_column_new_with_area);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_get_button, gxg_gtk_tree_view_column_get_button_w, 1, 0, 0, H_gtk_tree_view_column_get_button);
- XG_DEFINE_PROCEDURE(gtk_tree_view_column_focus_cell, gxg_gtk_tree_view_column_focus_cell_w, 2, 0, 0, H_gtk_tree_view_column_focus_cell);
- XG_DEFINE_PROCEDURE(gtk_clipboard_wait_is_uris_available, gxg_gtk_clipboard_wait_is_uris_available_w, 1, 0, 0, H_gtk_clipboard_wait_is_uris_available);
- XG_DEFINE_PROCEDURE(gtk_toolbar_set_drop_highlight_item, gxg_gtk_toolbar_set_drop_highlight_item_w, 3, 0, 0, H_gtk_toolbar_set_drop_highlight_item);
- XG_DEFINE_PROCEDURE(gtk_tool_item_toolbar_reconfigured, gxg_gtk_tool_item_toolbar_reconfigured_w, 1, 0, 0, H_gtk_tool_item_toolbar_reconfigured);
- XG_DEFINE_PROCEDURE(gtk_orientable_set_orientation, gxg_gtk_orientable_set_orientation_w, 2, 0, 0, H_gtk_orientable_set_orientation);
- XG_DEFINE_PROCEDURE(gtk_orientable_get_orientation, gxg_gtk_orientable_get_orientation_w, 1, 0, 0, H_gtk_orientable_get_orientation);
- XG_DEFINE_PROCEDURE(gtk_parse_args, gxg_gtk_parse_args_w, 0, 2, 0, H_gtk_parse_args);
- XG_DEFINE_PROCEDURE(gtk_get_major_version, gxg_gtk_get_major_version_w, 0, 0, 0, H_gtk_get_major_version);
- XG_DEFINE_PROCEDURE(gtk_get_minor_version, gxg_gtk_get_minor_version_w, 0, 0, 0, H_gtk_get_minor_version);
- XG_DEFINE_PROCEDURE(gtk_get_micro_version, gxg_gtk_get_micro_version_w, 0, 0, 0, H_gtk_get_micro_version);
- XG_DEFINE_PROCEDURE(gtk_get_binary_age, gxg_gtk_get_binary_age_w, 0, 0, 0, H_gtk_get_binary_age);
- XG_DEFINE_PROCEDURE(gtk_get_interface_age, gxg_gtk_get_interface_age_w, 0, 0, 0, H_gtk_get_interface_age);
- XG_DEFINE_PROCEDURE(gtk_image_new_from_gicon, gxg_gtk_image_new_from_gicon_w, 2, 0, 0, H_gtk_image_new_from_gicon);
- XG_DEFINE_PROCEDURE(gtk_image_set_from_gicon, gxg_gtk_image_set_from_gicon_w, 3, 0, 0, H_gtk_image_set_from_gicon);
- XG_DEFINE_PROCEDURE(gtk_image_get_gicon, gxg_gtk_image_get_gicon_w, 1, 2, 0, H_gtk_image_get_gicon);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_set_show_text, gxg_gtk_progress_bar_set_show_text_w, 2, 0, 0, H_gtk_progress_bar_set_show_text);
- XG_DEFINE_PROCEDURE(gtk_progress_bar_get_show_text, gxg_gtk_progress_bar_get_show_text_w, 1, 0, 0, H_gtk_progress_bar_get_show_text);
- XG_DEFINE_PROCEDURE(gtk_invisible_new_for_screen, gxg_gtk_invisible_new_for_screen_w, 1, 0, 0, H_gtk_invisible_new_for_screen);
- XG_DEFINE_PROCEDURE(gtk_invisible_set_screen, gxg_gtk_invisible_set_screen_w, 2, 0, 0, H_gtk_invisible_set_screen);
- XG_DEFINE_PROCEDURE(gtk_invisible_get_screen, gxg_gtk_invisible_get_screen_w, 1, 0, 0, H_gtk_invisible_get_screen);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_storage_type, gxg_gtk_entry_get_icon_storage_type_w, 2, 0, 0, H_gtk_entry_get_icon_storage_type);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_pixbuf, gxg_gtk_entry_get_icon_pixbuf_w, 2, 0, 0, H_gtk_entry_get_icon_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_stock, gxg_gtk_entry_get_icon_stock_w, 2, 0, 0, H_gtk_entry_get_icon_stock);
- XG_DEFINE_PROCEDURE(gtk_entry_get_icon_gicon, gxg_gtk_entry_get_icon_gicon_w, 2, 0, 0, H_gtk_entry_get_icon_gicon);
- XG_DEFINE_PROCEDURE(gtk_container_propagate_draw, gxg_gtk_container_propagate_draw_w, 3, 0, 0, H_gtk_container_propagate_draw);
- XG_DEFINE_PROCEDURE(gtk_container_set_focus_chain, gxg_gtk_container_set_focus_chain_w, 2, 0, 0, H_gtk_container_set_focus_chain);
- XG_DEFINE_PROCEDURE(gtk_container_get_focus_chain, gxg_gtk_container_get_focus_chain_w, 1, 1, 0, H_gtk_container_get_focus_chain);
- XG_DEFINE_PROCEDURE(gtk_container_unset_focus_chain, gxg_gtk_container_unset_focus_chain_w, 1, 0, 0, H_gtk_container_unset_focus_chain);
- XG_DEFINE_PROCEDURE(gtk_container_set_reallocate_redraws, gxg_gtk_container_set_reallocate_redraws_w, 2, 0, 0, H_gtk_container_set_reallocate_redraws);
- XG_DEFINE_PROCEDURE(gtk_container_set_focus_child, gxg_gtk_container_set_focus_child_w, 2, 0, 0, H_gtk_container_set_focus_child);
- XG_DEFINE_PROCEDURE(gtk_container_set_focus_vadjustment, gxg_gtk_container_set_focus_vadjustment_w, 2, 0, 0, H_gtk_container_set_focus_vadjustment);
- XG_DEFINE_PROCEDURE(gtk_container_get_focus_vadjustment, gxg_gtk_container_get_focus_vadjustment_w, 1, 0, 0, H_gtk_container_get_focus_vadjustment);
- XG_DEFINE_PROCEDURE(gtk_container_set_focus_hadjustment, gxg_gtk_container_set_focus_hadjustment_w, 2, 0, 0, H_gtk_container_set_focus_hadjustment);
- XG_DEFINE_PROCEDURE(gtk_container_get_focus_hadjustment, gxg_gtk_container_get_focus_hadjustment_w, 1, 0, 0, H_gtk_container_get_focus_hadjustment);
- XG_DEFINE_PROCEDURE(gtk_container_resize_children, gxg_gtk_container_resize_children_w, 1, 0, 0, H_gtk_container_resize_children);
- XG_DEFINE_PROCEDURE(gtk_assistant_commit, gxg_gtk_assistant_commit_w, 1, 0, 0, H_gtk_assistant_commit);
- XG_DEFINE_PROCEDURE(gtk_im_multicontext_get_context_id, gxg_gtk_im_multicontext_get_context_id_w, 1, 0, 0, H_gtk_im_multicontext_get_context_id);
- XG_DEFINE_PROCEDURE(gtk_im_multicontext_set_context_id, gxg_gtk_im_multicontext_set_context_id_w, 2, 0, 0, H_gtk_im_multicontext_set_context_id);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_set_license_type, gxg_gtk_about_dialog_set_license_type_w, 2, 0, 0, H_gtk_about_dialog_set_license_type);
- XG_DEFINE_PROCEDURE(gtk_about_dialog_get_license_type, gxg_gtk_about_dialog_get_license_type_w, 1, 0, 0, H_gtk_about_dialog_get_license_type);
- XG_DEFINE_PROCEDURE(gtk_window_set_skip_taskbar_hint, gxg_gtk_window_set_skip_taskbar_hint_w, 2, 0, 0, H_gtk_window_set_skip_taskbar_hint);
- XG_DEFINE_PROCEDURE(gtk_window_get_skip_taskbar_hint, gxg_gtk_window_get_skip_taskbar_hint_w, 1, 0, 0, H_gtk_window_get_skip_taskbar_hint);
- XG_DEFINE_PROCEDURE(gtk_window_set_skip_pager_hint, gxg_gtk_window_set_skip_pager_hint_w, 2, 0, 0, H_gtk_window_set_skip_pager_hint);
- XG_DEFINE_PROCEDURE(gtk_window_get_skip_pager_hint, gxg_gtk_window_get_skip_pager_hint_w, 1, 0, 0, H_gtk_window_get_skip_pager_hint);
- XG_DEFINE_PROCEDURE(gtk_window_set_screen, gxg_gtk_window_set_screen_w, 2, 0, 0, H_gtk_window_set_screen);
- XG_DEFINE_PROCEDURE(gtk_window_get_screen, gxg_gtk_window_get_screen_w, 1, 0, 0, H_gtk_window_get_screen);
- XG_DEFINE_PROCEDURE(gtk_window_set_icon_from_file, gxg_gtk_window_set_icon_from_file_w, 2, 1, 0, H_gtk_window_set_icon_from_file);
- XG_DEFINE_PROCEDURE(gtk_window_set_default_icon_from_file, gxg_gtk_window_set_default_icon_from_file_w, 1, 1, 0, H_gtk_window_set_default_icon_from_file);
- XG_DEFINE_PROCEDURE(gtk_window_fullscreen, gxg_gtk_window_fullscreen_w, 1, 0, 0, H_gtk_window_fullscreen);
- XG_DEFINE_PROCEDURE(gtk_window_unfullscreen, gxg_gtk_window_unfullscreen_w, 1, 0, 0, H_gtk_window_unfullscreen);
- XG_DEFINE_PROCEDURE(gtk_window_get_window_type, gxg_gtk_window_get_window_type_w, 1, 0, 0, H_gtk_window_get_window_type);
- XG_DEFINE_PROCEDURE(gtk_window_group_add_window, gxg_gtk_window_group_add_window_w, 2, 0, 0, H_gtk_window_group_add_window);
- XG_DEFINE_PROCEDURE(gtk_window_group_remove_window, gxg_gtk_window_group_remove_window_w, 2, 0, 0, H_gtk_window_group_remove_window);
- XG_DEFINE_PROCEDURE(gtk_window_group_new, gxg_gtk_window_group_new_w, 0, 0, 0, H_gtk_window_group_new);
- XG_DEFINE_PROCEDURE(gtk_window_get_group, gxg_gtk_window_get_group_w, 1, 0, 0, H_gtk_window_get_group);
- XG_DEFINE_PROCEDURE(gtk_window_group_list_windows, gxg_gtk_window_group_list_windows_w, 1, 0, 0, H_gtk_window_group_list_windows);
- XG_DEFINE_PROCEDURE(gtk_window_group_get_current_device_grab, gxg_gtk_window_group_get_current_device_grab_w, 2, 0, 0, H_gtk_window_group_get_current_device_grab);
- XG_DEFINE_PROCEDURE(gtk_window_group_get_current_grab, gxg_gtk_window_group_get_current_grab_w, 1, 0, 0, H_gtk_window_group_get_current_grab);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_data, gxg_gtk_selection_data_get_data_w, 1, 0, 0, H_gtk_selection_data_get_data);
- XG_DEFINE_PROCEDURE(gtk_selection_owner_set_for_display, gxg_gtk_selection_owner_set_for_display_w, 4, 0, 0, H_gtk_selection_owner_set_for_display);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_get_text_orientation, gxg_gtk_tool_shell_get_text_orientation_w, 1, 0, 0, H_gtk_tool_shell_get_text_orientation);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_get_text_alignment, gxg_gtk_tool_shell_get_text_alignment_w, 1, 0, 0, H_gtk_tool_shell_get_text_alignment);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_get_ellipsize_mode, gxg_gtk_tool_shell_get_ellipsize_mode_w, 1, 0, 0, H_gtk_tool_shell_get_ellipsize_mode);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_get_text_size_group, gxg_gtk_tool_shell_get_text_size_group_w, 1, 0, 0, H_gtk_tool_shell_get_text_size_group);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_get_icon_size, gxg_gtk_tool_shell_get_icon_size_w, 1, 0, 0, H_gtk_tool_shell_get_icon_size);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_get_orientation, gxg_gtk_tool_shell_get_orientation_w, 1, 0, 0, H_gtk_tool_shell_get_orientation);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_get_style, gxg_gtk_tool_shell_get_style_w, 1, 0, 0, H_gtk_tool_shell_get_style);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_get_relief_style, gxg_gtk_tool_shell_get_relief_style_w, 1, 0, 0, H_gtk_tool_shell_get_relief_style);
- XG_DEFINE_PROCEDURE(gtk_tool_shell_rebuild_menu, gxg_gtk_tool_shell_rebuild_menu_w, 1, 0, 0, H_gtk_tool_shell_rebuild_menu);
- XG_DEFINE_PROCEDURE(gtk_status_icon_new_from_gicon, gxg_gtk_status_icon_new_from_gicon_w, 1, 0, 0, H_gtk_status_icon_new_from_gicon);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_from_gicon, gxg_gtk_status_icon_set_from_gicon_w, 2, 0, 0, H_gtk_status_icon_set_from_gicon);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_gicon, gxg_gtk_status_icon_get_gicon_w, 1, 0, 0, H_gtk_status_icon_get_gicon);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_has_tooltip, gxg_gtk_status_icon_set_has_tooltip_w, 2, 0, 0, H_gtk_status_icon_set_has_tooltip);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_tooltip_text, gxg_gtk_status_icon_set_tooltip_text_w, 2, 0, 0, H_gtk_status_icon_set_tooltip_text);
- XG_DEFINE_PROCEDURE(gtk_status_icon_set_tooltip_markup, gxg_gtk_status_icon_set_tooltip_markup_w, 2, 0, 0, H_gtk_status_icon_set_tooltip_markup);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_has_tooltip, gxg_gtk_status_icon_get_has_tooltip_w, 1, 0, 0, H_gtk_status_icon_get_has_tooltip);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_tooltip_text, gxg_gtk_status_icon_get_tooltip_text_w, 1, 0, 0, H_gtk_status_icon_get_tooltip_text);
- XG_DEFINE_PROCEDURE(gtk_status_icon_get_tooltip_markup, gxg_gtk_status_icon_get_tooltip_markup_w, 1, 0, 0, H_gtk_status_icon_get_tooltip_markup);
- XG_DEFINE_PROCEDURE(gtk_accel_map_lock_path, gxg_gtk_accel_map_lock_path_w, 1, 0, 0, H_gtk_accel_map_lock_path);
- XG_DEFINE_PROCEDURE(gtk_accel_map_unlock_path, gxg_gtk_accel_map_unlock_path_w, 1, 0, 0, H_gtk_accel_map_unlock_path);
- XG_DEFINE_PROCEDURE(gtk_icon_theme_lookup_by_gicon, gxg_gtk_icon_theme_lookup_by_gicon_w, 4, 0, 0, H_gtk_icon_theme_lookup_by_gicon);
- XG_DEFINE_PROCEDURE(gtk_icon_info_new_for_pixbuf, gxg_gtk_icon_info_new_for_pixbuf_w, 2, 0, 0, H_gtk_icon_info_new_for_pixbuf);
- XG_DEFINE_PROCEDURE(gtk_icon_view_set_item_orientation, gxg_gtk_icon_view_set_item_orientation_w, 2, 0, 0, H_gtk_icon_view_set_item_orientation);
- XG_DEFINE_PROCEDURE(gtk_icon_view_get_item_orientation, gxg_gtk_icon_view_get_item_orientation_w, 1, 0, 0, H_gtk_icon_view_get_item_orientation);
- XG_DEFINE_PROCEDURE(gtk_text_view_im_context_filter_keypress, gxg_gtk_text_view_im_context_filter_keypress_w, 2, 0, 0, H_gtk_text_view_im_context_filter_keypress);
- XG_DEFINE_PROCEDURE(gtk_text_view_reset_im_context, gxg_gtk_text_view_reset_im_context_w, 1, 0, 0, H_gtk_text_view_reset_im_context);
- XG_DEFINE_PROCEDURE(gtk_action_get_accel_path, gxg_gtk_action_get_accel_path_w, 1, 0, 0, H_gtk_action_get_accel_path);
- XG_DEFINE_PROCEDURE(gtk_action_block_activate, gxg_gtk_action_block_activate_w, 1, 0, 0, H_gtk_action_block_activate);
- XG_DEFINE_PROCEDURE(gtk_action_unblock_activate, gxg_gtk_action_unblock_activate_w, 1, 0, 0, H_gtk_action_unblock_activate);
- XG_DEFINE_PROCEDURE(gtk_action_set_accel_path, gxg_gtk_action_set_accel_path_w, 2, 0, 0, H_gtk_action_set_accel_path);
- XG_DEFINE_PROCEDURE(gtk_action_set_accel_group, gxg_gtk_action_set_accel_group_w, 2, 0, 0, H_gtk_action_set_accel_group);
- XG_DEFINE_PROCEDURE(gdk_device_get_position, gxg_gdk_device_get_position_w, 2, 2, 0, H_gdk_device_get_position);
- XG_DEFINE_PROCEDURE(gdk_device_get_window_at_position, gxg_gdk_device_get_window_at_position_w, 1, 2, 0, H_gdk_device_get_window_at_position);
- XG_DEFINE_PROCEDURE(gtk_cell_view_get_draw_sensitive, gxg_gtk_cell_view_get_draw_sensitive_w, 1, 0, 0, H_gtk_cell_view_get_draw_sensitive);
- XG_DEFINE_PROCEDURE(gtk_cell_view_set_draw_sensitive, gxg_gtk_cell_view_set_draw_sensitive_w, 2, 0, 0, H_gtk_cell_view_set_draw_sensitive);
- XG_DEFINE_PROCEDURE(gtk_cell_view_get_fit_model, gxg_gtk_cell_view_get_fit_model_w, 1, 0, 0, H_gtk_cell_view_get_fit_model);
- XG_DEFINE_PROCEDURE(gtk_cell_view_set_fit_model, gxg_gtk_cell_view_set_fit_model_w, 2, 0, 0, H_gtk_cell_view_set_fit_model);
- XG_DEFINE_PROCEDURE(gtk_combo_box_new_with_area, gxg_gtk_combo_box_new_with_area_w, 1, 0, 0, H_gtk_combo_box_new_with_area);
- XG_DEFINE_PROCEDURE(gtk_combo_box_new_with_area_and_entry, gxg_gtk_combo_box_new_with_area_and_entry_w, 1, 0, 0, H_gtk_combo_box_new_with_area_and_entry);
- XG_DEFINE_PROCEDURE(gtk_icon_view_new_with_area, gxg_gtk_icon_view_new_with_area_w, 1, 0, 0, H_gtk_icon_view_new_with_area);
- XG_DEFINE_PROCEDURE(gtk_menu_item_set_reserve_indicator, gxg_gtk_menu_item_set_reserve_indicator_w, 2, 0, 0, H_gtk_menu_item_set_reserve_indicator);
- XG_DEFINE_PROCEDURE(gtk_menu_item_get_reserve_indicator, gxg_gtk_menu_item_get_reserve_indicator_w, 1, 0, 0, H_gtk_menu_item_get_reserve_indicator);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_get_selected_item, gxg_gtk_menu_shell_get_selected_item_w, 1, 0, 0, H_gtk_menu_shell_get_selected_item);
- XG_DEFINE_PROCEDURE(gtk_menu_shell_get_parent_shell, gxg_gtk_menu_shell_get_parent_shell_w, 1, 0, 0, H_gtk_menu_shell_get_parent_shell);
- XG_DEFINE_PROCEDURE(gtk_selection_data_get_data_with_length, gxg_gtk_selection_data_get_data_with_length_w, 1, 1, 0, H_gtk_selection_data_get_data_with_length);
- XG_DEFINE_PROCEDURE(gtk_tree_model_iter_previous, gxg_gtk_tree_model_iter_previous_w, 2, 0, 0, H_gtk_tree_model_iter_previous);
- XG_DEFINE_PROCEDURE(gtk_tree_view_is_blank_at_pos, gxg_gtk_tree_view_is_blank_at_pos_w, 3, 4, 0, H_gtk_tree_view_is_blank_at_pos);
- XG_DEFINE_PROCEDURE(gtk_widget_set_device_enabled, gxg_gtk_widget_set_device_enabled_w, 3, 0, 0, H_gtk_widget_set_device_enabled);
- XG_DEFINE_PROCEDURE(gtk_widget_get_device_enabled, gxg_gtk_widget_get_device_enabled_w, 2, 0, 0, H_gtk_widget_get_device_enabled);
- XG_DEFINE_PROCEDURE(gtk_window_set_has_user_ref_count, gxg_gtk_window_set_has_user_ref_count_w, 2, 0, 0, H_gtk_window_set_has_user_ref_count);
- XG_DEFINE_PROCEDURE(gdk_selection_send_notify, gxg_gdk_selection_send_notify_w, 5, 0, 0, H_gdk_selection_send_notify);
- XG_DEFINE_PROCEDURE(gdk_selection_send_notify_for_display, gxg_gdk_selection_send_notify_for_display_w, 6, 0, 0, H_gdk_selection_send_notify_for_display);
- XG_DEFINE_PROCEDURE(gdk_rgba_copy, gxg_gdk_rgba_copy_w, 1, 0, 0, H_gdk_rgba_copy);
- XG_DEFINE_PROCEDURE(gdk_rgba_free, gxg_gdk_rgba_free_w, 1, 0, 0, H_gdk_rgba_free);
- XG_DEFINE_PROCEDURE(gdk_rgba_parse, gxg_gdk_rgba_parse_w, 2, 0, 0, H_gdk_rgba_parse);
- XG_DEFINE_PROCEDURE(gdk_rgba_to_string, gxg_gdk_rgba_to_string_w, 1, 0, 0, H_gdk_rgba_to_string);
+#if GTK_CHECK_VERSION(3, 4, 0)
+ Xg_define_procedure(GTK_APPLICATION_WINDOW, gxg_GTK_APPLICATION_WINDOW_w, 1, 0, 0, "(GTK_APPLICATION_WINDOW obj) casts obj to GTK_APPLICATION_WINDOW", NULL);
+ Xg_define_procedure(GTK_COLOR_CHOOSER_DIALOG, gxg_GTK_COLOR_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_COLOR_CHOOSER_DIALOG obj) casts obj to GTK_COLOR_CHOOSER_DIALOG", NULL);
+ Xg_define_procedure(GTK_COLOR_CHOOSER_WIDGET, gxg_GTK_COLOR_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_COLOR_CHOOSER_WIDGET obj) casts obj to GTK_COLOR_CHOOSER_WIDGET", NULL);
#endif
-#if (!HAVE_GTK_3)
- XG_DEFINE_PROCEDURE(gdk_colormap_new, gxg_gdk_colormap_new_w, 2, 0, 0, H_gdk_colormap_new);
- XG_DEFINE_PROCEDURE(gdk_colormap_get_system, gxg_gdk_colormap_get_system_w, 0, 0, 0, H_gdk_colormap_get_system);
- XG_DEFINE_PROCEDURE(gdk_colormap_alloc_colors, gxg_gdk_colormap_alloc_colors_w, 5, 1, 0, H_gdk_colormap_alloc_colors);
- XG_DEFINE_PROCEDURE(gdk_colormap_alloc_color, gxg_gdk_colormap_alloc_color_w, 4, 0, 0, H_gdk_colormap_alloc_color);
- XG_DEFINE_PROCEDURE(gdk_colormap_get_visual, gxg_gdk_colormap_get_visual_w, 1, 0, 0, H_gdk_colormap_get_visual);
- XG_DEFINE_PROCEDURE(gdk_cursor_ref, gxg_gdk_cursor_ref_w, 1, 0, 0, H_gdk_cursor_ref);
- XG_DEFINE_PROCEDURE(gdk_cursor_unref, gxg_gdk_cursor_unref_w, 1, 0, 0, H_gdk_cursor_unref);
- XG_DEFINE_PROCEDURE(gdk_drag_context_new, gxg_gdk_drag_context_new_w, 0, 0, 0, H_gdk_drag_context_new);
- XG_DEFINE_PROCEDURE(gdk_drag_get_protocol, gxg_gdk_drag_get_protocol_w, 1, 1, 0, H_gdk_drag_get_protocol);
- XG_DEFINE_PROCEDURE(gdk_drag_find_window, gxg_gdk_drag_find_window_w, 4, 2, 0, H_gdk_drag_find_window);
- XG_DEFINE_PROCEDURE(gdk_drag_motion, gxg_gdk_drag_motion_w, 8, 0, 0, H_gdk_drag_motion);
- XG_DEFINE_PROCEDURE(gdk_cairo_create, gxg_gdk_cairo_create_w, 1, 0, 0, H_gdk_cairo_create);
- XG_DEFINE_PROCEDURE(gdk_drawable_get_size, gxg_gdk_drawable_get_size_w, 1, 2, 0, H_gdk_drawable_get_size);
- XG_DEFINE_PROCEDURE(gdk_drawable_set_colormap, gxg_gdk_drawable_set_colormap_w, 2, 0, 0, H_gdk_drawable_set_colormap);
- XG_DEFINE_PROCEDURE(gdk_drawable_get_colormap, gxg_gdk_drawable_get_colormap_w, 1, 0, 0, H_gdk_drawable_get_colormap);
- XG_DEFINE_PROCEDURE(gdk_drawable_get_visual, gxg_gdk_drawable_get_visual_w, 1, 0, 0, H_gdk_drawable_get_visual);
- XG_DEFINE_PROCEDURE(gdk_drawable_get_depth, gxg_gdk_drawable_get_depth_w, 1, 0, 0, H_gdk_drawable_get_depth);
- XG_DEFINE_PROCEDURE(gdk_set_locale, gxg_gdk_set_locale_w, 0, 0, 0, H_gdk_set_locale);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_render_threshold_alpha, gxg_gdk_pixbuf_render_threshold_alpha_w, 9, 0, 0, H_gdk_pixbuf_render_threshold_alpha);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_render_pixmap_and_mask_for_colormap, gxg_gdk_pixbuf_render_pixmap_and_mask_for_colormap_w, 3, 2, 0, H_gdk_pixbuf_render_pixmap_and_mask_for_colormap);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_render_pixmap_and_mask, gxg_gdk_pixbuf_render_pixmap_and_mask_w, 2, 2, 0, H_gdk_pixbuf_render_pixmap_and_mask);
- XG_DEFINE_PROCEDURE(gdk_pixbuf_get_from_drawable, gxg_gdk_pixbuf_get_from_drawable_w, 9, 0, 0, H_gdk_pixbuf_get_from_drawable);
- XG_DEFINE_PROCEDURE(gdk_rgb_find_color, gxg_gdk_rgb_find_color_w, 2, 0, 0, H_gdk_rgb_find_color);
- XG_DEFINE_PROCEDURE(gdk_window_clear, gxg_gdk_window_clear_w, 1, 0, 0, H_gdk_window_clear);
- XG_DEFINE_PROCEDURE(gdk_window_clear_area, gxg_gdk_window_clear_area_w, 5, 0, 0, H_gdk_window_clear_area);
- XG_DEFINE_PROCEDURE(gdk_window_clear_area_e, gxg_gdk_window_clear_area_e_w, 5, 0, 0, H_gdk_window_clear_area_e);
- XG_DEFINE_PROCEDURE(gdk_window_shape_combine_mask, gxg_gdk_window_shape_combine_mask_w, 4, 0, 0, H_gdk_window_shape_combine_mask);
- XG_DEFINE_PROCEDURE(gdk_window_foreign_new, gxg_gdk_window_foreign_new_w, 1, 0, 0, H_gdk_window_foreign_new);
- XG_DEFINE_PROCEDURE(gdk_window_lookup, gxg_gdk_window_lookup_w, 1, 0, 0, H_gdk_window_lookup);
- XG_DEFINE_PROCEDURE(gdk_window_set_icon, gxg_gdk_window_set_icon_w, 4, 0, 0, H_gdk_window_set_icon);
- XG_DEFINE_PROCEDURE(gdk_window_get_internal_paint_info, gxg_gdk_window_get_internal_paint_info_w, 1, 3, 0, H_gdk_window_get_internal_paint_info);
- XG_DEFINE_PROCEDURE(gdk_set_sm_client_id, gxg_gdk_set_sm_client_id_w, 1, 0, 0, H_gdk_set_sm_client_id);
- XG_DEFINE_PROCEDURE(gdk_window_set_back_pixmap, gxg_gdk_window_set_back_pixmap_w, 3, 0, 0, H_gdk_window_set_back_pixmap);
- XG_DEFINE_PROCEDURE(gdk_window_get_geometry, gxg_gdk_window_get_geometry_w, 1, 5, 0, H_gdk_window_get_geometry);
- XG_DEFINE_PROCEDURE(gtk_adjustment_new, gxg_gtk_adjustment_new_w, 6, 0, 0, H_gtk_adjustment_new);
- XG_DEFINE_PROCEDURE(gtk_bindings_activate, gxg_gtk_bindings_activate_w, 3, 0, 0, H_gtk_bindings_activate);
- XG_DEFINE_PROCEDURE(gtk_binding_set_activate, gxg_gtk_binding_set_activate_w, 4, 0, 0, H_gtk_binding_set_activate);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_get_size, gxg_gtk_cell_renderer_get_size_w, 3, 4, 0, H_gtk_cell_renderer_get_size);
- XG_DEFINE_PROCEDURE(gtk_cell_renderer_render, gxg_gtk_cell_renderer_render_w, 7, 0, 0, H_gtk_cell_renderer_render);
- XG_DEFINE_PROCEDURE(gtk_drag_dest_set_proxy, gxg_gtk_drag_dest_set_proxy_w, 4, 0, 0, H_gtk_drag_dest_set_proxy);
- XG_DEFINE_PROCEDURE(gtk_drag_source_set_icon, gxg_gtk_drag_source_set_icon_w, 4, 0, 0, H_gtk_drag_source_set_icon);
- XG_DEFINE_PROCEDURE(gtk_drag_set_icon_pixmap, gxg_gtk_drag_set_icon_pixmap_w, 6, 0, 0, H_gtk_drag_set_icon_pixmap);
- XG_DEFINE_PROCEDURE(gtk_icon_set_render_icon, gxg_gtk_icon_set_render_icon_w, 7, 0, 0, H_gtk_icon_set_render_icon);
- XG_DEFINE_PROCEDURE(gtk_set_locale, gxg_gtk_set_locale_w, 0, 0, 0, H_gtk_set_locale);
- XG_DEFINE_PROCEDURE(gtk_range_set_update_policy, gxg_gtk_range_set_update_policy_w, 2, 0, 0, H_gtk_range_set_update_policy);
- XG_DEFINE_PROCEDURE(gtk_range_get_update_policy, gxg_gtk_range_get_update_policy_w, 1, 0, 0, H_gtk_range_get_update_policy);
- XG_DEFINE_PROCEDURE(gtk_rc_add_default_file, gxg_gtk_rc_add_default_file_w, 1, 0, 0, H_gtk_rc_add_default_file);
- XG_DEFINE_PROCEDURE(gtk_rc_set_default_files, gxg_gtk_rc_set_default_files_w, 1, 0, 0, H_gtk_rc_set_default_files);
- XG_DEFINE_PROCEDURE(gtk_rc_get_default_files, gxg_gtk_rc_get_default_files_w, 0, 0, 0, H_gtk_rc_get_default_files);
- XG_DEFINE_PROCEDURE(gtk_rc_get_style, gxg_gtk_rc_get_style_w, 1, 0, 0, H_gtk_rc_get_style);
- XG_DEFINE_PROCEDURE(gtk_rc_parse, gxg_gtk_rc_parse_w, 1, 0, 0, H_gtk_rc_parse);
- XG_DEFINE_PROCEDURE(gtk_rc_parse_string, gxg_gtk_rc_parse_string_w, 1, 0, 0, H_gtk_rc_parse_string);
- XG_DEFINE_PROCEDURE(gtk_rc_reparse_all, gxg_gtk_rc_reparse_all_w, 0, 0, 0, H_gtk_rc_reparse_all);
- XG_DEFINE_PROCEDURE(gtk_rc_style_new, gxg_gtk_rc_style_new_w, 0, 0, 0, H_gtk_rc_style_new);
- XG_DEFINE_PROCEDURE(gtk_rc_style_copy, gxg_gtk_rc_style_copy_w, 1, 0, 0, H_gtk_rc_style_copy);
- XG_DEFINE_PROCEDURE(gtk_rc_find_module_in_path, gxg_gtk_rc_find_module_in_path_w, 1, 0, 0, H_gtk_rc_find_module_in_path);
- XG_DEFINE_PROCEDURE(gtk_rc_get_theme_dir, gxg_gtk_rc_get_theme_dir_w, 0, 0, 0, H_gtk_rc_get_theme_dir);
- XG_DEFINE_PROCEDURE(gtk_rc_get_module_dir, gxg_gtk_rc_get_module_dir_w, 0, 0, 0, H_gtk_rc_get_module_dir);
- XG_DEFINE_PROCEDURE(gtk_rc_get_im_module_path, gxg_gtk_rc_get_im_module_path_w, 0, 0, 0, H_gtk_rc_get_im_module_path);
- XG_DEFINE_PROCEDURE(gtk_rc_get_im_module_file, gxg_gtk_rc_get_im_module_file_w, 0, 0, 0, H_gtk_rc_get_im_module_file);
- XG_DEFINE_PROCEDURE(gtk_style_new, gxg_gtk_style_new_w, 0, 0, 0, H_gtk_style_new);
- XG_DEFINE_PROCEDURE(gtk_style_copy, gxg_gtk_style_copy_w, 1, 0, 0, H_gtk_style_copy);
- XG_DEFINE_PROCEDURE(gtk_style_attach, gxg_gtk_style_attach_w, 2, 0, 0, H_gtk_style_attach);
- XG_DEFINE_PROCEDURE(gtk_style_detach, gxg_gtk_style_detach_w, 1, 0, 0, H_gtk_style_detach);
- XG_DEFINE_PROCEDURE(gtk_style_set_background, gxg_gtk_style_set_background_w, 3, 0, 0, H_gtk_style_set_background);
- XG_DEFINE_PROCEDURE(gtk_style_apply_default_background, gxg_gtk_style_apply_default_background_w, 9, 0, 0, H_gtk_style_apply_default_background);
- XG_DEFINE_PROCEDURE(gtk_style_lookup_icon_set, gxg_gtk_style_lookup_icon_set_w, 2, 0, 0, H_gtk_style_lookup_icon_set);
- XG_DEFINE_PROCEDURE(gtk_style_render_icon, gxg_gtk_style_render_icon_w, 7, 0, 0, H_gtk_style_render_icon);
- XG_DEFINE_PROCEDURE(gtk_tree_view_create_row_drag_icon, gxg_gtk_tree_view_create_row_drag_icon_w, 2, 0, 0, H_gtk_tree_view_create_row_drag_icon);
- XG_DEFINE_PROCEDURE(gtk_widget_hide_all, gxg_gtk_widget_hide_all_w, 1, 0, 0, H_gtk_widget_hide_all);
- XG_DEFINE_PROCEDURE(gtk_widget_size_request, gxg_gtk_widget_size_request_w, 2, 0, 0, H_gtk_widget_size_request);
- XG_DEFINE_PROCEDURE(gtk_widget_get_child_requisition, gxg_gtk_widget_get_child_requisition_w, 2, 0, 0, H_gtk_widget_get_child_requisition);
- XG_DEFINE_PROCEDURE(gtk_widget_get_colormap, gxg_gtk_widget_get_colormap_w, 1, 0, 0, H_gtk_widget_get_colormap);
- XG_DEFINE_PROCEDURE(gtk_widget_set_colormap, gxg_gtk_widget_set_colormap_w, 2, 0, 0, H_gtk_widget_set_colormap);
- XG_DEFINE_PROCEDURE(gtk_widget_set_style, gxg_gtk_widget_set_style_w, 2, 0, 0, H_gtk_widget_set_style);
- XG_DEFINE_PROCEDURE(gtk_widget_ensure_style, gxg_gtk_widget_ensure_style_w, 1, 0, 0, H_gtk_widget_ensure_style);
- XG_DEFINE_PROCEDURE(gtk_widget_get_style, gxg_gtk_widget_get_style_w, 1, 0, 0, H_gtk_widget_get_style);
- XG_DEFINE_PROCEDURE(gtk_widget_modify_style, gxg_gtk_widget_modify_style_w, 2, 0, 0, H_gtk_widget_modify_style);
- XG_DEFINE_PROCEDURE(gtk_widget_get_modifier_style, gxg_gtk_widget_get_modifier_style_w, 1, 0, 0, H_gtk_widget_get_modifier_style);
- XG_DEFINE_PROCEDURE(gtk_widget_modify_fg, gxg_gtk_widget_modify_fg_w, 3, 0, 0, H_gtk_widget_modify_fg);
- XG_DEFINE_PROCEDURE(gtk_widget_modify_bg, gxg_gtk_widget_modify_bg_w, 3, 0, 0, H_gtk_widget_modify_bg);
- XG_DEFINE_PROCEDURE(gtk_widget_modify_text, gxg_gtk_widget_modify_text_w, 3, 0, 0, H_gtk_widget_modify_text);
- XG_DEFINE_PROCEDURE(gtk_widget_modify_base, gxg_gtk_widget_modify_base_w, 3, 0, 0, H_gtk_widget_modify_base);
- XG_DEFINE_PROCEDURE(gtk_widget_modify_font, gxg_gtk_widget_modify_font_w, 2, 0, 0, H_gtk_widget_modify_font);
- XG_DEFINE_PROCEDURE(gtk_widget_render_icon, gxg_gtk_widget_render_icon_w, 4, 0, 0, H_gtk_widget_render_icon);
- XG_DEFINE_PROCEDURE(gtk_widget_reset_rc_styles, gxg_gtk_widget_reset_rc_styles_w, 1, 0, 0, H_gtk_widget_reset_rc_styles);
- XG_DEFINE_PROCEDURE(gtk_widget_push_colormap, gxg_gtk_widget_push_colormap_w, 1, 0, 0, H_gtk_widget_push_colormap);
- XG_DEFINE_PROCEDURE(gtk_widget_pop_colormap, gxg_gtk_widget_pop_colormap_w, 0, 0, 0, H_gtk_widget_pop_colormap);
- XG_DEFINE_PROCEDURE(gtk_widget_set_default_colormap, gxg_gtk_widget_set_default_colormap_w, 1, 0, 0, H_gtk_widget_set_default_colormap);
- XG_DEFINE_PROCEDURE(gtk_widget_get_default_style, gxg_gtk_widget_get_default_style_w, 0, 0, 0, H_gtk_widget_get_default_style);
- XG_DEFINE_PROCEDURE(gtk_widget_get_default_colormap, gxg_gtk_widget_get_default_colormap_w, 0, 0, 0, H_gtk_widget_get_default_colormap);
- XG_DEFINE_PROCEDURE(gtk_widget_get_default_visual, gxg_gtk_widget_get_default_visual_w, 0, 0, 0, H_gtk_widget_get_default_visual);
- XG_DEFINE_PROCEDURE(gtk_widget_shape_combine_mask, gxg_gtk_widget_shape_combine_mask_w, 4, 0, 0, H_gtk_widget_shape_combine_mask);
- XG_DEFINE_PROCEDURE(gtk_widget_reset_shapes, gxg_gtk_widget_reset_shapes_w, 1, 0, 0, H_gtk_widget_reset_shapes);
- XG_DEFINE_PROCEDURE(gtk_requisition_copy, gxg_gtk_requisition_copy_w, 1, 0, 0, H_gtk_requisition_copy);
- XG_DEFINE_PROCEDURE(gtk_requisition_free, gxg_gtk_requisition_free_w, 1, 0, 0, H_gtk_requisition_free);
- XG_DEFINE_PROCEDURE(gtk_window_set_has_frame, gxg_gtk_window_set_has_frame_w, 2, 0, 0, H_gtk_window_set_has_frame);
- XG_DEFINE_PROCEDURE(gtk_window_get_has_frame, gxg_gtk_window_get_has_frame_w, 1, 0, 0, H_gtk_window_get_has_frame);
- XG_DEFINE_PROCEDURE(gtk_window_set_frame_dimensions, gxg_gtk_window_set_frame_dimensions_w, 5, 0, 0, H_gtk_window_set_frame_dimensions);
- XG_DEFINE_PROCEDURE(gtk_window_get_frame_dimensions, gxg_gtk_window_get_frame_dimensions_w, 1, 4, 0, H_gtk_window_get_frame_dimensions);
- XG_DEFINE_PROCEDURE(gtk_window_remove_embedded_xid, gxg_gtk_window_remove_embedded_xid_w, 2, 0, 0, H_gtk_window_remove_embedded_xid);
- XG_DEFINE_PROCEDURE(gtk_window_add_embedded_xid, gxg_gtk_window_add_embedded_xid_w, 2, 0, 0, H_gtk_window_add_embedded_xid);
- XG_DEFINE_PROCEDURE(gdk_screen_get_default_colormap, gxg_gdk_screen_get_default_colormap_w, 1, 0, 0, H_gdk_screen_get_default_colormap);
- XG_DEFINE_PROCEDURE(gdk_screen_set_default_colormap, gxg_gdk_screen_set_default_colormap_w, 2, 0, 0, H_gdk_screen_set_default_colormap);
- XG_DEFINE_PROCEDURE(gdk_screen_get_system_colormap, gxg_gdk_screen_get_system_colormap_w, 1, 0, 0, H_gdk_screen_get_system_colormap);
- XG_DEFINE_PROCEDURE(gtk_cell_view_get_size_of_row, gxg_gtk_cell_view_get_size_of_row_w, 3, 0, 0, H_gtk_cell_view_get_size_of_row);
- XG_DEFINE_PROCEDURE(gtk_style_lookup_color, gxg_gtk_style_lookup_color_w, 3, 0, 0, H_gtk_style_lookup_color);
+#if GTK_CHECK_VERSION(3, 6, 0)
+ Xg_define_procedure(GTK_MENU_BUTTON, gxg_GTK_MENU_BUTTON_w, 1, 0, 0, "(GTK_MENU_BUTTON obj) casts obj to GTK_MENU_BUTTON", NULL);
+ Xg_define_procedure(GTK_SEARCH_ENTRY, gxg_GTK_SEARCH_ENTRY_w, 1, 0, 0, "(GTK_SEARCH_ENTRY obj) casts obj to GTK_SEARCH_ENTRY", NULL);
+ Xg_define_procedure(GTK_LEVEL_BAR, gxg_GTK_LEVEL_BAR_w, 1, 0, 0, "(GTK_LEVEL_BAR obj) casts obj to GTK_LEVEL_BAR", NULL);
#endif
- XG_DEFINE_PROCEDURE(cairo_create, gxg_cairo_create_w, 1, 0, 0, H_cairo_create);
- XG_DEFINE_PROCEDURE(cairo_version, gxg_cairo_version_w, 0, 0, 0, H_cairo_version);
- XG_DEFINE_PROCEDURE(cairo_version_string, gxg_cairo_version_string_w, 0, 0, 0, H_cairo_version_string);
- XG_DEFINE_PROCEDURE(cairo_reference, gxg_cairo_reference_w, 1, 0, 0, H_cairo_reference);
- XG_DEFINE_PROCEDURE(cairo_destroy, gxg_cairo_destroy_w, 1, 0, 0, H_cairo_destroy);
- XG_DEFINE_PROCEDURE(cairo_save, gxg_cairo_save_w, 1, 0, 0, H_cairo_save);
- XG_DEFINE_PROCEDURE(cairo_restore, gxg_cairo_restore_w, 1, 0, 0, H_cairo_restore);
- XG_DEFINE_PROCEDURE(cairo_push_group, gxg_cairo_push_group_w, 1, 0, 0, H_cairo_push_group);
- XG_DEFINE_PROCEDURE(cairo_push_group_with_content, gxg_cairo_push_group_with_content_w, 2, 0, 0, H_cairo_push_group_with_content);
- XG_DEFINE_PROCEDURE(cairo_pop_group, gxg_cairo_pop_group_w, 1, 0, 0, H_cairo_pop_group);
- XG_DEFINE_PROCEDURE(cairo_pop_group_to_source, gxg_cairo_pop_group_to_source_w, 1, 0, 0, H_cairo_pop_group_to_source);
- XG_DEFINE_PROCEDURE(cairo_set_operator, gxg_cairo_set_operator_w, 2, 0, 0, H_cairo_set_operator);
- XG_DEFINE_PROCEDURE(cairo_set_source, gxg_cairo_set_source_w, 2, 0, 0, H_cairo_set_source);
- XG_DEFINE_PROCEDURE(cairo_set_source_rgb, gxg_cairo_set_source_rgb_w, 4, 0, 0, H_cairo_set_source_rgb);
- XG_DEFINE_PROCEDURE(cairo_set_source_rgba, gxg_cairo_set_source_rgba_w, 5, 0, 0, H_cairo_set_source_rgba);
- XG_DEFINE_PROCEDURE(cairo_set_source_surface, gxg_cairo_set_source_surface_w, 4, 0, 0, H_cairo_set_source_surface);
- XG_DEFINE_PROCEDURE(cairo_set_tolerance, gxg_cairo_set_tolerance_w, 2, 0, 0, H_cairo_set_tolerance);
- XG_DEFINE_PROCEDURE(cairo_set_antialias, gxg_cairo_set_antialias_w, 2, 0, 0, H_cairo_set_antialias);
- XG_DEFINE_PROCEDURE(cairo_set_fill_rule, gxg_cairo_set_fill_rule_w, 2, 0, 0, H_cairo_set_fill_rule);
- XG_DEFINE_PROCEDURE(cairo_set_line_width, gxg_cairo_set_line_width_w, 2, 0, 0, H_cairo_set_line_width);
- XG_DEFINE_PROCEDURE(cairo_set_line_cap, gxg_cairo_set_line_cap_w, 2, 0, 0, H_cairo_set_line_cap);
- XG_DEFINE_PROCEDURE(cairo_set_line_join, gxg_cairo_set_line_join_w, 2, 0, 0, H_cairo_set_line_join);
- XG_DEFINE_PROCEDURE(cairo_set_dash, gxg_cairo_set_dash_w, 4, 0, 0, H_cairo_set_dash);
- XG_DEFINE_PROCEDURE(cairo_set_miter_limit, gxg_cairo_set_miter_limit_w, 2, 0, 0, H_cairo_set_miter_limit);
- XG_DEFINE_PROCEDURE(cairo_translate, gxg_cairo_translate_w, 3, 0, 0, H_cairo_translate);
- XG_DEFINE_PROCEDURE(cairo_scale, gxg_cairo_scale_w, 3, 0, 0, H_cairo_scale);
- XG_DEFINE_PROCEDURE(cairo_rotate, gxg_cairo_rotate_w, 2, 0, 0, H_cairo_rotate);
- XG_DEFINE_PROCEDURE(cairo_transform, gxg_cairo_transform_w, 2, 0, 0, H_cairo_transform);
- XG_DEFINE_PROCEDURE(cairo_set_matrix, gxg_cairo_set_matrix_w, 2, 0, 0, H_cairo_set_matrix);
- XG_DEFINE_PROCEDURE(cairo_identity_matrix, gxg_cairo_identity_matrix_w, 1, 0, 0, H_cairo_identity_matrix);
- XG_DEFINE_PROCEDURE(cairo_user_to_device, gxg_cairo_user_to_device_w, 1, 2, 0, H_cairo_user_to_device);
- XG_DEFINE_PROCEDURE(cairo_user_to_device_distance, gxg_cairo_user_to_device_distance_w, 1, 2, 0, H_cairo_user_to_device_distance);
- XG_DEFINE_PROCEDURE(cairo_device_to_user, gxg_cairo_device_to_user_w, 1, 2, 0, H_cairo_device_to_user);
- XG_DEFINE_PROCEDURE(cairo_device_to_user_distance, gxg_cairo_device_to_user_distance_w, 1, 2, 0, H_cairo_device_to_user_distance);
- XG_DEFINE_PROCEDURE(cairo_new_path, gxg_cairo_new_path_w, 1, 0, 0, H_cairo_new_path);
- XG_DEFINE_PROCEDURE(cairo_move_to, gxg_cairo_move_to_w, 3, 0, 0, H_cairo_move_to);
- XG_DEFINE_PROCEDURE(cairo_new_sub_path, gxg_cairo_new_sub_path_w, 1, 0, 0, H_cairo_new_sub_path);
- XG_DEFINE_PROCEDURE(cairo_line_to, gxg_cairo_line_to_w, 3, 0, 0, H_cairo_line_to);
- XG_DEFINE_PROCEDURE(cairo_curve_to, gxg_cairo_curve_to_w, 7, 0, 0, H_cairo_curve_to);
- XG_DEFINE_PROCEDURE(cairo_arc, gxg_cairo_arc_w, 6, 0, 0, H_cairo_arc);
- XG_DEFINE_PROCEDURE(cairo_arc_negative, gxg_cairo_arc_negative_w, 6, 0, 0, H_cairo_arc_negative);
- XG_DEFINE_PROCEDURE(cairo_rel_move_to, gxg_cairo_rel_move_to_w, 3, 0, 0, H_cairo_rel_move_to);
- XG_DEFINE_PROCEDURE(cairo_rel_line_to, gxg_cairo_rel_line_to_w, 3, 0, 0, H_cairo_rel_line_to);
- XG_DEFINE_PROCEDURE(cairo_rel_curve_to, gxg_cairo_rel_curve_to_w, 7, 0, 0, H_cairo_rel_curve_to);
- XG_DEFINE_PROCEDURE(cairo_rectangle, gxg_cairo_rectangle_w, 5, 0, 0, H_cairo_rectangle);
- XG_DEFINE_PROCEDURE(cairo_close_path, gxg_cairo_close_path_w, 1, 0, 0, H_cairo_close_path);
- XG_DEFINE_PROCEDURE(cairo_paint, gxg_cairo_paint_w, 1, 0, 0, H_cairo_paint);
- XG_DEFINE_PROCEDURE(cairo_paint_with_alpha, gxg_cairo_paint_with_alpha_w, 2, 0, 0, H_cairo_paint_with_alpha);
- XG_DEFINE_PROCEDURE(cairo_mask, gxg_cairo_mask_w, 2, 0, 0, H_cairo_mask);
- XG_DEFINE_PROCEDURE(cairo_mask_surface, gxg_cairo_mask_surface_w, 4, 0, 0, H_cairo_mask_surface);
- XG_DEFINE_PROCEDURE(cairo_stroke, gxg_cairo_stroke_w, 1, 0, 0, H_cairo_stroke);
- XG_DEFINE_PROCEDURE(cairo_stroke_preserve, gxg_cairo_stroke_preserve_w, 1, 0, 0, H_cairo_stroke_preserve);
- XG_DEFINE_PROCEDURE(cairo_fill, gxg_cairo_fill_w, 1, 0, 0, H_cairo_fill);
- XG_DEFINE_PROCEDURE(cairo_fill_preserve, gxg_cairo_fill_preserve_w, 1, 0, 0, H_cairo_fill_preserve);
- XG_DEFINE_PROCEDURE(cairo_copy_page, gxg_cairo_copy_page_w, 1, 0, 0, H_cairo_copy_page);
- XG_DEFINE_PROCEDURE(cairo_show_page, gxg_cairo_show_page_w, 1, 0, 0, H_cairo_show_page);
- XG_DEFINE_PROCEDURE(cairo_in_stroke, gxg_cairo_in_stroke_w, 3, 0, 0, H_cairo_in_stroke);
- XG_DEFINE_PROCEDURE(cairo_in_fill, gxg_cairo_in_fill_w, 3, 0, 0, H_cairo_in_fill);
- XG_DEFINE_PROCEDURE(cairo_reset_clip, gxg_cairo_reset_clip_w, 1, 0, 0, H_cairo_reset_clip);
- XG_DEFINE_PROCEDURE(cairo_clip, gxg_cairo_clip_w, 1, 0, 0, H_cairo_clip);
- XG_DEFINE_PROCEDURE(cairo_clip_preserve, gxg_cairo_clip_preserve_w, 1, 0, 0, H_cairo_clip_preserve);
- XG_DEFINE_PROCEDURE(cairo_font_options_create, gxg_cairo_font_options_create_w, 0, 0, 0, H_cairo_font_options_create);
- XG_DEFINE_PROCEDURE(cairo_font_options_copy, gxg_cairo_font_options_copy_w, 1, 0, 0, H_cairo_font_options_copy);
- XG_DEFINE_PROCEDURE(cairo_font_options_destroy, gxg_cairo_font_options_destroy_w, 1, 0, 0, H_cairo_font_options_destroy);
- XG_DEFINE_PROCEDURE(cairo_font_options_status, gxg_cairo_font_options_status_w, 1, 0, 0, H_cairo_font_options_status);
- XG_DEFINE_PROCEDURE(cairo_font_options_merge, gxg_cairo_font_options_merge_w, 2, 0, 0, H_cairo_font_options_merge);
- XG_DEFINE_PROCEDURE(cairo_font_options_equal, gxg_cairo_font_options_equal_w, 2, 0, 0, H_cairo_font_options_equal);
- XG_DEFINE_PROCEDURE(cairo_font_options_hash, gxg_cairo_font_options_hash_w, 1, 0, 0, H_cairo_font_options_hash);
- XG_DEFINE_PROCEDURE(cairo_font_options_set_antialias, gxg_cairo_font_options_set_antialias_w, 2, 0, 0, H_cairo_font_options_set_antialias);
- XG_DEFINE_PROCEDURE(cairo_font_options_get_antialias, gxg_cairo_font_options_get_antialias_w, 1, 0, 0, H_cairo_font_options_get_antialias);
- XG_DEFINE_PROCEDURE(cairo_font_options_set_subpixel_order, gxg_cairo_font_options_set_subpixel_order_w, 2, 0, 0, H_cairo_font_options_set_subpixel_order);
- XG_DEFINE_PROCEDURE(cairo_font_options_get_subpixel_order, gxg_cairo_font_options_get_subpixel_order_w, 1, 0, 0, H_cairo_font_options_get_subpixel_order);
- XG_DEFINE_PROCEDURE(cairo_font_options_set_hint_style, gxg_cairo_font_options_set_hint_style_w, 2, 0, 0, H_cairo_font_options_set_hint_style);
- XG_DEFINE_PROCEDURE(cairo_font_options_get_hint_style, gxg_cairo_font_options_get_hint_style_w, 1, 0, 0, H_cairo_font_options_get_hint_style);
- XG_DEFINE_PROCEDURE(cairo_font_options_set_hint_metrics, gxg_cairo_font_options_set_hint_metrics_w, 2, 0, 0, H_cairo_font_options_set_hint_metrics);
- XG_DEFINE_PROCEDURE(cairo_font_options_get_hint_metrics, gxg_cairo_font_options_get_hint_metrics_w, 1, 0, 0, H_cairo_font_options_get_hint_metrics);
- XG_DEFINE_PROCEDURE(cairo_select_font_face, gxg_cairo_select_font_face_w, 4, 0, 0, H_cairo_select_font_face);
- XG_DEFINE_PROCEDURE(cairo_set_font_size, gxg_cairo_set_font_size_w, 2, 0, 0, H_cairo_set_font_size);
- XG_DEFINE_PROCEDURE(cairo_set_font_matrix, gxg_cairo_set_font_matrix_w, 2, 0, 0, H_cairo_set_font_matrix);
- XG_DEFINE_PROCEDURE(cairo_get_font_matrix, gxg_cairo_get_font_matrix_w, 2, 0, 0, H_cairo_get_font_matrix);
- XG_DEFINE_PROCEDURE(cairo_set_font_options, gxg_cairo_set_font_options_w, 2, 0, 0, H_cairo_set_font_options);
- XG_DEFINE_PROCEDURE(cairo_get_font_options, gxg_cairo_get_font_options_w, 2, 0, 0, H_cairo_get_font_options);
- XG_DEFINE_PROCEDURE(cairo_set_scaled_font, gxg_cairo_set_scaled_font_w, 2, 0, 0, H_cairo_set_scaled_font);
- XG_DEFINE_PROCEDURE(cairo_show_text, gxg_cairo_show_text_w, 2, 0, 0, H_cairo_show_text);
- XG_DEFINE_PROCEDURE(cairo_show_glyphs, gxg_cairo_show_glyphs_w, 3, 0, 0, H_cairo_show_glyphs);
- XG_DEFINE_PROCEDURE(cairo_get_font_face, gxg_cairo_get_font_face_w, 1, 0, 0, H_cairo_get_font_face);
- XG_DEFINE_PROCEDURE(cairo_font_extents, gxg_cairo_font_extents_w, 2, 0, 0, H_cairo_font_extents);
- XG_DEFINE_PROCEDURE(cairo_set_font_face, gxg_cairo_set_font_face_w, 2, 0, 0, H_cairo_set_font_face);
- XG_DEFINE_PROCEDURE(cairo_text_extents, gxg_cairo_text_extents_w, 3, 0, 0, H_cairo_text_extents);
- XG_DEFINE_PROCEDURE(cairo_glyph_extents, gxg_cairo_glyph_extents_w, 4, 0, 0, H_cairo_glyph_extents);
- XG_DEFINE_PROCEDURE(cairo_text_path, gxg_cairo_text_path_w, 2, 0, 0, H_cairo_text_path);
- XG_DEFINE_PROCEDURE(cairo_glyph_path, gxg_cairo_glyph_path_w, 3, 0, 0, H_cairo_glyph_path);
- XG_DEFINE_PROCEDURE(cairo_font_face_reference, gxg_cairo_font_face_reference_w, 1, 0, 0, H_cairo_font_face_reference);
- XG_DEFINE_PROCEDURE(cairo_font_face_destroy, gxg_cairo_font_face_destroy_w, 1, 0, 0, H_cairo_font_face_destroy);
- XG_DEFINE_PROCEDURE(cairo_font_face_status, gxg_cairo_font_face_status_w, 1, 0, 0, H_cairo_font_face_status);
- XG_DEFINE_PROCEDURE(cairo_font_face_get_user_data, gxg_cairo_font_face_get_user_data_w, 2, 0, 0, H_cairo_font_face_get_user_data);
- XG_DEFINE_PROCEDURE(cairo_font_face_set_user_data, gxg_cairo_font_face_set_user_data_w, 4, 0, 0, H_cairo_font_face_set_user_data);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_create, gxg_cairo_scaled_font_create_w, 4, 0, 0, H_cairo_scaled_font_create);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_reference, gxg_cairo_scaled_font_reference_w, 1, 0, 0, H_cairo_scaled_font_reference);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_destroy, gxg_cairo_scaled_font_destroy_w, 1, 0, 0, H_cairo_scaled_font_destroy);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_status, gxg_cairo_scaled_font_status_w, 1, 0, 0, H_cairo_scaled_font_status);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_extents, gxg_cairo_scaled_font_extents_w, 2, 0, 0, H_cairo_scaled_font_extents);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_text_extents, gxg_cairo_scaled_font_text_extents_w, 3, 0, 0, H_cairo_scaled_font_text_extents);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_glyph_extents, gxg_cairo_scaled_font_glyph_extents_w, 4, 0, 0, H_cairo_scaled_font_glyph_extents);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_get_font_face, gxg_cairo_scaled_font_get_font_face_w, 1, 0, 0, H_cairo_scaled_font_get_font_face);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_get_font_matrix, gxg_cairo_scaled_font_get_font_matrix_w, 2, 0, 0, H_cairo_scaled_font_get_font_matrix);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_get_ctm, gxg_cairo_scaled_font_get_ctm_w, 2, 0, 0, H_cairo_scaled_font_get_ctm);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_get_font_options, gxg_cairo_scaled_font_get_font_options_w, 2, 0, 0, H_cairo_scaled_font_get_font_options);
- XG_DEFINE_PROCEDURE(cairo_get_operator, gxg_cairo_get_operator_w, 1, 0, 0, H_cairo_get_operator);
- XG_DEFINE_PROCEDURE(cairo_get_source, gxg_cairo_get_source_w, 1, 0, 0, H_cairo_get_source);
- XG_DEFINE_PROCEDURE(cairo_get_tolerance, gxg_cairo_get_tolerance_w, 1, 0, 0, H_cairo_get_tolerance);
- XG_DEFINE_PROCEDURE(cairo_get_antialias, gxg_cairo_get_antialias_w, 1, 0, 0, H_cairo_get_antialias);
- XG_DEFINE_PROCEDURE(cairo_get_current_point, gxg_cairo_get_current_point_w, 1, 2, 0, H_cairo_get_current_point);
- XG_DEFINE_PROCEDURE(cairo_get_fill_rule, gxg_cairo_get_fill_rule_w, 1, 0, 0, H_cairo_get_fill_rule);
- XG_DEFINE_PROCEDURE(cairo_get_line_width, gxg_cairo_get_line_width_w, 1, 0, 0, H_cairo_get_line_width);
- XG_DEFINE_PROCEDURE(cairo_get_line_cap, gxg_cairo_get_line_cap_w, 1, 0, 0, H_cairo_get_line_cap);
- XG_DEFINE_PROCEDURE(cairo_get_line_join, gxg_cairo_get_line_join_w, 1, 0, 0, H_cairo_get_line_join);
- XG_DEFINE_PROCEDURE(cairo_get_miter_limit, gxg_cairo_get_miter_limit_w, 1, 0, 0, H_cairo_get_miter_limit);
- XG_DEFINE_PROCEDURE(cairo_get_matrix, gxg_cairo_get_matrix_w, 2, 0, 0, H_cairo_get_matrix);
- XG_DEFINE_PROCEDURE(cairo_get_target, gxg_cairo_get_target_w, 1, 0, 0, H_cairo_get_target);
- XG_DEFINE_PROCEDURE(cairo_get_group_target, gxg_cairo_get_group_target_w, 1, 0, 0, H_cairo_get_group_target);
- XG_DEFINE_PROCEDURE(cairo_copy_path, gxg_cairo_copy_path_w, 1, 0, 0, H_cairo_copy_path);
- XG_DEFINE_PROCEDURE(cairo_copy_path_flat, gxg_cairo_copy_path_flat_w, 1, 0, 0, H_cairo_copy_path_flat);
- XG_DEFINE_PROCEDURE(cairo_append_path, gxg_cairo_append_path_w, 2, 0, 0, H_cairo_append_path);
- XG_DEFINE_PROCEDURE(cairo_path_destroy, gxg_cairo_path_destroy_w, 1, 0, 0, H_cairo_path_destroy);
- XG_DEFINE_PROCEDURE(cairo_status, gxg_cairo_status_w, 1, 0, 0, H_cairo_status);
- XG_DEFINE_PROCEDURE(cairo_status_to_string, gxg_cairo_status_to_string_w, 1, 0, 0, H_cairo_status_to_string);
- XG_DEFINE_PROCEDURE(cairo_surface_create_similar, gxg_cairo_surface_create_similar_w, 4, 0, 0, H_cairo_surface_create_similar);
- XG_DEFINE_PROCEDURE(cairo_surface_reference, gxg_cairo_surface_reference_w, 1, 0, 0, H_cairo_surface_reference);
- XG_DEFINE_PROCEDURE(cairo_surface_finish, gxg_cairo_surface_finish_w, 1, 0, 0, H_cairo_surface_finish);
- XG_DEFINE_PROCEDURE(cairo_surface_destroy, gxg_cairo_surface_destroy_w, 1, 0, 0, H_cairo_surface_destroy);
- XG_DEFINE_PROCEDURE(cairo_surface_status, gxg_cairo_surface_status_w, 1, 0, 0, H_cairo_surface_status);
- XG_DEFINE_PROCEDURE(cairo_surface_get_content, gxg_cairo_surface_get_content_w, 1, 0, 0, H_cairo_surface_get_content);
- XG_DEFINE_PROCEDURE(cairo_surface_get_user_data, gxg_cairo_surface_get_user_data_w, 2, 0, 0, H_cairo_surface_get_user_data);
- XG_DEFINE_PROCEDURE(cairo_surface_set_user_data, gxg_cairo_surface_set_user_data_w, 4, 0, 0, H_cairo_surface_set_user_data);
- XG_DEFINE_PROCEDURE(cairo_surface_get_font_options, gxg_cairo_surface_get_font_options_w, 2, 0, 0, H_cairo_surface_get_font_options);
- XG_DEFINE_PROCEDURE(cairo_surface_flush, gxg_cairo_surface_flush_w, 1, 0, 0, H_cairo_surface_flush);
- XG_DEFINE_PROCEDURE(cairo_surface_mark_dirty, gxg_cairo_surface_mark_dirty_w, 1, 0, 0, H_cairo_surface_mark_dirty);
- XG_DEFINE_PROCEDURE(cairo_surface_mark_dirty_rectangle, gxg_cairo_surface_mark_dirty_rectangle_w, 5, 0, 0, H_cairo_surface_mark_dirty_rectangle);
- XG_DEFINE_PROCEDURE(cairo_surface_set_device_offset, gxg_cairo_surface_set_device_offset_w, 3, 0, 0, H_cairo_surface_set_device_offset);
- XG_DEFINE_PROCEDURE(cairo_surface_get_device_offset, gxg_cairo_surface_get_device_offset_w, 1, 2, 0, H_cairo_surface_get_device_offset);
- XG_DEFINE_PROCEDURE(cairo_surface_set_fallback_resolution, gxg_cairo_surface_set_fallback_resolution_w, 3, 0, 0, H_cairo_surface_set_fallback_resolution);
- XG_DEFINE_PROCEDURE(cairo_image_surface_create, gxg_cairo_image_surface_create_w, 3, 0, 0, H_cairo_image_surface_create);
- XG_DEFINE_PROCEDURE(cairo_image_surface_create_for_data, gxg_cairo_image_surface_create_for_data_w, 5, 0, 0, H_cairo_image_surface_create_for_data);
- XG_DEFINE_PROCEDURE(cairo_image_surface_get_data, gxg_cairo_image_surface_get_data_w, 1, 0, 0, H_cairo_image_surface_get_data);
- XG_DEFINE_PROCEDURE(cairo_image_surface_get_format, gxg_cairo_image_surface_get_format_w, 1, 0, 0, H_cairo_image_surface_get_format);
- XG_DEFINE_PROCEDURE(cairo_image_surface_get_width, gxg_cairo_image_surface_get_width_w, 1, 0, 0, H_cairo_image_surface_get_width);
- XG_DEFINE_PROCEDURE(cairo_image_surface_get_height, gxg_cairo_image_surface_get_height_w, 1, 0, 0, H_cairo_image_surface_get_height);
- XG_DEFINE_PROCEDURE(cairo_image_surface_get_stride, gxg_cairo_image_surface_get_stride_w, 1, 0, 0, H_cairo_image_surface_get_stride);
- XG_DEFINE_PROCEDURE(cairo_pattern_create_rgb, gxg_cairo_pattern_create_rgb_w, 3, 0, 0, H_cairo_pattern_create_rgb);
- XG_DEFINE_PROCEDURE(cairo_pattern_create_rgba, gxg_cairo_pattern_create_rgba_w, 4, 0, 0, H_cairo_pattern_create_rgba);
- XG_DEFINE_PROCEDURE(cairo_pattern_create_for_surface, gxg_cairo_pattern_create_for_surface_w, 1, 0, 0, H_cairo_pattern_create_for_surface);
- XG_DEFINE_PROCEDURE(cairo_pattern_create_linear, gxg_cairo_pattern_create_linear_w, 4, 0, 0, H_cairo_pattern_create_linear);
- XG_DEFINE_PROCEDURE(cairo_pattern_create_radial, gxg_cairo_pattern_create_radial_w, 6, 0, 0, H_cairo_pattern_create_radial);
- XG_DEFINE_PROCEDURE(cairo_pattern_reference, gxg_cairo_pattern_reference_w, 1, 0, 0, H_cairo_pattern_reference);
- XG_DEFINE_PROCEDURE(cairo_pattern_destroy, gxg_cairo_pattern_destroy_w, 1, 0, 0, H_cairo_pattern_destroy);
- XG_DEFINE_PROCEDURE(cairo_pattern_status, gxg_cairo_pattern_status_w, 1, 0, 0, H_cairo_pattern_status);
- XG_DEFINE_PROCEDURE(cairo_pattern_add_color_stop_rgb, gxg_cairo_pattern_add_color_stop_rgb_w, 5, 0, 0, H_cairo_pattern_add_color_stop_rgb);
- XG_DEFINE_PROCEDURE(cairo_pattern_add_color_stop_rgba, gxg_cairo_pattern_add_color_stop_rgba_w, 6, 0, 0, H_cairo_pattern_add_color_stop_rgba);
- XG_DEFINE_PROCEDURE(cairo_pattern_set_matrix, gxg_cairo_pattern_set_matrix_w, 2, 0, 0, H_cairo_pattern_set_matrix);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_matrix, gxg_cairo_pattern_get_matrix_w, 2, 0, 0, H_cairo_pattern_get_matrix);
- XG_DEFINE_PROCEDURE(cairo_pattern_set_extend, gxg_cairo_pattern_set_extend_w, 2, 0, 0, H_cairo_pattern_set_extend);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_extend, gxg_cairo_pattern_get_extend_w, 1, 0, 0, H_cairo_pattern_get_extend);
- XG_DEFINE_PROCEDURE(cairo_pattern_set_filter, gxg_cairo_pattern_set_filter_w, 2, 0, 0, H_cairo_pattern_set_filter);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_filter, gxg_cairo_pattern_get_filter_w, 1, 0, 0, H_cairo_pattern_get_filter);
- XG_DEFINE_PROCEDURE(cairo_matrix_init, gxg_cairo_matrix_init_w, 7, 0, 0, H_cairo_matrix_init);
- XG_DEFINE_PROCEDURE(cairo_matrix_init_identity, gxg_cairo_matrix_init_identity_w, 1, 0, 0, H_cairo_matrix_init_identity);
- XG_DEFINE_PROCEDURE(cairo_matrix_init_translate, gxg_cairo_matrix_init_translate_w, 3, 0, 0, H_cairo_matrix_init_translate);
- XG_DEFINE_PROCEDURE(cairo_matrix_init_scale, gxg_cairo_matrix_init_scale_w, 3, 0, 0, H_cairo_matrix_init_scale);
- XG_DEFINE_PROCEDURE(cairo_matrix_init_rotate, gxg_cairo_matrix_init_rotate_w, 2, 0, 0, H_cairo_matrix_init_rotate);
- XG_DEFINE_PROCEDURE(cairo_matrix_translate, gxg_cairo_matrix_translate_w, 3, 0, 0, H_cairo_matrix_translate);
- XG_DEFINE_PROCEDURE(cairo_matrix_scale, gxg_cairo_matrix_scale_w, 3, 0, 0, H_cairo_matrix_scale);
- XG_DEFINE_PROCEDURE(cairo_matrix_rotate, gxg_cairo_matrix_rotate_w, 2, 0, 0, H_cairo_matrix_rotate);
- XG_DEFINE_PROCEDURE(cairo_matrix_invert, gxg_cairo_matrix_invert_w, 1, 0, 0, H_cairo_matrix_invert);
- XG_DEFINE_PROCEDURE(cairo_matrix_multiply, gxg_cairo_matrix_multiply_w, 3, 0, 0, H_cairo_matrix_multiply);
- XG_DEFINE_PROCEDURE(cairo_matrix_transform_distance, gxg_cairo_matrix_transform_distance_w, 1, 2, 0, H_cairo_matrix_transform_distance);
- XG_DEFINE_PROCEDURE(cairo_matrix_transform_point, gxg_cairo_matrix_transform_point_w, 1, 2, 0, H_cairo_matrix_transform_point);
- XG_DEFINE_PROCEDURE(cairo_get_reference_count, gxg_cairo_get_reference_count_w, 1, 0, 0, H_cairo_get_reference_count);
- XG_DEFINE_PROCEDURE(cairo_get_user_data, gxg_cairo_get_user_data_w, 2, 0, 0, H_cairo_get_user_data);
- XG_DEFINE_PROCEDURE(cairo_set_user_data, gxg_cairo_set_user_data_w, 4, 0, 0, H_cairo_set_user_data);
- XG_DEFINE_PROCEDURE(cairo_clip_extents, gxg_cairo_clip_extents_w, 1, 4, 0, H_cairo_clip_extents);
- XG_DEFINE_PROCEDURE(cairo_copy_clip_rectangle_list, gxg_cairo_copy_clip_rectangle_list_w, 1, 0, 0, H_cairo_copy_clip_rectangle_list);
- XG_DEFINE_PROCEDURE(cairo_rectangle_list_destroy, gxg_cairo_rectangle_list_destroy_w, 1, 0, 0, H_cairo_rectangle_list_destroy);
- XG_DEFINE_PROCEDURE(cairo_font_face_get_reference_count, gxg_cairo_font_face_get_reference_count_w, 1, 0, 0, H_cairo_font_face_get_reference_count);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_get_reference_count, gxg_cairo_scaled_font_get_reference_count_w, 1, 0, 0, H_cairo_scaled_font_get_reference_count);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_get_user_data, gxg_cairo_scaled_font_get_user_data_w, 2, 0, 0, H_cairo_scaled_font_get_user_data);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_set_user_data, gxg_cairo_scaled_font_set_user_data_w, 4, 0, 0, H_cairo_scaled_font_set_user_data);
- XG_DEFINE_PROCEDURE(cairo_get_dash_count, gxg_cairo_get_dash_count_w, 1, 0, 0, H_cairo_get_dash_count);
- XG_DEFINE_PROCEDURE(cairo_get_dash, gxg_cairo_get_dash_w, 1, 2, 0, H_cairo_get_dash);
- XG_DEFINE_PROCEDURE(cairo_surface_get_reference_count, gxg_cairo_surface_get_reference_count_w, 1, 0, 0, H_cairo_surface_get_reference_count);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_reference_count, gxg_cairo_pattern_get_reference_count_w, 1, 0, 0, H_cairo_pattern_get_reference_count);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_user_data, gxg_cairo_pattern_get_user_data_w, 2, 0, 0, H_cairo_pattern_get_user_data);
- XG_DEFINE_PROCEDURE(cairo_pattern_set_user_data, gxg_cairo_pattern_set_user_data_w, 4, 0, 0, H_cairo_pattern_set_user_data);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_rgba, gxg_cairo_pattern_get_rgba_w, 1, 4, 0, H_cairo_pattern_get_rgba);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_surface, gxg_cairo_pattern_get_surface_w, 1, 1, 0, H_cairo_pattern_get_surface);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_color_stop_rgba, gxg_cairo_pattern_get_color_stop_rgba_w, 2, 5, 0, H_cairo_pattern_get_color_stop_rgba);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_color_stop_count, gxg_cairo_pattern_get_color_stop_count_w, 1, 1, 0, H_cairo_pattern_get_color_stop_count);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_linear_points, gxg_cairo_pattern_get_linear_points_w, 1, 4, 0, H_cairo_pattern_get_linear_points);
- XG_DEFINE_PROCEDURE(cairo_pattern_get_radial_circles, gxg_cairo_pattern_get_radial_circles_w, 1, 6, 0, H_cairo_pattern_get_radial_circles);
- XG_DEFINE_PROCEDURE(cairo_get_scaled_font, gxg_cairo_get_scaled_font_w, 1, 0, 0, H_cairo_get_scaled_font);
- XG_DEFINE_PROCEDURE(cairo_path_extents, gxg_cairo_path_extents_w, 1, 4, 0, H_cairo_path_extents);
- XG_DEFINE_PROCEDURE(cairo_has_current_point, gxg_cairo_has_current_point_w, 1, 0, 0, H_cairo_has_current_point);
- XG_DEFINE_PROCEDURE(cairo_surface_copy_page, gxg_cairo_surface_copy_page_w, 1, 0, 0, H_cairo_surface_copy_page);
- XG_DEFINE_PROCEDURE(cairo_surface_show_page, gxg_cairo_surface_show_page_w, 1, 0, 0, H_cairo_surface_show_page);
- XG_DEFINE_PROCEDURE(cairo_format_stride_for_width, gxg_cairo_format_stride_for_width_w, 2, 0, 0, H_cairo_format_stride_for_width);
- XG_DEFINE_PROCEDURE(cairo_image_surface_create_from_png, gxg_cairo_image_surface_create_from_png_w, 1, 0, 0, H_cairo_image_surface_create_from_png);
- XG_DEFINE_PROCEDURE(cairo_surface_write_to_png, gxg_cairo_surface_write_to_png_w, 2, 0, 0, H_cairo_surface_write_to_png);
-#if HAVE_CAIRO_GLYPH_ALLOCATE
- XG_DEFINE_PROCEDURE(cairo_glyph_allocate, gxg_cairo_glyph_allocate_w, 1, 0, 0, H_cairo_glyph_allocate);
- XG_DEFINE_PROCEDURE(cairo_glyph_free, gxg_cairo_glyph_free_w, 1, 0, 0, H_cairo_glyph_free);
- XG_DEFINE_PROCEDURE(cairo_text_cluster_allocate, gxg_cairo_text_cluster_allocate_w, 1, 0, 0, H_cairo_text_cluster_allocate);
- XG_DEFINE_PROCEDURE(cairo_text_cluster_free, gxg_cairo_text_cluster_free_w, 1, 0, 0, H_cairo_text_cluster_free);
- XG_DEFINE_PROCEDURE(cairo_show_text_glyphs, gxg_cairo_show_text_glyphs_w, 8, 0, 0, H_cairo_show_text_glyphs);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_text_to_glyphs, gxg_cairo_scaled_font_text_to_glyphs_w, 0, 0, 1, H_cairo_scaled_font_text_to_glyphs);
- XG_DEFINE_PROCEDURE(cairo_scaled_font_get_scale_matrix, gxg_cairo_scaled_font_get_scale_matrix_w, 2, 0, 0, H_cairo_scaled_font_get_scale_matrix);
- XG_DEFINE_PROCEDURE(cairo_toy_font_face_create, gxg_cairo_toy_font_face_create_w, 3, 0, 0, H_cairo_toy_font_face_create);
- XG_DEFINE_PROCEDURE(cairo_toy_font_face_get_family, gxg_cairo_toy_font_face_get_family_w, 1, 0, 0, H_cairo_toy_font_face_get_family);
- XG_DEFINE_PROCEDURE(cairo_toy_font_face_get_slant, gxg_cairo_toy_font_face_get_slant_w, 1, 0, 0, H_cairo_toy_font_face_get_slant);
- XG_DEFINE_PROCEDURE(cairo_toy_font_face_get_weight, gxg_cairo_toy_font_face_get_weight_w, 1, 0, 0, H_cairo_toy_font_face_get_weight);
- XG_DEFINE_PROCEDURE(cairo_user_font_face_create, gxg_cairo_user_font_face_create_w, 0, 0, 0, H_cairo_user_font_face_create);
- XG_DEFINE_PROCEDURE(cairo_surface_get_fallback_resolution, gxg_cairo_surface_get_fallback_resolution_w, 1, 2, 0, H_cairo_surface_get_fallback_resolution);
- XG_DEFINE_PROCEDURE(cairo_surface_has_show_text_glyphs, gxg_cairo_surface_has_show_text_glyphs_w, 1, 0, 0, H_cairo_surface_has_show_text_glyphs);
+#if GTK_CHECK_VERSION(3, 10, 0)
+ Xg_define_procedure(GTK_PLACES_SIDEBAR, gxg_GTK_PLACES_SIDEBAR_w, 1, 0, 0, "(GTK_PLACES_SIDEBAR obj) casts obj to GTK_PLACES_SIDEBAR", NULL);
+ Xg_define_procedure(GTK_STACK_SWITCHER, gxg_GTK_STACK_SWITCHER_w, 1, 0, 0, "(GTK_STACK_SWITCHER obj) casts obj to GTK_STACK_SWITCHER", NULL);
+ Xg_define_procedure(GTK_STACK, gxg_GTK_STACK_w, 1, 0, 0, "(GTK_STACK obj) casts obj to GTK_STACK", NULL);
+ Xg_define_procedure(GTK_REVEALER, gxg_GTK_REVEALER_w, 1, 0, 0, "(GTK_REVEALER obj) casts obj to GTK_REVEALER", NULL);
+ Xg_define_procedure(GTK_HEADER_BAR, gxg_GTK_HEADER_BAR_w, 1, 0, 0, "(GTK_HEADER_BAR obj) casts obj to GTK_HEADER_BAR", NULL);
+ Xg_define_procedure(GTK_LIST_BOX, gxg_GTK_LIST_BOX_w, 1, 0, 0, "(GTK_LIST_BOX obj) casts obj to GTK_LIST_BOX", NULL);
+ Xg_define_procedure(GTK_LIST_BOX_ROW, gxg_GTK_LIST_BOX_ROW_w, 1, 0, 0, "(GTK_LIST_BOX_ROW obj) casts obj to GTK_LIST_BOX_ROW", NULL);
+ Xg_define_procedure(GTK_SEARCH_BAR, gxg_GTK_SEARCH_BAR_w, 1, 0, 0, "(GTK_SEARCH_BAR obj) casts obj to GTK_SEARCH_BAR", NULL);
#endif
-#if HAVE_CAIRO_REGION_XOR
- XG_DEFINE_PROCEDURE(cairo_in_clip, gxg_cairo_in_clip_w, 3, 0, 0, H_cairo_in_clip);
- XG_DEFINE_PROCEDURE(cairo_device_reference, gxg_cairo_device_reference_w, 1, 0, 0, H_cairo_device_reference);
- XG_DEFINE_PROCEDURE(cairo_device_status, gxg_cairo_device_status_w, 1, 0, 0, H_cairo_device_status);
- XG_DEFINE_PROCEDURE(cairo_device_acquire, gxg_cairo_device_acquire_w, 1, 0, 0, H_cairo_device_acquire);
- XG_DEFINE_PROCEDURE(cairo_device_release, gxg_cairo_device_release_w, 1, 0, 0, H_cairo_device_release);
- XG_DEFINE_PROCEDURE(cairo_device_flush, gxg_cairo_device_flush_w, 1, 0, 0, H_cairo_device_flush);
- XG_DEFINE_PROCEDURE(cairo_device_finish, gxg_cairo_device_finish_w, 1, 0, 0, H_cairo_device_finish);
- XG_DEFINE_PROCEDURE(cairo_device_destroy, gxg_cairo_device_destroy_w, 1, 0, 0, H_cairo_device_destroy);
- XG_DEFINE_PROCEDURE(cairo_device_get_reference_count, gxg_cairo_device_get_reference_count_w, 1, 0, 0, H_cairo_device_get_reference_count);
- XG_DEFINE_PROCEDURE(cairo_device_get_user_data, gxg_cairo_device_get_user_data_w, 2, 0, 0, H_cairo_device_get_user_data);
- XG_DEFINE_PROCEDURE(cairo_device_set_user_data, gxg_cairo_device_set_user_data_w, 4, 0, 0, H_cairo_device_set_user_data);
- XG_DEFINE_PROCEDURE(cairo_surface_create_for_rectangle, gxg_cairo_surface_create_for_rectangle_w, 5, 0, 0, H_cairo_surface_create_for_rectangle);
- XG_DEFINE_PROCEDURE(cairo_surface_get_device, gxg_cairo_surface_get_device_w, 1, 0, 0, H_cairo_surface_get_device);
- XG_DEFINE_PROCEDURE(cairo_surface_set_mime_data, gxg_cairo_surface_set_mime_data_w, 6, 0, 0, H_cairo_surface_set_mime_data);
- XG_DEFINE_PROCEDURE(cairo_recording_surface_create, gxg_cairo_recording_surface_create_w, 2, 0, 0, H_cairo_recording_surface_create);
- XG_DEFINE_PROCEDURE(cairo_recording_surface_ink_extents, gxg_cairo_recording_surface_ink_extents_w, 5, 0, 0, H_cairo_recording_surface_ink_extents);
- XG_DEFINE_PROCEDURE(cairo_region_create, gxg_cairo_region_create_w, 0, 0, 0, H_cairo_region_create);
- XG_DEFINE_PROCEDURE(cairo_region_create_rectangle, gxg_cairo_region_create_rectangle_w, 1, 0, 0, H_cairo_region_create_rectangle);
- XG_DEFINE_PROCEDURE(cairo_region_create_rectangles, gxg_cairo_region_create_rectangles_w, 2, 0, 0, H_cairo_region_create_rectangles);
- XG_DEFINE_PROCEDURE(cairo_region_copy, gxg_cairo_region_copy_w, 1, 0, 0, H_cairo_region_copy);
- XG_DEFINE_PROCEDURE(cairo_region_reference, gxg_cairo_region_reference_w, 1, 0, 0, H_cairo_region_reference);
- XG_DEFINE_PROCEDURE(cairo_region_destroy, gxg_cairo_region_destroy_w, 1, 0, 0, H_cairo_region_destroy);
- XG_DEFINE_PROCEDURE(cairo_region_equal, gxg_cairo_region_equal_w, 2, 0, 0, H_cairo_region_equal);
- XG_DEFINE_PROCEDURE(cairo_region_status, gxg_cairo_region_status_w, 1, 0, 0, H_cairo_region_status);
- XG_DEFINE_PROCEDURE(cairo_region_get_extents, gxg_cairo_region_get_extents_w, 2, 0, 0, H_cairo_region_get_extents);
- XG_DEFINE_PROCEDURE(cairo_region_num_rectangles, gxg_cairo_region_num_rectangles_w, 1, 0, 0, H_cairo_region_num_rectangles);
- XG_DEFINE_PROCEDURE(cairo_region_get_rectangle, gxg_cairo_region_get_rectangle_w, 3, 0, 0, H_cairo_region_get_rectangle);
- XG_DEFINE_PROCEDURE(cairo_region_is_empty, gxg_cairo_region_is_empty_w, 1, 0, 0, H_cairo_region_is_empty);
- XG_DEFINE_PROCEDURE(cairo_region_contains_rectangle, gxg_cairo_region_contains_rectangle_w, 2, 0, 0, H_cairo_region_contains_rectangle);
- XG_DEFINE_PROCEDURE(cairo_region_contains_point, gxg_cairo_region_contains_point_w, 3, 0, 0, H_cairo_region_contains_point);
- XG_DEFINE_PROCEDURE(cairo_region_translate, gxg_cairo_region_translate_w, 3, 0, 0, H_cairo_region_translate);
- XG_DEFINE_PROCEDURE(cairo_region_subtract, gxg_cairo_region_subtract_w, 2, 0, 0, H_cairo_region_subtract);
- XG_DEFINE_PROCEDURE(cairo_region_subtract_rectangle, gxg_cairo_region_subtract_rectangle_w, 2, 0, 0, H_cairo_region_subtract_rectangle);
- XG_DEFINE_PROCEDURE(cairo_region_intersect, gxg_cairo_region_intersect_w, 2, 0, 0, H_cairo_region_intersect);
- XG_DEFINE_PROCEDURE(cairo_region_intersect_rectangle, gxg_cairo_region_intersect_rectangle_w, 2, 0, 0, H_cairo_region_intersect_rectangle);
- XG_DEFINE_PROCEDURE(cairo_region_union, gxg_cairo_region_union_w, 2, 0, 0, H_cairo_region_union);
- XG_DEFINE_PROCEDURE(cairo_region_union_rectangle, gxg_cairo_region_union_rectangle_w, 2, 0, 0, H_cairo_region_union_rectangle);
- XG_DEFINE_PROCEDURE(cairo_region_xor, gxg_cairo_region_xor_w, 2, 0, 0, H_cairo_region_xor);
- XG_DEFINE_PROCEDURE(cairo_region_xor_rectangle, gxg_cairo_region_xor_rectangle_w, 2, 0, 0, H_cairo_region_xor_rectangle);
+#if GTK_CHECK_VERSION(3, 12, 0)
+ Xg_define_procedure(GTK_FLOW_BOX, gxg_GTK_FLOW_BOX_w, 1, 0, 0, "(GTK_FLOW_BOX obj) casts obj to GTK_FLOW_BOX", NULL);
+ Xg_define_procedure(GTK_FLOW_BOX_CHILD, gxg_GTK_FLOW_BOX_CHILD_w, 1, 0, 0, "(GTK_FLOW_BOX_CHILD obj) casts obj to GTK_FLOW_BOX_CHILD", NULL);
+ Xg_define_procedure(GTK_ACTION_BAR, gxg_GTK_ACTION_BAR_w, 1, 0, 0, "(GTK_ACTION_BAR obj) casts obj to GTK_ACTION_BAR", NULL);
+ Xg_define_procedure(GTK_POPOVER, gxg_GTK_POPOVER_w, 1, 0, 0, "(GTK_POPOVER obj) casts obj to GTK_POPOVER", NULL);
#endif
- XG_DEFINE_PROCEDURE(GPOINTER, gxg_GPOINTER_w, 1, 0, 0, "(GPOINTER obj) casts obj to GPOINTER");
- XG_DEFINE_PROCEDURE(GDK_DRAG_CONTEXT, gxg_GDK_DRAG_CONTEXT_w, 1, 0, 0, "(GDK_DRAG_CONTEXT obj) casts obj to GDK_DRAG_CONTEXT");
- XG_DEFINE_PROCEDURE(GDK_DEVICE, gxg_GDK_DEVICE_w, 1, 0, 0, "(GDK_DEVICE obj) casts obj to GDK_DEVICE");
- XG_DEFINE_PROCEDURE(GDK_KEYMAP, gxg_GDK_KEYMAP_w, 1, 0, 0, "(GDK_KEYMAP obj) casts obj to GDK_KEYMAP");
- XG_DEFINE_PROCEDURE(GDK_VISUAL, gxg_GDK_VISUAL_w, 1, 0, 0, "(GDK_VISUAL obj) casts obj to GDK_VISUAL");
- XG_DEFINE_PROCEDURE(GDK_WINDOW, gxg_GDK_WINDOW_w, 1, 0, 0, "(GDK_WINDOW obj) casts obj to GDK_WINDOW");
- XG_DEFINE_PROCEDURE(GDK_PIXBUF, gxg_GDK_PIXBUF_w, 1, 0, 0, "(GDK_PIXBUF obj) casts obj to GDK_PIXBUF");
- XG_DEFINE_PROCEDURE(GDK_PIXBUF_ANIMATION, gxg_GDK_PIXBUF_ANIMATION_w, 1, 0, 0, "(GDK_PIXBUF_ANIMATION obj) casts obj to GDK_PIXBUF_ANIMATION");
- XG_DEFINE_PROCEDURE(GDK_PIXBUF_ANIMATION_ITER, gxg_GDK_PIXBUF_ANIMATION_ITER_w, 1, 0, 0, "(GDK_PIXBUF_ANIMATION_ITER obj) casts obj to GDK_PIXBUF_ANIMATION_ITER");
- XG_DEFINE_PROCEDURE(GTK_VBOX, gxg_GTK_VBOX_w, 1, 0, 0, "(GTK_VBOX obj) casts obj to GTK_VBOX");
- XG_DEFINE_PROCEDURE(GTK_ACCEL_GROUP, gxg_GTK_ACCEL_GROUP_w, 1, 0, 0, "(GTK_ACCEL_GROUP obj) casts obj to GTK_ACCEL_GROUP");
- XG_DEFINE_PROCEDURE(GTK_ACCEL_LABEL, gxg_GTK_ACCEL_LABEL_w, 1, 0, 0, "(GTK_ACCEL_LABEL obj) casts obj to GTK_ACCEL_LABEL");
- XG_DEFINE_PROCEDURE(GTK_ACCESSIBLE, gxg_GTK_ACCESSIBLE_w, 1, 0, 0, "(GTK_ACCESSIBLE obj) casts obj to GTK_ACCESSIBLE");
- XG_DEFINE_PROCEDURE(GTK_ADJUSTMENT, gxg_GTK_ADJUSTMENT_w, 1, 0, 0, "(GTK_ADJUSTMENT obj) casts obj to GTK_ADJUSTMENT");
- XG_DEFINE_PROCEDURE(GTK_ALIGNMENT, gxg_GTK_ALIGNMENT_w, 1, 0, 0, "(GTK_ALIGNMENT obj) casts obj to GTK_ALIGNMENT");
- XG_DEFINE_PROCEDURE(GTK_ARROW, gxg_GTK_ARROW_w, 1, 0, 0, "(GTK_ARROW obj) casts obj to GTK_ARROW");
- XG_DEFINE_PROCEDURE(GTK_ASPECT_FRAME, gxg_GTK_ASPECT_FRAME_w, 1, 0, 0, "(GTK_ASPECT_FRAME obj) casts obj to GTK_ASPECT_FRAME");
- XG_DEFINE_PROCEDURE(GTK_BUTTON_BOX, gxg_GTK_BUTTON_BOX_w, 1, 0, 0, "(GTK_BUTTON_BOX obj) casts obj to GTK_BUTTON_BOX");
- XG_DEFINE_PROCEDURE(GTK_BIN, gxg_GTK_BIN_w, 1, 0, 0, "(GTK_BIN obj) casts obj to GTK_BIN");
- XG_DEFINE_PROCEDURE(GTK_BOX, gxg_GTK_BOX_w, 1, 0, 0, "(GTK_BOX obj) casts obj to GTK_BOX");
- XG_DEFINE_PROCEDURE(GTK_BUTTON, gxg_GTK_BUTTON_w, 1, 0, 0, "(GTK_BUTTON obj) casts obj to GTK_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_CALENDAR, gxg_GTK_CALENDAR_w, 1, 0, 0, "(GTK_CALENDAR obj) casts obj to GTK_CALENDAR");
- XG_DEFINE_PROCEDURE(GTK_CELL_EDITABLE, gxg_GTK_CELL_EDITABLE_w, 1, 0, 0, "(GTK_CELL_EDITABLE obj) casts obj to GTK_CELL_EDITABLE");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER, gxg_GTK_CELL_RENDERER_w, 1, 0, 0, "(GTK_CELL_RENDERER obj) casts obj to GTK_CELL_RENDERER");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER_PIXBUF, gxg_GTK_CELL_RENDERER_PIXBUF_w, 1, 0, 0, "(GTK_CELL_RENDERER_PIXBUF obj) casts obj to GTK_CELL_RENDERER_PIXBUF");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER_TEXT, gxg_GTK_CELL_RENDERER_TEXT_w, 1, 0, 0, "(GTK_CELL_RENDERER_TEXT obj) casts obj to GTK_CELL_RENDERER_TEXT");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER_TOGGLE, gxg_GTK_CELL_RENDERER_TOGGLE_w, 1, 0, 0, "(GTK_CELL_RENDERER_TOGGLE obj) casts obj to GTK_CELL_RENDERER_TOGGLE");
- XG_DEFINE_PROCEDURE(GTK_CHECK_BUTTON, gxg_GTK_CHECK_BUTTON_w, 1, 0, 0, "(GTK_CHECK_BUTTON obj) casts obj to GTK_CHECK_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_CHECK_MENU_ITEM, gxg_GTK_CHECK_MENU_ITEM_w, 1, 0, 0, "(GTK_CHECK_MENU_ITEM obj) casts obj to GTK_CHECK_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_COLOR_SELECTION_DIALOG, gxg_GTK_COLOR_SELECTION_DIALOG_w, 1, 0, 0, "(GTK_COLOR_SELECTION_DIALOG obj) casts obj to GTK_COLOR_SELECTION_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_COLOR_SELECTION, gxg_GTK_COLOR_SELECTION_w, 1, 0, 0, "(GTK_COLOR_SELECTION obj) casts obj to GTK_COLOR_SELECTION");
- XG_DEFINE_PROCEDURE(GTK_CONTAINER, gxg_GTK_CONTAINER_w, 1, 0, 0, "(GTK_CONTAINER obj) casts obj to GTK_CONTAINER");
- XG_DEFINE_PROCEDURE(GTK_DIALOG, gxg_GTK_DIALOG_w, 1, 0, 0, "(GTK_DIALOG obj) casts obj to GTK_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_DRAWING_AREA, gxg_GTK_DRAWING_AREA_w, 1, 0, 0, "(GTK_DRAWING_AREA obj) casts obj to GTK_DRAWING_AREA");
- XG_DEFINE_PROCEDURE(GTK_EDITABLE, gxg_GTK_EDITABLE_w, 1, 0, 0, "(GTK_EDITABLE obj) casts obj to GTK_EDITABLE");
- XG_DEFINE_PROCEDURE(GTK_ENTRY, gxg_GTK_ENTRY_w, 1, 0, 0, "(GTK_ENTRY obj) casts obj to GTK_ENTRY");
- XG_DEFINE_PROCEDURE(GTK_EVENT_BOX, gxg_GTK_EVENT_BOX_w, 1, 0, 0, "(GTK_EVENT_BOX obj) casts obj to GTK_EVENT_BOX");
- XG_DEFINE_PROCEDURE(GTK_FIXED, gxg_GTK_FIXED_w, 1, 0, 0, "(GTK_FIXED obj) casts obj to GTK_FIXED");
- XG_DEFINE_PROCEDURE(GTK_FONT_SELECTION, gxg_GTK_FONT_SELECTION_w, 1, 0, 0, "(GTK_FONT_SELECTION obj) casts obj to GTK_FONT_SELECTION");
- XG_DEFINE_PROCEDURE(GTK_FONT_SELECTION_DIALOG, gxg_GTK_FONT_SELECTION_DIALOG_w, 1, 0, 0, "(GTK_FONT_SELECTION_DIALOG obj) casts obj to GTK_FONT_SELECTION_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_FRAME, gxg_GTK_FRAME_w, 1, 0, 0, "(GTK_FRAME obj) casts obj to GTK_FRAME");
- XG_DEFINE_PROCEDURE(GTK_HANDLE_BOX, gxg_GTK_HANDLE_BOX_w, 1, 0, 0, "(GTK_HANDLE_BOX obj) casts obj to GTK_HANDLE_BOX");
- XG_DEFINE_PROCEDURE(GTK_HBUTTON_BOX, gxg_GTK_HBUTTON_BOX_w, 1, 0, 0, "(GTK_HBUTTON_BOX obj) casts obj to GTK_HBUTTON_BOX");
- XG_DEFINE_PROCEDURE(GTK_HBOX, gxg_GTK_HBOX_w, 1, 0, 0, "(GTK_HBOX obj) casts obj to GTK_HBOX");
- XG_DEFINE_PROCEDURE(GTK_HPANED, gxg_GTK_HPANED_w, 1, 0, 0, "(GTK_HPANED obj) casts obj to GTK_HPANED");
- XG_DEFINE_PROCEDURE(GTK_HSCALE, gxg_GTK_HSCALE_w, 1, 0, 0, "(GTK_HSCALE obj) casts obj to GTK_HSCALE");
- XG_DEFINE_PROCEDURE(GTK_HSCROLLBAR, gxg_GTK_HSCROLLBAR_w, 1, 0, 0, "(GTK_HSCROLLBAR obj) casts obj to GTK_HSCROLLBAR");
- XG_DEFINE_PROCEDURE(GTK_HSEPARATOR, gxg_GTK_HSEPARATOR_w, 1, 0, 0, "(GTK_HSEPARATOR obj) casts obj to GTK_HSEPARATOR");
- XG_DEFINE_PROCEDURE(GTK_ICON_FACTORY, gxg_GTK_ICON_FACTORY_w, 1, 0, 0, "(GTK_ICON_FACTORY obj) casts obj to GTK_ICON_FACTORY");
- XG_DEFINE_PROCEDURE(GTK_IMAGE, gxg_GTK_IMAGE_w, 1, 0, 0, "(GTK_IMAGE obj) casts obj to GTK_IMAGE");
- XG_DEFINE_PROCEDURE(GTK_IMAGE_MENU_ITEM, gxg_GTK_IMAGE_MENU_ITEM_w, 1, 0, 0, "(GTK_IMAGE_MENU_ITEM obj) casts obj to GTK_IMAGE_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IM_CONTEXT, gxg_GTK_IM_CONTEXT_w, 1, 0, 0, "(GTK_IM_CONTEXT obj) casts obj to GTK_IM_CONTEXT");
- XG_DEFINE_PROCEDURE(GTK_IM_CONTEXT_SIMPLE, gxg_GTK_IM_CONTEXT_SIMPLE_w, 1, 0, 0, "(GTK_IM_CONTEXT_SIMPLE obj) casts obj to GTK_IM_CONTEXT_SIMPLE");
- XG_DEFINE_PROCEDURE(GTK_IM_MULTICONTEXT, gxg_GTK_IM_MULTICONTEXT_w, 1, 0, 0, "(GTK_IM_MULTICONTEXT obj) casts obj to GTK_IM_MULTICONTEXT");
- XG_DEFINE_PROCEDURE(GTK_INVISIBLE, gxg_GTK_INVISIBLE_w, 1, 0, 0, "(GTK_INVISIBLE obj) casts obj to GTK_INVISIBLE");
- XG_DEFINE_PROCEDURE(GTK_LABEL, gxg_GTK_LABEL_w, 1, 0, 0, "(GTK_LABEL obj) casts obj to GTK_LABEL");
- XG_DEFINE_PROCEDURE(GTK_LAYOUT, gxg_GTK_LAYOUT_w, 1, 0, 0, "(GTK_LAYOUT obj) casts obj to GTK_LAYOUT");
- XG_DEFINE_PROCEDURE(GTK_LIST_STORE, gxg_GTK_LIST_STORE_w, 1, 0, 0, "(GTK_LIST_STORE obj) casts obj to GTK_LIST_STORE");
- XG_DEFINE_PROCEDURE(GTK_MENU_BAR, gxg_GTK_MENU_BAR_w, 1, 0, 0, "(GTK_MENU_BAR obj) casts obj to GTK_MENU_BAR");
- XG_DEFINE_PROCEDURE(GTK_MENU, gxg_GTK_MENU_w, 1, 0, 0, "(GTK_MENU obj) casts obj to GTK_MENU");
- XG_DEFINE_PROCEDURE(GTK_MENU_ITEM, gxg_GTK_MENU_ITEM_w, 1, 0, 0, "(GTK_MENU_ITEM obj) casts obj to GTK_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_MENU_SHELL, gxg_GTK_MENU_SHELL_w, 1, 0, 0, "(GTK_MENU_SHELL obj) casts obj to GTK_MENU_SHELL");
- XG_DEFINE_PROCEDURE(GTK_MISC, gxg_GTK_MISC_w, 1, 0, 0, "(GTK_MISC obj) casts obj to GTK_MISC");
- XG_DEFINE_PROCEDURE(GTK_NOTEBOOK, gxg_GTK_NOTEBOOK_w, 1, 0, 0, "(GTK_NOTEBOOK obj) casts obj to GTK_NOTEBOOK");
- XG_DEFINE_PROCEDURE(GTK_PANED, gxg_GTK_PANED_w, 1, 0, 0, "(GTK_PANED obj) casts obj to GTK_PANED");
- XG_DEFINE_PROCEDURE(GTK_PROGRESS_BAR, gxg_GTK_PROGRESS_BAR_w, 1, 0, 0, "(GTK_PROGRESS_BAR obj) casts obj to GTK_PROGRESS_BAR");
- XG_DEFINE_PROCEDURE(GTK_RADIO_BUTTON, gxg_GTK_RADIO_BUTTON_w, 1, 0, 0, "(GTK_RADIO_BUTTON obj) casts obj to GTK_RADIO_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_RADIO_MENU_ITEM, gxg_GTK_RADIO_MENU_ITEM_w, 1, 0, 0, "(GTK_RADIO_MENU_ITEM obj) casts obj to GTK_RADIO_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_RANGE, gxg_GTK_RANGE_w, 1, 0, 0, "(GTK_RANGE obj) casts obj to GTK_RANGE");
- XG_DEFINE_PROCEDURE(GTK_SCALE, gxg_GTK_SCALE_w, 1, 0, 0, "(GTK_SCALE obj) casts obj to GTK_SCALE");
- XG_DEFINE_PROCEDURE(GTK_SCROLLBAR, gxg_GTK_SCROLLBAR_w, 1, 0, 0, "(GTK_SCROLLBAR obj) casts obj to GTK_SCROLLBAR");
- XG_DEFINE_PROCEDURE(GTK_SCROLLED_WINDOW, gxg_GTK_SCROLLED_WINDOW_w, 1, 0, 0, "(GTK_SCROLLED_WINDOW obj) casts obj to GTK_SCROLLED_WINDOW");
- XG_DEFINE_PROCEDURE(GTK_SEPARATOR, gxg_GTK_SEPARATOR_w, 1, 0, 0, "(GTK_SEPARATOR obj) casts obj to GTK_SEPARATOR");
- XG_DEFINE_PROCEDURE(GTK_SEPARATOR_MENU_ITEM, gxg_GTK_SEPARATOR_MENU_ITEM_w, 1, 0, 0, "(GTK_SEPARATOR_MENU_ITEM obj) casts obj to GTK_SEPARATOR_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_SIZE_GROUP, gxg_GTK_SIZE_GROUP_w, 1, 0, 0, "(GTK_SIZE_GROUP obj) casts obj to GTK_SIZE_GROUP");
- XG_DEFINE_PROCEDURE(GTK_SPIN_BUTTON, gxg_GTK_SPIN_BUTTON_w, 1, 0, 0, "(GTK_SPIN_BUTTON obj) casts obj to GTK_SPIN_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_STATUSBAR, gxg_GTK_STATUSBAR_w, 1, 0, 0, "(GTK_STATUSBAR obj) casts obj to GTK_STATUSBAR");
- XG_DEFINE_PROCEDURE(GTK_TABLE, gxg_GTK_TABLE_w, 1, 0, 0, "(GTK_TABLE obj) casts obj to GTK_TABLE");
- XG_DEFINE_PROCEDURE(GTK_TEAROFF_MENU_ITEM, gxg_GTK_TEAROFF_MENU_ITEM_w, 1, 0, 0, "(GTK_TEAROFF_MENU_ITEM obj) casts obj to GTK_TEAROFF_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_TEXT_BUFFER, gxg_GTK_TEXT_BUFFER_w, 1, 0, 0, "(GTK_TEXT_BUFFER obj) casts obj to GTK_TEXT_BUFFER");
- XG_DEFINE_PROCEDURE(GTK_TEXT_CHILD_ANCHOR, gxg_GTK_TEXT_CHILD_ANCHOR_w, 1, 0, 0, "(GTK_TEXT_CHILD_ANCHOR obj) casts obj to GTK_TEXT_CHILD_ANCHOR");
- XG_DEFINE_PROCEDURE(GTK_TEXT_MARK, gxg_GTK_TEXT_MARK_w, 1, 0, 0, "(GTK_TEXT_MARK obj) casts obj to GTK_TEXT_MARK");
- XG_DEFINE_PROCEDURE(GTK_TEXT_TAG, gxg_GTK_TEXT_TAG_w, 1, 0, 0, "(GTK_TEXT_TAG obj) casts obj to GTK_TEXT_TAG");
- XG_DEFINE_PROCEDURE(GTK_TEXT_TAG_TABLE, gxg_GTK_TEXT_TAG_TABLE_w, 1, 0, 0, "(GTK_TEXT_TAG_TABLE obj) casts obj to GTK_TEXT_TAG_TABLE");
- XG_DEFINE_PROCEDURE(GTK_TEXT_VIEW, gxg_GTK_TEXT_VIEW_w, 1, 0, 0, "(GTK_TEXT_VIEW obj) casts obj to GTK_TEXT_VIEW");
- XG_DEFINE_PROCEDURE(GTK_TOGGLE_BUTTON, gxg_GTK_TOGGLE_BUTTON_w, 1, 0, 0, "(GTK_TOGGLE_BUTTON obj) casts obj to GTK_TOGGLE_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_TOOLBAR, gxg_GTK_TOOLBAR_w, 1, 0, 0, "(GTK_TOOLBAR obj) casts obj to GTK_TOOLBAR");
- XG_DEFINE_PROCEDURE(GTK_TREE_DRAG_SOURCE, gxg_GTK_TREE_DRAG_SOURCE_w, 1, 0, 0, "(GTK_TREE_DRAG_SOURCE obj) casts obj to GTK_TREE_DRAG_SOURCE");
- XG_DEFINE_PROCEDURE(GTK_TREE_DRAG_DEST, gxg_GTK_TREE_DRAG_DEST_w, 1, 0, 0, "(GTK_TREE_DRAG_DEST obj) casts obj to GTK_TREE_DRAG_DEST");
- XG_DEFINE_PROCEDURE(GTK_TREE_MODEL, gxg_GTK_TREE_MODEL_w, 1, 0, 0, "(GTK_TREE_MODEL obj) casts obj to GTK_TREE_MODEL");
- XG_DEFINE_PROCEDURE(GTK_TREE_MODEL_SORT, gxg_GTK_TREE_MODEL_SORT_w, 1, 0, 0, "(GTK_TREE_MODEL_SORT obj) casts obj to GTK_TREE_MODEL_SORT");
- XG_DEFINE_PROCEDURE(GTK_TREE_SELECTION, gxg_GTK_TREE_SELECTION_w, 1, 0, 0, "(GTK_TREE_SELECTION obj) casts obj to GTK_TREE_SELECTION");
- XG_DEFINE_PROCEDURE(GTK_TREE_SORTABLE, gxg_GTK_TREE_SORTABLE_w, 1, 0, 0, "(GTK_TREE_SORTABLE obj) casts obj to GTK_TREE_SORTABLE");
- XG_DEFINE_PROCEDURE(GTK_TREE_STORE, gxg_GTK_TREE_STORE_w, 1, 0, 0, "(GTK_TREE_STORE obj) casts obj to GTK_TREE_STORE");
- XG_DEFINE_PROCEDURE(GTK_TREE_VIEW_COLUMN, gxg_GTK_TREE_VIEW_COLUMN_w, 1, 0, 0, "(GTK_TREE_VIEW_COLUMN obj) casts obj to GTK_TREE_VIEW_COLUMN");
- XG_DEFINE_PROCEDURE(GTK_TREE_VIEW, gxg_GTK_TREE_VIEW_w, 1, 0, 0, "(GTK_TREE_VIEW obj) casts obj to GTK_TREE_VIEW");
- XG_DEFINE_PROCEDURE(GTK_VBUTTON_BOX, gxg_GTK_VBUTTON_BOX_w, 1, 0, 0, "(GTK_VBUTTON_BOX obj) casts obj to GTK_VBUTTON_BOX");
- XG_DEFINE_PROCEDURE(GTK_VIEWPORT, gxg_GTK_VIEWPORT_w, 1, 0, 0, "(GTK_VIEWPORT obj) casts obj to GTK_VIEWPORT");
- XG_DEFINE_PROCEDURE(GTK_VPANED, gxg_GTK_VPANED_w, 1, 0, 0, "(GTK_VPANED obj) casts obj to GTK_VPANED");
- XG_DEFINE_PROCEDURE(GTK_VSCALE, gxg_GTK_VSCALE_w, 1, 0, 0, "(GTK_VSCALE obj) casts obj to GTK_VSCALE");
- XG_DEFINE_PROCEDURE(GTK_VSCROLLBAR, gxg_GTK_VSCROLLBAR_w, 1, 0, 0, "(GTK_VSCROLLBAR obj) casts obj to GTK_VSCROLLBAR");
- XG_DEFINE_PROCEDURE(GTK_VSEPARATOR, gxg_GTK_VSEPARATOR_w, 1, 0, 0, "(GTK_VSEPARATOR obj) casts obj to GTK_VSEPARATOR");
- XG_DEFINE_PROCEDURE(GTK_WIDGET, gxg_GTK_WIDGET_w, 1, 0, 0, "(GTK_WIDGET obj) casts obj to GTK_WIDGET");
- XG_DEFINE_PROCEDURE(GTK_WINDOW, gxg_GTK_WINDOW_w, 1, 0, 0, "(GTK_WINDOW obj) casts obj to GTK_WINDOW");
- XG_DEFINE_PROCEDURE(PANGO_CONTEXT, gxg_PANGO_CONTEXT_w, 1, 0, 0, "(PANGO_CONTEXT obj) casts obj to PANGO_CONTEXT");
- XG_DEFINE_PROCEDURE(PANGO_FONT_FAMILY, gxg_PANGO_FONT_FAMILY_w, 1, 0, 0, "(PANGO_FONT_FAMILY obj) casts obj to PANGO_FONT_FAMILY");
- XG_DEFINE_PROCEDURE(PANGO_FONT_FACE, gxg_PANGO_FONT_FACE_w, 1, 0, 0, "(PANGO_FONT_FACE obj) casts obj to PANGO_FONT_FACE");
- XG_DEFINE_PROCEDURE(PANGO_FONT, gxg_PANGO_FONT_w, 1, 0, 0, "(PANGO_FONT obj) casts obj to PANGO_FONT");
- XG_DEFINE_PROCEDURE(PANGO_FONT_MAP, gxg_PANGO_FONT_MAP_w, 1, 0, 0, "(PANGO_FONT_MAP obj) casts obj to PANGO_FONT_MAP");
- XG_DEFINE_PROCEDURE(PANGO_LAYOUT, gxg_PANGO_LAYOUT_w, 1, 0, 0, "(PANGO_LAYOUT obj) casts obj to PANGO_LAYOUT");
- XG_DEFINE_PROCEDURE(G_OBJECT, gxg_G_OBJECT_w, 1, 0, 0, "(G_OBJECT obj) casts obj to G_OBJECT");
- XG_DEFINE_PROCEDURE(GDK_SCREEN, gxg_GDK_SCREEN_w, 1, 0, 0, "(GDK_SCREEN obj) casts obj to GDK_SCREEN");
- XG_DEFINE_PROCEDURE(GDK_DISPLAY_OBJECT, gxg_GDK_DISPLAY_OBJECT_w, 1, 0, 0, "(GDK_DISPLAY_OBJECT obj) casts obj to GDK_DISPLAY_OBJECT");
- XG_DEFINE_PROCEDURE(GDK_EVENT, gxg_GDK_EVENT_w, 1, 0, 0, "(GDK_EVENT obj) casts obj to GDK_EVENT");
- XG_DEFINE_PROCEDURE(GDK_EVENT_ANY, gxg_GDK_EVENT_ANY_w, 1, 0, 0, "(GDK_EVENT_ANY obj) casts obj to GDK_EVENT_ANY");
- XG_DEFINE_PROCEDURE(GDK_EVENT_EXPOSE, gxg_GDK_EVENT_EXPOSE_w, 1, 0, 0, "(GDK_EVENT_EXPOSE obj) casts obj to GDK_EVENT_EXPOSE");
- XG_DEFINE_PROCEDURE(GDK_EVENT_NOEXPOSE, gxg_GDK_EVENT_NOEXPOSE_w, 1, 0, 0, "(GDK_EVENT_NOEXPOSE obj) casts obj to GDK_EVENT_NOEXPOSE");
- XG_DEFINE_PROCEDURE(GDK_EVENT_VISIBILITY, gxg_GDK_EVENT_VISIBILITY_w, 1, 0, 0, "(GDK_EVENT_VISIBILITY obj) casts obj to GDK_EVENT_VISIBILITY");
- XG_DEFINE_PROCEDURE(GDK_EVENT_MOTION, gxg_GDK_EVENT_MOTION_w, 1, 0, 0, "(GDK_EVENT_MOTION obj) casts obj to GDK_EVENT_MOTION");
- XG_DEFINE_PROCEDURE(GDK_EVENT_BUTTON, gxg_GDK_EVENT_BUTTON_w, 1, 0, 0, "(GDK_EVENT_BUTTON obj) casts obj to GDK_EVENT_BUTTON");
- XG_DEFINE_PROCEDURE(GDK_EVENT_SCROLL, gxg_GDK_EVENT_SCROLL_w, 1, 0, 0, "(GDK_EVENT_SCROLL obj) casts obj to GDK_EVENT_SCROLL");
- XG_DEFINE_PROCEDURE(GDK_EVENT_KEY, gxg_GDK_EVENT_KEY_w, 1, 0, 0, "(GDK_EVENT_KEY obj) casts obj to GDK_EVENT_KEY");
- XG_DEFINE_PROCEDURE(GDK_EVENT_CROSSING, gxg_GDK_EVENT_CROSSING_w, 1, 0, 0, "(GDK_EVENT_CROSSING obj) casts obj to GDK_EVENT_CROSSING");
- XG_DEFINE_PROCEDURE(GDK_EVENT_FOCUS, gxg_GDK_EVENT_FOCUS_w, 1, 0, 0, "(GDK_EVENT_FOCUS obj) casts obj to GDK_EVENT_FOCUS");
- XG_DEFINE_PROCEDURE(GDK_EVENT_CONFIGURE, gxg_GDK_EVENT_CONFIGURE_w, 1, 0, 0, "(GDK_EVENT_CONFIGURE obj) casts obj to GDK_EVENT_CONFIGURE");
- XG_DEFINE_PROCEDURE(GDK_EVENT_PROPERTY, gxg_GDK_EVENT_PROPERTY_w, 1, 0, 0, "(GDK_EVENT_PROPERTY obj) casts obj to GDK_EVENT_PROPERTY");
- XG_DEFINE_PROCEDURE(GDK_EVENT_SELECTION, gxg_GDK_EVENT_SELECTION_w, 1, 0, 0, "(GDK_EVENT_SELECTION obj) casts obj to GDK_EVENT_SELECTION");
- XG_DEFINE_PROCEDURE(GDK_EVENT_PROXIMITY, gxg_GDK_EVENT_PROXIMITY_w, 1, 0, 0, "(GDK_EVENT_PROXIMITY obj) casts obj to GDK_EVENT_PROXIMITY");
- XG_DEFINE_PROCEDURE(GDK_EVENT_SETTING, gxg_GDK_EVENT_SETTING_w, 1, 0, 0, "(GDK_EVENT_SETTING obj) casts obj to GDK_EVENT_SETTING");
- XG_DEFINE_PROCEDURE(GDK_EVENT_WINDOWSTATE, gxg_GDK_EVENT_WINDOWSTATE_w, 1, 0, 0, "(GDK_EVENT_WINDOWSTATE obj) casts obj to GDK_EVENT_WINDOWSTATE");
- XG_DEFINE_PROCEDURE(GDK_EVENT_DND, gxg_GDK_EVENT_DND_w, 1, 0, 0, "(GDK_EVENT_DND obj) casts obj to GDK_EVENT_DND");
- XG_DEFINE_PROCEDURE(GTK_FILE_CHOOSER_DIALOG, gxg_GTK_FILE_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_FILE_CHOOSER_DIALOG obj) casts obj to GTK_FILE_CHOOSER_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_FILE_CHOOSER_WIDGET, gxg_GTK_FILE_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_FILE_CHOOSER_WIDGET obj) casts obj to GTK_FILE_CHOOSER_WIDGET");
- XG_DEFINE_PROCEDURE(GTK_TREE_MODEL_FILTER, gxg_GTK_TREE_MODEL_FILTER_w, 1, 0, 0, "(GTK_TREE_MODEL_FILTER obj) casts obj to GTK_TREE_MODEL_FILTER");
- XG_DEFINE_PROCEDURE(GTK_ACTION, gxg_GTK_ACTION_w, 1, 0, 0, "(GTK_ACTION obj) casts obj to GTK_ACTION");
- XG_DEFINE_PROCEDURE(GTK_ACTION_GROUP, gxg_GTK_ACTION_GROUP_w, 1, 0, 0, "(GTK_ACTION_GROUP obj) casts obj to GTK_ACTION_GROUP");
- XG_DEFINE_PROCEDURE(GTK_COMBO_BOX, gxg_GTK_COMBO_BOX_w, 1, 0, 0, "(GTK_COMBO_BOX obj) casts obj to GTK_COMBO_BOX");
- XG_DEFINE_PROCEDURE(GTK_EXPANDER, gxg_GTK_EXPANDER_w, 1, 0, 0, "(GTK_EXPANDER obj) casts obj to GTK_EXPANDER");
- XG_DEFINE_PROCEDURE(GTK_FONT_BUTTON, gxg_GTK_FONT_BUTTON_w, 1, 0, 0, "(GTK_FONT_BUTTON obj) casts obj to GTK_FONT_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_COLOR_BUTTON, gxg_GTK_COLOR_BUTTON_w, 1, 0, 0, "(GTK_COLOR_BUTTON obj) casts obj to GTK_COLOR_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_ENTRY_COMPLETION, gxg_GTK_ENTRY_COMPLETION_w, 1, 0, 0, "(GTK_ENTRY_COMPLETION obj) casts obj to GTK_ENTRY_COMPLETION");
- XG_DEFINE_PROCEDURE(GTK_RADIO_TOOL_BUTTON, gxg_GTK_RADIO_TOOL_BUTTON_w, 1, 0, 0, "(GTK_RADIO_TOOL_BUTTON obj) casts obj to GTK_RADIO_TOOL_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_RADIO_ACTION, gxg_GTK_RADIO_ACTION_w, 1, 0, 0, "(GTK_RADIO_ACTION obj) casts obj to GTK_RADIO_ACTION");
- XG_DEFINE_PROCEDURE(GTK_SEPARATOR_TOOL_ITEM, gxg_GTK_SEPARATOR_TOOL_ITEM_w, 1, 0, 0, "(GTK_SEPARATOR_TOOL_ITEM obj) casts obj to GTK_SEPARATOR_TOOL_ITEM");
- XG_DEFINE_PROCEDURE(GTK_TOGGLE_ACTION, gxg_GTK_TOGGLE_ACTION_w, 1, 0, 0, "(GTK_TOGGLE_ACTION obj) casts obj to GTK_TOGGLE_ACTION");
- XG_DEFINE_PROCEDURE(GTK_TOGGLE_TOOL_BUTTON, gxg_GTK_TOGGLE_TOOL_BUTTON_w, 1, 0, 0, "(GTK_TOGGLE_TOOL_BUTTON obj) casts obj to GTK_TOGGLE_TOOL_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_FILE_FILTER, gxg_GTK_FILE_FILTER_w, 1, 0, 0, "(GTK_FILE_FILTER obj) casts obj to GTK_FILE_FILTER");
- XG_DEFINE_PROCEDURE(GTK_CELL_LAYOUT, gxg_GTK_CELL_LAYOUT_w, 1, 0, 0, "(GTK_CELL_LAYOUT obj) casts obj to GTK_CELL_LAYOUT");
- XG_DEFINE_PROCEDURE(GTK_CLIPBOARD, gxg_GTK_CLIPBOARD_w, 1, 0, 0, "(GTK_CLIPBOARD obj) casts obj to GTK_CLIPBOARD");
- XG_DEFINE_PROCEDURE(GTK_FILE_CHOOSER, gxg_GTK_FILE_CHOOSER_w, 1, 0, 0, "(GTK_FILE_CHOOSER obj) casts obj to GTK_FILE_CHOOSER");
- XG_DEFINE_PROCEDURE(GTK_ICON_THEME, gxg_GTK_ICON_THEME_w, 1, 0, 0, "(GTK_ICON_THEME obj) casts obj to GTK_ICON_THEME");
- XG_DEFINE_PROCEDURE(GTK_TOOL_BUTTON, gxg_GTK_TOOL_BUTTON_w, 1, 0, 0, "(GTK_TOOL_BUTTON obj) casts obj to GTK_TOOL_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_TOOL_ITEM, gxg_GTK_TOOL_ITEM_w, 1, 0, 0, "(GTK_TOOL_ITEM obj) casts obj to GTK_TOOL_ITEM");
- XG_DEFINE_PROCEDURE(GTK_ACCEL_MAP, gxg_GTK_ACCEL_MAP_w, 1, 0, 0, "(GTK_ACCEL_MAP obj) casts obj to GTK_ACCEL_MAP");
- XG_DEFINE_PROCEDURE(GTK_CELL_VIEW, gxg_GTK_CELL_VIEW_w, 1, 0, 0, "(GTK_CELL_VIEW obj) casts obj to GTK_CELL_VIEW");
- XG_DEFINE_PROCEDURE(GTK_ABOUT_DIALOG, gxg_GTK_ABOUT_DIALOG_w, 1, 0, 0, "(GTK_ABOUT_DIALOG obj) casts obj to GTK_ABOUT_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER_COMBO, gxg_GTK_CELL_RENDERER_COMBO_w, 1, 0, 0, "(GTK_CELL_RENDERER_COMBO obj) casts obj to GTK_CELL_RENDERER_COMBO");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER_PROGRESS, gxg_GTK_CELL_RENDERER_PROGRESS_w, 1, 0, 0, "(GTK_CELL_RENDERER_PROGRESS obj) casts obj to GTK_CELL_RENDERER_PROGRESS");
- XG_DEFINE_PROCEDURE(GTK_ICON_VIEW, gxg_GTK_ICON_VIEW_w, 1, 0, 0, "(GTK_ICON_VIEW obj) casts obj to GTK_ICON_VIEW");
- XG_DEFINE_PROCEDURE(GTK_FILE_CHOOSER_BUTTON, gxg_GTK_FILE_CHOOSER_BUTTON_w, 1, 0, 0, "(GTK_FILE_CHOOSER_BUTTON obj) casts obj to GTK_FILE_CHOOSER_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_MENU_TOOL_BUTTON, gxg_GTK_MENU_TOOL_BUTTON_w, 1, 0, 0, "(GTK_MENU_TOOL_BUTTON obj) casts obj to GTK_MENU_TOOL_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_ASSISTANT, gxg_GTK_ASSISTANT_w, 1, 0, 0, "(GTK_ASSISTANT obj) casts obj to GTK_ASSISTANT");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER_ACCEL, gxg_GTK_CELL_RENDERER_ACCEL_w, 1, 0, 0, "(GTK_CELL_RENDERER_ACCEL obj) casts obj to GTK_CELL_RENDERER_ACCEL");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER_SPIN, gxg_GTK_CELL_RENDERER_SPIN_w, 1, 0, 0, "(GTK_CELL_RENDERER_SPIN obj) casts obj to GTK_CELL_RENDERER_SPIN");
- XG_DEFINE_PROCEDURE(GTK_LINK_BUTTON, gxg_GTK_LINK_BUTTON_w, 1, 0, 0, "(GTK_LINK_BUTTON obj) casts obj to GTK_LINK_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_RECENT_CHOOSER_DIALOG, gxg_GTK_RECENT_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_RECENT_CHOOSER_DIALOG obj) casts obj to GTK_RECENT_CHOOSER_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_RECENT_CHOOSER, gxg_GTK_RECENT_CHOOSER_w, 1, 0, 0, "(GTK_RECENT_CHOOSER obj) casts obj to GTK_RECENT_CHOOSER");
- XG_DEFINE_PROCEDURE(GTK_RECENT_CHOOSER_MENU, gxg_GTK_RECENT_CHOOSER_MENU_w, 1, 0, 0, "(GTK_RECENT_CHOOSER_MENU obj) casts obj to GTK_RECENT_CHOOSER_MENU");
- XG_DEFINE_PROCEDURE(GTK_RECENT_CHOOSER_WIDGET, gxg_GTK_RECENT_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_RECENT_CHOOSER_WIDGET obj) casts obj to GTK_RECENT_CHOOSER_WIDGET");
- XG_DEFINE_PROCEDURE(GTK_RECENT_FILTER, gxg_GTK_RECENT_FILTER_w, 1, 0, 0, "(GTK_RECENT_FILTER obj) casts obj to GTK_RECENT_FILTER");
- XG_DEFINE_PROCEDURE(GTK_RECENT_MANAGER, gxg_GTK_RECENT_MANAGER_w, 1, 0, 0, "(GTK_RECENT_MANAGER obj) casts obj to GTK_RECENT_MANAGER");
- XG_DEFINE_PROCEDURE(GTK_STATUS_ICON, gxg_GTK_STATUS_ICON_w, 1, 0, 0, "(GTK_STATUS_ICON obj) casts obj to GTK_STATUS_ICON");
- XG_DEFINE_PROCEDURE(GTK_PRINT_CONTEXT, gxg_GTK_PRINT_CONTEXT_w, 1, 0, 0, "(GTK_PRINT_CONTEXT obj) casts obj to GTK_PRINT_CONTEXT");
- XG_DEFINE_PROCEDURE(GTK_PRINT_OPERATION, gxg_GTK_PRINT_OPERATION_w, 1, 0, 0, "(GTK_PRINT_OPERATION obj) casts obj to GTK_PRINT_OPERATION");
- XG_DEFINE_PROCEDURE(GTK_PRINT_OPERATION_PREVIEW, gxg_GTK_PRINT_OPERATION_PREVIEW_w, 1, 0, 0, "(GTK_PRINT_OPERATION_PREVIEW obj) casts obj to GTK_PRINT_OPERATION_PREVIEW");
- XG_DEFINE_PROCEDURE(GTK_PRINT_SETTINGS, gxg_GTK_PRINT_SETTINGS_w, 1, 0, 0, "(GTK_PRINT_SETTINGS obj) casts obj to GTK_PRINT_SETTINGS");
- XG_DEFINE_PROCEDURE(GTK_TOOLTIP, gxg_GTK_TOOLTIP_w, 1, 0, 0, "(GTK_TOOLTIP obj) casts obj to GTK_TOOLTIP");
-#if HAVE_GTK_INFO_BAR_NEW
- XG_DEFINE_PROCEDURE(GTK_INFO_BAR, gxg_GTK_INFO_BAR_w, 1, 0, 0, "(GTK_INFO_BAR obj) casts obj to GTK_INFO_BAR");
+#if GTK_CHECK_VERSION(3, 14, 0)
+ Xg_define_procedure(GTK_GESTURE, gxg_GTK_GESTURE_w, 1, 0, 0, "(GTK_GESTURE obj) casts obj to GTK_GESTURE", NULL);
+ Xg_define_procedure(GTK_GESTURE_DRAG, gxg_GTK_GESTURE_DRAG_w, 1, 0, 0, "(GTK_GESTURE_DRAG obj) casts obj to GTK_GESTURE_DRAG", NULL);
+ Xg_define_procedure(GTK_GESTURE_LONG_PRESS, gxg_GTK_GESTURE_LONG_PRESS_w, 1, 0, 0, "(GTK_GESTURE_LONG_PRESS obj) casts obj to GTK_GESTURE_LONG_PRESS", NULL);
+ Xg_define_procedure(GTK_GESTURE_ZOOM, gxg_GTK_GESTURE_ZOOM_w, 1, 0, 0, "(GTK_GESTURE_ZOOM obj) casts obj to GTK_GESTURE_ZOOM", NULL);
+ Xg_define_procedure(GTK_GESTURE_SWIPE, gxg_GTK_GESTURE_SWIPE_w, 1, 0, 0, "(GTK_GESTURE_SWIPE obj) casts obj to GTK_GESTURE_SWIPE", NULL);
+ Xg_define_procedure(GTK_GESTURE_SINGLE, gxg_GTK_GESTURE_SINGLE_w, 1, 0, 0, "(GTK_GESTURE_SINGLE obj) casts obj to GTK_GESTURE_SINGLE", NULL);
+ Xg_define_procedure(GTK_GESTURE_PAN, gxg_GTK_GESTURE_PAN_w, 1, 0, 0, "(GTK_GESTURE_PAN obj) casts obj to GTK_GESTURE_PAN", NULL);
+ Xg_define_procedure(GTK_GESTURE_MULTI_PRESS, gxg_GTK_GESTURE_MULTI_PRESS_w, 1, 0, 0, "(GTK_GESTURE_MULTI_PRESS obj) casts obj to GTK_GESTURE_MULTI_PRESS", NULL);
+ Xg_define_procedure(GTK_GESTURE_ROTATE, gxg_GTK_GESTURE_ROTATE_w, 1, 0, 0, "(GTK_GESTURE_ROTATE obj) casts obj to GTK_GESTURE_ROTATE", NULL);
+ Xg_define_procedure(GTK_EVENT_CONTROLLER, gxg_GTK_EVENT_CONTROLLER_w, 1, 0, 0, "(GTK_EVENT_CONTROLLER obj) casts obj to GTK_EVENT_CONTROLLER", NULL);
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
- XG_DEFINE_PROCEDURE(GTK_ENTRY_BUFFER, gxg_GTK_ENTRY_BUFFER_w, 1, 0, 0, "(GTK_ENTRY_BUFFER obj) casts obj to GTK_ENTRY_BUFFER");
+#if GTK_CHECK_VERSION(3, 16, 0)
+ Xg_define_procedure(GTK_GL_AREA, gxg_GTK_GL_AREA_w, 1, 0, 0, "(GTK_GL_AREA obj) casts obj to GTK_GL_AREA", NULL);
+ Xg_define_procedure(GDK_GL_CONTEXT, gxg_GDK_GL_CONTEXT_w, 1, 0, 0, "(GDK_GL_CONTEXT obj) casts obj to GDK_GL_CONTEXT", NULL);
+ Xg_define_procedure(GTK_POPOVER_MENU, gxg_GTK_POPOVER_MENU_w, 1, 0, 0, "(GTK_POPOVER_MENU obj) casts obj to GTK_POPOVER_MENU", NULL);
+ Xg_define_procedure(GTK_STACK_SIDEBAR, gxg_GTK_STACK_SIDEBAR_w, 1, 0, 0, "(GTK_STACK_SIDEBAR obj) casts obj to GTK_STACK_SIDEBAR", NULL);
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
- XG_DEFINE_PROCEDURE(GTK_SPINNER, gxg_GTK_SPINNER_w, 1, 0, 0, "(GTK_SPINNER obj) casts obj to GTK_SPINNER");
- XG_DEFINE_PROCEDURE(GTK_CELL_RENDERER_SPINNER, gxg_GTK_CELL_RENDERER_SPINNER_w, 1, 0, 0, "(GTK_CELL_RENDERER_SPINNER obj) casts obj to GTK_CELL_RENDERER_SPINNER");
- XG_DEFINE_PROCEDURE(GTK_TOOL_PALETTE, gxg_GTK_TOOL_PALETTE_w, 1, 0, 0, "(GTK_TOOL_PALETTE obj) casts obj to GTK_TOOL_PALETTE");
- XG_DEFINE_PROCEDURE(GTK_TOOL_ITEM_GROUP, gxg_GTK_TOOL_ITEM_GROUP_w, 1, 0, 0, "(GTK_TOOL_ITEM_GROUP obj) casts obj to GTK_TOOL_ITEM_GROUP");
+ Xg_define_procedure(c-array->list, c_array_to_xen_list_w, 2, 0, 0, NULL, NULL);
+ Xg_define_procedure(list->c-array, xen_list_to_c_array_w, 2, 0, 0, NULL, NULL);
+ Xg_define_procedure(make-target-entry, gxg_make_target_entry_w, 1, 0, 0, H_make_target_entry, NULL);
+ Xg_define_procedure(g_object_get, xg_object_get_w, 3, 0, 0, NULL, NULL);
+ Xg_define_procedure(g_object_set, xg_object_set_w, 3, 0, 0, NULL, NULL);
+ Xg_define_procedure(gtk_event_keyval, xg_gtk_event_keyval_w, 1, 0, 0, NULL, NULL);
+ Xg_define_procedure(gtk_init, gxg_gtk_init_w, 0, 2, 0, H_gtk_init, NULL);
+ Xg_define_procedure(gtk_init_check, gxg_gtk_init_check_w, 0, 2, 0, H_gtk_init_check, NULL);
+ Xg_define_procedure(GDK_IS_DRAG_CONTEXT, gxg_GDK_IS_DRAG_CONTEXT_w, 1, 0, 0, "(GDK_IS_DRAG_CONTEXT obj): " PROC_TRUE " if obj is a GDK_IS_DRAG_CONTEXT", NULL);
+ Xg_define_procedure(GDK_IS_DEVICE, gxg_GDK_IS_DEVICE_w, 1, 0, 0, "(GDK_IS_DEVICE obj): " PROC_TRUE " if obj is a GDK_IS_DEVICE", NULL);
+ Xg_define_procedure(GDK_IS_KEYMAP, gxg_GDK_IS_KEYMAP_w, 1, 0, 0, "(GDK_IS_KEYMAP obj): " PROC_TRUE " if obj is a GDK_IS_KEYMAP", NULL);
+ Xg_define_procedure(GDK_IS_VISUAL, gxg_GDK_IS_VISUAL_w, 1, 0, 0, "(GDK_IS_VISUAL obj): " PROC_TRUE " if obj is a GDK_IS_VISUAL", NULL);
+ Xg_define_procedure(GDK_IS_WINDOW, gxg_GDK_IS_WINDOW_w, 1, 0, 0, "(GDK_IS_WINDOW obj): " PROC_TRUE " if obj is a GDK_IS_WINDOW", NULL);
+ Xg_define_procedure(GDK_IS_PIXBUF, gxg_GDK_IS_PIXBUF_w, 1, 0, 0, "(GDK_IS_PIXBUF obj): " PROC_TRUE " if obj is a GDK_IS_PIXBUF", NULL);
+ Xg_define_procedure(GDK_IS_PIXBUF_ANIMATION, gxg_GDK_IS_PIXBUF_ANIMATION_w, 1, 0, 0, "(GDK_IS_PIXBUF_ANIMATION obj): " PROC_TRUE " if obj is a GDK_IS_PIXBUF_ANIMATION", NULL);
+ Xg_define_procedure(GDK_IS_PIXBUF_ANIMATION_ITER, gxg_GDK_IS_PIXBUF_ANIMATION_ITER_w, 1, 0, 0, "(GDK_IS_PIXBUF_ANIMATION_ITER obj): " PROC_TRUE " if obj is a GDK_IS_PIXBUF_ANIMATION_ITER", NULL);
+ Xg_define_procedure(GTK_IS_ACCEL_GROUP, gxg_GTK_IS_ACCEL_GROUP_w, 1, 0, 0, "(GTK_IS_ACCEL_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_ACCEL_GROUP", NULL);
+ Xg_define_procedure(GTK_IS_ACCEL_LABEL, gxg_GTK_IS_ACCEL_LABEL_w, 1, 0, 0, "(GTK_IS_ACCEL_LABEL obj): " PROC_TRUE " if obj is a GTK_IS_ACCEL_LABEL", NULL);
+ Xg_define_procedure(GTK_IS_ACCESSIBLE, gxg_GTK_IS_ACCESSIBLE_w, 1, 0, 0, "(GTK_IS_ACCESSIBLE obj): " PROC_TRUE " if obj is a GTK_IS_ACCESSIBLE", NULL);
+ Xg_define_procedure(GTK_IS_ADJUSTMENT, gxg_GTK_IS_ADJUSTMENT_w, 1, 0, 0, "(GTK_IS_ADJUSTMENT obj): " PROC_TRUE " if obj is a GTK_IS_ADJUSTMENT", NULL);
+ Xg_define_procedure(GTK_IS_ASPECT_FRAME, gxg_GTK_IS_ASPECT_FRAME_w, 1, 0, 0, "(GTK_IS_ASPECT_FRAME obj): " PROC_TRUE " if obj is a GTK_IS_ASPECT_FRAME", NULL);
+ Xg_define_procedure(GTK_IS_BUTTON_BOX, gxg_GTK_IS_BUTTON_BOX_w, 1, 0, 0, "(GTK_IS_BUTTON_BOX obj): " PROC_TRUE " if obj is a GTK_IS_BUTTON_BOX", NULL);
+ Xg_define_procedure(GTK_IS_BIN, gxg_GTK_IS_BIN_w, 1, 0, 0, "(GTK_IS_BIN obj): " PROC_TRUE " if obj is a GTK_IS_BIN", NULL);
+ Xg_define_procedure(GTK_IS_BOX, gxg_GTK_IS_BOX_w, 1, 0, 0, "(GTK_IS_BOX obj): " PROC_TRUE " if obj is a GTK_IS_BOX", NULL);
+ Xg_define_procedure(GTK_IS_BUTTON, gxg_GTK_IS_BUTTON_w, 1, 0, 0, "(GTK_IS_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_CALENDAR, gxg_GTK_IS_CALENDAR_w, 1, 0, 0, "(GTK_IS_CALENDAR obj): " PROC_TRUE " if obj is a GTK_IS_CALENDAR", NULL);
+ Xg_define_procedure(GTK_IS_CELL_EDITABLE, gxg_GTK_IS_CELL_EDITABLE_w, 1, 0, 0, "(GTK_IS_CELL_EDITABLE obj): " PROC_TRUE " if obj is a GTK_IS_CELL_EDITABLE", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER, gxg_GTK_IS_CELL_RENDERER_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER_PIXBUF, gxg_GTK_IS_CELL_RENDERER_PIXBUF_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_PIXBUF obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_PIXBUF", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER_TEXT, gxg_GTK_IS_CELL_RENDERER_TEXT_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_TEXT obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_TEXT", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER_TOGGLE, gxg_GTK_IS_CELL_RENDERER_TOGGLE_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_TOGGLE obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_TOGGLE", NULL);
+ Xg_define_procedure(GTK_IS_CHECK_BUTTON, gxg_GTK_IS_CHECK_BUTTON_w, 1, 0, 0, "(GTK_IS_CHECK_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_CHECK_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_CHECK_MENU_ITEM, gxg_GTK_IS_CHECK_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_CHECK_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_CHECK_MENU_ITEM", NULL);
+ Xg_define_procedure(GTK_IS_CONTAINER, gxg_GTK_IS_CONTAINER_w, 1, 0, 0, "(GTK_IS_CONTAINER obj): " PROC_TRUE " if obj is a GTK_IS_CONTAINER", NULL);
+ Xg_define_procedure(GTK_IS_DIALOG, gxg_GTK_IS_DIALOG_w, 1, 0, 0, "(GTK_IS_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_DIALOG", NULL);
+ Xg_define_procedure(GTK_IS_DRAWING_AREA, gxg_GTK_IS_DRAWING_AREA_w, 1, 0, 0, "(GTK_IS_DRAWING_AREA obj): " PROC_TRUE " if obj is a GTK_IS_DRAWING_AREA", NULL);
+ Xg_define_procedure(GTK_IS_EDITABLE, gxg_GTK_IS_EDITABLE_w, 1, 0, 0, "(GTK_IS_EDITABLE obj): " PROC_TRUE " if obj is a GTK_IS_EDITABLE", NULL);
+ Xg_define_procedure(GTK_IS_ENTRY, gxg_GTK_IS_ENTRY_w, 1, 0, 0, "(GTK_IS_ENTRY obj): " PROC_TRUE " if obj is a GTK_IS_ENTRY", NULL);
+ Xg_define_procedure(GTK_IS_EVENT_BOX, gxg_GTK_IS_EVENT_BOX_w, 1, 0, 0, "(GTK_IS_EVENT_BOX obj): " PROC_TRUE " if obj is a GTK_IS_EVENT_BOX", NULL);
+ Xg_define_procedure(GTK_IS_FIXED, gxg_GTK_IS_FIXED_w, 1, 0, 0, "(GTK_IS_FIXED obj): " PROC_TRUE " if obj is a GTK_IS_FIXED", NULL);
+ Xg_define_procedure(GTK_IS_FRAME, gxg_GTK_IS_FRAME_w, 1, 0, 0, "(GTK_IS_FRAME obj): " PROC_TRUE " if obj is a GTK_IS_FRAME", NULL);
+ Xg_define_procedure(GTK_IS_IMAGE, gxg_GTK_IS_IMAGE_w, 1, 0, 0, "(GTK_IS_IMAGE obj): " PROC_TRUE " if obj is a GTK_IS_IMAGE", NULL);
+ Xg_define_procedure(GTK_IS_IM_CONTEXT, gxg_GTK_IS_IM_CONTEXT_w, 1, 0, 0, "(GTK_IS_IM_CONTEXT obj): " PROC_TRUE " if obj is a GTK_IS_IM_CONTEXT", NULL);
+ Xg_define_procedure(GTK_IS_IM_CONTEXT_SIMPLE, gxg_GTK_IS_IM_CONTEXT_SIMPLE_w, 1, 0, 0, "(GTK_IS_IM_CONTEXT_SIMPLE obj): " PROC_TRUE " if obj is a GTK_IS_IM_CONTEXT_SIMPLE", NULL);
+ Xg_define_procedure(GTK_IS_INVISIBLE, gxg_GTK_IS_INVISIBLE_w, 1, 0, 0, "(GTK_IS_INVISIBLE obj): " PROC_TRUE " if obj is a GTK_IS_INVISIBLE", NULL);
+ Xg_define_procedure(GTK_IS_LABEL, gxg_GTK_IS_LABEL_w, 1, 0, 0, "(GTK_IS_LABEL obj): " PROC_TRUE " if obj is a GTK_IS_LABEL", NULL);
+ Xg_define_procedure(GTK_IS_LAYOUT, gxg_GTK_IS_LAYOUT_w, 1, 0, 0, "(GTK_IS_LAYOUT obj): " PROC_TRUE " if obj is a GTK_IS_LAYOUT", NULL);
+ Xg_define_procedure(GTK_IS_LIST_STORE, gxg_GTK_IS_LIST_STORE_w, 1, 0, 0, "(GTK_IS_LIST_STORE obj): " PROC_TRUE " if obj is a GTK_IS_LIST_STORE", NULL);
+ Xg_define_procedure(GTK_IS_MENU_BAR, gxg_GTK_IS_MENU_BAR_w, 1, 0, 0, "(GTK_IS_MENU_BAR obj): " PROC_TRUE " if obj is a GTK_IS_MENU_BAR", NULL);
+ Xg_define_procedure(GTK_IS_MENU, gxg_GTK_IS_MENU_w, 1, 0, 0, "(GTK_IS_MENU obj): " PROC_TRUE " if obj is a GTK_IS_MENU", NULL);
+ Xg_define_procedure(GTK_IS_MENU_ITEM, gxg_GTK_IS_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_MENU_ITEM", NULL);
+ Xg_define_procedure(GTK_IS_MENU_SHELL, gxg_GTK_IS_MENU_SHELL_w, 1, 0, 0, "(GTK_IS_MENU_SHELL obj): " PROC_TRUE " if obj is a GTK_IS_MENU_SHELL", NULL);
+ Xg_define_procedure(GTK_IS_NOTEBOOK, gxg_GTK_IS_NOTEBOOK_w, 1, 0, 0, "(GTK_IS_NOTEBOOK obj): " PROC_TRUE " if obj is a GTK_IS_NOTEBOOK", NULL);
+ Xg_define_procedure(GTK_IS_PANED, gxg_GTK_IS_PANED_w, 1, 0, 0, "(GTK_IS_PANED obj): " PROC_TRUE " if obj is a GTK_IS_PANED", NULL);
+ Xg_define_procedure(GTK_IS_PROGRESS_BAR, gxg_GTK_IS_PROGRESS_BAR_w, 1, 0, 0, "(GTK_IS_PROGRESS_BAR obj): " PROC_TRUE " if obj is a GTK_IS_PROGRESS_BAR", NULL);
+ Xg_define_procedure(GTK_IS_RADIO_BUTTON, gxg_GTK_IS_RADIO_BUTTON_w, 1, 0, 0, "(GTK_IS_RADIO_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_RADIO_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_RADIO_MENU_ITEM, gxg_GTK_IS_RADIO_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_RADIO_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_RADIO_MENU_ITEM", NULL);
+ Xg_define_procedure(GTK_IS_RANGE, gxg_GTK_IS_RANGE_w, 1, 0, 0, "(GTK_IS_RANGE obj): " PROC_TRUE " if obj is a GTK_IS_RANGE", NULL);
+ Xg_define_procedure(GTK_IS_SCALE, gxg_GTK_IS_SCALE_w, 1, 0, 0, "(GTK_IS_SCALE obj): " PROC_TRUE " if obj is a GTK_IS_SCALE", NULL);
+ Xg_define_procedure(GTK_IS_SCROLLBAR, gxg_GTK_IS_SCROLLBAR_w, 1, 0, 0, "(GTK_IS_SCROLLBAR obj): " PROC_TRUE " if obj is a GTK_IS_SCROLLBAR", NULL);
+ Xg_define_procedure(GTK_IS_SCROLLED_WINDOW, gxg_GTK_IS_SCROLLED_WINDOW_w, 1, 0, 0, "(GTK_IS_SCROLLED_WINDOW obj): " PROC_TRUE " if obj is a GTK_IS_SCROLLED_WINDOW", NULL);
+ Xg_define_procedure(GTK_IS_SEPARATOR, gxg_GTK_IS_SEPARATOR_w, 1, 0, 0, "(GTK_IS_SEPARATOR obj): " PROC_TRUE " if obj is a GTK_IS_SEPARATOR", NULL);
+ Xg_define_procedure(GTK_IS_SEPARATOR_MENU_ITEM, gxg_GTK_IS_SEPARATOR_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_SEPARATOR_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_SEPARATOR_MENU_ITEM", NULL);
+ Xg_define_procedure(GTK_IS_SETTINGS, gxg_GTK_IS_SETTINGS_w, 1, 0, 0, "(GTK_IS_SETTINGS obj): " PROC_TRUE " if obj is a GTK_IS_SETTINGS", NULL);
+ Xg_define_procedure(GTK_IS_SIZE_GROUP, gxg_GTK_IS_SIZE_GROUP_w, 1, 0, 0, "(GTK_IS_SIZE_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_SIZE_GROUP", NULL);
+ Xg_define_procedure(GTK_IS_SPIN_BUTTON, gxg_GTK_IS_SPIN_BUTTON_w, 1, 0, 0, "(GTK_IS_SPIN_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_SPIN_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_STATUSBAR, gxg_GTK_IS_STATUSBAR_w, 1, 0, 0, "(GTK_IS_STATUSBAR obj): " PROC_TRUE " if obj is a GTK_IS_STATUSBAR", NULL);
+ Xg_define_procedure(GTK_IS_TEXT_BUFFER, gxg_GTK_IS_TEXT_BUFFER_w, 1, 0, 0, "(GTK_IS_TEXT_BUFFER obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_BUFFER", NULL);
+ Xg_define_procedure(GTK_IS_TEXT_CHILD_ANCHOR, gxg_GTK_IS_TEXT_CHILD_ANCHOR_w, 1, 0, 0, "(GTK_IS_TEXT_CHILD_ANCHOR obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_CHILD_ANCHOR", NULL);
+ Xg_define_procedure(GTK_IS_TEXT_MARK, gxg_GTK_IS_TEXT_MARK_w, 1, 0, 0, "(GTK_IS_TEXT_MARK obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_MARK", NULL);
+ Xg_define_procedure(GTK_IS_TEXT_TAG, gxg_GTK_IS_TEXT_TAG_w, 1, 0, 0, "(GTK_IS_TEXT_TAG obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_TAG", NULL);
+ Xg_define_procedure(GTK_IS_TEXT_TAG_TABLE, gxg_GTK_IS_TEXT_TAG_TABLE_w, 1, 0, 0, "(GTK_IS_TEXT_TAG_TABLE obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_TAG_TABLE", NULL);
+ Xg_define_procedure(GTK_IS_TEXT_VIEW, gxg_GTK_IS_TEXT_VIEW_w, 1, 0, 0, "(GTK_IS_TEXT_VIEW obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_VIEW", NULL);
+ Xg_define_procedure(GTK_IS_TOGGLE_BUTTON, gxg_GTK_IS_TOGGLE_BUTTON_w, 1, 0, 0, "(GTK_IS_TOGGLE_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_TOGGLE_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_TOOLBAR, gxg_GTK_IS_TOOLBAR_w, 1, 0, 0, "(GTK_IS_TOOLBAR obj): " PROC_TRUE " if obj is a GTK_IS_TOOLBAR", NULL);
+ Xg_define_procedure(GTK_IS_TREE_DRAG_SOURCE, gxg_GTK_IS_TREE_DRAG_SOURCE_w, 1, 0, 0, "(GTK_IS_TREE_DRAG_SOURCE obj): " PROC_TRUE " if obj is a GTK_IS_TREE_DRAG_SOURCE", NULL);
+ Xg_define_procedure(GTK_IS_TREE_DRAG_DEST, gxg_GTK_IS_TREE_DRAG_DEST_w, 1, 0, 0, "(GTK_IS_TREE_DRAG_DEST obj): " PROC_TRUE " if obj is a GTK_IS_TREE_DRAG_DEST", NULL);
+ Xg_define_procedure(GTK_IS_TREE_MODEL, gxg_GTK_IS_TREE_MODEL_w, 1, 0, 0, "(GTK_IS_TREE_MODEL obj): " PROC_TRUE " if obj is a GTK_IS_TREE_MODEL", NULL);
+ Xg_define_procedure(GTK_IS_TREE_MODEL_SORT, gxg_GTK_IS_TREE_MODEL_SORT_w, 1, 0, 0, "(GTK_IS_TREE_MODEL_SORT obj): " PROC_TRUE " if obj is a GTK_IS_TREE_MODEL_SORT", NULL);
+ Xg_define_procedure(GTK_IS_TREE_SELECTION, gxg_GTK_IS_TREE_SELECTION_w, 1, 0, 0, "(GTK_IS_TREE_SELECTION obj): " PROC_TRUE " if obj is a GTK_IS_TREE_SELECTION", NULL);
+ Xg_define_procedure(GTK_IS_TREE_SORTABLE, gxg_GTK_IS_TREE_SORTABLE_w, 1, 0, 0, "(GTK_IS_TREE_SORTABLE obj): " PROC_TRUE " if obj is a GTK_IS_TREE_SORTABLE", NULL);
+ Xg_define_procedure(GTK_IS_TREE_STORE, gxg_GTK_IS_TREE_STORE_w, 1, 0, 0, "(GTK_IS_TREE_STORE obj): " PROC_TRUE " if obj is a GTK_IS_TREE_STORE", NULL);
+ Xg_define_procedure(GTK_IS_TREE_VIEW_COLUMN, gxg_GTK_IS_TREE_VIEW_COLUMN_w, 1, 0, 0, "(GTK_IS_TREE_VIEW_COLUMN obj): " PROC_TRUE " if obj is a GTK_IS_TREE_VIEW_COLUMN", NULL);
+ Xg_define_procedure(GTK_IS_TREE_VIEW, gxg_GTK_IS_TREE_VIEW_w, 1, 0, 0, "(GTK_IS_TREE_VIEW obj): " PROC_TRUE " if obj is a GTK_IS_TREE_VIEW", NULL);
+ Xg_define_procedure(GTK_IS_VIEWPORT, gxg_GTK_IS_VIEWPORT_w, 1, 0, 0, "(GTK_IS_VIEWPORT obj): " PROC_TRUE " if obj is a GTK_IS_VIEWPORT", NULL);
+ Xg_define_procedure(GTK_IS_WIDGET, gxg_GTK_IS_WIDGET_w, 1, 0, 0, "(GTK_IS_WIDGET obj): " PROC_TRUE " if obj is a GTK_IS_WIDGET", NULL);
+ Xg_define_procedure(GTK_IS_WINDOW, gxg_GTK_IS_WINDOW_w, 1, 0, 0, "(GTK_IS_WINDOW obj): " PROC_TRUE " if obj is a GTK_IS_WINDOW", NULL);
+ Xg_define_procedure(PANGO_IS_CONTEXT, gxg_PANGO_IS_CONTEXT_w, 1, 0, 0, "(PANGO_IS_CONTEXT obj): " PROC_TRUE " if obj is a PANGO_IS_CONTEXT", NULL);
+ Xg_define_procedure(PANGO_IS_FONT_FAMILY, gxg_PANGO_IS_FONT_FAMILY_w, 1, 0, 0, "(PANGO_IS_FONT_FAMILY obj): " PROC_TRUE " if obj is a PANGO_IS_FONT_FAMILY", NULL);
+ Xg_define_procedure(PANGO_IS_FONT_FACE, gxg_PANGO_IS_FONT_FACE_w, 1, 0, 0, "(PANGO_IS_FONT_FACE obj): " PROC_TRUE " if obj is a PANGO_IS_FONT_FACE", NULL);
+ Xg_define_procedure(PANGO_IS_FONT, gxg_PANGO_IS_FONT_w, 1, 0, 0, "(PANGO_IS_FONT obj): " PROC_TRUE " if obj is a PANGO_IS_FONT", NULL);
+ Xg_define_procedure(PANGO_IS_FONT_MAP, gxg_PANGO_IS_FONT_MAP_w, 1, 0, 0, "(PANGO_IS_FONT_MAP obj): " PROC_TRUE " if obj is a PANGO_IS_FONT_MAP", NULL);
+ Xg_define_procedure(PANGO_IS_LAYOUT, gxg_PANGO_IS_LAYOUT_w, 1, 0, 0, "(PANGO_IS_LAYOUT obj): " PROC_TRUE " if obj is a PANGO_IS_LAYOUT", NULL);
+ Xg_define_procedure(G_IS_OBJECT, gxg_G_IS_OBJECT_w, 1, 0, 0, "(G_IS_OBJECT obj): " PROC_TRUE " if obj is a G_IS_OBJECT", NULL);
+ Xg_define_procedure(GDK_IS_SCREEN, gxg_GDK_IS_SCREEN_w, 1, 0, 0, "(GDK_IS_SCREEN obj): " PROC_TRUE " if obj is a GDK_IS_SCREEN", NULL);
+ Xg_define_procedure(GDK_IS_DISPLAY, gxg_GDK_IS_DISPLAY_w, 1, 0, 0, "(GDK_IS_DISPLAY obj): " PROC_TRUE " if obj is a GDK_IS_DISPLAY", NULL);
+ Xg_define_procedure(GTK_IS_FILE_CHOOSER_DIALOG, gxg_GTK_IS_FILE_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_IS_FILE_CHOOSER_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_FILE_CHOOSER_DIALOG", NULL);
+ Xg_define_procedure(GTK_IS_FILE_CHOOSER_WIDGET, gxg_GTK_IS_FILE_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_IS_FILE_CHOOSER_WIDGET obj): " PROC_TRUE " if obj is a GTK_IS_FILE_CHOOSER_WIDGET", NULL);
+ Xg_define_procedure(GTK_IS_TREE_MODEL_FILTER, gxg_GTK_IS_TREE_MODEL_FILTER_w, 1, 0, 0, "(GTK_IS_TREE_MODEL_FILTER obj): " PROC_TRUE " if obj is a GTK_IS_TREE_MODEL_FILTER", NULL);
+ Xg_define_procedure(GTK_IS_COMBO_BOX, gxg_GTK_IS_COMBO_BOX_w, 1, 0, 0, "(GTK_IS_COMBO_BOX obj): " PROC_TRUE " if obj is a GTK_IS_COMBO_BOX", NULL);
+ Xg_define_procedure(GTK_IS_EXPANDER, gxg_GTK_IS_EXPANDER_w, 1, 0, 0, "(GTK_IS_EXPANDER obj): " PROC_TRUE " if obj is a GTK_IS_EXPANDER", NULL);
+ Xg_define_procedure(GTK_IS_FONT_BUTTON, gxg_GTK_IS_FONT_BUTTON_w, 1, 0, 0, "(GTK_IS_FONT_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_FONT_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_COLOR_BUTTON, gxg_GTK_IS_COLOR_BUTTON_w, 1, 0, 0, "(GTK_IS_COLOR_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_COLOR_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_ENTRY_COMPLETION, gxg_GTK_IS_ENTRY_COMPLETION_w, 1, 0, 0, "(GTK_IS_ENTRY_COMPLETION obj): " PROC_TRUE " if obj is a GTK_IS_ENTRY_COMPLETION", NULL);
+ Xg_define_procedure(GTK_IS_RADIO_TOOL_BUTTON, gxg_GTK_IS_RADIO_TOOL_BUTTON_w, 1, 0, 0, "(GTK_IS_RADIO_TOOL_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_RADIO_TOOL_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_SEPARATOR_TOOL_ITEM, gxg_GTK_IS_SEPARATOR_TOOL_ITEM_w, 1, 0, 0, "(GTK_IS_SEPARATOR_TOOL_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_SEPARATOR_TOOL_ITEM", NULL);
+ Xg_define_procedure(GTK_IS_TOGGLE_TOOL_BUTTON, gxg_GTK_IS_TOGGLE_TOOL_BUTTON_w, 1, 0, 0, "(GTK_IS_TOGGLE_TOOL_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_TOGGLE_TOOL_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_FILE_FILTER, gxg_GTK_IS_FILE_FILTER_w, 1, 0, 0, "(GTK_IS_FILE_FILTER obj): " PROC_TRUE " if obj is a GTK_IS_FILE_FILTER", NULL);
+ Xg_define_procedure(GTK_IS_CELL_LAYOUT, gxg_GTK_IS_CELL_LAYOUT_w, 1, 0, 0, "(GTK_IS_CELL_LAYOUT obj): " PROC_TRUE " if obj is a GTK_IS_CELL_LAYOUT", NULL);
+ Xg_define_procedure(GTK_IS_CLIPBOARD, gxg_GTK_IS_CLIPBOARD_w, 1, 0, 0, "(GTK_IS_CLIPBOARD obj): " PROC_TRUE " if obj is a GTK_IS_CLIPBOARD", NULL);
+ Xg_define_procedure(GTK_IS_FILE_CHOOSER, gxg_GTK_IS_FILE_CHOOSER_w, 1, 0, 0, "(GTK_IS_FILE_CHOOSER obj): " PROC_TRUE " if obj is a GTK_IS_FILE_CHOOSER", NULL);
+ Xg_define_procedure(GTK_IS_ICON_THEME, gxg_GTK_IS_ICON_THEME_w, 1, 0, 0, "(GTK_IS_ICON_THEME obj): " PROC_TRUE " if obj is a GTK_IS_ICON_THEME", NULL);
+ Xg_define_procedure(GTK_IS_TOOL_BUTTON, gxg_GTK_IS_TOOL_BUTTON_w, 1, 0, 0, "(GTK_IS_TOOL_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_TOOL_ITEM, gxg_GTK_IS_TOOL_ITEM_w, 1, 0, 0, "(GTK_IS_TOOL_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_ITEM", NULL);
+ Xg_define_procedure(GTK_IS_ACCEL_MAP, gxg_GTK_IS_ACCEL_MAP_w, 1, 0, 0, "(GTK_IS_ACCEL_MAP obj): " PROC_TRUE " if obj is a GTK_IS_ACCEL_MAP", NULL);
+ Xg_define_procedure(GTK_IS_CELL_VIEW, gxg_GTK_IS_CELL_VIEW_w, 1, 0, 0, "(GTK_IS_CELL_VIEW obj): " PROC_TRUE " if obj is a GTK_IS_CELL_VIEW", NULL);
+ Xg_define_procedure(GTK_IS_ABOUT_DIALOG, gxg_GTK_IS_ABOUT_DIALOG_w, 1, 0, 0, "(GTK_IS_ABOUT_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_ABOUT_DIALOG", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER_COMBO, gxg_GTK_IS_CELL_RENDERER_COMBO_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_COMBO obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_COMBO", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER_PROGRESS, gxg_GTK_IS_CELL_RENDERER_PROGRESS_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_PROGRESS obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_PROGRESS", NULL);
+ Xg_define_procedure(GTK_IS_ICON_VIEW, gxg_GTK_IS_ICON_VIEW_w, 1, 0, 0, "(GTK_IS_ICON_VIEW obj): " PROC_TRUE " if obj is a GTK_IS_ICON_VIEW", NULL);
+ Xg_define_procedure(GTK_IS_FILE_CHOOSER_BUTTON, gxg_GTK_IS_FILE_CHOOSER_BUTTON_w, 1, 0, 0, "(GTK_IS_FILE_CHOOSER_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_FILE_CHOOSER_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_MENU_TOOL_BUTTON, gxg_GTK_IS_MENU_TOOL_BUTTON_w, 1, 0, 0, "(GTK_IS_MENU_TOOL_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_MENU_TOOL_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_ASSISTANT, gxg_GTK_IS_ASSISTANT_w, 1, 0, 0, "(GTK_IS_ASSISTANT obj): " PROC_TRUE " if obj is a GTK_IS_ASSISTANT", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER_ACCEL, gxg_GTK_IS_CELL_RENDERER_ACCEL_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_ACCEL obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_ACCEL", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER_SPIN, gxg_GTK_IS_CELL_RENDERER_SPIN_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_SPIN obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_SPIN", NULL);
+ Xg_define_procedure(GTK_IS_LINK_BUTTON, gxg_GTK_IS_LINK_BUTTON_w, 1, 0, 0, "(GTK_IS_LINK_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_LINK_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_RECENT_CHOOSER_DIALOG, gxg_GTK_IS_RECENT_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_IS_RECENT_CHOOSER_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_CHOOSER_DIALOG", NULL);
+ Xg_define_procedure(GTK_IS_RECENT_CHOOSER, gxg_GTK_IS_RECENT_CHOOSER_w, 1, 0, 0, "(GTK_IS_RECENT_CHOOSER obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_CHOOSER", NULL);
+ Xg_define_procedure(GTK_IS_RECENT_CHOOSER_MENU, gxg_GTK_IS_RECENT_CHOOSER_MENU_w, 1, 0, 0, "(GTK_IS_RECENT_CHOOSER_MENU obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_CHOOSER_MENU", NULL);
+ Xg_define_procedure(GTK_IS_RECENT_CHOOSER_WIDGET, gxg_GTK_IS_RECENT_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_IS_RECENT_CHOOSER_WIDGET obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_CHOOSER_WIDGET", NULL);
+ Xg_define_procedure(GTK_IS_RECENT_FILTER, gxg_GTK_IS_RECENT_FILTER_w, 1, 0, 0, "(GTK_IS_RECENT_FILTER obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_FILTER", NULL);
+ Xg_define_procedure(GTK_IS_RECENT_MANAGER, gxg_GTK_IS_RECENT_MANAGER_w, 1, 0, 0, "(GTK_IS_RECENT_MANAGER obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_MANAGER", NULL);
+ Xg_define_procedure(GTK_IS_PRINT_CONTEXT, gxg_GTK_IS_PRINT_CONTEXT_w, 1, 0, 0, "(GTK_IS_PRINT_CONTEXT obj): " PROC_TRUE " if obj is a GTK_IS_PRINT_CONTEXT", NULL);
+ Xg_define_procedure(GTK_IS_PRINT_OPERATION, gxg_GTK_IS_PRINT_OPERATION_w, 1, 0, 0, "(GTK_IS_PRINT_OPERATION obj): " PROC_TRUE " if obj is a GTK_IS_PRINT_OPERATION", NULL);
+ Xg_define_procedure(GTK_IS_PRINT_OPERATION_PREVIEW, gxg_GTK_IS_PRINT_OPERATION_PREVIEW_w, 1, 0, 0, "(GTK_IS_PRINT_OPERATION_PREVIEW obj): " PROC_TRUE " if obj is a GTK_IS_PRINT_OPERATION_PREVIEW", NULL);
+ Xg_define_procedure(GTK_IS_PRINT_SETTINGS, gxg_GTK_IS_PRINT_SETTINGS_w, 1, 0, 0, "(GTK_IS_PRINT_SETTINGS obj): " PROC_TRUE " if obj is a GTK_IS_PRINT_SETTINGS", NULL);
+ Xg_define_procedure(GTK_IS_TOOLTIP, gxg_GTK_IS_TOOLTIP_w, 1, 0, 0, "(GTK_IS_TOOLTIP obj): " PROC_TRUE " if obj is a GTK_IS_TOOLTIP", NULL);
+#if GTK_CHECK_VERSION(2, 18, 0)
+ Xg_define_procedure(GTK_IS_INFO_BAR, gxg_GTK_IS_INFO_BAR_w, 1, 0, 0, "(GTK_IS_INFO_BAR obj): " PROC_TRUE " if obj is a GTK_IS_INFO_BAR", NULL);
+ Xg_define_procedure(GTK_IS_ENTRY_BUFFER, gxg_GTK_IS_ENTRY_BUFFER_w, 1, 0, 0, "(GTK_IS_ENTRY_BUFFER obj): " PROC_TRUE " if obj is a GTK_IS_ENTRY_BUFFER", NULL);
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
- XG_DEFINE_PROCEDURE(GTK_COMBO_BOX_TEXT, gxg_GTK_COMBO_BOX_TEXT_w, 1, 0, 0, "(GTK_COMBO_BOX_TEXT obj) casts obj to GTK_COMBO_BOX_TEXT");
- XG_DEFINE_PROCEDURE(GTK_GRID, gxg_GTK_GRID_w, 1, 0, 0, "(GTK_GRID obj) casts obj to GTK_GRID");
- XG_DEFINE_PROCEDURE(GTK_SCROLLABLE, gxg_GTK_SCROLLABLE_w, 1, 0, 0, "(GTK_SCROLLABLE obj) casts obj to GTK_SCROLLABLE");
- XG_DEFINE_PROCEDURE(GTK_SWITCH, gxg_GTK_SWITCH_w, 1, 0, 0, "(GTK_SWITCH obj) casts obj to GTK_SWITCH");
- XG_DEFINE_PROCEDURE(GTK_ACTIVATABLE, gxg_GTK_ACTIVATABLE_w, 1, 0, 0, "(GTK_ACTIVATABLE obj) casts obj to GTK_ACTIVATABLE");
- XG_DEFINE_PROCEDURE(GTK_ORIENTABLE, gxg_GTK_ORIENTABLE_w, 1, 0, 0, "(GTK_ORIENTABLE obj) casts obj to GTK_ORIENTABLE");
- XG_DEFINE_PROCEDURE(GTK_WINDOW_GROUP, gxg_GTK_WINDOW_GROUP_w, 1, 0, 0, "(GTK_WINDOW_GROUP obj) casts obj to GTK_WINDOW_GROUP");
- XG_DEFINE_PROCEDURE(GTK_TOOL_SHELL, gxg_GTK_TOOL_SHELL_w, 1, 0, 0, "(GTK_TOOL_SHELL obj) casts obj to GTK_TOOL_SHELL");
+#if GTK_CHECK_VERSION(2, 20, 0)
+ Xg_define_procedure(GTK_IS_SPINNER, gxg_GTK_IS_SPINNER_w, 1, 0, 0, "(GTK_IS_SPINNER obj): " PROC_TRUE " if obj is a GTK_IS_SPINNER", NULL);
+ Xg_define_procedure(GTK_IS_CELL_RENDERER_SPINNER, gxg_GTK_IS_CELL_RENDERER_SPINNER_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_SPINNER obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_SPINNER", NULL);
+ Xg_define_procedure(GTK_IS_TOOL_PALETTE, gxg_GTK_IS_TOOL_PALETTE_w, 1, 0, 0, "(GTK_IS_TOOL_PALETTE obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_PALETTE", NULL);
+ Xg_define_procedure(GTK_IS_TOOL_ITEM_GROUP, gxg_GTK_IS_TOOL_ITEM_GROUP_w, 1, 0, 0, "(GTK_IS_TOOL_ITEM_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_ITEM_GROUP", NULL);
#endif
-#if (!HAVE_GTK_3)
- XG_DEFINE_PROCEDURE(GDK_COLORMAP, gxg_GDK_COLORMAP_w, 1, 0, 0, "(GDK_COLORMAP obj) casts obj to GDK_COLORMAP");
- XG_DEFINE_PROCEDURE(GDK_DRAWABLE, gxg_GDK_DRAWABLE_w, 1, 0, 0, "(GDK_DRAWABLE obj) casts obj to GDK_DRAWABLE");
- XG_DEFINE_PROCEDURE(GDK_PIXMAP, gxg_GDK_PIXMAP_w, 1, 0, 0, "(GDK_PIXMAP obj) casts obj to GDK_PIXMAP");
- XG_DEFINE_PROCEDURE(GTK_OBJECT, gxg_GTK_OBJECT_w, 1, 0, 0, "(GTK_OBJECT obj) casts obj to GTK_OBJECT");
- XG_DEFINE_PROCEDURE(GTK_STYLE, gxg_GTK_STYLE_w, 1, 0, 0, "(GTK_STYLE obj) casts obj to GTK_STYLE");
+#if GTK_CHECK_VERSION(3, 0, 0)
+ Xg_define_procedure(GTK_IS_COMBO_BOX_TEXT, gxg_GTK_IS_COMBO_BOX_TEXT_w, 1, 0, 0, "(GTK_IS_COMBO_BOX_TEXT obj): " PROC_TRUE " if obj is a GTK_IS_COMBO_BOX_TEXT", NULL);
+ Xg_define_procedure(GTK_IS_GRID, gxg_GTK_IS_GRID_w, 1, 0, 0, "(GTK_IS_GRID obj): " PROC_TRUE " if obj is a GTK_IS_GRID", NULL);
+ Xg_define_procedure(GTK_IS_SCROLLABLE, gxg_GTK_IS_SCROLLABLE_w, 1, 0, 0, "(GTK_IS_SCROLLABLE obj): " PROC_TRUE " if obj is a GTK_IS_SCROLLABLE", NULL);
+ Xg_define_procedure(GTK_IS_SWITCH, gxg_GTK_IS_SWITCH_w, 1, 0, 0, "(GTK_IS_SWITCH obj): " PROC_TRUE " if obj is a GTK_IS_SWITCH", NULL);
+ Xg_define_procedure(GTK_IS_ORIENTABLE, gxg_GTK_IS_ORIENTABLE_w, 1, 0, 0, "(GTK_IS_ORIENTABLE obj): " PROC_TRUE " if obj is a GTK_IS_ORIENTABLE", NULL);
+ Xg_define_procedure(GTK_IS_WINDOW_GROUP, gxg_GTK_IS_WINDOW_GROUP_w, 1, 0, 0, "(GTK_IS_WINDOW_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_WINDOW_GROUP", NULL);
+ Xg_define_procedure(GTK_IS_TOOL_SHELL, gxg_GTK_IS_TOOL_SHELL_w, 1, 0, 0, "(GTK_IS_TOOL_SHELL obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_SHELL", NULL);
#endif
- XG_DEFINE_PROCEDURE(c-array->list, c_array_to_xen_list_w, 2, 0, 0, NULL);
- XG_DEFINE_PROCEDURE(list->c-array, xen_list_to_c_array_w, 2, 0, 0, NULL);
- XG_DEFINE_PROCEDURE(->string, c_to_xen_string_w, 1, 0, 0, NULL);
- XG_DEFINE_PROCEDURE(make-target-entry, gxg_make_target_entry_w, 1, 0, 0, H_make_target_entry);
- XG_DEFINE_PROCEDURE(g_object_get, xg_object_get_w, 3, 0, 0, NULL);
- XG_DEFINE_PROCEDURE(gtk_event_keyval, xg_gtk_event_keyval_w, 1, 0, 0, NULL);
- XG_DEFINE_PROCEDURE(gtk_init, gxg_gtk_init_w, 0, 2, 0, H_gtk_init);
- XG_DEFINE_PROCEDURE(gtk_init_check, gxg_gtk_init_check_w, 0, 2, 0, H_gtk_init_check);
- XG_DEFINE_PROCEDURE(GDK_IS_DRAG_CONTEXT, gxg_GDK_IS_DRAG_CONTEXT_w, 1, 0, 0, "(GDK_IS_DRAG_CONTEXT obj): " PROC_TRUE " if obj is a GDK_IS_DRAG_CONTEXT");
- XG_DEFINE_PROCEDURE(GDK_IS_DEVICE, gxg_GDK_IS_DEVICE_w, 1, 0, 0, "(GDK_IS_DEVICE obj): " PROC_TRUE " if obj is a GDK_IS_DEVICE");
- XG_DEFINE_PROCEDURE(GDK_IS_KEYMAP, gxg_GDK_IS_KEYMAP_w, 1, 0, 0, "(GDK_IS_KEYMAP obj): " PROC_TRUE " if obj is a GDK_IS_KEYMAP");
- XG_DEFINE_PROCEDURE(GDK_IS_VISUAL, gxg_GDK_IS_VISUAL_w, 1, 0, 0, "(GDK_IS_VISUAL obj): " PROC_TRUE " if obj is a GDK_IS_VISUAL");
- XG_DEFINE_PROCEDURE(GDK_IS_WINDOW, gxg_GDK_IS_WINDOW_w, 1, 0, 0, "(GDK_IS_WINDOW obj): " PROC_TRUE " if obj is a GDK_IS_WINDOW");
- XG_DEFINE_PROCEDURE(GDK_IS_PIXBUF, gxg_GDK_IS_PIXBUF_w, 1, 0, 0, "(GDK_IS_PIXBUF obj): " PROC_TRUE " if obj is a GDK_IS_PIXBUF");
- XG_DEFINE_PROCEDURE(GDK_IS_PIXBUF_ANIMATION, gxg_GDK_IS_PIXBUF_ANIMATION_w, 1, 0, 0, "(GDK_IS_PIXBUF_ANIMATION obj): " PROC_TRUE " if obj is a GDK_IS_PIXBUF_ANIMATION");
- XG_DEFINE_PROCEDURE(GDK_IS_PIXBUF_ANIMATION_ITER, gxg_GDK_IS_PIXBUF_ANIMATION_ITER_w, 1, 0, 0, "(GDK_IS_PIXBUF_ANIMATION_ITER obj): " PROC_TRUE " if obj is a GDK_IS_PIXBUF_ANIMATION_ITER");
- XG_DEFINE_PROCEDURE(GTK_IS_VBOX, gxg_GTK_IS_VBOX_w, 1, 0, 0, "(GTK_IS_VBOX obj): " PROC_TRUE " if obj is a GTK_IS_VBOX");
- XG_DEFINE_PROCEDURE(GTK_IS_ACCEL_GROUP, gxg_GTK_IS_ACCEL_GROUP_w, 1, 0, 0, "(GTK_IS_ACCEL_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_ACCEL_GROUP");
- XG_DEFINE_PROCEDURE(GTK_IS_ACCEL_LABEL, gxg_GTK_IS_ACCEL_LABEL_w, 1, 0, 0, "(GTK_IS_ACCEL_LABEL obj): " PROC_TRUE " if obj is a GTK_IS_ACCEL_LABEL");
- XG_DEFINE_PROCEDURE(GTK_IS_ACCESSIBLE, gxg_GTK_IS_ACCESSIBLE_w, 1, 0, 0, "(GTK_IS_ACCESSIBLE obj): " PROC_TRUE " if obj is a GTK_IS_ACCESSIBLE");
- XG_DEFINE_PROCEDURE(GTK_IS_ADJUSTMENT, gxg_GTK_IS_ADJUSTMENT_w, 1, 0, 0, "(GTK_IS_ADJUSTMENT obj): " PROC_TRUE " if obj is a GTK_IS_ADJUSTMENT");
- XG_DEFINE_PROCEDURE(GTK_IS_ALIGNMENT, gxg_GTK_IS_ALIGNMENT_w, 1, 0, 0, "(GTK_IS_ALIGNMENT obj): " PROC_TRUE " if obj is a GTK_IS_ALIGNMENT");
- XG_DEFINE_PROCEDURE(GTK_IS_ARROW, gxg_GTK_IS_ARROW_w, 1, 0, 0, "(GTK_IS_ARROW obj): " PROC_TRUE " if obj is a GTK_IS_ARROW");
- XG_DEFINE_PROCEDURE(GTK_IS_ASPECT_FRAME, gxg_GTK_IS_ASPECT_FRAME_w, 1, 0, 0, "(GTK_IS_ASPECT_FRAME obj): " PROC_TRUE " if obj is a GTK_IS_ASPECT_FRAME");
- XG_DEFINE_PROCEDURE(GTK_IS_BUTTON_BOX, gxg_GTK_IS_BUTTON_BOX_w, 1, 0, 0, "(GTK_IS_BUTTON_BOX obj): " PROC_TRUE " if obj is a GTK_IS_BUTTON_BOX");
- XG_DEFINE_PROCEDURE(GTK_IS_BIN, gxg_GTK_IS_BIN_w, 1, 0, 0, "(GTK_IS_BIN obj): " PROC_TRUE " if obj is a GTK_IS_BIN");
- XG_DEFINE_PROCEDURE(GTK_IS_BOX, gxg_GTK_IS_BOX_w, 1, 0, 0, "(GTK_IS_BOX obj): " PROC_TRUE " if obj is a GTK_IS_BOX");
- XG_DEFINE_PROCEDURE(GTK_IS_BUTTON, gxg_GTK_IS_BUTTON_w, 1, 0, 0, "(GTK_IS_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_CALENDAR, gxg_GTK_IS_CALENDAR_w, 1, 0, 0, "(GTK_IS_CALENDAR obj): " PROC_TRUE " if obj is a GTK_IS_CALENDAR");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_EDITABLE, gxg_GTK_IS_CELL_EDITABLE_w, 1, 0, 0, "(GTK_IS_CELL_EDITABLE obj): " PROC_TRUE " if obj is a GTK_IS_CELL_EDITABLE");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER, gxg_GTK_IS_CELL_RENDERER_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER_PIXBUF, gxg_GTK_IS_CELL_RENDERER_PIXBUF_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_PIXBUF obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_PIXBUF");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER_TEXT, gxg_GTK_IS_CELL_RENDERER_TEXT_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_TEXT obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_TEXT");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER_TOGGLE, gxg_GTK_IS_CELL_RENDERER_TOGGLE_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_TOGGLE obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_TOGGLE");
- XG_DEFINE_PROCEDURE(GTK_IS_CHECK_BUTTON, gxg_GTK_IS_CHECK_BUTTON_w, 1, 0, 0, "(GTK_IS_CHECK_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_CHECK_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_CHECK_MENU_ITEM, gxg_GTK_IS_CHECK_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_CHECK_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_CHECK_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IS_COLOR_SELECTION_DIALOG, gxg_GTK_IS_COLOR_SELECTION_DIALOG_w, 1, 0, 0, "(GTK_IS_COLOR_SELECTION_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_COLOR_SELECTION_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_IS_COLOR_SELECTION, gxg_GTK_IS_COLOR_SELECTION_w, 1, 0, 0, "(GTK_IS_COLOR_SELECTION obj): " PROC_TRUE " if obj is a GTK_IS_COLOR_SELECTION");
- XG_DEFINE_PROCEDURE(GTK_IS_CONTAINER, gxg_GTK_IS_CONTAINER_w, 1, 0, 0, "(GTK_IS_CONTAINER obj): " PROC_TRUE " if obj is a GTK_IS_CONTAINER");
- XG_DEFINE_PROCEDURE(GTK_IS_DIALOG, gxg_GTK_IS_DIALOG_w, 1, 0, 0, "(GTK_IS_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_IS_DRAWING_AREA, gxg_GTK_IS_DRAWING_AREA_w, 1, 0, 0, "(GTK_IS_DRAWING_AREA obj): " PROC_TRUE " if obj is a GTK_IS_DRAWING_AREA");
- XG_DEFINE_PROCEDURE(GTK_IS_EDITABLE, gxg_GTK_IS_EDITABLE_w, 1, 0, 0, "(GTK_IS_EDITABLE obj): " PROC_TRUE " if obj is a GTK_IS_EDITABLE");
- XG_DEFINE_PROCEDURE(GTK_IS_ENTRY, gxg_GTK_IS_ENTRY_w, 1, 0, 0, "(GTK_IS_ENTRY obj): " PROC_TRUE " if obj is a GTK_IS_ENTRY");
- XG_DEFINE_PROCEDURE(GTK_IS_EVENT_BOX, gxg_GTK_IS_EVENT_BOX_w, 1, 0, 0, "(GTK_IS_EVENT_BOX obj): " PROC_TRUE " if obj is a GTK_IS_EVENT_BOX");
- XG_DEFINE_PROCEDURE(GTK_IS_FIXED, gxg_GTK_IS_FIXED_w, 1, 0, 0, "(GTK_IS_FIXED obj): " PROC_TRUE " if obj is a GTK_IS_FIXED");
- XG_DEFINE_PROCEDURE(GTK_IS_FONT_SELECTION, gxg_GTK_IS_FONT_SELECTION_w, 1, 0, 0, "(GTK_IS_FONT_SELECTION obj): " PROC_TRUE " if obj is a GTK_IS_FONT_SELECTION");
- XG_DEFINE_PROCEDURE(GTK_IS_FONT_SELECTION_DIALOG, gxg_GTK_IS_FONT_SELECTION_DIALOG_w, 1, 0, 0, "(GTK_IS_FONT_SELECTION_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_FONT_SELECTION_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_IS_FRAME, gxg_GTK_IS_FRAME_w, 1, 0, 0, "(GTK_IS_FRAME obj): " PROC_TRUE " if obj is a GTK_IS_FRAME");
- XG_DEFINE_PROCEDURE(GTK_IS_HANDLE_BOX, gxg_GTK_IS_HANDLE_BOX_w, 1, 0, 0, "(GTK_IS_HANDLE_BOX obj): " PROC_TRUE " if obj is a GTK_IS_HANDLE_BOX");
- XG_DEFINE_PROCEDURE(GTK_IS_HBUTTON_BOX, gxg_GTK_IS_HBUTTON_BOX_w, 1, 0, 0, "(GTK_IS_HBUTTON_BOX obj): " PROC_TRUE " if obj is a GTK_IS_HBUTTON_BOX");
- XG_DEFINE_PROCEDURE(GTK_IS_HBOX, gxg_GTK_IS_HBOX_w, 1, 0, 0, "(GTK_IS_HBOX obj): " PROC_TRUE " if obj is a GTK_IS_HBOX");
- XG_DEFINE_PROCEDURE(GTK_IS_HPANED, gxg_GTK_IS_HPANED_w, 1, 0, 0, "(GTK_IS_HPANED obj): " PROC_TRUE " if obj is a GTK_IS_HPANED");
- XG_DEFINE_PROCEDURE(GTK_IS_HSCALE, gxg_GTK_IS_HSCALE_w, 1, 0, 0, "(GTK_IS_HSCALE obj): " PROC_TRUE " if obj is a GTK_IS_HSCALE");
- XG_DEFINE_PROCEDURE(GTK_IS_HSCROLLBAR, gxg_GTK_IS_HSCROLLBAR_w, 1, 0, 0, "(GTK_IS_HSCROLLBAR obj): " PROC_TRUE " if obj is a GTK_IS_HSCROLLBAR");
- XG_DEFINE_PROCEDURE(GTK_IS_HSEPARATOR, gxg_GTK_IS_HSEPARATOR_w, 1, 0, 0, "(GTK_IS_HSEPARATOR obj): " PROC_TRUE " if obj is a GTK_IS_HSEPARATOR");
- XG_DEFINE_PROCEDURE(GTK_IS_ICON_FACTORY, gxg_GTK_IS_ICON_FACTORY_w, 1, 0, 0, "(GTK_IS_ICON_FACTORY obj): " PROC_TRUE " if obj is a GTK_IS_ICON_FACTORY");
- XG_DEFINE_PROCEDURE(GTK_IS_IMAGE, gxg_GTK_IS_IMAGE_w, 1, 0, 0, "(GTK_IS_IMAGE obj): " PROC_TRUE " if obj is a GTK_IS_IMAGE");
- XG_DEFINE_PROCEDURE(GTK_IS_IMAGE_MENU_ITEM, gxg_GTK_IS_IMAGE_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_IMAGE_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_IMAGE_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IS_IM_CONTEXT, gxg_GTK_IS_IM_CONTEXT_w, 1, 0, 0, "(GTK_IS_IM_CONTEXT obj): " PROC_TRUE " if obj is a GTK_IS_IM_CONTEXT");
- XG_DEFINE_PROCEDURE(GTK_IS_IM_CONTEXT_SIMPLE, gxg_GTK_IS_IM_CONTEXT_SIMPLE_w, 1, 0, 0, "(GTK_IS_IM_CONTEXT_SIMPLE obj): " PROC_TRUE " if obj is a GTK_IS_IM_CONTEXT_SIMPLE");
- XG_DEFINE_PROCEDURE(GTK_IS_IM_MULTICONTEXT, gxg_GTK_IS_IM_MULTICONTEXT_w, 1, 0, 0, "(GTK_IS_IM_MULTICONTEXT obj): " PROC_TRUE " if obj is a GTK_IS_IM_MULTICONTEXT");
- XG_DEFINE_PROCEDURE(GTK_IS_INVISIBLE, gxg_GTK_IS_INVISIBLE_w, 1, 0, 0, "(GTK_IS_INVISIBLE obj): " PROC_TRUE " if obj is a GTK_IS_INVISIBLE");
- XG_DEFINE_PROCEDURE(GTK_IS_LABEL, gxg_GTK_IS_LABEL_w, 1, 0, 0, "(GTK_IS_LABEL obj): " PROC_TRUE " if obj is a GTK_IS_LABEL");
- XG_DEFINE_PROCEDURE(GTK_IS_LAYOUT, gxg_GTK_IS_LAYOUT_w, 1, 0, 0, "(GTK_IS_LAYOUT obj): " PROC_TRUE " if obj is a GTK_IS_LAYOUT");
- XG_DEFINE_PROCEDURE(GTK_IS_LIST_STORE, gxg_GTK_IS_LIST_STORE_w, 1, 0, 0, "(GTK_IS_LIST_STORE obj): " PROC_TRUE " if obj is a GTK_IS_LIST_STORE");
- XG_DEFINE_PROCEDURE(GTK_IS_MENU_BAR, gxg_GTK_IS_MENU_BAR_w, 1, 0, 0, "(GTK_IS_MENU_BAR obj): " PROC_TRUE " if obj is a GTK_IS_MENU_BAR");
- XG_DEFINE_PROCEDURE(GTK_IS_MENU, gxg_GTK_IS_MENU_w, 1, 0, 0, "(GTK_IS_MENU obj): " PROC_TRUE " if obj is a GTK_IS_MENU");
- XG_DEFINE_PROCEDURE(GTK_IS_MENU_ITEM, gxg_GTK_IS_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IS_MENU_SHELL, gxg_GTK_IS_MENU_SHELL_w, 1, 0, 0, "(GTK_IS_MENU_SHELL obj): " PROC_TRUE " if obj is a GTK_IS_MENU_SHELL");
- XG_DEFINE_PROCEDURE(GTK_IS_MISC, gxg_GTK_IS_MISC_w, 1, 0, 0, "(GTK_IS_MISC obj): " PROC_TRUE " if obj is a GTK_IS_MISC");
- XG_DEFINE_PROCEDURE(GTK_IS_NOTEBOOK, gxg_GTK_IS_NOTEBOOK_w, 1, 0, 0, "(GTK_IS_NOTEBOOK obj): " PROC_TRUE " if obj is a GTK_IS_NOTEBOOK");
- XG_DEFINE_PROCEDURE(GTK_IS_PANED, gxg_GTK_IS_PANED_w, 1, 0, 0, "(GTK_IS_PANED obj): " PROC_TRUE " if obj is a GTK_IS_PANED");
- XG_DEFINE_PROCEDURE(GTK_IS_PROGRESS_BAR, gxg_GTK_IS_PROGRESS_BAR_w, 1, 0, 0, "(GTK_IS_PROGRESS_BAR obj): " PROC_TRUE " if obj is a GTK_IS_PROGRESS_BAR");
- XG_DEFINE_PROCEDURE(GTK_IS_RADIO_BUTTON, gxg_GTK_IS_RADIO_BUTTON_w, 1, 0, 0, "(GTK_IS_RADIO_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_RADIO_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_RADIO_MENU_ITEM, gxg_GTK_IS_RADIO_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_RADIO_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_RADIO_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IS_RANGE, gxg_GTK_IS_RANGE_w, 1, 0, 0, "(GTK_IS_RANGE obj): " PROC_TRUE " if obj is a GTK_IS_RANGE");
- XG_DEFINE_PROCEDURE(GTK_IS_SCALE, gxg_GTK_IS_SCALE_w, 1, 0, 0, "(GTK_IS_SCALE obj): " PROC_TRUE " if obj is a GTK_IS_SCALE");
- XG_DEFINE_PROCEDURE(GTK_IS_SCROLLBAR, gxg_GTK_IS_SCROLLBAR_w, 1, 0, 0, "(GTK_IS_SCROLLBAR obj): " PROC_TRUE " if obj is a GTK_IS_SCROLLBAR");
- XG_DEFINE_PROCEDURE(GTK_IS_SCROLLED_WINDOW, gxg_GTK_IS_SCROLLED_WINDOW_w, 1, 0, 0, "(GTK_IS_SCROLLED_WINDOW obj): " PROC_TRUE " if obj is a GTK_IS_SCROLLED_WINDOW");
- XG_DEFINE_PROCEDURE(GTK_IS_SEPARATOR, gxg_GTK_IS_SEPARATOR_w, 1, 0, 0, "(GTK_IS_SEPARATOR obj): " PROC_TRUE " if obj is a GTK_IS_SEPARATOR");
- XG_DEFINE_PROCEDURE(GTK_IS_SEPARATOR_MENU_ITEM, gxg_GTK_IS_SEPARATOR_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_SEPARATOR_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_SEPARATOR_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IS_SIZE_GROUP, gxg_GTK_IS_SIZE_GROUP_w, 1, 0, 0, "(GTK_IS_SIZE_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_SIZE_GROUP");
- XG_DEFINE_PROCEDURE(GTK_IS_SPIN_BUTTON, gxg_GTK_IS_SPIN_BUTTON_w, 1, 0, 0, "(GTK_IS_SPIN_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_SPIN_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_STATUSBAR, gxg_GTK_IS_STATUSBAR_w, 1, 0, 0, "(GTK_IS_STATUSBAR obj): " PROC_TRUE " if obj is a GTK_IS_STATUSBAR");
- XG_DEFINE_PROCEDURE(GTK_IS_TABLE, gxg_GTK_IS_TABLE_w, 1, 0, 0, "(GTK_IS_TABLE obj): " PROC_TRUE " if obj is a GTK_IS_TABLE");
- XG_DEFINE_PROCEDURE(GTK_IS_TEAROFF_MENU_ITEM, gxg_GTK_IS_TEAROFF_MENU_ITEM_w, 1, 0, 0, "(GTK_IS_TEAROFF_MENU_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_TEAROFF_MENU_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IS_TEXT_BUFFER, gxg_GTK_IS_TEXT_BUFFER_w, 1, 0, 0, "(GTK_IS_TEXT_BUFFER obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_BUFFER");
- XG_DEFINE_PROCEDURE(GTK_IS_TEXT_CHILD_ANCHOR, gxg_GTK_IS_TEXT_CHILD_ANCHOR_w, 1, 0, 0, "(GTK_IS_TEXT_CHILD_ANCHOR obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_CHILD_ANCHOR");
- XG_DEFINE_PROCEDURE(GTK_IS_TEXT_MARK, gxg_GTK_IS_TEXT_MARK_w, 1, 0, 0, "(GTK_IS_TEXT_MARK obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_MARK");
- XG_DEFINE_PROCEDURE(GTK_IS_TEXT_TAG, gxg_GTK_IS_TEXT_TAG_w, 1, 0, 0, "(GTK_IS_TEXT_TAG obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_TAG");
- XG_DEFINE_PROCEDURE(GTK_IS_TEXT_TAG_TABLE, gxg_GTK_IS_TEXT_TAG_TABLE_w, 1, 0, 0, "(GTK_IS_TEXT_TAG_TABLE obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_TAG_TABLE");
- XG_DEFINE_PROCEDURE(GTK_IS_TEXT_VIEW, gxg_GTK_IS_TEXT_VIEW_w, 1, 0, 0, "(GTK_IS_TEXT_VIEW obj): " PROC_TRUE " if obj is a GTK_IS_TEXT_VIEW");
- XG_DEFINE_PROCEDURE(GTK_IS_TOGGLE_BUTTON, gxg_GTK_IS_TOGGLE_BUTTON_w, 1, 0, 0, "(GTK_IS_TOGGLE_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_TOGGLE_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_TOOLBAR, gxg_GTK_IS_TOOLBAR_w, 1, 0, 0, "(GTK_IS_TOOLBAR obj): " PROC_TRUE " if obj is a GTK_IS_TOOLBAR");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_DRAG_SOURCE, gxg_GTK_IS_TREE_DRAG_SOURCE_w, 1, 0, 0, "(GTK_IS_TREE_DRAG_SOURCE obj): " PROC_TRUE " if obj is a GTK_IS_TREE_DRAG_SOURCE");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_DRAG_DEST, gxg_GTK_IS_TREE_DRAG_DEST_w, 1, 0, 0, "(GTK_IS_TREE_DRAG_DEST obj): " PROC_TRUE " if obj is a GTK_IS_TREE_DRAG_DEST");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_MODEL, gxg_GTK_IS_TREE_MODEL_w, 1, 0, 0, "(GTK_IS_TREE_MODEL obj): " PROC_TRUE " if obj is a GTK_IS_TREE_MODEL");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_MODEL_SORT, gxg_GTK_IS_TREE_MODEL_SORT_w, 1, 0, 0, "(GTK_IS_TREE_MODEL_SORT obj): " PROC_TRUE " if obj is a GTK_IS_TREE_MODEL_SORT");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_SELECTION, gxg_GTK_IS_TREE_SELECTION_w, 1, 0, 0, "(GTK_IS_TREE_SELECTION obj): " PROC_TRUE " if obj is a GTK_IS_TREE_SELECTION");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_SORTABLE, gxg_GTK_IS_TREE_SORTABLE_w, 1, 0, 0, "(GTK_IS_TREE_SORTABLE obj): " PROC_TRUE " if obj is a GTK_IS_TREE_SORTABLE");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_STORE, gxg_GTK_IS_TREE_STORE_w, 1, 0, 0, "(GTK_IS_TREE_STORE obj): " PROC_TRUE " if obj is a GTK_IS_TREE_STORE");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_VIEW_COLUMN, gxg_GTK_IS_TREE_VIEW_COLUMN_w, 1, 0, 0, "(GTK_IS_TREE_VIEW_COLUMN obj): " PROC_TRUE " if obj is a GTK_IS_TREE_VIEW_COLUMN");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_VIEW, gxg_GTK_IS_TREE_VIEW_w, 1, 0, 0, "(GTK_IS_TREE_VIEW obj): " PROC_TRUE " if obj is a GTK_IS_TREE_VIEW");
- XG_DEFINE_PROCEDURE(GTK_IS_VBUTTON_BOX, gxg_GTK_IS_VBUTTON_BOX_w, 1, 0, 0, "(GTK_IS_VBUTTON_BOX obj): " PROC_TRUE " if obj is a GTK_IS_VBUTTON_BOX");
- XG_DEFINE_PROCEDURE(GTK_IS_VIEWPORT, gxg_GTK_IS_VIEWPORT_w, 1, 0, 0, "(GTK_IS_VIEWPORT obj): " PROC_TRUE " if obj is a GTK_IS_VIEWPORT");
- XG_DEFINE_PROCEDURE(GTK_IS_VPANED, gxg_GTK_IS_VPANED_w, 1, 0, 0, "(GTK_IS_VPANED obj): " PROC_TRUE " if obj is a GTK_IS_VPANED");
- XG_DEFINE_PROCEDURE(GTK_IS_VSCALE, gxg_GTK_IS_VSCALE_w, 1, 0, 0, "(GTK_IS_VSCALE obj): " PROC_TRUE " if obj is a GTK_IS_VSCALE");
- XG_DEFINE_PROCEDURE(GTK_IS_VSCROLLBAR, gxg_GTK_IS_VSCROLLBAR_w, 1, 0, 0, "(GTK_IS_VSCROLLBAR obj): " PROC_TRUE " if obj is a GTK_IS_VSCROLLBAR");
- XG_DEFINE_PROCEDURE(GTK_IS_VSEPARATOR, gxg_GTK_IS_VSEPARATOR_w, 1, 0, 0, "(GTK_IS_VSEPARATOR obj): " PROC_TRUE " if obj is a GTK_IS_VSEPARATOR");
- XG_DEFINE_PROCEDURE(GTK_IS_WIDGET, gxg_GTK_IS_WIDGET_w, 1, 0, 0, "(GTK_IS_WIDGET obj): " PROC_TRUE " if obj is a GTK_IS_WIDGET");
- XG_DEFINE_PROCEDURE(GTK_IS_WINDOW, gxg_GTK_IS_WINDOW_w, 1, 0, 0, "(GTK_IS_WINDOW obj): " PROC_TRUE " if obj is a GTK_IS_WINDOW");
- XG_DEFINE_PROCEDURE(PANGO_IS_CONTEXT, gxg_PANGO_IS_CONTEXT_w, 1, 0, 0, "(PANGO_IS_CONTEXT obj): " PROC_TRUE " if obj is a PANGO_IS_CONTEXT");
- XG_DEFINE_PROCEDURE(PANGO_IS_FONT_FAMILY, gxg_PANGO_IS_FONT_FAMILY_w, 1, 0, 0, "(PANGO_IS_FONT_FAMILY obj): " PROC_TRUE " if obj is a PANGO_IS_FONT_FAMILY");
- XG_DEFINE_PROCEDURE(PANGO_IS_FONT_FACE, gxg_PANGO_IS_FONT_FACE_w, 1, 0, 0, "(PANGO_IS_FONT_FACE obj): " PROC_TRUE " if obj is a PANGO_IS_FONT_FACE");
- XG_DEFINE_PROCEDURE(PANGO_IS_FONT, gxg_PANGO_IS_FONT_w, 1, 0, 0, "(PANGO_IS_FONT obj): " PROC_TRUE " if obj is a PANGO_IS_FONT");
- XG_DEFINE_PROCEDURE(PANGO_IS_FONT_MAP, gxg_PANGO_IS_FONT_MAP_w, 1, 0, 0, "(PANGO_IS_FONT_MAP obj): " PROC_TRUE " if obj is a PANGO_IS_FONT_MAP");
- XG_DEFINE_PROCEDURE(PANGO_IS_LAYOUT, gxg_PANGO_IS_LAYOUT_w, 1, 0, 0, "(PANGO_IS_LAYOUT obj): " PROC_TRUE " if obj is a PANGO_IS_LAYOUT");
- XG_DEFINE_PROCEDURE(G_IS_OBJECT, gxg_G_IS_OBJECT_w, 1, 0, 0, "(G_IS_OBJECT obj): " PROC_TRUE " if obj is a G_IS_OBJECT");
- XG_DEFINE_PROCEDURE(GDK_IS_SCREEN, gxg_GDK_IS_SCREEN_w, 1, 0, 0, "(GDK_IS_SCREEN obj): " PROC_TRUE " if obj is a GDK_IS_SCREEN");
- XG_DEFINE_PROCEDURE(GDK_IS_DISPLAY, gxg_GDK_IS_DISPLAY_w, 1, 0, 0, "(GDK_IS_DISPLAY obj): " PROC_TRUE " if obj is a GDK_IS_DISPLAY");
- XG_DEFINE_PROCEDURE(GTK_IS_FILE_CHOOSER_DIALOG, gxg_GTK_IS_FILE_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_IS_FILE_CHOOSER_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_FILE_CHOOSER_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_IS_FILE_CHOOSER_WIDGET, gxg_GTK_IS_FILE_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_IS_FILE_CHOOSER_WIDGET obj): " PROC_TRUE " if obj is a GTK_IS_FILE_CHOOSER_WIDGET");
- XG_DEFINE_PROCEDURE(GTK_IS_TREE_MODEL_FILTER, gxg_GTK_IS_TREE_MODEL_FILTER_w, 1, 0, 0, "(GTK_IS_TREE_MODEL_FILTER obj): " PROC_TRUE " if obj is a GTK_IS_TREE_MODEL_FILTER");
- XG_DEFINE_PROCEDURE(GTK_IS_ACTION, gxg_GTK_IS_ACTION_w, 1, 0, 0, "(GTK_IS_ACTION obj): " PROC_TRUE " if obj is a GTK_IS_ACTION");
- XG_DEFINE_PROCEDURE(GTK_IS_ACTION_GROUP, gxg_GTK_IS_ACTION_GROUP_w, 1, 0, 0, "(GTK_IS_ACTION_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_ACTION_GROUP");
- XG_DEFINE_PROCEDURE(GTK_IS_COMBO_BOX, gxg_GTK_IS_COMBO_BOX_w, 1, 0, 0, "(GTK_IS_COMBO_BOX obj): " PROC_TRUE " if obj is a GTK_IS_COMBO_BOX");
- XG_DEFINE_PROCEDURE(GTK_IS_EXPANDER, gxg_GTK_IS_EXPANDER_w, 1, 0, 0, "(GTK_IS_EXPANDER obj): " PROC_TRUE " if obj is a GTK_IS_EXPANDER");
- XG_DEFINE_PROCEDURE(GTK_IS_FONT_BUTTON, gxg_GTK_IS_FONT_BUTTON_w, 1, 0, 0, "(GTK_IS_FONT_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_FONT_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_COLOR_BUTTON, gxg_GTK_IS_COLOR_BUTTON_w, 1, 0, 0, "(GTK_IS_COLOR_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_COLOR_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_ENTRY_COMPLETION, gxg_GTK_IS_ENTRY_COMPLETION_w, 1, 0, 0, "(GTK_IS_ENTRY_COMPLETION obj): " PROC_TRUE " if obj is a GTK_IS_ENTRY_COMPLETION");
- XG_DEFINE_PROCEDURE(GTK_IS_RADIO_TOOL_BUTTON, gxg_GTK_IS_RADIO_TOOL_BUTTON_w, 1, 0, 0, "(GTK_IS_RADIO_TOOL_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_RADIO_TOOL_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_RADIO_ACTION, gxg_GTK_IS_RADIO_ACTION_w, 1, 0, 0, "(GTK_IS_RADIO_ACTION obj): " PROC_TRUE " if obj is a GTK_IS_RADIO_ACTION");
- XG_DEFINE_PROCEDURE(GTK_IS_SEPARATOR_TOOL_ITEM, gxg_GTK_IS_SEPARATOR_TOOL_ITEM_w, 1, 0, 0, "(GTK_IS_SEPARATOR_TOOL_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_SEPARATOR_TOOL_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IS_TOGGLE_ACTION, gxg_GTK_IS_TOGGLE_ACTION_w, 1, 0, 0, "(GTK_IS_TOGGLE_ACTION obj): " PROC_TRUE " if obj is a GTK_IS_TOGGLE_ACTION");
- XG_DEFINE_PROCEDURE(GTK_IS_TOGGLE_TOOL_BUTTON, gxg_GTK_IS_TOGGLE_TOOL_BUTTON_w, 1, 0, 0, "(GTK_IS_TOGGLE_TOOL_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_TOGGLE_TOOL_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_FILE_FILTER, gxg_GTK_IS_FILE_FILTER_w, 1, 0, 0, "(GTK_IS_FILE_FILTER obj): " PROC_TRUE " if obj is a GTK_IS_FILE_FILTER");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_LAYOUT, gxg_GTK_IS_CELL_LAYOUT_w, 1, 0, 0, "(GTK_IS_CELL_LAYOUT obj): " PROC_TRUE " if obj is a GTK_IS_CELL_LAYOUT");
- XG_DEFINE_PROCEDURE(GTK_IS_CLIPBOARD, gxg_GTK_IS_CLIPBOARD_w, 1, 0, 0, "(GTK_IS_CLIPBOARD obj): " PROC_TRUE " if obj is a GTK_IS_CLIPBOARD");
- XG_DEFINE_PROCEDURE(GTK_IS_FILE_CHOOSER, gxg_GTK_IS_FILE_CHOOSER_w, 1, 0, 0, "(GTK_IS_FILE_CHOOSER obj): " PROC_TRUE " if obj is a GTK_IS_FILE_CHOOSER");
- XG_DEFINE_PROCEDURE(GTK_IS_ICON_THEME, gxg_GTK_IS_ICON_THEME_w, 1, 0, 0, "(GTK_IS_ICON_THEME obj): " PROC_TRUE " if obj is a GTK_IS_ICON_THEME");
- XG_DEFINE_PROCEDURE(GTK_IS_TOOL_BUTTON, gxg_GTK_IS_TOOL_BUTTON_w, 1, 0, 0, "(GTK_IS_TOOL_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_TOOL_ITEM, gxg_GTK_IS_TOOL_ITEM_w, 1, 0, 0, "(GTK_IS_TOOL_ITEM obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_ITEM");
- XG_DEFINE_PROCEDURE(GTK_IS_ACCEL_MAP, gxg_GTK_IS_ACCEL_MAP_w, 1, 0, 0, "(GTK_IS_ACCEL_MAP obj): " PROC_TRUE " if obj is a GTK_IS_ACCEL_MAP");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_VIEW, gxg_GTK_IS_CELL_VIEW_w, 1, 0, 0, "(GTK_IS_CELL_VIEW obj): " PROC_TRUE " if obj is a GTK_IS_CELL_VIEW");
- XG_DEFINE_PROCEDURE(GTK_IS_ABOUT_DIALOG, gxg_GTK_IS_ABOUT_DIALOG_w, 1, 0, 0, "(GTK_IS_ABOUT_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_ABOUT_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER_COMBO, gxg_GTK_IS_CELL_RENDERER_COMBO_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_COMBO obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_COMBO");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER_PROGRESS, gxg_GTK_IS_CELL_RENDERER_PROGRESS_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_PROGRESS obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_PROGRESS");
- XG_DEFINE_PROCEDURE(GTK_IS_ICON_VIEW, gxg_GTK_IS_ICON_VIEW_w, 1, 0, 0, "(GTK_IS_ICON_VIEW obj): " PROC_TRUE " if obj is a GTK_IS_ICON_VIEW");
- XG_DEFINE_PROCEDURE(GTK_IS_FILE_CHOOSER_BUTTON, gxg_GTK_IS_FILE_CHOOSER_BUTTON_w, 1, 0, 0, "(GTK_IS_FILE_CHOOSER_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_FILE_CHOOSER_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_MENU_TOOL_BUTTON, gxg_GTK_IS_MENU_TOOL_BUTTON_w, 1, 0, 0, "(GTK_IS_MENU_TOOL_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_MENU_TOOL_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_ASSISTANT, gxg_GTK_IS_ASSISTANT_w, 1, 0, 0, "(GTK_IS_ASSISTANT obj): " PROC_TRUE " if obj is a GTK_IS_ASSISTANT");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER_ACCEL, gxg_GTK_IS_CELL_RENDERER_ACCEL_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_ACCEL obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_ACCEL");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER_SPIN, gxg_GTK_IS_CELL_RENDERER_SPIN_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_SPIN obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_SPIN");
- XG_DEFINE_PROCEDURE(GTK_IS_LINK_BUTTON, gxg_GTK_IS_LINK_BUTTON_w, 1, 0, 0, "(GTK_IS_LINK_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_LINK_BUTTON");
- XG_DEFINE_PROCEDURE(GTK_IS_RECENT_CHOOSER_DIALOG, gxg_GTK_IS_RECENT_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_IS_RECENT_CHOOSER_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_CHOOSER_DIALOG");
- XG_DEFINE_PROCEDURE(GTK_IS_RECENT_CHOOSER, gxg_GTK_IS_RECENT_CHOOSER_w, 1, 0, 0, "(GTK_IS_RECENT_CHOOSER obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_CHOOSER");
- XG_DEFINE_PROCEDURE(GTK_IS_RECENT_CHOOSER_MENU, gxg_GTK_IS_RECENT_CHOOSER_MENU_w, 1, 0, 0, "(GTK_IS_RECENT_CHOOSER_MENU obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_CHOOSER_MENU");
- XG_DEFINE_PROCEDURE(GTK_IS_RECENT_CHOOSER_WIDGET, gxg_GTK_IS_RECENT_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_IS_RECENT_CHOOSER_WIDGET obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_CHOOSER_WIDGET");
- XG_DEFINE_PROCEDURE(GTK_IS_RECENT_FILTER, gxg_GTK_IS_RECENT_FILTER_w, 1, 0, 0, "(GTK_IS_RECENT_FILTER obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_FILTER");
- XG_DEFINE_PROCEDURE(GTK_IS_RECENT_MANAGER, gxg_GTK_IS_RECENT_MANAGER_w, 1, 0, 0, "(GTK_IS_RECENT_MANAGER obj): " PROC_TRUE " if obj is a GTK_IS_RECENT_MANAGER");
- XG_DEFINE_PROCEDURE(GTK_IS_STATUS_ICON, gxg_GTK_IS_STATUS_ICON_w, 1, 0, 0, "(GTK_IS_STATUS_ICON obj): " PROC_TRUE " if obj is a GTK_IS_STATUS_ICON");
- XG_DEFINE_PROCEDURE(GTK_IS_PRINT_CONTEXT, gxg_GTK_IS_PRINT_CONTEXT_w, 1, 0, 0, "(GTK_IS_PRINT_CONTEXT obj): " PROC_TRUE " if obj is a GTK_IS_PRINT_CONTEXT");
- XG_DEFINE_PROCEDURE(GTK_IS_PRINT_OPERATION, gxg_GTK_IS_PRINT_OPERATION_w, 1, 0, 0, "(GTK_IS_PRINT_OPERATION obj): " PROC_TRUE " if obj is a GTK_IS_PRINT_OPERATION");
- XG_DEFINE_PROCEDURE(GTK_IS_PRINT_OPERATION_PREVIEW, gxg_GTK_IS_PRINT_OPERATION_PREVIEW_w, 1, 0, 0, "(GTK_IS_PRINT_OPERATION_PREVIEW obj): " PROC_TRUE " if obj is a GTK_IS_PRINT_OPERATION_PREVIEW");
- XG_DEFINE_PROCEDURE(GTK_IS_PRINT_SETTINGS, gxg_GTK_IS_PRINT_SETTINGS_w, 1, 0, 0, "(GTK_IS_PRINT_SETTINGS obj): " PROC_TRUE " if obj is a GTK_IS_PRINT_SETTINGS");
- XG_DEFINE_PROCEDURE(GTK_IS_TOOLTIP, gxg_GTK_IS_TOOLTIP_w, 1, 0, 0, "(GTK_IS_TOOLTIP obj): " PROC_TRUE " if obj is a GTK_IS_TOOLTIP");
-#if HAVE_GTK_INFO_BAR_NEW
- XG_DEFINE_PROCEDURE(GTK_IS_INFO_BAR, gxg_GTK_IS_INFO_BAR_w, 1, 0, 0, "(GTK_IS_INFO_BAR obj): " PROC_TRUE " if obj is a GTK_IS_INFO_BAR");
+#if GTK_CHECK_VERSION(3, 2, 0)
+ Xg_define_procedure(GTK_IS_OVERLAY, gxg_GTK_IS_OVERLAY_w, 1, 0, 0, "(GTK_IS_OVERLAY obj): " PROC_TRUE " if obj is a GTK_IS_OVERLAY", NULL);
+ Xg_define_procedure(GTK_IS_FONT_CHOOSER, gxg_GTK_IS_FONT_CHOOSER_w, 1, 0, 0, "(GTK_IS_FONT_CHOOSER obj): " PROC_TRUE " if obj is a GTK_IS_FONT_CHOOSER", NULL);
+ Xg_define_procedure(GTK_IS_FONT_CHOOSER_DIALOG, gxg_GTK_IS_FONT_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_IS_FONT_CHOOSER_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_FONT_CHOOSER_DIALOG", NULL);
+ Xg_define_procedure(GTK_IS_FONT_CHOOSER_WIDGET, gxg_GTK_IS_FONT_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_IS_FONT_CHOOSER_WIDGET obj): " PROC_TRUE " if obj is a GTK_IS_FONT_CHOOSER_WIDGET", NULL);
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
- XG_DEFINE_PROCEDURE(GTK_IS_ENTRY_BUFFER, gxg_GTK_IS_ENTRY_BUFFER_w, 1, 0, 0, "(GTK_IS_ENTRY_BUFFER obj): " PROC_TRUE " if obj is a GTK_IS_ENTRY_BUFFER");
+#if GTK_CHECK_VERSION(3, 4, 0)
+ Xg_define_procedure(GTK_IS_APPLICATION_WINDOW, gxg_GTK_IS_APPLICATION_WINDOW_w, 1, 0, 0, "(GTK_IS_APPLICATION_WINDOW obj): " PROC_TRUE " if obj is a GTK_IS_APPLICATION_WINDOW", NULL);
+ Xg_define_procedure(GTK_IS_COLOR_CHOOSER_DIALOG, gxg_GTK_IS_COLOR_CHOOSER_DIALOG_w, 1, 0, 0, "(GTK_IS_COLOR_CHOOSER_DIALOG obj): " PROC_TRUE " if obj is a GTK_IS_COLOR_CHOOSER_DIALOG", NULL);
+ Xg_define_procedure(GTK_IS_COLOR_CHOOSER_WIDGET, gxg_GTK_IS_COLOR_CHOOSER_WIDGET_w, 1, 0, 0, "(GTK_IS_COLOR_CHOOSER_WIDGET obj): " PROC_TRUE " if obj is a GTK_IS_COLOR_CHOOSER_WIDGET", NULL);
#endif
-#if HAVE_GTK_WIDGET_GET_MAPPED
- XG_DEFINE_PROCEDURE(GTK_IS_SPINNER, gxg_GTK_IS_SPINNER_w, 1, 0, 0, "(GTK_IS_SPINNER obj): " PROC_TRUE " if obj is a GTK_IS_SPINNER");
- XG_DEFINE_PROCEDURE(GTK_IS_CELL_RENDERER_SPINNER, gxg_GTK_IS_CELL_RENDERER_SPINNER_w, 1, 0, 0, "(GTK_IS_CELL_RENDERER_SPINNER obj): " PROC_TRUE " if obj is a GTK_IS_CELL_RENDERER_SPINNER");
- XG_DEFINE_PROCEDURE(GTK_IS_TOOL_PALETTE, gxg_GTK_IS_TOOL_PALETTE_w, 1, 0, 0, "(GTK_IS_TOOL_PALETTE obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_PALETTE");
- XG_DEFINE_PROCEDURE(GTK_IS_TOOL_ITEM_GROUP, gxg_GTK_IS_TOOL_ITEM_GROUP_w, 1, 0, 0, "(GTK_IS_TOOL_ITEM_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_ITEM_GROUP");
+#if GTK_CHECK_VERSION(3, 6, 0)
+ Xg_define_procedure(GTK_IS_MENU_BUTTON, gxg_GTK_IS_MENU_BUTTON_w, 1, 0, 0, "(GTK_IS_MENU_BUTTON obj): " PROC_TRUE " if obj is a GTK_IS_MENU_BUTTON", NULL);
+ Xg_define_procedure(GTK_IS_SEARCH_ENTRY, gxg_GTK_IS_SEARCH_ENTRY_w, 1, 0, 0, "(GTK_IS_SEARCH_ENTRY obj): " PROC_TRUE " if obj is a GTK_IS_SEARCH_ENTRY", NULL);
+ Xg_define_procedure(GTK_IS_LEVEL_BAR, gxg_GTK_IS_LEVEL_BAR_w, 1, 0, 0, "(GTK_IS_LEVEL_BAR obj): " PROC_TRUE " if obj is a GTK_IS_LEVEL_BAR", NULL);
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
- XG_DEFINE_PROCEDURE(GTK_IS_COMBO_BOX_TEXT, gxg_GTK_IS_COMBO_BOX_TEXT_w, 1, 0, 0, "(GTK_IS_COMBO_BOX_TEXT obj): " PROC_TRUE " if obj is a GTK_IS_COMBO_BOX_TEXT");
- XG_DEFINE_PROCEDURE(GTK_IS_GRID, gxg_GTK_IS_GRID_w, 1, 0, 0, "(GTK_IS_GRID obj): " PROC_TRUE " if obj is a GTK_IS_GRID");
- XG_DEFINE_PROCEDURE(GTK_IS_SCROLLABLE, gxg_GTK_IS_SCROLLABLE_w, 1, 0, 0, "(GTK_IS_SCROLLABLE obj): " PROC_TRUE " if obj is a GTK_IS_SCROLLABLE");
- XG_DEFINE_PROCEDURE(GTK_IS_SWITCH, gxg_GTK_IS_SWITCH_w, 1, 0, 0, "(GTK_IS_SWITCH obj): " PROC_TRUE " if obj is a GTK_IS_SWITCH");
- XG_DEFINE_PROCEDURE(GTK_IS_ACTIVATABLE, gxg_GTK_IS_ACTIVATABLE_w, 1, 0, 0, "(GTK_IS_ACTIVATABLE obj): " PROC_TRUE " if obj is a GTK_IS_ACTIVATABLE");
- XG_DEFINE_PROCEDURE(GTK_IS_ORIENTABLE, gxg_GTK_IS_ORIENTABLE_w, 1, 0, 0, "(GTK_IS_ORIENTABLE obj): " PROC_TRUE " if obj is a GTK_IS_ORIENTABLE");
- XG_DEFINE_PROCEDURE(GTK_IS_WINDOW_GROUP, gxg_GTK_IS_WINDOW_GROUP_w, 1, 0, 0, "(GTK_IS_WINDOW_GROUP obj): " PROC_TRUE " if obj is a GTK_IS_WINDOW_GROUP");
- XG_DEFINE_PROCEDURE(GTK_IS_TOOL_SHELL, gxg_GTK_IS_TOOL_SHELL_w, 1, 0, 0, "(GTK_IS_TOOL_SHELL obj): " PROC_TRUE " if obj is a GTK_IS_TOOL_SHELL");
+#if GTK_CHECK_VERSION(3, 10, 0)
+ Xg_define_procedure(GTK_IS_PLACES_SIDEBAR, gxg_GTK_IS_PLACES_SIDEBAR_w, 1, 0, 0, "(GTK_IS_PLACES_SIDEBAR obj): " PROC_TRUE " if obj is a GTK_IS_PLACES_SIDEBAR", NULL);
+ Xg_define_procedure(GTK_IS_STACK_SWITCHER, gxg_GTK_IS_STACK_SWITCHER_w, 1, 0, 0, "(GTK_IS_STACK_SWITCHER obj): " PROC_TRUE " if obj is a GTK_IS_STACK_SWITCHER", NULL);
+ Xg_define_procedure(GTK_IS_STACK, gxg_GTK_IS_STACK_w, 1, 0, 0, "(GTK_IS_STACK obj): " PROC_TRUE " if obj is a GTK_IS_STACK", NULL);
+ Xg_define_procedure(GTK_IS_REVEALER, gxg_GTK_IS_REVEALER_w, 1, 0, 0, "(GTK_IS_REVEALER obj): " PROC_TRUE " if obj is a GTK_IS_REVEALER", NULL);
+ Xg_define_procedure(GTK_IS_HEADER_BAR, gxg_GTK_IS_HEADER_BAR_w, 1, 0, 0, "(GTK_IS_HEADER_BAR obj): " PROC_TRUE " if obj is a GTK_IS_HEADER_BAR", NULL);
+ Xg_define_procedure(GTK_IS_LIST_BOX, gxg_GTK_IS_LIST_BOX_w, 1, 0, 0, "(GTK_IS_LIST_BOX obj): " PROC_TRUE " if obj is a GTK_IS_LIST_BOX", NULL);
+ Xg_define_procedure(GTK_IS_LIST_BOX_ROW, gxg_GTK_IS_LIST_BOX_ROW_w, 1, 0, 0, "(GTK_IS_LIST_BOX_ROW obj): " PROC_TRUE " if obj is a GTK_IS_LIST_BOX_ROW", NULL);
+ Xg_define_procedure(GTK_IS_SEARCH_BAR, gxg_GTK_IS_SEARCH_BAR_w, 1, 0, 0, "(GTK_IS_SEARCH_BAR obj): " PROC_TRUE " if obj is a GTK_IS_SEARCH_BAR", NULL);
#endif
-#if (!HAVE_GTK_3)
- XG_DEFINE_PROCEDURE(GDK_IS_COLORMAP, gxg_GDK_IS_COLORMAP_w, 1, 0, 0, "(GDK_IS_COLORMAP obj): " PROC_TRUE " if obj is a GDK_IS_COLORMAP");
- XG_DEFINE_PROCEDURE(GDK_IS_DRAWABLE, gxg_GDK_IS_DRAWABLE_w, 1, 0, 0, "(GDK_IS_DRAWABLE obj): " PROC_TRUE " if obj is a GDK_IS_DRAWABLE");
- XG_DEFINE_PROCEDURE(GDK_IS_PIXMAP, gxg_GDK_IS_PIXMAP_w, 1, 0, 0, "(GDK_IS_PIXMAP obj): " PROC_TRUE " if obj is a GDK_IS_PIXMAP");
- XG_DEFINE_PROCEDURE(GTK_IS_OBJECT, gxg_GTK_IS_OBJECT_w, 1, 0, 0, "(GTK_IS_OBJECT obj): " PROC_TRUE " if obj is a GTK_IS_OBJECT");
- XG_DEFINE_PROCEDURE(GTK_IS_RC_STYLE, gxg_GTK_IS_RC_STYLE_w, 1, 0, 0, "(GTK_IS_RC_STYLE obj): " PROC_TRUE " if obj is a GTK_IS_RC_STYLE");
- XG_DEFINE_PROCEDURE(GTK_IS_STYLE, gxg_GTK_IS_STYLE_w, 1, 0, 0, "(GTK_IS_STYLE obj): " PROC_TRUE " if obj is a GTK_IS_STYLE");
+#if GTK_CHECK_VERSION(3, 12, 0)
+ Xg_define_procedure(GTK_IS_FLOW_BOX, gxg_GTK_IS_FLOW_BOX_w, 1, 0, 0, "(GTK_IS_FLOW_BOX obj): " PROC_TRUE " if obj is a GTK_IS_FLOW_BOX", NULL);
+ Xg_define_procedure(GTK_IS_FLOW_BOX_CHILD, gxg_GTK_IS_FLOW_BOX_CHILD_w, 1, 0, 0, "(GTK_IS_FLOW_BOX_CHILD obj): " PROC_TRUE " if obj is a GTK_IS_FLOW_BOX_CHILD", NULL);
+ Xg_define_procedure(GTK_IS_ACTION_BAR, gxg_GTK_IS_ACTION_BAR_w, 1, 0, 0, "(GTK_IS_ACTION_BAR obj): " PROC_TRUE " if obj is a GTK_IS_ACTION_BAR", NULL);
+ Xg_define_procedure(GTK_IS_POPOVER, gxg_GTK_IS_POPOVER_w, 1, 0, 0, "(GTK_IS_POPOVER obj): " PROC_TRUE " if obj is a GTK_IS_POPOVER", NULL);
#endif
-}
+#if GTK_CHECK_VERSION(3, 14, 0)
+ Xg_define_procedure(GTK_IS_GESTURE, gxg_GTK_IS_GESTURE_w, 1, 0, 0, "(GTK_IS_GESTURE obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE", NULL);
+ Xg_define_procedure(GTK_IS_GESTURE_DRAG, gxg_GTK_IS_GESTURE_DRAG_w, 1, 0, 0, "(GTK_IS_GESTURE_DRAG obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE_DRAG", NULL);
+ Xg_define_procedure(GTK_IS_GESTURE_LONG_PRESS, gxg_GTK_IS_GESTURE_LONG_PRESS_w, 1, 0, 0, "(GTK_IS_GESTURE_LONG_PRESS obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE_LONG_PRESS", NULL);
+ Xg_define_procedure(GTK_IS_GESTURE_ZOOM, gxg_GTK_IS_GESTURE_ZOOM_w, 1, 0, 0, "(GTK_IS_GESTURE_ZOOM obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE_ZOOM", NULL);
+ Xg_define_procedure(GTK_IS_GESTURE_SWIPE, gxg_GTK_IS_GESTURE_SWIPE_w, 1, 0, 0, "(GTK_IS_GESTURE_SWIPE obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE_SWIPE", NULL);
+ Xg_define_procedure(GTK_IS_GESTURE_SINGLE, gxg_GTK_IS_GESTURE_SINGLE_w, 1, 0, 0, "(GTK_IS_GESTURE_SINGLE obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE_SINGLE", NULL);
+ Xg_define_procedure(GTK_IS_GESTURE_PAN, gxg_GTK_IS_GESTURE_PAN_w, 1, 0, 0, "(GTK_IS_GESTURE_PAN obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE_PAN", NULL);
+ Xg_define_procedure(GTK_IS_GESTURE_MULTI_PRESS, gxg_GTK_IS_GESTURE_MULTI_PRESS_w, 1, 0, 0, "(GTK_IS_GESTURE_MULTI_PRESS obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE_MULTI_PRESS", NULL);
+ Xg_define_procedure(GTK_IS_GESTURE_ROTATE, gxg_GTK_IS_GESTURE_ROTATE_w, 1, 0, 0, "(GTK_IS_GESTURE_ROTATE obj): " PROC_TRUE " if obj is a GTK_IS_GESTURE_ROTATE", NULL);
+ Xg_define_procedure(GTK_IS_EVENT_CONTROLLER, gxg_GTK_IS_EVENT_CONTROLLER_w, 1, 0, 0, "(GTK_IS_EVENT_CONTROLLER obj): " PROC_TRUE " if obj is a GTK_IS_EVENT_CONTROLLER", NULL);
+#endif
-static void define_structs(void)
-{
- XG_DEFINE_ACCESSOR(blue, gxg_blue_w, gxg_set_blue_w, 1, 0, 2, 0);
- XG_DEFINE_ACCESSOR(green, gxg_green_w, gxg_set_green_w, 1, 0, 2, 0);
- XG_DEFINE_ACCESSOR(red, gxg_red_w, gxg_set_red_w, 1, 0, 2, 0);
- XG_DEFINE_ACCESSOR(pixel, gxg_pixel_w, gxg_set_pixel_w, 1, 0, 2, 0);
- XG_DEFINE_PROCEDURE(GdkColor, gxg_make_GdkColor_w, 0, 0, 1, "(GdkColor ...): a new GdkColor struct");
- XG_DEFINE_PROCEDURE(GtkTextIter, gxg_make_GtkTextIter_w, 0, 0, 0, "(GtkTextIter): a new GtkTextIter struct");
- XG_DEFINE_PROCEDURE(GtkTreeIter, gxg_make_GtkTreeIter_w, 0, 0, 0, "(GtkTreeIter): a new GtkTreeIter struct");
- XG_DEFINE_PROCEDURE(PangoRectangle, gxg_make_PangoRectangle_w, 0, 0, 0, "(PangoRectangle): a new PangoRectangle struct");
- XG_DEFINE_PROCEDURE(cairo_matrix_t, gxg_make_cairo_matrix_t_w, 0, 0, 0, "(cairo_matrix_t): a new cairo_matrix_t struct");
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
- XG_DEFINE_PROCEDURE(GdkRGBA, gxg_make_GdkRGBA_w, 0, 0, 0, "(GdkRGBA): a new GdkRGBA struct");
+#if GTK_CHECK_VERSION(3, 16, 0)
+ Xg_define_procedure(GTK_IS_GL_AREA, gxg_GTK_IS_GL_AREA_w, 1, 0, 0, "(GTK_IS_GL_AREA obj): " PROC_TRUE " if obj is a GTK_IS_GL_AREA", NULL);
+ Xg_define_procedure(GDK_IS_GL_CONTEXT, gxg_GDK_IS_GL_CONTEXT_w, 1, 0, 0, "(GDK_IS_GL_CONTEXT obj): " PROC_TRUE " if obj is a GDK_IS_GL_CONTEXT", NULL);
+ Xg_define_procedure(GTK_IS_POPOVER_MENU, gxg_GTK_IS_POPOVER_MENU_w, 1, 0, 0, "(GTK_IS_POPOVER_MENU obj): " PROC_TRUE " if obj is a GTK_IS_POPOVER_MENU", NULL);
+ Xg_define_procedure(GTK_IS_STACK_SIDEBAR, gxg_GTK_IS_STACK_SIDEBAR_w, 1, 0, 0, "(GTK_IS_STACK_SIDEBAR obj): " PROC_TRUE " if obj is a GTK_IS_STACK_SIDEBAR", NULL);
#endif
}
@@ -47294,1575 +43800,1876 @@ static void define_structs(void)
static void define_integers(void)
{
-#if HAVE_SCHEME
- #define DEFINE_INTEGER(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, C_TO_XEN_INT(Name))
- #define DEFINE_ULONG(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, C_TO_XEN_ULONG(Name))
-#else
- #define DEFINE_INTEGER(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_INT(Name))
- #define DEFINE_ULONG(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_ULONG(Name))
-#endif
+#define define_integer(Name) Xen_define(Xg_pre #Name Xg_post, C_int_to_Xen_integer(Name))
+#if !GLIB_CHECK_VERSION(2,35,0)
g_type_init();
- DEFINE_INTEGER(G_SIGNAL_RUN_FIRST);
- DEFINE_INTEGER(G_SIGNAL_RUN_LAST);
- DEFINE_INTEGER(G_SIGNAL_RUN_CLEANUP);
- DEFINE_INTEGER(G_SIGNAL_NO_RECURSE);
- DEFINE_INTEGER(G_SIGNAL_DETAILED);
- DEFINE_INTEGER(G_SIGNAL_ACTION);
- DEFINE_INTEGER(G_SIGNAL_NO_HOOKS);
- DEFINE_INTEGER(G_CONNECT_AFTER);
- DEFINE_INTEGER(G_CONNECT_SWAPPED);
- DEFINE_INTEGER(G_SIGNAL_MATCH_ID);
- DEFINE_INTEGER(G_SIGNAL_MATCH_DETAIL);
- DEFINE_INTEGER(G_SIGNAL_MATCH_CLOSURE);
- DEFINE_INTEGER(G_SIGNAL_MATCH_FUNC);
- DEFINE_INTEGER(G_SIGNAL_MATCH_DATA);
- DEFINE_INTEGER(G_SIGNAL_MATCH_UNBLOCKED);
- DEFINE_INTEGER(GDK_X_CURSOR);
- DEFINE_INTEGER(GDK_ARROW);
- DEFINE_INTEGER(GDK_BASED_ARROW_DOWN);
- DEFINE_INTEGER(GDK_BASED_ARROW_UP);
- DEFINE_INTEGER(GDK_BOAT);
- DEFINE_INTEGER(GDK_BOGOSITY);
- DEFINE_INTEGER(GDK_BOTTOM_LEFT_CORNER);
- DEFINE_INTEGER(GDK_BOTTOM_RIGHT_CORNER);
- DEFINE_INTEGER(GDK_BOTTOM_SIDE);
- DEFINE_INTEGER(GDK_BOTTOM_TEE);
- DEFINE_INTEGER(GDK_BOX_SPIRAL);
- DEFINE_INTEGER(GDK_CENTER_PTR);
- DEFINE_INTEGER(GDK_CIRCLE);
- DEFINE_INTEGER(GDK_CLOCK);
- DEFINE_INTEGER(GDK_COFFEE_MUG);
- DEFINE_INTEGER(GDK_CROSS);
- DEFINE_INTEGER(GDK_CROSS_REVERSE);
- DEFINE_INTEGER(GDK_CROSSHAIR);
- DEFINE_INTEGER(GDK_DIAMOND_CROSS);
- DEFINE_INTEGER(GDK_DOT);
- DEFINE_INTEGER(GDK_DOTBOX);
- DEFINE_INTEGER(GDK_DOUBLE_ARROW);
- DEFINE_INTEGER(GDK_DRAFT_LARGE);
- DEFINE_INTEGER(GDK_DRAFT_SMALL);
- DEFINE_INTEGER(GDK_DRAPED_BOX);
- DEFINE_INTEGER(GDK_EXCHANGE);
- DEFINE_INTEGER(GDK_FLEUR);
- DEFINE_INTEGER(GDK_GOBBLER);
- DEFINE_INTEGER(GDK_GUMBY);
- DEFINE_INTEGER(GDK_HAND1);
- DEFINE_INTEGER(GDK_HAND2);
- DEFINE_INTEGER(GDK_HEART);
- DEFINE_INTEGER(GDK_ICON);
- DEFINE_INTEGER(GDK_IRON_CROSS);
- DEFINE_INTEGER(GDK_LEFT_PTR);
- DEFINE_INTEGER(GDK_LEFT_SIDE);
- DEFINE_INTEGER(GDK_LEFT_TEE);
- DEFINE_INTEGER(GDK_LEFTBUTTON);
- DEFINE_INTEGER(GDK_LL_ANGLE);
- DEFINE_INTEGER(GDK_LR_ANGLE);
- DEFINE_INTEGER(GDK_MAN);
- DEFINE_INTEGER(GDK_MIDDLEBUTTON);
- DEFINE_INTEGER(GDK_MOUSE);
- DEFINE_INTEGER(GDK_PENCIL);
- DEFINE_INTEGER(GDK_PIRATE);
- DEFINE_INTEGER(GDK_PLUS);
- DEFINE_INTEGER(GDK_QUESTION_ARROW);
- DEFINE_INTEGER(GDK_RIGHT_PTR);
- DEFINE_INTEGER(GDK_RIGHT_SIDE);
- DEFINE_INTEGER(GDK_RIGHT_TEE);
- DEFINE_INTEGER(GDK_RIGHTBUTTON);
- DEFINE_INTEGER(GDK_RTL_LOGO);
- DEFINE_INTEGER(GDK_SAILBOAT);
- DEFINE_INTEGER(GDK_SB_DOWN_ARROW);
- DEFINE_INTEGER(GDK_SB_H_DOUBLE_ARROW);
- DEFINE_INTEGER(GDK_SB_LEFT_ARROW);
- DEFINE_INTEGER(GDK_SB_RIGHT_ARROW);
- DEFINE_INTEGER(GDK_SB_UP_ARROW);
- DEFINE_INTEGER(GDK_SB_V_DOUBLE_ARROW);
- DEFINE_INTEGER(GDK_SHUTTLE);
- DEFINE_INTEGER(GDK_SIZING);
- DEFINE_INTEGER(GDK_SPIDER);
- DEFINE_INTEGER(GDK_SPRAYCAN);
- DEFINE_INTEGER(GDK_STAR);
- DEFINE_INTEGER(GDK_TARGET);
- DEFINE_INTEGER(GDK_TCROSS);
- DEFINE_INTEGER(GDK_TOP_LEFT_ARROW);
- DEFINE_INTEGER(GDK_TOP_LEFT_CORNER);
- DEFINE_INTEGER(GDK_TOP_RIGHT_CORNER);
- DEFINE_INTEGER(GDK_TOP_SIDE);
- DEFINE_INTEGER(GDK_TOP_TEE);
- DEFINE_INTEGER(GDK_TREK);
- DEFINE_INTEGER(GDK_UL_ANGLE);
- DEFINE_INTEGER(GDK_UMBRELLA);
- DEFINE_INTEGER(GDK_UR_ANGLE);
- DEFINE_INTEGER(GDK_WATCH);
- DEFINE_INTEGER(GDK_XTERM);
- DEFINE_INTEGER(GDK_LAST_CURSOR );
- DEFINE_INTEGER(GDK_ACTION_DEFAULT);
- DEFINE_INTEGER(GDK_ACTION_COPY);
- DEFINE_INTEGER(GDK_ACTION_MOVE);
- DEFINE_INTEGER(GDK_ACTION_LINK);
- DEFINE_INTEGER(GDK_ACTION_PRIVATE);
- DEFINE_INTEGER(GDK_ACTION_ASK);
- DEFINE_INTEGER(GDK_PRIORITY_EVENTS);
- DEFINE_INTEGER(GDK_PRIORITY_REDRAW);
- DEFINE_INTEGER(GDK_NOTHING);
- DEFINE_INTEGER(GDK_DELETE);
- DEFINE_INTEGER(GDK_DESTROY);
- DEFINE_INTEGER(GDK_EXPOSE);
- DEFINE_INTEGER(GDK_MOTION_NOTIFY);
- DEFINE_INTEGER(GDK_BUTTON_PRESS);
- DEFINE_INTEGER(GDK_2BUTTON_PRESS);
- DEFINE_INTEGER(GDK_3BUTTON_PRESS);
- DEFINE_INTEGER(GDK_BUTTON_RELEASE);
- DEFINE_INTEGER(GDK_KEY_PRESS);
- DEFINE_INTEGER(GDK_KEY_RELEASE);
- DEFINE_INTEGER(GDK_ENTER_NOTIFY);
- DEFINE_INTEGER(GDK_LEAVE_NOTIFY);
- DEFINE_INTEGER(GDK_FOCUS_CHANGE);
- DEFINE_INTEGER(GDK_CONFIGURE);
- DEFINE_INTEGER(GDK_MAP);
- DEFINE_INTEGER(GDK_UNMAP);
- DEFINE_INTEGER(GDK_PROPERTY_NOTIFY);
- DEFINE_INTEGER(GDK_SELECTION_CLEAR);
- DEFINE_INTEGER(GDK_SELECTION_REQUEST);
- DEFINE_INTEGER(GDK_SELECTION_NOTIFY);
- DEFINE_INTEGER(GDK_PROXIMITY_IN);
- DEFINE_INTEGER(GDK_PROXIMITY_OUT);
- DEFINE_INTEGER(GDK_DRAG_ENTER);
- DEFINE_INTEGER(GDK_DRAG_LEAVE);
- DEFINE_INTEGER(GDK_DRAG_MOTION);
- DEFINE_INTEGER(GDK_DRAG_STATUS);
- DEFINE_INTEGER(GDK_DROP_START);
- DEFINE_INTEGER(GDK_DROP_FINISHED);
- DEFINE_INTEGER(GDK_CLIENT_EVENT);
- DEFINE_INTEGER(GDK_VISIBILITY_NOTIFY);
- DEFINE_INTEGER(GDK_SCROLL);
- DEFINE_INTEGER(GDK_WINDOW_STATE);
- DEFINE_INTEGER(GDK_SETTING);
- DEFINE_INTEGER(GDK_OWNER_CHANGE);
- DEFINE_INTEGER(GDK_GRAB_BROKEN);
- DEFINE_INTEGER(GDK_EXPOSURE_MASK);
- DEFINE_INTEGER(GDK_POINTER_MOTION_MASK);
- DEFINE_INTEGER(GDK_POINTER_MOTION_HINT_MASK);
- DEFINE_INTEGER(GDK_BUTTON_MOTION_MASK);
- DEFINE_INTEGER(GDK_BUTTON1_MOTION_MASK);
- DEFINE_INTEGER(GDK_BUTTON2_MOTION_MASK);
- DEFINE_INTEGER(GDK_BUTTON3_MOTION_MASK);
- DEFINE_INTEGER(GDK_BUTTON_PRESS_MASK);
- DEFINE_INTEGER(GDK_BUTTON_RELEASE_MASK);
- DEFINE_INTEGER(GDK_KEY_PRESS_MASK);
- DEFINE_INTEGER(GDK_KEY_RELEASE_MASK);
- DEFINE_INTEGER(GDK_ENTER_NOTIFY_MASK);
- DEFINE_INTEGER(GDK_LEAVE_NOTIFY_MASK);
- DEFINE_INTEGER(GDK_FOCUS_CHANGE_MASK);
- DEFINE_INTEGER(GDK_STRUCTURE_MASK);
- DEFINE_INTEGER(GDK_PROPERTY_CHANGE_MASK);
- DEFINE_INTEGER(GDK_VISIBILITY_NOTIFY_MASK);
- DEFINE_INTEGER(GDK_PROXIMITY_IN_MASK);
- DEFINE_INTEGER(GDK_PROXIMITY_OUT_MASK);
- DEFINE_INTEGER(GDK_SUBSTRUCTURE_MASK);
- DEFINE_INTEGER(GDK_SCROLL_MASK);
- DEFINE_INTEGER(GDK_ALL_EVENTS_MASK);
- DEFINE_INTEGER(GDK_VISIBILITY_UNOBSCURED );
- DEFINE_INTEGER(GDK_VISIBILITY_PARTIAL );
- DEFINE_INTEGER(GDK_VISIBILITY_FULLY_OBSCURED);
- DEFINE_INTEGER(GDK_SCROLL_UP);
- DEFINE_INTEGER(GDK_SCROLL_DOWN);
- DEFINE_INTEGER(GDK_SCROLL_LEFT);
- DEFINE_INTEGER(GDK_SCROLL_RIGHT);
- DEFINE_INTEGER(GDK_NOTIFY_ANCESTOR);
- DEFINE_INTEGER(GDK_NOTIFY_VIRTUAL);
- DEFINE_INTEGER(GDK_NOTIFY_INFERIOR);
- DEFINE_INTEGER(GDK_NOTIFY_NONLINEAR);
- DEFINE_INTEGER(GDK_NOTIFY_NONLINEAR_VIRTUAL);
- DEFINE_INTEGER(GDK_NOTIFY_UNKNOWN);
- DEFINE_INTEGER(GDK_CROSSING_NORMAL);
- DEFINE_INTEGER(GDK_CROSSING_GRAB);
- DEFINE_INTEGER(GDK_CROSSING_UNGRAB);
- DEFINE_INTEGER(GDK_PROPERTY_NEW_VALUE);
- DEFINE_INTEGER(GDK_PROPERTY_DELETE);
- DEFINE_INTEGER(GDK_WINDOW_STATE_WITHDRAWN);
- DEFINE_INTEGER(GDK_WINDOW_STATE_ICONIFIED);
- DEFINE_INTEGER(GDK_WINDOW_STATE_MAXIMIZED);
- DEFINE_INTEGER(GDK_WINDOW_STATE_STICKY);
- DEFINE_INTEGER(GDK_SETTING_ACTION_NEW);
- DEFINE_INTEGER(GDK_SETTING_ACTION_CHANGED);
- DEFINE_INTEGER(GDK_SETTING_ACTION_DELETED);
- DEFINE_INTEGER(GDK_PROP_MODE_REPLACE);
- DEFINE_INTEGER(GDK_PROP_MODE_PREPEND);
- DEFINE_INTEGER(GDK_PROP_MODE_APPEND);
- DEFINE_INTEGER(GDK_CURRENT_TIME);
- DEFINE_INTEGER(GDK_PARENT_RELATIVE);
- DEFINE_INTEGER(GDK_LSB_FIRST);
- DEFINE_INTEGER(GDK_MSB_FIRST);
- DEFINE_INTEGER(GDK_SHIFT_MASK);
- DEFINE_INTEGER(GDK_LOCK_MASK);
- DEFINE_INTEGER(GDK_CONTROL_MASK);
- DEFINE_INTEGER(GDK_MOD1_MASK);
- DEFINE_INTEGER(GDK_MOD2_MASK);
- DEFINE_INTEGER(GDK_MOD3_MASK);
- DEFINE_INTEGER(GDK_MOD4_MASK);
- DEFINE_INTEGER(GDK_MOD5_MASK);
- DEFINE_INTEGER(GDK_BUTTON1_MASK);
- DEFINE_INTEGER(GDK_BUTTON2_MASK);
- DEFINE_INTEGER(GDK_BUTTON3_MASK);
- DEFINE_INTEGER(GDK_BUTTON4_MASK);
- DEFINE_INTEGER(GDK_BUTTON5_MASK);
- DEFINE_INTEGER(GDK_RELEASE_MASK);
- DEFINE_INTEGER(GDK_MODIFIER_MASK);
- DEFINE_INTEGER(GDK_OK);
- DEFINE_INTEGER(GDK_ERROR);
- DEFINE_INTEGER(GDK_ERROR_PARAM);
- DEFINE_INTEGER(GDK_ERROR_FILE);
- DEFINE_INTEGER(GDK_ERROR_MEM);
- DEFINE_INTEGER(GDK_GRAB_SUCCESS);
- DEFINE_INTEGER(GDK_GRAB_ALREADY_GRABBED);
- DEFINE_INTEGER(GDK_GRAB_INVALID_TIME);
- DEFINE_INTEGER(GDK_GRAB_NOT_VIEWABLE);
- DEFINE_INTEGER(GDK_GRAB_FROZEN);
- DEFINE_INTEGER(GDK_VISUAL_STATIC_GRAY);
- DEFINE_INTEGER(GDK_VISUAL_GRAYSCALE);
- DEFINE_INTEGER(GDK_VISUAL_STATIC_COLOR);
- DEFINE_INTEGER(GDK_VISUAL_PSEUDO_COLOR);
- DEFINE_INTEGER(GDK_VISUAL_TRUE_COLOR);
- DEFINE_INTEGER(GDK_VISUAL_DIRECT_COLOR);
- DEFINE_INTEGER(GDK_INPUT_OUTPUT);
- DEFINE_INTEGER(GDK_INPUT_ONLY);
- DEFINE_INTEGER(GDK_WINDOW_ROOT);
- DEFINE_INTEGER(GDK_WINDOW_TOPLEVEL);
- DEFINE_INTEGER(GDK_WINDOW_CHILD);
- DEFINE_INTEGER(GDK_WINDOW_TEMP);
- DEFINE_INTEGER(GDK_WINDOW_FOREIGN);
- DEFINE_INTEGER(GDK_WA_TITLE);
- DEFINE_INTEGER(GDK_WA_X);
- DEFINE_INTEGER(GDK_WA_Y);
- DEFINE_INTEGER(GDK_WA_CURSOR);
- DEFINE_INTEGER(GDK_WA_VISUAL);
- DEFINE_INTEGER(GDK_WA_WMCLASS);
- DEFINE_INTEGER(GDK_WA_NOREDIR);
- DEFINE_INTEGER(GDK_HINT_POS);
- DEFINE_INTEGER(GDK_HINT_MIN_SIZE);
- DEFINE_INTEGER(GDK_HINT_MAX_SIZE);
- DEFINE_INTEGER(GDK_HINT_BASE_SIZE);
- DEFINE_INTEGER(GDK_HINT_ASPECT);
- DEFINE_INTEGER(GDK_HINT_RESIZE_INC);
- DEFINE_INTEGER(GDK_HINT_WIN_GRAVITY);
- DEFINE_INTEGER(GDK_HINT_USER_POS);
- DEFINE_INTEGER(GDK_HINT_USER_SIZE);
- DEFINE_INTEGER(GDK_WINDOW_TYPE_HINT_NORMAL);
- DEFINE_INTEGER(GDK_WINDOW_TYPE_HINT_DIALOG);
- DEFINE_INTEGER(GDK_WINDOW_TYPE_HINT_MENU);
- DEFINE_INTEGER(GDK_WINDOW_TYPE_HINT_TOOLBAR);
- DEFINE_INTEGER(GDK_DECOR_ALL);
- DEFINE_INTEGER(GDK_DECOR_BORDER);
- DEFINE_INTEGER(GDK_DECOR_RESIZEH);
- DEFINE_INTEGER(GDK_DECOR_TITLE);
- DEFINE_INTEGER(GDK_DECOR_MENU);
- DEFINE_INTEGER(GDK_DECOR_MINIMIZE);
- DEFINE_INTEGER(GDK_DECOR_MAXIMIZE);
- DEFINE_INTEGER(GDK_FUNC_ALL);
- DEFINE_INTEGER(GDK_FUNC_RESIZE);
- DEFINE_INTEGER(GDK_FUNC_MOVE);
- DEFINE_INTEGER(GDK_FUNC_MINIMIZE);
- DEFINE_INTEGER(GDK_FUNC_MAXIMIZE);
- DEFINE_INTEGER(GDK_FUNC_CLOSE);
- DEFINE_INTEGER(GDK_GRAVITY_NORTH_WEST);
- DEFINE_INTEGER(GDK_GRAVITY_NORTH);
- DEFINE_INTEGER(GDK_GRAVITY_NORTH_EAST);
- DEFINE_INTEGER(GDK_GRAVITY_WEST);
- DEFINE_INTEGER(GDK_GRAVITY_CENTER);
- DEFINE_INTEGER(GDK_GRAVITY_EAST);
- DEFINE_INTEGER(GDK_GRAVITY_SOUTH_WEST);
- DEFINE_INTEGER(GDK_GRAVITY_SOUTH);
- DEFINE_INTEGER(GDK_GRAVITY_SOUTH_EAST);
- DEFINE_INTEGER(GDK_GRAVITY_STATIC);
- DEFINE_INTEGER(GDK_WINDOW_EDGE_NORTH_WEST);
- DEFINE_INTEGER(GDK_WINDOW_EDGE_NORTH);
- DEFINE_INTEGER(GDK_WINDOW_EDGE_NORTH_EAST);
- DEFINE_INTEGER(GDK_WINDOW_EDGE_WEST);
- DEFINE_INTEGER(GDK_WINDOW_EDGE_EAST);
- DEFINE_INTEGER(GDK_WINDOW_EDGE_SOUTH_WEST);
- DEFINE_INTEGER(GDK_WINDOW_EDGE_SOUTH);
- DEFINE_INTEGER(GDK_WINDOW_EDGE_SOUTH_EAST);
- DEFINE_INTEGER(GDK_PIXBUF_ALPHA_BILEVEL);
- DEFINE_INTEGER(GDK_PIXBUF_ALPHA_FULL);
- DEFINE_INTEGER(GDK_COLORSPACE_RGB);
- DEFINE_INTEGER(GDK_PIXBUF_ERROR_CORRUPT_IMAGE);
- DEFINE_INTEGER(GDK_PIXBUF_ERROR_INSUFFICIENT_MEMORY);
- DEFINE_INTEGER(GDK_PIXBUF_ERROR_BAD_OPTION);
- DEFINE_INTEGER(GDK_PIXBUF_ERROR_UNKNOWN_TYPE);
- DEFINE_INTEGER(GDK_PIXBUF_ERROR_UNSUPPORTED_OPERATION);
- DEFINE_INTEGER(GDK_PIXBUF_ERROR_FAILED);
- DEFINE_INTEGER(GDK_INTERP_NEAREST);
- DEFINE_INTEGER(GDK_INTERP_TILES);
- DEFINE_INTEGER(GDK_INTERP_BILINEAR);
- DEFINE_INTEGER(GDK_INTERP_HYPER);
- DEFINE_INTEGER(GTK_ACCEL_VISIBLE);
- DEFINE_INTEGER(GTK_ACCEL_LOCKED);
- DEFINE_INTEGER(GTK_ACCEL_MASK);
- DEFINE_INTEGER(GTK_CALENDAR_SHOW_HEADING);
- DEFINE_INTEGER(GTK_CALENDAR_SHOW_DAY_NAMES);
- DEFINE_INTEGER(GTK_CALENDAR_NO_MONTH_CHANGE);
- DEFINE_INTEGER(GTK_CALENDAR_SHOW_WEEK_NUMBERS);
- DEFINE_INTEGER(GTK_CELL_RENDERER_SELECTED);
- DEFINE_INTEGER(GTK_CELL_RENDERER_PRELIT);
- DEFINE_INTEGER(GTK_CELL_RENDERER_INSENSITIVE);
- DEFINE_INTEGER(GTK_CELL_RENDERER_SORTED);
- DEFINE_INTEGER(GTK_CELL_RENDERER_FOCUSED);
- DEFINE_INTEGER(GTK_DIALOG_MODAL);
- DEFINE_INTEGER(GTK_DIALOG_DESTROY_WITH_PARENT);
- DEFINE_INTEGER(GTK_RESPONSE_NONE);
- DEFINE_INTEGER(GTK_RESPONSE_REJECT);
- DEFINE_INTEGER(GTK_RESPONSE_ACCEPT);
- DEFINE_INTEGER(GTK_RESPONSE_DELETE_EVENT);
- DEFINE_INTEGER(GTK_RESPONSE_OK);
- DEFINE_INTEGER(GTK_RESPONSE_CANCEL);
- DEFINE_INTEGER(GTK_RESPONSE_CLOSE);
- DEFINE_INTEGER(GTK_RESPONSE_YES);
- DEFINE_INTEGER(GTK_RESPONSE_NO);
- DEFINE_INTEGER(GTK_RESPONSE_APPLY);
- DEFINE_INTEGER(GTK_RESPONSE_HELP);
- DEFINE_INTEGER(GTK_DEST_DEFAULT_MOTION);
- DEFINE_INTEGER(GTK_DEST_DEFAULT_HIGHLIGHT);
- DEFINE_INTEGER(GTK_DEST_DEFAULT_DROP);
- DEFINE_INTEGER(GTK_DEST_DEFAULT_ALL);
- DEFINE_INTEGER(GTK_ARROW_UP);
- DEFINE_INTEGER(GTK_ARROW_DOWN);
- DEFINE_INTEGER(GTK_ARROW_LEFT);
- DEFINE_INTEGER(GTK_ARROW_RIGHT);
- DEFINE_INTEGER(GTK_EXPAND);
- DEFINE_INTEGER(GTK_SHRINK);
- DEFINE_INTEGER(GTK_FILL);
- DEFINE_INTEGER(GTK_BUTTONBOX_SPREAD);
- DEFINE_INTEGER(GTK_BUTTONBOX_EDGE);
- DEFINE_INTEGER(GTK_BUTTONBOX_START);
- DEFINE_INTEGER(GTK_BUTTONBOX_END);
- DEFINE_INTEGER(GTK_BUTTONBOX_CENTER);
- DEFINE_INTEGER(GTK_DELETE_CHARS);
- DEFINE_INTEGER(GTK_DELETE_WORD_ENDS);
- DEFINE_INTEGER(GTK_DELETE_WORDS);
- DEFINE_INTEGER(GTK_DELETE_DISPLAY_LINES);
- DEFINE_INTEGER(GTK_DELETE_DISPLAY_LINE_ENDS);
- DEFINE_INTEGER(GTK_DELETE_PARAGRAPH_ENDS);
- DEFINE_INTEGER(GTK_DELETE_PARAGRAPHS);
- DEFINE_INTEGER(GTK_DELETE_WHITESPACE);
- DEFINE_INTEGER(GTK_DIR_TAB_FORWARD);
- DEFINE_INTEGER(GTK_DIR_TAB_BACKWARD);
- DEFINE_INTEGER(GTK_DIR_UP);
- DEFINE_INTEGER(GTK_DIR_DOWN);
- DEFINE_INTEGER(GTK_DIR_LEFT);
- DEFINE_INTEGER(GTK_DIR_RIGHT);
- DEFINE_INTEGER(GTK_EXPANDER_COLLAPSED);
- DEFINE_INTEGER(GTK_EXPANDER_SEMI_COLLAPSED);
- DEFINE_INTEGER(GTK_EXPANDER_SEMI_EXPANDED);
- DEFINE_INTEGER(GTK_EXPANDER_EXPANDED);
- DEFINE_INTEGER(GTK_ICON_SIZE_INVALID);
- DEFINE_INTEGER(GTK_ICON_SIZE_MENU);
- DEFINE_INTEGER(GTK_ICON_SIZE_SMALL_TOOLBAR);
- DEFINE_INTEGER(GTK_ICON_SIZE_LARGE_TOOLBAR);
- DEFINE_INTEGER(GTK_ICON_SIZE_BUTTON);
- DEFINE_INTEGER(GTK_ICON_SIZE_DND);
- DEFINE_INTEGER(GTK_ICON_SIZE_DIALOG);
- DEFINE_INTEGER(GTK_TEXT_DIR_NONE);
- DEFINE_INTEGER(GTK_TEXT_DIR_LTR);
- DEFINE_INTEGER(GTK_TEXT_DIR_RTL);
- DEFINE_INTEGER(GTK_JUSTIFY_LEFT);
- DEFINE_INTEGER(GTK_JUSTIFY_RIGHT);
- DEFINE_INTEGER(GTK_JUSTIFY_CENTER);
- DEFINE_INTEGER(GTK_JUSTIFY_FILL);
- DEFINE_INTEGER(GTK_MENU_DIR_PARENT);
- DEFINE_INTEGER(GTK_MENU_DIR_CHILD);
- DEFINE_INTEGER(GTK_MENU_DIR_NEXT);
- DEFINE_INTEGER(GTK_MENU_DIR_PREV);
- DEFINE_INTEGER(GTK_MOVEMENT_LOGICAL_POSITIONS);
- DEFINE_INTEGER(GTK_MOVEMENT_VISUAL_POSITIONS);
- DEFINE_INTEGER(GTK_MOVEMENT_WORDS);
- DEFINE_INTEGER(GTK_MOVEMENT_DISPLAY_LINES);
- DEFINE_INTEGER(GTK_MOVEMENT_DISPLAY_LINE_ENDS);
- DEFINE_INTEGER(GTK_MOVEMENT_PARAGRAPHS);
- DEFINE_INTEGER(GTK_MOVEMENT_PARAGRAPH_ENDS);
- DEFINE_INTEGER(GTK_MOVEMENT_PAGES);
- DEFINE_INTEGER(GTK_MOVEMENT_BUFFER_ENDS);
- DEFINE_INTEGER(GTK_ORIENTATION_HORIZONTAL);
- DEFINE_INTEGER(GTK_ORIENTATION_VERTICAL);
- DEFINE_INTEGER(GTK_CORNER_TOP_LEFT);
- DEFINE_INTEGER(GTK_CORNER_BOTTOM_LEFT);
- DEFINE_INTEGER(GTK_CORNER_TOP_RIGHT);
- DEFINE_INTEGER(GTK_CORNER_BOTTOM_RIGHT);
- DEFINE_INTEGER(GTK_PACK_START);
- DEFINE_INTEGER(GTK_PACK_END);
- DEFINE_INTEGER(GTK_PATH_PRIO_LOWEST);
- DEFINE_INTEGER(GTK_PATH_PRIO_GTK);
- DEFINE_INTEGER(GTK_PATH_PRIO_APPLICATION);
- DEFINE_INTEGER(GTK_PATH_PRIO_THEME);
- DEFINE_INTEGER(GTK_PATH_PRIO_RC);
- DEFINE_INTEGER(GTK_PATH_PRIO_HIGHEST);
- DEFINE_INTEGER(GTK_PATH_PRIO_MASK);
- DEFINE_INTEGER(GTK_PATH_WIDGET);
- DEFINE_INTEGER(GTK_PATH_WIDGET_CLASS);
- DEFINE_INTEGER(GTK_PATH_CLASS);
- DEFINE_INTEGER(GTK_POLICY_ALWAYS);
- DEFINE_INTEGER(GTK_POLICY_AUTOMATIC);
- DEFINE_INTEGER(GTK_POLICY_NEVER);
- DEFINE_INTEGER(GTK_POS_LEFT);
- DEFINE_INTEGER(GTK_POS_RIGHT);
- DEFINE_INTEGER(GTK_POS_TOP);
- DEFINE_INTEGER(GTK_POS_BOTTOM);
- DEFINE_INTEGER(GTK_RELIEF_NORMAL);
- DEFINE_INTEGER(GTK_RELIEF_HALF);
- DEFINE_INTEGER(GTK_RELIEF_NONE);
- DEFINE_INTEGER(GTK_RESIZE_PARENT);
- DEFINE_INTEGER(GTK_RESIZE_QUEUE);
- DEFINE_INTEGER(GTK_RESIZE_IMMEDIATE);
- DEFINE_INTEGER(GTK_SCROLL_NONE);
- DEFINE_INTEGER(GTK_SCROLL_JUMP);
- DEFINE_INTEGER(GTK_SCROLL_STEP_BACKWARD);
- DEFINE_INTEGER(GTK_SCROLL_STEP_FORWARD);
- DEFINE_INTEGER(GTK_SCROLL_PAGE_BACKWARD);
- DEFINE_INTEGER(GTK_SCROLL_PAGE_FORWARD);
- DEFINE_INTEGER(GTK_SCROLL_STEP_UP);
- DEFINE_INTEGER(GTK_SCROLL_STEP_DOWN);
- DEFINE_INTEGER(GTK_SCROLL_PAGE_UP);
- DEFINE_INTEGER(GTK_SCROLL_PAGE_DOWN);
- DEFINE_INTEGER(GTK_SCROLL_STEP_LEFT);
- DEFINE_INTEGER(GTK_SCROLL_STEP_RIGHT);
- DEFINE_INTEGER(GTK_SCROLL_PAGE_LEFT);
- DEFINE_INTEGER(GTK_SCROLL_PAGE_RIGHT);
- DEFINE_INTEGER(GTK_SCROLL_START);
- DEFINE_INTEGER(GTK_SCROLL_END);
- DEFINE_INTEGER(GTK_SELECTION_NONE);
- DEFINE_INTEGER(GTK_SELECTION_SINGLE);
- DEFINE_INTEGER(GTK_SELECTION_BROWSE);
- DEFINE_INTEGER(GTK_SELECTION_MULTIPLE);
- DEFINE_INTEGER(GTK_SHADOW_NONE);
- DEFINE_INTEGER(GTK_SHADOW_IN);
- DEFINE_INTEGER(GTK_SHADOW_OUT);
- DEFINE_INTEGER(GTK_SHADOW_ETCHED_IN);
- DEFINE_INTEGER(GTK_SHADOW_ETCHED_OUT);
- DEFINE_INTEGER(GTK_STATE_NORMAL);
- DEFINE_INTEGER(GTK_STATE_ACTIVE);
- DEFINE_INTEGER(GTK_STATE_PRELIGHT);
- DEFINE_INTEGER(GTK_STATE_SELECTED);
- DEFINE_INTEGER(GTK_STATE_INSENSITIVE);
- DEFINE_INTEGER(GTK_TOOLBAR_ICONS);
- DEFINE_INTEGER(GTK_TOOLBAR_TEXT);
- DEFINE_INTEGER(GTK_TOOLBAR_BOTH);
- DEFINE_INTEGER(GTK_TOOLBAR_BOTH_HORIZ);
- DEFINE_INTEGER(GTK_WIN_POS_NONE);
- DEFINE_INTEGER(GTK_WIN_POS_CENTER);
- DEFINE_INTEGER(GTK_WIN_POS_MOUSE);
- DEFINE_INTEGER(GTK_WIN_POS_CENTER_ALWAYS);
- DEFINE_INTEGER(GTK_WIN_POS_CENTER_ON_PARENT);
- DEFINE_INTEGER(GTK_WINDOW_TOPLEVEL);
- DEFINE_INTEGER(GTK_WINDOW_POPUP);
- DEFINE_INTEGER(GTK_WRAP_NONE);
- DEFINE_INTEGER(GTK_WRAP_CHAR);
- DEFINE_INTEGER(GTK_WRAP_WORD);
- DEFINE_INTEGER(GTK_SORT_ASCENDING);
- DEFINE_INTEGER(GTK_SORT_DESCENDING);
- DEFINE_INTEGER(GTK_IMAGE_EMPTY);
- DEFINE_INTEGER(GTK_IMAGE_PIXBUF);
- DEFINE_INTEGER(GTK_IMAGE_STOCK);
- DEFINE_INTEGER(GTK_IMAGE_ICON_SET);
- DEFINE_INTEGER(GTK_IMAGE_ANIMATION);
- DEFINE_INTEGER(GTK_MAX_COMPOSE_LEN);
- DEFINE_INTEGER(GTK_PRIORITY_RESIZE);
- DEFINE_INTEGER(GTK_MESSAGE_INFO);
- DEFINE_INTEGER(GTK_MESSAGE_WARNING);
- DEFINE_INTEGER(GTK_MESSAGE_QUESTION);
- DEFINE_INTEGER(GTK_MESSAGE_ERROR);
- DEFINE_INTEGER(GTK_BUTTONS_NONE);
- DEFINE_INTEGER(GTK_BUTTONS_OK);
- DEFINE_INTEGER(GTK_BUTTONS_CLOSE);
- DEFINE_INTEGER(GTK_BUTTONS_CANCEL);
- DEFINE_INTEGER(GTK_BUTTONS_YES_NO);
- DEFINE_INTEGER(GTK_BUTTONS_OK_CANCEL);
- DEFINE_INTEGER(GTK_NOTEBOOK_TAB_FIRST);
- DEFINE_INTEGER(GTK_NOTEBOOK_TAB_LAST);
- DEFINE_INTEGER(GTK_SIZE_GROUP_NONE);
- DEFINE_INTEGER(GTK_SIZE_GROUP_HORIZONTAL);
- DEFINE_INTEGER(GTK_SIZE_GROUP_VERTICAL);
- DEFINE_INTEGER(GTK_SIZE_GROUP_BOTH);
- DEFINE_INTEGER(GTK_INPUT_ERROR);
- DEFINE_INTEGER(GTK_UPDATE_ALWAYS);
- DEFINE_INTEGER(GTK_UPDATE_IF_VALID);
- DEFINE_INTEGER(GTK_SPIN_STEP_FORWARD);
- DEFINE_INTEGER(GTK_SPIN_STEP_BACKWARD);
- DEFINE_INTEGER(GTK_SPIN_PAGE_FORWARD);
- DEFINE_INTEGER(GTK_SPIN_PAGE_BACKWARD);
- DEFINE_INTEGER(GTK_SPIN_HOME);
- DEFINE_INTEGER(GTK_SPIN_END);
- DEFINE_INTEGER(GTK_SPIN_USER_DEFINED);
- DEFINE_INTEGER(GTK_TEXT_SEARCH_VISIBLE_ONLY);
- DEFINE_INTEGER(GTK_TEXT_SEARCH_TEXT_ONLY);
- DEFINE_INTEGER(GTK_TEXT_WINDOW_PRIVATE);
- DEFINE_INTEGER(GTK_TEXT_WINDOW_WIDGET);
- DEFINE_INTEGER(GTK_TEXT_WINDOW_TEXT);
- DEFINE_INTEGER(GTK_TEXT_WINDOW_LEFT);
- DEFINE_INTEGER(GTK_TEXT_WINDOW_RIGHT);
- DEFINE_INTEGER(GTK_TEXT_WINDOW_TOP);
- DEFINE_INTEGER(GTK_TEXT_WINDOW_BOTTOM);
- DEFINE_INTEGER(GTK_TEXT_VIEW_PRIORITY_VALIDATE);
- DEFINE_INTEGER(GTK_TREE_MODEL_ITERS_PERSIST);
- DEFINE_INTEGER(GTK_TREE_MODEL_LIST_ONLY);
- DEFINE_INTEGER(GTK_TREE_VIEW_COLUMN_GROW_ONLY);
- DEFINE_INTEGER(GTK_TREE_VIEW_COLUMN_AUTOSIZE);
- DEFINE_INTEGER(GTK_TREE_VIEW_COLUMN_FIXED);
- DEFINE_INTEGER(GTK_TREE_VIEW_DROP_BEFORE);
- DEFINE_INTEGER(GTK_TREE_VIEW_DROP_AFTER);
- DEFINE_INTEGER(GTK_TREE_VIEW_DROP_INTO_OR_BEFORE);
- DEFINE_INTEGER(GTK_TREE_VIEW_DROP_INTO_OR_AFTER);
- DEFINE_INTEGER(PANGO_ATTR_INVALID);
- DEFINE_INTEGER(PANGO_ATTR_LANGUAGE);
- DEFINE_INTEGER(PANGO_ATTR_FAMILY);
- DEFINE_INTEGER(PANGO_ATTR_STYLE);
- DEFINE_INTEGER(PANGO_ATTR_WEIGHT);
- DEFINE_INTEGER(PANGO_ATTR_VARIANT);
- DEFINE_INTEGER(PANGO_ATTR_STRETCH);
- DEFINE_INTEGER(PANGO_ATTR_SIZE);
- DEFINE_INTEGER(PANGO_ATTR_FONT_DESC);
- DEFINE_INTEGER(PANGO_ATTR_FOREGROUND);
- DEFINE_INTEGER(PANGO_ATTR_BACKGROUND);
- DEFINE_INTEGER(PANGO_ATTR_UNDERLINE);
- DEFINE_INTEGER(PANGO_ATTR_STRIKETHROUGH);
- DEFINE_INTEGER(PANGO_ATTR_RISE);
- DEFINE_INTEGER(PANGO_ATTR_SHAPE);
- DEFINE_INTEGER(PANGO_ATTR_SCALE);
- DEFINE_INTEGER(PANGO_UNDERLINE_NONE);
- DEFINE_INTEGER(PANGO_UNDERLINE_SINGLE);
- DEFINE_INTEGER(PANGO_UNDERLINE_DOUBLE);
- DEFINE_INTEGER(PANGO_UNDERLINE_LOW);
- DEFINE_INTEGER(PANGO_COVERAGE_NONE);
- DEFINE_INTEGER(PANGO_COVERAGE_FALLBACK);
- DEFINE_INTEGER(PANGO_COVERAGE_APPROXIMATE);
- DEFINE_INTEGER(PANGO_COVERAGE_EXACT);
- DEFINE_INTEGER(PANGO_STYLE_NORMAL);
- DEFINE_INTEGER(PANGO_STYLE_OBLIQUE);
- DEFINE_INTEGER(PANGO_STYLE_ITALIC);
- DEFINE_INTEGER(PANGO_VARIANT_NORMAL);
- DEFINE_INTEGER(PANGO_VARIANT_SMALL_CAPS);
- DEFINE_INTEGER(PANGO_WEIGHT_ULTRALIGHT);
- DEFINE_INTEGER(PANGO_WEIGHT_LIGHT);
- DEFINE_INTEGER(PANGO_WEIGHT_NORMAL);
- DEFINE_INTEGER(PANGO_WEIGHT_BOLD);
- DEFINE_INTEGER(PANGO_WEIGHT_ULTRABOLD);
- DEFINE_INTEGER(PANGO_WEIGHT_HEAVY);
- DEFINE_INTEGER(PANGO_STRETCH_ULTRA_CONDENSED);
- DEFINE_INTEGER(PANGO_STRETCH_EXTRA_CONDENSED);
- DEFINE_INTEGER(PANGO_STRETCH_CONDENSED);
- DEFINE_INTEGER(PANGO_STRETCH_SEMI_CONDENSED);
- DEFINE_INTEGER(PANGO_STRETCH_NORMAL);
- DEFINE_INTEGER(PANGO_STRETCH_SEMI_EXPANDED);
- DEFINE_INTEGER(PANGO_STRETCH_EXPANDED);
- DEFINE_INTEGER(PANGO_STRETCH_EXTRA_EXPANDED);
- DEFINE_INTEGER(PANGO_STRETCH_ULTRA_EXPANDED);
- DEFINE_INTEGER(PANGO_FONT_MASK_FAMILY);
- DEFINE_INTEGER(PANGO_FONT_MASK_STYLE);
- DEFINE_INTEGER(PANGO_FONT_MASK_VARIANT);
- DEFINE_INTEGER(PANGO_FONT_MASK_WEIGHT);
- DEFINE_INTEGER(PANGO_FONT_MASK_STRETCH);
- DEFINE_INTEGER(PANGO_FONT_MASK_SIZE);
- DEFINE_INTEGER(PANGO_ALIGN_LEFT);
- DEFINE_INTEGER(PANGO_ALIGN_CENTER);
- DEFINE_INTEGER(PANGO_ALIGN_RIGHT);
- DEFINE_INTEGER(PANGO_WRAP_WORD);
- DEFINE_INTEGER(PANGO_WRAP_CHAR);
- DEFINE_INTEGER(PANGO_DIRECTION_LTR);
- DEFINE_INTEGER(PANGO_DIRECTION_RTL);
- DEFINE_INTEGER(PANGO_DIRECTION_TTB_LTR);
- DEFINE_INTEGER(PANGO_DIRECTION_TTB_RTL);
- DEFINE_INTEGER(GDK_WINDOW_STATE_FULLSCREEN);
- DEFINE_INTEGER(GDK_WINDOW_STATE_ABOVE);
- DEFINE_INTEGER(GDK_WINDOW_STATE_BELOW);
- DEFINE_INTEGER(GTK_MOVEMENT_HORIZONTAL_PAGES);
- DEFINE_INTEGER(GTK_SCROLL_STEPS);
- DEFINE_INTEGER(GTK_SCROLL_PAGES);
- DEFINE_INTEGER(GTK_SCROLL_ENDS);
- DEFINE_INTEGER(GTK_SCROLL_HORIZONTAL_STEPS);
- DEFINE_INTEGER(GTK_SCROLL_HORIZONTAL_PAGES);
- DEFINE_INTEGER(GTK_SCROLL_HORIZONTAL_ENDS);
- DEFINE_INTEGER(GTK_WRAP_WORD_CHAR);
- DEFINE_INTEGER(GTK_FILE_FILTER_FILENAME);
- DEFINE_INTEGER(GTK_FILE_FILTER_URI);
- DEFINE_INTEGER(GTK_FILE_FILTER_DISPLAY_NAME);
- DEFINE_INTEGER(GTK_FILE_FILTER_MIME_TYPE);
- DEFINE_INTEGER(GTK_ICON_LOOKUP_NO_SVG);
- DEFINE_INTEGER(GTK_ICON_LOOKUP_FORCE_SVG);
- DEFINE_INTEGER(GTK_ICON_LOOKUP_USE_BUILTIN);
- DEFINE_INTEGER(GTK_ICON_LOOKUP_GENERIC_FALLBACK);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ACTION_OPEN);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ACTION_SAVE);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ACTION_CREATE_FOLDER);
- DEFINE_INTEGER(G_PRIORITY_HIGH);
- DEFINE_INTEGER(G_PRIORITY_DEFAULT);
- DEFINE_INTEGER(G_PRIORITY_HIGH_IDLE);
- DEFINE_INTEGER(G_PRIORITY_DEFAULT_IDLE);
- DEFINE_INTEGER(G_PRIORITY_LOW);
- DEFINE_INTEGER(PANGO_ATTR_FALLBACK);
- DEFINE_INTEGER(PANGO_ATTR_LETTER_SPACING);
- DEFINE_INTEGER(PANGO_UNDERLINE_ERROR);
- DEFINE_INTEGER(PANGO_WRAP_WORD_CHAR);
- DEFINE_INTEGER(PANGO_ELLIPSIZE_NONE);
- DEFINE_INTEGER(PANGO_ELLIPSIZE_START);
- DEFINE_INTEGER(PANGO_ELLIPSIZE_MIDDLE);
- DEFINE_INTEGER(PANGO_ELLIPSIZE_END);
- DEFINE_INTEGER(PANGO_SCRIPT_INVALID_CODE);
- DEFINE_INTEGER(PANGO_SCRIPT_COMMON);
- DEFINE_INTEGER(PANGO_SCRIPT_INHERITED);
- DEFINE_INTEGER(PANGO_SCRIPT_ARABIC);
- DEFINE_INTEGER(PANGO_SCRIPT_ARMENIAN);
- DEFINE_INTEGER(PANGO_SCRIPT_BENGALI);
- DEFINE_INTEGER(PANGO_SCRIPT_BOPOMOFO);
- DEFINE_INTEGER(PANGO_SCRIPT_CHEROKEE);
- DEFINE_INTEGER(PANGO_SCRIPT_COPTIC);
- DEFINE_INTEGER(PANGO_SCRIPT_CYRILLIC);
- DEFINE_INTEGER(PANGO_SCRIPT_DESERET);
- DEFINE_INTEGER(PANGO_SCRIPT_DEVANAGARI);
- DEFINE_INTEGER(PANGO_SCRIPT_ETHIOPIC);
- DEFINE_INTEGER(PANGO_SCRIPT_GEORGIAN);
- DEFINE_INTEGER(PANGO_SCRIPT_GOTHIC);
- DEFINE_INTEGER(PANGO_SCRIPT_GREEK);
- DEFINE_INTEGER(PANGO_SCRIPT_GUJARATI);
- DEFINE_INTEGER(PANGO_SCRIPT_GURMUKHI);
- DEFINE_INTEGER(PANGO_SCRIPT_HAN);
- DEFINE_INTEGER(PANGO_SCRIPT_HANGUL);
- DEFINE_INTEGER(PANGO_SCRIPT_HEBREW);
- DEFINE_INTEGER(PANGO_SCRIPT_HIRAGANA);
- DEFINE_INTEGER(PANGO_SCRIPT_KANNADA);
- DEFINE_INTEGER(PANGO_SCRIPT_KATAKANA);
- DEFINE_INTEGER(PANGO_SCRIPT_KHMER);
- DEFINE_INTEGER(PANGO_SCRIPT_LAO);
- DEFINE_INTEGER(PANGO_SCRIPT_LATIN);
- DEFINE_INTEGER(PANGO_SCRIPT_MALAYALAM);
- DEFINE_INTEGER(PANGO_SCRIPT_MONGOLIAN);
- DEFINE_INTEGER(PANGO_SCRIPT_MYANMAR);
- DEFINE_INTEGER(PANGO_SCRIPT_OGHAM);
- DEFINE_INTEGER(PANGO_SCRIPT_OLD_ITALIC);
- DEFINE_INTEGER(PANGO_SCRIPT_ORIYA);
- DEFINE_INTEGER(PANGO_SCRIPT_RUNIC);
- DEFINE_INTEGER(PANGO_SCRIPT_SINHALA);
- DEFINE_INTEGER(PANGO_SCRIPT_SYRIAC);
- DEFINE_INTEGER(PANGO_SCRIPT_TAMIL);
- DEFINE_INTEGER(PANGO_SCRIPT_TELUGU);
- DEFINE_INTEGER(PANGO_SCRIPT_THAANA);
- DEFINE_INTEGER(PANGO_SCRIPT_THAI);
- DEFINE_INTEGER(PANGO_SCRIPT_TIBETAN);
- DEFINE_INTEGER(PANGO_SCRIPT_CANADIAN_ABORIGINAL);
- DEFINE_INTEGER(PANGO_SCRIPT_YI);
- DEFINE_INTEGER(PANGO_SCRIPT_TAGALOG);
- DEFINE_INTEGER(PANGO_SCRIPT_HANUNOO);
- DEFINE_INTEGER(PANGO_SCRIPT_BUHID);
- DEFINE_INTEGER(PANGO_SCRIPT_TAGBANWA);
- DEFINE_INTEGER(PANGO_SCRIPT_BRAILLE);
- DEFINE_INTEGER(PANGO_SCRIPT_CYPRIOT);
- DEFINE_INTEGER(PANGO_SCRIPT_LIMBU);
- DEFINE_INTEGER(PANGO_SCRIPT_OSMANYA);
- DEFINE_INTEGER(PANGO_SCRIPT_SHAVIAN);
- DEFINE_INTEGER(PANGO_SCRIPT_LINEAR_B);
- DEFINE_INTEGER(PANGO_SCRIPT_TAI_LE);
- DEFINE_INTEGER(PANGO_SCRIPT_UGARITIC);
- DEFINE_INTEGER(PANGO_TAB_LEFT);
- DEFINE_INTEGER(PANGO_DIRECTION_WEAK_LTR);
- DEFINE_INTEGER(PANGO_DIRECTION_WEAK_RTL);
- DEFINE_INTEGER(PANGO_DIRECTION_NEUTRAL);
- DEFINE_INTEGER(GTK_TREE_SORTABLE_DEFAULT_SORT_COLUMN_ID);
- DEFINE_INTEGER(GTK_TREE_SORTABLE_UNSORTED_SORT_COLUMN_ID);
- DEFINE_INTEGER(GTK_IMAGE_ICON_NAME);
- DEFINE_INTEGER(PANGO_ATTR_UNDERLINE_COLOR);
- DEFINE_INTEGER(PANGO_ATTR_STRIKETHROUGH_COLOR);
- DEFINE_INTEGER(PANGO_RENDER_PART_FOREGROUND);
- DEFINE_INTEGER(PANGO_RENDER_PART_BACKGROUND);
- DEFINE_INTEGER(PANGO_RENDER_PART_UNDERLINE);
- DEFINE_INTEGER(PANGO_RENDER_PART_STRIKETHROUGH);
- DEFINE_INTEGER(G_LOG_FLAG_RECURSION);
- DEFINE_INTEGER(G_LOG_FLAG_FATAL);
- DEFINE_INTEGER(G_LOG_LEVEL_ERROR);
- DEFINE_INTEGER(G_LOG_LEVEL_CRITICAL);
- DEFINE_INTEGER(G_LOG_LEVEL_WARNING);
- DEFINE_INTEGER(G_LOG_LEVEL_MESSAGE);
- DEFINE_INTEGER(G_LOG_LEVEL_INFO);
- DEFINE_INTEGER(G_LOG_LEVEL_DEBUG);
- DEFINE_INTEGER(G_LOG_LEVEL_MASK);
- DEFINE_INTEGER(G_LOG_FATAL_MASK);
- DEFINE_INTEGER(PANGO_WEIGHT_SEMIBOLD);
- DEFINE_INTEGER(GTK_PACK_DIRECTION_LTR);
- DEFINE_INTEGER(GTK_PACK_DIRECTION_RTL);
- DEFINE_INTEGER(GTK_PACK_DIRECTION_TTB);
- DEFINE_INTEGER(GTK_PACK_DIRECTION_BTT);
- DEFINE_INTEGER(GTK_ICON_VIEW_NO_DROP);
- DEFINE_INTEGER(GTK_ICON_VIEW_DROP_INTO);
- DEFINE_INTEGER(GTK_ICON_VIEW_DROP_LEFT);
- DEFINE_INTEGER(GTK_ICON_VIEW_DROP_RIGHT);
- DEFINE_INTEGER(GTK_ICON_VIEW_DROP_ABOVE);
- DEFINE_INTEGER(GTK_ICON_VIEW_DROP_BELOW);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_CONFIRMATION_CONFIRM);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_CONFIRMATION_ACCEPT_FILENAME);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_CONFIRMATION_SELECT_AGAIN);
- DEFINE_INTEGER(PANGO_SCRIPT_NEW_TAI_LUE);
- DEFINE_INTEGER(PANGO_SCRIPT_BUGINESE);
- DEFINE_INTEGER(PANGO_SCRIPT_GLAGOLITIC);
- DEFINE_INTEGER(PANGO_SCRIPT_TIFINAGH);
- DEFINE_INTEGER(PANGO_SCRIPT_SYLOTI_NAGRI);
- DEFINE_INTEGER(PANGO_SCRIPT_OLD_PERSIAN);
- DEFINE_INTEGER(PANGO_SCRIPT_KHAROSHTHI);
- DEFINE_INTEGER(GDK_SUPER_MASK);
- DEFINE_INTEGER(GDK_HYPER_MASK);
- DEFINE_INTEGER(GDK_META_MASK);
- DEFINE_INTEGER(GTK_SENSITIVITY_AUTO);
- DEFINE_INTEGER(GTK_SENSITIVITY_ON);
- DEFINE_INTEGER(GTK_SENSITIVITY_OFF);
- DEFINE_INTEGER(GTK_TEXT_BUFFER_TARGET_INFO_BUFFER_CONTENTS);
- DEFINE_INTEGER(GTK_TEXT_BUFFER_TARGET_INFO_RICH_TEXT);
- DEFINE_INTEGER(GTK_TEXT_BUFFER_TARGET_INFO_TEXT);
- DEFINE_INTEGER(GTK_ASSISTANT_PAGE_CONTENT);
- DEFINE_INTEGER(GTK_ASSISTANT_PAGE_INTRO);
- DEFINE_INTEGER(GTK_ASSISTANT_PAGE_CONFIRM);
- DEFINE_INTEGER(GTK_ASSISTANT_PAGE_SUMMARY);
- DEFINE_INTEGER(GTK_ASSISTANT_PAGE_PROGRESS);
- DEFINE_INTEGER(GTK_CELL_RENDERER_ACCEL_MODE_GTK);
- DEFINE_INTEGER(GTK_CELL_RENDERER_ACCEL_MODE_OTHER);
- DEFINE_INTEGER(GTK_RECENT_SORT_NONE);
- DEFINE_INTEGER(GTK_RECENT_SORT_MRU);
- DEFINE_INTEGER(GTK_RECENT_SORT_LRU);
- DEFINE_INTEGER(GTK_RECENT_SORT_CUSTOM);
- DEFINE_INTEGER(GTK_RECENT_CHOOSER_ERROR_NOT_FOUND);
- DEFINE_INTEGER(GTK_RECENT_CHOOSER_ERROR_INVALID_URI);
- DEFINE_INTEGER(GTK_RECENT_FILTER_URI);
- DEFINE_INTEGER(GTK_RECENT_FILTER_DISPLAY_NAME);
- DEFINE_INTEGER(GTK_RECENT_FILTER_MIME_TYPE);
- DEFINE_INTEGER(GTK_RECENT_FILTER_APPLICATION);
- DEFINE_INTEGER(GTK_RECENT_FILTER_GROUP);
- DEFINE_INTEGER(GTK_RECENT_FILTER_AGE);
- DEFINE_INTEGER(GTK_RECENT_MANAGER_ERROR_NOT_FOUND);
- DEFINE_INTEGER(GTK_RECENT_MANAGER_ERROR_INVALID_URI);
- DEFINE_INTEGER(GTK_RECENT_MANAGER_ERROR_INVALID_ENCODING);
- DEFINE_INTEGER(GTK_RECENT_MANAGER_ERROR_NOT_REGISTERED);
- DEFINE_INTEGER(GTK_RECENT_MANAGER_ERROR_READ);
- DEFINE_INTEGER(GTK_RECENT_MANAGER_ERROR_WRITE);
- DEFINE_INTEGER(GTK_RECENT_MANAGER_ERROR_UNKNOWN);
- DEFINE_INTEGER(GTK_MESSAGE_OTHER);
- DEFINE_INTEGER(GTK_TREE_VIEW_GRID_LINES_NONE);
- DEFINE_INTEGER(GTK_TREE_VIEW_GRID_LINES_HORIZONTAL);
- DEFINE_INTEGER(GTK_TREE_VIEW_GRID_LINES_VERTICAL);
- DEFINE_INTEGER(GTK_TREE_VIEW_GRID_LINES_BOTH);
- DEFINE_INTEGER(GTK_PRINT_STATUS_INITIAL);
- DEFINE_INTEGER(GTK_PRINT_STATUS_PREPARING);
- DEFINE_INTEGER(GTK_PRINT_STATUS_GENERATING_DATA);
- DEFINE_INTEGER(GTK_PRINT_STATUS_SENDING_DATA);
- DEFINE_INTEGER(GTK_PRINT_STATUS_PENDING);
- DEFINE_INTEGER(GTK_PRINT_STATUS_PENDING_ISSUE);
- DEFINE_INTEGER(GTK_PRINT_STATUS_PRINTING);
- DEFINE_INTEGER(GTK_PRINT_STATUS_FINISHED);
- DEFINE_INTEGER(GTK_PRINT_STATUS_FINISHED_ABORTED);
- DEFINE_INTEGER(GTK_PRINT_OPERATION_RESULT_ERROR);
- DEFINE_INTEGER(GTK_PRINT_OPERATION_RESULT_APPLY);
- DEFINE_INTEGER(GTK_PRINT_OPERATION_RESULT_CANCEL);
- DEFINE_INTEGER(GTK_PRINT_OPERATION_RESULT_IN_PROGRESS);
- DEFINE_INTEGER(GTK_PRINT_OPERATION_ACTION_PRINT_DIALOG);
- DEFINE_INTEGER(GTK_PRINT_OPERATION_ACTION_PRINT);
- DEFINE_INTEGER(GTK_PRINT_OPERATION_ACTION_PREVIEW);
- DEFINE_INTEGER(GTK_PRINT_OPERATION_ACTION_EXPORT);
- DEFINE_INTEGER(GTK_PRINT_ERROR_GENERAL);
- DEFINE_INTEGER(GTK_PRINT_ERROR_INTERNAL_ERROR);
- DEFINE_INTEGER(GTK_PRINT_ERROR_NOMEM);
- DEFINE_INTEGER(GTK_PRINT_ERROR_INVALID_FILE);
- DEFINE_INTEGER(GTK_DRAG_RESULT_SUCCESS);
- DEFINE_INTEGER(GTK_DRAG_RESULT_NO_TARGET);
- DEFINE_INTEGER(GTK_DRAG_RESULT_USER_CANCELLED);
- DEFINE_INTEGER(GTK_DRAG_RESULT_TIMEOUT_EXPIRED);
- DEFINE_INTEGER(GTK_DRAG_RESULT_GRAB_BROKEN);
- DEFINE_INTEGER(GTK_DRAG_RESULT_ERROR);
-#if HAVE_GTK_TEST_WIDGET_CLICK
- DEFINE_INTEGER(GTK_CALENDAR_SHOW_DETAILS);
+#endif
+ define_integer(G_NORMALIZE_DEFAULT);
+ define_integer(G_NORMALIZE_NFD);
+ define_integer(G_NORMALIZE_DEFAULT_COMPOSE);
+ define_integer(G_NORMALIZE_NFC);
+ define_integer(G_NORMALIZE_ALL);
+ define_integer(G_NORMALIZE_NFKD);
+ define_integer(G_NORMALIZE_ALL_COMPOSE);
+ define_integer(G_NORMALIZE_NFKC);
+ define_integer(G_SIGNAL_RUN_FIRST);
+ define_integer(G_SIGNAL_RUN_LAST);
+ define_integer(G_SIGNAL_RUN_CLEANUP);
+ define_integer(G_SIGNAL_NO_RECURSE);
+ define_integer(G_SIGNAL_DETAILED);
+ define_integer(G_SIGNAL_ACTION);
+ define_integer(G_SIGNAL_NO_HOOKS);
+ define_integer(G_CONNECT_AFTER);
+ define_integer(G_CONNECT_SWAPPED);
+ define_integer(G_SIGNAL_MATCH_ID);
+ define_integer(G_SIGNAL_MATCH_DETAIL);
+ define_integer(G_SIGNAL_MATCH_CLOSURE);
+ define_integer(G_SIGNAL_MATCH_FUNC);
+ define_integer(G_SIGNAL_MATCH_DATA);
+ define_integer(G_SIGNAL_MATCH_UNBLOCKED);
+ define_integer(GDK_X_CURSOR);
+ define_integer(GDK_ARROW);
+ define_integer(GDK_BASED_ARROW_DOWN);
+ define_integer(GDK_BASED_ARROW_UP);
+ define_integer(GDK_BOAT);
+ define_integer(GDK_BOGOSITY);
+ define_integer(GDK_BOTTOM_LEFT_CORNER);
+ define_integer(GDK_BOTTOM_RIGHT_CORNER);
+ define_integer(GDK_BOTTOM_SIDE);
+ define_integer(GDK_BOTTOM_TEE);
+ define_integer(GDK_BOX_SPIRAL);
+ define_integer(GDK_CENTER_PTR);
+ define_integer(GDK_CIRCLE);
+ define_integer(GDK_CLOCK);
+ define_integer(GDK_COFFEE_MUG);
+ define_integer(GDK_CROSS);
+ define_integer(GDK_CROSS_REVERSE);
+ define_integer(GDK_CROSSHAIR);
+ define_integer(GDK_DIAMOND_CROSS);
+ define_integer(GDK_DOT);
+ define_integer(GDK_DOTBOX);
+ define_integer(GDK_DOUBLE_ARROW);
+ define_integer(GDK_DRAFT_LARGE);
+ define_integer(GDK_DRAFT_SMALL);
+ define_integer(GDK_DRAPED_BOX);
+ define_integer(GDK_EXCHANGE);
+ define_integer(GDK_FLEUR);
+ define_integer(GDK_GOBBLER);
+ define_integer(GDK_GUMBY);
+ define_integer(GDK_HAND1);
+ define_integer(GDK_HAND2);
+ define_integer(GDK_HEART);
+ define_integer(GDK_ICON);
+ define_integer(GDK_IRON_CROSS);
+ define_integer(GDK_LEFT_PTR);
+ define_integer(GDK_LEFT_SIDE);
+ define_integer(GDK_LEFT_TEE);
+ define_integer(GDK_LEFTBUTTON);
+ define_integer(GDK_LL_ANGLE);
+ define_integer(GDK_LR_ANGLE);
+ define_integer(GDK_MAN);
+ define_integer(GDK_MIDDLEBUTTON);
+ define_integer(GDK_MOUSE);
+ define_integer(GDK_PENCIL);
+ define_integer(GDK_PIRATE);
+ define_integer(GDK_PLUS);
+ define_integer(GDK_QUESTION_ARROW);
+ define_integer(GDK_RIGHT_PTR);
+ define_integer(GDK_RIGHT_SIDE);
+ define_integer(GDK_RIGHT_TEE);
+ define_integer(GDK_RIGHTBUTTON);
+ define_integer(GDK_RTL_LOGO);
+ define_integer(GDK_SAILBOAT);
+ define_integer(GDK_SB_DOWN_ARROW);
+ define_integer(GDK_SB_H_DOUBLE_ARROW);
+ define_integer(GDK_SB_LEFT_ARROW);
+ define_integer(GDK_SB_RIGHT_ARROW);
+ define_integer(GDK_SB_UP_ARROW);
+ define_integer(GDK_SB_V_DOUBLE_ARROW);
+ define_integer(GDK_SHUTTLE);
+ define_integer(GDK_SIZING);
+ define_integer(GDK_SPIDER);
+ define_integer(GDK_SPRAYCAN);
+ define_integer(GDK_STAR);
+ define_integer(GDK_TARGET);
+ define_integer(GDK_TCROSS);
+ define_integer(GDK_TOP_LEFT_ARROW);
+ define_integer(GDK_TOP_LEFT_CORNER);
+ define_integer(GDK_TOP_RIGHT_CORNER);
+ define_integer(GDK_TOP_SIDE);
+ define_integer(GDK_TOP_TEE);
+ define_integer(GDK_TREK);
+ define_integer(GDK_UL_ANGLE);
+ define_integer(GDK_UMBRELLA);
+ define_integer(GDK_UR_ANGLE);
+ define_integer(GDK_WATCH);
+ define_integer(GDK_XTERM);
+ define_integer(GDK_LAST_CURSOR );
+ define_integer(GDK_ACTION_DEFAULT);
+ define_integer(GDK_ACTION_COPY);
+ define_integer(GDK_ACTION_MOVE);
+ define_integer(GDK_ACTION_LINK);
+ define_integer(GDK_ACTION_PRIVATE);
+ define_integer(GDK_ACTION_ASK);
+ define_integer(GDK_PRIORITY_EVENTS);
+ define_integer(GDK_PRIORITY_REDRAW);
+ define_integer(GDK_NOTHING);
+ define_integer(GDK_DELETE);
+ define_integer(GDK_DESTROY);
+ define_integer(GDK_EXPOSE);
+ define_integer(GDK_MOTION_NOTIFY);
+ define_integer(GDK_BUTTON_PRESS);
+ define_integer(GDK_2BUTTON_PRESS);
+ define_integer(GDK_3BUTTON_PRESS);
+ define_integer(GDK_BUTTON_RELEASE);
+ define_integer(GDK_KEY_PRESS);
+ define_integer(GDK_KEY_RELEASE);
+ define_integer(GDK_ENTER_NOTIFY);
+ define_integer(GDK_LEAVE_NOTIFY);
+ define_integer(GDK_FOCUS_CHANGE);
+ define_integer(GDK_CONFIGURE);
+ define_integer(GDK_MAP);
+ define_integer(GDK_UNMAP);
+ define_integer(GDK_PROPERTY_NOTIFY);
+ define_integer(GDK_SELECTION_CLEAR);
+ define_integer(GDK_SELECTION_REQUEST);
+ define_integer(GDK_SELECTION_NOTIFY);
+ define_integer(GDK_PROXIMITY_IN);
+ define_integer(GDK_PROXIMITY_OUT);
+ define_integer(GDK_DRAG_ENTER);
+ define_integer(GDK_DRAG_LEAVE);
+ define_integer(GDK_DRAG_MOTION);
+ define_integer(GDK_DRAG_STATUS);
+ define_integer(GDK_DROP_START);
+ define_integer(GDK_DROP_FINISHED);
+ define_integer(GDK_CLIENT_EVENT);
+ define_integer(GDK_VISIBILITY_NOTIFY);
+ define_integer(GDK_SCROLL);
+ define_integer(GDK_WINDOW_STATE);
+ define_integer(GDK_SETTING);
+ define_integer(GDK_OWNER_CHANGE);
+ define_integer(GDK_GRAB_BROKEN);
+ define_integer(GDK_EXPOSURE_MASK);
+ define_integer(GDK_POINTER_MOTION_MASK);
+ define_integer(GDK_BUTTON_MOTION_MASK);
+ define_integer(GDK_BUTTON1_MOTION_MASK);
+ define_integer(GDK_BUTTON2_MOTION_MASK);
+ define_integer(GDK_BUTTON3_MOTION_MASK);
+ define_integer(GDK_BUTTON_PRESS_MASK);
+ define_integer(GDK_BUTTON_RELEASE_MASK);
+ define_integer(GDK_KEY_PRESS_MASK);
+ define_integer(GDK_KEY_RELEASE_MASK);
+ define_integer(GDK_ENTER_NOTIFY_MASK);
+ define_integer(GDK_LEAVE_NOTIFY_MASK);
+ define_integer(GDK_FOCUS_CHANGE_MASK);
+ define_integer(GDK_STRUCTURE_MASK);
+ define_integer(GDK_PROPERTY_CHANGE_MASK);
+ define_integer(GDK_VISIBILITY_NOTIFY_MASK);
+ define_integer(GDK_PROXIMITY_IN_MASK);
+ define_integer(GDK_PROXIMITY_OUT_MASK);
+ define_integer(GDK_SUBSTRUCTURE_MASK);
+ define_integer(GDK_SCROLL_MASK);
+ define_integer(GDK_ALL_EVENTS_MASK);
+ define_integer(GDK_SCROLL_UP);
+ define_integer(GDK_SCROLL_DOWN);
+ define_integer(GDK_SCROLL_LEFT);
+ define_integer(GDK_SCROLL_RIGHT);
+ define_integer(GDK_NOTIFY_ANCESTOR);
+ define_integer(GDK_NOTIFY_VIRTUAL);
+ define_integer(GDK_NOTIFY_INFERIOR);
+ define_integer(GDK_NOTIFY_NONLINEAR);
+ define_integer(GDK_NOTIFY_NONLINEAR_VIRTUAL);
+ define_integer(GDK_NOTIFY_UNKNOWN);
+ define_integer(GDK_CROSSING_NORMAL);
+ define_integer(GDK_CROSSING_GRAB);
+ define_integer(GDK_CROSSING_UNGRAB);
+ define_integer(GDK_PROPERTY_NEW_VALUE);
+ define_integer(GDK_PROPERTY_DELETE);
+ define_integer(GDK_WINDOW_STATE_WITHDRAWN);
+ define_integer(GDK_WINDOW_STATE_ICONIFIED);
+ define_integer(GDK_WINDOW_STATE_MAXIMIZED);
+ define_integer(GDK_WINDOW_STATE_STICKY);
+ define_integer(GDK_SETTING_ACTION_NEW);
+ define_integer(GDK_SETTING_ACTION_CHANGED);
+ define_integer(GDK_SETTING_ACTION_DELETED);
+ define_integer(GDK_PROP_MODE_REPLACE);
+ define_integer(GDK_PROP_MODE_PREPEND);
+ define_integer(GDK_PROP_MODE_APPEND);
+ define_integer(GDK_CURRENT_TIME);
+ define_integer(GDK_PARENT_RELATIVE);
+ define_integer(GDK_LSB_FIRST);
+ define_integer(GDK_MSB_FIRST);
+ define_integer(GDK_SHIFT_MASK);
+ define_integer(GDK_LOCK_MASK);
+ define_integer(GDK_CONTROL_MASK);
+ define_integer(GDK_MOD1_MASK);
+ define_integer(GDK_MOD2_MASK);
+ define_integer(GDK_MOD3_MASK);
+ define_integer(GDK_MOD4_MASK);
+ define_integer(GDK_MOD5_MASK);
+ define_integer(GDK_BUTTON1_MASK);
+ define_integer(GDK_BUTTON2_MASK);
+ define_integer(GDK_BUTTON3_MASK);
+ define_integer(GDK_BUTTON4_MASK);
+ define_integer(GDK_BUTTON5_MASK);
+ define_integer(GDK_RELEASE_MASK);
+ define_integer(GDK_MODIFIER_MASK);
+ define_integer(GDK_OK);
+ define_integer(GDK_ERROR);
+ define_integer(GDK_ERROR_PARAM);
+ define_integer(GDK_ERROR_FILE);
+ define_integer(GDK_ERROR_MEM);
+ define_integer(GDK_GRAB_SUCCESS);
+ define_integer(GDK_GRAB_ALREADY_GRABBED);
+ define_integer(GDK_GRAB_INVALID_TIME);
+ define_integer(GDK_GRAB_NOT_VIEWABLE);
+ define_integer(GDK_GRAB_FROZEN);
+ define_integer(GDK_VISUAL_STATIC_GRAY);
+ define_integer(GDK_VISUAL_GRAYSCALE);
+ define_integer(GDK_VISUAL_STATIC_COLOR);
+ define_integer(GDK_VISUAL_PSEUDO_COLOR);
+ define_integer(GDK_VISUAL_TRUE_COLOR);
+ define_integer(GDK_VISUAL_DIRECT_COLOR);
+ define_integer(GDK_INPUT_OUTPUT);
+ define_integer(GDK_INPUT_ONLY);
+ define_integer(GDK_WINDOW_ROOT);
+ define_integer(GDK_WINDOW_TOPLEVEL);
+ define_integer(GDK_WINDOW_CHILD);
+ define_integer(GDK_WINDOW_TEMP);
+ define_integer(GDK_WINDOW_FOREIGN);
+ define_integer(GDK_WA_TITLE);
+ define_integer(GDK_WA_X);
+ define_integer(GDK_WA_Y);
+ define_integer(GDK_WA_CURSOR);
+ define_integer(GDK_WA_VISUAL);
+ define_integer(GDK_WA_WMCLASS);
+ define_integer(GDK_WA_NOREDIR);
+ define_integer(GDK_HINT_POS);
+ define_integer(GDK_HINT_MIN_SIZE);
+ define_integer(GDK_HINT_MAX_SIZE);
+ define_integer(GDK_HINT_BASE_SIZE);
+ define_integer(GDK_HINT_ASPECT);
+ define_integer(GDK_HINT_RESIZE_INC);
+ define_integer(GDK_HINT_WIN_GRAVITY);
+ define_integer(GDK_HINT_USER_POS);
+ define_integer(GDK_HINT_USER_SIZE);
+ define_integer(GDK_WINDOW_TYPE_HINT_NORMAL);
+ define_integer(GDK_WINDOW_TYPE_HINT_DIALOG);
+ define_integer(GDK_WINDOW_TYPE_HINT_MENU);
+ define_integer(GDK_WINDOW_TYPE_HINT_TOOLBAR);
+ define_integer(GDK_DECOR_ALL);
+ define_integer(GDK_DECOR_BORDER);
+ define_integer(GDK_DECOR_RESIZEH);
+ define_integer(GDK_DECOR_TITLE);
+ define_integer(GDK_DECOR_MENU);
+ define_integer(GDK_DECOR_MINIMIZE);
+ define_integer(GDK_DECOR_MAXIMIZE);
+ define_integer(GDK_FUNC_ALL);
+ define_integer(GDK_FUNC_RESIZE);
+ define_integer(GDK_FUNC_MOVE);
+ define_integer(GDK_FUNC_MINIMIZE);
+ define_integer(GDK_FUNC_MAXIMIZE);
+ define_integer(GDK_FUNC_CLOSE);
+ define_integer(GDK_GRAVITY_NORTH_WEST);
+ define_integer(GDK_GRAVITY_NORTH);
+ define_integer(GDK_GRAVITY_NORTH_EAST);
+ define_integer(GDK_GRAVITY_WEST);
+ define_integer(GDK_GRAVITY_CENTER);
+ define_integer(GDK_GRAVITY_EAST);
+ define_integer(GDK_GRAVITY_SOUTH_WEST);
+ define_integer(GDK_GRAVITY_SOUTH);
+ define_integer(GDK_GRAVITY_SOUTH_EAST);
+ define_integer(GDK_GRAVITY_STATIC);
+ define_integer(GDK_WINDOW_EDGE_NORTH_WEST);
+ define_integer(GDK_WINDOW_EDGE_NORTH);
+ define_integer(GDK_WINDOW_EDGE_NORTH_EAST);
+ define_integer(GDK_WINDOW_EDGE_WEST);
+ define_integer(GDK_WINDOW_EDGE_EAST);
+ define_integer(GDK_WINDOW_EDGE_SOUTH_WEST);
+ define_integer(GDK_WINDOW_EDGE_SOUTH);
+ define_integer(GDK_WINDOW_EDGE_SOUTH_EAST);
+ define_integer(GDK_PIXBUF_ALPHA_BILEVEL);
+ define_integer(GDK_PIXBUF_ALPHA_FULL);
+ define_integer(GDK_COLORSPACE_RGB);
+ define_integer(GDK_PIXBUF_ERROR_CORRUPT_IMAGE);
+ define_integer(GDK_PIXBUF_ERROR_INSUFFICIENT_MEMORY);
+ define_integer(GDK_PIXBUF_ERROR_BAD_OPTION);
+ define_integer(GDK_PIXBUF_ERROR_UNKNOWN_TYPE);
+ define_integer(GDK_PIXBUF_ERROR_UNSUPPORTED_OPERATION);
+ define_integer(GDK_PIXBUF_ERROR_FAILED);
+ define_integer(GDK_INTERP_NEAREST);
+ define_integer(GDK_INTERP_TILES);
+ define_integer(GDK_INTERP_BILINEAR);
+ define_integer(GDK_INTERP_HYPER);
+ define_integer(GTK_ACCEL_VISIBLE);
+ define_integer(GTK_ACCEL_LOCKED);
+ define_integer(GTK_ACCEL_MASK);
+ define_integer(GTK_CALENDAR_SHOW_HEADING);
+ define_integer(GTK_CALENDAR_SHOW_DAY_NAMES);
+ define_integer(GTK_CALENDAR_NO_MONTH_CHANGE);
+ define_integer(GTK_CALENDAR_SHOW_WEEK_NUMBERS);
+ define_integer(GTK_CELL_RENDERER_SELECTED);
+ define_integer(GTK_CELL_RENDERER_PRELIT);
+ define_integer(GTK_CELL_RENDERER_INSENSITIVE);
+ define_integer(GTK_CELL_RENDERER_SORTED);
+ define_integer(GTK_CELL_RENDERER_FOCUSED);
+ define_integer(GTK_DIALOG_MODAL);
+ define_integer(GTK_DIALOG_DESTROY_WITH_PARENT);
+ define_integer(GTK_RESPONSE_NONE);
+ define_integer(GTK_RESPONSE_REJECT);
+ define_integer(GTK_RESPONSE_ACCEPT);
+ define_integer(GTK_RESPONSE_DELETE_EVENT);
+ define_integer(GTK_RESPONSE_OK);
+ define_integer(GTK_RESPONSE_CANCEL);
+ define_integer(GTK_RESPONSE_CLOSE);
+ define_integer(GTK_RESPONSE_YES);
+ define_integer(GTK_RESPONSE_NO);
+ define_integer(GTK_RESPONSE_APPLY);
+ define_integer(GTK_RESPONSE_HELP);
+ define_integer(GTK_DEST_DEFAULT_MOTION);
+ define_integer(GTK_DEST_DEFAULT_HIGHLIGHT);
+ define_integer(GTK_DEST_DEFAULT_DROP);
+ define_integer(GTK_DEST_DEFAULT_ALL);
+ define_integer(GTK_BUTTONBOX_SPREAD);
+ define_integer(GTK_BUTTONBOX_EDGE);
+ define_integer(GTK_BUTTONBOX_START);
+ define_integer(GTK_BUTTONBOX_END);
+ define_integer(GTK_BUTTONBOX_CENTER);
+ define_integer(GTK_DELETE_CHARS);
+ define_integer(GTK_DELETE_WORD_ENDS);
+ define_integer(GTK_DELETE_WORDS);
+ define_integer(GTK_DELETE_DISPLAY_LINES);
+ define_integer(GTK_DELETE_DISPLAY_LINE_ENDS);
+ define_integer(GTK_DELETE_PARAGRAPH_ENDS);
+ define_integer(GTK_DELETE_PARAGRAPHS);
+ define_integer(GTK_DELETE_WHITESPACE);
+ define_integer(GTK_DIR_TAB_FORWARD);
+ define_integer(GTK_DIR_TAB_BACKWARD);
+ define_integer(GTK_DIR_UP);
+ define_integer(GTK_DIR_DOWN);
+ define_integer(GTK_DIR_LEFT);
+ define_integer(GTK_DIR_RIGHT);
+ define_integer(GTK_TEXT_DIR_NONE);
+ define_integer(GTK_TEXT_DIR_LTR);
+ define_integer(GTK_TEXT_DIR_RTL);
+ define_integer(GTK_JUSTIFY_LEFT);
+ define_integer(GTK_JUSTIFY_RIGHT);
+ define_integer(GTK_JUSTIFY_CENTER);
+ define_integer(GTK_JUSTIFY_FILL);
+ define_integer(GTK_MENU_DIR_PARENT);
+ define_integer(GTK_MENU_DIR_CHILD);
+ define_integer(GTK_MENU_DIR_NEXT);
+ define_integer(GTK_MENU_DIR_PREV);
+ define_integer(GTK_MOVEMENT_LOGICAL_POSITIONS);
+ define_integer(GTK_MOVEMENT_VISUAL_POSITIONS);
+ define_integer(GTK_MOVEMENT_WORDS);
+ define_integer(GTK_MOVEMENT_DISPLAY_LINES);
+ define_integer(GTK_MOVEMENT_DISPLAY_LINE_ENDS);
+ define_integer(GTK_MOVEMENT_PARAGRAPHS);
+ define_integer(GTK_MOVEMENT_PARAGRAPH_ENDS);
+ define_integer(GTK_MOVEMENT_PAGES);
+ define_integer(GTK_MOVEMENT_BUFFER_ENDS);
+ define_integer(GTK_ORIENTATION_HORIZONTAL);
+ define_integer(GTK_ORIENTATION_VERTICAL);
+ define_integer(GTK_CORNER_TOP_LEFT);
+ define_integer(GTK_CORNER_BOTTOM_LEFT);
+ define_integer(GTK_CORNER_TOP_RIGHT);
+ define_integer(GTK_CORNER_BOTTOM_RIGHT);
+ define_integer(GTK_PACK_START);
+ define_integer(GTK_PACK_END);
+ define_integer(GTK_POLICY_ALWAYS);
+ define_integer(GTK_POLICY_AUTOMATIC);
+ define_integer(GTK_POLICY_NEVER);
+ define_integer(GTK_POS_LEFT);
+ define_integer(GTK_POS_RIGHT);
+ define_integer(GTK_POS_TOP);
+ define_integer(GTK_POS_BOTTOM);
+ define_integer(GTK_RELIEF_NORMAL);
+ define_integer(GTK_RELIEF_HALF);
+ define_integer(GTK_RELIEF_NONE);
+ define_integer(GTK_RESIZE_PARENT);
+ define_integer(GTK_RESIZE_QUEUE);
+ define_integer(GTK_RESIZE_IMMEDIATE);
+ define_integer(GTK_SCROLL_NONE);
+ define_integer(GTK_SCROLL_JUMP);
+ define_integer(GTK_SCROLL_STEP_BACKWARD);
+ define_integer(GTK_SCROLL_STEP_FORWARD);
+ define_integer(GTK_SCROLL_PAGE_BACKWARD);
+ define_integer(GTK_SCROLL_PAGE_FORWARD);
+ define_integer(GTK_SCROLL_STEP_UP);
+ define_integer(GTK_SCROLL_STEP_DOWN);
+ define_integer(GTK_SCROLL_PAGE_UP);
+ define_integer(GTK_SCROLL_PAGE_DOWN);
+ define_integer(GTK_SCROLL_STEP_LEFT);
+ define_integer(GTK_SCROLL_STEP_RIGHT);
+ define_integer(GTK_SCROLL_PAGE_LEFT);
+ define_integer(GTK_SCROLL_PAGE_RIGHT);
+ define_integer(GTK_SCROLL_START);
+ define_integer(GTK_SCROLL_END);
+ define_integer(GTK_SELECTION_NONE);
+ define_integer(GTK_SELECTION_SINGLE);
+ define_integer(GTK_SELECTION_BROWSE);
+ define_integer(GTK_SELECTION_MULTIPLE);
+ define_integer(GTK_SHADOW_NONE);
+ define_integer(GTK_SHADOW_IN);
+ define_integer(GTK_SHADOW_OUT);
+ define_integer(GTK_SHADOW_ETCHED_IN);
+ define_integer(GTK_SHADOW_ETCHED_OUT);
+ define_integer(GTK_TOOLBAR_ICONS);
+ define_integer(GTK_TOOLBAR_TEXT);
+ define_integer(GTK_TOOLBAR_BOTH);
+ define_integer(GTK_TOOLBAR_BOTH_HORIZ);
+ define_integer(GTK_WIN_POS_NONE);
+ define_integer(GTK_WIN_POS_CENTER);
+ define_integer(GTK_WIN_POS_MOUSE);
+ define_integer(GTK_WIN_POS_CENTER_ALWAYS);
+ define_integer(GTK_WIN_POS_CENTER_ON_PARENT);
+ define_integer(GTK_WINDOW_TOPLEVEL);
+ define_integer(GTK_WINDOW_POPUP);
+ define_integer(GTK_WRAP_NONE);
+ define_integer(GTK_WRAP_CHAR);
+ define_integer(GTK_WRAP_WORD);
+ define_integer(GTK_SORT_ASCENDING);
+ define_integer(GTK_SORT_DESCENDING);
+ define_integer(GTK_IMAGE_EMPTY);
+ define_integer(GTK_IMAGE_PIXBUF);
+ define_integer(GTK_IMAGE_STOCK);
+ define_integer(GTK_IMAGE_ICON_SET);
+ define_integer(GTK_IMAGE_ANIMATION);
+ define_integer(GTK_MAX_COMPOSE_LEN);
+ define_integer(GTK_PRIORITY_RESIZE);
+ define_integer(GTK_MESSAGE_INFO);
+ define_integer(GTK_MESSAGE_WARNING);
+ define_integer(GTK_MESSAGE_QUESTION);
+ define_integer(GTK_MESSAGE_ERROR);
+ define_integer(GTK_BUTTONS_NONE);
+ define_integer(GTK_BUTTONS_OK);
+ define_integer(GTK_BUTTONS_CLOSE);
+ define_integer(GTK_BUTTONS_CANCEL);
+ define_integer(GTK_BUTTONS_YES_NO);
+ define_integer(GTK_BUTTONS_OK_CANCEL);
+ define_integer(GTK_NOTEBOOK_TAB_FIRST);
+ define_integer(GTK_NOTEBOOK_TAB_LAST);
+ define_integer(GTK_SIZE_GROUP_NONE);
+ define_integer(GTK_SIZE_GROUP_HORIZONTAL);
+ define_integer(GTK_SIZE_GROUP_VERTICAL);
+ define_integer(GTK_SIZE_GROUP_BOTH);
+ define_integer(GTK_INPUT_ERROR);
+ define_integer(GTK_UPDATE_ALWAYS);
+ define_integer(GTK_UPDATE_IF_VALID);
+ define_integer(GTK_SPIN_STEP_FORWARD);
+ define_integer(GTK_SPIN_STEP_BACKWARD);
+ define_integer(GTK_SPIN_PAGE_FORWARD);
+ define_integer(GTK_SPIN_PAGE_BACKWARD);
+ define_integer(GTK_SPIN_HOME);
+ define_integer(GTK_SPIN_END);
+ define_integer(GTK_SPIN_USER_DEFINED);
+ define_integer(GTK_TEXT_SEARCH_VISIBLE_ONLY);
+ define_integer(GTK_TEXT_SEARCH_TEXT_ONLY);
+ define_integer(GTK_TEXT_WINDOW_PRIVATE);
+ define_integer(GTK_TEXT_WINDOW_WIDGET);
+ define_integer(GTK_TEXT_WINDOW_TEXT);
+ define_integer(GTK_TEXT_WINDOW_LEFT);
+ define_integer(GTK_TEXT_WINDOW_RIGHT);
+ define_integer(GTK_TEXT_WINDOW_TOP);
+ define_integer(GTK_TEXT_WINDOW_BOTTOM);
+ define_integer(GTK_TEXT_VIEW_PRIORITY_VALIDATE);
+ define_integer(GTK_TREE_MODEL_ITERS_PERSIST);
+ define_integer(GTK_TREE_MODEL_LIST_ONLY);
+ define_integer(GTK_TREE_VIEW_COLUMN_GROW_ONLY);
+ define_integer(GTK_TREE_VIEW_COLUMN_AUTOSIZE);
+ define_integer(GTK_TREE_VIEW_COLUMN_FIXED);
+ define_integer(GTK_TREE_VIEW_DROP_BEFORE);
+ define_integer(GTK_TREE_VIEW_DROP_AFTER);
+ define_integer(GTK_TREE_VIEW_DROP_INTO_OR_BEFORE);
+ define_integer(GTK_TREE_VIEW_DROP_INTO_OR_AFTER);
+ define_integer(PANGO_ATTR_INVALID);
+ define_integer(PANGO_ATTR_LANGUAGE);
+ define_integer(PANGO_ATTR_FAMILY);
+ define_integer(PANGO_ATTR_STYLE);
+ define_integer(PANGO_ATTR_WEIGHT);
+ define_integer(PANGO_ATTR_VARIANT);
+ define_integer(PANGO_ATTR_STRETCH);
+ define_integer(PANGO_ATTR_SIZE);
+ define_integer(PANGO_ATTR_FONT_DESC);
+ define_integer(PANGO_ATTR_FOREGROUND);
+ define_integer(PANGO_ATTR_BACKGROUND);
+ define_integer(PANGO_ATTR_UNDERLINE);
+ define_integer(PANGO_ATTR_STRIKETHROUGH);
+ define_integer(PANGO_ATTR_RISE);
+ define_integer(PANGO_ATTR_SHAPE);
+ define_integer(PANGO_ATTR_SCALE);
+ define_integer(PANGO_UNDERLINE_NONE);
+ define_integer(PANGO_UNDERLINE_SINGLE);
+ define_integer(PANGO_UNDERLINE_DOUBLE);
+ define_integer(PANGO_UNDERLINE_LOW);
+ define_integer(PANGO_COVERAGE_NONE);
+ define_integer(PANGO_COVERAGE_FALLBACK);
+ define_integer(PANGO_COVERAGE_APPROXIMATE);
+ define_integer(PANGO_COVERAGE_EXACT);
+ define_integer(PANGO_STYLE_NORMAL);
+ define_integer(PANGO_STYLE_OBLIQUE);
+ define_integer(PANGO_STYLE_ITALIC);
+ define_integer(PANGO_VARIANT_NORMAL);
+ define_integer(PANGO_VARIANT_SMALL_CAPS);
+ define_integer(PANGO_WEIGHT_ULTRALIGHT);
+ define_integer(PANGO_WEIGHT_LIGHT);
+ define_integer(PANGO_WEIGHT_NORMAL);
+ define_integer(PANGO_WEIGHT_BOLD);
+ define_integer(PANGO_WEIGHT_ULTRABOLD);
+ define_integer(PANGO_WEIGHT_HEAVY);
+ define_integer(PANGO_STRETCH_ULTRA_CONDENSED);
+ define_integer(PANGO_STRETCH_EXTRA_CONDENSED);
+ define_integer(PANGO_STRETCH_CONDENSED);
+ define_integer(PANGO_STRETCH_SEMI_CONDENSED);
+ define_integer(PANGO_STRETCH_NORMAL);
+ define_integer(PANGO_STRETCH_SEMI_EXPANDED);
+ define_integer(PANGO_STRETCH_EXPANDED);
+ define_integer(PANGO_STRETCH_EXTRA_EXPANDED);
+ define_integer(PANGO_STRETCH_ULTRA_EXPANDED);
+ define_integer(PANGO_FONT_MASK_FAMILY);
+ define_integer(PANGO_FONT_MASK_STYLE);
+ define_integer(PANGO_FONT_MASK_VARIANT);
+ define_integer(PANGO_FONT_MASK_WEIGHT);
+ define_integer(PANGO_FONT_MASK_STRETCH);
+ define_integer(PANGO_FONT_MASK_SIZE);
+ define_integer(PANGO_ALIGN_LEFT);
+ define_integer(PANGO_ALIGN_CENTER);
+ define_integer(PANGO_ALIGN_RIGHT);
+ define_integer(PANGO_WRAP_WORD);
+ define_integer(PANGO_WRAP_CHAR);
+ define_integer(PANGO_DIRECTION_LTR);
+ define_integer(PANGO_DIRECTION_RTL);
+ define_integer(PANGO_DIRECTION_TTB_LTR);
+ define_integer(PANGO_DIRECTION_TTB_RTL);
+ define_integer(GDK_WINDOW_STATE_FULLSCREEN);
+ define_integer(GDK_WINDOW_STATE_ABOVE);
+ define_integer(GDK_WINDOW_STATE_BELOW);
+ define_integer(GTK_MOVEMENT_HORIZONTAL_PAGES);
+ define_integer(GTK_SCROLL_STEPS);
+ define_integer(GTK_SCROLL_PAGES);
+ define_integer(GTK_SCROLL_ENDS);
+ define_integer(GTK_SCROLL_HORIZONTAL_STEPS);
+ define_integer(GTK_SCROLL_HORIZONTAL_PAGES);
+ define_integer(GTK_SCROLL_HORIZONTAL_ENDS);
+ define_integer(GTK_WRAP_WORD_CHAR);
+ define_integer(GTK_FILE_FILTER_FILENAME);
+ define_integer(GTK_FILE_FILTER_URI);
+ define_integer(GTK_FILE_FILTER_DISPLAY_NAME);
+ define_integer(GTK_FILE_FILTER_MIME_TYPE);
+ define_integer(GTK_ICON_LOOKUP_NO_SVG);
+ define_integer(GTK_ICON_LOOKUP_FORCE_SVG);
+ define_integer(GTK_ICON_LOOKUP_USE_BUILTIN);
+ define_integer(GTK_ICON_LOOKUP_GENERIC_FALLBACK);
+ define_integer(GTK_FILE_CHOOSER_ACTION_OPEN);
+ define_integer(GTK_FILE_CHOOSER_ACTION_SAVE);
+ define_integer(GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER);
+ define_integer(GTK_FILE_CHOOSER_ACTION_CREATE_FOLDER);
+ define_integer(G_PRIORITY_HIGH);
+ define_integer(G_PRIORITY_DEFAULT);
+ define_integer(G_PRIORITY_HIGH_IDLE);
+ define_integer(G_PRIORITY_DEFAULT_IDLE);
+ define_integer(G_PRIORITY_LOW);
+ define_integer(PANGO_ATTR_FALLBACK);
+ define_integer(PANGO_ATTR_LETTER_SPACING);
+ define_integer(PANGO_UNDERLINE_ERROR);
+ define_integer(PANGO_WRAP_WORD_CHAR);
+ define_integer(PANGO_ELLIPSIZE_NONE);
+ define_integer(PANGO_ELLIPSIZE_START);
+ define_integer(PANGO_ELLIPSIZE_MIDDLE);
+ define_integer(PANGO_ELLIPSIZE_END);
+ define_integer(PANGO_SCRIPT_INVALID_CODE);
+ define_integer(PANGO_SCRIPT_COMMON);
+ define_integer(PANGO_SCRIPT_INHERITED);
+ define_integer(PANGO_SCRIPT_ARABIC);
+ define_integer(PANGO_SCRIPT_ARMENIAN);
+ define_integer(PANGO_SCRIPT_BENGALI);
+ define_integer(PANGO_SCRIPT_BOPOMOFO);
+ define_integer(PANGO_SCRIPT_CHEROKEE);
+ define_integer(PANGO_SCRIPT_COPTIC);
+ define_integer(PANGO_SCRIPT_CYRILLIC);
+ define_integer(PANGO_SCRIPT_DESERET);
+ define_integer(PANGO_SCRIPT_DEVANAGARI);
+ define_integer(PANGO_SCRIPT_ETHIOPIC);
+ define_integer(PANGO_SCRIPT_GEORGIAN);
+ define_integer(PANGO_SCRIPT_GOTHIC);
+ define_integer(PANGO_SCRIPT_GREEK);
+ define_integer(PANGO_SCRIPT_GUJARATI);
+ define_integer(PANGO_SCRIPT_GURMUKHI);
+ define_integer(PANGO_SCRIPT_HAN);
+ define_integer(PANGO_SCRIPT_HANGUL);
+ define_integer(PANGO_SCRIPT_HEBREW);
+ define_integer(PANGO_SCRIPT_HIRAGANA);
+ define_integer(PANGO_SCRIPT_KANNADA);
+ define_integer(PANGO_SCRIPT_KATAKANA);
+ define_integer(PANGO_SCRIPT_KHMER);
+ define_integer(PANGO_SCRIPT_LAO);
+ define_integer(PANGO_SCRIPT_LATIN);
+ define_integer(PANGO_SCRIPT_MALAYALAM);
+ define_integer(PANGO_SCRIPT_MONGOLIAN);
+ define_integer(PANGO_SCRIPT_MYANMAR);
+ define_integer(PANGO_SCRIPT_OGHAM);
+ define_integer(PANGO_SCRIPT_OLD_ITALIC);
+ define_integer(PANGO_SCRIPT_ORIYA);
+ define_integer(PANGO_SCRIPT_RUNIC);
+ define_integer(PANGO_SCRIPT_SINHALA);
+ define_integer(PANGO_SCRIPT_SYRIAC);
+ define_integer(PANGO_SCRIPT_TAMIL);
+ define_integer(PANGO_SCRIPT_TELUGU);
+ define_integer(PANGO_SCRIPT_THAANA);
+ define_integer(PANGO_SCRIPT_THAI);
+ define_integer(PANGO_SCRIPT_TIBETAN);
+ define_integer(PANGO_SCRIPT_CANADIAN_ABORIGINAL);
+ define_integer(PANGO_SCRIPT_YI);
+ define_integer(PANGO_SCRIPT_TAGALOG);
+ define_integer(PANGO_SCRIPT_HANUNOO);
+ define_integer(PANGO_SCRIPT_BUHID);
+ define_integer(PANGO_SCRIPT_TAGBANWA);
+ define_integer(PANGO_SCRIPT_BRAILLE);
+ define_integer(PANGO_SCRIPT_CYPRIOT);
+ define_integer(PANGO_SCRIPT_LIMBU);
+ define_integer(PANGO_SCRIPT_OSMANYA);
+ define_integer(PANGO_SCRIPT_SHAVIAN);
+ define_integer(PANGO_SCRIPT_LINEAR_B);
+ define_integer(PANGO_SCRIPT_TAI_LE);
+ define_integer(PANGO_SCRIPT_UGARITIC);
+ define_integer(PANGO_TAB_LEFT);
+ define_integer(PANGO_DIRECTION_WEAK_LTR);
+ define_integer(PANGO_DIRECTION_WEAK_RTL);
+ define_integer(PANGO_DIRECTION_NEUTRAL);
+ define_integer(GTK_TREE_SORTABLE_DEFAULT_SORT_COLUMN_ID);
+ define_integer(GTK_TREE_SORTABLE_UNSORTED_SORT_COLUMN_ID);
+ define_integer(GTK_IMAGE_ICON_NAME);
+ define_integer(PANGO_ATTR_UNDERLINE_COLOR);
+ define_integer(PANGO_ATTR_STRIKETHROUGH_COLOR);
+ define_integer(PANGO_RENDER_PART_FOREGROUND);
+ define_integer(PANGO_RENDER_PART_BACKGROUND);
+ define_integer(PANGO_RENDER_PART_UNDERLINE);
+ define_integer(PANGO_RENDER_PART_STRIKETHROUGH);
+ define_integer(G_LOG_FLAG_RECURSION);
+ define_integer(G_LOG_FLAG_FATAL);
+ define_integer(G_LOG_LEVEL_ERROR);
+ define_integer(G_LOG_LEVEL_CRITICAL);
+ define_integer(G_LOG_LEVEL_WARNING);
+ define_integer(G_LOG_LEVEL_MESSAGE);
+ define_integer(G_LOG_LEVEL_INFO);
+ define_integer(G_LOG_LEVEL_DEBUG);
+ define_integer(G_LOG_LEVEL_MASK);
+ define_integer(G_LOG_FATAL_MASK);
+ define_integer(PANGO_WEIGHT_SEMIBOLD);
+ define_integer(GTK_PACK_DIRECTION_LTR);
+ define_integer(GTK_PACK_DIRECTION_RTL);
+ define_integer(GTK_PACK_DIRECTION_TTB);
+ define_integer(GTK_PACK_DIRECTION_BTT);
+ define_integer(GTK_ICON_VIEW_NO_DROP);
+ define_integer(GTK_ICON_VIEW_DROP_INTO);
+ define_integer(GTK_ICON_VIEW_DROP_LEFT);
+ define_integer(GTK_ICON_VIEW_DROP_RIGHT);
+ define_integer(GTK_ICON_VIEW_DROP_ABOVE);
+ define_integer(GTK_ICON_VIEW_DROP_BELOW);
+ define_integer(GTK_FILE_CHOOSER_CONFIRMATION_CONFIRM);
+ define_integer(GTK_FILE_CHOOSER_CONFIRMATION_ACCEPT_FILENAME);
+ define_integer(GTK_FILE_CHOOSER_CONFIRMATION_SELECT_AGAIN);
+ define_integer(PANGO_SCRIPT_NEW_TAI_LUE);
+ define_integer(PANGO_SCRIPT_BUGINESE);
+ define_integer(PANGO_SCRIPT_GLAGOLITIC);
+ define_integer(PANGO_SCRIPT_TIFINAGH);
+ define_integer(PANGO_SCRIPT_SYLOTI_NAGRI);
+ define_integer(PANGO_SCRIPT_OLD_PERSIAN);
+ define_integer(PANGO_SCRIPT_KHAROSHTHI);
+ define_integer(GDK_SUPER_MASK);
+ define_integer(GDK_HYPER_MASK);
+ define_integer(GDK_META_MASK);
+ define_integer(GTK_SENSITIVITY_AUTO);
+ define_integer(GTK_SENSITIVITY_ON);
+ define_integer(GTK_SENSITIVITY_OFF);
+ define_integer(GTK_TEXT_BUFFER_TARGET_INFO_BUFFER_CONTENTS);
+ define_integer(GTK_TEXT_BUFFER_TARGET_INFO_RICH_TEXT);
+ define_integer(GTK_TEXT_BUFFER_TARGET_INFO_TEXT);
+ define_integer(GTK_ASSISTANT_PAGE_CONTENT);
+ define_integer(GTK_ASSISTANT_PAGE_INTRO);
+ define_integer(GTK_ASSISTANT_PAGE_CONFIRM);
+ define_integer(GTK_ASSISTANT_PAGE_SUMMARY);
+ define_integer(GTK_ASSISTANT_PAGE_PROGRESS);
+ define_integer(GTK_CELL_RENDERER_ACCEL_MODE_GTK);
+ define_integer(GTK_CELL_RENDERER_ACCEL_MODE_OTHER);
+ define_integer(GTK_RECENT_SORT_NONE);
+ define_integer(GTK_RECENT_SORT_MRU);
+ define_integer(GTK_RECENT_SORT_LRU);
+ define_integer(GTK_RECENT_SORT_CUSTOM);
+ define_integer(GTK_RECENT_CHOOSER_ERROR_NOT_FOUND);
+ define_integer(GTK_RECENT_CHOOSER_ERROR_INVALID_URI);
+ define_integer(GTK_RECENT_MANAGER_ERROR_NOT_FOUND);
+ define_integer(GTK_RECENT_MANAGER_ERROR_INVALID_URI);
+ define_integer(GTK_RECENT_MANAGER_ERROR_INVALID_ENCODING);
+ define_integer(GTK_RECENT_MANAGER_ERROR_NOT_REGISTERED);
+ define_integer(GTK_RECENT_MANAGER_ERROR_READ);
+ define_integer(GTK_RECENT_MANAGER_ERROR_WRITE);
+ define_integer(GTK_RECENT_MANAGER_ERROR_UNKNOWN);
+ define_integer(GTK_MESSAGE_OTHER);
+ define_integer(GTK_TREE_VIEW_GRID_LINES_NONE);
+ define_integer(GTK_TREE_VIEW_GRID_LINES_HORIZONTAL);
+ define_integer(GTK_TREE_VIEW_GRID_LINES_VERTICAL);
+ define_integer(GTK_TREE_VIEW_GRID_LINES_BOTH);
+ define_integer(GTK_PRINT_STATUS_INITIAL);
+ define_integer(GTK_PRINT_STATUS_PREPARING);
+ define_integer(GTK_PRINT_STATUS_GENERATING_DATA);
+ define_integer(GTK_PRINT_STATUS_SENDING_DATA);
+ define_integer(GTK_PRINT_STATUS_PENDING);
+ define_integer(GTK_PRINT_STATUS_PENDING_ISSUE);
+ define_integer(GTK_PRINT_STATUS_PRINTING);
+ define_integer(GTK_PRINT_STATUS_FINISHED);
+ define_integer(GTK_PRINT_STATUS_FINISHED_ABORTED);
+ define_integer(GTK_PRINT_OPERATION_RESULT_ERROR);
+ define_integer(GTK_PRINT_OPERATION_RESULT_APPLY);
+ define_integer(GTK_PRINT_OPERATION_RESULT_CANCEL);
+ define_integer(GTK_PRINT_OPERATION_RESULT_IN_PROGRESS);
+ define_integer(GTK_PRINT_OPERATION_ACTION_PRINT_DIALOG);
+ define_integer(GTK_PRINT_OPERATION_ACTION_PRINT);
+ define_integer(GTK_PRINT_OPERATION_ACTION_PREVIEW);
+ define_integer(GTK_PRINT_OPERATION_ACTION_EXPORT);
+ define_integer(GTK_PRINT_ERROR_GENERAL);
+ define_integer(GTK_PRINT_ERROR_INTERNAL_ERROR);
+ define_integer(GTK_PRINT_ERROR_NOMEM);
+ define_integer(GTK_PRINT_ERROR_INVALID_FILE);
+ define_integer(GTK_DRAG_RESULT_SUCCESS);
+ define_integer(GTK_DRAG_RESULT_NO_TARGET);
+ define_integer(GTK_DRAG_RESULT_USER_CANCELLED);
+ define_integer(GTK_DRAG_RESULT_TIMEOUT_EXPIRED);
+ define_integer(GTK_DRAG_RESULT_GRAB_BROKEN);
+ define_integer(GTK_DRAG_RESULT_ERROR);
+#if GTK_CHECK_VERSION(2, 14, 0)
+ define_integer(GTK_CALENDAR_SHOW_DETAILS);
+ define_integer(GDK_CROSSING_GTK_GRAB);
+ define_integer(GDK_CROSSING_GTK_UNGRAB);
+ define_integer(GDK_CROSSING_STATE_CHANGED);
+#endif
+
+#if GTK_CHECK_VERSION(2, 16, 0)
+ define_integer(GTK_ENTRY_ICON_PRIMARY);
+ define_integer(GTK_ENTRY_ICON_SECONDARY);
+ define_integer(GDK_BLANK_CURSOR );
+#endif
+
+#if GTK_CHECK_VERSION(2, 18, 0)
+ define_integer(PANGO_WEIGHT_THIN);
+ define_integer(PANGO_WEIGHT_BOOK);
+ define_integer(PANGO_WEIGHT_MEDIUM);
+ define_integer(GDK_WINDOW_OFFSCREEN);
+ define_integer(GTK_ENTRY_BUFFER_MAX_SIZE);
+#endif
+
+#if GTK_CHECK_VERSION(3, 0, 0)
+ define_integer(GDK_KEY_VoidSymbol);
+ define_integer(GDK_KEY_BackSpace);
+ define_integer(GDK_KEY_Tab);
+ define_integer(GDK_KEY_Linefeed);
+ define_integer(GDK_KEY_Clear);
+ define_integer(GDK_KEY_Return);
+ define_integer(GDK_KEY_Pause);
+ define_integer(GDK_KEY_Scroll_Lock);
+ define_integer(GDK_KEY_Sys_Req);
+ define_integer(GDK_KEY_Escape);
+ define_integer(GDK_KEY_Delete);
+ define_integer(GDK_KEY_Home);
+ define_integer(GDK_KEY_Left);
+ define_integer(GDK_KEY_Up);
+ define_integer(GDK_KEY_Right);
+ define_integer(GDK_KEY_Down);
+ define_integer(GDK_KEY_Prior);
+ define_integer(GDK_KEY_Page_Up);
+ define_integer(GDK_KEY_Next);
+ define_integer(GDK_KEY_Page_Down);
+ define_integer(GDK_KEY_End);
+ define_integer(GDK_KEY_Begin);
+ define_integer(GDK_KEY_Select);
+ define_integer(GDK_KEY_Print);
+ define_integer(GDK_KEY_Execute);
+ define_integer(GDK_KEY_Insert);
+ define_integer(GDK_KEY_Undo);
+ define_integer(GDK_KEY_Redo);
+ define_integer(GDK_KEY_Menu);
+ define_integer(GDK_KEY_Find);
+ define_integer(GDK_KEY_Cancel);
+ define_integer(GDK_KEY_Help);
+ define_integer(GDK_KEY_Break);
+ define_integer(GDK_KEY_Mode_switch);
+ define_integer(GDK_KEY_script_switch);
+ define_integer(GDK_KEY_Num_Lock);
+ define_integer(GDK_KEY_KP_Space);
+ define_integer(GDK_KEY_KP_Tab);
+ define_integer(GDK_KEY_KP_Enter);
+ define_integer(GDK_KEY_KP_F1);
+ define_integer(GDK_KEY_KP_F2);
+ define_integer(GDK_KEY_KP_F3);
+ define_integer(GDK_KEY_KP_F4);
+ define_integer(GDK_KEY_KP_Home);
+ define_integer(GDK_KEY_KP_Left);
+ define_integer(GDK_KEY_KP_Up);
+ define_integer(GDK_KEY_KP_Right);
+ define_integer(GDK_KEY_KP_Down);
+ define_integer(GDK_KEY_KP_Prior);
+ define_integer(GDK_KEY_KP_Page_Up);
+ define_integer(GDK_KEY_KP_Next);
+ define_integer(GDK_KEY_KP_Page_Down);
+ define_integer(GDK_KEY_KP_End);
+ define_integer(GDK_KEY_KP_Begin);
+ define_integer(GDK_KEY_KP_Insert);
+ define_integer(GDK_KEY_KP_Delete);
+ define_integer(GDK_KEY_KP_Equal);
+ define_integer(GDK_KEY_KP_Multiply);
+ define_integer(GDK_KEY_KP_Add);
+ define_integer(GDK_KEY_KP_Separator);
+ define_integer(GDK_KEY_KP_Subtract);
+ define_integer(GDK_KEY_KP_Decimal);
+ define_integer(GDK_KEY_KP_Divide);
+ define_integer(GDK_KEY_KP_0);
+ define_integer(GDK_KEY_KP_1);
+ define_integer(GDK_KEY_KP_2);
+ define_integer(GDK_KEY_KP_3);
+ define_integer(GDK_KEY_KP_4);
+ define_integer(GDK_KEY_KP_5);
+ define_integer(GDK_KEY_KP_6);
+ define_integer(GDK_KEY_KP_7);
+ define_integer(GDK_KEY_KP_8);
+ define_integer(GDK_KEY_KP_9);
+ define_integer(GDK_KEY_F1);
+ define_integer(GDK_KEY_F2);
+ define_integer(GDK_KEY_F3);
+ define_integer(GDK_KEY_F4);
+ define_integer(GDK_KEY_F5);
+ define_integer(GDK_KEY_F6);
+ define_integer(GDK_KEY_F7);
+ define_integer(GDK_KEY_F8);
+ define_integer(GDK_KEY_F9);
+ define_integer(GDK_KEY_F10);
+ define_integer(GDK_KEY_F11);
+ define_integer(GDK_KEY_L1);
+ define_integer(GDK_KEY_F12);
+ define_integer(GDK_KEY_L2);
+ define_integer(GDK_KEY_F13);
+ define_integer(GDK_KEY_L3);
+ define_integer(GDK_KEY_F14);
+ define_integer(GDK_KEY_L4);
+ define_integer(GDK_KEY_F15);
+ define_integer(GDK_KEY_L5);
+ define_integer(GDK_KEY_F16);
+ define_integer(GDK_KEY_L6);
+ define_integer(GDK_KEY_F17);
+ define_integer(GDK_KEY_L7);
+ define_integer(GDK_KEY_F18);
+ define_integer(GDK_KEY_L8);
+ define_integer(GDK_KEY_F19);
+ define_integer(GDK_KEY_L9);
+ define_integer(GDK_KEY_F20);
+ define_integer(GDK_KEY_L10);
+ define_integer(GDK_KEY_F21);
+ define_integer(GDK_KEY_R1);
+ define_integer(GDK_KEY_F22);
+ define_integer(GDK_KEY_R2);
+ define_integer(GDK_KEY_F23);
+ define_integer(GDK_KEY_R3);
+ define_integer(GDK_KEY_F24);
+ define_integer(GDK_KEY_R4);
+ define_integer(GDK_KEY_F25);
+ define_integer(GDK_KEY_R5);
+ define_integer(GDK_KEY_F26);
+ define_integer(GDK_KEY_R6);
+ define_integer(GDK_KEY_F27);
+ define_integer(GDK_KEY_R7);
+ define_integer(GDK_KEY_F28);
+ define_integer(GDK_KEY_R8);
+ define_integer(GDK_KEY_F29);
+ define_integer(GDK_KEY_R9);
+ define_integer(GDK_KEY_F30);
+ define_integer(GDK_KEY_R10);
+ define_integer(GDK_KEY_F31);
+ define_integer(GDK_KEY_R11);
+ define_integer(GDK_KEY_F32);
+ define_integer(GDK_KEY_R12);
+ define_integer(GDK_KEY_F33);
+ define_integer(GDK_KEY_R13);
+ define_integer(GDK_KEY_F34);
+ define_integer(GDK_KEY_R14);
+ define_integer(GDK_KEY_F35);
+ define_integer(GDK_KEY_R15);
+ define_integer(GDK_KEY_Shift_L);
+ define_integer(GDK_KEY_Shift_R);
+ define_integer(GDK_KEY_Control_L);
+ define_integer(GDK_KEY_Control_R);
+ define_integer(GDK_KEY_Caps_Lock);
+ define_integer(GDK_KEY_Shift_Lock);
+ define_integer(GDK_KEY_Meta_L);
+ define_integer(GDK_KEY_Meta_R);
+ define_integer(GDK_KEY_Alt_L);
+ define_integer(GDK_KEY_Alt_R);
+ define_integer(GDK_KEY_space);
+ define_integer(GDK_KEY_exclam);
+ define_integer(GDK_KEY_quotedbl);
+ define_integer(GDK_KEY_numbersign);
+ define_integer(GDK_KEY_dollar);
+ define_integer(GDK_KEY_percent);
+ define_integer(GDK_KEY_ampersand);
+ define_integer(GDK_KEY_apostrophe);
+ define_integer(GDK_KEY_quoteright);
+ define_integer(GDK_KEY_parenleft);
+ define_integer(GDK_KEY_parenright);
+ define_integer(GDK_KEY_asterisk);
+ define_integer(GDK_KEY_plus);
+ define_integer(GDK_KEY_comma);
+ define_integer(GDK_KEY_minus);
+ define_integer(GDK_KEY_period);
+ define_integer(GDK_KEY_slash);
+ define_integer(GDK_KEY_0);
+ define_integer(GDK_KEY_1);
+ define_integer(GDK_KEY_2);
+ define_integer(GDK_KEY_3);
+ define_integer(GDK_KEY_4);
+ define_integer(GDK_KEY_5);
+ define_integer(GDK_KEY_6);
+ define_integer(GDK_KEY_7);
+ define_integer(GDK_KEY_8);
+ define_integer(GDK_KEY_9);
+ define_integer(GDK_KEY_colon);
+ define_integer(GDK_KEY_semicolon);
+ define_integer(GDK_KEY_less);
+ define_integer(GDK_KEY_equal);
+ define_integer(GDK_KEY_greater);
+ define_integer(GDK_KEY_question);
+ define_integer(GDK_KEY_at);
+ define_integer(GDK_KEY_A);
+ define_integer(GDK_KEY_B);
+ define_integer(GDK_KEY_C);
+ define_integer(GDK_KEY_D);
+ define_integer(GDK_KEY_E);
+ define_integer(GDK_KEY_F);
+ define_integer(GDK_KEY_G);
+ define_integer(GDK_KEY_H);
+ define_integer(GDK_KEY_I);
+ define_integer(GDK_KEY_J);
+ define_integer(GDK_KEY_K);
+ define_integer(GDK_KEY_L);
+ define_integer(GDK_KEY_M);
+ define_integer(GDK_KEY_N);
+ define_integer(GDK_KEY_O);
+ define_integer(GDK_KEY_P);
+ define_integer(GDK_KEY_Q);
+ define_integer(GDK_KEY_R);
+ define_integer(GDK_KEY_S);
+ define_integer(GDK_KEY_T);
+ define_integer(GDK_KEY_U);
+ define_integer(GDK_KEY_V);
+ define_integer(GDK_KEY_W);
+ define_integer(GDK_KEY_X);
+ define_integer(GDK_KEY_Y);
+ define_integer(GDK_KEY_Z);
+ define_integer(GDK_KEY_bracketleft);
+ define_integer(GDK_KEY_backslash);
+ define_integer(GDK_KEY_bracketright);
+ define_integer(GDK_KEY_asciicircum);
+ define_integer(GDK_KEY_underscore);
+ define_integer(GDK_KEY_grave);
+ define_integer(GDK_KEY_quoteleft);
+ define_integer(GDK_KEY_a);
+ define_integer(GDK_KEY_b);
+ define_integer(GDK_KEY_c);
+ define_integer(GDK_KEY_d);
+ define_integer(GDK_KEY_e);
+ define_integer(GDK_KEY_f);
+ define_integer(GDK_KEY_g);
+ define_integer(GDK_KEY_h);
+ define_integer(GDK_KEY_i);
+ define_integer(GDK_KEY_j);
+ define_integer(GDK_KEY_k);
+ define_integer(GDK_KEY_l);
+ define_integer(GDK_KEY_m);
+ define_integer(GDK_KEY_n);
+ define_integer(GDK_KEY_o);
+ define_integer(GDK_KEY_p);
+ define_integer(GDK_KEY_q);
+ define_integer(GDK_KEY_r);
+ define_integer(GDK_KEY_s);
+ define_integer(GDK_KEY_t);
+ define_integer(GDK_KEY_u);
+ define_integer(GDK_KEY_v);
+ define_integer(GDK_KEY_w);
+ define_integer(GDK_KEY_x);
+ define_integer(GDK_KEY_y);
+ define_integer(GDK_KEY_z);
+ define_integer(GDK_KEY_braceleft);
+ define_integer(GDK_KEY_bar);
+ define_integer(GDK_KEY_braceright);
+ define_integer(GDK_KEY_asciitilde);
+ define_integer(GTK_SIZE_REQUEST_HEIGHT_FOR_WIDTH);
+ define_integer(GTK_SIZE_REQUEST_WIDTH_FOR_HEIGHT);
+ define_integer(GTK_ASSISTANT_PAGE_CUSTOM);
+ define_integer(GTK_TEXT_SEARCH_CASE_INSENSITIVE);
+ define_integer(GTK_SCROLL_MINIMUM);
+ define_integer(GTK_SCROLL_NATURAL);
+ define_integer(GTK_TARGET_SAME_APP);
+ define_integer(GTK_TARGET_SAME_WIDGET);
+ define_integer(GTK_TARGET_OTHER_APP);
+ define_integer(GTK_TARGET_OTHER_WIDGET);
+ define_integer(GTK_ALIGN_FILL);
+ define_integer(GTK_ALIGN_START);
+ define_integer(GTK_ALIGN_END);
+ define_integer(GTK_ALIGN_CENTER);
+ define_integer(GTK_TOOL_PALETTE_DRAG_ITEMS);
+ define_integer(GTK_TOOL_PALETTE_DRAG_GROUPS);
+ define_integer(GTK_IMAGE_GICON);
+ define_integer(GTK_FILE_CHOOSER_ERROR);
+ define_integer(GTK_FILE_CHOOSER_ERROR_NONEXISTENT);
+ define_integer(GTK_FILE_CHOOSER_ERROR_BAD_FILENAME);
+ define_integer(GTK_FILE_CHOOSER_ERROR_ALREADY_EXISTS);
+ define_integer(GTK_FILE_CHOOSER_ERROR_INCOMPLETE_HOSTNAME);
+ define_integer(GTK_ICON_LOOKUP_FORCE_SIZE);
+ define_integer(GTK_ICON_THEME_NOT_FOUND);
+ define_integer(GTK_ICON_THEME_FAILED);
+ define_integer(GTK_STATE_FLAG_NORMAL);
+ define_integer(GTK_STATE_FLAG_ACTIVE);
+ define_integer(GTK_STATE_FLAG_PRELIGHT);
+ define_integer(GTK_STATE_FLAG_SELECTED);
+ define_integer(GTK_STATE_FLAG_INSENSITIVE);
+ define_integer(GTK_STATE_FLAG_INCONSISTENT);
+ define_integer(GTK_STATE_FLAG_FOCUSED);
+#endif
+
+#if GTK_CHECK_VERSION(3, 2, 0)
+ define_integer(GTK_SIZE_REQUEST_CONSTANT_SIZE);
+#endif
+
+#if GTK_CHECK_VERSION(3, 4, 0)
+ define_integer(GDK_MODIFIER_INTENT_PRIMARY_ACCELERATOR);
+ define_integer(GDK_MODIFIER_INTENT_CONTEXT_MENU);
+ define_integer(GDK_MODIFIER_INTENT_EXTEND_SELECTION);
+ define_integer(GDK_MODIFIER_INTENT_MODIFY_SELECTION);
+ define_integer(GDK_MODIFIER_INTENT_NO_TEXT_INPUT);
+ define_integer(GDK_MODIFIER_INTENT_SHIFT_GROUP);
+ define_integer(GTK_REGION_ONLY);
+ define_integer(GDK_WINDOW_STATE_FOCUSED);
+ define_integer(GTK_CELL_RENDERER_EXPANDABLE);
+ define_integer(GTK_CELL_RENDERER_EXPANDED);
+ define_integer(GTK_STATE_FLAG_BACKDROP);
+#endif
+
+#if GTK_CHECK_VERSION(3, 6, 0)
+ define_integer(GDK_TOUCH_BEGIN);
+ define_integer(GDK_TOUCH_UPDATE);
+ define_integer(GDK_TOUCH_END);
+ define_integer(GDK_TOUCH_CANCEL);
+ define_integer(GDK_SCROLL_SMOOTH);
+ define_integer(GDK_CROSSING_TOUCH_BEGIN);
+ define_integer(GDK_CROSSING_TOUCH_END);
+ define_integer(GDK_CROSSING_DEVICE_SWITCH);
+ define_integer(GDK_TOUCH_MASK);
+ define_integer(GDK_SMOOTH_SCROLL_MASK);
+ define_integer(GTK_LEVEL_BAR_MODE_CONTINUOUS);
+ define_integer(GTK_LEVEL_BAR_MODE_DISCRETE);
+ define_integer(GTK_INPUT_PURPOSE_FREE_FORM);
+ define_integer(GTK_INPUT_PURPOSE_ALPHA);
+ define_integer(GTK_INPUT_PURPOSE_DIGITS);
+ define_integer(GTK_INPUT_PURPOSE_NUMBER);
+ define_integer(GTK_INPUT_PURPOSE_PHONE);
+ define_integer(GTK_INPUT_PURPOSE_URL);
+ define_integer(GTK_INPUT_PURPOSE_EMAIL);
+ define_integer(GTK_INPUT_PURPOSE_NAME);
+ define_integer(GTK_INPUT_PURPOSE_PASSWORD);
+ define_integer(GTK_INPUT_PURPOSE_PIN);
+ define_integer(GTK_INPUT_HINT_NONE);
+ define_integer(GTK_INPUT_HINT_SPELLCHECK);
+ define_integer(GTK_INPUT_HINT_NO_SPELLCHECK);
+ define_integer(GTK_INPUT_HINT_WORD_COMPLETION);
+ define_integer(GTK_INPUT_HINT_LOWERCASE);
+ define_integer(GTK_INPUT_HINT_UPPERCASE_CHARS);
+ define_integer(GTK_INPUT_HINT_UPPERCASE_WORDS);
+ define_integer(GTK_INPUT_HINT_UPPERCASE_SENTENCES);
+ define_integer(GTK_INPUT_HINT_INHIBIT_OSK);
#endif
-#if HAVE_GTK_ADJUSTMENT_GET_UPPER
- DEFINE_INTEGER(GDK_CROSSING_GTK_GRAB);
- DEFINE_INTEGER(GDK_CROSSING_GTK_UNGRAB);
- DEFINE_INTEGER(GDK_CROSSING_STATE_CHANGED);
+#if GTK_CHECK_VERSION(3, 8, 0)
+ define_integer(GTK_STATE_FLAG_DIR_LTR);
+ define_integer(GTK_STATE_FLAG_DIR_RTL);
+ define_integer(GDK_FULLSCREEN_ON_CURRENT_MONITOR);
+ define_integer(GDK_FULLSCREEN_ON_ALL_MONITORS);
#endif
-#if HAVE_GTK_SCALE_ADD_MARK
- DEFINE_INTEGER(GTK_ENTRY_ICON_PRIMARY);
- DEFINE_INTEGER(GTK_ENTRY_ICON_SECONDARY);
- DEFINE_INTEGER(GTK_ARROWS_BOTH);
- DEFINE_INTEGER(GTK_ARROWS_START);
- DEFINE_INTEGER(GTK_ARROWS_END);
- DEFINE_INTEGER(GDK_BLANK_CURSOR );
+#if GTK_CHECK_VERSION(3, 10, 0)
+ define_integer(GTK_ALIGN_BASELINE);
+ define_integer(GTK_BASELINE_POSITION_TOP);
+ define_integer(GTK_BASELINE_POSITION_CENTER);
+ define_integer(GTK_BASELINE_POSITION_BOTTOM);
+ define_integer(GTK_PLACES_OPEN_NORMAL);
+ define_integer(GTK_PLACES_OPEN_NEW_TAB);
+ define_integer(GTK_PLACES_OPEN_NEW_WINDOW);
+ define_integer(GTK_STACK_TRANSITION_TYPE_NONE);
+ define_integer(GTK_STACK_TRANSITION_TYPE_CROSSFADE);
+ define_integer(GTK_STACK_TRANSITION_TYPE_SLIDE_RIGHT);
+ define_integer(GTK_STACK_TRANSITION_TYPE_SLIDE_LEFT);
+ define_integer(GTK_STACK_TRANSITION_TYPE_SLIDE_UP);
+ define_integer(GTK_STACK_TRANSITION_TYPE_SLIDE_DOWN);
+ define_integer(GTK_REVEALER_TRANSITION_TYPE_NONE);
+ define_integer(GTK_REVEALER_TRANSITION_TYPE_CROSSFADE);
+ define_integer(GTK_REVEALER_TRANSITION_TYPE_SLIDE_RIGHT);
+ define_integer(GTK_REVEALER_TRANSITION_TYPE_SLIDE_LEFT);
+ define_integer(GTK_REVEALER_TRANSITION_TYPE_SLIDE_UP);
+ define_integer(GTK_REVEALER_TRANSITION_TYPE_SLIDE_DOWN);
+ define_integer(GDK_WINDOW_STATE_TILED);
#endif
-#if HAVE_GTK_INFO_BAR_NEW
- DEFINE_INTEGER(PANGO_WEIGHT_THIN);
- DEFINE_INTEGER(PANGO_WEIGHT_BOOK);
- DEFINE_INTEGER(PANGO_WEIGHT_MEDIUM);
+#if GTK_CHECK_VERSION(3, 12, 0)
+ define_integer(GTK_STACK_TRANSITION_TYPE_SLIDE_LEFT_RIGHT);
+ define_integer(GTK_STACK_TRANSITION_TYPE_SLIDE_UP_DOWN);
+ define_integer(GTK_STACK_TRANSITION_TYPE_OVER_UP);
+ define_integer(GTK_STACK_TRANSITION_TYPE_OVER_DOWN);
+ define_integer(GTK_STACK_TRANSITION_TYPE_OVER_LEFT);
+ define_integer(GTK_STACK_TRANSITION_TYPE_OVER_RIGHT);
+ define_integer(GTK_STACK_TRANSITION_TYPE_UNDER_UP);
+ define_integer(GTK_STACK_TRANSITION_TYPE_UNDER_DOWN);
+ define_integer(GTK_STACK_TRANSITION_TYPE_UNDER_LEFT);
+ define_integer(GTK_STACK_TRANSITION_TYPE_UNDER_RIGHT);
+ define_integer(GTK_STACK_TRANSITION_TYPE_OVER_UP_DOWN);
#endif
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
- DEFINE_INTEGER(GDK_WINDOW_OFFSCREEN);
+#if GTK_CHECK_VERSION(3, 14, 0)
+ define_integer(GTK_TEXT_VIEW_LAYER_BELOW);
+ define_integer(GTK_TEXT_VIEW_LAYER_ABOVE);
#endif
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
- DEFINE_INTEGER(GDK_KEY_VoidSymbol);
- DEFINE_INTEGER(GDK_KEY_BackSpace);
- DEFINE_INTEGER(GDK_KEY_Tab);
- DEFINE_INTEGER(GDK_KEY_Linefeed);
- DEFINE_INTEGER(GDK_KEY_Clear);
- DEFINE_INTEGER(GDK_KEY_Return);
- DEFINE_INTEGER(GDK_KEY_Pause);
- DEFINE_INTEGER(GDK_KEY_Scroll_Lock);
- DEFINE_INTEGER(GDK_KEY_Sys_Req);
- DEFINE_INTEGER(GDK_KEY_Escape);
- DEFINE_INTEGER(GDK_KEY_Delete);
- DEFINE_INTEGER(GDK_KEY_Home);
- DEFINE_INTEGER(GDK_KEY_Left);
- DEFINE_INTEGER(GDK_KEY_Up);
- DEFINE_INTEGER(GDK_KEY_Right);
- DEFINE_INTEGER(GDK_KEY_Down);
- DEFINE_INTEGER(GDK_KEY_Prior);
- DEFINE_INTEGER(GDK_KEY_Page_Up);
- DEFINE_INTEGER(GDK_KEY_Next);
- DEFINE_INTEGER(GDK_KEY_Page_Down);
- DEFINE_INTEGER(GDK_KEY_End);
- DEFINE_INTEGER(GDK_KEY_Begin);
- DEFINE_INTEGER(GDK_KEY_Select);
- DEFINE_INTEGER(GDK_KEY_Print);
- DEFINE_INTEGER(GDK_KEY_Execute);
- DEFINE_INTEGER(GDK_KEY_Insert);
- DEFINE_INTEGER(GDK_KEY_Undo);
- DEFINE_INTEGER(GDK_KEY_Redo);
- DEFINE_INTEGER(GDK_KEY_Menu);
- DEFINE_INTEGER(GDK_KEY_Find);
- DEFINE_INTEGER(GDK_KEY_Cancel);
- DEFINE_INTEGER(GDK_KEY_Help);
- DEFINE_INTEGER(GDK_KEY_Break);
- DEFINE_INTEGER(GDK_KEY_Mode_switch);
- DEFINE_INTEGER(GDK_KEY_script_switch);
- DEFINE_INTEGER(GDK_KEY_Num_Lock);
- DEFINE_INTEGER(GDK_KEY_KP_Space);
- DEFINE_INTEGER(GDK_KEY_KP_Tab);
- DEFINE_INTEGER(GDK_KEY_KP_Enter);
- DEFINE_INTEGER(GDK_KEY_KP_F1);
- DEFINE_INTEGER(GDK_KEY_KP_F2);
- DEFINE_INTEGER(GDK_KEY_KP_F3);
- DEFINE_INTEGER(GDK_KEY_KP_F4);
- DEFINE_INTEGER(GDK_KEY_KP_Home);
- DEFINE_INTEGER(GDK_KEY_KP_Left);
- DEFINE_INTEGER(GDK_KEY_KP_Up);
- DEFINE_INTEGER(GDK_KEY_KP_Right);
- DEFINE_INTEGER(GDK_KEY_KP_Down);
- DEFINE_INTEGER(GDK_KEY_KP_Prior);
- DEFINE_INTEGER(GDK_KEY_KP_Page_Up);
- DEFINE_INTEGER(GDK_KEY_KP_Next);
- DEFINE_INTEGER(GDK_KEY_KP_Page_Down);
- DEFINE_INTEGER(GDK_KEY_KP_End);
- DEFINE_INTEGER(GDK_KEY_KP_Begin);
- DEFINE_INTEGER(GDK_KEY_KP_Insert);
- DEFINE_INTEGER(GDK_KEY_KP_Delete);
- DEFINE_INTEGER(GDK_KEY_KP_Equal);
- DEFINE_INTEGER(GDK_KEY_KP_Multiply);
- DEFINE_INTEGER(GDK_KEY_KP_Add);
- DEFINE_INTEGER(GDK_KEY_KP_Separator);
- DEFINE_INTEGER(GDK_KEY_KP_Subtract);
- DEFINE_INTEGER(GDK_KEY_KP_Decimal);
- DEFINE_INTEGER(GDK_KEY_KP_Divide);
- DEFINE_INTEGER(GDK_KEY_KP_0);
- DEFINE_INTEGER(GDK_KEY_KP_1);
- DEFINE_INTEGER(GDK_KEY_KP_2);
- DEFINE_INTEGER(GDK_KEY_KP_3);
- DEFINE_INTEGER(GDK_KEY_KP_4);
- DEFINE_INTEGER(GDK_KEY_KP_5);
- DEFINE_INTEGER(GDK_KEY_KP_6);
- DEFINE_INTEGER(GDK_KEY_KP_7);
- DEFINE_INTEGER(GDK_KEY_KP_8);
- DEFINE_INTEGER(GDK_KEY_KP_9);
- DEFINE_INTEGER(GDK_KEY_F1);
- DEFINE_INTEGER(GDK_KEY_F2);
- DEFINE_INTEGER(GDK_KEY_F3);
- DEFINE_INTEGER(GDK_KEY_F4);
- DEFINE_INTEGER(GDK_KEY_F5);
- DEFINE_INTEGER(GDK_KEY_F6);
- DEFINE_INTEGER(GDK_KEY_F7);
- DEFINE_INTEGER(GDK_KEY_F8);
- DEFINE_INTEGER(GDK_KEY_F9);
- DEFINE_INTEGER(GDK_KEY_F10);
- DEFINE_INTEGER(GDK_KEY_F11);
- DEFINE_INTEGER(GDK_KEY_L1);
- DEFINE_INTEGER(GDK_KEY_F12);
- DEFINE_INTEGER(GDK_KEY_L2);
- DEFINE_INTEGER(GDK_KEY_F13);
- DEFINE_INTEGER(GDK_KEY_L3);
- DEFINE_INTEGER(GDK_KEY_F14);
- DEFINE_INTEGER(GDK_KEY_L4);
- DEFINE_INTEGER(GDK_KEY_F15);
- DEFINE_INTEGER(GDK_KEY_L5);
- DEFINE_INTEGER(GDK_KEY_F16);
- DEFINE_INTEGER(GDK_KEY_L6);
- DEFINE_INTEGER(GDK_KEY_F17);
- DEFINE_INTEGER(GDK_KEY_L7);
- DEFINE_INTEGER(GDK_KEY_F18);
- DEFINE_INTEGER(GDK_KEY_L8);
- DEFINE_INTEGER(GDK_KEY_F19);
- DEFINE_INTEGER(GDK_KEY_L9);
- DEFINE_INTEGER(GDK_KEY_F20);
- DEFINE_INTEGER(GDK_KEY_L10);
- DEFINE_INTEGER(GDK_KEY_F21);
- DEFINE_INTEGER(GDK_KEY_R1);
- DEFINE_INTEGER(GDK_KEY_F22);
- DEFINE_INTEGER(GDK_KEY_R2);
- DEFINE_INTEGER(GDK_KEY_F23);
- DEFINE_INTEGER(GDK_KEY_R3);
- DEFINE_INTEGER(GDK_KEY_F24);
- DEFINE_INTEGER(GDK_KEY_R4);
- DEFINE_INTEGER(GDK_KEY_F25);
- DEFINE_INTEGER(GDK_KEY_R5);
- DEFINE_INTEGER(GDK_KEY_F26);
- DEFINE_INTEGER(GDK_KEY_R6);
- DEFINE_INTEGER(GDK_KEY_F27);
- DEFINE_INTEGER(GDK_KEY_R7);
- DEFINE_INTEGER(GDK_KEY_F28);
- DEFINE_INTEGER(GDK_KEY_R8);
- DEFINE_INTEGER(GDK_KEY_F29);
- DEFINE_INTEGER(GDK_KEY_R9);
- DEFINE_INTEGER(GDK_KEY_F30);
- DEFINE_INTEGER(GDK_KEY_R10);
- DEFINE_INTEGER(GDK_KEY_F31);
- DEFINE_INTEGER(GDK_KEY_R11);
- DEFINE_INTEGER(GDK_KEY_F32);
- DEFINE_INTEGER(GDK_KEY_R12);
- DEFINE_INTEGER(GDK_KEY_F33);
- DEFINE_INTEGER(GDK_KEY_R13);
- DEFINE_INTEGER(GDK_KEY_F34);
- DEFINE_INTEGER(GDK_KEY_R14);
- DEFINE_INTEGER(GDK_KEY_F35);
- DEFINE_INTEGER(GDK_KEY_R15);
- DEFINE_INTEGER(GDK_KEY_Shift_L);
- DEFINE_INTEGER(GDK_KEY_Shift_R);
- DEFINE_INTEGER(GDK_KEY_Control_L);
- DEFINE_INTEGER(GDK_KEY_Control_R);
- DEFINE_INTEGER(GDK_KEY_Caps_Lock);
- DEFINE_INTEGER(GDK_KEY_Shift_Lock);
- DEFINE_INTEGER(GDK_KEY_Meta_L);
- DEFINE_INTEGER(GDK_KEY_Meta_R);
- DEFINE_INTEGER(GDK_KEY_Alt_L);
- DEFINE_INTEGER(GDK_KEY_Alt_R);
- DEFINE_INTEGER(GDK_KEY_space);
- DEFINE_INTEGER(GDK_KEY_exclam);
- DEFINE_INTEGER(GDK_KEY_quotedbl);
- DEFINE_INTEGER(GDK_KEY_numbersign);
- DEFINE_INTEGER(GDK_KEY_dollar);
- DEFINE_INTEGER(GDK_KEY_percent);
- DEFINE_INTEGER(GDK_KEY_ampersand);
- DEFINE_INTEGER(GDK_KEY_apostrophe);
- DEFINE_INTEGER(GDK_KEY_quoteright);
- DEFINE_INTEGER(GDK_KEY_parenleft);
- DEFINE_INTEGER(GDK_KEY_parenright);
- DEFINE_INTEGER(GDK_KEY_asterisk);
- DEFINE_INTEGER(GDK_KEY_plus);
- DEFINE_INTEGER(GDK_KEY_comma);
- DEFINE_INTEGER(GDK_KEY_minus);
- DEFINE_INTEGER(GDK_KEY_period);
- DEFINE_INTEGER(GDK_KEY_slash);
- DEFINE_INTEGER(GDK_KEY_0);
- DEFINE_INTEGER(GDK_KEY_1);
- DEFINE_INTEGER(GDK_KEY_2);
- DEFINE_INTEGER(GDK_KEY_3);
- DEFINE_INTEGER(GDK_KEY_4);
- DEFINE_INTEGER(GDK_KEY_5);
- DEFINE_INTEGER(GDK_KEY_6);
- DEFINE_INTEGER(GDK_KEY_7);
- DEFINE_INTEGER(GDK_KEY_8);
- DEFINE_INTEGER(GDK_KEY_9);
- DEFINE_INTEGER(GDK_KEY_colon);
- DEFINE_INTEGER(GDK_KEY_semicolon);
- DEFINE_INTEGER(GDK_KEY_less);
- DEFINE_INTEGER(GDK_KEY_equal);
- DEFINE_INTEGER(GDK_KEY_greater);
- DEFINE_INTEGER(GDK_KEY_question);
- DEFINE_INTEGER(GDK_KEY_at);
- DEFINE_INTEGER(GDK_KEY_A);
- DEFINE_INTEGER(GDK_KEY_B);
- DEFINE_INTEGER(GDK_KEY_C);
- DEFINE_INTEGER(GDK_KEY_D);
- DEFINE_INTEGER(GDK_KEY_E);
- DEFINE_INTEGER(GDK_KEY_F);
- DEFINE_INTEGER(GDK_KEY_G);
- DEFINE_INTEGER(GDK_KEY_H);
- DEFINE_INTEGER(GDK_KEY_I);
- DEFINE_INTEGER(GDK_KEY_J);
- DEFINE_INTEGER(GDK_KEY_K);
- DEFINE_INTEGER(GDK_KEY_L);
- DEFINE_INTEGER(GDK_KEY_M);
- DEFINE_INTEGER(GDK_KEY_N);
- DEFINE_INTEGER(GDK_KEY_O);
- DEFINE_INTEGER(GDK_KEY_P);
- DEFINE_INTEGER(GDK_KEY_Q);
- DEFINE_INTEGER(GDK_KEY_R);
- DEFINE_INTEGER(GDK_KEY_S);
- DEFINE_INTEGER(GDK_KEY_T);
- DEFINE_INTEGER(GDK_KEY_U);
- DEFINE_INTEGER(GDK_KEY_V);
- DEFINE_INTEGER(GDK_KEY_W);
- DEFINE_INTEGER(GDK_KEY_X);
- DEFINE_INTEGER(GDK_KEY_Y);
- DEFINE_INTEGER(GDK_KEY_Z);
- DEFINE_INTEGER(GDK_KEY_bracketleft);
- DEFINE_INTEGER(GDK_KEY_backslash);
- DEFINE_INTEGER(GDK_KEY_bracketright);
- DEFINE_INTEGER(GDK_KEY_asciicircum);
- DEFINE_INTEGER(GDK_KEY_underscore);
- DEFINE_INTEGER(GDK_KEY_grave);
- DEFINE_INTEGER(GDK_KEY_quoteleft);
- DEFINE_INTEGER(GDK_KEY_a);
- DEFINE_INTEGER(GDK_KEY_b);
- DEFINE_INTEGER(GDK_KEY_c);
- DEFINE_INTEGER(GDK_KEY_d);
- DEFINE_INTEGER(GDK_KEY_e);
- DEFINE_INTEGER(GDK_KEY_f);
- DEFINE_INTEGER(GDK_KEY_g);
- DEFINE_INTEGER(GDK_KEY_h);
- DEFINE_INTEGER(GDK_KEY_i);
- DEFINE_INTEGER(GDK_KEY_j);
- DEFINE_INTEGER(GDK_KEY_k);
- DEFINE_INTEGER(GDK_KEY_l);
- DEFINE_INTEGER(GDK_KEY_m);
- DEFINE_INTEGER(GDK_KEY_n);
- DEFINE_INTEGER(GDK_KEY_o);
- DEFINE_INTEGER(GDK_KEY_p);
- DEFINE_INTEGER(GDK_KEY_q);
- DEFINE_INTEGER(GDK_KEY_r);
- DEFINE_INTEGER(GDK_KEY_s);
- DEFINE_INTEGER(GDK_KEY_t);
- DEFINE_INTEGER(GDK_KEY_u);
- DEFINE_INTEGER(GDK_KEY_v);
- DEFINE_INTEGER(GDK_KEY_w);
- DEFINE_INTEGER(GDK_KEY_x);
- DEFINE_INTEGER(GDK_KEY_y);
- DEFINE_INTEGER(GDK_KEY_z);
- DEFINE_INTEGER(GDK_KEY_braceleft);
- DEFINE_INTEGER(GDK_KEY_bar);
- DEFINE_INTEGER(GDK_KEY_braceright);
- DEFINE_INTEGER(GDK_KEY_asciitilde);
- DEFINE_INTEGER(GTK_STATE_INCONSISTENT);
- DEFINE_INTEGER(GTK_STATE_FOCUSED);
- DEFINE_INTEGER(GTK_SIZE_REQUEST_HEIGHT_FOR_WIDTH);
- DEFINE_INTEGER(GTK_SIZE_REQUEST_WIDTH_FOR_HEIGHT);
- DEFINE_INTEGER(GTK_ASSISTANT_PAGE_CUSTOM);
- DEFINE_INTEGER(GTK_TEXT_SEARCH_CASE_INSENSITIVE);
- DEFINE_INTEGER(GTK_SCROLL_MINIMUM);
- DEFINE_INTEGER(GTK_SCROLL_NATURAL);
- DEFINE_INTEGER(GTK_TARGET_SAME_APP);
- DEFINE_INTEGER(GTK_TARGET_SAME_WIDGET);
- DEFINE_INTEGER(GTK_TARGET_OTHER_APP);
- DEFINE_INTEGER(GTK_TARGET_OTHER_WIDGET);
- DEFINE_INTEGER(GTK_ALIGN_FILL);
- DEFINE_INTEGER(GTK_ALIGN_START);
- DEFINE_INTEGER(GTK_ALIGN_END);
- DEFINE_INTEGER(GTK_ALIGN_CENTER);
- DEFINE_INTEGER(GTK_ARROW_NONE);
- DEFINE_INTEGER(GTK_TOOL_PALETTE_DRAG_ITEMS);
- DEFINE_INTEGER(GTK_TOOL_PALETTE_DRAG_GROUPS);
- DEFINE_INTEGER(GTK_IMAGE_GICON);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ERROR);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ERROR_NONEXISTENT);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ERROR_BAD_FILENAME);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ERROR_ALREADY_EXISTS);
- DEFINE_INTEGER(GTK_FILE_CHOOSER_ERROR_INCOMPLETE_HOSTNAME);
- DEFINE_INTEGER(GTK_LICENSE_UNKNOWN);
- DEFINE_INTEGER(GTK_LICENSE_CUSTOM);
- DEFINE_INTEGER(GTK_LICENSE_GPL_2_0);
- DEFINE_INTEGER(GTK_LICENSE_GPL_3_0);
- DEFINE_INTEGER(GTK_LICENSE_LGPL_2_1);
- DEFINE_INTEGER(GTK_LICENSE_LGPL_3_0);
- DEFINE_INTEGER(GTK_LICENSE_BSD);
- DEFINE_INTEGER(GTK_LICENSE_MIT_X11);
- DEFINE_INTEGER(GTK_LICENSE_ARTISTIC);
- DEFINE_INTEGER(GTK_ICON_LOOKUP_FORCE_SIZE);
- DEFINE_INTEGER(GTK_ICON_THEME_NOT_FOUND);
- DEFINE_INTEGER(GTK_ICON_THEME_FAILED);
+#if GTK_CHECK_VERSION(3, 16, 0)
+ define_integer(GTK_POLICY_EXTERNAL);
+ define_integer(PANGO_WEIGHT_SEMILIGHT);
+ define_integer(GTK_TEXT_EXTEND_SELECTION_WORD);
+ define_integer(GTK_TEXT_EXTEND_SELECTION_LINE);
#endif
-#if (!HAVE_GTK_3)
- DEFINE_INTEGER(GDK_DRAG_PROTO_MOTIF);
- DEFINE_INTEGER(GDK_DRAG_PROTO_XDND);
- DEFINE_INTEGER(GDK_DRAG_PROTO_ROOTWIN);
- DEFINE_INTEGER(GDK_DRAG_PROTO_NONE);
- DEFINE_INTEGER(GDK_DRAG_PROTO_WIN32_DROPFILES);
- DEFINE_INTEGER(GDK_DRAG_PROTO_OLE2);
- DEFINE_INTEGER(GDK_DRAG_PROTO_LOCAL);
- DEFINE_INTEGER(GDK_NO_EXPOSE);
- DEFINE_INTEGER(GDK_VoidSymbol);
- DEFINE_INTEGER(GDK_BackSpace);
- DEFINE_INTEGER(GDK_Tab);
- DEFINE_INTEGER(GDK_Linefeed);
- DEFINE_INTEGER(GDK_Clear);
- DEFINE_INTEGER(GDK_Return);
- DEFINE_INTEGER(GDK_Pause);
- DEFINE_INTEGER(GDK_Scroll_Lock);
- DEFINE_INTEGER(GDK_Sys_Req);
- DEFINE_INTEGER(GDK_Escape);
- DEFINE_INTEGER(GDK_Delete);
- DEFINE_INTEGER(GDK_Home);
- DEFINE_INTEGER(GDK_Left);
- DEFINE_INTEGER(GDK_Up);
- DEFINE_INTEGER(GDK_Right);
- DEFINE_INTEGER(GDK_Down);
- DEFINE_INTEGER(GDK_Prior);
- DEFINE_INTEGER(GDK_Page_Up);
- DEFINE_INTEGER(GDK_Next);
- DEFINE_INTEGER(GDK_Page_Down);
- DEFINE_INTEGER(GDK_End);
- DEFINE_INTEGER(GDK_Begin);
- DEFINE_INTEGER(GDK_Select);
- DEFINE_INTEGER(GDK_Print);
- DEFINE_INTEGER(GDK_Execute);
- DEFINE_INTEGER(GDK_Insert);
- DEFINE_INTEGER(GDK_Undo);
- DEFINE_INTEGER(GDK_Redo);
- DEFINE_INTEGER(GDK_Menu);
- DEFINE_INTEGER(GDK_Find);
- DEFINE_INTEGER(GDK_Cancel);
- DEFINE_INTEGER(GDK_Help);
- DEFINE_INTEGER(GDK_Break);
- DEFINE_INTEGER(GDK_Mode_switch);
- DEFINE_INTEGER(GDK_script_switch);
- DEFINE_INTEGER(GDK_Num_Lock);
- DEFINE_INTEGER(GDK_KP_Space);
- DEFINE_INTEGER(GDK_KP_Tab);
- DEFINE_INTEGER(GDK_KP_Enter);
- DEFINE_INTEGER(GDK_KP_F1);
- DEFINE_INTEGER(GDK_KP_F2);
- DEFINE_INTEGER(GDK_KP_F3);
- DEFINE_INTEGER(GDK_KP_F4);
- DEFINE_INTEGER(GDK_KP_Home);
- DEFINE_INTEGER(GDK_KP_Left);
- DEFINE_INTEGER(GDK_KP_Up);
- DEFINE_INTEGER(GDK_KP_Right);
- DEFINE_INTEGER(GDK_KP_Down);
- DEFINE_INTEGER(GDK_KP_Prior);
- DEFINE_INTEGER(GDK_KP_Page_Up);
- DEFINE_INTEGER(GDK_KP_Next);
- DEFINE_INTEGER(GDK_KP_Page_Down);
- DEFINE_INTEGER(GDK_KP_End);
- DEFINE_INTEGER(GDK_KP_Begin);
- DEFINE_INTEGER(GDK_KP_Insert);
- DEFINE_INTEGER(GDK_KP_Delete);
- DEFINE_INTEGER(GDK_KP_Equal);
- DEFINE_INTEGER(GDK_KP_Multiply);
- DEFINE_INTEGER(GDK_KP_Add);
- DEFINE_INTEGER(GDK_KP_Separator);
- DEFINE_INTEGER(GDK_KP_Subtract);
- DEFINE_INTEGER(GDK_KP_Decimal);
- DEFINE_INTEGER(GDK_KP_Divide);
- DEFINE_INTEGER(GDK_KP_0);
- DEFINE_INTEGER(GDK_KP_1);
- DEFINE_INTEGER(GDK_KP_2);
- DEFINE_INTEGER(GDK_KP_3);
- DEFINE_INTEGER(GDK_KP_4);
- DEFINE_INTEGER(GDK_KP_5);
- DEFINE_INTEGER(GDK_KP_6);
- DEFINE_INTEGER(GDK_KP_7);
- DEFINE_INTEGER(GDK_KP_8);
- DEFINE_INTEGER(GDK_KP_9);
- DEFINE_INTEGER(GDK_F1);
- DEFINE_INTEGER(GDK_F2);
- DEFINE_INTEGER(GDK_F3);
- DEFINE_INTEGER(GDK_F4);
- DEFINE_INTEGER(GDK_F5);
- DEFINE_INTEGER(GDK_F6);
- DEFINE_INTEGER(GDK_F7);
- DEFINE_INTEGER(GDK_F8);
- DEFINE_INTEGER(GDK_F9);
- DEFINE_INTEGER(GDK_F10);
- DEFINE_INTEGER(GDK_F11);
- DEFINE_INTEGER(GDK_L1);
- DEFINE_INTEGER(GDK_F12);
- DEFINE_INTEGER(GDK_L2);
- DEFINE_INTEGER(GDK_F13);
- DEFINE_INTEGER(GDK_L3);
- DEFINE_INTEGER(GDK_F14);
- DEFINE_INTEGER(GDK_L4);
- DEFINE_INTEGER(GDK_F15);
- DEFINE_INTEGER(GDK_L5);
- DEFINE_INTEGER(GDK_F16);
- DEFINE_INTEGER(GDK_L6);
- DEFINE_INTEGER(GDK_F17);
- DEFINE_INTEGER(GDK_L7);
- DEFINE_INTEGER(GDK_F18);
- DEFINE_INTEGER(GDK_L8);
- DEFINE_INTEGER(GDK_F19);
- DEFINE_INTEGER(GDK_L9);
- DEFINE_INTEGER(GDK_F20);
- DEFINE_INTEGER(GDK_L10);
- DEFINE_INTEGER(GDK_F21);
- DEFINE_INTEGER(GDK_R1);
- DEFINE_INTEGER(GDK_F22);
- DEFINE_INTEGER(GDK_R2);
- DEFINE_INTEGER(GDK_F23);
- DEFINE_INTEGER(GDK_R3);
- DEFINE_INTEGER(GDK_F24);
- DEFINE_INTEGER(GDK_R4);
- DEFINE_INTEGER(GDK_F25);
- DEFINE_INTEGER(GDK_R5);
- DEFINE_INTEGER(GDK_F26);
- DEFINE_INTEGER(GDK_R6);
- DEFINE_INTEGER(GDK_F27);
- DEFINE_INTEGER(GDK_R7);
- DEFINE_INTEGER(GDK_F28);
- DEFINE_INTEGER(GDK_R8);
- DEFINE_INTEGER(GDK_F29);
- DEFINE_INTEGER(GDK_R9);
- DEFINE_INTEGER(GDK_F30);
- DEFINE_INTEGER(GDK_R10);
- DEFINE_INTEGER(GDK_F31);
- DEFINE_INTEGER(GDK_R11);
- DEFINE_INTEGER(GDK_F32);
- DEFINE_INTEGER(GDK_R12);
- DEFINE_INTEGER(GDK_F33);
- DEFINE_INTEGER(GDK_R13);
- DEFINE_INTEGER(GDK_F34);
- DEFINE_INTEGER(GDK_R14);
- DEFINE_INTEGER(GDK_F35);
- DEFINE_INTEGER(GDK_R15);
- DEFINE_INTEGER(GDK_Shift_L);
- DEFINE_INTEGER(GDK_Shift_R);
- DEFINE_INTEGER(GDK_Control_L);
- DEFINE_INTEGER(GDK_Control_R);
- DEFINE_INTEGER(GDK_Caps_Lock);
- DEFINE_INTEGER(GDK_Shift_Lock);
- DEFINE_INTEGER(GDK_Meta_L);
- DEFINE_INTEGER(GDK_Meta_R);
- DEFINE_INTEGER(GDK_Alt_L);
- DEFINE_INTEGER(GDK_Alt_R);
- DEFINE_INTEGER(GDK_space);
- DEFINE_INTEGER(GDK_exclam);
- DEFINE_INTEGER(GDK_quotedbl);
- DEFINE_INTEGER(GDK_numbersign);
- DEFINE_INTEGER(GDK_dollar);
- DEFINE_INTEGER(GDK_percent);
- DEFINE_INTEGER(GDK_ampersand);
- DEFINE_INTEGER(GDK_apostrophe);
- DEFINE_INTEGER(GDK_quoteright);
- DEFINE_INTEGER(GDK_parenleft);
- DEFINE_INTEGER(GDK_parenright);
- DEFINE_INTEGER(GDK_asterisk);
- DEFINE_INTEGER(GDK_plus);
- DEFINE_INTEGER(GDK_comma);
- DEFINE_INTEGER(GDK_minus);
- DEFINE_INTEGER(GDK_period);
- DEFINE_INTEGER(GDK_slash);
- DEFINE_INTEGER(GDK_0);
- DEFINE_INTEGER(GDK_1);
- DEFINE_INTEGER(GDK_2);
- DEFINE_INTEGER(GDK_3);
- DEFINE_INTEGER(GDK_4);
- DEFINE_INTEGER(GDK_5);
- DEFINE_INTEGER(GDK_6);
- DEFINE_INTEGER(GDK_7);
- DEFINE_INTEGER(GDK_8);
- DEFINE_INTEGER(GDK_9);
- DEFINE_INTEGER(GDK_colon);
- DEFINE_INTEGER(GDK_semicolon);
- DEFINE_INTEGER(GDK_less);
- DEFINE_INTEGER(GDK_equal);
- DEFINE_INTEGER(GDK_greater);
- DEFINE_INTEGER(GDK_question);
- DEFINE_INTEGER(GDK_at);
- DEFINE_INTEGER(GDK_A);
- DEFINE_INTEGER(GDK_B);
- DEFINE_INTEGER(GDK_C);
- DEFINE_INTEGER(GDK_D);
- DEFINE_INTEGER(GDK_E);
- DEFINE_INTEGER(GDK_F);
- DEFINE_INTEGER(GDK_G);
- DEFINE_INTEGER(GDK_H);
- DEFINE_INTEGER(GDK_I);
- DEFINE_INTEGER(GDK_J);
- DEFINE_INTEGER(GDK_K);
- DEFINE_INTEGER(GDK_L);
- DEFINE_INTEGER(GDK_M);
- DEFINE_INTEGER(GDK_N);
- DEFINE_INTEGER(GDK_O);
- DEFINE_INTEGER(GDK_P);
- DEFINE_INTEGER(GDK_Q);
- DEFINE_INTEGER(GDK_R);
- DEFINE_INTEGER(GDK_S);
- DEFINE_INTEGER(GDK_T);
- DEFINE_INTEGER(GDK_U);
- DEFINE_INTEGER(GDK_V);
- DEFINE_INTEGER(GDK_W);
- DEFINE_INTEGER(GDK_X);
- DEFINE_INTEGER(GDK_Y);
- DEFINE_INTEGER(GDK_Z);
- DEFINE_INTEGER(GDK_bracketleft);
- DEFINE_INTEGER(GDK_backslash);
- DEFINE_INTEGER(GDK_bracketright);
- DEFINE_INTEGER(GDK_asciicircum);
- DEFINE_INTEGER(GDK_underscore);
- DEFINE_INTEGER(GDK_grave);
- DEFINE_INTEGER(GDK_quoteleft);
- DEFINE_INTEGER(GDK_a);
- DEFINE_INTEGER(GDK_b);
- DEFINE_INTEGER(GDK_c);
- DEFINE_INTEGER(GDK_d);
- DEFINE_INTEGER(GDK_e);
- DEFINE_INTEGER(GDK_f);
- DEFINE_INTEGER(GDK_g);
- DEFINE_INTEGER(GDK_h);
- DEFINE_INTEGER(GDK_i);
- DEFINE_INTEGER(GDK_j);
- DEFINE_INTEGER(GDK_k);
- DEFINE_INTEGER(GDK_l);
- DEFINE_INTEGER(GDK_m);
- DEFINE_INTEGER(GDK_n);
- DEFINE_INTEGER(GDK_o);
- DEFINE_INTEGER(GDK_p);
- DEFINE_INTEGER(GDK_q);
- DEFINE_INTEGER(GDK_r);
- DEFINE_INTEGER(GDK_s);
- DEFINE_INTEGER(GDK_t);
- DEFINE_INTEGER(GDK_u);
- DEFINE_INTEGER(GDK_v);
- DEFINE_INTEGER(GDK_w);
- DEFINE_INTEGER(GDK_x);
- DEFINE_INTEGER(GDK_y);
- DEFINE_INTEGER(GDK_z);
- DEFINE_INTEGER(GDK_braceleft);
- DEFINE_INTEGER(GDK_bar);
- DEFINE_INTEGER(GDK_braceright);
- DEFINE_INTEGER(GDK_asciitilde);
- DEFINE_INTEGER(GTK_UPDATE_CONTINUOUS);
- DEFINE_INTEGER(GTK_UPDATE_DISCONTINUOUS);
- DEFINE_INTEGER(GTK_UPDATE_DELAYED);
- DEFINE_INTEGER(GTK_RC_FG);
- DEFINE_INTEGER(GTK_RC_BG);
- DEFINE_INTEGER(GTK_RC_TEXT);
- DEFINE_INTEGER(GTK_RC_BASE);
+#if GTK_CHECK_VERSION(3, 18, 0)
+ define_integer(GDK_TOUCHPAD_SWIPE);
+ define_integer(GDK_TOUCHPAD_PINCH);
+ define_integer(GDK_TOUCHPAD_GESTURE_PHASE_BEGIN);
+ define_integer(GDK_TOUCHPAD_GESTURE_PHASE_UPDATE);
+ define_integer(GDK_TOUCHPAD_GESTURE_PHASE_END);
+ define_integer(GDK_TOUCHPAD_GESTURE_PHASE_CANCEL);
+ define_integer(GDK_TOUCHPAD_GESTURE_MASK);
+ define_integer(GDK_MODIFIER_INTENT_DEFAULT_MOD_MASK);
#endif
- DEFINE_INTEGER(CAIRO_STATUS_SUCCESS);
- DEFINE_INTEGER(CAIRO_STATUS_NO_MEMORY);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_RESTORE);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_POP_GROUP);
- DEFINE_INTEGER(CAIRO_STATUS_NO_CURRENT_POINT);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_MATRIX);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_STATUS);
- DEFINE_INTEGER(CAIRO_STATUS_NULL_POINTER);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_STRING);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_PATH_DATA);
- DEFINE_INTEGER(CAIRO_STATUS_READ_ERROR);
- DEFINE_INTEGER(CAIRO_STATUS_WRITE_ERROR);
- DEFINE_INTEGER(CAIRO_STATUS_SURFACE_FINISHED);
- DEFINE_INTEGER(CAIRO_STATUS_SURFACE_TYPE_MISMATCH);
- DEFINE_INTEGER(CAIRO_STATUS_PATTERN_TYPE_MISMATCH);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_CONTENT);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_FORMAT);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_VISUAL);
- DEFINE_INTEGER(CAIRO_STATUS_FILE_NOT_FOUND);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_DASH);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_DSC_COMMENT);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_INDEX);
- DEFINE_INTEGER(CAIRO_STATUS_CLIP_NOT_REPRESENTABLE);
- DEFINE_INTEGER(CAIRO_STATUS_TEMP_FILE_ERROR);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_STRIDE);
- DEFINE_INTEGER(CAIRO_CONTENT_COLOR);
- DEFINE_INTEGER(CAIRO_CONTENT_ALPHA);
- DEFINE_INTEGER(CAIRO_CONTENT_COLOR_ALPHA);
- DEFINE_INTEGER(CAIRO_OPERATOR_CLEAR);
- DEFINE_INTEGER(CAIRO_OPERATOR_SOURCE);
- DEFINE_INTEGER(CAIRO_OPERATOR_OVER);
- DEFINE_INTEGER(CAIRO_OPERATOR_IN);
- DEFINE_INTEGER(CAIRO_OPERATOR_OUT);
- DEFINE_INTEGER(CAIRO_OPERATOR_ATOP);
- DEFINE_INTEGER(CAIRO_OPERATOR_DEST);
- DEFINE_INTEGER(CAIRO_OPERATOR_DEST_OVER);
- DEFINE_INTEGER(CAIRO_OPERATOR_DEST_IN);
- DEFINE_INTEGER(CAIRO_OPERATOR_DEST_OUT);
- DEFINE_INTEGER(CAIRO_OPERATOR_DEST_ATOP);
- DEFINE_INTEGER(CAIRO_OPERATOR_XOR);
- DEFINE_INTEGER(CAIRO_OPERATOR_ADD);
- DEFINE_INTEGER(CAIRO_OPERATOR_SATURATE);
- DEFINE_INTEGER(CAIRO_ANTIALIAS_DEFAULT);
- DEFINE_INTEGER(CAIRO_ANTIALIAS_NONE);
- DEFINE_INTEGER(CAIRO_ANTIALIAS_GRAY);
- DEFINE_INTEGER(CAIRO_ANTIALIAS_SUBPIXEL);
- DEFINE_INTEGER(CAIRO_FILL_RULE_WINDING);
- DEFINE_INTEGER(CAIRO_FILL_RULE_EVEN_ODD);
- DEFINE_INTEGER(CAIRO_LINE_CAP_BUTT);
- DEFINE_INTEGER(CAIRO_LINE_CAP_ROUND);
- DEFINE_INTEGER(CAIRO_LINE_CAP_SQUARE);
- DEFINE_INTEGER(CAIRO_LINE_JOIN_MITER);
- DEFINE_INTEGER(CAIRO_LINE_JOIN_ROUND);
- DEFINE_INTEGER(CAIRO_LINE_JOIN_BEVEL);
- DEFINE_INTEGER(CAIRO_FONT_SLANT_NORMAL);
- DEFINE_INTEGER(CAIRO_FONT_SLANT_ITALIC);
- DEFINE_INTEGER(CAIRO_FONT_SLANT_OBLIQUE);
- DEFINE_INTEGER(CAIRO_FONT_WEIGHT_NORMAL);
- DEFINE_INTEGER(CAIRO_FONT_WEIGHT_BOLD);
- DEFINE_INTEGER(CAIRO_SUBPIXEL_ORDER_DEFAULT);
- DEFINE_INTEGER(CAIRO_SUBPIXEL_ORDER_RGB);
- DEFINE_INTEGER(CAIRO_SUBPIXEL_ORDER_BGR);
- DEFINE_INTEGER(CAIRO_SUBPIXEL_ORDER_VRGB);
- DEFINE_INTEGER(CAIRO_SUBPIXEL_ORDER_VBGR);
- DEFINE_INTEGER(CAIRO_HINT_STYLE_DEFAULT);
- DEFINE_INTEGER(CAIRO_HINT_STYLE_NONE);
- DEFINE_INTEGER(CAIRO_HINT_STYLE_SLIGHT);
- DEFINE_INTEGER(CAIRO_HINT_STYLE_MEDIUM);
- DEFINE_INTEGER(CAIRO_HINT_STYLE_FULL);
- DEFINE_INTEGER(CAIRO_HINT_METRICS_DEFAULT);
- DEFINE_INTEGER(CAIRO_HINT_METRICS_OFF);
- DEFINE_INTEGER(CAIRO_HINT_METRICS_ON);
- DEFINE_INTEGER(CAIRO_FONT_TYPE_TOY);
- DEFINE_INTEGER(CAIRO_FONT_TYPE_FT);
- DEFINE_INTEGER(CAIRO_FONT_TYPE_WIN32);
- DEFINE_INTEGER(CAIRO_FONT_TYPE_QUARTZ);
- DEFINE_INTEGER(CAIRO_PATH_MOVE_TO);
- DEFINE_INTEGER(CAIRO_PATH_LINE_TO);
- DEFINE_INTEGER(CAIRO_PATH_CURVE_TO);
- DEFINE_INTEGER(CAIRO_PATH_CLOSE_PATH);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_IMAGE);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_PDF);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_PS);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_XLIB);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_XCB);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_GLITZ);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_QUARTZ);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_WIN32);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_BEOS);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_DIRECTFB);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_SVG);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_OS2);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_WIN32_PRINTING);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_QUARTZ_IMAGE);
- DEFINE_INTEGER(CAIRO_FORMAT_ARGB32);
- DEFINE_INTEGER(CAIRO_FORMAT_RGB24);
- DEFINE_INTEGER(CAIRO_FORMAT_A8);
- DEFINE_INTEGER(CAIRO_FORMAT_A1);
- DEFINE_INTEGER(CAIRO_PATTERN_TYPE_SOLID);
- DEFINE_INTEGER(CAIRO_PATTERN_TYPE_SURFACE);
- DEFINE_INTEGER(CAIRO_PATTERN_TYPE_LINEAR);
- DEFINE_INTEGER(CAIRO_PATTERN_TYPE_RADIAL);
- DEFINE_INTEGER(CAIRO_EXTEND_NONE);
- DEFINE_INTEGER(CAIRO_EXTEND_REPEAT);
- DEFINE_INTEGER(CAIRO_EXTEND_REFLECT);
- DEFINE_INTEGER(CAIRO_EXTEND_PAD);
- DEFINE_INTEGER(CAIRO_FILTER_FAST);
- DEFINE_INTEGER(CAIRO_FILTER_GOOD);
- DEFINE_INTEGER(CAIRO_FILTER_BEST);
- DEFINE_INTEGER(CAIRO_FILTER_NEAREST);
- DEFINE_INTEGER(CAIRO_FILTER_BILINEAR);
- DEFINE_INTEGER(CAIRO_FILTER_GAUSSIAN);
-#if HAVE_CAIRO_GLYPH_ALLOCATE
- DEFINE_INTEGER(CAIRO_STATUS_FONT_TYPE_MISMATCH);
- DEFINE_INTEGER(CAIRO_STATUS_USER_FONT_IMMUTABLE);
- DEFINE_INTEGER(CAIRO_STATUS_USER_FONT_ERROR);
- DEFINE_INTEGER(CAIRO_STATUS_NEGATIVE_COUNT);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_CLUSTERS);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_SLANT);
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_WEIGHT);
+#if GTK_CHECK_VERSION(3, 20, 0)
+ define_integer(GTK_SHORTCUT_ACCELERATOR);
+ define_integer(GTK_SHORTCUT_GESTURE_PINCH);
+ define_integer(GTK_SHORTCUT_GESTURE_STRETCH);
+ define_integer(GTK_SHORTCUT_GESTURE_ROTATE_CLOCKWISE);
+ define_integer(GTK_SHORTCUT_GESTURE_ROTATE_COUNTERCLOCKWISE);
+ define_integer(GTK_SHORTCUT_GESTURE_TWO_FINGER_SWIPE_LEFT);
+ define_integer(GTK_SHORTCUT_GESTURE_TWO_FINGER_SWIPE_RIGHT);
+ define_integer(GTK_SHORTCUT_GESTURE);
#endif
-#if HAVE_CAIRO_REGION_XOR
- DEFINE_INTEGER(CAIRO_STATUS_INVALID_SIZE);
- DEFINE_INTEGER(CAIRO_STATUS_USER_FONT_NOT_IMPLEMENTED);
- DEFINE_INTEGER(CAIRO_STATUS_DEVICE_TYPE_MISMATCH);
- DEFINE_INTEGER(CAIRO_STATUS_DEVICE_ERROR);
- DEFINE_INTEGER(CAIRO_OPERATOR_MULTIPLY);
- DEFINE_INTEGER(CAIRO_OPERATOR_SCREEN);
- DEFINE_INTEGER(CAIRO_OPERATOR_OVERLAY);
- DEFINE_INTEGER(CAIRO_OPERATOR_DARKEN);
- DEFINE_INTEGER(CAIRO_OPERATOR_LIGHTEN);
- DEFINE_INTEGER(CAIRO_OPERATOR_COLOR_DODGE);
- DEFINE_INTEGER(CAIRO_OPERATOR_COLOR_BURN);
- DEFINE_INTEGER(CAIRO_OPERATOR_HARD_LIGHT);
- DEFINE_INTEGER(CAIRO_OPERATOR_SOFT_LIGHT);
- DEFINE_INTEGER(CAIRO_OPERATOR_DIFFERENCE);
- DEFINE_INTEGER(CAIRO_OPERATOR_EXCLUSION);
- DEFINE_INTEGER(CAIRO_OPERATOR_HSL_HUE);
- DEFINE_INTEGER(CAIRO_OPERATOR_HSL_SATURATION);
- DEFINE_INTEGER(CAIRO_OPERATOR_HSL_COLOR);
- DEFINE_INTEGER(CAIRO_OPERATOR_HSL_LUMINOSITY);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_SCRIPT);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_QT);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_RECORDING);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_VG);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_GL);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_DRM);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_TEE);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_XML);
- DEFINE_INTEGER(CAIRO_SURFACE_TYPE_SKIA);
+ define_integer(CAIRO_STATUS_SUCCESS);
+ define_integer(CAIRO_STATUS_NO_MEMORY);
+ define_integer(CAIRO_STATUS_INVALID_RESTORE);
+ define_integer(CAIRO_STATUS_INVALID_POP_GROUP);
+ define_integer(CAIRO_STATUS_NO_CURRENT_POINT);
+ define_integer(CAIRO_STATUS_INVALID_MATRIX);
+ define_integer(CAIRO_STATUS_INVALID_STATUS);
+ define_integer(CAIRO_STATUS_NULL_POINTER);
+ define_integer(CAIRO_STATUS_INVALID_STRING);
+ define_integer(CAIRO_STATUS_INVALID_PATH_DATA);
+ define_integer(CAIRO_STATUS_READ_ERROR);
+ define_integer(CAIRO_STATUS_WRITE_ERROR);
+ define_integer(CAIRO_STATUS_SURFACE_FINISHED);
+ define_integer(CAIRO_STATUS_SURFACE_TYPE_MISMATCH);
+ define_integer(CAIRO_STATUS_PATTERN_TYPE_MISMATCH);
+ define_integer(CAIRO_STATUS_INVALID_CONTENT);
+ define_integer(CAIRO_STATUS_INVALID_FORMAT);
+ define_integer(CAIRO_STATUS_INVALID_VISUAL);
+ define_integer(CAIRO_STATUS_FILE_NOT_FOUND);
+ define_integer(CAIRO_STATUS_INVALID_DASH);
+ define_integer(CAIRO_STATUS_INVALID_DSC_COMMENT);
+ define_integer(CAIRO_STATUS_INVALID_INDEX);
+ define_integer(CAIRO_STATUS_CLIP_NOT_REPRESENTABLE);
+ define_integer(CAIRO_STATUS_TEMP_FILE_ERROR);
+ define_integer(CAIRO_STATUS_INVALID_STRIDE);
+ define_integer(CAIRO_CONTENT_COLOR);
+ define_integer(CAIRO_CONTENT_ALPHA);
+ define_integer(CAIRO_CONTENT_COLOR_ALPHA);
+ define_integer(CAIRO_OPERATOR_CLEAR);
+ define_integer(CAIRO_OPERATOR_SOURCE);
+ define_integer(CAIRO_OPERATOR_OVER);
+ define_integer(CAIRO_OPERATOR_IN);
+ define_integer(CAIRO_OPERATOR_OUT);
+ define_integer(CAIRO_OPERATOR_ATOP);
+ define_integer(CAIRO_OPERATOR_DEST);
+ define_integer(CAIRO_OPERATOR_DEST_OVER);
+ define_integer(CAIRO_OPERATOR_DEST_IN);
+ define_integer(CAIRO_OPERATOR_DEST_OUT);
+ define_integer(CAIRO_OPERATOR_DEST_ATOP);
+ define_integer(CAIRO_OPERATOR_XOR);
+ define_integer(CAIRO_OPERATOR_ADD);
+ define_integer(CAIRO_OPERATOR_SATURATE);
+ define_integer(CAIRO_ANTIALIAS_DEFAULT);
+ define_integer(CAIRO_ANTIALIAS_NONE);
+ define_integer(CAIRO_ANTIALIAS_GRAY);
+ define_integer(CAIRO_ANTIALIAS_SUBPIXEL);
+ define_integer(CAIRO_FILL_RULE_WINDING);
+ define_integer(CAIRO_FILL_RULE_EVEN_ODD);
+ define_integer(CAIRO_LINE_CAP_BUTT);
+ define_integer(CAIRO_LINE_CAP_ROUND);
+ define_integer(CAIRO_LINE_CAP_SQUARE);
+ define_integer(CAIRO_LINE_JOIN_MITER);
+ define_integer(CAIRO_LINE_JOIN_ROUND);
+ define_integer(CAIRO_LINE_JOIN_BEVEL);
+ define_integer(CAIRO_FONT_SLANT_NORMAL);
+ define_integer(CAIRO_FONT_SLANT_ITALIC);
+ define_integer(CAIRO_FONT_SLANT_OBLIQUE);
+ define_integer(CAIRO_FONT_WEIGHT_NORMAL);
+ define_integer(CAIRO_FONT_WEIGHT_BOLD);
+ define_integer(CAIRO_SUBPIXEL_ORDER_DEFAULT);
+ define_integer(CAIRO_SUBPIXEL_ORDER_RGB);
+ define_integer(CAIRO_SUBPIXEL_ORDER_BGR);
+ define_integer(CAIRO_SUBPIXEL_ORDER_VRGB);
+ define_integer(CAIRO_SUBPIXEL_ORDER_VBGR);
+ define_integer(CAIRO_HINT_STYLE_DEFAULT);
+ define_integer(CAIRO_HINT_STYLE_NONE);
+ define_integer(CAIRO_HINT_STYLE_SLIGHT);
+ define_integer(CAIRO_HINT_STYLE_MEDIUM);
+ define_integer(CAIRO_HINT_STYLE_FULL);
+ define_integer(CAIRO_HINT_METRICS_DEFAULT);
+ define_integer(CAIRO_HINT_METRICS_OFF);
+ define_integer(CAIRO_HINT_METRICS_ON);
+ define_integer(CAIRO_FONT_TYPE_TOY);
+ define_integer(CAIRO_FONT_TYPE_FT);
+ define_integer(CAIRO_FONT_TYPE_WIN32);
+ define_integer(CAIRO_FONT_TYPE_QUARTZ);
+ define_integer(CAIRO_PATH_MOVE_TO);
+ define_integer(CAIRO_PATH_LINE_TO);
+ define_integer(CAIRO_PATH_CURVE_TO);
+ define_integer(CAIRO_PATH_CLOSE_PATH);
+ define_integer(CAIRO_SURFACE_TYPE_IMAGE);
+ define_integer(CAIRO_SURFACE_TYPE_PDF);
+ define_integer(CAIRO_SURFACE_TYPE_PS);
+ define_integer(CAIRO_SURFACE_TYPE_XLIB);
+ define_integer(CAIRO_SURFACE_TYPE_XCB);
+ define_integer(CAIRO_SURFACE_TYPE_GLITZ);
+ define_integer(CAIRO_SURFACE_TYPE_QUARTZ);
+ define_integer(CAIRO_SURFACE_TYPE_WIN32);
+ define_integer(CAIRO_SURFACE_TYPE_BEOS);
+ define_integer(CAIRO_SURFACE_TYPE_DIRECTFB);
+ define_integer(CAIRO_SURFACE_TYPE_SVG);
+ define_integer(CAIRO_SURFACE_TYPE_OS2);
+ define_integer(CAIRO_SURFACE_TYPE_WIN32_PRINTING);
+ define_integer(CAIRO_SURFACE_TYPE_QUARTZ_IMAGE);
+ define_integer(CAIRO_FORMAT_ARGB32);
+ define_integer(CAIRO_FORMAT_RGB24);
+ define_integer(CAIRO_FORMAT_A8);
+ define_integer(CAIRO_FORMAT_A1);
+ define_integer(CAIRO_PATTERN_TYPE_SOLID);
+ define_integer(CAIRO_PATTERN_TYPE_SURFACE);
+ define_integer(CAIRO_PATTERN_TYPE_LINEAR);
+ define_integer(CAIRO_PATTERN_TYPE_RADIAL);
+ define_integer(CAIRO_EXTEND_NONE);
+ define_integer(CAIRO_EXTEND_REPEAT);
+ define_integer(CAIRO_EXTEND_REFLECT);
+ define_integer(CAIRO_EXTEND_PAD);
+ define_integer(CAIRO_FILTER_FAST);
+ define_integer(CAIRO_FILTER_GOOD);
+ define_integer(CAIRO_FILTER_BEST);
+ define_integer(CAIRO_FILTER_NEAREST);
+ define_integer(CAIRO_FILTER_BILINEAR);
+ define_integer(CAIRO_FILTER_GAUSSIAN);
+#if HAVE_CAIRO_1_8
+ define_integer(CAIRO_STATUS_FONT_TYPE_MISMATCH);
+ define_integer(CAIRO_STATUS_USER_FONT_IMMUTABLE);
+ define_integer(CAIRO_STATUS_USER_FONT_ERROR);
+ define_integer(CAIRO_STATUS_NEGATIVE_COUNT);
+ define_integer(CAIRO_STATUS_INVALID_CLUSTERS);
+ define_integer(CAIRO_STATUS_INVALID_SLANT);
+ define_integer(CAIRO_STATUS_INVALID_WEIGHT);
#endif
- DEFINE_ULONG(GDK_PIXBUF_ERROR);
- DEFINE_ULONG(G_TYPE_IO_CONDITION);
- DEFINE_ULONG(G_TYPE_INVALID);
- DEFINE_ULONG(G_TYPE_NONE);
- DEFINE_ULONG(G_TYPE_INTERFACE);
- DEFINE_ULONG(G_TYPE_CHAR);
- DEFINE_ULONG(G_TYPE_UCHAR);
- DEFINE_ULONG(G_TYPE_BOOLEAN);
- DEFINE_ULONG(G_TYPE_INT);
- DEFINE_ULONG(G_TYPE_UINT);
- DEFINE_ULONG(G_TYPE_LONG);
- DEFINE_ULONG(G_TYPE_ULONG);
- DEFINE_ULONG(G_TYPE_INT64);
- DEFINE_ULONG(G_TYPE_UINT64);
- DEFINE_ULONG(G_TYPE_ENUM);
- DEFINE_ULONG(G_TYPE_FLAGS);
- DEFINE_ULONG(G_TYPE_FLOAT);
- DEFINE_ULONG(G_TYPE_DOUBLE);
- DEFINE_ULONG(G_TYPE_STRING);
- DEFINE_ULONG(G_TYPE_POINTER);
- DEFINE_ULONG(G_TYPE_BOXED);
- DEFINE_ULONG(G_TYPE_PARAM);
- DEFINE_ULONG(G_TYPE_OBJECT);
- DEFINE_ULONG(PANGO_TYPE_ITEM);
- DEFINE_ULONG(PANGO_TYPE_LAYOUT_LINE);
-#if HAVE_GTK_STATUS_ICON_GET_TITLE
- DEFINE_ULONG(GTK_ENTRY_BUFFER_MAX_SIZE);
+#if HAVE_CAIRO_1_9_12 && GTK_CHECK_VERSION(3, 0, 0)
+ define_integer(CAIRO_STATUS_INVALID_SIZE);
+ define_integer(CAIRO_STATUS_USER_FONT_NOT_IMPLEMENTED);
+ define_integer(CAIRO_STATUS_DEVICE_TYPE_MISMATCH);
+ define_integer(CAIRO_STATUS_DEVICE_ERROR);
+ define_integer(CAIRO_OPERATOR_MULTIPLY);
+ define_integer(CAIRO_OPERATOR_SCREEN);
+ define_integer(CAIRO_OPERATOR_OVERLAY);
+ define_integer(CAIRO_OPERATOR_DARKEN);
+ define_integer(CAIRO_OPERATOR_LIGHTEN);
+ define_integer(CAIRO_OPERATOR_COLOR_DODGE);
+ define_integer(CAIRO_OPERATOR_COLOR_BURN);
+ define_integer(CAIRO_OPERATOR_HARD_LIGHT);
+ define_integer(CAIRO_OPERATOR_SOFT_LIGHT);
+ define_integer(CAIRO_OPERATOR_DIFFERENCE);
+ define_integer(CAIRO_OPERATOR_EXCLUSION);
+ define_integer(CAIRO_OPERATOR_HSL_HUE);
+ define_integer(CAIRO_OPERATOR_HSL_SATURATION);
+ define_integer(CAIRO_OPERATOR_HSL_COLOR);
+ define_integer(CAIRO_OPERATOR_HSL_LUMINOSITY);
+ define_integer(CAIRO_SURFACE_TYPE_SCRIPT);
+ define_integer(CAIRO_SURFACE_TYPE_QT);
+ define_integer(CAIRO_SURFACE_TYPE_RECORDING);
+ define_integer(CAIRO_SURFACE_TYPE_VG);
+ define_integer(CAIRO_SURFACE_TYPE_GL);
+ define_integer(CAIRO_SURFACE_TYPE_DRM);
+ define_integer(CAIRO_SURFACE_TYPE_TEE);
+ define_integer(CAIRO_SURFACE_TYPE_XML);
+ define_integer(CAIRO_SURFACE_TYPE_SKIA);
#endif
}
static void define_doubles(void)
{
-#if HAVE_SCHEME
- #define DEFINE_DOUBLE(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, C_TO_XEN_DOUBLE(Name))
-#else
- #define DEFINE_DOUBLE(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_DOUBLE(Name))
-#endif
+#define define_double(Name) Xen_define(Xg_pre #Name Xg_post, C_double_to_Xen_real(Name))
- DEFINE_DOUBLE(PANGO_SCALE_XX_SMALL);
- DEFINE_DOUBLE(PANGO_SCALE_X_SMALL);
- DEFINE_DOUBLE(PANGO_SCALE_SMALL);
- DEFINE_DOUBLE(PANGO_SCALE_MEDIUM);
- DEFINE_DOUBLE(PANGO_SCALE_LARGE);
- DEFINE_DOUBLE(PANGO_SCALE_X_LARGE);
- DEFINE_DOUBLE(PANGO_SCALE_XX_LARGE);
+ define_double(PANGO_SCALE_XX_SMALL);
+ define_double(PANGO_SCALE_X_SMALL);
+ define_double(PANGO_SCALE_SMALL);
+ define_double(PANGO_SCALE_MEDIUM);
+ define_double(PANGO_SCALE_LARGE);
+ define_double(PANGO_SCALE_X_LARGE);
+ define_double(PANGO_SCALE_XX_LARGE);
}
/* -------------------------------- predefined Atoms -------------------------------- */
static void define_atoms(void)
{
-#if HAVE_SCHEME
- #define DEFINE_ATOM(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, C_TO_XEN_GdkAtom(Name))
-#else
- #define DEFINE_ATOM(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_GdkAtom(Name))
-#endif
-
- DEFINE_ATOM(GDK_SELECTION_PRIMARY);
- DEFINE_ATOM(GDK_SELECTION_SECONDARY);
- DEFINE_ATOM(GDK_SELECTION_CLIPBOARD);
- DEFINE_ATOM(GDK_TARGET_BITMAP);
- DEFINE_ATOM(GDK_TARGET_DRAWABLE);
- DEFINE_ATOM(GDK_TARGET_STRING);
- DEFINE_ATOM(GDK_SELECTION_TYPE_ATOM);
- DEFINE_ATOM(GDK_SELECTION_TYPE_BITMAP);
- DEFINE_ATOM(GDK_SELECTION_TYPE_DRAWABLE);
- DEFINE_ATOM(GDK_SELECTION_TYPE_INTEGER);
- DEFINE_ATOM(GDK_SELECTION_TYPE_WINDOW);
- DEFINE_ATOM(GDK_SELECTION_TYPE_STRING);
- DEFINE_ATOM(GDK_NONE);
+#define define_atom(Name) Xen_define(Xg_pre #Name Xg_post, C_to_Xen_GdkAtom(Name))
+
+ define_atom(GDK_SELECTION_PRIMARY);
+ define_atom(GDK_SELECTION_SECONDARY);
+ define_atom(GDK_SELECTION_CLIPBOARD);
+ define_atom(GDK_TARGET_BITMAP);
+ define_atom(GDK_TARGET_DRAWABLE);
+ define_atom(GDK_TARGET_STRING);
+ define_atom(GDK_SELECTION_TYPE_ATOM);
+ define_atom(GDK_SELECTION_TYPE_BITMAP);
+ define_atom(GDK_SELECTION_TYPE_DRAWABLE);
+ define_atom(GDK_SELECTION_TYPE_INTEGER);
+ define_atom(GDK_SELECTION_TYPE_WINDOW);
+ define_atom(GDK_SELECTION_TYPE_STRING);
+ define_atom(GDK_NONE);
+}
+
+/* -------------------------------- symbols -------------------------------- */
+
+static void define_symbols(void)
+{
+ xg_GtkAllocation_symbol = C_string_to_Xen_symbol("GtkAllocation");
+ xg_GtkShortcutsWindow__symbol = C_string_to_Xen_symbol("GtkShortcutsWindow_");
+ xg_GtkStackSidebar__symbol = C_string_to_Xen_symbol("GtkStackSidebar_");
+ xg_GtkSearchEntry__symbol = C_string_to_Xen_symbol("GtkSearchEntry_");
+ xg_GtkPopoverMenu__symbol = C_string_to_Xen_symbol("GtkPopoverMenu_");
+ xg_GtkStyleContext__symbol = C_string_to_Xen_symbol("GtkStyleContext_");
+ xg_GdkGLContext__symbol = C_string_to_Xen_symbol("GdkGLContext_");
+ xg_GtkGLArea__symbol = C_string_to_Xen_symbol("GtkGLArea_");
+ xg_GtkPropagationPhase_symbol = C_string_to_Xen_symbol("GtkPropagationPhase");
+ xg_GtkEventController__symbol = C_string_to_Xen_symbol("GtkEventController_");
+ xg_GtkGestureZoom__symbol = C_string_to_Xen_symbol("GtkGestureZoom_");
+ xg_GtkGestureSwipe__symbol = C_string_to_Xen_symbol("GtkGestureSwipe_");
+ xg_GtkGestureSingle__symbol = C_string_to_Xen_symbol("GtkGestureSingle_");
+ xg_GtkGestureRotate__symbol = C_string_to_Xen_symbol("GtkGestureRotate_");
+ xg_GtkGestureMultiPress__symbol = C_string_to_Xen_symbol("GtkGestureMultiPress_");
+ xg_GtkGesturePan__symbol = C_string_to_Xen_symbol("GtkGesturePan_");
+ xg_GtkGestureDrag__symbol = C_string_to_Xen_symbol("GtkGestureDrag_");
+ xg_GdkEventSequence__symbol = C_string_to_Xen_symbol("GdkEventSequence_");
+ xg_GtkEventSequenceState_symbol = C_string_to_Xen_symbol("GtkEventSequenceState");
+ xg_GtkGesture__symbol = C_string_to_Xen_symbol("GtkGesture_");
+ xg_GtkPopover__symbol = C_string_to_Xen_symbol("GtkPopover_");
+ xg_GtkActionBar__symbol = C_string_to_Xen_symbol("GtkActionBar_");
+ xg_GtkFlowBox__symbol = C_string_to_Xen_symbol("GtkFlowBox_");
+ xg_GtkFlowBoxChild__symbol = C_string_to_Xen_symbol("GtkFlowBoxChild_");
+ xg_GdkEventType_symbol = C_string_to_Xen_symbol("GdkEventType");
+ xg_GtkSearchBar__symbol = C_string_to_Xen_symbol("GtkSearchBar_");
+ xg_GtkListBox__symbol = C_string_to_Xen_symbol("GtkListBox_");
+ xg_GtkListBoxRow__symbol = C_string_to_Xen_symbol("GtkListBoxRow_");
+ xg_GtkHeaderBar__symbol = C_string_to_Xen_symbol("GtkHeaderBar_");
+ xg_GtkRevealerTransitionType_symbol = C_string_to_Xen_symbol("GtkRevealerTransitionType");
+ xg_GtkRevealer__symbol = C_string_to_Xen_symbol("GtkRevealer_");
+ xg_GtkStackTransitionType_symbol = C_string_to_Xen_symbol("GtkStackTransitionType");
+ xg_GtkStack__symbol = C_string_to_Xen_symbol("GtkStack_");
+ xg_GtkStackSwitcher__symbol = C_string_to_Xen_symbol("GtkStackSwitcher_");
+ xg_GtkPlacesSidebar__symbol = C_string_to_Xen_symbol("GtkPlacesSidebar_");
+ xg_GtkPlacesOpenFlags_symbol = C_string_to_Xen_symbol("GtkPlacesOpenFlags");
+ xg_GtkBaselinePosition_symbol = C_string_to_Xen_symbol("GtkBaselinePosition");
+ xg_GdkFullscreenMode_symbol = C_string_to_Xen_symbol("GdkFullscreenMode");
+ xg_GtkInputHints_symbol = C_string_to_Xen_symbol("GtkInputHints");
+ xg_GtkInputPurpose_symbol = C_string_to_Xen_symbol("GtkInputPurpose");
+ xg_GtkLevelBarMode_symbol = C_string_to_Xen_symbol("GtkLevelBarMode");
+ xg_GtkLevelBar__symbol = C_string_to_Xen_symbol("GtkLevelBar_");
+ xg_GtkMenuButton__symbol = C_string_to_Xen_symbol("GtkMenuButton_");
+ xg_GtkColorChooser__symbol = C_string_to_Xen_symbol("GtkColorChooser_");
+ xg_GtkApplicationWindow__symbol = C_string_to_Xen_symbol("GtkApplicationWindow_");
+ xg_GtkApplication__symbol = C_string_to_Xen_symbol("GtkApplication_");
+ xg_GMenuModel__symbol = C_string_to_Xen_symbol("GMenuModel_");
+ xg_guint___symbol = C_string_to_Xen_symbol("guint__");
+ xg_GdkModifierIntent_symbol = C_string_to_Xen_symbol("GdkModifierIntent");
+ xg_GtkFontChooser__symbol = C_string_to_Xen_symbol("GtkFontChooser_");
+ xg_GdkScrollDirection_symbol = C_string_to_Xen_symbol("GdkScrollDirection");
+ xg_GtkOverlay__symbol = C_string_to_Xen_symbol("GtkOverlay_");
+ xg_GtkWidgetPath__symbol = C_string_to_Xen_symbol("GtkWidgetPath_");
+ xg_GtkStateFlags_symbol = C_string_to_Xen_symbol("GtkStateFlags");
+ xg_GdkScreen___symbol = C_string_to_Xen_symbol("GdkScreen__");
+ xg_GtkToolShell__symbol = C_string_to_Xen_symbol("GtkToolShell_");
+ xg_GtkWindowGroup__symbol = C_string_to_Xen_symbol("GtkWindowGroup_");
+ xg_GtkInvisible__symbol = C_string_to_Xen_symbol("GtkInvisible_");
+ xg_GtkOrientable__symbol = C_string_to_Xen_symbol("GtkOrientable_");
+ xg_GtkCellArea__symbol = C_string_to_Xen_symbol("GtkCellArea_");
+ xg_GtkBorder__symbol = C_string_to_Xen_symbol("GtkBorder_");
+ xg_GtkSwitch__symbol = C_string_to_Xen_symbol("GtkSwitch_");
+ xg_GtkScrollablePolicy_symbol = C_string_to_Xen_symbol("GtkScrollablePolicy");
+ xg_GtkScrollable__symbol = C_string_to_Xen_symbol("GtkScrollable_");
+ xg_GtkGrid__symbol = C_string_to_Xen_symbol("GtkGrid_");
+ xg_GdkRGBA__symbol = C_string_to_Xen_symbol("GdkRGBA_");
+ xg_GtkComboBoxText__symbol = C_string_to_Xen_symbol("GtkComboBoxText_");
+ xg_GtkAlign_symbol = C_string_to_Xen_symbol("GtkAlign");
+ xg_GtkContainerClass__symbol = C_string_to_Xen_symbol("GtkContainerClass_");
+ xg_GtkSizeRequestMode_symbol = C_string_to_Xen_symbol("GtkSizeRequestMode");
+ xg_cairo_region_overlap_t_symbol = C_string_to_Xen_symbol("cairo_region_overlap_t");
+ xg_cairo_rectangle_int_t__symbol = C_string_to_Xen_symbol("cairo_rectangle_int_t_");
+ xg_double__symbol = C_string_to_Xen_symbol("double_");
+ xg_cairo_rectangle_t__symbol = C_string_to_Xen_symbol("cairo_rectangle_t_");
+ xg_cairo_device_t__symbol = C_string_to_Xen_symbol("cairo_device_t_");
+ xg_cairo_bool_t_symbol = C_string_to_Xen_symbol("cairo_bool_t");
+ xg_cairo_text_cluster_flags_t__symbol = C_string_to_Xen_symbol("cairo_text_cluster_flags_t_");
+ xg_cairo_text_cluster_t___symbol = C_string_to_Xen_symbol("cairo_text_cluster_t__");
+ xg_cairo_glyph_t___symbol = C_string_to_Xen_symbol("cairo_glyph_t__");
+ xg_cairo_text_cluster_flags_t_symbol = C_string_to_Xen_symbol("cairo_text_cluster_flags_t");
+ xg_cairo_text_cluster_t__symbol = C_string_to_Xen_symbol("cairo_text_cluster_t_");
+ xg_cairo_region_t__symbol = C_string_to_Xen_symbol("cairo_region_t_");
+ xg_GtkMessageDialog__symbol = C_string_to_Xen_symbol("GtkMessageDialog_");
+ xg_GdkDevice__symbol = C_string_to_Xen_symbol("GdkDevice_");
+ xg_GdkDeviceManager__symbol = C_string_to_Xen_symbol("GdkDeviceManager_");
+ xg_GtkAccessible__symbol = C_string_to_Xen_symbol("GtkAccessible_");
+ xg_GdkModifierType__symbol = C_string_to_Xen_symbol("GdkModifierType_");
+ xg_GtkToolPaletteDragTargets_symbol = C_string_to_Xen_symbol("GtkToolPaletteDragTargets");
+ xg_GtkToolItemGroup__symbol = C_string_to_Xen_symbol("GtkToolItemGroup_");
+ xg_GtkToolPalette__symbol = C_string_to_Xen_symbol("GtkToolPalette_");
+ xg_GtkSpinner__symbol = C_string_to_Xen_symbol("GtkSpinner_");
+ xg_GtkEntryBuffer__symbol = C_string_to_Xen_symbol("GtkEntryBuffer_");
+ xg_GtkMessageType_symbol = C_string_to_Xen_symbol("GtkMessageType");
+ xg_GtkInfoBar__symbol = C_string_to_Xen_symbol("GtkInfoBar_");
+ xg_GIcon__symbol = C_string_to_Xen_symbol("GIcon_");
+ xg_GtkEntryIconPosition_symbol = C_string_to_Xen_symbol("GtkEntryIconPosition");
+ xg_GFile__symbol = C_string_to_Xen_symbol("GFile_");
+ xg_GtkScaleButton__symbol = C_string_to_Xen_symbol("GtkScaleButton_");
+ xg_GtkCalendarDetailFunc_symbol = C_string_to_Xen_symbol("GtkCalendarDetailFunc");
+ xg_GtkTooltip__symbol = C_string_to_Xen_symbol("GtkTooltip_");
+ xg_cairo_rectangle_list_t__symbol = C_string_to_Xen_symbol("cairo_rectangle_list_t_");
+ xg_void__symbol = C_string_to_Xen_symbol("void_");
+ xg_cairo_filter_t_symbol = C_string_to_Xen_symbol("cairo_filter_t");
+ xg_cairo_extend_t_symbol = C_string_to_Xen_symbol("cairo_extend_t");
+ xg_cairo_format_t_symbol = C_string_to_Xen_symbol("cairo_format_t");
+ xg_cairo_path_t__symbol = C_string_to_Xen_symbol("cairo_path_t_");
+ xg_cairo_destroy_func_t_symbol = C_string_to_Xen_symbol("cairo_destroy_func_t");
+ xg_cairo_user_data_key_t__symbol = C_string_to_Xen_symbol("cairo_user_data_key_t_");
+ xg_cairo_text_extents_t__symbol = C_string_to_Xen_symbol("cairo_text_extents_t_");
+ xg_cairo_font_extents_t__symbol = C_string_to_Xen_symbol("cairo_font_extents_t_");
+ xg_cairo_font_face_t__symbol = C_string_to_Xen_symbol("cairo_font_face_t_");
+ xg_cairo_glyph_t__symbol = C_string_to_Xen_symbol("cairo_glyph_t_");
+ xg_cairo_scaled_font_t__symbol = C_string_to_Xen_symbol("cairo_scaled_font_t_");
+ xg_cairo_font_weight_t_symbol = C_string_to_Xen_symbol("cairo_font_weight_t");
+ xg_cairo_font_slant_t_symbol = C_string_to_Xen_symbol("cairo_font_slant_t");
+ xg_cairo_hint_metrics_t_symbol = C_string_to_Xen_symbol("cairo_hint_metrics_t");
+ xg_cairo_hint_style_t_symbol = C_string_to_Xen_symbol("cairo_hint_style_t");
+ xg_cairo_subpixel_order_t_symbol = C_string_to_Xen_symbol("cairo_subpixel_order_t");
+ xg_cairo_status_t_symbol = C_string_to_Xen_symbol("cairo_status_t");
+ xg_bool_symbol = C_string_to_Xen_symbol("bool");
+ xg_cairo_matrix_t__symbol = C_string_to_Xen_symbol("cairo_matrix_t_");
+ xg_cairo_line_join_t_symbol = C_string_to_Xen_symbol("cairo_line_join_t");
+ xg_cairo_line_cap_t_symbol = C_string_to_Xen_symbol("cairo_line_cap_t");
+ xg_cairo_fill_rule_t_symbol = C_string_to_Xen_symbol("cairo_fill_rule_t");
+ xg_cairo_antialias_t_symbol = C_string_to_Xen_symbol("cairo_antialias_t");
+ xg_cairo_operator_t_symbol = C_string_to_Xen_symbol("cairo_operator_t");
+ xg_cairo_pattern_t__symbol = C_string_to_Xen_symbol("cairo_pattern_t_");
+ xg_cairo_content_t_symbol = C_string_to_Xen_symbol("cairo_content_t");
+ xg_GtkPageSet_symbol = C_string_to_Xen_symbol("GtkPageSet");
+ xg_GtkPageRange__symbol = C_string_to_Xen_symbol("GtkPageRange_");
+ xg_GtkPrintPages_symbol = C_string_to_Xen_symbol("GtkPrintPages");
+ xg_GtkPrintQuality_symbol = C_string_to_Xen_symbol("GtkPrintQuality");
+ xg_GtkPrintDuplex_symbol = C_string_to_Xen_symbol("GtkPrintDuplex");
+ xg_GtkPaperSize__symbol = C_string_to_Xen_symbol("GtkPaperSize_");
+ xg_GtkPageOrientation_symbol = C_string_to_Xen_symbol("GtkPageOrientation");
+ xg_GtkPrintSettingsFunc_symbol = C_string_to_Xen_symbol("GtkPrintSettingsFunc");
+ xg_GtkPrintOperationPreview__symbol = C_string_to_Xen_symbol("GtkPrintOperationPreview_");
+ xg_GtkPageSetupDoneFunc_symbol = C_string_to_Xen_symbol("GtkPageSetupDoneFunc");
+ xg_GtkPrintStatus_symbol = C_string_to_Xen_symbol("GtkPrintStatus");
+ xg_GtkPrintOperationAction_symbol = C_string_to_Xen_symbol("GtkPrintOperationAction");
+ xg_GtkPrintOperationResult_symbol = C_string_to_Xen_symbol("GtkPrintOperationResult");
+ xg_GtkUnit_symbol = C_string_to_Xen_symbol("GtkUnit");
+ xg_GtkPrintSettings__symbol = C_string_to_Xen_symbol("GtkPrintSettings_");
+ xg_GtkPrintOperation__symbol = C_string_to_Xen_symbol("GtkPrintOperation_");
+ xg_GtkPageSetup__symbol = C_string_to_Xen_symbol("GtkPageSetup_");
+ xg_GtkPrintContext__symbol = C_string_to_Xen_symbol("GtkPrintContext_");
+ xg_cairo_surface_t__symbol = C_string_to_Xen_symbol("cairo_surface_t_");
+ xg_GtkTreeViewGridLines_symbol = C_string_to_Xen_symbol("GtkTreeViewGridLines");
+ xg_GtkRecentData__symbol = C_string_to_Xen_symbol("GtkRecentData_");
+ xg_GtkTextBufferDeserializeFunc_symbol = C_string_to_Xen_symbol("GtkTextBufferDeserializeFunc");
+ xg_GtkTextBufferSerializeFunc_symbol = C_string_to_Xen_symbol("GtkTextBufferSerializeFunc");
+ xg_time_t_symbol = C_string_to_Xen_symbol("time_t");
+ xg_GtkRecentChooserMenu__symbol = C_string_to_Xen_symbol("GtkRecentChooserMenu_");
+ xg_GtkRecentManager__symbol = C_string_to_Xen_symbol("GtkRecentManager_");
+ xg_GtkRecentFilter__symbol = C_string_to_Xen_symbol("GtkRecentFilter_");
+ xg_GtkRecentSortFunc_symbol = C_string_to_Xen_symbol("GtkRecentSortFunc");
+ xg_GtkRecentSortType_symbol = C_string_to_Xen_symbol("GtkRecentSortType");
+ xg_GtkRecentChooser__symbol = C_string_to_Xen_symbol("GtkRecentChooser_");
+ xg_GtkLinkButton__symbol = C_string_to_Xen_symbol("GtkLinkButton_");
+ xg_GtkAssistantPageType_symbol = C_string_to_Xen_symbol("GtkAssistantPageType");
+ xg_GtkAssistantPageFunc_symbol = C_string_to_Xen_symbol("GtkAssistantPageFunc");
+ xg_GtkAssistant__symbol = C_string_to_Xen_symbol("GtkAssistant_");
+ xg_GDestroyNotify_symbol = C_string_to_Xen_symbol("GDestroyNotify");
+ xg_GtkTreeViewSearchPositionFunc_symbol = C_string_to_Xen_symbol("GtkTreeViewSearchPositionFunc");
+ xg_GtkSensitivityType_symbol = C_string_to_Xen_symbol("GtkSensitivityType");
+ xg_GtkClipboardRichTextReceivedFunc_symbol = C_string_to_Xen_symbol("GtkClipboardRichTextReceivedFunc");
+ xg_GtkMenuBar__symbol = C_string_to_Xen_symbol("GtkMenuBar_");
+ xg_GtkPackDirection_symbol = C_string_to_Xen_symbol("GtkPackDirection");
+ xg_GtkIconViewDropPosition_symbol = C_string_to_Xen_symbol("GtkIconViewDropPosition");
+ xg_GValue__symbol = C_string_to_Xen_symbol("GValue_");
+ xg_GLogFunc_symbol = C_string_to_Xen_symbol("GLogFunc");
+ xg_PangoMatrix__symbol = C_string_to_Xen_symbol("PangoMatrix_");
+ xg_PangoRenderPart_symbol = C_string_to_Xen_symbol("PangoRenderPart");
+ xg_PangoRenderer__symbol = C_string_to_Xen_symbol("PangoRenderer_");
+ xg_GtkClipboardImageReceivedFunc_symbol = C_string_to_Xen_symbol("GtkClipboardImageReceivedFunc");
+ xg_GtkMenuToolButton__symbol = C_string_to_Xen_symbol("GtkMenuToolButton_");
+ xg_GtkFileChooserButton__symbol = C_string_to_Xen_symbol("GtkFileChooserButton_");
+ xg_PangoScriptIter__symbol = C_string_to_Xen_symbol("PangoScriptIter_");
+ xg_PangoScript_symbol = C_string_to_Xen_symbol("PangoScript");
+ xg_PangoAttrFilterFunc_symbol = C_string_to_Xen_symbol("PangoAttrFilterFunc");
+ xg_PangoEllipsizeMode_symbol = C_string_to_Xen_symbol("PangoEllipsizeMode");
+ xg_GtkIconViewForeachFunc_symbol = C_string_to_Xen_symbol("GtkIconViewForeachFunc");
+ xg_GtkAboutDialog__symbol = C_string_to_Xen_symbol("GtkAboutDialog_");
+ xg_GtkTreeViewRowSeparatorFunc_symbol = C_string_to_Xen_symbol("GtkTreeViewRowSeparatorFunc");
+ xg_GtkCellView__symbol = C_string_to_Xen_symbol("GtkCellView_");
+ xg_GtkAccelMap__symbol = C_string_to_Xen_symbol("GtkAccelMap_");
+ xg_GtkClipboardTargetsReceivedFunc_symbol = C_string_to_Xen_symbol("GtkClipboardTargetsReceivedFunc");
+ xg_GtkOrientation_symbol = C_string_to_Xen_symbol("GtkOrientation");
+ xg_GtkToolButton__symbol = C_string_to_Xen_symbol("GtkToolButton_");
+ xg_GtkIconLookupFlags_symbol = C_string_to_Xen_symbol("GtkIconLookupFlags");
+ xg_GtkIconInfo__symbol = C_string_to_Xen_symbol("GtkIconInfo_");
+ xg_GtkIconTheme__symbol = C_string_to_Xen_symbol("GtkIconTheme_");
+ xg_GtkFileChooser__symbol = C_string_to_Xen_symbol("GtkFileChooser_");
+ xg_GtkCellLayoutDataFunc_symbol = C_string_to_Xen_symbol("GtkCellLayoutDataFunc");
+ xg_GtkCellLayout__symbol = C_string_to_Xen_symbol("GtkCellLayout_");
+ xg_GtkFileFilterFunc_symbol = C_string_to_Xen_symbol("GtkFileFilterFunc");
+ xg_GtkFileFilterFlags_symbol = C_string_to_Xen_symbol("GtkFileFilterFlags");
+ xg_GtkFileFilter__symbol = C_string_to_Xen_symbol("GtkFileFilter_");
+ xg_GSourceFunc_symbol = C_string_to_Xen_symbol("GSourceFunc");
+ xg_GtkToggleToolButton__symbol = C_string_to_Xen_symbol("GtkToggleToolButton_");
+ xg_GtkSeparatorToolItem__symbol = C_string_to_Xen_symbol("GtkSeparatorToolItem_");
+ xg_GtkRadioToolButton__symbol = C_string_to_Xen_symbol("GtkRadioToolButton_");
+ xg_GtkEntryCompletionMatchFunc_symbol = C_string_to_Xen_symbol("GtkEntryCompletionMatchFunc");
+ xg_GtkFontButton__symbol = C_string_to_Xen_symbol("GtkFontButton_");
+ xg_GtkExpander__symbol = C_string_to_Xen_symbol("GtkExpander_");
+ xg_GtkComboBox__symbol = C_string_to_Xen_symbol("GtkComboBox_");
+ xg_GtkTreeModelFilter__symbol = C_string_to_Xen_symbol("GtkTreeModelFilter_");
+ xg_GtkFileChooserAction_symbol = C_string_to_Xen_symbol("GtkFileChooserAction");
+ xg_GtkToolItem__symbol = C_string_to_Xen_symbol("GtkToolItem_");
+ xg_GtkEventBox__symbol = C_string_to_Xen_symbol("GtkEventBox_");
+ xg_GtkCalendarDisplayOptions_symbol = C_string_to_Xen_symbol("GtkCalendarDisplayOptions");
+ xg_GdkScreen__symbol = C_string_to_Xen_symbol("GdkScreen_");
+ xg_PangoLayoutRun__symbol = C_string_to_Xen_symbol("PangoLayoutRun_");
+ xg_PangoLayoutIter__symbol = C_string_to_Xen_symbol("PangoLayoutIter_");
+ xg_PangoLayoutLine__symbol = C_string_to_Xen_symbol("PangoLayoutLine_");
+ xg_int__symbol = C_string_to_Xen_symbol("int_");
+ xg_PangoAlignment_symbol = C_string_to_Xen_symbol("PangoAlignment");
+ xg_PangoWrapMode_symbol = C_string_to_Xen_symbol("PangoWrapMode");
+ xg_PangoItem__symbol = C_string_to_Xen_symbol("PangoItem_");
+ xg_PangoGlyphString__symbol = C_string_to_Xen_symbol("PangoGlyphString_");
+ xg_PangoFontMap__symbol = C_string_to_Xen_symbol("PangoFontMap_");
+ xg_PangoGlyph_symbol = C_string_to_Xen_symbol("PangoGlyph");
+ xg_PangoFontFace__symbol = C_string_to_Xen_symbol("PangoFontFace_");
+ xg_PangoFontFace___symbol = C_string_to_Xen_symbol("PangoFontFace__");
+ xg_PangoFontFamily__symbol = C_string_to_Xen_symbol("PangoFontFamily_");
+ xg_PangoFontMask_symbol = C_string_to_Xen_symbol("PangoFontMask");
+ xg_PangoFontDescription___symbol = C_string_to_Xen_symbol("PangoFontDescription__");
+ xg_PangoCoverageLevel_symbol = C_string_to_Xen_symbol("PangoCoverageLevel");
+ xg_PangoCoverage__symbol = C_string_to_Xen_symbol("PangoCoverage_");
+ xg_PangoFontMetrics__symbol = C_string_to_Xen_symbol("PangoFontMetrics_");
+ xg_PangoFontset__symbol = C_string_to_Xen_symbol("PangoFontset_");
+ xg_PangoFont__symbol = C_string_to_Xen_symbol("PangoFont_");
+ xg_PangoFontFamily___symbol = C_string_to_Xen_symbol("PangoFontFamily__");
+ xg_PangoLogAttr__symbol = C_string_to_Xen_symbol("PangoLogAttr_");
+ xg_PangoAnalysis__symbol = C_string_to_Xen_symbol("PangoAnalysis_");
+ xg_PangoAttrList___symbol = C_string_to_Xen_symbol("PangoAttrList__");
+ xg_PangoAttrIterator__symbol = C_string_to_Xen_symbol("PangoAttrIterator_");
+ xg_PangoRectangle__symbol = C_string_to_Xen_symbol("PangoRectangle_");
+ xg_PangoUnderline_symbol = C_string_to_Xen_symbol("PangoUnderline");
+ xg_PangoStretch_symbol = C_string_to_Xen_symbol("PangoStretch");
+ xg_PangoVariant_symbol = C_string_to_Xen_symbol("PangoVariant");
+ xg_PangoWeight_symbol = C_string_to_Xen_symbol("PangoWeight");
+ xg_PangoStyle_symbol = C_string_to_Xen_symbol("PangoStyle");
+ xg_guint16_symbol = C_string_to_Xen_symbol("guint16");
+ xg_PangoAttribute__symbol = C_string_to_Xen_symbol("PangoAttribute_");
+ xg_PangoAttrType_symbol = C_string_to_Xen_symbol("PangoAttrType");
+ xg_PangoColor__symbol = C_string_to_Xen_symbol("PangoColor_");
+ xg_GdkGravity_symbol = C_string_to_Xen_symbol("GdkGravity");
+ xg_GtkWindowPosition_symbol = C_string_to_Xen_symbol("GtkWindowPosition");
+ xg_GtkWindowType_symbol = C_string_to_Xen_symbol("GtkWindowType");
+ xg_GtkWindow__symbol = C_string_to_Xen_symbol("GtkWindow_");
+ xg_GtkTextDirection_symbol = C_string_to_Xen_symbol("GtkTextDirection");
+ xg_AtkObject__symbol = C_string_to_Xen_symbol("AtkObject_");
+ xg_GtkDirectionType_symbol = C_string_to_Xen_symbol("GtkDirectionType");
+ xg_GtkAllocation__symbol = C_string_to_Xen_symbol("GtkAllocation_");
+ xg_GtkViewport__symbol = C_string_to_Xen_symbol("GtkViewport_");
+ xg_GtkTreeViewSearchEqualFunc_symbol = C_string_to_Xen_symbol("GtkTreeViewSearchEqualFunc");
+ xg_GtkTreeViewDropPosition_symbol = C_string_to_Xen_symbol("GtkTreeViewDropPosition");
+ xg_GtkTreeViewMappingFunc_symbol = C_string_to_Xen_symbol("GtkTreeViewMappingFunc");
+ xg_GtkTreeViewColumnDropFunc_symbol = C_string_to_Xen_symbol("GtkTreeViewColumnDropFunc");
+ xg_GtkTreeViewColumnSizing_symbol = C_string_to_Xen_symbol("GtkTreeViewColumnSizing");
+ xg_GtkTreeCellDataFunc_symbol = C_string_to_Xen_symbol("GtkTreeCellDataFunc");
+ xg_GtkTreeStore__symbol = C_string_to_Xen_symbol("GtkTreeStore_");
+ xg_GtkTreeIterCompareFunc_symbol = C_string_to_Xen_symbol("GtkTreeIterCompareFunc");
+ xg_GtkSortType_symbol = C_string_to_Xen_symbol("GtkSortType");
+ xg_GtkTreeSortable__symbol = C_string_to_Xen_symbol("GtkTreeSortable_");
+ xg_GtkTreeSelectionForeachFunc_symbol = C_string_to_Xen_symbol("GtkTreeSelectionForeachFunc");
+ xg_GtkTreeModel___symbol = C_string_to_Xen_symbol("GtkTreeModel__");
+ xg_GtkTreeSelectionFunc_symbol = C_string_to_Xen_symbol("GtkTreeSelectionFunc");
+ xg_GtkSelectionMode_symbol = C_string_to_Xen_symbol("GtkSelectionMode");
+ xg_GtkTreeModelSort__symbol = C_string_to_Xen_symbol("GtkTreeModelSort_");
+ xg_GtkTreeModelForeachFunc_symbol = C_string_to_Xen_symbol("GtkTreeModelForeachFunc");
+ xg_GtkTreeModelFlags_symbol = C_string_to_Xen_symbol("GtkTreeModelFlags");
+ xg_GtkTreeRowReference__symbol = C_string_to_Xen_symbol("GtkTreeRowReference_");
+ xg_GtkTreeDragDest__symbol = C_string_to_Xen_symbol("GtkTreeDragDest_");
+ xg_GtkTreeDragSource__symbol = C_string_to_Xen_symbol("GtkTreeDragSource_");
+ xg_GtkToolbarStyle_symbol = C_string_to_Xen_symbol("GtkToolbarStyle");
+ xg_GtkToolbar__symbol = C_string_to_Xen_symbol("GtkToolbar_");
+ xg_GtkToggleButton__symbol = C_string_to_Xen_symbol("GtkToggleButton_");
+ xg_PangoTabArray__symbol = C_string_to_Xen_symbol("PangoTabArray_");
+ xg_GtkWrapMode_symbol = C_string_to_Xen_symbol("GtkWrapMode");
+ xg_GtkTextWindowType_symbol = C_string_to_Xen_symbol("GtkTextWindowType");
+ xg_GtkTextView__symbol = C_string_to_Xen_symbol("GtkTextView_");
+ xg_GtkTextTagTableForeach_symbol = C_string_to_Xen_symbol("GtkTextTagTableForeach");
+ xg_GtkTextSearchFlags_symbol = C_string_to_Xen_symbol("GtkTextSearchFlags");
+ xg_GtkTextCharPredicate_symbol = C_string_to_Xen_symbol("GtkTextCharPredicate");
+ xg_GtkTextAttributes__symbol = C_string_to_Xen_symbol("GtkTextAttributes_");
+ xg_GtkTextMark__symbol = C_string_to_Xen_symbol("GtkTextMark_");
+ xg_GtkTextChildAnchor__symbol = C_string_to_Xen_symbol("GtkTextChildAnchor_");
+ xg_GtkTextIter__symbol = C_string_to_Xen_symbol("GtkTextIter_");
+ xg_GtkTextTagTable__symbol = C_string_to_Xen_symbol("GtkTextTagTable_");
+ xg_GtkTextBuffer__symbol = C_string_to_Xen_symbol("GtkTextBuffer_");
+ xg_GtkStatusbar__symbol = C_string_to_Xen_symbol("GtkStatusbar_");
+ xg_GtkSpinType_symbol = C_string_to_Xen_symbol("GtkSpinType");
+ xg_GtkSpinButtonUpdatePolicy_symbol = C_string_to_Xen_symbol("GtkSpinButtonUpdatePolicy");
+ xg_GtkSpinButton__symbol = C_string_to_Xen_symbol("GtkSpinButton_");
+ xg_GtkSizeGroupMode_symbol = C_string_to_Xen_symbol("GtkSizeGroupMode");
+ xg_GtkSizeGroup__symbol = C_string_to_Xen_symbol("GtkSizeGroup_");
+ xg_GtkSettings__symbol = C_string_to_Xen_symbol("GtkSettings_");
+ xg_GtkCornerType_symbol = C_string_to_Xen_symbol("GtkCornerType");
+ xg_GtkPolicyType_symbol = C_string_to_Xen_symbol("GtkPolicyType");
+ xg_GtkScrolledWindow__symbol = C_string_to_Xen_symbol("GtkScrolledWindow_");
+ xg_GtkScale__symbol = C_string_to_Xen_symbol("GtkScale_");
+ xg_GtkRange__symbol = C_string_to_Xen_symbol("GtkRange_");
+ xg_GtkRadioMenuItem__symbol = C_string_to_Xen_symbol("GtkRadioMenuItem_");
+ xg_GtkRadioButton__symbol = C_string_to_Xen_symbol("GtkRadioButton_");
+ xg_GtkProgressBar__symbol = C_string_to_Xen_symbol("GtkProgressBar_");
+ xg_GtkPaned__symbol = C_string_to_Xen_symbol("GtkPaned_");
+ xg_GtkPositionType_symbol = C_string_to_Xen_symbol("GtkPositionType");
+ xg_GtkNotebook__symbol = C_string_to_Xen_symbol("GtkNotebook_");
+ xg_GtkMenuShell__symbol = C_string_to_Xen_symbol("GtkMenuShell_");
+ xg_GtkMenuItem__symbol = C_string_to_Xen_symbol("GtkMenuItem_");
+ xg_GtkMenuPositionFunc_symbol = C_string_to_Xen_symbol("GtkMenuPositionFunc");
+ xg_PangoLanguage__symbol = C_string_to_Xen_symbol("PangoLanguage_");
+ xg_GtkListStore__symbol = C_string_to_Xen_symbol("GtkListStore_");
+ xg_GtkLayout__symbol = C_string_to_Xen_symbol("GtkLayout_");
+ xg_GtkJustification_symbol = C_string_to_Xen_symbol("GtkJustification");
+ xg_GtkLabel__symbol = C_string_to_Xen_symbol("GtkLabel_");
+ xg_guint16__symbol = C_string_to_Xen_symbol("guint16_");
+ xg_GtkIMContextSimple__symbol = C_string_to_Xen_symbol("GtkIMContextSimple_");
+ xg_GdkEventKey__symbol = C_string_to_Xen_symbol("GdkEventKey_");
+ xg_PangoAttrList__symbol = C_string_to_Xen_symbol("PangoAttrList_");
+ xg_GtkIMContext__symbol = C_string_to_Xen_symbol("GtkIMContext_");
+ xg_GtkImageType_symbol = C_string_to_Xen_symbol("GtkImageType");
+ xg_GtkImage__symbol = C_string_to_Xen_symbol("GtkImage_");
+ xg_GtkShadowType_symbol = C_string_to_Xen_symbol("GtkShadowType");
+ xg_GtkFrame__symbol = C_string_to_Xen_symbol("GtkFrame_");
+ xg_GtkFixed__symbol = C_string_to_Xen_symbol("GtkFixed_");
+ xg_PangoLayout__symbol = C_string_to_Xen_symbol("PangoLayout_");
+ xg_GtkEntry__symbol = C_string_to_Xen_symbol("GtkEntry_");
+ xg_GtkEditable__symbol = C_string_to_Xen_symbol("GtkEditable_");
+ xg_GtkTargetList__symbol = C_string_to_Xen_symbol("GtkTargetList_");
+ xg_GtkDestDefaults_symbol = C_string_to_Xen_symbol("GtkDestDefaults");
+ xg_etc_symbol = C_string_to_Xen_symbol("etc");
+ xg_GtkDialog__symbol = C_string_to_Xen_symbol("GtkDialog_");
+ xg_GtkCallback_symbol = C_string_to_Xen_symbol("GtkCallback");
+ xg_GtkContainer__symbol = C_string_to_Xen_symbol("GtkContainer_");
+ xg_GtkClipboardTextReceivedFunc_symbol = C_string_to_Xen_symbol("GtkClipboardTextReceivedFunc");
+ xg_GtkClipboardReceivedFunc_symbol = C_string_to_Xen_symbol("GtkClipboardReceivedFunc");
+ xg_GtkClipboardClearFunc_symbol = C_string_to_Xen_symbol("GtkClipboardClearFunc");
+ xg_GtkClipboardGetFunc_symbol = C_string_to_Xen_symbol("GtkClipboardGetFunc");
+ xg_GtkTargetEntry__symbol = C_string_to_Xen_symbol("GtkTargetEntry_");
+ xg_GtkCheckMenuItem__symbol = C_string_to_Xen_symbol("GtkCheckMenuItem_");
+ xg_GtkCellRendererToggle__symbol = C_string_to_Xen_symbol("GtkCellRendererToggle_");
+ xg_GtkCellRendererText__symbol = C_string_to_Xen_symbol("GtkCellRendererText_");
+ xg_GtkCellRendererState_symbol = C_string_to_Xen_symbol("GtkCellRendererState");
+ xg_GtkCellEditable__symbol = C_string_to_Xen_symbol("GtkCellEditable_");
+ xg_GtkCalendar__symbol = C_string_to_Xen_symbol("GtkCalendar_");
+ xg_GtkReliefStyle_symbol = C_string_to_Xen_symbol("GtkReliefStyle");
+ xg_GtkButton__symbol = C_string_to_Xen_symbol("GtkButton_");
+ xg_GtkPackType_symbol = C_string_to_Xen_symbol("GtkPackType");
+ xg_GtkBox__symbol = C_string_to_Xen_symbol("GtkBox_");
+ xg_GtkBin__symbol = C_string_to_Xen_symbol("GtkBin_");
+ xg_GtkBindingSet__symbol = C_string_to_Xen_symbol("GtkBindingSet_");
+ xg_GtkButtonBox__symbol = C_string_to_Xen_symbol("GtkButtonBox_");
+ xg_GtkButtonBoxStyle_symbol = C_string_to_Xen_symbol("GtkButtonBoxStyle");
+ xg_GtkAspectFrame__symbol = C_string_to_Xen_symbol("GtkAspectFrame_");
+ xg_GtkAdjustment__symbol = C_string_to_Xen_symbol("GtkAdjustment_");
+ xg_GtkAccelMapForeach_symbol = C_string_to_Xen_symbol("GtkAccelMapForeach");
+ xg_GtkAccelLabel__symbol = C_string_to_Xen_symbol("GtkAccelLabel_");
+ xg_GtkAccelGroupEntry__symbol = C_string_to_Xen_symbol("GtkAccelGroupEntry_");
+ xg_lambda3_symbol = C_string_to_Xen_symbol("lambda3");
+ xg_GSList__symbol = C_string_to_Xen_symbol("GSList_");
+ xg_GObject__symbol = C_string_to_Xen_symbol("GObject_");
+ xg_GtkAccelFlags_symbol = C_string_to_Xen_symbol("GtkAccelFlags");
+ xg_GtkAccelGroup__symbol = C_string_to_Xen_symbol("GtkAccelGroup_");
+ xg_GTimeVal__symbol = C_string_to_Xen_symbol("GTimeVal_");
+ xg_GdkPixbufAnimationIter__symbol = C_string_to_Xen_symbol("GdkPixbufAnimationIter_");
+ xg_GdkPixbufAnimation__symbol = C_string_to_Xen_symbol("GdkPixbufAnimation_");
+ xg_GdkInterpType_symbol = C_string_to_Xen_symbol("GdkInterpType");
+ xg_double_symbol = C_string_to_Xen_symbol("double");
+ xg_gfloat_symbol = C_string_to_Xen_symbol("gfloat");
+ xg_guchar_symbol = C_string_to_Xen_symbol("guchar");
+ xg_char___symbol = C_string_to_Xen_symbol("char__");
+ xg_GdkPixbufDestroyNotify_symbol = C_string_to_Xen_symbol("GdkPixbufDestroyNotify");
+ xg_GError__symbol = C_string_to_Xen_symbol("GError_");
+ xg_int_symbol = C_string_to_Xen_symbol("int");
+ xg_GdkColorspace_symbol = C_string_to_Xen_symbol("GdkColorspace");
+ xg_GdkWindowTypeHint_symbol = C_string_to_Xen_symbol("GdkWindowTypeHint");
+ xg_GdkWindowHints_symbol = C_string_to_Xen_symbol("GdkWindowHints");
+ xg_GdkGeometry__symbol = C_string_to_Xen_symbol("GdkGeometry_");
+ xg_GdkWindowEdge_symbol = C_string_to_Xen_symbol("GdkWindowEdge");
+ xg_GdkWMFunction_symbol = C_string_to_Xen_symbol("GdkWMFunction");
+ xg_GdkWMDecoration_symbol = C_string_to_Xen_symbol("GdkWMDecoration");
+ xg_GdkEventMask_symbol = C_string_to_Xen_symbol("GdkEventMask");
+ xg_GdkWindowState_symbol = C_string_to_Xen_symbol("GdkWindowState");
+ xg_GdkFilterFunc_symbol = C_string_to_Xen_symbol("GdkFilterFunc");
+ xg_GdkWindowType_symbol = C_string_to_Xen_symbol("GdkWindowType");
+ xg_GdkWindowAttr__symbol = C_string_to_Xen_symbol("GdkWindowAttr_");
+ xg_GdkVisualType__symbol = C_string_to_Xen_symbol("GdkVisualType_");
+ xg_gint__symbol = C_string_to_Xen_symbol("gint_");
+ xg_GdkVisualType_symbol = C_string_to_Xen_symbol("GdkVisualType");
+ xg_GdkPropMode_symbol = C_string_to_Xen_symbol("GdkPropMode");
+ xg_guchar__symbol = C_string_to_Xen_symbol("guchar_");
+ xg_PangoContext__symbol = C_string_to_Xen_symbol("PangoContext_");
+ xg_PangoDirection_symbol = C_string_to_Xen_symbol("PangoDirection");
+ xg_GdkKeymapKey__symbol = C_string_to_Xen_symbol("GdkKeymapKey_");
+ xg_GdkKeymap__symbol = C_string_to_Xen_symbol("GdkKeymap_");
+ xg_GdkRectangle__symbol = C_string_to_Xen_symbol("GdkRectangle_");
+ xg_char__symbol = C_string_to_Xen_symbol("char_");
+ xg_gchar___symbol = C_string_to_Xen_symbol("gchar__");
+ xg_GdkEventFunc_symbol = C_string_to_Xen_symbol("GdkEventFunc");
+ xg_gdouble_symbol = C_string_to_Xen_symbol("gdouble");
+ xg_GList__symbol = C_string_to_Xen_symbol("GList_");
+ xg_GdkWindow__symbol = C_string_to_Xen_symbol("GdkWindow_");
+ xg_guint32_symbol = C_string_to_Xen_symbol("guint32");
+ xg_GdkDragAction_symbol = C_string_to_Xen_symbol("GdkDragAction");
+ xg_GdkDragContext__symbol = C_string_to_Xen_symbol("GdkDragContext_");
+ xg_GdkCursorType_symbol = C_string_to_Xen_symbol("GdkCursorType");
+ xg_GdkDisplay__symbol = C_string_to_Xen_symbol("GdkDisplay_");
+ xg_GdkCursor__symbol = C_string_to_Xen_symbol("GdkCursor_");
+ xg_GdkVisual__symbol = C_string_to_Xen_symbol("GdkVisual_");
+ xg_GSignalMatchType_symbol = C_string_to_Xen_symbol("GSignalMatchType");
+ xg_GConnectFlags_symbol = C_string_to_Xen_symbol("GConnectFlags");
+ xg_GtkDestroyNotify_symbol = C_string_to_Xen_symbol("GtkDestroyNotify");
+ xg_GSignalEmissionHook_symbol = C_string_to_Xen_symbol("GSignalEmissionHook");
+ xg_gulong_symbol = C_string_to_Xen_symbol("gulong");
+ xg_GSignalInvocationHint__symbol = C_string_to_Xen_symbol("GSignalInvocationHint_");
+ xg_GQuark_symbol = C_string_to_Xen_symbol("GQuark");
+ xg_guint__symbol = C_string_to_Xen_symbol("guint_");
+ xg_GSignalQuery__symbol = C_string_to_Xen_symbol("GSignalQuery_");
+ xg_GType__symbol = C_string_to_Xen_symbol("GType_");
+ xg_GSignalCMarshaller_symbol = C_string_to_Xen_symbol("GSignalCMarshaller");
+ xg_gpointer_symbol = C_string_to_Xen_symbol("gpointer");
+ xg_GSignalAccumulator_symbol = C_string_to_Xen_symbol("GSignalAccumulator");
+ xg_GSignalFlags_symbol = C_string_to_Xen_symbol("GSignalFlags");
+ xg_GType_symbol = C_string_to_Xen_symbol("GType");
+ xg_GClosureNotify_symbol = C_string_to_Xen_symbol("GClosureNotify");
+ xg_GCallback_symbol = C_string_to_Xen_symbol("GCallback");
+ xg_GNormalizeMode_symbol = C_string_to_Xen_symbol("GNormalizeMode");
+ xg_glong_symbol = C_string_to_Xen_symbol("glong");
+ xg_gssize_symbol = C_string_to_Xen_symbol("gssize");
+ xg_gunichar__symbol = C_string_to_Xen_symbol("gunichar_");
+ xg_void_symbol = C_string_to_Xen_symbol("void");
+ xg_GtkRecentInfo__symbol = C_string_to_Xen_symbol("GtkRecentInfo_");
+ xg_gsize_symbol = C_string_to_Xen_symbol("gsize");
+ xg_guint8__symbol = C_string_to_Xen_symbol("guint8_");
+ xg_GdkAtom_symbol = C_string_to_Xen_symbol("GdkAtom");
+ xg_GLogLevelFlags_symbol = C_string_to_Xen_symbol("GLogLevelFlags");
+ xg_GdkPixbuf__symbol = C_string_to_Xen_symbol("GdkPixbuf_");
+ xg_GtkIconView__symbol = C_string_to_Xen_symbol("GtkIconView_");
+ xg_GtkEntryCompletion__symbol = C_string_to_Xen_symbol("GtkEntryCompletion_");
+ xg_GtkFileFilterInfo__symbol = C_string_to_Xen_symbol("GtkFileFilterInfo_");
+ xg_GtkTreeSelection__symbol = C_string_to_Xen_symbol("GtkTreeSelection_");
+ xg_GtkCellRenderer__symbol = C_string_to_Xen_symbol("GtkCellRenderer_");
+ xg_GtkTreeViewColumn__symbol = C_string_to_Xen_symbol("GtkTreeViewColumn_");
+ xg_GtkTreeView__symbol = C_string_to_Xen_symbol("GtkTreeView_");
+ xg_gunichar_symbol = C_string_to_Xen_symbol("gunichar");
+ xg_GdkAtom__symbol = C_string_to_Xen_symbol("GdkAtom_");
+ xg_GtkSelectionData__symbol = C_string_to_Xen_symbol("GtkSelectionData_");
+ xg_GtkClipboard__symbol = C_string_to_Xen_symbol("GtkClipboard_");
+ xg_GtkTreeIter__symbol = C_string_to_Xen_symbol("GtkTreeIter_");
+ xg_GtkTreePath__symbol = C_string_to_Xen_symbol("GtkTreePath_");
+ xg_GtkTreeModel__symbol = C_string_to_Xen_symbol("GtkTreeModel_");
+ xg_GdkModifierType_symbol = C_string_to_Xen_symbol("GdkModifierType");
+ xg_guint_symbol = C_string_to_Xen_symbol("guint");
+ xg_gchar__symbol = C_string_to_Xen_symbol("gchar_");
+ xg_GtkTextTag__symbol = C_string_to_Xen_symbol("GtkTextTag_");
+ xg_gboolean_symbol = C_string_to_Xen_symbol("gboolean");
+ xg_gint_symbol = C_string_to_Xen_symbol("gint");
+ xg_GtkMenu__symbol = C_string_to_Xen_symbol("GtkMenu_");
+ xg_GdkXEvent__symbol = C_string_to_Xen_symbol("GdkXEvent_");
+ xg_GtkWidget__symbol = C_string_to_Xen_symbol("GtkWidget_");
+ xg_lambda_data_symbol = C_string_to_Xen_symbol("lambda_data");
+ xg_GClosure__symbol = C_string_to_Xen_symbol("GClosure_");
+ xg_GtkAccelKey__symbol = C_string_to_Xen_symbol("GtkAccelKey_");
+ xg_GdkEventMotion__symbol = C_string_to_Xen_symbol("GdkEventMotion_");
+ xg_gdouble__symbol = C_string_to_Xen_symbol("gdouble_");
+ xg_GdkEventAny__symbol = C_string_to_Xen_symbol("GdkEventAny_");
+ xg_GdkEvent__symbol = C_string_to_Xen_symbol("GdkEvent_");
+ xg_cairo_t__symbol = C_string_to_Xen_symbol("cairo_t_");
+ xg_cairo_font_options_t__symbol = C_string_to_Xen_symbol("cairo_font_options_t_");
+ xg_PangoFontDescription__symbol = C_string_to_Xen_symbol("PangoFontDescription_");
+ xg_idler_symbol = C_string_to_Xen_symbol("idler");
+ xg_GtkCellRendererPixbuf__symbol = C_string_to_Xen_symbol("GtkCellRendererPixbuf_");
+ xg_GtkCheckButton__symbol = C_string_to_Xen_symbol("GtkCheckButton_");
+ xg_GtkDrawingArea__symbol = C_string_to_Xen_symbol("GtkDrawingArea_");
+ xg_GtkScrollbar__symbol = C_string_to_Xen_symbol("GtkScrollbar_");
+ xg_GtkSeparator__symbol = C_string_to_Xen_symbol("GtkSeparator_");
+ xg_GtkSeparatorMenuItem__symbol = C_string_to_Xen_symbol("GtkSeparatorMenuItem_");
+ xg_GdkEventExpose__symbol = C_string_to_Xen_symbol("GdkEventExpose_");
+ xg_GdkEventNoExpose__symbol = C_string_to_Xen_symbol("GdkEventNoExpose_");
+ xg_GdkEventVisibility__symbol = C_string_to_Xen_symbol("GdkEventVisibility_");
+ xg_GdkEventButton__symbol = C_string_to_Xen_symbol("GdkEventButton_");
+ xg_GdkEventScroll__symbol = C_string_to_Xen_symbol("GdkEventScroll_");
+ xg_GdkEventCrossing__symbol = C_string_to_Xen_symbol("GdkEventCrossing_");
+ xg_GdkEventFocus__symbol = C_string_to_Xen_symbol("GdkEventFocus_");
+ xg_GdkEventConfigure__symbol = C_string_to_Xen_symbol("GdkEventConfigure_");
+ xg_GdkEventProperty__symbol = C_string_to_Xen_symbol("GdkEventProperty_");
+ xg_GdkEventSelection__symbol = C_string_to_Xen_symbol("GdkEventSelection_");
+ xg_GdkEventProximity__symbol = C_string_to_Xen_symbol("GdkEventProximity_");
+ xg_GdkEventSetting__symbol = C_string_to_Xen_symbol("GdkEventSetting_");
+ xg_GdkEventWindowState__symbol = C_string_to_Xen_symbol("GdkEventWindowState_");
+ xg_GdkEventDND__symbol = C_string_to_Xen_symbol("GdkEventDND_");
+ xg_GtkFileChooserDialog__symbol = C_string_to_Xen_symbol("GtkFileChooserDialog_");
+ xg_GtkFileChooserWidget__symbol = C_string_to_Xen_symbol("GtkFileChooserWidget_");
+ xg_GtkColorButton__symbol = C_string_to_Xen_symbol("GtkColorButton_");
+ xg_GtkAccelMap_symbol = C_string_to_Xen_symbol("GtkAccelMap");
+ xg_GtkCellRendererCombo__symbol = C_string_to_Xen_symbol("GtkCellRendererCombo_");
+ xg_GtkCellRendererProgress__symbol = C_string_to_Xen_symbol("GtkCellRendererProgress_");
+ xg_GtkCellRendererAccel__symbol = C_string_to_Xen_symbol("GtkCellRendererAccel_");
+ xg_GtkCellRendererSpin__symbol = C_string_to_Xen_symbol("GtkCellRendererSpin_");
+ xg_GtkRecentChooserDialog__symbol = C_string_to_Xen_symbol("GtkRecentChooserDialog_");
+ xg_GtkRecentChooserWidget__symbol = C_string_to_Xen_symbol("GtkRecentChooserWidget_");
+ xg_GtkCellRendererSpinner__symbol = C_string_to_Xen_symbol("GtkCellRendererSpinner_");
+ xg_gboolean__symbol = C_string_to_Xen_symbol("gboolean_");
+ xg_GtkFontChooserDialog__symbol = C_string_to_Xen_symbol("GtkFontChooserDialog_");
+ xg_GtkFontChooserWidget__symbol = C_string_to_Xen_symbol("GtkFontChooserWidget_");
+ xg_GtkColorChooserDialog__symbol = C_string_to_Xen_symbol("GtkColorChooserDialog_");
+ xg_GtkColorChooserWidget__symbol = C_string_to_Xen_symbol("GtkColorChooserWidget_");
+ xg_GtkColorWidget__symbol = C_string_to_Xen_symbol("GtkColorWidget_");
+ xg_GtkGestureLongPress__symbol = C_string_to_Xen_symbol("GtkGestureLongPress_");
}
/* -------------------------------- strings -------------------------------- */
@@ -48870,156 +45677,44 @@ static void define_atoms(void)
static void define_strings(void)
{
-#if HAVE_SCHEME
- #define DEFINE_STRING(Name) s7_define_constant(s7, XG_PRE #Name XG_POST, s7_make_permanent_string(Name))
-#else
- #define DEFINE_STRING(Name) XEN_DEFINE(XG_PRE #Name XG_POST, C_TO_XEN_STRING(Name))
-#endif
- DEFINE_STRING(GTK_STOCK_DIALOG_INFO);
- DEFINE_STRING(GTK_STOCK_DIALOG_WARNING);
- DEFINE_STRING(GTK_STOCK_DIALOG_ERROR);
- DEFINE_STRING(GTK_STOCK_DIALOG_QUESTION);
- DEFINE_STRING(GTK_STOCK_DND);
- DEFINE_STRING(GTK_STOCK_DND_MULTIPLE);
- DEFINE_STRING(GTK_STOCK_ADD);
- DEFINE_STRING(GTK_STOCK_APPLY);
- DEFINE_STRING(GTK_STOCK_BOLD);
- DEFINE_STRING(GTK_STOCK_CANCEL);
- DEFINE_STRING(GTK_STOCK_CDROM);
- DEFINE_STRING(GTK_STOCK_CLEAR);
- DEFINE_STRING(GTK_STOCK_CLOSE);
- DEFINE_STRING(GTK_STOCK_COLOR_PICKER);
- DEFINE_STRING(GTK_STOCK_CONVERT);
- DEFINE_STRING(GTK_STOCK_COPY);
- DEFINE_STRING(GTK_STOCK_CUT);
- DEFINE_STRING(GTK_STOCK_DELETE);
- DEFINE_STRING(GTK_STOCK_EXECUTE);
- DEFINE_STRING(GTK_STOCK_FIND);
- DEFINE_STRING(GTK_STOCK_FIND_AND_REPLACE);
- DEFINE_STRING(GTK_STOCK_FLOPPY);
- DEFINE_STRING(GTK_STOCK_GOTO_BOTTOM);
- DEFINE_STRING(GTK_STOCK_GOTO_FIRST);
- DEFINE_STRING(GTK_STOCK_GOTO_LAST);
- DEFINE_STRING(GTK_STOCK_GOTO_TOP);
- DEFINE_STRING(GTK_STOCK_GO_BACK);
- DEFINE_STRING(GTK_STOCK_GO_DOWN);
- DEFINE_STRING(GTK_STOCK_GO_FORWARD);
- DEFINE_STRING(GTK_STOCK_GO_UP);
- DEFINE_STRING(GTK_STOCK_HARDDISK);
- DEFINE_STRING(GTK_STOCK_HELP);
- DEFINE_STRING(GTK_STOCK_HOME);
- DEFINE_STRING(GTK_STOCK_INDEX);
- DEFINE_STRING(GTK_STOCK_ITALIC);
- DEFINE_STRING(GTK_STOCK_INDENT);
- DEFINE_STRING(GTK_STOCK_UNINDENT);
- DEFINE_STRING(GTK_STOCK_NETWORK);
- DEFINE_STRING(GTK_STOCK_JUMP_TO);
- DEFINE_STRING(GTK_STOCK_JUSTIFY_CENTER);
- DEFINE_STRING(GTK_STOCK_JUSTIFY_FILL);
- DEFINE_STRING(GTK_STOCK_JUSTIFY_LEFT);
- DEFINE_STRING(GTK_STOCK_JUSTIFY_RIGHT);
- DEFINE_STRING(GTK_STOCK_MISSING_IMAGE);
- DEFINE_STRING(GTK_STOCK_NEW);
- DEFINE_STRING(GTK_STOCK_NO);
- DEFINE_STRING(GTK_STOCK_OK);
- DEFINE_STRING(GTK_STOCK_OPEN);
- DEFINE_STRING(GTK_STOCK_PASTE);
- DEFINE_STRING(GTK_STOCK_PREFERENCES);
- DEFINE_STRING(GTK_STOCK_PRINT);
- DEFINE_STRING(GTK_STOCK_PRINT_PREVIEW);
- DEFINE_STRING(GTK_STOCK_PROPERTIES);
- DEFINE_STRING(GTK_STOCK_QUIT);
- DEFINE_STRING(GTK_STOCK_REDO);
- DEFINE_STRING(GTK_STOCK_REFRESH);
- DEFINE_STRING(GTK_STOCK_REMOVE);
- DEFINE_STRING(GTK_STOCK_REVERT_TO_SAVED);
- DEFINE_STRING(GTK_STOCK_SAVE);
- DEFINE_STRING(GTK_STOCK_SAVE_AS);
- DEFINE_STRING(GTK_STOCK_SELECT_COLOR);
- DEFINE_STRING(GTK_STOCK_SELECT_FONT);
- DEFINE_STRING(GTK_STOCK_SORT_ASCENDING);
- DEFINE_STRING(GTK_STOCK_SORT_DESCENDING);
- DEFINE_STRING(GTK_STOCK_SPELL_CHECK);
- DEFINE_STRING(GTK_STOCK_STOP);
- DEFINE_STRING(GTK_STOCK_STRIKETHROUGH);
- DEFINE_STRING(GTK_STOCK_UNDELETE);
- DEFINE_STRING(GTK_STOCK_UNDERLINE);
- DEFINE_STRING(GTK_STOCK_UNDO);
- DEFINE_STRING(GTK_STOCK_YES);
- DEFINE_STRING(GTK_STOCK_ZOOM_100);
- DEFINE_STRING(GTK_STOCK_ZOOM_FIT);
- DEFINE_STRING(GTK_STOCK_ZOOM_IN);
- DEFINE_STRING(GTK_STOCK_ZOOM_OUT);
- DEFINE_STRING(GTK_STOCK_ABOUT);
- DEFINE_STRING(GTK_STOCK_CONNECT);
- DEFINE_STRING(GTK_STOCK_DIRECTORY);
- DEFINE_STRING(GTK_STOCK_DISCONNECT);
- DEFINE_STRING(GTK_STOCK_EDIT);
- DEFINE_STRING(GTK_STOCK_FILE);
- DEFINE_STRING(GTK_STOCK_MEDIA_FORWARD);
- DEFINE_STRING(GTK_STOCK_MEDIA_NEXT);
- DEFINE_STRING(GTK_STOCK_MEDIA_PAUSE);
- DEFINE_STRING(GTK_STOCK_MEDIA_PLAY);
- DEFINE_STRING(GTK_STOCK_MEDIA_PREVIOUS);
- DEFINE_STRING(GTK_STOCK_MEDIA_RECORD);
- DEFINE_STRING(GTK_STOCK_MEDIA_REWIND);
- DEFINE_STRING(GTK_STOCK_MEDIA_STOP);
- DEFINE_STRING(GTK_STOCK_FULLSCREEN);
- DEFINE_STRING(GTK_STOCK_INFO);
- DEFINE_STRING(GTK_STOCK_LEAVE_FULLSCREEN);
- DEFINE_STRING(GTK_STOCK_ORIENTATION_PORTRAIT);
- DEFINE_STRING(GTK_STOCK_ORIENTATION_LANDSCAPE);
- DEFINE_STRING(GTK_STOCK_ORIENTATION_REVERSE_LANDSCAPE);
- DEFINE_STRING(GTK_STOCK_SELECT_ALL);
- DEFINE_STRING(GTK_STOCK_ORIENTATION_REVERSE_PORTRAIT);
- DEFINE_STRING(GTK_PRINT_SETTINGS_PRINTER);
- DEFINE_STRING(GTK_PRINT_SETTINGS_ORIENTATION);
- DEFINE_STRING(GTK_PRINT_SETTINGS_PAPER_FORMAT);
- DEFINE_STRING(GTK_PRINT_SETTINGS_PAPER_WIDTH);
- DEFINE_STRING(GTK_PRINT_SETTINGS_PAPER_HEIGHT);
- DEFINE_STRING(GTK_PRINT_SETTINGS_N_COPIES);
- DEFINE_STRING(GTK_PRINT_SETTINGS_DEFAULT_SOURCE);
- DEFINE_STRING(GTK_PRINT_SETTINGS_QUALITY);
- DEFINE_STRING(GTK_PRINT_SETTINGS_RESOLUTION);
- DEFINE_STRING(GTK_PRINT_SETTINGS_USE_COLOR);
- DEFINE_STRING(GTK_PRINT_SETTINGS_DUPLEX);
- DEFINE_STRING(GTK_PRINT_SETTINGS_COLLATE);
- DEFINE_STRING(GTK_PRINT_SETTINGS_REVERSE);
- DEFINE_STRING(GTK_PRINT_SETTINGS_MEDIA_TYPE);
- DEFINE_STRING(GTK_PRINT_SETTINGS_DITHER);
- DEFINE_STRING(GTK_PRINT_SETTINGS_SCALE);
- DEFINE_STRING(GTK_PRINT_SETTINGS_PRINT_PAGES);
- DEFINE_STRING(GTK_PRINT_SETTINGS_PAGE_RANGES);
- DEFINE_STRING(GTK_PRINT_SETTINGS_PAGE_SET);
- DEFINE_STRING(GTK_PRINT_SETTINGS_FINISHINGS);
- DEFINE_STRING(GTK_PRINT_SETTINGS_NUMBER_UP);
- DEFINE_STRING(GTK_PRINT_SETTINGS_OUTPUT_BIN);
- DEFINE_STRING(GTK_PRINT_SETTINGS_OUTPUT_FILE_FORMAT);
- DEFINE_STRING(GTK_PRINT_SETTINGS_OUTPUT_URI);
- DEFINE_STRING(GTK_STOCK_DISCARD);
-#if HAVE_GTK_SCALE_ADD_MARK
- DEFINE_STRING(GTK_STOCK_CAPS_LOCK_WARNING);
-#endif
-
-#if HAVE_GTK_COMBO_BOX_NEW_WITH_AREA
- DEFINE_STRING(GTK_STOCK_DIALOG_AUTHENTICATION);
- DEFINE_STRING(GTK_STOCK_PAGE_SETUP);
- DEFINE_STRING(GTK_STOCK_PRINT_ERROR);
- DEFINE_STRING(GTK_STOCK_PRINT_PAUSED);
- DEFINE_STRING(GTK_STOCK_PRINT_REPORT);
- DEFINE_STRING(GTK_STOCK_PRINT_WARNING);
- DEFINE_STRING(GTK_STYLE_CLASS_HIGHLIGHT);
- DEFINE_STRING(GTK_STYLE_CLASS_FRAME);
- DEFINE_STRING(GTK_STYLE_CLASS_DND);
- DEFINE_STRING(GTK_STYLE_CLASS_HORIZONTAL);
- DEFINE_STRING(GTK_STYLE_CLASS_VERTICAL);
+#define define_string(Name) Xen_define(Xg_pre #Name Xg_post, C_string_to_Xen_string(Name))
+ define_string(GTK_PRINT_SETTINGS_PRINTER);
+ define_string(GTK_PRINT_SETTINGS_ORIENTATION);
+ define_string(GTK_PRINT_SETTINGS_PAPER_FORMAT);
+ define_string(GTK_PRINT_SETTINGS_PAPER_WIDTH);
+ define_string(GTK_PRINT_SETTINGS_PAPER_HEIGHT);
+ define_string(GTK_PRINT_SETTINGS_N_COPIES);
+ define_string(GTK_PRINT_SETTINGS_DEFAULT_SOURCE);
+ define_string(GTK_PRINT_SETTINGS_QUALITY);
+ define_string(GTK_PRINT_SETTINGS_RESOLUTION);
+ define_string(GTK_PRINT_SETTINGS_USE_COLOR);
+ define_string(GTK_PRINT_SETTINGS_DUPLEX);
+ define_string(GTK_PRINT_SETTINGS_COLLATE);
+ define_string(GTK_PRINT_SETTINGS_REVERSE);
+ define_string(GTK_PRINT_SETTINGS_MEDIA_TYPE);
+ define_string(GTK_PRINT_SETTINGS_DITHER);
+ define_string(GTK_PRINT_SETTINGS_SCALE);
+ define_string(GTK_PRINT_SETTINGS_PRINT_PAGES);
+ define_string(GTK_PRINT_SETTINGS_PAGE_RANGES);
+ define_string(GTK_PRINT_SETTINGS_PAGE_SET);
+ define_string(GTK_PRINT_SETTINGS_FINISHINGS);
+ define_string(GTK_PRINT_SETTINGS_NUMBER_UP);
+ define_string(GTK_PRINT_SETTINGS_OUTPUT_BIN);
+ define_string(GTK_PRINT_SETTINGS_OUTPUT_FILE_FORMAT);
+ define_string(GTK_PRINT_SETTINGS_OUTPUT_URI);
+#if GTK_CHECK_VERSION(3, 0, 0)
+ define_string(GTK_STYLE_CLASS_HIGHLIGHT);
+ define_string(GTK_STYLE_CLASS_FRAME);
+ define_string(GTK_STYLE_CLASS_DND);
+ define_string(GTK_STYLE_CLASS_HORIZONTAL);
+ define_string(GTK_STYLE_CLASS_VERTICAL);
#endif
-#if HAVE_CAIRO_REGION_XOR
- DEFINE_STRING(CAIRO_MIME_TYPE_JPEG);
- DEFINE_STRING(CAIRO_MIME_TYPE_PNG);
- DEFINE_STRING(CAIRO_MIME_TYPE_JP2);
- DEFINE_STRING(CAIRO_MIME_TYPE_URI);
+#if HAVE_CAIRO_1_9_12 && GTK_CHECK_VERSION(3, 0, 0)
+ define_string(CAIRO_MIME_TYPE_JPEG);
+ define_string(CAIRO_MIME_TYPE_PNG);
+ define_string(CAIRO_MIME_TYPE_JP2);
+ define_string(CAIRO_MIME_TYPE_URI);
#endif
}
@@ -49033,31 +45728,49 @@ void Init_libxg(void)
{
if (!xg_already_inited)
{
+ define_symbols();
define_xm_obj();
define_integers();
define_doubles();
define_functions();
- define_structs();
define_atoms();
define_strings();
- XEN_YES_WE_HAVE("xg");
- XEN_DEFINE("xg-version", C_TO_XEN_STRING("02-Mar-11"));
+ define_structs();
+ Xen_provide_feature("xg");
+ #if GTK_CHECK_VERSION(3, 0, 0)
+ Xen_provide_feature("gtk3");
+ #else
+ Xen_provide_feature("gtk2");
+ #endif
+ Xen_define("xg-version", C_string_to_Xen_string("26-Nov-15"));
xg_already_inited = true;
#if HAVE_SCHEME
+#if USE_SND
/* these are macros in glib/gobject/gsignal.h, but we want the types handled in some convenient way in the extension language */
- XEN_EVAL_C_STRING("(define (g_signal_connect obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (not (null? data)) (car data)) #f 0))");
- XEN_EVAL_C_STRING("(define (g_signal_connect_after obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (not (null? data)) (car data)) #f G_CONNECT_AFTER))");
- XEN_EVAL_C_STRING("(define (g_signal_connect_swapped obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (not (null? data)) (car data)) #f G_CONNECT_SWAPPED))");
+ s7_define(s7, s7_nil(s7), s7_make_symbol(s7, "g_signal_connect"),
+ Xen_eval_C_string("(lambda (obj name func . data)\
+ ((*gtk* 'g_signal_connect_data) ((*gtk* 'GPOINTER) obj) name func (and (pair? data) (car data)) #f 0))"));
+ s7_define(s7, s7_nil(s7), s7_make_symbol(s7, "g_signal_connect_after"),
+ Xen_eval_C_string("(lambda (obj name func . data)\
+ ((*gtk* 'g_signal_connect_data) ((*gtk* 'GPOINTER) obj) name func (and (pair? data) (car data)) #f (*gtk* 'G_CONNECT_AFTER)))"));
+ s7_define(s7, s7_nil(s7), s7_make_symbol(s7, "g_signal_connect_swapped"),
+ Xen_eval_C_string("(lambda (obj name func . data)\
+ ((*gtk* 'g_signal_connect_data) ((*gtk* 'GPOINTER) obj) name func (and (pair? data) (car data)) #f (*gtk* 'G_CONNECT_SWAPPED)))"));
+#else
+ Xen_eval_C_string("(define (g_signal_connect obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (pair? data) (car data)) #f 0))");
+ Xen_eval_C_string("(define (g_signal_connect_after obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (pair? data) (car data)) #f G_CONNECT_AFTER))");
+ Xen_eval_C_string("(define (g_signal_connect_swapped obj name func . data) (g_signal_connect_data (GPOINTER obj) name func (and (pair? data) (car data)) #f G_CONNECT_SWAPPED))");
+#endif
#endif
#if HAVE_RUBY
- XEN_EVAL_C_STRING("def Rg_signal_connect(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, 0); end");
- XEN_EVAL_C_STRING("def Rg_signal_connect_after(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, RG_CONNECT_AFTER); end");
- XEN_EVAL_C_STRING("def Rg_signal_connect_swapped(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, RG_CONNECT_SWAPPED); end");
+ Xen_eval_C_string("def Rg_signal_connect(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, 0); end");
+ Xen_eval_C_string("def Rg_signal_connect_after(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, RG_CONNECT_AFTER); end");
+ Xen_eval_C_string("def Rg_signal_connect_swapped(obj, name, func, data = false); Rg_signal_connect_data(RGPOINTER(obj), name, func, data, false, RG_CONNECT_SWAPPED); end");
#endif
#if HAVE_FORTH
- XEN_EVAL_C_STRING(": Fg_signal_connect <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f 0 Fg_signal_connect_data ;");
- XEN_EVAL_C_STRING(": Fg_signal_connect_after <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f FG_CONNECT_AFTER Fg_signal_connect_data ;");
- XEN_EVAL_C_STRING(": Fg_signal_connect_swapped <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f FG_CONNECT_SWAPPED Fg_signal_connect_data ;");
+ Xen_eval_C_string(": Fg_signal_connect <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f 0 Fg_signal_connect_data ;");
+ Xen_eval_C_string(": Fg_signal_connect_after <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f FG_CONNECT_AFTER Fg_signal_connect_data ;");
+ Xen_eval_C_string(": Fg_signal_connect_swapped <{ obj name func :optional data #f -- n }> obj FGPOINTER name func data #f FG_CONNECT_SWAPPED Fg_signal_connect_data ;");
#endif
}
}
diff --git a/xm-enved.fs b/xm-enved.fs
index 321a2e9..4c0f3ff 100644
--- a/xm-enved.fs
+++ b/xm-enved.fs
@@ -1,631 +1,700 @@
-\ -*- snd-forth -*-
\ xm-enved.fs -- xm-enved.scm -> xm-enved.fs
\ Author: Michael Scholz <mi-scholz at users.sourceforge.net>
\ Created: Fri Oct 21 18:22:57 CEST 2005
-\ Changed: Mon Oct 25 21:47:23 CEST 2010
+\ Changed: Sat Dec 1 19:09:08 CET 2012
\ Commentary:
\
-\ Requires --with-motif|gtk and module libxm.so|libxg.so or --with-static-xm|xg!
+\ Requires --with-motif|gtk
\
-\ Tested with Snd 11.10, Motif 2.3.0, Gtk+ 2.20.1, Fth 1.2.x
+\ Tested with Snd 13.x
+\ Fth 1.3.x
+\ Motif 2.3.4 X11R6
+\ (Glib 2.28.8, Pango 1.28.4, Cairo 1.10.2)
\
\ This is an example of an object type written in Forth.
\
\ XENVED
-\ xe-inspect ( obj -- str )
-\ xe->string ( obj -- str )
-\ xe-dump ( obj -- str )
-\ xe->array ( obj -- ary )
-\ xe-ref ( obj index -- point )
-\ xe-set! ( obj index point -- )
-\ xe-equal? ( obj1 obj2 -- f )
-\ xe-length ( obj -- len )
-\ xe-free ( obj -- )
\
+\ before-enved-hook ( xe pos x y reason -- f )
\ xenved? ( obj -- f )
-\ make-xenved ( name parent :key envelope axis-bounds args -- xenved )
-\ run-before-enved-hook ( obj point reason -- f )
-\ xe-index ( obj x -- index|-1 )
-\ xe-insert! ( obj index point -- )
-\ xe-delete! ( obj index -- )
-\ xe-envelope ( obj -- lst )
-\ set-xe-envelope ( obj lst -- )
-\ xe-open ( obj -- )
-\ xe-close ( obj -- )
+\ make-xenved ( name parent :key envelope axis-bounds args -- xe )
+\
+\ xenved-length ( xe -- len|-1 )
+\ xenved-ref ( xe index -- point )
+\ xenved-set! ( xe index point -- )
+\ xenved-index ( xe x -- index|-1 )
+\ xenved-insert! ( xe index point -- )
+\ xenved-delete! ( xe index -- )
+\
+\ xenved-envelope@ ( xe -- ary )
+\ xenved-envelope! ( xe ary -- )
+\ xenved-open ( xe -- )
+\ xenved-close ( xe -- )
+\
+\ xe-envelope ( xe -- ary )
+\ set-xe-envelope ( xe ary -- )
\
\ xenved-test ( name -- xe )
'snd-nogui provided? [if] skip-file [then]
+'snd-gtk provided? [if]
+ 'gtk3 provided? not [if]
+ .( snd-gtk: gtk3 required -- skipping xm-enved.fs ) cr
+ skip-file
+ [then]
+[then]
+
require enved
require snd-xm
\ === XENVED OBJECT TYPE ===
-5 $" ( gen pos x y reason -- f ) \
-Will be called before changing a breakpoint in GEN's envelope. \
+5 "( xe pos x y reason -- f ) \
+Will be called before changing a breakpoint in XE's envelope. \
This hook runs the global ENVED-HOOK at first, \
-subsequent procedures can directly manipulate GEN's envelope \
+subsequent procedures can directly manipulate XE's envelope \
or the returned array of the preceding hook procedure.\n\
This instance hook is like the global ENVED-HOOK; \
POS is ENVELOPE's x-position, X and Y are the new points, \
-and REASON is one of the Snd constants ENVED-ADD-POINT, ENVED-DELETE-POINT, ENVED-MOVE-POINT. \
-If one of the hook procedures in the hook array returns #f, xenved changes the breakpoint, \
-otherwise the last hook procedure is responsible for manipulating GEN's envelope itself."
-create-hook before-enved-hook
-
-: axis-bounds? ( obj -- f ) array-length 4 = ;
+and REASON is one of the Snd constants ENVED-ADD-POINT, \
+ENVED-DELETE-POINT, ENVED-MOVE-POINT. \
+If one of the hook procedures in the hook array returns #f, \
+xenved changes the breakpoint, \
+otherwise the last hook procedure is responsible for manipulating \
+XE's envelope itself." create-hook before-enved-hook
-hide
-enved%
- cell% field xe-enved
- cell% field xe-name
- cell% field xe-parent
- cell% field xe-args
- cell% field xe-drawer
- cell% field xe-gcs
- cell% field xe-bx0
- cell% field xe-bx1
- cell% field xe-by0
- cell% field xe-by1
- cell% field xe-px0
- cell% field xe-px1
- cell% field xe-py0
- cell% field xe-py1
- cell% field xe-mouse-up \ float
- cell% field xe-mouse-down \ float
- cell% field xe-mouse-pos
- cell% field xe-mouse-new
- cell% field xe-click-time
- cell% field xe-dragging
-end-struct xenved%
-
-: xe-enved@ ( obj -- env ) instance-gen-ref xe-enved @ ;
-: xe-envelope@ ( obj -- val ) xe-enved@ envelope@ ;
-: xe-envelope! ( val obj -- ) xe-enved@ envelope! ;
-: xe-name@ ( obj -- val ) instance-gen-ref xe-name @ ;
-: xe-parent@ ( obj -- val ) instance-gen-ref xe-parent @ ;
-: xe-args@ ( obj -- val ) instance-gen-ref xe-args @ ;
-: xe-gcs@ ( obj -- val ) instance-gen-ref xe-gcs @ ;
-: xe-drawer@ ( obj -- val ) instance-gen-ref xe-drawer @ ;
-: xe-bx0@ ( obj -- val ) instance-gen-ref xe-bx0 @ ;
-: xe-bx1@ ( obj -- val ) instance-gen-ref xe-bx1 @ ;
-: xe-by0@ ( obj -- val ) instance-gen-ref xe-by0 @ ;
-: xe-by1@ ( obj -- val ) instance-gen-ref xe-by1 @ ;
-: xe-px0@ ( obj -- val ) instance-gen-ref xe-px0 @ ;
-: xe-px0! ( val obj -- ) instance-gen-ref xe-px0 ! ;
-: xe-px1@ ( obj -- val ) instance-gen-ref xe-px1 @ ;
-: xe-px1! ( val obj -- ) instance-gen-ref xe-px1 ! ;
-: xe-py0@ ( obj -- val ) instance-gen-ref xe-py0 @ ;
-: xe-py0! ( val obj -- ) instance-gen-ref xe-py0 ! ;
-: xe-py1@ ( obj -- val ) instance-gen-ref xe-py1 @ ;
-: xe-py1! ( val obj -- ) instance-gen-ref xe-py1 ! ;
-: xe-mouse-up@ ( obj -- val ) instance-gen-ref xe-mouse-up @ ;
-: xe-mouse-up! ( val obj -- ) instance-gen-ref xe-mouse-up ! ;
-: xe-mouse-down@ ( obj -- val ) instance-gen-ref xe-mouse-down @ ;
-: xe-mouse-down! ( val obj -- ) instance-gen-ref xe-mouse-down ! ;
-: xe-mouse-pos@ ( obj -- val ) instance-gen-ref xe-mouse-pos @ ;
-: xe-mouse-pos! ( val obj -- ) instance-gen-ref xe-mouse-pos ! ;
-: xe-mouse-new@ ( obj -- val ) instance-gen-ref xe-mouse-new @ ;
-: xe-mouse-new! ( val obj -- ) instance-gen-ref xe-mouse-new ! ;
-: xe-click-time@ ( obj -- val ) instance-gen-ref xe-click-time @ ;
-: xe-dragging@ ( obj -- val ) instance-gen-ref xe-dragging @ ;
-: xe-dragging! ( val obj -- ) instance-gen-ref xe-dragging ! ;
-set-current
+\
+\ Example hook function:
+\ Applies Snd's enved-hook functions to xenved.
+\
+\ before-enved-hook lambda: <{ xe pos x y reason -- f }>
+\ enved-hook hook-empty? if
+\ #f
+\ else
+\ xe xenved-envelope@ { res }
+\ enved-hook each { prc }
+\ prc #( res pos x y reason ) run-proc to res
+\ res false? ?leave
+\ end-each
+\ res array? if
+\ xe res xenved-envelope!
+\ then
+\ res
+\ then
+\ ; add-hook!
"xenved" make-object-type constant fth-xenved
fth-xenved make-?obj xenved?
-\ before-enved-hook lambda: <{ gen pos x y reason -- f }>
-\ enved-hook hook-empty? if
-\ #f
-\ else
-\ gen xe-envelope@ { res }
-\ enved-hook hook->array each { prc }
-\ prc #( res pos x y reason ) run-proc to res
-\ res false? ?leave
-\ end-each
-\ res array? if
-\ res gen xe-envelope!
-\ else
-\ res enved? if
-\ res envelope@ gen xe-envelope!
-\ else
-\ res xenved? if
-\ res xe-envelope@ gen xe-envelope!
-\ then
-\ then
-\ then
-\ res
-\ then
-\ ; add-hook!
+hide
+#( "xe-enved"
+ "xe-name"
+ "xe-parent"
+ "xe-args"
+ "xe-drawer"
+ "xe-gcs"
+ "xe-bx0"
+ "xe-bx1"
+ "xe-by0"
+ "xe-by1"
+ "xe-px0"
+ "xe-px1"
+ "xe-py0"
+ "xe-py1"
+ "xe-mouse-up"
+ "xe-mouse-down"
+ "xe-mouse-pos"
+ "xe-mouse-new"
+ "xe-click-time"
+ "xe-dragging" ) create-instance-struct make-xenved-instance
+
+: axis-bounds? ( obj -- f )
+ array-length 4 =
+;
+
+: xe-length ( self -- len ) xe-enved@ enved-length ;
+
+: xe-inspect { self -- str }
+ "#<%s[%d]: axis-bounds: #( %s %s %s %s ), envelope: %s>"
+ #( self object-name
+ self xe-length
+ self xe-bx0@
+ self xe-bx1@
+ self xe-by0@
+ self xe-by1@
+ self xe-enved@ ) string-format
+;
-: run-before-enved-hook { gen point reason -- f }
- before-enved-hook hook-empty? if
- #t
- else
- #f \ flag
- before-enved-hook hook->array each { prc }
- prc #( gen gen xe-mouse-pos@ point 0 array-ref point 1 array-ref reason ) run-proc false? if
- not \ toggle flag
- leave
- then
- end-each
- then
+: xe->string ( self -- str ) xe-enved@ object->string ;
+
+: xe-dump { self -- str }
+ "%S %S :envelope %s :axis-bounds #( %s %s %s %s ) :args %S make-xenved"
+ #( self xe-name@
+ self xe-parent@
+ self xe-enved@
+ self xe-bx0@
+ self xe-bx1@
+ self xe-by0@
+ self xe-by1@
+ self xe-args@ ) string-format
;
-: xe-length ( obj -- len ) xe-enved@ enved-length ;
-
-: xe-inspect { obj -- str }
- $" #<%s[%d]: axis-bounds: #( %s %s %s %s ), envelope: %s>"
- #( obj object-name
- obj xe-length
- obj xe-bx0@
- obj xe-bx1@
- obj xe-by0@
- obj xe-by1@
- obj xe-enved@ ) string-format
+: xe->array ( self -- ary ) xe-enved@ object->array ;
+: xe-ref ( self index -- point ) swap xe-enved@ swap enved-ref ;
+: xe-set! ( self index point -- ) rot xe-enved@ -rot enved-set! ;
+
+: xe-equal? { self obj -- f }
+ self obj = if
+ #t
+ else
+ self xe-enved@ obj xe-enved@ object-equal?
+ then
;
-: xe->string ( obj -- str ) xe-enved@ enved->string ;
-
-: xe-dump { obj -- str }
- $" %S %S :envelope %S :axis-bounds #( %s %s %s %s ) :args %S make-xenved"
- #( obj xe-name@
- obj xe-parent@
- obj xe-envelope@
- obj xe-bx0@
- obj xe-bx1@
- obj xe-by0@
- obj xe-by1@
- obj xe-args@ ) string-format
+\ Init object type Xenved.
+<'> xe-inspect fth-xenved set-object-inspect \ xe .inspect
+<'> xe->string fth-xenved set-object->string \ xe object->string
+<'> xe-dump fth-xenved set-object-dump \ xe object-dump
+<'> xe->array fth-xenved set-object->array \ xe object->array
+<'> xe-ref fth-xenved set-object-value-ref \ xe idx object-ref => #( x y )
+<'> xe-set! fth-xenved set-object-value-set \ xe idx #( x y ) object-set!
+<'> xe-equal? fth-xenved set-object-equal-p \ obj1 obj2 object-equal?
+<'> xe-length fth-xenved set-object-length \ xe object-length => (lstlen/2)
+<'> xe-ref fth-xenved 1 set-object-apply \ xe idx apply => #( x y )
+
+: run-before-enved-hook { xe point reason -- f }
+ xe xenved? xe 1 "an xenved" assert-type
+ point array-length 2 = point 1 "an array #( x y )" assert-type
+ before-enved-hook hook-empty? if
+ #t
+ else
+ #f ( flag )
+ before-enved-hook each { prc }
+ prc #( xe
+ xe xe-mouse-pos@
+ point 0 array-ref
+ point 1 array-ref
+ reason ) run-proc false? if
+ not ( toggle flag )
+ leave
+ then
+ end-each
+ then
;
+set-current
-: xe->array ( obj -- ary ) xe-enved@ enved->array ;
-: xe-ref ( obj index -- point ) swap xe-enved@ swap enved-ref ;
-: xe-set! ( obj index point -- ) rot xe-enved@ -rot enved-set! ;
+: xenved-length { xe -- len|-1 }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe xe-length
+;
-: xe-equal? { obj1 obj2 -- f }
- obj1 xenved? obj2 xenved? && if
- obj1 xe-enved@ obj2 xe-enved@ enved-equal?
- else
- #f
- then
+: xenved-ref { xe index -- point }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe index xe-ref
;
-: xe-free ( obj -- ) instance-gen-ref free throw ;
+: xenved-set! { xe index point -- }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe index point xe-set!
+;
-\ Init xenved
-<'> xe-inspect fth-xenved set-object-inspect \ xe .inspect
-<'> xe->string fth-xenved set-object->string \ xe object->string
-<'> xe-dump fth-xenved set-object-dump \ xe object-dump
-<'> xe->array fth-xenved set-object->array \ xe object->array
-<'> xe-ref fth-xenved set-object-value-ref \ xe index object-ref => #( x y )
-<'> xe-set! fth-xenved set-object-value-set \ xe index #( x y ) object-set!
-<'> xe-equal? fth-xenved set-object-equal-p \ obj1 obj2 equal?
-<'> xe-length fth-xenved set-object-length \ xe object-length => number of points (lstlen/2)
-<'> xe-free fth-xenved set-object-free \ for gc
-<'> xe-ref fth-xenved 1 set-object-apply \ xe index apply => #( x y )
+: xenved-index { xe x -- index|-1 }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe xe-enved@ x enved-index
+;
-: xe-index ( obj x -- index|-1 ) swap xe-enved@ swap enved-index ;
-: xe-insert! ( obj index point -- ) rot xe-enved@ -rot enved-insert! ;
-: xe-delete! ( obj index -- ) swap xe-enved@ swap enved-delete! ;
+: xenved-insert! { xe index point -- }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe xe-enved@ index point enved-insert!
+;
+: xenved-delete! { xe index -- }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe xe-enved@ index enved-delete!
+;
+previous
+
+hide
0.03 constant mouse-radius
-: grfx { x gen -- val }
- gen xe-px0@ gen xe-px1@ = if
- gen xe-px0@
- else
- gen xe-px0@ { px0 }
- gen xe-px1@ { px1 }
- gen xe-bx0@ { bx0 }
- gen xe-bx1@ { bx1 }
- x bx0 f- bx1 bx0 f- f/ px1 px0 f- f* px0 f+ floor f>s px0 max px1 min
- then
+: grfx { xe x -- n }
+ xe xe-px0@ xe xe-px1@ = if
+ xe xe-px0@
+ else
+ xe xe-px0@ { px0 }
+ xe xe-px1@ { px1 }
+ xe xe-bx0@ { bx0 }
+ xe xe-bx1@ { bx1 }
+ x bx0 f-
+ bx1 bx0 f- f/
+ px1 px0 f- f*
+ px0 f+ floor f>s
+ px0 max
+ px1 min
+ then
;
-: grfy { y gen -- val }
- gen xe-py0@ gen xe-py1@ = if
- gen xe-py0@
- else
- gen xe-py0@ { py0 }
- gen xe-py1@ { py1 }
- gen xe-by0@ { by0 }
- gen xe-by1@ { by1 }
- y by1 f- by0 by1 f- f/ py0 py1 f- f* py1 f+ floor f>s py1 max py0 min
- then
+: grfy { xe y -- n }
+ xe xe-py0@ xe xe-py1@ = if
+ xe xe-py0@
+ else
+ xe xe-py0@ { py0 }
+ xe xe-py1@ { py1 }
+ xe xe-by0@ { by0 }
+ xe xe-by1@ { by1 }
+ y by1 f-
+ by0 by1 f- f/
+ py0 py1 f- f*
+ py1 f+ floor f>s
+ py1 max
+ py0 min
+ then
;
-: ungrfx { x gen -- val }
- gen xe-px0@ gen xe-px1@ = if
- gen xe-bx0@ s>f
- else
- gen xe-px0@ { px0 }
- gen xe-px1@ { px1 }
- gen xe-bx0@ { bx0 }
- gen xe-bx1@ { bx1 }
- x px0 f- px1 px0 f- f/ bx1 bx0 f- f* bx0 f+ bx0 fmax bx1 fmin
- then
+: ungrfx { xe x -- r }
+ xe xe-px0@ xe xe-px1@ = if
+ xe xe-bx0@ s>f
+ else
+ xe xe-px0@ { px0 }
+ xe xe-px1@ { px1 }
+ xe xe-bx0@ { bx0 }
+ xe xe-bx1@ { bx1 }
+ x px0 f-
+ px1 px0 f- f/
+ bx1 bx0 f- f*
+ bx0 f+
+ bx0 fmax
+ bx1 fmin
+ then
;
-: ungrfy { y gen -- val }
- gen xe-py0@ gen xe-py1@ = if
- gen xe-by1@ s>f
- else
- gen xe-py0@ { py0 }
- gen xe-py1@ { py1 }
- gen xe-by0@ { by0 }
- gen xe-by1@ { by1 }
- py0 y f- py0 py1 f- f/ by1 by0 f- f* by0 f+ by0 fmax by1 fmin
- then
+: ungrfy { xe y -- r }
+ xe xe-py0@ xe xe-py1@ = if
+ xe xe-by1@ s>f
+ else
+ xe xe-py0@ { py0 }
+ xe xe-py1@ { py1 }
+ xe xe-by0@ { by0 }
+ xe xe-by1@ { by1 }
+ py0 y f-
+ py0 py1 f- f/
+ by1 by0 f- f*
+ by0 f+
+ by0 fmax
+ by1 fmin
+ then
;
'snd-motif provided? [if]
- 360 64 * constant 360*64
-
- : xe-redraw { gen -- }
- gen xe-drawer@ { drawer }
- drawer is-managed?
- gen xe-py0@ gen xe-py1@ > && if
- gen xe-gcs@ { gc }
- drawer FXtDisplay { dpy }
- drawer FXtWindow { win }
- dpy win FXClearWindow drop
- \ Motif's DRAW-AXES takes 6 optional arguments.
- \ '( x0 y0 x1 y1 ) = draw-axes(wid gc label
- \ x0=0.0 x1=1.0 y0=-1.0 y1=1.0
- \ style=x-axis-in-seconds
- \ axes=show-all-axes)
- \ arity #( 3 6 #f )
- drawer
- gc
- gen xe-name@
- gen xe-bx0@
- gen xe-bx1@
- gen xe-by0@
- gen xe-by1@
- x-axis-in-seconds
- show-all-axes draw-axes drop
- #f #f { lx ly }
- 10 { mouse-d }
- 5 { mouse-r }
- gen each { point }
- point 0 array-ref gen grfx { cx }
- point 1 array-ref gen grfy { cy }
- dpy win gc cx mouse-r - cy mouse-r - mouse-d mouse-d 0 360*64 FXFillArc drop
- lx if dpy win gc lx ly cx cy FXDrawLine drop then
- cx to lx
- cy to ly
- end-each
- then
- ;
+ 360 64 * constant 360*64
+
+ : xe-redraw { xe -- }
+ xe xe-drawer@ { drawer }
+ drawer is-managed?
+ xe xe-py0@ xe xe-py1@ > && if
+ xe xe-gcs@ { gc }
+ drawer FXtDisplay { dpy }
+ drawer FXtWindow { win }
+ dpy win FXClearWindow drop
+ \ Motif's DRAW-AXES takes 6 optional arguments.
+ \ '( x0 y0 x1 y1 ) = draw-axes(wid gc label
+ \ x0=0.0 x1=1.0 y0=-1.0 y1=1.0
+ \ style=x-axis-in-seconds
+ \ axes=show-all-axes)
+ \ arity #( 3 6 #f )
+ drawer gc xe xe-name@
+ xe xe-bx0@ xe xe-bx1@ xe xe-by0@ xe xe-by1@
+ x-axis-in-seconds show-all-axes draw-axes drop
+ #f #f { lx ly }
+ 10 { mouse-d }
+ 5 { mouse-r }
+ xe each { point }
+ xe point 0 array-ref grfx { cx }
+ xe point 1 array-ref grfy { cy }
+ dpy win gc cx mouse-r - cy mouse-r -
+ mouse-d mouse-d 0 360*64 FXFillArc drop
+ lx if
+ dpy win gc lx ly cx cy FXDrawLine drop
+ then
+ cx to lx
+ cy to ly
+ end-each
+ then
+ ;
[else]
- : xe-redraw { gen -- }
- gen xe-drawer@ { drawer }
- drawer is-managed?
- gen xe-py0@ gen xe-py1@ > && if
- gen xe-gcs@ { gc }
- drawer FGTK_WIDGET widget-size { size }
- drawer Fgtk_widget_get_window ( win ) FGDK_DRAWABLE Fgdk_cairo_create { cairo }
- cairo Fcairo_push_group drop
- cairo 1.0 1.0 1.0 Fcairo_set_source_rgb drop
- cairo 0 0 size 0 array-ref size 1 array-ref Fcairo_rectangle drop
- cairo Fcairo_fill drop
- \ Gtk's DRAW-AXES takes one more optional argument, a cairo object.
- \ '( x0 y0 x1 y1 ) = draw-axes(wid gc label
- \ x0=0.0 x1=1.0 y0=-1.0 y1=1.0
- \ style=x-axis-in-seconds
- \ axes=show-all-axes
- \ cairo)
- \ arity #( 3 7 #f )
- drawer
- gc
- gen xe-name@
- gen xe-bx0@
- gen xe-bx1@
- gen xe-by0@
- gen xe-by1@
- x-axis-in-seconds
- show-all-axes
- cairo draw-axes drop
- cairo 1.0 Fcairo_set_line_width drop
- cairo 0.0 0.0 0.0 Fcairo_set_source_rgb drop
- #f #f { lx ly }
- 5 { mouse-r }
- gen each { point }
- point 0 array-ref gen grfx { cx }
- point 1 array-ref gen grfy { cy }
- cairo cx cy mouse-r 0.0 two-pi Fcairo_arc drop
- cairo Fcairo_fill drop
- lx if
- cairo lx ly Fcairo_move_to drop
- cairo cx cy Fcairo_line_to drop
- cairo Fcairo_stroke drop
- then
- cx to lx
- cy to ly
- end-each
- cairo Fcairo_pop_group_to_source drop
- cairo Fcairo_paint drop
- cairo Fcairo_destroy drop
- then
- ;
+ : xe-redraw { xe -- }
+ xe xe-drawer@ { drawer }
+ drawer is-managed?
+ xe xe-py0@ xe xe-py1@ > && if
+ xe xe-gcs@ { gc }
+ drawer FGTK_WIDGET widget-size { size }
+ drawer make-cairo { cairo }
+ cairo Fcairo_push_group drop
+ cairo 1.0 1.0 1.0 Fcairo_set_source_rgb drop
+ cairo 0 0 size 0 array-ref size 1 array-ref
+ Fcairo_rectangle drop
+ cairo Fcairo_fill drop
+ \ Gtk's DRAW-AXES takes one more optional argument,
+ \ a cairo object.
+ \ '( x0 y0 x1 y1 ) = draw-axes(wid gc label
+ \ x0=0.0 x1=1.0 y0=-1.0 y1=1.0
+ \ style=x-axis-in-seconds
+ \ axes=show-all-axes
+ \ cairo)
+ \ arity #( 3 7 #f )
+ drawer gc xe xe-name@
+ xe xe-bx0@ xe xe-bx1@ xe xe-by0@ xe xe-by1@
+ x-axis-in-seconds show-all-axes cairo
+ draw-axes drop
+ cairo 1.0 Fcairo_set_line_width drop
+ cairo 0.0 0.0 0.0 Fcairo_set_source_rgb drop
+ #f #f { lx ly }
+ 5 { mouse-r }
+ xe each { point }
+ xe point 0 array-ref grfx { cx }
+ xe point 1 array-ref grfy { cy }
+ cairo cx cy mouse-r 0.0 two-pi Fcairo_arc drop
+ cairo Fcairo_fill drop
+ lx if
+ cairo lx ly Fcairo_move_to drop
+ cairo cx cy Fcairo_line_to drop
+ cairo Fcairo_stroke drop
+ then
+ cx to lx
+ cy to ly
+ end-each
+ cairo Fcairo_pop_group_to_source drop
+ cairo Fcairo_paint drop
+ cairo free-cairo drop
+ then
+ ;
[then]
-: add-envelope-point { x y gen -- }
- gen xe-mouse-pos@ { mpos }
- gen x xe-index dup 0>= if
- to mpos
- else
- drop
- gen each 0 array-ref x f> if i to mpos leave then end-each
- then
- gen mpos #( x y ) xe-insert!
- mpos gen xe-mouse-pos!
+: add-envelope-point { xe x y -- }
+ xe xe-mouse-pos@ { mpos }
+ xe x xenved-index dup 0>= if
+ to mpos
+ else
+ drop
+ xe each
+ 0 array-ref x f> if
+ i to mpos
+ leave
+ then
+ end-each
+ then
+ xe mpos #( x y ) xenved-insert!
+ xe mpos xe-mouse-pos!
;
-: draw-axes-set-points { lst gen -- }
- lst 0 array-ref gen xe-px0!
- lst 1 array-ref gen xe-py0!
- lst 2 array-ref gen xe-px1!
- lst 3 array-ref gen xe-py1!
- gen xe-redraw
+: draw-axes-set-points { lst xe -- }
+ xe lst 0 array-ref xe-px0!
+ xe lst 1 array-ref xe-py0!
+ xe lst 2 array-ref xe-px1!
+ xe lst 3 array-ref xe-py1!
+ xe xe-redraw
;
-: mouse-press { gen xx yy -- }
- xx gen ungrfx { x }
- yy gen ungrfy { y }
- #f \ flag
- gen each { point }
- point 0 array-ref x f- fabs mouse-radius f<
- point 1 array-ref y f- fabs mouse-radius f< && if drop ( flag ) i leave then
- end-each { pos }
- pos not gen xe-mouse-new!
- time gen xe-mouse-down!
- pos number? if
- pos gen xe-mouse-pos!
- else
- gen #( x y ) enved-add-point run-before-enved-hook if x y gen add-envelope-point then
- gen xe-redraw
- then
+: mouse-press { xe xx yy -- }
+ xe xx ungrfx { x }
+ xe yy ungrfy { y }
+ #f ( flag )
+ xe each { point }
+ point 0 array-ref x f- fabs mouse-radius f<
+ point 1 array-ref y f- fabs mouse-radius f< && if
+ drop ( flag )
+ i ( flag is now pos )
+ leave
+ then
+ end-each { pos }
+ xe pos not xe-mouse-new!
+ xe time xe-mouse-down!
+ pos number? if
+ xe pos xe-mouse-pos!
+ else
+ xe #( x y ) enved-add-point run-before-enved-hook if
+ xe x y add-envelope-point
+ then
+ xe xe-redraw
+ then
;
-: mouse-release { gen -- }
- gen xe-mouse-pos@ { mpos }
- time gen xe-mouse-up!
- gen xe-mouse-new@ unless
- gen xe-mouse-up@ gen xe-mouse-down@ f- gen xe-click-time@ f<= if
- mpos 0<> if
- mpos gen xe-length 1- < if
- gen mpos xe-ref { point }
- gen point enved-delete-point run-before-enved-hook if gen mpos xe-delete! then
- gen xe-redraw
+: mouse-release { xe -- }
+ xe xe-mouse-pos@ { mpos }
+ xe time xe-mouse-up!
+ xe xe-mouse-new@ unless
+ xe xe-mouse-up@ xe xe-mouse-down@ f-
+ xe xe-click-time@ f<= if
+ mpos 0<> if
+ mpos xe xenved-length 1- < if
+ xe mpos xenved-ref { point }
+ xe point enved-delete-point
+ run-before-enved-hook if
+ xe mpos xenved-delete!
+ then
+ xe xe-redraw
+ then
+ then
+ then
then
- then
- then
- then
- #f gen xe-mouse-new!
+ xe #f xe-mouse-new!
;
-: mouse-drag { gen xx yy -- }
- xx gen ungrfx { x }
- yy gen ungrfy { y }
- gen xe-mouse-pos@ { mpos }
- mpos 0= if
- gen 0 xe-ref 0 array-ref
- else
- mpos gen xe-length 1- >= if
- gen -1 xe-ref 0 array-ref
- else
- gen mpos 1- xe-ref 0 array-ref gen mpos 1+ xe-ref 0 array-ref x fmin fmax
- then
- then to x
- gen #( x y ) enved-move-point run-before-enved-hook if gen mpos #( x y ) xe-set! then
- gen xe-redraw
+: mouse-drag { xe xx yy -- }
+ xe xx ungrfx { x }
+ xe yy ungrfy { y }
+ xe xe-mouse-pos@ { mpos }
+ mpos 0= if
+ xe 0 xenved-ref 0 array-ref
+ else
+ mpos xe xenved-length 1- >= if
+ xe -1 xenved-ref 0 array-ref
+ else
+ xe mpos 1- xenved-ref 0 array-ref
+ xe mpos 1+ xenved-ref 0 array-ref x fmin fmax
+ then
+ then to x
+ xe #( x y ) enved-move-point run-before-enved-hook if
+ xe mpos #( x y ) xenved-set!
+ then
+ xe xe-redraw
;
'snd-motif provided? [if]
- : draw-axes-cb <{ w gen info -- }>
- gen xe-drawer@
- gen xe-gcs@
- gen xe-name@
- gen xe-bx0@
- gen xe-bx1@
- gen xe-by0@
- x-axis-in-seconds
- show-all-axes draw-axes gen draw-axes-set-points
- ;
-
- : mouse-press-cb <{ w gen ev f -- }> gen ev Fx ev Fy mouse-press ;
- : mouse-release-cb <{ w gen ev f -- }> gen mouse-release ;
- : mouse-drag-cb <{ w gen ev f -- }> gen ev Fx ev Fy mouse-drag ;
- : define-cursor-cb <{ w gen ev f -- x }> w FXtDisplay w FXtWindow gen FXDefineCursor ;
- : undefine-cursor-cb <{ w gen ev f -- x }> w FXtDisplay w FXtWindow FXUndefineCursor ;
-
- : make-drawer { name parent args -- drawer }
- args FXmNbackground array-member? unless
- args FXmNbackground array-push graph-color array-push to args
- then
- args FXmNforeground array-member? unless
- args FXmNforeground array-push data-color array-push to args
- then
- name FxmDrawingAreaWidgetClass parent args undef FXtCreateManagedWidget ( drawer )
- ;
+ : draw-axes-cb <{ w xe info -- }>
+ xe xe-drawer@ xe xe-gcs@ xe xe-name@
+ xe xe-bx0@ xe xe-bx1@ xe xe-by0@
+ x-axis-in-seconds show-all-axes draw-axes
+ xe draw-axes-set-points
+ ;
+
+ : mouse-press-cb <{ w xe ev f -- }>
+ xe ev Fx ev Fy mouse-press
+ ;
+
+ : mouse-release-cb <{ w xe ev f -- }>
+ xe mouse-release
+ ;
+
+ : mouse-drag-cb <{ w xe ev f -- }>
+ xe ev Fx ev Fy mouse-drag
+ ;
+
+ : define-cursor-cb <{ w xe ev f -- x }>
+ w FXtDisplay w FXtWindow xe FXDefineCursor
+ ;
+
+ : undefine-cursor-cb <{ w xe ev f -- x }>
+ w FXtDisplay w FXtWindow FXUndefineCursor
+ ;
+
+ : make-drawer { name parent args -- drawer }
+ args FXmNbackground array-member? unless
+ args FXmNbackground array-push graph-color
+ array-push to args
+ then
+ args FXmNforeground array-member? unless
+ args FXmNforeground array-push data-color
+ array-push to args
+ then
+ name FxmDrawingAreaWidgetClass parent args undef
+ FXtCreateManagedWidget ( drawer )
+ ;
- : init-xenved { gen -- gen }
- gen xe-drawer@ { drawer }
- drawer FXtDisplay FXC_crosshair FXCreateFontCursor { arrow-cursor }
- drawer FXmNresizeCallback <'> draw-axes-cb gen FXtAddCallback drop
- drawer FXmNexposeCallback <'> draw-axes-cb gen FXtAddCallback drop
- drawer FButtonPressMask #f <'> mouse-press-cb gen FXtAddEventHandler drop
- drawer FButtonReleaseMask #f <'> mouse-release-cb gen FXtAddEventHandler drop
- drawer FButtonMotionMask #f <'> mouse-drag-cb gen FXtAddEventHandler drop
- drawer FEnterWindowMask #f <'> define-cursor-cb arrow-cursor FXtAddEventHandler drop
- drawer FLeaveWindowMask #f <'> undefine-cursor-cb #f FXtAddEventHandler drop
- gen
- ;
+ : init-xenved-cbs { xe -- }
+ xe xe-drawer@ { drawer }
+ drawer FXtDisplay FXC_crosshair
+ FXCreateFontCursor { arrow-cursor }
+ drawer FXmNresizeCallback <'> draw-axes-cb xe
+ FXtAddCallback drop
+ drawer FXmNexposeCallback <'> draw-axes-cb xe
+ FXtAddCallback drop
+ drawer FButtonPressMask #f <'> mouse-press-cb xe
+ FXtAddEventHandler drop
+ drawer FButtonReleaseMask #f <'> mouse-release-cb xe
+ FXtAddEventHandler drop
+ drawer FButtonMotionMask #f <'> mouse-drag-cb xe
+ FXtAddEventHandler drop
+ drawer FEnterWindowMask #f <'> define-cursor-cb arrow-cursor
+ FXtAddEventHandler drop
+ drawer FLeaveWindowMask #f <'> undefine-cursor-cb #f
+ FXtAddEventHandler drop
+ ;
[else]
- : draw-axes-cb <{ w ev gen -- f }>
- save-stack { stack }
- gen xe-drawer@
- gen xe-gcs@
- gen xe-name@
- gen xe-bx0@
- gen xe-bx1@
- gen xe-by0@
- gen xe-by1@ draw-axes gen draw-axes-set-points
- stack restore-stack
- #f
- ;
-
- \ '( bool x y ) = gdk_event_get_coords(event x-win-return=undef y-win-return=undef)
- \ arity #( 1 2 #f )
- : get-coords ( ev -- x y ) undef undef Fgdk_event_get_coords dup 1 array-ref swap 2 array-ref ;
-
- : mouse-press-cb <{ w ev gen -- f }>
- #t gen xe-dragging!
- gen ev FGDK_EVENT get-coords mouse-press
- #f
- ;
-
- : mouse-release-cb <{ w ev gen -- f }>
- #f gen xe-dragging!
- gen mouse-release
- #f
- ;
-
- : mouse-drag-cb <{ w ev gen -- f }>
- gen xe-dragging@ if gen ev FGDK_EVENT get-coords mouse-drag then
- #f
- ;
-
- : define-cursor-cb <{ w ev cursor -- f }>
- w Fgtk_widget_get_window cursor Fgdk_window_set_cursor drop
- #f
- ;
-
- : make-drawer { name parent args -- drawer }
- Fgtk_drawing_area_new { drawer }
- drawer FGDK_ALL_EVENTS_MASK Fgtk_widget_set_events drop
- parent FGTK_BOX drawer #t #t 10 Fgtk_box_pack_start drop
- drawer Fgtk_widget_show drop
- drawer name Fgtk_widget_set_name drop
- drawer -1 200 Fgtk_widget_set_size_request drop
- drawer
- ;
-
- : init-xenved { gen -- gen }
- gen xe-drawer@ { drawer }
- drawer FGPOINTER
- "expose_event" drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup
- 0
- <'> draw-axes-cb gen #f Fg_cclosure_new
- #f
- Fg_signal_connect_closure_by_id drop
- drawer FGPOINTER
- "configure_event" drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup
- 0
- <'> draw-axes-cb gen #f Fg_cclosure_new
- #f
- Fg_signal_connect_closure_by_id drop
- drawer FGPOINTER
- "button_press_event" drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup
- 0
- <'> mouse-press-cb gen #f Fg_cclosure_new
- #f
- Fg_signal_connect_closure_by_id drop
- drawer FGPOINTER
- "button_release_event" drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup
- 0
- <'> mouse-release-cb gen #f Fg_cclosure_new
- #f
- Fg_signal_connect_closure_by_id drop
- drawer FGPOINTER
- "motion_notify_event" drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup
- 0
- <'> mouse-drag-cb gen #f Fg_cclosure_new
- #f
- Fg_signal_connect_closure_by_id drop
- drawer FGPOINTER
- "enter_notify_event" drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup
- 0
- <'> define-cursor-cb FGDK_CROSSHAIR Fgdk_cursor_new ( arrow-cursor ) #f Fg_cclosure_new
- #f
- Fg_signal_connect_closure_by_id drop
- drawer FGPOINTER
- "leave_notify_event" drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup
- 0
- <'> define-cursor-cb FGDK_LEFT_PTR Fgdk_cursor_new ( old-cursor ) #f Fg_cclosure_new
- #f
- Fg_signal_connect_closure_by_id drop
- gen
- ;
+ : draw-axes-cb <{ w ev xe -- f }>
+ xe xe-drawer@ { win }
+ win make-cairo { cairo }
+ win xe xe-gcs@ xe xe-name@ xe xe-bx0@ xe xe-bx1@
+ xe xe-by0@ xe xe-by1@ x-axis-in-seconds show-all-axes
+ cairo draw-axes xe draw-axes-set-points
+ cairo free-cairo drop
+ #f
+ ;
+
+ \ '( bool x y ) =
+ \ gdk_event_get_coords(event x-win-return=undef y-win-return=undef)
+ \ arity #( 1 2 #f )
+ : get-coords ( ev -- x y )
+ undef undef Fgdk_event_get_coords dup \ coords coords
+ 1 array-ref swap \ x coords
+ 2 array-ref \ x y
+ ;
+
+ : mouse-press-cb <{ w ev xe -- f }>
+ xe #t xe-dragging!
+ xe ev FGDK_EVENT get-coords mouse-press
+ #f
+ ;
+
+ : mouse-release-cb <{ w ev xe -- f }>
+ xe #f xe-dragging!
+ xe mouse-release
+ #f
+ ;
+
+ : mouse-drag-cb <{ w ev xe -- f }>
+ xe xe-dragging@ if
+ xe ev FGDK_EVENT get-coords mouse-drag
+ then
+ #f
+ ;
+
+ : define-cursor-cb <{ w ev cursor -- f }>
+ w Fgtk_widget_get_window cursor Fgdk_window_set_cursor drop
+ #f
+ ;
+
+ : make-drawer { name parent args -- drawer }
+ Fgtk_drawing_area_new { drawer }
+ drawer FGDK_ALL_EVENTS_MASK Fgtk_widget_set_events drop
+ parent FGTK_BOX drawer #t #t 10 Fgtk_box_pack_start drop
+ drawer Fgtk_widget_show drop
+ drawer name Fgtk_widget_set_name drop
+ drawer -1 200 Fgtk_widget_set_size_request drop
+ drawer
+ ;
+
+ : init-xenved-cbs { xe -- }
+ xe xe-drawer@ { drawer }
+ drawer FGPOINTER
+ 'gtk3 provided? if
+ "draw"
+ else
+ "expose_event"
+ then drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup 0
+ <'> draw-axes-cb xe #f Fg_cclosure_new #f
+ Fg_signal_connect_closure_by_id drop
+ drawer FGPOINTER "configure_event"
+ drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup 0
+ <'> draw-axes-cb xe #f Fg_cclosure_new #f
+ Fg_signal_connect_closure_by_id drop
+ drawer FGPOINTER "button_press_event"
+ drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup 0
+ <'> mouse-press-cb xe #f Fg_cclosure_new #f
+ Fg_signal_connect_closure_by_id drop
+ drawer FGPOINTER "button_release_event"
+ drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup 0
+ <'> mouse-release-cb xe #f Fg_cclosure_new #f
+ Fg_signal_connect_closure_by_id drop
+ drawer FGPOINTER "motion_notify_event"
+ drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup 0
+ <'> mouse-drag-cb xe #f Fg_cclosure_new #f
+ Fg_signal_connect_closure_by_id drop
+ drawer FGPOINTER "enter_notify_event"
+ drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup 0
+ <'> define-cursor-cb
+ FGDK_CROSSHAIR Fgdk_cursor_new ( arrow-cursor )
+ #f Fg_cclosure_new #f Fg_signal_connect_closure_by_id drop
+ drawer FGPOINTER "leave_notify_event"
+ drawer FG_OBJECT FG_OBJECT_TYPE Fg_signal_lookup 0
+ <'> define-cursor-cb
+ FGDK_LEFT_PTR Fgdk_cursor_new ( old-cursor )
+ #f Fg_cclosure_new #f Fg_signal_connect_closure_by_id drop
+ ;
[then]
+set-current
-\ Arrays or lists as default values for <{ ... }> doesn't work very well.
-\
-\ make-xenved <{ name parent
-\ :key
-\ envelope #( 0.0 0.0 1.0 1.0 )
-\ axis-bounds #( 0.0 1.0 0.0 1.0 )
-\ args #() -- gen }>
-
-: make-xenved ( name parent keyword-args -- gen )
- :envelope #( 0.0 0.0 1.0 1.0 ) get-optkey { envelope }
- :axis-bounds #( 0.0 1.0 0.0 1.0 ) get-optkey { axis-bounds }
- :args #() get-optkey { args }
- { name parent }
- parent widget? parent 2 $" a widget" assert-type
- axis-bounds axis-bounds? axis-bounds 4 $" an array of axis bounds" assert-type
- xenved% %alloc { xe }
- xe unless 'system-error #( get-func-name $" cannot create xenved" ) fth-throw then
- envelope make-enved xe xe-enved !
- name string? unless "xe-test" to name then
- name parent args make-drawer xe xe-drawer !
- name xe xe-name !
- parent xe xe-parent !
- args xe xe-args !
- snd-gcs 0 array-ref xe xe-gcs !
- axis-bounds 0 array-ref xe xe-bx0 !
- axis-bounds 2 array-ref xe xe-by0 !
- axis-bounds 1 array-ref xe xe-bx1 !
- axis-bounds 3 array-ref xe xe-by1 !
- 0 xe xe-px0 ! \ points == ints
- 0 xe xe-py0 !
- 0 xe xe-px1 !
- 0 xe xe-py1 !
- 0.0 xe xe-mouse-up !
- 0.0 xe xe-mouse-down !
- 0.5 xe xe-click-time !
- 0 xe xe-mouse-pos !
- #f xe xe-mouse-new !
- #f xe xe-dragging !
- xe fth-xenved make-instance init-xenved ( gen )
+: make-xenved <{ name parent
+ :key
+ envelope #( 0.0 0.0 1.0 1.0 )
+ axis-bounds #( 0.0 1.0 0.0 1.0 )
+ args #() -- xe }>
+ parent widget? parent 2 "a widget" assert-type
+ axis-bounds axis-bounds? axis-bounds 4
+ "an array of axis bounds" assert-type
+ fth-xenved make-xenved-instance { xe }
+ xe envelope make-enved xe-enved!
+ name string? unless
+ "xe-test" to name
+ then
+ xe name parent args make-drawer xe-drawer!
+ xe name xe-name!
+ xe parent xe-parent!
+ xe args xe-args!
+ xe snd-gcs 0 array-ref xe-gcs!
+ xe axis-bounds 0 array-ref xe-bx0!
+ xe axis-bounds 2 array-ref xe-by0!
+ xe axis-bounds 1 array-ref xe-bx1!
+ xe axis-bounds 3 array-ref xe-by1!
+ xe 0 xe-px0! \ points == ints
+ xe 0 xe-py0!
+ xe 0 xe-px1!
+ xe 0 xe-py1!
+ xe 0.0 xe-mouse-up!
+ xe 0.0 xe-mouse-down!
+ xe 0.5 xe-click-time!
+ xe 0 xe-mouse-pos!
+ xe #f xe-mouse-new!
+ xe #f xe-dragging!
+ xe init-xenved-cbs
+ xe
+;
+
+: xenved-envelope@ { xe -- ary }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe xe-enved@ enved-envelope@
+;
+
+
+: xenved-envelope! { xe ary -- }
+ xe xenved? xe 1 "an xenved" assert-type
+ ary array? ary 2 "an array" assert-type
+ xe xe-enved@ ary enved-envelope!
;
-: xe-envelope { gen -- lst }
- gen xenved? gen 1 $" an xenved object" assert-type
- gen xe-envelope@
+<'> xenved-envelope@ alias xe-envelope
+
+: set-xe-envelope { xe ary -- }
+ xe ary xenved-envelope!
+ xe xe-redraw
;
-: set-xe-envelope { gen lst -- }
- gen xenved? gen 1 $" an xenved object" assert-type
- lst array? lst 2 $" an array" assert-type
- lst gen xe-envelope!
- gen xe-redraw
+\ XXX
+\ For backwards compatibility.
+<'> xenved-envelope@ alias xe-envelope@
+
+\ XXX
+\ For backwards compatibility with arguments swapped.
+: xe-envelope! { ary xe -- }
+ xe ary xenved-envelope!
;
-: xe-open { gen -- }
- gen xenved? gen 1 $" an xenved object" assert-type
- gen xe-drawer@ widget? if gen xe-drawer@ show-widget drop then
+: xenved-open { xe -- }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe xe-drawer@ widget? if
+ xe xe-drawer@ show-widget drop
+ then
+ xe xe-redraw
;
-: xe-close { gen -- }
- gen xenved? gen 1 $" an xenved object" assert-type
- gen xe-drawer@ widget? if gen xe-drawer@ hide-widget drop then
+: xenved-close { xe -- }
+ xe xenved? xe 1 "an xenved" assert-type
+ xe xe-drawer@ widget? if
+ xe xe-drawer@ hide-widget drop
+ then
;
previous
@@ -643,24 +712,24 @@ previous
[then]
: xenved-test <{ :optional name "xenved" -- xe }>
- doc" create a drawing test widget\n\
+ doc" create a drawing test widget\n\
xenved-test value xe\n\
xe => #( 0.0 0.0 1.0 1.0 )\n\
xe xe-envelope => #( 0.0 0.0 1.0 1.0 )\n\
-\\ some clicks later
+\\ some clicks later\n\
xe xe-envelope => #( 0.0 0.0\n\
0.190736 0.562264\n\
0.632152 0.932075\n\
0.848774 0.316981\n\
1.0 1.0 )\n\
-xe #( 0 1 1 1 ) set-xe-envelope
+xe #( 0 1 1 1 ) set-xe-envelope\n\
xe xe-envelope => #( 0 1 1 1 )\n\
-xe xe-close"
- name
- name test-widget-type test-widget-args add-main-pane
- :envelope #( 0.0 0.0 1.0 1.0 )
- :axis-bounds #( 0.0 1.0 0.0 1.0 )
- :args test-xenved-args make-xenved ( xe )
+xe xe-close."
+ name
+ name test-widget-type test-widget-args add-main-pane
+ :envelope #( 0.0 0.0 1.0 1.0 )
+ :axis-bounds #( 0.0 1.0 0.0 1.0 )
+ :args test-xenved-args make-xenved ( xe )
;
\ xm-enved.fs ends here
diff --git a/xm-enved.rb b/xm-enved.rb
index ed3679e..f8e9f7a 100644
--- a/xm-enved.rb
+++ b/xm-enved.rb
@@ -1,12 +1,12 @@
-# xm-enved.rb -- Translation of xm-enved.scm and enved.scm -*- snd-ruby -*-
+# xm-enved.rb -- Translation of xm-enved.scm and enved.scm
# Translator/Author: Michael Scholz <mi-scholz at users.sourceforge.net>
-# Created: Tue Mar 18 00:18:35 CET 2003
-# Changed: Wed Nov 17 22:58:35 CET 2010
+# Created: 03/03/18 00:18:35
+# Changed: 14/11/13 04:56:16
-# Commentary:
-#
-# Tested with Snd 11, Motif 2.2.3, Gtk+ 2.20.1, Ruby 1.8.0/7, 1.9.2/3.
+# Tested with Snd 15.x
+# Ruby 2.x.x
+# Motif 2.3.3 X11R6
#
# module Snd_enved
# channel_enved(snd, chn)
@@ -21,31 +21,30 @@
# start_enveloping
# stop_enveloping
# play_with_envs(snd = false)
-# play_panned(snd)
#
# envelope?(obj)
-# make_enved(enved = [0, 0, 1, 1])
+# make_enved(enved)
# enved?(obj)
-# make_graph_enved(enved = [0, 0, 1, 1], snd = Snd.snd, chn = Snd.chn)
+# make_graph_enved(enved, snd, chn)
# graph_enved?(obj)
# make_xenved(name, parent, *rest)
# xenved?(obj)
# xenved_test(name)
#
# class Enved
-# initialize(enved = [0, 0, 1, 1])
+# initialize(enved)
# inspect
# to_s
# envelope
# envelope=(new_env)
# reset
-# interp(x, base = 0)
-# stretch(old_att = nil, new_att = nil, old_dec = nil, new_dec = nil)
-# stretch!(old_att = nil, new_att = nil, old_dec = nil, new_dec = nil)
-# scale(scale = 1.0, offset = 0.0)
-# scale!(scale = 1.0, offset = 0.0)
-# normalize(new_max = 1.0)
-# normalize!(new_max = 1.0)
+# interp(x, base)
+# stretch(old_att, new_att, old_dec, new_dec)
+# stretch!(old_att, new_att, old_dec, new_dec)
+# scale(scale, offset)
+# scale!(scale, offset)
+# normalize(new_max)
+# normalize!(new_max)
# reverse
# reverse!
# point(idx, *args)
@@ -64,33 +63,31 @@
# map
# map!
#
-# class Graph_enved < Enved
-# initialize(enved, snd, chn)
-# click_time
-# click_time=(val)
-# before_enved_hook
-# after_enved_hook
-# inspect
-# to_s
-# reset
-# redraw
-# mouse_press_cb(x, y)
-# mouse_drag_cb(x, y)
-# mouse_release_cb
+# class Graph_enved < Enved
+# initialize(enved, snd, chn)
+# click_time
+# click_time=(val)
+# before_enved_hook
+# after_enved_hook
+# inspect
+# to_s
+# reset
+# redraw
+# mouse_press_cb(x, y)
+# mouse_drag_cb(x, y)
+# mouse_release_cb
#
-# class Xenved < Graph_enved
-# initialize(name, parent, enved, bounds, args, axis_label)
-# inspect
-# to_s
-# clear
-# envelope=(new_env)
-# axis_bounds
-# axis_bounds=(bounds)
-# point(idx, *args)
-# create
-# close
-
-# Code:
+# class Xenved < Graph_enved
+# initialize(name, parent, enved, bounds, args, axis_label)
+# inspect
+# to_s
+# clear
+# envelope=(new_env)
+# axis_bounds
+# axis_bounds=(bounds)
+# point(idx, *args)
+# create
+# close
require "env"
require "hooks"
@@ -125,8 +122,8 @@ module Snd_enved
end
add_help(:channel_envelope,
- "channel_envelope(snd, chn) \
-returns the current enved envelope associated with snd's channel chn")
+ "channel_envelope(snd=false, chn=false) \
+Returns the current enved envelope associated with SND's channel CHN.")
def channel_envelope(snd = false, chn = false)
if graph_enved?(ge = channel_enved(snd, chn))
ge.envelope
@@ -184,7 +181,8 @@ returns the current enved envelope associated with snd's channel chn")
# C-g returns to original env
# C-. applies current env to amplitude
if key == ?. and state == 4
- env_channel((channel_envelope(snd, chn) or [0, 1, 1, 1]), 0, frames(snd, chn), snd, chn)
+ env_channel((channel_envelope(snd, chn) or [0, 1, 1, 1]),
+ 0, framples(snd, chn), snd, chn)
true
else
if key == ?g and state == 4
@@ -200,7 +198,7 @@ returns the current enved envelope associated with snd's channel chn")
add_help(:start_enveloping,
"start_enveloping() \
-starts the enved processes, displaying an envelope editor in each channel")
+Starts the enved processes, displaying an envelope editor in each channel.")
def start_enveloping
unless $after_open_hook.member?(Hook_name)
$after_open_hook.add_hook!(Hook_name) do |snd|
@@ -212,8 +210,8 @@ starts the enved processes, displaying an envelope editor in each channel")
$mouse_drag_hook.add_hook!(Hook_name) do |snd, chn, button, state, x, y|
mouse_drag_envelope(snd, chn, button, state, x, y)
end
- $mouse_click_hook.add_hook!(Hook_name) do |snd, chn, button, state, x, y, axis|
- mouse_release_envelope(snd, chn, button, state, x, y, axis)
+ $mouse_click_hook.add_hook!(Hook_name) do |snd, chn, but, st, x, y, axis|
+ mouse_release_envelope(snd, chn, but, st, x, y, axis)
end
$key_press_hook.add_hook!(Hook_name) do |snd, chn, key, state|
enveloping_key_press(snd, chn, key, state)
@@ -225,58 +223,40 @@ starts the enved processes, displaying an envelope editor in each channel")
end
add_help(:stop_enveloping,
- "stop_enveloping() turns off the enved channel-specific envelope editors")
+ "stop_enveloping() \
+Turns off the enved channel-specific envelope editors.")
def stop_enveloping
$after_open_hook.remove_hook!(Hook_name)
$mouse_press_hook.remove_hook!(Hook_name)
$mouse_drag_hook.remove_hook!(Hook_name)
$mouse_click_hook.remove_hook!(Hook_name)
$key_press_hook.remove_hook!(Hook_name)
- Snd.catch do set_lisp_graph?(false, Snd.snd, Snd.chn) end
+ Snd.catch do
+ set_lisp_graph?(false, Snd.snd, Snd.chn)
+ end
nil
end
- # some examples of using this envelope editor
+ # some examples
add_help(:play_with_envs,
- "play_with_envs([snd=false]) \
-sets channel amps during playback from the associated enved envelopes")
+ "play_with_envs(snd=false) \
+Sets channel amps during playback from the associated enved envelopes.")
def play_with_envs(snd = false)
channel_envelope(snd, 0) or create_initial_envelopes(snd)
channels(snd).times do |chn|
player = make_player(snd, chn)
e = make_env(:envelope, channel_envelope(snd, chn),
- :length, (frames(snd, chn).to_f / dac_size).floor)
- add_player(player, 0, -1, -1, lambda { |reason| $play_hook.reset_hook! })
- $play_hook.add_hook!(get_func_name) { |fr| set_amp_control(env(e), player) }
- end
- start_playing(channels(snd), srate(snd))
- end
-
- add_help(:play_panned,
- "play_panned(snd) \
-pans a mono sound following its enved envelope into a stereo sound")
- def play_panned(snd)
- bufsize = 256
- data = make_sound_data(2, bufsize)
- bytes = bufsize * 4
- audio_fd = mus_audio_open_output(0, srate(snd), 2, Mus_lshort, bytes)
- samp = 0
- len = frames(snd, 0)
- if audio_fd != -1
- channel_envelope(snd, 0) or create_initial_envelopes(snd)
- e = make_env(:envelope, channel_envelope(snd, 0), :length, (len.to_f / dac_size).floor)
- while samp < len
- scaler = env(e)
- samps0 = channel2vct(samp, bufsize)
- samps1 = samps0.dup
- vct2sound_data(samps0.scale(scaler), data, 0)
- vct2sound_data(samps1.scale(1.0 - scaler), data, 1)
- mus_audio_write(audio_fd, data, bufsize)
- samp += bufsize
+ :length, (framples(snd, chn).to_f / dac_size).floor)
+ add_player(player, 0, -1, -1,
+ lambda do |reason|
+ $play_hook.reset_hook!
+ end)
+ $play_hook.add_hook!(get_func_name) do |fr|
+ set_amp_control(env(e), player)
end
- mus_audio_close(audio_fd)
end
+ start_playing(channels(snd), srate(snd))
end
def envelope?(obj)
@@ -284,7 +264,8 @@ pans a mono sound following its enved envelope into a stereo sound")
end
def make_enved(enved = [0, 0, 1, 1])
- assert_type(envelope?(enved), enved, 0, "an envelope, at least 2 points [x0, y0, x1, y1, ...]")
+ assert_type(envelope?(enved), enved, 0,
+ "an envelope, at least 2 points [x0, y0, x1, y1, ...]")
Enved.new(enved)
end
@@ -293,7 +274,8 @@ pans a mono sound following its enved envelope into a stereo sound")
end
def make_graph_enved(enved = [0, 0, 1, 1], snd = Snd.snd, chn = Snd.chn)
- assert_type(envelope?(enved), enved, 0, "an envelope, at least 2 points [x0, y0, x1, y1, ...]")
+ assert_type(envelope?(enved), enved, 0,
+ "an envelope, at least 2 points [x0, y0, x1, y1, ...]")
(ge = Graph_enved.new(enved, snd, chn)).redraw
ge
end
@@ -309,10 +291,12 @@ pans a mono sound following its enved envelope into a stereo sound")
[:axis_bounds, [0, 1, 0, 1]],
[:args, []],
:axis_label)
- name = "xenved" unless string?(name) and (not name.empty?)
+ unless string?(name) and (not name.empty?)
+ name = "xenved"
+ end
assert_type(widget?(parent), parent, 1, "a widget")
- assert_type((array?(bounds) and bounds.length == 4),
- bounds, 3, "an array of 4 elements [x0, x1, y0, y1]")
+ assert_type((array?(bounds) and bounds.length == 4), bounds, 3,
+ "an array of 4 elements [x0, x1, y0, y1]")
unless array?(label) and label.length == 4
label = bounds
end
@@ -323,7 +307,6 @@ pans a mono sound following its enved envelope into a stereo sound")
obj.instance_of?(Xenved)
end
-
if $with_motif
Test_widget_type = RxmFormWidgetClass
Test_widget_args = [RXmNheight, 200]
@@ -354,7 +337,9 @@ class Enved
include Info
def initialize(enved = [0, 0, 1, 1])
- (@envelope = enved).map! do |x| x.to_f end
+ (@envelope = enved).map! do |x|
+ x.to_f
+ end
@init = @envelope.dup
set_enved_help
end
@@ -369,8 +354,11 @@ class Enved
end
def envelope=(enved)
- assert_type(envelope?(enved), enved, 0, "an envelope, at least 2 points [x0, y0, x1, y1, ...]")
- @envelope = enved.map do |x| x.to_f end
+ assert_type(envelope?(enved), enved, 0,
+ "an envelope, at least 2 points [x0, y0, x1, y1, ...]")
+ @envelope = enved.map do |x|
+ x.to_f
+ end
end
def reset
@@ -473,23 +461,31 @@ class Enved
end
def each
- 0.step(@envelope.length - 1, 2) do |i| yield(@envelope[i, 2]) end
+ 0.step(@envelope.length - 1, 2) do |i|
+ yield(@envelope[i, 2])
+ end
@envelope
end
def each_with_index
- 0.step(@envelope.length - 1, 2) do |i| yield(@envelope[i, 2] + [i]) end
+ 0.step(@envelope.length - 1, 2) do |i|
+ yield(@envelope[i, 2] + [i])
+ end
@envelope
end
def map
res = make_array(@envelope.length)
- 0.step(@envelope.length - 1, 2) do |i| res[i, 2] = yield(@envelope[i, 2]) end
+ 0.step(@envelope.length - 1, 2) do |i|
+ res[i, 2] = yield(@envelope[i, 2])
+ end
res
end
def map!
- 0.step(@envelope.length - 1, 2) do |i| @envelope[i, 2] = yield(@envelope[i, 2]) end
+ 0.step(@envelope.length - 1, 2) do |i|
+ @envelope[i, 2] = yield(@envelope[i, 2])
+ end
@envelope
end
@@ -518,7 +514,7 @@ class Enved
# map do |x, y| ... end map! do |x, y| ... end
# each do |x, y| ... end each_with_index do |x, y, i| ... end
# length
-# point(idx, *args) # point(idx) --> [x, y]
+# point(idx, *args) # point(idx) ==> [x, y]
# # point(idx, :x, x_val, :y, y_val)
# # sets x, y or both and returns new [x, y]
# in_range?(x) (x > first_x and x < last_x)
@@ -535,15 +531,15 @@ class Graph_enved < Enved
@snd = snd
@chn = chn
@before_enved_hook = Hook.new("@before_enved_hook", 4, "\
-lambda do |pos, x, y, reason| ... end: called before changing a
-breakpoint in @envelope. This hook runs the global $enved_hook as
+lambda do |pos, x, y, reason| ... end: called before changing a \
+breakpoint in @envelope. This hook runs the global $enved_hook as \
first hook, subsequent procedures can directly manipulate @envelope.
-This instance hook is like the global $enved_hook; POS is @envelope's
-x-position, X and Y are the new points, and REASON is one of
-Enved_add_point, Enved_delete_point, Enved_move_point. If the last
-hook procedure in the hook list returns `false', the class changes the
-breakpoint, otherwise the hook procedures are responsible for
+This instance hook is like the global $enved_hook; POS is @envelope's \
+x-position, X and Y are the new points, and REASON is one of \
+Enved_add_point, Enved_delete_point, Enved_move_point. If the last \
+hook procedure in the hook list returns `false', the class changes the \
+breakpoint, otherwise the hook procedures are responsible for \
manipulating @envelope itself.
From dlocsig.rb:
@@ -584,7 +580,8 @@ $enved_hook.add_hook!(\"snd-init-hook\") do |env, pt, x, y, reason|
false
end
end")
- @before_enved_hook.add_hook!("initialize-xm-enved-hook") do |pos, x, y, reason|
+ hn = "initialize-xm-enved-hook"
+ @before_enved_hook.add_hook!(hn) do |pos, x, y, reason|
if $enved_hook.empty?
false
else
@@ -601,8 +598,8 @@ end")
end
end
@after_enved_hook = Hook.new("@after_enved_hook", 2, "\
-lambda do |pos, reason| ... end: called after redrawing new or changed
-breakpoints. POS is @envelope's x-position, and REASON is one of
+lambda do |pos, reason| ... end: called after redrawing new or changed \
+breakpoints. POS is @envelope's x-position, and REASON is one of \
Enved_add_point, Enved_delete_point, Enved_move_point.")
init
set_enved_help
@@ -617,7 +614,8 @@ Enved_add_point, Enved_delete_point, Enved_move_point.")
end
def to_s
- format("#<%s: %s[%s:%s]: %s>", self.class, @graph_name, @snd, @chn, @envelope.to_string)
+ format("#<%s: %s[%s:%s]: %s>",
+ self.class, @graph_name, @snd, @chn, @envelope.to_string)
end
def init
@@ -716,7 +714,9 @@ Enved_add_point, Enved_delete_point, Enved_move_point.")
true
else
e = nil
- @before_enved_hook.run_hook do |prc| e = prc.call(@mouse_pos / 2, x, y, reason) end
+ @before_enved_hook.run_hook do |prc|
+ e = prc.call(@mouse_pos / 2, x, y, reason)
+ end
e.class == FalseClass
end
end
@@ -728,7 +728,10 @@ Enved_add_point, Enved_delete_point, Enved_move_point.")
idx = test_env.index(cur_pair) * 2
@envelope[idx + 1] = y
else
- if cur_pair = test_env.detect do |pair| x < pair[0] end
+ cur_pair = test_env.detect do |pair|
+ x < pair[0]
+ end
+ if cur_pair
idx = test_env.index(cur_pair) * 2
@envelope.insert(idx, x, y)
end
@@ -764,8 +767,8 @@ Enved_add_point, Enved_delete_point, Enved_move_point.")
# more examples in xm-enved.rb, module Snd_enved
ge = make_graph_enved([0, 0, 1, 1], 0, 0)
-ge.envelope # --> [0.0, 0.0, 1.0, 1.0]
-ge.click_time # --> 0.2
+ge.envelope # ==> [0.0, 0.0, 1.0, 1.0]
+ge.click_time # ==> 0.2
ge.envelope = [0, 1, 1, 1]
ge.help # this help
"
@@ -779,14 +782,22 @@ if $with_gui
super(enved)
@name = name
@parent = parent
- @x0, @x1, @y0, @y1 = bounds.map do |x| x.to_f end
+ @x0, @x1, @y0, @y1 = bounds.map do |x|
+ x.to_f
+ end
@args = args
if $with_motif
- @args += [RXmNforeground, data_color] unless @args.member?(RXmNforeground)
- @args += [RXmNbackground, graph_color] unless @args.member?(RXmNbackground)
+ unless @args.member?(RXmNforeground)
+ @args += [RXmNforeground, data_color]
+ end
+ unless @args.member?(RXmNbackground)
+ @args += [RXmNbackground, graph_color]
+ end
end
@lx0, @lx1, @ly0, @ly1 = if envelope?(axis_label)
- axis_label.map do |x| x.to_f end
+ axis_label.map do |x|
+ x.to_f
+ end
else
[0.0, 1.0, -1.0, 1.0]
end
@@ -800,9 +811,9 @@ if $with_gui
alias help description
def inspect
- format("%s.new(%s, %s, %s, %s, %s, %s)",
+ format("%s.new(%p, %s, %s, %s, %s, %s)",
self.class,
- @name.inspect,
+ @name,
@parent,
@envelope,
[@x0, @x1, @y0, @y1],
@@ -811,7 +822,8 @@ if $with_gui
end
def to_s
- format("#<%s: name: %s, envelope: %s>", self.class, @name.inspect, @envelope.to_string)
+ format("#<%s: name: %p, envelope: %s>",
+ self.class, @name, @envelope.to_string)
end
def axis_bounds
@@ -819,9 +831,11 @@ if $with_gui
end
def axis_bounds=(bounds)
- assert_type((array?(bounds) and bounds.length == 4),
- bounds, 0, "an array of 4 elements [x0, x1, y0, y1]")
- @x0, @x1, @y0, @y1 = bounds.map do |x| x.to_f end
+ assert_type((array?(bounds) and bounds.length == 4), bounds, 0,
+ "an array of 4 elements [x0, x1, y0, y1]")
+ @x0, @x1, @y0, @y1 = bounds.map do |x|
+ x.to_f
+ end
self.envelope = @init
end
@@ -862,8 +876,11 @@ if $with_gui
@envelope.each_pair do |x, y|
cx = grfx(x)
cy = grfy(y)
- RXFillArc(@dpy, @window, @gc, cx - Mouse_r, cy - Mouse_r, Mouse_d, Mouse_d, 0, 360*64)
- RXDrawLine(@dpy, @window, @gc, lx, ly, cx, cy) if lx
+ RXFillArc(@dpy, @window, @gc,
+ cx - Mouse_r, cy - Mouse_r, Mouse_d, Mouse_d, 0, 360 * 64)
+ if lx
+ RXDrawLine(@dpy, @window, @gc, lx, ly, cx, cy)
+ end
lx, ly = cx, cy
end
end
@@ -872,7 +889,7 @@ if $with_gui
def redraw
if is_managed?(@drawer) and @px0 and @py0 > @py1
size = widget_size(RGTK_WIDGET(@drawer))
- cairo = Rgdk_cairo_create(RGDK_DRAWABLE(Rgtk_widget_get_window(@drawer)))
+ cairo = make_cairo(@drawer)
Rcairo_push_group(cairo)
Rcairo_set_source_rgb(cairo, 1.0, 1.0, 1.0)
Rcairo_rectangle(cairo, 0, 0, size[0], size[1])
@@ -903,7 +920,8 @@ if $with_gui
end
Rcairo_pop_group_to_source(cairo)
Rcairo_paint(cairo)
- Rcairo_destroy(cairo)
+ # Rcairo_destroy(cairo)
+ free_cairo(cairo)
end
end
end
@@ -940,11 +958,11 @@ if $with_gui
# more examples in effects.rb
xe = xenved_test
-xe.envelope # --> [0.0, 0.0, 1.0, 1.0]
-xe.click_time # --> 0.5
+xe.envelope # ==> [0.0, 0.0, 1.0, 1.0]
+xe.click_time # ==> 0.5
xe.envelope = [0, 1, 1, 1]
# some clicks later
-xe.envelope # --> [0.0, 0.0,
+xe.envelope # ==> [0.0, 0.0,
# 0.190735694822888, 0.562264150943396,
# 0.632152588555858, 0.932075471698113,
# 0.848773841961853, 0.316981132075472,
@@ -959,11 +977,18 @@ xe.help # this help
if $with_motif
def create_enved
- @drawer = RXtCreateManagedWidget(@name, RxmDrawingAreaWidgetClass, @parent, @args)
+ @drawer = RXtCreateManagedWidget(@name, RxmDrawingAreaWidgetClass,
+ @parent, @args)
@dpy = RXtDisplay(@drawer)
@window = RXtWindow(@drawer)
- RXtAddCallback(@drawer, RXmNresizeCallback, lambda do |w, c, i| draw_axes_cb end)
- RXtAddCallback(@drawer, RXmNexposeCallback, lambda do |w, c, i| draw_axes_cb end)
+ RXtAddCallback(@drawer, RXmNresizeCallback,
+ lambda do |w, c, i|
+ draw_axes_cb
+ end)
+ RXtAddCallback(@drawer, RXmNexposeCallback,
+ lambda do |w, c, i|
+ draw_axes_cb
+ end)
RXtAddEventHandler(@drawer, RButtonPressMask, false,
lambda do |w, c, e, f|
mouse_press_cb(ungrfx(Rx(e)), ungrfy(Ry(e)))
@@ -994,7 +1019,8 @@ xe.help # this help
Rgtk_widget_show(@drawer)
Rgtk_widget_set_name(@drawer, @name)
Rgtk_widget_set_size_request(@drawer, -1, 200)
- add_event_handler(@drawer, "expose_event") do |w, e, d|
+ evname = provided?(:gtk3) ? "draw" : "expose_event"
+ add_event_handler(@drawer, evname) do |w, e, d|
draw_axes_cb
false
end
@@ -1035,16 +1061,46 @@ xe.help # this help
end
end
- def draw_axes_cb
- @px0, @py0, @px1, @py1 = draw_axes(@drawer, @gc, @name, @lx0, @lx1, @ly0, @ly1)
- redraw
+ if $with_motif
+ # Motif's DRAW_AXES takes 3 required and 6 optional arguments.
+ # draw_axes(wid, gc, label,
+ # x0=0.0, x1=1.0, y0=-1.0, y1=1.0,
+ # style=X_axis_in_seconds,
+ # axes=Show_all_axes)
+ def draw_axes_cb
+ @px0, @py0, @px1, @py1 = draw_axes(@drawer, @gc, @name,
+ @lx0, @lx1, @ly0, @ly1,
+ X_axis_in_seconds,
+ Show_all_axes)
+ redraw
+ end
+ end
+
+ if $with_gtk
+ # Gtk's DRAW_AXES takes 3 required and 7 optional arguments.
+ # draw_axes(wid, gc, label,
+ # x0=0.0, x1=1.0, y0=-1.0, y1=1.0,
+ # style=X_axis_in_seconds,
+ # axes=Show_all_axes,
+ # cairo)
+ def draw_axes_cb
+ cairo = make_cairo(@drawer)
+ @px0, @py0, @px1, @py1 = draw_axes(@drawer, @gc, @name,
+ @lx0, @lx1, @ly0, @ly1,
+ X_axis_in_seconds,
+ Show_all_axes,
+ cairo)
+ free_cairo(cairo)
+ redraw
+ end
end
def ungrfx(x)
if @px0 == @px1
@x0
else
- [@x1, [@x0, @x0 + ((@x1 - @x0) * ((x - @px0) / (@px1.to_f - @px0)))].max].min
+ [@x1,
+ [@x0, @x0 + ((@x1 - @x0) * ((x - @px0) / (@px1.to_f - @px0)))].max].min
end
end
@@ -1052,7 +1108,8 @@ xe.help # this help
if @py0 == @py1
@y1
else
- [@y1, [@y0, @y0 + ((@y1 - @y0) * ((@py0 - y) / (@py0.to_f - @py1)))].max].min
+ [@y1,
+ [@y0, @y0 + ((@y1 - @y0) * ((@py0 - y) / (@py0.to_f - @py1)))].max].min
end
end
@@ -1060,7 +1117,10 @@ xe.help # this help
if @px0 == @px1
@px0
else
- [@px1, [@px0, (@px0 + ((@px1 - @px0) * ((x - @x0) / (@x1.to_f - @x0)))).round].max].min
+ [@px1,
+ [@px0,
+ (@px0 +
+ ((@px1 - @px0) * ((x - @x0) / (@x1.to_f - @x0)))).round].max].min
end
end
@@ -1068,7 +1128,10 @@ xe.help # this help
if @py0 == @py1
@py0
else
- [@py0, [@py1, (@py1 + ((@py0 - @py1) * ((y - @y1) / (@y0.to_f - @y1)))).round].max].min
+ [@py0,
+ [@py1,
+ (@py1 +
+ ((@py0 - @py1) * ((y - @y1) / (@y0.to_f - @y1)))).round].max].min
end
end
end
diff --git a/xm-enved.scm b/xm-enved.scm
index 980cd95..61f91c9 100644
--- a/xm-enved.scm
+++ b/xm-enved.scm
@@ -4,40 +4,28 @@
;;; (xe-envelope editor) -> current envelope (settable)
(provide 'snd-xm-enved.scm)
-(define with-gtk2 (provided? 'gtk2))
-(define with-gtk3 (provided? 'gtk3))
-(if (provided? 'snd-motif)
- (if (not (provided? 'xm))
- (let ((hxm (dlopen "xm.so")))
- (if (string? hxm)
- (snd-error (format #f "xm-enved.scm needs the xm module (either 'make xm' or build Snd with --with-static-xm): ~A" hxm))
- (dlinit hxm "Init_libxm"))))
- (if (provided? 'snd-gtk)
- (if (not (provided? 'xg))
- (let ((hxm (dlopen "xg.so")))
- (if (string? hxm)
- (snd-error (format #f "xm-enved.scm needs the xg module (either 'make xg' or build Snd with --with-static-xg): ~A" hxm))
- (dlinit hxm "Init_libxg"))))))
+(if (and (provided? 'snd-motif)
+ (not (provided? 'snd-snd-motif.scm)))
+ (load "snd-motif.scm"))
(define xe-envelope
- (make-procedure-with-setter
+ (dilambda
(lambda (drawer)
- "accessor for the current xm-enved envelope"
(or (car drawer)
- (let ((ax-inf (list-ref drawer 3)))
- (list (list-ref ax-inf 0)
- (list-ref ax-inf 1)
- (list-ref ax-inf 2)
- (list-ref ax-inf 3))))) ; was 1?
+ (let ((ax-inf (drawer 3)))
+ (list (ax-inf 0)
+ (ax-inf 1)
+ (ax-inf 2)
+ (ax-inf 3))))) ; was 1?
(lambda (drawer new-env)
- (list-set! drawer 0 new-env)
+ (set! (drawer 0) new-env)
(xe-redraw drawer))))
(define (xe-create-enved name parent args axis-bounds)
(define (xe-add-envelope-point x y cur-env)
- (let ((new-env '()))
+ (let ((new-env ()))
(define (search-point e)
(if (null? e)
(append new-env (list x y))
@@ -51,7 +39,7 @@
(search-point cur-env)))
(define (xe-edit-envelope-point pos x y cur-env)
- (let ((new-env '()))
+ (let ((new-env ()))
(define (search-point e npos)
(if (= npos pos)
(append new-env (list x y) (cddr e))
@@ -61,7 +49,7 @@
(search-point cur-env 0)))
(define (xe-remove-envelope-point pos cur-env)
- (let ((new-env '()))
+ (let ((new-env ()))
(define (search-point e npos)
(if (null? e)
new-env
@@ -81,19 +69,19 @@
(define (xe-on-dot? x y cur-env pos)
(define xe-mouse-radius .03)
- (and (not (null? cur-env))
+ (and (pair? cur-env)
(or (and (< (abs (- (car cur-env) x)) xe-mouse-radius)
(< (abs (- (cadr cur-env) y)) xe-mouse-radius)
pos)
(xe-on-dot? x y (cddr cur-env) (+ pos 2)))))
(define (xe-ungrfy drawer y)
- (let* ((bounds (list-ref drawer 3))
- (locs (list-ref drawer 2))
- (ay0 (list-ref bounds 1))
- (ay1 (list-ref bounds 3))
- (py0 (list-ref locs 1))
- (py1 (list-ref locs 3)))
+ (let* ((bounds (drawer 3))
+ (locs (drawer 2))
+ (ay0 (bounds 1))
+ (ay1 (bounds 3))
+ (py0 (locs 1))
+ (py1 (locs 3)))
(if (= py0 py1)
ay1
(min ay1
@@ -103,12 +91,12 @@
(- py0 py1)))))))))
(define (xe-ungrfx drawer x)
- (let* ((bounds (list-ref drawer 3))
- (locs (list-ref drawer 2))
- (ax0 (list-ref bounds 0))
- (ax1 (list-ref bounds 2))
- (px0 (list-ref locs 0))
- (px1 (list-ref locs 2)))
+ (let* ((bounds (drawer 3))
+ (locs (drawer 2))
+ (ax0 (bounds 0))
+ (ax1 (bounds 2))
+ (px0 (locs 0))
+ (px1 (locs 2)))
(if (= px0 px1)
ax0
(min ax1
@@ -142,39 +130,37 @@
(let* ((cur-env (xe-envelope drawer))
(x (xe-ungrfx drawer xx))
(y (xe-ungrfy drawer yy))
- (ax-pix (list-ref drawer 2))
(lx (if (= xe-mouse-pos 0)
(car cur-env)
(if (>= xe-mouse-pos (- (length cur-env) 2))
- (list-ref cur-env (- (length cur-env) 2))
- (max (list-ref cur-env (- xe-mouse-pos 2))
+ (cur-env (- (length cur-env) 2))
+ (max (cur-env (- xe-mouse-pos 2))
(min x
- (list-ref cur-env (+ xe-mouse-pos 2))))))))
+ (cur-env (+ xe-mouse-pos 2))))))))
(set! (xe-envelope drawer)
(xe-edit-envelope-point xe-mouse-pos lx y cur-env))
(xe-redraw drawer)))
(define (xe-mouse-release drawer xx yy)
- (let* ((cur-env (xe-envelope drawer))
- (x (xe-ungrfx drawer xx))
- (y (xe-ungrfy drawer yy))
- (ax-pix (list-ref drawer 2)))
+ (let ((cur-env (xe-envelope drawer)))
(set! xe-mouse-up (get-internal-real-time))
(if (and (not xe-mouse-new)
(<= (- xe-mouse-up xe-mouse-down) xe-click-time)
(not (= xe-mouse-pos 0))
- (not (>= xe-mouse-pos (- (length cur-env) 2))))
+ (< xe-mouse-pos (- (length cur-env) 2)))
(set! (xe-envelope drawer)
(xe-remove-envelope-point xe-mouse-pos cur-env)))
(xe-redraw drawer)
(set! xe-mouse-new #f)))
(if (provided? 'snd-motif)
- (begin
+ (with-let (sublet *motif*
+ 'args args 'parent parent 'axis-bounds axis-bounds 'name name
+ 'xe-redraw xe-redraw 'xe-mouse-press xe-mouse-press 'xe-mouse-drag xe-mouse-drag 'xe-mouse-release xe-mouse-release)
(if (not (member XmNbackground args))
- (set! args (append args (list XmNbackground (graph-color)))))
+ (set! args (append args (list XmNbackground *graph-color*))))
(if (not (member XmNforeground args))
- (set! args (append args (list XmNforeground (data-color)))))
+ (set! args (append args (list XmNforeground *data-color*))))
(let* ((drawer (XtCreateManagedWidget name xmDrawingAreaWidgetClass parent args))
(gc (car (snd-gcs)))
(x0 (car axis-bounds))
@@ -190,11 +176,11 @@
name)))
(XtAddCallback drawer XmNresizeCallback
(lambda (w context info)
- (list-set! editor 2 (apply draw-axes drawer gc name axis-bounds))
+ (set! (editor 2) (apply draw-axes drawer gc name axis-bounds))
(xe-redraw editor)))
(XtAddCallback drawer XmNexposeCallback
(lambda (w context info)
- (list-set! editor 2 (apply draw-axes drawer gc name axis-bounds))
+ (set! (editor 2) (apply draw-axes drawer gc name axis-bounds))
(xe-redraw editor)))
(XtAddEventHandler drawer ButtonPressMask #f
(lambda (w context ev flag)
@@ -213,131 +199,133 @@
(XUndefineCursor (XtDisplay w) (XtWindow w))))
editor))
- (let* ((drawer (gtk_drawing_area_new))
- (gc (car (snd-gcs)))
- (x0 (car axis-bounds))
- (x1 (cadr axis-bounds))
- (y0 (caddr axis-bounds))
- (y1 (cadddr axis-bounds))
- (arrow-cursor (gdk_cursor_new GDK_CROSSHAIR))
- (old-cursor (gdk_cursor_new GDK_LEFT_PTR))
- (editor (list (list x0 y0 x1 y0) ; needs to be in user-coordinates (graph size can change)
- drawer
- #f ; axis pixel locs filled in when drawn
- (list x0 y0 x1 y1)
- (list gc #f)
- name))
- (dragging #f))
-
- ;; (xe-create-enved "hi" (list-ref (sound-widgets 0) 9) '() '(0.0 1.0 0.0 1.0))
-
- (define (local-draw-axes wid gc label x0 x1 y0 y1)
- (let ((cr (make-cairo wid)))
- (let ((val (draw-axes wid gc label x0 x1 y0 y1 x-axis-in-seconds show-all-axes cr)))
- (free-cairo cr)
- val)))
-
- (gtk_widget_set_events drawer GDK_ALL_EVENTS_MASK)
- (gtk_box_pack_start (GTK_BOX parent) drawer #t #t 10)
- (gtk_widget_show drawer)
- (gtk_widget_set_size_request drawer -1 200)
-
- (g_signal_connect_closure_by_id (GPOINTER drawer)
- (g_signal_lookup (if with-gtk3 "draw" "expose_event")
- (G_OBJECT_TYPE (G_OBJECT drawer)))
- 0 (g_cclosure_new (lambda (w e d)
- (list-set! editor 2 (apply local-draw-axes drawer gc name axis-bounds))
- (xe-redraw editor)
- #f)
- #f #f)
- #f)
- (g_signal_connect_closure_by_id (GPOINTER drawer)
- (g_signal_lookup "configure_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
- 0 (g_cclosure_new (lambda (w e d)
- (list-set! editor 2 (apply local-draw-axes drawer gc name axis-bounds))
- (xe-redraw editor)
- #f)
- #f #f)
- #f)
- (g_signal_connect_closure_by_id (GPOINTER drawer)
- (g_signal_lookup "button_press_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
- 0 (g_cclosure_new (lambda (w e d)
- (let* ((ev (GDK_EVENT e))
- (coords (gdk_event_get_coords ev))
- (x (cadr coords))
- (y (caddr coords)))
- (set! dragging #t)
- (xe-mouse-press editor x y))
- #f)
- #f #f)
- #f)
- (g_signal_connect_closure_by_id (GPOINTER drawer)
- (g_signal_lookup "button_release_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
- 0 (g_cclosure_new (lambda (w e d)
- (let* ((ev (GDK_EVENT e))
- (coords (gdk_event_get_coords ev))
- (x (cadr coords))
- (y (caddr coords)))
- (set! dragging #f)
- (xe-mouse-release editor x y))
- #f)
- #f #f)
- #f)
- (g_signal_connect_closure_by_id (GPOINTER drawer)
- (g_signal_lookup "motion_notify_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
- 0 (g_cclosure_new (lambda (w e d)
- (if dragging
- (let* ((ev (GDK_EVENT e))
- (coords (gdk_event_get_coords ev))
- (x (cadr coords))
- (y (caddr coords)))
- (xe-mouse-drag editor x y)))
- #f)
- #f #f)
- #f)
-
- (g_signal_connect_closure_by_id (GPOINTER drawer)
- (g_signal_lookup "enter_notify_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
- 0 (g_cclosure_new (lambda (w e d)
- (gdk_window_set_cursor (gtk_widget_get_window w) arrow-cursor)
- #f)
- #f #f)
- #f)
- (g_signal_connect_closure_by_id (GPOINTER drawer)
- (g_signal_lookup "leave_notify_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
- 0 (g_cclosure_new (lambda (w e d)
- (gdk_window_set_cursor (gtk_widget_get_window w) old-cursor)
- #f)
- #f #f)
- #f)
- editor)))
+ (with-let (sublet *gtk*
+ 'args args 'parent parent 'axis-bounds axis-bounds 'name name
+ 'xe-redraw xe-redraw 'xe-mouse-press xe-mouse-press 'xe-mouse-drag xe-mouse-drag 'xe-mouse-release xe-mouse-release)
+ (let* ((drawer (gtk_drawing_area_new))
+ (gc (car (snd-gcs)))
+ (x0 (car axis-bounds))
+ (x1 (cadr axis-bounds))
+ (y0 (caddr axis-bounds))
+ (y1 (cadddr axis-bounds))
+ (arrow-cursor (gdk_cursor_new_for_display (gdk_display_get_default) GDK_CROSSHAIR))
+ (old-cursor (gdk_cursor_new_for_display (gdk_display_get_default) GDK_LEFT_PTR))
+ (editor (list (list x0 y0 x1 y0) ; needs to be in user-coordinates (graph size can change)
+ drawer
+ #f ; axis pixel locs filled in when drawn
+ (list x0 y0 x1 y1)
+ (list gc #f)
+ name))
+ (dragging #f))
+
+ ;; (xe-create-enved "hi" ((sound-widgets 0) 9) () '(0.0 1.0 0.0 1.0))
+
+ (define (local-draw-axes wid gc label x0 x1 y0 y1)
+ (let ((cr (make-cairo wid)))
+ (let ((val (draw-axes wid gc label x0 x1 y0 y1 x-axis-in-seconds show-all-axes cr)))
+ (free-cairo cr)
+ val)))
+
+ (gtk_widget_set_events drawer GDK_ALL_EVENTS_MASK)
+ (gtk_box_pack_start (GTK_BOX parent) drawer #t #t 10)
+ (gtk_widget_show drawer)
+ (gtk_widget_set_size_request drawer -1 200)
+
+ (g_signal_connect_closure_by_id (GPOINTER drawer)
+ (g_signal_lookup "draw" (G_OBJECT_TYPE (G_OBJECT drawer)))
+ 0 (g_cclosure_new (lambda (w e d)
+ (set! (editor 2) (apply local-draw-axes drawer gc name axis-bounds))
+ (xe-redraw editor)
+ #f)
+ #f #f)
+ #f)
+ (g_signal_connect_closure_by_id (GPOINTER drawer)
+ (g_signal_lookup "configure_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
+ 0 (g_cclosure_new (lambda (w e d)
+ (set! (editor 2) (apply local-draw-axes drawer gc name axis-bounds))
+ (xe-redraw editor)
+ #f)
+ #f #f)
+ #f)
+ (g_signal_connect_closure_by_id (GPOINTER drawer)
+ (g_signal_lookup "button_press_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
+ 0 (g_cclosure_new (lambda (w e d)
+ (let* ((ev (GDK_EVENT e))
+ (coords (gdk_event_get_coords ev))
+ (x (cadr coords))
+ (y (caddr coords)))
+ (set! dragging #t)
+ (xe-mouse-press editor x y))
+ #f)
+ #f #f)
+ #f)
+ (g_signal_connect_closure_by_id (GPOINTER drawer)
+ (g_signal_lookup "button_release_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
+ 0 (g_cclosure_new (lambda (w e d)
+ (let* ((ev (GDK_EVENT e))
+ (coords (gdk_event_get_coords ev))
+ (x (cadr coords))
+ (y (caddr coords)))
+ (set! dragging #f)
+ (xe-mouse-release editor x y))
+ #f)
+ #f #f)
+ #f)
+ (g_signal_connect_closure_by_id (GPOINTER drawer)
+ (g_signal_lookup "motion_notify_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
+ 0 (g_cclosure_new (lambda (w e d)
+ (if dragging
+ (let* ((ev (GDK_EVENT e))
+ (coords (gdk_event_get_coords ev))
+ (x (cadr coords))
+ (y (caddr coords)))
+ (xe-mouse-drag editor x y)))
+ #f)
+ #f #f)
+ #f)
+
+ (g_signal_connect_closure_by_id (GPOINTER drawer)
+ (g_signal_lookup "enter_notify_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
+ 0 (g_cclosure_new (lambda (w e d)
+ (gdk_window_set_cursor (gtk_widget_get_window w) arrow-cursor)
+ #f)
+ #f #f)
+ #f)
+ (g_signal_connect_closure_by_id (GPOINTER drawer)
+ (g_signal_lookup "leave_notify_event" (G_OBJECT_TYPE (G_OBJECT drawer)))
+ 0 (g_cclosure_new (lambda (w e d)
+ (gdk_window_set_cursor (gtk_widget_get_window w) old-cursor)
+ #f)
+ #f #f)
+ #f)
+ editor))))
(define (xe-redraw drawer)
(let* ((cur-env (xe-envelope drawer))
- (widget (list-ref drawer 1))
- (dpy (and (provided? 'snd-motif) (XtDisplay widget)))
- (wn (if (provided? 'snd-motif) (XtWindow widget) (gtk_widget_get_window widget)))
- (ax-pix (list-ref drawer 2))
- (ax-inf (list-ref drawer 3))
- (gc (car (list-ref drawer 4)))
- (name (list-ref drawer 5))
+ (widget (drawer 1))
+ (dpy (and (provided? 'snd-motif) ((*motif* 'XtDisplay) widget)))
+ (wn (if (provided? 'snd-motif) ((*motif* 'XtWindow) widget) ((*gtk* 'gtk_widget_get_window) widget)))
+ (ax-pix (drawer 2))
+ (ax-inf (drawer 3))
+ (gc (car (drawer 4)))
+ (name (drawer 5))
(len (and (list? cur-env) (length cur-env)))
- (get_realized (if with-gtk3 gtk_widget_get_realized (lambda (w) #t))))
+ (get_realized (if (provided? 'snd-gtk) (*gtk* 'gtk_widget_get_realized))))
(if (and (list? ax-pix)
(list? cur-env)
(if (provided? 'snd-motif)
- (XtIsManaged widget)
+ ((*motif* 'XtIsManaged) widget)
(get_realized widget)))
- (let* ((px0 (list-ref ax-pix 0))
- (px1 (list-ref ax-pix 2))
- (py0 (list-ref ax-pix 1))
- (py1 (list-ref ax-pix 3))
- (ix0 (list-ref ax-inf 0))
- (ix1 (list-ref ax-inf 2))
- (iy0 (list-ref ax-inf 1))
- (iy1 (list-ref ax-inf 3))
- (mouse-d 10)
- (mouse-r 5))
+ (let ((px0 (ax-pix 0))
+ (px1 (ax-pix 2))
+ (py0 (ax-pix 1))
+ (py1 (ax-pix 3))
+ (ix0 (ax-inf 0))
+ (ix1 (ax-inf 2))
+ (iy0 (ax-inf 1))
+ (iy1 (ax-inf 3))
+ (mouse-d 10)
+ (mouse-r 5))
(define (xe-grfx drawer x)
(if (= px0 px1)
@@ -361,63 +349,53 @@
(begin
(if (provided? 'snd-motif)
(begin
- (XClearWindow dpy wn)
+ ((*motif* 'XClearWindow) dpy wn)
(draw-axes widget gc name ix0 ix1 iy0 iy1)
(let ((lx #f)
(ly #f))
(do ((i 0 (+ i 2)))
((= i len))
- (let ((cx (xe-grfx drawer (list-ref cur-env i)))
- (cy (xe-grfy drawer (list-ref cur-env (+ i 1)))))
- (XFillArc dpy wn gc
- (- cx mouse-r)
- (- cy mouse-r)
- mouse-d mouse-d
- 0 (* 360 64))
+ (let ((cx (xe-grfx drawer (cur-env i)))
+ (cy (xe-grfy drawer (cur-env (+ i 1)))))
+ ((*motif* 'XFillArc)
+ dpy wn gc
+ (- cx mouse-r)
+ (- cy mouse-r)
+ mouse-d mouse-d
+ 0 (* 360 64))
(if lx
- (XDrawLine dpy wn gc lx ly cx cy))
+ ((*motif* 'XDrawLine) dpy wn gc lx ly cx cy))
(set! lx cx)
(set! ly cy)))))
- (let* ((lx #f)
- (ly #f)
- (cr (gdk_cairo_create ((if (provided? 'gtk3) GDK_WINDOW GDK_DRAWABLE) wn)))
- (size (widget-size (GTK_WIDGET widget))))
+ ;; *gtk*
+ (let ((lx #f)
+ (ly #f)
+ (cr ((*gtk* 'gdk_cairo_create) ((*gtk* 'GDK_WINDOW) wn)))
+ (size (widget-size ((*gtk* 'GTK_WIDGET) widget))))
- (cairo_push_group cr)
-
- (let ((bg-color (color->list (basic-color))))
- (cairo_set_source_rgb cr 1.0 1.0 1.0)
- (cairo_rectangle cr 0 0 (car size) (cadr size))
- (cairo_fill cr))
+ ((*gtk* 'cairo_push_group) cr)
+ ((*gtk* 'cairo_set_source_rgb) cr 1.0 1.0 1.0)
+ ((*gtk* 'cairo_rectangle) cr 0 0 (car size) (cadr size))
+ ((*gtk* 'cairo_fill) cr)
(draw-axes widget gc name ix0 ix1 iy0 iy1 x-axis-in-seconds show-all-axes cr)
- (cairo_set_line_width cr 1.0)
- (cairo_set_source_rgb cr 0.0 0.0 0.0)
+ ((*gtk* 'cairo_set_line_width) cr 1.0)
+ ((*gtk* 'cairo_set_source_rgb) cr 0.0 0.0 0.0)
(do ((i 0 (+ i 2)))
((= i len))
- (let ((cx (xe-grfx drawer (list-ref cur-env i)))
- (cy (xe-grfy drawer (list-ref cur-env (+ i 1)))))
- (cairo_arc cr cx cy mouse-r 0.0 (* 2 pi))
- (cairo_fill cr)
+ (let ((cx (xe-grfx drawer (cur-env i)))
+ (cy (xe-grfy drawer (cur-env (+ i 1)))))
+ ((*gtk* 'cairo_arc) cr cx cy mouse-r 0.0 (* 2 pi))
+ ((*gtk* 'cairo_fill) cr)
(if lx
(begin
- (cairo_move_to cr lx ly)
- (cairo_line_to cr cx cy)
- (cairo_stroke cr)))
+ ((*gtk* 'cairo_move_to) cr lx ly)
+ ((*gtk* 'cairo_line_to) cr cx cy)
+ ((*gtk* 'cairo_stroke) cr)))
(set! lx cx)
(set! ly cy)))
- (cairo_pop_group_to_source cr)
- (cairo_paint cr)
- (cairo_destroy cr)))))))))
+ ((*gtk* 'cairo_pop_group_to_source) cr)
+ ((*gtk* 'cairo_paint) cr)
+ ((*gtk* 'cairo_destroy) cr)))))))))
-#|
-(define outer (add-main-pane "hiho" xmFormWidgetClass '()))
-
-(define editor (xe-create-enved "a name" outer
- (list XmNleftAttachment XmATTACH_FORM
- XmNtopAttachment XmATTACH_FORM
- XmNbottomAttachment XmATTACH_FORM
- XmNrightAttachment XmATTACH_FORM)
- '(0.0 1.0 0.0 1.0)))
-|#
diff --git a/xm.c b/xm.c
index 5ff4263..e4e0701 100644
--- a/xm.c
+++ b/xm.c
@@ -3,13 +3,29 @@
* for tests and examples see snd-motif.scm, bess.scm|rb, and snd-test.scm
*/
-#include <mus-config.h>
+#include "mus-config.h"
#include <stdlib.h>
-#define XM_DATE "23-Dec-09"
+
+#define HAVE_XSHAPEQUERYEXTENSION 1
+/* this dates from X11 R6.4 -- set to 0 if you're running a 20 year old version of X
+ */
+#define HAVE_XP 0
+
+
+#define XM_DATE "29-Oct-15"
/* HISTORY:
*
+ * 29-Oct-15: removed ->string.
+ * --------
+ * 6-Mar: more macro name changes.
+ * 21-Feb-14: _P changed to use _is_.
+ * --------
+ * 7-Jul-13: removed the non-standard extra widgets.
+ * --------
+ * 20-Oct: changed INT64_T to LONG_LONG.
+ * 20-Mar-11: X/Xpm/Motif are assumed now.
* --------
* 23-Dec: removed XmPrint/libXp support.
* 16-Dec: removed Guile support.
@@ -33,12 +49,12 @@
* --------
* 16-Sep: XmUNSPECIFIED_PIXEL and friends should be unsigned long (not int).
* 17-Aug: XtSetArg 3rd arg should be 0, not NULL (type mismatch if 64-bit).
- * 14-June: various xen-related updates (XEN_DEFINE).
+ * 14-June: various xen-related updates (Xen_DEFINE).
* 13-June: fold xm-ruby.c into xm.c.
* 15-Apr: XGetWindowProperty free bugfix.
* 28-Mar: fix some Ruby error strings (#f->false).
* 31-Jan: remove Motif 1 support, and Lesstif.
- * 4-Jan-05: replace XEN_VECTOR_ELEMENTS usages.
+ * 4-Jan-05: replace Xen_VECTOR_ELEMENTS usages.
* --------
* 30-Dec: plug various memory leaks.
* 23-Nov: resource type lookup indexing bugfix.
@@ -111,7 +127,7 @@
* 29-Mar: XmParseProc.
* 20-Mar: XpmGetErrorString omitted inadvertently earlier.
* 4-Mar: XWindowChanges and XSetWindowAttributes struct creators.
- * 1-Mar: XmTabListFree, various ->* conversions (->strings etc).
+ * 1-Mar: XmTabListFree, various ->* conversions(->strings etc).
* 25-Feb: XmTextBlock fields
* 22-Feb: #f = NULL and vice-versa throughout
* 21-Feb: added various callback struct makers, changed XtCallCallbacks to be compatible with them.
@@ -134,7 +150,7 @@
* XVisualInfo fields added.
* Cursor type added.
* 1-Feb: Motif 2.2 additions (tooltip).
- * 21-Jan: Ruby fixups (XEN_COPY_ARG to protect lists)
+ * 21-Jan: Ruby fixups (Xen_COPY_ARG to protect lists)
* 7-Jan-02: XEvent fields settable. added XtCallCallbacks-raw.
* ----------
* 12-Sep: xm-version.
@@ -144,31 +160,22 @@
* 23-Jul-01: use lists rather than vectors.
*/
-#if UNDEF_USE_SND
- #undef USE_SND
- #define USE_SND 0
-#endif
-
#if HAVE_EXTENSION_LANGUAGE
-#if HAVE_MOTIF
#include <Xm/XmAll.h>
-#else
- #include <X11/Xlib.h>
- #include <X11/Intrinsic.h>
- #include <X11/Shell.h>
- #include <X11/Xatom.h>
-#endif
-
-#include <X11/keysym.h>
-#include <X11/cursorfont.h>
-#include <stdio.h>
+ #include <X11/keysym.h>
+ #include <X11/cursorfont.h>
+ #include <stdio.h>
#if HAVE_XSHAPEQUERYEXTENSION
#include <X11/extensions/shape.h>
#endif
-/* compile-time flags are HAVE_MOTIF HAVE_RUBY MUS_WITH_EDITRES */
+#if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L))))
+ #define __func__ __FUNCTION__
+#endif
+
+/* compile-time flags are HAVE_RUBY|SCHEME WITH_EDITRES */
/* if you're using g++ and it complains about XmRemoveFromPostFromList, update Motif (you need 2.1.30) */
@@ -179,53 +186,25 @@
#include "xen.h"
/* in snd-0.h: */
#if HAVE_RUBY
- #define S_setB "set_"
+ #define S_set "set_"
#define PROC_FALSE "false"
#define PROC_TRUE "true"
#endif
#if HAVE_SCHEME
- #define S_setB "set! "
+ #define S_set "set! "
#define PROC_FALSE "#f"
#define PROC_TRUE "#t"
#endif
#if HAVE_FORTH
- #define S_setB "set-"
+ #define S_set "set-"
#define PROC_FALSE "#f"
#define PROC_TRUE "#t"
#endif
#define NOT_A_GC_LOC -1
#endif
-#ifndef calloc
- #define calloc(a, b) calloc((size_t)(a), (size_t)(b))
- #define malloc(a) malloc((size_t)(a))
- #define free(a) free(a)
- #define realloc(a, b) realloc(a, (size_t)(b))
-#endif
-
#include <X11/xpm.h>
-#if HAVE_XmCreateDataField
- #include <Xm/DataF.h>
-#endif
-#if HAVE_XmCreateTabStack
- #include <Xm/TabStack.h>
-#endif
-#if HAVE_XmCreateButtonBox
- #include <Xm/ButtonBox.h>
-#endif
-#if HAVE_XmCreateColumn
- #include <Xm/Column.h>
-#endif
-#if HAVE_XmCreateDropDown
- #include <Xm/DropDown.h>
-#endif
-#if HAVE_XmCreateFontSelector
- #include <Xm/FontS.h>
-#endif
-#if HAVE_XmCreateColorSelector
- #include <Xm/ColorS.h>
-#endif
-#if MUS_WITH_EDITRES
+#if WITH_EDITRES
#include <X11/Xmu/Editres.h>
#endif
@@ -247,16 +226,16 @@
#define XM_FIELD_PREFIX "F"
#endif
-#define XM_FIELD_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \
- XEN_ASSERT_TYPE(Assertion, Arg, Position, XM_FIELD_PREFIX Caller XM_POSTFIX, Correct_Type)
+#define XM_field_assert_type(Assertion, Arg, Position, Caller, Correct_Type) \
+ Xen_check_type(Assertion, Arg, Position, XM_FIELD_PREFIX Caller XM_POSTFIX, Correct_Type)
#if HAVE_RUBY
- #define XM_SET_FIELD_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \
- XEN_ASSERT_TYPE(Assertion, Arg, Position, XM_FIELD_PREFIX S_setB Caller XM_POSTFIX, Correct_Type)
+ #define XM_set_field_assert_type(Assertion, Arg, Position, Caller, Correct_Type) \
+ Xen_check_type(Assertion, Arg, Position, XM_FIELD_PREFIX S_set Caller XM_POSTFIX, Correct_Type)
#endif
#if HAVE_SCHEME || HAVE_FORTH
- #define XM_SET_FIELD_ASSERT_TYPE(Assertion, Arg, Position, Caller, Correct_Type) \
- XEN_ASSERT_TYPE(Assertion, Arg, Position, S_setB XM_FIELD_PREFIX Caller XM_POSTFIX, Correct_Type)
+ #define XM_set_field_assert_type(Assertion, Arg, Position, Caller, Correct_Type) \
+ Xen_check_type(Assertion, Arg, Position, S_set XM_FIELD_PREFIX Caller XM_POSTFIX, Correct_Type)
#endif
#define XtIsSubClass XtIsSubclass
@@ -282,7 +261,7 @@
* a sample program
(let* ((shell-app (XtVaOpenApplication
- "Test" 0 '() applicationShellWidgetClass
+ "Test" 0 () applicationShellWidgetClass
(list XmNallowShellResize #t)))
(app (cadr shell-app))
(shell (car shell-app))
@@ -302,7 +281,7 @@
XmNrightAttachment XmATTACH_FORM
XmNallowResize #t)))
(button (XtCreateManagedWidget
- "push me" xmPushButtonWidgetClass main-pane '() 0)))
+ "push me" xmPushButtonWidgetClass main-pane () 0)))
(XtAddCallback button XmNactivateCallback
(lambda (widget context event-info)
(display widget)
@@ -327,7 +306,7 @@
* XtCallback procedure args are passed by value
* various "client data" args are optional
* XtCallbackLists are passed as lists of procedure/data pairs
- * where explicit NULL is needed as arg, use #f (or '() for list args)
+ * where explicit NULL is needed as arg, use #f (or () for list args)
*
* omitted:
*
@@ -361,14 +340,12 @@
-/* -------------------------------- smob for GC -------------------------------- */
-
-/* "smob" for locally created stuff (X graphics entities mainly) */
+/* -------------------------------- GC -------------------------------- */
-static XEN_OBJECT_TYPE xm_obj_tag;
+static Xen_object_type_t xm_obj_tag;
#if HAVE_RUBY
-static void *xm_obj_free(XEN obj)
+static void *xm_obj_free(Xen obj)
{
void *vobj;
vobj = (void *)obj;
@@ -378,10 +355,10 @@ static void *xm_obj_free(XEN obj)
#endif
#if HAVE_FORTH
-static void xm_obj_free(XEN obj)
+static void xm_obj_free(Xen obj)
{
void *val;
- val = (void *)XEN_OBJECT_REF(obj);
+ val = (void *)Xen_object_ref(obj);
free(val);
}
#endif
@@ -398,17 +375,17 @@ static bool s7_equalp_xm(void *x1, void *x2)
}
#endif
-static XEN make_xm_obj(void *ptr)
+static Xen make_xm_obj(void *ptr)
{
- XEN_MAKE_AND_RETURN_OBJECT(xm_obj_tag, ptr, 0, xm_obj_free);
+ return(Xen_make_object(xm_obj_tag, ptr, 0, xm_obj_free));
}
static void define_xm_obj(void)
{
#if HAVE_SCHEME
- xm_obj_tag = XEN_MAKE_OBJECT_TYPE("<XmObj>", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL);
+ xm_obj_tag = s7_new_type_x(s7, "<XmObj>", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
#else
- xm_obj_tag = XEN_MAKE_OBJECT_TYPE("XmObj", sizeof(void *));
+ xm_obj_tag = Xen_make_object_type("XmObj", sizeof(void *));
#endif
#if HAVE_FORTH
@@ -424,222 +401,210 @@ static void define_xm_obj(void)
* the _PTR form treats NULL as #f and vice-versa
*/
-#define WRAP_FOR_XEN(Name, Value) XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(Name), XEN_WRAP_C_POINTER(Value))
-#define WRAP_FOR_XEN_OBJ(Name, Value) XEN_LIST_3(C_STRING_TO_XEN_SYMBOL(Name), XEN_WRAP_C_POINTER(Value), make_xm_obj(Value))
-#define WRAP_P(Name, Value) (XEN_LIST_P(Value) && \
- (XEN_LIST_LENGTH(Value) >= 2) && \
- (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (strcmp(Name, XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value))) == 0))
-
-/* XM_TYPE is used for non-pointers (XID mainly) */
-#define XM_TYPE(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(#Name), C_TO_XEN_ULONG(val)));} \
- static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} \
- static XEN XEN_ ## Name ## _p(XEN val) {return(C_TO_XEN_BOOLEAN(WRAP_P(#Name, val)));}
-
-#define XM_TYPE_NO_p(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(#Name), C_TO_XEN_ULONG(val)));} \
- static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_ULONG(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
-
-#define XM_TYPE_INT(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {return(XEN_LIST_2(C_STRING_TO_XEN_SYMBOL(#Name), C_TO_XEN_INT(val)));} \
- static XType XEN_TO_C_ ## Name (XEN val) {return((XType)XEN_TO_C_INT(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} \
- static XEN XEN_ ## Name ## _p(XEN val) {return(C_TO_XEN_BOOLEAN(WRAP_P(#Name, val)));}
-
-#define XM_TYPE_PTR(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return((XType)NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} \
- static XEN XEN_ ## Name ## _p(XEN val) {return(C_TO_XEN_BOOLEAN(WRAP_P(#Name, val)));}
-
-#define XM_TYPE_PTR_NO_p(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return((XType)NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
-
-#define XM_TYPE_PTR_NO_p_NO_P(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN(#Name, val)); return(XEN_FALSE);} \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return((XType)NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));}
-
-#define XM_TYPE_PTR_NO_C2X(Name, XType) \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return((XType)NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} \
- static XEN XEN_ ## Name ## _p(XEN val) {return(C_TO_XEN_BOOLEAN(WRAP_P(#Name, val)));}
-
-#define XM_TYPE_PTR_NO_C2X_NO_p(Name, XType) \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return((XType)NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));}
-
-#define XM_TYPE_PTR_OBJ(Name, XType) \
- static XEN C_TO_XEN_ ## Name (XType val) {if (val) return(WRAP_FOR_XEN_OBJ(#Name, val)); return(XEN_FALSE);} \
- static XType XEN_TO_C_ ## Name (XEN val) {if (XEN_FALSE_P(val)) return(NULL); return((XType)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));} \
- static bool XEN_ ## Name ## _P(XEN val) {return(WRAP_P(#Name, val));} \
- static XEN XEN_ ## Name ## _p(XEN val) {return(C_TO_XEN_BOOLEAN(WRAP_P(#Name, val)));}
-
-
-
-#define XEN_TO_C_Dimension(Arg) (Dimension)(XEN_TO_C_INT(Arg))
-#define C_TO_XEN_Dimension(Arg) (C_TO_XEN_INT((Dimension)Arg))
-#define XEN_Dimension_P(Arg) (XEN_INTEGER_P(Arg))
-
-#define XEN_TO_C_Position(Arg) (Position)(XEN_TO_C_INT(Arg))
-#define C_TO_XEN_Position(Arg) (C_TO_XEN_INT((Position)Arg))
-#define XEN_Position_P(Arg) (XEN_INTEGER_P(Arg))
-
-#define XEN_TO_C_char(Arg) (char)(XEN_TO_C_INT(Arg))
-#define C_TO_XEN_char(Arg) (C_TO_XEN_INT(Arg))
-#define XEN_char_P(Arg) (XEN_INTEGER_P(Arg))
-
-#define XEN_TO_C_Modifiers(Arg) (Modifiers)(XEN_TO_C_ULONG(Arg))
-#define C_TO_XEN_Modifiers(Arg) (C_TO_XEN_ULONG(Arg))
-#define XEN_Modifiers_P(Arg) (XEN_ULONG_P(Arg))
-
-XM_TYPE(Cursor, Cursor)
-XM_TYPE_PTR(Screen, Screen *)
-XM_TYPE_PTR_OBJ(XRectangle, XRectangle *)
-XM_TYPE_PTR_OBJ(XArc, XArc *)
-XM_TYPE_PTR_OBJ(XPoint, XPoint *)
-XM_TYPE_PTR_OBJ(XSegment, XSegment *)
-XM_TYPE_PTR_OBJ(XColor, XColor *)
-XM_TYPE(Atom, Atom)
-XM_TYPE(Colormap, Colormap) /* XID */
-XM_TYPE_PTR_NO_C2X(Depth, Depth *)
-XM_TYPE_PTR(Display, Display *)
-XM_TYPE(Font, Font)
-XM_TYPE_PTR(GC, GC)
-XM_TYPE(KeySym, KeySym)
-XM_TYPE(Pixel, Pixel)
-XM_TYPE(Pixmap, Pixmap)
-XM_TYPE(Region, Region)
-XM_TYPE(Time, Time)
-XM_TYPE_PTR(Visual, Visual *)
-XM_TYPE(Window, Window) /* this is XID = long I think */
-XM_TYPE_PTR(XCharStruct, XCharStruct *)
-XM_TYPE_PTR(XFontProp, XFontProp *)
-XM_TYPE(XFontSet, XFontSet)
-XM_TYPE_PTR(XFontStruct, XFontStruct *)
-XM_TYPE_PTR(XGCValues, XGCValues *)
-XM_TYPE_PTR_NO_C2X(XTextItem, XTextItem *)
-XM_TYPE_PTR(XModifierKeymap, XModifierKeymap *) /* opaque in this implementation */
-XM_TYPE_PTR(XImage, XImage *)
-static XAnyEvent *XEN_TO_C_XAnyEvent(XEN val) {return((XAnyEvent *)XEN_UNWRAP_C_POINTER(XEN_CADR(val)));}
-XM_TYPE_PTR_NO_C2X(XButtonEvent, XButtonEvent *)
-XM_TYPE_PTR_NO_C2X(XCirculateEvent, XCirculateEvent *)
-XM_TYPE_PTR_NO_C2X(XCirculateRequestEvent, XCirculateRequestEvent *)
-XM_TYPE_PTR_NO_C2X(XClientMessageEvent, XClientMessageEvent *)
-XM_TYPE_PTR_NO_C2X(XColormapEvent, XColormapEvent *)
-XM_TYPE_PTR_NO_C2X(XConfigureEvent, XConfigureEvent *)
-XM_TYPE_PTR_NO_C2X(XConfigureRequestEvent, XConfigureRequestEvent *)
-XM_TYPE_PTR_NO_C2X(XCreateWindowEvent, XCreateWindowEvent *)
-XM_TYPE_PTR_NO_C2X(XCrossingEvent, XCrossingEvent *)
-XM_TYPE_PTR_NO_C2X(XDestroyWindowEvent, XDestroyWindowEvent *)
-XM_TYPE_PTR(XErrorEvent, XErrorEvent *)
-XM_TYPE_PTR_NO_C2X(XExposeEvent, XExposeEvent *)
-XM_TYPE_PTR_NO_C2X(XFocusChangeEvent, XFocusChangeEvent *)
-XM_TYPE_PTR_NO_C2X(XGraphicsExposeEvent, XGraphicsExposeEvent *)
-XM_TYPE_PTR_NO_C2X(XGravityEvent, XGravityEvent *)
-XM_TYPE_PTR_NO_C2X(XKeyEvent, XKeyEvent *)
-XM_TYPE_PTR_NO_C2X(XKeymapEvent, XKeymapEvent *)
-XM_TYPE_PTR_NO_C2X(XMapEvent, XMapEvent *)
-XM_TYPE_PTR_NO_C2X(XMapRequestEvent, XMapRequestEvent *)
-XM_TYPE_PTR_NO_C2X(XMappingEvent, XMappingEvent *)
-XM_TYPE_PTR_NO_C2X(XMotionEvent, XMotionEvent *)
-XM_TYPE_PTR_NO_C2X(XNoExposeEvent, XNoExposeEvent *)
-XM_TYPE_PTR_NO_C2X(XPropertyEvent, XPropertyEvent *)
-XM_TYPE_PTR_NO_C2X(XReparentEvent, XReparentEvent *)
-XM_TYPE_PTR_NO_C2X(XResizeRequestEvent, XResizeRequestEvent *)
-XM_TYPE_PTR_NO_C2X(XSelectionClearEvent, XSelectionClearEvent *)
-XM_TYPE_PTR_NO_C2X(XSelectionEvent, XSelectionEvent *)
-XM_TYPE_PTR(XSelectionRequestEvent, XSelectionRequestEvent *)
-XM_TYPE_PTR_NO_C2X(XUnmapEvent, XUnmapEvent *)
-XM_TYPE_PTR_NO_C2X(XVisibilityEvent, XVisibilityEvent *)
-XM_TYPE_PTR_OBJ(XSetWindowAttributes, XSetWindowAttributes *)
-XM_TYPE_PTR(XVisualInfo, XVisualInfo *)
-XM_TYPE_PTR(XWMHints, XWMHints *)
-XM_TYPE_PTR_NO_C2X_NO_p(XSizeHints, XSizeHints *)
-XM_TYPE_PTR(XWindowAttributes, XWindowAttributes *)
-XM_TYPE_PTR_OBJ(XWindowChanges, XWindowChanges *)
-XM_TYPE_PTR(XStandardColormap, XStandardColormap *)
-XM_TYPE_INT(KeyCode, KeyCode)
-XM_TYPE_INT(XContext, XContext)
-XM_TYPE_PTR(XIconSize, XIconSize *)
-
-#if HAVE_MOTIF
-XM_TYPE_PTR(Widget, Widget)
-XM_TYPE(WidgetClass, WidgetClass)
-XM_TYPE(XtAppContext, XtAppContext)
-XM_TYPE(XtRequestId, XtRequestId)
-XM_TYPE(XtWorkProcId, XtWorkProcId)
-XM_TYPE(XtInputId, XtInputId)
-XM_TYPE(XtIntervalId, XtIntervalId)
-XM_TYPE_NO_p(XtActionHookId, XtActionHookId)
-XM_TYPE_NO_p(XtTranslations, XtTranslations) /* opaque */
-XM_TYPE_PTR(XmString, XmString)
-XM_TYPE_PTR_NO_p_NO_P(XmAnyCallbackStruct, XmAnyCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmArrowButtonCallbackStruct, XmArrowButtonCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmCommandCallbackStruct, XmCommandCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDragDropFinishCallbackStruct, XmDragDropFinishCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDragMotionCallbackStruct, XmDragMotionCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDragProcCallbackStruct, XmDragProcCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDrawingAreaCallbackStruct, XmDrawingAreaCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDrawnButtonCallbackStruct, XmDrawnButtonCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDropFinishCallbackStruct, XmDropFinishCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDropProcCallbackStruct, XmDropProcCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDropSiteEnterCallbackStruct, XmDropSiteEnterCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDropSiteLeaveCallbackStruct, XmDropSiteLeaveCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDropStartCallbackStruct, XmDropStartCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmFileSelectionBoxCallbackStruct, XmFileSelectionBoxCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmListCallbackStruct, XmListCallbackStruct *)
-XM_TYPE(XmTab, XmTab) /* opaque */
-XM_TYPE_PTR_NO_p(XmDragStartCallbackStruct, XmDragStartCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDisplayCallbackStruct, XmDisplayCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmDestinationCallbackStruct, XmDestinationCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmConvertCallbackStruct, XmConvertCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmComboBoxCallbackStruct, XmComboBoxCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmContainerOutlineCallbackStruct, XmContainerOutlineCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmContainerSelectCallbackStruct, XmContainerSelectCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmNotebookCallbackStruct, XmNotebookCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmNotebookPageInfo, XmNotebookPageInfo *)
-XM_TYPE_PTR(XmRenderTable, XmRenderTable)
-XM_TYPE_PTR(XmRendition, XmRendition)
-XM_TYPE_PTR_NO_p(XmSpinBoxCallbackStruct, XmSpinBoxCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmTraverseObscuredCallbackStruct, XmTraverseObscuredCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmTopLevelLeaveCallbackStruct, XmTopLevelLeaveCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmTopLevelEnterCallbackStruct, XmTopLevelEnterCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmPopupHandlerCallbackStruct, XmPopupHandlerCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmSelectionCallbackStruct, XmSelectionCallbackStruct *)
-XM_TYPE_PTR_NO_C2X_NO_p(XmTransferDoneCallbackStruct, XmTransferDoneCallbackStruct *)
-XM_TYPE_PTR(XmTabList, XmTabList) /* opaque */
-XM_TYPE(XmParseMapping, XmParseMapping)
-XM_TYPE_PTR_NO_p(XmOperationChangedCallbackStruct, XmOperationChangedCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmPushButtonCallbackStruct, XmPushButtonCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmRowColumnCallbackStruct, XmRowColumnCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmScaleCallbackStruct, XmScaleCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmScrollBarCallbackStruct, XmScrollBarCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmSelectionBoxCallbackStruct, XmSelectionBoxCallbackStruct *)
-XM_TYPE_PTR_NO_p(XmTextVerifyCallbackStruct, XmTextVerifyCallbackStruct *)
-XM_TYPE_PTR_NO_C2X_NO_p(XmTextBlock, XmTextBlock)
-XM_TYPE_PTR_NO_p(XmToggleButtonCallbackStruct, XmToggleButtonCallbackStruct *)
-#if HAVE_XmCreateDataField
-XM_TYPE_PTR_NO_p(XmDataFieldCallbackStruct, XmDataFieldCallbackStruct *)
-#endif
-#if HAVE_XmCreateTabStack
-XM_TYPE_PTR_NO_p(XmTabStackCallbackStruct, XmTabStackCallbackStruct *)
-#endif
-#define XEN_TO_C_XmFontList(Arg) XEN_TO_C_XmRenderTable(Arg)
-XM_TYPE(XmTextSource, XmTextSource)
-XM_TYPE(XmStringContext, XmStringContext)
-
-static int XEN_XmFontList_or_XmRenderTable_P(XEN arg)
-{
- return(XEN_XmRenderTable_P(arg));
-}
-#endif
-
-static XEN type_to_event_symbol(int utype)
+#define wrap_for_Xen(Name, Value) Xen_list_2(C_string_to_Xen_symbol(Name), Xen_wrap_C_pointer(Value))
+#define wrap_for_Xen_obj(Name, Value) Xen_list_3(C_string_to_Xen_symbol(Name), Xen_wrap_C_pointer(Value), make_xm_obj(Value))
+#define is_wrapped(Name, Value) (Xen_is_list(Value) && \
+ (Xen_list_length(Value) >= 2) && \
+ (Xen_is_symbol(Xen_car(Value))) && \
+ (strcmp(Name, Xen_symbol_to_C_string(Xen_car(Value))) == 0))
+
+/* Xm_type is used for non-pointers (XID mainly) */
+#define Xm_type(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {return(Xen_list_2(C_string_to_Xen_symbol(#Name), C_ulong_to_Xen_ulong(val)));} \
+ static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} \
+ static Xen g_is_ ## Name (Xen val) {return(C_bool_to_Xen_boolean(is_wrapped(#Name, val)));}
+
+#define Xm_type_no_p(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {return(Xen_list_2(C_string_to_Xen_symbol(#Name), C_ulong_to_Xen_ulong(val)));} \
+ static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_ulong_to_C_ulong(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));}
+
+#define Xm_type_int(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {return(Xen_list_2(C_string_to_Xen_symbol(#Name), C_int_to_Xen_integer(val)));} \
+ static XType Xen_to_C_ ## Name (Xen val) {return((XType)Xen_integer_to_C_int(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} \
+ static Xen g_is_ ## Name (Xen val) {return(C_bool_to_Xen_boolean(is_wrapped(#Name, val)));}
+
+#define Xm_type_ptr(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(#Name, val)); return(Xen_false);} \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return((XType)NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} \
+ static Xen g_is_ ## Name (Xen val) {return(C_bool_to_Xen_boolean(is_wrapped(#Name, val)));}
+
+#define Xm_type_ptr_no_p(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(#Name, val)); return(Xen_false);} \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return((XType)NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));}
+
+#define Xm_type_ptr_no_p_NO_P(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen(#Name, val)); return(Xen_false);} \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return((XType)NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));}
+
+#define Xm_type_ptr_no_c2x(Name, XType) \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return((XType)NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} \
+ static Xen g_is_ ## Name (Xen val) {return(C_bool_to_Xen_boolean(is_wrapped(#Name, val)));}
+
+#define Xm_type_ptr_no_c2x_no_p(Name, XType) \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return((XType)NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));}
+
+#define Xm_type_ptr_obj(Name, XType) \
+ static Xen C_to_Xen_ ## Name (XType val) {if (val) return(wrap_for_Xen_obj(#Name, val)); return(Xen_false);} \
+ static XType Xen_to_C_ ## Name (Xen val) {if (Xen_is_false(val)) return(NULL); return((XType)Xen_unwrap_C_pointer(Xen_cadr(val)));} \
+ static bool Xen_is_ ## Name (Xen val) {return(is_wrapped(#Name, val));} \
+ static Xen g_is_ ## Name (Xen val) {return(C_bool_to_Xen_boolean(is_wrapped(#Name, val)));}
+
+
+
+#define Xen_to_C_Dimension(Arg) (Dimension)(Xen_integer_to_C_int(Arg))
+#define C_to_Xen_Dimension(Arg) (C_int_to_Xen_integer((Dimension)Arg))
+#define Xen_is_Dimension(Arg) (Xen_is_integer(Arg))
+
+#define Xen_to_C_Position(Arg) (Position)(Xen_integer_to_C_int(Arg))
+#define C_to_Xen_Position(Arg) (C_int_to_Xen_integer((Position)Arg))
+#define Xen_is_Position(Arg) (Xen_is_integer(Arg))
+
+#define Xen_to_C_Modifiers(Arg) (Modifiers)(Xen_ulong_to_C_ulong(Arg))
+#define C_to_Xen_Modifiers(Arg) (C_ulong_to_Xen_ulong(Arg))
+#define Xen_is_Modifiers(Arg) (Xen_is_ulong(Arg))
+
+Xm_type(Cursor, Cursor)
+Xm_type_ptr(Screen, Screen *)
+Xm_type_ptr_obj(XRectangle, XRectangle *)
+Xm_type_ptr_obj(XArc, XArc *)
+Xm_type_ptr_obj(XPoint, XPoint *)
+Xm_type_ptr_obj(XSegment, XSegment *)
+Xm_type_ptr_obj(XColor, XColor *)
+Xm_type(Atom, Atom)
+Xm_type(Colormap, Colormap) /* XID */
+Xm_type_ptr_no_c2x(Depth, Depth *)
+Xm_type_ptr(Display, Display *)
+Xm_type(Font, Font)
+Xm_type_ptr(GC, GC)
+Xm_type(KeySym, KeySym)
+Xm_type(Pixel, Pixel)
+Xm_type(Pixmap, Pixmap)
+Xm_type(Region, Region)
+Xm_type(Time, Time)
+Xm_type_ptr(Visual, Visual *)
+Xm_type(Window, Window) /* this is XID = long I think */
+Xm_type_ptr(XCharStruct, XCharStruct *)
+Xm_type_ptr(XFontProp, XFontProp *)
+Xm_type(XFontSet, XFontSet)
+Xm_type_ptr(XFontStruct, XFontStruct *)
+Xm_type_ptr(XGCValues, XGCValues *)
+Xm_type_ptr_no_c2x(XTextItem, XTextItem *)
+Xm_type_ptr(XModifierKeymap, XModifierKeymap *) /* opaque in this implementation */
+Xm_type_ptr(XImage, XImage *)
+static XAnyEvent *Xen_to_C_XAnyEvent(Xen val) {return((XAnyEvent *)Xen_unwrap_C_pointer(Xen_cadr(val)));}
+Xm_type_ptr_no_c2x(XButtonEvent, XButtonEvent *)
+Xm_type_ptr_no_c2x(XCirculateEvent, XCirculateEvent *)
+Xm_type_ptr_no_c2x(XCirculateRequestEvent, XCirculateRequestEvent *)
+Xm_type_ptr_no_c2x(XClientMessageEvent, XClientMessageEvent *)
+Xm_type_ptr_no_c2x(XColormapEvent, XColormapEvent *)
+Xm_type_ptr_no_c2x(XConfigureEvent, XConfigureEvent *)
+Xm_type_ptr_no_c2x(XConfigureRequestEvent, XConfigureRequestEvent *)
+Xm_type_ptr_no_c2x(XCreateWindowEvent, XCreateWindowEvent *)
+Xm_type_ptr_no_c2x(XCrossingEvent, XCrossingEvent *)
+Xm_type_ptr_no_c2x(XDestroyWindowEvent, XDestroyWindowEvent *)
+Xm_type_ptr(XErrorEvent, XErrorEvent *)
+Xm_type_ptr_no_c2x(XExposeEvent, XExposeEvent *)
+Xm_type_ptr_no_c2x(XFocusChangeEvent, XFocusChangeEvent *)
+Xm_type_ptr_no_c2x(XGraphicsExposeEvent, XGraphicsExposeEvent *)
+Xm_type_ptr_no_c2x(XGravityEvent, XGravityEvent *)
+Xm_type_ptr_no_c2x(XKeyEvent, XKeyEvent *)
+Xm_type_ptr_no_c2x(XKeymapEvent, XKeymapEvent *)
+Xm_type_ptr_no_c2x(XMapEvent, XMapEvent *)
+Xm_type_ptr_no_c2x(XMapRequestEvent, XMapRequestEvent *)
+Xm_type_ptr_no_c2x(XMappingEvent, XMappingEvent *)
+Xm_type_ptr_no_c2x(XMotionEvent, XMotionEvent *)
+Xm_type_ptr_no_c2x(XNoExposeEvent, XNoExposeEvent *)
+Xm_type_ptr_no_c2x(XPropertyEvent, XPropertyEvent *)
+Xm_type_ptr_no_c2x(XReparentEvent, XReparentEvent *)
+Xm_type_ptr_no_c2x(XResizeRequestEvent, XResizeRequestEvent *)
+Xm_type_ptr_no_c2x(XSelectionClearEvent, XSelectionClearEvent *)
+Xm_type_ptr_no_c2x(XSelectionEvent, XSelectionEvent *)
+Xm_type_ptr(XSelectionRequestEvent, XSelectionRequestEvent *)
+Xm_type_ptr_no_c2x(XUnmapEvent, XUnmapEvent *)
+Xm_type_ptr_no_c2x(XVisibilityEvent, XVisibilityEvent *)
+Xm_type_ptr_obj(XSetWindowAttributes, XSetWindowAttributes *)
+Xm_type_ptr(XVisualInfo, XVisualInfo *)
+Xm_type_ptr(XWMHints, XWMHints *)
+Xm_type_ptr_no_c2x_no_p(XSizeHints, XSizeHints *)
+Xm_type_ptr(XWindowAttributes, XWindowAttributes *)
+Xm_type_ptr_obj(XWindowChanges, XWindowChanges *)
+Xm_type_ptr(XStandardColormap, XStandardColormap *)
+Xm_type_int(KeyCode, KeyCode)
+Xm_type_int(XContext, XContext)
+Xm_type_ptr(XIconSize, XIconSize *)
+
+Xm_type_ptr(Widget, Widget)
+Xm_type(WidgetClass, WidgetClass)
+Xm_type(XtAppContext, XtAppContext)
+Xm_type(XtRequestId, XtRequestId)
+Xm_type(XtWorkProcId, XtWorkProcId)
+Xm_type(XtInputId, XtInputId)
+Xm_type(XtIntervalId, XtIntervalId)
+Xm_type_no_p(XtActionHookId, XtActionHookId)
+Xm_type_no_p(XtTranslations, XtTranslations) /* opaque */
+Xm_type_ptr(XmString, XmString)
+Xm_type_ptr_no_p_NO_P(XmAnyCallbackStruct, XmAnyCallbackStruct *)
+Xm_type_ptr_no_p(XmArrowButtonCallbackStruct, XmArrowButtonCallbackStruct *)
+Xm_type_ptr_no_p(XmCommandCallbackStruct, XmCommandCallbackStruct *)
+Xm_type_ptr_no_p(XmDragDropFinishCallbackStruct, XmDragDropFinishCallbackStruct *)
+Xm_type_ptr_no_p(XmDragMotionCallbackStruct, XmDragMotionCallbackStruct *)
+Xm_type_ptr_no_p(XmDragProcCallbackStruct, XmDragProcCallbackStruct *)
+Xm_type_ptr_no_p(XmDrawingAreaCallbackStruct, XmDrawingAreaCallbackStruct *)
+Xm_type_ptr_no_p(XmDrawnButtonCallbackStruct, XmDrawnButtonCallbackStruct *)
+Xm_type_ptr_no_p(XmDropFinishCallbackStruct, XmDropFinishCallbackStruct *)
+Xm_type_ptr_no_p(XmDropProcCallbackStruct, XmDropProcCallbackStruct *)
+Xm_type_ptr_no_p(XmDropSiteEnterCallbackStruct, XmDropSiteEnterCallbackStruct *)
+Xm_type_ptr_no_p(XmDropSiteLeaveCallbackStruct, XmDropSiteLeaveCallbackStruct *)
+Xm_type_ptr_no_p(XmDropStartCallbackStruct, XmDropStartCallbackStruct *)
+Xm_type_ptr_no_p(XmFileSelectionBoxCallbackStruct, XmFileSelectionBoxCallbackStruct *)
+Xm_type_ptr_no_p(XmListCallbackStruct, XmListCallbackStruct *)
+Xm_type(XmTab, XmTab) /* opaque */
+Xm_type_ptr_no_p(XmDragStartCallbackStruct, XmDragStartCallbackStruct *)
+Xm_type_ptr_no_p(XmDisplayCallbackStruct, XmDisplayCallbackStruct *)
+Xm_type_ptr_no_p(XmDestinationCallbackStruct, XmDestinationCallbackStruct *)
+Xm_type_ptr_no_p(XmConvertCallbackStruct, XmConvertCallbackStruct *)
+Xm_type_ptr_no_p(XmComboBoxCallbackStruct, XmComboBoxCallbackStruct *)
+Xm_type_ptr_no_p(XmContainerOutlineCallbackStruct, XmContainerOutlineCallbackStruct *)
+Xm_type_ptr_no_p(XmContainerSelectCallbackStruct, XmContainerSelectCallbackStruct *)
+Xm_type_ptr_no_p(XmNotebookCallbackStruct, XmNotebookCallbackStruct *)
+Xm_type_ptr_no_p(XmNotebookPageInfo, XmNotebookPageInfo *)
+Xm_type_ptr(XmRenderTable, XmRenderTable)
+Xm_type_ptr(XmRendition, XmRendition)
+Xm_type_ptr_no_p(XmSpinBoxCallbackStruct, XmSpinBoxCallbackStruct *)
+Xm_type_ptr_no_p(XmTraverseObscuredCallbackStruct, XmTraverseObscuredCallbackStruct *)
+Xm_type_ptr_no_p(XmTopLevelLeaveCallbackStruct, XmTopLevelLeaveCallbackStruct *)
+Xm_type_ptr_no_p(XmTopLevelEnterCallbackStruct, XmTopLevelEnterCallbackStruct *)
+Xm_type_ptr_no_p(XmPopupHandlerCallbackStruct, XmPopupHandlerCallbackStruct *)
+Xm_type_ptr_no_p(XmSelectionCallbackStruct, XmSelectionCallbackStruct *)
+Xm_type_ptr_no_c2x_no_p(XmTransferDoneCallbackStruct, XmTransferDoneCallbackStruct *)
+Xm_type_ptr(XmTabList, XmTabList) /* opaque */
+Xm_type(XmParseMapping, XmParseMapping)
+Xm_type_ptr_no_p(XmOperationChangedCallbackStruct, XmOperationChangedCallbackStruct *)
+Xm_type_ptr_no_p(XmPushButtonCallbackStruct, XmPushButtonCallbackStruct *)
+Xm_type_ptr_no_p(XmRowColumnCallbackStruct, XmRowColumnCallbackStruct *)
+Xm_type_ptr_no_p(XmScaleCallbackStruct, XmScaleCallbackStruct *)
+Xm_type_ptr_no_p(XmScrollBarCallbackStruct, XmScrollBarCallbackStruct *)
+Xm_type_ptr_no_p(XmSelectionBoxCallbackStruct, XmSelectionBoxCallbackStruct *)
+Xm_type_ptr_no_p(XmTextVerifyCallbackStruct, XmTextVerifyCallbackStruct *)
+Xm_type_ptr_no_c2x_no_p(XmTextBlock, XmTextBlock)
+Xm_type_ptr_no_p(XmToggleButtonCallbackStruct, XmToggleButtonCallbackStruct *)
+#define Xen_to_C_XmFontList(Arg) Xen_to_C_XmRenderTable(Arg)
+Xm_type(XmTextSource, XmTextSource)
+Xm_type(XmStringContext, XmStringContext)
+
+static int Xen_is_XmFontList_or_XmRenderTable(Xen arg)
+{
+ return(Xen_is_XmRenderTable(arg));
+}
+
+static Xen type_to_event_symbol(int utype)
{
const char *type;
type = "XErrorEvent"; /* -1 for an error event? */
@@ -680,71 +645,62 @@ static XEN type_to_event_symbol(int utype)
case ClientMessage: type = "XClientMessageEvent"; break;
case MappingNotify: type = "XMappingEvent"; break;
}
- return(C_STRING_TO_XEN_SYMBOL(type));
+ return(C_string_to_Xen_symbol(type));
}
-static XEN C_TO_XEN_XEvent_1(XEvent *e, int need_free)
+static Xen C_to_Xen_XEvent_1(XEvent *e, int need_free)
{
- if (e == NULL) return(XEN_FALSE); /* synthetic callback may have no event */
+ if (e == NULL) return(Xen_false); /* synthetic callback may have no event */
if (need_free)
- return(XEN_LIST_4(type_to_event_symbol(e->type),
- XEN_WRAP_C_POINTER(e),
+ return(Xen_list_4(type_to_event_symbol(e->type),
+ Xen_wrap_C_pointer(e),
make_xm_obj(e),
- C_STRING_TO_XEN_SYMBOL("XEvent")));
- return(XEN_LIST_4(type_to_event_symbol(e->type),
- XEN_WRAP_C_POINTER(e),
- XEN_FALSE,
- C_STRING_TO_XEN_SYMBOL("XEvent")));
+ C_string_to_Xen_symbol("XEvent")));
+ return(Xen_list_4(type_to_event_symbol(e->type),
+ Xen_wrap_C_pointer(e),
+ Xen_false,
+ C_string_to_Xen_symbol("XEvent")));
}
-#define C_TO_XEN_XEvent(e) C_TO_XEN_XEvent_1(e, false)
-#define C_TO_XEN_XEvent_OBJ(e) C_TO_XEN_XEvent_1(e, true)
-#define XEN_TO_C_XEvent(Arg) (XEvent *)XEN_UNWRAP_C_POINTER(XEN_CADR(Arg))
-#define XEN_XEvent_P(Value) (XEN_LIST_P(Value) &&\
- (XEN_LIST_LENGTH(Value) == 4) &&\
- (XEN_SYMBOL_P(XEN_CADDDR(Value))) &&\
- (strcmp("XEvent", XEN_SYMBOL_TO_C_STRING(XEN_CADDDR(Value))) == 0))
+#define C_to_Xen_XEvent(e) C_to_Xen_XEvent_1(e, false)
+#define C_to_Xen_XEvent_OBJ(e) C_to_Xen_XEvent_1(e, true)
+#define Xen_to_C_XEvent(Arg) (XEvent *)Xen_unwrap_C_pointer(Xen_cadr(Arg))
+#define Xen_is_XEvent(Value) (Xen_is_list(Value) &&\
+ (Xen_list_length(Value) == 4) &&\
+ (Xen_is_symbol(Xen_cadddr(Value))) &&\
+ (strcmp("XEvent", Xen_symbol_to_C_string(Xen_cadddr(Value))) == 0))
-static XEN XEN_XEvent_p(XEN val)
+static Xen g_is_XEvent(Xen val)
{
- return(C_TO_XEN_BOOLEAN(XEN_XEvent_P(val)));
+ return(C_bool_to_Xen_boolean(Xen_is_XEvent(val)));
}
-static XEN gxm_XEvent(XEN type)
+static Xen gxm_XEvent(Xen type)
{
XEvent *e;
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(type), type, XEN_ONLY_ARG, "XEvent", "an X event type (integer)");
+ Xen_check_type(Xen_is_integer_or_unbound(type), type, 1, "XEvent", "an X event type (integer)");
e = (XEvent *)calloc(1, sizeof(XEvent));
- if (XEN_INTEGER_P(type))
- e->type = XEN_TO_C_INT(type);
- return(XEN_LIST_4(type_to_event_symbol(e->type),
- XEN_WRAP_C_POINTER(e),
+ if (Xen_is_integer(type))
+ e->type = Xen_integer_to_C_int(type);
+ return(Xen_list_4(type_to_event_symbol(e->type),
+ Xen_wrap_C_pointer(e),
make_xm_obj(e),
- C_STRING_TO_XEN_SYMBOL("XEvent")));
+ C_string_to_Xen_symbol("XEvent")));
}
-static XEN gxm_XGCValues(void)
+static Xen gxm_XGCValues(void)
{
XGCValues *e;
e = (XGCValues *)calloc(1, sizeof(XGCValues));
- return(WRAP_FOR_XEN_OBJ("XGCValues", e));
+ return(wrap_for_Xen_obj("XGCValues", e));
}
-#if HAVE_MOTIF
-
-#ifdef XEN_ARGIFY_1
- #define XM_Make(Name) \
- static XEN gxm_ ## Name (void) {Name *e; e = (Name *)calloc(1, sizeof(Name)); return(WRAP_FOR_XEN_OBJ(#Name, e));} \
- XEN_NARGIFY_0(gxm_ ## Name ## _w, gxm_ ## Name)
- #define XM_Declare(Name) \
- XEN_DEFINE_PROCEDURE(XM_PREFIX #Name XM_POSTFIX, gxm_ ## Name ## _w, 0, 0, 0, "Make an " #Name " struct")
-#else
- #define XM_Make(Name) \
- static XEN gxm_ ## Name (void) {Name *e; e = (Name *)calloc(1, sizeof(Name)); return(WRAP_FOR_XEN_OBJ(#Name, e));}
- #define XM_Declare(Name) \
- XEN_DEFINE_PROCEDURE(XM_PREFIX #Name XM_POSTFIX, gxm_ ## Name, 0, 0, 0, "Make an " #Name " struct")
-#endif
+#define XM_Make(Name) \
+ static Xen gxm_ ## Name (void) {Name *e; e = (Name *)calloc(1, sizeof(Name)); return(wrap_for_Xen_obj(#Name, e));} \
+ Xen_wrap_no_args(gxm_ ## Name ## _w, gxm_ ## Name)
+#define XM_Declare(Name) \
+ Xen_define_safe_procedure(XM_PREFIX #Name XM_POSTFIX, gxm_ ## Name ## _w, 0, 0, 0, "Make an " #Name " struct")
XM_Make(XmAnyCallbackStruct)
XM_Make(XmArrowButtonCallbackStruct)
@@ -784,25 +740,15 @@ XM_Make(XmSelectionCallbackStruct)
XM_Make(XmTransferDoneCallbackStruct)
XM_Make(XmDisplayCallbackStruct)
XM_Make(XmDragStartCallbackStruct)
-#if HAVE_XmCreateDataField
-XM_Make(XmDataFieldCallbackStruct)
-#endif
-#if HAVE_XmCreateTabStack
-XM_Make(XmTabStackCallbackStruct)
-#endif
-static XEN gxm_XmTextBlock(void)
+static Xen gxm_XmTextBlock(void)
{
XmTextBlockRec *e;
e = (XmTextBlockRec *)calloc(1, sizeof(XmTextBlockRec));
- return(WRAP_FOR_XEN_OBJ("XmTextBlock", e));
+ return(wrap_for_Xen_obj("XmTextBlock", e));
}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_0(gxm_XmTextBlock_w, gxm_XmTextBlock)
-#else
- #define gxm_XmTextBlock_w gxm_XmTextBlock
-#endif
+Xen_wrap_no_args(gxm_XmTextBlock_w, gxm_XmTextBlock)
static void define_makes(void)
{
@@ -829,7 +775,7 @@ static void define_makes(void)
XM_Declare(XmSelectionBoxCallbackStruct);
XM_Declare(XmTextVerifyCallbackStruct);
XM_Declare(XmToggleButtonCallbackStruct);
- XEN_DEFINE_PROCEDURE(XM_PREFIX "XmTextBlock" XM_POSTFIX, gxm_XmTextBlock_w, 0, 0, 0, "Make an XmTextBlock struct");
+ Xen_define_safe_procedure(XM_PREFIX "XmTextBlock" XM_POSTFIX, gxm_XmTextBlock_w, 0, 0, 0, "Make an XmTextBlock struct");
XM_Declare(XmDestinationCallbackStruct);
XM_Declare(XmConvertCallbackStruct);
XM_Declare(XmComboBoxCallbackStruct);
@@ -845,12 +791,6 @@ static void define_makes(void)
XM_Declare(XmTransferDoneCallbackStruct);
XM_Declare(XmDisplayCallbackStruct);
XM_Declare(XmDragStartCallbackStruct);
-#if HAVE_XmCreateDataField
- XM_Declare(XmDataFieldCallbackStruct);
-#endif
-#if HAVE_XmCreateTabStack
- XM_Declare(XmTabStackCallbackStruct);
-#endif
}
static int its_a_callbackstruct(const char *name)
@@ -869,16 +809,14 @@ static int its_a_callbackstruct(const char *name)
return(0);
}
-#define XEN_AnyCallbackStruct_P(Value) (XEN_LIST_P(Value) && \
- (XEN_LIST_LENGTH(Value) >= 2) && \
- (XEN_SYMBOL_P(XEN_CAR(Value))) && \
- (its_a_callbackstruct(XEN_SYMBOL_TO_C_STRING(XEN_CAR(Value)))))
-#endif
+#define Xen_is_AnyCallbackStruct(Value) (Xen_is_list(Value) && \
+ (Xen_list_length(Value) >= 2) && \
+ (Xen_is_symbol(Xen_car(Value))) && \
+ (its_a_callbackstruct(Xen_symbol_to_C_string(Xen_car(Value)))))
-static int xm_protect(XEN obj);
+static int xm_protect(Xen obj);
static void xm_unprotect_at(int ind);
-#if HAVE_MOTIF
/* in XtGetValues we need to return tagged-types (etc) for arbitrarily named resources,
* and in XtSetValues we need to do type checks, so resources are hashed by
@@ -889,7 +827,7 @@ typedef enum {XM_INT, XM_ULONG, XM_UCHAR, XM_FLOAT, XM_STRING, XM_XMSTRING, XM_S
XM_INT_TABLE, XM_RENDER_TABLE, XM_TAB_LIST, XM_WIDGET, XM_WIDGET_LIST,
XM_BOOLEAN, XM_CALLBACK, XM_PIXEL, XM_PIXMAP, XM_XFONTSTRUCT, XM_DIMENSION,
XM_ATOM, XM_ATOM_LIST, XM_STRING_LIST, XM_CHARSET_TABLE, XM_TEXT_SOURCE,
- XM_FONTLIST, XM_COLORMAP, XM_KEYSYM, XM_KEYSYM_TABLE, XM_SCREEN, XM_WINDOW,
+ XM_COLORMAP, XM_KEYSYM, XM_KEYSYM_TABLE, XM_SCREEN, XM_WINDOW,
XM_VISUAL, XM_RECTANGLE_LIST, XM_WIDGET_CLASS, XM_STRING_OR_INT,
XM_TRANSFER_CALLBACK, XM_CONVERT_CALLBACK, XM_SEARCH_CALLBACK, XM_ORDER_CALLBACK,
XM_QUALIFY_CALLBACK, XM_ALLOC_COLOR_CALLBACK, XM_POPUP_CALLBACK, XM_SCREEN_COLOR_CALLBACK,
@@ -900,198 +838,189 @@ typedef enum {XM_INT, XM_ULONG, XM_UCHAR, XM_FLOAT, XM_STRING, XM_XMSTRING, XM_S
static xm_resource_t resource_type(const char *resource);
-static XEN C_TO_XEN_Widgets(Widget *array, int len)
+static Xen C_to_Xen_Widgets(Widget *array, int len)
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
if (array)
{
int i, loc;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Widget(array[i]), lst);
+ lst = Xen_cons(C_to_Xen_Widget(array[i]), lst);
xm_unprotect_at(loc);
}
return(lst);
}
-static XEN C_TO_XEN_XmStringTable(XmStringTable array, int len)
+static Xen C_to_Xen_XmStringTable(XmStringTable array, int len)
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
if (array)
{
int i, loc;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_XmString(array[i]), lst);
+ lst = Xen_cons(C_to_Xen_XmString(array[i]), lst);
xm_unprotect_at(loc);
}
return(lst);
}
-static Widget *XEN_TO_C_Widgets(XEN lst_1, int n)
+static Widget *Xen_to_C_Widgets(Xen lst_1, int n)
{
Widget *ws;
int i;
- XEN lst;
- lst = XEN_COPY_ARG(lst_1);
+ Xen lst;
+ lst = Xen_copy_arg(lst_1);
ws = (Widget *)calloc(n, sizeof(Widget));
- for (i = 0; (i < n) && (XEN_NOT_NULL_P(lst)); i++, lst = XEN_CDR(lst))
- if (XEN_Widget_P(XEN_CAR(lst)))
- ws[i] = XEN_TO_C_Widget(XEN_CAR(lst));
+ for (i = 0; (i < n) && (!Xen_is_null(lst)); i++, lst = Xen_cdr(lst))
+ if (Xen_is_Widget(Xen_car(lst)))
+ ws[i] = Xen_to_C_Widget(Xen_car(lst));
else
{
free(ws);
ws = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(lst), i, c__FUNCTION__, "a Widget");
+ Xen_check_type(0, Xen_car(lst), i, __func__, "a Widget");
break;
}
return(ws);
}
-static XmString *XEN_TO_C_XmStrings(XEN v_1, int len)
+static XmString *Xen_to_C_XmStrings(Xen v_1, int len)
{
XmString *str;
int i;
- XEN v;
- v = XEN_COPY_ARG(v_1);
+ Xen v;
+ v = Xen_copy_arg(v_1);
str = (XmString *)calloc(len, sizeof(XmString));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_XmString_P(XEN_CAR(v)))
- str[i] = (XmString)XEN_TO_C_XmString(XEN_CAR(v));
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_XmString(Xen_car(v)))
+ str[i] = (XmString)Xen_to_C_XmString(Xen_car(v));
else
{
free(str);
str = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "an XmString");
+ Xen_check_type(0, Xen_car(v), i, __func__, "an XmString");
break;
}
return(str);
}
-static XmDropTransferEntryRec *XEN_TO_C_XmDropTransferEntryRecs(XEN v_1, int len)
+static XmDropTransferEntryRec *Xen_to_C_XmDropTransferEntryRecs(Xen v_1, int len)
{
XmDropTransferEntryRec *ps;
int i;
- XEN v;
- v = XEN_COPY_ARG(v_1);
+ Xen v;
+ v = Xen_copy_arg(v_1);
ps = (XmDropTransferEntryRec *)calloc(len, sizeof(XmDropTransferEntryRec));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
{
- if (XEN_Atom_P(XEN_CAR(v)))
- ps[i].target = XEN_TO_C_Atom(XEN_CAR(v));
+ if (Xen_is_Atom(Xen_car(v)))
+ ps[i].target = Xen_to_C_Atom(Xen_car(v));
else
{
- if (XEN_LIST_P(XEN_CAR(v)))
+ if (Xen_is_list(Xen_car(v)))
{
- if (XEN_Atom_P(XEN_CAR(XEN_CAR(v))))
- ps[i].target = XEN_TO_C_Atom(XEN_CAR(XEN_CAR(v)));
- else XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "an Atom");
- ps[i].client_data = (XtPointer)XEN_CADR(XEN_CAR(v));
+ if (Xen_is_Atom(Xen_car(Xen_car(v))))
+ ps[i].target = Xen_to_C_Atom(Xen_car(Xen_car(v)));
+ else Xen_check_type(0, Xen_car(v), i, __func__, "an Atom");
+ ps[i].client_data = (XtPointer)Xen_cadr(Xen_car(v));
}
}
}
return(ps);
}
-static XmStringTable XEN_TO_C_XmStringTable(XEN v_1, int len)
+static XmStringTable Xen_to_C_XmStringTable(Xen v_1, int len)
{
- XEN v;
+ Xen v;
XmStringTable str;
int i;
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
str = (XmStringTable)calloc(len + 1, sizeof(XmString));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_XmString_P(XEN_CAR(v)))
- str[i] = XEN_TO_C_XmString(XEN_CAR(v));
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_XmString(Xen_car(v)))
+ str[i] = Xen_to_C_XmString(Xen_car(v));
else
{
free(str);
str = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "an XmString");
+ Xen_check_type(0, Xen_car(v), i, __func__, "an XmString");
break;
}
return(str);
}
-#endif
-
-static XEN C_TO_XEN_Ints(int *array, int len)
+static Xen C_to_Xen_Ints(int *array, int len)
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
if (array)
{
int i, loc;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_INT(array[i]), lst);
+ lst = Xen_cons(C_int_to_Xen_integer(array[i]), lst);
xm_unprotect_at(loc);
}
return(lst);
}
#if HAVE_SCHEME
-static XEN c_to_xen_ints(XEN array, XEN len)
+static Xen c_to_xen_ints(Xen array, Xen len)
{
#define H_to_ints "->ints translates a Motif int array (from a .value reference for example) into a scheme list of ints"
- return(C_TO_XEN_Ints((int *)XEN_UNWRAP_C_POINTER(array), XEN_TO_C_INT(len)));
+ Xen_check_type(Xen_is_wrapped_c_pointer(array), array, 1, "->ints", "int*");
+ return(C_to_Xen_Ints((int *)Xen_unwrap_C_pointer(array), Xen_integer_to_C_int(len)));
}
#endif
-static XEN C_TO_XEN_Atoms(Atom *array, int len)
+static Xen C_to_Xen_Atoms(Atom *array, int len)
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
if (array)
{
int i, loc;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Atom(array[i]), lst);
+ lst = Xen_cons(C_to_Xen_Atom(array[i]), lst);
xm_unprotect_at(loc);
}
return(lst);
}
#if HAVE_SCHEME
-static XEN c_to_xen_atoms(XEN array, XEN len)
+static Xen c_to_xen_atoms(Xen array, Xen len)
{
#define H_to_Atoms "->Atoms translates a Motif Atoms array (from a .value reference for example) into a scheme list of Atoms"
- return(C_TO_XEN_Atoms((Atom *)XEN_UNWRAP_C_POINTER(array), XEN_TO_C_INT(len)));
+ Xen_check_type(Xen_is_wrapped_c_pointer(array), array, 1, "->Atoms", "Atom*");
+ return(C_to_Xen_Atoms((Atom *)Xen_unwrap_C_pointer(array), Xen_integer_to_C_int(len)));
}
#endif
-static XEN C_TO_XEN_Strings(char **array, int len)
+static Xen C_to_Xen_Strings(char **array, int len)
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
if (array)
{
int i, loc;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(array[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(array[i]), lst);
xm_unprotect_at(loc);
}
return(lst);
}
#if HAVE_SCHEME
-static XEN c_to_xen_strings(XEN array, XEN len)
+static Xen c_to_xen_strings(Xen array, Xen len)
{
#define H_to_strings "->strings translates a Motif string array (from a .value reference for example) into a scheme list of strings"
- return(C_TO_XEN_Strings((char **)XEN_UNWRAP_C_POINTER(array), XEN_TO_C_INT(len)));
-}
-
-static XEN c_to_xen_string(XEN str)
-{
- #define H_to_string "->string translates a Motif string (from a .value reference for example) into a scheme string"
- char *tmp;
- tmp = (char *)XEN_UNWRAP_C_POINTER(str);
- if (tmp)
- return(C_TO_XEN_STRING(tmp));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_wrapped_c_pointer(array), array, 1, "->strings", "char**");
+ return(C_to_Xen_Strings((char **)Xen_unwrap_C_pointer(array), Xen_integer_to_C_int(len)));
}
#endif
-static XEN copy_xrectangle(XRectangle *old_r)
+static Xen copy_xrectangle(XRectangle *old_r)
{
XRectangle *r;
r = (XRectangle *)calloc(1, sizeof(XRectangle));
@@ -1099,253 +1028,252 @@ static XEN copy_xrectangle(XRectangle *old_r)
r->y = old_r->y;
r->width = old_r->width;
r->height = old_r->height;
- return(C_TO_XEN_XRectangle(r));
+ return(C_to_Xen_XRectangle(r));
}
-static XEN C_TO_XEN_XRectangles(XRectangle *array, int len)
+static Xen C_to_Xen_XRectangles(XRectangle *array, int len)
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
if (array)
{
int i, loc;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(copy_xrectangle(&(array[i])), lst);
+ lst = Xen_cons(copy_xrectangle(&(array[i])), lst);
xm_unprotect_at(loc);
}
return(lst);
}
#if HAVE_SCHEME
-static XEN c_to_xen_xrectangles(XEN array, XEN len)
+static Xen c_to_xen_xrectangles(Xen array, Xen len)
{
#define H_to_XRectangles "->XRectangles translates a Motif rectangle array (from a .value reference for example) into a scheme list of rectangles"
- return(C_TO_XEN_XRectangles((XRectangle *)XEN_UNWRAP_C_POINTER(array), XEN_TO_C_INT(len)));
+ Xen_check_type(Xen_is_wrapped_c_pointer(array), array, 1, "->XRectangles", "Motif rectangle array");
+ return(C_to_Xen_XRectangles((XRectangle *)Xen_unwrap_C_pointer(array), Xen_integer_to_C_int(len)));
}
#endif
-static XEN C_TO_XEN_KeySyms(KeySym *array, int len)
+static Xen C_to_Xen_KeySyms(KeySym *array, int len)
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
if (array)
{
int i, loc;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_KeySym(array[i]), lst);
+ lst = Xen_cons(C_to_Xen_KeySym(array[i]), lst);
xm_unprotect_at(loc);
}
return(lst);
}
-static Window *XEN_TO_C_Windows(XEN lst_1, int n)
+static Window *Xen_to_C_Windows(Xen lst_1, int n)
{
Window *ws;
int i;
- XEN lst;
+ Xen lst;
if (n == 0) return(NULL);
- lst = XEN_COPY_ARG(lst_1);
+ lst = Xen_copy_arg(lst_1);
ws = (Window *)calloc(n, sizeof(Window));
- for (i = 0; (i < n) && (XEN_NOT_NULL_P(lst)); i++, lst = XEN_CDR(lst))
- if (XEN_Window_P(XEN_CAR(lst)))
- ws[i] = XEN_TO_C_Window(XEN_CAR(lst));
+ for (i = 0; (i < n) && (!Xen_is_null(lst)); i++, lst = Xen_cdr(lst))
+ if (Xen_is_Window(Xen_car(lst)))
+ ws[i] = Xen_to_C_Window(Xen_car(lst));
else
{
free(ws);
ws = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(lst), i, c__FUNCTION__, "a Window");
+ Xen_check_type(0, Xen_car(lst), i, __func__, "a Window");
break;
}
return(ws);
}
-#if HAVE_MOTIF
-static XmRendition *XEN_TO_C_XmRenditions(XEN lst_1, int n)
+static XmRendition *Xen_to_C_XmRenditions(Xen lst_1, int n)
{
- XEN lst;
+ Xen lst;
XmRendition *ws;
int i;
if (n == 0) return(NULL);
- lst = XEN_COPY_ARG(lst_1);
+ lst = Xen_copy_arg(lst_1);
ws = (XmRendition *)calloc(n, sizeof(XmRendition));
- for (i = 0; (i < n) && (XEN_NOT_NULL_P(lst)); i++, lst = XEN_CDR(lst))
- if (XEN_XmRendition_P(XEN_CAR(lst)))
- ws[i] = XEN_TO_C_XmRendition(XEN_CAR(lst));
+ for (i = 0; (i < n) && (!Xen_is_null(lst)); i++, lst = Xen_cdr(lst))
+ if (Xen_is_XmRendition(Xen_car(lst)))
+ ws[i] = Xen_to_C_XmRendition(Xen_car(lst));
else
{
free(ws);
ws = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(lst), i, c__FUNCTION__, "an XmRendition");
+ Xen_check_type(0, Xen_car(lst), i, __func__, "an XmRendition");
break;
}
return(ws);
}
-static XmTab *XEN_TO_C_XmTabs(XEN v_1, int len)
+static XmTab *Xen_to_C_XmTabs(Xen v_1, int len)
{
- XEN v;
+ Xen v;
XmTab *str;
int i;
if (len == 0) return(NULL);
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
str = (XmTab *)calloc(len, sizeof(XmTab));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_XmTab_P(XEN_CAR(v)))
- str[i] = (XmTab)XEN_TO_C_XmTab(XEN_CAR(v));
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_XmTab(Xen_car(v)))
+ str[i] = (XmTab)Xen_to_C_XmTab(Xen_car(v));
else
{
free(str);
str = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "an XmTab");
+ Xen_check_type(0, Xen_car(v), i, __func__, "an XmTab");
break;
}
return(str);
}
-#endif
-static Atom *XEN_TO_C_Atoms(XEN v_1, int len)
+static Atom *Xen_to_C_Atoms(Xen v_1, int len)
{
- XEN v;
+ Xen v;
Atom *str;
int i;
if (len == 0) return(NULL);
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
str = (Atom *)calloc(len, sizeof(Atom));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_Atom_P(XEN_CAR(v)))
- str[i] = (Atom)XEN_TO_C_Atom(XEN_CAR(v));
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_Atom(Xen_car(v)))
+ str[i] = (Atom)Xen_to_C_Atom(Xen_car(v));
else
{
free(str);
str = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "an Atom");
+ Xen_check_type(0, Xen_car(v), i, __func__, "an Atom");
break;
}
return(str);
}
-static Pixel *XEN_TO_C_Pixels(XEN v_1, int len)
+static Pixel *Xen_to_C_Pixels(Xen v_1, int len)
{
- XEN v;
+ Xen v;
Pixel *str;
int i;
if (len == 0) return(NULL);
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
str = (Pixel *)calloc(len, sizeof(Pixel));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_Pixel_P(XEN_CAR(v)))
- str[i] = (Pixel)XEN_TO_C_Pixel(XEN_CAR(v));
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_Pixel(Xen_car(v)))
+ str[i] = (Pixel)Xen_to_C_Pixel(Xen_car(v));
else
{
free(str);
str = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "a Pixel");
+ Xen_check_type(0, Xen_car(v), i, __func__, "a Pixel");
break;
}
return(str);
}
-static KeySym *XEN_TO_C_KeySyms(XEN v_1, int len)
+static KeySym *Xen_to_C_KeySyms(Xen v_1, int len)
{
- XEN v;
+ Xen v;
KeySym *str;
int i;
if (len == 0) return(NULL);
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
str = (KeySym *)calloc(len, sizeof(KeySym));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_KeySym_P(XEN_CAR(v)))
- str[i] = (KeySym)XEN_TO_C_KeySym(XEN_CAR(v));
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_KeySym(Xen_car(v)))
+ str[i] = (KeySym)Xen_to_C_KeySym(Xen_car(v));
else
{
free(str);
str = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "a KeySym");
+ Xen_check_type(0, Xen_car(v), i, __func__, "a KeySym");
break;
}
return(str);
}
-static char **XEN_TO_C_Strings(XEN v_1, int len)
+static char **Xen_to_C_Strings(Xen v_1, int len)
{
- XEN v;
+ Xen v;
char **str;
int i;
if (len == 0) return(NULL);
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
str = (char **)calloc(len, sizeof(char *));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_STRING_P(XEN_CAR(v)))
- str[i] = (char *)XEN_TO_C_STRING(XEN_CAR(v)); /* should this be protected? */
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_string(Xen_car(v)))
+ str[i] = (char *)Xen_string_to_C_string(Xen_car(v)); /* should this be protected? */
else
{
free(str);
str = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "a char*");
+ Xen_check_type(0, Xen_car(v), i, __func__, "a char*");
break;
}
return(str);
}
-static int *XEN_TO_C_Ints(XEN v_1, int len)
+static int *Xen_to_C_Ints(Xen v_1, int len)
{
- XEN v;
+ Xen v;
int *ps;
int i;
if (len == 0) return(NULL);
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
ps = (int *)calloc(len, sizeof(int));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_INTEGER_P(XEN_CAR(v)))
- ps[i] = XEN_TO_C_INT(XEN_CAR(v));
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_integer(Xen_car(v)))
+ ps[i] = Xen_integer_to_C_int(Xen_car(v));
else
{
free(ps);
ps = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "an int");
+ Xen_check_type(0, Xen_car(v), i, __func__, "an int");
break;
}
return(ps);
}
-static Cardinal *XEN_TO_C_Cardinals(XEN v_1, int len)
+static Cardinal *Xen_to_C_Cardinals(Xen v_1, int len)
{
- XEN v;
+ Xen v;
Cardinal *ps;
int i;
if (len == 0) return(NULL);
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
ps = (Cardinal *)calloc(len, sizeof(int));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
- if (XEN_INTEGER_P(XEN_CAR(v)))
- ps[i] = (Cardinal)XEN_TO_C_INT(XEN_CAR(v));
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
+ if (Xen_is_integer(Xen_car(v)))
+ ps[i] = (Cardinal)Xen_integer_to_C_int(Xen_car(v));
else
{
free(ps);
ps = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "a Cardinal");
+ Xen_check_type(0, Xen_car(v), i, __func__, "a Cardinal");
break;
}
return(ps);
}
-static XRectangle *XEN_TO_C_XRectangles(XEN v_1, int len)
+static XRectangle *Xen_to_C_XRectangles(Xen v_1, int len)
{
- XEN v;
+ Xen v;
XRectangle *str, *dat;
int i;
if (len == 0) return(NULL);
- v = XEN_COPY_ARG(v_1);
+ v = Xen_copy_arg(v_1);
str = (XRectangle *)calloc(len, sizeof(XRectangle));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(v)); i++, v = XEN_CDR(v))
+ for (i = 0; (i < len) && (!Xen_is_null(v)); i++, v = Xen_cdr(v))
{
- if (XEN_XRectangle_P(XEN_CAR(v)))
- dat = (XRectangle *)XEN_TO_C_XRectangle(XEN_CAR(v));
+ if (Xen_is_XRectangle(Xen_car(v)))
+ dat = (XRectangle *)Xen_to_C_XRectangle(Xen_car(v));
else
{
free(str);
str = NULL;
- XEN_ASSERT_TYPE(0, XEN_CAR(v), i, c__FUNCTION__, "an XRectangle");
+ Xen_check_type(0, Xen_car(v), i, __func__, "an XRectangle");
break;
}
str[i].x = dat->x;
@@ -1357,42 +1285,41 @@ static XRectangle *XEN_TO_C_XRectangles(XEN v_1, int len)
}
-#if HAVE_MOTIF
/* -------- arglists -------- */
-static XEN wrap_callback_struct(int type, XtPointer info);
-static int map_over_protected_elements(bool (*func)(XEN val, int loc, unsigned long fid), unsigned long id);
-static XEN xm_protected_element(int loc);
+static Xen wrap_callback_struct(int type, XtPointer info);
+static int map_over_protected_elements(bool (*func)(Xen val, int loc, unsigned long fid), unsigned long id);
+static Xen xm_protected_element(int loc);
static int callback_struct_type(Widget w, const char *name);
-static void xm_unprotect(XEN obj);
+static void xm_unprotect(Xen obj);
enum {CALLBACK_TYPE, CALLBACK_FUNC, CALLBACK_DATA, CALLBACK_STRUCT_TYPE, CALLBACK_GC_LOC};
-#define C_TO_XEN_XM_XtCallback(Code, Context) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("XtCallback"), Code, Context, XEN_ZERO, XEN_ZERO)
+#define C_to_Xen_XM_XtCallback(Code, Context) \
+ Xen_list_5(C_string_to_Xen_symbol("XtCallback"), Code, Context, Xen_integer_zero, Xen_integer_zero)
static void gxm_XtCallbackProc(Widget w, XtPointer context, XtPointer info)
{
- XEN descr = (XEN)context;
- XEN_CALL_3(XEN_LIST_REF(descr, CALLBACK_FUNC), /* descr: (list "XtCallback" func user-data struct-type gc-loc) */
- C_TO_XEN_Widget(w),
- XEN_LIST_REF(descr, CALLBACK_DATA),
- wrap_callback_struct(XEN_TO_C_INT(XEN_LIST_REF(descr, CALLBACK_STRUCT_TYPE)), info),
- c__FUNCTION__);
+ Xen descr = (Xen)context;
+ Xen_call_with_3_args(Xen_list_ref(descr, CALLBACK_FUNC), /* descr: (list "XtCallback" func user-data struct-type gc-loc) */
+ C_to_Xen_Widget(w),
+ Xen_list_ref(descr, CALLBACK_DATA),
+ wrap_callback_struct(Xen_integer_to_C_int(Xen_list_ref(descr, CALLBACK_STRUCT_TYPE)), info),
+ __func__);
}
-#define C_TO_XEN_XM_Drop_Callback(Code) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("Drop_Callback"), Code, XEN_FALSE, XEN_ZERO, XEN_ZERO)
-#define XM_Drop_Callback_P(Arg) WRAP_P("Drop_Callback", Arg)
+#define C_to_Xen_XM_Drop_Callback(Code) \
+ Xen_list_5(C_string_to_Xen_symbol("Drop_Callback"), Code, Xen_false, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_Drop_Callback(Arg) is_wrapped("Drop_Callback", Arg)
-static bool find_dropproc(XEN val, int loc, unsigned long w)
+static bool find_dropproc(Xen val, int loc, unsigned long w)
{
- return((XM_Drop_Callback_P(val)) &&
- (((XEN_FALSE_P((XEN)w)) &&
- (XEN_FALSE_P(XEN_LIST_REF(val, CALLBACK_DATA)))) ||
- ((XEN_Widget_P(XEN_LIST_REF(val, CALLBACK_DATA))) &&
- (XEN_TO_C_ULONG(XEN_CADR(XEN_LIST_REF(val, CALLBACK_DATA))) == w))));
+ return((XM_is_Drop_Callback(val)) &&
+ (((Xen_is_false((Xen)w)) &&
+ (Xen_is_false(Xen_list_ref(val, CALLBACK_DATA)))) ||
+ ((Xen_is_Widget(Xen_list_ref(val, CALLBACK_DATA))) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(Xen_list_ref(val, CALLBACK_DATA))) == w))));
}
static void gxm_Drop_Callback(Widget w, XtPointer context, XtPointer info)
@@ -1402,29 +1329,29 @@ static void gxm_Drop_Callback(Widget w, XtPointer context, XtPointer info)
i = map_over_protected_elements(find_dropproc, (unsigned long)w);
if (i >= 0)
{
- XEN code;
- code = XEN_LIST_REF(xm_protected_element(i), CALLBACK_FUNC);
- if (XEN_PROCEDURE_P(code))
- XEN_CALL_3(code,
- C_TO_XEN_Widget(w),
- XEN_FALSE,
- C_TO_XEN_XmDropProcCallbackStruct(cb),
- c__FUNCTION__);
+ Xen code;
+ code = Xen_list_ref(xm_protected_element(i), CALLBACK_FUNC);
+ if (Xen_is_procedure(code))
+ Xen_call_with_3_args(code,
+ C_to_Xen_Widget(w),
+ Xen_false,
+ C_to_Xen_XmDropProcCallbackStruct(cb),
+ __func__);
}
cb->dropSiteStatus = XmINVALID_DROP_SITE; /* try to exit cleanly from on-going drop */
}
-#define C_TO_XEN_XM_Drag_Callback(Code) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("Drag_Callback"), Code, XEN_FALSE, XEN_ZERO, XEN_ZERO)
-#define XM_Drag_Callback_P(Arg) WRAP_P("Drag_Callback", Arg)
+#define C_to_Xen_XM_Drag_Callback(Code) \
+ Xen_list_5(C_string_to_Xen_symbol("Drag_Callback"), Code, Xen_false, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_Drag_Callback(Arg) is_wrapped("Drag_Callback", Arg)
-static bool find_dragproc(XEN val, int loc, unsigned long w)
+static bool find_dragproc(Xen val, int loc, unsigned long w)
{
- return((XM_Drag_Callback_P(val)) &&
- (((XEN_FALSE_P((XEN)w)) &&
- (XEN_FALSE_P(XEN_LIST_REF(val, CALLBACK_DATA)))) ||
- ((XEN_Widget_P(XEN_LIST_REF(val, CALLBACK_DATA))) &&
- (XEN_TO_C_ULONG(XEN_CADR(XEN_LIST_REF(val, CALLBACK_DATA))) == w))));
+ return((XM_is_Drag_Callback(val)) &&
+ (((Xen_is_false((Xen)w)) &&
+ (Xen_is_false(Xen_list_ref(val, CALLBACK_DATA)))) ||
+ ((Xen_is_Widget(Xen_list_ref(val, CALLBACK_DATA))) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(Xen_list_ref(val, CALLBACK_DATA))) == w))));
}
static void gxm_Drag_Callback(Widget w, XtPointer context, XtPointer info)
@@ -1434,28 +1361,28 @@ static void gxm_Drag_Callback(Widget w, XtPointer context, XtPointer info)
i = map_over_protected_elements(find_dragproc, (unsigned long)w);
if (i >= 0)
{
- XEN code;
- code = XEN_LIST_REF(xm_protected_element(i), CALLBACK_FUNC);
- if (XEN_PROCEDURE_P(code))
- XEN_CALL_3(code,
- C_TO_XEN_Widget(w),
- XEN_FALSE,
- C_TO_XEN_XmDragProcCallbackStruct(cb),
- c__FUNCTION__);
+ Xen code;
+ code = Xen_list_ref(xm_protected_element(i), CALLBACK_FUNC);
+ if (Xen_is_procedure(code))
+ Xen_call_with_3_args(code,
+ C_to_Xen_Widget(w),
+ Xen_false,
+ C_to_Xen_XmDragProcCallbackStruct(cb),
+ __func__);
}
}
-#define C_TO_XEN_XM_XtPopupChild(Code) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("XtPopupChild"), Code, XEN_FALSE, XEN_ZERO, XEN_ZERO)
-#define XM_XtPopupChild_P(Arg) WRAP_P("XtPopupChild", Arg)
+#define C_to_Xen_XM_XtPopupChild(Code) \
+ Xen_list_5(C_string_to_Xen_symbol("XtPopupChild"), Code, Xen_false, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_XtPopupChild(Arg) is_wrapped("XtPopupChild", Arg)
-static bool find_popupchild(XEN val, int loc, unsigned long w)
+static bool find_popupchild(Xen val, int loc, unsigned long w)
{
- return((XM_XtPopupChild_P(val)) &&
- (((XEN_FALSE_P((XEN)w)) &&
- (XEN_FALSE_P(XEN_LIST_REF(val, CALLBACK_DATA)))) ||
- ((XEN_Widget_P(XEN_LIST_REF(val, CALLBACK_DATA))) &&
- (XEN_TO_C_ULONG(XEN_CADR(XEN_LIST_REF(val, CALLBACK_DATA))) == w))));
+ return((XM_is_XtPopupChild(val)) &&
+ (((Xen_is_false((Xen)w)) &&
+ (Xen_is_false(Xen_list_ref(val, CALLBACK_DATA)))) ||
+ ((Xen_is_Widget(Xen_list_ref(val, CALLBACK_DATA))) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(Xen_list_ref(val, CALLBACK_DATA))) == w))));
}
static void gxm_XtPopupChild(Widget w)
@@ -1465,26 +1392,26 @@ static void gxm_XtPopupChild(Widget w)
i = map_over_protected_elements(find_popupchild, (unsigned long)w);
if (i >= 0)
{
- XEN code;
- code = XEN_LIST_REF(xm_protected_element(i), CALLBACK_FUNC);
- if (XEN_PROCEDURE_P(code))
- XEN_CALL_1(code,
- C_TO_XEN_Widget(w),
- c__FUNCTION__);
+ Xen code;
+ code = Xen_list_ref(xm_protected_element(i), CALLBACK_FUNC);
+ if (Xen_is_procedure(code))
+ Xen_call_with_1_arg(code,
+ C_to_Xen_Widget(w),
+ __func__);
}
}
-#define C_TO_XEN_XM_XmSearchProc(Code) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("XmSearchProc"), Code, XEN_FALSE, XEN_ZERO, XEN_ZERO)
-#define XM_XmSearchProc_P(Arg) WRAP_P("XmSearchProc", Arg)
+#define C_to_Xen_XM_XmSearchProc(Code) \
+ Xen_list_5(C_string_to_Xen_symbol("XmSearchProc"), Code, Xen_false, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_XmSearchProc(Arg) is_wrapped("XmSearchProc", Arg)
-static bool find_searchproc(XEN val, int loc, unsigned long w)
+static bool find_searchproc(Xen val, int loc, unsigned long w)
{
- return((XM_XmSearchProc_P(val)) &&
- (((XEN_FALSE_P((XEN)w)) &&
- (XEN_FALSE_P(XEN_LIST_REF(val, CALLBACK_DATA)))) ||
- ((XEN_Widget_P(XEN_LIST_REF(val, CALLBACK_DATA))) &&
- (XEN_TO_C_ULONG(XEN_CADR(XEN_LIST_REF(val, CALLBACK_DATA))) == w))));
+ return((XM_is_XmSearchProc(val)) &&
+ (((Xen_is_false((Xen)w)) &&
+ (Xen_is_false(Xen_list_ref(val, CALLBACK_DATA)))) ||
+ ((Xen_is_Widget(Xen_list_ref(val, CALLBACK_DATA))) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(Xen_list_ref(val, CALLBACK_DATA))) == w))));
}
static void gxm_XmSearchProc(Widget w, XmFileSelectionBoxCallbackStruct *info)
@@ -1494,27 +1421,27 @@ static void gxm_XmSearchProc(Widget w, XmFileSelectionBoxCallbackStruct *info)
i = map_over_protected_elements(find_searchproc, (unsigned long)w);
if (i >= 0)
{
- XEN code;
- code = XEN_LIST_REF(xm_protected_element(i), CALLBACK_FUNC);
- if (XEN_PROCEDURE_P(code))
- XEN_CALL_2(code,
- C_TO_XEN_Widget(w),
- C_TO_XEN_XmFileSelectionBoxCallbackStruct(info),
- c__FUNCTION__);
+ Xen code;
+ code = Xen_list_ref(xm_protected_element(i), CALLBACK_FUNC);
+ if (Xen_is_procedure(code))
+ Xen_call_with_2_args(code,
+ C_to_Xen_Widget(w),
+ C_to_Xen_XmFileSelectionBoxCallbackStruct(info),
+ __func__);
}
}
-#define C_TO_XEN_XM_XmQualifyProc(Code) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("XmQualifyProc"), Code, XEN_FALSE, XEN_ZERO, XEN_ZERO)
-#define XM_XmQualifyProc_P(Arg) WRAP_P("XmQualifyProc", Arg)
+#define C_to_Xen_XM_XmQualifyProc(Code) \
+ Xen_list_5(C_string_to_Xen_symbol("XmQualifyProc"), Code, Xen_false, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_XmQualifyProc(Arg) is_wrapped("XmQualifyProc", Arg)
-static bool find_qualifyproc(XEN val, int loc, unsigned long w)
+static bool find_qualifyproc(Xen val, int loc, unsigned long w)
{
- return((XM_XmQualifyProc_P(val)) &&
- (((XEN_FALSE_P((XEN)w)) &&
- (XEN_FALSE_P(XEN_LIST_REF(val, CALLBACK_DATA)))) ||
- ((XEN_Widget_P(XEN_LIST_REF(val, CALLBACK_DATA))) &&
- (XEN_TO_C_ULONG(XEN_CADR(XEN_LIST_REF(val, CALLBACK_DATA))) == w))));
+ return((XM_is_XmQualifyProc(val)) &&
+ (((Xen_is_false((Xen)w)) &&
+ (Xen_is_false(Xen_list_ref(val, CALLBACK_DATA)))) ||
+ ((Xen_is_Widget(Xen_list_ref(val, CALLBACK_DATA))) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(Xen_list_ref(val, CALLBACK_DATA))) == w))));
}
static void gxm_XmQualifyProc(Widget w, XtPointer indata, XtPointer outdata)
@@ -1524,28 +1451,28 @@ static void gxm_XmQualifyProc(Widget w, XtPointer indata, XtPointer outdata)
i = map_over_protected_elements(find_qualifyproc, (unsigned long)w);
if (i >= 0)
{
- XEN code;
- code = XEN_LIST_REF(xm_protected_element(i), CALLBACK_FUNC);
- if (XEN_PROCEDURE_P(code))
- XEN_CALL_3(code,
- C_TO_XEN_Widget(w),
- C_TO_XEN_XmFileSelectionBoxCallbackStruct((XmFileSelectionBoxCallbackStruct *)indata),
- C_TO_XEN_XmFileSelectionBoxCallbackStruct((XmFileSelectionBoxCallbackStruct *)outdata),
- c__FUNCTION__);
+ Xen code;
+ code = Xen_list_ref(xm_protected_element(i), CALLBACK_FUNC);
+ if (Xen_is_procedure(code))
+ Xen_call_with_3_args(code,
+ C_to_Xen_Widget(w),
+ C_to_Xen_XmFileSelectionBoxCallbackStruct((XmFileSelectionBoxCallbackStruct *)indata),
+ C_to_Xen_XmFileSelectionBoxCallbackStruct((XmFileSelectionBoxCallbackStruct *)outdata),
+ __func__);
}
}
-#define C_TO_XEN_XM_XtOrderProc(Code) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("XtOrderProc"), Code, XEN_FALSE, XEN_ZERO, XEN_ZERO)
-#define XM_XtOrderProc_P(Arg) WRAP_P("XtOrderProc", Arg)
+#define C_to_Xen_XM_XtOrderProc(Code) \
+ Xen_list_5(C_string_to_Xen_symbol("XtOrderProc"), Code, Xen_false, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_XtOrderProc(Arg) is_wrapped("XtOrderProc", Arg)
-static bool find_orderproc(XEN val, int loc, unsigned long w)
+static bool find_orderproc(Xen val, int loc, unsigned long w)
{
- return((XM_XtOrderProc_P(val)) &&
- (((XEN_FALSE_P((XEN)w)) &&
- (XEN_FALSE_P(XEN_LIST_REF(val, CALLBACK_DATA)))) ||
- ((XEN_Widget_P(XEN_LIST_REF(val, CALLBACK_DATA))) &&
- (XEN_TO_C_ULONG(XEN_CADR(XEN_LIST_REF(val, CALLBACK_DATA))) == w))));
+ return((XM_is_XtOrderProc(val)) &&
+ (((Xen_is_false((Xen)w)) &&
+ (Xen_is_false(Xen_list_ref(val, CALLBACK_DATA)))) ||
+ ((Xen_is_Widget(Xen_list_ref(val, CALLBACK_DATA))) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(Xen_list_ref(val, CALLBACK_DATA))) == w))));
}
static Cardinal gxm_XtOrderProc(Widget w)
@@ -1555,28 +1482,28 @@ static Cardinal gxm_XtOrderProc(Widget w)
i = map_over_protected_elements(find_orderproc, (unsigned long)w);
if (i >= 0)
{
- XEN code;
- code = XEN_LIST_REF(xm_protected_element(i), CALLBACK_FUNC);
- if (XEN_PROCEDURE_P(code))
- result = XEN_TO_C_INT(XEN_CALL_1(code,
- C_TO_XEN_Widget(w),
- c__FUNCTION__));
+ Xen code;
+ code = Xen_list_ref(xm_protected_element(i), CALLBACK_FUNC);
+ if (Xen_is_procedure(code))
+ result = Xen_integer_to_C_int(Xen_call_with_1_arg(code,
+ C_to_Xen_Widget(w),
+ __func__));
}
return((Cardinal)result);
}
-#define C_TO_XEN_XM_Parse_Callback(Code) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("Parse_Callback"), Code, XEN_FALSE, XEN_ZERO, XEN_ZERO)
-#define XM_Parse_Callback_P(Arg) WRAP_P("Parse_Callback", Arg)
+#define C_to_Xen_XM_Parse_Callback(Code) \
+ Xen_list_5(C_string_to_Xen_symbol("Parse_Callback"), Code, Xen_false, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_Parse_Callback(Arg) is_wrapped("Parse_Callback", Arg)
-static bool find_parseproc(XEN val, int loc, unsigned long w)
+static bool find_parseproc(Xen val, int loc, unsigned long w)
{
- return((XM_Parse_Callback_P(val)) &&
- (((XEN_FALSE_P((XEN)w)) &&
- (XEN_FALSE_P(XEN_LIST_REF(val, CALLBACK_DATA)))) ||
- ((XEN_XmParseMapping_P(XEN_LIST_REF(val, CALLBACK_DATA))) &&
- (XEN_TO_C_ULONG(XEN_CADR(XEN_LIST_REF(val, CALLBACK_DATA))) == w))));
+ return((XM_is_Parse_Callback(val)) &&
+ (((Xen_is_false((Xen)w)) &&
+ (Xen_is_false(Xen_list_ref(val, CALLBACK_DATA)))) ||
+ ((Xen_is_XmParseMapping(Xen_list_ref(val, CALLBACK_DATA))) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(Xen_list_ref(val, CALLBACK_DATA))) == w))));
}
static XmIncludeStatus gxm_Parse_Callback(XtPointer *in_out, XtPointer text_end, XmTextType type, XmStringTag locale_tag,
@@ -1586,132 +1513,132 @@ static XmIncludeStatus gxm_Parse_Callback(XtPointer *in_out, XtPointer text_end,
i = map_over_protected_elements(find_parseproc, (unsigned long)entry);
if (i >= 0)
{
- XEN code;
- code = XEN_LIST_REF(xm_protected_element(i), CALLBACK_FUNC);
- if (XEN_PROCEDURE_P(code))
- return(XEN_TO_C_INT(XEN_APPLY(code,
- XEN_LIST_8(C_TO_XEN_STRING((char *)(*in_out)),
- XEN_WRAP_C_POINTER(text_end), /* can't work... */
- C_TO_XEN_INT(type),
- C_TO_XEN_STRING(locale_tag),
- C_TO_XEN_XmParseMapping(entry),
- C_TO_XEN_INT(pattern_length),
- C_TO_XEN_XmString((*str_include)), /* can't work... */
- (XEN)call_data),
- c__FUNCTION__)));
+ Xen code;
+ code = Xen_list_ref(xm_protected_element(i), CALLBACK_FUNC);
+ if (Xen_is_procedure(code))
+ return(Xen_integer_to_C_int(Xen_apply(code,
+ Xen_list_8(C_string_to_Xen_string((char *)(*in_out)),
+ Xen_wrap_C_pointer(text_end), /* can't work... */
+ C_int_to_Xen_integer(type),
+ C_string_to_Xen_string(locale_tag),
+ C_to_Xen_XmParseMapping(entry),
+ C_int_to_Xen_integer(pattern_length),
+ C_to_Xen_XmString((*str_include)), /* can't work... */
+ (Xen)call_data),
+ __func__)));
}
return(0);
}
-static XEN xm_XmColorAllocationProc;
+static Xen xm_XmColorAllocationProc;
static void gxm_XmAllocColorProc(Display *dpy, Colormap color, XColor *bs)
{
/* DIFF: XmAllocColorProc should return new XColor value
*/
- XEN val;
- val = XEN_CALL_3(xm_XmColorAllocationProc,
- C_TO_XEN_Display(dpy),
- C_TO_XEN_Colormap(color),
- C_TO_XEN_XColor(bs),
- c__FUNCTION__);
- bs = XEN_TO_C_XColor(val);
+ Xen val;
+ val = Xen_call_with_3_args(xm_XmColorAllocationProc,
+ C_to_Xen_Display(dpy),
+ C_to_Xen_Colormap(color),
+ C_to_Xen_XColor(bs),
+ __func__);
+ (*bs) = (*(Xen_to_C_XColor(val)));
}
-static XEN xm_XmColorCalculationProc;
+static Xen xm_XmColorCalculationProc;
static void gxm_XmColorCalculationProc(Screen *scr, XColor *bg, XColor *fg, XColor *sel, XColor *ts, XColor *bs)
{
/* DIFF: XmColorCalculationProc takes 2 args, returns list of 4 colors
*/
- XEN lst;
+ Xen lst;
int loc;
- lst = XEN_CALL_2(xm_XmColorCalculationProc,
- C_TO_XEN_Screen(scr),
- C_TO_XEN_XColor(bg),
- c__FUNCTION__);
+ lst = Xen_call_with_2_args(xm_XmColorCalculationProc,
+ C_to_Xen_Screen(scr),
+ C_to_Xen_XColor(bg),
+ __func__);
loc = xm_protect(lst);
- if (XEN_LIST_P(lst))
+ if (Xen_is_list(lst))
{
- fg = XEN_TO_C_XColor(XEN_LIST_REF(lst, 0));
- sel = XEN_TO_C_XColor(XEN_LIST_REF(lst, 1));
- ts = XEN_TO_C_XColor(XEN_LIST_REF(lst, 2));
- bs = XEN_TO_C_XColor(XEN_LIST_REF(lst, 3));
+ (*fg) = (*(Xen_to_C_XColor(Xen_list_ref(lst, 0))));
+ (*sel) = (*(Xen_to_C_XColor(Xen_list_ref(lst, 1))));
+ (*ts) = (*(Xen_to_C_XColor(Xen_list_ref(lst, 2))));
+ (*bs) = (*(Xen_to_C_XColor(Xen_list_ref(lst, 3))));
}
xm_unprotect_at(loc);
}
-static XEN xm_XmColorProc; /* XmColorProc is not the same as XmScreen color calculation proc */
+static Xen xm_XmColorProc; /* XmColorProc is not the same as XmScreen color calculation proc */
static void gxm_XmColorProc(XColor *bg, XColor *fg, XColor *sel, XColor *ts, XColor *bs)
{
- XEN lst;
+ Xen lst;
int loc;
- lst = XEN_CALL_1(xm_XmColorProc,
- C_TO_XEN_XColor(bg),
- c__FUNCTION__);
+ lst = Xen_call_with_1_arg(xm_XmColorProc,
+ C_to_Xen_XColor(bg),
+ __func__);
loc = xm_protect(lst);
- if (XEN_LIST_P(lst))
+ if (Xen_is_list(lst))
{
- fg = XEN_TO_C_XColor(XEN_LIST_REF(lst, 0));
- sel = XEN_TO_C_XColor(XEN_LIST_REF(lst, 1));
- ts = XEN_TO_C_XColor(XEN_LIST_REF(lst, 2));
- bs = XEN_TO_C_XColor(XEN_LIST_REF(lst, 3));
+ (*fg) = (*(Xen_to_C_XColor(Xen_list_ref(lst, 0))));
+ (*sel) = (*(Xen_to_C_XColor(Xen_list_ref(lst, 1))));
+ (*ts) = (*(Xen_to_C_XColor(Xen_list_ref(lst, 2))));
+ (*bs) = (*(Xen_to_C_XColor(Xen_list_ref(lst, 3))));
}
xm_unprotect_at(loc);
}
-static XtCallbackList XEN_TO_C_XtCallbackList(XEN call_list1)
+static XtCallbackList Xen_to_C_XtCallbackList(Xen call_list1)
{
- XEN call_list;
+ Xen call_list;
int call_i, call_len;
XtCallbackRec *cl = NULL;
- call_list = XEN_COPY_ARG(call_list1);
- call_len = XEN_LIST_LENGTH(call_list) / 2;
+ call_list = Xen_copy_arg(call_list1);
+ call_len = Xen_list_length(call_list) / 2;
if (call_len == 0) return(NULL);
cl = (XtCallbackRec *)calloc(call_len + 1, sizeof(XtCallbackRec));
- for (call_i = 0; call_i < call_len; call_i++, call_list = XEN_CDDR(call_list))
+ for (call_i = 0; call_i < call_len; call_i++, call_list = Xen_cddr(call_list))
{
- XEN func, data;
- func = XEN_CAR(call_list);
- if (XEN_LIST_LENGTH(call_list) == 2)
- data = XEN_CADR(call_list);
- else data = XEN_FALSE;
- if ((XEN_PROCEDURE_P(func)) && (XEN_REQUIRED_ARGS_OK(func, 3)))
+ Xen func, data;
+ func = Xen_car(call_list);
+ if (Xen_list_length(call_list) == 2)
+ data = Xen_cadr(call_list);
+ else data = Xen_false;
+ if ((Xen_is_procedure(func)) && (Xen_is_aritable(func, 3)))
{
- XEN descr;
+ Xen descr;
cl[call_i].callback = gxm_XtCallbackProc;
- descr = C_TO_XEN_XM_XtCallback(XEN_CAR(call_list), data);
+ descr = C_to_Xen_XM_XtCallback(Xen_car(call_list), data);
cl[call_i].closure = (XtPointer)descr;
- XEN_LIST_SET(descr, CALLBACK_GC_LOC, C_TO_XEN_INT(xm_protect(descr)));
+ Xen_list_set(descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(xm_protect(descr)));
}
}
return(cl);
}
-static XEN C_TO_XEN_STRING_WITH_TERMINATION(char *str, unsigned long len)
+static Xen C_to_Xen_STRING_WITH_TERMINATION(char *str, unsigned long len)
{
- if ((len == 0) || (str == NULL)) return(XEN_FALSE);
+ if ((len == 0) || (str == NULL)) return(Xen_false);
str[len] = '\0';
- return(C_TO_XEN_STRING(str));
+ return(C_string_to_Xen_string(str));
}
-static XEN xm_XtSelectionCallback_Descr;
+static Xen xm_XtSelectionCallback_Descr;
static void gxm_XtSelectionCallbackProc(Widget w, XtPointer x, Atom *a1, Atom *a2, XtPointer x1, unsigned long *l, int *i)
{
- XEN_APPLY(XEN_CAR(xm_XtSelectionCallback_Descr),
- XEN_LIST_7(C_TO_XEN_Widget(w),
- XEN_CADR(xm_XtSelectionCallback_Descr),
- C_TO_XEN_Atom(*a1),
- C_TO_XEN_Atom(*a2),
- C_TO_XEN_STRING_WITH_TERMINATION((char *)x1, *l), /* should we handle Atom -> Lisp type conversions? */
- C_TO_XEN_ULONG(*l),
- C_TO_XEN_INT(*i)),
- c__FUNCTION__);
+ Xen_apply(Xen_car(xm_XtSelectionCallback_Descr),
+ Xen_list_7(C_to_Xen_Widget(w),
+ Xen_cadr(xm_XtSelectionCallback_Descr),
+ C_to_Xen_Atom(*a1),
+ C_to_Xen_Atom(*a2),
+ C_to_Xen_STRING_WITH_TERMINATION((char *)x1, *l), /* should we handle Atom -> Lisp type conversions? */
+ C_ulong_to_Xen_ulong(*l),
+ C_int_to_Xen_integer(*i)),
+ __func__);
}
-static XEN xm_XtConvertSelectionIncr_Descr;
+static Xen xm_XtConvertSelectionIncr_Descr;
static Boolean gxm_XtConvertSelectionIncrProc(Widget w, Atom *selection, Atom *target,
Atom *type_return, XtPointer *value_return,
@@ -1723,21 +1650,21 @@ static Boolean gxm_XtConvertSelectionIncrProc(Widget w, Atom *selection, Atom *t
* should return (list ...) if ok, #f if not
* the list should be (type value length format)
*/
- XEN result;
- result = XEN_APPLY(xm_XtConvertSelectionIncr_Descr,
- XEN_LIST_6(C_TO_XEN_Widget(w),
- C_TO_XEN_Atom(*selection),
- C_TO_XEN_Atom(*target),
- C_TO_XEN_INT(*max_length),
- XEN_WRAP_C_POINTER(client_data),
- C_TO_XEN_ULONG(*request_id)), /* XtRequestId is XtPointer */
- c__FUNCTION__);
- if (XEN_FALSE_P(result))
+ Xen result;
+ result = Xen_apply(xm_XtConvertSelectionIncr_Descr,
+ Xen_list_6(C_to_Xen_Widget(w),
+ C_to_Xen_Atom(*selection),
+ C_to_Xen_Atom(*target),
+ C_int_to_Xen_integer(*max_length),
+ Xen_wrap_C_pointer(client_data),
+ C_ulong_to_Xen_ulong(*request_id)), /* XtRequestId is XtPointer */
+ __func__);
+ if (Xen_is_false(result))
return(0);
- (*type_return) = XEN_TO_C_Atom(XEN_LIST_REF(result, 0));
- (*value_return) = (XtPointer)XEN_UNWRAP_C_POINTER(XEN_LIST_REF(result, 1));
- (*length_return) = (unsigned long)XEN_TO_C_INT(XEN_LIST_REF(result, 2));
- (*format_return) = XEN_TO_C_INT(XEN_LIST_REF(result, 3));
+ (*type_return) = Xen_to_C_Atom(Xen_list_ref(result, 0));
+ (*value_return) = (XtPointer)Xen_unwrap_C_pointer(Xen_list_ref(result, 1));
+ (*length_return) = (unsigned long)Xen_integer_to_C_int(Xen_list_ref(result, 2));
+ (*format_return) = Xen_integer_to_C_int(Xen_list_ref(result, 3));
return(1);
}
@@ -1747,7 +1674,7 @@ static Arg *protect_args(Arg *args, int len)
int i;
for (i = 0; i < len; i++)
if (args[i].name)
- args[i].name = xen_strdup(args[i].name); /* XEN_TO_C_STRING will eventually gc, so protect against that until we're done with args */
+ args[i].name = xen_strdup(args[i].name); /* Xen_to_C_STRING will eventually gc, so protect against that until we're done with args */
return(args);
}
@@ -1761,35 +1688,35 @@ static Arg *free_args(Arg *args, int len)
return(NULL);
}
-static Arg *XEN_TO_C_Args(XEN inargl)
+static Arg *Xen_to_C_Args(Xen inargl)
{
/* an Arg array in xm is a list of name value pairs */
Arg *args = NULL;
int i, len, gcloc;
- XEN descr, inarg;
+ Xen descr, inarg;
/* if XtVaNestedList supported, scan for it here, and increase length as needed,
- * then make recursive call to XEN_TO_C_Args in that branch, unloading afterwards
+ * then make recursive call to Xen_to_C_Args in that branch, unloading afterwards
* this is not actually needed in xm -- just use append!
*/
- inarg = XEN_COPY_ARG(inargl);
- len = XEN_LIST_LENGTH(inarg) / 2;
+ inarg = Xen_copy_arg(inargl);
+ len = Xen_list_length(inarg) / 2;
if (len == 0) return(NULL);
gcloc = xm_protect(inarg);
args = (Arg *)calloc(len, sizeof(Arg));
- for (i = 0; i < len; i++, inarg = XEN_CDDR(inarg))
+ for (i = 0; i < len; i++, inarg = Xen_cddr(inarg))
{
XtCallbackRec *cl = NULL;
xm_resource_t type;
- XEN xname, value;
+ Xen xname, value;
char *name;
- xname = XEN_CAR(inarg);
- XEN_ASSERT_TYPE(XEN_STRING_P(xname), xname, 0, c__FUNCTION__, "string");
- name = (char *)XEN_TO_C_STRING(xname);
+ xname = Xen_car(inarg);
+ Xen_check_type(Xen_is_string(xname), xname, 0, __func__, "string");
+ name = (char *)Xen_string_to_C_string(xname);
type = resource_type(name);
- value = XEN_CADR(inarg);
+ value = Xen_cadr(inarg);
switch (type)
{
- /* here the XtSetArg call wants an XtCallbackList, the incoming XEN type is a list of callback data pairs
+ /* here the XtSetArg call wants an XtCallbackList, the incoming Xen type is a list of callback data pairs
* the new callback rec.callback = gxm_XtCallback (etc -- chosen by resource type)
* the rec.closure will be the wrapped func/data info
* we don't have all the data we need for the actual wrapped list here since we need the widget to choose the callback struct type
@@ -1797,96 +1724,96 @@ static Arg *XEN_TO_C_Args(XEN inargl)
* also, which callback is invoked may depend on callback type
*/
case XM_CALLBACK:
- cl = XEN_TO_C_XtCallbackList(value);
+ cl = Xen_to_C_XtCallbackList(value);
if (cl) XtSetArg(args[i], name, cl);
break;
case XM_PARSE_CALLBACK:
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 8)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 8)))
{
XtSetArg(args[i], name, (unsigned long)gxm_Parse_Callback);
- descr = C_TO_XEN_XM_Parse_Callback(value);
- XEN_LIST_SET(descr, CALLBACK_GC_LOC, C_TO_XEN_INT(xm_protect(descr)));
+ descr = C_to_Xen_XM_Parse_Callback(value);
+ Xen_list_set(descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(xm_protect(descr)));
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 8 args");
+ else Xen_check_type(0, value, 0, name, "procedure of 8 args");
}
break;
case XM_DROP_CALLBACK:
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 3)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 3)))
{
XtSetArg(args[i], name, (unsigned long)gxm_Drop_Callback);
- descr = C_TO_XEN_XM_Drop_Callback(value);
- XEN_LIST_SET(descr, CALLBACK_GC_LOC, C_TO_XEN_INT(xm_protect(descr)));
+ descr = C_to_Xen_XM_Drop_Callback(value);
+ Xen_list_set(descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(xm_protect(descr)));
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 3 args");
+ else Xen_check_type(0, value, 0, name, "procedure of 3 args");
}
break;
case XM_DRAG_CALLBACK:
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 3)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 3)))
{
XtSetArg(args[i], name, (unsigned long)gxm_Drag_Callback);
- descr = C_TO_XEN_XM_Drag_Callback(value);
- XEN_LIST_SET(descr, CALLBACK_GC_LOC, C_TO_XEN_INT(xm_protect(descr)));
+ descr = C_to_Xen_XM_Drag_Callback(value);
+ Xen_list_set(descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(xm_protect(descr)));
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 3 args");
+ else Xen_check_type(0, value, 0, name, "procedure of 3 args");
}
break;
case XM_SEARCH_CALLBACK: /* XmNfileSearchProc and XmNdirSearchProc, XmSearchProc XmFileSelectionBox 756 */
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 2)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 2)))
{
XtSetArg(args[i], name, (unsigned long)gxm_XmSearchProc);
- descr = C_TO_XEN_XM_XmSearchProc(value);
- XEN_LIST_SET(descr, CALLBACK_GC_LOC, C_TO_XEN_INT(xm_protect(descr)));
+ descr = C_to_Xen_XM_XmSearchProc(value);
+ Xen_list_set(descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(xm_protect(descr)));
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 2 args");
+ else Xen_check_type(0, value, 0, name, "procedure of 2 args");
}
break;
case XM_QUALIFY_CALLBACK: /* XmNqualifySearchDataProc, XmQualifyProc */
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 3)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 3)))
{
XtSetArg(args[i], name, (unsigned long)gxm_XmQualifyProc);
- descr = C_TO_XEN_XM_XmQualifyProc(value);
- XEN_LIST_SET(descr, CALLBACK_GC_LOC, C_TO_XEN_INT(xm_protect(descr)));
+ descr = C_to_Xen_XM_XmQualifyProc(value);
+ Xen_list_set(descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(xm_protect(descr)));
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 3 args");
+ else Xen_check_type(0, value, 0, name, "procedure of 3 args");
}
break;
case XM_ORDER_CALLBACK:
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 1)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 1)))
{
XtSetArg(args[i], name, (unsigned long)gxm_XtOrderProc);
- descr = C_TO_XEN_XM_XtOrderProc(value);
- XEN_LIST_SET(descr, CALLBACK_GC_LOC, C_TO_XEN_INT(xm_protect(descr)));
+ descr = C_to_Xen_XM_XtOrderProc(value);
+ Xen_list_set(descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(xm_protect(descr)));
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 1 arg");
+ else Xen_check_type(0, value, 0, name, "procedure of 1 arg");
}
break;
case XM_TRANSFER_CALLBACK: /* XmNtransferProc, XtSelectionCallbackProc, XmDropTransfer */
/* for now I'll assume no collisions here */
- xm_XtSelectionCallback_Descr = XEN_LIST_2(value, XEN_FALSE);
+ xm_XtSelectionCallback_Descr = Xen_list_2(value, Xen_false);
xm_protect(xm_XtSelectionCallback_Descr);
XtSetArg(args[i], name, (unsigned long)gxm_XtSelectionCallbackProc);
break;
@@ -1896,207 +1823,207 @@ static Arg *XEN_TO_C_Args(XEN inargl)
XtSetArg(args[i], name, (unsigned long)gxm_XtConvertSelectionIncrProc);
break;
case XM_ALLOC_COLOR_CALLBACK: /* XmNcolorAllocationProc, XmAllocColorProc XmScreen 921 */
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 3)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 3)))
{
XtSetArg(args[i], name, (unsigned long)gxm_XmAllocColorProc);
- if (XEN_PROCEDURE_P(xm_XmColorAllocationProc)) xm_unprotect(xm_XmColorAllocationProc);
+ if (Xen_is_procedure(xm_XmColorAllocationProc)) xm_unprotect(xm_XmColorAllocationProc);
xm_protect(value);
xm_XmColorAllocationProc = value;
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 3 args");
+ else Xen_check_type(0, value, 0, name, "procedure of 3 args");
}
break;
case XM_SCREEN_COLOR_CALLBACK: /* XmNcolorCalculationProc, XmScreen 921 */
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 2)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 2)))
{
XtSetArg(args[i], name, (unsigned long)gxm_XmColorCalculationProc);
- if (XEN_PROCEDURE_P(xm_XmColorCalculationProc)) xm_unprotect(xm_XmColorCalculationProc);
+ if (Xen_is_procedure(xm_XmColorCalculationProc)) xm_unprotect(xm_XmColorCalculationProc);
xm_protect(value);
xm_XmColorCalculationProc = value;
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 2 args");
+ else Xen_check_type(0, value, 0, name, "procedure of 2 args");
}
break;
case XM_POPUP_CALLBACK: /* XmNcreatePopupChildProc, XtCreatePopupChildProc */
- if ((XEN_PROCEDURE_P(value)) && (XEN_REQUIRED_ARGS_OK(value, 1)))
+ if ((Xen_is_procedure(value)) && (Xen_is_aritable(value, 1)))
{
XtSetArg(args[i], name, (unsigned long)gxm_XtPopupChild);
- descr = C_TO_XEN_XM_XtPopupChild(value);
- XEN_LIST_SET(descr, CALLBACK_GC_LOC, C_TO_XEN_INT(xm_protect(descr)));
+ descr = C_to_Xen_XM_XtPopupChild(value);
+ Xen_list_set(descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(xm_protect(descr)));
}
else
{
- if (XEN_FALSE_P(value))
+ if (Xen_is_false(value))
XtSetArg(args[i], name, 0);
- else XEN_ASSERT_TYPE(0, value, 0, name, "procedure of 1 arg");
+ else Xen_check_type(0, value, 0, name, "procedure of 1 arg");
}
break;
/* the rest are just doing type checks before the conversion to C */
case XM_INT:
- XEN_ASSERT_TYPE(XEN_INTEGER_P(value), value, XEN_ONLY_ARG, name, "an integer");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_INT(value)));
+ Xen_check_type(Xen_is_integer(value), value, 1, name, "an integer");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_integer_to_C_int(value)));
break;
case XM_FLOAT:
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(value), value, XEN_ONLY_ARG, name, "a float");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_DOUBLE(value)));
+ Xen_check_type(Xen_is_double(value), value, 1, name, "a float");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_real_to_C_double(value)));
break;
case XM_STRING:
- XEN_ASSERT_TYPE(XEN_STRING_P(value), value, XEN_ONLY_ARG, name, "a string");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_STRING(value)));
+ Xen_check_type(Xen_is_string(value), value, 1, name, "a string");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_string_to_C_string(value)));
break;
case XM_STRING_OR_INT:
- XEN_ASSERT_TYPE(XEN_STRING_P(value) || XEN_INTEGER_P(value), value, XEN_ONLY_ARG, name, "an integer or a string");
- if (XEN_STRING_P(value))
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_STRING(value)));
- else XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_INT(value)));
+ Xen_check_type(Xen_is_string(value) || Xen_is_integer(value), value, 1, name, "an integer or a string");
+ if (Xen_is_string(value))
+ XtSetArg(args[i], name, (XtArgVal)(Xen_string_to_C_string(value)));
+ else XtSetArg(args[i], name, (XtArgVal)(Xen_integer_to_C_int(value)));
break;
case XM_XMSTRING:
- XEN_ASSERT_TYPE(XEN_XmString_P(value), value, XEN_ONLY_ARG, name, "an XmString");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_XmString(value)));
+ Xen_check_type(Xen_is_XmString(value), value, 1, name, "an XmString");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_XmString(value)));
break;
case XM_STRING_OR_XMSTRING:
- XEN_ASSERT_TYPE(XEN_XmString_P(value) || XEN_STRING_P(value), value, XEN_ONLY_ARG, name, "a string or an XmString");
- if (XEN_STRING_P(value))
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_STRING(value)));
- else XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_XmString(value)));
+ Xen_check_type(Xen_is_XmString(value) || Xen_is_string(value), value, 1, name, "a string or an XmString");
+ if (Xen_is_string(value))
+ XtSetArg(args[i], name, (XtArgVal)(Xen_string_to_C_string(value)));
+ else XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_XmString(value)));
break;
case XM_STRING_TABLE:
- XEN_ASSERT_TYPE(XEN_LIST_P(value), value, XEN_ONLY_ARG, name, "an XmStringTable");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_XmStringTable(value, XEN_LIST_LENGTH(value))));
+ Xen_check_type(Xen_is_list(value), value, 1, name, "an XmStringTable");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_XmStringTable(value, Xen_list_length(value))));
break;
case XM_TRANSFER_ENTRY_LIST:
- XEN_ASSERT_TYPE(XEN_LIST_P(value), value, XEN_ONLY_ARG, name, "a list");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_XmDropTransferEntryRecs(value, XEN_LIST_LENGTH(value))));
+ Xen_check_type(Xen_is_list(value), value, 1, name, "a list");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_XmDropTransferEntryRecs(value, Xen_list_length(value))));
break;
case XM_RENDER_TABLE:
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(value), value, XEN_ONLY_ARG, name, "an XmRenderTable");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_XmRenderTable(value)));
+ Xen_check_type(Xen_is_XmRenderTable(value), value, 1, name, "an XmRenderTable");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_XmRenderTable(value)));
break;
case XM_TAB_LIST:
- XEN_ASSERT_TYPE(XEN_XmTabList_P(value), value, XEN_ONLY_ARG, name, "an XmTabList");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_XmTabList(value)));
+ Xen_check_type(Xen_is_XmTabList(value), value, 1, name, "an XmTabList");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_XmTabList(value)));
break;
case XM_WIDGET:
- XEN_ASSERT_TYPE(XEN_Widget_P(value), value, XEN_ONLY_ARG, name, "a Widget");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Widget(value)));
+ Xen_check_type(Xen_is_Widget(value), value, 1, name, "a Widget");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Widget(value)));
break;
case XM_BOOLEAN:
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(value), value, XEN_ONLY_ARG, name, "a boolean");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_BOOLEAN(value)));
+ Xen_check_type(Xen_is_boolean(value), value, 1, name, "a boolean");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_boolean_to_C_bool(value)));
break;
case XM_BOOLEAN_OR_INT:
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(value) || XEN_INTEGER_P(value), value, XEN_ONLY_ARG, name, "a boolean or int");
- if (XEN_BOOLEAN_P(value))
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_BOOLEAN(value)));
- else XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_INT(value)));
+ Xen_check_type(Xen_is_boolean(value) || Xen_is_integer(value), value, 1, name, "a boolean or int");
+ if (Xen_is_boolean(value))
+ XtSetArg(args[i], name, (XtArgVal)(Xen_boolean_to_C_bool(value)));
+ else XtSetArg(args[i], name, (XtArgVal)(Xen_integer_to_C_int(value)));
break;
case XM_PIXEL:
- XEN_ASSERT_TYPE(XEN_Pixel_P(value), value, XEN_ONLY_ARG, name, "a pixel");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Pixel(value)));
+ Xen_check_type(Xen_is_Pixel(value), value, 1, name, "a pixel");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Pixel(value)));
break;
case XM_PIXMAP:
- XEN_ASSERT_TYPE(XEN_Pixmap_P(value), value, XEN_ONLY_ARG, name, "a pixmap");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Pixmap(value)));
+ Xen_check_type(Xen_is_Pixmap(value), value, 1, name, "a pixmap");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Pixmap(value)));
break;
case XM_DIMENSION:
- XEN_ASSERT_TYPE(XEN_INTEGER_P(value), value, XEN_ONLY_ARG, name, "a Dimension (integer)");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Dimension(value)));
+ Xen_check_type(Xen_is_integer(value), value, 1, name, "a Dimension (integer)");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Dimension(value)));
break;
case XM_POSITION:
- XEN_ASSERT_TYPE(XEN_INTEGER_P(value), value, XEN_ONLY_ARG, name, "a Position (integer)");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Position(value)));
+ Xen_check_type(Xen_is_integer(value), value, 1, name, "a Position (integer)");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Position(value)));
break;
case XM_SHORT:
- XEN_ASSERT_TYPE(XEN_INTEGER_P(value), value, XEN_ONLY_ARG, name, "a short");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_INT(value)));
+ Xen_check_type(Xen_is_integer(value), value, 1, name, "a short");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_integer_to_C_int(value)));
break;
case XM_ATOM:
- XEN_ASSERT_TYPE(XEN_Atom_P(value), value, XEN_ONLY_ARG, name, "an Atom");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Atom(value)));
+ Xen_check_type(Xen_is_Atom(value), value, 1, name, "an Atom");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Atom(value)));
break;
case XM_TEXT_SOURCE:
- XEN_ASSERT_TYPE(XEN_XmTextSource_P(value), value, XEN_ONLY_ARG, name, "an XmTextSource");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_XmTextSource(value)));
+ Xen_check_type(Xen_is_XmTextSource(value), value, 1, name, "an XmTextSource");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_XmTextSource(value)));
break;
case XM_COLORMAP:
- XEN_ASSERT_TYPE(XEN_Colormap_P(value), value, XEN_ONLY_ARG, name, "a Colormap");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Colormap(value)));
+ Xen_check_type(Xen_is_Colormap(value), value, 1, name, "a Colormap");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Colormap(value)));
break;
case XM_KEYSYM:
- XEN_ASSERT_TYPE(XEN_KeySym_P(value), value, XEN_ONLY_ARG, name, "a KeySym");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_KeySym(value)));
+ Xen_check_type(Xen_is_KeySym(value), value, 1, name, "a KeySym");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_KeySym(value)));
break;
case XM_SCREEN:
- XEN_ASSERT_TYPE(XEN_Screen_P(value), value, XEN_ONLY_ARG, name, "a Screen");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Screen(value)));
+ Xen_check_type(Xen_is_Screen(value), value, 1, name, "a Screen");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Screen(value)));
break;
case XM_WINDOW:
- XEN_ASSERT_TYPE(XEN_Window_P(value), value, XEN_ONLY_ARG, name, "a Window");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Window(value)));
+ Xen_check_type(Xen_is_Window(value), value, 1, name, "a Window");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Window(value)));
break;
case XM_VISUAL:
- XEN_ASSERT_TYPE(XEN_Visual_P(value), value, XEN_ONLY_ARG, name, "a Visual");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Visual(value)));
+ Xen_check_type(Xen_is_Visual(value), value, 1, name, "a Visual");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Visual(value)));
break;
case XM_WIDGET_CLASS:
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(value), value, XEN_ONLY_ARG, name, "a WidgetClass");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_WidgetClass(value)));
+ Xen_check_type(Xen_is_WidgetClass(value), value, 1, name, "a WidgetClass");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_WidgetClass(value)));
break;
case XM_ATOM_LIST:
- XEN_ASSERT_TYPE(XEN_LIST_P(value), value, XEN_ONLY_ARG, name, "a list of Atoms");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Atoms(value, XEN_LIST_LENGTH(value))));
+ Xen_check_type(Xen_is_list(value), value, 1, name, "a list of Atoms");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Atoms(value, Xen_list_length(value))));
break;
case XM_INT_TABLE:
- XEN_ASSERT_TYPE(XEN_LIST_P(value), value, XEN_ONLY_ARG, name, "a list of ints");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Ints(value, XEN_LIST_LENGTH(value))));
+ Xen_check_type(Xen_is_list(value), value, 1, name, "a list of ints");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Ints(value, Xen_list_length(value))));
break;
case XM_WIDGET_LIST:
- XEN_ASSERT_TYPE(XEN_LIST_P(value), value, XEN_ONLY_ARG, name, "a list of Widgets");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Widgets(value, XEN_LIST_LENGTH(value))));
+ Xen_check_type(Xen_is_list(value), value, 1, name, "a list of Widgets");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Widgets(value, Xen_list_length(value))));
break;
case XM_KEYSYM_TABLE:
- XEN_ASSERT_TYPE(XEN_LIST_P(value), value, XEN_ONLY_ARG, name, "a list of KeySyms");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_KeySyms(value, XEN_LIST_LENGTH(value))));
+ Xen_check_type(Xen_is_list(value), value, 1, name, "a list of KeySyms");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_KeySyms(value, Xen_list_length(value))));
break;
case XM_STRING_LIST:
case XM_CHARSET_TABLE:
- XEN_ASSERT_TYPE(XEN_LIST_P(value), value, XEN_ONLY_ARG, name, "a list of char *");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Strings(value, XEN_LIST_LENGTH(value))));
+ Xen_check_type(Xen_is_list(value), value, 1, name, "a list of char *");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Strings(value, Xen_list_length(value))));
break;
case XM_RECTANGLE_LIST:
- XEN_ASSERT_TYPE(XEN_LIST_P(value), value, XEN_ONLY_ARG, name, "a list of XRectangles");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_XRectangles(value, XEN_LIST_LENGTH(value))));
+ Xen_check_type(Xen_is_list(value), value, 1, name, "a list of XRectangles");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_XRectangles(value, Xen_list_length(value))));
break;
case XM_CURSOR:
- XEN_ASSERT_TYPE(XEN_Cursor_P(value), value, XEN_ONLY_ARG, name, "a cursor");
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_Cursor(value)));
+ Xen_check_type(Xen_is_Cursor(value), value, 1, name, "a cursor");
+ XtSetArg(args[i], name, (XtArgVal)(Xen_to_C_Cursor(value)));
break;
default:
- if (XEN_ULONG_P(value))
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_ULONG(value)));
- else if (XEN_INTEGER_P(value))
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_INT(value)));
- else if (XEN_BOOLEAN_P(value))
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_BOOLEAN(value)));
- else if (XEN_STRING_P(value))
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_STRING(value)));
+ if (Xen_is_ulong(value))
+ XtSetArg(args[i], name, (XtArgVal)(Xen_ulong_to_C_ulong(value)));
+ else if (Xen_is_integer(value))
+ XtSetArg(args[i], name, (XtArgVal)(Xen_integer_to_C_int(value)));
+ else if (Xen_is_boolean(value))
+ XtSetArg(args[i], name, (XtArgVal)(Xen_boolean_to_C_bool(value)));
+ else if (Xen_is_string(value))
+ XtSetArg(args[i], name, (XtArgVal)(Xen_string_to_C_string(value)));
/* these are bare pointers -- we can't assume they can be "unwrapped" in xen jargon */
- else if (XEN_LIST_P(value))
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_INT64_T(XEN_CADR(value)))); /* all tagged types */
+ else if (Xen_is_list(value))
+ XtSetArg(args[i], name, (XtArgVal)(Xen_llong_to_C_llong(Xen_cadr(value)))); /* all tagged types */
else
- XtSetArg(args[i], name, (XtArgVal)(XEN_TO_C_INT64_T(value)));
+ XtSetArg(args[i], name, (XtArgVal)(Xen_llong_to_C_llong(value)));
break;
}
}
@@ -2116,7 +2043,7 @@ static void fixup_args(Widget w, Arg *args, int len)
{
XtCallbackRec *cl = NULL;
int j;
- XEN data;
+ Xen data;
switch (resource_type(name))
{
case XM_STRING_TABLE:
@@ -2138,8 +2065,8 @@ static void fixup_args(Widget w, Arg *args, int len)
for (j = 0 ;; j++)
{
if (cl[j].callback == NULL) break;
- data = (XEN)(cl[j].closure);
- XEN_LIST_SET(data, CALLBACK_STRUCT_TYPE, C_TO_XEN_INT(callback_struct_type(w, name)));
+ data = (Xen)(cl[j].closure);
+ Xen_list_set(data, CALLBACK_STRUCT_TYPE, C_int_to_Xen_integer(callback_struct_type(w, name)));
}
free(cl);
break;
@@ -2149,13 +2076,13 @@ static void fixup_args(Widget w, Arg *args, int len)
if (j >= 0)
{
data = xm_protected_element(j);
- xm_unprotect_at(XEN_TO_C_INT(XEN_LIST_REF(data, CALLBACK_GC_LOC)));
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_list_ref(data, CALLBACK_GC_LOC)));
}
- j = map_over_protected_elements(find_dropproc, (unsigned long)XEN_FALSE);
+ j = map_over_protected_elements(find_dropproc, (unsigned long)Xen_false);
if (j >= 0)
{
data = xm_protected_element(j);
- XEN_LIST_SET(data, CALLBACK_DATA, C_TO_XEN_Widget(w));
+ Xen_list_set(data, CALLBACK_DATA, C_to_Xen_Widget(w));
}
else fprintf(stderr,"can't fixup drop proc!");
break;
@@ -2164,13 +2091,13 @@ static void fixup_args(Widget w, Arg *args, int len)
if (j >= 0)
{
data = xm_protected_element(j);
- xm_unprotect_at(XEN_TO_C_INT(XEN_LIST_REF(data, CALLBACK_GC_LOC)));
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_list_ref(data, CALLBACK_GC_LOC)));
}
- j = map_over_protected_elements(find_dragproc, (unsigned long)XEN_FALSE);
+ j = map_over_protected_elements(find_dragproc, (unsigned long)Xen_false);
if (j >= 0)
{
data = xm_protected_element(j);
- XEN_LIST_SET(data, CALLBACK_DATA, C_TO_XEN_Widget(w));
+ Xen_list_set(data, CALLBACK_DATA, C_to_Xen_Widget(w));
}
else fprintf(stderr,"can't fixup drag proc!");
break;
@@ -2179,13 +2106,13 @@ static void fixup_args(Widget w, Arg *args, int len)
if (j >= 0)
{
data = xm_protected_element(j);
- xm_unprotect_at(XEN_TO_C_INT(XEN_LIST_REF(data, CALLBACK_GC_LOC)));
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_list_ref(data, CALLBACK_GC_LOC)));
}
- j = map_over_protected_elements(find_qualifyproc, (unsigned long)XEN_FALSE); /* i.e. find the unset one */
+ j = map_over_protected_elements(find_qualifyproc, (unsigned long)Xen_false); /* i.e. find the unset one */
if (j >= 0)
{
data = xm_protected_element(j);
- XEN_LIST_SET(data, CALLBACK_DATA, C_TO_XEN_Widget(w));
+ Xen_list_set(data, CALLBACK_DATA, C_to_Xen_Widget(w));
}
break;
case XM_SEARCH_CALLBACK:
@@ -2193,13 +2120,13 @@ static void fixup_args(Widget w, Arg *args, int len)
if (j >= 0)
{
data = xm_protected_element(j);
- xm_unprotect_at(XEN_TO_C_INT(XEN_LIST_REF(data, CALLBACK_GC_LOC)));
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_list_ref(data, CALLBACK_GC_LOC)));
}
- j = map_over_protected_elements(find_searchproc, (unsigned long)XEN_FALSE);
+ j = map_over_protected_elements(find_searchproc, (unsigned long)Xen_false);
if (j >= 0)
{
data = xm_protected_element(j);
- XEN_LIST_SET(data, CALLBACK_DATA, C_TO_XEN_Widget(w));
+ Xen_list_set(data, CALLBACK_DATA, C_to_Xen_Widget(w));
}
break;
case XM_ORDER_CALLBACK:
@@ -2207,13 +2134,13 @@ static void fixup_args(Widget w, Arg *args, int len)
if (j >= 0)
{
data = xm_protected_element(j);
- xm_unprotect_at(XEN_TO_C_INT(XEN_LIST_REF(data, CALLBACK_GC_LOC)));
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_list_ref(data, CALLBACK_GC_LOC)));
}
- j = map_over_protected_elements(find_orderproc, (unsigned long)XEN_FALSE);
+ j = map_over_protected_elements(find_orderproc, (unsigned long)Xen_false);
if (j >= 0)
{
data = xm_protected_element(j);
- XEN_LIST_SET(data, CALLBACK_DATA, C_TO_XEN_Widget(w));
+ Xen_list_set(data, CALLBACK_DATA, C_to_Xen_Widget(w));
}
break;
case XM_POPUP_CALLBACK:
@@ -2221,13 +2148,13 @@ static void fixup_args(Widget w, Arg *args, int len)
if (j >= 0)
{
data = xm_protected_element(j);
- xm_unprotect_at(XEN_TO_C_INT(XEN_LIST_REF(data, CALLBACK_GC_LOC)));
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_list_ref(data, CALLBACK_GC_LOC)));
}
- j = map_over_protected_elements(find_popupchild, (unsigned long)XEN_FALSE);
+ j = map_over_protected_elements(find_popupchild, (unsigned long)Xen_false);
if (j >= 0)
{
data = xm_protected_element(j);
- XEN_LIST_SET(data, CALLBACK_DATA, C_TO_XEN_Widget(w));
+ Xen_list_set(data, CALLBACK_DATA, C_to_Xen_Widget(w));
}
break;
default:
@@ -2253,7 +2180,7 @@ static int xmstringtable_length(Widget w, const char *name)
return(len);
}
-static XEN C_TO_XEN_ANY(Widget w, Arg arg)
+static Xen C_to_Xen_ANY(Widget w, Arg arg)
{
/* XtGetValues -- a list of pairs: resource-name place-holder where we fill in the 2nd element */
/* this has to wait until the last moment to decide what arg.value is -- if we assume unsigned long*
@@ -2263,46 +2190,46 @@ static XEN C_TO_XEN_ANY(Widget w, Arg arg)
int j, ilen = 0;
switch (resource_type(arg.name))
{
- case XM_INT: return(C_TO_XEN_INT((*((int *)(arg.value)))));
- case XM_ULONG: return(C_TO_XEN_ULONG((*((unsigned long *)(arg.value)))));
- case XM_XTPOINTER: return(XEN_WRAP_C_POINTER((XtPointer)(arg.value)));
- case XM_UCHAR: return(C_TO_XEN_INT((*((unsigned char *)(arg.value)))));
- case XM_FLOAT: return(C_TO_XEN_DOUBLE((*((float *)(arg.value))))); /* the resource values are floats */
- case XM_STRING: return(C_TO_XEN_STRING((char *)(*((char **)(arg.value)))));
+ case XM_INT: return(C_int_to_Xen_integer((*((int *)(arg.value)))));
+ case XM_ULONG: return(C_ulong_to_Xen_ulong((*((unsigned long *)(arg.value)))));
+ case XM_XTPOINTER: return(Xen_wrap_C_pointer((XtPointer)(arg.value)));
+ case XM_UCHAR: return(C_int_to_Xen_integer((*((unsigned char *)(arg.value)))));
+ case XM_FLOAT: return(C_double_to_Xen_real((*((float *)(arg.value))))); /* the resource values are floats */
+ case XM_STRING: return(C_string_to_Xen_string((char *)(*((char **)(arg.value)))));
case XM_STRING_OR_XMSTRING: /* fileselectionbox here , not parsemapping */
- case XM_XMSTRING: return(C_TO_XEN_XmString((XmString)(*((XmString *)(arg.value)))));
- case XM_STRING_TABLE: return(C_TO_XEN_XmStringTable((XmStringTable)(*((XmStringTable *)(arg.value))), xmstringtable_length(w, arg.name)));
- case XM_RENDER_TABLE: return(C_TO_XEN_XmRenderTable((XmRenderTable)(*((XmRenderTable *)(arg.value)))));
- case XM_TAB_LIST: return(C_TO_XEN_XmTabList((XmTabList)(*((XmTabList *)(arg.value)))));
- case XM_WIDGET: return(C_TO_XEN_Widget((Widget)(*((Widget *)(arg.value)))));
+ case XM_XMSTRING: return(C_to_Xen_XmString((XmString)(*((XmString *)(arg.value)))));
+ case XM_STRING_TABLE: return(C_to_Xen_XmStringTable((XmStringTable)(*((XmStringTable *)(arg.value))), xmstringtable_length(w, arg.name)));
+ case XM_RENDER_TABLE: return(C_to_Xen_XmRenderTable((XmRenderTable)(*((XmRenderTable *)(arg.value)))));
+ case XM_TAB_LIST: return(C_to_Xen_XmTabList((XmTabList)(*((XmTabList *)(arg.value)))));
+ case XM_WIDGET: return(C_to_Xen_Widget((Widget)(*((Widget *)(arg.value)))));
case XM_WIDGET_LIST: /* (XtGetValues c1 (list XmNchildren 0) 1) */
if (strcmp(arg.name, XmNchildren) == 0)
XtSetArg(a[0], XmNnumChildren, &ilen); /* Composite */
else XtSetArg(a[0], XmNselectedObjectCount, &ilen); /* Container */
XtGetValues(w, a, 1);
- return(C_TO_XEN_Widgets((Widget *)(*((Widget **)(arg.value))), ilen));
+ return(C_to_Xen_Widgets((Widget *)(*((Widget **)(arg.value))), ilen));
break;
- case XM_BOOLEAN: return(C_TO_XEN_BOOLEAN((*((Boolean *)(arg.value)))));
- case XM_BOOLEAN_OR_INT: return(C_TO_XEN_INT((*((int *)(arg.value)))));
+ case XM_BOOLEAN: return(C_bool_to_Xen_boolean((*((Boolean *)(arg.value)))));
+ case XM_BOOLEAN_OR_INT: return(C_int_to_Xen_integer((*((int *)(arg.value)))));
case XM_SEARCH_CALLBACK:
j = map_over_protected_elements(find_searchproc, (unsigned long)w);
- if (j >= 0) return(XEN_LIST_REF(xm_protected_element(j), CALLBACK_FUNC));
+ if (j >= 0) return(Xen_list_ref(xm_protected_element(j), CALLBACK_FUNC));
break;
case XM_DROP_CALLBACK:
j = map_over_protected_elements(find_dropproc, (unsigned long)w);
- if (j >= 0) return(XEN_LIST_REF(xm_protected_element(j), CALLBACK_FUNC));
+ if (j >= 0) return(Xen_list_ref(xm_protected_element(j), CALLBACK_FUNC));
break;
case XM_DRAG_CALLBACK:
j = map_over_protected_elements(find_dragproc, (unsigned long)w);
- if (j >= 0) return(XEN_LIST_REF(xm_protected_element(j), CALLBACK_FUNC));
+ if (j >= 0) return(Xen_list_ref(xm_protected_element(j), CALLBACK_FUNC));
break;
case XM_ORDER_CALLBACK:
j = map_over_protected_elements(find_orderproc, (unsigned long)w);
- if (j >= 0) return(XEN_LIST_REF(xm_protected_element(j), CALLBACK_FUNC));
+ if (j >= 0) return(Xen_list_ref(xm_protected_element(j), CALLBACK_FUNC));
break;
case XM_QUALIFY_CALLBACK:
j = map_over_protected_elements(find_qualifyproc, (unsigned long)w);
- if (j >= 0) return(XEN_LIST_REF(xm_protected_element(j), CALLBACK_FUNC));
+ if (j >= 0) return(Xen_list_ref(xm_protected_element(j), CALLBACK_FUNC));
break;
case XM_ALLOC_COLOR_CALLBACK:
return(xm_XmColorAllocationProc);
@@ -2312,7 +2239,7 @@ static XEN C_TO_XEN_ANY(Widget w, Arg arg)
break;
case XM_POPUP_CALLBACK:
j = map_over_protected_elements(find_popupchild, (unsigned long)w);
- if (j >= 0) return(XEN_LIST_REF(xm_protected_element(j), CALLBACK_FUNC));
+ if (j >= 0) return(Xen_list_ref(xm_protected_element(j), CALLBACK_FUNC));
break;
case XM_TRANSFER_CALLBACK:
return(xm_XtSelectionCallback_Descr);
@@ -2322,46 +2249,46 @@ static XEN C_TO_XEN_ANY(Widget w, Arg arg)
/* this can't work because we don't know what the desired callback was, so we can't search the gc table */
/* and if the callback was a C procedure, what good would its address be in this context? */
/* (XtGetValues_1 would need to pass the entire Arg or something) */
- return(C_TO_XEN_ULONG((*((unsigned long *)(arg.value)))));
+ return(C_ulong_to_Xen_ulong((*((unsigned long *)(arg.value)))));
break;
- case XM_PIXEL: return(C_TO_XEN_Pixel((*((Pixel *)(arg.value)))));
- case XM_PIXMAP: return(C_TO_XEN_Pixmap((*((Pixmap *)(arg.value)))));
- case XM_XFONTSTRUCT: return(C_TO_XEN_XFontStruct((XFontStruct *)(*((XFontStruct **)(arg.value)))));
- case XM_DIMENSION: return(C_TO_XEN_Dimension((*((Dimension *)(arg.value)))));
- case XM_POSITION: return(C_TO_XEN_Position((*((Position *)(arg.value)))));
- case XM_SHORT: return(C_TO_XEN_INT((*((short *)(arg.value)))));
- case XM_ATOM: return(C_TO_XEN_Atom((*((Atom *)(arg.value)))));
- case XM_TEXT_SOURCE: return(C_TO_XEN_XmTextSource((XmTextSource)(*((XmTextSource *)(arg.value)))));
+ case XM_PIXEL: return(C_to_Xen_Pixel((*((Pixel *)(arg.value)))));
+ case XM_PIXMAP: return(C_to_Xen_Pixmap((*((Pixmap *)(arg.value)))));
+ case XM_XFONTSTRUCT: return(C_to_Xen_XFontStruct((XFontStruct *)(*((XFontStruct **)(arg.value)))));
+ case XM_DIMENSION: return(C_to_Xen_Dimension((*((Dimension *)(arg.value)))));
+ case XM_POSITION: return(C_to_Xen_Position((*((Position *)(arg.value)))));
+ case XM_SHORT: return(C_int_to_Xen_integer((*((short *)(arg.value)))));
+ case XM_ATOM: return(C_to_Xen_Atom((*((Atom *)(arg.value)))));
+ case XM_TEXT_SOURCE: return(C_to_Xen_XmTextSource((XmTextSource)(*((XmTextSource *)(arg.value)))));
case XM_ATOM_LIST:
if (strcmp(arg.name, XmNexportTargets) == 0) /* DragContext */
XtSetArg(a[0], XmNnumExportTargets, &ilen); /* DropSite */
else XtSetArg(a[0], XmNnumImportTargets, &ilen);
XtGetValues(w, a, 1);
if ((ilen > 0) && (ilen < 100))
- return(C_TO_XEN_Atoms((Atom *)(*((Atom **)(arg.value))), ilen));
- else return(XEN_FALSE);
+ return(C_to_Xen_Atoms((Atom *)(*((Atom **)(arg.value))), ilen));
+ else return(Xen_false);
break;
case XM_STRING_LIST: /* ApplicationShell */
XtSetArg(a[0], XmNargc, &ilen);
XtGetValues(w, a, 1);
- return(C_TO_XEN_Strings((char **)(*((char ***)(arg.value))), ilen));
+ return(C_to_Xen_Strings((char **)(*((char ***)(arg.value))), ilen));
break;
case XM_CHARSET_TABLE:
XtSetArg(a[0], XmNbuttonCount, &ilen); /* may not be long enough... */
XtGetValues(w, a, 1);
- return(C_TO_XEN_Strings((char **)(*((char ***)(arg.value))), ilen));
+ return(C_to_Xen_Strings((char **)(*((char ***)(arg.value))), ilen));
break;
- case XM_COLORMAP: return(C_TO_XEN_Colormap((*((Colormap *)(arg.value)))));
- case XM_KEYSYM: return(C_TO_XEN_KeySym((*((KeySym *)(arg.value)))));
+ case XM_COLORMAP: return(C_to_Xen_Colormap((*((Colormap *)(arg.value)))));
+ case XM_KEYSYM: return(C_to_Xen_KeySym((*((KeySym *)(arg.value)))));
case XM_KEYSYM_TABLE:
XtSetArg(a[0], XmNbuttonCount, &ilen);
XtGetValues(w, a, 1);
- return(C_TO_XEN_KeySyms((KeySym *)(*((KeySym **)(arg.value))), ilen));
+ return(C_to_Xen_KeySyms((KeySym *)(*((KeySym **)(arg.value))), ilen));
break;
- case XM_SCREEN: return(C_TO_XEN_Screen((Screen *)(*((Screen **)(arg.value)))));
- case XM_WINDOW: return(C_TO_XEN_Window((Window)(*((Window *)(arg.value)))));
- case XM_VISUAL: return(C_TO_XEN_Visual((Visual *)(*((Visual **)(arg.value)))));
+ case XM_SCREEN: return(C_to_Xen_Screen((Screen *)(*((Screen **)(arg.value)))));
+ case XM_WINDOW: return(C_to_Xen_Window((Window)(*((Window *)(arg.value)))));
+ case XM_VISUAL: return(C_to_Xen_Visual((Visual *)(*((Visual **)(arg.value)))));
case XM_INT_TABLE:
if (strcmp(arg.name, XmNdetailOrder) == 0)
XtSetArg(a[0], XmNdetailOrderCount, &ilen);
@@ -2372,37 +2299,37 @@ static XEN C_TO_XEN_ANY(Widget w, Arg arg)
else XtSetArg(a[0], XmNselectedPositionCount, &ilen);
}
XtGetValues(w, a, 1);
- return(C_TO_XEN_Ints((int *)(*((int **)(arg.value))), ilen));
+ return(C_to_Xen_Ints((int *)(*((int **)(arg.value))), ilen));
break;
case XM_RECTANGLE_LIST: /* XmNrectangles exists but is not documented */
XtSetArg(a[0], XmNnumDropRectangles, &ilen);
XtGetValues(w, a, 1);
- return(C_TO_XEN_XRectangles((XRectangle *)(*((XRectangle **)(arg.value))), ilen));
+ return(C_to_Xen_XRectangles((XRectangle *)(*((XRectangle **)(arg.value))), ilen));
break;
- case XM_WIDGET_CLASS: return(C_TO_XEN_WidgetClass((WidgetClass)(*((WidgetClass *)(arg.value)))));
+ case XM_WIDGET_CLASS: return(C_to_Xen_WidgetClass((WidgetClass)(*((WidgetClass *)(arg.value)))));
case XM_STRING_OR_INT:
if ((w) &&
((XmIsText(w)) || (XmIsTextField(w))))
- return(C_TO_XEN_STRING((char *)(*((char **)(arg.value)))));
- else return(C_TO_XEN_INT((int)(*((int *)(arg.value)))));
+ return(C_string_to_Xen_string((char *)(*((char **)(arg.value)))));
+ else return(C_int_to_Xen_integer((int)(*((int *)(arg.value)))));
break;
default:
break;
}
- return(C_TO_XEN_ULONG((*((unsigned long *)(arg.value))))); /* fallback */
+ return(C_ulong_to_Xen_ulong((*((unsigned long *)(arg.value))))); /* fallback */
}
-static XEN C_TO_XEN_Args(Widget w, Arg *args, int len)
+static Xen C_to_Xen_Args(Widget w, Arg *args, int len)
{
/* here XtGetValues (or equivalent) has filled in the resource values and we need to pass them back
* to scheme properly wrapped
*/
int i, loc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS_2(C_TO_XEN_STRING(args[i].name),
- C_TO_XEN_ANY(w, args[i]),
+ lst = Xen_cons_2(C_string_to_Xen_string(args[i].name),
+ C_to_Xen_ANY(w, args[i]),
lst);
xm_unprotect_at(loc);
return(lst);
@@ -2410,87 +2337,86 @@ static XEN C_TO_XEN_Args(Widget w, Arg *args, int len)
/* (XtGetValues c1 (list XmNx 0) 1) */
-static XEN gxm_XtGetValues_1(XEN arg1, XEN larg2, int len)
+static Xen gxm_XtGetValues_1(Xen arg1, Xen larg2, int len)
{
Arg *args;
unsigned long *locs;
Widget w;
- XEN val, arg2;
+ Xen val, arg2;
int i, gcloc;
/* here we need to make sure the ref args are ok from C's point of view */
- if (len <= 0) return(XEN_FALSE);
- w = XEN_TO_C_Widget(arg1);
- arg2 = XEN_COPY_ARG(larg2);
+ if (len <= 0) return(Xen_false);
+ w = Xen_to_C_Widget(arg1);
+ arg2 = Xen_copy_arg(larg2);
gcloc = xm_protect(arg2);
args = (Arg *)calloc(len, sizeof(Arg));
locs = (unsigned long *)calloc(len, sizeof(unsigned long));
- for (i = 0; i < len; i++, arg2 = XEN_CDDR(arg2))
+ for (i = 0; i < len; i++, arg2 = Xen_cddr(arg2))
{
char *name;
- name = xen_strdup(XEN_TO_C_STRING(XEN_CAR(arg2)));
+ name = xen_strdup(Xen_string_to_C_string(Xen_car(arg2)));
XtSetArg(args[i], name, &(locs[i]));
}
XtGetValues(w, args, len);
- val = C_TO_XEN_Args(w, args, len);
+ val = C_to_Xen_Args(w, args, len);
free_args(args, len);
free(locs);
xm_unprotect_at(gcloc);
return(val);
}
-#endif
/* -------------------------------- gc protection -------------------------------- */
-static XEN xm_protected;
+static Xen xm_protected;
static int xm_protected_size = 0;
-static XEN xm_gc_table;
+static Xen xm_gc_table;
static int last_xm_unprotect = NOT_A_GC_LOC;
-static int xm_protect(XEN obj)
+static int xm_protect(Xen obj)
{
int i, new_size;
- XEN new_table;
+ Xen new_table;
if (last_xm_unprotect >= 0)
{
i = last_xm_unprotect;
- if (XEN_FALSE_P(XEN_VECTOR_REF(xm_protected, i)))
+ if (Xen_is_false(Xen_vector_ref(xm_protected, i)))
{
- XEN_VECTOR_SET(xm_protected, i, obj);
+ Xen_vector_set(xm_protected, i, obj);
last_xm_unprotect = NOT_A_GC_LOC;
return(i);
}
last_xm_unprotect = NOT_A_GC_LOC;
}
for (i = 0; i < xm_protected_size; i++)
- if (XEN_FALSE_P(XEN_VECTOR_REF(xm_protected, i)))
+ if (Xen_is_false(Xen_vector_ref(xm_protected, i)))
{
- XEN_VECTOR_SET(xm_protected, i, obj);
+ Xen_vector_set(xm_protected, i, obj);
return(i);
}
new_size = xm_protected_size * 2;
- new_table = XEN_MAKE_VECTOR(new_size, XEN_FALSE);
+ new_table = Xen_make_vector(new_size, Xen_false);
for (i = 0; i < xm_protected_size; i++)
{
- XEN_VECTOR_SET(new_table, i, XEN_VECTOR_REF(xm_protected, i));
- XEN_VECTOR_SET(xm_protected, i, XEN_FALSE);
+ Xen_vector_set(new_table, i, Xen_vector_ref(xm_protected, i));
+ Xen_vector_set(xm_protected, i, Xen_false);
}
- XEN_VECTOR_SET(new_table, xm_protected_size, obj);
- XEN_VECTOR_SET(xm_gc_table, 0, new_table);
+ Xen_vector_set(new_table, xm_protected_size, obj);
+ Xen_vector_set(xm_gc_table, 0, new_table);
i = xm_protected_size;
xm_protected_size = new_size;
xm_protected = new_table;
return(i);
}
-static void xm_unprotect(XEN obj)
+static void xm_unprotect(Xen obj)
{
int i;
for (i = 0; i < xm_protected_size; i++)
- if (XEN_EQ_P(XEN_VECTOR_REF(xm_protected, i), obj))
+ if (Xen_is_eq(Xen_vector_ref(xm_protected, i), obj))
{
- XEN_VECTOR_SET(xm_protected, i, XEN_FALSE);
+ Xen_vector_set(xm_protected, i, Xen_false);
last_xm_unprotect = i;
return;
}
@@ -2498,22 +2424,22 @@ static void xm_unprotect(XEN obj)
static void xm_unprotect_at(int ind)
{
- XEN_VECTOR_SET(xm_protected, ind, XEN_FALSE);
+ Xen_vector_set(xm_protected, ind, Xen_false);
last_xm_unprotect = ind;
}
-static int map_over_protected_elements(bool (*func)(XEN val, int loc, unsigned long fid), unsigned long id)
+static int map_over_protected_elements(bool (*func)(Xen val, int loc, unsigned long fid), unsigned long id)
{
int i;
for (i = 0; i < xm_protected_size; i++)
- if (func(XEN_VECTOR_REF(xm_protected, i), i, id))
+ if (func(Xen_vector_ref(xm_protected, i), i, id))
return(i);
return(-1);
}
-static XEN xm_protected_element(int loc)
+static Xen xm_protected_element(int loc)
{
- return(XEN_VECTOR_REF(xm_protected, loc));
+ return(Xen_vector_ref(xm_protected, loc));
}
@@ -2534,170 +2460,169 @@ static XEN xm_protected_element(int loc)
*/
/* Motif */
-#if HAVE_MOTIF
/* weird order of procedures here and throughout caused by the C-header scripts --
* basically I forgot to reverse the main lists before pouring out the code,
* so everything is slightly backwards
*/
-static int XEN_TO_C_INT_DEF(XEN len, XEN lst)
+static int Xen_to_C_INT_DEF(Xen len, Xen lst)
{
- if (XEN_INTEGER_P(len))
- return(XEN_TO_C_INT(len));
+ if (Xen_is_integer(len))
+ return(Xen_integer_to_C_int(len));
else
{
int list_len;
- list_len = XEN_LIST_LENGTH(lst);
+ list_len = Xen_list_length(lst);
return((int)(list_len / 2));
}
}
-static XEN gxm_XmTransferDone(XEN arg1, XEN arg2)
+static Xen gxm_XmTransferDone(Xen arg1, Xen arg2)
{
#define H_XmTransferDone "void XmTransferDone(XtPointer transfer_id, XmTransferStatus status) completes a data transfer"
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1), arg1, 1, "XmTransferDone", "XtPointer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTransferDone", "XmTransferStatus");
- XmTransferDone((XtPointer)XEN_UNWRAP_C_POINTER(arg1), (XmTransferStatus)XEN_TO_C_INT(arg2));
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1), arg1, 1, "XmTransferDone", "XtPointer");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTransferDone", "XmTransferStatus");
+ XmTransferDone((XtPointer)Xen_unwrap_C_pointer(arg1), (XmTransferStatus)Xen_integer_to_C_int(arg2));
return(arg1);
}
-static XEN gxm_XmTransferSendRequest(XEN arg1, XEN arg2)
+static Xen gxm_XmTransferSendRequest(Xen arg1, Xen arg2)
{
#define H_XmTransferSendRequest "void XmTransferSendRequest(XtPointer transfer_id, Time time) transfers a MULTIPLE request"
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1), arg1, 1, "XmTransferSendRequest", "XtPointer");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTransferSendRequest", "Time");
- XmTransferSendRequest((XtPointer)XEN_UNWRAP_C_POINTER(arg1), XEN_TO_C_Time(arg2));
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1), arg1, 1, "XmTransferSendRequest", "XtPointer");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTransferSendRequest", "Time");
+ XmTransferSendRequest((XtPointer)Xen_unwrap_C_pointer(arg1), Xen_to_C_Time(arg2));
return(arg1);
}
-static XEN gxm_XmTransferStartRequest(XEN arg1)
+static Xen gxm_XmTransferStartRequest(Xen arg1)
{
#define H_XmTransferStartRequest "void XmTransferStartRequest(XtPointer transfer_id) begins a MULTIPLE transfer"
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1), arg1, 1, "XmTransferStartRequest", "XtPointer");
- XmTransferStartRequest((XtPointer)XEN_UNWRAP_C_POINTER(arg1));
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1), arg1, 1, "XmTransferStartRequest", "XtPointer");
+ XmTransferStartRequest((XtPointer)Xen_unwrap_C_pointer(arg1));
return(arg1);
}
-static XEN gxm_XmTransferSetParameters(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmTransferSetParameters(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmTransferSetParameters "void XmTransferSetParameters(XtPointer transfer_id, XtPointer parm, int parm_fmt, \
unsigned long parm_length, Atom parm_type) establishes parameters to be passed by the next call to XmTransferValue"
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1), arg1, 1, "XmTransferSetParameters", "XtPointer");
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg2), arg2, 2, "XmTransferSetParameters", "XtPointer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTransferSetParameters", "an integer");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XmTransferSetParameters", "unsigned long");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg5), arg5, 5, "XmTransferSetParameters", "an Atom");
- XmTransferSetParameters((XtPointer)XEN_UNWRAP_C_POINTER(arg1),
- (XtPointer)XEN_UNWRAP_C_POINTER(arg2),
- XEN_TO_C_INT(arg3),
- XEN_TO_C_ULONG(arg4),
- XEN_TO_C_Atom(arg5));
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1), arg1, 1, "XmTransferSetParameters", "XtPointer");
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg2), arg2, 2, "XmTransferSetParameters", "XtPointer");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTransferSetParameters", "an integer");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XmTransferSetParameters", "unsigned long");
+ Xen_check_type(Xen_is_Atom(arg5), arg5, 5, "XmTransferSetParameters", "an Atom");
+ XmTransferSetParameters((XtPointer)Xen_unwrap_C_pointer(arg1),
+ (XtPointer)Xen_unwrap_C_pointer(arg2),
+ Xen_integer_to_C_int(arg3),
+ Xen_ulong_to_C_ulong(arg4),
+ Xen_to_C_Atom(arg5));
return(arg1);
}
static void gxm_TransferValueProc(Widget w, XtPointer context, XtPointer info)
{
- XEN descr = (XEN)context;
- XEN_CALL_3(XEN_LIST_REF(descr, 0),
- C_TO_XEN_Widget(w),
- XEN_LIST_REF(descr, 1),
- C_TO_XEN_XmSelectionCallbackStruct((XmSelectionCallbackStruct *)info),
- c__FUNCTION__);
+ Xen descr = (Xen)context;
+ Xen_call_with_3_args(Xen_list_ref(descr, 0),
+ C_to_Xen_Widget(w),
+ Xen_list_ref(descr, 1),
+ C_to_Xen_XmSelectionCallbackStruct((XmSelectionCallbackStruct *)info),
+ __func__);
}
-static XEN gxm_XmTransferValue(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmTransferValue(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmTransferValue "void XmTransferValue(XtPointer transfer_id, Atom target, XtCallbackProc proc, XtPointer client_data, Time time) \
transfers data to a destination"
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1), arg1, 1, "XmTransferValue", "XtPointer");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmTransferValue", "an Atom");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg3) && (XEN_REQUIRED_ARGS_OK(arg3, 3)), arg3, 3, "XmTransferValue", "XtCallbackProc (3 args)");
- XEN_ASSERT_TYPE(XEN_Time_P(arg5), arg5, 5, "XmTransferValue", "Time");
- XmTransferValue((XtPointer)XEN_UNWRAP_C_POINTER(arg1),
- XEN_TO_C_Atom(arg2),
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1), arg1, 1, "XmTransferValue", "XtPointer");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmTransferValue", "an Atom");
+ Xen_check_type(Xen_is_procedure(arg3) && (Xen_is_aritable(arg3, 3)), arg3, 3, "XmTransferValue", "XtCallbackProc (3 args)");
+ Xen_check_type(Xen_is_Time(arg5), arg5, 5, "XmTransferValue", "Time");
+ XmTransferValue((XtPointer)Xen_unwrap_C_pointer(arg1),
+ Xen_to_C_Atom(arg2),
gxm_TransferValueProc,
- (XtPointer)XEN_LIST_2(arg3, arg4),
- XEN_TO_C_Time(arg5));
+ (XtPointer)Xen_list_2(arg3, arg4),
+ Xen_to_C_Time(arg5));
return(arg1);
}
-static XEN gxm_new_widget(const char *caller, Widget (*func)(Widget parent, char *name, ArgList al, Cardinal ac), XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_new_widget(const char *caller, Widget (*func)(Widget parent, char *name, ArgList al, Cardinal ac), Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, caller, "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, caller, "char*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, caller, "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg4), arg4, 4, caller, "int");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, caller, "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, caller, "char*");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, caller, "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg4), arg4, 4, caller, "int");
{
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg3);
- w = (*func)(XEN_TO_C_Widget(arg1),
- (char *)XEN_TO_C_STRING(arg2),
+ args = Xen_to_C_Args(arg3);
+ w = (*func)(Xen_to_C_Widget(arg1),
+ (char *)Xen_string_to_C_string(arg2),
args,
- arglen = XEN_TO_C_INT_DEF(arg4, arg3));
+ arglen = Xen_to_C_INT_DEF(arg4, arg3));
if (args)
{
fixup_args(w, args, arglen);
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmCreateMenuShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateMenuShell(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateMenuShell "Widget XmCreateMenuShell(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MenuShell widget creation function"
return(gxm_new_widget("XmCreateMenuShell", XmCreateMenuShell, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmProcessTraversal(XEN arg1, XEN arg2)
+static Xen gxm_XmProcessTraversal(Xen arg1, Xen arg2)
{
#define H_XmProcessTraversal "Boolean XmProcessTraversal(Widget widget, XmTraversalDirection direction) determines which \
component receives keyboard events when a widget has the focus"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmProcessTraversal", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmProcessTraversal", "XmTraversalDirection");
- return(C_TO_XEN_BOOLEAN(XmProcessTraversal(XEN_TO_C_Widget(arg1), (XmTraversalDirection)XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmProcessTraversal", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmProcessTraversal", "XmTraversalDirection");
+ return(C_bool_to_Xen_boolean(XmProcessTraversal(Xen_to_C_Widget(arg1), (XmTraversalDirection)Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XmGetFocusWidget(XEN arg1)
+static Xen gxm_XmGetFocusWidget(Xen arg1)
{
#define H_XmGetFocusWidget "Widget XmGetFocusWidget(Widget widget): returns the ID of the widget that has keyboard focus"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmGetFocusWidget", "Widget");
- return(C_TO_XEN_Widget(XmGetFocusWidget(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmGetFocusWidget", "Widget");
+ return(C_to_Xen_Widget(XmGetFocusWidget(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmGetTabGroup(XEN arg1)
+static Xen gxm_XmGetTabGroup(Xen arg1)
{
#define H_XmGetTabGroup "Widget XmGetTabGroup(Widget widget): returns the widget ID of a tab group"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmGetTabGroup", "Widget");
- return(C_TO_XEN_Widget(XmGetTabGroup(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmGetTabGroup", "Widget");
+ return(C_to_Xen_Widget(XmGetTabGroup(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmGetVisibility(XEN arg1)
+static Xen gxm_XmGetVisibility(Xen arg1)
{
#define H_XmGetVisibility "XmVisibility XmGetVisibility(Widget widget) determines if a widget is visible"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmGetVisibility", "Widget");
- return(C_TO_XEN_INT(XmGetVisibility(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmGetVisibility", "Widget");
+ return(C_int_to_Xen_integer(XmGetVisibility(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmIsTraversable(XEN arg1)
+static Xen gxm_XmIsTraversable(Xen arg1)
{
#define H_XmIsTraversable "Boolean XmIsTraversable(Widget widget) identifies whether a widget can be traversed"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmIsTraversable", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsTraversable(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmIsTraversable", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsTraversable(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmGetDestination(XEN arg1)
+static Xen gxm_XmGetDestination(Xen arg1)
{
#define H_XmGetDestination "Widget XmGetDestination(Display *display) gets the current destination widget for paste etc"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmGetDestination", "Display*");
- return(C_TO_XEN_Widget(XmGetDestination(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmGetDestination", "Display*");
+ return(C_to_Xen_Widget(XmGetDestination(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XmRenderTableAddRenditions(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmRenderTableAddRenditions(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmRenderTableAddRenditions "XmRenderTable XmRenderTableAddRenditions(XmRenderTable oldtable, \
XmRendition *renditions, Cardinal rendition_count, XmMergeMode merge_mode) adds renditions to a render table"
@@ -2706,22 +2631,23 @@ XmRendition *renditions, Cardinal rendition_count, XmMergeMode merge_mode) adds
int len, listlen = 0;
XmRendition *rs;
XmRenderTable res;
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(arg1) || XEN_FALSE_P(arg1), arg1, 1, "XmRenderTableAddRenditions", "XmRenderTable");
- XEN_ASSERT_TYPE(XEN_LIST_P_WITH_LENGTH(arg2, listlen), arg2, 2, "XmRenderTableAddRenditions", "list of XmRendition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmRenderTableAddRenditions", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmRenderTableAddRenditions", "XmMergeMode");
- len = XEN_TO_C_INT(arg3);
+ Xen_check_type(Xen_is_XmRenderTable(arg1) || Xen_is_false(arg1), arg1, 1, "XmRenderTableAddRenditions", "XmRenderTable");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmRenderTableAddRenditions", "list of XmRendition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmRenderTableAddRenditions", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmRenderTableAddRenditions", "XmMergeMode");
+ listlen = Xen_list_length(arg2);
+ len = Xen_integer_to_C_int(arg3);
if (len > listlen) len = listlen;
- if (len <= 0) return(XEN_FALSE);
- rs = XEN_TO_C_XmRenditions(arg2, len);
- res = XmRenderTableAddRenditions(XEN_FALSE_P(arg1) ? NULL : XEN_TO_C_XmRenderTable(arg1),
+ if (len <= 0) return(Xen_false);
+ rs = Xen_to_C_XmRenditions(arg2, len);
+ res = XmRenderTableAddRenditions(Xen_is_false(arg1) ? NULL : Xen_to_C_XmRenderTable(arg1),
rs, (Cardinal)len,
- (XmMergeMode)XEN_TO_C_INT(arg4));
+ (XmMergeMode)Xen_integer_to_C_int(arg4));
free(rs);
- return(C_TO_XEN_XmRenderTable(res));
+ return(C_to_Xen_XmRenderTable(res));
}
-static XEN gxm_XmRenderTableRemoveRenditions(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmRenderTableRemoveRenditions(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmRenderTableRemoveRenditions "XmRenderTable XmRenderTableRemoveRenditions(XmRenderTable oldtable, XmStringTag *tags, int tag_count) \
removes renditions"
@@ -2730,27 +2656,27 @@ removes renditions"
int len = 0;
XmStringTag *tags = NULL;
XmRenderTable rt = NULL;
- if (XEN_NOT_BOUND_P(arg1) || XEN_FALSE_P(arg1)) return(XEN_FALSE);
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(arg1) || XEN_FALSE_P(arg1), arg1, 1, "XmRenderTableRemoveRenditions", "XmRenderTable");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2) || XEN_FALSE_P(arg2) || XEN_NOT_BOUND_P(arg2), arg2, 2, "XmRenderTableRemoveRenditions", "XmStringTag*");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmRenderTableRemoveRenditions", "int");
- if (XEN_INTEGER_P(arg3))
+ if (!Xen_is_bound(arg1) || Xen_is_false(arg1)) return(Xen_false);
+ Xen_check_type(Xen_is_XmRenderTable(arg1) || Xen_is_false(arg1), arg1, 1, "XmRenderTableRemoveRenditions", "XmRenderTable");
+ Xen_check_type(Xen_is_list(arg2) || Xen_is_false(arg2) || !Xen_is_bound(arg2), arg2, 2, "XmRenderTableRemoveRenditions", "XmStringTag*");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmRenderTableRemoveRenditions", "int");
+ if (Xen_is_integer(arg3))
{
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
}
else
{
- if (XEN_LIST_P(arg2))
- len = XEN_LIST_LENGTH(arg2);
+ if (Xen_is_list(arg2))
+ len = Xen_list_length(arg2);
}
- if (XEN_BOUND_P(arg2)) tags = (XmStringTag *)XEN_TO_C_Strings(arg2, len);
- rt = XmRenderTableRemoveRenditions(XEN_TO_C_XmRenderTable(arg1), tags, len);
+ if (Xen_is_bound(arg2)) tags = (XmStringTag *)Xen_to_C_Strings(arg2, len);
+ rt = XmRenderTableRemoveRenditions(Xen_to_C_XmRenderTable(arg1), tags, len);
if (tags) free(tags);
- return(C_TO_XEN_XmRenderTable(rt));
+ return(C_to_Xen_XmRenderTable(rt));
}
-static XEN gxm_XmRenderTableCopy(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmRenderTableCopy(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmRenderTableCopy "XmRenderTable XmRenderTableCopy(XmRenderTable table, XmStringTag *tags, int tag_count) copies renditions"
/* DIFF: XmRenderTableCopy arg2 is list of strings
@@ -2758,51 +2684,51 @@ static XEN gxm_XmRenderTableCopy(XEN arg1, XEN arg2, XEN arg3)
int len = 0;
XmStringTag *tags = NULL;
XmRenderTable rt = NULL;
- if (XEN_NOT_BOUND_P(arg1) || XEN_FALSE_P(arg1)) return(XEN_FALSE);
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(arg1), arg1, 1, "XmRenderTableCopy", "XmRenderTable");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2) || XEN_FALSE_P(arg2) || XEN_NOT_BOUND_P(arg2), arg2, 2, "XmRenderTableCopy", "XmStringTag*");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmRenderTableCopy", "int");
- if (XEN_INTEGER_P(arg3))
+ if (!Xen_is_bound(arg1) || Xen_is_false(arg1)) return(Xen_false);
+ Xen_check_type(Xen_is_XmRenderTable(arg1), arg1, 1, "XmRenderTableCopy", "XmRenderTable");
+ Xen_check_type(Xen_is_list(arg2) || Xen_is_false(arg2) || !Xen_is_bound(arg2), arg2, 2, "XmRenderTableCopy", "XmStringTag*");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmRenderTableCopy", "int");
+ if (Xen_is_integer(arg3))
{
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
}
else
{
- if (XEN_LIST_P(arg2))
- len = XEN_LIST_LENGTH(arg2);
+ if (Xen_is_list(arg2))
+ len = Xen_list_length(arg2);
}
- if (XEN_BOUND_P(arg2)) tags = (XmStringTag *)XEN_TO_C_Strings(arg2, len);
- rt = XmRenderTableCopy(XEN_TO_C_XmRenderTable(arg1), tags, len);
+ if (Xen_is_bound(arg2)) tags = (XmStringTag *)Xen_to_C_Strings(arg2, len);
+ rt = XmRenderTableCopy(Xen_to_C_XmRenderTable(arg1), tags, len);
if (tags) free(tags);
- return(C_TO_XEN_XmRenderTable(rt));
+ return(C_to_Xen_XmRenderTable(rt));
}
-static XEN gxm_XmRenderTableFree(XEN arg1)
+static Xen gxm_XmRenderTableFree(Xen arg1)
{
#define H_XmRenderTableFree "void XmRenderTableFree(XmRenderTable table) recovers memory"
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(arg1), arg1, 1, "XmRenderTableFree", "XmRenderTable");
- XmRenderTableFree(XEN_TO_C_XmRenderTable(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XmRenderTable(arg1), arg1, 1, "XmRenderTableFree", "XmRenderTable");
+ XmRenderTableFree(Xen_to_C_XmRenderTable(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmRenderTableGetTags(XEN arg1)
+static Xen gxm_XmRenderTableGetTags(Xen arg1)
{
#define H_XmRenderTableGetTags "int XmRenderTableGetTags(XmRenderTable table) gets rendition tags (list of strings)"
/* DIFF: XmRenderTableGetTags omits arg2, returns list of strings
*/
int len, loc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
XmStringTag *str;
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(arg1), arg1, 1, "XmRenderTableGetTags", "XmRenderTable");
+ Xen_check_type(Xen_is_XmRenderTable(arg1), arg1, 1, "XmRenderTableGetTags", "XmRenderTable");
loc = xm_protect(lst);
- len = XmRenderTableGetTags(XEN_TO_C_XmRenderTable(arg1), &str);
+ len = XmRenderTableGetTags(Xen_to_C_XmRenderTable(arg1), &str);
if (str)
{
int i;
for (i = len - 1; i >= 0; i--)
{
- lst = XEN_CONS(C_TO_XEN_STRING(str[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(str[i]), lst);
free(str[i]);
}
free(str);
@@ -2811,104 +2737,104 @@ static XEN gxm_XmRenderTableGetTags(XEN arg1)
return(lst);
}
-static XEN gxm_XmRenderTableGetRendition(XEN arg1, XEN arg2)
+static Xen gxm_XmRenderTableGetRendition(Xen arg1, Xen arg2)
{
#define H_XmRenderTableGetRendition "XmRendition XmRenderTableGetRendition(XmRenderTable table, XmStringTag tag) \
matches a rendition tag"
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(arg1), arg1, 1, "XmRenderTableGetRendition", "XmRenderTable");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmRenderTableGetRendition", "XmStringTag");
- return(C_TO_XEN_XmRendition(XmRenderTableGetRendition(XEN_TO_C_XmRenderTable(arg1), (char *)XEN_TO_C_STRING(arg2))));
+ Xen_check_type(Xen_is_XmRenderTable(arg1), arg1, 1, "XmRenderTableGetRendition", "XmRenderTable");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmRenderTableGetRendition", "XmStringTag");
+ return(C_to_Xen_XmRendition(XmRenderTableGetRendition(Xen_to_C_XmRenderTable(arg1), (char *)Xen_string_to_C_string(arg2))));
}
-static XEN gxm_XmRenderTableGetRenditions(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmRenderTableGetRenditions(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmRenderTableGetRenditions "XmRendition *XmRenderTableGetRenditions(XmRenderTable table, XmStringTag *tags, Cardinal tag_count) \
matches rendition tags"
/* DIFF: XmRenderTableGetRenditions returns list of XmRenditions, arg2 is list of strings
*/
int i, len = 0, loc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
XmRendition *rs;
XmStringTag *tags;
- if ((XEN_NOT_BOUND_P(arg1)) || XEN_NOT_BOUND_P(arg2) || XEN_FALSE_P(arg2)) return(XEN_FALSE);
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(arg1), arg1, 1, "XmRenderTableGetRenditions", "XmRenderTable");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmRenderTableGetRenditions", "list of String");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmRenderTableGetRenditions", "int");
- if (XEN_BOUND_P(arg3))
- len = XEN_TO_C_INT(arg3);
- else len = XEN_LIST_LENGTH(arg2);
- if (len <= 0) return(XEN_FALSE);
+ if ((!Xen_is_bound(arg1)) || !Xen_is_bound(arg2) || Xen_is_false(arg2)) return(Xen_false);
+ Xen_check_type(Xen_is_XmRenderTable(arg1), arg1, 1, "XmRenderTableGetRenditions", "XmRenderTable");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmRenderTableGetRenditions", "list of String");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmRenderTableGetRenditions", "int");
+ if (Xen_is_bound(arg3))
+ len = Xen_integer_to_C_int(arg3);
+ else len = Xen_list_length(arg2);
+ if (len <= 0) return(Xen_false);
loc = xm_protect(lst);
- tags = (XmStringTag *)XEN_TO_C_Strings(arg2, len);
- rs = XmRenderTableGetRenditions(XEN_TO_C_XmRenderTable(arg1), tags, (Cardinal)len);
+ tags = (XmStringTag *)Xen_to_C_Strings(arg2, len);
+ rs = XmRenderTableGetRenditions(Xen_to_C_XmRenderTable(arg1), tags, (Cardinal)len);
free(tags);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_XmRendition(rs[i]), lst);
+ lst = Xen_cons(C_to_Xen_XmRendition(rs[i]), lst);
free(rs);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XmRenditionCreate(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmRenditionCreate(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmRenditionCreate "XmRendition XmRenditionCreate(Widget widget, XmStringTag tag, ArgList arglist, Cardinal argcount) \
creates a rendition"
XmRendition w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmRenditionCreate", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmRenditionCreate", "XmStringTag");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XmRenditionCreate", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg4), arg4, 4, "XmRenditionCreate", "int");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmRenditionCreate", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmRenditionCreate", "XmStringTag");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XmRenditionCreate", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg4), arg4, 4, "XmRenditionCreate", "int");
{
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg3);
- arglen = XEN_TO_C_INT_DEF(arg4, arg3);
- w = XmRenditionCreate(XEN_TO_C_Widget(arg1), (char *)XEN_TO_C_STRING(arg2), args, arglen);
+ args = Xen_to_C_Args(arg3);
+ arglen = Xen_to_C_INT_DEF(arg4, arg3);
+ w = XmRenditionCreate(Xen_to_C_Widget(arg1), (char *)Xen_string_to_C_string(arg2), args, arglen);
if (args) free_args(args, arglen);
}
- return(C_TO_XEN_XmRendition(w));
+ return(C_to_Xen_XmRendition(w));
}
-static XEN gxm_XmRenditionFree(XEN arg1)
+static Xen gxm_XmRenditionFree(Xen arg1)
{
#define H_XmRenditionFree "void XmRenditionFree(XmRendition rendition) frees a rendition"
- XEN_ASSERT_TYPE(XEN_XmRendition_P(arg1), arg1, 1, "XmRenditionFree", "XmRendition");
- XmRenditionFree(XEN_TO_C_XmRendition(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XmRendition(arg1), arg1, 1, "XmRenditionFree", "XmRendition");
+ XmRenditionFree(Xen_to_C_XmRendition(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmRenditionRetrieve(XEN arg1, XEN larg2, XEN arg3)
+static Xen gxm_XmRenditionRetrieve(Xen arg1, Xen larg2, Xen arg3)
{
#define H_XmRenditionRetrieve "void XmRenditionRetrieve(XmRendition rendition, ArgList arglist, Cardinal argcount) \
retrieves rendition resources"
- XEN_ASSERT_TYPE(XEN_XmRendition_P(arg1), arg1, 1, "XmRenditionRetrieve", "XmRendition");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg2), larg2, 2, "XmRenditionRetrieve", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmRenditionRetrieve", "int");
+ Xen_check_type(Xen_is_XmRendition(arg1), arg1, 1, "XmRenditionRetrieve", "XmRendition");
+ Xen_check_type(Xen_is_list(larg2), larg2, 2, "XmRenditionRetrieve", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmRenditionRetrieve", "int");
{
/* this is a kind of XtGetvalues, not set
*/
Arg *args;
unsigned long *locs;
- XEN val;
+ Xen val;
int i, len, gcloc;
XmRendition r;
- char *name;
- XEN arg2;
- arg2 = XEN_COPY_ARG(larg2);
+ Xen arg2;
+ arg2 = Xen_copy_arg(larg2);
gcloc = xm_protect(arg2);
/* here we need to make sure the ref args are ok from C's point of view */
- r = XEN_TO_C_XmRendition(arg1);
- len = XEN_TO_C_INT_DEF(arg3, arg2);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg3, 3, "XmRenditionRetrieve", "positive integer");
+ r = Xen_to_C_XmRendition(arg1);
+ len = Xen_to_C_INT_DEF(arg3, arg2);
+ if (len <= 0) Xen_check_type(0, arg3, 3, "XmRenditionRetrieve", "positive integer");
args = (Arg *)calloc(len, sizeof(Arg));
locs = (unsigned long *)calloc(len, sizeof(unsigned long));
- for (i = 0; i < len; i++, arg2 = XEN_CDDR(arg2))
+ for (i = 0; i < len; i++, arg2 = Xen_cddr(arg2))
{
- name = xen_strdup(XEN_TO_C_STRING(XEN_CAR(arg2)));
+ char *name;
+ name = xen_strdup(Xen_string_to_C_string(Xen_car(arg2)));
XtSetArg(args[i], name, &(locs[i]));
}
XmRenditionRetrieve(r, args, len);
- val = C_TO_XEN_Args((Widget)r, args, len);
+ val = C_to_Xen_Args((Widget)r, args, len);
free_args(args, len);
free(locs);
xm_unprotect_at(gcloc);
@@ -2916,25 +2842,25 @@ retrieves rendition resources"
}
}
-static XEN gxm_XmRenditionUpdate(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmRenditionUpdate(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmRenditionUpdate "void XmRenditionUpdate(XmRendition rendition, ArgList arglist, Cardinal argcount) \
modifies resources"
- XEN_ASSERT_TYPE(XEN_XmRendition_P(arg1), arg1, 1, "XmRenditionUpdate", "XmRendition");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmRenditionUpdate", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmRenditionUpdate", "int");
+ Xen_check_type(Xen_is_XmRendition(arg1), arg1, 1, "XmRenditionUpdate", "XmRendition");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmRenditionUpdate", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmRenditionUpdate", "int");
{
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg2);
- arglen = XEN_TO_C_INT_DEF(arg3, arg2);
- XmRenditionUpdate(XEN_TO_C_XmRendition(arg1), args, arglen);
+ args = Xen_to_C_Args(arg2);
+ arglen = Xen_to_C_INT_DEF(arg3, arg2);
+ XmRenditionUpdate(Xen_to_C_XmRendition(arg1), args, arglen);
if (args) free_args(args, arglen);
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmRenderTableCvtToProp(XEN arg1, XEN arg2)
+static Xen gxm_XmRenderTableCvtToProp(Xen arg1, Xen arg2)
{
#define H_XmRenderTableCvtToProp "unsigned int XmRenderTableCvtToProp(Widget widget, XmRenderTable table) \
converts a render table to a string representation -> (val props)"
@@ -2942,30 +2868,30 @@ converts a render table to a string representation -> (val props)"
*/
char *buf;
unsigned int val;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmRenderTableCvtToProp", "Widget");
- XEN_ASSERT_TYPE(XEN_XmRenderTable_P(arg2), arg2, 2, "XmRenderTableCvtToProp", "XmRenderTable");
- val = XmRenderTableCvtToProp(XEN_TO_C_Widget(arg1), XEN_TO_C_XmRenderTable(arg2), &buf);
- return(XEN_LIST_2(C_TO_XEN_ULONG(val),
- C_TO_XEN_STRING(buf)));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmRenderTableCvtToProp", "Widget");
+ Xen_check_type(Xen_is_XmRenderTable(arg2), arg2, 2, "XmRenderTableCvtToProp", "XmRenderTable");
+ val = XmRenderTableCvtToProp(Xen_to_C_Widget(arg1), Xen_to_C_XmRenderTable(arg2), &buf);
+ return(Xen_list_2(C_ulong_to_Xen_ulong(val),
+ C_string_to_Xen_string(buf)));
}
-static XEN gxm_XmRenderTableCvtFromProp(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmRenderTableCvtFromProp(Xen arg1, Xen arg2, Xen arg3)
{
char *str;
int len;
#define H_XmRenderTableCvtFromProp "XmRenderTable XmRenderTableCvtFromProp(Widget widget, char *property, unsigned int length) \
converts from a string representation to a render table"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmRenderTableCvtFromProp", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmRenderTableCvtFromProp", "char*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XmRenderTableCvtFromProp", "unsigned int");
- str = (char *)XEN_TO_C_STRING(arg2);
- len = XEN_TO_C_ULONG(arg3);
- if ((str) || ((int)strlen(str) == len))
- return(C_TO_XEN_XmRenderTable(XmRenderTableCvtFromProp(XEN_TO_C_Widget(arg1), str, len)));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmRenderTableCvtFromProp", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmRenderTableCvtFromProp", "char*");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XmRenderTableCvtFromProp", "unsigned int");
+ str = (char *)Xen_string_to_C_string(arg2);
+ len = Xen_ulong_to_C_ulong(arg3);
+ if ((str) && ((int)strlen(str) == len))
+ return(C_to_Xen_XmRenderTable(XmRenderTableCvtFromProp(Xen_to_C_Widget(arg1), str, len)));
+ return(Xen_false);
}
-static XEN gxm_XmTabListInsertTabs(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTabListInsertTabs(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTabListInsertTabs "XmTabList XmTabListInsertTabs(XmTabList oldlist, XmTab *tabs, Cardinal tab_count, int position) \
inserts tabs into a tab list"
@@ -2974,48 +2900,49 @@ inserts tabs into a tab list"
int len, listlen = 0;
XmTab *tabs;
XmTabList tl;
- XEN_ASSERT_TYPE(XEN_XmTabList_P(arg1) || XEN_FALSE_P(arg1), arg1, 1, "XmTabListInsertTabs", "XmTabList");
- XEN_ASSERT_TYPE(XEN_LIST_P_WITH_LENGTH(arg2, listlen), arg2, 2, "XmTabListInsertTabs", "list of XmTab");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTabListInsertTabs", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmTabListInsertTabs", "int");
- len = XEN_TO_C_INT(arg3);
+ Xen_check_type(Xen_is_XmTabList(arg1) || Xen_is_false(arg1), arg1, 1, "XmTabListInsertTabs", "XmTabList");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmTabListInsertTabs", "list of XmTab");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTabListInsertTabs", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmTabListInsertTabs", "int");
+ listlen = Xen_list_length(arg2);
+ len = Xen_integer_to_C_int(arg3);
if (len > listlen) len = listlen;
- if (len <= 0) return(XEN_FALSE);
- tabs = XEN_TO_C_XmTabs(arg2, len);
- tl = XmTabListInsertTabs(XEN_FALSE_P(arg1) ? NULL : XEN_TO_C_XmTabList(arg1),
- tabs, len, XEN_TO_C_INT(arg4));
+ if (len <= 0) return(Xen_false);
+ tabs = Xen_to_C_XmTabs(arg2, len);
+ tl = XmTabListInsertTabs(Xen_is_false(arg1) ? NULL : Xen_to_C_XmTabList(arg1),
+ tabs, len, Xen_integer_to_C_int(arg4));
free(tabs);
- return(C_TO_XEN_XmTabList(tl));
+ return(C_to_Xen_XmTabList(tl));
}
-static XEN gxm_XmTabListCopy(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTabListCopy(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmTabListCopy "XmTabList XmTabListCopy(XmTabList tablist, int offset, Cardinal count) creates \
a new tab list from an existing list"
/* Motif documentation incorrectly calls this "XmTabListTabCopy" */
- XEN_ASSERT_TYPE(XEN_XmTabList_P(arg1), arg1, 1, "XmTabListCopy", "XmTabList");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTabListCopy", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTabListCopy", "int");
- return(C_TO_XEN_XmTabList(XmTabListCopy(XEN_TO_C_XmTabList(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_XmTabList(arg1), arg1, 1, "XmTabListCopy", "XmTabList");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTabListCopy", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTabListCopy", "int");
+ return(C_to_Xen_XmTabList(XmTabListCopy(Xen_to_C_XmTabList(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XmTabListTabCount(XEN arg1)
+static Xen gxm_XmTabListTabCount(Xen arg1)
{
#define H_XmTabListTabCount "Cardinal XmTabListTabCount(XmTabList tablist): returns length of tablist"
- XEN_ASSERT_TYPE(XEN_XmTabList_P(arg1), arg1, 1, "XmTabListTabCount", "XmTabList");
- return(C_TO_XEN_INT(XmTabListTabCount(XEN_TO_C_XmTabList(arg1))));
+ Xen_check_type(Xen_is_XmTabList(arg1), arg1, 1, "XmTabListTabCount", "XmTabList");
+ return(C_int_to_Xen_integer(XmTabListTabCount(Xen_to_C_XmTabList(arg1))));
}
-static XEN gxm_XmTabListGetTab(XEN arg1, XEN arg2)
+static Xen gxm_XmTabListGetTab(Xen arg1, Xen arg2)
{
#define H_XmTabListGetTab "XmTab XmTabListGetTab(XmTabList tablist, Cardinal position): returns a copy of a tab"
- XEN_ASSERT_TYPE(XEN_XmTabList_P(arg1), arg1, 1, "XmTabListGetTab", "XmTabList");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTabListGetTab", "int");
- return(C_TO_XEN_XmTab(XmTabListGetTab(XEN_TO_C_XmTabList(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_XmTabList(arg1), arg1, 1, "XmTabListGetTab", "XmTabList");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTabListGetTab", "int");
+ return(C_to_Xen_XmTab(XmTabListGetTab(Xen_to_C_XmTabList(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XmTabListReplacePositions(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTabListReplacePositions(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTabListReplacePositions "XmTabList XmTabListReplacePositions(XmTabList oldlist, Cardinal *position_list, XmTab *tabs, Cardinal tab_count) \
creates a new tab list with replacement tabs"
@@ -3023,23 +2950,23 @@ creates a new tab list with replacement tabs"
*/
Cardinal *ts;
int len;
- XEN res;
+ Xen res;
XmTab *tabs;
- XEN_ASSERT_TYPE(XEN_XmTabList_P(arg1), arg1, 1, "XmTabListReplacePositions", "XmTabList");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmTabListReplacePositions", "list of ints");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XmTabListReplacePositions", "list of XmTab");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg4), arg4, 4, "XmTabListReplacePositions", "int");
- if (XEN_INTEGER_P(arg4)) len = XEN_TO_C_INT(arg4); else len = XEN_LIST_LENGTH(arg3);
- if (len <= 0) return(XEN_FALSE);
- ts = XEN_TO_C_Cardinals(arg2, len);
- tabs = XEN_TO_C_XmTabs(arg3, len);
- res = C_TO_XEN_XmTabList(XmTabListReplacePositions(XEN_TO_C_XmTabList(arg1), ts, tabs, len));
+ Xen_check_type(Xen_is_XmTabList(arg1), arg1, 1, "XmTabListReplacePositions", "XmTabList");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmTabListReplacePositions", "list of ints");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XmTabListReplacePositions", "list of XmTab");
+ Xen_check_type(Xen_is_integer_or_unbound(arg4), arg4, 4, "XmTabListReplacePositions", "int");
+ if (Xen_is_integer(arg4)) len = Xen_integer_to_C_int(arg4); else len = Xen_list_length(arg3);
+ if (len <= 0) return(Xen_false);
+ ts = Xen_to_C_Cardinals(arg2, len);
+ tabs = Xen_to_C_XmTabs(arg3, len);
+ res = C_to_Xen_XmTabList(XmTabListReplacePositions(Xen_to_C_XmTabList(arg1), ts, tabs, len));
free(ts);
free(tabs);
return(res);
}
-static XEN gxm_XmTabListRemoveTabs(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTabListRemoveTabs(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmTabListRemoveTabs "XmTabList XmTabListRemoveTabs(XmTabList oldlist, Cardinal *position_list, Cardinal position_count) \
removes noncontiguous tabs"
@@ -3047,51 +2974,51 @@ removes noncontiguous tabs"
*/
Cardinal *ts;
int len;
- XEN res;
- XEN_ASSERT_TYPE(XEN_XmTabList_P(arg1), arg1, 1, "XmTabListRemoveTabs", "XmTabList");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmTabListRemoveTabs", "list of int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmTabListRemoveTabs", "int");
- if (XEN_INTEGER_P(arg3)) len = XEN_TO_C_INT(arg3); else len = XEN_LIST_LENGTH(arg2);
- if (len <= 0) return(XEN_FALSE);
- ts = XEN_TO_C_Cardinals(arg2, len);
- res = C_TO_XEN_XmTabList(XmTabListRemoveTabs(XEN_TO_C_XmTabList(arg1), ts, len));
+ Xen res;
+ Xen_check_type(Xen_is_XmTabList(arg1), arg1, 1, "XmTabListRemoveTabs", "XmTabList");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmTabListRemoveTabs", "list of int");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmTabListRemoveTabs", "int");
+ if (Xen_is_integer(arg3)) len = Xen_integer_to_C_int(arg3); else len = Xen_list_length(arg2);
+ if (len <= 0) return(Xen_false);
+ ts = Xen_to_C_Cardinals(arg2, len);
+ res = C_to_Xen_XmTabList(XmTabListRemoveTabs(Xen_to_C_XmTabList(arg1), ts, len));
free(ts);
return(res);
}
-static XEN gxm_XmTabCreate(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmTabCreate(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmTabCreate "XmTab XmTabCreate(float value, unsigned char units, XmOffsetModel offset_model, unsigned char alignment, char *decimal) \
creates a tab stop"
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(arg1), arg1, 1, "XmTabCreate", "float");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTabCreate", "unsigned char");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTabCreate", "XmOffsetModel");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmTabCreate", "unsigned char");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg5), arg5, 5, "XmTabCreate", "char*");
- return(C_TO_XEN_XmTab(XmTabCreate((float)XEN_TO_C_DOUBLE(arg1),
- (unsigned char)(XEN_TO_C_INT(arg2)),
- (XmOffsetModel)XEN_TO_C_INT(arg3),
- (unsigned char)(XEN_TO_C_INT(arg4)),
- (char *)XEN_TO_C_STRING(arg5))));
+ Xen_check_type(Xen_is_double(arg1), arg1, 1, "XmTabCreate", "float");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTabCreate", "unsigned char");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTabCreate", "XmOffsetModel");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmTabCreate", "unsigned char");
+ Xen_check_type(Xen_is_string(arg5), arg5, 5, "XmTabCreate", "char*");
+ return(C_to_Xen_XmTab(XmTabCreate((float)Xen_real_to_C_double(arg1),
+ (unsigned char)(Xen_integer_to_C_int(arg2)),
+ (XmOffsetModel)Xen_integer_to_C_int(arg3),
+ (unsigned char)(Xen_integer_to_C_int(arg4)),
+ (char *)Xen_string_to_C_string(arg5))));
}
-static XEN gxm_XmTabListFree(XEN arg1)
+static Xen gxm_XmTabListFree(Xen arg1)
{
#define H_XmTabListFree "void XmTabListFree(XmTabList tab) frees a tab list"
- XEN_ASSERT_TYPE(XEN_XmTabList_P(arg1), arg1, 1, "XmTabListFree", "XmTabList");
- XmTabListFree(XEN_TO_C_XmTabList(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XmTabList(arg1), arg1, 1, "XmTabListFree", "XmTabList");
+ XmTabListFree(Xen_to_C_XmTabList(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmTabFree(XEN arg1)
+static Xen gxm_XmTabFree(Xen arg1)
{
#define H_XmTabFree "void XmTabFree(XmTab tab) frees a tab"
- XEN_ASSERT_TYPE(XEN_XmTab_P(arg1), arg1, 1, "XmTabFree", "XmTab");
- XmTabFree(XEN_TO_C_XmTab(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XmTab(arg1), arg1, 1, "XmTabFree", "XmTab");
+ XmTabFree(Xen_to_C_XmTab(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmTabGetValues(XEN arg1)
+static Xen gxm_XmTabGetValues(Xen arg1)
{
#define H_XmTabGetValues "float XmTabGetValues(XmTab tab): returns tab values"
/* DIFF: XmTabGetValues tab [units offset align decimal] -> (list val units ofset align decimal)
@@ -3101,54 +3028,54 @@ static XEN gxm_XmTabGetValues(XEN arg1)
unsigned char a1, a2;
char **a3;
float res;
- XEN val;
- XEN_ASSERT_TYPE(XEN_XmTab_P(arg1), arg1, 1, "XmTabGetValues", "XmTab");
+ Xen val;
+ Xen_check_type(Xen_is_XmTab(arg1), arg1, 1, "XmTabGetValues", "XmTab");
a3 = (char **)calloc(1, sizeof(char *));
- res = XmTabGetValues(XEN_TO_C_XmTab(arg1), &a1, &off, &a2, a3);
- val = XEN_LIST_5(C_TO_XEN_DOUBLE((double)res),
- C_TO_XEN_INT((int)a1),
- C_TO_XEN_INT((int)off),
- C_TO_XEN_INT((int)a2),
- C_TO_XEN_STRING(a3[0]));
+ res = XmTabGetValues(Xen_to_C_XmTab(arg1), &a1, &off, &a2, a3);
+ val = Xen_list_5(C_double_to_Xen_real((double)res),
+ C_int_to_Xen_integer((int)a1),
+ C_int_to_Xen_integer((int)off),
+ C_int_to_Xen_integer((int)a2),
+ C_string_to_Xen_string(a3[0]));
free(a3);
return(val);
}
-static XEN gxm_XmTabSetValue(XEN arg1, XEN arg2)
+static Xen gxm_XmTabSetValue(Xen arg1, Xen arg2)
{
#define H_XmTabSetValue "void XmTabSetValue(XmTab tab, float value) sets a tab stop"
- XEN_ASSERT_TYPE(XEN_XmTab_P(arg1), arg1, 1, "XmTabSetValue", "XmTab");
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(arg2), arg2, 2, "XmTabSetValue", "float");
- XmTabSetValue(XEN_TO_C_XmTab(arg1), (float)XEN_TO_C_DOUBLE(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XmTab(arg1), arg1, 1, "XmTabSetValue", "XmTab");
+ Xen_check_type(Xen_is_double(arg2), arg2, 2, "XmTabSetValue", "float");
+ XmTabSetValue(Xen_to_C_XmTab(arg1), (float)Xen_real_to_C_double(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmStringTableProposeTablist(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmStringTableProposeTablist(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmStringTableProposeTablist "XmTabList XmStringTableProposeTablist(XmStringTable strings, Cardinal num_strings, Widget widget, \
float pad_value, XmOffsetModel offset_model): returns a tab list"
- /* DIFF: XmStringTableProposetablist 1st arg is list of XmStrings
+ /* DIFF: XmStringTableProposetablist first arg is list of XmStrings
*/
XmStringTable tab;
XmTabList tabl;
- XEN_ASSERT_TYPE(XEN_LIST_P(arg1), arg1, 1, "XmStringTableProposeTablist", "XmStringTable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmStringTableProposeTablist", "int");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg3), arg3, 3, "XmStringTableProposeTablist", "Widget");
- XEN_ASSERT_TYPE(XEN_DOUBLE_P(arg4), arg4, 4, "XmStringTableProposeTablist", "float");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XmStringTableProposeTablist", "XmOffsetModel");
- tab = XEN_TO_C_XmStringTable(arg1, XEN_TO_C_INT(arg2));
+ Xen_check_type(Xen_is_list(arg1), arg1, 1, "XmStringTableProposeTablist", "XmStringTable");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmStringTableProposeTablist", "int");
+ Xen_check_type(Xen_is_Widget(arg3), arg3, 3, "XmStringTableProposeTablist", "Widget");
+ Xen_check_type(Xen_is_double(arg4), arg4, 4, "XmStringTableProposeTablist", "float");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XmStringTableProposeTablist", "XmOffsetModel");
+ tab = Xen_to_C_XmStringTable(arg1, Xen_integer_to_C_int(arg2));
tabl = XmStringTableProposeTablist(tab,
- XEN_TO_C_INT(arg2),
- XEN_TO_C_Widget(arg3),
- (float)XEN_TO_C_DOUBLE(arg4),
- (XmOffsetModel)XEN_TO_C_INT(arg5));
+ Xen_integer_to_C_int(arg2),
+ Xen_to_C_Widget(arg3),
+ (float)Xen_real_to_C_double(arg4),
+ (XmOffsetModel)Xen_integer_to_C_int(arg5));
free(tab);
- return(C_TO_XEN_XmTabList(tabl));
+ return(C_to_Xen_XmTabList(tabl));
}
-#define XEN_XmParseTable_P(Arg) XEN_LIST_P(Arg)
+#define Xen_is_XmParseTable(Arg) Xen_is_list(Arg)
-static XmParseTable XEN_TO_C_XmParseTable(XEN lst, int size)
+static XmParseTable Xen_to_C_XmParseTable(Xen lst, int size)
{
int i;
XmParseTable pt;
@@ -3156,58 +3083,58 @@ static XmParseTable XEN_TO_C_XmParseTable(XEN lst, int size)
pt = (XmParseTable)XtCalloc(size, sizeof(XmParseMapping));
for (i = 0; i < size; i++)
{
- XEN val;
- val = XEN_LIST_REF(lst, i);
- if (XEN_XmParseMapping_P(val))
- pt[i] = XEN_TO_C_XmParseMapping(val);
- else XEN_ASSERT_TYPE(0, val, i, c__FUNCTION__, "an XmParseMapping");
+ Xen val;
+ val = Xen_list_ref(lst, i);
+ if (Xen_is_XmParseMapping(val))
+ pt[i] = Xen_to_C_XmParseMapping(val);
+ else Xen_check_type(0, val, i, __func__, "an XmParseMapping");
}
return(pt);
}
-static XEN gxm_XmParseTableFree(XEN arg1, XEN arg2)
+static Xen gxm_XmParseTableFree(Xen arg1, Xen arg2)
{
#define H_XmParseTableFree "void XmParseTableFree(XmParseTable parse_table, Cardinal count) recovers memory"
- XEN_ASSERT_TYPE(XEN_XmParseTable_P(arg1), arg1, 1, "XmParseTableFree", "XmParseTable");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg2), arg2, 2, "XmParseTableFree", "int");
+ Xen_check_type(Xen_is_XmParseTable(arg1), arg1, 1, "XmParseTableFree", "XmParseTable");
+ Xen_check_type(Xen_is_integer_or_unbound(arg2), arg2, 2, "XmParseTableFree", "int");
/* can't happen -- a no-op */
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmParseMappingFree(XEN arg1)
+static Xen gxm_XmParseMappingFree(Xen arg1)
{
#define H_XmParseMappingFree "void XmParseMappingFree(XmParseMapping parse_mapping) frees a parse mapping"
- XEN_ASSERT_TYPE(XEN_XmParseMapping_P(arg1), arg1, 1, "XmParseMappingFree", "XmParseMapping");
- XmParseMappingFree(XEN_TO_C_XmParseMapping(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XmParseMapping(arg1), arg1, 1, "XmParseMappingFree", "XmParseMapping");
+ XmParseMappingFree(Xen_to_C_XmParseMapping(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmParseMappingGetValues(XEN arg1, XEN larg2, XEN arg3)
+static Xen gxm_XmParseMappingGetValues(Xen arg1, Xen larg2, Xen arg3)
{
#define H_XmParseMappingGetValues "void XmParseMappingGetValues(XmParseMapping parse_mapping, ArgList arglist, Cardinal argcount) \
retrieves attributes of a parse mapping"
- XEN_ASSERT_TYPE(XEN_XmParseMapping_P(arg1), arg1, 1, "XmParseMappingGetValues", "XmParseMapping");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg2), larg2, 2, "XmParseMappingGetValues", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmParseMappingGetValues", "int");
+ Xen_check_type(Xen_is_XmParseMapping(arg1), arg1, 1, "XmParseMappingGetValues", "XmParseMapping");
+ Xen_check_type(Xen_is_list(larg2), larg2, 2, "XmParseMappingGetValues", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmParseMappingGetValues", "int");
{
Arg *args;
unsigned long *locs;
int len, gcloc;
- XEN val, arg2;
+ Xen val, arg2;
int i;
- len = XEN_TO_C_INT_DEF(arg3, larg2);
- arg2 = XEN_COPY_ARG(larg2);
+ len = Xen_to_C_INT_DEF(arg3, larg2);
+ arg2 = Xen_copy_arg(larg2);
gcloc = xm_protect(arg2);
args = (Arg *)calloc(len, sizeof(Arg));
locs = (unsigned long *)calloc(len, sizeof(unsigned long));
- for (i = 0; i < len; i++, arg2 = XEN_CDDR(arg2))
+ for (i = 0; i < len; i++, arg2 = Xen_cddr(arg2))
{
char *name;
- name = xen_strdup(XEN_TO_C_STRING(XEN_CAR(arg2)));
+ name = xen_strdup(Xen_string_to_C_string(Xen_car(arg2)));
XtSetArg(args[i], name, &(locs[i]));
}
- XmParseMappingGetValues(XEN_TO_C_XmParseMapping(arg1), args, len);
- val = C_TO_XEN_Args(NULL, args, len);
+ XmParseMappingGetValues(Xen_to_C_XmParseMapping(arg1), args, len);
+ val = C_to_Xen_Args(NULL, args, len);
free_args(args, len);
free(locs);
xm_unprotect_at(gcloc);
@@ -3215,120 +3142,127 @@ retrieves attributes of a parse mapping"
}
}
-static XEN gxm_XmParseMappingSetValues(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmParseMappingSetValues(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmParseMappingSetValues "void XmParseMappingSetValues(XmParseMapping parse_mapping, ArgList arglist, Cardinal argcount) \
sets attributes of a parse mapping"
- XEN_ASSERT_TYPE(XEN_XmParseMapping_P(arg1), arg1, 1, "XmParseMappingSetValues", "XmParseMapping");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmParseMappingSetValues", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmParseMappingSetValues", "int");
+ Xen_check_type(Xen_is_XmParseMapping(arg1), arg1, 1, "XmParseMappingSetValues", "XmParseMapping");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmParseMappingSetValues", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmParseMappingSetValues", "int");
{
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg2);
- arglen = XEN_TO_C_INT_DEF(arg3, arg2);
- XmParseMappingSetValues(XEN_TO_C_XmParseMapping(arg1), args, arglen);
+ args = Xen_to_C_Args(arg2);
+ arglen = Xen_to_C_INT_DEF(arg3, arg2);
+ XmParseMappingSetValues(Xen_to_C_XmParseMapping(arg1), args, arglen);
if (args) free_args(args, arglen);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxm_XmParseMappingCreate(XEN arg1, XEN arg2)
+static Xen gxm_XmParseMappingCreate(Xen arg1, Xen arg2)
{
#define H_XmParseMappingCreate "XmParseMapping XmParseMappingCreate(ArgList arglist, Cardinal argcount) create a parse mapping"
XmParseMapping w;
- XEN_ASSERT_TYPE(XEN_LIST_P(arg1), arg1, 1, "XmParseMappingCreate", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg2), arg2, 2, "XmParseMappingCreate", "int");
+ Xen_check_type(Xen_is_list(arg1), arg1, 1, "XmParseMappingCreate", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg2), arg2, 2, "XmParseMappingCreate", "int");
{
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg1);
- arglen = XEN_TO_C_INT_DEF(arg2, arg1);
+ args = Xen_to_C_Args(arg1);
+ arglen = Xen_to_C_INT_DEF(arg2, arg1);
w = XmParseMappingCreate(args, arglen);
if (args) free_args(args, arglen);
}
- return(C_TO_XEN_XmParseMapping(w));
+ return(C_to_Xen_XmParseMapping(w));
}
-static XEN gxm_XmCvtXmStringToByteStream(XEN str)
+static Xen gxm_XmCvtXmStringToByteStream(Xen str)
{
#define H_XmCvtXmStringToByteStream "int XmCvtXmStringToByteStream(XmString str) converts an XmString into a byte stream."
unsigned char *prop = NULL;
int res = 0; /* #bytes in returned val */
XmString xstr;
- XEN_ASSERT_TYPE(XEN_XmString_P(str), str, XEN_ONLY_ARG, "XmCvtXmStringToByteStream", "XmString");
- xstr = XEN_TO_C_XmString(str);
+ Xen_check_type(Xen_is_XmString(str), str, 1, "XmCvtXmStringToByteStream", "XmString");
+ xstr = Xen_to_C_XmString(str);
if (!(XmStringEmpty(xstr)))
res = XmCvtXmStringToByteStream(xstr, &prop);
/* here there is apparently no trailing 0, so this function worries Valgrind */
- return(XEN_LIST_2(C_TO_XEN_INT(res), C_TO_XEN_STRING((const char *)prop)));
+ return(Xen_list_2(C_int_to_Xen_integer(res), C_string_to_Xen_string((const char *)prop)));
}
-static XEN gxm_XmCvtByteStreamToXmString(XEN str)
+static Xen gxm_XmCvtByteStreamToXmString(Xen str)
{
#define H_XmCvtByteStreamToXmString "XmString XmCvtByteStreamToXmString(char *str) converts a byte stream into an XmString."
XmString res = NULL;
const char *bstr;
- XEN_ASSERT_TYPE(XEN_STRING_P(str), str, XEN_ONLY_ARG, "XmCvtByteStreamToXmString", "char *");
- bstr = XEN_TO_C_STRING(str);
+ Xen_check_type(Xen_is_string(str), str, 1, "XmCvtByteStreamToXmString", "char *");
+ bstr = Xen_string_to_C_string(str);
if (bstr)
- res = XmCvtByteStreamToXmString((unsigned char *)(XEN_TO_C_STRING(str)));
- return(C_TO_XEN_XmString(res));
+ res = XmCvtByteStreamToXmString((unsigned char *)(Xen_string_to_C_string(str)));
+ return(C_to_Xen_XmString(res));
}
-static XEN gxm_XmStringByteStreamLength(XEN str)
+static Xen gxm_XmStringByteStreamLength(Xen str)
{
#define H_XmStringByteStreamLength "int XmStringByteStreamLength(char *str): returns the length of the byte stream."
- int res;
- XEN_ASSERT_TYPE(XEN_STRING_P(str), str, XEN_ONLY_ARG, "XmStringByteStreamLength", "char *");
- res = (int)XmStringByteStreamLength((unsigned char *)(XEN_TO_C_STRING(str)));
- return(C_TO_XEN_INT(res));
+ unsigned char *stream;
+
+ Xen_check_type(Xen_is_string(str), str, 1, "XmStringByteStreamLength", "char *");
+ stream = (unsigned char *)(Xen_string_to_C_string(str));
+ if (!stream)
+ Xen_out_of_range_error("XmStringByteStreamLength", 1, str, "a null stream?");
+ return(C_int_to_Xen_integer((int)XmStringByteStreamLength(stream)));
}
-static XEN gxm_XmStringPutRendition(XEN arg1, XEN arg2)
+static Xen gxm_XmStringPutRendition(Xen arg1, Xen arg2)
{
#define H_XmStringPutRendition "XmString XmStringPutRendition(XmString string, XmStringTag rendition) places \
renditions around strings"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringPutRendition", "XmString");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmStringPutRendition", "XmStringTag");
- return(C_TO_XEN_XmString(XmStringPutRendition(XEN_TO_C_XmString(arg1), (char *)XEN_TO_C_STRING(arg2))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringPutRendition", "XmString");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmStringPutRendition", "XmStringTag");
+ return(C_to_Xen_XmString(XmStringPutRendition(Xen_to_C_XmString(arg1), (char *)Xen_string_to_C_string(arg2))));
}
-static XEN gxm_XmStringGenerate(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmStringGenerate(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmStringGenerate "XmString XmStringGenerate(XtPointer text, XmStringTag tag, XmTextType type, XmStringTag rendition) \
generates a compound string"
XmTextType type;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XmStringGenerate", "XtPointer");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2) || XEN_FALSE_P(arg2), arg2, 2, "XmStringGenerate", "XmStringTag");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmStringGenerate", "XmTextType");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XmStringGenerate", "XmStringTag");
- type = (XmTextType)XEN_TO_C_INT(arg3);
- if (type > 1) XEN_ASSERT_TYPE(0, arg3, 3, "XmStringGenerate", "XmTextType");
- return(C_TO_XEN_XmString(XmStringGenerate((XtPointer)XEN_TO_C_STRING(arg1),
- XEN_FALSE_P(arg2) ? NULL : (char *)XEN_TO_C_STRING(arg2),
+ XmStringTag rendition;
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XmStringGenerate", "XtPointer");
+ Xen_check_type(Xen_is_string(arg2) || Xen_is_false(arg2), arg2, 2, "XmStringGenerate", "XmStringTag");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmStringGenerate", "XmTextType");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XmStringGenerate", "XmStringTag");
+ type = (XmTextType)Xen_integer_to_C_int(arg3);
+ if (type > 1) Xen_check_type(0, arg3, 3, "XmStringGenerate", "XmTextType");
+ rendition = (XmStringTag)Xen_string_to_C_string(arg4);
+ if (!rendition)
+ Xen_out_of_range_error("XmStringGenerate", 4, arg4, "a null rendition?");
+ return(C_to_Xen_XmString(XmStringGenerate((XtPointer)Xen_string_to_C_string(arg1),
+ Xen_is_false(arg2) ? NULL : (char *)Xen_string_to_C_string(arg2),
type,
- (char *)XEN_TO_C_STRING(arg4))));
+ rendition)));
}
-static XEN gxm_XmStringDirectionToDirection(XEN arg1)
+static Xen gxm_XmStringDirectionToDirection(Xen arg1)
{
#define H_XmStringDirectionToDirection "XmDirection XmStringDirectionToDirection(XmStringDirection direction) converts \
from XmStringDirection to XmDirection"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 1, "XmStringDirectionToDirection", "XmStringDirection");
- return(C_TO_XEN_INT(XmStringDirectionToDirection(XEN_TO_C_INT(arg1))));
+ Xen_check_type(Xen_is_integer(arg1), arg1, 1, "XmStringDirectionToDirection", "XmStringDirection");
+ return(C_int_to_Xen_integer(XmStringDirectionToDirection(Xen_integer_to_C_int(arg1))));
}
-static XEN gxm_XmDirectionToStringDirection(XEN arg1)
+static Xen gxm_XmDirectionToStringDirection(Xen arg1)
{
#define H_XmDirectionToStringDirection "XmStringDirection XmDirectionToStringDirection (dir) converts an XmDirection \
value to an XmStringDirection value"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 1, "XmDirectionToStringDirection", "XmDirection");
- return(C_TO_XEN_INT(XmDirectionToStringDirection(XEN_TO_C_INT(arg1))));
+ Xen_check_type(Xen_is_integer(arg1), arg1, 1, "XmDirectionToStringDirection", "XmDirection");
+ return(C_int_to_Xen_integer(XmDirectionToStringDirection(Xen_integer_to_C_int(arg1))));
}
-static XEN gxm_XmStringTableParseStringArray(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XmStringTableParseStringArray(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XmStringTableParseStringArray "XmStringTable XmStringTableParseStringArray(XtPointer *strings, Cardinal count, XmStringTag tag, \
XmTextType type, XmParseTable parse, Cardinal parse_count, XtPointer call_data) converts an array of strings \
@@ -3339,76 +3273,76 @@ to a compound string table"
int len;
XmStringTable val;
XmParseTable pt = NULL;
- XEN lst;
+ Xen lst;
XmTextType type;
- XEN_ASSERT_TYPE(XEN_LIST_P(arg1), arg1, 1, "XmStringTableParseStringArray", "list of strings");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmStringTableParseStringArray", "int");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg3) || XEN_STRING_P(arg3), arg3, 3, "XmStringTableParseStringArray", "XmStringTag");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmStringTableParseStringArray", "XmTextType");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg5) || XEN_XmParseTable_P(arg5), arg5, 5, "XmStringTableParseStringArray", "XmParseTable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XmStringTableParseStringArray", "int");
- type = (XmTextType)XEN_TO_C_INT(arg4);
- if (type > 1) XEN_ASSERT_TYPE(0, arg4, 4, "XmStringTableParseStringArray", "XmTextType");
- len = XEN_TO_C_INT(arg2);
- if (len <= 0) return(XEN_FALSE);
- strs = XEN_TO_C_Strings(arg1, len);
- if (XEN_XmParseTable_P(arg5)) pt = XEN_TO_C_XmParseTable(arg5, len);
+ Xen_check_type(Xen_is_list(arg1), arg1, 1, "XmStringTableParseStringArray", "list of strings");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmStringTableParseStringArray", "int");
+ Xen_check_type(Xen_is_false(arg3) || Xen_is_string(arg3), arg3, 3, "XmStringTableParseStringArray", "XmStringTag");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmStringTableParseStringArray", "XmTextType");
+ Xen_check_type(Xen_is_false(arg5) || Xen_is_XmParseTable(arg5), arg5, 5, "XmStringTableParseStringArray", "XmParseTable");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XmStringTableParseStringArray", "int");
+ type = (XmTextType)Xen_integer_to_C_int(arg4);
+ if (type > 1) Xen_check_type(0, arg4, 4, "XmStringTableParseStringArray", "XmTextType");
+ len = Xen_integer_to_C_int(arg2);
+ if (len <= 0) return(Xen_false);
+ strs = Xen_to_C_Strings(arg1, len);
+ if (Xen_is_XmParseTable(arg5)) pt = Xen_to_C_XmParseTable(arg5, len);
val = XmStringTableParseStringArray((XtPointer *)strs,
(Cardinal)len,
- (XEN_FALSE_P(arg3)) ? NULL : (char *)XEN_TO_C_STRING(arg3),
+ (Xen_is_false(arg3)) ? NULL : (char *)Xen_string_to_C_string(arg3),
type,
pt,
- XEN_TO_C_INT(arg6),
+ Xen_integer_to_C_int(arg6),
(XtPointer)arg7);
free(strs);
- lst = C_TO_XEN_XmStringTable(val, len);
+ lst = C_to_Xen_XmStringTable(val, len);
free(val);
if (pt) free(pt);
return(lst);
}
-static XEN gxm_XmStringTableUnparse(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+static Xen gxm_XmStringTableUnparse(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
#define H_XmStringTableUnparse "XtPointer *XmStringTableUnparse(XmStringTable table, Cardinal count, XmStringTag tag, XmTextType tag_type, \
XmTextType output_type, XmParseTable parse, Cardinal parse_count, XmParseModel parse_model) converts a table of \
compound strings to an array of text"
- /* DIFF: XmStringTableUnparse returns list of strings, 1st arg is list of XmStrings
+ /* DIFF: XmStringTableUnparse returns list of strings, first arg is list of XmStrings
*/
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
char **tab;
XmStringTable tb;
int i, len, loc;
XmTextType type1, type2;
XmParseTable pt = NULL;
- XEN_ASSERT_TYPE(XEN_LIST_P(arg1), arg1, 1, "XmStringTableUnparse", "XmStringTable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmStringTableUnparse", "int");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg3) || XEN_STRING_P(arg3), arg3, 3, "XmStringTableUnparse", "XmStringTag");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmStringTableUnparse", "XmTextType");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XmStringTableUnparse", "XmTextType");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg6) || XEN_XmParseTable_P(arg6), arg6, 6, "XmStringTableUnparse", "XmParseTable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XmStringTableUnparse", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XmStringTableUnparse", "XmParseModel");
- type1 = (XmTextType)XEN_TO_C_INT(arg4);
- if (type1 > 1) XEN_ASSERT_TYPE(0, arg4, 4, "XmStringTableUnparse", "XmTextType");
- type2 = (XmTextType)XEN_TO_C_INT(arg5);
- if (type2 > 1) XEN_ASSERT_TYPE(0, arg5, 5, "XmStringTableUnparse", "XmTextType");
- len = XEN_TO_C_INT(arg2);
- if (len <= 0) return(XEN_FALSE);
+ Xen_check_type(Xen_is_list(arg1), arg1, 1, "XmStringTableUnparse", "XmStringTable");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmStringTableUnparse", "int");
+ Xen_check_type(Xen_is_false(arg3) || Xen_is_string(arg3), arg3, 3, "XmStringTableUnparse", "XmStringTag");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmStringTableUnparse", "XmTextType");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XmStringTableUnparse", "XmTextType");
+ Xen_check_type(Xen_is_false(arg6) || Xen_is_XmParseTable(arg6), arg6, 6, "XmStringTableUnparse", "XmParseTable");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XmStringTableUnparse", "int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XmStringTableUnparse", "XmParseModel");
+ type1 = (XmTextType)Xen_integer_to_C_int(arg4);
+ if (type1 > 1) Xen_check_type(0, arg4, 4, "XmStringTableUnparse", "XmTextType");
+ type2 = (XmTextType)Xen_integer_to_C_int(arg5);
+ if (type2 > 1) Xen_check_type(0, arg5, 5, "XmStringTableUnparse", "XmTextType");
+ len = Xen_integer_to_C_int(arg2);
+ if (len <= 0) return(Xen_false);
loc = xm_protect(lst);
- tb = XEN_TO_C_XmStringTable(arg1, len);
- if (XEN_XmParseTable_P(arg6)) pt = XEN_TO_C_XmParseTable(arg6, len);
+ tb = Xen_to_C_XmStringTable(arg1, len);
+ if (Xen_is_XmParseTable(arg6)) pt = Xen_to_C_XmParseTable(arg6, len);
tab = (char **)XmStringTableUnparse(tb,
len,
- (XEN_FALSE_P(arg3)) ? NULL : (char *)XEN_TO_C_STRING(arg3),
+ (Xen_is_false(arg3)) ? NULL : (char *)Xen_string_to_C_string(arg3),
type1,
type2,
pt,
- XEN_TO_C_INT(arg7),
- (XmParseModel)XEN_TO_C_INT(arg8));
+ Xen_integer_to_C_int(arg7),
+ (XmParseModel)Xen_integer_to_C_int(arg8));
free(tb);
for (i = len - 1; i >= 0; i--)
{
- lst = XEN_CONS(C_TO_XEN_STRING(tab[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(tab[i]), lst);
free(tab[i]);
}
free(tab);
@@ -3417,29 +3351,29 @@ compound strings to an array of text"
return(lst);
}
-static XEN gxm_XmStringTableToXmString(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmStringTableToXmString(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmStringTableToXmString "XmString XmStringTableToXmString(XmStringTable table, Cardinal count, XmString break_component) \
converts a compound string table to a single compound string"
- /* DIFF: XmStringTableToXmString 1st arg is list of XmStrings
+ /* DIFF: XmStringTableToXmString first arg is list of XmStrings
*/
int count;
XmStringTable tab;
XmString val;
- XEN_ASSERT_TYPE(XEN_LIST_P(arg1), arg1, 1, "XmStringTableToXmString", "XmStringTable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmStringTableToXmString", "int");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg3) || XEN_FALSE_P(arg3), arg3, 3, "XmStringTableToXmString", "XmString");
- count = XEN_TO_C_INT(arg2);
- if (count <= 0) return(XEN_FALSE);
- tab = XEN_TO_C_XmStringTable(arg1, count);
+ Xen_check_type(Xen_is_list(arg1), arg1, 1, "XmStringTableToXmString", "XmStringTable");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmStringTableToXmString", "int");
+ Xen_check_type(Xen_is_XmString(arg3) || Xen_is_false(arg3), arg3, 3, "XmStringTableToXmString", "XmString");
+ count = Xen_integer_to_C_int(arg2);
+ if (count <= 0) return(Xen_false);
+ tab = Xen_to_C_XmStringTable(arg1, count);
val = XmStringTableToXmString(tab,
count,
- (XEN_XmString_P(arg3)) ? XEN_TO_C_XmString(arg3) : NULL);
+ (Xen_is_XmString(arg3)) ? Xen_to_C_XmString(arg3) : NULL);
free(tab);
- return(C_TO_XEN_XmString(val));
+ return(C_to_Xen_XmString(val));
}
-static XEN gxm_XmStringToXmStringTable(XEN arg1, XEN arg2)
+static Xen gxm_XmStringToXmStringTable(Xen arg1, Xen arg2)
{
#define H_XmStringToXmStringTable "Cardinal XmStringToXmStringTable(XmString string, XmString break_component) \
converts a single compound string to a table of compound strings"
@@ -3447,93 +3381,94 @@ converts a single compound string to a table of compound strings"
*/
XmStringTable tab;
Cardinal val;
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringToXmStringTable", "XmString");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2) || XEN_FALSE_P(arg2), arg2, 2, "XmStringToXmStringTable", "XmString");
- val = XmStringToXmStringTable(XEN_TO_C_XmString(arg1),
- (XEN_XmString_P(arg2)) ? XEN_TO_C_XmString(arg2) : NULL,
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringToXmStringTable", "XmString");
+ Xen_check_type(Xen_is_XmString(arg2) || Xen_is_false(arg2), arg2, 2, "XmStringToXmStringTable", "XmString");
+ val = XmStringToXmStringTable(Xen_to_C_XmString(arg1),
+ (Xen_is_XmString(arg2)) ? Xen_to_C_XmString(arg2) : NULL,
&tab);
- return(XEN_LIST_2(C_TO_XEN_INT(val), C_TO_XEN_XmStringTable(tab, val)));
+ return(Xen_list_2(C_int_to_Xen_integer(val), C_to_Xen_XmStringTable(tab, val)));
}
-static XEN gxm_XmStringParseText(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XmStringParseText(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XmStringParseText "XmString XmStringParseText(XtPointer text, XtPointer *text_end, XmStringTag tag, XmTextType type, \
XmParseTable parse_table, Cardinal parse_count, XtPointer call_data) converts a character string to a compound string"
/* DIFF: XmStringParseText arg1 is string, arg2 is int
*/
- int loc, len;
+ int len;
const char *str, *tag = NULL;
XmTextType type;
XtPointer *intext = NULL;
XmParseTable pt = NULL;
- XEN rtn;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XmStringParseText", "string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2) || XEN_FALSE_P(arg2), arg2, 2, "XmStringParseText", "int");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3) || XEN_FALSE_P(arg3), arg3, 3, "XmStringParseText", "XmStringTag");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmStringParseText", "XmTextType");
- XEN_ASSERT_TYPE(XEN_XmParseTable_P(arg5), arg5, 5, "XmStringParseText", "XmParseTable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XmStringParseText", "int");
- type = (XmTextType)XEN_TO_C_INT(arg4);
- if (type > 1) XEN_ASSERT_TYPE(0, arg4, 4, "XmStringParseText", "XmTextType");
- str = XEN_TO_C_STRING(arg1);
- if (XEN_INTEGER_P(arg2))
+ Xen rtn;
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XmStringParseText", "string");
+ Xen_check_type(Xen_is_integer(arg2) || Xen_is_false(arg2), arg2, 2, "XmStringParseText", "int");
+ Xen_check_type(Xen_is_string(arg3) || Xen_is_false(arg3), arg3, 3, "XmStringParseText", "XmStringTag");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmStringParseText", "XmTextType");
+ Xen_check_type(Xen_is_XmParseTable(arg5), arg5, 5, "XmStringParseText", "XmParseTable");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XmStringParseText", "int");
+ type = (XmTextType)Xen_integer_to_C_int(arg4);
+ if (type > 1) Xen_check_type(0, arg4, 4, "XmStringParseText", "XmTextType");
+ str = Xen_string_to_C_string(arg1);
+ if (Xen_is_integer(arg2))
{
- loc = XEN_TO_C_INT(arg2);
+ int loc;
+ loc = Xen_integer_to_C_int(arg2);
intext = (XtPointer *)(str + loc);
}
- if (XEN_STRING_P(arg3)) tag = XEN_TO_C_STRING(arg3);
- len = XEN_TO_C_INT(arg6);
- if (XEN_XmParseTable_P(arg5)) pt = XEN_TO_C_XmParseTable(arg5, len);
- rtn = C_TO_XEN_XmString(XmStringParseText((char *)str, intext, (char *)tag, type, pt, len, (XtPointer)arg7));
+ if (Xen_is_string(arg3)) tag = Xen_string_to_C_string(arg3);
+ len = Xen_integer_to_C_int(arg6);
+ if (Xen_is_XmParseTable(arg5)) pt = Xen_to_C_XmParseTable(arg5, len);
+ rtn = C_to_Xen_XmString(XmStringParseText((char *)str, intext, (char *)tag, type, pt, len, (XtPointer)arg7));
if (pt) free(pt);
return(rtn);
}
-static XEN gxm_XmStringUnparse(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XmStringUnparse(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XmStringUnparse "XtPointer XmStringUnparse(XmString string, XmStringTag tag, XmTextType tag_type, XmTextType output_type, \
XmParseTable parse_table, Cardinal parse_count, XmParseModel parse_model) unparses text"
XmTextType type1, type2;
- XEN rtn;
+ Xen rtn;
char *str;
XmParseTable pt = NULL;
int len;
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringUnparse", "XmString");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2) || XEN_FALSE_P(arg2), arg2, 2, "XmStringUnparse", "XmStringTag or " PROC_FALSE);
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmStringUnparse", "XmTextType");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmStringUnparse", "XmTextType");
- XEN_ASSERT_TYPE(XEN_XmParseTable_P(arg5) || XEN_FALSE_P(arg5), arg5, 5, "XmStringUnparse", "XmParseTable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XmStringUnparse", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XmStringUnparse", "XmParseModel");
- type1 = (XmTextType)XEN_TO_C_INT(arg3);
- if (type1 > 1) XEN_ASSERT_TYPE(0, arg3, 3, "XmStringUnparse", "XmTextType");
- type2 = (XmTextType)XEN_TO_C_INT(arg4);
- if (type2 > 1) XEN_ASSERT_TYPE(0, arg4, 4, "XmStringUnparse", "XmTextType");
- len = XEN_TO_C_INT(arg6);
- if (XEN_XmParseTable_P(arg5)) pt = XEN_TO_C_XmParseTable(arg5, len);
- str = (char *)XmStringUnparse(XEN_TO_C_XmString(arg1),
- (XEN_STRING_P(arg2)) ? (char *)XEN_TO_C_STRING(arg2) : NULL,
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringUnparse", "XmString");
+ Xen_check_type(Xen_is_string(arg2) || Xen_is_false(arg2), arg2, 2, "XmStringUnparse", "XmStringTag or " PROC_FALSE);
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmStringUnparse", "XmTextType");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmStringUnparse", "XmTextType");
+ Xen_check_type(Xen_is_XmParseTable(arg5) || Xen_is_false(arg5), arg5, 5, "XmStringUnparse", "XmParseTable");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XmStringUnparse", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XmStringUnparse", "XmParseModel");
+ type1 = (XmTextType)Xen_integer_to_C_int(arg3);
+ if (type1 > 1) Xen_check_type(0, arg3, 3, "XmStringUnparse", "XmTextType");
+ type2 = (XmTextType)Xen_integer_to_C_int(arg4);
+ if (type2 > 1) Xen_check_type(0, arg4, 4, "XmStringUnparse", "XmTextType");
+ len = Xen_integer_to_C_int(arg6);
+ if (Xen_is_XmParseTable(arg5)) pt = Xen_to_C_XmParseTable(arg5, len);
+ str = (char *)XmStringUnparse(Xen_to_C_XmString(arg1),
+ (Xen_is_string(arg2)) ? (char *)Xen_string_to_C_string(arg2) : NULL,
type1, type2, pt, len,
- (XmParseModel)XEN_TO_C_INT(arg7));
- rtn = C_TO_XEN_STRING(str);
+ (XmParseModel)Xen_integer_to_C_int(arg7));
+ rtn = C_string_to_Xen_string(str);
if (str) XtFree(str);
if (pt) free(pt);
return(rtn);
}
-static XEN gxm_XmStringComponentCreate(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmStringComponentCreate(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmStringComponentCreate "XmString XmStringComponentCreate(XmStringComponentType c_type, unsigned int length, XtPointer value) \
creates arbitrary components"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 1, "XmStringComponentCreate", "XmStringComponentType");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XmStringComponentCreate", "unsigned int");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3) || XEN_FALSE_P(arg3), arg3, 3, "XmStringComponentCreate", "XtPointer");
- return(C_TO_XEN_XmString(XmStringComponentCreate(XEN_TO_C_INT(arg1),
- XEN_TO_C_ULONG(arg2),
- XEN_FALSE_P(arg3) ? NULL : (char *)XEN_TO_C_STRING(arg3))));
+ Xen_check_type(Xen_is_integer(arg1), arg1, 1, "XmStringComponentCreate", "XmStringComponentType");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XmStringComponentCreate", "unsigned int");
+ Xen_check_type(Xen_is_string(arg3) || Xen_is_false(arg3), arg3, 3, "XmStringComponentCreate", "XtPointer");
+ return(C_to_Xen_XmString(XmStringComponentCreate(Xen_integer_to_C_int(arg1),
+ Xen_ulong_to_C_ulong(arg2),
+ Xen_is_false(arg3) ? NULL : (char *)Xen_string_to_C_string(arg3))));
}
-static XEN gxm_XmStringGetNextTriple(XEN arg1)
+static Xen gxm_XmStringGetNextTriple(Xen arg1)
{
#define H_XmStringGetNextTriple "XmStringComponentType XmStringGetNextTriple(XmStringContext context) \
returns the type, length, and value of the next component in the compound string"
@@ -3542,354 +3477,354 @@ returns the type, length, and value of the next component in the compound string
unsigned int len;
int val;
XtPointer *ptr = NULL;
- XEN_ASSERT_TYPE(XEN_XmStringContext_P(arg1), arg1, 1, "XmStringGetNextTriple", "XmStringContext");
- val = XmStringGetNextTriple(XEN_TO_C_XmStringContext(arg1), &len, ptr);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_INT((int)len),
- (val == XmSTRING_COMPONENT_TEXT) ? C_TO_XEN_STRING((char *)(*ptr)) : XEN_WRAP_C_POINTER(ptr)));
+ Xen_check_type(Xen_is_XmStringContext(arg1), arg1, 1, "XmStringGetNextTriple", "XmStringContext");
+ val = XmStringGetNextTriple(Xen_to_C_XmStringContext(arg1), &len, ptr);
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer((int)len),
+ (val == XmSTRING_COMPONENT_TEXT) ? C_string_to_Xen_string((char *)(*ptr)) : Xen_wrap_C_pointer(ptr)));
}
-static XEN gxm_XmStringPeekNextTriple(XEN arg1)
+static Xen gxm_XmStringPeekNextTriple(Xen arg1)
{
#define H_XmStringPeekNextTriple "XmStringComponentType XmStringPeekNextTriple(XmStringContext context): returns the \
component type of the next component"
- XEN_ASSERT_TYPE(XEN_XmStringContext_P(arg1), arg1, 1, "XmStringPeekNextTriple", "XmStringContext");
- return(C_TO_XEN_INT(XmStringPeekNextTriple(XEN_TO_C_XmStringContext(arg1))));
+ Xen_check_type(Xen_is_XmStringContext(arg1), arg1, 1, "XmStringPeekNextTriple", "XmStringContext");
+ return(C_int_to_Xen_integer(XmStringPeekNextTriple(Xen_to_C_XmStringContext(arg1))));
}
-static XEN gxm_XmStringDrawUnderline(XEN args)
+static Xen gxm_XmStringDrawUnderline(Xen args)
{
#define H_XmStringDrawUnderline "void XmStringDrawUnderline(Display *d, Window w, XmRenderTable rendertable, XmString string, GC gc, \
Position x, Position y, Dimension width, unsigned char alignment, unsigned char layout_direction, XRectangle *clip, XmString underline) \
underlines a string drawn in an X Window"
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- arg11 = XEN_LIST_REF(args, 10);
- arg12 = XEN_LIST_REF(args, 11);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmStringDrawUnderline", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmStringDrawUnderline", "Window");
- XEN_ASSERT_TYPE(XEN_XmFontList_or_XmRenderTable_P(arg3), arg3, 3, "XmStringDrawUnderline", "XmFontList");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg4), arg4, 4, "XmStringDrawUnderline", "XmString");
- XEN_ASSERT_TYPE(XEN_GC_P(arg5), arg5, 5, "XmStringDrawUnderline", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XmStringDrawUnderline", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XmStringDrawUnderline", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XmStringDrawUnderline", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg9), arg9, 9, "XmStringDrawUnderline", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg10), arg10, 10, "XmStringDrawUnderline", "unsigned int");
- XEN_ASSERT_TYPE(XEN_XRectangle_P(arg11), arg11, 11, "XmStringDrawUnderline", "XRectangle");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg12), arg12, 12, "XmStringDrawUnderline", "XmString");
- XmStringDrawUnderline(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_XmFontList(arg3),
- XEN_TO_C_XmString(arg4),
- XEN_TO_C_GC(arg5),
- XEN_TO_C_INT(arg6), XEN_TO_C_INT(arg7), XEN_TO_C_INT(arg8),
- XEN_TO_C_ULONG(arg9), XEN_TO_C_ULONG(arg10),
- XEN_TO_C_XRectangle(arg11),
- XEN_TO_C_XmString(arg12));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmStringDrawImage(XEN args)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ arg11 = Xen_list_ref(args, 10);
+ arg12 = Xen_list_ref(args, 11);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmStringDrawUnderline", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmStringDrawUnderline", "Window");
+ Xen_check_type(Xen_is_XmFontList_or_XmRenderTable(arg3), arg3, 3, "XmStringDrawUnderline", "XmFontList");
+ Xen_check_type(Xen_is_XmString(arg4), arg4, 4, "XmStringDrawUnderline", "XmString");
+ Xen_check_type(Xen_is_GC(arg5), arg5, 5, "XmStringDrawUnderline", "GC");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XmStringDrawUnderline", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XmStringDrawUnderline", "int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XmStringDrawUnderline", "int");
+ Xen_check_type(Xen_is_ulong(arg9), arg9, 9, "XmStringDrawUnderline", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg10), arg10, 10, "XmStringDrawUnderline", "unsigned int");
+ Xen_check_type(Xen_is_XRectangle(arg11), arg11, 11, "XmStringDrawUnderline", "XRectangle");
+ Xen_check_type(Xen_is_XmString(arg12), arg12, 12, "XmStringDrawUnderline", "XmString");
+ XmStringDrawUnderline(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_XmFontList(arg3),
+ Xen_to_C_XmString(arg4),
+ Xen_to_C_GC(arg5),
+ Xen_integer_to_C_int(arg6), Xen_integer_to_C_int(arg7), Xen_integer_to_C_int(arg8),
+ Xen_ulong_to_C_ulong(arg9), Xen_ulong_to_C_ulong(arg10),
+ Xen_to_C_XRectangle(arg11),
+ Xen_to_C_XmString(arg12));
+ return(Xen_false);
+}
+
+static Xen gxm_XmStringDrawImage(Xen args)
{
#define H_XmStringDrawImage "void XmStringDrawImage(Display *d, Window w, XmRenderTable rendertable, XmString string, GC gc, Position x, \
Position y, Dimension width, unsigned char alignment, unsigned char layout_direction, XRectangle *clip) \
draws a compound string in an X Window and creates an image"
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- arg11 = XEN_LIST_REF(args, 10);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmStringDrawImage", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmStringDrawImage", "Window");
- XEN_ASSERT_TYPE(XEN_XmFontList_or_XmRenderTable_P(arg3), arg3, 3, "XmStringDrawImage", "XmFontList");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg4), arg4, 4, "XmStringDrawImage", "XmString");
- XEN_ASSERT_TYPE(XEN_GC_P(arg5), arg5, 5, "XmStringDrawImage", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XmStringDrawImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XmStringDrawImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XmStringDrawImage", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg9), arg9, 9, "XmStringDrawImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg10), arg10, 10, "XmStringDrawImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_XRectangle_P(arg11), arg11, 11, "XmStringDrawImage", "XRectangle*");
- XmStringDrawImage(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_XmFontList(arg3),
- XEN_TO_C_XmString(arg4),
- XEN_TO_C_GC(arg5),
- XEN_TO_C_INT(arg6), XEN_TO_C_INT(arg7), XEN_TO_C_INT(arg8),
- XEN_TO_C_ULONG(arg9), XEN_TO_C_ULONG(arg10),
- XEN_TO_C_XRectangle(arg11));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmStringDraw(XEN args)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ arg11 = Xen_list_ref(args, 10);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmStringDrawImage", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmStringDrawImage", "Window");
+ Xen_check_type(Xen_is_XmFontList_or_XmRenderTable(arg3), arg3, 3, "XmStringDrawImage", "XmFontList");
+ Xen_check_type(Xen_is_XmString(arg4), arg4, 4, "XmStringDrawImage", "XmString");
+ Xen_check_type(Xen_is_GC(arg5), arg5, 5, "XmStringDrawImage", "GC");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XmStringDrawImage", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XmStringDrawImage", "int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XmStringDrawImage", "int");
+ Xen_check_type(Xen_is_ulong(arg9), arg9, 9, "XmStringDrawImage", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg10), arg10, 10, "XmStringDrawImage", "unsigned int");
+ Xen_check_type(Xen_is_XRectangle(arg11), arg11, 11, "XmStringDrawImage", "XRectangle*");
+ XmStringDrawImage(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_XmFontList(arg3),
+ Xen_to_C_XmString(arg4),
+ Xen_to_C_GC(arg5),
+ Xen_integer_to_C_int(arg6), Xen_integer_to_C_int(arg7), Xen_integer_to_C_int(arg8),
+ Xen_ulong_to_C_ulong(arg9), Xen_ulong_to_C_ulong(arg10),
+ Xen_to_C_XRectangle(arg11));
+ return(Xen_false);
+}
+
+static Xen gxm_XmStringDraw(Xen args)
{
#define H_XmStringDraw "void XmStringDraw(Display *d, Window w, XmRenderTable rendertable, XmString string, GC gc, Position x, Position y, \
Dimension width, unsigned char alignment, unsigned char layout_direction, XRectangle *clip) draws a compound \
string in an X window"
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- arg11 = XEN_LIST_REF(args, 10);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmStringDraw", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmStringDraw", "Window");
- XEN_ASSERT_TYPE(XEN_XmFontList_or_XmRenderTable_P(arg3), arg3, 3, "XmStringDraw", "XmFontList");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg4), arg4, 4, "XmStringDraw", "XmString");
- XEN_ASSERT_TYPE(XEN_GC_P(arg5), arg5, 5, "XmStringDraw", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XmStringDraw", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XmStringDraw", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XmStringDraw", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg9), arg9, 9, "XmStringDraw", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg10), arg10, 10, "XmStringDraw", "unsigned int");
- XEN_ASSERT_TYPE(XEN_XRectangle_P(arg11), arg11, 11, "XmStringDraw", "XRectangle*");
- XmStringDraw(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_XmFontList(arg3),
- XEN_TO_C_XmString(arg4),
- XEN_TO_C_GC(arg5),
- XEN_TO_C_INT(arg6), XEN_TO_C_INT(arg7), XEN_TO_C_INT(arg8),
- XEN_TO_C_ULONG(arg9), XEN_TO_C_ULONG(arg10),
- XEN_TO_C_XRectangle(arg11));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmStringLineCount(XEN arg1)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ arg11 = Xen_list_ref(args, 10);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmStringDraw", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmStringDraw", "Window");
+ Xen_check_type(Xen_is_XmFontList_or_XmRenderTable(arg3), arg3, 3, "XmStringDraw", "XmFontList");
+ Xen_check_type(Xen_is_XmString(arg4), arg4, 4, "XmStringDraw", "XmString");
+ Xen_check_type(Xen_is_GC(arg5), arg5, 5, "XmStringDraw", "GC");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XmStringDraw", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XmStringDraw", "int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XmStringDraw", "int");
+ Xen_check_type(Xen_is_ulong(arg9), arg9, 9, "XmStringDraw", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg10), arg10, 10, "XmStringDraw", "unsigned int");
+ Xen_check_type(Xen_is_XRectangle(arg11), arg11, 11, "XmStringDraw", "XRectangle*");
+ XmStringDraw(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_XmFontList(arg3),
+ Xen_to_C_XmString(arg4),
+ Xen_to_C_GC(arg5),
+ Xen_integer_to_C_int(arg6), Xen_integer_to_C_int(arg7), Xen_integer_to_C_int(arg8),
+ Xen_ulong_to_C_ulong(arg9), Xen_ulong_to_C_ulong(arg10),
+ Xen_to_C_XRectangle(arg11));
+ return(Xen_false);
+}
+
+static Xen gxm_XmStringLineCount(Xen arg1)
{
#define H_XmStringLineCount "int XmStringLineCount(XmString string): returns the number of separators plus one \
in the provided compound string"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringLineCount", "XmString");
- return(C_TO_XEN_INT(XmStringLineCount(XEN_TO_C_XmString(arg1))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringLineCount", "XmString");
+ return(C_int_to_Xen_integer(XmStringLineCount(Xen_to_C_XmString(arg1))));
}
-static XEN gxm_XmStringExtent(XEN arg1, XEN arg2)
+static Xen gxm_XmStringExtent(Xen arg1, Xen arg2)
{
#define H_XmStringExtent "void XmStringExtent(XmRenderTable rendertable, XmString string) \
determines the size of the smallest rectangle that will enclose the compound string"
/* DIFF: XmStringExtent omits and returns the last 2 args
*/
Dimension w, h;
- XEN_ASSERT_TYPE(XEN_XmFontList_or_XmRenderTable_P(arg1), arg1, 1, "XmStringExtent", "XmFontList");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmStringExtent", "XmString");
- XmStringExtent(XEN_TO_C_XmFontList(arg1), XEN_TO_C_XmString(arg2), &w, &h);
- return(XEN_LIST_2(C_TO_XEN_Dimension(w),
- C_TO_XEN_Dimension(h)));
+ Xen_check_type(Xen_is_XmFontList_or_XmRenderTable(arg1), arg1, 1, "XmStringExtent", "XmFontList");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmStringExtent", "XmString");
+ XmStringExtent(Xen_to_C_XmFontList(arg1), Xen_to_C_XmString(arg2), &w, &h);
+ return(Xen_list_2(C_to_Xen_Dimension(w),
+ C_to_Xen_Dimension(h)));
}
-static XEN gxm_XmStringHeight(XEN arg1, XEN arg2)
+static Xen gxm_XmStringHeight(Xen arg1, Xen arg2)
{
#define H_XmStringHeight "Dimension XmStringHeight(XmRenderTable rendertable, XmString string): returns the line \
height of the given compound string"
- XEN_ASSERT_TYPE(XEN_XmFontList_or_XmRenderTable_P(arg1), arg1, 1, "XmStringHeight", "XmFontList");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmStringHeight", "XmString");
- return(C_TO_XEN_Dimension(XmStringHeight(XEN_TO_C_XmFontList(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_XmFontList_or_XmRenderTable(arg1), arg1, 1, "XmStringHeight", "XmFontList");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmStringHeight", "XmString");
+ return(C_to_Xen_Dimension(XmStringHeight(Xen_to_C_XmFontList(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmStringWidth(XEN arg1, XEN arg2)
+static Xen gxm_XmStringWidth(Xen arg1, Xen arg2)
{
#define H_XmStringWidth "Dimension XmStringWidth(XmRenderTable rendertable, XmString string): returns \
the width of the widest line in a compound string"
- XEN_ASSERT_TYPE(XEN_XmFontList_or_XmRenderTable_P(arg1), arg1, 1, "XmStringWidth", "XmFontList");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmStringWidth", "XmString");
- return(C_TO_XEN_Dimension(XmStringWidth(XEN_TO_C_XmFontList(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_XmFontList_or_XmRenderTable(arg1), arg1, 1, "XmStringWidth", "XmFontList");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmStringWidth", "XmString");
+ return(C_to_Xen_Dimension(XmStringWidth(Xen_to_C_XmFontList(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmStringBaseline(XEN arg1, XEN arg2)
+static Xen gxm_XmStringBaseline(Xen arg1, Xen arg2)
{
#define H_XmStringBaseline "Dimension XmStringBaseline(XmRenderTable rendertable, XmString string): returns \
the number of pixels between \
the top of the character box and the baseline of the first line of text"
- XEN_ASSERT_TYPE(XEN_XmFontList_or_XmRenderTable_P(arg1), arg1, 1, "XmStringBaseline", "XmFontList");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmStringBaseline", "XmString");
- return(C_TO_XEN_Dimension(XmStringBaseline(XEN_TO_C_XmFontList(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_XmFontList_or_XmRenderTable(arg1), arg1, 1, "XmStringBaseline", "XmFontList");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmStringBaseline", "XmString");
+ return(C_to_Xen_Dimension(XmStringBaseline(Xen_to_C_XmFontList(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmStringFree(XEN arg1)
+static Xen gxm_XmStringFree(Xen arg1)
{
#define H_XmStringFree "void XmStringFree(XmString string) conditionally deallocates memory"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringFree", "XmString");
- XmStringFree(XEN_TO_C_XmString(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringFree", "XmString");
+ XmStringFree(Xen_to_C_XmString(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmStringHasSubstring(XEN arg1, XEN arg2)
+static Xen gxm_XmStringHasSubstring(Xen arg1, Xen arg2)
{
#define H_XmStringHasSubstring "Boolean XmStringHasSubstring(XmString string, XmString substring) indicates \
whether one compound string is contained within another"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringHasSubstring", "XmString");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmStringHasSubstring", "XmString");
- return(C_TO_XEN_BOOLEAN(XmStringHasSubstring(XEN_TO_C_XmString(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringHasSubstring", "XmString");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmStringHasSubstring", "XmString");
+ return(C_bool_to_Xen_boolean(XmStringHasSubstring(Xen_to_C_XmString(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmStringIsVoid(XEN arg1)
+static Xen gxm_XmStringIsVoid(Xen arg1)
{
#define H_XmStringIsVoid "Boolean XmStringIsVoid(XmString s1) provides information on the existence of non-zero-length text \
components, tab components, or separator components"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringIsVoid", "XmString");
- return(C_TO_XEN_BOOLEAN(XmStringIsVoid(XEN_TO_C_XmString(arg1))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringIsVoid", "XmString");
+ return(C_bool_to_Xen_boolean(XmStringIsVoid(Xen_to_C_XmString(arg1))));
}
-static XEN gxm_XmStringEmpty(XEN arg1)
+static Xen gxm_XmStringEmpty(Xen arg1)
{
#define H_XmStringEmpty "Boolean XmStringEmpty(XmString s1) provides information on the existence of \
non-zero-length text components"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringEmpty", "XmString");
- return(C_TO_XEN_BOOLEAN(XmStringEmpty(XEN_TO_C_XmString(arg1))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringEmpty", "XmString");
+ return(C_bool_to_Xen_boolean(XmStringEmpty(Xen_to_C_XmString(arg1))));
}
-static XEN gxm_XmStringCompare(XEN arg1, XEN arg2)
+static Xen gxm_XmStringCompare(Xen arg1, Xen arg2)
{
#define H_XmStringCompare "Boolean XmStringCompare(XmString s1, XmString s2) compares two strings"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringCompare", "XmString");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmStringCompare", "XmString");
- return(C_TO_XEN_BOOLEAN(XmStringCompare(XEN_TO_C_XmString(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringCompare", "XmString");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmStringCompare", "XmString");
+ return(C_bool_to_Xen_boolean(XmStringCompare(Xen_to_C_XmString(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmStringCopy(XEN arg1)
+static Xen gxm_XmStringCopy(Xen arg1)
{
#define H_XmStringCopy "XmString XmStringCopy(XmString s1) makes a copy of a string"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringCopy", "XmString");
- return(C_TO_XEN_XmString(XmStringCopy(XEN_TO_C_XmString(arg1))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringCopy", "XmString");
+ return(C_to_Xen_XmString(XmStringCopy(Xen_to_C_XmString(arg1))));
}
-static XEN gxm_XmStringConcatAndFree(XEN arg1, XEN arg2)
+static Xen gxm_XmStringConcatAndFree(Xen arg1, Xen arg2)
{
#define H_XmStringConcatAndFree "XmString XmStringConcatAndFree(XmString s1, XmString s2) appends one string to \
another and frees the original strings"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringConcatAndFree", "XmString");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmStringConcatAndFree", "XmString");
- return(C_TO_XEN_XmString(XmStringConcatAndFree(XEN_TO_C_XmString(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringConcatAndFree", "XmString");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmStringConcatAndFree", "XmString");
+ return(C_to_Xen_XmString(XmStringConcatAndFree(Xen_to_C_XmString(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmStringConcat(XEN arg1, XEN arg2)
+static Xen gxm_XmStringConcat(Xen arg1, Xen arg2)
{
#define H_XmStringConcat "XmString XmStringConcat(XmString s1, XmString s2) appends one string to another"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmStringConcat", "XmString");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmStringConcat", "XmString");
- return(C_TO_XEN_XmString(XmStringConcat(XEN_TO_C_XmString(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmStringConcat", "XmString");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmStringConcat", "XmString");
+ return(C_to_Xen_XmString(XmStringConcat(Xen_to_C_XmString(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmStringFreeContext(XEN arg1)
+static Xen gxm_XmStringFreeContext(Xen arg1)
{
#define H_XmStringFreeContext "void XmStringFreeContext(XmStringContext context) releases the string scanning \
context data structure"
- XEN_ASSERT_TYPE(XEN_XmStringContext_P(arg1), arg1, 1, "XmStringFreeContext", "XmStringContext");
- XmStringFreeContext(XEN_TO_C_XmStringContext(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XmStringContext(arg1), arg1, 1, "XmStringFreeContext", "XmStringContext");
+ XmStringFreeContext(Xen_to_C_XmStringContext(arg1));
+ return(Xen_false);
}
static XmStringContext gxm_initxmsc;
-static XEN gxm_XmStringInitContext(XEN arg2)
+static Xen gxm_XmStringInitContext(Xen arg2)
{
#define H_XmStringInitContext "Boolean XmStringInitContext(XmString string) creates \
a data structure for scanning an XmString component by component"
- /* DIFF XmStringInitContext 1st arg omitted and rtn
+ /* DIFF XmStringInitContext first arg omitted and rtn
*/
int val;
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 1, "XmStringInitContext", "XmString");
- val = XmStringInitContext(&gxm_initxmsc, XEN_TO_C_XmString(arg2));
- return(XEN_LIST_2(C_TO_XEN_BOOLEAN(val), C_TO_XEN_XmStringContext(gxm_initxmsc)));
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 1, "XmStringInitContext", "XmString");
+ val = XmStringInitContext(&gxm_initxmsc, Xen_to_C_XmString(arg2));
+ return(Xen_list_2(C_bool_to_Xen_boolean(val), C_to_Xen_XmStringContext(gxm_initxmsc)));
}
-static XEN gxm_XmStringSeparatorCreate(void)
+static Xen gxm_XmStringSeparatorCreate(void)
{
#define H_XmStringSeparatorCreate "XmString XmStringSeparatorCreate(void) creates a compound string"
- return(C_TO_XEN_XmString(XmStringSeparatorCreate()));
+ return(C_to_Xen_XmString(XmStringSeparatorCreate()));
}
-static XEN gxm_XmStringDirectionCreate(XEN arg1)
+static Xen gxm_XmStringDirectionCreate(Xen arg1)
{
#define H_XmStringDirectionCreate "XmString XmStringDirectionCreate(XmStringDirection direction) creates a compound string"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 1, "XmStringDirectionCreate", "int");
- return(C_TO_XEN_XmString(XmStringDirectionCreate(XEN_TO_C_INT(arg1))));
+ Xen_check_type(Xen_is_integer(arg1), arg1, 1, "XmStringDirectionCreate", "int");
+ return(C_to_Xen_XmString(XmStringDirectionCreate(Xen_integer_to_C_int(arg1))));
}
-static XEN gxm_XmStringCreateLocalized(XEN arg1)
+static Xen gxm_XmStringCreateLocalized(Xen arg1)
{
#define H_XmStringCreateLocalized "XmString XmStringCreateLocalized(char *text) creates a compound string in the current locale"
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XmStringCreateLocalized", "String");
- return(C_TO_XEN_XmString(XmStringCreateLocalized((char *)XEN_TO_C_STRING(arg1))));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XmStringCreateLocalized", "String");
+ return(C_to_Xen_XmString(XmStringCreateLocalized((char *)Xen_string_to_C_string(arg1))));
}
-static XEN gxm_XmStringCreate(XEN arg1, XEN arg2)
+static Xen gxm_XmStringCreate(Xen arg1, Xen arg2)
{
#define H_XmStringCreate "XmString XmStringCreate(char *text, char *tag) creates a compound string"
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XmStringCreate", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmStringCreate", "XmStringCharSet");
- return(C_TO_XEN_XmString(XmStringCreate((char *)XEN_TO_C_STRING(arg1), (char *)XEN_TO_C_STRING(arg2))));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XmStringCreate", "char*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmStringCreate", "XmStringCharSet");
+ return(C_to_Xen_XmString(XmStringCreate((char *)Xen_string_to_C_string(arg1), (char *)Xen_string_to_C_string(arg2))));
}
-static XEN gxm_XmChangeColor(XEN arg1, XEN arg2)
+static Xen gxm_XmChangeColor(Xen arg1, Xen arg2)
{
#define H_XmChangeColor "void XmChangeColor(Widget widget, Pixel background) recalculates all associated colors of a widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmChangeColor", "Widget");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg2), arg2, 2, "XmChangeColor", "Pixel");
- XmChangeColor(XEN_TO_C_Widget(arg1), XEN_TO_C_Pixel(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmChangeColor", "Widget");
+ Xen_check_type(Xen_is_Pixel(arg2), arg2, 2, "XmChangeColor", "Pixel");
+ XmChangeColor(Xen_to_C_Widget(arg1), Xen_to_C_Pixel(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmGetColors(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmGetColors(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmGetColors "void XmGetColors(Screen *screen, Colormap colormap, Pixel background) generates foreground, select, and shadow colors"
/* DIFF: XmGetColors omits trailing 4 args and returns them
*/
Pixel fg,ts, bs, sr;
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XmGetColors", "Screen*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XmGetColors", "Colormap");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg3), arg3, 3, "XmGetColors", "Pixel");
- XmGetColors(XEN_TO_C_Screen(arg1),
- XEN_TO_C_Colormap(arg2),
- XEN_TO_C_Pixel(arg3),
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XmGetColors", "Screen*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XmGetColors", "Colormap");
+ Xen_check_type(Xen_is_Pixel(arg3), arg3, 3, "XmGetColors", "Pixel");
+ XmGetColors(Xen_to_C_Screen(arg1),
+ Xen_to_C_Colormap(arg2),
+ Xen_to_C_Pixel(arg3),
&fg, &ts, &bs, &sr);
- return(XEN_LIST_4(C_TO_XEN_Pixel(fg),
- C_TO_XEN_Pixel(ts),
- C_TO_XEN_Pixel(bs),
- C_TO_XEN_Pixel(sr)));
+ return(Xen_list_4(C_to_Xen_Pixel(fg),
+ C_to_Xen_Pixel(ts),
+ C_to_Xen_Pixel(bs),
+ C_to_Xen_Pixel(sr)));
}
-static XEN gxm_XmGetColorCalculation(void)
+static Xen gxm_XmGetColorCalculation(void)
{
#define H_XmGetColorCalculation "XmColorProc XmGetColorCalculation(void) get the procedure used for default color calculation"
return(xm_XmColorProc);
}
-static XEN gxm_XmSetColorCalculation(XEN arg1)
+static Xen gxm_XmSetColorCalculation(Xen arg1)
{
#define H_XmSetColorCalculation "XmColorProc XmSetColorCalculation(XmColorProc color_proc) set the procedure used for default color calculation"
/* DIFF: XmSetColorCalculation NULL -> #f
*/
- if (XEN_PROCEDURE_P(xm_XmColorProc)) xm_unprotect(xm_XmColorProc);
- if (XEN_FALSE_P(arg1))
+ if (Xen_is_procedure(xm_XmColorProc)) xm_unprotect(xm_XmColorProc);
+ if (Xen_is_false(arg1))
{
- xm_XmColorProc = XEN_FALSE;
+ xm_XmColorProc = Xen_false;
XmSetColorCalculation(NULL);
}
else
{
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg1) && (XEN_REQUIRED_ARGS_OK(arg1, 1)), arg1, 1, "XmSetColorCalculation", "(XmColorProc but 1 arg)");
+ Xen_check_type(Xen_is_procedure(arg1) && (Xen_is_aritable(arg1, 1)), arg1, 1, "XmSetColorCalculation", "(XmColorProc but 1 arg)");
xm_protect(arg1);
xm_XmColorProc = arg1;
XmSetColorCalculation((XmColorProc)gxm_XmColorProc);
@@ -3897,19 +3832,19 @@ static XEN gxm_XmSetColorCalculation(XEN arg1)
return(arg1);
}
-static XEN gxm_XmTrackingEvent(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTrackingEvent(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmTrackingEvent "Widget XmTrackingEvent(Widget widget, Cursor cursor, Boolean confine_to): (widget event)"
/* DIFF: XmTrackingEvent widget cursor confine [event] -> (list widget event)
*/
XEvent *e; /* do we need to allocate? */
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmTrackingEvent", "Widget");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg2), arg2, 2, "XmTrackingEvent", "Cursor");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmTrackingEvent", "boolean");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmTrackingEvent", "Widget");
+ Xen_check_type(Xen_is_Cursor(arg2), arg2, 2, "XmTrackingEvent", "Cursor");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmTrackingEvent", "boolean");
e = (XEvent *)calloc(1, sizeof(XEvent));
- w = XmTrackingEvent(XEN_TO_C_Widget(arg1), XEN_TO_C_ULONG(arg2), XEN_TO_C_BOOLEAN(arg3), e);
- return(XEN_LIST_2(C_TO_XEN_Widget(w), C_TO_XEN_XEvent_OBJ(e)));
+ w = XmTrackingEvent(Xen_to_C_Widget(arg1), Xen_ulong_to_C_ulong(arg2), Xen_boolean_to_C_bool(arg3), e);
+ return(Xen_list_2(C_to_Xen_Widget(w), C_to_Xen_XEvent_OBJ(e)));
}
@@ -3941,24 +3876,24 @@ static XEN gxm_XmTrackingEvent(XEN arg1, XEN arg2, XEN arg3)
NULL);
*/
-static XEN gxm_XmVaCreateSimpleCheckBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmVaCreateSimpleCheckBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmVaCreateSimpleCheckBox "Widget XmVaCreateSimpleCheckBox(Widget parent, String name, XtCallbackProc callback, args)"
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmVaCreateSimpleCheckBox", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmVaCreateSimpleCheckBox", "String");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg3) && (XEN_REQUIRED_ARGS_OK(arg3, 3)), arg3, 3, "XmVaCreateSimpleCheckBox", "XtCallbackProc (3 args)");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XmVaCreateSimpleCheckBox", "List");
- arg4 = XEN_CONS_2(C_TO_XEN_STRING(XmNvalueChangedCallback),
- XEN_LIST_2(arg3, XEN_FALSE), /* XtCallbackList technically */
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmVaCreateSimpleCheckBox", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmVaCreateSimpleCheckBox", "String");
+ Xen_check_type(Xen_is_procedure(arg3) && (Xen_is_aritable(arg3, 3)), arg3, 3, "XmVaCreateSimpleCheckBox", "XtCallbackProc (3 args)");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XmVaCreateSimpleCheckBox", "List");
+ arg4 = Xen_cons_2(C_string_to_Xen_string(XmNvalueChangedCallback),
+ Xen_list_2(arg3, Xen_false), /* XtCallbackList technically */
arg4);
{
int arglen;
Arg *args;
- args = XEN_TO_C_Args(arg4);
- arglen = XEN_LIST_LENGTH(arg4) / 2;
- w = XmCreateSimpleCheckBox(XEN_TO_C_Widget(arg1),
- (char *)XEN_TO_C_STRING(arg2),
+ args = Xen_to_C_Args(arg4);
+ arglen = Xen_list_length(arg4) / 2;
+ w = XmCreateSimpleCheckBox(Xen_to_C_Widget(arg1),
+ (char *)Xen_string_to_C_string(arg2),
args,
arglen);
if (args)
@@ -3967,30 +3902,30 @@ static XEN gxm_XmVaCreateSimpleCheckBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmVaCreateSimpleRadioBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmVaCreateSimpleRadioBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmVaCreateSimpleRadioBox "Widget XmVaCreateSimpleRadioBox(Widget parent, String name, int button_set, XtCallbackProc callback, args)"
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmVaCreateSimpleRadioBox", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmVaCreateSimpleRadioBox", "String");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmVaCreateSimpleRadioBox", "int");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 3)), arg4, 4, "XmVaCreateSimpleRadioBox", "XtCallbackProc (3 args");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg5), arg5, 5, "XmVaCreateSimpleRadioBox", "List");
- arg5 = XEN_CONS_2(C_TO_XEN_STRING(XmNvalueChangedCallback),
- XEN_LIST_2(arg4, XEN_FALSE),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmVaCreateSimpleRadioBox", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmVaCreateSimpleRadioBox", "String");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmVaCreateSimpleRadioBox", "int");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 3)), arg4, 4, "XmVaCreateSimpleRadioBox", "XtCallbackProc (3 args");
+ Xen_check_type(Xen_is_list(arg5), arg5, 5, "XmVaCreateSimpleRadioBox", "List");
+ arg5 = Xen_cons_2(C_string_to_Xen_string(XmNvalueChangedCallback),
+ Xen_list_2(arg4, Xen_false),
arg5);
/* can't handle button set here since the menuHistory resource is the widget allocated later */
{
int arglen;
Arg *args;
- args = XEN_TO_C_Args(arg5);
- arglen = XEN_LIST_LENGTH(arg5) / 2;
- w = XmCreateSimpleRadioBox(XEN_TO_C_Widget(arg1),
- (char *)XEN_TO_C_STRING(arg2),
+ args = Xen_to_C_Args(arg5);
+ arglen = Xen_list_length(arg5) / 2;
+ w = XmCreateSimpleRadioBox(Xen_to_C_Widget(arg1),
+ (char *)Xen_string_to_C_string(arg2),
args,
arglen);
if (args)
@@ -3999,35 +3934,35 @@ static XEN gxm_XmVaCreateSimpleRadioBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4,
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmVaCreateSimpleOptionMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XmVaCreateSimpleOptionMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XmVaCreateSimpleOptionMenu "Widget XmVaCreateSimpleOptionMenu(Widget parent, String name, XmString option_label, \
KeySym option_mnemonic, int button_set, XtCallbackProc callback, args)"
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmVaCreateSimpleOptionMenu", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmVaCreateSimpleOptionMenu", "String");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg3), arg3, 3, "XmVaCreateSimpleOptionMenu", "XmString");
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg4), arg4, 4, "XmVaCreateSimpleOptionMenu", "KeySym");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XmVaCreateSimpleOptionMenu", "int");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg6) && (XEN_REQUIRED_ARGS_OK(arg6, 3)), arg6, 6, "XmVaCreateSimpleOptionMenu", "XtCallbackProc (3 args)");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg7), arg7, 7, "XmVaCreateSimpleOptionMenu", "List");
- arg7 = XEN_CONS_2(C_TO_XEN_STRING(XmNlabelString),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmVaCreateSimpleOptionMenu", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmVaCreateSimpleOptionMenu", "String");
+ Xen_check_type(Xen_is_XmString(arg3), arg3, 3, "XmVaCreateSimpleOptionMenu", "XmString");
+ Xen_check_type(Xen_is_KeySym(arg4), arg4, 4, "XmVaCreateSimpleOptionMenu", "KeySym");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XmVaCreateSimpleOptionMenu", "int");
+ Xen_check_type(Xen_is_procedure(arg6) && (Xen_is_aritable(arg6, 3)), arg6, 6, "XmVaCreateSimpleOptionMenu", "XtCallbackProc (3 args)");
+ Xen_check_type(Xen_is_list(arg7), arg7, 7, "XmVaCreateSimpleOptionMenu", "List");
+ arg7 = Xen_cons_2(C_string_to_Xen_string(XmNlabelString),
arg3,
- XEN_CONS_2(C_TO_XEN_STRING(XmNmnemonic),
+ Xen_cons_2(C_string_to_Xen_string(XmNmnemonic),
arg4,
- XEN_CONS_2(C_TO_XEN_STRING(XmNvalueChangedCallback),
- XEN_LIST_2(arg6, XEN_FALSE),
+ Xen_cons_2(C_string_to_Xen_string(XmNvalueChangedCallback),
+ Xen_list_2(arg6, Xen_false),
arg7)));
{
int arglen;
Arg *args;
- args = XEN_TO_C_Args(arg7);
- arglen = XEN_LIST_LENGTH(arg7) / 2;
- w = XmCreateSimpleOptionMenu(XEN_TO_C_Widget(arg1),
- (char *)XEN_TO_C_STRING(arg2),
+ args = Xen_to_C_Args(arg7);
+ arglen = Xen_list_length(arg7) / 2;
+ w = XmCreateSimpleOptionMenu(Xen_to_C_Widget(arg1),
+ (char *)Xen_string_to_C_string(arg2),
args,
arglen);
if (args)
@@ -4036,28 +3971,28 @@ KeySym option_mnemonic, int button_set, XtCallbackProc callback, args)"
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmVaCreateSimplePulldownMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmVaCreateSimplePulldownMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmVaCreateSimplePulldownMenu "Widget XmVaCreateSimplePulldownMenu(Widget parent, String name, int post_from_button, XtCallbackProc callback, args)"
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmVaCreateSimplePulldownMenu", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmVaCreateSimplePulldownMenu", "String");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmVaCreateSimplePulldownMenu", "int");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 3)), arg4, 4, "XmVaCreateSimplePulldownMenu", "XtCallbackProc (3 args)");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg5), arg5, 5, "XmVaCreateSimplePulldownMenu", "List");
- arg5 = XEN_CONS_2(C_TO_XEN_STRING(XmNvalueChangedCallback),
- XEN_LIST_2(arg4, XEN_FALSE),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmVaCreateSimplePulldownMenu", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmVaCreateSimplePulldownMenu", "String");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmVaCreateSimplePulldownMenu", "int");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 3)), arg4, 4, "XmVaCreateSimplePulldownMenu", "XtCallbackProc (3 args)");
+ Xen_check_type(Xen_is_list(arg5), arg5, 5, "XmVaCreateSimplePulldownMenu", "List");
+ arg5 = Xen_cons_2(C_string_to_Xen_string(XmNvalueChangedCallback),
+ Xen_list_2(arg4, Xen_false),
arg5);
{
int arglen;
Arg *args;
- args = XEN_TO_C_Args(arg5);
- arglen = XEN_LIST_LENGTH(arg5) / 2;
- w = XmCreateSimplePulldownMenu(XEN_TO_C_Widget(arg1),
- (char *)XEN_TO_C_STRING(arg2),
+ args = Xen_to_C_Args(arg5);
+ arglen = Xen_list_length(arg5) / 2;
+ w = XmCreateSimplePulldownMenu(Xen_to_C_Widget(arg1),
+ (char *)Xen_string_to_C_string(arg2),
args,
arglen);
if (args)
@@ -4066,27 +4001,27 @@ static XEN gxm_XmVaCreateSimplePulldownMenu(XEN arg1, XEN arg2, XEN arg3, XEN ar
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmVaCreateSimplePopupMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmVaCreateSimplePopupMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmVaCreateSimplePopupMenu "Widget XmVaCreateSimplePopupMenu(Widget parent, String name, XtCallbackProc callback, args)"
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmVaCreateSimplePopupMenu", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmVaCreateSimplePopupMenu", "String");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg3) && (XEN_REQUIRED_ARGS_OK(arg3, 3)), arg3, 3, "XmVaCreateSimplePopupMenu", "XtCallbackProc (3 args)");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XmVaCreateSimplePopupMenu", "List");
- arg4 = XEN_CONS_2(C_TO_XEN_STRING(XmNvalueChangedCallback),
- XEN_LIST_2(arg3, XEN_FALSE),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmVaCreateSimplePopupMenu", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmVaCreateSimplePopupMenu", "String");
+ Xen_check_type(Xen_is_procedure(arg3) && (Xen_is_aritable(arg3, 3)), arg3, 3, "XmVaCreateSimplePopupMenu", "XtCallbackProc (3 args)");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XmVaCreateSimplePopupMenu", "List");
+ arg4 = Xen_cons_2(C_string_to_Xen_string(XmNvalueChangedCallback),
+ Xen_list_2(arg3, Xen_false),
arg4);
{
int arglen;
Arg *args;
- args = XEN_TO_C_Args(arg4);
- arglen = XEN_LIST_LENGTH(arg4) / 2;
- w = XmCreateSimplePopupMenu(XEN_TO_C_Widget(arg1),
- (char *)XEN_TO_C_STRING(arg2),
+ args = Xen_to_C_Args(arg4);
+ arglen = Xen_list_length(arg4) / 2;
+ w = XmCreateSimplePopupMenu(Xen_to_C_Widget(arg1),
+ (char *)Xen_string_to_C_string(arg2),
args,
arglen);
if (args)
@@ -4095,23 +4030,23 @@ static XEN gxm_XmVaCreateSimplePopupMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmVaCreateSimpleMenuBar(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmVaCreateSimpleMenuBar(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmVaCreateSimpleMenuBar "Widget XmVaCreateSimpleMenuBar(Widget parent, String name, args)"
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmVaCreateSimpleMenuBar", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmVaCreateSimpleMenuBar", "String");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XmVaCreateSimpleMenuBar", "List");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmVaCreateSimpleMenuBar", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmVaCreateSimpleMenuBar", "String");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XmVaCreateSimpleMenuBar", "List");
{
int arglen;
Arg *args;
- args = XEN_TO_C_Args(arg3);
- arglen = XEN_LIST_LENGTH(arg3) / 2;
- w = XmVaCreateSimpleMenuBar(XEN_TO_C_Widget(arg1),
- (char *)XEN_TO_C_STRING(arg2),
+ args = Xen_to_C_Args(arg3);
+ arglen = Xen_list_length(arg3) / 2;
+ w = XmVaCreateSimpleMenuBar(Xen_to_C_Widget(arg1),
+ (char *)Xen_string_to_C_string(arg2),
args,
arglen);
if (args)
@@ -4120,58 +4055,58 @@ static XEN gxm_XmVaCreateSimpleMenuBar(XEN arg1, XEN arg2, XEN arg3)
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmCreateSimpleCheckBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSimpleCheckBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSimpleCheckBox "Widget XmCreateSimpleCheckBox(Widget parent, String name, ArgList arglist, Cardinal argcount)"
return(gxm_new_widget("XmCreateSimpleCheckBox", XmCreateSimpleCheckBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSimpleRadioBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSimpleRadioBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSimpleRadioBox "Widget XmCreateSimpleRadioBox(Widget parent, String name, ArgList arglist, Cardinal argcount)"
return(gxm_new_widget("XmCreateSimpleRadioBox", XmCreateSimpleRadioBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSimpleOptionMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSimpleOptionMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSimpleOptionMenu "Widget XmCreateSimpleOptionMenu(Widget parent, String name, ArgList arglist, Cardinal argcount)"
return(gxm_new_widget("XmCreateSimpleOptionMenu", XmCreateSimpleOptionMenu, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSimplePulldownMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSimplePulldownMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSimplePulldownMenu "Widget XmCreateSimplePulldownMenu(Widget parent, String name, ArgList arglist, Cardinal argcount)"
return(gxm_new_widget("XmCreateSimplePulldownMenu", XmCreateSimplePulldownMenu, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSimplePopupMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSimplePopupMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSimplePopupMenu "Widget XmCreateSimplePopupMenu(Widget parent, String name, ArgList arglist, Cardinal argcount)"
return(gxm_new_widget("XmCreateSimplePopupMenu", XmCreateSimplePopupMenu, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSimpleMenuBar(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSimpleMenuBar(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSimpleMenuBar "Widget XmCreateSimpleMenuBar(Widget parent, String name, ArgList arglist, Cardinal argcount)"
return(gxm_new_widget("XmCreateSimpleMenuBar", XmCreateSimpleMenuBar, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmConvertUnits(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmConvertUnits(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmConvertUnits "int XmConvertUnits(Widget widget, int orientation, int from_unit_type, int from_value, int to_unit_type) \
converts a value in one unit type to another unit type"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmConvertUnits", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmConvertUnits", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmConvertUnits", "register");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmConvertUnits", "register");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XmConvertUnits", "register");
- return(C_TO_XEN_INT(XmConvertUnits(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmConvertUnits", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmConvertUnits", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmConvertUnits", "register");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmConvertUnits", "register");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XmConvertUnits", "register");
+ return(C_int_to_Xen_integer(XmConvertUnits(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5))));
}
-static XEN gxm_XmConvertStringToUnits(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmConvertStringToUnits(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmConvertStringToUnits "int XmConvertStringToUnits(Screen *screen, String spec, int orientation, int to_type, XtEnum *parse_error) \
converts a string specification to a unit value"
@@ -4179,59 +4114,59 @@ converts a string specification to a unit value"
*/
XtEnum err = 0;
int val;
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XmConvertStringToUnits", "Screen*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmConvertStringToUnits", "String");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmConvertStringToUnits", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmConvertStringToUnits", "int");
- val = XmConvertStringToUnits(XEN_TO_C_Screen(arg1), (char *)XEN_TO_C_STRING(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4), &err);
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XmConvertStringToUnits", "Screen*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmConvertStringToUnits", "String");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmConvertStringToUnits", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmConvertStringToUnits", "int");
+ val = XmConvertStringToUnits(Xen_to_C_Screen(arg1), (char *)Xen_string_to_C_string(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4), &err);
if (err == 0)
- return(C_TO_XEN_INT(val));
- return(XEN_FALSE);
+ return(C_int_to_Xen_integer(val));
+ return(Xen_false);
}
-static XEN gxm_XmCvtXmStringToCT(XEN arg1)
+static Xen gxm_XmCvtXmStringToCT(Xen arg1)
{
#define H_XmCvtXmStringToCT "char *XmCvtXmStringToCT(XmString string) converts a compound string to compound text"
- XEN_ASSERT_TYPE(XEN_XmString_P(arg1), arg1, 1, "XmCvtXmStringToCT", "XmString");
- return(C_TO_XEN_STRING(XmCvtXmStringToCT(XEN_TO_C_XmString(arg1))));
+ Xen_check_type(Xen_is_XmString(arg1), arg1, 1, "XmCvtXmStringToCT", "XmString");
+ return(C_string_to_Xen_string(XmCvtXmStringToCT(Xen_to_C_XmString(arg1))));
/* memory leak here, but the docs don't say that I should free the string of "compound text" */
}
-static XEN gxm_XmCvtCTToXmString(XEN arg1)
+static Xen gxm_XmCvtCTToXmString(Xen arg1)
{
#define H_XmCvtCTToXmString "XmString XmCvtCTToXmString(char *text) converts compound text to a compound string"
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XmCvtCTToXmString", "char*");
- return(C_TO_XEN_XmString(XmCvtCTToXmString((char *)XEN_TO_C_STRING(arg1))));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XmCvtCTToXmString", "char*");
+ return(C_to_Xen_XmString(XmCvtCTToXmString((char *)Xen_string_to_C_string(arg1))));
}
-static XEN gxm_XmMapSegmentEncoding(XEN arg1)
+static Xen gxm_XmMapSegmentEncoding(Xen arg1)
{
char *str;
- XEN res;
+ Xen res;
#define H_XmMapSegmentEncoding "char *XmMapSegmentEncoding(char *fontlist_tag): returns the compound text \
encoding format associated with the specified font list tag"
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XmMapSegmentEncoding", "char*");
- str = XmMapSegmentEncoding((char *)XEN_TO_C_STRING(arg1));
- res = C_TO_XEN_STRING(str);
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XmMapSegmentEncoding", "char*");
+ str = XmMapSegmentEncoding((char *)Xen_string_to_C_string(arg1));
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XmRegisterSegmentEncoding(XEN arg1, XEN arg2)
+static Xen gxm_XmRegisterSegmentEncoding(Xen arg1, Xen arg2)
{
char *str;
- XEN res;
+ Xen res;
#define H_XmRegisterSegmentEncoding "char *XmRegisterSegmentEncoding(char *fontlist_tag, char *ct_encoding) \
registers a compound text encoding format for a specified font list element tag"
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XmRegisterSegmentEncoding", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmRegisterSegmentEncoding", "char*");
- str = XmRegisterSegmentEncoding((char *)XEN_TO_C_STRING(arg1), (char *)XEN_TO_C_STRING(arg2));
- res = C_TO_XEN_STRING(str);
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XmRegisterSegmentEncoding", "char*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmRegisterSegmentEncoding", "char*");
+ str = XmRegisterSegmentEncoding((char *)Xen_string_to_C_string(arg1), (char *)Xen_string_to_C_string(arg2));
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XmWidgetGetBaselines(XEN arg1)
+static Xen gxm_XmWidgetGetBaselines(Xen arg1)
{
#define H_XmWidgetGetBaselines "Boolean XmWidgetGetBaselines(Widget widget) retrieves baseline information for a widget"
/* DIFF: XmWidgetGetBaselines omits args 2 and 3, returns list of Dimensions
@@ -4239,114 +4174,114 @@ static XEN gxm_XmWidgetGetBaselines(XEN arg1)
Dimension *ds;
int len, i, loc;
Boolean b;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmWidgetGetBaselines", "Widget");
- b = XmWidgetGetBaselines(XEN_TO_C_Widget(arg1), &ds, &len);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmWidgetGetBaselines", "Widget");
+ b = XmWidgetGetBaselines(Xen_to_C_Widget(arg1), &ds, &len);
if (!b)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Dimension(ds[i]), lst);
+ lst = Xen_cons(C_to_Xen_Dimension(ds[i]), lst);
free(ds);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XmWidgetGetDisplayRect(XEN arg1)
+static Xen gxm_XmWidgetGetDisplayRect(Xen arg1)
{
#define H_XmWidgetGetDisplayRect "Boolean XmWidgetGetDisplayRect(Widget widget): returns widget's bounding box as XRectangle"
XRectangle *r;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmWidgetGetDisplayRect", "Widget");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmWidgetGetDisplayRect", "Widget");
r = (XRectangle *)calloc(1, sizeof(XRectangle));
- if (!(XmWidgetGetDisplayRect(XEN_TO_C_Widget(arg1), r)))
+ if (!(XmWidgetGetDisplayRect(Xen_to_C_Widget(arg1), r)))
{
free(r);
- return(XEN_FALSE);
+ return(Xen_false);
}
- return(C_TO_XEN_XRectangle(r));
+ return(C_to_Xen_XRectangle(r));
}
-static XEN gxm_XmObjectAtPoint(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmObjectAtPoint(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmObjectAtPoint "Widget XmObjectAtPoint(Widget widget, Position x, Position y) determines which child \
intersects or comes closest to a specified point"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmObjectAtPoint", "Widget");
- XEN_ASSERT_TYPE(XEN_Position_P(arg2), arg2, 2, "XmObjectAtPoint", "Position");
- XEN_ASSERT_TYPE(XEN_Position_P(arg3), arg3, 3, "XmObjectAtPoint", "Position");
- return(C_TO_XEN_Widget(XmObjectAtPoint(XEN_TO_C_Widget(arg1), XEN_TO_C_Position(arg2), XEN_TO_C_Position(arg3))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmObjectAtPoint", "Widget");
+ Xen_check_type(Xen_is_Position(arg2), arg2, 2, "XmObjectAtPoint", "Position");
+ Xen_check_type(Xen_is_Position(arg3), arg3, 3, "XmObjectAtPoint", "Position");
+ return(C_to_Xen_Widget(XmObjectAtPoint(Xen_to_C_Widget(arg1), Xen_to_C_Position(arg2), Xen_to_C_Position(arg3))));
}
-static XEN gxm_XmUpdateDisplay(XEN arg1)
+static Xen gxm_XmUpdateDisplay(Xen arg1)
{
#define H_XmUpdateDisplay "void XmUpdateDisplay (widget) processes all pending exposure events immediately"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmUpdateDisplay", "Widget");
- XmUpdateDisplay(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmUpdateDisplay", "Widget");
+ XmUpdateDisplay(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmDestroyPixmap(XEN arg1, XEN arg2)
+static Xen gxm_XmDestroyPixmap(Xen arg1, Xen arg2)
{
#define H_XmDestroyPixmap "Boolean XmDestroyPixmap(Screen *screen, Pixmap pixmap) removes a pixmap from the pixmap cache"
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XmDestroyPixmap", "Screen*");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg2), arg2, 2, "XmDestroyPixmap", "Pixmap");
- return(C_TO_XEN_BOOLEAN(XmDestroyPixmap(XEN_TO_C_Screen(arg1),
- XEN_TO_C_Pixmap(arg2))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XmDestroyPixmap", "Screen*");
+ Xen_check_type(Xen_is_Pixmap(arg2), arg2, 2, "XmDestroyPixmap", "Pixmap");
+ return(C_bool_to_Xen_boolean(XmDestroyPixmap(Xen_to_C_Screen(arg1),
+ Xen_to_C_Pixmap(arg2))));
}
-static XEN gxm_XmGetPixmapByDepth(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmGetPixmapByDepth(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmGetPixmapByDepth "Pixmap XmGetPixmapByDepth(Screen *screen, char *image_name, Pixel foreground, Pixel background, int depth) \
generates a pixmap, stores it in a pixmap cache, and returns the pixmap"
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XmGetPixmapByDepth", "Screen*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmGetPixmapByDepth", "char*");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg3), arg3, 3, "XmGetPixmapByDepth", "Pixel");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg4), arg4, 4, "XmGetPixmapByDepth", "Pixel");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XmGetPixmapByDepth", "int");
- return(C_TO_XEN_Pixmap(XmGetPixmapByDepth(XEN_TO_C_Screen(arg1),
- (char *)XEN_TO_C_STRING(arg2),
- XEN_TO_C_Pixel(arg3),
- XEN_TO_C_Pixel(arg4),
- XEN_TO_C_INT(arg5))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XmGetPixmapByDepth", "Screen*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmGetPixmapByDepth", "char*");
+ Xen_check_type(Xen_is_Pixel(arg3), arg3, 3, "XmGetPixmapByDepth", "Pixel");
+ Xen_check_type(Xen_is_Pixel(arg4), arg4, 4, "XmGetPixmapByDepth", "Pixel");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XmGetPixmapByDepth", "int");
+ return(C_to_Xen_Pixmap(XmGetPixmapByDepth(Xen_to_C_Screen(arg1),
+ (char *)Xen_string_to_C_string(arg2),
+ Xen_to_C_Pixel(arg3),
+ Xen_to_C_Pixel(arg4),
+ Xen_integer_to_C_int(arg5))));
}
-static XEN gxm_XmGetPixmap(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmGetPixmap(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmGetPixmap "Pixmap XmGetPixmap(Screen *screen, char *image_name, Pixel foreground, Pixel background) A pixmap caching function \
that generates a pixmap, stores it in a pixmap cache, and returns the pixmap"
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XmGetPixmap", "Screen*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmGetPixmap", "char*");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg3), arg3, 3, "XmGetPixmap", "Pixel");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg4), arg4, 4, "XmGetPixmap", "Pixel");
- return(C_TO_XEN_Pixmap(XmGetPixmap(XEN_TO_C_Screen(arg1),
- (char *)XEN_TO_C_STRING(arg2),
- XEN_TO_C_Pixel(arg3),
- XEN_TO_C_Pixel(arg4))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XmGetPixmap", "Screen*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmGetPixmap", "char*");
+ Xen_check_type(Xen_is_Pixel(arg3), arg3, 3, "XmGetPixmap", "Pixel");
+ Xen_check_type(Xen_is_Pixel(arg4), arg4, 4, "XmGetPixmap", "Pixel");
+ return(C_to_Xen_Pixmap(XmGetPixmap(Xen_to_C_Screen(arg1),
+ (char *)Xen_string_to_C_string(arg2),
+ Xen_to_C_Pixel(arg3),
+ Xen_to_C_Pixel(arg4))));
}
-static XEN gxm_XmUninstallImage(XEN arg1)
+static Xen gxm_XmUninstallImage(Xen arg1)
{
#define H_XmUninstallImage "Boolean XmUninstallImage(XImage *image) removes an image from the image cache"
- XEN_ASSERT_TYPE(XEN_XImage_P(arg1), arg1, 1, "XmUninstallImage", "XImage*");
- return(C_TO_XEN_BOOLEAN(XmUninstallImage(XEN_TO_C_XImage(arg1))));
+ Xen_check_type(Xen_is_XImage(arg1), arg1, 1, "XmUninstallImage", "XImage*");
+ return(C_bool_to_Xen_boolean(XmUninstallImage(Xen_to_C_XImage(arg1))));
}
-static XEN gxm_XmInstallImage(XEN arg1, XEN arg2)
+static Xen gxm_XmInstallImage(Xen arg1, Xen arg2)
{
#define H_XmInstallImage "Boolean XmInstallImage(XImage *image, char *image_name) adds an image to the image cache"
- XEN_ASSERT_TYPE(XEN_XImage_P(arg1), arg1, 1, "XmInstallImage", "XImage*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmInstallImage", "char*");
- return(C_TO_XEN_BOOLEAN(XmInstallImage(XEN_TO_C_XImage(arg1),
- (char *)XEN_TO_C_STRING(arg2))));
+ Xen_check_type(Xen_is_XImage(arg1), arg1, 1, "XmInstallImage", "XImage*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmInstallImage", "char*");
+ return(C_bool_to_Xen_boolean(XmInstallImage(Xen_to_C_XImage(arg1),
+ (char *)Xen_string_to_C_string(arg2))));
}
-static XEN gxm_XmCreateMainWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateMainWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateMainWindow "Widget XmCreateMainWindow(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MainWindow widget creation function"
return(gxm_new_widget("XmCreateMainWindow", XmCreateMainWindow, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmTranslateKey(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTranslateKey(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmTranslateKey "void XmTranslateKey(Display *display, KeyCode keycode, Modifiers modifiers) \
The default keycode-to-keysym translator -> (modifiers keysym)"
@@ -4354,56 +4289,56 @@ The default keycode-to-keysym translator -> (modifiers keysym)"
*/
Modifiers m;
KeySym k;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmTranslateKey", "Display*");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XmTranslateKey", "KeyCode");
- XEN_ASSERT_TYPE(XEN_Modifiers_P(arg3), arg3, 3, "XmTranslateKey", "Modifiers");
- XmTranslateKey(XEN_TO_C_Display(arg1), XEN_TO_C_KeyCode(arg2), XEN_TO_C_Modifiers(arg3), &m, &k);
- return(XEN_LIST_2(C_TO_XEN_Modifiers(m),
- C_TO_XEN_KeySym(k)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmTranslateKey", "Display*");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XmTranslateKey", "KeyCode");
+ Xen_check_type(Xen_is_Modifiers(arg3), arg3, 3, "XmTranslateKey", "Modifiers");
+ XmTranslateKey(Xen_to_C_Display(arg1), Xen_to_C_KeyCode(arg2), Xen_to_C_Modifiers(arg3), &m, &k);
+ return(Xen_list_2(C_to_Xen_Modifiers(m),
+ C_to_Xen_KeySym(k)));
}
-static XEN gxm_XmCreateScrolledList(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateScrolledList(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateScrolledList "Widget XmCreateScrolledList(Widget parent, String name, ArgList arglist, Cardinal argcount) The List \
ScrolledList creation function"
return(gxm_new_widget("XmCreateScrolledList", XmCreateScrolledList, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateList(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateList(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateList "Widget XmCreateList(Widget parent, String name, ArgList arglist, Cardinal argcount) The List widget creation function"
return(gxm_new_widget("XmCreateList", XmCreateList, arg1, arg2, arg3, arg4));
}
-#define XEN_ListWidget_P(Arg) (XEN_Widget_P(Arg) && XmIsList(XEN_TO_C_Widget(Arg)))
+#define Xen_is_ListWidget(Arg) (Xen_is_Widget(Arg) && XmIsList(Xen_to_C_Widget(Arg)))
-static XEN gxm_XmListPosSelected(XEN arg1, XEN arg2)
+static Xen gxm_XmListPosSelected(Xen arg1, Xen arg2)
{
#define H_XmListPosSelected "Boolean XmListPosSelected(Widget widget, int position) determines if the list item at a \
specified position is selected"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListPosSelected", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListPosSelected", "int");
- return(C_TO_XEN_BOOLEAN(XmListPosSelected(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListPosSelected", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListPosSelected", "int");
+ return(C_bool_to_Xen_boolean(XmListPosSelected(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XmListUpdateSelectedList(XEN arg1)
+static Xen gxm_XmListUpdateSelectedList(Xen arg1)
{
#define H_XmListUpdateSelectedList "void XmListUpdateSelectedList(Widget widget) updates the XmNselectedItems resource"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListUpdateSelectedList", "List Widget");
- XmListUpdateSelectedList(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListUpdateSelectedList", "List Widget");
+ XmListUpdateSelectedList(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmListSetHorizPos(XEN arg1, XEN arg2)
+static Xen gxm_XmListSetHorizPos(Xen arg1, Xen arg2)
{
#define H_XmListSetHorizPos "void XmListSetHorizPos(Widget widget, int position) scrolls to the specified position in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSetHorizPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListSetHorizPos", "int");
- XmListSetHorizPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSetHorizPos", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListSetHorizPos", "int");
+ XmListSetHorizPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListGetSelectedPos(XEN arg1)
+static Xen gxm_XmListGetSelectedPos(Xen arg1)
{
#define H_XmListGetSelectedPos "Boolean XmListGetSelectedPos(Widget widget) A List function that returns the position of every selected item in the list"
/* DIFF: XmListGetSelectedPos omits args 2 and 3, returns list of positions
@@ -4411,20 +4346,20 @@ static XEN gxm_XmListGetSelectedPos(XEN arg1)
int *ps;
int i, len, loc;
Boolean b;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListGetSelectedPos", "List Widget");
- b = XmListGetSelectedPos(XEN_TO_C_Widget(arg1), &ps, &len);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListGetSelectedPos", "List Widget");
+ b = XmListGetSelectedPos(Xen_to_C_Widget(arg1), &ps, &len);
if (!b)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_INT(ps[i]), lst);
+ lst = Xen_cons(C_int_to_Xen_integer(ps[i]), lst);
free(ps);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XmListGetMatchPos(XEN arg1, XEN arg2)
+static Xen gxm_XmListGetMatchPos(Xen arg1, Xen arg2)
{
#define H_XmListGetMatchPos "Boolean XmListGetMatchPos(Widget widget, XmString item): returns all instances of an item in the list"
/* DIFF: XmListGetSelectedPos omits args 3 and 4, returns list of positions
@@ -4432,21 +4367,21 @@ static XEN gxm_XmListGetMatchPos(XEN arg1, XEN arg2)
int *ps;
int i, len, loc;
Boolean b;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListGetMatchPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListGetMatchPos", "XmString");
- b = XmListGetMatchPos(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2), &ps, &len);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListGetMatchPos", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListGetMatchPos", "XmString");
+ b = XmListGetMatchPos(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2), &ps, &len);
if (!b)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_INT(ps[i]), lst);
+ lst = Xen_cons(C_int_to_Xen_integer(ps[i]), lst);
free(ps);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XmListPosToBounds(XEN arg1, XEN arg2)
+static Xen gxm_XmListPosToBounds(Xen arg1, Xen arg2)
{
#define H_XmListPosToBounds "Boolean XmListPosToBounds(Widget widget, int position): returns the bounding box of an item at a specified position in a list"
/* DIFF: XmListPosToBounds last 4 args omitted and returned
@@ -4454,151 +4389,151 @@ static XEN gxm_XmListPosToBounds(XEN arg1, XEN arg2)
Position x, y;
Dimension w, h;
int val;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListPosToBounds", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListPosToBounds", "int");
- val = XmListPosToBounds(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), &x, &y, &w, &h);
- return(XEN_LIST_5(C_TO_XEN_BOOLEAN(val),
- C_TO_XEN_Position(x),
- C_TO_XEN_Position(y),
- C_TO_XEN_Dimension(w),
- C_TO_XEN_Dimension(h)));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListPosToBounds", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListPosToBounds", "int");
+ val = XmListPosToBounds(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), &x, &y, &w, &h);
+ return(Xen_list_5(C_bool_to_Xen_boolean(val),
+ C_to_Xen_Position(x),
+ C_to_Xen_Position(y),
+ C_to_Xen_Dimension(w),
+ C_to_Xen_Dimension(h)));
}
-static XEN gxm_XmListYToPos(XEN arg1, XEN arg2)
+static Xen gxm_XmListYToPos(Xen arg1, Xen arg2)
{
#define H_XmListYToPos "int XmListYToPos(Widget widget, Position y): returns the position of the item at a specified y-coordinate"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListYToPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_Position_P(arg2), arg2, 2, "XmListYToPos", "Position");
- return(C_TO_XEN_INT(XmListYToPos(XEN_TO_C_Widget(arg1), XEN_TO_C_Position(arg2))));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListYToPos", "List Widget");
+ Xen_check_type(Xen_is_Position(arg2), arg2, 2, "XmListYToPos", "Position");
+ return(C_int_to_Xen_integer(XmListYToPos(Xen_to_C_Widget(arg1), Xen_to_C_Position(arg2))));
}
-static XEN gxm_XmListSetKbdItemPos(XEN arg1, XEN arg2)
+static Xen gxm_XmListSetKbdItemPos(Xen arg1, Xen arg2)
{
#define H_XmListSetKbdItemPos "Boolean XmListSetKbdItemPos(Widget widget, int position) sets the location cursor at a specified position"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSetKbdItemPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListSetKbdItemPos", "int");
- return(C_TO_XEN_BOOLEAN(XmListSetKbdItemPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSetKbdItemPos", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListSetKbdItemPos", "int");
+ return(C_bool_to_Xen_boolean(XmListSetKbdItemPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XmListGetKbdItemPos(XEN arg1)
+static Xen gxm_XmListGetKbdItemPos(Xen arg1)
{
#define H_XmListGetKbdItemPos "int XmListGetKbdItemPos(Widget widget): returns the position of the item at the location cursor"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListGetKbdItemPos", "List Widget");
- return(C_TO_XEN_INT(XmListGetKbdItemPos(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListGetKbdItemPos", "List Widget");
+ return(C_int_to_Xen_integer(XmListGetKbdItemPos(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmListItemPos(XEN arg1, XEN arg2)
+static Xen gxm_XmListItemPos(Xen arg1, Xen arg2)
{
#define H_XmListItemPos "int XmListItemPos(Widget widget, XmString item): returns the position of an item in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListItemPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListItemPos", "XmString");
- return(C_TO_XEN_INT(XmListItemPos(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListItemPos", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListItemPos", "XmString");
+ return(C_int_to_Xen_integer(XmListItemPos(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmListItemExists(XEN arg1, XEN arg2)
+static Xen gxm_XmListItemExists(Xen arg1, Xen arg2)
{
#define H_XmListItemExists "Boolean XmListItemExists(Widget widget, XmString item) checks if a specified item is in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListItemExists", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListItemExists", "XmString");
- return(C_TO_XEN_BOOLEAN(XmListItemExists(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2))));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListItemExists", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListItemExists", "XmString");
+ return(C_bool_to_Xen_boolean(XmListItemExists(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2))));
}
-static XEN gxm_XmListSetAddMode(XEN arg1, XEN arg2)
+static Xen gxm_XmListSetAddMode(Xen arg1, Xen arg2)
{
#define H_XmListSetAddMode "void XmListSetAddMode(Widget widget, Boolean state) sets add mode in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSetAddMode", "List Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmListSetAddMode", "boolean");
- XmListSetAddMode(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSetAddMode", "List Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmListSetAddMode", "boolean");
+ XmListSetAddMode(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListSetBottomItem(XEN arg1, XEN arg2)
+static Xen gxm_XmListSetBottomItem(Xen arg1, Xen arg2)
{
#define H_XmListSetBottomItem "void XmListSetBottomItem(Widget widget, XmString item) makes an existing item the last \
visible item in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSetBottomItem", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListSetBottomItem", "XmString");
- XmListSetBottomItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSetBottomItem", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListSetBottomItem", "XmString");
+ XmListSetBottomItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListSetItem(XEN arg1, XEN arg2)
+static Xen gxm_XmListSetItem(Xen arg1, Xen arg2)
{
#define H_XmListSetItem "void XmListSetItem(Widget widget, XmString item) makes an existing item the first visible item in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSetItem", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListSetItem", "XmString");
- XmListSetItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSetItem", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListSetItem", "XmString");
+ XmListSetItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListSetBottomPos(XEN arg1, XEN arg2)
+static Xen gxm_XmListSetBottomPos(Xen arg1, Xen arg2)
{
#define H_XmListSetBottomPos "void XmListSetBottomPos(Widget widget, int position) makes a specified item the last visible item in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSetBottomPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListSetBottomPos", "int");
- XmListSetBottomPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSetBottomPos", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListSetBottomPos", "int");
+ XmListSetBottomPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListSetPos(XEN arg1, XEN arg2)
+static Xen gxm_XmListSetPos(Xen arg1, Xen arg2)
{
#define H_XmListSetPos "void XmListSetPos(Widget widget, int position) makes the item at the given position the first \
visible position in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSetPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListSetPos", "int");
- XmListSetPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSetPos", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListSetPos", "int");
+ XmListSetPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListDeselectAllItems(XEN arg1)
+static Xen gxm_XmListDeselectAllItems(Xen arg1)
{
#define H_XmListDeselectAllItems "void XmListDeselectAllItems(Widget widget) unhighlights and removes all items from the selected list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeselectAllItems", "List Widget");
- XmListDeselectAllItems(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeselectAllItems", "List Widget");
+ XmListDeselectAllItems(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmListDeselectPos(XEN arg1, XEN arg2)
+static Xen gxm_XmListDeselectPos(Xen arg1, Xen arg2)
{
#define H_XmListDeselectPos "void XmListDeselectPos(Widget widget, int position) deselects an item at a specified position in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeselectPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListDeselectPos", "int");
- XmListDeselectPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeselectPos", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListDeselectPos", "int");
+ XmListDeselectPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListDeselectItem(XEN arg1, XEN arg2)
+static Xen gxm_XmListDeselectItem(Xen arg1, Xen arg2)
{
#define H_XmListDeselectItem "void XmListDeselectItem(Widget widget, XmString item) deselects the specified item from the selected list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeselectItem", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListDeselectItem", "XmString");
- XmListDeselectItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeselectItem", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListDeselectItem", "XmString");
+ XmListDeselectItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListSelectPos(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmListSelectPos(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmListSelectPos "void XmListSelectPos(Widget widget, int position, Boolean notify) selects an item at a specified \
position in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSelectPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListSelectPos", "int");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmListSelectPos", "boolean");
- XmListSelectPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_BOOLEAN(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSelectPos", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListSelectPos", "int");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmListSelectPos", "boolean");
+ XmListSelectPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_boolean_to_C_bool(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmListSelectItem(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmListSelectItem(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmListSelectItem "void XmListSelectItem(Widget widget, XmString item, Boolean notify) selects an item in the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListSelectItem", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListSelectItem", "XmString");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmListSelectItem", "boolean");
- XmListSelectItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2), XEN_TO_C_BOOLEAN(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListSelectItem", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListSelectItem", "XmString");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmListSelectItem", "boolean");
+ XmListSelectItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2), Xen_boolean_to_C_bool(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmListReplacePositions(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmListReplacePositions(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmListReplacePositions "void XmListReplacePositions(Widget widget, int *position_list, XmString *item_list, int item_count) \
replaces items in a list based on position"
@@ -4607,21 +4542,21 @@ replaces items in a list based on position"
int *ps;
XmString *str;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListReplacePositions", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListReplacePositions", "list of int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XmListReplacePositions", "list of XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg4), arg4, 4, "XmListReplacePositions", "int");
- if (XEN_INTEGER_P(arg4)) len = XEN_TO_C_INT(arg4); else len = XEN_LIST_LENGTH(arg3);
- if (len <= 0) return(XEN_FALSE);
- ps = XEN_TO_C_Ints(arg2, len);
- str = XEN_TO_C_XmStrings(arg3, len);
- XmListReplacePositions(XEN_TO_C_Widget(arg1), ps, str, len);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListReplacePositions", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListReplacePositions", "list of int");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XmListReplacePositions", "list of XmString");
+ Xen_check_type(Xen_is_integer_or_unbound(arg4), arg4, 4, "XmListReplacePositions", "int");
+ if (Xen_is_integer(arg4)) len = Xen_integer_to_C_int(arg4); else len = Xen_list_length(arg3);
+ if (len <= 0) return(Xen_false);
+ ps = Xen_to_C_Ints(arg2, len);
+ str = Xen_to_C_XmStrings(arg3, len);
+ XmListReplacePositions(Xen_to_C_Widget(arg1), ps, str, len);
free(ps);
free(str);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListReplaceItemsPosUnselected(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmListReplaceItemsPosUnselected(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmListReplaceItemsPosUnselected "void XmListReplaceItemsPosUnselected(Widget widget, XmString *new_items, int item_count, int position) \
replaces items in a list without selecting the replacement items"
@@ -4629,19 +4564,19 @@ replaces items in a list without selecting the replacement items"
*/
XmString *str;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListReplaceItemsPosUnselected", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListReplaceItemsPosUnselected", "list of XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListReplaceItemsPosUnselected", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmListReplaceItemsPosUnselected", "int");
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
- str = XEN_TO_C_XmStrings(arg2, len);
- XmListReplaceItemsPosUnselected(XEN_TO_C_Widget(arg1), str, len, XEN_TO_C_INT(arg4));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListReplaceItemsPosUnselected", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListReplaceItemsPosUnselected", "list of XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListReplaceItemsPosUnselected", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmListReplaceItemsPosUnselected", "int");
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
+ str = Xen_to_C_XmStrings(arg2, len);
+ XmListReplaceItemsPosUnselected(Xen_to_C_Widget(arg1), str, len, Xen_integer_to_C_int(arg4));
free(str);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListReplaceItemsUnselected(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmListReplaceItemsUnselected(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmListReplaceItemsUnselected "void XmListReplaceItemsUnselected(Widget widget, XmString *old_items, int item_count, XmString *new_items) \
replaces items in a list"
@@ -4649,21 +4584,21 @@ replaces items in a list"
*/
XmString *str1, *str2;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListReplaceItemsUnselected", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListReplaceItemsUnselected", "list of XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListReplaceItemsUnselected", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XmListReplaceItemsUnselected", "list of XmString");
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
- str1 = XEN_TO_C_XmStrings(arg2, len);
- str2 = XEN_TO_C_XmStrings(arg4, len);
- XmListReplaceItemsUnselected(XEN_TO_C_Widget(arg1), str1, len, str2);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListReplaceItemsUnselected", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListReplaceItemsUnselected", "list of XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListReplaceItemsUnselected", "int");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XmListReplaceItemsUnselected", "list of XmString");
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
+ str1 = Xen_to_C_XmStrings(arg2, len);
+ str2 = Xen_to_C_XmStrings(arg4, len);
+ XmListReplaceItemsUnselected(Xen_to_C_Widget(arg1), str1, len, str2);
free(str1);
free(str2);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListReplaceItemsPos(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmListReplaceItemsPos(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmListReplaceItemsPos "void XmListReplaceItemsPos(Widget widget, XmString *new_items, int item_count, int position) \
replaces the specified elements in the list"
@@ -4671,19 +4606,19 @@ replaces the specified elements in the list"
*/
XmString *str;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListReplaceItemsPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListReplaceItemsPos", "list of XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListReplaceItemsPos", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmListReplaceItemsPos", "int");
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
- str = XEN_TO_C_XmStrings(arg2, len);
- XmListReplaceItemsPos(XEN_TO_C_Widget(arg1), str, len, XEN_TO_C_INT(arg4));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListReplaceItemsPos", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListReplaceItemsPos", "list of XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListReplaceItemsPos", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmListReplaceItemsPos", "int");
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
+ str = Xen_to_C_XmStrings(arg2, len);
+ XmListReplaceItemsPos(Xen_to_C_Widget(arg1), str, len, Xen_integer_to_C_int(arg4));
free(str);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListReplaceItems(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmListReplaceItems(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmListReplaceItems "void XmListReplaceItems(Widget widget, XmString *old_items, int item_count, XmString *new_items) \
replaces the specified elements in the list"
@@ -4691,49 +4626,49 @@ replaces the specified elements in the list"
*/
XmString *str1, *str2;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListReplaceItems", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListReplaceItems", "list of XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListReplaceItems", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XmListReplaceItems", "XmString*");
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
- str1 = XEN_TO_C_XmStrings(arg2, len);
- str2 = XEN_TO_C_XmStrings(arg4, len);
- XmListReplaceItems(XEN_TO_C_Widget(arg1), str1, len, str2);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListReplaceItems", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListReplaceItems", "list of XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListReplaceItems", "int");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XmListReplaceItems", "XmString*");
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
+ str1 = Xen_to_C_XmStrings(arg2, len);
+ str2 = Xen_to_C_XmStrings(arg4, len);
+ XmListReplaceItems(Xen_to_C_Widget(arg1), str1, len, str2);
free(str1);
free(str2);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListDeleteAllItems(XEN arg1)
+static Xen gxm_XmListDeleteAllItems(Xen arg1)
{
#define H_XmListDeleteAllItems "void XmListDeleteAllItems(Widget widget) deletes all items from the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeleteAllItems", "List Widget");
- XmListDeleteAllItems(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeleteAllItems", "List Widget");
+ XmListDeleteAllItems(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmListDeleteItemsPos(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmListDeleteItemsPos(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmListDeleteItemsPos "void XmListDeleteItemsPos(Widget widget, int item_count, int position) deletes \
items from the list starting at the given position"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeleteItemsPos", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListDeleteItemsPos", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListDeleteItemsPos", "int");
- XmListDeleteItemsPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeleteItemsPos", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListDeleteItemsPos", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListDeleteItemsPos", "int");
+ XmListDeleteItemsPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmListDeletePos(XEN arg1, XEN arg2)
+static Xen gxm_XmListDeletePos(Xen arg1, Xen arg2)
{
#define H_XmListDeletePos "void XmListDeletePos(Widget widget, int position) deletes an item from a list at a specified position"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeletePos", "List Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmListDeletePos", "int");
- XmListDeletePos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeletePos", "List Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmListDeletePos", "int");
+ XmListDeletePos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListDeletePositions(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmListDeletePositions(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmListDeletePositions "void XmListDeletePositions(Widget widget, int *position_list, int position_count) deletes \
items from a list based on an array of positions"
@@ -4741,55 +4676,55 @@ items from a list based on an array of positions"
*/
int *pos;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeletePositions", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListDeletePositions", "list of int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmListDeletePositions", "int");
- if (XEN_INTEGER_P(arg3)) len = XEN_TO_C_INT(arg3); else len = XEN_LIST_LENGTH(arg2);
- if (len <= 0) return(XEN_FALSE);
- pos = XEN_TO_C_Ints(arg2, len);
- XmListDeletePositions(XEN_TO_C_Widget(arg1), pos, len);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeletePositions", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListDeletePositions", "list of int");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmListDeletePositions", "int");
+ if (Xen_is_integer(arg3)) len = Xen_integer_to_C_int(arg3); else len = Xen_list_length(arg2);
+ if (len <= 0) return(Xen_false);
+ pos = Xen_to_C_Ints(arg2, len);
+ XmListDeletePositions(Xen_to_C_Widget(arg1), pos, len);
free(pos);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListDeleteItems(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmListDeleteItems(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmListDeleteItems "void XmListDeleteItems(Widget widget, XmString *items, int item_count) deletes items from the list"
/* DIFF: XmListDeleteItems arg 2 is list of XmStrings
*/
XmString *str;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeleteItems", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListDeleteItems", "list of XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmListDeleteItems", "int");
- if (XEN_INTEGER_P(arg3)) len = XEN_TO_C_INT(arg3); else len = XEN_LIST_LENGTH(arg2);
- if (len <= 0) return(XEN_FALSE);
- str = XEN_TO_C_XmStrings(arg2, len);
- XmListDeleteItems(XEN_TO_C_Widget(arg1), str, len);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeleteItems", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListDeleteItems", "list of XmString");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmListDeleteItems", "int");
+ if (Xen_is_integer(arg3)) len = Xen_integer_to_C_int(arg3); else len = Xen_list_length(arg2);
+ if (len <= 0) return(Xen_false);
+ str = Xen_to_C_XmStrings(arg2, len);
+ XmListDeleteItems(Xen_to_C_Widget(arg1), str, len);
free(str);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListDeleteItem(XEN arg1, XEN arg2)
+static Xen gxm_XmListDeleteItem(Xen arg1, Xen arg2)
{
#define H_XmListDeleteItem "void XmListDeleteItem(Widget widget, XmString item) deletes an item from the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListDeleteItem", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListDeleteItem", "XmString");
- XmListDeleteItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListDeleteItem", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListDeleteItem", "XmString");
+ XmListDeleteItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmListAddItemUnselected(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmListAddItemUnselected(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmListAddItemUnselected "void XmListAddItemUnselected(Widget widget, XmString item, int position) adds an item to the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListAddItemUnselected", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListAddItemUnselected", "XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListAddItemUnselected", "int");
- XmListAddItemUnselected(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2), XEN_TO_C_INT(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListAddItemUnselected", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListAddItemUnselected", "XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListAddItemUnselected", "int");
+ XmListAddItemUnselected(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2), Xen_integer_to_C_int(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmListAddItemsUnselected(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmListAddItemsUnselected(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmListAddItemsUnselected "void XmListAddItemsUnselected(Widget widget, XmString *items, int item_count, int position) \
adds items to a list"
@@ -4797,511 +4732,183 @@ adds items to a list"
*/
XmString *str;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListAddItemsUnselected", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListAddItemsUnselected", "list of XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListAddItemsUnselected", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmListAddItemsUnselected", "int");
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
- str = XEN_TO_C_XmStrings(arg2, len);
- XmListAddItemsUnselected(XEN_TO_C_Widget(arg1), str, len, XEN_TO_C_INT(arg4));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListAddItemsUnselected", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListAddItemsUnselected", "list of XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListAddItemsUnselected", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmListAddItemsUnselected", "int");
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
+ str = Xen_to_C_XmStrings(arg2, len);
+ XmListAddItemsUnselected(Xen_to_C_Widget(arg1), str, len, Xen_integer_to_C_int(arg4));
free(str);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListAddItems(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmListAddItems(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmListAddItems "void XmListAddItems(Widget widget, XmString *items, int item_count, int position) adds items to the list"
/* DIFF: XmListAddItems arg 2 is list of XmStrings
*/
XmString *str;
int len;
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListAddItems", "List Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmListAddItems", "XmString*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListAddItems", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmListAddItems", "int");
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
- str = XEN_TO_C_XmStrings(arg2, len);
- XmListAddItems(XEN_TO_C_Widget(arg1), str, len, XEN_TO_C_INT(arg4));
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListAddItems", "List Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmListAddItems", "XmString*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListAddItems", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmListAddItems", "int");
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
+ str = Xen_to_C_XmStrings(arg2, len);
+ XmListAddItems(Xen_to_C_Widget(arg1), str, len, Xen_integer_to_C_int(arg4));
free(str);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmListAddItem(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmListAddItem(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmListAddItem "void XmListAddItem(Widget widget, XmString item, int position) adds an item to the list"
- XEN_ASSERT_TYPE(XEN_ListWidget_P(arg1), arg1, 1, "XmListAddItem", "List Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmListAddItem", "XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmListAddItem", "int");
- XmListAddItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2), XEN_TO_C_INT(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ListWidget(arg1), arg1, 1, "XmListAddItem", "List Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmListAddItem", "XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmListAddItem", "int");
+ XmListAddItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2), Xen_integer_to_C_int(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmIsMotifWMRunning(XEN arg1)
+static Xen gxm_XmIsMotifWMRunning(Xen arg1)
{
#define H_XmIsMotifWMRunning "Boolean XmIsMotifWMRunning(Widget shell) determines whether the window manager is running"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmIsMotifWMRunning", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsMotifWMRunning(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmIsMotifWMRunning", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsMotifWMRunning(Xen_to_C_Widget(arg1))));
}
/* DIFF: all XmCreate<Obj> arglist is a list of args
*/
-static XEN gxm_XmCreateLabel(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateLabel(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateLabel "Widget XmCreateLabel(Widget parent, String name, ArgList arglist, Cardinal argcount) The Label widget creation function"
return(gxm_new_widget("XmCreateLabel", XmCreateLabel, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateLabelGadget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateLabelGadget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateLabelGadget "Widget XmCreateLabelGadget(Widget parent, String name, ArgList arglist, Cardinal argcount) The LabelGadget creation function"
return(gxm_new_widget("XmCreateLabelGadget", XmCreateLabelGadget, arg1, arg2, arg3, arg4));
}
-#if HAVE_XmToolTipGetLabel
-static XEN gxm_XmToolTipGetLabel(XEN arg1)
-{
- #define H_XmToolTipGetLabel "Widget XmToolTipGetLabel(Widget wid) apparently returns the tooltip label associated with its argument"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, XEN_ONLY_ARG, "XmToolTipGetLabel", "Widget");
- return(C_TO_XEN_Widget(XmToolTipGetLabel(XEN_TO_C_Widget(arg1))));
-}
-#endif
-
-#if HAVE_XmCreateTabStack
-
-#ifndef XmIsTabStack
-#define XmIsTabStack(w) (XtIsSubclass(w, xmTabStackWidgetClass))
-#endif
-
-static XEN gxm_XmCreateTabStack(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_XmCreateTabStack "Widget XmCreateTabStack(Widget parent, String name, ArgList arglist, Cardinal argcount) \
-The TabStack widget creation function"
- return(gxm_new_widget("XmCreateTabStack", XmCreateTabStack, arg1, arg2, arg3, arg4));
-}
-
-static XEN gxm_XmIsTabStack(XEN arg)
-{
- #define H_XmIsTabStack "XmIsTabStack(arg): " PROC_TRUE " if arg is a TabStack widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsTabStack", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsTabStack(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmTabStackGetSelectedTab(XEN arg)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmTabStackGetSelectedTab", "Widget");
- return(C_TO_XEN_Widget(XmTabStackGetSelectedTab(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmTabStackSelectTab(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmTabStackSelectTab", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg1), arg1, 2, "XmTabStackSelectTab", "boolean");
- XmTabStackSelectTab(XEN_TO_C_Widget(arg), XEN_TO_C_BOOLEAN(arg1));
- return(XEN_FALSE);
-}
-
-#if HAVE_XmTabStackXYToWidget
-static XEN gxm_XmTabStackIndexToWidget(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmTabStackIndexToWidget", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 2, "XmTabStackIndexToWidget", "int");
- return(XEN_TO_C_Widget(XmTabStackIndexToWidget(XEN_TO_C_Widget(arg), XEN_TO_C_INT(arg1))));
-}
-
-static XEN gxm_XmTabStackXYToWidget(XEN arg, XEN arg1, XEN arg2)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmTabStackXYToWidget", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 2, "XmTabStackXYToWidget", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 3, "XmTabStackXYToWidget", "int");
- return(XEN_TO_C_Widget(XmTabStackXYToWidget(XEN_TO_C_Widget(arg), XEN_TO_C_INT(arg1), XEN_TO_C_INT(arg2))));
-}
-#endif
-#endif
-
-#if HAVE_XmCreateDataField
-
-#ifndef XmIsDataField
-#define XmIsDataField(w) (XtIsSubclass(w, xmDataFieldWidgetClass))
-#endif
-
-static XEN gxm_XmCreateDataField(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_XmCreateDataField "Widget XmCreateDataField(Widget parent, String name, ArgList arglist, Cardinal argcount) \
-The DataField widget creation function"
- return(gxm_new_widget("XmCreateDataField", XmCreateDataField, arg1, arg2, arg3, arg4));
-}
-
-static XEN gxm_XmIsDataField(XEN arg)
-{
- #define H_XmIsDataField "XmIsDataField(arg): " PROC_TRUE " if arg is a DataField widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDataField", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDataField(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmDataFieldGetString(XEN arg)
-{
- char *str;
- XEN rtn;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDataFieldGetString", "Widget");
- str = XmDataFieldGetString(XEN_TO_C_Widget(arg));
- rtn = C_TO_XEN_STRING(str);
- if (str) XtFree(str);
- return(rtn);
-}
-
-static XEN gxm_XmDataFieldGetSelection(XEN arg)
-{
- char *str;
- XEN rtn;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDataFieldGetSelection", "Widget");
- str = XmDataFieldGetSelection(XEN_TO_C_Widget(arg));
- rtn = C_TO_XEN_STRING(str);
- if (str) XtFree(str);
- return(rtn);
-}
-
-static XEN gxm_XmDataFieldPaste(XEN arg)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDataFieldPaste", "Widget");
- return(C_TO_XEN_BOOLEAN(XmDataFieldPaste(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmDataFieldCut(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldCut", "Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg1), arg1, 2, "XmDataFieldCut", "Time");
- return(C_TO_XEN_BOOLEAN(XmDataFieldCut(XEN_TO_C_Widget(arg), XEN_TO_C_Time(arg1))));
-}
-
-static XEN gxm_XmDataFieldCopy(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldCopy", "Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg1), arg1, 2, "XmDataFieldCopy", "Time");
- return(C_TO_XEN_BOOLEAN(XmDataFieldCopy(XEN_TO_C_Widget(arg), XEN_TO_C_Time(arg1))));
-}
-
-static XEN gxm_XmDataFieldSetString(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldSetString", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 2, "XmDataFieldSetString", "char*");
- XmDataFieldSetString(XEN_TO_C_Widget(arg), (char *)XEN_TO_C_STRING(arg1));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmDataFieldSetEditable(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldSetEditable", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg1), arg1, 2, "XmDataFieldSetEditable", "boolean");
- XmDataFieldSetEditable(XEN_TO_C_Widget(arg), XEN_TO_C_BOOLEAN(arg1));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmDataFieldSetAddMode(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldSetAddMode", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg1), arg1, 2, "XmDataFieldSetAddMode", "boolean");
- XmDataFieldSetAddMode(XEN_TO_C_Widget(arg), XEN_TO_C_BOOLEAN(arg1));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmDataFieldSetInsertionPosition(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldSetInsertionPosition", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 2, "XmDataFieldSetInsertionPosition", "int");
- XmDataFieldSetInsertionPosition(XEN_TO_C_Widget(arg), (XmTextPosition)XEN_TO_C_INT(arg1));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmDataFieldShowPosition(XEN arg, XEN arg1)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldShowPosition", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 2, "XmDataFieldShowPosition", "int");
- XmDataFieldShowPosition(XEN_TO_C_Widget(arg), (XmTextPosition)XEN_TO_C_INT(arg1));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmDataFieldXYToPos(XEN arg, XEN arg1, XEN arg2)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldXYToPos", "Widget");
- XEN_ASSERT_TYPE(XEN_Position_P(arg1), arg1, 2, "XmDataFieldXYToPos", "Position");
- XEN_ASSERT_TYPE(XEN_Position_P(arg2), arg2, 3, "XmDataFieldXYToPos", "Position");
- return(C_TO_XEN_INT((int)(XmDataFieldXYToPos(XEN_TO_C_Widget(arg), XEN_TO_C_Position(arg1), XEN_TO_C_Position(arg2)))));
-}
-
-static XEN gxm_XmDataFieldSetHighlight(XEN arg, XEN arg1, XEN arg2, XEN arg3)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldSetHighlight", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 2, "XmDataFieldSetHighlight", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 3, "XmDataFieldSetHighlight", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg3, 4, "XmDataFieldSetHighlight", "int (highligh mode)");
- XmDataFieldSetHighlight(XEN_TO_C_Widget(arg), (XmTextPosition)XEN_TO_C_INT(arg1), (XmTextPosition)XEN_TO_C_INT(arg2),
- (XmHighlightMode)XEN_TO_C_INT(arg3));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmDataFieldSetSelection(XEN arg, XEN arg1, XEN arg2, XEN arg3)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 1, "XmDataFieldSetSelection", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 2, "XmDataFieldSetSelection", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 3, "XmDataFieldSetSelection", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg3, 4, "XmDataFieldSetSelection", "Time");
- XmDataFieldSetSelection(XEN_TO_C_Widget(arg), (XmTextPosition)XEN_TO_C_INT(arg1), (XmTextPosition)XEN_TO_C_INT(arg2), XEN_TO_C_Time(arg3));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XmDataFieldGetSelectionPosition(XEN arg)
-{
- XmTextPosition pos1 = 0, pos2 = 0;
- Boolean val = False;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDataFieldGetSelectionPosition", "Widget");
- val = XmDataFieldGetSelectionPosition(XEN_TO_C_Widget(arg), &pos1, &pos2);
- return(XEN_LIST_3(C_TO_XEN_BOOLEAN(val),
- C_TO_XEN_INT((int)pos1),
- C_TO_XEN_INT((int)pos2)));
-}
-#endif
-
-#if HAVE_XmCreateButtonBox
-static XEN gxm_XmCreateButtonBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_XmCreateButtonBox "Widget XmCreateButtonBox(Widget parent, String name, ArgList arglist, Cardinal argcount) \
-The ButtonBox widget creation function"
- return(gxm_new_widget("XmCreateButtonBox", XmCreateButtonBox, arg1, arg2, arg3, arg4));
-}
-
-#ifndef XmIsButtonBox
-#define XmIsButtonBox(w) (XtIsSubclass(w, xmButtonBoxWidgetClass))
-#endif
-
-static XEN gxm_XmIsButtonBox(XEN arg)
-{
- #define H_XmIsButtonBox "XmIsButtonBox(arg): " PROC_TRUE " if arg is a ButtonBox widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsButtonBox", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsButtonBox(XEN_TO_C_Widget(arg))));
-}
-#endif
-
-#if HAVE_XmCreateColumn
-static XEN gxm_XmCreateColumn(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_XmCreateColumn "Widget XmCreateColumn(Widget parent, String name, ArgList arglist, Cardinal argcount) \
-The Column widget creation function"
- return(gxm_new_widget("XmCreateColumn", XmCreateColumn, arg1, arg2, arg3, arg4));
-}
-
-#ifndef XmIsColumn
-#define XmIsColumn(w) (XtIsSubclass(w, xmColumnWidgetClass))
-#endif
-
-static XEN gxm_XmIsColumn(XEN arg)
-{
- #define H_XmIsColumn "XmIsColumn(arg): " PROC_TRUE " if arg is a Column widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsColumn", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsColumn(XEN_TO_C_Widget(arg))));
-}
-
-#if HAVE_XmColumnGetChildLabel
-static XEN gxm_XmColumnGetChildLabel(XEN arg)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmColumnGetChildLabel", "Widget");
- return(C_TO_XEN_Widget(XmColumnGetChildLabel(XEN_TO_C_Widget(arg))));
-}
-#endif
-#endif
-
-#if HAVE_XmCreateDropDown
-static XEN gxm_XmCreateDropDown(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_XmCreateDropDown "Widget XmCreateDropDown(Widget parent, String name, ArgList arglist, Cardinal argcount) \
-The DropDown widget creation function"
- /* there is a problem here: the XmCreateDropDown macro in DropDown.h does not give us
- function argument access to the actual function. Hence a short-term kludge...
- */
-#ifdef _XmCominationBox2_h
- /* yes, it actually is spelled that way! */
-return(gxm_new_widget("XmCreateDropDown", XmCreateCombinationBox2, arg1, arg2, arg3, arg4));
-#else
- return(gxm_new_widget("XmCreateDropDown", XmCreateDropDown, arg1, arg2, arg3, arg4));
-#endif
-}
-
-#ifndef XmIsDropDown
-#define XmIsDropDown(w) (XtIsSubclass(w, xmDropDownWidgetClass))
-#endif
-
-static XEN gxm_XmIsDropDown(XEN arg)
-{
- #define H_XmIsDropDown "XmIsDropDown(arg): " PROC_TRUE " if arg is a DropDown widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDropDown", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDropDown(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmDropDownGetValue(XEN arg)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDropDownGetValue", "Widget");
- return(C_TO_XEN_STRING((char *)XmDropDownGetValue(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmDropDownGetText(XEN arg)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDropDownGetText", "Widget");
- return(C_TO_XEN_Widget(XmDropDownGetText(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmDropDownGetLabel(XEN arg)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDropDownGetLabel", "Widget");
- return(C_TO_XEN_Widget(XmDropDownGetLabel(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmDropDownGetArrow(XEN arg)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDropDownGetArrow", "Widget");
- return(C_TO_XEN_Widget(XmDropDownGetArrow(XEN_TO_C_Widget(arg))));
-}
-
-static XEN gxm_XmDropDownGetList(XEN arg)
-{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmDropDownGetList", "Widget");
- return(C_TO_XEN_Widget(XmDropDownGetList(XEN_TO_C_Widget(arg))));
-}
-#endif
-
-#if HAVE_XmCreateFontSelector
-static XEN gxm_XmCreateFontSelector(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_XmCreateFontSelector "Widget XmCreateFontSelector(Widget parent, String name, ArgList arglist, Cardinal argcount) \
-The FontSelector widget creation function"
- return(gxm_new_widget("XmCreateFontSelector", XmCreateFontSelector, arg1, arg2, arg3, arg4));
-}
-#endif
-
-#if HAVE_XmCreateColorSelector
-static XEN gxm_XmCreateColorSelector(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
-{
- #define H_XmCreateColorSelector "Widget XmCreateColorSelector(Widget parent, String name, ArgList arglist, Cardinal argcount) \
-The ColorSelector widget creation function"
- return(gxm_new_widget("XmCreateColorSelector", XmCreateColorSelector, arg1, arg2, arg3, arg4));
-}
-#endif
-
-static XEN gxm_XmCreateIconHeader(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateIconHeader(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateIconHeader "Widget XmCreateIconHeader(Widget parent, String name, ArgList arglist, Cardinal argcount)"
return(gxm_new_widget("XmCreateIconHeader", XmCreateIconHeader, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateIconGadget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateIconGadget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateIconGadget "Widget XmCreateIconGadget(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The IconGadget widget creation function"
return(gxm_new_widget("XmCreateIconGadget", XmCreateIconGadget, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateToggleButton(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateToggleButton(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateToggleButton "Widget XmCreateToggleButton(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The ToggleButton widget creation function"
return(gxm_new_widget("XmCreateToggleButton", XmCreateToggleButton, arg1, arg2, arg3, arg4));
}
-#define XEN_ToggleButtonWidget_P(Arg) (XEN_Widget_P(Arg) && (XmIsToggleButton(XEN_TO_C_Widget(Arg)) || XmIsToggleButtonGadget(XEN_TO_C_Widget(Arg))))
+#define Xen_is_ToggleButtonWidget(Arg) (Xen_is_Widget(Arg) && (XmIsToggleButton(Xen_to_C_Widget(Arg)) || XmIsToggleButtonGadget(Xen_to_C_Widget(Arg))))
-static XEN gxm_XmToggleButtonSetValue(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmToggleButtonSetValue(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmToggleButtonSetValue "void XmToggleButtonSetValue(Widget widget, XmToggleButtonState state, Boolean notify) \
sets or changes the current state"
- XEN_ASSERT_TYPE(XEN_ToggleButtonWidget_P(arg1), arg1, 1, "XmToggleButtonSetValue", "ToggleButton Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmToggleButtonSetValue", "int (actually XmToggleButtonState)");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmToggleButtonSetValue", "boolean");
- return(C_TO_XEN_BOOLEAN(XmToggleButtonSetValue(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_BOOLEAN(arg3))));
+ Xen_check_type(Xen_is_ToggleButtonWidget(arg1), arg1, 1, "XmToggleButtonSetValue", "ToggleButton Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmToggleButtonSetValue", "int (actually XmToggleButtonState)");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmToggleButtonSetValue", "boolean");
+ return(C_bool_to_Xen_boolean(XmToggleButtonSetValue(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_boolean_to_C_bool(arg3))));
}
-static XEN gxm_XmToggleButtonSetState(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmToggleButtonSetState(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmToggleButtonSetState "void XmToggleButtonSetState(Widget widget, Boolean state, Boolean notify) \
sets or changes the current state"
- XEN_ASSERT_TYPE(XEN_ToggleButtonWidget_P(arg1), arg1, 1, "XmToggleButtonSetState", "ToggleButton Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmToggleButtonSetState", "boolean");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmToggleButtonSetState", "boolean");
- XmToggleButtonSetState(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2), XEN_TO_C_BOOLEAN(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ToggleButtonWidget(arg1), arg1, 1, "XmToggleButtonSetState", "ToggleButton Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmToggleButtonSetState", "boolean");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmToggleButtonSetState", "boolean");
+ XmToggleButtonSetState(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2), Xen_boolean_to_C_bool(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmToggleButtonGetState(XEN arg1)
+static Xen gxm_XmToggleButtonGetState(Xen arg1)
{
#define H_XmToggleButtonGetState "Boolean XmToggleButtonGetState(Widget widget) obtains the state of a ToggleButton"
- XEN_ASSERT_TYPE(XEN_ToggleButtonWidget_P(arg1), arg1, 1, "XmToggleButtonGetState", "ToggleButton Widget");
- return(C_TO_XEN_BOOLEAN(XmToggleButtonGetState(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_ToggleButtonWidget(arg1), arg1, 1, "XmToggleButtonGetState", "ToggleButton Widget");
+ return(C_bool_to_Xen_boolean(XmToggleButtonGetState(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmCreateToggleButtonGadget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateToggleButtonGadget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateToggleButtonGadget "Widget XmCreateToggleButtonGadget(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The ToggleButtonGadget creation function"
return(gxm_new_widget("XmCreateToggleButtonGadget", XmCreateToggleButtonGadget, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmToggleButtonGadgetSetValue(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmToggleButtonGadgetSetValue(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmToggleButtonGadgetSetValue "Boolean XmToggleButtonGadgetSetValue(Widget w, XmToggleButtonState newstate, Boolean notify)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmToggleButtonGadgetSetValue", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmToggleButtonGadgetSetValue", "int");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmToggleButtonGadgetSetValue", "boolean");
- return(C_TO_XEN_BOOLEAN(XmToggleButtonGadgetSetValue(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_BOOLEAN(arg3))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmToggleButtonGadgetSetValue", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmToggleButtonGadgetSetValue", "int");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmToggleButtonGadgetSetValue", "boolean");
+ return(C_bool_to_Xen_boolean(XmToggleButtonGadgetSetValue(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_boolean_to_C_bool(arg3))));
}
-static XEN gxm_XmCreateGrabShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateGrabShell(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateGrabShell "Widget XmCreateGrabShell(Widget parent, char *name, ArgList al, Cardinal ac): a new GrabShell"
return(gxm_new_widget("XmCreateGrabShell", XmCreateGrabShell, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmToggleButtonGadgetSetState(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmToggleButtonGadgetSetState(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmToggleButtonGadgetSetState "void XmToggleButtonGadgetSetState(Widget widget, Boolean state, Boolean notify) \
sets or changes the current state"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmToggleButtonGadgetSetState", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmToggleButtonGadgetSetState", "boolean");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmToggleButtonGadgetSetState", "boolean");
- XmToggleButtonGadgetSetState(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2), XEN_TO_C_BOOLEAN(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmToggleButtonGadgetSetState", "Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmToggleButtonGadgetSetState", "boolean");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmToggleButtonGadgetSetState", "boolean");
+ XmToggleButtonGadgetSetState(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2), Xen_boolean_to_C_bool(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmToggleButtonGadgetGetState(XEN arg1)
+static Xen gxm_XmToggleButtonGadgetGetState(Xen arg1)
{
#define H_XmToggleButtonGadgetGetState "Boolean XmToggleButtonGadgetGetState(Widget widget) obtains \
the state of a ToggleButtonGadget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmToggleButtonGadgetGetState", "Widget");
- return(C_TO_XEN_BOOLEAN(XmToggleButtonGadgetGetState(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmToggleButtonGadgetGetState", "Widget");
+ return(C_bool_to_Xen_boolean(XmToggleButtonGadgetGetState(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmCreateFrame(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateFrame(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateFrame "Widget XmCreateFrame(Widget parent, String name, ArgList arglist, Cardinal argcount) The Frame widget creation function"
return(gxm_new_widget("XmCreateFrame", XmCreateFrame, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateFormDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateFormDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateFormDialog "Widget XmCreateFormDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
A Form FormDialog creation function"
return(gxm_new_widget("XmCreateFormDialog", XmCreateFormDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateForm(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateForm(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateForm "Widget XmCreateForm(Widget parent, String name, ArgList arglist, Cardinal argcount) The Form widget creation function"
return(gxm_new_widget("XmCreateForm", XmCreateForm, arg1, arg2, arg3, arg4));
}
-#define XEN_TextWidget_P(Arg) (XEN_Widget_P(Arg) && (XmIsText(XEN_TO_C_Widget(Arg)) || XmIsTextField(XEN_TO_C_Widget(Arg))))
-#define XEN_JustTextWidget_P(Arg) (XEN_Widget_P(Arg) && XmIsText(XEN_TO_C_Widget(Arg)))
+#define Xen_is_TextWidget(Arg) (Xen_is_Widget(Arg) && (XmIsText(Xen_to_C_Widget(Arg)) || XmIsTextField(Xen_to_C_Widget(Arg))))
+#define Xen_is_JustTextWidget(Arg) (Xen_is_Widget(Arg) && XmIsText(Xen_to_C_Widget(Arg)))
-static XEN gxm_XmTextFindString(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTextFindString(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTextFindString "Boolean XmTextFindString(Widget widget, XmTextPosition start, char *string, XmTextDirection direction) \
finds the beginning position of a text string"
@@ -5309,88 +4916,88 @@ finds the beginning position of a text string"
*/
XmTextPosition pos;
int res;
- XEN_ASSERT_TYPE(XEN_JustTextWidget_P(arg1), arg1, 1, "XmTextFindString", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFindString", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XmTextFindString", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmTextFindString", "XmTextDirection");
- res = XmTextFindString(XEN_TO_C_Widget(arg1),
- (XmTextPosition)XEN_TO_C_INT(arg2),
- (char *)XEN_TO_C_STRING(arg3),
- (XmTextDirection)XEN_TO_C_INT(arg4),
+ Xen_check_type(Xen_is_JustTextWidget(arg1), arg1, 1, "XmTextFindString", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFindString", "XmTextPosition");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XmTextFindString", "char*");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmTextFindString", "XmTextDirection");
+ res = XmTextFindString(Xen_to_C_Widget(arg1),
+ (XmTextPosition)Xen_integer_to_C_int(arg2),
+ (char *)Xen_string_to_C_string(arg3),
+ (XmTextDirection)Xen_integer_to_C_int(arg4),
&pos);
if (res)
- return(C_TO_XEN_INT(pos));
- return(XEN_FALSE);
+ return(C_int_to_Xen_integer(pos));
+ return(Xen_false);
}
-static XEN gxm_XmTextEnableRedisplay(XEN arg1)
+static Xen gxm_XmTextEnableRedisplay(Xen arg1)
{
#define H_XmTextEnableRedisplay "void XmTextEnableRedisplay(Widget widget) forces the visual update of a Text widget"
- XEN_ASSERT_TYPE(XEN_JustTextWidget_P(arg1), arg1, 1, "XmTextEnableRedisplay", "Text or TextField Widget");
- XmTextEnableRedisplay(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_JustTextWidget(arg1), arg1, 1, "XmTextEnableRedisplay", "Text or TextField Widget");
+ XmTextEnableRedisplay(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmTextDisableRedisplay(XEN arg1)
+static Xen gxm_XmTextDisableRedisplay(Xen arg1)
{
#define H_XmTextDisableRedisplay "void XmTextDisableRedisplay(Widget widget) temporarily prevents visual update of the Text widget"
- XEN_ASSERT_TYPE(XEN_JustTextWidget_P(arg1), arg1, 1, "XmTextDisableRedisplay", "Text or TextField Widget");
- XmTextDisableRedisplay(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_JustTextWidget(arg1), arg1, 1, "XmTextDisableRedisplay", "Text or TextField Widget");
+ XmTextDisableRedisplay(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmTextGetCenterline(XEN arg1)
+static Xen gxm_XmTextGetCenterline(Xen arg1)
{
#define H_XmTextGetCenterline "int XmTextGetCenterline(Widget widget) Return the height (length) of a character string when the writing direction is vertical"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetCenterline", "Text or TextField Widget");
- return(C_TO_XEN_INT(XmTextGetCenterline(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetCenterline", "Text or TextField Widget");
+ return(C_int_to_Xen_integer(XmTextGetCenterline(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextGetBaseline(XEN arg1)
+static Xen gxm_XmTextGetBaseline(Xen arg1)
{
#define H_XmTextGetBaseline "int XmTextGetBaseline(Widget widget) accesses the y position of the baseline"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetBaseline", "Text or TextField Widget");
- return(C_TO_XEN_INT(XmTextGetBaseline(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetBaseline", "Text or TextField Widget");
+ return(C_int_to_Xen_integer(XmTextGetBaseline(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextScroll(XEN arg1, XEN arg2)
+static Xen gxm_XmTextScroll(Xen arg1, Xen arg2)
{
#define H_XmTextScroll "void XmTextScroll(Widget widget, int lines) scrolls text"
- XEN_ASSERT_TYPE(XEN_JustTextWidget_P(arg1), arg1, 1, "XmTextScroll", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextScroll", "int");
- XmTextScroll(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_JustTextWidget(arg1), arg1, 1, "XmTextScroll", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextScroll", "int");
+ XmTextScroll(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextShowPosition(XEN arg1, XEN arg2)
+static Xen gxm_XmTextShowPosition(Xen arg1, Xen arg2)
{
#define H_XmTextShowPosition "void XmTextShowPosition(Widget widget, XmTextPosition position) forces text at a given position to be displayed"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextShowPosition", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextShowPosition", "XmTextPosition");
- XmTextShowPosition(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextShowPosition", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextShowPosition", "XmTextPosition");
+ XmTextShowPosition(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextSetSource(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTextSetSource(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTextSetSource "void XmTextSetSource(Widget widget, XmTextSource source, XmTextPosition top_character, \
XmTextPosition cursor_position) sets the source of the widget"
- XEN_ASSERT_TYPE(XEN_JustTextWidget_P(arg1), arg1, 1, "XmTextSetSource", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_XmTextSource_P(arg2), arg2, 2, "XmTextSetSource", "XmTextSource");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextSetSource", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmTextSetSource", "XmTextPosition");
- XmTextSetSource(XEN_TO_C_Widget(arg1), XEN_TO_C_XmTextSource(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_JustTextWidget(arg1), arg1, 1, "XmTextSetSource", "Text or TextField Widget");
+ Xen_check_type(Xen_is_XmTextSource(arg2), arg2, 2, "XmTextSetSource", "XmTextSource");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextSetSource", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmTextSetSource", "XmTextPosition");
+ XmTextSetSource(Xen_to_C_Widget(arg1), Xen_to_C_XmTextSource(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmTextGetSource(XEN arg1)
+static Xen gxm_XmTextGetSource(Xen arg1)
{
#define H_XmTextGetSource "XmTextSource XmTextGetSource(Widget widget) accesses the source of the widget"
- XEN_ASSERT_TYPE(XEN_JustTextWidget_P(arg1), arg1, 1, "XmTextGetSource", "Text or TextField Widget");
- return(C_TO_XEN_XmTextSource(XmTextGetSource(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_JustTextWidget(arg1), arg1, 1, "XmTextGetSource", "Text or TextField Widget");
+ return(C_to_Xen_XmTextSource(XmTextGetSource(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextPosToXY(XEN arg1, XEN arg2)
+static Xen gxm_XmTextPosToXY(Xen arg1, Xen arg2)
{
#define H_XmTextPosToXY "Boolean XmTextPosToXY(Widget widget, XmTextPosition position) A Text function \
that returns the x and y position of a character position"
@@ -5398,500 +5005,500 @@ that returns the x and y position of a character position"
*/
Position x, y;
int val;
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextPosToXY", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextPosToXY", "XmTextPosition");
- val = XmTextPosToXY(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), &x, &y);
- return(XEN_LIST_3(C_TO_XEN_BOOLEAN(val),
- C_TO_XEN_Position(x),
- C_TO_XEN_Position(y)));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextPosToXY", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextPosToXY", "XmTextPosition");
+ val = XmTextPosToXY(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), &x, &y);
+ return(Xen_list_3(C_bool_to_Xen_boolean(val),
+ C_to_Xen_Position(x),
+ C_to_Xen_Position(y)));
}
-static XEN gxm_XmTextXYToPos(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTextXYToPos(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmTextXYToPos "XmTextPosition XmTextXYToPos(Widget widget, Position x, Position y) accesses \
the character position nearest an x and y position"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextXYToPos", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextXYToPos", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextXYToPos", "int");
- return(C_TO_XEN_INT(XmTextXYToPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextXYToPos", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextXYToPos", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextXYToPos", "int");
+ return(C_int_to_Xen_integer(XmTextXYToPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XmTextGetSelectionPosition(XEN arg1)
+static Xen gxm_XmTextGetSelectionPosition(Xen arg1)
{
#define H_XmTextGetSelectionPosition "Boolean XmTextGetSelectionPosition(Widget widget): returns the position of the primary selection"
/* DIFF: XmTextGetSelectionPosition widget [left right] -> (list res left right)
no arg2 arg3, returns (owner left right) instead */
XmTextPosition pos1, pos2;
int res;
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetSelectionPosition", "Text or TextField Widget");
- res = XmTextGetSelectionPosition(XEN_TO_C_Widget(arg1), &pos1, &pos2);
- return(XEN_LIST_3(C_TO_XEN_BOOLEAN(res),
- C_TO_XEN_INT(pos1),
- C_TO_XEN_INT(pos2)));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetSelectionPosition", "Text or TextField Widget");
+ res = XmTextGetSelectionPosition(Xen_to_C_Widget(arg1), &pos1, &pos2);
+ return(Xen_list_3(C_bool_to_Xen_boolean(res),
+ C_int_to_Xen_integer(pos1),
+ C_int_to_Xen_integer(pos2)));
}
-static XEN gxm_XmTextClearSelection(XEN arg1, XEN arg2)
+static Xen gxm_XmTextClearSelection(Xen arg1, Xen arg2)
{
#define H_XmTextClearSelection "void XmTextClearSelection(Widget widget, Time time) clears the primary selection"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextClearSelection", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTextClearSelection", "Time");
- XmTextClearSelection(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextClearSelection", "Text or TextField Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTextClearSelection", "Time");
+ XmTextClearSelection(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextSetSelection(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTextSetSelection(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTextSetSelection "void XmTextSetSelection(Widget widget, XmTextPosition first, XmTextPosition last, Time time) \
sets the primary selection of the text"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextSetSelection", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextSetSelection", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextSetSelection", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_Time_P(arg4), arg4, 4, "XmTextSetSelection", "Time");
- XmTextSetSelection(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_Time(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextSetSelection", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextSetSelection", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextSetSelection", "XmTextPosition");
+ Xen_check_type(Xen_is_Time(arg4), arg4, 4, "XmTextSetSelection", "Time");
+ XmTextSetSelection(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_to_C_Time(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmTextGetSelection(XEN arg1)
+static Xen gxm_XmTextGetSelection(Xen arg1)
{
char *str;
- XEN res;
+ Xen res;
#define H_XmTextGetSelection "char *XmTextGetSelection(Widget widget) retrieves the value of the primary selection"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetSelection", "Text or TextField Widget");
- str = XmTextGetSelection(XEN_TO_C_Widget(arg1));
- res = C_TO_XEN_STRING(str);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetSelection", "Text or TextField Widget");
+ str = XmTextGetSelection(Xen_to_C_Widget(arg1));
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XmTextPasteLink(XEN arg1)
+static Xen gxm_XmTextPasteLink(Xen arg1)
{
#define H_XmTextPasteLink "Boolean XmTextPasteLink(Widget widget) inserts a link to the clipboard selection"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextPasteLink", "Text or TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextPasteLink(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextPasteLink", "Text or TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextPasteLink(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextPaste(XEN arg1)
+static Xen gxm_XmTextPaste(Xen arg1)
{
#define H_XmTextPaste "Boolean XmTextPaste(Widget widget) inserts the clipboard selection"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextPaste", "Text or TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextPaste(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextPaste", "Text or TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextPaste(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextCut(XEN arg1, XEN arg2)
+static Xen gxm_XmTextCut(Xen arg1, Xen arg2)
{
#define H_XmTextCut "Boolean XmTextCut(Widget widget, Time time) copies the primary selection to the clipboard and deletes the selected text"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextCut", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTextCut", "Time");
- return(C_TO_XEN_BOOLEAN(XmTextCut(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextCut", "Text or TextField Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTextCut", "Time");
+ return(C_bool_to_Xen_boolean(XmTextCut(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmTextCopyLink(XEN arg1, XEN arg2)
+static Xen gxm_XmTextCopyLink(Xen arg1, Xen arg2)
{
#define H_XmTextCopyLink "Boolean XmTextCopyLink(Widget widget, Time time) copies a link to the primary selection to the clipboard"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextCopyLink", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTextCopyLink", "Time");
- return(C_TO_XEN_BOOLEAN(XmTextCopyLink(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextCopyLink", "Text or TextField Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTextCopyLink", "Time");
+ return(C_bool_to_Xen_boolean(XmTextCopyLink(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmTextCopy(XEN arg1, XEN arg2)
+static Xen gxm_XmTextCopy(Xen arg1, Xen arg2)
{
#define H_XmTextCopy "Boolean XmTextCopy(Widget widget, Time time) copies the primary selection to the clipboard"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextCopy", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTextCopy", "Time");
- return(C_TO_XEN_BOOLEAN(XmTextCopy(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextCopy", "Text or TextField Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTextCopy", "Time");
+ return(C_bool_to_Xen_boolean(XmTextCopy(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmTextRemove(XEN arg1)
+static Xen gxm_XmTextRemove(Xen arg1)
{
#define H_XmTextRemove "Boolean XmTextRemove(Widget widget) deletes the primary selection"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextRemove", "Text or TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextRemove(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextRemove", "Text or TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextRemove(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextSetCursorPosition(XEN arg1, XEN arg2)
+static Xen gxm_XmTextSetCursorPosition(Xen arg1, Xen arg2)
{
#define H_XmTextSetCursorPosition "void XmTextSetCursorPosition(Widget w, int position) sets the insertion cursor position"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextSetCursorPosition", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextSetCursorPosition", "XmTextPosition");
- XmTextSetCursorPosition(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextSetCursorPosition", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextSetCursorPosition", "XmTextPosition");
+ XmTextSetCursorPosition(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextSetInsertionPosition(XEN arg1, XEN arg2)
+static Xen gxm_XmTextSetInsertionPosition(Xen arg1, Xen arg2)
{
#define H_XmTextSetInsertionPosition "void XmTextSetInsertionPosition(Widget widget, XmTextPosition position) \
sets the position of the insert cursor"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextSetInsertionPosition", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextSetInsertionPosition", "XmTextPosition");
- XmTextSetInsertionPosition(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextSetInsertionPosition", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextSetInsertionPosition", "XmTextPosition");
+ XmTextSetInsertionPosition(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextGetInsertionPosition(XEN arg1)
+static Xen gxm_XmTextGetInsertionPosition(Xen arg1)
{
#define H_XmTextGetInsertionPosition "XmTextPosition XmTextGetInsertionPosition(Widget widget) accesses the \
position of the insert cursor"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetInsertionPosition", "Text or TextField Widget");
- return(C_TO_XEN_INT(XmTextGetInsertionPosition(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetInsertionPosition", "Text or TextField Widget");
+ return(C_int_to_Xen_integer(XmTextGetInsertionPosition(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextGetCursorPosition(XEN arg1)
+static Xen gxm_XmTextGetCursorPosition(Xen arg1)
{
#define H_XmTextGetCursorPosition "int XmTextGetCursorPosition(Widget w) presumably returns the widget's insertion cursor position"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetCursorPosition", "Text or TextField Widget");
- return(C_TO_XEN_INT(XmTextGetCursorPosition(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetCursorPosition", "Text or TextField Widget");
+ return(C_int_to_Xen_integer(XmTextGetCursorPosition(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextSetTopCharacter(XEN arg1, XEN arg2)
+static Xen gxm_XmTextSetTopCharacter(Xen arg1, Xen arg2)
{
#define H_XmTextSetTopCharacter "void XmTextSetTopCharacter(Widget widget, XmTextPosition top_character) sets \
the position of the first character displayed"
- XEN_ASSERT_TYPE(XEN_JustTextWidget_P(arg1), arg1, 1, "XmTextSetTopCharacter", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextSetTopCharacter", "XmTextPosition");
- XmTextSetTopCharacter(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_JustTextWidget(arg1), arg1, 1, "XmTextSetTopCharacter", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextSetTopCharacter", "XmTextPosition");
+ XmTextSetTopCharacter(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextGetTopCharacter(XEN arg1)
+static Xen gxm_XmTextGetTopCharacter(Xen arg1)
{
#define H_XmTextGetTopCharacter "XmTextPosition XmTextGetTopCharacter(Widget widget) accesses the position of the first character displayed"
- XEN_ASSERT_TYPE(XEN_JustTextWidget_P(arg1), arg1, 1, "XmTextGetTopCharacter", "Text or TextField Widget");
- return(C_TO_XEN_INT(XmTextGetTopCharacter(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_JustTextWidget(arg1), arg1, 1, "XmTextGetTopCharacter", "Text or TextField Widget");
+ return(C_int_to_Xen_integer(XmTextGetTopCharacter(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextSetMaxLength(XEN arg1, XEN arg2)
+static Xen gxm_XmTextSetMaxLength(Xen arg1, Xen arg2)
{
#define H_XmTextSetMaxLength "void XmTextSetMaxLength(Widget widget, int max_length) sets the value of the current \
maximum allowable length of a text string entered from the keyboard"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextSetMaxLength", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextSetMaxLength", "int");
- XmTextSetMaxLength(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextSetMaxLength", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextSetMaxLength", "int");
+ XmTextSetMaxLength(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextGetMaxLength(XEN arg1)
+static Xen gxm_XmTextGetMaxLength(Xen arg1)
{
#define H_XmTextGetMaxLength "int XmTextGetMaxLength(Widget widget) accesses the value of the current maximum allowable \
length of a text string entered from the keyboard"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetMaxLength", "Text or TextField Widget");
- return(C_TO_XEN_INT(XmTextGetMaxLength(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetMaxLength", "Text or TextField Widget");
+ return(C_int_to_Xen_integer(XmTextGetMaxLength(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextSetEditable(XEN arg1, XEN arg2)
+static Xen gxm_XmTextSetEditable(Xen arg1, Xen arg2)
{
#define H_XmTextSetEditable "void XmTextSetEditable(Widget widget, Boolean editable) sets the edit permission"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextSetEditable", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmTextSetEditable", "boolean");
- XmTextSetEditable(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextSetEditable", "Text or TextField Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmTextSetEditable", "boolean");
+ XmTextSetEditable(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextGetEditable(XEN arg1)
+static Xen gxm_XmTextGetEditable(Xen arg1)
{
#define H_XmTextGetEditable "Boolean XmTextGetEditable(Widget widget) accesses the edit permission state"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetEditable", "Text or TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextGetEditable(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetEditable", "Text or TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextGetEditable(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextGetAddMode(XEN arg1)
+static Xen gxm_XmTextGetAddMode(Xen arg1)
{
#define H_XmTextGetAddMode "Boolean XmTextGetAddMode(Widget w) presumably returns the widget's current add mode."
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetAddMode", "Text or TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextGetAddMode(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetAddMode", "Text or TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextGetAddMode(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextSetAddMode(XEN arg1, XEN arg2)
+static Xen gxm_XmTextSetAddMode(Xen arg1, Xen arg2)
{
#define H_XmTextSetAddMode "void XmTextSetAddMode(Widget widget, Boolean state) sets the widget's add mode -- \
this determines whether you can move the insertion cursor without changing the primary selection"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextSetAddMode", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmTextSetAddMode", "boolean");
- XmTextSetAddMode(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextSetAddMode", "Text or TextField Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmTextSetAddMode", "boolean");
+ XmTextSetAddMode(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextInsert(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTextInsert(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmTextInsert "void XmTextInsert(Widget widget, XmTextPosition position, char *value) inserts a character \
string into a text string"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextInsert", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextInsert", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XmTextInsert", "char*");
- XmTextInsert(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), (char *)XEN_TO_C_STRING(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextInsert", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextInsert", "XmTextPosition");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XmTextInsert", "char*");
+ XmTextInsert(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), (char *)Xen_string_to_C_string(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmTextReplace(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTextReplace(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTextReplace "void XmTextReplace(Widget widget, XmTextPosition from_pos, XmTextPosition to_pos, char *value) \
replaces part of a text string"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextReplace", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextReplace", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextReplace", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XmTextReplace", "char*");
- XmTextReplace(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), (char *)XEN_TO_C_STRING(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextReplace", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextReplace", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextReplace", "XmTextPosition");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XmTextReplace", "char*");
+ XmTextReplace(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), (char *)Xen_string_to_C_string(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmTextSetString(XEN arg1, XEN arg2)
+static Xen gxm_XmTextSetString(Xen arg1, Xen arg2)
{
#define H_XmTextSetString "void XmTextSetString(Widget widget, char *value) sets the string value"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextSetString", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmTextSetString", "char*");
- XmTextSetString(XEN_TO_C_Widget(arg1), (char *)XEN_TO_C_STRING(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextSetString", "Text or TextField Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmTextSetString", "char*");
+ XmTextSetString(Xen_to_C_Widget(arg1), (char *)Xen_string_to_C_string(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextGetLastPosition(XEN arg1)
+static Xen gxm_XmTextGetLastPosition(Xen arg1)
{
#define H_XmTextGetLastPosition "XmTextPosition XmTextGetLastPosition(Widget widget) accesses the last position in the text"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetLastPosition", "Text or TextField Widget");
- return(C_TO_XEN_INT(XmTextGetLastPosition(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetLastPosition", "Text or TextField Widget");
+ return(C_int_to_Xen_integer(XmTextGetLastPosition(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextGetString(XEN arg1)
+static Xen gxm_XmTextGetString(Xen arg1)
{
char *str;
- XEN res;
+ Xen res;
#define H_XmTextGetString "char *XmTextGetString(Widget widget) accesses the string value"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetString", "Text or TextField Widget");
- str = XmTextGetString(XEN_TO_C_Widget(arg1));
- res = C_TO_XEN_STRING(str);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetString", "Text or TextField Widget");
+ str = XmTextGetString(Xen_to_C_Widget(arg1));
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XmTextGetSubstring(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTextGetSubstring(Xen arg1, Xen arg2, Xen arg3)
{
/* DIFF: omit and rtn last 2 args */
#define H_XmTextGetSubstring "int XmTextGetSubstring(Widget widget, XmTextPosition start, int num_chars) \
retrieves a copy of a portion of the internal text buffer"
int rtn, len;
char *buf;
- XEN str = XEN_FALSE;
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextGetSubstring", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextGetSubstring", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextGetSubstring", "int");
- len = XEN_TO_C_INT(arg3);
+ Xen str = Xen_false;
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextGetSubstring", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextGetSubstring", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextGetSubstring", "int");
+ len = Xen_integer_to_C_int(arg3);
buf = (char *)calloc(len + 1, sizeof(char));
- rtn = XmTextGetSubstring(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), len, len + 1, buf);
+ rtn = XmTextGetSubstring(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), len, len + 1, buf);
if (rtn != XmCOPY_FAILED)
- str = C_TO_XEN_STRING(buf);
+ str = C_string_to_Xen_string(buf);
free(buf);
return(str);
}
-static XEN gxm_XmCreateText(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateText(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateText "Widget XmCreateText(Widget parent, String name, ArgList arglist, Cardinal argcount) The Text widget creation function"
return(gxm_new_widget("XmCreateText", XmCreateText, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateScrolledText(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateScrolledText(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateScrolledText "Widget XmCreateScrolledText(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The Text ScrolledText creation function"
return(gxm_new_widget("XmCreateScrolledText", XmCreateScrolledText, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmTextSetHighlight(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTextSetHighlight(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTextSetHighlight "void XmTextSetHighlight(Widget widget, XmTextPosition left, XmTextPosition right, XmHighlightMode mode) \
highlights text"
- XEN_ASSERT_TYPE(XEN_TextWidget_P(arg1), arg1, 1, "XmTextSetHighlight", "Text or TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextSetHighlight", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextSetHighlight", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmTextSetHighlight", "XmHighlightMode");
- XmTextSetHighlight(XEN_TO_C_Widget(arg1),
- (XmTextPosition)XEN_TO_C_INT(arg2),
- (XmTextPosition)XEN_TO_C_INT(arg3),
- (XmHighlightMode)XEN_TO_C_INT(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextWidget(arg1), arg1, 1, "XmTextSetHighlight", "Text or TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextSetHighlight", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextSetHighlight", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmTextSetHighlight", "XmHighlightMode");
+ XmTextSetHighlight(Xen_to_C_Widget(arg1),
+ (XmTextPosition)Xen_integer_to_C_int(arg2),
+ (XmTextPosition)Xen_integer_to_C_int(arg3),
+ (XmHighlightMode)Xen_integer_to_C_int(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmCreateFileSelectionDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateFileSelectionDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateFileSelectionDialog "Widget XmCreateFileSelectionDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The FileSelectionBox FileSelectionDialog creation function"
return(gxm_new_widget("XmCreateFileSelectionDialog", XmCreateFileSelectionDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateFileSelectionBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateFileSelectionBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateFileSelectionBox "Widget XmCreateFileSelectionBox(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The FileSelectionBox widget creation function"
return(gxm_new_widget("XmCreateFileSelectionBox", XmCreateFileSelectionBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmFileSelectionDoSearch(XEN arg1, XEN arg2)
+static Xen gxm_XmFileSelectionDoSearch(Xen arg1, Xen arg2)
{
#define H_XmFileSelectionDoSearch "void XmFileSelectionDoSearch(Widget widget, XmString dirmask) \
initiates a directory search"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmFileSelectionDoSearch", "Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2) || XEN_FALSE_P(arg2), arg2, 2, "XmFileSelectionDoSearch", "XmString");
- XmFileSelectionDoSearch(XEN_TO_C_Widget(arg1), XEN_FALSE_P(arg2) ? NULL : XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmFileSelectionDoSearch", "Widget");
+ Xen_check_type(Xen_is_XmString(arg2) || Xen_is_false(arg2), arg2, 2, "XmFileSelectionDoSearch", "XmString");
+ XmFileSelectionDoSearch(Xen_to_C_Widget(arg1), Xen_is_false(arg2) ? NULL : Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmFileSelectionBoxGetChild(XEN arg1, XEN arg2)
+static Xen gxm_XmFileSelectionBoxGetChild(Xen arg1, Xen arg2)
{
#define H_XmFileSelectionBoxGetChild "Widget XmFileSelectionBoxGetChild(Widget widget, unsigned char child) \
used to access a component"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmFileSelectionBoxGetChild", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XmFileSelectionBoxGetChild", "unsigned int");
- return(C_TO_XEN_Widget(XmFileSelectionBoxGetChild(XEN_TO_C_Widget(arg1), XEN_TO_C_ULONG(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmFileSelectionBoxGetChild", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XmFileSelectionBoxGetChild", "unsigned int");
+ return(C_to_Xen_Widget(XmFileSelectionBoxGetChild(Xen_to_C_Widget(arg1), Xen_ulong_to_C_ulong(arg2))));
}
-static XEN gxm_XmCreateTextField(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateTextField(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateTextField "Widget XmCreateTextField(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The TextField widget creation function"
return(gxm_new_widget("XmCreateTextField", XmCreateTextField, arg1, arg2, arg3, arg4));
}
-#define XEN_TextFieldWidget_P(Arg) (XEN_Widget_P(Arg) && XmIsTextField(XEN_TO_C_Widget(Arg)))
+#define Xen_is_TextFieldWidget(Arg) (Xen_is_Widget(Arg) && XmIsTextField(Xen_to_C_Widget(Arg)))
-static XEN gxm_XmTextFieldGetBaseline(XEN arg1)
+static Xen gxm_XmTextFieldGetBaseline(Xen arg1)
{
#define H_XmTextFieldGetBaseline "int XmTextFieldGetBaseline(Widget widget) accesses the y position of the baseline"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetBaseline", "TextField Widget");
- return(C_TO_XEN_INT(XmTextFieldGetBaseline(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetBaseline", "TextField Widget");
+ return(C_int_to_Xen_integer(XmTextFieldGetBaseline(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldSetHighlight(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTextFieldSetHighlight(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTextFieldSetHighlight "void XmTextFieldSetHighlight(Widget widget, XmTextPosition left, XmTextPosition right, XmHighlightMode mode) \
highlights text"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldSetHighlight", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldSetHighlight", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextFieldSetHighlight", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmTextFieldSetHighlight", "XmHighlightMode");
- XmTextFieldSetHighlight(XEN_TO_C_Widget(arg1),
- (XmTextPosition)XEN_TO_C_INT(arg2),
- (XmTextPosition)XEN_TO_C_INT(arg3),
- (XmHighlightMode)XEN_TO_C_INT(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldSetHighlight", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldSetHighlight", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextFieldSetHighlight", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmTextFieldSetHighlight", "XmHighlightMode");
+ XmTextFieldSetHighlight(Xen_to_C_Widget(arg1),
+ (XmTextPosition)Xen_integer_to_C_int(arg2),
+ (XmTextPosition)Xen_integer_to_C_int(arg3),
+ (XmHighlightMode)Xen_integer_to_C_int(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldShowPosition(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldShowPosition(Xen arg1, Xen arg2)
{
#define H_XmTextFieldShowPosition "void XmTextFieldShowPosition(Widget widget, XmTextPosition position) \
forces text at a given position to be displayed"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldShowPosition", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldShowPosition", "XmTextPosition");
- XmTextFieldShowPosition(XEN_TO_C_Widget(arg1),
- (XmTextPosition)XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldShowPosition", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldShowPosition", "XmTextPosition");
+ XmTextFieldShowPosition(Xen_to_C_Widget(arg1),
+ (XmTextPosition)Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldPosToXY(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldPosToXY(Xen arg1, Xen arg2)
{
#define H_XmTextFieldPosToXY "Boolean XmTextFieldPosToXY(Widget widget, XmTextPosition position): returns the x and y position of a character position"
/* DIFF: XmTextFieldPosToXY omits last 2 args and returns them
*/
Position x, y;
int val;
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldPosToXY", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldPosToXY", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmTextPosToXY", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextPosToXY", "XmTextPosition");
- val = XmTextFieldPosToXY(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), &x, &y);
- return(XEN_LIST_3(C_TO_XEN_BOOLEAN(val),
- C_TO_XEN_Position(x),
- C_TO_XEN_Position(y)));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldPosToXY", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldPosToXY", "XmTextPosition");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmTextPosToXY", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextPosToXY", "XmTextPosition");
+ val = XmTextFieldPosToXY(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), &x, &y);
+ return(Xen_list_3(C_bool_to_Xen_boolean(val),
+ C_to_Xen_Position(x),
+ C_to_Xen_Position(y)));
}
-static XEN gxm_XmTextFieldXYToPos(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTextFieldXYToPos(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmTextFieldXYToPos "XmTextPosition XmTextFieldXYToPos(Widget widget, Position x, Position y) \
accesses the character position nearest an x and y position"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldXYToPos", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldXYToPos", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextFieldXYToPos", "int");
- return(C_TO_XEN_INT(XmTextFieldXYToPos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldXYToPos", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldXYToPos", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextFieldXYToPos", "int");
+ return(C_int_to_Xen_integer(XmTextFieldXYToPos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XmTextFieldSetSelection(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTextFieldSetSelection(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTextFieldSetSelection "void XmTextFieldSetSelection(Widget widget, XmTextPosition first, XmTextPosition last, Time time) \
sets the primary selection of the text"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldSetSelection", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldSetSelection", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextFieldSetSelection", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_Time_P(arg4), arg4, 4, "XmTextFieldSetSelection", "Time");
- XmTextFieldSetSelection(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_Time(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldSetSelection", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldSetSelection", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextFieldSetSelection", "XmTextPosition");
+ Xen_check_type(Xen_is_Time(arg4), arg4, 4, "XmTextFieldSetSelection", "Time");
+ XmTextFieldSetSelection(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_to_C_Time(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldClearSelection(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldClearSelection(Xen arg1, Xen arg2)
{
#define H_XmTextFieldClearSelection "void XmTextFieldClearSelection(Widget widget, Time time) clears the primary selection"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldClearSelection", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTextFieldClearSelection", "Time");
- XmTextFieldClearSelection(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldClearSelection", "TextField Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTextFieldClearSelection", "Time");
+ XmTextFieldClearSelection(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldPasteLink(XEN arg1)
+static Xen gxm_XmTextFieldPasteLink(Xen arg1)
{
#define H_XmTextFieldPasteLink "Boolean XmTextFieldPasteLink(Widget widget) inserts a link to the clipboard selection"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldPasteLink", "TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextFieldPasteLink(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldPasteLink", "TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextFieldPasteLink(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldCopyLink(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldCopyLink(Xen arg1, Xen arg2)
{
#define H_XmTextFieldCopyLink "Boolean XmTextFieldCopyLink(Widget widget, Time time) copies a link to the \
primary selection to the clipboard"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldCopyLink", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTextFieldCopyLink", "Time");
- return(C_TO_XEN_BOOLEAN(XmTextFieldCopyLink(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldCopyLink", "TextField Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTextFieldCopyLink", "Time");
+ return(C_bool_to_Xen_boolean(XmTextFieldCopyLink(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmTextFieldPaste(XEN arg1)
+static Xen gxm_XmTextFieldPaste(Xen arg1)
{
#define H_XmTextFieldPaste "Boolean XmTextFieldPaste(Widget widget) inserts the clipboard selection"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldPaste", "TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextFieldPaste(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldPaste", "TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextFieldPaste(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldCut(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldCut(Xen arg1, Xen arg2)
{
#define H_XmTextFieldCut "Boolean XmTextFieldCut(Widget widget, Time time) copies the primary selection \
to the clipboard and deletes the selected text"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldCut", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTextFieldCut", "Time");
- return(C_TO_XEN_BOOLEAN(XmTextFieldCut(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldCut", "TextField Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTextFieldCut", "Time");
+ return(C_bool_to_Xen_boolean(XmTextFieldCut(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmTextFieldCopy(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldCopy(Xen arg1, Xen arg2)
{
#define H_XmTextFieldCopy "Boolean XmTextFieldCopy(Widget widget, Time time) copies the primary selection to the clipboard"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldCopy", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmTextFieldCopy", "Time");
- return(C_TO_XEN_BOOLEAN(XmTextFieldCopy(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldCopy", "TextField Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmTextFieldCopy", "Time");
+ return(C_bool_to_Xen_boolean(XmTextFieldCopy(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmTextFieldRemove(XEN arg1)
+static Xen gxm_XmTextFieldRemove(Xen arg1)
{
#define H_XmTextFieldRemove "Boolean XmTextFieldRemove(Widget widget) deletes the primary selection"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldRemove", "TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextFieldRemove(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldRemove", "TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextFieldRemove(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldGetSelection(XEN arg1)
+static Xen gxm_XmTextFieldGetSelection(Xen arg1)
{
char *str;
- XEN res;
+ Xen res;
#define H_XmTextFieldGetSelection "char *XmTextFieldGetSelection(Widget widget) retrieves the value of the primary selection"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetSelection", "TextField Widget");
- str = XmTextFieldGetSelection(XEN_TO_C_Widget(arg1));
- res = C_TO_XEN_STRING(str);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetSelection", "TextField Widget");
+ str = XmTextFieldGetSelection(Xen_to_C_Widget(arg1));
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XmTextFieldGetSelectionPosition(XEN arg1)
+static Xen gxm_XmTextFieldGetSelectionPosition(Xen arg1)
{
#define H_XmTextFieldGetSelectionPosition "Boolean XmTextFieldGetSelectionPosition(Widget widget) \
returns the position of the primary selection"
@@ -5900,172 +5507,172 @@ returns the position of the primary selection"
*/
XmTextPosition pos1, pos2;
int res;
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetSelectionPosition", "TextField Widget");
- res = XmTextFieldGetSelectionPosition(XEN_TO_C_Widget(arg1), &pos1, &pos2);
- return(XEN_LIST_3(C_TO_XEN_BOOLEAN(res),
- C_TO_XEN_INT(pos1),
- C_TO_XEN_INT(pos2)));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetSelectionPosition", "TextField Widget");
+ res = XmTextFieldGetSelectionPosition(Xen_to_C_Widget(arg1), &pos1, &pos2);
+ return(Xen_list_3(C_bool_to_Xen_boolean(res),
+ C_int_to_Xen_integer(pos1),
+ C_int_to_Xen_integer(pos2)));
}
-static XEN gxm_XmTextFieldSetInsertionPosition(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldSetInsertionPosition(Xen arg1, Xen arg2)
{
#define H_XmTextFieldSetInsertionPosition "void XmTextFieldSetInsertionPosition(Widget widget, XmTextPosition position) \
sets the position of the insertion cursor"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldSetInsertionPosition", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldSetInsertionPosition", "XmTextPosition");
- XmTextFieldSetInsertionPosition(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldSetInsertionPosition", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldSetInsertionPosition", "XmTextPosition");
+ XmTextFieldSetInsertionPosition(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldSetCursorPosition(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldSetCursorPosition(Xen arg1, Xen arg2)
{
#define H_XmTextFieldSetCursorPosition "void XmTextFieldSetCursorPosition(Widget w, int position) sets the insertion cursor position"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldSetCursorPosition", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldSetCursorPosition", "XmTextPosition");
- XmTextFieldSetCursorPosition(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldSetCursorPosition", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldSetCursorPosition", "XmTextPosition");
+ XmTextFieldSetCursorPosition(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldGetInsertionPosition(XEN arg1)
+static Xen gxm_XmTextFieldGetInsertionPosition(Xen arg1)
{
#define H_XmTextFieldGetInsertionPosition "XmTextPosition XmTextFieldGetInsertionPosition(Widget widget) \
accesses the position of the insertion cursor"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetInsertionPosition", "TextField Widget");
- return(C_TO_XEN_INT(XmTextFieldGetInsertionPosition(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetInsertionPosition", "TextField Widget");
+ return(C_int_to_Xen_integer(XmTextFieldGetInsertionPosition(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldGetCursorPosition(XEN arg1)
+static Xen gxm_XmTextFieldGetCursorPosition(Xen arg1)
{
#define H_XmTextFieldGetCursorPosition "int XmTextFieldGetCursorPosition(Widget w) presumably returns the widget's insertion cursor position"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetCursorPosition", "TextField Widget");
- return(C_TO_XEN_INT(XmTextFieldGetCursorPosition(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetCursorPosition", "TextField Widget");
+ return(C_int_to_Xen_integer(XmTextFieldGetCursorPosition(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldSetMaxLength(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldSetMaxLength(Xen arg1, Xen arg2)
{
#define H_XmTextFieldSetMaxLength "void XmTextFieldSetMaxLength(Widget widget, int max_length) sets the \
value of the current maximum allowable length of a text string \
entered from the keyboard"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldSetMaxLength", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldSetMaxLength", "int");
- XmTextFieldSetMaxLength(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldSetMaxLength", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldSetMaxLength", "int");
+ XmTextFieldSetMaxLength(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldGetMaxLength(XEN arg1)
+static Xen gxm_XmTextFieldGetMaxLength(Xen arg1)
{
#define H_XmTextFieldGetMaxLength "int XmTextFieldGetMaxLength(Widget widget) accesses the value of the \
current maximum allowable length of a text string \
entered from the keyboard"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetMaxLength", "TextField Widget");
- return(C_TO_XEN_INT(XmTextFieldGetMaxLength(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetMaxLength", "TextField Widget");
+ return(C_int_to_Xen_integer(XmTextFieldGetMaxLength(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldSetEditable(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldSetEditable(Xen arg1, Xen arg2)
{
#define H_XmTextFieldSetEditable "void XmTextFieldSetEditable(Widget widget, Boolean editable) sets the edit permission"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldSetEditable", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmTextFieldSetEditable", "boolean");
- XmTextFieldSetEditable(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldSetEditable", "TextField Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmTextFieldSetEditable", "boolean");
+ XmTextFieldSetEditable(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldGetEditable(XEN arg1)
+static Xen gxm_XmTextFieldGetEditable(Xen arg1)
{
#define H_XmTextFieldGetEditable "Boolean XmTextFieldGetEditable(Widget widget) accesses the edit permission state"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetEditable", "TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextFieldGetEditable(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetEditable", "TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextFieldGetEditable(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldGetAddMode(XEN arg1)
+static Xen gxm_XmTextFieldGetAddMode(Xen arg1)
{
#define H_XmTextFieldGetAddMode "Boolean XmTextFieldGetAddMode(Widget w) presumably returns the widget's current add mode."
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetAddMode", "TextField Widget");
- return(C_TO_XEN_BOOLEAN(XmTextFieldGetAddMode(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetAddMode", "TextField Widget");
+ return(C_bool_to_Xen_boolean(XmTextFieldGetAddMode(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldSetAddMode(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldSetAddMode(Xen arg1, Xen arg2)
{
#define H_XmTextFieldSetAddMode "void XmTextFieldSetAddMode(Widget widget, Boolean state) sets the state of Add mode"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldSetAddMode", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmTextFieldSetAddMode", "boolean");
- XmTextFieldSetAddMode(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldSetAddMode", "TextField Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmTextFieldSetAddMode", "boolean");
+ XmTextFieldSetAddMode(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldInsert(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTextFieldInsert(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmTextFieldInsert "void XmTextFieldInsert(Widget widget, XmTextPosition position, char *value) \
inserts a character string into a text string"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldInsert", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldInsert", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XmTextFieldInsert", "char*");
- XmTextFieldInsert(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), (char *)XEN_TO_C_STRING(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldInsert", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldInsert", "XmTextPosition");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XmTextFieldInsert", "char*");
+ XmTextFieldInsert(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), (char *)Xen_string_to_C_string(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldReplace(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmTextFieldReplace(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmTextFieldReplace "void XmTextFieldReplace(Widget widget, XmTextPosition from_pos, XmTextPosition to_pos, char *value) \
replaces part of a text string"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldReplace", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldReplace", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextFieldReplace", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XmTextFieldReplace", "char*");
- XmTextFieldReplace(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), (char *)XEN_TO_C_STRING(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldReplace", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldReplace", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextFieldReplace", "XmTextPosition");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XmTextFieldReplace", "char*");
+ XmTextFieldReplace(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), (char *)Xen_string_to_C_string(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldSetString(XEN arg1, XEN arg2)
+static Xen gxm_XmTextFieldSetString(Xen arg1, Xen arg2)
{
#define H_XmTextFieldSetString "void XmTextFieldSetString(Widget widget, char *value) sets the string value"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldSetString", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmTextFieldSetString", "char*");
- XmTextFieldSetString(XEN_TO_C_Widget(arg1), (char *)XEN_TO_C_STRING(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldSetString", "TextField Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmTextFieldSetString", "char*");
+ XmTextFieldSetString(Xen_to_C_Widget(arg1), (char *)Xen_string_to_C_string(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmTextFieldGetLastPosition(XEN arg1)
+static Xen gxm_XmTextFieldGetLastPosition(Xen arg1)
{
#define H_XmTextFieldGetLastPosition "XmTextPosition XmTextFieldGetLastPosition(Widget widget) accesses \
the position of the last text character"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetLastPosition", "TextField Widget");
- return(C_TO_XEN_INT(XmTextFieldGetLastPosition(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetLastPosition", "TextField Widget");
+ return(C_int_to_Xen_integer(XmTextFieldGetLastPosition(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmTextFieldGetSubstring(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmTextFieldGetSubstring(Xen arg1, Xen arg2, Xen arg3)
{
/* DIFF: omit and rtn last 2 args */
#define H_XmTextFieldGetSubstring "int XmTextFieldGetSubstring(Widget widget, XmTextPosition start, int num_chars) \
retrieves a copy of a portion of the internal text buffer"
int rtn, len;
char *buf;
- XEN str = XEN_FALSE;
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetSubstring", "TextField Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmTextFieldGetSubstring", "XmTextPosition");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTextFieldGetSubstring", "int");
- len = XEN_TO_C_INT(arg3);
+ Xen str = Xen_false;
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetSubstring", "TextField Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmTextFieldGetSubstring", "XmTextPosition");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTextFieldGetSubstring", "int");
+ len = Xen_integer_to_C_int(arg3);
buf = (char *)calloc(len + 1, sizeof(char));
- rtn = XmTextFieldGetSubstring(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), len, len + 1, buf);
+ rtn = XmTextFieldGetSubstring(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), len, len + 1, buf);
if (rtn != XmCOPY_FAILED)
- str = C_TO_XEN_STRING(buf);
+ str = C_string_to_Xen_string(buf);
free(buf);
return(str);
}
-static XEN gxm_XmTextFieldGetString(XEN arg1)
+static Xen gxm_XmTextFieldGetString(Xen arg1)
{
char *str;
- XEN res;
+ Xen res;
#define H_XmTextFieldGetString "char *XmTextFieldGetString(Widget widget) accesses the string value"
- XEN_ASSERT_TYPE(XEN_TextFieldWidget_P(arg1), arg1, 1, "XmTextFieldGetString", "TextField Widget");
- str = XmTextFieldGetString(XEN_TO_C_Widget(arg1));
- res = C_TO_XEN_STRING(str);
+ Xen_check_type(Xen_is_TextFieldWidget(arg1), arg1, 1, "XmTextFieldGetString", "TextField Widget");
+ str = XmTextFieldGetString(Xen_to_C_Widget(arg1));
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XmDropTransferAdd(XEN arg1, XEN arg2)
+static Xen gxm_XmDropTransferAdd(Xen arg1, Xen arg2)
{
#define H_XmDropTransferAdd "void XmDropTransferAdd(Widget drop_transfer, XmDropTransferEntryRec *transfers) \
enables additional drop transfer entries to be processed after initiating a drop transfer"
@@ -6073,51 +5680,51 @@ enables additional drop transfer entries to be processed after initiating a drop
*/
int len;
XmDropTransferEntryRec *entries;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropTransferAdd", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmDropTransferAdd", "XmDropTransferEntry");
- len = XEN_LIST_LENGTH(arg2);
- if (len <= 0) return(XEN_FALSE);
- entries = XEN_TO_C_XmDropTransferEntryRecs(arg2, len);
- XmDropTransferAdd(XEN_TO_C_Widget(arg1), entries, len);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropTransferAdd", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmDropTransferAdd", "XmDropTransferEntry");
+ len = Xen_list_length(arg2);
+ if (len <= 0) return(Xen_false);
+ entries = Xen_to_C_XmDropTransferEntryRecs(arg2, len);
+ XmDropTransferAdd(Xen_to_C_Widget(arg1), entries, len);
free(entries);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmDropTransferStart(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmDropTransferStart(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmDropTransferStart "Widget XmDropTransferStart(Widget widget, ArgList arglist, Cardinal argcount) \
initiates a drop transfer"
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropTransferStart", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmDropTransferStart", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmDropTransferStart", "int");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropTransferStart", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmDropTransferStart", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmDropTransferStart", "int");
{
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg2);
- arglen = XEN_TO_C_INT_DEF(arg3, arg2);
- w = XmDropTransferStart(XEN_TO_C_Widget(arg1), args, arglen);
+ args = Xen_to_C_Args(arg2);
+ arglen = Xen_to_C_INT_DEF(arg3, arg2);
+ w = XmDropTransferStart(Xen_to_C_Widget(arg1), args, arglen);
if (args)
{
fixup_args(w, args, arglen);
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmDropSiteConfigureStackingOrder(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmDropSiteConfigureStackingOrder(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmDropSiteConfigureStackingOrder "void XmDropSiteConfigureStackingOrder(Widget widget, Widget sibling, Cardinal stack_mode) \
reorders a stack of widgets that are registered drop sites"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteConfigureStackingOrder", "Widget");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg2), arg2, 2, "XmDropSiteConfigureStackingOrder", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmDropSiteConfigureStackingOrder", "int");
- XmDropSiteConfigureStackingOrder(XEN_TO_C_Widget(arg1), XEN_TO_C_Widget(arg2), XEN_TO_C_INT(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteConfigureStackingOrder", "Widget");
+ Xen_check_type(Xen_is_Widget(arg2), arg2, 2, "XmDropSiteConfigureStackingOrder", "Widget");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmDropSiteConfigureStackingOrder", "int");
+ XmDropSiteConfigureStackingOrder(Xen_to_C_Widget(arg1), Xen_to_C_Widget(arg2), Xen_integer_to_C_int(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmDropSiteQueryStackingOrder(XEN arg1)
+static Xen gxm_XmDropSiteQueryStackingOrder(Xen arg1)
{
#define H_XmDropSiteQueryStackingOrder "Status XmDropSiteQueryStackingOrder(Widget widget): (list parent child ...)"
/* DIFF: XmDropSiteQueryStackingOrder widget [parent child numchild] -> (list parent child ...)
@@ -6125,75 +5732,75 @@ static XEN gxm_XmDropSiteQueryStackingOrder(XEN arg1)
*/
Widget parent;
Widget *children;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
unsigned int num_children;
int res, i, loc;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteQueryStackingOrder", "Widget");
- res = XmDropSiteQueryStackingOrder(XEN_TO_C_Widget(arg1), &parent, &children, &num_children);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteQueryStackingOrder", "Widget");
+ res = XmDropSiteQueryStackingOrder(Xen_to_C_Widget(arg1), &parent, &children, &num_children);
if (res == 0)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = num_children - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Widget(children[i]), lst);
+ lst = Xen_cons(C_to_Xen_Widget(children[i]), lst);
xm_unprotect_at(loc);
- return(XEN_CONS(C_TO_XEN_Widget(parent), lst));
+ return(Xen_cons(C_to_Xen_Widget(parent), lst));
}
-static XEN gxm_XmDropSiteRetrieve(XEN arg1, XEN larg2, XEN arg3)
+static Xen gxm_XmDropSiteRetrieve(Xen arg1, Xen larg2, Xen arg3)
{
#define H_XmDropSiteRetrieve "void XmDropSiteRetrieve(Widget widget, ArgList arglist, Cardinal argcount) \
retrieves resource values set on a drop site"
Arg *args;
unsigned long *locs;
- XEN val = XEN_FALSE;
+ Xen val = Xen_false;
int i, len, gcloc;
- XEN arg2;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteRetrieve", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg2), larg2, 2, "XmDropSiteRetrieve", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmDropSiteRetrieve", "int");
- arg2 = XEN_COPY_ARG(larg2);
+ Xen arg2;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteRetrieve", "Widget");
+ Xen_check_type(Xen_is_list(larg2), larg2, 2, "XmDropSiteRetrieve", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmDropSiteRetrieve", "int");
+ arg2 = Xen_copy_arg(larg2);
gcloc = xm_protect(arg2);
- len = XEN_TO_C_INT_DEF(arg3, larg2);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg3, 3, "XmDropSiteRetrieve", "positive integer");
+ len = Xen_to_C_INT_DEF(arg3, larg2);
+ if (len <= 0) Xen_check_type(0, arg3, 3, "XmDropSiteRetrieve", "positive integer");
args = (Arg *)calloc(len, sizeof(Arg));
locs = (unsigned long *)calloc(len, sizeof(unsigned long));
- for (i = 0; i < len; i++, arg2 = XEN_CDDR(arg2))
+ for (i = 0; i < len; i++, arg2 = Xen_cddr(arg2))
{
char *name;
- name = xen_strdup(XEN_TO_C_STRING(XEN_CAR(arg2)));
+ name = xen_strdup(Xen_string_to_C_string(Xen_car(arg2)));
XtSetArg(args[i], name, &(locs[i]));
}
- XmDropSiteRetrieve(XEN_TO_C_Widget(arg1), args, len);
- val = C_TO_XEN_Args((Widget)(XEN_TO_C_Widget(arg1)), args, len);
+ XmDropSiteRetrieve(Xen_to_C_Widget(arg1), args, len);
+ val = C_to_Xen_Args((Widget)(Xen_to_C_Widget(arg1)), args, len);
free_args(args, len);
free(locs);
xm_unprotect_at(gcloc);
return(val);
}
-static XEN gxm_XmDropSiteEndUpdate(XEN arg1)
+static Xen gxm_XmDropSiteEndUpdate(Xen arg1)
{
#define H_XmDropSiteEndUpdate "void XmDropSiteEndUpdate(Widget widget) facilitates processing updates to multiple drop sites"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteEndUpdate", "Widget");
- XmDropSiteEndUpdate(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteEndUpdate", "Widget");
+ XmDropSiteEndUpdate(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmDropSiteUpdate(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmDropSiteUpdate(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmDropSiteUpdate "void XmDropSiteUpdate(Widget widget, ArgList arglist, Cardinal argcount) sets \
resource values for a drop site"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteUpdate", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmDropSiteUpdate", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmDropSiteUpdate", "int");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteUpdate", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmDropSiteUpdate", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmDropSiteUpdate", "int");
{
Widget w;
Arg *args;
int arglen;
- w = XEN_TO_C_Widget(arg1);
- args = XEN_TO_C_Args(arg2);
- arglen = XEN_TO_C_INT_DEF(arg3, arg2);
+ w = Xen_to_C_Widget(arg1);
+ args = Xen_to_C_Args(arg2);
+ arglen = Xen_to_C_INT_DEF(arg3, arg2);
XmDropSiteUpdate(w, args, arglen);
if (args)
{
@@ -6201,47 +5808,47 @@ resource values for a drop site"
free_args(args, arglen);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmDropSiteStartUpdate(XEN arg1)
+static Xen gxm_XmDropSiteStartUpdate(Xen arg1)
{
#define H_XmDropSiteStartUpdate "void XmDropSiteStartUpdate(Widget widget) facilitates processing updates \
to multiple drop sites"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteStartUpdate", "Widget");
- XmDropSiteStartUpdate(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteStartUpdate", "Widget");
+ XmDropSiteStartUpdate(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmDropSiteRegistered(XEN arg1)
+static Xen gxm_XmDropSiteRegistered(Xen arg1)
{
#define H_XmDropSiteRegistered "Boolean XmDropSiteRegistered(Widget widget) determines if a drop site has been registered"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteRegistered", "Widget");
- return(C_TO_XEN_BOOLEAN(XmDropSiteRegistered(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteRegistered", "Widget");
+ return(C_bool_to_Xen_boolean(XmDropSiteRegistered(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmDropSiteUnregister(XEN arg1)
+static Xen gxm_XmDropSiteUnregister(Xen arg1)
{
#define H_XmDropSiteUnregister "void XmDropSiteUnregister(Widget widget) frees drop site information"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteUnregister", "Widget");
- XmDropSiteUnregister(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteUnregister", "Widget");
+ XmDropSiteUnregister(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmDropSiteRegister(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmDropSiteRegister(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmDropSiteRegister "void XmDropSiteRegister(Widget widget, ArgList arglist, Cardinal argcount) \
identifies a drop site and assigns resources that specify its behavior"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDropSiteRegister", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmDropSiteRegister", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XmDropSiteRegister", "int");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDropSiteRegister", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmDropSiteRegister", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmDropSiteRegister", "int");
{
Widget w;
Arg *args;
int arglen;
- w = XEN_TO_C_Widget(arg1);
- args = XEN_TO_C_Args(arg2);
- arglen = XEN_TO_C_INT_DEF(arg3, arg2);
+ w = Xen_to_C_Widget(arg1);
+ args = Xen_to_C_Args(arg2);
+ arglen = Xen_to_C_INT_DEF(arg3, arg2);
XmDropSiteRegister(w, args, arglen);
if (args)
{
@@ -6249,98 +5856,98 @@ identifies a drop site and assigns resources that specify its behavior"
free_args(args, arglen);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmSimpleSpinBoxSetItem(XEN arg1, XEN arg2)
+static Xen gxm_XmSimpleSpinBoxSetItem(Xen arg1, Xen arg2)
{
#define H_XmSimpleSpinBoxSetItem "void XmSimpleSpinBoxSetItem(Widget w, XmString item) set an item in the XmSimpleSpinBox list"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmSimpleSpinBoxSetItem", "Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmSimpleSpinBoxSetItem", "XmString");
- XmSimpleSpinBoxSetItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmSimpleSpinBoxSetItem", "Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmSimpleSpinBoxSetItem", "XmString");
+ XmSimpleSpinBoxSetItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmSimpleSpinBoxDeletePos(XEN arg1, XEN arg2)
+static Xen gxm_XmSimpleSpinBoxDeletePos(Xen arg1, Xen arg2)
{
#define H_XmSimpleSpinBoxDeletePos "void XmSimpleSpinBoxDeletePos(Widget w, int pos) delete a XmSimpleSpinBox item"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmSimpleSpinBoxDeletePos", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmSimpleSpinBoxDeletePos", "int");
- XmSimpleSpinBoxDeletePos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmSimpleSpinBoxDeletePos", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmSimpleSpinBoxDeletePos", "int");
+ XmSimpleSpinBoxDeletePos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmSimpleSpinBoxAddItem(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmSimpleSpinBoxAddItem(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmSimpleSpinBoxAddItem "void XmSimpleSpinBoxAddItem(Widget w, XmString item, int pos) add an item to the XmSimpleSpinBox"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmSimpleSpinBoxAddItem", "Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmSimpleSpinBoxAddItem", "XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmSimpleSpinBoxAddItem", "int");
- XmSimpleSpinBoxAddItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2), XEN_TO_C_INT(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmSimpleSpinBoxAddItem", "Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmSimpleSpinBoxAddItem", "XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmSimpleSpinBoxAddItem", "int");
+ XmSimpleSpinBoxAddItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2), Xen_integer_to_C_int(arg3));
+ return(Xen_false);
}
-static XEN gxm_XmCreateSimpleSpinBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSimpleSpinBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSimpleSpinBox "Widget XmCreateSimpleSpinBox(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The SimpleSpinBox widget creation function"
return(gxm_new_widget("XmCreateSimpleSpinBox", XmCreateSimpleSpinBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateDrawnButton(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateDrawnButton(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateDrawnButton "Widget XmCreateDrawnButton(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The DrawnButton widget creation function"
return(gxm_new_widget("XmCreateDrawnButton", XmCreateDrawnButton, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmSpinBoxValidatePosition(XEN arg1)
+static Xen gxm_XmSpinBoxValidatePosition(Xen arg1)
{
#define H_XmSpinBoxValidatePosition "int XmSpinBoxValidatePosition(Widget textfield) translate the current value of \
the specified XmSpinBox child into a valid position"
/* DIFF: XmSpinBoxValidatePosition omits arg2, returns pos
*/
int pos;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmSpinBoxValidatePosition", "Widget");
- XmSpinBoxValidatePosition(XEN_TO_C_Widget(arg1), &pos);
- return(C_TO_XEN_INT(pos));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmSpinBoxValidatePosition", "Widget");
+ XmSpinBoxValidatePosition(Xen_to_C_Widget(arg1), &pos);
+ return(C_int_to_Xen_integer(pos));
}
-static XEN gxm_XmCreateSpinBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSpinBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSpinBox "The SpinBox creation function"
return(gxm_new_widget("XmCreateSpinBox", XmCreateSpinBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateDrawingArea(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateDrawingArea(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateDrawingArea "Widget XmCreateDrawingArea(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The DrawingArea widget creation function"
return(gxm_new_widget("XmCreateDrawingArea", XmCreateDrawingArea, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSeparator(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSeparator(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSeparator "Widget XmCreateSeparator(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The Separator widget creation function"
return(gxm_new_widget("XmCreateSeparator", XmCreateSeparator, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateDragIcon(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateDragIcon(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateDragIcon "Widget XmCreateDragIcon(Widget widget, String name, ArgList arglist, Cardinal argcount) \
creates a DragIcon widget"
return(gxm_new_widget("XmCreateDragIcon", XmCreateDragIcon, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSeparatorGadget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSeparatorGadget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSeparatorGadget "Widget XmCreateSeparatorGadget(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The SeparatorGadget creation function"
return(gxm_new_widget("XmCreateSeparatorGadget", XmCreateSeparatorGadget, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmTargetsAreCompatible(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmTargetsAreCompatible(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmTargetsAreCompatible "Boolean XmTargetsAreCompatible(Display *display, Atom *export_targets, Cardinal num_export_targets, \
Atom *import_targets, Cardinal num_import_targets) tests whether the target types match between a drop site and source object"
@@ -6348,45 +5955,45 @@ Atom *import_targets, Cardinal num_import_targets) tests whether the target typ
*/
Atom *outs, *ins;
int val, len1, len2;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmTargetsAreCompatible", "Display*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmTargetsAreCompatible", "list of Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmTargetsAreCompatible", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XmTargetsAreCompatible", "list of Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XmTargetsAreCompatible", "int");
- len1 = XEN_TO_C_INT(arg3);
- outs = XEN_TO_C_Atoms(arg2, len1);
- len2 = XEN_TO_C_INT(arg5);
- ins = XEN_TO_C_Atoms(arg4, len2);
- val = XmTargetsAreCompatible(XEN_TO_C_Display(arg1), outs, len1, ins, len2);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmTargetsAreCompatible", "Display*");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmTargetsAreCompatible", "list of Atom");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmTargetsAreCompatible", "int");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XmTargetsAreCompatible", "list of Atom");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XmTargetsAreCompatible", "int");
+ len1 = Xen_integer_to_C_int(arg3);
+ outs = Xen_to_C_Atoms(arg2, len1);
+ len2 = Xen_integer_to_C_int(arg5);
+ ins = Xen_to_C_Atoms(arg4, len2);
+ val = XmTargetsAreCompatible(Xen_to_C_Display(arg1), outs, len1, ins, len2);
free(outs);
free(ins);
- return(C_TO_XEN_BOOLEAN(val));
+ return(C_bool_to_Xen_boolean(val));
}
-static XEN gxm_XmDragCancel(XEN arg1)
+static Xen gxm_XmDragCancel(Xen arg1)
{
#define H_XmDragCancel "void XmDragCancel(Widget dragcontext) terminates a drag transaction"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDragCancel", "Widget");
- XmDragCancel(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDragCancel", "Widget");
+ XmDragCancel(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmDragStart(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmDragStart(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmDragStart "Widget XmDragStart(Widget widget, XEvent *event, ArgList arglist, Cardinal argcount) \
initiates a drag and drop transaction"
Widget w;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDragStart", "Widget");
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg2), arg2, 2, "XmDragStart", "XEvent*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XmDragStart", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg4), arg4, 4, "XmDragStart", "int");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDragStart", "Widget");
+ Xen_check_type(Xen_is_XEvent(arg2), arg2, 2, "XmDragStart", "XEvent*");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XmDragStart", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg4), arg4, 4, "XmDragStart", "int");
{
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg3);
- arglen = XEN_TO_C_INT_DEF(arg4, arg3);
- w = XmDragStart(XEN_TO_C_Widget(arg1),
- XEN_TO_C_XEvent(arg2),
+ args = Xen_to_C_Args(arg3);
+ arglen = Xen_to_C_INT_DEF(arg4, arg3);
+ w = XmDragStart(Xen_to_C_Widget(arg1),
+ Xen_to_C_XEvent(arg2),
args, arglen);
if (args)
{
@@ -6394,139 +6001,139 @@ initiates a drag and drop transaction"
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XmCreatePromptDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreatePromptDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreatePromptDialog "Widget XmCreatePromptDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The SelectionBox PromptDialog creation function"
return(gxm_new_widget("XmCreatePromptDialog", XmCreatePromptDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSelectionDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSelectionDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSelectionDialog "Widget XmCreateSelectionDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The SelectionBox SelectionDialog creation function"
return(gxm_new_widget("XmCreateSelectionDialog", XmCreateSelectionDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateSelectionBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateSelectionBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateSelectionBox "Widget XmCreateSelectionBox(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The SelectionBox widget creation function"
return(gxm_new_widget("XmCreateSelectionBox", XmCreateSelectionBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmSelectionBoxGetChild(XEN arg1, XEN arg2)
+static Xen gxm_XmSelectionBoxGetChild(Xen arg1, Xen arg2)
{
#define H_XmSelectionBoxGetChild "Widget XmSelectionBoxGetChild(Widget widget, unsigned char child) used to access a SelectionBox component"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmSelectionBoxGetChild", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XmSelectionBoxGetChild", "unsigned int");
- return(C_TO_XEN_Widget(XmSelectionBoxGetChild(XEN_TO_C_Widget(arg1), XEN_TO_C_ULONG(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmSelectionBoxGetChild", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XmSelectionBoxGetChild", "unsigned int");
+ return(C_to_Xen_Widget(XmSelectionBoxGetChild(Xen_to_C_Widget(arg1), Xen_ulong_to_C_ulong(arg2))));
}
-static XEN gxm_XmGetXmDisplay(XEN arg1)
+static Xen gxm_XmGetXmDisplay(Xen arg1)
{
#define H_XmGetXmDisplay "Widget XmGetXmDisplay(Display *display) A Display function that returns the"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmGetXmDisplay", "Display*");
- return(C_TO_XEN_Widget(XmGetXmDisplay(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmGetXmDisplay", "Display*");
+ return(C_to_Xen_Widget(XmGetXmDisplay(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XmGetDragContext(XEN arg1, XEN arg2)
+static Xen gxm_XmGetDragContext(Xen arg1, Xen arg2)
{
#define H_XmGetDragContext "Widget XmGetDragContext(Widget refwidget, Time timestamp) retrieves \
the DragContext widget ID associated with a timestamp"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmGetDragContext", "Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmGetDragContext", "Time");
- return(C_TO_XEN_Widget(XmGetDragContext(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmGetDragContext", "Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmGetDragContext", "Time");
+ return(C_to_Xen_Widget(XmGetDragContext(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmScrollVisible(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmScrollVisible(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmScrollVisible "void XmScrollVisible(Widget scrollw_widget, Widget widget, Dimension left_right_margin, Dimension top_bottom_margin) \
makes an invisible descendant of a ScrolledWindow work area visible"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmScrollVisible", "Widget");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg2), arg2, 2, "XmScrollVisible", "Widget");
- XEN_ASSERT_TYPE(XEN_Dimension_P(arg3), arg3, 3, "XmScrollVisible", "Dimension");
- XEN_ASSERT_TYPE(XEN_Dimension_P(arg4), arg4, 4, "XmScrollVisible", "Dimension");
- XmScrollVisible(XEN_TO_C_Widget(arg1), XEN_TO_C_Widget(arg2),
- XEN_TO_C_Dimension(arg3), XEN_TO_C_Dimension(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmScrollVisible", "Widget");
+ Xen_check_type(Xen_is_Widget(arg2), arg2, 2, "XmScrollVisible", "Widget");
+ Xen_check_type(Xen_is_Dimension(arg3), arg3, 3, "XmScrollVisible", "Dimension");
+ Xen_check_type(Xen_is_Dimension(arg4), arg4, 4, "XmScrollVisible", "Dimension");
+ XmScrollVisible(Xen_to_C_Widget(arg1), Xen_to_C_Widget(arg2),
+ Xen_to_C_Dimension(arg3), Xen_to_C_Dimension(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmCreateScrolledWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateScrolledWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateScrolledWindow "Widget XmCreateScrolledWindow(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The ScrolledWindow widget creation function"
return(gxm_new_widget("XmCreateScrolledWindow", XmCreateScrolledWindow, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateDialogShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateDialogShell(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateDialogShell "Widget XmCreateDialogShell(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The DialogShell widget creation function"
return(gxm_new_widget("XmCreateDialogShell", XmCreateDialogShell, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmScrollBarSetValues(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XmScrollBarSetValues(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XmScrollBarSetValues "void XmScrollBarSetValues (widget, value, slider_size, increment, page_increment, notify) \
changes ScrollBar's increment values and the slider's size and position"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmScrollBarSetValues", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmScrollBarSetValues", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmScrollBarSetValues", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmScrollBarSetValues", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XmScrollBarSetValues", "int");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg6), arg6, 6, "XmScrollBarSetValues", "boolean");
- XmScrollBarSetValues(XEN_TO_C_Widget(arg1),
- XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- XEN_TO_C_BOOLEAN(arg6));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmScrollBarSetValues", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmScrollBarSetValues", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmScrollBarSetValues", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmScrollBarSetValues", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XmScrollBarSetValues", "int");
+ Xen_check_type(Xen_is_boolean(arg6), arg6, 6, "XmScrollBarSetValues", "boolean");
+ XmScrollBarSetValues(Xen_to_C_Widget(arg1),
+ Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ Xen_boolean_to_C_bool(arg6));
+ return(Xen_false);
}
-static XEN gxm_XmScrollBarGetValues(XEN arg1)
+static Xen gxm_XmScrollBarGetValues(Xen arg1)
{
#define H_XmScrollBarGetValues "void XmScrollBarGetValues (widget): returns the ScrollBar's increment values (list val size incr page)"
/* DIFF: XmScrollBarGetValues omits and returns last 4 args
*/
int val, size, incr, page;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmScrollBarGetValues", "Widget");
- XmScrollBarGetValues(XEN_TO_C_Widget(arg1), &val, &size, &incr, &page);
- return(XEN_LIST_4(C_TO_XEN_INT(val),
- C_TO_XEN_INT(size),
- C_TO_XEN_INT(incr),
- C_TO_XEN_INT(page)));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmScrollBarGetValues", "Widget");
+ XmScrollBarGetValues(Xen_to_C_Widget(arg1), &val, &size, &incr, &page);
+ return(Xen_list_4(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(size),
+ C_int_to_Xen_integer(incr),
+ C_int_to_Xen_integer(page)));
}
-static XEN gxm_XmCreateScrollBar(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateScrollBar(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateScrollBar "Widget XmCreateScrollBar(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The ScrollBar widget creation function"
return(gxm_new_widget("XmCreateScrollBar", XmCreateScrollBar, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmGetXmScreen(XEN arg1)
+static Xen gxm_XmGetXmScreen(Xen arg1)
{
#define H_XmGetXmScreen "Widget XmGetXmScreen(Screen *screen): returns the XmScreen object ID for a specified screen"
/* this is the Motif Screen "widget" */
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XmGetXmScreen", "Screen*");
- return(C_TO_XEN_Widget(XmGetXmScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XmGetXmScreen", "Screen*");
+ return(C_to_Xen_Widget(XmGetXmScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XmClipboardRegisterFormat(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmClipboardRegisterFormat(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmClipboardRegisterFormat "int XmClipboardRegisterFormat (display, format_name, format_length) registers a new format"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardRegisterFormat", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmClipboardRegisterFormat", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmClipboardRegisterFormat", "int");
- return(C_TO_XEN_INT(XmClipboardRegisterFormat(XEN_TO_C_Display(arg1),
- (char *)XEN_TO_C_STRING(arg2),
- XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardRegisterFormat", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmClipboardRegisterFormat", "char*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmClipboardRegisterFormat", "int");
+ return(C_int_to_Xen_integer(XmClipboardRegisterFormat(Xen_to_C_Display(arg1),
+ (char *)Xen_string_to_C_string(arg2),
+ Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XmClipboardInquirePendingItems(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmClipboardInquirePendingItems(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmClipboardInquirePendingItems "int XmClipboardInquirePendingItems (display, window, format_name) \
returns a list of data ID/private ID pairs"
@@ -6535,84 +6142,84 @@ returns a list of data ID/private ID pairs"
unsigned long len;
XmClipboardPendingList clst;
int i, loc, rtn;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardInquirePendingItems", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardInquirePendingItems", "Window");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XmClipboardInquirePendingItems", "char*");
- rtn = XmClipboardInquirePendingItems(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- (char *)XEN_TO_C_STRING(arg3),
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardInquirePendingItems", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardInquirePendingItems", "Window");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XmClipboardInquirePendingItems", "char*");
+ rtn = XmClipboardInquirePendingItems(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ (char *)Xen_string_to_C_string(arg3),
&clst,
&len);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(XEN_LIST_2(C_TO_XEN_INT(clst[i].DataId),
- C_TO_XEN_INT(clst[i].PrivateId)),
+ lst = Xen_cons(Xen_list_2(C_int_to_Xen_integer(clst[i].DataId),
+ C_int_to_Xen_integer(clst[i].PrivateId)),
lst);
- lst = XEN_CONS(C_TO_XEN_INT(rtn), lst);
+ lst = Xen_cons(C_int_to_Xen_integer(rtn), lst);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XmClipboardInquireLength(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmClipboardInquireLength(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmClipboardInquireLength "int XmClipboardInquireLength (display, window, format_name): returns the length of the stored data"
/* DIFF: XmClipboardInquireLength omit and rtn last arg
*/
unsigned long len;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardInquireLength", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardInquireLength", "Window");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XmClipboardInquireLength", "char*");
- val = XmClipboardInquireLength(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), (char *)XEN_TO_C_STRING(arg3), &len);
- return(XEN_LIST_2(C_TO_XEN_INT(val),
- C_TO_XEN_ULONG(len)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardInquireLength", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardInquireLength", "Window");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XmClipboardInquireLength", "char*");
+ val = XmClipboardInquireLength(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), (char *)Xen_string_to_C_string(arg3), &len);
+ return(Xen_list_2(C_int_to_Xen_integer(val),
+ C_ulong_to_Xen_ulong(len)));
}
-static XEN gxm_XmClipboardInquireFormat(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmClipboardInquireFormat(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmClipboardInquireFormat "int XmClipboardInquireFormat (display, window, index, buffer_len) \
returns a specified format name"
/* DIFF: XmClipboardInquireFormat omits arg4 (XtPointer buffer) and arg6, returns them
*/
- XEN res;
+ Xen res;
XtPointer buf;
unsigned long len, n;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardInquireFormat", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardInquireFormat", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmClipboardInquireFormat", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XmClipboardInquireFormat", "ulong");
- len = XEN_TO_C_ULONG(arg4);
- if (len == 0) return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardInquireFormat", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardInquireFormat", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmClipboardInquireFormat", "int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XmClipboardInquireFormat", "ulong");
+ len = Xen_ulong_to_C_ulong(arg4);
+ if (len == 0) return(Xen_false);
buf = (XtPointer)calloc(len + 1, sizeof(char));
- val = XmClipboardInquireFormat(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_INT(arg3),
+ val = XmClipboardInquireFormat(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_integer_to_C_int(arg3),
buf, len, &n);
- res = C_TO_XEN_STRING((char *)buf);
+ res = C_string_to_Xen_string((char *)buf);
free(buf);
- return(XEN_LIST_2(C_TO_XEN_INT(val), res));
+ return(Xen_list_2(C_int_to_Xen_integer(val), res));
}
-static XEN gxm_XmClipboardInquireCount(XEN arg1, XEN arg2)
+static Xen gxm_XmClipboardInquireCount(Xen arg1, Xen arg2)
{
#define H_XmClipboardInquireCount "int XmClipboardInquireCount (display, window): returns the number of data item formats"
/* DIFF: XmClipboardInquireCount omits and rtns last 2 args
*/
int count, val;
unsigned long len;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardInquireCount", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardInquireCount", "Window");
- val = XmClipboardInquireCount(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardInquireCount", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardInquireCount", "Window");
+ val = XmClipboardInquireCount(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
&count, &len);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_INT(count),
- C_TO_XEN_ULONG(len)));
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(count),
+ C_ulong_to_Xen_ulong(len)));
}
-static XEN gxm_XmClipboardRetrieve(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmClipboardRetrieve(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmClipboardRetrieve "int XmClipboardRetrieve (display, window, format_name, length) retrieves a data item from the clipboard"
/* DIFF: XmClipboardRetrieve omits buf arg, and last 2, returning them and a list of ulongs
@@ -6621,116 +6228,116 @@ static XEN gxm_XmClipboardRetrieve(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
long id;
XtPointer buf;
int len, val;
- XEN str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardRetrieve", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardRetrieve", "Window");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XmClipboardRetrieve", "char*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XmClipboardRetrieve", "ulong");
- len = XEN_TO_C_ULONG(arg4);
- if (len <= 0) return(XEN_FALSE);
+ Xen str;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardRetrieve", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardRetrieve", "Window");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XmClipboardRetrieve", "char*");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XmClipboardRetrieve", "ulong");
+ len = Xen_ulong_to_C_ulong(arg4);
+ if (len <= 0) return(Xen_false);
buf = (XtPointer)malloc(len);
- val = XmClipboardRetrieve(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- (char *)XEN_TO_C_STRING(arg3),
+ val = XmClipboardRetrieve(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ (char *)Xen_string_to_C_string(arg3),
buf, len, &n, &id);
- str = C_TO_XEN_STRING((char *)buf);
+ str = C_string_to_Xen_string((char *)buf);
free(buf);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
+ return(Xen_list_3(C_int_to_Xen_integer(val),
str,
- C_TO_XEN_ULONG(id)));
+ C_ulong_to_Xen_ulong(id)));
}
-static XEN gxm_XmClipboardEndRetrieve(XEN arg1, XEN arg2)
+static Xen gxm_XmClipboardEndRetrieve(Xen arg1, Xen arg2)
{
#define H_XmClipboardEndRetrieve "int XmClipboardEndRetrieve (display, window) completes retrieval of \
data from the clipboard"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardEndRetrieve", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardEndRetrieve", "Window");
- return(C_TO_XEN_INT(XmClipboardEndRetrieve(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardEndRetrieve", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardEndRetrieve", "Window");
+ return(C_int_to_Xen_integer(XmClipboardEndRetrieve(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XmClipboardStartRetrieve(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmClipboardStartRetrieve(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmClipboardStartRetrieve "int XmClipboardStartRetrieve (display, window, timestamp) \
prepares to retrieve data from the clipboard"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardStartRetrieve", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardStartRetrieve", "Window");
- XEN_ASSERT_TYPE(XEN_Time_P(arg3), arg3, 3, "XmClipboardStartRetrieve", "Time");
- return(C_TO_XEN_INT(XmClipboardStartRetrieve(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Time(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardStartRetrieve", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardStartRetrieve", "Window");
+ Xen_check_type(Xen_is_Time(arg3), arg3, 3, "XmClipboardStartRetrieve", "Time");
+ return(C_int_to_Xen_integer(XmClipboardStartRetrieve(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Time(arg3))));
}
-static XEN gxm_XmClipboardUnlock(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmClipboardUnlock(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmClipboardUnlock "int XmClipboardUnlock (display, window, remove_all_locks) unlocks the clipboard"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardUnlock", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardUnlock", "Window");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmClipboardUnlock", "boolean");
- return(C_TO_XEN_INT(XmClipboardUnlock(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_BOOLEAN(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardUnlock", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardUnlock", "Window");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmClipboardUnlock", "boolean");
+ return(C_int_to_Xen_integer(XmClipboardUnlock(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_boolean_to_C_bool(arg3))));
}
-static XEN gxm_XmClipboardLock(XEN arg1, XEN arg2)
+static Xen gxm_XmClipboardLock(Xen arg1, Xen arg2)
{
#define H_XmClipboardLock "int XmClipboardLock (display, window) locks the clipboard"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardLock", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardLock", "Window");
- return(C_TO_XEN_INT(XmClipboardLock(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardLock", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardLock", "Window");
+ return(C_int_to_Xen_integer(XmClipboardLock(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XmClipboardUndoCopy(XEN arg1, XEN arg2)
+static Xen gxm_XmClipboardUndoCopy(Xen arg1, Xen arg2)
{
#define H_XmClipboardUndoCopy "int XmClipboardUndoCopy (display, window) deletes the last item placed on the clipboard"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardUndoCopy", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardUndoCopy", "Window");
- return(C_TO_XEN_INT(XmClipboardUndoCopy(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardUndoCopy", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardUndoCopy", "Window");
+ return(C_int_to_Xen_integer(XmClipboardUndoCopy(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XmClipboardCopyByName(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XmClipboardCopyByName(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XmClipboardCopyByName "int XmClipboardCopyByName (display, window, data_id, buf, len, id) copies a data item passed by name"
/* DIFF: XmClipboardCopyByName arg4 is string
*/
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardCopyByName", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardCopyByName", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmClipboardCopyByName", "long");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XmClipboardCopyByName", "XtPointer");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XmClipboardCopyByName", "ulong");
- return(C_TO_XEN_INT(XmClipboardCopyByName(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3),
- (XtPointer)XEN_TO_C_STRING(arg4),
- XEN_TO_C_ULONG(arg5),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardCopyByName", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardCopyByName", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmClipboardCopyByName", "long");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XmClipboardCopyByName", "XtPointer");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XmClipboardCopyByName", "ulong");
+ return(C_int_to_Xen_integer(XmClipboardCopyByName(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3),
+ (XtPointer)Xen_string_to_C_string(arg4),
+ Xen_ulong_to_C_ulong(arg5),
(unsigned long)arg6)));
}
-static XEN gxm_XmClipboardWithdrawFormat(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmClipboardWithdrawFormat(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmClipboardWithdrawFormat "int XmClipboardWithdrawFormat (display, window, data_id) \
indicates that the application no longer wants to supply a data item"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardWithdrawFormat", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardWithdrawFormat", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmClipboardWithdrawFormat", "long");
- return(C_TO_XEN_INT(XmClipboardWithdrawFormat(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardWithdrawFormat", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardWithdrawFormat", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmClipboardWithdrawFormat", "long");
+ return(C_int_to_Xen_integer(XmClipboardWithdrawFormat(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XmClipboardCancelCopy(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmClipboardCancelCopy(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmClipboardCancelCopy "int XmClipboardCancelCopy (display, window, item_id) cancels a copy to the clipboard"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardCancelCopy", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardCancelCopy", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmClipboardCancelCopy", "long");
- return(C_TO_XEN_INT(XmClipboardCancelCopy(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardCancelCopy", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardCancelCopy", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmClipboardCancelCopy", "long");
+ return(C_int_to_Xen_integer(XmClipboardCancelCopy(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XmClipboardEndCopy(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmClipboardEndCopy(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmClipboardEndCopy "int XmClipboardEndCopy (display, window, item_id) completes the \
copying of data to the clipboard"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardEndCopy", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardEndCopy", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmClipboardEndCopy", "long");
- return(C_TO_XEN_INT(XmClipboardEndCopy(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardEndCopy", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardEndCopy", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmClipboardEndCopy", "long");
+ return(C_int_to_Xen_integer(XmClipboardEndCopy(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XmClipboardCopy(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XmClipboardCopy(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XmClipboardCopy "int XmClipboardCopy (display, window, item_id, format_name, buffer, len, id) copies a data item \
to temporary storage for later copying to clipboard"
@@ -6738,35 +6345,35 @@ to temporary storage for later copying to clipboard"
*/
long id;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardCopy", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardCopy", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmClipboardCopy", "long");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XmClipboardCopy", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg5), arg5, 5, "XmClipboardCopy", "XtPointer");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XmClipboardCopy", "ulong");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XmClipboardCopy", "long");
- val = XmClipboardCopy(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_INT(arg3), (char *)XEN_TO_C_STRING(arg4),
- (XtPointer)XEN_TO_C_STRING(arg5), XEN_TO_C_ULONG(arg6),
- XEN_TO_C_INT(arg7), &id);
- return(XEN_LIST_2(C_TO_XEN_INT(val),
- C_TO_XEN_INT(id)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardCopy", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardCopy", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmClipboardCopy", "long");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XmClipboardCopy", "char*");
+ Xen_check_type(Xen_is_string(arg5), arg5, 5, "XmClipboardCopy", "XtPointer");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XmClipboardCopy", "ulong");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XmClipboardCopy", "long");
+ val = XmClipboardCopy(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_integer_to_C_int(arg3), (char *)Xen_string_to_C_string(arg4),
+ (XtPointer)Xen_string_to_C_string(arg5), Xen_ulong_to_C_ulong(arg6),
+ Xen_integer_to_C_int(arg7), &id);
+ return(Xen_list_2(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(id)));
}
/* There's just one clipboard, I think, so these callbacks must be globals */
-static XEN xm_XmCutPasteProc;
+static Xen xm_XmCutPasteProc;
static void gxm_XmCutPasteProc(Widget w, long *data, long *privater, int *reason)
{
- XEN_CALL_4(xm_XmCutPasteProc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_ULONG(*data),
- C_TO_XEN_ULONG(*privater),
- C_TO_XEN_INT(*reason),
- c__FUNCTION__);
+ Xen_call_with_4_args(xm_XmCutPasteProc,
+ C_to_Xen_Widget(w),
+ C_ulong_to_Xen_ulong(*data),
+ C_ulong_to_Xen_ulong(*privater),
+ C_int_to_Xen_integer(*reason),
+ __func__);
}
-static XEN gxm_XmClipboardStartCopy(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XmClipboardStartCopy(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XmClipboardStartCopy "int XmClipboardStartCopy (display, window, clip_label, timestamp, widget, callback) \
sets up a storage and data structure, returns id"
@@ -6774,175 +6381,175 @@ sets up a storage and data structure, returns id"
*/
long id;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardStartCopy", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardStartCopy", "Window");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg3), arg3, 3, "XmClipboardStartCopy", "XmString");
- XEN_ASSERT_TYPE(XEN_Time_P(arg4), arg4, 4, "XmClipboardStartCopy", "Time");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg5), arg5, 5, "XmClipboardStartCopy", "Widget");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg6) && (XEN_REQUIRED_ARGS_OK(arg6, 4)), arg6, 6, "XmClipboardStartCopy", "(XmCutPasteProc widget data priv reason)");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardStartCopy", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardStartCopy", "Window");
+ Xen_check_type(Xen_is_XmString(arg3), arg3, 3, "XmClipboardStartCopy", "XmString");
+ Xen_check_type(Xen_is_Time(arg4), arg4, 4, "XmClipboardStartCopy", "Time");
+ Xen_check_type(Xen_is_Widget(arg5), arg5, 5, "XmClipboardStartCopy", "Widget");
+ Xen_check_type(Xen_is_procedure(arg6) && (Xen_is_aritable(arg6, 4)), arg6, 6, "XmClipboardStartCopy", "(XmCutPasteProc widget data priv reason)");
xm_protect(arg6);
- if (XEN_PROCEDURE_P(xm_XmCutPasteProc)) xm_unprotect(xm_XmCutPasteProc);
+ if (Xen_is_procedure(xm_XmCutPasteProc)) xm_unprotect(xm_XmCutPasteProc);
xm_XmCutPasteProc = arg6;
- val = XmClipboardStartCopy(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_XmString(arg3),
- XEN_TO_C_Time(arg4), XEN_TO_C_Widget(arg5), (XmCutPasteProc)gxm_XmCutPasteProc, &id);
- return(XEN_LIST_2(C_TO_XEN_INT(val),
- C_TO_XEN_INT(id)));
+ val = XmClipboardStartCopy(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_XmString(arg3),
+ Xen_to_C_Time(arg4), Xen_to_C_Widget(arg5), (XmCutPasteProc)gxm_XmCutPasteProc, &id);
+ return(Xen_list_2(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(id)));
}
-static XEN xm_XmVoidProc;
+static Xen xm_XmVoidProc;
static void gxm_XmVoidProc(Widget w, int *data, int *privater, int *reason)
{
- XEN_CALL_4(xm_XmVoidProc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_ULONG(*data),
- C_TO_XEN_ULONG(*privater),
- C_TO_XEN_INT(*reason),
- c__FUNCTION__);
+ Xen_call_with_4_args(xm_XmVoidProc,
+ C_to_Xen_Widget(w),
+ C_ulong_to_Xen_ulong(*data),
+ C_ulong_to_Xen_ulong(*privater),
+ C_int_to_Xen_integer(*reason),
+ __func__);
}
-static XEN gxm_XmClipboardBeginCopy(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmClipboardBeginCopy(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmClipboardBeginCopy "int XmClipboardBeginCopy(display, window, XmString label, widget, callback)"
/* DIFF: XmClipboardBeinCopy omits and returns last arg
*/
long id;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmClipboardBeginCopy", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XmClipboardBeginCopy", "Window");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg3), arg3, 3, "XmClipboardBeginCopy", "XmString");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg4), arg4, 4, "XmClipboardBeginCopy", "Widget");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg5) && (XEN_REQUIRED_ARGS_OK(arg5, 4)), arg5, 5, "XmClipboardBeginCopy", "(XmVoidProc widget data priv reason)");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmClipboardBeginCopy", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XmClipboardBeginCopy", "Window");
+ Xen_check_type(Xen_is_XmString(arg3), arg3, 3, "XmClipboardBeginCopy", "XmString");
+ Xen_check_type(Xen_is_Widget(arg4), arg4, 4, "XmClipboardBeginCopy", "Widget");
+ Xen_check_type(Xen_is_procedure(arg5) && (Xen_is_aritable(arg5, 4)), arg5, 5, "XmClipboardBeginCopy", "(XmVoidProc widget data priv reason)");
xm_protect(arg5);
- if (XEN_PROCEDURE_P(xm_XmVoidProc)) xm_unprotect(xm_XmVoidProc);
+ if (Xen_is_procedure(xm_XmVoidProc)) xm_unprotect(xm_XmVoidProc);
xm_XmVoidProc = arg5;
- val = XmClipboardBeginCopy(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_XmString(arg3), XEN_TO_C_Widget(arg4),
+ val = XmClipboardBeginCopy(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_to_C_XmString(arg3), Xen_to_C_Widget(arg4),
gxm_XmVoidProc, &id);
- return(XEN_LIST_2(C_TO_XEN_INT(val),
- C_TO_XEN_INT(id)));
+ return(Xen_list_2(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(id)));
}
-#define XEN_ScaleWidget_P(Arg) (XEN_Widget_P(Arg) && XmIsScale(XEN_TO_C_Widget(Arg)))
+#define Xen_is_ScaleWidget(Arg) (Xen_is_Widget(Arg) && XmIsScale(Xen_to_C_Widget(Arg)))
-static XEN gxm_XmScaleSetTicks(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XmScaleSetTicks(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XmScaleSetTicks "void XmScaleSetTicks(Widget scale, int big_every, Cardinal num_medium, Cardinal num_small, Dimension size_big, \
Dimension size_medium, Dimension size_small) controls Scale tick marks"
- XEN_ASSERT_TYPE(XEN_ScaleWidget_P(arg1), arg1, 1, "XmScaleSetTicks", "Scale Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmScaleSetTicks", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmScaleSetTicks", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XmScaleSetTicks", "int");
- XEN_ASSERT_TYPE(XEN_Dimension_P(arg5), arg5, 5, "XmScaleSetTicks", "Dimension");
- XEN_ASSERT_TYPE(XEN_Dimension_P(arg6), arg6, 6, "XmScaleSetTicks", "Dimension");
- XEN_ASSERT_TYPE(XEN_Dimension_P(arg7), arg7, 7, "XmScaleSetTicks", "Dimension");
- XmScaleSetTicks(XEN_TO_C_Widget(arg1),
- XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4),
- XEN_TO_C_Dimension(arg5), XEN_TO_C_Dimension(arg6), XEN_TO_C_Dimension(arg7));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ScaleWidget(arg1), arg1, 1, "XmScaleSetTicks", "Scale Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmScaleSetTicks", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmScaleSetTicks", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XmScaleSetTicks", "int");
+ Xen_check_type(Xen_is_Dimension(arg5), arg5, 5, "XmScaleSetTicks", "Dimension");
+ Xen_check_type(Xen_is_Dimension(arg6), arg6, 6, "XmScaleSetTicks", "Dimension");
+ Xen_check_type(Xen_is_Dimension(arg7), arg7, 7, "XmScaleSetTicks", "Dimension");
+ XmScaleSetTicks(Xen_to_C_Widget(arg1),
+ Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4),
+ Xen_to_C_Dimension(arg5), Xen_to_C_Dimension(arg6), Xen_to_C_Dimension(arg7));
+ return(Xen_false);
}
-static XEN gxm_XmCreateScale(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateScale(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateScale "Widget XmCreateScale(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The Scale widget creation function"
return(gxm_new_widget("XmCreateScale", XmCreateScale, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmScaleGetValue(XEN arg1)
+static Xen gxm_XmScaleGetValue(Xen arg1)
{
#define H_XmScaleGetValue "void XmScaleGetValue(Widget widget): returns the current (scale) slider position"
/* DIFF: XmScaleGetValue omits and returns arg2
*/
int val;
- XEN_ASSERT_TYPE(XEN_ScaleWidget_P(arg1), arg1, 1, "XmScaleGetValue", "Scale Widget");
- XmScaleGetValue(XEN_TO_C_Widget(arg1), &val);
- return(C_TO_XEN_INT(val));
+ Xen_check_type(Xen_is_ScaleWidget(arg1), arg1, 1, "XmScaleGetValue", "Scale Widget");
+ XmScaleGetValue(Xen_to_C_Widget(arg1), &val);
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XmScaleSetValue(XEN arg1, XEN arg2)
+static Xen gxm_XmScaleSetValue(Xen arg1, Xen arg2)
{
#define H_XmScaleSetValue "void XmScaleSetValue(Widget widget, int value) sets a Scale slider value"
- XEN_ASSERT_TYPE(XEN_ScaleWidget_P(arg1), arg1, 1, "XmScaleSetValue", "Scale Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmScaleSetValue", "int");
- XmScaleSetValue(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ScaleWidget(arg1), arg1, 1, "XmScaleSetValue", "Scale Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmScaleSetValue", "int");
+ XmScaleSetValue(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-#define XEN_ContainerWidget_P(Arg) (XEN_Widget_P(Arg) && XmIsContainer(XEN_TO_C_Widget(Arg)))
+#define Xen_is_ContainerWidget(Arg) (Xen_is_Widget(Arg) && XmIsContainer(Xen_to_C_Widget(Arg)))
-static XEN gxm_XmContainerPasteLink(XEN arg1)
+static Xen gxm_XmContainerPasteLink(Xen arg1)
{
#define H_XmContainerPasteLink "Boolean XmContainerPasteLink(Widget container) container function to insert links from the clipboard"
- XEN_ASSERT_TYPE(XEN_ContainerWidget_P(arg1), arg1, 1, "XmContainerPasteLink", "Container Widget");
- return(C_TO_XEN_BOOLEAN(XmContainerPasteLink(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_ContainerWidget(arg1), arg1, 1, "XmContainerPasteLink", "Container Widget");
+ return(C_bool_to_Xen_boolean(XmContainerPasteLink(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmContainerCopyLink(XEN arg1, XEN arg2)
+static Xen gxm_XmContainerCopyLink(Xen arg1, Xen arg2)
{
#define H_XmContainerCopyLink "Boolean XmContainerCopyLink(Widget container, Time timestamp) Container function to copy links to the clipboard"
- XEN_ASSERT_TYPE(XEN_ContainerWidget_P(arg1), arg1, 1, "XmContainerCopyLink", "Container Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmContainerCopyLink", "Time");
- return(C_TO_XEN_BOOLEAN(XmContainerCopyLink(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_ContainerWidget(arg1), arg1, 1, "XmContainerCopyLink", "Container Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmContainerCopyLink", "Time");
+ return(C_bool_to_Xen_boolean(XmContainerCopyLink(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmContainerPaste(XEN arg1)
+static Xen gxm_XmContainerPaste(Xen arg1)
{
#define H_XmContainerPaste "Boolean XmContainerPaste(Widget container) Container function to insert items from the clipboard"
- XEN_ASSERT_TYPE(XEN_ContainerWidget_P(arg1), arg1, 1, "XmContainerPaste", "Container Widget");
- return(C_TO_XEN_BOOLEAN(XmContainerPaste(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_ContainerWidget(arg1), arg1, 1, "XmContainerPaste", "Container Widget");
+ return(C_bool_to_Xen_boolean(XmContainerPaste(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmContainerCopy(XEN arg1, XEN arg2)
+static Xen gxm_XmContainerCopy(Xen arg1, Xen arg2)
{
#define H_XmContainerCopy "Boolean XmContainerCopy(Widget container, Time timestamp) Container function to copy primary selection to the clipboard"
- XEN_ASSERT_TYPE(XEN_ContainerWidget_P(arg1), arg1, 1, "XmContainerCopy", "Container Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmContainerCopy", "Time");
- return(C_TO_XEN_BOOLEAN(XmContainerCopy(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_ContainerWidget(arg1), arg1, 1, "XmContainerCopy", "Container Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmContainerCopy", "Time");
+ return(C_bool_to_Xen_boolean(XmContainerCopy(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmContainerCut(XEN arg1, XEN arg2)
+static Xen gxm_XmContainerCut(Xen arg1, Xen arg2)
{
#define H_XmContainerCut "Boolean XmContainerCut(Widget container, Time timestamp) Container function to move items to the clipboard"
- XEN_ASSERT_TYPE(XEN_ContainerWidget_P(arg1), arg1, 1, "XmContainerCut", "Container Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XmContainerCut", "Time");
- return(C_TO_XEN_BOOLEAN(XmContainerCut(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_ContainerWidget(arg1), arg1, 1, "XmContainerCut", "Container Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XmContainerCut", "Time");
+ return(C_bool_to_Xen_boolean(XmContainerCut(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XmContainerReorder(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmContainerReorder(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmContainerReorder "void XmContainerReorder(Widget container, WidgetList widgets, int num_widgets) Container function to reorder children"
/* DIFF: XmContainerReorder arg2 is list of Widgets
*/
int len;
- XEN_ASSERT_TYPE(XEN_ContainerWidget_P(arg1), arg1, 1, "XmContainerReorder", "Container Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XmContainerReorder", "WidgetList");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmContainerReorder", "int");
- len = XEN_TO_C_INT(arg3);
+ Xen_check_type(Xen_is_ContainerWidget(arg1), arg1, 1, "XmContainerReorder", "Container Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmContainerReorder", "WidgetList");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmContainerReorder", "int");
+ len = Xen_integer_to_C_int(arg3);
if (len > 0)
{
- if (len > XEN_LIST_LENGTH(arg2))
- XEN_OUT_OF_RANGE_ERROR("XmContainerReorder", 3, arg3, "len too large");
+ if (len > Xen_list_length(arg2))
+ Xen_out_of_range_error("XmContainerReorder", 3, arg3, "len too large");
else
{
WidgetList ws;
- ws = XEN_TO_C_Widgets(arg2, len);
- XmContainerReorder(XEN_TO_C_Widget(arg1), ws, len);
+ ws = Xen_to_C_Widgets(arg2, len);
+ XmContainerReorder(Xen_to_C_Widget(arg1), ws, len);
if (ws) free(ws);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmContainerRelayout(XEN arg1)
+static Xen gxm_XmContainerRelayout(Xen arg1)
{
#define H_XmContainerRelayout "void XmContainerRelayout(Widget container) Container relayout function"
- XEN_ASSERT_TYPE(XEN_ContainerWidget_P(arg1), arg1, 1, "XmContainerRelayout", "Container Widget");
- XmContainerRelayout(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ContainerWidget(arg1), arg1, 1, "XmContainerRelayout", "Container Widget");
+ XmContainerRelayout(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmContainerGetItemChildren(XEN arg1, XEN arg2)
+static Xen gxm_XmContainerGetItemChildren(Xen arg1, Xen arg2)
{
#define H_XmContainerGetItemChildren "int XmContainerGetItemChildren(Widget container, Widget item) \
returns a list of all children of an item"
@@ -6950,253 +6557,253 @@ returns a list of all children of an item"
*/
Widget *ws;
int len;
- XEN_ASSERT_TYPE(XEN_ContainerWidget_P(arg1), arg1, 1, "XmContainerGetItemChildren", "Container Widget");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg2), arg2, 2, "XmContainerGetItemChildren", "Widget");
- len = XmContainerGetItemChildren(XEN_TO_C_Widget(arg1), XEN_TO_C_Widget(arg2), &ws);
- return(C_TO_XEN_Widgets(ws, len));
+ Xen_check_type(Xen_is_ContainerWidget(arg1), arg1, 1, "XmContainerGetItemChildren", "Container Widget");
+ Xen_check_type(Xen_is_Widget(arg2), arg2, 2, "XmContainerGetItemChildren", "Widget");
+ len = XmContainerGetItemChildren(Xen_to_C_Widget(arg1), Xen_to_C_Widget(arg2), &ws);
+ return(C_to_Xen_Widgets(ws, len));
}
-static XEN gxm_XmCreateContainer(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateContainer(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateContainer "Widget XmCreateContainer(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The Container creation function"
return(gxm_new_widget("XmCreateContainer", XmCreateContainer, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmGetTearOffControl(XEN arg1)
+static Xen gxm_XmGetTearOffControl(Xen arg1)
{
#define H_XmGetTearOffControl "Widget XmGetTearOffControl(Widget menu) obtains the widget ID for the tear-off control in a menu"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmGetTearOffControl", "Widget");
- return(C_TO_XEN_Widget(XmGetTearOffControl(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmGetTearOffControl", "Widget");
+ return(C_to_Xen_Widget(XmGetTearOffControl(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmGetPostedFromWidget(XEN arg1)
+static Xen gxm_XmGetPostedFromWidget(Xen arg1)
{
#define H_XmGetPostedFromWidget "Widget XmGetPostedFromWidget(Widget menu): returns the widget from which a menu was posted"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmGetPostedFromWidget", "Widget");
- return(C_TO_XEN_Widget(XmGetPostedFromWidget(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmGetPostedFromWidget", "Widget");
+ return(C_to_Xen_Widget(XmGetPostedFromWidget(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmCreatePulldownMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreatePulldownMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreatePulldownMenu "Widget XmCreatePulldownMenu(Widget parent, String name, ArgList arglist, Cardinal argcount) \
A RowColumn widget creation function"
return(gxm_new_widget("XmCreatePulldownMenu", XmCreatePulldownMenu, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreatePopupMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreatePopupMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreatePopupMenu "Widget XmCreatePopupMenu(Widget parent, String name, ArgList arglist, Cardinal argcount) \
A RowColumn widget creation function"
return(gxm_new_widget("XmCreatePopupMenu", XmCreatePopupMenu, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateMenuBar(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateMenuBar(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateMenuBar "Widget XmCreateMenuBar(Widget parent, String name, ArgList arglist, Cardinal argcount) \
A RowColumn widget creation function"
return(gxm_new_widget("XmCreateMenuBar", XmCreateMenuBar, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmOptionButtonGadget(XEN arg1)
+static Xen gxm_XmOptionButtonGadget(Xen arg1)
{
#define H_XmOptionButtonGadget "Widget XmOptionButtonGadget(Widget option_menu) obtains \
the widget ID for the CascadeButtonGadget in an OptionMenu"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmOptionButtonGadget", "Widget");
- return(C_TO_XEN_Widget(XmOptionButtonGadget(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmOptionButtonGadget", "Widget");
+ return(C_to_Xen_Widget(XmOptionButtonGadget(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmOptionLabelGadget(XEN arg1)
+static Xen gxm_XmOptionLabelGadget(Xen arg1)
{
#define H_XmOptionLabelGadget "Widget XmOptionLabelGadget(Widget option_menu) obtains the \
widget ID for the LabelGadget in an OptionMenu"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmOptionLabelGadget", "Widget");
- return(C_TO_XEN_Widget(XmOptionLabelGadget(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmOptionLabelGadget", "Widget");
+ return(C_to_Xen_Widget(XmOptionLabelGadget(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XmCreateOptionMenu(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateOptionMenu(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateOptionMenu "Widget XmCreateOptionMenu(Widget parent, String name, ArgList arglist, Cardinal argcount) \
A RowColumn widget creation function"
return(gxm_new_widget("XmCreateOptionMenu", XmCreateOptionMenu, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateRadioBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateRadioBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateRadioBox "Widget XmCreateRadioBox(Widget parent, String name, ArgList arglist, Cardinal argcount) \
A RowColumn widget creation function"
return(gxm_new_widget("XmCreateRadioBox", XmCreateRadioBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateWorkArea(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateWorkArea(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateWorkArea "Widget XmCreateWorkArea(Widget parent, String name, ArgList arglist, Cardinal argcount) \
creates a RowColumn WorkArea"
return(gxm_new_widget("XmCreateWorkArea", XmCreateWorkArea, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateRowColumn(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateRowColumn(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateRowColumn "Widget XmCreateRowColumn(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The RowColumn widget creation function"
return(gxm_new_widget("XmCreateRowColumn", XmCreateRowColumn, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmMenuPosition(XEN arg1, XEN arg2)
+static Xen gxm_XmMenuPosition(Xen arg1, Xen arg2)
{
#define H_XmMenuPosition "void XmMenuPosition(Widget menu, XButtonPressedEvent *event) positions a Popup menu pane"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmMenuPosition", "Widget");
- XEN_ASSERT_TYPE(XEN_XButtonEvent_P(arg2), arg2, 2, "XmMenuPosition", "XButtonPressedEvent*");
- XmMenuPosition(XEN_TO_C_Widget(arg1), XEN_TO_C_XButtonEvent(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmMenuPosition", "Widget");
+ Xen_check_type(Xen_is_XButtonEvent(arg2), arg2, 2, "XmMenuPosition", "XButtonPressedEvent*");
+ XmMenuPosition(Xen_to_C_Widget(arg1), Xen_to_C_XButtonEvent(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmCreateCommandDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateCommandDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateCommandDialog "Widget XmCreateCommandDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The Command CommandDialog creation function"
return(gxm_new_widget("XmCreateCommandDialog", XmCreateCommandDialog, arg1, arg2, arg3, arg4));
}
-#define XEN_CommandWidget_P(Arg) (XEN_Widget_P(Arg) && XmIsCommand(XEN_TO_C_Widget(Arg)))
+#define Xen_is_CommandWidget(Arg) (Xen_is_Widget(Arg) && XmIsCommand(Xen_to_C_Widget(Arg)))
-static XEN gxm_XmCommandError(XEN arg1, XEN arg2)
+static Xen gxm_XmCommandError(Xen arg1, Xen arg2)
{
#define H_XmCommandError "void XmCommandError(Widget widget, XmString error) Command function that displays an error message"
- XEN_ASSERT_TYPE(XEN_CommandWidget_P(arg1), arg1, 1, "XmCommandError", "Command Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmCommandError", "XmString");
- XmCommandError(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_CommandWidget(arg1), arg1, 1, "XmCommandError", "Command Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmCommandError", "XmString");
+ XmCommandError(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmCommandAppendValue(XEN arg1, XEN arg2)
+static Xen gxm_XmCommandAppendValue(Xen arg1, Xen arg2)
{
#define H_XmCommandAppendValue "void XmCommandAppendValue(Widget widget, XmString command) \
appends the passed XmString to the end of the string displayed in the command area of the widget"
- XEN_ASSERT_TYPE(XEN_CommandWidget_P(arg1), arg1, 1, "XmCommandAppendValue", "Command Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmCommandAppendValue", "XmString");
- XmCommandAppendValue(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_CommandWidget(arg1), arg1, 1, "XmCommandAppendValue", "Command Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmCommandAppendValue", "XmString");
+ XmCommandAppendValue(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmCommandSetValue(XEN arg1, XEN arg2)
+static Xen gxm_XmCommandSetValue(Xen arg1, Xen arg2)
{
#define H_XmCommandSetValue "void XmCommandSetValue(Widget widget, XmString command) A Command function that replaces a displayed string"
- XEN_ASSERT_TYPE(XEN_CommandWidget_P(arg1), arg1, 1, "XmCommandSetValue", "Command Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmCommandSetValue", "XmString");
- XmCommandSetValue(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_CommandWidget(arg1), arg1, 1, "XmCommandSetValue", "Command Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmCommandSetValue", "XmString");
+ XmCommandSetValue(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmCommandGetChild(XEN arg1, XEN arg2)
+static Xen gxm_XmCommandGetChild(Xen arg1, Xen arg2)
{
#define H_XmCommandGetChild "Widget XmCommandGetChild(Widget widget, unsigned char child) A Command function that is used to access a component"
- XEN_ASSERT_TYPE(XEN_CommandWidget_P(arg1), arg1, 1, "XmCommandGetChild", "Command Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XmCommandGetChild", "unsigned int");
- return(C_TO_XEN_Widget(XmCommandGetChild(XEN_TO_C_Widget(arg1), XEN_TO_C_ULONG(arg2))));
+ Xen_check_type(Xen_is_CommandWidget(arg1), arg1, 1, "XmCommandGetChild", "Command Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XmCommandGetChild", "unsigned int");
+ return(C_to_Xen_Widget(XmCommandGetChild(Xen_to_C_Widget(arg1), Xen_ulong_to_C_ulong(arg2))));
}
-static XEN gxm_XmCreateCommand(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateCommand(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateCommand "Widget XmCreateCommand(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The Command widget creation function"
return(gxm_new_widget("XmCreateCommand", XmCreateCommand, arg1, arg2, arg3, arg4));
}
-#define XEN_ComboBoxWidget_P(Arg) (XEN_Widget_P(Arg) && XmIsComboBox(XEN_TO_C_Widget(Arg)))
+#define Xen_is_ComboBoxWidget(Arg) (Xen_is_Widget(Arg) && XmIsComboBox(Xen_to_C_Widget(Arg)))
-static XEN gxm_XmComboBoxUpdate(XEN arg1)
+static Xen gxm_XmComboBoxUpdate(Xen arg1)
{
#define H_XmComboBoxUpdate "void XmComboBoxUpdate(Widget widget) A ComboBox function that resynchronizes data"
- XEN_ASSERT_TYPE(XEN_ComboBoxWidget_P(arg1), arg1, 1, "XmComboBoxUpdate", "ComboBox Widget");
- XmComboBoxUpdate(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ComboBoxWidget(arg1), arg1, 1, "XmComboBoxUpdate", "ComboBox Widget");
+ XmComboBoxUpdate(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XmComboBoxSetItem(XEN arg1, XEN arg2)
+static Xen gxm_XmComboBoxSetItem(Xen arg1, Xen arg2)
{
#define H_XmComboBoxSetItem "void XmComboBoxSetItem(Widget w, XmString item) set an item in the XmComboBox list"
- XEN_ASSERT_TYPE(XEN_ComboBoxWidget_P(arg1), arg1, 1, "XmComboBoxSetItem", "ComboBox Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmComboBoxSetItem", "XmString");
- XmComboBoxSetItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ComboBoxWidget(arg1), arg1, 1, "XmComboBoxSetItem", "ComboBox Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmComboBoxSetItem", "XmString");
+ XmComboBoxSetItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmComboBoxSelectItem(XEN arg1, XEN arg2)
+static Xen gxm_XmComboBoxSelectItem(Xen arg1, Xen arg2)
{
#define H_XmComboBoxSelectItem "void XmComboBoxSelectItem(Widget w, XmString item) select a XmComboBox item"
- XEN_ASSERT_TYPE(XEN_ComboBoxWidget_P(arg1), arg1, 1, "XmComboBoxSelectItem", "ComboBox Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmComboBoxSelectItem", "XmString");
- XmComboBoxSelectItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ComboBoxWidget(arg1), arg1, 1, "XmComboBoxSelectItem", "ComboBox Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmComboBoxSelectItem", "XmString");
+ XmComboBoxSelectItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmComboBoxDeletePos(XEN arg1, XEN arg2)
+static Xen gxm_XmComboBoxDeletePos(Xen arg1, Xen arg2)
{
#define H_XmComboBoxDeletePos "void XmComboBoxDeletePos(Widget w, int pos) Delete a XmComboBox item"
- XEN_ASSERT_TYPE(XEN_ComboBoxWidget_P(arg1), arg1, 1, "XmComboBoxDeletePos", "ComboBox Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmComboBoxDeletePos", "int");
- XmComboBoxDeletePos(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ComboBoxWidget(arg1), arg1, 1, "XmComboBoxDeletePos", "ComboBox Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmComboBoxDeletePos", "int");
+ XmComboBoxDeletePos(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmComboBoxAddItem(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmComboBoxAddItem(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmComboBoxAddItem "void XmComboBoxAddItem(Widget w, XmString item, int pos, Boolean unique) add an item to the ComboBox widget"
- XEN_ASSERT_TYPE(XEN_ComboBoxWidget_P(arg1), arg1, 1, "XmComboBoxAddItem", "ComboBox Widget");
- XEN_ASSERT_TYPE(XEN_XmString_P(arg2), arg2, 2, "XmComboBoxAddItem", "XmString");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XmComboBoxAddItem", "int");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg4), arg4, 4, "XmComboBoxAddItem", "Boolean");
- XmComboBoxAddItem(XEN_TO_C_Widget(arg1), XEN_TO_C_XmString(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_BOOLEAN(arg4));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_ComboBoxWidget(arg1), arg1, 1, "XmComboBoxAddItem", "ComboBox Widget");
+ Xen_check_type(Xen_is_XmString(arg2), arg2, 2, "XmComboBoxAddItem", "XmString");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XmComboBoxAddItem", "int");
+ Xen_check_type(Xen_is_boolean(arg4), arg4, 4, "XmComboBoxAddItem", "Boolean");
+ XmComboBoxAddItem(Xen_to_C_Widget(arg1), Xen_to_C_XmString(arg2), Xen_integer_to_C_int(arg3), Xen_boolean_to_C_bool(arg4));
+ return(Xen_false);
}
-static XEN gxm_XmCreateDropDownList(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateDropDownList(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateDropDownList "Widget XmCreateDropDownList(Widget parent, String name, ArgList arglist, Cardinal arg_count) \
The Drop-down list ComboBox widget creation function"
return(gxm_new_widget("XmCreateDropDownList", XmCreateDropDownList, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateDropDownComboBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateDropDownComboBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateDropDownComboBox "Widget XmCreateDropDownComboBox(Widget parent, String name, ArgList arglist, Cardinal arg_count) \
The Drop-down ComboBox widget creation function"
return(gxm_new_widget("XmCreateDropDownComboBox", XmCreateDropDownComboBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateComboBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateComboBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateComboBox "Widget XmCreateComboBox(Widget parent, String name, ArgList arglist, Cardinal arg_count) \
The default ComboBox widget creation function"
return(gxm_new_widget("XmCreateComboBox", XmCreateComboBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreatePushButton(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreatePushButton(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreatePushButton "Widget XmCreatePushButton(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The PushButton widget creation function"
return(gxm_new_widget("XmCreatePushButton", XmCreatePushButton, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreatePushButtonGadget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreatePushButtonGadget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreatePushButtonGadget "Widget XmCreatePushButtonGadget(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The PushButtonGadget creation function"
return(gxm_new_widget("XmCreatePushButtonGadget", XmCreatePushButtonGadget, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCascadeButtonHighlight(XEN arg1, XEN arg2)
+static Xen gxm_XmCascadeButtonHighlight(Xen arg1, Xen arg2)
{
#define H_XmCascadeButtonHighlight "void XmCascadeButtonHighlight(Widget cascadeButton, Boolean highlight) A CascadeButton and \
CascadeButtonGadget function that sets the highlight state"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmCascadeButtonHighlight", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmCascadeButtonHighlight", "boolean");
- XmCascadeButtonHighlight(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmCascadeButtonHighlight", "Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmCascadeButtonHighlight", "boolean");
+ XmCascadeButtonHighlight(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmCreateCascadeButton(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateCascadeButton(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateCascadeButton "Widget XmCreateCascadeButton(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The CascadeButton widget creation function"
@@ -7205,118 +6812,197 @@ The CascadeButton widget creation function"
static void gxm_ProtocolProc(Widget w, XtPointer context, XtPointer info)
{
- XEN descr = (XEN)context;
- XEN_CALL_3(XEN_CADR(descr),
- C_TO_XEN_Widget(w),
- XEN_CADDR(descr),
- XEN_WRAP_C_POINTER(info), /* what's this? */
- c__FUNCTION__);
+ Xen descr = (Xen)context;
+ Xen_call_with_3_args(Xen_cadr(descr),
+ C_to_Xen_Widget(w),
+ Xen_caddr(descr),
+ Xen_wrap_C_pointer(info), /* what's this? */
+ __func__);
}
-#define C_TO_XEN_XM_ProtocolHook(Code, Context, PropertyAtom, ProtocolAtom) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("ProtocolHook"), Code, Context, PropertyAtom, ProtocolAtom)
-/* #define XM_ProtocolHook_P(Arg) WRAP_P("ProtocolHook", Arg) */
+#define C_to_Xen_XM_ProtocolHook(Code, Context, PropertyAtom, ProtocolAtom) \
+ Xen_list_5(C_string_to_Xen_symbol("ProtocolHook"), Code, Context, PropertyAtom, ProtocolAtom)
+/* #define XM_ProtocolHook_P(Arg) is_wrapped("ProtocolHook", Arg) */
-#define C_TO_XEN_XM_ProtocolProc(Code, Context, PropertyAtom, ProtocolAtom) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("ProtocolProc"), Code, Context, PropertyAtom, ProtocolAtom)
-#define XM_ProtocolProc_P(Arg) WRAP_P("ProtocolProc", Arg)
+#define C_to_Xen_XM_ProtocolProc(Code, Context, PropertyAtom, ProtocolAtom) \
+ Xen_list_5(C_string_to_Xen_symbol("ProtocolProc"), Code, Context, PropertyAtom, ProtocolAtom)
+#define XM_is_ProtocolProc(Arg) is_wrapped("ProtocolProc", Arg)
-static XEN gxm_XmSetProtocolHooks(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XmSetProtocolHooks(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XmSetProtocolHooks "void XmSetProtocolHooks(Widget shell, Atom property, Atom protocol, XtCallbackProc prehook, \
XtPointer pre_closure, XtCallbackProc posthook, XtPointer post_closure) A VendorShell function that allows preactions and postactions \
to be executed when a protocol message is received from MWM"
- XEN descr1, descr2;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmSetProtocolHooks", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmSetProtocolHooks", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XmSetProtocolHooks", "Atom");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 3)), arg4, 4, "XmSetProtocolHooks", "(XtCallbackProc widget data callb)");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg6) && (XEN_REQUIRED_ARGS_OK(arg6, 3)), arg6, 6, "XmSetProtocolHooks", "(XtCallbackProc widget data callb)");
- descr1 = C_TO_XEN_XM_ProtocolHook(arg4, arg5, arg2, arg3);
- descr2 = C_TO_XEN_XM_ProtocolHook(arg6, arg7, arg2, arg3);
+ Xen descr1, descr2;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmSetProtocolHooks", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmSetProtocolHooks", "Atom");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XmSetProtocolHooks", "Atom");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 3)), arg4, 4, "XmSetProtocolHooks", "(XtCallbackProc widget data callb)");
+ Xen_check_type(Xen_is_procedure(arg6) && (Xen_is_aritable(arg6, 3)), arg6, 6, "XmSetProtocolHooks", "(XtCallbackProc widget data callb)");
+ descr1 = C_to_Xen_XM_ProtocolHook(arg4, arg5, arg2, arg3);
+ descr2 = C_to_Xen_XM_ProtocolHook(arg6, arg7, arg2, arg3);
xm_protect(descr1);
xm_protect(descr2);
- XmSetProtocolHooks(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2), XEN_TO_C_Atom(arg3),
+ XmSetProtocolHooks(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2), Xen_to_C_Atom(arg3),
gxm_ProtocolProc, (XtPointer)descr1,
gxm_ProtocolProc, (XtPointer)descr2);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmDeactivateProtocol(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmSetWMProtocolHooks(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
+{
+ #define H_XmSetWMProtocolHooks "void XmSetWMProtocolHooks(Widget shell, Atom property, XtCallbackProc prehook, \
+XtPointer pre_closure, XtCallbackProc posthook, XtPointer post_closure) A VendorShell function that allows preactions and postactions \
+to be executed when a protocol message is received from MWM"
+ Xen descr1, descr2, wm_atom;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmSetWMProtocolHooks", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmSetWMProtocolHooks", "Atom");
+ Xen_check_type(Xen_is_procedure(arg3) && (Xen_is_aritable(arg3, 3)), arg3, 3, "XmSetWMProtocolHooks", "(XtCallbackProc widget data callb)");
+ Xen_check_type(Xen_is_procedure(arg5) && (Xen_is_aritable(arg5, 3)), arg5, 5, "XmSetWMProtocolHooks", "(XtCallbackProc widget data callb)");
+ wm_atom = C_to_Xen_Atom(XInternAtom(XtDisplay(Xen_to_C_Widget(arg1)), "WM_PROTOCOLS", false));
+ descr1 = C_to_Xen_XM_ProtocolHook(arg3, arg4, arg2, wm_atom);
+ descr2 = C_to_Xen_XM_ProtocolHook(arg5, arg6, arg2, wm_atom);
+ xm_protect(descr1);
+ xm_protect(descr2);
+ XmSetWMProtocolHooks(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2),
+ gxm_ProtocolProc, (XtPointer)descr1,
+ gxm_ProtocolProc, (XtPointer)descr2);
+ return(Xen_false);
+}
+
+static Xen gxm_XmDeactivateProtocol(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmDeactivateProtocol "void XmDeactivateProtocol(Widget shell, Atom property, Atom protocol) \
deactivates a protocol without removing it"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmDeactivateProtocol", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmDeactivateProtocol", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XmDeactivateProtocol", "Atom");
- XmDeactivateProtocol(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2), XEN_TO_C_Atom(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDeactivateProtocol", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmDeactivateProtocol", "Atom");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XmDeactivateProtocol", "Atom");
+ XmDeactivateProtocol(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2), Xen_to_C_Atom(arg3));
+ return(Xen_false);
+}
+
+static Xen gxm_XmDeactivateWMProtocol(Xen arg1, Xen arg2)
+{
+ #define H_XmDeactivateWMProtocol "void XmDeactivateWMProtocol(Widget shell, Atom property) \
+deactivates a property in WM_PROTOCOLS without removing it"
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmDeactivateProtocol", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmDeactivateProtocol", "Atom");
+ XmDeactivateWMProtocol(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmActivateProtocol(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmActivateProtocol(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmActivateProtocol "oid XmActivateProtocol(Widget shell, Atom property, Atom protocol) activates a protocol"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmActivateProtocol", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmActivateProtocol", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XmActivateProtocol", "Atom");
- XmActivateProtocol(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2), XEN_TO_C_Atom(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmActivateProtocol", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmActivateProtocol", "Atom");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XmActivateProtocol", "Atom");
+ XmActivateProtocol(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2), Xen_to_C_Atom(arg3));
+ return(Xen_false);
+}
+
+static Xen gxm_XmActivateWMProtocol(Xen arg1, Xen arg2)
+{
+ #define H_XmActivateWMProtocol "oid XmActivateWMProtocol(Widget shell, Atom property) activates a property in the WM_PROTOCOLS"
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmActivateProtocol", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmActivateProtocol", "Atom");
+ XmActivateWMProtocol(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2));
+ return(Xen_false);
}
-static bool unprotect_protocolproc(XEN val, int loc, unsigned long udescr)
+static bool unprotect_protocolproc(Xen val, int loc, unsigned long udescr)
{
- XEN descr = (XEN)udescr; /* ('protocolproc func data propatom protoatom) */
- return((XM_ProtocolProc_P(val)) &&
- (XEN_TO_C_ULONG(XEN_CADR(val)) == XEN_TO_C_ULONG(XEN_CADR(descr))) &&
- (XEN_TO_C_ULONG(XEN_CADDR(val)) == XEN_TO_C_ULONG(XEN_CADDR(descr))) &&
- (XEN_TO_C_Atom(XEN_LIST_REF(val, 3)) == XEN_TO_C_Atom(XEN_LIST_REF(val,3))) &&
- (XEN_TO_C_Atom(XEN_LIST_REF(val, 4)) == XEN_TO_C_Atom(XEN_LIST_REF(val,4))));
+ Xen descr = (Xen)udescr; /* ('protocolproc func data propatom protoatom) */
+ return((XM_is_ProtocolProc(val)) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(val)) == Xen_ulong_to_C_ulong(Xen_cadr(descr))) &&
+ (Xen_ulong_to_C_ulong(Xen_caddr(val)) == Xen_ulong_to_C_ulong(Xen_caddr(descr))) &&
+ (Xen_to_C_Atom(Xen_list_ref(val, 3)) == Xen_to_C_Atom(Xen_list_ref(val,3))) &&
+ (Xen_to_C_Atom(Xen_list_ref(val, 4)) == Xen_to_C_Atom(Xen_list_ref(val,4))));
}
-static XEN gxm_XmRemoveProtocolCallback(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmRemoveProtocolCallback(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmRemoveProtocolCallback "void XmRemoveProtocolCallback(Widget shell, Atom property, Atom protocol, XtCallbackProc callback, \
XtPointer closure) removes a callback from the internal list"
- XEN descr;
+ Xen descr;
int loc, dloc;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmRemoveProtocolCallback", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmRemoveProtocolCallback", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XmRemoveProtocolCallback", "Atom");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 3)), arg4, 4, "XmRemoveProtocolCallback", "XtCallbackProc (3 args)");
- descr = C_TO_XEN_XM_ProtocolProc(arg4, arg5, arg2, arg3);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmRemoveProtocolCallback", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmRemoveProtocolCallback", "Atom");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XmRemoveProtocolCallback", "Atom");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 3)), arg4, 4, "XmRemoveProtocolCallback", "XtCallbackProc (3 args)");
+ descr = C_to_Xen_XM_ProtocolProc(arg4, arg5, arg2, arg3);
dloc = xm_protect(descr);
loc = map_over_protected_elements(unprotect_protocolproc, (unsigned long)descr);
- XmRemoveProtocolCallback(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Atom(arg2),
- XEN_TO_C_Atom(arg3),
+ XmRemoveProtocolCallback(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2),
+ Xen_to_C_Atom(arg3),
gxm_ProtocolProc,
- (XtPointer)(XEN_VECTOR_REF(xm_protected, loc))); /* this was the original tag passed in */
+ (XtPointer)(Xen_vector_ref(xm_protected, loc))); /* this was the original tag passed in */
/* now unprotect the proc and our descr */
xm_unprotect_at(dloc);
xm_unprotect_at(loc);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmAddProtocolCallback(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XmRemoveWMProtocolCallback(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
+{
+ #define H_XmRemoveWMProtocolCallback "void XmRemoveWMProtocolCallback(Widget shell, Atom property, XtCallbackProc callback, \
+XtPointer closure) removes a callback from the WM_PROTOCOLS list"
+ Xen descr;
+ int loc, dloc;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmRemoveWMProtocolCallback", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmRemoveWMProtocolCallback", "Atom");
+ Xen_check_type(Xen_is_procedure(arg3) && (Xen_is_aritable(arg3, 3)), arg3, 3, "XmRemoveWMProtocolCallback", "XtCallbackProc (3 args)");
+ descr = C_to_Xen_XM_ProtocolProc(arg3, arg4, arg2, C_to_Xen_Atom(XInternAtom(XtDisplay(Xen_to_C_Widget(arg1)), "WM_PROTOCOLS", false)));
+ dloc = xm_protect(descr);
+ loc = map_over_protected_elements(unprotect_protocolproc, (unsigned long)descr);
+ XmRemoveWMProtocolCallback(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2),
+ gxm_ProtocolProc,
+ (XtPointer)(Xen_vector_ref(xm_protected, loc))); /* this was the original tag passed in */
+ /* now unprotect the proc and our descr */
+ xm_unprotect_at(dloc);
+ xm_unprotect_at(loc);
+ return(Xen_false);
+}
+
+static Xen gxm_XmAddProtocolCallback(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XmAddProtocolCallback "void XmAddProtocolCallback(Widget shell, Atom property, Atom protocol, XtCallbackProc callback, \
XtPointer closure) adds client callbacks for a protocol"
- XEN descr;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmAddProtocolCallback", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmAddProtocolCallback", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XmAddProtocolCallback", "Atom");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 3)), arg4, 4, "XmAddProtocolCallback", "(XtCallbackProc widget data callb)");
- descr = C_TO_XEN_XM_ProtocolProc(arg4, arg5, arg2, arg3);
+ Xen descr;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmAddProtocolCallback", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmAddProtocolCallback", "Atom");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XmAddProtocolCallback", "Atom");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 3)), arg4, 4, "XmAddProtocolCallback", "(XtCallbackProc widget data callb)");
+ descr = C_to_Xen_XM_ProtocolProc(arg4, arg5, arg2, arg3);
xm_protect(descr);
- XmAddProtocolCallback(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Atom(arg2),
- XEN_TO_C_Atom(arg3),
+ XmAddProtocolCallback(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2),
+ Xen_to_C_Atom(arg3),
gxm_ProtocolProc,
(XtPointer)descr);
- return(XEN_FALSE);
+ return(Xen_false);
+}
+
+static Xen gxm_XmAddWMProtocolCallback(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
+{
+ #define H_XmAddWMProtocolCallback "void XmAddWMProtocolCallback(Widget shell, Atom property, XtCallbackProc callback, \
+XtPointer closure) adds client callbacks for the WM_PROTOCOLS"
+ Xen descr;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmAddWMProtocolCallback", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmAddWMProtocolCallback", "Atom");
+ Xen_check_type(Xen_is_procedure(arg3) && (Xen_is_aritable(arg3, 3)), arg3, 3, "XmAddWMProtocolCallback", "(XtCallbackProc widget data callb)");
+ descr = C_to_Xen_XM_ProtocolProc(arg3, arg4, arg2, C_to_Xen_Atom(XInternAtom(XtDisplay(Xen_to_C_Widget(arg1)), "WM_PROTOCOLS", false)));
+ xm_protect(descr);
+ XmAddWMProtocolCallback(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2),
+ gxm_ProtocolProc,
+ (XtPointer)descr);
+ return(Xen_false);
}
-static XEN gxm_XmRemoveProtocols(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmRemoveProtocols(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmRemoveProtocols "void XmRemoveProtocols(Widget shell, Atom property, Atom *protocols, Cardinal num_protocols) \
removes the protocols from the protocol manager and deallocates the internal tables"
@@ -7324,19 +7010,36 @@ removes the protocols from the protocol manager and deallocates the internal tab
*/
Atom *outs;
int len;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmRemoveProtocols", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmRemoveProtocols", "Atom");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XmRemoveProtocols", "list of Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg4), arg4, 4, "XmRemoveProtocols", "int");
- if (XEN_INTEGER_P(arg4)) len = XEN_TO_C_INT(arg4); else len = XEN_LIST_LENGTH(arg3);
- if (len <= 0) return(XEN_FALSE);
- outs = XEN_TO_C_Atoms(arg3, len);
- XmRemoveProtocols(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2), outs, len);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmRemoveProtocols", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmRemoveProtocols", "Atom");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XmRemoveProtocols", "list of Atom");
+ Xen_check_type(Xen_is_integer_or_unbound(arg4), arg4, 4, "XmRemoveProtocols", "int");
+ if (Xen_is_integer(arg4)) len = Xen_integer_to_C_int(arg4); else len = Xen_list_length(arg3);
+ if (len <= 0) return(Xen_false);
+ outs = Xen_to_C_Atoms(arg3, len);
+ XmRemoveProtocols(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2), outs, len);
free(outs);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmAddProtocols(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmRemoveWMProtocols(Xen arg1, Xen arg2, Xen arg3)
+{
+ #define H_XmRemoveWMProtocols "void XmRemoveWMProtocols(Widget shell, Atom *protocols, Cardinal num_protocols) \
+removes the protocols from WM_PROTOCOLS"
+ Atom *outs;
+ int len;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmRemoveWMProtocols", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmRemoveWMProtocols", "list of Atom");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmRemoveWMProtocols", "int");
+ if (Xen_is_integer(arg3)) len = Xen_integer_to_C_int(arg3); else len = Xen_list_length(arg2);
+ if (len <= 0) return(Xen_false);
+ outs = Xen_to_C_Atoms(arg2, len);
+ XmRemoveWMProtocols(Xen_to_C_Widget(arg1), outs, len);
+ free(outs);
+ return(Xen_false);
+}
+
+static Xen gxm_XmAddProtocols(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmAddProtocols "void XmAddProtocols(Widget shell, Atom property, Atom *protocols, Cardinal num_protocols) \
adds the protocols to the protocol manager and allocates the internal tables"
@@ -7344,514 +7047,531 @@ adds the protocols to the protocol manager and allocates the internal tables"
*/
Atom *outs;
int len;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmAddProtocols", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmAddProtocols", "Atom");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XmAddProtocols", "list of Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg4), arg4, 4, "XmAddProtocols", "int");
- if (XEN_INTEGER_P(arg4)) len = XEN_TO_C_INT(arg4); else len = XEN_LIST_LENGTH(arg3);
- if (len <= 0) return(XEN_FALSE);
- outs = XEN_TO_C_Atoms(arg3, len);
- XmAddProtocols(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2), outs, len);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmAddProtocols", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmAddProtocols", "Atom");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XmAddProtocols", "list of Atom");
+ Xen_check_type(Xen_is_integer_or_unbound(arg4), arg4, 4, "XmAddProtocols", "int");
+ if (Xen_is_integer(arg4)) len = Xen_integer_to_C_int(arg4); else len = Xen_list_length(arg3);
+ if (len <= 0) return(Xen_false);
+ outs = Xen_to_C_Atoms(arg3, len);
+ XmAddProtocols(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2), outs, len);
+ free(outs);
+ return(Xen_false);
+}
+
+static Xen gxm_XmAddWMProtocols(Xen arg1, Xen arg2, Xen arg3)
+{
+ #define H_XmAddWMProtocols "void XmAddWMProtocols(Widget shell, Atom *protocols, Cardinal num_protocols) \
+adds the protocols to WM_PROTOCOLS"
+ Atom *outs;
+ int len;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmAddWMProtocols", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XmAddWMProtocols", "list of Atom");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XmAddWMProtocols", "int");
+ if (Xen_is_integer(arg3)) len = Xen_integer_to_C_int(arg3); else len = Xen_list_length(arg2);
+ if (len <= 0) return(Xen_false);
+ outs = Xen_to_C_Atoms(arg2, len);
+ XmAddWMProtocols(Xen_to_C_Widget(arg1), outs, len);
free(outs);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XmCascadeButtonGadgetHighlight(XEN arg1, XEN arg2)
+static Xen gxm_XmCascadeButtonGadgetHighlight(Xen arg1, Xen arg2)
{
#define H_XmCascadeButtonGadgetHighlight "void XmCascadeButtonGadgetHighlight(Widget cascadeButtonGadget, Boolean highlight) \
A CascadeButtonGadget function that sets the highlight state"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmCascadeButtonGadgetHighlight", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XmCascadeButtonGadgetHighlight", "boolean");
- XmCascadeButtonGadgetHighlight(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmCascadeButtonGadgetHighlight", "Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XmCascadeButtonGadgetHighlight", "boolean");
+ XmCascadeButtonGadgetHighlight(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2));
+ return(Xen_false);
}
-static XEN gxm_XmCreateCascadeButtonGadget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateCascadeButtonGadget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateCascadeButtonGadget "Widget XmCreateCascadeButtonGadget(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The CascadeButtonGadget creation function"
return(gxm_new_widget("XmCreateCascadeButtonGadget", XmCreateCascadeButtonGadget, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateBulletinBoardDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateBulletinBoardDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateBulletinBoardDialog "Widget XmCreateBulletinBoardDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The BulletinBoard BulletinBoardDialog creation function"
return(gxm_new_widget("XmCreateBulletinBoardDialog", XmCreateBulletinBoardDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateBulletinBoard(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateBulletinBoard(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateBulletinBoard "Widget XmCreateBulletinBoard(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The BulletinBoard widget creation function"
return(gxm_new_widget("XmCreateBulletinBoard", XmCreateBulletinBoard, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreatePanedWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreatePanedWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreatePanedWindow "Widget XmCreatePanedWindow(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The PanedWindow widget creation function"
return(gxm_new_widget("XmCreatePanedWindow", XmCreatePanedWindow, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmGetAtomName(XEN arg1, XEN arg2)
+static Xen gxm_XmGetAtomName(Xen arg1, Xen arg2)
{
char *str;
- XEN res;
+ Xen res;
#define H_XmGetAtomName "String XmGetAtomName(Display *display, Atom atom) returns the string representation for an atom"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmGetAtomName", "Display*");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XmGetAtomName", "Atom");
- str = XmGetAtomName(XEN_TO_C_Display(arg1), XEN_TO_C_Atom(arg2));
- res = C_TO_XEN_STRING(str);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmGetAtomName", "Display*");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XmGetAtomName", "Atom");
+ str = XmGetAtomName(Xen_to_C_Display(arg1), Xen_to_C_Atom(arg2));
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XmInternAtom(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XmInternAtom(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XmInternAtom "A macro that returns an atom for a given name"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XmInternAtom", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XmInternAtom", "String");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XmInternAtom", "Boolean");
- return(C_TO_XEN_Atom(XmInternAtom(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2), XEN_TO_C_BOOLEAN(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XmInternAtom", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XmInternAtom", "String");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XmInternAtom", "Boolean");
+ return(C_to_Xen_Atom(XmInternAtom(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2), Xen_boolean_to_C_bool(arg3))));
}
-static XEN gxm_XmNotebookGetPageInfo(XEN arg1, XEN arg2)
+static Xen gxm_XmNotebookGetPageInfo(Xen arg1, Xen arg2)
{
#define H_XmNotebookGetPageInfo "XmNotebookPageStatus XmNotebookGetPageInfo(Widget notebook, int page_number) \
A Notebook function that returns page information"
XmNotebookPageInfo *info;
int err;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmNotebookGetPageInfo", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XmNotebookGetPageInfo", "int");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmNotebookGetPageInfo", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XmNotebookGetPageInfo", "int");
info = (XmNotebookPageInfo *)calloc(1, sizeof(XmNotebookPageInfo));
- err = XmNotebookGetPageInfo(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2), info);
- return(XEN_LIST_2(C_TO_XEN_INT(err), C_TO_XEN_XmNotebookPageInfo(info)));
+ err = XmNotebookGetPageInfo(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2), info);
+ return(Xen_list_2(C_int_to_Xen_integer(err), C_to_Xen_XmNotebookPageInfo(info)));
}
-static XEN gxm_XmCreateNotebook(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateNotebook(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateNotebook "void XmCreateNotebook(Widget parent, String name, ArgList arglist, Cardinal argcount) The Notebook widget creation function"
return(gxm_new_widget("XmCreateNotebook", XmCreateNotebook, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateArrowButton(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateArrowButton(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateArrowButton "Widget XmCreateArrowButton(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The ArrowButton widget creation function"
return(gxm_new_widget("XmCreateArrowButton", XmCreateArrowButton, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateArrowButtonGadget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateArrowButtonGadget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateArrowButtonGadget "Widget XmCreateArrowButtonGadget(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The ArrowButtonGadget creation function"
return(gxm_new_widget("XmCreateArrowButtonGadget", XmCreateArrowButtonGadget, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmMessageBoxGetChild(XEN arg1, XEN arg2)
+static Xen gxm_XmMessageBoxGetChild(Xen arg1, Xen arg2)
{
#define H_XmMessageBoxGetChild "Widget XmMessageBoxGetChild(Widget widget, unsigned char child) A MessageBox function that is used to access a component"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XmMessageBoxGetChild", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XmMessageBoxGetChild", "unsigned int");
- return(C_TO_XEN_Widget(XmMessageBoxGetChild(XEN_TO_C_Widget(arg1), XEN_TO_C_ULONG(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XmMessageBoxGetChild", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XmMessageBoxGetChild", "unsigned int");
+ return(C_to_Xen_Widget(XmMessageBoxGetChild(Xen_to_C_Widget(arg1), Xen_ulong_to_C_ulong(arg2))));
}
-static XEN gxm_XmCreateTemplateDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateTemplateDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateTemplateDialog "Widget XmCreateTemplateDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
A MessageBox TemplateDialog creation function"
return(gxm_new_widget("XmCreateTemplateDialog", XmCreateTemplateDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateWorkingDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateWorkingDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateWorkingDialog "Widget XmCreateWorkingDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MessageBox WorkingDialog creation function"
return(gxm_new_widget("XmCreateWorkingDialog", XmCreateWorkingDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateWarningDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateWarningDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateWarningDialog "Widget XmCreateWarningDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MessageBox WarningDialog creation function"
return(gxm_new_widget("XmCreateWarningDialog", XmCreateWarningDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateQuestionDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateQuestionDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateQuestionDialog "Widget XmCreateQuestionDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MessageBox QuestionDialog creation function"
return(gxm_new_widget("XmCreateQuestionDialog", XmCreateQuestionDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateInformationDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateInformationDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateInformationDialog "Widget XmCreateInformationDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MessageBox InformationDialog creation function"
return(gxm_new_widget("XmCreateInformationDialog", XmCreateInformationDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateErrorDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateErrorDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateErrorDialog "Widget XmCreateErrorDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MessageBox ErrorDialog creation function"
return(gxm_new_widget("XmCreateErrorDialog", XmCreateErrorDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateMessageDialog(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateMessageDialog(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateMessageDialog "Widget XmCreateMessageDialog(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MessageBox MessageDialog creation function"
return(gxm_new_widget("XmCreateMessageDialog", XmCreateMessageDialog, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmCreateMessageBox(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XmCreateMessageBox(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XmCreateMessageBox "Widget XmCreateMessageBox(Widget parent, String name, ArgList arglist, Cardinal argcount) \
The MessageBox widget creation function"
return(gxm_new_widget("XmCreateMessageBox", XmCreateMessageBox, arg1, arg2, arg3, arg4));
}
-static XEN gxm_XmIsMessageBox(XEN arg)
+static Xen gxm_XmIsMessageBox(Xen arg)
{
#define H_XmIsMessageBox "XmIsMessageBox(arg): " PROC_TRUE " if arg is a MessageBox widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsMessageBox", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsMessageBox(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsMessageBox", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsMessageBox(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsArrowButtonGadget(XEN arg)
+static Xen gxm_XmIsArrowButtonGadget(Xen arg)
{
#define H_XmIsArrowButtonGadget "XmIsArrowButtonGadget(arg): " PROC_TRUE " if arg is an ArrowButton gadget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsArrowButtonGadget", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsArrowButtonGadget(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsArrowButtonGadget", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsArrowButtonGadget(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsArrowButton(XEN arg)
+static Xen gxm_XmIsArrowButton(Xen arg)
{
#define H_XmIsArrowButton "XmIsArrowButton(arg): " PROC_TRUE " if arg is an ArrowButton widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsArrowButton", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsArrowButton(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsArrowButton", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsArrowButton(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsNotebook(XEN arg)
+static Xen gxm_XmIsNotebook(Xen arg)
{
#define H_XmIsNotebook "XmIsNotebook(arg): " PROC_TRUE " if arg is a Notebook widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsNotebook", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsNotebook(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsNotebook", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsNotebook(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsPanedWindow(XEN arg)
+static Xen gxm_XmIsPanedWindow(Xen arg)
{
#define H_XmIsPanedWindow "XmIsPanedWindow(arg): " PROC_TRUE " if arg is a PanedWindow widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsPanedWindow", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsPanedWindow(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsPanedWindow", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsPanedWindow(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsBulletinBoard(XEN arg)
+static Xen gxm_XmIsBulletinBoard(Xen arg)
{
#define H_XmIsBulletinBoard "XmIsBulletinBoard(arg): " PROC_TRUE " if arg is a BulletinBoard widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsBulletinBoard", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsBulletinBoard(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsBulletinBoard", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsBulletinBoard(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsPrimitive(XEN arg)
+static Xen gxm_XmIsPrimitive(Xen arg)
{
#define H_XmIsPrimitive "XmIsPrimitive(arg): " PROC_TRUE " if arg is a Primitive widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsPrimitive", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsPrimitive(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsPrimitive", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsPrimitive(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsCascadeButtonGadget(XEN arg)
+static Xen gxm_XmIsCascadeButtonGadget(Xen arg)
{
#define H_XmIsCascadeButtonGadget "XmIsCascadeButtonGadget(arg): " PROC_TRUE " if arg is a CascadeButtonGadget gadget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsCascadeButtonGadget", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsCascadeButtonGadget(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsCascadeButtonGadget", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsCascadeButtonGadget(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsCascadeButton(XEN arg)
+static Xen gxm_XmIsCascadeButton(Xen arg)
{
#define H_XmIsCascadeButton "XmIsCascadeButton(arg): " PROC_TRUE " if arg is a CascadeButton widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsCascadeButton", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsCascadeButton(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsCascadeButton", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsCascadeButton(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsPushButtonGadget(XEN arg)
+static Xen gxm_XmIsPushButtonGadget(Xen arg)
{
#define H_XmIsPushButtonGadget "XmIsPushButtonGadget(arg): " PROC_TRUE " if arg is a PushButtonGadget gadget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsPushButtonGadget", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsPushButtonGadget(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsPushButtonGadget", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsPushButtonGadget(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsPushButton(XEN arg)
+static Xen gxm_XmIsPushButton(Xen arg)
{
#define H_XmIsPushButton "XmIsPushButton(arg): " PROC_TRUE " if arg is a PushButton widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsPushButton", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsPushButton(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsPushButton", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsPushButton(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsComboBox(XEN arg)
+static Xen gxm_XmIsComboBox(Xen arg)
{
#define H_XmIsComboBox "XmIsComboBox(arg): " PROC_TRUE " if arg is a ComboBox widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsComboBox", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsComboBox(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsComboBox", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsComboBox(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsCommand(XEN arg)
+static Xen gxm_XmIsCommand(Xen arg)
{
#define H_XmIsCommand "XmIsCommand(arg): " PROC_TRUE " if arg is a Command widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsCommand", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsCommand(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsCommand", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsCommand(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsRowColumn(XEN arg)
+static Xen gxm_XmIsRowColumn(Xen arg)
{
#define H_XmIsRowColumn "XmIsRowColumn(arg): " PROC_TRUE " if arg is a RowColumn widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsRowColumn", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsRowColumn(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsRowColumn", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsRowColumn(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsContainer(XEN arg)
+static Xen gxm_XmIsContainer(Xen arg)
{
#define H_XmIsContainer "XmIsContainer(arg): " PROC_TRUE " if arg is a Container widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsContainer", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsContainer(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsContainer", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsContainer(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsScreen(XEN arg)
+static Xen gxm_XmIsScreen(Xen arg)
{
#define H_XmIsScreen "XmIsScreen(arg): " PROC_TRUE " if arg is a Screen widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsScreen", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsScreen(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsScreen", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsScreen(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsScale(XEN arg)
+static Xen gxm_XmIsScale(Xen arg)
{
#define H_XmIsScale "XmIsScale(arg): " PROC_TRUE " if arg is a Scale widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsScale", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsScale(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsScale", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsScale(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsScrollBar(XEN arg)
+static Xen gxm_XmIsScrollBar(Xen arg)
{
#define H_XmIsScrollBar "XmIsScrollBar(arg): " PROC_TRUE " if arg is a ScrollBar widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsScrollBar", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsScrollBar(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsScrollBar", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsScrollBar(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsDialogShell(XEN arg)
+static Xen gxm_XmIsDialogShell(Xen arg)
{
#define H_XmIsDialogShell "XmIsDialogShell(arg): " PROC_TRUE " if arg is a DialogShell widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDialogShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDialogShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsDialogShell", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsDialogShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsScrolledWindow(XEN arg)
+static Xen gxm_XmIsScrolledWindow(Xen arg)
{
#define H_XmIsScrolledWindow "XmIsScrolledWindow(arg): " PROC_TRUE " if arg is a ScrolledWindow widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsScrolledWindow", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsScrolledWindow(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsScrolledWindow", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsScrolledWindow(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsDisplay(XEN arg)
+static Xen gxm_XmIsDisplay(Xen arg)
{
#define H_XmIsDisplay "XmIsDisplay(arg): " PROC_TRUE " if arg is a Display widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDisplay", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDisplay(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsDisplay", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsDisplay(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsSelectionBox(XEN arg)
+static Xen gxm_XmIsSelectionBox(Xen arg)
{
#define H_XmIsSelectionBox "XmIsSelectionBox(arg): " PROC_TRUE " if arg is a SelectionBox widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsSelectionBox", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsSelectionBox(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsSelectionBox", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsSelectionBox(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsDragContext(XEN arg)
+static Xen gxm_XmIsDragContext(Xen arg)
{
#define H_XmIsDragContext "XmIsDragContext(arg): " PROC_TRUE " if arg is a DragContext widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDragContext", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDragContext(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsDragContext", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsDragContext(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsSeparatorGadget(XEN arg)
+static Xen gxm_XmIsSeparatorGadget(Xen arg)
{
#define H_XmIsSeparatorGadget "XmIsSeparatorGadget(arg): " PROC_TRUE " if arg is a SeparatorGadget gadget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsSeparatorGadget", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsSeparatorGadget(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsSeparatorGadget", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsSeparatorGadget(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsDragIconObjectClass(XEN arg)
+static Xen gxm_XmIsDragIconObjectClass(Xen arg)
{
#define H_XmIsDragIconObjectClass "XmIsDragIconObjectClass(arg): " PROC_TRUE " if arg is a DragIconObjectClass widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDragIconObjectClass", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDragIconObjectClass(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsDragIconObjectClass", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsDragIconObjectClass(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsSeparator(XEN arg)
+static Xen gxm_XmIsSeparator(Xen arg)
{
#define H_XmIsSeparator "XmIsSeparator(arg): " PROC_TRUE " if arg is a Separator widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsSeparator", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsSeparator(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsSeparator", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsSeparator(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsDrawingArea(XEN arg)
+static Xen gxm_XmIsDrawingArea(Xen arg)
{
#define H_XmIsDrawingArea "XmIsDrawingArea(arg): " PROC_TRUE " if arg is a DrawingArea widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDrawingArea", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDrawingArea(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsDrawingArea", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsDrawingArea(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsDrawnButton(XEN arg)
+static Xen gxm_XmIsDrawnButton(Xen arg)
{
#define H_XmIsDrawnButton "XmIsDrawnButton(arg): " PROC_TRUE " if arg is a DrawnButton widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDrawnButton", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDrawnButton(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsDrawnButton", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsDrawnButton(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsDropSiteManager(XEN arg)
+static Xen gxm_XmIsDropSiteManager(Xen arg)
{
#define H_XmIsDropSiteManager "XmIsDropSiteManager(arg): " PROC_TRUE " if arg is a DropSiteManager widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDropSiteManager", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDropSiteManager(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsDropSiteManager", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsDropSiteManager(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsDropTransfer(XEN arg)
+static Xen gxm_XmIsDropTransfer(Xen arg)
{
#define H_XmIsDropTransfer "XmIsDropTransfer(arg): " PROC_TRUE " if arg is a DropTransfer widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsDropTransfer", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsDropTransfer(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsDropTransfer", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsDropTransfer(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsTextField(XEN arg)
+static Xen gxm_XmIsTextField(Xen arg)
{
#define H_XmIsTextField "XmIsTextField(arg): " PROC_TRUE " if arg is a TextField widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsTextField", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsTextField(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsTextField", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsTextField(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsFileSelectionBox(XEN arg)
+static Xen gxm_XmIsFileSelectionBox(Xen arg)
{
#define H_XmIsFileSelectionBox "XmIsFileSelectionBox(arg): " PROC_TRUE " if arg is a FileSelectionBox widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsFileSelectionBox", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsFileSelectionBox(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsFileSelectionBox", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsFileSelectionBox(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsText(XEN arg)
+static Xen gxm_XmIsText(Xen arg)
{
#define H_XmIsText "XmIsText(arg): " PROC_TRUE " if arg is a Text widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsText", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsText(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsText", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsText(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsForm(XEN arg)
+static Xen gxm_XmIsForm(Xen arg)
{
#define H_XmIsForm "XmIsForm(arg): " PROC_TRUE " if arg is a Form widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsForm", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsForm(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsForm", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsForm(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsFrame(XEN arg)
+static Xen gxm_XmIsFrame(Xen arg)
{
#define H_XmIsFrame "XmIsFrame(arg): " PROC_TRUE " if arg is a Frame widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsFrame", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsFrame(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsFrame", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsFrame(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsGadget(XEN arg)
+static Xen gxm_XmIsGadget(Xen arg)
{
#define H_XmIsGadget "XmIsGadget(arg): " PROC_TRUE " if arg is a Gadget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsGadget", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsGadget(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsGadget", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsGadget(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsToggleButtonGadget(XEN arg)
+static Xen gxm_XmIsToggleButtonGadget(Xen arg)
{
#define H_XmIsToggleButtonGadget "XmIsToggleButtonGadget(arg): " PROC_TRUE " if arg is a ToggleButtonGadget gadget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsToggleButtonGadget", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsToggleButtonGadget(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsToggleButtonGadget", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsToggleButtonGadget(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsGrabShell(XEN arg)
+static Xen gxm_XmIsGrabShell(Xen arg)
{
#define H_XmIsGrabShell "XmIsGrabShell(arg): " PROC_TRUE " if arg is a GrabShell widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsGrabShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsGrabShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsGrabShell", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsGrabShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsToggleButton(XEN arg)
+static Xen gxm_XmIsToggleButton(Xen arg)
{
#define H_XmIsToggleButton "XmIsToggleButton(arg): " PROC_TRUE " if arg is a ToggleButton widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsToggleButton", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsToggleButton(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsToggleButton", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsToggleButton(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsIconGadget(XEN arg)
+static Xen gxm_XmIsIconGadget(Xen arg)
{
#define H_XmIsIconGadget "XmIsIconGadget(arg): " PROC_TRUE " if arg is a IconGadget widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsIconGadget", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsIconGadget(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsIconGadget", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsIconGadget(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsIconHeader(XEN arg)
+static Xen gxm_XmIsIconHeader(Xen arg)
{
#define H_XmIsIconHeader "XmIsIconHeader(arg): " PROC_TRUE " if arg is a IconHeader widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsIconHeader", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsIconHeader(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsIconHeader", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsIconHeader(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsLabelGadget(XEN arg)
+static Xen gxm_XmIsLabelGadget(Xen arg)
{
#define H_XmIsLabelGadget "XmIsLabelGadget(arg): " PROC_TRUE " if arg is a LabelGadget widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsLabelGadget", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsLabelGadget(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsLabelGadget", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsLabelGadget(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsLabel(XEN arg)
+static Xen gxm_XmIsLabel(Xen arg)
{
#define H_XmIsLabel "XmIsLabel(arg): " PROC_TRUE " if arg is a Label widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsLabel", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsLabel(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsLabel", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsLabel(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsVendorShell(XEN arg)
+static Xen gxm_XmIsVendorShell(Xen arg)
{
#define H_XmIsVendorShell "XmIsVendorShell(arg): " PROC_TRUE " if arg is a VendorShell widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsVendorShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsVendorShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsVendorShell", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsVendorShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsList(XEN arg)
+static Xen gxm_XmIsList(Xen arg)
{
#define H_XmIsList "XmIsList(arg): " PROC_TRUE " if arg is a List widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsList", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsList(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsList", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsList(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsMainWindow(XEN arg)
+static Xen gxm_XmIsMainWindow(Xen arg)
{
#define H_XmIsMainWindow "XmIsMainWindow(arg): " PROC_TRUE " if arg is a MainWindow widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsMainWindow", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsMainWindow(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsMainWindow", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsMainWindow(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsManager(XEN arg)
+static Xen gxm_XmIsManager(Xen arg)
{
#define H_XmIsManager "XmIsManager(arg): " PROC_TRUE " if arg is a Manager widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsManager", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsManager(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsManager", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsManager(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XmIsMenuShell(XEN arg)
+static Xen gxm_XmIsMenuShell(Xen arg)
{
#define H_XmIsMenuShell "XmIsMenuShell(arg): " PROC_TRUE " if arg is a MenuShell widget"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XmIsMenuShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XmIsMenuShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XmIsMenuShell", "Widget");
+ return(C_bool_to_Xen_boolean(XmIsMenuShell(Xen_to_C_Widget(arg))));
}
-#endif
-/* end HAVE_MOTIF */
+
+
/* ----------------------------------------------------------------------------------------------------
*
@@ -7869,53 +7589,53 @@ static XEN gxm_XmIsMenuShell(XEN arg)
* ----------------------------------------------------------------------------------------------------
*/
-static XEN gxm_XXorRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XXorRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XXorRegion "XXorRegion(sra, srb, dr_return) calculates the difference between the union and intersection of two regions."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XXorRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg2), arg2, 2, "XXorRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg3), arg3, 3, "XXorRegion", "Region");
- return(C_TO_XEN_INT(XXorRegion(XEN_TO_C_Region(arg1), XEN_TO_C_Region(arg2), XEN_TO_C_Region(arg3))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XXorRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg2), arg2, 2, "XXorRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg3), arg3, 3, "XXorRegion", "Region");
+ return(C_int_to_Xen_integer(XXorRegion(Xen_to_C_Region(arg1), Xen_to_C_Region(arg2), Xen_to_C_Region(arg3))));
}
-static XEN gxm_XUnionRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XUnionRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XUnionRegion "XUnionRegion(sra, srb, dr_return) computes the union of two regions."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XUnionRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg2), arg2, 2, "XUnionRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg3), arg3, 3, "XUnionRegion", "Region");
- return(C_TO_XEN_INT(XUnionRegion(XEN_TO_C_Region(arg1), XEN_TO_C_Region(arg2), XEN_TO_C_Region(arg3))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XUnionRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg2), arg2, 2, "XUnionRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg3), arg3, 3, "XUnionRegion", "Region");
+ return(C_int_to_Xen_integer(XUnionRegion(Xen_to_C_Region(arg1), Xen_to_C_Region(arg2), Xen_to_C_Region(arg3))));
}
-static XEN gxm_XUnionRectWithRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XUnionRectWithRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XUnionRectWithRegion "XUnionRectWithRegion(rectangle, src_region, dest_region_return) updates the destination region from a \
union of the specified rectangle and the specified source region."
- XEN_ASSERT_TYPE(XEN_XRectangle_P(arg1), arg1, 1, "XUnionRectWithRegion", "XRectangle*");
- XEN_ASSERT_TYPE(XEN_Region_P(arg2), arg2, 2, "XUnionRectWithRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg3), arg3, 3, "XUnionRectWithRegion", "Region");
- return(C_TO_XEN_INT(XUnionRectWithRegion(XEN_TO_C_XRectangle(arg1), XEN_TO_C_Region(arg2), XEN_TO_C_Region(arg3))));
+ Xen_check_type(Xen_is_XRectangle(arg1), arg1, 1, "XUnionRectWithRegion", "XRectangle*");
+ Xen_check_type(Xen_is_Region(arg2), arg2, 2, "XUnionRectWithRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg3), arg3, 3, "XUnionRectWithRegion", "Region");
+ return(C_int_to_Xen_integer(XUnionRectWithRegion(Xen_to_C_XRectangle(arg1), Xen_to_C_Region(arg2), Xen_to_C_Region(arg3))));
}
-static XEN gxm_XSubtractRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSubtractRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSubtractRegion "XSubtractRegion(sra, srb, dr_return) subtracts srb from sra and stores the results in dr_return."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XSubtractRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg2), arg2, 2, "XSubtractRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg3), arg3, 3, "XSubtractRegion", "Region");
- return(C_TO_XEN_INT(XSubtractRegion(XEN_TO_C_Region(arg1), XEN_TO_C_Region(arg2), XEN_TO_C_Region(arg3))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XSubtractRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg2), arg2, 2, "XSubtractRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg3), arg3, 3, "XSubtractRegion", "Region");
+ return(C_int_to_Xen_integer(XSubtractRegion(Xen_to_C_Region(arg1), Xen_to_C_Region(arg2), Xen_to_C_Region(arg3))));
}
-static XEN gxm_XShrinkRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XShrinkRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XShrinkRegion "XShrinkRegion(r, dx, dy) reduces the specified region by a specified amount."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XShrinkRegion", "Region");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XShrinkRegion", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XShrinkRegion", "int");
- return(C_TO_XEN_INT(XShrinkRegion(XEN_TO_C_Region(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XShrinkRegion", "Region");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XShrinkRegion", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XShrinkRegion", "int");
+ return(C_int_to_Xen_integer(XShrinkRegion(Xen_to_C_Region(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XSetWMProperties(XEN dpy, XEN win, XEN win_name, XEN icon_name, XEN argv, XEN argc, XEN normal_hints, XEN wm_hints)
+static Xen gxm_XSetWMProperties(Xen dpy, Xen win, Xen win_name, Xen icon_name, Xen argv, Xen argc, Xen normal_hints, Xen wm_hints)
{
/* last arg omitted -- XClassHint not supported */
#define H_XSetWMProperties "XSetWMProperties(dpy, win, win_name, icon_name, argv, argc, normal_hints wm_hints) sets the window properties"
@@ -7923,107 +7643,107 @@ static XEN gxm_XSetWMProperties(XEN dpy, XEN win, XEN win_name, XEN icon_name, X
char **c_argv = NULL;
XTextProperty w_name, i_name;
bool use_w_name = false, use_i_name = false;
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XSetWMProperties", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(win), win, XEN_ARG_2, "XSetWMProperties", "Window");
- XEN_ASSERT_TYPE(XEN_STRING_P(win_name) || XEN_NULL_P(win_name) || XEN_FALSE_P(win_name), win_name, XEN_ARG_3, "XSetWMProperties", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(icon_name) || XEN_NULL_P(icon_name) || XEN_FALSE_P(icon_name), icon_name, XEN_ARG_4, "XSetWMProperties", "char*");
- XEN_ASSERT_TYPE(XEN_LIST_P(argv), argv, XEN_ARG_5, "XSetWMProperties", "list of char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(argc), argc, XEN_ARG_6, "XSetWMProperties", "int");
- XEN_ASSERT_TYPE(XEN_FALSE_P(normal_hints) || XEN_XSizeHints_P(normal_hints), normal_hints, XEN_ARG_7, "XSetWMProperties", "XSizeHints* or false");
- XEN_ASSERT_TYPE(XEN_FALSE_P(wm_hints) || XEN_XWMHints_P(wm_hints), wm_hints, XEN_ARG_8, "XSetWMProperties", "XWMHints* or false");
- c_argc = XEN_TO_C_INT(argc);
- if (c_argc > 0) c_argv = XEN_TO_C_Strings(argv, c_argc);
- if (XEN_STRING_P(win_name))
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XSetWMProperties", "Display*");
+ Xen_check_type(Xen_is_Window(win), win, 2, "XSetWMProperties", "Window");
+ Xen_check_type(Xen_is_string(win_name) || Xen_is_null(win_name) || Xen_is_false(win_name), win_name, 3, "XSetWMProperties", "char*");
+ Xen_check_type(Xen_is_string(icon_name) || Xen_is_null(icon_name) || Xen_is_false(icon_name), icon_name, 4, "XSetWMProperties", "char*");
+ Xen_check_type(Xen_is_list(argv), argv, 5, "XSetWMProperties", "list of char*");
+ Xen_check_type(Xen_is_integer(argc), argc, 6, "XSetWMProperties", "int");
+ Xen_check_type(Xen_is_false(normal_hints) || Xen_is_XSizeHints(normal_hints), normal_hints, 7, "XSetWMProperties", "XSizeHints* or false");
+ Xen_check_type(Xen_is_false(wm_hints) || Xen_is_XWMHints(wm_hints), wm_hints, 8, "XSetWMProperties", "XWMHints* or false");
+ c_argc = Xen_integer_to_C_int(argc);
+ if (c_argc > 0) c_argv = Xen_to_C_Strings(argv, c_argc);
+ if (Xen_is_string(win_name))
{
char *name;
use_w_name = true;
- name = (char *)XEN_TO_C_STRING(win_name);
+ name = (char *)Xen_string_to_C_string(win_name);
XStringListToTextProperty(&name, 1, &w_name);
}
- if (XEN_STRING_P(icon_name))
+ if (Xen_is_string(icon_name))
{
char *name;
use_i_name = true;
- name = (char *)XEN_TO_C_STRING(icon_name);
+ name = (char *)Xen_string_to_C_string(icon_name);
XStringListToTextProperty(&name, 1, &i_name);
}
- XSetWMProperties(XEN_TO_C_Display(dpy),
- XEN_TO_C_Window(win),
+ XSetWMProperties(Xen_to_C_Display(dpy),
+ Xen_to_C_Window(win),
(use_w_name) ? &w_name : NULL,
(use_i_name) ? &i_name : NULL,
c_argv,
c_argc,
- XEN_TO_C_XSizeHints(normal_hints),
- XEN_TO_C_XWMHints(wm_hints),
+ Xen_to_C_XSizeHints(normal_hints),
+ Xen_to_C_XWMHints(wm_hints),
NULL);
if (c_argv) free(c_argv);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XSetRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetRegion "XSetRegion(display, gc, r) sets the clip-mask in the GC to the specified region."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetRegion", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetRegion", "GC");
- XEN_ASSERT_TYPE(XEN_Region_P(arg3), arg3, 3, "XSetRegion", "Region");
- return(C_TO_XEN_INT(XSetRegion(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_Region(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetRegion", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetRegion", "GC");
+ Xen_check_type(Xen_is_Region(arg3), arg3, 3, "XSetRegion", "Region");
+ return(C_int_to_Xen_integer(XSetRegion(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_to_C_Region(arg3))));
}
-static XEN gxm_XSetWMHints(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetWMHints(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetWMHints "XSetWMHints(display, w, wmhints) sets the window manager hints that include icon information and location, the \
initial state of the window, and whether the application relies on the window manager to get keyboard input."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWMHints", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWMHints", "Window");
- XEN_ASSERT_TYPE(XEN_XWMHints_P(arg3), arg3, 3, "XSetWMHints", "XWMHints*");
- return(C_TO_XEN_INT(XSetWMHints(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_XWMHints(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWMHints", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWMHints", "Window");
+ Xen_check_type(Xen_is_XWMHints(arg3), arg3, 3, "XSetWMHints", "XWMHints*");
+ return(C_int_to_Xen_integer(XSetWMHints(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_XWMHints(arg3))));
}
-static XEN gxm_XSetRGBColormaps(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XSetRGBColormaps(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XSetRGBColormaps "void XSetRGBColormaps(display, w, std_colormap, count, property) replaces the RGB colormap definition in the \
specified property on the named window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetRGBColormaps", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetRGBColormaps", "Window");
- XEN_ASSERT_TYPE(XEN_XStandardColormap_P(arg3), arg3, 3, "XSetRGBColormaps", "XStandardColormap*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetRGBColormaps", "int");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg5), arg5, 5, "XSetRGBColormaps", "Atom");
- XSetRGBColormaps(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_XStandardColormap(arg3),
- XEN_TO_C_INT(arg4),
- XEN_TO_C_Atom(arg5));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetRGBColormaps", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetRGBColormaps", "Window");
+ Xen_check_type(Xen_is_XStandardColormap(arg3), arg3, 3, "XSetRGBColormaps", "XStandardColormap*");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetRGBColormaps", "int");
+ Xen_check_type(Xen_is_Atom(arg5), arg5, 5, "XSetRGBColormaps", "Atom");
+ XSetRGBColormaps(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_XStandardColormap(arg3),
+ Xen_integer_to_C_int(arg4),
+ Xen_to_C_Atom(arg5));
+ return(Xen_false);
}
-static XEN gxm_XUniqueContext(void)
+static Xen gxm_XUniqueContext(void)
{
#define H_XUniqueContext "XContext XUniqueContext() creates a unique context type that may be used in subsequent calls to XSaveContext."
- return(C_TO_XEN_XContext(XUniqueContext()));
+ return(C_to_Xen_XContext(XUniqueContext()));
}
-static XEN gxm_XSaveContext(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XSaveContext(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XSaveContext "XSaveContext(dpy, rid, context) saves a context"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSaveContext", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XSaveContext", "XID");
- XEN_ASSERT_TYPE(XEN_XContext_P(arg3), arg3, 3, "XSaveContext", "XContext");
- return(C_TO_XEN_INT(XSaveContext(XEN_TO_C_Display(arg1), XEN_TO_C_ULONG(arg2), XEN_TO_C_XContext(arg3), (caddr_t)arg4)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSaveContext", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XSaveContext", "XID");
+ Xen_check_type(Xen_is_XContext(arg3), arg3, 3, "XSaveContext", "XContext");
+ return(C_int_to_Xen_integer(XSaveContext(Xen_to_C_Display(arg1), Xen_ulong_to_C_ulong(arg2), Xen_to_C_XContext(arg3), (caddr_t)arg4)));
}
-static XEN gxm_XRectInRegion(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XRectInRegion(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XRectInRegion "int XRectInRegion(r, x, y, width, height): returns RectangleIn if the rectangle is entirely in the specified region, \
RectangleOut if the rectangle is entirely out of the specified region, and RectanglePart if the rectangle is partially in the specified region. "
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XRectInRegion", "Region");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XRectInRegion", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XRectInRegion", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XRectInRegion", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XRectInRegion", "unsigned int");
- return(C_TO_XEN_INT(XRectInRegion(XEN_TO_C_Region(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_ULONG(arg4), XEN_TO_C_ULONG(arg5))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XRectInRegion", "Region");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XRectInRegion", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XRectInRegion", "int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XRectInRegion", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XRectInRegion", "unsigned int");
+ return(C_int_to_Xen_integer(XRectInRegion(Xen_to_C_Region(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_ulong_to_C_ulong(arg4), Xen_ulong_to_C_ulong(arg5))));
}
-static XEN gxm_XPolygonRegion(XEN larg1, XEN arg2, XEN arg3)
+static Xen gxm_XPolygonRegion(Xen larg1, Xen arg2, Xen arg3)
{
#define H_XPolygonRegion "Region XPolygonRegion(points, n, fill_rule): returns a region for the polygon defined by the points list."
/* DIFF: XPolygonRegion XPoint* arg (arg 1) is list of XPoints
@@ -8031,66 +7751,66 @@ static XEN gxm_XPolygonRegion(XEN larg1, XEN arg2, XEN arg3)
XPoint *pt, *pt1;
int i, len;
Region res;
- XEN arg1;
- XEN_ASSERT_TYPE(XEN_LIST_P(larg1), larg1, 1, "XPolygonRegion", "list of XPoints");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XPolygonRegion", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XPolygonRegion", "int");
- arg1 = XEN_COPY_ARG(larg1);
- len = XEN_TO_C_INT(arg2);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg2, 2, "XPolygonRegion", "positive integer");
+ Xen arg1;
+ Xen_check_type(Xen_is_list(larg1), larg1, 1, "XPolygonRegion", "list of XPoints");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XPolygonRegion", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XPolygonRegion", "int");
+ arg1 = Xen_copy_arg(larg1);
+ len = Xen_integer_to_C_int(arg2);
+ if (len <= 0) Xen_check_type(0, arg2, 2, "XPolygonRegion", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg1)); i++, arg1 = XEN_CDR(arg1))
+ for (i = 0; (i < len) && (!Xen_is_null(arg1)); i++, arg1 = Xen_cdr(arg1))
{
- XEN xp;
- xp = XEN_CAR(arg1);
- if (!(XEN_XPoint_P(xp))) {free(pt); XEN_ASSERT_TYPE(0, xp, i, "XPolygonRegion", "XPoint"); return(XEN_FALSE);}
- pt1 = XEN_TO_C_XPoint(XEN_CAR(arg1));
+ Xen xp;
+ xp = Xen_car(arg1);
+ if (!(Xen_is_XPoint(xp))) {free(pt); Xen_check_type(0, xp, i, "XPolygonRegion", "XPoint"); return(Xen_false);}
+ pt1 = Xen_to_C_XPoint(Xen_car(arg1));
pt[i].x = pt1->x;
pt[i].y = pt1->y;
}
- res = XPolygonRegion(pt, len, XEN_TO_C_INT(arg3));
+ res = XPolygonRegion(pt, len, Xen_integer_to_C_int(arg3));
free(pt);
- return(C_TO_XEN_Region(res));
+ return(C_to_Xen_Region(res));
}
-static XEN gxm_XPointInRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XPointInRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XPointInRegion "Bool XPointInRegion(r, x, y): returns " PROC_TRUE " if the point (x, y) is contained in the region r."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XPointInRegion", "Region");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XPointInRegion", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XPointInRegion", "int");
- return(C_TO_XEN_BOOLEAN(XPointInRegion(XEN_TO_C_Region(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XPointInRegion", "Region");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XPointInRegion", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XPointInRegion", "int");
+ return(C_bool_to_Xen_boolean(XPointInRegion(Xen_to_C_Region(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XOffsetRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XOffsetRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XOffsetRegion "XOffsetRegion(r, dx, dy) moves the specified region by a specified amount."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XOffsetRegion", "Region");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XOffsetRegion", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XOffsetRegion", "int");
- return(C_TO_XEN_INT(XOffsetRegion(XEN_TO_C_Region(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XOffsetRegion", "Region");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XOffsetRegion", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XOffsetRegion", "int");
+ return(C_int_to_Xen_integer(XOffsetRegion(Xen_to_C_Region(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3))));
}
static XVisualInfo *match_visual_info;
-static XEN gxm_XMatchVisualInfo(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XMatchVisualInfo(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XMatchVisualInfo "Status XMatchVisualInfo(display, screen, depth, class): returns the visual information for a \
visual that matches the specified depth and class for a screen."
/* DIFF: XMatchVisualInfo dpy scr dep class [visual] -> #f or visual
*/
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XMatchVisualInfo", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XMatchVisualInfo", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XMatchVisualInfo", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XMatchVisualInfo", "int");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XMatchVisualInfo", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XMatchVisualInfo", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XMatchVisualInfo", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XMatchVisualInfo", "int");
match_visual_info = (XVisualInfo *)calloc(1, sizeof(XVisualInfo));
- val = XMatchVisualInfo(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4), match_visual_info);
+ val = XMatchVisualInfo(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4), match_visual_info);
if (val)
- return(C_TO_XEN_XVisualInfo(match_visual_info));
- return(XEN_FALSE);
+ return(C_to_Xen_XVisualInfo(match_visual_info));
+ return(Xen_false);
}
-static XEN gxm_XLookupString(XEN arg1)
+static Xen gxm_XLookupString(Xen arg1)
{
#define H_XLookupString "int XLookupString(event_struct) translates a key event to a KeySym and a string -> (len str keysym)."
/* DIFF: XLookupString last arg is ignored, keyevent and all but last omitted -> (list len str keysym)
@@ -8098,76 +7818,76 @@ static XEN gxm_XLookupString(XEN arg1)
KeySym key;
char *str;
int len;
- XEN res;
- XEN_ASSERT_TYPE(XEN_XKeyEvent_P(arg1), arg1, 1, "XLookupString", "XKeyEvent*");/* user-created */
+ Xen res;
+ Xen_check_type(Xen_is_XKeyEvent(arg1), arg1, 1, "XLookupString", "XKeyEvent*");/* user-created */
str = (char *)calloc(16, sizeof(char));
- len = XLookupString(XEN_TO_C_XKeyEvent(arg1), str, 16, &key, NULL);
- res = XEN_LIST_3(C_TO_XEN_INT(len),
- C_TO_XEN_STRING(str),
- C_TO_XEN_KeySym(key));
+ len = XLookupString(Xen_to_C_XKeyEvent(arg1), str, 16, &key, NULL);
+ res = Xen_list_3(C_int_to_Xen_integer(len),
+ C_string_to_Xen_string(str),
+ C_to_Xen_KeySym(key));
free(str);
return(res);
}
-static XEN gxm_XConvertCase(XEN arg1)
+static Xen gxm_XConvertCase(Xen arg1)
{
#define H_XConvertCase "void XConvertCase(keysym): returns the uppercase and lowercase forms of the specified \
Keysym, if the KeySym is subject to case conversion; otherwise, the specified KeySym is returned to both lower_return and upper_return."
/* DIFF: XConvertCase keysym [k1 k2] -> (list k1 k2)
*/
KeySym k1, k2;
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg1), arg1, 1, "XConvertCase", "KeySym");
- XConvertCase(XEN_TO_C_KeySym(arg1), &k1, &k2);
- return(XEN_LIST_2(C_TO_XEN_KeySym(k1),
- C_TO_XEN_KeySym(k2)));
+ Xen_check_type(Xen_is_KeySym(arg1), arg1, 1, "XConvertCase", "KeySym");
+ XConvertCase(Xen_to_C_KeySym(arg1), &k1, &k2);
+ return(Xen_list_2(C_to_Xen_KeySym(k1),
+ C_to_Xen_KeySym(k2)));
}
-static XEN gxm_XIntersectRegion(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XIntersectRegion(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XIntersectRegion "XIntersectRegion(sra, srb, dr_return) computes the intersection of two regions."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XIntersectRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg2), arg2, 2, "XIntersectRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg3), arg3, 3, "XIntersectRegion", "Region");
- return(C_TO_XEN_INT(XIntersectRegion(XEN_TO_C_Region(arg1), XEN_TO_C_Region(arg2), XEN_TO_C_Region(arg3))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XIntersectRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg2), arg2, 2, "XIntersectRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg3), arg3, 3, "XIntersectRegion", "Region");
+ return(C_int_to_Xen_integer(XIntersectRegion(Xen_to_C_Region(arg1), Xen_to_C_Region(arg2), Xen_to_C_Region(arg3))));
}
-static XEN gxm_XGetWMHints(XEN arg1, XEN arg2)
+static Xen gxm_XGetWMHints(Xen arg1, Xen arg2)
{
#define H_XGetWMHints "XWMHints *XGetWMHints(display, w) reads the window manager hints and returns NULL if no WM_HINTS property was \
set on the window or returns a pointer to a XWMHints structure if it succeeds."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetWMHints", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetWMHints", "Window");
- return(C_TO_XEN_XWMHints(XGetWMHints(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetWMHints", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetWMHints", "Window");
+ return(C_to_Xen_XWMHints(XGetWMHints(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XGetVisualInfo(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XGetVisualInfo(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XGetVisualInfo "XVisualInfo *XGetVisualInfo(display, vinfo_mask, vinfo_template): returns a list of visual \
structures that have attributes equal to the attributes specified by vinfo_template."
- /* DIFF: XGetVisualInfo dpy mask template [nitems] -> '() or (list visual...)
+ /* DIFF: XGetVisualInfo dpy mask template [nitems] -> () or (list visual...)
*/
XVisualInfo *v;
int len;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetVisualInfo", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XGetVisualInfo", "long");
- XEN_ASSERT_TYPE(XEN_XVisualInfo_P(arg3), arg3, 3, "XGetVisualInfo", "XVisualInfo*");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetVisualInfo", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XGetVisualInfo", "long");
+ Xen_check_type(Xen_is_XVisualInfo(arg3), arg3, 3, "XGetVisualInfo", "XVisualInfo*");
- v = XGetVisualInfo(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_XVisualInfo(arg3), &len);
+ v = XGetVisualInfo(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), Xen_to_C_XVisualInfo(arg3), &len);
if (v)
{
int i, loc;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_XVisualInfo(v + i), lst);
+ lst = Xen_cons(C_to_Xen_XVisualInfo(v + i), lst);
xm_unprotect_at(loc);
/* XFree(v); */ /* valgrind says this is a bad idea */
}
return(lst);
}
-static XEN gxm_XGetRGBColormaps(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XGetRGBColormaps(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XGetRGBColormaps "Status XGetRGBColormaps(display, w, property): returns the RGB colormap \
definitions stored in the specified property on the named window."
@@ -8175,184 +7895,184 @@ definitions stored in the specified property on the named window."
*/
int len, i, loc;
Status val;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
XStandardColormap **cs = NULL; /* do I allocate this?? */
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetRGBColormaps", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetRGBColormaps", "Window");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XGetRGBColormaps", "Atom");
- val = XGetRGBColormaps(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetRGBColormaps", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetRGBColormaps", "Window");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XGetRGBColormaps", "Atom");
+ val = XGetRGBColormaps(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
cs, &len,
- XEN_TO_C_Atom(arg3));
+ Xen_to_C_Atom(arg3));
if (val == 0)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_XStandardColormap(cs[i]), lst);
+ lst = Xen_cons(C_to_Xen_XStandardColormap(cs[i]), lst);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XGetIconSizes(XEN arg1, XEN arg2)
+static Xen gxm_XGetIconSizes(Xen arg1, Xen arg2)
{
- #define H_XGetIconSizes "Status XGetIconSizes(display, w): returns #f if the window manager has not \
+ #define H_XGetIconSizes "Status XGetIconSizes(display, w): returns " PROC_FALSE " if the window manager has not \
set icon sizes; otherwise, it return nonzero and a list of XIconSize structs."
/* DIFF: XGetIconSizes omit last 2 args, return list of XIconSizes
*/
XIconSize *sizes;
int i, len, val, loc;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetIconSizes", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetIconSizes", "Window");
- val = XGetIconSizes(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), &sizes, &len);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetIconSizes", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetIconSizes", "Window");
+ val = XGetIconSizes(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), &sizes, &len);
if (val == 0)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_XIconSize(&(sizes[i])), lst);
+ lst = Xen_cons(C_to_Xen_XIconSize(&(sizes[i])), lst);
XFree(sizes);
xm_unprotect_at(loc);
- return(XEN_LIST_2(C_TO_XEN_INT(val),
+ return(Xen_list_2(C_int_to_Xen_integer(val),
lst));
}
-static XEN gxm_XFindContext(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XFindContext(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XFindContext "XFindContext(dpy, rid, context) gets data from the context manager"
/* DIFF: XFindContext last arg omitted, val returned
*/
caddr_t x;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFindContext", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XFindContext", "XID");
- XEN_ASSERT_TYPE(XEN_XContext_P(arg3), arg3, 3, "XFindContext", "XContext");
- val = XFindContext(XEN_TO_C_Display(arg1), XEN_TO_C_ULONG(arg2), XEN_TO_C_XContext(arg3), &x);
- return(XEN_LIST_2(C_TO_XEN_INT(val),
- (XEN)x));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFindContext", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XFindContext", "XID");
+ Xen_check_type(Xen_is_XContext(arg3), arg3, 3, "XFindContext", "XContext");
+ val = XFindContext(Xen_to_C_Display(arg1), Xen_ulong_to_C_ulong(arg2), Xen_to_C_XContext(arg3), &x);
+ return(Xen_list_2(C_int_to_Xen_integer(val),
+ (Xen)x));
}
-static XEN gxm_XEqualRegion(XEN arg1, XEN arg2)
+static Xen gxm_XEqualRegion(Xen arg1, Xen arg2)
{
#define H_XEqualRegion "Bool XEqualRegion(r1, r2): returns " PROC_TRUE " if the two regions have the same offset, size, and shape."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XEqualRegion", "Region");
- XEN_ASSERT_TYPE(XEN_Region_P(arg2), arg2, 2, "XEqualRegion", "Region");
- return(C_TO_XEN_BOOLEAN(XEqualRegion(XEN_TO_C_Region(arg1), XEN_TO_C_Region(arg2))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XEqualRegion", "Region");
+ Xen_check_type(Xen_is_Region(arg2), arg2, 2, "XEqualRegion", "Region");
+ return(C_bool_to_Xen_boolean(XEqualRegion(Xen_to_C_Region(arg1), Xen_to_C_Region(arg2))));
}
-static XEN gxm_XEmptyRegion(XEN arg1)
+static Xen gxm_XEmptyRegion(Xen arg1)
{
#define H_XEmptyRegion "Bool XEmptyRegion(r): returns " PROC_TRUE " if the region is empty."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XEmptyRegion", "Region");
- return(C_TO_XEN_BOOLEAN(XEmptyRegion(XEN_TO_C_Region(arg1))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XEmptyRegion", "Region");
+ return(C_bool_to_Xen_boolean(XEmptyRegion(Xen_to_C_Region(arg1))));
}
-static XEN gxm_XDestroyRegion(XEN arg1)
+static Xen gxm_XDestroyRegion(Xen arg1)
{
#define H_XDestroyRegion "XDestroyRegion(r) deallocates the storage associated with a specified region."
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XDestroyRegion", "Region");
- return(C_TO_XEN_INT(XDestroyRegion(XEN_TO_C_Region(arg1))));
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XDestroyRegion", "Region");
+ return(C_int_to_Xen_integer(XDestroyRegion(Xen_to_C_Region(arg1))));
}
-static XEN gxm_XDeleteContext(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XDeleteContext(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XDeleteContext "int XDeleteContext(display, rid, context) deletes the entry for the given resource ID and type from the data structure."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDeleteContext", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XDeleteContext", "XID");
- XEN_ASSERT_TYPE(XEN_XContext_P(arg3), arg3, 3, "XDeleteContext", "XContext");
- return(C_TO_XEN_INT(XDeleteContext(XEN_TO_C_Display(arg1), XEN_TO_C_ULONG(arg2), XEN_TO_C_XContext(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDeleteContext", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XDeleteContext", "XID");
+ Xen_check_type(Xen_is_XContext(arg3), arg3, 3, "XDeleteContext", "XContext");
+ return(C_int_to_Xen_integer(XDeleteContext(Xen_to_C_Display(arg1), Xen_ulong_to_C_ulong(arg2), Xen_to_C_XContext(arg3))));
}
-static XEN gxm_XDefaultString(void)
+static Xen gxm_XDefaultString(void)
{
#define H_XDefaultString "char *XDefaultString(): returns the default string used by Xlib for text conversion"
- return(C_TO_XEN_STRING(XDefaultString()));
+ return(C_string_to_Xen_string(XDefaultString()));
}
-static XEN gxm_XCreateRegion(void)
+static Xen gxm_XCreateRegion(void)
{
#define H_XCreateRegion "Region XCreateRegion()"
- return(C_TO_XEN_Region(XCreateRegion()));
+ return(C_to_Xen_Region(XCreateRegion()));
}
-static XEN gxm_XClipBox(XEN arg1)
+static Xen gxm_XClipBox(Xen arg1)
{
#define H_XClipBox "XClipBox(r): returns the smallest rectangle enclosing the specified region."
/* DIFF: XClipBox region [rectangle] -> (list val rectangle)
*/
XRectangle *r;
int val;
- XEN_ASSERT_TYPE(XEN_Region_P(arg1), arg1, 1, "XClipBox", "Region");
+ Xen_check_type(Xen_is_Region(arg1), arg1, 1, "XClipBox", "Region");
r = (XRectangle *)calloc(1, sizeof(XRectangle));
- val = XClipBox(XEN_TO_C_Region(arg1), r);
- return(XEN_LIST_2(C_TO_XEN_INT(val), C_TO_XEN_XRectangle(r)));
+ val = XClipBox(Xen_to_C_Region(arg1), r);
+ return(Xen_list_2(C_int_to_Xen_integer(val), C_to_Xen_XRectangle(r)));
}
-static XEN gxm_XAllocWMHints(void)
+static Xen gxm_XAllocWMHints(void)
{
#define H_XAllocWMHints "XAllocWMHints() allocates a window manager hints structure"
- return(C_TO_XEN_XWMHints(XAllocWMHints()));
+ return(C_to_Xen_XWMHints(XAllocWMHints()));
}
-static XEN gxm_XAllocStandardColormap(void)
+static Xen gxm_XAllocStandardColormap(void)
{
#define H_XAllocStandardColormap "XStandardColormap *XAllocStandardColormap() allocates and returns a pointer to a XStandardColormap structure."
- return(C_TO_XEN_XStandardColormap(XAllocStandardColormap()));
+ return(C_to_Xen_XStandardColormap(XAllocStandardColormap()));
}
-static XEN gxm_XAllocIconSize(void)
+static Xen gxm_XAllocIconSize(void)
{
#define H_XAllocIconSize "XIconSize *XAllocIconSize() allocates and returns a pointer to a XIconSize structure."
- return(C_TO_XEN_XIconSize(XAllocIconSize()));
+ return(C_to_Xen_XIconSize(XAllocIconSize()));
}
-static XEN gxm_XFilterEvent(XEN arg1, XEN arg2)
+static Xen gxm_XFilterEvent(Xen arg1, Xen arg2)
{
#define H_XFilterEvent "Bool XFilterEvent(event, w) passes the event to any filters registered for it in the given window"
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg1), arg1, 1, "XFilterEvent", "XEvent*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XFilterEvent", "Window");
- return(C_TO_XEN_BOOLEAN(XFilterEvent(XEN_TO_C_XEvent(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_XEvent(arg1), arg1, 1, "XFilterEvent", "XEvent*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XFilterEvent", "Window");
+ return(C_bool_to_Xen_boolean(XFilterEvent(Xen_to_C_XEvent(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XContextualDrawing(XEN arg1)
+static Xen gxm_XContextualDrawing(Xen arg1)
{
#define H_XContextualDrawing "Bool XContextualDrawing(font_set): returns " PROC_TRUE " if text drawn with the font set might include context-dependent drawing."
- XEN_ASSERT_TYPE(XEN_XFontSet_P(arg1), arg1, 1, "XContextualDrawing", "XFontSet");
- return(C_TO_XEN_BOOLEAN(XContextualDrawing(XEN_TO_C_XFontSet(arg1))));
+ Xen_check_type(Xen_is_XFontSet(arg1), arg1, 1, "XContextualDrawing", "XFontSet");
+ return(C_bool_to_Xen_boolean(XContextualDrawing(Xen_to_C_XFontSet(arg1))));
}
-static XEN gxm_XDirectionalDependentDrawing(XEN arg1)
+static Xen gxm_XDirectionalDependentDrawing(Xen arg1)
{
#define H_XDirectionalDependentDrawing "Bool XDirectionalDependentDrawing(font_set): returns " PROC_TRUE " if the drawing functions implement \
implicit text directionality."
- XEN_ASSERT_TYPE(XEN_XFontSet_P(arg1), arg1, 1, "XDirectionalDependentDrawing", "XFontSet");
- return(C_TO_XEN_BOOLEAN(XDirectionalDependentDrawing(XEN_TO_C_XFontSet(arg1))));
+ Xen_check_type(Xen_is_XFontSet(arg1), arg1, 1, "XDirectionalDependentDrawing", "XFontSet");
+ return(C_bool_to_Xen_boolean(XDirectionalDependentDrawing(Xen_to_C_XFontSet(arg1))));
}
-static XEN gxm_XContextDependentDrawing(XEN arg1)
+static Xen gxm_XContextDependentDrawing(Xen arg1)
{
#define H_XContextDependentDrawing "Bool XContextDependentDrawing(font_set): returns " PROC_TRUE " if the drawing functions implement implicit \
text directionality or if text drawn with the font_set might include context-dependent drawing."
- XEN_ASSERT_TYPE(XEN_XFontSet_P(arg1), arg1, 1, "XContextDependentDrawing", "XFontSet");
- return(C_TO_XEN_BOOLEAN(XContextDependentDrawing(XEN_TO_C_XFontSet(arg1))));
+ Xen_check_type(Xen_is_XFontSet(arg1), arg1, 1, "XContextDependentDrawing", "XFontSet");
+ return(C_bool_to_Xen_boolean(XContextDependentDrawing(Xen_to_C_XFontSet(arg1))));
}
-static XEN gxm_XLocaleOfFontSet(XEN arg1)
+static Xen gxm_XLocaleOfFontSet(Xen arg1)
{
#define H_XLocaleOfFontSet "char *XLocaleOfFontSet(font_set): returns the name of the locale bound to the specified XFontSet, as a \
null-terminated string."
- XEN_ASSERT_TYPE(XEN_XFontSet_P(arg1), arg1, 1, "XLocaleOfFontSet", "XFontSet");
- return(C_TO_XEN_STRING(XLocaleOfFontSet(XEN_TO_C_XFontSet(arg1))));
+ Xen_check_type(Xen_is_XFontSet(arg1), arg1, 1, "XLocaleOfFontSet", "XFontSet");
+ return(C_string_to_Xen_string(XLocaleOfFontSet(Xen_to_C_XFontSet(arg1))));
}
-static XEN gxm_XBaseFontNameListOfFontSet(XEN arg1)
+static Xen gxm_XBaseFontNameListOfFontSet(Xen arg1)
{
#define H_XBaseFontNameListOfFontSet "char *XBaseFontNameListOfFontSet(font_set): returns the original base font name list supplied \
by the client when the XFontSet was created."
- XEN_ASSERT_TYPE(XEN_XFontSet_P(arg1), arg1, 1, "XBaseFontNameListOfFontSet", "XFontSet");
- return(C_TO_XEN_STRING(XBaseFontNameListOfFontSet(XEN_TO_C_XFontSet(arg1))));
+ Xen_check_type(Xen_is_XFontSet(arg1), arg1, 1, "XBaseFontNameListOfFontSet", "XFontSet");
+ return(C_string_to_Xen_string(XBaseFontNameListOfFontSet(Xen_to_C_XFontSet(arg1))));
}
-static XEN gxm_XFontsOfFontSet(XEN arg1)
+static Xen gxm_XFontsOfFontSet(Xen arg1)
{
#define H_XFontsOfFontSet "int XFontsOfFontSet(font_set): returns a list of one or more \
XFontStructs and font names for the fonts used by the Xmb and Xwc layers, for the given font set."
@@ -8360,32 +8080,32 @@ XFontStructs and font names for the fonts used by the Xmb and Xwc layers, for th
*/
int i, len, loc1, loc2;
char **names;
- XEN lst1 = XEN_EMPTY_LIST, lst2 = XEN_EMPTY_LIST;
+ Xen lst1 = Xen_empty_list, lst2 = Xen_empty_list;
XFontStruct **fs;
- XEN_ASSERT_TYPE(XEN_XFontSet_P(arg1), arg1, 1, "XFontsOfFontSet", "XFontSet");
- len = XFontsOfFontSet(XEN_TO_C_XFontSet(arg1), &fs, &names);
+ Xen_check_type(Xen_is_XFontSet(arg1), arg1, 1, "XFontsOfFontSet", "XFontSet");
+ len = XFontsOfFontSet(Xen_to_C_XFontSet(arg1), &fs, &names);
loc1 = xm_protect(lst1);
loc2 = xm_protect(lst2);
for (i = len - 1; i >= 0; i--)
{
- lst1 = XEN_CONS(C_TO_XEN_XFontStruct(fs[i]), lst1);
- lst2 = XEN_CONS(C_TO_XEN_STRING(names[i]), lst2);
+ lst1 = Xen_cons(C_to_Xen_XFontStruct(fs[i]), lst1);
+ lst2 = Xen_cons(C_string_to_Xen_string(names[i]), lst2);
}
xm_unprotect_at(loc1);
xm_unprotect_at(loc2);
- return(XEN_LIST_2(lst1, lst2));
+ return(Xen_list_2(lst1, lst2));
}
-static XEN gxm_XFreeFontSet(XEN arg1, XEN arg2)
+static Xen gxm_XFreeFontSet(Xen arg1, Xen arg2)
{
#define H_XFreeFontSet "void XFreeFontSet(display, font_set) frees the specified font set."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFreeFontSet", "Display*");
- XEN_ASSERT_TYPE(XEN_XFontSet_P(arg2), arg2, 2, "XFreeFontSet", "XFontSet");
- XFreeFontSet(XEN_TO_C_Display(arg1), XEN_TO_C_XFontSet(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFreeFontSet", "Display*");
+ Xen_check_type(Xen_is_XFontSet(arg2), arg2, 2, "XFreeFontSet", "XFontSet");
+ XFreeFontSet(Xen_to_C_Display(arg1), Xen_to_C_XFontSet(arg2));
+ return(Xen_false);
}
-static XEN gxm_XCreateFontSet(XEN arg1, XEN arg2)
+static Xen gxm_XCreateFontSet(Xen arg1, Xen arg2)
{
#define H_XCreateFontSet "XFontSet XCreateFontSet(display, base_font_name_list) creates a font set for the specified display."
/* DIFF: XCreateFontSet ignores (omits) the 3 trailing missing glyph args
@@ -8393,43 +8113,43 @@ static XEN gxm_XCreateFontSet(XEN arg1, XEN arg2)
char **cs;
int len;
char *str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateFontSet", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XCreateFontSet", "char*");
- return(C_TO_XEN_XFontSet(XCreateFontSet(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2), &cs, &len, &str)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateFontSet", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XCreateFontSet", "char*");
+ return(C_to_Xen_XFontSet(XCreateFontSet(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2), &cs, &len, &str)));
}
-static XEN gxm_XSetLocaleModifiers(XEN arg1)
+static Xen gxm_XSetLocaleModifiers(Xen arg1)
{
#define H_XSetLocaleModifiers "char *XSetLocaleModifiers(modifier_list) sets the X modifiers for the current locale setting."
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XSetLocaleModifiers", "char*");
- return(C_TO_XEN_STRING(XSetLocaleModifiers(XEN_TO_C_STRING(arg1))));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XSetLocaleModifiers", "char*");
+ return(C_string_to_Xen_string(XSetLocaleModifiers(Xen_string_to_C_string(arg1))));
}
-static XEN gxm_XSupportsLocale(void)
+static Xen gxm_XSupportsLocale(void)
{
#define H_XSupportsLocale "Bool XSupportsLocale(): returns " PROC_TRUE " if Xlib functions are capable of operating under the current locale."
- return(C_TO_XEN_BOOLEAN(XSupportsLocale()));
+ return(C_bool_to_Xen_boolean(XSupportsLocale()));
}
-static XEN gxm_XWriteBitmapFile(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XWriteBitmapFile(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XWriteBitmapFile "int XWriteBitmapFile(display, filename, bitmap, width, height, x_hot, y_hot) writes a bitmap out to a file in \
the X Version 11 format."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XWriteBitmapFile", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XWriteBitmapFile", "char*");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3), arg3, 3, "XWriteBitmapFile", "Pixmap");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XWriteBitmapFile", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XWriteBitmapFile", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XWriteBitmapFile", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XWriteBitmapFile", "int");
- return(C_TO_XEN_INT(XWriteBitmapFile(XEN_TO_C_Display(arg1),
- (char *)XEN_TO_C_STRING(arg2),
- XEN_TO_C_Pixmap(arg3),
- XEN_TO_C_ULONG(arg4), XEN_TO_C_ULONG(arg5),
- XEN_TO_C_INT(arg6), XEN_TO_C_INT(arg7))));
-}
-
-static XEN gxm_XWindowEvent(XEN arg1, XEN arg2, XEN arg3)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XWriteBitmapFile", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XWriteBitmapFile", "char*");
+ Xen_check_type(Xen_is_Pixmap(arg3), arg3, 3, "XWriteBitmapFile", "Pixmap");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XWriteBitmapFile", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XWriteBitmapFile", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XWriteBitmapFile", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XWriteBitmapFile", "int");
+ return(C_int_to_Xen_integer(XWriteBitmapFile(Xen_to_C_Display(arg1),
+ (char *)Xen_string_to_C_string(arg2),
+ Xen_to_C_Pixmap(arg3),
+ Xen_ulong_to_C_ulong(arg4), Xen_ulong_to_C_ulong(arg5),
+ Xen_integer_to_C_int(arg6), Xen_integer_to_C_int(arg7))));
+}
+
+static Xen gxm_XWindowEvent(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XWindowEvent "XWindowEvent(display, w, event_mask) searches the event queue for an event that matches both \
the specified window and event mask, and removes it or waits until it arrives."
@@ -8437,142 +8157,142 @@ the specified window and event mask, and removes it or waits until it arrives."
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XWindowEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XWindowEvent", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XWindowEvent", "long");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XWindowEvent", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XWindowEvent", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XWindowEvent", "long");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XWindowEvent(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3), e);
- return(XEN_LIST_2(C_TO_XEN_INT(val), C_TO_XEN_XEvent_OBJ(e)));
+ val = XWindowEvent(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3), e);
+ return(Xen_list_2(C_int_to_Xen_integer(val), C_to_Xen_XEvent_OBJ(e)));
}
-static XEN gxm_XWidthOfScreen(XEN arg1)
+static Xen gxm_XWidthOfScreen(Xen arg1)
{
#define H_WidthOfScreen "XWidthOfScreen(screen): returns the width of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XWidthOfScreen", "Screen*");
- return(C_TO_XEN_INT(XWidthOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XWidthOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XWidthOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XWidthMMOfScreen(XEN arg1)
+static Xen gxm_XWidthMMOfScreen(Xen arg1)
{
#define H_WidthMMOfScreen "XWidthMMOfScreen(screen): returns the width of the specified screen in millimeters."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XWidthMMOfScreen", "Screen*");
- return(C_TO_XEN_INT(XWidthMMOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XWidthMMOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XWidthMMOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XWarpPointer(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8, XEN arg9)
+static Xen gxm_XWarpPointer(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8, Xen arg9)
{
#define H_XWarpPointer "XWarpPointer(display, src_w, dest_w, src_x, src_y, src_width, src_height, dest_x, dest_y)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XWarpPointer", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XWarpPointer", "Window");
- XEN_ASSERT_TYPE(XEN_Window_P(arg3), arg3, 3, "XWarpPointer", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XWarpPointer", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XWarpPointer", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XWarpPointer", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XWarpPointer", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XWarpPointer", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9), arg9, 9, "XWarpPointer", "int");
- return(C_TO_XEN_INT(XWarpPointer(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2), XEN_TO_C_Window(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- XEN_TO_C_ULONG(arg6), XEN_TO_C_ULONG(arg7),
- XEN_TO_C_INT(arg8), XEN_TO_C_INT(arg9))));
-}
-
-static XEN gxm_XVendorRelease(XEN arg1)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XWarpPointer", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XWarpPointer", "Window");
+ Xen_check_type(Xen_is_Window(arg3), arg3, 3, "XWarpPointer", "Window");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XWarpPointer", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XWarpPointer", "int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XWarpPointer", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XWarpPointer", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XWarpPointer", "int");
+ Xen_check_type(Xen_is_integer(arg9), arg9, 9, "XWarpPointer", "int");
+ return(C_int_to_Xen_integer(XWarpPointer(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2), Xen_to_C_Window(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ Xen_ulong_to_C_ulong(arg6), Xen_ulong_to_C_ulong(arg7),
+ Xen_integer_to_C_int(arg8), Xen_integer_to_C_int(arg9))));
+}
+
+static Xen gxm_XVendorRelease(Xen arg1)
{
#define H_VendorRelease "VendorRelease(display): returns a number related to a vendor's release of the X server."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XVendorRelease", "Display*");
- return(C_TO_XEN_INT(XVendorRelease(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XVendorRelease", "Display*");
+ return(C_int_to_Xen_integer(XVendorRelease(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XUnmapWindow(XEN arg1, XEN arg2)
+static Xen gxm_XUnmapWindow(Xen arg1, Xen arg2)
{
#define H_XUnmapWindow "XUnmapWindow(display, w) unmaps the specified window and causes the X server to generate an UnmapNotify event."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUnmapWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XUnmapWindow", "Window");
- return(C_TO_XEN_INT(XUnmapWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUnmapWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XUnmapWindow", "Window");
+ return(C_int_to_Xen_integer(XUnmapWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XUnmapSubwindows(XEN arg1, XEN arg2)
+static Xen gxm_XUnmapSubwindows(Xen arg1, Xen arg2)
{
#define H_XUnmapSubwindows "XUnmapSubwindows(display, w) unmaps all subwindows for the specified window in bottom-to-top stacking order."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUnmapSubwindows", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XUnmapSubwindows", "Window");
- return(C_TO_XEN_INT(XUnmapSubwindows(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUnmapSubwindows", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XUnmapSubwindows", "Window");
+ return(C_int_to_Xen_integer(XUnmapSubwindows(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XUnloadFont(XEN arg1, XEN arg2)
+static Xen gxm_XUnloadFont(Xen arg1, Xen arg2)
{
#define H_XUnloadFont "XUnloadFont(display, font) deletes the association between the font resource ID and the specified font."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUnloadFont", "Display*");
- XEN_ASSERT_TYPE(XEN_Font_P(arg2), arg2, 2, "XUnloadFont", "Font");
- return(C_TO_XEN_INT(XUnloadFont(XEN_TO_C_Display(arg1), XEN_TO_C_Font(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUnloadFont", "Display*");
+ Xen_check_type(Xen_is_Font(arg2), arg2, 2, "XUnloadFont", "Font");
+ return(C_int_to_Xen_integer(XUnloadFont(Xen_to_C_Display(arg1), Xen_to_C_Font(arg2))));
}
-static XEN gxm_XUninstallColormap(XEN arg1, XEN arg2)
+static Xen gxm_XUninstallColormap(Xen arg1, Xen arg2)
{
#define H_XUninstallColormap "XUninstallColormap(display, colormap) removes the specified colormap from the required list for its screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUninstallColormap", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XUninstallColormap", "Colormap");
- return(C_TO_XEN_INT(XUninstallColormap(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUninstallColormap", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XUninstallColormap", "Colormap");
+ return(C_int_to_Xen_integer(XUninstallColormap(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2))));
}
-static XEN gxm_XUngrabServer(XEN arg1)
+static Xen gxm_XUngrabServer(Xen arg1)
{
#define H_XUngrabServer "XUngrabServer(display) restarts processing of requests and close downs on other connections."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUngrabServer", "Display*");
- return(C_TO_XEN_INT(XUngrabServer(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUngrabServer", "Display*");
+ return(C_int_to_Xen_integer(XUngrabServer(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XUngrabPointer(XEN arg1, XEN arg2)
+static Xen gxm_XUngrabPointer(Xen arg1, Xen arg2)
{
#define H_XUngrabPointer "XUngrabPointer(display, time) releases the pointer and any queued events if this client has actively grabbed the \
pointer from XGrabPointer, XGrabButton,or from a normal button press."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUngrabPointer", "Display*");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XUngrabPointer", "Time");
- return(C_TO_XEN_INT(XUngrabPointer(XEN_TO_C_Display(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUngrabPointer", "Display*");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XUngrabPointer", "Time");
+ return(C_int_to_Xen_integer(XUngrabPointer(Xen_to_C_Display(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XUngrabKeyboard(XEN arg1, XEN arg2)
+static Xen gxm_XUngrabKeyboard(Xen arg1, Xen arg2)
{
#define H_XUngrabKeyboard "XUngrabKeyboard(display, time) releases the keyboard and any queued events if this client has it actively grabbed \
from either XGrabKeyboard or XGrabKey."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUngrabKeyboard", "Display*");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XUngrabKeyboard", "Time");
- return(C_TO_XEN_INT(XUngrabKeyboard(XEN_TO_C_Display(arg1), XEN_TO_C_Time(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUngrabKeyboard", "Display*");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XUngrabKeyboard", "Time");
+ return(C_int_to_Xen_integer(XUngrabKeyboard(Xen_to_C_Display(arg1), Xen_to_C_Time(arg2))));
}
-static XEN gxm_XUngrabKey(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XUngrabKey(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XUngrabKey "XUngrabKey(display, keycode, modifiers, grab_window) releases the key combination on the specified window if it was \
grabbed by this client."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUngrabKey", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XUngrabKey", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XUngrabKey", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg4), arg4, 4, "XUngrabKey", "Window");
- return(C_TO_XEN_INT(XUngrabKey(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_ULONG(arg3), XEN_TO_C_Window(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUngrabKey", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XUngrabKey", "int");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XUngrabKey", "unsigned int");
+ Xen_check_type(Xen_is_Window(arg4), arg4, 4, "XUngrabKey", "Window");
+ return(C_int_to_Xen_integer(XUngrabKey(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), Xen_ulong_to_C_ulong(arg3), Xen_to_C_Window(arg4))));
}
-static XEN gxm_XUngrabButton(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XUngrabButton(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XUngrabButton "XUngrabButton(display, button, modifiers, grab_window) releases the passive button/key combination on the specified \
window if it was grabbed by this client."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUngrabButton", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XUngrabButton", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XUngrabButton", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg4), arg4, 4, "XUngrabButton", "Window");
- return(C_TO_XEN_INT(XUngrabButton(XEN_TO_C_Display(arg1), XEN_TO_C_ULONG(arg2), XEN_TO_C_ULONG(arg3), XEN_TO_C_Window(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUngrabButton", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XUngrabButton", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XUngrabButton", "unsigned int");
+ Xen_check_type(Xen_is_Window(arg4), arg4, 4, "XUngrabButton", "Window");
+ return(C_int_to_Xen_integer(XUngrabButton(Xen_to_C_Display(arg1), Xen_ulong_to_C_ulong(arg2), Xen_ulong_to_C_ulong(arg3), Xen_to_C_Window(arg4))));
}
-static XEN gxm_XUndefineCursor(XEN arg1, XEN arg2)
+static Xen gxm_XUndefineCursor(Xen arg1, Xen arg2)
{
#define H_XUndefineCursor "XUndefineCursor(display, w) undoes the effect of a previous XDefineCursor for this window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XUndefineCursor", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XUndefineCursor", "Window");
- return(C_TO_XEN_INT(XUndefineCursor(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XUndefineCursor", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XUndefineCursor", "Window");
+ return(C_int_to_Xen_integer(XUndefineCursor(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XTranslateCoordinates(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XTranslateCoordinates(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XTranslateCoordinates "Bool XTranslateCoordinates(display, src_w, dest_w, src_x, src_y) \
takes the src_x and src_y coordinates relative to the source window's origin and returns these coordinates to dest_x_return and dest_y_return \
@@ -8581,89 +8301,89 @@ relative to the destination window's origin -> (rtn x y win)."
*/
Window w;
int x, y, rtn;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XTranslateCoordinates", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XTranslateCoordinates", "Window");
- XEN_ASSERT_TYPE(XEN_Window_P(arg3), arg3, 3, "XTranslateCoordinates", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XTranslateCoordinates", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XTranslateCoordinates", "int");
- rtn = XTranslateCoordinates(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_Window(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XTranslateCoordinates", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XTranslateCoordinates", "Window");
+ Xen_check_type(Xen_is_Window(arg3), arg3, 3, "XTranslateCoordinates", "Window");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XTranslateCoordinates", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XTranslateCoordinates", "int");
+ rtn = XTranslateCoordinates(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_Window(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
&x, &y, &w);
- return(XEN_LIST_4(C_TO_XEN_BOOLEAN(rtn),
- C_TO_XEN_INT(x),
- C_TO_XEN_INT(y),
- C_TO_XEN_Window(w)));
+ return(Xen_list_4(C_bool_to_Xen_boolean(rtn),
+ C_int_to_Xen_integer(x),
+ C_int_to_Xen_integer(y),
+ C_to_Xen_Window(w)));
}
-static XEN gxm_XTextWidth(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XTextWidth(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XTextWidth "int XTextWidth(font_struct, string, count): returns the width of the specified 8-bit string."
- XEN_ASSERT_TYPE(XEN_XFontStruct_P(arg1), arg1, 1, "XTextWidth", "XFontStruct*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XTextWidth", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XTextWidth", "int");
- return(C_TO_XEN_INT(XTextWidth(XEN_TO_C_XFontStruct(arg1), (char *)XEN_TO_C_STRING(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_XFontStruct(arg1), arg1, 1, "XTextWidth", "XFontStruct*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XTextWidth", "char*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XTextWidth", "int");
+ return(C_int_to_Xen_integer(XTextWidth(Xen_to_C_XFontStruct(arg1), (char *)Xen_string_to_C_string(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XTextExtents(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XTextExtents(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XTextExtents "XTextExtents(font_struct, string, nchars): returns an XCharStruct structure describing the text."
/* DIFF: XTextExtents omit final 4 args and returns them [Xcharset returned as embedded list)
*/
int dir, fa, fd, rtn;
XCharStruct val;
- XEN_ASSERT_TYPE(XEN_XFontStruct_P(arg1), arg1, 1, "XTextExtents", "XFontStruct*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XTextExtents", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XTextExtents", "int");
- rtn = XTextExtents(XEN_TO_C_XFontStruct(arg1),
- (char *)XEN_TO_C_STRING(arg2),
- XEN_TO_C_INT(arg3),
+ Xen_check_type(Xen_is_XFontStruct(arg1), arg1, 1, "XTextExtents", "XFontStruct*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XTextExtents", "char*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XTextExtents", "int");
+ rtn = XTextExtents(Xen_to_C_XFontStruct(arg1),
+ (char *)Xen_string_to_C_string(arg2),
+ Xen_integer_to_C_int(arg3),
&dir, &fa, &fd, &val);
- return(XEN_LIST_5(C_TO_XEN_INT(rtn),
- C_TO_XEN_INT(dir),
- C_TO_XEN_INT(fa),
- C_TO_XEN_INT(fd),
- XEN_LIST_6(C_TO_XEN_INT((int)(val.lbearing)),
- C_TO_XEN_INT((int)(val.rbearing)),
- C_TO_XEN_INT((int)(val.width)),
- C_TO_XEN_INT((int)(val.ascent)),
- C_TO_XEN_INT((int)(val.descent)),
- C_TO_XEN_INT((int)(val.attributes)))));
+ return(Xen_list_5(C_int_to_Xen_integer(rtn),
+ C_int_to_Xen_integer(dir),
+ C_int_to_Xen_integer(fa),
+ C_int_to_Xen_integer(fd),
+ Xen_list_6(C_int_to_Xen_integer((int)(val.lbearing)),
+ C_int_to_Xen_integer((int)(val.rbearing)),
+ C_int_to_Xen_integer((int)(val.width)),
+ C_int_to_Xen_integer((int)(val.ascent)),
+ C_int_to_Xen_integer((int)(val.descent)),
+ C_int_to_Xen_integer((int)(val.attributes)))));
}
-static XEN gxm_XSync(XEN arg1, XEN arg2)
+static Xen gxm_XSync(Xen arg1, Xen arg2)
{
#define H_XSync "XSync(display, discard) flushes the output buffer and then waits until all requests have been received and processed by the X server."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSync", "Display*");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XSync", "Bool");
- return(C_TO_XEN_INT(XSync(XEN_TO_C_Display(arg1), XEN_TO_C_BOOLEAN(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSync", "Display*");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XSync", "Bool");
+ return(C_int_to_Xen_integer(XSync(Xen_to_C_Display(arg1), Xen_boolean_to_C_bool(arg2))));
}
-static XEN gxm_XStoreNamedColor(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XStoreNamedColor(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XStoreNamedColor "XStoreNamedColor(display, colormap, color, pixel, flags) looks up the named color with respect to the screen \
associated with the colormap and stores the result in the specified colormap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XStoreNamedColor", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XStoreNamedColor", "Colormap");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XStoreNamedColor", "char*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XStoreNamedColor", "ulong"); /* this is explicitly an index into the colormap, so I'll leave it as is */
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XStoreNamedColor", "int");
- return(C_TO_XEN_INT(XStoreNamedColor(XEN_TO_C_Display(arg1),
- XEN_TO_C_Colormap(arg2),
- (char *)XEN_TO_C_STRING(arg3), XEN_TO_C_ULONG(arg4), XEN_TO_C_INT(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XStoreNamedColor", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XStoreNamedColor", "Colormap");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XStoreNamedColor", "char*");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XStoreNamedColor", "ulong"); /* this is explicitly an index into the colormap, so I'll leave it as is */
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XStoreNamedColor", "int");
+ return(C_int_to_Xen_integer(XStoreNamedColor(Xen_to_C_Display(arg1),
+ Xen_to_C_Colormap(arg2),
+ (char *)Xen_string_to_C_string(arg3), Xen_ulong_to_C_ulong(arg4), Xen_integer_to_C_int(arg5))));
}
-static XEN gxm_XStoreName(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XStoreName(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XStoreName "XStoreName(display, w, window_name) assigns the name passed to window_name to the specified window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XStoreName", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XStoreName", "Window");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XStoreName", "char*");
- return(C_TO_XEN_INT(XStoreName(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), (char *)XEN_TO_C_STRING(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XStoreName", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XStoreName", "Window");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XStoreName", "char*");
+ return(C_int_to_Xen_integer(XStoreName(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), (char *)Xen_string_to_C_string(arg3))));
}
-static XEN gxm_XStoreColors(XEN arg1, XEN arg2, XEN larg3, XEN arg4)
+static Xen gxm_XStoreColors(Xen arg1, Xen arg2, Xen larg3, Xen arg4)
{
#define H_XStoreColors "XStoreColors(display, colormap, color, ncolors) changes the colormap entries of the pixel values specified in the \
pixel members of the XColor structures."
@@ -8671,19 +8391,19 @@ pixel members of the XColor structures."
*/
XColor *xc;
int i, len;
- XEN arg3;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XStoreColors", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XStoreColors", "Colormap");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg3), larg3, 3, "XStoreColors", "list of XColor");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XStoreColors", "int");
- arg3 = XEN_COPY_ARG(larg3);
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg4, 4, "XStoreColors", "positive integer");
+ Xen arg3;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XStoreColors", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XStoreColors", "Colormap");
+ Xen_check_type(Xen_is_list(larg3), larg3, 3, "XStoreColors", "list of XColor");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XStoreColors", "int");
+ arg3 = Xen_copy_arg(larg3);
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) Xen_check_type(0, arg4, 4, "XStoreColors", "positive integer");
xc = (XColor *)calloc(len, sizeof(XColor));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg3)); i++, arg3 = XEN_CDR(arg3))
+ for (i = 0; (i < len) && (!Xen_is_null(arg3)); i++, arg3 = Xen_cdr(arg3))
{
XColor *xc1;
- xc1 = XEN_TO_C_XColor(XEN_CAR(arg3));
+ xc1 = Xen_to_C_XColor(Xen_car(arg3));
xc[i].pixel = xc1->pixel;
xc[i].red = xc1->red;
xc[i].green = xc1->green;
@@ -8691,367 +8411,367 @@ pixel members of the XColor structures."
xc[i].flags = xc1->flags;
xc[i].pad = xc1->pad;
}
- XStoreColors(XEN_TO_C_Display(arg1),
- XEN_TO_C_Colormap(arg2),
+ XStoreColors(Xen_to_C_Display(arg1),
+ Xen_to_C_Colormap(arg2),
xc, len);
free(xc);
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XStoreColor(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XStoreColor(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XStoreColor "XStoreColor(display, colormap, color) changes the colormap entry of the pixel value specified in the pixel member \
of the XColor structure."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XStoreColor", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XStoreColor", "Colormap");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg3), arg3, 3, "XStoreColor", "XColor");
- return(C_TO_XEN_INT(XStoreColor(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2), XEN_TO_C_XColor(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XStoreColor", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XStoreColor", "Colormap");
+ Xen_check_type(Xen_is_XColor(arg3), arg3, 3, "XStoreColor", "XColor");
+ return(C_int_to_Xen_integer(XStoreColor(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2), Xen_to_C_XColor(arg3))));
}
-static XEN gxm_XStoreBytes(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XStoreBytes(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XStoreBytes "XStoreBytes(display, bytes, nbytes)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XStoreBytes", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XStoreBytes", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XStoreBytes", "int");
- return(C_TO_XEN_INT(XStoreBytes(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2), XEN_TO_C_INT(arg3) + 1)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XStoreBytes", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XStoreBytes", "char*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XStoreBytes", "int");
+ return(C_int_to_Xen_integer(XStoreBytes(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2), Xen_integer_to_C_int(arg3) + 1)));
}
-static XEN gxm_XStoreBuffer(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XStoreBuffer(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XStoreBuffer "XStoreBuffer(display, bytes, nbytes, buffer)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XStoreBuffer", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XStoreBuffer", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XStoreBuffer", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XStoreBuffer", "int");
- return(C_TO_XEN_INT(XStoreBuffer(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2), XEN_TO_C_INT(arg3) + 1, XEN_TO_C_INT(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XStoreBuffer", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XStoreBuffer", "char*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XStoreBuffer", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XStoreBuffer", "int");
+ return(C_int_to_Xen_integer(XStoreBuffer(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2), Xen_integer_to_C_int(arg3) + 1, Xen_integer_to_C_int(arg4))));
}
-static XEN gxm_XSetWindowColormap(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetWindowColormap(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetWindowColormap "XSetWindowColormap(display, w, colormap) sets the specified colormap of the specified window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWindowColormap", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWindowColormap", "Window");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg3), arg3, 3, "XSetWindowColormap", "Colormap");
- return(C_TO_XEN_INT(XSetWindowColormap(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Colormap(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWindowColormap", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWindowColormap", "Window");
+ Xen_check_type(Xen_is_Colormap(arg3), arg3, 3, "XSetWindowColormap", "Colormap");
+ return(C_int_to_Xen_integer(XSetWindowColormap(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Colormap(arg3))));
}
-static XEN gxm_XSetWindowBorderWidth(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetWindowBorderWidth(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetWindowBorderWidth "XSetWindowBorderWidth(display, w, width) sets the specified window's border width to the specified width."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWindowBorderWidth", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWindowBorderWidth", "Window");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XSetWindowBorderWidth", "unsigned int");
- return(C_TO_XEN_INT(XSetWindowBorderWidth(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_ULONG(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWindowBorderWidth", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWindowBorderWidth", "Window");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XSetWindowBorderWidth", "unsigned int");
+ return(C_int_to_Xen_integer(XSetWindowBorderWidth(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_ulong_to_C_ulong(arg3))));
}
-static XEN gxm_XSetWindowBorderPixmap(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetWindowBorderPixmap(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetWindowBorderPixmap "XSetWindowBorderPixmap(display, w, border_pixmap) sets the border pixmap of the window to the pixmap you specify."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWindowBorderPixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWindowBorderPixmap", "Window");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3) || XEN_INTEGER_P(arg3), arg3, 3, "XSetWindowBorderPixmap", "Pixmap");
- return(C_TO_XEN_INT(XSetWindowBorderPixmap(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- (XEN_Pixmap_P(arg3)) ? XEN_TO_C_Pixmap(arg3) : CopyFromParent)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWindowBorderPixmap", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWindowBorderPixmap", "Window");
+ Xen_check_type(Xen_is_Pixmap(arg3) || Xen_is_integer(arg3), arg3, 3, "XSetWindowBorderPixmap", "Pixmap");
+ return(C_int_to_Xen_integer(XSetWindowBorderPixmap(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ (Xen_is_Pixmap(arg3)) ? Xen_to_C_Pixmap(arg3) : CopyFromParent)));
}
-static XEN gxm_XSetWindowBorder(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetWindowBorder(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetWindowBorder "XSetWindowBorder(display, w, border_pixel) sets the border of the window to the pixel value you specify."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWindowBorder", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWindowBorder", "Window");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg3), arg3, 3, "XSetWindowBorder", "pixel");
- return(C_TO_XEN_INT(XSetWindowBorder(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Pixel(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWindowBorder", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWindowBorder", "Window");
+ Xen_check_type(Xen_is_Pixel(arg3), arg3, 3, "XSetWindowBorder", "pixel");
+ return(C_int_to_Xen_integer(XSetWindowBorder(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Pixel(arg3))));
}
-static XEN gxm_XSetWindowBackgroundPixmap(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetWindowBackgroundPixmap(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetWindowBackgroundPixmap "XSetWindowBackgroundPixmap(display, w, background_pixmap) sets the background pixmap of the window to \
the specified pixmap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWindowBackgroundPixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWindowBackgroundPixmap", "Window");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3) || XEN_INTEGER_P(arg3), arg3, 3, "XSetWindowBackgroundPixmap", "Pixmap");
- return(C_TO_XEN_INT(XSetWindowBackgroundPixmap(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- (XEN_Pixmap_P(arg3)) ? XEN_TO_C_Pixmap(arg3) : XEN_TO_C_ULONG(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWindowBackgroundPixmap", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWindowBackgroundPixmap", "Window");
+ Xen_check_type(Xen_is_Pixmap(arg3) || Xen_is_integer(arg3), arg3, 3, "XSetWindowBackgroundPixmap", "Pixmap");
+ return(C_int_to_Xen_integer(XSetWindowBackgroundPixmap(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ (Xen_is_Pixmap(arg3)) ? Xen_to_C_Pixmap(arg3) : Xen_ulong_to_C_ulong(arg3))));
}
-static XEN gxm_XSetWindowBackground(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetWindowBackground(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetWindowBackground "XSetWindowBackground(display, w, background_pixel) sets the background of the window to the specified pixel value."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWindowBackground", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWindowBackground", "Window");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg3), arg3, 3, "XSetWindowBackground", "pixel");
- return(C_TO_XEN_INT(XSetWindowBackground(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Pixel(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWindowBackground", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWindowBackground", "Window");
+ Xen_check_type(Xen_is_Pixel(arg3), arg3, 3, "XSetWindowBackground", "pixel");
+ return(C_int_to_Xen_integer(XSetWindowBackground(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Pixel(arg3))));
}
-static XEN gxm_XSetTile(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetTile(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetTile "XSetTile(display, gc, tile) sets the fill tile in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetTile", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetTile", "GC");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3), arg3, 3, "XSetTile", "Pixmap");
- return(C_TO_XEN_INT(XSetTile(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_Pixmap(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetTile", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetTile", "GC");
+ Xen_check_type(Xen_is_Pixmap(arg3), arg3, 3, "XSetTile", "Pixmap");
+ return(C_int_to_Xen_integer(XSetTile(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_to_C_Pixmap(arg3))));
}
-static XEN gxm_XSetTSOrigin(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XSetTSOrigin(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XSetTSOrigin "XSetTSOrigin(display, gc, ts_x_origin, ts_y_origin) sets the tile/stipple origin in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetTSOrigin", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetTSOrigin", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetTSOrigin", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetTSOrigin", "int");
- return(C_TO_XEN_INT(XSetTSOrigin(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetTSOrigin", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetTSOrigin", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetTSOrigin", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetTSOrigin", "int");
+ return(C_int_to_Xen_integer(XSetTSOrigin(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4))));
}
-static XEN gxm_XSetSubwindowMode(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetSubwindowMode(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetSubwindowMode "XSetSubwindowMode(display, gc, subwindow_mode) sets the subwindow mode in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetSubwindowMode", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetSubwindowMode", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetSubwindowMode", "int");
- return(C_TO_XEN_INT(XSetSubwindowMode(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetSubwindowMode", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetSubwindowMode", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetSubwindowMode", "int");
+ return(C_int_to_Xen_integer(XSetSubwindowMode(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XSetStipple(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetStipple(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetStipple "XSetStipple(display, gc, stipple) sets the stipple in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetStipple", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetStipple", "GC");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3), arg3, 3, "XSetStipple", "Pixmap");
- return(C_TO_XEN_INT(XSetStipple(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_Pixmap(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetStipple", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetStipple", "GC");
+ Xen_check_type(Xen_is_Pixmap(arg3), arg3, 3, "XSetStipple", "Pixmap");
+ return(C_int_to_Xen_integer(XSetStipple(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_to_C_Pixmap(arg3))));
}
-static XEN gxm_XSetState(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XSetState(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XSetState "XSetState(display, gc, foreground, background, function, plane_mask) sets the foreground, background, plane mask, and \
function components for the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetState", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetState", "GC");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg3), arg3, 3, "XSetState", "Pixel");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg4), arg4, 4, "XSetState", "Pixel");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XSetState", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XSetState", "ulong");
- return(C_TO_XEN_INT(XSetState(XEN_TO_C_Display(arg1),
- XEN_TO_C_GC(arg2),
- XEN_TO_C_Pixel(arg3), XEN_TO_C_Pixel(arg4),
- XEN_TO_C_INT(arg5), XEN_TO_C_ULONG(arg6))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetState", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetState", "GC");
+ Xen_check_type(Xen_is_Pixel(arg3), arg3, 3, "XSetState", "Pixel");
+ Xen_check_type(Xen_is_Pixel(arg4), arg4, 4, "XSetState", "Pixel");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XSetState", "int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XSetState", "ulong");
+ return(C_int_to_Xen_integer(XSetState(Xen_to_C_Display(arg1),
+ Xen_to_C_GC(arg2),
+ Xen_to_C_Pixel(arg3), Xen_to_C_Pixel(arg4),
+ Xen_integer_to_C_int(arg5), Xen_ulong_to_C_ulong(arg6))));
}
-static XEN gxm_XSetSelectionOwner(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XSetSelectionOwner(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XSetSelectionOwner "XSetSelectionOwner(display, selection, owner, time) changes the owner and last-change time for the specified selection"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetSelectionOwner", "Display*");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XSetSelectionOwner", "Atom");
- XEN_ASSERT_TYPE(XEN_Window_P(arg3), arg3, 3, "XSetSelectionOwner", "Window");
- XEN_ASSERT_TYPE(XEN_Time_P(arg4), arg4, 4, "XSetSelectionOwner", "Time");
- return(C_TO_XEN_INT(XSetSelectionOwner(XEN_TO_C_Display(arg1), XEN_TO_C_Atom(arg2), XEN_TO_C_Window(arg3), XEN_TO_C_Time(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetSelectionOwner", "Display*");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XSetSelectionOwner", "Atom");
+ Xen_check_type(Xen_is_Window(arg3), arg3, 3, "XSetSelectionOwner", "Window");
+ Xen_check_type(Xen_is_Time(arg4), arg4, 4, "XSetSelectionOwner", "Time");
+ return(C_int_to_Xen_integer(XSetSelectionOwner(Xen_to_C_Display(arg1), Xen_to_C_Atom(arg2), Xen_to_C_Window(arg3), Xen_to_C_Time(arg4))));
}
-static XEN gxm_XSetScreenSaver(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XSetScreenSaver(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XSetScreenSaver "XSetScreenSaver(display, timeout, interval, prefer_blanking, allow_exposures) enables the screen saver."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetScreenSaver", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XSetScreenSaver", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetScreenSaver", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetScreenSaver", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XSetScreenSaver", "int");
- return(C_TO_XEN_INT(XSetScreenSaver(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetScreenSaver", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XSetScreenSaver", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetScreenSaver", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetScreenSaver", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XSetScreenSaver", "int");
+ return(C_int_to_Xen_integer(XSetScreenSaver(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5))));
}
-static XEN gxm_XSetPointerMapping(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetPointerMapping(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetPointerMapping "int XSetPointerMapping(display, map, nmap) sets the mapping of the pointer."
int i, len, rtn;
unsigned char *map;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetPointerMapping", "Display*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XSetPointerMapping", "list of ints");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XSetPointerMapping", "int");
- if (XEN_INTEGER_P(arg3)) len = XEN_TO_C_INT(arg3); else len = XEN_LIST_LENGTH(arg2);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetPointerMapping", "Display*");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XSetPointerMapping", "list of ints");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XSetPointerMapping", "int");
+ if (Xen_is_integer(arg3)) len = Xen_integer_to_C_int(arg3); else len = Xen_list_length(arg2);
map = (unsigned char *)calloc(len, sizeof(unsigned char));
for (i = 0; i < len; i++)
- map[i] = (unsigned char)XEN_TO_C_INT(XEN_LIST_REF(arg2, i));
- rtn = XSetPointerMapping(XEN_TO_C_Display(arg1), map, len);
+ map[i] = (unsigned char)Xen_integer_to_C_int(Xen_list_ref(arg2, i));
+ rtn = XSetPointerMapping(Xen_to_C_Display(arg1), map, len);
free(map);
- return(C_TO_XEN_INT(rtn));
+ return(C_int_to_Xen_integer(rtn));
}
-static XEN gxm_XSetPlaneMask(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetPlaneMask(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetPlaneMask "XSetPlaneMask(display, gc, plane_mask) sets the plane mask in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetPlaneMask", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetPlaneMask", "GC");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XSetPlaneMask", "ulong");
- return(C_TO_XEN_INT(XSetPlaneMask(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_ULONG(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetPlaneMask", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetPlaneMask", "GC");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XSetPlaneMask", "ulong");
+ return(C_int_to_Xen_integer(XSetPlaneMask(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_ulong_to_C_ulong(arg3))));
}
-static XEN gxm_XSetModifierMapping(XEN arg1, XEN arg2)
+static Xen gxm_XSetModifierMapping(Xen arg1, Xen arg2)
{
#define H_XSetModifierMapping "int XSetModifierMapping(display, modmap) specifies the KeyCodes of the keys (if any) that are to be used as modifiers."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetModifierMapping", "Display*");
- XEN_ASSERT_TYPE(XEN_XModifierKeymap_P(arg2), arg2, 2, "XSetModifierMapping", "XModifierKeymap*");
- return(C_TO_XEN_INT(XSetModifierMapping(XEN_TO_C_Display(arg1), XEN_TO_C_XModifierKeymap(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetModifierMapping", "Display*");
+ Xen_check_type(Xen_is_XModifierKeymap(arg2), arg2, 2, "XSetModifierMapping", "XModifierKeymap*");
+ return(C_int_to_Xen_integer(XSetModifierMapping(Xen_to_C_Display(arg1), Xen_to_C_XModifierKeymap(arg2))));
}
-static XEN gxm_XSetLineAttributes(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XSetLineAttributes(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XSetLineAttributes "XSetLineAttributes(display, gc, line_width, line_style, cap_style, join_style) sets the line drawing components \
in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetLineAttributes", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetLineAttributes", "GC");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XSetLineAttributes", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetLineAttributes", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XSetLineAttributes", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XSetLineAttributes", "int");
- return(C_TO_XEN_INT(XSetLineAttributes(XEN_TO_C_Display(arg1),
- XEN_TO_C_GC(arg2),
- XEN_TO_C_ULONG(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetLineAttributes", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetLineAttributes", "GC");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XSetLineAttributes", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetLineAttributes", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XSetLineAttributes", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XSetLineAttributes", "int");
+ return(C_int_to_Xen_integer(XSetLineAttributes(Xen_to_C_Display(arg1),
+ Xen_to_C_GC(arg2),
+ Xen_ulong_to_C_ulong(arg3), Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6))));
}
-static XEN gxm_XSetInputFocus(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XSetInputFocus(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XSetInputFocus "XSetInputFocus(display, focus, revert_to, time) changes the input focus and the last-focus-change time."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetInputFocus", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetInputFocus", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetInputFocus", "int");
- XEN_ASSERT_TYPE(XEN_Time_P(arg4), arg4, 4, "XSetInputFocus", "Time");
- return(C_TO_XEN_INT(XSetInputFocus(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_Time(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetInputFocus", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetInputFocus", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetInputFocus", "int");
+ Xen_check_type(Xen_is_Time(arg4), arg4, 4, "XSetInputFocus", "Time");
+ return(C_int_to_Xen_integer(XSetInputFocus(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3), Xen_to_C_Time(arg4))));
}
-static XEN gxm_XSetIconName(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetIconName(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetIconName "XSetIconName(display, w, icon_name) sets the name to be displayed in a window's icon."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetIconName", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetIconName", "Window");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XSetIconName", "char*");
- return(C_TO_XEN_INT(XSetIconName(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), (char *)XEN_TO_C_STRING(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetIconName", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetIconName", "Window");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XSetIconName", "char*");
+ return(C_int_to_Xen_integer(XSetIconName(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), (char *)Xen_string_to_C_string(arg3))));
}
-static XEN gxm_XSetGraphicsExposures(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetGraphicsExposures(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetGraphicsExposures "XSetGraphicsExposures(display, gc, graphics_exposures) sets the graphics-exposures flag in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetGraphicsExposures", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetGraphicsExposures", "GC");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XSetGraphicsExposures", "Bool");
- return(C_TO_XEN_INT(XSetGraphicsExposures(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_BOOLEAN(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetGraphicsExposures", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetGraphicsExposures", "GC");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XSetGraphicsExposures", "Bool");
+ return(C_int_to_Xen_integer(XSetGraphicsExposures(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_boolean_to_C_bool(arg3))));
}
-static XEN gxm_XSetFunction(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetFunction(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetFunction "XSetFunction(display, gc, function) sets a specified value in the specified GC"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetFunction", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetFunction", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetFunction", "int");
- return(C_TO_XEN_INT(XSetFunction(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetFunction", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetFunction", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetFunction", "int");
+ return(C_int_to_Xen_integer(XSetFunction(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XSetForeground(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetForeground(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetForeground "XSetForeground(display, gc, foreground) sets the foreground in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetForeground", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetForeground", "GC");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg3), arg3, 3, "XSetForeground", "Pixel");
- return(C_TO_XEN_INT(XSetForeground(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_Pixel(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetForeground", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetForeground", "GC");
+ Xen_check_type(Xen_is_Pixel(arg3), arg3, 3, "XSetForeground", "Pixel");
+ return(C_int_to_Xen_integer(XSetForeground(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_to_C_Pixel(arg3))));
}
-static XEN gxm_XSetFontPath(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetFontPath(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetFontPath "XSetFontPath(display, directories, ndirs) defines the directory search path for font lookup."
/* DIFF: XSetFontPath arg2 is list of strings
*/
char **paths;
int len, rtn;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetFontPath", "Display*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XSetFontPath", "list of char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetFontPath", "int");
- len = XEN_TO_C_INT(arg3);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetFontPath", "Display*");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XSetFontPath", "list of char*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetFontPath", "int");
+ len = Xen_integer_to_C_int(arg3);
if (len > 0)
- paths = XEN_TO_C_Strings(arg2, len);
+ paths = Xen_to_C_Strings(arg2, len);
else paths = NULL;
- rtn = XSetFontPath(XEN_TO_C_Display(arg1), paths, len);
+ rtn = XSetFontPath(Xen_to_C_Display(arg1), paths, len);
if (paths) free(paths);
- return(C_TO_XEN_INT(rtn));
+ return(C_int_to_Xen_integer(rtn));
}
-static XEN gxm_XSetFont(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetFont(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetFont "XSetFont(display, gc, font) sets the current font in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetFont", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetFont", "GC");
- XEN_ASSERT_TYPE(XEN_Font_P(arg3), arg3, 3, "XSetFont", "Font");
- return(C_TO_XEN_INT(XSetFont(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_Font(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetFont", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetFont", "GC");
+ Xen_check_type(Xen_is_Font(arg3), arg3, 3, "XSetFont", "Font");
+ return(C_int_to_Xen_integer(XSetFont(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_to_C_Font(arg3))));
}
-static XEN gxm_XSetFillStyle(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetFillStyle(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetFillStyle "XSetFillStyle(display, gc, fill_style) sets the fill-style in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetFillStyle", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetFillStyle", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetFillStyle", "int");
- return(C_TO_XEN_INT(XSetFillStyle(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetFillStyle", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetFillStyle", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetFillStyle", "int");
+ return(C_int_to_Xen_integer(XSetFillStyle(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XSetFillRule(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetFillRule(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetFillRule "XSetFillRule(display, gc, fill_rule) sets the fill-rule in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetFillRule", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetFillRule", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetFillRule", "int");
- return(C_TO_XEN_INT(XSetFillRule(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetFillRule", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetFillRule", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetFillRule", "int");
+ return(C_int_to_Xen_integer(XSetFillRule(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XSetDashes(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XSetDashes(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XSetDashes "XSetDashes(display, gc, dash_offset, dash_list, n) sets the dash-offset and dash-list attributes for dashed line styles \
in the specified GC."
char *dashes;
int i, len = 0, val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetDashes", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetDashes", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetDashes", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XSetDashes", "list of ints");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg5), arg5, 5, "XSetDashes", "optional length of list (int)");
- if (XEN_INTEGER_P(arg5)) len = XEN_TO_C_INT(arg5);
- if (len <= 0) len = XEN_LIST_LENGTH(arg4);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetDashes", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetDashes", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetDashes", "int");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XSetDashes", "list of ints");
+ Xen_check_type(Xen_is_integer_or_unbound(arg5), arg5, 5, "XSetDashes", "optional length of list (int)");
+ if (Xen_is_integer(arg5)) len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) len = Xen_list_length(arg4);
dashes = (char *)calloc(len, sizeof(char));
- for (i = 0; i < len; i++) dashes[i] = (char)(XEN_TO_C_INT(XEN_LIST_REF(arg4, i)));
- val = XSetDashes(XEN_TO_C_Display(arg1),
- XEN_TO_C_GC(arg2),
- XEN_TO_C_INT(arg3),
+ for (i = 0; i < len; i++) dashes[i] = (char)(Xen_integer_to_C_int(Xen_list_ref(arg4, i)));
+ val = XSetDashes(Xen_to_C_Display(arg1),
+ Xen_to_C_GC(arg2),
+ Xen_integer_to_C_int(arg3),
dashes, len);
free(dashes);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XSetCommand(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XSetCommand(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XSetCommand "XSetCommand(display, w, argv, argc) sets the command and arguments used to invoke the application."
/* DIFF: XSetCommand argv is list of strings
*/
int len, val;
char **str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetCommand", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetCommand", "Window");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XSetCommand", "list of char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetCommand", "int");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) return(XEN_FALSE);
- str = XEN_TO_C_Strings(arg3, len);
- val = XSetCommand(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), str, len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetCommand", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetCommand", "Window");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XSetCommand", "list of char*");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetCommand", "int");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) return(Xen_false);
+ str = Xen_to_C_Strings(arg3, len);
+ val = XSetCommand(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), str, len);
free(str);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XSetCloseDownMode(XEN arg1, XEN arg2)
+static Xen gxm_XSetCloseDownMode(Xen arg1, Xen arg2)
{
#define H_XSetCloseDownMode "XSetCloseDownMode(display, close_mode) defines what will happen to the client's resources at connection close."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetCloseDownMode", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XSetCloseDownMode", "int");
- return(C_TO_XEN_INT(XSetCloseDownMode(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetCloseDownMode", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XSetCloseDownMode", "int");
+ return(C_int_to_Xen_integer(XSetCloseDownMode(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XSetClipRectangles(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN larg5, XEN arg6, XEN arg7)
+static Xen gxm_XSetClipRectangles(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen larg5, Xen arg6, Xen arg7)
{
#define H_XSetClipRectangles "XSetClipRectangles(display, gc, clip_x_origin, clip_y_origin, rectangles, n, ordering) changes the clip-mask in \
the specified GC to the specified list of rectangles and sets the clip origin."
@@ -9059,115 +8779,115 @@ the specified GC to the specified list of rectangles and sets the clip origin."
*/
XRectangle *pt;
int i, len;
- XEN arg5;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetClipRectangles", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetClipRectangles", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetClipRectangles", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetClipRectangles", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg5), larg5, 5, "XSetClipRectangles", "list of XRectangles");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XSetClipRectangles", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XSetClipRectangles", "int");
- arg5 = XEN_COPY_ARG(larg5);
- len = XEN_TO_C_INT(arg6);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg6, 6, "XSetClipRectangles", "positive integer");
+ Xen arg5;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetClipRectangles", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetClipRectangles", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetClipRectangles", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetClipRectangles", "int");
+ Xen_check_type(Xen_is_list(larg5), larg5, 5, "XSetClipRectangles", "list of XRectangles");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XSetClipRectangles", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XSetClipRectangles", "int");
+ arg5 = Xen_copy_arg(larg5);
+ len = Xen_integer_to_C_int(arg6);
+ if (len <= 0) Xen_check_type(0, arg6, 6, "XSetClipRectangles", "positive integer");
pt = (XRectangle *)calloc(len, sizeof(XRectangle));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg5)); i++, arg5 = XEN_CDR(arg5))
+ for (i = 0; (i < len) && (!Xen_is_null(arg5)); i++, arg5 = Xen_cdr(arg5))
{
XRectangle *pt1;
- pt1 = XEN_TO_C_XRectangle(XEN_CAR(arg5));
+ pt1 = Xen_to_C_XRectangle(Xen_car(arg5));
pt[i].x = pt1->x;
pt[i].y = pt1->y;
pt[i].width = pt1->width;
pt[i].height = pt1->height;
}
- XSetClipRectangles(XEN_TO_C_Display(arg1),
- XEN_TO_C_GC(arg2),
- XEN_TO_C_INT(arg3),
- XEN_TO_C_INT(arg4),
+ XSetClipRectangles(Xen_to_C_Display(arg1),
+ Xen_to_C_GC(arg2),
+ Xen_integer_to_C_int(arg3),
+ Xen_integer_to_C_int(arg4),
pt, len,
- XEN_TO_C_INT(arg7));
+ Xen_integer_to_C_int(arg7));
free(pt);
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XSetClipOrigin(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XSetClipOrigin(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XSetClipOrigin "XSetClipOrigin(display, gc, clip_x_origin, clip_y_origin) sets the clip origin in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetClipOrigin", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetClipOrigin", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetClipOrigin", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetClipOrigin", "int");
- return(C_TO_XEN_INT(XSetClipOrigin(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetClipOrigin", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetClipOrigin", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetClipOrigin", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetClipOrigin", "int");
+ return(C_int_to_Xen_integer(XSetClipOrigin(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4))));
}
-static XEN gxm_XSetClipMask(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetClipMask(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetClipMask "XSetClipMask(display, gc, pixmap) sets the clip-mask in the specified GC to the specified pixmap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetClipMask", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetClipMask", "GC");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3) || XEN_INTEGER_P(arg3), arg3, 3, "XSetClipMask", "Pixmap or None");
- return(C_TO_XEN_INT(XSetClipMask(XEN_TO_C_Display(arg1),
- XEN_TO_C_GC(arg2),
- (XEN_Pixmap_P(arg3)) ? XEN_TO_C_Pixmap(arg3) : None)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetClipMask", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetClipMask", "GC");
+ Xen_check_type(Xen_is_Pixmap(arg3) || Xen_is_integer(arg3), arg3, 3, "XSetClipMask", "Pixmap or None");
+ return(C_int_to_Xen_integer(XSetClipMask(Xen_to_C_Display(arg1),
+ Xen_to_C_GC(arg2),
+ (Xen_is_Pixmap(arg3)) ? Xen_to_C_Pixmap(arg3) : None)));
}
-static XEN gxm_XSetBackground(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetBackground(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetBackground "XSetBackground(display, gc, background) sets the background in the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetBackground", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetBackground", "GC");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg3), arg3, 3, "XSetBackground", "Pixel");
- return(C_TO_XEN_INT(XSetBackground(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_Pixel(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetBackground", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetBackground", "GC");
+ Xen_check_type(Xen_is_Pixel(arg3), arg3, 3, "XSetBackground", "Pixel");
+ return(C_int_to_Xen_integer(XSetBackground(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_to_C_Pixel(arg3))));
}
-static XEN gxm_XSetArcMode(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetArcMode(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetArcMode "XSetArcMode(display, gc, arc_mode)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetArcMode", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XSetArcMode", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSetArcMode", "int");
- return(C_TO_XEN_INT(XSetArcMode(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetArcMode", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XSetArcMode", "GC");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSetArcMode", "int");
+ return(C_int_to_Xen_integer(XSetArcMode(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XSetAccessControl(XEN arg1, XEN arg2)
+static Xen gxm_XSetAccessControl(Xen arg1, Xen arg2)
{
#define H_XSetAccessControl "XSetAccessControl(display, mode) either enables or disables the use of the access control list at each connection setup."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetAccessControl", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XSetAccessControl", "int");
- return(C_TO_XEN_INT(XSetAccessControl(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetAccessControl", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XSetAccessControl", "int");
+ return(C_int_to_Xen_integer(XSetAccessControl(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XSendEvent(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XSendEvent(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XSendEvent "Status XSendEvent(display, w, propagate, event_mask, event_send) identifies the destination window, determines which \
clients should receive the specified events, "
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSendEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSendEvent", "Window");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XSendEvent", "Bool");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSendEvent", "long");
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg5), arg5, 5, "XSendEvent", "XEvent*");
- return(C_TO_XEN_INT(XSendEvent(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_BOOLEAN(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_XEvent(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSendEvent", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSendEvent", "Window");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XSendEvent", "Bool");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSendEvent", "long");
+ Xen_check_type(Xen_is_XEvent(arg5), arg5, 5, "XSendEvent", "XEvent*");
+ return(C_int_to_Xen_integer(XSendEvent(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_boolean_to_C_bool(arg3), Xen_integer_to_C_int(arg4), Xen_to_C_XEvent(arg5))));
}
-static XEN gxm_XSelectInput(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSelectInput(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSelectInput "XSelectInput(dpy, window, event_mask) selects input events"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSelectInput", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSelectInput", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSelectInput", "long");
- return(C_TO_XEN_INT(XSelectInput(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSelectInput", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSelectInput", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSelectInput", "long");
+ return(C_int_to_Xen_integer(XSelectInput(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XScreenCount(XEN arg1)
+static Xen gxm_XScreenCount(Xen arg1)
{
#define H_ScreenCount "returns the number of available screens."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XScreenCount", "Display*");
- return(C_TO_XEN_INT(XScreenCount(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XScreenCount", "Display*");
+ return(C_int_to_Xen_integer(XScreenCount(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XRotateWindowProperties(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XRotateWindowProperties(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XRotateWindowProperties "XRotateWindowProperties(display, w, properties, num_prop, npositions) allows you to rotate properties on a \
window and causes the X server to generate PropertyNotify events."
@@ -9175,148 +8895,148 @@ window and causes the X server to generate PropertyNotify events."
*/
Atom *outs;
int val, len;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XRotateWindowProperties", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XRotateWindowProperties", "Window");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XRotateWindowProperties", "list of Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XRotateWindowProperties", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XRotateWindowProperties", "int");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) return(XEN_FALSE);
- outs = XEN_TO_C_Atoms(arg3, len);
- val = XRotateWindowProperties(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), outs, len, XEN_TO_C_INT(arg5));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XRotateWindowProperties", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XRotateWindowProperties", "Window");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XRotateWindowProperties", "list of Atom");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XRotateWindowProperties", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XRotateWindowProperties", "int");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) return(Xen_false);
+ outs = Xen_to_C_Atoms(arg3, len);
+ val = XRotateWindowProperties(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), outs, len, Xen_integer_to_C_int(arg5));
free(outs);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XRotateBuffers(XEN arg1, XEN arg2)
+static Xen gxm_XRotateBuffers(Xen arg1, Xen arg2)
{
#define H_XRotateBuffers "XRotateBuffers(display, rotate) rotates the cut buffers, such that buffer 0 becomes buffer n, buffer 1 becomes n + 1 \
mod 8, and so on. "
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XRotateBuffers", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XRotateBuffers", "int");
- return(C_TO_XEN_INT(XRotateBuffers(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XRotateBuffers", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XRotateBuffers", "int");
+ return(C_int_to_Xen_integer(XRotateBuffers(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XRestackWindows(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XRestackWindows(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XRestackWindows "XRestackWindows(display, windows, nwindows) restacks the windows in the order specified, from top to bottom."
/* DIFF: XRestackWindows arg2 is list of Windows
*/
int len, rtn;
Window *ws;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XRestackWindows", "Display*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XRestackWindows", "list of Windows");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XRestackWindows", "int");
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) return(XEN_FALSE);
- ws = XEN_TO_C_Windows(arg2, len);
- rtn = XRestackWindows(XEN_TO_C_Display(arg1), ws, len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XRestackWindows", "Display*");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XRestackWindows", "list of Windows");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XRestackWindows", "int");
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) return(Xen_false);
+ ws = Xen_to_C_Windows(arg2, len);
+ rtn = XRestackWindows(Xen_to_C_Display(arg1), ws, len);
free(ws);
- return(C_TO_XEN_INT(rtn));
+ return(C_int_to_Xen_integer(rtn));
}
-static XEN gxm_XResizeWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XResizeWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XResizeWindow "XResizeWindow(display, w, width, height) changes the inside dimensions of the specified window, not including its borders."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XResizeWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XResizeWindow", "Window");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XResizeWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XResizeWindow", "unsigned int");
- return(C_TO_XEN_INT(XResizeWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_ULONG(arg3), XEN_TO_C_ULONG(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XResizeWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XResizeWindow", "Window");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XResizeWindow", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XResizeWindow", "unsigned int");
+ return(C_int_to_Xen_integer(XResizeWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_ulong_to_C_ulong(arg3), Xen_ulong_to_C_ulong(arg4))));
}
-static XEN gxm_XResetScreenSaver(XEN arg1)
+static Xen gxm_XResetScreenSaver(Xen arg1)
{
#define H_XResetScreenSaver "XResetScreenSaver(display) resets the screen saver."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XResetScreenSaver", "Display*");
- return(C_TO_XEN_INT(XResetScreenSaver(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XResetScreenSaver", "Display*");
+ return(C_int_to_Xen_integer(XResetScreenSaver(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XReparentWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XReparentWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XReparentWindow "XReparentWindow(display, w, parent, x, y)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XReparentWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XReparentWindow", "Window");
- XEN_ASSERT_TYPE(XEN_Window_P(arg3), arg3, 3, "XReparentWindow", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XReparentWindow", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XReparentWindow", "int");
- return(C_TO_XEN_INT(XReparentWindow(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_Window(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XReparentWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XReparentWindow", "Window");
+ Xen_check_type(Xen_is_Window(arg3), arg3, 3, "XReparentWindow", "Window");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XReparentWindow", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XReparentWindow", "int");
+ return(C_int_to_Xen_integer(XReparentWindow(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_Window(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5))));
}
-static XEN gxm_XRefreshKeyboardMapping(XEN arg1)
+static Xen gxm_XRefreshKeyboardMapping(Xen arg1)
{
#define H_XRefreshKeyboardMapping "XRefreshKeyboardMapping(event_map) refreshes the stored modifier and keymap information."
- XEN_ASSERT_TYPE(XEN_XMappingEvent_P(arg1), arg1, 1, "XRefreshKeyboardMapping", "XMappingEvent*");
- return(C_TO_XEN_INT(XRefreshKeyboardMapping(XEN_TO_C_XMappingEvent(arg1))));
+ Xen_check_type(Xen_is_XMappingEvent(arg1), arg1, 1, "XRefreshKeyboardMapping", "XMappingEvent*");
+ return(C_int_to_Xen_integer(XRefreshKeyboardMapping(Xen_to_C_XMappingEvent(arg1))));
}
-static XEN gxm_XRecolorCursor(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XRecolorCursor(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XRecolorCursor "XRecolorCursor(display, cursor, foreground_color, background_color) changes the color of the specified cursor, and if \
the cursor is being displayed on a screen, the change is visible immediately."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XRecolorCursor", "Display*");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg2), arg2, 2, "XRecolorCursor", "Cursor");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg3), arg3, 3, "XRecolorCursor", "XColor");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg4), arg4, 4, "XRecolorCursor", "XColor");
- return(C_TO_XEN_INT(XRecolorCursor(XEN_TO_C_Display(arg1), XEN_TO_C_Cursor(arg2),
- XEN_TO_C_XColor(arg3), XEN_TO_C_XColor(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XRecolorCursor", "Display*");
+ Xen_check_type(Xen_is_Cursor(arg2), arg2, 2, "XRecolorCursor", "Cursor");
+ Xen_check_type(Xen_is_XColor(arg3), arg3, 3, "XRecolorCursor", "XColor");
+ Xen_check_type(Xen_is_XColor(arg4), arg4, 4, "XRecolorCursor", "XColor");
+ return(C_int_to_Xen_integer(XRecolorCursor(Xen_to_C_Display(arg1), Xen_to_C_Cursor(arg2),
+ Xen_to_C_XColor(arg3), Xen_to_C_XColor(arg4))));
}
-static XEN gxm_XRebindKeysym(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XRebindKeysym(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XRebindKeysym "XRebindKeysym(display, keysym, list, mod_count, string, num_bytes) can be used to rebind the meaning of a KeySym for the client."
/* DIFF: XRebindKeysym mod_list is list of keysyms
*/
KeySym *ks;
int len, val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XRebindKeysym", "Display*");
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg2), arg2, 2, "XRebindKeysym", "KeySym");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XRebindKeysym", "list of KeySym");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XRebindKeysym", "int");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg5), arg5, 5, "XRebindKeysym", "string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XRebindKeysym", "int");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) return(XEN_FALSE);
- ks = XEN_TO_C_KeySyms(arg3, len);
- val = XRebindKeysym(XEN_TO_C_Display(arg1),
- XEN_TO_C_KeySym(arg2),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XRebindKeysym", "Display*");
+ Xen_check_type(Xen_is_KeySym(arg2), arg2, 2, "XRebindKeysym", "KeySym");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XRebindKeysym", "list of KeySym");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XRebindKeysym", "int");
+ Xen_check_type(Xen_is_string(arg5), arg5, 5, "XRebindKeysym", "string");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XRebindKeysym", "int");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) return(Xen_false);
+ ks = Xen_to_C_KeySyms(arg3, len);
+ val = XRebindKeysym(Xen_to_C_Display(arg1),
+ Xen_to_C_KeySym(arg2),
ks, len,
- (unsigned char *)XEN_TO_C_STRING(arg5), XEN_TO_C_INT(arg6));
+ (unsigned char *)Xen_string_to_C_string(arg5), Xen_integer_to_C_int(arg6));
free(ks);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XReadBitmapFileData(XEN arg1)
+static Xen gxm_XReadBitmapFileData(Xen arg1)
{
#define H_XReadBitmapFileData "int XReadBitmapFileData(filename) reads in a \
file containing a bitmap, in the same manner as XReadBitmapFile, but returns the data directly rather than creating a pixmap in the server."
/* DIFF: XReadBitmapFileData omits last 5 args, returns as list
*/
- unsigned int w, h, i, j;
+ unsigned int w = 0, h = 0, i, j;
int x, y;
unsigned char **str = NULL; /* allocated by X? */
int val, loc;
- XEN bits = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XReadBitmapFileData", "char*");
- val = XReadBitmapFileData((char *)XEN_TO_C_STRING(arg1), &w, &h, str, &x, &y);
+ Xen bits = Xen_empty_list;
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XReadBitmapFileData", "char*");
+ val = XReadBitmapFileData((char *)Xen_string_to_C_string(arg1), &w, &h, str, &x, &y);
loc = xm_protect(bits);
for (i = 0; i < h; i++)
for (j = 0; j < w; j++)
- bits = XEN_CONS(C_TO_XEN_INT((int)(str[i][j])), bits);
+ bits = Xen_cons(C_int_to_Xen_integer((int)(str[i][j])), bits);
if (str) free(str);
xm_unprotect_at(loc);
- return(XEN_LIST_6(C_TO_XEN_INT(val),
- C_TO_XEN_INT((int)w),
- C_TO_XEN_INT((int)h),
+ return(Xen_list_6(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer((int)w),
+ C_int_to_Xen_integer((int)h),
bits,
- C_TO_XEN_INT((int)x),
- C_TO_XEN_INT((int)y)));
+ C_int_to_Xen_integer((int)x),
+ C_int_to_Xen_integer((int)y)));
}
-static XEN gxm_XReadBitmapFile(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XReadBitmapFile(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XReadBitmapFile "int XReadBitmapFile(display, d, filename) reads in a file containing a bitmap."
/* DIFF: XReadBitmapFile omits last 5 args, returns as list
@@ -9325,27 +9045,27 @@ static XEN gxm_XReadBitmapFile(XEN arg1, XEN arg2, XEN arg3)
int x, y;
int val;
Pixmap *p = NULL; /* allocated by X? */
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XReadBitmapFile", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XReadBitmapFile", "Drawable");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XReadBitmapFile", "char*");
- val = XReadBitmapFile(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), (char *)XEN_TO_C_STRING(arg3), &w, &h, p, &x, &y);
- return(XEN_LIST_6(C_TO_XEN_INT(val),
- C_TO_XEN_INT((int)w),
- C_TO_XEN_INT((int)h),
- C_TO_XEN_Pixmap(*p),
- C_TO_XEN_INT((int)x),
- C_TO_XEN_INT((int)y)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XReadBitmapFile", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XReadBitmapFile", "Drawable");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XReadBitmapFile", "char*");
+ val = XReadBitmapFile(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), (char *)Xen_string_to_C_string(arg3), &w, &h, p, &x, &y);
+ return(Xen_list_6(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer((int)w),
+ C_int_to_Xen_integer((int)h),
+ C_to_Xen_Pixmap(*p),
+ C_int_to_Xen_integer((int)x),
+ C_int_to_Xen_integer((int)y)));
}
-static XEN gxm_XRaiseWindow(XEN arg1, XEN arg2)
+static Xen gxm_XRaiseWindow(Xen arg1, Xen arg2)
{
#define H_XRaiseWindow "XRaiseWindow(display, w)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XRaiseWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XRaiseWindow", "Window");
- return(C_TO_XEN_INT(XRaiseWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XRaiseWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XRaiseWindow", "Window");
+ return(C_int_to_Xen_integer(XRaiseWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XQueryTree(XEN arg1, XEN arg2)
+static Xen gxm_XQueryTree(Xen arg1, Xen arg2)
{
#define H_XQueryTree "Status XQueryTree(display, w): returns the root ID, the \
parent window ID, a pointer to the list of children windows and the number of children in the list for the specified window."
@@ -9355,24 +9075,24 @@ parent window ID, a pointer to the list of children windows and the number of ch
Window *ws;
Window root, parent;
int i, val, loc;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryTree", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XQueryTree", "Window");
- val = XQueryTree(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryTree", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XQueryTree", "Window");
+ val = XQueryTree(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
&root, &parent, &ws, &arrlen);
loc = xm_protect(lst);
for (i = arrlen - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Window(ws[i]), lst);
+ lst = Xen_cons(C_to_Xen_Window(ws[i]), lst);
XFree(ws);
xm_unprotect_at(loc);
- return(XEN_LIST_4(C_TO_XEN_INT(val),
- C_TO_XEN_Window(root),
- C_TO_XEN_Window(parent),
+ return(Xen_list_4(C_int_to_Xen_integer(val),
+ C_to_Xen_Window(root),
+ C_to_Xen_Window(parent),
lst));
}
-static XEN gxm_XQueryTextExtents(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XQueryTextExtents(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XQueryTextExtents "XQueryTextExtents(display, font, string): returns the bounding box of the specified 8-bit string."
/* DIFF: XQueryTextExtents omits last 5 args, returns list
@@ -9380,22 +9100,22 @@ static XEN gxm_XQueryTextExtents(XEN arg1, XEN arg2, XEN arg3)
XCharStruct *c;
int fa, fd, dr, val;
char *str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryTextExtents", "Display*");
- XEN_ASSERT_TYPE(XEN_Font_P(arg2), arg2, 2, "XQueryTextExtents", "Font");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XQueryTextExtents", "char*");
- str = (char *)XEN_TO_C_STRING(arg3);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryTextExtents", "Display*");
+ Xen_check_type(Xen_is_Font(arg2), arg2, 2, "XQueryTextExtents", "Font");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XQueryTextExtents", "char*");
+ str = (char *)Xen_string_to_C_string(arg3);
c = (XCharStruct *)calloc(1, sizeof(XCharStruct));
- val = XQueryTextExtents(XEN_TO_C_Display(arg1),
- XEN_TO_C_Font(arg2),
+ val = XQueryTextExtents(Xen_to_C_Display(arg1),
+ Xen_to_C_Font(arg2),
str, strlen(str), &dr, &fa, &fd, c);
- return(XEN_LIST_5(C_TO_XEN_INT(val),
- C_TO_XEN_INT(dr),
- C_TO_XEN_INT(fa),
- C_TO_XEN_INT(fd),
- WRAP_FOR_XEN_OBJ("XCharStruct", c)));
+ return(Xen_list_5(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(dr),
+ C_int_to_Xen_integer(fa),
+ C_int_to_Xen_integer(fd),
+ wrap_for_Xen_obj("XCharStruct", c)));
}
-static XEN gxm_XQueryPointer(XEN arg1, XEN arg2)
+static Xen gxm_XQueryPointer(Xen arg1, Xen arg2)
{
#define H_XQueryPointer "Bool XQueryPointer(display, w): returns the root window the pointer is logically on and the pointer \
coordinates relative to the root window's origin."
@@ -9405,22 +9125,22 @@ coordinates relative to the root window's origin."
int rx, ry, wx, wy;
unsigned int mask;
int rtn;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryPointer", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XQueryPointer", "Window");
- rtn = XQueryPointer(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryPointer", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XQueryPointer", "Window");
+ rtn = XQueryPointer(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
&w1, &w2, &rx, &ry, &wx, &wy, &mask);
- return(XEN_LIST_8(C_TO_XEN_BOOLEAN(rtn),
- C_TO_XEN_Window(w1),
- C_TO_XEN_Window(w2),
- C_TO_XEN_INT(rx),
- C_TO_XEN_INT(ry),
- C_TO_XEN_INT(wx),
- C_TO_XEN_INT(wy),
- C_TO_XEN_ULONG((unsigned long)mask)));
+ return(Xen_list_8(C_bool_to_Xen_boolean(rtn),
+ C_to_Xen_Window(w1),
+ C_to_Xen_Window(w2),
+ C_int_to_Xen_integer(rx),
+ C_int_to_Xen_integer(ry),
+ C_int_to_Xen_integer(wx),
+ C_int_to_Xen_integer(wy),
+ C_ulong_to_Xen_ulong((unsigned long)mask)));
}
-static XEN gxm_XQueryKeymap(XEN arg1)
+static Xen gxm_XQueryKeymap(Xen arg1)
{
#define H_XQueryKeymap "XQueryKeymap(display): returns a bit vector for the logical state of the keyboard, where each bit \
set to 1 indicates that the corresponding key is currently pressed down."
@@ -9428,78 +9148,78 @@ set to 1 indicates that the corresponding key is currently pressed down."
*/
char keys[32];
int val, i, loc;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryKeymap", "Display*");
- val = XQueryKeymap(XEN_TO_C_Display(arg1), keys);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryKeymap", "Display*");
+ val = XQueryKeymap(Xen_to_C_Display(arg1), keys);
loc = xm_protect(lst);
for (i = 31; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_INT((int)keys[i]), lst);
+ lst = Xen_cons(C_int_to_Xen_integer((int)keys[i]), lst);
xm_unprotect_at(loc);
- return(XEN_CONS(C_TO_XEN_INT(val), lst));
+ return(Xen_cons(C_int_to_Xen_integer(val), lst));
}
-static XEN gxm_XQueryExtension(XEN arg1, XEN arg2)
+static Xen gxm_XQueryExtension(Xen arg1, Xen arg2)
{
#define H_XQueryExtension "Bool XQueryExtension(dpy, name) gets extension version information"
/* DIFF: XQueryExtension dpy name [op er er] -> (list val op er er)
*/
int op, err1, err2, val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryExtension", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XQueryExtension", "char*");
- val = XQueryExtension(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2), &op, &err1, &err2);
- return(XEN_LIST_4(C_TO_XEN_BOOLEAN(val),
- C_TO_XEN_INT(op),
- C_TO_XEN_INT(err1),
- C_TO_XEN_INT(err2)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryExtension", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XQueryExtension", "char*");
+ val = XQueryExtension(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2), &op, &err1, &err2);
+ return(Xen_list_4(C_bool_to_Xen_boolean(val),
+ C_int_to_Xen_integer(op),
+ C_int_to_Xen_integer(err1),
+ C_int_to_Xen_integer(err2)));
}
-static XEN gxm_XQueryColors(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XQueryColors(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XQueryColors "XQueryColors(display, colormap, defs_in_out, ncolors)"
int i, len, rtn;
- XEN lst;
+ Xen lst;
XColor *cols;
XColor *col;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryColors", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XQueryColors", "Colormap");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XQueryColors", "XColor list");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg4), arg4, 4, "XQueryColors", "int");
- if (XEN_INTEGER_P(arg4)) len = XEN_TO_C_INT(arg4); else len = XEN_LIST_LENGTH(arg3);
- lst = XEN_COPY_ARG(arg3);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryColors", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XQueryColors", "Colormap");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XQueryColors", "XColor list");
+ Xen_check_type(Xen_is_integer_or_unbound(arg4), arg4, 4, "XQueryColors", "int");
+ if (Xen_is_integer(arg4)) len = Xen_integer_to_C_int(arg4); else len = Xen_list_length(arg3);
+ lst = Xen_copy_arg(arg3);
cols = (XColor *)calloc(len, sizeof(XColor));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(lst)); i++, lst = XEN_CDR(lst))
+ for (i = 0; (i < len) && (!Xen_is_null(lst)); i++, lst = Xen_cdr(lst))
{
- if (XEN_XColor_P(XEN_CAR(lst)))
+ if (Xen_is_XColor(Xen_car(lst)))
{
- col = XEN_TO_C_XColor(XEN_CAR(lst));
+ col = Xen_to_C_XColor(Xen_car(lst));
cols[i].pixel = col->pixel;
}
- else XEN_ASSERT_TYPE(0, XEN_CAR(lst), i, c__FUNCTION__, "an XColor");
+ else Xen_check_type(0, Xen_car(lst), i, __func__, "an XColor");
}
- rtn = XQueryColors(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2), cols, len);
+ rtn = XQueryColors(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2), cols, len);
for (i = 0; i < len; i++)
{
- col = XEN_TO_C_XColor(XEN_LIST_REF(arg3, i));
+ col = Xen_to_C_XColor(Xen_list_ref(arg3, i));
col->red = cols[i].red;
col->green = cols[i].green;
col->blue = cols[i].blue;
col->flags = cols[i].flags;
}
free(cols);
- return(C_TO_XEN_INT(rtn));
+ return(C_int_to_Xen_integer(rtn));
}
-static XEN gxm_XQueryColor(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XQueryColor(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XQueryColor "XQueryColor(display, colormap, def_in_out): returns the current RGB value for the pixel in the XColor structure \
and sets the DoRed, DoGreen, DoBlue flags."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryColor", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XQueryColor", "Colormap");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg3), arg3, 3, "XQueryColor", "XColor*");
- return(C_TO_XEN_INT(XQueryColor(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2), XEN_TO_C_XColor(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryColor", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XQueryColor", "Colormap");
+ Xen_check_type(Xen_is_XColor(arg3), arg3, 3, "XQueryColor", "XColor*");
+ return(C_int_to_Xen_integer(XQueryColor(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2), Xen_to_C_XColor(arg3))));
}
-static XEN gxm_XQueryBestTile(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XQueryBestTile(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XQueryBestTile "Status XQueryBestTile(display, which_screen, width, height) returns the best or \
closest size, that is, the size that can be tiled fastest on the screen specified by which_screen."
@@ -9507,18 +9227,18 @@ closest size, that is, the size that can be tiled fastest on the screen specifie
*/
unsigned int w, h;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryBestTile", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XQueryBestTile", "Drawable");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XQueryBestTile", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XQueryBestTile", "unsigned int");
- val = XQueryBestTile(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_ULONG(arg3), XEN_TO_C_ULONG(arg4), &w, &h);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_ULONG(w),
- C_TO_XEN_ULONG(h)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryBestTile", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XQueryBestTile", "Drawable");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XQueryBestTile", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XQueryBestTile", "unsigned int");
+ val = XQueryBestTile(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_ulong_to_C_ulong(arg3), Xen_ulong_to_C_ulong(arg4), &w, &h);
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_ulong_to_Xen_ulong(w),
+ C_ulong_to_Xen_ulong(h)));
}
-static XEN gxm_XQueryBestStipple(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XQueryBestStipple(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XQueryBestStipple "Status XQueryBestStipple(display, which_screen, width, height) returns the \
best or closest size, that is, the size that can be stippled fastest on the screen specified by which_screen."
@@ -9526,19 +9246,19 @@ best or closest size, that is, the size that can be stippled fastest on the scre
*/
unsigned int w, h;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryBestStipple", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XQueryBestStipple", "Drawable");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XQueryBestStipple", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XQueryBestStipple", "unsigned int");
- val = XQueryBestStipple(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_ULONG(arg3), XEN_TO_C_ULONG(arg4),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryBestStipple", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XQueryBestStipple", "Drawable");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XQueryBestStipple", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XQueryBestStipple", "unsigned int");
+ val = XQueryBestStipple(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_ulong_to_C_ulong(arg3), Xen_ulong_to_C_ulong(arg4),
&w, &h);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_ULONG(w),
- C_TO_XEN_ULONG(h)));
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_ulong_to_Xen_ulong(w),
+ C_ulong_to_Xen_ulong(h)));
}
-static XEN gxm_XQueryBestSize(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XQueryBestSize(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XQueryBestSize "Status XQueryBestSize(display, class, which_screen, width, height) returns the \
best or closest size to the specified size."
@@ -9546,20 +9266,20 @@ best or closest size to the specified size."
*/
unsigned int w, h;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryBestSize", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XQueryBestSize", "int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg3), arg3, 3, "XQueryBestSize", "Drawable");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XQueryBestSize", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XQueryBestSize", "unsigned int");
- val = XQueryBestSize(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_Window(arg3),
- XEN_TO_C_ULONG(arg4), XEN_TO_C_ULONG(arg5),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryBestSize", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XQueryBestSize", "int");
+ Xen_check_type(Xen_is_Window(arg3), arg3, 3, "XQueryBestSize", "Drawable");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XQueryBestSize", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XQueryBestSize", "unsigned int");
+ val = XQueryBestSize(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), Xen_to_C_Window(arg3),
+ Xen_ulong_to_C_ulong(arg4), Xen_ulong_to_C_ulong(arg5),
&w, &h);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_ULONG(w),
- C_TO_XEN_ULONG(h)));
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_ulong_to_Xen_ulong(w),
+ C_ulong_to_Xen_ulong(h)));
}
-static XEN gxm_XQueryBestCursor(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XQueryBestCursor(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XQueryBestCursor "Status XQueryBestCursor(display, d, width, height) provides a way to find \
out what size cursors are actually possible on the display."
@@ -9567,130 +9287,130 @@ out what size cursors are actually possible on the display."
*/
unsigned int w, h;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryBestCursor", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XQueryBestCursor", "Drawable");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XQueryBestCursor", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XQueryBestCursor", "unsigned int");
- val = XQueryBestCursor(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_ULONG(arg3), XEN_TO_C_ULONG(arg4),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryBestCursor", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XQueryBestCursor", "Drawable");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XQueryBestCursor", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XQueryBestCursor", "unsigned int");
+ val = XQueryBestCursor(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_ulong_to_C_ulong(arg3), Xen_ulong_to_C_ulong(arg4),
&w, &h);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_ULONG(w),
- C_TO_XEN_ULONG(h)));
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_ulong_to_Xen_ulong(w),
+ C_ulong_to_Xen_ulong(h)));
}
-static XEN gxm_XQLength(XEN arg1)
+static Xen gxm_XQLength(Xen arg1)
{
#define H_QLength "returns the length of the event queue for the connected display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQLength", "Display*");
- return(C_TO_XEN_INT(XQLength(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQLength", "Display*");
+ return(C_int_to_Xen_integer(XQLength(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XPutImage(XEN args)
+static Xen gxm_XPutImage(Xen args)
{
#define H_XPutImage "XPutImage(display, d, gc, image, src_x, src_y, dest_x, dest_y, width, height) combines an image with a rectangle \
of the specified drawable."
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XPutImage", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XPutImage", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XPutImage", "GC");
- XEN_ASSERT_TYPE(XEN_XImage_P(arg4), arg4, 4, "XPutImage", "XImage*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XPutImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XPutImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XPutImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XPutImage", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg9), arg9, 9, "XPutImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg10), arg10, 10, "XPutImage", "unsigned int");
- return(C_TO_XEN_INT(XPutImage(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3), XEN_TO_C_XImage(arg4), XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6),
- XEN_TO_C_INT(arg7), XEN_TO_C_INT(arg8), XEN_TO_C_ULONG(arg9), XEN_TO_C_ULONG(arg10))));
-}
-
-static XEN gxm_XPutBackEvent(XEN arg1, XEN arg2)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XPutImage", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XPutImage", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XPutImage", "GC");
+ Xen_check_type(Xen_is_XImage(arg4), arg4, 4, "XPutImage", "XImage*");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XPutImage", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XPutImage", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XPutImage", "int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XPutImage", "int");
+ Xen_check_type(Xen_is_ulong(arg9), arg9, 9, "XPutImage", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg10), arg10, 10, "XPutImage", "unsigned int");
+ return(C_int_to_Xen_integer(XPutImage(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3), Xen_to_C_XImage(arg4), Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6),
+ Xen_integer_to_C_int(arg7), Xen_integer_to_C_int(arg8), Xen_ulong_to_C_ulong(arg9), Xen_ulong_to_C_ulong(arg10))));
+}
+
+static Xen gxm_XPutBackEvent(Xen arg1, Xen arg2)
{
#define H_XPutBackEvent "XPutBackEvent(display, event) pushes an event back onto the head of the display's event queue by copying the event into the queue."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XPutBackEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg2), arg2, 2, "XPutBackEvent", "XEvent*");
- return(C_TO_XEN_INT(XPutBackEvent(XEN_TO_C_Display(arg1), XEN_TO_C_XEvent(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XPutBackEvent", "Display*");
+ Xen_check_type(Xen_is_XEvent(arg2), arg2, 2, "XPutBackEvent", "XEvent*");
+ return(C_int_to_Xen_integer(XPutBackEvent(Xen_to_C_Display(arg1), Xen_to_C_XEvent(arg2))));
}
-static XEN gxm_XProtocolVersion(XEN arg1)
+static Xen gxm_XProtocolVersion(Xen arg1)
{
#define H_ProtocolVersion "ProtocolVersion(display): returns the major version number (11) of the X protocol associated with the connected display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XProtocolVersion", "Display*");
- return(C_TO_XEN_INT(XProtocolVersion(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XProtocolVersion", "Display*");
+ return(C_int_to_Xen_integer(XProtocolVersion(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XProtocolRevision(XEN arg1)
+static Xen gxm_XProtocolRevision(Xen arg1)
{
#define H_ProtocolRevision "ProtocolRevision(display): returns the minor protocol revision number of the X server."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XProtocolRevision", "Display*");
- return(C_TO_XEN_INT(XProtocolRevision(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XProtocolRevision", "Display*");
+ return(C_int_to_Xen_integer(XProtocolRevision(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XPlanesOfScreen(XEN arg1)
+static Xen gxm_XPlanesOfScreen(Xen arg1)
{
#define H_PlanesOfScreen "PlanesOfScreen(screen): returns the number of planes in the root window of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XPlanesOfScreen", "Screen*");
- return(C_TO_XEN_INT(XPlanesOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XPlanesOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XPlanesOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XPending(XEN arg1)
+static Xen gxm_XPending(Xen arg1)
{
#define H_XPending "int XPending(display): returns the number of events that have been received from the X server but have not been removed \
from the event queue."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XPending", "Display*");
- return(C_TO_XEN_INT(XPending(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XPending", "Display*");
+ return(C_int_to_Xen_integer(XPending(Xen_to_C_Display(arg1))));
}
-static XEN xm_XPeekIfEventProc;
+static Xen xm_XPeekIfEventProc;
static Bool gxm_XPeekIfEventProc(Display *dpy, XEvent *e, XtPointer p)
{
- return(XEN_TO_C_BOOLEAN(XEN_CALL_3(xm_XPeekIfEventProc, C_TO_XEN_Display(dpy), C_TO_XEN_XEvent(e), (XEN)(p), c__FUNCTION__)));
+ return(Xen_boolean_to_C_bool(Xen_call_with_3_args(xm_XPeekIfEventProc, C_to_Xen_Display(dpy), C_to_Xen_XEvent(e), (Xen)(p), __func__)));
}
-static XEN gxm_XPeekIfEvent(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XPeekIfEvent(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XPeekIfEvent "XPeekIfEvent(display, predicate, arg): returns only when the specified predicate procedure returns " PROC_TRUE " for an event."
/* DIFF: XPeekIfEvent dpy [evrtn] proc ptr -> (list val evrtn)
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XPeekIfEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg2) && (XEN_REQUIRED_ARGS_OK(arg2, 3)), arg2, 2, "XPeekIfEvent", "(Bool_Proc dpy ev data)");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XPeekIfEvent", "Display*");
+ Xen_check_type(Xen_is_procedure(arg2) && (Xen_is_aritable(arg2, 3)), arg2, 2, "XPeekIfEvent", "(Bool_Proc dpy ev data)");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XPeekIfEvent(XEN_TO_C_Display(arg1),
+ val = XPeekIfEvent(Xen_to_C_Display(arg1),
e,
(Bool (*)(Display *d, XEvent *ev, char *p))gxm_XPeekIfEventProc, /* C++ insists on the cast */
(XPointer)arg3);
- return(XEN_LIST_2(C_TO_XEN_INT(val), C_TO_XEN_XEvent_OBJ(e)));
+ return(Xen_list_2(C_int_to_Xen_integer(val), C_to_Xen_XEvent_OBJ(e)));
}
-static XEN gxm_XPeekEvent(XEN arg1)
+static Xen gxm_XPeekEvent(Xen arg1)
{
#define H_XPeekEvent "XPeekEvent(display): returns the first event from the event queue, but it does not remove the event from the queue."
/* DIFF: XPeekEvent dpy [ev] -> (list int event)
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XPeekEvent", "Display*");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XPeekEvent", "Display*");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XPeekEvent(XEN_TO_C_Display(arg1), e);
- return(XEN_LIST_2(C_TO_XEN_INT(val), C_TO_XEN_XEvent_OBJ(e)));
+ val = XPeekEvent(Xen_to_C_Display(arg1), e);
+ return(Xen_list_2(C_int_to_Xen_integer(val), C_to_Xen_XEvent_OBJ(e)));
}
-static XEN gxm_XParseGeometry(XEN arg1)
+static Xen gxm_XParseGeometry(Xen arg1)
{
#define H_XParseGeometry "int XParseGeometry(parsestring): returns a bitmask that \
indicates which of the four values (width, height, xoffset, and yoffset) were actually found in the string and whether the x and y values are negative. "
@@ -9698,34 +9418,34 @@ indicates which of the four values (width, height, xoffset, and yoffset) were ac
*/
int x = 0, y = 0, val = 0;
unsigned int w = 0, h = 0;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XParseGeometry", "char*");
- val = XParseGeometry((char *)XEN_TO_C_STRING(arg1), &x, &y, &w, &h);
- return(XEN_LIST_5(C_TO_XEN_INT(val),
- C_TO_XEN_INT(x),
- C_TO_XEN_INT(y),
- C_TO_XEN_INT(w),
- C_TO_XEN_INT(h)));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XParseGeometry", "char*");
+ val = XParseGeometry((char *)Xen_string_to_C_string(arg1), &x, &y, &w, &h);
+ return(Xen_list_5(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(x),
+ C_int_to_Xen_integer(y),
+ C_int_to_Xen_integer(w),
+ C_int_to_Xen_integer(h)));
}
-static XEN gxm_XParseColor(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XParseColor(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XParseColor "Status XParseColor(display, colormap, spec, exact_def_return) looks up the string name of a color with respect \
to the screen associated with the specified colormap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XParseColor", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XParseColor", "Colormap");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XParseColor", "char*");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg4), arg4, 4, "XParseColor", "XColor");
- return(C_TO_XEN_INT(XParseColor(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2), (char *)XEN_TO_C_STRING(arg3), XEN_TO_C_XColor(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XParseColor", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XParseColor", "Colormap");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XParseColor", "char*");
+ Xen_check_type(Xen_is_XColor(arg4), arg4, 4, "XParseColor", "XColor");
+ return(C_int_to_Xen_integer(XParseColor(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2), (char *)Xen_string_to_C_string(arg3), Xen_to_C_XColor(arg4))));
}
-static XEN gxm_XNoOp(XEN arg1)
+static Xen gxm_XNoOp(Xen arg1)
{
#define H_XNoOp "XNoOp(dpy) sends the server a no-op for exercise"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XNoOp", "Display*");
- return(C_TO_XEN_INT(XNoOp(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XNoOp", "Display*");
+ return(C_int_to_Xen_integer(XNoOp(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XNextEvent(XEN arg1)
+static Xen gxm_XNextEvent(Xen arg1)
{
#define H_XNextEvent "XNextEvent(display) copies the first event from the event queue into the specified XEvent structure \
and then removes it from the queue."
@@ -9733,146 +9453,146 @@ and then removes it from the queue."
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XNextEvent", "Display*");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XNextEvent", "Display*");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XNextEvent(XEN_TO_C_Display(arg1), e);
- return(XEN_LIST_2(C_TO_XEN_INT(val), C_TO_XEN_XEvent_OBJ(e)));
+ val = XNextEvent(Xen_to_C_Display(arg1), e);
+ return(Xen_list_2(C_int_to_Xen_integer(val), C_to_Xen_XEvent_OBJ(e)));
}
-static XEN gxm_XMoveWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XMoveWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XMoveWindow "XMoveWindow(display, w, x, y) moves the specified window to the specified x and y coordinates, but it does not \
change the window's size, raise the window, or change the mapping state of the window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XMoveWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XMoveWindow", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XMoveWindow", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XMoveWindow", "int");
- return(C_TO_XEN_INT(XMoveWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XMoveWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XMoveWindow", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XMoveWindow", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XMoveWindow", "int");
+ return(C_int_to_Xen_integer(XMoveWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4))));
}
-static XEN gxm_XMoveResizeWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XMoveResizeWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XMoveResizeWindow "XMoveResizeWindow(display, w, x, y, width, height) changes the size and location of the specified window without raising it."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XMoveResizeWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XMoveResizeWindow", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XMoveResizeWindow", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XMoveResizeWindow", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XMoveResizeWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XMoveResizeWindow", "unsigned int");
- return(C_TO_XEN_INT(XMoveResizeWindow(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4),
- XEN_TO_C_ULONG(arg5), XEN_TO_C_ULONG(arg6))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XMoveResizeWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XMoveResizeWindow", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XMoveResizeWindow", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XMoveResizeWindow", "int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XMoveResizeWindow", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XMoveResizeWindow", "unsigned int");
+ return(C_int_to_Xen_integer(XMoveResizeWindow(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4),
+ Xen_ulong_to_C_ulong(arg5), Xen_ulong_to_C_ulong(arg6))));
}
-static XEN gxm_XMinCmapsOfScreen(XEN arg1)
+static Xen gxm_XMinCmapsOfScreen(Xen arg1)
{
#define H_MinCmapsOfScreen "returns the minimum number of installed colormaps supported by the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XMinCmapsOfScreen", "Screen*");
- return(C_TO_XEN_INT(XMinCmapsOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XMinCmapsOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XMinCmapsOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XMaxCmapsOfScreen(XEN arg1)
+static Xen gxm_XMaxCmapsOfScreen(Xen arg1)
{
#define H_MaxCmapsOfScreen "returns the maximum number of installed colormaps supported by the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XMaxCmapsOfScreen", "Screen*");
- return(C_TO_XEN_INT(XMaxCmapsOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XMaxCmapsOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XMaxCmapsOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XMaskEvent(XEN arg1, XEN arg2)
+static Xen gxm_XMaskEvent(Xen arg1, Xen arg2)
{
#define H_XMaskEvent "XMaskEvent(display, event_mask) searches the event queue for the events associated with the specified mask."
/* DIFF: XMaskEvent dpy mask [ev] -> (list val ev)
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XMaskEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XMaskEvent", "long");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XMaskEvent", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XMaskEvent", "long");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XMaskEvent(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), e);
- return(XEN_LIST_2(C_TO_XEN_INT(val), C_TO_XEN_XEvent_OBJ(e)));
+ val = XMaskEvent(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), e);
+ return(Xen_list_2(C_int_to_Xen_integer(val), C_to_Xen_XEvent_OBJ(e)));
}
-static XEN gxm_XMapWindow(XEN arg1, XEN arg2)
+static Xen gxm_XMapWindow(Xen arg1, Xen arg2)
{
#define H_XMapWindow "XMapWindow(display, w) maps the window and all of its subwindows that have had map requests."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XMapWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XMapWindow", "Window");
- return(C_TO_XEN_INT(XMapWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XMapWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XMapWindow", "Window");
+ return(C_int_to_Xen_integer(XMapWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XMapSubwindows(XEN arg1, XEN arg2)
+static Xen gxm_XMapSubwindows(Xen arg1, Xen arg2)
{
#define H_XMapSubwindows "XMapSubwindows(display, w) maps all subwindows for a specified window in top-to-bottom stacking order."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XMapSubwindows", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XMapSubwindows", "Window");
- return(C_TO_XEN_INT(XMapSubwindows(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XMapSubwindows", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XMapSubwindows", "Window");
+ return(C_int_to_Xen_integer(XMapSubwindows(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XMapRaised(XEN arg1, XEN arg2)
+static Xen gxm_XMapRaised(Xen arg1, Xen arg2)
{
#define H_XMapRaised "XMapRaised(display, w) maps the window and all of its subwindows that have had map requests, and raises the \
specified window to the top of the stack."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XMapRaised", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XMapRaised", "Window");
- return(C_TO_XEN_INT(XMapRaised(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XMapRaised", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XMapRaised", "Window");
+ return(C_int_to_Xen_integer(XMapRaised(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XLowerWindow(XEN arg1, XEN arg2)
+static Xen gxm_XLowerWindow(Xen arg1, Xen arg2)
{
#define H_XLowerWindow "XLowerWindow(display, w) lowers the specified window to the bottom of the stack so that it does not obscure any sibling windows."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XLowerWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XLowerWindow", "Window");
- return(C_TO_XEN_INT(XLowerWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XLowerWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XLowerWindow", "Window");
+ return(C_int_to_Xen_integer(XLowerWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XLookupColor(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XLookupColor(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XLookupColor "Status XLookupColor(display, colormap, color_name, exact_def_return, screen_def_return) looks up the string name \
of a color with respect to the screen associated with the specified colormap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XLookupColor", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XLookupColor", "Colormap");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XLookupColor", "char*");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg4), arg4, 4, "XLookupColor", "XColor*");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg5), arg5, 5, "XLookupColor", "XColor*");
- return(C_TO_XEN_INT(XLookupColor(XEN_TO_C_Display(arg1),
- XEN_TO_C_Colormap(arg2),
- (char *)XEN_TO_C_STRING(arg3),
- XEN_TO_C_XColor(arg4), XEN_TO_C_XColor(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XLookupColor", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XLookupColor", "Colormap");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XLookupColor", "char*");
+ Xen_check_type(Xen_is_XColor(arg4), arg4, 4, "XLookupColor", "XColor*");
+ Xen_check_type(Xen_is_XColor(arg5), arg5, 5, "XLookupColor", "XColor*");
+ return(C_int_to_Xen_integer(XLookupColor(Xen_to_C_Display(arg1),
+ Xen_to_C_Colormap(arg2),
+ (char *)Xen_string_to_C_string(arg3),
+ Xen_to_C_XColor(arg4), Xen_to_C_XColor(arg5))));
}
-static XEN gxm_XKillClient(XEN arg1, XEN arg2)
+static Xen gxm_XKillClient(Xen arg1, Xen arg2)
{
#define H_XKillClient "XKillClient(display, resource) forces a close-down of the client that created the resource"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XKillClient", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XKillClient", "XID");
- return(C_TO_XEN_INT(XKillClient(XEN_TO_C_Display(arg1), XEN_TO_C_ULONG(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XKillClient", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XKillClient", "XID");
+ return(C_int_to_Xen_integer(XKillClient(Xen_to_C_Display(arg1), Xen_ulong_to_C_ulong(arg2))));
}
-static XEN gxm_XKeysymToKeycode(XEN arg1, XEN arg2)
+static Xen gxm_XKeysymToKeycode(Xen arg1, Xen arg2)
{
#define H_XKeysymToKeycode "KeyCode XKeysymToKeycode(display, keysym)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XKeysymToKeycode", "Display*");
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg2), arg2, 2, "XKeysymToKeycode", "KeySym");
- return(C_TO_XEN_KeyCode(XKeysymToKeycode(XEN_TO_C_Display(arg1), XEN_TO_C_KeySym(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XKeysymToKeycode", "Display*");
+ Xen_check_type(Xen_is_KeySym(arg2), arg2, 2, "XKeysymToKeycode", "KeySym");
+ return(C_to_Xen_KeyCode(XKeysymToKeycode(Xen_to_C_Display(arg1), Xen_to_C_KeySym(arg2))));
}
-static XEN gxm_XInstallColormap(XEN arg1, XEN arg2)
+static Xen gxm_XInstallColormap(Xen arg1, Xen arg2)
{
#define H_XInstallColormap "XInstallColormap(display, colormap) installs the specified colormap for its associated screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XInstallColormap", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XInstallColormap", "Colormap");
- return(C_TO_XEN_INT(XInstallColormap(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XInstallColormap", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XInstallColormap", "Colormap");
+ return(C_int_to_Xen_integer(XInstallColormap(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2))));
}
-static XEN gxm_XImageByteOrder(XEN arg1)
+static Xen gxm_XImageByteOrder(Xen arg1)
{
#define H_ImageByteOrder "specifies the required byte order for images for each scanline unit in XY format (bitmap) or for each pixel value in Z format."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XImageByteOrder", "Display*");
- return(C_TO_XEN_INT(XImageByteOrder(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XImageByteOrder", "Display*");
+ return(C_int_to_Xen_integer(XImageByteOrder(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XIfEvent(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XIfEvent(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XIfEvent "XIfEvent(display, predicate, arg) completes only when the specified predicate procedure returns " PROC_TRUE " for \
an event, which indicates an event in the queue matches."
@@ -9880,139 +9600,139 @@ an event, which indicates an event in the queue matches."
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XIfEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg2) && (XEN_REQUIRED_ARGS_OK(arg2, 3)), arg2, 2, "XIfEvent", "(Bool_Proc dpy ev data)");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XIfEvent", "Display*");
+ Xen_check_type(Xen_is_procedure(arg2) && (Xen_is_aritable(arg2, 3)), arg2, 2, "XIfEvent", "(Bool_Proc dpy ev data)");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XIfEvent(XEN_TO_C_Display(arg1),
+ val = XIfEvent(Xen_to_C_Display(arg1),
e,
(Bool (*)(Display *d1, XEvent *e1, char *p1))gxm_XPeekIfEventProc,
(char *)arg3);
- return(XEN_LIST_2(C_TO_XEN_INT(val), C_TO_XEN_XEvent_OBJ(e)));
+ return(Xen_list_2(C_int_to_Xen_integer(val), C_to_Xen_XEvent_OBJ(e)));
}
-static XEN gxm_XHeightOfScreen(XEN arg1)
+static Xen gxm_XHeightOfScreen(Xen arg1)
{
#define H_HeightOfScreen "XHeightOfScreen(screen): returns the height of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XHeightOfScreen", "Screen*");
- return(C_TO_XEN_INT(XHeightOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XHeightOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XHeightOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XHeightMMOfScreen(XEN arg1)
+static Xen gxm_XHeightMMOfScreen(Xen arg1)
{
#define H_HeightMMOfScreen "XHeightMMOfScreen(screen): returns the height of the specified screen in millimeters."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XHeightMMOfScreen", "Screen*");
- return(C_TO_XEN_INT(XHeightMMOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XHeightMMOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XHeightMMOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XGrabServer(XEN arg1)
+static Xen gxm_XGrabServer(Xen arg1)
{
#define H_XGrabServer "XGrabServer(display) disables processing of requests and close downs on all other connections than the one this request arrived on."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGrabServer", "Display*");
- return(C_TO_XEN_INT(XGrabServer(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGrabServer", "Display*");
+ return(C_int_to_Xen_integer(XGrabServer(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XGrabPointer(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8, XEN arg9)
+static Xen gxm_XGrabPointer(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8, Xen arg9)
{
#define H_XGrabPointer "int XGrabPointer(display, grab_window, owner_events, event_mask, pointer_mode, keyboard_mode, confine_to, cursor, time) \
actively grabs control of the pointer and returns GrabSuccess if the grab was successful."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGrabPointer", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGrabPointer", "Window");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XGrabPointer", "Bool");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XGrabPointer", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XGrabPointer", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XGrabPointer", "int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg7), arg7, 7, "XGrabPointer", "Window");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg8), arg8, 8, "XGrabPointer", "Cursor");
- XEN_ASSERT_TYPE(XEN_Time_P(arg9), arg9, 9, "XGrabPointer", "Time");
- return(C_TO_XEN_INT(XGrabPointer(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_BOOLEAN(arg3),
- XEN_TO_C_ULONG(arg4), XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6),
- XEN_TO_C_Window(arg7), XEN_TO_C_Cursor(arg8),
- XEN_TO_C_Time(arg9))));
-}
-
-static XEN gxm_XGrabKeyboard(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGrabPointer", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGrabPointer", "Window");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XGrabPointer", "Bool");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XGrabPointer", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XGrabPointer", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XGrabPointer", "int");
+ Xen_check_type(Xen_is_Window(arg7), arg7, 7, "XGrabPointer", "Window");
+ Xen_check_type(Xen_is_Cursor(arg8), arg8, 8, "XGrabPointer", "Cursor");
+ Xen_check_type(Xen_is_Time(arg9), arg9, 9, "XGrabPointer", "Time");
+ return(C_int_to_Xen_integer(XGrabPointer(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_boolean_to_C_bool(arg3),
+ Xen_ulong_to_C_ulong(arg4), Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6),
+ Xen_to_C_Window(arg7), Xen_to_C_Cursor(arg8),
+ Xen_to_C_Time(arg9))));
+}
+
+static Xen gxm_XGrabKeyboard(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XGrabKeyboard "int XGrabKeyboard(display, grab_window, owner_events, pointer_mode, keyboard_mode, time) actively grabs control of \
the keyboard and generates FocusIn and FocusOut events."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGrabKeyboard", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGrabKeyboard", "Window");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XGrabKeyboard", "Bool");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XGrabKeyboard", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XGrabKeyboard", "int");
- XEN_ASSERT_TYPE(XEN_Time_P(arg6), arg6, 6, "XGrabKeyboard", "Time");
- return(C_TO_XEN_INT(XGrabKeyboard(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_BOOLEAN(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- XEN_TO_C_Time(arg6))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGrabKeyboard", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGrabKeyboard", "Window");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XGrabKeyboard", "Bool");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XGrabKeyboard", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XGrabKeyboard", "int");
+ Xen_check_type(Xen_is_Time(arg6), arg6, 6, "XGrabKeyboard", "Time");
+ return(C_int_to_Xen_integer(XGrabKeyboard(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_boolean_to_C_bool(arg3), Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ Xen_to_C_Time(arg6))));
}
-static XEN gxm_XGrabKey(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XGrabKey(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XGrabKey "XGrabKey(display, keycode, modifiers, grab_window, owner_events, pointer_mode, keyboard_mode) establishes a passive \
grab on the keyboard."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGrabKey", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XGrabKey", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XGrabKey", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg4), arg4, 4, "XGrabKey", "Window");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg5), arg5, 5, "XGrabKey", "Bool");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XGrabKey", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XGrabKey", "int");
- return(C_TO_XEN_INT(XGrabKey(XEN_TO_C_Display(arg1),
- XEN_TO_C_INT(arg2), XEN_TO_C_ULONG(arg3),
- XEN_TO_C_Window(arg4),
- XEN_TO_C_BOOLEAN(arg5), XEN_TO_C_INT(arg6), XEN_TO_C_INT(arg7))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGrabKey", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XGrabKey", "int");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XGrabKey", "unsigned int");
+ Xen_check_type(Xen_is_Window(arg4), arg4, 4, "XGrabKey", "Window");
+ Xen_check_type(Xen_is_boolean(arg5), arg5, 5, "XGrabKey", "Bool");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XGrabKey", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XGrabKey", "int");
+ return(C_int_to_Xen_integer(XGrabKey(Xen_to_C_Display(arg1),
+ Xen_integer_to_C_int(arg2), Xen_ulong_to_C_ulong(arg3),
+ Xen_to_C_Window(arg4),
+ Xen_boolean_to_C_bool(arg5), Xen_integer_to_C_int(arg6), Xen_integer_to_C_int(arg7))));
}
-static XEN gxm_XGrabButton(XEN args)
+static Xen gxm_XGrabButton(Xen args)
{
#define H_XGrabButton "XGrabButton(display, button, modifiers, grab_window, owner_events, event_mask, pointer_mode, keyboard_mode, confine_to, cursor) \
establishes a passive grab."
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGrabButton", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XGrabButton", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XGrabButton", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg4), arg4, 4, "XGrabButton", "Window");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg5), arg5, 5, "XGrabButton", "Bool");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XGrabButton", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XGrabButton", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XGrabButton", "int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg9), arg9, 9, "XGrabButton", "Window");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg10), arg10, 10, "XGrabButton", "Cursor");
- return(C_TO_XEN_INT(XGrabButton(XEN_TO_C_Display(arg1),
- XEN_TO_C_ULONG(arg2), XEN_TO_C_ULONG(arg3),
- XEN_TO_C_Window(arg4), XEN_TO_C_BOOLEAN(arg5),
- XEN_TO_C_ULONG(arg6), XEN_TO_C_INT(arg7),
- XEN_TO_C_INT(arg8),
- XEN_TO_C_Window(arg9), XEN_TO_C_Cursor(arg10))));
-}
-
-static XEN gxm_XGetWindowAttributes(XEN arg1, XEN arg2)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGrabButton", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XGrabButton", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XGrabButton", "unsigned int");
+ Xen_check_type(Xen_is_Window(arg4), arg4, 4, "XGrabButton", "Window");
+ Xen_check_type(Xen_is_boolean(arg5), arg5, 5, "XGrabButton", "Bool");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XGrabButton", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XGrabButton", "int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XGrabButton", "int");
+ Xen_check_type(Xen_is_Window(arg9), arg9, 9, "XGrabButton", "Window");
+ Xen_check_type(Xen_is_Cursor(arg10), arg10, 10, "XGrabButton", "Cursor");
+ return(C_int_to_Xen_integer(XGrabButton(Xen_to_C_Display(arg1),
+ Xen_ulong_to_C_ulong(arg2), Xen_ulong_to_C_ulong(arg3),
+ Xen_to_C_Window(arg4), Xen_boolean_to_C_bool(arg5),
+ Xen_ulong_to_C_ulong(arg6), Xen_integer_to_C_int(arg7),
+ Xen_integer_to_C_int(arg8),
+ Xen_to_C_Window(arg9), Xen_to_C_Cursor(arg10))));
+}
+
+static Xen gxm_XGetWindowAttributes(Xen arg1, Xen arg2)
{
#define H_XGetWindowAttributes "Status XGetWindowAttributes(display, w): returns the current attributes for the \
specified window to an XWindowAttributes structure."
/* DIFF: XGetWindowAttributes omits and rtns arg3
*/
XWindowAttributes *w;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetWindowAttributes", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetWindowAttributes", "Window");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetWindowAttributes", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetWindowAttributes", "Window");
w = (XWindowAttributes *)calloc(1, sizeof(XWindowAttributes));
- XGetWindowAttributes(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), w);
- return(C_TO_XEN_XWindowAttributes(w));
+ XGetWindowAttributes(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), w);
+ return(C_to_Xen_XWindowAttributes(w));
}
-static XEN gxm_XGetWindowProperty(XEN args)
+static Xen gxm_XGetWindowProperty(Xen args)
{
#define H_XGetWindowProperty "int XGetWindowProperty(display, w, property, long_offset, long_length, delete, req_type) \
returns the actual type of the property; the actual format of the property; the \
@@ -10020,79 +9740,79 @@ number of 8-bit, 16-bit, or 32-bit items transferred; the number of bytes remain
actually returned."
/* DIFF: XGetWindowProperty omit trailing 5 args, rtn as list
*/
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7;
- XEN result = XEN_FALSE;
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7;
+ Xen result = Xen_false;
Atom a;
int ret, val;
unsigned long len = 0, bytes;
unsigned char *data[1];
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetWindowProperty", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetWindowProperty", "Window");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XGetWindowProperty", "Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XGetWindowProperty", "long");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XGetWindowProperty", "long");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg6), arg6, 6, "XGetWindowProperty", "Bool");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg7), arg7, 7, "XGetWindowProperty", "Atom");
- val = XGetWindowProperty(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_Atom(arg3),
- XEN_TO_C_INT(arg4),
- XEN_TO_C_INT(arg5),
- XEN_TO_C_BOOLEAN(arg6),
- XEN_TO_C_Atom(arg7),
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetWindowProperty", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetWindowProperty", "Window");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XGetWindowProperty", "Atom");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XGetWindowProperty", "long");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XGetWindowProperty", "long");
+ Xen_check_type(Xen_is_boolean(arg6), arg6, 6, "XGetWindowProperty", "Bool");
+ Xen_check_type(Xen_is_Atom(arg7), arg7, 7, "XGetWindowProperty", "Atom");
+ val = XGetWindowProperty(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_Atom(arg3),
+ Xen_integer_to_C_int(arg4),
+ Xen_integer_to_C_int(arg5),
+ Xen_boolean_to_C_bool(arg6),
+ Xen_to_C_Atom(arg7),
&a, &ret, &len, &bytes, (unsigned char **)data);
if ((a != (Atom)None) && (len > 0))
{
if (a == XA_STRING)
- result = C_TO_XEN_STRING((char *)data[0]);
- else result = C_TO_XEN_STRINGN((char *)data[0], len * ret / 8); /* is this a good idea? -- perhaps a void pointer here? */
+ result = C_string_to_Xen_string((char *)data[0]);
+ else result = C_string_to_Xen_string_with_length((char *)data[0], len * ret / 8); /* is this a good idea? -- perhaps a void pointer here? */
if (data[0]) XFree(data[0]);
}
- return(XEN_LIST_6(C_TO_XEN_INT(val),
- C_TO_XEN_Atom(a),
- C_TO_XEN_INT(ret),
- C_TO_XEN_ULONG(len),
- C_TO_XEN_ULONG(bytes),
+ return(Xen_list_6(C_int_to_Xen_integer(val),
+ C_to_Xen_Atom(a),
+ C_int_to_Xen_integer(ret),
+ C_ulong_to_Xen_ulong(len),
+ C_ulong_to_Xen_ulong(bytes),
result));
}
-static XEN gxm_XGetTransientForHint(XEN arg1, XEN arg2)
+static Xen gxm_XGetTransientForHint(Xen arg1, Xen arg2)
{
#define H_XGetTransientForHint "Status XGetTransientForHint(display, w): returns the WM_TRANSIENT_FOR property for the specified window."
/* DIFF: XGetTransientForHint omit and rtn last arg
*/
Window w;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetTransientForHint", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetTransientForHint", "Window");
- val = XGetTransientForHint(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), &w);
- return(XEN_LIST_2(C_TO_XEN_INT(val),
- C_TO_XEN_Window(w)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetTransientForHint", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetTransientForHint", "Window");
+ val = XGetTransientForHint(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), &w);
+ return(Xen_list_2(C_int_to_Xen_integer(val),
+ C_to_Xen_Window(w)));
}
-static XEN gxm_XGetScreenSaver(XEN arg1)
+static Xen gxm_XGetScreenSaver(Xen arg1)
{
#define H_XGetScreenSaver "XGetScreenSaver(display) gets the current screen saver values."
/* DIFF: XGetScreenSaver omit and rtn last 4 args
*/
int a, b, c ,d, val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetScreenSaver", "Display*");
- val = XGetScreenSaver(XEN_TO_C_Display(arg1), &a, &b, &c, &d);
- return(XEN_LIST_5(C_TO_XEN_INT(val),
- C_TO_XEN_INT(a),
- C_TO_XEN_INT(b),
- C_TO_XEN_INT(c),
- C_TO_XEN_INT(d)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetScreenSaver", "Display*");
+ val = XGetScreenSaver(Xen_to_C_Display(arg1), &a, &b, &c, &d);
+ return(Xen_list_5(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(a),
+ C_int_to_Xen_integer(b),
+ C_int_to_Xen_integer(c),
+ C_int_to_Xen_integer(d)));
}
-static XEN gxm_XGetPointerMapping(XEN arg1, XEN ignore, XEN arg3)
+static Xen gxm_XGetPointerMapping(Xen arg1, Xen ignore, Xen arg3)
{
#define H_XGetPointerMapping "int XGetPointerMapping(display, ignored, len): returns the current mapping of the pointer."
/* DIFF: XGetPointerMapping ignores arg2, returns list
@@ -10100,96 +9820,96 @@ static XEN gxm_XGetPointerMapping(XEN arg1, XEN ignore, XEN arg3)
*/
int i, len, loc, rtn;
unsigned char *map;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetPointerMapping", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XGetPointerMapping", "int");
- len = XEN_TO_C_INT(arg3);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg3, 3, "XGetPointerMapping", "positive integer");
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetPointerMapping", "Display*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XGetPointerMapping", "int");
+ len = Xen_integer_to_C_int(arg3);
+ if (len <= 0) Xen_check_type(0, arg3, 3, "XGetPointerMapping", "positive integer");
map = (unsigned char *)calloc(len, sizeof(unsigned char));
- rtn = XGetPointerMapping(XEN_TO_C_Display(arg1), map, len);
+ rtn = XGetPointerMapping(Xen_to_C_Display(arg1), map, len);
if (len > rtn) len = rtn;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_INT((int)(map[i])), lst);
+ lst = Xen_cons(C_int_to_Xen_integer((int)(map[i])), lst);
free(map);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XGetPointerControl(XEN arg1)
+static Xen gxm_XGetPointerControl(Xen arg1)
{
#define H_XGetPointerControl "XGetPointerControl(display) \
returns the pointer's current acceleration multiplier and acceleration threshold."
/* DIFF: XGetPointerControl omits and return last 3 args
*/
int val, num, den, thresh;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetPointerControl", "Display*");
- val = XGetPointerControl(XEN_TO_C_Display(arg1), &num, &den, &thresh);
- return(XEN_LIST_4(C_TO_XEN_INT(val),
- C_TO_XEN_INT(num),
- C_TO_XEN_INT(den),
- C_TO_XEN_INT(thresh)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetPointerControl", "Display*");
+ val = XGetPointerControl(Xen_to_C_Display(arg1), &num, &den, &thresh);
+ return(Xen_list_4(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(num),
+ C_int_to_Xen_integer(den),
+ C_int_to_Xen_integer(thresh)));
}
-static XEN gxm_XGetKeyboardControl(XEN arg1)
+static Xen gxm_XGetKeyboardControl(Xen arg1)
{
#define H_XGetKeyboardControl "XGetKeyboardControl(display): returns the current control values for the keyboard \
to the XKeyboardState structure."
/* DIFF: XGetKeyboardControl omits arg2 and rtns list of fields
*/
XKeyboardState ks;
- XEN v;
+ Xen v;
int i, loc;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetKeyboardControl", "Display*");
- XGetKeyboardControl(XEN_TO_C_Display(arg1), &ks);
- v = XEN_MAKE_VECTOR(32, XEN_ZERO);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetKeyboardControl", "Display*");
+ XGetKeyboardControl(Xen_to_C_Display(arg1), &ks);
+ v = Xen_make_vector(32, Xen_integer_zero);
loc = xm_protect(v);
for (i = 0; i < 32; i++)
- XEN_VECTOR_SET(v, i, C_TO_XEN_INT((int)(ks.auto_repeats[i])));
+ Xen_vector_set(v, i, C_int_to_Xen_integer((int)(ks.auto_repeats[i])));
xm_unprotect_at(loc);
- return(XEN_LIST_7(C_TO_XEN_INT(ks.key_click_percent),
- C_TO_XEN_INT(ks.bell_percent),
- C_TO_XEN_INT(ks.bell_pitch),
- C_TO_XEN_INT(ks.bell_duration),
- C_TO_XEN_INT(ks.led_mask),
- C_TO_XEN_INT(ks.global_auto_repeat),
+ return(Xen_list_7(C_int_to_Xen_integer(ks.key_click_percent),
+ C_int_to_Xen_integer(ks.bell_percent),
+ C_int_to_Xen_integer(ks.bell_pitch),
+ C_int_to_Xen_integer(ks.bell_duration),
+ C_int_to_Xen_integer(ks.led_mask),
+ C_int_to_Xen_integer(ks.global_auto_repeat),
v));
}
-static XEN gxm_XGetInputFocus(XEN arg1)
+static Xen gxm_XGetInputFocus(Xen arg1)
{
#define H_XGetInputFocus "XGetInputFocus(display): returns the focus window and the current focus state."
/* DIFF: XGetInputFocus omit and rtn last 2 args
*/
Window w;
int r, val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetInputFocus", "Display*");
- val = XGetInputFocus(XEN_TO_C_Display(arg1), &w, &r);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_Window(w),
- C_TO_XEN_INT(r)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetInputFocus", "Display*");
+ val = XGetInputFocus(Xen_to_C_Display(arg1), &w, &r);
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_to_Xen_Window(w),
+ C_int_to_Xen_integer(r)));
}
-static XEN gxm_XGetIconName(XEN arg1, XEN arg2)
+static Xen gxm_XGetIconName(Xen arg1, Xen arg2)
{
#define H_XGetIconName "Status XGetIconName(display, w): returns the name to be displayed in the specified window's icon."
/* DIFF: XGetIconName omits and returns arg3
*/
char *str;
int val;
- XEN res = XEN_FALSE;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetIconName", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetIconName", "Window");
- val = XGetIconName(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), &str);
+ Xen res = Xen_false;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetIconName", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetIconName", "Window");
+ val = XGetIconName(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), &str);
if (val != 0)
{
- res = C_TO_XEN_STRING(str);
+ res = C_string_to_Xen_string(str);
XFree(str);
}
return(res);
}
-static XEN gxm_XGetGeometry(XEN arg1, XEN arg2)
+static Xen gxm_XGetGeometry(Xen arg1, Xen arg2)
{
#define H_XGetGeometry "Status XGetGeometry(display, d): returns the root window and the current geometry of the drawable."
/* DIFF: XGetGeometry omits last 7 args and returns list
@@ -10197,51 +9917,51 @@ static XEN gxm_XGetGeometry(XEN arg1, XEN arg2)
unsigned int wr, hr, br, dr;
int xr, yr, val;
Window root;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetGeometry", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetGeometry", "Drawable");
- val = XGetGeometry(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetGeometry", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetGeometry", "Drawable");
+ val = XGetGeometry(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
&root, &xr, &yr, &wr, &hr, &br, &dr);
- return(XEN_LIST_8(C_TO_XEN_INT(val),
- C_TO_XEN_Window(root),
- C_TO_XEN_INT(xr),
- C_TO_XEN_INT(yr),
- C_TO_XEN_ULONG(wr),
- C_TO_XEN_ULONG(hr),
- C_TO_XEN_ULONG(br),
- C_TO_XEN_ULONG(dr)));
+ return(Xen_list_8(C_int_to_Xen_integer(val),
+ C_to_Xen_Window(root),
+ C_int_to_Xen_integer(xr),
+ C_int_to_Xen_integer(yr),
+ C_ulong_to_Xen_ulong(wr),
+ C_ulong_to_Xen_ulong(hr),
+ C_ulong_to_Xen_ulong(br),
+ C_ulong_to_Xen_ulong(dr)));
}
-static XEN gxm_XGetGCValues(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XGetGCValues(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XGetGCValues "Status XGetGCValues(display, gc, valuemask): returns the components specified by valuemask for the specified GC."
/* DIFF: XGetGCValues omits and returns last arg
*/
XGCValues *val;
int rtn;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetGCValues", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XGetGCValues", "GC");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XGetGCValues", "ulong");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetGCValues", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XGetGCValues", "GC");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XGetGCValues", "ulong");
val = (XGCValues *)calloc(1, sizeof(XGCValues));
- rtn = XGetGCValues(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_ULONG(arg3), val);
- return(XEN_LIST_2(C_TO_XEN_INT(rtn),
- C_TO_XEN_XGCValues(val)));
+ rtn = XGetGCValues(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_ulong_to_C_ulong(arg3), val);
+ return(Xen_list_2(C_int_to_Xen_integer(rtn),
+ C_to_Xen_XGCValues(val)));
}
-static XEN gxm_XGetFontProperty(XEN arg1, XEN arg2)
+static Xen gxm_XGetFontProperty(Xen arg1, Xen arg2)
{
#define H_XGetFontProperty "Bool XGetFontProperty(font_struct, atom): returns the value of the specified font property. "
/* DIFF: XGetFontProperty omits and rtns last arg
*/
Bool val = False;
unsigned long prop = 0;
- XEN_ASSERT_TYPE(XEN_XFontStruct_P(arg1), arg1, 1, "XGetFontProperty", "XFontStruct*");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XGetFontProperty", "Atom");
- val = XGetFontProperty(XEN_TO_C_XFontStruct(arg1), XEN_TO_C_Atom(arg2), &prop);
- return(XEN_LIST_2(C_TO_XEN_BOOLEAN(val),
- C_TO_XEN_ULONG(prop)));
+ Xen_check_type(Xen_is_XFontStruct(arg1), arg1, 1, "XGetFontProperty", "XFontStruct*");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XGetFontProperty", "Atom");
+ val = XGetFontProperty(Xen_to_C_XFontStruct(arg1), Xen_to_C_Atom(arg2), &prop);
+ return(Xen_list_2(C_bool_to_Xen_boolean(val),
+ C_ulong_to_Xen_ulong(prop)));
}
-static XEN gxm_XGetErrorText(XEN arg1, XEN arg2, XEN ignore, XEN arg4)
+static Xen gxm_XGetErrorText(Xen arg1, Xen arg2, Xen ignore, Xen arg4)
{
#define H_XGetErrorText "XGetErrorText(display, code, buffer_return, length) copies a null-terminated string describing the specified error \
code into the specified buffer."
@@ -10249,281 +9969,282 @@ code into the specified buffer."
*/
char *buf;
int len, val;
- XEN str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetErrorText", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XGetErrorText", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XGetErrorText", "int");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg4, 4, "XGetErrorText", "positive integer");
+ Xen str;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetErrorText", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XGetErrorText", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XGetErrorText", "int");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) Xen_check_type(0, arg4, 4, "XGetErrorText", "positive integer");
buf = (char *)calloc(len, sizeof(char));
- val = XGetErrorText(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), buf, len);
- str = C_TO_XEN_STRING(buf);
+ val = XGetErrorText(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), buf, len);
+ str = C_string_to_Xen_string(buf);
free(buf);
- return(XEN_LIST_2(C_TO_XEN_INT(val),
+ return(Xen_list_2(C_int_to_Xen_integer(val),
str));
}
-static XEN gxm_XGeometry(XEN args)
+static Xen gxm_XGeometry(Xen args)
{
#define H_XGeometry "int XGeometry(dpy, screen, position, default_position, bwidth, fwidth, fheight, xadder, yadder) calculates \
window geometry given user geometry string and default geometry"
/* DIFF: XGetGeometry omits trailing 4 args and returns them
*/
int x, y, w, h, val;
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGeometry", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XGeometry", "int");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XGeometry", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XGeometry", "char*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XGeometry", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XGeometry", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XGeometry", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XGeometry", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9), arg9, 9, "XGeometry", "int");
- val = XGeometry(XEN_TO_C_Display(arg1),
- XEN_TO_C_INT(arg2),
- (char *)XEN_TO_C_STRING(arg3),
- (char *)XEN_TO_C_STRING(arg4),
- XEN_TO_C_ULONG(arg5),
- XEN_TO_C_ULONG(arg6),
- XEN_TO_C_ULONG(arg7),
- XEN_TO_C_INT(arg8),
- XEN_TO_C_INT(arg9),
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGeometry", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XGeometry", "int");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XGeometry", "char*");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XGeometry", "char*");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XGeometry", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XGeometry", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XGeometry", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XGeometry", "int");
+ Xen_check_type(Xen_is_integer(arg9), arg9, 9, "XGeometry", "int");
+ val = XGeometry(Xen_to_C_Display(arg1),
+ Xen_integer_to_C_int(arg2),
+ (char *)Xen_string_to_C_string(arg3),
+ (char *)Xen_string_to_C_string(arg4),
+ Xen_ulong_to_C_ulong(arg5),
+ Xen_ulong_to_C_ulong(arg6),
+ Xen_ulong_to_C_ulong(arg7),
+ Xen_integer_to_C_int(arg8),
+ Xen_integer_to_C_int(arg9),
&x, &y, &w, &h);
- return(XEN_LIST_5(C_TO_XEN_INT(val),
- C_TO_XEN_INT(x),
- C_TO_XEN_INT(y),
- C_TO_XEN_INT(w),
- C_TO_XEN_INT(h)));
+ return(Xen_list_5(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(x),
+ C_int_to_Xen_integer(y),
+ C_int_to_Xen_integer(w),
+ C_int_to_Xen_integer(h)));
}
-static XEN gxm_XFreePixmap(XEN arg1, XEN arg2)
+static Xen gxm_XFreePixmap(Xen arg1, Xen arg2)
{
#define H_XFreePixmap "XFreePixmap(display, pixmap) first deletes the association between the pixmap ID and the pixmap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFreePixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg2), arg2, 2, "XFreePixmap", "Pixmap");
- return(C_TO_XEN_INT(XFreePixmap(XEN_TO_C_Display(arg1), XEN_TO_C_Pixmap(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFreePixmap", "Display*");
+ Xen_check_type(Xen_is_Pixmap(arg2), arg2, 2, "XFreePixmap", "Pixmap");
+ return(C_int_to_Xen_integer(XFreePixmap(Xen_to_C_Display(arg1), Xen_to_C_Pixmap(arg2))));
}
-static XEN gxm_XFreeModifiermap(XEN arg1)
+static Xen gxm_XFreeModifiermap(Xen arg1)
{
#define H_XFreeModifiermap "XFreeModifiermap(modmap) frees the specified XModifierKeymap structure."
- XEN_ASSERT_TYPE(XEN_XModifierKeymap_P(arg1), arg1, 1, "XFreeModifiermap", "XModifierKeymap*");
- return(C_TO_XEN_INT(XFreeModifiermap(XEN_TO_C_XModifierKeymap(arg1))));
+ Xen_check_type(Xen_is_XModifierKeymap(arg1), arg1, 1, "XFreeModifiermap", "XModifierKeymap*");
+ return(C_int_to_Xen_integer(XFreeModifiermap(Xen_to_C_XModifierKeymap(arg1))));
}
-static XEN gxm_XFreeGC(XEN arg1, XEN arg2)
+static Xen gxm_XFreeGC(Xen arg1, Xen arg2)
{
#define H_XFreeGC "XFreeGC(display, gc) destroys the specified GC as well as all the associated storage."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFreeGC", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XFreeGC", "GC");
- return(C_TO_XEN_INT(XFreeGC(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFreeGC", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XFreeGC", "GC");
+ return(C_int_to_Xen_integer(XFreeGC(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2))));
}
-static XEN gxm_XFreeFontPath(XEN ignore)
+static Xen gxm_XFreeFontPath(Xen ignore)
{
#define H_XFreeFontPath "XFreeFontPath(list) frees the data allocated by XGetFontPath (a no-op in xm)."
/* DIFF: XFreeFontPath is no-op
*/
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XFreeFontNames(XEN ignore)
+static Xen gxm_XFreeFontNames(Xen ignore)
{
#define H_XFreeFontNames "XFreeFontNames(list) frees the array and strings returned by XListFonts or XListFontsWithInfo (a no-op in xm)."
/* DIFF: XFreeFontNames is no-op
*/
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XFreeFontInfo(XEN ignore1, XEN ignore2, XEN ignore3)
+static Xen gxm_XFreeFontInfo(Xen ignore1, Xen ignore2, Xen ignore3)
{
#define H_XFreeFontInfo "XFreeFontInfo(names, free_info, actual_count) frees a font structure or an array of font structures, and \
optionally an array of font names (a no-op in xm)."
/* DIFF: XFreeFontInfo is a no-op
*/
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XFreeFont(XEN arg1, XEN arg2)
+static Xen gxm_XFreeFont(Xen arg1, Xen arg2)
{
#define H_XFreeFont "XFreeFont(display, font_struct) deletes the association between the font resource ID and the specified font and \
frees the XFontStruct structure."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFreeFont", "Display*");
- XEN_ASSERT_TYPE(XEN_XFontStruct_P(arg2), arg2, 2, "XFreeFont", "XFontStruct*");
- return(C_TO_XEN_INT(XFreeFont(XEN_TO_C_Display(arg1), XEN_TO_C_XFontStruct(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFreeFont", "Display*");
+ Xen_check_type(Xen_is_XFontStruct(arg2), arg2, 2, "XFreeFont", "XFontStruct*");
+ return(C_int_to_Xen_integer(XFreeFont(Xen_to_C_Display(arg1), Xen_to_C_XFontStruct(arg2))));
}
-static XEN gxm_XFreeExtensionList(XEN ignore)
+static Xen gxm_XFreeExtensionList(Xen ignore)
{
/* DIFF: XFreeExtensionList is a no-op
*/
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XFreeCursor(XEN arg1, XEN arg2)
+static Xen gxm_XFreeCursor(Xen arg1, Xen arg2)
{
#define H_XFreeCursor "XFreeCursor(display, cursor) deletes the association between the cursor resource ID and the specified cursor."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFreeCursor", "Display*");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg2), arg2, 2, "XFreeCursor", "Cursor");
- return(C_TO_XEN_INT(XFreeCursor(XEN_TO_C_Display(arg1), XEN_TO_C_Cursor(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFreeCursor", "Display*");
+ Xen_check_type(Xen_is_Cursor(arg2), arg2, 2, "XFreeCursor", "Cursor");
+ return(C_int_to_Xen_integer(XFreeCursor(Xen_to_C_Display(arg1), Xen_to_C_Cursor(arg2))));
}
-static XEN gxm_XFreeColors(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XFreeColors(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XFreeColors "XFreeColors(display, colormap, pixels, npixels, planes) frees the cells represented by pixels whose values are in the pixels array."
/* DIFF: XFreeColors pixel array (arg3) is list of pixels
*/
unsigned long *ps;
int len, val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFreeColors", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XFreeColors", "Colormap");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XFreeColors", "list of pixel");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XFreeColors", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XFreeColors", "ulong");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) return(XEN_FALSE);
- ps = XEN_TO_C_Pixels(arg3, len);
- val = XFreeColors(XEN_TO_C_Display(arg1),
- XEN_TO_C_Colormap(arg2),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFreeColors", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XFreeColors", "Colormap");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XFreeColors", "list of pixel");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XFreeColors", "int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XFreeColors", "ulong");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) return(Xen_false);
+ ps = Xen_to_C_Pixels(arg3, len);
+ val = XFreeColors(Xen_to_C_Display(arg1),
+ Xen_to_C_Colormap(arg2),
ps, len,
- XEN_TO_C_ULONG(arg5));
+ Xen_ulong_to_C_ulong(arg5));
free(ps);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XFreeColormap(XEN arg1, XEN arg2)
+static Xen gxm_XFreeColormap(Xen arg1, Xen arg2)
{
#define H_XFreeColormap "XFreeColormap(display, colormap) deletes the association between the colormap resource ID and the colormap and \
frees the colormap storage."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFreeColormap", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XFreeColormap", "Colormap");
- return(C_TO_XEN_INT(XFreeColormap(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFreeColormap", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XFreeColormap", "Colormap");
+ return(C_int_to_Xen_integer(XFreeColormap(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2))));
}
-static XEN gxm_XFree(XEN arg1)
+static Xen gxm_XFree(Xen arg1)
{
#define H_XFree "XFree(data) is a general-purpose Xlib routine that frees the specified data."
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1) || XEN_LIST_P(arg1), arg1, 1, "XFree", "void* or xm entity");
- if (XEN_LIST_P(arg1))
- XFree((void *)XEN_UNWRAP_C_POINTER(XEN_CADR(arg1)));
- else XFree((void *)XEN_UNWRAP_C_POINTER(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1) || Xen_is_list(arg1), arg1, 1, "XFree", "void* or xm entity");
+
+ if (Xen_is_list(arg1))
+ XFree((void *)Xen_unwrap_C_pointer(Xen_cadr(arg1)));
+ else XFree((void *)Xen_unwrap_C_pointer(arg1));
+ return(Xen_false);
}
-static XEN gxm_XForceScreenSaver(XEN arg1, XEN arg2)
+static Xen gxm_XForceScreenSaver(Xen arg1, Xen arg2)
{
#define H_XForceScreenSaver "XForceScreenSaver(display, mode) activates the screen saver"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XForceScreenSaver", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XForceScreenSaver", "int");
- return(C_TO_XEN_INT(XForceScreenSaver(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XForceScreenSaver", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XForceScreenSaver", "int");
+ return(C_int_to_Xen_integer(XForceScreenSaver(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XFlush(XEN arg1)
+static Xen gxm_XFlush(Xen arg1)
{
#define H_XFlush "XFlush(display) flushes the output buffer."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFlush", "Display*");
- return(C_TO_XEN_INT(XFlush(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFlush", "Display*");
+ return(C_int_to_Xen_integer(XFlush(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XFillRectangles(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5)
+static Xen gxm_XFillRectangles(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5)
{
#define H_XFillRectangles "XFillRectangles(display, d, gc, rectangles, nrectangles)"
/* DIFF: XFillRectangles XRectangle* arg (arg 4) is list of XRectangles
*/
XRectangle *pt;
int i, len;
- XEN arg4;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFillRectangles", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XFillRectangles", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XFillRectangles", "GC");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg4), larg4, 4, "XFillRectangles", "list of XRectangle");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XFillRectangles", "int");
- arg4 = XEN_COPY_ARG(larg4);
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg5, 5, "XFillRectangles", "positive integer");
+ Xen arg4;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFillRectangles", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XFillRectangles", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XFillRectangles", "GC");
+ Xen_check_type(Xen_is_list(larg4), larg4, 4, "XFillRectangles", "list of XRectangle");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XFillRectangles", "int");
+ arg4 = Xen_copy_arg(larg4);
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) Xen_check_type(0, arg5, 5, "XFillRectangles", "positive integer");
pt = (XRectangle *)calloc(len, sizeof(XRectangle));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg4)); i++, arg4 = XEN_CDR(arg4))
+ for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
XRectangle *pt1;
- pt1 = XEN_TO_C_XRectangle(XEN_CAR(arg4));
+ pt1 = Xen_to_C_XRectangle(Xen_car(arg4));
pt[i].x = pt1->x;
pt[i].y = pt1->y;
pt[i].width = pt1->width;
pt[i].height = pt1->height;
}
- XFillRectangles(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
+ XFillRectangles(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
pt, len);
free(pt);
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XFillRectangle(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XFillRectangle(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XFillRectangle "XFillRectangle(display, d, gc, x, y, width, height)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFillRectangle", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XFillRectangle", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XFillRectangle", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XFillRectangle", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XFillRectangle", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XFillRectangle", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XFillRectangle", "unsigned int");
- return(C_TO_XEN_INT(XFillRectangle(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- XEN_TO_C_ULONG(arg6), XEN_TO_C_ULONG(arg7))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFillRectangle", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XFillRectangle", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XFillRectangle", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XFillRectangle", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XFillRectangle", "int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XFillRectangle", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XFillRectangle", "unsigned int");
+ return(C_int_to_Xen_integer(XFillRectangle(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3), Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ Xen_ulong_to_C_ulong(arg6), Xen_ulong_to_C_ulong(arg7))));
}
-static XEN gxm_XFillPolygon(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XFillPolygon(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XFillPolygon "XFillPolygon(display, d, gc, points, npoints, shape, mode)"
/* DIFF: XFillPolygon Point* arg (arg 4) is list of XPoint
*/
XPoint *pt, *pt1;
int i, len;
- XEN arg4;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFillPolygon", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XFillPolygon", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XFillPolygon", "GC");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg4), larg4, 4, "XFillPolygon", "list of XPoints");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XFillPolygon", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XFillPolygon", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XFillPolygon", "int");
- arg4 = XEN_COPY_ARG(larg4);
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg5, 5, "XFillPolygon", "positive integer");
+ Xen arg4;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFillPolygon", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XFillPolygon", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XFillPolygon", "GC");
+ Xen_check_type(Xen_is_list(larg4), larg4, 4, "XFillPolygon", "list of XPoints");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XFillPolygon", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XFillPolygon", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XFillPolygon", "int");
+ arg4 = Xen_copy_arg(larg4);
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) Xen_check_type(0, arg5, 5, "XFillPolygon", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg4)); i++, arg4 = XEN_CDR(arg4))
+ for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
- XEN xp;
- xp = XEN_CAR(arg4);
- if (!(XEN_XPoint_P(xp))) XEN_ASSERT_TYPE(0, xp, i, "XFillRegion", "XPoint");
- pt1 = XEN_TO_C_XPoint(xp);
+ Xen xp;
+ xp = Xen_car(arg4);
+ if (!(Xen_is_XPoint(xp))) Xen_check_type(0, xp, i, "XFillRegion", "XPoint");
+ pt1 = Xen_to_C_XPoint(xp);
pt[i].x = pt1->x;
pt[i].y = pt1->y;
}
- XFillPolygon(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
+ XFillPolygon(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
pt, len,
- XEN_TO_C_INT(arg6),
- XEN_TO_C_INT(arg7));
+ Xen_integer_to_C_int(arg6),
+ Xen_integer_to_C_int(arg7));
free(pt);
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XFillArcs(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5)
+static Xen gxm_XFillArcs(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5)
{
#define H_XFillArcs "XFillArcs(display, d, gc, arcs, narcs)"
/* DIFF: XFillArcs Arc* arg (arg 4) is list of XArcs
@@ -10532,265 +10253,265 @@ static XEN gxm_XFillArcs(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5)
Display *dpy;
Drawable draw;
GC gc;
- XEN arg4;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFillArcs", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XFillArcs", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XFillArcs", "GC");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg4), larg4, 4, "XFillArcs", "list of XArcs");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XFillArcs", "int");
- arg4 = XEN_COPY_ARG(larg4);
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) return(XEN_FALSE);
- dpy = XEN_TO_C_Display(arg1);
- draw = XEN_TO_C_Window(arg2);
- gc = XEN_TO_C_GC(arg3);
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg4)); i++, arg4 = XEN_CDR(arg4))
+ Xen arg4;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFillArcs", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XFillArcs", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XFillArcs", "GC");
+ Xen_check_type(Xen_is_list(larg4), larg4, 4, "XFillArcs", "list of XArcs");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XFillArcs", "int");
+ arg4 = Xen_copy_arg(larg4);
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) return(Xen_false);
+ dpy = Xen_to_C_Display(arg1);
+ draw = Xen_to_C_Window(arg2);
+ gc = Xen_to_C_GC(arg3);
+ for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
XArc *arc;
- arc = XEN_TO_C_XArc(XEN_CAR(arg4));
+ arc = Xen_to_C_XArc(Xen_car(arg4));
XFillArc(dpy, draw, gc, arc->x, arc->y, arc->width, arc->height, arc->angle1, arc->angle2);
}
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XFillArc(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8, XEN arg9)
+static Xen gxm_XFillArc(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8, Xen arg9)
{
#define H_XFillArc "XFillArc(display, d, gc, x, y, width, height, angle1, angle2) fills the region described by the specified arc."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFillArc", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XFillArc", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XFillArc", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XFillArc", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XFillArc", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XFillArc", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XFillArc", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XFillArc", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9), arg9, 9, "XFillArc", "int");
- return(C_TO_XEN_INT(XFillArc(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- XEN_TO_C_ULONG(arg6), XEN_TO_C_ULONG(arg7),
- XEN_TO_C_INT(arg8), XEN_TO_C_INT(arg9))));
-}
-
-static XEN gxm_XFetchName(XEN arg1, XEN arg2)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFillArc", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XFillArc", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XFillArc", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XFillArc", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XFillArc", "int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XFillArc", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XFillArc", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XFillArc", "int");
+ Xen_check_type(Xen_is_integer(arg9), arg9, 9, "XFillArc", "int");
+ return(C_int_to_Xen_integer(XFillArc(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3), Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ Xen_ulong_to_C_ulong(arg6), Xen_ulong_to_C_ulong(arg7),
+ Xen_integer_to_C_int(arg8), Xen_integer_to_C_int(arg9))));
+}
+
+static Xen gxm_XFetchName(Xen arg1, Xen arg2)
{
#define H_XFetchName "Status XFetchName(display, w): returns the name of the specified window."
/* DIFF: XFetchName omits and rtns arg3
*/
char *name;
int val;
- XEN str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFetchName", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XFetchName", "Window");
- val = XFetchName(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), &name);
+ Xen str;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFetchName", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XFetchName", "Window");
+ val = XFetchName(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), &name);
if (val == 0)
- return(XEN_FALSE);
- str = C_TO_XEN_STRING(name);
+ return(Xen_false);
+ str = C_string_to_Xen_string(name);
free(name);
return(str);
}
-static XEN gxm_XEventsQueued(XEN arg1, XEN arg2)
+static Xen gxm_XEventsQueued(Xen arg1, Xen arg2)
{
#define H_XEventsQueued "int XEventsQueued(display, mode)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XEventsQueued", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XEventsQueued", "int");
- return(C_TO_XEN_INT(XEventsQueued(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XEventsQueued", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XEventsQueued", "int");
+ return(C_int_to_Xen_integer(XEventsQueued(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XEnableAccessControl(XEN arg1)
+static Xen gxm_XEnableAccessControl(Xen arg1)
{
#define H_XEnableAccessControl "XEnableAccessControl(display) enables the use of the access control list at each connection setup."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XEnableAccessControl", "Display*");
- return(C_TO_XEN_INT(XEnableAccessControl(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XEnableAccessControl", "Display*");
+ return(C_int_to_Xen_integer(XEnableAccessControl(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XDrawText(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XDrawText(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XDrawText "XDrawText(display, d, gc, x, y, items, nitems) draws text"
int i, len = 0, res;
XTextItem *items;
- XEN lst;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawText", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawText", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawText", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XDrawText", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawText", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg6), arg6, 6, "XDrawText", "list of XTextItem");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg7), arg7, 7, "XDrawText", "int");
- lst = XEN_COPY_ARG(arg6);
- if (XEN_INTEGER_P(arg7)) len = XEN_TO_C_INT(arg7); else len = XEN_LIST_LENGTH(arg6);
+ Xen lst;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawText", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawText", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawText", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XDrawText", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawText", "int");
+ Xen_check_type(Xen_is_list(arg6), arg6, 6, "XDrawText", "list of XTextItem");
+ Xen_check_type(Xen_is_integer_or_unbound(arg7), arg7, 7, "XDrawText", "int");
+ lst = Xen_copy_arg(arg6);
+ if (Xen_is_integer(arg7)) len = Xen_integer_to_C_int(arg7); else len = Xen_list_length(arg6);
items = (XTextItem *)calloc(len, sizeof(XTextItem));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(lst)); i++, lst = XEN_CDR(lst))
+ for (i = 0; (i < len) && (!Xen_is_null(lst)); i++, lst = Xen_cdr(lst))
{
XTextItem *val;
- val = XEN_TO_C_XTextItem(XEN_CAR(lst));
+ val = Xen_to_C_XTextItem(Xen_car(lst));
items[i].chars = val->chars;
items[i].nchars = val->nchars;
items[i].delta = val->delta;
items[i].font = val->font;
}
- res = XDrawText(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
+ res = XDrawText(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
items, len);
free(items);
- return(C_TO_XEN_INT(res));
+ return(C_int_to_Xen_integer(res));
}
-static XEN gxm_XDrawString(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XDrawString(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XDrawString "XDrawString(display, d, gc, x, y, string, length)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawString", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawString", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawString", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XDrawString", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawString", "int");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg6), arg6, 6, "XDrawString", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XDrawString", "int");
- return(C_TO_XEN_INT(XDrawString(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- (char *)XEN_TO_C_STRING(arg6), XEN_TO_C_INT(arg7))));
-}
-
-static XEN gxm_XDrawSegments(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawString", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawString", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawString", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XDrawString", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawString", "int");
+ Xen_check_type(Xen_is_string(arg6), arg6, 6, "XDrawString", "char*");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XDrawString", "int");
+ return(C_int_to_Xen_integer(XDrawString(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ (char *)Xen_string_to_C_string(arg6), Xen_integer_to_C_int(arg7))));
+}
+
+static Xen gxm_XDrawSegments(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5)
{
#define H_XDrawSegments "XDrawSegments(display, d, gc, segments, nsegments) draws multiple, unconnected lines. "
/* DIFF: XDrawSegments XSegment* arg (arg 4) is list of XSegments
*/
XSegment *pt;
int i, len;
- XEN arg4;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawSegments", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawSegments", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawSegments", "GC");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg4), larg4, 4, "XDrawSegments", "list of XSegments");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawSegments", "int");
- arg4 = XEN_COPY_ARG(larg4);
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg5, 5, "XDrawSegments", "positive integer");
+ Xen arg4;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawSegments", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawSegments", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawSegments", "GC");
+ Xen_check_type(Xen_is_list(larg4), larg4, 4, "XDrawSegments", "list of XSegments");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawSegments", "int");
+ arg4 = Xen_copy_arg(larg4);
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) Xen_check_type(0, arg5, 5, "XDrawSegments", "positive integer");
pt = (XSegment *)calloc(len, sizeof(XSegment));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg4)); i++, arg4 = XEN_CDR(arg4))
+ for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
XSegment *pt1;
- pt1 = XEN_TO_C_XSegment(XEN_CAR(arg4));
+ pt1 = Xen_to_C_XSegment(Xen_car(arg4));
pt[i].x1 = pt1->x1;
pt[i].y1 = pt1->y1;
pt[i].x2 = pt1->x2;
pt[i].y2 = pt1->y2;
}
- XDrawSegments(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
+ XDrawSegments(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
pt, len);
free(pt);
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XDrawRectangles(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5)
+static Xen gxm_XDrawRectangles(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5)
{
#define H_XDrawRectangles "XDrawRectangles(display, d, gc, rectangles, nrectangles) draws the outlines of the specified rectangles."
/* DIFF: XDrawRectangles XRectangle* arg (arg 4) is list of XRectangles
*/
XRectangle *pt;
int i, len;
- XEN arg4;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawRectangles", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawRectangles", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawRectangles", "GC");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg4), larg4, 4, "XDrawRectangles", "list of XRectangles");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawRectangles", "int");
- arg4 = XEN_COPY_ARG(larg4);
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg5, 5, "XDrawRectangles", "positive integer");
+ Xen arg4;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawRectangles", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawRectangles", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawRectangles", "GC");
+ Xen_check_type(Xen_is_list(larg4), larg4, 4, "XDrawRectangles", "list of XRectangles");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawRectangles", "int");
+ arg4 = Xen_copy_arg(larg4);
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) Xen_check_type(0, arg5, 5, "XDrawRectangles", "positive integer");
pt = (XRectangle *)calloc(len, sizeof(XRectangle));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg4)); i++, arg4 = XEN_CDR(arg4))
+ for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
XRectangle *pt1;
- pt1 = XEN_TO_C_XRectangle(XEN_CAR(arg4));
+ pt1 = Xen_to_C_XRectangle(Xen_car(arg4));
pt[i].x = pt1->x;
pt[i].y = pt1->y;
pt[i].width = pt1->width;
pt[i].height = pt1->height;
}
- XDrawRectangles(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
+ XDrawRectangles(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
pt, len);
free(pt);
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XDrawRectangle(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XDrawRectangle(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XDrawRectangle "XDrawRectangle(display, d, gc, x, y, width, height) draws the outlines of the specified rectangle."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawRectangle", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawRectangle", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawRectangle", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XDrawRectangle", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawRectangle", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XDrawRectangle", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XDrawRectangle", "unsigned int");
- return(C_TO_XEN_INT(XDrawRectangle(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5), XEN_TO_C_ULONG(arg6), XEN_TO_C_ULONG(arg7))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawRectangle", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawRectangle", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawRectangle", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XDrawRectangle", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawRectangle", "int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XDrawRectangle", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XDrawRectangle", "unsigned int");
+ return(C_int_to_Xen_integer(XDrawRectangle(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5), Xen_ulong_to_C_ulong(arg6), Xen_ulong_to_C_ulong(arg7))));
}
-static XEN gxm_XDrawPoints(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5, XEN arg6)
+static Xen gxm_XDrawPoints(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5, Xen arg6)
{
#define H_XDrawPoints "XDrawPoints(display, d, gc, points, npoints, mode) draws multiple points."
/* DIFF: XDrawPoints XPoint* arg (arg 4) is list of XPoints
*/
XPoint *pt, *pt1;
int i, len;
- XEN arg4;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawPoints", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawPoints", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawPoints", "GC");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg4), larg4, 4, "XDrawPoints", "list of XPoints");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawPoints", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XDrawPoints", "int");
- arg4 = XEN_COPY_ARG(larg4);
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg5, 5, "XDrawPoints", "positive integer");
+ Xen arg4;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawPoints", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawPoints", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawPoints", "GC");
+ Xen_check_type(Xen_is_list(larg4), larg4, 4, "XDrawPoints", "list of XPoints");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawPoints", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XDrawPoints", "int");
+ arg4 = Xen_copy_arg(larg4);
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) Xen_check_type(0, arg5, 5, "XDrawPoints", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg4)); i++, arg4 = XEN_CDR(arg4))
+ for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
- XEN xp;
- xp = XEN_CAR(arg4);
- if (!(XEN_XPoint_P(xp))) XEN_ASSERT_TYPE(0, xp, i, "XDrawPoints", "XPoint");
- pt1 = XEN_TO_C_XPoint(xp);
+ Xen xp;
+ xp = Xen_car(arg4);
+ if (!(Xen_is_XPoint(xp))) Xen_check_type(0, xp, i, "XDrawPoints", "XPoint");
+ pt1 = Xen_to_C_XPoint(xp);
pt[i].x = pt1->x;
pt[i].y = pt1->y;
}
- XDrawPoints(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
+ XDrawPoints(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
pt, len,
- XEN_TO_C_INT(arg6));
+ Xen_integer_to_C_int(arg6));
free(pt);
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XDrawPoint(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XDrawPoint(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XDrawPoint "XDrawPoint(display, d, gc, x, y) uses the foreground pixel and function components of the GC to draw a single \
point into the specified drawable."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawPoint", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawPoint", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawPoint", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XDrawPoint", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawPoint", "int");
- return(C_TO_XEN_INT(XDrawPoint(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawPoint", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawPoint", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawPoint", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XDrawPoint", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawPoint", "int");
+ return(C_int_to_Xen_integer(XDrawPoint(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5))));
}
-static XEN gxm_XDrawLines(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5, XEN arg6)
+static Xen gxm_XDrawLines(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5, Xen arg6)
{
#define H_XDrawLines "XDrawLines(display, d, gc, points, npoints, mode) uses the components of the specified GC to draw npoints lines \
between each pair of points (point[i], point[i+1]) in the array of XPoint structures."
@@ -10798,121 +10519,121 @@ between each pair of points (point[i], point[i+1]) in the array of XPoint struct
*/
XPoint *pt, *pt1;
int i, len;
- XEN arg4;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawLines", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawLines", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawLines", "GC");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg4), larg4, 4, "XDrawLines", "list of XPoints");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawLines", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XDrawLines", "int");
- arg4 = XEN_COPY_ARG(larg4);
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg5, 5, "XDrawLines", "positive integer");
+ Xen arg4;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawLines", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawLines", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawLines", "GC");
+ Xen_check_type(Xen_is_list(larg4), larg4, 4, "XDrawLines", "list of XPoints");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawLines", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XDrawLines", "int");
+ arg4 = Xen_copy_arg(larg4);
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) Xen_check_type(0, arg5, 5, "XDrawLines", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg4)); i++, arg4 = XEN_CDR(arg4))
+ for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
- XEN xp;
- xp = XEN_CAR(arg4);
- if (!(XEN_XPoint_P(xp))) XEN_ASSERT_TYPE(0, xp, i, "XDrawLines", "XPoint");
- pt1 = XEN_TO_C_XPoint(xp);
+ Xen xp;
+ xp = Xen_car(arg4);
+ if (!(Xen_is_XPoint(xp))) Xen_check_type(0, xp, i, "XDrawLines", "XPoint");
+ pt1 = Xen_to_C_XPoint(xp);
pt[i].x = pt1->x;
pt[i].y = pt1->y;
}
- XDrawLines(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
+ XDrawLines(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
pt, len,
- XEN_TO_C_INT(arg6));
+ Xen_integer_to_C_int(arg6));
free(pt);
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XDrawLinesDirect(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XDrawLinesDirect(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XDrawLinesDirect "XDrawLinesDirect is the same as XDrawLines but takes an (opaque) pointer to an XPoint array"
XPoint *pt;
int len;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawLinesDirect", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawLinesDirect", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawLinesDirect", "GC");
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg4), arg4, 4, "XDrawLinesDirect", "array of XPoints");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawLines", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XDrawLines", "int");
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) return(XEN_FALSE);
- pt = (XPoint *)XEN_UNWRAP_C_POINTER(arg4);
- XDrawLines(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawLinesDirect", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawLinesDirect", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawLinesDirect", "GC");
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg4), arg4, 4, "XDrawLinesDirect", "array of XPoints");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawLines", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XDrawLines", "int");
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) return(Xen_false);
+ pt = (XPoint *)Xen_unwrap_C_pointer(arg4);
+ XDrawLines(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
pt, len,
- XEN_TO_C_INT(arg6));
- return(C_TO_XEN_INT(len));
+ Xen_integer_to_C_int(arg6));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_Vector2XPoints(XEN arg1)
+static Xen gxm_Vector2XPoints(Xen arg1)
{
#define H_vector2XPoints "(vector->XPoints vect) packages point data in vect as (opaque) array of XPoints"
int i, j, len;
/* vector assumed to be sequence of x y pairs (not XPoints from local view)
*/
XPoint *pt;
- XEN_ASSERT_TYPE(XEN_VECTOR_P(arg1), arg1, XEN_ONLY_ARG, "vector->XPoints", "vector of x,y values");
- len = XEN_VECTOR_LENGTH(arg1) / 2;
- if (len <= 0) XEN_ASSERT_TYPE(0, arg1, 1, "vector->XPoints", "positive integer");
+ Xen_check_type(Xen_is_vector(arg1), arg1, 1, "vector->XPoints", "vector of x,y values");
+ len = Xen_vector_length(arg1) / 2;
+ if (len <= 0) Xen_check_type(0, arg1, 1, "vector->XPoints", "positive integer");
pt = (XPoint *)calloc(len, sizeof(XPoint));
for (i = 0, j = 0; i < len; i++, j += 2)
{
- pt[i].x = XEN_TO_C_INT(XEN_VECTOR_REF(arg1, j));
- pt[i].y = XEN_TO_C_INT(XEN_VECTOR_REF(arg1, j + 1));
+ pt[i].x = Xen_integer_to_C_int(Xen_vector_ref(arg1, j));
+ pt[i].y = Xen_integer_to_C_int(Xen_vector_ref(arg1, j + 1));
}
- return(XEN_WRAP_C_POINTER(pt));
+ return(Xen_wrap_C_pointer(pt));
}
-static XEN gxm_FreeXPoints(XEN arg1)
+static Xen gxm_FreeXPoints(Xen arg1)
{
void *pts;
#define H_freeXPoints "(freeXPoints vect) frees an (opaque) XPoint array created by vector->Xpoints"
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1), arg1, XEN_ONLY_ARG, "freeXPoints", "opaque XPoint array");
- pts = (void *)(XEN_UNWRAP_C_POINTER(arg1));
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1), arg1, 1, "freeXPoints", "opaque XPoint array");
+ pts = (void *)(Xen_unwrap_C_pointer(arg1));
free(pts);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XDrawLine(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XDrawLine(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XDrawLine "XDrawLine(display, d, gc, x1, y1, x2, y2) uses the components of the specified GC to draw a line between the \
specified set of points (x1, y1) and (x2, y2)."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawLine", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawLine", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawLine", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XDrawLine", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawLine", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XDrawLine", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XDrawLine", "int");
- return(C_TO_XEN_INT(XDrawLine(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6), XEN_TO_C_INT(arg7))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawLine", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawLine", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawLine", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XDrawLine", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawLine", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XDrawLine", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XDrawLine", "int");
+ return(C_int_to_Xen_integer(XDrawLine(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6), Xen_integer_to_C_int(arg7))));
}
-static XEN gxm_XDrawImageString(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XDrawImageString(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XDrawImageString "XDrawImageString(display, d, gc, x, y, string, length)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawImageString", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawImageString", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawImageString", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XDrawImageString", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawImageString", "int");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg6), arg6, 6, "XDrawImageString", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XDrawImageString", "int");
- return(C_TO_XEN_INT(XDrawImageString(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5), (char *)XEN_TO_C_STRING(arg6), XEN_TO_C_INT(arg7))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawImageString", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawImageString", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawImageString", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XDrawImageString", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawImageString", "int");
+ Xen_check_type(Xen_is_string(arg6), arg6, 6, "XDrawImageString", "char*");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XDrawImageString", "int");
+ return(C_int_to_Xen_integer(XDrawImageString(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5), (char *)Xen_string_to_C_string(arg6), Xen_integer_to_C_int(arg7))));
}
-static XEN gxm_XDrawArcs(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5)
+static Xen gxm_XDrawArcs(Xen arg1, Xen arg2, Xen arg3, Xen larg4, Xen arg5)
{
#define H_XDrawArcs "XDrawArcs(display, d, gc, arcs, narcs) draws multiple circular or elliptical arcs."
/* DIFF: XDrawArcs Arc* arg (arg 4) is list of XArcs
@@ -10921,369 +10642,369 @@ static XEN gxm_XDrawArcs(XEN arg1, XEN arg2, XEN arg3, XEN larg4, XEN arg5)
Display *dpy;
Drawable draw;
GC gc;
- XEN arg4;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawArcs", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawArcs", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawArcs", "GC");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg4), larg4, 4, "XDrawArcs", "list of XArcs");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawArcs", "int");
- arg4 = XEN_COPY_ARG(larg4);
- len = XEN_TO_C_INT(arg5);
- dpy = XEN_TO_C_Display(arg1);
- draw = XEN_TO_C_Window(arg2);
- gc = XEN_TO_C_GC(arg3);
- for (i = 0; (i < len) && (XEN_NOT_NULL_P(arg4)); i++, arg4 = XEN_CDR(arg4))
+ Xen arg4;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawArcs", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawArcs", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawArcs", "GC");
+ Xen_check_type(Xen_is_list(larg4), larg4, 4, "XDrawArcs", "list of XArcs");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawArcs", "int");
+ arg4 = Xen_copy_arg(larg4);
+ len = Xen_integer_to_C_int(arg5);
+ dpy = Xen_to_C_Display(arg1);
+ draw = Xen_to_C_Window(arg2);
+ gc = Xen_to_C_GC(arg3);
+ for (i = 0; (i < len) && (!Xen_is_null(arg4)); i++, arg4 = Xen_cdr(arg4))
{
XArc *arc;
- arc = XEN_TO_C_XArc(XEN_CAR(arg4));
+ arc = Xen_to_C_XArc(Xen_car(arg4));
XDrawArc(dpy, draw, gc, arc->x, arc->y, arc->width, arc->height, arc->angle1, arc->angle2);
}
- return(C_TO_XEN_INT(len));
+ return(C_int_to_Xen_integer(len));
}
-static XEN gxm_XDrawArc(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8, XEN arg9)
+static Xen gxm_XDrawArc(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8, Xen arg9)
{
#define H_XDrawArc "XDrawArc(display, d, gc, x, y, width, height, angle1, angle2) draws a single circular or elliptical arc."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDrawArc", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDrawArc", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg3), arg3, 3, "XDrawArc", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XDrawArc", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XDrawArc", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XDrawArc", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XDrawArc", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XDrawArc", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9), arg9, 9, "XDrawArc", "int");
- return(C_TO_XEN_INT(XDrawArc(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_GC(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- XEN_TO_C_ULONG(arg6), XEN_TO_C_ULONG(arg7), XEN_TO_C_INT(arg8), XEN_TO_C_INT(arg9))));
-}
-
-static XEN gxm_XDisplayWidthMM(XEN arg1, XEN arg2)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDrawArc", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDrawArc", "Drawable");
+ Xen_check_type(Xen_is_GC(arg3), arg3, 3, "XDrawArc", "GC");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XDrawArc", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XDrawArc", "int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XDrawArc", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XDrawArc", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XDrawArc", "int");
+ Xen_check_type(Xen_is_integer(arg9), arg9, 9, "XDrawArc", "int");
+ return(C_int_to_Xen_integer(XDrawArc(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_GC(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ Xen_ulong_to_C_ulong(arg6), Xen_ulong_to_C_ulong(arg7), Xen_integer_to_C_int(arg8), Xen_integer_to_C_int(arg9))));
+}
+
+static Xen gxm_XDisplayWidthMM(Xen arg1, Xen arg2)
{
#define H_DisplayWidthMM "DisplayWidthMM(display, screen_number): returns the width of the specified screen in millimeters."
#define H_XDisplayWidthMM "XDisplayWidthMM(display, screen_number): returns the width of the specified screen in millimeters."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayWidthMM", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDisplayWidthMM", "int");
- return(C_TO_XEN_INT(XDisplayWidthMM(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayWidthMM", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDisplayWidthMM", "int");
+ return(C_int_to_Xen_integer(XDisplayWidthMM(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDisplayWidth(XEN arg1, XEN arg2)
+static Xen gxm_XDisplayWidth(Xen arg1, Xen arg2)
{
#define H_DisplayWidth "DisplayWidth(display, screen_number): returns the width of the screen in pixels."
#define H_XDisplayWidth "XDisplayWidth(display, screen_number): returns the width of the screen in pixels."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayWidth", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDisplayWidth", "int");
- return(C_TO_XEN_INT(XDisplayWidth(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayWidth", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDisplayWidth", "int");
+ return(C_int_to_Xen_integer(XDisplayWidth(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDisplayPlanes(XEN arg1, XEN arg2)
+static Xen gxm_XDisplayPlanes(Xen arg1, Xen arg2)
{
#define H_DisplayPlanes "DisplayPlanes(display, screen_number): returns the depth of the root window of the specified screen."
#define H_XDisplayPlanes "XDisplayPlanes(display, screen_number): returns the depth of the root window of the specified screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayPlanes", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDisplayPlanes", "int");
- return(C_TO_XEN_INT(XDisplayPlanes(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayPlanes", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDisplayPlanes", "int");
+ return(C_int_to_Xen_integer(XDisplayPlanes(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDisplayKeycodes(XEN arg1)
+static Xen gxm_XDisplayKeycodes(Xen arg1)
{
#define H_XDisplayKeycodes "XDisplayKeycodes(display): returns the min-keycodes and max-keycodes supported by the specified display."
/* DIFF: XDisplayKeycodes omit and rtn arg 2 and 3
*/
int m1, m2, val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayKeycodes", "Display*");
- val = XDisplayKeycodes(XEN_TO_C_Display(arg1), &m1, &m2);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_INT(m1),
- C_TO_XEN_INT(m2)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayKeycodes", "Display*");
+ val = XDisplayKeycodes(Xen_to_C_Display(arg1), &m1, &m2);
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_int_to_Xen_integer(m1),
+ C_int_to_Xen_integer(m2)));
}
-static XEN gxm_XDisplayHeightMM(XEN arg1, XEN arg2)
+static Xen gxm_XDisplayHeightMM(Xen arg1, Xen arg2)
{
#define H_DisplayHeightMM "DisplayHeightMM(display, screen_number): returns the height of the specified screen in millimeters."
#define H_XDisplayHeightMM "XDisplayHeightMM(display, screen_number): returns the height of the specified screen in millimeters."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayHeightMM", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDisplayHeightMM", "int");
- return(C_TO_XEN_INT(XDisplayHeightMM(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayHeightMM", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDisplayHeightMM", "int");
+ return(C_int_to_Xen_integer(XDisplayHeightMM(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDisplayHeight(XEN arg1, XEN arg2)
+static Xen gxm_XDisplayHeight(Xen arg1, Xen arg2)
{
#define H_DisplayHeight "DisplayHeight(display, screen_number): returns the height of the specified screen in pixels."
#define H_XDisplayHeight "XDisplayHeight(display, screen_number): returns the height of the specified screen in pixels."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayHeight", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDisplayHeight", "int");
- return(C_TO_XEN_INT(XDisplayHeight(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayHeight", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDisplayHeight", "int");
+ return(C_int_to_Xen_integer(XDisplayHeight(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDisplayCells(XEN arg1, XEN arg2)
+static Xen gxm_XDisplayCells(Xen arg1, Xen arg2)
{
#define H_DisplayCells "DisplayCells(display, screen_number): returns the number of entries in the default colormap."
#define H_XDisplayCells "XDisplayCells(display, screen_number): returns the number of entries in the default colormap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayCells", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDisplayCells", "int");
- return(C_TO_XEN_INT(XDisplayCells(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayCells", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDisplayCells", "int");
+ return(C_int_to_Xen_integer(XDisplayCells(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDisableAccessControl(XEN arg1)
+static Xen gxm_XDisableAccessControl(Xen arg1)
{
#define H_XDisableAccessControl "XDisableAccessControl(display) disables the use of the access control list at each connection setup."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisableAccessControl", "Display*");
- return(C_TO_XEN_INT(XDisableAccessControl(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisableAccessControl", "Display*");
+ return(C_int_to_Xen_integer(XDisableAccessControl(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XDoesSaveUnders(XEN arg1)
+static Xen gxm_XDoesSaveUnders(Xen arg1)
{
#define H_DoesSaveUnders "DoesSaveUnders(screen): returns a Boolean value indicating whether the screen supports save unders."
#define H_XDoesSaveUnders "XDoesSaveUnders(screen): returns a Boolean value indicating whether the screen supports save unders."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XDoesSaveUnders", "Screen*");
- return(C_TO_XEN_BOOLEAN(XDoesSaveUnders(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XDoesSaveUnders", "Screen*");
+ return(C_bool_to_Xen_boolean(XDoesSaveUnders(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDoesBackingStore(XEN arg1)
+static Xen gxm_XDoesBackingStore(Xen arg1)
{
#define H_DoesBackingStore "DoesBackingStore(screen): returns WhenMapped, NotUseful,or Always,which indicate whether the screen supports backing stores."
#define H_XDoesBackingStore "XDoesBackingStore(screen): returns WhenMapped, NotUseful,or Always,which indicate whether the screen supports backing stores."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XDoesBackingStore", "Screen*");
- return(C_TO_XEN_BOOLEAN(XDoesBackingStore(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XDoesBackingStore", "Screen*");
+ return(C_bool_to_Xen_boolean(XDoesBackingStore(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDestroySubwindows(XEN arg1, XEN arg2)
+static Xen gxm_XDestroySubwindows(Xen arg1, Xen arg2)
{
#define H_XDestroySubwindows "XDestroySubwindows(display, w) destroys all inferior windows of the specified window, in bottom-to-top stacking order."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDestroySubwindows", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDestroySubwindows", "Window");
- return(C_TO_XEN_INT(XDestroySubwindows(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDestroySubwindows", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDestroySubwindows", "Window");
+ return(C_int_to_Xen_integer(XDestroySubwindows(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XDestroyWindow(XEN arg1, XEN arg2)
+static Xen gxm_XDestroyWindow(Xen arg1, Xen arg2)
{
#define H_XDestroyWindow "XDestroyWindow(display, w) destroys the specified window as well as all of its subwindows and causes the X server \
to generate a DestroyNotify event for each window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDestroyWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDestroyWindow", "Window");
- return(C_TO_XEN_INT(XDestroyWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDestroyWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDestroyWindow", "Window");
+ return(C_int_to_Xen_integer(XDestroyWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XDeleteProperty(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XDeleteProperty(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XDeleteProperty "XDeleteProperty(display, w, property) deletes the specified property only if the property was defined on the specified \
window and causes the X server to generate a PropertyNotify event on the window unless the property does not exist."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDeleteProperty", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDeleteProperty", "Window");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XDeleteProperty", "Atom");
- return(C_TO_XEN_INT(XDeleteProperty(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Atom(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDeleteProperty", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDeleteProperty", "Window");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XDeleteProperty", "Atom");
+ return(C_int_to_Xen_integer(XDeleteProperty(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Atom(arg3))));
}
-static XEN gxm_XDefineCursor(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XDefineCursor(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XDefineCursor "XDefineCursor(display, w, cursor)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDefineCursor", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XDefineCursor", "Window");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg3), arg3, 3, "XDefineCursor", "Cursor");
- return(C_TO_XEN_INT(XDefineCursor(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Cursor(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDefineCursor", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XDefineCursor", "Window");
+ Xen_check_type(Xen_is_Cursor(arg3), arg3, 3, "XDefineCursor", "Cursor");
+ return(C_int_to_Xen_integer(XDefineCursor(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Cursor(arg3))));
}
-static XEN gxm_XDefaultScreen(XEN arg1)
+static Xen gxm_XDefaultScreen(Xen arg1)
{
#define H_XDefaultScreen "XDefaultScreen(display)"
#define H_XDefaultScreenOfDisplay "returns the default screen of the specified display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDefaultScreen", "Display*");
- return(C_TO_XEN_INT(XDefaultScreen(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDefaultScreen", "Display*");
+ return(C_int_to_Xen_integer(XDefaultScreen(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XDefaultDepthOfScreen(XEN arg1)
+static Xen gxm_XDefaultDepthOfScreen(Xen arg1)
{
#define H_DefaultDepthOfScreen "returns the default depth of the root window of the specified screen."
#define H_XDefaultDepthOfScreen "returns the default depth of the root window of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XDefaultDepthOfScreen", "Screen*");
- return(C_TO_XEN_INT(XDefaultDepthOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XDefaultDepthOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XDefaultDepthOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDefaultDepth(XEN arg1, XEN arg2)
+static Xen gxm_XDefaultDepth(Xen arg1, Xen arg2)
{
#define H_DefaultDepth "returns the depth (number of planes) of the default root window for the specified screen."
#define H_XDefaultDepth "returns the depth (number of planes) of the default root window for the specified screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDefaultDepth", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDefaultDepth", "int");
- return(C_TO_XEN_INT(XDefaultDepth(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDefaultDepth", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDefaultDepth", "int");
+ return(C_int_to_Xen_integer(XDefaultDepth(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XCopyPlane(XEN args)
+static Xen gxm_XCopyPlane(Xen args)
{
#define H_XCopyPlane "XCopyPlane(display, src, dest, gc, src_x, src_y, width, height, dest_x, dest_y, plane) uses a single bit plane of the \
specified source rectangle combined with the specified GC to modify the specified rectangle of dest."
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- arg11 = XEN_LIST_REF(args, 10);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCopyPlane", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCopyPlane", "Drawable");
- XEN_ASSERT_TYPE(XEN_Window_P(arg3), arg3, 3, "XCopyPlane", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg4), arg4, 4, "XCopyPlane", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XCopyPlane", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XCopyPlane", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XCopyPlane", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg8), arg8, 8, "XCopyPlane", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9), arg9, 9, "XCopyPlane", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg10), arg10, 10, "XCopyPlane", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg11), arg11, 11, "XCopyPlane", "ulong");
- return(C_TO_XEN_INT(XCopyPlane(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_Window(arg3),
- XEN_TO_C_GC(arg4),
- XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6), XEN_TO_C_ULONG(arg7),
- XEN_TO_C_ULONG(arg8), XEN_TO_C_INT(arg9),
- XEN_TO_C_INT(arg10), XEN_TO_C_ULONG(arg11))));
-}
-
-static XEN gxm_XCopyGC(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ arg11 = Xen_list_ref(args, 10);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCopyPlane", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCopyPlane", "Drawable");
+ Xen_check_type(Xen_is_Window(arg3), arg3, 3, "XCopyPlane", "Drawable");
+ Xen_check_type(Xen_is_GC(arg4), arg4, 4, "XCopyPlane", "GC");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XCopyPlane", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XCopyPlane", "int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XCopyPlane", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg8), arg8, 8, "XCopyPlane", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg9), arg9, 9, "XCopyPlane", "int");
+ Xen_check_type(Xen_is_integer(arg10), arg10, 10, "XCopyPlane", "int");
+ Xen_check_type(Xen_is_ulong(arg11), arg11, 11, "XCopyPlane", "ulong");
+ return(C_int_to_Xen_integer(XCopyPlane(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_Window(arg3),
+ Xen_to_C_GC(arg4),
+ Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6), Xen_ulong_to_C_ulong(arg7),
+ Xen_ulong_to_C_ulong(arg8), Xen_integer_to_C_int(arg9),
+ Xen_integer_to_C_int(arg10), Xen_ulong_to_C_ulong(arg11))));
+}
+
+static Xen gxm_XCopyGC(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XCopyGC "XCopyGC(display, src, valuemask, dest) copies the specified components from the source GC to the destination GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCopyGC", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XCopyGC", "GC");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XCopyGC", "ulong");
- XEN_ASSERT_TYPE(XEN_GC_P(arg4), arg4, 4, "XCopyGC", "GC");
- return(C_TO_XEN_INT(XCopyGC(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_ULONG(arg3), XEN_TO_C_GC(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCopyGC", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XCopyGC", "GC");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XCopyGC", "ulong");
+ Xen_check_type(Xen_is_GC(arg4), arg4, 4, "XCopyGC", "GC");
+ return(C_int_to_Xen_integer(XCopyGC(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_ulong_to_C_ulong(arg3), Xen_to_C_GC(arg4))));
}
-static XEN gxm_XCopyArea(XEN args)
+static Xen gxm_XCopyArea(Xen args)
{
#define H_XCopyArea "XCopyArea(display, src, dest, gc, src_x, src_y, width, height, dest_x, dest_y) combines the specified rectangle of src \
with the specified rectangle of dest."
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCopyArea", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCopyArea", "Drawable");
- XEN_ASSERT_TYPE(XEN_Window_P(arg3), arg3, 3, "XCopyArea", "Drawable");
- XEN_ASSERT_TYPE(XEN_GC_P(arg4), arg4, 4, "XCopyArea", "GC");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XCopyArea", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XCopyArea", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XCopyArea", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg8), arg8, 8, "XCopyArea", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9), arg9, 9, "XCopyArea", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg10), arg10, 10, "XCopyArea", "int");
- return(C_TO_XEN_INT(XCopyArea(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_Window(arg3),
- XEN_TO_C_GC(arg4),
- XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6), XEN_TO_C_ULONG(arg7),
- XEN_TO_C_ULONG(arg8), XEN_TO_C_INT(arg9), XEN_TO_C_INT(arg10))));
-}
-
-static XEN gxm_XConvertSelection(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCopyArea", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCopyArea", "Drawable");
+ Xen_check_type(Xen_is_Window(arg3), arg3, 3, "XCopyArea", "Drawable");
+ Xen_check_type(Xen_is_GC(arg4), arg4, 4, "XCopyArea", "GC");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XCopyArea", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XCopyArea", "int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XCopyArea", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg8), arg8, 8, "XCopyArea", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg9), arg9, 9, "XCopyArea", "int");
+ Xen_check_type(Xen_is_integer(arg10), arg10, 10, "XCopyArea", "int");
+ return(C_int_to_Xen_integer(XCopyArea(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_Window(arg3),
+ Xen_to_C_GC(arg4),
+ Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6), Xen_ulong_to_C_ulong(arg7),
+ Xen_ulong_to_C_ulong(arg8), Xen_integer_to_C_int(arg9), Xen_integer_to_C_int(arg10))));
+}
+
+static Xen gxm_XConvertSelection(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XConvertSelection "void XConvertSelection(display, selection, target, property, requestor, time)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XConvertSelection", "Display*");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XConvertSelection", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XConvertSelection", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg4), arg4, 4, "XConvertSelection", "Atom");
- XEN_ASSERT_TYPE(XEN_Window_P(arg5), arg5, 5, "XConvertSelection", "Window");
- XEN_ASSERT_TYPE(XEN_Time_P(arg6), arg6, 6, "XConvertSelection", "Time");
- return(C_TO_XEN_INT(XConvertSelection(XEN_TO_C_Display(arg1),
- XEN_TO_C_Atom(arg2), XEN_TO_C_Atom(arg3), XEN_TO_C_Atom(arg4),
- XEN_TO_C_Window(arg5), XEN_TO_C_Time(arg6))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XConvertSelection", "Display*");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XConvertSelection", "Atom");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XConvertSelection", "Atom");
+ Xen_check_type(Xen_is_Atom(arg4), arg4, 4, "XConvertSelection", "Atom");
+ Xen_check_type(Xen_is_Window(arg5), arg5, 5, "XConvertSelection", "Window");
+ Xen_check_type(Xen_is_Time(arg6), arg6, 6, "XConvertSelection", "Time");
+ return(C_int_to_Xen_integer(XConvertSelection(Xen_to_C_Display(arg1),
+ Xen_to_C_Atom(arg2), Xen_to_C_Atom(arg3), Xen_to_C_Atom(arg4),
+ Xen_to_C_Window(arg5), Xen_to_C_Time(arg6))));
}
-static XEN gxm_XConnectionNumber(XEN arg1)
+static Xen gxm_XConnectionNumber(Xen arg1)
{
#define H_XConnectionNumber "returns a connection number for the specified display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XConnectionNumber", "Display*");
- return(C_TO_XEN_INT(XConnectionNumber(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XConnectionNumber", "Display*");
+ return(C_int_to_Xen_integer(XConnectionNumber(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XConfigureWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XConfigureWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XConfigureWindow "XConfigureWindow(display, w, value_mask, values) uses the values specified in the XWindowChanges structure to \
reconfigure a window's size, position, border, and stacking order."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XConfigureWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XConfigureWindow", "Window");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XConfigureWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_XWindowChanges_P(arg4), arg4, 4, "XConfigureWindow", "XWindowChanges*");
- return(C_TO_XEN_INT(XConfigureWindow(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2), XEN_TO_C_ULONG(arg3), XEN_TO_C_XWindowChanges(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XConfigureWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XConfigureWindow", "Window");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XConfigureWindow", "unsigned int");
+ Xen_check_type(Xen_is_XWindowChanges(arg4), arg4, 4, "XConfigureWindow", "XWindowChanges*");
+ return(C_int_to_Xen_integer(XConfigureWindow(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2), Xen_ulong_to_C_ulong(arg3), Xen_to_C_XWindowChanges(arg4))));
}
-static XEN gxm_XCloseDisplay(XEN arg1)
+static Xen gxm_XCloseDisplay(Xen arg1)
{
#define H_XCloseDisplay "XCloseDisplay(display) closes the connection to the X server for the display specified in the Display structure and \
destroys all windows, resource IDs etc."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCloseDisplay", "Display*");
- return(C_TO_XEN_INT(XCloseDisplay(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCloseDisplay", "Display*");
+ return(C_int_to_Xen_integer(XCloseDisplay(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XClearWindow(XEN arg1, XEN arg2)
+static Xen gxm_XClearWindow(Xen arg1, Xen arg2)
{
#define H_XClearWindow "XClearWindow(display, w) clears the entire area in the specified window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XClearWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XClearWindow", "Window");
- return(C_TO_XEN_INT(XClearWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XClearWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XClearWindow", "Window");
+ return(C_int_to_Xen_integer(XClearWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XClearArea(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XClearArea(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XClearArea "XClearArea(display, w, x, y, width, height, exposures) paints a rectangular area in the specified window according to the \
specified dimensions with the window's background pixel or pixmap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XClearArea", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XClearArea", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XClearArea", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XClearArea", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XClearArea", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XClearArea", "unsigned int");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg7), arg7, 7, "XClearArea", "Bool");
- return(C_TO_XEN_INT(XClearArea(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4),
- XEN_TO_C_ULONG(arg5), XEN_TO_C_ULONG(arg6), XEN_TO_C_BOOLEAN(arg7))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XClearArea", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XClearArea", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XClearArea", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XClearArea", "int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XClearArea", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XClearArea", "unsigned int");
+ Xen_check_type(Xen_is_boolean(arg7), arg7, 7, "XClearArea", "Bool");
+ return(C_int_to_Xen_integer(XClearArea(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4),
+ Xen_ulong_to_C_ulong(arg5), Xen_ulong_to_C_ulong(arg6), Xen_boolean_to_C_bool(arg7))));
}
-static XEN gxm_XCirculateSubwindowsUp(XEN arg1, XEN arg2)
+static Xen gxm_XCirculateSubwindowsUp(Xen arg1, Xen arg2)
{
#define H_XCirculateSubwindowsUp "XCirculateSubwindowsUp(display, w) raises the lowest mapped child of the specified window that is partially or \
completely occluded by another child."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCirculateSubwindowsUp", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCirculateSubwindowsUp", "Window");
- return(C_TO_XEN_INT(XCirculateSubwindowsUp(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCirculateSubwindowsUp", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCirculateSubwindowsUp", "Window");
+ return(C_int_to_Xen_integer(XCirculateSubwindowsUp(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XCirculateSubwindowsDown(XEN arg1, XEN arg2)
+static Xen gxm_XCirculateSubwindowsDown(Xen arg1, Xen arg2)
{
#define H_XCirculateSubwindowsDown "XCirculateSubwindowsDown(display, w) lowers the highest mapped child of the specified window that partially or \
completely occludes another child."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCirculateSubwindowsDown", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCirculateSubwindowsDown", "Window");
- return(C_TO_XEN_INT(XCirculateSubwindowsDown(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCirculateSubwindowsDown", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCirculateSubwindowsDown", "Window");
+ return(C_int_to_Xen_integer(XCirculateSubwindowsDown(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XCirculateSubwindows(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XCirculateSubwindows(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XCirculateSubwindows "XCirculateSubwindows(display, w, direction) circulates children of the specified window in the specified direction."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCirculateSubwindows", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCirculateSubwindows", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XCirculateSubwindows", "int");
- return(C_TO_XEN_INT(XCirculateSubwindows(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCirculateSubwindows", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCirculateSubwindows", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XCirculateSubwindows", "int");
+ return(C_int_to_Xen_integer(XCirculateSubwindows(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XCheckWindowEvent(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XCheckWindowEvent(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XCheckWindowEvent "Bool XCheckWindowEvent(display, w, event_mask) searches the event queue and then the events available \
on the server connection for the first event that matches the specified window and event mask."
@@ -11291,21 +11012,21 @@ on the server connection for the first event that matches the specified window a
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCheckWindowEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCheckWindowEvent", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XCheckWindowEvent", "long");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCheckWindowEvent", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCheckWindowEvent", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XCheckWindowEvent", "long");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XCheckWindowEvent(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3), e);
+ val = XCheckWindowEvent(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3), e);
if (val)
- return(C_TO_XEN_XEvent_OBJ(e));
+ return(C_to_Xen_XEvent_OBJ(e));
else
{
free(e);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxm_XCheckTypedWindowEvent(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XCheckTypedWindowEvent(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XCheckTypedWindowEvent "Bool XCheckTypedWindowEvent(display, w, event_type) searches the event queue and then any events \
available on the server connection for the first event that matches the specified event mask"
@@ -11313,21 +11034,21 @@ available on the server connection for the first event that matches the specifie
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCheckTypedWindowEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCheckTypedWindowEvent", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XCheckTypedWindowEvent", "int");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCheckTypedWindowEvent", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCheckTypedWindowEvent", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XCheckTypedWindowEvent", "int");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XCheckTypedWindowEvent(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3), e);
+ val = XCheckTypedWindowEvent(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3), e);
if (val)
- return(C_TO_XEN_XEvent_OBJ(e));
+ return(C_to_Xen_XEvent_OBJ(e));
else
{
free(e);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxm_XCheckTypedEvent(XEN arg1, XEN arg2)
+static Xen gxm_XCheckTypedEvent(Xen arg1, Xen arg2)
{
#define H_XCheckTypedEvent "Bool XCheckTypedEvent(display, event_type) searches the event queue and then any events available \
on the server connection for the first event that matches the specified type."
@@ -11335,20 +11056,20 @@ on the server connection for the first event that matches the specified type."
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCheckTypedEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XCheckTypedEvent", "int");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCheckTypedEvent", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XCheckTypedEvent", "int");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XCheckTypedEvent(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), e);
+ val = XCheckTypedEvent(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), e);
if (val)
- return(C_TO_XEN_XEvent_OBJ(e));
+ return(C_to_Xen_XEvent_OBJ(e));
else
{
free(e);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxm_XCheckMaskEvent(XEN arg1, XEN arg2)
+static Xen gxm_XCheckMaskEvent(Xen arg1, Xen arg2)
{
#define H_XCheckMaskEvent "Bool XCheckMaskEvent(display, event_mask) searches the event queue and then any events available on \
the server connection for the first event that matches the specified mask."
@@ -11356,105 +11077,105 @@ the server connection for the first event that matches the specified mask."
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCheckMaskEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XCheckMaskEvent", "long");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCheckMaskEvent", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XCheckMaskEvent", "long");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XCheckMaskEvent(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), e);
+ val = XCheckMaskEvent(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), e);
if (val)
- return(C_TO_XEN_XEvent_OBJ(e));
+ return(C_to_Xen_XEvent_OBJ(e));
else
{
free(e);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxm_XCheckIfEvent(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XCheckIfEvent(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XCheckIfEvent "Bool XCheckIfEvent(display, predicate, arg)"
/* DIFF: XCheckIfEvent dpy [ev] proc ptr -> (list val ev)
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCheckIfEvent", "Display*");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg2) && (XEN_REQUIRED_ARGS_OK(arg2, 3)), arg2, 2, "XCheckIfEvent", "(Bool_Proc dpy ev data)");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCheckIfEvent", "Display*");
+ Xen_check_type(Xen_is_procedure(arg2) && (Xen_is_aritable(arg2, 3)), arg2, 2, "XCheckIfEvent", "(Bool_Proc dpy ev data)");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XCheckIfEvent(XEN_TO_C_Display(arg1),
+ val = XCheckIfEvent(Xen_to_C_Display(arg1),
e,
(Bool (*)(Display *d, XEvent *ev, char *p))gxm_XPeekIfEventProc,
(char*)arg3);
if (val)
- return(C_TO_XEN_XEvent_OBJ(e));
+ return(C_to_Xen_XEvent_OBJ(e));
else
{
free(e);
- return(XEN_FALSE);
+ return(Xen_false);
}
}
-static XEN gxm_XChangeWindowAttributes(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XChangeWindowAttributes(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XChangeWindowAttributes "XChangeWindowAttributes(display, w, valuemask, attributes) uses the window attributes in the XSetWindowAttributes \
structure to change the specified window attributes."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XChangeWindowAttributes", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XChangeWindowAttributes", "Window");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XChangeWindowAttributes", "ulong");
- XEN_ASSERT_TYPE(XEN_XSetWindowAttributes_P(arg4), arg4, 4, "XChangeWindowAttributes", "XSetWindowAttributes*");
- return(C_TO_XEN_INT(XChangeWindowAttributes(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_ULONG(arg3),
- XEN_TO_C_XSetWindowAttributes(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XChangeWindowAttributes", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XChangeWindowAttributes", "Window");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XChangeWindowAttributes", "ulong");
+ Xen_check_type(Xen_is_XSetWindowAttributes(arg4), arg4, 4, "XChangeWindowAttributes", "XSetWindowAttributes*");
+ return(C_int_to_Xen_integer(XChangeWindowAttributes(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_ulong_to_C_ulong(arg3),
+ Xen_to_C_XSetWindowAttributes(arg4))));
}
-static XEN gxm_XChangeProperty(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+static Xen gxm_XChangeProperty(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
#define H_XChangeProperty "XChangeProperty(display, w, property, type, format, mode, data, nelements) alters the property for the specified \
window and causes the X server to generate a PropertyNotify event on that window."
unsigned char *command;
int len;
int *data = NULL;
- XEN rtn;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XChangeProperty", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XChangeProperty", "Window");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XChangeProperty", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg4), arg4, 4, "XChangeProperty", "Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XChangeProperty", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XChangeProperty", "int");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg7) || XEN_LIST_P(arg7), arg7, 7, "XChangeProperty", "string or list of int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg8), arg8, 8, "XChangeProperty", "int");
- if (XEN_STRING_P(arg7))
+ Xen rtn;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XChangeProperty", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XChangeProperty", "Window");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XChangeProperty", "Atom");
+ Xen_check_type(Xen_is_Atom(arg4), arg4, 4, "XChangeProperty", "Atom");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XChangeProperty", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XChangeProperty", "int");
+ Xen_check_type(Xen_is_string(arg7) || Xen_is_list(arg7), arg7, 7, "XChangeProperty", "string or list of int");
+ Xen_check_type(Xen_is_integer_or_unbound(arg8), arg8, 8, "XChangeProperty", "int");
+ if (Xen_is_string(arg7))
{
- command = (unsigned char *)(XEN_TO_C_STRING(arg7));
- if (XEN_INTEGER_P(arg8)) len = XEN_TO_C_INT(arg8); else len = strlen((const char *)command) + 1;
+ command = (unsigned char *)(Xen_string_to_C_string(arg7));
+ if (Xen_is_integer(arg8)) len = Xen_integer_to_C_int(arg8); else len = strlen((const char *)command) + 1;
}
else
{
- if (XEN_INTEGER_P(arg8)) len = XEN_TO_C_INT(arg8); else len = XEN_LIST_LENGTH(arg7);
- data = XEN_TO_C_Ints(arg7, len);
+ if (Xen_is_integer(arg8)) len = Xen_integer_to_C_int(arg8); else len = Xen_list_length(arg7);
+ data = Xen_to_C_Ints(arg7, len);
command = (unsigned char *)data;
}
- rtn = C_TO_XEN_INT(XChangeProperty(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_Atom(arg3), XEN_TO_C_Atom(arg4),
- XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6),
+ rtn = C_int_to_Xen_integer(XChangeProperty(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_to_C_Atom(arg3), Xen_to_C_Atom(arg4),
+ Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6),
(const unsigned char *)command, len));
if (data) free(data);
return(rtn);
}
-static XEN gxm_XChangePointerControl(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XChangePointerControl(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XChangePointerControl "XChangePointerControl(display, do_accel, do_threshold, accel_numerator, accel_denominator, threshold) \
defines how the pointing device moves."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XChangePointerControl", "Display*");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XChangePointerControl", "Bool");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XChangePointerControl", "Bool");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XChangePointerControl", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XChangePointerControl", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XChangePointerControl", "int");
- return(C_TO_XEN_INT(XChangePointerControl(XEN_TO_C_Display(arg1),
- XEN_TO_C_BOOLEAN(arg2), XEN_TO_C_BOOLEAN(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XChangePointerControl", "Display*");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XChangePointerControl", "Bool");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XChangePointerControl", "Bool");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XChangePointerControl", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XChangePointerControl", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XChangePointerControl", "int");
+ return(C_int_to_Xen_integer(XChangePointerControl(Xen_to_C_Display(arg1),
+ Xen_boolean_to_C_bool(arg2), Xen_boolean_to_C_bool(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6))));
}
-static XEN gxm_XChangeKeyboardMapping(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XChangeKeyboardMapping(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XChangeKeyboardMapping "XChangeKeyboardMapping(display, first_keycode, keysyms_per_keycode, keysyms, num_codes) defines the \
symbols for the specified number of KeyCodes starting with first_keycode."
@@ -11462,279 +11183,279 @@ symbols for the specified number of KeyCodes starting with first_keycode."
*/
KeySym *ks;
int len, val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XChangeKeyboardMapping", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XChangeKeyboardMapping", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XChangeKeyboardMapping", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XChangeKeyboardMapping", "list of KeySym");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XChangeKeyboardMapping", "int");
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) return(XEN_FALSE);
- ks = XEN_TO_C_KeySyms(arg4, len);
- val = XChangeKeyboardMapping(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), ks, len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XChangeKeyboardMapping", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XChangeKeyboardMapping", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XChangeKeyboardMapping", "int");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XChangeKeyboardMapping", "list of KeySym");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XChangeKeyboardMapping", "int");
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) return(Xen_false);
+ ks = Xen_to_C_KeySyms(arg4, len);
+ val = XChangeKeyboardMapping(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), ks, len);
free(ks);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XChangeKeyboardControl(XEN arg1, XEN arg2, XEN larg3)
+static Xen gxm_XChangeKeyboardControl(Xen arg1, Xen arg2, Xen larg3)
{
#define H_XChangeKeyboardControl "XChangeKeyboardControl(display, value_mask, values) controls the keyboard characteristics defined by \
the XKeyboardControl structure."
/* DIFF: XChangeKeyboardControl arg3 is list of XKeyboardControl fields
*/
- XEN arg3;
+ Xen arg3;
XKeyboardControl kc;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XChangeKeyboardControl", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XChangeKeyboardControl", "ulong");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg3), larg3, 3, "XChangeKeyboardControl", "XKeyboardControl*");
- arg3 = XEN_COPY_ARG(larg3);
- kc.key_click_percent = XEN_TO_C_INT(XEN_CAR(arg3)); arg3 = XEN_CDR(arg3);
- if (!(XEN_NULL_P(arg3)))
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XChangeKeyboardControl", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XChangeKeyboardControl", "ulong");
+ Xen_check_type(Xen_is_list(larg3), larg3, 3, "XChangeKeyboardControl", "XKeyboardControl*");
+ arg3 = Xen_copy_arg(larg3);
+ kc.key_click_percent = Xen_integer_to_C_int(Xen_car(arg3)); arg3 = Xen_cdr(arg3);
+ if (!(Xen_is_null(arg3)))
{
- kc.bell_percent = XEN_TO_C_INT(XEN_CAR(arg3)); arg3 = XEN_CDR(arg3);
- if (!(XEN_NULL_P(arg3)))
+ kc.bell_percent = Xen_integer_to_C_int(Xen_car(arg3)); arg3 = Xen_cdr(arg3);
+ if (!(Xen_is_null(arg3)))
{
- kc.bell_pitch = XEN_TO_C_INT(XEN_CAR(arg3)); arg3 = XEN_CDR(arg3);
- if (!(XEN_NULL_P(arg3)))
+ kc.bell_pitch = Xen_integer_to_C_int(Xen_car(arg3)); arg3 = Xen_cdr(arg3);
+ if (!(Xen_is_null(arg3)))
{
- kc.bell_duration = XEN_TO_C_INT(XEN_CAR(arg3)); arg3 = XEN_CDR(arg3);
- if (!(XEN_NULL_P(arg3)))
+ kc.bell_duration = Xen_integer_to_C_int(Xen_car(arg3)); arg3 = Xen_cdr(arg3);
+ if (!(Xen_is_null(arg3)))
{
- kc.led = XEN_TO_C_INT(XEN_CAR(arg3)); arg3 = XEN_CDR(arg3);
- if (!(XEN_NULL_P(arg3)))
+ kc.led = Xen_integer_to_C_int(Xen_car(arg3)); arg3 = Xen_cdr(arg3);
+ if (!(Xen_is_null(arg3)))
{
- kc.led_mode = XEN_TO_C_INT(XEN_CAR(arg3)); arg3 = XEN_CDR(arg3);
- if (!(XEN_NULL_P(arg3)))
+ kc.led_mode = Xen_integer_to_C_int(Xen_car(arg3)); arg3 = Xen_cdr(arg3);
+ if (!(Xen_is_null(arg3)))
{
- kc.key = XEN_TO_C_INT(XEN_CAR(arg3)); arg3 = XEN_CDR(arg3);
- if (!(XEN_NULL_P(arg3)))
+ kc.key = Xen_integer_to_C_int(Xen_car(arg3)); arg3 = Xen_cdr(arg3);
+ if (!(Xen_is_null(arg3)))
{
- kc.auto_repeat_mode = XEN_TO_C_INT(XEN_CAR(arg3));
+ kc.auto_repeat_mode = Xen_integer_to_C_int(Xen_car(arg3));
}}}}}}}
- return(C_TO_XEN_INT(XChangeKeyboardControl(XEN_TO_C_Display(arg1), XEN_TO_C_ULONG(arg2), &kc)));
+ return(C_int_to_Xen_integer(XChangeKeyboardControl(Xen_to_C_Display(arg1), Xen_ulong_to_C_ulong(arg2), &kc)));
}
-static XEN gxm_XChangeGC(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XChangeGC(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XChangeGC "XChangeGC(display, gc, valuemask, values) changes the components specified by valuemask for the specified GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XChangeGC", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XChangeGC", "GC");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XChangeGC", "ulong");
- XEN_ASSERT_TYPE(XEN_XGCValues_P(arg4), arg4, 4, "XChangeGC", "XGCValues*");
- return(C_TO_XEN_INT(XChangeGC(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2), XEN_TO_C_ULONG(arg3), XEN_TO_C_XGCValues(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XChangeGC", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XChangeGC", "GC");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XChangeGC", "ulong");
+ Xen_check_type(Xen_is_XGCValues(arg4), arg4, 4, "XChangeGC", "XGCValues*");
+ return(C_int_to_Xen_integer(XChangeGC(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2), Xen_ulong_to_C_ulong(arg3), Xen_to_C_XGCValues(arg4))));
}
-static XEN gxm_XChangeActivePointerGrab(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XChangeActivePointerGrab(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XChangeActivePointerGrab "XChangeActivePointerGrab(display, event_mask, cursor, time) changes the specified dynamic parameters \
if the pointer is actively grabbed by the client and if the specified time is no earlier than the last-pointer-grab time and no later than \
the current X server time."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XChangeActivePointerGrab", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XChangeActivePointerGrab", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg3), arg3, 3, "XChangeActivePointerGrab", "Cursor");
- XEN_ASSERT_TYPE(XEN_Time_P(arg4), arg4, 4, "XChangeActivePointerGrab", "Time");
- return(C_TO_XEN_INT(XChangeActivePointerGrab(XEN_TO_C_Display(arg1), XEN_TO_C_ULONG(arg2), XEN_TO_C_Cursor(arg3), XEN_TO_C_Time(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XChangeActivePointerGrab", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XChangeActivePointerGrab", "unsigned int");
+ Xen_check_type(Xen_is_Cursor(arg3), arg3, 3, "XChangeActivePointerGrab", "Cursor");
+ Xen_check_type(Xen_is_Time(arg4), arg4, 4, "XChangeActivePointerGrab", "Time");
+ return(C_int_to_Xen_integer(XChangeActivePointerGrab(Xen_to_C_Display(arg1), Xen_ulong_to_C_ulong(arg2), Xen_to_C_Cursor(arg3), Xen_to_C_Time(arg4))));
}
-static XEN gxm_XCellsOfScreen(XEN arg1)
+static Xen gxm_XCellsOfScreen(Xen arg1)
{
#define H_CellsOfScreen "CellsOfScreen(screen): returns the number of colormap cells in the default colormap of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XCellsOfScreen", "Screen*");
- return(C_TO_XEN_INT(XCellsOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XCellsOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XCellsOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XBitmapUnit(XEN arg1)
+static Xen gxm_XBitmapUnit(Xen arg1)
{
#define H_BitmapUnit "BitmapUnit(display): returns the size of a bitmap's scanline unit in bits."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XBitmapUnit", "Display*");
- return(C_TO_XEN_INT(XBitmapUnit(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XBitmapUnit", "Display*");
+ return(C_int_to_Xen_integer(XBitmapUnit(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XBitmapPad(XEN arg1)
+static Xen gxm_XBitmapPad(Xen arg1)
{
#define H_BitmapPad "BitmapPad(display): returns the number of bits that each scanline must be padded."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XBitmapPad", "Display*");
- return(C_TO_XEN_INT(XBitmapPad(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XBitmapPad", "Display*");
+ return(C_int_to_Xen_integer(XBitmapPad(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XBitmapBitOrder(XEN arg1)
+static Xen gxm_XBitmapBitOrder(Xen arg1)
{
#define H_BitmapBitOrder "BitmapBitOrder(display): returns LSBFirst or MSBFirst to indicate whether the leftmost bit in the bitmap as \
displayed on the screen is the least or most significant bit in the unit."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XBitmapBitOrder", "Display*");
- return(C_TO_XEN_INT(XBitmapBitOrder(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XBitmapBitOrder", "Display*");
+ return(C_int_to_Xen_integer(XBitmapBitOrder(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XBell(XEN arg1, XEN arg2)
+static Xen gxm_XBell(Xen arg1, Xen arg2)
{
#define H_XBell "XBell(display, percent) rings the bell on the keyboard on the specified display, if possible."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XBell", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XBell", "int");
- return(C_TO_XEN_INT(XBell(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XBell", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XBell", "int");
+ return(C_int_to_Xen_integer(XBell(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XAutoRepeatOn(XEN arg1)
+static Xen gxm_XAutoRepeatOn(Xen arg1)
{
#define H_XAutoRepeatOn "XAutoRepeatOn(display) turns on auto-repeat for the keyboard on the specified display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XAutoRepeatOn", "Display*");
- return(C_TO_XEN_INT(XAutoRepeatOn(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XAutoRepeatOn", "Display*");
+ return(C_int_to_Xen_integer(XAutoRepeatOn(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XAutoRepeatOff(XEN arg1)
+static Xen gxm_XAutoRepeatOff(Xen arg1)
{
#define H_XAutoRepeatOff "XAutoRepeatOff(display) turns off auto-repeat for the keyboard on the specified display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XAutoRepeatOff", "Display*");
- return(C_TO_XEN_INT(XAutoRepeatOff(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XAutoRepeatOff", "Display*");
+ return(C_int_to_Xen_integer(XAutoRepeatOff(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XAllowEvents(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XAllowEvents(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XAllowEvents "XAllowEvents(display, event_mode, time)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XAllowEvents", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XAllowEvents", "int");
- XEN_ASSERT_TYPE(XEN_Time_P(arg3), arg3, 3, "XAllowEvents", "Time");
- return(C_TO_XEN_INT(XAllowEvents(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_Time(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XAllowEvents", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XAllowEvents", "int");
+ Xen_check_type(Xen_is_Time(arg3), arg3, 3, "XAllowEvents", "Time");
+ return(C_int_to_Xen_integer(XAllowEvents(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), Xen_to_C_Time(arg3))));
}
-static XEN gxm_XAllocNamedColor(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XAllocNamedColor(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XAllocNamedColor "Status XAllocNamedColor(display, colormap, color_name, screen_def_return, exact_def_return) looks up the \
named color with respect to the screen that is associated with the specified colormap."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XAllocNamedColor", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XAllocNamedColor", "Colormap");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XAllocNamedColor", "char*");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg4), arg4, 4, "XAllocNamedColor", "XColor");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg5), arg5, 5, "XAllocNamedColor", "XColor");
- return(C_TO_XEN_INT(XAllocNamedColor(XEN_TO_C_Display(arg1),
- XEN_TO_C_Colormap(arg2),
- (char *)XEN_TO_C_STRING(arg3),
- XEN_TO_C_XColor(arg4), XEN_TO_C_XColor(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XAllocNamedColor", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XAllocNamedColor", "Colormap");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XAllocNamedColor", "char*");
+ Xen_check_type(Xen_is_XColor(arg4), arg4, 4, "XAllocNamedColor", "XColor");
+ Xen_check_type(Xen_is_XColor(arg5), arg5, 5, "XAllocNamedColor", "XColor");
+ return(C_int_to_Xen_integer(XAllocNamedColor(Xen_to_C_Display(arg1),
+ Xen_to_C_Colormap(arg2),
+ (char *)Xen_string_to_C_string(arg3),
+ Xen_to_C_XColor(arg4), Xen_to_C_XColor(arg5))));
}
-static XEN gxm_XAllocColorPlanes(XEN args)
+static Xen gxm_XAllocColorPlanes(Xen args)
{
#define H_XAllocColorPlanes "Status XAllocColorPlanes(display, colormap, contig, ncolors, nreds, ngreens, nblues)"
/* DIFF: XAllocColorPlanes omits pixel array (arg4) and trailing 3 args, returns them and embedded list of pixels
*/
unsigned long r,g,b;
unsigned long *ps;
- int i, len, val;
- XEN lst = XEN_FALSE;
- XEN arg1, arg2, arg3, arg5, arg6, arg7, arg8;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg5 = XEN_LIST_REF(args, 3);
- arg6 = XEN_LIST_REF(args, 4);
- arg7 = XEN_LIST_REF(args, 5);
- arg8 = XEN_LIST_REF(args, 6);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XAllocColorPlanes", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XAllocColorPlanes", "Colormap");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XAllocColorPlanes", "Bool");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XAllocColorPlanes", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XAllocColorPlanes", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XAllocColorPlanes", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XAllocColorPlanes", "int");
- len = XEN_TO_C_INT(arg5);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg5, 5, "XAllocColorPlanes", "positive integer");
+ int len, val;
+ Xen lst = Xen_false;
+ Xen arg1, arg2, arg3, arg5, arg6, arg7, arg8;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg5 = Xen_list_ref(args, 3);
+ arg6 = Xen_list_ref(args, 4);
+ arg7 = Xen_list_ref(args, 5);
+ arg8 = Xen_list_ref(args, 6);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XAllocColorPlanes", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XAllocColorPlanes", "Colormap");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XAllocColorPlanes", "Bool");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XAllocColorPlanes", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XAllocColorPlanes", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XAllocColorPlanes", "int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XAllocColorPlanes", "int");
+ len = Xen_integer_to_C_int(arg5);
+ if (len <= 0) Xen_check_type(0, arg5, 5, "XAllocColorPlanes", "positive integer");
ps = (unsigned long *)calloc(len, sizeof(unsigned long));
- val = XAllocColorPlanes(XEN_TO_C_Display(arg1),
- XEN_TO_C_Colormap(arg2),
- XEN_TO_C_BOOLEAN(arg3),
+ val = XAllocColorPlanes(Xen_to_C_Display(arg1),
+ Xen_to_C_Colormap(arg2),
+ Xen_boolean_to_C_bool(arg3),
ps, len,
- XEN_TO_C_INT(arg6), XEN_TO_C_INT(arg7), XEN_TO_C_INT(arg8),
+ Xen_integer_to_C_int(arg6), Xen_integer_to_C_int(arg7), Xen_integer_to_C_int(arg8),
&r, &g, &b);
if (val != 0)
{
- XEN plist = XEN_EMPTY_LIST;
- int loc;
+ Xen plist = Xen_empty_list;
+ int i, loc;
loc = xm_protect(plist);
for (i = len - 1; i >= 0; i--)
- plist = XEN_CONS(C_TO_XEN_ULONG(ps[i]), plist);
+ plist = Xen_cons(C_ulong_to_Xen_ulong(ps[i]), plist);
xm_unprotect_at(loc);
- lst = XEN_LIST_5(C_TO_XEN_INT(val),
+ lst = Xen_list_5(C_int_to_Xen_integer(val),
plist,
- C_TO_XEN_ULONG(r),
- C_TO_XEN_ULONG(g),
- C_TO_XEN_ULONG(b));
+ C_ulong_to_Xen_ulong(r),
+ C_ulong_to_Xen_ulong(g),
+ C_ulong_to_Xen_ulong(b));
}
free(ps);
return(lst);
}
-static XEN gxm_XAllocColorCells(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XAllocColorCells(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XAllocColorCells "Status XAllocColorCells(display, colormap, contig, nplanes, npixels) \
allocates read/write color cells."
/* DIFF: XAllocColorCells arg 4 and 6 omitted and returned as (embedded) lists
*/
- int mlen, plen, i, val;
- XEN mlst = XEN_EMPTY_LIST, plst = XEN_EMPTY_LIST;
+ int mlen, plen, val;
+ Xen mlst = Xen_empty_list, plst = Xen_empty_list;
unsigned long *ms, *ps;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XAllocColorCells", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XAllocColorCells", "Colormap");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XAllocColorCells", "Bool");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XAllocColorCells", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XAllocColorCells", "unsigned int");
- mlen = XEN_TO_C_INT(arg4);
- if (mlen <= 0) return(XEN_FALSE);
- plen = XEN_TO_C_INT(arg5);
- if (plen <= 0) return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XAllocColorCells", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XAllocColorCells", "Colormap");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XAllocColorCells", "Bool");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XAllocColorCells", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XAllocColorCells", "unsigned int");
+ mlen = Xen_integer_to_C_int(arg4);
+ if (mlen <= 0) return(Xen_false);
+ plen = Xen_integer_to_C_int(arg5);
+ if (plen <= 0) return(Xen_false);
ms = (unsigned long *)calloc(mlen, sizeof(unsigned long));
ps = (unsigned long *)calloc(plen, sizeof(unsigned long));
- val = XAllocColorCells(XEN_TO_C_Display(arg1),
- XEN_TO_C_Colormap(arg2),
- XEN_TO_C_BOOLEAN(arg3),
+ val = XAllocColorCells(Xen_to_C_Display(arg1),
+ Xen_to_C_Colormap(arg2),
+ Xen_boolean_to_C_bool(arg3),
ms, mlen,
ps, plen);
if (val != 0)
{
- int loc1, loc2;
+ int i, loc1, loc2;
loc1 = xm_protect(mlst);
loc2 = xm_protect(plst);
for (i = mlen - 1; i >= 0; i--)
- mlst = XEN_CONS(C_TO_XEN_ULONG(ms[i]), mlst);
+ mlst = Xen_cons(C_ulong_to_Xen_ulong(ms[i]), mlst);
for (i = plen - 1; i >= 0; i--)
- mlst = XEN_CONS(C_TO_XEN_ULONG(ps[i]), plst);
+ mlst = Xen_cons(C_ulong_to_Xen_ulong(ps[i]), plst);
xm_unprotect_at(loc1);
xm_unprotect_at(loc2);
}
free(ms);
free(ps);
if (val != 0)
- return(XEN_LIST_3(C_TO_XEN_INT(val),
+ return(Xen_list_3(C_int_to_Xen_integer(val),
mlst,
plst));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XAllocColor(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XAllocColor(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XAllocColor "Status XAllocColor(display, colormap, screen_in_out) allocates a read-only colormap entry corresponding to the \
closest RGB value supported by the hardware."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XAllocColor", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XAllocColor", "Colormap");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg3), arg3, 3, "XAllocColor", "XColor");
- return(C_TO_XEN_INT(XAllocColor(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2), XEN_TO_C_XColor(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XAllocColor", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XAllocColor", "Colormap");
+ Xen_check_type(Xen_is_XColor(arg3), arg3, 3, "XAllocColor", "XColor");
+ return(C_int_to_Xen_integer(XAllocColor(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2), Xen_to_C_XColor(arg3))));
}
-static XEN gxm_XActivateScreenSaver(XEN arg1)
+static Xen gxm_XActivateScreenSaver(Xen arg1)
{
#define H_XActivateScreenSaver "XActivateScreenSaver(display) activates the screen saver."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XActivateScreenSaver", "Display*");
- return(C_TO_XEN_INT(XActivateScreenSaver(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XActivateScreenSaver", "Display*");
+ return(C_int_to_Xen_integer(XActivateScreenSaver(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XSetTransientForHint(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XSetTransientForHint(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XSetTransientForHint "XSetTransientForHint(display, w, prop_window) sets the WM_TRANSIENT_FOR property of the specified \
window to the specified prop_window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetTransientForHint", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetTransientForHint", "Window");
- XEN_ASSERT_TYPE(XEN_Window_P(arg3), arg3, 3, "XSetTransientForHint", "Window");
- return(C_TO_XEN_INT(XSetTransientForHint(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Window(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetTransientForHint", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetTransientForHint", "Window");
+ Xen_check_type(Xen_is_Window(arg3), arg3, 3, "XSetTransientForHint", "Window");
+ return(C_int_to_Xen_integer(XSetTransientForHint(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Window(arg3))));
}
-static XEN gxm_XSetWMColormapWindows(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XSetWMColormapWindows(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XSetWMColormapWindows "Status XSetWMColormapWindows(display, w, colormap_windows, count) replaces the WM_COLORMAP_WINDOWS property \
on the specified window with the list of windows specified by the colormap_windows argument."
@@ -11742,45 +11463,45 @@ on the specified window with the list of windows specified by the colormap_windo
*/
int len, rtn;
Window *ws;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWMColormapWindows", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWMColormapWindows", "Window");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XSetWMColormapWindows", "list of Windows");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetWMColormapWindows", "int");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) return(XEN_FALSE);
- ws = XEN_TO_C_Windows(arg3, len);
- rtn = XSetWMColormapWindows(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWMColormapWindows", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWMColormapWindows", "Window");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XSetWMColormapWindows", "list of Windows");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetWMColormapWindows", "int");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) return(Xen_false);
+ ws = Xen_to_C_Windows(arg3, len);
+ rtn = XSetWMColormapWindows(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
ws, len);
free(ws);
- return(C_TO_XEN_INT(rtn));
+ return(C_int_to_Xen_integer(rtn));
}
-static XEN gxm_XGetWMColormapWindows(XEN arg1, XEN arg2)
+static Xen gxm_XGetWMColormapWindows(Xen arg1, Xen arg2)
{
#define H_XGetWMColormapWindows "Status XGetWMColormapWindows(display, w): returns the list of \
window identifiers stored in the WM_COLORMAP_WINDOWS property on the specified window."
/* DIFF: XGetWMColormapWindows omit last 2 args, return list of windows
*/
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
int i, len, rtn, loc;
Window *ws;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetWMColormapWindows", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetWMColormapWindows", "Window");
- rtn = XGetWMColormapWindows(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetWMColormapWindows", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetWMColormapWindows", "Window");
+ rtn = XGetWMColormapWindows(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
&ws, &len);
if (rtn == 0)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Window(ws[i]), lst);
+ lst = Xen_cons(C_to_Xen_Window(ws[i]), lst);
xm_unprotect_at(loc);
XFree(ws);
return(lst);
}
-static XEN gxm_XGetCommand(XEN arg1, XEN arg2)
+static Xen gxm_XGetCommand(Xen arg1, Xen arg2)
{
#define H_XGetCommand "Status XGetCommand(display, w) reads the WM_COMMAND property from the specified window \
and returns a string list."
@@ -11788,45 +11509,45 @@ and returns a string list."
*/
char **argv;
int argc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
Status err;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetCommand", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetCommand", "Window");
- err = XGetCommand(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), &argv, &argc);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetCommand", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetCommand", "Window");
+ err = XGetCommand(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), &argv, &argc);
if (err != 0)
{
int i, loc;
loc = xm_protect(lst);
for (i = argc - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(argv[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(argv[i]), lst);
XFreeStringList(argv);
xm_unprotect_at(loc);
}
return(lst);
}
-static XEN gxm_XWithdrawWindow(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XWithdrawWindow(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XWithdrawWindow "Status XWithdrawWindow(display, w, screen_number) unmaps the specified window and sends a synthetic \
UnmapNotify event to the root window of the specified screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XWithdrawWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XWithdrawWindow", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XWithdrawWindow", "int");
- return(C_TO_XEN_INT(XWithdrawWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XWithdrawWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XWithdrawWindow", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XWithdrawWindow", "int");
+ return(C_int_to_Xen_integer(XWithdrawWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XIconifyWindow(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XIconifyWindow(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XIconifyWindow "Status XIconifyWindow(display, w, screen_number) sends a WM_CHANGE_STATE ClientMessage event with a format of \
32 and a first data element of IconicState to the root window of the specified screen with an event mask set to \
SubstructureNotifyMask | SubstructureRedirectMask."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XIconifyWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XIconifyWindow", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XIconifyWindow", "int");
- return(C_TO_XEN_INT(XIconifyWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XIconifyWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XIconifyWindow", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XIconifyWindow", "int");
+ return(C_int_to_Xen_integer(XIconifyWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XSetWMProtocols(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XSetWMProtocols(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XSetWMProtocols "Status XSetWMProtocols(display, w, protocols, count) replaces the WM_PROTOCOLS property on the \
specified window with the list of atoms specified by the protocols argument."
@@ -11834,19 +11555,19 @@ specified window with the list of atoms specified by the protocols argument."
*/
Atom *outs;
int val, len;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetWMProtocols", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XSetWMProtocols", "Window");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XSetWMProtocols", "list of Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XSetWMProtocols", "int");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) return(XEN_FALSE);
- outs = XEN_TO_C_Atoms(arg3, len);
- val = XSetWMProtocols(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), outs, len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetWMProtocols", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XSetWMProtocols", "Window");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XSetWMProtocols", "list of Atom");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XSetWMProtocols", "int");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) return(Xen_false);
+ outs = Xen_to_C_Atoms(arg3, len);
+ val = XSetWMProtocols(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), outs, len);
free(outs);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XGetWMProtocols(XEN arg1, XEN arg2)
+static Xen gxm_XGetWMProtocols(Xen arg1, Xen arg2)
{
#define H_XGetWMProtocols "Status XGetWMProtocols(display, w): returns the list of atoms stored in the \
WM_PROTOCOLS property on the specified window."
@@ -11854,54 +11575,54 @@ WM_PROTOCOLS property on the specified window."
*/
Atom *ats;
int len, i, val, loc;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetWMProtocols", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetWMProtocols", "Window");
- val = XGetWMProtocols(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), &ats, &len);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetWMProtocols", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetWMProtocols", "Window");
+ val = XGetWMProtocols(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), &ats, &len);
if (val == 0)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Atom(ats[i]), lst);
+ lst = Xen_cons(C_to_Xen_Atom(ats[i]), lst);
xm_unprotect_at(loc);
XFree((void *)ats);
return(lst);
}
-static XEN gxm_XReconfigureWMWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XReconfigureWMWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XReconfigureWMWindow "Status XReconfigureWMWindow(display, w, screen_number, value_mask, values) issues a ConfigureWindow \
request on the specified top-level window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XReconfigureWMWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XReconfigureWMWindow", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XReconfigureWMWindow", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XReconfigureWMWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_XWindowChanges_P(arg5), arg5, 5, "XReconfigureWMWindow", "XWindowChanges*");
- return(C_TO_XEN_INT(XReconfigureWMWindow(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_ULONG(arg4),
- XEN_TO_C_XWindowChanges(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XReconfigureWMWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XReconfigureWMWindow", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XReconfigureWMWindow", "int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XReconfigureWMWindow", "unsigned int");
+ Xen_check_type(Xen_is_XWindowChanges(arg5), arg5, 5, "XReconfigureWMWindow", "XWindowChanges*");
+ return(C_int_to_Xen_integer(XReconfigureWMWindow(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_integer_to_C_int(arg3), Xen_ulong_to_C_ulong(arg4),
+ Xen_to_C_XWindowChanges(arg5))));
}
-static XEN gxm_XListDepths(XEN arg1, XEN arg2)
+static Xen gxm_XListDepths(Xen arg1, Xen arg2)
{
#define H_XListDepths "int *XListDepths(display, screen_number): returns the array of depths that are available on the \
specified screen."
/* DIFF: XListDepths omits last arg, returns list of depths
*/
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
int i, len, loc;
int *ds;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XListDepths", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XListDepths", "int");
- ds = XListDepths(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2), &len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XListDepths", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XListDepths", "int");
+ ds = XListDepths(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2), &len);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_INT(ds[i]), lst);
+ lst = Xen_cons(C_int_to_Xen_integer(ds[i]), lst);
XFree(ds);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XListPixmapFormats(XEN arg1)
+static Xen gxm_XListPixmapFormats(Xen arg1)
{
#define H_XListPixmapFormats "XPixmapFormatValues *XListPixmapFormats(display): returns an array of XPixmapFormatValues \
structures that describe the types of Z format images supported by the specified display."
@@ -11909,17 +11630,17 @@ structures that describe the types of Z format images supported by the specified
*/
XPixmapFormatValues *ps;
int len, loc;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XListPixmapFormats", "Display*");
- ps = XListPixmapFormats(XEN_TO_C_Display(arg1), &len);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XListPixmapFormats", "Display*");
+ ps = XListPixmapFormats(Xen_to_C_Display(arg1), &len);
loc = xm_protect(lst);
if (ps)
{
int i;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(XEN_LIST_3(C_TO_XEN_INT(ps[i].depth),
- C_TO_XEN_INT(ps[i].bits_per_pixel),
- C_TO_XEN_INT(ps[i].scanline_pad)),
+ lst = Xen_cons(Xen_list_3(C_int_to_Xen_integer(ps[i].depth),
+ C_int_to_Xen_integer(ps[i].bits_per_pixel),
+ C_int_to_Xen_integer(ps[i].scanline_pad)),
lst);
free(ps);
}
@@ -11928,260 +11649,260 @@ structures that describe the types of Z format images supported by the specified
}
-static XEN xm_XIOErrorHandler;
+static Xen xm_XIOErrorHandler;
static int gxm_XIOErrorHandler(Display *dpy)
{
- XEN_CALL_1(xm_XIOErrorHandler, C_TO_XEN_Display(dpy), c__FUNCTION__);
+ Xen_call_with_1_arg(xm_XIOErrorHandler, C_to_Xen_Display(dpy), __func__);
return(0); /* never happens */
}
-static XEN gxm_XSetIOErrorHandler(XEN arg1)
+static Xen gxm_XSetIOErrorHandler(Xen arg1)
{
#define H_XSetIOErrorHandler "int (*XSetIOErrorHandler(handler))() sets the fatal I/O error handler. "
- XEN old_val;
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg1) || XEN_PROCEDURE_P(arg1), arg1, XEN_ONLY_ARG, "XSetIOErrorHandler", PROC_FALSE "=null or function of 1 arg");
+ Xen old_val;
+ Xen_check_type(Xen_is_false(arg1) || Xen_is_procedure(arg1), arg1, 1, "XSetIOErrorHandler", PROC_FALSE "=null or function of 1 arg");
xm_protect(arg1);
old_val = xm_XIOErrorHandler;
xm_XIOErrorHandler = arg1;
- if (XEN_FALSE_P(arg1))
+ if (Xen_is_false(arg1))
XSetIOErrorHandler(NULL);
else XSetIOErrorHandler(gxm_XIOErrorHandler);
- if (XEN_PROCEDURE_P(old_val)) xm_unprotect(old_val); /* hmmm... what if we're gc'd on the way back? */
+ if (Xen_is_procedure(old_val)) xm_unprotect(old_val); /* hmmm... what if we're gc'd on the way back? */
return(old_val);
}
-static XEN xm_XErrorHandler;
+static Xen xm_XErrorHandler;
static int gxm_XErrorHandler(Display *dpy, XErrorEvent *e)
{
- XEN_CALL_2(xm_XErrorHandler, C_TO_XEN_Display(dpy), C_TO_XEN_XErrorEvent((XErrorEvent *)e), c__FUNCTION__);
+ Xen_call_with_2_args(xm_XErrorHandler, C_to_Xen_Display(dpy), C_to_Xen_XErrorEvent((XErrorEvent *)e), __func__);
return(0); /* never happens */
}
-static XEN gxm_XSetErrorHandler(XEN arg1)
+static Xen gxm_XSetErrorHandler(Xen arg1)
{
#define H_XSetErrorHandler "XSetErrorHandler(proc) causes proc to be called if an error occurs"
- XEN old_val;
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg1) || XEN_PROCEDURE_P(arg1), arg1, XEN_ONLY_ARG, "XSetErrorHandler", PROC_FALSE "=null or function of 2 args");
+ Xen old_val;
+ Xen_check_type(Xen_is_false(arg1) || Xen_is_procedure(arg1), arg1, 1, "XSetErrorHandler", PROC_FALSE "=null or function of 2 args");
xm_protect(arg1);
old_val = xm_XErrorHandler;
xm_XErrorHandler = arg1;
- if (XEN_FALSE_P(arg1))
+ if (Xen_is_false(arg1))
XSetErrorHandler(NULL);
else XSetErrorHandler(gxm_XErrorHandler);
- if (XEN_PROCEDURE_P(old_val)) xm_unprotect(old_val); /* hmmm... what if we're gc'd on the way back? */
+ if (Xen_is_procedure(old_val)) xm_unprotect(old_val); /* hmmm... what if we're gc'd on the way back? */
return(old_val);
}
-static XEN gxm_XScreenNumberOfScreen(XEN arg1)
+static Xen gxm_XScreenNumberOfScreen(Xen arg1)
{
#define H_XScreenNumberOfScreen "int XScreenNumberOfScreen(screen): returns the screen index number of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XScreenNumberOfScreen", "Screen*");
- return(C_TO_XEN_INT(XScreenNumberOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XScreenNumberOfScreen", "Screen*");
+ return(C_int_to_Xen_integer(XScreenNumberOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XEventMaskOfScreen(XEN arg1)
+static Xen gxm_XEventMaskOfScreen(Xen arg1)
{
#define H_EventMaskOfScreen "EventMaskOfScreen(screen): returns the root event mask of the root window for the specified screen at connection setup."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XEventMaskOfScreen", "Screen*");
- return(C_TO_XEN_ULONG(XEventMaskOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XEventMaskOfScreen", "Screen*");
+ return(C_ulong_to_Xen_ulong(XEventMaskOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDefaultScreenOfDisplay(XEN arg1)
+static Xen gxm_XDefaultScreenOfDisplay(Xen arg1)
{
/* #define DefaultScreenOfDisplay(display) */
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDefaultScreenOfDisplay", "Display*");
- return(C_TO_XEN_Screen(XDefaultScreenOfDisplay(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDefaultScreenOfDisplay", "Display*");
+ return(C_to_Xen_Screen(XDefaultScreenOfDisplay(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XScreenOfDisplay(XEN arg1, XEN arg2)
+static Xen gxm_XScreenOfDisplay(Xen arg1, Xen arg2)
{
#define H_ScreenOfDisplay "ScreenOfDisplay(display, screen_number): returns a pointer to the screen of the specified display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XScreenOfDisplay", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XScreenOfDisplay", "int");
- return(C_TO_XEN_Screen(XScreenOfDisplay(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XScreenOfDisplay", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XScreenOfDisplay", "int");
+ return(C_to_Xen_Screen(XScreenOfDisplay(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDisplayOfScreen(XEN arg1)
+static Xen gxm_XDisplayOfScreen(Xen arg1)
{
#define H_DisplayOfScreen "DisplayOfScreen(screen): returns the display of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XDisplayOfScreen", "Screen*");
- return(C_TO_XEN_Display(XDisplayOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XDisplayOfScreen", "Screen*");
+ return(C_to_Xen_Display(XDisplayOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDefaultColormapOfScreen(XEN arg1)
+static Xen gxm_XDefaultColormapOfScreen(Xen arg1)
{
#define H_DefaultColormapOfScreen "DefaultColormapOfScreen(screen): returns the default colormap of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XDefaultColormapOfScreen", "Screen*");
- return(C_TO_XEN_Colormap(XDefaultColormapOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XDefaultColormapOfScreen", "Screen*");
+ return(C_to_Xen_Colormap(XDefaultColormapOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDefaultColormap(XEN arg1, XEN arg2)
+static Xen gxm_XDefaultColormap(Xen arg1, Xen arg2)
{
#define H_DefaultColormap "DefaultColormap(display, screen_number): returns the default colormap ID for allocation on the specified screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDefaultColormap", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDefaultColormap", "int");
- return(C_TO_XEN_Colormap(XDefaultColormap(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDefaultColormap", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDefaultColormap", "int");
+ return(C_to_Xen_Colormap(XDefaultColormap(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDisplayString(XEN arg1)
+static Xen gxm_XDisplayString(Xen arg1)
{
#define H_DisplayString "DisplayString(display): returns the string that was passed to XOpenDisplay when the current display was opened."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayString", "Display*");
- return(C_TO_XEN_STRING(XDisplayString(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayString", "Display*");
+ return(C_string_to_Xen_string(XDisplayString(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XServerVendor(XEN arg1)
+static Xen gxm_XServerVendor(Xen arg1)
{
#define H_ServerVendor "ServerVendor(display): returns a pointer to a null-terminated string that provides some identification of the \
owner of the X server implementation."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XServerVendor", "Display*");
- return(C_TO_XEN_STRING(XServerVendor(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XServerVendor", "Display*");
+ return(C_string_to_Xen_string(XServerVendor(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XLastKnownRequestProcessed(XEN arg1)
+static Xen gxm_XLastKnownRequestProcessed(Xen arg1)
{
#define H_LastKnownRequestProcessed "LastKnownRequestProcessed(display) extracts the full serial number of the last request known by Xlib \
to have been processed by the X server."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XLastKnownRequestProcessed", "Display*");
- return(C_TO_XEN_ULONG(XLastKnownRequestProcessed(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XLastKnownRequestProcessed", "Display*");
+ return(C_ulong_to_Xen_ulong(XLastKnownRequestProcessed(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XNextRequest(XEN arg1)
+static Xen gxm_XNextRequest(Xen arg1)
{
#define H_NextRequest "NextRequest(display) extracts the full serial number that is to be used for the next request."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XNextRequest", "Display*");
- return(C_TO_XEN_ULONG(XNextRequest(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XNextRequest", "Display*");
+ return(C_ulong_to_Xen_ulong(XNextRequest(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XWhitePixelOfScreen(XEN arg1)
+static Xen gxm_XWhitePixelOfScreen(Xen arg1)
{
#define H_WhitePixelOfScreen "WhitePixelOfScreen(screen): returns the white pixel value of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XWhitePixelOfScreen", "Screen*");
- return(C_TO_XEN_Pixel(XWhitePixelOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XWhitePixelOfScreen", "Screen*");
+ return(C_to_Xen_Pixel(XWhitePixelOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XBlackPixelOfScreen(XEN arg1)
+static Xen gxm_XBlackPixelOfScreen(Xen arg1)
{
#define H_BlackPixelOfScreen "BlackPixelOfScreen(screen): returns the black pixel value of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XBlackPixelOfScreen", "Screen*");
- return(C_TO_XEN_Pixel(XBlackPixelOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XBlackPixelOfScreen", "Screen*");
+ return(C_to_Xen_Pixel(XBlackPixelOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XAllPlanes(void)
+static Xen gxm_XAllPlanes(void)
{
#define H_AllPlanes "Allplanes(): returns a value with all bits set to 1 suitable for use in a plane argument to a procedure."
- return(C_TO_XEN_ULONG(XAllPlanes()));
+ return(C_ulong_to_Xen_ulong(XAllPlanes()));
}
-static XEN gxm_XWhitePixel(XEN arg1, XEN arg2)
+static Xen gxm_XWhitePixel(Xen arg1, Xen arg2)
{
#define H_WhitePixel "WhitePixel(display, screen_number): returns the white pixel value for the specified screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XWhitePixel", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XWhitePixel", "int");
- return(C_TO_XEN_Pixel(XWhitePixel(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XWhitePixel", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XWhitePixel", "int");
+ return(C_to_Xen_Pixel(XWhitePixel(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XBlackPixel(XEN arg1, XEN arg2)
+static Xen gxm_XBlackPixel(Xen arg1, Xen arg2)
{
#define H_BlackPixel "BlackPixel(display, screen_number): returns the black pixel value for the specified screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XBlackPixel", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XBlackPixel", "int");
- return(C_TO_XEN_Pixel(XBlackPixel(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XBlackPixel", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XBlackPixel", "int");
+ return(C_to_Xen_Pixel(XBlackPixel(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDefaultGCOfScreen(XEN arg1)
+static Xen gxm_XDefaultGCOfScreen(Xen arg1)
{
#define H_DefaultGCOfScreen "DefaultGCOfScreen(screen): returns the default GC of the specified screen, which has the same depth as the root \
window of the screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XDefaultGCOfScreen", "Screen*");
- return(C_TO_XEN_GC(XDefaultGCOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XDefaultGCOfScreen", "Screen*");
+ return(C_to_Xen_GC(XDefaultGCOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDefaultGC(XEN arg1, XEN arg2)
+static Xen gxm_XDefaultGC(Xen arg1, Xen arg2)
{
#define H_DefaultGC "DefaultGC(display, screen_number): returns the default GC for the root window of the "
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDefaultGC", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDefaultGC", "int");
- return(C_TO_XEN_GC(XDefaultGC(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDefaultGC", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDefaultGC", "int");
+ return(C_to_Xen_GC(XDefaultGC(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XDefaultVisualOfScreen(XEN arg1)
+static Xen gxm_XDefaultVisualOfScreen(Xen arg1)
{
#define H_DefaultVisualOfScreen "DefaultVisualOfScreen(screen): returns the default visual of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XDefaultVisualOfScreen", "Screen*");
- return(C_TO_XEN_Visual(XDefaultVisualOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XDefaultVisualOfScreen", "Screen*");
+ return(C_to_Xen_Visual(XDefaultVisualOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDefaultVisual(XEN arg1, XEN arg2)
+static Xen gxm_XDefaultVisual(Xen arg1, Xen arg2)
{
#define H_DefaultVisual "DefaultVisual(display, screen_number): returns the default visual type for the specified screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDefaultVisual", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XDefaultVisual", "int");
- return(C_TO_XEN_Visual(XDefaultVisual(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDefaultVisual", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XDefaultVisual", "int");
+ return(C_to_Xen_Visual(XDefaultVisual(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XRootWindowOfScreen(XEN arg1)
+static Xen gxm_XRootWindowOfScreen(Xen arg1)
{
#define H_RootWindowOfScreen "RootWindowOfScreen(screen): returns the root window of the specified screen."
- XEN_ASSERT_TYPE(XEN_Screen_P(arg1), arg1, 1, "XRootWindowOfScreen", "Screen*");
- return(C_TO_XEN_Window(XRootWindowOfScreen(XEN_TO_C_Screen(arg1))));
+ Xen_check_type(Xen_is_Screen(arg1), arg1, 1, "XRootWindowOfScreen", "Screen*");
+ return(C_to_Xen_Window(XRootWindowOfScreen(Xen_to_C_Screen(arg1))));
}
-static XEN gxm_XDefaultRootWindow(XEN arg1)
+static Xen gxm_XDefaultRootWindow(Xen arg1)
{
#define H_DefaultRootWindow "DefaultRootWindow(display): returns the root window for the default screen."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDefaultRootWindow", "Display*");
- return(C_TO_XEN_Window(XDefaultRootWindow(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDefaultRootWindow", "Display*");
+ return(C_to_Xen_Window(XDefaultRootWindow(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XRootWindow(XEN arg1, XEN arg2)
+static Xen gxm_XRootWindow(Xen arg1, Xen arg2)
{
#define H_RootWindow "RootWindow(display, screen_number): returns the root window."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XRootWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XRootWindow", "int");
- return(C_TO_XEN_Window(XRootWindow(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XRootWindow", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XRootWindow", "int");
+ return(C_to_Xen_Window(XRootWindow(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XVisualIDFromVisual(XEN arg1)
+static Xen gxm_XVisualIDFromVisual(Xen arg1)
{
#define H_XVisualIDFromVisual "VisualID XVisualIDFromVisual(visual): returns the visual ID for the specified visual type."
- XEN_ASSERT_TYPE(XEN_Visual_P(arg1), arg1, 1, "XVisualIDFromVisual", "Visual*");
- return(C_TO_XEN_ULONG(XVisualIDFromVisual(XEN_TO_C_Visual(arg1))));
+ Xen_check_type(Xen_is_Visual(arg1), arg1, 1, "XVisualIDFromVisual", "Visual*");
+ return(C_ulong_to_Xen_ulong(XVisualIDFromVisual(Xen_to_C_Visual(arg1))));
}
-static XEN gxm_XDisplayMotionBufferSize(XEN arg1)
+static Xen gxm_XDisplayMotionBufferSize(Xen arg1)
{
#define H_XDisplayMotionBufferSize "unsigned long XDisplayMotionBufferSize(display)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XDisplayMotionBufferSize", "Display*");
- return(C_TO_XEN_ULONG(XDisplayMotionBufferSize(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XDisplayMotionBufferSize", "Display*");
+ return(C_ulong_to_Xen_ulong(XDisplayMotionBufferSize(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XExtendedMaxRequestSize(XEN arg1)
+static Xen gxm_XExtendedMaxRequestSize(Xen arg1)
{
#define H_XExtendedMaxRequestSize "long XExtendedMaxRequestSize(display): returns zero if the specified display does not support an \
extended-length protocol encoding; otherwise, it returns the maximum request size (in 4-byte units) supported by the server using the \
extended-length encoding."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XExtendedMaxRequestSize", "Display*");
- return(C_TO_XEN_INT(XExtendedMaxRequestSize(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XExtendedMaxRequestSize", "Display*");
+ return(C_int_to_Xen_integer(XExtendedMaxRequestSize(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XMaxRequestSize(XEN arg1)
+static Xen gxm_XMaxRequestSize(Xen arg1)
{
#define H_XMaxRequestSize "long XMaxRequestSize(display): returns the maximum request size (in 4-byte units) supported by the server \
without using an extended-length protocol encoding."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XMaxRequestSize", "Display*");
- return(C_TO_XEN_INT(XMaxRequestSize(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XMaxRequestSize", "Display*");
+ return(C_int_to_Xen_integer(XMaxRequestSize(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XStringToKeysym(XEN arg1)
+static Xen gxm_XStringToKeysym(Xen arg1)
{
#define H_XStringToKeysym "KeySym XStringToKeysym(string)"
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XStringToKeysym", "char*");
- return(C_TO_XEN_KeySym(XStringToKeysym((char *)XEN_TO_C_STRING(arg1))));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XStringToKeysym", "char*");
+ return(C_to_Xen_KeySym(XStringToKeysym((char *)Xen_string_to_C_string(arg1))));
}
-static XEN gxm_XGetKeyboardMapping(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XGetKeyboardMapping(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XGetKeyboardMapping "KeySym *XGetKeyboardMapping(display, first_keycode, keycode_count): returns \
the symbols for the specified number of KeyCodes starting with first_keycode."
@@ -12189,99 +11910,102 @@ the symbols for the specified number of KeyCodes starting with first_keycode."
*/
int n, i, len, count, loc;
KeySym *keys;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetKeyboardMapping", "Display*");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XGetKeyboardMapping", "KeyCode");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XGetKeyboardMapping", "int");
- count = XEN_TO_C_INT(arg3);
- keys = XGetKeyboardMapping(XEN_TO_C_Display(arg1), XEN_TO_C_KeyCode(arg2), count, &n);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetKeyboardMapping", "Display*");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XGetKeyboardMapping", "KeyCode");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XGetKeyboardMapping", "int");
+ count = Xen_integer_to_C_int(arg3);
+ keys = XGetKeyboardMapping(Xen_to_C_Display(arg1), Xen_to_C_KeyCode(arg2), count, &n);
len = count * n;
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_KeySym(keys[i]), lst);
+ lst = Xen_cons(C_to_Xen_KeySym(keys[i]), lst);
XFree(keys);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XLookupKeysym(XEN arg1, XEN arg2)
+static Xen gxm_XLookupKeysym(Xen arg1, Xen arg2)
{
#define H_XLookupKeysym "KeySym XLookupKeysym(key_event, index) uses a given keyboard event and the index you specified to return \
the KeySym from the list that corresponds to the KeyCode member in the XKeyPressedEvent or XKeyReleasedEvent structure."
- XEN_ASSERT_TYPE(XEN_XKeyEvent_P(arg1), arg1, 1, "XLookupKeysym", "XKeyEvent*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XLookupKeysym", "int");
- return(C_TO_XEN_KeySym(XLookupKeysym(XEN_TO_C_XKeyEvent(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_XKeyEvent(arg1), arg1, 1, "XLookupKeysym", "XKeyEvent*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XLookupKeysym", "int");
+ return(C_to_Xen_KeySym(XLookupKeysym(Xen_to_C_XKeyEvent(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XKeycodeToKeysym(XEN arg1, XEN arg2, XEN arg3)
+#if 0
+/* this has been deprecated for XkbKeycodeToKeysym */
+static Xen gxm_XKeycodeToKeysym(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XKeycodeToKeysym "KeySym XKeycodeToKeysym(display, keycode, index) uses internal Xlib tables and returns the KeySym defined \
for the specified KeyCode and the element of the KeyCode vector."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XKeycodeToKeysym", "Display*");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XKeycodeToKeysym", "KeyCode");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XKeycodeToKeysym", "int");
- return(C_TO_XEN_KeySym(XKeycodeToKeysym(XEN_TO_C_Display(arg1), XEN_TO_C_KeyCode(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XKeycodeToKeysym", "Display*");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XKeycodeToKeysym", "KeyCode");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XKeycodeToKeysym", "int");
+ return(C_to_Xen_KeySym(XKeycodeToKeysym(Xen_to_C_Display(arg1), Xen_to_C_KeyCode(arg2), Xen_integer_to_C_int(arg3))));
}
+#endif
-static XEN gxm_XListProperties(XEN arg1, XEN arg2)
+static Xen gxm_XListProperties(Xen arg1, Xen arg2)
{
#define H_XListProperties "Atom *XListProperties(display, w): returns a pointer to an array of atom properties that \
are defined for the specified window or returns NULL if no properties were found."
/* DIFF: XListProperties returns list, no arg3
*/
int i, len, loc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
Atom *ats;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XListProperties", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XListProperties", "Window");
- ats = XListProperties(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), &len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XListProperties", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XListProperties", "Window");
+ ats = XListProperties(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), &len);
if (ats == NULL)
- return(XEN_FALSE);
+ return(Xen_false);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Atom(ats[i]), lst);
+ lst = Xen_cons(C_to_Xen_Atom(ats[i]), lst);
xm_unprotect_at(loc);
XFree(ats);
return(lst);
}
-static XEN gxm_XListExtensions(XEN arg1)
+static Xen gxm_XListExtensions(Xen arg1)
{
#define H_XListExtensions "XListExtensions(dpy): list of strings describing available extensions"
/* DIFF: XListExtensions omits arg2, returns list
*/
int i, len, loc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
char **str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XListExtensions", "Display*");
- str = XListExtensions(XEN_TO_C_Display(arg1), &len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XListExtensions", "Display*");
+ str = XListExtensions(Xen_to_C_Display(arg1), &len);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(str[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(str[i]), lst);
XFreeExtensionList(str);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XGetFontPath(XEN arg1)
+static Xen gxm_XGetFontPath(Xen arg1)
{
#define H_XGetFontPath "char **XGetFontPath(display) allocates and returns an array of strings containing the search path."
/* DIFF: XGetFontPath omits arg2, returns list
*/
int i, len, loc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
char **str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetFontPath", "Display*");
- str = XGetFontPath(XEN_TO_C_Display(arg1), &len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetFontPath", "Display*");
+ str = XGetFontPath(Xen_to_C_Display(arg1), &len);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(str[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(str[i]), lst);
XFreeFontPath(str);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XListFontsWithInfo(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XListFontsWithInfo(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XListFontsWithInfo "char **XListFontsWithInfo(display, pattern, maxnames): returns a list of \
font names that match the specified pattern and their associated font information."
@@ -12290,15 +12014,15 @@ font names that match the specified pattern and their associated font informatio
int i, count, loc;
XFontStruct *info;
char **val;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XListFontsWithInfo", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XListFontsWithInfo", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XListFontsWithInfo", "int");
- val = XListFontsWithInfo(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2), XEN_TO_C_INT(arg3), &count, &info);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XListFontsWithInfo", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XListFontsWithInfo", "char*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XListFontsWithInfo", "int");
+ val = XListFontsWithInfo(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2), Xen_integer_to_C_int(arg3), &count, &info);
loc = xm_protect(lst);
for (i = count - 1; i >= 0; i--)
- lst = XEN_CONS(XEN_LIST_2(C_TO_XEN_STRING(val[i]),
- C_TO_XEN_XFontStruct(&(info[i]))),
+ lst = Xen_cons(Xen_list_2(C_string_to_Xen_string(val[i]),
+ C_to_Xen_XFontStruct(&(info[i]))),
lst);
XFreeFontInfo(val, info, count);
/* XFreeFontNames(val); */
@@ -12306,28 +12030,28 @@ font names that match the specified pattern and their associated font informatio
return(lst);
}
-static XEN gxm_XListFonts(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XListFonts(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XListFonts "char **XListFonts(display, pattern, maxnames): returns an array of available font names that match \
the string you passed to the pattern argument."
/* DIFF: XListFonts omits arg4, returns list
*/
int i, len, loc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
char **str;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XListFonts", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XListFonts", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XListFonts", "int");
- str = XListFonts(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2), XEN_TO_C_INT(arg3), &len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XListFonts", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XListFonts", "char*");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XListFonts", "int");
+ str = XListFonts(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2), Xen_integer_to_C_int(arg3), &len);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(str[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(str[i]), lst);
XFreeFontNames(str);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XListInstalledColormaps(XEN arg1, XEN arg2)
+static Xen gxm_XListInstalledColormaps(Xen arg1, Xen arg2)
{
#define H_XListInstalledColormaps "Colormap *XListInstalledColormaps(display, w): returns a list of the currently installed \
colormaps for the screen of the specified window."
@@ -12335,90 +12059,90 @@ colormaps for the screen of the specified window."
*/
Colormap *cm;
int i, len, loc;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XListInstalledColormaps", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XListInstalledColormaps", "Window");
- cm = XListInstalledColormaps(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), &len);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XListInstalledColormaps", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XListInstalledColormaps", "Window");
+ cm = XListInstalledColormaps(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), &len);
loc = xm_protect(lst);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Colormap(cm[i]), lst);
+ lst = Xen_cons(C_to_Xen_Colormap(cm[i]), lst);
free(cm);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XCreateWindow(XEN args)
+static Xen gxm_XCreateWindow(Xen args)
{
#define H_XCreateWindow "Window XCreateWindow(display, parent, x, y, width, height, border_width, depth, class, visual, valuemask, attributes) \
creates an unmapped subwindow for a specified parent window, returns the window ID of the created window, and causes the X server to generate \
a CreateNotify event."
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- arg11 = XEN_LIST_REF(args, 10);
- arg12 = XEN_LIST_REF(args, 11);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCreateWindow", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XCreateWindow", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XCreateWindow", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XCreateWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XCreateWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XCreateWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XCreateWindow", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg9), arg9, 9, "XCreateWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Visual_P(arg10), arg10, 10, "XCreateWindow", "Visual*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg11), arg11, 11, "XCreateWindow", "ulong");
- XEN_ASSERT_TYPE(XEN_XSetWindowAttributes_P(arg12), arg12, 12, "XCreateWindow", "XSetWindowAttributes*");
- return(C_TO_XEN_Window(XCreateWindow(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4),
- XEN_TO_C_ULONG(arg5), XEN_TO_C_ULONG(arg6),
- XEN_TO_C_ULONG(arg7), XEN_TO_C_INT(arg8),
- XEN_TO_C_ULONG(arg9), XEN_TO_C_Visual(arg10),
- XEN_TO_C_ULONG(arg11),
- XEN_TO_C_XSetWindowAttributes(arg12))));
-}
-
-static XEN gxm_XGetSelectionOwner(XEN arg1, XEN arg2)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ arg11 = Xen_list_ref(args, 10);
+ arg12 = Xen_list_ref(args, 11);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCreateWindow", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XCreateWindow", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XCreateWindow", "int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XCreateWindow", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XCreateWindow", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XCreateWindow", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XCreateWindow", "int");
+ Xen_check_type(Xen_is_ulong(arg9), arg9, 9, "XCreateWindow", "unsigned int");
+ Xen_check_type(Xen_is_Visual(arg10), arg10, 10, "XCreateWindow", "Visual*");
+ Xen_check_type(Xen_is_ulong(arg11), arg11, 11, "XCreateWindow", "ulong");
+ Xen_check_type(Xen_is_XSetWindowAttributes(arg12), arg12, 12, "XCreateWindow", "XSetWindowAttributes*");
+ return(C_to_Xen_Window(XCreateWindow(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4),
+ Xen_ulong_to_C_ulong(arg5), Xen_ulong_to_C_ulong(arg6),
+ Xen_ulong_to_C_ulong(arg7), Xen_integer_to_C_int(arg8),
+ Xen_ulong_to_C_ulong(arg9), Xen_to_C_Visual(arg10),
+ Xen_ulong_to_C_ulong(arg11),
+ Xen_to_C_XSetWindowAttributes(arg12))));
+}
+
+static Xen gxm_XGetSelectionOwner(Xen arg1, Xen arg2)
{
#define H_XGetSelectionOwner "Window XGetSelectionOwner(display, selection): returns the window ID associated with the window that \
currently owns the specified selection."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetSelectionOwner", "Display*");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XGetSelectionOwner", "Atom");
- return(C_TO_XEN_Window(XGetSelectionOwner(XEN_TO_C_Display(arg1), XEN_TO_C_Atom(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetSelectionOwner", "Display*");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XGetSelectionOwner", "Atom");
+ return(C_to_Xen_Window(XGetSelectionOwner(Xen_to_C_Display(arg1), Xen_to_C_Atom(arg2))));
}
-static XEN gxm_XCreateSimpleWindow(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8, XEN arg9)
+static Xen gxm_XCreateSimpleWindow(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8, Xen arg9)
{
#define H_XCreateSimpleWindow "Window XCreateSimpleWindow(display, parent, x, y, width, height, border_width, border, background) \
creates an unmapped InputOutput subwindow for a specified parent window, returns the window ID of the created window, and causes the X \
server to generate a CreateNotify event."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateSimpleWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCreateSimpleWindow", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XCreateSimpleWindow", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XCreateSimpleWindow", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XCreateSimpleWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XCreateSimpleWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XCreateSimpleWindow", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg8), arg8, 8, "XCreateSimpleWindow", "Pixel");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg9), arg9, 9, "XCreateSimpleWindow", "Pixel");
- return(C_TO_XEN_Window(XCreateSimpleWindow(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4),
- XEN_TO_C_ULONG(arg5), XEN_TO_C_ULONG(arg6),
- XEN_TO_C_ULONG(arg7), XEN_TO_C_Pixel(arg8),
- XEN_TO_C_Pixel(arg9))));
-}
-
-static XEN gxm_XCreatePixmapFromBitmapData(XEN arg1, XEN arg2, XEN larg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateSimpleWindow", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCreateSimpleWindow", "Window");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XCreateSimpleWindow", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XCreateSimpleWindow", "int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XCreateSimpleWindow", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XCreateSimpleWindow", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XCreateSimpleWindow", "unsigned int");
+ Xen_check_type(Xen_is_Pixel(arg8), arg8, 8, "XCreateSimpleWindow", "Pixel");
+ Xen_check_type(Xen_is_Pixel(arg9), arg9, 9, "XCreateSimpleWindow", "Pixel");
+ return(C_to_Xen_Window(XCreateSimpleWindow(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4),
+ Xen_ulong_to_C_ulong(arg5), Xen_ulong_to_C_ulong(arg6),
+ Xen_ulong_to_C_ulong(arg7), Xen_to_C_Pixel(arg8),
+ Xen_to_C_Pixel(arg9))));
+}
+
+static Xen gxm_XCreatePixmapFromBitmapData(Xen arg1, Xen arg2, Xen larg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
#define H_XCreatePixmapFromBitmapData "Pixmap XCreatePixmapFromBitmapData(display, d, data, width, height, fg, bg, depth) creates a \
pixmap of the given depth and then does a bitmap-format XPutImage of the data into it."
@@ -12427,32 +12151,32 @@ pixmap of the given depth and then does a bitmap-format XPutImage of the data in
char *bits;
int i, len;
Pixmap p;
- XEN arg3;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreatePixmapFromBitmapData", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCreatePixmapFromBitmapData", "Drawable");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg3), larg3, 3, "XCreatePixmapFromBitmapData", "list of char");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XCreatePixmapFromBitmapData", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XCreatePixmapFromBitmapData", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg6), arg6, 6, "XCreatePixmapFromBitmapData", "pixel");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg7), arg7, 7, "XCreatePixmapFromBitmapData", "pixel");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg8), arg8, 8, "XCreatePixmapFromBitmapData", "unsigned int");
- len = XEN_LIST_LENGTH(larg3);
- if (len <= 0) XEN_ASSERT_TYPE(0, larg3, 3, "XCreatePixmapFromBitmapData", "positive integer");
- arg3 = XEN_COPY_ARG(larg3);
+ Xen arg3;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreatePixmapFromBitmapData", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCreatePixmapFromBitmapData", "Drawable");
+ Xen_check_type(Xen_is_list(larg3), larg3, 3, "XCreatePixmapFromBitmapData", "list of char");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XCreatePixmapFromBitmapData", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XCreatePixmapFromBitmapData", "unsigned int");
+ Xen_check_type(Xen_is_Pixel(arg6), arg6, 6, "XCreatePixmapFromBitmapData", "pixel");
+ Xen_check_type(Xen_is_Pixel(arg7), arg7, 7, "XCreatePixmapFromBitmapData", "pixel");
+ Xen_check_type(Xen_is_ulong(arg8), arg8, 8, "XCreatePixmapFromBitmapData", "unsigned int");
+ len = Xen_list_length(larg3);
+ if (len <= 0) Xen_check_type(0, larg3, 3, "XCreatePixmapFromBitmapData", "positive integer");
+ arg3 = Xen_copy_arg(larg3);
bits = (char *)calloc(len, sizeof(char));
- for (i = 0; i < len; i++, arg3 = XEN_CDR(arg3))
- bits[i] = (char)XEN_TO_C_INT(XEN_CAR(arg3));
- p = XCreatePixmapFromBitmapData(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ for (i = 0; i < len; i++, arg3 = Xen_cdr(arg3))
+ bits[i] = (char)Xen_integer_to_C_int(Xen_car(arg3));
+ p = XCreatePixmapFromBitmapData(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
bits,
- XEN_TO_C_ULONG(arg4), XEN_TO_C_ULONG(arg5),
- XEN_TO_C_Pixel(arg6), XEN_TO_C_Pixel(arg7),
- XEN_TO_C_ULONG(arg8));
+ Xen_ulong_to_C_ulong(arg4), Xen_ulong_to_C_ulong(arg5),
+ Xen_to_C_Pixel(arg6), Xen_to_C_Pixel(arg7),
+ Xen_ulong_to_C_ulong(arg8));
free(bits);
- return(C_TO_XEN_Pixmap(p));
+ return(C_to_Xen_Pixmap(p));
}
-static XEN gxm_XCreateBitmapFromData(XEN arg1, XEN arg2, XEN larg3, XEN arg4, XEN arg5)
+static Xen gxm_XCreateBitmapFromData(Xen arg1, Xen arg2, Xen larg3, Xen arg4, Xen arg5)
{
#define H_XCreateBitmapFromData "Pixmap XCreateBitmapFromData(display, d, data, width, height) allows you to include in your C \
program a bitmap file that was written out by XWriteBitmapFile"
@@ -12461,374 +12185,374 @@ program a bitmap file that was written out by XWriteBitmapFile"
char *bits;
int i, len;
Pixmap p;
- XEN arg3;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateBitmapFromData", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCreateBitmapFromData", "Drawable");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg3), larg3, 3, "XCreateBitmapFromData", "list of char");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XCreateBitmapFromData", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XCreateBitmapFromData", "unsigned int");
- len = XEN_LIST_LENGTH(larg3);
- if (len <= 0) XEN_ASSERT_TYPE(0, larg3, 3, "XCreateBitmapFromData", "positive integer");
- arg3 = XEN_COPY_ARG(larg3);
+ Xen arg3;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateBitmapFromData", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCreateBitmapFromData", "Drawable");
+ Xen_check_type(Xen_is_list(larg3), larg3, 3, "XCreateBitmapFromData", "list of char");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XCreateBitmapFromData", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XCreateBitmapFromData", "unsigned int");
+ len = Xen_list_length(larg3);
+ if (len <= 0) Xen_check_type(0, larg3, 3, "XCreateBitmapFromData", "positive integer");
+ arg3 = Xen_copy_arg(larg3);
bits = (char *)calloc(len, sizeof(char));
- for (i = 0; i < len; i++, arg3 = XEN_CDR(arg3))
- bits[i] = (char)XEN_TO_C_INT(XEN_CAR(arg3));
- p = XCreateBitmapFromData(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ for (i = 0; i < len; i++, arg3 = Xen_cdr(arg3))
+ bits[i] = (char)Xen_integer_to_C_int(Xen_car(arg3));
+ p = XCreateBitmapFromData(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
bits,
- XEN_TO_C_ULONG(arg4),
- XEN_TO_C_ULONG(arg5));
+ Xen_ulong_to_C_ulong(arg4),
+ Xen_ulong_to_C_ulong(arg5));
free(bits);
- return(C_TO_XEN_Pixmap(p));
+ return(C_to_Xen_Pixmap(p));
}
-static XEN gxm_XCreatePixmap(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XCreatePixmap(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XCreatePixmap "Pixmap XCreatePixmap(display, d, width, height, depth)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreatePixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCreatePixmap", "Drawable");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XCreatePixmap", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XCreatePixmap", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XCreatePixmap", "unsigned int");
- return(C_TO_XEN_Pixmap(XCreatePixmap(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2),
- XEN_TO_C_ULONG(arg3), XEN_TO_C_ULONG(arg4), XEN_TO_C_ULONG(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreatePixmap", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCreatePixmap", "Drawable");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XCreatePixmap", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XCreatePixmap", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XCreatePixmap", "unsigned int");
+ return(C_to_Xen_Pixmap(XCreatePixmap(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2),
+ Xen_ulong_to_C_ulong(arg3), Xen_ulong_to_C_ulong(arg4), Xen_ulong_to_C_ulong(arg5))));
}
-static XEN gxm_XFlushGC(XEN arg1, XEN arg2)
+static Xen gxm_XFlushGC(Xen arg1, Xen arg2)
{
#define H_XFlushGC "XFlushGC(dpy, gc) forces cached GC changes to X server"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFlushGC", "Display*");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XFlushGC", "GC");
- XFlushGC(XEN_TO_C_Display(arg1), XEN_TO_C_GC(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFlushGC", "Display*");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XFlushGC", "GC");
+ XFlushGC(Xen_to_C_Display(arg1), Xen_to_C_GC(arg2));
+ return(Xen_false);
}
-static XEN gxm_XCreateGC(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XCreateGC(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XCreateGC "GC XCreateGC(display, d, valuemask, values) creates a graphics context and returns a GC."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateGC", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCreateGC", "Drawable");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XCreateGC", "ulong");
- XEN_ASSERT_TYPE(XEN_XGCValues_P(arg4), arg4, 4, "XCreateGC", "XGCValues*");
- return(C_TO_XEN_GC(XCreateGC(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_ULONG(arg3), XEN_TO_C_XGCValues(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateGC", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCreateGC", "Drawable");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XCreateGC", "ulong");
+ Xen_check_type(Xen_is_XGCValues(arg4), arg4, 4, "XCreateGC", "XGCValues*");
+ return(C_to_Xen_GC(XCreateGC(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_ulong_to_C_ulong(arg3), Xen_to_C_XGCValues(arg4))));
}
-static XEN gxm_XLoadFont(XEN arg1, XEN arg2)
+static Xen gxm_XLoadFont(Xen arg1, Xen arg2)
{
#define H_XLoadFont "Font XLoadFont(display, name) loads the specified font and returns its associated font ID."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XLoadFont", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XLoadFont", "char*");
- return(C_TO_XEN_Font(XLoadFont(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XLoadFont", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XLoadFont", "char*");
+ return(C_to_Xen_Font(XLoadFont(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2))));
}
-static XEN gxm_XCreateFontCursor(XEN arg1, XEN arg2)
+static Xen gxm_XCreateFontCursor(Xen arg1, Xen arg2)
{
#define H_XCreateFontCursor "Cursor XCreateFontCursor(display, shape)"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateFontCursor", "Display*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XCreateFontCursor", "unsigned int");
- return(C_TO_XEN_Cursor(XCreateFontCursor(XEN_TO_C_Display(arg1), XEN_TO_C_ULONG(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateFontCursor", "Display*");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XCreateFontCursor", "unsigned int");
+ return(C_to_Xen_Cursor(XCreateFontCursor(Xen_to_C_Display(arg1), Xen_ulong_to_C_ulong(arg2))));
}
-static XEN gxm_XCreateGlyphCursor(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XCreateGlyphCursor(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XCreateGlyphCursor "Cursor XCreateGlyphCursor(display, source_font, mask_font, source_char, mask_char, foreground_color, \
background_color) is similar to XCreatePixmapCursor except that the source and mask bitmaps are obtained from the specified font glyphs."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateGlyphCursor", "Display*");
- XEN_ASSERT_TYPE(XEN_Font_P(arg2), arg2, 2, "XCreateGlyphCursor", "Font");
- XEN_ASSERT_TYPE(XEN_Font_P(arg3) || XEN_INTEGER_P(arg3) || XEN_FALSE_P(arg3), arg3, 3, "XCreateGlyphCursor", "Font");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XCreateGlyphCursor", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XCreateGlyphCursor", "unsigned int");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg6), arg6, 6, "XCreateGlyphCursor", "XColor");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg7), arg7, 7, "XCreateGlyphCursor", "XColor");
- return(C_TO_XEN_Cursor(XCreateGlyphCursor(XEN_TO_C_Display(arg1), XEN_TO_C_Font(arg2),
- (XEN_Font_P(arg3)) ? XEN_TO_C_Font(arg3) : None,
- XEN_TO_C_ULONG(arg4),
- XEN_TO_C_ULONG(arg5),
- XEN_TO_C_XColor(arg6), XEN_TO_C_XColor(arg7))));
-}
-
-static XEN gxm_XCreatePixmapCursor(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateGlyphCursor", "Display*");
+ Xen_check_type(Xen_is_Font(arg2), arg2, 2, "XCreateGlyphCursor", "Font");
+ Xen_check_type(Xen_is_Font(arg3) || Xen_is_integer(arg3) || Xen_is_false(arg3), arg3, 3, "XCreateGlyphCursor", "Font");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XCreateGlyphCursor", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XCreateGlyphCursor", "unsigned int");
+ Xen_check_type(Xen_is_XColor(arg6), arg6, 6, "XCreateGlyphCursor", "XColor");
+ Xen_check_type(Xen_is_XColor(arg7), arg7, 7, "XCreateGlyphCursor", "XColor");
+ return(C_to_Xen_Cursor(XCreateGlyphCursor(Xen_to_C_Display(arg1), Xen_to_C_Font(arg2),
+ (Xen_is_Font(arg3)) ? Xen_to_C_Font(arg3) : None,
+ Xen_ulong_to_C_ulong(arg4),
+ Xen_ulong_to_C_ulong(arg5),
+ Xen_to_C_XColor(arg6), Xen_to_C_XColor(arg7))));
+}
+
+static Xen gxm_XCreatePixmapCursor(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XCreatePixmapCursor "Cursor XCreatePixmapCursor(display, source, mask, foreground_color, background_color, x, y) creates \
a cursor and returns the cursor ID associated with it."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreatePixmapCursor", "Display*");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg2), arg2, 2, "XCreatePixmapCursor", "Pixmap");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3) || XEN_INTEGER_P(arg3) || XEN_FALSE_P(arg3), arg3, 3, "XCreatePixmapCursor", "Pixmap");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg4), arg4, 4, "XCreatePixmapCursor", "XColor");
- XEN_ASSERT_TYPE(XEN_XColor_P(arg5), arg5, 5, "XCreatePixmapCursor", "XColor");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XCreatePixmapCursor", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XCreatePixmapCursor", "unsigned int");
- return(C_TO_XEN_Cursor(XCreatePixmapCursor(XEN_TO_C_Display(arg1),
- XEN_TO_C_Pixmap(arg2),
- (XEN_Pixmap_P(arg3)) ? XEN_TO_C_Pixmap(arg3) : None,
- XEN_TO_C_XColor(arg4),
- XEN_TO_C_XColor(arg5),
- XEN_TO_C_ULONG(arg6), XEN_TO_C_ULONG(arg7))));
-}
-
-static XEN gxm_XCreateColormap(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreatePixmapCursor", "Display*");
+ Xen_check_type(Xen_is_Pixmap(arg2), arg2, 2, "XCreatePixmapCursor", "Pixmap");
+ Xen_check_type(Xen_is_Pixmap(arg3) || Xen_is_integer(arg3) || Xen_is_false(arg3), arg3, 3, "XCreatePixmapCursor", "Pixmap");
+ Xen_check_type(Xen_is_XColor(arg4), arg4, 4, "XCreatePixmapCursor", "XColor");
+ Xen_check_type(Xen_is_XColor(arg5), arg5, 5, "XCreatePixmapCursor", "XColor");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XCreatePixmapCursor", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XCreatePixmapCursor", "unsigned int");
+ return(C_to_Xen_Cursor(XCreatePixmapCursor(Xen_to_C_Display(arg1),
+ Xen_to_C_Pixmap(arg2),
+ (Xen_is_Pixmap(arg3)) ? Xen_to_C_Pixmap(arg3) : None,
+ Xen_to_C_XColor(arg4),
+ Xen_to_C_XColor(arg5),
+ Xen_ulong_to_C_ulong(arg6), Xen_ulong_to_C_ulong(arg7))));
+}
+
+static Xen gxm_XCreateColormap(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XCreateColormap "Colormap XCreateColormap(display, w, visual, alloc) creates a colormap of the specified visual type for \
the screen on which the specified window resides and returns the colormap ID associated with it."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateColormap", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XCreateColormap", "Window");
- XEN_ASSERT_TYPE(XEN_Visual_P(arg3), arg3, 3, "XCreateColormap", "Visual*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XCreateColormap", "int");
- return(C_TO_XEN_Colormap(XCreateColormap(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Visual(arg3), XEN_TO_C_INT(arg4))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateColormap", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XCreateColormap", "Window");
+ Xen_check_type(Xen_is_Visual(arg3), arg3, 3, "XCreateColormap", "Visual*");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XCreateColormap", "int");
+ return(C_to_Xen_Colormap(XCreateColormap(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Visual(arg3), Xen_integer_to_C_int(arg4))));
}
-static XEN gxm_XCopyColormapAndFree(XEN arg1, XEN arg2)
+static Xen gxm_XCopyColormapAndFree(Xen arg1, Xen arg2)
{
#define H_XCopyColormapAndFree "Colormap XCopyColormapAndFree(display, colormap) creates a colormap of the same visual type and \
for the same screen as the specified colormap and returns the new colormap ID."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCopyColormapAndFree", "Display*");
- XEN_ASSERT_TYPE(XEN_Colormap_P(arg2), arg2, 2, "XCopyColormapAndFree", "Colormap");
- return(C_TO_XEN_Colormap(XCopyColormapAndFree(XEN_TO_C_Display(arg1), XEN_TO_C_Colormap(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCopyColormapAndFree", "Display*");
+ Xen_check_type(Xen_is_Colormap(arg2), arg2, 2, "XCopyColormapAndFree", "Colormap");
+ return(C_to_Xen_Colormap(XCopyColormapAndFree(Xen_to_C_Display(arg1), Xen_to_C_Colormap(arg2))));
}
-static XEN gxm_XInternAtom(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XInternAtom(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XInternAtom "Atom XInternAtom(display, atom_name, only_if_exists): returns the atom identifier associated with the specified atom_name string."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XInternAtom", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XInternAtom", "char*");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XInternAtom", "Bool");
- return(C_TO_XEN_Atom(XInternAtom(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2), XEN_TO_C_BOOLEAN(arg3))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XInternAtom", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XInternAtom", "char*");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XInternAtom", "Bool");
+ return(C_to_Xen_Atom(XInternAtom(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2), Xen_boolean_to_C_bool(arg3))));
}
-static XEN xm_AfterFunction;
+static Xen xm_AfterFunction;
static int default_after_function(Display *ignore) {return(0);}
static int gxm_AfterFunction(Display *dpy)
{
- return(XEN_TO_C_INT(XEN_CALL_1(xm_AfterFunction,
- C_TO_XEN_Display(dpy),
- c__FUNCTION__)));
+ return(Xen_integer_to_C_int(Xen_call_with_1_arg(xm_AfterFunction,
+ C_to_Xen_Display(dpy),
+ __func__)));
}
-static XEN gxm_XSetAfterFunction(XEN arg1, XEN arg2)
+static Xen gxm_XSetAfterFunction(Xen arg1, Xen arg2)
{
#define H_XSetAfterFunction "XSetAfterFunction(dpy, proc) sets a function (one arg: dpy) to be called after every X function call"
- XEN old_func;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSetAfterFunction", "Display*");
+ Xen old_func;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSetAfterFunction", "Display*");
xm_protect(arg2);
old_func = xm_AfterFunction;
xm_AfterFunction = arg2;
- if (XEN_PROCEDURE_P(arg2))
- XSetAfterFunction(XEN_TO_C_Display(arg1), gxm_AfterFunction);
- else XSetAfterFunction(XEN_TO_C_Display(arg1), default_after_function);
- if (XEN_PROCEDURE_P(old_func)) xm_unprotect(old_func);
+ if (Xen_is_procedure(arg2))
+ XSetAfterFunction(Xen_to_C_Display(arg1), gxm_AfterFunction);
+ else XSetAfterFunction(Xen_to_C_Display(arg1), default_after_function);
+ if (Xen_is_procedure(old_func)) xm_unprotect(old_func);
return(old_func);
}
-static XEN gxm_XSynchronize(XEN arg1, XEN arg2)
+static Xen gxm_XSynchronize(Xen arg1, Xen arg2)
{
#define H_XSynchronize "int (*XSynchronize(display, onoff))() turns on/off synchronous behavior."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XSynchronize", "Display*");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XSynchronize", "boolean");
- XSynchronize(XEN_TO_C_Display(arg1),
- XEN_TO_C_BOOLEAN(arg2));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XSynchronize", "Display*");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XSynchronize", "boolean");
+ XSynchronize(Xen_to_C_Display(arg1),
+ Xen_boolean_to_C_bool(arg2));
return(xm_AfterFunction);
}
-static XEN gxm_XKeysymToString(XEN arg1)
+static Xen gxm_XKeysymToString(Xen arg1)
{
#define H_XKeysymToString "char *XKeysymToString(keysym)"
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg1), arg1, 1, "XKeysymToString", "KeySym");
- return(C_TO_XEN_STRING(XKeysymToString(XEN_TO_C_KeySym(arg1))));
+ Xen_check_type(Xen_is_KeySym(arg1), arg1, 1, "XKeysymToString", "KeySym");
+ return(C_string_to_Xen_string(XKeysymToString(Xen_to_C_KeySym(arg1))));
}
-static XEN gxm_XDisplayName(XEN arg1)
+static Xen gxm_XDisplayName(Xen arg1)
{
#define H_XDisplayName "char *XDisplayName(string): returns the name of the display that XOpenDisplay would attempt to use."
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XDisplayName", "char*");
- return(C_TO_XEN_STRING(XDisplayName((char *)XEN_TO_C_STRING(arg1))));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XDisplayName", "char*");
+ return(C_string_to_Xen_string(XDisplayName((char *)Xen_string_to_C_string(arg1))));
}
-static XEN gxm_XGetAtomName(XEN arg1, XEN arg2)
+static Xen gxm_XGetAtomName(Xen arg1, Xen arg2)
{
#define H_XGetAtomName "char *XGetAtomName(display, atom): returns the name associated with the specified atom."
char *str;
- XEN res;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetAtomName", "Display*");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XGetAtomName", "Atom");
- str = XGetAtomName(XEN_TO_C_Display(arg1), XEN_TO_C_Atom(arg2));
- res = C_TO_XEN_STRING(str);
+ Xen res;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetAtomName", "Display*");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XGetAtomName", "Atom");
+ str = XGetAtomName(Xen_to_C_Display(arg1), Xen_to_C_Atom(arg2));
+ res = C_string_to_Xen_string(str);
XFree(str);
return(res);
}
-static XEN gxm_XFetchBuffer(XEN arg1, XEN arg2)
+static Xen gxm_XFetchBuffer(Xen arg1, Xen arg2)
{
- #define H_XFetchBuffer "char *XFetchBuffer(display, buffer): returns #f if there \
+ #define H_XFetchBuffer "char *XFetchBuffer(display, buffer): returns " PROC_FALSE " if there \
is no data in the buffer or if an invalid buffer is specified, otherwise a string."
int len = 0;
char *buf;
- XEN lst = XEN_FALSE;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFetchBuffer", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XFetchBuffer", "int");
- buf = XFetchBuffer(XEN_TO_C_Display(arg1), &len, XEN_TO_C_INT(arg2));
+ Xen lst = Xen_false;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFetchBuffer", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XFetchBuffer", "int");
+ buf = XFetchBuffer(Xen_to_C_Display(arg1), &len, Xen_integer_to_C_int(arg2));
if (len > 0)
{
- lst = C_TO_XEN_STRING(buf);
+ lst = C_string_to_Xen_string(buf);
free(buf);
}
return(lst);
}
-static XEN gxm_XFetchBytes(XEN arg1)
+static Xen gxm_XFetchBytes(Xen arg1)
{
#define H_XFetchBytes "char *XFetchBytes(display): returns the string in cut buffer 0"
/* DIFF: XFetchBytes returns string, omits arg2
*/
int len = 0;
char *buf;
- XEN lst = XEN_FALSE;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XFetchBytes", "Display*");
- buf = XFetchBytes(XEN_TO_C_Display(arg1), &len);
+ Xen lst = Xen_false;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XFetchBytes", "Display*");
+ buf = XFetchBytes(Xen_to_C_Display(arg1), &len);
if (len > 0)
{
- lst = C_TO_XEN_STRING(buf);
+ lst = C_string_to_Xen_string(buf);
free(buf);
}
return(lst);
}
-static XEN gxm_XOpenDisplay(XEN arg1)
+static Xen gxm_XOpenDisplay(Xen arg1)
{
#define H_XOpenDisplay "Display *XOpenDisplay(display_name): returns a Display structure that serves as the connection to the X server \
and that contains all the information about that X server."
Display *dpy;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1) || XEN_FALSE_P(arg1), arg1, 1, "XOpenDisplay", "char*");
- dpy = XOpenDisplay(XEN_FALSE_P(arg1) ? NULL : (char *)XEN_TO_C_STRING(arg1));
+ Xen_check_type(Xen_is_string(arg1) || Xen_is_false(arg1), arg1, 1, "XOpenDisplay", "char*");
+ dpy = XOpenDisplay(Xen_is_false(arg1) ? NULL : (char *)Xen_string_to_C_string(arg1));
if (dpy)
- return(C_TO_XEN_Display(dpy));
- return(XEN_FALSE);
+ return(C_to_Xen_Display(dpy));
+ return(Xen_false);
}
-static XEN gxm_XGetSubImage(XEN args)
+static Xen gxm_XGetSubImage(Xen args)
{
#define H_XGetSubImage "XImage *XGetSubImage(display, d, x, y, width, height, plane_mask, format, dest_image, dest_x, dest_y) updates \
dest_image with the specified subimage in the same manner as "
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- arg11 = XEN_LIST_REF(args, 10);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetSubImage", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetSubImage", "Drawable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XGetSubImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XGetSubImage", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XGetSubImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XGetSubImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XGetSubImage", "ulong");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XGetSubImage", "int");
- XEN_ASSERT_TYPE(XEN_XImage_P(arg9), arg9, 9, "XGetSubImage", "XImage*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg10), arg10, 10, "XGetSubImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg11), arg11, 11, "XGetSubImage", "int");
- return(C_TO_XEN_XImage(XGetSubImage(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4),
- XEN_TO_C_ULONG(arg5), XEN_TO_C_ULONG(arg6),
- XEN_TO_C_ULONG(arg7), XEN_TO_C_INT(arg8),
- XEN_TO_C_XImage(arg9),
- XEN_TO_C_INT(arg10), XEN_TO_C_INT(arg11))));
-}
-
-static XEN gxm_XGetImage(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ arg11 = Xen_list_ref(args, 10);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetSubImage", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetSubImage", "Drawable");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XGetSubImage", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XGetSubImage", "int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XGetSubImage", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XGetSubImage", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XGetSubImage", "ulong");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XGetSubImage", "int");
+ Xen_check_type(Xen_is_XImage(arg9), arg9, 9, "XGetSubImage", "XImage*");
+ Xen_check_type(Xen_is_integer(arg10), arg10, 10, "XGetSubImage", "int");
+ Xen_check_type(Xen_is_integer(arg11), arg11, 11, "XGetSubImage", "int");
+ return(C_to_Xen_XImage(XGetSubImage(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4),
+ Xen_ulong_to_C_ulong(arg5), Xen_ulong_to_C_ulong(arg6),
+ Xen_ulong_to_C_ulong(arg7), Xen_integer_to_C_int(arg8),
+ Xen_to_C_XImage(arg9),
+ Xen_integer_to_C_int(arg10), Xen_integer_to_C_int(arg11))));
+}
+
+static Xen gxm_XGetImage(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
#define H_XGetImage "XImage *XGetImage(display, d, x, y, width, height, plane_mask, format): returns a pointer to an XImage structure."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetImage", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetImage", "Drawable");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XGetImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XGetImage", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XGetImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XGetImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XGetImage", "ulong");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg8), arg8, 8, "XGetImage", "int");
- return(C_TO_XEN_XImage(XGetImage(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4),
- XEN_TO_C_ULONG(arg5), XEN_TO_C_ULONG(arg6),
- XEN_TO_C_ULONG(arg7), XEN_TO_C_INT(arg8))));
-}
-
-static XEN gxm_XCreateImage(XEN args)
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetImage", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetImage", "Drawable");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XGetImage", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XGetImage", "int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XGetImage", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XGetImage", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XGetImage", "ulong");
+ Xen_check_type(Xen_is_integer(arg8), arg8, 8, "XGetImage", "int");
+ return(C_to_Xen_XImage(XGetImage(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4),
+ Xen_ulong_to_C_ulong(arg5), Xen_ulong_to_C_ulong(arg6),
+ Xen_ulong_to_C_ulong(arg7), Xen_integer_to_C_int(arg8))));
+}
+
+static Xen gxm_XCreateImage(Xen args)
{
#define H_XCreateImage "XImage *XCreateImage(display, visual, depth, format, offset, data, width, height, bitmap_pad, bytes_per_line) \
allocates the memory needed for an XImage structure for the specified display but does not allocate space for the image itself."
- XEN arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10;
- arg1 = XEN_LIST_REF(args, 0);
- arg2 = XEN_LIST_REF(args, 1);
- arg3 = XEN_LIST_REF(args, 2);
- arg4 = XEN_LIST_REF(args, 3);
- arg5 = XEN_LIST_REF(args, 4);
- arg6 = XEN_LIST_REF(args, 5);
- arg7 = XEN_LIST_REF(args, 6);
- arg8 = XEN_LIST_REF(args, 7);
- arg9 = XEN_LIST_REF(args, 8);
- arg10 = XEN_LIST_REF(args, 9);
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XCreateImage", "Display*");
- XEN_ASSERT_TYPE(XEN_Visual_P(arg2), arg2, 2, "XCreateImage", "Visual*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XCreateImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XCreateImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XCreateImage", "int");
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg6), arg6, 6, "XCreateImage", "pointer");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg7), arg7, 7, "XCreateImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg8), arg8, 8, "XCreateImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9), arg9, 9, "XCreateImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg10), arg10, 10, "XCreateImage", "int");
- return(C_TO_XEN_XImage(XCreateImage(XEN_TO_C_Display(arg1),
- XEN_TO_C_Visual(arg2),
- XEN_TO_C_ULONG(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- (char *)XEN_UNWRAP_C_POINTER(arg6),
- XEN_TO_C_ULONG(arg7), XEN_TO_C_ULONG(arg8),
- XEN_TO_C_INT(arg9), XEN_TO_C_INT(arg10))));
-}
-
-static XEN gxm_XNewModifiermap(XEN arg1)
+ Xen arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10;
+ arg1 = Xen_list_ref(args, 0);
+ arg2 = Xen_list_ref(args, 1);
+ arg3 = Xen_list_ref(args, 2);
+ arg4 = Xen_list_ref(args, 3);
+ arg5 = Xen_list_ref(args, 4);
+ arg6 = Xen_list_ref(args, 5);
+ arg7 = Xen_list_ref(args, 6);
+ arg8 = Xen_list_ref(args, 7);
+ arg9 = Xen_list_ref(args, 8);
+ arg10 = Xen_list_ref(args, 9);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XCreateImage", "Display*");
+ Xen_check_type(Xen_is_Visual(arg2), arg2, 2, "XCreateImage", "Visual*");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XCreateImage", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XCreateImage", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XCreateImage", "int");
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg6), arg6, 6, "XCreateImage", "pointer");
+ Xen_check_type(Xen_is_ulong(arg7), arg7, 7, "XCreateImage", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg8), arg8, 8, "XCreateImage", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg9), arg9, 9, "XCreateImage", "int");
+ Xen_check_type(Xen_is_integer(arg10), arg10, 10, "XCreateImage", "int");
+ return(C_to_Xen_XImage(XCreateImage(Xen_to_C_Display(arg1),
+ Xen_to_C_Visual(arg2),
+ Xen_ulong_to_C_ulong(arg3), Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ (char *)Xen_unwrap_C_pointer(arg6),
+ Xen_ulong_to_C_ulong(arg7), Xen_ulong_to_C_ulong(arg8),
+ Xen_integer_to_C_int(arg9), Xen_integer_to_C_int(arg10))));
+}
+
+static Xen gxm_XNewModifiermap(Xen arg1)
{
#define H_XNewModifiermap "XModifierKeymap *XNewModifiermap(max_keys_per_mod): returns a pointer to XModifierKeymap structure for later use."
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 1, "XNewModifiermap", "int");
- return(C_TO_XEN_XModifierKeymap(XNewModifiermap(XEN_TO_C_INT(arg1))));
+ Xen_check_type(Xen_is_integer(arg1), arg1, 1, "XNewModifiermap", "int");
+ return(C_to_Xen_XModifierKeymap(XNewModifiermap(Xen_integer_to_C_int(arg1))));
}
-static XEN gxm_XInsertModifiermapEntry(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XInsertModifiermapEntry(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XInsertModifiermapEntry "XModifierKeymap *XInsertModifiermapEntry(modmap, keycode_entry, modifier) adds the specified KeyCode to \
the set that controls the specified modifier and returns the resulting XModifierKeymap structure (expanded as needed)."
- XEN_ASSERT_TYPE(XEN_XModifierKeymap_P(arg1), arg1, 1, "XInsertModifiermapEntry", "XModifierKeymap*");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XInsertModifiermapEntry", "KeyCode");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XInsertModifiermapEntry", "int");
- return(C_TO_XEN_XModifierKeymap(XInsertModifiermapEntry(XEN_TO_C_XModifierKeymap(arg1), XEN_TO_C_KeyCode(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_XModifierKeymap(arg1), arg1, 1, "XInsertModifiermapEntry", "XModifierKeymap*");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XInsertModifiermapEntry", "KeyCode");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XInsertModifiermapEntry", "int");
+ return(C_to_Xen_XModifierKeymap(XInsertModifiermapEntry(Xen_to_C_XModifierKeymap(arg1), Xen_to_C_KeyCode(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XGetModifierMapping(XEN arg1)
+static Xen gxm_XGetModifierMapping(Xen arg1)
{
#define H_XGetModifierMapping "XModifierKeymap *XGetModifierMapping(display): returns a pointer to a newly created XModifierKeymap structure \
that contains the keys being used as modifiers."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetModifierMapping", "Display*");
- return(C_TO_XEN_XModifierKeymap(XGetModifierMapping(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetModifierMapping", "Display*");
+ return(C_to_Xen_XModifierKeymap(XGetModifierMapping(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XDeleteModifiermapEntry(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XDeleteModifiermapEntry(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XDeleteModifiermapEntry "XModifierKeymap *XDeleteModifiermapEntry(modmap, keycode_entry, modifier) deletes the specified KeyCode \
from the set that controls the specified modifier and returns a pointer to the resulting XModifierKeymap structure."
- XEN_ASSERT_TYPE(XEN_XModifierKeymap_P(arg1), arg1, 1, "XDeleteModifiermapEntry", "XModifierKeymap*");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XDeleteModifiermapEntry", "KeyCode");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XDeleteModifiermapEntry", "int");
- return(C_TO_XEN_XModifierKeymap(XDeleteModifiermapEntry(XEN_TO_C_XModifierKeymap(arg1), XEN_TO_C_KeyCode(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_XModifierKeymap(arg1), arg1, 1, "XDeleteModifiermapEntry", "XModifierKeymap*");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XDeleteModifiermapEntry", "KeyCode");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XDeleteModifiermapEntry", "int");
+ return(C_to_Xen_XModifierKeymap(XDeleteModifiermapEntry(Xen_to_C_XModifierKeymap(arg1), Xen_to_C_KeyCode(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XGetMotionEvents(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XGetMotionEvents(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XGetMotionEvents "XTimeCoord *XGetMotionEvents(display, w, start, stop): returns all events in the motion history \
buffer that fall between the specified start and stop times, inclusive, and that have coordinates that lie within the specified window \
@@ -12837,450 +12561,450 @@ buffer that fall between the specified start and stop times, inclusive, and that
*/
int n, i, loc;
XTimeCoord *tcs;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XGetMotionEvents", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XGetMotionEvents", "Window");
- XEN_ASSERT_TYPE(XEN_Time_P(arg3), arg3, 3, "XGetMotionEvents", "Time");
- XEN_ASSERT_TYPE(XEN_Time_P(arg4), arg4, 4, "XGetMotionEvents", "Time");
- tcs = XGetMotionEvents(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2), XEN_TO_C_Time(arg3), XEN_TO_C_Time(arg4), &n);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XGetMotionEvents", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XGetMotionEvents", "Window");
+ Xen_check_type(Xen_is_Time(arg3), arg3, 3, "XGetMotionEvents", "Time");
+ Xen_check_type(Xen_is_Time(arg4), arg4, 4, "XGetMotionEvents", "Time");
+ tcs = XGetMotionEvents(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2), Xen_to_C_Time(arg3), Xen_to_C_Time(arg4), &n);
loc = xm_protect(lst);
for (i = n - 1; i > 0; i--)
- lst = XEN_CONS(XEN_LIST_3(C_TO_XEN_Time(tcs->time),
- C_TO_XEN_INT((int)(tcs->x)),
- C_TO_XEN_INT((int)(tcs->y))),
+ lst = Xen_cons(Xen_list_3(C_to_Xen_Time(tcs->time),
+ C_int_to_Xen_integer((int)(tcs->x)),
+ C_int_to_Xen_integer((int)(tcs->y))),
lst);
XFree(tcs); /* free each as well? */
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XQueryFont(XEN arg1, XEN arg2)
+static Xen gxm_XQueryFont(Xen arg1, Xen arg2)
{
#define H_XQueryFont "XFontStruct *XQueryFont(display, font): returns a pointer to the XFontStruct structure, which contains information \
associated with the font."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XQueryFont", "Display*");
- XEN_ASSERT_TYPE(XEN_Font_P(arg2), arg2, 2, "XQueryFont", "Font");
- return(C_TO_XEN_XFontStruct(XQueryFont(XEN_TO_C_Display(arg1), XEN_TO_C_Font(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XQueryFont", "Display*");
+ Xen_check_type(Xen_is_Font(arg2), arg2, 2, "XQueryFont", "Font");
+ return(C_to_Xen_XFontStruct(XQueryFont(Xen_to_C_Display(arg1), Xen_to_C_Font(arg2))));
}
-static XEN gxm_XLoadQueryFont(XEN arg1, XEN arg2)
+static Xen gxm_XLoadQueryFont(Xen arg1, Xen arg2)
{
#define H_XLoadQueryFont "XFontStruct *XLoadQueryFont(display, name) provides the most common way for accessing a font. XLoadQueryFont \
both opens (loads) the specified font and returns a pointer to the appropriate XFontStruct structure."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XLoadQueryFont", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XLoadQueryFont", "char*");
- return(C_TO_XEN_XFontStruct(XLoadQueryFont(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XLoadQueryFont", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XLoadQueryFont", "char*");
+ return(C_to_Xen_XFontStruct(XLoadQueryFont(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2))));
}
-static XEN gxm_DefaultScreen(XEN arg)
+static Xen gxm_DefaultScreen(Xen arg)
{
#define H_DefaultScreen "returns the default screen number referenced in the XOpenDisplay routine."
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "DefaultScreen", "Display*");
- return(C_TO_XEN_INT(DefaultScreen(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "DefaultScreen", "Display*");
+ return(C_int_to_Xen_integer(DefaultScreen(Xen_to_C_Display(arg))));
}
-static XEN gxm_DefaultRootWindow(XEN arg)
+static Xen gxm_DefaultRootWindow(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "DefaultRootWindow", "Display*");
- return(C_TO_XEN_Window(DefaultRootWindow(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "DefaultRootWindow", "Display*");
+ return(C_to_Xen_Window(DefaultRootWindow(Xen_to_C_Display(arg))));
}
-static XEN gxm_QLength(XEN arg)
+static Xen gxm_QLength(Xen arg)
{
/* QLength(display) */
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "QLength", "Display*");
- return(C_TO_XEN_INT(QLength(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "QLength", "Display*");
+ return(C_int_to_Xen_integer(QLength(Xen_to_C_Display(arg))));
}
-static XEN gxm_ScreenCount(XEN arg1)
+static Xen gxm_ScreenCount(Xen arg1)
{
/* ScreenCount(display) */
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "ScreenCount", "Display*");
- return(C_TO_XEN_INT(XScreenCount(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "ScreenCount", "Display*");
+ return(C_int_to_Xen_integer(XScreenCount(Xen_to_C_Display(arg1))));
}
-static XEN gxm_ServerVendor(XEN arg)
+static Xen gxm_ServerVendor(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "ServerVendor", "Display*");
- return(C_TO_XEN_STRING(ServerVendor(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "ServerVendor", "Display*");
+ return(C_string_to_Xen_string(ServerVendor(Xen_to_C_Display(arg))));
}
-static XEN gxm_ProtocolVersion(XEN arg)
+static Xen gxm_ProtocolVersion(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "ProtocolVersion", "Display*");
- return(C_TO_XEN_INT(ProtocolVersion(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "ProtocolVersion", "Display*");
+ return(C_int_to_Xen_integer(ProtocolVersion(Xen_to_C_Display(arg))));
}
-static XEN gxm_ProtocolRevision(XEN arg)
+static Xen gxm_ProtocolRevision(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "ProtocolRevision", "Display*");
- return(C_TO_XEN_INT(ProtocolRevision(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "ProtocolRevision", "Display*");
+ return(C_int_to_Xen_integer(ProtocolRevision(Xen_to_C_Display(arg))));
}
-static XEN gxm_VendorRelease(XEN arg)
+static Xen gxm_VendorRelease(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "VendorRelease", "Display*");
- return(C_TO_XEN_INT(VendorRelease(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "VendorRelease", "Display*");
+ return(C_int_to_Xen_integer(VendorRelease(Xen_to_C_Display(arg))));
}
-static XEN gxm_DisplayString(XEN arg)
+static Xen gxm_DisplayString(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "DisplayString", "Display*");
- return(C_TO_XEN_STRING(DisplayString(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "DisplayString", "Display*");
+ return(C_string_to_Xen_string(DisplayString(Xen_to_C_Display(arg))));
}
-static XEN gxm_BitmapUnit(XEN arg)
+static Xen gxm_BitmapUnit(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "BitmapUnit", "Display*");
- return(C_TO_XEN_INT(BitmapUnit(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "BitmapUnit", "Display*");
+ return(C_int_to_Xen_integer(BitmapUnit(Xen_to_C_Display(arg))));
}
-static XEN gxm_BitmapBitOrder(XEN arg)
+static Xen gxm_BitmapBitOrder(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "BitmapBitOrder", "Display*");
- return(C_TO_XEN_INT(BitmapBitOrder(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "BitmapBitOrder", "Display*");
+ return(C_int_to_Xen_integer(BitmapBitOrder(Xen_to_C_Display(arg))));
}
-static XEN gxm_BitmapPad(XEN arg)
+static Xen gxm_BitmapPad(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "BitmapPad", "Display*");
- return(C_TO_XEN_INT(BitmapPad(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "BitmapPad", "Display*");
+ return(C_int_to_Xen_integer(BitmapPad(Xen_to_C_Display(arg))));
}
-static XEN gxm_ImageByteOrder(XEN arg)
+static Xen gxm_ImageByteOrder(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "ImageByteOrder", "Display*");
- return(C_TO_XEN_INT(ImageByteOrder(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "ImageByteOrder", "Display*");
+ return(C_int_to_Xen_integer(ImageByteOrder(Xen_to_C_Display(arg))));
}
-static XEN gxm_NextRequest(XEN arg)
+static Xen gxm_NextRequest(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "NextRequest", "Display*");
- return(C_TO_XEN_ULONG(NextRequest(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "NextRequest", "Display*");
+ return(C_ulong_to_Xen_ulong(NextRequest(Xen_to_C_Display(arg))));
}
-static XEN gxm_LastKnownRequestProcessed(XEN arg)
+static Xen gxm_LastKnownRequestProcessed(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "LastKnownRequestProcessed", "Display*");
- return(C_TO_XEN_ULONG(LastKnownRequestProcessed(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "LastKnownRequestProcessed", "Display*");
+ return(C_ulong_to_Xen_ulong(LastKnownRequestProcessed(Xen_to_C_Display(arg))));
}
-static XEN gxm_DefaultScreenOfDisplay(XEN arg)
+static Xen gxm_DefaultScreenOfDisplay(Xen arg)
{
#define H_DefaultScreenOfDisplay "returns the default screen of the specified display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg), arg, 0, "DefaultScreenOfDisplay", "Display");
- return(C_TO_XEN_Screen(DefaultScreenOfDisplay(XEN_TO_C_Display(arg))));
+ Xen_check_type(Xen_is_Display(arg), arg, 0, "DefaultScreenOfDisplay", "Display");
+ return(C_to_Xen_Screen(DefaultScreenOfDisplay(Xen_to_C_Display(arg))));
}
-static XEN gxm_DisplayOfScreen(XEN arg)
+static Xen gxm_DisplayOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "DisplayOfScreen", "Screen");
- return(C_TO_XEN_Display(DisplayOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "DisplayOfScreen", "Screen");
+ return(C_to_Xen_Display(DisplayOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_RootWindowOfScreen(XEN arg)
+static Xen gxm_RootWindowOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "RootWindowOfScreen", "Screen");
- return(C_TO_XEN_Window(RootWindowOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "RootWindowOfScreen", "Screen");
+ return(C_to_Xen_Window(RootWindowOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_BlackPixelOfScreen(XEN arg)
+static Xen gxm_BlackPixelOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "BlackPixelOfScreen", "Screen");
- return(C_TO_XEN_Pixel(BlackPixelOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "BlackPixelOfScreen", "Screen");
+ return(C_to_Xen_Pixel(BlackPixelOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_WhitePixelOfScreen(XEN arg)
+static Xen gxm_WhitePixelOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "WhitePixelOfScreen", "Screen");
- return(C_TO_XEN_Pixel(WhitePixelOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "WhitePixelOfScreen", "Screen");
+ return(C_to_Xen_Pixel(WhitePixelOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_DefaultColormapOfScreen(XEN arg)
+static Xen gxm_DefaultColormapOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "DefaultColormapOfScreen", "Screen");
- return(C_TO_XEN_Colormap(DefaultColormapOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "DefaultColormapOfScreen", "Screen");
+ return(C_to_Xen_Colormap(DefaultColormapOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_DefaultDepthOfScreen(XEN arg)
+static Xen gxm_DefaultDepthOfScreen(Xen arg)
{
/* DefaultDepthOfScreen(screen) */
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "DefaultDepthOfScreen", "Screen");
- return(C_TO_XEN_INT(DefaultDepthOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "DefaultDepthOfScreen", "Screen");
+ return(C_int_to_Xen_integer(DefaultDepthOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_DefaultGCOfScreen(XEN arg)
+static Xen gxm_DefaultGCOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "DefaultGCOfScreen", "Screen");
- return(C_TO_XEN_GC(DefaultGCOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "DefaultGCOfScreen", "Screen");
+ return(C_to_Xen_GC(DefaultGCOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_DefaultVisualOfScreen(XEN arg)
+static Xen gxm_DefaultVisualOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "DefaultVisualOfScreen", "Screen");
- return(C_TO_XEN_Visual(DefaultVisualOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "DefaultVisualOfScreen", "Screen");
+ return(C_to_Xen_Visual(DefaultVisualOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_WidthOfScreen(XEN arg)
+static Xen gxm_WidthOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "WidthOfScreen", "Screen");
- return(C_TO_XEN_INT(WidthOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "WidthOfScreen", "Screen");
+ return(C_int_to_Xen_integer(WidthOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_HeightOfScreen(XEN arg)
+static Xen gxm_HeightOfScreen(Xen arg)
{
/* HeightOfScreen(screen) */
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "HeightOfScreen", "Screen");
- return(C_TO_XEN_INT(HeightOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "HeightOfScreen", "Screen");
+ return(C_int_to_Xen_integer(HeightOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_WidthMMOfScreen(XEN arg)
+static Xen gxm_WidthMMOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "WidthMMOfScreen", "Screen");
- return(C_TO_XEN_INT(WidthMMOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "WidthMMOfScreen", "Screen");
+ return(C_int_to_Xen_integer(WidthMMOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_HeightMMOfScreen(XEN arg)
+static Xen gxm_HeightMMOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "HeightMMOfScreen", "Screen");
- return(C_TO_XEN_INT(HeightMMOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "HeightMMOfScreen", "Screen");
+ return(C_int_to_Xen_integer(HeightMMOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_PlanesOfScreen(XEN arg)
+static Xen gxm_PlanesOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "PlanesOfScreen", "Screen");
- return(C_TO_XEN_INT(PlanesOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "PlanesOfScreen", "Screen");
+ return(C_int_to_Xen_integer(PlanesOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_CellsOfScreen(XEN arg)
+static Xen gxm_CellsOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "CellsOfScreen", "Screen");
- return(C_TO_XEN_INT(CellsOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "CellsOfScreen", "Screen");
+ return(C_int_to_Xen_integer(CellsOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_MinCmapsOfScreen(XEN arg)
+static Xen gxm_MinCmapsOfScreen(Xen arg)
{
/* MinCmapsOfScreen(screen) */
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "MinCmapsOfScreen", "Screen");
- return(C_TO_XEN_INT(MinCmapsOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "MinCmapsOfScreen", "Screen");
+ return(C_int_to_Xen_integer(MinCmapsOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_MaxCmapsOfScreen(XEN arg)
+static Xen gxm_MaxCmapsOfScreen(Xen arg)
{
/* MaxCmapsOfScreen(screen) */
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "MaxCmapsOfScreen", "Screen");
- return(C_TO_XEN_INT(MaxCmapsOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "MaxCmapsOfScreen", "Screen");
+ return(C_int_to_Xen_integer(MaxCmapsOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_DoesSaveUnders(XEN arg)
+static Xen gxm_DoesSaveUnders(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "DoesSaveUnders", "Screen");
- return(C_TO_XEN_BOOLEAN(DoesSaveUnders(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "DoesSaveUnders", "Screen");
+ return(C_bool_to_Xen_boolean(DoesSaveUnders(Xen_to_C_Screen(arg))));
}
-static XEN gxm_DoesBackingStore(XEN arg)
+static Xen gxm_DoesBackingStore(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "DoesBackingStore", "Screen");
- return(C_TO_XEN_BOOLEAN(DoesBackingStore(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "DoesBackingStore", "Screen");
+ return(C_bool_to_Xen_boolean(DoesBackingStore(Xen_to_C_Screen(arg))));
}
-static XEN gxm_EventMaskOfScreen(XEN arg)
+static Xen gxm_EventMaskOfScreen(Xen arg)
{
- XEN_ASSERT_TYPE(XEN_Screen_P(arg), arg, 0, "EventMaskOfScreen", "Screen");
- return(C_TO_XEN_ULONG(EventMaskOfScreen(XEN_TO_C_Screen(arg))));
+ Xen_check_type(Xen_is_Screen(arg), arg, 0, "EventMaskOfScreen", "Screen");
+ return(C_ulong_to_Xen_ulong(EventMaskOfScreen(Xen_to_C_Screen(arg))));
}
-static XEN gxm_RootWindow(XEN arg1, XEN arg2)
+static Xen gxm_RootWindow(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "RootWindow", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "RootWindow", "int");
- return(C_TO_XEN_Window(RootWindow(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "RootWindow", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "RootWindow", "int");
+ return(C_to_Xen_Window(RootWindow(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DefaultVisual(XEN arg1, XEN arg2)
+static Xen gxm_DefaultVisual(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DefaultVisual", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DefaultVisual", "int");
- return(C_TO_XEN_Visual(DefaultVisual(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DefaultVisual", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DefaultVisual", "int");
+ return(C_to_Xen_Visual(DefaultVisual(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DefaultGC(XEN arg1, XEN arg2)
+static Xen gxm_DefaultGC(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DefaultGC", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DefaultGC", "int");
- return(C_TO_XEN_GC(DefaultGC(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DefaultGC", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DefaultGC", "int");
+ return(C_to_Xen_GC(DefaultGC(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_BlackPixel(XEN arg1, XEN arg2)
+static Xen gxm_BlackPixel(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "BlackPixel", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "BlackPixel", "int");
- return(C_TO_XEN_Pixel(BlackPixel(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "BlackPixel", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "BlackPixel", "int");
+ return(C_to_Xen_Pixel(BlackPixel(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_WhitePixel(XEN arg1, XEN arg2)
+static Xen gxm_WhitePixel(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "WhitePixel", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "WhitePixel", "int");
- return(C_TO_XEN_Pixel(WhitePixel(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "WhitePixel", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "WhitePixel", "int");
+ return(C_to_Xen_Pixel(WhitePixel(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DisplayWidth(XEN arg1, XEN arg2)
+static Xen gxm_DisplayWidth(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DisplayWidth", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DisplayWidth", "int");
- return(C_TO_XEN_INT(DisplayWidth(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DisplayWidth", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DisplayWidth", "int");
+ return(C_int_to_Xen_integer(DisplayWidth(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DisplayHeight(XEN arg1, XEN arg2)
+static Xen gxm_DisplayHeight(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DisplayHeight", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DisplayHeight", "int");
- return(C_TO_XEN_INT(DisplayHeight(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DisplayHeight", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DisplayHeight", "int");
+ return(C_int_to_Xen_integer(DisplayHeight(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DisplayWidthMM(XEN arg1, XEN arg2)
+static Xen gxm_DisplayWidthMM(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DisplayWidthMM", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DisplayWidthMM", "int");
- return(C_TO_XEN_INT(DisplayWidthMM(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DisplayWidthMM", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DisplayWidthMM", "int");
+ return(C_int_to_Xen_integer(DisplayWidthMM(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DisplayHeightMM(XEN arg1, XEN arg2)
+static Xen gxm_DisplayHeightMM(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DisplayHeightMM", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DisplayHeightMM", "int");
- return(C_TO_XEN_INT(DisplayHeightMM(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DisplayHeightMM", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DisplayHeightMM", "int");
+ return(C_int_to_Xen_integer(DisplayHeightMM(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DisplayPlanes(XEN arg1, XEN arg2)
+static Xen gxm_DisplayPlanes(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DisplayPlanes", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DisplayPlanes", "int");
- return(C_TO_XEN_INT(DisplayPlanes(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DisplayPlanes", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DisplayPlanes", "int");
+ return(C_int_to_Xen_integer(DisplayPlanes(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DisplayCells(XEN arg1, XEN arg2)
+static Xen gxm_DisplayCells(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DisplayCells", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DisplayCells", "int");
- return(C_TO_XEN_INT(DisplayCells(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DisplayCells", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DisplayCells", "int");
+ return(C_int_to_Xen_integer(DisplayCells(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DefaultColormap(XEN arg1, XEN arg2)
+static Xen gxm_DefaultColormap(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DefaultColormap", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DefaultColormap", "int");
- return(C_TO_XEN_Colormap(DefaultColormap(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DefaultColormap", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DefaultColormap", "int");
+ return(C_to_Xen_Colormap(DefaultColormap(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_ScreenOfDisplay(XEN arg1, XEN arg2)
+static Xen gxm_ScreenOfDisplay(Xen arg1, Xen arg2)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "ScreenOfDisplay", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "ScreenOfDisplay", "int");
- return(C_TO_XEN_Screen(ScreenOfDisplay(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "ScreenOfDisplay", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "ScreenOfDisplay", "int");
+ return(C_to_Xen_Screen(ScreenOfDisplay(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_DefaultDepth(XEN arg1, XEN arg2)
+static Xen gxm_DefaultDepth(Xen arg1, Xen arg2)
{
/* DefaultDepth(display, screen_number) */
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "DefaultDepth", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "DefaultDepth", "int");
- return(C_TO_XEN_INT(DefaultDepth(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "DefaultDepth", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "DefaultDepth", "int");
+ return(C_int_to_Xen_integer(DefaultDepth(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_IsKeypadKey(XEN arg)
+static Xen gxm_IsKeypadKey(Xen arg)
{
#define H_IsKeypadKey "IsKeypadKey(keysym): returns " PROC_TRUE " if the specified KeySym is a keypad key."
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg), arg, 0, "IsKeypadKey", "KeySym");
- return(C_TO_XEN_BOOLEAN(IsKeypadKey(XEN_TO_C_KeySym(arg))));
+ Xen_check_type(Xen_is_KeySym(arg), arg, 0, "IsKeypadKey", "KeySym");
+ return(C_bool_to_Xen_boolean(IsKeypadKey(Xen_to_C_KeySym(arg))));
}
-static XEN gxm_IsPrivateKeypadKey(XEN arg)
+static Xen gxm_IsPrivateKeypadKey(Xen arg)
{
#define H_IsPrivateKeypadKey "IsPrivateKeypadKey(keysym): returns " PROC_TRUE " if the specified KeySym is a vendor-private keypad key."
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg), arg, 0, "IsPrivateKeypadKey", "KeySym");
- return(C_TO_XEN_BOOLEAN(IsPrivateKeypadKey(XEN_TO_C_KeySym(arg))));
+ Xen_check_type(Xen_is_KeySym(arg), arg, 0, "IsPrivateKeypadKey", "KeySym");
+ return(C_bool_to_Xen_boolean(IsPrivateKeypadKey(Xen_to_C_KeySym(arg))));
}
-static XEN gxm_IsCursorKey(XEN arg)
+static Xen gxm_IsCursorKey(Xen arg)
{
#define H_IsCursorKey "IsCursorKey(keysym): returns " PROC_TRUE " if the specified KeySym is a cursor key."
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg), arg, 0, "IsCursorKey", "KeySym");
- return(C_TO_XEN_BOOLEAN(IsCursorKey(XEN_TO_C_KeySym(arg))));
+ Xen_check_type(Xen_is_KeySym(arg), arg, 0, "IsCursorKey", "KeySym");
+ return(C_bool_to_Xen_boolean(IsCursorKey(Xen_to_C_KeySym(arg))));
}
-static XEN gxm_IsPFKey(XEN arg)
+static Xen gxm_IsPFKey(Xen arg)
{
#define H_IsPFKey "IsPFKey(keysym): returns " PROC_TRUE " if the specified KeySym is a PF key."
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg), arg, 0, "IsPFKey", "KeySym");
- return(C_TO_XEN_BOOLEAN(IsPFKey(XEN_TO_C_KeySym(arg))));
+ Xen_check_type(Xen_is_KeySym(arg), arg, 0, "IsPFKey", "KeySym");
+ return(C_bool_to_Xen_boolean(IsPFKey(Xen_to_C_KeySym(arg))));
}
-static XEN gxm_IsFunctionKey(XEN arg)
+static Xen gxm_IsFunctionKey(Xen arg)
{
#define H_IsFunctionKey "IsFunctionKey(keysym): returns " PROC_TRUE " if the KeySym is a function key."
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg), arg, 0, "IsFunctionKey", "KeySym");
- return(C_TO_XEN_BOOLEAN(IsFunctionKey(XEN_TO_C_KeySym(arg))));
+ Xen_check_type(Xen_is_KeySym(arg), arg, 0, "IsFunctionKey", "KeySym");
+ return(C_bool_to_Xen_boolean(IsFunctionKey(Xen_to_C_KeySym(arg))));
}
-static XEN gxm_IsMiscFunctionKey(XEN arg)
+static Xen gxm_IsMiscFunctionKey(Xen arg)
{
#define H_IsMiscFunctionKey "IsMiscFunctionKey(keysym): returns " PROC_TRUE " if the specified KeySym is a miscellaneous function key."
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg), arg, 0, "IsMiscFunctionKey", "KeySym");
- return(C_TO_XEN_BOOLEAN(IsMiscFunctionKey(XEN_TO_C_KeySym(arg))));
+ Xen_check_type(Xen_is_KeySym(arg), arg, 0, "IsMiscFunctionKey", "KeySym");
+ return(C_bool_to_Xen_boolean(IsMiscFunctionKey(Xen_to_C_KeySym(arg))));
}
-static XEN gxm_IsModifierKey(XEN arg)
+static Xen gxm_IsModifierKey(Xen arg)
{
#define H_IsModifierKey "IsModifierKey(keysym): returns " PROC_TRUE " if the specified KeySym is a modifier key."
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg), arg, 0, "IsModifierKey", "KeySym");
- return(C_TO_XEN_BOOLEAN(IsModifierKey(XEN_TO_C_KeySym(arg))));
+ Xen_check_type(Xen_is_KeySym(arg), arg, 0, "IsModifierKey", "KeySym");
+ return(C_bool_to_Xen_boolean(IsModifierKey(Xen_to_C_KeySym(arg))));
}
-static XEN gxm_XAddPixel(XEN arg1, XEN arg2)
+static Xen gxm_XAddPixel(Xen arg1, Xen arg2)
{
#define H_XAddPixel "XAddPixel(ximage, value) adds a constant value to every pixel in an image."
- XEN_ASSERT_TYPE(XEN_XImage_P(arg1), arg1, 1, "XAddPixel", "XImage*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XAddPixel", "long");
- return(C_TO_XEN_INT(XAddPixel(XEN_TO_C_XImage(arg1), XEN_TO_C_INT(arg2))));
+ Xen_check_type(Xen_is_XImage(arg1), arg1, 1, "XAddPixel", "XImage*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XAddPixel", "long");
+ return(C_int_to_Xen_integer(XAddPixel(Xen_to_C_XImage(arg1), Xen_integer_to_C_int(arg2))));
}
-static XEN gxm_XSubImage(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XSubImage(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XSubImage "XImage *XSubImage(ximage, x, y, subimage_width, subimage_height) creates a new image that is a subsection of an existing one."
- XEN_ASSERT_TYPE(XEN_XImage_P(arg1), arg1, 1, "XSubImage", "XImage*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XSubImage", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XSubImage", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg4), arg4, 4, "XSubImage", "unsigned int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XSubImage", "unsigned int");
- return(C_TO_XEN_XImage(XSubImage(XEN_TO_C_XImage(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_ULONG(arg4), XEN_TO_C_ULONG(arg5))));
+ Xen_check_type(Xen_is_XImage(arg1), arg1, 1, "XSubImage", "XImage*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XSubImage", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XSubImage", "int");
+ Xen_check_type(Xen_is_ulong(arg4), arg4, 4, "XSubImage", "unsigned int");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XSubImage", "unsigned int");
+ return(C_to_Xen_XImage(XSubImage(Xen_to_C_XImage(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_ulong_to_C_ulong(arg4), Xen_ulong_to_C_ulong(arg5))));
}
-static XEN gxm_XPutPixel(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XPutPixel(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XPutPixel "XPutPixel(ximage, x, y, pixel) overwrites the pixel in the named image with the specified pixel value."
- XEN_ASSERT_TYPE(XEN_XImage_P(arg1), arg1, 1, "XPutPixel", "XImage*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XPutPixel", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XPutPixel", "int");
- XEN_ASSERT_TYPE(XEN_Pixel_P(arg4), arg4, 4, "XPutPixel", "Pixel");
- return(C_TO_XEN_INT(XPutPixel(XEN_TO_C_XImage(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_Pixel(arg4))));
+ Xen_check_type(Xen_is_XImage(arg1), arg1, 1, "XPutPixel", "XImage*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XPutPixel", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XPutPixel", "int");
+ Xen_check_type(Xen_is_Pixel(arg4), arg4, 4, "XPutPixel", "Pixel");
+ return(C_int_to_Xen_integer(XPutPixel(Xen_to_C_XImage(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3), Xen_to_C_Pixel(arg4))));
}
-static XEN gxm_XGetPixel(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XGetPixel(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XGetPixel "Pixel XGetPixel(ximage, x, y): returns the specified pixel from the named image."
- XEN_ASSERT_TYPE(XEN_XImage_P(arg1), arg1, 1, "XGetPixel", "XImage*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XGetPixel", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XGetPixel", "int");
- return(C_TO_XEN_Pixel(XGetPixel(XEN_TO_C_XImage(arg1), XEN_TO_C_INT(arg2), XEN_TO_C_INT(arg3))));
+ Xen_check_type(Xen_is_XImage(arg1), arg1, 1, "XGetPixel", "XImage*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XGetPixel", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XGetPixel", "int");
+ return(C_to_Xen_Pixel(XGetPixel(Xen_to_C_XImage(arg1), Xen_integer_to_C_int(arg2), Xen_integer_to_C_int(arg3))));
}
-static XEN gxm_XDestroyImage(XEN arg1)
+static Xen gxm_XDestroyImage(Xen arg1)
{
#define H_XDestroyImage "XDestroyImage(ximage) deallocates the memory associated with the XImage structure."
- XEN_ASSERT_TYPE(XEN_XImage_P(arg1), arg1, 1, "XDestroyImage", "XImage*");
- return(C_TO_XEN_INT(XDestroyImage(XEN_TO_C_XImage(arg1))));
+ Xen_check_type(Xen_is_XImage(arg1), arg1, 1, "XDestroyImage", "XImage*");
+ return(C_int_to_Xen_integer(XDestroyImage(Xen_to_C_XImage(arg1))));
}
@@ -13305,7 +13029,7 @@ static XEN gxm_XDestroyImage(XEN arg1)
/* thanks to Michael Scholz! */
-static XEN gxm_XShapeQueryExtension(XEN dpy)
+static Xen gxm_XShapeQueryExtension(Xen dpy)
{
#define H_XShapeQueryExtension "(XShapeQueryExtension dpy): returns list of (Bool event_base error_base)"
/* DIFF: (proposal)
@@ -13314,25 +13038,25 @@ static XEN gxm_XShapeQueryExtension(XEN dpy)
*/
int event_base = 0, error_base = 0;
Bool ret = False;
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeQueryExtension", "Display*");
- ret = XShapeQueryExtension(XEN_TO_C_Display(dpy), &event_base, &error_base);
- return(XEN_LIST_3(C_TO_XEN_BOOLEAN(ret), C_TO_XEN_INT(event_base), C_TO_XEN_INT(error_base)));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeQueryExtension", "Display*");
+ ret = XShapeQueryExtension(Xen_to_C_Display(dpy), &event_base, &error_base);
+ return(Xen_list_3(C_bool_to_Xen_boolean(ret), C_int_to_Xen_integer(event_base), C_int_to_Xen_integer(error_base)));
}
-static XEN gxm_XShapeQueryVersion(XEN dpy)
+static Xen gxm_XShapeQueryVersion(Xen dpy)
{
#define H_XShapeQueryVersion "(XShapeQueryVersion dpy): returns list of (Bool major_version minor_version)"
int major = 0, minor = 0;
Bool ret = False;
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeQueryVersion", "Display*");
- ret = XShapeQueryVersion(XEN_TO_C_Display(dpy), &major, &minor);
- return(XEN_LIST_3(C_TO_XEN_BOOLEAN(ret), C_TO_XEN_INT(major), C_TO_XEN_INT(minor)));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeQueryVersion", "Display*");
+ ret = XShapeQueryVersion(Xen_to_C_Display(dpy), &major, &minor);
+ return(Xen_list_3(C_bool_to_Xen_boolean(ret), C_int_to_Xen_integer(major), C_int_to_Xen_integer(minor)));
}
-static XEN gxm_XShapeQueryExtents(XEN dpy, XEN win)
+static Xen gxm_XShapeQueryExtents(Xen dpy, Xen win)
{
#define H_XShapeQueryExtents "(XShapeQueryExtents dpy win): returns list of (status bounding_shaped x_bound y_bound w_bound \
-h_bound clip_shaped x_clip y_clip w_clip h_clip"
+h_bound clip_shaped x_clip y_clip w_clip h_clip)"
Bool bounding_shaped;
int x_bounding;
int y_bounding;
@@ -13344,121 +13068,121 @@ h_bound clip_shaped x_clip y_clip w_clip h_clip"
unsigned int w_clip;
unsigned int h_clip;
Status ret;
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeQueryExtents", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(win), win, XEN_ARG_2, "XShapeQueryExtents", "Window");
- ret = XShapeQueryExtents(XEN_TO_C_Display(dpy), XEN_TO_C_Window(win),
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeQueryExtents", "Display*");
+ Xen_check_type(Xen_is_Window(win), win, 2, "XShapeQueryExtents", "Window");
+ ret = XShapeQueryExtents(Xen_to_C_Display(dpy), Xen_to_C_Window(win),
&bounding_shaped, &x_bounding, &y_bounding, &w_bounding, &h_bounding,
&clip_shaped, &x_clip, &y_clip, &w_clip, &h_clip);
- return(XEN_CONS(C_TO_XEN_INT(ret),
- XEN_CONS(C_TO_XEN_INT(bounding_shaped),
- XEN_LIST_9(C_TO_XEN_INT(x_bounding),
- C_TO_XEN_INT(y_bounding),
- C_TO_XEN_INT(w_bounding),
- C_TO_XEN_INT(h_bounding),
- C_TO_XEN_INT(clip_shaped),
- C_TO_XEN_INT(x_clip),
- C_TO_XEN_INT(y_clip),
- C_TO_XEN_INT(w_clip),
- C_TO_XEN_INT(h_clip)))));
+ return(Xen_cons(C_int_to_Xen_integer(ret),
+ Xen_cons(C_int_to_Xen_integer(bounding_shaped),
+ Xen_list_9(C_int_to_Xen_integer(x_bounding),
+ C_int_to_Xen_integer(y_bounding),
+ C_int_to_Xen_integer(w_bounding),
+ C_int_to_Xen_integer(h_bounding),
+ C_int_to_Xen_integer(clip_shaped),
+ C_int_to_Xen_integer(x_clip),
+ C_int_to_Xen_integer(y_clip),
+ C_int_to_Xen_integer(w_clip),
+ C_int_to_Xen_integer(h_clip)))));
}
-static XEN gxm_XShapeGetRectangles(XEN dpy, XEN win, XEN kind)
+static Xen gxm_XShapeGetRectangles(Xen dpy, Xen win, Xen kind)
{
#define H_XShapeGetRectangles "(XShapeGetRectangles dpy win kind): returns list of (xrectangles ordering)"
int count = 0, ordering = 0;
XRectangle *res;
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeGetRectangles", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(win), win, XEN_ARG_2, "XShapeGetRectangles", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(kind), kind, XEN_ARG_3, "XShapeGetRectangles", "int");
- res = XShapeGetRectangles(XEN_TO_C_Display(dpy), XEN_TO_C_Window(win), XEN_TO_C_INT(kind), &count, &ordering);
- return(XEN_LIST_2(C_TO_XEN_XRectangles(res, count), C_TO_XEN_INT(ordering)));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeGetRectangles", "Display*");
+ Xen_check_type(Xen_is_Window(win), win, 2, "XShapeGetRectangles", "Window");
+ Xen_check_type(Xen_is_integer(kind), kind, 3, "XShapeGetRectangles", "int");
+ res = XShapeGetRectangles(Xen_to_C_Display(dpy), Xen_to_C_Window(win), Xen_integer_to_C_int(kind), &count, &ordering);
+ return(Xen_list_2(C_to_Xen_XRectangles(res, count), C_int_to_Xen_integer(ordering)));
}
-static XEN gxm_XShapeOffsetShape(XEN dpy, XEN win, XEN kind, XEN x, XEN y)
+static Xen gxm_XShapeOffsetShape(Xen dpy, Xen win, Xen kind, Xen x, Xen y)
{
#define H_XShapeOffsetShape "(XShapeOffsetShape dpy win kind x-off y-off)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeOffsetShape", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(win), win, XEN_ARG_2, "XShapeOffsetShape", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(kind), kind, XEN_ARG_3, "XShapeOffsetShape", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x), x, XEN_ARG_4, "XShapeOffsetShape", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y), y, XEN_ARG_5, "XShapeOffsetShape", "int");
- XShapeOffsetShape(XEN_TO_C_Display(dpy), XEN_TO_C_Window(win),
- XEN_TO_C_INT(kind), XEN_TO_C_INT(x), XEN_TO_C_INT(y));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeOffsetShape", "Display*");
+ Xen_check_type(Xen_is_Window(win), win, 2, "XShapeOffsetShape", "Window");
+ Xen_check_type(Xen_is_integer(kind), kind, 3, "XShapeOffsetShape", "int");
+ Xen_check_type(Xen_is_integer(x), x, 4, "XShapeOffsetShape", "int");
+ Xen_check_type(Xen_is_integer(y), y, 5, "XShapeOffsetShape", "int");
+ XShapeOffsetShape(Xen_to_C_Display(dpy), Xen_to_C_Window(win),
+ Xen_integer_to_C_int(kind), Xen_integer_to_C_int(x), Xen_integer_to_C_int(y));
+ return(Xen_false);
}
-static XEN gxm_XShapeCombineRegion(XEN dpy, XEN win, XEN kind, XEN x, XEN y, XEN reg, XEN op)
+static Xen gxm_XShapeCombineRegion(Xen dpy, Xen win, Xen kind, Xen x, Xen y, Xen reg, Xen op)
{
#define H_XShapeCombineRegion "(XShapeCombineRegion dpy win kind x-off y-off region op)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeCombineRegion", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(win), win, XEN_ARG_2, "XShapeCombineRegion", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(kind), kind, XEN_ARG_3, "XShapeCombineRegion", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x), x, XEN_ARG_4, "XShapeCombineRegion", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y), y, XEN_ARG_5, "XShapeCombineRegion", "int");
- XEN_ASSERT_TYPE(XEN_Region_P(reg), reg, XEN_ARG_6, "XShapeCombineRegion", "Region");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(op), op, XEN_ARG_6, "XShapeCombineRegion", "int");
- XShapeCombineRegion(XEN_TO_C_Display(dpy), XEN_TO_C_Window(win),
- XEN_TO_C_INT(kind), XEN_TO_C_INT(x), XEN_TO_C_INT(y),
- XEN_TO_C_Region(reg),
- XEN_TO_C_INT(op));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XShapeCombineMask(XEN dpy, XEN win, XEN kind, XEN x, XEN y, XEN pix, XEN op)
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeCombineRegion", "Display*");
+ Xen_check_type(Xen_is_Window(win), win, 2, "XShapeCombineRegion", "Window");
+ Xen_check_type(Xen_is_integer(kind), kind, 3, "XShapeCombineRegion", "int");
+ Xen_check_type(Xen_is_integer(x), x, 4, "XShapeCombineRegion", "int");
+ Xen_check_type(Xen_is_integer(y), y, 5, "XShapeCombineRegion", "int");
+ Xen_check_type(Xen_is_Region(reg), reg, 6, "XShapeCombineRegion", "Region");
+ Xen_check_type(Xen_is_integer(op), op, 6, "XShapeCombineRegion", "int");
+ XShapeCombineRegion(Xen_to_C_Display(dpy), Xen_to_C_Window(win),
+ Xen_integer_to_C_int(kind), Xen_integer_to_C_int(x), Xen_integer_to_C_int(y),
+ Xen_to_C_Region(reg),
+ Xen_integer_to_C_int(op));
+ return(Xen_false);
+}
+
+static Xen gxm_XShapeCombineMask(Xen dpy, Xen win, Xen kind, Xen x, Xen y, Xen pix, Xen op)
{
#define H_XShapeCombineMask "(XShapeCombineMask dpy win kind x-off y-off pixmap op)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeCombineMask", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(win), win, XEN_ARG_2, "XShapeCombineMask", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(kind), kind, XEN_ARG_3, "XShapeCombineMask", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x), x, XEN_ARG_4, "XShapeCombineMask", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y), y, XEN_ARG_5, "XShapeCombineMask", "int");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(pix), pix, XEN_ARG_6, "XShapeCombineMask", "Pixmap");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(op), op, XEN_ARG_6, "XShapeCombineMask", "int");
- XShapeCombineMask(XEN_TO_C_Display(dpy), XEN_TO_C_Window(win),
- XEN_TO_C_INT(kind), XEN_TO_C_INT(x), XEN_TO_C_INT(y),
- XEN_TO_C_Pixmap(pix),
- XEN_TO_C_INT(op));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XShapeCombineShape(XEN dpy, XEN win, XEN kind, XEN x, XEN y, XEN src, XEN src_kind, XEN op)
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeCombineMask", "Display*");
+ Xen_check_type(Xen_is_Window(win), win, 2, "XShapeCombineMask", "Window");
+ Xen_check_type(Xen_is_integer(kind), kind, 3, "XShapeCombineMask", "int");
+ Xen_check_type(Xen_is_integer(x), x, 4, "XShapeCombineMask", "int");
+ Xen_check_type(Xen_is_integer(y), y, 5, "XShapeCombineMask", "int");
+ Xen_check_type(Xen_is_Pixmap(pix), pix, 6, "XShapeCombineMask", "Pixmap");
+ Xen_check_type(Xen_is_integer(op), op, 6, "XShapeCombineMask", "int");
+ XShapeCombineMask(Xen_to_C_Display(dpy), Xen_to_C_Window(win),
+ Xen_integer_to_C_int(kind), Xen_integer_to_C_int(x), Xen_integer_to_C_int(y),
+ Xen_to_C_Pixmap(pix),
+ Xen_integer_to_C_int(op));
+ return(Xen_false);
+}
+
+static Xen gxm_XShapeCombineShape(Xen dpy, Xen win, Xen kind, Xen x, Xen y, Xen src, Xen src_kind, Xen op)
{
#define H_XShapeCombineShape "(XShapeCombineShape dpy win kind x-off y-off src src_kind op)"
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeCombineShape", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(win), win, XEN_ARG_2, "XShapeCombineShape", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(kind), kind, XEN_ARG_3, "XShapeCombineShape", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x), x, XEN_ARG_4, "XShapeCombineShape", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y), y, XEN_ARG_5, "XShapeCombineShape", "int");
- XEN_ASSERT_TYPE(XEN_Window_P(src), src, XEN_ARG_6, "XShapeCombineShape", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(src_kind), src_kind, XEN_ARG_7, "XShapeCombineShape", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(op), op, XEN_ARG_8, "XShapeCombineShape", "int");
- XShapeCombineShape(XEN_TO_C_Display(dpy), XEN_TO_C_Window(win),
- XEN_TO_C_INT(kind), XEN_TO_C_INT(x), XEN_TO_C_INT(y),
- XEN_TO_C_Window(src), XEN_TO_C_INT(src_kind),
- XEN_TO_C_INT(op));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XShapeCombineRectangles(XEN dpy, XEN win, XEN kind, XEN x, XEN y, XEN rects, XEN n_rects, XEN op, XEN ordering)
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeCombineShape", "Display*");
+ Xen_check_type(Xen_is_Window(win), win, 2, "XShapeCombineShape", "Window");
+ Xen_check_type(Xen_is_integer(kind), kind, 3, "XShapeCombineShape", "int");
+ Xen_check_type(Xen_is_integer(x), x, 4, "XShapeCombineShape", "int");
+ Xen_check_type(Xen_is_integer(y), y, 5, "XShapeCombineShape", "int");
+ Xen_check_type(Xen_is_Window(src), src, 6, "XShapeCombineShape", "Window");
+ Xen_check_type(Xen_is_integer(src_kind), src_kind, 7, "XShapeCombineShape", "int");
+ Xen_check_type(Xen_is_integer(op), op, 8, "XShapeCombineShape", "int");
+ XShapeCombineShape(Xen_to_C_Display(dpy), Xen_to_C_Window(win),
+ Xen_integer_to_C_int(kind), Xen_integer_to_C_int(x), Xen_integer_to_C_int(y),
+ Xen_to_C_Window(src), Xen_integer_to_C_int(src_kind),
+ Xen_integer_to_C_int(op));
+ return(Xen_false);
+}
+
+static Xen gxm_XShapeCombineRectangles(Xen dpy, Xen win, Xen kind, Xen x, Xen y, Xen rects, Xen n_rects, Xen op, Xen ordering)
{
#define H_XShapeCombineRectangles "(XShapeCombineRectangles dpy win kind x-off y-off rectangles n-rects op ordering)"
XRectangle *cr = NULL;
- XEN_ASSERT_TYPE(XEN_Display_P(dpy), dpy, XEN_ARG_1, "XShapeCombineRectangles", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(win), win, XEN_ARG_2, "XShapeCombineRectangles", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(kind), kind, XEN_ARG_3, "XShapeCombineRectangles", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x), x, XEN_ARG_4, "XShapeCombineRectangles", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y), y, XEN_ARG_5, "XShapeCombineRectangles", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(rects), rects, XEN_ARG_6, "XShapeCombineRectangles", "list of XRectangles");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(n_rects), n_rects, XEN_ARG_7, "XShapeCombineRectangles", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(op), op, XEN_ARG_8, "XShapeCombineRectangles", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(ordering), ordering, XEN_ARG_9, "XShapeCombineRectangles", "int");
- cr = XEN_TO_C_XRectangles(rects, XEN_TO_C_INT(n_rects));
- XShapeCombineRectangles(XEN_TO_C_Display(dpy), XEN_TO_C_Window(win),
- XEN_TO_C_INT(kind), XEN_TO_C_INT(x), XEN_TO_C_INT(y),
- cr, XEN_TO_C_INT(n_rects),
- XEN_TO_C_INT(op), XEN_TO_C_INT(ordering));
+ Xen_check_type(Xen_is_Display(dpy), dpy, 1, "XShapeCombineRectangles", "Display*");
+ Xen_check_type(Xen_is_Window(win), win, 2, "XShapeCombineRectangles", "Window");
+ Xen_check_type(Xen_is_integer(kind), kind, 3, "XShapeCombineRectangles", "int");
+ Xen_check_type(Xen_is_integer(x), x, 4, "XShapeCombineRectangles", "int");
+ Xen_check_type(Xen_is_integer(y), y, 5, "XShapeCombineRectangles", "int");
+ Xen_check_type(Xen_is_list(rects), rects, 6, "XShapeCombineRectangles", "list of XRectangles");
+ Xen_check_type(Xen_is_integer(n_rects), n_rects, 7, "XShapeCombineRectangles", "int");
+ Xen_check_type(Xen_is_integer(op), op, 8, "XShapeCombineRectangles", "int");
+ Xen_check_type(Xen_is_integer(ordering), ordering, 9, "XShapeCombineRectangles", "int");
+ cr = Xen_to_C_XRectangles(rects, Xen_integer_to_C_int(n_rects));
+ XShapeCombineRectangles(Xen_to_C_Display(dpy), Xen_to_C_Window(win),
+ Xen_integer_to_C_int(kind), Xen_integer_to_C_int(x), Xen_integer_to_C_int(y),
+ cr, Xen_integer_to_C_int(n_rects),
+ Xen_integer_to_C_int(op), Xen_integer_to_C_int(ordering));
if (cr) free(cr);
- return(XEN_FALSE);
+ return(Xen_false);
}
#endif
@@ -13480,7 +13204,6 @@ static XEN gxm_XShapeCombineRectangles(XEN dpy, XEN win, XEN kind, XEN x, XEN y,
* ----------------------------------------------------------------------------------------------------
*/
-#if HAVE_MOTIF
typedef enum {CANCEL_CONVERT, CONVERT, LOSE, DONE, CONVERT_INCR, LOSE_INCR, DONE_INCR} xm_selmap_t;
/* need a way to map from widget to selection proc */
@@ -13488,13 +13211,13 @@ typedef enum {CANCEL_CONVERT, CONVERT, LOSE, DONE, CONVERT_INCR, LOSE_INCR, DONE
typedef struct {
Widget w;
xm_selmap_t type;
- XEN proc;
+ Xen proc;
} selmap;
static selmap *selmaps = NULL;
static int selmap_size = 0;
static int selmap_ctr = 0;
-static void add_selmap(Widget w, xm_selmap_t type, XEN proc)
+static void add_selmap(Widget w, xm_selmap_t type, Xen proc)
{
if (selmap_size == 0)
selmaps = (selmap *)calloc(8, sizeof(selmap));
@@ -13514,122 +13237,123 @@ static void add_selmap(Widget w, xm_selmap_t type, XEN proc)
selmaps[selmap_ctr++].proc = proc;
}
-static XEN unselmap(Widget w, xm_selmap_t type)
+static Xen unselmap(Widget w, xm_selmap_t type)
{
int i;
for (i = 0; i < selmap_ctr; i++)
if ((selmaps[i].w == w) &&
(selmaps[i].type == type))
return(selmaps[i].proc);
- return(XEN_FALSE);
+ return(Xen_false);
}
static void gxm_XtCancelConvertSelectionProc(Widget w, Atom *a1, Atom *a2, XtRequestId *id, XtPointer x)
{
- XEN proc;
+ Xen proc;
proc = unselmap(w, CANCEL_CONVERT);
- if (XEN_PROCEDURE_P(proc))
- XEN_CALL_5(proc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_Atom(*a1),
- C_TO_XEN_Atom(*a2),
- C_TO_XEN_XtRequestId(*id),
- (XEN)x,
+ if (Xen_is_procedure(proc))
+ Xen_call_with_5_args(proc,
+ C_to_Xen_Widget(w),
+ C_to_Xen_Atom(*a1),
+ C_to_Xen_Atom(*a2),
+ C_to_Xen_XtRequestId(*id),
+ (Xen)x,
"CancelConvert");
}
static Boolean gxm_XtConvertSelectionProc(Widget w, Atom *a1, Atom *a2, Atom *a3, XtPointer* x, unsigned long *l, int *i)
{
- XEN proc, val;
+ Xen proc;
proc = unselmap(w, CONVERT);
- if (XEN_PROCEDURE_P(proc))
+ if (Xen_is_procedure(proc))
{
- val = XEN_CALL_3(proc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_Atom(*a1),
- C_TO_XEN_Atom(*a2),
+ Xen val;
+ val = Xen_call_with_3_args(proc,
+ C_to_Xen_Widget(w),
+ C_to_Xen_Atom(*a1),
+ C_to_Xen_Atom(*a2),
"ConvertSelection");
- (*a3) = XEN_TO_C_Atom(XEN_LIST_REF(val, 1));
- (*x) = (XtPointer)(XEN_LIST_REF(val, 2));
- (*l) = XEN_TO_C_ULONG(XEN_LIST_REF(val, 3));
- (*i) = XEN_TO_C_INT(XEN_LIST_REF(val, 4));
- return(XEN_TO_C_BOOLEAN(XEN_CAR(val)));
+ (*a3) = Xen_to_C_Atom(Xen_list_ref(val, 1));
+ (*x) = (XtPointer)(Xen_list_ref(val, 2));
+ (*l) = Xen_ulong_to_C_ulong(Xen_list_ref(val, 3));
+ (*i) = Xen_integer_to_C_int(Xen_list_ref(val, 4));
+ return(Xen_boolean_to_C_bool(Xen_car(val)));
}
return(0);
}
static void gxm_XtLoseSelectionIncrProc(Widget w, Atom *a, XtPointer x)
{
- XEN proc;
+ Xen proc;
proc = unselmap(w, LOSE_INCR);
- if (XEN_PROCEDURE_P(proc))
- XEN_CALL_3(proc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_Atom(*a),
- (XEN)x,
+ if (Xen_is_procedure(proc))
+ Xen_call_with_3_args(proc,
+ C_to_Xen_Widget(w),
+ C_to_Xen_Atom(*a),
+ (Xen)x,
"LoseSelectionIncr");
}
static void gxm_XtLoseSelectionProc(Widget w, Atom *a)
{
- XEN proc;
+ Xen proc;
proc = unselmap(w, LOSE);
- if (XEN_PROCEDURE_P(proc))
- XEN_CALL_2(proc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_Atom(*a),
+ if (Xen_is_procedure(proc))
+ Xen_call_with_2_args(proc,
+ C_to_Xen_Widget(w),
+ C_to_Xen_Atom(*a),
"LoseSelection");
}
static void gxm_XtSelectionDoneProc(Widget w, Atom *a1, Atom *a2)
{
- XEN proc;
+ Xen proc;
proc = unselmap(w, DONE);
- if (XEN_PROCEDURE_P(proc))
- XEN_CALL_3(proc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_Atom(*a1),
- C_TO_XEN_Atom(*a2),
+ if (Xen_is_procedure(proc))
+ Xen_call_with_3_args(proc,
+ C_to_Xen_Widget(w),
+ C_to_Xen_Atom(*a1),
+ C_to_Xen_Atom(*a2),
"DoneSelection");
}
static void gxm_XtSelectionDoneIncrProc(Widget w, Atom *a1, Atom *a2, XtRequestId *i, XtPointer x)
{
- XEN proc;
+ Xen proc;
proc = unselmap(w, DONE_INCR);
- if (XEN_PROCEDURE_P(proc))
- XEN_CALL_5(proc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_Atom(*a1),
- C_TO_XEN_Atom(*a2),
- C_TO_XEN_XtRequestId(*i),
- (XEN)x,
+ if (Xen_is_procedure(proc))
+ Xen_call_with_5_args(proc,
+ C_to_Xen_Widget(w),
+ C_to_Xen_Atom(*a1),
+ C_to_Xen_Atom(*a2),
+ C_to_Xen_XtRequestId(*i),
+ (Xen)x,
"DoneSelectionIncr");
}
-static XEN gxm_XtAppUnlock(XEN arg1)
+static Xen gxm_XtAppUnlock(Xen arg1)
{
#define H_XtAppUnlock "void XtAppUnlock(app_context) unlocks the application context."
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppUnlock", "XtAppContext");
- XtAppUnlock(XEN_TO_C_XtAppContext(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppUnlock", "XtAppContext");
+ XtAppUnlock(Xen_to_C_XtAppContext(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtAppLock(XEN arg1)
+static Xen gxm_XtAppLock(Xen arg1)
{
#define H_XtAppLock "void XtAppLock(app_context) locks the application context including all its related displays and widgets."
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppLock", "XtAppContext");
- XtAppLock(XEN_TO_C_XtAppContext(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppLock", "XtAppContext");
+ XtAppLock(Xen_to_C_XtAppContext(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtToolkitThreadInitialize(void)
+static Xen gxm_XtToolkitThreadInitialize(void)
{
#define H_XtToolkitThreadInitialize "Boolean XtToolkitThreadInitialize()"
- return(C_TO_XEN_BOOLEAN(XtToolkitThreadInitialize()));
+ return(C_bool_to_Xen_boolean(XtToolkitThreadInitialize()));
}
-static XEN gxm_XtGetDisplays(XEN arg1)
+static Xen gxm_XtGetDisplays(Xen arg1)
{
#define H_XtGetDisplays "void XtGetDisplays(app_context): list of displays"
/* DIFF: XtGetDisplays not arg2 arg3 returns list
@@ -13637,161 +13361,161 @@ static XEN gxm_XtGetDisplays(XEN arg1)
unsigned int x;
Display **ds;
int i, loc;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtGetDisplays", "XtAppContext");
- XtGetDisplays(XEN_TO_C_XtAppContext(arg1), &ds, &x);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtGetDisplays", "XtAppContext");
+ XtGetDisplays(Xen_to_C_XtAppContext(arg1), &ds, &x);
loc = xm_protect(lst);
for (i = x - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_Display(ds[i]), lst);
+ lst = Xen_cons(C_to_Xen_Display(ds[i]), lst);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XtGetApplicationNameAndClass(XEN arg1)
+static Xen gxm_XtGetApplicationNameAndClass(Xen arg1)
{
#define H_XtGetApplicationNameAndClass "void XtGetApplicationNameAndClass(display): returns the application name \
and class passed to XtDisplayInitialize for the specified display."
/* DIFF: XtGetApplicationNameAndClass omits and rtns args 2 and 3
*/
char *name, *clas;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtGetApplicationNameAndClass", "Display*");
- XtGetApplicationNameAndClass(XEN_TO_C_Display(arg1), &name, &clas);
- return(XEN_LIST_2(C_TO_XEN_STRING(name),
- C_TO_XEN_STRING(clas)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtGetApplicationNameAndClass", "Display*");
+ XtGetApplicationNameAndClass(Xen_to_C_Display(arg1), &name, &clas);
+ return(Xen_list_2(C_string_to_Xen_string(name),
+ C_string_to_Xen_string(clas)));
}
-static XEN gxm_XtUngrabPointer(XEN arg1, XEN arg2)
+static Xen gxm_XtUngrabPointer(Xen arg1, Xen arg2)
{
#define H_XtUngrabPointer "void XtUngrabPointer(widget, time) calls XUngrabPointer with the specified time."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtUngrabPointer", "Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XtUngrabPointer", "Time");
- XtUngrabPointer(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtUngrabPointer", "Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XtUngrabPointer", "Time");
+ XtUngrabPointer(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtGrabPointer(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+static Xen gxm_XtGrabPointer(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
#define H_XtGrabPointer "int XtGrabPointer(widget, owner_events, event_mask, pointer_mode, keyboard_mode, confine_to, cursor, time) calls \
XGrabPointer specifying the widget's window as the grab window."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGrabPointer", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XtGrabPointer", "boolean");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XtGrabPointer", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XtGrabPointer", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XtGrabPointer", "int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg6), arg6, 6, "XtGrabPointer", "Window");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg7), arg7, 7, "XtGrabPointer", "Cursor");
- XEN_ASSERT_TYPE(XEN_Time_P(arg8), arg8, 8, "XtGrabPointer", "Time");
- return(C_TO_XEN_INT(XtGrabPointer(XEN_TO_C_Widget(arg1),
- XEN_TO_C_BOOLEAN(arg2), XEN_TO_C_ULONG(arg3),
- XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5),
- XEN_TO_C_Window(arg6), XEN_TO_C_Cursor(arg7),
- XEN_TO_C_Time(arg8))));
-}
-
-static XEN gxm_XtUngrabButton(XEN arg1, XEN arg2, XEN arg3)
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGrabPointer", "Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XtGrabPointer", "boolean");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XtGrabPointer", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XtGrabPointer", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XtGrabPointer", "int");
+ Xen_check_type(Xen_is_Window(arg6), arg6, 6, "XtGrabPointer", "Window");
+ Xen_check_type(Xen_is_Cursor(arg7), arg7, 7, "XtGrabPointer", "Cursor");
+ Xen_check_type(Xen_is_Time(arg8), arg8, 8, "XtGrabPointer", "Time");
+ return(C_int_to_Xen_integer(XtGrabPointer(Xen_to_C_Widget(arg1),
+ Xen_boolean_to_C_bool(arg2), Xen_ulong_to_C_ulong(arg3),
+ Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5),
+ Xen_to_C_Window(arg6), Xen_to_C_Cursor(arg7),
+ Xen_to_C_Time(arg8))));
+}
+
+static Xen gxm_XtUngrabButton(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtUngrabButton "void XtUngrabButton(widget, button, modifiers) calls XUngrabButton specifying the widget's window as the ungrab \
window if the widget is realized. "
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtUngrabButton", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtUngrabButton", "unsigned int");
- XEN_ASSERT_TYPE(XEN_Modifiers_P(arg3), arg3, 3, "XtUngrabButton", "Modifiers");
- XtUngrabButton(XEN_TO_C_Widget(arg1), XEN_TO_C_ULONG(arg2), XEN_TO_C_Modifiers(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtUngrabButton", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtUngrabButton", "unsigned int");
+ Xen_check_type(Xen_is_Modifiers(arg3), arg3, 3, "XtUngrabButton", "Modifiers");
+ XtUngrabButton(Xen_to_C_Widget(arg1), Xen_ulong_to_C_ulong(arg2), Xen_to_C_Modifiers(arg3));
+ return(Xen_false);
}
-static XEN gxm_XtGrabButton(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8, XEN arg9)
+static Xen gxm_XtGrabButton(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8, Xen arg9)
{
#define H_XtGrabButton "void XtGrabButton(widget, button, modifiers, owner_events, event_mask, pointer_mode, keyboard_mode, confine_to, cursor) \
calls XGrabButton specifying the widget's window as the grab window if the widget is realized."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGrabButton", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XtGrabButton", "int");
- XEN_ASSERT_TYPE(XEN_Modifiers_P(arg3), arg3, 3, "XtGrabButton", "Modifiers");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg4), arg4, 4, "XtGrabButton", "boolean");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XtGrabButton", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XtGrabButton", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XtGrabButton", "int");
- XEN_ASSERT_TYPE(XEN_Window_P(arg8), arg8, 8, "XtGrabButton", "Window");
- XEN_ASSERT_TYPE(XEN_Cursor_P(arg9), arg9, 9, "XtGrabButton", "Cursor");
- XtGrabButton(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2),
- XEN_TO_C_Modifiers(arg3), XEN_TO_C_BOOLEAN(arg4), XEN_TO_C_ULONG(arg5), XEN_TO_C_INT(arg6), XEN_TO_C_INT(arg7),
- XEN_TO_C_Window(arg8), XEN_TO_C_Cursor(arg9));
- return(XEN_FALSE);
-}
-
-static XEN gxm_XtUngrabKeyboard(XEN arg1, XEN arg2)
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGrabButton", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XtGrabButton", "int");
+ Xen_check_type(Xen_is_Modifiers(arg3), arg3, 3, "XtGrabButton", "Modifiers");
+ Xen_check_type(Xen_is_boolean(arg4), arg4, 4, "XtGrabButton", "boolean");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XtGrabButton", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XtGrabButton", "int");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XtGrabButton", "int");
+ Xen_check_type(Xen_is_Window(arg8), arg8, 8, "XtGrabButton", "Window");
+ Xen_check_type(Xen_is_Cursor(arg9), arg9, 9, "XtGrabButton", "Cursor");
+ XtGrabButton(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2),
+ Xen_to_C_Modifiers(arg3), Xen_boolean_to_C_bool(arg4), Xen_ulong_to_C_ulong(arg5), Xen_integer_to_C_int(arg6), Xen_integer_to_C_int(arg7),
+ Xen_to_C_Window(arg8), Xen_to_C_Cursor(arg9));
+ return(Xen_false);
+}
+
+static Xen gxm_XtUngrabKeyboard(Xen arg1, Xen arg2)
{
#define H_XtUngrabKeyboard "void XtUngrabKeyboard(widget, time) calls XUngrabKeyboard with the specified time."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtUngrabKeyboard", "Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XtUngrabKeyboard", "Time");
- XtUngrabKeyboard(XEN_TO_C_Widget(arg1), XEN_TO_C_Time(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtUngrabKeyboard", "Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XtUngrabKeyboard", "Time");
+ XtUngrabKeyboard(Xen_to_C_Widget(arg1), Xen_to_C_Time(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtGrabKeyboard(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtGrabKeyboard(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtGrabKeyboard "int XtGrabKeyboard(widget, owner_events, pointer_mode, keyboard_mode, time)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGrabKeyboard", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XtGrabKeyboard", "boolean");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XtGrabKeyboard", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XtGrabKeyboard", "int");
- XEN_ASSERT_TYPE(XEN_Time_P(arg5), arg5, 5, "XtGrabKeyboard", "Time");
- return(C_TO_XEN_INT(XtGrabKeyboard(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2), XEN_TO_C_INT(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_Time(arg5))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGrabKeyboard", "Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XtGrabKeyboard", "boolean");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XtGrabKeyboard", "int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XtGrabKeyboard", "int");
+ Xen_check_type(Xen_is_Time(arg5), arg5, 5, "XtGrabKeyboard", "Time");
+ return(C_int_to_Xen_integer(XtGrabKeyboard(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2), Xen_integer_to_C_int(arg3), Xen_integer_to_C_int(arg4), Xen_to_C_Time(arg5))));
}
-static XEN gxm_XtUngrabKey(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtUngrabKey(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtUngrabKey "void XtUngrabKey(widget, keycode, modifiers) calls XUngrabKey specifying the widget's window as the ungrab window \
if the widget is realized."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtUngrabKey", "Widget");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XtUngrabKey", "KeyCode");
- XEN_ASSERT_TYPE(XEN_Modifiers_P(arg3), arg3, 3, "XtUngrabKey", "Modifiers");
- XtUngrabKey(XEN_TO_C_Widget(arg1), XEN_TO_C_KeyCode(arg2), XEN_TO_C_Modifiers(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtUngrabKey", "Widget");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XtUngrabKey", "KeyCode");
+ Xen_check_type(Xen_is_Modifiers(arg3), arg3, 3, "XtUngrabKey", "Modifiers");
+ XtUngrabKey(Xen_to_C_Widget(arg1), Xen_to_C_KeyCode(arg2), Xen_to_C_Modifiers(arg3));
+ return(Xen_false);
}
-static XEN gxm_XtGrabKey(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XtGrabKey(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XtGrabKey "void XtGrabKey(widget, keycode, modifiers, owner_events, pointer_mode, keyboard_mode) calls XGrabKey specifying the \
widget's window as the grab window if the widget is realized."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGrabKey", "Widget");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XtGrabKey", "KeyCode");
- XEN_ASSERT_TYPE(XEN_Modifiers_P(arg3), arg3, 3, "XtGrabKey", "Modifiers");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg4), arg4, 4, "XtGrabKey", "boolean");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XtGrabKey", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XtGrabKey", "int");
- XtGrabKey(XEN_TO_C_Widget(arg1), XEN_TO_C_KeyCode(arg2), XEN_TO_C_Modifiers(arg3), XEN_TO_C_BOOLEAN(arg4), XEN_TO_C_INT(arg5), XEN_TO_C_INT(arg6));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGrabKey", "Widget");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XtGrabKey", "KeyCode");
+ Xen_check_type(Xen_is_Modifiers(arg3), arg3, 3, "XtGrabKey", "Modifiers");
+ Xen_check_type(Xen_is_boolean(arg4), arg4, 4, "XtGrabKey", "boolean");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XtGrabKey", "int");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XtGrabKey", "int");
+ XtGrabKey(Xen_to_C_Widget(arg1), Xen_to_C_KeyCode(arg2), Xen_to_C_Modifiers(arg3), Xen_boolean_to_C_bool(arg4), Xen_integer_to_C_int(arg5), Xen_integer_to_C_int(arg6));
+ return(Xen_false);
}
-static XEN gxm_XtCancelSelectionRequest(XEN arg1, XEN arg2)
+static Xen gxm_XtCancelSelectionRequest(Xen arg1, Xen arg2)
{
#define H_XtCancelSelectionRequest "void XtCancelSelectionRequest(requestor, selection)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCancelSelectionRequest", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtCancelSelectionRequest", "Atom");
- XtCancelSelectionRequest(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCancelSelectionRequest", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtCancelSelectionRequest", "Atom");
+ XtCancelSelectionRequest(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtSendSelectionRequest(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtSendSelectionRequest(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtSendSelectionRequest "void XtSendSelectionRequest(requestor, selection, time)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtSendSelectionRequest", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtSendSelectionRequest", "Atom");
- XEN_ASSERT_TYPE(XEN_Time_P(arg3), arg3, 3, "XtSendSelectionRequest", "Time");
- XtSendSelectionRequest(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2), XEN_TO_C_Time(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtSendSelectionRequest", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtSendSelectionRequest", "Atom");
+ Xen_check_type(Xen_is_Time(arg3), arg3, 3, "XtSendSelectionRequest", "Time");
+ XtSendSelectionRequest(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2), Xen_to_C_Time(arg3));
+ return(Xen_false);
}
-static XEN gxm_XtCreateSelectionRequest(XEN arg1, XEN arg2)
+static Xen gxm_XtCreateSelectionRequest(Xen arg1, Xen arg2)
{
#define H_XtCreateSelectionRequest "void XtCreateSelectionRequest(requestor, selection)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCreateSelectionRequest", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtCreateSelectionRequest", "Atom");
- XtCreateSelectionRequest(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCreateSelectionRequest", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtCreateSelectionRequest", "Atom");
+ XtCreateSelectionRequest(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtGetSelectionValuesIncremental(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XtGetSelectionValuesIncremental(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XtGetSelectionValuesIncremental "void XtGetSelectionValuesIncremental(w, selection, targets, count, callback, client_data, time) \
is similar to XtGetSelectionValueIncremental except that it takes a list of target types and a list of client data and obtains the current \
@@ -13800,72 +13524,72 @@ value of the selection converted to each of the targets."
*/
Atom *outs;
int len, loc;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGetSelectionValuesIncremental", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtGetSelectionValuesIncremental", "Atom");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XtGetSelectionValuesIncremental", "list of Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XtGetSelectionValuesIncremental", "int");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg5) && (XEN_REQUIRED_ARGS_OK(arg5, 7)), arg5, 5, "XtGetSelectionValuesIncremental", "XtSelectionCallbackProc");
- XEN_ASSERT_TYPE(XEN_Time_P(arg7), arg7, 7, "XtGetSelectionValuesIncremental", "Time");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) return(XEN_FALSE);
- outs = XEN_TO_C_Atoms(arg3, len);
- xm_XtSelectionCallback_Descr = XEN_LIST_2(arg5, arg6);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGetSelectionValuesIncremental", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtGetSelectionValuesIncremental", "Atom");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XtGetSelectionValuesIncremental", "list of Atom");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XtGetSelectionValuesIncremental", "int");
+ Xen_check_type(Xen_is_procedure(arg5) && (Xen_is_aritable(arg5, 7)), arg5, 5, "XtGetSelectionValuesIncremental", "XtSelectionCallbackProc");
+ Xen_check_type(Xen_is_Time(arg7), arg7, 7, "XtGetSelectionValuesIncremental", "Time");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) return(Xen_false);
+ outs = Xen_to_C_Atoms(arg3, len);
+ xm_XtSelectionCallback_Descr = Xen_list_2(arg5, arg6);
loc = xm_protect(xm_XtSelectionCallback_Descr);
- XtGetSelectionValuesIncremental(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Atom(arg2), outs, len,
+ XtGetSelectionValuesIncremental(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2), outs, len,
gxm_XtSelectionCallbackProc,
- (XtPointer *)arg6, XEN_TO_C_Time(arg7));
+ (XtPointer *)arg6, Xen_to_C_Time(arg7));
xm_unprotect_at(loc);
free(outs);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtGetSelectionValueIncremental(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XtGetSelectionValueIncremental(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XtGetSelectionValueIncremental "void XtGetSelectionValueIncremental(w, selection, target, callback, client_data, time) is similar \
to XtGetSelectionValue except that the selection_callback procedure will be called repeatedly upon delivery of multiple segments of the selection value."
int loc;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGetSelectionValueIncremental", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtGetSelectionValueIncremental", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XtGetSelectionValueIncremental", "Atom");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 7)), arg4, 4, "XtGetSelectionValueIncremental", "XtSelectionCallbackProc");
- XEN_ASSERT_TYPE(XEN_Time_P(arg6), arg6, 6, "XtGetSelectionValueIncremental", "Time");
- xm_XtSelectionCallback_Descr = XEN_LIST_2(arg4, arg5);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGetSelectionValueIncremental", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtGetSelectionValueIncremental", "Atom");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XtGetSelectionValueIncremental", "Atom");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 7)), arg4, 4, "XtGetSelectionValueIncremental", "XtSelectionCallbackProc");
+ Xen_check_type(Xen_is_Time(arg6), arg6, 6, "XtGetSelectionValueIncremental", "Time");
+ xm_XtSelectionCallback_Descr = Xen_list_2(arg4, arg5);
loc = xm_protect(xm_XtSelectionCallback_Descr);
- XtGetSelectionValueIncremental(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Atom(arg2), XEN_TO_C_Atom(arg3),
+ XtGetSelectionValueIncremental(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2), Xen_to_C_Atom(arg3),
gxm_XtSelectionCallbackProc,
- (XtPointer)arg5, XEN_TO_C_Time(arg6));
+ (XtPointer)arg5, Xen_to_C_Time(arg6));
xm_unprotect_at(loc);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtGetSelectionRequest(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtGetSelectionRequest(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtGetSelectionRequest "XSelectionRequestEvent* XtGetSelectionRequest(w, selection, request_id)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGetSelectionRequest", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtGetSelectionRequest", "Atom");
- XEN_ASSERT_TYPE(XEN_XtRequestId_P(arg3), arg3, 3, "XtGetSelectionRequest", "XtRequestId");
- return(C_TO_XEN_XSelectionRequestEvent(XtGetSelectionRequest(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2), XEN_TO_C_XtRequestId(arg3))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGetSelectionRequest", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtGetSelectionRequest", "Atom");
+ Xen_check_type(Xen_is_XtRequestId(arg3), arg3, 3, "XtGetSelectionRequest", "XtRequestId");
+ return(C_to_Xen_XSelectionRequestEvent(XtGetSelectionRequest(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2), Xen_to_C_XtRequestId(arg3))));
}
-static XEN gxm_XtAppGetSelectionTimeout(XEN arg1)
+static Xen gxm_XtAppGetSelectionTimeout(Xen arg1)
{
#define H_XtAppGetSelectionTimeout "unsigned long XtAppGetSelectionTimeout(app_context): returns the current selection timeout value, in milliseconds."
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppGetSelectionTimeout", "XtAppContext");
- return(C_TO_XEN_ULONG(XtAppGetSelectionTimeout(XEN_TO_C_XtAppContext(arg1))));
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppGetSelectionTimeout", "XtAppContext");
+ return(C_ulong_to_Xen_ulong(XtAppGetSelectionTimeout(Xen_to_C_XtAppContext(arg1))));
}
-static XEN gxm_XtAppSetSelectionTimeout(XEN arg1, XEN arg2)
+static Xen gxm_XtAppSetSelectionTimeout(Xen arg1, Xen arg2)
{
#define H_XtAppSetSelectionTimeout "void XtAppSetSelectionTimeout(app_context, timeout) sets the app's selection timeout mechanism."
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppSetSelectionTimeout", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtAppSetSelectionTimeout", "ulong");
- XtAppSetSelectionTimeout(XEN_TO_C_XtAppContext(arg1), XEN_TO_C_ULONG(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppSetSelectionTimeout", "XtAppContext");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtAppSetSelectionTimeout", "ulong");
+ XtAppSetSelectionTimeout(Xen_to_C_XtAppContext(arg1), Xen_ulong_to_C_ulong(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtGetSelectionValues(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XtGetSelectionValues(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XtGetSelectionValues "void XtGetSelectionValues(w, selection, targets, count, callback, client_data, time) is similar to \
XtGetSelectionValue except that it takes a list of target types and a list of client data and obtains the current value of the selection \
@@ -13874,56 +13598,56 @@ converted to each of the targets."
*/
Atom *outs;
int len, loc;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGetSelectionValues", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtGetSelectionValues", "Atom");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XtGetSelectionValues", "list of Atom");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XtGetSelectionValues", "int");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg5) && (XEN_REQUIRED_ARGS_OK(arg5, 7)), arg5, 5, "XtGetSelectionValues", "XtSelectionCallbackProc");
- XEN_ASSERT_TYPE(XEN_Time_P(arg7), arg7, 7, "XtGetSelectionValues", "Time");
- len = XEN_TO_C_INT(arg4);
- if (len <= 0) return(XEN_FALSE);
- outs = XEN_TO_C_Atoms(arg3, len);
- xm_XtSelectionCallback_Descr = XEN_LIST_2(arg5, arg6);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGetSelectionValues", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtGetSelectionValues", "Atom");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XtGetSelectionValues", "list of Atom");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XtGetSelectionValues", "int");
+ Xen_check_type(Xen_is_procedure(arg5) && (Xen_is_aritable(arg5, 7)), arg5, 5, "XtGetSelectionValues", "XtSelectionCallbackProc");
+ Xen_check_type(Xen_is_Time(arg7), arg7, 7, "XtGetSelectionValues", "Time");
+ len = Xen_integer_to_C_int(arg4);
+ if (len <= 0) return(Xen_false);
+ outs = Xen_to_C_Atoms(arg3, len);
+ xm_XtSelectionCallback_Descr = Xen_list_2(arg5, arg6);
loc = xm_protect(xm_XtSelectionCallback_Descr);
- XtGetSelectionValues(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Atom(arg2), outs, len,
+ XtGetSelectionValues(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2), outs, len,
gxm_XtSelectionCallbackProc,
- (XtPointer *)arg6, XEN_TO_C_Time(arg7));
+ (XtPointer *)arg6, Xen_to_C_Time(arg7));
xm_unprotect_at(loc);
free(outs);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtGetSelectionValue(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XtGetSelectionValue(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XtGetSelectionValue "void XtGetSelectionValue(w, selection, target, callback, client_data, time) requests the value of the \
selection that has been converted to the target type. "
int loc;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGetSelectionValue", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtGetSelectionValue", "Atom");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg3), arg3, 3, "XtGetSelectionValue", "Atom");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 7)), arg4, 4, "XtGetSelectionValue", "XtSelectionCallbackProc");
- XEN_ASSERT_TYPE(XEN_Time_P(arg6), arg6, 6, "XtGetSelectionValue", "Time");
- xm_XtSelectionCallback_Descr = XEN_LIST_2(arg4, arg5);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGetSelectionValue", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtGetSelectionValue", "Atom");
+ Xen_check_type(Xen_is_Atom(arg3), arg3, 3, "XtGetSelectionValue", "Atom");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 7)), arg4, 4, "XtGetSelectionValue", "XtSelectionCallbackProc");
+ Xen_check_type(Xen_is_Time(arg6), arg6, 6, "XtGetSelectionValue", "Time");
+ xm_XtSelectionCallback_Descr = Xen_list_2(arg4, arg5);
loc = xm_protect(xm_XtSelectionCallback_Descr);
- XtGetSelectionValue(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Atom(arg2),
- XEN_TO_C_Atom(arg3),
+ XtGetSelectionValue(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2),
+ Xen_to_C_Atom(arg3),
gxm_XtSelectionCallbackProc,
- (XtPointer)arg5, XEN_TO_C_Time(arg6));
+ (XtPointer)arg5, Xen_to_C_Time(arg6));
xm_unprotect_at(loc);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtDisownSelection(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtDisownSelection(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtDisownSelection "void XtDisownSelection(w, selection, time) informs the selection mechanism that the specified widget is to \
lose ownership of the selection."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtDisownSelection", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtDisownSelection", "Atom");
- XEN_ASSERT_TYPE(XEN_Time_P(arg3), arg3, 3, "XtDisownSelection", "Time");
- XtDisownSelection(XEN_TO_C_Widget(arg1), XEN_TO_C_Atom(arg2), XEN_TO_C_Time(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtDisownSelection", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtDisownSelection", "Atom");
+ Xen_check_type(Xen_is_Time(arg3), arg3, 3, "XtDisownSelection", "Time");
+ XtDisownSelection(Xen_to_C_Widget(arg1), Xen_to_C_Atom(arg2), Xen_to_C_Time(arg3));
+ return(Xen_false);
}
@@ -13931,35 +13655,35 @@ lose ownership of the selection."
/* a "Substitution" is a list '(char substitute), so pass a list of such lists below where a substitution array is required */
-static XEN xm_filepredicate_proc;
+static Xen xm_filepredicate_proc;
static Boolean gxm_XtFilePredicate(String filename)
{
- return(XEN_TO_C_BOOLEAN(XEN_CALL_1(xm_filepredicate_proc,
- C_TO_XEN_STRING(filename),
- c__FUNCTION__)));
+ return(Xen_boolean_to_C_bool(Xen_call_with_1_arg(xm_filepredicate_proc,
+ C_string_to_Xen_string(filename),
+ __func__)));
}
-static SubstitutionRec *gxm_make_subs(XEN lst_1)
+static SubstitutionRec *gxm_make_subs(Xen lst_1)
{
int len;
SubstitutionRec *subs = NULL;
- len = XEN_LIST_LENGTH(lst_1);
+ len = Xen_list_length(lst_1);
if (len > 0)
{
int i;
- XEN lst;
- lst = XEN_COPY_ARG(lst_1);
+ Xen lst;
+ lst = Xen_copy_arg(lst_1);
subs = (SubstitutionRec *)calloc(len, sizeof(SubstitutionRec));
- for (i = 0; i < len; i++, lst = XEN_CDR(lst))
+ for (i = 0; i < len; i++, lst = Xen_cdr(lst))
{
- if (!(XEN_LIST_P(XEN_CAR(lst))))
+ if (!(Xen_is_list(Xen_car(lst))))
{
free(subs);
return(NULL);
}
- subs[i].match = XEN_TO_C_CHAR(XEN_CAR(XEN_CAR(lst)));
- subs[i].substitution = xen_strdup(XEN_TO_C_STRING(XEN_CADR(XEN_CAR(lst))));
+ subs[i].match = Xen_char_to_C_char(Xen_car(Xen_car(lst)));
+ subs[i].substitution = xen_strdup(Xen_string_to_C_string(Xen_cadr(Xen_car(lst))));
}
}
return(subs);
@@ -13967,138 +13691,138 @@ static SubstitutionRec *gxm_make_subs(XEN lst_1)
/* (XtFindFile "/lib/%N:/usr/lib/%N:/usr/local/lib/%N" (list (list #\N "libxm.so")) 1 file-exists?) */
-static XEN gxm_XtResolvePathname(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+static Xen gxm_XtResolvePathname(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
#define H_XtResolvePathname "String XtResolvePathname(display, type, filename, suffix, path, substitutions, num_substitutions, predicate)"
/* DIFF: XtResolvePathname args use #f for NULL
* (XtResolvePathname (XtDisplay (cadr (main-widgets))) "app-defaults" #f #f #f #f 0 #f)
*/
int arg8_loc = -1;
- XEN res;
+ Xen res;
char *str;
SubstitutionRec *subs = NULL;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtResolvePathname", "Display*");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg2) || XEN_STRING_P(arg2), arg2, 2, "XtResolvePathname", "char*");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg3) || XEN_STRING_P(arg3), arg3, 3, "XtResolvePathname", "char*");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg4) || XEN_STRING_P(arg4), arg4, 4, "XtResolvePathname", "char*");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg5) || XEN_STRING_P(arg5), arg5, 5, "XtResolvePathname", "char*");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg6) || XEN_LIST_P(arg6), arg6, 6, "XtResolvePathname", "Substitution list");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XtResolvePathname", "int");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg8) ||
- (XEN_PROCEDURE_P(arg8) && (XEN_REQUIRED_ARGS_OK(arg8, 1))),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtResolvePathname", "Display*");
+ Xen_check_type(Xen_is_false(arg2) || Xen_is_string(arg2), arg2, 2, "XtResolvePathname", "char*");
+ Xen_check_type(Xen_is_false(arg3) || Xen_is_string(arg3), arg3, 3, "XtResolvePathname", "char*");
+ Xen_check_type(Xen_is_false(arg4) || Xen_is_string(arg4), arg4, 4, "XtResolvePathname", "char*");
+ Xen_check_type(Xen_is_false(arg5) || Xen_is_string(arg5), arg5, 5, "XtResolvePathname", "char*");
+ Xen_check_type(Xen_is_false(arg6) || Xen_is_list(arg6), arg6, 6, "XtResolvePathname", "Substitution list");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XtResolvePathname", "int");
+ Xen_check_type(Xen_is_false(arg8) ||
+ (Xen_is_procedure(arg8) && (Xen_is_aritable(arg8, 1))),
arg8, 8, "XtResolvePathname", "XtFilePredicate (takes 1 arg)");
- if (XEN_LIST_P(arg6))
+ if (Xen_is_list(arg6))
{
- subs = gxm_make_subs(XEN_COPY_ARG(arg6));
- if (subs == NULL) return(XEN_FALSE); /* type error? */
+ subs = gxm_make_subs(Xen_copy_arg(arg6));
+ if (subs == NULL) return(Xen_false); /* type error? */
}
- if (XEN_PROCEDURE_P(arg8))
+ if (Xen_is_procedure(arg8))
{
arg8_loc = xm_protect(arg8);
xm_filepredicate_proc = arg8;
}
- str = XtResolvePathname(XEN_TO_C_Display(arg1),
- (XEN_FALSE_P(arg2)) ? NULL : (char *)XEN_TO_C_STRING(arg2),
- (XEN_FALSE_P(arg3)) ? NULL : (char *)XEN_TO_C_STRING(arg3),
- (XEN_FALSE_P(arg4)) ? NULL : (char *)XEN_TO_C_STRING(arg4),
- (XEN_FALSE_P(arg5)) ? NULL : (char *)XEN_TO_C_STRING(arg5),
+ str = XtResolvePathname(Xen_to_C_Display(arg1),
+ (Xen_is_false(arg2)) ? NULL : (char *)Xen_string_to_C_string(arg2),
+ (Xen_is_false(arg3)) ? NULL : (char *)Xen_string_to_C_string(arg3),
+ (Xen_is_false(arg4)) ? NULL : (char *)Xen_string_to_C_string(arg4),
+ (Xen_is_false(arg5)) ? NULL : (char *)Xen_string_to_C_string(arg5),
subs,
- XEN_TO_C_INT(arg7),
- (XEN_FALSE_P(arg8)) ? NULL : gxm_XtFilePredicate);
- if (XEN_PROCEDURE_P(arg8)) xm_unprotect_at(arg8_loc);
+ Xen_integer_to_C_int(arg7),
+ (Xen_is_false(arg8)) ? NULL : gxm_XtFilePredicate);
+ if (Xen_is_procedure(arg8)) xm_unprotect_at(arg8_loc);
if (subs)
{
int i, len;
- len = XEN_LIST_LENGTH(arg6);
+ len = Xen_list_length(arg6);
for (i = 0; i < len; i++)
if (subs[i].substitution) free(subs[i].substitution);
free(subs);
}
- res = C_TO_XEN_STRING(str);
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XtFindFile(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XtFindFile(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XtFindFile "String XtFindFile(path, substitutions, num_substitutions, predicate) \
searches for a file using substitutions in the path list"
char *str;
- XEN res;
+ Xen res;
int arg4_loc = -1;
SubstitutionRec *subs = NULL;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtFindFile", "char*");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg2) || XEN_LIST_P(arg2), arg2, 2, "XtFindFile", "Substitution list");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XtFindFile", "int");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg4) ||
- (XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 1))),
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtFindFile", "char*");
+ Xen_check_type(Xen_is_false(arg2) || Xen_is_list(arg2), arg2, 2, "XtFindFile", "Substitution list");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XtFindFile", "int");
+ Xen_check_type(Xen_is_false(arg4) ||
+ (Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 1))),
arg4, 4, "XtFindFile", "XtFilePredicate (takes 1 arg)");
- if (XEN_LIST_P(arg2))
+ if (Xen_is_list(arg2))
{
- subs = gxm_make_subs(XEN_COPY_ARG(arg2));
- if (subs == NULL) return(XEN_FALSE); /* type error? */
+ subs = gxm_make_subs(Xen_copy_arg(arg2));
+ if (subs == NULL) return(Xen_false); /* type error? */
}
- if (XEN_PROCEDURE_P(arg4))
+ if (Xen_is_procedure(arg4))
{
arg4_loc = xm_protect(arg4);
xm_filepredicate_proc = arg4;
}
- str = XtFindFile((char *)XEN_TO_C_STRING(arg1),
+ str = XtFindFile((char *)Xen_string_to_C_string(arg1),
subs,
- XEN_TO_C_INT(arg3),
- (XEN_FALSE_P(arg4) ? NULL : gxm_XtFilePredicate));
- if (XEN_PROCEDURE_P(arg4)) xm_unprotect_at(arg4_loc);
+ Xen_integer_to_C_int(arg3),
+ (Xen_is_false(arg4) ? NULL : gxm_XtFilePredicate));
+ if (Xen_is_procedure(arg4)) xm_unprotect_at(arg4_loc);
if (subs)
{
int i, len;
- len = XEN_LIST_LENGTH(arg2);
+ len = Xen_list_length(arg2);
for (i = 0; i < len; i++)
if (subs[i].substitution) free(subs[i].substitution);
free(subs);
}
- res = C_TO_XEN_STRING(str);
+ res = C_string_to_Xen_string(str);
if (str) XtFree(str);
return(res);
}
-static XEN gxm_XtReleaseGC(XEN arg1, XEN arg2)
+static Xen gxm_XtReleaseGC(Xen arg1, Xen arg2)
{
#define H_XtReleaseGC "void XtReleaseGC(w, gc) deallocate the specified shared GC."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtReleaseGC", "Widget");
- XEN_ASSERT_TYPE(XEN_GC_P(arg2), arg2, 2, "XtReleaseGC", "GC");
- XtReleaseGC(XEN_TO_C_Widget(arg1), XEN_TO_C_GC(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtReleaseGC", "Widget");
+ Xen_check_type(Xen_is_GC(arg2), arg2, 2, "XtReleaseGC", "GC");
+ XtReleaseGC(Xen_to_C_Widget(arg1), Xen_to_C_GC(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtDestroyGC(XEN arg1)
+static Xen gxm_XtDestroyGC(Xen arg1)
{
#define H_XtDestroyGC "XtDestroyGC(gc) is obsolete -- use XtReleaseGC"
- XEN_ASSERT_TYPE(XEN_GC_P(arg1), arg1, 1, "XtDestroyGC", "GC");
- XtDestroyGC(XEN_TO_C_GC(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_GC(arg1), arg1, 1, "XtDestroyGC", "GC");
+ XtDestroyGC(Xen_to_C_GC(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtAllocateGC(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XtAllocateGC(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XtAllocateGC "GC XtAllocateGC(w, depth, value_mask, values, dynamic_mask, unused_mask): returns a sharable GC that may be modified by the client."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtAllocateGC", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XtAllocateGC", "int");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XtAllocateGC", "XtGCMask");
- XEN_ASSERT_TYPE(XEN_XGCValues_P(arg4), arg4, 4, "XtAllocateGC", "XGCValues*");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg5), arg5, 5, "XtAllocateGC", "XtGCMask");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg6), arg6, 6, "XtAllocateGC", "XtGCMask");
- return(C_TO_XEN_GC(XtAllocateGC(XEN_TO_C_Widget(arg1), XEN_TO_C_INT(arg2),
- XEN_TO_C_ULONG(arg3), XEN_TO_C_XGCValues(arg4),
- XEN_TO_C_ULONG(arg5), XEN_TO_C_ULONG(arg6))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtAllocateGC", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XtAllocateGC", "int");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XtAllocateGC", "XtGCMask");
+ Xen_check_type(Xen_is_XGCValues(arg4), arg4, 4, "XtAllocateGC", "XGCValues*");
+ Xen_check_type(Xen_is_ulong(arg5), arg5, 5, "XtAllocateGC", "XtGCMask");
+ Xen_check_type(Xen_is_ulong(arg6), arg6, 6, "XtAllocateGC", "XtGCMask");
+ return(C_to_Xen_GC(XtAllocateGC(Xen_to_C_Widget(arg1), Xen_integer_to_C_int(arg2),
+ Xen_ulong_to_C_ulong(arg3), Xen_to_C_XGCValues(arg4),
+ Xen_ulong_to_C_ulong(arg5), Xen_ulong_to_C_ulong(arg6))));
}
-static XEN gxm_XtGetGC(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtGetGC(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtGetGC "GC XtGetGC(w, value_mask, values): returns a sharable, read-only GC."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGetGC", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtGetGC", "XtGCMask");
- XEN_ASSERT_TYPE(XEN_XGCValues_P(arg3), arg3, 3, "XtGetGC", "XGCValues*");
- return(C_TO_XEN_GC(XtGetGC(XEN_TO_C_Widget(arg1), XEN_TO_C_ULONG(arg2), XEN_TO_C_XGCValues(arg3))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGetGC", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtGetGC", "XtGCMask");
+ Xen_check_type(Xen_is_XGCValues(arg3), arg3, 3, "XtGetGC", "XGCValues*");
+ return(C_to_Xen_GC(XtGetGC(Xen_to_C_Widget(arg1), Xen_ulong_to_C_ulong(arg2), Xen_to_C_XGCValues(arg3))));
}
@@ -14106,27 +13830,27 @@ static XEN gxm_XtGetGC(XEN arg1, XEN arg2, XEN arg3)
/* (80) XtWorkProc called (protected) until quits or removed explicitly */
-#define C_TO_XEN_XM_Background(Code, Context) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("Background"), Code, Context, XEN_ZERO, XEN_ZERO)
-#define XM_Background_P(Arg) WRAP_P("Background", Arg)
+#define C_to_Xen_XM_Background(Code, Context) \
+ Xen_list_5(C_string_to_Xen_symbol("Background"), Code, Context, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_Background(Arg) is_wrapped("Background", Arg)
static Boolean gxm_XtWorkProc(XtPointer cdata)
{
/* if true, quits */
int val;
- XEN descr = (XEN)cdata;
+ Xen descr = (Xen)cdata;
/* (list 'Background function context gc-loc id) */
- val = XEN_TO_C_BOOLEAN(XEN_CALL_1(XEN_CADR(descr),
- XEN_CADDR(descr),
- c__FUNCTION__));
- if (val) xm_unprotect_at(XEN_TO_C_INT(XEN_LIST_REF(descr, 3)));
+ val = Xen_boolean_to_C_bool(Xen_call_with_1_arg(Xen_cadr(descr),
+ Xen_caddr(descr),
+ __func__));
+ if (val) xm_unprotect_at(Xen_integer_to_C_int(Xen_list_ref(descr, 3)));
return(val);
}
-static bool unprotect_workproc(XEN val, int loc, unsigned long id)
+static bool unprotect_workproc(Xen val, int loc, unsigned long id)
{
- if ((XM_Background_P(val)) &&
- ((XtWorkProcId)XEN_TO_C_ULONG(XEN_LIST_REF(val, 4)) == id))
+ if ((XM_is_Background(val)) &&
+ ((XtWorkProcId)Xen_ulong_to_C_ulong(Xen_list_ref(val, 4)) == id))
{
xm_unprotect_at(loc);
return(true);
@@ -14134,129 +13858,158 @@ static bool unprotect_workproc(XEN val, int loc, unsigned long id)
return(false);
}
-static XEN gxm_XtRemoveWorkProc(XEN arg1)
+static Xen gxm_XtRemoveWorkProc(Xen arg1)
{
#define H_XtRemoveWorkProc "void XtRemoveWorkProc(id) explicitly removes the specified background work procedure."
XtWorkProcId id;
- XEN_ASSERT_TYPE(XEN_XtWorkProcId_P(arg1), arg1, 1, "XtRemoveWorkProc", "XtWorkProcId");
- id = XEN_TO_C_XtWorkProcId(arg1);
+ Xen_check_type(Xen_is_XtWorkProcId(arg1), arg1, 1, "XtRemoveWorkProc", "XtWorkProcId");
+ id = Xen_to_C_XtWorkProcId(arg1);
XtRemoveWorkProc(id);
map_over_protected_elements(unprotect_workproc, id);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtAppAddWorkProc(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtAppAddWorkProc(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtAppAddWorkProc "XtWorkProcId XtAppAddWorkProc(app_context, proc, client_data) adds the specified work procedure for the \
application identified by app_context."
XtWorkProcId id;
int gc_loc;
- XEN descr;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppAddWorkProc", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg2) && (XEN_REQUIRED_ARGS_OK(arg2, 1)), arg2, 2, "XtAppAddWorkProc", "(XtWorkProc data)");
+ Xen descr;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppAddWorkProc", "XtAppContext");
+ Xen_check_type(Xen_is_procedure(arg2) && (Xen_is_aritable(arg2, 1)), arg2, 2, "XtAppAddWorkProc", "(XtWorkProc data)");
- descr = C_TO_XEN_XM_Background(arg2, (XEN_BOUND_P(arg3)) ? arg3 : XEN_FALSE);
+ descr = C_to_Xen_XM_Background(arg2, (Xen_is_bound(arg3)) ? arg3 : Xen_false);
gc_loc = xm_protect(descr);
- id = XtAppAddWorkProc(XEN_TO_C_XtAppContext(arg1),
+ id = XtAppAddWorkProc(Xen_to_C_XtAppContext(arg1),
gxm_XtWorkProc,
(XtPointer)descr);
- XEN_LIST_SET(descr, 3, C_TO_XEN_INT(gc_loc));
- XEN_LIST_SET(descr, 4, C_TO_XEN_ULONG(id));
- return(C_TO_XEN_XtWorkProcId(id));
+ Xen_list_set(descr, 3, C_int_to_Xen_integer(gc_loc));
+ Xen_list_set(descr, 4, C_ulong_to_Xen_ulong(id));
+ return(C_to_Xen_XtWorkProcId(id));
}
/* the next 4 are needed where the caller allocates a block of memory, but X frees it (XCreateImage) --
* can't use Scheme-allocated memory here etc
*/
-static XEN gxm_XtFree(XEN arg1)
+static Xen gxm_XtFree(Xen arg1)
{
#define H_XtFree "void XtFree(ptr)"
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1), arg1, 1, "XtFree", "pointer");
- XtFree((char *)XEN_UNWRAP_C_POINTER(arg1));
- return(XEN_FALSE);
+ char *ptr;
+
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1), arg1, 1, "XtFree", "pointer");
+
+ ptr = (char *)Xen_unwrap_C_pointer(arg1);
+ if (ptr) XtFree(ptr);
+ return(Xen_false);
}
-static XEN gxm_XtRealloc(XEN arg1, XEN arg2)
+static Xen gxm_XtRealloc(Xen arg1, Xen arg2)
{
#define H_XtRealloc "char *XtRealloc(ptr, num)"
- XEN_ASSERT_TYPE(XEN_WRAPPED_C_POINTER_P(arg1), arg1, 1, "XtRealloc", "pointer");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XtRealloc", "int");
- return(C_TO_XEN_ULONG(XtRealloc((char *)XEN_UNWRAP_C_POINTER(arg1), XEN_TO_C_INT(arg2))));
+ int num;
+ char *ptr;
+
+ Xen_check_type(Xen_is_wrapped_c_pointer(arg1), arg1, 1, "XtRealloc", "pointer");
+ ptr = (char *)Xen_unwrap_C_pointer(arg1);
+ if (!ptr) return(Xen_false);
+
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XtRealloc", "int");
+ num = Xen_integer_to_C_int(arg2);
+ if (num <= 0)
+ Xen_out_of_range_error("XtRealloc", 2, arg2, "num should be positive");
+
+ return(C_ulong_to_Xen_ulong(XtRealloc(ptr, num)));
}
-static XEN gxm_XtCalloc(XEN arg1, XEN arg2)
+static Xen gxm_XtCalloc(Xen arg1, Xen arg2)
{
#define H_XtCalloc "char *XtCalloc(num, size)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 1, "XtCalloc", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XtCalloc", "int");
- return(XEN_WRAP_C_POINTER(XtCalloc(XEN_TO_C_INT(arg1), XEN_TO_C_INT(arg2))));
+ int num, size;
+
+ Xen_check_type(Xen_is_integer(arg1), arg1, 1, "XtCalloc", "int");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XtCalloc", "int");
+ num = Xen_integer_to_C_int(arg1);
+ if (num <= 0)
+ Xen_out_of_range_error("XtCalloc", 1, arg1, "num should be positive");
+ size = Xen_integer_to_C_int(arg2);
+ if (size <= 0)
+ Xen_out_of_range_error("XtCalloc", 2, arg2, "size should be positive");
+
+ return(Xen_wrap_C_pointer(XtCalloc(num, size))); /* dumb thing simply exits the main program on error! */
}
-static XEN gxm_XtMalloc(XEN arg1)
+static Xen gxm_XtMalloc(Xen arg1)
{
#define H_XtMalloc "char *XtMalloc(size)"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg1), arg1, 1, "XtMalloc", "int");
- return(XEN_WRAP_C_POINTER(XtMalloc(XEN_TO_C_INT(arg1))));
+ int size;
+
+ Xen_check_type(Xen_is_integer(arg1), arg1, 1, "XtMalloc", "int");
+ size = Xen_integer_to_C_int(arg1);
+ if (size <= 0)
+ Xen_out_of_range_error("XtMalloc", 1, arg1, "size should be positive");
+
+ return(Xen_wrap_C_pointer(XtMalloc(size)));
}
-static XEN xm_XtErrorHandler;
-static XEN xm_XtWarningHandler;
+static Xen xm_XtErrorHandler;
+static Xen xm_XtWarningHandler;
static void gxm_XtErrorHandler(String msg)
{
- if (XEN_PROCEDURE_P(xm_XtErrorHandler))
- XEN_CALL_1(xm_XtErrorHandler,
- C_TO_XEN_STRING(msg),
- c__FUNCTION__);
+ if (Xen_is_procedure(xm_XtErrorHandler))
+ Xen_call_with_1_arg(xm_XtErrorHandler,
+ C_string_to_Xen_string(msg),
+ __func__);
}
-static XEN gxm_XtAppSetErrorHandler(XEN arg1, XEN arg2)
+static Xen gxm_XtAppSetErrorHandler(Xen arg1, Xen arg2)
{
#define H_XtAppSetErrorHandler "void XtAppSetErrorHandler(app_context, handler) registers the specified procedure, which is called when \
a fatal error condition occurs."
- XEN old_val;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppSetErrorHandler", "XtAppContext");
+ Xen old_val;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppSetErrorHandler", "XtAppContext");
old_val = xm_XtErrorHandler;
xm_protect(arg2);
xm_XtErrorHandler = arg2;
- XtAppSetErrorHandler(XEN_TO_C_XtAppContext(arg1), gxm_XtErrorHandler);
- if (XEN_PROCEDURE_P(old_val)) xm_unprotect(old_val);
+ XtAppSetErrorHandler(Xen_to_C_XtAppContext(arg1), gxm_XtErrorHandler);
+ if (Xen_is_procedure(old_val)) xm_unprotect(old_val);
return(old_val);
}
static void gxm_XtWarningHandler(String msg)
{
- if (XEN_PROCEDURE_P(xm_XtWarningHandler))
- XEN_CALL_1(xm_XtWarningHandler,
- C_TO_XEN_STRING(msg),
- c__FUNCTION__);
+ if (Xen_is_procedure(xm_XtWarningHandler))
+ Xen_call_with_1_arg(xm_XtWarningHandler,
+ C_string_to_Xen_string(msg),
+ __func__);
}
-static XEN gxm_XtAppSetWarningHandler(XEN arg1, XEN arg2)
+static Xen gxm_XtAppSetWarningHandler(Xen arg1, Xen arg2)
{
#define H_XtAppSetWarningHandler "void XtAppSetWarningHandler(app_context, handler) registers the specified procedure, which is called \
when a nonfatal error condition occurs."
- XEN old_val;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppSetWarningHandler", "XtAppContext");
+ Xen old_val;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppSetWarningHandler", "XtAppContext");
old_val = xm_XtWarningHandler;
xm_protect(arg2);
xm_XtWarningHandler = arg2;
- XtAppSetWarningHandler(XEN_TO_C_XtAppContext(arg1), gxm_XtWarningHandler);
- if (XEN_PROCEDURE_P(old_val)) xm_unprotect(old_val);
+ XtAppSetWarningHandler(Xen_to_C_XtAppContext(arg1), gxm_XtWarningHandler);
+ if (Xen_is_procedure(old_val)) xm_unprotect(old_val);
return(old_val);
}
-static XEN gxm_XtAppError(XEN arg1, XEN arg2)
+static Xen gxm_XtAppError(Xen arg1, Xen arg2)
{
#define H_XtAppError "void XtAppError(app_context, message) calls the installed error procedure and passes the specified message."
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppError", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtAppError", "char*");
- XtAppError(XEN_TO_C_XtAppContext(arg1), (char *)XEN_TO_C_STRING(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppError", "XtAppContext");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtAppError", "char*");
+ XtAppError(Xen_to_C_XtAppContext(arg1), (char *)Xen_string_to_C_string(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtAppWarningMsg(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XtAppWarningMsg(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XtAppWarningMsg "void XtAppWarningMsg(app_context, name, type, class, default, params, num_params) calls the high-level error \
handler and passes the specified information."
@@ -14265,25 +14018,25 @@ handler and passes the specified information."
int size;
Cardinal csize;
char **pars;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppWarningMsg", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtAppWarningMsg", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XtAppWarningMsg", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XtAppWarningMsg", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg5), arg5, 5, "XtAppWarningMsg", "char*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg6), arg6, 6, "XtAppWarningMsg", "list of String");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XtAppWarningMsg", "int");
- size = XEN_TO_C_INT(arg7);
- if (size <= 0) return(XEN_FALSE);
- pars = XEN_TO_C_Strings(arg6, size);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppWarningMsg", "XtAppContext");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtAppWarningMsg", "char*");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XtAppWarningMsg", "char*");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XtAppWarningMsg", "char*");
+ Xen_check_type(Xen_is_string(arg5), arg5, 5, "XtAppWarningMsg", "char*");
+ Xen_check_type(Xen_is_list(arg6), arg6, 6, "XtAppWarningMsg", "list of String");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XtAppWarningMsg", "int");
+ size = Xen_integer_to_C_int(arg7);
+ if (size <= 0) return(Xen_false);
+ pars = Xen_to_C_Strings(arg6, size);
csize = (Cardinal)size;
- XtAppWarningMsg(XEN_TO_C_XtAppContext(arg1), (char *)XEN_TO_C_STRING(arg2),
- (char *)XEN_TO_C_STRING(arg3), (char *)XEN_TO_C_STRING(arg4), (char *)XEN_TO_C_STRING(arg5),
+ XtAppWarningMsg(Xen_to_C_XtAppContext(arg1), (char *)Xen_string_to_C_string(arg2),
+ (char *)Xen_string_to_C_string(arg3), (char *)Xen_string_to_C_string(arg4), (char *)Xen_string_to_C_string(arg5),
pars, &csize);
free(pars);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtAppErrorMsg(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7)
+static Xen gxm_XtAppErrorMsg(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7)
{
#define H_XtAppErrorMsg "void XtAppErrorMsg(app_context, name, type, class, default, params, num_params) calls the high-level error \
handler and passes the specified information."
@@ -14292,62 +14045,62 @@ handler and passes the specified information."
int size;
Cardinal csize;
char **pars;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppErrorMsg", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtAppErrorMsg", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XtAppErrorMsg", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XtAppErrorMsg", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg5), arg5, 5, "XtAppErrorMsg", "char*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg6), arg6, 6, "XtAppErrorMsg", "list of String");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 7, "XtAppErrorMsg", "int");
- size = XEN_TO_C_INT(arg7);
- if (size <= 0) return(XEN_FALSE);
- pars = XEN_TO_C_Strings(arg6, size);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppErrorMsg", "XtAppContext");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtAppErrorMsg", "char*");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XtAppErrorMsg", "char*");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XtAppErrorMsg", "char*");
+ Xen_check_type(Xen_is_string(arg5), arg5, 5, "XtAppErrorMsg", "char*");
+ Xen_check_type(Xen_is_list(arg6), arg6, 6, "XtAppErrorMsg", "list of String");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 7, "XtAppErrorMsg", "int");
+ size = Xen_integer_to_C_int(arg7);
+ if (size <= 0) return(Xen_false);
+ pars = Xen_to_C_Strings(arg6, size);
csize = (Cardinal)size;
- XtAppErrorMsg(XEN_TO_C_XtAppContext(arg1), (char *)XEN_TO_C_STRING(arg2),
- (char *)XEN_TO_C_STRING(arg3), (char *)XEN_TO_C_STRING(arg4),
- (char *)XEN_TO_C_STRING(arg5), pars, &csize);
+ XtAppErrorMsg(Xen_to_C_XtAppContext(arg1), (char *)Xen_string_to_C_string(arg2),
+ (char *)Xen_string_to_C_string(arg3), (char *)Xen_string_to_C_string(arg4),
+ (char *)Xen_string_to_C_string(arg5), pars, &csize);
free(pars);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN xm_XtErrorMsgHandler;
-static XEN xm_XtWarningMsgHandler;
+static Xen xm_XtErrorMsgHandler;
+static Xen xm_XtWarningMsgHandler;
static void gxm_XtErrorMsgHandler(String name, String type, String clas, String defp, String *pars, Cardinal *num)
{
/* DIFF: XtErrorMsgHandler takes list of string pars
*/
- if ((XEN_PROCEDURE_P(xm_XtErrorMsgHandler)) && (num) && ((pars) || (*num == 0)))
+ if ((Xen_is_procedure(xm_XtErrorMsgHandler)) && (num) && ((pars) || (*num == 0)))
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
int i, len, loc;
loc = xm_protect(lst);
len = (*num);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(pars[i]), lst);
- XEN_CALL_6(xm_XtErrorMsgHandler,
- C_TO_XEN_STRING(name),
- C_TO_XEN_STRING(type),
- C_TO_XEN_STRING(clas),
- C_TO_XEN_STRING(defp),
+ lst = Xen_cons(C_string_to_Xen_string(pars[i]), lst);
+ Xen_call_with_6_args(xm_XtErrorMsgHandler,
+ C_string_to_Xen_string(name),
+ C_string_to_Xen_string(type),
+ C_string_to_Xen_string(clas),
+ C_string_to_Xen_string(defp),
lst,
- C_TO_XEN_INT(*num),
- c__FUNCTION__);
+ C_int_to_Xen_integer(*num),
+ __func__);
xm_unprotect_at(loc);
}
}
-static XEN gxm_XtAppSetErrorMsgHandler(XEN arg1, XEN arg2)
+static Xen gxm_XtAppSetErrorMsgHandler(Xen arg1, Xen arg2)
{
#define H_XtAppSetErrorMsgHandler "void XtAppSetErrorMsgHandler(app_context, msg_handler) registers the specified procedure, which is called \
when a fatal error occurs."
- XEN old_val;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppSetErrorMsgHandler", "XtAppContext");
+ Xen old_val;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppSetErrorMsgHandler", "XtAppContext");
old_val = xm_XtErrorMsgHandler;
xm_protect(arg2);
xm_XtErrorMsgHandler = arg2;
- XtAppSetErrorMsgHandler(XEN_TO_C_XtAppContext(arg1), gxm_XtErrorMsgHandler);
- if (XEN_PROCEDURE_P(old_val)) xm_unprotect(old_val);
+ XtAppSetErrorMsgHandler(Xen_to_C_XtAppContext(arg1), gxm_XtErrorMsgHandler);
+ if (Xen_is_procedure(old_val)) xm_unprotect(old_val);
return(old_val);
}
@@ -14356,41 +14109,41 @@ static void gxm_XtWarningMsgHandler(String name, String type, String clas, Strin
{
/* DIFF: XtWarningMsgHandler takes list of string pars
*/
- if ((XEN_PROCEDURE_P(xm_XtWarningMsgHandler)) && (num) && ((pars) || (*num == 0)))
+ if ((Xen_is_procedure(xm_XtWarningMsgHandler)) && (num) && ((pars) || (*num == 0)))
{
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
int i, len, loc;
loc = xm_protect(lst);
len = (*num);
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(pars[i]), lst);
- XEN_CALL_6(xm_XtWarningMsgHandler,
- C_TO_XEN_STRING(name),
- C_TO_XEN_STRING(type),
- C_TO_XEN_STRING(clas),
- C_TO_XEN_STRING(defp),
+ lst = Xen_cons(C_string_to_Xen_string(pars[i]), lst);
+ Xen_call_with_6_args(xm_XtWarningMsgHandler,
+ C_string_to_Xen_string(name),
+ C_string_to_Xen_string(type),
+ C_string_to_Xen_string(clas),
+ C_string_to_Xen_string(defp),
lst,
- C_TO_XEN_INT(*num),
- c__FUNCTION__);
+ C_int_to_Xen_integer(*num),
+ __func__);
xm_unprotect_at(loc);
}
}
-static XEN gxm_XtAppSetWarningMsgHandler(XEN arg1, XEN arg2)
+static Xen gxm_XtAppSetWarningMsgHandler(Xen arg1, Xen arg2)
{
#define H_XtAppSetWarningMsgHandler "void XtAppSetWarningMsgHandler(app_context, msg_handler) registers the specified procedure, which \
is called when a nonfatal error condition occurs."
- XEN old_val;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppSetWarningMsgHandler", "XtAppContext");
+ Xen old_val;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppSetWarningMsgHandler", "XtAppContext");
old_val = xm_XtWarningMsgHandler;
xm_protect(arg2);
xm_XtWarningMsgHandler = arg2;
- XtAppSetWarningMsgHandler(XEN_TO_C_XtAppContext(arg1), gxm_XtWarningMsgHandler);
- if (XEN_PROCEDURE_P(old_val)) xm_unprotect(old_val);
+ XtAppSetWarningMsgHandler(Xen_to_C_XtAppContext(arg1), gxm_XtWarningMsgHandler);
+ if (Xen_is_procedure(old_val)) xm_unprotect(old_val);
return(old_val);
}
-static XEN gxm_XtGetValues(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtGetValues(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtGetValues "void XtGetValues(Widget w, ArgList args, Cardinal num_args): returns the values of the \
resources specified for the widget w. In xm, 'args' is a list of resource names followed by a placeholder \
@@ -14399,34 +14152,34 @@ of a widget, (" XM_PREFIX "XtGetValues" XM_POSTFIX " w (list " XM_PREFIX "XmNhei
" XM_PREFIX "XmNwidth" XM_POSTFIX " 0)) which returns the list with the values filled in: (list height 123 \
width 321). If the resource value is an array in C, it is returned as a list."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGetValues", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XtGetValues", "List");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XtGetValues", "int");
- return(gxm_XtGetValues_1(arg1, arg2, XEN_TO_C_INT_DEF(arg3, arg2)));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGetValues", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XtGetValues", "List");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XtGetValues", "int");
+ return(gxm_XtGetValues_1(arg1, arg2, Xen_to_C_INT_DEF(arg3, arg2)));
}
-static XEN gxm_XtVaGetValues(XEN arg1, XEN arg2)
+static Xen gxm_XtVaGetValues(Xen arg1, Xen arg2)
{
#define H_XtVaGetValues "void XtVaGetValues(w, ...) in xm is the same as XtGetValues."
/* DIFF: XtVaGetValues -> returns original list with vals in place
*/
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtVaGetValues", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XtVaGetValues", "List");
- return(gxm_XtGetValues_1(arg1, arg2, XEN_LIST_LENGTH(arg2) / 2));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtVaGetValues", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XtVaGetValues", "List");
+ return(gxm_XtGetValues_1(arg1, arg2, Xen_list_length(arg2) / 2));
}
-static XEN gxm_XtVaSetValues(XEN arg1, XEN arg2)
+static Xen gxm_XtVaSetValues(Xen arg1, Xen arg2)
{
#define H_XtVaSetValues "void XtVaSetValues(w, ...) in xm is the same as XtSetValues."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtVaSetValues", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XtVaSetValues", "List");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtVaSetValues", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XtVaSetValues", "List");
{
Widget w;
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg2);
- w = XEN_TO_C_Widget(arg1);
- arglen = XEN_LIST_LENGTH(arg2) / 2;
+ args = Xen_to_C_Args(arg2);
+ w = Xen_to_C_Widget(arg1);
+ arglen = Xen_list_length(arg2) / 2;
XtSetValues(w, args, arglen);
if (args)
{
@@ -14434,10 +14187,10 @@ static XEN gxm_XtVaSetValues(XEN arg1, XEN arg2)
free_args(args, arglen);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtSetValues(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtSetValues(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtSetValues "void XtSetValues(Widget w, ArgList args, Cardinal num_args) sets the values of the \
resources specified for the widget w. In xm, 'args' is a list of resource names followed by the new value, \
@@ -14445,16 +14198,16 @@ and the length of the arglist is optional. For example, to set the current heig
of a widget, (" XM_PREFIX "XtSetValues" XM_POSTFIX " w (list " XM_PREFIX "XmNheight" XM_POSTFIX " 123 \
" XM_PREFIX "XmNwidth" XM_POSTFIX " 321)). If the resource value in C is an array, it is a list in xm."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtSetValues", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XtSetValues", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg3), arg3, 3, "XtSetValues", "int");
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtSetValues", "Widget");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XtSetValues", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg3), arg3, 3, "XtSetValues", "int");
{
Arg *args;
int arglen;
Widget w;
- w = XEN_TO_C_Widget(arg1);
- args = XEN_TO_C_Args(arg2);
- arglen = XEN_TO_C_INT_DEF(arg3, arg2);
+ w = Xen_to_C_Widget(arg1);
+ args = Xen_to_C_Args(arg2);
+ arglen = Xen_to_C_INT_DEF(arg3, arg2);
XtSetValues(w, args, arglen);
if (args)
{
@@ -14462,66 +14215,66 @@ of a widget, (" XM_PREFIX "XtSetValues" XM_POSTFIX " w (list " XM_PREFIX "XmNhei
free_args(args, arglen);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtCloseDisplay(XEN arg1)
+static Xen gxm_XtCloseDisplay(Xen arg1)
{
#define H_XtCloseDisplay "void XtCloseDisplay(display) closes the specified display as soon as it is safe to do so."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtCloseDisplay", "Display*");
- XtCloseDisplay(XEN_TO_C_Display(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtCloseDisplay", "Display*");
+ XtCloseDisplay(Xen_to_C_Display(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtDisplayToApplicationContext(XEN arg1)
+static Xen gxm_XtDisplayToApplicationContext(Xen arg1)
{
#define H_XtDisplayToApplicationContext "XtAppContext XtDisplayToApplicationContext(dpy): returns the application context for the specified display."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtDisplayToApplicationContext", "Display*");
- return(C_TO_XEN_XtAppContext(XtDisplayToApplicationContext(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtDisplayToApplicationContext", "Display*");
+ return(C_to_Xen_XtAppContext(XtDisplayToApplicationContext(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XtWidgetToApplicationContext(XEN arg1)
+static Xen gxm_XtWidgetToApplicationContext(Xen arg1)
{
#define H_XtWidgetToApplicationContext "XtAppContext XtWidgetToApplicationContext(w): returns the application context for the specified widget."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtWidgetToApplicationContext", "Widget");
- return(C_TO_XEN_XtAppContext(XtWidgetToApplicationContext(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtWidgetToApplicationContext", "Widget");
+ return(C_to_Xen_XtAppContext(XtWidgetToApplicationContext(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtInitializeWidgetClass(XEN arg1)
+static Xen gxm_XtInitializeWidgetClass(Xen arg1)
{
#define H_XtInitializeWidgetClass "void XtInitializeWidgetClass(object_class)"
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg1), arg1, 1, "XtInitializeWidgetClass", "WidgetClass");
- XtInitializeWidgetClass(XEN_TO_C_WidgetClass(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_WidgetClass(arg1), arg1, 1, "XtInitializeWidgetClass", "WidgetClass");
+ XtInitializeWidgetClass(Xen_to_C_WidgetClass(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtDestroyApplicationContext(XEN arg1)
+static Xen gxm_XtDestroyApplicationContext(Xen arg1)
{
#define H_XtDestroyApplicationContext "void XtDestroyApplicationContext(app_context) destroys the specified application context as soon as it is safe to do so."
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtDestroyApplicationContext", "XtAppContext");
- XtDestroyApplicationContext(XEN_TO_C_XtAppContext(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtDestroyApplicationContext", "XtAppContext");
+ XtDestroyApplicationContext(Xen_to_C_XtAppContext(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtCreateApplicationContext(void)
+static Xen gxm_XtCreateApplicationContext(void)
{
#define H_XtCreateApplicationContext "XtAppContext XtCreateApplicationContext()"
- return(C_TO_XEN_XtAppContext(XtCreateApplicationContext()));
+ return(C_to_Xen_XtAppContext(XtCreateApplicationContext()));
}
-static XEN gxm_argv_to_list(XEN lst, int argc, char **argv)
+static Xen gxm_argv_to_list(Xen lst, int argc, char **argv)
{
int i, loc;
if (argc == 0) return(lst);
loc = xm_protect(lst);
for (i = argc - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_STRING(argv[i]), lst);
+ lst = Xen_cons(C_string_to_Xen_string(argv[i]), lst);
free(argv);
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XtOpenDisplay(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg7, XEN arg8)
+static Xen gxm_XtOpenDisplay(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg7, Xen arg8)
{
#define H_XtOpenDisplay "Display *XtOpenDisplay(app_context, display_string, application_name, application_class, argc, argv) \
calls XOpenDisplay the specified display name."
@@ -14529,48 +14282,48 @@ calls XOpenDisplay the specified display name."
*/
char **argv = NULL;
int argc;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
Display *dpy;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtOpenDisplay", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2) || XEN_FALSE_P(arg2), arg2, 2, "XtOpenDisplay", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XtOpenDisplay", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XtOpenDisplay", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 5, "XtOpenDisplay", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg8), arg8, 6, "XtOpenDisplay", "list of char*");
- argc = XEN_TO_C_INT(arg7);
- if (XEN_LIST_LENGTH(arg8) != argc) return(XEN_FALSE); /* error? */
- if (argc > 0) argv = XEN_TO_C_Strings(arg8, argc);
- dpy = XtOpenDisplay(XEN_TO_C_XtAppContext(arg1),
- (XEN_FALSE_P(arg2)) ? NULL : (char *)XEN_TO_C_STRING(arg2),
- (char *)XEN_TO_C_STRING(arg3),
- (char *)XEN_TO_C_STRING(arg4),
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtOpenDisplay", "XtAppContext");
+ Xen_check_type(Xen_is_string(arg2) || Xen_is_false(arg2), arg2, 2, "XtOpenDisplay", "char*");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XtOpenDisplay", "char*");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XtOpenDisplay", "char*");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 5, "XtOpenDisplay", "int");
+ Xen_check_type(Xen_is_list(arg8), arg8, 6, "XtOpenDisplay", "list of char*");
+ argc = Xen_integer_to_C_int(arg7);
+ if (Xen_list_length(arg8) != argc) return(Xen_false); /* error? */
+ if (argc > 0) argv = Xen_to_C_Strings(arg8, argc);
+ dpy = XtOpenDisplay(Xen_to_C_XtAppContext(arg1),
+ (Xen_is_false(arg2)) ? NULL : (char *)Xen_string_to_C_string(arg2),
+ (char *)Xen_string_to_C_string(arg3),
+ (char *)Xen_string_to_C_string(arg4),
NULL, 0, &argc, argv);
if (dpy)
- lst = XEN_CONS(C_TO_XEN_Display(dpy), lst);
- else lst = XEN_CONS(XEN_FALSE, lst);
+ lst = Xen_cons(C_to_Xen_Display(dpy), lst);
+ else lst = Xen_cons(Xen_false, lst);
return(gxm_argv_to_list(lst, argc, argv));
}
-static XEN gxm_XtAppSetFallbackResources(XEN app, XEN specs)
+static Xen gxm_XtAppSetFallbackResources(Xen app, Xen specs)
{
#define H_XtAppSetFallbackResources "XtAppSetFallbackResources(app, list-of-strings) sets the app's default resource values \
from the list of strings"
char **fallbacks;
int i, len;
- XEN lst;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(app), app, 1, "XtAppSetFallbackResources", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_LIST_P(specs), specs, 2, "XtAppSetFallbackResources", "list of char*");
- len = XEN_LIST_LENGTH(specs);
- lst = XEN_COPY_ARG(specs);
+ Xen lst;
+ Xen_check_type(Xen_is_XtAppContext(app), app, 1, "XtAppSetFallbackResources", "XtAppContext");
+ Xen_check_type(Xen_is_list(specs), specs, 2, "XtAppSetFallbackResources", "list of char*");
+ len = Xen_list_length(specs);
+ lst = Xen_copy_arg(specs);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
- for (i = 0; i < len; i++, lst = XEN_CDR(lst))
- fallbacks[i] = (char *)XEN_TO_C_STRING(XEN_CAR(lst));
- XtAppSetFallbackResources(XEN_TO_C_XtAppContext(app), fallbacks);
+ for (i = 0; i < len; i++, lst = Xen_cdr(lst))
+ fallbacks[i] = (char *)Xen_string_to_C_string(Xen_car(lst));
+ XtAppSetFallbackResources(Xen_to_C_XtAppContext(app), fallbacks);
free(fallbacks);
return(app);
}
-static XEN gxm_XtVaAppInitialize(XEN arg2, XEN arg5, XEN arg6, XEN arg8, XEN specs)
+static Xen gxm_XtVaAppInitialize(Xen arg2, Xen arg5, Xen arg6, Xen arg8, Xen specs)
{
#define H_XtVaAppInitialize "Widget XtVaAppInitialize(application_class, argc_in_out, argv_in_out, args, fallbacks) -- the order \
of the arguments is slightly different from the C Xt call. The final arg is an (optional) list of strings."
@@ -14584,30 +14337,39 @@ of the arguments is slightly different from the C Xt call. The final arg is an
int i, len = 0, argc, arglen;
char **argv = NULL;
char **fallbacks = NULL;
- XEN lst;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 1, "XtVaAppInitialize", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 2, "XtVaAppInitialize", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg6), arg6, 3, "XtVaAppInitialize", "list of String");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg8), arg8, 4, "XtVaAppInitialize", "arg list");
- XEN_ASSERT_TYPE(XEN_LIST_P(specs) || XEN_NOT_BOUND_P(specs), specs, 5, "XtVaAppInitialize", "list of char*");
- argc = XEN_TO_C_INT(arg5);
- if (XEN_LIST_LENGTH(arg6) != argc) return(XEN_FALSE); /* error? */
- if (argc > 0) argv = XEN_TO_C_Strings(arg6, argc);
- if (XEN_LIST_P(specs))
+ Xen_check_type(Xen_is_string(arg2), arg2, 1, "XtVaAppInitialize", "char*");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 2, "XtVaAppInitialize", "int");
+ Xen_check_type(Xen_is_list(arg6), arg6, 3, "XtVaAppInitialize", "list of String");
+ Xen_check_type(Xen_is_list(arg8), arg8, 4, "XtVaAppInitialize", "arg list");
+ Xen_check_type(Xen_is_list(specs) || !Xen_is_bound(specs), specs, 5, "XtVaAppInitialize", "list of char*");
+ argc = Xen_integer_to_C_int(arg5);
+ if (Xen_list_length(arg6) != argc) return(Xen_false); /* error? */
+ if (argc > 0) argv = Xen_to_C_Strings(arg6, argc);
+ if (Xen_is_list(specs))
{
+ Xen lst;
int gcloc;
- len = XEN_LIST_LENGTH(specs);
- lst = XEN_COPY_ARG(specs);
+ len = Xen_list_length(specs);
+ if (len <= 0) return(Xen_false);
+ lst = Xen_copy_arg(specs);
gcloc = xm_protect(lst);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
- for (i = 0; i < len; i++, lst = XEN_CDR(lst))
- fallbacks[i] = xen_strdup(XEN_TO_C_STRING(XEN_CAR(lst)));
+ for (i = 0; i < len; i++, lst = Xen_cdr(lst))
+ {
+ if (!Xen_is_string(Xen_car(lst)))
+ {
+ free(fallbacks);
+ xm_unprotect_at(gcloc);
+ return(Xen_false);
+ }
+ fallbacks[i] = xen_strdup(Xen_string_to_C_string(Xen_car(lst)));
+ }
xm_unprotect_at(gcloc);
}
- args = XEN_TO_C_Args(arg8);
- arglen = XEN_LIST_LENGTH(arg8) / 2;
+ args = Xen_to_C_Args(arg8);
+ arglen = Xen_list_length(arg8) / 2;
res = XtAppInitialize(&app,
- (char *)XEN_TO_C_STRING(arg2),
+ (char *)Xen_string_to_C_string(arg2),
NULL,
0,
&argc,
@@ -14626,13 +14388,13 @@ of the arguments is slightly different from the C Xt call. The final arg is an
if (fallbacks[i]) free(fallbacks[i]);
free(fallbacks);
}
- return(XEN_LIST_3(C_TO_XEN_Widget(res),
- C_TO_XEN_XtAppContext(app),
- gxm_argv_to_list(XEN_EMPTY_LIST, argc, argv)));
+ return(Xen_list_3(C_to_Xen_Widget(res),
+ C_to_Xen_XtAppContext(app),
+ gxm_argv_to_list(Xen_empty_list, argc, argv)));
}
-static XEN gxm_XtAppInitialize(XEN arg2, XEN arg5, XEN arg6, XEN arg8, XEN arg9)
+static Xen gxm_XtAppInitialize(Xen arg2, Xen arg5, Xen arg6, Xen arg8, Xen arg9)
{
#define H_XtAppInitialize "Widget XtAppInitialize(application_class, argc_in_out, argv_in_out, \
args, num_args) calls XtToolkitInitialize followed by XtCreateApplicationContext ,then calls XtOpenDisplay with \
@@ -14649,30 +14411,30 @@ and the specified args and num_args and returns the created shell. The num_args
char **argv = NULL;
char **fallbacks = NULL;
int i, len = 0;
- XEN lst;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 1, "XtAppInitialize", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 2, "XtAppInitialize", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg6), arg6, 3, "XtAppInitialize", "list of String*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg8), arg8, 4, "XtAppInitialize", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9) || XEN_LIST_P(arg9) || XEN_NOT_BOUND_P(arg9), arg9, 5, "XtAppInitialize", "int or list of strings"); /* num_args */
- argc = XEN_TO_C_INT(arg5);
- if (XEN_LIST_LENGTH(arg6) != argc) return(XEN_FALSE); /* error? */
- if (argc > 0) argv = XEN_TO_C_Strings(arg6, argc);
- args = XEN_TO_C_Args(arg8);
- if (XEN_INTEGER_P(arg9)) arglen = XEN_TO_C_INT(arg9); else arglen = XEN_LIST_LENGTH(arg8) / 2;
- if (XEN_LIST_P(arg9))
+ Xen_check_type(Xen_is_string(arg2), arg2, 1, "XtAppInitialize", "char*");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 2, "XtAppInitialize", "int");
+ Xen_check_type(Xen_is_list(arg6), arg6, 3, "XtAppInitialize", "list of String*");
+ Xen_check_type(Xen_is_list(arg8), arg8, 4, "XtAppInitialize", "ArgList");
+ Xen_check_type(Xen_is_integer(arg9) || Xen_is_list(arg9) || !Xen_is_bound(arg9), arg9, 5, "XtAppInitialize", "int or list of strings"); /* num_args */
+ argc = Xen_integer_to_C_int(arg5);
+ if (Xen_list_length(arg6) != argc) return(Xen_false); /* error? */
+ if (argc > 0) argv = Xen_to_C_Strings(arg6, argc);
+ args = Xen_to_C_Args(arg8);
+ if (Xen_is_integer(arg9)) arglen = Xen_integer_to_C_int(arg9); else arglen = Xen_list_length(arg8) / 2;
+ if (Xen_is_list(arg9))
{
+ Xen lst;
int gcloc;
- len = XEN_LIST_LENGTH(arg9);
- lst = XEN_COPY_ARG(arg9);
+ len = Xen_list_length(arg9);
+ lst = Xen_copy_arg(arg9);
gcloc = xm_protect(lst);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
- for (i = 0; i < len; i++, lst = XEN_CDR(lst))
- fallbacks[i] = xen_strdup(XEN_TO_C_STRING(XEN_CAR(lst)));
+ for (i = 0; i < len; i++, lst = Xen_cdr(lst))
+ fallbacks[i] = xen_strdup(Xen_string_to_C_string(Xen_car(lst)));
xm_unprotect_at(gcloc);
}
res = XtAppInitialize(&app,
- (char *)XEN_TO_C_STRING(arg2),
+ (char *)Xen_string_to_C_string(arg2),
NULL,
0,
&argc,
@@ -14691,12 +14453,12 @@ and the specified args and num_args and returns the created shell. The num_args
if (fallbacks[i]) free(fallbacks[i]);
free(fallbacks);
}
- return(XEN_LIST_3(C_TO_XEN_Widget(res),
- C_TO_XEN_XtAppContext(app),
- gxm_argv_to_list(XEN_EMPTY_LIST, argc, argv)));
+ return(Xen_list_3(C_to_Xen_Widget(res),
+ C_to_Xen_XtAppContext(app),
+ gxm_argv_to_list(Xen_empty_list, argc, argv)));
}
-static XEN gxm_XtVaOpenApplication(XEN arg1, XEN arg4, XEN arg5, XEN arg7, XEN arg8, XEN specs)
+static Xen gxm_XtVaOpenApplication(Xen arg1, Xen arg4, Xen arg5, Xen arg7, Xen arg8, Xen specs)
{
#define H_XtVaOpenApplication "Widget XtVaOpenApplication(application_class, argc_in_out, argv_in_out, widget_class, args, fallbacks)"
/* DIFF: XtVaOpenApplication [app] name {options numopts} {argc} argv resources class args -> (list widget app), argc is int not int* options/num ignored
@@ -14710,37 +14472,37 @@ static XEN gxm_XtVaOpenApplication(XEN arg1, XEN arg4, XEN arg5, XEN arg7, XEN a
char **argv = NULL;
char **fallbacks = NULL;
int i, len = 0;
- XEN lst;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtVaOpenApplication", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 2, "XtVaOpenApplication", "int"); /* was arg3 by mistake, 11-Oct-02 */
- XEN_ASSERT_TYPE(XEN_LIST_P(arg5), arg5, 3, "XtVaOpenApplication", "list of String");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg7), arg7, 4, "XtVaOpenApplication", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg8), arg8, 5, "XtVaOpenApplication", "arg list");
- XEN_ASSERT_TYPE(XEN_LIST_P(specs) || XEN_NOT_BOUND_P(specs), specs, 5, "XtVaOpenApplication", "list of char*");
- argc = XEN_TO_C_INT(arg4);
- if (XEN_LIST_LENGTH(arg5) != argc) return(XEN_FALSE); /* error? */
- if (argc > 0) argv = XEN_TO_C_Strings(arg5, argc);
- if (XEN_LIST_P(specs))
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtVaOpenApplication", "char*");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 2, "XtVaOpenApplication", "int"); /* was arg3 by mistake, 11-Oct-02 */
+ Xen_check_type(Xen_is_list(arg5), arg5, 3, "XtVaOpenApplication", "list of String");
+ Xen_check_type(Xen_is_WidgetClass(arg7), arg7, 4, "XtVaOpenApplication", "WidgetClass");
+ Xen_check_type(Xen_is_list(arg8), arg8, 5, "XtVaOpenApplication", "arg list");
+ Xen_check_type(Xen_is_list(specs) || !Xen_is_bound(specs), specs, 5, "XtVaOpenApplication", "list of char*");
+ argc = Xen_integer_to_C_int(arg4);
+ if (Xen_list_length(arg5) != argc) return(Xen_false); /* error? */
+ if (argc > 0) argv = Xen_to_C_Strings(arg5, argc);
+ if (Xen_is_list(specs))
{
+ Xen lst;
int gcloc;
- len = XEN_LIST_LENGTH(specs);
- lst = XEN_COPY_ARG(specs);
+ len = Xen_list_length(specs);
+ lst = Xen_copy_arg(specs);
gcloc = xm_protect(lst);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
- for (i = 0; i < len; i++, lst = XEN_CDR(lst))
- fallbacks[i] = xen_strdup(XEN_TO_C_STRING(XEN_CAR(lst)));
+ for (i = 0; i < len; i++, lst = Xen_cdr(lst))
+ fallbacks[i] = xen_strdup(Xen_string_to_C_string(Xen_car(lst)));
xm_unprotect_at(gcloc);
}
- args = XEN_TO_C_Args(arg8);
- arglen = XEN_LIST_LENGTH(arg8) / 2;
+ args = Xen_to_C_Args(arg8);
+ arglen = Xen_list_length(arg8) / 2;
res = XtOpenApplication(&app,
- (char *)XEN_TO_C_STRING(arg1),
+ (char *)Xen_string_to_C_string(arg1),
NULL,
0,
&argc,
argv,
fallbacks,
- XEN_TO_C_WidgetClass(arg7),
+ Xen_to_C_WidgetClass(arg7),
args,
arglen);
if (args)
@@ -14754,12 +14516,12 @@ static XEN gxm_XtVaOpenApplication(XEN arg1, XEN arg4, XEN arg5, XEN arg7, XEN a
if (fallbacks[i]) free(fallbacks[i]);
free(fallbacks);
}
- return(XEN_LIST_3(C_TO_XEN_Widget(res),
- C_TO_XEN_XtAppContext(app),
- gxm_argv_to_list(XEN_EMPTY_LIST, argc, argv)));
+ return(Xen_list_3(C_to_Xen_Widget(res),
+ C_to_Xen_XtAppContext(app),
+ gxm_argv_to_list(Xen_empty_list, argc, argv)));
}
-static XEN gxm_XtOpenApplication(XEN arg1, XEN arg4, XEN arg5, XEN arg7, XEN arg8, XEN arg9)
+static Xen gxm_XtOpenApplication(Xen arg1, Xen arg4, Xen arg5, Xen arg7, Xen arg8, Xen arg9)
{
#define H_XtOpenApplication "Widget XtOpenApplication(application_class, argc_in_out, argv_in_out, \
widget_class, args, num_args) calls XtToolkitInitialize followed by XtCreateApplicationContext , then calls XtOpenDisplay \
@@ -14775,31 +14537,31 @@ of fallback resources."
char **argv;
char **fallbacks = NULL;
int i, len = 0;
- XEN lst;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtOpenApplication", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 2, "XtOpenApplication", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg5), arg5, 3, "XtOpenApplication", "list of String*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg7), arg7, 4, "XtOpenApplication", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg8), arg8, 8, "XtOpenApplication", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg9) || XEN_LIST_P(arg9) || XEN_NOT_BOUND_P(arg9), arg9, 5, "XtOpenApplication", "int or list of strings"); /* num_args */
- argc = XEN_TO_C_INT(arg4);
- argv = XEN_TO_C_Strings(arg5, argc);
- args = XEN_TO_C_Args(arg8);
- if (XEN_INTEGER_P(arg9)) arglen = XEN_TO_C_INT(arg9); else arglen = XEN_LIST_LENGTH(arg8) / 2;
- if (XEN_LIST_P(arg9))
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtOpenApplication", "char*");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 2, "XtOpenApplication", "int");
+ Xen_check_type(Xen_is_list(arg5), arg5, 3, "XtOpenApplication", "list of String*");
+ Xen_check_type(Xen_is_WidgetClass(arg7), arg7, 4, "XtOpenApplication", "WidgetClass");
+ Xen_check_type(Xen_is_list(arg8), arg8, 8, "XtOpenApplication", "ArgList");
+ Xen_check_type(Xen_is_integer(arg9) || Xen_is_list(arg9) || !Xen_is_bound(arg9), arg9, 5, "XtOpenApplication", "int or list of strings"); /* num_args */
+ argc = Xen_integer_to_C_int(arg4);
+ argv = Xen_to_C_Strings(arg5, argc);
+ args = Xen_to_C_Args(arg8);
+ if (Xen_is_integer(arg9)) arglen = Xen_integer_to_C_int(arg9); else arglen = Xen_list_length(arg8) / 2;
+ if (Xen_is_list(arg9))
{
+ Xen lst;
int gcloc;
- len = XEN_LIST_LENGTH(arg9);
- lst = XEN_COPY_ARG(arg9);
+ len = Xen_list_length(arg9);
+ lst = Xen_copy_arg(arg9);
gcloc = xm_protect(lst);
fallbacks = (char **)calloc(len + 1, sizeof(char *)); /* +1 for null termination */
- for (i = 0; i < len; i++, lst = XEN_CDR(lst))
- fallbacks[i] = (char *)XEN_TO_C_STRING(XEN_CAR(lst));
+ for (i = 0; i < len; i++, lst = Xen_cdr(lst))
+ fallbacks[i] = (char *)Xen_string_to_C_string(Xen_car(lst));
xm_unprotect_at(gcloc);
}
- res = XtOpenApplication(&app, (char *)XEN_TO_C_STRING(arg1),
+ res = XtOpenApplication(&app, (char *)Xen_string_to_C_string(arg1),
NULL, 0, &argc,
- argv, fallbacks, XEN_TO_C_WidgetClass(arg7),
+ argv, fallbacks, Xen_to_C_WidgetClass(arg7),
args, arglen);
if (args)
{
@@ -14812,12 +14574,12 @@ of fallback resources."
if (fallbacks[i]) free(fallbacks[i]);
free(fallbacks);
}
- return(XEN_LIST_3(C_TO_XEN_Widget(res),
- C_TO_XEN_XtAppContext(app),
- gxm_argv_to_list(XEN_EMPTY_LIST, argc, argv)));
+ return(Xen_list_3(C_to_Xen_Widget(res),
+ C_to_Xen_XtAppContext(app),
+ gxm_argv_to_list(Xen_empty_list, argc, argv)));
}
-static XEN gxm_XtDisplayInitialize(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg7, XEN arg8)
+static Xen gxm_XtDisplayInitialize(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg7, Xen arg8)
{
#define H_XtDisplayInitialize "void XtDisplayInitialize(app_context, display, application_name, application_class, argc, argv) \
builds the resource database, calls the Xlib XrmParseCommand to parse the command line, and performs other per display initialization."
@@ -14825,58 +14587,58 @@ builds the resource database, calls the Xlib XrmParseCommand to parse the comman
*/
char **argv;
int argc;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtDisplayInitialize", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_Display_P(arg2), arg2, 2, "XtDisplayInitialize", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XtDisplayInitialize", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg4), arg4, 4, "XtDisplayInitialize", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg7), arg7, 5, "XtDisplayInitialize", "int");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg8), arg8, 6, "XtDisplayInitialize", "list of char*");
- argc = XEN_TO_C_INT(arg7);
- argv = XEN_TO_C_Strings(arg8, argc);
- XtDisplayInitialize(XEN_TO_C_XtAppContext(arg1),
- XEN_TO_C_Display(arg2),
- (char *)XEN_TO_C_STRING(arg3),
- (char *)XEN_TO_C_STRING(arg4),
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtDisplayInitialize", "XtAppContext");
+ Xen_check_type(Xen_is_Display(arg2), arg2, 2, "XtDisplayInitialize", "Display*");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XtDisplayInitialize", "char*");
+ Xen_check_type(Xen_is_string(arg4), arg4, 4, "XtDisplayInitialize", "char*");
+ Xen_check_type(Xen_is_integer(arg7), arg7, 5, "XtDisplayInitialize", "int");
+ Xen_check_type(Xen_is_list(arg8), arg8, 6, "XtDisplayInitialize", "list of char*");
+ argc = Xen_integer_to_C_int(arg7);
+ argv = Xen_to_C_Strings(arg8, argc);
+ XtDisplayInitialize(Xen_to_C_XtAppContext(arg1),
+ Xen_to_C_Display(arg2),
+ (char *)Xen_string_to_C_string(arg3),
+ (char *)Xen_string_to_C_string(arg4),
NULL, 0,
&argc, argv);
- return(gxm_argv_to_list(XEN_EMPTY_LIST, argc, argv));
+ return(gxm_argv_to_list(Xen_empty_list, argc, argv));
}
/* -------- XtLanguage callback -------- */
/* (456) a global */
-static XEN xm_language_proc;
+static Xen xm_language_proc;
static String gxm_XtLanguageProc(Display* d, String s, XtPointer context)
{
char *res;
- res = (char *)XEN_TO_C_STRING(XEN_CALL_3(xm_language_proc,
- C_TO_XEN_Display(d),
- C_TO_XEN_STRING(s),
- (XEN)context,
- c__FUNCTION__));
+ res = (char *)Xen_string_to_C_string(Xen_call_with_3_args(xm_language_proc,
+ C_to_Xen_Display(d),
+ C_string_to_Xen_string(s),
+ (Xen)context,
+ __func__));
if (res)
return(xen_strdup(res));
return(NULL);
}
-static XEN gxm_XtSetLanguageProc(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtSetLanguageProc(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtSetLanguageProc "Widget XtSetLanguageProc(app_context, proc, client_data)"
/* arg can be null -> use default */
/* DIFF: XtSetLanguageProc args1 and 2 use #f for NULL, return of #f means none was set
*/
- XEN previous_proc = XEN_FALSE;
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg1) || XEN_XtAppContext_P(arg1), arg1, 1, "XtSetLanguageProc", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg2) || (XEN_PROCEDURE_P(arg2) && (XEN_REQUIRED_ARGS_OK(arg2, 3))), arg2, 2, "XtSetLanguageProc", "XtLanguageProc");
+ Xen previous_proc = Xen_false;
+ Xen_check_type(Xen_is_false(arg1) || Xen_is_XtAppContext(arg1), arg1, 1, "XtSetLanguageProc", "XtAppContext");
+ Xen_check_type(Xen_is_false(arg2) || (Xen_is_procedure(arg2) && (Xen_is_aritable(arg2, 3))), arg2, 2, "XtSetLanguageProc", "XtLanguageProc");
previous_proc = xm_language_proc;
- if (XEN_PROCEDURE_P(previous_proc))
+ if (Xen_is_procedure(previous_proc))
xm_unprotect(previous_proc);
- if (XEN_PROCEDURE_P(arg2))
+ if (Xen_is_procedure(arg2))
xm_protect(arg2);
- if (XEN_FALSE_P(arg1))
+ if (Xen_is_false(arg1))
{
- if (XEN_FALSE_P(arg2))
+ if (Xen_is_false(arg2))
XtSetLanguageProc(NULL, NULL, NULL);
else XtSetLanguageProc(NULL,
(XtLanguageProc)gxm_XtLanguageProc,
@@ -14884,39 +14646,39 @@ static XEN gxm_XtSetLanguageProc(XEN arg1, XEN arg2, XEN arg3)
}
else
{
- if (XEN_FALSE_P(arg2))
- XtSetLanguageProc(XEN_TO_C_XtAppContext(arg1), NULL, NULL);
- else XtSetLanguageProc(XEN_TO_C_XtAppContext(arg1),
+ if (Xen_is_false(arg2))
+ XtSetLanguageProc(Xen_to_C_XtAppContext(arg1), NULL, NULL);
+ else XtSetLanguageProc(Xen_to_C_XtAppContext(arg1),
(XtLanguageProc)gxm_XtLanguageProc,
(XtPointer)arg3);
}
return(previous_proc);
}
-static XEN gxm_XtToolkitInitialize(void)
+static Xen gxm_XtToolkitInitialize(void)
{
#define H_XtToolkitInitialize "void XtToolkitInitialize()"
XtToolkitInitialize();
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtVaAppCreateShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtVaAppCreateShell(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtVaAppCreateShell "Widget XtVaAppCreateShell(application_name, application_class, widget_class, display, ...)"
Arg *args;
Widget w;
int arglen;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtVaAppCreateShell", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtVaAppCreateShell", "char*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg3), arg3, 3, "XtVaAppCreateShell", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_Display_P(arg4), arg4, 4, "XtVaAppCreateShell", "Display*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg5), arg5, 5, "XtVaAppCreateShell", "List");
- args = XEN_TO_C_Args(arg5);
- arglen = XEN_LIST_LENGTH(arg5) / 2;
- w = XtAppCreateShell((char *)XEN_TO_C_STRING(arg1),
- (char *)XEN_TO_C_STRING(arg2),
- XEN_TO_C_WidgetClass(arg3),
- XEN_TO_C_Display(arg4),
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtVaAppCreateShell", "char*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtVaAppCreateShell", "char*");
+ Xen_check_type(Xen_is_WidgetClass(arg3), arg3, 3, "XtVaAppCreateShell", "WidgetClass");
+ Xen_check_type(Xen_is_Display(arg4), arg4, 4, "XtVaAppCreateShell", "Display*");
+ Xen_check_type(Xen_is_list(arg5), arg5, 5, "XtVaAppCreateShell", "List");
+ args = Xen_to_C_Args(arg5);
+ arglen = Xen_list_length(arg5) / 2;
+ w = XtAppCreateShell((char *)Xen_string_to_C_string(arg1),
+ (char *)Xen_string_to_C_string(arg2),
+ Xen_to_C_WidgetClass(arg3),
+ Xen_to_C_Display(arg4),
args,
arglen);
if (args)
@@ -14924,28 +14686,28 @@ static XEN gxm_XtVaAppCreateShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN ar
fixup_args(w, args, arglen);
free_args(args, arglen);
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XtAppCreateShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XtAppCreateShell(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XtAppCreateShell "Widget XtAppCreateShell(application_name, application_class, widget_class, display, args, num_args) saves \
the specified application name and application class for qualifying all widget resource specifiers."
Arg *args;
Widget w;
int arglen;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtAppCreateShell", "char*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtAppCreateShell", "char*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg3), arg3, 3, "XtAppCreateShell", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_Display_P(arg4), arg4, 4, "XtAppCreateShell", "Display*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg5), arg5, 5, "XtAppCreateShell", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg6), arg6, 6, "XtAppCreateShell", "int");
- args = XEN_TO_C_Args(arg5);
- arglen = XEN_TO_C_INT_DEF(arg6, arg5);
- w = XtAppCreateShell((char *)XEN_TO_C_STRING(arg1),
- (char *)XEN_TO_C_STRING(arg2),
- XEN_TO_C_WidgetClass(arg3),
- XEN_TO_C_Display(arg4),
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtAppCreateShell", "char*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtAppCreateShell", "char*");
+ Xen_check_type(Xen_is_WidgetClass(arg3), arg3, 3, "XtAppCreateShell", "WidgetClass");
+ Xen_check_type(Xen_is_Display(arg4), arg4, 4, "XtAppCreateShell", "Display*");
+ Xen_check_type(Xen_is_list(arg5), arg5, 5, "XtAppCreateShell", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg6), arg6, 6, "XtAppCreateShell", "int");
+ args = Xen_to_C_Args(arg5);
+ arglen = Xen_to_C_INT_DEF(arg6, arg5);
+ w = XtAppCreateShell((char *)Xen_string_to_C_string(arg1),
+ (char *)Xen_string_to_C_string(arg2),
+ Xen_to_C_WidgetClass(arg3),
+ Xen_to_C_Display(arg4),
args,
arglen);
if (args)
@@ -14953,24 +14715,24 @@ the specified application name and application class for qualifying all widget r
fixup_args(w, args, arglen);
free_args(args, arglen);
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XtVaCreateManagedWidget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XtVaCreateManagedWidget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XtVaCreateManagedWidget "Widget XtVaCreateManagedWidget(name, widget_class, parent, ...)"
Arg *args;
Widget w;
int arglen;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtVaCreateManagedWidget", "char*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg2), arg2, 2, "XtVaCreateManagedWidget", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg3), arg3, 3, "XtVaCreateManagedWidget", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XtVaCreateManagedWidget", "List");
- args = XEN_TO_C_Args(arg4);
- arglen = XEN_LIST_LENGTH(arg4) / 2;
- w = XtCreateManagedWidget((char *)XEN_TO_C_STRING(arg1),
- XEN_TO_C_WidgetClass(arg2),
- XEN_TO_C_Widget(arg3),
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtVaCreateManagedWidget", "char*");
+ Xen_check_type(Xen_is_WidgetClass(arg2), arg2, 2, "XtVaCreateManagedWidget", "WidgetClass");
+ Xen_check_type(Xen_is_Widget(arg3), arg3, 3, "XtVaCreateManagedWidget", "Widget");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XtVaCreateManagedWidget", "List");
+ args = Xen_to_C_Args(arg4);
+ arglen = Xen_list_length(arg4) / 2;
+ w = XtCreateManagedWidget((char *)Xen_string_to_C_string(arg1),
+ Xen_to_C_WidgetClass(arg2),
+ Xen_to_C_Widget(arg3),
args,
arglen);
if (args)
@@ -14978,24 +14740,24 @@ static XEN gxm_XtVaCreateManagedWidget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
fixup_args(w, args, arglen);
free_args(args, arglen);
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XtVaCreateWidget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XtVaCreateWidget(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XtVaCreateWidget "Widget XtVaCreateWidget(name, widget_class, parent, ...)"
Arg *args;
int arglen;
Widget w;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtVaCreateWidget", "char*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg2), arg2, 2, "XtVaCreateWidget", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg3), arg3, 3, "XtVaCreateWidget", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XtVaCreateWidget", "List");
- args = XEN_TO_C_Args(arg4);
- arglen = XEN_LIST_LENGTH(arg4) / 2;
- w = XtCreateWidget((char *)XEN_TO_C_STRING(arg1),
- XEN_TO_C_WidgetClass(arg2),
- XEN_TO_C_Widget(arg3),
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtVaCreateWidget", "char*");
+ Xen_check_type(Xen_is_WidgetClass(arg2), arg2, 2, "XtVaCreateWidget", "WidgetClass");
+ Xen_check_type(Xen_is_Widget(arg3), arg3, 3, "XtVaCreateWidget", "Widget");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XtVaCreateWidget", "List");
+ args = Xen_to_C_Args(arg4);
+ arglen = Xen_list_length(arg4) / 2;
+ w = XtCreateWidget((char *)Xen_string_to_C_string(arg1),
+ Xen_to_C_WidgetClass(arg2),
+ Xen_to_C_Widget(arg3),
args,
arglen);
if (args)
@@ -15003,133 +14765,133 @@ static XEN gxm_XtVaCreateWidget(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
fixup_args(w, args, arglen);
free_args(args, arglen);
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XtCreateManagedWidget(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtCreateManagedWidget(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtCreateManagedWidget "Widget XtCreateManagedWidget(name, widget_class, parent, args, num_args) is a routine \
that calls XtCreateWidget and XtManageChild."
Arg *args;
Widget w;
int arglen;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtCreateManagedWidget", "char*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg2), arg2, 2, "XtCreateManagedWidget", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg3), arg3, 3, "XtCreateManagedWidget", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XtCreateManagedWidget", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg5), arg5, 5, "XtCreateManagedWidget", "int");
- args = XEN_TO_C_Args(arg4);
- arglen = XEN_TO_C_INT_DEF(arg5, arg4);
- w = XtCreateManagedWidget((char *)XEN_TO_C_STRING(arg1),
- XEN_TO_C_WidgetClass(arg2),
- XEN_TO_C_Widget(arg3),
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtCreateManagedWidget", "char*");
+ Xen_check_type(Xen_is_WidgetClass(arg2), arg2, 2, "XtCreateManagedWidget", "WidgetClass");
+ Xen_check_type(Xen_is_Widget(arg3), arg3, 3, "XtCreateManagedWidget", "Widget");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XtCreateManagedWidget", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg5), arg5, 5, "XtCreateManagedWidget", "int");
+ args = Xen_to_C_Args(arg4);
+ arglen = Xen_to_C_INT_DEF(arg5, arg4);
+ w = XtCreateManagedWidget((char *)Xen_string_to_C_string(arg1),
+ Xen_to_C_WidgetClass(arg2),
+ Xen_to_C_Widget(arg3),
args, arglen);
if (args)
{
fixup_args(w, args, arglen);
free_args(args, arglen);
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XtCreateWidget(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtCreateWidget(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtCreateWidget "Widget XtCreateWidget(name, widget_class, parent, args, num_args) performs much of the boilerplate operations of widget creation."
Arg *args;
Widget w;
int arglen;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtCreateWidget", "char*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg2), arg2, 2, "XtCreateWidget", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg3), arg3, 3, "XtCreateWidget", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XtCreateWidget", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg5), arg5, 5, "XtCreateWidget", "int");
- args = XEN_TO_C_Args(arg4);
- arglen = XEN_TO_C_INT_DEF(arg5, arg4);
- w = XtCreateWidget((char *)XEN_TO_C_STRING(arg1),
- XEN_TO_C_WidgetClass(arg2),
- XEN_TO_C_Widget(arg3),
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtCreateWidget", "char*");
+ Xen_check_type(Xen_is_WidgetClass(arg2), arg2, 2, "XtCreateWidget", "WidgetClass");
+ Xen_check_type(Xen_is_Widget(arg3), arg3, 3, "XtCreateWidget", "Widget");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XtCreateWidget", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg5), arg5, 5, "XtCreateWidget", "int");
+ args = Xen_to_C_Args(arg4);
+ arglen = Xen_to_C_INT_DEF(arg5, arg4);
+ w = XtCreateWidget((char *)Xen_string_to_C_string(arg1),
+ Xen_to_C_WidgetClass(arg2),
+ Xen_to_C_Widget(arg3),
args, arglen);
if (args)
{
fixup_args(w, args, arglen);
free_args(args, arglen);
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XtCallbackPopdown(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtCallbackPopdown(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtCallbackPopdown "void XtCallbackPopdown(w, client_data, call_data) calls XtPopdown with the specified shell_widget and then \
calls XtSetSensitive to resensitize the enable_widget."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCallbackPopdown", "Widget");
- XtCallbackPopdown(XEN_TO_C_Widget(arg1), (XtPointer)arg2, (XtPointer)arg3);
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCallbackPopdown", "Widget");
+ XtCallbackPopdown(Xen_to_C_Widget(arg1), (XtPointer)arg2, (XtPointer)arg3);
+ return(Xen_false);
}
-static XEN gxm_XtPopdown(XEN arg1)
+static Xen gxm_XtPopdown(Xen arg1)
{
#define H_XtPopdown "void XtPopdown(popup_shell)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtPopdown", "Widget");
- XtPopdown(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtPopdown", "Widget");
+ XtPopdown(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtCallbackExclusive(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtCallbackExclusive(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtCallbackExclusive "void XtCallbackExclusive(w, client_data, call_data)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCallbackExclusive", "Widget");
- XtCallbackExclusive(XEN_TO_C_Widget(arg1), (XtPointer)arg2, (XtPointer)arg3);
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCallbackExclusive", "Widget");
+ XtCallbackExclusive(Xen_to_C_Widget(arg1), (XtPointer)arg2, (XtPointer)arg3);
+ return(Xen_false);
}
-static XEN gxm_XtCallbackNonexclusive(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtCallbackNonexclusive(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtCallbackNonexclusive "void XtCallbackNonexclusive(w, client_data, call_data)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCallbackNonexclusive", "Widget");
- XtCallbackNonexclusive(XEN_TO_C_Widget(arg1), (XtPointer)arg2, (XtPointer)arg3);
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCallbackNonexclusive", "Widget");
+ XtCallbackNonexclusive(Xen_to_C_Widget(arg1), (XtPointer)arg2, (XtPointer)arg3);
+ return(Xen_false);
}
-static XEN gxm_XtCallbackNone(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtCallbackNone(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtCallbackNone "void XtCallbackNone(w, client_data, call_data)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCallbackNone", "Widget");
- XtCallbackNone(XEN_TO_C_Widget(arg1), (XtPointer)arg2, (XtPointer)arg3);
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCallbackNone", "Widget");
+ XtCallbackNone(Xen_to_C_Widget(arg1), (XtPointer)arg2, (XtPointer)arg3);
+ return(Xen_false);
}
-static XEN gxm_XtPopupSpringLoaded(XEN arg1)
+static Xen gxm_XtPopupSpringLoaded(Xen arg1)
{
#define H_XtPopupSpringLoaded "void XtPopupSpringLoaded(popup_shell)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtPopupSpringLoaded", "Widget");
- XtPopupSpringLoaded(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtPopupSpringLoaded", "Widget");
+ XtPopupSpringLoaded(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtPopup(XEN arg1, XEN arg2)
+static Xen gxm_XtPopup(Xen arg1, Xen arg2)
{
#define H_XtPopup "void XtPopup(popup_shell, grab_kind)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtPopup", "Widget");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XtPopup", "XtGrabKind");
- XtPopup(XEN_TO_C_Widget(arg1), (XtGrabKind)XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtPopup", "Widget");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XtPopup", "XtGrabKind");
+ XtPopup(Xen_to_C_Widget(arg1), (XtGrabKind)Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtVaCreatePopupShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XtVaCreatePopupShell(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XtVaCreatePopupShell "Widget XtVaCreatePopupShell(name, widget_class, parent, ...)"
Arg *args;
int arglen;
Widget w;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtVaCreatePopupShell", "char*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg2), arg2, 2, "XtVaCreatePopupShell", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg3), arg3, 3, "XtVaCreatePopupShell", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XtVaCreatePopupShell", "List");
- args = XEN_TO_C_Args(arg4);
- arglen = XEN_LIST_LENGTH(arg4) / 2;
- w = XtCreatePopupShell((char *)XEN_TO_C_STRING(arg1),
- XEN_TO_C_WidgetClass(arg2),
- XEN_TO_C_Widget(arg3),
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtVaCreatePopupShell", "char*");
+ Xen_check_type(Xen_is_WidgetClass(arg2), arg2, 2, "XtVaCreatePopupShell", "WidgetClass");
+ Xen_check_type(Xen_is_Widget(arg3), arg3, 3, "XtVaCreatePopupShell", "Widget");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XtVaCreatePopupShell", "List");
+ args = Xen_to_C_Args(arg4);
+ arglen = Xen_list_length(arg4) / 2;
+ w = XtCreatePopupShell((char *)Xen_string_to_C_string(arg1),
+ Xen_to_C_WidgetClass(arg2),
+ Xen_to_C_Widget(arg3),
args,
arglen);
if (args)
@@ -15137,28 +14899,28 @@ static XEN gxm_XtVaCreatePopupShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
fixup_args(w, args, arglen);
free_args(args, arglen);
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XtCreatePopupShell(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtCreatePopupShell(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtCreatePopupShell "Widget XtCreatePopupShell(name, widget_class, parent, args, num_args) ensures that the specified \
class is a subclass of Shell and, rather than using insert_child to attach the widget to the parent's children list, attaches the shell \
to the parent's pop-ups list directly."
Widget w;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtCreatePopupShell", "char*");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg2), arg2, 2, "XtCreatePopupShell", "WidgetClass");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg3), arg3, 3, "XtCreatePopupShell", "Widget");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4), arg4, 4, "XtCreatePopupShell", "ArgList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg5), arg5, 5, "XtCreatePopupShell", "int");
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtCreatePopupShell", "char*");
+ Xen_check_type(Xen_is_WidgetClass(arg2), arg2, 2, "XtCreatePopupShell", "WidgetClass");
+ Xen_check_type(Xen_is_Widget(arg3), arg3, 3, "XtCreatePopupShell", "Widget");
+ Xen_check_type(Xen_is_list(arg4), arg4, 4, "XtCreatePopupShell", "ArgList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg5), arg5, 5, "XtCreatePopupShell", "int");
{
Arg *args;
int arglen;
- args = XEN_TO_C_Args(arg4);
- arglen = XEN_TO_C_INT_DEF(arg5, arg4);
- w = XtCreatePopupShell((char *)XEN_TO_C_STRING(arg1),
- XEN_TO_C_WidgetClass(arg2),
- XEN_TO_C_Widget(arg3),
+ args = Xen_to_C_Args(arg4);
+ arglen = Xen_to_C_INT_DEF(arg5, arg4);
+ w = XtCreatePopupShell((char *)Xen_string_to_C_string(arg1),
+ Xen_to_C_WidgetClass(arg2),
+ Xen_to_C_Widget(arg3),
args, arglen);
if (args)
{
@@ -15166,67 +14928,67 @@ to the parent's pop-ups list directly."
free_args(args, arglen);
}
}
- return(C_TO_XEN_Widget(w));
+ return(C_to_Xen_Widget(w));
}
-static XEN gxm_XtHasCallbacks(XEN arg1, XEN arg2)
+static Xen gxm_XtHasCallbacks(Xen arg1, Xen arg2)
{
#define H_XtHasCallbacks "XtCallbackStatus XtHasCallbacks(w, callback_name) first checks to see if the widget has a callback \
list identified by callback_name; returns XtCallbackNoList or XtCallbackHasNone if none, else XtCallbackHasSome"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtHasCallbacks", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtHasCallbacks", "char*");
- return(C_TO_XEN_INT(XtHasCallbacks(XEN_TO_C_Widget(arg1), (char *)XEN_TO_C_STRING(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtHasCallbacks", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtHasCallbacks", "char*");
+ return(C_int_to_Xen_integer(XtHasCallbacks(Xen_to_C_Widget(arg1), (char *)Xen_string_to_C_string(arg2))));
}
-static XEN gxm_XtCallCallbacks(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtCallCallbacks(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtCallCallbacks "void XtCallCallbacks(w, callback_name, call_data) calls each procedure that is registered in the \
specified widget's callback list. The call_data arg is assumed to be a callback struct reference"
XtPointer val = NULL;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCallCallbacks", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtCallCallbacks", "char*");
- if (XEN_LIST_P(arg3)) val = (XtPointer)XEN_UNWRAP_C_POINTER(XEN_CADR(arg3));
- XtCallCallbacks(XEN_TO_C_Widget(arg1), (char *)XEN_TO_C_STRING(arg2), val);
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCallCallbacks", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtCallCallbacks", "char*");
+ if (Xen_is_list(arg3)) val = (XtPointer)Xen_unwrap_C_pointer(Xen_cadr(arg3));
+ XtCallCallbacks(Xen_to_C_Widget(arg1), (char *)Xen_string_to_C_string(arg2), val);
+ return(Xen_false);
}
-static XEN gxm_XtRemoveAllCallbacks(XEN arg1, XEN arg2)
+static Xen gxm_XtRemoveAllCallbacks(Xen arg1, Xen arg2)
{
#define H_XtRemoveAllCallbacks "void XtRemoveAllCallbacks(w, callback_name) removes all the callback procedures from the specified widget's callback list."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtRemoveAllCallbacks", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtRemoveAllCallbacks", "char*");
- XtRemoveAllCallbacks(XEN_TO_C_Widget(arg1), (char *)XEN_TO_C_STRING(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtRemoveAllCallbacks", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtRemoveAllCallbacks", "char*");
+ XtRemoveAllCallbacks(Xen_to_C_Widget(arg1), (char *)Xen_string_to_C_string(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtRemoveCallback(XEN arg1, XEN arg2, XEN arg4)
+static Xen gxm_XtRemoveCallback(Xen arg1, Xen arg2, Xen arg4)
{
#define H_XtRemoveCallback "void XtRemoveCallback(w, callback_name, client_data) removes a callback"
/* DIFF: XtRemoveCallback omits proc arg and is passed whatever XtAddCallback returned
*/
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtRemoveCallback", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtRemoveCallback", "char*");
- xm_unprotect_at(XEN_TO_C_INT(XEN_LIST_REF(arg4, CALLBACK_GC_LOC)));
- XtRemoveCallback(XEN_TO_C_Widget(arg1), (char *)XEN_TO_C_STRING(arg2), gxm_XtCallbackProc, (XtPointer)arg4);
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtRemoveCallback", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtRemoveCallback", "char*");
+ xm_unprotect_at(Xen_integer_to_C_int(Xen_list_ref(arg4, CALLBACK_GC_LOC)));
+ XtRemoveCallback(Xen_to_C_Widget(arg1), (char *)Xen_string_to_C_string(arg2), gxm_XtCallbackProc, (XtPointer)arg4);
+ return(Xen_false);
}
-static XEN gxm_XtRemoveCallbacks(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtRemoveCallbacks(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtRemoveCallbacks "void XtRemoveCallbacks(w, callback_name, callbacks) removes the specified callback procedures from the \
specified widget's callback list. (The 3rd arg is a list of descriptors returned by XtAddCallback)."
/* DIFF: XtRemoveCallbacks takes list of descriptors as arg3
*/
- XEN lst;
+ Xen lst;
int i, len;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtRemoveCallbacks", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtRemoveCallbacks", "char*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XtRemoveCallbacks", "list of XtCallbacks");
- lst = XEN_COPY_ARG(arg3);
- len = XEN_LIST_LENGTH(lst);
- for (i = 0; i < len; i++, lst = XEN_CDR(lst))
- gxm_XtRemoveCallback(arg1, arg2, XEN_CAR(lst));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtRemoveCallbacks", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtRemoveCallbacks", "char*");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XtRemoveCallbacks", "list of XtCallbacks");
+ lst = Xen_copy_arg(arg3);
+ len = Xen_list_length(lst);
+ for (i = 0; i < len; i++, lst = Xen_cdr(lst))
+ gxm_XtRemoveCallback(arg1, arg2, Xen_car(lst));
+ return(Xen_false);
}
/* need these for all callback proc types, and locations to store the list of them */
@@ -15237,57 +14999,51 @@ enum {
GXM_Drawing, GXM_Drawn, GXM_Drop_Finish, GXM_Drop_Proc, GXM_DropSite_Enter, GXM_DropSite_Leave, GXM_Drop_Start,
GXM_File, GXM_List, GXM_Notebook, GXM_Operation, GXM_Popup, GXM_PushButton, GXM_RowColumn, GXM_Scale,
GXM_ScrollBar, GXM_Selection, GXM_SpinBox, GXM_ToggleButton, GXM_TopLevel_Enter, GXM_TopLevel_Leave,
- GXM_Traverse, GXM_Verify, GXM_DataField, GXM_TabStack
+ GXM_Traverse, GXM_Verify
};
-static XEN wrap_callback_struct(int type, XtPointer info)
+static Xen wrap_callback_struct(int type, XtPointer info)
{
switch (type)
{
- case GXM_Any: return(C_TO_XEN_XmAnyCallbackStruct((XmAnyCallbackStruct *)info));
- case GXM_Arrow: return(C_TO_XEN_XmArrowButtonCallbackStruct((XmArrowButtonCallbackStruct *)info));
- case GXM_Command: return(C_TO_XEN_XmCommandCallbackStruct((XmCommandCallbackStruct *)info));
- case GXM_Drag_Drop: return(C_TO_XEN_XmDragDropFinishCallbackStruct((XmDragDropFinishCallbackStruct *)info));
- case GXM_Drag_Motion: return(C_TO_XEN_XmDragMotionCallbackStruct((XmDragMotionCallbackStruct *)info));
- case GXM_Drag_Proc: return(C_TO_XEN_XmDragProcCallbackStruct((XmDragProcCallbackStruct *)info));
- case GXM_Drawing: return(C_TO_XEN_XmDrawingAreaCallbackStruct((XmDrawingAreaCallbackStruct *)info));
- case GXM_Drawn: return(C_TO_XEN_XmDrawnButtonCallbackStruct((XmDrawnButtonCallbackStruct *)info));
- case GXM_Drop_Finish: return(C_TO_XEN_XmDropFinishCallbackStruct((XmDropFinishCallbackStruct *)info));
- case GXM_Drop_Proc: return(C_TO_XEN_XmDropProcCallbackStruct((XmDropProcCallbackStruct *)info));
- case GXM_DropSite_Enter: return(C_TO_XEN_XmDropSiteEnterCallbackStruct((XmDropSiteEnterCallbackStruct *)info));
- case GXM_DropSite_Leave: return(C_TO_XEN_XmDropSiteLeaveCallbackStruct((XmDropSiteLeaveCallbackStruct *)info));
- case GXM_Drop_Start: return(C_TO_XEN_XmDropStartCallbackStruct((XmDropStartCallbackStruct *)info));
- case GXM_File: return(C_TO_XEN_XmFileSelectionBoxCallbackStruct((XmFileSelectionBoxCallbackStruct *)info));
- case GXM_List: return(C_TO_XEN_XmListCallbackStruct((XmListCallbackStruct *)info));
- case GXM_PushButton: return(C_TO_XEN_XmPushButtonCallbackStruct((XmPushButtonCallbackStruct *)info));
- case GXM_RowColumn: return(C_TO_XEN_XmRowColumnCallbackStruct((XmRowColumnCallbackStruct *)info));
- case GXM_Scale: return(C_TO_XEN_XmScaleCallbackStruct((XmScaleCallbackStruct *)info));
- case GXM_ScrollBar: return(C_TO_XEN_XmScrollBarCallbackStruct((XmScrollBarCallbackStruct *)info));
- case GXM_Selection: return(C_TO_XEN_XmSelectionBoxCallbackStruct((XmSelectionBoxCallbackStruct *)info));
- case GXM_ToggleButton: return(C_TO_XEN_XmToggleButtonCallbackStruct((XmToggleButtonCallbackStruct *)info));
- case GXM_Verify: return(C_TO_XEN_XmTextVerifyCallbackStruct((XmTextVerifyCallbackStruct *)info));
- case GXM_Popup: return(C_TO_XEN_XmPopupHandlerCallbackStruct((XmPopupHandlerCallbackStruct *)info));
- case GXM_Drag_Start: return(C_TO_XEN_XmDragStartCallbackStruct((XmDragStartCallbackStruct *)info));
- case GXM_Convert: return(C_TO_XEN_XmConvertCallbackStruct((XmConvertCallbackStruct *)info));
- case GXM_Container_Outline: return(C_TO_XEN_XmContainerOutlineCallbackStruct((XmContainerOutlineCallbackStruct *)info));
- case GXM_Container_Select: return(C_TO_XEN_XmContainerSelectCallbackStruct((XmContainerSelectCallbackStruct *)info));
- case GXM_Destination: return(C_TO_XEN_XmDestinationCallbackStruct((XmDestinationCallbackStruct *)info));
- case GXM_Display: return(C_TO_XEN_XmDisplayCallbackStruct((XmDisplayCallbackStruct *)info));
- case GXM_Combo: return(C_TO_XEN_XmComboBoxCallbackStruct((XmComboBoxCallbackStruct *)info));
- case GXM_Notebook: return(C_TO_XEN_XmNotebookCallbackStruct((XmNotebookCallbackStruct *)info));
- case GXM_Operation: return(C_TO_XEN_XmOperationChangedCallbackStruct((XmOperationChangedCallbackStruct *)info));
- case GXM_SpinBox: return(C_TO_XEN_XmSpinBoxCallbackStruct((XmSpinBoxCallbackStruct *)info));
- case GXM_TopLevel_Enter: return(C_TO_XEN_XmTopLevelEnterCallbackStruct((XmTopLevelEnterCallbackStruct *)info));
- case GXM_TopLevel_Leave: return(C_TO_XEN_XmTopLevelLeaveCallbackStruct((XmTopLevelLeaveCallbackStruct *)info));
- case GXM_Traverse: return(C_TO_XEN_XmTraverseObscuredCallbackStruct((XmTraverseObscuredCallbackStruct *)info));
-#if HAVE_XmCreateDataField
- case GXM_DataField: return(C_TO_XEN_XmDataFieldCallbackStruct((XmDataFieldCallbackStruct *)info));
-#endif
-#if HAVE_XmCreateTabStack
- case GXM_TabStack: return(C_TO_XEN_XmTabStackCallbackStruct((XmTabStackCallbackStruct *)info));
-#endif
+ case GXM_Any: return(C_to_Xen_XmAnyCallbackStruct((XmAnyCallbackStruct *)info));
+ case GXM_Arrow: return(C_to_Xen_XmArrowButtonCallbackStruct((XmArrowButtonCallbackStruct *)info));
+ case GXM_Command: return(C_to_Xen_XmCommandCallbackStruct((XmCommandCallbackStruct *)info));
+ case GXM_Drag_Drop: return(C_to_Xen_XmDragDropFinishCallbackStruct((XmDragDropFinishCallbackStruct *)info));
+ case GXM_Drag_Motion: return(C_to_Xen_XmDragMotionCallbackStruct((XmDragMotionCallbackStruct *)info));
+ case GXM_Drag_Proc: return(C_to_Xen_XmDragProcCallbackStruct((XmDragProcCallbackStruct *)info));
+ case GXM_Drawing: return(C_to_Xen_XmDrawingAreaCallbackStruct((XmDrawingAreaCallbackStruct *)info));
+ case GXM_Drawn: return(C_to_Xen_XmDrawnButtonCallbackStruct((XmDrawnButtonCallbackStruct *)info));
+ case GXM_Drop_Finish: return(C_to_Xen_XmDropFinishCallbackStruct((XmDropFinishCallbackStruct *)info));
+ case GXM_Drop_Proc: return(C_to_Xen_XmDropProcCallbackStruct((XmDropProcCallbackStruct *)info));
+ case GXM_DropSite_Enter: return(C_to_Xen_XmDropSiteEnterCallbackStruct((XmDropSiteEnterCallbackStruct *)info));
+ case GXM_DropSite_Leave: return(C_to_Xen_XmDropSiteLeaveCallbackStruct((XmDropSiteLeaveCallbackStruct *)info));
+ case GXM_Drop_Start: return(C_to_Xen_XmDropStartCallbackStruct((XmDropStartCallbackStruct *)info));
+ case GXM_File: return(C_to_Xen_XmFileSelectionBoxCallbackStruct((XmFileSelectionBoxCallbackStruct *)info));
+ case GXM_List: return(C_to_Xen_XmListCallbackStruct((XmListCallbackStruct *)info));
+ case GXM_PushButton: return(C_to_Xen_XmPushButtonCallbackStruct((XmPushButtonCallbackStruct *)info));
+ case GXM_RowColumn: return(C_to_Xen_XmRowColumnCallbackStruct((XmRowColumnCallbackStruct *)info));
+ case GXM_Scale: return(C_to_Xen_XmScaleCallbackStruct((XmScaleCallbackStruct *)info));
+ case GXM_ScrollBar: return(C_to_Xen_XmScrollBarCallbackStruct((XmScrollBarCallbackStruct *)info));
+ case GXM_Selection: return(C_to_Xen_XmSelectionBoxCallbackStruct((XmSelectionBoxCallbackStruct *)info));
+ case GXM_ToggleButton: return(C_to_Xen_XmToggleButtonCallbackStruct((XmToggleButtonCallbackStruct *)info));
+ case GXM_Verify: return(C_to_Xen_XmTextVerifyCallbackStruct((XmTextVerifyCallbackStruct *)info));
+ case GXM_Popup: return(C_to_Xen_XmPopupHandlerCallbackStruct((XmPopupHandlerCallbackStruct *)info));
+ case GXM_Drag_Start: return(C_to_Xen_XmDragStartCallbackStruct((XmDragStartCallbackStruct *)info));
+ case GXM_Convert: return(C_to_Xen_XmConvertCallbackStruct((XmConvertCallbackStruct *)info));
+ case GXM_Container_Outline: return(C_to_Xen_XmContainerOutlineCallbackStruct((XmContainerOutlineCallbackStruct *)info));
+ case GXM_Container_Select: return(C_to_Xen_XmContainerSelectCallbackStruct((XmContainerSelectCallbackStruct *)info));
+ case GXM_Destination: return(C_to_Xen_XmDestinationCallbackStruct((XmDestinationCallbackStruct *)info));
+ case GXM_Display: return(C_to_Xen_XmDisplayCallbackStruct((XmDisplayCallbackStruct *)info));
+ case GXM_Combo: return(C_to_Xen_XmComboBoxCallbackStruct((XmComboBoxCallbackStruct *)info));
+ case GXM_Notebook: return(C_to_Xen_XmNotebookCallbackStruct((XmNotebookCallbackStruct *)info));
+ case GXM_Operation: return(C_to_Xen_XmOperationChangedCallbackStruct((XmOperationChangedCallbackStruct *)info));
+ case GXM_SpinBox: return(C_to_Xen_XmSpinBoxCallbackStruct((XmSpinBoxCallbackStruct *)info));
+ case GXM_TopLevel_Enter: return(C_to_Xen_XmTopLevelEnterCallbackStruct((XmTopLevelEnterCallbackStruct *)info));
+ case GXM_TopLevel_Leave: return(C_to_Xen_XmTopLevelLeaveCallbackStruct((XmTopLevelLeaveCallbackStruct *)info));
+ case GXM_Traverse: return(C_to_Xen_XmTraverseObscuredCallbackStruct((XmTraverseObscuredCallbackStruct *)info));
}
- return(XEN_FALSE);
+ return(Xen_false);
}
static int callback_struct_type(Widget w, const char *name)
@@ -15344,202 +15100,199 @@ static int callback_struct_type(Widget w, const char *name)
if (strcmp(name, XmNtopLevelLeaveCallback) == 0) return(GXM_TopLevel_Leave);
}
if (XmIsDrawnButton(w)) return(GXM_Drawn);
-#if HAVE_XmCreateDataField
- if (XmIsDataField(w)) return(GXM_DataField);
-#endif
return(GXM_Any);
}
-static XEN gxm_XtAddCallback(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XtAddCallback(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XtAddCallback "void XtAddCallback(w, callback_name, callback, client_data) adds the specified callback procedure to \
-the specified widget's callback list. In xm, the client-data is optional, defaulting to #f. The callback procedure takes \
+the specified widget's callback list. In xm, the client-data is optional, defaulting to " PROC_FALSE ". The callback procedure takes \
3 args: widget client-data callback-info. Returns a description of the callback suitable for use with XtRemoveCallback."
/* DIFF: XtAddCallback returns the C-side "client-data" (for subsequent XtRemoveCallback)
*/
char *name;
Widget w;
int gc_loc;
- XEN call_descr = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtAddCallback", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtAddCallback", "char*");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg3) && (XEN_REQUIRED_ARGS_OK(arg3, 3)), arg3, 3, "XtAddCallback", "(XtCallbackProc widget data callb)");
- w = XEN_TO_C_Widget(arg1);
- name = (char *)XEN_TO_C_STRING(arg2);
- call_descr = C_TO_XEN_XM_XtCallback(arg3, (XEN_BOUND_P(arg4)) ? arg4 : XEN_FALSE);
+ Xen call_descr = Xen_empty_list;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtAddCallback", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtAddCallback", "char*");
+ Xen_check_type(Xen_is_procedure(arg3) && (Xen_is_aritable(arg3, 3)), arg3, 3, "XtAddCallback", "(XtCallbackProc widget data callb)");
+ w = Xen_to_C_Widget(arg1);
+ name = (char *)Xen_string_to_C_string(arg2);
+ call_descr = C_to_Xen_XM_XtCallback(arg3, (Xen_is_bound(arg4)) ? arg4 : Xen_false);
gc_loc = xm_protect(call_descr);
- XEN_LIST_SET(call_descr, CALLBACK_GC_LOC, C_TO_XEN_INT(gc_loc));
- XEN_LIST_SET(call_descr, CALLBACK_STRUCT_TYPE, C_TO_XEN_INT(callback_struct_type(w, name)));
+ Xen_list_set(call_descr, CALLBACK_GC_LOC, C_int_to_Xen_integer(gc_loc));
+ Xen_list_set(call_descr, CALLBACK_STRUCT_TYPE, C_int_to_Xen_integer(callback_struct_type(w, name)));
XtAddCallback(w, name, gxm_XtCallbackProc, (XtPointer)call_descr);
return(call_descr);
}
-static XEN gxm_XtAddCallbacks(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtAddCallbacks(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtAddCallbacks "void XtAddCallbacks(w, callback_name, callbacks) add the specified list of callbacks to the specified widget's callback list. \
It returns a list of callback descriptors for use with XtRemoveCallback(s)."
/* DIFF: XtAddCallbacks takes list of (func data) pairs as arg3
*/
- XEN res = XEN_EMPTY_LIST, lst;
+ Xen res = Xen_empty_list, lst;
int i, len;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtAddCallbacks", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtAddCallbacks", "char*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XtAddCallbacks", "list of XtCallbacks");
- len = XEN_LIST_LENGTH(arg3);
- lst = XEN_COPY_ARG(arg3);
- for (i = len - 1; i >= 0; i--, lst = XEN_CDR(lst))
- res = XEN_CONS(gxm_XtAddCallback(arg1, arg2, XEN_CAR(XEN_CAR(lst)), XEN_CADR(XEN_CAR(lst))),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtAddCallbacks", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtAddCallbacks", "char*");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XtAddCallbacks", "list of XtCallbacks");
+ len = Xen_list_length(arg3);
+ lst = Xen_copy_arg(arg3);
+ for (i = len - 1; i >= 0; i--, lst = Xen_cdr(lst))
+ res = Xen_cons(gxm_XtAddCallback(arg1, arg2, Xen_car(Xen_car(lst)), Xen_cadr(Xen_car(lst))),
res);
return(res);
}
-static XEN gxm_XtParent(XEN arg1)
+static Xen gxm_XtParent(Xen arg1)
{
#define H_XtParent "Widget XtParent(w): returns the widget's parent widget ID."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtParent", "Widget");
- return(C_TO_XEN_Widget(XtParent(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtParent", "Widget");
+ return(C_to_Xen_Widget(XtParent(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtClass(XEN arg1)
+static Xen gxm_XtClass(Xen arg1)
{
#define H_XtClass "WidgetClass XtClass(w)"
#define H_XtSuperclass "WidgetClass XtSuperclass(w): returns a pointer to the widget's superclass class structure."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtClass", "Widget");
- return(C_TO_XEN_WidgetClass(XtClass(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtClass", "Widget");
+ return(C_to_Xen_WidgetClass(XtClass(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtSuperclass(XEN arg1)
+static Xen gxm_XtSuperclass(Xen arg1)
{
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtSuperclass", "Widget");
- return(C_TO_XEN_WidgetClass(XtSuperclass(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtSuperclass", "Widget");
+ return(C_to_Xen_WidgetClass(XtSuperclass(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtName(XEN arg1)
+static Xen gxm_XtName(Xen arg1)
{
#define H_XtName "Widget XtName(w): returns the widget's name."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtName", "Widget");
- return(C_TO_XEN_STRING(XtName(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtName", "Widget");
+ return(C_string_to_Xen_string(XtName(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtWindowOfObject(XEN arg1)
+static Xen gxm_XtWindowOfObject(Xen arg1)
{
#define H_XtWindowOfObject "Window XtWindowOfObject(object): returns the window of the specified object."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtWindowOfObject", "Widget");
- return(C_TO_XEN_Window(XtWindowOfObject(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtWindowOfObject", "Widget");
+ return(C_to_Xen_Window(XtWindowOfObject(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtWindow(XEN arg1)
+static Xen gxm_XtWindow(Xen arg1)
{
#define H_XtWindow "Window XtWindow(w): returns the window of the specified widget."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtWindow", "Widget");
- return(C_TO_XEN_Window(XtWindow(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtWindow", "Widget");
+ return(C_to_Xen_Window(XtWindow(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtScreenOfObject(XEN arg1)
+static Xen gxm_XtScreenOfObject(Xen arg1)
{
#define H_XtScreenOfObject "Screen *XtScreenOfObject(object): returns the screen pointer for the specified object."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtScreenOfObject", "Widget");
- return(C_TO_XEN_Screen(XtScreenOfObject(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtScreenOfObject", "Widget");
+ return(C_to_Xen_Screen(XtScreenOfObject(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtScreen(XEN arg1)
+static Xen gxm_XtScreen(Xen arg1)
{
#define H_XtScreen "Screen* XtScreen(w): returns the screen pointer for the specified widget."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtScreen", "Widget");
- return(C_TO_XEN_Screen(XtScreen(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtScreen", "Widget");
+ return(C_to_Xen_Screen(XtScreen(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtDisplayOfObject(XEN arg1)
+static Xen gxm_XtDisplayOfObject(Xen arg1)
{
#define H_XtDisplayOfObject "Display *XtDisplayOfObject(object): returns the display pointer for the specified object."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtDisplayOfObject", "Widget");
- return(C_TO_XEN_Display(XtDisplayOfObject(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtDisplayOfObject", "Widget");
+ return(C_to_Xen_Display(XtDisplayOfObject(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtDisplay(XEN arg1)
+static Xen gxm_XtDisplay(Xen arg1)
{
#define H_XtDisplay "Display* XtDisplay(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtDisplay", "Widget");
- return(C_TO_XEN_Display(XtDisplay(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtDisplay", "Widget");
+ return(C_to_Xen_Display(XtDisplay(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtVaCreateArgsList(XEN arg1, XEN ignore2)
+static Xen gxm_XtVaCreateArgsList(Xen arg1, Xen ignore2)
{
#define H_XtVaCreateArgsList "XtVarArgsList XtVaCreateArgsList(unused, ...) allocates memory and copies its arguments into a single \
list pointer, which may be used with XtVaNestedList."
- /* DIFF: XtVaCreateArgsList just returns its 1st arg
+ /* DIFF: XtVaCreateArgsList just returns its first arg
*/
return(arg1);
}
-static XEN gxm_XtMergeArgLists(XEN arg1, XEN ignore2, XEN arg3, XEN ignore4)
+static Xen gxm_XtMergeArgLists(Xen arg1, Xen ignore2, Xen arg3, Xen ignore4)
{
#define H_XtMergeArgLists "ArgList XtMergeArgLists(args1, num_args1, args2, num_args2) allocates enough storage to hold the combined \
ArgList structures and copies them into it."
/* just merges, not duplicate check, kinda dumb to drop into C for that */
- XEN_ASSERT_TYPE(XEN_LIST_P(arg1), arg1, 1, "XtMergeArgLists", "list");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg3), arg3, 3, "XtMergeArgLists", "list");
- return(XEN_APPEND(arg1, arg3));
+ Xen_check_type(Xen_is_list(arg1), arg1, 1, "XtMergeArgLists", "list");
+ Xen_check_type(Xen_is_list(arg3), arg3, 3, "XtMergeArgLists", "list");
+ return(Xen_append(arg1, arg3));
}
-static XEN gxm_XtWindowToWidget(XEN arg1, XEN arg2)
+static Xen gxm_XtWindowToWidget(Xen arg1, Xen arg2)
{
#define H_XtWindowToWidget "Widget XtWindowToWidget(display, window) translates the specified window and display pointer into the appropriate widget instance."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtWindowToWidget", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XtWindowToWidget", "Window");
- return(C_TO_XEN_Widget(XtWindowToWidget(XEN_TO_C_Display(arg1), XEN_TO_C_Window(arg2))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtWindowToWidget", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XtWindowToWidget", "Window");
+ return(C_to_Xen_Widget(XtWindowToWidget(Xen_to_C_Display(arg1), Xen_to_C_Window(arg2))));
}
-static XEN gxm_XtNameToWidget(XEN arg1, XEN arg2)
+static Xen gxm_XtNameToWidget(Xen arg1, Xen arg2)
{
#define H_XtNameToWidget "Widget XtNameToWidget(reference, names) looks for a widget whose name is the first component in the specified names"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtNameToWidget", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtNameToWidget", "char*");
- return(C_TO_XEN_Widget(XtNameToWidget(XEN_TO_C_Widget(arg1), (char *)XEN_TO_C_STRING(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtNameToWidget", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtNameToWidget", "char*");
+ return(C_to_Xen_Widget(XtNameToWidget(Xen_to_C_Widget(arg1), (char *)Xen_string_to_C_string(arg2))));
}
-static XEN gxm_XtSetSensitive(XEN arg1, XEN arg2)
+static Xen gxm_XtSetSensitive(Xen arg1, Xen arg2)
{
#define H_XtSetSensitive "void XtSetSensitive(w, sensitive)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtSetSensitive", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XtSetSensitive", "boolean");
- XtSetSensitive(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtSetSensitive", "Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XtSetSensitive", "boolean");
+ XtSetSensitive(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtDestroyWidget(XEN arg1)
+static Xen gxm_XtDestroyWidget(Xen arg1)
{
#define H_XtDestroyWidget "void XtDestroyWidget(w) provides the only method of destroying a widget, including widgets that need to destroy themselves."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtDestroyWidget", "Widget");
- XtDestroyWidget(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtDestroyWidget", "Widget");
+ XtDestroyWidget(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtUnrealizeWidget(XEN arg1)
+static Xen gxm_XtUnrealizeWidget(Xen arg1)
{
#define H_XtUnrealizeWidget "void XtUnrealizeWidget(w) destroys the windows of an existing widget and all of its children (recursively down the widget tree)."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtUnrealizeWidget", "Widget");
- XtUnrealizeWidget(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtUnrealizeWidget", "Widget");
+ XtUnrealizeWidget(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtRealizeWidget(XEN arg1)
+static Xen gxm_XtRealizeWidget(Xen arg1)
{
#define H_XtRealizeWidget "void XtRealizeWidget(w) maps the widget window."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtRealizeWidget", "Widget");
- XtRealizeWidget(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtRealizeWidget", "Widget");
+ XtRealizeWidget(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtAppPending(XEN arg1)
+static Xen gxm_XtAppPending(Xen arg1)
{
#define H_XtAppPending "XtInputMask XtAppPending(app_context): returns a nonzero value if there are events pending from the X server, timer \
pending, or other input sources pending. "
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppPending", "XtAppContext");
- return(C_TO_XEN_ULONG(XtAppPending(XEN_TO_C_XtAppContext(arg1))));
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppPending", "XtAppContext");
+ return(C_ulong_to_Xen_ulong(XtAppPending(Xen_to_C_XtAppContext(arg1))));
}
-static XEN gxm_XtAppNextEvent(XEN arg1)
+static Xen gxm_XtAppNextEvent(Xen arg1)
{
#define H_XtAppNextEvent "void XtAppNextEvent(app_context) flushes the X output buffers of each Display in the application \
context and waits for an event while looking at the other input sources, timeout timeout values, and signal handlers and calling any callback \
@@ -15547,10 +15300,10 @@ procedures triggered by them -> event."
/* DIFF: XtAppNextEvent app [ev] -> ev
*/
XEvent *e;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppNextEvent", "XtAppContext");
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppNextEvent", "XtAppContext");
e = (XEvent *)calloc(1, sizeof(XEvent));
- XtAppNextEvent(XEN_TO_C_XtAppContext(arg1), e);
- return(C_TO_XEN_XEvent_OBJ(e));
+ XtAppNextEvent(Xen_to_C_XtAppContext(arg1), e);
+ return(C_to_Xen_XEvent_OBJ(e));
}
@@ -15559,25 +15312,25 @@ procedures triggered by them -> event."
/* (77) explicitly removed via XtRemoveInput */
-#define C_TO_XEN_XM_Input(Code, Context) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("Input"), Code, Context, XEN_ZERO, XEN_ZERO)
-#define XM_Input_P(Arg) WRAP_P("Input", Arg)
+#define C_to_Xen_XM_Input(Code, Context) \
+ Xen_list_5(C_string_to_Xen_symbol("Input"), Code, Context, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_Input(Arg) is_wrapped("Input", Arg)
static void gxm_XtInputCallbackProc(XtPointer cdata, int *fileno, XtInputId *id)
{
- XEN descr = (XEN)cdata;
+ Xen descr = (Xen)cdata;
/* (list 'Input function context gc-loc id) */
- XEN_CALL_3(XEN_CADR(descr),
- XEN_CADDR(descr),
- C_TO_XEN_ULONG(*fileno),
- C_TO_XEN_XtInputId(*id),
- c__FUNCTION__);
+ Xen_call_with_3_args(Xen_cadr(descr),
+ Xen_caddr(descr),
+ C_ulong_to_Xen_ulong(*fileno),
+ C_to_Xen_XtInputId(*id),
+ __func__);
}
-static bool unprotect_inputproc(XEN val, int loc, unsigned long id)
+static bool unprotect_inputproc(Xen val, int loc, unsigned long id)
{
- if ((XM_Input_P(val)) &&
- ((XtInputId)XEN_TO_C_ULONG(XEN_LIST_REF(val, 4)) == id))
+ if ((XM_is_Input(val)) &&
+ ((XtInputId)Xen_ulong_to_C_ulong(Xen_list_ref(val, 4)) == id))
{
xm_unprotect_at(loc);
return(true);
@@ -15585,68 +15338,68 @@ static bool unprotect_inputproc(XEN val, int loc, unsigned long id)
return(false);
}
-static XEN gxm_XtRemoveInput(XEN arg1)
+static Xen gxm_XtRemoveInput(Xen arg1)
{
#define H_XtRemoveInput "void XtRemoveInput(id) causes the read routine to stop watching for input from the input source."
XtInputId id;
- XEN_ASSERT_TYPE(XEN_XtInputId_P(arg1), arg1, 1, "XtRemoveInput", "XtInputId");
- id = XEN_TO_C_XtInputId(arg1);
+ Xen_check_type(Xen_is_XtInputId(arg1), arg1, 1, "XtRemoveInput", "XtInputId");
+ id = Xen_to_C_XtInputId(arg1);
XtRemoveInput(id);
map_over_protected_elements(unprotect_inputproc, id);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtAppAddInput(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtAppAddInput(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtAppAddInput "XtInputId XtAppAddInput(app_context, source, condition, proc, client_data) registers with the read routine a \
new source of events, which is usually file input but can also be file output."
XtInputId id;
int gc_loc;
- XEN descr;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppAddInput", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XtAppAddInput", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg3), arg3, 3, "XtAppAddInput", "int");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 3)), arg4, 4, "XtAppAddInput", "(XtInputCallbackProc data fileno id)");
- descr = C_TO_XEN_XM_Input(arg4, (XEN_BOUND_P(arg5)) ? arg5 : XEN_FALSE);
+ Xen descr;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppAddInput", "XtAppContext");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XtAppAddInput", "int");
+ Xen_check_type(Xen_is_integer(arg3), arg3, 3, "XtAppAddInput", "int");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 3)), arg4, 4, "XtAppAddInput", "(XtInputCallbackProc data fileno id)");
+ descr = C_to_Xen_XM_Input(arg4, (Xen_is_bound(arg5)) ? arg5 : Xen_false);
gc_loc = xm_protect(descr);
- id = XtAppAddInput(XEN_TO_C_XtAppContext(arg1),
- XEN_TO_C_INT(arg2),
-#if (SIZEOF_INT64_T != SIZEOF_VOID_P)
- (XtPointer)((int)XEN_TO_C_ULONG(arg3)),
+ id = XtAppAddInput(Xen_to_C_XtAppContext(arg1),
+ Xen_integer_to_C_int(arg2),
+#if (SIZEOF_VOID_P == 4)
+ (XtPointer)((int)Xen_ulong_to_C_ulong(arg3)),
#else
- (XtPointer)XEN_TO_C_INT64_T(arg3),
+ (XtPointer)Xen_llong_to_C_llong(arg3),
#endif
gxm_XtInputCallbackProc,
(XtPointer)descr);
- XEN_LIST_SET(descr, 3, C_TO_XEN_INT(gc_loc));
- XEN_LIST_SET(descr, 4, C_TO_XEN_ULONG(id));
- return(C_TO_XEN_XtInputId(id));
+ Xen_list_set(descr, 3, C_int_to_Xen_integer(gc_loc));
+ Xen_list_set(descr, 4, C_ulong_to_Xen_ulong(id));
+ return(C_to_Xen_XtInputId(id));
}
/* -------- Timer Callback -------- */
/* (79) protect the function, then unprotect after invocation */
-#define C_TO_XEN_XM_TimeOut(Code, Context) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("TimeOut"), Code, Context, XEN_ZERO, XEN_ZERO)
-#define XM_TimeOut_P(Arg) WRAP_P("TimeOut", Arg)
+#define C_to_Xen_XM_TimeOut(Code, Context) \
+ Xen_list_5(C_string_to_Xen_symbol("TimeOut"), Code, Context, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_TimeOut(Arg) is_wrapped("TimeOut", Arg)
static void gxm_XtTimerCallbackProc(XtPointer cdata, XtIntervalId* i)
{
- XEN descr = (XEN)cdata;
+ Xen descr = (Xen)cdata;
/* (list 'TimeOut function context gc-loc id) */
int gc_loc;
- gc_loc = XEN_TO_C_INT(XEN_LIST_REF(descr, 3));
- XEN_CALL_2(XEN_CADR(descr),
- XEN_CADDR(descr),
- C_TO_XEN_XtIntervalId(*i),
- c__FUNCTION__);
+ gc_loc = Xen_integer_to_C_int(Xen_list_ref(descr, 3));
+ Xen_call_with_2_args(Xen_cadr(descr),
+ Xen_caddr(descr),
+ C_to_Xen_XtIntervalId(*i),
+ __func__);
xm_unprotect_at(gc_loc);
}
-static bool unprotect_timeoutproc(XEN val, int loc, unsigned long id)
+static bool unprotect_timeoutproc(Xen val, int loc, unsigned long id)
{
- if ((XM_TimeOut_P(val)) &&
- ((XtIntervalId)XEN_TO_C_ULONG(XEN_LIST_REF(val, 4)) == id))
+ if ((XM_is_TimeOut(val)) &&
+ ((XtIntervalId)Xen_ulong_to_C_ulong(Xen_list_ref(val, 4)) == id))
{
xm_unprotect_at(loc);
return(true);
@@ -15654,412 +15407,412 @@ static bool unprotect_timeoutproc(XEN val, int loc, unsigned long id)
return(false);
}
-static XEN gxm_XtRemoveTimeOut(XEN arg1)
+static Xen gxm_XtRemoveTimeOut(Xen arg1)
{
#define H_XtRemoveTimeOut "void XtRemoveTimeOut(timer) removes the timeout."
XtIntervalId id;
- XEN_ASSERT_TYPE(XEN_XtIntervalId_P(arg1), arg1, 1, "XtRemoveTimeOut", "XtIntervalId");
- id = XEN_TO_C_XtIntervalId(arg1);
+ Xen_check_type(Xen_is_XtIntervalId(arg1), arg1, 1, "XtRemoveTimeOut", "XtIntervalId");
+ id = Xen_to_C_XtIntervalId(arg1);
XtRemoveTimeOut(id);
map_over_protected_elements(unprotect_timeoutproc, id);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtAppAddTimeOut(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XtAppAddTimeOut(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XtAppAddTimeOut "XtIntervalId XtAppAddTimeOut(app_context, interval, proc, client_data) creates a timeout and returns an identifier for it."
XtIntervalId id;
int gc_loc;
- XEN descr;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppAddTimeOut", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtAppAddTimeOut", "ulong");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg3) && (XEN_REQUIRED_ARGS_OK(arg3, 2)), arg3, 3, "XtAppAddTimeOut", "(XtTimerCallbackProc data id)");
- descr = C_TO_XEN_XM_TimeOut(arg3, (XEN_BOUND_P(arg4)) ? arg4 : XEN_FALSE);
+ Xen descr;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppAddTimeOut", "XtAppContext");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtAppAddTimeOut", "ulong");
+ Xen_check_type(Xen_is_procedure(arg3) && (Xen_is_aritable(arg3, 2)), arg3, 3, "XtAppAddTimeOut", "(XtTimerCallbackProc data id)");
+ descr = C_to_Xen_XM_TimeOut(arg3, (Xen_is_bound(arg4)) ? arg4 : Xen_false);
gc_loc = xm_protect(descr);
- id = XtAppAddTimeOut(XEN_TO_C_XtAppContext(arg1),
- XEN_TO_C_ULONG(arg2),
+ id = XtAppAddTimeOut(Xen_to_C_XtAppContext(arg1),
+ Xen_ulong_to_C_ulong(arg2),
gxm_XtTimerCallbackProc,
(XtPointer)descr);
- XEN_LIST_SET(descr, 3, C_TO_XEN_INT(gc_loc));
- XEN_LIST_SET(descr, 4, C_TO_XEN_ULONG(id));
- return(C_TO_XEN_XtIntervalId(id));
+ Xen_list_set(descr, 3, C_int_to_Xen_integer(gc_loc));
+ Xen_list_set(descr, 4, C_ulong_to_Xen_ulong(id));
+ return(C_to_Xen_XtIntervalId(id));
}
-static XEN gxm_XtLastTimestampProcessed(XEN arg1)
+static Xen gxm_XtLastTimestampProcessed(Xen arg1)
{
#define H_XtLastTimestampProcessed "Time XtLastTimestampProcessed(display): returns the timestamp of the last event"
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtLastTimestampProcessed", "Display*");
- return(C_TO_XEN_Time(XtLastTimestampProcessed(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtLastTimestampProcessed", "Display*");
+ return(C_to_Xen_Time(XtLastTimestampProcessed(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XtLastEventProcessed(XEN arg1)
+static Xen gxm_XtLastEventProcessed(Xen arg1)
{
#define H_XtLastEventProcessed "XEvent* XtLastEventProcessed(display): returns the last event passed to XtDispatchEvent for the \
specified display and NULL if there has been no event. "
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtLastEventProcessed", "Display*");
- return(C_TO_XEN_XEvent(XtLastEventProcessed(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtLastEventProcessed", "Display*");
+ return(C_to_Xen_XEvent(XtLastEventProcessed(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XtGetKeyboardFocusWidget(XEN arg1)
+static Xen gxm_XtGetKeyboardFocusWidget(Xen arg1)
{
#define H_XtGetKeyboardFocusWidget "Widget XtGetKeyboardFocusWidget(widget): returns the widget that would be the end result of keyboard \
event forwarding for a keyboard event for the specified widget."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtGetKeyboardFocusWidget", "Widget");
- return(C_TO_XEN_Widget(XtGetKeyboardFocusWidget(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtGetKeyboardFocusWidget", "Widget");
+ return(C_to_Xen_Widget(XtGetKeyboardFocusWidget(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtSetKeyboardFocus(XEN arg1, XEN arg2)
+static Xen gxm_XtSetKeyboardFocus(Xen arg1, Xen arg2)
{
#define H_XtSetKeyboardFocus "XtSetKeyboardFocus(subtree descendant) causes XtDispatchEvent to remap and send the event to the specified \
descendant widget."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtSetKeyboardFocus", "Widget");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg2), arg2, 2, "XtSetKeyboardFocus", "Widget");
- XtSetKeyboardFocus(XEN_TO_C_Widget(arg1), XEN_TO_C_Widget(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtSetKeyboardFocus", "Widget");
+ Xen_check_type(Xen_is_Widget(arg2), arg2, 2, "XtSetKeyboardFocus", "Widget");
+ XtSetKeyboardFocus(Xen_to_C_Widget(arg1), Xen_to_C_Widget(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtAddExposureToRegion(XEN arg1, XEN arg2)
+static Xen gxm_XtAddExposureToRegion(Xen arg1, Xen arg2)
{
#define H_XtAddExposureToRegion "void XtAddExposureToRegion(event, region) computes the union of the rectangle defined by the exposure event \
and the specified region. Then, it stores the results back in region."
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg1), arg1, 1, "XtAddExposureToRegion", "XEvent*");
- XEN_ASSERT_TYPE(XEN_Region_P(arg2), arg2, 2, "XtAddExposureToRegion", "Region");
- XtAddExposureToRegion(XEN_TO_C_XEvent(arg1), XEN_TO_C_Region(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XEvent(arg1), arg1, 1, "XtAddExposureToRegion", "XEvent*");
+ Xen_check_type(Xen_is_Region(arg2), arg2, 2, "XtAddExposureToRegion", "Region");
+ XtAddExposureToRegion(Xen_to_C_XEvent(arg1), Xen_to_C_Region(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtAppMainLoop(XEN arg1)
+static Xen gxm_XtAppMainLoop(Xen arg1)
{
#define H_XtAppMainLoop "void XtAppMainLoop(app_context) first reads the next incoming X event by calling XtAppNextEvent and then it dispatches \
the event to the appropriate registered procedure by calling XtDispatchEvent."
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppMainLoop", "XtAppContext");
- XtAppMainLoop(XEN_TO_C_XtAppContext(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppMainLoop", "XtAppContext");
+ XtAppMainLoop(Xen_to_C_XtAppContext(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtAppProcessEvent(XEN arg1, XEN arg2)
+static Xen gxm_XtAppProcessEvent(Xen arg1, Xen arg2)
{
#define H_XtAppProcessEvent "void XtAppProcessEvent(app_context, mask) processes one timer, alternate input, signal source, or X event. \
If there is nothing of the appropriate type to process, XtAppProcessEvent blocks until there is."
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppProcessEvent", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtAppProcessEvent", "XtInputMask");
- XtAppProcessEvent(XEN_TO_C_XtAppContext(arg1), XEN_TO_C_ULONG(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppProcessEvent", "XtAppContext");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtAppProcessEvent", "XtInputMask");
+ XtAppProcessEvent(Xen_to_C_XtAppContext(arg1), Xen_ulong_to_C_ulong(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtRemoveGrab(XEN arg1)
+static Xen gxm_XtRemoveGrab(Xen arg1)
{
#define H_XtRemoveGrab "void XtRemoveGrab(w) removes widgets from the modal cascade starting at the most recent widget up to and \
including the specified widget. "
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtRemoveGrab", "Widget");
- XtRemoveGrab(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtRemoveGrab", "Widget");
+ XtRemoveGrab(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtAddGrab(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtAddGrab(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtAddGrab "void XtAddGrab(w, exclusive, spring_loaded) appends the widget (and associated parameters) to the modal cascade and \
checks that exclusive is " PROC_TRUE " if spring_loaded is " PROC_TRUE "."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtAddGrab", "Widget");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XtAddGrab", "boolean");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XtAddGrab", "boolean");
- XtAddGrab(XEN_TO_C_Widget(arg1), XEN_TO_C_BOOLEAN(arg2), XEN_TO_C_BOOLEAN(arg3));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtAddGrab", "Widget");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XtAddGrab", "boolean");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XtAddGrab", "boolean");
+ XtAddGrab(Xen_to_C_Widget(arg1), Xen_boolean_to_C_bool(arg2), Xen_boolean_to_C_bool(arg3));
+ return(Xen_false);
}
-static XEN gxm_XtBuildEventMask(XEN arg1)
+static Xen gxm_XtBuildEventMask(Xen arg1)
{
#define H_XtBuildEventMask "EventMask XtBuildEventMask(w): widget's event mask"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtBuildEventMask", "Widget");
- return(C_TO_XEN_ULONG(XtBuildEventMask(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtBuildEventMask", "Widget");
+ return(C_ulong_to_Xen_ulong(XtBuildEventMask(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtDispatchEventToWidget(XEN arg1, XEN arg2)
+static Xen gxm_XtDispatchEventToWidget(Xen arg1, Xen arg2)
{
#define H_XtDispatchEventToWidget "Boolean XtDispatchEventToWidget(widget, event) scans the list of registered event handlers for the \
specified widget and calls each handler that has been registered for the specified event type, subject to the continue_to_dispatch value \
returned by each handler."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtDispatchEventToWidget", "Widget");
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg2), arg2, 2, "XtDispatchEventToWidget", "XEvent*");
- return(C_TO_XEN_BOOLEAN(XtDispatchEventToWidget(XEN_TO_C_Widget(arg1), XEN_TO_C_XEvent(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtDispatchEventToWidget", "Widget");
+ Xen_check_type(Xen_is_XEvent(arg2), arg2, 2, "XtDispatchEventToWidget", "XEvent*");
+ return(C_bool_to_Xen_boolean(XtDispatchEventToWidget(Xen_to_C_Widget(arg1), Xen_to_C_XEvent(arg2))));
}
enum {EVENT_HANDLER_TYPE, EVENT_HANDLER_FUNC, EVENT_HANDLER_DATA, EVENT_HANDLER_GC_LOC, EVENT_HANDLER_WIDGET, EVENT_HANDLER_MASK};
-#define C_TO_XEN_XM_XtEventHandler(Code, Context, Widget, Mask) \
- XEN_LIST_6(C_STRING_TO_XEN_SYMBOL("XtEventHandler"), Code, Context, XEN_ZERO, Widget, Mask)
-#define XM_XtEventHandler_P(Arg) WRAP_P("XtEventHandler", Arg)
+#define C_to_Xen_XM_XtEventHandler(Code, Context, Widget, Mask) \
+ Xen_list_6(C_string_to_Xen_symbol("XtEventHandler"), Code, Context, Xen_integer_zero, Widget, Mask)
+#define XM_is_XtEventHandler(Arg) is_wrapped("XtEventHandler", Arg)
static void gxm_XtEventHandler(Widget w, XtPointer context, XEvent *event, Boolean *flag)
{
- XEN result;
- XEN descr = (XEN)context;
- result = XEN_CALL_4(XEN_LIST_REF(descr, EVENT_HANDLER_FUNC),
- C_TO_XEN_Widget(w),
- XEN_LIST_REF(descr, EVENT_HANDLER_DATA),
- C_TO_XEN_XEvent(event),
- C_TO_XEN_BOOLEAN(*flag),
- c__FUNCTION__);
- if ((XEN_SYMBOL_P(result)) && (strcmp("done", XEN_SYMBOL_TO_C_STRING(result)) == 0))
+ Xen result;
+ Xen descr = (Xen)context;
+ result = Xen_call_with_4_args(Xen_list_ref(descr, EVENT_HANDLER_FUNC),
+ C_to_Xen_Widget(w),
+ Xen_list_ref(descr, EVENT_HANDLER_DATA),
+ C_to_Xen_XEvent(event),
+ C_bool_to_Xen_boolean(*flag),
+ __func__);
+ if ((Xen_is_symbol(result)) && (strcmp("done", Xen_symbol_to_C_string(result)) == 0))
(*flag) = false;
}
-static bool find_xteventproc_1(XEN val, int loc, unsigned long wd)
+static bool find_xteventproc_1(Xen val, int loc, unsigned long wd)
{
- XEN lst = (XEN)wd;
+ Xen lst = (Xen)wd;
unsigned long w;
- XEN code;
- XEN data;
- w = XEN_TO_C_ULONG(XEN_CAR(lst));
- code = XEN_CADR(lst);
- data = XEN_CADDR(lst);
- return((XM_XtEventHandler_P(val)) &&
- (XEN_Widget_P(XEN_LIST_REF(val, EVENT_HANDLER_WIDGET))) &&
- (XEN_TO_C_ULONG(XEN_CADR(XEN_LIST_REF(val, EVENT_HANDLER_WIDGET))) == w) &&
- (XEN_EQ_P(code, XEN_LIST_REF(val, EVENT_HANDLER_FUNC))) &&
- (XEN_EQ_P(data, XEN_LIST_REF(val, EVENT_HANDLER_DATA))));
+ Xen code;
+ Xen data;
+ w = Xen_ulong_to_C_ulong(Xen_car(lst));
+ code = Xen_cadr(lst);
+ data = Xen_caddr(lst);
+ return((XM_is_XtEventHandler(val)) &&
+ (Xen_is_Widget(Xen_list_ref(val, EVENT_HANDLER_WIDGET))) &&
+ (Xen_ulong_to_C_ulong(Xen_cadr(Xen_list_ref(val, EVENT_HANDLER_WIDGET))) == w) &&
+ (Xen_is_eq(code, Xen_list_ref(val, EVENT_HANDLER_FUNC))) &&
+ (Xen_is_eq(data, Xen_list_ref(val, EVENT_HANDLER_DATA))));
}
-static XEN find_xteventproc(Widget w, XEN code, XEN data)
+static Xen find_xteventproc(Widget w, Xen code, Xen data)
{
/* here we again have to go by the widget */
- XEN lst;
+ Xen lst;
int i, loc;
- lst = XEN_LIST_3(C_TO_XEN_ULONG((unsigned long)w),code, data);
+ lst = Xen_list_3(C_ulong_to_Xen_ulong((unsigned long)w),code, data);
loc = xm_protect(lst);
i = map_over_protected_elements(find_xteventproc_1, (unsigned long)lst);
xm_unprotect_at(loc);
if (i >= 0)
return(xm_protected_element(i));
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtInsertRawEventHandler(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XtInsertRawEventHandler(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XtInsertRawEventHandler "void XtInsertRawEventHandler(w, event_mask, nonmaskable, proc, client_data, position) is similar to \
XtInsertEventHandler except that it does not modify the widget's event mask and never causes an XSelectInput for the specified events."
- XEN call_descr = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtInsertRawEventHandler", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtInsertRawEventHandler", "EventMask");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XtInsertRawEventHandler", "boolean");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 4)), arg4, 4, "XtInsertRawEventHandler", "XtEventHandler");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XtInsertRawEventHandler", "XtListPosition");
- call_descr = C_TO_XEN_XM_XtEventHandler(arg4, (XEN_BOUND_P(arg5)) ? arg5 : XEN_FALSE, arg1, arg2);
- XEN_LIST_SET(call_descr, EVENT_HANDLER_GC_LOC, C_TO_XEN_INT(xm_protect(call_descr)));
- XtInsertRawEventHandler(XEN_TO_C_Widget(arg1),
- XEN_TO_C_ULONG(arg2),
- XEN_TO_C_BOOLEAN(arg3),
+ Xen call_descr = Xen_empty_list;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtInsertRawEventHandler", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtInsertRawEventHandler", "EventMask");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XtInsertRawEventHandler", "boolean");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 4)), arg4, 4, "XtInsertRawEventHandler", "XtEventHandler");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XtInsertRawEventHandler", "XtListPosition");
+ call_descr = C_to_Xen_XM_XtEventHandler(arg4, (Xen_is_bound(arg5)) ? arg5 : Xen_false, arg1, arg2);
+ Xen_list_set(call_descr, EVENT_HANDLER_GC_LOC, C_int_to_Xen_integer(xm_protect(call_descr)));
+ XtInsertRawEventHandler(Xen_to_C_Widget(arg1),
+ Xen_ulong_to_C_ulong(arg2),
+ Xen_boolean_to_C_bool(arg3),
gxm_XtEventHandler,
(XtPointer)call_descr,
- (XtListPosition)XEN_TO_C_INT(arg6));
- return(XEN_FALSE);
+ (XtListPosition)Xen_integer_to_C_int(arg6));
+ return(Xen_false);
}
-static XEN gxm_XtInsertEventHandler(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XtInsertEventHandler(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XtInsertEventHandler "void XtInsertEventHandler(w, event_mask, nonmaskable, proc, client_data, position) is identical to \
XtAddEventHandler with the additional position argument. "
- XEN call_descr = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtInsertEventHandler", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtInsertEventHandler", "EventMask");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XtInsertEventHandler", "boolean");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 4)), arg4, 4, "XtInsertEventHandler", "XtEventHandler");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg6), arg6, 6, "XtInsertEventHandler", "XtListPosition");
- call_descr = C_TO_XEN_XM_XtEventHandler(arg4, (XEN_BOUND_P(arg5)) ? arg5 : XEN_FALSE, arg1, arg2);
- XEN_LIST_SET(call_descr, EVENT_HANDLER_GC_LOC, C_TO_XEN_INT(xm_protect(call_descr)));
- XtInsertEventHandler(XEN_TO_C_Widget(arg1),
- XEN_TO_C_ULONG(arg2),
- XEN_TO_C_BOOLEAN(arg3),
+ Xen call_descr = Xen_empty_list;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtInsertEventHandler", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtInsertEventHandler", "EventMask");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XtInsertEventHandler", "boolean");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 4)), arg4, 4, "XtInsertEventHandler", "XtEventHandler");
+ Xen_check_type(Xen_is_integer(arg6), arg6, 6, "XtInsertEventHandler", "XtListPosition");
+ call_descr = C_to_Xen_XM_XtEventHandler(arg4, (Xen_is_bound(arg5)) ? arg5 : Xen_false, arg1, arg2);
+ Xen_list_set(call_descr, EVENT_HANDLER_GC_LOC, C_int_to_Xen_integer(xm_protect(call_descr)));
+ XtInsertEventHandler(Xen_to_C_Widget(arg1),
+ Xen_ulong_to_C_ulong(arg2),
+ Xen_boolean_to_C_bool(arg3),
gxm_XtEventHandler,
(XtPointer)call_descr,
- (XtListPosition)XEN_TO_C_INT(arg6));
- return(XEN_FALSE);
+ (XtListPosition)Xen_integer_to_C_int(arg6));
+ return(Xen_false);
}
-static XEN gxm_XtRemoveRawEventHandler(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtRemoveRawEventHandler(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtRemoveRawEventHandler "void XtRemoveRawEventHandler(w, event_mask, nonmaskable, proc, client_data) stops the specified \
procedure from receiving the specified events."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtRemoveRawEventHandler", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtRemoveRawEventHandler", "EventMask");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XtRemoveRawEventHandler", "boolean");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 4)), arg4, 4, "XtRemoveRawEventHandler", "XtEventHandler");
- XtRemoveRawEventHandler(XEN_TO_C_Widget(arg1),
- XEN_TO_C_ULONG(arg2),
- XEN_TO_C_BOOLEAN(arg3),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtRemoveRawEventHandler", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtRemoveRawEventHandler", "EventMask");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XtRemoveRawEventHandler", "boolean");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 4)), arg4, 4, "XtRemoveRawEventHandler", "XtEventHandler");
+ XtRemoveRawEventHandler(Xen_to_C_Widget(arg1),
+ Xen_ulong_to_C_ulong(arg2),
+ Xen_boolean_to_C_bool(arg3),
gxm_XtEventHandler,
- (XtPointer)find_xteventproc(XEN_TO_C_Widget(arg1), arg4, arg5));
- return(XEN_FALSE);
+ (XtPointer)find_xteventproc(Xen_to_C_Widget(arg1), arg4, arg5));
+ return(Xen_false);
}
-static XEN gxm_XtAddRawEventHandler(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtAddRawEventHandler(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtAddRawEventHandler "void XtAddRawEventHandler(w, event_mask, nonmaskable, proc, client_data) is similar to XtAddEventHandler \
except that it does not affect the widget's mask and never causes an XSelectInput for its events."
- XEN call_descr = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtAddRawEventHandler", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtAddRawEventHandler", "EventMask");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XtAddRawEventHandler", "boolean");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 4)), arg4, 4, "XtAddRawEventHandler", "XtEventHandler");
- call_descr = C_TO_XEN_XM_XtEventHandler(arg4, (XEN_BOUND_P(arg5)) ? arg5 : XEN_FALSE, arg1, arg2);
- XEN_LIST_SET(call_descr, EVENT_HANDLER_GC_LOC, C_TO_XEN_INT(xm_protect(call_descr)));
- XtAddRawEventHandler(XEN_TO_C_Widget(arg1),
- XEN_TO_C_ULONG(arg2),
- XEN_TO_C_BOOLEAN(arg3),
+ Xen call_descr = Xen_empty_list;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtAddRawEventHandler", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtAddRawEventHandler", "EventMask");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XtAddRawEventHandler", "boolean");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 4)), arg4, 4, "XtAddRawEventHandler", "XtEventHandler");
+ call_descr = C_to_Xen_XM_XtEventHandler(arg4, (Xen_is_bound(arg5)) ? arg5 : Xen_false, arg1, arg2);
+ Xen_list_set(call_descr, EVENT_HANDLER_GC_LOC, C_int_to_Xen_integer(xm_protect(call_descr)));
+ XtAddRawEventHandler(Xen_to_C_Widget(arg1),
+ Xen_ulong_to_C_ulong(arg2),
+ Xen_boolean_to_C_bool(arg3),
gxm_XtEventHandler,
(XtPointer)call_descr);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtRemoveEventHandler(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtRemoveEventHandler(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtRemoveEventHandler "XtRemoveEventHandler(w, event_mask, nonmaskable, proc, client_data)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtRemoveEventHandler", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtRemoveEventHandler", "EventMask");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XtRemoveEventHandler", "boolean");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 4)), arg4, 4, "XtRemoveEventHandler", "XtEventHandler");
- XtRemoveEventHandler(XEN_TO_C_Widget(arg1),
- XEN_TO_C_ULONG(arg2),
- XEN_TO_C_BOOLEAN(arg3),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtRemoveEventHandler", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtRemoveEventHandler", "EventMask");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XtRemoveEventHandler", "boolean");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 4)), arg4, 4, "XtRemoveEventHandler", "XtEventHandler");
+ XtRemoveEventHandler(Xen_to_C_Widget(arg1),
+ Xen_ulong_to_C_ulong(arg2),
+ Xen_boolean_to_C_bool(arg3),
gxm_XtEventHandler,
- (XtPointer)find_xteventproc(XEN_TO_C_Widget(arg1), arg4, arg5));
- return(XEN_FALSE);
+ (XtPointer)find_xteventproc(Xen_to_C_Widget(arg1), arg4, arg5));
+ return(Xen_false);
}
-static XEN gxm_XtAddEventHandler(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtAddEventHandler(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtAddEventHandler "void XtAddEventHandler(w, event_mask, nonmaskable, proc, client_data) registers a procedure with the dispatch \
mechanism that is to be called when an event that matches the mask occurs on the specified widget. To set the 'continue_to_dispatch' \
flag to 'false', return the symbol 'done from the event handler."
- XEN call_descr = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtAddEventHandler", "Widget");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg2), arg2, 2, "XtAddEventHandler", "EventMask");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg3), arg3, 3, "XtAddEventHandler", "boolean");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 4)), arg4, 4, "XtAddEventHandler", "XtEventHandler");
- call_descr = C_TO_XEN_XM_XtEventHandler(arg4, (XEN_BOUND_P(arg5)) ? arg5 : XEN_FALSE, arg1, arg2);
- XEN_LIST_SET(call_descr, EVENT_HANDLER_GC_LOC, C_TO_XEN_INT(xm_protect(call_descr)));
- XtAddEventHandler(XEN_TO_C_Widget(arg1),
- XEN_TO_C_ULONG(arg2),
- XEN_TO_C_BOOLEAN(arg3),
+ Xen call_descr = Xen_empty_list;
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtAddEventHandler", "Widget");
+ Xen_check_type(Xen_is_ulong(arg2), arg2, 2, "XtAddEventHandler", "EventMask");
+ Xen_check_type(Xen_is_boolean(arg3), arg3, 3, "XtAddEventHandler", "boolean");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 4)), arg4, 4, "XtAddEventHandler", "XtEventHandler");
+ call_descr = C_to_Xen_XM_XtEventHandler(arg4, (Xen_is_bound(arg5)) ? arg5 : Xen_false, arg1, arg2);
+ Xen_list_set(call_descr, EVENT_HANDLER_GC_LOC, C_int_to_Xen_integer(xm_protect(call_descr)));
+ XtAddEventHandler(Xen_to_C_Widget(arg1),
+ Xen_ulong_to_C_ulong(arg2),
+ Xen_boolean_to_C_bool(arg3),
gxm_XtEventHandler,
(XtPointer)call_descr);
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtConvertCase(XEN arg1, XEN arg2)
+static Xen gxm_XtConvertCase(Xen arg1, Xen arg2)
{
#define H_XtConvertCase "void XtConvertCase(display, keysym) calls the appropriate converter and returns the results."
/* DIFF: XtConvertCase dpy keysym [k1 k2] -> (list k1 k2)
*/
KeySym k1, k2;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtConvertCase", "Display*");
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg2), arg2, 2, "XtConvertCase", "KeySym");
- XtConvertCase(XEN_TO_C_Display(arg1), XEN_TO_C_KeySym(arg2), &k1, &k2);
- return(XEN_LIST_2(C_TO_XEN_KeySym(k1),
- C_TO_XEN_KeySym(k2)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtConvertCase", "Display*");
+ Xen_check_type(Xen_is_KeySym(arg2), arg2, 2, "XtConvertCase", "KeySym");
+ XtConvertCase(Xen_to_C_Display(arg1), Xen_to_C_KeySym(arg2), &k1, &k2);
+ return(Xen_list_2(C_to_Xen_KeySym(k1),
+ C_to_Xen_KeySym(k2)));
}
/* -------- case converter -------- */
/* (424) convert case XtRegisterCaseConverter global */
-static XEN xm_XtCaseProc;
+static Xen xm_XtCaseProc;
static void gxm_XtCaseProc(Display* d, KeySym k1, KeySym* k2, KeySym* k3)
{
- XEN val;
+ Xen val;
int loc;
- val = XEN_CALL_2(xm_XtCaseProc,
- C_TO_XEN_Display(d),
- C_TO_XEN_KeySym(k1),
- c__FUNCTION__);
+ val = Xen_call_with_2_args(xm_XtCaseProc,
+ C_to_Xen_Display(d),
+ C_to_Xen_KeySym(k1),
+ __func__);
loc = xm_protect(val);
- if (XEN_LIST_P(val))
+ if (Xen_is_list(val))
{
- (*k2) = XEN_TO_C_KeySym(XEN_CAR(val));
- (*k3) = XEN_TO_C_KeySym(XEN_CADR(val));
+ (*k2) = Xen_to_C_KeySym(Xen_car(val));
+ (*k3) = Xen_to_C_KeySym(Xen_cadr(val));
}
xm_unprotect_at(loc);
}
-static XEN gxm_XtRegisterCaseConverter(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XtRegisterCaseConverter(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
#define H_XtRegisterCaseConverter "void XtRegisterCaseConverter(display, proc, start, stop) registers the specified case converter."
/* DIFF: XtRegisterCaseConverter user XtCaseProc should return the new KeySyms as a list (not as ref args)
*/
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtRegisterCaseConverter", "Display*");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg2) && (XEN_REQUIRED_ARGS_OK(arg2, 2)), arg2, 2, "XtRegisterCaseConverter", "(XtCaseProc dpy keysym)");
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg3), arg3, 3, "XtRegisterCaseConverter", "KeySym");
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg4), arg4, 4, "XtRegisterCaseConverter", "KeySym");
- if (XEN_PROCEDURE_P(xm_XtCaseProc)) xm_unprotect(xm_XtCaseProc);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtRegisterCaseConverter", "Display*");
+ Xen_check_type(Xen_is_procedure(arg2) && (Xen_is_aritable(arg2, 2)), arg2, 2, "XtRegisterCaseConverter", "(XtCaseProc dpy keysym)");
+ Xen_check_type(Xen_is_KeySym(arg3), arg3, 3, "XtRegisterCaseConverter", "KeySym");
+ Xen_check_type(Xen_is_KeySym(arg4), arg4, 4, "XtRegisterCaseConverter", "KeySym");
+ if (Xen_is_procedure(xm_XtCaseProc)) xm_unprotect(xm_XtCaseProc);
xm_protect(arg2);
xm_XtCaseProc = arg2;
- XtRegisterCaseConverter(XEN_TO_C_Display(arg1), gxm_XtCaseProc, XEN_TO_C_KeySym(arg3), XEN_TO_C_KeySym(arg4));
- return(XEN_FALSE);
+ XtRegisterCaseConverter(Xen_to_C_Display(arg1), gxm_XtCaseProc, Xen_to_C_KeySym(arg3), Xen_to_C_KeySym(arg4));
+ return(Xen_false);
}
/* -------- keyproc -------- */
/* (454) XtSetKeyTranslator global */
-static XEN xm_XtKeyProc;
+static Xen xm_XtKeyProc;
static void gxm_XtKeyProc(Display *dpy, KeyCode c, Modifiers m, Modifiers *mp, KeySym *sym)
{
- XEN val;
+ Xen val;
int loc;
- val = XEN_CALL_3(xm_XtKeyProc,
- C_TO_XEN_Display(dpy),
- C_TO_XEN_KeyCode(c),
- C_TO_XEN_Modifiers(m),
- c__FUNCTION__);
+ val = Xen_call_with_3_args(xm_XtKeyProc,
+ C_to_Xen_Display(dpy),
+ C_to_Xen_KeyCode(c),
+ C_to_Xen_Modifiers(m),
+ __func__);
loc = xm_protect(val);
- if (XEN_LIST_P(val))
+ if (Xen_is_list(val))
{
/* KeySym is long, Modifier(s) is int, so these can actually work, I guess */
- (*mp) = XEN_TO_C_Modifiers(XEN_CAR(val));
- (*sym) = XEN_TO_C_KeySym(XEN_CADR(val));
+ (*mp) = Xen_to_C_Modifiers(Xen_car(val));
+ (*sym) = Xen_to_C_KeySym(Xen_cadr(val));
}
else XtTranslateKey(dpy, c, m, mp, sym);
xm_unprotect_at(loc);
}
-static XEN gxm_XtSetKeyTranslator(XEN arg1, XEN arg2)
+static Xen gxm_XtSetKeyTranslator(Xen arg1, Xen arg2)
{
#define H_XtSetKeyTranslator "void XtSetKeyTranslator(display, proc) sets the specified procedure as the current key translator. "
/* DIFF: XtSetKeyTranslator user XtKeyProc should return the new Modifiers and KeySym as a list (not as ref arg), set arg2 #f to get default proc
*/
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtSetKeyTranslator", "Display*");
- XEN_ASSERT_TYPE(XEN_FALSE_P(arg2) || (XEN_PROCEDURE_P(arg2) && (XEN_REQUIRED_ARGS_OK(arg2, 3))), arg2, 2, "XtSetKeyTranslator", "(XtKeyProc dpy key mod)");
- if (XEN_PROCEDURE_P(xm_XtKeyProc)) xm_unprotect(xm_XtKeyProc);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtSetKeyTranslator", "Display*");
+ Xen_check_type(Xen_is_false(arg2) || (Xen_is_procedure(arg2) && (Xen_is_aritable(arg2, 3))), arg2, 2, "XtSetKeyTranslator", "(XtKeyProc dpy key mod)");
+ if (Xen_is_procedure(xm_XtKeyProc)) xm_unprotect(xm_XtKeyProc);
xm_XtKeyProc = arg2;
- if (XEN_FALSE_P(arg2))
- XtSetKeyTranslator(XEN_TO_C_Display(arg1), XtTranslateKey);
+ if (Xen_is_false(arg2))
+ XtSetKeyTranslator(Xen_to_C_Display(arg1), XtTranslateKey);
else
{
xm_protect(arg2);
- XtSetKeyTranslator(XEN_TO_C_Display(arg1), (XtKeyProc)gxm_XtKeyProc);
+ XtSetKeyTranslator(Xen_to_C_Display(arg1), (XtKeyProc)gxm_XtKeyProc);
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtTranslateKey(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtTranslateKey(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtTranslateKey "XtTranslateKey(Display *, XtKeyCode, Modifiers): modifiers and keysym"
/* DIFF: XtTranslateKey omit and rtn last 2 args
*/
Modifiers m;
KeySym k;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtTranslateKey", "Display*");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XtTranslateKey", "KeyCode");
- XEN_ASSERT_TYPE(XEN_Modifiers_P(arg3), arg3, 3, "XtTranslateKey", "Modifiers");
- XtTranslateKey(XEN_TO_C_Display(arg1), XEN_TO_C_KeyCode(arg2), XEN_TO_C_Modifiers(arg3), &m, &k);
- return(XEN_LIST_2(C_TO_XEN_Modifiers(m),
- C_TO_XEN_KeySym(k)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtTranslateKey", "Display*");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XtTranslateKey", "KeyCode");
+ Xen_check_type(Xen_is_Modifiers(arg3), arg3, 3, "XtTranslateKey", "Modifiers");
+ XtTranslateKey(Xen_to_C_Display(arg1), Xen_to_C_KeyCode(arg2), Xen_to_C_Modifiers(arg3), &m, &k);
+ return(Xen_list_2(C_to_Xen_Modifiers(m),
+ C_to_Xen_KeySym(k)));
}
-static XEN gxm_XtTranslateKeycode(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtTranslateKeycode(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtTranslateKeycode "void XtTranslateKeycode(display, keycode, modifiers) passes the specified \
arguments directly to the currently registered KeyCode to KeySym translator, returns (modifiers keysym)."
@@ -16067,123 +15820,123 @@ arguments directly to the currently registered KeyCode to KeySym translator, ret
*/
Modifiers m;
KeySym k;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtTranslateKeycode", "Display*");
- XEN_ASSERT_TYPE(XEN_KeyCode_P(arg2), arg2, 2, "XtTranslateKeycode", "KeyCode");
- XEN_ASSERT_TYPE(XEN_Modifiers_P(arg3), arg3, 3, "XtTranslateKeycode", "Modifiers");
- XtTranslateKeycode(XEN_TO_C_Display(arg1), XEN_TO_C_KeyCode(arg2), XEN_TO_C_Modifiers(arg3), &m, &k);
- return(XEN_LIST_2(C_TO_XEN_Modifiers(m),
- C_TO_XEN_KeySym(k)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtTranslateKeycode", "Display*");
+ Xen_check_type(Xen_is_KeyCode(arg2), arg2, 2, "XtTranslateKeycode", "KeyCode");
+ Xen_check_type(Xen_is_Modifiers(arg3), arg3, 3, "XtTranslateKeycode", "Modifiers");
+ XtTranslateKeycode(Xen_to_C_Display(arg1), Xen_to_C_KeyCode(arg2), Xen_to_C_Modifiers(arg3), &m, &k);
+ return(Xen_list_2(C_to_Xen_Modifiers(m),
+ C_to_Xen_KeySym(k)));
}
-static XEN gxm_XtGetActionKeysym(XEN arg1)
+static Xen gxm_XtGetActionKeysym(Xen arg1)
{
#define H_XtGetActionKeysym "KeySym XtGetActionKeysym(event): (keysym modifiers)"
/* DIFF: XtGetActionKeysym omit and rtn last arg
*/
Modifiers m;
KeySym k;
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg1), arg1, 1, "XtGetActionKeysym", "XEvent*");
- k = XtGetActionKeysym(XEN_TO_C_XEvent(arg1), &m);
- return(XEN_LIST_2(C_TO_XEN_KeySym(k),
- C_TO_XEN_Modifiers(m)));
+ Xen_check_type(Xen_is_XEvent(arg1), arg1, 1, "XtGetActionKeysym", "XEvent*");
+ k = XtGetActionKeysym(Xen_to_C_XEvent(arg1), &m);
+ return(Xen_list_2(C_to_Xen_KeySym(k),
+ C_to_Xen_Modifiers(m)));
}
-static XEN gxm_XtGetResourceList(XEN widget_class)
+static Xen gxm_XtGetResourceList(Xen widget_class)
{
#define H_XtGetResourceList "XtGetResourceList(widget-class): returns the widget class's resource list"
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
Cardinal len = 0;
- int i;
XtResourceList resources;
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(widget_class), widget_class, 1, "XtGetResourceList", "WidgetClass");
- XtGetResourceList(XEN_TO_C_WidgetClass(widget_class), &resources, &len);
+ Xen_check_type(Xen_is_WidgetClass(widget_class), widget_class, 1, "XtGetResourceList", "WidgetClass");
+ XtGetResourceList(Xen_to_C_WidgetClass(widget_class), &resources, &len);
if (len > 0)
{
+ int i;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(XEN_LIST_7(C_TO_XEN_STRING(resources[i].resource_name),
- C_TO_XEN_STRING(resources[i].resource_class),
- C_TO_XEN_STRING(resources[i].resource_type),
- C_TO_XEN_INT((int)(resources[i].resource_size)),
- C_TO_XEN_INT((int)(resources[i].resource_offset)),
- C_TO_XEN_STRING(resources[i].default_type),
- XEN_WRAP_C_POINTER(resources[i].default_addr)),
+ lst = Xen_cons(Xen_list_7(C_string_to_Xen_string(resources[i].resource_name),
+ C_string_to_Xen_string(resources[i].resource_class),
+ C_string_to_Xen_string(resources[i].resource_type),
+ C_int_to_Xen_integer((int)(resources[i].resource_size)),
+ C_int_to_Xen_integer((int)(resources[i].resource_offset)),
+ C_string_to_Xen_string(resources[i].default_type),
+ Xen_wrap_C_pointer(resources[i].default_addr)),
lst);
XtFree((char *)resources);
}
return(lst);
}
-static XEN gxm_XtGetMultiClickTime(XEN arg1)
+static Xen gxm_XtGetMultiClickTime(Xen arg1)
{
#define H_XtGetMultiClickTime "int XtGetMultiClickTime(display): returns the time in milliseconds that the translation manager uses to \
determine if multiple events are to be interpreted as a repeated event "
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtGetMultiClickTime", "Display*");
- return(C_TO_XEN_INT(XtGetMultiClickTime(XEN_TO_C_Display(arg1))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtGetMultiClickTime", "Display*");
+ return(C_int_to_Xen_integer(XtGetMultiClickTime(Xen_to_C_Display(arg1))));
}
-static XEN gxm_XtSetMultiClickTime(XEN arg1, XEN arg2)
+static Xen gxm_XtSetMultiClickTime(Xen arg1, Xen arg2)
{
#define H_XtSetMultiClickTime "void XtSetMultiClickTime(display, time) sets the time interval used by the translation manager to determine \
when multiple events are interpreted as a repeated event."
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtSetMultiClickTime", "Display*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg2), arg2, 2, "XtSetMultiClickTime", "int");
- XtSetMultiClickTime(XEN_TO_C_Display(arg1), XEN_TO_C_INT(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtSetMultiClickTime", "Display*");
+ Xen_check_type(Xen_is_integer(arg2), arg2, 2, "XtSetMultiClickTime", "int");
+ XtSetMultiClickTime(Xen_to_C_Display(arg1), Xen_integer_to_C_int(arg2));
+ return(Xen_false);
}
-static XEN register_proc;
+static Xen register_proc;
static void gxm_XtRegisterGrabActionProc(Widget w, XEvent* e, String* s, Cardinal* c)
{
- XEN_CALL_3(register_proc,
- C_TO_XEN_Widget(w),
- C_TO_XEN_XEvent(e),
- C_TO_XEN_Strings(s, *c),
- c__FUNCTION__);
+ Xen_call_with_3_args(register_proc,
+ C_to_Xen_Widget(w),
+ C_to_Xen_XEvent(e),
+ C_to_Xen_Strings(s, *c),
+ __func__);
}
-static XEN gxm_XtRegisterGrabAction(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtRegisterGrabAction(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtRegisterGrabAction "void XtRegisterGrabAction(action_proc, owner_events, event_mask, pointer_mode, keyboard_mode) adds the \
specified action_proc to a list known to the translation manager."
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg1) && (XEN_REQUIRED_ARGS_OK(arg1, 3)), arg1, 1, "XtRegisterGrabAction", "XtActionProc");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(arg2), arg2, 2, "XtRegisterGrabAction", "boolean");
- XEN_ASSERT_TYPE(XEN_ULONG_P(arg3), arg3, 3, "XtRegisterGrabAction", "unsigned int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg4), arg4, 4, "XtRegisterGrabAction", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(arg5), arg5, 5, "XtRegisterGrabAction", "int");
+ Xen_check_type(Xen_is_procedure(arg1) && (Xen_is_aritable(arg1, 3)), arg1, 1, "XtRegisterGrabAction", "XtActionProc");
+ Xen_check_type(Xen_is_boolean(arg2), arg2, 2, "XtRegisterGrabAction", "boolean");
+ Xen_check_type(Xen_is_ulong(arg3), arg3, 3, "XtRegisterGrabAction", "unsigned int");
+ Xen_check_type(Xen_is_integer(arg4), arg4, 4, "XtRegisterGrabAction", "int");
+ Xen_check_type(Xen_is_integer(arg5), arg5, 5, "XtRegisterGrabAction", "int");
xm_protect(arg1);
register_proc = arg1;
- XtRegisterGrabAction(gxm_XtRegisterGrabActionProc, XEN_TO_C_BOOLEAN(arg2), XEN_TO_C_ULONG(arg3), XEN_TO_C_INT(arg4), XEN_TO_C_INT(arg5));
- return(XEN_FALSE);
+ XtRegisterGrabAction(gxm_XtRegisterGrabActionProc, Xen_boolean_to_C_bool(arg2), Xen_ulong_to_C_ulong(arg3), Xen_integer_to_C_int(arg4), Xen_integer_to_C_int(arg5));
+ return(Xen_false);
}
-static XEN gxm_XtCallActionProc(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XtCallActionProc(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
#define H_XtCallActionProc "void XtCallActionProc(widget, action, event, params, num_params) searches for the named action routine in the \
same manner and order as translation tables are bound. If found, the action routine is invoked with the specified widget, event pointer, \
and parameters."
char **params = NULL;
int i, len = 0;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCallActionProc", "Widget");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XtCallActionProc", "char*");
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg3) || XEN_FALSE_P(arg3), arg3, 3, "XtCallActionProc", "XEvent*");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg4) || XEN_FALSE_P(arg4), arg4, 4, "XtCallActionProc", "list of String");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg5), arg5, 5, "XtCallActionProc", "int");
- if (XEN_LIST_P(arg4))
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCallActionProc", "Widget");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XtCallActionProc", "char*");
+ Xen_check_type(Xen_is_XEvent(arg3) || Xen_is_false(arg3), arg3, 3, "XtCallActionProc", "XEvent*");
+ Xen_check_type(Xen_is_list(arg4) || Xen_is_false(arg4), arg4, 4, "XtCallActionProc", "list of String");
+ Xen_check_type(Xen_is_integer_or_unbound(arg5), arg5, 5, "XtCallActionProc", "int");
+ if (Xen_is_list(arg4))
{
- if (XEN_INTEGER_P(arg5))
- len = XEN_TO_C_INT(arg5);
- else len = XEN_LIST_LENGTH(arg4);
+ if (Xen_is_integer(arg5))
+ len = Xen_integer_to_C_int(arg5);
+ else len = Xen_list_length(arg4);
}
if (len > 0)
{
params = (char **)calloc(len, sizeof(char *));
for (i = 0; i < len; i++)
- params[i] = xen_strdup(XEN_TO_C_STRING(XEN_LIST_REF(arg4, i)));
+ params[i] = xen_strdup(Xen_string_to_C_string(Xen_list_ref(arg4, i)));
}
- XtCallActionProc(XEN_TO_C_Widget(arg1),
- (char *)XEN_TO_C_STRING(arg2),
- (XEN_XEvent_P(arg3)) ? XEN_TO_C_XEvent(arg3) : NULL,
+ XtCallActionProc(Xen_to_C_Widget(arg1),
+ (char *)Xen_string_to_C_string(arg2),
+ (Xen_is_XEvent(arg3)) ? Xen_to_C_XEvent(arg3) : NULL,
params, len);
if (params)
{
@@ -16191,39 +15944,39 @@ and parameters."
if (params[i]) free(params[i]);
free(params);
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtGetActionList(XEN arg1)
+static Xen gxm_XtGetActionList(Xen arg1)
{
#define H_XtGetActionList "void XtGetActionList(widget_class): list of actions"
/* DIFF: XtGetActionList omit arg2 and 3, return list of lists
*/
unsigned int len;
XtActionList act;
- XEN lst = XEN_EMPTY_LIST;
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg1), arg1, 1, "XtGetActionList", "WidgetClass");
- XtGetActionList(XEN_TO_C_WidgetClass(arg1), &act, &len);
+ Xen lst = Xen_empty_list;
+ Xen_check_type(Xen_is_WidgetClass(arg1), arg1, 1, "XtGetActionList", "WidgetClass");
+ XtGetActionList(Xen_to_C_WidgetClass(arg1), &act, &len);
if (len > 0)
{
int i;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(XEN_LIST_2(C_TO_XEN_STRING(act[i].string),
- C_TO_XEN_ULONG(act[i].proc)),
+ lst = Xen_cons(Xen_list_2(C_string_to_Xen_string(act[i].string),
+ C_ulong_to_Xen_ulong(act[i].proc)),
lst);
free(act);
}
return(lst);
}
-#define C_TO_XEN_XM_ActionHook(Code, Context) \
- XEN_LIST_5(C_STRING_TO_XEN_SYMBOL("ActionHook"), Code, Context, XEN_ZERO, XEN_ZERO)
-#define XM_ActionHook_P(Arg) WRAP_P("ActionHook", Arg)
+#define C_to_Xen_XM_ActionHook(Code, Context) \
+ Xen_list_5(C_string_to_Xen_symbol("ActionHook"), Code, Context, Xen_integer_zero, Xen_integer_zero)
+#define XM_is_ActionHook(Arg) is_wrapped("ActionHook", Arg)
-static bool unprotect_actionhook(XEN val, int loc, unsigned long id)
+static bool unprotect_actionhook(Xen val, int loc, unsigned long id)
{
- if ((XM_ActionHook_P(val)) &&
- ((XtActionHookId)XEN_TO_C_ULONG(XEN_LIST_REF(val, 4)) == (XtActionHookId)id))
+ if ((XM_is_ActionHook(val)) &&
+ ((XtActionHookId)Xen_ulong_to_C_ulong(Xen_list_ref(val, 4)) == (XtActionHookId)id))
{
xm_unprotect_at(loc);
return(true);
@@ -16231,47 +15984,47 @@ static bool unprotect_actionhook(XEN val, int loc, unsigned long id)
return(false);
}
-static XEN gxm_XtRemoveActionHook(XEN arg1)
+static Xen gxm_XtRemoveActionHook(Xen arg1)
{
#define H_XtRemoveActionHook "void XtRemoveActionHook(idP) removes the specified action hook procedure from the list in which it was registered."
XtActionHookId id;
- XEN_ASSERT_TYPE(XEN_XtActionHookId_P(arg1), arg1, 1, "XtRemoveActionHook", "XtActionHookId");
- id = XEN_TO_C_XtActionHookId(arg1);
+ Xen_check_type(Xen_is_XtActionHookId(arg1), arg1, 1, "XtRemoveActionHook", "XtActionHookId");
+ id = Xen_to_C_XtActionHookId(arg1);
XtRemoveActionHook(id);
map_over_protected_elements(unprotect_actionhook, (unsigned long)id);
- return(XEN_FALSE);
+ return(Xen_false);
}
static void gxm_XtActionHookProc(Widget w, XtPointer p, String s, XEvent* e, String* s1, Cardinal* c)
{
/* DIFF: XtActionHookProc takes 5 args (last is string list)
*/
- XEN descr = (XEN)p;
+ Xen descr = (Xen)p;
/* (list 'ActionHook function context gc-loc id) */
- XEN_CALL_5(XEN_CADR(descr),
- C_TO_XEN_Widget(w),
- XEN_CADDR(descr),
- C_TO_XEN_STRING(s),
- C_TO_XEN_XEvent(e),
- C_TO_XEN_Strings(s1, *c),
- c__FUNCTION__);
+ Xen_call_with_5_args(Xen_cadr(descr),
+ C_to_Xen_Widget(w),
+ Xen_caddr(descr),
+ C_string_to_Xen_string(s),
+ C_to_Xen_XEvent(e),
+ C_to_Xen_Strings(s1, *c),
+ __func__);
}
-static XEN gxm_XtAppAddActionHook(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtAppAddActionHook(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtAppAddActionHook "XtActionHookId XtAppAddActionHook(app_context, proc, client_data) adds the specified procedure to the front of \
a list maintained in the application context."
XtActionHookId id;
int gc_loc;
- XEN descr;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppAddActionHook", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg2) && (XEN_REQUIRED_ARGS_OK(arg2, 5)), arg2, 2, "XtAppAddActionHook", "XtActionHookProc");
- descr = C_TO_XEN_XM_ActionHook(arg2, (XEN_BOUND_P(arg3)) ? arg3 : XEN_FALSE);
+ Xen descr;
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppAddActionHook", "XtAppContext");
+ Xen_check_type(Xen_is_procedure(arg2) && (Xen_is_aritable(arg2, 5)), arg2, 2, "XtAppAddActionHook", "XtActionHookProc");
+ descr = C_to_Xen_XM_ActionHook(arg2, (Xen_is_bound(arg3)) ? arg3 : Xen_false);
gc_loc = xm_protect(descr);
- id = XtAppAddActionHook(XEN_TO_C_XtAppContext(arg1), gxm_XtActionHookProc, (XtPointer)descr);
- XEN_LIST_SET(descr, 3, C_TO_XEN_INT(gc_loc));
- XEN_LIST_SET(descr, 4, C_TO_XEN_ULONG(id));
- return(C_TO_XEN_XtActionHookId(id));
+ id = XtAppAddActionHook(Xen_to_C_XtAppContext(arg1), gxm_XtActionHookProc, (XtPointer)descr);
+ Xen_list_set(descr, 3, C_int_to_Xen_integer(gc_loc));
+ Xen_list_set(descr, 4, C_ulong_to_Xen_ulong(id));
+ return(C_to_Xen_XtActionHookId(id));
}
@@ -16290,38 +16043,38 @@ a list maintained in the application context."
* struct _XtStateRec *current_state;
*/
-static XEN xtactionprocs[9];
+static Xen xtactionprocs[9];
static void gxm_XtActionProc0(Widget w, XEvent *e, char **args, Cardinal *argn)
{
- XEN_CALL_3(xtactionprocs[0], C_TO_XEN_Widget(w), C_TO_XEN_XEvent(e), C_TO_XEN_Strings(args, *argn), c__FUNCTION__);
+ Xen_call_with_3_args(xtactionprocs[0], C_to_Xen_Widget(w), C_to_Xen_XEvent(e), C_to_Xen_Strings(args, *argn), __func__);
}
static void gxm_XtActionProc1(Widget w, XEvent *e, char **args, Cardinal *argn)
{
- XEN_CALL_3(xtactionprocs[1], C_TO_XEN_Widget(w), C_TO_XEN_XEvent(e), C_TO_XEN_Strings(args, *argn), c__FUNCTION__);
+ Xen_call_with_3_args(xtactionprocs[1], C_to_Xen_Widget(w), C_to_Xen_XEvent(e), C_to_Xen_Strings(args, *argn), __func__);
}
static void gxm_XtActionProc2(Widget w, XEvent *e, char **args, Cardinal *argn)
{
- XEN_CALL_3(xtactionprocs[2], C_TO_XEN_Widget(w), C_TO_XEN_XEvent(e), C_TO_XEN_Strings(args, *argn), c__FUNCTION__);
+ Xen_call_with_3_args(xtactionprocs[2], C_to_Xen_Widget(w), C_to_Xen_XEvent(e), C_to_Xen_Strings(args, *argn), __func__);
}
static void gxm_XtActionProc3(Widget w, XEvent *e, char **args, Cardinal *argn)
{
- XEN_CALL_3(xtactionprocs[3], C_TO_XEN_Widget(w), C_TO_XEN_XEvent(e), C_TO_XEN_Strings(args, *argn), c__FUNCTION__);
+ Xen_call_with_3_args(xtactionprocs[3], C_to_Xen_Widget(w), C_to_Xen_XEvent(e), C_to_Xen_Strings(args, *argn), __func__);
}
static void gxm_XtActionProc4(Widget w, XEvent *e, char **args, Cardinal *argn)
{
- XEN_CALL_3(xtactionprocs[4], C_TO_XEN_Widget(w), C_TO_XEN_XEvent(e), C_TO_XEN_Strings(args, *argn), c__FUNCTION__);
+ Xen_call_with_3_args(xtactionprocs[4], C_to_Xen_Widget(w), C_to_Xen_XEvent(e), C_to_Xen_Strings(args, *argn), __func__);
}
static void gxm_XtActionProc5(Widget w, XEvent *e, char **args, Cardinal *argn)
{
- XEN_CALL_3(xtactionprocs[5], C_TO_XEN_Widget(w), C_TO_XEN_XEvent(e), C_TO_XEN_Strings(args, *argn), c__FUNCTION__);
+ Xen_call_with_3_args(xtactionprocs[5], C_to_Xen_Widget(w), C_to_Xen_XEvent(e), C_to_Xen_Strings(args, *argn), __func__);
}
static void gxm_XtActionProc6(Widget w, XEvent *e, char **args, Cardinal *argn)
{
- XEN_CALL_3(xtactionprocs[6], C_TO_XEN_Widget(w), C_TO_XEN_XEvent(e), C_TO_XEN_Strings(args, *argn), c__FUNCTION__);
+ Xen_call_with_3_args(xtactionprocs[6], C_to_Xen_Widget(w), C_to_Xen_XEvent(e), C_to_Xen_Strings(args, *argn), __func__);
}
static void gxm_XtActionProc7(Widget w, XEvent *e, char **args, Cardinal *argn)
{
- XEN_CALL_3(xtactionprocs[7], C_TO_XEN_Widget(w), C_TO_XEN_XEvent(e), C_TO_XEN_Strings(args, *argn), c__FUNCTION__);
+ Xen_call_with_3_args(xtactionprocs[7], C_to_Xen_Widget(w), C_to_Xen_XEvent(e), C_to_Xen_Strings(args, *argn), __func__);
}
static void gxm_XtActionProc8(Widget w, XEvent *e, char **args, Cardinal *argn)
{
@@ -16329,25 +16082,25 @@ static void gxm_XtActionProc8(Widget w, XEvent *e, char **args, Cardinal *argn)
}
static int xm_action_ctr = 0;
-static XtActionsRec *make_action_rec(int len, XEN larg2)
+static XtActionsRec *make_action_rec(int len, Xen larg2)
{
int i, gcloc;
XtActionsRec *act;
- XEN arg2;
- arg2 = XEN_COPY_ARG(larg2);
+ Xen arg2;
+ arg2 = Xen_copy_arg(larg2);
gcloc = xm_protect(arg2);
act = (XtActionsRec *)calloc(len, sizeof(XtActionsRec));
- for (i = 0; i < len; i++, arg2 = XEN_CDR(arg2))
+ for (i = 0; i < len; i++, arg2 = Xen_cdr(arg2))
{
- XEN pair;
- pair = XEN_CAR(arg2);
- act[i].string = (String)xen_strdup(XEN_TO_C_STRING(XEN_CAR(pair)));
+ Xen pair;
+ pair = Xen_car(arg2);
+ act[i].string = (String)xen_strdup(Xen_string_to_C_string(Xen_car(pair)));
if (xm_action_ctr >= 8)
{
fprintf(stderr,"too many actions...");
act[i].proc = (XtActionProc)gxm_XtActionProc8;
- xm_protect(XEN_CADR(pair));
- xtactionprocs[8] = XEN_CADR(pair);
+ xm_protect(Xen_cadr(pair));
+ xtactionprocs[8] = Xen_cadr(pair);
}
else
{
@@ -16362,15 +16115,15 @@ static XtActionsRec *make_action_rec(int len, XEN larg2)
case 6: act[i].proc = (XtActionProc)gxm_XtActionProc6; break;
case 7: act[i].proc = (XtActionProc)gxm_XtActionProc7; break;
}
- xm_protect(XEN_CADR(pair));
- xtactionprocs[xm_action_ctr++] = XEN_CADR(pair);
+ xm_protect(Xen_cadr(pair));
+ xtactionprocs[xm_action_ctr++] = Xen_cadr(pair);
}
}
xm_unprotect_at(gcloc);
return(act);
}
-static XEN gxm_XtAppAddActions(XEN arg1, XEN arg2)
+static Xen gxm_XtAppAddActions(Xen arg1, Xen arg2)
{
#define H_XtAppAddActions "void XtAppAddActions(app_context, actions, num_actions) adds the specified action table and registers it \
with the translation manager."
@@ -16379,81 +16132,81 @@ with the translation manager."
*/
XtActionsRec *act;
int i, len;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppAddActions", "XtAppContext");
- XEN_ASSERT_TYPE(XEN_LIST_P(arg2), arg2, 2, "XtAppAddActions", "list of XtActions");
- len = XEN_LIST_LENGTH(arg2);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg2, 2, "XtAppAddActions", "positive integer");
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppAddActions", "XtAppContext");
+ Xen_check_type(Xen_is_list(arg2), arg2, 2, "XtAppAddActions", "list of XtActions");
+ len = Xen_list_length(arg2);
+ if (len <= 0) Xen_check_type(0, arg2, 2, "XtAppAddActions", "positive integer");
act = make_action_rec(len, arg2);
- XtAppAddActions(XEN_TO_C_XtAppContext(arg1), act, len);
+ XtAppAddActions(Xen_to_C_XtAppContext(arg1), act, len);
for (i = 0; i < len; i++)
if (act[i].string) free(act[i].string);
free(act);
return(arg1);
}
-static XEN gxm_XtUninstallTranslations(XEN arg1)
+static Xen gxm_XtUninstallTranslations(Xen arg1)
{
#define H_XtUninstallTranslations "void XtUninstallTranslations(w) causes the entire translation table for widget to be removed."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtUninstallTranslations", "Widget");
- XtUninstallTranslations(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtUninstallTranslations", "Widget");
+ XtUninstallTranslations(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtInstallAllAccelerators(XEN arg1, XEN arg2)
+static Xen gxm_XtInstallAllAccelerators(Xen arg1, Xen arg2)
{
#define H_XtInstallAllAccelerators "void XtInstallAllAccelerators(destination, source)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtInstallAllAccelerators", "Widget");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg2), arg2, 2, "XtInstallAllAccelerators", "Widget");
- XtInstallAllAccelerators(XEN_TO_C_Widget(arg1), XEN_TO_C_Widget(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtInstallAllAccelerators", "Widget");
+ Xen_check_type(Xen_is_Widget(arg2), arg2, 2, "XtInstallAllAccelerators", "Widget");
+ XtInstallAllAccelerators(Xen_to_C_Widget(arg1), Xen_to_C_Widget(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtInstallAccelerators(XEN arg1, XEN arg2)
+static Xen gxm_XtInstallAccelerators(Xen arg1, Xen arg2)
{
#define H_XtInstallAccelerators "void XtInstallAccelerators(destination, source) installs the accelerators from source onto destination by \
augmenting the destination translations with the source accelerators."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtInstallAccelerators", "Widget");
- XEN_ASSERT_TYPE(XEN_Widget_P(arg2), arg2, 2, "XtInstallAccelerators", "Widget");
- XtInstallAccelerators(XEN_TO_C_Widget(arg1), XEN_TO_C_Widget(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtInstallAccelerators", "Widget");
+ Xen_check_type(Xen_is_Widget(arg2), arg2, 2, "XtInstallAccelerators", "Widget");
+ XtInstallAccelerators(Xen_to_C_Widget(arg1), Xen_to_C_Widget(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtAugmentTranslations(XEN arg1, XEN arg2)
+static Xen gxm_XtAugmentTranslations(Xen arg1, Xen arg2)
{
#define H_XtAugmentTranslations "void XtAugmentTranslations(w, translations) nondestructively merges the new translations into the existing \
widget translations."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtAugmentTranslations", "Widget");
- XEN_ASSERT_TYPE(XEN_XtTranslations_P(arg2), arg2, 2, "XtAugmentTranslations", "XtTranslations");
- XtAugmentTranslations(XEN_TO_C_Widget(arg1), XEN_TO_C_XtTranslations(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtAugmentTranslations", "Widget");
+ Xen_check_type(Xen_is_XtTranslations(arg2), arg2, 2, "XtAugmentTranslations", "XtTranslations");
+ XtAugmentTranslations(Xen_to_C_Widget(arg1), Xen_to_C_XtTranslations(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtOverrideTranslations(XEN arg1, XEN arg2)
+static Xen gxm_XtOverrideTranslations(Xen arg1, Xen arg2)
{
#define H_XtOverrideTranslations "void XtOverrideTranslations(w, translations) destructively merges the new translations into the existing \
widget translations."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtOverrideTranslations", "Widget");
- XEN_ASSERT_TYPE(XEN_XtTranslations_P(arg2), arg2, 2, "XtOverrideTranslations", "XtTranslations");
- XtOverrideTranslations(XEN_TO_C_Widget(arg1), XEN_TO_C_XtTranslations(arg2));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtOverrideTranslations", "Widget");
+ Xen_check_type(Xen_is_XtTranslations(arg2), arg2, 2, "XtOverrideTranslations", "XtTranslations");
+ XtOverrideTranslations(Xen_to_C_Widget(arg1), Xen_to_C_XtTranslations(arg2));
+ return(Xen_false);
}
-static XEN gxm_XtParseAcceleratorTable(XEN arg1)
+static Xen gxm_XtParseAcceleratorTable(Xen arg1)
{
#define H_XtParseAcceleratorTable "XtAccelerators XtParseAcceleratorTable(const char *source) compiles source"
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtParseAcceleratorTable", "char*");
- return(C_TO_XEN_ULONG(XtParseAcceleratorTable((char *)XEN_TO_C_STRING(arg1))));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtParseAcceleratorTable", "char*");
+ return(C_ulong_to_Xen_ulong(XtParseAcceleratorTable((char *)Xen_string_to_C_string(arg1))));
}
-static XEN gxm_XtParseTranslationTable(XEN arg1)
+static Xen gxm_XtParseTranslationTable(Xen arg1)
{
#define H_XtParseTranslationTable "XtTranslations XtParseTranslationTable(table) compiles the translation table into the opaque internal \
representation of type XtTranslations."
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XtParseTranslationTable", "char*");
- return(C_TO_XEN_XtTranslations(XtParseTranslationTable((char *)XEN_TO_C_STRING(arg1))));
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XtParseTranslationTable", "char*");
+ return(C_to_Xen_XtTranslations(XtParseTranslationTable((char *)Xen_string_to_C_string(arg1))));
}
-static XEN gxm_XtKeysymToKeycodeList(XEN arg1, XEN arg2)
+static Xen gxm_XtKeysymToKeycodeList(Xen arg1, Xen arg2)
{
#define H_XtKeysymToKeycodeList "void XtKeysymToKeycodeList(display, keysym) procedure returns all the \
KeyCodes that have keysym in their entry for the keyboard mapping table associated with display -> (keycodes)."
@@ -16461,74 +16214,74 @@ KeyCodes that have keysym in their entry for the keyboard mapping table associat
*/
unsigned int len;
KeyCode *kr;
- XEN lst = XEN_EMPTY_LIST;
+ Xen lst = Xen_empty_list;
int loc;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XtKeysymToKeycodeList", "Display*");
- XEN_ASSERT_TYPE(XEN_KeySym_P(arg2), arg2, 2, "XtKeysymToKeycodeList", "KeySym");
- XtKeysymToKeycodeList(XEN_TO_C_Display(arg1), XEN_TO_C_KeySym(arg2), &kr, &len);
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XtKeysymToKeycodeList", "Display*");
+ Xen_check_type(Xen_is_KeySym(arg2), arg2, 2, "XtKeysymToKeycodeList", "KeySym");
+ XtKeysymToKeycodeList(Xen_to_C_Display(arg1), Xen_to_C_KeySym(arg2), &kr, &len);
loc = xm_protect(lst);
if (len > 0)
{
int i;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(C_TO_XEN_KeyCode(kr[i]), lst);
+ lst = Xen_cons(C_to_Xen_KeyCode(kr[i]), lst);
free(kr);
}
xm_unprotect_at(loc);
return(lst);
}
-static XEN gxm_XtTranslateCoords(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtTranslateCoords(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtTranslateCoords "void XtTranslateCoords(w, x, y): (root_x root_y)"
/* DIFF: XtTranslateCoords omits and returns last 2 args
*/
Position x, y;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtTranslateCoords", "Widget");
- XEN_ASSERT_TYPE(XEN_Position_P(arg2), arg2, 2, "XtTranslateCoords", "Position");
- XEN_ASSERT_TYPE(XEN_Position_P(arg3), arg3, 3, "XtTranslateCoords", "Position");
- XtTranslateCoords(XEN_TO_C_Widget(arg1), XEN_TO_C_Position(arg2), XEN_TO_C_Position(arg3), &x, &y);
- return(XEN_LIST_2(C_TO_XEN_Position(x),
- C_TO_XEN_Position(y)));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtTranslateCoords", "Widget");
+ Xen_check_type(Xen_is_Position(arg2), arg2, 2, "XtTranslateCoords", "Position");
+ Xen_check_type(Xen_is_Position(arg3), arg3, 3, "XtTranslateCoords", "Position");
+ XtTranslateCoords(Xen_to_C_Widget(arg1), Xen_to_C_Position(arg2), Xen_to_C_Position(arg3), &x, &y);
+ return(Xen_list_2(C_to_Xen_Position(x),
+ C_to_Xen_Position(y)));
}
-static XEN gxm_XtMakeResizeRequest(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtMakeResizeRequest(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtMakeResizeRequest "XtGeometryResult XtMakeResizeRequest(w, width, height): (res width height)"
/* DIFF: XtMakeResizeRequest w wid hgt [rtnw rtn] -> (list res w h)
*/
Dimension w, h;
int val;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtMakeResizeRequest", "Widget");
- XEN_ASSERT_TYPE(XEN_Dimension_P(arg2), arg2, 2, "XtMakeResizeRequest", "Dimension");
- XEN_ASSERT_TYPE(XEN_Dimension_P(arg3), arg3, 3, "XtMakeResizeRequest", "Dimension");
- val = XtMakeResizeRequest(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Dimension(arg2),
- XEN_TO_C_Dimension(arg3),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtMakeResizeRequest", "Widget");
+ Xen_check_type(Xen_is_Dimension(arg2), arg2, 2, "XtMakeResizeRequest", "Dimension");
+ Xen_check_type(Xen_is_Dimension(arg3), arg3, 3, "XtMakeResizeRequest", "Dimension");
+ val = XtMakeResizeRequest(Xen_to_C_Widget(arg1),
+ Xen_to_C_Dimension(arg2),
+ Xen_to_C_Dimension(arg3),
&w, &h);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_Dimension(w),
- C_TO_XEN_Dimension(h)));
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_to_Xen_Dimension(w),
+ C_to_Xen_Dimension(h)));
}
-static XEN gxm_XtOwnSelectionIncremental(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6, XEN arg7, XEN arg8)
+static Xen gxm_XtOwnSelectionIncremental(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6, Xen arg7, Xen arg8)
{
#define H_XtOwnSelectionIncremental "Boolean XtOwnSelectionIncremental(w, selection, time, convert_callback, lose_callback, \
done_callback, cancel_callback, client_data)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtOwnSelectionIncremental", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtOwnSelectionIncremental", "Atom");
- XEN_ASSERT_TYPE(XEN_Time_P(arg3), arg3, 3, "XtOwnSelectionIncremental", "Time");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 10)), arg4, 4, "XtOwnSelectionIncremental", "XtConvertSelectionIncrProc");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg5) && (XEN_REQUIRED_ARGS_OK(arg5, 3)), arg5, 5, "XtOwnSelectionIncremental", "XtLoseSelectionIncrProc");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg6) && (XEN_REQUIRED_ARGS_OK(arg6, 5)), arg6, 6, "XtOwnSelectionIncremental", "XtSelectionDoneIncrProc");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg7) && (XEN_REQUIRED_ARGS_OK(arg7, 5)), arg7, 7, "XtOwnSelectionIncremental", "XtCancelConvertSelectionProc");
- add_selmap(XEN_TO_C_Widget(arg1), CONVERT_INCR, arg4);
- add_selmap(XEN_TO_C_Widget(arg1), LOSE_INCR, arg5);
- add_selmap(XEN_TO_C_Widget(arg1), DONE_INCR, arg6);
- add_selmap(XEN_TO_C_Widget(arg1), CANCEL_CONVERT, arg7);
- return(C_TO_XEN_BOOLEAN(XtOwnSelectionIncremental(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Atom(arg2),
- XEN_TO_C_Time(arg3),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtOwnSelectionIncremental", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtOwnSelectionIncremental", "Atom");
+ Xen_check_type(Xen_is_Time(arg3), arg3, 3, "XtOwnSelectionIncremental", "Time");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 10)), arg4, 4, "XtOwnSelectionIncremental", "XtConvertSelectionIncrProc");
+ Xen_check_type(Xen_is_procedure(arg5) && (Xen_is_aritable(arg5, 3)), arg5, 5, "XtOwnSelectionIncremental", "XtLoseSelectionIncrProc");
+ Xen_check_type(Xen_is_procedure(arg6) && (Xen_is_aritable(arg6, 5)), arg6, 6, "XtOwnSelectionIncremental", "XtSelectionDoneIncrProc");
+ Xen_check_type(Xen_is_procedure(arg7) && (Xen_is_aritable(arg7, 5)), arg7, 7, "XtOwnSelectionIncremental", "XtCancelConvertSelectionProc");
+ add_selmap(Xen_to_C_Widget(arg1), CONVERT_INCR, arg4);
+ add_selmap(Xen_to_C_Widget(arg1), LOSE_INCR, arg5);
+ add_selmap(Xen_to_C_Widget(arg1), DONE_INCR, arg6);
+ add_selmap(Xen_to_C_Widget(arg1), CANCEL_CONVERT, arg7);
+ return(C_bool_to_Xen_boolean(XtOwnSelectionIncremental(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2),
+ Xen_to_C_Time(arg3),
(XtConvertSelectionIncrProc)gxm_XtConvertSelectionIncrProc,
gxm_XtLoseSelectionIncrProc,
gxm_XtSelectionDoneIncrProc,
@@ -16536,65 +16289,65 @@ done_callback, cancel_callback, client_data)"
(XtPointer)arg8)));
}
-static XEN gxm_XtOwnSelection(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5, XEN arg6)
+static Xen gxm_XtOwnSelection(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5, Xen arg6)
{
#define H_XtOwnSelection "Boolean XtOwnSelection(w, selection, time, convert_proc, lose_selection, done_proc) informs the selection \
mechanism that a widget believes it owns a selection."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtOwnSelection", "Widget");
- XEN_ASSERT_TYPE(XEN_Atom_P(arg2), arg2, 2, "XtOwnSelection", "Atom");
- XEN_ASSERT_TYPE(XEN_Time_P(arg3), arg3, 3, "XtOwnSelection", "Time");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg4) && (XEN_REQUIRED_ARGS_OK(arg4, 7)), arg4, 4, "XtOwnSelection", "XtConvertSelectionProc");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg5) && (XEN_REQUIRED_ARGS_OK(arg5, 2)), arg5, 5, "XtOwnSelection", "XtLoseSelectionProc");
- XEN_ASSERT_TYPE(XEN_PROCEDURE_P(arg6) && (XEN_REQUIRED_ARGS_OK(arg6, 3)), arg6, 6, "XtOwnSelection", "XtSelectionDoneProc");
- add_selmap(XEN_TO_C_Widget(arg1), CONVERT, arg4);
- add_selmap(XEN_TO_C_Widget(arg1), LOSE, arg5);
- add_selmap(XEN_TO_C_Widget(arg1), DONE, arg6);
- return(C_TO_XEN_BOOLEAN(XtOwnSelection(XEN_TO_C_Widget(arg1),
- XEN_TO_C_Atom(arg2),
- XEN_TO_C_Time(arg3),
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtOwnSelection", "Widget");
+ Xen_check_type(Xen_is_Atom(arg2), arg2, 2, "XtOwnSelection", "Atom");
+ Xen_check_type(Xen_is_Time(arg3), arg3, 3, "XtOwnSelection", "Time");
+ Xen_check_type(Xen_is_procedure(arg4) && (Xen_is_aritable(arg4, 7)), arg4, 4, "XtOwnSelection", "XtConvertSelectionProc");
+ Xen_check_type(Xen_is_procedure(arg5) && (Xen_is_aritable(arg5, 2)), arg5, 5, "XtOwnSelection", "XtLoseSelectionProc");
+ Xen_check_type(Xen_is_procedure(arg6) && (Xen_is_aritable(arg6, 3)), arg6, 6, "XtOwnSelection", "XtSelectionDoneProc");
+ add_selmap(Xen_to_C_Widget(arg1), CONVERT, arg4);
+ add_selmap(Xen_to_C_Widget(arg1), LOSE, arg5);
+ add_selmap(Xen_to_C_Widget(arg1), DONE, arg6);
+ return(C_bool_to_Xen_boolean(XtOwnSelection(Xen_to_C_Widget(arg1),
+ Xen_to_C_Atom(arg2),
+ Xen_to_C_Time(arg3),
(XtConvertSelectionProc)gxm_XtConvertSelectionProc,
gxm_XtLoseSelectionProc,
gxm_XtSelectionDoneProc)));
}
-static XEN gxm_XtIsSensitive(XEN arg1)
+static Xen gxm_XtIsSensitive(Xen arg1)
{
#define H_XtIsSensitive "Boolean XtIsSensitive(w): returns " PROC_TRUE " if user input events are being dispatched."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtIsSensitive", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsSensitive(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtIsSensitive", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsSensitive(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtIsRealized(XEN arg1)
+static Xen gxm_XtIsRealized(Xen arg1)
{
#define H_XtIsRealized "Boolean XtIsRealized(w): returns " PROC_TRUE " if the widget has been realized,"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtIsRealized", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsRealized(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtIsRealized", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsRealized(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtIsManaged(XEN arg1)
+static Xen gxm_XtIsManaged(Xen arg1)
{
#define H_XtIsManaged "Boolean XtIsManaged(widget): returns " PROC_TRUE " if the specified widget is of class RectObj or any subclass thereof and is managed."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtIsManaged", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsManaged(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtIsManaged", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsManaged(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtIsObject(XEN arg1)
+static Xen gxm_XtIsObject(Xen arg1)
{
#define H_XtIsObject "Boolean XtIsObject(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtIsObject", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsObject(XEN_TO_C_Widget(arg1))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtIsObject", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsObject(Xen_to_C_Widget(arg1))));
}
-static XEN gxm_XtIsSubclass(XEN arg1, XEN arg2)
+static Xen gxm_XtIsSubclass(Xen arg1, Xen arg2)
{
#define H_XtIsSubclass "Boolean XtIsSubclass(w, widget_class): returns " PROC_TRUE " if the class of the specified widget is equal to or is a \
subclass of the specified class."
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtIsSubclass", "Widget");
- XEN_ASSERT_TYPE(XEN_WidgetClass_P(arg2), arg2, 2, "XtIsSubclass", "WidgetClass");
- return(C_TO_XEN_BOOLEAN(XtIsSubclass(XEN_TO_C_Widget(arg1), XEN_TO_C_WidgetClass(arg2))));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtIsSubclass", "Widget");
+ Xen_check_type(Xen_is_WidgetClass(arg2), arg2, 2, "XtIsSubclass", "WidgetClass");
+ return(C_bool_to_Xen_boolean(XtIsSubclass(Xen_to_C_Widget(arg1), Xen_to_C_WidgetClass(arg2))));
}
-static XEN gxm_XtAppPeekEvent(XEN arg1)
+static Xen gxm_XtAppPeekEvent(Xen arg1)
{
#define H_XtAppPeekEvent "Boolean XtAppPeekEvent(app_context) fills in the event and returns a nonzero value. If no X \
input is on the queue, XtAppPeekEvent flushes the output buffer and blocks until input is available."
@@ -16602,507 +16355,506 @@ input is on the queue, XtAppPeekEvent flushes the output buffer and blocks until
*/
XEvent *e;
int val;
- XEN_ASSERT_TYPE(XEN_XtAppContext_P(arg1), arg1, 1, "XtAppPeekEvent", "XtAppContext");
+ Xen_check_type(Xen_is_XtAppContext(arg1), arg1, 1, "XtAppPeekEvent", "XtAppContext");
e = (XEvent *)calloc(1, sizeof(XEvent));
- val = XtAppPeekEvent(XEN_TO_C_XtAppContext(arg1), e);
- return(XEN_LIST_2(C_TO_XEN_BOOLEAN(val), C_TO_XEN_XEvent_OBJ(e)));
+ val = XtAppPeekEvent(Xen_to_C_XtAppContext(arg1), e);
+ return(Xen_list_2(C_bool_to_Xen_boolean(val), C_to_Xen_XEvent_OBJ(e)));
}
-static XEN gxm_XtCallAcceptFocus(XEN arg1, XEN arg2)
+static Xen gxm_XtCallAcceptFocus(Xen arg1, Xen arg2)
{
#define H_XtCallAcceptFocus "Boolean XtCallAcceptFocus(w, time) calls the specified widget's accept_focus procedure, passing it the \
specified widget and time, and returns what the accept_focus procedure returns."
/* DIFF: XtCallAcceptFocus takes Time arg (not Time*)
*/
Time tm;
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtCallAcceptFocus", "Widget");
- XEN_ASSERT_TYPE(XEN_Time_P(arg2), arg2, 2, "XtCallAcceptFocus", "Time");
- tm = XEN_TO_C_Time(arg2);
- return(C_TO_XEN_BOOLEAN(XtCallAcceptFocus(XEN_TO_C_Widget(arg1), &tm)));
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtCallAcceptFocus", "Widget");
+ Xen_check_type(Xen_is_Time(arg2), arg2, 2, "XtCallAcceptFocus", "Time");
+ tm = Xen_to_C_Time(arg2);
+ return(C_bool_to_Xen_boolean(XtCallAcceptFocus(Xen_to_C_Widget(arg1), &tm)));
}
-static XEN gxm_XtDispatchEvent(XEN arg1)
+static Xen gxm_XtDispatchEvent(Xen arg1)
{
#define H_XtDispatchEvent "Boolean XtDispatchEvent(event) sends those events to the event handler functions that have been previously \
registered with the dispatch routine."
- XEN_ASSERT_TYPE(XEN_XEvent_P(arg1), arg1, 1, "XtDispatchEvent", "XEvent*");
- return(C_TO_XEN_BOOLEAN(XtDispatchEvent(XEN_TO_C_XEvent(arg1))));
+ Xen_check_type(Xen_is_XEvent(arg1), arg1, 1, "XtDispatchEvent", "XEvent*");
+ return(C_bool_to_Xen_boolean(XtDispatchEvent(Xen_to_C_XEvent(arg1))));
}
-static XEN gxm_XtUnmanageChild(XEN arg1)
+static Xen gxm_XtUnmanageChild(Xen arg1)
{
#define H_XtUnmanageChild "void XtUnmanageChild(child)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtUnmanageChild", "Widget");
- XtUnmanageChild(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtUnmanageChild", "Widget");
+ XtUnmanageChild(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtUnmanageChildren(XEN arg1, XEN arg2)
+static Xen gxm_XtUnmanageChildren(Xen arg1, Xen arg2)
{
#define H_XtUnmanageChildren "void XtUnmanageChildren(children, num_children)"
/* DIFF: XtUnmanageChildren arg1 is list of widgets
*/
int len;
- XEN_ASSERT_TYPE(XEN_LIST_P(arg1), arg1, 1, "XtUnmanageChildren", "WidgetList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg2), arg2, 2, "XtUnmanageChildren", "int");
- if (XEN_INTEGER_P(arg2)) len = XEN_TO_C_INT(arg2); else len = XEN_LIST_LENGTH(arg1);
+ Xen_check_type(Xen_is_list(arg1), arg1, 1, "XtUnmanageChildren", "WidgetList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg2), arg2, 2, "XtUnmanageChildren", "int");
+ if (Xen_is_integer(arg2)) len = Xen_integer_to_C_int(arg2); else len = Xen_list_length(arg1);
if (len > 0)
{
- if (len > XEN_LIST_LENGTH(arg1))
- XEN_OUT_OF_RANGE_ERROR("XmContainerReorder", 2, arg2, "len too large");
+ if (len > Xen_list_length(arg1))
+ Xen_out_of_range_error("XmContainerReorder", 2, arg2, "len too large");
else
{
WidgetList ws1;
- ws1 = XEN_TO_C_Widgets(arg1, len);
+ ws1 = Xen_to_C_Widgets(arg1, len);
XtUnmanageChildren(ws1, len);
if (ws1) free(ws1);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtManageChild(XEN arg1)
+static Xen gxm_XtManageChild(Xen arg1)
{
#define H_XtManageChild "void XtManageChild(child)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg1), arg1, 1, "XtManageChild", "Widget");
- XtManageChild(XEN_TO_C_Widget(arg1));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg1), arg1, 1, "XtManageChild", "Widget");
+ XtManageChild(Xen_to_C_Widget(arg1));
+ return(Xen_false);
}
-static XEN gxm_XtManageChildren(XEN arg1, XEN arg2)
+static Xen gxm_XtManageChildren(Xen arg1, Xen arg2)
{
#define H_XtManageChildren "void XtManageChildren(children, num_children)"
/* DIFF: XtManageChildren arg1 is list of widgets
*/
int len;
- XEN_ASSERT_TYPE(XEN_LIST_P(arg1), arg1, 1, "XtManageChildren", "WidgetList");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(arg2), arg2, 2, "XtManageChildren", "int");
- if (XEN_INTEGER_P(arg2)) len = XEN_TO_C_INT(arg2); else len = XEN_LIST_LENGTH(arg1);
+ Xen_check_type(Xen_is_list(arg1), arg1, 1, "XtManageChildren", "WidgetList");
+ Xen_check_type(Xen_is_integer_or_unbound(arg2), arg2, 2, "XtManageChildren", "int");
+ if (Xen_is_integer(arg2)) len = Xen_integer_to_C_int(arg2); else len = Xen_list_length(arg1);
if (len > 0)
{
- if (len > XEN_LIST_LENGTH(arg1))
- XEN_OUT_OF_RANGE_ERROR("XmContainerReorder", 2, arg2, "len too large");
+ if (len > Xen_list_length(arg1))
+ Xen_out_of_range_error("XmContainerReorder", 2, arg2, "len too large");
else
{
WidgetList ws1;
- ws1 = XEN_TO_C_Widgets(arg1, len);
+ ws1 = Xen_to_C_Widgets(arg1, len);
XtManageChildren(ws1, len);
if (ws1) free(ws1);
}
}
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_XtIsRectObj(XEN arg)
+static Xen gxm_XtIsRectObj(Xen arg)
{
#define H_XtIsRectObj "Boolean XtIsRectObj(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsRectObj", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsRectObj(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsRectObj", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsRectObj(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsWidget(XEN arg)
+static Xen gxm_XtIsWidget(Xen arg)
{
#define H_XtIsWidget "Boolean XtIsWidget(w)"
- return(C_TO_XEN_BOOLEAN(WRAP_P("Widget", arg) &&
- (XtIsWidget(XEN_TO_C_Widget(arg)))));
+ return(C_bool_to_Xen_boolean(is_wrapped("Widget", arg) &&
+ (XtIsWidget(Xen_to_C_Widget(arg)))));
}
-static XEN gxm_XtIsComposite(XEN arg)
+static Xen gxm_XtIsComposite(Xen arg)
{
#define H_XtIsComposite "Boolean XtIsComposite(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsComposite", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsComposite(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsComposite", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsComposite(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsConstraint(XEN arg)
+static Xen gxm_XtIsConstraint(Xen arg)
{
#define H_XtIsConstraint "Boolean XtIsConstraint(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsConstraint", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsConstraint(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsConstraint", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsConstraint(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsShell(XEN arg)
+static Xen gxm_XtIsShell(Xen arg)
{
#define H_XtIsShell "Boolean XtIsShell(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsShell", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsOverrideShell(XEN arg)
+static Xen gxm_XtIsOverrideShell(Xen arg)
{
#define H_XtIsOverrideShell "Boolean XtIsOverrideShell(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsOverrideShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsOverrideShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsOverrideShell", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsOverrideShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsWMShell(XEN arg)
+static Xen gxm_XtIsWMShell(Xen arg)
{
#define H_XtIsWMShell "Boolean XtIsWMShell(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsWMShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsWMShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsWMShell", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsWMShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsVendorShell(XEN arg)
+static Xen gxm_XtIsVendorShell(Xen arg)
{
#define H_XtIsVendorShell "Boolean XtIsVendorShell(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsVendorShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsVendorShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsVendorShell", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsVendorShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsTransientShell(XEN arg)
+static Xen gxm_XtIsTransientShell(Xen arg)
{
#define H_XtIsTransientShell "Boolean XtIsTransientShell(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsTransientShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsTransientShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsTransientShell", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsTransientShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsTopLevelShell(XEN arg)
+static Xen gxm_XtIsTopLevelShell(Xen arg)
{
#define H_XtIsTopLevelShell "Boolean XtIsTopLevelShell(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsTopLevelShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsTopLevelShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsTopLevelShell", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsTopLevelShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsApplicationShell(XEN arg)
+static Xen gxm_XtIsApplicationShell(Xen arg)
{
#define H_XtIsApplicationShell "Boolean XtIsApplicationShell(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsApplicationShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsApplicationShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsApplicationShell", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsApplicationShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtIsSessionShell(XEN arg)
+static Xen gxm_XtIsSessionShell(Xen arg)
{
#define H_XtIsSessionShell "Boolean XtIsSessionShell(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtIsSessionShell", "Widget");
- return(C_TO_XEN_BOOLEAN(XtIsSessionShell(XEN_TO_C_Widget(arg))));
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtIsSessionShell", "Widget");
+ return(C_bool_to_Xen_boolean(XtIsSessionShell(Xen_to_C_Widget(arg))));
}
-static XEN gxm_XtMapWidget(XEN arg)
+static Xen gxm_XtMapWidget(Xen arg)
{
#define H_XtMapWidget "XtMapWidget(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtMapWidget", "Widget");
- XtMapWidget(XEN_TO_C_Widget(arg));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtMapWidget", "Widget");
+ XtMapWidget(Xen_to_C_Widget(arg));
+ return(Xen_false);
}
-static XEN gxm_XtUnmapWidget(XEN arg)
+static Xen gxm_XtUnmapWidget(Xen arg)
{
#define H_XtUnmapWidget "XtUnmapWidget(w)"
- XEN_ASSERT_TYPE(XEN_Widget_P(arg), arg, 0, "XtUnmapWidget", "Widget");
- XtUnmapWidget(XEN_TO_C_Widget(arg));
- return(XEN_FALSE);
+ Xen_check_type(Xen_is_Widget(arg), arg, 0, "XtUnmapWidget", "Widget");
+ XtUnmapWidget(Xen_to_C_Widget(arg));
+ return(Xen_false);
}
-static XEN gxm_XtSetArg(XEN arg1, XEN arg2, XEN arg3)
+static Xen gxm_XtSetArg(Xen arg1, Xen arg2, Xen arg3)
{
#define H_XtSetArg "XtSetArg in xm is useless -- it returns its arguments as a list"
- return(XEN_LIST_3(arg1, arg2, arg3));
+ return(Xen_list_3(arg1, arg2, arg3));
}
-#endif
-/* end HAVE_MOTIF */
-
/* ---------------------------------------------------------------------------------------------------- */
-XM_TYPE_PTR_NO_C2X(XpmImage, XpmImage *)
-XM_TYPE_PTR_NO_C2X(XpmAttributes, XpmAttributes *) /* _OBJ?? */
-XM_TYPE_PTR_NO_C2X(XpmColorSymbol, XpmColorSymbol *)
+Xm_type_ptr_no_c2x(XpmImage, XpmImage *)
+Xm_type_ptr_no_c2x(XpmAttributes, XpmAttributes *) /* _OBJ?? */
+Xm_type_ptr_no_c2x(XpmColorSymbol, XpmColorSymbol *)
-static XEN gxm_XpmCreateXpmImageFromPixmap(XEN arg1, XEN arg2, XEN arg3, XEN arg5)
+static Xen gxm_XpmCreateXpmImageFromPixmap(Xen arg1, Xen arg2, Xen arg3, Xen arg5)
{
XpmImage *image;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XpmCreateXpmImageFromPixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg2), arg2, 2, "XpmCreateXpmImageFromPixmap", "Pixmap");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3), arg3, 3, "XpmCreateXpmImageFromPixmap", "Pixmap");
- XEN_ASSERT_TYPE(XEN_XpmAttributes_P(arg5) || XEN_FALSE_P(arg5), arg5, 5, "XpmCreateXpmImageFromPixmap", "XpmAttributes*");
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XpmCreateXpmImageFromPixmap", "Display*");
+ Xen_check_type(Xen_is_Pixmap(arg2), arg2, 2, "XpmCreateXpmImageFromPixmap", "Pixmap");
+ Xen_check_type(Xen_is_Pixmap(arg3), arg3, 3, "XpmCreateXpmImageFromPixmap", "Pixmap");
+ Xen_check_type(Xen_is_XpmAttributes(arg5) || Xen_is_false(arg5), arg5, 5, "XpmCreateXpmImageFromPixmap", "XpmAttributes*");
image = (XpmImage *)calloc(1, sizeof(XpmImage));
- val = XpmCreateXpmImageFromPixmap(XEN_TO_C_Display(arg1),
- XEN_TO_C_Pixmap(arg2),
- XEN_TO_C_Pixmap(arg3),
+ val = XpmCreateXpmImageFromPixmap(Xen_to_C_Display(arg1),
+ Xen_to_C_Pixmap(arg2),
+ Xen_to_C_Pixmap(arg3),
image,
- (XEN_FALSE_P(arg5)) ? NULL : XEN_TO_C_XpmAttributes(arg5));
+ (Xen_is_false(arg5)) ? NULL : Xen_to_C_XpmAttributes(arg5));
if (val == XpmSuccess)
- return(WRAP_FOR_XEN_OBJ("XpmImage", image));
+ return(wrap_for_Xen_obj("XpmImage", image));
free(image);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XpmCreatePixmapFromXpmImage(XEN arg1, XEN arg2, XEN arg3, XEN arg4)
+static Xen gxm_XpmCreatePixmapFromXpmImage(Xen arg1, Xen arg2, Xen arg3, Xen arg4)
{
/* DIFF: XpmCreatePixmapFromXpmImage omits and returns pixmap args
*/
Pixmap p1, p2;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XpmCreatePixmapFromXpmImage", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XpmCreatePixmapFromXpmImage", "Drawable");
- XEN_ASSERT_TYPE(XEN_XpmImage_P(arg3), arg3, 3, "XpmCreatePixmapFromXpmImage", "XpmImage*");
- XEN_ASSERT_TYPE(XEN_XpmAttributes_P(arg4) || XEN_FALSE_P(arg4), arg4, 4, "XpmCreatePixmapFromXpmImage", "XpmAttributes*");
- val = XpmCreatePixmapFromXpmImage(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- XEN_TO_C_XpmImage(arg3),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XpmCreatePixmapFromXpmImage", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XpmCreatePixmapFromXpmImage", "Drawable");
+ Xen_check_type(Xen_is_XpmImage(arg3), arg3, 3, "XpmCreatePixmapFromXpmImage", "XpmImage*");
+ Xen_check_type(Xen_is_XpmAttributes(arg4) || Xen_is_false(arg4), arg4, 4, "XpmCreatePixmapFromXpmImage", "XpmAttributes*");
+ val = XpmCreatePixmapFromXpmImage(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ Xen_to_C_XpmImage(arg3),
&p1, &p2,
- (XEN_FALSE_P(arg4)) ? NULL : XEN_TO_C_XpmAttributes(arg4));
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_Pixmap(p1),
- C_TO_XEN_Pixmap(p2)));
+ (Xen_is_false(arg4)) ? NULL : Xen_to_C_XpmAttributes(arg4));
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_to_Xen_Pixmap(p1),
+ C_to_Xen_Pixmap(p2)));
}
-static XEN gxm_XpmReadFileToPixmap(XEN arg1, XEN arg2, XEN arg3, XEN arg6)
+static Xen gxm_XpmReadFileToPixmap(Xen arg1, Xen arg2, Xen arg3, Xen arg6)
{
/* DIFF: XpmReadFileToPixmap omits and returns pixmap args
*/
Pixmap p1, p2;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XpmReadFileToPixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XpmReadFileToPixmap", "Drawable");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg3), arg3, 3, "XpmReadFileToPixmap", "char*");
- XEN_ASSERT_TYPE(XEN_XpmAttributes_P(arg6) || XEN_FALSE_P(arg6), arg6, 6, "XpmReadFileToPixmap", "XpmAttributes*");
- val = XpmReadFileToPixmap(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
- (char *)XEN_TO_C_STRING(arg3),
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XpmReadFileToPixmap", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XpmReadFileToPixmap", "Drawable");
+ Xen_check_type(Xen_is_string(arg3), arg3, 3, "XpmReadFileToPixmap", "char*");
+ Xen_check_type(Xen_is_XpmAttributes(arg6) || Xen_is_false(arg6), arg6, 6, "XpmReadFileToPixmap", "XpmAttributes*");
+ val = XpmReadFileToPixmap(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
+ (char *)Xen_string_to_C_string(arg3),
&p1, &p2,
- (XEN_FALSE_P(arg6)) ? NULL : XEN_TO_C_XpmAttributes(arg6));
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_Pixmap(p1),
- C_TO_XEN_Pixmap(p2)));
+ (Xen_is_false(arg6)) ? NULL : Xen_to_C_XpmAttributes(arg6));
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_to_Xen_Pixmap(p1),
+ C_to_Xen_Pixmap(p2)));
}
-static XEN gxm_XpmReadFileToXpmImage(XEN arg1)
+static Xen gxm_XpmReadFileToXpmImage(Xen arg1)
{
int val;
XpmImage *image;
- XEN_ASSERT_TYPE(XEN_STRING_P(arg1), arg1, 1, "XpmReadFileToXpmImage", "char*");
+ Xen_check_type(Xen_is_string(arg1), arg1, 1, "XpmReadFileToXpmImage", "char*");
image = (XpmImage *)calloc(1, sizeof(XpmImage));
- val = XpmReadFileToXpmImage((char *)XEN_TO_C_STRING(arg1), image, NULL);
+ val = XpmReadFileToXpmImage((char *)Xen_string_to_C_string(arg1), image, NULL);
if (val == XpmSuccess)
- return(WRAP_FOR_XEN_OBJ("XpmImage", image));
+ return(wrap_for_Xen_obj("XpmImage", image));
free(image);
- return(C_TO_XEN_INT(val));
+ return(C_int_to_Xen_integer(val));
}
-static XEN gxm_XpmCreatePixmapFromData(XEN arg1, XEN arg2, XEN larg3, XEN arg6)
+static Xen gxm_XpmCreatePixmapFromData(Xen arg1, Xen arg2, Xen larg3, Xen arg6)
{
/* DIFF: XpmCreatePixmapFromData omits and returns pixmap args, arg3 (bits) is list of strings
*/
Pixmap p1, p2;
int val, i, len;
char **bits;
- XEN arg3;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XpmCreatePixmapFromData", "Display*");
- XEN_ASSERT_TYPE(XEN_Window_P(arg2), arg2, 2, "XpmCreatePixmapFromData", "Drawable");
- XEN_ASSERT_TYPE(XEN_LIST_P(larg3), larg3, 3, "XpmCreatePixmapFromData", "list of char*");
- XEN_ASSERT_TYPE(XEN_XpmAttributes_P(arg6) || XEN_FALSE_P(arg6), arg6, 6, "XpmCreatePixmapFromData", "XpmAttributes*");
- arg3 = XEN_COPY_ARG(larg3);
- len = XEN_LIST_LENGTH(arg3);
- if (len <= 0) XEN_ASSERT_TYPE(0, arg3, 3, "XpmCreatePixmapFromData", "positive integer");
+ Xen arg3;
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XpmCreatePixmapFromData", "Display*");
+ Xen_check_type(Xen_is_Window(arg2), arg2, 2, "XpmCreatePixmapFromData", "Drawable");
+ Xen_check_type(Xen_is_list(larg3), larg3, 3, "XpmCreatePixmapFromData", "list of char*");
+ Xen_check_type(Xen_is_XpmAttributes(arg6) || Xen_is_false(arg6), arg6, 6, "XpmCreatePixmapFromData", "XpmAttributes*");
+ arg3 = Xen_copy_arg(larg3);
+ len = Xen_list_length(arg3);
+ if (len <= 0) Xen_check_type(0, arg3, 3, "XpmCreatePixmapFromData", "positive integer");
bits = (char **)calloc(len, sizeof(char *));
- for (i = 0; i < len; i++, arg3 = XEN_CDR(arg3))
- bits[i] = xen_strdup(XEN_TO_C_STRING(XEN_CAR(arg3)));
- val = XpmCreatePixmapFromData(XEN_TO_C_Display(arg1),
- XEN_TO_C_Window(arg2),
+ for (i = 0; i < len; i++, arg3 = Xen_cdr(arg3))
+ bits[i] = xen_strdup(Xen_string_to_C_string(Xen_car(arg3)));
+ val = XpmCreatePixmapFromData(Xen_to_C_Display(arg1),
+ Xen_to_C_Window(arg2),
bits,
&p1, &p2,
- (XEN_FALSE_P(arg6)) ? NULL : XEN_TO_C_XpmAttributes(arg6));
+ (Xen_is_false(arg6)) ? NULL : Xen_to_C_XpmAttributes(arg6));
for (i = 0; i < len; i++)
if (bits[i]) free(bits[i]);
free(bits);
- return(XEN_LIST_3(C_TO_XEN_INT(val),
- C_TO_XEN_Pixmap(p1),
- C_TO_XEN_Pixmap(p2)));
+ return(Xen_list_3(C_int_to_Xen_integer(val),
+ C_to_Xen_Pixmap(p1),
+ C_to_Xen_Pixmap(p2)));
}
-static XEN gxm_XpmWriteFileFromPixmap(XEN arg1, XEN arg2, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XpmWriteFileFromPixmap(Xen arg1, Xen arg2, Xen arg3, Xen arg4, Xen arg5)
{
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XpmWriteFileFromPixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_STRING_P(arg2), arg2, 2, "XpmWriteFileFromPixmap", "char*");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3), arg3, 3, "XpmWriteFileFromPixmap", "Pixmap");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg4), arg4, 4, "XpmWriteFileFromPixmap", "Pixmap");
- XEN_ASSERT_TYPE(XEN_XpmAttributes_P(arg5) || XEN_FALSE_P(arg5), arg5, 5, "XpmWriteFileFromPixmap", "XpmAttributes*");
- return(C_TO_XEN_INT(XpmWriteFileFromPixmap(XEN_TO_C_Display(arg1), (char *)XEN_TO_C_STRING(arg2),
- XEN_TO_C_Pixmap(arg3), XEN_TO_C_Pixmap(arg4),
- (XEN_FALSE_P(arg5)) ? NULL : XEN_TO_C_XpmAttributes(arg5))));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XpmWriteFileFromPixmap", "Display*");
+ Xen_check_type(Xen_is_string(arg2), arg2, 2, "XpmWriteFileFromPixmap", "char*");
+ Xen_check_type(Xen_is_Pixmap(arg3), arg3, 3, "XpmWriteFileFromPixmap", "Pixmap");
+ Xen_check_type(Xen_is_Pixmap(arg4), arg4, 4, "XpmWriteFileFromPixmap", "Pixmap");
+ Xen_check_type(Xen_is_XpmAttributes(arg5) || Xen_is_false(arg5), arg5, 5, "XpmWriteFileFromPixmap", "XpmAttributes*");
+ return(C_int_to_Xen_integer(XpmWriteFileFromPixmap(Xen_to_C_Display(arg1), (char *)Xen_string_to_C_string(arg2),
+ Xen_to_C_Pixmap(arg3), Xen_to_C_Pixmap(arg4),
+ (Xen_is_false(arg5)) ? NULL : Xen_to_C_XpmAttributes(arg5))));
}
-static XEN gxm_XpmCreateDataFromPixmap(XEN arg1, XEN arg3, XEN arg4, XEN arg5)
+static Xen gxm_XpmCreateDataFromPixmap(Xen arg1, Xen arg3, Xen arg4, Xen arg5)
{
/* DIFF: XpmCreateDataFromPixmap arg2 omitted and rtn'd
*/
char **buf = NULL;
int val;
- XEN_ASSERT_TYPE(XEN_Display_P(arg1), arg1, 1, "XpmCreateDataFromPixmap", "Display*");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg3), arg3, 3, "XpmCreateDataFromPixmap", "Pixmap");
- XEN_ASSERT_TYPE(XEN_Pixmap_P(arg4), arg4, 4, "XpmCreateDataFromPixmap", "Pixmap");
- XEN_ASSERT_TYPE(XEN_XpmAttributes_P(arg5) || XEN_FALSE_P(arg5), arg5, 5, "XpmCreateDataFromPixmap", "XpmAttributes*");
- val = XpmCreateDataFromPixmap(XEN_TO_C_Display(arg1), &buf,
- XEN_TO_C_Pixmap(arg3),
- XEN_TO_C_Pixmap(arg4),
- (XEN_FALSE_P(arg5)) ? NULL : XEN_TO_C_XpmAttributes(arg5));
- return(XEN_LIST_2(C_TO_XEN_INT(val),
- XEN_WRAP_C_POINTER(buf)));
+ Xen_check_type(Xen_is_Display(arg1), arg1, 1, "XpmCreateDataFromPixmap", "Display*");
+ Xen_check_type(Xen_is_Pixmap(arg3), arg3, 3, "XpmCreateDataFromPixmap", "Pixmap");
+ Xen_check_type(Xen_is_Pixmap(arg4), arg4, 4, "XpmCreateDataFromPixmap", "Pixmap");
+ Xen_check_type(Xen_is_XpmAttributes(arg5) || Xen_is_false(arg5), arg5, 5, "XpmCreateDataFromPixmap", "XpmAttributes*");
+ val = XpmCreateDataFromPixmap(Xen_to_C_Display(arg1), &buf,
+ Xen_to_C_Pixmap(arg3),
+ Xen_to_C_Pixmap(arg4),
+ (Xen_is_false(arg5)) ? NULL : Xen_to_C_XpmAttributes(arg5));
+ return(Xen_list_2(C_int_to_Xen_integer(val),
+ Xen_wrap_C_pointer(buf)));
}
-static XEN gxm_XpmGetErrorString(XEN err)
+static Xen gxm_XpmGetErrorString(Xen err)
{
#define H_XpmGetErrorString "(XpmGetErrorString err): string describing error"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(err), err, XEN_ONLY_ARG, "XpmGetErrorString", "an Xpm status code");
- return(C_TO_XEN_STRING(XpmGetErrorString(XEN_TO_C_INT(err))));
+ Xen_check_type(Xen_is_integer(err), err, 1, "XpmGetErrorString", "an Xpm status code");
+ return(C_string_to_Xen_string(XpmGetErrorString(Xen_integer_to_C_int(err))));
}
-static XEN gxm_XpmColorSymbol(XEN name, XEN value, XEN pixel)
+static Xen gxm_XpmColorSymbol(Xen name, Xen value, Xen pixel)
{
XpmColorSymbol *r;
#define H_XpmColorSymbol "(XpmColorSymbol name val pix): new XpmColorSymbol struct"
- XEN_ASSERT_TYPE(XEN_STRING_P(name), name, 1, "XpmColorSymbol", "char*");
- XEN_ASSERT_TYPE(XEN_FALSE_P(value) || XEN_STRING_P(value), value, 2, "XpmColorSymbol", "char*");
- XEN_ASSERT_TYPE(XEN_Pixel_P(pixel), pixel, 3, "XpmColorSymbol", "Pixel");
+ Xen_check_type(Xen_is_string(name), name, 1, "XpmColorSymbol", "char*");
+ Xen_check_type(Xen_is_false(value) || Xen_is_string(value), value, 2, "XpmColorSymbol", "char*");
+ Xen_check_type(Xen_is_Pixel(pixel), pixel, 3, "XpmColorSymbol", "Pixel");
r = (XpmColorSymbol *)calloc(1, sizeof(XpmColorSymbol));
- r->name = (char *)XEN_TO_C_STRING(name);
- r->value = (XEN_FALSE_P(value)) ? NULL : (char *)XEN_TO_C_STRING(value);
- r->pixel = XEN_TO_C_Pixel(pixel);
- return(WRAP_FOR_XEN_OBJ("XpmColorSymbol",r));
+ r->name = (char *)Xen_string_to_C_string(name);
+ r->value = (Xen_is_false(value)) ? NULL : (char *)Xen_string_to_C_string(value);
+ r->pixel = Xen_to_C_Pixel(pixel);
+ return(wrap_for_Xen_obj("XpmColorSymbol",r));
}
-static XEN gxm_XpmImage(XEN width, XEN height, XEN cpp, XEN ncolors, XEN data)
+static Xen gxm_XpmImage(Xen width, Xen height, Xen cpp, Xen ncolors, Xen data)
{
XpmImage *r;
#define H_XpmImage "(XpmImage w h cpp n data): new XpmImage struct"
- XEN_ASSERT_TYPE(XEN_ULONG_P(width), width, 1, "XpmImage", "ulong");
- XEN_ASSERT_TYPE(XEN_ULONG_P(height), height, 2, "XpmImage", "ulong");
- XEN_ASSERT_TYPE(XEN_ULONG_P(cpp), cpp, 3, "XpmImage", "ulong");
- XEN_ASSERT_TYPE(XEN_ULONG_P(ncolors), ncolors, 4, "XpmImage", "ulong");
- XEN_ASSERT_TYPE(XEN_ULONG_P(data), data, 5, "XpmImage", "ulong");
+ Xen_check_type(Xen_is_ulong(width), width, 1, "XpmImage", "ulong");
+ Xen_check_type(Xen_is_ulong(height), height, 2, "XpmImage", "ulong");
+ Xen_check_type(Xen_is_ulong(cpp), cpp, 3, "XpmImage", "ulong");
+ Xen_check_type(Xen_is_ulong(ncolors), ncolors, 4, "XpmImage", "ulong");
+ Xen_check_type(Xen_is_ulong(data), data, 5, "XpmImage", "ulong");
r = (XpmImage *)calloc(1, sizeof(XpmImage));
- r->width = XEN_TO_C_ULONG(width);
- r->height = XEN_TO_C_ULONG(height);
- r->cpp = XEN_TO_C_ULONG(cpp);
- r->ncolors = XEN_TO_C_ULONG(ncolors);
- r->data = (unsigned int *)XEN_TO_C_ULONG(data);
- return(WRAP_FOR_XEN_OBJ("XpmImage", r));
+ r->width = Xen_ulong_to_C_ulong(width);
+ r->height = Xen_ulong_to_C_ulong(height);
+ r->cpp = Xen_ulong_to_C_ulong(cpp);
+ r->ncolors = Xen_ulong_to_C_ulong(ncolors);
+ r->data = (unsigned int *)Xen_ulong_to_C_ulong(data);
+ return(wrap_for_Xen_obj("XpmImage", r));
}
-static XEN gxm_XpmAttributes(void)
+static Xen gxm_XpmAttributes(void)
{
#define H_XpmAttributes "(XpmAttributes): new XpmAttributes struct"
- return(WRAP_FOR_XEN_OBJ("XpmAttributes",
+ return(wrap_for_Xen_obj("XpmAttributes",
(XpmAttributes *)calloc(1, sizeof(XpmAttributes))));
}
-static XEN gxm_cpp(XEN ptr)
+static Xen gxm_cpp(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE((XEN_XpmImage_P(ptr)) || (XEN_XpmAttributes_P(ptr)), ptr, XEN_ONLY_ARG, "cpp", "XpmImage");
- if (XEN_XpmImage_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmImage(ptr))->cpp)));
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->cpp)));
+ XM_field_assert_type((Xen_is_XpmImage(ptr)) || (Xen_is_XpmAttributes(ptr)), ptr, 1, "cpp", "XpmImage");
+ if (Xen_is_XpmImage(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmImage(ptr))->cpp)));
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->cpp)));
}
-static XEN gxm_set_cpp(XEN ptr, XEN val)
+static Xen gxm_set_cpp(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE((XEN_XpmImage_P(ptr)) || (XEN_XpmAttributes_P(ptr)), ptr, XEN_ARG_1, "cpp", "XpmImage");
- if (XEN_XpmImage_P(ptr)) (XEN_TO_C_XpmImage(ptr))->cpp = XEN_TO_C_ULONG(val);
- (XEN_TO_C_XpmAttributes(ptr))->cpp = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type((Xen_is_XpmImage(ptr)) || (Xen_is_XpmAttributes(ptr)), ptr, 1, "cpp", "XpmImage");
+ if (Xen_is_XpmImage(ptr)) (Xen_to_C_XpmImage(ptr))->cpp = Xen_ulong_to_C_ulong(val);
+ (Xen_to_C_XpmAttributes(ptr))->cpp = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_ncolors(XEN ptr)
+static Xen gxm_ncolors(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE((XEN_XpmImage_P(ptr)) || (XEN_XpmAttributes_P(ptr)), ptr, XEN_ONLY_ARG, "ncolors", "XpmImage");
- if (XEN_XpmImage_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmImage(ptr))->ncolors)));
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->ncolors)));
+ XM_field_assert_type((Xen_is_XpmImage(ptr)) || (Xen_is_XpmAttributes(ptr)), ptr, 1, "ncolors", "XpmImage");
+ if (Xen_is_XpmImage(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmImage(ptr))->ncolors)));
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->ncolors)));
}
-static XEN gxm_set_ncolors(XEN ptr, XEN val)
+static Xen gxm_set_ncolors(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE((XEN_XpmImage_P(ptr)) || (XEN_XpmAttributes_P(ptr)), ptr, XEN_ARG_1, "ncolors", "XpmImage");
- if (XEN_XpmImage_P(ptr)) (XEN_TO_C_XpmImage(ptr))->ncolors = XEN_TO_C_ULONG(val);
- else (XEN_TO_C_XpmAttributes(ptr))->ncolors = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type((Xen_is_XpmImage(ptr)) || (Xen_is_XpmAttributes(ptr)), ptr, 1, "ncolors", "XpmImage");
+ if (Xen_is_XpmImage(ptr)) (Xen_to_C_XpmImage(ptr))->ncolors = Xen_ulong_to_C_ulong(val);
+ else (Xen_to_C_XpmAttributes(ptr))->ncolors = Xen_ulong_to_C_ulong(val);
return(val);
}
#if 0
-static XEN gxm_set_data(XEN ptr, XEN val)
+static Xen gxm_set_data(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmImage_P(ptr), ptr, XEN_ARG_1, "data", "XpmImage");
- (XEN_TO_C_XpmImage(ptr))->data = (unsigned int *)XEN_UNWRAP_C_POINTER(val);
+ XM_set_field_assert_type(Xen_is_XpmImage(ptr), ptr, 1, "data", "XpmImage");
+ (Xen_to_C_XpmImage(ptr))->data = (unsigned int *)Xen_unwrap_C_pointer(val);
return(val);
}
#endif
-static XEN gxm_valuemask(XEN ptr)
+static Xen gxm_valuemask(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ONLY_ARG, "valuemask", "XpmAttributes");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->valuemask)));
+ XM_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "valuemask", "XpmAttributes");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->valuemask)));
}
-static XEN gxm_set_valuemask(XEN ptr, XEN val)
+static Xen gxm_set_valuemask(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ARG_1, "valuemask", "XpmAttributes");
- (XEN_TO_C_XpmAttributes(ptr))->valuemask = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "valuemask", "XpmAttributes");
+ (Xen_to_C_XpmAttributes(ptr))->valuemask = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_x_hotspot(XEN ptr)
+static Xen gxm_x_hotspot(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ONLY_ARG, "x_hotspot", "XpmAttributes");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->x_hotspot)));
+ XM_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "x_hotspot", "XpmAttributes");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->x_hotspot)));
}
-static XEN gxm_set_x_hotspot(XEN ptr, XEN val)
+static Xen gxm_set_x_hotspot(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ARG_1, "x_hotspot", "XpmAttributes");
- (XEN_TO_C_XpmAttributes(ptr))->x_hotspot = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "x_hotspot", "XpmAttributes");
+ (Xen_to_C_XpmAttributes(ptr))->x_hotspot = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_y_hotspot(XEN ptr)
+static Xen gxm_y_hotspot(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ONLY_ARG, "y_hotspot", "XpmAttributes");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->y_hotspot)));
+ XM_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "y_hotspot", "XpmAttributes");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->y_hotspot)));
}
-static XEN gxm_set_y_hotspot(XEN ptr, XEN val)
+static Xen gxm_set_y_hotspot(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ARG_1, "y_hotspot", "XpmAttributes");
- (XEN_TO_C_XpmAttributes(ptr))->y_hotspot = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "y_hotspot", "XpmAttributes");
+ (Xen_to_C_XpmAttributes(ptr))->y_hotspot = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_colorsymbols(XEN ptr)
+static Xen gxm_colorsymbols(Xen ptr)
{
XpmAttributes *atr;
- int i, len;
- XEN lst = XEN_EMPTY_LIST;
- XM_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ONLY_ARG, "colorsymbols", "XpmAttributes");
- atr = XEN_TO_C_XpmAttributes(ptr);
+ int len;
+ Xen lst = Xen_empty_list;
+ XM_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "colorsymbols", "XpmAttributes");
+ atr = Xen_to_C_XpmAttributes(ptr);
len = atr->numsymbols;
if (len > 0)
{
+ int i;
XpmColorSymbol *cols;
cols = atr->colorsymbols;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(WRAP_FOR_XEN("XpmColorSymbol", &(cols[i])), lst);
+ lst = Xen_cons(wrap_for_Xen("XpmColorSymbol", &(cols[i])), lst);
}
return(lst);
}
-static XEN gxm_set_colorsymbols(XEN ptr, XEN vals)
+static Xen gxm_set_colorsymbols(Xen ptr, Xen vals)
{
XpmAttributes *atr;
- int i, len;
- XEN lst;
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ARG_1, "colorsymbols", "XpmAttributes");
- XM_SET_FIELD_ASSERT_TYPE(XEN_LIST_P(vals), vals, XEN_ARG_2, "colorsymbols", "list of XpmColorSymbols");
- atr = XEN_TO_C_XpmAttributes(ptr);
- len = XEN_LIST_LENGTH(vals);
+ int len;
+ XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "colorsymbols", "XpmAttributes");
+ XM_set_field_assert_type(Xen_is_list(vals), vals, 2, "colorsymbols", "list of XpmColorSymbols");
+ atr = Xen_to_C_XpmAttributes(ptr);
+ len = Xen_list_length(vals);
if (len > 0)
{
+ Xen lst;
+ int i;
XpmColorSymbol *cols = NULL, *cur;
cols = (XpmColorSymbol *)calloc(len, sizeof(XpmColorSymbol));
- for (lst = XEN_COPY_ARG(vals), i = 0; i < len; i++, lst = XEN_CDR(lst))
+ for (lst = Xen_copy_arg(vals), i = 0; i < len; i++, lst = Xen_cdr(lst))
{
- cur = XEN_TO_C_XpmColorSymbol(XEN_CAR(lst));
+ cur = Xen_to_C_XpmColorSymbol(Xen_car(lst));
if (cur->name) cols[i].name = xen_strdup(cur->name);
if (cur->value) cols[i].value = xen_strdup(cur->value);
cols[i].pixel = cur->pixel;
@@ -17112,49 +16864,49 @@ static XEN gxm_set_colorsymbols(XEN ptr, XEN vals)
return(vals);
}
-static XEN gxm_numsymbols(XEN ptr)
+static Xen gxm_numsymbols(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ONLY_ARG, "numsymbols", "XpmAttributes");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->numsymbols)));
+ XM_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "numsymbols", "XpmAttributes");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->numsymbols)));
}
-static XEN gxm_set_numsymbols(XEN ptr, XEN val)
+static Xen gxm_set_numsymbols(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ARG_1, "numsymbols", "XpmAttributes");
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "numsymbols", "integer");
- (XEN_TO_C_XpmAttributes(ptr))->numsymbols = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "numsymbols", "XpmAttributes");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "numsymbols", "integer");
+ (Xen_to_C_XpmAttributes(ptr))->numsymbols = Xen_integer_to_C_int(val);
return(val);
}
/* pixels is the list -- not sure what good npixels is without pixels */
-static XEN gxm_npixels(XEN ptr)
+static Xen gxm_npixels(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ONLY_ARG, "npixels", "XpmAttributes");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->npixels)));
+ XM_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "npixels", "XpmAttributes");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->npixels)));
}
-static XEN gxm_set_npixels(XEN ptr, XEN val)
+static Xen gxm_set_npixels(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ARG_1, "npixels", "XpmAttributes");
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "npixels", "integer");
- (XEN_TO_C_XpmAttributes(ptr))->npixels = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "npixels", "XpmAttributes");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "npixels", "integer");
+ (Xen_to_C_XpmAttributes(ptr))->npixels = Xen_integer_to_C_int(val);
return(val);
}
-#if MUS_WITH_EDITRES
-static XEN gxm_XEditResCheckMessages(XEN widget, XEN data, XEN event, XEN cont)
+#if WITH_EDITRES
+static Xen gxm_XEditResCheckMessages(Xen widget, Xen data, Xen event, Xen cont)
{
Boolean flag;
- XEN_ASSERT_TYPE(XEN_Widget_P(widget), widget, XEN_ARG_1, "widget", "_XEditResCheckMessages");
- XEN_ASSERT_TYPE(XEN_XEvent_P(event), event, XEN_ARG_3, "XEvent", "_XEditResCheckMessages");
- XEN_ASSERT_TYPE(XEN_BOOLEAN_P(cont), cont, XEN_ARG_4, "boolean", "_XEditResCheckMessages");
- flag = XEN_TO_C_BOOLEAN(cont);
- _XEditResCheckMessages(XEN_TO_C_Widget(widget),
+ Xen_check_type(Xen_is_Widget(widget), widget, 1, "widget", "_XEditResCheckMessages");
+ Xen_check_type(Xen_is_XEvent(event), event, 3, "XEvent", "_XEditResCheckMessages");
+ Xen_check_type(Xen_is_boolean(cont), cont, 4, "boolean", "_XEditResCheckMessages");
+ flag = Xen_boolean_to_C_bool(cont);
+ _XEditResCheckMessages(Xen_to_C_Widget(widget),
(XtPointer)data,
- XEN_TO_C_XEvent(event),
+ Xen_to_C_XEvent(event),
&flag);
- return(XEN_FALSE);
+ return(Xen_false);
}
#endif
@@ -17164,2546 +16916,2519 @@ static XEN gxm_XEditResCheckMessages(XEN widget, XEN data, XEN event, XEN cont)
/* XRectangle */
-static XEN gxm_XRectangle(XEN x, XEN y, XEN width, XEN height)
+static Xen gxm_XRectangle(Xen x, Xen y, Xen width, Xen height)
{
#define H_XRectangle "(XRectangle x y width height): returns the given XRectangle"
XRectangle *r;
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x), x, 1, "XRectangle", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y), y, 2, "XRectangle", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(width), width, 3, "XRectangle", "INT");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(height), height, 4, "XRectangle", "INT");
+ Xen_check_type(Xen_is_integer(x), x, 1, "XRectangle", "short");
+ Xen_check_type(Xen_is_integer(y), y, 2, "XRectangle", "short");
+ Xen_check_type(Xen_is_integer(width), width, 3, "XRectangle", "INT");
+ Xen_check_type(Xen_is_integer(height), height, 4, "XRectangle", "INT");
r = (XRectangle *)calloc(1, sizeof(XRectangle));
- r->x = (short)XEN_TO_C_INT(x);
- r->y = (short)XEN_TO_C_INT(y);
- r->width = XEN_TO_C_INT(width);
- r->height = XEN_TO_C_INT(height);
- return(C_TO_XEN_XRectangle(r));
+ r->x = (short)Xen_integer_to_C_int(x);
+ r->y = (short)Xen_integer_to_C_int(y);
+ r->width = Xen_integer_to_C_int(width);
+ r->height = Xen_integer_to_C_int(height);
+ return(C_to_Xen_XRectangle(r));
}
/* XSegment */
-static XEN gxm_XSegment(XEN x1, XEN y1, XEN x2, XEN y2)
+static Xen gxm_XSegment(Xen x1, Xen y1, Xen x2, Xen y2)
{
XSegment *r;
#define H_XSegment "(XSegment x1 y1 x2 y2): new XSegment struct"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x1), x1, 1, "XSegment", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y1), y1, 2, "XSegment", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x2), x2, 3, "XSegment", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y2), y2, 4, "XSegment", "short");
+ Xen_check_type(Xen_is_integer(x1), x1, 1, "XSegment", "short");
+ Xen_check_type(Xen_is_integer(y1), y1, 2, "XSegment", "short");
+ Xen_check_type(Xen_is_integer(x2), x2, 3, "XSegment", "short");
+ Xen_check_type(Xen_is_integer(y2), y2, 4, "XSegment", "short");
r = (XSegment *)calloc(1, sizeof(XSegment));
- r->x1 = (short)XEN_TO_C_INT(x1);
- r->y1 = (short)XEN_TO_C_INT(y1);
- r->x2 = (short)XEN_TO_C_INT(x2);
- r->y2 = (short)XEN_TO_C_INT(y2);
- return(C_TO_XEN_XSegment(r));
+ r->x1 = (short)Xen_integer_to_C_int(x1);
+ r->y1 = (short)Xen_integer_to_C_int(y1);
+ r->x2 = (short)Xen_integer_to_C_int(x2);
+ r->y2 = (short)Xen_integer_to_C_int(y2);
+ return(C_to_Xen_XSegment(r));
}
-static XEN gxm_y2(XEN ptr)
+static Xen gxm_y2(Xen ptr)
{
- if (XEN_XSegment_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XSegment(ptr))->y2)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "y2", "XSegment");
- return(XEN_FALSE);
+ if (Xen_is_XSegment(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XSegment(ptr))->y2)));
+ XM_field_assert_type(0, ptr, 1, "y2", "XSegment");
+ return(Xen_false);
}
-static XEN gxm_set_y2(XEN ptr, XEN val)
+static Xen gxm_set_y2(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, "y2", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSegment_P(ptr), ptr, XEN_ARG_2, "y2", "XSegment");
- (XEN_TO_C_XSegment(ptr))->y2 = (short)XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 1, "y2", "an integer");
+ XM_set_field_assert_type(Xen_is_XSegment(ptr), ptr, 2, "y2", "XSegment");
+ (Xen_to_C_XSegment(ptr))->y2 = (short)Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_x2(XEN ptr)
+static Xen gxm_x2(Xen ptr)
{
- if (XEN_XSegment_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XSegment(ptr))->x2)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "x2", "XSegment");
- return(XEN_FALSE);
+ if (Xen_is_XSegment(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XSegment(ptr))->x2)));
+ XM_field_assert_type(0, ptr, 1, "x2", "XSegment");
+ return(Xen_false);
}
-static XEN gxm_set_x2(XEN ptr, XEN val)
+static Xen gxm_set_x2(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, "x2", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSegment_P(ptr), ptr, XEN_ARG_2, "x2", "XSegment");
- (XEN_TO_C_XSegment(ptr))->x2 = (short)XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 1, "x2", "an integer");
+ XM_set_field_assert_type(Xen_is_XSegment(ptr), ptr, 2, "x2", "XSegment");
+ (Xen_to_C_XSegment(ptr))->x2 = (short)Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_y1(XEN ptr)
+static Xen gxm_y1(Xen ptr)
{
- if (XEN_XSegment_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XSegment(ptr))->y1)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "y1", "XSegment");
- return(XEN_FALSE);
+ if (Xen_is_XSegment(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XSegment(ptr))->y1)));
+ XM_field_assert_type(0, ptr, 1, "y1", "XSegment");
+ return(Xen_false);
}
-static XEN gxm_set_y1(XEN ptr, XEN val)
+static Xen gxm_set_y1(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, "y1", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSegment_P(ptr), ptr, XEN_ARG_2, "y1", "XSegment");
- (XEN_TO_C_XSegment(ptr))->y1 = (short)XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 1, "y1", "an integer");
+ XM_set_field_assert_type(Xen_is_XSegment(ptr), ptr, 2, "y1", "XSegment");
+ (Xen_to_C_XSegment(ptr))->y1 = (short)Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_x1(XEN ptr)
+static Xen gxm_x1(Xen ptr)
{
- if (XEN_XSegment_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XSegment(ptr))->x1)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "x1", "XSegment");
- return(XEN_FALSE);
+ if (Xen_is_XSegment(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XSegment(ptr))->x1)));
+ XM_field_assert_type(0, ptr, 1, "x1", "XSegment");
+ return(Xen_false);
}
-static XEN gxm_set_x1(XEN ptr, XEN val)
+static Xen gxm_set_x1(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, "x1", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSegment_P(ptr), ptr, XEN_ARG_2, "x1", "XSegment");
- (XEN_TO_C_XSegment(ptr))->x1 = (short)XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 1, "x1", "an integer");
+ XM_set_field_assert_type(Xen_is_XSegment(ptr), ptr, 2, "x1", "XSegment");
+ (Xen_to_C_XSegment(ptr))->x1 = (short)Xen_integer_to_C_int(val);
return(val);
}
/* XPoint */
-static XEN gxm_XPoint(XEN x, XEN y)
+static Xen gxm_XPoint(Xen x, Xen y)
{
XPoint *r;
#define H_XPoint "(XPoint x y): new XPoint struct"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x), x, 1, "XPoint", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y), y, 2, "XPoint", "short");
+ Xen_check_type(Xen_is_integer(x), x, 1, "XPoint", "short");
+ Xen_check_type(Xen_is_integer(y), y, 2, "XPoint", "short");
r = (XPoint *)calloc(1, sizeof(XPoint));
- r->x = (short)XEN_TO_C_INT(x);
- r->y = (short)XEN_TO_C_INT(y);
- return(C_TO_XEN_XPoint(r));
+ r->x = (short)Xen_integer_to_C_int(x);
+ r->y = (short)Xen_integer_to_C_int(y);
+ return(C_to_Xen_XPoint(r));
}
/* XArc */
-static XEN gxm_XArc(XEN x, XEN y, XEN width, XEN height, XEN angle1, XEN angle2)
+static Xen gxm_XArc(Xen x, Xen y, Xen width, Xen height, Xen angle1, Xen angle2)
{
XArc *r;
#define H_XArc "(XArc x y w h ang1 ang2): new XArc struct"
- XEN_ASSERT_TYPE(XEN_INTEGER_P(x), x, 1, "XArc", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(y), y, 2, "XArc", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(width), width, 3, "XArc", "INT");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(height), height, 4, "XArc", "INT");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(angle1), angle1, 5, "XArc", "short");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(angle2), angle2, 6, "XArc", "short");
+ Xen_check_type(Xen_is_integer(x), x, 1, "XArc", "short");
+ Xen_check_type(Xen_is_integer(y), y, 2, "XArc", "short");
+ Xen_check_type(Xen_is_integer(width), width, 3, "XArc", "INT");
+ Xen_check_type(Xen_is_integer(height), height, 4, "XArc", "INT");
+ Xen_check_type(Xen_is_integer(angle1), angle1, 5, "XArc", "short");
+ Xen_check_type(Xen_is_integer(angle2), angle2, 6, "XArc", "short");
r = (XArc *)calloc(1, sizeof(XArc));
- r->x = (short)XEN_TO_C_INT(x);
- r->y = (short)XEN_TO_C_INT(y);
- r->width = XEN_TO_C_INT(width);
- r->height = XEN_TO_C_INT(height);
- r->angle1 = (short)XEN_TO_C_INT(angle1);
- r->angle2 = (short)XEN_TO_C_INT(angle2);
- return(C_TO_XEN_XArc(r));
+ r->x = (short)Xen_integer_to_C_int(x);
+ r->y = (short)Xen_integer_to_C_int(y);
+ r->width = Xen_integer_to_C_int(width);
+ r->height = Xen_integer_to_C_int(height);
+ r->angle1 = (short)Xen_integer_to_C_int(angle1);
+ r->angle2 = (short)Xen_integer_to_C_int(angle2);
+ return(C_to_Xen_XArc(r));
}
-static XEN gxm_angle2(XEN ptr)
+static Xen gxm_angle2(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XArc_P(ptr), ptr, XEN_ONLY_ARG, "angle2", "XArc");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XArc(ptr))->angle2)));
+ XM_field_assert_type(Xen_is_XArc(ptr), ptr, 1, "angle2", "XArc");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XArc(ptr))->angle2)));
}
-static XEN gxm_set_angle2(XEN ptr, XEN val)
+static Xen gxm_set_angle2(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, "angle2", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XArc_P(ptr), ptr, XEN_ARG_2, "angle2", "XArc");
- (XEN_TO_C_XArc(ptr))->angle2 = (short)XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 1, "angle2", "an integer");
+ XM_set_field_assert_type(Xen_is_XArc(ptr), ptr, 2, "angle2", "XArc");
+ (Xen_to_C_XArc(ptr))->angle2 = (short)Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_angle1(XEN ptr)
+static Xen gxm_angle1(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XArc_P(ptr), ptr, XEN_ONLY_ARG, "angle1", "XArc");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XArc(ptr))->angle1)));
+ XM_field_assert_type(Xen_is_XArc(ptr), ptr, 1, "angle1", "XArc");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XArc(ptr))->angle1)));
}
-static XEN gxm_set_angle1(XEN ptr, XEN val)
+static Xen gxm_set_angle1(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_1, "angle1", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XArc_P(ptr), ptr, XEN_ARG_2, "angle1", "XArc");
- (XEN_TO_C_XArc(ptr))->angle1 = (short)XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 1, "angle1", "an integer");
+ XM_set_field_assert_type(Xen_is_XArc(ptr), ptr, 2, "angle1", "XArc");
+ (Xen_to_C_XArc(ptr))->angle1 = (short)Xen_integer_to_C_int(val);
return(val);
}
/* XColor */
-static XEN gxm_XColor(XEN pixel, XEN red, XEN green, XEN blue, XEN flags, XEN pad)
+static Xen gxm_XColor(Xen pixel, Xen red, Xen green, Xen blue, Xen flags, Xen pad)
{
XColor *r;
#define H_XColor "(XColor pixel red green blue flags pad): new XColor struct"
- XEN_ASSERT_TYPE(XEN_ULONG_P(pixel) || XEN_NOT_BOUND_P(pixel), pixel, 1, "XColor", "ulong");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(red), red, 2, "XColor", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(green), green, 3, "XColor", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(blue), blue, 4, "XColor", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(flags), flags, 5, "XColor", "char");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(pad), pad, 6, "XColor", "char");
+ Xen_check_type(Xen_is_ulong(pixel) || !Xen_is_bound(pixel), pixel, 1, "XColor", "ulong");
+ Xen_check_type(Xen_is_integer_or_unbound(red), red, 2, "XColor", "int");
+ Xen_check_type(Xen_is_integer_or_unbound(green), green, 3, "XColor", "int");
+ Xen_check_type(Xen_is_integer_or_unbound(blue), blue, 4, "XColor", "int");
+ Xen_check_type(Xen_is_integer_or_unbound(flags), flags, 5, "XColor", "char");
+ Xen_check_type(Xen_is_integer_or_unbound(pad), pad, 6, "XColor", "char");
r = (XColor *)calloc(1, sizeof(XColor));
- if (XEN_BOUND_P(pixel)) r->pixel = XEN_TO_C_ULONG(pixel);
- if (XEN_BOUND_P(red)) r->red = XEN_TO_C_INT(red);
- if (XEN_BOUND_P(green)) r->green = XEN_TO_C_INT(green);
- if (XEN_BOUND_P(blue)) r->blue = XEN_TO_C_INT(blue);
- if (XEN_BOUND_P(flags)) r->flags = (char)XEN_TO_C_INT(flags);
- if (XEN_BOUND_P(pad)) r->pad = (char)XEN_TO_C_INT(pad);
- return(C_TO_XEN_XColor(r));
+ if (Xen_is_bound(pixel)) r->pixel = Xen_ulong_to_C_ulong(pixel);
+ if (Xen_is_bound(red)) r->red = Xen_integer_to_C_int(red);
+ if (Xen_is_bound(green)) r->green = Xen_integer_to_C_int(green);
+ if (Xen_is_bound(blue)) r->blue = Xen_integer_to_C_int(blue);
+ if (Xen_is_bound(flags)) r->flags = (char)Xen_integer_to_C_int(flags);
+ if (Xen_is_bound(pad)) r->pad = (char)Xen_integer_to_C_int(pad);
+ return(C_to_Xen_XColor(r));
}
-static XEN gxm_pad(XEN ptr)
+static Xen gxm_pad(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XColor_P(ptr), ptr, XEN_ONLY_ARG, "pad", "XColor");
- return(C_TO_XEN_char((char)((XEN_TO_C_XColor(ptr))->pad)));
+ XM_field_assert_type(Xen_is_XColor(ptr), ptr, 1, "pad", "XColor");
+ return(C_int_to_Xen_integer((char)((Xen_to_C_XColor(ptr))->pad)));
}
-static XEN gxm_set_pad(XEN ptr, XEN val)
+static Xen gxm_set_pad(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XColor_P(ptr), ptr, XEN_ARG_1, "pad", "XColor");
- XM_SET_FIELD_ASSERT_TYPE(XEN_char_P(val), val, XEN_ARG_2, "pad", "char");
- (XEN_TO_C_XColor(ptr))->pad = XEN_TO_C_char(val);
+ XM_set_field_assert_type(Xen_is_XColor(ptr), ptr, 1, "pad", "XColor");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "pad", "char");
+ (Xen_to_C_XColor(ptr))->pad = (char)Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_blue(XEN ptr)
+static Xen gxm_blue(Xen ptr)
{
- if (XEN_XColor_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XColor(ptr))->blue)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "blue", "XColor");
- return(XEN_FALSE);
+ if (Xen_is_XColor(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XColor(ptr))->blue)));
+ XM_field_assert_type(0, ptr, 1, "blue", "XColor");
+ return(Xen_false);
}
-static XEN gxm_set_blue(XEN ptr, XEN val)
+static Xen gxm_set_blue(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "blue", "an integer");
- if (XEN_XColor_P(ptr)) (XEN_TO_C_XColor(ptr))->blue = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "blue", "XColor");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "blue", "an integer");
+ if (Xen_is_XColor(ptr)) (Xen_to_C_XColor(ptr))->blue = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "blue", "XColor");
return(val);
}
-static XEN gxm_green(XEN ptr)
+static Xen gxm_green(Xen ptr)
{
- if (XEN_XColor_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XColor(ptr))->green)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "green", "XColor");
- return(XEN_FALSE);
+ if (Xen_is_XColor(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XColor(ptr))->green)));
+ XM_field_assert_type(0, ptr, 1, "green", "XColor");
+ return(Xen_false);
}
-static XEN gxm_set_green(XEN ptr, XEN val)
+static Xen gxm_set_green(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "green", "an integer");
- if (XEN_XColor_P(ptr)) (XEN_TO_C_XColor(ptr))->green = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "green", "XColor");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "green", "an integer");
+ if (Xen_is_XColor(ptr)) (Xen_to_C_XColor(ptr))->green = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "green", "XColor");
return(val);
}
-static XEN gxm_red(XEN ptr)
+static Xen gxm_red(Xen ptr)
{
- if (XEN_XColor_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XColor(ptr))->red)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "red", "XColor");
- return(XEN_FALSE);
+ if (Xen_is_XColor(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XColor(ptr))->red)));
+ XM_field_assert_type(0, ptr, 1, "red", "XColor");
+ return(Xen_false);
}
-static XEN gxm_set_red(XEN ptr, XEN val)
+static Xen gxm_set_red(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "red", "an integer");
- if (XEN_XColor_P(ptr)) (XEN_TO_C_XColor(ptr))->red = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "red", "XColor");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "red", "an integer");
+ if (Xen_is_XColor(ptr)) (Xen_to_C_XColor(ptr))->red = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "red", "XColor");
return(val);
}
-static XEN gxm_XWindowChanges(XEN x, XEN y, XEN width, XEN height, XEN border_width, XEN sibling, XEN stack_mode)
+static Xen gxm_XWindowChanges(Xen x, Xen y, Xen width, Xen height, Xen border_width, Xen sibling, Xen stack_mode)
{
XWindowChanges *r;
#define H_XWindowChanges "(XWindowChanges x y w h border sib stack_mode): new XWindowChanges struct"
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(x), x, 1, "XWindowChanges", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(y), y, 2, "XWindowChanges", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(width), width, 3, "XWindowChanges", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(height), height, 4, "XWindowChanges", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(border_width), border_width, 5, "XWindowChanges", "int");
- XEN_ASSERT_TYPE(XEN_Window_P(sibling) || XEN_NOT_BOUND_P(sibling), sibling, 6, "XWindowChanges", "Window");
- XEN_ASSERT_TYPE(XEN_INTEGER_IF_BOUND_P(stack_mode), stack_mode, 7, "XWindowChanges", "int");
+ Xen_check_type(Xen_is_integer_or_unbound(x), x, 1, "XWindowChanges", "int");
+ Xen_check_type(Xen_is_integer_or_unbound(y), y, 2, "XWindowChanges", "int");
+ Xen_check_type(Xen_is_integer_or_unbound(width), width, 3, "XWindowChanges", "int");
+ Xen_check_type(Xen_is_integer_or_unbound(height), height, 4, "XWindowChanges", "int");
+ Xen_check_type(Xen_is_integer_or_unbound(border_width), border_width, 5, "XWindowChanges", "int");
+ Xen_check_type(Xen_is_Window(sibling) || !Xen_is_bound(sibling), sibling, 6, "XWindowChanges", "Window");
+ Xen_check_type(Xen_is_integer_or_unbound(stack_mode), stack_mode, 7, "XWindowChanges", "int");
r = (XWindowChanges *)calloc(1, sizeof(XWindowChanges));
- if (XEN_BOUND_P(x)) r->x = XEN_TO_C_INT(x);
- if (XEN_BOUND_P(y)) r->y = XEN_TO_C_INT(y);
- if (XEN_BOUND_P(width)) r->width = XEN_TO_C_INT(width);
- if (XEN_BOUND_P(height)) r->height = XEN_TO_C_INT(height);
- if (XEN_BOUND_P(border_width)) r->border_width = XEN_TO_C_INT(border_width);
- if (XEN_BOUND_P(sibling)) r->sibling = XEN_TO_C_Window(sibling);
- if (XEN_BOUND_P(stack_mode)) r->stack_mode = XEN_TO_C_INT(stack_mode);
- return(C_TO_XEN_XWindowChanges(r));
+ if (Xen_is_bound(x)) r->x = Xen_integer_to_C_int(x);
+ if (Xen_is_bound(y)) r->y = Xen_integer_to_C_int(y);
+ if (Xen_is_bound(width)) r->width = Xen_integer_to_C_int(width);
+ if (Xen_is_bound(height)) r->height = Xen_integer_to_C_int(height);
+ if (Xen_is_bound(border_width)) r->border_width = Xen_integer_to_C_int(border_width);
+ if (Xen_is_bound(sibling)) r->sibling = Xen_to_C_Window(sibling);
+ if (Xen_is_bound(stack_mode)) r->stack_mode = Xen_integer_to_C_int(stack_mode);
+ return(C_to_Xen_XWindowChanges(r));
}
-static XEN gxm_XSetWindowAttributes(XEN arglist)
+static Xen gxm_XSetWindowAttributes(Xen arglist)
{
int len;
XSetWindowAttributes *r;
#define H_XSetWindowAttributes "(XSetWindowAttributes args): new XSetWindowAttributes struct (14 or more args!)"
r = (XSetWindowAttributes *)calloc(1, sizeof(XSetWindowAttributes));
- len = XEN_LIST_LENGTH(arglist);
- if ((len > 0) && (XEN_Pixmap_P(XEN_LIST_REF(arglist, 0)))) r->background_pixmap = XEN_TO_C_Pixmap(XEN_LIST_REF(arglist, 0));
- if ((len > 1) && (XEN_Pixel_P(XEN_LIST_REF(arglist, 1)))) r->background_pixel = XEN_TO_C_Pixel(XEN_LIST_REF(arglist, 1));
- if ((len > 2) && (XEN_Pixmap_P(XEN_LIST_REF(arglist, 2)))) r->border_pixmap = XEN_TO_C_Pixmap(XEN_LIST_REF(arglist, 2));
- if ((len > 3) && (XEN_Pixel_P(XEN_LIST_REF(arglist, 3)))) r->border_pixel = XEN_TO_C_Pixel(XEN_LIST_REF(arglist, 3));
- if ((len > 4) && (XEN_INTEGER_P(XEN_LIST_REF(arglist, 4)))) r->bit_gravity = XEN_TO_C_INT(XEN_LIST_REF(arglist, 4));
- if ((len > 5) && (XEN_INTEGER_P(XEN_LIST_REF(arglist, 5)))) r->win_gravity = XEN_TO_C_INT(XEN_LIST_REF(arglist, 5));
- if ((len > 6) && (XEN_INTEGER_P(XEN_LIST_REF(arglist, 6)))) r->backing_store = XEN_TO_C_INT(XEN_LIST_REF(arglist, 6));
- if ((len > 7) && (XEN_ULONG_P(XEN_LIST_REF(arglist, 7)))) r->backing_planes = XEN_TO_C_ULONG(XEN_LIST_REF(arglist, 7));
- if ((len > 8) && (XEN_Pixel_P(XEN_LIST_REF(arglist, 8)))) r->backing_pixel = XEN_TO_C_Pixel(XEN_LIST_REF(arglist, 8));
- if ((len > 9) && (XEN_BOOLEAN_P(XEN_LIST_REF(arglist, 9)))) r->save_under = XEN_TO_C_BOOLEAN(XEN_LIST_REF(arglist, 9));
- if ((len > 10) && (XEN_INTEGER_P(XEN_LIST_REF(arglist, 10)))) r->event_mask = XEN_TO_C_INT(XEN_LIST_REF(arglist, 10));
- if ((len > 11) && (XEN_INTEGER_P(XEN_LIST_REF(arglist, 11)))) r->do_not_propagate_mask = XEN_TO_C_INT(XEN_LIST_REF(arglist, 11));
- if ((len > 12) && (XEN_BOOLEAN_P(XEN_LIST_REF(arglist, 12)))) r->override_redirect = XEN_TO_C_BOOLEAN(XEN_LIST_REF(arglist, 12));
- if ((len > 13) && (XEN_Colormap_P(XEN_LIST_REF(arglist, 13)))) r->colormap = XEN_TO_C_Colormap(XEN_LIST_REF(arglist, 13));
- if ((len > 14) && (XEN_Cursor_P(XEN_LIST_REF(arglist, 14)))) r->cursor = XEN_TO_C_Cursor(XEN_LIST_REF(arglist, 14));
- return(C_TO_XEN_XSetWindowAttributes(r));
+ len = Xen_list_length(arglist);
+ if ((len > 0) && (Xen_is_Pixmap(Xen_list_ref(arglist, 0)))) r->background_pixmap = Xen_to_C_Pixmap(Xen_list_ref(arglist, 0));
+ if ((len > 1) && (Xen_is_Pixel(Xen_list_ref(arglist, 1)))) r->background_pixel = Xen_to_C_Pixel(Xen_list_ref(arglist, 1));
+ if ((len > 2) && (Xen_is_Pixmap(Xen_list_ref(arglist, 2)))) r->border_pixmap = Xen_to_C_Pixmap(Xen_list_ref(arglist, 2));
+ if ((len > 3) && (Xen_is_Pixel(Xen_list_ref(arglist, 3)))) r->border_pixel = Xen_to_C_Pixel(Xen_list_ref(arglist, 3));
+ if ((len > 4) && (Xen_is_integer(Xen_list_ref(arglist, 4)))) r->bit_gravity = Xen_integer_to_C_int(Xen_list_ref(arglist, 4));
+ if ((len > 5) && (Xen_is_integer(Xen_list_ref(arglist, 5)))) r->win_gravity = Xen_integer_to_C_int(Xen_list_ref(arglist, 5));
+ if ((len > 6) && (Xen_is_integer(Xen_list_ref(arglist, 6)))) r->backing_store = Xen_integer_to_C_int(Xen_list_ref(arglist, 6));
+ if ((len > 7) && (Xen_is_ulong(Xen_list_ref(arglist, 7)))) r->backing_planes = Xen_ulong_to_C_ulong(Xen_list_ref(arglist, 7));
+ if ((len > 8) && (Xen_is_Pixel(Xen_list_ref(arglist, 8)))) r->backing_pixel = Xen_to_C_Pixel(Xen_list_ref(arglist, 8));
+ if ((len > 9) && (Xen_is_boolean(Xen_list_ref(arglist, 9)))) r->save_under = Xen_boolean_to_C_bool(Xen_list_ref(arglist, 9));
+ if ((len > 10) && (Xen_is_integer(Xen_list_ref(arglist, 10)))) r->event_mask = Xen_integer_to_C_int(Xen_list_ref(arglist, 10));
+ if ((len > 11) && (Xen_is_integer(Xen_list_ref(arglist, 11)))) r->do_not_propagate_mask = Xen_integer_to_C_int(Xen_list_ref(arglist, 11));
+ if ((len > 12) && (Xen_is_boolean(Xen_list_ref(arglist, 12)))) r->override_redirect = Xen_boolean_to_C_bool(Xen_list_ref(arglist, 12));
+ if ((len > 13) && (Xen_is_Colormap(Xen_list_ref(arglist, 13)))) r->colormap = Xen_to_C_Colormap(Xen_list_ref(arglist, 13));
+ if ((len > 14) && (Xen_is_Cursor(Xen_list_ref(arglist, 14)))) r->cursor = Xen_to_C_Cursor(Xen_list_ref(arglist, 14));
+ return(C_to_Xen_XSetWindowAttributes(r));
}
-static XEN gxm_stack_mode(XEN ptr)
+static Xen gxm_stack_mode(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowChanges_P(ptr), ptr, XEN_ONLY_ARG, "stack_mode", "XWindowChanges");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowChanges(ptr))->stack_mode)));
+ XM_field_assert_type(Xen_is_XWindowChanges(ptr), ptr, 1, "stack_mode", "XWindowChanges");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowChanges(ptr))->stack_mode)));
}
-static XEN gxm_sibling(XEN ptr)
+static Xen gxm_sibling(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowChanges_P(ptr), ptr, XEN_ONLY_ARG, "sibling", "XWindowChanges");
- return(C_TO_XEN_Window((Window)((XEN_TO_C_XWindowChanges(ptr))->sibling)));
+ XM_field_assert_type(Xen_is_XWindowChanges(ptr), ptr, 1, "sibling", "XWindowChanges");
+ return(C_to_Xen_Window((Window)((Xen_to_C_XWindowChanges(ptr))->sibling)));
}
-static XEN gxm_obdata(XEN ptr)
+static Xen gxm_obdata(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XImage_P(ptr), ptr, XEN_ONLY_ARG, "obdata", "XImage");
- return(XEN_WRAP_C_POINTER((XPointer)((XEN_TO_C_XImage(ptr))->obdata)));
+ XM_field_assert_type(Xen_is_XImage(ptr), ptr, 1, "obdata", "XImage");
+ return(Xen_wrap_C_pointer((XPointer)((Xen_to_C_XImage(ptr))->obdata)));
}
-static XEN gxm_bytes_per_line(XEN ptr)
+static Xen gxm_bytes_per_line(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XImage_P(ptr), ptr, XEN_ONLY_ARG, "bytes_per_line", "XImage");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->bytes_per_line)));
+ XM_field_assert_type(Xen_is_XImage(ptr), ptr, 1, "bytes_per_line", "XImage");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->bytes_per_line)));
}
-static XEN gxm_bitmap_pad(XEN ptr)
+static Xen gxm_bitmap_pad(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XImage_P(ptr), ptr, XEN_ONLY_ARG, "bitmap_pad", "XImage");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->bitmap_pad)));
+ XM_field_assert_type(Xen_is_XImage(ptr), ptr, 1, "bitmap_pad", "XImage");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->bitmap_pad)));
}
-static XEN gxm_bitmap_bit_order(XEN ptr)
+static Xen gxm_bitmap_bit_order(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XImage_P(ptr), ptr, XEN_ONLY_ARG, "bitmap_bit_order", "XImage");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->bitmap_bit_order)));
+ XM_field_assert_type(Xen_is_XImage(ptr), ptr, 1, "bitmap_bit_order", "XImage");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->bitmap_bit_order)));
}
-static XEN gxm_bitmap_unit(XEN ptr)
+static Xen gxm_bitmap_unit(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XImage_P(ptr), ptr, XEN_ONLY_ARG, "bitmap_unit", "XImage");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->bitmap_unit)));
+ XM_field_assert_type(Xen_is_XImage(ptr), ptr, 1, "bitmap_unit", "XImage");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->bitmap_unit)));
}
-static XEN gxm_byte_order(XEN ptr)
+static Xen gxm_byte_order(Xen ptr)
{
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->byte_order)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "byte_order", "XImage");
- return(XEN_FALSE);
+ if (Xen_is_XImage(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->byte_order)));
+ XM_field_assert_type(0, ptr, 1, "byte_order", "XImage");
+ return(Xen_false);
}
-static XEN gxm_xoffset(XEN ptr)
+static Xen gxm_xoffset(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XImage_P(ptr), ptr, XEN_ONLY_ARG, "xoffset", "XImage");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->xoffset)));
+ XM_field_assert_type(Xen_is_XImage(ptr), ptr, 1, "xoffset", "XImage");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->xoffset)));
}
-static XEN gxm_screen(XEN ptr)
+static Xen gxm_screen(Xen ptr)
{
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_Screen((Screen *)((XEN_TO_C_XWindowAttributes(ptr))->screen)));
-#if HAVE_MOTIF
- if (XEN_XmTopLevelEnterCallbackStruct_P(ptr)) return(C_TO_XEN_Screen((Screen *)((XEN_TO_C_XmTopLevelEnterCallbackStruct(ptr))->screen)));
- if (XEN_XmTopLevelLeaveCallbackStruct_P(ptr)) return(C_TO_XEN_Screen((Screen *)((XEN_TO_C_XmTopLevelLeaveCallbackStruct(ptr))->screen)));
-#endif
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->screen)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "screen", "a struct with a screen field");
- return(XEN_FALSE);
+ if (Xen_is_XWindowAttributes(ptr)) return(C_to_Xen_Screen((Screen *)((Xen_to_C_XWindowAttributes(ptr))->screen)));
+ if (Xen_is_XmTopLevelEnterCallbackStruct(ptr)) return(C_to_Xen_Screen((Screen *)((Xen_to_C_XmTopLevelEnterCallbackStruct(ptr))->screen)));
+ if (Xen_is_XmTopLevelLeaveCallbackStruct(ptr)) return(C_to_Xen_Screen((Screen *)((Xen_to_C_XmTopLevelLeaveCallbackStruct(ptr))->screen)));
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->screen)));
+ XM_field_assert_type(0, ptr, 1, "screen", "a struct with a screen field");
+ return(Xen_false);
}
-static XEN gxm_your_event_mask(XEN ptr)
+static Xen gxm_your_event_mask(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "your_event_mask", "XWindowAttributes");
- return(C_TO_XEN_INT((long)((XEN_TO_C_XWindowAttributes(ptr))->your_event_mask)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr), ptr, 1, "your_event_mask", "XWindowAttributes");
+ return(C_int_to_Xen_integer((long)((Xen_to_C_XWindowAttributes(ptr))->your_event_mask)));
}
-static XEN gxm_all_event_masks(XEN ptr)
+static Xen gxm_all_event_masks(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "all_event_masks", "XWindowAttributes");
- return(C_TO_XEN_INT((long)((XEN_TO_C_XWindowAttributes(ptr))->all_event_masks)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr), ptr, 1, "all_event_masks", "XWindowAttributes");
+ return(C_int_to_Xen_integer((long)((Xen_to_C_XWindowAttributes(ptr))->all_event_masks)));
}
-static XEN gxm_map_state(XEN ptr)
+static Xen gxm_map_state(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "map_state", "XWindowAttributes");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->map_state)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr), ptr, 1, "map_state", "XWindowAttributes");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->map_state)));
}
-static XEN gxm_map_installed(XEN ptr)
+static Xen gxm_map_installed(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "map_installed", "XWindowAttributes");
- return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XWindowAttributes(ptr))->map_installed)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr), ptr, 1, "map_installed", "XWindowAttributes");
+ return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XWindowAttributes(ptr))->map_installed)));
}
-static XEN gxm_set_visual(XEN ptr, XEN val)
+static Xen gxm_set_visual(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Visual_P(val), val, XEN_ARG_2, "visual", "Visual");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ARG_1, "visual", "Visual");
- (XEN_TO_C_XpmAttributes(ptr))->visual = (Visual *)XEN_TO_C_Visual(val);
+ XM_set_field_assert_type(Xen_is_Visual(val), val, 2, "visual", "Visual");
+ XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "visual", "Visual");
+ (Xen_to_C_XpmAttributes(ptr))->visual = (Visual *)Xen_to_C_Visual(val);
return(val);
}
-static XEN gxm_visual(XEN ptr)
+static Xen gxm_visual(Xen ptr)
{
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_Visual((Visual *)((XEN_TO_C_XWindowAttributes(ptr))->visual)));
- if (XEN_XpmAttributes_P(ptr)) return(C_TO_XEN_Visual((Visual *)((XEN_TO_C_XpmAttributes(ptr))->visual)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "visual", "a struct with a visual field");
- return(XEN_FALSE);
+ if (Xen_is_XWindowAttributes(ptr)) return(C_to_Xen_Visual((Visual *)((Xen_to_C_XWindowAttributes(ptr))->visual)));
+ if (Xen_is_XpmAttributes(ptr)) return(C_to_Xen_Visual((Visual *)((Xen_to_C_XpmAttributes(ptr))->visual)));
+ XM_field_assert_type(0, ptr, 1, "visual", "a struct with a visual field");
+ return(Xen_false);
}
-static XEN gxm_cursor(XEN ptr)
+static Xen gxm_cursor(Xen ptr)
{
- if (XEN_XSetWindowAttributes_P(ptr)) return(C_TO_XEN_Cursor((Cursor)((XEN_TO_C_XSetWindowAttributes(ptr))->cursor)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "cursor", "XSetWindowAttributes");
- return(XEN_FALSE);
+ if (Xen_is_XSetWindowAttributes(ptr)) return(C_to_Xen_Cursor((Cursor)((Xen_to_C_XSetWindowAttributes(ptr))->cursor)));
+ XM_field_assert_type(0, ptr, 1, "cursor", "XSetWindowAttributes");
+ return(Xen_false);
}
-static XEN gxm_set_cursor(XEN ptr, XEN val)
+static Xen gxm_set_cursor(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ARG_1, "cursor", "XSetWindowAttributes");
- XM_SET_FIELD_ASSERT_TYPE(XEN_Cursor_P(val), val, XEN_ARG_2, "cursor", "a Cursor");
- (XEN_TO_C_XSetWindowAttributes(ptr))->cursor = XEN_TO_C_Cursor(val);
+ XM_set_field_assert_type(Xen_is_XSetWindowAttributes(ptr), ptr, 1, "cursor", "XSetWindowAttributes");
+ XM_set_field_assert_type(Xen_is_Cursor(val), val, 2, "cursor", "a Cursor");
+ (Xen_to_C_XSetWindowAttributes(ptr))->cursor = Xen_to_C_Cursor(val);
return(val);
}
-static XEN gxm_do_not_propagate_mask(XEN ptr)
+static Xen gxm_do_not_propagate_mask(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr) || XEN_XSetWindowAttributes_P(ptr),
- ptr, XEN_ONLY_ARG, "do_not_propagate_mask", "a struct with a do_not_propagate_mask field");
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((long)((XEN_TO_C_XWindowAttributes(ptr))->do_not_propagate_mask)));
- return(C_TO_XEN_INT((long)((XEN_TO_C_XSetWindowAttributes(ptr))->do_not_propagate_mask)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr) || Xen_is_XSetWindowAttributes(ptr),
+ ptr, 1, "do_not_propagate_mask", "a struct with a do_not_propagate_mask field");
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((long)((Xen_to_C_XWindowAttributes(ptr))->do_not_propagate_mask)));
+ return(C_int_to_Xen_integer((long)((Xen_to_C_XSetWindowAttributes(ptr))->do_not_propagate_mask)));
}
-static XEN gxm_event_mask(XEN ptr)
+static Xen gxm_event_mask(Xen ptr)
{
- if (XEN_XSetWindowAttributes_P(ptr)) return(C_TO_XEN_INT((long)((XEN_TO_C_XSetWindowAttributes(ptr))->event_mask)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "event_mask", "XSetWindowAttributes");
- return(XEN_FALSE);
+ if (Xen_is_XSetWindowAttributes(ptr)) return(C_int_to_Xen_integer((long)((Xen_to_C_XSetWindowAttributes(ptr))->event_mask)));
+ XM_field_assert_type(0, ptr, 1, "event_mask", "XSetWindowAttributes");
+ return(Xen_false);
}
-static XEN gxm_set_event_mask(XEN ptr, XEN val)
+static Xen gxm_set_event_mask(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ARG_1, "event_mask", "XSetWindowAttributes");
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "event_mask", "an integer");
- (XEN_TO_C_XSetWindowAttributes(ptr))->event_mask = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_XSetWindowAttributes(ptr), ptr, 1, "event_mask", "XSetWindowAttributes");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "event_mask", "an integer");
+ (Xen_to_C_XSetWindowAttributes(ptr))->event_mask = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_save_under(XEN ptr)
+static Xen gxm_save_under(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr) || XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "save_under", "a struct with a save_under field");
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XWindowAttributes(ptr))->save_under)));
- return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XSetWindowAttributes(ptr))->save_under)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr) || Xen_is_XSetWindowAttributes(ptr), ptr, 1, "save_under", "a struct with a save_under field");
+ if (Xen_is_XWindowAttributes(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XWindowAttributes(ptr))->save_under)));
+ return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XSetWindowAttributes(ptr))->save_under)));
}
-static XEN gxm_set_save_under(XEN ptr, XEN val)
+static Xen gxm_set_save_under(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr) || XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ARG_1, "save_under", "a struct with a save_under field");
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "save_under", "a Boolean");
- if (XEN_XWindowAttributes_P(ptr))
- (XEN_TO_C_XWindowAttributes(ptr))->save_under = XEN_TO_C_BOOLEAN(val);
+ XM_set_field_assert_type(Xen_is_XWindowAttributes(ptr) || Xen_is_XSetWindowAttributes(ptr), ptr, 1, "save_under", "a struct with a save_under field");
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "save_under", "a Boolean");
+ if (Xen_is_XWindowAttributes(ptr))
+ (Xen_to_C_XWindowAttributes(ptr))->save_under = Xen_boolean_to_C_bool(val);
else
- (XEN_TO_C_XSetWindowAttributes(ptr))->save_under = XEN_TO_C_BOOLEAN(val);
+ (Xen_to_C_XSetWindowAttributes(ptr))->save_under = Xen_boolean_to_C_bool(val);
return(val);
}
-static XEN gxm_backing_pixel(XEN ptr)
+static Xen gxm_backing_pixel(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr) || XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "backing_pixel", "a struct with a backing_pixel field");
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_Pixel((unsigned long)((XEN_TO_C_XWindowAttributes(ptr))->backing_pixel)));
- return(C_TO_XEN_Pixel((unsigned long)((XEN_TO_C_XSetWindowAttributes(ptr))->backing_pixel)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr) || Xen_is_XSetWindowAttributes(ptr), ptr, 1, "backing_pixel", "a struct with a backing_pixel field");
+ if (Xen_is_XWindowAttributes(ptr)) return(C_to_Xen_Pixel((unsigned long)((Xen_to_C_XWindowAttributes(ptr))->backing_pixel)));
+ return(C_to_Xen_Pixel((unsigned long)((Xen_to_C_XSetWindowAttributes(ptr))->backing_pixel)));
}
-static XEN gxm_backing_planes(XEN ptr)
+static Xen gxm_backing_planes(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr) || XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "backing_planes", "a struct with a backing_planes field");
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XWindowAttributes(ptr))->backing_planes)));
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XSetWindowAttributes(ptr))->backing_planes)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr) || Xen_is_XSetWindowAttributes(ptr), ptr, 1, "backing_planes", "a struct with a backing_planes field");
+ if (Xen_is_XWindowAttributes(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XWindowAttributes(ptr))->backing_planes)));
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XSetWindowAttributes(ptr))->backing_planes)));
}
-static XEN gxm_win_gravity(XEN ptr)
+static Xen gxm_win_gravity(Xen ptr)
{
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->win_gravity)));
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XSetWindowAttributes(ptr))->win_gravity)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "win_gravity", "a struct with a win_gravity field");
- return(XEN_FALSE);
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->win_gravity)));
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XSetWindowAttributes(ptr))->win_gravity)));
+ XM_field_assert_type(0, ptr, 1, "win_gravity", "a struct with a win_gravity field");
+ return(Xen_false);
}
-static XEN gxm_bit_gravity(XEN ptr)
+static Xen gxm_bit_gravity(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr) || XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "bit_gravity", "a struct with a bit_gravity field");
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->bit_gravity)));
- return(C_TO_XEN_INT((int)((XEN_TO_C_XSetWindowAttributes(ptr))->bit_gravity)));
+ XM_field_assert_type(Xen_is_XWindowAttributes(ptr) || Xen_is_XSetWindowAttributes(ptr), ptr, 1, "bit_gravity", "a struct with a bit_gravity field");
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->bit_gravity)));
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XSetWindowAttributes(ptr))->bit_gravity)));
}
-static XEN gxm_set_bit_gravity(XEN ptr, XEN val)
+static Xen gxm_set_bit_gravity(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XWindowAttributes_P(ptr) || XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ARG_1, "bit_gravity", "a struct with a bit_gravity field");
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "bit_gravity", "an integer");
- if (XEN_XWindowAttributes_P(ptr))
- (XEN_TO_C_XWindowAttributes(ptr))->bit_gravity = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_XWindowAttributes(ptr) || Xen_is_XSetWindowAttributes(ptr), ptr, 1, "bit_gravity", "a struct with a bit_gravity field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "bit_gravity", "an integer");
+ if (Xen_is_XWindowAttributes(ptr))
+ (Xen_to_C_XWindowAttributes(ptr))->bit_gravity = Xen_integer_to_C_int(val);
else
- (XEN_TO_C_XSetWindowAttributes(ptr))->bit_gravity = XEN_TO_C_INT(val);
+ (Xen_to_C_XSetWindowAttributes(ptr))->bit_gravity = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_border_pixel(XEN ptr)
+static Xen gxm_border_pixel(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "border_pixel", "XSetWindowAttributes");
- return(C_TO_XEN_Pixel((unsigned long)((XEN_TO_C_XSetWindowAttributes(ptr))->border_pixel)));
+ XM_field_assert_type(Xen_is_XSetWindowAttributes(ptr), ptr, 1, "border_pixel", "XSetWindowAttributes");
+ return(C_to_Xen_Pixel((unsigned long)((Xen_to_C_XSetWindowAttributes(ptr))->border_pixel)));
}
-static XEN gxm_set_border_pixel(XEN ptr, XEN val)
+static Xen gxm_set_border_pixel(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ARG_1, "border_pixel", "XSetWindowAttributes");
- XM_SET_FIELD_ASSERT_TYPE(XEN_Pixel_P(val), val, XEN_ARG_2, "border_pixel", "a Pixel");
- (XEN_TO_C_XSetWindowAttributes(ptr))->border_pixel = XEN_TO_C_Pixel(val);
+ XM_set_field_assert_type(Xen_is_XSetWindowAttributes(ptr), ptr, 1, "border_pixel", "XSetWindowAttributes");
+ XM_set_field_assert_type(Xen_is_Pixel(val), val, 2, "border_pixel", "a Pixel");
+ (Xen_to_C_XSetWindowAttributes(ptr))->border_pixel = Xen_to_C_Pixel(val);
return(val);
}
-static XEN gxm_border_pixmap(XEN ptr)
+static Xen gxm_border_pixmap(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "border_pixmap", "XSetWindowAttributes");
- return(C_TO_XEN_Pixmap((Pixmap)((XEN_TO_C_XSetWindowAttributes(ptr))->border_pixmap)));
+ XM_field_assert_type(Xen_is_XSetWindowAttributes(ptr), ptr, 1, "border_pixmap", "XSetWindowAttributes");
+ return(C_to_Xen_Pixmap((Pixmap)((Xen_to_C_XSetWindowAttributes(ptr))->border_pixmap)));
}
-static XEN gxm_background_pixel(XEN ptr)
+static Xen gxm_background_pixel(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "background_pixel", "XSetWindowAttributes");
- return(C_TO_XEN_Pixel((unsigned long)((XEN_TO_C_XSetWindowAttributes(ptr))->background_pixel)));
+ XM_field_assert_type(Xen_is_XSetWindowAttributes(ptr), ptr, 1, "background_pixel", "XSetWindowAttributes");
+ return(C_to_Xen_Pixel((unsigned long)((Xen_to_C_XSetWindowAttributes(ptr))->background_pixel)));
}
-static XEN gxm_set_background_pixel(XEN ptr, XEN val)
+static Xen gxm_set_background_pixel(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ARG_1, "background_pixel", "XSetWindowAttributes");
- XM_SET_FIELD_ASSERT_TYPE(XEN_Pixel_P(val), val, XEN_ARG_2, "background_pixel", "a Pixel");
- (XEN_TO_C_XSetWindowAttributes(ptr))->background_pixel = XEN_TO_C_Pixel(val);
+ XM_set_field_assert_type(Xen_is_XSetWindowAttributes(ptr), ptr, 1, "background_pixel", "XSetWindowAttributes");
+ XM_set_field_assert_type(Xen_is_Pixel(val), val, 2, "background_pixel", "a Pixel");
+ (Xen_to_C_XSetWindowAttributes(ptr))->background_pixel = Xen_to_C_Pixel(val);
return(val);
}
-static XEN gxm_background_pixmap(XEN ptr)
+static Xen gxm_background_pixmap(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr), ptr, XEN_ONLY_ARG, "background_pixmap", "XSetWindowAttributes");
- return(C_TO_XEN_Pixmap((Pixmap)((XEN_TO_C_XSetWindowAttributes(ptr))->background_pixmap)));
+ XM_field_assert_type(Xen_is_XSetWindowAttributes(ptr), ptr, 1, "background_pixmap", "XSetWindowAttributes");
+ return(C_to_Xen_Pixmap((Pixmap)((Xen_to_C_XSetWindowAttributes(ptr))->background_pixmap)));
}
-static XEN gxm_bits_per_pixel(XEN ptr)
+static Xen gxm_bits_per_pixel(Xen ptr)
{
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->bits_per_pixel)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "bits_per_pixel", "XImage");
- return(XEN_FALSE);
+ if (Xen_is_XImage(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->bits_per_pixel)));
+ XM_field_assert_type(0, ptr, 1, "bits_per_pixel", "XImage");
+ return(Xen_false);
}
-static XEN gxm_visuals(XEN ptr)
+static Xen gxm_visuals(Xen ptr)
{
Depth *dps;
- Visual *vs;
- int i, len;
- XEN lst = XEN_EMPTY_LIST;
- XM_FIELD_ASSERT_TYPE(XEN_Depth_P(ptr), ptr, XEN_ONLY_ARG, "visuals", "Depth");
- dps = XEN_TO_C_Depth(ptr);
+ int len;
+ Xen lst = Xen_empty_list;
+ XM_field_assert_type(Xen_is_Depth(ptr), ptr, 1, "visuals", "Depth");
+ dps = Xen_to_C_Depth(ptr);
len = dps->nvisuals;
if (len > 0)
{
+ int i;
+ Visual *vs;
vs = dps->visuals;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(WRAP_FOR_XEN("Visual", &(vs[i])), lst);
+ lst = Xen_cons(wrap_for_Xen("Visual", &(vs[i])), lst);
}
return(lst);
}
-static XEN gxm_nvisuals(XEN ptr)
+static Xen gxm_nvisuals(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Depth_P(ptr), ptr, XEN_ONLY_ARG, "nvisuals", "Depth");
- return(C_TO_XEN_INT((int)((XEN_TO_C_Depth(ptr))->nvisuals)));
+ XM_field_assert_type(Xen_is_Depth(ptr), ptr, 1, "nvisuals", "Depth");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_Depth(ptr))->nvisuals)));
}
-static XEN gxm_set_depth(XEN ptr, XEN val)
+static Xen gxm_set_depth(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmAttributes_P(ptr), ptr, XEN_ARG_1, "depth", "XpmAttributes");
- (XEN_TO_C_XpmAttributes(ptr))->depth = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_XpmAttributes(ptr), ptr, 1, "depth", "XpmAttributes");
+ (Xen_to_C_XpmAttributes(ptr))->depth = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_depth(XEN ptr)
+static Xen gxm_depth(Xen ptr)
{
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->depth)));
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->depth)));
- if (XEN_Depth_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_Depth(ptr))->depth)));
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->depth)));
- if (XEN_XpmAttributes_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->depth)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "depth", "a struct with a depth field");
- return(XEN_FALSE);
+ if (Xen_is_XImage(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->depth)));
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->depth)));
+ if (Xen_is_Depth(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_Depth(ptr))->depth)));
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->depth)));
+ if (Xen_is_XpmAttributes(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->depth)));
+ XM_field_assert_type(0, ptr, 1, "depth", "a struct with a depth field");
+ return(Xen_false);
}
-static XEN gxm_map_entries(XEN ptr)
+static Xen gxm_map_entries(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Visual_P(ptr), ptr, XEN_ONLY_ARG, "map_entries", "Visual");
- return(C_TO_XEN_INT((int)((XEN_TO_C_Visual(ptr))->map_entries)));
+ XM_field_assert_type(Xen_is_Visual(ptr), ptr, 1, "map_entries", "Visual");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_Visual(ptr))->map_entries)));
}
-static XEN gxm_bits_per_rgb(XEN ptr)
+static Xen gxm_bits_per_rgb(Xen ptr)
{
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->bits_per_rgb)));
- if (XEN_Visual_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_Visual(ptr))->bits_per_rgb)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "bits_per_rgb", "Visual or XVisualInfo");
- return(XEN_FALSE);
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->bits_per_rgb)));
+ if (Xen_is_Visual(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_Visual(ptr))->bits_per_rgb)));
+ XM_field_assert_type(0, ptr, 1, "bits_per_rgb", "Visual or XVisualInfo");
+ return(Xen_false);
}
-static XEN gxm_blue_mask(XEN ptr)
+static Xen gxm_blue_mask(Xen ptr)
{
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XImage(ptr))->blue_mask)));
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->blue_mask)));
- if (XEN_Visual_P(ptr)) return(C_TO_XEN_INT((long)((XEN_TO_C_Visual(ptr))->blue_mask)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "blue_mask", "a struct with a blue_mask field");
- return(XEN_FALSE);
+ if (Xen_is_XImage(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XImage(ptr))->blue_mask)));
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->blue_mask)));
+ if (Xen_is_Visual(ptr)) return(C_int_to_Xen_integer((long)((Xen_to_C_Visual(ptr))->blue_mask)));
+ XM_field_assert_type(0, ptr, 1, "blue_mask", "a struct with a blue_mask field");
+ return(Xen_false);
}
-static XEN gxm_green_mask(XEN ptr)
+static Xen gxm_green_mask(Xen ptr)
{
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XImage(ptr))->green_mask)));
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->green_mask)));
- if (XEN_Visual_P(ptr)) return(C_TO_XEN_INT((long)((XEN_TO_C_Visual(ptr))->green_mask)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "green_mask", "a struct with a green_mask field");
- return(XEN_FALSE);
+ if (Xen_is_XImage(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XImage(ptr))->green_mask)));
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->green_mask)));
+ if (Xen_is_Visual(ptr)) return(C_int_to_Xen_integer((long)((Xen_to_C_Visual(ptr))->green_mask)));
+ XM_field_assert_type(0, ptr, 1, "green_mask", "a struct with a green_mask field");
+ return(Xen_false);
}
-static XEN gxm_red_mask(XEN ptr)
+static Xen gxm_red_mask(Xen ptr)
{
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XImage(ptr))->red_mask)));
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->red_mask)));
- if (XEN_Visual_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_Visual(ptr))->red_mask)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "red_mask", "a struct with a red_mask field");
- return(XEN_FALSE);
+ if (Xen_is_XImage(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XImage(ptr))->red_mask)));
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->red_mask)));
+ if (Xen_is_Visual(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_Visual(ptr))->red_mask)));
+ XM_field_assert_type(0, ptr, 1, "red_mask", "a struct with a red_mask field");
+ return(Xen_false);
}
-static XEN gxm_colormap_size(XEN ptr)
+static Xen gxm_colormap_size(Xen ptr)
{
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->colormap_size)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "colormap_size", "XVisualInfo*");
- return(XEN_FALSE);
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->colormap_size)));
+ XM_field_assert_type(0, ptr, 1, "colormap_size", "XVisualInfo*");
+ return(Xen_false);
}
-static XEN gxm_class(XEN ptr)
+static Xen gxm_class(Xen ptr)
{
#ifndef __cplusplus
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->class)));
- if (XEN_Visual_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_Visual(ptr))->class)));
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->class)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "class", "a struct with a class field");
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->class)));
+ if (Xen_is_Visual(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_Visual(ptr))->class)));
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->class)));
+ XM_field_assert_type(0, ptr, 1, "class", "a struct with a class field");
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_visualid(XEN ptr)
+static Xen gxm_visualid(Xen ptr)
{
- if (XEN_Visual_P(ptr)) return(C_TO_XEN_ULONG((VisualID)((XEN_TO_C_Visual(ptr))->visualid)));
- if (XEN_XStandardColormap_P(ptr)) return(C_TO_XEN_ULONG((VisualID)((XEN_TO_C_XStandardColormap(ptr))->visualid)));
- if (XEN_XVisualInfo_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisualInfo(ptr))->visualid)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "visualid", "a struct with a visualid field");
- return(XEN_FALSE);
+ if (Xen_is_Visual(ptr)) return(C_ulong_to_Xen_ulong((VisualID)((Xen_to_C_Visual(ptr))->visualid)));
+ if (Xen_is_XStandardColormap(ptr)) return(C_ulong_to_Xen_ulong((VisualID)((Xen_to_C_XStandardColormap(ptr))->visualid)));
+ if (Xen_is_XVisualInfo(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisualInfo(ptr))->visualid)));
+ XM_field_assert_type(0, ptr, 1, "visualid", "a struct with a visualid field");
+ return(Xen_false);
}
-static XEN gxm_set_pixel(XEN ptr, XEN val)
+static Xen gxm_set_pixel(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Pixel_P(val), val, XEN_ARG_2, "pixel", "a Pixel");
- if (XEN_XColor_P(ptr)) (XEN_TO_C_XColor(ptr))->pixel = XEN_TO_C_Pixel(val);
- else if (XEN_XpmColorSymbol_P(ptr)) (XEN_TO_C_XpmColorSymbol(ptr))->pixel = XEN_TO_C_Pixel(val);
+ XM_set_field_assert_type(Xen_is_Pixel(val), val, 2, "pixel", "a Pixel");
+ if (Xen_is_XColor(ptr)) (Xen_to_C_XColor(ptr))->pixel = Xen_to_C_Pixel(val);
+ else if (Xen_is_XpmColorSymbol(ptr)) (Xen_to_C_XpmColorSymbol(ptr))->pixel = Xen_to_C_Pixel(val);
return(val);
}
-static XEN gxm_pixel(XEN ptr)
+static Xen gxm_pixel(Xen ptr)
{
- if (XEN_XColor_P(ptr)) return(C_TO_XEN_Pixel((Pixel)((XEN_TO_C_XColor(ptr))->pixel)));
-#if HAVE_MOTIF
- if (XEN_XmScrollBarCallbackStruct_P(ptr)) return(C_TO_XEN_Pixel((Pixel)((XEN_TO_C_XmScrollBarCallbackStruct(ptr))->pixel)));
-#endif
- if (XEN_XpmColorSymbol_P(ptr)) return(C_TO_XEN_Pixel((Pixel)((XEN_TO_C_XpmColorSymbol(ptr))->pixel)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "pixel", "a struct with a pixel field");
- return(XEN_FALSE);
+ if (Xen_is_XColor(ptr)) return(C_to_Xen_Pixel((Pixel)((Xen_to_C_XColor(ptr))->pixel)));
+ if (Xen_is_XmScrollBarCallbackStruct(ptr)) return(C_to_Xen_Pixel((Pixel)((Xen_to_C_XmScrollBarCallbackStruct(ptr))->pixel)));
+ if (Xen_is_XpmColorSymbol(ptr)) return(C_to_Xen_Pixel((Pixel)((Xen_to_C_XpmColorSymbol(ptr))->pixel)));
+ XM_field_assert_type(0, ptr, 1, "pixel", "a struct with a pixel field");
+ return(Xen_false);
}
-static XEN gxm_window_group(XEN ptr)
+static Xen gxm_window_group(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ONLY_ARG, "window_group", "XWMHints");
- return(C_TO_XEN_ULONG((XID)((XEN_TO_C_XWMHints(ptr))->window_group)));
+ XM_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "window_group", "XWMHints");
+ return(C_ulong_to_Xen_ulong((XID)((Xen_to_C_XWMHints(ptr))->window_group)));
}
-static XEN gxm_icon_mask(XEN ptr)
+static Xen gxm_icon_mask(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ONLY_ARG, "icon_mask", "XWMHints");
- return(C_TO_XEN_Pixmap((Pixmap)((XEN_TO_C_XWMHints(ptr))->icon_mask)));
+ XM_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "icon_mask", "XWMHints");
+ return(C_to_Xen_Pixmap((Pixmap)((Xen_to_C_XWMHints(ptr))->icon_mask)));
}
-static XEN gxm_icon_y(XEN ptr)
+static Xen gxm_icon_y(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ONLY_ARG, "icon_y", "XWMHints");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XWMHints(ptr))->icon_y)));
+ XM_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "icon_y", "XWMHints");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XWMHints(ptr))->icon_y)));
}
-static XEN gxm_icon_x(XEN ptr)
+static Xen gxm_icon_x(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ONLY_ARG, "icon_x", "XWMHints");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XWMHints(ptr))->icon_x)));
+ XM_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "icon_x", "XWMHints");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XWMHints(ptr))->icon_x)));
}
-static XEN gxm_icon_window(XEN ptr)
+static Xen gxm_icon_window(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ONLY_ARG, "icon_window", "XWMHints");
- return(C_TO_XEN_Window((Window)((XEN_TO_C_XWMHints(ptr))->icon_window)));
+ XM_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "icon_window", "XWMHints");
+ return(C_to_Xen_Window((Window)((Xen_to_C_XWMHints(ptr))->icon_window)));
}
-static XEN gxm_icon_pixmap(XEN ptr)
+static Xen gxm_icon_pixmap(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ONLY_ARG, "icon_pixmap", "XWMHints");
- return(C_TO_XEN_Pixmap((Pixmap)((XEN_TO_C_XWMHints(ptr))->icon_pixmap)));
+ XM_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "icon_pixmap", "XWMHints");
+ return(C_to_Xen_Pixmap((Pixmap)((Xen_to_C_XWMHints(ptr))->icon_pixmap)));
}
-static XEN gxm_initial_state(XEN ptr)
+static Xen gxm_initial_state(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ONLY_ARG, "initial_state", "XWMHints");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XWMHints(ptr))->initial_state)));
+ XM_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "initial_state", "XWMHints");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XWMHints(ptr))->initial_state)));
}
-static XEN gxm_set_initial_state(XEN ptr, XEN val)
+static Xen gxm_set_initial_state(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ARG_1, "initial_state", "XWMHints");
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "initial_state", "an integer");
- (XEN_TO_C_XWMHints(ptr))->initial_state = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "initial_state", "XWMHints");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "initial_state", "an integer");
+ (Xen_to_C_XWMHints(ptr))->initial_state = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_input(XEN ptr)
+static Xen gxm_input(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ONLY_ARG, "input", "XWMHints");
- return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XWMHints(ptr))->input)));
+ XM_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "input", "XWMHints");
+ return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XWMHints(ptr))->input)));
}
-static XEN gxm_set_input(XEN ptr, XEN val)
+static Xen gxm_set_input(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XWMHints_P(ptr), ptr, XEN_ARG_1, "input", "XWMHints");
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "input", "a boolean");
- (XEN_TO_C_XWMHints(ptr))->input = XEN_TO_C_BOOLEAN(val);
+ XM_set_field_assert_type(Xen_is_XWMHints(ptr), ptr, 1, "input", "XWMHints");
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "input", "a boolean");
+ (Xen_to_C_XWMHints(ptr))->input = Xen_boolean_to_C_bool(val);
return(val);
}
-static XEN gxm_flags(XEN ptr)
+static Xen gxm_flags(Xen ptr)
{
- if (XEN_XColor_P(ptr)) return(C_TO_XEN_char((char)((XEN_TO_C_XColor(ptr))->flags)));
-#if HAVE_MOTIF
- if (XEN_XmSelectionCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmSelectionCallbackStruct(ptr))->flags)));
- if (XEN_XmDestinationCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDestinationCallbackStruct(ptr))->flags)));
- if (XEN_XmConvertCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmConvertCallbackStruct(ptr))->flags)));
-#endif
- if (XEN_XWMHints_P(ptr)) return(C_TO_XEN_INT((long)((XEN_TO_C_XWMHints(ptr))->flags)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "flags", "a struct with a flags field");
- return(XEN_FALSE);
+ if (Xen_is_XColor(ptr)) return(C_int_to_Xen_integer((char)((Xen_to_C_XColor(ptr))->flags)));
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmSelectionCallbackStruct(ptr))->flags)));
+ if (Xen_is_XmDestinationCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDestinationCallbackStruct(ptr))->flags)));
+ if (Xen_is_XmConvertCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmConvertCallbackStruct(ptr))->flags)));
+ if (Xen_is_XWMHints(ptr)) return(C_int_to_Xen_integer((long)((Xen_to_C_XWMHints(ptr))->flags)));
+ XM_field_assert_type(0, ptr, 1, "flags", "a struct with a flags field");
+ return(Xen_false);
}
-static XEN gxm_set_flags(XEN ptr, XEN val)
+static Xen gxm_set_flags(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XColor_P(ptr) || XEN_XWMHints_P(ptr), ptr, XEN_ARG_1, "flags", "XColor or XWMHints");
- XM_SET_FIELD_ASSERT_TYPE(XEN_char_P(val), val, XEN_ARG_2, "input", "a char (int)");
- if (XEN_XColor_P(ptr)) (XEN_TO_C_XColor(ptr))->flags = XEN_TO_C_char(val);
- else if (XEN_XWMHints_P(ptr)) (XEN_TO_C_XWMHints(ptr))->flags = XEN_TO_C_char(val);
+ XM_set_field_assert_type(Xen_is_XColor(ptr) || Xen_is_XWMHints(ptr), ptr, 1, "flags", "XColor or XWMHints");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "input", "a char (int)");
+ if (Xen_is_XColor(ptr)) (Xen_to_C_XColor(ptr))->flags = (char)Xen_integer_to_C_int(val);
+ else if (Xen_is_XWMHints(ptr)) (Xen_to_C_XWMHints(ptr))->flags = (char)Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_per_char(XEN ptr)
+static Xen gxm_per_char(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XFontStruct_P(ptr), ptr, XEN_ONLY_ARG, "per_char", "XFontStruct");
- return(C_TO_XEN_XCharStruct((XCharStruct *)((XEN_TO_C_XFontStruct(ptr))->per_char)));
+ XM_field_assert_type(Xen_is_XFontStruct(ptr), ptr, 1, "per_char", "XFontStruct");
+ return(C_to_Xen_XCharStruct((XCharStruct *)((Xen_to_C_XFontStruct(ptr))->per_char)));
}
-static XEN gxm_max_bounds(XEN ptr)
+static Xen gxm_max_bounds(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XFontStruct_P(ptr), ptr, XEN_ONLY_ARG, "max_bounds", "XFontStruct");
- return(C_TO_XEN_XCharStruct((XCharStruct *)(&(XEN_TO_C_XFontStruct(ptr))->max_bounds)));
+ XM_field_assert_type(Xen_is_XFontStruct(ptr), ptr, 1, "max_bounds", "XFontStruct");
+ return(C_to_Xen_XCharStruct((XCharStruct *)(&(Xen_to_C_XFontStruct(ptr))->max_bounds)));
}
-static XEN gxm_min_bounds(XEN ptr)
+static Xen gxm_min_bounds(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XFontStruct_P(ptr), ptr, XEN_ONLY_ARG, "min_bounds", "XFontStruct");
- return(C_TO_XEN_XCharStruct((XCharStruct *)(&(XEN_TO_C_XFontStruct(ptr))->min_bounds)));
+ XM_field_assert_type(Xen_is_XFontStruct(ptr), ptr, 1, "min_bounds", "XFontStruct");
+ return(C_to_Xen_XCharStruct((XCharStruct *)(&(Xen_to_C_XFontStruct(ptr))->min_bounds)));
}
-static XEN gxm_min_height(XEN ptr)
+static Xen gxm_min_height(Xen ptr)
{
- if (XEN_XIconSize_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XIconSize(ptr))->min_height)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "min_height", "XIconSize");
- return(XEN_FALSE);
+ if (Xen_is_XIconSize(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XIconSize(ptr))->min_height)));
+ XM_field_assert_type(0, ptr, 1, "min_height", "XIconSize");
+ return(Xen_false);
}
-static XEN gxm_min_width(XEN ptr)
+static Xen gxm_min_width(Xen ptr)
{
- if (XEN_XIconSize_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XIconSize(ptr))->min_width)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "min_width", "XIconSize");
- return(XEN_FALSE);
+ if (Xen_is_XIconSize(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XIconSize(ptr))->min_width)));
+ XM_field_assert_type(0, ptr, 1, "min_width", "XIconSize");
+ return(Xen_false);
}
-static XEN gxm_max_height(XEN ptr)
+static Xen gxm_max_height(Xen ptr)
{
- if (XEN_XIconSize_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XIconSize(ptr))->max_height)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "max_height", "XIconSize");
- return(XEN_FALSE);
+ if (Xen_is_XIconSize(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XIconSize(ptr))->max_height)));
+ XM_field_assert_type(0, ptr, 1, "max_height", "XIconSize");
+ return(Xen_false);
}
-static XEN gxm_max_width(XEN ptr)
+static Xen gxm_max_width(Xen ptr)
{
- if (XEN_XIconSize_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XIconSize(ptr))->max_width)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "max_width", "XIconSize");
- return(XEN_FALSE);
+ if (Xen_is_XIconSize(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XIconSize(ptr))->max_width)));
+ XM_field_assert_type(0, ptr, 1, "max_width", "XIconSize");
+ return(Xen_false);
}
-static XEN gxm_height_inc(XEN ptr)
+static Xen gxm_height_inc(Xen ptr)
{
- if (XEN_XIconSize_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XIconSize(ptr))->height_inc)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "height_inc", "XIconSize");
- return(XEN_FALSE);
+ if (Xen_is_XIconSize(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XIconSize(ptr))->height_inc)));
+ XM_field_assert_type(0, ptr, 1, "height_inc", "XIconSize");
+ return(Xen_false);
}
-static XEN gxm_width_inc(XEN ptr)
+static Xen gxm_width_inc(Xen ptr)
{
- if (XEN_XIconSize_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XIconSize(ptr))->width_inc)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "width_inc", "XIconSize");
- return(XEN_FALSE);
+ if (Xen_is_XIconSize(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XIconSize(ptr))->width_inc)));
+ XM_field_assert_type(0, ptr, 1, "width_inc", "XIconSize");
+ return(Xen_false);
}
-static XEN gxm_properties(XEN ptr)
+static Xen gxm_properties(Xen ptr)
{
int i, len;
XFontStruct *fs;
XFontProp *props;
- XEN lst = XEN_EMPTY_LIST;
- XM_FIELD_ASSERT_TYPE(XEN_XFontStruct_P(ptr), ptr, XEN_ONLY_ARG, "properties", "XFontStruct");
- fs = XEN_TO_C_XFontStruct(ptr);
+ Xen lst = Xen_empty_list;
+ XM_field_assert_type(Xen_is_XFontStruct(ptr), ptr, 1, "properties", "XFontStruct");
+ fs = Xen_to_C_XFontStruct(ptr);
len = fs->n_properties;
props = fs->properties;
for (i = 0; i < len; i++)
- lst = XEN_CONS(C_TO_XEN_XFontProp(&(props[i])), lst);
+ lst = Xen_cons(C_to_Xen_XFontProp(&(props[i])), lst);
return(lst);
}
-static XEN gxm_fid(XEN ptr)
+static Xen gxm_fid(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XFontStruct_P(ptr), ptr, XEN_ONLY_ARG, "fid", "XFontStruct");
- return(C_TO_XEN_Font((Font)((XEN_TO_C_XFontStruct(ptr))->fid)));
+ XM_field_assert_type(Xen_is_XFontStruct(ptr), ptr, 1, "fid", "XFontStruct");
+ return(C_to_Xen_Font((Font)((Xen_to_C_XFontStruct(ptr))->fid)));
}
-static XEN gxm_card32(XEN ptr)
+static Xen gxm_card32(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XFontProp_P(ptr), ptr, XEN_ONLY_ARG, "card32", "XFontProp");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XFontProp(ptr))->card32)));
+ XM_field_assert_type(Xen_is_XFontProp(ptr), ptr, 1, "card32", "XFontProp");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XFontProp(ptr))->card32)));
}
-static XEN gxm_set_name(XEN ptr, XEN val)
+static Xen gxm_set_name(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ARG_2, "name", "a string");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XpmColorSymbol_P(ptr), ptr, XEN_ARG_1, "name", "XpmColorSymbol");
- (XEN_TO_C_XpmColorSymbol(ptr))->name = xen_strdup(XEN_TO_C_STRING(val));
+ XM_set_field_assert_type(Xen_is_string(val), val, 2, "name", "a string");
+ XM_set_field_assert_type(Xen_is_XpmColorSymbol(ptr), ptr, 1, "name", "XpmColorSymbol");
+ (Xen_to_C_XpmColorSymbol(ptr))->name = xen_strdup(Xen_string_to_C_string(val));
return(val);
}
-static XEN gxm_name(XEN ptr)
+static Xen gxm_name(Xen ptr)
{
- if (XEN_XFontProp_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XFontProp(ptr))->name)));
- if (XEN_XpmColorSymbol_P(ptr)) return(C_TO_XEN_STRING((char *)((XEN_TO_C_XpmColorSymbol(ptr))->name)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "name", "a struct with a name field");
- return(XEN_FALSE);
+ if (Xen_is_XFontProp(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XFontProp(ptr))->name)));
+ if (Xen_is_XpmColorSymbol(ptr)) return(C_string_to_Xen_string((char *)((Xen_to_C_XpmColorSymbol(ptr))->name)));
+ XM_field_assert_type(0, ptr, 1, "name", "a struct with a name field");
+ return(Xen_false);
}
-static XEN gxm_attributes(XEN ptr)
+static Xen gxm_attributes(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XCharStruct_P(ptr), ptr, XEN_ONLY_ARG, "attributes", "XCharStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XCharStruct(ptr))->attributes)));
+ XM_field_assert_type(Xen_is_XCharStruct(ptr), ptr, 1, "attributes", "XCharStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XCharStruct(ptr))->attributes)));
}
-static XEN gxm_descent(XEN ptr)
+static Xen gxm_descent(Xen ptr)
{
- if (XEN_XFontStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XFontStruct(ptr))->descent)));
- if (XEN_XCharStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCharStruct(ptr))->descent)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "descent", "a struct with a descent field");
- return(XEN_FALSE);
+ if (Xen_is_XFontStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XFontStruct(ptr))->descent)));
+ if (Xen_is_XCharStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCharStruct(ptr))->descent)));
+ XM_field_assert_type(0, ptr, 1, "descent", "a struct with a descent field");
+ return(Xen_false);
}
-static XEN gxm_ascent(XEN ptr)
+static Xen gxm_ascent(Xen ptr)
{
- if (XEN_XFontStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XFontStruct(ptr))->ascent)));
- if (XEN_XCharStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCharStruct(ptr))->ascent)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "ascent", "a struct with an ascent field");
- return(XEN_FALSE);
+ if (Xen_is_XFontStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XFontStruct(ptr))->ascent)));
+ if (Xen_is_XCharStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCharStruct(ptr))->ascent)));
+ XM_field_assert_type(0, ptr, 1, "ascent", "a struct with an ascent field");
+ return(Xen_false);
}
-static XEN gxm_rbearing(XEN ptr)
+static Xen gxm_rbearing(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XCharStruct_P(ptr), ptr, XEN_ONLY_ARG, "rbearing", "XCharStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XCharStruct(ptr))->rbearing)));
+ XM_field_assert_type(Xen_is_XCharStruct(ptr), ptr, 1, "rbearing", "XCharStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XCharStruct(ptr))->rbearing)));
}
-static XEN gxm_lbearing(XEN ptr)
+static Xen gxm_lbearing(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XCharStruct_P(ptr), ptr, XEN_ONLY_ARG, "lbearing", "XCharStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XCharStruct(ptr))->lbearing)));
+ XM_field_assert_type(Xen_is_XCharStruct(ptr), ptr, 1, "lbearing", "XCharStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XCharStruct(ptr))->lbearing)));
}
-static XEN gxm_request_code(XEN ptr)
+static Xen gxm_request_code(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XErrorEvent_P(ptr), ptr, XEN_ONLY_ARG, "request_code", "XErrorEvent");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XErrorEvent(ptr))->request_code)));
+ XM_field_assert_type(Xen_is_XErrorEvent(ptr), ptr, 1, "request_code", "XErrorEvent");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XErrorEvent(ptr))->request_code)));
}
-static XEN gxm_set_request_code(XEN ptr, XEN val)
+static Xen gxm_set_request_code(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "request_code", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XErrorEvent_P(ptr), ptr, XEN_ARG_1, "request_code", "XErrorEvent");
- (XEN_TO_C_XErrorEvent(ptr))->request_code = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "request_code", "an integer");
+ XM_set_field_assert_type(Xen_is_XErrorEvent(ptr), ptr, 1, "request_code", "XErrorEvent");
+ (Xen_to_C_XErrorEvent(ptr))->request_code = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_error_code(XEN ptr)
+static Xen gxm_error_code(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XErrorEvent_P(ptr), ptr, XEN_ONLY_ARG, "error_code", "XErrorEvent");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XErrorEvent(ptr))->error_code)));
+ XM_field_assert_type(Xen_is_XErrorEvent(ptr), ptr, 1, "error_code", "XErrorEvent");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XErrorEvent(ptr))->error_code)));
}
-static XEN gxm_set_error_code(XEN ptr, XEN val)
+static Xen gxm_set_error_code(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "error_code", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XErrorEvent_P(ptr), ptr, XEN_ARG_1, "error_code", "XErrorEvent");
- (XEN_TO_C_XErrorEvent(ptr))->error_code = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "error_code", "an integer");
+ XM_set_field_assert_type(Xen_is_XErrorEvent(ptr), ptr, 1, "error_code", "XErrorEvent");
+ (Xen_to_C_XErrorEvent(ptr))->error_code = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_resourceid(XEN ptr)
+static Xen gxm_resourceid(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XErrorEvent_P(ptr), ptr, XEN_ONLY_ARG, "resourceid", "XErrorEvent");
- return(C_TO_XEN_ULONG((XID)((XEN_TO_C_XErrorEvent(ptr))->resourceid)));
+ XM_field_assert_type(Xen_is_XErrorEvent(ptr), ptr, 1, "resourceid", "XErrorEvent");
+ return(C_ulong_to_Xen_ulong((XID)((Xen_to_C_XErrorEvent(ptr))->resourceid)));
}
-static XEN gxm_set_resourceid(XEN ptr, XEN val)
+static Xen gxm_set_resourceid(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_ULONG_P(val), val, XEN_ARG_2, "resourceid", "an XID");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XErrorEvent_P(ptr), ptr, XEN_ARG_1, "resourceid", "XErrorEvent");
- (XEN_TO_C_XErrorEvent(ptr))->resourceid = (XID)XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_ulong(val), val, 2, "resourceid", "an XID");
+ XM_set_field_assert_type(Xen_is_XErrorEvent(ptr), ptr, 1, "resourceid", "XErrorEvent");
+ (Xen_to_C_XErrorEvent(ptr))->resourceid = (XID)Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_first_keycode(XEN ptr)
+static Xen gxm_first_keycode(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XMappingEvent_P(ptr), ptr, XEN_ONLY_ARG, "first_keycode", "XMappingEvent");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XMappingEvent(ptr))->first_keycode)));
+ XM_field_assert_type(Xen_is_XMappingEvent(ptr), ptr, 1, "first_keycode", "XMappingEvent");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XMappingEvent(ptr))->first_keycode)));
}
-static XEN gxm_set_first_keycode(XEN ptr, XEN val)
+static Xen gxm_set_first_keycode(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "first_keycode", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XMappingEvent_P(ptr), ptr, XEN_ARG_1, "first_keycode", "XMappingEvent");
- (XEN_TO_C_XMappingEvent(ptr))->first_keycode = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "first_keycode", "an integer");
+ XM_set_field_assert_type(Xen_is_XMappingEvent(ptr), ptr, 1, "first_keycode", "XMappingEvent");
+ (Xen_to_C_XMappingEvent(ptr))->first_keycode = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_request(XEN ptr)
+static Xen gxm_request(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XMappingEvent_P(ptr), ptr, XEN_ONLY_ARG, "request", "XMappingEvent");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XMappingEvent(ptr))->request)));
+ XM_field_assert_type(Xen_is_XMappingEvent(ptr), ptr, 1, "request", "XMappingEvent");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XMappingEvent(ptr))->request)));
}
-static XEN gxm_set_request(XEN ptr, XEN val)
+static Xen gxm_set_request(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "request", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XMappingEvent_P(ptr), ptr, XEN_ARG_1, "request", "XMappingEvent");
- (XEN_TO_C_XMappingEvent(ptr))->request = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "request", "an integer");
+ XM_set_field_assert_type(Xen_is_XMappingEvent(ptr), ptr, 1, "request", "XMappingEvent");
+ (Xen_to_C_XMappingEvent(ptr))->request = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_format(XEN ptr)
+static Xen gxm_format(Xen ptr)
{
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->format)));
-#if HAVE_MOTIF
- if (XEN_XmSelectionCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmSelectionCallbackStruct(ptr))->format)));
- if (XEN_XmConvertCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmConvertCallbackStruct(ptr))->format)));
- if (XEN_XmTextBlock_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmTextBlock(ptr))->format)));
-#endif
- if (XEN_XClientMessageEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XClientMessageEvent(ptr))->format)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "format", "XClientMessageEvent");
- return(XEN_FALSE);
+ if (Xen_is_XImage(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->format)));
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmSelectionCallbackStruct(ptr))->format)));
+ if (Xen_is_XmConvertCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmConvertCallbackStruct(ptr))->format)));
+ if (Xen_is_XmTextBlock(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmTextBlock(ptr))->format)));
+ if (Xen_is_XClientMessageEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XClientMessageEvent(ptr))->format)));
+ XM_field_assert_type(0, ptr, 1, "format", "XClientMessageEvent");
+ return(Xen_false);
}
-static XEN gxm_set_format(XEN ptr, XEN val)
+static Xen gxm_set_format(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "format", "an integer");
- if (XEN_XClientMessageEvent_P(ptr)) (XEN_TO_C_XClientMessageEvent(ptr))->format = XEN_TO_C_INT(val);
-#if HAVE_MOTIF
- else if (XEN_XmTextBlock_P(ptr)) (XEN_TO_C_XmTextBlock(ptr))->format = XEN_TO_C_INT(val);
-#endif
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "format", "XClientMessageEvent or XmTextBlock");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "format", "an integer");
+ if (Xen_is_XClientMessageEvent(ptr)) (Xen_to_C_XClientMessageEvent(ptr))->format = Xen_integer_to_C_int(val);
+ else if (Xen_is_XmTextBlock(ptr)) (Xen_to_C_XmTextBlock(ptr))->format = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "format", "XClientMessageEvent or XmTextBlock");
return(val);
}
-static XEN gxm_message_type(XEN ptr)
+static Xen gxm_message_type(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XClientMessageEvent_P(ptr), ptr, XEN_ONLY_ARG, "message_type", "XClientMessageEvent");
- return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XClientMessageEvent(ptr))->message_type)));
+ XM_field_assert_type(Xen_is_XClientMessageEvent(ptr), ptr, 1, "message_type", "XClientMessageEvent");
+ return(C_to_Xen_Atom((Atom)((Xen_to_C_XClientMessageEvent(ptr))->message_type)));
}
-static XEN gxm_set_message_type(XEN ptr, XEN val)
+static Xen gxm_set_message_type(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Atom_P(val), val, XEN_ARG_2, "message_type", "an Atom");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XClientMessageEvent_P(ptr), ptr, XEN_ARG_1, "message_type", "XClientMessageEvent");
- (XEN_TO_C_XClientMessageEvent(ptr))->message_type = XEN_TO_C_Atom(val);
+ XM_set_field_assert_type(Xen_is_Atom(val), val, 2, "message_type", "an Atom");
+ XM_set_field_assert_type(Xen_is_XClientMessageEvent(ptr), ptr, 1, "message_type", "XClientMessageEvent");
+ (Xen_to_C_XClientMessageEvent(ptr))->message_type = Xen_to_C_Atom(val);
return(val);
}
-static XEN gxm_new(XEN ptr)
+static Xen gxm_new(Xen ptr)
{
#ifndef __cplusplus
- XM_FIELD_ASSERT_TYPE(XEN_XColormapEvent_P(ptr), ptr, XEN_ONLY_ARG, "new", "XColormapEvent");
- return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XColormapEvent(ptr))->new)));
+ XM_field_assert_type(Xen_is_XColormapEvent(ptr), ptr, 1, "new", "XColormapEvent");
+ return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XColormapEvent(ptr))->new)));
#endif
- return(XEN_FALSE);
+ return(Xen_false);
}
-static XEN gxm_set_new(XEN ptr, XEN val)
+static Xen gxm_set_new(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "new", "a boolean");
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "new", "a boolean");
#ifndef __cplusplus
- if (XEN_XColormapEvent_P(ptr)) (XEN_TO_C_XColormapEvent(ptr))->new = XEN_TO_C_BOOLEAN(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "new", "XColormapEvent");
+ if (Xen_is_XColormapEvent(ptr)) (Xen_to_C_XColormapEvent(ptr))->new = Xen_boolean_to_C_bool(val);
+ else XM_set_field_assert_type(0, ptr, 1, "new", "XColormapEvent");
#endif
return(val);
}
-static XEN gxm_colormap(XEN ptr)
+static Xen gxm_colormap(Xen ptr)
{
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_Colormap((Colormap)((XEN_TO_C_XWindowAttributes(ptr))->colormap)));
- if (XEN_XSetWindowAttributes_P(ptr)) return(C_TO_XEN_Colormap((Colormap)((XEN_TO_C_XSetWindowAttributes(ptr))->colormap)));
- if (XEN_XColormapEvent_P(ptr)) return(C_TO_XEN_Colormap((Colormap)((XEN_TO_C_XColormapEvent(ptr))->colormap)));
- if (XEN_XStandardColormap_P(ptr)) return(C_TO_XEN_Colormap((Colormap)((XEN_TO_C_XStandardColormap(ptr))->colormap)));
- if (XEN_XpmAttributes_P(ptr)) return(C_TO_XEN_Colormap((Colormap)((XEN_TO_C_XpmAttributes(ptr))->colormap)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "colormap", "a struct with a colormap field");
- return(XEN_FALSE);
+ if (Xen_is_XWindowAttributes(ptr)) return(C_to_Xen_Colormap((Colormap)((Xen_to_C_XWindowAttributes(ptr))->colormap)));
+ if (Xen_is_XSetWindowAttributes(ptr)) return(C_to_Xen_Colormap((Colormap)((Xen_to_C_XSetWindowAttributes(ptr))->colormap)));
+ if (Xen_is_XColormapEvent(ptr)) return(C_to_Xen_Colormap((Colormap)((Xen_to_C_XColormapEvent(ptr))->colormap)));
+ if (Xen_is_XStandardColormap(ptr)) return(C_to_Xen_Colormap((Colormap)((Xen_to_C_XStandardColormap(ptr))->colormap)));
+ if (Xen_is_XpmAttributes(ptr)) return(C_to_Xen_Colormap((Colormap)((Xen_to_C_XpmAttributes(ptr))->colormap)));
+ XM_field_assert_type(0, ptr, 1, "colormap", "a struct with a colormap field");
+ return(Xen_false);
}
-static XEN gxm_set_colormap(XEN ptr, XEN val)
+static Xen gxm_set_colormap(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Colormap_P(val), val, XEN_ARG_2, "colormap", "a Colormap");
- if (XEN_XpmAttributes_P(ptr)) (XEN_TO_C_XpmAttributes(ptr))->colormap = XEN_TO_C_Colormap(val);
+ XM_set_field_assert_type(Xen_is_Colormap(val), val, 2, "colormap", "a Colormap");
+ if (Xen_is_XpmAttributes(ptr)) (Xen_to_C_XpmAttributes(ptr))->colormap = Xen_to_C_Colormap(val);
else
{
- if (XEN_XColormapEvent_P(ptr)) (XEN_TO_C_XColormapEvent(ptr))->colormap = XEN_TO_C_Colormap(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "colormap", "XpmAttributes or XColormapEvent");
+ if (Xen_is_XColormapEvent(ptr)) (Xen_to_C_XColormapEvent(ptr))->colormap = Xen_to_C_Colormap(val);
+ else XM_set_field_assert_type(0, ptr, 1, "colormap", "XpmAttributes or XColormapEvent");
}
return(val);
}
-static XEN gxm_property(XEN ptr)
+static Xen gxm_property(Xen ptr)
{
- if (XEN_XSelectionEvent_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XSelectionEvent(ptr))->property)));
- if (XEN_XSelectionRequestEvent_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XSelectionRequestEvent(ptr))->property)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "property", "a struct with a property field");
- return(XEN_FALSE);
+ if (Xen_is_XSelectionEvent(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XSelectionEvent(ptr))->property)));
+ if (Xen_is_XSelectionRequestEvent(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XSelectionRequestEvent(ptr))->property)));
+ XM_field_assert_type(0, ptr, 1, "property", "a struct with a property field");
+ return(Xen_false);
}
-static XEN gxm_set_property(XEN ptr, XEN val)
+static Xen gxm_set_property(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Atom_P(val), val, XEN_ARG_2, "property", "an Atom");
- if (XEN_XSelectionEvent_P(ptr)) (XEN_TO_C_XSelectionEvent(ptr))->property = XEN_TO_C_Atom(val);
- else if (XEN_XSelectionRequestEvent_P(ptr)) (XEN_TO_C_XSelectionRequestEvent(ptr))->property = XEN_TO_C_Atom(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "property", "XSelection(Request)Event");
+ XM_set_field_assert_type(Xen_is_Atom(val), val, 2, "property", "an Atom");
+ if (Xen_is_XSelectionEvent(ptr)) (Xen_to_C_XSelectionEvent(ptr))->property = Xen_to_C_Atom(val);
+ else if (Xen_is_XSelectionRequestEvent(ptr)) (Xen_to_C_XSelectionRequestEvent(ptr))->property = Xen_to_C_Atom(val);
+ else XM_set_field_assert_type(0, ptr, 1, "property", "XSelection(Request)Event");
return(val);
}
-static XEN gxm_target(XEN ptr)
+static Xen gxm_target(Xen ptr)
{
-#if HAVE_MOTIF
- if (XEN_XmPopupHandlerCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmPopupHandlerCallbackStruct(ptr))->target)));
- if (XEN_XmSelectionCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmSelectionCallbackStruct(ptr))->target)));
- if (XEN_XmConvertCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmConvertCallbackStruct(ptr))->target)));
-#endif
- if (XEN_XSelectionEvent_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XSelectionEvent(ptr))->target)));
- if (XEN_XSelectionRequestEvent_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XSelectionRequestEvent(ptr))->target)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "target", "a struct with a target field");
- return(XEN_FALSE);
+ if (Xen_is_XmPopupHandlerCallbackStruct(ptr)) return(C_to_Xen_Widget((Widget)((Xen_to_C_XmPopupHandlerCallbackStruct(ptr))->target)));
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmSelectionCallbackStruct(ptr))->target)));
+ if (Xen_is_XmConvertCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmConvertCallbackStruct(ptr))->target)));
+ if (Xen_is_XSelectionEvent(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XSelectionEvent(ptr))->target)));
+ if (Xen_is_XSelectionRequestEvent(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XSelectionRequestEvent(ptr))->target)));
+ XM_field_assert_type(0, ptr, 1, "target", "a struct with a target field");
+ return(Xen_false);
}
-static XEN gxm_set_target(XEN ptr, XEN val)
+static Xen gxm_set_target(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Atom_P(val), val, XEN_ARG_2, "target", "an Atom");
- if (XEN_XSelectionEvent_P(ptr)) (XEN_TO_C_XSelectionEvent(ptr))->target = XEN_TO_C_Atom(val);
- else if (XEN_XSelectionRequestEvent_P(ptr)) (XEN_TO_C_XSelectionRequestEvent(ptr))->target = XEN_TO_C_Atom(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "target", "XSelection(Request)Event");
+ XM_set_field_assert_type(Xen_is_Atom(val), val, 2, "target", "an Atom");
+ if (Xen_is_XSelectionEvent(ptr)) (Xen_to_C_XSelectionEvent(ptr))->target = Xen_to_C_Atom(val);
+ else if (Xen_is_XSelectionRequestEvent(ptr)) (Xen_to_C_XSelectionRequestEvent(ptr))->target = Xen_to_C_Atom(val);
+ else XM_set_field_assert_type(0, ptr, 1, "target", "XSelection(Request)Event");
return(val);
}
-static XEN gxm_requestor(XEN ptr)
+static Xen gxm_requestor(Xen ptr)
{
- if (XEN_XSelectionEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XSelectionEvent(ptr))->requestor)));
- if (XEN_XSelectionRequestEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XSelectionRequestEvent(ptr))->requestor)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "requestor", "a struct with a requestor field");
- return(XEN_FALSE);
+ if (Xen_is_XSelectionEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XSelectionEvent(ptr))->requestor)));
+ if (Xen_is_XSelectionRequestEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XSelectionRequestEvent(ptr))->requestor)));
+ XM_field_assert_type(0, ptr, 1, "requestor", "a struct with a requestor field");
+ return(Xen_false);
}
-static XEN gxm_set_requestor(XEN ptr, XEN val)
+static Xen gxm_set_requestor(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Window_P(val), val, XEN_ARG_2, "requestor", "a Window");
- if (XEN_XSelectionEvent_P(ptr)) (XEN_TO_C_XSelectionEvent(ptr))->requestor = XEN_TO_C_Window(val);
- else if (XEN_XSelectionRequestEvent_P(ptr)) (XEN_TO_C_XSelectionRequestEvent(ptr))->requestor = XEN_TO_C_Window(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "requestor", "XSelection(Request)Event");
+ XM_set_field_assert_type(Xen_is_Window(val), val, 2, "requestor", "a Window");
+ if (Xen_is_XSelectionEvent(ptr)) (Xen_to_C_XSelectionEvent(ptr))->requestor = Xen_to_C_Window(val);
+ else if (Xen_is_XSelectionRequestEvent(ptr)) (Xen_to_C_XSelectionRequestEvent(ptr))->requestor = Xen_to_C_Window(val);
+ else XM_set_field_assert_type(0, ptr, 1, "requestor", "XSelection(Request)Event");
return(val);
}
-static XEN gxm_owner(XEN ptr)
+static Xen gxm_owner(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XSelectionRequestEvent_P(ptr), ptr, XEN_ONLY_ARG, "owner", "XSelectionRequestEvent");
- return(C_TO_XEN_Window((Window)((XEN_TO_C_XSelectionRequestEvent(ptr))->owner)));
+ XM_field_assert_type(Xen_is_XSelectionRequestEvent(ptr), ptr, 1, "owner", "XSelectionRequestEvent");
+ return(C_to_Xen_Window((Window)((Xen_to_C_XSelectionRequestEvent(ptr))->owner)));
}
-static XEN gxm_set_owner(XEN ptr, XEN val)
+static Xen gxm_set_owner(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Window_P(val), val, XEN_ARG_2, "owner", "a Window");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSelectionRequestEvent_P(ptr), ptr, XEN_ARG_1, "owner", "XSelectionRequestEvent");
- (XEN_TO_C_XSelectionRequestEvent(ptr))->owner = XEN_TO_C_Window(val);
+ XM_set_field_assert_type(Xen_is_Window(val), val, 2, "owner", "a Window");
+ XM_set_field_assert_type(Xen_is_XSelectionRequestEvent(ptr), ptr, 1, "owner", "XSelectionRequestEvent");
+ (Xen_to_C_XSelectionRequestEvent(ptr))->owner = Xen_to_C_Window(val);
return(val);
}
-static XEN gxm_selection(XEN ptr)
+static Xen gxm_selection(Xen ptr)
{
-#if HAVE_MOTIF
- if (XEN_XmTransferDoneCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmTransferDoneCallbackStruct(ptr))->selection)));
- if (XEN_XmSelectionCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmSelectionCallbackStruct(ptr))->selection)));
- if (XEN_XmDestinationCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmDestinationCallbackStruct(ptr))->selection)));
- if (XEN_XmConvertCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmConvertCallbackStruct(ptr))->selection)));
-#endif
- if (XEN_XSelectionEvent_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XSelectionEvent(ptr))->selection)));
- if (XEN_XSelectionRequestEvent_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XSelectionRequestEvent(ptr))->selection)));
- if (XEN_XSelectionClearEvent_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XSelectionClearEvent(ptr))->selection)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "selection", "a struct with a selection field");
- return(XEN_FALSE);
+ if (Xen_is_XmTransferDoneCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmTransferDoneCallbackStruct(ptr))->selection)));
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmSelectionCallbackStruct(ptr))->selection)));
+ if (Xen_is_XmDestinationCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmDestinationCallbackStruct(ptr))->selection)));
+ if (Xen_is_XmConvertCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmConvertCallbackStruct(ptr))->selection)));
+ if (Xen_is_XSelectionEvent(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XSelectionEvent(ptr))->selection)));
+ if (Xen_is_XSelectionRequestEvent(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XSelectionRequestEvent(ptr))->selection)));
+ if (Xen_is_XSelectionClearEvent(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XSelectionClearEvent(ptr))->selection)));
+ XM_field_assert_type(0, ptr, 1, "selection", "a struct with a selection field");
+ return(Xen_false);
}
-static XEN gxm_set_selection(XEN ptr, XEN val)
+static Xen gxm_set_selection(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Atom_P(val), val, XEN_ARG_2, "selection", "an Atom");
- if (XEN_XSelectionEvent_P(ptr)) (XEN_TO_C_XSelectionEvent(ptr))->selection = XEN_TO_C_Atom(val);
- else if (XEN_XSelectionRequestEvent_P(ptr)) (XEN_TO_C_XSelectionRequestEvent(ptr))->selection = XEN_TO_C_Atom(val);
- else if (XEN_XSelectionClearEvent_P(ptr)) (XEN_TO_C_XSelectionClearEvent(ptr))->selection = XEN_TO_C_Atom(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "selection", "XSelection(Request|Clear)Event");
+ XM_set_field_assert_type(Xen_is_Atom(val), val, 2, "selection", "an Atom");
+ if (Xen_is_XSelectionEvent(ptr)) (Xen_to_C_XSelectionEvent(ptr))->selection = Xen_to_C_Atom(val);
+ else if (Xen_is_XSelectionRequestEvent(ptr)) (Xen_to_C_XSelectionRequestEvent(ptr))->selection = Xen_to_C_Atom(val);
+ else if (Xen_is_XSelectionClearEvent(ptr)) (Xen_to_C_XSelectionClearEvent(ptr))->selection = Xen_to_C_Atom(val);
+ else XM_set_field_assert_type(0, ptr, 1, "selection", "XSelection(Request|Clear)Event");
return(val);
}
-static XEN gxm_atom(XEN ptr)
+static Xen gxm_atom(Xen ptr)
{
- if (XEN_XPropertyEvent_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XPropertyEvent(ptr))->atom)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "atom", "XPropertyEvent");
- return(XEN_FALSE);
+ if (Xen_is_XPropertyEvent(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XPropertyEvent(ptr))->atom)));
+ XM_field_assert_type(0, ptr, 1, "atom", "XPropertyEvent");
+ return(Xen_false);
}
-static XEN gxm_set_atom(XEN ptr, XEN val)
+static Xen gxm_set_atom(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Atom_P(val), val, XEN_ARG_2, "atom", "an Atom");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XPropertyEvent_P(ptr), ptr, XEN_ARG_1, "atom", "XPropertyEvent");
- (XEN_TO_C_XPropertyEvent(ptr))->atom = XEN_TO_C_Atom(val);
+ XM_set_field_assert_type(Xen_is_Atom(val), val, 2, "atom", "an Atom");
+ XM_set_field_assert_type(Xen_is_XPropertyEvent(ptr), ptr, 1, "atom", "XPropertyEvent");
+ (Xen_to_C_XPropertyEvent(ptr))->atom = Xen_to_C_Atom(val);
return(val);
}
-static XEN gxm_place(XEN ptr)
+static Xen gxm_place(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XCirculateRequestEvent_P(ptr) || XEN_XCirculateEvent_P(ptr), ptr, XEN_ONLY_ARG, "place", "a struct with a place field");
- if (XEN_XCirculateRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCirculateRequestEvent(ptr))->place)));
- return(C_TO_XEN_INT((int)((XEN_TO_C_XCirculateEvent(ptr))->place)));
+ XM_field_assert_type(Xen_is_XCirculateRequestEvent(ptr) || Xen_is_XCirculateEvent(ptr), ptr, 1, "place", "a struct with a place field");
+ if (Xen_is_XCirculateRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCirculateRequestEvent(ptr))->place)));
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XCirculateEvent(ptr))->place)));
}
-static XEN gxm_set_place(XEN ptr, XEN val)
+static Xen gxm_set_place(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "place", "an integer");
- if (XEN_XCirculateRequestEvent_P(ptr)) (XEN_TO_C_XCirculateRequestEvent(ptr))->place = XEN_TO_C_INT(val);
- else if (XEN_XCirculateEvent_P(ptr)) (XEN_TO_C_XCirculateEvent(ptr))->place = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "place", "a struct with a place field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "place", "an integer");
+ if (Xen_is_XCirculateRequestEvent(ptr)) (Xen_to_C_XCirculateRequestEvent(ptr))->place = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCirculateEvent(ptr)) (Xen_to_C_XCirculateEvent(ptr))->place = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "place", "a struct with a place field");
return(val);
}
-static XEN gxm_value_mask(XEN ptr)
+static Xen gxm_value_mask(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XConfigureRequestEvent_P(ptr), ptr, XEN_ONLY_ARG, "value_mask", "XConfigureRequestEvent");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XConfigureRequestEvent(ptr))->value_mask)));
+ XM_field_assert_type(Xen_is_XConfigureRequestEvent(ptr), ptr, 1, "value_mask", "XConfigureRequestEvent");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XConfigureRequestEvent(ptr))->value_mask)));
}
-static XEN gxm_set_value_mask(XEN ptr, XEN val)
+static Xen gxm_set_value_mask(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_ULONG_P(val), val, XEN_ARG_2, "value_mask", "an unsigned long");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XConfigureRequestEvent_P(ptr), ptr, XEN_ARG_1, "value_mask", "XConfigureRequestEvent");
- (XEN_TO_C_XConfigureRequestEvent(ptr))->value_mask = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_ulong(val), val, 2, "value_mask", "an unsigned long");
+ XM_set_field_assert_type(Xen_is_XConfigureRequestEvent(ptr), ptr, 1, "value_mask", "XConfigureRequestEvent");
+ (Xen_to_C_XConfigureRequestEvent(ptr))->value_mask = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_above(XEN ptr)
+static Xen gxm_above(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XConfigureRequestEvent_P(ptr) || XEN_XConfigureEvent_P(ptr), ptr, XEN_ONLY_ARG, "above", "a struct with an above field");
- if (XEN_XConfigureRequestEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XConfigureRequestEvent(ptr))->above)));
- return(C_TO_XEN_Window((Window)((XEN_TO_C_XConfigureEvent(ptr))->above)));
+ XM_field_assert_type(Xen_is_XConfigureRequestEvent(ptr) || Xen_is_XConfigureEvent(ptr), ptr, 1, "above", "a struct with an above field");
+ if (Xen_is_XConfigureRequestEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XConfigureRequestEvent(ptr))->above)));
+ return(C_to_Xen_Window((Window)((Xen_to_C_XConfigureEvent(ptr))->above)));
}
-static XEN gxm_set_above(XEN ptr, XEN val)
+static Xen gxm_set_above(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Window_P(val), val, XEN_ARG_2, "above", "a Window");
- if (XEN_XConfigureRequestEvent_P(ptr)) (XEN_TO_C_XConfigureRequestEvent(ptr))->above = XEN_TO_C_Window(val);
- else if (XEN_XConfigureEvent_P(ptr)) (XEN_TO_C_XConfigureEvent(ptr))->above = XEN_TO_C_Window(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "above", "a struct with an above field");
+ XM_set_field_assert_type(Xen_is_Window(val), val, 2, "above", "a Window");
+ if (Xen_is_XConfigureRequestEvent(ptr)) (Xen_to_C_XConfigureRequestEvent(ptr))->above = Xen_to_C_Window(val);
+ else if (Xen_is_XConfigureEvent(ptr)) (Xen_to_C_XConfigureEvent(ptr))->above = Xen_to_C_Window(val);
+ else XM_set_field_assert_type(0, ptr, 1, "above", "a struct with an above field");
return(val);
}
-static XEN gxm_from_configure(XEN ptr)
+static Xen gxm_from_configure(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XUnmapEvent_P(ptr), ptr, XEN_ONLY_ARG, "from_configure", "XUnmapEvent");
- return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XUnmapEvent(ptr))->from_configure)));
+ XM_field_assert_type(Xen_is_XUnmapEvent(ptr), ptr, 1, "from_configure", "XUnmapEvent");
+ return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XUnmapEvent(ptr))->from_configure)));
}
-static XEN gxm_set_from_configure(XEN ptr, XEN val)
+static Xen gxm_set_from_configure(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "from_configure", "a boolean");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XUnmapEvent_P(ptr), ptr, XEN_ARG_1, "from_configure", "XUnmapEvent");
- (XEN_TO_C_XUnmapEvent(ptr))->from_configure = XEN_TO_C_BOOLEAN(val);
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "from_configure", "a boolean");
+ XM_set_field_assert_type(Xen_is_XUnmapEvent(ptr), ptr, 1, "from_configure", "XUnmapEvent");
+ (Xen_to_C_XUnmapEvent(ptr))->from_configure = Xen_boolean_to_C_bool(val);
return(val);
}
-static XEN gxm_event(XEN ptr)
+static Xen gxm_event(Xen ptr)
{
/* Xlib.h says event is a window in these cases -- kinda strange looking */
- if (XEN_XCirculateEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XCirculateEvent(ptr))->event)));
- if (XEN_XGravityEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XGravityEvent(ptr))->event)));
- if (XEN_XConfigureEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XConfigureEvent(ptr))->event)));
- if (XEN_XReparentEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XReparentEvent(ptr))->event)));
- if (XEN_XMapEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XMapEvent(ptr))->event)));
- if (XEN_XUnmapEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XUnmapEvent(ptr))->event)));
- if (XEN_XDestroyWindowEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XDestroyWindowEvent(ptr))->event)));
-#if HAVE_MOTIF
- if (XEN_AnyCallbackStruct_P(ptr)) return(C_TO_XEN_XEvent((XEvent *)((XEN_TO_C_XmAnyCallbackStruct(ptr))->event)));
-#endif
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "event", "a struct with an event field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_set_event(XEN ptr, XEN val)
-{
- if (XEN_XCirculateEvent_P(ptr)) (XEN_TO_C_XCirculateEvent(ptr))->event = XEN_TO_C_Window(val); else
- if (XEN_XGravityEvent_P(ptr)) (XEN_TO_C_XGravityEvent(ptr))->event = XEN_TO_C_Window(val); else
- if (XEN_XConfigureEvent_P(ptr)) (XEN_TO_C_XConfigureEvent(ptr))->event = XEN_TO_C_Window(val); else
- if (XEN_XReparentEvent_P(ptr)) (XEN_TO_C_XReparentEvent(ptr))->event = XEN_TO_C_Window(val); else
- if (XEN_XMapEvent_P(ptr)) (XEN_TO_C_XMapEvent(ptr))->event = XEN_TO_C_Window(val); else
- if (XEN_XUnmapEvent_P(ptr)) (XEN_TO_C_XUnmapEvent(ptr))->event = XEN_TO_C_Window(val); else
- if (XEN_XDestroyWindowEvent_P(ptr)) (XEN_TO_C_XDestroyWindowEvent(ptr))->event = XEN_TO_C_Window(val); else
-#if HAVE_MOTIF
- if (XEN_AnyCallbackStruct_P(ptr)) (XEN_TO_C_XmAnyCallbackStruct(ptr))->event = XEN_TO_C_XEvent(val); else
-#endif
- XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "event", "a struct with an event field");
+ if (Xen_is_XCirculateEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XCirculateEvent(ptr))->event)));
+ if (Xen_is_XGravityEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XGravityEvent(ptr))->event)));
+ if (Xen_is_XConfigureEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XConfigureEvent(ptr))->event)));
+ if (Xen_is_XReparentEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XReparentEvent(ptr))->event)));
+ if (Xen_is_XMapEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XMapEvent(ptr))->event)));
+ if (Xen_is_XUnmapEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XUnmapEvent(ptr))->event)));
+ if (Xen_is_XDestroyWindowEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XDestroyWindowEvent(ptr))->event)));
+ if (Xen_is_AnyCallbackStruct(ptr)) return(C_to_Xen_XEvent((XEvent *)((Xen_to_C_XmAnyCallbackStruct(ptr))->event)));
+ XM_field_assert_type(0, ptr, 1, "event", "a struct with an event field");
+ return(Xen_false);
+}
+
+static Xen gxm_set_event(Xen ptr, Xen val)
+{
+ if (Xen_is_XCirculateEvent(ptr)) (Xen_to_C_XCirculateEvent(ptr))->event = Xen_to_C_Window(val); else
+ if (Xen_is_XGravityEvent(ptr)) (Xen_to_C_XGravityEvent(ptr))->event = Xen_to_C_Window(val); else
+ if (Xen_is_XConfigureEvent(ptr)) (Xen_to_C_XConfigureEvent(ptr))->event = Xen_to_C_Window(val); else
+ if (Xen_is_XReparentEvent(ptr)) (Xen_to_C_XReparentEvent(ptr))->event = Xen_to_C_Window(val); else
+ if (Xen_is_XMapEvent(ptr)) (Xen_to_C_XMapEvent(ptr))->event = Xen_to_C_Window(val); else
+ if (Xen_is_XUnmapEvent(ptr)) (Xen_to_C_XUnmapEvent(ptr))->event = Xen_to_C_Window(val); else
+ if (Xen_is_XDestroyWindowEvent(ptr)) (Xen_to_C_XDestroyWindowEvent(ptr))->event = Xen_to_C_Window(val); else
+ if (Xen_is_AnyCallbackStruct(ptr)) (Xen_to_C_XmAnyCallbackStruct(ptr))->event = Xen_to_C_XEvent(val); else
+ XM_set_field_assert_type(0, ptr, 1, "event", "a struct with an event field");
return(val);
}
-static XEN gxm_override_redirect(XEN ptr)
+static Xen gxm_override_redirect(Xen ptr)
{
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XWindowAttributes(ptr))->override_redirect)));
- if (XEN_XSetWindowAttributes_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XSetWindowAttributes(ptr))->override_redirect)));
- if (XEN_XConfigureEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XConfigureEvent(ptr))->override_redirect)));
- if (XEN_XReparentEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XReparentEvent(ptr))->override_redirect)));
- if (XEN_XMapEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XMapEvent(ptr))->override_redirect)));
- if (XEN_XCreateWindowEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XCreateWindowEvent(ptr))->override_redirect)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "override_redirect", "a struct with an override_redirect field");
- return(XEN_FALSE);
+ if (Xen_is_XWindowAttributes(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XWindowAttributes(ptr))->override_redirect)));
+ if (Xen_is_XSetWindowAttributes(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XSetWindowAttributes(ptr))->override_redirect)));
+ if (Xen_is_XConfigureEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XConfigureEvent(ptr))->override_redirect)));
+ if (Xen_is_XReparentEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XReparentEvent(ptr))->override_redirect)));
+ if (Xen_is_XMapEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XMapEvent(ptr))->override_redirect)));
+ if (Xen_is_XCreateWindowEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XCreateWindowEvent(ptr))->override_redirect)));
+ XM_field_assert_type(0, ptr, 1, "override_redirect", "a struct with an override_redirect field");
+ return(Xen_false);
}
-static XEN gxm_set_override_redirect(XEN ptr, XEN val)
+static Xen gxm_set_override_redirect(Xen ptr, Xen val)
{
Bool b;
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "override_redirect", "a boolean");
- b = (Bool)XEN_TO_C_BOOLEAN(val);
- if (XEN_XConfigureEvent_P(ptr)) (XEN_TO_C_XConfigureEvent(ptr))->override_redirect = b;
- else if (XEN_XReparentEvent_P(ptr)) (XEN_TO_C_XReparentEvent(ptr))->override_redirect = b;
- else if (XEN_XMapEvent_P(ptr)) (XEN_TO_C_XMapEvent(ptr))->override_redirect = b;
- else if (XEN_XCreateWindowEvent_P(ptr)) (XEN_TO_C_XCreateWindowEvent(ptr))->override_redirect = b;
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "override_redirect", "a struct with an override_redirect field");
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "override_redirect", "a boolean");
+ b = (Bool)Xen_boolean_to_C_bool(val);
+ if (Xen_is_XConfigureEvent(ptr)) (Xen_to_C_XConfigureEvent(ptr))->override_redirect = b;
+ else if (Xen_is_XReparentEvent(ptr)) (Xen_to_C_XReparentEvent(ptr))->override_redirect = b;
+ else if (Xen_is_XMapEvent(ptr)) (Xen_to_C_XMapEvent(ptr))->override_redirect = b;
+ else if (Xen_is_XCreateWindowEvent(ptr)) (Xen_to_C_XCreateWindowEvent(ptr))->override_redirect = b;
+ else XM_set_field_assert_type(0, ptr, 1, "override_redirect", "a struct with an override_redirect field");
return(val);
}
-static XEN gxm_border_width(XEN ptr)
+static Xen gxm_border_width(Xen ptr)
{
- if (XEN_XWindowChanges_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowChanges(ptr))->border_width)));
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->border_width)));
- if (XEN_XConfigureRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureRequestEvent(ptr))->border_width)));
- if (XEN_XConfigureEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureEvent(ptr))->border_width)));
- if (XEN_XCreateWindowEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCreateWindowEvent(ptr))->border_width)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "border_width", "a struct with a border_width field");
- return(XEN_FALSE);
+ if (Xen_is_XWindowChanges(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowChanges(ptr))->border_width)));
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->border_width)));
+ if (Xen_is_XConfigureRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureRequestEvent(ptr))->border_width)));
+ if (Xen_is_XConfigureEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureEvent(ptr))->border_width)));
+ if (Xen_is_XCreateWindowEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCreateWindowEvent(ptr))->border_width)));
+ XM_field_assert_type(0, ptr, 1, "border_width", "a struct with a border_width field");
+ return(Xen_false);
}
-static XEN gxm_set_border_width(XEN ptr, XEN val)
+static Xen gxm_set_border_width(Xen ptr, Xen val)
{
int wid;
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "border_width", "an integer");
- wid = XEN_TO_C_INT(val);
- if (XEN_XConfigureRequestEvent_P(ptr)) (XEN_TO_C_XConfigureRequestEvent(ptr))->border_width = wid;
- else if (XEN_XConfigureEvent_P(ptr)) (XEN_TO_C_XConfigureEvent(ptr))->border_width = wid;
- else if (XEN_XCreateWindowEvent_P(ptr)) (XEN_TO_C_XCreateWindowEvent(ptr))->border_width = wid;
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "border_width", "a struct with a border_width field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "border_width", "an integer");
+ wid = Xen_integer_to_C_int(val);
+ if (Xen_is_XConfigureRequestEvent(ptr)) (Xen_to_C_XConfigureRequestEvent(ptr))->border_width = wid;
+ else if (Xen_is_XConfigureEvent(ptr)) (Xen_to_C_XConfigureEvent(ptr))->border_width = wid;
+ else if (Xen_is_XCreateWindowEvent(ptr)) (Xen_to_C_XCreateWindowEvent(ptr))->border_width = wid;
+ else XM_set_field_assert_type(0, ptr, 1, "border_width", "a struct with a border_width field");
return(val);
}
-static XEN gxm_parent(XEN ptr)
+static Xen gxm_parent(Xen ptr)
{
- if (XEN_XCirculateRequestEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XCirculateRequestEvent(ptr))->parent)));
- if (XEN_XConfigureRequestEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XConfigureRequestEvent(ptr))->parent)));
- if (XEN_XReparentEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XReparentEvent(ptr))->parent)));
- if (XEN_XMapRequestEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XMapRequestEvent(ptr))->parent)));
- if (XEN_XCreateWindowEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XCreateWindowEvent(ptr))->parent)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "parent", "a struct with a parent field");
- return(XEN_FALSE);
+ if (Xen_is_XCirculateRequestEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XCirculateRequestEvent(ptr))->parent)));
+ if (Xen_is_XConfigureRequestEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XConfigureRequestEvent(ptr))->parent)));
+ if (Xen_is_XReparentEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XReparentEvent(ptr))->parent)));
+ if (Xen_is_XMapRequestEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XMapRequestEvent(ptr))->parent)));
+ if (Xen_is_XCreateWindowEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XCreateWindowEvent(ptr))->parent)));
+ XM_field_assert_type(0, ptr, 1, "parent", "a struct with a parent field");
+ return(Xen_false);
}
-static XEN gxm_set_parent(XEN ptr, XEN val)
+static Xen gxm_set_parent(Xen ptr, Xen val)
{
Window w;
- XM_SET_FIELD_ASSERT_TYPE(XEN_Window_P(val), val, XEN_ARG_2, "parent", "a Window");
- w = XEN_TO_C_Window(val);
- if (XEN_XCirculateRequestEvent_P(ptr)) (XEN_TO_C_XCirculateRequestEvent(ptr))->parent = w;
- else if (XEN_XConfigureRequestEvent_P(ptr)) (XEN_TO_C_XConfigureRequestEvent(ptr))->parent = w;
- else if (XEN_XReparentEvent_P(ptr)) (XEN_TO_C_XReparentEvent(ptr))->parent = w;
- else if (XEN_XMapRequestEvent_P(ptr)) (XEN_TO_C_XMapRequestEvent(ptr))->parent = w;
- else if (XEN_XCreateWindowEvent_P(ptr)) (XEN_TO_C_XCreateWindowEvent(ptr))->parent= w;
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "parent", "a struct with a parent field");
+ XM_set_field_assert_type(Xen_is_Window(val), val, 2, "parent", "a Window");
+ w = Xen_to_C_Window(val);
+ if (Xen_is_XCirculateRequestEvent(ptr)) (Xen_to_C_XCirculateRequestEvent(ptr))->parent = w;
+ else if (Xen_is_XConfigureRequestEvent(ptr)) (Xen_to_C_XConfigureRequestEvent(ptr))->parent = w;
+ else if (Xen_is_XReparentEvent(ptr)) (Xen_to_C_XReparentEvent(ptr))->parent = w;
+ else if (Xen_is_XMapRequestEvent(ptr)) (Xen_to_C_XMapRequestEvent(ptr))->parent = w;
+ else if (Xen_is_XCreateWindowEvent(ptr)) (Xen_to_C_XCreateWindowEvent(ptr))->parent= w;
+ else XM_set_field_assert_type(0, ptr, 1, "parent", "a struct with a parent field");
return(val);
}
-static XEN gxm_minor_code(XEN ptr)
+static Xen gxm_minor_code(Xen ptr)
{
- if (XEN_XErrorEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XErrorEvent(ptr))->minor_code)));
- if (XEN_XNoExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XNoExposeEvent(ptr))->minor_code)));
- if (XEN_XGraphicsExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGraphicsExposeEvent(ptr))->minor_code)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "minor_code", "a struct with a minor_code field");
- return(XEN_FALSE);
+ if (Xen_is_XErrorEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XErrorEvent(ptr))->minor_code)));
+ if (Xen_is_XNoExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XNoExposeEvent(ptr))->minor_code)));
+ if (Xen_is_XGraphicsExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGraphicsExposeEvent(ptr))->minor_code)));
+ XM_field_assert_type(0, ptr, 1, "minor_code", "a struct with a minor_code field");
+ return(Xen_false);
}
-static XEN gxm_set_minor_code(XEN ptr, XEN val)
+static Xen gxm_set_minor_code(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "minor_code", "an integer");
- if (XEN_XErrorEvent_P(ptr)) (XEN_TO_C_XErrorEvent(ptr))->minor_code = XEN_TO_C_INT(val);
- else if (XEN_XNoExposeEvent_P(ptr)) (XEN_TO_C_XNoExposeEvent(ptr))->minor_code = XEN_TO_C_INT(val);
- else if (XEN_XGraphicsExposeEvent_P(ptr)) (XEN_TO_C_XGraphicsExposeEvent(ptr))->minor_code = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "minor_code", "a struct with a minor_code field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "minor_code", "an integer");
+ if (Xen_is_XErrorEvent(ptr)) (Xen_to_C_XErrorEvent(ptr))->minor_code = Xen_integer_to_C_int(val);
+ else if (Xen_is_XNoExposeEvent(ptr)) (Xen_to_C_XNoExposeEvent(ptr))->minor_code = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGraphicsExposeEvent(ptr)) (Xen_to_C_XGraphicsExposeEvent(ptr))->minor_code = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "minor_code", "a struct with a minor_code field");
return(val);
}
-static XEN gxm_major_code(XEN ptr)
+static Xen gxm_major_code(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XNoExposeEvent_P(ptr) || XEN_XGraphicsExposeEvent_P(ptr), ptr, XEN_ONLY_ARG, "major_code", "a struct with a major_code field");
- if (XEN_XNoExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XNoExposeEvent(ptr))->major_code)));
- return(C_TO_XEN_INT((int)((XEN_TO_C_XGraphicsExposeEvent(ptr))->major_code)));
+ XM_field_assert_type(Xen_is_XNoExposeEvent(ptr) || Xen_is_XGraphicsExposeEvent(ptr), ptr, 1, "major_code", "a struct with a major_code field");
+ if (Xen_is_XNoExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XNoExposeEvent(ptr))->major_code)));
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XGraphicsExposeEvent(ptr))->major_code)));
}
-static XEN gxm_set_major_code(XEN ptr, XEN val)
+static Xen gxm_set_major_code(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "major_code", "an integer");
- if (XEN_XNoExposeEvent_P(ptr)) (XEN_TO_C_XNoExposeEvent(ptr))->major_code = XEN_TO_C_INT(val);
- else if (XEN_XGraphicsExposeEvent_P(ptr)) (XEN_TO_C_XGraphicsExposeEvent(ptr))->major_code = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "major_code", "a struct with a major_code field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "major_code", "an integer");
+ if (Xen_is_XNoExposeEvent(ptr)) (Xen_to_C_XNoExposeEvent(ptr))->major_code = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGraphicsExposeEvent(ptr)) (Xen_to_C_XGraphicsExposeEvent(ptr))->major_code = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "major_code", "a struct with a major_code field");
return(val);
}
-static XEN gxm_drawable(XEN ptr)
+static Xen gxm_drawable(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XNoExposeEvent_P(ptr) || XEN_XGraphicsExposeEvent_P(ptr), ptr, XEN_ONLY_ARG, "drawable", "a struct with a drawable field");
- if (XEN_XNoExposeEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XNoExposeEvent(ptr))->drawable)));
- return(C_TO_XEN_Window((Window)((XEN_TO_C_XGraphicsExposeEvent(ptr))->drawable)));
+ XM_field_assert_type(Xen_is_XNoExposeEvent(ptr) || Xen_is_XGraphicsExposeEvent(ptr), ptr, 1, "drawable", "a struct with a drawable field");
+ if (Xen_is_XNoExposeEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XNoExposeEvent(ptr))->drawable)));
+ return(C_to_Xen_Window((Window)((Xen_to_C_XGraphicsExposeEvent(ptr))->drawable)));
}
-static XEN gxm_set_drawable(XEN ptr, XEN val)
+static Xen gxm_set_drawable(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Window_P(val), val, XEN_ARG_2, "drawable", "a Window");
- if (XEN_XNoExposeEvent_P(ptr)) (XEN_TO_C_XNoExposeEvent(ptr))->drawable = XEN_TO_C_Window(val);
- else if (XEN_XGraphicsExposeEvent_P(ptr)) (XEN_TO_C_XGraphicsExposeEvent(ptr))->drawable = XEN_TO_C_Window(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "drawable", "a struct with a drawable field");
+ XM_set_field_assert_type(Xen_is_Window(val), val, 2, "drawable", "a Window");
+ if (Xen_is_XNoExposeEvent(ptr)) (Xen_to_C_XNoExposeEvent(ptr))->drawable = Xen_to_C_Window(val);
+ else if (Xen_is_XGraphicsExposeEvent(ptr)) (Xen_to_C_XGraphicsExposeEvent(ptr))->drawable = Xen_to_C_Window(val);
+ else XM_set_field_assert_type(0, ptr, 1, "drawable", "a struct with a drawable field");
return(val);
}
-static XEN gxm_count(XEN ptr)
+static Xen gxm_count(Xen ptr)
{
- if (XEN_XMappingEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XMappingEvent(ptr))->count)));
- if (XEN_XGraphicsExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGraphicsExposeEvent(ptr))->count)));
- if (XEN_XExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XExposeEvent(ptr))->count)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "count", "a struct with a count field");
- return(XEN_FALSE);
+ if (Xen_is_XMappingEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XMappingEvent(ptr))->count)));
+ if (Xen_is_XGraphicsExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGraphicsExposeEvent(ptr))->count)));
+ if (Xen_is_XExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XExposeEvent(ptr))->count)));
+ XM_field_assert_type(0, ptr, 1, "count", "a struct with a count field");
+ return(Xen_false);
}
-static XEN gxm_set_count(XEN ptr, XEN val)
+static Xen gxm_set_count(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "count", "an integer");
- if (XEN_XMappingEvent_P(ptr)) (XEN_TO_C_XMappingEvent(ptr))->count = XEN_TO_C_INT(val);
- else if (XEN_XGraphicsExposeEvent_P(ptr)) (XEN_TO_C_XGraphicsExposeEvent(ptr))->count = XEN_TO_C_INT(val);
- else if (XEN_XExposeEvent_P(ptr)) (XEN_TO_C_XExposeEvent(ptr))->count = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "count", "a struct with a count field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "count", "an integer");
+ if (Xen_is_XMappingEvent(ptr)) (Xen_to_C_XMappingEvent(ptr))->count = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGraphicsExposeEvent(ptr)) (Xen_to_C_XGraphicsExposeEvent(ptr))->count = Xen_integer_to_C_int(val);
+ else if (Xen_is_XExposeEvent(ptr)) (Xen_to_C_XExposeEvent(ptr))->count = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "count", "a struct with a count field");
return(val);
}
-static XEN gxm_key_vector(XEN ptr)
+static Xen gxm_key_vector(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XKeymapEvent_P(ptr), ptr, XEN_ONLY_ARG, "key_vector", "XKeymapEvent");
- return(C_TO_XEN_STRING((char *)((XEN_TO_C_XKeymapEvent(ptr))->key_vector)));
+ XM_field_assert_type(Xen_is_XKeymapEvent(ptr), ptr, 1, "key_vector", "XKeymapEvent");
+ return(C_string_to_Xen_string((char *)((Xen_to_C_XKeymapEvent(ptr))->key_vector)));
}
-static XEN gxm_set_key_vector(XEN ptr, XEN val)
+static Xen gxm_set_key_vector(Xen ptr, Xen val)
{
char *keys;
- int i, lim = 0;
- XM_SET_FIELD_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ARG_2, "key_vector", "a string");
- keys = (char *)XEN_TO_C_STRING(val);
+ int lim = 0;
+ XM_set_field_assert_type(Xen_is_string(val), val, 2, "key_vector", "a string");
+ keys = (char *)Xen_string_to_C_string(val);
if (keys) lim = strlen(keys);
if (lim > 32) lim = 32;
if (lim > 0)
{
- if (XEN_XKeymapEvent_P(ptr))
+ if (Xen_is_XKeymapEvent(ptr))
{
+ int i;
for (i = 0; i < lim; i++)
- (XEN_TO_C_XKeymapEvent(ptr))->key_vector[i] = keys[i];
+ (Xen_to_C_XKeymapEvent(ptr))->key_vector[i] = keys[i];
}
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "key_vector", "XKeymapEvent");
+ else XM_set_field_assert_type(0, ptr, 1, "key_vector", "XKeymapEvent");
}
return(val);
}
-static XEN gxm_focus(XEN ptr)
+static Xen gxm_focus(Xen ptr)
{
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XCrossingEvent(ptr))->focus)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "focus", "XCrossingEvent");
- return(XEN_FALSE);
+ if (Xen_is_XCrossingEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XCrossingEvent(ptr))->focus)));
+ XM_field_assert_type(0, ptr, 1, "focus", "XCrossingEvent");
+ return(Xen_false);
}
-static XEN gxm_set_focus(XEN ptr, XEN val)
+static Xen gxm_set_focus(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "focus", "a boolean");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XCrossingEvent_P(ptr), ptr, XEN_ARG_1, "focus", "XCrossingEvent");
- (XEN_TO_C_XCrossingEvent(ptr))->focus = (Bool)XEN_TO_C_BOOLEAN(val);
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "focus", "a boolean");
+ XM_set_field_assert_type(Xen_is_XCrossingEvent(ptr), ptr, 1, "focus", "XCrossingEvent");
+ (Xen_to_C_XCrossingEvent(ptr))->focus = (Bool)Xen_boolean_to_C_bool(val);
return(val);
}
-static XEN gxm_detail(XEN ptr)
+static Xen gxm_detail(Xen ptr)
{
- if (XEN_XConfigureRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureRequestEvent(ptr))->detail)));
- if (XEN_XFocusChangeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XFocusChangeEvent(ptr))->detail)));
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCrossingEvent(ptr))->detail)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "detail", "a struct with a detail field");
- return(XEN_FALSE);
+ if (Xen_is_XConfigureRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureRequestEvent(ptr))->detail)));
+ if (Xen_is_XFocusChangeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XFocusChangeEvent(ptr))->detail)));
+ if (Xen_is_XCrossingEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCrossingEvent(ptr))->detail)));
+ XM_field_assert_type(0, ptr, 1, "detail", "a struct with a detail field");
+ return(Xen_false);
}
-static XEN gxm_set_detail(XEN ptr, XEN val)
+static Xen gxm_set_detail(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "detail", "an integer");
- if (XEN_XConfigureRequestEvent_P(ptr)) (XEN_TO_C_XConfigureRequestEvent(ptr))->detail = XEN_TO_C_INT(val);
- else if (XEN_XFocusChangeEvent_P(ptr)) (XEN_TO_C_XFocusChangeEvent(ptr))->detail = XEN_TO_C_INT(val);
- else if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->detail = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "detail", "a struct with a detail field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "detail", "an integer");
+ if (Xen_is_XConfigureRequestEvent(ptr)) (Xen_to_C_XConfigureRequestEvent(ptr))->detail = Xen_integer_to_C_int(val);
+ else if (Xen_is_XFocusChangeEvent(ptr)) (Xen_to_C_XFocusChangeEvent(ptr))->detail = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->detail = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "detail", "a struct with a detail field");
return(val);
}
-static XEN gxm_mode(XEN ptr)
+static Xen gxm_mode(Xen ptr)
{
- if (XEN_XFocusChangeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XFocusChangeEvent(ptr))->mode)));
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCrossingEvent(ptr))->mode)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "mode", "a struct with a mode field");
- return(XEN_FALSE);
+ if (Xen_is_XFocusChangeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XFocusChangeEvent(ptr))->mode)));
+ if (Xen_is_XCrossingEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCrossingEvent(ptr))->mode)));
+ XM_field_assert_type(0, ptr, 1, "mode", "a struct with a mode field");
+ return(Xen_false);
}
-static XEN gxm_set_mode(XEN ptr, XEN val)
+static Xen gxm_set_mode(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "mode", "an integer");
- if (XEN_XFocusChangeEvent_P(ptr)) (XEN_TO_C_XFocusChangeEvent(ptr))->mode = XEN_TO_C_INT(val);
- else if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->mode = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "mode", "a struct with a mode field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "mode", "an integer");
+ if (Xen_is_XFocusChangeEvent(ptr)) (Xen_to_C_XFocusChangeEvent(ptr))->mode = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->mode = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "mode", "a struct with a mode field");
return(val);
}
-static XEN gxm_is_hint(XEN ptr)
+static Xen gxm_is_hint(Xen ptr)
{
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_char((char)((XEN_TO_C_XMotionEvent(ptr))->is_hint)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "is_hint", "XMotionEvent");
- return(XEN_FALSE);
+ if (Xen_is_XMotionEvent(ptr)) return(C_int_to_Xen_integer((char)((Xen_to_C_XMotionEvent(ptr))->is_hint)));
+ XM_field_assert_type(0, ptr, 1, "is_hint", "XMotionEvent");
+ return(Xen_false);
}
-static XEN gxm_set_is_hint(XEN ptr, XEN val)
+static Xen gxm_set_is_hint(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "is_hint", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XMotionEvent_P(ptr), ptr, XEN_ARG_1, "is_hint", "XMotionEvent");
- (XEN_TO_C_XMotionEvent(ptr))->is_hint = (char)XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "is_hint", "an integer");
+ XM_set_field_assert_type(Xen_is_XMotionEvent(ptr), ptr, 1, "is_hint", "XMotionEvent");
+ (Xen_to_C_XMotionEvent(ptr))->is_hint = (char)Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_button(XEN ptr)
+static Xen gxm_button(Xen ptr)
{
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XButtonEvent(ptr))->button)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "button", "XButtonEvent");
- return(XEN_FALSE);
+ if (Xen_is_XButtonEvent(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XButtonEvent(ptr))->button)));
+ XM_field_assert_type(0, ptr, 1, "button", "XButtonEvent");
+ return(Xen_false);
}
-static XEN gxm_set_button(XEN ptr, XEN val)
+static Xen gxm_set_button(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_ULONG_P(val), val, XEN_ARG_2, "button", "an unsigned long");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XButtonEvent_P(ptr), ptr, XEN_ARG_1, "button", "XButtonEvent");
- (XEN_TO_C_XButtonEvent(ptr))->button = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_ulong(val), val, 2, "button", "an unsigned long");
+ XM_set_field_assert_type(Xen_is_XButtonEvent(ptr), ptr, 1, "button", "XButtonEvent");
+ (Xen_to_C_XButtonEvent(ptr))->button = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_same_screen(XEN ptr)
+static Xen gxm_same_screen(Xen ptr)
{
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XCrossingEvent(ptr))->same_screen)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XMotionEvent(ptr))->same_screen)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XButtonEvent(ptr))->same_screen)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XKeyEvent(ptr))->same_screen)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "same_screen", "a struct with a same_screen field");
- return(XEN_FALSE);
+ if (Xen_is_XCrossingEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XCrossingEvent(ptr))->same_screen)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XMotionEvent(ptr))->same_screen)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XButtonEvent(ptr))->same_screen)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XKeyEvent(ptr))->same_screen)));
+ XM_field_assert_type(0, ptr, 1, "same_screen", "a struct with a same_screen field");
+ return(Xen_false);
}
-static XEN gxm_set_same_screen(XEN ptr, XEN val)
+static Xen gxm_set_same_screen(Xen ptr, Xen val)
{
Bool b;
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "same_screen", "a boolean");
- b = (Bool)XEN_TO_C_BOOLEAN(val);
- if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->same_screen = b;
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->same_screen = b;
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->same_screen = b;
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->same_screen = b;
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "same_screen", "a struct with a same_screen field");
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "same_screen", "a boolean");
+ b = (Bool)Xen_boolean_to_C_bool(val);
+ if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->same_screen = b;
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->same_screen = b;
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->same_screen = b;
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->same_screen = b;
+ else XM_set_field_assert_type(0, ptr, 1, "same_screen", "a struct with a same_screen field");
return(val);
}
-static XEN gxm_keycode(XEN ptr)
+static Xen gxm_keycode(Xen ptr)
{
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_KeyCode((XEN_TO_C_XKeyEvent(ptr))->keycode));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "keycode", "XKeyEvent");
- return(XEN_FALSE);
+ if (Xen_is_XKeyEvent(ptr)) return(C_to_Xen_KeyCode((Xen_to_C_XKeyEvent(ptr))->keycode));
+ XM_field_assert_type(0, ptr, 1, "keycode", "XKeyEvent");
+ return(Xen_false);
}
-static XEN gxm_set_keycode(XEN ptr, XEN val)
+static Xen gxm_set_keycode(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_KeyCode_P(val), val, XEN_ARG_2, "keycode", "a KeyCode");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XKeyEvent_P(ptr), ptr, XEN_ARG_1, "keycode", "XKeyEvent");
- (XEN_TO_C_XKeyEvent(ptr))->keycode = XEN_TO_C_KeyCode(val);
+ XM_set_field_assert_type(Xen_is_KeyCode(val), val, 2, "keycode", "a KeyCode");
+ XM_set_field_assert_type(Xen_is_XKeyEvent(ptr), ptr, 1, "keycode", "XKeyEvent");
+ (Xen_to_C_XKeyEvent(ptr))->keycode = Xen_to_C_KeyCode(val);
return(val);
}
-static XEN gxm_state(XEN ptr)
+static Xen gxm_state(Xen ptr)
{
- if (XEN_XColormapEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XColormapEvent(ptr))->state)));
- if (XEN_XPropertyEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XPropertyEvent(ptr))->state)));
- if (XEN_XVisibilityEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XVisibilityEvent(ptr))->state)));
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XCrossingEvent(ptr))->state)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XMotionEvent(ptr))->state)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XButtonEvent(ptr))->state)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XKeyEvent(ptr))->state)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "state", "a struct with a state field");
- return(XEN_FALSE);
+ if (Xen_is_XColormapEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XColormapEvent(ptr))->state)));
+ if (Xen_is_XPropertyEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XPropertyEvent(ptr))->state)));
+ if (Xen_is_XVisibilityEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XVisibilityEvent(ptr))->state)));
+ if (Xen_is_XCrossingEvent(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XCrossingEvent(ptr))->state)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XMotionEvent(ptr))->state)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XButtonEvent(ptr))->state)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XKeyEvent(ptr))->state)));
+ XM_field_assert_type(0, ptr, 1, "state", "a struct with a state field");
+ return(Xen_false);
}
-static XEN gxm_set_state(XEN ptr, XEN val)
+static Xen gxm_set_state(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val) || XEN_ULONG_P(val), val, XEN_ARG_2, "state", "an integer");
- if (XEN_XColormapEvent_P(ptr)) (XEN_TO_C_XColormapEvent(ptr))->state = XEN_TO_C_INT(val);
- else if (XEN_XPropertyEvent_P(ptr)) (XEN_TO_C_XPropertyEvent(ptr))->state = XEN_TO_C_INT(val);
- else if (XEN_XVisibilityEvent_P(ptr)) (XEN_TO_C_XVisibilityEvent(ptr))->state = XEN_TO_C_INT(val);
- else if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->state = XEN_TO_C_ULONG(val);
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->state = XEN_TO_C_ULONG(val);
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->state = XEN_TO_C_ULONG(val);
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->state = XEN_TO_C_ULONG(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "state", "a struct with a state field");
+ XM_set_field_assert_type(Xen_is_integer(val) || Xen_is_ulong(val), val, 2, "state", "an integer");
+ if (Xen_is_XColormapEvent(ptr)) (Xen_to_C_XColormapEvent(ptr))->state = Xen_integer_to_C_int(val);
+ else if (Xen_is_XPropertyEvent(ptr)) (Xen_to_C_XPropertyEvent(ptr))->state = Xen_integer_to_C_int(val);
+ else if (Xen_is_XVisibilityEvent(ptr)) (Xen_to_C_XVisibilityEvent(ptr))->state = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->state = Xen_ulong_to_C_ulong(val);
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->state = Xen_ulong_to_C_ulong(val);
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->state = Xen_ulong_to_C_ulong(val);
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->state = Xen_ulong_to_C_ulong(val);
+ else XM_set_field_assert_type(0, ptr, 1, "state", "a struct with a state field");
return(val);
}
-static XEN gxm_y_root(XEN ptr)
+static Xen gxm_y_root(Xen ptr)
{
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCrossingEvent(ptr))->y_root)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XMotionEvent(ptr))->y_root)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XButtonEvent(ptr))->y_root)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XKeyEvent(ptr))->y_root)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "y_root", "a struct with a y_root field");
- return(XEN_FALSE);
+ if (Xen_is_XCrossingEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCrossingEvent(ptr))->y_root)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XMotionEvent(ptr))->y_root)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XButtonEvent(ptr))->y_root)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XKeyEvent(ptr))->y_root)));
+ XM_field_assert_type(0, ptr, 1, "y_root", "a struct with a y_root field");
+ return(Xen_false);
}
-static XEN gxm_set_y_root(XEN ptr, XEN val)
+static Xen gxm_set_y_root(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "y_root", "an integer");
- if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->y_root = XEN_TO_C_INT(val);
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->y_root = XEN_TO_C_INT(val);
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->y_root = XEN_TO_C_INT(val);
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->y_root = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "y_root", "a struct with a y_root field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "y_root", "an integer");
+ if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->y_root = Xen_integer_to_C_int(val);
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->y_root = Xen_integer_to_C_int(val);
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->y_root = Xen_integer_to_C_int(val);
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->y_root = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "y_root", "a struct with a y_root field");
return(val);
}
-static XEN gxm_x_root(XEN ptr)
+static Xen gxm_x_root(Xen ptr)
{
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCrossingEvent(ptr))->x_root)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XMotionEvent(ptr))->x_root)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XButtonEvent(ptr))->x_root)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XKeyEvent(ptr))->x_root)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "x_root", "a struct with an x_root field");
- return(XEN_FALSE);
+ if (Xen_is_XCrossingEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCrossingEvent(ptr))->x_root)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XMotionEvent(ptr))->x_root)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XButtonEvent(ptr))->x_root)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XKeyEvent(ptr))->x_root)));
+ XM_field_assert_type(0, ptr, 1, "x_root", "a struct with an x_root field");
+ return(Xen_false);
}
-static XEN gxm_set_x_root(XEN ptr, XEN val)
+static Xen gxm_set_x_root(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "x_root", "an integer");
- if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->x_root = XEN_TO_C_INT(val);
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->x_root = XEN_TO_C_INT(val);
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->x_root = XEN_TO_C_INT(val);
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->x_root = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "x_root", "a struct with a x_root field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "x_root", "an integer");
+ if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->x_root = Xen_integer_to_C_int(val);
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->x_root = Xen_integer_to_C_int(val);
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->x_root = Xen_integer_to_C_int(val);
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->x_root = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "x_root", "a struct with a x_root field");
return(val);
}
-static XEN gxm_set_x(XEN ptr, XEN val)
-{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "x", "an integer");
- if (XEN_XRectangle_P(ptr)) (XEN_TO_C_XRectangle(ptr))->x = (short)XEN_TO_C_INT(val);
- else if (XEN_XPoint_P(ptr)) (XEN_TO_C_XPoint(ptr))->x = (short)XEN_TO_C_INT(val);
- else if (XEN_XArc_P(ptr)) (XEN_TO_C_XArc(ptr))->x = (short)XEN_TO_C_INT(val);
- else if (XEN_XConfigureRequestEvent_P(ptr)) (XEN_TO_C_XConfigureRequestEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XGravityEvent_P(ptr)) (XEN_TO_C_XGravityEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XConfigureEvent_P(ptr)) (XEN_TO_C_XConfigureEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XReparentEvent_P(ptr)) (XEN_TO_C_XReparentEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XCreateWindowEvent_P(ptr)) (XEN_TO_C_XCreateWindowEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XGraphicsExposeEvent_P(ptr)) (XEN_TO_C_XGraphicsExposeEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XExposeEvent_P(ptr)) (XEN_TO_C_XExposeEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->x = XEN_TO_C_INT(val);
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->x = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "x", "a struct with an x field");
+static Xen gxm_set_x(Xen ptr, Xen val)
+{
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "x", "an integer");
+ if (Xen_is_XRectangle(ptr)) (Xen_to_C_XRectangle(ptr))->x = (short)Xen_integer_to_C_int(val);
+ else if (Xen_is_XPoint(ptr)) (Xen_to_C_XPoint(ptr))->x = (short)Xen_integer_to_C_int(val);
+ else if (Xen_is_XArc(ptr)) (Xen_to_C_XArc(ptr))->x = (short)Xen_integer_to_C_int(val);
+ else if (Xen_is_XConfigureRequestEvent(ptr)) (Xen_to_C_XConfigureRequestEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGravityEvent(ptr)) (Xen_to_C_XGravityEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XConfigureEvent(ptr)) (Xen_to_C_XConfigureEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XReparentEvent(ptr)) (Xen_to_C_XReparentEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCreateWindowEvent(ptr)) (Xen_to_C_XCreateWindowEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGraphicsExposeEvent(ptr)) (Xen_to_C_XGraphicsExposeEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XExposeEvent(ptr)) (Xen_to_C_XExposeEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->x = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "x", "a struct with an x field");
return(val);
}
-static XEN gxm_set_y(XEN ptr, XEN val)
-{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "y", "an integer");
- if (XEN_XRectangle_P(ptr)) (XEN_TO_C_XRectangle(ptr))->y = (short)XEN_TO_C_INT(val);
- else if (XEN_XPoint_P(ptr)) (XEN_TO_C_XPoint(ptr))->y = (short)XEN_TO_C_INT(val);
- else if (XEN_XArc_P(ptr)) (XEN_TO_C_XArc(ptr))->y = (short)XEN_TO_C_INT(val);
- else if (XEN_XConfigureRequestEvent_P(ptr)) (XEN_TO_C_XConfigureRequestEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XGravityEvent_P(ptr)) (XEN_TO_C_XGravityEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XConfigureEvent_P(ptr)) (XEN_TO_C_XConfigureEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XReparentEvent_P(ptr)) (XEN_TO_C_XReparentEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XCreateWindowEvent_P(ptr)) (XEN_TO_C_XCreateWindowEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XGraphicsExposeEvent_P(ptr)) (XEN_TO_C_XGraphicsExposeEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XExposeEvent_P(ptr)) (XEN_TO_C_XExposeEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->y = XEN_TO_C_INT(val);
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->y = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "y", "a struct with a y field");
+static Xen gxm_set_y(Xen ptr, Xen val)
+{
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "y", "an integer");
+ if (Xen_is_XRectangle(ptr)) (Xen_to_C_XRectangle(ptr))->y = (short)Xen_integer_to_C_int(val);
+ else if (Xen_is_XPoint(ptr)) (Xen_to_C_XPoint(ptr))->y = (short)Xen_integer_to_C_int(val);
+ else if (Xen_is_XArc(ptr)) (Xen_to_C_XArc(ptr))->y = (short)Xen_integer_to_C_int(val);
+ else if (Xen_is_XConfigureRequestEvent(ptr)) (Xen_to_C_XConfigureRequestEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGravityEvent(ptr)) (Xen_to_C_XGravityEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XConfigureEvent(ptr)) (Xen_to_C_XConfigureEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XReparentEvent(ptr)) (Xen_to_C_XReparentEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCreateWindowEvent(ptr)) (Xen_to_C_XCreateWindowEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGraphicsExposeEvent(ptr)) (Xen_to_C_XGraphicsExposeEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XExposeEvent(ptr)) (Xen_to_C_XExposeEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->y = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "y", "a struct with a y field");
return(val);
}
-static XEN gxm_y(XEN ptr)
-{
- if (XEN_XRectangle_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XRectangle(ptr))->y)));
- if (XEN_XPoint_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XPoint(ptr))->y)));
- if (XEN_XArc_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XArc(ptr))->y)));
- if (XEN_XWindowChanges_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowChanges(ptr))->y)));
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->y)));
-#if HAVE_MOTIF
- if (XEN_XmDropProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropProcCallbackStruct(ptr))->y)));
- if (XEN_XmDragProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragProcCallbackStruct(ptr))->y)));
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->y)));
- if (XEN_XmDragMotionCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragMotionCallbackStruct(ptr))->y)));
- if (XEN_XmDropSiteEnterCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropSiteEnterCallbackStruct(ptr))->y)));
- if (XEN_XmTopLevelEnterCallbackStruct_P(ptr)) return(C_TO_XEN_Position((Position)((XEN_TO_C_XmTopLevelEnterCallbackStruct(ptr))->y)));
-#endif
- if (XEN_XConfigureRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureRequestEvent(ptr))->y)));
- if (XEN_XGravityEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGravityEvent(ptr))->y)));
- if (XEN_XConfigureEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureEvent(ptr))->y)));
- if (XEN_XReparentEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XReparentEvent(ptr))->y)));
- if (XEN_XCreateWindowEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCreateWindowEvent(ptr))->y)));
- if (XEN_XGraphicsExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGraphicsExposeEvent(ptr))->y)));
- if (XEN_XExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XExposeEvent(ptr))->y)));
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCrossingEvent(ptr))->y)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XMotionEvent(ptr))->y)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XButtonEvent(ptr))->y)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XKeyEvent(ptr))->y)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "y", "a struct with a y field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_x(XEN ptr)
-{
- if (XEN_XRectangle_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XRectangle(ptr))->x)));
- if (XEN_XPoint_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XPoint(ptr))->x)));
- if (XEN_XArc_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XArc(ptr))->x)));
- if (XEN_XWindowChanges_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowChanges(ptr))->x)));
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->x)));
-#if HAVE_MOTIF
- if (XEN_XmDropProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropProcCallbackStruct(ptr))->x)));
- if (XEN_XmDragProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragProcCallbackStruct(ptr))->x)));
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->x)));
- if (XEN_XmDragMotionCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragMotionCallbackStruct(ptr))->x)));
- if (XEN_XmDropSiteEnterCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropSiteEnterCallbackStruct(ptr))->x)));
- if (XEN_XmTopLevelEnterCallbackStruct_P(ptr)) return(C_TO_XEN_Position((Position)((XEN_TO_C_XmTopLevelEnterCallbackStruct(ptr))->x)));
-#endif
- if (XEN_XConfigureRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureRequestEvent(ptr))->x)));
- if (XEN_XGravityEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGravityEvent(ptr))->x)));
- if (XEN_XConfigureEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureEvent(ptr))->x)));
- if (XEN_XReparentEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XReparentEvent(ptr))->x)));
- if (XEN_XCreateWindowEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCreateWindowEvent(ptr))->x)));
- if (XEN_XGraphicsExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGraphicsExposeEvent(ptr))->x)));
- if (XEN_XExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XExposeEvent(ptr))->x)));
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCrossingEvent(ptr))->x)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XMotionEvent(ptr))->x)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XButtonEvent(ptr))->x)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XKeyEvent(ptr))->x)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "x", "a struct with an x field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_time(XEN ptr)
-{
-#if HAVE_MOTIF
- if (XEN_XmDestinationCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDestinationCallbackStruct(ptr))->time)));
-#endif
- if (XEN_XSelectionEvent_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XSelectionEvent(ptr))->time)));
- if (XEN_XSelectionRequestEvent_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XSelectionRequestEvent(ptr))->time)));
- if (XEN_XSelectionClearEvent_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XSelectionClearEvent(ptr))->time)));
- if (XEN_XPropertyEvent_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XPropertyEvent(ptr))->time)));
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XCrossingEvent(ptr))->time)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XMotionEvent(ptr))->time)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XButtonEvent(ptr))->time)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XKeyEvent(ptr))->time)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "time", "a struct with a time field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_set_time(XEN ptr, XEN val)
+static Xen gxm_y(Xen ptr)
+{
+ if (Xen_is_XRectangle(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XRectangle(ptr))->y)));
+ if (Xen_is_XPoint(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XPoint(ptr))->y)));
+ if (Xen_is_XArc(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XArc(ptr))->y)));
+ if (Xen_is_XWindowChanges(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowChanges(ptr))->y)));
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->y)));
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropProcCallbackStruct(ptr))->y)));
+ if (Xen_is_XmDragProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragProcCallbackStruct(ptr))->y)));
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropStartCallbackStruct(ptr))->y)));
+ if (Xen_is_XmDragMotionCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragMotionCallbackStruct(ptr))->y)));
+ if (Xen_is_XmDropSiteEnterCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropSiteEnterCallbackStruct(ptr))->y)));
+ if (Xen_is_XmTopLevelEnterCallbackStruct(ptr)) return(C_to_Xen_Position((Position)((Xen_to_C_XmTopLevelEnterCallbackStruct(ptr))->y)));
+ if (Xen_is_XConfigureRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureRequestEvent(ptr))->y)));
+ if (Xen_is_XGravityEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGravityEvent(ptr))->y)));
+ if (Xen_is_XConfigureEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureEvent(ptr))->y)));
+ if (Xen_is_XReparentEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XReparentEvent(ptr))->y)));
+ if (Xen_is_XCreateWindowEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCreateWindowEvent(ptr))->y)));
+ if (Xen_is_XGraphicsExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGraphicsExposeEvent(ptr))->y)));
+ if (Xen_is_XExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XExposeEvent(ptr))->y)));
+ if (Xen_is_XCrossingEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCrossingEvent(ptr))->y)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XMotionEvent(ptr))->y)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XButtonEvent(ptr))->y)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XKeyEvent(ptr))->y)));
+ XM_field_assert_type(0, ptr, 1, "y", "a struct with a y field");
+ return(Xen_false);
+}
+
+static Xen gxm_x(Xen ptr)
+{
+ if (Xen_is_XRectangle(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XRectangle(ptr))->x)));
+ if (Xen_is_XPoint(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XPoint(ptr))->x)));
+ if (Xen_is_XArc(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XArc(ptr))->x)));
+ if (Xen_is_XWindowChanges(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowChanges(ptr))->x)));
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->x)));
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropProcCallbackStruct(ptr))->x)));
+ if (Xen_is_XmDragProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragProcCallbackStruct(ptr))->x)));
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropStartCallbackStruct(ptr))->x)));
+ if (Xen_is_XmDragMotionCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragMotionCallbackStruct(ptr))->x)));
+ if (Xen_is_XmDropSiteEnterCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropSiteEnterCallbackStruct(ptr))->x)));
+ if (Xen_is_XmTopLevelEnterCallbackStruct(ptr)) return(C_to_Xen_Position((Position)((Xen_to_C_XmTopLevelEnterCallbackStruct(ptr))->x)));
+ if (Xen_is_XConfigureRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureRequestEvent(ptr))->x)));
+ if (Xen_is_XGravityEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGravityEvent(ptr))->x)));
+ if (Xen_is_XConfigureEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureEvent(ptr))->x)));
+ if (Xen_is_XReparentEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XReparentEvent(ptr))->x)));
+ if (Xen_is_XCreateWindowEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCreateWindowEvent(ptr))->x)));
+ if (Xen_is_XGraphicsExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGraphicsExposeEvent(ptr))->x)));
+ if (Xen_is_XExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XExposeEvent(ptr))->x)));
+ if (Xen_is_XCrossingEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCrossingEvent(ptr))->x)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XMotionEvent(ptr))->x)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XButtonEvent(ptr))->x)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XKeyEvent(ptr))->x)));
+ XM_field_assert_type(0, ptr, 1, "x", "a struct with an x field");
+ return(Xen_false);
+}
+
+static Xen gxm_time(Xen ptr)
+{
+ if (Xen_is_XmDestinationCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDestinationCallbackStruct(ptr))->time)));
+ if (Xen_is_XSelectionEvent(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XSelectionEvent(ptr))->time)));
+ if (Xen_is_XSelectionRequestEvent(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XSelectionRequestEvent(ptr))->time)));
+ if (Xen_is_XSelectionClearEvent(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XSelectionClearEvent(ptr))->time)));
+ if (Xen_is_XPropertyEvent(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XPropertyEvent(ptr))->time)));
+ if (Xen_is_XCrossingEvent(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XCrossingEvent(ptr))->time)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XMotionEvent(ptr))->time)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XButtonEvent(ptr))->time)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XKeyEvent(ptr))->time)));
+ XM_field_assert_type(0, ptr, 1, "time", "a struct with a time field");
+ return(Xen_false);
+}
+
+static Xen gxm_set_time(Xen ptr, Xen val)
{
Time tm;
- XM_SET_FIELD_ASSERT_TYPE(XEN_Time_P(val), val, XEN_ARG_2, "time", "Time");
- tm = XEN_TO_C_Time(val);
- if (XEN_XSelectionEvent_P(ptr)) (XEN_TO_C_XSelectionEvent(ptr))->time = tm;
- else if (XEN_XSelectionRequestEvent_P(ptr)) (XEN_TO_C_XSelectionRequestEvent(ptr))->time = tm;
- else if (XEN_XSelectionClearEvent_P(ptr)) (XEN_TO_C_XSelectionClearEvent(ptr))->time = tm;
- else if (XEN_XPropertyEvent_P(ptr)) (XEN_TO_C_XPropertyEvent(ptr))->time = tm;
- else if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->time = tm;
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->time = tm;
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->time = tm;
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->time = tm;
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "time", "a struct with a time field");
+ XM_set_field_assert_type(Xen_is_Time(val), val, 2, "time", "Time");
+ tm = Xen_to_C_Time(val);
+ if (Xen_is_XSelectionEvent(ptr)) (Xen_to_C_XSelectionEvent(ptr))->time = tm;
+ else if (Xen_is_XSelectionRequestEvent(ptr)) (Xen_to_C_XSelectionRequestEvent(ptr))->time = tm;
+ else if (Xen_is_XSelectionClearEvent(ptr)) (Xen_to_C_XSelectionClearEvent(ptr))->time = tm;
+ else if (Xen_is_XPropertyEvent(ptr)) (Xen_to_C_XPropertyEvent(ptr))->time = tm;
+ else if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->time = tm;
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->time = tm;
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->time = tm;
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->time = tm;
+ else XM_set_field_assert_type(0, ptr, 1, "time", "a struct with a time field");
return(val);
}
-static XEN gxm_subwindow(XEN ptr)
+static Xen gxm_subwindow(Xen ptr)
{
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XCrossingEvent(ptr))->subwindow)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XMotionEvent(ptr))->subwindow)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XButtonEvent(ptr))->subwindow)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XKeyEvent(ptr))->subwindow)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "subwindow", "a struct with a subwindow field");
- return(XEN_FALSE);
+ if (Xen_is_XCrossingEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XCrossingEvent(ptr))->subwindow)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XMotionEvent(ptr))->subwindow)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XButtonEvent(ptr))->subwindow)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XKeyEvent(ptr))->subwindow)));
+ XM_field_assert_type(0, ptr, 1, "subwindow", "a struct with a subwindow field");
+ return(Xen_false);
}
-static XEN gxm_set_subwindow(XEN ptr, XEN val)
+static Xen gxm_set_subwindow(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Window_P(val), val, XEN_ARG_2, "subwindow", "a Window");
- if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->subwindow = XEN_TO_C_Window(val);
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->subwindow = XEN_TO_C_Window(val);
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->subwindow = XEN_TO_C_Window(val);
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->subwindow = XEN_TO_C_Window(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "subwindow", "a struct with a subwindow field");
+ XM_set_field_assert_type(Xen_is_Window(val), val, 2, "subwindow", "a Window");
+ if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->subwindow = Xen_to_C_Window(val);
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->subwindow = Xen_to_C_Window(val);
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->subwindow = Xen_to_C_Window(val);
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->subwindow = Xen_to_C_Window(val);
+ else XM_set_field_assert_type(0, ptr, 1, "subwindow", "a struct with a subwindow field");
return(val);
}
-static XEN gxm_window(XEN ptr)
+static Xen gxm_window(Xen ptr)
{
-#if HAVE_MOTIF
- if (XEN_XmDrawnButtonCallbackStruct_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XmDrawnButtonCallbackStruct(ptr))->window)));
- if (XEN_XmDrawingAreaCallbackStruct_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XmDrawingAreaCallbackStruct(ptr))->window)));
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->window)));
- if (XEN_XmTopLevelEnterCallbackStruct_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XmTopLevelEnterCallbackStruct(ptr))->window)));
- if (XEN_XmTopLevelLeaveCallbackStruct_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XmTopLevelLeaveCallbackStruct(ptr))->window)));
-#endif
- if (XEN_XEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XAnyEvent(ptr))->window)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "window", "a struct with a window field");
- return(XEN_FALSE);
+ if (Xen_is_XmDrawnButtonCallbackStruct(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XmDrawnButtonCallbackStruct(ptr))->window)));
+ if (Xen_is_XmDrawingAreaCallbackStruct(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XmDrawingAreaCallbackStruct(ptr))->window)));
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XmDropStartCallbackStruct(ptr))->window)));
+ if (Xen_is_XmTopLevelEnterCallbackStruct(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XmTopLevelEnterCallbackStruct(ptr))->window)));
+ if (Xen_is_XmTopLevelLeaveCallbackStruct(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XmTopLevelLeaveCallbackStruct(ptr))->window)));
+ if (Xen_is_XEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XAnyEvent(ptr))->window)));
+ XM_field_assert_type(0, ptr, 1, "window", "a struct with a window field");
+ return(Xen_false);
}
-static XEN gxm_set_window(XEN ptr, XEN val)
+static Xen gxm_set_window(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Window_P(val), val, XEN_ARG_2, "window", "a Window");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XEvent_P(ptr), ptr, XEN_ARG_1, "window", "XEvent");
- (XEN_TO_C_XAnyEvent(ptr))->window = XEN_TO_C_Window(val);
+ XM_set_field_assert_type(Xen_is_Window(val), val, 2, "window", "a Window");
+ XM_set_field_assert_type(Xen_is_XEvent(ptr), ptr, 1, "window", "XEvent");
+ (Xen_to_C_XAnyEvent(ptr))->window = Xen_to_C_Window(val);
return(val);
}
-static XEN gxm_send_event(XEN ptr)
+static Xen gxm_send_event(Xen ptr)
{
- if (XEN_XEvent_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XAnyEvent(ptr))->send_event)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "send_event", "XEvent");
- return(XEN_FALSE);
+ if (Xen_is_XEvent(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XAnyEvent(ptr))->send_event)));
+ XM_field_assert_type(0, ptr, 1, "send_event", "XEvent");
+ return(Xen_false);
}
-static XEN gxm_set_send_event(XEN ptr, XEN val)
+static Xen gxm_set_send_event(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "send_event", "a boolean");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XEvent_P(ptr), ptr, XEN_ARG_1, "send_event", "XEvent");
- (XEN_TO_C_XAnyEvent(ptr))->send_event = (Bool)XEN_TO_C_BOOLEAN(val);
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "send_event", "a boolean");
+ XM_set_field_assert_type(Xen_is_XEvent(ptr), ptr, 1, "send_event", "XEvent");
+ (Xen_to_C_XAnyEvent(ptr))->send_event = (Bool)Xen_boolean_to_C_bool(val);
return(val);
}
-static XEN gxm_serial(XEN ptr)
+static Xen gxm_serial(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XEvent_P(ptr), ptr, XEN_ONLY_ARG, "serial", "XEvent");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XAnyEvent(ptr))->serial)));
+ XM_field_assert_type(Xen_is_XEvent(ptr), ptr, 1, "serial", "XEvent");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XAnyEvent(ptr))->serial)));
}
-static XEN gxm_set_serial(XEN ptr, XEN val)
+static Xen gxm_set_serial(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XEvent_P(ptr), ptr, XEN_ARG_1, "serial", "XEvent");
- (XEN_TO_C_XAnyEvent(ptr))->serial = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_XEvent(ptr), ptr, 1, "serial", "XEvent");
+ (Xen_to_C_XAnyEvent(ptr))->serial = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_type(XEN ptr)
+static Xen gxm_type(Xen ptr)
{
-#if HAVE_MOTIF
- if (XEN_XmSelectionCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmSelectionCallbackStruct(ptr))->type)));
- if (XEN_XmConvertCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmConvertCallbackStruct(ptr))->type)));
-#endif
- if (XEN_XEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XAnyEvent(ptr))->type)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "type", "a struct with a type field");
- return(XEN_FALSE);
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmSelectionCallbackStruct(ptr))->type)));
+ if (Xen_is_XmConvertCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmConvertCallbackStruct(ptr))->type)));
+ if (Xen_is_XEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XAnyEvent(ptr))->type)));
+ XM_field_assert_type(0, ptr, 1, "type", "a struct with a type field");
+ return(Xen_false);
}
-static XEN gxm_set_type(XEN ptr, XEN val)
+static Xen gxm_set_type(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XEvent_P(ptr), ptr, XEN_ARG_1, "type", "XEvent");
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "type", "integer");
- (XEN_TO_C_XAnyEvent(ptr))->type = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_XEvent(ptr), ptr, 1, "type", "XEvent");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "type", "integer");
+ (Xen_to_C_XAnyEvent(ptr))->type = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_root_input_mask(XEN ptr)
+static Xen gxm_root_input_mask(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "root_input_mask", "Screen");
- return(C_TO_XEN_INT((long)((XEN_TO_C_Screen(ptr))->root_input_mask)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "root_input_mask", "Screen");
+ return(C_int_to_Xen_integer((long)((Xen_to_C_Screen(ptr))->root_input_mask)));
}
-static XEN gxm_save_unders(XEN ptr)
+static Xen gxm_save_unders(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "save_unders", "Screen");
- return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_Screen(ptr))->save_unders)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "save_unders", "Screen");
+ return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_Screen(ptr))->save_unders)));
}
-static XEN gxm_backing_store(XEN ptr)
+static Xen gxm_backing_store(Xen ptr)
{
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_BOOLEAN((int)((XEN_TO_C_XWindowAttributes(ptr))->backing_store)));
- if (XEN_XSetWindowAttributes_P(ptr)) return(C_TO_XEN_BOOLEAN((int)((XEN_TO_C_XSetWindowAttributes(ptr))->backing_store)));
- if (XEN_Screen_P(ptr)) return(C_TO_XEN_BOOLEAN((int)((XEN_TO_C_Screen(ptr))->backing_store)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "backing_store", "a struct with a backing_store field");
- return(XEN_FALSE);
+ if (Xen_is_XWindowAttributes(ptr)) return(C_bool_to_Xen_boolean((int)((Xen_to_C_XWindowAttributes(ptr))->backing_store)));
+ if (Xen_is_XSetWindowAttributes(ptr)) return(C_bool_to_Xen_boolean((int)((Xen_to_C_XSetWindowAttributes(ptr))->backing_store)));
+ if (Xen_is_Screen(ptr)) return(C_bool_to_Xen_boolean((int)((Xen_to_C_Screen(ptr))->backing_store)));
+ XM_field_assert_type(0, ptr, 1, "backing_store", "a struct with a backing_store field");
+ return(Xen_false);
}
-static XEN gxm_set_backing_store(XEN ptr, XEN val)
+static Xen gxm_set_backing_store(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XSetWindowAttributes_P(ptr) || XEN_XWindowAttributes_P(ptr) || XEN_Screen_P(ptr),
- ptr, XEN_ARG_1, "backing_store", "a struct with a backing_store field");
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "backing_store", "a Boolean");
- if (XEN_XWindowAttributes_P(ptr))
- (XEN_TO_C_XWindowAttributes(ptr))->backing_store = XEN_TO_C_BOOLEAN(val);
- else if (XEN_XSetWindowAttributes_P(ptr))
- (XEN_TO_C_XSetWindowAttributes(ptr))->backing_store = XEN_TO_C_BOOLEAN(val);
- else if (XEN_Screen_P(ptr))
- (XEN_TO_C_Screen(ptr))->backing_store = XEN_TO_C_BOOLEAN(val);
+ XM_set_field_assert_type(Xen_is_XSetWindowAttributes(ptr) || Xen_is_XWindowAttributes(ptr) || Xen_is_Screen(ptr),
+ ptr, 1, "backing_store", "a struct with a backing_store field");
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "backing_store", "a Boolean");
+ if (Xen_is_XWindowAttributes(ptr))
+ (Xen_to_C_XWindowAttributes(ptr))->backing_store = Xen_boolean_to_C_bool(val);
+ else if (Xen_is_XSetWindowAttributes(ptr))
+ (Xen_to_C_XSetWindowAttributes(ptr))->backing_store = Xen_boolean_to_C_bool(val);
+ else if (Xen_is_Screen(ptr))
+ (Xen_to_C_Screen(ptr))->backing_store = Xen_boolean_to_C_bool(val);
return(val);
}
-static XEN gxm_min_maps(XEN ptr)
+static Xen gxm_min_maps(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "min_maps", "Screen");
- return(C_TO_XEN_INT((int)((XEN_TO_C_Screen(ptr))->min_maps)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "min_maps", "Screen");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_Screen(ptr))->min_maps)));
}
-static XEN gxm_max_maps(XEN ptr)
+static Xen gxm_max_maps(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "max_maps", "Screen");
- return(C_TO_XEN_INT((int)((XEN_TO_C_Screen(ptr))->max_maps)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "max_maps", "Screen");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_Screen(ptr))->max_maps)));
}
-static XEN gxm_black_pixel(XEN ptr)
+static Xen gxm_black_pixel(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "black_pixel", "Screen");
- return(C_TO_XEN_Pixel((XEN_TO_C_Screen(ptr))->black_pixel));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "black_pixel", "Screen");
+ return(C_to_Xen_Pixel((Xen_to_C_Screen(ptr))->black_pixel));
}
-static XEN gxm_white_pixel(XEN ptr)
+static Xen gxm_white_pixel(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "white_pixel", "Screen");
- return(C_TO_XEN_Pixel((XEN_TO_C_Screen(ptr))->white_pixel));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "white_pixel", "Screen");
+ return(C_to_Xen_Pixel((Xen_to_C_Screen(ptr))->white_pixel));
}
-static XEN gxm_cmap(XEN ptr)
+static Xen gxm_cmap(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "cmap", "Screen");
- return(C_TO_XEN_Colormap((Colormap)((XEN_TO_C_Screen(ptr))->cmap)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "cmap", "Screen");
+ return(C_to_Xen_Colormap((Colormap)((Xen_to_C_Screen(ptr))->cmap)));
}
-static XEN gxm_default_gc(XEN ptr)
+static Xen gxm_default_gc(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "default_gc", "Screen");
- return(C_TO_XEN_GC((GC)((XEN_TO_C_Screen(ptr))->default_gc)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "default_gc", "Screen");
+ return(C_to_Xen_GC((GC)((Xen_to_C_Screen(ptr))->default_gc)));
}
-static XEN gxm_root_visual(XEN ptr)
+static Xen gxm_root_visual(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "root_visual", "Screen");
- return(C_TO_XEN_Visual((Visual *)((XEN_TO_C_Screen(ptr))->root_visual)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "root_visual", "Screen");
+ return(C_to_Xen_Visual((Visual *)((Xen_to_C_Screen(ptr))->root_visual)));
}
-static XEN gxm_root_depth(XEN ptr)
+static Xen gxm_root_depth(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "root_depth", "Screen");
- return(C_TO_XEN_INT((int)((XEN_TO_C_Screen(ptr))->root_depth)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "root_depth", "Screen");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_Screen(ptr))->root_depth)));
}
-static XEN gxm_depths(XEN ptr)
+static Xen gxm_depths(Xen ptr)
{
- Depth *dps;
Screen *scr;
- int i, len;
- XEN lst = XEN_EMPTY_LIST;
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "depths", "Screen");
- scr = XEN_TO_C_Screen(ptr);
+ int len;
+ Xen lst = Xen_empty_list;
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "depths", "Screen");
+ scr = Xen_to_C_Screen(ptr);
len = scr->ndepths;
if (len > 0)
{
+ Depth *dps;
+ int i;
dps = scr->depths;
for (i = len - 1; i >= 0; i--)
- lst = XEN_CONS(WRAP_FOR_XEN("Depth", &(dps[i])), lst);
+ lst = Xen_cons(wrap_for_Xen("Depth", &(dps[i])), lst);
}
return(lst);
}
-static XEN gxm_ndepths(XEN ptr)
+static Xen gxm_ndepths(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "ndepths", "Screen");
- return(C_TO_XEN_INT((int)((XEN_TO_C_Screen(ptr))->ndepths)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "ndepths", "Screen");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_Screen(ptr))->ndepths)));
}
-static XEN gxm_mheight(XEN ptr)
+static Xen gxm_mheight(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "mheight", "Screen");
- return(C_TO_XEN_INT((int)((XEN_TO_C_Screen(ptr))->mheight)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "mheight", "Screen");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_Screen(ptr))->mheight)));
}
-static XEN gxm_mwidth(XEN ptr)
+static Xen gxm_mwidth(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "mwidth", "Screen");
- return(C_TO_XEN_INT((int)((XEN_TO_C_Screen(ptr))->mwidth)));
+ XM_field_assert_type(Xen_is_Screen(ptr), ptr, 1, "mwidth", "Screen");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_Screen(ptr))->mwidth)));
}
-static XEN gxm_set_height(XEN ptr, XEN val)
+static Xen gxm_set_height(Xen ptr, Xen val)
{
- if (XEN_XRectangle_P(ptr)) (XEN_TO_C_XRectangle(ptr))->height = XEN_TO_C_INT(val);
- else if (XEN_XArc_P(ptr)) (XEN_TO_C_XArc(ptr))->height = XEN_TO_C_INT(val);
- else if (XEN_XpmImage_P(ptr)) (XEN_TO_C_XpmImage(ptr))->height = XEN_TO_C_ULONG(val);
- else if (XEN_XpmAttributes_P(ptr)) (XEN_TO_C_XpmAttributes(ptr))->height = XEN_TO_C_ULONG(val);
- else if (XEN_XConfigureRequestEvent_P(ptr)) (XEN_TO_C_XConfigureRequestEvent(ptr))->height = XEN_TO_C_INT(val);
- else if (XEN_XResizeRequestEvent_P(ptr)) (XEN_TO_C_XResizeRequestEvent(ptr))->height = XEN_TO_C_INT(val);
- else if (XEN_XConfigureEvent_P(ptr)) (XEN_TO_C_XConfigureEvent(ptr))->height = XEN_TO_C_INT(val);
- else if (XEN_XCreateWindowEvent_P(ptr)) (XEN_TO_C_XCreateWindowEvent(ptr))->height = XEN_TO_C_INT(val);
- else if (XEN_XGraphicsExposeEvent_P(ptr)) (XEN_TO_C_XGraphicsExposeEvent(ptr))->height = XEN_TO_C_INT(val);
- else if (XEN_XExposeEvent_P(ptr)) (XEN_TO_C_XExposeEvent(ptr))->height = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "height", "a struct with a height field");
+ if (Xen_is_XRectangle(ptr)) (Xen_to_C_XRectangle(ptr))->height = Xen_integer_to_C_int(val);
+ else if (Xen_is_XArc(ptr)) (Xen_to_C_XArc(ptr))->height = Xen_integer_to_C_int(val);
+ else if (Xen_is_XpmImage(ptr)) (Xen_to_C_XpmImage(ptr))->height = Xen_ulong_to_C_ulong(val);
+ else if (Xen_is_XpmAttributes(ptr)) (Xen_to_C_XpmAttributes(ptr))->height = Xen_ulong_to_C_ulong(val);
+ else if (Xen_is_XConfigureRequestEvent(ptr)) (Xen_to_C_XConfigureRequestEvent(ptr))->height = Xen_integer_to_C_int(val);
+ else if (Xen_is_XResizeRequestEvent(ptr)) (Xen_to_C_XResizeRequestEvent(ptr))->height = Xen_integer_to_C_int(val);
+ else if (Xen_is_XConfigureEvent(ptr)) (Xen_to_C_XConfigureEvent(ptr))->height = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCreateWindowEvent(ptr)) (Xen_to_C_XCreateWindowEvent(ptr))->height = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGraphicsExposeEvent(ptr)) (Xen_to_C_XGraphicsExposeEvent(ptr))->height = Xen_integer_to_C_int(val);
+ else if (Xen_is_XExposeEvent(ptr)) (Xen_to_C_XExposeEvent(ptr))->height = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "height", "a struct with a height field");
return(val);
}
-static XEN gxm_set_width(XEN ptr, XEN val)
+static Xen gxm_set_width(Xen ptr, Xen val)
{
- if (XEN_XRectangle_P(ptr)) (XEN_TO_C_XRectangle(ptr))->width = XEN_TO_C_INT(val);
- else if (XEN_XArc_P(ptr)) (XEN_TO_C_XArc(ptr))->width = XEN_TO_C_INT(val);
- else if (XEN_XpmImage_P(ptr)) (XEN_TO_C_XpmImage(ptr))->width = XEN_TO_C_ULONG(val);
- else if (XEN_XpmAttributes_P(ptr)) (XEN_TO_C_XpmAttributes(ptr))->width = XEN_TO_C_ULONG(val);
- else if (XEN_XConfigureRequestEvent_P(ptr)) (XEN_TO_C_XConfigureRequestEvent(ptr))->width = XEN_TO_C_INT(val);
- else if (XEN_XResizeRequestEvent_P(ptr)) (XEN_TO_C_XResizeRequestEvent(ptr))->width = XEN_TO_C_INT(val);
- else if (XEN_XConfigureEvent_P(ptr)) (XEN_TO_C_XConfigureEvent(ptr))->width = XEN_TO_C_INT(val);
- else if (XEN_XCreateWindowEvent_P(ptr)) (XEN_TO_C_XCreateWindowEvent(ptr))->width = XEN_TO_C_INT(val);
- else if (XEN_XGraphicsExposeEvent_P(ptr)) (XEN_TO_C_XGraphicsExposeEvent(ptr))->width = XEN_TO_C_INT(val);
- else if (XEN_XExposeEvent_P(ptr)) (XEN_TO_C_XExposeEvent(ptr))->width = XEN_TO_C_INT(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "width", "a struct with a width field");
+ if (Xen_is_XRectangle(ptr)) (Xen_to_C_XRectangle(ptr))->width = Xen_integer_to_C_int(val);
+ else if (Xen_is_XArc(ptr)) (Xen_to_C_XArc(ptr))->width = Xen_integer_to_C_int(val);
+ else if (Xen_is_XpmImage(ptr)) (Xen_to_C_XpmImage(ptr))->width = Xen_ulong_to_C_ulong(val);
+ else if (Xen_is_XpmAttributes(ptr)) (Xen_to_C_XpmAttributes(ptr))->width = Xen_ulong_to_C_ulong(val);
+ else if (Xen_is_XConfigureRequestEvent(ptr)) (Xen_to_C_XConfigureRequestEvent(ptr))->width = Xen_integer_to_C_int(val);
+ else if (Xen_is_XResizeRequestEvent(ptr)) (Xen_to_C_XResizeRequestEvent(ptr))->width = Xen_integer_to_C_int(val);
+ else if (Xen_is_XConfigureEvent(ptr)) (Xen_to_C_XConfigureEvent(ptr))->width = Xen_integer_to_C_int(val);
+ else if (Xen_is_XCreateWindowEvent(ptr)) (Xen_to_C_XCreateWindowEvent(ptr))->width = Xen_integer_to_C_int(val);
+ else if (Xen_is_XGraphicsExposeEvent(ptr)) (Xen_to_C_XGraphicsExposeEvent(ptr))->width = Xen_integer_to_C_int(val);
+ else if (Xen_is_XExposeEvent(ptr)) (Xen_to_C_XExposeEvent(ptr))->width = Xen_integer_to_C_int(val);
+ else XM_set_field_assert_type(0, ptr, 1, "width", "a struct with a width field");
return(val);
}
-static XEN gxm_height(XEN ptr)
-{
- if (XEN_XRectangle_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XRectangle(ptr))->height)));
- if (XEN_XArc_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XArc(ptr))->height)));
- if (XEN_XWindowChanges_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowChanges(ptr))->height)));
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->height)));
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->height)));
- if (XEN_XConfigureRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureRequestEvent(ptr))->height)));
- if (XEN_XResizeRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XResizeRequestEvent(ptr))->height)));
- if (XEN_XConfigureEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureEvent(ptr))->height)));
- if (XEN_XCreateWindowEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCreateWindowEvent(ptr))->height)));
- if (XEN_XGraphicsExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGraphicsExposeEvent(ptr))->height)));
- if (XEN_XExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XExposeEvent(ptr))->height)));
- if (XEN_Screen_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_Screen(ptr))->height)));
- if (XEN_XpmImage_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmImage(ptr))->height)));
- if (XEN_XpmAttributes_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->height)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "height", "a struct with a height field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_width(XEN ptr)
-{
- if (XEN_XRectangle_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XRectangle(ptr))->width)));
- if (XEN_XArc_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XArc(ptr))->width)));
- if (XEN_XWindowChanges_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowChanges(ptr))->width)));
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XImage(ptr))->width)));
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XWindowAttributes(ptr))->width)));
- if (XEN_XCharStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCharStruct(ptr))->width)));
- if (XEN_XConfigureRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureRequestEvent(ptr))->width)));
- if (XEN_XResizeRequestEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XResizeRequestEvent(ptr))->width)));
- if (XEN_XConfigureEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XConfigureEvent(ptr))->width)));
- if (XEN_XCreateWindowEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XCreateWindowEvent(ptr))->width)));
- if (XEN_XGraphicsExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGraphicsExposeEvent(ptr))->width)));
- if (XEN_XExposeEvent_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XExposeEvent(ptr))->width)));
- if (XEN_Screen_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_Screen(ptr))->width)));
- if (XEN_XpmImage_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmImage(ptr))->width)));
- if (XEN_XpmAttributes_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XpmAttributes(ptr))->width)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "width", "a struct with a width field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_root(XEN ptr)
-{
- if (XEN_XWindowAttributes_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XWindowAttributes(ptr))->root)));
- if (XEN_XCrossingEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XCrossingEvent(ptr))->root)));
- if (XEN_XMotionEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XMotionEvent(ptr))->root)));
- if (XEN_XButtonEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XButtonEvent(ptr))->root)));
- if (XEN_XKeyEvent_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_XKeyEvent(ptr))->root)));
- if (XEN_Screen_P(ptr)) return(C_TO_XEN_Window((Window)((XEN_TO_C_Screen(ptr))->root)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "root", "a struct with a root field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_set_root(XEN ptr, XEN val)
+static Xen gxm_height(Xen ptr)
+{
+ if (Xen_is_XRectangle(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XRectangle(ptr))->height)));
+ if (Xen_is_XArc(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XArc(ptr))->height)));
+ if (Xen_is_XWindowChanges(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowChanges(ptr))->height)));
+ if (Xen_is_XImage(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->height)));
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->height)));
+ if (Xen_is_XConfigureRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureRequestEvent(ptr))->height)));
+ if (Xen_is_XResizeRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XResizeRequestEvent(ptr))->height)));
+ if (Xen_is_XConfigureEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureEvent(ptr))->height)));
+ if (Xen_is_XCreateWindowEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCreateWindowEvent(ptr))->height)));
+ if (Xen_is_XGraphicsExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGraphicsExposeEvent(ptr))->height)));
+ if (Xen_is_XExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XExposeEvent(ptr))->height)));
+ if (Xen_is_Screen(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_Screen(ptr))->height)));
+ if (Xen_is_XpmImage(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmImage(ptr))->height)));
+ if (Xen_is_XpmAttributes(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->height)));
+ XM_field_assert_type(0, ptr, 1, "height", "a struct with a height field");
+ return(Xen_false);
+}
+
+static Xen gxm_width(Xen ptr)
+{
+ if (Xen_is_XRectangle(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XRectangle(ptr))->width)));
+ if (Xen_is_XArc(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XArc(ptr))->width)));
+ if (Xen_is_XWindowChanges(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowChanges(ptr))->width)));
+ if (Xen_is_XImage(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XImage(ptr))->width)));
+ if (Xen_is_XWindowAttributes(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XWindowAttributes(ptr))->width)));
+ if (Xen_is_XCharStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCharStruct(ptr))->width)));
+ if (Xen_is_XConfigureRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureRequestEvent(ptr))->width)));
+ if (Xen_is_XResizeRequestEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XResizeRequestEvent(ptr))->width)));
+ if (Xen_is_XConfigureEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XConfigureEvent(ptr))->width)));
+ if (Xen_is_XCreateWindowEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XCreateWindowEvent(ptr))->width)));
+ if (Xen_is_XGraphicsExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGraphicsExposeEvent(ptr))->width)));
+ if (Xen_is_XExposeEvent(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XExposeEvent(ptr))->width)));
+ if (Xen_is_Screen(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_Screen(ptr))->width)));
+ if (Xen_is_XpmImage(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmImage(ptr))->width)));
+ if (Xen_is_XpmAttributes(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XpmAttributes(ptr))->width)));
+ XM_field_assert_type(0, ptr, 1, "width", "a struct with a width field");
+ return(Xen_false);
+}
+
+static Xen gxm_root(Xen ptr)
+{
+ if (Xen_is_XWindowAttributes(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XWindowAttributes(ptr))->root)));
+ if (Xen_is_XCrossingEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XCrossingEvent(ptr))->root)));
+ if (Xen_is_XMotionEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XMotionEvent(ptr))->root)));
+ if (Xen_is_XButtonEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XButtonEvent(ptr))->root)));
+ if (Xen_is_XKeyEvent(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_XKeyEvent(ptr))->root)));
+ if (Xen_is_Screen(ptr)) return(C_to_Xen_Window((Window)((Xen_to_C_Screen(ptr))->root)));
+ XM_field_assert_type(0, ptr, 1, "root", "a struct with a root field");
+ return(Xen_false);
+}
+
+static Xen gxm_set_root(Xen ptr, Xen val)
{
Window w;
- XM_SET_FIELD_ASSERT_TYPE(XEN_Window_P(val), val, XEN_ARG_2, "root", "a Window");
- w = XEN_TO_C_Window(val);
- if (XEN_XWindowAttributes_P(ptr)) (XEN_TO_C_XWindowAttributes(ptr))->root = w;
- else if (XEN_XCrossingEvent_P(ptr)) (XEN_TO_C_XCrossingEvent(ptr))->root = w;
- else if (XEN_XMotionEvent_P(ptr)) (XEN_TO_C_XMotionEvent(ptr))->root = w;
- else if (XEN_XButtonEvent_P(ptr)) (XEN_TO_C_XButtonEvent(ptr))->root = w;
- else if (XEN_XKeyEvent_P(ptr)) (XEN_TO_C_XKeyEvent(ptr))->root = w;
- else if (XEN_Screen_P(ptr)) (XEN_TO_C_Screen(ptr))->root = w;
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "root", "a struct with a root field");
+ XM_set_field_assert_type(Xen_is_Window(val), val, 2, "root", "a Window");
+ w = Xen_to_C_Window(val);
+ if (Xen_is_XWindowAttributes(ptr)) (Xen_to_C_XWindowAttributes(ptr))->root = w;
+ else if (Xen_is_XCrossingEvent(ptr)) (Xen_to_C_XCrossingEvent(ptr))->root = w;
+ else if (Xen_is_XMotionEvent(ptr)) (Xen_to_C_XMotionEvent(ptr))->root = w;
+ else if (Xen_is_XButtonEvent(ptr)) (Xen_to_C_XButtonEvent(ptr))->root = w;
+ else if (Xen_is_XKeyEvent(ptr)) (Xen_to_C_XKeyEvent(ptr))->root = w;
+ else if (Xen_is_Screen(ptr)) (Xen_to_C_Screen(ptr))->root = w;
+ else XM_set_field_assert_type(0, ptr, 1, "root", "a struct with a root field");
return(val);
}
-static XEN gxm_display(XEN ptr)
+static Xen gxm_display(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XEvent_P(ptr) || XEN_Screen_P(ptr), ptr, XEN_ONLY_ARG, "display", "XEvent or Screen");
- if (XEN_XEvent_P(ptr)) return(C_TO_XEN_Display((Display *)((XEN_TO_C_XAnyEvent(ptr))->display)));
- return(C_TO_XEN_Display((Display *)((XEN_TO_C_Screen(ptr))->display)));
+ XM_field_assert_type(Xen_is_XEvent(ptr) || Xen_is_Screen(ptr), ptr, 1, "display", "XEvent or Screen");
+ if (Xen_is_XEvent(ptr)) return(C_to_Xen_Display((Display *)((Xen_to_C_XAnyEvent(ptr))->display)));
+ return(C_to_Xen_Display((Display *)((Xen_to_C_Screen(ptr))->display)));
}
-static XEN gxm_set_display(XEN ptr, XEN val)
+static Xen gxm_set_display(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Display_P(val), val, XEN_ARG_2, "display", "a Display*");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XEvent_P(ptr), ptr, XEN_ARG_1, "display", "XEvent");
- (XEN_TO_C_XAnyEvent(ptr))->display = XEN_TO_C_Display(val);
+ XM_set_field_assert_type(Xen_is_Display(val), val, 2, "display", "a Display*");
+ XM_set_field_assert_type(Xen_is_XEvent(ptr), ptr, 1, "display", "XEvent");
+ (Xen_to_C_XAnyEvent(ptr))->display = Xen_to_C_Display(val);
return(val);
}
-static XEN gxm_function(XEN ptr)
+static Xen gxm_function(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->function)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "function", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->function)));
+ XM_field_assert_type(0, ptr, 1, "function", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_function(XEN ptr, XEN val)
+static Xen gxm_set_function(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "function", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "function", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->function = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "function", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "function", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->function = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_plane_mask(XEN ptr)
+static Xen gxm_plane_mask(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ONLY_ARG, "plane_mask", "XGCValues");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XGCValues(ptr))->plane_mask)));
+ XM_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "plane_mask", "XGCValues");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XGCValues(ptr))->plane_mask)));
}
-static XEN gxm_set_plane_mask(XEN ptr, XEN val)
+static Xen gxm_set_plane_mask(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "plane_mask", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->plane_mask = XEN_TO_C_ULONG(val);
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "plane_mask", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->plane_mask = Xen_ulong_to_C_ulong(val);
return(val);
}
-static XEN gxm_foreground(XEN ptr)
+static Xen gxm_foreground(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_Pixel((Pixel)((XEN_TO_C_XGCValues(ptr))->foreground)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "foreground", "a struct with a foreground field");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_to_Xen_Pixel((Pixel)((Xen_to_C_XGCValues(ptr))->foreground)));
+ XM_field_assert_type(0, ptr, 1, "foreground", "a struct with a foreground field");
+ return(Xen_false);
}
-static XEN gxm_set_foreground(XEN ptr, XEN val)
+static Xen gxm_set_foreground(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Pixel_P(val), val, XEN_ARG_2, "foreground", "a Pixel");
- XM_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "foreground", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->foreground = XEN_TO_C_Pixel(val);
+ XM_set_field_assert_type(Xen_is_Pixel(val), val, 2, "foreground", "a Pixel");
+ XM_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "foreground", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->foreground = Xen_to_C_Pixel(val);
return(val);
}
-static XEN gxm_background(XEN ptr)
+static Xen gxm_background(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_Pixel((Pixel)((XEN_TO_C_XGCValues(ptr))->background)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "background", "a struct with a background field");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_to_Xen_Pixel((Pixel)((Xen_to_C_XGCValues(ptr))->background)));
+ XM_field_assert_type(0, ptr, 1, "background", "a struct with a background field");
+ return(Xen_false);
}
-static XEN gxm_set_background(XEN ptr, XEN val)
+static Xen gxm_set_background(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Pixel_P(val), val, XEN_ARG_2, "background", "a Pixel");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "background", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->background = XEN_TO_C_Pixel(val);
+ XM_set_field_assert_type(Xen_is_Pixel(val), val, 2, "background", "a Pixel");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "background", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->background = Xen_to_C_Pixel(val);
return(val);
}
-static XEN gxm_line_width(XEN ptr)
+static Xen gxm_line_width(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->line_width)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "line_width", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->line_width)));
+ XM_field_assert_type(0, ptr, 1, "line_width", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_line_width(XEN ptr, XEN val)
+static Xen gxm_set_line_width(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "line_width", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "line_width", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->line_width = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "line_width", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "line_width", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->line_width = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_line_style(XEN ptr)
+static Xen gxm_line_style(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->line_style)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "line_style", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->line_style)));
+ XM_field_assert_type(0, ptr, 1, "line_style", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_line_style(XEN ptr, XEN val)
+static Xen gxm_set_line_style(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "line_style", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "line_style", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->line_style = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "line_style", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "line_style", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->line_style = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_cap_style(XEN ptr)
+static Xen gxm_cap_style(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->cap_style)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "cap_style", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->cap_style)));
+ XM_field_assert_type(0, ptr, 1, "cap_style", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_cap_style(XEN ptr, XEN val)
+static Xen gxm_set_cap_style(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "cap_style", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "cap_style", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->cap_style = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "cap_style", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "cap_style", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->cap_style = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_join_style(XEN ptr)
+static Xen gxm_join_style(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->join_style)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "join_style", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->join_style)));
+ XM_field_assert_type(0, ptr, 1, "join_style", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_join_style(XEN ptr, XEN val)
+static Xen gxm_set_join_style(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "join_style", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "join_style", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->join_style = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "join_style", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "join_style", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->join_style = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_fill_style(XEN ptr)
+static Xen gxm_fill_style(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ONLY_ARG, "fill_style", "XGCValues");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->fill_style)));
+ XM_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "fill_style", "XGCValues");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->fill_style)));
}
-static XEN gxm_set_fill_style(XEN ptr, XEN val)
+static Xen gxm_set_fill_style(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "fill_style", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "fill_style", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->fill_style = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "fill_style", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "fill_style", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->fill_style = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_fill_rule(XEN ptr)
+static Xen gxm_fill_rule(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ONLY_ARG, "fill_rule", "XGCValues");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->fill_rule)));
+ XM_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "fill_rule", "XGCValues");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->fill_rule)));
}
-static XEN gxm_set_fill_rule(XEN ptr, XEN val)
+static Xen gxm_set_fill_rule(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "fill_rule", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "fill_rule", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->fill_rule = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "fill_rule", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "fill_rule", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->fill_rule = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_arc_mode(XEN ptr)
+static Xen gxm_arc_mode(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ONLY_ARG, "arc_mode", "XGCValues");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->arc_mode)));
+ XM_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "arc_mode", "XGCValues");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->arc_mode)));
}
-static XEN gxm_set_arc_mode(XEN ptr, XEN val)
+static Xen gxm_set_arc_mode(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "arc_mode", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "arc_mode", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->arc_mode = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "arc_mode", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "arc_mode", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->arc_mode = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_tile(XEN ptr)
+static Xen gxm_tile(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_Pixmap((Pixmap)((XEN_TO_C_XGCValues(ptr))->tile)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "tile", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_to_Xen_Pixmap((Pixmap)((Xen_to_C_XGCValues(ptr))->tile)));
+ XM_field_assert_type(0, ptr, 1, "tile", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_tile(XEN ptr, XEN val)
+static Xen gxm_set_tile(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Pixmap_P(val), val, XEN_ARG_2, "tile", "a Pixmap");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "tile", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->tile = XEN_TO_C_Pixmap(val);
+ XM_set_field_assert_type(Xen_is_Pixmap(val), val, 2, "tile", "a Pixmap");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "tile", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->tile = Xen_to_C_Pixmap(val);
return(val);
}
-static XEN gxm_stipple(XEN ptr)
+static Xen gxm_stipple(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_Pixmap((Pixmap)((XEN_TO_C_XGCValues(ptr))->stipple)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "stipple", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_to_Xen_Pixmap((Pixmap)((Xen_to_C_XGCValues(ptr))->stipple)));
+ XM_field_assert_type(0, ptr, 1, "stipple", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_stipple(XEN ptr, XEN val)
+static Xen gxm_set_stipple(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Pixmap_P(val), val, XEN_ARG_2, "stipple", "a Pixmap");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "stipple", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->stipple = XEN_TO_C_Pixmap(val);
+ XM_set_field_assert_type(Xen_is_Pixmap(val), val, 2, "stipple", "a Pixmap");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "stipple", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->stipple = Xen_to_C_Pixmap(val);
return(val);
}
-static XEN gxm_ts_x_origin(XEN ptr)
+static Xen gxm_ts_x_origin(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->ts_x_origin)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "ts_x_origin", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->ts_x_origin)));
+ XM_field_assert_type(0, ptr, 1, "ts_x_origin", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_ts_x_origin(XEN ptr, XEN val)
+static Xen gxm_set_ts_x_origin(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "ts_x_origin", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "ts_x_origin", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->ts_x_origin = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "ts_x_origin", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "ts_x_origin", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->ts_x_origin = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_ts_y_origin(XEN ptr)
+static Xen gxm_ts_y_origin(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->ts_y_origin)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "ts_y_origin", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->ts_y_origin)));
+ XM_field_assert_type(0, ptr, 1, "ts_y_origin", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_ts_y_origin(XEN ptr, XEN val)
+static Xen gxm_set_ts_y_origin(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "ts_y_origin", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "ts_y_origin", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->ts_y_origin = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "ts_y_origin", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "ts_y_origin", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->ts_y_origin = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_font(XEN ptr)
+static Xen gxm_font(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_Font((Font)((XEN_TO_C_XGCValues(ptr))->font)));
- if (XEN_XTextItem_P(ptr)) return(C_TO_XEN_Font((Font)((XEN_TO_C_XTextItem(ptr))->font)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "font", "a struct with a font field");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_to_Xen_Font((Font)((Xen_to_C_XGCValues(ptr))->font)));
+ if (Xen_is_XTextItem(ptr)) return(C_to_Xen_Font((Font)((Xen_to_C_XTextItem(ptr))->font)));
+ XM_field_assert_type(0, ptr, 1, "font", "a struct with a font field");
+ return(Xen_false);
}
-static XEN gxm_set_font(XEN ptr, XEN val)
+static Xen gxm_set_font(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Font_P(val), val, XEN_ARG_2, "font", "a font");
- if (XEN_XGCValues_P(ptr)) (XEN_TO_C_XGCValues(ptr))->font = XEN_TO_C_Font(val);
- else if (XEN_XTextItem_P(ptr)) (XEN_TO_C_XTextItem(ptr))->font = XEN_TO_C_Font(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "font", "a struct with a font field");
+ XM_set_field_assert_type(Xen_is_Font(val), val, 2, "font", "a font");
+ if (Xen_is_XGCValues(ptr)) (Xen_to_C_XGCValues(ptr))->font = Xen_to_C_Font(val);
+ else if (Xen_is_XTextItem(ptr)) (Xen_to_C_XTextItem(ptr))->font = Xen_to_C_Font(val);
+ else XM_set_field_assert_type(0, ptr, 1, "font", "a struct with a font field");
return(val);
}
-static XEN gxm_subwindow_mode(XEN ptr)
+static Xen gxm_subwindow_mode(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->subwindow_mode)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "subwindow_mode", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->subwindow_mode)));
+ XM_field_assert_type(0, ptr, 1, "subwindow_mode", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_subwindow_mode(XEN ptr, XEN val)
+static Xen gxm_set_subwindow_mode(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "subwindow_mode", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "subwindow_mode", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->subwindow_mode = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "subwindow_mode", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "subwindow_mode", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->subwindow_mode = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_graphics_exposures(XEN ptr)
+static Xen gxm_graphics_exposures(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_BOOLEAN((Bool)((XEN_TO_C_XGCValues(ptr))->graphics_exposures)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "graphics_exposures", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_bool_to_Xen_boolean((Bool)((Xen_to_C_XGCValues(ptr))->graphics_exposures)));
+ XM_field_assert_type(0, ptr, 1, "graphics_exposures", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_graphics_exposures(XEN ptr, XEN val)
+static Xen gxm_set_graphics_exposures(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "graphics_exposures", "a boolean");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "graphics_exposure", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->graphics_exposures = XEN_TO_C_BOOLEAN(val);
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "graphics_exposures", "a boolean");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "graphics_exposure", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->graphics_exposures = Xen_boolean_to_C_bool(val);
return(val);
}
-static XEN gxm_clip_x_origin(XEN ptr)
+static Xen gxm_clip_x_origin(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->clip_x_origin)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "clip_x_origin", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->clip_x_origin)));
+ XM_field_assert_type(0, ptr, 1, "clip_x_origin", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_clip_x_origin(XEN ptr, XEN val)
+static Xen gxm_set_clip_x_origin(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "clip_x_origin", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "clip_x_origin", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->clip_x_origin = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "clip_x_origin", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "clip_x_origin", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->clip_x_origin = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_clip_y_origin(XEN ptr)
+static Xen gxm_clip_y_origin(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->clip_y_origin)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "clip_y_origin", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->clip_y_origin)));
+ XM_field_assert_type(0, ptr, 1, "clip_y_origin", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_clip_y_origin(XEN ptr, XEN val)
+static Xen gxm_set_clip_y_origin(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "clip_y_origin", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "clip_y_origin", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->clip_y_origin = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "clip_y_origin", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "clip_y_origin", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->clip_y_origin = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_clip_mask(XEN ptr)
+static Xen gxm_clip_mask(Xen ptr)
{
- if (XEN_XGCValues_P(ptr)) return(C_TO_XEN_Pixmap((Pixmap)((XEN_TO_C_XGCValues(ptr))->clip_mask)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "clip_mask", "XGCValues");
- return(XEN_FALSE);
+ if (Xen_is_XGCValues(ptr)) return(C_to_Xen_Pixmap((Pixmap)((Xen_to_C_XGCValues(ptr))->clip_mask)));
+ XM_field_assert_type(0, ptr, 1, "clip_mask", "XGCValues");
+ return(Xen_false);
}
-static XEN gxm_set_clip_mask(XEN ptr, XEN val)
+static Xen gxm_set_clip_mask(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Pixmap_P(val), val, XEN_ARG_2, "clip_mask", "a Pixmap");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "clip_mask", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->clip_mask = XEN_TO_C_Pixmap(val);
+ XM_set_field_assert_type(Xen_is_Pixmap(val), val, 2, "clip_mask", "a Pixmap");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "clip_mask", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->clip_mask = Xen_to_C_Pixmap(val);
return(val);
}
-static XEN gxm_dash_offset(XEN ptr)
+static Xen gxm_dash_offset(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ONLY_ARG, "dash_offset", "XGCValues");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XGCValues(ptr))->dash_offset)));
+ XM_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "dash_offset", "XGCValues");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XGCValues(ptr))->dash_offset)));
}
-static XEN gxm_set_dash_offset(XEN ptr, XEN val)
+static Xen gxm_set_dash_offset(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "dash_offset", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "dash_offset", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->dash_offset = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "dash_offset", "an integer");
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "dash_offset", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->dash_offset = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_dashes(XEN ptr)
+static Xen gxm_dashes(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ONLY_ARG, "dashes", "XGCValues");
- return(C_TO_XEN_char((char)((XEN_TO_C_XGCValues(ptr))->dashes)));
+ XM_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "dashes", "XGCValues");
+ return(C_int_to_Xen_integer((char)((Xen_to_C_XGCValues(ptr))->dashes)));
}
-static XEN gxm_set_dashes(XEN ptr, XEN val)
+static Xen gxm_set_dashes(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XGCValues_P(ptr), ptr, XEN_ARG_1, "dashes", "XGCValues");
- (XEN_TO_C_XGCValues(ptr))->dashes = XEN_TO_C_char(val);
+ XM_set_field_assert_type(Xen_is_XGCValues(ptr), ptr, 1, "dashes", "XGCValues");
+ (Xen_to_C_XGCValues(ptr))->dashes = (char)Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_killid(XEN ptr)
+static Xen gxm_killid(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XStandardColormap_P(ptr), ptr, XEN_ONLY_ARG, "killid", "XStandardColormap");
- return(C_TO_XEN_INT((long)((XEN_TO_C_XStandardColormap(ptr))->killid)));
+ XM_field_assert_type(Xen_is_XStandardColormap(ptr), ptr, 1, "killid", "XStandardColormap");
+ return(C_int_to_Xen_integer((long)((Xen_to_C_XStandardColormap(ptr))->killid)));
}
-static XEN gxm_base_pixel(XEN ptr)
+static Xen gxm_base_pixel(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XStandardColormap_P(ptr), ptr, XEN_ONLY_ARG, "base_pixel", "XStandardColormap");
- return(C_TO_XEN_Pixel((unsigned long)((XEN_TO_C_XStandardColormap(ptr))->base_pixel)));
+ XM_field_assert_type(Xen_is_XStandardColormap(ptr), ptr, 1, "base_pixel", "XStandardColormap");
+ return(C_to_Xen_Pixel((unsigned long)((Xen_to_C_XStandardColormap(ptr))->base_pixel)));
}
-static XEN gxm_blue_mult(XEN ptr)
+static Xen gxm_blue_mult(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XStandardColormap_P(ptr), ptr, XEN_ONLY_ARG, "blue_mult", "XStandardColormap");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XStandardColormap(ptr))->blue_mult)));
+ XM_field_assert_type(Xen_is_XStandardColormap(ptr), ptr, 1, "blue_mult", "XStandardColormap");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XStandardColormap(ptr))->blue_mult)));
}
-static XEN gxm_blue_max(XEN ptr)
+static Xen gxm_blue_max(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XStandardColormap_P(ptr), ptr, XEN_ONLY_ARG, "blue_max", "XStandardColormap");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XStandardColormap(ptr))->blue_max)));
+ XM_field_assert_type(Xen_is_XStandardColormap(ptr), ptr, 1, "blue_max", "XStandardColormap");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XStandardColormap(ptr))->blue_max)));
}
-static XEN gxm_green_mult(XEN ptr)
+static Xen gxm_green_mult(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XStandardColormap_P(ptr), ptr, XEN_ONLY_ARG, "green_mult", "XStandardColormap");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XStandardColormap(ptr))->green_mult)));
+ XM_field_assert_type(Xen_is_XStandardColormap(ptr), ptr, 1, "green_mult", "XStandardColormap");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XStandardColormap(ptr))->green_mult)));
}
-static XEN gxm_green_max(XEN ptr)
+static Xen gxm_green_max(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XStandardColormap_P(ptr), ptr, XEN_ONLY_ARG, "green_max", "XStandardColormap");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XStandardColormap(ptr))->green_max)));
+ XM_field_assert_type(Xen_is_XStandardColormap(ptr), ptr, 1, "green_max", "XStandardColormap");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XStandardColormap(ptr))->green_max)));
}
-static XEN gxm_red_mult(XEN ptr)
+static Xen gxm_red_mult(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XStandardColormap_P(ptr), ptr, XEN_ONLY_ARG, "red_mult", "XStandardColormap");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XStandardColormap(ptr))->red_mult)));
+ XM_field_assert_type(Xen_is_XStandardColormap(ptr), ptr, 1, "red_mult", "XStandardColormap");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XStandardColormap(ptr))->red_mult)));
}
-static XEN gxm_red_max(XEN ptr)
+static Xen gxm_red_max(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XStandardColormap_P(ptr), ptr, XEN_ONLY_ARG, "red_max", "XStandardColormap");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XStandardColormap(ptr))->red_max)));
+ XM_field_assert_type(Xen_is_XStandardColormap(ptr), ptr, 1, "red_max", "XStandardColormap");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XStandardColormap(ptr))->red_max)));
}
-static XEN gxm_XTextItem(XEN chars, XEN nchars, XEN delta, XEN font)
+static Xen gxm_XTextItem(Xen chars, Xen nchars, Xen delta, Xen font)
{
XTextItem *r;
#define H_XTextItem "(XTextItem chars len delta font): new XTextItem struct"
- XEN_ASSERT_TYPE(XEN_STRING_P(chars), chars, 1, "XTextItem", "char*");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(nchars), nchars, 2, "XTextItem", "int");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(delta), delta, 3, "XTextItem", "int");
- XEN_ASSERT_TYPE(XEN_Font_P(font), font, 4, "XTextItem", "Font");
+ Xen_check_type(Xen_is_string(chars), chars, 1, "XTextItem", "char*");
+ Xen_check_type(Xen_is_integer(nchars), nchars, 2, "XTextItem", "int");
+ Xen_check_type(Xen_is_integer(delta), delta, 3, "XTextItem", "int");
+ Xen_check_type(Xen_is_Font(font), font, 4, "XTextItem", "Font");
r = (XTextItem *)calloc(1, sizeof(XTextItem));
- r->chars = (char *)XEN_TO_C_STRING(chars);
- r->nchars = XEN_TO_C_INT(nchars);
- r->delta = XEN_TO_C_INT(delta);
- r->font = XEN_TO_C_Font(font);
- return(WRAP_FOR_XEN_OBJ("XTextItem", (XTextItem *)r));
+ r->chars = (char *)Xen_string_to_C_string(chars);
+ r->nchars = Xen_integer_to_C_int(nchars);
+ r->delta = Xen_integer_to_C_int(delta);
+ r->font = Xen_to_C_Font(font);
+ return(wrap_for_Xen_obj("XTextItem", (XTextItem *)r));
}
-static XEN gxm_chars(XEN ptr)
+static Xen gxm_chars(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XTextItem_P(ptr), ptr, XEN_ONLY_ARG, "chars", "XTextItem");
- return(C_TO_XEN_STRING((char *)((XEN_TO_C_XTextItem(ptr))->chars)));
+ XM_field_assert_type(Xen_is_XTextItem(ptr), ptr, 1, "chars", "XTextItem");
+ return(C_string_to_Xen_string((char *)((Xen_to_C_XTextItem(ptr))->chars)));
}
-static XEN gxm_set_chars(XEN ptr, XEN val)
+static Xen gxm_set_chars(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ARG_2, "chars", "a string");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XTextItem_P(ptr), ptr, XEN_ARG_1, "chars", "XTextItem");
- (XEN_TO_C_XTextItem(ptr))->chars = xen_strdup(XEN_TO_C_STRING(val));
+ XM_set_field_assert_type(Xen_is_string(val), val, 2, "chars", "a string");
+ XM_set_field_assert_type(Xen_is_XTextItem(ptr), ptr, 1, "chars", "XTextItem");
+ (Xen_to_C_XTextItem(ptr))->chars = xen_strdup(Xen_string_to_C_string(val));
return(val);
}
-static XEN gxm_nchars(XEN ptr)
+static Xen gxm_nchars(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XTextItem_P(ptr), ptr, XEN_ONLY_ARG, "nchars", "XTextItem");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XTextItem(ptr))->nchars)));
+ XM_field_assert_type(Xen_is_XTextItem(ptr), ptr, 1, "nchars", "XTextItem");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XTextItem(ptr))->nchars)));
}
-static XEN gxm_set_nchars(XEN ptr, XEN val)
+static Xen gxm_set_nchars(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "nchars", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XTextItem_P(ptr), ptr, XEN_ARG_1, "nchars", "XTextItem");
- (XEN_TO_C_XTextItem(ptr))->nchars = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "nchars", "an integer");
+ XM_set_field_assert_type(Xen_is_XTextItem(ptr), ptr, 1, "nchars", "XTextItem");
+ (Xen_to_C_XTextItem(ptr))->nchars = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_delta(XEN ptr)
+static Xen gxm_delta(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XTextItem_P(ptr), ptr, XEN_ONLY_ARG, "delta", "XTextItem");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XTextItem(ptr))->delta)));
+ XM_field_assert_type(Xen_is_XTextItem(ptr), ptr, 1, "delta", "XTextItem");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XTextItem(ptr))->delta)));
}
-static XEN gxm_set_delta(XEN ptr, XEN val)
+static Xen gxm_set_delta(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "delta", "an integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XTextItem_P(ptr), ptr, XEN_ARG_1, "delta", "XTextItem");
- (XEN_TO_C_XTextItem(ptr))->delta = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "delta", "an integer");
+ XM_set_field_assert_type(Xen_is_XTextItem(ptr), ptr, 1, "delta", "XTextItem");
+ (Xen_to_C_XTextItem(ptr))->delta = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_data(XEN ptr)
+static Xen gxm_data(Xen ptr)
{
- if (XEN_XImage_P(ptr)) return(C_TO_XEN_STRING((char *)((XEN_TO_C_XImage(ptr))->data)));
- if (XEN_XClientMessageEvent_P(ptr)) return(C_TO_XEN_STRING((char *)((XEN_TO_C_XClientMessageEvent(ptr))->data.b)));
-#if HAVE_MOTIF
- if (XEN_XmRowColumnCallbackStruct_P(ptr)) return(C_TO_XEN_STRING((char *)((XEN_TO_C_XmRowColumnCallbackStruct(ptr))->data)));
-#endif
- if (XEN_XpmImage_P(ptr)) return(XEN_WRAP_C_POINTER((XEN_TO_C_XpmImage(ptr))->data));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "data", "XpmImage");
- return(XEN_FALSE);
+ if (Xen_is_XImage(ptr)) return(C_string_to_Xen_string((char *)((Xen_to_C_XImage(ptr))->data)));
+ if (Xen_is_XClientMessageEvent(ptr)) return(C_string_to_Xen_string((char *)((Xen_to_C_XClientMessageEvent(ptr))->data.b)));
+ if (Xen_is_XmRowColumnCallbackStruct(ptr)) return(C_string_to_Xen_string((char *)((Xen_to_C_XmRowColumnCallbackStruct(ptr))->data)));
+ if (Xen_is_XpmImage(ptr)) return(Xen_wrap_C_pointer((Xen_to_C_XpmImage(ptr))->data));
+ XM_field_assert_type(0, ptr, 1, "data", "XpmImage");
+ return(Xen_false);
}
-static XEN gxm_set_data(XEN ptr, XEN val)
+static Xen gxm_set_data(Xen ptr, Xen val)
{
- int i, len = 0;
char *str;
- XM_SET_FIELD_ASSERT_TYPE(XEN_STRING_P(val) || XEN_LIST_P(val), val, XEN_ARG_2, "data", "a string or a list of longs");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XClientMessageEvent_P(ptr), ptr, XEN_ARG_1, "data", "XClientMessageEvent");
- if (XEN_STRING_P(val))
+ XM_set_field_assert_type(Xen_is_string(val) || Xen_is_list(val), val, 2, "data", "a string or a list of longs");
+ XM_set_field_assert_type(Xen_is_XClientMessageEvent(ptr), ptr, 1, "data", "XClientMessageEvent");
+ if (Xen_is_string(val))
{
- str = (char *)XEN_TO_C_STRING(val);
+ int i, len = 0;
+ str = (char *)Xen_string_to_C_string(val);
if (str)
len = strlen(str);
if (len > 19) len = 19;
for (i = 0; i < len; i++)
- (XEN_TO_C_XClientMessageEvent(ptr))->data.b[i] = str[i];
+ (Xen_to_C_XClientMessageEvent(ptr))->data.b[i] = str[i];
}
else
{
int i, len;
- len = XEN_LIST_LENGTH(val);
+ len = Xen_list_length(val);
if (len > 5) len = 5; /* only room here for 5 ints */
for (i = 0; i < len; i++)
- (XEN_TO_C_XClientMessageEvent(ptr))->data.l[i] = XEN_TO_C_INT(XEN_LIST_REF(val, i));
+ (Xen_to_C_XClientMessageEvent(ptr))->data.l[i] = Xen_integer_to_C_int(Xen_list_ref(val, i));
}
return(val);
}
@@ -19711,5493 +19436,3684 @@ static XEN gxm_set_data(XEN ptr, XEN val)
/* -------------------------------------------------------------------------------- */
-#if HAVE_MOTIF
-static XEN gxm_text(XEN ptr)
+
+static Xen gxm_text(Xen ptr)
{
/* DIFF: TextVerifyCallbackStruct text field returns list (string format)
*/
XmTextBlock tb;
- if (XEN_XmTextVerifyCallbackStruct_P(ptr))
+ if (Xen_is_XmTextVerifyCallbackStruct(ptr))
{
- tb = (XmTextBlock)(XEN_TO_C_XmTextVerifyCallbackStruct(ptr))->text;
+ tb = (XmTextBlock)(Xen_to_C_XmTextVerifyCallbackStruct(ptr))->text;
if ((tb) && (tb->length > 0))
- return(XEN_LIST_2(C_TO_XEN_STRING(tb->ptr),
- C_TO_XEN_ULONG(tb->format)));
- return(XEN_FALSE);
+ return(Xen_list_2(C_string_to_Xen_string(tb->ptr),
+ C_ulong_to_Xen_ulong(tb->format)));
+ return(Xen_false);
}
-#if HAVE_XmCreateDataField
- else if (XEN_XmDataFieldCallbackStruct_P(ptr)) return(C_TO_XEN_STRING((XEN_TO_C_XmDataFieldCallbackStruct(ptr))->text));
-#endif
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "text", "an XmTextVerifyCallbackStruct");
- return(XEN_FALSE);
+ XM_field_assert_type(0, ptr, 1, "text", "an XmTextVerifyCallbackStruct");
+ return(Xen_false);
}
-#if HAVE_XmCreateDataField
-static XEN gxm_w(XEN ptr)
+static Xen gxm_endPos(Xen ptr)
{
- if (XEN_XmDataFieldCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmDataFieldCallbackStruct(ptr))->w)));
- return(XEN_FALSE);
+ XM_field_assert_type(Xen_is_XmTextVerifyCallbackStruct(ptr), ptr, 1, "endPos", "XmTextVerifyCallbackStruct");
+ return(C_int_to_Xen_integer((long)((Xen_to_C_XmTextVerifyCallbackStruct(ptr))->endPos)));
}
-static XEN gxm_accept(XEN ptr)
-{
- if (XEN_XmDataFieldCallbackStruct_P(ptr)) return(C_TO_XEN_BOOLEAN((XEN_TO_C_XmDataFieldCallbackStruct(ptr))->accept));
- return(XEN_FALSE);
-}
-#endif
-#if HAVE_XmCreateTabStack
-static XEN gxm_selected_child(XEN ptr)
-{
- if (XEN_XmTabStackCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((XEN_TO_C_XmTabStackCallbackStruct(ptr))->selected_child));
- return(XEN_FALSE);
-}
-#endif
-static XEN gxm_endPos(XEN ptr)
+static Xen gxm_startPos(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmTextVerifyCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "endPos", "XmTextVerifyCallbackStruct");
- return(C_TO_XEN_INT((long)((XEN_TO_C_XmTextVerifyCallbackStruct(ptr))->endPos)));
+ XM_field_assert_type(Xen_is_XmTextVerifyCallbackStruct(ptr), ptr, 1, "startPos", "XmTextVerifyCallbackStruct");
+ return(C_int_to_Xen_integer((long)((Xen_to_C_XmTextVerifyCallbackStruct(ptr))->startPos)));
}
-static XEN gxm_startPos(XEN ptr)
+static Xen gxm_newInsert(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmTextVerifyCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "startPos", "XmTextVerifyCallbackStruct");
- return(C_TO_XEN_INT((long)((XEN_TO_C_XmTextVerifyCallbackStruct(ptr))->startPos)));
+ XM_field_assert_type(Xen_is_XmTextVerifyCallbackStruct(ptr), ptr, 1, "newInsert", "XmTextVerifyCallbackStruct");
+ return(C_int_to_Xen_integer((long)((Xen_to_C_XmTextVerifyCallbackStruct(ptr))->newInsert)));
}
-static XEN gxm_newInsert(XEN ptr)
+static Xen gxm_currInsert(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmTextVerifyCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "newInsert", "XmTextVerifyCallbackStruct");
- return(C_TO_XEN_INT((long)((XEN_TO_C_XmTextVerifyCallbackStruct(ptr))->newInsert)));
+ XM_field_assert_type(Xen_is_XmTextVerifyCallbackStruct(ptr), ptr, 1, "currInsert", "XmTextVerifyCallbackStruct");
+ return(C_int_to_Xen_integer((long)((Xen_to_C_XmTextVerifyCallbackStruct(ptr))->currInsert)));
}
-static XEN gxm_currInsert(XEN ptr)
+static Xen gxm_crossed_boundary(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmTextVerifyCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "currInsert", "XmTextVerifyCallbackStruct");
- return(C_TO_XEN_INT((long)((XEN_TO_C_XmTextVerifyCallbackStruct(ptr))->currInsert)));
+ XM_field_assert_type(Xen_is_XmSpinBoxCallbackStruct(ptr), ptr, 1, "crossed_boundary", "XmSpinBoxCallbackStruct");
+ return(C_bool_to_Xen_boolean((Boolean)((Xen_to_C_XmSpinBoxCallbackStruct(ptr))->crossed_boundary)));
}
-static XEN gxm_crossed_boundary(XEN ptr)
+static Xen gxm_position(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmSpinBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "crossed_boundary", "XmSpinBoxCallbackStruct");
- return(C_TO_XEN_BOOLEAN((Boolean)((XEN_TO_C_XmSpinBoxCallbackStruct(ptr))->crossed_boundary)));
+ XM_field_assert_type(Xen_is_XmSpinBoxCallbackStruct(ptr), ptr, 1, "position", "XmSpinBoxCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmSpinBoxCallbackStruct(ptr))->position)));
}
-static XEN gxm_position(XEN ptr)
+static Xen gxm_tag(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmSpinBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "position", "XmSpinBoxCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmSpinBoxCallbackStruct(ptr))->position)));
+ XM_field_assert_type(Xen_is_XmDisplayCallbackStruct(ptr), ptr, 1, "tag", "XmDisplayCallbackStruct");
+ return(C_string_to_Xen_string((XmStringTag)((Xen_to_C_XmDisplayCallbackStruct(ptr))->tag)));
}
-static XEN gxm_tag(XEN ptr)
+static Xen gxm_render_table(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmDisplayCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "tag", "XmDisplayCallbackStruct");
- return(C_TO_XEN_STRING((XmStringTag)((XEN_TO_C_XmDisplayCallbackStruct(ptr))->tag)));
+ XM_field_assert_type(Xen_is_XmDisplayCallbackStruct(ptr), ptr, 1, "render_table", "XmDisplayCallbackStruct");
+ return(C_to_Xen_XmRenderTable((XmRenderTable)((Xen_to_C_XmDisplayCallbackStruct(ptr))->render_table)));
}
-static XEN gxm_render_table(XEN ptr)
+static Xen gxm_font_name(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmDisplayCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "render_table", "XmDisplayCallbackStruct");
- return(C_TO_XEN_XmRenderTable((XmRenderTable)((XEN_TO_C_XmDisplayCallbackStruct(ptr))->render_table)));
+ XM_field_assert_type(Xen_is_XmDisplayCallbackStruct(ptr), ptr, 1, "font_name", "XmDisplayCallbackStruct");
+ return(C_string_to_Xen_string((char *)((Xen_to_C_XmDisplayCallbackStruct(ptr))->font_name)));
}
-static XEN gxm_font_name(XEN ptr)
+static Xen gxm_rendition(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmDisplayCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "font_name", "XmDisplayCallbackStruct");
- return(C_TO_XEN_STRING((char *)((XEN_TO_C_XmDisplayCallbackStruct(ptr))->font_name)));
+ XM_field_assert_type(Xen_is_XmDisplayCallbackStruct(ptr), ptr, 1, "rendition", "XmDisplayCallbackStruct");
+ return(C_to_Xen_XmRendition((XmRendition)((Xen_to_C_XmDisplayCallbackStruct(ptr))->rendition)));
}
-static XEN gxm_rendition(XEN ptr)
+static Xen gxm_prev_page_widget(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmDisplayCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "rendition", "XmDisplayCallbackStruct");
- return(C_TO_XEN_XmRendition((XmRendition)((XEN_TO_C_XmDisplayCallbackStruct(ptr))->rendition)));
+ XM_field_assert_type(Xen_is_XmNotebookCallbackStruct(ptr), ptr, 1, "prev_page_widget", "XmNotebookCallbackStruct");
+ return(C_to_Xen_Widget((Widget)((Xen_to_C_XmNotebookCallbackStruct(ptr))->prev_page_widget)));
}
-static XEN gxm_prev_page_widget(XEN ptr)
+static Xen gxm_prev_page_number(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmNotebookCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "prev_page_widget", "XmNotebookCallbackStruct");
- return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmNotebookCallbackStruct(ptr))->prev_page_widget)));
+ XM_field_assert_type(Xen_is_XmNotebookCallbackStruct(ptr), ptr, 1, "prev_page_number", "XmNotebookCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmNotebookCallbackStruct(ptr))->prev_page_number)));
}
-static XEN gxm_prev_page_number(XEN ptr)
+static Xen gxm_new_outline_state(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmNotebookCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "prev_page_number", "XmNotebookCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmNotebookCallbackStruct(ptr))->prev_page_number)));
+ XM_field_assert_type(Xen_is_XmContainerOutlineCallbackStruct(ptr), ptr, 1, "new_outline_state", "XmContainerOutlineCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmContainerOutlineCallbackStruct(ptr))->new_outline_state)));
}
-static XEN gxm_new_outline_state(XEN ptr)
+static Xen gxm_postIt(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmContainerOutlineCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "new_outline_state", "XmContainerOutlineCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmContainerOutlineCallbackStruct(ptr))->new_outline_state)));
+ XM_field_assert_type(Xen_is_XmPopupHandlerCallbackStruct(ptr), ptr, 1, "postIt", "XmPopupHandlerCallbackStruct");
+ return(C_bool_to_Xen_boolean((Boolean)((Xen_to_C_XmPopupHandlerCallbackStruct(ptr))->postIt)));
}
-static XEN gxm_postIt(XEN ptr)
+static Xen gxm_menuToPost(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmPopupHandlerCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "postIt", "XmPopupHandlerCallbackStruct");
- return(C_TO_XEN_BOOLEAN((Boolean)((XEN_TO_C_XmPopupHandlerCallbackStruct(ptr))->postIt)));
+ XM_field_assert_type(Xen_is_XmPopupHandlerCallbackStruct(ptr), ptr, 1, "menuToPost", "XmPopupHandlerCallbackStruct");
+ return(C_to_Xen_Widget((Widget)((Xen_to_C_XmPopupHandlerCallbackStruct(ptr))->menuToPost)));
}
-static XEN gxm_menuToPost(XEN ptr)
+static Xen gxm_set_postIt(Xen ptr, Xen post)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmPopupHandlerCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "menuToPost", "XmPopupHandlerCallbackStruct");
- return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmPopupHandlerCallbackStruct(ptr))->menuToPost)));
-}
-
-static XEN gxm_set_postIt(XEN ptr, XEN post)
-{
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(post), post, XEN_ARG_2, "postIt", "a boolean");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XmPopupHandlerCallbackStruct_P(ptr), ptr, XEN_ARG_1, "postIt", "XmPopupHandler");
- (XEN_TO_C_XmPopupHandlerCallbackStruct(ptr))->postIt = XEN_TO_C_BOOLEAN(post);
+ XM_set_field_assert_type(Xen_is_boolean(post), post, 2, "postIt", "a boolean");
+ XM_set_field_assert_type(Xen_is_XmPopupHandlerCallbackStruct(ptr), ptr, 1, "postIt", "XmPopupHandler");
+ (Xen_to_C_XmPopupHandlerCallbackStruct(ptr))->postIt = Xen_boolean_to_C_bool(post);
return(post);
}
-static XEN gxm_set_menuToPost(XEN ptr, XEN menu)
+static Xen gxm_set_menuToPost(Xen ptr, Xen menu)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_Widget_P(menu), menu, XEN_ARG_2, "menuToPost", "a Widget");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XmPopupHandlerCallbackStruct_P(ptr), ptr, XEN_ARG_1, "menuToPost", "XmPopupHandler");
- (XEN_TO_C_XmPopupHandlerCallbackStruct(ptr))->menuToPost = (Widget)XEN_TO_C_Widget(menu);
+ XM_set_field_assert_type(Xen_is_Widget(menu), menu, 2, "menuToPost", "a Widget");
+ XM_set_field_assert_type(Xen_is_XmPopupHandlerCallbackStruct(ptr), ptr, 1, "menuToPost", "XmPopupHandler");
+ (Xen_to_C_XmPopupHandlerCallbackStruct(ptr))->menuToPost = (Widget)Xen_to_C_Widget(menu);
return(menu);
}
-static XEN gxm_pattern_length(XEN ptr)
+static Xen gxm_pattern_length(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmFileSelectionBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "pattern_length", "XmFileSelectionBoxCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->pattern_length)));
+ XM_field_assert_type(Xen_is_XmFileSelectionBoxCallbackStruct(ptr), ptr, 1, "pattern_length", "XmFileSelectionBoxCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->pattern_length)));
}
-static XEN gxm_pattern(XEN ptr)
+static Xen gxm_pattern(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmFileSelectionBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "pattern", "XmFileSelectionBoxCallbackStruct");
- return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->pattern)));
+ XM_field_assert_type(Xen_is_XmFileSelectionBoxCallbackStruct(ptr), ptr, 1, "pattern", "XmFileSelectionBoxCallbackStruct");
+ return(C_to_Xen_XmString((XmString)((Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->pattern)));
}
-static XEN gxm_dir_length(XEN ptr)
+static Xen gxm_dir_length(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmFileSelectionBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "dir_length", "XmFileSelectionBoxCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->dir_length)));
+ XM_field_assert_type(Xen_is_XmFileSelectionBoxCallbackStruct(ptr), ptr, 1, "dir_length", "XmFileSelectionBoxCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->dir_length)));
}
-static XEN gxm_dir(XEN ptr)
+static Xen gxm_dir(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmFileSelectionBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "dir", "XmFileSelectionBoxCallbackStruct");
- return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->dir)));
+ XM_field_assert_type(Xen_is_XmFileSelectionBoxCallbackStruct(ptr), ptr, 1, "dir", "XmFileSelectionBoxCallbackStruct");
+ return(C_to_Xen_XmString((XmString)((Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->dir)));
}
-static XEN gxm_mask_length(XEN ptr)
+static Xen gxm_mask_length(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmFileSelectionBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "mask_length", "XmFileSelectionBoxCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->mask_length)));
+ XM_field_assert_type(Xen_is_XmFileSelectionBoxCallbackStruct(ptr), ptr, 1, "mask_length", "XmFileSelectionBoxCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->mask_length)));
}
-static XEN gxm_mask(XEN ptr)
+static Xen gxm_mask(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmFileSelectionBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "mask", "XmFileSelectionBoxCallbackStruct");
- return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->mask)));
+ XM_field_assert_type(Xen_is_XmFileSelectionBoxCallbackStruct(ptr), ptr, 1, "mask", "XmFileSelectionBoxCallbackStruct");
+ return(C_to_Xen_XmString((XmString)((Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->mask)));
}
-static XEN gxm_auto_selection_type(XEN ptr)
+static Xen gxm_auto_selection_type(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmContainerSelectCallbackStruct_P(ptr) || XEN_XmListCallbackStruct_P(ptr),
- ptr, XEN_ONLY_ARG, "auto_selection_type", "a struct with an auto_selection_type field");
- if (XEN_XmContainerSelectCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmContainerSelectCallbackStruct(ptr))->auto_selection_type)));
- return(C_TO_XEN_char((char)((XEN_TO_C_XmListCallbackStruct(ptr))->auto_selection_type)));
+ XM_field_assert_type(Xen_is_XmContainerSelectCallbackStruct(ptr) || Xen_is_XmListCallbackStruct(ptr),
+ ptr, 1, "auto_selection_type", "a struct with an auto_selection_type field");
+ if (Xen_is_XmContainerSelectCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmContainerSelectCallbackStruct(ptr))->auto_selection_type)));
+ return(C_int_to_Xen_integer((char)((Xen_to_C_XmListCallbackStruct(ptr))->auto_selection_type)));
}
-static XEN gxm_selection_type(XEN ptr)
+static Xen gxm_selection_type(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmListCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "selection_type", "XmListCallbackStruct");
- return(C_TO_XEN_char((char)((XEN_TO_C_XmListCallbackStruct(ptr))->selection_type)));
+ XM_field_assert_type(Xen_is_XmListCallbackStruct(ptr), ptr, 1, "selection_type", "XmListCallbackStruct");
+ return(C_int_to_Xen_integer((char)((Xen_to_C_XmListCallbackStruct(ptr))->selection_type)));
}
-static XEN gxm_selected_item_positions(XEN ptr)
+static Xen gxm_selected_item_positions(Xen ptr)
{
/* DIFF: selected_item_positions is a list of ints
*/
- if (XEN_XmListCallbackStruct_P(ptr))
- return(C_TO_XEN_Ints((int *)((XEN_TO_C_XmListCallbackStruct(ptr))->selected_item_positions),
- ((int)((XEN_TO_C_XmListCallbackStruct(ptr))->selected_item_count))));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "selected_item_positions", "a struct with a selected_item_positions field");
- return(XEN_FALSE);
+ if (Xen_is_XmListCallbackStruct(ptr))
+ return(C_to_Xen_Ints((int *)((Xen_to_C_XmListCallbackStruct(ptr))->selected_item_positions),
+ ((int)((Xen_to_C_XmListCallbackStruct(ptr))->selected_item_count))));
+ XM_field_assert_type(0, ptr, 1, "selected_item_positions", "a struct with a selected_item_positions field");
+ return(Xen_false);
}
-static XEN gxm_selected_item_count(XEN ptr)
+static Xen gxm_selected_item_count(Xen ptr)
{
- if (XEN_XmContainerSelectCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmContainerSelectCallbackStruct(ptr))->selected_item_count)));
- if (XEN_XmListCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmListCallbackStruct(ptr))->selected_item_count)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "selected_item_count", "XmListCallbackStruct");
- return(XEN_FALSE);
+ if (Xen_is_XmContainerSelectCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmContainerSelectCallbackStruct(ptr))->selected_item_count)));
+ if (Xen_is_XmListCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmListCallbackStruct(ptr))->selected_item_count)));
+ XM_field_assert_type(0, ptr, 1, "selected_item_count", "XmListCallbackStruct");
+ return(Xen_false);
}
-static XEN gxm_selected_items(XEN ptr)
+static Xen gxm_selected_items(Xen ptr)
{
/* DIFF selected_items field returns list
*/
- if (XEN_XmContainerSelectCallbackStruct_P(ptr))
- return(C_TO_XEN_Widgets((WidgetList)((XEN_TO_C_XmContainerSelectCallbackStruct(ptr))->selected_items),
- (XEN_TO_C_XmContainerSelectCallbackStruct(ptr))->selected_item_count));
- if (XEN_XmListCallbackStruct_P(ptr))
- return(C_TO_XEN_XmStringTable((XmStringTable)((XEN_TO_C_XmListCallbackStruct(ptr))->selected_items),
- (XEN_TO_C_XmListCallbackStruct(ptr))->selected_item_count));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "selected_items", "a struct with a selected_items field");
- return(XEN_FALSE);
+ if (Xen_is_XmContainerSelectCallbackStruct(ptr))
+ return(C_to_Xen_Widgets((WidgetList)((Xen_to_C_XmContainerSelectCallbackStruct(ptr))->selected_items),
+ (Xen_to_C_XmContainerSelectCallbackStruct(ptr))->selected_item_count));
+ if (Xen_is_XmListCallbackStruct(ptr))
+ return(C_to_Xen_XmStringTable((XmStringTable)((Xen_to_C_XmListCallbackStruct(ptr))->selected_items),
+ (Xen_to_C_XmListCallbackStruct(ptr))->selected_item_count));
+ XM_field_assert_type(0, ptr, 1, "selected_items", "a struct with a selected_items field");
+ return(Xen_false);
}
-static XEN gxm_item_length(XEN ptr)
+static Xen gxm_item_length(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmListCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "item_length", "XmListCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmListCallbackStruct(ptr))->item_length)));
+ XM_field_assert_type(Xen_is_XmListCallbackStruct(ptr), ptr, 1, "item_length", "XmListCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmListCallbackStruct(ptr))->item_length)));
}
-static XEN gxm_item(XEN ptr)
+static Xen gxm_item(Xen ptr)
{
- if (XEN_XmContainerOutlineCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmContainerOutlineCallbackStruct(ptr))->item)));
- if (XEN_XmListCallbackStruct_P(ptr)) return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmListCallbackStruct(ptr))->item)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "item", "XmListCallbackStruct");
- return(XEN_FALSE);
+ if (Xen_is_XmContainerOutlineCallbackStruct(ptr)) return(C_to_Xen_Widget((Widget)((Xen_to_C_XmContainerOutlineCallbackStruct(ptr))->item)));
+ if (Xen_is_XmListCallbackStruct(ptr)) return(C_to_Xen_XmString((XmString)((Xen_to_C_XmListCallbackStruct(ptr))->item)));
+ XM_field_assert_type(0, ptr, 1, "item", "XmListCallbackStruct");
+ return(Xen_false);
}
/* in Motif 2, this field is an int: XmSET to XmINDETERMINATE -- should we change? */
-static XEN gxm_set(XEN ptr)
+static Xen gxm_set(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmToggleButtonCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "set", "XmToggleButtonCallbackStruct");
- return(C_TO_XEN_BOOLEAN((int)((XEN_TO_C_XmToggleButtonCallbackStruct(ptr))->set)));
+ XM_field_assert_type(Xen_is_XmToggleButtonCallbackStruct(ptr), ptr, 1, "set", "XmToggleButtonCallbackStruct");
+ return(C_bool_to_Xen_boolean((int)((Xen_to_C_XmToggleButtonCallbackStruct(ptr))->set)));
}
-static XEN gxm_set_set(XEN ptr, XEN val)
+static Xen gxm_set_set(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val) || XEN_INTEGER_P(val), val, XEN_ARG_2, "set", "a boolean");
- XM_SET_FIELD_ASSERT_TYPE(XEN_XmToggleButtonCallbackStruct_P(ptr), ptr, XEN_ARG_1, "set", "XmToggleButtonCallbackStruct");
- (XEN_TO_C_XmToggleButtonCallbackStruct(ptr))->set = XEN_TO_C_BOOLEAN(val);
+ XM_set_field_assert_type(Xen_is_boolean(val) || Xen_is_integer(val), val, 2, "set", "a boolean");
+ XM_set_field_assert_type(Xen_is_XmToggleButtonCallbackStruct(ptr), ptr, 1, "set", "XmToggleButtonCallbackStruct");
+ (Xen_to_C_XmToggleButtonCallbackStruct(ptr))->set = Xen_boolean_to_C_bool(val);
return(val);
}
-static XEN gxm_callbackstruct(XEN ptr)
+static Xen gxm_callbackstruct(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmRowColumnCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "callbackstruct", "XmRowColumnCallbackStruct");
- return(C_TO_XEN_STRING((char *)((XEN_TO_C_XmRowColumnCallbackStruct(ptr))->callbackstruct)));
+ XM_field_assert_type(Xen_is_XmRowColumnCallbackStruct(ptr), ptr, 1, "callbackstruct", "XmRowColumnCallbackStruct");
+ return(C_string_to_Xen_string((char *)((Xen_to_C_XmRowColumnCallbackStruct(ptr))->callbackstruct)));
}
-static XEN gxm_item_position(XEN ptr)
+static Xen gxm_item_position(Xen ptr)
{
- if (XEN_XmListCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmListCallbackStruct(ptr))->item_position)));
- if (XEN_XmComboBoxCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmComboBoxCallbackStruct(ptr))->item_position)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "item_position", "a struct with an item_position field");
- return(XEN_FALSE);
+ if (Xen_is_XmListCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmListCallbackStruct(ptr))->item_position)));
+ if (Xen_is_XmComboBoxCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmComboBoxCallbackStruct(ptr))->item_position)));
+ XM_field_assert_type(0, ptr, 1, "item_position", "a struct with an item_position field");
+ return(Xen_false);
}
-static XEN gxm_item_or_text(XEN ptr)
+static Xen gxm_item_or_text(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmComboBoxCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "item_or_text", "XmComboBoxCallbackStruct");
- return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmComboBoxCallbackStruct(ptr))->item_or_text)));
+ XM_field_assert_type(Xen_is_XmComboBoxCallbackStruct(ptr), ptr, 1, "item_or_text", "XmComboBoxCallbackStruct");
+ return(C_to_Xen_XmString((XmString)((Xen_to_C_XmComboBoxCallbackStruct(ptr))->item_or_text)));
}
-static XEN gxm_doit(XEN ptr)
+static Xen gxm_doit(Xen ptr)
{
- if (XEN_XmTextVerifyCallbackStruct_P(ptr)) return(C_TO_XEN_BOOLEAN((Boolean)((XEN_TO_C_XmTextVerifyCallbackStruct(ptr))->doit)));
- if (XEN_XmSpinBoxCallbackStruct_P(ptr)) return(C_TO_XEN_BOOLEAN((Boolean)((XEN_TO_C_XmSpinBoxCallbackStruct(ptr))->doit)));
- if (XEN_XmDragStartCallbackStruct_P(ptr)) return(C_TO_XEN_BOOLEAN((Boolean)((XEN_TO_C_XmDragStartCallbackStruct(ptr))->doit)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "doit", "a struct with a doit field");
- return(XEN_FALSE);
+ if (Xen_is_XmTextVerifyCallbackStruct(ptr)) return(C_bool_to_Xen_boolean((Boolean)((Xen_to_C_XmTextVerifyCallbackStruct(ptr))->doit)));
+ if (Xen_is_XmSpinBoxCallbackStruct(ptr)) return(C_bool_to_Xen_boolean((Boolean)((Xen_to_C_XmSpinBoxCallbackStruct(ptr))->doit)));
+ if (Xen_is_XmDragStartCallbackStruct(ptr)) return(C_bool_to_Xen_boolean((Boolean)((Xen_to_C_XmDragStartCallbackStruct(ptr))->doit)));
+ XM_field_assert_type(0, ptr, 1, "doit", "a struct with a doit field");
+ return(Xen_false);
}
-static XEN gxm_set_doit(XEN ptr, XEN val)
+static Xen gxm_set_doit(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_BOOLEAN_P(val), val, XEN_ARG_2, "doit", "a boolean");
- if (XEN_XmTextVerifyCallbackStruct_P(ptr)) (XEN_TO_C_XmTextVerifyCallbackStruct(ptr))->doit = XEN_TO_C_BOOLEAN(val);
- else if (XEN_XmSpinBoxCallbackStruct_P(ptr)) (XEN_TO_C_XmSpinBoxCallbackStruct(ptr))->doit = XEN_TO_C_BOOLEAN(val);
- else if (XEN_XmDragStartCallbackStruct_P(ptr)) (XEN_TO_C_XmDragStartCallbackStruct(ptr))->doit = XEN_TO_C_BOOLEAN(val);
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "doit", "a struct with a doit field");
+ XM_set_field_assert_type(Xen_is_boolean(val), val, 2, "doit", "a boolean");
+ if (Xen_is_XmTextVerifyCallbackStruct(ptr)) (Xen_to_C_XmTextVerifyCallbackStruct(ptr))->doit = Xen_boolean_to_C_bool(val);
+ else if (Xen_is_XmSpinBoxCallbackStruct(ptr)) (Xen_to_C_XmSpinBoxCallbackStruct(ptr))->doit = Xen_boolean_to_C_bool(val);
+ else if (Xen_is_XmDragStartCallbackStruct(ptr)) (Xen_to_C_XmDragStartCallbackStruct(ptr))->doit = Xen_boolean_to_C_bool(val);
+ else XM_set_field_assert_type(0, ptr, 1, "doit", "a struct with a doit field");
return(val);
}
-static XEN gxm_widget(XEN ptr)
+static Xen gxm_widget(Xen ptr)
{
- if (XEN_XmSpinBoxCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmSpinBoxCallbackStruct(ptr))->widget)));
- if (XEN_XmDragStartCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmDragStartCallbackStruct(ptr))->widget)));
- if (XEN_XmRowColumnCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmRowColumnCallbackStruct(ptr))->widget)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "widget", "a struct with a widget field");
- return(XEN_FALSE);
+ if (Xen_is_XmSpinBoxCallbackStruct(ptr)) return(C_to_Xen_Widget((Widget)((Xen_to_C_XmSpinBoxCallbackStruct(ptr))->widget)));
+ if (Xen_is_XmDragStartCallbackStruct(ptr)) return(C_to_Xen_Widget((Widget)((Xen_to_C_XmDragStartCallbackStruct(ptr))->widget)));
+ if (Xen_is_XmRowColumnCallbackStruct(ptr)) return(C_to_Xen_Widget((Widget)((Xen_to_C_XmRowColumnCallbackStruct(ptr))->widget)));
+ XM_field_assert_type(0, ptr, 1, "widget", "a struct with a widget field");
+ return(Xen_false);
}
-static XEN gxm_click_count(XEN ptr)
+static Xen gxm_click_count(Xen ptr)
{
- if (XEN_XmPushButtonCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmPushButtonCallbackStruct(ptr))->click_count)));
- if (XEN_XmDrawnButtonCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDrawnButtonCallbackStruct(ptr))->click_count)));
- if (XEN_XmArrowButtonCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmArrowButtonCallbackStruct(ptr))->click_count)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "click_count", "a struct with a click_count field");
- return(XEN_FALSE);
+ if (Xen_is_XmPushButtonCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmPushButtonCallbackStruct(ptr))->click_count)));
+ if (Xen_is_XmDrawnButtonCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDrawnButtonCallbackStruct(ptr))->click_count)));
+ if (Xen_is_XmArrowButtonCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmArrowButtonCallbackStruct(ptr))->click_count)));
+ XM_field_assert_type(0, ptr, 1, "click_count", "a struct with a click_count field");
+ return(Xen_false);
}
-static XEN gxm_set_click_count(XEN ptr, XEN val)
+static Xen gxm_set_click_count(Xen ptr, Xen val)
{
int count;
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "click_count", "int");
- count = XEN_TO_C_INT(val);
- if (XEN_XmPushButtonCallbackStruct_P(ptr)) (XEN_TO_C_XmPushButtonCallbackStruct(ptr))->click_count = count;
- else if (XEN_XmDrawnButtonCallbackStruct_P(ptr)) (XEN_TO_C_XmDrawnButtonCallbackStruct(ptr))->click_count = count;
- else if (XEN_XmArrowButtonCallbackStruct_P(ptr)) (XEN_TO_C_XmArrowButtonCallbackStruct(ptr))->click_count = count;
- else XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "click_count", "a struct with a click_count field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "click_count", "int");
+ count = Xen_integer_to_C_int(val);
+ if (Xen_is_XmPushButtonCallbackStruct(ptr)) (Xen_to_C_XmPushButtonCallbackStruct(ptr))->click_count = count;
+ else if (Xen_is_XmDrawnButtonCallbackStruct(ptr)) (Xen_to_C_XmDrawnButtonCallbackStruct(ptr))->click_count = count;
+ else if (Xen_is_XmArrowButtonCallbackStruct(ptr)) (Xen_to_C_XmArrowButtonCallbackStruct(ptr))->click_count = count;
+ else XM_set_field_assert_type(0, ptr, 1, "click_count", "a struct with a click_count field");
return(val);
}
-static XEN gxm_remaining(XEN ptr)
+static Xen gxm_remaining(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmSelectionCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "remaining", "XmSelectionCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmSelectionCallbackStruct(ptr))->remaining)));
+ XM_field_assert_type(Xen_is_XmSelectionCallbackStruct(ptr), ptr, 1, "remaining", "XmSelectionCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmSelectionCallbackStruct(ptr))->remaining)));
}
-static XEN gxm_destination_data(XEN ptr)
+static Xen gxm_destination_data(Xen ptr)
{
/* widget-class specific interpretation -- is it worth untangling? */
- XM_FIELD_ASSERT_TYPE(XEN_XmDestinationCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "destination_data", "XmDestinationCallbackStruct");
- return(XEN_WRAP_C_POINTER(((XEN_TO_C_XmDestinationCallbackStruct(ptr))->destination_data)));
+ XM_field_assert_type(Xen_is_XmDestinationCallbackStruct(ptr), ptr, 1, "destination_data", "XmDestinationCallbackStruct");
+ return(Xen_wrap_C_pointer(((Xen_to_C_XmDestinationCallbackStruct(ptr))->destination_data)));
}
-static XEN gxm_transfer_id(XEN ptr)
+static Xen gxm_transfer_id(Xen ptr)
{
- if (XEN_XmTransferDoneCallbackStruct_P(ptr)) return(XEN_WRAP_C_POINTER(((XEN_TO_C_XmTransferDoneCallbackStruct(ptr))->transfer_id)));
- if (XEN_XmSelectionCallbackStruct_P(ptr)) return(XEN_WRAP_C_POINTER(((XEN_TO_C_XmSelectionCallbackStruct(ptr))->transfer_id)));
- if (XEN_XmDestinationCallbackStruct_P(ptr)) return(XEN_WRAP_C_POINTER(((XEN_TO_C_XmDestinationCallbackStruct(ptr))->transfer_id)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "transfer_id", "a struct with a transfer_id field");
- return(XEN_FALSE);
+ if (Xen_is_XmTransferDoneCallbackStruct(ptr)) return(Xen_wrap_C_pointer(((Xen_to_C_XmTransferDoneCallbackStruct(ptr))->transfer_id)));
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) return(Xen_wrap_C_pointer(((Xen_to_C_XmSelectionCallbackStruct(ptr))->transfer_id)));
+ if (Xen_is_XmDestinationCallbackStruct(ptr)) return(Xen_wrap_C_pointer(((Xen_to_C_XmDestinationCallbackStruct(ptr))->transfer_id)));
+ XM_field_assert_type(0, ptr, 1, "transfer_id", "a struct with a transfer_id field");
+ return(Xen_false);
}
-static XEN gxm_length(XEN ptr)
+static Xen gxm_length(Xen ptr)
{
- if (XEN_XmFileSelectionBoxCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->length)));
- if (XEN_XmCommandCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmCommandCallbackStruct(ptr))->length)));
- if (XEN_XmTextBlock_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmTextBlock(ptr))->length)));
- if (XEN_XmSelectionBoxCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmSelectionBoxCallbackStruct(ptr))->length)));
- if (XEN_XmSelectionCallbackStruct_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XmSelectionCallbackStruct(ptr))->length)));
- if (XEN_XmConvertCallbackStruct_P(ptr)) return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XmConvertCallbackStruct(ptr))->length)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "length", "a struct with a length field");
- return(XEN_FALSE);
+ if (Xen_is_XmFileSelectionBoxCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->length)));
+ if (Xen_is_XmCommandCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmCommandCallbackStruct(ptr))->length)));
+ if (Xen_is_XmTextBlock(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmTextBlock(ptr))->length)));
+ if (Xen_is_XmSelectionBoxCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmSelectionBoxCallbackStruct(ptr))->length)));
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XmSelectionCallbackStruct(ptr))->length)));
+ if (Xen_is_XmConvertCallbackStruct(ptr)) return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XmConvertCallbackStruct(ptr))->length)));
+ XM_field_assert_type(0, ptr, 1, "length", "a struct with a length field");
+ return(Xen_false);
}
-static XEN gxm_set_length(XEN ptr, XEN val)
+static Xen gxm_set_length(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XmTextBlock_P(ptr), ptr, XEN_ARG_1, "length", "XmTextBlock");
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "length", "int");
- (XEN_TO_C_XmTextBlock(ptr))->length = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_XmTextBlock(ptr), ptr, 1, "length", "XmTextBlock");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "length", "int");
+ (Xen_to_C_XmTextBlock(ptr))->length = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_ptr(XEN ptr)
+static Xen gxm_ptr(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmTextBlock_P(ptr), ptr, XEN_ARG_1, "ptr", "XmTextBlock");
- return(C_TO_XEN_STRING((XEN_TO_C_XmTextBlock(ptr))->ptr));
+ XM_field_assert_type(Xen_is_XmTextBlock(ptr), ptr, 1, "ptr", "XmTextBlock");
+ return(C_string_to_Xen_string((Xen_to_C_XmTextBlock(ptr))->ptr));
}
-static XEN gxm_set_ptr(XEN pt, XEN val)
+static Xen gxm_set_ptr(Xen pt, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_XmTextBlock_P(pt), pt, XEN_ARG_1, "ptr", "XmTextBlock");
- XM_SET_FIELD_ASSERT_TYPE(XEN_STRING_P(val), val, XEN_ARG_2, "length", "char*");
- (XEN_TO_C_XmTextBlock(pt))->ptr = xen_strdup(XEN_TO_C_STRING(val));
+ XM_set_field_assert_type(Xen_is_XmTextBlock(pt), pt, 1, "ptr", "XmTextBlock");
+ XM_set_field_assert_type(Xen_is_string(val), val, 2, "length", "char*");
+ (Xen_to_C_XmTextBlock(pt))->ptr = xen_strdup(Xen_string_to_C_string(val));
return(val);
}
-static XEN gxm_value(XEN ptr)
-{
- if (XEN_XmSpinBoxCallbackStruct_P(ptr)) return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmSpinBoxCallbackStruct(ptr))->value)));
- if (XEN_XmSelectionBoxCallbackStruct_P(ptr)) return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmSelectionBoxCallbackStruct(ptr))->value)));
- if (XEN_XmConvertCallbackStruct_P(ptr)) return(XEN_WRAP_C_POINTER((XtPointer)((XEN_TO_C_XmConvertCallbackStruct(ptr))->value)));
- if (XEN_XmSelectionCallbackStruct_P(ptr)) return(XEN_WRAP_C_POINTER((XtPointer)((XEN_TO_C_XmSelectionCallbackStruct(ptr))->value)));
- if (XEN_XmScaleCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmScaleCallbackStruct(ptr))->value)));
- if (XEN_XmFileSelectionBoxCallbackStruct_P(ptr)) return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->value)));
- if (XEN_XmCommandCallbackStruct_P(ptr)) return(C_TO_XEN_XmString((XmString)((XEN_TO_C_XmCommandCallbackStruct(ptr))->value)));
- if (XEN_XmScrollBarCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmScrollBarCallbackStruct(ptr))->value)));
- if (XEN_XpmColorSymbol_P(ptr)) return(C_TO_XEN_STRING((char *)((XEN_TO_C_XpmColorSymbol(ptr))->value)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "value", "a struct with a value field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_set_value(XEN ptr, XEN val)
-{
-#if HAVE_MOTIF
- if (XEN_XmScaleCallbackStruct_P(ptr)) (XEN_TO_C_XmScaleCallbackStruct(ptr))->value = XEN_TO_C_INT(val); else
- if (XEN_XmFileSelectionBoxCallbackStruct_P(ptr)) (XEN_TO_C_XmFileSelectionBoxCallbackStruct(ptr))->value = XEN_TO_C_XmString(val); else
- if (XEN_XmCommandCallbackStruct_P(ptr)) (XEN_TO_C_XmCommandCallbackStruct(ptr))->value = XEN_TO_C_XmString(val); else
- if (XEN_XmScrollBarCallbackStruct_P(ptr)) (XEN_TO_C_XmScrollBarCallbackStruct(ptr))->value = XEN_TO_C_INT(val); else
- if (XEN_XmConvertCallbackStruct_P(ptr)) (XEN_TO_C_XmConvertCallbackStruct(ptr))->value = (XtPointer)XEN_UNWRAP_C_POINTER(val); else
- if (XEN_XmSpinBoxCallbackStruct_P(ptr)) (XEN_TO_C_XmSpinBoxCallbackStruct(ptr))->value = XEN_TO_C_XmString(val); else
- if (XEN_XmSelectionBoxCallbackStruct_P(ptr)) (XEN_TO_C_XmSelectionBoxCallbackStruct(ptr))->value = XEN_TO_C_XmString(val); else
- if (XEN_XmSelectionCallbackStruct_P(ptr)) (XEN_TO_C_XmSelectionCallbackStruct(ptr))->value = (XtPointer)XEN_UNWRAP_C_POINTER(val); else
-#endif
- if (XEN_XpmColorSymbol_P(ptr)) (XEN_TO_C_XpmColorSymbol(ptr))->value = xen_strdup(XEN_TO_C_STRING(val)); else
- XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "value", "a struct with a value field");
+static Xen gxm_value(Xen ptr)
+{
+ if (Xen_is_XmSpinBoxCallbackStruct(ptr)) return(C_to_Xen_XmString((XmString)((Xen_to_C_XmSpinBoxCallbackStruct(ptr))->value)));
+ if (Xen_is_XmSelectionBoxCallbackStruct(ptr)) return(C_to_Xen_XmString((XmString)((Xen_to_C_XmSelectionBoxCallbackStruct(ptr))->value)));
+ if (Xen_is_XmConvertCallbackStruct(ptr)) return(Xen_wrap_C_pointer((XtPointer)((Xen_to_C_XmConvertCallbackStruct(ptr))->value)));
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) return(Xen_wrap_C_pointer((XtPointer)((Xen_to_C_XmSelectionCallbackStruct(ptr))->value)));
+ if (Xen_is_XmScaleCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmScaleCallbackStruct(ptr))->value)));
+ if (Xen_is_XmFileSelectionBoxCallbackStruct(ptr)) return(C_to_Xen_XmString((XmString)((Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->value)));
+ if (Xen_is_XmCommandCallbackStruct(ptr)) return(C_to_Xen_XmString((XmString)((Xen_to_C_XmCommandCallbackStruct(ptr))->value)));
+ if (Xen_is_XmScrollBarCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmScrollBarCallbackStruct(ptr))->value)));
+ if (Xen_is_XpmColorSymbol(ptr)) return(C_string_to_Xen_string((char *)((Xen_to_C_XpmColorSymbol(ptr))->value)));
+ XM_field_assert_type(0, ptr, 1, "value", "a struct with a value field");
+ return(Xen_false);
+}
+
+static Xen gxm_set_value(Xen ptr, Xen val)
+{
+ if (Xen_is_XmScaleCallbackStruct(ptr)) (Xen_to_C_XmScaleCallbackStruct(ptr))->value = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmFileSelectionBoxCallbackStruct(ptr)) (Xen_to_C_XmFileSelectionBoxCallbackStruct(ptr))->value = Xen_to_C_XmString(val); else
+ if (Xen_is_XmCommandCallbackStruct(ptr)) (Xen_to_C_XmCommandCallbackStruct(ptr))->value = Xen_to_C_XmString(val); else
+ if (Xen_is_XmScrollBarCallbackStruct(ptr)) (Xen_to_C_XmScrollBarCallbackStruct(ptr))->value = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmConvertCallbackStruct(ptr)) (Xen_to_C_XmConvertCallbackStruct(ptr))->value = (XtPointer)Xen_unwrap_C_pointer(val); else
+ if (Xen_is_XmSpinBoxCallbackStruct(ptr)) (Xen_to_C_XmSpinBoxCallbackStruct(ptr))->value = Xen_to_C_XmString(val); else
+ if (Xen_is_XmSelectionBoxCallbackStruct(ptr)) (Xen_to_C_XmSelectionBoxCallbackStruct(ptr))->value = Xen_to_C_XmString(val); else
+ if (Xen_is_XmSelectionCallbackStruct(ptr)) (Xen_to_C_XmSelectionCallbackStruct(ptr))->value = (XtPointer)Xen_unwrap_C_pointer(val); else
+ if (Xen_is_XpmColorSymbol(ptr)) (Xen_to_C_XpmColorSymbol(ptr))->value = xen_strdup(Xen_string_to_C_string(val)); else
+ XM_set_field_assert_type(0, ptr, 1, "value", "a struct with a value field");
return(val);
}
-static XEN gxm_status(XEN ptr)
+static Xen gxm_status(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmTransferDoneCallbackStruct_P(ptr) || XEN_XmConvertCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "status", "a struct with a status field");
- if (XEN_XmTransferDoneCallbackStruct_P(ptr)) return(C_TO_XEN_INT((XmTransferStatus)((XEN_TO_C_XmTransferDoneCallbackStruct(ptr))->status)));
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmConvertCallbackStruct(ptr))->status)));
+ XM_field_assert_type(Xen_is_XmTransferDoneCallbackStruct(ptr) || Xen_is_XmConvertCallbackStruct(ptr), ptr, 1, "status", "a struct with a status field");
+ if (Xen_is_XmTransferDoneCallbackStruct(ptr)) return(C_int_to_Xen_integer((XmTransferStatus)((Xen_to_C_XmTransferDoneCallbackStruct(ptr))->status)));
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmConvertCallbackStruct(ptr))->status)));
}
-static XEN gxm_parm_type(XEN ptr)
+static Xen gxm_parm_type(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmConvertCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "parm_type", "XmConvertCallbackStruct");
- return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmConvertCallbackStruct(ptr))->parm_type)));
+ XM_field_assert_type(Xen_is_XmConvertCallbackStruct(ptr), ptr, 1, "parm_type", "XmConvertCallbackStruct");
+ return(C_to_Xen_Atom((Atom)((Xen_to_C_XmConvertCallbackStruct(ptr))->parm_type)));
}
-static XEN gxm_parm_length(XEN ptr)
+static Xen gxm_parm_length(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmConvertCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "parm_length", "XmConvertCallbackStruct");
- return(C_TO_XEN_ULONG((unsigned long)((XEN_TO_C_XmConvertCallbackStruct(ptr))->parm_length)));
+ XM_field_assert_type(Xen_is_XmConvertCallbackStruct(ptr), ptr, 1, "parm_length", "XmConvertCallbackStruct");
+ return(C_ulong_to_Xen_ulong((unsigned long)((Xen_to_C_XmConvertCallbackStruct(ptr))->parm_length)));
}
-static XEN gxm_parm_format(XEN ptr)
+static Xen gxm_parm_format(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmConvertCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "parm_format", "XmConvertCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmConvertCallbackStruct(ptr))->parm_format)));
+ XM_field_assert_type(Xen_is_XmConvertCallbackStruct(ptr), ptr, 1, "parm_format", "XmConvertCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmConvertCallbackStruct(ptr))->parm_format)));
}
-static XEN gxm_parm(XEN ptr)
+static Xen gxm_parm(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmConvertCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "parm", "XmConvertCallbackStruct");
- return(XEN_WRAP_C_POINTER((XtPointer)((XEN_TO_C_XmConvertCallbackStruct(ptr))->parm)));
+ XM_field_assert_type(Xen_is_XmConvertCallbackStruct(ptr), ptr, 1, "parm", "XmConvertCallbackStruct");
+ return(Xen_wrap_C_pointer((XtPointer)((Xen_to_C_XmConvertCallbackStruct(ptr))->parm)));
}
-static XEN gxm_location_data(XEN ptr)
+static Xen gxm_location_data(Xen ptr)
{
/* widget-class specific interpretation -- is it worth untangling? */
- XM_FIELD_ASSERT_TYPE(XEN_XmDestinationCallbackStruct_P(ptr) || XEN_XmConvertCallbackStruct_P(ptr),
- ptr, XEN_ONLY_ARG, "location_data", "a struct with a location_data field");
- if (XEN_XmDestinationCallbackStruct_P(ptr)) return(XEN_WRAP_C_POINTER((XtPointer)((XEN_TO_C_XmDestinationCallbackStruct(ptr))->location_data)));
- return(XEN_WRAP_C_POINTER((XtPointer)((XEN_TO_C_XmConvertCallbackStruct(ptr))->location_data)));
+ XM_field_assert_type(Xen_is_XmDestinationCallbackStruct(ptr) || Xen_is_XmConvertCallbackStruct(ptr),
+ ptr, 1, "location_data", "a struct with a location_data field");
+ if (Xen_is_XmDestinationCallbackStruct(ptr)) return(Xen_wrap_C_pointer((XtPointer)((Xen_to_C_XmDestinationCallbackStruct(ptr))->location_data)));
+ return(Xen_wrap_C_pointer((XtPointer)((Xen_to_C_XmConvertCallbackStruct(ptr))->location_data)));
}
-static XEN gxm_source_data(XEN ptr)
+static Xen gxm_source_data(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmConvertCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "source_data", "XmConvertCallbackStruct");
- return(XEN_WRAP_C_POINTER((XtPointer)((XEN_TO_C_XmConvertCallbackStruct(ptr))->source_data)));
+ XM_field_assert_type(Xen_is_XmConvertCallbackStruct(ptr), ptr, 1, "source_data", "XmConvertCallbackStruct");
+ return(Xen_wrap_C_pointer((XtPointer)((Xen_to_C_XmConvertCallbackStruct(ptr))->source_data)));
}
-static XEN gxm_client_data(XEN ptr)
+static Xen gxm_client_data(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmTransferDoneCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "client_data", "XmTransferDoneCallbackStruct");
- return(XEN_WRAP_C_POINTER((XtPointer)((XEN_TO_C_XmTransferDoneCallbackStruct(ptr))->client_data)));
+ XM_field_assert_type(Xen_is_XmTransferDoneCallbackStruct(ptr), ptr, 1, "client_data", "XmTransferDoneCallbackStruct");
+ return(Xen_wrap_C_pointer((XtPointer)((Xen_to_C_XmTransferDoneCallbackStruct(ptr))->client_data)));
}
-static XEN gxm_animate(XEN ptr)
+static Xen gxm_animate(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmDragProcCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "animate", "XmDragProcCallbackStruct");
- return(C_TO_XEN_BOOLEAN((Boolean)((XEN_TO_C_XmDragProcCallbackStruct(ptr))->animate)));
+ XM_field_assert_type(Xen_is_XmDragProcCallbackStruct(ptr), ptr, 1, "animate", "XmDragProcCallbackStruct");
+ return(C_bool_to_Xen_boolean((Boolean)((Xen_to_C_XmDragProcCallbackStruct(ptr))->animate)));
}
-static XEN gxm_dragContext(XEN ptr)
+static Xen gxm_dragContext(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmDropProcCallbackStruct_P(ptr) || XEN_XmDragProcCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "dragContext", "a struct with a dragContext field");
- if (XEN_XmDropProcCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmDropProcCallbackStruct(ptr))->dragContext)));
- return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmDragProcCallbackStruct(ptr))->dragContext)));
+ XM_field_assert_type(Xen_is_XmDropProcCallbackStruct(ptr) || Xen_is_XmDragProcCallbackStruct(ptr), ptr, 1, "dragContext", "a struct with a dragContext field");
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) return(C_to_Xen_Widget((Widget)((Xen_to_C_XmDropProcCallbackStruct(ptr))->dragContext)));
+ return(C_to_Xen_Widget((Widget)((Xen_to_C_XmDragProcCallbackStruct(ptr))->dragContext)));
}
-static XEN gxm_completionStatus(XEN ptr)
+static Xen gxm_completionStatus(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmDropFinishCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "completionStatus", "XmDropFinishCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropFinishCallbackStruct(ptr))->completionStatus)));
+ XM_field_assert_type(Xen_is_XmDropFinishCallbackStruct(ptr), ptr, 1, "completionStatus", "XmDropFinishCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropFinishCallbackStruct(ptr))->completionStatus)));
}
-static XEN gxm_iccHandle(XEN ptr)
+static Xen gxm_iccHandle(Xen ptr)
{
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->iccHandle)));
- if (XEN_XmTopLevelEnterCallbackStruct_P(ptr)) return(C_TO_XEN_Atom((Atom)((XEN_TO_C_XmTopLevelEnterCallbackStruct(ptr))->iccHandle)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "iccHandle", "a struct with an iccHandle field");
- return(XEN_FALSE);
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmDropStartCallbackStruct(ptr))->iccHandle)));
+ if (Xen_is_XmTopLevelEnterCallbackStruct(ptr)) return(C_to_Xen_Atom((Atom)((Xen_to_C_XmTopLevelEnterCallbackStruct(ptr))->iccHandle)));
+ XM_field_assert_type(0, ptr, 1, "iccHandle", "a struct with an iccHandle field");
+ return(Xen_false);
}
-static XEN gxm_dropAction(XEN ptr)
+static Xen gxm_dropAction(Xen ptr)
{
- if (XEN_XmDropProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropProcCallbackStruct(ptr))->dropAction)));
- if (XEN_XmDropFinishCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropFinishCallbackStruct(ptr))->dropAction)));
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->dropAction)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "dropAction", "a struct with a dropAction field");
- return(XEN_FALSE);
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropProcCallbackStruct(ptr))->dropAction)));
+ if (Xen_is_XmDropFinishCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropFinishCallbackStruct(ptr))->dropAction)));
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropStartCallbackStruct(ptr))->dropAction)));
+ XM_field_assert_type(0, ptr, 1, "dropAction", "a struct with a dropAction field");
+ return(Xen_false);
}
-static XEN gxm_dropSiteStatus(XEN ptr)
+static Xen gxm_dropSiteStatus(Xen ptr)
{
- if (XEN_XmDropProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropProcCallbackStruct(ptr))->dropSiteStatus)));
- if (XEN_XmDragProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragProcCallbackStruct(ptr))->dropSiteStatus)));
- if (XEN_XmDropFinishCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropFinishCallbackStruct(ptr))->dropSiteStatus)));
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->dropSiteStatus)));
- if (XEN_XmOperationChangedCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmOperationChangedCallbackStruct(ptr))->dropSiteStatus)));
- if (XEN_XmDragMotionCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragMotionCallbackStruct(ptr))->dropSiteStatus)));
- if (XEN_XmDropSiteEnterCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropSiteEnterCallbackStruct(ptr))->dropSiteStatus)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "dropSiteStatus", "a struct with a dropSiteStatus field");
- return(XEN_FALSE);
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropProcCallbackStruct(ptr))->dropSiteStatus)));
+ if (Xen_is_XmDragProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragProcCallbackStruct(ptr))->dropSiteStatus)));
+ if (Xen_is_XmDropFinishCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropFinishCallbackStruct(ptr))->dropSiteStatus)));
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropStartCallbackStruct(ptr))->dropSiteStatus)));
+ if (Xen_is_XmOperationChangedCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmOperationChangedCallbackStruct(ptr))->dropSiteStatus)));
+ if (Xen_is_XmDragMotionCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragMotionCallbackStruct(ptr))->dropSiteStatus)));
+ if (Xen_is_XmDropSiteEnterCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropSiteEnterCallbackStruct(ptr))->dropSiteStatus)));
+ XM_field_assert_type(0, ptr, 1, "dropSiteStatus", "a struct with a dropSiteStatus field");
+ return(Xen_false);
}
-static XEN gxm_set_dropSiteStatus(XEN ptr, XEN val)
+static Xen gxm_set_dropSiteStatus(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "dropSiteStatus", "an integer");
- if (XEN_XmDropProcCallbackStruct_P(ptr)) (XEN_TO_C_XmDropProcCallbackStruct(ptr))->dropSiteStatus = XEN_TO_C_INT(val); else
- if (XEN_XmDragProcCallbackStruct_P(ptr)) (XEN_TO_C_XmDragProcCallbackStruct(ptr))->dropSiteStatus = XEN_TO_C_INT(val); else
- if (XEN_XmDropFinishCallbackStruct_P(ptr)) (XEN_TO_C_XmDropFinishCallbackStruct(ptr))->dropSiteStatus = XEN_TO_C_INT(val); else
- if (XEN_XmDropStartCallbackStruct_P(ptr)) (XEN_TO_C_XmDropStartCallbackStruct(ptr))->dropSiteStatus = XEN_TO_C_INT(val); else
- if (XEN_XmOperationChangedCallbackStruct_P(ptr)) (XEN_TO_C_XmOperationChangedCallbackStruct(ptr))->dropSiteStatus = XEN_TO_C_INT(val); else
- if (XEN_XmDragMotionCallbackStruct_P(ptr)) (XEN_TO_C_XmDragMotionCallbackStruct(ptr))->dropSiteStatus = XEN_TO_C_INT(val); else
- if (XEN_XmDropSiteEnterCallbackStruct_P(ptr)) (XEN_TO_C_XmDropSiteEnterCallbackStruct(ptr))->dropSiteStatus = XEN_TO_C_INT(val); else
- XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "dropSiteStatus", "a struct with a dropSiteStatus field");
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "dropSiteStatus", "an integer");
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) (Xen_to_C_XmDropProcCallbackStruct(ptr))->dropSiteStatus = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDragProcCallbackStruct(ptr)) (Xen_to_C_XmDragProcCallbackStruct(ptr))->dropSiteStatus = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDropFinishCallbackStruct(ptr)) (Xen_to_C_XmDropFinishCallbackStruct(ptr))->dropSiteStatus = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) (Xen_to_C_XmDropStartCallbackStruct(ptr))->dropSiteStatus = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmOperationChangedCallbackStruct(ptr)) (Xen_to_C_XmOperationChangedCallbackStruct(ptr))->dropSiteStatus = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDragMotionCallbackStruct(ptr)) (Xen_to_C_XmDragMotionCallbackStruct(ptr))->dropSiteStatus = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDropSiteEnterCallbackStruct(ptr)) (Xen_to_C_XmDropSiteEnterCallbackStruct(ptr))->dropSiteStatus = Xen_integer_to_C_int(val); else
+ XM_set_field_assert_type(0, ptr, 1, "dropSiteStatus", "a struct with a dropSiteStatus field");
return(val);
}
-static XEN gxm_operations(XEN ptr)
-{
- if (XEN_XmDropProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropProcCallbackStruct(ptr))->operations)));
- if (XEN_XmDragProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragProcCallbackStruct(ptr))->operations)));
- if (XEN_XmDropFinishCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropFinishCallbackStruct(ptr))->operations)));
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->operations)));
- if (XEN_XmOperationChangedCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmOperationChangedCallbackStruct(ptr))->operations)));
- if (XEN_XmDragMotionCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragMotionCallbackStruct(ptr))->operations)));
- if (XEN_XmDropSiteEnterCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropSiteEnterCallbackStruct(ptr))->operations)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "operations", "a struct with an operations field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_operation(XEN ptr)
-{
- if (XEN_XmDestinationCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDestinationCallbackStruct(ptr))->operation)));
- if (XEN_XmDropProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropProcCallbackStruct(ptr))->operation)));
- if (XEN_XmDragProcCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragProcCallbackStruct(ptr))->operation)));
- if (XEN_XmDropFinishCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropFinishCallbackStruct(ptr))->operation)));
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->operation)));
- if (XEN_XmOperationChangedCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmOperationChangedCallbackStruct(ptr))->operation)));
- if (XEN_XmDragMotionCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDragMotionCallbackStruct(ptr))->operation)));
- if (XEN_XmDropSiteEnterCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmDropSiteEnterCallbackStruct(ptr))->operation)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "operation", "a struct with an operation field");
- return(XEN_FALSE);
-}
-
-static XEN gxm_set_operation(XEN ptr, XEN val)
-{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "operation", "an integer");
- if (XEN_XmDestinationCallbackStruct_P(ptr)) (XEN_TO_C_XmDestinationCallbackStruct(ptr))->operation = XEN_TO_C_INT(val); else
- if (XEN_XmDropProcCallbackStruct_P(ptr)) (XEN_TO_C_XmDropProcCallbackStruct(ptr))->operation = XEN_TO_C_INT(val); else
- if (XEN_XmDragProcCallbackStruct_P(ptr)) (XEN_TO_C_XmDragProcCallbackStruct(ptr))->operation = XEN_TO_C_INT(val); else
- if (XEN_XmDropFinishCallbackStruct_P(ptr)) (XEN_TO_C_XmDropFinishCallbackStruct(ptr))->operation = XEN_TO_C_INT(val); else
- if (XEN_XmDropStartCallbackStruct_P(ptr)) (XEN_TO_C_XmDropStartCallbackStruct(ptr))->operation = XEN_TO_C_INT(val); else
- if (XEN_XmOperationChangedCallbackStruct_P(ptr)) (XEN_TO_C_XmOperationChangedCallbackStruct(ptr))->operation = XEN_TO_C_INT(val); else
- if (XEN_XmDragMotionCallbackStruct_P(ptr)) (XEN_TO_C_XmDragMotionCallbackStruct(ptr))->operation = XEN_TO_C_INT(val); else
- if (XEN_XmDropSiteEnterCallbackStruct_P(ptr)) (XEN_TO_C_XmDropSiteEnterCallbackStruct(ptr))->operation = XEN_TO_C_INT(val); else
- XM_SET_FIELD_ASSERT_TYPE(0, ptr, XEN_ARG_1, "operation", "a struct with an operation field");
+static Xen gxm_operations(Xen ptr)
+{
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropProcCallbackStruct(ptr))->operations)));
+ if (Xen_is_XmDragProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragProcCallbackStruct(ptr))->operations)));
+ if (Xen_is_XmDropFinishCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropFinishCallbackStruct(ptr))->operations)));
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropStartCallbackStruct(ptr))->operations)));
+ if (Xen_is_XmOperationChangedCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmOperationChangedCallbackStruct(ptr))->operations)));
+ if (Xen_is_XmDragMotionCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragMotionCallbackStruct(ptr))->operations)));
+ if (Xen_is_XmDropSiteEnterCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropSiteEnterCallbackStruct(ptr))->operations)));
+ XM_field_assert_type(0, ptr, 1, "operations", "a struct with an operations field");
+ return(Xen_false);
+}
+
+static Xen gxm_operation(Xen ptr)
+{
+ if (Xen_is_XmDestinationCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDestinationCallbackStruct(ptr))->operation)));
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropProcCallbackStruct(ptr))->operation)));
+ if (Xen_is_XmDragProcCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragProcCallbackStruct(ptr))->operation)));
+ if (Xen_is_XmDropFinishCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropFinishCallbackStruct(ptr))->operation)));
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropStartCallbackStruct(ptr))->operation)));
+ if (Xen_is_XmOperationChangedCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmOperationChangedCallbackStruct(ptr))->operation)));
+ if (Xen_is_XmDragMotionCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDragMotionCallbackStruct(ptr))->operation)));
+ if (Xen_is_XmDropSiteEnterCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmDropSiteEnterCallbackStruct(ptr))->operation)));
+ XM_field_assert_type(0, ptr, 1, "operation", "a struct with an operation field");
+ return(Xen_false);
+}
+
+static Xen gxm_set_operation(Xen ptr, Xen val)
+{
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "operation", "an integer");
+ if (Xen_is_XmDestinationCallbackStruct(ptr)) (Xen_to_C_XmDestinationCallbackStruct(ptr))->operation = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) (Xen_to_C_XmDropProcCallbackStruct(ptr))->operation = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDragProcCallbackStruct(ptr)) (Xen_to_C_XmDragProcCallbackStruct(ptr))->operation = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDropFinishCallbackStruct(ptr)) (Xen_to_C_XmDropFinishCallbackStruct(ptr))->operation = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) (Xen_to_C_XmDropStartCallbackStruct(ptr))->operation = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmOperationChangedCallbackStruct(ptr)) (Xen_to_C_XmOperationChangedCallbackStruct(ptr))->operation = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDragMotionCallbackStruct(ptr)) (Xen_to_C_XmDragMotionCallbackStruct(ptr))->operation = Xen_integer_to_C_int(val); else
+ if (Xen_is_XmDropSiteEnterCallbackStruct(ptr)) (Xen_to_C_XmDropSiteEnterCallbackStruct(ptr))->operation = Xen_integer_to_C_int(val); else
+ XM_set_field_assert_type(0, ptr, 1, "operation", "a struct with an operation field");
return(val);
}
-static XEN gxm_timeStamp(XEN ptr)
+static Xen gxm_timeStamp(Xen ptr)
{
- if (XEN_XmDropProcCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDropProcCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmDragProcCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDragProcCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmDragDropFinishCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDragDropFinishCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmDropFinishCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDropFinishCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmDropStartCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDropStartCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmOperationChangedCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmOperationChangedCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmDragMotionCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDragMotionCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmDropSiteLeaveCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDropSiteLeaveCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmDropSiteEnterCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmDropSiteEnterCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmTopLevelEnterCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmTopLevelEnterCallbackStruct(ptr))->timeStamp)));
- if (XEN_XmTopLevelLeaveCallbackStruct_P(ptr)) return(C_TO_XEN_Time((Time)((XEN_TO_C_XmTopLevelLeaveCallbackStruct(ptr))->timeStamp)));
- XM_FIELD_ASSERT_TYPE(0, ptr, XEN_ONLY_ARG, "timeStamp", "a struct with a timeStamp field");
- return(XEN_FALSE);
+ if (Xen_is_XmDropProcCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDropProcCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmDragProcCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDragProcCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmDragDropFinishCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDragDropFinishCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmDropFinishCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDropFinishCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmDropStartCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDropStartCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmOperationChangedCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmOperationChangedCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmDragMotionCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDragMotionCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmDropSiteLeaveCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDropSiteLeaveCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmDropSiteEnterCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmDropSiteEnterCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmTopLevelEnterCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmTopLevelEnterCallbackStruct(ptr))->timeStamp)));
+ if (Xen_is_XmTopLevelLeaveCallbackStruct(ptr)) return(C_to_Xen_Time((Time)((Xen_to_C_XmTopLevelLeaveCallbackStruct(ptr))->timeStamp)));
+ XM_field_assert_type(0, ptr, 1, "timeStamp", "a struct with a timeStamp field");
+ return(Xen_false);
}
-static XEN gxm_reason(XEN ptr)
+static Xen gxm_reason(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_AnyCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "reason", "a callbackstruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmAnyCallbackStruct(ptr))->reason)));
+ XM_field_assert_type(Xen_is_AnyCallbackStruct(ptr), ptr, 1, "reason", "a callbackstruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmAnyCallbackStruct(ptr))->reason)));
}
-static XEN gxm_set_reason(XEN ptr, XEN val)
+static Xen gxm_set_reason(Xen ptr, Xen val)
{
- XM_SET_FIELD_ASSERT_TYPE(XEN_INTEGER_P(val), val, XEN_ARG_2, "reason", "integer");
- XM_SET_FIELD_ASSERT_TYPE(XEN_AnyCallbackStruct_P(ptr), ptr, XEN_ARG_1, "reason", "a callbackstruct");
- (XEN_TO_C_XmAnyCallbackStruct(ptr))->reason = XEN_TO_C_INT(val);
+ XM_set_field_assert_type(Xen_is_integer(val), val, 2, "reason", "integer");
+ XM_set_field_assert_type(Xen_is_AnyCallbackStruct(ptr), ptr, 1, "reason", "a callbackstruct");
+ (Xen_to_C_XmAnyCallbackStruct(ptr))->reason = Xen_integer_to_C_int(val);
return(val);
}
-static XEN gxm_direction(XEN ptr)
-{
- XM_FIELD_ASSERT_TYPE(XEN_XmTraverseObscuredCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "direction", "XmTraverseObscuredCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmTraverseObscuredCallbackStruct(ptr))->direction)));
-}
-
-static XEN gxm_dragProtocolStyle(XEN ptr)
-{
- XM_FIELD_ASSERT_TYPE(XEN_XmTopLevelEnterCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "dragProtocolStyle", "XmTopLevelEnterCallbackStruct");
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmTopLevelEnterCallbackStruct(ptr))->dragProtocolStyle)));
-}
-
-static XEN gxm_traversal_destination(XEN ptr)
+static Xen gxm_direction(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmTraverseObscuredCallbackStruct_P(ptr), ptr, XEN_ONLY_ARG, "traversal_destination", "XmTraverseObscuredCallbackStruct");
- return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmTraverseObscuredCallbackStruct(ptr))->traversal_destination)));
+ XM_field_assert_type(Xen_is_XmTraverseObscuredCallbackStruct(ptr), ptr, 1, "direction", "XmTraverseObscuredCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmTraverseObscuredCallbackStruct(ptr))->direction)));
}
-static XEN gxm_minor_tab_widget(XEN ptr)
+static Xen gxm_dragProtocolStyle(Xen ptr)
{
- XM_FIELD_ASSERT_TYPE(XEN_XmNotebookPageInfo_P(ptr), ptr, XEN_ONLY_ARG, "minor_tab_widget", "XmNotebookPageInfo");
- return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmNotebookPageInfo(ptr))->minor_tab_widget)));
-}
-
-static XEN gxm_major_tab_widget(XEN ptr)
-{
- XM_FIELD_ASSERT_TYPE(XEN_XmNotebookPageInfo_P(ptr), ptr, XEN_ONLY_ARG, "major_tab_widget", "XmNotebookPageInfo");
- return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmNotebookPageInfo(ptr))->major_tab_widget)));
-}
-
-static XEN gxm_status_area_widget(XEN ptr)
-{
- XM_FIELD_ASSERT_TYPE(XEN_XmNotebookPageInfo_P(ptr), ptr, XEN_ONLY_ARG, "status_area_widget", "XmNotebookPageInfo");
- return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmNotebookPageInfo(ptr))->status_area_widget)));
-}
-
-static XEN gxm_page_widget(XEN ptr)
-{
- XM_FIELD_ASSERT_TYPE(XEN_XmNotebookCallbackStruct_P(ptr) || XEN_XmNotebookPageInfo_P(ptr), ptr, XEN_ONLY_ARG, "page_widget", "a struct with a page_widget field");
- if (XEN_XmNotebookCallbackStruct_P(ptr)) return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmNotebookCallbackStruct(ptr))->page_widget)));
- return(C_TO_XEN_Widget((Widget)((XEN_TO_C_XmNotebookPageInfo(ptr))->page_widget)));
-}
-
-static XEN gxm_page_number(XEN ptr)
-{
- XM_FIELD_ASSERT_TYPE(XEN_XmNotebookCallbackStruct_P(ptr) || XEN_XmNotebookPageInfo_P(ptr), ptr, XEN_ONLY_ARG, "page_number", "a struct with a page_number field");
- if (XEN_XmNotebookCallbackStruct_P(ptr)) return(C_TO_XEN_INT((int)((XEN_TO_C_XmNotebookCallbackStruct(ptr))->page_number)));
- return(C_TO_XEN_INT((int)((XEN_TO_C_XmNotebookPageInfo(ptr))->page_number)));
-}
-#endif
-/* HAVE_MOTIF */
-
-
-#ifdef XEN_ARGIFY_1
-#if HAVE_MOTIF
- XEN_NARGIFY_3(gxm_XtSetArg_w, gxm_XtSetArg)
- XEN_ARGIFY_2(gxm_XtManageChildren_w, gxm_XtManageChildren)
- XEN_NARGIFY_1(gxm_XtManageChild_w, gxm_XtManageChild)
- XEN_ARGIFY_2(gxm_XtUnmanageChildren_w, gxm_XtUnmanageChildren)
- XEN_NARGIFY_1(gxm_XtUnmanageChild_w, gxm_XtUnmanageChild)
- XEN_NARGIFY_1(gxm_XtDispatchEvent_w, gxm_XtDispatchEvent)
- XEN_NARGIFY_2(gxm_XtCallAcceptFocus_w, gxm_XtCallAcceptFocus)
- XEN_NARGIFY_1(gxm_XtAppPeekEvent_w, gxm_XtAppPeekEvent)
- XEN_NARGIFY_2(gxm_XtIsSubclass_w, gxm_XtIsSubclass)
- XEN_NARGIFY_2(gxm_XtAppSetFallbackResources_w, gxm_XtAppSetFallbackResources)
- XEN_NARGIFY_1(gxm_XtIsObject_w, gxm_XtIsObject)
- XEN_NARGIFY_1(gxm_XtIsManaged_w, gxm_XtIsManaged)
- XEN_NARGIFY_1(gxm_XtIsRealized_w, gxm_XtIsRealized)
- XEN_NARGIFY_1(gxm_XtIsSensitive_w, gxm_XtIsSensitive)
- XEN_NARGIFY_6(gxm_XtOwnSelection_w, gxm_XtOwnSelection)
- XEN_NARGIFY_8(gxm_XtOwnSelectionIncremental_w, gxm_XtOwnSelectionIncremental)
- XEN_NARGIFY_3(gxm_XtMakeResizeRequest_w, gxm_XtMakeResizeRequest)
- XEN_NARGIFY_3(gxm_XtTranslateCoords_w, gxm_XtTranslateCoords)
- XEN_NARGIFY_2(gxm_XtKeysymToKeycodeList_w, gxm_XtKeysymToKeycodeList)
- XEN_NARGIFY_1(gxm_XtParseTranslationTable_w, gxm_XtParseTranslationTable)
- XEN_NARGIFY_1(gxm_XtParseAcceleratorTable_w, gxm_XtParseAcceleratorTable)
- XEN_NARGIFY_2(gxm_XtOverrideTranslations_w, gxm_XtOverrideTranslations)
- XEN_NARGIFY_2(gxm_XtAugmentTranslations_w, gxm_XtAugmentTranslations)
- XEN_NARGIFY_2(gxm_XtInstallAccelerators_w, gxm_XtInstallAccelerators)
- XEN_NARGIFY_2(gxm_XtInstallAllAccelerators_w, gxm_XtInstallAllAccelerators)
- XEN_NARGIFY_1(gxm_XtUninstallTranslations_w, gxm_XtUninstallTranslations)
- XEN_NARGIFY_2(gxm_XtAppAddActions_w, gxm_XtAppAddActions)
- XEN_ARGIFY_3(gxm_XtAppAddActionHook_w, gxm_XtAppAddActionHook)
- XEN_NARGIFY_1(gxm_XtRemoveActionHook_w, gxm_XtRemoveActionHook)
- XEN_NARGIFY_1(gxm_XtGetActionList_w, gxm_XtGetActionList)
- XEN_ARGIFY_5(gxm_XtCallActionProc_w, gxm_XtCallActionProc)
- XEN_NARGIFY_5(gxm_XtRegisterGrabAction_w, gxm_XtRegisterGrabAction)
- XEN_NARGIFY_2(gxm_XtSetMultiClickTime_w, gxm_XtSetMultiClickTime)
- XEN_NARGIFY_1(gxm_XtGetMultiClickTime_w, gxm_XtGetMultiClickTime)
- XEN_NARGIFY_1(gxm_XtGetResourceList_w, gxm_XtGetResourceList)
- XEN_NARGIFY_1(gxm_XtGetActionKeysym_w, gxm_XtGetActionKeysym)
- XEN_NARGIFY_3(gxm_XtTranslateKeycode_w, gxm_XtTranslateKeycode)
- XEN_NARGIFY_3(gxm_XtTranslateKey_w, gxm_XtTranslateKey)
- XEN_NARGIFY_2(gxm_XtSetKeyTranslator_w, gxm_XtSetKeyTranslator)
- XEN_NARGIFY_4(gxm_XtRegisterCaseConverter_w, gxm_XtRegisterCaseConverter)
- XEN_NARGIFY_2(gxm_XtConvertCase_w, gxm_XtConvertCase)
- XEN_ARGIFY_5(gxm_XtAddEventHandler_w, gxm_XtAddEventHandler)
- XEN_NARGIFY_5(gxm_XtRemoveEventHandler_w, gxm_XtRemoveEventHandler)
- XEN_NARGIFY_5(gxm_XtAddRawEventHandler_w, gxm_XtAddRawEventHandler)
- XEN_NARGIFY_5(gxm_XtRemoveRawEventHandler_w, gxm_XtRemoveRawEventHandler)
- XEN_NARGIFY_6(gxm_XtInsertEventHandler_w, gxm_XtInsertEventHandler)
- XEN_NARGIFY_6(gxm_XtInsertRawEventHandler_w, gxm_XtInsertRawEventHandler)
- XEN_NARGIFY_2(gxm_XtDispatchEventToWidget_w, gxm_XtDispatchEventToWidget)
- XEN_NARGIFY_1(gxm_XtBuildEventMask_w, gxm_XtBuildEventMask)
- XEN_NARGIFY_3(gxm_XtAddGrab_w, gxm_XtAddGrab)
- XEN_NARGIFY_1(gxm_XtRemoveGrab_w, gxm_XtRemoveGrab)
- XEN_NARGIFY_2(gxm_XtAppProcessEvent_w, gxm_XtAppProcessEvent)
- XEN_NARGIFY_1(gxm_XtAppMainLoop_w, gxm_XtAppMainLoop)
- XEN_NARGIFY_2(gxm_XtAddExposureToRegion_w, gxm_XtAddExposureToRegion)
- XEN_NARGIFY_2(gxm_XtSetKeyboardFocus_w, gxm_XtSetKeyboardFocus)
- XEN_NARGIFY_1(gxm_XtGetKeyboardFocusWidget_w, gxm_XtGetKeyboardFocusWidget)
- XEN_NARGIFY_1(gxm_XtLastEventProcessed_w, gxm_XtLastEventProcessed)
- XEN_NARGIFY_1(gxm_XtLastTimestampProcessed_w, gxm_XtLastTimestampProcessed)
- XEN_ARGIFY_4(gxm_XtAppAddTimeOut_w, gxm_XtAppAddTimeOut)
- XEN_NARGIFY_1(gxm_XtRemoveTimeOut_w, gxm_XtRemoveTimeOut)
- XEN_ARGIFY_5(gxm_XtAppAddInput_w, gxm_XtAppAddInput)
- XEN_NARGIFY_1(gxm_XtRemoveInput_w, gxm_XtRemoveInput)
- XEN_NARGIFY_1(gxm_XtAppNextEvent_w, gxm_XtAppNextEvent)
- XEN_NARGIFY_1(gxm_XtAppPending_w, gxm_XtAppPending)
- XEN_NARGIFY_1(gxm_XtRealizeWidget_w, gxm_XtRealizeWidget)
- XEN_NARGIFY_1(gxm_XtUnrealizeWidget_w, gxm_XtUnrealizeWidget)
- XEN_NARGIFY_1(gxm_XtDestroyWidget_w, gxm_XtDestroyWidget)
- XEN_NARGIFY_2(gxm_XtSetSensitive_w, gxm_XtSetSensitive)
- XEN_NARGIFY_2(gxm_XtNameToWidget_w, gxm_XtNameToWidget)
- XEN_NARGIFY_2(gxm_XtWindowToWidget_w, gxm_XtWindowToWidget)
- XEN_NARGIFY_4(gxm_XtMergeArgLists_w, gxm_XtMergeArgLists)
- XEN_NARGIFY_2(gxm_XtVaCreateArgsList_w, gxm_XtVaCreateArgsList)
- XEN_NARGIFY_1(gxm_XtDisplay_w, gxm_XtDisplay)
- XEN_NARGIFY_1(gxm_XtDisplayOfObject_w, gxm_XtDisplayOfObject)
- XEN_NARGIFY_1(gxm_XtScreen_w, gxm_XtScreen)
- XEN_NARGIFY_1(gxm_XtScreenOfObject_w, gxm_XtScreenOfObject)
- XEN_NARGIFY_1(gxm_XtWindow_w, gxm_XtWindow)
- XEN_NARGIFY_1(gxm_XtWindowOfObject_w, gxm_XtWindowOfObject)
- XEN_NARGIFY_1(gxm_XtName_w, gxm_XtName)
- XEN_NARGIFY_1(gxm_XtSuperclass_w, gxm_XtSuperclass)
- XEN_NARGIFY_1(gxm_XtClass_w, gxm_XtClass)
- XEN_NARGIFY_1(gxm_XtParent_w, gxm_XtParent)
- XEN_ARGIFY_4(gxm_XtAddCallback_w, gxm_XtAddCallback)
- XEN_NARGIFY_3(gxm_XtRemoveCallback_w, gxm_XtRemoveCallback)
- XEN_NARGIFY_3(gxm_XtAddCallbacks_w, gxm_XtAddCallbacks)
- XEN_NARGIFY_3(gxm_XtRemoveCallbacks_w, gxm_XtRemoveCallbacks)
- XEN_NARGIFY_2(gxm_XtRemoveAllCallbacks_w, gxm_XtRemoveAllCallbacks)
- XEN_NARGIFY_3(gxm_XtCallCallbacks_w, gxm_XtCallCallbacks)
- XEN_NARGIFY_2(gxm_XtHasCallbacks_w, gxm_XtHasCallbacks)
- XEN_ARGIFY_5(gxm_XtCreatePopupShell_w, gxm_XtCreatePopupShell)
- XEN_NARGIFY_4(gxm_XtVaCreatePopupShell_w, gxm_XtVaCreatePopupShell)
- XEN_NARGIFY_2(gxm_XtPopup_w, gxm_XtPopup)
- XEN_NARGIFY_1(gxm_XtPopupSpringLoaded_w, gxm_XtPopupSpringLoaded)
- XEN_NARGIFY_3(gxm_XtCallbackNone_w, gxm_XtCallbackNone)
- XEN_NARGIFY_3(gxm_XtCallbackNonexclusive_w, gxm_XtCallbackNonexclusive)
- XEN_NARGIFY_3(gxm_XtCallbackExclusive_w, gxm_XtCallbackExclusive)
- XEN_NARGIFY_1(gxm_XtPopdown_w, gxm_XtPopdown)
- XEN_NARGIFY_3(gxm_XtCallbackPopdown_w, gxm_XtCallbackPopdown)
- XEN_ARGIFY_5(gxm_XtCreateWidget_w, gxm_XtCreateWidget)
- XEN_ARGIFY_5(gxm_XtCreateManagedWidget_w, gxm_XtCreateManagedWidget)
- XEN_NARGIFY_4(gxm_XtVaCreateWidget_w, gxm_XtVaCreateWidget)
- XEN_NARGIFY_4(gxm_XtVaCreateManagedWidget_w, gxm_XtVaCreateManagedWidget)
- XEN_ARGIFY_6(gxm_XtAppCreateShell_w, gxm_XtAppCreateShell)
- XEN_NARGIFY_5(gxm_XtVaAppCreateShell_w, gxm_XtVaAppCreateShell)
- XEN_NARGIFY_0(gxm_XtToolkitInitialize_w, gxm_XtToolkitInitialize)
- XEN_NARGIFY_3(gxm_XtSetLanguageProc_w, gxm_XtSetLanguageProc)
- XEN_NARGIFY_6(gxm_XtDisplayInitialize_w, gxm_XtDisplayInitialize)
- XEN_ARGIFY_6(gxm_XtOpenApplication_w, gxm_XtOpenApplication)
- XEN_ARGIFY_6(gxm_XtVaOpenApplication_w, gxm_XtVaOpenApplication)
- XEN_ARGIFY_5(gxm_XtAppInitialize_w, gxm_XtAppInitialize)
- XEN_ARGIFY_5(gxm_XtVaAppInitialize_w, gxm_XtVaAppInitialize)
- XEN_NARGIFY_6(gxm_XtOpenDisplay_w, gxm_XtOpenDisplay)
- XEN_NARGIFY_0(gxm_XtCreateApplicationContext_w, gxm_XtCreateApplicationContext)
- XEN_NARGIFY_1(gxm_XtDestroyApplicationContext_w, gxm_XtDestroyApplicationContext)
- XEN_NARGIFY_1(gxm_XtInitializeWidgetClass_w, gxm_XtInitializeWidgetClass)
- XEN_NARGIFY_1(gxm_XtWidgetToApplicationContext_w, gxm_XtWidgetToApplicationContext)
- XEN_NARGIFY_1(gxm_XtDisplayToApplicationContext_w, gxm_XtDisplayToApplicationContext)
- XEN_NARGIFY_1(gxm_XtCloseDisplay_w, gxm_XtCloseDisplay)
- XEN_ARGIFY_3(gxm_XtSetValues_w, gxm_XtSetValues)
- XEN_NARGIFY_2(gxm_XtVaSetValues_w, gxm_XtVaSetValues)
- XEN_ARGIFY_3(gxm_XtGetValues_w, gxm_XtGetValues)
- XEN_NARGIFY_2(gxm_XtVaGetValues_w, gxm_XtVaGetValues)
- XEN_NARGIFY_2(gxm_XtAppSetErrorMsgHandler_w, gxm_XtAppSetErrorMsgHandler)
- XEN_NARGIFY_2(gxm_XtAppSetWarningMsgHandler_w, gxm_XtAppSetWarningMsgHandler)
- XEN_NARGIFY_7(gxm_XtAppErrorMsg_w, gxm_XtAppErrorMsg)
- XEN_NARGIFY_7(gxm_XtAppWarningMsg_w, gxm_XtAppWarningMsg)
- XEN_NARGIFY_2(gxm_XtAppSetErrorHandler_w, gxm_XtAppSetErrorHandler)
- XEN_NARGIFY_2(gxm_XtAppSetWarningHandler_w, gxm_XtAppSetWarningHandler)
- XEN_NARGIFY_2(gxm_XtAppError_w, gxm_XtAppError)
- XEN_NARGIFY_1(gxm_XtMalloc_w, gxm_XtMalloc)
- XEN_NARGIFY_2(gxm_XtCalloc_w, gxm_XtCalloc)
- XEN_NARGIFY_2(gxm_XtRealloc_w, gxm_XtRealloc)
- XEN_NARGIFY_1(gxm_XtFree_w, gxm_XtFree)
- XEN_ARGIFY_3(gxm_XtAppAddWorkProc_w, gxm_XtAppAddWorkProc)
- XEN_NARGIFY_1(gxm_XtRemoveWorkProc_w, gxm_XtRemoveWorkProc)
- XEN_NARGIFY_3(gxm_XtGetGC_w, gxm_XtGetGC)
- XEN_NARGIFY_6(gxm_XtAllocateGC_w, gxm_XtAllocateGC)
- XEN_NARGIFY_1(gxm_XtDestroyGC_w, gxm_XtDestroyGC)
- XEN_NARGIFY_2(gxm_XtReleaseGC_w, gxm_XtReleaseGC)
- XEN_NARGIFY_4(gxm_XtFindFile_w, gxm_XtFindFile)
- XEN_NARGIFY_8(gxm_XtResolvePathname_w, gxm_XtResolvePathname)
- XEN_NARGIFY_3(gxm_XtDisownSelection_w, gxm_XtDisownSelection)
- XEN_NARGIFY_6(gxm_XtGetSelectionValue_w, gxm_XtGetSelectionValue)
- XEN_NARGIFY_7(gxm_XtGetSelectionValues_w, gxm_XtGetSelectionValues)
- XEN_NARGIFY_2(gxm_XtAppSetSelectionTimeout_w, gxm_XtAppSetSelectionTimeout)
- XEN_NARGIFY_1(gxm_XtAppGetSelectionTimeout_w, gxm_XtAppGetSelectionTimeout)
- XEN_NARGIFY_3(gxm_XtGetSelectionRequest_w, gxm_XtGetSelectionRequest)
- XEN_NARGIFY_6(gxm_XtGetSelectionValueIncremental_w, gxm_XtGetSelectionValueIncremental)
- XEN_NARGIFY_7(gxm_XtGetSelectionValuesIncremental_w, gxm_XtGetSelectionValuesIncremental)
- XEN_NARGIFY_2(gxm_XtCreateSelectionRequest_w, gxm_XtCreateSelectionRequest)
- XEN_NARGIFY_3(gxm_XtSendSelectionRequest_w, gxm_XtSendSelectionRequest)
- XEN_NARGIFY_2(gxm_XtCancelSelectionRequest_w, gxm_XtCancelSelectionRequest)
- XEN_NARGIFY_6(gxm_XtGrabKey_w, gxm_XtGrabKey)
- XEN_NARGIFY_3(gxm_XtUngrabKey_w, gxm_XtUngrabKey)
- XEN_NARGIFY_5(gxm_XtGrabKeyboard_w, gxm_XtGrabKeyboard)
- XEN_NARGIFY_2(gxm_XtUngrabKeyboard_w, gxm_XtUngrabKeyboard)
- XEN_NARGIFY_9(gxm_XtGrabButton_w, gxm_XtGrabButton)
- XEN_NARGIFY_3(gxm_XtUngrabButton_w, gxm_XtUngrabButton)
- XEN_NARGIFY_8(gxm_XtGrabPointer_w, gxm_XtGrabPointer)
- XEN_NARGIFY_2(gxm_XtUngrabPointer_w, gxm_XtUngrabPointer)
- XEN_NARGIFY_1(gxm_XtGetApplicationNameAndClass_w, gxm_XtGetApplicationNameAndClass)
- XEN_NARGIFY_1(gxm_XtGetDisplays_w, gxm_XtGetDisplays)
- XEN_NARGIFY_0(gxm_XtToolkitThreadInitialize_w, gxm_XtToolkitThreadInitialize)
- XEN_NARGIFY_1(gxm_XtAppLock_w, gxm_XtAppLock)
- XEN_NARGIFY_1(gxm_XtAppUnlock_w, gxm_XtAppUnlock)
- XEN_NARGIFY_1(gxm_XtIsRectObj_w, gxm_XtIsRectObj)
- XEN_NARGIFY_1(gxm_XtIsWidget_w, gxm_XtIsWidget)
- XEN_NARGIFY_1(gxm_XtIsComposite_w, gxm_XtIsComposite)
- XEN_NARGIFY_1(gxm_XtIsConstraint_w, gxm_XtIsConstraint)
- XEN_NARGIFY_1(gxm_XtIsShell_w, gxm_XtIsShell)
- XEN_NARGIFY_1(gxm_XtIsOverrideShell_w, gxm_XtIsOverrideShell)
- XEN_NARGIFY_1(gxm_XtIsWMShell_w, gxm_XtIsWMShell)
- XEN_NARGIFY_1(gxm_XtIsVendorShell_w, gxm_XtIsVendorShell)
- XEN_NARGIFY_1(gxm_XtIsTransientShell_w, gxm_XtIsTransientShell)
- XEN_NARGIFY_1(gxm_XtIsTopLevelShell_w, gxm_XtIsTopLevelShell)
- XEN_NARGIFY_1(gxm_XtIsApplicationShell_w, gxm_XtIsApplicationShell)
- XEN_NARGIFY_1(gxm_XtIsSessionShell_w, gxm_XtIsSessionShell)
- XEN_NARGIFY_1(gxm_XtMapWidget_w, gxm_XtMapWidget)
- XEN_NARGIFY_1(gxm_XtUnmapWidget_w, gxm_XtUnmapWidget)
-#endif
- XEN_NARGIFY_2(gxm_XLoadQueryFont_w, gxm_XLoadQueryFont)
- XEN_NARGIFY_2(gxm_XQueryFont_w, gxm_XQueryFont)
- XEN_NARGIFY_4(gxm_XGetMotionEvents_w, gxm_XGetMotionEvents)
- XEN_NARGIFY_3(gxm_XDeleteModifiermapEntry_w, gxm_XDeleteModifiermapEntry)
- XEN_NARGIFY_1(gxm_XGetModifierMapping_w, gxm_XGetModifierMapping)
- XEN_NARGIFY_3(gxm_XInsertModifiermapEntry_w, gxm_XInsertModifiermapEntry)
- XEN_NARGIFY_1(gxm_XNewModifiermap_w, gxm_XNewModifiermap)
- XEN_VARGIFY(gxm_XCreateImage_w, gxm_XCreateImage)
- XEN_NARGIFY_8(gxm_XGetImage_w, gxm_XGetImage)
- XEN_VARGIFY(gxm_XGetSubImage_w, gxm_XGetSubImage)
- XEN_NARGIFY_1(gxm_XOpenDisplay_w, gxm_XOpenDisplay)
- XEN_NARGIFY_1(gxm_XFetchBytes_w, gxm_XFetchBytes)
- XEN_NARGIFY_2(gxm_XFetchBuffer_w, gxm_XFetchBuffer)
- XEN_NARGIFY_2(gxm_XGetAtomName_w, gxm_XGetAtomName)
- XEN_NARGIFY_1(gxm_XDisplayName_w, gxm_XDisplayName)
- XEN_NARGIFY_1(gxm_XKeysymToString_w, gxm_XKeysymToString)
- XEN_NARGIFY_2(gxm_XSynchronize_w, gxm_XSynchronize)
- XEN_NARGIFY_2(gxm_XSetAfterFunction_w, gxm_XSetAfterFunction)
- XEN_NARGIFY_3(gxm_XInternAtom_w, gxm_XInternAtom)
- XEN_NARGIFY_2(gxm_XCopyColormapAndFree_w, gxm_XCopyColormapAndFree)
- XEN_NARGIFY_4(gxm_XCreateColormap_w, gxm_XCreateColormap)
- XEN_NARGIFY_7(gxm_XCreatePixmapCursor_w, gxm_XCreatePixmapCursor)
- XEN_NARGIFY_7(gxm_XCreateGlyphCursor_w, gxm_XCreateGlyphCursor)
- XEN_NARGIFY_2(gxm_XCreateFontCursor_w, gxm_XCreateFontCursor)
- XEN_NARGIFY_2(gxm_XLoadFont_w, gxm_XLoadFont)
- XEN_NARGIFY_4(gxm_XCreateGC_w, gxm_XCreateGC)
- XEN_NARGIFY_2(gxm_XFlushGC_w, gxm_XFlushGC)
- XEN_NARGIFY_5(gxm_XCreatePixmap_w, gxm_XCreatePixmap)
- XEN_NARGIFY_5(gxm_XCreateBitmapFromData_w, gxm_XCreateBitmapFromData)
- XEN_NARGIFY_8(gxm_XCreatePixmapFromBitmapData_w, gxm_XCreatePixmapFromBitmapData)
- XEN_NARGIFY_9(gxm_XCreateSimpleWindow_w, gxm_XCreateSimpleWindow)
- XEN_NARGIFY_2(gxm_XGetSelectionOwner_w, gxm_XGetSelectionOwner)
- XEN_VARGIFY(gxm_XCreateWindow_w, gxm_XCreateWindow)
- XEN_NARGIFY_2(gxm_XListInstalledColormaps_w, gxm_XListInstalledColormaps)
- XEN_NARGIFY_3(gxm_XListFonts_w, gxm_XListFonts)
- XEN_NARGIFY_3(gxm_XListFontsWithInfo_w, gxm_XListFontsWithInfo)
- XEN_NARGIFY_1(gxm_XGetFontPath_w, gxm_XGetFontPath)
- XEN_NARGIFY_1(gxm_XListExtensions_w, gxm_XListExtensions)
- XEN_NARGIFY_2(gxm_XListProperties_w, gxm_XListProperties)
- XEN_NARGIFY_3(gxm_XKeycodeToKeysym_w, gxm_XKeycodeToKeysym)
- XEN_NARGIFY_2(gxm_XLookupKeysym_w, gxm_XLookupKeysym)
- XEN_NARGIFY_3(gxm_XGetKeyboardMapping_w, gxm_XGetKeyboardMapping)
- XEN_NARGIFY_1(gxm_XStringToKeysym_w, gxm_XStringToKeysym)
- XEN_NARGIFY_1(gxm_XMaxRequestSize_w, gxm_XMaxRequestSize)
- XEN_NARGIFY_1(gxm_XExtendedMaxRequestSize_w, gxm_XExtendedMaxRequestSize)
- XEN_NARGIFY_1(gxm_XDisplayMotionBufferSize_w, gxm_XDisplayMotionBufferSize)
- XEN_NARGIFY_1(gxm_XVisualIDFromVisual_w, gxm_XVisualIDFromVisual)
- XEN_NARGIFY_2(gxm_XRootWindow_w, gxm_XRootWindow)
- XEN_NARGIFY_1(gxm_XDefaultRootWindow_w, gxm_XDefaultRootWindow)
- XEN_NARGIFY_1(gxm_XRootWindowOfScreen_w, gxm_XRootWindowOfScreen)
- XEN_NARGIFY_2(gxm_XDefaultVisual_w, gxm_XDefaultVisual)
- XEN_NARGIFY_1(gxm_XDefaultVisualOfScreen_w, gxm_XDefaultVisualOfScreen)
- XEN_NARGIFY_2(gxm_XDefaultGC_w, gxm_XDefaultGC)
- XEN_NARGIFY_1(gxm_XDefaultGCOfScreen_w, gxm_XDefaultGCOfScreen)
- XEN_NARGIFY_2(gxm_XBlackPixel_w, gxm_XBlackPixel)
- XEN_NARGIFY_2(gxm_XWhitePixel_w, gxm_XWhitePixel)
- XEN_NARGIFY_0(gxm_XAllPlanes_w, gxm_XAllPlanes)
- XEN_NARGIFY_1(gxm_XBlackPixelOfScreen_w, gxm_XBlackPixelOfScreen)
- XEN_NARGIFY_1(gxm_XWhitePixelOfScreen_w, gxm_XWhitePixelOfScreen)
- XEN_NARGIFY_1(gxm_XNextRequest_w, gxm_XNextRequest)
- XEN_NARGIFY_1(gxm_XLastKnownRequestProcessed_w, gxm_XLastKnownRequestProcessed)
- XEN_NARGIFY_1(gxm_XServerVendor_w, gxm_XServerVendor)
- XEN_NARGIFY_1(gxm_XDisplayString_w, gxm_XDisplayString)
- XEN_NARGIFY_2(gxm_XDefaultColormap_w, gxm_XDefaultColormap)
- XEN_NARGIFY_1(gxm_XDefaultColormapOfScreen_w, gxm_XDefaultColormapOfScreen)
- XEN_NARGIFY_1(gxm_XDisplayOfScreen_w, gxm_XDisplayOfScreen)
- XEN_NARGIFY_2(gxm_XScreenOfDisplay_w, gxm_XScreenOfDisplay)
- XEN_NARGIFY_1(gxm_XDefaultScreenOfDisplay_w, gxm_XDefaultScreenOfDisplay)
- XEN_NARGIFY_1(gxm_XEventMaskOfScreen_w, gxm_XEventMaskOfScreen)
- XEN_NARGIFY_1(gxm_XScreenNumberOfScreen_w, gxm_XScreenNumberOfScreen)
- XEN_NARGIFY_1(gxm_XSetErrorHandler_w, gxm_XSetErrorHandler)
- XEN_NARGIFY_1(gxm_XSetIOErrorHandler_w, gxm_XSetIOErrorHandler)
- XEN_NARGIFY_1(gxm_XListPixmapFormats_w, gxm_XListPixmapFormats)
- XEN_NARGIFY_2(gxm_XListDepths_w, gxm_XListDepths)
- XEN_NARGIFY_5(gxm_XReconfigureWMWindow_w, gxm_XReconfigureWMWindow)
- XEN_NARGIFY_2(gxm_XGetWMProtocols_w, gxm_XGetWMProtocols)
- XEN_NARGIFY_4(gxm_XSetWMProtocols_w, gxm_XSetWMProtocols)
- XEN_NARGIFY_3(gxm_XIconifyWindow_w, gxm_XIconifyWindow)
- XEN_NARGIFY_3(gxm_XWithdrawWindow_w, gxm_XWithdrawWindow)
- XEN_NARGIFY_2(gxm_XGetCommand_w, gxm_XGetCommand)
- XEN_NARGIFY_2(gxm_XGetWMColormapWindows_w, gxm_XGetWMColormapWindows)
- XEN_NARGIFY_4(gxm_XSetWMColormapWindows_w, gxm_XSetWMColormapWindows)
- XEN_NARGIFY_3(gxm_XSetTransientForHint_w, gxm_XSetTransientForHint)
- XEN_NARGIFY_1(gxm_XActivateScreenSaver_w, gxm_XActivateScreenSaver)
- XEN_NARGIFY_3(gxm_XAllocColor_w, gxm_XAllocColor)
- XEN_NARGIFY_5(gxm_XAllocColorCells_w, gxm_XAllocColorCells)
- XEN_VARGIFY(gxm_XAllocColorPlanes_w, gxm_XAllocColorPlanes)
- XEN_NARGIFY_5(gxm_XAllocNamedColor_w, gxm_XAllocNamedColor)
- XEN_NARGIFY_3(gxm_XAllowEvents_w, gxm_XAllowEvents)
- XEN_NARGIFY_1(gxm_XAutoRepeatOff_w, gxm_XAutoRepeatOff)
- XEN_NARGIFY_1(gxm_XAutoRepeatOn_w, gxm_XAutoRepeatOn)
- XEN_NARGIFY_2(gxm_XBell_w, gxm_XBell)
- XEN_NARGIFY_1(gxm_XBitmapBitOrder_w, gxm_XBitmapBitOrder)
- XEN_NARGIFY_1(gxm_XBitmapPad_w, gxm_XBitmapPad)
- XEN_NARGIFY_1(gxm_XBitmapUnit_w, gxm_XBitmapUnit)
- XEN_NARGIFY_1(gxm_XCellsOfScreen_w, gxm_XCellsOfScreen)
- XEN_NARGIFY_4(gxm_XChangeActivePointerGrab_w, gxm_XChangeActivePointerGrab)
- XEN_NARGIFY_4(gxm_XChangeGC_w, gxm_XChangeGC)
- XEN_NARGIFY_3(gxm_XChangeKeyboardControl_w, gxm_XChangeKeyboardControl)
- XEN_NARGIFY_5(gxm_XChangeKeyboardMapping_w, gxm_XChangeKeyboardMapping)
- XEN_NARGIFY_6(gxm_XChangePointerControl_w, gxm_XChangePointerControl)
- XEN_ARGIFY_8(gxm_XChangeProperty_w, gxm_XChangeProperty)
- XEN_NARGIFY_4(gxm_XChangeWindowAttributes_w, gxm_XChangeWindowAttributes)
- XEN_NARGIFY_3(gxm_XCheckIfEvent_w, gxm_XCheckIfEvent)
- XEN_NARGIFY_2(gxm_XCheckMaskEvent_w, gxm_XCheckMaskEvent)
- XEN_NARGIFY_2(gxm_XCheckTypedEvent_w, gxm_XCheckTypedEvent)
- XEN_NARGIFY_3(gxm_XCheckTypedWindowEvent_w, gxm_XCheckTypedWindowEvent)
- XEN_NARGIFY_3(gxm_XCheckWindowEvent_w, gxm_XCheckWindowEvent)
- XEN_NARGIFY_3(gxm_XCirculateSubwindows_w, gxm_XCirculateSubwindows)
- XEN_NARGIFY_2(gxm_XCirculateSubwindowsDown_w, gxm_XCirculateSubwindowsDown)
- XEN_NARGIFY_2(gxm_XCirculateSubwindowsUp_w, gxm_XCirculateSubwindowsUp)
- XEN_NARGIFY_7(gxm_XClearArea_w, gxm_XClearArea)
- XEN_NARGIFY_2(gxm_XClearWindow_w, gxm_XClearWindow)
- XEN_NARGIFY_1(gxm_XCloseDisplay_w, gxm_XCloseDisplay)
- XEN_NARGIFY_4(gxm_XConfigureWindow_w, gxm_XConfigureWindow)
- XEN_NARGIFY_1(gxm_XConnectionNumber_w, gxm_XConnectionNumber)
- XEN_NARGIFY_6(gxm_XConvertSelection_w, gxm_XConvertSelection)
- XEN_VARGIFY(gxm_XCopyArea_w, gxm_XCopyArea)
- XEN_NARGIFY_4(gxm_XCopyGC_w, gxm_XCopyGC)
- XEN_VARGIFY(gxm_XCopyPlane_w, gxm_XCopyPlane)
- XEN_NARGIFY_2(gxm_XDefaultDepth_w, gxm_XDefaultDepth)
- XEN_NARGIFY_1(gxm_XDefaultDepthOfScreen_w, gxm_XDefaultDepthOfScreen)
- XEN_NARGIFY_1(gxm_XDefaultScreen_w, gxm_XDefaultScreen)
- XEN_NARGIFY_3(gxm_XDefineCursor_w, gxm_XDefineCursor)
- XEN_NARGIFY_3(gxm_XDeleteProperty_w, gxm_XDeleteProperty)
- XEN_NARGIFY_2(gxm_XDestroyWindow_w, gxm_XDestroyWindow)
- XEN_NARGIFY_2(gxm_XDestroySubwindows_w, gxm_XDestroySubwindows)
- XEN_NARGIFY_1(gxm_XDoesBackingStore_w, gxm_XDoesBackingStore)
- XEN_NARGIFY_1(gxm_XDoesSaveUnders_w, gxm_XDoesSaveUnders)
- XEN_NARGIFY_1(gxm_XDisableAccessControl_w, gxm_XDisableAccessControl)
- XEN_NARGIFY_2(gxm_XDisplayCells_w, gxm_XDisplayCells)
- XEN_NARGIFY_2(gxm_XDisplayHeight_w, gxm_XDisplayHeight)
- XEN_NARGIFY_2(gxm_XDisplayHeightMM_w, gxm_XDisplayHeightMM)
- XEN_NARGIFY_1(gxm_XDisplayKeycodes_w, gxm_XDisplayKeycodes)
- XEN_NARGIFY_2(gxm_XDisplayPlanes_w, gxm_XDisplayPlanes)
- XEN_NARGIFY_2(gxm_XDisplayWidth_w, gxm_XDisplayWidth)
- XEN_NARGIFY_2(gxm_XDisplayWidthMM_w, gxm_XDisplayWidthMM)
- XEN_NARGIFY_9(gxm_XDrawArc_w, gxm_XDrawArc)
- XEN_NARGIFY_5(gxm_XDrawArcs_w, gxm_XDrawArcs)
- XEN_NARGIFY_7(gxm_XDrawImageString_w, gxm_XDrawImageString)
- XEN_NARGIFY_7(gxm_XDrawLine_w, gxm_XDrawLine)
- XEN_NARGIFY_6(gxm_XDrawLines_w, gxm_XDrawLines)
- XEN_NARGIFY_6(gxm_XDrawLinesDirect_w, gxm_XDrawLinesDirect)
- XEN_NARGIFY_1(gxm_FreeXPoints_w, gxm_FreeXPoints)
- XEN_NARGIFY_1(gxm_Vector2XPoints_w, gxm_Vector2XPoints)
- XEN_NARGIFY_5(gxm_XDrawPoint_w, gxm_XDrawPoint)
- XEN_NARGIFY_6(gxm_XDrawPoints_w, gxm_XDrawPoints)
- XEN_NARGIFY_7(gxm_XDrawRectangle_w, gxm_XDrawRectangle)
- XEN_NARGIFY_5(gxm_XDrawRectangles_w, gxm_XDrawRectangles)
- XEN_NARGIFY_5(gxm_XDrawSegments_w, gxm_XDrawSegments)
- XEN_NARGIFY_7(gxm_XDrawString_w, gxm_XDrawString)
- XEN_ARGIFY_7(gxm_XDrawText_w, gxm_XDrawText)
- XEN_NARGIFY_1(gxm_XEnableAccessControl_w, gxm_XEnableAccessControl)
- XEN_NARGIFY_2(gxm_XEventsQueued_w, gxm_XEventsQueued)
- XEN_NARGIFY_2(gxm_XFetchName_w, gxm_XFetchName)
- XEN_NARGIFY_9(gxm_XFillArc_w, gxm_XFillArc)
- XEN_NARGIFY_5(gxm_XFillArcs_w, gxm_XFillArcs)
- XEN_NARGIFY_7(gxm_XFillPolygon_w, gxm_XFillPolygon)
- XEN_NARGIFY_7(gxm_XFillRectangle_w, gxm_XFillRectangle)
- XEN_NARGIFY_5(gxm_XFillRectangles_w, gxm_XFillRectangles)
- XEN_NARGIFY_1(gxm_XFlush_w, gxm_XFlush)
- XEN_NARGIFY_2(gxm_XForceScreenSaver_w, gxm_XForceScreenSaver)
- XEN_NARGIFY_1(gxm_XFree_w, gxm_XFree)
- XEN_NARGIFY_2(gxm_XFreeColormap_w, gxm_XFreeColormap)
- XEN_NARGIFY_5(gxm_XFreeColors_w, gxm_XFreeColors)
- XEN_NARGIFY_2(gxm_XFreeCursor_w, gxm_XFreeCursor)
- XEN_NARGIFY_1(gxm_XFreeExtensionList_w, gxm_XFreeExtensionList)
- XEN_NARGIFY_2(gxm_XFreeFont_w, gxm_XFreeFont)
- XEN_NARGIFY_3(gxm_XFreeFontInfo_w, gxm_XFreeFontInfo)
- XEN_NARGIFY_1(gxm_XFreeFontNames_w, gxm_XFreeFontNames)
- XEN_NARGIFY_1(gxm_XFreeFontPath_w, gxm_XFreeFontPath)
- XEN_NARGIFY_2(gxm_XFreeGC_w, gxm_XFreeGC)
- XEN_NARGIFY_1(gxm_XFreeModifiermap_w, gxm_XFreeModifiermap)
- XEN_NARGIFY_2(gxm_XFreePixmap_w, gxm_XFreePixmap)
- XEN_VARGIFY(gxm_XGeometry_w, gxm_XGeometry)
- XEN_NARGIFY_4(gxm_XGetErrorText_w, gxm_XGetErrorText)
- XEN_NARGIFY_2(gxm_XGetFontProperty_w, gxm_XGetFontProperty)
- XEN_NARGIFY_3(gxm_XGetGCValues_w, gxm_XGetGCValues)
- XEN_NARGIFY_0(gxm_XGCValues_w, gxm_XGCValues)
- XEN_ARGIFY_1(gxm_XEvent_w, gxm_XEvent)
- XEN_NARGIFY_2(gxm_XGetGeometry_w, gxm_XGetGeometry)
- XEN_NARGIFY_2(gxm_XGetIconName_w, gxm_XGetIconName)
- XEN_NARGIFY_1(gxm_XGetInputFocus_w, gxm_XGetInputFocus)
- XEN_NARGIFY_1(gxm_XGetKeyboardControl_w, gxm_XGetKeyboardControl)
- XEN_NARGIFY_1(gxm_XGetPointerControl_w, gxm_XGetPointerControl)
- XEN_NARGIFY_3(gxm_XGetPointerMapping_w, gxm_XGetPointerMapping)
- XEN_NARGIFY_1(gxm_XGetScreenSaver_w, gxm_XGetScreenSaver)
- XEN_NARGIFY_2(gxm_XGetTransientForHint_w, gxm_XGetTransientForHint)
- XEN_VARGIFY(gxm_XGetWindowProperty_w, gxm_XGetWindowProperty)
- XEN_NARGIFY_2(gxm_XGetWindowAttributes_w, gxm_XGetWindowAttributes)
- XEN_VARGIFY(gxm_XGrabButton_w, gxm_XGrabButton)
- XEN_NARGIFY_7(gxm_XGrabKey_w, gxm_XGrabKey)
- XEN_NARGIFY_6(gxm_XGrabKeyboard_w, gxm_XGrabKeyboard)
- XEN_NARGIFY_9(gxm_XGrabPointer_w, gxm_XGrabPointer)
- XEN_NARGIFY_1(gxm_XGrabServer_w, gxm_XGrabServer)
- XEN_NARGIFY_1(gxm_XHeightMMOfScreen_w, gxm_XHeightMMOfScreen)
- XEN_NARGIFY_1(gxm_XHeightOfScreen_w, gxm_XHeightOfScreen)
- XEN_NARGIFY_3(gxm_XIfEvent_w, gxm_XIfEvent)
- XEN_NARGIFY_1(gxm_XImageByteOrder_w, gxm_XImageByteOrder)
- XEN_NARGIFY_2(gxm_XInstallColormap_w, gxm_XInstallColormap)
- XEN_NARGIFY_2(gxm_XKeysymToKeycode_w, gxm_XKeysymToKeycode)
- XEN_NARGIFY_2(gxm_XKillClient_w, gxm_XKillClient)
- XEN_NARGIFY_5(gxm_XLookupColor_w, gxm_XLookupColor)
- XEN_NARGIFY_2(gxm_XLowerWindow_w, gxm_XLowerWindow)
- XEN_NARGIFY_2(gxm_XMapRaised_w, gxm_XMapRaised)
- XEN_NARGIFY_2(gxm_XMapSubwindows_w, gxm_XMapSubwindows)
- XEN_NARGIFY_2(gxm_XMapWindow_w, gxm_XMapWindow)
- XEN_NARGIFY_2(gxm_XMaskEvent_w, gxm_XMaskEvent)
- XEN_NARGIFY_1(gxm_XMaxCmapsOfScreen_w, gxm_XMaxCmapsOfScreen)
- XEN_NARGIFY_1(gxm_XMinCmapsOfScreen_w, gxm_XMinCmapsOfScreen)
- XEN_NARGIFY_6(gxm_XMoveResizeWindow_w, gxm_XMoveResizeWindow)
- XEN_NARGIFY_4(gxm_XMoveWindow_w, gxm_XMoveWindow)
- XEN_NARGIFY_1(gxm_XNextEvent_w, gxm_XNextEvent)
- XEN_NARGIFY_1(gxm_XNoOp_w, gxm_XNoOp)
- XEN_NARGIFY_4(gxm_XParseColor_w, gxm_XParseColor)
- XEN_NARGIFY_1(gxm_XParseGeometry_w, gxm_XParseGeometry)
- XEN_NARGIFY_1(gxm_XPeekEvent_w, gxm_XPeekEvent)
- XEN_NARGIFY_3(gxm_XPeekIfEvent_w, gxm_XPeekIfEvent)
- XEN_NARGIFY_1(gxm_XPending_w, gxm_XPending)
- XEN_NARGIFY_1(gxm_XPlanesOfScreen_w, gxm_XPlanesOfScreen)
- XEN_NARGIFY_1(gxm_XProtocolRevision_w, gxm_XProtocolRevision)
- XEN_NARGIFY_1(gxm_XProtocolVersion_w, gxm_XProtocolVersion)
- XEN_NARGIFY_2(gxm_XPutBackEvent_w, gxm_XPutBackEvent)
- XEN_VARGIFY(gxm_XPutImage_w, gxm_XPutImage)
- XEN_NARGIFY_1(gxm_XQLength_w, gxm_XQLength)
- XEN_NARGIFY_4(gxm_XQueryBestCursor_w, gxm_XQueryBestCursor)
- XEN_NARGIFY_5(gxm_XQueryBestSize_w, gxm_XQueryBestSize)
- XEN_NARGIFY_4(gxm_XQueryBestStipple_w, gxm_XQueryBestStipple)
- XEN_NARGIFY_4(gxm_XQueryBestTile_w, gxm_XQueryBestTile)
- XEN_NARGIFY_3(gxm_XQueryColor_w, gxm_XQueryColor)
- XEN_ARGIFY_4(gxm_XQueryColors_w, gxm_XQueryColors)
- XEN_NARGIFY_2(gxm_XQueryExtension_w, gxm_XQueryExtension)
- XEN_NARGIFY_1(gxm_XQueryKeymap_w, gxm_XQueryKeymap)
- XEN_NARGIFY_2(gxm_XQueryPointer_w, gxm_XQueryPointer)
- XEN_NARGIFY_3(gxm_XQueryTextExtents_w, gxm_XQueryTextExtents)
- XEN_NARGIFY_2(gxm_XQueryTree_w, gxm_XQueryTree)
- XEN_NARGIFY_2(gxm_XRaiseWindow_w, gxm_XRaiseWindow)
- XEN_NARGIFY_3(gxm_XReadBitmapFile_w, gxm_XReadBitmapFile)
- XEN_NARGIFY_1(gxm_XReadBitmapFileData_w, gxm_XReadBitmapFileData)
- XEN_NARGIFY_6(gxm_XRebindKeysym_w, gxm_XRebindKeysym)
- XEN_NARGIFY_4(gxm_XRecolorCursor_w, gxm_XRecolorCursor)
- XEN_NARGIFY_1(gxm_XRefreshKeyboardMapping_w, gxm_XRefreshKeyboardMapping)
- XEN_NARGIFY_5(gxm_XReparentWindow_w, gxm_XReparentWindow)
- XEN_NARGIFY_1(gxm_XResetScreenSaver_w, gxm_XResetScreenSaver)
- XEN_NARGIFY_4(gxm_XResizeWindow_w, gxm_XResizeWindow)
- XEN_NARGIFY_3(gxm_XRestackWindows_w, gxm_XRestackWindows)
- XEN_NARGIFY_2(gxm_XRotateBuffers_w, gxm_XRotateBuffers)
- XEN_NARGIFY_5(gxm_XRotateWindowProperties_w, gxm_XRotateWindowProperties)
- XEN_NARGIFY_1(gxm_XScreenCount_w, gxm_XScreenCount)
- XEN_NARGIFY_3(gxm_XSelectInput_w, gxm_XSelectInput)
- XEN_NARGIFY_5(gxm_XSendEvent_w, gxm_XSendEvent)
- XEN_NARGIFY_2(gxm_XSetAccessControl_w, gxm_XSetAccessControl)
- XEN_NARGIFY_3(gxm_XSetArcMode_w, gxm_XSetArcMode)
- XEN_NARGIFY_3(gxm_XSetBackground_w, gxm_XSetBackground)
- XEN_NARGIFY_3(gxm_XSetClipMask_w, gxm_XSetClipMask)
- XEN_NARGIFY_4(gxm_XSetClipOrigin_w, gxm_XSetClipOrigin)
- XEN_NARGIFY_7(gxm_XSetClipRectangles_w, gxm_XSetClipRectangles)
- XEN_NARGIFY_2(gxm_XSetCloseDownMode_w, gxm_XSetCloseDownMode)
- XEN_NARGIFY_4(gxm_XSetCommand_w, gxm_XSetCommand)
- XEN_ARGIFY_5(gxm_XSetDashes_w, gxm_XSetDashes)
- XEN_NARGIFY_3(gxm_XSetFillRule_w, gxm_XSetFillRule)
- XEN_NARGIFY_3(gxm_XSetFillStyle_w, gxm_XSetFillStyle)
- XEN_NARGIFY_3(gxm_XSetFont_w, gxm_XSetFont)
- XEN_NARGIFY_3(gxm_XSetFontPath_w, gxm_XSetFontPath)
- XEN_NARGIFY_3(gxm_XSetForeground_w, gxm_XSetForeground)
- XEN_NARGIFY_3(gxm_XSetFunction_w, gxm_XSetFunction)
- XEN_NARGIFY_3(gxm_XSetGraphicsExposures_w, gxm_XSetGraphicsExposures)
- XEN_NARGIFY_3(gxm_XSetIconName_w, gxm_XSetIconName)
- XEN_NARGIFY_4(gxm_XSetInputFocus_w, gxm_XSetInputFocus)
- XEN_NARGIFY_6(gxm_XSetLineAttributes_w, gxm_XSetLineAttributes)
- XEN_NARGIFY_2(gxm_XSetModifierMapping_w, gxm_XSetModifierMapping)
- XEN_NARGIFY_3(gxm_XSetPlaneMask_w, gxm_XSetPlaneMask)
- XEN_ARGIFY_3(gxm_XSetPointerMapping_w, gxm_XSetPointerMapping)
- XEN_NARGIFY_5(gxm_XSetScreenSaver_w, gxm_XSetScreenSaver)
- XEN_NARGIFY_4(gxm_XSetSelectionOwner_w, gxm_XSetSelectionOwner)
- XEN_NARGIFY_6(gxm_XSetState_w, gxm_XSetState)
- XEN_NARGIFY_3(gxm_XSetStipple_w, gxm_XSetStipple)
- XEN_NARGIFY_3(gxm_XSetSubwindowMode_w, gxm_XSetSubwindowMode)
- XEN_NARGIFY_4(gxm_XSetTSOrigin_w, gxm_XSetTSOrigin)
- XEN_NARGIFY_3(gxm_XSetTile_w, gxm_XSetTile)
- XEN_NARGIFY_3(gxm_XSetWindowBackground_w, gxm_XSetWindowBackground)
- XEN_NARGIFY_3(gxm_XSetWindowBackgroundPixmap_w, gxm_XSetWindowBackgroundPixmap)
- XEN_NARGIFY_3(gxm_XSetWindowBorder_w, gxm_XSetWindowBorder)
- XEN_NARGIFY_3(gxm_XSetWindowBorderPixmap_w, gxm_XSetWindowBorderPixmap)
- XEN_NARGIFY_3(gxm_XSetWindowBorderWidth_w, gxm_XSetWindowBorderWidth)
- XEN_NARGIFY_3(gxm_XSetWindowColormap_w, gxm_XSetWindowColormap)
- XEN_NARGIFY_4(gxm_XStoreBuffer_w, gxm_XStoreBuffer)
- XEN_NARGIFY_3(gxm_XStoreBytes_w, gxm_XStoreBytes)
- XEN_NARGIFY_3(gxm_XStoreColor_w, gxm_XStoreColor)
- XEN_NARGIFY_4(gxm_XStoreColors_w, gxm_XStoreColors)
- XEN_NARGIFY_3(gxm_XStoreName_w, gxm_XStoreName)
- XEN_NARGIFY_5(gxm_XStoreNamedColor_w, gxm_XStoreNamedColor)
- XEN_NARGIFY_2(gxm_XSync_w, gxm_XSync)
- XEN_NARGIFY_3(gxm_XTextExtents_w, gxm_XTextExtents)
- XEN_NARGIFY_3(gxm_XTextWidth_w, gxm_XTextWidth)
- XEN_NARGIFY_5(gxm_XTranslateCoordinates_w, gxm_XTranslateCoordinates)
- XEN_NARGIFY_2(gxm_XUndefineCursor_w, gxm_XUndefineCursor)
- XEN_NARGIFY_4(gxm_XUngrabButton_w, gxm_XUngrabButton)
- XEN_NARGIFY_4(gxm_XUngrabKey_w, gxm_XUngrabKey)
- XEN_NARGIFY_2(gxm_XUngrabKeyboard_w, gxm_XUngrabKeyboard)
- XEN_NARGIFY_2(gxm_XUngrabPointer_w, gxm_XUngrabPointer)
- XEN_NARGIFY_1(gxm_XUngrabServer_w, gxm_XUngrabServer)
- XEN_NARGIFY_2(gxm_XUninstallColormap_w, gxm_XUninstallColormap)
- XEN_NARGIFY_2(gxm_XUnloadFont_w, gxm_XUnloadFont)
- XEN_NARGIFY_2(gxm_XUnmapSubwindows_w, gxm_XUnmapSubwindows)
- XEN_NARGIFY_2(gxm_XUnmapWindow_w, gxm_XUnmapWindow)
- XEN_NARGIFY_1(gxm_XVendorRelease_w, gxm_XVendorRelease)
- XEN_NARGIFY_9(gxm_XWarpPointer_w, gxm_XWarpPointer)
- XEN_NARGIFY_1(gxm_XWidthMMOfScreen_w, gxm_XWidthMMOfScreen)
- XEN_NARGIFY_1(gxm_XWidthOfScreen_w, gxm_XWidthOfScreen)
- XEN_NARGIFY_3(gxm_XWindowEvent_w, gxm_XWindowEvent)
- XEN_NARGIFY_7(gxm_XWriteBitmapFile_w, gxm_XWriteBitmapFile)
- XEN_NARGIFY_0(gxm_XSupportsLocale_w, gxm_XSupportsLocale)
- XEN_NARGIFY_1(gxm_XSetLocaleModifiers_w, gxm_XSetLocaleModifiers)
- XEN_NARGIFY_2(gxm_XCreateFontSet_w, gxm_XCreateFontSet)
- XEN_NARGIFY_2(gxm_XFreeFontSet_w, gxm_XFreeFontSet)
- XEN_NARGIFY_1(gxm_XFontsOfFontSet_w, gxm_XFontsOfFontSet)
- XEN_NARGIFY_1(gxm_XBaseFontNameListOfFontSet_w, gxm_XBaseFontNameListOfFontSet)
- XEN_NARGIFY_1(gxm_XLocaleOfFontSet_w, gxm_XLocaleOfFontSet)
- XEN_NARGIFY_1(gxm_XContextDependentDrawing_w, gxm_XContextDependentDrawing)
- XEN_NARGIFY_1(gxm_XDirectionalDependentDrawing_w, gxm_XDirectionalDependentDrawing)
- XEN_NARGIFY_1(gxm_XContextualDrawing_w, gxm_XContextualDrawing)
- XEN_NARGIFY_2(gxm_XFilterEvent_w, gxm_XFilterEvent)
- XEN_NARGIFY_0(gxm_XAllocIconSize_w, gxm_XAllocIconSize)
- XEN_NARGIFY_0(gxm_XAllocStandardColormap_w, gxm_XAllocStandardColormap)
- XEN_NARGIFY_0(gxm_XAllocWMHints_w, gxm_XAllocWMHints)
- XEN_NARGIFY_1(gxm_XClipBox_w, gxm_XClipBox)
- XEN_NARGIFY_0(gxm_XCreateRegion_w, gxm_XCreateRegion)
- XEN_NARGIFY_0(gxm_XDefaultString_w, gxm_XDefaultString)
- XEN_NARGIFY_3(gxm_XDeleteContext_w, gxm_XDeleteContext)
- XEN_NARGIFY_1(gxm_XDestroyRegion_w, gxm_XDestroyRegion)
- XEN_NARGIFY_1(gxm_XEmptyRegion_w, gxm_XEmptyRegion)
- XEN_NARGIFY_2(gxm_XEqualRegion_w, gxm_XEqualRegion)
- XEN_NARGIFY_3(gxm_XFindContext_w, gxm_XFindContext)
- XEN_NARGIFY_2(gxm_XGetIconSizes_w, gxm_XGetIconSizes)
- XEN_NARGIFY_3(gxm_XGetRGBColormaps_w, gxm_XGetRGBColormaps)
- XEN_NARGIFY_3(gxm_XGetVisualInfo_w, gxm_XGetVisualInfo)
- XEN_NARGIFY_2(gxm_XGetWMHints_w, gxm_XGetWMHints)
- XEN_NARGIFY_3(gxm_XIntersectRegion_w, gxm_XIntersectRegion)
- XEN_NARGIFY_1(gxm_XConvertCase_w, gxm_XConvertCase)
- XEN_NARGIFY_1(gxm_XLookupString_w, gxm_XLookupString)
- XEN_NARGIFY_4(gxm_XMatchVisualInfo_w, gxm_XMatchVisualInfo)
- XEN_NARGIFY_3(gxm_XOffsetRegion_w, gxm_XOffsetRegion)
- XEN_NARGIFY_3(gxm_XPointInRegion_w, gxm_XPointInRegion)
- XEN_NARGIFY_3(gxm_XPolygonRegion_w, gxm_XPolygonRegion)
- XEN_NARGIFY_5(gxm_XRectInRegion_w, gxm_XRectInRegion)
- XEN_NARGIFY_4(gxm_XSaveContext_w, gxm_XSaveContext)
- XEN_NARGIFY_0(gxm_XUniqueContext_w, gxm_XUniqueContext)
- XEN_NARGIFY_5(gxm_XSetRGBColormaps_w, gxm_XSetRGBColormaps)
- XEN_NARGIFY_3(gxm_XSetWMHints_w, gxm_XSetWMHints)
- XEN_NARGIFY_3(gxm_XSetRegion_w, gxm_XSetRegion)
- XEN_NARGIFY_8(gxm_XSetWMProperties_w, gxm_XSetWMProperties)
- XEN_NARGIFY_3(gxm_XShrinkRegion_w, gxm_XShrinkRegion)
- XEN_NARGIFY_3(gxm_XSubtractRegion_w, gxm_XSubtractRegion)
- XEN_NARGIFY_3(gxm_XUnionRectWithRegion_w, gxm_XUnionRectWithRegion)
- XEN_NARGIFY_3(gxm_XUnionRegion_w, gxm_XUnionRegion)
- XEN_NARGIFY_3(gxm_XXorRegion_w, gxm_XXorRegion)
-
- XEN_NARGIFY_1(gxm_DefaultScreen_w, gxm_DefaultScreen)
- XEN_NARGIFY_1(gxm_DefaultRootWindow_w, gxm_DefaultRootWindow)
- XEN_NARGIFY_1(gxm_QLength_w, gxm_QLength)
- XEN_NARGIFY_1(gxm_ScreenCount_w, gxm_ScreenCount)
- XEN_NARGIFY_1(gxm_ServerVendor_w, gxm_ServerVendor)
- XEN_NARGIFY_1(gxm_ProtocolVersion_w, gxm_ProtocolVersion)
- XEN_NARGIFY_1(gxm_ProtocolRevision_w, gxm_ProtocolRevision)
- XEN_NARGIFY_1(gxm_VendorRelease_w, gxm_VendorRelease)
- XEN_NARGIFY_1(gxm_DisplayString_w, gxm_DisplayString)
- XEN_NARGIFY_1(gxm_BitmapUnit_w, gxm_BitmapUnit)
- XEN_NARGIFY_1(gxm_BitmapBitOrder_w, gxm_BitmapBitOrder)
- XEN_NARGIFY_1(gxm_BitmapPad_w, gxm_BitmapPad)
- XEN_NARGIFY_1(gxm_ImageByteOrder_w, gxm_ImageByteOrder)
- XEN_NARGIFY_1(gxm_NextRequest_w, gxm_NextRequest)
- XEN_NARGIFY_1(gxm_LastKnownRequestProcessed_w, gxm_LastKnownRequestProcessed)
- XEN_NARGIFY_1(gxm_DefaultScreenOfDisplay_w, gxm_DefaultScreenOfDisplay)
- XEN_NARGIFY_1(gxm_DisplayOfScreen_w, gxm_DisplayOfScreen)
- XEN_NARGIFY_1(gxm_RootWindowOfScreen_w, gxm_RootWindowOfScreen)
- XEN_NARGIFY_1(gxm_BlackPixelOfScreen_w, gxm_BlackPixelOfScreen)
- XEN_NARGIFY_1(gxm_WhitePixelOfScreen_w, gxm_WhitePixelOfScreen)
- XEN_NARGIFY_1(gxm_DefaultColormapOfScreen_w, gxm_DefaultColormapOfScreen)
- XEN_NARGIFY_1(gxm_DefaultDepthOfScreen_w, gxm_DefaultDepthOfScreen)
- XEN_NARGIFY_1(gxm_DefaultGCOfScreen_w, gxm_DefaultGCOfScreen)
- XEN_NARGIFY_1(gxm_DefaultVisualOfScreen_w, gxm_DefaultVisualOfScreen)
- XEN_NARGIFY_1(gxm_WidthOfScreen_w, gxm_WidthOfScreen)
- XEN_NARGIFY_1(gxm_HeightOfScreen_w, gxm_HeightOfScreen)
- XEN_NARGIFY_1(gxm_WidthMMOfScreen_w, gxm_WidthMMOfScreen)
- XEN_NARGIFY_1(gxm_HeightMMOfScreen_w, gxm_HeightMMOfScreen)
- XEN_NARGIFY_1(gxm_PlanesOfScreen_w, gxm_PlanesOfScreen)
- XEN_NARGIFY_1(gxm_CellsOfScreen_w, gxm_CellsOfScreen)
- XEN_NARGIFY_1(gxm_MinCmapsOfScreen_w, gxm_MinCmapsOfScreen)
- XEN_NARGIFY_1(gxm_MaxCmapsOfScreen_w, gxm_MaxCmapsOfScreen)
- XEN_NARGIFY_1(gxm_DoesSaveUnders_w, gxm_DoesSaveUnders)
- XEN_NARGIFY_1(gxm_DoesBackingStore_w, gxm_DoesBackingStore)
- XEN_NARGIFY_1(gxm_EventMaskOfScreen_w, gxm_EventMaskOfScreen)
- XEN_NARGIFY_2(gxm_RootWindow_w, gxm_RootWindow)
- XEN_NARGIFY_2(gxm_DefaultVisual_w, gxm_DefaultVisual)
- XEN_NARGIFY_2(gxm_DefaultGC_w, gxm_DefaultGC)
- XEN_NARGIFY_2(gxm_BlackPixel_w, gxm_BlackPixel)
- XEN_NARGIFY_2(gxm_WhitePixel_w, gxm_WhitePixel)
- XEN_NARGIFY_2(gxm_DisplayWidth_w, gxm_DisplayWidth)
- XEN_NARGIFY_2(gxm_DisplayHeight_w, gxm_DisplayHeight)
- XEN_NARGIFY_2(gxm_DisplayWidthMM_w, gxm_DisplayWidthMM)
- XEN_NARGIFY_2(gxm_DisplayHeightMM_w, gxm_DisplayHeightMM)
- XEN_NARGIFY_2(gxm_DisplayPlanes_w, gxm_DisplayPlanes)
- XEN_NARGIFY_2(gxm_DisplayCells_w, gxm_DisplayCells)
- XEN_NARGIFY_2(gxm_DefaultColormap_w, gxm_DefaultColormap)
- XEN_NARGIFY_2(gxm_ScreenOfDisplay_w, gxm_ScreenOfDisplay)
- XEN_NARGIFY_2(gxm_DefaultDepth_w, gxm_DefaultDepth)
-
- XEN_NARGIFY_1(gxm_IsKeypadKey_w, gxm_IsKeypadKey)
- XEN_NARGIFY_1(gxm_IsPrivateKeypadKey_w, gxm_IsPrivateKeypadKey)
- XEN_NARGIFY_1(gxm_IsCursorKey_w, gxm_IsCursorKey)
- XEN_NARGIFY_1(gxm_IsPFKey_w, gxm_IsPFKey)
- XEN_NARGIFY_1(gxm_IsFunctionKey_w, gxm_IsFunctionKey)
- XEN_NARGIFY_1(gxm_IsMiscFunctionKey_w, gxm_IsMiscFunctionKey)
- XEN_NARGIFY_1(gxm_IsModifierKey_w, gxm_IsModifierKey)
-
- XEN_NARGIFY_1(XEN_XButtonEvent_p_w, XEN_XButtonEvent_p)
- XEN_NARGIFY_1(XEN_XCirculateEvent_p_w, XEN_XCirculateEvent_p)
- XEN_NARGIFY_1(XEN_XCirculateRequestEvent_p_w, XEN_XCirculateRequestEvent_p)
- XEN_NARGIFY_1(XEN_XClientMessageEvent_p_w, XEN_XClientMessageEvent_p)
- XEN_NARGIFY_1(XEN_XColormapEvent_p_w, XEN_XColormapEvent_p)
- XEN_NARGIFY_1(XEN_XConfigureEvent_p_w, XEN_XConfigureEvent_p)
- XEN_NARGIFY_1(XEN_XConfigureRequestEvent_p_w, XEN_XConfigureRequestEvent_p)
- XEN_NARGIFY_1(XEN_XCreateWindowEvent_p_w, XEN_XCreateWindowEvent_p)
- XEN_NARGIFY_1(XEN_XCrossingEvent_p_w, XEN_XCrossingEvent_p)
- XEN_NARGIFY_1(XEN_XDestroyWindowEvent_p_w, XEN_XDestroyWindowEvent_p)
- XEN_NARGIFY_1(XEN_XErrorEvent_p_w, XEN_XErrorEvent_p)
- XEN_NARGIFY_1(XEN_XExposeEvent_p_w, XEN_XExposeEvent_p)
- XEN_NARGIFY_1(XEN_XFocusChangeEvent_p_w, XEN_XFocusChangeEvent_p)
- XEN_NARGIFY_1(XEN_XGraphicsExposeEvent_p_w, XEN_XGraphicsExposeEvent_p)
- XEN_NARGIFY_1(XEN_XGravityEvent_p_w, XEN_XGravityEvent_p)
- XEN_NARGIFY_1(XEN_XKeyEvent_p_w, XEN_XKeyEvent_p)
- XEN_NARGIFY_1(XEN_XKeymapEvent_p_w, XEN_XKeymapEvent_p)
- XEN_NARGIFY_1(XEN_XMapEvent_p_w, XEN_XMapEvent_p)
- XEN_NARGIFY_1(XEN_XMapRequestEvent_p_w, XEN_XMapRequestEvent_p)
- XEN_NARGIFY_1(XEN_XMappingEvent_p_w, XEN_XMappingEvent_p)
- XEN_NARGIFY_1(XEN_XMotionEvent_p_w, XEN_XMotionEvent_p)
- XEN_NARGIFY_1(XEN_XNoExposeEvent_p_w, XEN_XNoExposeEvent_p)
- XEN_NARGIFY_1(XEN_XPropertyEvent_p_w, XEN_XPropertyEvent_p)
- XEN_NARGIFY_1(XEN_XReparentEvent_p_w, XEN_XReparentEvent_p)
- XEN_NARGIFY_1(XEN_XResizeRequestEvent_p_w, XEN_XResizeRequestEvent_p)
- XEN_NARGIFY_1(XEN_XSelectionClearEvent_p_w, XEN_XSelectionClearEvent_p)
- XEN_NARGIFY_1(XEN_XSelectionEvent_p_w, XEN_XSelectionEvent_p)
- XEN_NARGIFY_1(XEN_XSelectionRequestEvent_p_w, XEN_XSelectionRequestEvent_p)
- XEN_NARGIFY_1(XEN_XSetWindowAttributes_p_w, XEN_XSetWindowAttributes_p)
- XEN_NARGIFY_1(XEN_XUnmapEvent_p_w, XEN_XUnmapEvent_p)
- XEN_NARGIFY_1(XEN_XVisibilityEvent_p_w, XEN_XVisibilityEvent_p)
- XEN_NARGIFY_1(XEN_XIconSize_p_w, XEN_XIconSize_p)
-
-#if HAVE_MOTIF
- XEN_ARGIFY_4(gxm_XmCreateMessageBox_w, gxm_XmCreateMessageBox)
- XEN_ARGIFY_4(gxm_XmCreateMessageDialog_w, gxm_XmCreateMessageDialog)
- XEN_ARGIFY_4(gxm_XmCreateErrorDialog_w, gxm_XmCreateErrorDialog)
- XEN_ARGIFY_4(gxm_XmCreateInformationDialog_w, gxm_XmCreateInformationDialog)
- XEN_ARGIFY_4(gxm_XmCreateQuestionDialog_w, gxm_XmCreateQuestionDialog)
- XEN_ARGIFY_4(gxm_XmCreateWarningDialog_w, gxm_XmCreateWarningDialog)
- XEN_ARGIFY_4(gxm_XmCreateWorkingDialog_w, gxm_XmCreateWorkingDialog)
- XEN_ARGIFY_4(gxm_XmCreateTemplateDialog_w, gxm_XmCreateTemplateDialog)
- XEN_NARGIFY_2(gxm_XmMessageBoxGetChild_w, gxm_XmMessageBoxGetChild)
- XEN_ARGIFY_4(gxm_XmCreateArrowButtonGadget_w, gxm_XmCreateArrowButtonGadget)
- XEN_ARGIFY_4(gxm_XmCreateArrowButton_w, gxm_XmCreateArrowButton)
- XEN_ARGIFY_4(gxm_XmCreateNotebook_w, gxm_XmCreateNotebook)
- XEN_NARGIFY_2(gxm_XmNotebookGetPageInfo_w, gxm_XmNotebookGetPageInfo)
- XEN_NARGIFY_5(gxm_XmTransferSetParameters_w, gxm_XmTransferSetParameters)
- XEN_NARGIFY_2(gxm_XmTransferDone_w, gxm_XmTransferDone)
- XEN_NARGIFY_5(gxm_XmTransferValue_w, gxm_XmTransferValue)
- XEN_NARGIFY_1(gxm_XmTransferStartRequest_w, gxm_XmTransferStartRequest)
- XEN_NARGIFY_2(gxm_XmTransferSendRequest_w, gxm_XmTransferSendRequest)
- XEN_ARGIFY_4(gxm_XmCreateComboBox_w, gxm_XmCreateComboBox)
- XEN_ARGIFY_4(gxm_XmCreateDropDownComboBox_w, gxm_XmCreateDropDownComboBox)
- XEN_ARGIFY_4(gxm_XmCreateDropDownList_w, gxm_XmCreateDropDownList)
- XEN_NARGIFY_4(gxm_XmComboBoxAddItem_w, gxm_XmComboBoxAddItem)
- XEN_NARGIFY_2(gxm_XmComboBoxDeletePos_w, gxm_XmComboBoxDeletePos)
- XEN_NARGIFY_2(gxm_XmComboBoxSelectItem_w, gxm_XmComboBoxSelectItem)
- XEN_NARGIFY_2(gxm_XmComboBoxSetItem_w, gxm_XmComboBoxSetItem)
- XEN_NARGIFY_1(gxm_XmComboBoxUpdate_w, gxm_XmComboBoxUpdate)
- XEN_ARGIFY_4(gxm_XmCreateContainer_w, gxm_XmCreateContainer)
- XEN_NARGIFY_2(gxm_XmContainerGetItemChildren_w, gxm_XmContainerGetItemChildren)
- XEN_NARGIFY_1(gxm_XmContainerRelayout_w, gxm_XmContainerRelayout)
- XEN_NARGIFY_3(gxm_XmContainerReorder_w, gxm_XmContainerReorder)
- XEN_NARGIFY_2(gxm_XmContainerCut_w, gxm_XmContainerCut)
- XEN_NARGIFY_2(gxm_XmContainerCopy_w, gxm_XmContainerCopy)
- XEN_NARGIFY_1(gxm_XmContainerPaste_w, gxm_XmContainerPaste)
- XEN_NARGIFY_2(gxm_XmContainerCopyLink_w, gxm_XmContainerCopyLink)
- XEN_NARGIFY_1(gxm_XmContainerPasteLink_w, gxm_XmContainerPasteLink)
- XEN_ARGIFY_4(gxm_XmCreateSpinBox_w, gxm_XmCreateSpinBox)
- XEN_NARGIFY_1(gxm_XmSpinBoxValidatePosition_w, gxm_XmSpinBoxValidatePosition)
- XEN_ARGIFY_4(gxm_XmCreateSimpleSpinBox_w, gxm_XmCreateSimpleSpinBox)
- XEN_NARGIFY_3(gxm_XmSimpleSpinBoxAddItem_w, gxm_XmSimpleSpinBoxAddItem)
- XEN_NARGIFY_2(gxm_XmSimpleSpinBoxDeletePos_w, gxm_XmSimpleSpinBoxDeletePos)
- XEN_NARGIFY_2(gxm_XmSimpleSpinBoxSetItem_w, gxm_XmSimpleSpinBoxSetItem)
- XEN_NARGIFY_1(gxm_XmDropSiteRegistered_w, gxm_XmDropSiteRegistered)
- XEN_NARGIFY_2(gxm_XmTextFieldCopyLink_w, gxm_XmTextFieldCopyLink)
- XEN_NARGIFY_1(gxm_XmTextFieldPasteLink_w, gxm_XmTextFieldPasteLink)
- XEN_NARGIFY_1(gxm_XmTextGetCenterline_w, gxm_XmTextGetCenterline)
- XEN_NARGIFY_3(gxm_XmToggleButtonGadgetSetValue_w, gxm_XmToggleButtonGadgetSetValue)
- XEN_ARGIFY_4(gxm_XmCreateIconGadget_w, gxm_XmCreateIconGadget)
- XEN_ARGIFY_4(gxm_XmCreateIconHeader_w, gxm_XmCreateIconHeader)
- XEN_NARGIFY_3(gxm_XmObjectAtPoint_w, gxm_XmObjectAtPoint)
- XEN_NARGIFY_4(gxm_XmConvertStringToUnits_w, gxm_XmConvertStringToUnits)
- XEN_ARGIFY_4(gxm_XmCreateGrabShell_w, gxm_XmCreateGrabShell)
- XEN_NARGIFY_3(gxm_XmToggleButtonSetValue_w, gxm_XmToggleButtonSetValue)
- XEN_NARGIFY_1(gxm_XmTextPasteLink_w, gxm_XmTextPasteLink)
- XEN_NARGIFY_2(gxm_XmTextCopyLink_w, gxm_XmTextCopyLink)
- XEN_NARGIFY_7(gxm_XmScaleSetTicks_w, gxm_XmScaleSetTicks)
- XEN_NARGIFY_3(gxm_XmInternAtom_w, gxm_XmInternAtom)
- XEN_NARGIFY_2(gxm_XmGetAtomName_w, gxm_XmGetAtomName)
- XEN_ARGIFY_4(gxm_XmCreatePanedWindow_w, gxm_XmCreatePanedWindow)
- XEN_ARGIFY_4(gxm_XmCreateBulletinBoard_w, gxm_XmCreateBulletinBoard)
- XEN_ARGIFY_4(gxm_XmCreateBulletinBoardDialog_w, gxm_XmCreateBulletinBoardDialog)
- XEN_ARGIFY_4(gxm_XmCreateCascadeButtonGadget_w, gxm_XmCreateCascadeButtonGadget)
- XEN_NARGIFY_2(gxm_XmCascadeButtonGadgetHighlight_w, gxm_XmCascadeButtonGadgetHighlight)
- XEN_ARGIFY_4(gxm_XmAddProtocols_w, gxm_XmAddProtocols)
- XEN_ARGIFY_4(gxm_XmRemoveProtocols_w, gxm_XmRemoveProtocols)
- XEN_NARGIFY_5(gxm_XmAddProtocolCallback_w, gxm_XmAddProtocolCallback)
- XEN_NARGIFY_5(gxm_XmRemoveProtocolCallback_w, gxm_XmRemoveProtocolCallback)
- XEN_NARGIFY_3(gxm_XmActivateProtocol_w, gxm_XmActivateProtocol)
- XEN_NARGIFY_3(gxm_XmDeactivateProtocol_w, gxm_XmDeactivateProtocol)
- XEN_NARGIFY_7(gxm_XmSetProtocolHooks_w, gxm_XmSetProtocolHooks)
- XEN_ARGIFY_4(gxm_XmCreateCascadeButton_w, gxm_XmCreateCascadeButton)
- XEN_NARGIFY_2(gxm_XmCascadeButtonHighlight_w, gxm_XmCascadeButtonHighlight)
- XEN_ARGIFY_4(gxm_XmCreatePushButtonGadget_w, gxm_XmCreatePushButtonGadget)
- XEN_ARGIFY_4(gxm_XmCreatePushButton_w, gxm_XmCreatePushButton)
- XEN_ARGIFY_4(gxm_XmCreateCommand_w, gxm_XmCreateCommand)
- XEN_NARGIFY_2(gxm_XmCommandGetChild_w, gxm_XmCommandGetChild)
- XEN_NARGIFY_2(gxm_XmCommandSetValue_w, gxm_XmCommandSetValue)
- XEN_NARGIFY_2(gxm_XmCommandAppendValue_w, gxm_XmCommandAppendValue)
- XEN_NARGIFY_2(gxm_XmCommandError_w, gxm_XmCommandError)
- XEN_ARGIFY_4(gxm_XmCreateCommandDialog_w, gxm_XmCreateCommandDialog)
- XEN_NARGIFY_2(gxm_XmMenuPosition_w, gxm_XmMenuPosition)
- XEN_ARGIFY_4(gxm_XmCreateRowColumn_w, gxm_XmCreateRowColumn)
- XEN_ARGIFY_4(gxm_XmCreateWorkArea_w, gxm_XmCreateWorkArea)
- XEN_ARGIFY_4(gxm_XmCreateRadioBox_w, gxm_XmCreateRadioBox)
- XEN_ARGIFY_4(gxm_XmCreateOptionMenu_w, gxm_XmCreateOptionMenu)
- XEN_NARGIFY_1(gxm_XmOptionLabelGadget_w, gxm_XmOptionLabelGadget)
- XEN_NARGIFY_1(gxm_XmOptionButtonGadget_w, gxm_XmOptionButtonGadget)
- XEN_ARGIFY_4(gxm_XmCreateMenuBar_w, gxm_XmCreateMenuBar)
- XEN_ARGIFY_4(gxm_XmCreatePopupMenu_w, gxm_XmCreatePopupMenu)
- XEN_ARGIFY_4(gxm_XmCreatePulldownMenu_w, gxm_XmCreatePulldownMenu)
- XEN_NARGIFY_1(gxm_XmGetPostedFromWidget_w, gxm_XmGetPostedFromWidget)
- XEN_NARGIFY_1(gxm_XmGetTearOffControl_w, gxm_XmGetTearOffControl)
- XEN_NARGIFY_2(gxm_XmScaleSetValue_w, gxm_XmScaleSetValue)
- XEN_NARGIFY_1(gxm_XmScaleGetValue_w, gxm_XmScaleGetValue)
- XEN_ARGIFY_4(gxm_XmCreateScale_w, gxm_XmCreateScale)
- XEN_NARGIFY_5(gxm_XmClipboardBeginCopy_w, gxm_XmClipboardBeginCopy)
- XEN_NARGIFY_6(gxm_XmClipboardStartCopy_w, gxm_XmClipboardStartCopy)
- XEN_NARGIFY_7(gxm_XmClipboardCopy_w, gxm_XmClipboardCopy)
- XEN_NARGIFY_3(gxm_XmClipboardEndCopy_w, gxm_XmClipboardEndCopy)
- XEN_NARGIFY_3(gxm_XmClipboardCancelCopy_w, gxm_XmClipboardCancelCopy)
- XEN_NARGIFY_3(gxm_XmClipboardWithdrawFormat_w, gxm_XmClipboardWithdrawFormat)
- XEN_NARGIFY_6(gxm_XmClipboardCopyByName_w, gxm_XmClipboardCopyByName)
- XEN_NARGIFY_2(gxm_XmClipboardUndoCopy_w, gxm_XmClipboardUndoCopy)
- XEN_NARGIFY_2(gxm_XmClipboardLock_w, gxm_XmClipboardLock)
- XEN_NARGIFY_3(gxm_XmClipboardUnlock_w, gxm_XmClipboardUnlock)
- XEN_NARGIFY_3(gxm_XmClipboardStartRetrieve_w, gxm_XmClipboardStartRetrieve)
- XEN_NARGIFY_2(gxm_XmClipboardEndRetrieve_w, gxm_XmClipboardEndRetrieve)
- XEN_NARGIFY_4(gxm_XmClipboardRetrieve_w, gxm_XmClipboardRetrieve)
- XEN_NARGIFY_2(gxm_XmClipboardInquireCount_w, gxm_XmClipboardInquireCount)
- XEN_NARGIFY_4(gxm_XmClipboardInquireFormat_w, gxm_XmClipboardInquireFormat)
- XEN_NARGIFY_3(gxm_XmClipboardInquireLength_w, gxm_XmClipboardInquireLength)
- XEN_NARGIFY_3(gxm_XmClipboardInquirePendingItems_w, gxm_XmClipboardInquirePendingItems)
- XEN_NARGIFY_3(gxm_XmClipboardRegisterFormat_w, gxm_XmClipboardRegisterFormat)
-#if HAVE_XmToolTipGetLabel
- XEN_NARGIFY_1(gxm_XmToolTipGetLabel_w, gxm_XmToolTipGetLabel)
-#endif
- XEN_NARGIFY_1(gxm_XmGetXmScreen_w, gxm_XmGetXmScreen)
-#if HAVE_XmCreateFontSelector
- XEN_ARGIFY_4(gxm_XmCreateFontSelector_w, gxm_XmCreateFontSelector)
-#endif
-#if HAVE_XmCreateColorSelector
- XEN_ARGIFY_4(gxm_XmCreateColorSelector_w, gxm_XmCreateColorSelector)
-#endif
- XEN_ARGIFY_4(gxm_XmCreateScrollBar_w, gxm_XmCreateScrollBar)
- XEN_NARGIFY_1(gxm_XmScrollBarGetValues_w, gxm_XmScrollBarGetValues)
- XEN_NARGIFY_6(gxm_XmScrollBarSetValues_w, gxm_XmScrollBarSetValues)
- XEN_ARGIFY_4(gxm_XmCreateDialogShell_w, gxm_XmCreateDialogShell)
- XEN_ARGIFY_4(gxm_XmCreateScrolledWindow_w, gxm_XmCreateScrolledWindow)
- XEN_NARGIFY_4(gxm_XmScrollVisible_w, gxm_XmScrollVisible)
- XEN_NARGIFY_2(gxm_XmGetDragContext_w, gxm_XmGetDragContext)
- XEN_NARGIFY_1(gxm_XmGetXmDisplay_w, gxm_XmGetXmDisplay)
- XEN_NARGIFY_2(gxm_XmSelectionBoxGetChild_w, gxm_XmSelectionBoxGetChild)
- XEN_ARGIFY_4(gxm_XmCreateSelectionBox_w, gxm_XmCreateSelectionBox)
- XEN_ARGIFY_4(gxm_XmCreateSelectionDialog_w, gxm_XmCreateSelectionDialog)
- XEN_ARGIFY_4(gxm_XmCreatePromptDialog_w, gxm_XmCreatePromptDialog)
- XEN_ARGIFY_4(gxm_XmDragStart_w, gxm_XmDragStart)
- XEN_NARGIFY_1(gxm_XmDragCancel_w, gxm_XmDragCancel)
- XEN_NARGIFY_5(gxm_XmTargetsAreCompatible_w, gxm_XmTargetsAreCompatible)
- XEN_ARGIFY_4(gxm_XmCreateSeparatorGadget_w, gxm_XmCreateSeparatorGadget)
- XEN_ARGIFY_4(gxm_XmCreateDragIcon_w, gxm_XmCreateDragIcon)
- XEN_ARGIFY_4(gxm_XmCreateSeparator_w, gxm_XmCreateSeparator)
- XEN_ARGIFY_4(gxm_XmCreateDrawingArea_w, gxm_XmCreateDrawingArea)
- XEN_ARGIFY_4(gxm_XmCreateDrawnButton_w, gxm_XmCreateDrawnButton)
- XEN_ARGIFY_3(gxm_XmDropSiteRegister_w, gxm_XmDropSiteRegister)
- XEN_NARGIFY_1(gxm_XmDropSiteUnregister_w, gxm_XmDropSiteUnregister)
- XEN_NARGIFY_1(gxm_XmDropSiteStartUpdate_w, gxm_XmDropSiteStartUpdate)
- XEN_ARGIFY_3(gxm_XmDropSiteUpdate_w, gxm_XmDropSiteUpdate)
- XEN_NARGIFY_1(gxm_XmDropSiteEndUpdate_w, gxm_XmDropSiteEndUpdate)
- XEN_ARGIFY_3(gxm_XmDropSiteRetrieve_w, gxm_XmDropSiteRetrieve)
- XEN_NARGIFY_1(gxm_XmDropSiteQueryStackingOrder_w, gxm_XmDropSiteQueryStackingOrder)
- XEN_NARGIFY_3(gxm_XmDropSiteConfigureStackingOrder_w, gxm_XmDropSiteConfigureStackingOrder)
- XEN_ARGIFY_3(gxm_XmDropTransferStart_w, gxm_XmDropTransferStart)
- XEN_NARGIFY_2(gxm_XmDropTransferAdd_w, gxm_XmDropTransferAdd)
- XEN_NARGIFY_1(gxm_XmTextFieldGetString_w, gxm_XmTextFieldGetString)
- XEN_NARGIFY_3(gxm_XmTextFieldGetSubstring_w, gxm_XmTextFieldGetSubstring)
- XEN_NARGIFY_1(gxm_XmTextFieldGetLastPosition_w, gxm_XmTextFieldGetLastPosition)
- XEN_NARGIFY_2(gxm_XmTextFieldSetString_w, gxm_XmTextFieldSetString)
- XEN_NARGIFY_4(gxm_XmTextFieldReplace_w, gxm_XmTextFieldReplace)
- XEN_NARGIFY_3(gxm_XmTextFieldInsert_w, gxm_XmTextFieldInsert)
- XEN_NARGIFY_2(gxm_XmTextFieldSetAddMode_w, gxm_XmTextFieldSetAddMode)
- XEN_NARGIFY_1(gxm_XmTextFieldGetAddMode_w, gxm_XmTextFieldGetAddMode)
- XEN_NARGIFY_1(gxm_XmTextFieldGetEditable_w, gxm_XmTextFieldGetEditable)
- XEN_NARGIFY_2(gxm_XmTextFieldSetEditable_w, gxm_XmTextFieldSetEditable)
- XEN_NARGIFY_1(gxm_XmTextFieldGetMaxLength_w, gxm_XmTextFieldGetMaxLength)
- XEN_NARGIFY_2(gxm_XmTextFieldSetMaxLength_w, gxm_XmTextFieldSetMaxLength)
- XEN_NARGIFY_1(gxm_XmTextFieldGetCursorPosition_w, gxm_XmTextFieldGetCursorPosition)
- XEN_NARGIFY_1(gxm_XmTextFieldGetInsertionPosition_w, gxm_XmTextFieldGetInsertionPosition)
- XEN_NARGIFY_2(gxm_XmTextFieldSetCursorPosition_w, gxm_XmTextFieldSetCursorPosition)
- XEN_NARGIFY_2(gxm_XmTextFieldSetInsertionPosition_w, gxm_XmTextFieldSetInsertionPosition)
- XEN_NARGIFY_1(gxm_XmTextFieldGetSelectionPosition_w, gxm_XmTextFieldGetSelectionPosition)
- XEN_NARGIFY_1(gxm_XmTextFieldGetSelection_w, gxm_XmTextFieldGetSelection)
- XEN_NARGIFY_1(gxm_XmTextFieldRemove_w, gxm_XmTextFieldRemove)
- XEN_NARGIFY_2(gxm_XmTextFieldCopy_w, gxm_XmTextFieldCopy)
- XEN_NARGIFY_2(gxm_XmTextFieldCut_w, gxm_XmTextFieldCut)
- XEN_NARGIFY_1(gxm_XmTextFieldPaste_w, gxm_XmTextFieldPaste)
- XEN_NARGIFY_2(gxm_XmTextFieldClearSelection_w, gxm_XmTextFieldClearSelection)
- XEN_NARGIFY_4(gxm_XmTextFieldSetSelection_w, gxm_XmTextFieldSetSelection)
- XEN_NARGIFY_3(gxm_XmTextFieldXYToPos_w, gxm_XmTextFieldXYToPos)
- XEN_NARGIFY_2(gxm_XmTextFieldPosToXY_w, gxm_XmTextFieldPosToXY)
- XEN_NARGIFY_2(gxm_XmTextFieldShowPosition_w, gxm_XmTextFieldShowPosition)
- XEN_NARGIFY_4(gxm_XmTextFieldSetHighlight_w, gxm_XmTextFieldSetHighlight)
- XEN_NARGIFY_1(gxm_XmTextFieldGetBaseline_w, gxm_XmTextFieldGetBaseline)
- XEN_ARGIFY_4(gxm_XmCreateTextField_w, gxm_XmCreateTextField)
- XEN_NARGIFY_2(gxm_XmFileSelectionBoxGetChild_w, gxm_XmFileSelectionBoxGetChild)
- XEN_NARGIFY_2(gxm_XmFileSelectionDoSearch_w, gxm_XmFileSelectionDoSearch)
- XEN_ARGIFY_4(gxm_XmCreateFileSelectionBox_w, gxm_XmCreateFileSelectionBox)
- XEN_ARGIFY_4(gxm_XmCreateFileSelectionDialog_w, gxm_XmCreateFileSelectionDialog)
- XEN_NARGIFY_4(gxm_XmTextSetHighlight_w, gxm_XmTextSetHighlight)
- XEN_ARGIFY_4(gxm_XmCreateScrolledText_w, gxm_XmCreateScrolledText)
- XEN_ARGIFY_4(gxm_XmCreateText_w, gxm_XmCreateText)
- XEN_NARGIFY_3(gxm_XmTextGetSubstring_w, gxm_XmTextGetSubstring)
- XEN_NARGIFY_1(gxm_XmTextGetString_w, gxm_XmTextGetString)
- XEN_NARGIFY_1(gxm_XmTextGetLastPosition_w, gxm_XmTextGetLastPosition)
- XEN_NARGIFY_2(gxm_XmTextSetString_w, gxm_XmTextSetString)
- XEN_NARGIFY_4(gxm_XmTextReplace_w, gxm_XmTextReplace)
- XEN_NARGIFY_3(gxm_XmTextInsert_w, gxm_XmTextInsert)
- XEN_NARGIFY_2(gxm_XmTextSetAddMode_w, gxm_XmTextSetAddMode)
- XEN_NARGIFY_1(gxm_XmTextGetAddMode_w, gxm_XmTextGetAddMode)
- XEN_NARGIFY_1(gxm_XmTextGetEditable_w, gxm_XmTextGetEditable)
- XEN_NARGIFY_2(gxm_XmTextSetEditable_w, gxm_XmTextSetEditable)
- XEN_NARGIFY_1(gxm_XmTextGetMaxLength_w, gxm_XmTextGetMaxLength)
- XEN_NARGIFY_2(gxm_XmTextSetMaxLength_w, gxm_XmTextSetMaxLength)
- XEN_NARGIFY_1(gxm_XmTextGetTopCharacter_w, gxm_XmTextGetTopCharacter)
- XEN_NARGIFY_2(gxm_XmTextSetTopCharacter_w, gxm_XmTextSetTopCharacter)
- XEN_NARGIFY_1(gxm_XmTextGetCursorPosition_w, gxm_XmTextGetCursorPosition)
- XEN_NARGIFY_1(gxm_XmTextGetInsertionPosition_w, gxm_XmTextGetInsertionPosition)
- XEN_NARGIFY_2(gxm_XmTextSetInsertionPosition_w, gxm_XmTextSetInsertionPosition)
- XEN_NARGIFY_2(gxm_XmTextSetCursorPosition_w, gxm_XmTextSetCursorPosition)
- XEN_NARGIFY_1(gxm_XmTextRemove_w, gxm_XmTextRemove)
- XEN_NARGIFY_2(gxm_XmTextCopy_w, gxm_XmTextCopy)
- XEN_NARGIFY_2(gxm_XmTextCut_w, gxm_XmTextCut)
- XEN_NARGIFY_1(gxm_XmTextPaste_w, gxm_XmTextPaste)
- XEN_NARGIFY_1(gxm_XmTextGetSelection_w, gxm_XmTextGetSelection)
- XEN_NARGIFY_4(gxm_XmTextSetSelection_w, gxm_XmTextSetSelection)
- XEN_NARGIFY_2(gxm_XmTextClearSelection_w, gxm_XmTextClearSelection)
- XEN_NARGIFY_1(gxm_XmTextGetSelectionPosition_w, gxm_XmTextGetSelectionPosition)
- XEN_NARGIFY_3(gxm_XmTextXYToPos_w, gxm_XmTextXYToPos)
- XEN_NARGIFY_2(gxm_XmTextPosToXY_w, gxm_XmTextPosToXY)
- XEN_NARGIFY_1(gxm_XmTextGetSource_w, gxm_XmTextGetSource)
- XEN_NARGIFY_4(gxm_XmTextSetSource_w, gxm_XmTextSetSource)
- XEN_NARGIFY_2(gxm_XmTextShowPosition_w, gxm_XmTextShowPosition)
- XEN_NARGIFY_2(gxm_XmTextScroll_w, gxm_XmTextScroll)
- XEN_NARGIFY_1(gxm_XmTextGetBaseline_w, gxm_XmTextGetBaseline)
- XEN_NARGIFY_1(gxm_XmTextDisableRedisplay_w, gxm_XmTextDisableRedisplay)
- XEN_NARGIFY_1(gxm_XmTextEnableRedisplay_w, gxm_XmTextEnableRedisplay)
- XEN_NARGIFY_4(gxm_XmTextFindString_w, gxm_XmTextFindString)
- XEN_ARGIFY_4(gxm_XmCreateForm_w, gxm_XmCreateForm)
- XEN_ARGIFY_4(gxm_XmCreateFormDialog_w, gxm_XmCreateFormDialog)
- XEN_ARGIFY_4(gxm_XmCreateFrame_w, gxm_XmCreateFrame)
- XEN_NARGIFY_1(gxm_XmToggleButtonGadgetGetState_w, gxm_XmToggleButtonGadgetGetState)
- XEN_NARGIFY_3(gxm_XmToggleButtonGadgetSetState_w, gxm_XmToggleButtonGadgetSetState)
- XEN_ARGIFY_4(gxm_XmCreateToggleButtonGadget_w, gxm_XmCreateToggleButtonGadget)
- XEN_NARGIFY_1(gxm_XmToggleButtonGetState_w, gxm_XmToggleButtonGetState)
- XEN_NARGIFY_3(gxm_XmToggleButtonSetState_w, gxm_XmToggleButtonSetState)
- XEN_ARGIFY_4(gxm_XmCreateToggleButton_w, gxm_XmCreateToggleButton)
- XEN_ARGIFY_4(gxm_XmCreateLabelGadget_w, gxm_XmCreateLabelGadget)
- XEN_ARGIFY_4(gxm_XmCreateLabel_w, gxm_XmCreateLabel)
- XEN_NARGIFY_1(gxm_XmIsMotifWMRunning_w, gxm_XmIsMotifWMRunning)
- XEN_NARGIFY_3(gxm_XmListAddItem_w, gxm_XmListAddItem)
- XEN_NARGIFY_4(gxm_XmListAddItems_w, gxm_XmListAddItems)
- XEN_NARGIFY_4(gxm_XmListAddItemsUnselected_w, gxm_XmListAddItemsUnselected)
- XEN_NARGIFY_3(gxm_XmListAddItemUnselected_w, gxm_XmListAddItemUnselected)
- XEN_NARGIFY_2(gxm_XmListDeleteItem_w, gxm_XmListDeleteItem)
- XEN_ARGIFY_3(gxm_XmListDeleteItems_w, gxm_XmListDeleteItems)
- XEN_ARGIFY_3(gxm_XmListDeletePositions_w, gxm_XmListDeletePositions)
- XEN_NARGIFY_2(gxm_XmListDeletePos_w, gxm_XmListDeletePos)
- XEN_NARGIFY_3(gxm_XmListDeleteItemsPos_w, gxm_XmListDeleteItemsPos)
- XEN_NARGIFY_1(gxm_XmListDeleteAllItems_w, gxm_XmListDeleteAllItems)
- XEN_NARGIFY_4(gxm_XmListReplaceItems_w, gxm_XmListReplaceItems)
- XEN_NARGIFY_4(gxm_XmListReplaceItemsPos_w, gxm_XmListReplaceItemsPos)
- XEN_NARGIFY_4(gxm_XmListReplaceItemsUnselected_w, gxm_XmListReplaceItemsUnselected)
- XEN_NARGIFY_4(gxm_XmListReplaceItemsPosUnselected_w, gxm_XmListReplaceItemsPosUnselected)
- XEN_NARGIFY_4(gxm_XmListReplacePositions_w, gxm_XmListReplacePositions)
- XEN_NARGIFY_3(gxm_XmListSelectItem_w, gxm_XmListSelectItem)
- XEN_NARGIFY_3(gxm_XmListSelectPos_w, gxm_XmListSelectPos)
- XEN_NARGIFY_2(gxm_XmListDeselectItem_w, gxm_XmListDeselectItem)
- XEN_NARGIFY_2(gxm_XmListDeselectPos_w, gxm_XmListDeselectPos)
- XEN_NARGIFY_1(gxm_XmListDeselectAllItems_w, gxm_XmListDeselectAllItems)
- XEN_NARGIFY_2(gxm_XmListSetPos_w, gxm_XmListSetPos)
- XEN_NARGIFY_2(gxm_XmListSetBottomPos_w, gxm_XmListSetBottomPos)
- XEN_NARGIFY_2(gxm_XmListSetItem_w, gxm_XmListSetItem)
- XEN_NARGIFY_2(gxm_XmListSetBottomItem_w, gxm_XmListSetBottomItem)
- XEN_NARGIFY_2(gxm_XmListSetAddMode_w, gxm_XmListSetAddMode)
- XEN_NARGIFY_2(gxm_XmListItemExists_w, gxm_XmListItemExists)
- XEN_NARGIFY_2(gxm_XmListItemPos_w, gxm_XmListItemPos)
- XEN_NARGIFY_1(gxm_XmListGetKbdItemPos_w, gxm_XmListGetKbdItemPos)
- XEN_NARGIFY_2(gxm_XmListSetKbdItemPos_w, gxm_XmListSetKbdItemPos)
- XEN_NARGIFY_2(gxm_XmListYToPos_w, gxm_XmListYToPos)
- XEN_NARGIFY_2(gxm_XmListPosToBounds_w, gxm_XmListPosToBounds)
- XEN_NARGIFY_2(gxm_XmListGetMatchPos_w, gxm_XmListGetMatchPos)
- XEN_NARGIFY_2(gxm_XmListSetHorizPos_w, gxm_XmListSetHorizPos)
- XEN_NARGIFY_1(gxm_XmListUpdateSelectedList_w, gxm_XmListUpdateSelectedList)
- XEN_NARGIFY_2(gxm_XmListPosSelected_w, gxm_XmListPosSelected)
- XEN_ARGIFY_4(gxm_XmCreateList_w, gxm_XmCreateList)
- XEN_ARGIFY_4(gxm_XmCreateScrolledList_w, gxm_XmCreateScrolledList)
- XEN_NARGIFY_3(gxm_XmTranslateKey_w, gxm_XmTranslateKey)
- XEN_ARGIFY_4(gxm_XmCreateMainWindow_w, gxm_XmCreateMainWindow)
- XEN_NARGIFY_2(gxm_XmInstallImage_w, gxm_XmInstallImage)
- XEN_NARGIFY_1(gxm_XmUninstallImage_w, gxm_XmUninstallImage)
- XEN_NARGIFY_4(gxm_XmGetPixmap_w, gxm_XmGetPixmap)
- XEN_NARGIFY_5(gxm_XmGetPixmapByDepth_w, gxm_XmGetPixmapByDepth)
- XEN_NARGIFY_2(gxm_XmDestroyPixmap_w, gxm_XmDestroyPixmap)
- XEN_NARGIFY_1(gxm_XmUpdateDisplay_w, gxm_XmUpdateDisplay)
- XEN_NARGIFY_1(gxm_XmWidgetGetBaselines_w, gxm_XmWidgetGetBaselines)
- XEN_NARGIFY_2(gxm_XmRegisterSegmentEncoding_w, gxm_XmRegisterSegmentEncoding)
- XEN_NARGIFY_1(gxm_XmMapSegmentEncoding_w, gxm_XmMapSegmentEncoding)
- XEN_NARGIFY_1(gxm_XmCvtCTToXmString_w, gxm_XmCvtCTToXmString)
- XEN_NARGIFY_1(gxm_XmCvtXmStringToCT_w, gxm_XmCvtXmStringToCT)
- XEN_NARGIFY_5(gxm_XmConvertUnits_w, gxm_XmConvertUnits)
- XEN_ARGIFY_4(gxm_XmCreateSimpleMenuBar_w, gxm_XmCreateSimpleMenuBar)
- XEN_ARGIFY_4(gxm_XmCreateSimplePopupMenu_w, gxm_XmCreateSimplePopupMenu)
- XEN_ARGIFY_4(gxm_XmCreateSimplePulldownMenu_w, gxm_XmCreateSimplePulldownMenu)
- XEN_ARGIFY_4(gxm_XmCreateSimpleOptionMenu_w, gxm_XmCreateSimpleOptionMenu)
- XEN_ARGIFY_4(gxm_XmCreateSimpleRadioBox_w, gxm_XmCreateSimpleRadioBox)
- XEN_ARGIFY_4(gxm_XmCreateSimpleCheckBox_w, gxm_XmCreateSimpleCheckBox)
- XEN_NARGIFY_3(gxm_XmVaCreateSimpleMenuBar_w, gxm_XmVaCreateSimpleMenuBar)
- XEN_NARGIFY_4(gxm_XmVaCreateSimplePopupMenu_w, gxm_XmVaCreateSimplePopupMenu)
- XEN_NARGIFY_5(gxm_XmVaCreateSimplePulldownMenu_w, gxm_XmVaCreateSimplePulldownMenu)
- XEN_NARGIFY_7(gxm_XmVaCreateSimpleOptionMenu_w, gxm_XmVaCreateSimpleOptionMenu)
- XEN_NARGIFY_5(gxm_XmVaCreateSimpleRadioBox_w, gxm_XmVaCreateSimpleRadioBox)
- XEN_NARGIFY_4(gxm_XmVaCreateSimpleCheckBox_w, gxm_XmVaCreateSimpleCheckBox)
- XEN_NARGIFY_3(gxm_XmTrackingEvent_w, gxm_XmTrackingEvent)
- XEN_NARGIFY_1(gxm_XmSetColorCalculation_w, gxm_XmSetColorCalculation)
- XEN_NARGIFY_0(gxm_XmGetColorCalculation_w, gxm_XmGetColorCalculation)
- XEN_NARGIFY_3(gxm_XmGetColors_w, gxm_XmGetColors)
- XEN_NARGIFY_2(gxm_XmChangeColor_w, gxm_XmChangeColor)
- XEN_NARGIFY_2(gxm_XmStringCreate_w, gxm_XmStringCreate)
- XEN_NARGIFY_1(gxm_XmStringCreateLocalized_w, gxm_XmStringCreateLocalized)
- XEN_NARGIFY_1(gxm_XmStringDirectionCreate_w, gxm_XmStringDirectionCreate)
- XEN_NARGIFY_0(gxm_XmStringSeparatorCreate_w, gxm_XmStringSeparatorCreate)
- XEN_NARGIFY_1(gxm_XmStringInitContext_w, gxm_XmStringInitContext)
- XEN_NARGIFY_1(gxm_XmStringFreeContext_w, gxm_XmStringFreeContext)
- XEN_NARGIFY_2(gxm_XmStringConcatAndFree_w, gxm_XmStringConcatAndFree)
- XEN_NARGIFY_1(gxm_XmStringIsVoid_w, gxm_XmStringIsVoid)
- XEN_NARGIFY_1(gxm_XmStringPeekNextTriple_w, gxm_XmStringPeekNextTriple)
- XEN_NARGIFY_1(gxm_XmStringGetNextTriple_w, gxm_XmStringGetNextTriple)
- XEN_NARGIFY_3(gxm_XmStringComponentCreate_w, gxm_XmStringComponentCreate)
- XEN_NARGIFY_7(gxm_XmStringUnparse_w, gxm_XmStringUnparse)
- XEN_NARGIFY_7(gxm_XmStringParseText_w, gxm_XmStringParseText)
- XEN_NARGIFY_2(gxm_XmStringToXmStringTable_w, gxm_XmStringToXmStringTable)
- XEN_NARGIFY_3(gxm_XmStringTableToXmString_w, gxm_XmStringTableToXmString)
- XEN_NARGIFY_8(gxm_XmStringTableUnparse_w, gxm_XmStringTableUnparse)
- XEN_NARGIFY_7(gxm_XmStringTableParseStringArray_w, gxm_XmStringTableParseStringArray)
- XEN_NARGIFY_1(gxm_XmDirectionToStringDirection_w, gxm_XmDirectionToStringDirection)
- XEN_NARGIFY_1(gxm_XmStringDirectionToDirection_w, gxm_XmStringDirectionToDirection)
- XEN_NARGIFY_4(gxm_XmStringGenerate_w, gxm_XmStringGenerate)
- XEN_NARGIFY_2(gxm_XmStringPutRendition_w, gxm_XmStringPutRendition)
- XEN_ARGIFY_2(gxm_XmParseMappingCreate_w, gxm_XmParseMappingCreate)
- XEN_ARGIFY_3(gxm_XmParseMappingSetValues_w, gxm_XmParseMappingSetValues)
- XEN_ARGIFY_3(gxm_XmParseMappingGetValues_w, gxm_XmParseMappingGetValues)
- XEN_NARGIFY_1(gxm_XmParseMappingFree_w, gxm_XmParseMappingFree)
- XEN_ARGIFY_2(gxm_XmParseTableFree_w, gxm_XmParseTableFree)
- XEN_NARGIFY_5(gxm_XmStringTableProposeTablist_w, gxm_XmStringTableProposeTablist)
- XEN_NARGIFY_2(gxm_XmTabSetValue_w, gxm_XmTabSetValue)
- XEN_NARGIFY_1(gxm_XmTabGetValues_w, gxm_XmTabGetValues)
- XEN_NARGIFY_1(gxm_XmTabFree_w, gxm_XmTabFree)
- XEN_NARGIFY_1(gxm_XmTabListFree_w, gxm_XmTabListFree)
- XEN_NARGIFY_5(gxm_XmTabCreate_w, gxm_XmTabCreate)
- XEN_NARGIFY_1(gxm_XmTabListTabCount_w, gxm_XmTabListTabCount)
- XEN_ARGIFY_3(gxm_XmTabListRemoveTabs_w, gxm_XmTabListRemoveTabs)
- XEN_ARGIFY_4(gxm_XmTabListReplacePositions_w, gxm_XmTabListReplacePositions)
- XEN_NARGIFY_2(gxm_XmTabListGetTab_w, gxm_XmTabListGetTab)
- XEN_NARGIFY_3(gxm_XmTabListCopy_w, gxm_XmTabListCopy)
- XEN_NARGIFY_4(gxm_XmTabListInsertTabs_w, gxm_XmTabListInsertTabs)
- XEN_NARGIFY_3(gxm_XmRenderTableCvtFromProp_w, gxm_XmRenderTableCvtFromProp)
- XEN_NARGIFY_2(gxm_XmRenderTableCvtToProp_w, gxm_XmRenderTableCvtToProp)
- XEN_ARGIFY_3(gxm_XmRenditionUpdate_w, gxm_XmRenditionUpdate)
- XEN_ARGIFY_3(gxm_XmRenditionRetrieve_w, gxm_XmRenditionRetrieve)
- XEN_NARGIFY_1(gxm_XmRenditionFree_w, gxm_XmRenditionFree)
- XEN_ARGIFY_4(gxm_XmRenditionCreate_w, gxm_XmRenditionCreate)
- XEN_ARGIFY_3(gxm_XmRenderTableGetRenditions_w, gxm_XmRenderTableGetRenditions)
- XEN_NARGIFY_2(gxm_XmRenderTableGetRendition_w, gxm_XmRenderTableGetRendition)
- XEN_NARGIFY_1(gxm_XmRenderTableGetTags_w, gxm_XmRenderTableGetTags)
- XEN_NARGIFY_1(gxm_XmRenderTableFree_w, gxm_XmRenderTableFree)
- XEN_ARGIFY_3(gxm_XmRenderTableCopy_w, gxm_XmRenderTableCopy)
- XEN_ARGIFY_3(gxm_XmRenderTableRemoveRenditions_w, gxm_XmRenderTableRemoveRenditions)
- XEN_NARGIFY_4(gxm_XmRenderTableAddRenditions_w, gxm_XmRenderTableAddRenditions)
- XEN_NARGIFY_2(gxm_XmStringConcat_w, gxm_XmStringConcat)
- XEN_NARGIFY_1(gxm_XmStringCopy_w, gxm_XmStringCopy)
- XEN_NARGIFY_2(gxm_XmStringCompare_w, gxm_XmStringCompare)
- XEN_NARGIFY_1(gxm_XmStringEmpty_w, gxm_XmStringEmpty)
- XEN_NARGIFY_2(gxm_XmStringHasSubstring_w, gxm_XmStringHasSubstring)
- XEN_NARGIFY_1(gxm_XmStringFree_w, gxm_XmStringFree)
- XEN_NARGIFY_2(gxm_XmStringBaseline_w, gxm_XmStringBaseline)
- XEN_NARGIFY_2(gxm_XmStringWidth_w, gxm_XmStringWidth)
- XEN_NARGIFY_2(gxm_XmStringHeight_w, gxm_XmStringHeight)
- XEN_NARGIFY_2(gxm_XmStringExtent_w, gxm_XmStringExtent)
- XEN_NARGIFY_1(gxm_XmStringLineCount_w, gxm_XmStringLineCount)
- XEN_VARGIFY(gxm_XmStringDraw_w, gxm_XmStringDraw)
- XEN_VARGIFY(gxm_XmStringDrawImage_w, gxm_XmStringDrawImage)
- XEN_VARGIFY(gxm_XmStringDrawUnderline_w, gxm_XmStringDrawUnderline)
-
- XEN_NARGIFY_1(gxm_XmGetDestination_w, gxm_XmGetDestination)
- XEN_NARGIFY_1(gxm_XmIsTraversable_w, gxm_XmIsTraversable)
- XEN_NARGIFY_1(gxm_XmGetVisibility_w, gxm_XmGetVisibility)
- XEN_NARGIFY_1(gxm_XmGetTabGroup_w, gxm_XmGetTabGroup)
- XEN_NARGIFY_1(gxm_XmGetFocusWidget_w, gxm_XmGetFocusWidget)
- XEN_NARGIFY_2(gxm_XmProcessTraversal_w, gxm_XmProcessTraversal)
- XEN_ARGIFY_4(gxm_XmCreateMenuShell_w, gxm_XmCreateMenuShell)
-
- XEN_NARGIFY_1(gxm_XmIsMessageBox_w, gxm_XmIsMessageBox)
- XEN_NARGIFY_1(gxm_XmIsArrowButtonGadget_w, gxm_XmIsArrowButtonGadget)
- XEN_NARGIFY_1(gxm_XmIsArrowButton_w, gxm_XmIsArrowButton)
- XEN_NARGIFY_1(gxm_XmCvtXmStringToByteStream_w, gxm_XmCvtXmStringToByteStream)
- XEN_NARGIFY_1(gxm_XmCvtByteStreamToXmString_w, gxm_XmCvtByteStreamToXmString)
- XEN_NARGIFY_1(gxm_XmStringByteStreamLength_w, gxm_XmStringByteStreamLength)
- XEN_NARGIFY_1(gxm_XmIsNotebook_w, gxm_XmIsNotebook)
- XEN_NARGIFY_1(gxm_XmIsComboBox_w, gxm_XmIsComboBox)
- XEN_NARGIFY_1(gxm_XmIsContainer_w, gxm_XmIsContainer)
- XEN_NARGIFY_1(gxm_XmIsGrabShell_w, gxm_XmIsGrabShell)
- XEN_NARGIFY_1(gxm_XmIsIconGadget_w, gxm_XmIsIconGadget)
- XEN_NARGIFY_1(gxm_XmIsIconHeader_w, gxm_XmIsIconHeader)
- XEN_NARGIFY_1(gxm_XmIsPanedWindow_w, gxm_XmIsPanedWindow)
- XEN_NARGIFY_1(gxm_XmIsBulletinBoard_w, gxm_XmIsBulletinBoard)
- XEN_NARGIFY_1(gxm_XmIsPrimitive_w, gxm_XmIsPrimitive)
- XEN_NARGIFY_1(gxm_XmIsCascadeButtonGadget_w, gxm_XmIsCascadeButtonGadget)
- XEN_NARGIFY_1(gxm_XmIsCascadeButton_w, gxm_XmIsCascadeButton)
- XEN_NARGIFY_1(gxm_XmIsPushButtonGadget_w, gxm_XmIsPushButtonGadget)
- XEN_NARGIFY_1(gxm_XmIsPushButton_w, gxm_XmIsPushButton)
- XEN_NARGIFY_1(gxm_XmIsCommand_w, gxm_XmIsCommand)
- XEN_NARGIFY_1(gxm_XmIsRowColumn_w, gxm_XmIsRowColumn)
- XEN_NARGIFY_1(gxm_XmIsScale_w, gxm_XmIsScale)
- XEN_NARGIFY_1(gxm_XmIsScreen_w, gxm_XmIsScreen)
- XEN_NARGIFY_1(gxm_XmIsScrollBar_w, gxm_XmIsScrollBar)
- XEN_NARGIFY_1(gxm_XmIsDialogShell_w, gxm_XmIsDialogShell)
- XEN_NARGIFY_1(gxm_XmIsScrolledWindow_w, gxm_XmIsScrolledWindow)
- XEN_NARGIFY_1(gxm_XmIsDisplay_w, gxm_XmIsDisplay)
- XEN_NARGIFY_1(gxm_XmIsSelectionBox_w, gxm_XmIsSelectionBox)
- XEN_NARGIFY_1(gxm_XmIsDragContext_w, gxm_XmIsDragContext)
- XEN_NARGIFY_1(gxm_XmIsSeparatorGadget_w, gxm_XmIsSeparatorGadget)
- XEN_NARGIFY_1(gxm_XmIsDragIconObjectClass_w, gxm_XmIsDragIconObjectClass)
- XEN_NARGIFY_1(gxm_XmIsSeparator_w, gxm_XmIsSeparator)
- XEN_NARGIFY_1(gxm_XmIsDrawingArea_w, gxm_XmIsDrawingArea)
- XEN_NARGIFY_1(gxm_XmIsDrawnButton_w, gxm_XmIsDrawnButton)
- XEN_NARGIFY_1(gxm_XmIsDropSiteManager_w, gxm_XmIsDropSiteManager)
- XEN_NARGIFY_1(gxm_XmIsDropTransfer_w, gxm_XmIsDropTransfer)
- XEN_NARGIFY_1(gxm_XmIsTextField_w, gxm_XmIsTextField)
- XEN_NARGIFY_1(gxm_XmIsFileSelectionBox_w, gxm_XmIsFileSelectionBox)
- XEN_NARGIFY_1(gxm_XmIsText_w, gxm_XmIsText)
- XEN_NARGIFY_1(gxm_XmIsForm_w, gxm_XmIsForm)
- XEN_NARGIFY_1(gxm_XmIsFrame_w, gxm_XmIsFrame)
- XEN_NARGIFY_1(gxm_XmIsGadget_w, gxm_XmIsGadget)
- XEN_NARGIFY_1(gxm_XmIsToggleButtonGadget_w, gxm_XmIsToggleButtonGadget)
- XEN_NARGIFY_1(gxm_XmIsToggleButton_w, gxm_XmIsToggleButton)
- XEN_NARGIFY_1(gxm_XmIsLabelGadget_w, gxm_XmIsLabelGadget)
- XEN_NARGIFY_1(gxm_XmIsLabel_w, gxm_XmIsLabel)
- XEN_NARGIFY_1(gxm_XmIsVendorShell_w, gxm_XmIsVendorShell)
- XEN_NARGIFY_1(gxm_XmIsList_w, gxm_XmIsList)
- XEN_NARGIFY_1(gxm_XmIsMainWindow_w, gxm_XmIsMainWindow)
- XEN_NARGIFY_1(gxm_XmIsManager_w, gxm_XmIsManager)
- XEN_NARGIFY_1(gxm_XmIsMenuShell_w, gxm_XmIsMenuShell)
- XEN_NARGIFY_1(gxm_XmListGetSelectedPos_w, gxm_XmListGetSelectedPos)
- XEN_NARGIFY_1(gxm_XmWidgetGetDisplayRect_w, gxm_XmWidgetGetDisplayRect)
-
-#if HAVE_XmCreateButtonBox
- XEN_NARGIFY_1(gxm_XmIsButtonBox_w, gxm_XmIsButtonBox)
- XEN_ARGIFY_4(gxm_XmCreateButtonBox_w, gxm_XmCreateButtonBox)
-#endif
-#if HAVE_XmCreateTabStack
- XEN_ARGIFY_4(gxm_XmCreateTabStack_w, gxm_XmCreateTabStack)
- XEN_NARGIFY_1(gxm_XmIsTabStack_w, gxm_XmIsTabStack)
- XEN_NARGIFY_1(gxm_XmTabStackGetSelectedTab_w, gxm_XmTabStackGetSelectedTab)
- XEN_NARGIFY_2(gxm_XmTabStackSelectTab_w, gxm_XmTabStackSelectTab)
-#if HAVE_XmTabStackXYToWidget
- XEN_NARGIFY_2(gxm_XmTabStackIndexToWidget_w, gxm_XmTabStackIndexToWidget)
- XEN_NARGIFY_3(gxm_XmTabStackXYToWidget_w, gxm_XmTabStackXYToWidget)
-#endif
-#endif
-#if HAVE_XmCreateDataField
- XEN_NARGIFY_1(gxm_XmIsDataField_w, gxm_XmIsDataField)
- XEN_ARGIFY_4(gxm_XmCreateDataField_w, gxm_XmCreateDataField)
- XEN_NARGIFY_2(gxm_XmDataFieldSetString_w, gxm_XmDataFieldSetString)
- XEN_NARGIFY_1(gxm_XmDataFieldGetString_w, gxm_XmDataFieldGetString)
- XEN_NARGIFY_4(gxm_XmDataFieldSetHighlight_w, gxm_XmDataFieldSetHighlight)
- XEN_NARGIFY_2(gxm_XmDataFieldSetAddMode_w, gxm_XmDataFieldSetAddMode)
- XEN_NARGIFY_1(gxm_XmDataFieldGetSelection_w, gxm_XmDataFieldGetSelection)
- XEN_NARGIFY_4(gxm_XmDataFieldSetSelection_w, gxm_XmDataFieldSetSelection)
- XEN_NARGIFY_1(gxm_XmDataFieldGetSelectionPosition_w, gxm_XmDataFieldGetSelectionPosition)
- XEN_NARGIFY_3(gxm_XmDataFieldXYToPos_w, gxm_XmDataFieldXYToPos)
- XEN_NARGIFY_2(gxm_XmDataFieldShowPosition_w, gxm_XmDataFieldShowPosition)
- XEN_NARGIFY_2(gxm_XmDataFieldCut_w, gxm_XmDataFieldCut)
- XEN_NARGIFY_2(gxm_XmDataFieldCopy_w, gxm_XmDataFieldCopy)
- XEN_NARGIFY_1(gxm_XmDataFieldPaste_w, gxm_XmDataFieldPaste)
- XEN_NARGIFY_2(gxm_XmDataFieldSetEditable_w, gxm_XmDataFieldSetEditable)
- XEN_NARGIFY_2(gxm_XmDataFieldSetInsertionPosition_w, gxm_XmDataFieldSetInsertionPosition)
-#endif
-#if HAVE_XmCreateColumn
- XEN_ARGIFY_4(gxm_XmCreateColumn_w, gxm_XmCreateColumn)
- XEN_NARGIFY_1(gxm_XmIsColumn_w, gxm_XmIsColumn)
-#if HAVE_XmColumnGetChildLabel
- XEN_NARGIFY_1(gxm_XmColumnGetChildLabel_w, gxm_XmColumnGetChildLabel)
-#endif
-#endif
-#if HAVE_XmCreateDropDown
- XEN_NARGIFY_1(gxm_XmIsDropDown_w, gxm_XmIsDropDown)
- XEN_NARGIFY_1(gxm_XmDropDownGetValue_w, gxm_XmDropDownGetValue)
- XEN_NARGIFY_1(gxm_XmDropDownGetList_w, gxm_XmDropDownGetList)
- XEN_NARGIFY_1(gxm_XmDropDownGetText_w, gxm_XmDropDownGetText)
- XEN_NARGIFY_1(gxm_XmDropDownGetArrow_w, gxm_XmDropDownGetArrow)
- XEN_NARGIFY_1(gxm_XmDropDownGetLabel_w, gxm_XmDropDownGetLabel)
- XEN_ARGIFY_4(gxm_XmCreateDropDown_w, gxm_XmCreateDropDown)
-#endif
-
-#endif
-
- XEN_NARGIFY_4(gxm_XpmCreatePixmapFromData_w, gxm_XpmCreatePixmapFromData)
- XEN_NARGIFY_4(gxm_XpmCreateDataFromPixmap_w, gxm_XpmCreateDataFromPixmap)
- XEN_NARGIFY_4(gxm_XpmReadFileToPixmap_w, gxm_XpmReadFileToPixmap)
- XEN_NARGIFY_1(gxm_XpmReadFileToXpmImage_w, gxm_XpmReadFileToXpmImage)
- XEN_NARGIFY_5(gxm_XpmWriteFileFromPixmap_w, gxm_XpmWriteFileFromPixmap)
- XEN_NARGIFY_4(gxm_XpmCreatePixmapFromXpmImage_w, gxm_XpmCreatePixmapFromXpmImage)
- XEN_NARGIFY_4(gxm_XpmCreateXpmImageFromPixmap_w, gxm_XpmCreateXpmImageFromPixmap)
- XEN_NARGIFY_1(gxm_XpmGetErrorString_w, gxm_XpmGetErrorString)
-
- XEN_NARGIFY_3(gxm_XGetPixel_w, gxm_XGetPixel)
- XEN_NARGIFY_1(gxm_XDestroyImage_w, gxm_XDestroyImage)
- XEN_NARGIFY_4(gxm_XPutPixel_w, gxm_XPutPixel)
- XEN_NARGIFY_5(gxm_XSubImage_w, gxm_XSubImage)
- XEN_NARGIFY_2(gxm_XAddPixel_w, gxm_XAddPixel)
-
-#if HAVE_MOTIF
- XEN_NARGIFY_1(XEN_XtAppContext_p_w, XEN_XtAppContext_p)
- XEN_NARGIFY_1(XEN_XtRequestId_p_w, XEN_XtRequestId_p)
- XEN_NARGIFY_1(XEN_XtWorkProcId_p_w, XEN_XtWorkProcId_p)
- XEN_NARGIFY_1(XEN_XtInputId_p_w, XEN_XtInputId_p)
- XEN_NARGIFY_1(XEN_XtIntervalId_p_w, XEN_XtIntervalId_p)
-#endif
- XEN_NARGIFY_1(XEN_Screen_p_w, XEN_Screen_p)
- XEN_NARGIFY_1(XEN_XEvent_p_w, XEN_XEvent_p)
- XEN_NARGIFY_1(XEN_XRectangle_p_w, XEN_XRectangle_p)
- XEN_NARGIFY_1(XEN_XArc_p_w, XEN_XArc_p)
- XEN_NARGIFY_1(XEN_XPoint_p_w, XEN_XPoint_p)
- XEN_NARGIFY_1(XEN_XSegment_p_w, XEN_XSegment_p)
- XEN_NARGIFY_1(XEN_XColor_p_w, XEN_XColor_p)
- XEN_NARGIFY_1(XEN_Atom_p_w, XEN_Atom_p)
- XEN_NARGIFY_1(XEN_Colormap_p_w, XEN_Colormap_p)
- XEN_NARGIFY_1(XEN_XModifierKeymap_p_w, XEN_XModifierKeymap_p)
- XEN_NARGIFY_1(XEN_Depth_p_w, XEN_Depth_p)
- XEN_NARGIFY_1(XEN_Display_p_w, XEN_Display_p)
- XEN_NARGIFY_1(XEN_Font_p_w, XEN_Font_p)
- XEN_NARGIFY_1(XEN_GC_p_w, XEN_GC_p)
- XEN_NARGIFY_1(XEN_KeySym_p_w, XEN_KeySym_p)
- XEN_NARGIFY_1(XEN_Pixel_p_w, XEN_Pixel_p)
- XEN_NARGIFY_1(XEN_Pixmap_p_w, XEN_Pixmap_p)
- XEN_NARGIFY_1(XEN_Region_p_w, XEN_Region_p)
- XEN_NARGIFY_1(XEN_Time_p_w, XEN_Time_p)
- XEN_NARGIFY_1(XEN_Visual_p_w, XEN_Visual_p)
- XEN_NARGIFY_1(XEN_Window_p_w, XEN_Window_p)
-#if HAVE_MOTIF
- XEN_NARGIFY_1(XEN_Widget_p_w, XEN_Widget_p)
- XEN_NARGIFY_1(XEN_XmStringContext_p_w, XEN_XmStringContext_p)
-#endif
- XEN_NARGIFY_1(XEN_XFontProp_p_w, XEN_XFontProp_p)
- XEN_NARGIFY_1(XEN_XFontSet_p_w, XEN_XFontSet_p)
- XEN_NARGIFY_1(XEN_XFontStruct_p_w, XEN_XFontStruct_p)
- XEN_NARGIFY_1(XEN_XGCValues_p_w, XEN_XGCValues_p)
- XEN_NARGIFY_1(XEN_XImage_p_w, XEN_XImage_p)
- XEN_NARGIFY_1(XEN_XVisualInfo_p_w, XEN_XVisualInfo_p)
- XEN_NARGIFY_1(XEN_XWMHints_p_w, XEN_XWMHints_p)
- XEN_NARGIFY_1(XEN_XWindowAttributes_p_w, XEN_XWindowAttributes_p)
- XEN_NARGIFY_1(XEN_XWindowChanges_p_w, XEN_XWindowChanges_p)
- XEN_NARGIFY_1(XEN_KeyCode_p_w, XEN_KeyCode_p)
- XEN_NARGIFY_1(XEN_XContext_p_w, XEN_XContext_p)
- XEN_NARGIFY_1(XEN_XCharStruct_p_w, XEN_XCharStruct_p)
- XEN_NARGIFY_1(XEN_XTextItem_p_w, XEN_XTextItem_p)
- XEN_NARGIFY_1(XEN_XStandardColormap_p_w, XEN_XStandardColormap_p)
- XEN_NARGIFY_1(XEN_Cursor_p_w, XEN_Cursor_p)
-#if HAVE_MOTIF
- XEN_NARGIFY_1(XEN_WidgetClass_p_w, XEN_WidgetClass_p)
- XEN_NARGIFY_1(XEN_XmString_p_w, XEN_XmString_p)
- XEN_NARGIFY_1(XEN_XmTab_p_w, XEN_XmTab_p)
- XEN_NARGIFY_1(XEN_XmRendition_p_w, XEN_XmRendition_p)
- XEN_NARGIFY_1(XEN_XmRenderTable_p_w, XEN_XmRenderTable_p)
- XEN_NARGIFY_1(XEN_XmTabList_p_w, XEN_XmTabList_p)
- XEN_NARGIFY_1(XEN_XmParseMapping_p_w, XEN_XmParseMapping_p)
- XEN_NARGIFY_1(XEN_XmTextSource_p_w, XEN_XmTextSource_p)
-#endif
-
- XEN_NARGIFY_1(XEN_XpmAttributes_p_w, XEN_XpmAttributes_p)
- XEN_NARGIFY_1(XEN_XpmImage_p_w, XEN_XpmImage_p)
- XEN_NARGIFY_1(XEN_XpmColorSymbol_p_w, XEN_XpmColorSymbol_p)
-
-#if MUS_WITH_EDITRES
- XEN_NARGIFY_4(gxm_XEditResCheckMessages_w, gxm_XEditResCheckMessages)
-#endif
-
-#if HAVE_XSHAPEQUERYEXTENSION
- XEN_NARGIFY_1(gxm_XShapeQueryExtension_w, gxm_XShapeQueryExtension)
- XEN_NARGIFY_1(gxm_XShapeQueryVersion_w, gxm_XShapeQueryVersion)
- XEN_NARGIFY_2(gxm_XShapeQueryExtents_w, gxm_XShapeQueryExtents)
- XEN_NARGIFY_3(gxm_XShapeGetRectangles_w, gxm_XShapeGetRectangles)
- XEN_NARGIFY_5(gxm_XShapeOffsetShape_w, gxm_XShapeOffsetShape)
- XEN_NARGIFY_7(gxm_XShapeCombineRegion_w, gxm_XShapeCombineRegion)
- XEN_NARGIFY_7(gxm_XShapeCombineMask_w, gxm_XShapeCombineMask)
- XEN_NARGIFY_8(gxm_XShapeCombineShape_w, gxm_XShapeCombineShape)
- XEN_NARGIFY_9(gxm_XShapeCombineRectangles_w, gxm_XShapeCombineRectangles)
-#endif
-
- XEN_NARGIFY_4(gxm_XSegment_w, gxm_XSegment)
- XEN_NARGIFY_4(gxm_XRectangle_w, gxm_XRectangle)
- XEN_ARGIFY_6(gxm_XColor_w, gxm_XColor)
- XEN_NARGIFY_6(gxm_XArc_w, gxm_XArc)
- XEN_NARGIFY_7(gxm_XWindowChanges_w, gxm_XWindowChanges)
- XEN_VARGIFY(gxm_XSetWindowAttributes_w, gxm_XSetWindowAttributes)
- XEN_NARGIFY_2(gxm_XPoint_w, gxm_XPoint)
- XEN_NARGIFY_4(gxm_XTextItem_w, gxm_XTextItem)
- XEN_NARGIFY_1(gxm_pixel_w, gxm_pixel)
- XEN_NARGIFY_2(gxm_set_pixel_w, gxm_set_pixel)
- XEN_NARGIFY_1(gxm_red_w, gxm_red)
- XEN_NARGIFY_2(gxm_set_red_w, gxm_set_red)
- XEN_NARGIFY_1(gxm_green_w, gxm_green)
- XEN_NARGIFY_2(gxm_set_green_w, gxm_set_green)
- XEN_NARGIFY_1(gxm_blue_w, gxm_blue)
- XEN_NARGIFY_2(gxm_set_blue_w, gxm_set_blue)
- XEN_NARGIFY_1(gxm_flags_w, gxm_flags)
- XEN_NARGIFY_2(gxm_set_flags_w, gxm_set_flags)
- XEN_NARGIFY_1(gxm_pad_w, gxm_pad)
- XEN_NARGIFY_2(gxm_set_pad_w, gxm_set_pad)
- XEN_NARGIFY_1(gxm_x_w, gxm_x)
- XEN_NARGIFY_2(gxm_set_x_w, gxm_set_x)
- XEN_NARGIFY_1(gxm_y_w, gxm_y)
- XEN_NARGIFY_2(gxm_set_y_w, gxm_set_y)
- XEN_NARGIFY_1(gxm_width_w, gxm_width)
- XEN_NARGIFY_2(gxm_set_width_w, gxm_set_width)
- XEN_NARGIFY_1(gxm_height_w, gxm_height)
- XEN_NARGIFY_2(gxm_set_height_w, gxm_set_height)
- XEN_NARGIFY_1(gxm_angle1_w, gxm_angle1)
- XEN_NARGIFY_2(gxm_set_angle1_w, gxm_set_angle1)
- XEN_NARGIFY_1(gxm_angle2_w, gxm_angle2)
- XEN_NARGIFY_2(gxm_set_angle2_w, gxm_set_angle2)
- XEN_NARGIFY_1(gxm_x1_w, gxm_x1)
- XEN_NARGIFY_2(gxm_set_x1_w, gxm_set_x1)
- XEN_NARGIFY_1(gxm_y1_w, gxm_y1)
- XEN_NARGIFY_2(gxm_set_y1_w, gxm_set_y1)
- XEN_NARGIFY_1(gxm_x2_w, gxm_x2)
- XEN_NARGIFY_2(gxm_set_x2_w, gxm_set_x2)
- XEN_NARGIFY_1(gxm_y2_w, gxm_y2)
- XEN_NARGIFY_2(gxm_set_y2_w, gxm_set_y2)
- XEN_NARGIFY_1(gxm_dashes_w, gxm_dashes)
- XEN_NARGIFY_2(gxm_set_dashes_w, gxm_set_dashes)
- XEN_NARGIFY_1(gxm_dash_offset_w, gxm_dash_offset)
- XEN_NARGIFY_2(gxm_set_dash_offset_w, gxm_set_dash_offset)
- XEN_NARGIFY_1(gxm_clip_mask_w, gxm_clip_mask)
- XEN_NARGIFY_2(gxm_set_clip_mask_w, gxm_set_clip_mask)
- XEN_NARGIFY_1(gxm_clip_y_origin_w, gxm_clip_y_origin)
- XEN_NARGIFY_2(gxm_set_clip_y_origin_w, gxm_set_clip_y_origin)
- XEN_NARGIFY_1(gxm_clip_x_origin_w, gxm_clip_x_origin)
- XEN_NARGIFY_2(gxm_set_clip_x_origin_w, gxm_set_clip_x_origin)
- XEN_NARGIFY_1(gxm_graphics_exposures_w, gxm_graphics_exposures)
- XEN_NARGIFY_2(gxm_set_graphics_exposures_w, gxm_set_graphics_exposures)
- XEN_NARGIFY_1(gxm_subwindow_mode_w, gxm_subwindow_mode)
- XEN_NARGIFY_2(gxm_set_subwindow_mode_w, gxm_set_subwindow_mode)
- XEN_NARGIFY_1(gxm_font_w, gxm_font)
- XEN_NARGIFY_2(gxm_set_font_w, gxm_set_font)
- XEN_NARGIFY_1(gxm_ts_y_origin_w, gxm_ts_y_origin)
- XEN_NARGIFY_2(gxm_set_ts_y_origin_w, gxm_set_ts_y_origin)
- XEN_NARGIFY_1(gxm_ts_x_origin_w, gxm_ts_x_origin)
- XEN_NARGIFY_2(gxm_set_ts_x_origin_w, gxm_set_ts_x_origin)
- XEN_NARGIFY_1(gxm_stipple_w, gxm_stipple)
- XEN_NARGIFY_2(gxm_set_stipple_w, gxm_set_stipple)
- XEN_NARGIFY_1(gxm_tile_w, gxm_tile)
- XEN_NARGIFY_2(gxm_set_tile_w, gxm_set_tile)
- XEN_NARGIFY_1(gxm_arc_mode_w, gxm_arc_mode)
- XEN_NARGIFY_2(gxm_set_arc_mode_w, gxm_set_arc_mode)
- XEN_NARGIFY_1(gxm_fill_rule_w, gxm_fill_rule)
- XEN_NARGIFY_2(gxm_set_fill_rule_w, gxm_set_fill_rule)
- XEN_NARGIFY_1(gxm_fill_style_w, gxm_fill_style)
- XEN_NARGIFY_2(gxm_set_fill_style_w, gxm_set_fill_style)
- XEN_NARGIFY_1(gxm_join_style_w, gxm_join_style)
- XEN_NARGIFY_2(gxm_set_join_style_w, gxm_set_join_style)
- XEN_NARGIFY_1(gxm_cap_style_w, gxm_cap_style)
- XEN_NARGIFY_2(gxm_set_cap_style_w, gxm_set_cap_style)
- XEN_NARGIFY_1(gxm_line_style_w, gxm_line_style)
- XEN_NARGIFY_2(gxm_set_line_style_w, gxm_set_line_style)
- XEN_NARGIFY_1(gxm_line_width_w, gxm_line_width)
- XEN_NARGIFY_2(gxm_set_line_width_w, gxm_set_line_width)
- XEN_NARGIFY_1(gxm_background_w, gxm_background)
- XEN_NARGIFY_2(gxm_set_background_w, gxm_set_background)
- XEN_NARGIFY_1(gxm_foreground_w, gxm_foreground)
- XEN_NARGIFY_2(gxm_set_foreground_w, gxm_set_foreground)
- XEN_NARGIFY_1(gxm_plane_mask_w, gxm_plane_mask)
- XEN_NARGIFY_2(gxm_set_plane_mask_w, gxm_set_plane_mask)
- XEN_NARGIFY_1(gxm_function_w, gxm_function)
- XEN_NARGIFY_2(gxm_set_function_w, gxm_set_function)
- XEN_NARGIFY_1(gxm_delta_w, gxm_delta)
- XEN_NARGIFY_2(gxm_set_delta_w, gxm_set_delta)
- XEN_NARGIFY_1(gxm_nchars_w, gxm_nchars)
- XEN_NARGIFY_2(gxm_set_nchars_w, gxm_set_nchars)
- XEN_NARGIFY_1(gxm_chars_w, gxm_chars)
- XEN_NARGIFY_2(gxm_set_chars_w, gxm_set_chars)
- XEN_NARGIFY_1(gxm_name_w, gxm_name)
- XEN_NARGIFY_2(gxm_set_name_w, gxm_set_name)
- XEN_NARGIFY_1(gxm_depth_w, gxm_depth)
- XEN_NARGIFY_2(gxm_set_depth_w, gxm_set_depth)
- XEN_NARGIFY_1(gxm_visual_w, gxm_visual)
- XEN_NARGIFY_2(gxm_set_visual_w, gxm_set_visual)
-
- XEN_NARGIFY_1(gxm_display_w, gxm_display)
- XEN_NARGIFY_1(gxm_root_w, gxm_root)
- XEN_NARGIFY_1(gxm_mwidth_w, gxm_mwidth)
- XEN_NARGIFY_1(gxm_mheight_w, gxm_mheight)
- XEN_NARGIFY_1(gxm_ndepths_w, gxm_ndepths)
- XEN_NARGIFY_1(gxm_depths_w, gxm_depths)
- XEN_NARGIFY_1(gxm_root_depth_w, gxm_root_depth)
- XEN_NARGIFY_1(gxm_root_visual_w, gxm_root_visual)
- XEN_NARGIFY_1(gxm_default_gc_w, gxm_default_gc)
- XEN_NARGIFY_1(gxm_cmap_w, gxm_cmap)
- XEN_NARGIFY_1(gxm_white_pixel_w, gxm_white_pixel)
- XEN_NARGIFY_1(gxm_black_pixel_w, gxm_black_pixel)
- XEN_NARGIFY_1(gxm_max_maps_w, gxm_max_maps)
- XEN_NARGIFY_1(gxm_min_maps_w, gxm_min_maps)
- XEN_NARGIFY_1(gxm_backing_store_w, gxm_backing_store)
- XEN_NARGIFY_1(gxm_save_unders_w, gxm_save_unders)
- XEN_NARGIFY_1(gxm_root_input_mask_w, gxm_root_input_mask)
- XEN_NARGIFY_1(gxm_type_w, gxm_type)
- XEN_NARGIFY_1(gxm_serial_w, gxm_serial)
- XEN_NARGIFY_1(gxm_send_event_w, gxm_send_event)
- XEN_NARGIFY_1(gxm_window_w, gxm_window)
- XEN_NARGIFY_1(gxm_subwindow_w, gxm_subwindow)
- XEN_NARGIFY_1(gxm_time_w, gxm_time)
- XEN_NARGIFY_1(gxm_x_root_w, gxm_x_root)
- XEN_NARGIFY_1(gxm_y_root_w, gxm_y_root)
- XEN_NARGIFY_1(gxm_state_w, gxm_state)
- XEN_NARGIFY_1(gxm_keycode_w, gxm_keycode)
- XEN_NARGIFY_1(gxm_same_screen_w, gxm_same_screen)
- XEN_NARGIFY_1(gxm_button_w, gxm_button)
- XEN_NARGIFY_1(gxm_is_hint_w, gxm_is_hint)
- XEN_NARGIFY_1(gxm_mode_w, gxm_mode)
- XEN_NARGIFY_1(gxm_detail_w, gxm_detail)
- XEN_NARGIFY_1(gxm_focus_w, gxm_focus)
- XEN_NARGIFY_1(gxm_key_vector_w, gxm_key_vector)
- XEN_NARGIFY_1(gxm_count_w, gxm_count)
- XEN_NARGIFY_1(gxm_drawable_w, gxm_drawable)
- XEN_NARGIFY_1(gxm_major_code_w, gxm_major_code)
- XEN_NARGIFY_1(gxm_minor_code_w, gxm_minor_code)
- XEN_NARGIFY_1(gxm_parent_w, gxm_parent)
- XEN_NARGIFY_1(gxm_border_width_w, gxm_border_width)
- XEN_NARGIFY_1(gxm_override_redirect_w, gxm_override_redirect)
- XEN_NARGIFY_1(gxm_event_w, gxm_event)
- XEN_NARGIFY_1(gxm_from_configure_w, gxm_from_configure)
- XEN_NARGIFY_1(gxm_above_w, gxm_above)
- XEN_NARGIFY_1(gxm_value_mask_w, gxm_value_mask)
- XEN_NARGIFY_1(gxm_place_w, gxm_place)
- XEN_NARGIFY_1(gxm_atom_w, gxm_atom)
- XEN_NARGIFY_1(gxm_selection_w, gxm_selection)
- XEN_NARGIFY_1(gxm_owner_w, gxm_owner)
- XEN_NARGIFY_1(gxm_requestor_w, gxm_requestor)
- XEN_NARGIFY_1(gxm_target_w, gxm_target)
- XEN_NARGIFY_1(gxm_property_w, gxm_property)
- XEN_NARGIFY_1(gxm_new_w, gxm_new)
- XEN_NARGIFY_1(gxm_message_type_w, gxm_message_type)
- XEN_NARGIFY_1(gxm_format_w, gxm_format)
- XEN_NARGIFY_1(gxm_request_w, gxm_request)
- XEN_NARGIFY_1(gxm_first_keycode_w, gxm_first_keycode)
- XEN_NARGIFY_1(gxm_resourceid_w, gxm_resourceid)
- XEN_NARGIFY_1(gxm_error_code_w, gxm_error_code)
- XEN_NARGIFY_1(gxm_request_code_w, gxm_request_code)
- XEN_NARGIFY_1(gxm_lbearing_w, gxm_lbearing)
- XEN_NARGIFY_1(gxm_rbearing_w, gxm_rbearing)
- XEN_NARGIFY_1(gxm_ascent_w, gxm_ascent)
- XEN_NARGIFY_1(gxm_descent_w, gxm_descent)
- XEN_NARGIFY_1(gxm_attributes_w, gxm_attributes)
- XEN_NARGIFY_1(gxm_card32_w, gxm_card32)
- XEN_NARGIFY_1(gxm_fid_w, gxm_fid)
- XEN_NARGIFY_1(gxm_properties_w, gxm_properties)
- XEN_NARGIFY_1(gxm_min_bounds_w, gxm_min_bounds)
- XEN_NARGIFY_1(gxm_max_bounds_w, gxm_max_bounds)
- XEN_NARGIFY_1(gxm_per_char_w, gxm_per_char)
- XEN_NARGIFY_1(gxm_input_w, gxm_input)
- XEN_NARGIFY_1(gxm_initial_state_w, gxm_initial_state)
- XEN_NARGIFY_1(gxm_icon_pixmap_w, gxm_icon_pixmap)
- XEN_NARGIFY_1(gxm_icon_window_w, gxm_icon_window)
- XEN_NARGIFY_1(gxm_icon_x_w, gxm_icon_x)
- XEN_NARGIFY_1(gxm_icon_y_w, gxm_icon_y)
- XEN_NARGIFY_1(gxm_icon_mask_w, gxm_icon_mask)
- XEN_NARGIFY_1(gxm_window_group_w, gxm_window_group)
- XEN_NARGIFY_1(gxm_visualid_w, gxm_visualid)
- XEN_NARGIFY_1(gxm_class_w, gxm_class)
- XEN_NARGIFY_1(gxm_red_mask_w, gxm_red_mask)
- XEN_NARGIFY_1(gxm_green_mask_w, gxm_green_mask)
- XEN_NARGIFY_1(gxm_blue_mask_w, gxm_blue_mask)
- XEN_NARGIFY_1(gxm_bits_per_rgb_w, gxm_bits_per_rgb)
- XEN_NARGIFY_1(gxm_map_entries_w, gxm_map_entries)
- XEN_NARGIFY_1(gxm_colormap_size_w, gxm_colormap_size)
- XEN_NARGIFY_1(gxm_nvisuals_w, gxm_nvisuals)
- XEN_NARGIFY_1(gxm_visuals_w, gxm_visuals)
- XEN_NARGIFY_1(gxm_bits_per_pixel_w, gxm_bits_per_pixel)
- XEN_NARGIFY_1(gxm_background_pixmap_w, gxm_background_pixmap)
- XEN_NARGIFY_1(gxm_background_pixel_w, gxm_background_pixel)
- XEN_NARGIFY_1(gxm_border_pixmap_w, gxm_border_pixmap)
- XEN_NARGIFY_1(gxm_border_pixel_w, gxm_border_pixel)
- XEN_NARGIFY_1(gxm_bit_gravity_w, gxm_bit_gravity)
- XEN_NARGIFY_1(gxm_win_gravity_w, gxm_win_gravity)
- XEN_NARGIFY_1(gxm_backing_planes_w, gxm_backing_planes)
- XEN_NARGIFY_1(gxm_backing_pixel_w, gxm_backing_pixel)
- XEN_NARGIFY_1(gxm_save_under_w, gxm_save_under)
- XEN_NARGIFY_1(gxm_event_mask_w, gxm_event_mask)
- XEN_NARGIFY_1(gxm_do_not_propagate_mask_w, gxm_do_not_propagate_mask)
- XEN_NARGIFY_1(gxm_cursor_w, gxm_cursor)
- XEN_NARGIFY_1(gxm_map_installed_w, gxm_map_installed)
- XEN_NARGIFY_1(gxm_map_state_w, gxm_map_state)
- XEN_NARGIFY_1(gxm_all_event_masks_w, gxm_all_event_masks)
- XEN_NARGIFY_1(gxm_your_event_mask_w, gxm_your_event_mask)
- XEN_NARGIFY_1(gxm_screen_w, gxm_screen)
- XEN_NARGIFY_1(gxm_xoffset_w, gxm_xoffset)
- XEN_NARGIFY_1(gxm_byte_order_w, gxm_byte_order)
- XEN_NARGIFY_1(gxm_bitmap_unit_w, gxm_bitmap_unit)
- XEN_NARGIFY_1(gxm_bitmap_bit_order_w, gxm_bitmap_bit_order)
- XEN_NARGIFY_1(gxm_bitmap_pad_w, gxm_bitmap_pad)
- XEN_NARGIFY_1(gxm_bytes_per_line_w, gxm_bytes_per_line)
- XEN_NARGIFY_1(gxm_obdata_w, gxm_obdata)
- XEN_NARGIFY_1(gxm_sibling_w, gxm_sibling)
- XEN_NARGIFY_1(gxm_stack_mode_w, gxm_stack_mode)
-
- XEN_NARGIFY_1(gxm_red_max_w, gxm_red_max)
- XEN_NARGIFY_1(gxm_red_mult_w, gxm_red_mult)
- XEN_NARGIFY_1(gxm_green_max_w, gxm_green_max)
- XEN_NARGIFY_1(gxm_green_mult_w, gxm_green_mult)
- XEN_NARGIFY_1(gxm_blue_max_w, gxm_blue_max)
- XEN_NARGIFY_1(gxm_blue_mult_w, gxm_blue_mult)
- XEN_NARGIFY_1(gxm_base_pixel_w, gxm_base_pixel)
- XEN_NARGIFY_1(gxm_killid_w, gxm_killid)
- XEN_NARGIFY_1(gxm_data_w, gxm_data)
-
- XEN_NARGIFY_2(gxm_set_request_code_w, gxm_set_request_code)
- XEN_NARGIFY_2(gxm_set_error_code_w, gxm_set_error_code)
- XEN_NARGIFY_2(gxm_set_first_keycode_w, gxm_set_first_keycode)
- XEN_NARGIFY_2(gxm_set_request_w, gxm_set_request)
- XEN_NARGIFY_2(gxm_set_resourceid_w, gxm_set_resourceid)
- XEN_NARGIFY_2(gxm_set_format_w, gxm_set_format)
- XEN_NARGIFY_2(gxm_set_message_type_w, gxm_set_message_type)
- XEN_NARGIFY_2(gxm_set_new_w, gxm_set_new)
- XEN_NARGIFY_2(gxm_set_property_w, gxm_set_property)
- XEN_NARGIFY_2(gxm_set_display_w, gxm_set_display)
- XEN_NARGIFY_2(gxm_set_target_w, gxm_set_target)
- XEN_NARGIFY_2(gxm_set_requestor_w, gxm_set_requestor)
- XEN_NARGIFY_2(gxm_set_owner_w, gxm_set_owner)
- XEN_NARGIFY_2(gxm_set_selection_w, gxm_set_selection)
- XEN_NARGIFY_2(gxm_set_atom_w, gxm_set_atom)
- XEN_NARGIFY_2(gxm_set_place_w, gxm_set_place)
- XEN_NARGIFY_2(gxm_set_value_mask_w, gxm_set_value_mask)
- XEN_NARGIFY_2(gxm_set_above_w, gxm_set_above)
- XEN_NARGIFY_2(gxm_set_from_configure_w, gxm_set_from_configure)
- XEN_NARGIFY_2(gxm_set_event_w, gxm_set_event)
- XEN_NARGIFY_2(gxm_set_override_redirect_w, gxm_set_override_redirect)
- XEN_NARGIFY_2(gxm_set_border_width_w, gxm_set_border_width)
- XEN_NARGIFY_2(gxm_set_parent_w, gxm_set_parent)
- XEN_NARGIFY_2(gxm_set_minor_code_w, gxm_set_minor_code)
- XEN_NARGIFY_2(gxm_set_major_code_w, gxm_set_major_code)
- XEN_NARGIFY_2(gxm_set_drawable_w, gxm_set_drawable)
- XEN_NARGIFY_2(gxm_set_count_w, gxm_set_count)
- XEN_NARGIFY_2(gxm_set_key_vector_w, gxm_set_key_vector)
- XEN_NARGIFY_2(gxm_set_focus_w, gxm_set_focus)
- XEN_NARGIFY_2(gxm_set_detail_w, gxm_set_detail)
- XEN_NARGIFY_2(gxm_set_mode_w, gxm_set_mode)
- XEN_NARGIFY_2(gxm_set_is_hint_w, gxm_set_is_hint)
- XEN_NARGIFY_2(gxm_set_button_w, gxm_set_button)
- XEN_NARGIFY_2(gxm_set_same_screen_w, gxm_set_same_screen)
- XEN_NARGIFY_2(gxm_set_keycode_w, gxm_set_keycode)
- XEN_NARGIFY_2(gxm_set_state_w, gxm_set_state)
- XEN_NARGIFY_2(gxm_set_y_root_w, gxm_set_y_root)
- XEN_NARGIFY_2(gxm_set_x_root_w, gxm_set_x_root)
- XEN_NARGIFY_2(gxm_set_root_w, gxm_set_root)
- XEN_NARGIFY_2(gxm_set_time_w, gxm_set_time)
- XEN_NARGIFY_2(gxm_set_subwindow_w, gxm_set_subwindow)
- XEN_NARGIFY_2(gxm_set_window_w, gxm_set_window)
- XEN_NARGIFY_2(gxm_set_send_event_w, gxm_set_send_event)
- XEN_NARGIFY_2(gxm_set_serial_w, gxm_set_serial)
- XEN_NARGIFY_2(gxm_set_type_w, gxm_set_type)
- XEN_NARGIFY_1(gxm_colormap_w, gxm_colormap)
- XEN_NARGIFY_2(gxm_set_colormap_w, gxm_set_colormap)
-
- XEN_NARGIFY_2(gxm_set_input_w, gxm_set_input)
- XEN_NARGIFY_2(gxm_set_initial_state_w, gxm_set_initial_state)
-
- XEN_NARGIFY_1(gxm_min_height_w, gxm_min_height)
- XEN_NARGIFY_1(gxm_max_height_w, gxm_max_height)
- XEN_NARGIFY_1(gxm_min_width_w, gxm_min_width)
- XEN_NARGIFY_1(gxm_max_width_w, gxm_max_width)
- XEN_NARGIFY_1(gxm_height_inc_w, gxm_height_inc)
- XEN_NARGIFY_1(gxm_width_inc_w, gxm_width_inc)
-
- XEN_NARGIFY_2(gxm_set_data_w, gxm_set_data)
- XEN_NARGIFY_2(gxm_set_backing_store_w, gxm_set_backing_store)
- XEN_NARGIFY_2(gxm_set_background_pixel_w, gxm_set_background_pixel)
- XEN_NARGIFY_2(gxm_set_border_pixel_w, gxm_set_border_pixel)
- XEN_NARGIFY_2(gxm_set_bit_gravity_w, gxm_set_bit_gravity)
- XEN_NARGIFY_2(gxm_set_save_under_w, gxm_set_save_under)
- XEN_NARGIFY_2(gxm_set_event_mask_w, gxm_set_event_mask)
- XEN_NARGIFY_2(gxm_set_cursor_w, gxm_set_cursor)
-
-#if HAVE_MOTIF
- XEN_NARGIFY_2(gxm_set_set_w, gxm_set_set)
- XEN_NARGIFY_2(gxm_set_click_count_w, gxm_set_click_count)
- XEN_NARGIFY_2(gxm_set_length_w, gxm_set_length)
- XEN_NARGIFY_1(gxm_ptr_w, gxm_ptr)
- XEN_NARGIFY_2(gxm_set_ptr_w, gxm_set_ptr)
- XEN_NARGIFY_2(gxm_set_reason_w, gxm_set_reason)
- XEN_NARGIFY_1(gxm_page_number_w, gxm_page_number)
- XEN_NARGIFY_1(gxm_page_widget_w, gxm_page_widget)
- XEN_NARGIFY_1(gxm_status_area_widget_w, gxm_status_area_widget)
- XEN_NARGIFY_1(gxm_major_tab_widget_w, gxm_major_tab_widget)
- XEN_NARGIFY_1(gxm_minor_tab_widget_w, gxm_minor_tab_widget)
- XEN_NARGIFY_1(gxm_source_data_w, gxm_source_data)
- XEN_NARGIFY_1(gxm_location_data_w, gxm_location_data)
- XEN_NARGIFY_1(gxm_parm_w, gxm_parm)
- XEN_NARGIFY_1(gxm_parm_format_w, gxm_parm_format)
- XEN_NARGIFY_1(gxm_parm_length_w, gxm_parm_length)
- XEN_NARGIFY_1(gxm_parm_type_w, gxm_parm_type)
- XEN_NARGIFY_1(gxm_transfer_id_w, gxm_transfer_id)
- XEN_NARGIFY_1(gxm_destination_data_w, gxm_destination_data)
- XEN_NARGIFY_1(gxm_remaining_w, gxm_remaining)
- XEN_NARGIFY_1(gxm_item_or_text_w, gxm_item_or_text)
- XEN_NARGIFY_1(gxm_auto_selection_type_w, gxm_auto_selection_type)
- XEN_NARGIFY_1(gxm_new_outline_state_w, gxm_new_outline_state)
- XEN_NARGIFY_1(gxm_prev_page_number_w, gxm_prev_page_number)
- XEN_NARGIFY_1(gxm_prev_page_widget_w, gxm_prev_page_widget)
- XEN_NARGIFY_1(gxm_rendition_w, gxm_rendition)
- XEN_NARGIFY_1(gxm_render_table_w, gxm_render_table)
- XEN_NARGIFY_1(gxm_crossed_boundary_w, gxm_crossed_boundary)
- XEN_NARGIFY_1(gxm_client_data_w, gxm_client_data)
- XEN_NARGIFY_1(gxm_status_w, gxm_status)
- XEN_NARGIFY_1(gxm_font_name_w, gxm_font_name)
- XEN_NARGIFY_1(gxm_tag_w, gxm_tag)
- XEN_NARGIFY_1(gxm_traversal_destination_w, gxm_traversal_destination)
- XEN_NARGIFY_1(gxm_dragProtocolStyle_w, gxm_dragProtocolStyle)
- XEN_NARGIFY_1(gxm_direction_w, gxm_direction)
- XEN_NARGIFY_1(gxm_reason_w, gxm_reason)
- XEN_NARGIFY_1(gxm_timeStamp_w, gxm_timeStamp)
- XEN_NARGIFY_1(gxm_operation_w, gxm_operation )
- XEN_NARGIFY_2(gxm_set_operation_w, gxm_set_operation)
- XEN_NARGIFY_1(gxm_operations_w, gxm_operations)
- XEN_NARGIFY_1(gxm_dropSiteStatus_w, gxm_dropSiteStatus )
- XEN_NARGIFY_2(gxm_set_dropSiteStatus_w, gxm_set_dropSiteStatus)
- XEN_NARGIFY_1(gxm_dropAction_w, gxm_dropAction)
- XEN_NARGIFY_1(gxm_iccHandle_w, gxm_iccHandle)
- XEN_NARGIFY_1(gxm_completionStatus_w, gxm_completionStatus)
- XEN_NARGIFY_1(gxm_dragContext_w, gxm_dragContext)
- XEN_NARGIFY_1(gxm_animate_w, gxm_animate)
- XEN_NARGIFY_1(gxm_length_w, gxm_length)
- XEN_NARGIFY_1(gxm_click_count_w, gxm_click_count)
- XEN_NARGIFY_1(gxm_widget_w, gxm_widget)
- XEN_NARGIFY_1(gxm_item_position_w, gxm_item_position)
- XEN_NARGIFY_1(gxm_callbackstruct_w, gxm_callbackstruct)
- XEN_NARGIFY_1(gxm_set_w, gxm_set)
- XEN_NARGIFY_1(gxm_item_w, gxm_item)
- XEN_NARGIFY_1(gxm_item_length_w, gxm_item_length)
- XEN_NARGIFY_1(gxm_selected_items_w, gxm_selected_items)
- XEN_NARGIFY_1(gxm_selected_item_count_w, gxm_selected_item_count)
- XEN_NARGIFY_1(gxm_selected_item_positions_w, gxm_selected_item_positions)
- XEN_NARGIFY_1(gxm_selection_type_w, gxm_selection_type)
- XEN_NARGIFY_1(gxm_mask_w, gxm_mask)
- XEN_NARGIFY_1(gxm_mask_length_w, gxm_mask_length)
- XEN_NARGIFY_1(gxm_dir_w, gxm_dir)
- XEN_NARGIFY_1(gxm_dir_length_w, gxm_dir_length)
- XEN_NARGIFY_1(gxm_pattern_w, gxm_pattern)
- XEN_NARGIFY_1(gxm_pattern_length_w, gxm_pattern_length)
- XEN_NARGIFY_1(gxm_position_w, gxm_position)
- XEN_NARGIFY_1(gxm_currInsert_w, gxm_currInsert)
- XEN_NARGIFY_1(gxm_newInsert_w, gxm_newInsert)
- XEN_NARGIFY_1(gxm_startPos_w, gxm_startPos)
- XEN_NARGIFY_1(gxm_endPos_w, gxm_endPos)
- XEN_NARGIFY_1(gxm_text_w, gxm_text)
- XEN_NARGIFY_1(gxm_value_w, gxm_value)
- XEN_NARGIFY_2(gxm_set_value_w, gxm_set_value)
- XEN_NARGIFY_1(gxm_doit_w, gxm_doit)
- XEN_NARGIFY_2(gxm_set_doit_w, gxm_set_doit)
- XEN_NARGIFY_1(gxm_menuToPost_w, gxm_menuToPost)
- XEN_NARGIFY_2(gxm_set_menuToPost_w, gxm_set_menuToPost)
- XEN_NARGIFY_1(gxm_postIt_w, gxm_postIt)
- XEN_NARGIFY_2(gxm_set_postIt_w, gxm_set_postIt)
-#if HAVE_XmCreateDataField
- XEN_NARGIFY_1(gxm_w_w, gxm_w)
- XEN_NARGIFY_1(gxm_accept_w, gxm_accept)
-#endif
-#if HAVE_XmCreateTabStack
- XEN_NARGIFY_1(gxm_selected_child_w, gxm_selected_child)
-#endif
-
- XEN_NARGIFY_1(gxm_valuemask_w, gxm_valuemask)
- XEN_NARGIFY_2(gxm_set_valuemask_w, gxm_set_valuemask)
- XEN_NARGIFY_1(gxm_ncolors_w, gxm_ncolors)
- XEN_NARGIFY_2(gxm_set_ncolors_w, gxm_set_ncolors)
- XEN_NARGIFY_1(gxm_cpp_w, gxm_cpp)
- XEN_NARGIFY_2(gxm_set_cpp_w, gxm_set_cpp)
- XEN_NARGIFY_1(gxm_numsymbols_w, gxm_numsymbols)
- XEN_NARGIFY_2(gxm_set_numsymbols_w, gxm_set_numsymbols)
- XEN_NARGIFY_1(gxm_colorsymbols_w, gxm_colorsymbols)
- XEN_NARGIFY_2(gxm_set_colorsymbols_w, gxm_set_colorsymbols)
- XEN_NARGIFY_1(gxm_npixels_w, gxm_npixels)
- XEN_NARGIFY_2(gxm_set_npixels_w, gxm_set_npixels)
- XEN_NARGIFY_1(gxm_y_hotspot_w, gxm_y_hotspot)
- XEN_NARGIFY_2(gxm_set_y_hotspot_w, gxm_set_y_hotspot)
- XEN_NARGIFY_1(gxm_x_hotspot_w, gxm_x_hotspot)
- XEN_NARGIFY_2(gxm_set_x_hotspot_w, gxm_set_x_hotspot)
-
- XEN_NARGIFY_5(gxm_XpmImage_w, gxm_XpmImage)
- XEN_NARGIFY_3(gxm_XpmColorSymbol_w, gxm_XpmColorSymbol)
- XEN_NARGIFY_0(gxm_XpmAttributes_w, gxm_XpmAttributes)
-
-#if HAVE_SCHEME
- XEN_NARGIFY_1(c_to_xen_string_w, c_to_xen_string)
- XEN_NARGIFY_2(c_to_xen_strings_w, c_to_xen_strings)
- XEN_NARGIFY_2(c_to_xen_ints_w, c_to_xen_ints)
- XEN_NARGIFY_2(c_to_xen_atoms_w, c_to_xen_atoms)
- XEN_NARGIFY_2(c_to_xen_xrectangles_w, c_to_xen_xrectangles)
-#endif
-#endif
-
-#else
-
-/* no argify */
-#if HAVE_MOTIF
- #define gxm_XtSetArg_w gxm_XtSetArg
- #define gxm_XtManageChildren_w gxm_XtManageChildren
- #define gxm_XtManageChild_w gxm_XtManageChild
- #define gxm_XtUnmanageChildren_w gxm_XtUnmanageChildren
- #define gxm_XtUnmanageChild_w gxm_XtUnmanageChild
- #define gxm_XtDispatchEvent_w gxm_XtDispatchEvent
- #define gxm_XtCallAcceptFocus_w gxm_XtCallAcceptFocus
- #define gxm_XtAppPeekEvent_w gxm_XtAppPeekEvent
- #define gxm_XtIsSubclass_w gxm_XtIsSubclass
- #define gxm_XtAppSetFallbackResources_w gxm_XtAppSetFallbackResources
- #define gxm_XtIsObject_w gxm_XtIsObject
- #define gxm_XtIsManaged_w gxm_XtIsManaged
- #define gxm_XtIsRealized_w gxm_XtIsRealized
- #define gxm_XtIsSensitive_w gxm_XtIsSensitive
- #define gxm_XtOwnSelection_w gxm_XtOwnSelection
- #define gxm_XtOwnSelectionIncremental_w gxm_XtOwnSelectionIncremental
- #define gxm_XtMakeResizeRequest_w gxm_XtMakeResizeRequest
- #define gxm_XtTranslateCoords_w gxm_XtTranslateCoords
- #define gxm_XtKeysymToKeycodeList_w gxm_XtKeysymToKeycodeList
- #define gxm_XtParseTranslationTable_w gxm_XtParseTranslationTable
- #define gxm_XtParseAcceleratorTable_w gxm_XtParseAcceleratorTable
- #define gxm_XtOverrideTranslations_w gxm_XtOverrideTranslations
- #define gxm_XtAugmentTranslations_w gxm_XtAugmentTranslations
- #define gxm_XtInstallAccelerators_w gxm_XtInstallAccelerators
- #define gxm_XtInstallAllAccelerators_w gxm_XtInstallAllAccelerators
- #define gxm_XtUninstallTranslations_w gxm_XtUninstallTranslations
- #define gxm_XtAppAddActions_w gxm_XtAppAddActions
- #define gxm_XtAppAddActionHook_w gxm_XtAppAddActionHook
- #define gxm_XtRemoveActionHook_w gxm_XtRemoveActionHook
- #define gxm_XtGetActionList_w gxm_XtGetActionList
- #define gxm_XtCallActionProc_w gxm_XtCallActionProc
- #define gxm_XtRegisterGrabAction_w gxm_XtRegisterGrabAction
- #define gxm_XtSetMultiClickTime_w gxm_XtSetMultiClickTime
- #define gxm_XtGetMultiClickTime_w gxm_XtGetMultiClickTime
- #define gxm_XtGetResourceList_w gxm_XtGetResourceList
- #define gxm_XtGetActionKeysym_w gxm_XtGetActionKeysym
- #define gxm_XtTranslateKeycode_w gxm_XtTranslateKeycode
- #define gxm_XtTranslateKey_w gxm_XtTranslateKey
- #define gxm_XtSetKeyTranslator_w gxm_XtSetKeyTranslator
- #define gxm_XtRegisterCaseConverter_w gxm_XtRegisterCaseConverter
- #define gxm_XtConvertCase_w gxm_XtConvertCase
- #define gxm_XtAddEventHandler_w gxm_XtAddEventHandler
- #define gxm_XtRemoveEventHandler_w gxm_XtRemoveEventHandler
- #define gxm_XtAddRawEventHandler_w gxm_XtAddRawEventHandler
- #define gxm_XtRemoveRawEventHandler_w gxm_XtRemoveRawEventHandler
- #define gxm_XtInsertEventHandler_w gxm_XtInsertEventHandler
- #define gxm_XtInsertRawEventHandler_w gxm_XtInsertRawEventHandler
- #define gxm_XtDispatchEventToWidget_w gxm_XtDispatchEventToWidget
- #define gxm_XtBuildEventMask_w gxm_XtBuildEventMask
- #define gxm_XtAddGrab_w gxm_XtAddGrab
- #define gxm_XtRemoveGrab_w gxm_XtRemoveGrab
- #define gxm_XtAppProcessEvent_w gxm_XtAppProcessEvent
- #define gxm_XtAppMainLoop_w gxm_XtAppMainLoop
- #define gxm_XtAddExposureToRegion_w gxm_XtAddExposureToRegion
- #define gxm_XtSetKeyboardFocus_w gxm_XtSetKeyboardFocus
- #define gxm_XtGetKeyboardFocusWidget_w gxm_XtGetKeyboardFocusWidget
- #define gxm_XtLastEventProcessed_w gxm_XtLastEventProcessed
- #define gxm_XtLastTimestampProcessed_w gxm_XtLastTimestampProcessed
- #define gxm_XtAppAddTimeOut_w gxm_XtAppAddTimeOut
- #define gxm_XtRemoveTimeOut_w gxm_XtRemoveTimeOut
- #define gxm_XtAppAddInput_w gxm_XtAppAddInput
- #define gxm_XtRemoveInput_w gxm_XtRemoveInput
- #define gxm_XtAppNextEvent_w gxm_XtAppNextEvent
- #define gxm_XtAppPending_w gxm_XtAppPending
- #define gxm_XtRealizeWidget_w gxm_XtRealizeWidget
- #define gxm_XtUnrealizeWidget_w gxm_XtUnrealizeWidget
- #define gxm_XtDestroyWidget_w gxm_XtDestroyWidget
- #define gxm_XtSetSensitive_w gxm_XtSetSensitive
- #define gxm_XtNameToWidget_w gxm_XtNameToWidget
- #define gxm_XtWindowToWidget_w gxm_XtWindowToWidget
- #define gxm_XtMergeArgLists_w gxm_XtMergeArgLists
- #define gxm_XtVaCreateArgsList_w gxm_XtVaCreateArgsList
- #define gxm_XtDisplay_w gxm_XtDisplay
- #define gxm_XtDisplayOfObject_w gxm_XtDisplayOfObject
- #define gxm_XtScreen_w gxm_XtScreen
- #define gxm_XtScreenOfObject_w gxm_XtScreenOfObject
- #define gxm_XtWindow_w gxm_XtWindow
- #define gxm_XtWindowOfObject_w gxm_XtWindowOfObject
- #define gxm_XtName_w gxm_XtName
- #define gxm_XtSuperclass_w gxm_XtSuperclass
- #define gxm_XtClass_w gxm_XtClass
- #define gxm_XtParent_w gxm_XtParent
- #define gxm_XtAddCallback_w gxm_XtAddCallback
- #define gxm_XtRemoveCallback_w gxm_XtRemoveCallback
- #define gxm_XtAddCallbacks_w gxm_XtAddCallbacks
- #define gxm_XtRemoveCallbacks_w gxm_XtRemoveCallbacks
- #define gxm_XtRemoveAllCallbacks_w gxm_XtRemoveAllCallbacks
- #define gxm_XtCallCallbacks_w gxm_XtCallCallbacks
- #define gxm_XtHasCallbacks_w gxm_XtHasCallbacks
- #define gxm_XtCreatePopupShell_w gxm_XtCreatePopupShell
- #define gxm_XtVaCreatePopupShell_w gxm_XtVaCreatePopupShell
- #define gxm_XtPopup_w gxm_XtPopup
- #define gxm_XtPopupSpringLoaded_w gxm_XtPopupSpringLoaded
- #define gxm_XtCallbackNone_w gxm_XtCallbackNone
- #define gxm_XtCallbackNonexclusive_w gxm_XtCallbackNonexclusive
- #define gxm_XtCallbackExclusive_w gxm_XtCallbackExclusive
- #define gxm_XtPopdown_w gxm_XtPopdown
- #define gxm_XtCallbackPopdown_w gxm_XtCallbackPopdown
- #define gxm_XtCreateWidget_w gxm_XtCreateWidget
- #define gxm_XtCreateManagedWidget_w gxm_XtCreateManagedWidget
- #define gxm_XtVaCreateWidget_w gxm_XtVaCreateWidget
- #define gxm_XtVaCreateManagedWidget_w gxm_XtVaCreateManagedWidget
- #define gxm_XtAppCreateShell_w gxm_XtAppCreateShell
- #define gxm_XtVaAppCreateShell_w gxm_XtVaAppCreateShell
- #define gxm_XtToolkitInitialize_w gxm_XtToolkitInitialize
- #define gxm_XtSetLanguageProc_w gxm_XtSetLanguageProc
- #define gxm_XtDisplayInitialize_w gxm_XtDisplayInitialize
- #define gxm_XtOpenApplication_w gxm_XtOpenApplication
- #define gxm_XtVaOpenApplication_w gxm_XtVaOpenApplication
- #define gxm_XtAppInitialize_w gxm_XtAppInitialize
- #define gxm_XtVaAppInitialize_w gxm_XtVaAppInitialize
- #define gxm_XtOpenDisplay_w gxm_XtOpenDisplay
- #define gxm_XtCreateApplicationContext_w gxm_XtCreateApplicationContext
- #define gxm_XtDestroyApplicationContext_w gxm_XtDestroyApplicationContext
- #define gxm_XtInitializeWidgetClass_w gxm_XtInitializeWidgetClass
- #define gxm_XtWidgetToApplicationContext_w gxm_XtWidgetToApplicationContext
- #define gxm_XtDisplayToApplicationContext_w gxm_XtDisplayToApplicationContext
- #define gxm_XtCloseDisplay_w gxm_XtCloseDisplay
- #define gxm_XtSetValues_w gxm_XtSetValues
- #define gxm_XtVaSetValues_w gxm_XtVaSetValues
- #define gxm_XtGetValues_w gxm_XtGetValues
- #define gxm_XtVaGetValues_w gxm_XtVaGetValues
- #define gxm_XtAppSetErrorMsgHandler_w gxm_XtAppSetErrorMsgHandler
- #define gxm_XtAppSetWarningMsgHandler_w gxm_XtAppSetWarningMsgHandler
- #define gxm_XtAppErrorMsg_w gxm_XtAppErrorMsg
- #define gxm_XtAppWarningMsg_w gxm_XtAppWarningMsg
- #define gxm_XtAppSetErrorHandler_w gxm_XtAppSetErrorHandler
- #define gxm_XtAppSetWarningHandler_w gxm_XtAppSetWarningHandler
- #define gxm_XtAppError_w gxm_XtAppError
- #define gxm_XtMalloc_w gxm_XtMalloc
- #define gxm_XtCalloc_w gxm_XtCalloc
- #define gxm_XtRealloc_w gxm_XtRealloc
- #define gxm_XtFree_w gxm_XtFree
- #define gxm_XtAppAddWorkProc_w gxm_XtAppAddWorkProc
- #define gxm_XtRemoveWorkProc_w gxm_XtRemoveWorkProc
- #define gxm_XtGetGC_w gxm_XtGetGC
- #define gxm_XtAllocateGC_w gxm_XtAllocateGC
- #define gxm_XtDestroyGC_w gxm_XtDestroyGC
- #define gxm_XtReleaseGC_w gxm_XtReleaseGC
- #define gxm_XtFindFile_w gxm_XtFindFile
- #define gxm_XtResolvePathname_w gxm_XtResolvePathname
- #define gxm_XtDisownSelection_w gxm_XtDisownSelection
- #define gxm_XtGetSelectionValue_w gxm_XtGetSelectionValue
- #define gxm_XtGetSelectionValues_w gxm_XtGetSelectionValues
- #define gxm_XtAppSetSelectionTimeout_w gxm_XtAppSetSelectionTimeout
- #define gxm_XtAppGetSelectionTimeout_w gxm_XtAppGetSelectionTimeout
- #define gxm_XtGetSelectionRequest_w gxm_XtGetSelectionRequest
- #define gxm_XtGetSelectionValueIncremental_w gxm_XtGetSelectionValueIncremental
- #define gxm_XtGetSelectionValuesIncremental_w gxm_XtGetSelectionValuesIncremental
- #define gxm_XtCreateSelectionRequest_w gxm_XtCreateSelectionRequest
- #define gxm_XtSendSelectionRequest_w gxm_XtSendSelectionRequest
- #define gxm_XtCancelSelectionRequest_w gxm_XtCancelSelectionRequest
- #define gxm_XtGrabKey_w gxm_XtGrabKey
- #define gxm_XtUngrabKey_w gxm_XtUngrabKey
- #define gxm_XtGrabKeyboard_w gxm_XtGrabKeyboard
- #define gxm_XtUngrabKeyboard_w gxm_XtUngrabKeyboard
- #define gxm_XtGrabButton_w gxm_XtGrabButton
- #define gxm_XtUngrabButton_w gxm_XtUngrabButton
- #define gxm_XtGrabPointer_w gxm_XtGrabPointer
- #define gxm_XtUngrabPointer_w gxm_XtUngrabPointer
- #define gxm_XtGetApplicationNameAndClass_w gxm_XtGetApplicationNameAndClass
- #define gxm_XtGetDisplays_w gxm_XtGetDisplays
- #define gxm_XtToolkitThreadInitialize_w gxm_XtToolkitThreadInitialize
- #define gxm_XtAppLock_w gxm_XtAppLock
- #define gxm_XtAppUnlock_w gxm_XtAppUnlock
- #define gxm_XtIsRectObj_w gxm_XtIsRectObj
- #define gxm_XtIsWidget_w gxm_XtIsWidget
- #define gxm_XtIsComposite_w gxm_XtIsComposite
- #define gxm_XtIsConstraint_w gxm_XtIsConstraint
- #define gxm_XtIsShell_w gxm_XtIsShell
- #define gxm_XtIsOverrideShell_w gxm_XtIsOverrideShell
- #define gxm_XtIsWMShell_w gxm_XtIsWMShell
- #define gxm_XtIsVendorShell_w gxm_XtIsVendorShell
- #define gxm_XtIsTransientShell_w gxm_XtIsTransientShell
- #define gxm_XtIsTopLevelShell_w gxm_XtIsTopLevelShell
- #define gxm_XtIsApplicationShell_w gxm_XtIsApplicationShell
- #define gxm_XtIsSessionShell_w gxm_XtIsSessionShell
- #define gxm_XtMapWidget_w gxm_XtMapWidget
- #define gxm_XtUnmapWidget_w gxm_XtUnmapWidget
-#endif
- #define gxm_XLoadQueryFont_w gxm_XLoadQueryFont
- #define gxm_XQueryFont_w gxm_XQueryFont
- #define gxm_XGetMotionEvents_w gxm_XGetMotionEvents
- #define gxm_XDeleteModifiermapEntry_w gxm_XDeleteModifiermapEntry
- #define gxm_XGetModifierMapping_w gxm_XGetModifierMapping
- #define gxm_XInsertModifiermapEntry_w gxm_XInsertModifiermapEntry
- #define gxm_XNewModifiermap_w gxm_XNewModifiermap
- #define gxm_XCreateImage_w gxm_XCreateImage
- #define gxm_XGetImage_w gxm_XGetImage
- #define gxm_XGetSubImage_w gxm_XGetSubImage
- #define gxm_XOpenDisplay_w gxm_XOpenDisplay
- #define gxm_XFetchBytes_w gxm_XFetchBytes
- #define gxm_XFetchBuffer_w gxm_XFetchBuffer
- #define gxm_XGetAtomName_w gxm_XGetAtomName
- #define gxm_XDisplayName_w gxm_XDisplayName
- #define gxm_XKeysymToString_w gxm_XKeysymToString
- #define gxm_XSynchronize_w gxm_XSynchronize
- #define gxm_XSetAfterFunction_w gxm_XSetAfterFunction
- #define gxm_XInternAtom_w gxm_XInternAtom
- #define gxm_XCopyColormapAndFree_w gxm_XCopyColormapAndFree
- #define gxm_XCreateColormap_w gxm_XCreateColormap
- #define gxm_XCreatePixmapCursor_w gxm_XCreatePixmapCursor
- #define gxm_XCreateGlyphCursor_w gxm_XCreateGlyphCursor
- #define gxm_XCreateFontCursor_w gxm_XCreateFontCursor
- #define gxm_XLoadFont_w gxm_XLoadFont
- #define gxm_XCreateGC_w gxm_XCreateGC
- #define gxm_XFlushGC_w gxm_XFlushGC
- #define gxm_XCreatePixmap_w gxm_XCreatePixmap
- #define gxm_XCreateBitmapFromData_w gxm_XCreateBitmapFromData
- #define gxm_XCreatePixmapFromBitmapData_w gxm_XCreatePixmapFromBitmapData
- #define gxm_XCreateSimpleWindow_w gxm_XCreateSimpleWindow
- #define gxm_XGetSelectionOwner_w gxm_XGetSelectionOwner
- #define gxm_XCreateWindow_w gxm_XCreateWindow
- #define gxm_XListInstalledColormaps_w gxm_XListInstalledColormaps
- #define gxm_XListFonts_w gxm_XListFonts
- #define gxm_XListFontsWithInfo_w gxm_XListFontsWithInfo
- #define gxm_XGetFontPath_w gxm_XGetFontPath
- #define gxm_XListExtensions_w gxm_XListExtensions
- #define gxm_XListProperties_w gxm_XListProperties
- #define gxm_XKeycodeToKeysym_w gxm_XKeycodeToKeysym
- #define gxm_XLookupKeysym_w gxm_XLookupKeysym
- #define gxm_XGetKeyboardMapping_w gxm_XGetKeyboardMapping
- #define gxm_XStringToKeysym_w gxm_XStringToKeysym
- #define gxm_XMaxRequestSize_w gxm_XMaxRequestSize
- #define gxm_XExtendedMaxRequestSize_w gxm_XExtendedMaxRequestSize
- #define gxm_XDisplayMotionBufferSize_w gxm_XDisplayMotionBufferSize
- #define gxm_XVisualIDFromVisual_w gxm_XVisualIDFromVisual
- #define gxm_XRootWindow_w gxm_XRootWindow
- #define gxm_XDefaultRootWindow_w gxm_XDefaultRootWindow
- #define gxm_XRootWindowOfScreen_w gxm_XRootWindowOfScreen
- #define gxm_XDefaultVisual_w gxm_XDefaultVisual
- #define gxm_XDefaultVisualOfScreen_w gxm_XDefaultVisualOfScreen
- #define gxm_XDefaultGC_w gxm_XDefaultGC
- #define gxm_XDefaultGCOfScreen_w gxm_XDefaultGCOfScreen
- #define gxm_XBlackPixel_w gxm_XBlackPixel
- #define gxm_XWhitePixel_w gxm_XWhitePixel
- #define gxm_XAllPlanes_w gxm_XAllPlanes
- #define gxm_XBlackPixelOfScreen_w gxm_XBlackPixelOfScreen
- #define gxm_XWhitePixelOfScreen_w gxm_XWhitePixelOfScreen
- #define gxm_XNextRequest_w gxm_XNextRequest
- #define gxm_XLastKnownRequestProcessed_w gxm_XLastKnownRequestProcessed
- #define gxm_XServerVendor_w gxm_XServerVendor
- #define gxm_XDisplayString_w gxm_XDisplayString
- #define gxm_XDefaultColormap_w gxm_XDefaultColormap
- #define gxm_XDefaultColormapOfScreen_w gxm_XDefaultColormapOfScreen
- #define gxm_XDisplayOfScreen_w gxm_XDisplayOfScreen
- #define gxm_XScreenOfDisplay_w gxm_XScreenOfDisplay
- #define gxm_XDefaultScreenOfDisplay_w gxm_XDefaultScreenOfDisplay
- #define gxm_XEventMaskOfScreen_w gxm_XEventMaskOfScreen
- #define gxm_XScreenNumberOfScreen_w gxm_XScreenNumberOfScreen
- #define gxm_XSetErrorHandler_w gxm_XSetErrorHandler
- #define gxm_XSetIOErrorHandler_w gxm_XSetIOErrorHandler
- #define gxm_XListPixmapFormats_w gxm_XListPixmapFormats
- #define gxm_XListDepths_w gxm_XListDepths
- #define gxm_XReconfigureWMWindow_w gxm_XReconfigureWMWindow
- #define gxm_XGetWMProtocols_w gxm_XGetWMProtocols
- #define gxm_XSetWMProtocols_w gxm_XSetWMProtocols
- #define gxm_XIconifyWindow_w gxm_XIconifyWindow
- #define gxm_XWithdrawWindow_w gxm_XWithdrawWindow
- #define gxm_XGetCommand_w gxm_XGetCommand
- #define gxm_XGetWMColormapWindows_w gxm_XGetWMColormapWindows
- #define gxm_XSetWMColormapWindows_w gxm_XSetWMColormapWindows
- #define gxm_XSetTransientForHint_w gxm_XSetTransientForHint
- #define gxm_XActivateScreenSaver_w gxm_XActivateScreenSaver
- #define gxm_XAllocColor_w gxm_XAllocColor
- #define gxm_XAllocColorCells_w gxm_XAllocColorCells
- #define gxm_XAllocColorPlanes_w gxm_XAllocColorPlanes
- #define gxm_XAllocNamedColor_w gxm_XAllocNamedColor
- #define gxm_XAllowEvents_w gxm_XAllowEvents
- #define gxm_XAutoRepeatOff_w gxm_XAutoRepeatOff
- #define gxm_XAutoRepeatOn_w gxm_XAutoRepeatOn
- #define gxm_XBell_w gxm_XBell
- #define gxm_XBitmapBitOrder_w gxm_XBitmapBitOrder
- #define gxm_XBitmapPad_w gxm_XBitmapPad
- #define gxm_XBitmapUnit_w gxm_XBitmapUnit
- #define gxm_XCellsOfScreen_w gxm_XCellsOfScreen
- #define gxm_XChangeActivePointerGrab_w gxm_XChangeActivePointerGrab
- #define gxm_XChangeGC_w gxm_XChangeGC
- #define gxm_XChangeKeyboardControl_w gxm_XChangeKeyboardControl
- #define gxm_XChangeKeyboardMapping_w gxm_XChangeKeyboardMapping
- #define gxm_XChangePointerControl_w gxm_XChangePointerControl
- #define gxm_XChangeProperty_w gxm_XChangeProperty
- #define gxm_XChangeWindowAttributes_w gxm_XChangeWindowAttributes
- #define gxm_XCheckIfEvent_w gxm_XCheckIfEvent
- #define gxm_XCheckMaskEvent_w gxm_XCheckMaskEvent
- #define gxm_XCheckTypedEvent_w gxm_XCheckTypedEvent
- #define gxm_XCheckTypedWindowEvent_w gxm_XCheckTypedWindowEvent
- #define gxm_XCheckWindowEvent_w gxm_XCheckWindowEvent
- #define gxm_XCirculateSubwindows_w gxm_XCirculateSubwindows
- #define gxm_XCirculateSubwindowsDown_w gxm_XCirculateSubwindowsDown
- #define gxm_XCirculateSubwindowsUp_w gxm_XCirculateSubwindowsUp
- #define gxm_XClearArea_w gxm_XClearArea
- #define gxm_XClearWindow_w gxm_XClearWindow
- #define gxm_XCloseDisplay_w gxm_XCloseDisplay
- #define gxm_XConfigureWindow_w gxm_XConfigureWindow
- #define gxm_XConnectionNumber_w gxm_XConnectionNumber
- #define gxm_XConvertSelection_w gxm_XConvertSelection
- #define gxm_XCopyArea_w gxm_XCopyArea
- #define gxm_XCopyGC_w gxm_XCopyGC
- #define gxm_XCopyPlane_w gxm_XCopyPlane
- #define gxm_XDefaultDepth_w gxm_XDefaultDepth
- #define gxm_XDefaultDepthOfScreen_w gxm_XDefaultDepthOfScreen
- #define gxm_XDefaultScreen_w gxm_XDefaultScreen
- #define gxm_XDefineCursor_w gxm_XDefineCursor
- #define gxm_XDeleteProperty_w gxm_XDeleteProperty
- #define gxm_XDestroyWindow_w gxm_XDestroyWindow
- #define gxm_XDestroySubwindows_w gxm_XDestroySubwindows
- #define gxm_XDoesBackingStore_w gxm_XDoesBackingStore
- #define gxm_XDoesSaveUnders_w gxm_XDoesSaveUnders
- #define gxm_XDisableAccessControl_w gxm_XDisableAccessControl
- #define gxm_XDisplayCells_w gxm_XDisplayCells
- #define gxm_XDisplayHeight_w gxm_XDisplayHeight
- #define gxm_XDisplayHeightMM_w gxm_XDisplayHeightMM
- #define gxm_XDisplayKeycodes_w gxm_XDisplayKeycodes
- #define gxm_XDisplayPlanes_w gxm_XDisplayPlanes
- #define gxm_XDisplayWidth_w gxm_XDisplayWidth
- #define gxm_XDisplayWidthMM_w gxm_XDisplayWidthMM
- #define gxm_XDrawArc_w gxm_XDrawArc
- #define gxm_XDrawArcs_w gxm_XDrawArcs
- #define gxm_XDrawImageString_w gxm_XDrawImageString
- #define gxm_XDrawLine_w gxm_XDrawLine
- #define gxm_XDrawLines_w gxm_XDrawLines
- #define gxm_XDrawLinesDirect_w gxm_XDrawLinesDirect
- #define gxm_FreeXPoints_w gxm_FreeXPoints
- #define gxm_Vector2XPoints_w gxm_Vector2XPoints
- #define gxm_XDrawPoint_w gxm_XDrawPoint
- #define gxm_XDrawPoints_w gxm_XDrawPoints
- #define gxm_XDrawRectangle_w gxm_XDrawRectangle
- #define gxm_XDrawRectangles_w gxm_XDrawRectangles
- #define gxm_XDrawSegments_w gxm_XDrawSegments
- #define gxm_XDrawString_w gxm_XDrawString
- #define gxm_XDrawText_w gxm_XDrawText
- #define gxm_XEnableAccessControl_w gxm_XEnableAccessControl
- #define gxm_XEventsQueued_w gxm_XEventsQueued
- #define gxm_XFetchName_w gxm_XFetchName
- #define gxm_XFillArc_w gxm_XFillArc
- #define gxm_XFillArcs_w gxm_XFillArcs
- #define gxm_XFillPolygon_w gxm_XFillPolygon
- #define gxm_XFillRectangle_w gxm_XFillRectangle
- #define gxm_XFillRectangles_w gxm_XFillRectangles
- #define gxm_XFlush_w gxm_XFlush
- #define gxm_XForceScreenSaver_w gxm_XForceScreenSaver
- #define gxm_XFree_w gxm_XFree
- #define gxm_XFreeColormap_w gxm_XFreeColormap
- #define gxm_XFreeColors_w gxm_XFreeColors
- #define gxm_XFreeCursor_w gxm_XFreeCursor
- #define gxm_XFreeExtensionList_w gxm_XFreeExtensionList
- #define gxm_XFreeFont_w gxm_XFreeFont
- #define gxm_XFreeFontInfo_w gxm_XFreeFontInfo
- #define gxm_XFreeFontNames_w gxm_XFreeFontNames
- #define gxm_XFreeFontPath_w gxm_XFreeFontPath
- #define gxm_XFreeGC_w gxm_XFreeGC
- #define gxm_XFreeModifiermap_w gxm_XFreeModifiermap
- #define gxm_XFreePixmap_w gxm_XFreePixmap
- #define gxm_XGeometry_w gxm_XGeometry
- #define gxm_XGetErrorText_w gxm_XGetErrorText
- #define gxm_XGetFontProperty_w gxm_XGetFontProperty
- #define gxm_XGetGCValues_w gxm_XGetGCValues
- #define gxm_XGCValues_w gxm_XGCValues
- #define gxm_XEvent_w gxm_XEvent
- #define gxm_XGetGeometry_w gxm_XGetGeometry
- #define gxm_XGetIconName_w gxm_XGetIconName
- #define gxm_XGetInputFocus_w gxm_XGetInputFocus
- #define gxm_XGetKeyboardControl_w gxm_XGetKeyboardControl
- #define gxm_XGetPointerControl_w gxm_XGetPointerControl
- #define gxm_XGetPointerMapping_w gxm_XGetPointerMapping
- #define gxm_XGetScreenSaver_w gxm_XGetScreenSaver
- #define gxm_XGetTransientForHint_w gxm_XGetTransientForHint
- #define gxm_XGetWindowProperty_w gxm_XGetWindowProperty
- #define gxm_XGetWindowAttributes_w gxm_XGetWindowAttributes
- #define gxm_XGrabButton_w gxm_XGrabButton
- #define gxm_XGrabKey_w gxm_XGrabKey
- #define gxm_XGrabKeyboard_w gxm_XGrabKeyboard
- #define gxm_XGrabPointer_w gxm_XGrabPointer
- #define gxm_XGrabServer_w gxm_XGrabServer
- #define gxm_XHeightMMOfScreen_w gxm_XHeightMMOfScreen
- #define gxm_XHeightOfScreen_w gxm_XHeightOfScreen
- #define gxm_XIfEvent_w gxm_XIfEvent
- #define gxm_XImageByteOrder_w gxm_XImageByteOrder
- #define gxm_XInstallColormap_w gxm_XInstallColormap
- #define gxm_XKeysymToKeycode_w gxm_XKeysymToKeycode
- #define gxm_XKillClient_w gxm_XKillClient
- #define gxm_XLookupColor_w gxm_XLookupColor
- #define gxm_XLowerWindow_w gxm_XLowerWindow
- #define gxm_XMapRaised_w gxm_XMapRaised
- #define gxm_XMapSubwindows_w gxm_XMapSubwindows
- #define gxm_XMapWindow_w gxm_XMapWindow
- #define gxm_XMaskEvent_w gxm_XMaskEvent
- #define gxm_XMaxCmapsOfScreen_w gxm_XMaxCmapsOfScreen
- #define gxm_XMinCmapsOfScreen_w gxm_XMinCmapsOfScreen
- #define gxm_XMoveResizeWindow_w gxm_XMoveResizeWindow
- #define gxm_XMoveWindow_w gxm_XMoveWindow
- #define gxm_XNextEvent_w gxm_XNextEvent
- #define gxm_XNoOp_w gxm_XNoOp
- #define gxm_XParseColor_w gxm_XParseColor
- #define gxm_XParseGeometry_w gxm_XParseGeometry
- #define gxm_XPeekEvent_w gxm_XPeekEvent
- #define gxm_XPeekIfEvent_w gxm_XPeekIfEvent
- #define gxm_XPending_w gxm_XPending
- #define gxm_XPlanesOfScreen_w gxm_XPlanesOfScreen
- #define gxm_XProtocolRevision_w gxm_XProtocolRevision
- #define gxm_XProtocolVersion_w gxm_XProtocolVersion
- #define gxm_XPutBackEvent_w gxm_XPutBackEvent
- #define gxm_XPutImage_w gxm_XPutImage
- #define gxm_XQLength_w gxm_XQLength
- #define gxm_XQueryBestCursor_w gxm_XQueryBestCursor
- #define gxm_XQueryBestSize_w gxm_XQueryBestSize
- #define gxm_XQueryBestStipple_w gxm_XQueryBestStipple
- #define gxm_XQueryBestTile_w gxm_XQueryBestTile
- #define gxm_XQueryColor_w gxm_XQueryColor
- #define gxm_XQueryColors_w gxm_XQueryColors
- #define gxm_XQueryExtension_w gxm_XQueryExtension
- #define gxm_XQueryKeymap_w gxm_XQueryKeymap
- #define gxm_XQueryPointer_w gxm_XQueryPointer
- #define gxm_XQueryTextExtents_w gxm_XQueryTextExtents
- #define gxm_XQueryTree_w gxm_XQueryTree
- #define gxm_XRaiseWindow_w gxm_XRaiseWindow
- #define gxm_XReadBitmapFile_w gxm_XReadBitmapFile
- #define gxm_XReadBitmapFileData_w gxm_XReadBitmapFileData
- #define gxm_XRebindKeysym_w gxm_XRebindKeysym
- #define gxm_XRecolorCursor_w gxm_XRecolorCursor
- #define gxm_XRefreshKeyboardMapping_w gxm_XRefreshKeyboardMapping
- #define gxm_XReparentWindow_w gxm_XReparentWindow
- #define gxm_XResetScreenSaver_w gxm_XResetScreenSaver
- #define gxm_XResizeWindow_w gxm_XResizeWindow
- #define gxm_XRestackWindows_w gxm_XRestackWindows
- #define gxm_XRotateBuffers_w gxm_XRotateBuffers
- #define gxm_XRotateWindowProperties_w gxm_XRotateWindowProperties
- #define gxm_XScreenCount_w gxm_XScreenCount
- #define gxm_XSelectInput_w gxm_XSelectInput
- #define gxm_XSendEvent_w gxm_XSendEvent
- #define gxm_XSetAccessControl_w gxm_XSetAccessControl
- #define gxm_XSetArcMode_w gxm_XSetArcMode
- #define gxm_XSetBackground_w gxm_XSetBackground
- #define gxm_XSetClipMask_w gxm_XSetClipMask
- #define gxm_XSetClipOrigin_w gxm_XSetClipOrigin
- #define gxm_XSetClipRectangles_w gxm_XSetClipRectangles
- #define gxm_XSetCloseDownMode_w gxm_XSetCloseDownMode
- #define gxm_XSetCommand_w gxm_XSetCommand
- #define gxm_XSetDashes_w gxm_XSetDashes
- #define gxm_XSetFillRule_w gxm_XSetFillRule
- #define gxm_XSetFillStyle_w gxm_XSetFillStyle
- #define gxm_XSetFont_w gxm_XSetFont
- #define gxm_XSetFontPath_w gxm_XSetFontPath
- #define gxm_XSetForeground_w gxm_XSetForeground
- #define gxm_XSetFunction_w gxm_XSetFunction
- #define gxm_XSetGraphicsExposures_w gxm_XSetGraphicsExposures
- #define gxm_XSetIconName_w gxm_XSetIconName
- #define gxm_XSetInputFocus_w gxm_XSetInputFocus
- #define gxm_XSetLineAttributes_w gxm_XSetLineAttributes
- #define gxm_XSetModifierMapping_w gxm_XSetModifierMapping
- #define gxm_XSetPlaneMask_w gxm_XSetPlaneMask
- #define gxm_XSetPointerMapping_w gxm_XSetPointerMapping
- #define gxm_XSetScreenSaver_w gxm_XSetScreenSaver
- #define gxm_XSetSelectionOwner_w gxm_XSetSelectionOwner
- #define gxm_XSetState_w gxm_XSetState
- #define gxm_XSetStipple_w gxm_XSetStipple
- #define gxm_XSetSubwindowMode_w gxm_XSetSubwindowMode
- #define gxm_XSetTSOrigin_w gxm_XSetTSOrigin
- #define gxm_XSetTile_w gxm_XSetTile
- #define gxm_XSetWindowBackground_w gxm_XSetWindowBackground
- #define gxm_XSetWindowBackgroundPixmap_w gxm_XSetWindowBackgroundPixmap
- #define gxm_XSetWindowBorder_w gxm_XSetWindowBorder
- #define gxm_XSetWindowBorderPixmap_w gxm_XSetWindowBorderPixmap
- #define gxm_XSetWindowBorderWidth_w gxm_XSetWindowBorderWidth
- #define gxm_XSetWindowColormap_w gxm_XSetWindowColormap
- #define gxm_XStoreBuffer_w gxm_XStoreBuffer
- #define gxm_XStoreBytes_w gxm_XStoreBytes
- #define gxm_XStoreColor_w gxm_XStoreColor
- #define gxm_XStoreColors_w gxm_XStoreColors
- #define gxm_XStoreName_w gxm_XStoreName
- #define gxm_XStoreNamedColor_w gxm_XStoreNamedColor
- #define gxm_XSync_w gxm_XSync
- #define gxm_XTextExtents_w gxm_XTextExtents
- #define gxm_XTextWidth_w gxm_XTextWidth
- #define gxm_XTranslateCoordinates_w gxm_XTranslateCoordinates
- #define gxm_XUndefineCursor_w gxm_XUndefineCursor
- #define gxm_XUngrabButton_w gxm_XUngrabButton
- #define gxm_XUngrabKey_w gxm_XUngrabKey
- #define gxm_XUngrabKeyboard_w gxm_XUngrabKeyboard
- #define gxm_XUngrabPointer_w gxm_XUngrabPointer
- #define gxm_XUngrabServer_w gxm_XUngrabServer
- #define gxm_XUninstallColormap_w gxm_XUninstallColormap
- #define gxm_XUnloadFont_w gxm_XUnloadFont
- #define gxm_XUnmapSubwindows_w gxm_XUnmapSubwindows
- #define gxm_XUnmapWindow_w gxm_XUnmapWindow
- #define gxm_XVendorRelease_w gxm_XVendorRelease
- #define gxm_XWarpPointer_w gxm_XWarpPointer
- #define gxm_XWidthMMOfScreen_w gxm_XWidthMMOfScreen
- #define gxm_XWidthOfScreen_w gxm_XWidthOfScreen
- #define gxm_XWindowEvent_w gxm_XWindowEvent
- #define gxm_XWriteBitmapFile_w gxm_XWriteBitmapFile
- #define gxm_XSupportsLocale_w gxm_XSupportsLocale
- #define gxm_XSetLocaleModifiers_w gxm_XSetLocaleModifiers
- #define gxm_XCreateFontSet_w gxm_XCreateFontSet
- #define gxm_XFreeFontSet_w gxm_XFreeFontSet
- #define gxm_XFontsOfFontSet_w gxm_XFontsOfFontSet
- #define gxm_XBaseFontNameListOfFontSet_w gxm_XBaseFontNameListOfFontSet
- #define gxm_XLocaleOfFontSet_w gxm_XLocaleOfFontSet
- #define gxm_XContextDependentDrawing_w gxm_XContextDependentDrawing
- #define gxm_XDirectionalDependentDrawing_w gxm_XDirectionalDependentDrawing
- #define gxm_XContextualDrawing_w gxm_XContextualDrawing
- #define gxm_XFilterEvent_w gxm_XFilterEvent
- #define gxm_XAllocIconSize_w gxm_XAllocIconSize
- #define gxm_XAllocStandardColormap_w gxm_XAllocStandardColormap
- #define gxm_XAllocWMHints_w gxm_XAllocWMHints
- #define gxm_XClipBox_w gxm_XClipBox
- #define gxm_XCreateRegion_w gxm_XCreateRegion
- #define gxm_XDefaultString_w gxm_XDefaultString
- #define gxm_XDeleteContext_w gxm_XDeleteContext
- #define gxm_XDestroyRegion_w gxm_XDestroyRegion
- #define gxm_XEmptyRegion_w gxm_XEmptyRegion
- #define gxm_XEqualRegion_w gxm_XEqualRegion
- #define gxm_XFindContext_w gxm_XFindContext
- #define gxm_XGetIconSizes_w gxm_XGetIconSizes
- #define gxm_XGetRGBColormaps_w gxm_XGetRGBColormaps
- #define gxm_XGetVisualInfo_w gxm_XGetVisualInfo
- #define gxm_XGetWMHints_w gxm_XGetWMHints
- #define gxm_XIntersectRegion_w gxm_XIntersectRegion
- #define gxm_XConvertCase_w gxm_XConvertCase
- #define gxm_XLookupString_w gxm_XLookupString
- #define gxm_XMatchVisualInfo_w gxm_XMatchVisualInfo
- #define gxm_XOffsetRegion_w gxm_XOffsetRegion
- #define gxm_XPointInRegion_w gxm_XPointInRegion
- #define gxm_XPolygonRegion_w gxm_XPolygonRegion
- #define gxm_XRectInRegion_w gxm_XRectInRegion
- #define gxm_XSaveContext_w gxm_XSaveContext
- #define gxm_XUniqueContext_w gxm_XUniqueContext
- #define gxm_XSetRGBColormaps_w gxm_XSetRGBColormaps
- #define gxm_XSetWMHints_w gxm_XSetWMHints
- #define gxm_XSetRegion_w gxm_XSetRegion
- #define gxm_XSetWMProperties_w gxm_XSetWMProperties
- #define gxm_XShrinkRegion_w gxm_XShrinkRegion
- #define gxm_XSubtractRegion_w gxm_XSubtractRegion
- #define gxm_XUnionRectWithRegion_w gxm_XUnionRectWithRegion
- #define gxm_XUnionRegion_w gxm_XUnionRegion
- #define gxm_XXorRegion_w gxm_XXorRegion
-
- #define gxm_DefaultScreen_w gxm_DefaultScreen
- #define gxm_DefaultRootWindow_w gxm_DefaultRootWindow
- #define gxm_QLength_w gxm_QLength
- #define gxm_ScreenCount_w gxm_ScreenCount
- #define gxm_ServerVendor_w gxm_ServerVendor
- #define gxm_ProtocolVersion_w gxm_ProtocolVersion
- #define gxm_ProtocolRevision_w gxm_ProtocolRevision
- #define gxm_VendorRelease_w gxm_VendorRelease
- #define gxm_DisplayString_w gxm_DisplayString
- #define gxm_BitmapUnit_w gxm_BitmapUnit
- #define gxm_BitmapBitOrder_w gxm_BitmapBitOrder
- #define gxm_BitmapPad_w gxm_BitmapPad
- #define gxm_ImageByteOrder_w gxm_ImageByteOrder
- #define gxm_NextRequest_w gxm_NextRequest
- #define gxm_LastKnownRequestProcessed_w gxm_LastKnownRequestProcessed
- #define gxm_DefaultScreenOfDisplay_w gxm_DefaultScreenOfDisplay
- #define gxm_DisplayOfScreen_w gxm_DisplayOfScreen
- #define gxm_RootWindowOfScreen_w gxm_RootWindowOfScreen
- #define gxm_BlackPixelOfScreen_w gxm_BlackPixelOfScreen
- #define gxm_WhitePixelOfScreen_w gxm_WhitePixelOfScreen
- #define gxm_DefaultColormapOfScreen_w gxm_DefaultColormapOfScreen
- #define gxm_DefaultDepthOfScreen_w gxm_DefaultDepthOfScreen
- #define gxm_DefaultGCOfScreen_w gxm_DefaultGCOfScreen
- #define gxm_DefaultVisualOfScreen_w gxm_DefaultVisualOfScreen
- #define gxm_WidthOfScreen_w gxm_WidthOfScreen
- #define gxm_HeightOfScreen_w gxm_HeightOfScreen
- #define gxm_WidthMMOfScreen_w gxm_WidthMMOfScreen
- #define gxm_HeightMMOfScreen_w gxm_HeightMMOfScreen
- #define gxm_PlanesOfScreen_w gxm_PlanesOfScreen
- #define gxm_CellsOfScreen_w gxm_CellsOfScreen
- #define gxm_MinCmapsOfScreen_w gxm_MinCmapsOfScreen
- #define gxm_MaxCmapsOfScreen_w gxm_MaxCmapsOfScreen
- #define gxm_DoesSaveUnders_w gxm_DoesSaveUnders
- #define gxm_DoesBackingStore_w gxm_DoesBackingStore
- #define gxm_EventMaskOfScreen_w gxm_EventMaskOfScreen
- #define gxm_RootWindow_w gxm_RootWindow
- #define gxm_DefaultVisual_w gxm_DefaultVisual
- #define gxm_DefaultGC_w gxm_DefaultGC
- #define gxm_BlackPixel_w gxm_BlackPixel
- #define gxm_WhitePixel_w gxm_WhitePixel
- #define gxm_DisplayWidth_w gxm_DisplayWidth
- #define gxm_DisplayHeight_w gxm_DisplayHeight
- #define gxm_DisplayWidthMM_w gxm_DisplayWidthMM
- #define gxm_DisplayHeightMM_w gxm_DisplayHeightMM
- #define gxm_DisplayPlanes_w gxm_DisplayPlanes
- #define gxm_DisplayCells_w gxm_DisplayCells
- #define gxm_DefaultColormap_w gxm_DefaultColormap
- #define gxm_ScreenOfDisplay_w gxm_ScreenOfDisplay
- #define gxm_DefaultDepth_w gxm_DefaultDepth
-
- #define gxm_IsKeypadKey_w gxm_IsKeypadKey
- #define gxm_IsPrivateKeypadKey_w gxm_IsPrivateKeypadKey
- #define gxm_IsCursorKey_w gxm_IsCursorKey
- #define gxm_IsPFKey_w gxm_IsPFKey
- #define gxm_IsFunctionKey_w gxm_IsFunctionKey
- #define gxm_IsMiscFunctionKey_w gxm_IsMiscFunctionKey
- #define gxm_IsModifierKey_w gxm_IsModifierKey
-
- #define XEN_XButtonEvent_p_w XEN_XButtonEvent_p
- #define XEN_XCirculateEvent_p_w XEN_XCirculateEvent_p
- #define XEN_XCirculateRequestEvent_p_w XEN_XCirculateRequestEvent_p
- #define XEN_XClientMessageEvent_p_w XEN_XClientMessageEvent_p
- #define XEN_XColormapEvent_p_w XEN_XColormapEvent_p
- #define XEN_XConfigureEvent_p_w XEN_XConfigureEvent_p
- #define XEN_XConfigureRequestEvent_p_w XEN_XConfigureRequestEvent_p
- #define XEN_XCreateWindowEvent_p_w XEN_XCreateWindowEvent_p
- #define XEN_XCrossingEvent_p_w XEN_XCrossingEvent_p
- #define XEN_XDestroyWindowEvent_p_w XEN_XDestroyWindowEvent_p
- #define XEN_XErrorEvent_p_w XEN_XErrorEvent_p
- #define XEN_XExposeEvent_p_w XEN_XExposeEvent_p
- #define XEN_XFocusChangeEvent_p_w XEN_XFocusChangeEvent_p
- #define XEN_XGraphicsExposeEvent_p_w XEN_XGraphicsExposeEvent_p
- #define XEN_XGravityEvent_p_w XEN_XGravityEvent_p
- #define XEN_XKeyEvent_p_w XEN_XKeyEvent_p
- #define XEN_XKeymapEvent_p_w XEN_XKeymapEvent_p
- #define XEN_XMapEvent_p_w XEN_XMapEvent_p
- #define XEN_XMapRequestEvent_p_w XEN_XMapRequestEvent_p
- #define XEN_XMappingEvent_p_w XEN_XMappingEvent_p
- #define XEN_XMotionEvent_p_w XEN_XMotionEvent_p
- #define XEN_XNoExposeEvent_p_w XEN_XNoExposeEvent_p
- #define XEN_XPropertyEvent_p_w XEN_XPropertyEvent_p
- #define XEN_XReparentEvent_p_w XEN_XReparentEvent_p
- #define XEN_XResizeRequestEvent_p_w XEN_XResizeRequestEvent_p
- #define XEN_XSelectionClearEvent_p_w XEN_XSelectionClearEvent_p
- #define XEN_XSelectionEvent_p_w XEN_XSelectionEvent_p
- #define XEN_XSelectionRequestEvent_p_w XEN_XSelectionRequestEvent_p
- #define XEN_XSetWindowAttributes_p_w XEN_XSetWindowAttributes_p
- #define XEN_XUnmapEvent_p_w XEN_XUnmapEvent_p
- #define XEN_XVisibilityEvent_p_w XEN_XVisibilityEvent_p
- #define XEN_XIconSize_p_w XEN_XIconSize_p
-
-#if HAVE_MOTIF
- #define gxm_XmCreateMessageBox_w gxm_XmCreateMessageBox
- #define gxm_XmCreateMessageDialog_w gxm_XmCreateMessageDialog
- #define gxm_XmCreateErrorDialog_w gxm_XmCreateErrorDialog
- #define gxm_XmCreateInformationDialog_w gxm_XmCreateInformationDialog
- #define gxm_XmCreateQuestionDialog_w gxm_XmCreateQuestionDialog
- #define gxm_XmCreateWarningDialog_w gxm_XmCreateWarningDialog
- #define gxm_XmCreateWorkingDialog_w gxm_XmCreateWorkingDialog
- #define gxm_XmCreateTemplateDialog_w gxm_XmCreateTemplateDialog
- #define gxm_XmMessageBoxGetChild_w gxm_XmMessageBoxGetChild
- #define gxm_XmCreateArrowButtonGadget_w gxm_XmCreateArrowButtonGadget
- #define gxm_XmCreateArrowButton_w gxm_XmCreateArrowButton
- #define gxm_XmCreateNotebook_w gxm_XmCreateNotebook
- #define gxm_XmNotebookGetPageInfo_w gxm_XmNotebookGetPageInfo
- #define gxm_XmTransferSetParameters_w gxm_XmTransferSetParameters
- #define gxm_XmTransferDone_w gxm_XmTransferDone
- #define gxm_XmTransferValue_w gxm_XmTransferValue
- #define gxm_XmTransferStartRequest_w gxm_XmTransferStartRequest
- #define gxm_XmTransferSendRequest_w gxm_XmTransferSendRequest
- #define gxm_XmCreateComboBox_w gxm_XmCreateComboBox
- #define gxm_XmCreateDropDownComboBox_w gxm_XmCreateDropDownComboBox
- #define gxm_XmCreateDropDownList_w gxm_XmCreateDropDownList
- #define gxm_XmComboBoxAddItem_w gxm_XmComboBoxAddItem
- #define gxm_XmComboBoxDeletePos_w gxm_XmComboBoxDeletePos
- #define gxm_XmComboBoxSelectItem_w gxm_XmComboBoxSelectItem
- #define gxm_XmComboBoxSetItem_w gxm_XmComboBoxSetItem
- #define gxm_XmComboBoxUpdate_w gxm_XmComboBoxUpdate
- #define gxm_XmCreateContainer_w gxm_XmCreateContainer
- #define gxm_XmContainerGetItemChildren_w gxm_XmContainerGetItemChildren
- #define gxm_XmContainerRelayout_w gxm_XmContainerRelayout
- #define gxm_XmContainerReorder_w gxm_XmContainerReorder
- #define gxm_XmContainerCut_w gxm_XmContainerCut
- #define gxm_XmContainerCopy_w gxm_XmContainerCopy
- #define gxm_XmContainerPaste_w gxm_XmContainerPaste
- #define gxm_XmContainerCopyLink_w gxm_XmContainerCopyLink
- #define gxm_XmContainerPasteLink_w gxm_XmContainerPasteLink
- #define gxm_XmCreateSpinBox_w gxm_XmCreateSpinBox
- #define gxm_XmSpinBoxValidatePosition_w gxm_XmSpinBoxValidatePosition
- #define gxm_XmCreateSimpleSpinBox_w gxm_XmCreateSimpleSpinBox
- #define gxm_XmSimpleSpinBoxAddItem_w gxm_XmSimpleSpinBoxAddItem
- #define gxm_XmSimpleSpinBoxDeletePos_w gxm_XmSimpleSpinBoxDeletePos
- #define gxm_XmSimpleSpinBoxSetItem_w gxm_XmSimpleSpinBoxSetItem
- #define gxm_XmDropSiteRegistered_w gxm_XmDropSiteRegistered
- #define gxm_XmTextFieldCopyLink_w gxm_XmTextFieldCopyLink
- #define gxm_XmTextFieldPasteLink_w gxm_XmTextFieldPasteLink
- #define gxm_XmTextGetCenterline_w gxm_XmTextGetCenterline
- #define gxm_XmToggleButtonGadgetSetValue_w gxm_XmToggleButtonGadgetSetValue
- #define gxm_XmCreateIconGadget_w gxm_XmCreateIconGadget
- #define gxm_XmCreateIconHeader_w gxm_XmCreateIconHeader
- #define gxm_XmObjectAtPoint_w gxm_XmObjectAtPoint
- #define gxm_XmConvertStringToUnits_w gxm_XmConvertStringToUnits
- #define gxm_XmCreateGrabShell_w gxm_XmCreateGrabShell
- #define gxm_XmToggleButtonSetValue_w gxm_XmToggleButtonSetValue
- #define gxm_XmTextPasteLink_w gxm_XmTextPasteLink
- #define gxm_XmTextCopyLink_w gxm_XmTextCopyLink
- #define gxm_XmScaleSetTicks_w gxm_XmScaleSetTicks
- #define gxm_XmInternAtom_w gxm_XmInternAtom
- #define gxm_XmGetAtomName_w gxm_XmGetAtomName
- #define gxm_XmCreatePanedWindow_w gxm_XmCreatePanedWindow
- #define gxm_XmCreateBulletinBoard_w gxm_XmCreateBulletinBoard
- #define gxm_XmCreateBulletinBoardDialog_w gxm_XmCreateBulletinBoardDialog
- #define gxm_XmCreateCascadeButtonGadget_w gxm_XmCreateCascadeButtonGadget
- #define gxm_XmCascadeButtonGadgetHighlight_w gxm_XmCascadeButtonGadgetHighlight
- #define gxm_XmAddProtocols_w gxm_XmAddProtocols
- #define gxm_XmRemoveProtocols_w gxm_XmRemoveProtocols
- #define gxm_XmAddProtocolCallback_w gxm_XmAddProtocolCallback
- #define gxm_XmRemoveProtocolCallback_w gxm_XmRemoveProtocolCallback
- #define gxm_XmActivateProtocol_w gxm_XmActivateProtocol
- #define gxm_XmDeactivateProtocol_w gxm_XmDeactivateProtocol
- #define gxm_XmSetProtocolHooks_w gxm_XmSetProtocolHooks
- #define gxm_XmCreateCascadeButton_w gxm_XmCreateCascadeButton
- #define gxm_XmCascadeButtonHighlight_w gxm_XmCascadeButtonHighlight
- #define gxm_XmCreatePushButtonGadget_w gxm_XmCreatePushButtonGadget
- #define gxm_XmCreatePushButton_w gxm_XmCreatePushButton
- #define gxm_XmCreateCommand_w gxm_XmCreateCommand
- #define gxm_XmCommandGetChild_w gxm_XmCommandGetChild
- #define gxm_XmCommandSetValue_w gxm_XmCommandSetValue
- #define gxm_XmCommandAppendValue_w gxm_XmCommandAppendValue
- #define gxm_XmCommandError_w gxm_XmCommandError
- #define gxm_XmCreateCommandDialog_w gxm_XmCreateCommandDialog
- #define gxm_XmMenuPosition_w gxm_XmMenuPosition
- #define gxm_XmCreateRowColumn_w gxm_XmCreateRowColumn
- #define gxm_XmCreateWorkArea_w gxm_XmCreateWorkArea
- #define gxm_XmCreateRadioBox_w gxm_XmCreateRadioBox
- #define gxm_XmCreateOptionMenu_w gxm_XmCreateOptionMenu
- #define gxm_XmOptionLabelGadget_w gxm_XmOptionLabelGadget
- #define gxm_XmOptionButtonGadget_w gxm_XmOptionButtonGadget
- #define gxm_XmCreateMenuBar_w gxm_XmCreateMenuBar
- #define gxm_XmCreatePopupMenu_w gxm_XmCreatePopupMenu
- #define gxm_XmCreatePulldownMenu_w gxm_XmCreatePulldownMenu
- #define gxm_XmGetPostedFromWidget_w gxm_XmGetPostedFromWidget
- #define gxm_XmGetTearOffControl_w gxm_XmGetTearOffControl
- #define gxm_XmScaleSetValue_w gxm_XmScaleSetValue
- #define gxm_XmScaleGetValue_w gxm_XmScaleGetValue
- #define gxm_XmCreateScale_w gxm_XmCreateScale
- #define gxm_XmClipboardBeginCopy_w gxm_XmClipboardBeginCopy
- #define gxm_XmClipboardStartCopy_w gxm_XmClipboardStartCopy
- #define gxm_XmClipboardCopy_w gxm_XmClipboardCopy
- #define gxm_XmClipboardEndCopy_w gxm_XmClipboardEndCopy
- #define gxm_XmClipboardCancelCopy_w gxm_XmClipboardCancelCopy
- #define gxm_XmClipboardWithdrawFormat_w gxm_XmClipboardWithdrawFormat
- #define gxm_XmClipboardCopyByName_w gxm_XmClipboardCopyByName
- #define gxm_XmClipboardUndoCopy_w gxm_XmClipboardUndoCopy
- #define gxm_XmClipboardLock_w gxm_XmClipboardLock
- #define gxm_XmClipboardUnlock_w gxm_XmClipboardUnlock
- #define gxm_XmClipboardStartRetrieve_w gxm_XmClipboardStartRetrieve
- #define gxm_XmClipboardEndRetrieve_w gxm_XmClipboardEndRetrieve
- #define gxm_XmClipboardRetrieve_w gxm_XmClipboardRetrieve
- #define gxm_XmClipboardInquireCount_w gxm_XmClipboardInquireCount
- #define gxm_XmClipboardInquireFormat_w gxm_XmClipboardInquireFormat
- #define gxm_XmClipboardInquireLength_w gxm_XmClipboardInquireLength
- #define gxm_XmClipboardInquirePendingItems_w gxm_XmClipboardInquirePendingItems
- #define gxm_XmClipboardRegisterFormat_w gxm_XmClipboardRegisterFormat
-#if HAVE_XmToolTipGetLabel
- #define gxm_XmToolTipGetLabel_w gxm_XmToolTipGetLabel
-#endif
- #define gxm_XmGetXmScreen_w gxm_XmGetXmScreen
-#if HAVE_XmCreateFontSelector
- #define gxm_XmCreateFontSelector_w gxm_XmCreateFontSelector
-#endif
-#if HAVE_XmCreateColorSelector
- #define gxm_XmCreateColorSelector_w gxm_XmCreateColorSelector
-#endif
- #define gxm_XmCreateScrollBar_w gxm_XmCreateScrollBar
- #define gxm_XmScrollBarGetValues_w gxm_XmScrollBarGetValues
- #define gxm_XmScrollBarSetValues_w gxm_XmScrollBarSetValues
- #define gxm_XmCreateDialogShell_w gxm_XmCreateDialogShell
- #define gxm_XmCreateScrolledWindow_w gxm_XmCreateScrolledWindow
- #define gxm_XmScrollVisible_w gxm_XmScrollVisible
- #define gxm_XmGetDragContext_w gxm_XmGetDragContext
- #define gxm_XmGetXmDisplay_w gxm_XmGetXmDisplay
- #define gxm_XmSelectionBoxGetChild_w gxm_XmSelectionBoxGetChild
- #define gxm_XmCreateSelectionBox_w gxm_XmCreateSelectionBox
- #define gxm_XmCreateSelectionDialog_w gxm_XmCreateSelectionDialog
- #define gxm_XmCreatePromptDialog_w gxm_XmCreatePromptDialog
- #define gxm_XmDragStart_w gxm_XmDragStart
- #define gxm_XmDragCancel_w gxm_XmDragCancel
- #define gxm_XmTargetsAreCompatible_w gxm_XmTargetsAreCompatible
- #define gxm_XmCreateSeparatorGadget_w gxm_XmCreateSeparatorGadget
- #define gxm_XmCreateDragIcon_w gxm_XmCreateDragIcon
- #define gxm_XmCreateSeparator_w gxm_XmCreateSeparator
- #define gxm_XmCreateDrawingArea_w gxm_XmCreateDrawingArea
- #define gxm_XmCreateDrawnButton_w gxm_XmCreateDrawnButton
- #define gxm_XmDropSiteRegister_w gxm_XmDropSiteRegister
- #define gxm_XmDropSiteUnregister_w gxm_XmDropSiteUnregister
- #define gxm_XmDropSiteStartUpdate_w gxm_XmDropSiteStartUpdate
- #define gxm_XmDropSiteUpdate_w gxm_XmDropSiteUpdate
- #define gxm_XmDropSiteEndUpdate_w gxm_XmDropSiteEndUpdate
- #define gxm_XmDropSiteRetrieve_w gxm_XmDropSiteRetrieve
- #define gxm_XmDropSiteQueryStackingOrder_w gxm_XmDropSiteQueryStackingOrder
- #define gxm_XmDropSiteConfigureStackingOrder_w gxm_XmDropSiteConfigureStackingOrder
- #define gxm_XmDropTransferStart_w gxm_XmDropTransferStart
- #define gxm_XmDropTransferAdd_w gxm_XmDropTransferAdd
- #define gxm_XmTextFieldGetString_w gxm_XmTextFieldGetString
- #define gxm_XmTextFieldGetSubstring_w gxm_XmTextFieldGetSubstring
- #define gxm_XmTextFieldGetLastPosition_w gxm_XmTextFieldGetLastPosition
- #define gxm_XmTextFieldSetString_w gxm_XmTextFieldSetString
- #define gxm_XmTextFieldReplace_w gxm_XmTextFieldReplace
- #define gxm_XmTextFieldInsert_w gxm_XmTextFieldInsert
- #define gxm_XmTextFieldSetAddMode_w gxm_XmTextFieldSetAddMode
- #define gxm_XmTextFieldGetAddMode_w gxm_XmTextFieldGetAddMode
- #define gxm_XmTextFieldGetEditable_w gxm_XmTextFieldGetEditable
- #define gxm_XmTextFieldSetEditable_w gxm_XmTextFieldSetEditable
- #define gxm_XmTextFieldGetMaxLength_w gxm_XmTextFieldGetMaxLength
- #define gxm_XmTextFieldSetMaxLength_w gxm_XmTextFieldSetMaxLength
- #define gxm_XmTextFieldGetCursorPosition_w gxm_XmTextFieldGetCursorPosition
- #define gxm_XmTextFieldGetInsertionPosition_w gxm_XmTextFieldGetInsertionPosition
- #define gxm_XmTextFieldSetCursorPosition_w gxm_XmTextFieldSetCursorPosition
- #define gxm_XmTextFieldSetInsertionPosition_w gxm_XmTextFieldSetInsertionPosition
- #define gxm_XmTextFieldGetSelectionPosition_w gxm_XmTextFieldGetSelectionPosition
- #define gxm_XmTextFieldGetSelection_w gxm_XmTextFieldGetSelection
- #define gxm_XmTextFieldRemove_w gxm_XmTextFieldRemove
- #define gxm_XmTextFieldCopy_w gxm_XmTextFieldCopy
- #define gxm_XmTextFieldCut_w gxm_XmTextFieldCut
- #define gxm_XmTextFieldPaste_w gxm_XmTextFieldPaste
- #define gxm_XmTextFieldClearSelection_w gxm_XmTextFieldClearSelection
- #define gxm_XmTextFieldSetSelection_w gxm_XmTextFieldSetSelection
- #define gxm_XmTextFieldXYToPos_w gxm_XmTextFieldXYToPos
- #define gxm_XmTextFieldPosToXY_w gxm_XmTextFieldPosToXY
- #define gxm_XmTextFieldShowPosition_w gxm_XmTextFieldShowPosition
- #define gxm_XmTextFieldSetHighlight_w gxm_XmTextFieldSetHighlight
- #define gxm_XmTextFieldGetBaseline_w gxm_XmTextFieldGetBaseline
- #define gxm_XmCreateTextField_w gxm_XmCreateTextField
- #define gxm_XmFileSelectionBoxGetChild_w gxm_XmFileSelectionBoxGetChild
- #define gxm_XmFileSelectionDoSearch_w gxm_XmFileSelectionDoSearch
- #define gxm_XmCreateFileSelectionBox_w gxm_XmCreateFileSelectionBox
- #define gxm_XmCreateFileSelectionDialog_w gxm_XmCreateFileSelectionDialog
- #define gxm_XmTextSetHighlight_w gxm_XmTextSetHighlight
- #define gxm_XmCreateScrolledText_w gxm_XmCreateScrolledText
- #define gxm_XmCreateText_w gxm_XmCreateText
- #define gxm_XmTextGetSubstring_w gxm_XmTextGetSubstring
- #define gxm_XmTextGetString_w gxm_XmTextGetString
- #define gxm_XmTextGetLastPosition_w gxm_XmTextGetLastPosition
- #define gxm_XmTextSetString_w gxm_XmTextSetString
- #define gxm_XmTextReplace_w gxm_XmTextReplace
- #define gxm_XmTextInsert_w gxm_XmTextInsert
- #define gxm_XmTextSetAddMode_w gxm_XmTextSetAddMode
- #define gxm_XmTextGetAddMode_w gxm_XmTextGetAddMode
- #define gxm_XmTextGetEditable_w gxm_XmTextGetEditable
- #define gxm_XmTextSetEditable_w gxm_XmTextSetEditable
- #define gxm_XmTextGetMaxLength_w gxm_XmTextGetMaxLength
- #define gxm_XmTextSetMaxLength_w gxm_XmTextSetMaxLength
- #define gxm_XmTextGetTopCharacter_w gxm_XmTextGetTopCharacter
- #define gxm_XmTextSetTopCharacter_w gxm_XmTextSetTopCharacter
- #define gxm_XmTextGetCursorPosition_w gxm_XmTextGetCursorPosition
- #define gxm_XmTextGetInsertionPosition_w gxm_XmTextGetInsertionPosition
- #define gxm_XmTextSetInsertionPosition_w gxm_XmTextSetInsertionPosition
- #define gxm_XmTextSetCursorPosition_w gxm_XmTextSetCursorPosition
- #define gxm_XmTextRemove_w gxm_XmTextRemove
- #define gxm_XmTextCopy_w gxm_XmTextCopy
- #define gxm_XmTextCut_w gxm_XmTextCut
- #define gxm_XmTextPaste_w gxm_XmTextPaste
- #define gxm_XmTextGetSelection_w gxm_XmTextGetSelection
- #define gxm_XmTextSetSelection_w gxm_XmTextSetSelection
- #define gxm_XmTextClearSelection_w gxm_XmTextClearSelection
- #define gxm_XmTextGetSelectionPosition_w gxm_XmTextGetSelectionPosition
- #define gxm_XmTextXYToPos_w gxm_XmTextXYToPos
- #define gxm_XmTextPosToXY_w gxm_XmTextPosToXY
- #define gxm_XmTextGetSource_w gxm_XmTextGetSource
- #define gxm_XmTextSetSource_w gxm_XmTextSetSource
- #define gxm_XmTextShowPosition_w gxm_XmTextShowPosition
- #define gxm_XmTextScroll_w gxm_XmTextScroll
- #define gxm_XmTextGetBaseline_w gxm_XmTextGetBaseline
- #define gxm_XmTextDisableRedisplay_w gxm_XmTextDisableRedisplay
- #define gxm_XmTextEnableRedisplay_w gxm_XmTextEnableRedisplay
- #define gxm_XmTextFindString_w gxm_XmTextFindString
- #define gxm_XmCreateForm_w gxm_XmCreateForm
- #define gxm_XmCreateFormDialog_w gxm_XmCreateFormDialog
- #define gxm_XmCreateFrame_w gxm_XmCreateFrame
- #define gxm_XmToggleButtonGadgetGetState_w gxm_XmToggleButtonGadgetGetState
- #define gxm_XmToggleButtonGadgetSetState_w gxm_XmToggleButtonGadgetSetState
- #define gxm_XmCreateToggleButtonGadget_w gxm_XmCreateToggleButtonGadget
- #define gxm_XmToggleButtonGetState_w gxm_XmToggleButtonGetState
- #define gxm_XmToggleButtonSetState_w gxm_XmToggleButtonSetState
- #define gxm_XmCreateToggleButton_w gxm_XmCreateToggleButton
- #define gxm_XmCreateLabelGadget_w gxm_XmCreateLabelGadget
- #define gxm_XmCreateLabel_w gxm_XmCreateLabel
- #define gxm_XmIsMotifWMRunning_w gxm_XmIsMotifWMRunning
- #define gxm_XmListAddItem_w gxm_XmListAddItem
- #define gxm_XmListAddItems_w gxm_XmListAddItems
- #define gxm_XmListAddItemsUnselected_w gxm_XmListAddItemsUnselected
- #define gxm_XmListAddItemUnselected_w gxm_XmListAddItemUnselected
- #define gxm_XmListDeleteItem_w gxm_XmListDeleteItem
- #define gxm_XmListDeleteItems_w gxm_XmListDeleteItems
- #define gxm_XmListDeletePositions_w gxm_XmListDeletePositions
- #define gxm_XmListDeletePos_w gxm_XmListDeletePos
- #define gxm_XmListDeleteItemsPos_w gxm_XmListDeleteItemsPos
- #define gxm_XmListDeleteAllItems_w gxm_XmListDeleteAllItems
- #define gxm_XmListReplaceItems_w gxm_XmListReplaceItems
- #define gxm_XmListReplaceItemsPos_w gxm_XmListReplaceItemsPos
- #define gxm_XmListReplaceItemsUnselected_w gxm_XmListReplaceItemsUnselected
- #define gxm_XmListReplaceItemsPosUnselected_w gxm_XmListReplaceItemsPosUnselected
- #define gxm_XmListReplacePositions_w gxm_XmListReplacePositions
- #define gxm_XmListSelectItem_w gxm_XmListSelectItem
- #define gxm_XmListSelectPos_w gxm_XmListSelectPos
- #define gxm_XmListDeselectItem_w gxm_XmListDeselectItem
- #define gxm_XmListDeselectPos_w gxm_XmListDeselectPos
- #define gxm_XmListDeselectAllItems_w gxm_XmListDeselectAllItems
- #define gxm_XmListSetPos_w gxm_XmListSetPos
- #define gxm_XmListSetBottomPos_w gxm_XmListSetBottomPos
- #define gxm_XmListSetItem_w gxm_XmListSetItem
- #define gxm_XmListSetBottomItem_w gxm_XmListSetBottomItem
- #define gxm_XmListSetAddMode_w gxm_XmListSetAddMode
- #define gxm_XmListItemExists_w gxm_XmListItemExists
- #define gxm_XmListItemPos_w gxm_XmListItemPos
- #define gxm_XmListGetKbdItemPos_w gxm_XmListGetKbdItemPos
- #define gxm_XmListSetKbdItemPos_w gxm_XmListSetKbdItemPos
- #define gxm_XmListYToPos_w gxm_XmListYToPos
- #define gxm_XmListPosToBounds_w gxm_XmListPosToBounds
- #define gxm_XmListGetMatchPos_w gxm_XmListGetMatchPos
- #define gxm_XmListSetHorizPos_w gxm_XmListSetHorizPos
- #define gxm_XmListUpdateSelectedList_w gxm_XmListUpdateSelectedList
- #define gxm_XmListPosSelected_w gxm_XmListPosSelected
- #define gxm_XmCreateList_w gxm_XmCreateList
- #define gxm_XmCreateScrolledList_w gxm_XmCreateScrolledList
- #define gxm_XmTranslateKey_w gxm_XmTranslateKey
- #define gxm_XmCreateMainWindow_w gxm_XmCreateMainWindow
- #define gxm_XmInstallImage_w gxm_XmInstallImage
- #define gxm_XmUninstallImage_w gxm_XmUninstallImage
- #define gxm_XmGetPixmap_w gxm_XmGetPixmap
- #define gxm_XmGetPixmapByDepth_w gxm_XmGetPixmapByDepth
- #define gxm_XmDestroyPixmap_w gxm_XmDestroyPixmap
- #define gxm_XmUpdateDisplay_w gxm_XmUpdateDisplay
- #define gxm_XmWidgetGetBaselines_w gxm_XmWidgetGetBaselines
- #define gxm_XmRegisterSegmentEncoding_w gxm_XmRegisterSegmentEncoding
- #define gxm_XmMapSegmentEncoding_w gxm_XmMapSegmentEncoding
- #define gxm_XmCvtCTToXmString_w gxm_XmCvtCTToXmString
- #define gxm_XmCvtXmStringToCT_w gxm_XmCvtXmStringToCT
- #define gxm_XmConvertUnits_w gxm_XmConvertUnits
- #define gxm_XmCreateSimpleMenuBar_w gxm_XmCreateSimpleMenuBar
- #define gxm_XmCreateSimplePopupMenu_w gxm_XmCreateSimplePopupMenu
- #define gxm_XmCreateSimplePulldownMenu_w gxm_XmCreateSimplePulldownMenu
- #define gxm_XmCreateSimpleOptionMenu_w gxm_XmCreateSimpleOptionMenu
- #define gxm_XmCreateSimpleRadioBox_w gxm_XmCreateSimpleRadioBox
- #define gxm_XmCreateSimpleCheckBox_w gxm_XmCreateSimpleCheckBox
- #define gxm_XmVaCreateSimpleMenuBar_w gxm_XmVaCreateSimpleMenuBar
- #define gxm_XmVaCreateSimplePopupMenu_w gxm_XmVaCreateSimplePopupMenu
- #define gxm_XmVaCreateSimplePulldownMenu_w gxm_XmVaCreateSimplePulldownMenu
- #define gxm_XmVaCreateSimpleOptionMenu_w gxm_XmVaCreateSimpleOptionMenu
- #define gxm_XmVaCreateSimpleRadioBox_w gxm_XmVaCreateSimpleRadioBox
- #define gxm_XmVaCreateSimpleCheckBox_w gxm_XmVaCreateSimpleCheckBox
- #define gxm_XmTrackingEvent_w gxm_XmTrackingEvent
- #define gxm_XmSetColorCalculation_w gxm_XmSetColorCalculation
- #define gxm_XmGetColorCalculation_w gxm_XmGetColorCalculation
- #define gxm_XmGetColors_w gxm_XmGetColors
- #define gxm_XmChangeColor_w gxm_XmChangeColor
- #define gxm_XmStringCreate_w gxm_XmStringCreate
- #define gxm_XmStringCreateLocalized_w gxm_XmStringCreateLocalized
- #define gxm_XmStringDirectionCreate_w gxm_XmStringDirectionCreate
- #define gxm_XmStringSeparatorCreate_w gxm_XmStringSeparatorCreate
- #define gxm_XmStringInitContext_w gxm_XmStringInitContext
- #define gxm_XmStringFreeContext_w gxm_XmStringFreeContext
- #define gxm_XmStringConcatAndFree_w gxm_XmStringConcatAndFree
- #define gxm_XmStringIsVoid_w gxm_XmStringIsVoid
- #define gxm_XmStringPeekNextTriple_w gxm_XmStringPeekNextTriple
- #define gxm_XmStringGetNextTriple_w gxm_XmStringGetNextTriple
- #define gxm_XmStringComponentCreate_w gxm_XmStringComponentCreate
- #define gxm_XmStringUnparse_w gxm_XmStringUnparse
- #define gxm_XmStringParseText_w gxm_XmStringParseText
- #define gxm_XmStringToXmStringTable_w gxm_XmStringToXmStringTable
- #define gxm_XmStringTableToXmString_w gxm_XmStringTableToXmString
- #define gxm_XmStringTableUnparse_w gxm_XmStringTableUnparse
- #define gxm_XmStringTableParseStringArray_w gxm_XmStringTableParseStringArray
- #define gxm_XmDirectionToStringDirection_w gxm_XmDirectionToStringDirection
- #define gxm_XmStringDirectionToDirection_w gxm_XmStringDirectionToDirection
- #define gxm_XmStringGenerate_w gxm_XmStringGenerate
- #define gxm_XmStringPutRendition_w gxm_XmStringPutRendition
- #define gxm_XmParseMappingCreate_w gxm_XmParseMappingCreate
- #define gxm_XmParseMappingSetValues_w gxm_XmParseMappingSetValues
- #define gxm_XmParseMappingGetValues_w gxm_XmParseMappingGetValues
- #define gxm_XmParseMappingFree_w gxm_XmParseMappingFree
- #define gxm_XmParseTableFree_w gxm_XmParseTableFree
- #define gxm_XmStringTableProposeTablist_w gxm_XmStringTableProposeTablist
- #define gxm_XmTabSetValue_w gxm_XmTabSetValue
- #define gxm_XmTabGetValues_w gxm_XmTabGetValues
- #define gxm_XmTabFree_w gxm_XmTabFree
- #define gxm_XmTabListFree_w gxm_XmTabListFree
- #define gxm_XmTabCreate_w gxm_XmTabCreate
- #define gxm_XmTabListTabCount_w gxm_XmTabListTabCount
- #define gxm_XmTabListRemoveTabs_w gxm_XmTabListRemoveTabs
- #define gxm_XmTabListReplacePositions_w gxm_XmTabListReplacePositions
- #define gxm_XmTabListGetTab_w gxm_XmTabListGetTab
- #define gxm_XmTabListCopy_w gxm_XmTabListCopy
- #define gxm_XmTabListInsertTabs_w gxm_XmTabListInsertTabs
- #define gxm_XmRenderTableCvtFromProp_w gxm_XmRenderTableCvtFromProp
- #define gxm_XmRenderTableCvtToProp_w gxm_XmRenderTableCvtToProp
- #define gxm_XmRenditionUpdate_w gxm_XmRenditionUpdate
- #define gxm_XmRenditionRetrieve_w gxm_XmRenditionRetrieve
- #define gxm_XmRenditionFree_w gxm_XmRenditionFree
- #define gxm_XmRenditionCreate_w gxm_XmRenditionCreate
- #define gxm_XmRenderTableGetRenditions_w gxm_XmRenderTableGetRenditions
- #define gxm_XmRenderTableGetRendition_w gxm_XmRenderTableGetRendition
- #define gxm_XmRenderTableGetTags_w gxm_XmRenderTableGetTags
- #define gxm_XmRenderTableFree_w gxm_XmRenderTableFree
- #define gxm_XmRenderTableCopy_w gxm_XmRenderTableCopy
- #define gxm_XmRenderTableRemoveRenditions_w gxm_XmRenderTableRemoveRenditions
- #define gxm_XmRenderTableAddRenditions_w gxm_XmRenderTableAddRenditions
- #define gxm_XmStringConcat_w gxm_XmStringConcat
- #define gxm_XmStringCopy_w gxm_XmStringCopy
- #define gxm_XmStringCompare_w gxm_XmStringCompare
- #define gxm_XmStringEmpty_w gxm_XmStringEmpty
- #define gxm_XmStringHasSubstring_w gxm_XmStringHasSubstring
- #define gxm_XmStringFree_w gxm_XmStringFree
- #define gxm_XmStringBaseline_w gxm_XmStringBaseline
- #define gxm_XmStringWidth_w gxm_XmStringWidth
- #define gxm_XmStringHeight_w gxm_XmStringHeight
- #define gxm_XmStringExtent_w gxm_XmStringExtent
- #define gxm_XmStringLineCount_w gxm_XmStringLineCount
- #define gxm_XmStringDraw_w gxm_XmStringDraw
- #define gxm_XmStringDrawImage_w gxm_XmStringDrawImage
- #define gxm_XmStringDrawUnderline_w gxm_XmStringDrawUnderline
-
- #define gxm_XmGetDestination_w gxm_XmGetDestination
- #define gxm_XmIsTraversable_w gxm_XmIsTraversable
- #define gxm_XmGetVisibility_w gxm_XmGetVisibility
- #define gxm_XmGetTabGroup_w gxm_XmGetTabGroup
- #define gxm_XmGetFocusWidget_w gxm_XmGetFocusWidget
- #define gxm_XmProcessTraversal_w gxm_XmProcessTraversal
- #define gxm_XmCreateMenuShell_w gxm_XmCreateMenuShell
-
- #define gxm_XmIsMessageBox_w gxm_XmIsMessageBox
- #define gxm_XmIsArrowButtonGadget_w gxm_XmIsArrowButtonGadget
- #define gxm_XmIsArrowButton_w gxm_XmIsArrowButton
- #define gxm_XmCvtXmStringToByteStream_w gxm_XmCvtXmStringToByteStream
- #define gxm_XmCvtByteStreamToXmString_w gxm_XmCvtByteStreamToXmString
- #define gxm_XmStringByteStreamLength_w gxm_XmStringByteStreamLength
- #define gxm_XmIsNotebook_w gxm_XmIsNotebook
- #define gxm_XmIsComboBox_w gxm_XmIsComboBox
- #define gxm_XmIsContainer_w gxm_XmIsContainer
- #define gxm_XmIsGrabShell_w gxm_XmIsGrabShell
- #define gxm_XmIsIconGadget_w gxm_XmIsIconGadget
- #define gxm_XmIsIconHeader_w gxm_XmIsIconHeader
- #define gxm_XmIsPanedWindow_w gxm_XmIsPanedWindow
- #define gxm_XmIsBulletinBoard_w gxm_XmIsBulletinBoard
- #define gxm_XmIsPrimitive_w gxm_XmIsPrimitive
- #define gxm_XmIsCascadeButtonGadget_w gxm_XmIsCascadeButtonGadget
- #define gxm_XmIsCascadeButton_w gxm_XmIsCascadeButton
- #define gxm_XmIsPushButtonGadget_w gxm_XmIsPushButtonGadget
- #define gxm_XmIsPushButton_w gxm_XmIsPushButton
- #define gxm_XmIsCommand_w gxm_XmIsCommand
- #define gxm_XmIsRowColumn_w gxm_XmIsRowColumn
- #define gxm_XmIsScale_w gxm_XmIsScale
- #define gxm_XmIsScreen_w gxm_XmIsScreen
- #define gxm_XmIsScrollBar_w gxm_XmIsScrollBar
- #define gxm_XmIsDialogShell_w gxm_XmIsDialogShell
- #define gxm_XmIsScrolledWindow_w gxm_XmIsScrolledWindow
- #define gxm_XmIsDisplay_w gxm_XmIsDisplay
- #define gxm_XmIsSelectionBox_w gxm_XmIsSelectionBox
- #define gxm_XmIsDragContext_w gxm_XmIsDragContext
- #define gxm_XmIsSeparatorGadget_w gxm_XmIsSeparatorGadget
- #define gxm_XmIsDragIconObjectClass_w gxm_XmIsDragIconObjectClass
- #define gxm_XmIsSeparator_w gxm_XmIsSeparator
- #define gxm_XmIsDrawingArea_w gxm_XmIsDrawingArea
- #define gxm_XmIsDrawnButton_w gxm_XmIsDrawnButton
- #define gxm_XmIsDropSiteManager_w gxm_XmIsDropSiteManager
- #define gxm_XmIsDropTransfer_w gxm_XmIsDropTransfer
- #define gxm_XmIsTextField_w gxm_XmIsTextField
- #define gxm_XmIsFileSelectionBox_w gxm_XmIsFileSelectionBox
- #define gxm_XmIsText_w gxm_XmIsText
- #define gxm_XmIsForm_w gxm_XmIsForm
- #define gxm_XmIsFrame_w gxm_XmIsFrame
- #define gxm_XmIsGadget_w gxm_XmIsGadget
- #define gxm_XmIsToggleButtonGadget_w gxm_XmIsToggleButtonGadget
- #define gxm_XmIsToggleButton_w gxm_XmIsToggleButton
- #define gxm_XmIsLabelGadget_w gxm_XmIsLabelGadget
- #define gxm_XmIsLabel_w gxm_XmIsLabel
- #define gxm_XmIsVendorShell_w gxm_XmIsVendorShell
- #define gxm_XmIsList_w gxm_XmIsList
- #define gxm_XmIsMainWindow_w gxm_XmIsMainWindow
- #define gxm_XmIsManager_w gxm_XmIsManager
- #define gxm_XmIsMenuShell_w gxm_XmIsMenuShell
- #define gxm_XmListGetSelectedPos_w gxm_XmListGetSelectedPos
- #define gxm_XmWidgetGetDisplayRect_w gxm_XmWidgetGetDisplayRect
-
-#if HAVE_XmCreateButtonBox
- #define gxm_XmIsButtonBox_w gxm_XmIsButtonBox
- #define gxm_XmCreateButtonBox_w gxm_XmCreateButtonBox
-#endif
-#if HAVE_XmCreateTabStack
- #define gxm_XmCreateTabStack_w gxm_XmCreateTabStack
- #define gxm_XmIsTabStack_w gxm_XmIsTabStack
- #define gxm_XmTabStackGetSelectedTab_w gxm_XmTabStackGetSelectedTab
- #define gxm_XmTabStackSelectTab_w gxm_XmTabStackSelectTab
-#if HAVE_XmTabStackXYToWidget
- #define gxm_XmTabStackIndexToWidget_w gxm_XmTabStackIndexToWidget
- #define gxm_XmTabStackXYToWidget_w gxm_XmTabStackXYToWidget
-#endif
-#endif
-#if HAVE_XmCreateDataField
- #define gxm_XmIsDataField_w gxm_XmIsDataField
- #define gxm_XmCreateDataField_w gxm_XmCreateDataField
- #define gxm_XmDataFieldSetString_w gxm_XmDataFieldSetString
- #define gxm_XmDataFieldGetString_w gxm_XmDataFieldGetString
- #define gxm_XmDataFieldSetHighlight_w gxm_XmDataFieldSetHighlight
- #define gxm_XmDataFieldSetAddMode_w gxm_XmDataFieldSetAddMode
- #define gxm_XmDataFieldGetSelection_w gxm_XmDataFieldGetSelection
- #define gxm_XmDataFieldSetSelection_w gxm_XmDataFieldSetSelection
- #define gxm_XmDataFieldGetSelectionPosition_w gxm_XmDataFieldGetSelectionPosition
- #define gxm_XmDataFieldXYToPos_w gxm_XmDataFieldXYToPos
- #define gxm_XmDataFieldShowPosition_w gxm_XmDataFieldShowPosition
- #define gxm_XmDataFieldCut_w gxm_XmDataFieldCut
- #define gxm_XmDataFieldCopy_w gxm_XmDataFieldCopy
- #define gxm_XmDataFieldPaste_w gxm_XmDataFieldPaste
- #define gxm_XmDataFieldSetEditable_w gxm_XmDataFieldSetEditable
- #define gxm_XmDataFieldSetInsertionPosition_w gxm_XmDataFieldSetInsertionPosition
-#endif
-#if HAVE_XmCreateColumn
- #define gxm_XmCreateColumn_w gxm_XmCreateColumn
- #define gxm_XmIsColumn_w gxm_XmIsColumn
-#if HAVE_XmColumnGetChildLabel
- #define gxm_XmColumnGetChildLabel_w gxm_XmColumnGetChildLabel
-#endif
-#endif
-#if HAVE_XmCreateDropDown
- #define gxm_XmIsDropDown_w gxm_XmIsDropDown
- #define gxm_XmDropDownGetValue_w gxm_XmDropDownGetValue
- #define gxm_XmDropDownGetList_w gxm_XmDropDownGetList
- #define gxm_XmDropDownGetText_w gxm_XmDropDownGetText
- #define gxm_XmDropDownGetArrow_w gxm_XmDropDownGetArrow
- #define gxm_XmDropDownGetLabel_w gxm_XmDropDownGetLabel
- #define gxm_XmCreateDropDown_w gxm_XmCreateDropDown
-#endif
-
-#endif
-
- #define gxm_XpmCreatePixmapFromData_w gxm_XpmCreatePixmapFromData
- #define gxm_XpmCreateDataFromPixmap_w gxm_XpmCreateDataFromPixmap
- #define gxm_XpmReadFileToPixmap_w gxm_XpmReadFileToPixmap
- #define gxm_XpmReadFileToXpmImage_w gxm_XpmReadFileToXpmImage
- #define gxm_XpmWriteFileFromPixmap_w gxm_XpmWriteFileFromPixmap
- #define gxm_XpmCreatePixmapFromXpmImage_w gxm_XpmCreatePixmapFromXpmImage
- #define gxm_XpmCreateXpmImageFromPixmap_w gxm_XpmCreateXpmImageFromPixmap
- #define gxm_XpmGetErrorString_w gxm_XpmGetErrorString
-
- #define gxm_XGetPixel_w gxm_XGetPixel
- #define gxm_XDestroyImage_w gxm_XDestroyImage
- #define gxm_XPutPixel_w gxm_XPutPixel
- #define gxm_XSubImage_w gxm_XSubImage
- #define gxm_XAddPixel_w gxm_XAddPixel
-
-#if HAVE_MOTIF
- #define XEN_XtAppContext_p_w XEN_XtAppContext_p
- #define XEN_XtRequestId_p_w XEN_XtRequestId_p
- #define XEN_XtWorkProcId_p_w XEN_XtWorkProcId_p
- #define XEN_XtInputId_p_w XEN_XtInputId_p
- #define XEN_XtIntervalId_p_w XEN_XtIntervalId_p
-#endif
- #define XEN_Screen_p_w XEN_Screen_p
- #define XEN_XEvent_p_w XEN_XEvent_p
- #define XEN_XRectangle_p_w XEN_XRectangle_p
- #define XEN_XArc_p_w XEN_XArc_p
- #define XEN_XPoint_p_w XEN_XPoint_p
- #define XEN_XSegment_p_w XEN_XSegment_p
- #define XEN_XColor_p_w XEN_XColor_p
- #define XEN_Atom_p_w XEN_Atom_p
- #define XEN_Colormap_p_w XEN_Colormap_p
- #define XEN_XModifierKeymap_p_w XEN_XModifierKeymap_p
- #define XEN_Depth_p_w XEN_Depth_p
- #define XEN_Display_p_w XEN_Display_p
- #define XEN_Font_p_w XEN_Font_p
- #define XEN_GC_p_w XEN_GC_p
- #define XEN_KeySym_p_w XEN_KeySym_p
- #define XEN_Pixel_p_w XEN_Pixel_p
- #define XEN_Pixmap_p_w XEN_Pixmap_p
- #define XEN_Region_p_w XEN_Region_p
- #define XEN_Time_p_w XEN_Time_p
- #define XEN_Visual_p_w XEN_Visual_p
- #define XEN_Window_p_w XEN_Window_p
-#if HAVE_MOTIF
- #define XEN_Widget_p_w XEN_Widget_p
- #define XEN_XmStringContext_p_w XEN_XmStringContext_p
-#endif
- #define XEN_XFontProp_p_w XEN_XFontProp_p
- #define XEN_XFontSet_p_w XEN_XFontSet_p
- #define XEN_XFontStruct_p_w XEN_XFontStruct_p
- #define XEN_XGCValues_p_w XEN_XGCValues_p
- #define XEN_XImage_p_w XEN_XImage_p
- #define XEN_XVisualInfo_p_w XEN_XVisualInfo_p
- #define XEN_XWMHints_p_w XEN_XWMHints_p
- #define XEN_XWindowAttributes_p_w XEN_XWindowAttributes_p
- #define XEN_XWindowChanges_p_w XEN_XWindowChanges_p
- #define XEN_KeyCode_p_w XEN_KeyCode_p
- #define XEN_XContext_p_w XEN_XContext_p
- #define XEN_XCharStruct_p_w XEN_XCharStruct_p
- #define XEN_XTextItem_p_w XEN_XTextItem_p
- #define XEN_XStandardColormap_p_w XEN_XStandardColormap_p
- #define XEN_Cursor_p_w XEN_Cursor_p
-#if HAVE_MOTIF
- #define XEN_WidgetClass_p_w XEN_WidgetClass_p
- #define XEN_XmString_p_w XEN_XmString_p
- #define XEN_XmTab_p_w XEN_XmTab_p
- #define XEN_XmRendition_p_w XEN_XmRendition_p
- #define XEN_XmRenderTable_p_w XEN_XmRenderTable_p
- #define XEN_XmTabList_p_w XEN_XmTabList_p
- #define XEN_XmParseMapping_p_w XEN_XmParseMapping_p
- #define XEN_XmTextSource_p_w XEN_XmTextSource_p
+ XM_field_assert_type(Xen_is_XmTopLevelEnterCallbackStruct(ptr), ptr, 1, "dragProtocolStyle", "XmTopLevelEnterCallbackStruct");
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmTopLevelEnterCallbackStruct(ptr))->dragProtocolStyle)));
+}
+
+static Xen gxm_traversal_destination(Xen ptr)
+{
+ XM_field_assert_type(Xen_is_XmTraverseObscuredCallbackStruct(ptr), ptr, 1, "traversal_destination", "XmTraverseObscuredCallbackStruct");
+ return(C_to_Xen_Widget((Widget)((Xen_to_C_XmTraverseObscuredCallbackStruct(ptr))->traversal_destination)));
+}
+
+static Xen gxm_minor_tab_widget(Xen ptr)
+{
+ XM_field_assert_type(Xen_is_XmNotebookPageInfo(ptr), ptr, 1, "minor_tab_widget", "XmNotebookPageInfo");
+ return(C_to_Xen_Widget((Widget)((Xen_to_C_XmNotebookPageInfo(ptr))->minor_tab_widget)));
+}
+
+static Xen gxm_major_tab_widget(Xen ptr)
+{
+ XM_field_assert_type(Xen_is_XmNotebookPageInfo(ptr), ptr, 1, "major_tab_widget", "XmNotebookPageInfo");
+ return(C_to_Xen_Widget((Widget)((Xen_to_C_XmNotebookPageInfo(ptr))->major_tab_widget)));
+}
+
+static Xen gxm_status_area_widget(Xen ptr)
+{
+ XM_field_assert_type(Xen_is_XmNotebookPageInfo(ptr), ptr, 1, "status_area_widget", "XmNotebookPageInfo");
+ return(C_to_Xen_Widget((Widget)((Xen_to_C_XmNotebookPageInfo(ptr))->status_area_widget)));
+}
+
+static Xen gxm_page_widget(Xen ptr)
+{
+ XM_field_assert_type(Xen_is_XmNotebookCallbackStruct(ptr) || Xen_is_XmNotebookPageInfo(ptr), ptr, 1, "page_widget", "a struct with a page_widget field");
+ if (Xen_is_XmNotebookCallbackStruct(ptr)) return(C_to_Xen_Widget((Widget)((Xen_to_C_XmNotebookCallbackStruct(ptr))->page_widget)));
+ return(C_to_Xen_Widget((Widget)((Xen_to_C_XmNotebookPageInfo(ptr))->page_widget)));
+}
+
+static Xen gxm_page_number(Xen ptr)
+{
+ XM_field_assert_type(Xen_is_XmNotebookCallbackStruct(ptr) || Xen_is_XmNotebookPageInfo(ptr), ptr, 1, "page_number", "a struct with a page_number field");
+ if (Xen_is_XmNotebookCallbackStruct(ptr)) return(C_int_to_Xen_integer((int)((Xen_to_C_XmNotebookCallbackStruct(ptr))->page_number)));
+ return(C_int_to_Xen_integer((int)((Xen_to_C_XmNotebookPageInfo(ptr))->page_number)));
+}
+
+
+Xen_wrap_3_args(gxm_XtSetArg_w, gxm_XtSetArg)
+Xen_wrap_2_optional_args(gxm_XtManageChildren_w, gxm_XtManageChildren)
+Xen_wrap_1_arg(gxm_XtManageChild_w, gxm_XtManageChild)
+Xen_wrap_2_optional_args(gxm_XtUnmanageChildren_w, gxm_XtUnmanageChildren)
+Xen_wrap_1_arg(gxm_XtUnmanageChild_w, gxm_XtUnmanageChild)
+Xen_wrap_1_arg(gxm_XtDispatchEvent_w, gxm_XtDispatchEvent)
+Xen_wrap_2_args(gxm_XtCallAcceptFocus_w, gxm_XtCallAcceptFocus)
+Xen_wrap_1_arg(gxm_XtAppPeekEvent_w, gxm_XtAppPeekEvent)
+Xen_wrap_2_args(gxm_XtIsSubclass_w, gxm_XtIsSubclass)
+Xen_wrap_2_args(gxm_XtAppSetFallbackResources_w, gxm_XtAppSetFallbackResources)
+Xen_wrap_1_arg(gxm_XtIsObject_w, gxm_XtIsObject)
+Xen_wrap_1_arg(gxm_XtIsManaged_w, gxm_XtIsManaged)
+Xen_wrap_1_arg(gxm_XtIsRealized_w, gxm_XtIsRealized)
+Xen_wrap_1_arg(gxm_XtIsSensitive_w, gxm_XtIsSensitive)
+Xen_wrap_6_args(gxm_XtOwnSelection_w, gxm_XtOwnSelection)
+Xen_wrap_8_args(gxm_XtOwnSelectionIncremental_w, gxm_XtOwnSelectionIncremental)
+Xen_wrap_3_args(gxm_XtMakeResizeRequest_w, gxm_XtMakeResizeRequest)
+Xen_wrap_3_args(gxm_XtTranslateCoords_w, gxm_XtTranslateCoords)
+Xen_wrap_2_args(gxm_XtKeysymToKeycodeList_w, gxm_XtKeysymToKeycodeList)
+Xen_wrap_1_arg(gxm_XtParseTranslationTable_w, gxm_XtParseTranslationTable)
+Xen_wrap_1_arg(gxm_XtParseAcceleratorTable_w, gxm_XtParseAcceleratorTable)
+Xen_wrap_2_args(gxm_XtOverrideTranslations_w, gxm_XtOverrideTranslations)
+Xen_wrap_2_args(gxm_XtAugmentTranslations_w, gxm_XtAugmentTranslations)
+Xen_wrap_2_args(gxm_XtInstallAccelerators_w, gxm_XtInstallAccelerators)
+Xen_wrap_2_args(gxm_XtInstallAllAccelerators_w, gxm_XtInstallAllAccelerators)
+Xen_wrap_1_arg(gxm_XtUninstallTranslations_w, gxm_XtUninstallTranslations)
+Xen_wrap_2_args(gxm_XtAppAddActions_w, gxm_XtAppAddActions)
+Xen_wrap_3_optional_args(gxm_XtAppAddActionHook_w, gxm_XtAppAddActionHook)
+Xen_wrap_1_arg(gxm_XtRemoveActionHook_w, gxm_XtRemoveActionHook)
+Xen_wrap_1_arg(gxm_XtGetActionList_w, gxm_XtGetActionList)
+Xen_wrap_5_optional_args(gxm_XtCallActionProc_w, gxm_XtCallActionProc)
+Xen_wrap_5_args(gxm_XtRegisterGrabAction_w, gxm_XtRegisterGrabAction)
+Xen_wrap_2_args(gxm_XtSetMultiClickTime_w, gxm_XtSetMultiClickTime)
+Xen_wrap_1_arg(gxm_XtGetMultiClickTime_w, gxm_XtGetMultiClickTime)
+Xen_wrap_1_arg(gxm_XtGetResourceList_w, gxm_XtGetResourceList)
+Xen_wrap_1_arg(gxm_XtGetActionKeysym_w, gxm_XtGetActionKeysym)
+Xen_wrap_3_args(gxm_XtTranslateKeycode_w, gxm_XtTranslateKeycode)
+Xen_wrap_3_args(gxm_XtTranslateKey_w, gxm_XtTranslateKey)
+Xen_wrap_2_args(gxm_XtSetKeyTranslator_w, gxm_XtSetKeyTranslator)
+Xen_wrap_4_args(gxm_XtRegisterCaseConverter_w, gxm_XtRegisterCaseConverter)
+Xen_wrap_2_args(gxm_XtConvertCase_w, gxm_XtConvertCase)
+Xen_wrap_5_optional_args(gxm_XtAddEventHandler_w, gxm_XtAddEventHandler)
+Xen_wrap_5_args(gxm_XtRemoveEventHandler_w, gxm_XtRemoveEventHandler)
+Xen_wrap_5_args(gxm_XtAddRawEventHandler_w, gxm_XtAddRawEventHandler)
+Xen_wrap_5_args(gxm_XtRemoveRawEventHandler_w, gxm_XtRemoveRawEventHandler)
+Xen_wrap_6_args(gxm_XtInsertEventHandler_w, gxm_XtInsertEventHandler)
+Xen_wrap_6_args(gxm_XtInsertRawEventHandler_w, gxm_XtInsertRawEventHandler)
+Xen_wrap_2_args(gxm_XtDispatchEventToWidget_w, gxm_XtDispatchEventToWidget)
+Xen_wrap_1_arg(gxm_XtBuildEventMask_w, gxm_XtBuildEventMask)
+Xen_wrap_3_args(gxm_XtAddGrab_w, gxm_XtAddGrab)
+Xen_wrap_1_arg(gxm_XtRemoveGrab_w, gxm_XtRemoveGrab)
+Xen_wrap_2_args(gxm_XtAppProcessEvent_w, gxm_XtAppProcessEvent)
+Xen_wrap_1_arg(gxm_XtAppMainLoop_w, gxm_XtAppMainLoop)
+Xen_wrap_2_args(gxm_XtAddExposureToRegion_w, gxm_XtAddExposureToRegion)
+Xen_wrap_2_args(gxm_XtSetKeyboardFocus_w, gxm_XtSetKeyboardFocus)
+Xen_wrap_1_arg(gxm_XtGetKeyboardFocusWidget_w, gxm_XtGetKeyboardFocusWidget)
+Xen_wrap_1_arg(gxm_XtLastEventProcessed_w, gxm_XtLastEventProcessed)
+Xen_wrap_1_arg(gxm_XtLastTimestampProcessed_w, gxm_XtLastTimestampProcessed)
+Xen_wrap_4_optional_args(gxm_XtAppAddTimeOut_w, gxm_XtAppAddTimeOut)
+Xen_wrap_1_arg(gxm_XtRemoveTimeOut_w, gxm_XtRemoveTimeOut)
+Xen_wrap_5_optional_args(gxm_XtAppAddInput_w, gxm_XtAppAddInput)
+Xen_wrap_1_arg(gxm_XtRemoveInput_w, gxm_XtRemoveInput)
+Xen_wrap_1_arg(gxm_XtAppNextEvent_w, gxm_XtAppNextEvent)
+Xen_wrap_1_arg(gxm_XtAppPending_w, gxm_XtAppPending)
+Xen_wrap_1_arg(gxm_XtRealizeWidget_w, gxm_XtRealizeWidget)
+Xen_wrap_1_arg(gxm_XtUnrealizeWidget_w, gxm_XtUnrealizeWidget)
+Xen_wrap_1_arg(gxm_XtDestroyWidget_w, gxm_XtDestroyWidget)
+Xen_wrap_2_args(gxm_XtSetSensitive_w, gxm_XtSetSensitive)
+Xen_wrap_2_args(gxm_XtNameToWidget_w, gxm_XtNameToWidget)
+Xen_wrap_2_args(gxm_XtWindowToWidget_w, gxm_XtWindowToWidget)
+Xen_wrap_4_args(gxm_XtMergeArgLists_w, gxm_XtMergeArgLists)
+Xen_wrap_2_args(gxm_XtVaCreateArgsList_w, gxm_XtVaCreateArgsList)
+Xen_wrap_1_arg(gxm_XtDisplay_w, gxm_XtDisplay)
+Xen_wrap_1_arg(gxm_XtDisplayOfObject_w, gxm_XtDisplayOfObject)
+Xen_wrap_1_arg(gxm_XtScreen_w, gxm_XtScreen)
+Xen_wrap_1_arg(gxm_XtScreenOfObject_w, gxm_XtScreenOfObject)
+Xen_wrap_1_arg(gxm_XtWindow_w, gxm_XtWindow)
+Xen_wrap_1_arg(gxm_XtWindowOfObject_w, gxm_XtWindowOfObject)
+Xen_wrap_1_arg(gxm_XtName_w, gxm_XtName)
+Xen_wrap_1_arg(gxm_XtSuperclass_w, gxm_XtSuperclass)
+Xen_wrap_1_arg(gxm_XtClass_w, gxm_XtClass)
+Xen_wrap_1_arg(gxm_XtParent_w, gxm_XtParent)
+Xen_wrap_4_optional_args(gxm_XtAddCallback_w, gxm_XtAddCallback)
+Xen_wrap_3_args(gxm_XtRemoveCallback_w, gxm_XtRemoveCallback)
+Xen_wrap_3_args(gxm_XtAddCallbacks_w, gxm_XtAddCallbacks)
+Xen_wrap_3_args(gxm_XtRemoveCallbacks_w, gxm_XtRemoveCallbacks)
+Xen_wrap_2_args(gxm_XtRemoveAllCallbacks_w, gxm_XtRemoveAllCallbacks)
+Xen_wrap_3_args(gxm_XtCallCallbacks_w, gxm_XtCallCallbacks)
+Xen_wrap_2_args(gxm_XtHasCallbacks_w, gxm_XtHasCallbacks)
+Xen_wrap_5_optional_args(gxm_XtCreatePopupShell_w, gxm_XtCreatePopupShell)
+Xen_wrap_4_args(gxm_XtVaCreatePopupShell_w, gxm_XtVaCreatePopupShell)
+Xen_wrap_2_args(gxm_XtPopup_w, gxm_XtPopup)
+Xen_wrap_1_arg(gxm_XtPopupSpringLoaded_w, gxm_XtPopupSpringLoaded)
+Xen_wrap_3_args(gxm_XtCallbackNone_w, gxm_XtCallbackNone)
+Xen_wrap_3_args(gxm_XtCallbackNonexclusive_w, gxm_XtCallbackNonexclusive)
+Xen_wrap_3_args(gxm_XtCallbackExclusive_w, gxm_XtCallbackExclusive)
+Xen_wrap_1_arg(gxm_XtPopdown_w, gxm_XtPopdown)
+Xen_wrap_3_args(gxm_XtCallbackPopdown_w, gxm_XtCallbackPopdown)
+Xen_wrap_5_optional_args(gxm_XtCreateWidget_w, gxm_XtCreateWidget)
+Xen_wrap_5_optional_args(gxm_XtCreateManagedWidget_w, gxm_XtCreateManagedWidget)
+Xen_wrap_4_args(gxm_XtVaCreateWidget_w, gxm_XtVaCreateWidget)
+Xen_wrap_4_args(gxm_XtVaCreateManagedWidget_w, gxm_XtVaCreateManagedWidget)
+Xen_wrap_6_optional_args(gxm_XtAppCreateShell_w, gxm_XtAppCreateShell)
+Xen_wrap_5_args(gxm_XtVaAppCreateShell_w, gxm_XtVaAppCreateShell)
+Xen_wrap_no_args(gxm_XtToolkitInitialize_w, gxm_XtToolkitInitialize)
+Xen_wrap_3_args(gxm_XtSetLanguageProc_w, gxm_XtSetLanguageProc)
+Xen_wrap_6_args(gxm_XtDisplayInitialize_w, gxm_XtDisplayInitialize)
+Xen_wrap_6_optional_args(gxm_XtOpenApplication_w, gxm_XtOpenApplication)
+Xen_wrap_6_optional_args(gxm_XtVaOpenApplication_w, gxm_XtVaOpenApplication)
+Xen_wrap_5_optional_args(gxm_XtAppInitialize_w, gxm_XtAppInitialize)
+Xen_wrap_5_optional_args(gxm_XtVaAppInitialize_w, gxm_XtVaAppInitialize)
+Xen_wrap_6_args(gxm_XtOpenDisplay_w, gxm_XtOpenDisplay)
+Xen_wrap_no_args(gxm_XtCreateApplicationContext_w, gxm_XtCreateApplicationContext)
+Xen_wrap_1_arg(gxm_XtDestroyApplicationContext_w, gxm_XtDestroyApplicationContext)
+Xen_wrap_1_arg(gxm_XtInitializeWidgetClass_w, gxm_XtInitializeWidgetClass)
+Xen_wrap_1_arg(gxm_XtWidgetToApplicationContext_w, gxm_XtWidgetToApplicationContext)
+Xen_wrap_1_arg(gxm_XtDisplayToApplicationContext_w, gxm_XtDisplayToApplicationContext)
+Xen_wrap_1_arg(gxm_XtCloseDisplay_w, gxm_XtCloseDisplay)
+Xen_wrap_3_optional_args(gxm_XtSetValues_w, gxm_XtSetValues)
+Xen_wrap_2_args(gxm_XtVaSetValues_w, gxm_XtVaSetValues)
+Xen_wrap_3_optional_args(gxm_XtGetValues_w, gxm_XtGetValues)
+Xen_wrap_2_args(gxm_XtVaGetValues_w, gxm_XtVaGetValues)
+Xen_wrap_2_args(gxm_XtAppSetErrorMsgHandler_w, gxm_XtAppSetErrorMsgHandler)
+Xen_wrap_2_args(gxm_XtAppSetWarningMsgHandler_w, gxm_XtAppSetWarningMsgHandler)
+Xen_wrap_7_args(gxm_XtAppErrorMsg_w, gxm_XtAppErrorMsg)
+Xen_wrap_7_args(gxm_XtAppWarningMsg_w, gxm_XtAppWarningMsg)
+Xen_wrap_2_args(gxm_XtAppSetErrorHandler_w, gxm_XtAppSetErrorHandler)
+Xen_wrap_2_args(gxm_XtAppSetWarningHandler_w, gxm_XtAppSetWarningHandler)
+Xen_wrap_2_args(gxm_XtAppError_w, gxm_XtAppError)
+Xen_wrap_1_arg(gxm_XtMalloc_w, gxm_XtMalloc)
+Xen_wrap_2_args(gxm_XtCalloc_w, gxm_XtCalloc)
+Xen_wrap_2_args(gxm_XtRealloc_w, gxm_XtRealloc)
+Xen_wrap_1_arg(gxm_XtFree_w, gxm_XtFree)
+Xen_wrap_3_optional_args(gxm_XtAppAddWorkProc_w, gxm_XtAppAddWorkProc)
+Xen_wrap_1_arg(gxm_XtRemoveWorkProc_w, gxm_XtRemoveWorkProc)
+Xen_wrap_3_args(gxm_XtGetGC_w, gxm_XtGetGC)
+Xen_wrap_6_args(gxm_XtAllocateGC_w, gxm_XtAllocateGC)
+Xen_wrap_1_arg(gxm_XtDestroyGC_w, gxm_XtDestroyGC)
+Xen_wrap_2_args(gxm_XtReleaseGC_w, gxm_XtReleaseGC)
+Xen_wrap_4_args(gxm_XtFindFile_w, gxm_XtFindFile)
+Xen_wrap_8_args(gxm_XtResolvePathname_w, gxm_XtResolvePathname)
+Xen_wrap_3_args(gxm_XtDisownSelection_w, gxm_XtDisownSelection)
+Xen_wrap_6_args(gxm_XtGetSelectionValue_w, gxm_XtGetSelectionValue)
+Xen_wrap_7_args(gxm_XtGetSelectionValues_w, gxm_XtGetSelectionValues)
+Xen_wrap_2_args(gxm_XtAppSetSelectionTimeout_w, gxm_XtAppSetSelectionTimeout)
+Xen_wrap_1_arg(gxm_XtAppGetSelectionTimeout_w, gxm_XtAppGetSelectionTimeout)
+Xen_wrap_3_args(gxm_XtGetSelectionRequest_w, gxm_XtGetSelectionRequest)
+Xen_wrap_6_args(gxm_XtGetSelectionValueIncremental_w, gxm_XtGetSelectionValueIncremental)
+Xen_wrap_7_args(gxm_XtGetSelectionValuesIncremental_w, gxm_XtGetSelectionValuesIncremental)
+Xen_wrap_2_args(gxm_XtCreateSelectionRequest_w, gxm_XtCreateSelectionRequest)
+Xen_wrap_3_args(gxm_XtSendSelectionRequest_w, gxm_XtSendSelectionRequest)
+Xen_wrap_2_args(gxm_XtCancelSelectionRequest_w, gxm_XtCancelSelectionRequest)
+Xen_wrap_6_args(gxm_XtGrabKey_w, gxm_XtGrabKey)
+Xen_wrap_3_args(gxm_XtUngrabKey_w, gxm_XtUngrabKey)
+Xen_wrap_5_args(gxm_XtGrabKeyboard_w, gxm_XtGrabKeyboard)
+Xen_wrap_2_args(gxm_XtUngrabKeyboard_w, gxm_XtUngrabKeyboard)
+Xen_wrap_9_args(gxm_XtGrabButton_w, gxm_XtGrabButton)
+Xen_wrap_3_args(gxm_XtUngrabButton_w, gxm_XtUngrabButton)
+Xen_wrap_8_args(gxm_XtGrabPointer_w, gxm_XtGrabPointer)
+Xen_wrap_2_args(gxm_XtUngrabPointer_w, gxm_XtUngrabPointer)
+Xen_wrap_1_arg(gxm_XtGetApplicationNameAndClass_w, gxm_XtGetApplicationNameAndClass)
+Xen_wrap_1_arg(gxm_XtGetDisplays_w, gxm_XtGetDisplays)
+Xen_wrap_no_args(gxm_XtToolkitThreadInitialize_w, gxm_XtToolkitThreadInitialize)
+Xen_wrap_1_arg(gxm_XtAppLock_w, gxm_XtAppLock)
+Xen_wrap_1_arg(gxm_XtAppUnlock_w, gxm_XtAppUnlock)
+Xen_wrap_1_arg(gxm_XtIsRectObj_w, gxm_XtIsRectObj)
+Xen_wrap_1_arg(gxm_XtIsWidget_w, gxm_XtIsWidget)
+Xen_wrap_1_arg(gxm_XtIsComposite_w, gxm_XtIsComposite)
+Xen_wrap_1_arg(gxm_XtIsConstraint_w, gxm_XtIsConstraint)
+Xen_wrap_1_arg(gxm_XtIsShell_w, gxm_XtIsShell)
+Xen_wrap_1_arg(gxm_XtIsOverrideShell_w, gxm_XtIsOverrideShell)
+Xen_wrap_1_arg(gxm_XtIsWMShell_w, gxm_XtIsWMShell)
+Xen_wrap_1_arg(gxm_XtIsVendorShell_w, gxm_XtIsVendorShell)
+Xen_wrap_1_arg(gxm_XtIsTransientShell_w, gxm_XtIsTransientShell)
+Xen_wrap_1_arg(gxm_XtIsTopLevelShell_w, gxm_XtIsTopLevelShell)
+Xen_wrap_1_arg(gxm_XtIsApplicationShell_w, gxm_XtIsApplicationShell)
+Xen_wrap_1_arg(gxm_XtIsSessionShell_w, gxm_XtIsSessionShell)
+Xen_wrap_1_arg(gxm_XtMapWidget_w, gxm_XtMapWidget)
+Xen_wrap_1_arg(gxm_XtUnmapWidget_w, gxm_XtUnmapWidget)
+
+Xen_wrap_2_args(gxm_XLoadQueryFont_w, gxm_XLoadQueryFont)
+Xen_wrap_2_args(gxm_XQueryFont_w, gxm_XQueryFont)
+Xen_wrap_4_args(gxm_XGetMotionEvents_w, gxm_XGetMotionEvents)
+Xen_wrap_3_args(gxm_XDeleteModifiermapEntry_w, gxm_XDeleteModifiermapEntry)
+Xen_wrap_1_arg(gxm_XGetModifierMapping_w, gxm_XGetModifierMapping)
+Xen_wrap_3_args(gxm_XInsertModifiermapEntry_w, gxm_XInsertModifiermapEntry)
+Xen_wrap_1_arg(gxm_XNewModifiermap_w, gxm_XNewModifiermap)
+Xen_wrap_any_args(gxm_XCreateImage_w, gxm_XCreateImage)
+Xen_wrap_8_args(gxm_XGetImage_w, gxm_XGetImage)
+Xen_wrap_any_args(gxm_XGetSubImage_w, gxm_XGetSubImage)
+Xen_wrap_1_arg(gxm_XOpenDisplay_w, gxm_XOpenDisplay)
+Xen_wrap_1_arg(gxm_XFetchBytes_w, gxm_XFetchBytes)
+Xen_wrap_2_args(gxm_XFetchBuffer_w, gxm_XFetchBuffer)
+Xen_wrap_2_args(gxm_XGetAtomName_w, gxm_XGetAtomName)
+Xen_wrap_1_arg(gxm_XDisplayName_w, gxm_XDisplayName)
+Xen_wrap_1_arg(gxm_XKeysymToString_w, gxm_XKeysymToString)
+Xen_wrap_2_args(gxm_XSynchronize_w, gxm_XSynchronize)
+Xen_wrap_2_args(gxm_XSetAfterFunction_w, gxm_XSetAfterFunction)
+Xen_wrap_3_args(gxm_XInternAtom_w, gxm_XInternAtom)
+Xen_wrap_2_args(gxm_XCopyColormapAndFree_w, gxm_XCopyColormapAndFree)
+Xen_wrap_4_args(gxm_XCreateColormap_w, gxm_XCreateColormap)
+Xen_wrap_7_args(gxm_XCreatePixmapCursor_w, gxm_XCreatePixmapCursor)
+Xen_wrap_7_args(gxm_XCreateGlyphCursor_w, gxm_XCreateGlyphCursor)
+Xen_wrap_2_args(gxm_XCreateFontCursor_w, gxm_XCreateFontCursor)
+Xen_wrap_2_args(gxm_XLoadFont_w, gxm_XLoadFont)
+Xen_wrap_4_args(gxm_XCreateGC_w, gxm_XCreateGC)
+Xen_wrap_2_args(gxm_XFlushGC_w, gxm_XFlushGC)
+Xen_wrap_5_args(gxm_XCreatePixmap_w, gxm_XCreatePixmap)
+Xen_wrap_5_args(gxm_XCreateBitmapFromData_w, gxm_XCreateBitmapFromData)
+Xen_wrap_8_args(gxm_XCreatePixmapFromBitmapData_w, gxm_XCreatePixmapFromBitmapData)
+Xen_wrap_9_args(gxm_XCreateSimpleWindow_w, gxm_XCreateSimpleWindow)
+Xen_wrap_2_args(gxm_XGetSelectionOwner_w, gxm_XGetSelectionOwner)
+Xen_wrap_any_args(gxm_XCreateWindow_w, gxm_XCreateWindow)
+Xen_wrap_2_args(gxm_XListInstalledColormaps_w, gxm_XListInstalledColormaps)
+Xen_wrap_3_args(gxm_XListFonts_w, gxm_XListFonts)
+Xen_wrap_3_args(gxm_XListFontsWithInfo_w, gxm_XListFontsWithInfo)
+Xen_wrap_1_arg(gxm_XGetFontPath_w, gxm_XGetFontPath)
+Xen_wrap_1_arg(gxm_XListExtensions_w, gxm_XListExtensions)
+Xen_wrap_2_args(gxm_XListProperties_w, gxm_XListProperties)
+#if 0
+Xen_wrap_3_args(gxm_XKeycodeToKeysym_w, gxm_XKeycodeToKeysym)
#endif
-
- #define XEN_XpmAttributes_p_w XEN_XpmAttributes_p
- #define XEN_XpmImage_p_w XEN_XpmImage_p
- #define XEN_XpmColorSymbol_p_w XEN_XpmColorSymbol_p
-
-#if MUS_WITH_EDITRES
- #define gxm_XEditResCheckMessages_w gxm_XEditResCheckMessages
+Xen_wrap_2_args(gxm_XLookupKeysym_w, gxm_XLookupKeysym)
+Xen_wrap_3_args(gxm_XGetKeyboardMapping_w, gxm_XGetKeyboardMapping)
+Xen_wrap_1_arg(gxm_XStringToKeysym_w, gxm_XStringToKeysym)
+Xen_wrap_1_arg(gxm_XMaxRequestSize_w, gxm_XMaxRequestSize)
+Xen_wrap_1_arg(gxm_XExtendedMaxRequestSize_w, gxm_XExtendedMaxRequestSize)
+Xen_wrap_1_arg(gxm_XDisplayMotionBufferSize_w, gxm_XDisplayMotionBufferSize)
+Xen_wrap_1_arg(gxm_XVisualIDFromVisual_w, gxm_XVisualIDFromVisual)
+Xen_wrap_2_args(gxm_XRootWindow_w, gxm_XRootWindow)
+Xen_wrap_1_arg(gxm_XDefaultRootWindow_w, gxm_XDefaultRootWindow)
+Xen_wrap_1_arg(gxm_XRootWindowOfScreen_w, gxm_XRootWindowOfScreen)
+Xen_wrap_2_args(gxm_XDefaultVisual_w, gxm_XDefaultVisual)
+Xen_wrap_1_arg(gxm_XDefaultVisualOfScreen_w, gxm_XDefaultVisualOfScreen)
+Xen_wrap_2_args(gxm_XDefaultGC_w, gxm_XDefaultGC)
+Xen_wrap_1_arg(gxm_XDefaultGCOfScreen_w, gxm_XDefaultGCOfScreen)
+Xen_wrap_2_args(gxm_XBlackPixel_w, gxm_XBlackPixel)
+Xen_wrap_2_args(gxm_XWhitePixel_w, gxm_XWhitePixel)
+Xen_wrap_no_args(gxm_XAllPlanes_w, gxm_XAllPlanes)
+Xen_wrap_1_arg(gxm_XBlackPixelOfScreen_w, gxm_XBlackPixelOfScreen)
+Xen_wrap_1_arg(gxm_XWhitePixelOfScreen_w, gxm_XWhitePixelOfScreen)
+Xen_wrap_1_arg(gxm_XNextRequest_w, gxm_XNextRequest)
+Xen_wrap_1_arg(gxm_XLastKnownRequestProcessed_w, gxm_XLastKnownRequestProcessed)
+Xen_wrap_1_arg(gxm_XServerVendor_w, gxm_XServerVendor)
+Xen_wrap_1_arg(gxm_XDisplayString_w, gxm_XDisplayString)
+Xen_wrap_2_args(gxm_XDefaultColormap_w, gxm_XDefaultColormap)
+Xen_wrap_1_arg(gxm_XDefaultColormapOfScreen_w, gxm_XDefaultColormapOfScreen)
+Xen_wrap_1_arg(gxm_XDisplayOfScreen_w, gxm_XDisplayOfScreen)
+Xen_wrap_2_args(gxm_XScreenOfDisplay_w, gxm_XScreenOfDisplay)
+Xen_wrap_1_arg(gxm_XDefaultScreenOfDisplay_w, gxm_XDefaultScreenOfDisplay)
+Xen_wrap_1_arg(gxm_XEventMaskOfScreen_w, gxm_XEventMaskOfScreen)
+Xen_wrap_1_arg(gxm_XScreenNumberOfScreen_w, gxm_XScreenNumberOfScreen)
+Xen_wrap_1_arg(gxm_XSetErrorHandler_w, gxm_XSetErrorHandler)
+Xen_wrap_1_arg(gxm_XSetIOErrorHandler_w, gxm_XSetIOErrorHandler)
+Xen_wrap_1_arg(gxm_XListPixmapFormats_w, gxm_XListPixmapFormats)
+Xen_wrap_2_args(gxm_XListDepths_w, gxm_XListDepths)
+Xen_wrap_5_args(gxm_XReconfigureWMWindow_w, gxm_XReconfigureWMWindow)
+Xen_wrap_2_args(gxm_XGetWMProtocols_w, gxm_XGetWMProtocols)
+Xen_wrap_4_args(gxm_XSetWMProtocols_w, gxm_XSetWMProtocols)
+Xen_wrap_3_args(gxm_XIconifyWindow_w, gxm_XIconifyWindow)
+Xen_wrap_3_args(gxm_XWithdrawWindow_w, gxm_XWithdrawWindow)
+Xen_wrap_2_args(gxm_XGetCommand_w, gxm_XGetCommand)
+Xen_wrap_2_args(gxm_XGetWMColormapWindows_w, gxm_XGetWMColormapWindows)
+Xen_wrap_4_args(gxm_XSetWMColormapWindows_w, gxm_XSetWMColormapWindows)
+Xen_wrap_3_args(gxm_XSetTransientForHint_w, gxm_XSetTransientForHint)
+Xen_wrap_1_arg(gxm_XActivateScreenSaver_w, gxm_XActivateScreenSaver)
+Xen_wrap_3_args(gxm_XAllocColor_w, gxm_XAllocColor)
+Xen_wrap_5_args(gxm_XAllocColorCells_w, gxm_XAllocColorCells)
+Xen_wrap_any_args(gxm_XAllocColorPlanes_w, gxm_XAllocColorPlanes)
+Xen_wrap_5_args(gxm_XAllocNamedColor_w, gxm_XAllocNamedColor)
+Xen_wrap_3_args(gxm_XAllowEvents_w, gxm_XAllowEvents)
+Xen_wrap_1_arg(gxm_XAutoRepeatOff_w, gxm_XAutoRepeatOff)
+Xen_wrap_1_arg(gxm_XAutoRepeatOn_w, gxm_XAutoRepeatOn)
+Xen_wrap_2_args(gxm_XBell_w, gxm_XBell)
+Xen_wrap_1_arg(gxm_XBitmapBitOrder_w, gxm_XBitmapBitOrder)
+Xen_wrap_1_arg(gxm_XBitmapPad_w, gxm_XBitmapPad)
+Xen_wrap_1_arg(gxm_XBitmapUnit_w, gxm_XBitmapUnit)
+Xen_wrap_1_arg(gxm_XCellsOfScreen_w, gxm_XCellsOfScreen)
+Xen_wrap_4_args(gxm_XChangeActivePointerGrab_w, gxm_XChangeActivePointerGrab)
+Xen_wrap_4_args(gxm_XChangeGC_w, gxm_XChangeGC)
+Xen_wrap_3_args(gxm_XChangeKeyboardControl_w, gxm_XChangeKeyboardControl)
+Xen_wrap_5_args(gxm_XChangeKeyboardMapping_w, gxm_XChangeKeyboardMapping)
+Xen_wrap_6_args(gxm_XChangePointerControl_w, gxm_XChangePointerControl)
+Xen_wrap_8_optional_args(gxm_XChangeProperty_w, gxm_XChangeProperty)
+Xen_wrap_4_args(gxm_XChangeWindowAttributes_w, gxm_XChangeWindowAttributes)
+Xen_wrap_3_args(gxm_XCheckIfEvent_w, gxm_XCheckIfEvent)
+Xen_wrap_2_args(gxm_XCheckMaskEvent_w, gxm_XCheckMaskEvent)
+Xen_wrap_2_args(gxm_XCheckTypedEvent_w, gxm_XCheckTypedEvent)
+Xen_wrap_3_args(gxm_XCheckTypedWindowEvent_w, gxm_XCheckTypedWindowEvent)
+Xen_wrap_3_args(gxm_XCheckWindowEvent_w, gxm_XCheckWindowEvent)
+Xen_wrap_3_args(gxm_XCirculateSubwindows_w, gxm_XCirculateSubwindows)
+Xen_wrap_2_args(gxm_XCirculateSubwindowsDown_w, gxm_XCirculateSubwindowsDown)
+Xen_wrap_2_args(gxm_XCirculateSubwindowsUp_w, gxm_XCirculateSubwindowsUp)
+Xen_wrap_7_args(gxm_XClearArea_w, gxm_XClearArea)
+Xen_wrap_2_args(gxm_XClearWindow_w, gxm_XClearWindow)
+Xen_wrap_1_arg(gxm_XCloseDisplay_w, gxm_XCloseDisplay)
+Xen_wrap_4_args(gxm_XConfigureWindow_w, gxm_XConfigureWindow)
+Xen_wrap_1_arg(gxm_XConnectionNumber_w, gxm_XConnectionNumber)
+Xen_wrap_6_args(gxm_XConvertSelection_w, gxm_XConvertSelection)
+Xen_wrap_any_args(gxm_XCopyArea_w, gxm_XCopyArea)
+Xen_wrap_4_args(gxm_XCopyGC_w, gxm_XCopyGC)
+Xen_wrap_any_args(gxm_XCopyPlane_w, gxm_XCopyPlane)
+Xen_wrap_2_args(gxm_XDefaultDepth_w, gxm_XDefaultDepth)
+Xen_wrap_1_arg(gxm_XDefaultDepthOfScreen_w, gxm_XDefaultDepthOfScreen)
+Xen_wrap_1_arg(gxm_XDefaultScreen_w, gxm_XDefaultScreen)
+Xen_wrap_3_args(gxm_XDefineCursor_w, gxm_XDefineCursor)
+Xen_wrap_3_args(gxm_XDeleteProperty_w, gxm_XDeleteProperty)
+Xen_wrap_2_args(gxm_XDestroyWindow_w, gxm_XDestroyWindow)
+Xen_wrap_2_args(gxm_XDestroySubwindows_w, gxm_XDestroySubwindows)
+Xen_wrap_1_arg(gxm_XDoesBackingStore_w, gxm_XDoesBackingStore)
+Xen_wrap_1_arg(gxm_XDoesSaveUnders_w, gxm_XDoesSaveUnders)
+Xen_wrap_1_arg(gxm_XDisableAccessControl_w, gxm_XDisableAccessControl)
+Xen_wrap_2_args(gxm_XDisplayCells_w, gxm_XDisplayCells)
+Xen_wrap_2_args(gxm_XDisplayHeight_w, gxm_XDisplayHeight)
+Xen_wrap_2_args(gxm_XDisplayHeightMM_w, gxm_XDisplayHeightMM)
+Xen_wrap_1_arg(gxm_XDisplayKeycodes_w, gxm_XDisplayKeycodes)
+Xen_wrap_2_args(gxm_XDisplayPlanes_w, gxm_XDisplayPlanes)
+Xen_wrap_2_args(gxm_XDisplayWidth_w, gxm_XDisplayWidth)
+Xen_wrap_2_args(gxm_XDisplayWidthMM_w, gxm_XDisplayWidthMM)
+Xen_wrap_9_args(gxm_XDrawArc_w, gxm_XDrawArc)
+Xen_wrap_5_args(gxm_XDrawArcs_w, gxm_XDrawArcs)
+Xen_wrap_7_args(gxm_XDrawImageString_w, gxm_XDrawImageString)
+Xen_wrap_7_args(gxm_XDrawLine_w, gxm_XDrawLine)
+Xen_wrap_6_args(gxm_XDrawLines_w, gxm_XDrawLines)
+Xen_wrap_6_args(gxm_XDrawLinesDirect_w, gxm_XDrawLinesDirect)
+Xen_wrap_1_arg(gxm_FreeXPoints_w, gxm_FreeXPoints)
+Xen_wrap_1_arg(gxm_Vector2XPoints_w, gxm_Vector2XPoints)
+Xen_wrap_5_args(gxm_XDrawPoint_w, gxm_XDrawPoint)
+Xen_wrap_6_args(gxm_XDrawPoints_w, gxm_XDrawPoints)
+Xen_wrap_7_args(gxm_XDrawRectangle_w, gxm_XDrawRectangle)
+Xen_wrap_5_args(gxm_XDrawRectangles_w, gxm_XDrawRectangles)
+Xen_wrap_5_args(gxm_XDrawSegments_w, gxm_XDrawSegments)
+Xen_wrap_7_args(gxm_XDrawString_w, gxm_XDrawString)
+Xen_wrap_7_optional_args(gxm_XDrawText_w, gxm_XDrawText)
+Xen_wrap_1_arg(gxm_XEnableAccessControl_w, gxm_XEnableAccessControl)
+Xen_wrap_2_args(gxm_XEventsQueued_w, gxm_XEventsQueued)
+Xen_wrap_2_args(gxm_XFetchName_w, gxm_XFetchName)
+Xen_wrap_9_args(gxm_XFillArc_w, gxm_XFillArc)
+Xen_wrap_5_args(gxm_XFillArcs_w, gxm_XFillArcs)
+Xen_wrap_7_args(gxm_XFillPolygon_w, gxm_XFillPolygon)
+Xen_wrap_7_args(gxm_XFillRectangle_w, gxm_XFillRectangle)
+Xen_wrap_5_args(gxm_XFillRectangles_w, gxm_XFillRectangles)
+Xen_wrap_1_arg(gxm_XFlush_w, gxm_XFlush)
+Xen_wrap_2_args(gxm_XForceScreenSaver_w, gxm_XForceScreenSaver)
+Xen_wrap_1_arg(gxm_XFree_w, gxm_XFree)
+Xen_wrap_2_args(gxm_XFreeColormap_w, gxm_XFreeColormap)
+Xen_wrap_5_args(gxm_XFreeColors_w, gxm_XFreeColors)
+Xen_wrap_2_args(gxm_XFreeCursor_w, gxm_XFreeCursor)
+Xen_wrap_1_arg(gxm_XFreeExtensionList_w, gxm_XFreeExtensionList)
+Xen_wrap_2_args(gxm_XFreeFont_w, gxm_XFreeFont)
+Xen_wrap_3_args(gxm_XFreeFontInfo_w, gxm_XFreeFontInfo)
+Xen_wrap_1_arg(gxm_XFreeFontNames_w, gxm_XFreeFontNames)
+Xen_wrap_1_arg(gxm_XFreeFontPath_w, gxm_XFreeFontPath)
+Xen_wrap_2_args(gxm_XFreeGC_w, gxm_XFreeGC)
+Xen_wrap_1_arg(gxm_XFreeModifiermap_w, gxm_XFreeModifiermap)
+Xen_wrap_2_args(gxm_XFreePixmap_w, gxm_XFreePixmap)
+Xen_wrap_any_args(gxm_XGeometry_w, gxm_XGeometry)
+Xen_wrap_4_args(gxm_XGetErrorText_w, gxm_XGetErrorText)
+Xen_wrap_2_args(gxm_XGetFontProperty_w, gxm_XGetFontProperty)
+Xen_wrap_3_args(gxm_XGetGCValues_w, gxm_XGetGCValues)
+Xen_wrap_no_args(gxm_XGCValues_w, gxm_XGCValues)
+Xen_wrap_1_optional_arg(gxm_XEvent_w, gxm_XEvent)
+Xen_wrap_2_args(gxm_XGetGeometry_w, gxm_XGetGeometry)
+Xen_wrap_2_args(gxm_XGetIconName_w, gxm_XGetIconName)
+Xen_wrap_1_arg(gxm_XGetInputFocus_w, gxm_XGetInputFocus)
+Xen_wrap_1_arg(gxm_XGetKeyboardControl_w, gxm_XGetKeyboardControl)
+Xen_wrap_1_arg(gxm_XGetPointerControl_w, gxm_XGetPointerControl)
+Xen_wrap_3_args(gxm_XGetPointerMapping_w, gxm_XGetPointerMapping)
+Xen_wrap_1_arg(gxm_XGetScreenSaver_w, gxm_XGetScreenSaver)
+Xen_wrap_2_args(gxm_XGetTransientForHint_w, gxm_XGetTransientForHint)
+Xen_wrap_any_args(gxm_XGetWindowProperty_w, gxm_XGetWindowProperty)
+Xen_wrap_2_args(gxm_XGetWindowAttributes_w, gxm_XGetWindowAttributes)
+Xen_wrap_any_args(gxm_XGrabButton_w, gxm_XGrabButton)
+Xen_wrap_7_args(gxm_XGrabKey_w, gxm_XGrabKey)
+Xen_wrap_6_args(gxm_XGrabKeyboard_w, gxm_XGrabKeyboard)
+Xen_wrap_9_args(gxm_XGrabPointer_w, gxm_XGrabPointer)
+Xen_wrap_1_arg(gxm_XGrabServer_w, gxm_XGrabServer)
+Xen_wrap_1_arg(gxm_XHeightMMOfScreen_w, gxm_XHeightMMOfScreen)
+Xen_wrap_1_arg(gxm_XHeightOfScreen_w, gxm_XHeightOfScreen)
+Xen_wrap_3_args(gxm_XIfEvent_w, gxm_XIfEvent)
+Xen_wrap_1_arg(gxm_XImageByteOrder_w, gxm_XImageByteOrder)
+Xen_wrap_2_args(gxm_XInstallColormap_w, gxm_XInstallColormap)
+Xen_wrap_2_args(gxm_XKeysymToKeycode_w, gxm_XKeysymToKeycode)
+Xen_wrap_2_args(gxm_XKillClient_w, gxm_XKillClient)
+Xen_wrap_5_args(gxm_XLookupColor_w, gxm_XLookupColor)
+Xen_wrap_2_args(gxm_XLowerWindow_w, gxm_XLowerWindow)
+Xen_wrap_2_args(gxm_XMapRaised_w, gxm_XMapRaised)
+Xen_wrap_2_args(gxm_XMapSubwindows_w, gxm_XMapSubwindows)
+Xen_wrap_2_args(gxm_XMapWindow_w, gxm_XMapWindow)
+Xen_wrap_2_args(gxm_XMaskEvent_w, gxm_XMaskEvent)
+Xen_wrap_1_arg(gxm_XMaxCmapsOfScreen_w, gxm_XMaxCmapsOfScreen)
+Xen_wrap_1_arg(gxm_XMinCmapsOfScreen_w, gxm_XMinCmapsOfScreen)
+Xen_wrap_6_args(gxm_XMoveResizeWindow_w, gxm_XMoveResizeWindow)
+Xen_wrap_4_args(gxm_XMoveWindow_w, gxm_XMoveWindow)
+Xen_wrap_1_arg(gxm_XNextEvent_w, gxm_XNextEvent)
+Xen_wrap_1_arg(gxm_XNoOp_w, gxm_XNoOp)
+Xen_wrap_4_args(gxm_XParseColor_w, gxm_XParseColor)
+Xen_wrap_1_arg(gxm_XParseGeometry_w, gxm_XParseGeometry)
+Xen_wrap_1_arg(gxm_XPeekEvent_w, gxm_XPeekEvent)
+Xen_wrap_3_args(gxm_XPeekIfEvent_w, gxm_XPeekIfEvent)
+Xen_wrap_1_arg(gxm_XPending_w, gxm_XPending)
+Xen_wrap_1_arg(gxm_XPlanesOfScreen_w, gxm_XPlanesOfScreen)
+Xen_wrap_1_arg(gxm_XProtocolRevision_w, gxm_XProtocolRevision)
+Xen_wrap_1_arg(gxm_XProtocolVersion_w, gxm_XProtocolVersion)
+Xen_wrap_2_args(gxm_XPutBackEvent_w, gxm_XPutBackEvent)
+Xen_wrap_any_args(gxm_XPutImage_w, gxm_XPutImage)
+Xen_wrap_1_arg(gxm_XQLength_w, gxm_XQLength)
+Xen_wrap_4_args(gxm_XQueryBestCursor_w, gxm_XQueryBestCursor)
+Xen_wrap_5_args(gxm_XQueryBestSize_w, gxm_XQueryBestSize)
+Xen_wrap_4_args(gxm_XQueryBestStipple_w, gxm_XQueryBestStipple)
+Xen_wrap_4_args(gxm_XQueryBestTile_w, gxm_XQueryBestTile)
+Xen_wrap_3_args(gxm_XQueryColor_w, gxm_XQueryColor)
+Xen_wrap_4_optional_args(gxm_XQueryColors_w, gxm_XQueryColors)
+Xen_wrap_2_args(gxm_XQueryExtension_w, gxm_XQueryExtension)
+Xen_wrap_1_arg(gxm_XQueryKeymap_w, gxm_XQueryKeymap)
+Xen_wrap_2_args(gxm_XQueryPointer_w, gxm_XQueryPointer)
+Xen_wrap_3_args(gxm_XQueryTextExtents_w, gxm_XQueryTextExtents)
+Xen_wrap_2_args(gxm_XQueryTree_w, gxm_XQueryTree)
+Xen_wrap_2_args(gxm_XRaiseWindow_w, gxm_XRaiseWindow)
+Xen_wrap_3_args(gxm_XReadBitmapFile_w, gxm_XReadBitmapFile)
+Xen_wrap_1_arg(gxm_XReadBitmapFileData_w, gxm_XReadBitmapFileData)
+Xen_wrap_6_args(gxm_XRebindKeysym_w, gxm_XRebindKeysym)
+Xen_wrap_4_args(gxm_XRecolorCursor_w, gxm_XRecolorCursor)
+Xen_wrap_1_arg(gxm_XRefreshKeyboardMapping_w, gxm_XRefreshKeyboardMapping)
+Xen_wrap_5_args(gxm_XReparentWindow_w, gxm_XReparentWindow)
+Xen_wrap_1_arg(gxm_XResetScreenSaver_w, gxm_XResetScreenSaver)
+Xen_wrap_4_args(gxm_XResizeWindow_w, gxm_XResizeWindow)
+Xen_wrap_3_args(gxm_XRestackWindows_w, gxm_XRestackWindows)
+Xen_wrap_2_args(gxm_XRotateBuffers_w, gxm_XRotateBuffers)
+Xen_wrap_5_args(gxm_XRotateWindowProperties_w, gxm_XRotateWindowProperties)
+Xen_wrap_1_arg(gxm_XScreenCount_w, gxm_XScreenCount)
+Xen_wrap_3_args(gxm_XSelectInput_w, gxm_XSelectInput)
+Xen_wrap_5_args(gxm_XSendEvent_w, gxm_XSendEvent)
+Xen_wrap_2_args(gxm_XSetAccessControl_w, gxm_XSetAccessControl)
+Xen_wrap_3_args(gxm_XSetArcMode_w, gxm_XSetArcMode)
+Xen_wrap_3_args(gxm_XSetBackground_w, gxm_XSetBackground)
+Xen_wrap_3_args(gxm_XSetClipMask_w, gxm_XSetClipMask)
+Xen_wrap_4_args(gxm_XSetClipOrigin_w, gxm_XSetClipOrigin)
+Xen_wrap_7_args(gxm_XSetClipRectangles_w, gxm_XSetClipRectangles)
+Xen_wrap_2_args(gxm_XSetCloseDownMode_w, gxm_XSetCloseDownMode)
+Xen_wrap_4_args(gxm_XSetCommand_w, gxm_XSetCommand)
+Xen_wrap_5_optional_args(gxm_XSetDashes_w, gxm_XSetDashes)
+Xen_wrap_3_args(gxm_XSetFillRule_w, gxm_XSetFillRule)
+Xen_wrap_3_args(gxm_XSetFillStyle_w, gxm_XSetFillStyle)
+Xen_wrap_3_args(gxm_XSetFont_w, gxm_XSetFont)
+Xen_wrap_3_args(gxm_XSetFontPath_w, gxm_XSetFontPath)
+Xen_wrap_3_args(gxm_XSetForeground_w, gxm_XSetForeground)
+Xen_wrap_3_args(gxm_XSetFunction_w, gxm_XSetFunction)
+Xen_wrap_3_args(gxm_XSetGraphicsExposures_w, gxm_XSetGraphicsExposures)
+Xen_wrap_3_args(gxm_XSetIconName_w, gxm_XSetIconName)
+Xen_wrap_4_args(gxm_XSetInputFocus_w, gxm_XSetInputFocus)
+Xen_wrap_6_args(gxm_XSetLineAttributes_w, gxm_XSetLineAttributes)
+Xen_wrap_2_args(gxm_XSetModifierMapping_w, gxm_XSetModifierMapping)
+Xen_wrap_3_args(gxm_XSetPlaneMask_w, gxm_XSetPlaneMask)
+Xen_wrap_3_optional_args(gxm_XSetPointerMapping_w, gxm_XSetPointerMapping)
+Xen_wrap_5_args(gxm_XSetScreenSaver_w, gxm_XSetScreenSaver)
+Xen_wrap_4_args(gxm_XSetSelectionOwner_w, gxm_XSetSelectionOwner)
+Xen_wrap_6_args(gxm_XSetState_w, gxm_XSetState)
+Xen_wrap_3_args(gxm_XSetStipple_w, gxm_XSetStipple)
+Xen_wrap_3_args(gxm_XSetSubwindowMode_w, gxm_XSetSubwindowMode)
+Xen_wrap_4_args(gxm_XSetTSOrigin_w, gxm_XSetTSOrigin)
+Xen_wrap_3_args(gxm_XSetTile_w, gxm_XSetTile)
+Xen_wrap_3_args(gxm_XSetWindowBackground_w, gxm_XSetWindowBackground)
+Xen_wrap_3_args(gxm_XSetWindowBackgroundPixmap_w, gxm_XSetWindowBackgroundPixmap)
+Xen_wrap_3_args(gxm_XSetWindowBorder_w, gxm_XSetWindowBorder)
+Xen_wrap_3_args(gxm_XSetWindowBorderPixmap_w, gxm_XSetWindowBorderPixmap)
+Xen_wrap_3_args(gxm_XSetWindowBorderWidth_w, gxm_XSetWindowBorderWidth)
+Xen_wrap_3_args(gxm_XSetWindowColormap_w, gxm_XSetWindowColormap)
+Xen_wrap_4_args(gxm_XStoreBuffer_w, gxm_XStoreBuffer)
+Xen_wrap_3_args(gxm_XStoreBytes_w, gxm_XStoreBytes)
+Xen_wrap_3_args(gxm_XStoreColor_w, gxm_XStoreColor)
+Xen_wrap_4_args(gxm_XStoreColors_w, gxm_XStoreColors)
+Xen_wrap_3_args(gxm_XStoreName_w, gxm_XStoreName)
+Xen_wrap_5_args(gxm_XStoreNamedColor_w, gxm_XStoreNamedColor)
+Xen_wrap_2_args(gxm_XSync_w, gxm_XSync)
+Xen_wrap_3_args(gxm_XTextExtents_w, gxm_XTextExtents)
+Xen_wrap_3_args(gxm_XTextWidth_w, gxm_XTextWidth)
+Xen_wrap_5_args(gxm_XTranslateCoordinates_w, gxm_XTranslateCoordinates)
+Xen_wrap_2_args(gxm_XUndefineCursor_w, gxm_XUndefineCursor)
+Xen_wrap_4_args(gxm_XUngrabButton_w, gxm_XUngrabButton)
+Xen_wrap_4_args(gxm_XUngrabKey_w, gxm_XUngrabKey)
+Xen_wrap_2_args(gxm_XUngrabKeyboard_w, gxm_XUngrabKeyboard)
+Xen_wrap_2_args(gxm_XUngrabPointer_w, gxm_XUngrabPointer)
+Xen_wrap_1_arg(gxm_XUngrabServer_w, gxm_XUngrabServer)
+Xen_wrap_2_args(gxm_XUninstallColormap_w, gxm_XUninstallColormap)
+Xen_wrap_2_args(gxm_XUnloadFont_w, gxm_XUnloadFont)
+Xen_wrap_2_args(gxm_XUnmapSubwindows_w, gxm_XUnmapSubwindows)
+Xen_wrap_2_args(gxm_XUnmapWindow_w, gxm_XUnmapWindow)
+Xen_wrap_1_arg(gxm_XVendorRelease_w, gxm_XVendorRelease)
+Xen_wrap_9_args(gxm_XWarpPointer_w, gxm_XWarpPointer)
+Xen_wrap_1_arg(gxm_XWidthMMOfScreen_w, gxm_XWidthMMOfScreen)
+Xen_wrap_1_arg(gxm_XWidthOfScreen_w, gxm_XWidthOfScreen)
+Xen_wrap_3_args(gxm_XWindowEvent_w, gxm_XWindowEvent)
+Xen_wrap_7_args(gxm_XWriteBitmapFile_w, gxm_XWriteBitmapFile)
+Xen_wrap_no_args(gxm_XSupportsLocale_w, gxm_XSupportsLocale)
+Xen_wrap_1_arg(gxm_XSetLocaleModifiers_w, gxm_XSetLocaleModifiers)
+Xen_wrap_2_args(gxm_XCreateFontSet_w, gxm_XCreateFontSet)
+Xen_wrap_2_args(gxm_XFreeFontSet_w, gxm_XFreeFontSet)
+Xen_wrap_1_arg(gxm_XFontsOfFontSet_w, gxm_XFontsOfFontSet)
+Xen_wrap_1_arg(gxm_XBaseFontNameListOfFontSet_w, gxm_XBaseFontNameListOfFontSet)
+Xen_wrap_1_arg(gxm_XLocaleOfFontSet_w, gxm_XLocaleOfFontSet)
+Xen_wrap_1_arg(gxm_XContextDependentDrawing_w, gxm_XContextDependentDrawing)
+Xen_wrap_1_arg(gxm_XDirectionalDependentDrawing_w, gxm_XDirectionalDependentDrawing)
+Xen_wrap_1_arg(gxm_XContextualDrawing_w, gxm_XContextualDrawing)
+Xen_wrap_2_args(gxm_XFilterEvent_w, gxm_XFilterEvent)
+Xen_wrap_no_args(gxm_XAllocIconSize_w, gxm_XAllocIconSize)
+Xen_wrap_no_args(gxm_XAllocStandardColormap_w, gxm_XAllocStandardColormap)
+Xen_wrap_no_args(gxm_XAllocWMHints_w, gxm_XAllocWMHints)
+Xen_wrap_1_arg(gxm_XClipBox_w, gxm_XClipBox)
+Xen_wrap_no_args(gxm_XCreateRegion_w, gxm_XCreateRegion)
+Xen_wrap_no_args(gxm_XDefaultString_w, gxm_XDefaultString)
+Xen_wrap_3_args(gxm_XDeleteContext_w, gxm_XDeleteContext)
+Xen_wrap_1_arg(gxm_XDestroyRegion_w, gxm_XDestroyRegion)
+Xen_wrap_1_arg(gxm_XEmptyRegion_w, gxm_XEmptyRegion)
+Xen_wrap_2_args(gxm_XEqualRegion_w, gxm_XEqualRegion)
+Xen_wrap_3_args(gxm_XFindContext_w, gxm_XFindContext)
+Xen_wrap_2_args(gxm_XGetIconSizes_w, gxm_XGetIconSizes)
+Xen_wrap_3_args(gxm_XGetRGBColormaps_w, gxm_XGetRGBColormaps)
+Xen_wrap_3_args(gxm_XGetVisualInfo_w, gxm_XGetVisualInfo)
+Xen_wrap_2_args(gxm_XGetWMHints_w, gxm_XGetWMHints)
+Xen_wrap_3_args(gxm_XIntersectRegion_w, gxm_XIntersectRegion)
+Xen_wrap_1_arg(gxm_XConvertCase_w, gxm_XConvertCase)
+Xen_wrap_1_arg(gxm_XLookupString_w, gxm_XLookupString)
+Xen_wrap_4_args(gxm_XMatchVisualInfo_w, gxm_XMatchVisualInfo)
+Xen_wrap_3_args(gxm_XOffsetRegion_w, gxm_XOffsetRegion)
+Xen_wrap_3_args(gxm_XPointInRegion_w, gxm_XPointInRegion)
+Xen_wrap_3_args(gxm_XPolygonRegion_w, gxm_XPolygonRegion)
+Xen_wrap_5_args(gxm_XRectInRegion_w, gxm_XRectInRegion)
+Xen_wrap_4_args(gxm_XSaveContext_w, gxm_XSaveContext)
+Xen_wrap_no_args(gxm_XUniqueContext_w, gxm_XUniqueContext)
+Xen_wrap_5_args(gxm_XSetRGBColormaps_w, gxm_XSetRGBColormaps)
+Xen_wrap_3_args(gxm_XSetWMHints_w, gxm_XSetWMHints)
+Xen_wrap_3_args(gxm_XSetRegion_w, gxm_XSetRegion)
+Xen_wrap_8_args(gxm_XSetWMProperties_w, gxm_XSetWMProperties)
+Xen_wrap_3_args(gxm_XShrinkRegion_w, gxm_XShrinkRegion)
+Xen_wrap_3_args(gxm_XSubtractRegion_w, gxm_XSubtractRegion)
+Xen_wrap_3_args(gxm_XUnionRectWithRegion_w, gxm_XUnionRectWithRegion)
+Xen_wrap_3_args(gxm_XUnionRegion_w, gxm_XUnionRegion)
+Xen_wrap_3_args(gxm_XXorRegion_w, gxm_XXorRegion)
+
+Xen_wrap_1_arg(gxm_DefaultScreen_w, gxm_DefaultScreen)
+Xen_wrap_1_arg(gxm_DefaultRootWindow_w, gxm_DefaultRootWindow)
+Xen_wrap_1_arg(gxm_QLength_w, gxm_QLength)
+Xen_wrap_1_arg(gxm_ScreenCount_w, gxm_ScreenCount)
+Xen_wrap_1_arg(gxm_ServerVendor_w, gxm_ServerVendor)
+Xen_wrap_1_arg(gxm_ProtocolVersion_w, gxm_ProtocolVersion)
+Xen_wrap_1_arg(gxm_ProtocolRevision_w, gxm_ProtocolRevision)
+Xen_wrap_1_arg(gxm_VendorRelease_w, gxm_VendorRelease)
+Xen_wrap_1_arg(gxm_DisplayString_w, gxm_DisplayString)
+Xen_wrap_1_arg(gxm_BitmapUnit_w, gxm_BitmapUnit)
+Xen_wrap_1_arg(gxm_BitmapBitOrder_w, gxm_BitmapBitOrder)
+Xen_wrap_1_arg(gxm_BitmapPad_w, gxm_BitmapPad)
+Xen_wrap_1_arg(gxm_ImageByteOrder_w, gxm_ImageByteOrder)
+Xen_wrap_1_arg(gxm_NextRequest_w, gxm_NextRequest)
+Xen_wrap_1_arg(gxm_LastKnownRequestProcessed_w, gxm_LastKnownRequestProcessed)
+Xen_wrap_1_arg(gxm_DefaultScreenOfDisplay_w, gxm_DefaultScreenOfDisplay)
+Xen_wrap_1_arg(gxm_DisplayOfScreen_w, gxm_DisplayOfScreen)
+Xen_wrap_1_arg(gxm_RootWindowOfScreen_w, gxm_RootWindowOfScreen)
+Xen_wrap_1_arg(gxm_BlackPixelOfScreen_w, gxm_BlackPixelOfScreen)
+Xen_wrap_1_arg(gxm_WhitePixelOfScreen_w, gxm_WhitePixelOfScreen)
+Xen_wrap_1_arg(gxm_DefaultColormapOfScreen_w, gxm_DefaultColormapOfScreen)
+Xen_wrap_1_arg(gxm_DefaultDepthOfScreen_w, gxm_DefaultDepthOfScreen)
+Xen_wrap_1_arg(gxm_DefaultGCOfScreen_w, gxm_DefaultGCOfScreen)
+Xen_wrap_1_arg(gxm_DefaultVisualOfScreen_w, gxm_DefaultVisualOfScreen)
+Xen_wrap_1_arg(gxm_WidthOfScreen_w, gxm_WidthOfScreen)
+Xen_wrap_1_arg(gxm_HeightOfScreen_w, gxm_HeightOfScreen)
+Xen_wrap_1_arg(gxm_WidthMMOfScreen_w, gxm_WidthMMOfScreen)
+Xen_wrap_1_arg(gxm_HeightMMOfScreen_w, gxm_HeightMMOfScreen)
+Xen_wrap_1_arg(gxm_PlanesOfScreen_w, gxm_PlanesOfScreen)
+Xen_wrap_1_arg(gxm_CellsOfScreen_w, gxm_CellsOfScreen)
+Xen_wrap_1_arg(gxm_MinCmapsOfScreen_w, gxm_MinCmapsOfScreen)
+Xen_wrap_1_arg(gxm_MaxCmapsOfScreen_w, gxm_MaxCmapsOfScreen)
+Xen_wrap_1_arg(gxm_DoesSaveUnders_w, gxm_DoesSaveUnders)
+Xen_wrap_1_arg(gxm_DoesBackingStore_w, gxm_DoesBackingStore)
+Xen_wrap_1_arg(gxm_EventMaskOfScreen_w, gxm_EventMaskOfScreen)
+Xen_wrap_2_args(gxm_RootWindow_w, gxm_RootWindow)
+Xen_wrap_2_args(gxm_DefaultVisual_w, gxm_DefaultVisual)
+Xen_wrap_2_args(gxm_DefaultGC_w, gxm_DefaultGC)
+Xen_wrap_2_args(gxm_BlackPixel_w, gxm_BlackPixel)
+Xen_wrap_2_args(gxm_WhitePixel_w, gxm_WhitePixel)
+Xen_wrap_2_args(gxm_DisplayWidth_w, gxm_DisplayWidth)
+Xen_wrap_2_args(gxm_DisplayHeight_w, gxm_DisplayHeight)
+Xen_wrap_2_args(gxm_DisplayWidthMM_w, gxm_DisplayWidthMM)
+Xen_wrap_2_args(gxm_DisplayHeightMM_w, gxm_DisplayHeightMM)
+Xen_wrap_2_args(gxm_DisplayPlanes_w, gxm_DisplayPlanes)
+Xen_wrap_2_args(gxm_DisplayCells_w, gxm_DisplayCells)
+Xen_wrap_2_args(gxm_DefaultColormap_w, gxm_DefaultColormap)
+Xen_wrap_2_args(gxm_ScreenOfDisplay_w, gxm_ScreenOfDisplay)
+Xen_wrap_2_args(gxm_DefaultDepth_w, gxm_DefaultDepth)
+
+Xen_wrap_1_arg(gxm_IsKeypadKey_w, gxm_IsKeypadKey)
+Xen_wrap_1_arg(gxm_IsPrivateKeypadKey_w, gxm_IsPrivateKeypadKey)
+Xen_wrap_1_arg(gxm_IsCursorKey_w, gxm_IsCursorKey)
+Xen_wrap_1_arg(gxm_IsPFKey_w, gxm_IsPFKey)
+Xen_wrap_1_arg(gxm_IsFunctionKey_w, gxm_IsFunctionKey)
+Xen_wrap_1_arg(gxm_IsMiscFunctionKey_w, gxm_IsMiscFunctionKey)
+Xen_wrap_1_arg(gxm_IsModifierKey_w, gxm_IsModifierKey)
+
+Xen_wrap_1_arg(g_is_XButtonEvent_w, g_is_XButtonEvent)
+Xen_wrap_1_arg(g_is_XCirculateEvent_w, g_is_XCirculateEvent)
+Xen_wrap_1_arg(g_is_XCirculateRequestEvent_w, g_is_XCirculateRequestEvent)
+Xen_wrap_1_arg(g_is_XClientMessageEvent_w, g_is_XClientMessageEvent)
+Xen_wrap_1_arg(g_is_XColormapEvent_w, g_is_XColormapEvent)
+Xen_wrap_1_arg(g_is_XConfigureEvent_w, g_is_XConfigureEvent)
+Xen_wrap_1_arg(g_is_XConfigureRequestEvent_w, g_is_XConfigureRequestEvent)
+Xen_wrap_1_arg(g_is_XCreateWindowEvent_w, g_is_XCreateWindowEvent)
+Xen_wrap_1_arg(g_is_XCrossingEvent_w, g_is_XCrossingEvent)
+Xen_wrap_1_arg(g_is_XDestroyWindowEvent_w, g_is_XDestroyWindowEvent)
+Xen_wrap_1_arg(g_is_XErrorEvent_w, g_is_XErrorEvent)
+Xen_wrap_1_arg(g_is_XExposeEvent_w, g_is_XExposeEvent)
+Xen_wrap_1_arg(g_is_XFocusChangeEvent_w, g_is_XFocusChangeEvent)
+Xen_wrap_1_arg(g_is_XGraphicsExposeEvent_w, g_is_XGraphicsExposeEvent)
+Xen_wrap_1_arg(g_is_XGravityEvent_w, g_is_XGravityEvent)
+Xen_wrap_1_arg(g_is_XKeyEvent_w, g_is_XKeyEvent)
+Xen_wrap_1_arg(g_is_XKeymapEvent_w, g_is_XKeymapEvent)
+Xen_wrap_1_arg(g_is_XMapEvent_w, g_is_XMapEvent)
+Xen_wrap_1_arg(g_is_XMapRequestEvent_w, g_is_XMapRequestEvent)
+Xen_wrap_1_arg(g_is_XMappingEvent_w, g_is_XMappingEvent)
+Xen_wrap_1_arg(g_is_XMotionEvent_w, g_is_XMotionEvent)
+Xen_wrap_1_arg(g_is_XNoExposeEvent_w, g_is_XNoExposeEvent)
+Xen_wrap_1_arg(g_is_XPropertyEvent_w, g_is_XPropertyEvent)
+Xen_wrap_1_arg(g_is_XReparentEvent_w, g_is_XReparentEvent)
+Xen_wrap_1_arg(g_is_XResizeRequestEvent_w, g_is_XResizeRequestEvent)
+Xen_wrap_1_arg(g_is_XSelectionClearEvent_w, g_is_XSelectionClearEvent)
+Xen_wrap_1_arg(g_is_XSelectionEvent_w, g_is_XSelectionEvent)
+Xen_wrap_1_arg(g_is_XSelectionRequestEvent_w, g_is_XSelectionRequestEvent)
+Xen_wrap_1_arg(g_is_XSetWindowAttributes_w, g_is_XSetWindowAttributes)
+Xen_wrap_1_arg(g_is_XUnmapEvent_w, g_is_XUnmapEvent)
+Xen_wrap_1_arg(g_is_XVisibilityEvent_w, g_is_XVisibilityEvent)
+Xen_wrap_1_arg(g_is_XIconSize_w, g_is_XIconSize)
+
+Xen_wrap_4_optional_args(gxm_XmCreateMessageBox_w, gxm_XmCreateMessageBox)
+Xen_wrap_4_optional_args(gxm_XmCreateMessageDialog_w, gxm_XmCreateMessageDialog)
+Xen_wrap_4_optional_args(gxm_XmCreateErrorDialog_w, gxm_XmCreateErrorDialog)
+Xen_wrap_4_optional_args(gxm_XmCreateInformationDialog_w, gxm_XmCreateInformationDialog)
+Xen_wrap_4_optional_args(gxm_XmCreateQuestionDialog_w, gxm_XmCreateQuestionDialog)
+Xen_wrap_4_optional_args(gxm_XmCreateWarningDialog_w, gxm_XmCreateWarningDialog)
+Xen_wrap_4_optional_args(gxm_XmCreateWorkingDialog_w, gxm_XmCreateWorkingDialog)
+Xen_wrap_4_optional_args(gxm_XmCreateTemplateDialog_w, gxm_XmCreateTemplateDialog)
+Xen_wrap_2_args(gxm_XmMessageBoxGetChild_w, gxm_XmMessageBoxGetChild)
+Xen_wrap_4_optional_args(gxm_XmCreateArrowButtonGadget_w, gxm_XmCreateArrowButtonGadget)
+Xen_wrap_4_optional_args(gxm_XmCreateArrowButton_w, gxm_XmCreateArrowButton)
+Xen_wrap_4_optional_args(gxm_XmCreateNotebook_w, gxm_XmCreateNotebook)
+Xen_wrap_2_args(gxm_XmNotebookGetPageInfo_w, gxm_XmNotebookGetPageInfo)
+Xen_wrap_5_args(gxm_XmTransferSetParameters_w, gxm_XmTransferSetParameters)
+Xen_wrap_2_args(gxm_XmTransferDone_w, gxm_XmTransferDone)
+Xen_wrap_5_args(gxm_XmTransferValue_w, gxm_XmTransferValue)
+Xen_wrap_1_arg(gxm_XmTransferStartRequest_w, gxm_XmTransferStartRequest)
+Xen_wrap_2_args(gxm_XmTransferSendRequest_w, gxm_XmTransferSendRequest)
+Xen_wrap_4_optional_args(gxm_XmCreateComboBox_w, gxm_XmCreateComboBox)
+Xen_wrap_4_optional_args(gxm_XmCreateDropDownComboBox_w, gxm_XmCreateDropDownComboBox)
+Xen_wrap_4_optional_args(gxm_XmCreateDropDownList_w, gxm_XmCreateDropDownList)
+Xen_wrap_4_args(gxm_XmComboBoxAddItem_w, gxm_XmComboBoxAddItem)
+Xen_wrap_2_args(gxm_XmComboBoxDeletePos_w, gxm_XmComboBoxDeletePos)
+Xen_wrap_2_args(gxm_XmComboBoxSelectItem_w, gxm_XmComboBoxSelectItem)
+Xen_wrap_2_args(gxm_XmComboBoxSetItem_w, gxm_XmComboBoxSetItem)
+Xen_wrap_1_arg(gxm_XmComboBoxUpdate_w, gxm_XmComboBoxUpdate)
+Xen_wrap_4_optional_args(gxm_XmCreateContainer_w, gxm_XmCreateContainer)
+Xen_wrap_2_args(gxm_XmContainerGetItemChildren_w, gxm_XmContainerGetItemChildren)
+Xen_wrap_1_arg(gxm_XmContainerRelayout_w, gxm_XmContainerRelayout)
+Xen_wrap_3_args(gxm_XmContainerReorder_w, gxm_XmContainerReorder)
+Xen_wrap_2_args(gxm_XmContainerCut_w, gxm_XmContainerCut)
+Xen_wrap_2_args(gxm_XmContainerCopy_w, gxm_XmContainerCopy)
+Xen_wrap_1_arg(gxm_XmContainerPaste_w, gxm_XmContainerPaste)
+Xen_wrap_2_args(gxm_XmContainerCopyLink_w, gxm_XmContainerCopyLink)
+Xen_wrap_1_arg(gxm_XmContainerPasteLink_w, gxm_XmContainerPasteLink)
+Xen_wrap_4_optional_args(gxm_XmCreateSpinBox_w, gxm_XmCreateSpinBox)
+Xen_wrap_1_arg(gxm_XmSpinBoxValidatePosition_w, gxm_XmSpinBoxValidatePosition)
+Xen_wrap_4_optional_args(gxm_XmCreateSimpleSpinBox_w, gxm_XmCreateSimpleSpinBox)
+Xen_wrap_3_args(gxm_XmSimpleSpinBoxAddItem_w, gxm_XmSimpleSpinBoxAddItem)
+Xen_wrap_2_args(gxm_XmSimpleSpinBoxDeletePos_w, gxm_XmSimpleSpinBoxDeletePos)
+Xen_wrap_2_args(gxm_XmSimpleSpinBoxSetItem_w, gxm_XmSimpleSpinBoxSetItem)
+Xen_wrap_1_arg(gxm_XmDropSiteRegistered_w, gxm_XmDropSiteRegistered)
+Xen_wrap_2_args(gxm_XmTextFieldCopyLink_w, gxm_XmTextFieldCopyLink)
+Xen_wrap_1_arg(gxm_XmTextFieldPasteLink_w, gxm_XmTextFieldPasteLink)
+Xen_wrap_1_arg(gxm_XmTextGetCenterline_w, gxm_XmTextGetCenterline)
+Xen_wrap_3_args(gxm_XmToggleButtonGadgetSetValue_w, gxm_XmToggleButtonGadgetSetValue)
+Xen_wrap_4_optional_args(gxm_XmCreateIconGadget_w, gxm_XmCreateIconGadget)
+Xen_wrap_4_optional_args(gxm_XmCreateIconHeader_w, gxm_XmCreateIconHeader)
+Xen_wrap_3_args(gxm_XmObjectAtPoint_w, gxm_XmObjectAtPoint)
+Xen_wrap_4_args(gxm_XmConvertStringToUnits_w, gxm_XmConvertStringToUnits)
+Xen_wrap_4_optional_args(gxm_XmCreateGrabShell_w, gxm_XmCreateGrabShell)
+Xen_wrap_3_args(gxm_XmToggleButtonSetValue_w, gxm_XmToggleButtonSetValue)
+Xen_wrap_1_arg(gxm_XmTextPasteLink_w, gxm_XmTextPasteLink)
+Xen_wrap_2_args(gxm_XmTextCopyLink_w, gxm_XmTextCopyLink)
+Xen_wrap_7_args(gxm_XmScaleSetTicks_w, gxm_XmScaleSetTicks)
+Xen_wrap_3_args(gxm_XmInternAtom_w, gxm_XmInternAtom)
+Xen_wrap_2_args(gxm_XmGetAtomName_w, gxm_XmGetAtomName)
+Xen_wrap_4_optional_args(gxm_XmCreatePanedWindow_w, gxm_XmCreatePanedWindow)
+Xen_wrap_4_optional_args(gxm_XmCreateBulletinBoard_w, gxm_XmCreateBulletinBoard)
+Xen_wrap_4_optional_args(gxm_XmCreateBulletinBoardDialog_w, gxm_XmCreateBulletinBoardDialog)
+Xen_wrap_4_optional_args(gxm_XmCreateCascadeButtonGadget_w, gxm_XmCreateCascadeButtonGadget)
+Xen_wrap_2_args(gxm_XmCascadeButtonGadgetHighlight_w, gxm_XmCascadeButtonGadgetHighlight)
+Xen_wrap_4_optional_args(gxm_XmAddProtocols_w, gxm_XmAddProtocols)
+Xen_wrap_3_optional_args(gxm_XmAddWMProtocols_w, gxm_XmAddWMProtocols)
+Xen_wrap_4_optional_args(gxm_XmRemoveProtocols_w, gxm_XmRemoveProtocols)
+Xen_wrap_3_optional_args(gxm_XmRemoveWMProtocols_w, gxm_XmRemoveWMProtocols)
+Xen_wrap_5_args(gxm_XmAddProtocolCallback_w, gxm_XmAddProtocolCallback)
+Xen_wrap_4_args(gxm_XmAddWMProtocolCallback_w, gxm_XmAddWMProtocolCallback)
+Xen_wrap_5_args(gxm_XmRemoveProtocolCallback_w, gxm_XmRemoveProtocolCallback)
+Xen_wrap_4_args(gxm_XmRemoveWMProtocolCallback_w, gxm_XmRemoveWMProtocolCallback)
+Xen_wrap_3_args(gxm_XmActivateProtocol_w, gxm_XmActivateProtocol)
+Xen_wrap_3_args(gxm_XmDeactivateProtocol_w, gxm_XmDeactivateProtocol)
+Xen_wrap_2_args(gxm_XmActivateWMProtocol_w, gxm_XmActivateWMProtocol)
+Xen_wrap_2_args(gxm_XmDeactivateWMProtocol_w, gxm_XmDeactivateWMProtocol)
+Xen_wrap_7_args(gxm_XmSetProtocolHooks_w, gxm_XmSetProtocolHooks)
+Xen_wrap_6_args(gxm_XmSetWMProtocolHooks_w, gxm_XmSetWMProtocolHooks)
+Xen_wrap_4_optional_args(gxm_XmCreateCascadeButton_w, gxm_XmCreateCascadeButton)
+Xen_wrap_2_args(gxm_XmCascadeButtonHighlight_w, gxm_XmCascadeButtonHighlight)
+Xen_wrap_4_optional_args(gxm_XmCreatePushButtonGadget_w, gxm_XmCreatePushButtonGadget)
+Xen_wrap_4_optional_args(gxm_XmCreatePushButton_w, gxm_XmCreatePushButton)
+Xen_wrap_4_optional_args(gxm_XmCreateCommand_w, gxm_XmCreateCommand)
+Xen_wrap_2_args(gxm_XmCommandGetChild_w, gxm_XmCommandGetChild)
+Xen_wrap_2_args(gxm_XmCommandSetValue_w, gxm_XmCommandSetValue)
+Xen_wrap_2_args(gxm_XmCommandAppendValue_w, gxm_XmCommandAppendValue)
+Xen_wrap_2_args(gxm_XmCommandError_w, gxm_XmCommandError)
+Xen_wrap_4_optional_args(gxm_XmCreateCommandDialog_w, gxm_XmCreateCommandDialog)
+Xen_wrap_2_args(gxm_XmMenuPosition_w, gxm_XmMenuPosition)
+Xen_wrap_4_optional_args(gxm_XmCreateRowColumn_w, gxm_XmCreateRowColumn)
+Xen_wrap_4_optional_args(gxm_XmCreateWorkArea_w, gxm_XmCreateWorkArea)
+Xen_wrap_4_optional_args(gxm_XmCreateRadioBox_w, gxm_XmCreateRadioBox)
+Xen_wrap_4_optional_args(gxm_XmCreateOptionMenu_w, gxm_XmCreateOptionMenu)
+Xen_wrap_1_arg(gxm_XmOptionLabelGadget_w, gxm_XmOptionLabelGadget)
+Xen_wrap_1_arg(gxm_XmOptionButtonGadget_w, gxm_XmOptionButtonGadget)
+Xen_wrap_4_optional_args(gxm_XmCreateMenuBar_w, gxm_XmCreateMenuBar)
+Xen_wrap_4_optional_args(gxm_XmCreatePopupMenu_w, gxm_XmCreatePopupMenu)
+Xen_wrap_4_optional_args(gxm_XmCreatePulldownMenu_w, gxm_XmCreatePulldownMenu)
+Xen_wrap_1_arg(gxm_XmGetPostedFromWidget_w, gxm_XmGetPostedFromWidget)
+Xen_wrap_1_arg(gxm_XmGetTearOffControl_w, gxm_XmGetTearOffControl)
+Xen_wrap_2_args(gxm_XmScaleSetValue_w, gxm_XmScaleSetValue)
+Xen_wrap_1_arg(gxm_XmScaleGetValue_w, gxm_XmScaleGetValue)
+Xen_wrap_4_optional_args(gxm_XmCreateScale_w, gxm_XmCreateScale)
+Xen_wrap_5_args(gxm_XmClipboardBeginCopy_w, gxm_XmClipboardBeginCopy)
+Xen_wrap_6_args(gxm_XmClipboardStartCopy_w, gxm_XmClipboardStartCopy)
+Xen_wrap_7_args(gxm_XmClipboardCopy_w, gxm_XmClipboardCopy)
+Xen_wrap_3_args(gxm_XmClipboardEndCopy_w, gxm_XmClipboardEndCopy)
+Xen_wrap_3_args(gxm_XmClipboardCancelCopy_w, gxm_XmClipboardCancelCopy)
+Xen_wrap_3_args(gxm_XmClipboardWithdrawFormat_w, gxm_XmClipboardWithdrawFormat)
+Xen_wrap_6_args(gxm_XmClipboardCopyByName_w, gxm_XmClipboardCopyByName)
+Xen_wrap_2_args(gxm_XmClipboardUndoCopy_w, gxm_XmClipboardUndoCopy)
+Xen_wrap_2_args(gxm_XmClipboardLock_w, gxm_XmClipboardLock)
+Xen_wrap_3_args(gxm_XmClipboardUnlock_w, gxm_XmClipboardUnlock)
+Xen_wrap_3_args(gxm_XmClipboardStartRetrieve_w, gxm_XmClipboardStartRetrieve)
+Xen_wrap_2_args(gxm_XmClipboardEndRetrieve_w, gxm_XmClipboardEndRetrieve)
+Xen_wrap_4_args(gxm_XmClipboardRetrieve_w, gxm_XmClipboardRetrieve)
+Xen_wrap_2_args(gxm_XmClipboardInquireCount_w, gxm_XmClipboardInquireCount)
+Xen_wrap_4_args(gxm_XmClipboardInquireFormat_w, gxm_XmClipboardInquireFormat)
+Xen_wrap_3_args(gxm_XmClipboardInquireLength_w, gxm_XmClipboardInquireLength)
+Xen_wrap_3_args(gxm_XmClipboardInquirePendingItems_w, gxm_XmClipboardInquirePendingItems)
+Xen_wrap_3_args(gxm_XmClipboardRegisterFormat_w, gxm_XmClipboardRegisterFormat)
+Xen_wrap_1_arg(gxm_XmGetXmScreen_w, gxm_XmGetXmScreen)
+Xen_wrap_4_optional_args(gxm_XmCreateScrollBar_w, gxm_XmCreateScrollBar)
+Xen_wrap_1_arg(gxm_XmScrollBarGetValues_w, gxm_XmScrollBarGetValues)
+Xen_wrap_6_args(gxm_XmScrollBarSetValues_w, gxm_XmScrollBarSetValues)
+Xen_wrap_4_optional_args(gxm_XmCreateDialogShell_w, gxm_XmCreateDialogShell)
+Xen_wrap_4_optional_args(gxm_XmCreateScrolledWindow_w, gxm_XmCreateScrolledWindow)
+Xen_wrap_4_args(gxm_XmScrollVisible_w, gxm_XmScrollVisible)
+Xen_wrap_2_args(gxm_XmGetDragContext_w, gxm_XmGetDragContext)
+Xen_wrap_1_arg(gxm_XmGetXmDisplay_w, gxm_XmGetXmDisplay)
+Xen_wrap_2_args(gxm_XmSelectionBoxGetChild_w, gxm_XmSelectionBoxGetChild)
+Xen_wrap_4_optional_args(gxm_XmCreateSelectionBox_w, gxm_XmCreateSelectionBox)
+Xen_wrap_4_optional_args(gxm_XmCreateSelectionDialog_w, gxm_XmCreateSelectionDialog)
+Xen_wrap_4_optional_args(gxm_XmCreatePromptDialog_w, gxm_XmCreatePromptDialog)
+Xen_wrap_4_optional_args(gxm_XmDragStart_w, gxm_XmDragStart)
+Xen_wrap_1_arg(gxm_XmDragCancel_w, gxm_XmDragCancel)
+Xen_wrap_5_args(gxm_XmTargetsAreCompatible_w, gxm_XmTargetsAreCompatible)
+Xen_wrap_4_optional_args(gxm_XmCreateSeparatorGadget_w, gxm_XmCreateSeparatorGadget)
+Xen_wrap_4_optional_args(gxm_XmCreateDragIcon_w, gxm_XmCreateDragIcon)
+Xen_wrap_4_optional_args(gxm_XmCreateSeparator_w, gxm_XmCreateSeparator)
+Xen_wrap_4_optional_args(gxm_XmCreateDrawingArea_w, gxm_XmCreateDrawingArea)
+Xen_wrap_4_optional_args(gxm_XmCreateDrawnButton_w, gxm_XmCreateDrawnButton)
+Xen_wrap_3_optional_args(gxm_XmDropSiteRegister_w, gxm_XmDropSiteRegister)
+Xen_wrap_1_arg(gxm_XmDropSiteUnregister_w, gxm_XmDropSiteUnregister)
+Xen_wrap_1_arg(gxm_XmDropSiteStartUpdate_w, gxm_XmDropSiteStartUpdate)
+Xen_wrap_3_optional_args(gxm_XmDropSiteUpdate_w, gxm_XmDropSiteUpdate)
+Xen_wrap_1_arg(gxm_XmDropSiteEndUpdate_w, gxm_XmDropSiteEndUpdate)
+Xen_wrap_3_optional_args(gxm_XmDropSiteRetrieve_w, gxm_XmDropSiteRetrieve)
+Xen_wrap_1_arg(gxm_XmDropSiteQueryStackingOrder_w, gxm_XmDropSiteQueryStackingOrder)
+Xen_wrap_3_args(gxm_XmDropSiteConfigureStackingOrder_w, gxm_XmDropSiteConfigureStackingOrder)
+Xen_wrap_3_optional_args(gxm_XmDropTransferStart_w, gxm_XmDropTransferStart)
+Xen_wrap_2_args(gxm_XmDropTransferAdd_w, gxm_XmDropTransferAdd)
+Xen_wrap_1_arg(gxm_XmTextFieldGetString_w, gxm_XmTextFieldGetString)
+Xen_wrap_3_args(gxm_XmTextFieldGetSubstring_w, gxm_XmTextFieldGetSubstring)
+Xen_wrap_1_arg(gxm_XmTextFieldGetLastPosition_w, gxm_XmTextFieldGetLastPosition)
+Xen_wrap_2_args(gxm_XmTextFieldSetString_w, gxm_XmTextFieldSetString)
+Xen_wrap_4_args(gxm_XmTextFieldReplace_w, gxm_XmTextFieldReplace)
+Xen_wrap_3_args(gxm_XmTextFieldInsert_w, gxm_XmTextFieldInsert)
+Xen_wrap_2_args(gxm_XmTextFieldSetAddMode_w, gxm_XmTextFieldSetAddMode)
+Xen_wrap_1_arg(gxm_XmTextFieldGetAddMode_w, gxm_XmTextFieldGetAddMode)
+Xen_wrap_1_arg(gxm_XmTextFieldGetEditable_w, gxm_XmTextFieldGetEditable)
+Xen_wrap_2_args(gxm_XmTextFieldSetEditable_w, gxm_XmTextFieldSetEditable)
+Xen_wrap_1_arg(gxm_XmTextFieldGetMaxLength_w, gxm_XmTextFieldGetMaxLength)
+Xen_wrap_2_args(gxm_XmTextFieldSetMaxLength_w, gxm_XmTextFieldSetMaxLength)
+Xen_wrap_1_arg(gxm_XmTextFieldGetCursorPosition_w, gxm_XmTextFieldGetCursorPosition)
+Xen_wrap_1_arg(gxm_XmTextFieldGetInsertionPosition_w, gxm_XmTextFieldGetInsertionPosition)
+Xen_wrap_2_args(gxm_XmTextFieldSetCursorPosition_w, gxm_XmTextFieldSetCursorPosition)
+Xen_wrap_2_args(gxm_XmTextFieldSetInsertionPosition_w, gxm_XmTextFieldSetInsertionPosition)
+Xen_wrap_1_arg(gxm_XmTextFieldGetSelectionPosition_w, gxm_XmTextFieldGetSelectionPosition)
+Xen_wrap_1_arg(gxm_XmTextFieldGetSelection_w, gxm_XmTextFieldGetSelection)
+Xen_wrap_1_arg(gxm_XmTextFieldRemove_w, gxm_XmTextFieldRemove)
+Xen_wrap_2_args(gxm_XmTextFieldCopy_w, gxm_XmTextFieldCopy)
+Xen_wrap_2_args(gxm_XmTextFieldCut_w, gxm_XmTextFieldCut)
+Xen_wrap_1_arg(gxm_XmTextFieldPaste_w, gxm_XmTextFieldPaste)
+Xen_wrap_2_args(gxm_XmTextFieldClearSelection_w, gxm_XmTextFieldClearSelection)
+Xen_wrap_4_args(gxm_XmTextFieldSetSelection_w, gxm_XmTextFieldSetSelection)
+Xen_wrap_3_args(gxm_XmTextFieldXYToPos_w, gxm_XmTextFieldXYToPos)
+Xen_wrap_2_args(gxm_XmTextFieldPosToXY_w, gxm_XmTextFieldPosToXY)
+Xen_wrap_2_args(gxm_XmTextFieldShowPosition_w, gxm_XmTextFieldShowPosition)
+Xen_wrap_4_args(gxm_XmTextFieldSetHighlight_w, gxm_XmTextFieldSetHighlight)
+Xen_wrap_1_arg(gxm_XmTextFieldGetBaseline_w, gxm_XmTextFieldGetBaseline)
+Xen_wrap_4_optional_args(gxm_XmCreateTextField_w, gxm_XmCreateTextField)
+Xen_wrap_2_args(gxm_XmFileSelectionBoxGetChild_w, gxm_XmFileSelectionBoxGetChild)
+Xen_wrap_2_args(gxm_XmFileSelectionDoSearch_w, gxm_XmFileSelectionDoSearch)
+Xen_wrap_4_optional_args(gxm_XmCreateFileSelectionBox_w, gxm_XmCreateFileSelectionBox)
+Xen_wrap_4_optional_args(gxm_XmCreateFileSelectionDialog_w, gxm_XmCreateFileSelectionDialog)
+Xen_wrap_4_args(gxm_XmTextSetHighlight_w, gxm_XmTextSetHighlight)
+Xen_wrap_4_optional_args(gxm_XmCreateScrolledText_w, gxm_XmCreateScrolledText)
+Xen_wrap_4_optional_args(gxm_XmCreateText_w, gxm_XmCreateText)
+Xen_wrap_3_args(gxm_XmTextGetSubstring_w, gxm_XmTextGetSubstring)
+Xen_wrap_1_arg(gxm_XmTextGetString_w, gxm_XmTextGetString)
+Xen_wrap_1_arg(gxm_XmTextGetLastPosition_w, gxm_XmTextGetLastPosition)
+Xen_wrap_2_args(gxm_XmTextSetString_w, gxm_XmTextSetString)
+Xen_wrap_4_args(gxm_XmTextReplace_w, gxm_XmTextReplace)
+Xen_wrap_3_args(gxm_XmTextInsert_w, gxm_XmTextInsert)
+Xen_wrap_2_args(gxm_XmTextSetAddMode_w, gxm_XmTextSetAddMode)
+Xen_wrap_1_arg(gxm_XmTextGetAddMode_w, gxm_XmTextGetAddMode)
+Xen_wrap_1_arg(gxm_XmTextGetEditable_w, gxm_XmTextGetEditable)
+Xen_wrap_2_args(gxm_XmTextSetEditable_w, gxm_XmTextSetEditable)
+Xen_wrap_1_arg(gxm_XmTextGetMaxLength_w, gxm_XmTextGetMaxLength)
+Xen_wrap_2_args(gxm_XmTextSetMaxLength_w, gxm_XmTextSetMaxLength)
+Xen_wrap_1_arg(gxm_XmTextGetTopCharacter_w, gxm_XmTextGetTopCharacter)
+Xen_wrap_2_args(gxm_XmTextSetTopCharacter_w, gxm_XmTextSetTopCharacter)
+Xen_wrap_1_arg(gxm_XmTextGetCursorPosition_w, gxm_XmTextGetCursorPosition)
+Xen_wrap_1_arg(gxm_XmTextGetInsertionPosition_w, gxm_XmTextGetInsertionPosition)
+Xen_wrap_2_args(gxm_XmTextSetInsertionPosition_w, gxm_XmTextSetInsertionPosition)
+Xen_wrap_2_args(gxm_XmTextSetCursorPosition_w, gxm_XmTextSetCursorPosition)
+Xen_wrap_1_arg(gxm_XmTextRemove_w, gxm_XmTextRemove)
+Xen_wrap_2_args(gxm_XmTextCopy_w, gxm_XmTextCopy)
+Xen_wrap_2_args(gxm_XmTextCut_w, gxm_XmTextCut)
+Xen_wrap_1_arg(gxm_XmTextPaste_w, gxm_XmTextPaste)
+Xen_wrap_1_arg(gxm_XmTextGetSelection_w, gxm_XmTextGetSelection)
+Xen_wrap_4_args(gxm_XmTextSetSelection_w, gxm_XmTextSetSelection)
+Xen_wrap_2_args(gxm_XmTextClearSelection_w, gxm_XmTextClearSelection)
+Xen_wrap_1_arg(gxm_XmTextGetSelectionPosition_w, gxm_XmTextGetSelectionPosition)
+Xen_wrap_3_args(gxm_XmTextXYToPos_w, gxm_XmTextXYToPos)
+Xen_wrap_2_args(gxm_XmTextPosToXY_w, gxm_XmTextPosToXY)
+Xen_wrap_1_arg(gxm_XmTextGetSource_w, gxm_XmTextGetSource)
+Xen_wrap_4_args(gxm_XmTextSetSource_w, gxm_XmTextSetSource)
+Xen_wrap_2_args(gxm_XmTextShowPosition_w, gxm_XmTextShowPosition)
+Xen_wrap_2_args(gxm_XmTextScroll_w, gxm_XmTextScroll)
+Xen_wrap_1_arg(gxm_XmTextGetBaseline_w, gxm_XmTextGetBaseline)
+Xen_wrap_1_arg(gxm_XmTextDisableRedisplay_w, gxm_XmTextDisableRedisplay)
+Xen_wrap_1_arg(gxm_XmTextEnableRedisplay_w, gxm_XmTextEnableRedisplay)
+Xen_wrap_4_args(gxm_XmTextFindString_w, gxm_XmTextFindString)
+Xen_wrap_4_optional_args(gxm_XmCreateForm_w, gxm_XmCreateForm)
+Xen_wrap_4_optional_args(gxm_XmCreateFormDialog_w, gxm_XmCreateFormDialog)
+Xen_wrap_4_optional_args(gxm_XmCreateFrame_w, gxm_XmCreateFrame)
+Xen_wrap_1_arg(gxm_XmToggleButtonGadgetGetState_w, gxm_XmToggleButtonGadgetGetState)
+Xen_wrap_3_args(gxm_XmToggleButtonGadgetSetState_w, gxm_XmToggleButtonGadgetSetState)
+Xen_wrap_4_optional_args(gxm_XmCreateToggleButtonGadget_w, gxm_XmCreateToggleButtonGadget)
+Xen_wrap_1_arg(gxm_XmToggleButtonGetState_w, gxm_XmToggleButtonGetState)
+Xen_wrap_3_args(gxm_XmToggleButtonSetState_w, gxm_XmToggleButtonSetState)
+Xen_wrap_4_optional_args(gxm_XmCreateToggleButton_w, gxm_XmCreateToggleButton)
+Xen_wrap_4_optional_args(gxm_XmCreateLabelGadget_w, gxm_XmCreateLabelGadget)
+Xen_wrap_4_optional_args(gxm_XmCreateLabel_w, gxm_XmCreateLabel)
+Xen_wrap_1_arg(gxm_XmIsMotifWMRunning_w, gxm_XmIsMotifWMRunning)
+Xen_wrap_3_args(gxm_XmListAddItem_w, gxm_XmListAddItem)
+Xen_wrap_4_args(gxm_XmListAddItems_w, gxm_XmListAddItems)
+Xen_wrap_4_args(gxm_XmListAddItemsUnselected_w, gxm_XmListAddItemsUnselected)
+Xen_wrap_3_args(gxm_XmListAddItemUnselected_w, gxm_XmListAddItemUnselected)
+Xen_wrap_2_args(gxm_XmListDeleteItem_w, gxm_XmListDeleteItem)
+Xen_wrap_3_optional_args(gxm_XmListDeleteItems_w, gxm_XmListDeleteItems)
+Xen_wrap_3_optional_args(gxm_XmListDeletePositions_w, gxm_XmListDeletePositions)
+Xen_wrap_2_args(gxm_XmListDeletePos_w, gxm_XmListDeletePos)
+Xen_wrap_3_args(gxm_XmListDeleteItemsPos_w, gxm_XmListDeleteItemsPos)
+Xen_wrap_1_arg(gxm_XmListDeleteAllItems_w, gxm_XmListDeleteAllItems)
+Xen_wrap_4_args(gxm_XmListReplaceItems_w, gxm_XmListReplaceItems)
+Xen_wrap_4_args(gxm_XmListReplaceItemsPos_w, gxm_XmListReplaceItemsPos)
+Xen_wrap_4_args(gxm_XmListReplaceItemsUnselected_w, gxm_XmListReplaceItemsUnselected)
+Xen_wrap_4_args(gxm_XmListReplaceItemsPosUnselected_w, gxm_XmListReplaceItemsPosUnselected)
+Xen_wrap_4_args(gxm_XmListReplacePositions_w, gxm_XmListReplacePositions)
+Xen_wrap_3_args(gxm_XmListSelectItem_w, gxm_XmListSelectItem)
+Xen_wrap_3_args(gxm_XmListSelectPos_w, gxm_XmListSelectPos)
+Xen_wrap_2_args(gxm_XmListDeselectItem_w, gxm_XmListDeselectItem)
+Xen_wrap_2_args(gxm_XmListDeselectPos_w, gxm_XmListDeselectPos)
+Xen_wrap_1_arg(gxm_XmListDeselectAllItems_w, gxm_XmListDeselectAllItems)
+Xen_wrap_2_args(gxm_XmListSetPos_w, gxm_XmListSetPos)
+Xen_wrap_2_args(gxm_XmListSetBottomPos_w, gxm_XmListSetBottomPos)
+Xen_wrap_2_args(gxm_XmListSetItem_w, gxm_XmListSetItem)
+Xen_wrap_2_args(gxm_XmListSetBottomItem_w, gxm_XmListSetBottomItem)
+Xen_wrap_2_args(gxm_XmListSetAddMode_w, gxm_XmListSetAddMode)
+Xen_wrap_2_args(gxm_XmListItemExists_w, gxm_XmListItemExists)
+Xen_wrap_2_args(gxm_XmListItemPos_w, gxm_XmListItemPos)
+Xen_wrap_1_arg(gxm_XmListGetKbdItemPos_w, gxm_XmListGetKbdItemPos)
+Xen_wrap_2_args(gxm_XmListSetKbdItemPos_w, gxm_XmListSetKbdItemPos)
+Xen_wrap_2_args(gxm_XmListYToPos_w, gxm_XmListYToPos)
+Xen_wrap_2_args(gxm_XmListPosToBounds_w, gxm_XmListPosToBounds)
+Xen_wrap_2_args(gxm_XmListGetMatchPos_w, gxm_XmListGetMatchPos)
+Xen_wrap_2_args(gxm_XmListSetHorizPos_w, gxm_XmListSetHorizPos)
+Xen_wrap_1_arg(gxm_XmListUpdateSelectedList_w, gxm_XmListUpdateSelectedList)
+Xen_wrap_2_args(gxm_XmListPosSelected_w, gxm_XmListPosSelected)
+Xen_wrap_4_optional_args(gxm_XmCreateList_w, gxm_XmCreateList)
+Xen_wrap_4_optional_args(gxm_XmCreateScrolledList_w, gxm_XmCreateScrolledList)
+Xen_wrap_3_args(gxm_XmTranslateKey_w, gxm_XmTranslateKey)
+Xen_wrap_4_optional_args(gxm_XmCreateMainWindow_w, gxm_XmCreateMainWindow)
+Xen_wrap_2_args(gxm_XmInstallImage_w, gxm_XmInstallImage)
+Xen_wrap_1_arg(gxm_XmUninstallImage_w, gxm_XmUninstallImage)
+Xen_wrap_4_args(gxm_XmGetPixmap_w, gxm_XmGetPixmap)
+Xen_wrap_5_args(gxm_XmGetPixmapByDepth_w, gxm_XmGetPixmapByDepth)
+Xen_wrap_2_args(gxm_XmDestroyPixmap_w, gxm_XmDestroyPixmap)
+Xen_wrap_1_arg(gxm_XmUpdateDisplay_w, gxm_XmUpdateDisplay)
+Xen_wrap_1_arg(gxm_XmWidgetGetBaselines_w, gxm_XmWidgetGetBaselines)
+Xen_wrap_2_args(gxm_XmRegisterSegmentEncoding_w, gxm_XmRegisterSegmentEncoding)
+Xen_wrap_1_arg(gxm_XmMapSegmentEncoding_w, gxm_XmMapSegmentEncoding)
+Xen_wrap_1_arg(gxm_XmCvtCTToXmString_w, gxm_XmCvtCTToXmString)
+Xen_wrap_1_arg(gxm_XmCvtXmStringToCT_w, gxm_XmCvtXmStringToCT)
+Xen_wrap_5_args(gxm_XmConvertUnits_w, gxm_XmConvertUnits)
+Xen_wrap_4_optional_args(gxm_XmCreateSimpleMenuBar_w, gxm_XmCreateSimpleMenuBar)
+Xen_wrap_4_optional_args(gxm_XmCreateSimplePopupMenu_w, gxm_XmCreateSimplePopupMenu)
+Xen_wrap_4_optional_args(gxm_XmCreateSimplePulldownMenu_w, gxm_XmCreateSimplePulldownMenu)
+Xen_wrap_4_optional_args(gxm_XmCreateSimpleOptionMenu_w, gxm_XmCreateSimpleOptionMenu)
+Xen_wrap_4_optional_args(gxm_XmCreateSimpleRadioBox_w, gxm_XmCreateSimpleRadioBox)
+Xen_wrap_4_optional_args(gxm_XmCreateSimpleCheckBox_w, gxm_XmCreateSimpleCheckBox)
+Xen_wrap_3_args(gxm_XmVaCreateSimpleMenuBar_w, gxm_XmVaCreateSimpleMenuBar)
+Xen_wrap_4_args(gxm_XmVaCreateSimplePopupMenu_w, gxm_XmVaCreateSimplePopupMenu)
+Xen_wrap_5_args(gxm_XmVaCreateSimplePulldownMenu_w, gxm_XmVaCreateSimplePulldownMenu)
+Xen_wrap_7_args(gxm_XmVaCreateSimpleOptionMenu_w, gxm_XmVaCreateSimpleOptionMenu)
+Xen_wrap_5_args(gxm_XmVaCreateSimpleRadioBox_w, gxm_XmVaCreateSimpleRadioBox)
+Xen_wrap_4_args(gxm_XmVaCreateSimpleCheckBox_w, gxm_XmVaCreateSimpleCheckBox)
+Xen_wrap_3_args(gxm_XmTrackingEvent_w, gxm_XmTrackingEvent)
+Xen_wrap_1_arg(gxm_XmSetColorCalculation_w, gxm_XmSetColorCalculation)
+Xen_wrap_no_args(gxm_XmGetColorCalculation_w, gxm_XmGetColorCalculation)
+Xen_wrap_3_args(gxm_XmGetColors_w, gxm_XmGetColors)
+Xen_wrap_2_args(gxm_XmChangeColor_w, gxm_XmChangeColor)
+Xen_wrap_2_args(gxm_XmStringCreate_w, gxm_XmStringCreate)
+Xen_wrap_1_arg(gxm_XmStringCreateLocalized_w, gxm_XmStringCreateLocalized)
+Xen_wrap_1_arg(gxm_XmStringDirectionCreate_w, gxm_XmStringDirectionCreate)
+Xen_wrap_no_args(gxm_XmStringSeparatorCreate_w, gxm_XmStringSeparatorCreate)
+Xen_wrap_1_arg(gxm_XmStringInitContext_w, gxm_XmStringInitContext)
+Xen_wrap_1_arg(gxm_XmStringFreeContext_w, gxm_XmStringFreeContext)
+Xen_wrap_2_args(gxm_XmStringConcatAndFree_w, gxm_XmStringConcatAndFree)
+Xen_wrap_1_arg(gxm_XmStringIsVoid_w, gxm_XmStringIsVoid)
+Xen_wrap_1_arg(gxm_XmStringPeekNextTriple_w, gxm_XmStringPeekNextTriple)
+Xen_wrap_1_arg(gxm_XmStringGetNextTriple_w, gxm_XmStringGetNextTriple)
+Xen_wrap_3_args(gxm_XmStringComponentCreate_w, gxm_XmStringComponentCreate)
+Xen_wrap_7_args(gxm_XmStringUnparse_w, gxm_XmStringUnparse)
+Xen_wrap_7_args(gxm_XmStringParseText_w, gxm_XmStringParseText)
+Xen_wrap_2_args(gxm_XmStringToXmStringTable_w, gxm_XmStringToXmStringTable)
+Xen_wrap_3_args(gxm_XmStringTableToXmString_w, gxm_XmStringTableToXmString)
+Xen_wrap_8_args(gxm_XmStringTableUnparse_w, gxm_XmStringTableUnparse)
+Xen_wrap_7_args(gxm_XmStringTableParseStringArray_w, gxm_XmStringTableParseStringArray)
+Xen_wrap_1_arg(gxm_XmDirectionToStringDirection_w, gxm_XmDirectionToStringDirection)
+Xen_wrap_1_arg(gxm_XmStringDirectionToDirection_w, gxm_XmStringDirectionToDirection)
+Xen_wrap_4_args(gxm_XmStringGenerate_w, gxm_XmStringGenerate)
+Xen_wrap_2_args(gxm_XmStringPutRendition_w, gxm_XmStringPutRendition)
+Xen_wrap_2_optional_args(gxm_XmParseMappingCreate_w, gxm_XmParseMappingCreate)
+Xen_wrap_3_optional_args(gxm_XmParseMappingSetValues_w, gxm_XmParseMappingSetValues)
+Xen_wrap_3_optional_args(gxm_XmParseMappingGetValues_w, gxm_XmParseMappingGetValues)
+Xen_wrap_1_arg(gxm_XmParseMappingFree_w, gxm_XmParseMappingFree)
+Xen_wrap_2_optional_args(gxm_XmParseTableFree_w, gxm_XmParseTableFree)
+Xen_wrap_5_args(gxm_XmStringTableProposeTablist_w, gxm_XmStringTableProposeTablist)
+Xen_wrap_2_args(gxm_XmTabSetValue_w, gxm_XmTabSetValue)
+Xen_wrap_1_arg(gxm_XmTabGetValues_w, gxm_XmTabGetValues)
+Xen_wrap_1_arg(gxm_XmTabFree_w, gxm_XmTabFree)
+Xen_wrap_1_arg(gxm_XmTabListFree_w, gxm_XmTabListFree)
+Xen_wrap_5_args(gxm_XmTabCreate_w, gxm_XmTabCreate)
+Xen_wrap_1_arg(gxm_XmTabListTabCount_w, gxm_XmTabListTabCount)
+Xen_wrap_3_optional_args(gxm_XmTabListRemoveTabs_w, gxm_XmTabListRemoveTabs)
+Xen_wrap_4_optional_args(gxm_XmTabListReplacePositions_w, gxm_XmTabListReplacePositions)
+Xen_wrap_2_args(gxm_XmTabListGetTab_w, gxm_XmTabListGetTab)
+Xen_wrap_3_args(gxm_XmTabListCopy_w, gxm_XmTabListCopy)
+Xen_wrap_4_args(gxm_XmTabListInsertTabs_w, gxm_XmTabListInsertTabs)
+Xen_wrap_3_args(gxm_XmRenderTableCvtFromProp_w, gxm_XmRenderTableCvtFromProp)
+Xen_wrap_2_args(gxm_XmRenderTableCvtToProp_w, gxm_XmRenderTableCvtToProp)
+Xen_wrap_3_optional_args(gxm_XmRenditionUpdate_w, gxm_XmRenditionUpdate)
+Xen_wrap_3_optional_args(gxm_XmRenditionRetrieve_w, gxm_XmRenditionRetrieve)
+Xen_wrap_1_arg(gxm_XmRenditionFree_w, gxm_XmRenditionFree)
+Xen_wrap_4_optional_args(gxm_XmRenditionCreate_w, gxm_XmRenditionCreate)
+Xen_wrap_3_optional_args(gxm_XmRenderTableGetRenditions_w, gxm_XmRenderTableGetRenditions)
+Xen_wrap_2_args(gxm_XmRenderTableGetRendition_w, gxm_XmRenderTableGetRendition)
+Xen_wrap_1_arg(gxm_XmRenderTableGetTags_w, gxm_XmRenderTableGetTags)
+Xen_wrap_1_arg(gxm_XmRenderTableFree_w, gxm_XmRenderTableFree)
+Xen_wrap_3_optional_args(gxm_XmRenderTableCopy_w, gxm_XmRenderTableCopy)
+Xen_wrap_3_optional_args(gxm_XmRenderTableRemoveRenditions_w, gxm_XmRenderTableRemoveRenditions)
+Xen_wrap_4_args(gxm_XmRenderTableAddRenditions_w, gxm_XmRenderTableAddRenditions)
+Xen_wrap_2_args(gxm_XmStringConcat_w, gxm_XmStringConcat)
+Xen_wrap_1_arg(gxm_XmStringCopy_w, gxm_XmStringCopy)
+Xen_wrap_2_args(gxm_XmStringCompare_w, gxm_XmStringCompare)
+Xen_wrap_1_arg(gxm_XmStringEmpty_w, gxm_XmStringEmpty)
+Xen_wrap_2_args(gxm_XmStringHasSubstring_w, gxm_XmStringHasSubstring)
+Xen_wrap_1_arg(gxm_XmStringFree_w, gxm_XmStringFree)
+Xen_wrap_2_args(gxm_XmStringBaseline_w, gxm_XmStringBaseline)
+Xen_wrap_2_args(gxm_XmStringWidth_w, gxm_XmStringWidth)
+Xen_wrap_2_args(gxm_XmStringHeight_w, gxm_XmStringHeight)
+Xen_wrap_2_args(gxm_XmStringExtent_w, gxm_XmStringExtent)
+Xen_wrap_1_arg(gxm_XmStringLineCount_w, gxm_XmStringLineCount)
+Xen_wrap_any_args(gxm_XmStringDraw_w, gxm_XmStringDraw)
+Xen_wrap_any_args(gxm_XmStringDrawImage_w, gxm_XmStringDrawImage)
+Xen_wrap_any_args(gxm_XmStringDrawUnderline_w, gxm_XmStringDrawUnderline)
+
+Xen_wrap_1_arg(gxm_XmGetDestination_w, gxm_XmGetDestination)
+Xen_wrap_1_arg(gxm_XmIsTraversable_w, gxm_XmIsTraversable)
+Xen_wrap_1_arg(gxm_XmGetVisibility_w, gxm_XmGetVisibility)
+Xen_wrap_1_arg(gxm_XmGetTabGroup_w, gxm_XmGetTabGroup)
+Xen_wrap_1_arg(gxm_XmGetFocusWidget_w, gxm_XmGetFocusWidget)
+Xen_wrap_2_args(gxm_XmProcessTraversal_w, gxm_XmProcessTraversal)
+Xen_wrap_4_optional_args(gxm_XmCreateMenuShell_w, gxm_XmCreateMenuShell)
+
+Xen_wrap_1_arg(gxm_XmIsMessageBox_w, gxm_XmIsMessageBox)
+Xen_wrap_1_arg(gxm_XmIsArrowButtonGadget_w, gxm_XmIsArrowButtonGadget)
+Xen_wrap_1_arg(gxm_XmIsArrowButton_w, gxm_XmIsArrowButton)
+Xen_wrap_1_arg(gxm_XmCvtXmStringToByteStream_w, gxm_XmCvtXmStringToByteStream)
+Xen_wrap_1_arg(gxm_XmCvtByteStreamToXmString_w, gxm_XmCvtByteStreamToXmString)
+Xen_wrap_1_arg(gxm_XmStringByteStreamLength_w, gxm_XmStringByteStreamLength)
+Xen_wrap_1_arg(gxm_XmIsNotebook_w, gxm_XmIsNotebook)
+Xen_wrap_1_arg(gxm_XmIsComboBox_w, gxm_XmIsComboBox)
+Xen_wrap_1_arg(gxm_XmIsContainer_w, gxm_XmIsContainer)
+Xen_wrap_1_arg(gxm_XmIsGrabShell_w, gxm_XmIsGrabShell)
+Xen_wrap_1_arg(gxm_XmIsIconGadget_w, gxm_XmIsIconGadget)
+Xen_wrap_1_arg(gxm_XmIsIconHeader_w, gxm_XmIsIconHeader)
+Xen_wrap_1_arg(gxm_XmIsPanedWindow_w, gxm_XmIsPanedWindow)
+Xen_wrap_1_arg(gxm_XmIsBulletinBoard_w, gxm_XmIsBulletinBoard)
+Xen_wrap_1_arg(gxm_XmIsPrimitive_w, gxm_XmIsPrimitive)
+Xen_wrap_1_arg(gxm_XmIsCascadeButtonGadget_w, gxm_XmIsCascadeButtonGadget)
+Xen_wrap_1_arg(gxm_XmIsCascadeButton_w, gxm_XmIsCascadeButton)
+Xen_wrap_1_arg(gxm_XmIsPushButtonGadget_w, gxm_XmIsPushButtonGadget)
+Xen_wrap_1_arg(gxm_XmIsPushButton_w, gxm_XmIsPushButton)
+Xen_wrap_1_arg(gxm_XmIsCommand_w, gxm_XmIsCommand)
+Xen_wrap_1_arg(gxm_XmIsRowColumn_w, gxm_XmIsRowColumn)
+Xen_wrap_1_arg(gxm_XmIsScale_w, gxm_XmIsScale)
+Xen_wrap_1_arg(gxm_XmIsScreen_w, gxm_XmIsScreen)
+Xen_wrap_1_arg(gxm_XmIsScrollBar_w, gxm_XmIsScrollBar)
+Xen_wrap_1_arg(gxm_XmIsDialogShell_w, gxm_XmIsDialogShell)
+Xen_wrap_1_arg(gxm_XmIsScrolledWindow_w, gxm_XmIsScrolledWindow)
+Xen_wrap_1_arg(gxm_XmIsDisplay_w, gxm_XmIsDisplay)
+Xen_wrap_1_arg(gxm_XmIsSelectionBox_w, gxm_XmIsSelectionBox)
+Xen_wrap_1_arg(gxm_XmIsDragContext_w, gxm_XmIsDragContext)
+Xen_wrap_1_arg(gxm_XmIsSeparatorGadget_w, gxm_XmIsSeparatorGadget)
+Xen_wrap_1_arg(gxm_XmIsDragIconObjectClass_w, gxm_XmIsDragIconObjectClass)
+Xen_wrap_1_arg(gxm_XmIsSeparator_w, gxm_XmIsSeparator)
+Xen_wrap_1_arg(gxm_XmIsDrawingArea_w, gxm_XmIsDrawingArea)
+Xen_wrap_1_arg(gxm_XmIsDrawnButton_w, gxm_XmIsDrawnButton)
+Xen_wrap_1_arg(gxm_XmIsDropSiteManager_w, gxm_XmIsDropSiteManager)
+Xen_wrap_1_arg(gxm_XmIsDropTransfer_w, gxm_XmIsDropTransfer)
+Xen_wrap_1_arg(gxm_XmIsTextField_w, gxm_XmIsTextField)
+Xen_wrap_1_arg(gxm_XmIsFileSelectionBox_w, gxm_XmIsFileSelectionBox)
+Xen_wrap_1_arg(gxm_XmIsText_w, gxm_XmIsText)
+Xen_wrap_1_arg(gxm_XmIsForm_w, gxm_XmIsForm)
+Xen_wrap_1_arg(gxm_XmIsFrame_w, gxm_XmIsFrame)
+Xen_wrap_1_arg(gxm_XmIsGadget_w, gxm_XmIsGadget)
+Xen_wrap_1_arg(gxm_XmIsToggleButtonGadget_w, gxm_XmIsToggleButtonGadget)
+Xen_wrap_1_arg(gxm_XmIsToggleButton_w, gxm_XmIsToggleButton)
+Xen_wrap_1_arg(gxm_XmIsLabelGadget_w, gxm_XmIsLabelGadget)
+Xen_wrap_1_arg(gxm_XmIsLabel_w, gxm_XmIsLabel)
+Xen_wrap_1_arg(gxm_XmIsVendorShell_w, gxm_XmIsVendorShell)
+Xen_wrap_1_arg(gxm_XmIsList_w, gxm_XmIsList)
+Xen_wrap_1_arg(gxm_XmIsMainWindow_w, gxm_XmIsMainWindow)
+Xen_wrap_1_arg(gxm_XmIsManager_w, gxm_XmIsManager)
+Xen_wrap_1_arg(gxm_XmIsMenuShell_w, gxm_XmIsMenuShell)
+Xen_wrap_1_arg(gxm_XmListGetSelectedPos_w, gxm_XmListGetSelectedPos)
+Xen_wrap_1_arg(gxm_XmWidgetGetDisplayRect_w, gxm_XmWidgetGetDisplayRect)
+
+Xen_wrap_4_args(gxm_XpmCreatePixmapFromData_w, gxm_XpmCreatePixmapFromData)
+Xen_wrap_4_args(gxm_XpmCreateDataFromPixmap_w, gxm_XpmCreateDataFromPixmap)
+Xen_wrap_4_args(gxm_XpmReadFileToPixmap_w, gxm_XpmReadFileToPixmap)
+Xen_wrap_1_arg(gxm_XpmReadFileToXpmImage_w, gxm_XpmReadFileToXpmImage)
+Xen_wrap_5_args(gxm_XpmWriteFileFromPixmap_w, gxm_XpmWriteFileFromPixmap)
+Xen_wrap_4_args(gxm_XpmCreatePixmapFromXpmImage_w, gxm_XpmCreatePixmapFromXpmImage)
+Xen_wrap_4_args(gxm_XpmCreateXpmImageFromPixmap_w, gxm_XpmCreateXpmImageFromPixmap)
+Xen_wrap_1_arg(gxm_XpmGetErrorString_w, gxm_XpmGetErrorString)
+
+Xen_wrap_3_args(gxm_XGetPixel_w, gxm_XGetPixel)
+Xen_wrap_1_arg(gxm_XDestroyImage_w, gxm_XDestroyImage)
+Xen_wrap_4_args(gxm_XPutPixel_w, gxm_XPutPixel)
+Xen_wrap_5_args(gxm_XSubImage_w, gxm_XSubImage)
+Xen_wrap_2_args(gxm_XAddPixel_w, gxm_XAddPixel)
+
+Xen_wrap_1_arg(g_is_XtAppContext_w, g_is_XtAppContext)
+Xen_wrap_1_arg(g_is_XtRequestId_w, g_is_XtRequestId)
+Xen_wrap_1_arg(g_is_XtWorkProcId_w, g_is_XtWorkProcId)
+Xen_wrap_1_arg(g_is_XtInputId_w, g_is_XtInputId)
+Xen_wrap_1_arg(g_is_XtIntervalId_w, g_is_XtIntervalId)
+
+Xen_wrap_1_arg(g_is_Screen_w, g_is_Screen)
+Xen_wrap_1_arg(g_is_XEvent_w, g_is_XEvent)
+Xen_wrap_1_arg(g_is_XRectangle_w, g_is_XRectangle)
+Xen_wrap_1_arg(g_is_XArc_w, g_is_XArc)
+Xen_wrap_1_arg(g_is_XPoint_w, g_is_XPoint)
+Xen_wrap_1_arg(g_is_XSegment_w, g_is_XSegment)
+Xen_wrap_1_arg(g_is_XColor_w, g_is_XColor)
+Xen_wrap_1_arg(g_is_Atom_w, g_is_Atom)
+Xen_wrap_1_arg(g_is_Colormap_w, g_is_Colormap)
+Xen_wrap_1_arg(g_is_XModifierKeymap_w, g_is_XModifierKeymap)
+Xen_wrap_1_arg(g_is_Depth_w, g_is_Depth)
+Xen_wrap_1_arg(g_is_Display_w, g_is_Display)
+Xen_wrap_1_arg(g_is_Font_w, g_is_Font)
+Xen_wrap_1_arg(g_is_GC_w, g_is_GC)
+Xen_wrap_1_arg(g_is_KeySym_w, g_is_KeySym)
+Xen_wrap_1_arg(g_is_Pixel_w, g_is_Pixel)
+Xen_wrap_1_arg(g_is_Pixmap_w, g_is_Pixmap)
+Xen_wrap_1_arg(g_is_Region_w, g_is_Region)
+Xen_wrap_1_arg(g_is_Time_w, g_is_Time)
+Xen_wrap_1_arg(g_is_Visual_w, g_is_Visual)
+Xen_wrap_1_arg(g_is_Window_w, g_is_Window)
+Xen_wrap_1_arg(g_is_Widget_w, g_is_Widget)
+Xen_wrap_1_arg(g_is_XmStringContext_w, g_is_XmStringContext)
+Xen_wrap_1_arg(g_is_XFontProp_w, g_is_XFontProp)
+Xen_wrap_1_arg(g_is_XFontSet_w, g_is_XFontSet)
+Xen_wrap_1_arg(g_is_XFontStruct_w, g_is_XFontStruct)
+Xen_wrap_1_arg(g_is_XGCValues_w, g_is_XGCValues)
+Xen_wrap_1_arg(g_is_XImage_w, g_is_XImage)
+Xen_wrap_1_arg(g_is_XVisualInfo_w, g_is_XVisualInfo)
+Xen_wrap_1_arg(g_is_XWMHints_w, g_is_XWMHints)
+Xen_wrap_1_arg(g_is_XWindowAttributes_w, g_is_XWindowAttributes)
+Xen_wrap_1_arg(g_is_XWindowChanges_w, g_is_XWindowChanges)
+Xen_wrap_1_arg(g_is_KeyCode_w, g_is_KeyCode)
+Xen_wrap_1_arg(g_is_XContext_w, g_is_XContext)
+Xen_wrap_1_arg(g_is_XCharStruct_w, g_is_XCharStruct)
+Xen_wrap_1_arg(g_is_XTextItem_w, g_is_XTextItem)
+Xen_wrap_1_arg(g_is_XStandardColormap_w, g_is_XStandardColormap)
+Xen_wrap_1_arg(g_is_Cursor_w, g_is_Cursor)
+Xen_wrap_1_arg(g_is_WidgetClass_w, g_is_WidgetClass)
+Xen_wrap_1_arg(g_is_XmString_w, g_is_XmString)
+Xen_wrap_1_arg(g_is_XmTab_w, g_is_XmTab)
+Xen_wrap_1_arg(g_is_XmRendition_w, g_is_XmRendition)
+Xen_wrap_1_arg(g_is_XmRenderTable_w, g_is_XmRenderTable)
+Xen_wrap_1_arg(g_is_XmTabList_w, g_is_XmTabList)
+Xen_wrap_1_arg(g_is_XmParseMapping_w, g_is_XmParseMapping)
+Xen_wrap_1_arg(g_is_XmTextSource_w, g_is_XmTextSource)
+
+Xen_wrap_1_arg(g_is_XpmAttributes_w, g_is_XpmAttributes)
+Xen_wrap_1_arg(g_is_XpmImage_w, g_is_XpmImage)
+Xen_wrap_1_arg(g_is_XpmColorSymbol_w, g_is_XpmColorSymbol)
+
+#if WITH_EDITRES
+Xen_wrap_4_args(gxm_XEditResCheckMessages_w, gxm_XEditResCheckMessages)
#endif
#if HAVE_XSHAPEQUERYEXTENSION
- #define gxm_XShapeQueryExtension_w gxm_XShapeQueryExtension
- #define gxm_XShapeQueryVersion_w gxm_XShapeQueryVersion
- #define gxm_XShapeQueryExtents_w gxm_XShapeQueryExtents
- #define gxm_XShapeGetRectangles_w gxm_XShapeGetRectangles
- #define gxm_XShapeOffsetShape_w gxm_XShapeOffsetShape
- #define gxm_XShapeCombineRegion_w gxm_XShapeCombineRegion
- #define gxm_XShapeCombineMask_w gxm_XShapeCombineMask
- #define gxm_XShapeCombineShape_w gxm_XShapeCombineShape
- #define gxm_XShapeCombineRectangles_w gxm_XShapeCombineRectangles
+Xen_wrap_1_arg(gxm_XShapeQueryExtension_w, gxm_XShapeQueryExtension)
+Xen_wrap_1_arg(gxm_XShapeQueryVersion_w, gxm_XShapeQueryVersion)
+Xen_wrap_2_args(gxm_XShapeQueryExtents_w, gxm_XShapeQueryExtents)
+Xen_wrap_3_args(gxm_XShapeGetRectangles_w, gxm_XShapeGetRectangles)
+Xen_wrap_5_args(gxm_XShapeOffsetShape_w, gxm_XShapeOffsetShape)
+Xen_wrap_7_args(gxm_XShapeCombineRegion_w, gxm_XShapeCombineRegion)
+Xen_wrap_7_args(gxm_XShapeCombineMask_w, gxm_XShapeCombineMask)
+Xen_wrap_8_args(gxm_XShapeCombineShape_w, gxm_XShapeCombineShape)
+Xen_wrap_9_args(gxm_XShapeCombineRectangles_w, gxm_XShapeCombineRectangles)
#endif
- #define gxm_XSegment_w gxm_XSegment
- #define gxm_XRectangle_w gxm_XRectangle
- #define gxm_XColor_w gxm_XColor
- #define gxm_XArc_w gxm_XArc
- #define gxm_XWindowChanges_w gxm_XWindowChanges
- #define gxm_XSetWindowAttributes_w gxm_XSetWindowAttributes
- #define gxm_XPoint_w gxm_XPoint
- #define gxm_XTextItem_w gxm_XTextItem
- #define gxm_pixel_w gxm_pixel
- #define gxm_set_pixel_w gxm_set_pixel
- #define gxm_red_w gxm_red
- #define gxm_set_red_w gxm_set_red
- #define gxm_green_w gxm_green
- #define gxm_set_green_w gxm_set_green
- #define gxm_blue_w gxm_blue
- #define gxm_set_blue_w gxm_set_blue
- #define gxm_flags_w gxm_flags
- #define gxm_set_flags_w gxm_set_flags
- #define gxm_pad_w gxm_pad
- #define gxm_set_pad_w gxm_set_pad
- #define gxm_x_w gxm_x
- #define gxm_set_x_w gxm_set_x
- #define gxm_y_w gxm_y
- #define gxm_set_y_w gxm_set_y
- #define gxm_width_w gxm_width
- #define gxm_set_width_w gxm_set_width
- #define gxm_height_w gxm_height
- #define gxm_set_height_w gxm_set_height
- #define gxm_angle1_w gxm_angle1
- #define gxm_set_angle1_w gxm_set_angle1
- #define gxm_angle2_w gxm_angle2
- #define gxm_set_angle2_w gxm_set_angle2
- #define gxm_x1_w gxm_x1
- #define gxm_set_x1_w gxm_set_x1
- #define gxm_y1_w gxm_y1
- #define gxm_set_y1_w gxm_set_y1
- #define gxm_x2_w gxm_x2
- #define gxm_set_x2_w gxm_set_x2
- #define gxm_y2_w gxm_y2
- #define gxm_set_y2_w gxm_set_y2
- #define gxm_dashes_w gxm_dashes
- #define gxm_set_dashes_w gxm_set_dashes
- #define gxm_dash_offset_w gxm_dash_offset
- #define gxm_set_dash_offset_w gxm_set_dash_offset
- #define gxm_clip_mask_w gxm_clip_mask
- #define gxm_set_clip_mask_w gxm_set_clip_mask
- #define gxm_clip_y_origin_w gxm_clip_y_origin
- #define gxm_set_clip_y_origin_w gxm_set_clip_y_origin
- #define gxm_clip_x_origin_w gxm_clip_x_origin
- #define gxm_set_clip_x_origin_w gxm_set_clip_x_origin
- #define gxm_graphics_exposures_w gxm_graphics_exposures
- #define gxm_set_graphics_exposures_w gxm_set_graphics_exposures
- #define gxm_subwindow_mode_w gxm_subwindow_mode
- #define gxm_set_subwindow_mode_w gxm_set_subwindow_mode
- #define gxm_font_w gxm_font
- #define gxm_set_font_w gxm_set_font
- #define gxm_ts_y_origin_w gxm_ts_y_origin
- #define gxm_set_ts_y_origin_w gxm_set_ts_y_origin
- #define gxm_ts_x_origin_w gxm_ts_x_origin
- #define gxm_set_ts_x_origin_w gxm_set_ts_x_origin
- #define gxm_stipple_w gxm_stipple
- #define gxm_set_stipple_w gxm_set_stipple
- #define gxm_tile_w gxm_tile
- #define gxm_set_tile_w gxm_set_tile
- #define gxm_arc_mode_w gxm_arc_mode
- #define gxm_set_arc_mode_w gxm_set_arc_mode
- #define gxm_fill_rule_w gxm_fill_rule
- #define gxm_set_fill_rule_w gxm_set_fill_rule
- #define gxm_fill_style_w gxm_fill_style
- #define gxm_set_fill_style_w gxm_set_fill_style
- #define gxm_join_style_w gxm_join_style
- #define gxm_set_join_style_w gxm_set_join_style
- #define gxm_cap_style_w gxm_cap_style
- #define gxm_set_cap_style_w gxm_set_cap_style
- #define gxm_line_style_w gxm_line_style
- #define gxm_set_line_style_w gxm_set_line_style
- #define gxm_line_width_w gxm_line_width
- #define gxm_set_line_width_w gxm_set_line_width
- #define gxm_background_w gxm_background
- #define gxm_set_background_w gxm_set_background
- #define gxm_foreground_w gxm_foreground
- #define gxm_set_foreground_w gxm_set_foreground
- #define gxm_plane_mask_w gxm_plane_mask
- #define gxm_set_plane_mask_w gxm_set_plane_mask
- #define gxm_function_w gxm_function
- #define gxm_set_function_w gxm_set_function
- #define gxm_delta_w gxm_delta
- #define gxm_set_delta_w gxm_set_delta
- #define gxm_nchars_w gxm_nchars
- #define gxm_set_nchars_w gxm_set_nchars
- #define gxm_chars_w gxm_chars
- #define gxm_set_chars_w gxm_set_chars
- #define gxm_name_w gxm_name
- #define gxm_set_name_w gxm_set_name
- #define gxm_depth_w gxm_depth
- #define gxm_set_depth_w gxm_set_depth
- #define gxm_visual_w gxm_visual
- #define gxm_set_visual_w gxm_set_visual
-
- #define gxm_display_w gxm_display
- #define gxm_root_w gxm_root
- #define gxm_mwidth_w gxm_mwidth
- #define gxm_mheight_w gxm_mheight
- #define gxm_ndepths_w gxm_ndepths
- #define gxm_depths_w gxm_depths
- #define gxm_root_depth_w gxm_root_depth
- #define gxm_root_visual_w gxm_root_visual
- #define gxm_default_gc_w gxm_default_gc
- #define gxm_cmap_w gxm_cmap
- #define gxm_white_pixel_w gxm_white_pixel
- #define gxm_black_pixel_w gxm_black_pixel
- #define gxm_max_maps_w gxm_max_maps
- #define gxm_min_maps_w gxm_min_maps
- #define gxm_backing_store_w gxm_backing_store
- #define gxm_save_unders_w gxm_save_unders
- #define gxm_root_input_mask_w gxm_root_input_mask
- #define gxm_type_w gxm_type
- #define gxm_serial_w gxm_serial
- #define gxm_send_event_w gxm_send_event
- #define gxm_window_w gxm_window
- #define gxm_subwindow_w gxm_subwindow
- #define gxm_time_w gxm_time
- #define gxm_x_root_w gxm_x_root
- #define gxm_y_root_w gxm_y_root
- #define gxm_state_w gxm_state
- #define gxm_keycode_w gxm_keycode
- #define gxm_same_screen_w gxm_same_screen
- #define gxm_button_w gxm_button
- #define gxm_is_hint_w gxm_is_hint
- #define gxm_mode_w gxm_mode
- #define gxm_detail_w gxm_detail
- #define gxm_focus_w gxm_focus
- #define gxm_key_vector_w gxm_key_vector
- #define gxm_count_w gxm_count
- #define gxm_drawable_w gxm_drawable
- #define gxm_major_code_w gxm_major_code
- #define gxm_minor_code_w gxm_minor_code
- #define gxm_parent_w gxm_parent
- #define gxm_border_width_w gxm_border_width
- #define gxm_override_redirect_w gxm_override_redirect
- #define gxm_event_w gxm_event
- #define gxm_from_configure_w gxm_from_configure
- #define gxm_above_w gxm_above
- #define gxm_value_mask_w gxm_value_mask
- #define gxm_place_w gxm_place
- #define gxm_atom_w gxm_atom
- #define gxm_selection_w gxm_selection
- #define gxm_owner_w gxm_owner
- #define gxm_requestor_w gxm_requestor
- #define gxm_target_w gxm_target
- #define gxm_property_w gxm_property
- #define gxm_new_w gxm_new
- #define gxm_message_type_w gxm_message_type
- #define gxm_format_w gxm_format
- #define gxm_request_w gxm_request
- #define gxm_first_keycode_w gxm_first_keycode
- #define gxm_resourceid_w gxm_resourceid
- #define gxm_error_code_w gxm_error_code
- #define gxm_request_code_w gxm_request_code
- #define gxm_lbearing_w gxm_lbearing
- #define gxm_rbearing_w gxm_rbearing
- #define gxm_ascent_w gxm_ascent
- #define gxm_descent_w gxm_descent
- #define gxm_attributes_w gxm_attributes
- #define gxm_card32_w gxm_card32
- #define gxm_fid_w gxm_fid
- #define gxm_properties_w gxm_properties
- #define gxm_min_bounds_w gxm_min_bounds
- #define gxm_max_bounds_w gxm_max_bounds
- #define gxm_per_char_w gxm_per_char
- #define gxm_input_w gxm_input
- #define gxm_initial_state_w gxm_initial_state
- #define gxm_icon_pixmap_w gxm_icon_pixmap
- #define gxm_icon_window_w gxm_icon_window
- #define gxm_icon_x_w gxm_icon_x
- #define gxm_icon_y_w gxm_icon_y
- #define gxm_icon_mask_w gxm_icon_mask
- #define gxm_window_group_w gxm_window_group
- #define gxm_visualid_w gxm_visualid
- #define gxm_class_w gxm_class
- #define gxm_red_mask_w gxm_red_mask
- #define gxm_green_mask_w gxm_green_mask
- #define gxm_blue_mask_w gxm_blue_mask
- #define gxm_bits_per_rgb_w gxm_bits_per_rgb
- #define gxm_map_entries_w gxm_map_entries
- #define gxm_colormap_size_w gxm_colormap_size
- #define gxm_nvisuals_w gxm_nvisuals
- #define gxm_visuals_w gxm_visuals
- #define gxm_bits_per_pixel_w gxm_bits_per_pixel
- #define gxm_background_pixmap_w gxm_background_pixmap
- #define gxm_background_pixel_w gxm_background_pixel
- #define gxm_border_pixmap_w gxm_border_pixmap
- #define gxm_border_pixel_w gxm_border_pixel
- #define gxm_bit_gravity_w gxm_bit_gravity
- #define gxm_win_gravity_w gxm_win_gravity
- #define gxm_backing_planes_w gxm_backing_planes
- #define gxm_backing_pixel_w gxm_backing_pixel
- #define gxm_save_under_w gxm_save_under
- #define gxm_event_mask_w gxm_event_mask
- #define gxm_do_not_propagate_mask_w gxm_do_not_propagate_mask
- #define gxm_cursor_w gxm_cursor
- #define gxm_map_installed_w gxm_map_installed
- #define gxm_map_state_w gxm_map_state
- #define gxm_all_event_masks_w gxm_all_event_masks
- #define gxm_your_event_mask_w gxm_your_event_mask
- #define gxm_screen_w gxm_screen
- #define gxm_xoffset_w gxm_xoffset
- #define gxm_byte_order_w gxm_byte_order
- #define gxm_bitmap_unit_w gxm_bitmap_unit
- #define gxm_bitmap_bit_order_w gxm_bitmap_bit_order
- #define gxm_bitmap_pad_w gxm_bitmap_pad
- #define gxm_bytes_per_line_w gxm_bytes_per_line
- #define gxm_obdata_w gxm_obdata
- #define gxm_sibling_w gxm_sibling
- #define gxm_stack_mode_w gxm_stack_mode
+Xen_wrap_4_args(gxm_XSegment_w, gxm_XSegment)
+Xen_wrap_4_args(gxm_XRectangle_w, gxm_XRectangle)
+Xen_wrap_6_optional_args(gxm_XColor_w, gxm_XColor)
+Xen_wrap_6_args(gxm_XArc_w, gxm_XArc)
+Xen_wrap_7_args(gxm_XWindowChanges_w, gxm_XWindowChanges)
+Xen_wrap_any_args(gxm_XSetWindowAttributes_w, gxm_XSetWindowAttributes)
+Xen_wrap_2_args(gxm_XPoint_w, gxm_XPoint)
+Xen_wrap_4_args(gxm_XTextItem_w, gxm_XTextItem)
+Xen_wrap_1_arg(gxm_pixel_w, gxm_pixel)
+Xen_wrap_2_args(gxm_set_pixel_w, gxm_set_pixel)
+Xen_wrap_1_arg(gxm_red_w, gxm_red)
+Xen_wrap_2_args(gxm_set_red_w, gxm_set_red)
+Xen_wrap_1_arg(gxm_green_w, gxm_green)
+Xen_wrap_2_args(gxm_set_green_w, gxm_set_green)
+Xen_wrap_1_arg(gxm_blue_w, gxm_blue)
+Xen_wrap_2_args(gxm_set_blue_w, gxm_set_blue)
+Xen_wrap_1_arg(gxm_flags_w, gxm_flags)
+Xen_wrap_2_args(gxm_set_flags_w, gxm_set_flags)
+Xen_wrap_1_arg(gxm_pad_w, gxm_pad)
+Xen_wrap_2_args(gxm_set_pad_w, gxm_set_pad)
+Xen_wrap_1_arg(gxm_x_w, gxm_x)
+Xen_wrap_2_args(gxm_set_x_w, gxm_set_x)
+Xen_wrap_1_arg(gxm_y_w, gxm_y)
+Xen_wrap_2_args(gxm_set_y_w, gxm_set_y)
+Xen_wrap_1_arg(gxm_width_w, gxm_width)
+Xen_wrap_2_args(gxm_set_width_w, gxm_set_width)
+Xen_wrap_1_arg(gxm_height_w, gxm_height)
+Xen_wrap_2_args(gxm_set_height_w, gxm_set_height)
+Xen_wrap_1_arg(gxm_angle1_w, gxm_angle1)
+Xen_wrap_2_args(gxm_set_angle1_w, gxm_set_angle1)
+Xen_wrap_1_arg(gxm_angle2_w, gxm_angle2)
+Xen_wrap_2_args(gxm_set_angle2_w, gxm_set_angle2)
+Xen_wrap_1_arg(gxm_x1_w, gxm_x1)
+Xen_wrap_2_args(gxm_set_x1_w, gxm_set_x1)
+Xen_wrap_1_arg(gxm_y1_w, gxm_y1)
+Xen_wrap_2_args(gxm_set_y1_w, gxm_set_y1)
+Xen_wrap_1_arg(gxm_x2_w, gxm_x2)
+Xen_wrap_2_args(gxm_set_x2_w, gxm_set_x2)
+Xen_wrap_1_arg(gxm_y2_w, gxm_y2)
+Xen_wrap_2_args(gxm_set_y2_w, gxm_set_y2)
+Xen_wrap_1_arg(gxm_dashes_w, gxm_dashes)
+Xen_wrap_2_args(gxm_set_dashes_w, gxm_set_dashes)
+Xen_wrap_1_arg(gxm_dash_offset_w, gxm_dash_offset)
+Xen_wrap_2_args(gxm_set_dash_offset_w, gxm_set_dash_offset)
+Xen_wrap_1_arg(gxm_clip_mask_w, gxm_clip_mask)
+Xen_wrap_2_args(gxm_set_clip_mask_w, gxm_set_clip_mask)
+Xen_wrap_1_arg(gxm_clip_y_origin_w, gxm_clip_y_origin)
+Xen_wrap_2_args(gxm_set_clip_y_origin_w, gxm_set_clip_y_origin)
+Xen_wrap_1_arg(gxm_clip_x_origin_w, gxm_clip_x_origin)
+Xen_wrap_2_args(gxm_set_clip_x_origin_w, gxm_set_clip_x_origin)
+Xen_wrap_1_arg(gxm_graphics_exposures_w, gxm_graphics_exposures)
+Xen_wrap_2_args(gxm_set_graphics_exposures_w, gxm_set_graphics_exposures)
+Xen_wrap_1_arg(gxm_subwindow_mode_w, gxm_subwindow_mode)
+Xen_wrap_2_args(gxm_set_subwindow_mode_w, gxm_set_subwindow_mode)
+Xen_wrap_1_arg(gxm_font_w, gxm_font)
+Xen_wrap_2_args(gxm_set_font_w, gxm_set_font)
+Xen_wrap_1_arg(gxm_ts_y_origin_w, gxm_ts_y_origin)
+Xen_wrap_2_args(gxm_set_ts_y_origin_w, gxm_set_ts_y_origin)
+Xen_wrap_1_arg(gxm_ts_x_origin_w, gxm_ts_x_origin)
+Xen_wrap_2_args(gxm_set_ts_x_origin_w, gxm_set_ts_x_origin)
+Xen_wrap_1_arg(gxm_stipple_w, gxm_stipple)
+Xen_wrap_2_args(gxm_set_stipple_w, gxm_set_stipple)
+Xen_wrap_1_arg(gxm_tile_w, gxm_tile)
+Xen_wrap_2_args(gxm_set_tile_w, gxm_set_tile)
+Xen_wrap_1_arg(gxm_arc_mode_w, gxm_arc_mode)
+Xen_wrap_2_args(gxm_set_arc_mode_w, gxm_set_arc_mode)
+Xen_wrap_1_arg(gxm_fill_rule_w, gxm_fill_rule)
+Xen_wrap_2_args(gxm_set_fill_rule_w, gxm_set_fill_rule)
+Xen_wrap_1_arg(gxm_fill_style_w, gxm_fill_style)
+Xen_wrap_2_args(gxm_set_fill_style_w, gxm_set_fill_style)
+Xen_wrap_1_arg(gxm_join_style_w, gxm_join_style)
+Xen_wrap_2_args(gxm_set_join_style_w, gxm_set_join_style)
+Xen_wrap_1_arg(gxm_cap_style_w, gxm_cap_style)
+Xen_wrap_2_args(gxm_set_cap_style_w, gxm_set_cap_style)
+Xen_wrap_1_arg(gxm_line_style_w, gxm_line_style)
+Xen_wrap_2_args(gxm_set_line_style_w, gxm_set_line_style)
+Xen_wrap_1_arg(gxm_line_width_w, gxm_line_width)
+Xen_wrap_2_args(gxm_set_line_width_w, gxm_set_line_width)
+Xen_wrap_1_arg(gxm_background_w, gxm_background)
+Xen_wrap_2_args(gxm_set_background_w, gxm_set_background)
+Xen_wrap_1_arg(gxm_foreground_w, gxm_foreground)
+Xen_wrap_2_args(gxm_set_foreground_w, gxm_set_foreground)
+Xen_wrap_1_arg(gxm_plane_mask_w, gxm_plane_mask)
+Xen_wrap_2_args(gxm_set_plane_mask_w, gxm_set_plane_mask)
+Xen_wrap_1_arg(gxm_function_w, gxm_function)
+Xen_wrap_2_args(gxm_set_function_w, gxm_set_function)
+Xen_wrap_1_arg(gxm_delta_w, gxm_delta)
+Xen_wrap_2_args(gxm_set_delta_w, gxm_set_delta)
+Xen_wrap_1_arg(gxm_nchars_w, gxm_nchars)
+Xen_wrap_2_args(gxm_set_nchars_w, gxm_set_nchars)
+Xen_wrap_1_arg(gxm_chars_w, gxm_chars)
+Xen_wrap_2_args(gxm_set_chars_w, gxm_set_chars)
+Xen_wrap_1_arg(gxm_name_w, gxm_name)
+Xen_wrap_2_args(gxm_set_name_w, gxm_set_name)
+Xen_wrap_1_arg(gxm_depth_w, gxm_depth)
+Xen_wrap_2_args(gxm_set_depth_w, gxm_set_depth)
+Xen_wrap_1_arg(gxm_visual_w, gxm_visual)
+Xen_wrap_2_args(gxm_set_visual_w, gxm_set_visual)
+
+Xen_wrap_1_arg(gxm_display_w, gxm_display)
+Xen_wrap_1_arg(gxm_root_w, gxm_root)
+Xen_wrap_1_arg(gxm_mwidth_w, gxm_mwidth)
+Xen_wrap_1_arg(gxm_mheight_w, gxm_mheight)
+Xen_wrap_1_arg(gxm_ndepths_w, gxm_ndepths)
+Xen_wrap_1_arg(gxm_depths_w, gxm_depths)
+Xen_wrap_1_arg(gxm_root_depth_w, gxm_root_depth)
+Xen_wrap_1_arg(gxm_root_visual_w, gxm_root_visual)
+Xen_wrap_1_arg(gxm_default_gc_w, gxm_default_gc)
+Xen_wrap_1_arg(gxm_cmap_w, gxm_cmap)
+Xen_wrap_1_arg(gxm_white_pixel_w, gxm_white_pixel)
+Xen_wrap_1_arg(gxm_black_pixel_w, gxm_black_pixel)
+Xen_wrap_1_arg(gxm_max_maps_w, gxm_max_maps)
+Xen_wrap_1_arg(gxm_min_maps_w, gxm_min_maps)
+Xen_wrap_1_arg(gxm_backing_store_w, gxm_backing_store)
+Xen_wrap_1_arg(gxm_save_unders_w, gxm_save_unders)
+Xen_wrap_1_arg(gxm_root_input_mask_w, gxm_root_input_mask)
+Xen_wrap_1_arg(gxm_type_w, gxm_type)
+Xen_wrap_1_arg(gxm_serial_w, gxm_serial)
+Xen_wrap_1_arg(gxm_send_event_w, gxm_send_event)
+Xen_wrap_1_arg(gxm_window_w, gxm_window)
+Xen_wrap_1_arg(gxm_subwindow_w, gxm_subwindow)
+Xen_wrap_1_arg(gxm_time_w, gxm_time)
+Xen_wrap_1_arg(gxm_x_root_w, gxm_x_root)
+Xen_wrap_1_arg(gxm_y_root_w, gxm_y_root)
+Xen_wrap_1_arg(gxm_state_w, gxm_state)
+Xen_wrap_1_arg(gxm_keycode_w, gxm_keycode)
+Xen_wrap_1_arg(gxm_same_screen_w, gxm_same_screen)
+Xen_wrap_1_arg(gxm_button_w, gxm_button)
+Xen_wrap_1_arg(gxm_is_hint_w, gxm_is_hint)
+Xen_wrap_1_arg(gxm_mode_w, gxm_mode)
+Xen_wrap_1_arg(gxm_detail_w, gxm_detail)
+Xen_wrap_1_arg(gxm_focus_w, gxm_focus)
+Xen_wrap_1_arg(gxm_key_vector_w, gxm_key_vector)
+Xen_wrap_1_arg(gxm_count_w, gxm_count)
+Xen_wrap_1_arg(gxm_drawable_w, gxm_drawable)
+Xen_wrap_1_arg(gxm_major_code_w, gxm_major_code)
+Xen_wrap_1_arg(gxm_minor_code_w, gxm_minor_code)
+Xen_wrap_1_arg(gxm_parent_w, gxm_parent)
+Xen_wrap_1_arg(gxm_border_width_w, gxm_border_width)
+Xen_wrap_1_arg(gxm_override_redirect_w, gxm_override_redirect)
+Xen_wrap_1_arg(gxm_event_w, gxm_event)
+Xen_wrap_1_arg(gxm_from_configure_w, gxm_from_configure)
+Xen_wrap_1_arg(gxm_above_w, gxm_above)
+Xen_wrap_1_arg(gxm_value_mask_w, gxm_value_mask)
+Xen_wrap_1_arg(gxm_place_w, gxm_place)
+Xen_wrap_1_arg(gxm_atom_w, gxm_atom)
+Xen_wrap_1_arg(gxm_selection_w, gxm_selection)
+Xen_wrap_1_arg(gxm_owner_w, gxm_owner)
+Xen_wrap_1_arg(gxm_requestor_w, gxm_requestor)
+Xen_wrap_1_arg(gxm_target_w, gxm_target)
+Xen_wrap_1_arg(gxm_property_w, gxm_property)
+Xen_wrap_1_arg(gxm_new_w, gxm_new)
+Xen_wrap_1_arg(gxm_message_type_w, gxm_message_type)
+Xen_wrap_1_arg(gxm_format_w, gxm_format)
+Xen_wrap_1_arg(gxm_request_w, gxm_request)
+Xen_wrap_1_arg(gxm_first_keycode_w, gxm_first_keycode)
+Xen_wrap_1_arg(gxm_resourceid_w, gxm_resourceid)
+Xen_wrap_1_arg(gxm_error_code_w, gxm_error_code)
+Xen_wrap_1_arg(gxm_request_code_w, gxm_request_code)
+Xen_wrap_1_arg(gxm_lbearing_w, gxm_lbearing)
+Xen_wrap_1_arg(gxm_rbearing_w, gxm_rbearing)
+Xen_wrap_1_arg(gxm_ascent_w, gxm_ascent)
+Xen_wrap_1_arg(gxm_descent_w, gxm_descent)
+Xen_wrap_1_arg(gxm_attributes_w, gxm_attributes)
+Xen_wrap_1_arg(gxm_card32_w, gxm_card32)
+Xen_wrap_1_arg(gxm_fid_w, gxm_fid)
+Xen_wrap_1_arg(gxm_properties_w, gxm_properties)
+Xen_wrap_1_arg(gxm_min_bounds_w, gxm_min_bounds)
+Xen_wrap_1_arg(gxm_max_bounds_w, gxm_max_bounds)
+Xen_wrap_1_arg(gxm_per_char_w, gxm_per_char)
+Xen_wrap_1_arg(gxm_input_w, gxm_input)
+Xen_wrap_1_arg(gxm_initial_state_w, gxm_initial_state)
+Xen_wrap_1_arg(gxm_icon_pixmap_w, gxm_icon_pixmap)
+Xen_wrap_1_arg(gxm_icon_window_w, gxm_icon_window)
+Xen_wrap_1_arg(gxm_icon_x_w, gxm_icon_x)
+Xen_wrap_1_arg(gxm_icon_y_w, gxm_icon_y)
+Xen_wrap_1_arg(gxm_icon_mask_w, gxm_icon_mask)
+Xen_wrap_1_arg(gxm_window_group_w, gxm_window_group)
+Xen_wrap_1_arg(gxm_visualid_w, gxm_visualid)
+Xen_wrap_1_arg(gxm_class_w, gxm_class)
+Xen_wrap_1_arg(gxm_red_mask_w, gxm_red_mask)
+Xen_wrap_1_arg(gxm_green_mask_w, gxm_green_mask)
+Xen_wrap_1_arg(gxm_blue_mask_w, gxm_blue_mask)
+Xen_wrap_1_arg(gxm_bits_per_rgb_w, gxm_bits_per_rgb)
+Xen_wrap_1_arg(gxm_map_entries_w, gxm_map_entries)
+Xen_wrap_1_arg(gxm_colormap_size_w, gxm_colormap_size)
+Xen_wrap_1_arg(gxm_nvisuals_w, gxm_nvisuals)
+Xen_wrap_1_arg(gxm_visuals_w, gxm_visuals)
+Xen_wrap_1_arg(gxm_bits_per_pixel_w, gxm_bits_per_pixel)
+Xen_wrap_1_arg(gxm_background_pixmap_w, gxm_background_pixmap)
+Xen_wrap_1_arg(gxm_background_pixel_w, gxm_background_pixel)
+Xen_wrap_1_arg(gxm_border_pixmap_w, gxm_border_pixmap)
+Xen_wrap_1_arg(gxm_border_pixel_w, gxm_border_pixel)
+Xen_wrap_1_arg(gxm_bit_gravity_w, gxm_bit_gravity)
+Xen_wrap_1_arg(gxm_win_gravity_w, gxm_win_gravity)
+Xen_wrap_1_arg(gxm_backing_planes_w, gxm_backing_planes)
+Xen_wrap_1_arg(gxm_backing_pixel_w, gxm_backing_pixel)
+Xen_wrap_1_arg(gxm_save_under_w, gxm_save_under)
+Xen_wrap_1_arg(gxm_event_mask_w, gxm_event_mask)
+Xen_wrap_1_arg(gxm_do_not_propagate_mask_w, gxm_do_not_propagate_mask)
+Xen_wrap_1_arg(gxm_cursor_w, gxm_cursor)
+Xen_wrap_1_arg(gxm_map_installed_w, gxm_map_installed)
+Xen_wrap_1_arg(gxm_map_state_w, gxm_map_state)
+Xen_wrap_1_arg(gxm_all_event_masks_w, gxm_all_event_masks)
+Xen_wrap_1_arg(gxm_your_event_mask_w, gxm_your_event_mask)
+Xen_wrap_1_arg(gxm_screen_w, gxm_screen)
+Xen_wrap_1_arg(gxm_xoffset_w, gxm_xoffset)
+Xen_wrap_1_arg(gxm_byte_order_w, gxm_byte_order)
+Xen_wrap_1_arg(gxm_bitmap_unit_w, gxm_bitmap_unit)
+Xen_wrap_1_arg(gxm_bitmap_bit_order_w, gxm_bitmap_bit_order)
+Xen_wrap_1_arg(gxm_bitmap_pad_w, gxm_bitmap_pad)
+Xen_wrap_1_arg(gxm_bytes_per_line_w, gxm_bytes_per_line)
+Xen_wrap_1_arg(gxm_obdata_w, gxm_obdata)
+Xen_wrap_1_arg(gxm_sibling_w, gxm_sibling)
+Xen_wrap_1_arg(gxm_stack_mode_w, gxm_stack_mode)
- #define gxm_red_max_w gxm_red_max
- #define gxm_red_mult_w gxm_red_mult
- #define gxm_green_max_w gxm_green_max
- #define gxm_green_mult_w gxm_green_mult
- #define gxm_blue_max_w gxm_blue_max
- #define gxm_blue_mult_w gxm_blue_mult
- #define gxm_base_pixel_w gxm_base_pixel
- #define gxm_killid_w gxm_killid
- #define gxm_data_w gxm_data
-
- #define gxm_set_request_code_w gxm_set_request_code
- #define gxm_set_error_code_w gxm_set_error_code
- #define gxm_set_first_keycode_w gxm_set_first_keycode
- #define gxm_set_request_w gxm_set_request
- #define gxm_set_resourceid_w gxm_set_resourceid
- #define gxm_set_format_w gxm_set_format
- #define gxm_set_message_type_w gxm_set_message_type
- #define gxm_set_new_w gxm_set_new
- #define gxm_set_property_w gxm_set_property
- #define gxm_set_display_w gxm_set_display
- #define gxm_set_target_w gxm_set_target
- #define gxm_set_requestor_w gxm_set_requestor
- #define gxm_set_owner_w gxm_set_owner
- #define gxm_set_selection_w gxm_set_selection
- #define gxm_set_atom_w gxm_set_atom
- #define gxm_set_place_w gxm_set_place
- #define gxm_set_value_mask_w gxm_set_value_mask
- #define gxm_set_above_w gxm_set_above
- #define gxm_set_from_configure_w gxm_set_from_configure
- #define gxm_set_event_w gxm_set_event
- #define gxm_set_override_redirect_w gxm_set_override_redirect
- #define gxm_set_border_width_w gxm_set_border_width
- #define gxm_set_parent_w gxm_set_parent
- #define gxm_set_minor_code_w gxm_set_minor_code
- #define gxm_set_major_code_w gxm_set_major_code
- #define gxm_set_drawable_w gxm_set_drawable
- #define gxm_set_count_w gxm_set_count
- #define gxm_set_key_vector_w gxm_set_key_vector
- #define gxm_set_focus_w gxm_set_focus
- #define gxm_set_detail_w gxm_set_detail
- #define gxm_set_mode_w gxm_set_mode
- #define gxm_set_is_hint_w gxm_set_is_hint
- #define gxm_set_button_w gxm_set_button
- #define gxm_set_same_screen_w gxm_set_same_screen
- #define gxm_set_keycode_w gxm_set_keycode
- #define gxm_set_state_w gxm_set_state
- #define gxm_set_y_root_w gxm_set_y_root
- #define gxm_set_x_root_w gxm_set_x_root
- #define gxm_set_root_w gxm_set_root
- #define gxm_set_time_w gxm_set_time
- #define gxm_set_subwindow_w gxm_set_subwindow
- #define gxm_set_window_w gxm_set_window
- #define gxm_set_send_event_w gxm_set_send_event
- #define gxm_set_serial_w gxm_set_serial
- #define gxm_set_type_w gxm_set_type
- #define gxm_colormap_w gxm_colormap
- #define gxm_set_colormap_w gxm_set_colormap
-
- #define gxm_set_input_w gxm_set_input
- #define gxm_set_initial_state_w gxm_set_initial_state
-
- #define gxm_min_height_w gxm_min_height
- #define gxm_max_height_w gxm_max_height
- #define gxm_min_width_w gxm_min_width
- #define gxm_max_width_w gxm_max_width
- #define gxm_height_inc_w gxm_height_inc
- #define gxm_width_inc_w gxm_width_inc
-
- #define gxm_set_data_w gxm_set_data
- #define gxm_set_backing_store_w gxm_set_backing_store
- #define gxm_set_background_pixel_w gxm_set_background_pixel
- #define gxm_set_border_pixel_w gxm_set_border_pixel
- #define gxm_set_bit_gravity_w gxm_set_bit_gravity
- #define gxm_set_save_under_w gxm_set_save_under
- #define gxm_set_event_mask_w gxm_set_event_mask
- #define gxm_set_cursor_w gxm_set_cursor
-
-#if HAVE_MOTIF
- #define gxm_set_set_w gxm_set_set
- #define gxm_set_click_count_w gxm_set_click_count
- #define gxm_set_length_w gxm_set_length
- #define gxm_ptr_w gxm_ptr
- #define gxm_set_ptr_w gxm_set_ptr
- #define gxm_set_reason_w gxm_set_reason
- #define gxm_page_number_w gxm_page_number
- #define gxm_page_widget_w gxm_page_widget
- #define gxm_status_area_widget_w gxm_status_area_widget
- #define gxm_major_tab_widget_w gxm_major_tab_widget
- #define gxm_minor_tab_widget_w gxm_minor_tab_widget
- #define gxm_source_data_w gxm_source_data
- #define gxm_location_data_w gxm_location_data
- #define gxm_parm_w gxm_parm
- #define gxm_parm_format_w gxm_parm_format
- #define gxm_parm_length_w gxm_parm_length
- #define gxm_parm_type_w gxm_parm_type
- #define gxm_transfer_id_w gxm_transfer_id
- #define gxm_destination_data_w gxm_destination_data
- #define gxm_remaining_w gxm_remaining
- #define gxm_item_or_text_w gxm_item_or_text
- #define gxm_auto_selection_type_w gxm_auto_selection_type
- #define gxm_new_outline_state_w gxm_new_outline_state
- #define gxm_prev_page_number_w gxm_prev_page_number
- #define gxm_prev_page_widget_w gxm_prev_page_widget
- #define gxm_rendition_w gxm_rendition
- #define gxm_render_table_w gxm_render_table
- #define gxm_crossed_boundary_w gxm_crossed_boundary
- #define gxm_client_data_w gxm_client_data
- #define gxm_status_w gxm_status
- #define gxm_font_name_w gxm_font_name
- #define gxm_tag_w gxm_tag
- #define gxm_traversal_destination_w gxm_traversal_destination
- #define gxm_dragProtocolStyle_w gxm_dragProtocolStyle
- #define gxm_direction_w gxm_direction
- #define gxm_reason_w gxm_reason
- #define gxm_timeStamp_w gxm_timeStamp
- #define gxm_operation_w gxm_operation
- #define gxm_set_operation_w gxm_set_operation
- #define gxm_operations_w gxm_operations
- #define gxm_dropSiteStatus_w gxm_dropSiteStatus
- #define gxm_set_dropSiteStatus_w gxm_set_dropSiteStatus
- #define gxm_dropAction_w gxm_dropAction
- #define gxm_iccHandle_w gxm_iccHandle
- #define gxm_completionStatus_w gxm_completionStatus
- #define gxm_dragContext_w gxm_dragContext
- #define gxm_animate_w gxm_animate
- #define gxm_length_w gxm_length
- #define gxm_click_count_w gxm_click_count
- #define gxm_widget_w gxm_widget
- #define gxm_item_position_w gxm_item_position
- #define gxm_callbackstruct_w gxm_callbackstruct
- #define gxm_set_w gxm_set
- #define gxm_item_w gxm_item
- #define gxm_item_length_w gxm_item_length
- #define gxm_selected_items_w gxm_selected_items
- #define gxm_selected_item_count_w gxm_selected_item_count
- #define gxm_selected_item_positions_w gxm_selected_item_positions
- #define gxm_selection_type_w gxm_selection_type
- #define gxm_mask_w gxm_mask
- #define gxm_mask_length_w gxm_mask_length
- #define gxm_dir_w gxm_dir
- #define gxm_dir_length_w gxm_dir_length
- #define gxm_pattern_w gxm_pattern
- #define gxm_pattern_length_w gxm_pattern_length
- #define gxm_position_w gxm_position
- #define gxm_currInsert_w gxm_currInsert
- #define gxm_newInsert_w gxm_newInsert
- #define gxm_startPos_w gxm_startPos
- #define gxm_endPos_w gxm_endPos
- #define gxm_text_w gxm_text
- #define gxm_value_w gxm_value
- #define gxm_set_value_w gxm_set_value
- #define gxm_doit_w gxm_doit
- #define gxm_set_doit_w gxm_set_doit
- #define gxm_menuToPost_w gxm_menuToPost
- #define gxm_set_menuToPost_w gxm_set_menuToPost
- #define gxm_postIt_w gxm_postIt
- #define gxm_set_postIt_w gxm_set_postIt
-#if HAVE_XmCreateDataField
- #define gxm_w_w gxm_w
- #define gxm_accept_w gxm_accept
-#endif
-#if HAVE_XmCreateTabStack
- #define gxm_selected_child_w gxm_selected_child
-#endif
-
- #define gxm_valuemask_w gxm_valuemask
- #define gxm_set_valuemask_w gxm_set_valuemask
- #define gxm_ncolors_w gxm_ncolors
- #define gxm_set_ncolors_w gxm_set_ncolors
- #define gxm_cpp_w gxm_cpp
- #define gxm_set_cpp_w gxm_set_cpp
- #define gxm_numsymbols_w gxm_numsymbols
- #define gxm_set_numsymbols_w gxm_set_numsymbols
- #define gxm_colorsymbols_w gxm_colorsymbols
- #define gxm_set_colorsymbols_w gxm_set_colorsymbols
- #define gxm_npixels_w gxm_npixels
- #define gxm_set_npixels_w gxm_set_npixels
- #define gxm_y_hotspot_w gxm_y_hotspot
- #define gxm_set_y_hotspot_w gxm_set_y_hotspot
- #define gxm_x_hotspot_w gxm_x_hotspot
- #define gxm_set_x_hotspot_w gxm_set_x_hotspot
-
- #define gxm_XpmImage_w gxm_XpmImage
- #define gxm_XpmColorSymbol_w gxm_XpmColorSymbol
- #define gxm_XpmAttributes_w gxm_XpmAttributes
+Xen_wrap_1_arg(gxm_red_max_w, gxm_red_max)
+Xen_wrap_1_arg(gxm_red_mult_w, gxm_red_mult)
+Xen_wrap_1_arg(gxm_green_max_w, gxm_green_max)
+Xen_wrap_1_arg(gxm_green_mult_w, gxm_green_mult)
+Xen_wrap_1_arg(gxm_blue_max_w, gxm_blue_max)
+Xen_wrap_1_arg(gxm_blue_mult_w, gxm_blue_mult)
+Xen_wrap_1_arg(gxm_base_pixel_w, gxm_base_pixel)
+Xen_wrap_1_arg(gxm_killid_w, gxm_killid)
+Xen_wrap_1_arg(gxm_data_w, gxm_data)
+
+Xen_wrap_2_args(gxm_set_request_code_w, gxm_set_request_code)
+Xen_wrap_2_args(gxm_set_error_code_w, gxm_set_error_code)
+Xen_wrap_2_args(gxm_set_first_keycode_w, gxm_set_first_keycode)
+Xen_wrap_2_args(gxm_set_request_w, gxm_set_request)
+Xen_wrap_2_args(gxm_set_resourceid_w, gxm_set_resourceid)
+Xen_wrap_2_args(gxm_set_format_w, gxm_set_format)
+Xen_wrap_2_args(gxm_set_message_type_w, gxm_set_message_type)
+Xen_wrap_2_args(gxm_set_new_w, gxm_set_new)
+Xen_wrap_2_args(gxm_set_property_w, gxm_set_property)
+Xen_wrap_2_args(gxm_set_display_w, gxm_set_display)
+Xen_wrap_2_args(gxm_set_target_w, gxm_set_target)
+Xen_wrap_2_args(gxm_set_requestor_w, gxm_set_requestor)
+Xen_wrap_2_args(gxm_set_owner_w, gxm_set_owner)
+Xen_wrap_2_args(gxm_set_selection_w, gxm_set_selection)
+Xen_wrap_2_args(gxm_set_atom_w, gxm_set_atom)
+Xen_wrap_2_args(gxm_set_place_w, gxm_set_place)
+Xen_wrap_2_args(gxm_set_value_mask_w, gxm_set_value_mask)
+Xen_wrap_2_args(gxm_set_above_w, gxm_set_above)
+Xen_wrap_2_args(gxm_set_from_configure_w, gxm_set_from_configure)
+Xen_wrap_2_args(gxm_set_event_w, gxm_set_event)
+Xen_wrap_2_args(gxm_set_override_redirect_w, gxm_set_override_redirect)
+Xen_wrap_2_args(gxm_set_border_width_w, gxm_set_border_width)
+Xen_wrap_2_args(gxm_set_parent_w, gxm_set_parent)
+Xen_wrap_2_args(gxm_set_minor_code_w, gxm_set_minor_code)
+Xen_wrap_2_args(gxm_set_major_code_w, gxm_set_major_code)
+Xen_wrap_2_args(gxm_set_drawable_w, gxm_set_drawable)
+Xen_wrap_2_args(gxm_set_count_w, gxm_set_count)
+Xen_wrap_2_args(gxm_set_key_vector_w, gxm_set_key_vector)
+Xen_wrap_2_args(gxm_set_focus_w, gxm_set_focus)
+Xen_wrap_2_args(gxm_set_detail_w, gxm_set_detail)
+Xen_wrap_2_args(gxm_set_mode_w, gxm_set_mode)
+Xen_wrap_2_args(gxm_set_is_hint_w, gxm_set_is_hint)
+Xen_wrap_2_args(gxm_set_button_w, gxm_set_button)
+Xen_wrap_2_args(gxm_set_same_screen_w, gxm_set_same_screen)
+Xen_wrap_2_args(gxm_set_keycode_w, gxm_set_keycode)
+Xen_wrap_2_args(gxm_set_state_w, gxm_set_state)
+Xen_wrap_2_args(gxm_set_y_root_w, gxm_set_y_root)
+Xen_wrap_2_args(gxm_set_x_root_w, gxm_set_x_root)
+Xen_wrap_2_args(gxm_set_root_w, gxm_set_root)
+Xen_wrap_2_args(gxm_set_time_w, gxm_set_time)
+Xen_wrap_2_args(gxm_set_subwindow_w, gxm_set_subwindow)
+Xen_wrap_2_args(gxm_set_window_w, gxm_set_window)
+Xen_wrap_2_args(gxm_set_send_event_w, gxm_set_send_event)
+Xen_wrap_2_args(gxm_set_serial_w, gxm_set_serial)
+Xen_wrap_2_args(gxm_set_type_w, gxm_set_type)
+Xen_wrap_1_arg(gxm_colormap_w, gxm_colormap)
+Xen_wrap_2_args(gxm_set_colormap_w, gxm_set_colormap)
+
+Xen_wrap_2_args(gxm_set_input_w, gxm_set_input)
+Xen_wrap_2_args(gxm_set_initial_state_w, gxm_set_initial_state)
+
+Xen_wrap_1_arg(gxm_min_height_w, gxm_min_height)
+Xen_wrap_1_arg(gxm_max_height_w, gxm_max_height)
+Xen_wrap_1_arg(gxm_min_width_w, gxm_min_width)
+Xen_wrap_1_arg(gxm_max_width_w, gxm_max_width)
+Xen_wrap_1_arg(gxm_height_inc_w, gxm_height_inc)
+Xen_wrap_1_arg(gxm_width_inc_w, gxm_width_inc)
+
+Xen_wrap_2_args(gxm_set_data_w, gxm_set_data)
+Xen_wrap_2_args(gxm_set_backing_store_w, gxm_set_backing_store)
+Xen_wrap_2_args(gxm_set_background_pixel_w, gxm_set_background_pixel)
+Xen_wrap_2_args(gxm_set_border_pixel_w, gxm_set_border_pixel)
+Xen_wrap_2_args(gxm_set_bit_gravity_w, gxm_set_bit_gravity)
+Xen_wrap_2_args(gxm_set_save_under_w, gxm_set_save_under)
+Xen_wrap_2_args(gxm_set_event_mask_w, gxm_set_event_mask)
+Xen_wrap_2_args(gxm_set_cursor_w, gxm_set_cursor)
+
+Xen_wrap_2_args(gxm_set_set_w, gxm_set_set)
+Xen_wrap_2_args(gxm_set_click_count_w, gxm_set_click_count)
+Xen_wrap_2_args(gxm_set_length_w, gxm_set_length)
+Xen_wrap_1_arg(gxm_ptr_w, gxm_ptr)
+Xen_wrap_2_args(gxm_set_ptr_w, gxm_set_ptr)
+Xen_wrap_2_args(gxm_set_reason_w, gxm_set_reason)
+Xen_wrap_1_arg(gxm_page_number_w, gxm_page_number)
+Xen_wrap_1_arg(gxm_page_widget_w, gxm_page_widget)
+Xen_wrap_1_arg(gxm_status_area_widget_w, gxm_status_area_widget)
+Xen_wrap_1_arg(gxm_major_tab_widget_w, gxm_major_tab_widget)
+Xen_wrap_1_arg(gxm_minor_tab_widget_w, gxm_minor_tab_widget)
+Xen_wrap_1_arg(gxm_source_data_w, gxm_source_data)
+Xen_wrap_1_arg(gxm_location_data_w, gxm_location_data)
+Xen_wrap_1_arg(gxm_parm_w, gxm_parm)
+Xen_wrap_1_arg(gxm_parm_format_w, gxm_parm_format)
+Xen_wrap_1_arg(gxm_parm_length_w, gxm_parm_length)
+Xen_wrap_1_arg(gxm_parm_type_w, gxm_parm_type)
+Xen_wrap_1_arg(gxm_transfer_id_w, gxm_transfer_id)
+Xen_wrap_1_arg(gxm_destination_data_w, gxm_destination_data)
+Xen_wrap_1_arg(gxm_remaining_w, gxm_remaining)
+Xen_wrap_1_arg(gxm_item_or_text_w, gxm_item_or_text)
+Xen_wrap_1_arg(gxm_auto_selection_type_w, gxm_auto_selection_type)
+Xen_wrap_1_arg(gxm_new_outline_state_w, gxm_new_outline_state)
+Xen_wrap_1_arg(gxm_prev_page_number_w, gxm_prev_page_number)
+Xen_wrap_1_arg(gxm_prev_page_widget_w, gxm_prev_page_widget)
+Xen_wrap_1_arg(gxm_rendition_w, gxm_rendition)
+Xen_wrap_1_arg(gxm_render_table_w, gxm_render_table)
+Xen_wrap_1_arg(gxm_crossed_boundary_w, gxm_crossed_boundary)
+Xen_wrap_1_arg(gxm_client_data_w, gxm_client_data)
+Xen_wrap_1_arg(gxm_status_w, gxm_status)
+Xen_wrap_1_arg(gxm_font_name_w, gxm_font_name)
+Xen_wrap_1_arg(gxm_tag_w, gxm_tag)
+Xen_wrap_1_arg(gxm_traversal_destination_w, gxm_traversal_destination)
+Xen_wrap_1_arg(gxm_dragProtocolStyle_w, gxm_dragProtocolStyle)
+Xen_wrap_1_arg(gxm_direction_w, gxm_direction)
+Xen_wrap_1_arg(gxm_reason_w, gxm_reason)
+Xen_wrap_1_arg(gxm_timeStamp_w, gxm_timeStamp)
+Xen_wrap_1_arg(gxm_operation_w, gxm_operation )
+Xen_wrap_2_args(gxm_set_operation_w, gxm_set_operation)
+Xen_wrap_1_arg(gxm_operations_w, gxm_operations)
+Xen_wrap_1_arg(gxm_dropSiteStatus_w, gxm_dropSiteStatus )
+Xen_wrap_2_args(gxm_set_dropSiteStatus_w, gxm_set_dropSiteStatus)
+Xen_wrap_1_arg(gxm_dropAction_w, gxm_dropAction)
+Xen_wrap_1_arg(gxm_iccHandle_w, gxm_iccHandle)
+Xen_wrap_1_arg(gxm_completionStatus_w, gxm_completionStatus)
+Xen_wrap_1_arg(gxm_dragContext_w, gxm_dragContext)
+Xen_wrap_1_arg(gxm_animate_w, gxm_animate)
+Xen_wrap_1_arg(gxm_length_w, gxm_length)
+Xen_wrap_1_arg(gxm_click_count_w, gxm_click_count)
+Xen_wrap_1_arg(gxm_widget_w, gxm_widget)
+Xen_wrap_1_arg(gxm_item_position_w, gxm_item_position)
+Xen_wrap_1_arg(gxm_callbackstruct_w, gxm_callbackstruct)
+Xen_wrap_1_arg(gxm_set_w, gxm_set)
+Xen_wrap_1_arg(gxm_item_w, gxm_item)
+Xen_wrap_1_arg(gxm_item_length_w, gxm_item_length)
+Xen_wrap_1_arg(gxm_selected_items_w, gxm_selected_items)
+Xen_wrap_1_arg(gxm_selected_item_count_w, gxm_selected_item_count)
+Xen_wrap_1_arg(gxm_selected_item_positions_w, gxm_selected_item_positions)
+Xen_wrap_1_arg(gxm_selection_type_w, gxm_selection_type)
+Xen_wrap_1_arg(gxm_mask_w, gxm_mask)
+Xen_wrap_1_arg(gxm_mask_length_w, gxm_mask_length)
+Xen_wrap_1_arg(gxm_dir_w, gxm_dir)
+Xen_wrap_1_arg(gxm_dir_length_w, gxm_dir_length)
+Xen_wrap_1_arg(gxm_pattern_w, gxm_pattern)
+Xen_wrap_1_arg(gxm_pattern_length_w, gxm_pattern_length)
+Xen_wrap_1_arg(gxm_position_w, gxm_position)
+Xen_wrap_1_arg(gxm_currInsert_w, gxm_currInsert)
+Xen_wrap_1_arg(gxm_newInsert_w, gxm_newInsert)
+Xen_wrap_1_arg(gxm_startPos_w, gxm_startPos)
+Xen_wrap_1_arg(gxm_endPos_w, gxm_endPos)
+Xen_wrap_1_arg(gxm_text_w, gxm_text)
+Xen_wrap_1_arg(gxm_value_w, gxm_value)
+Xen_wrap_2_args(gxm_set_value_w, gxm_set_value)
+Xen_wrap_1_arg(gxm_doit_w, gxm_doit)
+Xen_wrap_2_args(gxm_set_doit_w, gxm_set_doit)
+Xen_wrap_1_arg(gxm_menuToPost_w, gxm_menuToPost)
+Xen_wrap_2_args(gxm_set_menuToPost_w, gxm_set_menuToPost)
+Xen_wrap_1_arg(gxm_postIt_w, gxm_postIt)
+Xen_wrap_2_args(gxm_set_postIt_w, gxm_set_postIt)
+
+Xen_wrap_1_arg(gxm_valuemask_w, gxm_valuemask)
+Xen_wrap_2_args(gxm_set_valuemask_w, gxm_set_valuemask)
+Xen_wrap_1_arg(gxm_ncolors_w, gxm_ncolors)
+Xen_wrap_2_args(gxm_set_ncolors_w, gxm_set_ncolors)
+Xen_wrap_1_arg(gxm_cpp_w, gxm_cpp)
+Xen_wrap_2_args(gxm_set_cpp_w, gxm_set_cpp)
+Xen_wrap_1_arg(gxm_numsymbols_w, gxm_numsymbols)
+Xen_wrap_2_args(gxm_set_numsymbols_w, gxm_set_numsymbols)
+Xen_wrap_1_arg(gxm_colorsymbols_w, gxm_colorsymbols)
+Xen_wrap_2_args(gxm_set_colorsymbols_w, gxm_set_colorsymbols)
+Xen_wrap_1_arg(gxm_npixels_w, gxm_npixels)
+Xen_wrap_2_args(gxm_set_npixels_w, gxm_set_npixels)
+Xen_wrap_1_arg(gxm_y_hotspot_w, gxm_y_hotspot)
+Xen_wrap_2_args(gxm_set_y_hotspot_w, gxm_set_y_hotspot)
+Xen_wrap_1_arg(gxm_x_hotspot_w, gxm_x_hotspot)
+Xen_wrap_2_args(gxm_set_x_hotspot_w, gxm_set_x_hotspot)
+
+Xen_wrap_5_args(gxm_XpmImage_w, gxm_XpmImage)
+Xen_wrap_3_args(gxm_XpmColorSymbol_w, gxm_XpmColorSymbol)
+Xen_wrap_no_args(gxm_XpmAttributes_w, gxm_XpmAttributes)
#if HAVE_SCHEME
- #define c_to_xen_string_w c_to_xen_string
- #define c_to_xen_strings_w c_to_xen_strings
- #define c_to_xen_ints_w c_to_xen_ints
- #define c_to_xen_atoms_w c_to_xen_atoms
- #define c_to_xen_xrectangles_w c_to_xen_xrectangles
-#endif
-
+Xen_wrap_2_args(c_to_xen_strings_w, c_to_xen_strings)
+Xen_wrap_2_args(c_to_xen_ints_w, c_to_xen_ints)
+Xen_wrap_2_args(c_to_xen_atoms_w, c_to_xen_atoms)
+Xen_wrap_2_args(c_to_xen_xrectangles_w, c_to_xen_xrectangles)
#endif
-/* HAVE_MOTIF */
-#endif
-/* argify */
-
static void define_procedures(void)
{
- #define XM_DEFINE_PROCEDURE(Name, Value, A1, A2, A3, Help) XEN_DEFINE_PROCEDURE(XM_PREFIX #Name XM_POSTFIX, Value, A1, A2, A3, Help)
+ #define XM_define_procedure(Name, Value, A1, A2, A3, Help) Xen_define_safe_procedure(XM_PREFIX #Name XM_POSTFIX, Value, A1, A2, A3, Help)
- xm_gc_table = XEN_MAKE_VECTOR(1, XEN_FALSE);
- XEN_PROTECT_FROM_GC(xm_gc_table);
+ xm_gc_table = Xen_make_vector(1, Xen_false);
+ Xen_GC_protect(xm_gc_table);
xm_protected_size = 512;
- xm_protected = XEN_MAKE_VECTOR(xm_protected_size, XEN_FALSE);
- XEN_VECTOR_SET(xm_gc_table, 0, xm_protected);
-
-#if HAVE_MOTIF
- XM_DEFINE_PROCEDURE(XtSetArg, gxm_XtSetArg_w, 3, 0, 0, H_XtSetArg);
- XM_DEFINE_PROCEDURE(XtManageChildren, gxm_XtManageChildren_w, 1, 1, 0, H_XtManageChildren);
- XM_DEFINE_PROCEDURE(XtManageChild, gxm_XtManageChild_w, 1, 0, 0, H_XtManageChild);
- XM_DEFINE_PROCEDURE(XtUnmanageChildren, gxm_XtUnmanageChildren_w, 1, 1, 0, H_XtUnmanageChildren);
- XM_DEFINE_PROCEDURE(XtUnmanageChild, gxm_XtUnmanageChild_w, 1, 0, 0, H_XtUnmanageChild);
- XM_DEFINE_PROCEDURE(XtDispatchEvent, gxm_XtDispatchEvent_w, 1, 0, 0, H_XtDispatchEvent);
- XM_DEFINE_PROCEDURE(XtCallAcceptFocus, gxm_XtCallAcceptFocus_w, 2, 0, 0, H_XtCallAcceptFocus);
- XM_DEFINE_PROCEDURE(XtAppPeekEvent, gxm_XtAppPeekEvent_w, 1, 0, 0, H_XtAppPeekEvent);
- XM_DEFINE_PROCEDURE(XtIsSubclass, gxm_XtIsSubclass_w, 2, 0, 0, H_XtIsSubclass);
- XM_DEFINE_PROCEDURE(XtIsObject, gxm_XtIsObject_w, 1, 0, 0, H_XtIsObject);
- XM_DEFINE_PROCEDURE(XtIsManaged, gxm_XtIsManaged_w, 1, 0, 0, H_XtIsManaged);
- XM_DEFINE_PROCEDURE(XtIsRealized, gxm_XtIsRealized_w, 1, 0, 0, H_XtIsRealized);
- XM_DEFINE_PROCEDURE(XtIsSensitive, gxm_XtIsSensitive_w, 1, 0, 0, H_XtIsSensitive);
- XM_DEFINE_PROCEDURE(XtOwnSelection, gxm_XtOwnSelection_w, 6, 0, 0, H_XtOwnSelection);
- XM_DEFINE_PROCEDURE(XtOwnSelectionIncremental, gxm_XtOwnSelectionIncremental_w, 8, 0, 0, H_XtOwnSelectionIncremental);
- XM_DEFINE_PROCEDURE(XtMakeResizeRequest, gxm_XtMakeResizeRequest_w, 3, 0, 0, H_XtMakeResizeRequest);
- XM_DEFINE_PROCEDURE(XtTranslateCoords, gxm_XtTranslateCoords_w, 3, 0, 0, H_XtTranslateCoords);
- XM_DEFINE_PROCEDURE(XtKeysymToKeycodeList, gxm_XtKeysymToKeycodeList_w, 2, 0, 0, H_XtKeysymToKeycodeList);
- XM_DEFINE_PROCEDURE(XtParseTranslationTable, gxm_XtParseTranslationTable_w, 1, 0, 0, H_XtParseTranslationTable);
- XM_DEFINE_PROCEDURE(XtParseAcceleratorTable, gxm_XtParseAcceleratorTable_w, 1, 0, 0, H_XtParseAcceleratorTable);
- XM_DEFINE_PROCEDURE(XtOverrideTranslations, gxm_XtOverrideTranslations_w, 2, 0, 0, H_XtOverrideTranslations);
- XM_DEFINE_PROCEDURE(XtAugmentTranslations, gxm_XtAugmentTranslations_w, 2, 0, 0, H_XtAugmentTranslations);
- XM_DEFINE_PROCEDURE(XtInstallAccelerators, gxm_XtInstallAccelerators_w, 2, 0, 0, H_XtInstallAccelerators);
- XM_DEFINE_PROCEDURE(XtInstallAllAccelerators, gxm_XtInstallAllAccelerators_w, 2, 0, 0, H_XtInstallAllAccelerators);
- XM_DEFINE_PROCEDURE(XtUninstallTranslations, gxm_XtUninstallTranslations_w, 1, 0, 0, H_XtUninstallTranslations);
- XM_DEFINE_PROCEDURE(XtAppAddActions, gxm_XtAppAddActions_w, 2, 0, 0, H_XtAppAddActions);
- XM_DEFINE_PROCEDURE(XtAppAddActionHook, gxm_XtAppAddActionHook_w, 2, 1, 0, H_XtAppAddActionHook);
- XM_DEFINE_PROCEDURE(XtRemoveActionHook, gxm_XtRemoveActionHook_w, 1, 0, 0, H_XtRemoveActionHook);
- XM_DEFINE_PROCEDURE(XtGetActionList, gxm_XtGetActionList_w, 1, 0, 0, H_XtGetActionList);
- XM_DEFINE_PROCEDURE(XtCallActionProc, gxm_XtCallActionProc_w, 4, 1, 0, H_XtCallActionProc);
- XM_DEFINE_PROCEDURE(XtRegisterGrabAction, gxm_XtRegisterGrabAction_w, 5, 0, 0, H_XtRegisterGrabAction);
- XM_DEFINE_PROCEDURE(XtSetMultiClickTime, gxm_XtSetMultiClickTime_w, 2, 0, 0, H_XtSetMultiClickTime);
- XM_DEFINE_PROCEDURE(XtGetMultiClickTime, gxm_XtGetMultiClickTime_w, 1, 0, 0, H_XtGetMultiClickTime);
- XM_DEFINE_PROCEDURE(XtGetResourceList, gxm_XtGetResourceList_w, 1, 0, 0, H_XtGetResourceList);
- XM_DEFINE_PROCEDURE(XtGetActionKeysym, gxm_XtGetActionKeysym_w, 1, 0, 0, H_XtGetActionKeysym);
- XM_DEFINE_PROCEDURE(XtTranslateKeycode, gxm_XtTranslateKeycode_w, 3, 0, 0, H_XtTranslateKeycode);
- XM_DEFINE_PROCEDURE(XtTranslateKey, gxm_XtTranslateKey_w, 3, 0, 0, H_XtTranslateKey);
- XM_DEFINE_PROCEDURE(XtSetKeyTranslator, gxm_XtSetKeyTranslator_w, 2, 0, 0, H_XtSetKeyTranslator);
- XM_DEFINE_PROCEDURE(XtRegisterCaseConverter, gxm_XtRegisterCaseConverter_w, 4, 0, 0, H_XtRegisterCaseConverter);
- XM_DEFINE_PROCEDURE(XtConvertCase, gxm_XtConvertCase_w, 2, 0, 0, H_XtConvertCase);
- XM_DEFINE_PROCEDURE(XtAddEventHandler, gxm_XtAddEventHandler_w, 4, 1, 0, H_XtAddEventHandler);
- XM_DEFINE_PROCEDURE(XtRemoveEventHandler, gxm_XtRemoveEventHandler_w, 5, 0, 0, H_XtRemoveEventHandler);
- XM_DEFINE_PROCEDURE(XtAddRawEventHandler, gxm_XtAddRawEventHandler_w, 5, 0, 0, H_XtAddRawEventHandler);
- XM_DEFINE_PROCEDURE(XtRemoveRawEventHandler, gxm_XtRemoveRawEventHandler_w, 5, 0, 0, H_XtRemoveRawEventHandler);
- XM_DEFINE_PROCEDURE(XtInsertEventHandler, gxm_XtInsertEventHandler_w, 6, 0, 0, H_XtInsertEventHandler);
- XM_DEFINE_PROCEDURE(XtInsertRawEventHandler, gxm_XtInsertRawEventHandler_w, 6, 0, 0, H_XtInsertRawEventHandler);
- XM_DEFINE_PROCEDURE(XtDispatchEventToWidget, gxm_XtDispatchEventToWidget_w, 2, 0, 0, H_XtDispatchEventToWidget);
- XM_DEFINE_PROCEDURE(XtBuildEventMask, gxm_XtBuildEventMask_w, 1, 0, 0, H_XtBuildEventMask);
- XM_DEFINE_PROCEDURE(XtAddGrab, gxm_XtAddGrab_w, 3, 0, 0, H_XtAddGrab);
- XM_DEFINE_PROCEDURE(XtRemoveGrab, gxm_XtRemoveGrab_w, 1, 0, 0, H_XtRemoveGrab);
- XM_DEFINE_PROCEDURE(XtAppProcessEvent, gxm_XtAppProcessEvent_w, 2, 0, 0, H_XtAppProcessEvent);
- XM_DEFINE_PROCEDURE(XtAppMainLoop, gxm_XtAppMainLoop_w, 1, 0, 0, H_XtAppMainLoop);
- XM_DEFINE_PROCEDURE(XtAddExposureToRegion, gxm_XtAddExposureToRegion_w, 2, 0, 0, H_XtAddExposureToRegion);
- XM_DEFINE_PROCEDURE(XtSetKeyboardFocus, gxm_XtSetKeyboardFocus_w, 2, 0, 0, H_XtSetKeyboardFocus);
- XM_DEFINE_PROCEDURE(XtGetKeyboardFocusWidget, gxm_XtGetKeyboardFocusWidget_w, 1, 0, 0, H_XtGetKeyboardFocusWidget);
- XM_DEFINE_PROCEDURE(XtLastEventProcessed, gxm_XtLastEventProcessed_w, 1, 0, 0, H_XtLastEventProcessed);
- XM_DEFINE_PROCEDURE(XtLastTimestampProcessed, gxm_XtLastTimestampProcessed_w, 1, 0, 0, H_XtLastTimestampProcessed);
- XM_DEFINE_PROCEDURE(XtAppAddTimeOut, gxm_XtAppAddTimeOut_w, 3, 1, 0, H_XtAppAddTimeOut);
- XM_DEFINE_PROCEDURE(XtRemoveTimeOut, gxm_XtRemoveTimeOut_w, 1, 0, 0, H_XtRemoveTimeOut);
- XM_DEFINE_PROCEDURE(XtAppAddInput, gxm_XtAppAddInput_w, 4, 1, 0, H_XtAppAddInput);
- XM_DEFINE_PROCEDURE(XtRemoveInput, gxm_XtRemoveInput_w, 1, 0, 0, H_XtRemoveInput);
- XM_DEFINE_PROCEDURE(XtAppNextEvent, gxm_XtAppNextEvent_w, 1, 0, 0, H_XtAppNextEvent);
- XM_DEFINE_PROCEDURE(XtAppPending, gxm_XtAppPending_w, 1, 0, 0, H_XtAppPending);
- XM_DEFINE_PROCEDURE(XtRealizeWidget, gxm_XtRealizeWidget_w, 1, 0, 0, H_XtRealizeWidget);
- XM_DEFINE_PROCEDURE(XtUnrealizeWidget, gxm_XtUnrealizeWidget_w, 1, 0, 0, H_XtUnrealizeWidget);
- XM_DEFINE_PROCEDURE(XtDestroyWidget, gxm_XtDestroyWidget_w, 1, 0, 0, H_XtDestroyWidget);
- XM_DEFINE_PROCEDURE(XtSetSensitive, gxm_XtSetSensitive_w, 2, 0, 0, H_XtSetSensitive);
- XM_DEFINE_PROCEDURE(XtNameToWidget, gxm_XtNameToWidget_w, 2, 0, 0, H_XtNameToWidget);
- XM_DEFINE_PROCEDURE(XtWindowToWidget, gxm_XtWindowToWidget_w, 2, 0, 0, H_XtWindowToWidget);
- XM_DEFINE_PROCEDURE(XtMergeArgLists, gxm_XtMergeArgLists_w, 4, 0, 0, H_XtMergeArgLists);
- XM_DEFINE_PROCEDURE(XtVaCreateArgsList, gxm_XtVaCreateArgsList_w, 2, 0, 0, H_XtVaCreateArgsList);
- XM_DEFINE_PROCEDURE(XtDisplay, gxm_XtDisplay_w, 1, 0, 0, H_XtDisplay);
- XM_DEFINE_PROCEDURE(XtDisplayOfObject, gxm_XtDisplayOfObject_w, 1, 0, 0, H_XtDisplayOfObject);
- XM_DEFINE_PROCEDURE(XtScreen, gxm_XtScreen_w, 1, 0, 0, H_XtScreen);
- XM_DEFINE_PROCEDURE(XtScreenOfObject, gxm_XtScreenOfObject_w, 1, 0, 0, H_XtScreenOfObject);
- XM_DEFINE_PROCEDURE(XtWindow, gxm_XtWindow_w, 1, 0, 0, H_XtWindow);
- XM_DEFINE_PROCEDURE(XtWindowOfObject, gxm_XtWindowOfObject_w, 1, 0, 0, H_XtWindowOfObject);
- XM_DEFINE_PROCEDURE(XtName, gxm_XtName_w, 1, 0, 0, H_XtName);
- XM_DEFINE_PROCEDURE(XtSuperclass, gxm_XtSuperclass_w, 1, 0, 0, H_XtSuperclass);
- XM_DEFINE_PROCEDURE(XtClass, gxm_XtClass_w, 1, 0, 0, H_XtClass);
- XM_DEFINE_PROCEDURE(XtParent, gxm_XtParent_w, 1, 0, 0, H_XtParent);
- XM_DEFINE_PROCEDURE(XtAddCallback, gxm_XtAddCallback_w, 3, 1, 0, H_XtAddCallback);
- XM_DEFINE_PROCEDURE(XtRemoveCallback, gxm_XtRemoveCallback_w, 3, 0, 0, H_XtRemoveCallback);
- XM_DEFINE_PROCEDURE(XtAddCallbacks, gxm_XtAddCallbacks_w, 3, 0, 0, H_XtAddCallbacks);
- XM_DEFINE_PROCEDURE(XtRemoveCallbacks, gxm_XtRemoveCallbacks_w, 3, 0, 0, H_XtRemoveCallbacks);
- XM_DEFINE_PROCEDURE(XtRemoveAllCallbacks, gxm_XtRemoveAllCallbacks_w, 2, 0, 0, H_XtRemoveAllCallbacks);
- XM_DEFINE_PROCEDURE(XtCallCallbacks, gxm_XtCallCallbacks_w, 3, 0, 0, H_XtCallCallbacks);
- XM_DEFINE_PROCEDURE(XtHasCallbacks, gxm_XtHasCallbacks_w, 2, 0, 0, H_XtHasCallbacks);
- XM_DEFINE_PROCEDURE(XtCreatePopupShell, gxm_XtCreatePopupShell_w, 4, 1, 0, H_XtCreatePopupShell);
- XM_DEFINE_PROCEDURE(XtVaCreatePopupShell, gxm_XtVaCreatePopupShell_w, 4, 0, 0, H_XtVaCreatePopupShell);
- XM_DEFINE_PROCEDURE(XtPopup, gxm_XtPopup_w, 2, 0, 0, H_XtPopup);
- XM_DEFINE_PROCEDURE(XtPopupSpringLoaded, gxm_XtPopupSpringLoaded_w, 1, 0, 0, H_XtPopupSpringLoaded);
- XM_DEFINE_PROCEDURE(XtCallbackNone, gxm_XtCallbackNone_w, 3, 0, 0, H_XtCallbackNone);
- XM_DEFINE_PROCEDURE(XtCallbackNonexclusive, gxm_XtCallbackNonexclusive_w, 3, 0, 0, H_XtCallbackNonexclusive);
- XM_DEFINE_PROCEDURE(XtCallbackExclusive, gxm_XtCallbackExclusive_w, 3, 0, 0, H_XtCallbackExclusive);
- XM_DEFINE_PROCEDURE(XtPopdown, gxm_XtPopdown_w, 1, 0, 0, H_XtPopdown);
- XM_DEFINE_PROCEDURE(XtCallbackPopdown, gxm_XtCallbackPopdown_w, 3, 0, 0, H_XtCallbackPopdown);
- XM_DEFINE_PROCEDURE(XtCreateWidget, gxm_XtCreateWidget_w, 4, 1, 0, H_XtCreateWidget);
- XM_DEFINE_PROCEDURE(XtCreateManagedWidget, gxm_XtCreateManagedWidget_w, 4, 1, 0, H_XtCreateManagedWidget);
- XM_DEFINE_PROCEDURE(XtVaCreateWidget, gxm_XtVaCreateWidget_w, 4, 0, 0, H_XtVaCreateWidget);
- XM_DEFINE_PROCEDURE(XtVaCreateManagedWidget, gxm_XtVaCreateManagedWidget_w, 4, 0, 0, H_XtVaCreateManagedWidget);
- XM_DEFINE_PROCEDURE(XtAppCreateShell, gxm_XtAppCreateShell_w, 5, 1, 0, H_XtAppCreateShell);
- XM_DEFINE_PROCEDURE(XtVaAppCreateShell, gxm_XtVaAppCreateShell_w, 5, 0, 0, H_XtVaAppCreateShell);
- XM_DEFINE_PROCEDURE(XtToolkitInitialize, gxm_XtToolkitInitialize_w, 0, 0, 0, H_XtToolkitInitialize);
- XM_DEFINE_PROCEDURE(XtSetLanguageProc, gxm_XtSetLanguageProc_w, 3, 0, 0, H_XtSetLanguageProc);
- XM_DEFINE_PROCEDURE(XtDisplayInitialize, gxm_XtDisplayInitialize_w, 6, 0, 0, H_XtDisplayInitialize);
- XM_DEFINE_PROCEDURE(XtOpenApplication, gxm_XtOpenApplication_w, 5, 1, 0, H_XtOpenApplication);
- XM_DEFINE_PROCEDURE(XtVaOpenApplication, gxm_XtVaOpenApplication_w, 5, 1, 0, H_XtVaOpenApplication);
- XM_DEFINE_PROCEDURE(XtAppInitialize, gxm_XtAppInitialize_w, 4, 1, 0, H_XtAppInitialize);
- XM_DEFINE_PROCEDURE(XtVaAppInitialize, gxm_XtVaAppInitialize_w, 4, 1, 0, H_XtVaAppInitialize);
- XM_DEFINE_PROCEDURE(XtOpenDisplay, gxm_XtOpenDisplay_w, 6, 0, 0, H_XtOpenDisplay);
- XM_DEFINE_PROCEDURE(XtCreateApplicationContext, gxm_XtCreateApplicationContext_w, 0, 0, 0, H_XtCreateApplicationContext);
- XM_DEFINE_PROCEDURE(XtDestroyApplicationContext, gxm_XtDestroyApplicationContext_w, 1, 0, 0, H_XtDestroyApplicationContext);
- XM_DEFINE_PROCEDURE(XtAppSetFallbackResources, gxm_XtAppSetFallbackResources_w, 2, 0, 0, H_XtAppSetFallbackResources);
- XM_DEFINE_PROCEDURE(XtInitializeWidgetClass, gxm_XtInitializeWidgetClass_w, 1, 0, 0, H_XtInitializeWidgetClass);
- XM_DEFINE_PROCEDURE(XtWidgetToApplicationContext, gxm_XtWidgetToApplicationContext_w, 1, 0, 0, H_XtWidgetToApplicationContext);
- XM_DEFINE_PROCEDURE(XtDisplayToApplicationContext, gxm_XtDisplayToApplicationContext_w, 1, 0, 0, H_XtDisplayToApplicationContext);
- XM_DEFINE_PROCEDURE(XtCloseDisplay, gxm_XtCloseDisplay_w, 1, 0, 0, H_XtCloseDisplay);
- XM_DEFINE_PROCEDURE(XtSetValues, gxm_XtSetValues_w, 2, 1, 0, H_XtSetValues);
- XM_DEFINE_PROCEDURE(XtVaSetValues, gxm_XtVaSetValues_w, 2, 0, 0, H_XtVaSetValues);
- XM_DEFINE_PROCEDURE(XtGetValues, gxm_XtGetValues_w, 2, 1, 0, H_XtGetValues);
- XM_DEFINE_PROCEDURE(XtVaGetValues, gxm_XtVaGetValues_w, 2, 0, 0, H_XtVaGetValues);
- XM_DEFINE_PROCEDURE(XtAppSetErrorMsgHandler, gxm_XtAppSetErrorMsgHandler_w, 2, 0, 0, H_XtAppSetErrorMsgHandler);
- XM_DEFINE_PROCEDURE(XtAppSetWarningMsgHandler, gxm_XtAppSetWarningMsgHandler_w, 2, 0, 0, H_XtAppSetWarningMsgHandler);
- XM_DEFINE_PROCEDURE(XtAppErrorMsg, gxm_XtAppErrorMsg_w, 7, 0, 0, H_XtAppErrorMsg);
- XM_DEFINE_PROCEDURE(XtAppWarningMsg, gxm_XtAppWarningMsg_w, 7, 0, 0, H_XtAppWarningMsg);
- XM_DEFINE_PROCEDURE(XtAppSetErrorHandler, gxm_XtAppSetErrorHandler_w, 2, 0, 0, H_XtAppSetErrorHandler);
- XM_DEFINE_PROCEDURE(XtAppSetWarningHandler, gxm_XtAppSetWarningHandler_w, 2, 0, 0, H_XtAppSetWarningHandler);
- XM_DEFINE_PROCEDURE(XtAppError, gxm_XtAppError_w, 2, 0, 0, H_XtAppError);
- XM_DEFINE_PROCEDURE(XtMalloc, gxm_XtMalloc_w, 1, 0, 0, H_XtMalloc);
- XM_DEFINE_PROCEDURE(XtCalloc, gxm_XtCalloc_w, 2, 0, 0, H_XtCalloc);
- XM_DEFINE_PROCEDURE(XtRealloc, gxm_XtRealloc_w, 2, 0, 0, H_XtRealloc);
- XM_DEFINE_PROCEDURE(XtFree, gxm_XtFree_w, 1, 0, 0, H_XtFree);
- XM_DEFINE_PROCEDURE(XtAppAddWorkProc, gxm_XtAppAddWorkProc_w, 2, 1, 0, H_XtAppAddWorkProc);
- XM_DEFINE_PROCEDURE(XtRemoveWorkProc, gxm_XtRemoveWorkProc_w, 1, 0, 0, H_XtRemoveWorkProc);
- XM_DEFINE_PROCEDURE(XtGetGC, gxm_XtGetGC_w, 3, 0, 0, H_XtGetGC);
- XM_DEFINE_PROCEDURE(XtAllocateGC, gxm_XtAllocateGC_w, 6, 0, 0, H_XtAllocateGC);
- XM_DEFINE_PROCEDURE(XtDestroyGC, gxm_XtDestroyGC_w, 1, 0, 0, H_XtDestroyGC);
- XM_DEFINE_PROCEDURE(XtReleaseGC, gxm_XtReleaseGC_w, 2, 0, 0, H_XtReleaseGC);
- XM_DEFINE_PROCEDURE(XtFindFile, gxm_XtFindFile_w, 4, 0, 0, H_XtFindFile);
- XM_DEFINE_PROCEDURE(XtResolvePathname, gxm_XtResolvePathname_w, 8, 0, 0, H_XtResolvePathname);
- XM_DEFINE_PROCEDURE(XtDisownSelection, gxm_XtDisownSelection_w, 3, 0, 0, H_XtDisownSelection);
- XM_DEFINE_PROCEDURE(XtGetSelectionValue, gxm_XtGetSelectionValue_w, 6, 0, 0, H_XtGetSelectionValue);
- XM_DEFINE_PROCEDURE(XtGetSelectionValues, gxm_XtGetSelectionValues_w, 7, 0, 0, H_XtGetSelectionValues);
- XM_DEFINE_PROCEDURE(XtAppSetSelectionTimeout, gxm_XtAppSetSelectionTimeout_w, 2, 0, 0, H_XtAppSetSelectionTimeout);
- XM_DEFINE_PROCEDURE(XtAppGetSelectionTimeout, gxm_XtAppGetSelectionTimeout_w, 1, 0, 0, H_XtAppGetSelectionTimeout);
- XM_DEFINE_PROCEDURE(XtGetSelectionRequest, gxm_XtGetSelectionRequest_w, 3, 0, 0, H_XtGetSelectionRequest);
- XM_DEFINE_PROCEDURE(XtGetSelectionValueIncremental, gxm_XtGetSelectionValueIncremental_w, 6, 0, 0, H_XtGetSelectionValueIncremental);
- XM_DEFINE_PROCEDURE(XtGetSelectionValuesIncremental, gxm_XtGetSelectionValuesIncremental_w, 7, 0, 0, H_XtGetSelectionValuesIncremental);
- XM_DEFINE_PROCEDURE(XtCreateSelectionRequest, gxm_XtCreateSelectionRequest_w, 2, 0, 0, H_XtCreateSelectionRequest);
- XM_DEFINE_PROCEDURE(XtSendSelectionRequest, gxm_XtSendSelectionRequest_w, 3, 0, 0, H_XtSendSelectionRequest);
- XM_DEFINE_PROCEDURE(XtCancelSelectionRequest, gxm_XtCancelSelectionRequest_w, 2, 0, 0, H_XtCancelSelectionRequest);
- XM_DEFINE_PROCEDURE(XtGrabKey, gxm_XtGrabKey_w, 6, 0, 0, H_XtGrabKey);
- XM_DEFINE_PROCEDURE(XtUngrabKey, gxm_XtUngrabKey_w, 3, 0, 0, H_XtUngrabKey);
- XM_DEFINE_PROCEDURE(XtGrabKeyboard, gxm_XtGrabKeyboard_w, 5, 0, 0, H_XtGrabKeyboard);
- XM_DEFINE_PROCEDURE(XtUngrabKeyboard, gxm_XtUngrabKeyboard_w, 2, 0, 0, H_XtUngrabKeyboard);
- XM_DEFINE_PROCEDURE(XtGrabButton, gxm_XtGrabButton_w, 9, 0, 0, H_XtGrabButton);
- XM_DEFINE_PROCEDURE(XtUngrabButton, gxm_XtUngrabButton_w, 3, 0, 0, H_XtUngrabButton);
- XM_DEFINE_PROCEDURE(XtGrabPointer, gxm_XtGrabPointer_w, 8, 0, 0, H_XtGrabPointer);
- XM_DEFINE_PROCEDURE(XtUngrabPointer, gxm_XtUngrabPointer_w, 2, 0, 0, H_XtUngrabPointer);
- XM_DEFINE_PROCEDURE(XtGetApplicationNameAndClass, gxm_XtGetApplicationNameAndClass_w, 1, 0, 0, H_XtGetApplicationNameAndClass);
- XM_DEFINE_PROCEDURE(XtGetDisplays, gxm_XtGetDisplays_w, 1, 0, 0, H_XtGetDisplays);
- XM_DEFINE_PROCEDURE(XtToolkitThreadInitialize, gxm_XtToolkitThreadInitialize_w, 0, 0, 0, H_XtToolkitThreadInitialize);
- XM_DEFINE_PROCEDURE(XtAppLock, gxm_XtAppLock_w, 1, 0, 0, H_XtAppLock);
- XM_DEFINE_PROCEDURE(XtAppUnlock, gxm_XtAppUnlock_w, 1, 0, 0, H_XtAppUnlock);
- XM_DEFINE_PROCEDURE(XtIsRectObj, gxm_XtIsRectObj_w, 1, 0, 0, H_XtIsRectObj);
- XM_DEFINE_PROCEDURE(XtIsWidget, gxm_XtIsWidget_w, 1, 0, 0, H_XtIsWidget);
- XM_DEFINE_PROCEDURE(XtIsComposite, gxm_XtIsComposite_w, 1, 0, 0, H_XtIsComposite);
- XM_DEFINE_PROCEDURE(XtIsConstraint, gxm_XtIsConstraint_w, 1, 0, 0, H_XtIsConstraint);
- XM_DEFINE_PROCEDURE(XtIsShell, gxm_XtIsShell_w, 1, 0, 0, H_XtIsShell);
- XM_DEFINE_PROCEDURE(XtIsOverrideShell, gxm_XtIsOverrideShell_w, 1, 0, 0, H_XtIsOverrideShell);
- XM_DEFINE_PROCEDURE(XtIsWMShell, gxm_XtIsWMShell_w, 1, 0, 0, H_XtIsWMShell);
- XM_DEFINE_PROCEDURE(XtIsVendorShell, gxm_XtIsVendorShell_w, 1, 0, 0, H_XtIsVendorShell);
- XM_DEFINE_PROCEDURE(XtIsTransientShell, gxm_XtIsTransientShell_w, 1, 0, 0, H_XtIsTransientShell);
- XM_DEFINE_PROCEDURE(XtIsTopLevelShell, gxm_XtIsTopLevelShell_w, 1, 0, 0, H_XtIsTopLevelShell);
- XM_DEFINE_PROCEDURE(XtIsApplicationShell, gxm_XtIsApplicationShell_w, 1, 0, 0, H_XtIsApplicationShell);
- XM_DEFINE_PROCEDURE(XtIsSessionShell, gxm_XtIsSessionShell_w, 1, 0, 0, H_XtIsSessionShell);
- XM_DEFINE_PROCEDURE(XtMapWidget, gxm_XtMapWidget_w, 1, 0, 0, H_XtMapWidget);
- XM_DEFINE_PROCEDURE(XtUnmapWidget, gxm_XtUnmapWidget_w, 1, 0, 0, H_XtUnmapWidget);
-#endif
- XM_DEFINE_PROCEDURE(XUniqueContext, gxm_XUniqueContext_w, 0, 0, 0, H_XUniqueContext);
- XM_DEFINE_PROCEDURE(XLoadQueryFont, gxm_XLoadQueryFont_w, 2, 0, 0, H_XLoadQueryFont);
- XM_DEFINE_PROCEDURE(XQueryFont, gxm_XQueryFont_w, 2, 0, 0, H_XQueryFont);
- XM_DEFINE_PROCEDURE(XGetMotionEvents, gxm_XGetMotionEvents_w, 4, 0, 0, H_XGetMotionEvents);
- XM_DEFINE_PROCEDURE(XDeleteModifiermapEntry, gxm_XDeleteModifiermapEntry_w, 3, 0, 0, H_XDeleteModifiermapEntry);
- XM_DEFINE_PROCEDURE(XGetModifierMapping, gxm_XGetModifierMapping_w, 1, 0, 0, H_XGetModifierMapping);
- XM_DEFINE_PROCEDURE(XInsertModifiermapEntry, gxm_XInsertModifiermapEntry_w, 3, 0, 0, H_XInsertModifiermapEntry);
- XM_DEFINE_PROCEDURE(XNewModifiermap, gxm_XNewModifiermap_w, 1, 0, 0, H_XNewModifiermap);
- XM_DEFINE_PROCEDURE(XCreateImage, gxm_XCreateImage_w, 0, 0, 1, H_XCreateImage);
- XM_DEFINE_PROCEDURE(XGetImage, gxm_XGetImage_w, 8, 0, 0, H_XGetImage);
- XM_DEFINE_PROCEDURE(XGetSubImage, gxm_XGetSubImage_w, 0, 0, 1, H_XGetSubImage);
- XM_DEFINE_PROCEDURE(XOpenDisplay, gxm_XOpenDisplay_w, 1, 0, 0, H_XOpenDisplay);
- XM_DEFINE_PROCEDURE(XFetchBytes, gxm_XFetchBytes_w, 1, 0, 0, H_XFetchBytes);
- XM_DEFINE_PROCEDURE(XFetchBuffer, gxm_XFetchBuffer_w, 2, 0, 0, H_XFetchBuffer);
- XM_DEFINE_PROCEDURE(XGetAtomName, gxm_XGetAtomName_w, 2, 0, 0, H_XGetAtomName);
- XM_DEFINE_PROCEDURE(XDisplayName, gxm_XDisplayName_w, 1, 0, 0, H_XDisplayName);
- XM_DEFINE_PROCEDURE(XKeysymToString, gxm_XKeysymToString_w, 1, 0, 0, H_XKeysymToString);
- XM_DEFINE_PROCEDURE(XSynchronize, gxm_XSynchronize_w, 2, 0, 0, H_XSynchronize);
- XM_DEFINE_PROCEDURE(XSetAfterFunction, gxm_XSetAfterFunction_w, 2, 0, 0, H_XSetAfterFunction);
- XM_DEFINE_PROCEDURE(XInternAtom, gxm_XInternAtom_w, 3, 0, 0, H_XInternAtom);
- XM_DEFINE_PROCEDURE(XCopyColormapAndFree, gxm_XCopyColormapAndFree_w, 2, 0, 0, H_XCopyColormapAndFree);
- XM_DEFINE_PROCEDURE(XCreateColormap, gxm_XCreateColormap_w, 4, 0, 0, H_XCreateColormap);
- XM_DEFINE_PROCEDURE(XCreatePixmapCursor, gxm_XCreatePixmapCursor_w, 7, 0, 0, H_XCreatePixmapCursor);
- XM_DEFINE_PROCEDURE(XCreateGlyphCursor, gxm_XCreateGlyphCursor_w, 7, 0, 0, H_XCreateGlyphCursor);
- XM_DEFINE_PROCEDURE(XCreateFontCursor, gxm_XCreateFontCursor_w, 2, 0, 0, H_XCreateFontCursor);
- XM_DEFINE_PROCEDURE(XLoadFont, gxm_XLoadFont_w, 2, 0, 0, H_XLoadFont);
- XM_DEFINE_PROCEDURE(XCreateGC, gxm_XCreateGC_w, 4, 0, 0, H_XCreateGC);
- XM_DEFINE_PROCEDURE(XFlushGC, gxm_XFlushGC_w, 2, 0, 0, H_XFlushGC);
- XM_DEFINE_PROCEDURE(XCreatePixmap, gxm_XCreatePixmap_w, 5, 0, 0, H_XCreatePixmap);
- XM_DEFINE_PROCEDURE(XCreateBitmapFromData, gxm_XCreateBitmapFromData_w, 5, 0, 0, H_XCreateBitmapFromData);
- XM_DEFINE_PROCEDURE(XCreatePixmapFromBitmapData, gxm_XCreatePixmapFromBitmapData_w, 8, 0, 0, H_XCreatePixmapFromBitmapData);
- XM_DEFINE_PROCEDURE(XCreateSimpleWindow, gxm_XCreateSimpleWindow_w, 9, 0, 0, H_XCreateSimpleWindow);
- XM_DEFINE_PROCEDURE(XGetSelectionOwner, gxm_XGetSelectionOwner_w, 2, 0, 0, H_XGetSelectionOwner);
- XM_DEFINE_PROCEDURE(XCreateWindow, gxm_XCreateWindow_w, 0, 0, 1, H_XCreateWindow);
- XM_DEFINE_PROCEDURE(XListInstalledColormaps, gxm_XListInstalledColormaps_w, 2, 0, 0, H_XListInstalledColormaps);
- XM_DEFINE_PROCEDURE(XListFonts, gxm_XListFonts_w, 3, 0, 0, H_XListFonts);
- XM_DEFINE_PROCEDURE(XListFontsWithInfo, gxm_XListFontsWithInfo_w, 3, 0, 0, H_XListFontsWithInfo);
- XM_DEFINE_PROCEDURE(XGetFontPath, gxm_XGetFontPath_w, 1, 0, 0, H_XGetFontPath);
- XM_DEFINE_PROCEDURE(XListExtensions, gxm_XListExtensions_w, 1, 0, 0, H_XListExtensions);
- XM_DEFINE_PROCEDURE(XListProperties, gxm_XListProperties_w, 2, 0, 0, H_XListProperties);
- XM_DEFINE_PROCEDURE(XKeycodeToKeysym, gxm_XKeycodeToKeysym_w, 3, 0, 0, H_XKeycodeToKeysym);
- XM_DEFINE_PROCEDURE(XLookupKeysym, gxm_XLookupKeysym_w, 2, 0, 0, H_XLookupKeysym);
- XM_DEFINE_PROCEDURE(XGetKeyboardMapping, gxm_XGetKeyboardMapping_w, 3, 0, 0, H_XGetKeyboardMapping);
- XM_DEFINE_PROCEDURE(XStringToKeysym, gxm_XStringToKeysym_w, 1, 0, 0, H_XStringToKeysym);
- XM_DEFINE_PROCEDURE(XMaxRequestSize, gxm_XMaxRequestSize_w, 1, 0, 0, H_XMaxRequestSize);
- XM_DEFINE_PROCEDURE(XExtendedMaxRequestSize, gxm_XExtendedMaxRequestSize_w, 1, 0, 0, H_XExtendedMaxRequestSize);
- XM_DEFINE_PROCEDURE(XDisplayMotionBufferSize, gxm_XDisplayMotionBufferSize_w, 1, 0, 0, H_XDisplayMotionBufferSize);
- XM_DEFINE_PROCEDURE(XVisualIDFromVisual, gxm_XVisualIDFromVisual_w, 1, 0, 0, H_XVisualIDFromVisual);
- XM_DEFINE_PROCEDURE(XRootWindow, gxm_XRootWindow_w, 2, 0, 0, H_RootWindow);
- XM_DEFINE_PROCEDURE(XDefaultRootWindow, gxm_XDefaultRootWindow_w, 1, 0, 0, H_DefaultRootWindow);
- XM_DEFINE_PROCEDURE(XRootWindowOfScreen, gxm_XRootWindowOfScreen_w, 1, 0, 0, H_RootWindowOfScreen);
- XM_DEFINE_PROCEDURE(XDefaultVisual, gxm_XDefaultVisual_w, 2, 0, 0, H_DefaultVisual);
- XM_DEFINE_PROCEDURE(XDefaultVisualOfScreen, gxm_XDefaultVisualOfScreen_w, 1, 0, 0, H_DefaultVisualOfScreen);
- XM_DEFINE_PROCEDURE(XDefaultGC, gxm_XDefaultGC_w, 2, 0, 0, H_DefaultGC);
- XM_DEFINE_PROCEDURE(XDefaultGCOfScreen, gxm_XDefaultGCOfScreen_w, 1, 0, 0, H_DefaultGCOfScreen);
- XM_DEFINE_PROCEDURE(XBlackPixel, gxm_XBlackPixel_w, 2, 0, 0, H_BlackPixel);
- XM_DEFINE_PROCEDURE(XWhitePixel, gxm_XWhitePixel_w, 2, 0, 0, H_WhitePixel);
- XM_DEFINE_PROCEDURE(XAllPlanes, gxm_XAllPlanes_w, 0, 0, 0, H_AllPlanes);
- XM_DEFINE_PROCEDURE(XBlackPixelOfScreen, gxm_XBlackPixelOfScreen_w, 1, 0, 0, H_BlackPixelOfScreen);
- XM_DEFINE_PROCEDURE(XWhitePixelOfScreen, gxm_XWhitePixelOfScreen_w, 1, 0, 0, H_WhitePixelOfScreen);
- XM_DEFINE_PROCEDURE(XNextRequest, gxm_XNextRequest_w, 1, 0, 0, H_NextRequest);
- XM_DEFINE_PROCEDURE(XLastKnownRequestProcessed, gxm_XLastKnownRequestProcessed_w, 1, 0, 0, H_LastKnownRequestProcessed);
- XM_DEFINE_PROCEDURE(XServerVendor, gxm_XServerVendor_w, 1, 0, 0, H_ServerVendor);
- XM_DEFINE_PROCEDURE(XDisplayString, gxm_XDisplayString_w, 1, 0, 0, H_DisplayString);
- XM_DEFINE_PROCEDURE(XDefaultColormap, gxm_XDefaultColormap_w, 2, 0, 0, H_DefaultColormap);
- XM_DEFINE_PROCEDURE(XDefaultColormapOfScreen, gxm_XDefaultColormapOfScreen_w, 1, 0, 0, H_DefaultColormapOfScreen);
- XM_DEFINE_PROCEDURE(XDisplayOfScreen, gxm_XDisplayOfScreen_w, 1, 0, 0, H_DisplayOfScreen);
- XM_DEFINE_PROCEDURE(XScreenOfDisplay, gxm_XScreenOfDisplay_w, 2, 0, 0, H_ScreenOfDisplay);
- XM_DEFINE_PROCEDURE(XDefaultScreenOfDisplay, gxm_XDefaultScreenOfDisplay_w, 1, 0, 0, H_XDefaultScreenOfDisplay);
- XM_DEFINE_PROCEDURE(XEventMaskOfScreen, gxm_XEventMaskOfScreen_w, 1, 0, 0, H_EventMaskOfScreen);
- XM_DEFINE_PROCEDURE(XScreenNumberOfScreen, gxm_XScreenNumberOfScreen_w, 1, 0, 0, H_XScreenNumberOfScreen);
- XM_DEFINE_PROCEDURE(XSetErrorHandler, gxm_XSetErrorHandler_w, 1, 0, 0, H_XSetErrorHandler);
- XM_DEFINE_PROCEDURE(XSetIOErrorHandler, gxm_XSetIOErrorHandler_w, 1, 0, 0, H_XSetIOErrorHandler);
- XM_DEFINE_PROCEDURE(XListPixmapFormats, gxm_XListPixmapFormats_w, 1, 0, 0, H_XListPixmapFormats);
- XM_DEFINE_PROCEDURE(XListDepths, gxm_XListDepths_w, 2, 0, 0, H_XListDepths);
- XM_DEFINE_PROCEDURE(XReconfigureWMWindow, gxm_XReconfigureWMWindow_w, 5, 0, 0, H_XReconfigureWMWindow);
- XM_DEFINE_PROCEDURE(XGetWMProtocols, gxm_XGetWMProtocols_w, 2, 0, 0, H_XGetWMProtocols);
- XM_DEFINE_PROCEDURE(XSetWMProtocols, gxm_XSetWMProtocols_w, 4, 0, 0, H_XSetWMProtocols);
- XM_DEFINE_PROCEDURE(XIconifyWindow, gxm_XIconifyWindow_w, 3, 0, 0, H_XIconifyWindow);
- XM_DEFINE_PROCEDURE(XWithdrawWindow, gxm_XWithdrawWindow_w, 3, 0, 0, H_XWithdrawWindow);
- XM_DEFINE_PROCEDURE(XGetCommand, gxm_XGetCommand_w, 2, 0, 0, H_XGetCommand);
- XM_DEFINE_PROCEDURE(XGetWMColormapWindows, gxm_XGetWMColormapWindows_w, 2, 0, 0, H_XGetWMColormapWindows);
- XM_DEFINE_PROCEDURE(XSetWMColormapWindows, gxm_XSetWMColormapWindows_w, 4, 0, 0, H_XSetWMColormapWindows);
- XM_DEFINE_PROCEDURE(XSetTransientForHint, gxm_XSetTransientForHint_w, 3, 0, 0, H_XSetTransientForHint);
- XM_DEFINE_PROCEDURE(XActivateScreenSaver, gxm_XActivateScreenSaver_w, 1, 0, 0, H_XActivateScreenSaver);
- XM_DEFINE_PROCEDURE(XAllocColor, gxm_XAllocColor_w, 3, 0, 0, H_XAllocColor);
- XM_DEFINE_PROCEDURE(XAllocColorCells, gxm_XAllocColorCells_w, 5, 0, 0, H_XAllocColorCells);
- XM_DEFINE_PROCEDURE(XAllocColorPlanes, gxm_XAllocColorPlanes_w, 0, 0, 1, H_XAllocColorPlanes);
- XM_DEFINE_PROCEDURE(XAllocNamedColor, gxm_XAllocNamedColor_w, 5, 0, 0, H_XAllocNamedColor);
- XM_DEFINE_PROCEDURE(XAllowEvents, gxm_XAllowEvents_w, 3, 0, 0, H_XAllowEvents);
- XM_DEFINE_PROCEDURE(XAutoRepeatOff, gxm_XAutoRepeatOff_w, 1, 0, 0, H_XAutoRepeatOff);
- XM_DEFINE_PROCEDURE(XAutoRepeatOn, gxm_XAutoRepeatOn_w, 1, 0, 0, H_XAutoRepeatOn);
- XM_DEFINE_PROCEDURE(XBell, gxm_XBell_w, 2, 0, 0, H_XBell);
- XM_DEFINE_PROCEDURE(XBitmapBitOrder, gxm_XBitmapBitOrder_w, 1, 0, 0, H_BitmapBitOrder);
- XM_DEFINE_PROCEDURE(XBitmapPad, gxm_XBitmapPad_w, 1, 0, 0, H_BitmapPad);
- XM_DEFINE_PROCEDURE(XBitmapUnit, gxm_XBitmapUnit_w, 1, 0, 0, H_BitmapUnit);
- XM_DEFINE_PROCEDURE(XCellsOfScreen, gxm_XCellsOfScreen_w, 1, 0, 0, H_CellsOfScreen);
- XM_DEFINE_PROCEDURE(XChangeActivePointerGrab, gxm_XChangeActivePointerGrab_w, 4, 0, 0, H_XChangeActivePointerGrab);
- XM_DEFINE_PROCEDURE(XChangeGC, gxm_XChangeGC_w, 4, 0, 0, H_XChangeGC);
- XM_DEFINE_PROCEDURE(XChangeKeyboardControl, gxm_XChangeKeyboardControl_w, 3, 0, 0, H_XChangeKeyboardControl);
- XM_DEFINE_PROCEDURE(XChangeKeyboardMapping, gxm_XChangeKeyboardMapping_w, 5, 0, 0, H_XChangeKeyboardMapping);
- XM_DEFINE_PROCEDURE(XChangePointerControl, gxm_XChangePointerControl_w, 6, 0, 0, H_XChangePointerControl);
- XM_DEFINE_PROCEDURE(XChangeProperty, gxm_XChangeProperty_w, 7, 1, 0, H_XChangeProperty);
- XM_DEFINE_PROCEDURE(XChangeWindowAttributes, gxm_XChangeWindowAttributes_w, 4, 0, 0, H_XChangeWindowAttributes);
- XM_DEFINE_PROCEDURE(XCheckIfEvent, gxm_XCheckIfEvent_w, 3, 0, 0, H_XCheckIfEvent);
- XM_DEFINE_PROCEDURE(XCheckMaskEvent, gxm_XCheckMaskEvent_w, 2, 0, 0, H_XCheckMaskEvent);
- XM_DEFINE_PROCEDURE(XCheckTypedEvent, gxm_XCheckTypedEvent_w, 2, 0, 0, H_XCheckTypedEvent);
- XM_DEFINE_PROCEDURE(XCheckTypedWindowEvent, gxm_XCheckTypedWindowEvent_w, 3, 0, 0, H_XCheckTypedWindowEvent);
- XM_DEFINE_PROCEDURE(XCheckWindowEvent, gxm_XCheckWindowEvent_w, 3, 0, 0, H_XCheckWindowEvent);
- XM_DEFINE_PROCEDURE(XCirculateSubwindows, gxm_XCirculateSubwindows_w, 3, 0, 0, H_XCirculateSubwindows);
- XM_DEFINE_PROCEDURE(XCirculateSubwindowsDown, gxm_XCirculateSubwindowsDown_w, 2, 0, 0, H_XCirculateSubwindowsDown);
- XM_DEFINE_PROCEDURE(XCirculateSubwindowsUp, gxm_XCirculateSubwindowsUp_w, 2, 0, 0, H_XCirculateSubwindowsUp);
- XM_DEFINE_PROCEDURE(XClearArea, gxm_XClearArea_w, 7, 0, 0, H_XClearArea);
- XM_DEFINE_PROCEDURE(XClearWindow, gxm_XClearWindow_w, 2, 0, 0, H_XClearWindow);
- XM_DEFINE_PROCEDURE(XCloseDisplay, gxm_XCloseDisplay_w, 1, 0, 0, H_XCloseDisplay);
- XM_DEFINE_PROCEDURE(XConfigureWindow, gxm_XConfigureWindow_w, 4, 0, 0, H_XConfigureWindow);
- XM_DEFINE_PROCEDURE(XConnectionNumber, gxm_XConnectionNumber_w, 1, 0, 0, H_XConnectionNumber);
- XM_DEFINE_PROCEDURE(XConvertSelection, gxm_XConvertSelection_w, 6, 0, 0, H_XConvertSelection);
- XM_DEFINE_PROCEDURE(XCopyArea, gxm_XCopyArea_w, 0, 0, 1, H_XCopyArea);
- XM_DEFINE_PROCEDURE(XCopyGC, gxm_XCopyGC_w, 4, 0, 0, H_XCopyGC);
- XM_DEFINE_PROCEDURE(XCopyPlane, gxm_XCopyPlane_w, 0, 0, 1, H_XCopyPlane);
- XM_DEFINE_PROCEDURE(XDefaultDepth, gxm_XDefaultDepth_w, 2, 0, 0, H_XDefaultDepth);
- XM_DEFINE_PROCEDURE(XDefaultDepthOfScreen, gxm_XDefaultDepthOfScreen_w, 1, 0, 0, H_XDefaultDepthOfScreen);
- XM_DEFINE_PROCEDURE(XDefaultScreen, gxm_XDefaultScreen_w, 1, 0, 0, H_XDefaultScreen);
- XM_DEFINE_PROCEDURE(XDefineCursor, gxm_XDefineCursor_w, 3, 0, 0, H_XDefineCursor);
- XM_DEFINE_PROCEDURE(XDeleteProperty, gxm_XDeleteProperty_w, 3, 0, 0, H_XDeleteProperty);
- XM_DEFINE_PROCEDURE(XDestroyWindow, gxm_XDestroyWindow_w, 2, 0, 0, H_XDestroyWindow);
- XM_DEFINE_PROCEDURE(XDestroySubwindows, gxm_XDestroySubwindows_w, 2, 0, 0, H_XDestroySubwindows);
- XM_DEFINE_PROCEDURE(XDoesBackingStore, gxm_XDoesBackingStore_w, 1, 0, 0, H_XDoesBackingStore);
- XM_DEFINE_PROCEDURE(XDoesSaveUnders, gxm_XDoesSaveUnders_w, 1, 0, 0, H_XDoesSaveUnders);
- XM_DEFINE_PROCEDURE(XDisableAccessControl, gxm_XDisableAccessControl_w, 1, 0, 0, H_XDisableAccessControl);
- XM_DEFINE_PROCEDURE(XDisplayCells, gxm_XDisplayCells_w, 2, 0, 0, H_XDisplayCells);
- XM_DEFINE_PROCEDURE(XDisplayHeight, gxm_XDisplayHeight_w, 2, 0, 0, H_XDisplayHeight);
- XM_DEFINE_PROCEDURE(XDisplayHeightMM, gxm_XDisplayHeightMM_w, 2, 0, 0, H_XDisplayHeightMM);
- XM_DEFINE_PROCEDURE(XDisplayKeycodes, gxm_XDisplayKeycodes_w, 1, 0, 0, H_XDisplayKeycodes);
- XM_DEFINE_PROCEDURE(XDisplayPlanes, gxm_XDisplayPlanes_w, 2, 0, 0, H_XDisplayPlanes);
- XM_DEFINE_PROCEDURE(XDisplayWidth, gxm_XDisplayWidth_w, 2, 0, 0, H_XDisplayWidth);
- XM_DEFINE_PROCEDURE(XDisplayWidthMM, gxm_XDisplayWidthMM_w, 2, 0, 0, H_XDisplayWidthMM);
- XM_DEFINE_PROCEDURE(XDrawArc, gxm_XDrawArc_w, 9, 0, 0, H_XDrawArc);
- XM_DEFINE_PROCEDURE(XDrawArcs, gxm_XDrawArcs_w, 5, 0, 0, H_XDrawArcs);
- XM_DEFINE_PROCEDURE(XDrawImageString, gxm_XDrawImageString_w, 7, 0, 0, H_XDrawImageString);
- XM_DEFINE_PROCEDURE(XDrawLine, gxm_XDrawLine_w, 7, 0, 0, H_XDrawLine);
- XM_DEFINE_PROCEDURE(XDrawLines, gxm_XDrawLines_w, 6, 0, 0, H_XDrawLines);
- XM_DEFINE_PROCEDURE(XDrawLinesDirect, gxm_XDrawLinesDirect_w, 6, 0, 0, H_XDrawLinesDirect);
- XM_DEFINE_PROCEDURE(freeXPoints, gxm_FreeXPoints_w, 1, 0, 0, H_freeXPoints);
- XM_DEFINE_PROCEDURE(vector->XPoints, gxm_Vector2XPoints_w, 1, 0, 0, H_vector2XPoints);
- XM_DEFINE_PROCEDURE(XDrawPoint, gxm_XDrawPoint_w, 5, 0, 0, H_XDrawPoint);
- XM_DEFINE_PROCEDURE(XDrawPoints, gxm_XDrawPoints_w, 6, 0, 0, H_XDrawPoints);
- XM_DEFINE_PROCEDURE(XDrawRectangle, gxm_XDrawRectangle_w, 7, 0, 0, H_XDrawRectangle);
- XM_DEFINE_PROCEDURE(XDrawRectangles, gxm_XDrawRectangles_w, 5, 0, 0, H_XDrawRectangles);
- XM_DEFINE_PROCEDURE(XDrawSegments, gxm_XDrawSegments_w, 5, 0, 0, H_XDrawSegments);
- XM_DEFINE_PROCEDURE(XDrawString, gxm_XDrawString_w, 7, 0, 0, H_XDrawString);
- XM_DEFINE_PROCEDURE(XDrawText, gxm_XDrawText_w, 6, 1, 0, H_XDrawText);
- XM_DEFINE_PROCEDURE(XEnableAccessControl, gxm_XEnableAccessControl_w, 1, 0, 0, H_XEnableAccessControl);
- XM_DEFINE_PROCEDURE(XEventsQueued, gxm_XEventsQueued_w, 2, 0, 0, H_XEventsQueued);
- XM_DEFINE_PROCEDURE(XFetchName, gxm_XFetchName_w, 2, 0, 0, H_XFetchName);
- XM_DEFINE_PROCEDURE(XFillArc, gxm_XFillArc_w, 9, 0, 0, H_XFillArc);
- XM_DEFINE_PROCEDURE(XFillArcs, gxm_XFillArcs_w, 5, 0, 0, H_XFillArcs);
- XM_DEFINE_PROCEDURE(XFillPolygon, gxm_XFillPolygon_w, 7, 0, 0, H_XFillPolygon);
- XM_DEFINE_PROCEDURE(XFillRectangle, gxm_XFillRectangle_w, 7, 0, 0, H_XFillRectangle);
- XM_DEFINE_PROCEDURE(XFillRectangles, gxm_XFillRectangles_w, 5, 0, 0, H_XFillRectangles);
- XM_DEFINE_PROCEDURE(XFlush, gxm_XFlush_w, 1, 0, 0, H_XFlush);
- XM_DEFINE_PROCEDURE(XForceScreenSaver, gxm_XForceScreenSaver_w, 2, 0, 0, H_XForceScreenSaver);
- XM_DEFINE_PROCEDURE(XFree, gxm_XFree_w, 1, 0, 0, H_XFree);
- XM_DEFINE_PROCEDURE(XFreeColormap, gxm_XFreeColormap_w, 2, 0, 0, H_XFreeColormap);
- XM_DEFINE_PROCEDURE(XFreeColors, gxm_XFreeColors_w, 5, 0, 0, H_XFreeColors);
- XM_DEFINE_PROCEDURE(XFreeCursor, gxm_XFreeCursor_w, 2, 0, 0, H_XFreeCursor);
- XM_DEFINE_PROCEDURE(XFreeExtensionList, gxm_XFreeExtensionList_w, 1, 0, 0, "XFreeExtensionList(list) frees list (from XListExtensions)");
- XM_DEFINE_PROCEDURE(XFreeFont, gxm_XFreeFont_w, 2, 0, 0, H_XFreeFont);
- XM_DEFINE_PROCEDURE(XFreeFontInfo, gxm_XFreeFontInfo_w, 3, 0, 0, H_XFreeFontInfo);
- XM_DEFINE_PROCEDURE(XFreeFontNames, gxm_XFreeFontNames_w, 1, 0, 0, H_XFreeFontNames);
- XM_DEFINE_PROCEDURE(XFreeFontPath, gxm_XFreeFontPath_w, 1, 0, 0, H_XFreeFontPath);
- XM_DEFINE_PROCEDURE(XFreeGC, gxm_XFreeGC_w, 2, 0, 0, H_XFreeGC);
- XM_DEFINE_PROCEDURE(XFreeModifiermap, gxm_XFreeModifiermap_w, 1, 0, 0, H_XFreeModifiermap);
- XM_DEFINE_PROCEDURE(XFreePixmap, gxm_XFreePixmap_w, 2, 0, 0, H_XFreePixmap);
- XM_DEFINE_PROCEDURE(XGeometry, gxm_XGeometry_w, 0, 0, 1, H_XGeometry);
- XM_DEFINE_PROCEDURE(XGetErrorText, gxm_XGetErrorText_w, 4, 0, 0, H_XGetErrorText);
- XM_DEFINE_PROCEDURE(XGetFontProperty, gxm_XGetFontProperty_w, 2, 0, 0, H_XGetFontProperty);
- XM_DEFINE_PROCEDURE(XGetGCValues, gxm_XGetGCValues_w, 3, 0, 0, H_XGetGCValues);
- XM_DEFINE_PROCEDURE(XGCValues, gxm_XGCValues_w, 0, 0, 0, "XGCValues returns a new XGCValue struct");
- XM_DEFINE_PROCEDURE(XEvent, gxm_XEvent_w, 0, 1, 0, "XEvent returns a new XEvent struct");
- XM_DEFINE_PROCEDURE(XGetGeometry, gxm_XGetGeometry_w, 2, 0, 0, H_XGetGeometry);
- XM_DEFINE_PROCEDURE(XGetIconName, gxm_XGetIconName_w, 2, 0, 0, H_XGetIconName);
- XM_DEFINE_PROCEDURE(XGetInputFocus, gxm_XGetInputFocus_w, 1, 0, 0, H_XGetInputFocus);
- XM_DEFINE_PROCEDURE(XGetKeyboardControl, gxm_XGetKeyboardControl_w, 1, 0, 0, H_XGetKeyboardControl);
- XM_DEFINE_PROCEDURE(XGetPointerControl, gxm_XGetPointerControl_w, 1, 0, 0, H_XGetPointerControl);
- XM_DEFINE_PROCEDURE(XGetPointerMapping, gxm_XGetPointerMapping_w, 3, 0, 0, H_XGetPointerMapping);
- XM_DEFINE_PROCEDURE(XGetScreenSaver, gxm_XGetScreenSaver_w, 1, 0, 0, H_XGetScreenSaver);
- XM_DEFINE_PROCEDURE(XGetTransientForHint, gxm_XGetTransientForHint_w, 2, 0, 0, H_XGetTransientForHint);
- XM_DEFINE_PROCEDURE(XGetWindowProperty, gxm_XGetWindowProperty_w, 0, 0, 1, H_XGetWindowProperty);
- XM_DEFINE_PROCEDURE(XGetWindowAttributes, gxm_XGetWindowAttributes_w, 2, 0, 0, H_XGetWindowAttributes);
- XM_DEFINE_PROCEDURE(XGrabButton, gxm_XGrabButton_w, 0, 0, 1, H_XGrabButton);
- XM_DEFINE_PROCEDURE(XGrabKey, gxm_XGrabKey_w, 7, 0, 0, H_XGrabKey);
- XM_DEFINE_PROCEDURE(XGrabKeyboard, gxm_XGrabKeyboard_w, 6, 0, 0, H_XGrabKeyboard);
- XM_DEFINE_PROCEDURE(XGrabPointer, gxm_XGrabPointer_w, 9, 0, 0, H_XGrabPointer);
- XM_DEFINE_PROCEDURE(XGrabServer, gxm_XGrabServer_w, 1, 0, 0, H_XGrabServer);
- XM_DEFINE_PROCEDURE(XHeightMMOfScreen, gxm_XHeightMMOfScreen_w, 1, 0, 0, H_HeightMMOfScreen);
- XM_DEFINE_PROCEDURE(XHeightOfScreen, gxm_XHeightOfScreen_w, 1, 0, 0, H_HeightOfScreen);
- XM_DEFINE_PROCEDURE(XIfEvent, gxm_XIfEvent_w, 3, 0, 0, H_XIfEvent);
- XM_DEFINE_PROCEDURE(XImageByteOrder, gxm_XImageByteOrder_w, 1, 0, 0, H_ImageByteOrder);
- XM_DEFINE_PROCEDURE(XInstallColormap, gxm_XInstallColormap_w, 2, 0, 0, H_XInstallColormap);
- XM_DEFINE_PROCEDURE(XKeysymToKeycode, gxm_XKeysymToKeycode_w, 2, 0, 0, H_XKeysymToKeycode);
- XM_DEFINE_PROCEDURE(XKillClient, gxm_XKillClient_w, 2, 0, 0, H_XKillClient);
- XM_DEFINE_PROCEDURE(XLookupColor, gxm_XLookupColor_w, 5, 0, 0, H_XLookupColor);
- XM_DEFINE_PROCEDURE(XLowerWindow, gxm_XLowerWindow_w, 2, 0, 0, H_XLowerWindow);
- XM_DEFINE_PROCEDURE(XMapRaised, gxm_XMapRaised_w, 2, 0, 0, H_XMapRaised);
- XM_DEFINE_PROCEDURE(XMapSubwindows, gxm_XMapSubwindows_w, 2, 0, 0, H_XMapSubwindows);
- XM_DEFINE_PROCEDURE(XMapWindow, gxm_XMapWindow_w, 2, 0, 0, H_XMapWindow);
- XM_DEFINE_PROCEDURE(XMaskEvent, gxm_XMaskEvent_w, 2, 0, 0, H_XMaskEvent);
- XM_DEFINE_PROCEDURE(XMaxCmapsOfScreen, gxm_XMaxCmapsOfScreen_w, 1, 0, 0, H_MaxCmapsOfScreen);
- XM_DEFINE_PROCEDURE(XMinCmapsOfScreen, gxm_XMinCmapsOfScreen_w, 1, 0, 0, H_MinCmapsOfScreen);
- XM_DEFINE_PROCEDURE(XMoveResizeWindow, gxm_XMoveResizeWindow_w, 6, 0, 0, H_XMoveResizeWindow);
- XM_DEFINE_PROCEDURE(XMoveWindow, gxm_XMoveWindow_w, 4, 0, 0, H_XMoveWindow);
- XM_DEFINE_PROCEDURE(XNextEvent, gxm_XNextEvent_w, 1, 0, 0, H_XNextEvent);
- XM_DEFINE_PROCEDURE(XNoOp, gxm_XNoOp_w, 1, 0, 0, H_XNoOp);
- XM_DEFINE_PROCEDURE(XParseColor, gxm_XParseColor_w, 4, 0, 0, H_XParseColor);
- XM_DEFINE_PROCEDURE(XParseGeometry, gxm_XParseGeometry_w, 1, 0, 0, H_XParseGeometry);
- XM_DEFINE_PROCEDURE(XPeekEvent, gxm_XPeekEvent_w, 1, 0, 0, H_XPeekEvent);
- XM_DEFINE_PROCEDURE(XPeekIfEvent, gxm_XPeekIfEvent_w, 3, 0, 0, H_XPeekIfEvent);
- XM_DEFINE_PROCEDURE(XPending, gxm_XPending_w, 1, 0, 0, H_XPending);
- XM_DEFINE_PROCEDURE(XPlanesOfScreen, gxm_XPlanesOfScreen_w, 1, 0, 0, H_PlanesOfScreen);
- XM_DEFINE_PROCEDURE(XProtocolRevision, gxm_XProtocolRevision_w, 1, 0, 0, H_ProtocolRevision);
- XM_DEFINE_PROCEDURE(XProtocolVersion, gxm_XProtocolVersion_w, 1, 0, 0, H_ProtocolVersion);
- XM_DEFINE_PROCEDURE(XPutBackEvent, gxm_XPutBackEvent_w, 2, 0, 0, H_XPutBackEvent);
- XM_DEFINE_PROCEDURE(XPutImage, gxm_XPutImage_w, 0, 0, 1, H_XPutImage);
- XM_DEFINE_PROCEDURE(XQLength, gxm_XQLength_w, 1, 0, 0, H_QLength);
- XM_DEFINE_PROCEDURE(XQueryBestCursor, gxm_XQueryBestCursor_w, 4, 0, 0, H_XQueryBestCursor);
- XM_DEFINE_PROCEDURE(XQueryBestSize, gxm_XQueryBestSize_w, 5, 0, 0, H_XQueryBestSize);
- XM_DEFINE_PROCEDURE(XQueryBestStipple, gxm_XQueryBestStipple_w, 4, 0, 0, H_XQueryBestStipple);
- XM_DEFINE_PROCEDURE(XQueryBestTile, gxm_XQueryBestTile_w, 4, 0, 0, H_XQueryBestTile);
- XM_DEFINE_PROCEDURE(XQueryColor, gxm_XQueryColor_w, 3, 0, 0, H_XQueryColor);
- XM_DEFINE_PROCEDURE(XQueryColors, gxm_XQueryColors_w, 3, 1, 0, H_XQueryColors);
- XM_DEFINE_PROCEDURE(XQueryExtension, gxm_XQueryExtension_w, 2, 0, 0, H_XQueryExtension);
- XM_DEFINE_PROCEDURE(XQueryKeymap, gxm_XQueryKeymap_w, 1, 0, 0, H_XQueryKeymap);
- XM_DEFINE_PROCEDURE(XQueryPointer, gxm_XQueryPointer_w, 2, 0, 0, H_XQueryPointer);
- XM_DEFINE_PROCEDURE(XQueryTextExtents, gxm_XQueryTextExtents_w, 3, 0, 0, H_XQueryTextExtents);
- XM_DEFINE_PROCEDURE(XQueryTree, gxm_XQueryTree_w, 2, 0, 0, H_XQueryTree);
- XM_DEFINE_PROCEDURE(XRaiseWindow, gxm_XRaiseWindow_w, 2, 0, 0, H_XRaiseWindow);
- XM_DEFINE_PROCEDURE(XReadBitmapFile, gxm_XReadBitmapFile_w, 3, 0, 0, H_XReadBitmapFile);
- XM_DEFINE_PROCEDURE(XReadBitmapFileData, gxm_XReadBitmapFileData_w, 1, 0, 0, H_XReadBitmapFileData);
- XM_DEFINE_PROCEDURE(XRebindKeysym, gxm_XRebindKeysym_w, 6, 0, 0, H_XRebindKeysym);
- XM_DEFINE_PROCEDURE(XRecolorCursor, gxm_XRecolorCursor_w, 4, 0, 0, H_XRecolorCursor);
- XM_DEFINE_PROCEDURE(XRefreshKeyboardMapping, gxm_XRefreshKeyboardMapping_w, 1, 0, 0, H_XRefreshKeyboardMapping);
- XM_DEFINE_PROCEDURE(XReparentWindow, gxm_XReparentWindow_w, 5, 0, 0, H_XReparentWindow);
- XM_DEFINE_PROCEDURE(XResetScreenSaver, gxm_XResetScreenSaver_w, 1, 0, 0, H_XResetScreenSaver);
- XM_DEFINE_PROCEDURE(XResizeWindow, gxm_XResizeWindow_w, 4, 0, 0, H_XResizeWindow);
- XM_DEFINE_PROCEDURE(XRestackWindows, gxm_XRestackWindows_w, 3, 0, 0, H_XRestackWindows);
- XM_DEFINE_PROCEDURE(XRotateBuffers, gxm_XRotateBuffers_w, 2, 0, 0, H_XRotateBuffers);
- XM_DEFINE_PROCEDURE(XRotateWindowProperties, gxm_XRotateWindowProperties_w, 5, 0, 0, H_XRotateWindowProperties);
- XM_DEFINE_PROCEDURE(XScreenCount, gxm_XScreenCount_w, 1, 0, 0, H_ScreenCount);
- XM_DEFINE_PROCEDURE(XSelectInput, gxm_XSelectInput_w, 3, 0, 0, H_XSelectInput);
- XM_DEFINE_PROCEDURE(XSendEvent, gxm_XSendEvent_w, 5, 0, 0, H_XSendEvent);
- XM_DEFINE_PROCEDURE(XSetAccessControl, gxm_XSetAccessControl_w, 2, 0, 0, H_XSetAccessControl);
- XM_DEFINE_PROCEDURE(XSetArcMode, gxm_XSetArcMode_w, 3, 0, 0, H_XSetArcMode);
- XM_DEFINE_PROCEDURE(XSetBackground, gxm_XSetBackground_w, 3, 0, 0, H_XSetBackground);
- XM_DEFINE_PROCEDURE(XSetClipMask, gxm_XSetClipMask_w, 3, 0, 0, H_XSetClipMask);
- XM_DEFINE_PROCEDURE(XSetClipOrigin, gxm_XSetClipOrigin_w, 4, 0, 0, H_XSetClipOrigin);
- XM_DEFINE_PROCEDURE(XSetClipRectangles, gxm_XSetClipRectangles_w, 7, 0, 0, H_XSetClipRectangles);
- XM_DEFINE_PROCEDURE(XSetCloseDownMode, gxm_XSetCloseDownMode_w, 2, 0, 0, H_XSetCloseDownMode);
- XM_DEFINE_PROCEDURE(XSetCommand, gxm_XSetCommand_w, 4, 0, 0, H_XSetCommand);
- XM_DEFINE_PROCEDURE(XSetDashes, gxm_XSetDashes_w, 4, 1, 0, H_XSetDashes);
- XM_DEFINE_PROCEDURE(XSetFillRule, gxm_XSetFillRule_w, 3, 0, 0, H_XSetFillRule);
- XM_DEFINE_PROCEDURE(XSetFillStyle, gxm_XSetFillStyle_w, 3, 0, 0, H_XSetFillStyle);
- XM_DEFINE_PROCEDURE(XSetFont, gxm_XSetFont_w, 3, 0, 0, H_XSetFont);
- XM_DEFINE_PROCEDURE(XSetFontPath, gxm_XSetFontPath_w, 3, 0, 0, H_XSetFontPath);
- XM_DEFINE_PROCEDURE(XSetForeground, gxm_XSetForeground_w, 3, 0, 0, H_XSetForeground);
- XM_DEFINE_PROCEDURE(XSetFunction, gxm_XSetFunction_w, 3, 0, 0, H_XSetFunction);
- XM_DEFINE_PROCEDURE(XSetGraphicsExposures, gxm_XSetGraphicsExposures_w, 3, 0, 0, H_XSetGraphicsExposures);
- XM_DEFINE_PROCEDURE(XSetIconName, gxm_XSetIconName_w, 3, 0, 0, H_XSetIconName);
- XM_DEFINE_PROCEDURE(XSetInputFocus, gxm_XSetInputFocus_w, 4, 0, 0, H_XSetInputFocus);
- XM_DEFINE_PROCEDURE(XSetLineAttributes, gxm_XSetLineAttributes_w, 6, 0, 0, H_XSetLineAttributes);
- XM_DEFINE_PROCEDURE(XSetModifierMapping, gxm_XSetModifierMapping_w, 2, 0, 0, H_XSetModifierMapping);
- XM_DEFINE_PROCEDURE(XSetPlaneMask, gxm_XSetPlaneMask_w, 3, 0, 0, H_XSetPlaneMask);
- XM_DEFINE_PROCEDURE(XSetPointerMapping, gxm_XSetPointerMapping_w, 2, 1, 0, H_XSetPointerMapping);
- XM_DEFINE_PROCEDURE(XSetScreenSaver, gxm_XSetScreenSaver_w, 5, 0, 0, H_XSetScreenSaver);
- XM_DEFINE_PROCEDURE(XSetSelectionOwner, gxm_XSetSelectionOwner_w, 4, 0, 0, H_XSetSelectionOwner);
- XM_DEFINE_PROCEDURE(XSetState, gxm_XSetState_w, 6, 0, 0, H_XSetState);
- XM_DEFINE_PROCEDURE(XSetStipple, gxm_XSetStipple_w, 3, 0, 0, H_XSetStipple);
- XM_DEFINE_PROCEDURE(XSetSubwindowMode, gxm_XSetSubwindowMode_w, 3, 0, 0, H_XSetSubwindowMode);
- XM_DEFINE_PROCEDURE(XSetTSOrigin, gxm_XSetTSOrigin_w, 4, 0, 0, H_XSetTSOrigin);
- XM_DEFINE_PROCEDURE(XSetTile, gxm_XSetTile_w, 3, 0, 0, H_XSetTile);
- XM_DEFINE_PROCEDURE(XSetWindowBackground, gxm_XSetWindowBackground_w, 3, 0, 0, H_XSetWindowBackground);
- XM_DEFINE_PROCEDURE(XSetWindowBackgroundPixmap, gxm_XSetWindowBackgroundPixmap_w, 3, 0, 0, H_XSetWindowBackgroundPixmap);
- XM_DEFINE_PROCEDURE(XSetWindowBorder, gxm_XSetWindowBorder_w, 3, 0, 0, H_XSetWindowBorder);
- XM_DEFINE_PROCEDURE(XSetWindowBorderPixmap, gxm_XSetWindowBorderPixmap_w, 3, 0, 0, H_XSetWindowBorderPixmap);
- XM_DEFINE_PROCEDURE(XSetWindowBorderWidth, gxm_XSetWindowBorderWidth_w, 3, 0, 0, H_XSetWindowBorderWidth);
- XM_DEFINE_PROCEDURE(XSetWindowColormap, gxm_XSetWindowColormap_w, 3, 0, 0, H_XSetWindowColormap);
- XM_DEFINE_PROCEDURE(XStoreBuffer, gxm_XStoreBuffer_w, 4, 0, 0, H_XStoreBuffer);
- XM_DEFINE_PROCEDURE(XStoreBytes, gxm_XStoreBytes_w, 3, 0, 0, H_XStoreBytes);
- XM_DEFINE_PROCEDURE(XStoreColor, gxm_XStoreColor_w, 3, 0, 0, H_XStoreColor);
- XM_DEFINE_PROCEDURE(XStoreColors, gxm_XStoreColors_w, 4, 0, 0, H_XStoreColors);
- XM_DEFINE_PROCEDURE(XStoreName, gxm_XStoreName_w, 3, 0, 0, H_XStoreName);
- XM_DEFINE_PROCEDURE(XStoreNamedColor, gxm_XStoreNamedColor_w, 5, 0, 0, H_XStoreNamedColor);
- XM_DEFINE_PROCEDURE(XSync, gxm_XSync_w, 2, 0, 0, H_XSync);
- XM_DEFINE_PROCEDURE(XTextExtents, gxm_XTextExtents_w, 3, 0, 0, H_XTextExtents);
- XM_DEFINE_PROCEDURE(XTextWidth, gxm_XTextWidth_w, 3, 0, 0, H_XTextWidth);
- XM_DEFINE_PROCEDURE(XTranslateCoordinates, gxm_XTranslateCoordinates_w, 5, 0, 0, H_XTranslateCoordinates);
- XM_DEFINE_PROCEDURE(XUndefineCursor, gxm_XUndefineCursor_w, 2, 0, 0, H_XUndefineCursor);
- XM_DEFINE_PROCEDURE(XUngrabButton, gxm_XUngrabButton_w, 4, 0, 0, H_XUngrabButton);
- XM_DEFINE_PROCEDURE(XUngrabKey, gxm_XUngrabKey_w, 4, 0, 0, H_XUngrabKey);
- XM_DEFINE_PROCEDURE(XUngrabKeyboard, gxm_XUngrabKeyboard_w, 2, 0, 0, H_XUngrabKeyboard);
- XM_DEFINE_PROCEDURE(XUngrabPointer, gxm_XUngrabPointer_w, 2, 0, 0, H_XUngrabPointer);
- XM_DEFINE_PROCEDURE(XUngrabServer, gxm_XUngrabServer_w, 1, 0, 0, H_XUngrabServer);
- XM_DEFINE_PROCEDURE(XUninstallColormap, gxm_XUninstallColormap_w, 2, 0, 0, H_XUninstallColormap);
- XM_DEFINE_PROCEDURE(XUnloadFont, gxm_XUnloadFont_w, 2, 0, 0, H_XUnloadFont);
- XM_DEFINE_PROCEDURE(XUnmapSubwindows, gxm_XUnmapSubwindows_w, 2, 0, 0, H_XUnmapSubwindows);
- XM_DEFINE_PROCEDURE(XUnmapWindow, gxm_XUnmapWindow_w, 2, 0, 0, H_XUnmapWindow);
- XM_DEFINE_PROCEDURE(XVendorRelease, gxm_XVendorRelease_w, 1, 0, 0, H_VendorRelease);
- XM_DEFINE_PROCEDURE(XWarpPointer, gxm_XWarpPointer_w, 9, 0, 0, H_XWarpPointer);
- XM_DEFINE_PROCEDURE(XWidthMMOfScreen, gxm_XWidthMMOfScreen_w, 1, 0, 0, H_WidthMMOfScreen);
- XM_DEFINE_PROCEDURE(XWidthOfScreen, gxm_XWidthOfScreen_w, 1, 0, 0, H_WidthOfScreen);
- XM_DEFINE_PROCEDURE(XWindowEvent, gxm_XWindowEvent_w, 3, 0, 0, H_XWindowEvent);
- XM_DEFINE_PROCEDURE(XWriteBitmapFile, gxm_XWriteBitmapFile_w, 7, 0, 0, H_XWriteBitmapFile);
- XM_DEFINE_PROCEDURE(XSupportsLocale, gxm_XSupportsLocale_w, 0, 0, 0, H_XSupportsLocale);
- XM_DEFINE_PROCEDURE(XSetLocaleModifiers, gxm_XSetLocaleModifiers_w, 1, 0, 0, H_XSetLocaleModifiers);
- XM_DEFINE_PROCEDURE(XCreateFontSet, gxm_XCreateFontSet_w, 2, 0, 0, H_XCreateFontSet);
- XM_DEFINE_PROCEDURE(XFreeFontSet, gxm_XFreeFontSet_w, 2, 0, 0, H_XFreeFontSet);
- XM_DEFINE_PROCEDURE(XFontsOfFontSet, gxm_XFontsOfFontSet_w, 1, 0, 0, H_XFontsOfFontSet);
- XM_DEFINE_PROCEDURE(XBaseFontNameListOfFontSet, gxm_XBaseFontNameListOfFontSet_w, 1, 0, 0, H_XBaseFontNameListOfFontSet);
- XM_DEFINE_PROCEDURE(XLocaleOfFontSet, gxm_XLocaleOfFontSet_w, 1, 0, 0, H_XLocaleOfFontSet);
- XM_DEFINE_PROCEDURE(XContextDependentDrawing, gxm_XContextDependentDrawing_w, 1, 0, 0, H_XContextDependentDrawing);
- XM_DEFINE_PROCEDURE(XDirectionalDependentDrawing, gxm_XDirectionalDependentDrawing_w, 1, 0, 0, H_XDirectionalDependentDrawing);
- XM_DEFINE_PROCEDURE(XContextualDrawing, gxm_XContextualDrawing_w, 1, 0, 0, H_XContextualDrawing);
- XM_DEFINE_PROCEDURE(XFilterEvent, gxm_XFilterEvent_w, 2, 0, 0, H_XFilterEvent);
- XM_DEFINE_PROCEDURE(XAllocIconSize, gxm_XAllocIconSize_w, 0, 0, 0, H_XAllocIconSize);
- XM_DEFINE_PROCEDURE(XAllocStandardColormap, gxm_XAllocStandardColormap_w, 0, 0, 0, H_XAllocStandardColormap);
- XM_DEFINE_PROCEDURE(XAllocWMHints, gxm_XAllocWMHints_w, 0, 0, 0, H_XAllocWMHints);
- XM_DEFINE_PROCEDURE(XClipBox, gxm_XClipBox_w, 1, 0, 0, H_XClipBox);
- XM_DEFINE_PROCEDURE(XCreateRegion, gxm_XCreateRegion_w, 0, 0, 0, H_XCreateRegion);
- XM_DEFINE_PROCEDURE(XDefaultString, gxm_XDefaultString_w, 0, 0, 0, H_XDefaultString);
- XM_DEFINE_PROCEDURE(XDeleteContext, gxm_XDeleteContext_w, 3, 0, 0, H_XDeleteContext);
- XM_DEFINE_PROCEDURE(XDestroyRegion, gxm_XDestroyRegion_w, 1, 0, 0, H_XDestroyRegion);
- XM_DEFINE_PROCEDURE(XEmptyRegion, gxm_XEmptyRegion_w, 1, 0, 0, H_XEmptyRegion);
- XM_DEFINE_PROCEDURE(XEqualRegion, gxm_XEqualRegion_w, 2, 0, 0, H_XEqualRegion);
- XM_DEFINE_PROCEDURE(XFindContext, gxm_XFindContext_w, 3, 0, 0, H_XFindContext);
- XM_DEFINE_PROCEDURE(XGetIconSizes, gxm_XGetIconSizes_w, 2, 0, 0, H_XGetIconSizes);
- XM_DEFINE_PROCEDURE(XGetRGBColormaps, gxm_XGetRGBColormaps_w, 3, 0, 0, H_XGetRGBColormaps);
- XM_DEFINE_PROCEDURE(XGetVisualInfo, gxm_XGetVisualInfo_w, 3, 0, 0, H_XGetVisualInfo);
- XM_DEFINE_PROCEDURE(XGetWMHints, gxm_XGetWMHints_w, 2, 0, 0, H_XGetWMHints);
- XM_DEFINE_PROCEDURE(XIntersectRegion, gxm_XIntersectRegion_w, 3, 0, 0, H_XIntersectRegion);
- XM_DEFINE_PROCEDURE(XConvertCase, gxm_XConvertCase_w, 1, 0, 0, H_XConvertCase);
- XM_DEFINE_PROCEDURE(XLookupString, gxm_XLookupString_w, 1, 0, 0, H_XLookupString);
- XM_DEFINE_PROCEDURE(XMatchVisualInfo, gxm_XMatchVisualInfo_w, 4, 0, 0, H_XMatchVisualInfo);
- XM_DEFINE_PROCEDURE(XOffsetRegion, gxm_XOffsetRegion_w, 3, 0, 0, H_XOffsetRegion);
- XM_DEFINE_PROCEDURE(XPointInRegion, gxm_XPointInRegion_w, 3, 0, 0, H_XPointInRegion);
- XM_DEFINE_PROCEDURE(XPolygonRegion, gxm_XPolygonRegion_w, 3, 0, 0, H_XPolygonRegion);
- XM_DEFINE_PROCEDURE(XRectInRegion, gxm_XRectInRegion_w, 5, 0, 0, H_XRectInRegion);
- XM_DEFINE_PROCEDURE(XSaveContext, gxm_XSaveContext_w, 4, 0, 0, H_XSaveContext);
- XM_DEFINE_PROCEDURE(XSetRGBColormaps, gxm_XSetRGBColormaps_w, 5, 0, 0, H_XSetRGBColormaps);
- XM_DEFINE_PROCEDURE(XSetWMHints, gxm_XSetWMHints_w, 3, 0, 0, H_XSetWMHints);
- XM_DEFINE_PROCEDURE(XSetRegion, gxm_XSetRegion_w, 3, 0, 0, H_XSetRegion);
- XM_DEFINE_PROCEDURE(XSetWMProperties, gxm_XSetWMProperties_w, 8, 0, 0, H_XSetWMProperties);
- XM_DEFINE_PROCEDURE(XShrinkRegion, gxm_XShrinkRegion_w, 3, 0, 0, H_XShrinkRegion);
- XM_DEFINE_PROCEDURE(XSubtractRegion, gxm_XSubtractRegion_w, 3, 0, 0, H_XSubtractRegion);
- XM_DEFINE_PROCEDURE(XUnionRectWithRegion, gxm_XUnionRectWithRegion_w, 3, 0, 0, H_XUnionRectWithRegion);
- XM_DEFINE_PROCEDURE(XUnionRegion, gxm_XUnionRegion_w, 3, 0, 0, H_XUnionRegion);
- XM_DEFINE_PROCEDURE(XXorRegion, gxm_XXorRegion_w, 3, 0, 0, H_XXorRegion);
-
- XM_DEFINE_PROCEDURE(DefaultScreen, gxm_DefaultScreen_w, 1, 0, 0, H_DefaultScreen);
- XM_DEFINE_PROCEDURE(DefaultRootWindow, gxm_DefaultRootWindow_w, 1, 0, 0, H_DefaultRootWindow);
- XM_DEFINE_PROCEDURE(QLength, gxm_QLength_w, 1, 0, 0, H_QLength);
- XM_DEFINE_PROCEDURE(ScreenCount, gxm_ScreenCount_w, 1, 0, 0, H_ScreenCount);
- XM_DEFINE_PROCEDURE(ServerVendor, gxm_ServerVendor_w, 1, 0, 0, H_ServerVendor);
- XM_DEFINE_PROCEDURE(ProtocolVersion, gxm_ProtocolVersion_w, 1, 0, 0, H_ProtocolVersion);
- XM_DEFINE_PROCEDURE(ProtocolRevision, gxm_ProtocolRevision_w, 1, 0, 0, H_ProtocolRevision);
- XM_DEFINE_PROCEDURE(VendorRelease, gxm_VendorRelease_w, 1, 0, 0, H_VendorRelease);
- XM_DEFINE_PROCEDURE(DisplayString, gxm_DisplayString_w, 1, 0, 0, H_DisplayString);
- XM_DEFINE_PROCEDURE(BitmapUnit, gxm_BitmapUnit_w, 1, 0, 0, H_BitmapUnit);
- XM_DEFINE_PROCEDURE(BitmapBitOrder, gxm_BitmapBitOrder_w, 1, 0, 0, H_BitmapBitOrder);
- XM_DEFINE_PROCEDURE(BitmapPad, gxm_BitmapPad_w, 1, 0, 0, H_BitmapPad);
- XM_DEFINE_PROCEDURE(ImageByteOrder, gxm_ImageByteOrder_w, 1, 0, 0, H_ImageByteOrder);
- XM_DEFINE_PROCEDURE(NextRequest, gxm_NextRequest_w, 1, 0, 0, H_NextRequest);
- XM_DEFINE_PROCEDURE(LastKnownRequestProcessed, gxm_LastKnownRequestProcessed_w, 1, 0, 0, H_LastKnownRequestProcessed);
- XM_DEFINE_PROCEDURE(DefaultScreenOfDisplay, gxm_DefaultScreenOfDisplay_w, 1, 0, 0, H_DefaultScreenOfDisplay);
- XM_DEFINE_PROCEDURE(DisplayOfScreen, gxm_DisplayOfScreen_w, 1, 0, 0, H_DisplayOfScreen);
- XM_DEFINE_PROCEDURE(RootWindowOfScreen, gxm_RootWindowOfScreen_w, 1, 0, 0, H_RootWindowOfScreen);
- XM_DEFINE_PROCEDURE(BlackPixelOfScreen, gxm_BlackPixelOfScreen_w, 1, 0, 0, H_BlackPixelOfScreen);
- XM_DEFINE_PROCEDURE(WhitePixelOfScreen, gxm_WhitePixelOfScreen_w, 1, 0, 0, H_WhitePixelOfScreen);
- XM_DEFINE_PROCEDURE(DefaultColormapOfScreen, gxm_DefaultColormapOfScreen_w, 1, 0, 0, H_DefaultColormapOfScreen);
- XM_DEFINE_PROCEDURE(DefaultDepthOfScreen, gxm_DefaultDepthOfScreen_w, 1, 0, 0, H_DefaultDepthOfScreen);
- XM_DEFINE_PROCEDURE(DefaultGCOfScreen, gxm_DefaultGCOfScreen_w, 1, 0, 0, H_DefaultGCOfScreen);
- XM_DEFINE_PROCEDURE(DefaultVisualOfScreen, gxm_DefaultVisualOfScreen_w, 1, 0, 0, H_DefaultVisualOfScreen);
- XM_DEFINE_PROCEDURE(WidthOfScreen, gxm_WidthOfScreen_w, 1, 0, 0, H_WidthOfScreen);
- XM_DEFINE_PROCEDURE(HeightOfScreen, gxm_HeightOfScreen_w, 1, 0, 0, H_HeightOfScreen);
- XM_DEFINE_PROCEDURE(WidthMMOfScreen, gxm_WidthMMOfScreen_w, 1, 0, 0, H_WidthMMOfScreen);
- XM_DEFINE_PROCEDURE(HeightMMOfScreen, gxm_HeightMMOfScreen_w, 1, 0, 0, H_HeightMMOfScreen);
- XM_DEFINE_PROCEDURE(PlanesOfScreen, gxm_PlanesOfScreen_w, 1, 0, 0, H_PlanesOfScreen);
- XM_DEFINE_PROCEDURE(CellsOfScreen, gxm_CellsOfScreen_w, 1, 0, 0, H_CellsOfScreen);
- XM_DEFINE_PROCEDURE(MinCmapsOfScreen, gxm_MinCmapsOfScreen_w, 1, 0, 0, H_MinCmapsOfScreen);
- XM_DEFINE_PROCEDURE(MaxCmapsOfScreen, gxm_MaxCmapsOfScreen_w, 1, 0, 0, H_MaxCmapsOfScreen);
- XM_DEFINE_PROCEDURE(DoesSaveUnders, gxm_DoesSaveUnders_w, 1, 0, 0, H_DoesSaveUnders);
- XM_DEFINE_PROCEDURE(DoesBackingStore, gxm_DoesBackingStore_w, 1, 0, 0, H_DoesBackingStore);
- XM_DEFINE_PROCEDURE(EventMaskOfScreen, gxm_EventMaskOfScreen_w, 1, 0, 0, H_EventMaskOfScreen);
- XM_DEFINE_PROCEDURE(RootWindow, gxm_RootWindow_w, 2, 0, 0, H_RootWindow);
- XM_DEFINE_PROCEDURE(DefaultVisual, gxm_DefaultVisual_w, 2, 0, 0, H_DefaultVisual);
- XM_DEFINE_PROCEDURE(DefaultGC, gxm_DefaultGC_w, 2, 0, 0, H_DefaultGC);
- XM_DEFINE_PROCEDURE(BlackPixel, gxm_BlackPixel_w, 2, 0, 0, H_BlackPixel);
- XM_DEFINE_PROCEDURE(WhitePixel, gxm_WhitePixel_w, 2, 0, 0, H_WhitePixel);
- XM_DEFINE_PROCEDURE(DisplayWidth, gxm_DisplayWidth_w, 2, 0, 0, H_DisplayWidth);
- XM_DEFINE_PROCEDURE(DisplayHeight, gxm_DisplayHeight_w, 2, 0, 0, H_DisplayHeight);
- XM_DEFINE_PROCEDURE(DisplayWidthMM, gxm_DisplayWidthMM_w, 2, 0, 0, H_DisplayWidthMM);
- XM_DEFINE_PROCEDURE(DisplayHeightMM, gxm_DisplayHeightMM_w, 2, 0, 0, H_DisplayHeightMM);
- XM_DEFINE_PROCEDURE(DisplayPlanes, gxm_DisplayPlanes_w, 2, 0, 0, H_DisplayPlanes);
- XM_DEFINE_PROCEDURE(DisplayCells, gxm_DisplayCells_w, 2, 0, 0, H_DisplayCells);
- XM_DEFINE_PROCEDURE(DefaultColormap, gxm_DefaultColormap_w, 2, 0, 0, H_DefaultColormap);
- XM_DEFINE_PROCEDURE(ScreenOfDisplay, gxm_ScreenOfDisplay_w, 2, 0, 0, H_ScreenOfDisplay);
- XM_DEFINE_PROCEDURE(DefaultDepth, gxm_DefaultDepth_w, 2, 0, 0, H_DefaultDepth);
-
- XM_DEFINE_PROCEDURE(IsKeypadKey, gxm_IsKeypadKey_w, 1, 0, 0, H_IsKeypadKey);
- XM_DEFINE_PROCEDURE(IsPrivateKeypadKey, gxm_IsPrivateKeypadKey_w, 1, 0, 0, H_IsPrivateKeypadKey);
- XM_DEFINE_PROCEDURE(IsCursorKey, gxm_IsCursorKey_w, 1, 0, 0, H_IsCursorKey);
- XM_DEFINE_PROCEDURE(IsPFKey, gxm_IsPFKey_w, 1, 0, 0, H_IsPFKey);
- XM_DEFINE_PROCEDURE(IsFunctionKey, gxm_IsFunctionKey_w, 1, 0, 0, H_IsFunctionKey);
- XM_DEFINE_PROCEDURE(IsMiscFunctionKey, gxm_IsMiscFunctionKey_w, 1, 0, 0, H_IsMiscFunctionKey);
- XM_DEFINE_PROCEDURE(IsModifierKey, gxm_IsModifierKey_w, 1, 0, 0, H_IsModifierKey);
-
- XM_DEFINE_PROCEDURE(XButtonEvent?, XEN_XButtonEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XButtonEvent");
- XM_DEFINE_PROCEDURE(XCirculateEvent?, XEN_XCirculateEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XCirculateEvent");
- XM_DEFINE_PROCEDURE(XCirculateRequestEvent?, XEN_XCirculateRequestEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XCirculateRequestEvent");
- XM_DEFINE_PROCEDURE(XClientMessageEvent?, XEN_XClientMessageEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XClientMessageEvent");
- XM_DEFINE_PROCEDURE(XColormapEvent?, XEN_XColormapEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XColormapEvent");
- XM_DEFINE_PROCEDURE(XConfigureEvent?, XEN_XConfigureEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XConfigureEvent");
- XM_DEFINE_PROCEDURE(XConfigureRequestEvent?, XEN_XConfigureRequestEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XConfigureRequestEvent");
- XM_DEFINE_PROCEDURE(XCreateWindowEvent?, XEN_XCreateWindowEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XCreateWindowEvent");
- XM_DEFINE_PROCEDURE(XCrossingEvent?, XEN_XCrossingEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XCrossingEvent");
- XM_DEFINE_PROCEDURE(XDestroyWindowEvent?, XEN_XDestroyWindowEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XDestroyWindowEvent");
- XM_DEFINE_PROCEDURE(XErrorEvent?, XEN_XErrorEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XErrorEvent");
- XM_DEFINE_PROCEDURE(XExposeEvent?, XEN_XExposeEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XExposeEvent");
- XM_DEFINE_PROCEDURE(XFocusChangeEvent?, XEN_XFocusChangeEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XFocusChangeEvent");
- XM_DEFINE_PROCEDURE(XGraphicsExposeEvent?, XEN_XGraphicsExposeEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XGraphicsExposeEvent");
- XM_DEFINE_PROCEDURE(XGravityEvent?, XEN_XGravityEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XGravityEvent");
- XM_DEFINE_PROCEDURE(XKeyEvent?, XEN_XKeyEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XKeyEvent");
- XM_DEFINE_PROCEDURE(XKeymapEvent?, XEN_XKeymapEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XKeymapEvent");
- XM_DEFINE_PROCEDURE(XMapEvent?, XEN_XMapEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XMapEvent");
- XM_DEFINE_PROCEDURE(XMapRequestEvent?, XEN_XMapRequestEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XMapRequestEvent");
- XM_DEFINE_PROCEDURE(XMappingEvent?, XEN_XMappingEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XMappingEvent");
- XM_DEFINE_PROCEDURE(XMotionEvent?, XEN_XMotionEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XMotionEvent");
- XM_DEFINE_PROCEDURE(XNoExposeEvent?, XEN_XNoExposeEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XNoExposeEvent");
- XM_DEFINE_PROCEDURE(XPropertyEvent?, XEN_XPropertyEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XPropertyEvent");
- XM_DEFINE_PROCEDURE(XReparentEvent?, XEN_XReparentEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XReparentEvent");
- XM_DEFINE_PROCEDURE(XResizeRequestEvent?, XEN_XResizeRequestEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XResizeRequestEvent");
- XM_DEFINE_PROCEDURE(XSelectionClearEvent?, XEN_XSelectionClearEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XSelectionClearEvent");
- XM_DEFINE_PROCEDURE(XSelectionEvent?, XEN_XSelectionEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XSelectionEvent");
- XM_DEFINE_PROCEDURE(XSelectionRequestEvent?, XEN_XSelectionRequestEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XSelectionRequestEvent");
- XM_DEFINE_PROCEDURE(XSetWindowAttributes?, XEN_XSetWindowAttributes_p_w, 1, 0, 0, PROC_TRUE " if arg is a XSetWindowAttributes");
- XM_DEFINE_PROCEDURE(XUnmapEvent?, XEN_XUnmapEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XUnmapEvent");
- XM_DEFINE_PROCEDURE(XVisibilityEvent?, XEN_XVisibilityEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XVisibilityEvent");
- XM_DEFINE_PROCEDURE(XIconSize?, XEN_XIconSize_p_w, 1, 0, 0, PROC_TRUE " if arg is a XIconSize object");
-
-#if HAVE_MOTIF
- XM_DEFINE_PROCEDURE(XmCreateMessageBox, gxm_XmCreateMessageBox_w, 3, 1, 0, H_XmCreateMessageBox);
- XM_DEFINE_PROCEDURE(XmCreateMessageDialog, gxm_XmCreateMessageDialog_w, 3, 1, 0, H_XmCreateMessageDialog);
- XM_DEFINE_PROCEDURE(XmCreateErrorDialog, gxm_XmCreateErrorDialog_w, 3, 1, 0, H_XmCreateErrorDialog);
- XM_DEFINE_PROCEDURE(XmCreateInformationDialog, gxm_XmCreateInformationDialog_w, 3, 1, 0, H_XmCreateInformationDialog);
- XM_DEFINE_PROCEDURE(XmCreateQuestionDialog, gxm_XmCreateQuestionDialog_w, 3, 1, 0, H_XmCreateQuestionDialog);
- XM_DEFINE_PROCEDURE(XmCreateWarningDialog, gxm_XmCreateWarningDialog_w, 3, 1, 0, H_XmCreateWarningDialog);
- XM_DEFINE_PROCEDURE(XmCreateWorkingDialog, gxm_XmCreateWorkingDialog_w, 3, 1, 0, H_XmCreateWorkingDialog);
- XM_DEFINE_PROCEDURE(XmCreateTemplateDialog, gxm_XmCreateTemplateDialog_w, 3, 1, 0, H_XmCreateTemplateDialog);
- XM_DEFINE_PROCEDURE(XmMessageBoxGetChild, gxm_XmMessageBoxGetChild_w, 2, 0, 0, H_XmMessageBoxGetChild);
- XM_DEFINE_PROCEDURE(XmCreateArrowButtonGadget, gxm_XmCreateArrowButtonGadget_w, 3, 1, 0, H_XmCreateArrowButtonGadget);
- XM_DEFINE_PROCEDURE(XmCreateArrowButton, gxm_XmCreateArrowButton_w, 3, 1, 0, H_XmCreateArrowButton);
-#if HAVE_XmCreateFontSelector
- XM_DEFINE_PROCEDURE(XmCreateFontSelector, gxm_XmCreateFontSelector_w, 3, 1, 0, H_XmCreateFontSelector);
-#endif
-#if HAVE_XmCreateColorSelector
- XM_DEFINE_PROCEDURE(XmCreateColorSelector, gxm_XmCreateColorSelector_w, 3, 1, 0, H_XmCreateColorSelector);
-#endif
-#if HAVE_XmToolTipGetLabel
- XM_DEFINE_PROCEDURE(XmToolTipGetLabel, gxm_XmToolTipGetLabel_w, 1, 0, 0, H_XmToolTipGetLabel);
-#endif
- XM_DEFINE_PROCEDURE(XmCreateNotebook, gxm_XmCreateNotebook_w, 3, 1, 0, H_XmCreateNotebook);
- XM_DEFINE_PROCEDURE(XmNotebookGetPageInfo, gxm_XmNotebookGetPageInfo_w, 2, 0, 0, H_XmNotebookGetPageInfo);
- XM_DEFINE_PROCEDURE(XmTransferSetParameters, gxm_XmTransferSetParameters_w, 5, 0, 0, H_XmTransferSetParameters);
- XM_DEFINE_PROCEDURE(XmTransferDone, gxm_XmTransferDone_w, 2, 0, 0, H_XmTransferDone);
- XM_DEFINE_PROCEDURE(XmTransferValue, gxm_XmTransferValue_w, 5, 0, 0, H_XmTransferValue);
- XM_DEFINE_PROCEDURE(XmTransferStartRequest, gxm_XmTransferStartRequest_w, 1, 0, 0, H_XmTransferStartRequest);
- XM_DEFINE_PROCEDURE(XmTransferSendRequest, gxm_XmTransferSendRequest_w, 2, 0, 0, H_XmTransferSendRequest);
- XM_DEFINE_PROCEDURE(XmCreateComboBox, gxm_XmCreateComboBox_w, 3, 1, 0, H_XmCreateComboBox);
- XM_DEFINE_PROCEDURE(XmCreateDropDownComboBox, gxm_XmCreateDropDownComboBox_w, 3, 1, 0, H_XmCreateDropDownComboBox);
- XM_DEFINE_PROCEDURE(XmCreateDropDownList, gxm_XmCreateDropDownList_w, 3, 1, 0, H_XmCreateDropDownList);
- XM_DEFINE_PROCEDURE(XmComboBoxAddItem, gxm_XmComboBoxAddItem_w, 4, 0, 0, H_XmComboBoxAddItem);
- XM_DEFINE_PROCEDURE(XmComboBoxDeletePos, gxm_XmComboBoxDeletePos_w, 2, 0, 0, H_XmComboBoxDeletePos);
- XM_DEFINE_PROCEDURE(XmComboBoxSelectItem, gxm_XmComboBoxSelectItem_w, 2, 0, 0, H_XmComboBoxSelectItem);
- XM_DEFINE_PROCEDURE(XmComboBoxSetItem, gxm_XmComboBoxSetItem_w, 2, 0, 0, H_XmComboBoxSetItem);
- XM_DEFINE_PROCEDURE(XmComboBoxUpdate, gxm_XmComboBoxUpdate_w, 1, 0, 0, H_XmComboBoxUpdate);
- XM_DEFINE_PROCEDURE(XmCreateContainer, gxm_XmCreateContainer_w, 3, 1, 0, H_XmCreateContainer);
- XM_DEFINE_PROCEDURE(XmContainerGetItemChildren, gxm_XmContainerGetItemChildren_w, 2, 0, 0, H_XmContainerGetItemChildren);
- XM_DEFINE_PROCEDURE(XmContainerRelayout, gxm_XmContainerRelayout_w, 1, 0, 0, H_XmContainerRelayout);
- XM_DEFINE_PROCEDURE(XmContainerReorder, gxm_XmContainerReorder_w, 3, 0, 0, H_XmContainerReorder);
- XM_DEFINE_PROCEDURE(XmContainerCut, gxm_XmContainerCut_w, 2, 0, 0, H_XmContainerCut);
- XM_DEFINE_PROCEDURE(XmContainerCopy, gxm_XmContainerCopy_w, 2, 0, 0, H_XmContainerCopy);
- XM_DEFINE_PROCEDURE(XmContainerPaste, gxm_XmContainerPaste_w, 1, 0, 0, H_XmContainerPaste);
- XM_DEFINE_PROCEDURE(XmContainerCopyLink, gxm_XmContainerCopyLink_w, 2, 0, 0, H_XmContainerCopyLink);
- XM_DEFINE_PROCEDURE(XmContainerPasteLink, gxm_XmContainerPasteLink_w, 1, 0, 0, H_XmContainerPasteLink);
- XM_DEFINE_PROCEDURE(XmCreateSpinBox, gxm_XmCreateSpinBox_w, 3, 1, 0, H_XmCreateSpinBox);
- XM_DEFINE_PROCEDURE(XmSpinBoxValidatePosition, gxm_XmSpinBoxValidatePosition_w, 1, 0, 0, H_XmSpinBoxValidatePosition);
- XM_DEFINE_PROCEDURE(XmCreateSimpleSpinBox, gxm_XmCreateSimpleSpinBox_w, 3, 1, 0, H_XmCreateSimpleSpinBox);
- XM_DEFINE_PROCEDURE(XmSimpleSpinBoxAddItem, gxm_XmSimpleSpinBoxAddItem_w, 3, 0, 0, H_XmSimpleSpinBoxAddItem);
- XM_DEFINE_PROCEDURE(XmSimpleSpinBoxDeletePos, gxm_XmSimpleSpinBoxDeletePos_w, 2, 0, 0, H_XmSimpleSpinBoxDeletePos);
- XM_DEFINE_PROCEDURE(XmSimpleSpinBoxSetItem, gxm_XmSimpleSpinBoxSetItem_w, 2, 0, 0, H_XmSimpleSpinBoxSetItem);
- XM_DEFINE_PROCEDURE(XmDropSiteRegistered, gxm_XmDropSiteRegistered_w, 1, 0, 0, H_XmDropSiteRegistered);
- XM_DEFINE_PROCEDURE(XmTextFieldCopyLink, gxm_XmTextFieldCopyLink_w, 2, 0, 0, H_XmTextFieldCopyLink);
- XM_DEFINE_PROCEDURE(XmTextFieldPasteLink, gxm_XmTextFieldPasteLink_w, 1, 0, 0, H_XmTextFieldPasteLink);
- XM_DEFINE_PROCEDURE(XmTextGetCenterline, gxm_XmTextGetCenterline_w, 1, 0, 0, H_XmTextGetCenterline);
- XM_DEFINE_PROCEDURE(XmToggleButtonGadgetSetValue, gxm_XmToggleButtonGadgetSetValue_w, 3, 0, 0, H_XmToggleButtonGadgetSetValue);
- XM_DEFINE_PROCEDURE(XmCreateIconGadget, gxm_XmCreateIconGadget_w, 3, 1, 0, H_XmCreateIconGadget);
- XM_DEFINE_PROCEDURE(XmCreateIconHeader, gxm_XmCreateIconHeader_w, 3, 1, 0, H_XmCreateIconHeader);
- XM_DEFINE_PROCEDURE(XmObjectAtPoint, gxm_XmObjectAtPoint_w, 3, 0, 0, H_XmObjectAtPoint);
- XM_DEFINE_PROCEDURE(XmConvertStringToUnits, gxm_XmConvertStringToUnits_w, 4, 0, 0, H_XmConvertStringToUnits);
- XM_DEFINE_PROCEDURE(XmCreateGrabShell, gxm_XmCreateGrabShell_w, 3, 1, 0, H_XmCreateGrabShell);
- XM_DEFINE_PROCEDURE(XmToggleButtonSetValue, gxm_XmToggleButtonSetValue_w, 3, 0, 0, H_XmToggleButtonSetValue);
- XM_DEFINE_PROCEDURE(XmTextPasteLink, gxm_XmTextPasteLink_w, 1, 0, 0, H_XmTextPasteLink);
- XM_DEFINE_PROCEDURE(XmTextCopyLink, gxm_XmTextCopyLink_w, 2, 0, 0, H_XmTextCopyLink);
- XM_DEFINE_PROCEDURE(XmScaleSetTicks, gxm_XmScaleSetTicks_w, 7, 0, 0, H_XmScaleSetTicks);
- XM_DEFINE_PROCEDURE(XmInternAtom, gxm_XmInternAtom_w, 3, 0, 0, H_XmInternAtom);
- XM_DEFINE_PROCEDURE(XmGetAtomName, gxm_XmGetAtomName_w, 2, 0, 0, H_XmGetAtomName);
- XM_DEFINE_PROCEDURE(XmCreatePanedWindow, gxm_XmCreatePanedWindow_w, 3, 1, 0, H_XmCreatePanedWindow);
- XM_DEFINE_PROCEDURE(XmCreateBulletinBoard, gxm_XmCreateBulletinBoard_w, 3, 1, 0, H_XmCreateBulletinBoard);
- XM_DEFINE_PROCEDURE(XmCreateBulletinBoardDialog, gxm_XmCreateBulletinBoardDialog_w, 3, 1, 0, H_XmCreateBulletinBoardDialog);
- XM_DEFINE_PROCEDURE(XmCreateCascadeButtonGadget, gxm_XmCreateCascadeButtonGadget_w, 3, 1, 0, H_XmCreateCascadeButtonGadget);
- XM_DEFINE_PROCEDURE(XmCascadeButtonGadgetHighlight, gxm_XmCascadeButtonGadgetHighlight_w, 2, 0, 0, H_XmCascadeButtonGadgetHighlight);
- XM_DEFINE_PROCEDURE(XmAddProtocols, gxm_XmAddProtocols_w, 3, 1, 0, H_XmAddProtocols);
- XM_DEFINE_PROCEDURE(XmRemoveProtocols, gxm_XmRemoveProtocols_w, 3, 1, 0, H_XmRemoveProtocols);
- XM_DEFINE_PROCEDURE(XmAddProtocolCallback, gxm_XmAddProtocolCallback_w, 5, 0, 0, H_XmAddProtocolCallback);
- XM_DEFINE_PROCEDURE(XmRemoveProtocolCallback, gxm_XmRemoveProtocolCallback_w, 5, 0, 0, H_XmRemoveProtocolCallback);
- XM_DEFINE_PROCEDURE(XmActivateProtocol, gxm_XmActivateProtocol_w, 3, 0, 0, H_XmActivateProtocol);
- XM_DEFINE_PROCEDURE(XmDeactivateProtocol, gxm_XmDeactivateProtocol_w, 3, 0, 0, H_XmDeactivateProtocol);
- XM_DEFINE_PROCEDURE(XmSetProtocolHooks, gxm_XmSetProtocolHooks_w, 7, 0, 0, H_XmSetProtocolHooks);
- XM_DEFINE_PROCEDURE(XmCreateCascadeButton, gxm_XmCreateCascadeButton_w, 3, 1, 0, H_XmCreateCascadeButton);
- XM_DEFINE_PROCEDURE(XmCascadeButtonHighlight, gxm_XmCascadeButtonHighlight_w, 2, 0, 0, H_XmCascadeButtonHighlight);
- XM_DEFINE_PROCEDURE(XmCreatePushButtonGadget, gxm_XmCreatePushButtonGadget_w, 3, 1, 0, H_XmCreatePushButtonGadget);
- XM_DEFINE_PROCEDURE(XmCreatePushButton, gxm_XmCreatePushButton_w, 3, 1, 0, H_XmCreatePushButton);
- XM_DEFINE_PROCEDURE(XmCreateCommand, gxm_XmCreateCommand_w, 3, 1, 0, H_XmCreateCommand);
- XM_DEFINE_PROCEDURE(XmCommandGetChild, gxm_XmCommandGetChild_w, 2, 0, 0, H_XmCommandGetChild);
- XM_DEFINE_PROCEDURE(XmCommandSetValue, gxm_XmCommandSetValue_w, 2, 0, 0, H_XmCommandSetValue);
- XM_DEFINE_PROCEDURE(XmCommandAppendValue, gxm_XmCommandAppendValue_w, 2, 0, 0, H_XmCommandAppendValue);
- XM_DEFINE_PROCEDURE(XmCommandError, gxm_XmCommandError_w, 2, 0, 0, H_XmCommandError);
- XM_DEFINE_PROCEDURE(XmCreateCommandDialog, gxm_XmCreateCommandDialog_w, 3, 1, 0, H_XmCreateCommandDialog);
- XM_DEFINE_PROCEDURE(XmMenuPosition, gxm_XmMenuPosition_w, 2, 0, 0, H_XmMenuPosition);
- XM_DEFINE_PROCEDURE(XmCreateRowColumn, gxm_XmCreateRowColumn_w, 3, 1, 0, H_XmCreateRowColumn);
- XM_DEFINE_PROCEDURE(XmCreateWorkArea, gxm_XmCreateWorkArea_w, 3, 1, 0, H_XmCreateWorkArea);
- XM_DEFINE_PROCEDURE(XmCreateRadioBox, gxm_XmCreateRadioBox_w, 3, 1, 0, H_XmCreateRadioBox);
- XM_DEFINE_PROCEDURE(XmCreateOptionMenu, gxm_XmCreateOptionMenu_w, 3, 1, 0, H_XmCreateOptionMenu);
- XM_DEFINE_PROCEDURE(XmOptionLabelGadget, gxm_XmOptionLabelGadget_w, 1, 0, 0, H_XmOptionLabelGadget);
- XM_DEFINE_PROCEDURE(XmOptionButtonGadget, gxm_XmOptionButtonGadget_w, 1, 0, 0, H_XmOptionButtonGadget);
- XM_DEFINE_PROCEDURE(XmCreateMenuBar, gxm_XmCreateMenuBar_w, 3, 1, 0, H_XmCreateMenuBar);
- XM_DEFINE_PROCEDURE(XmCreatePopupMenu, gxm_XmCreatePopupMenu_w, 3, 1, 0, H_XmCreatePopupMenu);
- XM_DEFINE_PROCEDURE(XmCreatePulldownMenu, gxm_XmCreatePulldownMenu_w, 3, 1, 0, H_XmCreatePulldownMenu);
- XM_DEFINE_PROCEDURE(XmGetPostedFromWidget, gxm_XmGetPostedFromWidget_w, 1, 0, 0, H_XmGetPostedFromWidget);
- XM_DEFINE_PROCEDURE(XmGetTearOffControl, gxm_XmGetTearOffControl_w, 1, 0, 0, H_XmGetTearOffControl);
- XM_DEFINE_PROCEDURE(XmScaleSetValue, gxm_XmScaleSetValue_w, 2, 0, 0, H_XmScaleSetValue);
- XM_DEFINE_PROCEDURE(XmScaleGetValue, gxm_XmScaleGetValue_w, 1, 0, 0, H_XmScaleGetValue);
- XM_DEFINE_PROCEDURE(XmCreateScale, gxm_XmCreateScale_w, 3, 1, 0, H_XmCreateScale);
- XM_DEFINE_PROCEDURE(XmClipboardBeginCopy, gxm_XmClipboardBeginCopy_w, 5, 0, 0, H_XmClipboardBeginCopy);
- XM_DEFINE_PROCEDURE(XmWidgetGetDisplayRect, gxm_XmWidgetGetDisplayRect_w, 1, 0, 0, H_XmWidgetGetDisplayRect);
- XM_DEFINE_PROCEDURE(XmClipboardStartCopy, gxm_XmClipboardStartCopy_w, 6, 0, 0, H_XmClipboardStartCopy);
- XM_DEFINE_PROCEDURE(XmClipboardCopy, gxm_XmClipboardCopy_w, 7, 0, 0, H_XmClipboardCopy);
- XM_DEFINE_PROCEDURE(XmClipboardEndCopy, gxm_XmClipboardEndCopy_w, 3, 0, 0, H_XmClipboardEndCopy);
- XM_DEFINE_PROCEDURE(XmClipboardCancelCopy, gxm_XmClipboardCancelCopy_w, 3, 0, 0, H_XmClipboardCancelCopy);
- XM_DEFINE_PROCEDURE(XmClipboardWithdrawFormat, gxm_XmClipboardWithdrawFormat_w, 3, 0, 0, H_XmClipboardWithdrawFormat);
- XM_DEFINE_PROCEDURE(XmClipboardCopyByName, gxm_XmClipboardCopyByName_w, 6, 0, 0, H_XmClipboardCopyByName);
- XM_DEFINE_PROCEDURE(XmClipboardUndoCopy, gxm_XmClipboardUndoCopy_w, 2, 0, 0, H_XmClipboardUndoCopy);
- XM_DEFINE_PROCEDURE(XmClipboardLock, gxm_XmClipboardLock_w, 2, 0, 0, H_XmClipboardLock);
- XM_DEFINE_PROCEDURE(XmClipboardUnlock, gxm_XmClipboardUnlock_w, 3, 0, 0, H_XmClipboardUnlock);
- XM_DEFINE_PROCEDURE(XmClipboardStartRetrieve, gxm_XmClipboardStartRetrieve_w, 3, 0, 0, H_XmClipboardStartRetrieve);
- XM_DEFINE_PROCEDURE(XmClipboardEndRetrieve, gxm_XmClipboardEndRetrieve_w, 2, 0, 0, H_XmClipboardEndRetrieve);
- XM_DEFINE_PROCEDURE(XmClipboardRetrieve, gxm_XmClipboardRetrieve_w, 4, 0, 0, H_XmClipboardRetrieve);
- XM_DEFINE_PROCEDURE(XmClipboardInquireCount, gxm_XmClipboardInquireCount_w, 2, 0, 0, H_XmClipboardInquireCount);
- XM_DEFINE_PROCEDURE(XmClipboardInquireFormat, gxm_XmClipboardInquireFormat_w, 4, 0, 0, H_XmClipboardInquireFormat);
- XM_DEFINE_PROCEDURE(XmClipboardInquireLength, gxm_XmClipboardInquireLength_w, 3, 0, 0, H_XmClipboardInquireLength);
- XM_DEFINE_PROCEDURE(XmClipboardInquirePendingItems, gxm_XmClipboardInquirePendingItems_w, 3, 0, 0, H_XmClipboardInquirePendingItems);
- XM_DEFINE_PROCEDURE(XmClipboardRegisterFormat, gxm_XmClipboardRegisterFormat_w, 3, 0, 0, H_XmClipboardRegisterFormat);
- XM_DEFINE_PROCEDURE(XmGetXmScreen, gxm_XmGetXmScreen_w, 1, 0, 0, H_XmGetXmScreen);
- XM_DEFINE_PROCEDURE(XmCreateScrollBar, gxm_XmCreateScrollBar_w, 3, 1, 0, H_XmCreateScrollBar);
- XM_DEFINE_PROCEDURE(XmScrollBarGetValues, gxm_XmScrollBarGetValues_w, 1, 0, 0, H_XmScrollBarGetValues);
- XM_DEFINE_PROCEDURE(XmScrollBarSetValues, gxm_XmScrollBarSetValues_w, 6, 0, 0, H_XmScrollBarSetValues);
- XM_DEFINE_PROCEDURE(XmCreateDialogShell, gxm_XmCreateDialogShell_w, 3, 1, 0, H_XmCreateDialogShell);
- XM_DEFINE_PROCEDURE(XmCreateScrolledWindow, gxm_XmCreateScrolledWindow_w, 3, 1, 0, H_XmCreateScrolledWindow);
- XM_DEFINE_PROCEDURE(XmScrollVisible, gxm_XmScrollVisible_w, 4, 0, 0, H_XmScrollVisible);
- XM_DEFINE_PROCEDURE(XmGetDragContext, gxm_XmGetDragContext_w, 2, 0, 0, H_XmGetDragContext);
- XM_DEFINE_PROCEDURE(XmGetXmDisplay, gxm_XmGetXmDisplay_w, 1, 0, 0, H_XmGetXmDisplay);
- XM_DEFINE_PROCEDURE(XmSelectionBoxGetChild, gxm_XmSelectionBoxGetChild_w, 2, 0, 0, H_XmSelectionBoxGetChild);
- XM_DEFINE_PROCEDURE(XmCreateSelectionBox, gxm_XmCreateSelectionBox_w, 3, 1, 0, H_XmCreateSelectionBox);
- XM_DEFINE_PROCEDURE(XmCreateSelectionDialog, gxm_XmCreateSelectionDialog_w, 3, 1, 0, H_XmCreateSelectionDialog);
- XM_DEFINE_PROCEDURE(XmCreatePromptDialog, gxm_XmCreatePromptDialog_w, 3, 1, 0, H_XmCreatePromptDialog);
- XM_DEFINE_PROCEDURE(XmDragStart, gxm_XmDragStart_w, 3, 1, 0, H_XmDragStart);
- XM_DEFINE_PROCEDURE(XmDragCancel, gxm_XmDragCancel_w, 1, 0, 0, H_XmDragCancel);
- XM_DEFINE_PROCEDURE(XmTargetsAreCompatible, gxm_XmTargetsAreCompatible_w, 5, 0, 0, H_XmTargetsAreCompatible);
- XM_DEFINE_PROCEDURE(XmCreateSeparatorGadget, gxm_XmCreateSeparatorGadget_w, 3, 1, 0, H_XmCreateSeparatorGadget);
- XM_DEFINE_PROCEDURE(XmCreateDragIcon, gxm_XmCreateDragIcon_w, 3, 1, 0, H_XmCreateDragIcon);
- XM_DEFINE_PROCEDURE(XmCreateSeparator, gxm_XmCreateSeparator_w, 3, 1, 0, H_XmCreateSeparator);
- XM_DEFINE_PROCEDURE(XmCreateDrawingArea, gxm_XmCreateDrawingArea_w, 3, 1, 0, H_XmCreateDrawingArea);
- XM_DEFINE_PROCEDURE(XmCreateDrawnButton, gxm_XmCreateDrawnButton_w, 3, 1, 0, H_XmCreateDrawnButton);
- XM_DEFINE_PROCEDURE(XmDropSiteRegister, gxm_XmDropSiteRegister_w, 2, 1, 0, H_XmDropSiteRegister);
- XM_DEFINE_PROCEDURE(XmDropSiteUnregister, gxm_XmDropSiteUnregister_w, 1, 0, 0, H_XmDropSiteUnregister);
- XM_DEFINE_PROCEDURE(XmDropSiteStartUpdate, gxm_XmDropSiteStartUpdate_w, 1, 0, 0, H_XmDropSiteStartUpdate);
- XM_DEFINE_PROCEDURE(XmDropSiteUpdate, gxm_XmDropSiteUpdate_w, 2, 1, 0, H_XmDropSiteUpdate);
- XM_DEFINE_PROCEDURE(XmDropSiteEndUpdate, gxm_XmDropSiteEndUpdate_w, 1, 0, 0, H_XmDropSiteEndUpdate);
- XM_DEFINE_PROCEDURE(XmDropSiteRetrieve, gxm_XmDropSiteRetrieve_w, 2, 1, 0, H_XmDropSiteRetrieve);
- XM_DEFINE_PROCEDURE(XmDropSiteQueryStackingOrder, gxm_XmDropSiteQueryStackingOrder_w, 1, 0, 0, H_XmDropSiteQueryStackingOrder);
- XM_DEFINE_PROCEDURE(XmDropSiteConfigureStackingOrder, gxm_XmDropSiteConfigureStackingOrder_w, 3, 0, 0, H_XmDropSiteConfigureStackingOrder);
- XM_DEFINE_PROCEDURE(XmDropTransferStart, gxm_XmDropTransferStart_w, 2, 1, 0, H_XmDropTransferStart);
- XM_DEFINE_PROCEDURE(XmDropTransferAdd, gxm_XmDropTransferAdd_w, 2, 0, 0, H_XmDropTransferAdd);
- XM_DEFINE_PROCEDURE(XmTextFieldGetString, gxm_XmTextFieldGetString_w, 1, 0, 0, H_XmTextFieldGetString);
- XM_DEFINE_PROCEDURE(XmTextFieldGetSubstring, gxm_XmTextFieldGetSubstring_w, 3, 0, 0, H_XmTextFieldGetSubstring);
- XM_DEFINE_PROCEDURE(XmTextFieldGetLastPosition, gxm_XmTextFieldGetLastPosition_w, 1, 0, 0, H_XmTextFieldGetLastPosition);
- XM_DEFINE_PROCEDURE(XmTextFieldSetString, gxm_XmTextFieldSetString_w, 2, 0, 0, H_XmTextFieldSetString);
- XM_DEFINE_PROCEDURE(XmTextFieldReplace, gxm_XmTextFieldReplace_w, 4, 0, 0, H_XmTextFieldReplace);
- XM_DEFINE_PROCEDURE(XmTextFieldInsert, gxm_XmTextFieldInsert_w, 3, 0, 0, H_XmTextFieldInsert);
- XM_DEFINE_PROCEDURE(XmTextFieldSetAddMode, gxm_XmTextFieldSetAddMode_w, 2, 0, 0, H_XmTextFieldSetAddMode);
- XM_DEFINE_PROCEDURE(XmTextFieldGetAddMode, gxm_XmTextFieldGetAddMode_w, 1, 0, 0, H_XmTextFieldGetAddMode);
- XM_DEFINE_PROCEDURE(XmTextFieldGetEditable, gxm_XmTextFieldGetEditable_w, 1, 0, 0, H_XmTextFieldGetEditable);
- XM_DEFINE_PROCEDURE(XmTextFieldSetEditable, gxm_XmTextFieldSetEditable_w, 2, 0, 0, H_XmTextFieldSetEditable);
- XM_DEFINE_PROCEDURE(XmTextFieldGetMaxLength, gxm_XmTextFieldGetMaxLength_w, 1, 0, 0, H_XmTextFieldGetMaxLength);
- XM_DEFINE_PROCEDURE(XmTextFieldSetMaxLength, gxm_XmTextFieldSetMaxLength_w, 2, 0, 0, H_XmTextFieldSetMaxLength);
- XM_DEFINE_PROCEDURE(XmTextFieldGetCursorPosition, gxm_XmTextFieldGetCursorPosition_w, 1, 0, 0, H_XmTextFieldGetCursorPosition);
- XM_DEFINE_PROCEDURE(XmTextFieldGetInsertionPosition, gxm_XmTextFieldGetInsertionPosition_w, 1, 0, 0, H_XmTextFieldGetInsertionPosition);
- XM_DEFINE_PROCEDURE(XmTextFieldSetCursorPosition, gxm_XmTextFieldSetCursorPosition_w, 2, 0, 0, H_XmTextFieldSetCursorPosition);
- XM_DEFINE_PROCEDURE(XmTextFieldSetInsertionPosition, gxm_XmTextFieldSetInsertionPosition_w, 2, 0, 0, H_XmTextFieldSetInsertionPosition);
- XM_DEFINE_PROCEDURE(XmTextFieldGetSelectionPosition, gxm_XmTextFieldGetSelectionPosition_w, 1, 0, 0, H_XmTextFieldGetSelectionPosition);
- XM_DEFINE_PROCEDURE(XmTextFieldGetSelection, gxm_XmTextFieldGetSelection_w, 1, 0, 0, H_XmTextFieldGetSelection);
- XM_DEFINE_PROCEDURE(XmTextFieldRemove, gxm_XmTextFieldRemove_w, 1, 0, 0, H_XmTextFieldRemove);
- XM_DEFINE_PROCEDURE(XmTextFieldCopy, gxm_XmTextFieldCopy_w, 2, 0, 0, H_XmTextFieldCopy);
- XM_DEFINE_PROCEDURE(XmTextFieldCut, gxm_XmTextFieldCut_w, 2, 0, 0, H_XmTextFieldCut);
- XM_DEFINE_PROCEDURE(XmTextFieldPaste, gxm_XmTextFieldPaste_w, 1, 0, 0, H_XmTextFieldPaste);
- XM_DEFINE_PROCEDURE(XmTextFieldClearSelection, gxm_XmTextFieldClearSelection_w, 2, 0, 0, H_XmTextFieldClearSelection);
- XM_DEFINE_PROCEDURE(XmTextFieldSetSelection, gxm_XmTextFieldSetSelection_w, 4, 0, 0, H_XmTextFieldSetSelection);
- XM_DEFINE_PROCEDURE(XmTextFieldXYToPos, gxm_XmTextFieldXYToPos_w, 3, 0, 0, H_XmTextFieldXYToPos);
- XM_DEFINE_PROCEDURE(XmTextFieldPosToXY, gxm_XmTextFieldPosToXY_w, 2, 0, 0, H_XmTextFieldPosToXY);
- XM_DEFINE_PROCEDURE(XmTextFieldShowPosition, gxm_XmTextFieldShowPosition_w, 2, 0, 0, H_XmTextFieldShowPosition);
- XM_DEFINE_PROCEDURE(XmTextFieldSetHighlight, gxm_XmTextFieldSetHighlight_w, 4, 0, 0, H_XmTextFieldSetHighlight);
- XM_DEFINE_PROCEDURE(XmTextFieldGetBaseline, gxm_XmTextFieldGetBaseline_w, 1, 0, 0, H_XmTextFieldGetBaseline);
- XM_DEFINE_PROCEDURE(XmCreateTextField, gxm_XmCreateTextField_w, 3, 1, 0, H_XmCreateTextField);
- XM_DEFINE_PROCEDURE(XmFileSelectionBoxGetChild, gxm_XmFileSelectionBoxGetChild_w, 2, 0, 0, H_XmFileSelectionBoxGetChild);
- XM_DEFINE_PROCEDURE(XmFileSelectionDoSearch, gxm_XmFileSelectionDoSearch_w, 2, 0, 0, H_XmFileSelectionDoSearch);
- XM_DEFINE_PROCEDURE(XmCreateFileSelectionBox, gxm_XmCreateFileSelectionBox_w, 3, 1, 0, H_XmCreateFileSelectionBox);
- XM_DEFINE_PROCEDURE(XmCreateFileSelectionDialog, gxm_XmCreateFileSelectionDialog_w, 3, 1, 0, H_XmCreateFileSelectionDialog);
- XM_DEFINE_PROCEDURE(XmTextSetHighlight, gxm_XmTextSetHighlight_w, 4, 0, 0, H_XmTextSetHighlight);
- XM_DEFINE_PROCEDURE(XmCreateScrolledText, gxm_XmCreateScrolledText_w, 3, 1, 0, H_XmCreateScrolledText);
- XM_DEFINE_PROCEDURE(XmCreateText, gxm_XmCreateText_w, 3, 1, 0, H_XmCreateText);
- XM_DEFINE_PROCEDURE(XmTextGetSubstring, gxm_XmTextGetSubstring_w, 3, 0, 0, H_XmTextGetSubstring);
- XM_DEFINE_PROCEDURE(XmTextGetString, gxm_XmTextGetString_w, 1, 0, 0, H_XmTextGetString);
- XM_DEFINE_PROCEDURE(XmTextGetLastPosition, gxm_XmTextGetLastPosition_w, 1, 0, 0, H_XmTextGetLastPosition);
- XM_DEFINE_PROCEDURE(XmTextSetString, gxm_XmTextSetString_w, 2, 0, 0, H_XmTextSetString);
- XM_DEFINE_PROCEDURE(XmTextReplace, gxm_XmTextReplace_w, 4, 0, 0, H_XmTextReplace);
- XM_DEFINE_PROCEDURE(XmTextInsert, gxm_XmTextInsert_w, 3, 0, 0, H_XmTextInsert);
- XM_DEFINE_PROCEDURE(XmTextSetAddMode, gxm_XmTextSetAddMode_w, 2, 0, 0, H_XmTextSetAddMode);
- XM_DEFINE_PROCEDURE(XmTextGetAddMode, gxm_XmTextGetAddMode_w, 1, 0, 0, H_XmTextGetAddMode);
- XM_DEFINE_PROCEDURE(XmTextGetEditable, gxm_XmTextGetEditable_w, 1, 0, 0, H_XmTextGetEditable);
- XM_DEFINE_PROCEDURE(XmTextSetEditable, gxm_XmTextSetEditable_w, 2, 0, 0, H_XmTextSetEditable);
- XM_DEFINE_PROCEDURE(XmTextGetMaxLength, gxm_XmTextGetMaxLength_w, 1, 0, 0, H_XmTextGetMaxLength);
- XM_DEFINE_PROCEDURE(XmTextSetMaxLength, gxm_XmTextSetMaxLength_w, 2, 0, 0, H_XmTextSetMaxLength);
- XM_DEFINE_PROCEDURE(XmTextGetTopCharacter, gxm_XmTextGetTopCharacter_w, 1, 0, 0, H_XmTextGetTopCharacter);
- XM_DEFINE_PROCEDURE(XmTextSetTopCharacter, gxm_XmTextSetTopCharacter_w, 2, 0, 0, H_XmTextSetTopCharacter);
- XM_DEFINE_PROCEDURE(XmTextGetCursorPosition, gxm_XmTextGetCursorPosition_w, 1, 0, 0, H_XmTextGetCursorPosition);
- XM_DEFINE_PROCEDURE(XmTextGetInsertionPosition, gxm_XmTextGetInsertionPosition_w, 1, 0, 0, H_XmTextGetInsertionPosition);
- XM_DEFINE_PROCEDURE(XmTextSetInsertionPosition, gxm_XmTextSetInsertionPosition_w, 2, 0, 0, H_XmTextSetInsertionPosition);
- XM_DEFINE_PROCEDURE(XmTextSetCursorPosition, gxm_XmTextSetCursorPosition_w, 2, 0, 0, H_XmTextSetCursorPosition);
- XM_DEFINE_PROCEDURE(XmTextRemove, gxm_XmTextRemove_w, 1, 0, 0, H_XmTextRemove);
- XM_DEFINE_PROCEDURE(XmTextCopy, gxm_XmTextCopy_w, 2, 0, 0, H_XmTextCopy);
- XM_DEFINE_PROCEDURE(XmTextCut, gxm_XmTextCut_w, 2, 0, 0, H_XmTextCut);
- XM_DEFINE_PROCEDURE(XmTextPaste, gxm_XmTextPaste_w, 1, 0, 0, H_XmTextPaste);
- XM_DEFINE_PROCEDURE(XmTextGetSelection, gxm_XmTextGetSelection_w, 1, 0, 0, H_XmTextGetSelection);
- XM_DEFINE_PROCEDURE(XmTextSetSelection, gxm_XmTextSetSelection_w, 4, 0, 0, H_XmTextSetSelection);
- XM_DEFINE_PROCEDURE(XmTextClearSelection, gxm_XmTextClearSelection_w, 2, 0, 0, H_XmTextClearSelection);
- XM_DEFINE_PROCEDURE(XmTextGetSelectionPosition, gxm_XmTextGetSelectionPosition_w, 1, 0, 0, H_XmTextGetSelectionPosition);
- XM_DEFINE_PROCEDURE(XmTextXYToPos, gxm_XmTextXYToPos_w, 3, 0, 0, H_XmTextXYToPos);
- XM_DEFINE_PROCEDURE(XmTextPosToXY, gxm_XmTextPosToXY_w, 2, 0, 0, H_XmTextPosToXY);
- XM_DEFINE_PROCEDURE(XmTextGetSource, gxm_XmTextGetSource_w, 1, 0, 0, H_XmTextGetSource);
- XM_DEFINE_PROCEDURE(XmTextSetSource, gxm_XmTextSetSource_w, 4, 0, 0, H_XmTextSetSource);
- XM_DEFINE_PROCEDURE(XmTextShowPosition, gxm_XmTextShowPosition_w, 2, 0, 0, H_XmTextShowPosition);
- XM_DEFINE_PROCEDURE(XmTextScroll, gxm_XmTextScroll_w, 2, 0, 0, H_XmTextScroll);
- XM_DEFINE_PROCEDURE(XmTextGetBaseline, gxm_XmTextGetBaseline_w, 1, 0, 0, H_XmTextGetBaseline);
- XM_DEFINE_PROCEDURE(XmTextDisableRedisplay, gxm_XmTextDisableRedisplay_w, 1, 0, 0, H_XmTextDisableRedisplay);
- XM_DEFINE_PROCEDURE(XmTextEnableRedisplay, gxm_XmTextEnableRedisplay_w, 1, 0, 0, H_XmTextEnableRedisplay);
- XM_DEFINE_PROCEDURE(XmTextFindString, gxm_XmTextFindString_w, 4, 0, 0, H_XmTextFindString);
- XM_DEFINE_PROCEDURE(XmCreateForm, gxm_XmCreateForm_w, 3, 1, 0, H_XmCreateForm);
- XM_DEFINE_PROCEDURE(XmCreateFormDialog, gxm_XmCreateFormDialog_w, 3, 1, 0, H_XmCreateFormDialog);
- XM_DEFINE_PROCEDURE(XmCreateFrame, gxm_XmCreateFrame_w, 3, 1, 0, H_XmCreateFrame);
- XM_DEFINE_PROCEDURE(XmToggleButtonGadgetGetState, gxm_XmToggleButtonGadgetGetState_w, 1, 0, 0, H_XmToggleButtonGadgetGetState);
- XM_DEFINE_PROCEDURE(XmToggleButtonGadgetSetState, gxm_XmToggleButtonGadgetSetState_w, 3, 0, 0, H_XmToggleButtonGadgetSetState);
- XM_DEFINE_PROCEDURE(XmCreateToggleButtonGadget, gxm_XmCreateToggleButtonGadget_w, 3, 1, 0, H_XmCreateToggleButtonGadget);
- XM_DEFINE_PROCEDURE(XmToggleButtonGetState, gxm_XmToggleButtonGetState_w, 1, 0, 0, H_XmToggleButtonGetState);
- XM_DEFINE_PROCEDURE(XmToggleButtonSetState, gxm_XmToggleButtonSetState_w, 3, 0, 0, H_XmToggleButtonSetState);
- XM_DEFINE_PROCEDURE(XmCreateToggleButton, gxm_XmCreateToggleButton_w, 3, 1, 0, H_XmCreateToggleButton);
- XM_DEFINE_PROCEDURE(XmCreateLabelGadget, gxm_XmCreateLabelGadget_w, 3, 1, 0, H_XmCreateLabelGadget);
- XM_DEFINE_PROCEDURE(XmCreateLabel, gxm_XmCreateLabel_w, 3, 1, 0, H_XmCreateLabel);
- XM_DEFINE_PROCEDURE(XmIsMotifWMRunning, gxm_XmIsMotifWMRunning_w, 1, 0, 0, H_XmIsMotifWMRunning);
- XM_DEFINE_PROCEDURE(XmListAddItem, gxm_XmListAddItem_w, 3, 0, 0, H_XmListAddItem);
- XM_DEFINE_PROCEDURE(XmListAddItems, gxm_XmListAddItems_w, 4, 0, 0, H_XmListAddItems);
- XM_DEFINE_PROCEDURE(XmListAddItemsUnselected, gxm_XmListAddItemsUnselected_w, 4, 0, 0, H_XmListAddItemsUnselected);
- XM_DEFINE_PROCEDURE(XmListAddItemUnselected, gxm_XmListAddItemUnselected_w, 3, 0, 0, H_XmListAddItemUnselected);
- XM_DEFINE_PROCEDURE(XmListDeleteItem, gxm_XmListDeleteItem_w, 2, 0, 0, H_XmListDeleteItem);
- XM_DEFINE_PROCEDURE(XmListDeleteItems, gxm_XmListDeleteItems_w, 2, 1, 0, H_XmListDeleteItems);
- XM_DEFINE_PROCEDURE(XmListDeletePositions, gxm_XmListDeletePositions_w, 2, 1, 0, H_XmListDeletePositions);
- XM_DEFINE_PROCEDURE(XmListDeletePos, gxm_XmListDeletePos_w, 2, 0, 0, H_XmListDeletePos);
- XM_DEFINE_PROCEDURE(XmListDeleteItemsPos, gxm_XmListDeleteItemsPos_w, 3, 0, 0, H_XmListDeleteItemsPos);
- XM_DEFINE_PROCEDURE(XmListDeleteAllItems, gxm_XmListDeleteAllItems_w, 1, 0, 0, H_XmListDeleteAllItems);
- XM_DEFINE_PROCEDURE(XmListReplaceItems, gxm_XmListReplaceItems_w, 4, 0, 0, H_XmListReplaceItems);
- XM_DEFINE_PROCEDURE(XmListReplaceItemsPos, gxm_XmListReplaceItemsPos_w, 4, 0, 0, H_XmListReplaceItemsPos);
- XM_DEFINE_PROCEDURE(XmListReplaceItemsUnselected, gxm_XmListReplaceItemsUnselected_w, 4, 0, 0, H_XmListReplaceItemsUnselected);
- XM_DEFINE_PROCEDURE(XmListReplaceItemsPosUnselected, gxm_XmListReplaceItemsPosUnselected_w, 4, 0, 0, H_XmListReplaceItemsPosUnselected);
- XM_DEFINE_PROCEDURE(XmListReplacePositions, gxm_XmListReplacePositions_w, 4, 0, 0, H_XmListReplacePositions);
- XM_DEFINE_PROCEDURE(XmListSelectItem, gxm_XmListSelectItem_w, 3, 0, 0, H_XmListSelectItem);
- XM_DEFINE_PROCEDURE(XmListSelectPos, gxm_XmListSelectPos_w, 3, 0, 0, H_XmListSelectPos);
- XM_DEFINE_PROCEDURE(XmListDeselectItem, gxm_XmListDeselectItem_w, 2, 0, 0, H_XmListDeselectItem);
- XM_DEFINE_PROCEDURE(XmListDeselectPos, gxm_XmListDeselectPos_w, 2, 0, 0, H_XmListDeselectPos);
- XM_DEFINE_PROCEDURE(XmListDeselectAllItems, gxm_XmListDeselectAllItems_w, 1, 0, 0, H_XmListDeselectAllItems);
- XM_DEFINE_PROCEDURE(XmListSetPos, gxm_XmListSetPos_w, 2, 0, 0, H_XmListSetPos);
- XM_DEFINE_PROCEDURE(XmListSetBottomPos, gxm_XmListSetBottomPos_w, 2, 0, 0, H_XmListSetBottomPos);
- XM_DEFINE_PROCEDURE(XmListSetItem, gxm_XmListSetItem_w, 2, 0, 0, H_XmListSetItem);
- XM_DEFINE_PROCEDURE(XmListSetBottomItem, gxm_XmListSetBottomItem_w, 2, 0, 0, H_XmListSetBottomItem);
- XM_DEFINE_PROCEDURE(XmListSetAddMode, gxm_XmListSetAddMode_w, 2, 0, 0, H_XmListSetAddMode);
- XM_DEFINE_PROCEDURE(XmListItemExists, gxm_XmListItemExists_w, 2, 0, 0, H_XmListItemExists);
- XM_DEFINE_PROCEDURE(XmListItemPos, gxm_XmListItemPos_w, 2, 0, 0, H_XmListItemPos);
- XM_DEFINE_PROCEDURE(XmListGetKbdItemPos, gxm_XmListGetKbdItemPos_w, 1, 0, 0, H_XmListGetKbdItemPos);
- XM_DEFINE_PROCEDURE(XmListSetKbdItemPos, gxm_XmListSetKbdItemPos_w, 2, 0, 0, H_XmListSetKbdItemPos);
- XM_DEFINE_PROCEDURE(XmListYToPos, gxm_XmListYToPos_w, 2, 0, 0, H_XmListYToPos);
- XM_DEFINE_PROCEDURE(XmListPosToBounds, gxm_XmListPosToBounds_w, 2, 0, 0, H_XmListPosToBounds);
- XM_DEFINE_PROCEDURE(XmListGetMatchPos, gxm_XmListGetMatchPos_w, 2, 0, 0, H_XmListGetMatchPos);
- XM_DEFINE_PROCEDURE(XmListSetHorizPos, gxm_XmListSetHorizPos_w, 2, 0, 0, H_XmListSetHorizPos);
- XM_DEFINE_PROCEDURE(XmListUpdateSelectedList, gxm_XmListUpdateSelectedList_w, 1, 0, 0, H_XmListUpdateSelectedList);
- XM_DEFINE_PROCEDURE(XmListPosSelected, gxm_XmListPosSelected_w, 2, 0, 0, H_XmListPosSelected);
- XM_DEFINE_PROCEDURE(XmCreateList, gxm_XmCreateList_w, 3, 1, 0, H_XmCreateList);
- XM_DEFINE_PROCEDURE(XmCreateScrolledList, gxm_XmCreateScrolledList_w, 3, 1, 0, H_XmCreateScrolledList);
- XM_DEFINE_PROCEDURE(XmTranslateKey, gxm_XmTranslateKey_w, 3, 0, 0, H_XmTranslateKey);
- XM_DEFINE_PROCEDURE(XmCreateMainWindow, gxm_XmCreateMainWindow_w, 3, 1, 0, H_XmCreateMainWindow);
- XM_DEFINE_PROCEDURE(XmInstallImage, gxm_XmInstallImage_w, 2, 0, 0, H_XmInstallImage);
- XM_DEFINE_PROCEDURE(XmUninstallImage, gxm_XmUninstallImage_w, 1, 0, 0, H_XmUninstallImage);
- XM_DEFINE_PROCEDURE(XmGetPixmap, gxm_XmGetPixmap_w, 4, 0, 0, H_XmGetPixmap);
- XM_DEFINE_PROCEDURE(XmGetPixmapByDepth, gxm_XmGetPixmapByDepth_w, 5, 0, 0, H_XmGetPixmapByDepth);
- XM_DEFINE_PROCEDURE(XmDestroyPixmap, gxm_XmDestroyPixmap_w, 2, 0, 0, H_XmDestroyPixmap);
- XM_DEFINE_PROCEDURE(XmUpdateDisplay, gxm_XmUpdateDisplay_w, 1, 0, 0, H_XmUpdateDisplay);
- XM_DEFINE_PROCEDURE(XmWidgetGetBaselines, gxm_XmWidgetGetBaselines_w, 1, 0, 0, H_XmWidgetGetBaselines);
- XM_DEFINE_PROCEDURE(XmRegisterSegmentEncoding, gxm_XmRegisterSegmentEncoding_w, 2, 0, 0, H_XmRegisterSegmentEncoding);
- XM_DEFINE_PROCEDURE(XmMapSegmentEncoding, gxm_XmMapSegmentEncoding_w, 1, 0, 0, H_XmMapSegmentEncoding);
- XM_DEFINE_PROCEDURE(XmCvtCTToXmString, gxm_XmCvtCTToXmString_w, 1, 0, 0, H_XmCvtCTToXmString);
- XM_DEFINE_PROCEDURE(XmCvtXmStringToCT, gxm_XmCvtXmStringToCT_w, 1, 0, 0, H_XmCvtXmStringToCT);
- XM_DEFINE_PROCEDURE(XmConvertUnits, gxm_XmConvertUnits_w, 5, 0, 0, H_XmConvertUnits);
- XM_DEFINE_PROCEDURE(XmCreateSimpleMenuBar, gxm_XmCreateSimpleMenuBar_w, 3, 1, 0, H_XmCreateSimpleMenuBar);
- XM_DEFINE_PROCEDURE(XmCreateSimplePopupMenu, gxm_XmCreateSimplePopupMenu_w, 3, 1, 0, H_XmCreateSimplePopupMenu);
- XM_DEFINE_PROCEDURE(XmCreateSimplePulldownMenu, gxm_XmCreateSimplePulldownMenu_w, 3, 1, 0, H_XmCreateSimplePulldownMenu);
- XM_DEFINE_PROCEDURE(XmCreateSimpleOptionMenu, gxm_XmCreateSimpleOptionMenu_w, 3, 1, 0, H_XmCreateSimpleOptionMenu);
- XM_DEFINE_PROCEDURE(XmCreateSimpleRadioBox, gxm_XmCreateSimpleRadioBox_w, 3, 1, 0, H_XmCreateSimpleRadioBox);
- XM_DEFINE_PROCEDURE(XmCreateSimpleCheckBox, gxm_XmCreateSimpleCheckBox_w, 3, 1, 0, H_XmCreateSimpleCheckBox);
- XM_DEFINE_PROCEDURE(XmVaCreateSimpleMenuBar, gxm_XmVaCreateSimpleMenuBar_w, 3, 0, 0, H_XmVaCreateSimpleMenuBar);
- XM_DEFINE_PROCEDURE(XmVaCreateSimplePopupMenu, gxm_XmVaCreateSimplePopupMenu_w, 4, 0, 0, H_XmVaCreateSimplePopupMenu);
- XM_DEFINE_PROCEDURE(XmVaCreateSimplePulldownMenu, gxm_XmVaCreateSimplePulldownMenu_w, 5, 0, 0, H_XmVaCreateSimplePulldownMenu);
- XM_DEFINE_PROCEDURE(XmVaCreateSimpleOptionMenu, gxm_XmVaCreateSimpleOptionMenu_w, 7, 0, 0, H_XmVaCreateSimpleOptionMenu);
- XM_DEFINE_PROCEDURE(XmVaCreateSimpleRadioBox, gxm_XmVaCreateSimpleRadioBox_w, 5, 0, 0, H_XmVaCreateSimpleRadioBox);
- XM_DEFINE_PROCEDURE(XmVaCreateSimpleCheckBox, gxm_XmVaCreateSimpleCheckBox_w, 4, 0, 0, H_XmVaCreateSimpleCheckBox);
- XM_DEFINE_PROCEDURE(XmTrackingEvent, gxm_XmTrackingEvent_w, 3, 0, 0, H_XmTrackingEvent);
- XM_DEFINE_PROCEDURE(XmSetColorCalculation, gxm_XmSetColorCalculation_w, 1, 0, 0, H_XmSetColorCalculation);
- XM_DEFINE_PROCEDURE(XmGetColorCalculation, gxm_XmGetColorCalculation_w, 0, 0, 0, H_XmGetColorCalculation);
- XM_DEFINE_PROCEDURE(XmGetColors, gxm_XmGetColors_w, 3, 0, 0, H_XmGetColors);
- XM_DEFINE_PROCEDURE(XmChangeColor, gxm_XmChangeColor_w, 2, 0, 0, H_XmChangeColor);
- XM_DEFINE_PROCEDURE(XmStringCreate, gxm_XmStringCreate_w, 2, 0, 0, H_XmStringCreate);
- XM_DEFINE_PROCEDURE(XmStringCreateLocalized, gxm_XmStringCreateLocalized_w, 1, 0, 0, H_XmStringCreateLocalized);
- XM_DEFINE_PROCEDURE(XmStringDirectionCreate, gxm_XmStringDirectionCreate_w, 1, 0, 0, H_XmStringDirectionCreate);
- XM_DEFINE_PROCEDURE(XmStringSeparatorCreate, gxm_XmStringSeparatorCreate_w, 0, 0, 0, H_XmStringSeparatorCreate);
- XM_DEFINE_PROCEDURE(XmStringInitContext, gxm_XmStringInitContext_w, 1, 0, 0, H_XmStringInitContext);
- XM_DEFINE_PROCEDURE(XmStringFreeContext, gxm_XmStringFreeContext_w, 1, 0, 0, H_XmStringFreeContext);
- XM_DEFINE_PROCEDURE(XmCvtXmStringToByteStream, gxm_XmCvtXmStringToByteStream_w, 1, 0, 0, H_XmCvtXmStringToByteStream);
- XM_DEFINE_PROCEDURE(XmCvtByteStreamToXmString, gxm_XmCvtByteStreamToXmString_w, 1, 0, 0, H_XmCvtByteStreamToXmString);
- XM_DEFINE_PROCEDURE(XmStringByteStreamLength, gxm_XmStringByteStreamLength_w, 1, 0, 0, H_XmStringByteStreamLength);
- XM_DEFINE_PROCEDURE(XmStringConcatAndFree, gxm_XmStringConcatAndFree_w, 2, 0, 0, H_XmStringConcatAndFree);
- XM_DEFINE_PROCEDURE(XmStringIsVoid, gxm_XmStringIsVoid_w, 1, 0, 0, H_XmStringIsVoid);
- XM_DEFINE_PROCEDURE(XmStringPeekNextTriple, gxm_XmStringPeekNextTriple_w, 1, 0, 0, H_XmStringPeekNextTriple);
- XM_DEFINE_PROCEDURE(XmStringGetNextTriple, gxm_XmStringGetNextTriple_w, 1, 0, 0, H_XmStringGetNextTriple);
- XM_DEFINE_PROCEDURE(XmStringComponentCreate, gxm_XmStringComponentCreate_w, 3, 0, 0, H_XmStringComponentCreate);
- XM_DEFINE_PROCEDURE(XmStringUnparse, gxm_XmStringUnparse_w, 7, 0, 0, H_XmStringUnparse);
- XM_DEFINE_PROCEDURE(XmStringParseText, gxm_XmStringParseText_w, 7, 0, 0, H_XmStringParseText);
- XM_DEFINE_PROCEDURE(XmStringToXmStringTable, gxm_XmStringToXmStringTable_w, 2, 0, 0, H_XmStringToXmStringTable);
- XM_DEFINE_PROCEDURE(XmStringTableToXmString, gxm_XmStringTableToXmString_w, 3, 0, 0, H_XmStringTableToXmString);
- XM_DEFINE_PROCEDURE(XmStringTableUnparse, gxm_XmStringTableUnparse_w, 8, 0, 0, H_XmStringTableUnparse);
- XM_DEFINE_PROCEDURE(XmStringTableParseStringArray, gxm_XmStringTableParseStringArray_w, 7, 0, 0, H_XmStringTableParseStringArray);
- XM_DEFINE_PROCEDURE(XmDirectionToStringDirection, gxm_XmDirectionToStringDirection_w, 1, 0, 0, H_XmDirectionToStringDirection);
- XM_DEFINE_PROCEDURE(XmStringDirectionToDirection, gxm_XmStringDirectionToDirection_w, 1, 0, 0, H_XmStringDirectionToDirection);
- XM_DEFINE_PROCEDURE(XmStringGenerate, gxm_XmStringGenerate_w, 4, 0, 0, H_XmStringGenerate);
- XM_DEFINE_PROCEDURE(XmStringPutRendition, gxm_XmStringPutRendition_w, 2, 0, 0, H_XmStringPutRendition);
- XM_DEFINE_PROCEDURE(XmParseMappingCreate, gxm_XmParseMappingCreate_w, 1, 1, 0, H_XmParseMappingCreate);
- XM_DEFINE_PROCEDURE(XmParseMappingSetValues, gxm_XmParseMappingSetValues_w, 2, 1, 0, H_XmParseMappingSetValues);
- XM_DEFINE_PROCEDURE(XmParseMappingGetValues, gxm_XmParseMappingGetValues_w, 2, 1, 0, H_XmParseMappingGetValues);
- XM_DEFINE_PROCEDURE(XmParseMappingFree, gxm_XmParseMappingFree_w, 1, 0, 0, H_XmParseMappingFree);
- XM_DEFINE_PROCEDURE(XmParseTableFree, gxm_XmParseTableFree_w, 1, 1, 0, H_XmParseTableFree);
- XM_DEFINE_PROCEDURE(XmStringTableProposeTablist, gxm_XmStringTableProposeTablist_w, 5, 0, 0, H_XmStringTableProposeTablist);
- XM_DEFINE_PROCEDURE(XmTabSetValue, gxm_XmTabSetValue_w, 2, 0, 0, H_XmTabSetValue);
- XM_DEFINE_PROCEDURE(XmTabGetValues, gxm_XmTabGetValues_w, 1, 0, 0, H_XmTabGetValues);
- XM_DEFINE_PROCEDURE(XmTabFree, gxm_XmTabFree_w, 1, 0, 0, H_XmTabFree);
- XM_DEFINE_PROCEDURE(XmTabListFree, gxm_XmTabListFree_w, 1, 0, 0, H_XmTabListFree);
- XM_DEFINE_PROCEDURE(XmTabCreate, gxm_XmTabCreate_w, 5, 0, 0, H_XmTabCreate);
- XM_DEFINE_PROCEDURE(XmTabListTabCount, gxm_XmTabListTabCount_w, 1, 0, 0, H_XmTabListTabCount);
- XM_DEFINE_PROCEDURE(XmTabListRemoveTabs, gxm_XmTabListRemoveTabs_w, 2, 1, 0, H_XmTabListRemoveTabs);
- XM_DEFINE_PROCEDURE(XmTabListReplacePositions, gxm_XmTabListReplacePositions_w, 3, 1, 0, H_XmTabListReplacePositions);
- XM_DEFINE_PROCEDURE(XmTabListGetTab, gxm_XmTabListGetTab_w, 2, 0, 0, H_XmTabListGetTab);
- XM_DEFINE_PROCEDURE(XmTabListCopy, gxm_XmTabListCopy_w, 3, 0, 0, H_XmTabListCopy);
- XM_DEFINE_PROCEDURE(XmTabListInsertTabs, gxm_XmTabListInsertTabs_w, 4, 0, 0, H_XmTabListInsertTabs);
- XM_DEFINE_PROCEDURE(XmRenderTableCvtFromProp, gxm_XmRenderTableCvtFromProp_w, 3, 0, 0, H_XmRenderTableCvtFromProp);
- XM_DEFINE_PROCEDURE(XmRenderTableCvtToProp, gxm_XmRenderTableCvtToProp_w, 2, 0, 0, H_XmRenderTableCvtToProp);
- XM_DEFINE_PROCEDURE(XmRenditionUpdate, gxm_XmRenditionUpdate_w, 2, 1, 0, H_XmRenditionUpdate);
- XM_DEFINE_PROCEDURE(XmRenditionRetrieve, gxm_XmRenditionRetrieve_w, 2, 1, 0, H_XmRenditionRetrieve);
- XM_DEFINE_PROCEDURE(XmRenditionFree, gxm_XmRenditionFree_w, 1, 0, 0, H_XmRenditionFree);
- XM_DEFINE_PROCEDURE(XmRenditionCreate, gxm_XmRenditionCreate_w, 3, 1, 0, H_XmRenditionCreate);
- XM_DEFINE_PROCEDURE(XmRenderTableGetRenditions, gxm_XmRenderTableGetRenditions_w, 0, 3, 0, H_XmRenderTableGetRenditions);
- XM_DEFINE_PROCEDURE(XmRenderTableGetRendition, gxm_XmRenderTableGetRendition_w, 2, 0, 0, H_XmRenderTableGetRendition);
- XM_DEFINE_PROCEDURE(XmRenderTableGetTags, gxm_XmRenderTableGetTags_w, 1, 0, 0, H_XmRenderTableGetTags);
- XM_DEFINE_PROCEDURE(XmRenderTableFree, gxm_XmRenderTableFree_w, 1, 0, 0, H_XmRenderTableFree);
- XM_DEFINE_PROCEDURE(XmRenderTableCopy, gxm_XmRenderTableCopy_w, 0, 3, 0, H_XmRenderTableCopy);
- XM_DEFINE_PROCEDURE(XmRenderTableRemoveRenditions, gxm_XmRenderTableRemoveRenditions_w, 0, 3, 0, H_XmRenderTableRemoveRenditions);
- XM_DEFINE_PROCEDURE(XmRenderTableAddRenditions, gxm_XmRenderTableAddRenditions_w, 4, 0, 0, H_XmRenderTableAddRenditions);
- XM_DEFINE_PROCEDURE(XmStringConcat, gxm_XmStringConcat_w, 2, 0, 0, H_XmStringConcat);
- XM_DEFINE_PROCEDURE(XmStringCopy, gxm_XmStringCopy_w, 1, 0, 0, H_XmStringCopy);
- XM_DEFINE_PROCEDURE(XmStringCompare, gxm_XmStringCompare_w, 2, 0, 0, H_XmStringCompare);
- XM_DEFINE_PROCEDURE(XmStringEmpty, gxm_XmStringEmpty_w, 1, 0, 0, H_XmStringEmpty);
- XM_DEFINE_PROCEDURE(XmStringHasSubstring, gxm_XmStringHasSubstring_w, 2, 0, 0, H_XmStringHasSubstring);
- XM_DEFINE_PROCEDURE(XmStringFree, gxm_XmStringFree_w, 1, 0, 0, H_XmStringFree);
- XM_DEFINE_PROCEDURE(XmStringBaseline, gxm_XmStringBaseline_w, 2, 0, 0, H_XmStringBaseline);
- XM_DEFINE_PROCEDURE(XmStringWidth, gxm_XmStringWidth_w, 2, 0, 0, H_XmStringWidth);
- XM_DEFINE_PROCEDURE(XmStringHeight, gxm_XmStringHeight_w, 2, 0, 0, H_XmStringHeight);
- XM_DEFINE_PROCEDURE(XmStringExtent, gxm_XmStringExtent_w, 2, 0, 0, H_XmStringExtent);
- XM_DEFINE_PROCEDURE(XmStringLineCount, gxm_XmStringLineCount_w, 1, 0, 0, H_XmStringLineCount);
- XM_DEFINE_PROCEDURE(XmStringDraw, gxm_XmStringDraw_w, 0, 0, 1, H_XmStringDraw);
- XM_DEFINE_PROCEDURE(XmStringDrawImage, gxm_XmStringDrawImage_w, 0, 0, 1, H_XmStringDrawImage);
- XM_DEFINE_PROCEDURE(XmStringDrawUnderline, gxm_XmStringDrawUnderline_w, 0, 0, 1, H_XmStringDrawUnderline);
- XM_DEFINE_PROCEDURE(XmGetDestination, gxm_XmGetDestination_w, 1, 0, 0, H_XmGetDestination);
- XM_DEFINE_PROCEDURE(XmIsTraversable, gxm_XmIsTraversable_w, 1, 0, 0, H_XmIsTraversable);
- XM_DEFINE_PROCEDURE(XmGetVisibility, gxm_XmGetVisibility_w, 1, 0, 0, H_XmGetVisibility);
- XM_DEFINE_PROCEDURE(XmGetTabGroup, gxm_XmGetTabGroup_w, 1, 0, 0, H_XmGetTabGroup);
- XM_DEFINE_PROCEDURE(XmGetFocusWidget, gxm_XmGetFocusWidget_w, 1, 0, 0, H_XmGetFocusWidget);
- XM_DEFINE_PROCEDURE(XmProcessTraversal, gxm_XmProcessTraversal_w, 2, 0, 0, H_XmProcessTraversal);
- XM_DEFINE_PROCEDURE(XmCreateMenuShell, gxm_XmCreateMenuShell_w, 3, 1, 0, H_XmCreateMenuShell);
-
- XM_DEFINE_PROCEDURE(XmIsMessageBox, gxm_XmIsMessageBox_w, 1, 0, 0, H_XmIsMessageBox);
- XM_DEFINE_PROCEDURE(XmIsArrowButtonGadget, gxm_XmIsArrowButtonGadget_w, 1, 0, 0, H_XmIsArrowButtonGadget);
- XM_DEFINE_PROCEDURE(XmIsArrowButton, gxm_XmIsArrowButton_w, 1, 0, 0, H_XmIsArrowButton);
- XM_DEFINE_PROCEDURE(XmIsNotebook, gxm_XmIsNotebook_w, 1, 0, 0, H_XmIsNotebook);
- XM_DEFINE_PROCEDURE(XmIsComboBox, gxm_XmIsComboBox_w, 1, 0, 0, H_XmIsComboBox);
- XM_DEFINE_PROCEDURE(XmIsContainer, gxm_XmIsContainer_w, 1, 0, 0, H_XmIsContainer);
- XM_DEFINE_PROCEDURE(XmIsGrabShell, gxm_XmIsGrabShell_w, 1, 0, 0, H_XmIsGrabShell);
- XM_DEFINE_PROCEDURE(XmIsIconGadget, gxm_XmIsIconGadget_w, 1, 0, 0, H_XmIsIconGadget);
- XM_DEFINE_PROCEDURE(XmIsIconHeader, gxm_XmIsIconHeader_w, 1, 0, 0, H_XmIsIconHeader);
- XM_DEFINE_PROCEDURE(XmIsPanedWindow, gxm_XmIsPanedWindow_w, 1, 0, 0, H_XmIsPanedWindow);
- XM_DEFINE_PROCEDURE(XmIsBulletinBoard, gxm_XmIsBulletinBoard_w, 1, 0, 0, H_XmIsBulletinBoard);
- XM_DEFINE_PROCEDURE(XmIsPrimitive, gxm_XmIsPrimitive_w, 1, 0, 0, H_XmIsPrimitive);
- XM_DEFINE_PROCEDURE(XmIsCascadeButtonGadget, gxm_XmIsCascadeButtonGadget_w, 1, 0, 0, H_XmIsCascadeButtonGadget);
- XM_DEFINE_PROCEDURE(XmIsCascadeButton, gxm_XmIsCascadeButton_w, 1, 0, 0, H_XmIsCascadeButton);
- XM_DEFINE_PROCEDURE(XmIsPushButtonGadget, gxm_XmIsPushButtonGadget_w, 1, 0, 0, H_XmIsPushButtonGadget);
- XM_DEFINE_PROCEDURE(XmIsPushButton, gxm_XmIsPushButton_w, 1, 0, 0, H_XmIsPushButton);
- XM_DEFINE_PROCEDURE(XmIsCommand, gxm_XmIsCommand_w, 1, 0, 0, H_XmIsCommand);
- XM_DEFINE_PROCEDURE(XmIsRowColumn, gxm_XmIsRowColumn_w, 1, 0, 0, H_XmIsRowColumn);
- XM_DEFINE_PROCEDURE(XmIsScale, gxm_XmIsScale_w, 1, 0, 0, H_XmIsScale);
- XM_DEFINE_PROCEDURE(XmIsScreen, gxm_XmIsScreen_w, 1, 0, 0, H_XmIsScreen);
- XM_DEFINE_PROCEDURE(XmIsScrollBar, gxm_XmIsScrollBar_w, 1, 0, 0, H_XmIsScrollBar);
- XM_DEFINE_PROCEDURE(XmIsDialogShell, gxm_XmIsDialogShell_w, 1, 0, 0, H_XmIsDialogShell);
- XM_DEFINE_PROCEDURE(XmIsScrolledWindow, gxm_XmIsScrolledWindow_w, 1, 0, 0, H_XmIsScrolledWindow);
- XM_DEFINE_PROCEDURE(XmIsDisplay, gxm_XmIsDisplay_w, 1, 0, 0, H_XmIsDisplay);
- XM_DEFINE_PROCEDURE(XmIsSelectionBox, gxm_XmIsSelectionBox_w, 1, 0, 0, H_XmIsSelectionBox);
- XM_DEFINE_PROCEDURE(XmIsDragContext, gxm_XmIsDragContext_w, 1, 0, 0, H_XmIsDragContext);
- XM_DEFINE_PROCEDURE(XmIsSeparatorGadget, gxm_XmIsSeparatorGadget_w, 1, 0, 0, H_XmIsSeparatorGadget);
- XM_DEFINE_PROCEDURE(XmIsDragIconObjectClass, gxm_XmIsDragIconObjectClass_w, 1, 0, 0, H_XmIsDragIconObjectClass);
- XM_DEFINE_PROCEDURE(XmIsSeparator, gxm_XmIsSeparator_w, 1, 0, 0, H_XmIsSeparator);
- XM_DEFINE_PROCEDURE(XmIsDrawingArea, gxm_XmIsDrawingArea_w, 1, 0, 0, H_XmIsDrawingArea);
- XM_DEFINE_PROCEDURE(XmIsDrawnButton, gxm_XmIsDrawnButton_w, 1, 0, 0, H_XmIsDrawnButton);
- XM_DEFINE_PROCEDURE(XmIsDropSiteManager, gxm_XmIsDropSiteManager_w, 1, 0, 0, H_XmIsDropSiteManager);
- XM_DEFINE_PROCEDURE(XmIsDropTransfer, gxm_XmIsDropTransfer_w, 1, 0, 0, H_XmIsDropTransfer);
- XM_DEFINE_PROCEDURE(XmIsTextField, gxm_XmIsTextField_w, 1, 0, 0, H_XmIsTextField);
- XM_DEFINE_PROCEDURE(XmIsFileSelectionBox, gxm_XmIsFileSelectionBox_w, 1, 0, 0, H_XmIsFileSelectionBox);
- XM_DEFINE_PROCEDURE(XmIsText, gxm_XmIsText_w, 1, 0, 0, H_XmIsText);
- XM_DEFINE_PROCEDURE(XmIsForm, gxm_XmIsForm_w, 1, 0, 0, H_XmIsForm);
- XM_DEFINE_PROCEDURE(XmIsFrame, gxm_XmIsFrame_w, 1, 0, 0, H_XmIsFrame);
- XM_DEFINE_PROCEDURE(XmIsGadget, gxm_XmIsGadget_w, 1, 0, 0, H_XmIsGadget);
- XM_DEFINE_PROCEDURE(XmIsToggleButtonGadget, gxm_XmIsToggleButtonGadget_w, 1, 0, 0, H_XmIsToggleButtonGadget);
- XM_DEFINE_PROCEDURE(XmIsToggleButton, gxm_XmIsToggleButton_w, 1, 0, 0, H_XmIsToggleButton);
- XM_DEFINE_PROCEDURE(XmIsLabelGadget, gxm_XmIsLabelGadget_w, 1, 0, 0, H_XmIsLabelGadget);
- XM_DEFINE_PROCEDURE(XmIsLabel, gxm_XmIsLabel_w, 1, 0, 0, H_XmIsLabel);
- XM_DEFINE_PROCEDURE(XmIsVendorShell, gxm_XmIsVendorShell_w, 1, 0, 0, H_XmIsVendorShell);
- XM_DEFINE_PROCEDURE(XmIsList, gxm_XmIsList_w, 1, 0, 0, H_XmIsList);
- XM_DEFINE_PROCEDURE(XmIsMainWindow, gxm_XmIsMainWindow_w, 1, 0, 0, H_XmIsMainWindow);
- XM_DEFINE_PROCEDURE(XmIsManager, gxm_XmIsManager_w, 1, 0, 0, H_XmIsManager);
- XM_DEFINE_PROCEDURE(XmIsMenuShell, gxm_XmIsMenuShell_w, 1, 0, 0, H_XmIsMenuShell);
- XM_DEFINE_PROCEDURE(XmListGetSelectedPos, gxm_XmListGetSelectedPos_w, 1, 0, 0, H_XmListGetSelectedPos);
-#endif
-#if HAVE_XmCreateButtonBox
- XM_DEFINE_PROCEDURE(XmIsButtonBox, gxm_XmIsButtonBox_w, 1, 0, 0, H_XmIsButtonBox);
- XM_DEFINE_PROCEDURE(XmCreateButtonBox, gxm_XmCreateButtonBox_w, 3, 1, 0, H_XmCreateButtonBox);
-#endif
-#if HAVE_XmCreateDataField
- XM_DEFINE_PROCEDURE(XmIsDataField, gxm_XmIsDataField_w, 1, 0, 0, H_XmIsDataField);
- XM_DEFINE_PROCEDURE(XmCreateDataField, gxm_XmCreateDataField_w, 3, 1, 0, H_XmCreateDataField);
- XM_DEFINE_PROCEDURE(XmDataFieldSetString, gxm_XmDataFieldSetString_w, 2, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldGetString, gxm_XmDataFieldGetString_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldSetHighlight, gxm_XmDataFieldSetHighlight_w, 4, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldSetAddMode, gxm_XmDataFieldSetAddMode_w, 2, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldGetSelection, gxm_XmDataFieldGetSelection_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldSetSelection, gxm_XmDataFieldSetSelection_w, 4, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldGetSelectionPosition, gxm_XmDataFieldGetSelectionPosition_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldXYToPos, gxm_XmDataFieldXYToPos_w, 3, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldShowPosition, gxm_XmDataFieldShowPosition_w, 2, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldCut, gxm_XmDataFieldCut_w, 2, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldCopy, gxm_XmDataFieldCopy_w, 2, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldPaste, gxm_XmDataFieldPaste_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldSetEditable, gxm_XmDataFieldSetEditable_w, 2, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDataFieldSetInsertionPosition, gxm_XmDataFieldSetInsertionPosition_w, 2, 0, 0, NULL);
-#endif
-#if HAVE_XmCreateTabStack
- XM_DEFINE_PROCEDURE(XmIsTabStack, gxm_XmIsTabStack_w, 1, 0, 0, H_XmIsTabStack);
- XM_DEFINE_PROCEDURE(XmTabStackGetSelectedTab, gxm_XmTabStackGetSelectedTab_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmTabStackSelectTab, gxm_XmTabStackSelectTab_w, 2, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmCreateTabStack, gxm_XmCreateTabStack_w, 3, 1, 0, H_XmCreateTabStack);
-#if HAVE_XmTabStackXYToWidget
- XM_DEFINE_PROCEDURE(XmTabStackIndexToWidget, gxm_XmTabStackIndexToWidget_w, 2, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmTabStackXYToWidget, gxm_XmTabStackXYToWidget_w, 3, 0, 0, NULL);
-#endif
-#endif
-#if HAVE_XmCreateColumn
- XM_DEFINE_PROCEDURE(XmCreateColumn, gxm_XmCreateColumn_w, 3, 1, 0, H_XmCreateColumn);
- XM_DEFINE_PROCEDURE(XmIsColumn, gxm_XmIsColumn_w, 1, 0, 0, H_XmIsColumn);
-#if HAVE_XmColumnGetChildLabel
- XM_DEFINE_PROCEDURE(XmColumnGetChildLabel, gxm_XmColumnGetChildLabel_w, 1, 0, 0, NULL);
-#endif
-#endif
-#if HAVE_XmCreateDropDown
- XM_DEFINE_PROCEDURE(XmIsDropDown, gxm_XmIsDropDown_w, 1, 0, 0, H_XmIsDropDown);
- XM_DEFINE_PROCEDURE(XmDropDownGetValue, gxm_XmDropDownGetValue_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDropDownGetList, gxm_XmDropDownGetList_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDropDownGetText, gxm_XmDropDownGetText_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDropDownGetArrow, gxm_XmDropDownGetArrow_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmDropDownGetLabel, gxm_XmDropDownGetLabel_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XmCreateDropDown, gxm_XmCreateDropDown_w, 3, 1, 0, H_XmCreateDropDown);
-#endif
-#if HAVE_XmCreateButtonBox
- XM_DEFINE_PROCEDURE(XmButtonBox?, gxm_XmIsButtonBox_w, 1, 0, 0, H_XmIsButtonBox);
-#endif
-#if HAVE_XmCreateTabStack
- XM_DEFINE_PROCEDURE(XmTabStack?, gxm_XmIsTabStack_w, 1, 0, 0, H_XmIsTabStack);
-#endif
-#if HAVE_XmCreateDataField
- XM_DEFINE_PROCEDURE(XmDataField?, gxm_XmIsDataField_w, 1, 0, 0, H_XmIsDataField);
-#endif
-#if HAVE_XmCreateDropDown
- XM_DEFINE_PROCEDURE(XmDropDown?, gxm_XmIsDropDown_w, 1, 0, 0, H_XmIsDropDown);
-#endif
-#if HAVE_XmCreateColumn
- XM_DEFINE_PROCEDURE(XmColumn?, gxm_XmIsColumn_w, 1, 0, 0, H_XmIsColumn);
-#endif
-
-#if HAVE_MOTIF
-#endif
-
- XM_DEFINE_PROCEDURE(XpmCreatePixmapFromData, gxm_XpmCreatePixmapFromData_w, 4, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XpmCreateDataFromPixmap, gxm_XpmCreateDataFromPixmap_w, 4, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XpmReadFileToPixmap, gxm_XpmReadFileToPixmap_w, 4, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XpmReadFileToXpmImage, gxm_XpmReadFileToXpmImage_w, 1, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XpmGetErrorString, gxm_XpmGetErrorString_w, 1, 0, 0, H_XpmGetErrorString);
- XM_DEFINE_PROCEDURE(XpmReadPixmapFile, gxm_XpmReadFileToPixmap_w, 4, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XpmWriteFileFromPixmap, gxm_XpmWriteFileFromPixmap_w, 5, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XpmWritePixmapFile, gxm_XpmWriteFileFromPixmap_w, 5, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XpmCreatePixmapFromXpmImage, gxm_XpmCreatePixmapFromXpmImage_w, 4, 0, 0, NULL);
- XM_DEFINE_PROCEDURE(XpmCreateXpmImageFromPixmap, gxm_XpmCreateXpmImageFromPixmap_w, 4, 0, 0, NULL);
-
- XM_DEFINE_PROCEDURE(XGetPixel, gxm_XGetPixel_w, 3, 0, 0, H_XGetPixel);
- XM_DEFINE_PROCEDURE(XDestroyImage, gxm_XDestroyImage_w, 1, 0, 0, H_XDestroyImage);
- XM_DEFINE_PROCEDURE(XPutPixel, gxm_XPutPixel_w, 4, 0, 0, H_XPutPixel);
- XM_DEFINE_PROCEDURE(XSubImage, gxm_XSubImage_w, 5, 0, 0, H_XSubImage);
- XM_DEFINE_PROCEDURE(XAddPixel, gxm_XAddPixel_w, 2, 0, 0, H_XAddPixel);
-
-#if HAVE_MOTIF
- XM_DEFINE_PROCEDURE(XtAppContext?, XEN_XtAppContext_p_w, 1, 0, 0, PROC_TRUE " if arg is a XtAppContext");
- XM_DEFINE_PROCEDURE(XtRequestId?, XEN_XtRequestId_p_w, 1, 0, 0, PROC_TRUE " if arg is a XtRequestId");
- XM_DEFINE_PROCEDURE(XtWorkProcId?, XEN_XtWorkProcId_p_w, 1, 0, 0, PROC_TRUE " if arg is a XtWorkProcId");
- XM_DEFINE_PROCEDURE(XtInputId?, XEN_XtInputId_p_w, 1, 0, 0, PROC_TRUE " if arg is a XtInputId");
- XM_DEFINE_PROCEDURE(XtIntervalId?, XEN_XtIntervalId_p_w, 1, 0, 0, PROC_TRUE " if arg is a XtIntervalId");
-#endif
- XM_DEFINE_PROCEDURE(Screen?, XEN_Screen_p_w, 1, 0, 0, PROC_TRUE " if arg is a Screen");
- XM_DEFINE_PROCEDURE(XEvent?, XEN_XEvent_p_w, 1, 0, 0, PROC_TRUE " if arg is a XEvent");
- XM_DEFINE_PROCEDURE(XRectangle?, XEN_XRectangle_p_w, 1, 0, 0, PROC_TRUE " if arg is a XRectangle");
- XM_DEFINE_PROCEDURE(XArc?, XEN_XArc_p_w, 1, 0, 0, PROC_TRUE " if arg is a XArc");
- XM_DEFINE_PROCEDURE(XPoint?, XEN_XPoint_p_w, 1, 0, 0, PROC_TRUE " if arg is a XPoint");
- XM_DEFINE_PROCEDURE(XSegment?, XEN_XSegment_p_w, 1, 0, 0, PROC_TRUE " if arg is a XSegment");
- XM_DEFINE_PROCEDURE(XColor?, XEN_XColor_p_w, 1, 0, 0, PROC_TRUE " if arg is a XColor");
- XM_DEFINE_PROCEDURE(Atom?, XEN_Atom_p_w, 1, 0, 0, PROC_TRUE " if arg is an Atom");
- XM_DEFINE_PROCEDURE(Colormap?, XEN_Colormap_p_w, 1, 0, 0, PROC_TRUE " if arg is a Colormap");
- XM_DEFINE_PROCEDURE(XModifierKeymap?, XEN_XModifierKeymap_p_w, 1, 0, 0, PROC_TRUE " if arg is a XModifierKeymap");
- XM_DEFINE_PROCEDURE(Depth?, XEN_Depth_p_w, 1, 0, 0, PROC_TRUE " if arg is a Depth");
- XM_DEFINE_PROCEDURE(Display?, XEN_Display_p_w, 1, 0, 0, PROC_TRUE " if arg is a Display");
- XM_DEFINE_PROCEDURE(Drawable?, XEN_Window_p_w, 1, 0, 0, PROC_TRUE " if arg is a Drawable");
- XM_DEFINE_PROCEDURE(Font?, XEN_Font_p_w, 1, 0, 0, PROC_TRUE " if arg is a Font");
- XM_DEFINE_PROCEDURE(GC?, XEN_GC_p_w, 1, 0, 0, PROC_TRUE " if arg is a GC");
- XM_DEFINE_PROCEDURE(KeySym?, XEN_KeySym_p_w, 1, 0, 0, PROC_TRUE " if arg is a KeySym");
- XM_DEFINE_PROCEDURE(Pixel?, XEN_Pixel_p_w, 1, 0, 0, PROC_TRUE " if arg is a Pixel");
- XM_DEFINE_PROCEDURE(Pixmap?, XEN_Pixmap_p_w, 1, 0, 0, PROC_TRUE " if arg is a Pixmap");
- XM_DEFINE_PROCEDURE(Region?, XEN_Region_p_w, 1, 0, 0, PROC_TRUE " if arg is a Region");
- XM_DEFINE_PROCEDURE(Time?, XEN_Time_p_w, 1, 0, 0, PROC_TRUE " if arg is a Time");
- XM_DEFINE_PROCEDURE(Visual?, XEN_Visual_p_w, 1, 0, 0, PROC_TRUE " if arg is a Visual");
- XM_DEFINE_PROCEDURE(Window?, XEN_Window_p_w, 1, 0, 0, PROC_TRUE " if arg is a Window");
-#if HAVE_MOTIF
- XM_DEFINE_PROCEDURE(Widget?, XEN_Widget_p_w, 1, 0, 0, PROC_TRUE " if arg is a Widget");
- XM_DEFINE_PROCEDURE(XmStringContext?, XEN_XmStringContext_p_w, 1, 0, 0, PROC_TRUE " if arg is a XmStringContext");
-#endif
- XM_DEFINE_PROCEDURE(XFontProp?, XEN_XFontProp_p_w, 1, 0, 0, PROC_TRUE " if arg is a XFontProp");
- XM_DEFINE_PROCEDURE(XFontSet?, XEN_XFontSet_p_w, 1, 0, 0, PROC_TRUE " if arg is a XFontSet");
- XM_DEFINE_PROCEDURE(XFontStruct?, XEN_XFontStruct_p_w, 1, 0, 0, PROC_TRUE " if arg is a XFontStruct");
- XM_DEFINE_PROCEDURE(XGCValues?, XEN_XGCValues_p_w, 1, 0, 0, PROC_TRUE " if arg is a XGCValues");
- XM_DEFINE_PROCEDURE(XImage?, XEN_XImage_p_w, 1, 0, 0, PROC_TRUE " if arg is a XImage");
- XM_DEFINE_PROCEDURE(XVisualInfo?, XEN_XVisualInfo_p_w, 1, 0, 0, PROC_TRUE " if arg is a XVisualInfo");
- XM_DEFINE_PROCEDURE(XWMHints?, XEN_XWMHints_p_w, 1, 0, 0, PROC_TRUE " if arg is a XWMHints");
- XM_DEFINE_PROCEDURE(XWindowAttributes?, XEN_XWindowAttributes_p_w, 1, 0, 0, PROC_TRUE " if arg is a XWindowAttributes");
- XM_DEFINE_PROCEDURE(XWindowChanges?, XEN_XWindowChanges_p_w, 1, 0, 0, PROC_TRUE " if arg is a XWindowChanges");
- XM_DEFINE_PROCEDURE(KeyCode?, XEN_KeyCode_p_w, 1, 0, 0, PROC_TRUE " if arg is a KeyCode");
- XM_DEFINE_PROCEDURE(XContext?, XEN_XContext_p_w, 1, 0, 0, PROC_TRUE " if arg is a XContext");
- XM_DEFINE_PROCEDURE(XCharStruct?, XEN_XCharStruct_p_w, 1, 0, 0, PROC_TRUE " if arg is a XCharStruct");
- XM_DEFINE_PROCEDURE(XTextItem?, XEN_XTextItem_p_w, 1, 0, 0, PROC_TRUE " if arg is a XTextItem");
- XM_DEFINE_PROCEDURE(XStandardColormap?, XEN_XStandardColormap_p_w, 1, 0, 0, PROC_TRUE " if arg is a XStandardColormap");
- XM_DEFINE_PROCEDURE(Cursor?, XEN_Cursor_p_w, 1, 0, 0, PROC_TRUE " if arg is a Cursor");
-#if HAVE_MOTIF
- XM_DEFINE_PROCEDURE(WidgetClass?, XEN_WidgetClass_p_w, 1, 0, 0, PROC_TRUE " if arg is a WidgetClass");
- XM_DEFINE_PROCEDURE(XmString?, XEN_XmString_p_w, 1, 0, 0, PROC_TRUE " if arg is a XmString");
- XM_DEFINE_PROCEDURE(XmToggleButton?, gxm_XmIsToggleButton_w, 1, 0, 0, H_XmIsToggleButton);
- XM_DEFINE_PROCEDURE(XmDrawingArea?, gxm_XmIsDrawingArea_w, 1, 0, 0, H_XmIsDrawingArea);
- XM_DEFINE_PROCEDURE(XmPushButton?, gxm_XmIsPushButton_w, 1, 0, 0, H_XmIsPushButton);
- XM_DEFINE_PROCEDURE(XmTextField?, gxm_XmIsTextField_w, 1, 0, 0, H_XmIsTextField);
- XM_DEFINE_PROCEDURE(XmFileSelectionBox?, gxm_XmIsFileSelectionBox_w, 1, 0, 0, H_XmIsFileSelectionBox);
- XM_DEFINE_PROCEDURE(XmText?, gxm_XmIsText_w, 1, 0, 0, H_XmIsText);
- XM_DEFINE_PROCEDURE(XmFrame?, gxm_XmIsFrame_w, 1, 0, 0, H_XmIsFrame);
- XM_DEFINE_PROCEDURE(XmLabel?, gxm_XmIsLabel_w, 1, 0, 0, H_XmIsLabel);
- XM_DEFINE_PROCEDURE(XmList?, gxm_XmIsList_w, 1, 0, 0, H_XmIsList);
- XM_DEFINE_PROCEDURE(XmArrowButton?, gxm_XmIsArrowButton_w, 1, 0, 0, H_XmIsArrowButton);
- XM_DEFINE_PROCEDURE(XmScrollBar?, gxm_XmIsScrollBar_w, 1, 0, 0, H_XmIsScrollBar);
- XM_DEFINE_PROCEDURE(XmCommand?, gxm_XmIsCommand_w, 1, 0, 0, H_XmIsCommand);
- XM_DEFINE_PROCEDURE(XmScale?, gxm_XmIsScale_w, 1, 0, 0, H_XmIsScale);
- XM_DEFINE_PROCEDURE(XmRowColumn?, gxm_XmIsRowColumn_w, 1, 0, 0, H_XmIsRowColumn);
- XM_DEFINE_PROCEDURE(XmTab?, XEN_XmTab_p_w, 1, 0, 0, PROC_TRUE " if arg is a Tab");
- XM_DEFINE_PROCEDURE(XmNotebook?, gxm_XmIsNotebook_w, 1, 0, 0, H_XmIsNotebook);
- XM_DEFINE_PROCEDURE(XmComboBox?, gxm_XmIsComboBox_w, 1, 0, 0, H_XmIsComboBox);
- XM_DEFINE_PROCEDURE(XmContainer?, gxm_XmIsContainer_w, 1, 0, 0, H_XmIsContainer);
- XM_DEFINE_PROCEDURE(XmIconHeader?, gxm_XmIsIconHeader_w, 1, 0, 0, H_XmIsIconHeader);
- XM_DEFINE_PROCEDURE(XmGrabShell?, gxm_XmIsGrabShell_w, 1, 0, 0, H_XmIsGrabShell);
- XM_DEFINE_PROCEDURE(XmRendition?, XEN_XmRendition_p_w, 1, 0, 0, PROC_TRUE " if arg is a Rendition");
- XM_DEFINE_PROCEDURE(XmRenderTable?, XEN_XmRenderTable_p_w, 1, 0, 0, PROC_TRUE " if arg is a RenderTable");
- XM_DEFINE_PROCEDURE(XmIconGadget?, gxm_XmIsIconGadget_w, 1, 0, 0, H_XmIsIconGadget);
- XM_DEFINE_PROCEDURE(XmTabList?, XEN_XmTabList_p_w, 1, 0, 0, PROC_TRUE " if arg is a TabList");
- XM_DEFINE_PROCEDURE(XmParseMapping?, XEN_XmParseMapping_p_w, 1, 0, 0, PROC_TRUE " if arg is a ParseMapping");
- XM_DEFINE_PROCEDURE(XmPanedWindow?, gxm_XmIsPanedWindow_w, 1, 0, 0, H_XmIsPanedWindow);
- XM_DEFINE_PROCEDURE(XmScrolledWindow?, gxm_XmIsScrolledWindow_w, 1, 0, 0, H_XmIsScrolledWindow);
- XM_DEFINE_PROCEDURE(XmCascadeButton?, gxm_XmIsCascadeButton_w, 1, 0, 0, H_XmIsCascadeButton);
- XM_DEFINE_PROCEDURE(XmForm?, gxm_XmIsForm_w, 1, 0, 0, H_XmIsForm);
- XM_DEFINE_PROCEDURE(XmBulletinBoard?, gxm_XmIsBulletinBoard_w, 1, 0, 0, H_XmIsBulletinBoard);
- XM_DEFINE_PROCEDURE(XmScreen?, gxm_XmIsScreen_w, 1, 0, 0, H_XmIsScreen);
- XM_DEFINE_PROCEDURE(XmDialogShell?, gxm_XmIsDialogShell_w, 1, 0, 0, H_XmIsDialogShell);
- XM_DEFINE_PROCEDURE(XmDisplay?, gxm_XmIsDisplay_w, 1, 0, 0, H_XmIsDisplay);
- XM_DEFINE_PROCEDURE(XmSelectionBox?, gxm_XmIsSelectionBox_w, 1, 0, 0, H_XmIsSelectionBox);
- XM_DEFINE_PROCEDURE(XmDragContext?, gxm_XmIsDragContext_w, 1, 0, 0, H_XmIsDragContext);
- XM_DEFINE_PROCEDURE(XmDragIconObjectClass?, gxm_XmIsDragIconObjectClass_w, 1, 0, 0, H_XmIsDragIconObjectClass);
- XM_DEFINE_PROCEDURE(XmSeparator?, gxm_XmIsSeparator_w, 1, 0, 0, H_XmIsSeparator);
- XM_DEFINE_PROCEDURE(XmDropSiteManager?, gxm_XmIsDropSiteManager_w, 1, 0, 0, H_XmIsDropSiteManager);
- XM_DEFINE_PROCEDURE(XmDropTransfer?, gxm_XmIsDropTransfer_w, 1, 0, 0, H_XmIsDropTransfer);
- XM_DEFINE_PROCEDURE(XmVendorShell?, gxm_XmIsVendorShell_w, 1, 0, 0, H_XmIsVendorShell);
- XM_DEFINE_PROCEDURE(XmMainWindow?, gxm_XmIsMainWindow_w, 1, 0, 0, H_XmIsMainWindow);
- XM_DEFINE_PROCEDURE(XmMessageBox?, gxm_XmIsMessageBox_w, 1, 0, 0, H_XmIsMessageBox);
- XM_DEFINE_PROCEDURE(XmManager?, gxm_XmIsManager_w, 1, 0, 0, H_XmIsManager);
- XM_DEFINE_PROCEDURE(XmMenuShell?, gxm_XmIsMenuShell_w, 1, 0, 0, H_XmIsMenuShell);
- XM_DEFINE_PROCEDURE(XmLabelGadget?, gxm_XmIsLabelGadget_w, 1, 0, 0, H_XmIsLabelGadget);
- XM_DEFINE_PROCEDURE(XmPushButtonGadget?, gxm_XmIsPushButtonGadget_w, 1, 0, 0, H_XmIsPushButtonGadget);
- XM_DEFINE_PROCEDURE(XmSeparatorGadget?, gxm_XmIsSeparatorGadget_w, 1, 0, 0, H_XmIsSeparatorGadget);
- XM_DEFINE_PROCEDURE(XmArrowButtonGadget?, gxm_XmIsArrowButtonGadget_w, 1, 0, 0, H_XmIsArrowButtonGadget);
- XM_DEFINE_PROCEDURE(XmCascadeButtonGadget?, gxm_XmIsCascadeButtonGadget_w, 1, 0, 0, H_XmIsCascadeButtonGadget);
- XM_DEFINE_PROCEDURE(XmToggleButtonGadget?, gxm_XmIsToggleButtonGadget_w, 1, 0, 0, H_XmIsToggleButtonGadget);
- XM_DEFINE_PROCEDURE(XmDrawnButton?, gxm_XmIsDrawnButton_w, 1, 0, 0, H_XmIsDrawnButton);
- XM_DEFINE_PROCEDURE(XmPrimitive?, gxm_XmIsPrimitive_w, 1, 0, 0, H_XmIsPrimitive);
- XM_DEFINE_PROCEDURE(XmTextSource?, XEN_XmTextSource_p_w, 1, 0, 0, PROC_TRUE " if arg is a TextSource");
+ xm_protected = Xen_make_vector(xm_protected_size, Xen_false);
+ Xen_vector_set(xm_gc_table, 0, xm_protected);
+
+ XM_define_procedure(XtSetArg, gxm_XtSetArg_w, 3, 0, 0, H_XtSetArg);
+ XM_define_procedure(XtManageChildren, gxm_XtManageChildren_w, 1, 1, 0, H_XtManageChildren);
+ XM_define_procedure(XtManageChild, gxm_XtManageChild_w, 1, 0, 0, H_XtManageChild);
+ XM_define_procedure(XtUnmanageChildren, gxm_XtUnmanageChildren_w, 1, 1, 0, H_XtUnmanageChildren);
+ XM_define_procedure(XtUnmanageChild, gxm_XtUnmanageChild_w, 1, 0, 0, H_XtUnmanageChild);
+ XM_define_procedure(XtDispatchEvent, gxm_XtDispatchEvent_w, 1, 0, 0, H_XtDispatchEvent);
+ XM_define_procedure(XtCallAcceptFocus, gxm_XtCallAcceptFocus_w, 2, 0, 0, H_XtCallAcceptFocus);
+ XM_define_procedure(XtAppPeekEvent, gxm_XtAppPeekEvent_w, 1, 0, 0, H_XtAppPeekEvent);
+ XM_define_procedure(XtIsSubclass, gxm_XtIsSubclass_w, 2, 0, 0, H_XtIsSubclass);
+ XM_define_procedure(XtIsObject, gxm_XtIsObject_w, 1, 0, 0, H_XtIsObject);
+ XM_define_procedure(XtIsManaged, gxm_XtIsManaged_w, 1, 0, 0, H_XtIsManaged);
+ XM_define_procedure(XtIsRealized, gxm_XtIsRealized_w, 1, 0, 0, H_XtIsRealized);
+ XM_define_procedure(XtIsSensitive, gxm_XtIsSensitive_w, 1, 0, 0, H_XtIsSensitive);
+ XM_define_procedure(XtOwnSelection, gxm_XtOwnSelection_w, 6, 0, 0, H_XtOwnSelection);
+ XM_define_procedure(XtOwnSelectionIncremental, gxm_XtOwnSelectionIncremental_w, 8, 0, 0, H_XtOwnSelectionIncremental);
+ XM_define_procedure(XtMakeResizeRequest, gxm_XtMakeResizeRequest_w, 3, 0, 0, H_XtMakeResizeRequest);
+ XM_define_procedure(XtTranslateCoords, gxm_XtTranslateCoords_w, 3, 0, 0, H_XtTranslateCoords);
+ XM_define_procedure(XtKeysymToKeycodeList, gxm_XtKeysymToKeycodeList_w, 2, 0, 0, H_XtKeysymToKeycodeList);
+ XM_define_procedure(XtParseTranslationTable, gxm_XtParseTranslationTable_w, 1, 0, 0, H_XtParseTranslationTable);
+ XM_define_procedure(XtParseAcceleratorTable, gxm_XtParseAcceleratorTable_w, 1, 0, 0, H_XtParseAcceleratorTable);
+ XM_define_procedure(XtOverrideTranslations, gxm_XtOverrideTranslations_w, 2, 0, 0, H_XtOverrideTranslations);
+ XM_define_procedure(XtAugmentTranslations, gxm_XtAugmentTranslations_w, 2, 0, 0, H_XtAugmentTranslations);
+ XM_define_procedure(XtInstallAccelerators, gxm_XtInstallAccelerators_w, 2, 0, 0, H_XtInstallAccelerators);
+ XM_define_procedure(XtInstallAllAccelerators, gxm_XtInstallAllAccelerators_w, 2, 0, 0, H_XtInstallAllAccelerators);
+ XM_define_procedure(XtUninstallTranslations, gxm_XtUninstallTranslations_w, 1, 0, 0, H_XtUninstallTranslations);
+ XM_define_procedure(XtAppAddActions, gxm_XtAppAddActions_w, 2, 0, 0, H_XtAppAddActions);
+ XM_define_procedure(XtAppAddActionHook, gxm_XtAppAddActionHook_w, 2, 1, 0, H_XtAppAddActionHook);
+ XM_define_procedure(XtRemoveActionHook, gxm_XtRemoveActionHook_w, 1, 0, 0, H_XtRemoveActionHook);
+ XM_define_procedure(XtGetActionList, gxm_XtGetActionList_w, 1, 0, 0, H_XtGetActionList);
+ XM_define_procedure(XtCallActionProc, gxm_XtCallActionProc_w, 4, 1, 0, H_XtCallActionProc);
+ XM_define_procedure(XtRegisterGrabAction, gxm_XtRegisterGrabAction_w, 5, 0, 0, H_XtRegisterGrabAction);
+ XM_define_procedure(XtSetMultiClickTime, gxm_XtSetMultiClickTime_w, 2, 0, 0, H_XtSetMultiClickTime);
+ XM_define_procedure(XtGetMultiClickTime, gxm_XtGetMultiClickTime_w, 1, 0, 0, H_XtGetMultiClickTime);
+ XM_define_procedure(XtGetResourceList, gxm_XtGetResourceList_w, 1, 0, 0, H_XtGetResourceList);
+ XM_define_procedure(XtGetActionKeysym, gxm_XtGetActionKeysym_w, 1, 0, 0, H_XtGetActionKeysym);
+ XM_define_procedure(XtTranslateKeycode, gxm_XtTranslateKeycode_w, 3, 0, 0, H_XtTranslateKeycode);
+ XM_define_procedure(XtTranslateKey, gxm_XtTranslateKey_w, 3, 0, 0, H_XtTranslateKey);
+ XM_define_procedure(XtSetKeyTranslator, gxm_XtSetKeyTranslator_w, 2, 0, 0, H_XtSetKeyTranslator);
+ XM_define_procedure(XtRegisterCaseConverter, gxm_XtRegisterCaseConverter_w, 4, 0, 0, H_XtRegisterCaseConverter);
+ XM_define_procedure(XtConvertCase, gxm_XtConvertCase_w, 2, 0, 0, H_XtConvertCase);
+ XM_define_procedure(XtAddEventHandler, gxm_XtAddEventHandler_w, 4, 1, 0, H_XtAddEventHandler);
+ XM_define_procedure(XtRemoveEventHandler, gxm_XtRemoveEventHandler_w, 5, 0, 0, H_XtRemoveEventHandler);
+ XM_define_procedure(XtAddRawEventHandler, gxm_XtAddRawEventHandler_w, 5, 0, 0, H_XtAddRawEventHandler);
+ XM_define_procedure(XtRemoveRawEventHandler, gxm_XtRemoveRawEventHandler_w, 5, 0, 0, H_XtRemoveRawEventHandler);
+ XM_define_procedure(XtInsertEventHandler, gxm_XtInsertEventHandler_w, 6, 0, 0, H_XtInsertEventHandler);
+ XM_define_procedure(XtInsertRawEventHandler, gxm_XtInsertRawEventHandler_w, 6, 0, 0, H_XtInsertRawEventHandler);
+ XM_define_procedure(XtDispatchEventToWidget, gxm_XtDispatchEventToWidget_w, 2, 0, 0, H_XtDispatchEventToWidget);
+ XM_define_procedure(XtBuildEventMask, gxm_XtBuildEventMask_w, 1, 0, 0, H_XtBuildEventMask);
+ XM_define_procedure(XtAddGrab, gxm_XtAddGrab_w, 3, 0, 0, H_XtAddGrab);
+ XM_define_procedure(XtRemoveGrab, gxm_XtRemoveGrab_w, 1, 0, 0, H_XtRemoveGrab);
+ XM_define_procedure(XtAppProcessEvent, gxm_XtAppProcessEvent_w, 2, 0, 0, H_XtAppProcessEvent);
+ XM_define_procedure(XtAppMainLoop, gxm_XtAppMainLoop_w, 1, 0, 0, H_XtAppMainLoop);
+ XM_define_procedure(XtAddExposureToRegion, gxm_XtAddExposureToRegion_w, 2, 0, 0, H_XtAddExposureToRegion);
+ XM_define_procedure(XtSetKeyboardFocus, gxm_XtSetKeyboardFocus_w, 2, 0, 0, H_XtSetKeyboardFocus);
+ XM_define_procedure(XtGetKeyboardFocusWidget, gxm_XtGetKeyboardFocusWidget_w, 1, 0, 0, H_XtGetKeyboardFocusWidget);
+ XM_define_procedure(XtLastEventProcessed, gxm_XtLastEventProcessed_w, 1, 0, 0, H_XtLastEventProcessed);
+ XM_define_procedure(XtLastTimestampProcessed, gxm_XtLastTimestampProcessed_w, 1, 0, 0, H_XtLastTimestampProcessed);
+ XM_define_procedure(XtAppAddTimeOut, gxm_XtAppAddTimeOut_w, 3, 1, 0, H_XtAppAddTimeOut);
+ XM_define_procedure(XtRemoveTimeOut, gxm_XtRemoveTimeOut_w, 1, 0, 0, H_XtRemoveTimeOut);
+ XM_define_procedure(XtAppAddInput, gxm_XtAppAddInput_w, 4, 1, 0, H_XtAppAddInput);
+ XM_define_procedure(XtRemoveInput, gxm_XtRemoveInput_w, 1, 0, 0, H_XtRemoveInput);
+ XM_define_procedure(XtAppNextEvent, gxm_XtAppNextEvent_w, 1, 0, 0, H_XtAppNextEvent);
+ XM_define_procedure(XtAppPending, gxm_XtAppPending_w, 1, 0, 0, H_XtAppPending);
+ XM_define_procedure(XtRealizeWidget, gxm_XtRealizeWidget_w, 1, 0, 0, H_XtRealizeWidget);
+ XM_define_procedure(XtUnrealizeWidget, gxm_XtUnrealizeWidget_w, 1, 0, 0, H_XtUnrealizeWidget);
+ XM_define_procedure(XtDestroyWidget, gxm_XtDestroyWidget_w, 1, 0, 0, H_XtDestroyWidget);
+ XM_define_procedure(XtSetSensitive, gxm_XtSetSensitive_w, 2, 0, 0, H_XtSetSensitive);
+ XM_define_procedure(XtNameToWidget, gxm_XtNameToWidget_w, 2, 0, 0, H_XtNameToWidget);
+ XM_define_procedure(XtWindowToWidget, gxm_XtWindowToWidget_w, 2, 0, 0, H_XtWindowToWidget);
+ XM_define_procedure(XtMergeArgLists, gxm_XtMergeArgLists_w, 4, 0, 0, H_XtMergeArgLists);
+ XM_define_procedure(XtVaCreateArgsList, gxm_XtVaCreateArgsList_w, 2, 0, 0, H_XtVaCreateArgsList);
+ XM_define_procedure(XtDisplay, gxm_XtDisplay_w, 1, 0, 0, H_XtDisplay);
+ XM_define_procedure(XtDisplayOfObject, gxm_XtDisplayOfObject_w, 1, 0, 0, H_XtDisplayOfObject);
+ XM_define_procedure(XtScreen, gxm_XtScreen_w, 1, 0, 0, H_XtScreen);
+ XM_define_procedure(XtScreenOfObject, gxm_XtScreenOfObject_w, 1, 0, 0, H_XtScreenOfObject);
+ XM_define_procedure(XtWindow, gxm_XtWindow_w, 1, 0, 0, H_XtWindow);
+ XM_define_procedure(XtWindowOfObject, gxm_XtWindowOfObject_w, 1, 0, 0, H_XtWindowOfObject);
+ XM_define_procedure(XtName, gxm_XtName_w, 1, 0, 0, H_XtName);
+ XM_define_procedure(XtSuperclass, gxm_XtSuperclass_w, 1, 0, 0, H_XtSuperclass);
+ XM_define_procedure(XtClass, gxm_XtClass_w, 1, 0, 0, H_XtClass);
+ XM_define_procedure(XtParent, gxm_XtParent_w, 1, 0, 0, H_XtParent);
+ XM_define_procedure(XtAddCallback, gxm_XtAddCallback_w, 3, 1, 0, H_XtAddCallback);
+ XM_define_procedure(XtRemoveCallback, gxm_XtRemoveCallback_w, 3, 0, 0, H_XtRemoveCallback);
+ XM_define_procedure(XtAddCallbacks, gxm_XtAddCallbacks_w, 3, 0, 0, H_XtAddCallbacks);
+ XM_define_procedure(XtRemoveCallbacks, gxm_XtRemoveCallbacks_w, 3, 0, 0, H_XtRemoveCallbacks);
+ XM_define_procedure(XtRemoveAllCallbacks, gxm_XtRemoveAllCallbacks_w, 2, 0, 0, H_XtRemoveAllCallbacks);
+ XM_define_procedure(XtCallCallbacks, gxm_XtCallCallbacks_w, 3, 0, 0, H_XtCallCallbacks);
+ XM_define_procedure(XtHasCallbacks, gxm_XtHasCallbacks_w, 2, 0, 0, H_XtHasCallbacks);
+ XM_define_procedure(XtCreatePopupShell, gxm_XtCreatePopupShell_w, 4, 1, 0, H_XtCreatePopupShell);
+ XM_define_procedure(XtVaCreatePopupShell, gxm_XtVaCreatePopupShell_w, 4, 0, 0, H_XtVaCreatePopupShell);
+ XM_define_procedure(XtPopup, gxm_XtPopup_w, 2, 0, 0, H_XtPopup);
+ XM_define_procedure(XtPopupSpringLoaded, gxm_XtPopupSpringLoaded_w, 1, 0, 0, H_XtPopupSpringLoaded);
+ XM_define_procedure(XtCallbackNone, gxm_XtCallbackNone_w, 3, 0, 0, H_XtCallbackNone);
+ XM_define_procedure(XtCallbackNonexclusive, gxm_XtCallbackNonexclusive_w, 3, 0, 0, H_XtCallbackNonexclusive);
+ XM_define_procedure(XtCallbackExclusive, gxm_XtCallbackExclusive_w, 3, 0, 0, H_XtCallbackExclusive);
+ XM_define_procedure(XtPopdown, gxm_XtPopdown_w, 1, 0, 0, H_XtPopdown);
+ XM_define_procedure(XtCallbackPopdown, gxm_XtCallbackPopdown_w, 3, 0, 0, H_XtCallbackPopdown);
+ XM_define_procedure(XtCreateWidget, gxm_XtCreateWidget_w, 4, 1, 0, H_XtCreateWidget);
+ XM_define_procedure(XtCreateManagedWidget, gxm_XtCreateManagedWidget_w, 4, 1, 0, H_XtCreateManagedWidget);
+ XM_define_procedure(XtVaCreateWidget, gxm_XtVaCreateWidget_w, 4, 0, 0, H_XtVaCreateWidget);
+ XM_define_procedure(XtVaCreateManagedWidget, gxm_XtVaCreateManagedWidget_w, 4, 0, 0, H_XtVaCreateManagedWidget);
+ XM_define_procedure(XtAppCreateShell, gxm_XtAppCreateShell_w, 5, 1, 0, H_XtAppCreateShell);
+ XM_define_procedure(XtVaAppCreateShell, gxm_XtVaAppCreateShell_w, 5, 0, 0, H_XtVaAppCreateShell);
+ XM_define_procedure(XtToolkitInitialize, gxm_XtToolkitInitialize_w, 0, 0, 0, H_XtToolkitInitialize);
+ XM_define_procedure(XtSetLanguageProc, gxm_XtSetLanguageProc_w, 3, 0, 0, H_XtSetLanguageProc);
+ XM_define_procedure(XtDisplayInitialize, gxm_XtDisplayInitialize_w, 6, 0, 0, H_XtDisplayInitialize);
+ XM_define_procedure(XtOpenApplication, gxm_XtOpenApplication_w, 5, 1, 0, H_XtOpenApplication);
+ XM_define_procedure(XtVaOpenApplication, gxm_XtVaOpenApplication_w, 5, 1, 0, H_XtVaOpenApplication);
+ XM_define_procedure(XtAppInitialize, gxm_XtAppInitialize_w, 4, 1, 0, H_XtAppInitialize);
+ XM_define_procedure(XtVaAppInitialize, gxm_XtVaAppInitialize_w, 4, 1, 0, H_XtVaAppInitialize);
+ XM_define_procedure(XtOpenDisplay, gxm_XtOpenDisplay_w, 6, 0, 0, H_XtOpenDisplay);
+ XM_define_procedure(XtCreateApplicationContext, gxm_XtCreateApplicationContext_w, 0, 0, 0, H_XtCreateApplicationContext);
+ XM_define_procedure(XtDestroyApplicationContext, gxm_XtDestroyApplicationContext_w, 1, 0, 0, H_XtDestroyApplicationContext);
+ XM_define_procedure(XtAppSetFallbackResources, gxm_XtAppSetFallbackResources_w, 2, 0, 0, H_XtAppSetFallbackResources);
+ XM_define_procedure(XtInitializeWidgetClass, gxm_XtInitializeWidgetClass_w, 1, 0, 0, H_XtInitializeWidgetClass);
+ XM_define_procedure(XtWidgetToApplicationContext, gxm_XtWidgetToApplicationContext_w, 1, 0, 0, H_XtWidgetToApplicationContext);
+ XM_define_procedure(XtDisplayToApplicationContext, gxm_XtDisplayToApplicationContext_w, 1, 0, 0, H_XtDisplayToApplicationContext);
+ XM_define_procedure(XtCloseDisplay, gxm_XtCloseDisplay_w, 1, 0, 0, H_XtCloseDisplay);
+ XM_define_procedure(XtSetValues, gxm_XtSetValues_w, 2, 1, 0, H_XtSetValues);
+ XM_define_procedure(XtVaSetValues, gxm_XtVaSetValues_w, 2, 0, 0, H_XtVaSetValues);
+ XM_define_procedure(XtGetValues, gxm_XtGetValues_w, 2, 1, 0, H_XtGetValues);
+ XM_define_procedure(XtVaGetValues, gxm_XtVaGetValues_w, 2, 0, 0, H_XtVaGetValues);
+ XM_define_procedure(XtAppSetErrorMsgHandler, gxm_XtAppSetErrorMsgHandler_w, 2, 0, 0, H_XtAppSetErrorMsgHandler);
+ XM_define_procedure(XtAppSetWarningMsgHandler, gxm_XtAppSetWarningMsgHandler_w, 2, 0, 0, H_XtAppSetWarningMsgHandler);
+ XM_define_procedure(XtAppErrorMsg, gxm_XtAppErrorMsg_w, 7, 0, 0, H_XtAppErrorMsg);
+ XM_define_procedure(XtAppWarningMsg, gxm_XtAppWarningMsg_w, 7, 0, 0, H_XtAppWarningMsg);
+ XM_define_procedure(XtAppSetErrorHandler, gxm_XtAppSetErrorHandler_w, 2, 0, 0, H_XtAppSetErrorHandler);
+ XM_define_procedure(XtAppSetWarningHandler, gxm_XtAppSetWarningHandler_w, 2, 0, 0, H_XtAppSetWarningHandler);
+ XM_define_procedure(XtAppError, gxm_XtAppError_w, 2, 0, 0, H_XtAppError);
+ XM_define_procedure(XtMalloc, gxm_XtMalloc_w, 1, 0, 0, H_XtMalloc);
+ XM_define_procedure(XtCalloc, gxm_XtCalloc_w, 2, 0, 0, H_XtCalloc);
+ XM_define_procedure(XtRealloc, gxm_XtRealloc_w, 2, 0, 0, H_XtRealloc);
+ XM_define_procedure(XtFree, gxm_XtFree_w, 1, 0, 0, H_XtFree);
+ XM_define_procedure(XtAppAddWorkProc, gxm_XtAppAddWorkProc_w, 2, 1, 0, H_XtAppAddWorkProc);
+ XM_define_procedure(XtRemoveWorkProc, gxm_XtRemoveWorkProc_w, 1, 0, 0, H_XtRemoveWorkProc);
+ XM_define_procedure(XtGetGC, gxm_XtGetGC_w, 3, 0, 0, H_XtGetGC);
+ XM_define_procedure(XtAllocateGC, gxm_XtAllocateGC_w, 6, 0, 0, H_XtAllocateGC);
+ XM_define_procedure(XtDestroyGC, gxm_XtDestroyGC_w, 1, 0, 0, H_XtDestroyGC);
+ XM_define_procedure(XtReleaseGC, gxm_XtReleaseGC_w, 2, 0, 0, H_XtReleaseGC);
+ XM_define_procedure(XtFindFile, gxm_XtFindFile_w, 4, 0, 0, H_XtFindFile);
+ XM_define_procedure(XtResolvePathname, gxm_XtResolvePathname_w, 8, 0, 0, H_XtResolvePathname);
+ XM_define_procedure(XtDisownSelection, gxm_XtDisownSelection_w, 3, 0, 0, H_XtDisownSelection);
+ XM_define_procedure(XtGetSelectionValue, gxm_XtGetSelectionValue_w, 6, 0, 0, H_XtGetSelectionValue);
+ XM_define_procedure(XtGetSelectionValues, gxm_XtGetSelectionValues_w, 7, 0, 0, H_XtGetSelectionValues);
+ XM_define_procedure(XtAppSetSelectionTimeout, gxm_XtAppSetSelectionTimeout_w, 2, 0, 0, H_XtAppSetSelectionTimeout);
+ XM_define_procedure(XtAppGetSelectionTimeout, gxm_XtAppGetSelectionTimeout_w, 1, 0, 0, H_XtAppGetSelectionTimeout);
+ XM_define_procedure(XtGetSelectionRequest, gxm_XtGetSelectionRequest_w, 3, 0, 0, H_XtGetSelectionRequest);
+ XM_define_procedure(XtGetSelectionValueIncremental, gxm_XtGetSelectionValueIncremental_w, 6, 0, 0, H_XtGetSelectionValueIncremental);
+ XM_define_procedure(XtGetSelectionValuesIncremental, gxm_XtGetSelectionValuesIncremental_w, 7, 0, 0, H_XtGetSelectionValuesIncremental);
+ XM_define_procedure(XtCreateSelectionRequest, gxm_XtCreateSelectionRequest_w, 2, 0, 0, H_XtCreateSelectionRequest);
+ XM_define_procedure(XtSendSelectionRequest, gxm_XtSendSelectionRequest_w, 3, 0, 0, H_XtSendSelectionRequest);
+ XM_define_procedure(XtCancelSelectionRequest, gxm_XtCancelSelectionRequest_w, 2, 0, 0, H_XtCancelSelectionRequest);
+ XM_define_procedure(XtGrabKey, gxm_XtGrabKey_w, 6, 0, 0, H_XtGrabKey);
+ XM_define_procedure(XtUngrabKey, gxm_XtUngrabKey_w, 3, 0, 0, H_XtUngrabKey);
+ XM_define_procedure(XtGrabKeyboard, gxm_XtGrabKeyboard_w, 5, 0, 0, H_XtGrabKeyboard);
+ XM_define_procedure(XtUngrabKeyboard, gxm_XtUngrabKeyboard_w, 2, 0, 0, H_XtUngrabKeyboard);
+ XM_define_procedure(XtGrabButton, gxm_XtGrabButton_w, 9, 0, 0, H_XtGrabButton);
+ XM_define_procedure(XtUngrabButton, gxm_XtUngrabButton_w, 3, 0, 0, H_XtUngrabButton);
+ XM_define_procedure(XtGrabPointer, gxm_XtGrabPointer_w, 8, 0, 0, H_XtGrabPointer);
+ XM_define_procedure(XtUngrabPointer, gxm_XtUngrabPointer_w, 2, 0, 0, H_XtUngrabPointer);
+ XM_define_procedure(XtGetApplicationNameAndClass, gxm_XtGetApplicationNameAndClass_w, 1, 0, 0, H_XtGetApplicationNameAndClass);
+ XM_define_procedure(XtGetDisplays, gxm_XtGetDisplays_w, 1, 0, 0, H_XtGetDisplays);
+ XM_define_procedure(XtToolkitThreadInitialize, gxm_XtToolkitThreadInitialize_w, 0, 0, 0, H_XtToolkitThreadInitialize);
+ XM_define_procedure(XtAppLock, gxm_XtAppLock_w, 1, 0, 0, H_XtAppLock);
+ XM_define_procedure(XtAppUnlock, gxm_XtAppUnlock_w, 1, 0, 0, H_XtAppUnlock);
+ XM_define_procedure(XtIsRectObj, gxm_XtIsRectObj_w, 1, 0, 0, H_XtIsRectObj);
+ XM_define_procedure(XtIsWidget, gxm_XtIsWidget_w, 1, 0, 0, H_XtIsWidget);
+ XM_define_procedure(XtIsComposite, gxm_XtIsComposite_w, 1, 0, 0, H_XtIsComposite);
+ XM_define_procedure(XtIsConstraint, gxm_XtIsConstraint_w, 1, 0, 0, H_XtIsConstraint);
+ XM_define_procedure(XtIsShell, gxm_XtIsShell_w, 1, 0, 0, H_XtIsShell);
+ XM_define_procedure(XtIsOverrideShell, gxm_XtIsOverrideShell_w, 1, 0, 0, H_XtIsOverrideShell);
+ XM_define_procedure(XtIsWMShell, gxm_XtIsWMShell_w, 1, 0, 0, H_XtIsWMShell);
+ XM_define_procedure(XtIsVendorShell, gxm_XtIsVendorShell_w, 1, 0, 0, H_XtIsVendorShell);
+ XM_define_procedure(XtIsTransientShell, gxm_XtIsTransientShell_w, 1, 0, 0, H_XtIsTransientShell);
+ XM_define_procedure(XtIsTopLevelShell, gxm_XtIsTopLevelShell_w, 1, 0, 0, H_XtIsTopLevelShell);
+ XM_define_procedure(XtIsApplicationShell, gxm_XtIsApplicationShell_w, 1, 0, 0, H_XtIsApplicationShell);
+ XM_define_procedure(XtIsSessionShell, gxm_XtIsSessionShell_w, 1, 0, 0, H_XtIsSessionShell);
+ XM_define_procedure(XtMapWidget, gxm_XtMapWidget_w, 1, 0, 0, H_XtMapWidget);
+ XM_define_procedure(XtUnmapWidget, gxm_XtUnmapWidget_w, 1, 0, 0, H_XtUnmapWidget);
+
+ XM_define_procedure(XUniqueContext, gxm_XUniqueContext_w, 0, 0, 0, H_XUniqueContext);
+ XM_define_procedure(XLoadQueryFont, gxm_XLoadQueryFont_w, 2, 0, 0, H_XLoadQueryFont);
+ XM_define_procedure(XQueryFont, gxm_XQueryFont_w, 2, 0, 0, H_XQueryFont);
+ XM_define_procedure(XGetMotionEvents, gxm_XGetMotionEvents_w, 4, 0, 0, H_XGetMotionEvents);
+ XM_define_procedure(XDeleteModifiermapEntry, gxm_XDeleteModifiermapEntry_w, 3, 0, 0, H_XDeleteModifiermapEntry);
+ XM_define_procedure(XGetModifierMapping, gxm_XGetModifierMapping_w, 1, 0, 0, H_XGetModifierMapping);
+ XM_define_procedure(XInsertModifiermapEntry, gxm_XInsertModifiermapEntry_w, 3, 0, 0, H_XInsertModifiermapEntry);
+ XM_define_procedure(XNewModifiermap, gxm_XNewModifiermap_w, 1, 0, 0, H_XNewModifiermap);
+ XM_define_procedure(XCreateImage, gxm_XCreateImage_w, 0, 0, 1, H_XCreateImage);
+ XM_define_procedure(XGetImage, gxm_XGetImage_w, 8, 0, 0, H_XGetImage);
+ XM_define_procedure(XGetSubImage, gxm_XGetSubImage_w, 0, 0, 1, H_XGetSubImage);
+ XM_define_procedure(XOpenDisplay, gxm_XOpenDisplay_w, 1, 0, 0, H_XOpenDisplay);
+ XM_define_procedure(XFetchBytes, gxm_XFetchBytes_w, 1, 0, 0, H_XFetchBytes);
+ XM_define_procedure(XFetchBuffer, gxm_XFetchBuffer_w, 2, 0, 0, H_XFetchBuffer);
+ XM_define_procedure(XGetAtomName, gxm_XGetAtomName_w, 2, 0, 0, H_XGetAtomName);
+ XM_define_procedure(XDisplayName, gxm_XDisplayName_w, 1, 0, 0, H_XDisplayName);
+ XM_define_procedure(XKeysymToString, gxm_XKeysymToString_w, 1, 0, 0, H_XKeysymToString);
+ XM_define_procedure(XSynchronize, gxm_XSynchronize_w, 2, 0, 0, H_XSynchronize);
+ XM_define_procedure(XSetAfterFunction, gxm_XSetAfterFunction_w, 2, 0, 0, H_XSetAfterFunction);
+ XM_define_procedure(XInternAtom, gxm_XInternAtom_w, 3, 0, 0, H_XInternAtom);
+ XM_define_procedure(XCopyColormapAndFree, gxm_XCopyColormapAndFree_w, 2, 0, 0, H_XCopyColormapAndFree);
+ XM_define_procedure(XCreateColormap, gxm_XCreateColormap_w, 4, 0, 0, H_XCreateColormap);
+ XM_define_procedure(XCreatePixmapCursor, gxm_XCreatePixmapCursor_w, 7, 0, 0, H_XCreatePixmapCursor);
+ XM_define_procedure(XCreateGlyphCursor, gxm_XCreateGlyphCursor_w, 7, 0, 0, H_XCreateGlyphCursor);
+ XM_define_procedure(XCreateFontCursor, gxm_XCreateFontCursor_w, 2, 0, 0, H_XCreateFontCursor);
+ XM_define_procedure(XLoadFont, gxm_XLoadFont_w, 2, 0, 0, H_XLoadFont);
+ XM_define_procedure(XCreateGC, gxm_XCreateGC_w, 4, 0, 0, H_XCreateGC);
+ XM_define_procedure(XFlushGC, gxm_XFlushGC_w, 2, 0, 0, H_XFlushGC);
+ XM_define_procedure(XCreatePixmap, gxm_XCreatePixmap_w, 5, 0, 0, H_XCreatePixmap);
+ XM_define_procedure(XCreateBitmapFromData, gxm_XCreateBitmapFromData_w, 5, 0, 0, H_XCreateBitmapFromData);
+ XM_define_procedure(XCreatePixmapFromBitmapData, gxm_XCreatePixmapFromBitmapData_w, 8, 0, 0, H_XCreatePixmapFromBitmapData);
+ XM_define_procedure(XCreateSimpleWindow, gxm_XCreateSimpleWindow_w, 9, 0, 0, H_XCreateSimpleWindow);
+ XM_define_procedure(XGetSelectionOwner, gxm_XGetSelectionOwner_w, 2, 0, 0, H_XGetSelectionOwner);
+ XM_define_procedure(XCreateWindow, gxm_XCreateWindow_w, 0, 0, 1, H_XCreateWindow);
+ XM_define_procedure(XListInstalledColormaps, gxm_XListInstalledColormaps_w, 2, 0, 0, H_XListInstalledColormaps);
+ XM_define_procedure(XListFonts, gxm_XListFonts_w, 3, 0, 0, H_XListFonts);
+ XM_define_procedure(XListFontsWithInfo, gxm_XListFontsWithInfo_w, 3, 0, 0, H_XListFontsWithInfo);
+ XM_define_procedure(XGetFontPath, gxm_XGetFontPath_w, 1, 0, 0, H_XGetFontPath);
+ XM_define_procedure(XListExtensions, gxm_XListExtensions_w, 1, 0, 0, H_XListExtensions);
+ XM_define_procedure(XListProperties, gxm_XListProperties_w, 2, 0, 0, H_XListProperties);
+#if 0
+ XM_define_procedure(XKeycodeToKeysym, gxm_XKeycodeToKeysym_w, 3, 0, 0, H_XKeycodeToKeysym);
#endif
+ XM_define_procedure(XLookupKeysym, gxm_XLookupKeysym_w, 2, 0, 0, H_XLookupKeysym);
+ XM_define_procedure(XGetKeyboardMapping, gxm_XGetKeyboardMapping_w, 3, 0, 0, H_XGetKeyboardMapping);
+ XM_define_procedure(XStringToKeysym, gxm_XStringToKeysym_w, 1, 0, 0, H_XStringToKeysym);
+ XM_define_procedure(XMaxRequestSize, gxm_XMaxRequestSize_w, 1, 0, 0, H_XMaxRequestSize);
+ XM_define_procedure(XExtendedMaxRequestSize, gxm_XExtendedMaxRequestSize_w, 1, 0, 0, H_XExtendedMaxRequestSize);
+ XM_define_procedure(XDisplayMotionBufferSize, gxm_XDisplayMotionBufferSize_w, 1, 0, 0, H_XDisplayMotionBufferSize);
+ XM_define_procedure(XVisualIDFromVisual, gxm_XVisualIDFromVisual_w, 1, 0, 0, H_XVisualIDFromVisual);
+ XM_define_procedure(XRootWindow, gxm_XRootWindow_w, 2, 0, 0, H_RootWindow);
+ XM_define_procedure(XDefaultRootWindow, gxm_XDefaultRootWindow_w, 1, 0, 0, H_DefaultRootWindow);
+ XM_define_procedure(XRootWindowOfScreen, gxm_XRootWindowOfScreen_w, 1, 0, 0, H_RootWindowOfScreen);
+ XM_define_procedure(XDefaultVisual, gxm_XDefaultVisual_w, 2, 0, 0, H_DefaultVisual);
+ XM_define_procedure(XDefaultVisualOfScreen, gxm_XDefaultVisualOfScreen_w, 1, 0, 0, H_DefaultVisualOfScreen);
+ XM_define_procedure(XDefaultGC, gxm_XDefaultGC_w, 2, 0, 0, H_DefaultGC);
+ XM_define_procedure(XDefaultGCOfScreen, gxm_XDefaultGCOfScreen_w, 1, 0, 0, H_DefaultGCOfScreen);
+ XM_define_procedure(XBlackPixel, gxm_XBlackPixel_w, 2, 0, 0, H_BlackPixel);
+ XM_define_procedure(XWhitePixel, gxm_XWhitePixel_w, 2, 0, 0, H_WhitePixel);
+ XM_define_procedure(XAllPlanes, gxm_XAllPlanes_w, 0, 0, 0, H_AllPlanes);
+ XM_define_procedure(XBlackPixelOfScreen, gxm_XBlackPixelOfScreen_w, 1, 0, 0, H_BlackPixelOfScreen);
+ XM_define_procedure(XWhitePixelOfScreen, gxm_XWhitePixelOfScreen_w, 1, 0, 0, H_WhitePixelOfScreen);
+ XM_define_procedure(XNextRequest, gxm_XNextRequest_w, 1, 0, 0, H_NextRequest);
+ XM_define_procedure(XLastKnownRequestProcessed, gxm_XLastKnownRequestProcessed_w, 1, 0, 0, H_LastKnownRequestProcessed);
+ XM_define_procedure(XServerVendor, gxm_XServerVendor_w, 1, 0, 0, H_ServerVendor);
+ XM_define_procedure(XDisplayString, gxm_XDisplayString_w, 1, 0, 0, H_DisplayString);
+ XM_define_procedure(XDefaultColormap, gxm_XDefaultColormap_w, 2, 0, 0, H_DefaultColormap);
+ XM_define_procedure(XDefaultColormapOfScreen, gxm_XDefaultColormapOfScreen_w, 1, 0, 0, H_DefaultColormapOfScreen);
+ XM_define_procedure(XDisplayOfScreen, gxm_XDisplayOfScreen_w, 1, 0, 0, H_DisplayOfScreen);
+ XM_define_procedure(XScreenOfDisplay, gxm_XScreenOfDisplay_w, 2, 0, 0, H_ScreenOfDisplay);
+ XM_define_procedure(XDefaultScreenOfDisplay, gxm_XDefaultScreenOfDisplay_w, 1, 0, 0, H_XDefaultScreenOfDisplay);
+ XM_define_procedure(XEventMaskOfScreen, gxm_XEventMaskOfScreen_w, 1, 0, 0, H_EventMaskOfScreen);
+ XM_define_procedure(XScreenNumberOfScreen, gxm_XScreenNumberOfScreen_w, 1, 0, 0, H_XScreenNumberOfScreen);
+ XM_define_procedure(XSetErrorHandler, gxm_XSetErrorHandler_w, 1, 0, 0, H_XSetErrorHandler);
+ XM_define_procedure(XSetIOErrorHandler, gxm_XSetIOErrorHandler_w, 1, 0, 0, H_XSetIOErrorHandler);
+ XM_define_procedure(XListPixmapFormats, gxm_XListPixmapFormats_w, 1, 0, 0, H_XListPixmapFormats);
+ XM_define_procedure(XListDepths, gxm_XListDepths_w, 2, 0, 0, H_XListDepths);
+ XM_define_procedure(XReconfigureWMWindow, gxm_XReconfigureWMWindow_w, 5, 0, 0, H_XReconfigureWMWindow);
+ XM_define_procedure(XGetWMProtocols, gxm_XGetWMProtocols_w, 2, 0, 0, H_XGetWMProtocols);
+ XM_define_procedure(XSetWMProtocols, gxm_XSetWMProtocols_w, 4, 0, 0, H_XSetWMProtocols);
+ XM_define_procedure(XIconifyWindow, gxm_XIconifyWindow_w, 3, 0, 0, H_XIconifyWindow);
+ XM_define_procedure(XWithdrawWindow, gxm_XWithdrawWindow_w, 3, 0, 0, H_XWithdrawWindow);
+ XM_define_procedure(XGetCommand, gxm_XGetCommand_w, 2, 0, 0, H_XGetCommand);
+ XM_define_procedure(XGetWMColormapWindows, gxm_XGetWMColormapWindows_w, 2, 0, 0, H_XGetWMColormapWindows);
+ XM_define_procedure(XSetWMColormapWindows, gxm_XSetWMColormapWindows_w, 4, 0, 0, H_XSetWMColormapWindows);
+ XM_define_procedure(XSetTransientForHint, gxm_XSetTransientForHint_w, 3, 0, 0, H_XSetTransientForHint);
+ XM_define_procedure(XActivateScreenSaver, gxm_XActivateScreenSaver_w, 1, 0, 0, H_XActivateScreenSaver);
+ XM_define_procedure(XAllocColor, gxm_XAllocColor_w, 3, 0, 0, H_XAllocColor);
+ XM_define_procedure(XAllocColorCells, gxm_XAllocColorCells_w, 5, 0, 0, H_XAllocColorCells);
+ XM_define_procedure(XAllocColorPlanes, gxm_XAllocColorPlanes_w, 0, 0, 1, H_XAllocColorPlanes);
+ XM_define_procedure(XAllocNamedColor, gxm_XAllocNamedColor_w, 5, 0, 0, H_XAllocNamedColor);
+ XM_define_procedure(XAllowEvents, gxm_XAllowEvents_w, 3, 0, 0, H_XAllowEvents);
+ XM_define_procedure(XAutoRepeatOff, gxm_XAutoRepeatOff_w, 1, 0, 0, H_XAutoRepeatOff);
+ XM_define_procedure(XAutoRepeatOn, gxm_XAutoRepeatOn_w, 1, 0, 0, H_XAutoRepeatOn);
+ XM_define_procedure(XBell, gxm_XBell_w, 2, 0, 0, H_XBell);
+ XM_define_procedure(XBitmapBitOrder, gxm_XBitmapBitOrder_w, 1, 0, 0, H_BitmapBitOrder);
+ XM_define_procedure(XBitmapPad, gxm_XBitmapPad_w, 1, 0, 0, H_BitmapPad);
+ XM_define_procedure(XBitmapUnit, gxm_XBitmapUnit_w, 1, 0, 0, H_BitmapUnit);
+ XM_define_procedure(XCellsOfScreen, gxm_XCellsOfScreen_w, 1, 0, 0, H_CellsOfScreen);
+ XM_define_procedure(XChangeActivePointerGrab, gxm_XChangeActivePointerGrab_w, 4, 0, 0, H_XChangeActivePointerGrab);
+ XM_define_procedure(XChangeGC, gxm_XChangeGC_w, 4, 0, 0, H_XChangeGC);
+ XM_define_procedure(XChangeKeyboardControl, gxm_XChangeKeyboardControl_w, 3, 0, 0, H_XChangeKeyboardControl);
+ XM_define_procedure(XChangeKeyboardMapping, gxm_XChangeKeyboardMapping_w, 5, 0, 0, H_XChangeKeyboardMapping);
+ XM_define_procedure(XChangePointerControl, gxm_XChangePointerControl_w, 6, 0, 0, H_XChangePointerControl);
+ XM_define_procedure(XChangeProperty, gxm_XChangeProperty_w, 7, 1, 0, H_XChangeProperty);
+ XM_define_procedure(XChangeWindowAttributes, gxm_XChangeWindowAttributes_w, 4, 0, 0, H_XChangeWindowAttributes);
+ XM_define_procedure(XCheckIfEvent, gxm_XCheckIfEvent_w, 3, 0, 0, H_XCheckIfEvent);
+ XM_define_procedure(XCheckMaskEvent, gxm_XCheckMaskEvent_w, 2, 0, 0, H_XCheckMaskEvent);
+ XM_define_procedure(XCheckTypedEvent, gxm_XCheckTypedEvent_w, 2, 0, 0, H_XCheckTypedEvent);
+ XM_define_procedure(XCheckTypedWindowEvent, gxm_XCheckTypedWindowEvent_w, 3, 0, 0, H_XCheckTypedWindowEvent);
+ XM_define_procedure(XCheckWindowEvent, gxm_XCheckWindowEvent_w, 3, 0, 0, H_XCheckWindowEvent);
+ XM_define_procedure(XCirculateSubwindows, gxm_XCirculateSubwindows_w, 3, 0, 0, H_XCirculateSubwindows);
+ XM_define_procedure(XCirculateSubwindowsDown, gxm_XCirculateSubwindowsDown_w, 2, 0, 0, H_XCirculateSubwindowsDown);
+ XM_define_procedure(XCirculateSubwindowsUp, gxm_XCirculateSubwindowsUp_w, 2, 0, 0, H_XCirculateSubwindowsUp);
+ XM_define_procedure(XClearArea, gxm_XClearArea_w, 7, 0, 0, H_XClearArea);
+ XM_define_procedure(XClearWindow, gxm_XClearWindow_w, 2, 0, 0, H_XClearWindow);
+ XM_define_procedure(XCloseDisplay, gxm_XCloseDisplay_w, 1, 0, 0, H_XCloseDisplay);
+ XM_define_procedure(XConfigureWindow, gxm_XConfigureWindow_w, 4, 0, 0, H_XConfigureWindow);
+ XM_define_procedure(XConnectionNumber, gxm_XConnectionNumber_w, 1, 0, 0, H_XConnectionNumber);
+ XM_define_procedure(XConvertSelection, gxm_XConvertSelection_w, 6, 0, 0, H_XConvertSelection);
+ XM_define_procedure(XCopyArea, gxm_XCopyArea_w, 0, 0, 1, H_XCopyArea);
+ XM_define_procedure(XCopyGC, gxm_XCopyGC_w, 4, 0, 0, H_XCopyGC);
+ XM_define_procedure(XCopyPlane, gxm_XCopyPlane_w, 0, 0, 1, H_XCopyPlane);
+ XM_define_procedure(XDefaultDepth, gxm_XDefaultDepth_w, 2, 0, 0, H_XDefaultDepth);
+ XM_define_procedure(XDefaultDepthOfScreen, gxm_XDefaultDepthOfScreen_w, 1, 0, 0, H_XDefaultDepthOfScreen);
+ XM_define_procedure(XDefaultScreen, gxm_XDefaultScreen_w, 1, 0, 0, H_XDefaultScreen);
+ XM_define_procedure(XDefineCursor, gxm_XDefineCursor_w, 3, 0, 0, H_XDefineCursor);
+ XM_define_procedure(XDeleteProperty, gxm_XDeleteProperty_w, 3, 0, 0, H_XDeleteProperty);
+ XM_define_procedure(XDestroyWindow, gxm_XDestroyWindow_w, 2, 0, 0, H_XDestroyWindow);
+ XM_define_procedure(XDestroySubwindows, gxm_XDestroySubwindows_w, 2, 0, 0, H_XDestroySubwindows);
+ XM_define_procedure(XDoesBackingStore, gxm_XDoesBackingStore_w, 1, 0, 0, H_XDoesBackingStore);
+ XM_define_procedure(XDoesSaveUnders, gxm_XDoesSaveUnders_w, 1, 0, 0, H_XDoesSaveUnders);
+ XM_define_procedure(XDisableAccessControl, gxm_XDisableAccessControl_w, 1, 0, 0, H_XDisableAccessControl);
+ XM_define_procedure(XDisplayCells, gxm_XDisplayCells_w, 2, 0, 0, H_XDisplayCells);
+ XM_define_procedure(XDisplayHeight, gxm_XDisplayHeight_w, 2, 0, 0, H_XDisplayHeight);
+ XM_define_procedure(XDisplayHeightMM, gxm_XDisplayHeightMM_w, 2, 0, 0, H_XDisplayHeightMM);
+ XM_define_procedure(XDisplayKeycodes, gxm_XDisplayKeycodes_w, 1, 0, 0, H_XDisplayKeycodes);
+ XM_define_procedure(XDisplayPlanes, gxm_XDisplayPlanes_w, 2, 0, 0, H_XDisplayPlanes);
+ XM_define_procedure(XDisplayWidth, gxm_XDisplayWidth_w, 2, 0, 0, H_XDisplayWidth);
+ XM_define_procedure(XDisplayWidthMM, gxm_XDisplayWidthMM_w, 2, 0, 0, H_XDisplayWidthMM);
+ XM_define_procedure(XDrawArc, gxm_XDrawArc_w, 9, 0, 0, H_XDrawArc);
+ XM_define_procedure(XDrawArcs, gxm_XDrawArcs_w, 5, 0, 0, H_XDrawArcs);
+ XM_define_procedure(XDrawImageString, gxm_XDrawImageString_w, 7, 0, 0, H_XDrawImageString);
+ XM_define_procedure(XDrawLine, gxm_XDrawLine_w, 7, 0, 0, H_XDrawLine);
+ XM_define_procedure(XDrawLines, gxm_XDrawLines_w, 6, 0, 0, H_XDrawLines);
+ XM_define_procedure(XDrawLinesDirect, gxm_XDrawLinesDirect_w, 6, 0, 0, H_XDrawLinesDirect);
+ XM_define_procedure(freeXPoints, gxm_FreeXPoints_w, 1, 0, 0, H_freeXPoints);
+ XM_define_procedure(vector->XPoints, gxm_Vector2XPoints_w, 1, 0, 0, H_vector2XPoints);
+ XM_define_procedure(XDrawPoint, gxm_XDrawPoint_w, 5, 0, 0, H_XDrawPoint);
+ XM_define_procedure(XDrawPoints, gxm_XDrawPoints_w, 6, 0, 0, H_XDrawPoints);
+ XM_define_procedure(XDrawRectangle, gxm_XDrawRectangle_w, 7, 0, 0, H_XDrawRectangle);
+ XM_define_procedure(XDrawRectangles, gxm_XDrawRectangles_w, 5, 0, 0, H_XDrawRectangles);
+ XM_define_procedure(XDrawSegments, gxm_XDrawSegments_w, 5, 0, 0, H_XDrawSegments);
+ XM_define_procedure(XDrawString, gxm_XDrawString_w, 7, 0, 0, H_XDrawString);
+ XM_define_procedure(XDrawText, gxm_XDrawText_w, 6, 1, 0, H_XDrawText);
+ XM_define_procedure(XEnableAccessControl, gxm_XEnableAccessControl_w, 1, 0, 0, H_XEnableAccessControl);
+ XM_define_procedure(XEventsQueued, gxm_XEventsQueued_w, 2, 0, 0, H_XEventsQueued);
+ XM_define_procedure(XFetchName, gxm_XFetchName_w, 2, 0, 0, H_XFetchName);
+ XM_define_procedure(XFillArc, gxm_XFillArc_w, 9, 0, 0, H_XFillArc);
+ XM_define_procedure(XFillArcs, gxm_XFillArcs_w, 5, 0, 0, H_XFillArcs);
+ XM_define_procedure(XFillPolygon, gxm_XFillPolygon_w, 7, 0, 0, H_XFillPolygon);
+ XM_define_procedure(XFillRectangle, gxm_XFillRectangle_w, 7, 0, 0, H_XFillRectangle);
+ XM_define_procedure(XFillRectangles, gxm_XFillRectangles_w, 5, 0, 0, H_XFillRectangles);
+ XM_define_procedure(XFlush, gxm_XFlush_w, 1, 0, 0, H_XFlush);
+ XM_define_procedure(XForceScreenSaver, gxm_XForceScreenSaver_w, 2, 0, 0, H_XForceScreenSaver);
+ XM_define_procedure(XFree, gxm_XFree_w, 1, 0, 0, H_XFree);
+ XM_define_procedure(XFreeColormap, gxm_XFreeColormap_w, 2, 0, 0, H_XFreeColormap);
+ XM_define_procedure(XFreeColors, gxm_XFreeColors_w, 5, 0, 0, H_XFreeColors);
+ XM_define_procedure(XFreeCursor, gxm_XFreeCursor_w, 2, 0, 0, H_XFreeCursor);
+ XM_define_procedure(XFreeExtensionList, gxm_XFreeExtensionList_w, 1, 0, 0, "XFreeExtensionList(list) frees list (from XListExtensions)");
+ XM_define_procedure(XFreeFont, gxm_XFreeFont_w, 2, 0, 0, H_XFreeFont);
+ XM_define_procedure(XFreeFontInfo, gxm_XFreeFontInfo_w, 3, 0, 0, H_XFreeFontInfo);
+ XM_define_procedure(XFreeFontNames, gxm_XFreeFontNames_w, 1, 0, 0, H_XFreeFontNames);
+ XM_define_procedure(XFreeFontPath, gxm_XFreeFontPath_w, 1, 0, 0, H_XFreeFontPath);
+ XM_define_procedure(XFreeGC, gxm_XFreeGC_w, 2, 0, 0, H_XFreeGC);
+ XM_define_procedure(XFreeModifiermap, gxm_XFreeModifiermap_w, 1, 0, 0, H_XFreeModifiermap);
+ XM_define_procedure(XFreePixmap, gxm_XFreePixmap_w, 2, 0, 0, H_XFreePixmap);
+ XM_define_procedure(XGeometry, gxm_XGeometry_w, 0, 0, 1, H_XGeometry);
+ XM_define_procedure(XGetErrorText, gxm_XGetErrorText_w, 4, 0, 0, H_XGetErrorText);
+ XM_define_procedure(XGetFontProperty, gxm_XGetFontProperty_w, 2, 0, 0, H_XGetFontProperty);
+ XM_define_procedure(XGetGCValues, gxm_XGetGCValues_w, 3, 0, 0, H_XGetGCValues);
+ XM_define_procedure(XGCValues, gxm_XGCValues_w, 0, 0, 0, "XGCValues returns a new XGCValue struct");
+ XM_define_procedure(XEvent, gxm_XEvent_w, 0, 1, 0, "XEvent returns a new XEvent struct");
+ XM_define_procedure(XGetGeometry, gxm_XGetGeometry_w, 2, 0, 0, H_XGetGeometry);
+ XM_define_procedure(XGetIconName, gxm_XGetIconName_w, 2, 0, 0, H_XGetIconName);
+ XM_define_procedure(XGetInputFocus, gxm_XGetInputFocus_w, 1, 0, 0, H_XGetInputFocus);
+ XM_define_procedure(XGetKeyboardControl, gxm_XGetKeyboardControl_w, 1, 0, 0, H_XGetKeyboardControl);
+ XM_define_procedure(XGetPointerControl, gxm_XGetPointerControl_w, 1, 0, 0, H_XGetPointerControl);
+ XM_define_procedure(XGetPointerMapping, gxm_XGetPointerMapping_w, 3, 0, 0, H_XGetPointerMapping);
+ XM_define_procedure(XGetScreenSaver, gxm_XGetScreenSaver_w, 1, 0, 0, H_XGetScreenSaver);
+ XM_define_procedure(XGetTransientForHint, gxm_XGetTransientForHint_w, 2, 0, 0, H_XGetTransientForHint);
+ XM_define_procedure(XGetWindowProperty, gxm_XGetWindowProperty_w, 0, 0, 1, H_XGetWindowProperty);
+ XM_define_procedure(XGetWindowAttributes, gxm_XGetWindowAttributes_w, 2, 0, 0, H_XGetWindowAttributes);
+ XM_define_procedure(XGrabButton, gxm_XGrabButton_w, 0, 0, 1, H_XGrabButton);
+ XM_define_procedure(XGrabKey, gxm_XGrabKey_w, 7, 0, 0, H_XGrabKey);
+ XM_define_procedure(XGrabKeyboard, gxm_XGrabKeyboard_w, 6, 0, 0, H_XGrabKeyboard);
+ XM_define_procedure(XGrabPointer, gxm_XGrabPointer_w, 9, 0, 0, H_XGrabPointer);
+ XM_define_procedure(XGrabServer, gxm_XGrabServer_w, 1, 0, 0, H_XGrabServer);
+ XM_define_procedure(XHeightMMOfScreen, gxm_XHeightMMOfScreen_w, 1, 0, 0, H_HeightMMOfScreen);
+ XM_define_procedure(XHeightOfScreen, gxm_XHeightOfScreen_w, 1, 0, 0, H_HeightOfScreen);
+ XM_define_procedure(XIfEvent, gxm_XIfEvent_w, 3, 0, 0, H_XIfEvent);
+ XM_define_procedure(XImageByteOrder, gxm_XImageByteOrder_w, 1, 0, 0, H_ImageByteOrder);
+ XM_define_procedure(XInstallColormap, gxm_XInstallColormap_w, 2, 0, 0, H_XInstallColormap);
+ XM_define_procedure(XKeysymToKeycode, gxm_XKeysymToKeycode_w, 2, 0, 0, H_XKeysymToKeycode);
+ XM_define_procedure(XKillClient, gxm_XKillClient_w, 2, 0, 0, H_XKillClient);
+ XM_define_procedure(XLookupColor, gxm_XLookupColor_w, 5, 0, 0, H_XLookupColor);
+ XM_define_procedure(XLowerWindow, gxm_XLowerWindow_w, 2, 0, 0, H_XLowerWindow);
+ XM_define_procedure(XMapRaised, gxm_XMapRaised_w, 2, 0, 0, H_XMapRaised);
+ XM_define_procedure(XMapSubwindows, gxm_XMapSubwindows_w, 2, 0, 0, H_XMapSubwindows);
+ XM_define_procedure(XMapWindow, gxm_XMapWindow_w, 2, 0, 0, H_XMapWindow);
+ XM_define_procedure(XMaskEvent, gxm_XMaskEvent_w, 2, 0, 0, H_XMaskEvent);
+ XM_define_procedure(XMaxCmapsOfScreen, gxm_XMaxCmapsOfScreen_w, 1, 0, 0, H_MaxCmapsOfScreen);
+ XM_define_procedure(XMinCmapsOfScreen, gxm_XMinCmapsOfScreen_w, 1, 0, 0, H_MinCmapsOfScreen);
+ XM_define_procedure(XMoveResizeWindow, gxm_XMoveResizeWindow_w, 6, 0, 0, H_XMoveResizeWindow);
+ XM_define_procedure(XMoveWindow, gxm_XMoveWindow_w, 4, 0, 0, H_XMoveWindow);
+ XM_define_procedure(XNextEvent, gxm_XNextEvent_w, 1, 0, 0, H_XNextEvent);
+ XM_define_procedure(XNoOp, gxm_XNoOp_w, 1, 0, 0, H_XNoOp);
+ XM_define_procedure(XParseColor, gxm_XParseColor_w, 4, 0, 0, H_XParseColor);
+ XM_define_procedure(XParseGeometry, gxm_XParseGeometry_w, 1, 0, 0, H_XParseGeometry);
+ XM_define_procedure(XPeekEvent, gxm_XPeekEvent_w, 1, 0, 0, H_XPeekEvent);
+ XM_define_procedure(XPeekIfEvent, gxm_XPeekIfEvent_w, 3, 0, 0, H_XPeekIfEvent);
+ XM_define_procedure(XPending, gxm_XPending_w, 1, 0, 0, H_XPending);
+ XM_define_procedure(XPlanesOfScreen, gxm_XPlanesOfScreen_w, 1, 0, 0, H_PlanesOfScreen);
+ XM_define_procedure(XProtocolRevision, gxm_XProtocolRevision_w, 1, 0, 0, H_ProtocolRevision);
+ XM_define_procedure(XProtocolVersion, gxm_XProtocolVersion_w, 1, 0, 0, H_ProtocolVersion);
+ XM_define_procedure(XPutBackEvent, gxm_XPutBackEvent_w, 2, 0, 0, H_XPutBackEvent);
+ XM_define_procedure(XPutImage, gxm_XPutImage_w, 0, 0, 1, H_XPutImage);
+ XM_define_procedure(XQLength, gxm_XQLength_w, 1, 0, 0, H_QLength);
+ XM_define_procedure(XQueryBestCursor, gxm_XQueryBestCursor_w, 4, 0, 0, H_XQueryBestCursor);
+ XM_define_procedure(XQueryBestSize, gxm_XQueryBestSize_w, 5, 0, 0, H_XQueryBestSize);
+ XM_define_procedure(XQueryBestStipple, gxm_XQueryBestStipple_w, 4, 0, 0, H_XQueryBestStipple);
+ XM_define_procedure(XQueryBestTile, gxm_XQueryBestTile_w, 4, 0, 0, H_XQueryBestTile);
+ XM_define_procedure(XQueryColor, gxm_XQueryColor_w, 3, 0, 0, H_XQueryColor);
+ XM_define_procedure(XQueryColors, gxm_XQueryColors_w, 3, 1, 0, H_XQueryColors);
+ XM_define_procedure(XQueryExtension, gxm_XQueryExtension_w, 2, 0, 0, H_XQueryExtension);
+ XM_define_procedure(XQueryKeymap, gxm_XQueryKeymap_w, 1, 0, 0, H_XQueryKeymap);
+ XM_define_procedure(XQueryPointer, gxm_XQueryPointer_w, 2, 0, 0, H_XQueryPointer);
+ XM_define_procedure(XQueryTextExtents, gxm_XQueryTextExtents_w, 3, 0, 0, H_XQueryTextExtents);
+ XM_define_procedure(XQueryTree, gxm_XQueryTree_w, 2, 0, 0, H_XQueryTree);
+ XM_define_procedure(XRaiseWindow, gxm_XRaiseWindow_w, 2, 0, 0, H_XRaiseWindow);
+ XM_define_procedure(XReadBitmapFile, gxm_XReadBitmapFile_w, 3, 0, 0, H_XReadBitmapFile);
+ XM_define_procedure(XReadBitmapFileData, gxm_XReadBitmapFileData_w, 1, 0, 0, H_XReadBitmapFileData);
+ XM_define_procedure(XRebindKeysym, gxm_XRebindKeysym_w, 6, 0, 0, H_XRebindKeysym);
+ XM_define_procedure(XRecolorCursor, gxm_XRecolorCursor_w, 4, 0, 0, H_XRecolorCursor);
+ XM_define_procedure(XRefreshKeyboardMapping, gxm_XRefreshKeyboardMapping_w, 1, 0, 0, H_XRefreshKeyboardMapping);
+ XM_define_procedure(XReparentWindow, gxm_XReparentWindow_w, 5, 0, 0, H_XReparentWindow);
+ XM_define_procedure(XResetScreenSaver, gxm_XResetScreenSaver_w, 1, 0, 0, H_XResetScreenSaver);
+ XM_define_procedure(XResizeWindow, gxm_XResizeWindow_w, 4, 0, 0, H_XResizeWindow);
+ XM_define_procedure(XRestackWindows, gxm_XRestackWindows_w, 3, 0, 0, H_XRestackWindows);
+ XM_define_procedure(XRotateBuffers, gxm_XRotateBuffers_w, 2, 0, 0, H_XRotateBuffers);
+ XM_define_procedure(XRotateWindowProperties, gxm_XRotateWindowProperties_w, 5, 0, 0, H_XRotateWindowProperties);
+ XM_define_procedure(XScreenCount, gxm_XScreenCount_w, 1, 0, 0, H_ScreenCount);
+ XM_define_procedure(XSelectInput, gxm_XSelectInput_w, 3, 0, 0, H_XSelectInput);
+ XM_define_procedure(XSendEvent, gxm_XSendEvent_w, 5, 0, 0, H_XSendEvent);
+ XM_define_procedure(XSetAccessControl, gxm_XSetAccessControl_w, 2, 0, 0, H_XSetAccessControl);
+ XM_define_procedure(XSetArcMode, gxm_XSetArcMode_w, 3, 0, 0, H_XSetArcMode);
+ XM_define_procedure(XSetBackground, gxm_XSetBackground_w, 3, 0, 0, H_XSetBackground);
+ XM_define_procedure(XSetClipMask, gxm_XSetClipMask_w, 3, 0, 0, H_XSetClipMask);
+ XM_define_procedure(XSetClipOrigin, gxm_XSetClipOrigin_w, 4, 0, 0, H_XSetClipOrigin);
+ XM_define_procedure(XSetClipRectangles, gxm_XSetClipRectangles_w, 7, 0, 0, H_XSetClipRectangles);
+ XM_define_procedure(XSetCloseDownMode, gxm_XSetCloseDownMode_w, 2, 0, 0, H_XSetCloseDownMode);
+ XM_define_procedure(XSetCommand, gxm_XSetCommand_w, 4, 0, 0, H_XSetCommand);
+ XM_define_procedure(XSetDashes, gxm_XSetDashes_w, 4, 1, 0, H_XSetDashes);
+ XM_define_procedure(XSetFillRule, gxm_XSetFillRule_w, 3, 0, 0, H_XSetFillRule);
+ XM_define_procedure(XSetFillStyle, gxm_XSetFillStyle_w, 3, 0, 0, H_XSetFillStyle);
+ XM_define_procedure(XSetFont, gxm_XSetFont_w, 3, 0, 0, H_XSetFont);
+ XM_define_procedure(XSetFontPath, gxm_XSetFontPath_w, 3, 0, 0, H_XSetFontPath);
+ XM_define_procedure(XSetForeground, gxm_XSetForeground_w, 3, 0, 0, H_XSetForeground);
+ XM_define_procedure(XSetFunction, gxm_XSetFunction_w, 3, 0, 0, H_XSetFunction);
+ XM_define_procedure(XSetGraphicsExposures, gxm_XSetGraphicsExposures_w, 3, 0, 0, H_XSetGraphicsExposures);
+ XM_define_procedure(XSetIconName, gxm_XSetIconName_w, 3, 0, 0, H_XSetIconName);
+ XM_define_procedure(XSetInputFocus, gxm_XSetInputFocus_w, 4, 0, 0, H_XSetInputFocus);
+ XM_define_procedure(XSetLineAttributes, gxm_XSetLineAttributes_w, 6, 0, 0, H_XSetLineAttributes);
+ XM_define_procedure(XSetModifierMapping, gxm_XSetModifierMapping_w, 2, 0, 0, H_XSetModifierMapping);
+ XM_define_procedure(XSetPlaneMask, gxm_XSetPlaneMask_w, 3, 0, 0, H_XSetPlaneMask);
+ XM_define_procedure(XSetPointerMapping, gxm_XSetPointerMapping_w, 2, 1, 0, H_XSetPointerMapping);
+ XM_define_procedure(XSetScreenSaver, gxm_XSetScreenSaver_w, 5, 0, 0, H_XSetScreenSaver);
+ XM_define_procedure(XSetSelectionOwner, gxm_XSetSelectionOwner_w, 4, 0, 0, H_XSetSelectionOwner);
+ XM_define_procedure(XSetState, gxm_XSetState_w, 6, 0, 0, H_XSetState);
+ XM_define_procedure(XSetStipple, gxm_XSetStipple_w, 3, 0, 0, H_XSetStipple);
+ XM_define_procedure(XSetSubwindowMode, gxm_XSetSubwindowMode_w, 3, 0, 0, H_XSetSubwindowMode);
+ XM_define_procedure(XSetTSOrigin, gxm_XSetTSOrigin_w, 4, 0, 0, H_XSetTSOrigin);
+ XM_define_procedure(XSetTile, gxm_XSetTile_w, 3, 0, 0, H_XSetTile);
+ XM_define_procedure(XSetWindowBackground, gxm_XSetWindowBackground_w, 3, 0, 0, H_XSetWindowBackground);
+ XM_define_procedure(XSetWindowBackgroundPixmap, gxm_XSetWindowBackgroundPixmap_w, 3, 0, 0, H_XSetWindowBackgroundPixmap);
+ XM_define_procedure(XSetWindowBorder, gxm_XSetWindowBorder_w, 3, 0, 0, H_XSetWindowBorder);
+ XM_define_procedure(XSetWindowBorderPixmap, gxm_XSetWindowBorderPixmap_w, 3, 0, 0, H_XSetWindowBorderPixmap);
+ XM_define_procedure(XSetWindowBorderWidth, gxm_XSetWindowBorderWidth_w, 3, 0, 0, H_XSetWindowBorderWidth);
+ XM_define_procedure(XSetWindowColormap, gxm_XSetWindowColormap_w, 3, 0, 0, H_XSetWindowColormap);
+ XM_define_procedure(XStoreBuffer, gxm_XStoreBuffer_w, 4, 0, 0, H_XStoreBuffer);
+ XM_define_procedure(XStoreBytes, gxm_XStoreBytes_w, 3, 0, 0, H_XStoreBytes);
+ XM_define_procedure(XStoreColor, gxm_XStoreColor_w, 3, 0, 0, H_XStoreColor);
+ XM_define_procedure(XStoreColors, gxm_XStoreColors_w, 4, 0, 0, H_XStoreColors);
+ XM_define_procedure(XStoreName, gxm_XStoreName_w, 3, 0, 0, H_XStoreName);
+ XM_define_procedure(XStoreNamedColor, gxm_XStoreNamedColor_w, 5, 0, 0, H_XStoreNamedColor);
+ XM_define_procedure(XSync, gxm_XSync_w, 2, 0, 0, H_XSync);
+ XM_define_procedure(XTextExtents, gxm_XTextExtents_w, 3, 0, 0, H_XTextExtents);
+ XM_define_procedure(XTextWidth, gxm_XTextWidth_w, 3, 0, 0, H_XTextWidth);
+ XM_define_procedure(XTranslateCoordinates, gxm_XTranslateCoordinates_w, 5, 0, 0, H_XTranslateCoordinates);
+ XM_define_procedure(XUndefineCursor, gxm_XUndefineCursor_w, 2, 0, 0, H_XUndefineCursor);
+ XM_define_procedure(XUngrabButton, gxm_XUngrabButton_w, 4, 0, 0, H_XUngrabButton);
+ XM_define_procedure(XUngrabKey, gxm_XUngrabKey_w, 4, 0, 0, H_XUngrabKey);
+ XM_define_procedure(XUngrabKeyboard, gxm_XUngrabKeyboard_w, 2, 0, 0, H_XUngrabKeyboard);
+ XM_define_procedure(XUngrabPointer, gxm_XUngrabPointer_w, 2, 0, 0, H_XUngrabPointer);
+ XM_define_procedure(XUngrabServer, gxm_XUngrabServer_w, 1, 0, 0, H_XUngrabServer);
+ XM_define_procedure(XUninstallColormap, gxm_XUninstallColormap_w, 2, 0, 0, H_XUninstallColormap);
+ XM_define_procedure(XUnloadFont, gxm_XUnloadFont_w, 2, 0, 0, H_XUnloadFont);
+ XM_define_procedure(XUnmapSubwindows, gxm_XUnmapSubwindows_w, 2, 0, 0, H_XUnmapSubwindows);
+ XM_define_procedure(XUnmapWindow, gxm_XUnmapWindow_w, 2, 0, 0, H_XUnmapWindow);
+ XM_define_procedure(XVendorRelease, gxm_XVendorRelease_w, 1, 0, 0, H_VendorRelease);
+ XM_define_procedure(XWarpPointer, gxm_XWarpPointer_w, 9, 0, 0, H_XWarpPointer);
+ XM_define_procedure(XWidthMMOfScreen, gxm_XWidthMMOfScreen_w, 1, 0, 0, H_WidthMMOfScreen);
+ XM_define_procedure(XWidthOfScreen, gxm_XWidthOfScreen_w, 1, 0, 0, H_WidthOfScreen);
+ XM_define_procedure(XWindowEvent, gxm_XWindowEvent_w, 3, 0, 0, H_XWindowEvent);
+ XM_define_procedure(XWriteBitmapFile, gxm_XWriteBitmapFile_w, 7, 0, 0, H_XWriteBitmapFile);
+ XM_define_procedure(XSupportsLocale, gxm_XSupportsLocale_w, 0, 0, 0, H_XSupportsLocale);
+ XM_define_procedure(XSetLocaleModifiers, gxm_XSetLocaleModifiers_w, 1, 0, 0, H_XSetLocaleModifiers);
+ XM_define_procedure(XCreateFontSet, gxm_XCreateFontSet_w, 2, 0, 0, H_XCreateFontSet);
+ XM_define_procedure(XFreeFontSet, gxm_XFreeFontSet_w, 2, 0, 0, H_XFreeFontSet);
+ XM_define_procedure(XFontsOfFontSet, gxm_XFontsOfFontSet_w, 1, 0, 0, H_XFontsOfFontSet);
+ XM_define_procedure(XBaseFontNameListOfFontSet, gxm_XBaseFontNameListOfFontSet_w, 1, 0, 0, H_XBaseFontNameListOfFontSet);
+ XM_define_procedure(XLocaleOfFontSet, gxm_XLocaleOfFontSet_w, 1, 0, 0, H_XLocaleOfFontSet);
+ XM_define_procedure(XContextDependentDrawing, gxm_XContextDependentDrawing_w, 1, 0, 0, H_XContextDependentDrawing);
+ XM_define_procedure(XDirectionalDependentDrawing, gxm_XDirectionalDependentDrawing_w, 1, 0, 0, H_XDirectionalDependentDrawing);
+ XM_define_procedure(XContextualDrawing, gxm_XContextualDrawing_w, 1, 0, 0, H_XContextualDrawing);
+ XM_define_procedure(XFilterEvent, gxm_XFilterEvent_w, 2, 0, 0, H_XFilterEvent);
+ XM_define_procedure(XAllocIconSize, gxm_XAllocIconSize_w, 0, 0, 0, H_XAllocIconSize);
+ XM_define_procedure(XAllocStandardColormap, gxm_XAllocStandardColormap_w, 0, 0, 0, H_XAllocStandardColormap);
+ XM_define_procedure(XAllocWMHints, gxm_XAllocWMHints_w, 0, 0, 0, H_XAllocWMHints);
+ XM_define_procedure(XClipBox, gxm_XClipBox_w, 1, 0, 0, H_XClipBox);
+ XM_define_procedure(XCreateRegion, gxm_XCreateRegion_w, 0, 0, 0, H_XCreateRegion);
+ XM_define_procedure(XDefaultString, gxm_XDefaultString_w, 0, 0, 0, H_XDefaultString);
+ XM_define_procedure(XDeleteContext, gxm_XDeleteContext_w, 3, 0, 0, H_XDeleteContext);
+ XM_define_procedure(XDestroyRegion, gxm_XDestroyRegion_w, 1, 0, 0, H_XDestroyRegion);
+ XM_define_procedure(XEmptyRegion, gxm_XEmptyRegion_w, 1, 0, 0, H_XEmptyRegion);
+ XM_define_procedure(XEqualRegion, gxm_XEqualRegion_w, 2, 0, 0, H_XEqualRegion);
+ XM_define_procedure(XFindContext, gxm_XFindContext_w, 3, 0, 0, H_XFindContext);
+ XM_define_procedure(XGetIconSizes, gxm_XGetIconSizes_w, 2, 0, 0, H_XGetIconSizes);
+ XM_define_procedure(XGetRGBColormaps, gxm_XGetRGBColormaps_w, 3, 0, 0, H_XGetRGBColormaps);
+ XM_define_procedure(XGetVisualInfo, gxm_XGetVisualInfo_w, 3, 0, 0, H_XGetVisualInfo);
+ XM_define_procedure(XGetWMHints, gxm_XGetWMHints_w, 2, 0, 0, H_XGetWMHints);
+ XM_define_procedure(XIntersectRegion, gxm_XIntersectRegion_w, 3, 0, 0, H_XIntersectRegion);
+ XM_define_procedure(XConvertCase, gxm_XConvertCase_w, 1, 0, 0, H_XConvertCase);
+ XM_define_procedure(XLookupString, gxm_XLookupString_w, 1, 0, 0, H_XLookupString);
+ XM_define_procedure(XMatchVisualInfo, gxm_XMatchVisualInfo_w, 4, 0, 0, H_XMatchVisualInfo);
+ XM_define_procedure(XOffsetRegion, gxm_XOffsetRegion_w, 3, 0, 0, H_XOffsetRegion);
+ XM_define_procedure(XPointInRegion, gxm_XPointInRegion_w, 3, 0, 0, H_XPointInRegion);
+ XM_define_procedure(XPolygonRegion, gxm_XPolygonRegion_w, 3, 0, 0, H_XPolygonRegion);
+ XM_define_procedure(XRectInRegion, gxm_XRectInRegion_w, 5, 0, 0, H_XRectInRegion);
+ XM_define_procedure(XSaveContext, gxm_XSaveContext_w, 4, 0, 0, H_XSaveContext);
+ XM_define_procedure(XSetRGBColormaps, gxm_XSetRGBColormaps_w, 5, 0, 0, H_XSetRGBColormaps);
+ XM_define_procedure(XSetWMHints, gxm_XSetWMHints_w, 3, 0, 0, H_XSetWMHints);
+ XM_define_procedure(XSetRegion, gxm_XSetRegion_w, 3, 0, 0, H_XSetRegion);
+ XM_define_procedure(XSetWMProperties, gxm_XSetWMProperties_w, 8, 0, 0, H_XSetWMProperties);
+ XM_define_procedure(XShrinkRegion, gxm_XShrinkRegion_w, 3, 0, 0, H_XShrinkRegion);
+ XM_define_procedure(XSubtractRegion, gxm_XSubtractRegion_w, 3, 0, 0, H_XSubtractRegion);
+ XM_define_procedure(XUnionRectWithRegion, gxm_XUnionRectWithRegion_w, 3, 0, 0, H_XUnionRectWithRegion);
+ XM_define_procedure(XUnionRegion, gxm_XUnionRegion_w, 3, 0, 0, H_XUnionRegion);
+ XM_define_procedure(XXorRegion, gxm_XXorRegion_w, 3, 0, 0, H_XXorRegion);
+
+ XM_define_procedure(DefaultScreen, gxm_DefaultScreen_w, 1, 0, 0, H_DefaultScreen);
+ XM_define_procedure(DefaultRootWindow, gxm_DefaultRootWindow_w, 1, 0, 0, H_DefaultRootWindow);
+ XM_define_procedure(QLength, gxm_QLength_w, 1, 0, 0, H_QLength);
+ XM_define_procedure(ScreenCount, gxm_ScreenCount_w, 1, 0, 0, H_ScreenCount);
+ XM_define_procedure(ServerVendor, gxm_ServerVendor_w, 1, 0, 0, H_ServerVendor);
+ XM_define_procedure(ProtocolVersion, gxm_ProtocolVersion_w, 1, 0, 0, H_ProtocolVersion);
+ XM_define_procedure(ProtocolRevision, gxm_ProtocolRevision_w, 1, 0, 0, H_ProtocolRevision);
+ XM_define_procedure(VendorRelease, gxm_VendorRelease_w, 1, 0, 0, H_VendorRelease);
+ XM_define_procedure(DisplayString, gxm_DisplayString_w, 1, 0, 0, H_DisplayString);
+ XM_define_procedure(BitmapUnit, gxm_BitmapUnit_w, 1, 0, 0, H_BitmapUnit);
+ XM_define_procedure(BitmapBitOrder, gxm_BitmapBitOrder_w, 1, 0, 0, H_BitmapBitOrder);
+ XM_define_procedure(BitmapPad, gxm_BitmapPad_w, 1, 0, 0, H_BitmapPad);
+ XM_define_procedure(ImageByteOrder, gxm_ImageByteOrder_w, 1, 0, 0, H_ImageByteOrder);
+ XM_define_procedure(NextRequest, gxm_NextRequest_w, 1, 0, 0, H_NextRequest);
+ XM_define_procedure(LastKnownRequestProcessed, gxm_LastKnownRequestProcessed_w, 1, 0, 0, H_LastKnownRequestProcessed);
+ XM_define_procedure(DefaultScreenOfDisplay, gxm_DefaultScreenOfDisplay_w, 1, 0, 0, H_DefaultScreenOfDisplay);
+ XM_define_procedure(DisplayOfScreen, gxm_DisplayOfScreen_w, 1, 0, 0, H_DisplayOfScreen);
+ XM_define_procedure(RootWindowOfScreen, gxm_RootWindowOfScreen_w, 1, 0, 0, H_RootWindowOfScreen);
+ XM_define_procedure(BlackPixelOfScreen, gxm_BlackPixelOfScreen_w, 1, 0, 0, H_BlackPixelOfScreen);
+ XM_define_procedure(WhitePixelOfScreen, gxm_WhitePixelOfScreen_w, 1, 0, 0, H_WhitePixelOfScreen);
+ XM_define_procedure(DefaultColormapOfScreen, gxm_DefaultColormapOfScreen_w, 1, 0, 0, H_DefaultColormapOfScreen);
+ XM_define_procedure(DefaultDepthOfScreen, gxm_DefaultDepthOfScreen_w, 1, 0, 0, H_DefaultDepthOfScreen);
+ XM_define_procedure(DefaultGCOfScreen, gxm_DefaultGCOfScreen_w, 1, 0, 0, H_DefaultGCOfScreen);
+ XM_define_procedure(DefaultVisualOfScreen, gxm_DefaultVisualOfScreen_w, 1, 0, 0, H_DefaultVisualOfScreen);
+ XM_define_procedure(WidthOfScreen, gxm_WidthOfScreen_w, 1, 0, 0, H_WidthOfScreen);
+ XM_define_procedure(HeightOfScreen, gxm_HeightOfScreen_w, 1, 0, 0, H_HeightOfScreen);
+ XM_define_procedure(WidthMMOfScreen, gxm_WidthMMOfScreen_w, 1, 0, 0, H_WidthMMOfScreen);
+ XM_define_procedure(HeightMMOfScreen, gxm_HeightMMOfScreen_w, 1, 0, 0, H_HeightMMOfScreen);
+ XM_define_procedure(PlanesOfScreen, gxm_PlanesOfScreen_w, 1, 0, 0, H_PlanesOfScreen);
+ XM_define_procedure(CellsOfScreen, gxm_CellsOfScreen_w, 1, 0, 0, H_CellsOfScreen);
+ XM_define_procedure(MinCmapsOfScreen, gxm_MinCmapsOfScreen_w, 1, 0, 0, H_MinCmapsOfScreen);
+ XM_define_procedure(MaxCmapsOfScreen, gxm_MaxCmapsOfScreen_w, 1, 0, 0, H_MaxCmapsOfScreen);
+ XM_define_procedure(DoesSaveUnders, gxm_DoesSaveUnders_w, 1, 0, 0, H_DoesSaveUnders);
+ XM_define_procedure(DoesBackingStore, gxm_DoesBackingStore_w, 1, 0, 0, H_DoesBackingStore);
+ XM_define_procedure(EventMaskOfScreen, gxm_EventMaskOfScreen_w, 1, 0, 0, H_EventMaskOfScreen);
+ XM_define_procedure(RootWindow, gxm_RootWindow_w, 2, 0, 0, H_RootWindow);
+ XM_define_procedure(DefaultVisual, gxm_DefaultVisual_w, 2, 0, 0, H_DefaultVisual);
+ XM_define_procedure(DefaultGC, gxm_DefaultGC_w, 2, 0, 0, H_DefaultGC);
+ XM_define_procedure(BlackPixel, gxm_BlackPixel_w, 2, 0, 0, H_BlackPixel);
+ XM_define_procedure(WhitePixel, gxm_WhitePixel_w, 2, 0, 0, H_WhitePixel);
+ XM_define_procedure(DisplayWidth, gxm_DisplayWidth_w, 2, 0, 0, H_DisplayWidth);
+ XM_define_procedure(DisplayHeight, gxm_DisplayHeight_w, 2, 0, 0, H_DisplayHeight);
+ XM_define_procedure(DisplayWidthMM, gxm_DisplayWidthMM_w, 2, 0, 0, H_DisplayWidthMM);
+ XM_define_procedure(DisplayHeightMM, gxm_DisplayHeightMM_w, 2, 0, 0, H_DisplayHeightMM);
+ XM_define_procedure(DisplayPlanes, gxm_DisplayPlanes_w, 2, 0, 0, H_DisplayPlanes);
+ XM_define_procedure(DisplayCells, gxm_DisplayCells_w, 2, 0, 0, H_DisplayCells);
+ XM_define_procedure(DefaultColormap, gxm_DefaultColormap_w, 2, 0, 0, H_DefaultColormap);
+ XM_define_procedure(ScreenOfDisplay, gxm_ScreenOfDisplay_w, 2, 0, 0, H_ScreenOfDisplay);
+ XM_define_procedure(DefaultDepth, gxm_DefaultDepth_w, 2, 0, 0, H_DefaultDepth);
+
+ XM_define_procedure(IsKeypadKey, gxm_IsKeypadKey_w, 1, 0, 0, H_IsKeypadKey);
+ XM_define_procedure(IsPrivateKeypadKey, gxm_IsPrivateKeypadKey_w, 1, 0, 0, H_IsPrivateKeypadKey);
+ XM_define_procedure(IsCursorKey, gxm_IsCursorKey_w, 1, 0, 0, H_IsCursorKey);
+ XM_define_procedure(IsPFKey, gxm_IsPFKey_w, 1, 0, 0, H_IsPFKey);
+ XM_define_procedure(IsFunctionKey, gxm_IsFunctionKey_w, 1, 0, 0, H_IsFunctionKey);
+ XM_define_procedure(IsMiscFunctionKey, gxm_IsMiscFunctionKey_w, 1, 0, 0, H_IsMiscFunctionKey);
+ XM_define_procedure(IsModifierKey, gxm_IsModifierKey_w, 1, 0, 0, H_IsModifierKey);
+
+ XM_define_procedure(XButtonEvent?, g_is_XButtonEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XButtonEvent");
+ XM_define_procedure(XCirculateEvent?, g_is_XCirculateEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XCirculateEvent");
+ XM_define_procedure(XCirculateRequestEvent?, g_is_XCirculateRequestEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XCirculateRequestEvent");
+ XM_define_procedure(XClientMessageEvent?, g_is_XClientMessageEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XClientMessageEvent");
+ XM_define_procedure(XColormapEvent?, g_is_XColormapEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XColormapEvent");
+ XM_define_procedure(XConfigureEvent?, g_is_XConfigureEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XConfigureEvent");
+ XM_define_procedure(XConfigureRequestEvent?, g_is_XConfigureRequestEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XConfigureRequestEvent");
+ XM_define_procedure(XCreateWindowEvent?, g_is_XCreateWindowEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XCreateWindowEvent");
+ XM_define_procedure(XCrossingEvent?, g_is_XCrossingEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XCrossingEvent");
+ XM_define_procedure(XDestroyWindowEvent?, g_is_XDestroyWindowEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XDestroyWindowEvent");
+ XM_define_procedure(XErrorEvent?, g_is_XErrorEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XErrorEvent");
+ XM_define_procedure(XExposeEvent?, g_is_XExposeEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XExposeEvent");
+ XM_define_procedure(XFocusChangeEvent?, g_is_XFocusChangeEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XFocusChangeEvent");
+ XM_define_procedure(XGraphicsExposeEvent?, g_is_XGraphicsExposeEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XGraphicsExposeEvent");
+ XM_define_procedure(XGravityEvent?, g_is_XGravityEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XGravityEvent");
+ XM_define_procedure(XKeyEvent?, g_is_XKeyEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XKeyEvent");
+ XM_define_procedure(XKeymapEvent?, g_is_XKeymapEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XKeymapEvent");
+ XM_define_procedure(XMapEvent?, g_is_XMapEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XMapEvent");
+ XM_define_procedure(XMapRequestEvent?, g_is_XMapRequestEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XMapRequestEvent");
+ XM_define_procedure(XMappingEvent?, g_is_XMappingEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XMappingEvent");
+ XM_define_procedure(XMotionEvent?, g_is_XMotionEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XMotionEvent");
+ XM_define_procedure(XNoExposeEvent?, g_is_XNoExposeEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XNoExposeEvent");
+ XM_define_procedure(XPropertyEvent?, g_is_XPropertyEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XPropertyEvent");
+ XM_define_procedure(XReparentEvent?, g_is_XReparentEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XReparentEvent");
+ XM_define_procedure(XResizeRequestEvent?, g_is_XResizeRequestEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XResizeRequestEvent");
+ XM_define_procedure(XSelectionClearEvent?, g_is_XSelectionClearEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XSelectionClearEvent");
+ XM_define_procedure(XSelectionEvent?, g_is_XSelectionEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XSelectionEvent");
+ XM_define_procedure(XSelectionRequestEvent?, g_is_XSelectionRequestEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XSelectionRequestEvent");
+ XM_define_procedure(XSetWindowAttributes?, g_is_XSetWindowAttributes_w, 1, 0, 0, PROC_TRUE " if arg is a XSetWindowAttributes");
+ XM_define_procedure(XUnmapEvent?, g_is_XUnmapEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XUnmapEvent");
+ XM_define_procedure(XVisibilityEvent?, g_is_XVisibilityEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XVisibilityEvent");
+ XM_define_procedure(XIconSize?, g_is_XIconSize_w, 1, 0, 0, PROC_TRUE " if arg is a XIconSize object");
+
+ XM_define_procedure(XmCreateMessageBox, gxm_XmCreateMessageBox_w, 3, 1, 0, H_XmCreateMessageBox);
+ XM_define_procedure(XmCreateMessageDialog, gxm_XmCreateMessageDialog_w, 3, 1, 0, H_XmCreateMessageDialog);
+ XM_define_procedure(XmCreateErrorDialog, gxm_XmCreateErrorDialog_w, 3, 1, 0, H_XmCreateErrorDialog);
+ XM_define_procedure(XmCreateInformationDialog, gxm_XmCreateInformationDialog_w, 3, 1, 0, H_XmCreateInformationDialog);
+ XM_define_procedure(XmCreateQuestionDialog, gxm_XmCreateQuestionDialog_w, 3, 1, 0, H_XmCreateQuestionDialog);
+ XM_define_procedure(XmCreateWarningDialog, gxm_XmCreateWarningDialog_w, 3, 1, 0, H_XmCreateWarningDialog);
+ XM_define_procedure(XmCreateWorkingDialog, gxm_XmCreateWorkingDialog_w, 3, 1, 0, H_XmCreateWorkingDialog);
+ XM_define_procedure(XmCreateTemplateDialog, gxm_XmCreateTemplateDialog_w, 3, 1, 0, H_XmCreateTemplateDialog);
+ XM_define_procedure(XmMessageBoxGetChild, gxm_XmMessageBoxGetChild_w, 2, 0, 0, H_XmMessageBoxGetChild);
+ XM_define_procedure(XmCreateArrowButtonGadget, gxm_XmCreateArrowButtonGadget_w, 3, 1, 0, H_XmCreateArrowButtonGadget);
+ XM_define_procedure(XmCreateArrowButton, gxm_XmCreateArrowButton_w, 3, 1, 0, H_XmCreateArrowButton);
+ XM_define_procedure(XmCreateNotebook, gxm_XmCreateNotebook_w, 3, 1, 0, H_XmCreateNotebook);
+ XM_define_procedure(XmNotebookGetPageInfo, gxm_XmNotebookGetPageInfo_w, 2, 0, 0, H_XmNotebookGetPageInfo);
+ XM_define_procedure(XmTransferSetParameters, gxm_XmTransferSetParameters_w, 5, 0, 0, H_XmTransferSetParameters);
+ XM_define_procedure(XmTransferDone, gxm_XmTransferDone_w, 2, 0, 0, H_XmTransferDone);
+ XM_define_procedure(XmTransferValue, gxm_XmTransferValue_w, 5, 0, 0, H_XmTransferValue);
+ XM_define_procedure(XmTransferStartRequest, gxm_XmTransferStartRequest_w, 1, 0, 0, H_XmTransferStartRequest);
+ XM_define_procedure(XmTransferSendRequest, gxm_XmTransferSendRequest_w, 2, 0, 0, H_XmTransferSendRequest);
+ XM_define_procedure(XmCreateComboBox, gxm_XmCreateComboBox_w, 3, 1, 0, H_XmCreateComboBox);
+ XM_define_procedure(XmCreateDropDownComboBox, gxm_XmCreateDropDownComboBox_w, 3, 1, 0, H_XmCreateDropDownComboBox);
+ XM_define_procedure(XmCreateDropDownList, gxm_XmCreateDropDownList_w, 3, 1, 0, H_XmCreateDropDownList);
+ XM_define_procedure(XmComboBoxAddItem, gxm_XmComboBoxAddItem_w, 4, 0, 0, H_XmComboBoxAddItem);
+ XM_define_procedure(XmComboBoxDeletePos, gxm_XmComboBoxDeletePos_w, 2, 0, 0, H_XmComboBoxDeletePos);
+ XM_define_procedure(XmComboBoxSelectItem, gxm_XmComboBoxSelectItem_w, 2, 0, 0, H_XmComboBoxSelectItem);
+ XM_define_procedure(XmComboBoxSetItem, gxm_XmComboBoxSetItem_w, 2, 0, 0, H_XmComboBoxSetItem);
+ XM_define_procedure(XmComboBoxUpdate, gxm_XmComboBoxUpdate_w, 1, 0, 0, H_XmComboBoxUpdate);
+ XM_define_procedure(XmCreateContainer, gxm_XmCreateContainer_w, 3, 1, 0, H_XmCreateContainer);
+ XM_define_procedure(XmContainerGetItemChildren, gxm_XmContainerGetItemChildren_w, 2, 0, 0, H_XmContainerGetItemChildren);
+ XM_define_procedure(XmContainerRelayout, gxm_XmContainerRelayout_w, 1, 0, 0, H_XmContainerRelayout);
+ XM_define_procedure(XmContainerReorder, gxm_XmContainerReorder_w, 3, 0, 0, H_XmContainerReorder);
+ XM_define_procedure(XmContainerCut, gxm_XmContainerCut_w, 2, 0, 0, H_XmContainerCut);
+ XM_define_procedure(XmContainerCopy, gxm_XmContainerCopy_w, 2, 0, 0, H_XmContainerCopy);
+ XM_define_procedure(XmContainerPaste, gxm_XmContainerPaste_w, 1, 0, 0, H_XmContainerPaste);
+ XM_define_procedure(XmContainerCopyLink, gxm_XmContainerCopyLink_w, 2, 0, 0, H_XmContainerCopyLink);
+ XM_define_procedure(XmContainerPasteLink, gxm_XmContainerPasteLink_w, 1, 0, 0, H_XmContainerPasteLink);
+ XM_define_procedure(XmCreateSpinBox, gxm_XmCreateSpinBox_w, 3, 1, 0, H_XmCreateSpinBox);
+ XM_define_procedure(XmSpinBoxValidatePosition, gxm_XmSpinBoxValidatePosition_w, 1, 0, 0, H_XmSpinBoxValidatePosition);
+ XM_define_procedure(XmCreateSimpleSpinBox, gxm_XmCreateSimpleSpinBox_w, 3, 1, 0, H_XmCreateSimpleSpinBox);
+ XM_define_procedure(XmSimpleSpinBoxAddItem, gxm_XmSimpleSpinBoxAddItem_w, 3, 0, 0, H_XmSimpleSpinBoxAddItem);
+ XM_define_procedure(XmSimpleSpinBoxDeletePos, gxm_XmSimpleSpinBoxDeletePos_w, 2, 0, 0, H_XmSimpleSpinBoxDeletePos);
+ XM_define_procedure(XmSimpleSpinBoxSetItem, gxm_XmSimpleSpinBoxSetItem_w, 2, 0, 0, H_XmSimpleSpinBoxSetItem);
+ XM_define_procedure(XmDropSiteRegistered, gxm_XmDropSiteRegistered_w, 1, 0, 0, H_XmDropSiteRegistered);
+ XM_define_procedure(XmTextFieldCopyLink, gxm_XmTextFieldCopyLink_w, 2, 0, 0, H_XmTextFieldCopyLink);
+ XM_define_procedure(XmTextFieldPasteLink, gxm_XmTextFieldPasteLink_w, 1, 0, 0, H_XmTextFieldPasteLink);
+ XM_define_procedure(XmTextGetCenterline, gxm_XmTextGetCenterline_w, 1, 0, 0, H_XmTextGetCenterline);
+ XM_define_procedure(XmToggleButtonGadgetSetValue, gxm_XmToggleButtonGadgetSetValue_w, 3, 0, 0, H_XmToggleButtonGadgetSetValue);
+ XM_define_procedure(XmCreateIconGadget, gxm_XmCreateIconGadget_w, 3, 1, 0, H_XmCreateIconGadget);
+ XM_define_procedure(XmCreateIconHeader, gxm_XmCreateIconHeader_w, 3, 1, 0, H_XmCreateIconHeader);
+ XM_define_procedure(XmObjectAtPoint, gxm_XmObjectAtPoint_w, 3, 0, 0, H_XmObjectAtPoint);
+ XM_define_procedure(XmConvertStringToUnits, gxm_XmConvertStringToUnits_w, 4, 0, 0, H_XmConvertStringToUnits);
+ XM_define_procedure(XmCreateGrabShell, gxm_XmCreateGrabShell_w, 3, 1, 0, H_XmCreateGrabShell);
+ XM_define_procedure(XmToggleButtonSetValue, gxm_XmToggleButtonSetValue_w, 3, 0, 0, H_XmToggleButtonSetValue);
+ XM_define_procedure(XmTextPasteLink, gxm_XmTextPasteLink_w, 1, 0, 0, H_XmTextPasteLink);
+ XM_define_procedure(XmTextCopyLink, gxm_XmTextCopyLink_w, 2, 0, 0, H_XmTextCopyLink);
+ XM_define_procedure(XmScaleSetTicks, gxm_XmScaleSetTicks_w, 7, 0, 0, H_XmScaleSetTicks);
+ XM_define_procedure(XmInternAtom, gxm_XmInternAtom_w, 3, 0, 0, H_XmInternAtom);
+ XM_define_procedure(XmGetAtomName, gxm_XmGetAtomName_w, 2, 0, 0, H_XmGetAtomName);
+ XM_define_procedure(XmCreatePanedWindow, gxm_XmCreatePanedWindow_w, 3, 1, 0, H_XmCreatePanedWindow);
+ XM_define_procedure(XmCreateBulletinBoard, gxm_XmCreateBulletinBoard_w, 3, 1, 0, H_XmCreateBulletinBoard);
+ XM_define_procedure(XmCreateBulletinBoardDialog, gxm_XmCreateBulletinBoardDialog_w, 3, 1, 0, H_XmCreateBulletinBoardDialog);
+ XM_define_procedure(XmCreateCascadeButtonGadget, gxm_XmCreateCascadeButtonGadget_w, 3, 1, 0, H_XmCreateCascadeButtonGadget);
+ XM_define_procedure(XmCascadeButtonGadgetHighlight, gxm_XmCascadeButtonGadgetHighlight_w, 2, 0, 0, H_XmCascadeButtonGadgetHighlight);
+ XM_define_procedure(XmAddProtocols, gxm_XmAddProtocols_w, 3, 1, 0, H_XmAddProtocols);
+ XM_define_procedure(XmAddWMProtocols, gxm_XmAddWMProtocols_w, 2, 1, 0, H_XmAddWMProtocols);
+ XM_define_procedure(XmRemoveProtocols, gxm_XmRemoveProtocols_w, 3, 1, 0, H_XmRemoveProtocols);
+ XM_define_procedure(XmRemoveWMProtocols, gxm_XmRemoveWMProtocols_w, 2, 1, 0, H_XmRemoveWMProtocols);
+ XM_define_procedure(XmAddProtocolCallback, gxm_XmAddProtocolCallback_w, 5, 0, 0, H_XmAddProtocolCallback);
+ XM_define_procedure(XmAddWMProtocolCallback, gxm_XmAddWMProtocolCallback_w, 4, 0, 0, H_XmAddWMProtocolCallback);
+ XM_define_procedure(XmRemoveProtocolCallback, gxm_XmRemoveProtocolCallback_w, 5, 0, 0, H_XmRemoveProtocolCallback);
+ XM_define_procedure(XmRemoveWMProtocolCallback, gxm_XmRemoveWMProtocolCallback_w, 4, 0, 0, H_XmRemoveWMProtocolCallback);
+ XM_define_procedure(XmActivateProtocol, gxm_XmActivateProtocol_w, 3, 0, 0, H_XmActivateProtocol);
+ XM_define_procedure(XmDeactivateProtocol, gxm_XmDeactivateProtocol_w, 3, 0, 0, H_XmDeactivateProtocol);
+ XM_define_procedure(XmActivateWMProtocol, gxm_XmActivateWMProtocol_w, 2, 0, 0, H_XmActivateWMProtocol);
+ XM_define_procedure(XmDeactivateWMProtocol, gxm_XmDeactivateWMProtocol_w, 2, 0, 0, H_XmDeactivateWMProtocol);
+ XM_define_procedure(XmSetProtocolHooks, gxm_XmSetProtocolHooks_w, 7, 0, 0, H_XmSetProtocolHooks);
+ XM_define_procedure(XmSetWMProtocolHooks, gxm_XmSetWMProtocolHooks_w, 6, 0, 0, H_XmSetWMProtocolHooks);
+ XM_define_procedure(XmCreateCascadeButton, gxm_XmCreateCascadeButton_w, 3, 1, 0, H_XmCreateCascadeButton);
+ XM_define_procedure(XmCascadeButtonHighlight, gxm_XmCascadeButtonHighlight_w, 2, 0, 0, H_XmCascadeButtonHighlight);
+ XM_define_procedure(XmCreatePushButtonGadget, gxm_XmCreatePushButtonGadget_w, 3, 1, 0, H_XmCreatePushButtonGadget);
+ XM_define_procedure(XmCreatePushButton, gxm_XmCreatePushButton_w, 3, 1, 0, H_XmCreatePushButton);
+ XM_define_procedure(XmCreateCommand, gxm_XmCreateCommand_w, 3, 1, 0, H_XmCreateCommand);
+ XM_define_procedure(XmCommandGetChild, gxm_XmCommandGetChild_w, 2, 0, 0, H_XmCommandGetChild);
+ XM_define_procedure(XmCommandSetValue, gxm_XmCommandSetValue_w, 2, 0, 0, H_XmCommandSetValue);
+ XM_define_procedure(XmCommandAppendValue, gxm_XmCommandAppendValue_w, 2, 0, 0, H_XmCommandAppendValue);
+ XM_define_procedure(XmCommandError, gxm_XmCommandError_w, 2, 0, 0, H_XmCommandError);
+ XM_define_procedure(XmCreateCommandDialog, gxm_XmCreateCommandDialog_w, 3, 1, 0, H_XmCreateCommandDialog);
+ XM_define_procedure(XmMenuPosition, gxm_XmMenuPosition_w, 2, 0, 0, H_XmMenuPosition);
+ XM_define_procedure(XmCreateRowColumn, gxm_XmCreateRowColumn_w, 3, 1, 0, H_XmCreateRowColumn);
+ XM_define_procedure(XmCreateWorkArea, gxm_XmCreateWorkArea_w, 3, 1, 0, H_XmCreateWorkArea);
+ XM_define_procedure(XmCreateRadioBox, gxm_XmCreateRadioBox_w, 3, 1, 0, H_XmCreateRadioBox);
+ XM_define_procedure(XmCreateOptionMenu, gxm_XmCreateOptionMenu_w, 3, 1, 0, H_XmCreateOptionMenu);
+ XM_define_procedure(XmOptionLabelGadget, gxm_XmOptionLabelGadget_w, 1, 0, 0, H_XmOptionLabelGadget);
+ XM_define_procedure(XmOptionButtonGadget, gxm_XmOptionButtonGadget_w, 1, 0, 0, H_XmOptionButtonGadget);
+ XM_define_procedure(XmCreateMenuBar, gxm_XmCreateMenuBar_w, 3, 1, 0, H_XmCreateMenuBar);
+ XM_define_procedure(XmCreatePopupMenu, gxm_XmCreatePopupMenu_w, 3, 1, 0, H_XmCreatePopupMenu);
+ XM_define_procedure(XmCreatePulldownMenu, gxm_XmCreatePulldownMenu_w, 3, 1, 0, H_XmCreatePulldownMenu);
+ XM_define_procedure(XmGetPostedFromWidget, gxm_XmGetPostedFromWidget_w, 1, 0, 0, H_XmGetPostedFromWidget);
+ XM_define_procedure(XmGetTearOffControl, gxm_XmGetTearOffControl_w, 1, 0, 0, H_XmGetTearOffControl);
+ XM_define_procedure(XmScaleSetValue, gxm_XmScaleSetValue_w, 2, 0, 0, H_XmScaleSetValue);
+ XM_define_procedure(XmScaleGetValue, gxm_XmScaleGetValue_w, 1, 0, 0, H_XmScaleGetValue);
+ XM_define_procedure(XmCreateScale, gxm_XmCreateScale_w, 3, 1, 0, H_XmCreateScale);
+ XM_define_procedure(XmClipboardBeginCopy, gxm_XmClipboardBeginCopy_w, 5, 0, 0, H_XmClipboardBeginCopy);
+ XM_define_procedure(XmWidgetGetDisplayRect, gxm_XmWidgetGetDisplayRect_w, 1, 0, 0, H_XmWidgetGetDisplayRect);
+ XM_define_procedure(XmClipboardStartCopy, gxm_XmClipboardStartCopy_w, 6, 0, 0, H_XmClipboardStartCopy);
+ XM_define_procedure(XmClipboardCopy, gxm_XmClipboardCopy_w, 7, 0, 0, H_XmClipboardCopy);
+ XM_define_procedure(XmClipboardEndCopy, gxm_XmClipboardEndCopy_w, 3, 0, 0, H_XmClipboardEndCopy);
+ XM_define_procedure(XmClipboardCancelCopy, gxm_XmClipboardCancelCopy_w, 3, 0, 0, H_XmClipboardCancelCopy);
+ XM_define_procedure(XmClipboardWithdrawFormat, gxm_XmClipboardWithdrawFormat_w, 3, 0, 0, H_XmClipboardWithdrawFormat);
+ XM_define_procedure(XmClipboardCopyByName, gxm_XmClipboardCopyByName_w, 6, 0, 0, H_XmClipboardCopyByName);
+ XM_define_procedure(XmClipboardUndoCopy, gxm_XmClipboardUndoCopy_w, 2, 0, 0, H_XmClipboardUndoCopy);
+ XM_define_procedure(XmClipboardLock, gxm_XmClipboardLock_w, 2, 0, 0, H_XmClipboardLock);
+ XM_define_procedure(XmClipboardUnlock, gxm_XmClipboardUnlock_w, 3, 0, 0, H_XmClipboardUnlock);
+ XM_define_procedure(XmClipboardStartRetrieve, gxm_XmClipboardStartRetrieve_w, 3, 0, 0, H_XmClipboardStartRetrieve);
+ XM_define_procedure(XmClipboardEndRetrieve, gxm_XmClipboardEndRetrieve_w, 2, 0, 0, H_XmClipboardEndRetrieve);
+ XM_define_procedure(XmClipboardRetrieve, gxm_XmClipboardRetrieve_w, 4, 0, 0, H_XmClipboardRetrieve);
+ XM_define_procedure(XmClipboardInquireCount, gxm_XmClipboardInquireCount_w, 2, 0, 0, H_XmClipboardInquireCount);
+ XM_define_procedure(XmClipboardInquireFormat, gxm_XmClipboardInquireFormat_w, 4, 0, 0, H_XmClipboardInquireFormat);
+ XM_define_procedure(XmClipboardInquireLength, gxm_XmClipboardInquireLength_w, 3, 0, 0, H_XmClipboardInquireLength);
+ XM_define_procedure(XmClipboardInquirePendingItems, gxm_XmClipboardInquirePendingItems_w, 3, 0, 0, H_XmClipboardInquirePendingItems);
+ XM_define_procedure(XmClipboardRegisterFormat, gxm_XmClipboardRegisterFormat_w, 3, 0, 0, H_XmClipboardRegisterFormat);
+ XM_define_procedure(XmGetXmScreen, gxm_XmGetXmScreen_w, 1, 0, 0, H_XmGetXmScreen);
+ XM_define_procedure(XmCreateScrollBar, gxm_XmCreateScrollBar_w, 3, 1, 0, H_XmCreateScrollBar);
+ XM_define_procedure(XmScrollBarGetValues, gxm_XmScrollBarGetValues_w, 1, 0, 0, H_XmScrollBarGetValues);
+ XM_define_procedure(XmScrollBarSetValues, gxm_XmScrollBarSetValues_w, 6, 0, 0, H_XmScrollBarSetValues);
+ XM_define_procedure(XmCreateDialogShell, gxm_XmCreateDialogShell_w, 3, 1, 0, H_XmCreateDialogShell);
+ XM_define_procedure(XmCreateScrolledWindow, gxm_XmCreateScrolledWindow_w, 3, 1, 0, H_XmCreateScrolledWindow);
+ XM_define_procedure(XmScrollVisible, gxm_XmScrollVisible_w, 4, 0, 0, H_XmScrollVisible);
+ XM_define_procedure(XmGetDragContext, gxm_XmGetDragContext_w, 2, 0, 0, H_XmGetDragContext);
+ XM_define_procedure(XmGetXmDisplay, gxm_XmGetXmDisplay_w, 1, 0, 0, H_XmGetXmDisplay);
+ XM_define_procedure(XmSelectionBoxGetChild, gxm_XmSelectionBoxGetChild_w, 2, 0, 0, H_XmSelectionBoxGetChild);
+ XM_define_procedure(XmCreateSelectionBox, gxm_XmCreateSelectionBox_w, 3, 1, 0, H_XmCreateSelectionBox);
+ XM_define_procedure(XmCreateSelectionDialog, gxm_XmCreateSelectionDialog_w, 3, 1, 0, H_XmCreateSelectionDialog);
+ XM_define_procedure(XmCreatePromptDialog, gxm_XmCreatePromptDialog_w, 3, 1, 0, H_XmCreatePromptDialog);
+ XM_define_procedure(XmDragStart, gxm_XmDragStart_w, 3, 1, 0, H_XmDragStart);
+ XM_define_procedure(XmDragCancel, gxm_XmDragCancel_w, 1, 0, 0, H_XmDragCancel);
+ XM_define_procedure(XmTargetsAreCompatible, gxm_XmTargetsAreCompatible_w, 5, 0, 0, H_XmTargetsAreCompatible);
+ XM_define_procedure(XmCreateSeparatorGadget, gxm_XmCreateSeparatorGadget_w, 3, 1, 0, H_XmCreateSeparatorGadget);
+ XM_define_procedure(XmCreateDragIcon, gxm_XmCreateDragIcon_w, 3, 1, 0, H_XmCreateDragIcon);
+ XM_define_procedure(XmCreateSeparator, gxm_XmCreateSeparator_w, 3, 1, 0, H_XmCreateSeparator);
+ XM_define_procedure(XmCreateDrawingArea, gxm_XmCreateDrawingArea_w, 3, 1, 0, H_XmCreateDrawingArea);
+ XM_define_procedure(XmCreateDrawnButton, gxm_XmCreateDrawnButton_w, 3, 1, 0, H_XmCreateDrawnButton);
+ XM_define_procedure(XmDropSiteRegister, gxm_XmDropSiteRegister_w, 2, 1, 0, H_XmDropSiteRegister);
+ XM_define_procedure(XmDropSiteUnregister, gxm_XmDropSiteUnregister_w, 1, 0, 0, H_XmDropSiteUnregister);
+ XM_define_procedure(XmDropSiteStartUpdate, gxm_XmDropSiteStartUpdate_w, 1, 0, 0, H_XmDropSiteStartUpdate);
+ XM_define_procedure(XmDropSiteUpdate, gxm_XmDropSiteUpdate_w, 2, 1, 0, H_XmDropSiteUpdate);
+ XM_define_procedure(XmDropSiteEndUpdate, gxm_XmDropSiteEndUpdate_w, 1, 0, 0, H_XmDropSiteEndUpdate);
+ XM_define_procedure(XmDropSiteRetrieve, gxm_XmDropSiteRetrieve_w, 2, 1, 0, H_XmDropSiteRetrieve);
+ XM_define_procedure(XmDropSiteQueryStackingOrder, gxm_XmDropSiteQueryStackingOrder_w, 1, 0, 0, H_XmDropSiteQueryStackingOrder);
+ XM_define_procedure(XmDropSiteConfigureStackingOrder, gxm_XmDropSiteConfigureStackingOrder_w, 3, 0, 0, H_XmDropSiteConfigureStackingOrder);
+ XM_define_procedure(XmDropTransferStart, gxm_XmDropTransferStart_w, 2, 1, 0, H_XmDropTransferStart);
+ XM_define_procedure(XmDropTransferAdd, gxm_XmDropTransferAdd_w, 2, 0, 0, H_XmDropTransferAdd);
+ XM_define_procedure(XmTextFieldGetString, gxm_XmTextFieldGetString_w, 1, 0, 0, H_XmTextFieldGetString);
+ XM_define_procedure(XmTextFieldGetSubstring, gxm_XmTextFieldGetSubstring_w, 3, 0, 0, H_XmTextFieldGetSubstring);
+ XM_define_procedure(XmTextFieldGetLastPosition, gxm_XmTextFieldGetLastPosition_w, 1, 0, 0, H_XmTextFieldGetLastPosition);
+ XM_define_procedure(XmTextFieldSetString, gxm_XmTextFieldSetString_w, 2, 0, 0, H_XmTextFieldSetString);
+ XM_define_procedure(XmTextFieldReplace, gxm_XmTextFieldReplace_w, 4, 0, 0, H_XmTextFieldReplace);
+ XM_define_procedure(XmTextFieldInsert, gxm_XmTextFieldInsert_w, 3, 0, 0, H_XmTextFieldInsert);
+ XM_define_procedure(XmTextFieldSetAddMode, gxm_XmTextFieldSetAddMode_w, 2, 0, 0, H_XmTextFieldSetAddMode);
+ XM_define_procedure(XmTextFieldGetAddMode, gxm_XmTextFieldGetAddMode_w, 1, 0, 0, H_XmTextFieldGetAddMode);
+ XM_define_procedure(XmTextFieldGetEditable, gxm_XmTextFieldGetEditable_w, 1, 0, 0, H_XmTextFieldGetEditable);
+ XM_define_procedure(XmTextFieldSetEditable, gxm_XmTextFieldSetEditable_w, 2, 0, 0, H_XmTextFieldSetEditable);
+ XM_define_procedure(XmTextFieldGetMaxLength, gxm_XmTextFieldGetMaxLength_w, 1, 0, 0, H_XmTextFieldGetMaxLength);
+ XM_define_procedure(XmTextFieldSetMaxLength, gxm_XmTextFieldSetMaxLength_w, 2, 0, 0, H_XmTextFieldSetMaxLength);
+ XM_define_procedure(XmTextFieldGetCursorPosition, gxm_XmTextFieldGetCursorPosition_w, 1, 0, 0, H_XmTextFieldGetCursorPosition);
+ XM_define_procedure(XmTextFieldGetInsertionPosition, gxm_XmTextFieldGetInsertionPosition_w, 1, 0, 0, H_XmTextFieldGetInsertionPosition);
+ XM_define_procedure(XmTextFieldSetCursorPosition, gxm_XmTextFieldSetCursorPosition_w, 2, 0, 0, H_XmTextFieldSetCursorPosition);
+ XM_define_procedure(XmTextFieldSetInsertionPosition, gxm_XmTextFieldSetInsertionPosition_w, 2, 0, 0, H_XmTextFieldSetInsertionPosition);
+ XM_define_procedure(XmTextFieldGetSelectionPosition, gxm_XmTextFieldGetSelectionPosition_w, 1, 0, 0, H_XmTextFieldGetSelectionPosition);
+ XM_define_procedure(XmTextFieldGetSelection, gxm_XmTextFieldGetSelection_w, 1, 0, 0, H_XmTextFieldGetSelection);
+ XM_define_procedure(XmTextFieldRemove, gxm_XmTextFieldRemove_w, 1, 0, 0, H_XmTextFieldRemove);
+ XM_define_procedure(XmTextFieldCopy, gxm_XmTextFieldCopy_w, 2, 0, 0, H_XmTextFieldCopy);
+ XM_define_procedure(XmTextFieldCut, gxm_XmTextFieldCut_w, 2, 0, 0, H_XmTextFieldCut);
+ XM_define_procedure(XmTextFieldPaste, gxm_XmTextFieldPaste_w, 1, 0, 0, H_XmTextFieldPaste);
+ XM_define_procedure(XmTextFieldClearSelection, gxm_XmTextFieldClearSelection_w, 2, 0, 0, H_XmTextFieldClearSelection);
+ XM_define_procedure(XmTextFieldSetSelection, gxm_XmTextFieldSetSelection_w, 4, 0, 0, H_XmTextFieldSetSelection);
+ XM_define_procedure(XmTextFieldXYToPos, gxm_XmTextFieldXYToPos_w, 3, 0, 0, H_XmTextFieldXYToPos);
+ XM_define_procedure(XmTextFieldPosToXY, gxm_XmTextFieldPosToXY_w, 2, 0, 0, H_XmTextFieldPosToXY);
+ XM_define_procedure(XmTextFieldShowPosition, gxm_XmTextFieldShowPosition_w, 2, 0, 0, H_XmTextFieldShowPosition);
+ XM_define_procedure(XmTextFieldSetHighlight, gxm_XmTextFieldSetHighlight_w, 4, 0, 0, H_XmTextFieldSetHighlight);
+ XM_define_procedure(XmTextFieldGetBaseline, gxm_XmTextFieldGetBaseline_w, 1, 0, 0, H_XmTextFieldGetBaseline);
+ XM_define_procedure(XmCreateTextField, gxm_XmCreateTextField_w, 3, 1, 0, H_XmCreateTextField);
+ XM_define_procedure(XmFileSelectionBoxGetChild, gxm_XmFileSelectionBoxGetChild_w, 2, 0, 0, H_XmFileSelectionBoxGetChild);
+ XM_define_procedure(XmFileSelectionDoSearch, gxm_XmFileSelectionDoSearch_w, 2, 0, 0, H_XmFileSelectionDoSearch);
+ XM_define_procedure(XmCreateFileSelectionBox, gxm_XmCreateFileSelectionBox_w, 3, 1, 0, H_XmCreateFileSelectionBox);
+ XM_define_procedure(XmCreateFileSelectionDialog, gxm_XmCreateFileSelectionDialog_w, 3, 1, 0, H_XmCreateFileSelectionDialog);
+ XM_define_procedure(XmTextSetHighlight, gxm_XmTextSetHighlight_w, 4, 0, 0, H_XmTextSetHighlight);
+ XM_define_procedure(XmCreateScrolledText, gxm_XmCreateScrolledText_w, 3, 1, 0, H_XmCreateScrolledText);
+ XM_define_procedure(XmCreateText, gxm_XmCreateText_w, 3, 1, 0, H_XmCreateText);
+ XM_define_procedure(XmTextGetSubstring, gxm_XmTextGetSubstring_w, 3, 0, 0, H_XmTextGetSubstring);
+ XM_define_procedure(XmTextGetString, gxm_XmTextGetString_w, 1, 0, 0, H_XmTextGetString);
+ XM_define_procedure(XmTextGetLastPosition, gxm_XmTextGetLastPosition_w, 1, 0, 0, H_XmTextGetLastPosition);
+ XM_define_procedure(XmTextSetString, gxm_XmTextSetString_w, 2, 0, 0, H_XmTextSetString);
+ XM_define_procedure(XmTextReplace, gxm_XmTextReplace_w, 4, 0, 0, H_XmTextReplace);
+ XM_define_procedure(XmTextInsert, gxm_XmTextInsert_w, 3, 0, 0, H_XmTextInsert);
+ XM_define_procedure(XmTextSetAddMode, gxm_XmTextSetAddMode_w, 2, 0, 0, H_XmTextSetAddMode);
+ XM_define_procedure(XmTextGetAddMode, gxm_XmTextGetAddMode_w, 1, 0, 0, H_XmTextGetAddMode);
+ XM_define_procedure(XmTextGetEditable, gxm_XmTextGetEditable_w, 1, 0, 0, H_XmTextGetEditable);
+ XM_define_procedure(XmTextSetEditable, gxm_XmTextSetEditable_w, 2, 0, 0, H_XmTextSetEditable);
+ XM_define_procedure(XmTextGetMaxLength, gxm_XmTextGetMaxLength_w, 1, 0, 0, H_XmTextGetMaxLength);
+ XM_define_procedure(XmTextSetMaxLength, gxm_XmTextSetMaxLength_w, 2, 0, 0, H_XmTextSetMaxLength);
+ XM_define_procedure(XmTextGetTopCharacter, gxm_XmTextGetTopCharacter_w, 1, 0, 0, H_XmTextGetTopCharacter);
+ XM_define_procedure(XmTextSetTopCharacter, gxm_XmTextSetTopCharacter_w, 2, 0, 0, H_XmTextSetTopCharacter);
+ XM_define_procedure(XmTextGetCursorPosition, gxm_XmTextGetCursorPosition_w, 1, 0, 0, H_XmTextGetCursorPosition);
+ XM_define_procedure(XmTextGetInsertionPosition, gxm_XmTextGetInsertionPosition_w, 1, 0, 0, H_XmTextGetInsertionPosition);
+ XM_define_procedure(XmTextSetInsertionPosition, gxm_XmTextSetInsertionPosition_w, 2, 0, 0, H_XmTextSetInsertionPosition);
+ XM_define_procedure(XmTextSetCursorPosition, gxm_XmTextSetCursorPosition_w, 2, 0, 0, H_XmTextSetCursorPosition);
+ XM_define_procedure(XmTextRemove, gxm_XmTextRemove_w, 1, 0, 0, H_XmTextRemove);
+ XM_define_procedure(XmTextCopy, gxm_XmTextCopy_w, 2, 0, 0, H_XmTextCopy);
+ XM_define_procedure(XmTextCut, gxm_XmTextCut_w, 2, 0, 0, H_XmTextCut);
+ XM_define_procedure(XmTextPaste, gxm_XmTextPaste_w, 1, 0, 0, H_XmTextPaste);
+ XM_define_procedure(XmTextGetSelection, gxm_XmTextGetSelection_w, 1, 0, 0, H_XmTextGetSelection);
+ XM_define_procedure(XmTextSetSelection, gxm_XmTextSetSelection_w, 4, 0, 0, H_XmTextSetSelection);
+ XM_define_procedure(XmTextClearSelection, gxm_XmTextClearSelection_w, 2, 0, 0, H_XmTextClearSelection);
+ XM_define_procedure(XmTextGetSelectionPosition, gxm_XmTextGetSelectionPosition_w, 1, 0, 0, H_XmTextGetSelectionPosition);
+ XM_define_procedure(XmTextXYToPos, gxm_XmTextXYToPos_w, 3, 0, 0, H_XmTextXYToPos);
+ XM_define_procedure(XmTextPosToXY, gxm_XmTextPosToXY_w, 2, 0, 0, H_XmTextPosToXY);
+ XM_define_procedure(XmTextGetSource, gxm_XmTextGetSource_w, 1, 0, 0, H_XmTextGetSource);
+ XM_define_procedure(XmTextSetSource, gxm_XmTextSetSource_w, 4, 0, 0, H_XmTextSetSource);
+ XM_define_procedure(XmTextShowPosition, gxm_XmTextShowPosition_w, 2, 0, 0, H_XmTextShowPosition);
+ XM_define_procedure(XmTextScroll, gxm_XmTextScroll_w, 2, 0, 0, H_XmTextScroll);
+ XM_define_procedure(XmTextGetBaseline, gxm_XmTextGetBaseline_w, 1, 0, 0, H_XmTextGetBaseline);
+ XM_define_procedure(XmTextDisableRedisplay, gxm_XmTextDisableRedisplay_w, 1, 0, 0, H_XmTextDisableRedisplay);
+ XM_define_procedure(XmTextEnableRedisplay, gxm_XmTextEnableRedisplay_w, 1, 0, 0, H_XmTextEnableRedisplay);
+ XM_define_procedure(XmTextFindString, gxm_XmTextFindString_w, 4, 0, 0, H_XmTextFindString);
+ XM_define_procedure(XmCreateForm, gxm_XmCreateForm_w, 3, 1, 0, H_XmCreateForm);
+ XM_define_procedure(XmCreateFormDialog, gxm_XmCreateFormDialog_w, 3, 1, 0, H_XmCreateFormDialog);
+ XM_define_procedure(XmCreateFrame, gxm_XmCreateFrame_w, 3, 1, 0, H_XmCreateFrame);
+ XM_define_procedure(XmToggleButtonGadgetGetState, gxm_XmToggleButtonGadgetGetState_w, 1, 0, 0, H_XmToggleButtonGadgetGetState);
+ XM_define_procedure(XmToggleButtonGadgetSetState, gxm_XmToggleButtonGadgetSetState_w, 3, 0, 0, H_XmToggleButtonGadgetSetState);
+ XM_define_procedure(XmCreateToggleButtonGadget, gxm_XmCreateToggleButtonGadget_w, 3, 1, 0, H_XmCreateToggleButtonGadget);
+ XM_define_procedure(XmToggleButtonGetState, gxm_XmToggleButtonGetState_w, 1, 0, 0, H_XmToggleButtonGetState);
+ XM_define_procedure(XmToggleButtonSetState, gxm_XmToggleButtonSetState_w, 3, 0, 0, H_XmToggleButtonSetState);
+ XM_define_procedure(XmCreateToggleButton, gxm_XmCreateToggleButton_w, 3, 1, 0, H_XmCreateToggleButton);
+ XM_define_procedure(XmCreateLabelGadget, gxm_XmCreateLabelGadget_w, 3, 1, 0, H_XmCreateLabelGadget);
+ XM_define_procedure(XmCreateLabel, gxm_XmCreateLabel_w, 3, 1, 0, H_XmCreateLabel);
+ XM_define_procedure(XmIsMotifWMRunning, gxm_XmIsMotifWMRunning_w, 1, 0, 0, H_XmIsMotifWMRunning);
+ XM_define_procedure(XmListAddItem, gxm_XmListAddItem_w, 3, 0, 0, H_XmListAddItem);
+ XM_define_procedure(XmListAddItems, gxm_XmListAddItems_w, 4, 0, 0, H_XmListAddItems);
+ XM_define_procedure(XmListAddItemsUnselected, gxm_XmListAddItemsUnselected_w, 4, 0, 0, H_XmListAddItemsUnselected);
+ XM_define_procedure(XmListAddItemUnselected, gxm_XmListAddItemUnselected_w, 3, 0, 0, H_XmListAddItemUnselected);
+ XM_define_procedure(XmListDeleteItem, gxm_XmListDeleteItem_w, 2, 0, 0, H_XmListDeleteItem);
+ XM_define_procedure(XmListDeleteItems, gxm_XmListDeleteItems_w, 2, 1, 0, H_XmListDeleteItems);
+ XM_define_procedure(XmListDeletePositions, gxm_XmListDeletePositions_w, 2, 1, 0, H_XmListDeletePositions);
+ XM_define_procedure(XmListDeletePos, gxm_XmListDeletePos_w, 2, 0, 0, H_XmListDeletePos);
+ XM_define_procedure(XmListDeleteItemsPos, gxm_XmListDeleteItemsPos_w, 3, 0, 0, H_XmListDeleteItemsPos);
+ XM_define_procedure(XmListDeleteAllItems, gxm_XmListDeleteAllItems_w, 1, 0, 0, H_XmListDeleteAllItems);
+ XM_define_procedure(XmListReplaceItems, gxm_XmListReplaceItems_w, 4, 0, 0, H_XmListReplaceItems);
+ XM_define_procedure(XmListReplaceItemsPos, gxm_XmListReplaceItemsPos_w, 4, 0, 0, H_XmListReplaceItemsPos);
+ XM_define_procedure(XmListReplaceItemsUnselected, gxm_XmListReplaceItemsUnselected_w, 4, 0, 0, H_XmListReplaceItemsUnselected);
+ XM_define_procedure(XmListReplaceItemsPosUnselected, gxm_XmListReplaceItemsPosUnselected_w, 4, 0, 0, H_XmListReplaceItemsPosUnselected);
+ XM_define_procedure(XmListReplacePositions, gxm_XmListReplacePositions_w, 4, 0, 0, H_XmListReplacePositions);
+ XM_define_procedure(XmListSelectItem, gxm_XmListSelectItem_w, 3, 0, 0, H_XmListSelectItem);
+ XM_define_procedure(XmListSelectPos, gxm_XmListSelectPos_w, 3, 0, 0, H_XmListSelectPos);
+ XM_define_procedure(XmListDeselectItem, gxm_XmListDeselectItem_w, 2, 0, 0, H_XmListDeselectItem);
+ XM_define_procedure(XmListDeselectPos, gxm_XmListDeselectPos_w, 2, 0, 0, H_XmListDeselectPos);
+ XM_define_procedure(XmListDeselectAllItems, gxm_XmListDeselectAllItems_w, 1, 0, 0, H_XmListDeselectAllItems);
+ XM_define_procedure(XmListSetPos, gxm_XmListSetPos_w, 2, 0, 0, H_XmListSetPos);
+ XM_define_procedure(XmListSetBottomPos, gxm_XmListSetBottomPos_w, 2, 0, 0, H_XmListSetBottomPos);
+ XM_define_procedure(XmListSetItem, gxm_XmListSetItem_w, 2, 0, 0, H_XmListSetItem);
+ XM_define_procedure(XmListSetBottomItem, gxm_XmListSetBottomItem_w, 2, 0, 0, H_XmListSetBottomItem);
+ XM_define_procedure(XmListSetAddMode, gxm_XmListSetAddMode_w, 2, 0, 0, H_XmListSetAddMode);
+ XM_define_procedure(XmListItemExists, gxm_XmListItemExists_w, 2, 0, 0, H_XmListItemExists);
+ XM_define_procedure(XmListItemPos, gxm_XmListItemPos_w, 2, 0, 0, H_XmListItemPos);
+ XM_define_procedure(XmListGetKbdItemPos, gxm_XmListGetKbdItemPos_w, 1, 0, 0, H_XmListGetKbdItemPos);
+ XM_define_procedure(XmListSetKbdItemPos, gxm_XmListSetKbdItemPos_w, 2, 0, 0, H_XmListSetKbdItemPos);
+ XM_define_procedure(XmListYToPos, gxm_XmListYToPos_w, 2, 0, 0, H_XmListYToPos);
+ XM_define_procedure(XmListPosToBounds, gxm_XmListPosToBounds_w, 2, 0, 0, H_XmListPosToBounds);
+ XM_define_procedure(XmListGetMatchPos, gxm_XmListGetMatchPos_w, 2, 0, 0, H_XmListGetMatchPos);
+ XM_define_procedure(XmListSetHorizPos, gxm_XmListSetHorizPos_w, 2, 0, 0, H_XmListSetHorizPos);
+ XM_define_procedure(XmListUpdateSelectedList, gxm_XmListUpdateSelectedList_w, 1, 0, 0, H_XmListUpdateSelectedList);
+ XM_define_procedure(XmListPosSelected, gxm_XmListPosSelected_w, 2, 0, 0, H_XmListPosSelected);
+ XM_define_procedure(XmCreateList, gxm_XmCreateList_w, 3, 1, 0, H_XmCreateList);
+ XM_define_procedure(XmCreateScrolledList, gxm_XmCreateScrolledList_w, 3, 1, 0, H_XmCreateScrolledList);
+ XM_define_procedure(XmTranslateKey, gxm_XmTranslateKey_w, 3, 0, 0, H_XmTranslateKey);
+ XM_define_procedure(XmCreateMainWindow, gxm_XmCreateMainWindow_w, 3, 1, 0, H_XmCreateMainWindow);
+ XM_define_procedure(XmInstallImage, gxm_XmInstallImage_w, 2, 0, 0, H_XmInstallImage);
+ XM_define_procedure(XmUninstallImage, gxm_XmUninstallImage_w, 1, 0, 0, H_XmUninstallImage);
+ XM_define_procedure(XmGetPixmap, gxm_XmGetPixmap_w, 4, 0, 0, H_XmGetPixmap);
+ XM_define_procedure(XmGetPixmapByDepth, gxm_XmGetPixmapByDepth_w, 5, 0, 0, H_XmGetPixmapByDepth);
+ XM_define_procedure(XmDestroyPixmap, gxm_XmDestroyPixmap_w, 2, 0, 0, H_XmDestroyPixmap);
+ XM_define_procedure(XmUpdateDisplay, gxm_XmUpdateDisplay_w, 1, 0, 0, H_XmUpdateDisplay);
+ XM_define_procedure(XmWidgetGetBaselines, gxm_XmWidgetGetBaselines_w, 1, 0, 0, H_XmWidgetGetBaselines);
+ XM_define_procedure(XmRegisterSegmentEncoding, gxm_XmRegisterSegmentEncoding_w, 2, 0, 0, H_XmRegisterSegmentEncoding);
+ XM_define_procedure(XmMapSegmentEncoding, gxm_XmMapSegmentEncoding_w, 1, 0, 0, H_XmMapSegmentEncoding);
+ XM_define_procedure(XmCvtCTToXmString, gxm_XmCvtCTToXmString_w, 1, 0, 0, H_XmCvtCTToXmString);
+ XM_define_procedure(XmCvtXmStringToCT, gxm_XmCvtXmStringToCT_w, 1, 0, 0, H_XmCvtXmStringToCT);
+ XM_define_procedure(XmConvertUnits, gxm_XmConvertUnits_w, 5, 0, 0, H_XmConvertUnits);
+ XM_define_procedure(XmCreateSimpleMenuBar, gxm_XmCreateSimpleMenuBar_w, 3, 1, 0, H_XmCreateSimpleMenuBar);
+ XM_define_procedure(XmCreateSimplePopupMenu, gxm_XmCreateSimplePopupMenu_w, 3, 1, 0, H_XmCreateSimplePopupMenu);
+ XM_define_procedure(XmCreateSimplePulldownMenu, gxm_XmCreateSimplePulldownMenu_w, 3, 1, 0, H_XmCreateSimplePulldownMenu);
+ XM_define_procedure(XmCreateSimpleOptionMenu, gxm_XmCreateSimpleOptionMenu_w, 3, 1, 0, H_XmCreateSimpleOptionMenu);
+ XM_define_procedure(XmCreateSimpleRadioBox, gxm_XmCreateSimpleRadioBox_w, 3, 1, 0, H_XmCreateSimpleRadioBox);
+ XM_define_procedure(XmCreateSimpleCheckBox, gxm_XmCreateSimpleCheckBox_w, 3, 1, 0, H_XmCreateSimpleCheckBox);
+ XM_define_procedure(XmVaCreateSimpleMenuBar, gxm_XmVaCreateSimpleMenuBar_w, 3, 0, 0, H_XmVaCreateSimpleMenuBar);
+ XM_define_procedure(XmVaCreateSimplePopupMenu, gxm_XmVaCreateSimplePopupMenu_w, 4, 0, 0, H_XmVaCreateSimplePopupMenu);
+ XM_define_procedure(XmVaCreateSimplePulldownMenu, gxm_XmVaCreateSimplePulldownMenu_w, 5, 0, 0, H_XmVaCreateSimplePulldownMenu);
+ XM_define_procedure(XmVaCreateSimpleOptionMenu, gxm_XmVaCreateSimpleOptionMenu_w, 7, 0, 0, H_XmVaCreateSimpleOptionMenu);
+ XM_define_procedure(XmVaCreateSimpleRadioBox, gxm_XmVaCreateSimpleRadioBox_w, 5, 0, 0, H_XmVaCreateSimpleRadioBox);
+ XM_define_procedure(XmVaCreateSimpleCheckBox, gxm_XmVaCreateSimpleCheckBox_w, 4, 0, 0, H_XmVaCreateSimpleCheckBox);
+ XM_define_procedure(XmTrackingEvent, gxm_XmTrackingEvent_w, 3, 0, 0, H_XmTrackingEvent);
+ XM_define_procedure(XmSetColorCalculation, gxm_XmSetColorCalculation_w, 1, 0, 0, H_XmSetColorCalculation);
+ XM_define_procedure(XmGetColorCalculation, gxm_XmGetColorCalculation_w, 0, 0, 0, H_XmGetColorCalculation);
+ XM_define_procedure(XmGetColors, gxm_XmGetColors_w, 3, 0, 0, H_XmGetColors);
+ XM_define_procedure(XmChangeColor, gxm_XmChangeColor_w, 2, 0, 0, H_XmChangeColor);
+ XM_define_procedure(XmStringCreate, gxm_XmStringCreate_w, 2, 0, 0, H_XmStringCreate);
+ XM_define_procedure(XmStringCreateLocalized, gxm_XmStringCreateLocalized_w, 1, 0, 0, H_XmStringCreateLocalized);
+ XM_define_procedure(XmStringDirectionCreate, gxm_XmStringDirectionCreate_w, 1, 0, 0, H_XmStringDirectionCreate);
+ XM_define_procedure(XmStringSeparatorCreate, gxm_XmStringSeparatorCreate_w, 0, 0, 0, H_XmStringSeparatorCreate);
+ XM_define_procedure(XmStringInitContext, gxm_XmStringInitContext_w, 1, 0, 0, H_XmStringInitContext);
+ XM_define_procedure(XmStringFreeContext, gxm_XmStringFreeContext_w, 1, 0, 0, H_XmStringFreeContext);
+ XM_define_procedure(XmCvtXmStringToByteStream, gxm_XmCvtXmStringToByteStream_w, 1, 0, 0, H_XmCvtXmStringToByteStream);
+ XM_define_procedure(XmCvtByteStreamToXmString, gxm_XmCvtByteStreamToXmString_w, 1, 0, 0, H_XmCvtByteStreamToXmString);
+ XM_define_procedure(XmStringByteStreamLength, gxm_XmStringByteStreamLength_w, 1, 0, 0, H_XmStringByteStreamLength);
+ XM_define_procedure(XmStringConcatAndFree, gxm_XmStringConcatAndFree_w, 2, 0, 0, H_XmStringConcatAndFree);
+ XM_define_procedure(XmStringIsVoid, gxm_XmStringIsVoid_w, 1, 0, 0, H_XmStringIsVoid);
+ XM_define_procedure(XmStringPeekNextTriple, gxm_XmStringPeekNextTriple_w, 1, 0, 0, H_XmStringPeekNextTriple);
+ XM_define_procedure(XmStringGetNextTriple, gxm_XmStringGetNextTriple_w, 1, 0, 0, H_XmStringGetNextTriple);
+ XM_define_procedure(XmStringComponentCreate, gxm_XmStringComponentCreate_w, 3, 0, 0, H_XmStringComponentCreate);
+ XM_define_procedure(XmStringUnparse, gxm_XmStringUnparse_w, 7, 0, 0, H_XmStringUnparse);
+ XM_define_procedure(XmStringParseText, gxm_XmStringParseText_w, 7, 0, 0, H_XmStringParseText);
+ XM_define_procedure(XmStringToXmStringTable, gxm_XmStringToXmStringTable_w, 2, 0, 0, H_XmStringToXmStringTable);
+ XM_define_procedure(XmStringTableToXmString, gxm_XmStringTableToXmString_w, 3, 0, 0, H_XmStringTableToXmString);
+ XM_define_procedure(XmStringTableUnparse, gxm_XmStringTableUnparse_w, 8, 0, 0, H_XmStringTableUnparse);
+ XM_define_procedure(XmStringTableParseStringArray, gxm_XmStringTableParseStringArray_w, 7, 0, 0, H_XmStringTableParseStringArray);
+ XM_define_procedure(XmDirectionToStringDirection, gxm_XmDirectionToStringDirection_w, 1, 0, 0, H_XmDirectionToStringDirection);
+ XM_define_procedure(XmStringDirectionToDirection, gxm_XmStringDirectionToDirection_w, 1, 0, 0, H_XmStringDirectionToDirection);
+ XM_define_procedure(XmStringGenerate, gxm_XmStringGenerate_w, 4, 0, 0, H_XmStringGenerate);
+ XM_define_procedure(XmStringPutRendition, gxm_XmStringPutRendition_w, 2, 0, 0, H_XmStringPutRendition);
+ XM_define_procedure(XmParseMappingCreate, gxm_XmParseMappingCreate_w, 1, 1, 0, H_XmParseMappingCreate);
+ XM_define_procedure(XmParseMappingSetValues, gxm_XmParseMappingSetValues_w, 2, 1, 0, H_XmParseMappingSetValues);
+ XM_define_procedure(XmParseMappingGetValues, gxm_XmParseMappingGetValues_w, 2, 1, 0, H_XmParseMappingGetValues);
+ XM_define_procedure(XmParseMappingFree, gxm_XmParseMappingFree_w, 1, 0, 0, H_XmParseMappingFree);
+ XM_define_procedure(XmParseTableFree, gxm_XmParseTableFree_w, 1, 1, 0, H_XmParseTableFree);
+ XM_define_procedure(XmStringTableProposeTablist, gxm_XmStringTableProposeTablist_w, 5, 0, 0, H_XmStringTableProposeTablist);
+ XM_define_procedure(XmTabSetValue, gxm_XmTabSetValue_w, 2, 0, 0, H_XmTabSetValue);
+ XM_define_procedure(XmTabGetValues, gxm_XmTabGetValues_w, 1, 0, 0, H_XmTabGetValues);
+ XM_define_procedure(XmTabFree, gxm_XmTabFree_w, 1, 0, 0, H_XmTabFree);
+ XM_define_procedure(XmTabListFree, gxm_XmTabListFree_w, 1, 0, 0, H_XmTabListFree);
+ XM_define_procedure(XmTabCreate, gxm_XmTabCreate_w, 5, 0, 0, H_XmTabCreate);
+ XM_define_procedure(XmTabListTabCount, gxm_XmTabListTabCount_w, 1, 0, 0, H_XmTabListTabCount);
+ XM_define_procedure(XmTabListRemoveTabs, gxm_XmTabListRemoveTabs_w, 2, 1, 0, H_XmTabListRemoveTabs);
+ XM_define_procedure(XmTabListReplacePositions, gxm_XmTabListReplacePositions_w, 3, 1, 0, H_XmTabListReplacePositions);
+ XM_define_procedure(XmTabListGetTab, gxm_XmTabListGetTab_w, 2, 0, 0, H_XmTabListGetTab);
+ XM_define_procedure(XmTabListCopy, gxm_XmTabListCopy_w, 3, 0, 0, H_XmTabListCopy);
+ XM_define_procedure(XmTabListInsertTabs, gxm_XmTabListInsertTabs_w, 4, 0, 0, H_XmTabListInsertTabs);
+ XM_define_procedure(XmRenderTableCvtFromProp, gxm_XmRenderTableCvtFromProp_w, 3, 0, 0, H_XmRenderTableCvtFromProp);
+ XM_define_procedure(XmRenderTableCvtToProp, gxm_XmRenderTableCvtToProp_w, 2, 0, 0, H_XmRenderTableCvtToProp);
+ XM_define_procedure(XmRenditionUpdate, gxm_XmRenditionUpdate_w, 2, 1, 0, H_XmRenditionUpdate);
+ XM_define_procedure(XmRenditionRetrieve, gxm_XmRenditionRetrieve_w, 2, 1, 0, H_XmRenditionRetrieve);
+ XM_define_procedure(XmRenditionFree, gxm_XmRenditionFree_w, 1, 0, 0, H_XmRenditionFree);
+ XM_define_procedure(XmRenditionCreate, gxm_XmRenditionCreate_w, 3, 1, 0, H_XmRenditionCreate);
+ XM_define_procedure(XmRenderTableGetRenditions, gxm_XmRenderTableGetRenditions_w, 0, 3, 0, H_XmRenderTableGetRenditions);
+ XM_define_procedure(XmRenderTableGetRendition, gxm_XmRenderTableGetRendition_w, 2, 0, 0, H_XmRenderTableGetRendition);
+ XM_define_procedure(XmRenderTableGetTags, gxm_XmRenderTableGetTags_w, 1, 0, 0, H_XmRenderTableGetTags);
+ XM_define_procedure(XmRenderTableFree, gxm_XmRenderTableFree_w, 1, 0, 0, H_XmRenderTableFree);
+ XM_define_procedure(XmRenderTableCopy, gxm_XmRenderTableCopy_w, 0, 3, 0, H_XmRenderTableCopy);
+ XM_define_procedure(XmRenderTableRemoveRenditions, gxm_XmRenderTableRemoveRenditions_w, 0, 3, 0, H_XmRenderTableRemoveRenditions);
+ XM_define_procedure(XmRenderTableAddRenditions, gxm_XmRenderTableAddRenditions_w, 4, 0, 0, H_XmRenderTableAddRenditions);
+ XM_define_procedure(XmStringConcat, gxm_XmStringConcat_w, 2, 0, 0, H_XmStringConcat);
+ XM_define_procedure(XmStringCopy, gxm_XmStringCopy_w, 1, 0, 0, H_XmStringCopy);
+ XM_define_procedure(XmStringCompare, gxm_XmStringCompare_w, 2, 0, 0, H_XmStringCompare);
+ XM_define_procedure(XmStringEmpty, gxm_XmStringEmpty_w, 1, 0, 0, H_XmStringEmpty);
+ XM_define_procedure(XmStringHasSubstring, gxm_XmStringHasSubstring_w, 2, 0, 0, H_XmStringHasSubstring);
+ XM_define_procedure(XmStringFree, gxm_XmStringFree_w, 1, 0, 0, H_XmStringFree);
+ XM_define_procedure(XmStringBaseline, gxm_XmStringBaseline_w, 2, 0, 0, H_XmStringBaseline);
+ XM_define_procedure(XmStringWidth, gxm_XmStringWidth_w, 2, 0, 0, H_XmStringWidth);
+ XM_define_procedure(XmStringHeight, gxm_XmStringHeight_w, 2, 0, 0, H_XmStringHeight);
+ XM_define_procedure(XmStringExtent, gxm_XmStringExtent_w, 2, 0, 0, H_XmStringExtent);
+ XM_define_procedure(XmStringLineCount, gxm_XmStringLineCount_w, 1, 0, 0, H_XmStringLineCount);
+ XM_define_procedure(XmStringDraw, gxm_XmStringDraw_w, 0, 0, 1, H_XmStringDraw);
+ XM_define_procedure(XmStringDrawImage, gxm_XmStringDrawImage_w, 0, 0, 1, H_XmStringDrawImage);
+ XM_define_procedure(XmStringDrawUnderline, gxm_XmStringDrawUnderline_w, 0, 0, 1, H_XmStringDrawUnderline);
+ XM_define_procedure(XmGetDestination, gxm_XmGetDestination_w, 1, 0, 0, H_XmGetDestination);
+ XM_define_procedure(XmIsTraversable, gxm_XmIsTraversable_w, 1, 0, 0, H_XmIsTraversable);
+ XM_define_procedure(XmGetVisibility, gxm_XmGetVisibility_w, 1, 0, 0, H_XmGetVisibility);
+ XM_define_procedure(XmGetTabGroup, gxm_XmGetTabGroup_w, 1, 0, 0, H_XmGetTabGroup);
+ XM_define_procedure(XmGetFocusWidget, gxm_XmGetFocusWidget_w, 1, 0, 0, H_XmGetFocusWidget);
+ XM_define_procedure(XmProcessTraversal, gxm_XmProcessTraversal_w, 2, 0, 0, H_XmProcessTraversal);
+ XM_define_procedure(XmCreateMenuShell, gxm_XmCreateMenuShell_w, 3, 1, 0, H_XmCreateMenuShell);
+
+ XM_define_procedure(XmIsMessageBox, gxm_XmIsMessageBox_w, 1, 0, 0, H_XmIsMessageBox);
+ XM_define_procedure(XmIsArrowButtonGadget, gxm_XmIsArrowButtonGadget_w, 1, 0, 0, H_XmIsArrowButtonGadget);
+ XM_define_procedure(XmIsArrowButton, gxm_XmIsArrowButton_w, 1, 0, 0, H_XmIsArrowButton);
+ XM_define_procedure(XmIsNotebook, gxm_XmIsNotebook_w, 1, 0, 0, H_XmIsNotebook);
+ XM_define_procedure(XmIsComboBox, gxm_XmIsComboBox_w, 1, 0, 0, H_XmIsComboBox);
+ XM_define_procedure(XmIsContainer, gxm_XmIsContainer_w, 1, 0, 0, H_XmIsContainer);
+ XM_define_procedure(XmIsGrabShell, gxm_XmIsGrabShell_w, 1, 0, 0, H_XmIsGrabShell);
+ XM_define_procedure(XmIsIconGadget, gxm_XmIsIconGadget_w, 1, 0, 0, H_XmIsIconGadget);
+ XM_define_procedure(XmIsIconHeader, gxm_XmIsIconHeader_w, 1, 0, 0, H_XmIsIconHeader);
+ XM_define_procedure(XmIsPanedWindow, gxm_XmIsPanedWindow_w, 1, 0, 0, H_XmIsPanedWindow);
+ XM_define_procedure(XmIsBulletinBoard, gxm_XmIsBulletinBoard_w, 1, 0, 0, H_XmIsBulletinBoard);
+ XM_define_procedure(XmIsPrimitive, gxm_XmIsPrimitive_w, 1, 0, 0, H_XmIsPrimitive);
+ XM_define_procedure(XmIsCascadeButtonGadget, gxm_XmIsCascadeButtonGadget_w, 1, 0, 0, H_XmIsCascadeButtonGadget);
+ XM_define_procedure(XmIsCascadeButton, gxm_XmIsCascadeButton_w, 1, 0, 0, H_XmIsCascadeButton);
+ XM_define_procedure(XmIsPushButtonGadget, gxm_XmIsPushButtonGadget_w, 1, 0, 0, H_XmIsPushButtonGadget);
+ XM_define_procedure(XmIsPushButton, gxm_XmIsPushButton_w, 1, 0, 0, H_XmIsPushButton);
+ XM_define_procedure(XmIsCommand, gxm_XmIsCommand_w, 1, 0, 0, H_XmIsCommand);
+ XM_define_procedure(XmIsRowColumn, gxm_XmIsRowColumn_w, 1, 0, 0, H_XmIsRowColumn);
+ XM_define_procedure(XmIsScale, gxm_XmIsScale_w, 1, 0, 0, H_XmIsScale);
+ XM_define_procedure(XmIsScreen, gxm_XmIsScreen_w, 1, 0, 0, H_XmIsScreen);
+ XM_define_procedure(XmIsScrollBar, gxm_XmIsScrollBar_w, 1, 0, 0, H_XmIsScrollBar);
+ XM_define_procedure(XmIsDialogShell, gxm_XmIsDialogShell_w, 1, 0, 0, H_XmIsDialogShell);
+ XM_define_procedure(XmIsScrolledWindow, gxm_XmIsScrolledWindow_w, 1, 0, 0, H_XmIsScrolledWindow);
+ XM_define_procedure(XmIsDisplay, gxm_XmIsDisplay_w, 1, 0, 0, H_XmIsDisplay);
+ XM_define_procedure(XmIsSelectionBox, gxm_XmIsSelectionBox_w, 1, 0, 0, H_XmIsSelectionBox);
+ XM_define_procedure(XmIsDragContext, gxm_XmIsDragContext_w, 1, 0, 0, H_XmIsDragContext);
+ XM_define_procedure(XmIsSeparatorGadget, gxm_XmIsSeparatorGadget_w, 1, 0, 0, H_XmIsSeparatorGadget);
+ XM_define_procedure(XmIsDragIconObjectClass, gxm_XmIsDragIconObjectClass_w, 1, 0, 0, H_XmIsDragIconObjectClass);
+ XM_define_procedure(XmIsSeparator, gxm_XmIsSeparator_w, 1, 0, 0, H_XmIsSeparator);
+ XM_define_procedure(XmIsDrawingArea, gxm_XmIsDrawingArea_w, 1, 0, 0, H_XmIsDrawingArea);
+ XM_define_procedure(XmIsDrawnButton, gxm_XmIsDrawnButton_w, 1, 0, 0, H_XmIsDrawnButton);
+ XM_define_procedure(XmIsDropSiteManager, gxm_XmIsDropSiteManager_w, 1, 0, 0, H_XmIsDropSiteManager);
+ XM_define_procedure(XmIsDropTransfer, gxm_XmIsDropTransfer_w, 1, 0, 0, H_XmIsDropTransfer);
+ XM_define_procedure(XmIsTextField, gxm_XmIsTextField_w, 1, 0, 0, H_XmIsTextField);
+ XM_define_procedure(XmIsFileSelectionBox, gxm_XmIsFileSelectionBox_w, 1, 0, 0, H_XmIsFileSelectionBox);
+ XM_define_procedure(XmIsText, gxm_XmIsText_w, 1, 0, 0, H_XmIsText);
+ XM_define_procedure(XmIsForm, gxm_XmIsForm_w, 1, 0, 0, H_XmIsForm);
+ XM_define_procedure(XmIsFrame, gxm_XmIsFrame_w, 1, 0, 0, H_XmIsFrame);
+ XM_define_procedure(XmIsGadget, gxm_XmIsGadget_w, 1, 0, 0, H_XmIsGadget);
+ XM_define_procedure(XmIsToggleButtonGadget, gxm_XmIsToggleButtonGadget_w, 1, 0, 0, H_XmIsToggleButtonGadget);
+ XM_define_procedure(XmIsToggleButton, gxm_XmIsToggleButton_w, 1, 0, 0, H_XmIsToggleButton);
+ XM_define_procedure(XmIsLabelGadget, gxm_XmIsLabelGadget_w, 1, 0, 0, H_XmIsLabelGadget);
+ XM_define_procedure(XmIsLabel, gxm_XmIsLabel_w, 1, 0, 0, H_XmIsLabel);
+ XM_define_procedure(XmIsVendorShell, gxm_XmIsVendorShell_w, 1, 0, 0, H_XmIsVendorShell);
+ XM_define_procedure(XmIsList, gxm_XmIsList_w, 1, 0, 0, H_XmIsList);
+ XM_define_procedure(XmIsMainWindow, gxm_XmIsMainWindow_w, 1, 0, 0, H_XmIsMainWindow);
+ XM_define_procedure(XmIsManager, gxm_XmIsManager_w, 1, 0, 0, H_XmIsManager);
+ XM_define_procedure(XmIsMenuShell, gxm_XmIsMenuShell_w, 1, 0, 0, H_XmIsMenuShell);
+ XM_define_procedure(XmListGetSelectedPos, gxm_XmListGetSelectedPos_w, 1, 0, 0, H_XmListGetSelectedPos);
+
+ XM_define_procedure(XpmCreatePixmapFromData, gxm_XpmCreatePixmapFromData_w, 4, 0, 0, NULL);
+ XM_define_procedure(XpmCreateDataFromPixmap, gxm_XpmCreateDataFromPixmap_w, 4, 0, 0, NULL);
+ XM_define_procedure(XpmReadFileToPixmap, gxm_XpmReadFileToPixmap_w, 4, 0, 0, NULL);
+ XM_define_procedure(XpmReadFileToXpmImage, gxm_XpmReadFileToXpmImage_w, 1, 0, 0, NULL);
+ XM_define_procedure(XpmGetErrorString, gxm_XpmGetErrorString_w, 1, 0, 0, H_XpmGetErrorString);
+ XM_define_procedure(XpmReadPixmapFile, gxm_XpmReadFileToPixmap_w, 4, 0, 0, NULL);
+ XM_define_procedure(XpmWriteFileFromPixmap, gxm_XpmWriteFileFromPixmap_w, 5, 0, 0, NULL);
+ XM_define_procedure(XpmWritePixmapFile, gxm_XpmWriteFileFromPixmap_w, 5, 0, 0, NULL);
+ XM_define_procedure(XpmCreatePixmapFromXpmImage, gxm_XpmCreatePixmapFromXpmImage_w, 4, 0, 0, NULL);
+ XM_define_procedure(XpmCreateXpmImageFromPixmap, gxm_XpmCreateXpmImageFromPixmap_w, 4, 0, 0, NULL);
+
+ XM_define_procedure(XGetPixel, gxm_XGetPixel_w, 3, 0, 0, H_XGetPixel);
+ XM_define_procedure(XDestroyImage, gxm_XDestroyImage_w, 1, 0, 0, H_XDestroyImage);
+ XM_define_procedure(XPutPixel, gxm_XPutPixel_w, 4, 0, 0, H_XPutPixel);
+ XM_define_procedure(XSubImage, gxm_XSubImage_w, 5, 0, 0, H_XSubImage);
+ XM_define_procedure(XAddPixel, gxm_XAddPixel_w, 2, 0, 0, H_XAddPixel);
+
+ XM_define_procedure(XtAppContext?, g_is_XtAppContext_w, 1, 0, 0, PROC_TRUE " if arg is a XtAppContext");
+ XM_define_procedure(XtRequestId?, g_is_XtRequestId_w, 1, 0, 0, PROC_TRUE " if arg is a XtRequestId");
+ XM_define_procedure(XtWorkProcId?, g_is_XtWorkProcId_w, 1, 0, 0, PROC_TRUE " if arg is a XtWorkProcId");
+ XM_define_procedure(XtInputId?, g_is_XtInputId_w, 1, 0, 0, PROC_TRUE " if arg is a XtInputId");
+ XM_define_procedure(XtIntervalId?, g_is_XtIntervalId_w, 1, 0, 0, PROC_TRUE " if arg is a XtIntervalId");
+ XM_define_procedure(Screen?, g_is_Screen_w, 1, 0, 0, PROC_TRUE " if arg is a Screen");
+ XM_define_procedure(XEvent?, g_is_XEvent_w, 1, 0, 0, PROC_TRUE " if arg is a XEvent");
+ XM_define_procedure(XRectangle?, g_is_XRectangle_w, 1, 0, 0, PROC_TRUE " if arg is a XRectangle");
+ XM_define_procedure(XArc?, g_is_XArc_w, 1, 0, 0, PROC_TRUE " if arg is a XArc");
+ XM_define_procedure(XPoint?, g_is_XPoint_w, 1, 0, 0, PROC_TRUE " if arg is a XPoint");
+ XM_define_procedure(XSegment?, g_is_XSegment_w, 1, 0, 0, PROC_TRUE " if arg is a XSegment");
+ XM_define_procedure(XColor?, g_is_XColor_w, 1, 0, 0, PROC_TRUE " if arg is a XColor");
+ XM_define_procedure(Atom?, g_is_Atom_w, 1, 0, 0, PROC_TRUE " if arg is an Atom");
+ XM_define_procedure(Colormap?, g_is_Colormap_w, 1, 0, 0, PROC_TRUE " if arg is a Colormap");
+ XM_define_procedure(XModifierKeymap?, g_is_XModifierKeymap_w, 1, 0, 0, PROC_TRUE " if arg is a XModifierKeymap");
+ XM_define_procedure(Depth?, g_is_Depth_w, 1, 0, 0, PROC_TRUE " if arg is a Depth");
+ XM_define_procedure(Display?, g_is_Display_w, 1, 0, 0, PROC_TRUE " if arg is a Display");
+ XM_define_procedure(Drawable?, g_is_Window_w, 1, 0, 0, PROC_TRUE " if arg is a Drawable");
+ XM_define_procedure(Font?, g_is_Font_w, 1, 0, 0, PROC_TRUE " if arg is a Font");
+ XM_define_procedure(GC?, g_is_GC_w, 1, 0, 0, PROC_TRUE " if arg is a GC");
+ XM_define_procedure(KeySym?, g_is_KeySym_w, 1, 0, 0, PROC_TRUE " if arg is a KeySym");
+ XM_define_procedure(Pixel?, g_is_Pixel_w, 1, 0, 0, PROC_TRUE " if arg is a Pixel");
+ XM_define_procedure(Pixmap?, g_is_Pixmap_w, 1, 0, 0, PROC_TRUE " if arg is a Pixmap");
+ XM_define_procedure(Region?, g_is_Region_w, 1, 0, 0, PROC_TRUE " if arg is a Region");
+ XM_define_procedure(Time?, g_is_Time_w, 1, 0, 0, PROC_TRUE " if arg is a Time");
+ XM_define_procedure(Visual?, g_is_Visual_w, 1, 0, 0, PROC_TRUE " if arg is a Visual");
+ XM_define_procedure(Window?, g_is_Window_w, 1, 0, 0, PROC_TRUE " if arg is a Window");
+ XM_define_procedure(Widget?, g_is_Widget_w, 1, 0, 0, PROC_TRUE " if arg is a Widget");
+ XM_define_procedure(XmStringContext?, g_is_XmStringContext_w, 1, 0, 0, PROC_TRUE " if arg is a XmStringContext");
+ XM_define_procedure(XFontProp?, g_is_XFontProp_w, 1, 0, 0, PROC_TRUE " if arg is a XFontProp");
+ XM_define_procedure(XFontSet?, g_is_XFontSet_w, 1, 0, 0, PROC_TRUE " if arg is a XFontSet");
+ XM_define_procedure(XFontStruct?, g_is_XFontStruct_w, 1, 0, 0, PROC_TRUE " if arg is a XFontStruct");
+ XM_define_procedure(XGCValues?, g_is_XGCValues_w, 1, 0, 0, PROC_TRUE " if arg is a XGCValues");
+ XM_define_procedure(XImage?, g_is_XImage_w, 1, 0, 0, PROC_TRUE " if arg is a XImage");
+ XM_define_procedure(XVisualInfo?, g_is_XVisualInfo_w, 1, 0, 0, PROC_TRUE " if arg is a XVisualInfo");
+ XM_define_procedure(XWMHints?, g_is_XWMHints_w, 1, 0, 0, PROC_TRUE " if arg is a XWMHints");
+ XM_define_procedure(XWindowAttributes?, g_is_XWindowAttributes_w, 1, 0, 0, PROC_TRUE " if arg is a XWindowAttributes");
+ XM_define_procedure(XWindowChanges?, g_is_XWindowChanges_w, 1, 0, 0, PROC_TRUE " if arg is a XWindowChanges");
+ XM_define_procedure(KeyCode?, g_is_KeyCode_w, 1, 0, 0, PROC_TRUE " if arg is a KeyCode");
+ XM_define_procedure(XContext?, g_is_XContext_w, 1, 0, 0, PROC_TRUE " if arg is a XContext");
+ XM_define_procedure(XCharStruct?, g_is_XCharStruct_w, 1, 0, 0, PROC_TRUE " if arg is a XCharStruct");
+ XM_define_procedure(XTextItem?, g_is_XTextItem_w, 1, 0, 0, PROC_TRUE " if arg is a XTextItem");
+ XM_define_procedure(XStandardColormap?, g_is_XStandardColormap_w, 1, 0, 0, PROC_TRUE " if arg is a XStandardColormap");
+ XM_define_procedure(Cursor?, g_is_Cursor_w, 1, 0, 0, PROC_TRUE " if arg is a Cursor");
+ XM_define_procedure(WidgetClass?, g_is_WidgetClass_w, 1, 0, 0, PROC_TRUE " if arg is a WidgetClass");
+ XM_define_procedure(XmString?, g_is_XmString_w, 1, 0, 0, PROC_TRUE " if arg is a XmString");
+ XM_define_procedure(XmToggleButton?, gxm_XmIsToggleButton_w, 1, 0, 0, H_XmIsToggleButton);
+ XM_define_procedure(XmDrawingArea?, gxm_XmIsDrawingArea_w, 1, 0, 0, H_XmIsDrawingArea);
+ XM_define_procedure(XmPushButton?, gxm_XmIsPushButton_w, 1, 0, 0, H_XmIsPushButton);
+ XM_define_procedure(XmTextField?, gxm_XmIsTextField_w, 1, 0, 0, H_XmIsTextField);
+ XM_define_procedure(XmFileSelectionBox?, gxm_XmIsFileSelectionBox_w, 1, 0, 0, H_XmIsFileSelectionBox);
+ XM_define_procedure(XmText?, gxm_XmIsText_w, 1, 0, 0, H_XmIsText);
+ XM_define_procedure(XmFrame?, gxm_XmIsFrame_w, 1, 0, 0, H_XmIsFrame);
+ XM_define_procedure(XmLabel?, gxm_XmIsLabel_w, 1, 0, 0, H_XmIsLabel);
+ XM_define_procedure(XmList?, gxm_XmIsList_w, 1, 0, 0, H_XmIsList);
+ XM_define_procedure(XmArrowButton?, gxm_XmIsArrowButton_w, 1, 0, 0, H_XmIsArrowButton);
+ XM_define_procedure(XmScrollBar?, gxm_XmIsScrollBar_w, 1, 0, 0, H_XmIsScrollBar);
+ XM_define_procedure(XmCommand?, gxm_XmIsCommand_w, 1, 0, 0, H_XmIsCommand);
+ XM_define_procedure(XmScale?, gxm_XmIsScale_w, 1, 0, 0, H_XmIsScale);
+ XM_define_procedure(XmRowColumn?, gxm_XmIsRowColumn_w, 1, 0, 0, H_XmIsRowColumn);
+ XM_define_procedure(XmTab?, g_is_XmTab_w, 1, 0, 0, PROC_TRUE " if arg is a Tab");
+ XM_define_procedure(XmNotebook?, gxm_XmIsNotebook_w, 1, 0, 0, H_XmIsNotebook);
+ XM_define_procedure(XmComboBox?, gxm_XmIsComboBox_w, 1, 0, 0, H_XmIsComboBox);
+ XM_define_procedure(XmContainer?, gxm_XmIsContainer_w, 1, 0, 0, H_XmIsContainer);
+ XM_define_procedure(XmIconHeader?, gxm_XmIsIconHeader_w, 1, 0, 0, H_XmIsIconHeader);
+ XM_define_procedure(XmGrabShell?, gxm_XmIsGrabShell_w, 1, 0, 0, H_XmIsGrabShell);
+ XM_define_procedure(XmRendition?, g_is_XmRendition_w, 1, 0, 0, PROC_TRUE " if arg is a Rendition");
+ XM_define_procedure(XmRenderTable?, g_is_XmRenderTable_w, 1, 0, 0, PROC_TRUE " if arg is a RenderTable");
+ XM_define_procedure(XmIconGadget?, gxm_XmIsIconGadget_w, 1, 0, 0, H_XmIsIconGadget);
+ XM_define_procedure(XmTabList?, g_is_XmTabList_w, 1, 0, 0, PROC_TRUE " if arg is a TabList");
+ XM_define_procedure(XmParseMapping?, g_is_XmParseMapping_w, 1, 0, 0, PROC_TRUE " if arg is a ParseMapping");
+ XM_define_procedure(XmPanedWindow?, gxm_XmIsPanedWindow_w, 1, 0, 0, H_XmIsPanedWindow);
+ XM_define_procedure(XmScrolledWindow?, gxm_XmIsScrolledWindow_w, 1, 0, 0, H_XmIsScrolledWindow);
+ XM_define_procedure(XmCascadeButton?, gxm_XmIsCascadeButton_w, 1, 0, 0, H_XmIsCascadeButton);
+ XM_define_procedure(XmForm?, gxm_XmIsForm_w, 1, 0, 0, H_XmIsForm);
+ XM_define_procedure(XmBulletinBoard?, gxm_XmIsBulletinBoard_w, 1, 0, 0, H_XmIsBulletinBoard);
+ XM_define_procedure(XmScreen?, gxm_XmIsScreen_w, 1, 0, 0, H_XmIsScreen);
+ XM_define_procedure(XmDialogShell?, gxm_XmIsDialogShell_w, 1, 0, 0, H_XmIsDialogShell);
+ XM_define_procedure(XmDisplay?, gxm_XmIsDisplay_w, 1, 0, 0, H_XmIsDisplay);
+ XM_define_procedure(XmSelectionBox?, gxm_XmIsSelectionBox_w, 1, 0, 0, H_XmIsSelectionBox);
+ XM_define_procedure(XmDragContext?, gxm_XmIsDragContext_w, 1, 0, 0, H_XmIsDragContext);
+ XM_define_procedure(XmDragIconObjectClass?, gxm_XmIsDragIconObjectClass_w, 1, 0, 0, H_XmIsDragIconObjectClass);
+ XM_define_procedure(XmSeparator?, gxm_XmIsSeparator_w, 1, 0, 0, H_XmIsSeparator);
+ XM_define_procedure(XmDropSiteManager?, gxm_XmIsDropSiteManager_w, 1, 0, 0, H_XmIsDropSiteManager);
+ XM_define_procedure(XmDropTransfer?, gxm_XmIsDropTransfer_w, 1, 0, 0, H_XmIsDropTransfer);
+ XM_define_procedure(XmVendorShell?, gxm_XmIsVendorShell_w, 1, 0, 0, H_XmIsVendorShell);
+ XM_define_procedure(XmMainWindow?, gxm_XmIsMainWindow_w, 1, 0, 0, H_XmIsMainWindow);
+ XM_define_procedure(XmMessageBox?, gxm_XmIsMessageBox_w, 1, 0, 0, H_XmIsMessageBox);
+ XM_define_procedure(XmManager?, gxm_XmIsManager_w, 1, 0, 0, H_XmIsManager);
+ XM_define_procedure(XmMenuShell?, gxm_XmIsMenuShell_w, 1, 0, 0, H_XmIsMenuShell);
+ XM_define_procedure(XmLabelGadget?, gxm_XmIsLabelGadget_w, 1, 0, 0, H_XmIsLabelGadget);
+ XM_define_procedure(XmPushButtonGadget?, gxm_XmIsPushButtonGadget_w, 1, 0, 0, H_XmIsPushButtonGadget);
+ XM_define_procedure(XmSeparatorGadget?, gxm_XmIsSeparatorGadget_w, 1, 0, 0, H_XmIsSeparatorGadget);
+ XM_define_procedure(XmArrowButtonGadget?, gxm_XmIsArrowButtonGadget_w, 1, 0, 0, H_XmIsArrowButtonGadget);
+ XM_define_procedure(XmCascadeButtonGadget?, gxm_XmIsCascadeButtonGadget_w, 1, 0, 0, H_XmIsCascadeButtonGadget);
+ XM_define_procedure(XmToggleButtonGadget?, gxm_XmIsToggleButtonGadget_w, 1, 0, 0, H_XmIsToggleButtonGadget);
+ XM_define_procedure(XmDrawnButton?, gxm_XmIsDrawnButton_w, 1, 0, 0, H_XmIsDrawnButton);
+ XM_define_procedure(XmPrimitive?, gxm_XmIsPrimitive_w, 1, 0, 0, H_XmIsPrimitive);
+ XM_define_procedure(XmTextSource?, g_is_XmTextSource_w, 1, 0, 0, PROC_TRUE " if arg is a TextSource");
+
+ XM_define_procedure(XpmAttributes?, g_is_XpmAttributes_w, 1, 0, 0, PROC_TRUE " if arg is a XpmAttributes");
+ XM_define_procedure(XpmImage?, g_is_XpmImage_w, 1, 0, 0, PROC_TRUE " if arg is a XpmImage");
+ XM_define_procedure(XpmColorSymbol?, g_is_XpmColorSymbol_w, 1, 0, 0, PROC_TRUE " if arg is a XpmColorSymbol");
- XM_DEFINE_PROCEDURE(XpmAttributes?, XEN_XpmAttributes_p_w, 1, 0, 0, PROC_TRUE " if arg is a XpmAttributes");
- XM_DEFINE_PROCEDURE(XpmImage?, XEN_XpmImage_p_w, 1, 0, 0, PROC_TRUE " if arg is a XpmImage");
- XM_DEFINE_PROCEDURE(XpmColorSymbol?, XEN_XpmColorSymbol_p_w, 1, 0, 0, PROC_TRUE " if arg is a XpmColorSymbol");
-
-#if HAVE_SCHEME && HAVE_MOTIF
- XEN_DEFINE_PROCEDURE("->string", c_to_xen_string_w, 1, 0, 0, H_to_string);
- XEN_DEFINE_PROCEDURE("->strings", c_to_xen_strings_w, 2, 0, 0, H_to_strings);
- XEN_DEFINE_PROCEDURE("->ints", c_to_xen_ints_w, 2, 0, 0, H_to_ints);
- XEN_DEFINE_PROCEDURE("->Atoms", c_to_xen_atoms_w, 2, 0, 0, H_to_Atoms);
- XEN_DEFINE_PROCEDURE("->XRectangles", c_to_xen_xrectangles_w, 2, 0, 0, H_to_XRectangles);
+#if HAVE_SCHEME
+ Xen_define_safe_procedure("->strings", c_to_xen_strings_w, 2, 0, 0, H_to_strings);
+ Xen_define_safe_procedure("->ints", c_to_xen_ints_w, 2, 0, 0, H_to_ints);
+ Xen_define_safe_procedure("->Atoms", c_to_xen_atoms_w, 2, 0, 0, H_to_Atoms);
+ Xen_define_safe_procedure("->XRectangles", c_to_xen_xrectangles_w, 2, 0, 0, H_to_XRectangles);
#endif
-#if MUS_WITH_EDITRES
- XM_DEFINE_PROCEDURE(_XEditResCheckMessages, gxm_XEditResCheckMessages_w, 4, 0, 0, NULL);
+#if WITH_EDITRES
+ XM_define_procedure(_XEditResCheckMessages, gxm_XEditResCheckMessages_w, 4, 0, 0, NULL);
#endif
#if HAVE_XSHAPEQUERYEXTENSION
- XM_DEFINE_PROCEDURE(XShapeQueryExtension, gxm_XShapeQueryExtension_w, 1, 0, 0, H_XShapeQueryExtension);
- XM_DEFINE_PROCEDURE(XShapeQueryVersion, gxm_XShapeQueryVersion_w, 1, 0, 0, H_XShapeQueryVersion);
- XM_DEFINE_PROCEDURE(XShapeQueryExtents, gxm_XShapeQueryExtents_w, 2, 0, 0, H_XShapeQueryExtents);
- XM_DEFINE_PROCEDURE(XShapeGetRectangles, gxm_XShapeGetRectangles_w, 3, 0, 0, H_XShapeGetRectangles);
- XM_DEFINE_PROCEDURE(XShapeOffsetShape, gxm_XShapeOffsetShape_w, 5, 0, 0, H_XShapeOffsetShape);
- XM_DEFINE_PROCEDURE(XShapeCombineRegion, gxm_XShapeCombineRegion_w, 7, 0, 0, H_XShapeCombineRegion);
- XM_DEFINE_PROCEDURE(XShapeCombineMask, gxm_XShapeCombineMask_w, 7, 0, 0, H_XShapeCombineMask);
- XM_DEFINE_PROCEDURE(XShapeCombineShape, gxm_XShapeCombineShape_w, 8, 0, 0, H_XShapeCombineShape);
- XM_DEFINE_PROCEDURE(XShapeCombineRectangles, gxm_XShapeCombineRectangles_w, 9, 0, 0, H_XShapeCombineRectangles);
+ XM_define_procedure(XShapeQueryExtension, gxm_XShapeQueryExtension_w, 1, 0, 0, H_XShapeQueryExtension);
+ XM_define_procedure(XShapeQueryVersion, gxm_XShapeQueryVersion_w, 1, 0, 0, H_XShapeQueryVersion);
+ XM_define_procedure(XShapeQueryExtents, gxm_XShapeQueryExtents_w, 2, 0, 0, H_XShapeQueryExtents);
+ XM_define_procedure(XShapeGetRectangles, gxm_XShapeGetRectangles_w, 3, 0, 0, H_XShapeGetRectangles);
+ XM_define_procedure(XShapeOffsetShape, gxm_XShapeOffsetShape_w, 5, 0, 0, H_XShapeOffsetShape);
+ XM_define_procedure(XShapeCombineRegion, gxm_XShapeCombineRegion_w, 7, 0, 0, H_XShapeCombineRegion);
+ XM_define_procedure(XShapeCombineMask, gxm_XShapeCombineMask_w, 7, 0, 0, H_XShapeCombineMask);
+ XM_define_procedure(XShapeCombineShape, gxm_XShapeCombineShape_w, 8, 0, 0, H_XShapeCombineShape);
+ XM_define_procedure(XShapeCombineRectangles, gxm_XShapeCombineRectangles_w, 9, 0, 0, H_XShapeCombineRectangles);
#endif
}
static void define_structs(void)
{
- #define XM_DEFINE_ACCESSOR(Name, Value, SetName, SetValue, A1, A2, A3, A4) \
- XEN_DEFINE_PROCEDURE_WITH_SETTER(XM_FIELD_PREFIX #Name XM_POSTFIX, Value, #Name " field accessor", XM_FIELD_PREFIX #SetName XM_POSTFIX, SetValue, A1, A2, A3, A4)
- #define XM_DEFINE_READER(Name, Value, A1, A2, A3) XEN_DEFINE_PROCEDURE(XM_FIELD_PREFIX #Name XM_POSTFIX, Value, A1, A2, A3, #Name " field reader")
-
- XM_DEFINE_ACCESSOR(pixel, gxm_pixel_w, set_pixel, gxm_set_pixel_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(red, gxm_red_w, set_red, gxm_set_red_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(green, gxm_green_w, set_green, gxm_set_green_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(blue, gxm_blue_w, set_blue, gxm_set_blue_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(flags, gxm_flags_w, set_flags, gxm_set_flags_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(pad, gxm_pad_w, set_pad, gxm_set_pad_w, 1, 0, 2, 0);
- XM_DEFINE_PROCEDURE(XColor, gxm_XColor_w, 0, 6, 0, H_XColor);
- XM_DEFINE_ACCESSOR(x, gxm_x_w, set_x, gxm_set_x_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(y, gxm_y_w, set_y, gxm_set_y_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(width, gxm_width_w, set_width, gxm_set_width_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(height, gxm_height_w, set_height, gxm_set_height_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(angle1, gxm_angle1_w, set_angle1, gxm_set_angle1_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(angle2, gxm_angle2_w, set_angle2, gxm_set_angle2_w, 1, 0, 2, 0);
- XM_DEFINE_PROCEDURE(XArc, gxm_XArc_w, 6, 0, 0, H_XArc);
- XM_DEFINE_PROCEDURE(XWindowChanges, gxm_XWindowChanges_w, 7, 0, 0, H_XWindowChanges);
- XM_DEFINE_PROCEDURE(XSetWindowAttributes, gxm_XSetWindowAttributes_w, 0, 0, 1, H_XSetWindowAttributes);
- XM_DEFINE_PROCEDURE(XPoint, gxm_XPoint_w, 2, 0, 0, H_XPoint);
- XM_DEFINE_ACCESSOR(x1, gxm_x1_w, set_x1, gxm_set_x1_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(y1, gxm_y1_w, set_y1, gxm_set_y1_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(x2, gxm_x2_w, set_x2, gxm_set_x2_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(y2, gxm_y2_w, set_y2, gxm_set_y2_w, 1, 0, 2, 0);
- XM_DEFINE_PROCEDURE(XSegment, gxm_XSegment_w, 4, 0, 0, H_XSegment);
- XM_DEFINE_PROCEDURE(XRectangle, gxm_XRectangle_w, 4, 0, 0, H_XRectangle);
- XM_DEFINE_ACCESSOR(dashes, gxm_dashes_w, set_dashes, gxm_set_dashes_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(dash_offset, gxm_dash_offset_w, set_dash_offset, gxm_set_dash_offset_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(clip_mask, gxm_clip_mask_w, set_clip_mask, gxm_set_clip_mask_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(clip_y_origin, gxm_clip_y_origin_w, set_clip_y_origin, gxm_set_clip_y_origin_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(clip_x_origin, gxm_clip_x_origin_w, set_clip_x_origin, gxm_set_clip_x_origin_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(graphics_exposures, gxm_graphics_exposures_w, set_graphics_exposures, gxm_set_graphics_exposures_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(subwindow_mode, gxm_subwindow_mode_w, set_subwindow_mode, gxm_set_subwindow_mode_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(font, gxm_font_w, set_font, gxm_set_font_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(ts_y_origin, gxm_ts_y_origin_w, set_ts_y_origin, gxm_set_ts_y_origin_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(ts_x_origin, gxm_ts_x_origin_w, set_ts_x_origin, gxm_set_ts_x_origin_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(stipple, gxm_stipple_w, set_stipple, gxm_set_stipple_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(tile, gxm_tile_w, set_tile, gxm_set_tile_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(arc_mode, gxm_arc_mode_w, set_arc_mode, gxm_set_arc_mode_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(fill_rule, gxm_fill_rule_w, set_fill_rule, gxm_set_fill_rule_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(fill_style, gxm_fill_style_w, set_fill_style, gxm_set_fill_style_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(join_style, gxm_join_style_w, set_join_style, gxm_set_join_style_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(cap_style, gxm_cap_style_w, set_cap_style, gxm_set_cap_style_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(line_style, gxm_line_style_w, set_line_style, gxm_set_line_style_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(line_width, gxm_line_width_w, set_line_width, gxm_set_line_width_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(background, gxm_background_w, set_background, gxm_set_background_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(foreground, gxm_foreground_w, set_foreground, gxm_set_foreground_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(plane_mask, gxm_plane_mask_w, set_plane_mask, gxm_set_plane_mask_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(function, gxm_function_w, set_function, gxm_set_function_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(delta, gxm_delta_w, set_delta, gxm_set_delta_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(nchars, gxm_nchars_w, set_nchars, gxm_set_nchars_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(chars, gxm_chars_w, set_chars, gxm_set_chars_w, 1, 0, 2, 0);
- XM_DEFINE_PROCEDURE(XTextItem, gxm_XTextItem_w, 4, 0, 0, H_XTextItem);
- XM_DEFINE_ACCESSOR(name, gxm_name_w, set_name, gxm_set_name_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(depth, gxm_depth_w, set_depth, gxm_set_depth_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(visual, gxm_visual_w, set_visual, gxm_set_visual_w, 1, 0, 2, 0);
-
- XM_DEFINE_READER(mwidth, gxm_mwidth_w, 1, 0, 0);
- XM_DEFINE_READER(mheight, gxm_mheight_w, 1, 0, 0);
- XM_DEFINE_READER(ndepths, gxm_ndepths_w, 1, 0, 0);
- XM_DEFINE_READER(depths, gxm_depths_w, 1, 0, 0);
- XM_DEFINE_READER(root_depth, gxm_root_depth_w, 1, 0, 0);
- XM_DEFINE_READER(root_visual, gxm_root_visual_w, 1, 0, 0);
- XM_DEFINE_READER(default_gc, gxm_default_gc_w, 1, 0, 0);
- XM_DEFINE_READER(cmap, gxm_cmap_w, 1, 0, 0);
- XM_DEFINE_READER(white_pixel, gxm_white_pixel_w, 1, 0, 0);
- XM_DEFINE_READER(black_pixel, gxm_black_pixel_w, 1, 0, 0);
- XM_DEFINE_READER(max_maps, gxm_max_maps_w, 1, 0, 0);
- XM_DEFINE_READER(min_maps, gxm_min_maps_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(backing_store, gxm_backing_store_w, set_backing_store, gxm_set_backing_store_w, 1, 0, 2, 0);
- XM_DEFINE_READER(save_unders, gxm_save_unders_w, 1, 0, 0);
- XM_DEFINE_READER(root_input_mask, gxm_root_input_mask_w, 1, 0, 0);
- XM_DEFINE_READER(lbearing, gxm_lbearing_w, 1, 0, 0);
- XM_DEFINE_READER(rbearing, gxm_rbearing_w, 1, 0, 0);
- XM_DEFINE_READER(ascent, gxm_ascent_w, 1, 0, 0);
- XM_DEFINE_READER(descent, gxm_descent_w, 1, 0, 0);
- XM_DEFINE_READER(attributes, gxm_attributes_w, 1, 0, 0);
- XM_DEFINE_READER(card32, gxm_card32_w, 1, 0, 0);
- XM_DEFINE_READER(fid, gxm_fid_w, 1, 0, 0);
- XM_DEFINE_READER(properties, gxm_properties_w, 1, 0, 0);
- XM_DEFINE_READER(min_bounds, gxm_min_bounds_w, 1, 0, 0);
- XM_DEFINE_READER(max_bounds, gxm_max_bounds_w, 1, 0, 0);
- XM_DEFINE_READER(per_char, gxm_per_char_w, 1, 0, 0);
-
- XM_DEFINE_ACCESSOR(input, gxm_input_w, set_input, gxm_set_input_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(initial_state, gxm_initial_state_w, set_initial_state, gxm_set_initial_state_w, 1, 0, 2, 0);
-
- XM_DEFINE_READER(icon_pixmap, gxm_icon_pixmap_w, 1, 0, 0);
- XM_DEFINE_READER(icon_window, gxm_icon_window_w, 1, 0, 0);
- XM_DEFINE_READER(icon_x, gxm_icon_x_w, 1, 0, 0);
- XM_DEFINE_READER(icon_y, gxm_icon_y_w, 1, 0, 0);
- XM_DEFINE_READER(icon_mask, gxm_icon_mask_w, 1, 0, 0);
- XM_DEFINE_READER(window_group, gxm_window_group_w, 1, 0, 0);
- XM_DEFINE_READER(visualid, gxm_visualid_w, 1, 0, 0);
- XM_DEFINE_READER(class, gxm_class_w, 1, 0, 0);
- XM_DEFINE_READER(red_mask, gxm_red_mask_w, 1, 0, 0);
- XM_DEFINE_READER(green_mask, gxm_green_mask_w, 1, 0, 0);
- XM_DEFINE_READER(blue_mask, gxm_blue_mask_w, 1, 0, 0);
- XM_DEFINE_READER(bits_per_rgb, gxm_bits_per_rgb_w, 1, 0, 0);
- XM_DEFINE_READER(colormap_size, gxm_colormap_size_w, 1, 0, 0);
- XM_DEFINE_READER(map_entries, gxm_map_entries_w, 1, 0, 0);
- XM_DEFINE_READER(nvisuals, gxm_nvisuals_w, 1, 0, 0);
- XM_DEFINE_READER(visuals, gxm_visuals_w, 1, 0, 0);
- XM_DEFINE_READER(bits_per_pixel, gxm_bits_per_pixel_w, 1, 0, 0);
- XM_DEFINE_READER(background_pixmap, gxm_background_pixmap_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(background_pixel, gxm_background_pixel_w, set_background_pixel, gxm_set_background_pixel_w, 1, 0, 2, 0);
- XM_DEFINE_READER(border_pixmap, gxm_border_pixmap_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(border_pixel, gxm_border_pixel_w, set_border_pixel, gxm_set_border_pixel_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(bit_gravity, gxm_bit_gravity_w, set_bit_gravity, gxm_set_bit_gravity_w, 1, 0, 2, 0);
- XM_DEFINE_READER(win_gravity, gxm_win_gravity_w, 1, 0, 0);
- XM_DEFINE_READER(backing_planes, gxm_backing_planes_w, 1, 0, 0);
- XM_DEFINE_READER(backing_pixel, gxm_backing_pixel_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(save_under, gxm_save_under_w, set_save_under, gxm_set_save_under_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(event_mask, gxm_event_mask_w, set_event_mask, gxm_set_event_mask_w, 1, 0, 2, 0);
- XM_DEFINE_READER(do_not_propagate_mask, gxm_do_not_propagate_mask_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(cursor, gxm_cursor_w, set_cursor, gxm_set_cursor_w, 1, 0, 2, 0);
- XM_DEFINE_READER(map_installed, gxm_map_installed_w, 1, 0, 0);
- XM_DEFINE_READER(map_state, gxm_map_state_w, 1, 0, 0);
- XM_DEFINE_READER(all_event_masks, gxm_all_event_masks_w, 1, 0, 0);
- XM_DEFINE_READER(your_event_mask, gxm_your_event_mask_w, 1, 0, 0);
- XM_DEFINE_READER(screen, gxm_screen_w, 1, 0, 0);
- XM_DEFINE_READER(xoffset, gxm_xoffset_w, 1, 0, 0);
- XM_DEFINE_READER(byte_order, gxm_byte_order_w, 1, 0, 0);
- XM_DEFINE_READER(bitmap_unit, gxm_bitmap_unit_w, 1, 0, 0);
- XM_DEFINE_READER(bitmap_bit_order, gxm_bitmap_bit_order_w, 1, 0, 0);
- XM_DEFINE_READER(bitmap_pad, gxm_bitmap_pad_w, 1, 0, 0);
- XM_DEFINE_READER(bytes_per_line, gxm_bytes_per_line_w, 1, 0, 0);
- XM_DEFINE_READER(obdata, gxm_obdata_w, 1, 0, 0);
- XM_DEFINE_READER(sibling, gxm_sibling_w, 1, 0, 0);
- XM_DEFINE_READER(stack_mode, gxm_stack_mode_w, 1, 0, 0);
+ #define XM_define_accessor(Name, Value, SetName, SetValue, A1, A2, A3, A4) \
+ Xen_define_dilambda(XM_FIELD_PREFIX #Name XM_POSTFIX, Value, #Name " field accessor", XM_FIELD_PREFIX #SetName XM_POSTFIX, SetValue, A1, A2, A3, A4)
+ #define XM_define_reader(Name, Value, A1, A2, A3) Xen_define_safe_procedure(XM_FIELD_PREFIX #Name XM_POSTFIX, Value, A1, A2, A3, #Name " field reader")
+
+ XM_define_accessor(pixel, gxm_pixel_w, set_pixel, gxm_set_pixel_w, 1, 0, 2, 0);
+ XM_define_accessor(red, gxm_red_w, set_red, gxm_set_red_w, 1, 0, 2, 0);
+ XM_define_accessor(green, gxm_green_w, set_green, gxm_set_green_w, 1, 0, 2, 0);
+ XM_define_accessor(blue, gxm_blue_w, set_blue, gxm_set_blue_w, 1, 0, 2, 0);
+ XM_define_accessor(flags, gxm_flags_w, set_flags, gxm_set_flags_w, 1, 0, 2, 0);
+ XM_define_accessor(pad, gxm_pad_w, set_pad, gxm_set_pad_w, 1, 0, 2, 0);
+ XM_define_procedure(XColor, gxm_XColor_w, 0, 6, 0, H_XColor);
+ XM_define_accessor(x, gxm_x_w, set_x, gxm_set_x_w, 1, 0, 2, 0);
+ XM_define_accessor(y, gxm_y_w, set_y, gxm_set_y_w, 1, 0, 2, 0);
+ XM_define_accessor(width, gxm_width_w, set_width, gxm_set_width_w, 1, 0, 2, 0);
+ XM_define_accessor(height, gxm_height_w, set_height, gxm_set_height_w, 1, 0, 2, 0);
+ XM_define_accessor(angle1, gxm_angle1_w, set_angle1, gxm_set_angle1_w, 1, 0, 2, 0);
+ XM_define_accessor(angle2, gxm_angle2_w, set_angle2, gxm_set_angle2_w, 1, 0, 2, 0);
+ XM_define_procedure(XArc, gxm_XArc_w, 6, 0, 0, H_XArc);
+ XM_define_procedure(XWindowChanges, gxm_XWindowChanges_w, 7, 0, 0, H_XWindowChanges);
+ XM_define_procedure(XSetWindowAttributes, gxm_XSetWindowAttributes_w, 0, 0, 1, H_XSetWindowAttributes);
+ XM_define_procedure(XPoint, gxm_XPoint_w, 2, 0, 0, H_XPoint);
+ XM_define_accessor(x1, gxm_x1_w, set_x1, gxm_set_x1_w, 1, 0, 2, 0);
+ XM_define_accessor(y1, gxm_y1_w, set_y1, gxm_set_y1_w, 1, 0, 2, 0);
+ XM_define_accessor(x2, gxm_x2_w, set_x2, gxm_set_x2_w, 1, 0, 2, 0);
+ XM_define_accessor(y2, gxm_y2_w, set_y2, gxm_set_y2_w, 1, 0, 2, 0);
+ XM_define_procedure(XSegment, gxm_XSegment_w, 4, 0, 0, H_XSegment);
+ XM_define_procedure(XRectangle, gxm_XRectangle_w, 4, 0, 0, H_XRectangle);
+ XM_define_accessor(dashes, gxm_dashes_w, set_dashes, gxm_set_dashes_w, 1, 0, 2, 0);
+ XM_define_accessor(dash_offset, gxm_dash_offset_w, set_dash_offset, gxm_set_dash_offset_w, 1, 0, 2, 0);
+ XM_define_accessor(clip_mask, gxm_clip_mask_w, set_clip_mask, gxm_set_clip_mask_w, 1, 0, 2, 0);
+ XM_define_accessor(clip_y_origin, gxm_clip_y_origin_w, set_clip_y_origin, gxm_set_clip_y_origin_w, 1, 0, 2, 0);
+ XM_define_accessor(clip_x_origin, gxm_clip_x_origin_w, set_clip_x_origin, gxm_set_clip_x_origin_w, 1, 0, 2, 0);
+ XM_define_accessor(graphics_exposures, gxm_graphics_exposures_w, set_graphics_exposures, gxm_set_graphics_exposures_w, 1, 0, 2, 0);
+ XM_define_accessor(subwindow_mode, gxm_subwindow_mode_w, set_subwindow_mode, gxm_set_subwindow_mode_w, 1, 0, 2, 0);
+ XM_define_accessor(font, gxm_font_w, set_font, gxm_set_font_w, 1, 0, 2, 0);
+ XM_define_accessor(ts_y_origin, gxm_ts_y_origin_w, set_ts_y_origin, gxm_set_ts_y_origin_w, 1, 0, 2, 0);
+ XM_define_accessor(ts_x_origin, gxm_ts_x_origin_w, set_ts_x_origin, gxm_set_ts_x_origin_w, 1, 0, 2, 0);
+ XM_define_accessor(stipple, gxm_stipple_w, set_stipple, gxm_set_stipple_w, 1, 0, 2, 0);
+ XM_define_accessor(tile, gxm_tile_w, set_tile, gxm_set_tile_w, 1, 0, 2, 0);
+ XM_define_accessor(arc_mode, gxm_arc_mode_w, set_arc_mode, gxm_set_arc_mode_w, 1, 0, 2, 0);
+ XM_define_accessor(fill_rule, gxm_fill_rule_w, set_fill_rule, gxm_set_fill_rule_w, 1, 0, 2, 0);
+ XM_define_accessor(fill_style, gxm_fill_style_w, set_fill_style, gxm_set_fill_style_w, 1, 0, 2, 0);
+ XM_define_accessor(join_style, gxm_join_style_w, set_join_style, gxm_set_join_style_w, 1, 0, 2, 0);
+ XM_define_accessor(cap_style, gxm_cap_style_w, set_cap_style, gxm_set_cap_style_w, 1, 0, 2, 0);
+ XM_define_accessor(line_style, gxm_line_style_w, set_line_style, gxm_set_line_style_w, 1, 0, 2, 0);
+ XM_define_accessor(line_width, gxm_line_width_w, set_line_width, gxm_set_line_width_w, 1, 0, 2, 0);
+ XM_define_accessor(background, gxm_background_w, set_background, gxm_set_background_w, 1, 0, 2, 0);
+ XM_define_accessor(foreground, gxm_foreground_w, set_foreground, gxm_set_foreground_w, 1, 0, 2, 0);
+ XM_define_accessor(plane_mask, gxm_plane_mask_w, set_plane_mask, gxm_set_plane_mask_w, 1, 0, 2, 0);
+ XM_define_accessor(function, gxm_function_w, set_function, gxm_set_function_w, 1, 0, 2, 0);
+ XM_define_accessor(delta, gxm_delta_w, set_delta, gxm_set_delta_w, 1, 0, 2, 0);
+ XM_define_accessor(nchars, gxm_nchars_w, set_nchars, gxm_set_nchars_w, 1, 0, 2, 0);
+ XM_define_accessor(chars, gxm_chars_w, set_chars, gxm_set_chars_w, 1, 0, 2, 0);
+ XM_define_procedure(XTextItem, gxm_XTextItem_w, 4, 0, 0, H_XTextItem);
+ XM_define_accessor(name, gxm_name_w, set_name, gxm_set_name_w, 1, 0, 2, 0);
+ XM_define_accessor(depth, gxm_depth_w, set_depth, gxm_set_depth_w, 1, 0, 2, 0);
+ XM_define_accessor(visual, gxm_visual_w, set_visual, gxm_set_visual_w, 1, 0, 2, 0);
+
+ XM_define_reader(mwidth, gxm_mwidth_w, 1, 0, 0);
+ XM_define_reader(mheight, gxm_mheight_w, 1, 0, 0);
+ XM_define_reader(ndepths, gxm_ndepths_w, 1, 0, 0);
+ XM_define_reader(depths, gxm_depths_w, 1, 0, 0);
+ XM_define_reader(root_depth, gxm_root_depth_w, 1, 0, 0);
+ XM_define_reader(root_visual, gxm_root_visual_w, 1, 0, 0);
+ XM_define_reader(default_gc, gxm_default_gc_w, 1, 0, 0);
+ XM_define_reader(cmap, gxm_cmap_w, 1, 0, 0);
+ XM_define_reader(white_pixel, gxm_white_pixel_w, 1, 0, 0);
+ XM_define_reader(black_pixel, gxm_black_pixel_w, 1, 0, 0);
+ XM_define_reader(max_maps, gxm_max_maps_w, 1, 0, 0);
+ XM_define_reader(min_maps, gxm_min_maps_w, 1, 0, 0);
+ XM_define_accessor(backing_store, gxm_backing_store_w, set_backing_store, gxm_set_backing_store_w, 1, 0, 2, 0);
+ XM_define_reader(save_unders, gxm_save_unders_w, 1, 0, 0);
+ XM_define_reader(root_input_mask, gxm_root_input_mask_w, 1, 0, 0);
+ XM_define_reader(lbearing, gxm_lbearing_w, 1, 0, 0);
+ XM_define_reader(rbearing, gxm_rbearing_w, 1, 0, 0);
+ XM_define_reader(ascent, gxm_ascent_w, 1, 0, 0);
+ XM_define_reader(descent, gxm_descent_w, 1, 0, 0);
+ XM_define_reader(attributes, gxm_attributes_w, 1, 0, 0);
+ XM_define_reader(card32, gxm_card32_w, 1, 0, 0);
+ XM_define_reader(fid, gxm_fid_w, 1, 0, 0);
+ XM_define_reader(properties, gxm_properties_w, 1, 0, 0);
+ XM_define_reader(min_bounds, gxm_min_bounds_w, 1, 0, 0);
+ XM_define_reader(max_bounds, gxm_max_bounds_w, 1, 0, 0);
+ XM_define_reader(per_char, gxm_per_char_w, 1, 0, 0);
+
+ XM_define_accessor(input, gxm_input_w, set_input, gxm_set_input_w, 1, 0, 2, 0);
+ XM_define_accessor(initial_state, gxm_initial_state_w, set_initial_state, gxm_set_initial_state_w, 1, 0, 2, 0);
+
+ XM_define_reader(icon_pixmap, gxm_icon_pixmap_w, 1, 0, 0);
+ XM_define_reader(icon_window, gxm_icon_window_w, 1, 0, 0);
+ XM_define_reader(icon_x, gxm_icon_x_w, 1, 0, 0);
+ XM_define_reader(icon_y, gxm_icon_y_w, 1, 0, 0);
+ XM_define_reader(icon_mask, gxm_icon_mask_w, 1, 0, 0);
+ XM_define_reader(window_group, gxm_window_group_w, 1, 0, 0);
+ XM_define_reader(visualid, gxm_visualid_w, 1, 0, 0);
+ XM_define_reader(class, gxm_class_w, 1, 0, 0);
+ XM_define_reader(red_mask, gxm_red_mask_w, 1, 0, 0);
+ XM_define_reader(green_mask, gxm_green_mask_w, 1, 0, 0);
+ XM_define_reader(blue_mask, gxm_blue_mask_w, 1, 0, 0);
+ XM_define_reader(bits_per_rgb, gxm_bits_per_rgb_w, 1, 0, 0);
+ XM_define_reader(colormap_size, gxm_colormap_size_w, 1, 0, 0);
+ XM_define_reader(map_entries, gxm_map_entries_w, 1, 0, 0);
+ XM_define_reader(nvisuals, gxm_nvisuals_w, 1, 0, 0);
+ XM_define_reader(visuals, gxm_visuals_w, 1, 0, 0);
+ XM_define_reader(bits_per_pixel, gxm_bits_per_pixel_w, 1, 0, 0);
+ XM_define_reader(background_pixmap, gxm_background_pixmap_w, 1, 0, 0);
+ XM_define_accessor(background_pixel, gxm_background_pixel_w, set_background_pixel, gxm_set_background_pixel_w, 1, 0, 2, 0);
+ XM_define_reader(border_pixmap, gxm_border_pixmap_w, 1, 0, 0);
+ XM_define_accessor(border_pixel, gxm_border_pixel_w, set_border_pixel, gxm_set_border_pixel_w, 1, 0, 2, 0);
+ XM_define_accessor(bit_gravity, gxm_bit_gravity_w, set_bit_gravity, gxm_set_bit_gravity_w, 1, 0, 2, 0);
+ XM_define_reader(win_gravity, gxm_win_gravity_w, 1, 0, 0);
+ XM_define_reader(backing_planes, gxm_backing_planes_w, 1, 0, 0);
+ XM_define_reader(backing_pixel, gxm_backing_pixel_w, 1, 0, 0);
+ XM_define_accessor(save_under, gxm_save_under_w, set_save_under, gxm_set_save_under_w, 1, 0, 2, 0);
+ XM_define_accessor(event_mask, gxm_event_mask_w, set_event_mask, gxm_set_event_mask_w, 1, 0, 2, 0);
+ XM_define_reader(do_not_propagate_mask, gxm_do_not_propagate_mask_w, 1, 0, 0);
+ XM_define_accessor(cursor, gxm_cursor_w, set_cursor, gxm_set_cursor_w, 1, 0, 2, 0);
+ XM_define_reader(map_installed, gxm_map_installed_w, 1, 0, 0);
+ XM_define_reader(map_state, gxm_map_state_w, 1, 0, 0);
+ XM_define_reader(all_event_masks, gxm_all_event_masks_w, 1, 0, 0);
+ XM_define_reader(your_event_mask, gxm_your_event_mask_w, 1, 0, 0);
+ XM_define_reader(screen, gxm_screen_w, 1, 0, 0);
+ XM_define_reader(xoffset, gxm_xoffset_w, 1, 0, 0);
+ XM_define_reader(byte_order, gxm_byte_order_w, 1, 0, 0);
+ XM_define_reader(bitmap_unit, gxm_bitmap_unit_w, 1, 0, 0);
+ XM_define_reader(bitmap_bit_order, gxm_bitmap_bit_order_w, 1, 0, 0);
+ XM_define_reader(bitmap_pad, gxm_bitmap_pad_w, 1, 0, 0);
+ XM_define_reader(bytes_per_line, gxm_bytes_per_line_w, 1, 0, 0);
+ XM_define_reader(obdata, gxm_obdata_w, 1, 0, 0);
+ XM_define_reader(sibling, gxm_sibling_w, 1, 0, 0);
+ XM_define_reader(stack_mode, gxm_stack_mode_w, 1, 0, 0);
- XM_DEFINE_READER(red_max, gxm_red_max_w, 1, 0, 0);
- XM_DEFINE_READER(red_mult, gxm_red_mult_w, 1, 0, 0);
- XM_DEFINE_READER(green_max, gxm_green_max_w, 1, 0, 0);
- XM_DEFINE_READER(green_mult, gxm_green_mult_w, 1, 0, 0);
- XM_DEFINE_READER(blue_max, gxm_blue_max_w, 1, 0, 0);
- XM_DEFINE_READER(blue_mult, gxm_blue_mult_w, 1, 0, 0);
- XM_DEFINE_READER(base_pixel, gxm_base_pixel_w, 1, 0, 0);
- XM_DEFINE_READER(killid, gxm_killid_w, 1, 0, 0);
-
- XM_DEFINE_READER(min_height, gxm_min_height_w, 1, 0, 0);
- XM_DEFINE_READER(max_height, gxm_max_height_w, 1, 0, 0);
- XM_DEFINE_READER(min_width, gxm_min_width_w, 1, 0, 0);
- XM_DEFINE_READER(max_width, gxm_max_width_w, 1, 0, 0);
- XM_DEFINE_READER(height_inc, gxm_height_inc_w, 1, 0, 0);
- XM_DEFINE_READER(width_inc, gxm_width_inc_w, 1, 0, 0);
-
-#if HAVE_MOTIF
- XM_DEFINE_READER(page_number, gxm_page_number_w, 1, 0, 0);
- XM_DEFINE_READER(page_widget, gxm_page_widget_w, 1, 0, 0);
- XM_DEFINE_READER(status_area_widget, gxm_status_area_widget_w, 1, 0, 0);
- XM_DEFINE_READER(major_tab_widget, gxm_major_tab_widget_w, 1, 0, 0);
- XM_DEFINE_READER(minor_tab_widget, gxm_minor_tab_widget_w, 1, 0, 0);
- XM_DEFINE_READER(source_data, gxm_source_data_w, 1, 0, 0);
- XM_DEFINE_READER(location_data, gxm_location_data_w, 1, 0, 0);
- XM_DEFINE_READER(parm, gxm_parm_w, 1, 0, 0);
- XM_DEFINE_READER(parm_format, gxm_parm_format_w, 1, 0, 0);
- XM_DEFINE_READER(parm_length, gxm_parm_length_w, 1, 0, 0);
- XM_DEFINE_READER(parm_type, gxm_parm_type_w, 1, 0, 0);
- XM_DEFINE_READER(transfer_id, gxm_transfer_id_w, 1, 0, 0);
- XM_DEFINE_READER(destination_data, gxm_destination_data_w, 1, 0, 0);
- XM_DEFINE_READER(remaining, gxm_remaining_w, 1, 0, 0);
- XM_DEFINE_READER(item_or_text, gxm_item_or_text_w, 1, 0, 0);
- XM_DEFINE_READER(auto_selection_type, gxm_auto_selection_type_w, 1, 0, 0);
- XM_DEFINE_READER(new_outline_state, gxm_new_outline_state_w, 1, 0, 0);
- XM_DEFINE_READER(prev_page_number, gxm_prev_page_number_w, 1, 0, 0);
- XM_DEFINE_READER(prev_page_widget, gxm_prev_page_widget_w, 1, 0, 0);
- XM_DEFINE_READER(rendition, gxm_rendition_w, 1, 0, 0);
- XM_DEFINE_READER(render_table, gxm_render_table_w, 1, 0, 0);
- XM_DEFINE_READER(crossed_boundary, gxm_crossed_boundary_w, 1, 0, 0);
- XM_DEFINE_READER(client_data, gxm_client_data_w, 1, 0, 0);
- XM_DEFINE_READER(status, gxm_status_w, 1, 0, 0);
- XM_DEFINE_READER(font_name, gxm_font_name_w, 1, 0, 0);
- XM_DEFINE_READER(tag, gxm_tag_w, 1, 0, 0);
- XM_DEFINE_READER(traversal_destination, gxm_traversal_destination_w, 1, 0, 0);
- XM_DEFINE_READER(dragProtocolStyle, gxm_dragProtocolStyle_w, 1, 0, 0);
- XM_DEFINE_READER(direction, gxm_direction_w, 1, 0, 0);
- XM_DEFINE_READER(position, gxm_position_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(menuToPost, gxm_menuToPost_w, set_menuToPost, gxm_set_menuToPost_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(postIt, gxm_postIt_w, set_postIt, gxm_set_postIt_w, 1, 0, 2, 0);
- XM_DEFINE_READER(timeStamp, gxm_timeStamp_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(operation, gxm_operation_w, set_operation, gxm_set_operation_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(reason, gxm_reason_w, set_reason, gxm_set_reason_w, 1, 0, 2, 0);
- XM_DEFINE_READER(operations, gxm_operations_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(dropSiteStatus, gxm_dropSiteStatus_w, set_dropSiteStatus, gxm_set_dropSiteStatus_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(set, gxm_set_w, set_set, gxm_set_set_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(click_count, gxm_click_count_w, set_click_count, gxm_set_click_count_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(length, gxm_length_w, set_length, gxm_set_length_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(ptr, gxm_ptr_w, set_ptr, gxm_set_ptr_w, 1, 0, 2, 0);
- XM_DEFINE_READER(dropAction, gxm_dropAction_w, 1, 0, 0);
- XM_DEFINE_READER(iccHandle, gxm_iccHandle_w, 1, 0, 0);
- XM_DEFINE_READER(completionStatus, gxm_completionStatus_w, 1, 0, 0);
- XM_DEFINE_READER(dragContext, gxm_dragContext_w, 1, 0, 0);
- XM_DEFINE_READER(animate, gxm_animate_w, 1, 0, 0);
- XM_DEFINE_READER(widget, gxm_widget_w, 1, 0, 0);
- XM_DEFINE_READER(item_position, gxm_item_position_w, 1, 0, 0);
- XM_DEFINE_READER(callbackstruct, gxm_callbackstruct_w, 1, 0, 0);
- XM_DEFINE_READER(item, gxm_item_w, 1, 0, 0);
- XM_DEFINE_READER(item_length, gxm_item_length_w, 1, 0, 0);
- XM_DEFINE_READER(selected_items, gxm_selected_items_w, 1, 0, 0);
- XM_DEFINE_READER(selected_item_count, gxm_selected_item_count_w, 1, 0, 0);
- XM_DEFINE_READER(selected_item_positions, gxm_selected_item_positions_w, 1, 0, 0);
- XM_DEFINE_READER(selection_type, gxm_selection_type_w, 1, 0, 0);
- XM_DEFINE_READER(mask, gxm_mask_w, 1, 0, 0);
- XM_DEFINE_READER(mask_length, gxm_mask_length_w, 1, 0, 0);
- XM_DEFINE_READER(dir, gxm_dir_w, 1, 0, 0);
- XM_DEFINE_READER(dir_length, gxm_dir_length_w, 1, 0, 0);
- XM_DEFINE_READER(pattern, gxm_pattern_w, 1, 0, 0);
- XM_DEFINE_READER(pattern_length, gxm_pattern_length_w, 1, 0, 0);
- XM_DEFINE_READER(currInsert, gxm_currInsert_w, 1, 0, 0);
- XM_DEFINE_READER(newInsert, gxm_newInsert_w, 1, 0, 0);
- XM_DEFINE_READER(startPos, gxm_startPos_w, 1, 0, 0);
- XM_DEFINE_READER(endPos, gxm_endPos_w, 1, 0, 0);
- XM_DEFINE_READER(text, gxm_text_w, 1, 0, 0);
- XM_DEFINE_ACCESSOR(value, gxm_value_w, set_value, gxm_set_value_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(doit, gxm_doit_w, set_doit, gxm_set_doit_w, 1, 0, 2, 0);
-#if HAVE_XmCreateDataField
- XM_DEFINE_READER(w, gxm_w_w, 1, 0, 0);
- XM_DEFINE_READER(accept, gxm_accept_w, 1, 0, 0);
-#endif
-#if HAVE_XmCreateTabStack
- XM_DEFINE_READER(selected_child, gxm_selected_child_w, 1, 0, 0);
-#endif
+ XM_define_reader(red_max, gxm_red_max_w, 1, 0, 0);
+ XM_define_reader(red_mult, gxm_red_mult_w, 1, 0, 0);
+ XM_define_reader(green_max, gxm_green_max_w, 1, 0, 0);
+ XM_define_reader(green_mult, gxm_green_mult_w, 1, 0, 0);
+ XM_define_reader(blue_max, gxm_blue_max_w, 1, 0, 0);
+ XM_define_reader(blue_mult, gxm_blue_mult_w, 1, 0, 0);
+ XM_define_reader(base_pixel, gxm_base_pixel_w, 1, 0, 0);
+ XM_define_reader(killid, gxm_killid_w, 1, 0, 0);
+
+ XM_define_reader(min_height, gxm_min_height_w, 1, 0, 0);
+ XM_define_reader(max_height, gxm_max_height_w, 1, 0, 0);
+ XM_define_reader(min_width, gxm_min_width_w, 1, 0, 0);
+ XM_define_reader(max_width, gxm_max_width_w, 1, 0, 0);
+ XM_define_reader(height_inc, gxm_height_inc_w, 1, 0, 0);
+ XM_define_reader(width_inc, gxm_width_inc_w, 1, 0, 0);
+
+ XM_define_reader(page_number, gxm_page_number_w, 1, 0, 0);
+ XM_define_reader(page_widget, gxm_page_widget_w, 1, 0, 0);
+ XM_define_reader(status_area_widget, gxm_status_area_widget_w, 1, 0, 0);
+ XM_define_reader(major_tab_widget, gxm_major_tab_widget_w, 1, 0, 0);
+ XM_define_reader(minor_tab_widget, gxm_minor_tab_widget_w, 1, 0, 0);
+ XM_define_reader(source_data, gxm_source_data_w, 1, 0, 0);
+ XM_define_reader(location_data, gxm_location_data_w, 1, 0, 0);
+ XM_define_reader(parm, gxm_parm_w, 1, 0, 0);
+ XM_define_reader(parm_format, gxm_parm_format_w, 1, 0, 0);
+ XM_define_reader(parm_length, gxm_parm_length_w, 1, 0, 0);
+ XM_define_reader(parm_type, gxm_parm_type_w, 1, 0, 0);
+ XM_define_reader(transfer_id, gxm_transfer_id_w, 1, 0, 0);
+ XM_define_reader(destination_data, gxm_destination_data_w, 1, 0, 0);
+ XM_define_reader(remaining, gxm_remaining_w, 1, 0, 0);
+ XM_define_reader(item_or_text, gxm_item_or_text_w, 1, 0, 0);
+ XM_define_reader(auto_selection_type, gxm_auto_selection_type_w, 1, 0, 0);
+ XM_define_reader(new_outline_state, gxm_new_outline_state_w, 1, 0, 0);
+ XM_define_reader(prev_page_number, gxm_prev_page_number_w, 1, 0, 0);
+ XM_define_reader(prev_page_widget, gxm_prev_page_widget_w, 1, 0, 0);
+ XM_define_reader(rendition, gxm_rendition_w, 1, 0, 0);
+ XM_define_reader(render_table, gxm_render_table_w, 1, 0, 0);
+ XM_define_reader(crossed_boundary, gxm_crossed_boundary_w, 1, 0, 0);
+ XM_define_reader(client_data, gxm_client_data_w, 1, 0, 0);
+ XM_define_reader(status, gxm_status_w, 1, 0, 0);
+ XM_define_reader(font_name, gxm_font_name_w, 1, 0, 0);
+ XM_define_reader(tag, gxm_tag_w, 1, 0, 0);
+ XM_define_reader(traversal_destination, gxm_traversal_destination_w, 1, 0, 0);
+ XM_define_reader(dragProtocolStyle, gxm_dragProtocolStyle_w, 1, 0, 0);
+ XM_define_reader(direction, gxm_direction_w, 1, 0, 0);
+ XM_define_reader(position, gxm_position_w, 1, 0, 0);
+ XM_define_accessor(menuToPost, gxm_menuToPost_w, set_menuToPost, gxm_set_menuToPost_w, 1, 0, 2, 0);
+ XM_define_accessor(postIt, gxm_postIt_w, set_postIt, gxm_set_postIt_w, 1, 0, 2, 0);
+ XM_define_reader(timeStamp, gxm_timeStamp_w, 1, 0, 0);
+ XM_define_accessor(operation, gxm_operation_w, set_operation, gxm_set_operation_w, 1, 0, 2, 0);
+ XM_define_accessor(reason, gxm_reason_w, set_reason, gxm_set_reason_w, 1, 0, 2, 0);
+ XM_define_reader(operations, gxm_operations_w, 1, 0, 0);
+ XM_define_accessor(dropSiteStatus, gxm_dropSiteStatus_w, set_dropSiteStatus, gxm_set_dropSiteStatus_w, 1, 0, 2, 0);
+ XM_define_accessor(set, gxm_set_w, set_set, gxm_set_set_w, 1, 0, 2, 0);
+ XM_define_accessor(click_count, gxm_click_count_w, set_click_count, gxm_set_click_count_w, 1, 0, 2, 0);
+ XM_define_accessor(length, gxm_length_w, set_length, gxm_set_length_w, 1, 0, 2, 0);
+ XM_define_accessor(ptr, gxm_ptr_w, set_ptr, gxm_set_ptr_w, 1, 0, 2, 0);
+ XM_define_reader(dropAction, gxm_dropAction_w, 1, 0, 0);
+ XM_define_reader(iccHandle, gxm_iccHandle_w, 1, 0, 0);
+ XM_define_reader(completionStatus, gxm_completionStatus_w, 1, 0, 0);
+ XM_define_reader(dragContext, gxm_dragContext_w, 1, 0, 0);
+ XM_define_reader(animate, gxm_animate_w, 1, 0, 0);
+ XM_define_reader(widget, gxm_widget_w, 1, 0, 0);
+ XM_define_reader(item_position, gxm_item_position_w, 1, 0, 0);
+ XM_define_reader(callbackstruct, gxm_callbackstruct_w, 1, 0, 0);
+ XM_define_reader(item, gxm_item_w, 1, 0, 0);
+ XM_define_reader(item_length, gxm_item_length_w, 1, 0, 0);
+ XM_define_reader(selected_items, gxm_selected_items_w, 1, 0, 0);
+ XM_define_reader(selected_item_count, gxm_selected_item_count_w, 1, 0, 0);
+ XM_define_reader(selected_item_positions, gxm_selected_item_positions_w, 1, 0, 0);
+ XM_define_reader(selection_type, gxm_selection_type_w, 1, 0, 0);
+ XM_define_reader(mask, gxm_mask_w, 1, 0, 0);
+ XM_define_reader(mask_length, gxm_mask_length_w, 1, 0, 0);
+ XM_define_reader(dir, gxm_dir_w, 1, 0, 0);
+ XM_define_reader(dir_length, gxm_dir_length_w, 1, 0, 0);
+ XM_define_reader(pattern, gxm_pattern_w, 1, 0, 0);
+ XM_define_reader(pattern_length, gxm_pattern_length_w, 1, 0, 0);
+ XM_define_reader(currInsert, gxm_currInsert_w, 1, 0, 0);
+ XM_define_reader(newInsert, gxm_newInsert_w, 1, 0, 0);
+ XM_define_reader(startPos, gxm_startPos_w, 1, 0, 0);
+ XM_define_reader(endPos, gxm_endPos_w, 1, 0, 0);
+ XM_define_reader(text, gxm_text_w, 1, 0, 0);
+ XM_define_accessor(value, gxm_value_w, set_value, gxm_set_value_w, 1, 0, 2, 0);
+ XM_define_accessor(doit, gxm_doit_w, set_doit, gxm_set_doit_w, 1, 0, 2, 0);
+
+ XM_define_accessor(valuemask, gxm_valuemask_w, set_valuemask, gxm_set_valuemask_w, 1, 0, 2, 0);
+ XM_define_accessor(ncolors, gxm_ncolors_w, set_ncolors, gxm_set_ncolors_w, 1, 0, 2, 0);
+ XM_define_accessor(cpp, gxm_cpp_w, set_cpp, gxm_set_cpp_w, 1, 0, 2, 0);
+ XM_define_procedure(XpmImage, gxm_XpmImage_w, 5, 0, 0, H_XpmImage);
+ XM_define_accessor(numsymbols, gxm_numsymbols_w, set_numsymbols, gxm_set_numsymbols_w, 1, 0, 2, 0);
+ XM_define_accessor(colorsymbols, gxm_colorsymbols_w, set_colorsymbols, gxm_set_colorsymbols_w, 1, 0, 2, 0);
+ XM_define_accessor(npixels, gxm_npixels_w, set_npixels, gxm_set_npixels_w, 1, 0, 2, 0);
+ XM_define_accessor(y_hotspot, gxm_y_hotspot_w, set_y_hotspot, gxm_set_y_hotspot_w, 1, 0, 2, 0);
+ XM_define_accessor(x_hotspot, gxm_x_hotspot_w, set_x_hotspot, gxm_set_x_hotspot_w, 1, 0, 2, 0);
+ XM_define_procedure(XpmColorSymbol, gxm_XpmColorSymbol_w, 3, 0, 0, H_XpmColorSymbol);
+ XM_define_procedure(XpmAttributes, gxm_XpmAttributes_w, 0, 0, 0, H_XpmAttributes);
+
+ XM_define_accessor(request_code, gxm_request_code_w, set_request_code, gxm_set_request_code_w, 1, 0, 2, 0);
+ XM_define_accessor(error_code, gxm_error_code_w, set_error_code, gxm_set_error_code_w, 1, 0, 2, 0);
+ XM_define_accessor(first_keycode, gxm_first_keycode_w, set_first_keycode, gxm_set_first_keycode_w, 1, 0, 2, 0);
+ XM_define_accessor(request, gxm_request_w, set_request, gxm_set_request_w, 1, 0, 2, 0);
+ XM_define_accessor(resourceid, gxm_resourceid_w, set_resourceid, gxm_set_resourceid_w, 1, 0, 2, 0);
+ XM_define_accessor(format, gxm_format_w, set_format, gxm_set_format_w, 1, 0, 2, 0);
+ XM_define_accessor(data, gxm_data_w, set_data, gxm_set_data_w, 1, 0, 2, 0);
+ XM_define_accessor(message_type, gxm_message_type_w, set_message_type, gxm_set_message_type_w, 1, 0, 2, 0);
+ XM_define_accessor(new, gxm_new_w, set_new, gxm_set_new_w, 1, 0, 2, 0);
+ XM_define_accessor(property, gxm_property_w, set_property, gxm_set_property_w, 1, 0, 2, 0);
+ XM_define_accessor(display, gxm_display_w, set_display, gxm_set_display_w, 1, 0, 2, 0);
+ XM_define_accessor(target, gxm_target_w, set_target, gxm_set_target_w, 1, 0, 2, 0);
+ XM_define_accessor(requestor, gxm_requestor_w, set_requestor, gxm_set_requestor_w, 1, 0, 2, 0);
+ XM_define_accessor(owner, gxm_owner_w, set_owner, gxm_set_owner_w, 1, 0, 2, 0);
+ XM_define_accessor(selection, gxm_selection_w, set_selection, gxm_set_selection_w, 1, 0, 2, 0);
+ XM_define_accessor(atom, gxm_atom_w, set_atom, gxm_set_atom_w, 1, 0, 2, 0);
+ XM_define_accessor(place, gxm_place_w, set_place, gxm_set_place_w, 1, 0, 2, 0);
+ XM_define_accessor(value_mask, gxm_value_mask_w, set_value_mask, gxm_set_value_mask_w, 1, 0, 2, 0);
+ XM_define_accessor(above, gxm_above_w, set_above, gxm_set_above_w, 1, 0, 2, 0);
+ XM_define_accessor(from_configure, gxm_from_configure_w, set_from_configure, gxm_set_from_configure_w, 1, 0, 2, 0);
+ XM_define_accessor(event, gxm_event_w, set_event, gxm_set_event_w, 1, 0, 2, 0);
+ XM_define_accessor(override_redirect, gxm_override_redirect_w, set_override_redirect, gxm_set_override_redirect_w, 1, 0, 2, 0);
+ XM_define_accessor(border_width, gxm_border_width_w, set_border_width, gxm_set_border_width_w, 1, 0, 2, 0);
+ XM_define_accessor(parent, gxm_parent_w, set_parent, gxm_set_parent_w, 1, 0, 2, 0);
+ XM_define_accessor(minor_code, gxm_minor_code_w, set_minor_code, gxm_set_minor_code_w, 1, 0, 2, 0);
+ XM_define_accessor(major_code, gxm_major_code_w, set_major_code, gxm_set_major_code_w, 1, 0, 2, 0);
+ XM_define_accessor(drawable, gxm_drawable_w, set_drawable, gxm_set_drawable_w, 1, 0, 2, 0);
+ XM_define_accessor(count, gxm_count_w, set_count, gxm_set_count_w, 1, 0, 2, 0);
+ XM_define_accessor(key_vector, gxm_key_vector_w, set_key_vector, gxm_set_key_vector_w, 1, 0, 2, 0);
+ XM_define_accessor(focus, gxm_focus_w, set_focus, gxm_set_focus_w, 1, 0, 2, 0);
+ XM_define_accessor(detail, gxm_detail_w, set_detail, gxm_set_detail_w, 1, 0, 2, 0);
+ XM_define_accessor(mode, gxm_mode_w, set_mode, gxm_set_mode_w, 1, 0, 2, 0);
+ XM_define_accessor(is_hint, gxm_is_hint_w, set_is_hint, gxm_set_is_hint_w, 1, 0, 2, 0);
+ XM_define_accessor(button, gxm_button_w, set_button, gxm_set_button_w, 1, 0, 2, 0);
+ XM_define_accessor(same_screen, gxm_same_screen_w, set_same_screen, gxm_set_same_screen_w, 1, 0, 2, 0);
+ XM_define_accessor(keycode, gxm_keycode_w, set_keycode, gxm_set_keycode_w, 1, 0, 2, 0);
+ XM_define_accessor(state, gxm_state_w, set_state, gxm_set_state_w, 1, 0, 2, 0);
+ XM_define_accessor(y_root, gxm_y_root_w, set_y_root, gxm_set_y_root_w, 1, 0, 2, 0);
+ XM_define_accessor(x_root, gxm_x_root_w, set_x_root, gxm_set_x_root_w, 1, 0, 2, 0);
+ XM_define_accessor(root, gxm_root_w, set_root, gxm_set_root_w, 1, 0, 2, 0);
+ XM_define_accessor(time, gxm_time_w, set_time, gxm_set_time_w, 1, 0, 2, 0);
+ XM_define_accessor(subwindow, gxm_subwindow_w, set_subwindow, gxm_set_subwindow_w, 1, 0, 2, 0);
+ XM_define_accessor(window, gxm_window_w, set_window, gxm_set_window_w, 1, 0, 2, 0);
+ XM_define_accessor(send_event, gxm_send_event_w, set_send_event, gxm_set_send_event_w, 1, 0, 2, 0);
+ XM_define_accessor(serial, gxm_serial_w, set_serial, gxm_set_serial_w, 1, 0, 2, 0);
+ XM_define_accessor(type, gxm_type_w, set_type, gxm_set_type_w, 1, 0, 2, 0);
+ XM_define_accessor(colormap, gxm_colormap_w, set_colormap, gxm_set_colormap_w, 1, 0, 2, 0);
+}
- XM_DEFINE_ACCESSOR(valuemask, gxm_valuemask_w, set_valuemask, gxm_set_valuemask_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(ncolors, gxm_ncolors_w, set_ncolors, gxm_set_ncolors_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(cpp, gxm_cpp_w, set_cpp, gxm_set_cpp_w, 1, 0, 2, 0);
- XM_DEFINE_PROCEDURE(XpmImage, gxm_XpmImage_w, 5, 0, 0, H_XpmImage);
- XM_DEFINE_ACCESSOR(numsymbols, gxm_numsymbols_w, set_numsymbols, gxm_set_numsymbols_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(colorsymbols, gxm_colorsymbols_w, set_colorsymbols, gxm_set_colorsymbols_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(npixels, gxm_npixels_w, set_npixels, gxm_set_npixels_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(y_hotspot, gxm_y_hotspot_w, set_y_hotspot, gxm_set_y_hotspot_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(x_hotspot, gxm_x_hotspot_w, set_x_hotspot, gxm_set_x_hotspot_w, 1, 0, 2, 0);
- XM_DEFINE_PROCEDURE(XpmColorSymbol, gxm_XpmColorSymbol_w, 3, 0, 0, H_XpmColorSymbol);
- XM_DEFINE_PROCEDURE(XpmAttributes, gxm_XpmAttributes_w, 0, 0, 0, H_XpmAttributes);
-#endif
- XM_DEFINE_ACCESSOR(request_code, gxm_request_code_w, set_request_code, gxm_set_request_code_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(error_code, gxm_error_code_w, set_error_code, gxm_set_error_code_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(first_keycode, gxm_first_keycode_w, set_first_keycode, gxm_set_first_keycode_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(request, gxm_request_w, set_request, gxm_set_request_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(resourceid, gxm_resourceid_w, set_resourceid, gxm_set_resourceid_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(format, gxm_format_w, set_format, gxm_set_format_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(data, gxm_data_w, set_data, gxm_set_data_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(message_type, gxm_message_type_w, set_message_type, gxm_set_message_type_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(new, gxm_new_w, set_new, gxm_set_new_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(property, gxm_property_w, set_property, gxm_set_property_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(display, gxm_display_w, set_display, gxm_set_display_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(target, gxm_target_w, set_target, gxm_set_target_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(requestor, gxm_requestor_w, set_requestor, gxm_set_requestor_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(owner, gxm_owner_w, set_owner, gxm_set_owner_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(selection, gxm_selection_w, set_selection, gxm_set_selection_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(atom, gxm_atom_w, set_atom, gxm_set_atom_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(place, gxm_place_w, set_place, gxm_set_place_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(value_mask, gxm_value_mask_w, set_value_mask, gxm_set_value_mask_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(above, gxm_above_w, set_above, gxm_set_above_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(from_configure, gxm_from_configure_w, set_from_configure, gxm_set_from_configure_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(event, gxm_event_w, set_event, gxm_set_event_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(override_redirect, gxm_override_redirect_w, set_override_redirect, gxm_set_override_redirect_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(border_width, gxm_border_width_w, set_border_width, gxm_set_border_width_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(parent, gxm_parent_w, set_parent, gxm_set_parent_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(minor_code, gxm_minor_code_w, set_minor_code, gxm_set_minor_code_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(major_code, gxm_major_code_w, set_major_code, gxm_set_major_code_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(drawable, gxm_drawable_w, set_drawable, gxm_set_drawable_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(count, gxm_count_w, set_count, gxm_set_count_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(key_vector, gxm_key_vector_w, set_key_vector, gxm_set_key_vector_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(focus, gxm_focus_w, set_focus, gxm_set_focus_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(detail, gxm_detail_w, set_detail, gxm_set_detail_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(mode, gxm_mode_w, set_mode, gxm_set_mode_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(is_hint, gxm_is_hint_w, set_is_hint, gxm_set_is_hint_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(button, gxm_button_w, set_button, gxm_set_button_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(same_screen, gxm_same_screen_w, set_same_screen, gxm_set_same_screen_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(keycode, gxm_keycode_w, set_keycode, gxm_set_keycode_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(state, gxm_state_w, set_state, gxm_set_state_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(y_root, gxm_y_root_w, set_y_root, gxm_set_y_root_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(x_root, gxm_x_root_w, set_x_root, gxm_set_x_root_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(root, gxm_root_w, set_root, gxm_set_root_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(time, gxm_time_w, set_time, gxm_set_time_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(subwindow, gxm_subwindow_w, set_subwindow, gxm_set_subwindow_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(window, gxm_window_w, set_window, gxm_set_window_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(send_event, gxm_send_event_w, set_send_event, gxm_set_send_event_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(serial, gxm_serial_w, set_serial, gxm_set_serial_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(type, gxm_type_w, set_type, gxm_set_type_w, 1, 0, 2, 0);
- XM_DEFINE_ACCESSOR(colormap, gxm_colormap_w, set_colormap, gxm_set_colormap_w, 1, 0, 2, 0);
-}
-
-
-#if HAVE_MOTIF
/* -------------------------------- string constants -------------------------------- */
/* can't get hcreate in glibc to work so... */
@@ -25239,9 +23155,9 @@ static xm_resource_t resource_type(const char *name)
/* unfortunately, we have names like 100DPIString in the newer Motif widgets... */
if ((ind < 0) || (ind >= LINKS_SIZE))
{
- XEN_ERROR(XEN_ERROR_TYPE("no-such-resource"),
- XEN_LIST_2(C_TO_XEN_STRING("no such resource: ~A"),
- C_TO_XEN_STRING(name)));
+ Xen_error(Xen_make_error_type("no-such-resource"),
+ Xen_list_2(C_string_to_Xen_string("no such resource: ~A"),
+ C_string_to_Xen_string(name)));
return(XM_NOT_A_RESOURCE);
}
start = hd_links[ind];
@@ -25256,2534 +23172,2228 @@ static xm_resource_t resource_type(const char *name)
static void define_strings(void)
{
-#if HAVE_SCHEME
- #define DEFINE_STRING(Name) s7_define_constant(s7, XM_PREFIX #Name XM_POSTFIX, s7_make_permanent_string(Name))
- #define DEFINE_RESOURCE(Name, Type) \
- s7_define_constant(s7, XM_PREFIX #Name XM_POSTFIX, s7_make_permanent_string(Name)); \
- hash_resource(Name, Type)
-#else
- #define DEFINE_STRING(Name) XEN_DEFINE(XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_STRING(Name))
- #define DEFINE_RESOURCE(Name, Type) \
- XEN_DEFINE(XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_STRING(Name)); \
+ #define define_string(Name) Xen_define(XM_PREFIX #Name XM_POSTFIX, C_string_to_Xen_string(Name))
+ #define define_resource(Name, Type) \
+ Xen_define(XM_PREFIX #Name XM_POSTFIX, C_string_to_Xen_string(Name)); \
hash_resource(Name, Type)
-#endif
xm_hash = (hdata **)calloc(XM_HASH_SIZE, sizeof(hdata *));
- DEFINE_STRING(XmSTRING_DEFAULT_CHARSET);
- DEFINE_STRING(XmFONTLIST_DEFAULT_TAG);
- DEFINE_STRING(XmFONTLIST_DEFAULT_TAG_STRING);
+ define_string(XmSTRING_DEFAULT_CHARSET);
+ define_string(XmFONTLIST_DEFAULT_TAG);
+ define_string(XmFONTLIST_DEFAULT_TAG_STRING);
/* these define special XmVaCreateSimple... arg possibilities */
- DEFINE_STRING(XmVaCASCADEBUTTON);
- DEFINE_STRING(XmVaCHECKBUTTON);
- DEFINE_STRING(XmVaDOUBLE_SEPARATOR);
- DEFINE_STRING(XmVaPUSHBUTTON);
- DEFINE_STRING(XmVaRADIOBUTTON);
- DEFINE_STRING(XmVaSEPARATOR);
- DEFINE_STRING(XmVaSINGLE_SEPARATOR);
- DEFINE_STRING(XmVaTOGGLEBUTTON);
- DEFINE_STRING(XmVaTITLE);
+ define_string(XmVaCASCADEBUTTON);
+ define_string(XmVaCHECKBUTTON);
+ define_string(XmVaDOUBLE_SEPARATOR);
+ define_string(XmVaPUSHBUTTON);
+ define_string(XmVaRADIOBUTTON);
+ define_string(XmVaSEPARATOR);
+ define_string(XmVaSINGLE_SEPARATOR);
+ define_string(XmVaTOGGLEBUTTON);
+ define_string(XmVaTITLE);
#if 0
- DEFINE_STRING(XtVaNestedList);
- DEFINE_STRING(XtVaTypedArg);
+ define_string(XtVaNestedList);
+ define_string(XtVaTypedArg);
#endif
/* XM_CALLBACK is used where the resource type is XtCallbackList */
- DEFINE_RESOURCE(XmNaccelerator, XM_STRING);
- DEFINE_RESOURCE(XmNacceleratorText, XM_XMSTRING);
- DEFINE_RESOURCE(XmNaccelerators, XM_ULONG);
- DEFINE_RESOURCE(XmNactivateCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNadjustLast, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNadjustMargin, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNalignment, XM_UCHAR);
- DEFINE_RESOURCE(XmNallowOverlap, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNallowResize, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNallowShellResize, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNancestorSensitive, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNanimationMask, XM_PIXMAP);
- DEFINE_RESOURCE(XmNanimationPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNanimationPixmapDepth, XM_INT);
- DEFINE_RESOURCE(XmNanimationStyle, XM_UCHAR);
- DEFINE_RESOURCE(XmNapplyCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNapplyLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNargc, XM_INT);
- DEFINE_RESOURCE(XmNargv, XM_STRING_LIST);
- DEFINE_RESOURCE(XmNarmCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNarmColor, XM_PIXEL);
- DEFINE_RESOURCE(XmNarmPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNarrowDirection, XM_UCHAR);
- DEFINE_RESOURCE(XmNattachment, XM_UCHAR);
- DEFINE_RESOURCE(XmNaudibleWarning, XM_UCHAR);
- DEFINE_RESOURCE(XmNautoShowCursorPosition, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNautoUnmanage, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNautomaticSelection, XM_UCHAR);
- DEFINE_RESOURCE(XmNbackground, XM_PIXEL);
- DEFINE_RESOURCE(XmNbackgroundPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNbaseHeight, XM_INT);
- DEFINE_RESOURCE(XmNbaseWidth, XM_INT);
- DEFINE_RESOURCE(XmNbitmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNblendModel, XM_ULONG);
- DEFINE_RESOURCE(XmNblinkRate, XM_INT);
- /* DEFINE_RESOURCE(XmNborder, XM_ULONG); */
- DEFINE_RESOURCE(XmNborderColor, XM_PIXEL);
- DEFINE_RESOURCE(XmNborderPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNborderWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNbottomAttachment, XM_UCHAR);
- DEFINE_RESOURCE(XmNbottomOffset, XM_INT);
- DEFINE_RESOURCE(XmNbottomPosition, XM_INT);
- DEFINE_RESOURCE(XmNbottomShadowColor, XM_PIXEL);
- DEFINE_RESOURCE(XmNbottomShadowPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNbottomWidget, XM_WIDGET);
- DEFINE_RESOURCE(XmNbrowseSelectionCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNbuttonAcceleratorText, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNbuttonAccelerators, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNbuttonCount, XM_INT);
- DEFINE_RESOURCE(XmNbuttonMnemonicCharSets, XM_CHARSET_TABLE);
- DEFINE_RESOURCE(XmNbuttonMnemonics, XM_KEYSYM_TABLE);
- DEFINE_RESOURCE(XmNbuttonSet, XM_INT);
- DEFINE_RESOURCE(XmNbuttonType, XM_ULONG);
- DEFINE_RESOURCE(XmNbuttons, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNcancelButton, XM_WIDGET);
- DEFINE_RESOURCE(XmNcancelCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNcancelLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNcascadePixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNcascadingCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNchildHorizontalAlignment, XM_UCHAR);
- DEFINE_RESOURCE(XmNchildHorizontalSpacing, XM_DIMENSION);
- DEFINE_RESOURCE(XmNchildPlacement, XM_UCHAR);
- DEFINE_RESOURCE(XmNchildVerticalAlignment, XM_UCHAR);
- DEFINE_RESOURCE(XmNchildren, XM_WIDGET_LIST);
- DEFINE_RESOURCE(XmNclientData, XM_XTPOINTER);
- DEFINE_RESOURCE(XmNclipWindow, XM_WIDGET);
- DEFINE_RESOURCE(XmNcolormap, XM_COLORMAP);
- DEFINE_RESOURCE(XmNcolumns, XM_SHORT);
- DEFINE_RESOURCE(XmNcommand, XM_XMSTRING);
- DEFINE_RESOURCE(XmNcommandChangedCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNcommandEnteredCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNcommandWindow, XM_WIDGET);
- DEFINE_RESOURCE(XmNcommandWindowLocation, XM_UCHAR);
- DEFINE_RESOURCE(XmNconvertProc, XM_CONVERT_CALLBACK);
- DEFINE_RESOURCE(XmNcreatePopupChildProc, XM_POPUP_CALLBACK);
- DEFINE_RESOURCE(XmNcursorBackground, XM_PIXEL);
- DEFINE_RESOURCE(XmNcursorForeground, XM_PIXEL);
- DEFINE_RESOURCE(XmNcursorPosition, XM_INT);
- DEFINE_RESOURCE(XmNcursorPositionVisible, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNdarkThreshold, XM_INT);
- DEFINE_RESOURCE(XmNdecimalPoints, XM_SHORT);
- DEFINE_RESOURCE(XmNdecrementCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdefaultActionCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdefaultButton, XM_WIDGET);
- DEFINE_RESOURCE(XmNdefaultButtonShadowThickness, XM_DIMENSION);
- DEFINE_RESOURCE(XmNdefaultButtonType, XM_UCHAR);
- DEFINE_RESOURCE(XmNdefaultCopyCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNdefaultInvalidCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNdefaultLinkCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNdefaultMoveCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNdefaultNoneCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNdefaultPosition, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNdefaultSourceCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNdefaultValidCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNdeleteResponse, XM_UCHAR);
- DEFINE_RESOURCE(XmNdepth, XM_INT);
- DEFINE_RESOURCE(XmNdestroyCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdialogStyle, XM_UCHAR);
- DEFINE_RESOURCE(XmNdialogTitle, XM_XMSTRING);
- DEFINE_RESOURCE(XmNdialogType, XM_UCHAR);
- DEFINE_RESOURCE(XmNdirListItemCount, XM_INT);
- DEFINE_RESOURCE(XmNdirListItems, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNdirListLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNdirMask, XM_XMSTRING);
- DEFINE_RESOURCE(XmNdirSearchProc, XM_SEARCH_CALLBACK);
- DEFINE_RESOURCE(XmNdirSpec, XM_XMSTRING);
- DEFINE_RESOURCE(XmNdirectory, XM_XMSTRING);
- DEFINE_RESOURCE(XmNdirectoryValid, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNdisarmCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdoubleClickInterval, XM_INT);
- DEFINE_RESOURCE(XmNdragCallback, XM_CALLBACK); /* scale slider etc */
- DEFINE_RESOURCE(XmNdragDropFinishCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdragInitiatorProtocolStyle, XM_UCHAR);
- DEFINE_RESOURCE(XmNdragMotionCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdragOperations, XM_UCHAR);
- DEFINE_RESOURCE(XmNdragProc, XM_DRAG_CALLBACK); /* drag and drop, not scale drag */
- DEFINE_RESOURCE(XmNdragReceiverProtocolStyle, XM_UCHAR);
- DEFINE_RESOURCE(XmNdropFinishCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdropProc, XM_DROP_CALLBACK);
- DEFINE_RESOURCE(XmNdropRectangles, XM_RECTANGLE_LIST);
- DEFINE_RESOURCE(XmNdropSiteActivity, XM_UCHAR);
- DEFINE_RESOURCE(XmNdropSiteEnterCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdropSiteLeaveCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdropSiteOperations, XM_UCHAR);
- DEFINE_RESOURCE(XmNdropSiteType, XM_UCHAR);
- DEFINE_RESOURCE(XmNdropStartCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdropTransfers, XM_TRANSFER_ENTRY_LIST);
- DEFINE_RESOURCE(XmNeditMode, XM_INT);
- DEFINE_RESOURCE(XmNeditable, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNentryAlignment, XM_UCHAR);
- DEFINE_RESOURCE(XmNentryBorder, XM_DIMENSION);
- DEFINE_RESOURCE(XmNentryCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNentryClass, XM_WIDGET_CLASS);
- DEFINE_RESOURCE(XmNentryVerticalAlignment, XM_UCHAR);
- DEFINE_RESOURCE(XmNexportTargets, XM_ATOM_LIST);
- DEFINE_RESOURCE(XmNexposeCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNextendedSelectionCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNfileListItemCount, XM_INT);
- DEFINE_RESOURCE(XmNfileListItems, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNfileListLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNfileSearchProc, XM_SEARCH_CALLBACK);
- DEFINE_RESOURCE(XmNfileTypeMask, XM_UCHAR);
- DEFINE_RESOURCE(XmNfillOnArm, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNfillOnSelect, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNfilterLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNfocusCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNfont, XM_XFONTSTRUCT);
- DEFINE_RESOURCE(XmNforeground, XM_PIXEL);
- DEFINE_RESOURCE(XmNforegroundThreshold, XM_INT);
- DEFINE_RESOURCE(XmNfractionBase, XM_INT);
- DEFINE_RESOURCE(XmNgainPrimaryCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNgeometry, XM_STRING);
- DEFINE_RESOURCE(XmNheight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNheightInc, XM_INT);
- DEFINE_RESOURCE(XmNhelpCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNhelpLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNhighlightColor, XM_PIXEL);
- DEFINE_RESOURCE(XmNhighlightOnEnter, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNhighlightPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNhighlightThickness, XM_DIMENSION);
- DEFINE_RESOURCE(XmNhistoryItemCount, XM_INT);
- DEFINE_RESOURCE(XmNhistoryItems, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNhistoryMaxItems, XM_INT);
- DEFINE_RESOURCE(XmNhistoryVisibleItemCount, XM_INT);
- DEFINE_RESOURCE(XmNhorizontalFontUnit, XM_INT);
- DEFINE_RESOURCE(XmNhorizontalScrollBar, XM_WIDGET);
- DEFINE_RESOURCE(XmNhorizontalSpacing, XM_DIMENSION);
- DEFINE_RESOURCE(XmNhotX, XM_POSITION);
- DEFINE_RESOURCE(XmNhotY, XM_POSITION);
- DEFINE_RESOURCE(XmNiconMask, XM_PIXMAP);
- DEFINE_RESOURCE(XmNiconName, XM_STRING);
- DEFINE_RESOURCE(XmNiconNameEncoding, XM_ATOM);
- DEFINE_RESOURCE(XmNiconPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNiconWindow, XM_WIDGET);
- DEFINE_RESOURCE(XmNiconX, XM_INT);
- DEFINE_RESOURCE(XmNiconY, XM_INT);
- DEFINE_RESOURCE(XmNiconic, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNimportTargets, XM_ATOM_LIST);
- DEFINE_RESOURCE(XmNincrement, XM_INT);
- DEFINE_RESOURCE(XmNincrementCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNincremental, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNindicatorOn, XM_INT);
- DEFINE_RESOURCE(XmNindicatorSize, XM_DIMENSION);
- DEFINE_RESOURCE(XmNindicatorType, XM_UCHAR);
- DEFINE_RESOURCE(XmNinitialDelay, XM_INT);
- DEFINE_RESOURCE(XmNinitialFocus, XM_WIDGET);
- DEFINE_RESOURCE(XmNinitialResourcesPersistent, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNinitialState, XM_INT);
- DEFINE_RESOURCE(XmNinput, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNinputCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNinputMethod, XM_STRING);
- DEFINE_RESOURCE(XmNinsertPosition, XM_ORDER_CALLBACK);
- DEFINE_RESOURCE(XmNinvalidCursorForeground, XM_PIXEL);
- DEFINE_RESOURCE(XmNisAligned, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNisHomogeneous, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNitemCount, XM_INT);
- DEFINE_RESOURCE(XmNitems, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNkeyboardFocusPolicy, XM_UCHAR);
- DEFINE_RESOURCE(XmNlabelInsensitivePixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNlabelPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNlabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNlabelType, XM_UCHAR);
- DEFINE_RESOURCE(XmNleftAttachment, XM_UCHAR);
- DEFINE_RESOURCE(XmNleftOffset, XM_INT);
- DEFINE_RESOURCE(XmNleftPosition, XM_INT);
- DEFINE_RESOURCE(XmNleftWidget, XM_WIDGET);
- DEFINE_RESOURCE(XmNlightThreshold, XM_INT);
- DEFINE_RESOURCE(XmNlistItemCount, XM_INT);
- DEFINE_RESOURCE(XmNlistItems, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNlistLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNlistMarginHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNlistMarginWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNlistSizePolicy, XM_UCHAR);
- DEFINE_RESOURCE(XmNlistSpacing, XM_DIMENSION);
- DEFINE_RESOURCE(XmNlistUpdated, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNlistVisibleItemCount, XM_INT);
- DEFINE_RESOURCE(XmNlosePrimaryCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNlosingFocusCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNmainWindowMarginHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmainWindowMarginWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmapCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNmappedWhenManaged, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNmappingDelay, XM_INT);
- DEFINE_RESOURCE(XmNmargin, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmarginBottom, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmarginHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmarginLeft, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmarginRight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmarginTop, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmarginWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmask, XM_PIXMAP);
- DEFINE_RESOURCE(XmNmaxAspectX, XM_INT);
- DEFINE_RESOURCE(XmNmaxAspectY, XM_INT);
- DEFINE_RESOURCE(XmNmaxHeight, XM_INT);
- DEFINE_RESOURCE(XmNmaxLength, XM_INT);
- DEFINE_RESOURCE(XmNmaxWidth, XM_INT);
- DEFINE_RESOURCE(XmNmaximum, XM_INT);
- DEFINE_RESOURCE(XmNmenuAccelerator, XM_STRING);
- DEFINE_RESOURCE(XmNmenuBar, XM_WIDGET);
- DEFINE_RESOURCE(XmNmenuCursor, XM_STRING);
- DEFINE_RESOURCE(XmNmenuHelpWidget, XM_WIDGET);
- DEFINE_RESOURCE(XmNmenuHistory, XM_WIDGET);
- DEFINE_RESOURCE(XmNmenuPost, XM_STRING);
- DEFINE_RESOURCE(XmNmessageAlignment, XM_UCHAR);
- DEFINE_RESOURCE(XmNmessageString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNmessageWindow, XM_WIDGET);
- DEFINE_RESOURCE(XmNminAspectX, XM_INT);
- DEFINE_RESOURCE(XmNminAspectY, XM_INT);
- DEFINE_RESOURCE(XmNminHeight, XM_INT);
- DEFINE_RESOURCE(XmNminWidth, XM_INT);
- DEFINE_RESOURCE(XmNminimizeButtons, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNminimum, XM_INT);
- DEFINE_RESOURCE(XmNmnemonic, XM_KEYSYM);
- DEFINE_RESOURCE(XmNmnemonicCharSet, XM_STRING);
- DEFINE_RESOURCE(XmNmodifyVerifyCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNmotionVerifyCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNmoveOpaque, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNmultiClick, XM_UCHAR);
- DEFINE_RESOURCE(XmNmultipleSelectionCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNmustMatch, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNmwmDecorations, XM_INT);
- DEFINE_RESOURCE(XmNmwmFunctions, XM_INT);
- DEFINE_RESOURCE(XmNmwmInputMode, XM_INT);
- DEFINE_RESOURCE(XmNmwmMenu, XM_STRING);
- DEFINE_RESOURCE(XmNnavigationType, XM_UCHAR);
- DEFINE_RESOURCE(XmNnoMatchCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNnoMatchString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNnoResize, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNnoneCursorForeground, XM_PIXEL);
- DEFINE_RESOURCE(XmNnumChildren, XM_INT);
- DEFINE_RESOURCE(XmNnumColumns, XM_SHORT);
- DEFINE_RESOURCE(XmNnumDropRectangles, XM_INT);
- DEFINE_RESOURCE(XmNnumDropTransfers, XM_INT);
- DEFINE_RESOURCE(XmNnumExportTargets, XM_INT);
- DEFINE_RESOURCE(XmNnumImportTargets, XM_INT);
- DEFINE_RESOURCE(XmNoffsetX, XM_POSITION);
- DEFINE_RESOURCE(XmNoffsetY, XM_POSITION);
- DEFINE_RESOURCE(XmNokCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNokLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNoperationChangedCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNoperationCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNoptionLabel, XM_XMSTRING);
- DEFINE_RESOURCE(XmNoptionMnemonic, XM_KEYSYM);
- DEFINE_RESOURCE(XmNorientation, XM_UCHAR);
- DEFINE_RESOURCE(XmNoverrideRedirect, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNpacking, XM_UCHAR);
- DEFINE_RESOURCE(XmNpageDecrementCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNpageIncrement, XM_INT);
- DEFINE_RESOURCE(XmNpageIncrementCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNpaneMaximum, XM_DIMENSION);
- DEFINE_RESOURCE(XmNpaneMinimum, XM_DIMENSION);
- DEFINE_RESOURCE(XmNpattern, XM_STRING_OR_XMSTRING);
- DEFINE_RESOURCE(XmNpendingDelete, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNpixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNpopdownCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNpopupCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNpopupEnabled, XM_INT); /* docs say boolean, but that is incorrect -- see rowcolumn docs */
- DEFINE_RESOURCE(XmNpositionIndex, XM_SHORT);
- DEFINE_RESOURCE(XmNpostFromButton, XM_INT);
- DEFINE_RESOURCE(XmNpreeditType, XM_STRING);
- DEFINE_RESOURCE(XmNprocessingDirection, XM_UCHAR);
- DEFINE_RESOURCE(XmNpromptString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNpushButtonEnabled, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNqualifySearchDataProc, XM_QUALIFY_CALLBACK);
- DEFINE_RESOURCE(XmNradioAlwaysOne, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNradioBehavior, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNrecomputeSize, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNrefigureMode, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNrepeatDelay, XM_INT);
- DEFINE_RESOURCE(XmNresizable, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNresizeCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNresizeHeight, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNresizePolicy, XM_UCHAR);
- DEFINE_RESOURCE(XmNresizeWidth, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNrightAttachment, XM_UCHAR);
- DEFINE_RESOURCE(XmNrightOffset, XM_INT);
- DEFINE_RESOURCE(XmNrightPosition, XM_INT);
- DEFINE_RESOURCE(XmNrightWidget, XM_WIDGET);
- DEFINE_RESOURCE(XmNrowColumnType, XM_UCHAR);
- DEFINE_RESOURCE(XmNrows, XM_SHORT);
- DEFINE_RESOURCE(XmNrubberPositioning, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNsashHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNsashIndent, XM_POSITION);
- DEFINE_RESOURCE(XmNsashShadowThickness, XM_DIMENSION);
- DEFINE_RESOURCE(XmNsashWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNsaveUnder, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNscaleHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNscaleMultiple, XM_INT);
- DEFINE_RESOURCE(XmNscaleWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNscreen, XM_SCREEN);
- DEFINE_RESOURCE(XmNscrollBarDisplayPolicy, XM_UCHAR);
- DEFINE_RESOURCE(XmNscrollBarPlacement, XM_UCHAR);
- DEFINE_RESOURCE(XmNscrollHorizontal, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNscrollLeftSide, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNscrollTopSide, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNscrollVertical, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNscrolledWindowMarginHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNscrolledWindowMarginWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNscrollingPolicy, XM_UCHAR);
- DEFINE_RESOURCE(XmNselectColor, XM_PIXEL);
- DEFINE_RESOURCE(XmNselectInsensitivePixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNselectPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNselectThreshold, XM_INT);
- DEFINE_RESOURCE(XmNselectedItemCount, XM_INT);
- DEFINE_RESOURCE(XmNselectedItems, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNselectionArray, XM_INT_TABLE);
- DEFINE_RESOURCE(XmNselectionArrayCount, XM_INT);
- DEFINE_RESOURCE(XmNselectionLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNselectionPolicy, XM_UCHAR);
- DEFINE_RESOURCE(XmNsensitive, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNseparatorOn, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNseparatorType, XM_UCHAR);
- DEFINE_RESOURCE(XmNset, XM_UCHAR);
- DEFINE_RESOURCE(XmNshadowThickness, XM_DIMENSION);
- DEFINE_RESOURCE(XmNshadowType, XM_UCHAR);
- DEFINE_RESOURCE(XmNshowArrows, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNshowAsDefault, XM_DIMENSION);
- DEFINE_RESOURCE(XmNshowSeparator, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNshowValue, XM_BOOLEAN_OR_INT); /* should be int, but that's incompatible with tons of existing code */
- DEFINE_RESOURCE(XmNsimpleCallback, XM_CALLBACK);
+ define_resource(XmNaccelerator, XM_STRING);
+ define_resource(XmNacceleratorText, XM_XMSTRING);
+ define_resource(XmNaccelerators, XM_ULONG);
+ define_resource(XmNactivateCallback, XM_CALLBACK);
+ define_resource(XmNadjustLast, XM_BOOLEAN);
+ define_resource(XmNadjustMargin, XM_BOOLEAN);
+ define_resource(XmNalignment, XM_UCHAR);
+ define_resource(XmNallowOverlap, XM_BOOLEAN);
+ define_resource(XmNallowResize, XM_BOOLEAN);
+ define_resource(XmNallowShellResize, XM_BOOLEAN);
+ define_resource(XmNancestorSensitive, XM_BOOLEAN);
+ define_resource(XmNanimationMask, XM_PIXMAP);
+ define_resource(XmNanimationPixmap, XM_PIXMAP);
+ define_resource(XmNanimationPixmapDepth, XM_INT);
+ define_resource(XmNanimationStyle, XM_UCHAR);
+ define_resource(XmNapplyCallback, XM_CALLBACK);
+ define_resource(XmNapplyLabelString, XM_XMSTRING);
+ define_resource(XmNargc, XM_INT);
+ define_resource(XmNargv, XM_STRING_LIST);
+ define_resource(XmNarmCallback, XM_CALLBACK);
+ define_resource(XmNarmColor, XM_PIXEL);
+ define_resource(XmNarmPixmap, XM_PIXMAP);
+ define_resource(XmNarrowDirection, XM_UCHAR);
+ define_resource(XmNattachment, XM_UCHAR);
+ define_resource(XmNaudibleWarning, XM_UCHAR);
+ define_resource(XmNautoShowCursorPosition, XM_BOOLEAN);
+ define_resource(XmNautoUnmanage, XM_BOOLEAN);
+ define_resource(XmNautomaticSelection, XM_UCHAR);
+ define_resource(XmNbackground, XM_PIXEL);
+ define_resource(XmNbackgroundPixmap, XM_PIXMAP);
+ define_resource(XmNbaseHeight, XM_INT);
+ define_resource(XmNbaseWidth, XM_INT);
+ define_resource(XmNbitmap, XM_PIXMAP);
+ define_resource(XmNblendModel, XM_ULONG);
+ define_resource(XmNblinkRate, XM_INT);
+ /* define_resource(XmNborder, XM_ULONG); */
+ define_resource(XmNborderColor, XM_PIXEL);
+ define_resource(XmNborderPixmap, XM_PIXMAP);
+ define_resource(XmNborderWidth, XM_DIMENSION);
+ define_resource(XmNbottomAttachment, XM_UCHAR);
+ define_resource(XmNbottomOffset, XM_INT);
+ define_resource(XmNbottomPosition, XM_INT);
+ define_resource(XmNbottomShadowColor, XM_PIXEL);
+ define_resource(XmNbottomShadowPixmap, XM_PIXMAP);
+ define_resource(XmNbottomWidget, XM_WIDGET);
+ define_resource(XmNbrowseSelectionCallback, XM_CALLBACK);
+ define_resource(XmNbuttonAcceleratorText, XM_STRING_TABLE);
+ define_resource(XmNbuttonAccelerators, XM_STRING_TABLE);
+ define_resource(XmNbuttonCount, XM_INT);
+ define_resource(XmNbuttonMnemonicCharSets, XM_CHARSET_TABLE);
+ define_resource(XmNbuttonMnemonics, XM_KEYSYM_TABLE);
+ define_resource(XmNbuttonSet, XM_INT);
+ define_resource(XmNbuttonType, XM_ULONG);
+ define_resource(XmNbuttons, XM_STRING_TABLE);
+ define_resource(XmNcancelButton, XM_WIDGET);
+ define_resource(XmNcancelCallback, XM_CALLBACK);
+ define_resource(XmNcancelLabelString, XM_XMSTRING);
+ define_resource(XmNcascadePixmap, XM_PIXMAP);
+ define_resource(XmNcascadingCallback, XM_CALLBACK);
+ define_resource(XmNchildHorizontalAlignment, XM_UCHAR);
+ define_resource(XmNchildHorizontalSpacing, XM_DIMENSION);
+ define_resource(XmNchildPlacement, XM_UCHAR);
+ define_resource(XmNchildVerticalAlignment, XM_UCHAR);
+ define_resource(XmNchildren, XM_WIDGET_LIST);
+ define_resource(XmNclientData, XM_XTPOINTER);
+ define_resource(XmNclipWindow, XM_WIDGET);
+ define_resource(XmNcolormap, XM_COLORMAP);
+ define_resource(XmNcolumns, XM_SHORT);
+ define_resource(XmNcommand, XM_XMSTRING);
+ define_resource(XmNcommandChangedCallback, XM_CALLBACK);
+ define_resource(XmNcommandEnteredCallback, XM_CALLBACK);
+ define_resource(XmNcommandWindow, XM_WIDGET);
+ define_resource(XmNcommandWindowLocation, XM_UCHAR);
+ define_resource(XmNconvertProc, XM_CONVERT_CALLBACK);
+ define_resource(XmNcreatePopupChildProc, XM_POPUP_CALLBACK);
+ define_resource(XmNcursorBackground, XM_PIXEL);
+ define_resource(XmNcursorForeground, XM_PIXEL);
+ define_resource(XmNcursorPosition, XM_INT);
+ define_resource(XmNcursorPositionVisible, XM_BOOLEAN);
+ define_resource(XmNdarkThreshold, XM_INT);
+ define_resource(XmNdecimalPoints, XM_SHORT);
+ define_resource(XmNdecrementCallback, XM_CALLBACK);
+ define_resource(XmNdefaultActionCallback, XM_CALLBACK);
+ define_resource(XmNdefaultButton, XM_WIDGET);
+ define_resource(XmNdefaultButtonShadowThickness, XM_DIMENSION);
+ define_resource(XmNdefaultButtonType, XM_UCHAR);
+ define_resource(XmNdefaultCopyCursorIcon, XM_WIDGET);
+ define_resource(XmNdefaultInvalidCursorIcon, XM_WIDGET);
+ define_resource(XmNdefaultLinkCursorIcon, XM_WIDGET);
+ define_resource(XmNdefaultMoveCursorIcon, XM_WIDGET);
+ define_resource(XmNdefaultNoneCursorIcon, XM_WIDGET);
+ define_resource(XmNdefaultPosition, XM_BOOLEAN);
+ define_resource(XmNdefaultSourceCursorIcon, XM_WIDGET);
+ define_resource(XmNdefaultValidCursorIcon, XM_WIDGET);
+ define_resource(XmNdeleteResponse, XM_UCHAR);
+ define_resource(XmNdepth, XM_INT);
+ define_resource(XmNdestroyCallback, XM_CALLBACK);
+ define_resource(XmNdialogStyle, XM_UCHAR);
+ define_resource(XmNdialogTitle, XM_XMSTRING);
+ define_resource(XmNdialogType, XM_UCHAR);
+ define_resource(XmNdirListItemCount, XM_INT);
+ define_resource(XmNdirListItems, XM_STRING_TABLE);
+ define_resource(XmNdirListLabelString, XM_XMSTRING);
+ define_resource(XmNdirMask, XM_XMSTRING);
+ define_resource(XmNdirSearchProc, XM_SEARCH_CALLBACK);
+ define_resource(XmNdirSpec, XM_XMSTRING);
+ define_resource(XmNdirectory, XM_XMSTRING);
+ define_resource(XmNdirectoryValid, XM_BOOLEAN);
+ define_resource(XmNdisarmCallback, XM_CALLBACK);
+ define_resource(XmNdoubleClickInterval, XM_INT);
+ define_resource(XmNdragCallback, XM_CALLBACK); /* scale slider etc */
+ define_resource(XmNdragDropFinishCallback, XM_CALLBACK);
+ define_resource(XmNdragInitiatorProtocolStyle, XM_UCHAR);
+ define_resource(XmNdragMotionCallback, XM_CALLBACK);
+ define_resource(XmNdragOperations, XM_UCHAR);
+ define_resource(XmNdragProc, XM_DRAG_CALLBACK); /* drag and drop, not scale drag */
+ define_resource(XmNdragReceiverProtocolStyle, XM_UCHAR);
+ define_resource(XmNdropFinishCallback, XM_CALLBACK);
+ define_resource(XmNdropProc, XM_DROP_CALLBACK);
+ define_resource(XmNdropRectangles, XM_RECTANGLE_LIST);
+ define_resource(XmNdropSiteActivity, XM_UCHAR);
+ define_resource(XmNdropSiteEnterCallback, XM_CALLBACK);
+ define_resource(XmNdropSiteLeaveCallback, XM_CALLBACK);
+ define_resource(XmNdropSiteOperations, XM_UCHAR);
+ define_resource(XmNdropSiteType, XM_UCHAR);
+ define_resource(XmNdropStartCallback, XM_CALLBACK);
+ define_resource(XmNdropTransfers, XM_TRANSFER_ENTRY_LIST);
+ define_resource(XmNeditMode, XM_INT);
+ define_resource(XmNeditable, XM_BOOLEAN);
+ define_resource(XmNentryAlignment, XM_UCHAR);
+ define_resource(XmNentryBorder, XM_DIMENSION);
+ define_resource(XmNentryCallback, XM_CALLBACK);
+ define_resource(XmNentryClass, XM_WIDGET_CLASS);
+ define_resource(XmNentryVerticalAlignment, XM_UCHAR);
+ define_resource(XmNexportTargets, XM_ATOM_LIST);
+ define_resource(XmNexposeCallback, XM_CALLBACK);
+ define_resource(XmNextendedSelectionCallback, XM_CALLBACK);
+ define_resource(XmNfileListItemCount, XM_INT);
+ define_resource(XmNfileListItems, XM_STRING_TABLE);
+ define_resource(XmNfileListLabelString, XM_XMSTRING);
+ define_resource(XmNfileSearchProc, XM_SEARCH_CALLBACK);
+ define_resource(XmNfileTypeMask, XM_UCHAR);
+ define_resource(XmNfillOnArm, XM_BOOLEAN);
+ define_resource(XmNfillOnSelect, XM_BOOLEAN);
+ define_resource(XmNfilterLabelString, XM_XMSTRING);
+ define_resource(XmNfocusCallback, XM_CALLBACK);
+ define_resource(XmNfont, XM_XFONTSTRUCT);
+ define_resource(XmNforeground, XM_PIXEL);
+ define_resource(XmNforegroundThreshold, XM_INT);
+ define_resource(XmNfractionBase, XM_INT);
+ define_resource(XmNgainPrimaryCallback, XM_CALLBACK);
+ define_resource(XmNgeometry, XM_STRING);
+ define_resource(XmNheight, XM_DIMENSION);
+ define_resource(XmNheightInc, XM_INT);
+ define_resource(XmNhelpCallback, XM_CALLBACK);
+ define_resource(XmNhelpLabelString, XM_XMSTRING);
+ define_resource(XmNhighlightColor, XM_PIXEL);
+ define_resource(XmNhighlightOnEnter, XM_BOOLEAN);
+ define_resource(XmNhighlightPixmap, XM_PIXMAP);
+ define_resource(XmNhighlightThickness, XM_DIMENSION);
+ define_resource(XmNhistoryItemCount, XM_INT);
+ define_resource(XmNhistoryItems, XM_STRING_TABLE);
+ define_resource(XmNhistoryMaxItems, XM_INT);
+ define_resource(XmNhistoryVisibleItemCount, XM_INT);
+ define_resource(XmNhorizontalFontUnit, XM_INT);
+ define_resource(XmNhorizontalScrollBar, XM_WIDGET);
+ define_resource(XmNhorizontalSpacing, XM_DIMENSION);
+ define_resource(XmNhotX, XM_POSITION);
+ define_resource(XmNhotY, XM_POSITION);
+ define_resource(XmNiconMask, XM_PIXMAP);
+ define_resource(XmNiconName, XM_STRING);
+ define_resource(XmNiconNameEncoding, XM_ATOM);
+ define_resource(XmNiconPixmap, XM_PIXMAP);
+ define_resource(XmNiconWindow, XM_WIDGET);
+ define_resource(XmNiconX, XM_INT);
+ define_resource(XmNiconY, XM_INT);
+ define_resource(XmNiconic, XM_BOOLEAN);
+ define_resource(XmNimportTargets, XM_ATOM_LIST);
+ define_resource(XmNincrement, XM_INT);
+ define_resource(XmNincrementCallback, XM_CALLBACK);
+ define_resource(XmNincremental, XM_BOOLEAN);
+ define_resource(XmNindicatorOn, XM_INT);
+ define_resource(XmNindicatorSize, XM_DIMENSION);
+ define_resource(XmNindicatorType, XM_UCHAR);
+ define_resource(XmNinitialDelay, XM_INT);
+ define_resource(XmNinitialFocus, XM_WIDGET);
+ define_resource(XmNinitialResourcesPersistent, XM_BOOLEAN);
+ define_resource(XmNinitialState, XM_INT);
+ define_resource(XmNinput, XM_BOOLEAN);
+ define_resource(XmNinputCallback, XM_CALLBACK);
+ define_resource(XmNinputMethod, XM_STRING);
+ define_resource(XmNinsertPosition, XM_ORDER_CALLBACK);
+ define_resource(XmNinvalidCursorForeground, XM_PIXEL);
+ define_resource(XmNisAligned, XM_BOOLEAN);
+ define_resource(XmNisHomogeneous, XM_BOOLEAN);
+ define_resource(XmNitemCount, XM_INT);
+ define_resource(XmNitems, XM_STRING_TABLE);
+ define_resource(XmNkeyboardFocusPolicy, XM_UCHAR);
+ define_resource(XmNlabelInsensitivePixmap, XM_PIXMAP);
+ define_resource(XmNlabelPixmap, XM_PIXMAP);
+ define_resource(XmNlabelString, XM_XMSTRING);
+ define_resource(XmNlabelType, XM_UCHAR);
+ define_resource(XmNleftAttachment, XM_UCHAR);
+ define_resource(XmNleftOffset, XM_INT);
+ define_resource(XmNleftPosition, XM_INT);
+ define_resource(XmNleftWidget, XM_WIDGET);
+ define_resource(XmNlightThreshold, XM_INT);
+ define_resource(XmNlistItemCount, XM_INT);
+ define_resource(XmNlistItems, XM_STRING_TABLE);
+ define_resource(XmNlistLabelString, XM_XMSTRING);
+ define_resource(XmNlistMarginHeight, XM_DIMENSION);
+ define_resource(XmNlistMarginWidth, XM_DIMENSION);
+ define_resource(XmNlistSizePolicy, XM_UCHAR);
+ define_resource(XmNlistSpacing, XM_DIMENSION);
+ define_resource(XmNlistUpdated, XM_BOOLEAN);
+ define_resource(XmNlistVisibleItemCount, XM_INT);
+ define_resource(XmNlosePrimaryCallback, XM_CALLBACK);
+ define_resource(XmNlosingFocusCallback, XM_CALLBACK);
+ define_resource(XmNmainWindowMarginHeight, XM_DIMENSION);
+ define_resource(XmNmainWindowMarginWidth, XM_DIMENSION);
+ define_resource(XmNmapCallback, XM_CALLBACK);
+ define_resource(XmNmappedWhenManaged, XM_BOOLEAN);
+ define_resource(XmNmappingDelay, XM_INT);
+ define_resource(XmNmargin, XM_DIMENSION);
+ define_resource(XmNmarginBottom, XM_DIMENSION);
+ define_resource(XmNmarginHeight, XM_DIMENSION);
+ define_resource(XmNmarginLeft, XM_DIMENSION);
+ define_resource(XmNmarginRight, XM_DIMENSION);
+ define_resource(XmNmarginTop, XM_DIMENSION);
+ define_resource(XmNmarginWidth, XM_DIMENSION);
+ define_resource(XmNmask, XM_PIXMAP);
+ define_resource(XmNmaxAspectX, XM_INT);
+ define_resource(XmNmaxAspectY, XM_INT);
+ define_resource(XmNmaxHeight, XM_INT);
+ define_resource(XmNmaxLength, XM_INT);
+ define_resource(XmNmaxWidth, XM_INT);
+ define_resource(XmNmaximum, XM_INT);
+ define_resource(XmNmenuAccelerator, XM_STRING);
+ define_resource(XmNmenuBar, XM_WIDGET);
+ define_resource(XmNmenuCursor, XM_STRING);
+ define_resource(XmNmenuHelpWidget, XM_WIDGET);
+ define_resource(XmNmenuHistory, XM_WIDGET);
+ define_resource(XmNmenuPost, XM_STRING);
+ define_resource(XmNmessageAlignment, XM_UCHAR);
+ define_resource(XmNmessageString, XM_XMSTRING);
+ define_resource(XmNmessageWindow, XM_WIDGET);
+ define_resource(XmNminAspectX, XM_INT);
+ define_resource(XmNminAspectY, XM_INT);
+ define_resource(XmNminHeight, XM_INT);
+ define_resource(XmNminWidth, XM_INT);
+ define_resource(XmNminimizeButtons, XM_BOOLEAN);
+ define_resource(XmNminimum, XM_INT);
+ define_resource(XmNmnemonic, XM_KEYSYM);
+ define_resource(XmNmnemonicCharSet, XM_STRING);
+ define_resource(XmNmodifyVerifyCallback, XM_CALLBACK);
+ define_resource(XmNmotionVerifyCallback, XM_CALLBACK);
+ define_resource(XmNmoveOpaque, XM_BOOLEAN);
+ define_resource(XmNmultiClick, XM_UCHAR);
+ define_resource(XmNmultipleSelectionCallback, XM_CALLBACK);
+ define_resource(XmNmustMatch, XM_BOOLEAN);
+ define_resource(XmNmwmDecorations, XM_INT);
+ define_resource(XmNmwmFunctions, XM_INT);
+ define_resource(XmNmwmInputMode, XM_INT);
+ define_resource(XmNmwmMenu, XM_STRING);
+ define_resource(XmNnavigationType, XM_UCHAR);
+ define_resource(XmNnoMatchCallback, XM_CALLBACK);
+ define_resource(XmNnoMatchString, XM_XMSTRING);
+ define_resource(XmNnoResize, XM_BOOLEAN);
+ define_resource(XmNnoneCursorForeground, XM_PIXEL);
+ define_resource(XmNnumChildren, XM_INT);
+ define_resource(XmNnumColumns, XM_SHORT);
+ define_resource(XmNnumDropRectangles, XM_INT);
+ define_resource(XmNnumDropTransfers, XM_INT);
+ define_resource(XmNnumExportTargets, XM_INT);
+ define_resource(XmNnumImportTargets, XM_INT);
+ define_resource(XmNoffsetX, XM_POSITION);
+ define_resource(XmNoffsetY, XM_POSITION);
+ define_resource(XmNokCallback, XM_CALLBACK);
+ define_resource(XmNokLabelString, XM_XMSTRING);
+ define_resource(XmNoperationChangedCallback, XM_CALLBACK);
+ define_resource(XmNoperationCursorIcon, XM_WIDGET);
+ define_resource(XmNoptionLabel, XM_XMSTRING);
+ define_resource(XmNoptionMnemonic, XM_KEYSYM);
+ define_resource(XmNorientation, XM_UCHAR);
+ define_resource(XmNoverrideRedirect, XM_BOOLEAN);
+ define_resource(XmNpacking, XM_UCHAR);
+ define_resource(XmNpageDecrementCallback, XM_CALLBACK);
+ define_resource(XmNpageIncrement, XM_INT);
+ define_resource(XmNpageIncrementCallback, XM_CALLBACK);
+ define_resource(XmNpaneMaximum, XM_DIMENSION);
+ define_resource(XmNpaneMinimum, XM_DIMENSION);
+ define_resource(XmNpattern, XM_STRING_OR_XMSTRING);
+ define_resource(XmNpendingDelete, XM_BOOLEAN);
+ define_resource(XmNpixmap, XM_PIXMAP);
+ define_resource(XmNpopdownCallback, XM_CALLBACK);
+ define_resource(XmNpopupCallback, XM_CALLBACK);
+ define_resource(XmNpopupEnabled, XM_INT); /* docs say boolean, but that is incorrect -- see rowcolumn docs */
+ define_resource(XmNpositionIndex, XM_SHORT);
+ define_resource(XmNpostFromButton, XM_INT);
+ define_resource(XmNpreeditType, XM_STRING);
+ define_resource(XmNprocessingDirection, XM_UCHAR);
+ define_resource(XmNpromptString, XM_XMSTRING);
+ define_resource(XmNpushButtonEnabled, XM_BOOLEAN);
+ define_resource(XmNqualifySearchDataProc, XM_QUALIFY_CALLBACK);
+ define_resource(XmNradioAlwaysOne, XM_BOOLEAN);
+ define_resource(XmNradioBehavior, XM_BOOLEAN);
+ define_resource(XmNrecomputeSize, XM_BOOLEAN);
+ define_resource(XmNrefigureMode, XM_BOOLEAN);
+ define_resource(XmNrepeatDelay, XM_INT);
+ define_resource(XmNresizable, XM_BOOLEAN);
+ define_resource(XmNresizeCallback, XM_CALLBACK);
+ define_resource(XmNresizeHeight, XM_BOOLEAN);
+ define_resource(XmNresizePolicy, XM_UCHAR);
+ define_resource(XmNresizeWidth, XM_BOOLEAN);
+ define_resource(XmNrightAttachment, XM_UCHAR);
+ define_resource(XmNrightOffset, XM_INT);
+ define_resource(XmNrightPosition, XM_INT);
+ define_resource(XmNrightWidget, XM_WIDGET);
+ define_resource(XmNrowColumnType, XM_UCHAR);
+ define_resource(XmNrows, XM_SHORT);
+ define_resource(XmNrubberPositioning, XM_BOOLEAN);
+ define_resource(XmNsashHeight, XM_DIMENSION);
+ define_resource(XmNsashIndent, XM_POSITION);
+ define_resource(XmNsashShadowThickness, XM_DIMENSION);
+ define_resource(XmNsashWidth, XM_DIMENSION);
+ define_resource(XmNsaveUnder, XM_BOOLEAN);
+ define_resource(XmNscaleHeight, XM_DIMENSION);
+ define_resource(XmNscaleMultiple, XM_INT);
+ define_resource(XmNscaleWidth, XM_DIMENSION);
+ define_resource(XmNscreen, XM_SCREEN);
+ define_resource(XmNscrollBarDisplayPolicy, XM_UCHAR);
+ define_resource(XmNscrollBarPlacement, XM_UCHAR);
+ define_resource(XmNscrollHorizontal, XM_BOOLEAN);
+ define_resource(XmNscrollLeftSide, XM_BOOLEAN);
+ define_resource(XmNscrollTopSide, XM_BOOLEAN);
+ define_resource(XmNscrollVertical, XM_BOOLEAN);
+ define_resource(XmNscrolledWindowMarginHeight, XM_DIMENSION);
+ define_resource(XmNscrolledWindowMarginWidth, XM_DIMENSION);
+ define_resource(XmNscrollingPolicy, XM_UCHAR);
+ define_resource(XmNselectColor, XM_PIXEL);
+ define_resource(XmNselectInsensitivePixmap, XM_PIXMAP);
+ define_resource(XmNselectPixmap, XM_PIXMAP);
+ define_resource(XmNselectThreshold, XM_INT);
+ define_resource(XmNselectedItemCount, XM_INT);
+ define_resource(XmNselectedItems, XM_STRING_TABLE);
+ define_resource(XmNselectionArray, XM_INT_TABLE);
+ define_resource(XmNselectionArrayCount, XM_INT);
+ define_resource(XmNselectionLabelString, XM_XMSTRING);
+ define_resource(XmNselectionPolicy, XM_UCHAR);
+ define_resource(XmNsensitive, XM_BOOLEAN);
+ define_resource(XmNseparatorOn, XM_BOOLEAN);
+ define_resource(XmNseparatorType, XM_UCHAR);
+ define_resource(XmNset, XM_UCHAR);
+ define_resource(XmNshadowThickness, XM_DIMENSION);
+ define_resource(XmNshadowType, XM_UCHAR);
+ define_resource(XmNshowArrows, XM_BOOLEAN);
+ define_resource(XmNshowAsDefault, XM_DIMENSION);
+ define_resource(XmNshowSeparator, XM_BOOLEAN);
+ define_resource(XmNshowValue, XM_BOOLEAN_OR_INT); /* should be int, but that's incompatible with tons of existing code */
+ define_resource(XmNsimpleCallback, XM_CALLBACK);
/* doc p905 calls this an XtCallbackProc (not list), but next pages says it's a list, Motif sources appear to treat it as a proc */
- DEFINE_RESOURCE(XmNsingleSelectionCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNskipAdjust, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNsliderSize, XM_INT);
- DEFINE_RESOURCE(XmNsliderVisual, XM_INT);
- DEFINE_RESOURCE(XmNslidingMode, XM_INT);
- DEFINE_RESOURCE(XmNsource, XM_TEXT_SOURCE);
- DEFINE_RESOURCE(XmNsourceCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNsourcePixmapIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNspacing, XM_DIMENSION);
- DEFINE_RESOURCE(XmNspotLocation, XM_INT);
- DEFINE_RESOURCE(XmNstateCursorIcon, XM_WIDGET);
- DEFINE_RESOURCE(XmNsubMenuId, XM_WIDGET);
- DEFINE_RESOURCE(XmNsymbolPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNtearOffMenuActivateCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtearOffMenuDeactivateCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtearOffModel, XM_UCHAR);
- DEFINE_RESOURCE(XmNtextAccelerators, XM_ULONG);
- DEFINE_RESOURCE(XmNtextColumns, XM_SHORT);
- DEFINE_RESOURCE(XmNtextString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNtextTranslations, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtitle, XM_STRING);
- DEFINE_RESOURCE(XmNtitleEncoding, XM_ATOM);
- DEFINE_RESOURCE(XmNtitleString, XM_XMSTRING);
+ define_resource(XmNsingleSelectionCallback, XM_CALLBACK);
+ define_resource(XmNskipAdjust, XM_BOOLEAN);
+ define_resource(XmNsliderSize, XM_INT);
+ define_resource(XmNsliderVisual, XM_INT);
+ define_resource(XmNslidingMode, XM_INT);
+ define_resource(XmNsource, XM_TEXT_SOURCE);
+ define_resource(XmNsourceCursorIcon, XM_WIDGET);
+ define_resource(XmNsourcePixmapIcon, XM_WIDGET);
+ define_resource(XmNspacing, XM_DIMENSION);
+ define_resource(XmNspotLocation, XM_INT);
+ define_resource(XmNstateCursorIcon, XM_WIDGET);
+ define_resource(XmNsubMenuId, XM_WIDGET);
+ define_resource(XmNsymbolPixmap, XM_PIXMAP);
+ define_resource(XmNtearOffMenuActivateCallback, XM_CALLBACK);
+ define_resource(XmNtearOffMenuDeactivateCallback, XM_CALLBACK);
+ define_resource(XmNtearOffModel, XM_UCHAR);
+ define_resource(XmNtextAccelerators, XM_ULONG);
+ define_resource(XmNtextColumns, XM_SHORT);
+ define_resource(XmNtextString, XM_XMSTRING);
+ define_resource(XmNtextTranslations, XM_CALLBACK);
+ define_resource(XmNtitle, XM_STRING);
+ define_resource(XmNtitleEncoding, XM_ATOM);
+ define_resource(XmNtitleString, XM_XMSTRING);
#ifdef XmNtoolTipString
- DEFINE_RESOURCE((char *)XmNtoolTipString, XM_XMSTRING);
- DEFINE_RESOURCE((char *)XmNtoolTipPostDelay, XM_INT);
- DEFINE_RESOURCE((char *)XmNtoolTipPostDuration, XM_INT);
- DEFINE_RESOURCE((char *)XmNtoolTipEnable, XM_BOOLEAN);
- DEFINE_RESOURCE((char *)XmNanimate, XM_BOOLEAN);
+ define_resource((char *)XmNtoolTipString, XM_XMSTRING);
+ define_resource((char *)XmNtoolTipPostDelay, XM_INT);
+ define_resource((char *)XmNtoolTipPostDuration, XM_INT);
+ define_resource((char *)XmNtoolTipEnable, XM_BOOLEAN);
+ define_resource((char *)XmNanimate, XM_BOOLEAN);
#endif
- DEFINE_RESOURCE(XmNtoBottomCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtoTopCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtopAttachment, XM_UCHAR);
- DEFINE_RESOURCE(XmNtopCharacter, XM_INT);
- DEFINE_RESOURCE(XmNtopItemPosition, XM_INT);
- DEFINE_RESOURCE(XmNtopLevelEnterCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtopLevelLeaveCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtopOffset, XM_INT);
- DEFINE_RESOURCE(XmNtopPosition, XM_INT);
- DEFINE_RESOURCE(XmNtopShadowColor, XM_PIXEL);
- DEFINE_RESOURCE(XmNtopShadowPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNtopWidget, XM_WIDGET);
- DEFINE_RESOURCE(XmNtransferProc, XM_TRANSFER_CALLBACK);
- DEFINE_RESOURCE(XmNtransferStatus, XM_UCHAR);
- DEFINE_RESOURCE(XmNtransient, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNtransientFor, XM_WIDGET);
- DEFINE_RESOURCE(XmNtranslations, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtraversalOn, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNtraverseObscuredCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtroughColor, XM_PIXEL);
- DEFINE_RESOURCE(XmNunitType, XM_UCHAR);
- DEFINE_RESOURCE(XmNunmapCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNunpostBehavior, XM_UCHAR);
- DEFINE_RESOURCE(XmNuseAsyncGeometry, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNuserData, XM_XTPOINTER);
- DEFINE_RESOURCE(XmNvalidCursorForeground, XM_PIXEL);
- DEFINE_RESOURCE(XmNvalue, XM_STRING_OR_INT);
- DEFINE_RESOURCE(XmNvalueChangedCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNverifyBell, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNverticalFontUnit, XM_INT);
- DEFINE_RESOURCE(XmNverticalScrollBar, XM_WIDGET);
- DEFINE_RESOURCE(XmNverticalSpacing, XM_DIMENSION);
- DEFINE_RESOURCE(XmNvisibleItemCount, XM_INT);
- DEFINE_RESOURCE(XmNvisibleWhenOff, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNvisual, XM_VISUAL);
- DEFINE_RESOURCE(XmNvisualPolicy, XM_UCHAR);
- DEFINE_RESOURCE(XmNwidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNwidthInc, XM_INT);
- DEFINE_RESOURCE(XmNwinGravity, XM_INT);
- DEFINE_RESOURCE(XmNwindow, XM_WIDGET);
- DEFINE_RESOURCE(XmNwindowGroup, XM_WINDOW);
- DEFINE_RESOURCE(XmNwmTimeout, XM_INT);
- DEFINE_RESOURCE(XmNwordWrap, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNworkWindow, XM_WIDGET);
- DEFINE_RESOURCE(XmNx, XM_POSITION);
- DEFINE_RESOURCE(XmNy, XM_POSITION);
- DEFINE_RESOURCE(XmNarrowLayout, XM_UCHAR);
- DEFINE_RESOURCE(XmNarrowOrientation, XM_UCHAR);
- DEFINE_RESOURCE(XmNarrowSensitivity, XM_UCHAR);
- DEFINE_RESOURCE(XmNarrowSize, XM_INT);
- DEFINE_RESOURCE(XmNarrowSpacing, XM_INT);
- DEFINE_RESOURCE(XmNautoDragModel, XM_INT);
- DEFINE_RESOURCE(XmNbackPageBackground, XM_PIXEL);
- DEFINE_RESOURCE(XmNbackPageForeground, XM_PIXEL);
- DEFINE_RESOURCE(XmNbackPageNumber, XM_INT);
- DEFINE_RESOURCE(XmNbackPagePlacement, XM_UCHAR);
- DEFINE_RESOURCE(XmNbackPageSize, XM_DIMENSION);
- DEFINE_RESOURCE(XmNbindingPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNbindingType, XM_UCHAR);
- DEFINE_RESOURCE(XmNbindingWidth, XM_INT);
- DEFINE_RESOURCE(XmNbitmapConversionModel, XM_INT);
- DEFINE_RESOURCE(XmNbuttonRenderTable, XM_RENDER_TABLE);
- DEFINE_RESOURCE(XmNcollapsedStatePixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNcolorAllocationProc, XM_ALLOC_COLOR_CALLBACK);
- DEFINE_RESOURCE(XmNcolorCalculationProc, XM_SCREEN_COLOR_CALLBACK);
- DEFINE_RESOURCE(XmNcomboBoxType, XM_UCHAR);
- DEFINE_RESOURCE(XmNconvertCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNcurrentPageNumber, XM_INT);
- DEFINE_RESOURCE(XmNdecimal, XM_STRING);
- DEFINE_RESOURCE(XmNdefaultArrowSensitivity, XM_UCHAR);
- DEFINE_RESOURCE(XmNdefaultButtonEmphasis, XM_INT);
- DEFINE_RESOURCE(XmNdefaultVirtualBindings, XM_STRING);
- DEFINE_RESOURCE(XmNdestinationCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNdetail, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNdetailColumnHeading, XM_INT);
- DEFINE_RESOURCE(XmNdetailColumnHeadingCount, XM_INT);
- DEFINE_RESOURCE(XmNdetailCount, XM_INT);
- DEFINE_RESOURCE(XmNdetailOrder, XM_INT_TABLE);
- DEFINE_RESOURCE(XmNdetailOrderCount, XM_INT);
- DEFINE_RESOURCE(XmNdetailShadowThickness, XM_INT);
- DEFINE_RESOURCE(XmNdetailTabList, XM_TAB_LIST);
- DEFINE_RESOURCE(XmNdirTextLabelString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNdragStartCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNenableBtn1Transfer, XM_INT);
- DEFINE_RESOURCE(XmNenableButtonTab, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNenableDragIcon, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNenableEtchedInMenu, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNenableMultiKeyBindings, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNenableThinThickness, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNenableToggleColor, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNenableToggleVisual, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNenableUnselectableDrag, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNenableWarp, XM_INT);
+ define_resource(XmNtoBottomCallback, XM_CALLBACK);
+ define_resource(XmNtoTopCallback, XM_CALLBACK);
+ define_resource(XmNtopAttachment, XM_UCHAR);
+ define_resource(XmNtopCharacter, XM_INT);
+ define_resource(XmNtopItemPosition, XM_INT);
+ define_resource(XmNtopLevelEnterCallback, XM_CALLBACK);
+ define_resource(XmNtopLevelLeaveCallback, XM_CALLBACK);
+ define_resource(XmNtopOffset, XM_INT);
+ define_resource(XmNtopPosition, XM_INT);
+ define_resource(XmNtopShadowColor, XM_PIXEL);
+ define_resource(XmNtopShadowPixmap, XM_PIXMAP);
+ define_resource(XmNtopWidget, XM_WIDGET);
+ define_resource(XmNtransferProc, XM_TRANSFER_CALLBACK);
+ define_resource(XmNtransferStatus, XM_UCHAR);
+ define_resource(XmNtransient, XM_BOOLEAN);
+ define_resource(XmNtransientFor, XM_WIDGET);
+ define_resource(XmNtranslations, XM_CALLBACK);
+ define_resource(XmNtraversalOn, XM_BOOLEAN);
+ define_resource(XmNtraverseObscuredCallback, XM_CALLBACK);
+ define_resource(XmNtroughColor, XM_PIXEL);
+ define_resource(XmNunitType, XM_UCHAR);
+ define_resource(XmNunmapCallback, XM_CALLBACK);
+ define_resource(XmNunpostBehavior, XM_UCHAR);
+ define_resource(XmNuseAsyncGeometry, XM_BOOLEAN);
+ define_resource(XmNuserData, XM_XTPOINTER);
+ define_resource(XmNvalidCursorForeground, XM_PIXEL);
+ define_resource(XmNvalue, XM_STRING_OR_INT);
+ define_resource(XmNvalueChangedCallback, XM_CALLBACK);
+ define_resource(XmNverifyBell, XM_BOOLEAN);
+ define_resource(XmNverticalFontUnit, XM_INT);
+ define_resource(XmNverticalScrollBar, XM_WIDGET);
+ define_resource(XmNverticalSpacing, XM_DIMENSION);
+ define_resource(XmNvisibleItemCount, XM_INT);
+ define_resource(XmNvisibleWhenOff, XM_BOOLEAN);
+ define_resource(XmNvisual, XM_VISUAL);
+ define_resource(XmNvisualPolicy, XM_UCHAR);
+ define_resource(XmNwidth, XM_DIMENSION);
+ define_resource(XmNwidthInc, XM_INT);
+ define_resource(XmNwinGravity, XM_INT);
+ define_resource(XmNwindow, XM_WIDGET);
+ define_resource(XmNwindowGroup, XM_WINDOW);
+ define_resource(XmNwmTimeout, XM_INT);
+ define_resource(XmNwordWrap, XM_BOOLEAN);
+ define_resource(XmNworkWindow, XM_WIDGET);
+ define_resource(XmNx, XM_POSITION);
+ define_resource(XmNy, XM_POSITION);
+ define_resource(XmNarrowLayout, XM_UCHAR);
+ define_resource(XmNarrowOrientation, XM_UCHAR);
+ define_resource(XmNarrowSensitivity, XM_UCHAR);
+ define_resource(XmNarrowSize, XM_INT);
+ define_resource(XmNarrowSpacing, XM_INT);
+ define_resource(XmNautoDragModel, XM_INT);
+ define_resource(XmNbackPageBackground, XM_PIXEL);
+ define_resource(XmNbackPageForeground, XM_PIXEL);
+ define_resource(XmNbackPageNumber, XM_INT);
+ define_resource(XmNbackPagePlacement, XM_UCHAR);
+ define_resource(XmNbackPageSize, XM_DIMENSION);
+ define_resource(XmNbindingPixmap, XM_PIXMAP);
+ define_resource(XmNbindingType, XM_UCHAR);
+ define_resource(XmNbindingWidth, XM_INT);
+ define_resource(XmNbitmapConversionModel, XM_INT);
+ define_resource(XmNbuttonRenderTable, XM_RENDER_TABLE);
+ define_resource(XmNcollapsedStatePixmap, XM_PIXMAP);
+ define_resource(XmNcolorAllocationProc, XM_ALLOC_COLOR_CALLBACK);
+ define_resource(XmNcolorCalculationProc, XM_SCREEN_COLOR_CALLBACK);
+ define_resource(XmNcomboBoxType, XM_UCHAR);
+ define_resource(XmNconvertCallback, XM_CALLBACK);
+ define_resource(XmNcurrentPageNumber, XM_INT);
+ define_resource(XmNdecimal, XM_STRING);
+ define_resource(XmNdefaultArrowSensitivity, XM_UCHAR);
+ define_resource(XmNdefaultButtonEmphasis, XM_INT);
+ define_resource(XmNdefaultVirtualBindings, XM_STRING);
+ define_resource(XmNdestinationCallback, XM_CALLBACK);
+ define_resource(XmNdetail, XM_STRING_TABLE);
+ define_resource(XmNdetailColumnHeading, XM_INT);
+ define_resource(XmNdetailColumnHeadingCount, XM_INT);
+ define_resource(XmNdetailCount, XM_INT);
+ define_resource(XmNdetailOrder, XM_INT_TABLE);
+ define_resource(XmNdetailOrderCount, XM_INT);
+ define_resource(XmNdetailShadowThickness, XM_INT);
+ define_resource(XmNdetailTabList, XM_TAB_LIST);
+ define_resource(XmNdirTextLabelString, XM_XMSTRING);
+ define_resource(XmNdragStartCallback, XM_CALLBACK);
+ define_resource(XmNenableBtn1Transfer, XM_INT);
+ define_resource(XmNenableButtonTab, XM_BOOLEAN);
+ define_resource(XmNenableDragIcon, XM_BOOLEAN);
+ define_resource(XmNenableEtchedInMenu, XM_BOOLEAN);
+ define_resource(XmNenableMultiKeyBindings, XM_BOOLEAN);
+ define_resource(XmNenableThinThickness, XM_BOOLEAN);
+ define_resource(XmNenableToggleColor, XM_BOOLEAN);
+ define_resource(XmNenableToggleVisual, XM_BOOLEAN);
+ define_resource(XmNenableUnselectableDrag, XM_BOOLEAN);
+ define_resource(XmNenableWarp, XM_INT);
#if HAVE_XP
- DEFINE_RESOURCE(XmNendJobCallback, XM_CALLBACK);
+ define_resource(XmNendJobCallback, XM_CALLBACK);
#endif
- DEFINE_RESOURCE(XmNentryParent, XM_WIDGET);
- DEFINE_RESOURCE(XmNentryViewType, XM_UCHAR);
- DEFINE_RESOURCE(XmNexpandedStatePixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNfileFilterStyle, XM_INT);
- DEFINE_RESOURCE(XmNfirstPageNumber, XM_INT);
- DEFINE_RESOURCE(XmNfontName, XM_STRING);
- DEFINE_RESOURCE(XmNfontType, XM_UCHAR);
- DEFINE_RESOURCE(XmNframeBackground, XM_PIXEL);
- DEFINE_RESOURCE(XmNframeChildType, XM_UCHAR);
- DEFINE_RESOURCE(XmNframeShadowThickness, XM_DIMENSION);
- DEFINE_RESOURCE(XmNgrabStyle, XM_INT);
- DEFINE_RESOURCE(XmNincludeStatus, XM_INT);
- DEFINE_RESOURCE(XmNincrementValue, XM_INT);
- DEFINE_RESOURCE(XmNindeterminateInsensitivePixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNindeterminatePixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNinnerMarginHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNinnerMarginWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNinputPolicy, XM_ULONG);
- DEFINE_RESOURCE(XmNinsensitiveStippleBitmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNinvokeParseProc, XM_PARSE_CALLBACK);
- DEFINE_RESOURCE(XmNlabelRenderTable, XM_RENDER_TABLE);
- DEFINE_RESOURCE(XmNlargeCellHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNlargeCellWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNlargeIconMask, XM_PIXMAP);
- DEFINE_RESOURCE(XmNlargeIconPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNlargeIconX, XM_FLOAT);
- DEFINE_RESOURCE(XmNlargeIconY, XM_FLOAT);
- DEFINE_RESOURCE(XmNlastPageNumber, XM_INT);
- DEFINE_RESOURCE(XmNlayoutDirection, XM_UCHAR);
- DEFINE_RESOURCE(XmNlayoutType, XM_UCHAR);
- DEFINE_RESOURCE(XmNlist, XM_WIDGET);
- DEFINE_RESOURCE(XmNloadModel, XM_UCHAR);
- DEFINE_RESOURCE(XmNmajorTabSpacing, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmatchBehavior, XM_UCHAR);
+ define_resource(XmNentryParent, XM_WIDGET);
+ define_resource(XmNentryViewType, XM_UCHAR);
+ define_resource(XmNexpandedStatePixmap, XM_PIXMAP);
+ define_resource(XmNfileFilterStyle, XM_INT);
+ define_resource(XmNfirstPageNumber, XM_INT);
+ define_resource(XmNfontName, XM_STRING);
+ define_resource(XmNfontType, XM_UCHAR);
+ define_resource(XmNframeBackground, XM_PIXEL);
+ define_resource(XmNframeChildType, XM_UCHAR);
+ define_resource(XmNframeShadowThickness, XM_DIMENSION);
+ define_resource(XmNgrabStyle, XM_INT);
+ define_resource(XmNincludeStatus, XM_INT);
+ define_resource(XmNincrementValue, XM_INT);
+ define_resource(XmNindeterminateInsensitivePixmap, XM_PIXMAP);
+ define_resource(XmNindeterminatePixmap, XM_PIXMAP);
+ define_resource(XmNinnerMarginHeight, XM_DIMENSION);
+ define_resource(XmNinnerMarginWidth, XM_DIMENSION);
+ define_resource(XmNinputPolicy, XM_ULONG);
+ define_resource(XmNinsensitiveStippleBitmap, XM_PIXMAP);
+ define_resource(XmNinvokeParseProc, XM_PARSE_CALLBACK);
+ define_resource(XmNlabelRenderTable, XM_RENDER_TABLE);
+ define_resource(XmNlargeCellHeight, XM_DIMENSION);
+ define_resource(XmNlargeCellWidth, XM_DIMENSION);
+ define_resource(XmNlargeIconMask, XM_PIXMAP);
+ define_resource(XmNlargeIconPixmap, XM_PIXMAP);
+ define_resource(XmNlargeIconX, XM_FLOAT);
+ define_resource(XmNlargeIconY, XM_FLOAT);
+ define_resource(XmNlastPageNumber, XM_INT);
+ define_resource(XmNlayoutDirection, XM_UCHAR);
+ define_resource(XmNlayoutType, XM_UCHAR);
+ define_resource(XmNlist, XM_WIDGET);
+ define_resource(XmNloadModel, XM_UCHAR);
+ define_resource(XmNmajorTabSpacing, XM_DIMENSION);
+ define_resource(XmNmatchBehavior, XM_UCHAR);
#if HAVE_XP
- DEFINE_RESOURCE(XmNmaxX, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmaxY, XM_DIMENSION);
- DEFINE_RESOURCE(XmNminX, XM_DIMENSION);
- DEFINE_RESOURCE(XmNminY, XM_DIMENSION);
+ define_resource(XmNmaxX, XM_DIMENSION);
+ define_resource(XmNmaxY, XM_DIMENSION);
+ define_resource(XmNminX, XM_DIMENSION);
+ define_resource(XmNminY, XM_DIMENSION);
#endif
- DEFINE_RESOURCE(XmNmaximumValue, XM_INT);
- DEFINE_RESOURCE(XmNminimumValue, XM_INT);
- DEFINE_RESOURCE(XmNminorTabSpacing, XM_DIMENSION);
- DEFINE_RESOURCE(XmNmotifVersion, XM_INT);
- DEFINE_RESOURCE(XmNnoFontCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNnoRenditionCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNnotebookChildType, XM_UCHAR);
- DEFINE_RESOURCE(XmNnumValues, XM_INT);
- DEFINE_RESOURCE(XmNoutlineButtonPolicy, XM_UCHAR);
- DEFINE_RESOURCE(XmNoutlineChangedCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNoutlineColumnWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNoutlineIndentation, XM_DIMENSION);
- DEFINE_RESOURCE(XmNoutlineLineStyle, XM_UCHAR);
- DEFINE_RESOURCE(XmNoutlineState, XM_UCHAR);
- DEFINE_RESOURCE(XmNpageChangedCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNpageNumber, XM_INT);
+ define_resource(XmNmaximumValue, XM_INT);
+ define_resource(XmNminimumValue, XM_INT);
+ define_resource(XmNminorTabSpacing, XM_DIMENSION);
+ define_resource(XmNmotifVersion, XM_INT);
+ define_resource(XmNnoFontCallback, XM_CALLBACK);
+ define_resource(XmNnoRenditionCallback, XM_CALLBACK);
+ define_resource(XmNnotebookChildType, XM_UCHAR);
+ define_resource(XmNnumValues, XM_INT);
+ define_resource(XmNoutlineButtonPolicy, XM_UCHAR);
+ define_resource(XmNoutlineChangedCallback, XM_CALLBACK);
+ define_resource(XmNoutlineColumnWidth, XM_DIMENSION);
+ define_resource(XmNoutlineIndentation, XM_DIMENSION);
+ define_resource(XmNoutlineLineStyle, XM_UCHAR);
+ define_resource(XmNoutlineState, XM_UCHAR);
+ define_resource(XmNpageChangedCallback, XM_CALLBACK);
+ define_resource(XmNpageNumber, XM_INT);
#if HAVE_XP
- DEFINE_RESOURCE(XmNpageSetupCallback, XM_CALLBACK);
+ define_resource(XmNpageSetupCallback, XM_CALLBACK);
#endif
- DEFINE_RESOURCE(XmNpathMode, XM_INT);
- DEFINE_RESOURCE(XmNpatternType, XM_UCHAR);
+ define_resource(XmNpathMode, XM_INT);
+ define_resource(XmNpatternType, XM_UCHAR);
#if HAVE_XP
- DEFINE_RESOURCE(XmNpdmNotificationCallback, XM_CALLBACK);
+ define_resource(XmNpdmNotificationCallback, XM_CALLBACK);
#endif
- DEFINE_RESOURCE(XmNpopupHandlerCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNposition, XM_INT);
- DEFINE_RESOURCE(XmNpositionMode, XM_INT);
- DEFINE_RESOURCE(XmNpositionType, XM_UCHAR);
- DEFINE_RESOURCE(XmNprimaryOwnership, XM_UCHAR);
- DEFINE_RESOURCE(XmNrenderTable, XM_RENDER_TABLE);
- DEFINE_RESOURCE(XmNrenditionBackground, XM_PIXEL);
- DEFINE_RESOURCE(XmNrenditionForeground, XM_PIXEL);
- DEFINE_RESOURCE(XmNscrolledWindowChildType, XM_UCHAR);
- DEFINE_RESOURCE(XmNselectedItem, XM_XMSTRING);
- DEFINE_RESOURCE(XmNselectedObjectCount, XM_INT);
- DEFINE_RESOURCE(XmNselectedObjects, XM_WIDGET_LIST);
- DEFINE_RESOURCE(XmNselectedPosition, XM_INT);
- DEFINE_RESOURCE(XmNselectedPositionCount, XM_INT);
- DEFINE_RESOURCE(XmNselectedPositions, XM_INT_TABLE);
- DEFINE_RESOURCE(XmNselectionCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNselectionMode, XM_UCHAR);
- DEFINE_RESOURCE(XmNselectionTechnique, XM_UCHAR);
- DEFINE_RESOURCE(XmNsliderMark, XM_INT);
- DEFINE_RESOURCE(XmNsmallCellHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNsmallCellWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNsmallIconMask, XM_PIXMAP);
- DEFINE_RESOURCE(XmNsmallIconPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNsmallIconX, XM_FLOAT);
- DEFINE_RESOURCE(XmNsmallIconY, XM_FLOAT);
- DEFINE_RESOURCE(XmNsnapBackMultiple, XM_SHORT);
- DEFINE_RESOURCE(XmNspatialIncludeModel, XM_UCHAR);
- DEFINE_RESOURCE(XmNspatialResizeModel, XM_UCHAR);
- DEFINE_RESOURCE(XmNspatialSnapModel, XM_UCHAR);
- DEFINE_RESOURCE(XmNspatialStyle, XM_UCHAR);
- DEFINE_RESOURCE(XmNspinBoxChildType, XM_UCHAR);
+ define_resource(XmNpopupHandlerCallback, XM_CALLBACK);
+ define_resource(XmNposition, XM_INT);
+ define_resource(XmNpositionMode, XM_INT);
+ define_resource(XmNpositionType, XM_UCHAR);
+ define_resource(XmNprimaryOwnership, XM_UCHAR);
+ define_resource(XmNrenderTable, XM_RENDER_TABLE);
+ define_resource(XmNrenditionBackground, XM_PIXEL);
+ define_resource(XmNrenditionForeground, XM_PIXEL);
+ define_resource(XmNscrolledWindowChildType, XM_UCHAR);
+ define_resource(XmNselectedItem, XM_XMSTRING);
+ define_resource(XmNselectedObjectCount, XM_INT);
+ define_resource(XmNselectedObjects, XM_WIDGET_LIST);
+ define_resource(XmNselectedPosition, XM_INT);
+ define_resource(XmNselectedPositionCount, XM_INT);
+ define_resource(XmNselectedPositions, XM_INT_TABLE);
+ define_resource(XmNselectionCallback, XM_CALLBACK);
+ define_resource(XmNselectionMode, XM_UCHAR);
+ define_resource(XmNselectionTechnique, XM_UCHAR);
+ define_resource(XmNsliderMark, XM_INT);
+ define_resource(XmNsmallCellHeight, XM_DIMENSION);
+ define_resource(XmNsmallCellWidth, XM_DIMENSION);
+ define_resource(XmNsmallIconMask, XM_PIXMAP);
+ define_resource(XmNsmallIconPixmap, XM_PIXMAP);
+ define_resource(XmNsmallIconX, XM_FLOAT);
+ define_resource(XmNsmallIconY, XM_FLOAT);
+ define_resource(XmNsnapBackMultiple, XM_SHORT);
+ define_resource(XmNspatialIncludeModel, XM_UCHAR);
+ define_resource(XmNspatialResizeModel, XM_UCHAR);
+ define_resource(XmNspatialSnapModel, XM_UCHAR);
+ define_resource(XmNspatialStyle, XM_UCHAR);
+ define_resource(XmNspinBoxChildType, XM_UCHAR);
#if HAVE_XP
- DEFINE_RESOURCE(XmNstartJobCallback, XM_CALLBACK);
-#endif
- DEFINE_RESOURCE(XmNstrikethruType, XM_UCHAR);
- DEFINE_RESOURCE(XmNsubstitute, XM_XMSTRING);
- DEFINE_RESOURCE(XmNtabList, XM_TAB_LIST);
- DEFINE_RESOURCE(XmNtag, XM_STRING);
- DEFINE_RESOURCE(XmNtearOffTitle, XM_XMSTRING);
- DEFINE_RESOURCE(XmNtextField, XM_WIDGET);
- DEFINE_RESOURCE(XmNtextRenderTable, XM_RENDER_TABLE);
- DEFINE_RESOURCE(XmNtoggleMode, XM_UCHAR);
- DEFINE_RESOURCE(XmNunderlineType, XM_UCHAR);
- DEFINE_RESOURCE(XmNunselectColor, XM_PIXEL);
-
- DEFINE_RESOURCE(XmNtabValue, XM_FLOAT);
- DEFINE_RESOURCE(XmNoffsetModel, XM_INT);
- DEFINE_RESOURCE(XmNcallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNwaitForWm, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNuseColorObj, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNvalues, XM_STRING_TABLE);
- /* DEFINE_RESOURCE(XmNverifyPreedit, XM_BOOLEAN); */
- DEFINE_RESOURCE(XmNviewType, XM_UCHAR);
- DEFINE_RESOURCE(XmNvisualEmphasis, XM_UCHAR);
- DEFINE_RESOURCE(XmNwrap, XM_BOOLEAN);
-
-#if HAVE_XmCreateFontSelector
- /* presumably in a "correct" setup these would be defined in Xm/XmStrDefs.h */
- #ifndef XmNcurrentFont
- /* see comment under resource definition above
- #define XmN100DPIstring "100DPIstring"
- #define XmN75DPIstring "75DPIstring"
- */
- #define XmNanyLowerString "anyLowerString"
- #define XmNanyString "anyString"
- #define XmNboldString "boldString"
- #define XmNbothString "bothString"
- #define XmNcurrentFont "currentFont"
- #define XmNdefaultEncodingString "defaultEncodingString"
- #define XmNencodingList "encodingList"
- #define XmNencodingString "encodingString"
- #define XmNfamilyString "familyString"
- #define XmNitalicString "italicString"
- #define XmNmonoSpaceString "monoSpaceString"
- #define XmNoptionString "optionString"
- #define XmNotherString "otherString"
- #define XmNpropSpaceString "propSpaceString"
- #define XmNsampleText "sampleText"
- #define XmNscalingString "scalingString"
- #define XmNshowFontName "showFontName"
- #define XmNshowNameString "showNameString"
- #define XmNsizeString "sizeString"
- #define XmNtextRows "textRows"
- #define XmNuseScaling "useScaling"
- #define XmNxlfdString "xlfdString"
- #endif
- /*
- DEFINE_RESOURCE(XmN100DPIstring, XM_XMSTRING);
- DEFINE_RESOURCE(XmN75DPIstring, XM_XMSTRING);
- */
- DEFINE_RESOURCE(XmNanyLowerString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNanyString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNboldString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNbothString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNcurrentFont, XM_STRING);
- DEFINE_RESOURCE(XmNdefaultEncodingString, XM_STRING);
- DEFINE_RESOURCE(XmNencodingList, XM_STRING_TABLE);
- DEFINE_RESOURCE(XmNencodingString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNfamilyString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNitalicString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNmonoSpaceString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNoptionString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNotherString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNpropSpaceString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNsampleText, XM_XMSTRING);
- DEFINE_RESOURCE(XmNscalingString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNshowFontName, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNshowNameString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNsizeString, XM_XMSTRING);
- DEFINE_RESOURCE(XmNtextRows, XM_DIMENSION);
- DEFINE_RESOURCE(XmNuseScaling, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNxlfdString, XM_XMSTRING);
-#endif
-#if HAVE_XmCreateColorSelector
- #ifndef XmNblueSliderLabel
- #define XmNblueSliderLabel "blueSliderLabel"
- #define XmNcolorListTogLabel "colorListTogLabel"
- #define XmNcolorMode "colorMode"
- #define XmNcolorName "colorName"
- #define XmNfileReadError "fileReadError"
- #define XmNgreenSliderLabel "greenSliderLabel"
- #define XmNnoCellError "noCellError"
- #define XmNredSliderLabel "redSliderLabel"
- #define XmNrgbFile "rgbFile"
- #define XmNsliderTogLabel "sliderTogLabel"
- #endif
- DEFINE_RESOURCE(XmNblueSliderLabel, XM_XMSTRING);
- DEFINE_RESOURCE(XmNcolorListTogLabel, XM_XMSTRING);
- DEFINE_RESOURCE(XmNcolorMode, XM_STRING);
- DEFINE_RESOURCE(XmNcolorName, XM_STRING);
- DEFINE_RESOURCE(XmNfileReadError, XM_XMSTRING);
- DEFINE_RESOURCE(XmNgreenSliderLabel, XM_XMSTRING);
- DEFINE_RESOURCE(XmNnoCellError, XM_XMSTRING);
- DEFINE_RESOURCE(XmNredSliderLabel, XM_XMSTRING);
- DEFINE_RESOURCE(XmNrgbFile, XM_STRING);
- DEFINE_RESOURCE(XmNsliderTogLabel, XM_XMSTRING);
+ define_resource(XmNstartJobCallback, XM_CALLBACK);
#endif
-#if HAVE_XmCreateButtonBox
- #ifndef XmNequalSize
- #define XmNequalSize "equalSize"
- #define XmNfillOption "fillOption"
- #endif
- DEFINE_RESOURCE(XmNequalSize, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNfillOption, XM_INT);
-#endif
-#ifdef XmNdefaultEntryLabelRenderTable
- DEFINE_RESOURCE(XmNdefaultEntryLabelRenderTable, XM_RENDER_TABLE);
-#endif
-#ifdef XmNentryLabelRenderTable
- DEFINE_RESOURCE(XmNentryLabelRenderTable, XM_RENDER_TABLE);
-#endif
-#ifdef XmNpixmapPlacement
- DEFINE_RESOURCE(XmNpixmapPlacement, XM_INT);
-#endif
-#ifdef XmNpixmapTextPadding
- DEFINE_RESOURCE(XmNpixmapTextPadding, XM_INT);
-#endif
-#if HAVE_XmCreateDataField
- #ifndef XmNautoFill
- #define XmNautoFill "autoFill"
- #define XmNpicture "picture"
- #define XmNpictureErrorCallback "pictureErrorCallback"
- #define XmNvalidateCallback "validateCallback"
- #endif
- DEFINE_RESOURCE(XmNautoFill, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNpicture, XM_STRING);
- DEFINE_RESOURCE(XmNpictureErrorCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNvalidateCallback, XM_CALLBACK);
-#endif
-#if HAVE_XmCreateColumn
- #ifndef XmNdefaultEntryLabelAlignment
- #define XmNdefaultEntryLabelAlignment "defaultEntryLabelAlignment"
- #define XmNdefaultEntryLabelFontList "defaultEntryLabelFontList"
- #define XmNdefaultFillStyle "defaultFillStyle"
- #define XmNdistribution "distribution"
- #define XmNitemSpacing "itemSpacing"
- #define XmNlabelSpacing "labelSpacing"
- #define XmNentryLabelAlignment "entryLabelAlignment"
- #define XmNentryLabelFontList "entryLabelFontList"
- #define XmNentryLabelPixmap "entryLabelPixmap"
- #define XmNentryLabelString "entryLabelString"
- #define XmNentryLabelType "entryLabelType"
- #define XmNfillStyle "fillStyle"
- #define XmNshowEntryLabel "showEntryLabel"
- #define XmNstretchable "stretchable"
- #endif
- DEFINE_RESOURCE(XmNdefaultEntryLabelAlignment, XM_INT);
- DEFINE_RESOURCE(XmNdefaultEntryLabelFontList, XM_FONTLIST);
- DEFINE_RESOURCE(XmNdefaultFillStyle, XM_INT);
- DEFINE_RESOURCE(XmNdistribution, XM_INT);
- DEFINE_RESOURCE(XmNitemSpacing, XM_INT);
- DEFINE_RESOURCE(XmNlabelSpacing, XM_INT);
- DEFINE_RESOURCE(XmNentryLabelAlignment, XM_INT);
- DEFINE_RESOURCE(XmNentryLabelFontList, XM_FONTLIST);
- DEFINE_RESOURCE(XmNentryLabelPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNentryLabelString, XM_XMSTRING); /* ? */
- DEFINE_RESOURCE(XmNentryLabelType, XM_INT);
- DEFINE_RESOURCE(XmNfillStyle, XM_INT);
- DEFINE_RESOURCE(XmNshowEntryLabel, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNstretchable, XM_BOOLEAN);
-#endif
-#if HAVE_XmCreateDropDown
- #ifndef XmNpopupCursor
- #define XmNcustomizedCombinationBox "customizedCombinationBox"
- #define XmNhorizontalMargin "horizontalMargin"
- #define XmNpopupCursor "popupCursor"
- #define XmNpopupOffset "popupOffset"
- #define XmNpopupShellWidget "popupShellWidget"
- #define XmNshowLabel "showLabel"
- #define XmNupdateShellCallback "updateShellCallback"
- #define XmNupdateTextCallback "updateTextCallback"
- #define XmNuseTextField "useTextField"
- #define XmNverify "verify"
- #define XmNverifyTextCallback "verifyTextCallback"
- #define XmNverticalMargin "verticalMargin"
- #endif
- DEFINE_RESOURCE(XmNcustomizedCombinationBox, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNhorizontalMargin, XM_DIMENSION);
- DEFINE_RESOURCE(XmNpopupCursor, XM_CURSOR);
- DEFINE_RESOURCE(XmNpopupOffset, XM_INT);
- DEFINE_RESOURCE(XmNpopupShellWidget, XM_WIDGET);
- DEFINE_RESOURCE(XmNshowLabel, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNupdateShellCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNupdateTextCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNuseTextField, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNverify, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNverifyTextCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNverticalMargin, XM_DIMENSION);
-#endif
-#if HAVE_XmCreateTabStack
- #ifndef XmNstackedEffect
- #define XmNstackedEffect "stackedEffect"
- #define XmNtabAutoSelect "tabAutoSelect"
- #define XmNtabCornerPercent "tabCornerPercent"
- #define XmNtabLabelSpacing "tabLabelSpacing"
- #define XmNtabMarginHeight "tabMarginHeight"
- #define XmNtabMarginWidth "tabMarginWidth"
- #define XmNtabMode "tabMode"
- #define XmNtabOffset "tabOffset"
- #define XmNtabOrientation "tabOrientation"
- #define XmNtabSelectColor "tabSelectColor"
- #define XmNtabSelectedCallback "tabSelectedCallback"
- #define XmNtabSelectPixmap "tabSelectPixmap"
- #define XmNtabSide "tabSide"
- #define XmNtabStyle "tabStyle"
- #define XmNuniformTabSize "uniformTabSize"
- #define XmNuseImageCache "useImageCache"
- #endif
- DEFINE_RESOURCE(XmNstackedEffect, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNtabAutoSelect, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNtabCornerPercent, XM_INT);
- DEFINE_RESOURCE(XmNtabLabelSpacing, XM_DIMENSION);
- DEFINE_RESOURCE(XmNtabMarginHeight, XM_DIMENSION);
- DEFINE_RESOURCE(XmNtabMarginWidth, XM_DIMENSION);
- DEFINE_RESOURCE(XmNtabMode, XM_INT);
- DEFINE_RESOURCE(XmNtabOffset, XM_DIMENSION);
- DEFINE_RESOURCE(XmNtabOrientation, XM_INT);
- DEFINE_RESOURCE(XmNtabSelectColor, XM_PIXEL);
- DEFINE_RESOURCE(XmNtabSelectedCallback, XM_CALLBACK);
- DEFINE_RESOURCE(XmNtabSelectPixmap, XM_PIXMAP);
- DEFINE_RESOURCE(XmNtabSide, XM_INT);
- DEFINE_RESOURCE(XmNtabStyle, XM_INT);
- DEFINE_RESOURCE(XmNuniformTabSize, XM_BOOLEAN);
- DEFINE_RESOURCE(XmNuseImageCache, XM_BOOLEAN);
-#endif
+ define_resource(XmNstrikethruType, XM_UCHAR);
+ define_resource(XmNsubstitute, XM_XMSTRING);
+ define_resource(XmNtabList, XM_TAB_LIST);
+ define_resource(XmNtag, XM_STRING);
+ define_resource(XmNtearOffTitle, XM_XMSTRING);
+ define_resource(XmNtextField, XM_WIDGET);
+ define_resource(XmNtextRenderTable, XM_RENDER_TABLE);
+ define_resource(XmNtoggleMode, XM_UCHAR);
+ define_resource(XmNunderlineType, XM_UCHAR);
+ define_resource(XmNunselectColor, XM_PIXEL);
+
+ define_resource(XmNtabValue, XM_FLOAT);
+ define_resource(XmNoffsetModel, XM_INT);
+ define_resource(XmNcallback, XM_CALLBACK);
+ define_resource(XmNwaitForWm, XM_BOOLEAN);
+ define_resource(XmNuseColorObj, XM_BOOLEAN);
+ define_resource(XmNvalues, XM_STRING_TABLE);
+ /* define_resource(XmNverifyPreedit, XM_BOOLEAN); */
+ define_resource(XmNviewType, XM_UCHAR);
+ define_resource(XmNvisualEmphasis, XM_UCHAR);
+ define_resource(XmNwrap, XM_BOOLEAN);
qsort((void *)xm_hash, hd_ctr, sizeof(hdata *), alphabet_compare);
{
- int i, n;
+ int i;
for (i = 0; i < LINKS_SIZE; i++) hd_links[i] = hd_ctr;
for (i = 0; i < hd_ctr; i++)
{
+ int n;
n = (int)(xm_hash[i]->name[0]) - 97; /* (char->integer #\a) */
-#if MUS_DEBUGGING
- if ((n < 0) || (n >= LINKS_SIZE))
- {
- fprintf(stderr, "index %s at %d\n", xm_hash[i]->name, n);
- abort();
- }
-#endif
if (hd_links[n] > i)
hd_links[n] = i;
}
}
}
-#endif
-#if HAVE_MOTIF
+
#define S_add_resource "add-resource"
-static XEN g_add_resource(XEN nam, XEN typ)
+static Xen g_add_resource(Xen nam, Xen typ)
{
#define H_add_resource "(" S_add_resource " name type) adds the resource 'name' with the libxm type 'type'. \
The types are defined in xm.c around line 679. To add XmNhiho as an integer: \n\
(define XmNhiho (add-resource \"hiho\" 0))"
- XEN_ASSERT_TYPE(XEN_STRING_P(nam), nam, XEN_ARG_1, S_add_resource, "a string");
- XEN_ASSERT_TYPE(XEN_INTEGER_P(typ), typ, XEN_ARG_2, S_add_resource, "an integer");
- hash_resource(XEN_TO_C_STRING(nam), (xm_resource_t)XEN_TO_C_INT(typ));
+ Xen_check_type(Xen_is_string(nam), nam, 1, S_add_resource, "a string");
+ Xen_check_type(Xen_is_integer(typ), typ, 2, S_add_resource, "an integer");
+ hash_resource(Xen_string_to_C_string(nam), (xm_resource_t)Xen_integer_to_C_int(typ));
return(nam);
}
-#ifdef XEN_ARGIFY_1
- XEN_NARGIFY_2(g_add_resource_w, g_add_resource)
-#else
- #define g_add_resource_w g_add_resource
-#endif
-#endif
+Xen_wrap_2_args(g_add_resource_w, g_add_resource)
/* -------------------------------- integer constants -------------------------------- */
static void define_integers(void)
{
-#if HAVE_SCHEME
- #define DEFINE_INTEGER(Name) s7_define_constant(s7, XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_INT(Name))
- #define DEFINE_ULONG(Name) s7_define_constant(s7, XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_ULONG(Name))
-#else
- #define DEFINE_INTEGER(Name) XEN_DEFINE(XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_INT(Name))
- #define DEFINE_ULONG(Name) XEN_DEFINE(XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_ULONG(Name))
-#endif
+ #define define_integer(Name) Xen_define(XM_PREFIX #Name XM_POSTFIX, C_int_to_Xen_integer(Name))
+ #define define_ulong(Name) Xen_define(XM_PREFIX #Name XM_POSTFIX, C_ulong_to_Xen_ulong(Name))
- DEFINE_ULONG(AllPlanes);
- DEFINE_INTEGER(XC_num_glyphs);
- DEFINE_INTEGER(XC_X_cursor);
- DEFINE_INTEGER(XC_arrow);
- DEFINE_INTEGER(XC_based_arrow_down);
- DEFINE_INTEGER(XC_based_arrow_up);
- DEFINE_INTEGER(XC_boat);
- DEFINE_INTEGER(XC_bogosity);
- DEFINE_INTEGER(XC_bottom_left_corner);
- DEFINE_INTEGER(XC_bottom_right_corner);
- DEFINE_INTEGER(XC_bottom_side);
- DEFINE_INTEGER(XC_bottom_tee);
- DEFINE_INTEGER(XC_box_spiral);
- DEFINE_INTEGER(XC_center_ptr);
- DEFINE_INTEGER(XC_circle);
- DEFINE_INTEGER(XC_clock);
- DEFINE_INTEGER(XC_coffee_mug);
- DEFINE_INTEGER(XC_cross);
- DEFINE_INTEGER(XC_cross_reverse);
- DEFINE_INTEGER(XC_crosshair);
- DEFINE_INTEGER(XC_diamond_cross);
- DEFINE_INTEGER(XC_dot);
- DEFINE_INTEGER(XC_dotbox);
- DEFINE_INTEGER(XC_double_arrow);
- DEFINE_INTEGER(XC_draft_large);
- DEFINE_INTEGER(XC_draft_small);
- DEFINE_INTEGER(XC_draped_box);
- DEFINE_INTEGER(XC_exchange);
- DEFINE_INTEGER(XC_fleur);
- DEFINE_INTEGER(XC_gobbler);
- DEFINE_INTEGER(XC_gumby);
- DEFINE_INTEGER(XC_hand1);
- DEFINE_INTEGER(XC_hand2);
- DEFINE_INTEGER(XC_heart);
- DEFINE_INTEGER(XC_icon);
- DEFINE_INTEGER(XC_iron_cross);
- DEFINE_INTEGER(XC_left_ptr);
- DEFINE_INTEGER(XC_left_side);
- DEFINE_INTEGER(XC_left_tee);
- DEFINE_INTEGER(XC_leftbutton);
- DEFINE_INTEGER(XC_ll_angle);
- DEFINE_INTEGER(XC_lr_angle);
- DEFINE_INTEGER(XC_man);
- DEFINE_INTEGER(XC_middlebutton);
- DEFINE_INTEGER(XC_mouse);
- DEFINE_INTEGER(XC_pencil);
- DEFINE_INTEGER(XC_pirate);
- DEFINE_INTEGER(XC_plus);
- DEFINE_INTEGER(XC_question_arrow);
- DEFINE_INTEGER(XC_right_ptr);
- DEFINE_INTEGER(XC_right_side);
- DEFINE_INTEGER(XC_right_tee);
- DEFINE_INTEGER(XC_rightbutton);
- DEFINE_INTEGER(XC_rtl_logo);
- DEFINE_INTEGER(XC_sailboat);
- DEFINE_INTEGER(XC_sb_down_arrow);
- DEFINE_INTEGER(XC_sb_h_double_arrow);
- DEFINE_INTEGER(XC_sb_left_arrow);
- DEFINE_INTEGER(XC_sb_right_arrow);
- DEFINE_INTEGER(XC_sb_up_arrow);
- DEFINE_INTEGER(XC_sb_v_double_arrow);
- DEFINE_INTEGER(XC_shuttle);
- DEFINE_INTEGER(XC_sizing);
- DEFINE_INTEGER(XC_spider);
- DEFINE_INTEGER(XC_spraycan);
- DEFINE_INTEGER(XC_star);
- DEFINE_INTEGER(XC_target);
- DEFINE_INTEGER(XC_tcross);
- DEFINE_INTEGER(XC_top_left_arrow);
- DEFINE_INTEGER(XC_top_left_corner);
- DEFINE_INTEGER(XC_top_right_corner);
- DEFINE_INTEGER(XC_top_side);
- DEFINE_INTEGER(XC_top_tee);
- DEFINE_INTEGER(XC_trek);
- DEFINE_INTEGER(XC_ul_angle);
- DEFINE_INTEGER(XC_umbrella);
- DEFINE_INTEGER(XC_ur_angle);
- DEFINE_INTEGER(XC_watch);
- DEFINE_INTEGER(XC_xterm);
- DEFINE_INTEGER(None);
- DEFINE_INTEGER(ParentRelative);
- DEFINE_INTEGER(CopyFromParent);
- DEFINE_INTEGER(PointerWindow);
- DEFINE_INTEGER(InputFocus);
- DEFINE_INTEGER(PointerRoot);
- DEFINE_INTEGER(AnyPropertyType);
- DEFINE_INTEGER(AnyKey);
- DEFINE_INTEGER(AnyButton);
- DEFINE_INTEGER(AllTemporary);
- DEFINE_INTEGER(CurrentTime);
- DEFINE_INTEGER(NoSymbol);
- DEFINE_INTEGER(NoEventMask);
- DEFINE_INTEGER(KeyPressMask);
- DEFINE_INTEGER(KeyReleaseMask);
- DEFINE_INTEGER(ButtonPressMask);
- DEFINE_INTEGER(ButtonReleaseMask);
- DEFINE_INTEGER(EnterWindowMask);
- DEFINE_INTEGER(LeaveWindowMask);
- DEFINE_INTEGER(PointerMotionMask);
- DEFINE_INTEGER(PointerMotionHintMask);
- DEFINE_INTEGER(Button1MotionMask);
- DEFINE_INTEGER(Button2MotionMask);
- DEFINE_INTEGER(Button3MotionMask);
- DEFINE_INTEGER(Button4MotionMask);
- DEFINE_INTEGER(Button5MotionMask);
- DEFINE_INTEGER(ButtonMotionMask);
- DEFINE_INTEGER(KeymapStateMask);
- DEFINE_INTEGER(ExposureMask);
- DEFINE_INTEGER(VisibilityChangeMask);
- DEFINE_INTEGER(StructureNotifyMask);
- DEFINE_INTEGER(ResizeRedirectMask);
- DEFINE_INTEGER(SubstructureNotifyMask);
- DEFINE_INTEGER(SubstructureRedirectMask);
- DEFINE_INTEGER(FocusChangeMask);
- DEFINE_INTEGER(PropertyChangeMask);
- DEFINE_INTEGER(ColormapChangeMask);
- DEFINE_INTEGER(OwnerGrabButtonMask);
- DEFINE_INTEGER(KeyPress);
- DEFINE_INTEGER(KeyRelease);
- DEFINE_INTEGER(ButtonPress);
- DEFINE_INTEGER(ButtonRelease);
- DEFINE_INTEGER(MotionNotify);
- DEFINE_INTEGER(EnterNotify);
- DEFINE_INTEGER(LeaveNotify);
- DEFINE_INTEGER(FocusIn);
- DEFINE_INTEGER(FocusOut);
- DEFINE_INTEGER(KeymapNotify);
- DEFINE_INTEGER(Expose);
- DEFINE_INTEGER(GraphicsExpose);
- DEFINE_INTEGER(NoExpose);
- DEFINE_INTEGER(VisibilityNotify);
- DEFINE_INTEGER(CreateNotify);
- DEFINE_INTEGER(DestroyNotify);
- DEFINE_INTEGER(UnmapNotify);
- DEFINE_INTEGER(MapNotify);
- DEFINE_INTEGER(MapRequest);
- DEFINE_INTEGER(ReparentNotify);
- DEFINE_INTEGER(ConfigureNotify);
- DEFINE_INTEGER(ConfigureRequest);
- DEFINE_INTEGER(GravityNotify);
- DEFINE_INTEGER(ResizeRequest);
- DEFINE_INTEGER(CirculateNotify);
- DEFINE_INTEGER(CirculateRequest);
- DEFINE_INTEGER(PropertyNotify);
- DEFINE_INTEGER(SelectionClear);
- DEFINE_INTEGER(SelectionRequest);
- DEFINE_INTEGER(SelectionNotify);
- DEFINE_INTEGER(ColormapNotify);
- DEFINE_INTEGER(ClientMessage);
- DEFINE_INTEGER(MappingNotify);
- DEFINE_INTEGER(ShiftMask);
- DEFINE_INTEGER(LockMask);
- DEFINE_INTEGER(ControlMask);
- DEFINE_INTEGER(Mod1Mask);
- DEFINE_INTEGER(Mod2Mask);
- DEFINE_INTEGER(Mod3Mask);
- DEFINE_INTEGER(Mod4Mask);
- DEFINE_INTEGER(Mod5Mask);
- DEFINE_INTEGER(ShiftMapIndex);
- DEFINE_INTEGER(LockMapIndex);
- DEFINE_INTEGER(ControlMapIndex);
- DEFINE_INTEGER(Mod1MapIndex);
- DEFINE_INTEGER(Mod2MapIndex);
- DEFINE_INTEGER(Mod3MapIndex);
- DEFINE_INTEGER(Mod4MapIndex);
- DEFINE_INTEGER(Mod5MapIndex);
- DEFINE_INTEGER(Button1Mask);
- DEFINE_INTEGER(Button2Mask);
- DEFINE_INTEGER(Button3Mask);
- DEFINE_INTEGER(Button4Mask);
- DEFINE_INTEGER(Button5Mask);
- DEFINE_INTEGER(AnyModifier);
- DEFINE_INTEGER(Button1);
- DEFINE_INTEGER(Button2);
- DEFINE_INTEGER(Button3);
- DEFINE_INTEGER(Button4);
- DEFINE_INTEGER(Button5);
- DEFINE_INTEGER(NotifyNormal);
- DEFINE_INTEGER(NotifyGrab);
- DEFINE_INTEGER(NotifyUngrab);
- DEFINE_INTEGER(NotifyWhileGrabbed);
- DEFINE_INTEGER(NotifyHint);
- DEFINE_INTEGER(NotifyAncestor);
- DEFINE_INTEGER(NotifyVirtual);
- DEFINE_INTEGER(NotifyInferior);
- DEFINE_INTEGER(NotifyNonlinear);
- DEFINE_INTEGER(NotifyNonlinearVirtual);
- DEFINE_INTEGER(NotifyPointer);
- DEFINE_INTEGER(NotifyPointerRoot);
- DEFINE_INTEGER(NotifyDetailNone);
- DEFINE_INTEGER(VisibilityUnobscured);
- DEFINE_INTEGER(VisibilityPartiallyObscured);
- DEFINE_INTEGER(VisibilityFullyObscured);
- DEFINE_INTEGER(PlaceOnTop);
- DEFINE_INTEGER(PlaceOnBottom);
- DEFINE_INTEGER(FamilyInternet);
- DEFINE_INTEGER(FamilyDECnet);
- DEFINE_INTEGER(FamilyChaos);
- DEFINE_INTEGER(PropertyNewValue);
- DEFINE_INTEGER(PropertyDelete);
- DEFINE_INTEGER(ColormapUninstalled);
- DEFINE_INTEGER(ColormapInstalled);
- DEFINE_INTEGER(GrabModeSync);
- DEFINE_INTEGER(GrabModeAsync);
- DEFINE_INTEGER(GrabSuccess);
- DEFINE_INTEGER(AlreadyGrabbed);
- DEFINE_INTEGER(GrabInvalidTime);
- DEFINE_INTEGER(GrabNotViewable);
- DEFINE_INTEGER(GrabFrozen);
- DEFINE_INTEGER(AsyncPointer);
- DEFINE_INTEGER(SyncPointer);
- DEFINE_INTEGER(ReplayPointer);
- DEFINE_INTEGER(AsyncKeyboard);
- DEFINE_INTEGER(SyncKeyboard);
- DEFINE_INTEGER(ReplayKeyboard);
- DEFINE_INTEGER(AsyncBoth);
- DEFINE_INTEGER(SyncBoth);
- DEFINE_INTEGER(RevertToNone);
- DEFINE_INTEGER(RevertToPointerRoot);
- DEFINE_INTEGER(RevertToParent);
- DEFINE_INTEGER(Success);
- DEFINE_INTEGER(BadRequest);
- DEFINE_INTEGER(BadValue);
- DEFINE_INTEGER(BadWindow);
- DEFINE_INTEGER(BadPixmap);
- DEFINE_INTEGER(BadAtom);
- DEFINE_INTEGER(BadCursor);
- DEFINE_INTEGER(BadFont);
- DEFINE_INTEGER(BadMatch);
- DEFINE_INTEGER(BadDrawable);
- DEFINE_INTEGER(BadAccess);
- DEFINE_INTEGER(BadAlloc);
- DEFINE_INTEGER(BadColor);
- DEFINE_INTEGER(BadGC);
- DEFINE_INTEGER(BadIDChoice);
- DEFINE_INTEGER(BadName);
- DEFINE_INTEGER(BadLength);
- DEFINE_INTEGER(BadImplementation);
- DEFINE_INTEGER(InputOutput);
- DEFINE_INTEGER(InputOnly);
- DEFINE_INTEGER(UnmapGravity);
- DEFINE_INTEGER(NotUseful);
- DEFINE_INTEGER(WhenMapped);
- DEFINE_INTEGER(Always);
- DEFINE_INTEGER(IsUnmapped);
- DEFINE_INTEGER(IsUnviewable);
- DEFINE_INTEGER(IsViewable);
- DEFINE_INTEGER(SetModeInsert);
- DEFINE_INTEGER(SetModeDelete);
- DEFINE_INTEGER(DestroyAll);
- DEFINE_INTEGER(RetainPermanent);
- DEFINE_INTEGER(RetainTemporary);
- DEFINE_INTEGER(CWBackPixmap);
- DEFINE_INTEGER(CWBackPixel);
- DEFINE_INTEGER(CWBorderPixmap);
- DEFINE_INTEGER(CWBorderPixel);
- DEFINE_INTEGER(CWBitGravity);
- DEFINE_INTEGER(CWWinGravity);
- DEFINE_INTEGER(CWBackingStore);
- DEFINE_INTEGER(CWBackingPlanes);
- DEFINE_INTEGER(CWBackingPixel);
- DEFINE_INTEGER(CWOverrideRedirect);
- DEFINE_INTEGER(CWSaveUnder);
- DEFINE_INTEGER(CWEventMask);
- DEFINE_INTEGER(CWDontPropagate);
- DEFINE_INTEGER(CWColormap);
- DEFINE_INTEGER(CWCursor);
- DEFINE_INTEGER(CWX);
- DEFINE_INTEGER(CWY);
- DEFINE_INTEGER(CWWidth);
- DEFINE_INTEGER(CWHeight);
- DEFINE_INTEGER(CWBorderWidth);
- DEFINE_INTEGER(CWSibling);
- DEFINE_INTEGER(CWStackMode);
- DEFINE_INTEGER(ForgetGravity);
- DEFINE_INTEGER(NorthWestGravity);
- DEFINE_INTEGER(NorthGravity);
- DEFINE_INTEGER(NorthEastGravity);
- DEFINE_INTEGER(WestGravity);
- DEFINE_INTEGER(CenterGravity);
- DEFINE_INTEGER(EastGravity);
- DEFINE_INTEGER(SouthWestGravity);
- DEFINE_INTEGER(SouthGravity);
- DEFINE_INTEGER(SouthEastGravity);
- DEFINE_INTEGER(StaticGravity);
- DEFINE_INTEGER(Above);
- DEFINE_INTEGER(Below);
- DEFINE_INTEGER(TopIf);
- DEFINE_INTEGER(BottomIf);
- DEFINE_INTEGER(Opposite);
- DEFINE_INTEGER(RaiseLowest);
- DEFINE_INTEGER(LowerHighest);
- DEFINE_INTEGER(PropModeReplace);
- DEFINE_INTEGER(PropModePrepend);
- DEFINE_INTEGER(PropModeAppend);
- DEFINE_INTEGER(KBKeyClickPercent);
- DEFINE_INTEGER(KBBellPercent);
- DEFINE_INTEGER(KBBellPitch);
- DEFINE_INTEGER(KBBellDuration);
- DEFINE_INTEGER(KBLed);
- DEFINE_INTEGER(KBLedMode);
- DEFINE_INTEGER(KBKey);
- DEFINE_INTEGER(KBAutoRepeatMode);
- DEFINE_INTEGER(AutoRepeatModeOff);
- DEFINE_INTEGER(AutoRepeatModeOn);
- DEFINE_INTEGER(AutoRepeatModeDefault);
- DEFINE_INTEGER(LedModeOff);
- DEFINE_INTEGER(LedModeOn);
- DEFINE_INTEGER(GXclear);
- DEFINE_INTEGER(GXand);
- DEFINE_INTEGER(GXandReverse);
- DEFINE_INTEGER(GXcopy);
- DEFINE_INTEGER(GXandInverted);
- DEFINE_INTEGER(GXnoop);
- DEFINE_INTEGER(GXxor);
- DEFINE_INTEGER(GXor);
- DEFINE_INTEGER(GXnor);
- DEFINE_INTEGER(GXequiv);
- DEFINE_INTEGER(GXinvert);
- DEFINE_INTEGER(GXorReverse);
- DEFINE_INTEGER(GXcopyInverted);
- DEFINE_INTEGER(GXorInverted);
- DEFINE_INTEGER(GXnand);
- DEFINE_INTEGER(GXset);
- DEFINE_INTEGER(LineSolid);
- DEFINE_INTEGER(LineOnOffDash);
- DEFINE_INTEGER(LineDoubleDash);
- DEFINE_INTEGER(CapNotLast);
- DEFINE_INTEGER(CapButt);
- DEFINE_INTEGER(CapRound);
- DEFINE_INTEGER(CapProjecting);
- DEFINE_INTEGER(JoinMiter);
- DEFINE_INTEGER(JoinRound);
- DEFINE_INTEGER(JoinBevel);
- DEFINE_INTEGER(FillSolid);
- DEFINE_INTEGER(FillTiled);
- DEFINE_INTEGER(FillStippled);
- DEFINE_INTEGER(FillOpaqueStippled);
- DEFINE_INTEGER(EvenOddRule);
- DEFINE_INTEGER(WindingRule);
- DEFINE_INTEGER(ClipByChildren);
- DEFINE_INTEGER(IncludeInferiors);
- DEFINE_INTEGER(Unsorted);
- DEFINE_INTEGER(YSorted);
- DEFINE_INTEGER(YXSorted);
- DEFINE_INTEGER(YXBanded);
- DEFINE_INTEGER(CoordModeOrigin);
- DEFINE_INTEGER(CoordModePrevious);
- DEFINE_INTEGER(Complex);
- DEFINE_INTEGER(Nonconvex);
- DEFINE_INTEGER(Convex);
- DEFINE_INTEGER(ArcChord);
- DEFINE_INTEGER(ArcPieSlice);
- DEFINE_INTEGER(GCFunction);
- DEFINE_INTEGER(GCPlaneMask);
- DEFINE_INTEGER(GCForeground);
- DEFINE_INTEGER(GCBackground);
- DEFINE_INTEGER(GCLineWidth);
- DEFINE_INTEGER(GCLineStyle);
- DEFINE_INTEGER(GCCapStyle);
- DEFINE_INTEGER(GCJoinStyle);
- DEFINE_INTEGER(GCFillStyle);
- DEFINE_INTEGER(GCFillRule);
- DEFINE_INTEGER(GCTile);
- DEFINE_INTEGER(GCStipple);
- DEFINE_INTEGER(GCTileStipXOrigin);
- DEFINE_INTEGER(GCTileStipYOrigin);
- DEFINE_INTEGER(GCFont);
- DEFINE_INTEGER(GCSubwindowMode);
- DEFINE_INTEGER(GCGraphicsExposures);
- DEFINE_INTEGER(GCClipXOrigin);
- DEFINE_INTEGER(GCClipYOrigin);
- DEFINE_INTEGER(GCClipMask);
- DEFINE_INTEGER(GCDashOffset);
- DEFINE_INTEGER(GCDashList);
- DEFINE_INTEGER(GCArcMode);
- DEFINE_INTEGER(GCLastBit);
- DEFINE_INTEGER(FontLeftToRight);
- DEFINE_INTEGER(FontRightToLeft);
- DEFINE_INTEGER(FontChange);
- DEFINE_INTEGER(XYBitmap);
- DEFINE_INTEGER(XYPixmap);
- DEFINE_INTEGER(ZPixmap);
- DEFINE_INTEGER(AllocNone);
- DEFINE_INTEGER(AllocAll);
- DEFINE_INTEGER(DoRed);
- DEFINE_INTEGER(DoGreen);
- DEFINE_INTEGER(DoBlue);
- DEFINE_INTEGER(CursorShape);
- DEFINE_INTEGER(TileShape);
- DEFINE_INTEGER(StippleShape);
- DEFINE_INTEGER(MappingSuccess);
- DEFINE_INTEGER(MappingBusy);
- DEFINE_INTEGER(MappingFailed);
- DEFINE_INTEGER(MappingModifier);
- DEFINE_INTEGER(MappingKeyboard);
- DEFINE_INTEGER(MappingPointer);
-
- DEFINE_INTEGER(DontPreferBlanking);
- DEFINE_INTEGER(PreferBlanking);
- DEFINE_INTEGER(DefaultBlanking);
- DEFINE_INTEGER(DisableScreenSaver);
- DEFINE_INTEGER(DisableScreenInterval);
- DEFINE_INTEGER(DontAllowExposures);
- DEFINE_INTEGER(AllowExposures);
- DEFINE_INTEGER(DefaultExposures);
- DEFINE_INTEGER(ScreenSaverReset);
- DEFINE_INTEGER(ScreenSaverActive);
-
- DEFINE_INTEGER(StaticGray);
- DEFINE_INTEGER(GrayScale);
- DEFINE_INTEGER(StaticColor);
- DEFINE_INTEGER(PseudoColor);
- DEFINE_INTEGER(TrueColor);
- DEFINE_INTEGER(DirectColor);
-
-#if HAVE_MOTIF
- DEFINE_INTEGER(XtInputNoneMask);
- DEFINE_INTEGER(XtInputReadMask);
- DEFINE_INTEGER(XtInputWriteMask);
- DEFINE_INTEGER(XtInputExceptMask);
+ define_ulong(AllPlanes);
+ define_integer(XC_num_glyphs);
+ define_integer(XC_X_cursor);
+ define_integer(XC_arrow);
+ define_integer(XC_based_arrow_down);
+ define_integer(XC_based_arrow_up);
+ define_integer(XC_boat);
+ define_integer(XC_bogosity);
+ define_integer(XC_bottom_left_corner);
+ define_integer(XC_bottom_right_corner);
+ define_integer(XC_bottom_side);
+ define_integer(XC_bottom_tee);
+ define_integer(XC_box_spiral);
+ define_integer(XC_center_ptr);
+ define_integer(XC_circle);
+ define_integer(XC_clock);
+ define_integer(XC_coffee_mug);
+ define_integer(XC_cross);
+ define_integer(XC_cross_reverse);
+ define_integer(XC_crosshair);
+ define_integer(XC_diamond_cross);
+ define_integer(XC_dot);
+ define_integer(XC_dotbox);
+ define_integer(XC_double_arrow);
+ define_integer(XC_draft_large);
+ define_integer(XC_draft_small);
+ define_integer(XC_draped_box);
+ define_integer(XC_exchange);
+ define_integer(XC_fleur);
+ define_integer(XC_gobbler);
+ define_integer(XC_gumby);
+ define_integer(XC_hand1);
+ define_integer(XC_hand2);
+ define_integer(XC_heart);
+ define_integer(XC_icon);
+ define_integer(XC_iron_cross);
+ define_integer(XC_left_ptr);
+ define_integer(XC_left_side);
+ define_integer(XC_left_tee);
+ define_integer(XC_leftbutton);
+ define_integer(XC_ll_angle);
+ define_integer(XC_lr_angle);
+ define_integer(XC_man);
+ define_integer(XC_middlebutton);
+ define_integer(XC_mouse);
+ define_integer(XC_pencil);
+ define_integer(XC_pirate);
+ define_integer(XC_plus);
+ define_integer(XC_question_arrow);
+ define_integer(XC_right_ptr);
+ define_integer(XC_right_side);
+ define_integer(XC_right_tee);
+ define_integer(XC_rightbutton);
+ define_integer(XC_rtl_logo);
+ define_integer(XC_sailboat);
+ define_integer(XC_sb_down_arrow);
+ define_integer(XC_sb_h_double_arrow);
+ define_integer(XC_sb_left_arrow);
+ define_integer(XC_sb_right_arrow);
+ define_integer(XC_sb_up_arrow);
+ define_integer(XC_sb_v_double_arrow);
+ define_integer(XC_shuttle);
+ define_integer(XC_sizing);
+ define_integer(XC_spider);
+ define_integer(XC_spraycan);
+ define_integer(XC_star);
+ define_integer(XC_target);
+ define_integer(XC_tcross);
+ define_integer(XC_top_left_arrow);
+ define_integer(XC_top_left_corner);
+ define_integer(XC_top_right_corner);
+ define_integer(XC_top_side);
+ define_integer(XC_top_tee);
+ define_integer(XC_trek);
+ define_integer(XC_ul_angle);
+ define_integer(XC_umbrella);
+ define_integer(XC_ur_angle);
+ define_integer(XC_watch);
+ define_integer(XC_xterm);
+ define_integer(None);
+ define_integer(ParentRelative);
+ define_integer(CopyFromParent);
+ define_integer(PointerWindow);
+ define_integer(InputFocus);
+ define_integer(PointerRoot);
+ define_integer(AnyPropertyType);
+ define_integer(AnyKey);
+ define_integer(AnyButton);
+ define_integer(AllTemporary);
+ define_integer(CurrentTime);
+ define_integer(NoSymbol);
+ define_integer(NoEventMask);
+ define_integer(KeyPressMask);
+ define_integer(KeyReleaseMask);
+ define_integer(ButtonPressMask);
+ define_integer(ButtonReleaseMask);
+ define_integer(EnterWindowMask);
+ define_integer(LeaveWindowMask);
+ define_integer(PointerMotionMask);
+ define_integer(PointerMotionHintMask);
+ define_integer(Button1MotionMask);
+ define_integer(Button2MotionMask);
+ define_integer(Button3MotionMask);
+ define_integer(Button4MotionMask);
+ define_integer(Button5MotionMask);
+ define_integer(ButtonMotionMask);
+ define_integer(KeymapStateMask);
+ define_integer(ExposureMask);
+ define_integer(VisibilityChangeMask);
+ define_integer(StructureNotifyMask);
+ define_integer(ResizeRedirectMask);
+ define_integer(SubstructureNotifyMask);
+ define_integer(SubstructureRedirectMask);
+ define_integer(FocusChangeMask);
+ define_integer(PropertyChangeMask);
+ define_integer(ColormapChangeMask);
+ define_integer(OwnerGrabButtonMask);
+ define_integer(KeyPress);
+ define_integer(KeyRelease);
+ define_integer(ButtonPress);
+ define_integer(ButtonRelease);
+ define_integer(MotionNotify);
+ define_integer(EnterNotify);
+ define_integer(LeaveNotify);
+ define_integer(FocusIn);
+ define_integer(FocusOut);
+ define_integer(KeymapNotify);
+ define_integer(Expose);
+ define_integer(GraphicsExpose);
+ define_integer(NoExpose);
+ define_integer(VisibilityNotify);
+ define_integer(CreateNotify);
+ define_integer(DestroyNotify);
+ define_integer(UnmapNotify);
+ define_integer(MapNotify);
+ define_integer(MapRequest);
+ define_integer(ReparentNotify);
+ define_integer(ConfigureNotify);
+ define_integer(ConfigureRequest);
+ define_integer(GravityNotify);
+ define_integer(ResizeRequest);
+ define_integer(CirculateNotify);
+ define_integer(CirculateRequest);
+ define_integer(PropertyNotify);
+ define_integer(SelectionClear);
+ define_integer(SelectionRequest);
+ define_integer(SelectionNotify);
+ define_integer(ColormapNotify);
+ define_integer(ClientMessage);
+ define_integer(MappingNotify);
+ define_integer(ShiftMask);
+ define_integer(LockMask);
+ define_integer(ControlMask);
+ define_integer(Mod1Mask);
+ define_integer(Mod2Mask);
+ define_integer(Mod3Mask);
+ define_integer(Mod4Mask);
+ define_integer(Mod5Mask);
+ define_integer(ShiftMapIndex);
+ define_integer(LockMapIndex);
+ define_integer(ControlMapIndex);
+ define_integer(Mod1MapIndex);
+ define_integer(Mod2MapIndex);
+ define_integer(Mod3MapIndex);
+ define_integer(Mod4MapIndex);
+ define_integer(Mod5MapIndex);
+ define_integer(Button1Mask);
+ define_integer(Button2Mask);
+ define_integer(Button3Mask);
+ define_integer(Button4Mask);
+ define_integer(Button5Mask);
+ define_integer(AnyModifier);
+ define_integer(Button1);
+ define_integer(Button2);
+ define_integer(Button3);
+ define_integer(Button4);
+ define_integer(Button5);
+ define_integer(NotifyNormal);
+ define_integer(NotifyGrab);
+ define_integer(NotifyUngrab);
+ define_integer(NotifyWhileGrabbed);
+ define_integer(NotifyHint);
+ define_integer(NotifyAncestor);
+ define_integer(NotifyVirtual);
+ define_integer(NotifyInferior);
+ define_integer(NotifyNonlinear);
+ define_integer(NotifyNonlinearVirtual);
+ define_integer(NotifyPointer);
+ define_integer(NotifyPointerRoot);
+ define_integer(NotifyDetailNone);
+ define_integer(VisibilityUnobscured);
+ define_integer(VisibilityPartiallyObscured);
+ define_integer(VisibilityFullyObscured);
+ define_integer(PlaceOnTop);
+ define_integer(PlaceOnBottom);
+ define_integer(FamilyInternet);
+ define_integer(FamilyDECnet);
+ define_integer(FamilyChaos);
+ define_integer(PropertyNewValue);
+ define_integer(PropertyDelete);
+ define_integer(ColormapUninstalled);
+ define_integer(ColormapInstalled);
+ define_integer(GrabModeSync);
+ define_integer(GrabModeAsync);
+ define_integer(GrabSuccess);
+ define_integer(AlreadyGrabbed);
+ define_integer(GrabInvalidTime);
+ define_integer(GrabNotViewable);
+ define_integer(GrabFrozen);
+ define_integer(AsyncPointer);
+ define_integer(SyncPointer);
+ define_integer(ReplayPointer);
+ define_integer(AsyncKeyboard);
+ define_integer(SyncKeyboard);
+ define_integer(ReplayKeyboard);
+ define_integer(AsyncBoth);
+ define_integer(SyncBoth);
+ define_integer(RevertToNone);
+ define_integer(RevertToPointerRoot);
+ define_integer(RevertToParent);
+ define_integer(Success);
+ define_integer(BadRequest);
+ define_integer(BadValue);
+ define_integer(BadWindow);
+ define_integer(BadPixmap);
+ define_integer(BadAtom);
+ define_integer(BadCursor);
+ define_integer(BadFont);
+ define_integer(BadMatch);
+ define_integer(BadDrawable);
+ define_integer(BadAccess);
+ define_integer(BadAlloc);
+ define_integer(BadColor);
+ define_integer(BadGC);
+ define_integer(BadIDChoice);
+ define_integer(BadName);
+ define_integer(BadLength);
+ define_integer(BadImplementation);
+ define_integer(InputOutput);
+ define_integer(InputOnly);
+ define_integer(UnmapGravity);
+ define_integer(NotUseful);
+ define_integer(WhenMapped);
+ define_integer(Always);
+ define_integer(IsUnmapped);
+ define_integer(IsUnviewable);
+ define_integer(IsViewable);
+ define_integer(SetModeInsert);
+ define_integer(SetModeDelete);
+ define_integer(DestroyAll);
+ define_integer(RetainPermanent);
+ define_integer(RetainTemporary);
+ define_integer(CWBackPixmap);
+ define_integer(CWBackPixel);
+ define_integer(CWBorderPixmap);
+ define_integer(CWBorderPixel);
+ define_integer(CWBitGravity);
+ define_integer(CWWinGravity);
+ define_integer(CWBackingStore);
+ define_integer(CWBackingPlanes);
+ define_integer(CWBackingPixel);
+ define_integer(CWOverrideRedirect);
+ define_integer(CWSaveUnder);
+ define_integer(CWEventMask);
+ define_integer(CWDontPropagate);
+ define_integer(CWColormap);
+ define_integer(CWCursor);
+ define_integer(CWX);
+ define_integer(CWY);
+ define_integer(CWWidth);
+ define_integer(CWHeight);
+ define_integer(CWBorderWidth);
+ define_integer(CWSibling);
+ define_integer(CWStackMode);
+ define_integer(ForgetGravity);
+ define_integer(NorthWestGravity);
+ define_integer(NorthGravity);
+ define_integer(NorthEastGravity);
+ define_integer(WestGravity);
+ define_integer(CenterGravity);
+ define_integer(EastGravity);
+ define_integer(SouthWestGravity);
+ define_integer(SouthGravity);
+ define_integer(SouthEastGravity);
+ define_integer(StaticGravity);
+ define_integer(Above);
+ define_integer(Below);
+ define_integer(TopIf);
+ define_integer(BottomIf);
+ define_integer(Opposite);
+ define_integer(RaiseLowest);
+ define_integer(LowerHighest);
+ define_integer(PropModeReplace);
+ define_integer(PropModePrepend);
+ define_integer(PropModeAppend);
+ define_integer(KBKeyClickPercent);
+ define_integer(KBBellPercent);
+ define_integer(KBBellPitch);
+ define_integer(KBBellDuration);
+ define_integer(KBLed);
+ define_integer(KBLedMode);
+ define_integer(KBKey);
+ define_integer(KBAutoRepeatMode);
+ define_integer(AutoRepeatModeOff);
+ define_integer(AutoRepeatModeOn);
+ define_integer(AutoRepeatModeDefault);
+ define_integer(LedModeOff);
+ define_integer(LedModeOn);
+ define_integer(GXclear);
+ define_integer(GXand);
+ define_integer(GXandReverse);
+ define_integer(GXcopy);
+ define_integer(GXandInverted);
+ define_integer(GXnoop);
+ define_integer(GXxor);
+ define_integer(GXor);
+ define_integer(GXnor);
+ define_integer(GXequiv);
+ define_integer(GXinvert);
+ define_integer(GXorReverse);
+ define_integer(GXcopyInverted);
+ define_integer(GXorInverted);
+ define_integer(GXnand);
+ define_integer(GXset);
+ define_integer(LineSolid);
+ define_integer(LineOnOffDash);
+ define_integer(LineDoubleDash);
+ define_integer(CapNotLast);
+ define_integer(CapButt);
+ define_integer(CapRound);
+ define_integer(CapProjecting);
+ define_integer(JoinMiter);
+ define_integer(JoinRound);
+ define_integer(JoinBevel);
+ define_integer(FillSolid);
+ define_integer(FillTiled);
+ define_integer(FillStippled);
+ define_integer(FillOpaqueStippled);
+ define_integer(EvenOddRule);
+ define_integer(WindingRule);
+ define_integer(ClipByChildren);
+ define_integer(IncludeInferiors);
+ define_integer(Unsorted);
+ define_integer(YSorted);
+ define_integer(YXSorted);
+ define_integer(YXBanded);
+ define_integer(CoordModeOrigin);
+ define_integer(CoordModePrevious);
+ define_integer(Complex);
+ define_integer(Nonconvex);
+ define_integer(Convex);
+ define_integer(ArcChord);
+ define_integer(ArcPieSlice);
+ define_integer(GCFunction);
+ define_integer(GCPlaneMask);
+ define_integer(GCForeground);
+ define_integer(GCBackground);
+ define_integer(GCLineWidth);
+ define_integer(GCLineStyle);
+ define_integer(GCCapStyle);
+ define_integer(GCJoinStyle);
+ define_integer(GCFillStyle);
+ define_integer(GCFillRule);
+ define_integer(GCTile);
+ define_integer(GCStipple);
+ define_integer(GCTileStipXOrigin);
+ define_integer(GCTileStipYOrigin);
+ define_integer(GCFont);
+ define_integer(GCSubwindowMode);
+ define_integer(GCGraphicsExposures);
+ define_integer(GCClipXOrigin);
+ define_integer(GCClipYOrigin);
+ define_integer(GCClipMask);
+ define_integer(GCDashOffset);
+ define_integer(GCDashList);
+ define_integer(GCArcMode);
+ define_integer(GCLastBit);
+ define_integer(FontLeftToRight);
+ define_integer(FontRightToLeft);
+ define_integer(FontChange);
+ define_integer(XYBitmap);
+ define_integer(XYPixmap);
+ define_integer(ZPixmap);
+ define_integer(AllocNone);
+ define_integer(AllocAll);
+ define_integer(DoRed);
+ define_integer(DoGreen);
+ define_integer(DoBlue);
+ define_integer(CursorShape);
+ define_integer(TileShape);
+ define_integer(StippleShape);
+ define_integer(MappingSuccess);
+ define_integer(MappingBusy);
+ define_integer(MappingFailed);
+ define_integer(MappingModifier);
+ define_integer(MappingKeyboard);
+ define_integer(MappingPointer);
+
+ define_integer(DontPreferBlanking);
+ define_integer(PreferBlanking);
+ define_integer(DefaultBlanking);
+ define_integer(DisableScreenSaver);
+ define_integer(DisableScreenInterval);
+ define_integer(DontAllowExposures);
+ define_integer(AllowExposures);
+ define_integer(DefaultExposures);
+ define_integer(ScreenSaverReset);
+ define_integer(ScreenSaverActive);
+
+ define_integer(StaticGray);
+ define_integer(GrayScale);
+ define_integer(StaticColor);
+ define_integer(PseudoColor);
+ define_integer(TrueColor);
+ define_integer(DirectColor);
+
+ define_integer(XtInputNoneMask);
+ define_integer(XtInputReadMask);
+ define_integer(XtInputWriteMask);
+ define_integer(XtInputExceptMask);
/* XtAllEvents is unsigned long EventMask: #define XtAllEvents ((EventMask) -1L)
* which I assume should be positive
*/
#if 0
- DEFINE_INTEGER(XtAllEvents);
+ define_integer(XtAllEvents);
#else
- DEFINE_ULONG(XtAllEvents);
+ define_ulong(XtAllEvents);
#endif
- DEFINE_INTEGER(XtIMXEvent);
- DEFINE_INTEGER(XtIMTimer);
- DEFINE_INTEGER(XtIMAlternateInput);
- DEFINE_INTEGER(XtIMSignal);
- DEFINE_INTEGER(XtIMAll);
- DEFINE_INTEGER(XtUnspecifiedPixmap);
- DEFINE_INTEGER(XtUnspecifiedShellInt);
- DEFINE_INTEGER(XtUnspecifiedWindow);
- DEFINE_INTEGER(XtUnspecifiedWindowGroup);
- DEFINE_INTEGER(XT_CONVERT_FAIL);
-#endif
- DEFINE_INTEGER(XlibSpecificationRelease);
- DEFINE_INTEGER(QueuedAlready);
- DEFINE_INTEGER(QueuedAfterReading);
- DEFINE_INTEGER(QueuedAfterFlush);
- DEFINE_INTEGER(XBufferOverflow);
- DEFINE_INTEGER(XLookupNone);
- DEFINE_INTEGER(XLookupChars);
- DEFINE_INTEGER(XLookupKeySym);
- DEFINE_INTEGER(XLookupBoth);
- DEFINE_INTEGER(XK_VoidSymbol);
- DEFINE_INTEGER(XK_BackSpace);
- DEFINE_INTEGER(XK_Tab);
- DEFINE_INTEGER(XK_Linefeed);
- DEFINE_INTEGER(XK_Clear);
- DEFINE_INTEGER(XK_Return);
- DEFINE_INTEGER(XK_Pause);
- DEFINE_INTEGER(XK_Scroll_Lock);
- DEFINE_INTEGER(XK_Sys_Req);
- DEFINE_INTEGER(XK_Escape);
- DEFINE_INTEGER(XK_Delete);
- DEFINE_INTEGER(XK_Home);
- DEFINE_INTEGER(XK_Left);
- DEFINE_INTEGER(XK_Up);
- DEFINE_INTEGER(XK_Right);
- DEFINE_INTEGER(XK_Down);
- DEFINE_INTEGER(XK_Prior);
- DEFINE_INTEGER(XK_Page_Up);
- DEFINE_INTEGER(XK_Next);
- DEFINE_INTEGER(XK_Page_Down);
- DEFINE_INTEGER(XK_End);
- DEFINE_INTEGER(XK_Begin);
- DEFINE_INTEGER(XK_Select);
- DEFINE_INTEGER(XK_Print);
- DEFINE_INTEGER(XK_Execute);
- DEFINE_INTEGER(XK_Insert);
- DEFINE_INTEGER(XK_Undo);
- DEFINE_INTEGER(XK_Redo);
- DEFINE_INTEGER(XK_Menu);
- DEFINE_INTEGER(XK_Find);
- DEFINE_INTEGER(XK_Cancel);
- DEFINE_INTEGER(XK_Help);
- DEFINE_INTEGER(XK_Break);
- DEFINE_INTEGER(XK_Mode_switch);
- DEFINE_INTEGER(XK_script_switch);
- DEFINE_INTEGER(XK_Num_Lock);
- DEFINE_INTEGER(XK_KP_Space);
- DEFINE_INTEGER(XK_KP_Tab);
- DEFINE_INTEGER(XK_KP_Enter);
- DEFINE_INTEGER(XK_KP_F1);
- DEFINE_INTEGER(XK_KP_F2);
- DEFINE_INTEGER(XK_KP_F3);
- DEFINE_INTEGER(XK_KP_F4);
- DEFINE_INTEGER(XK_KP_Home);
- DEFINE_INTEGER(XK_KP_Left);
- DEFINE_INTEGER(XK_KP_Up);
- DEFINE_INTEGER(XK_KP_Right);
- DEFINE_INTEGER(XK_KP_Down);
- DEFINE_INTEGER(XK_KP_Prior);
- DEFINE_INTEGER(XK_KP_Page_Up);
- DEFINE_INTEGER(XK_KP_Next);
- DEFINE_INTEGER(XK_KP_Page_Down);
- DEFINE_INTEGER(XK_KP_End);
- DEFINE_INTEGER(XK_KP_Begin);
- DEFINE_INTEGER(XK_KP_Insert);
- DEFINE_INTEGER(XK_KP_Delete);
- DEFINE_INTEGER(XK_KP_Equal);
- DEFINE_INTEGER(XK_KP_Multiply);
- DEFINE_INTEGER(XK_KP_Add);
- DEFINE_INTEGER(XK_KP_Separator);
- DEFINE_INTEGER(XK_KP_Subtract);
- DEFINE_INTEGER(XK_KP_Decimal);
- DEFINE_INTEGER(XK_KP_Divide);
- DEFINE_INTEGER(XK_KP_0);
- DEFINE_INTEGER(XK_KP_1);
- DEFINE_INTEGER(XK_KP_2);
- DEFINE_INTEGER(XK_KP_3);
- DEFINE_INTEGER(XK_KP_4);
- DEFINE_INTEGER(XK_KP_5);
- DEFINE_INTEGER(XK_KP_6);
- DEFINE_INTEGER(XK_KP_7);
- DEFINE_INTEGER(XK_KP_8);
- DEFINE_INTEGER(XK_KP_9);
- DEFINE_INTEGER(XK_F1);
- DEFINE_INTEGER(XK_F2);
- DEFINE_INTEGER(XK_F3);
- DEFINE_INTEGER(XK_F4);
- DEFINE_INTEGER(XK_F5);
- DEFINE_INTEGER(XK_F6);
- DEFINE_INTEGER(XK_F7);
- DEFINE_INTEGER(XK_F8);
- DEFINE_INTEGER(XK_F9);
- DEFINE_INTEGER(XK_F10);
- DEFINE_INTEGER(XK_F11);
- DEFINE_INTEGER(XK_L1);
- DEFINE_INTEGER(XK_F12);
- DEFINE_INTEGER(XK_L2);
- DEFINE_INTEGER(XK_F13);
- DEFINE_INTEGER(XK_L3);
- DEFINE_INTEGER(XK_F14);
- DEFINE_INTEGER(XK_L4);
- DEFINE_INTEGER(XK_F15);
- DEFINE_INTEGER(XK_L5);
- DEFINE_INTEGER(XK_F16);
- DEFINE_INTEGER(XK_L6);
- DEFINE_INTEGER(XK_F17);
- DEFINE_INTEGER(XK_L7);
- DEFINE_INTEGER(XK_F18);
- DEFINE_INTEGER(XK_L8);
- DEFINE_INTEGER(XK_F19);
- DEFINE_INTEGER(XK_L9);
- DEFINE_INTEGER(XK_F20);
- DEFINE_INTEGER(XK_L10);
- DEFINE_INTEGER(XK_F21);
- DEFINE_INTEGER(XK_R1);
- DEFINE_INTEGER(XK_F22);
- DEFINE_INTEGER(XK_R2);
- DEFINE_INTEGER(XK_F23);
- DEFINE_INTEGER(XK_R3);
- DEFINE_INTEGER(XK_F24);
- DEFINE_INTEGER(XK_R4);
- DEFINE_INTEGER(XK_F25);
- DEFINE_INTEGER(XK_R5);
- DEFINE_INTEGER(XK_F26);
- DEFINE_INTEGER(XK_R6);
- DEFINE_INTEGER(XK_F27);
- DEFINE_INTEGER(XK_R7);
- DEFINE_INTEGER(XK_F28);
- DEFINE_INTEGER(XK_R8);
- DEFINE_INTEGER(XK_F29);
- DEFINE_INTEGER(XK_R9);
- DEFINE_INTEGER(XK_F30);
- DEFINE_INTEGER(XK_R10);
- DEFINE_INTEGER(XK_F31);
- DEFINE_INTEGER(XK_R11);
- DEFINE_INTEGER(XK_F32);
- DEFINE_INTEGER(XK_R12);
- DEFINE_INTEGER(XK_F33);
- DEFINE_INTEGER(XK_R13);
- DEFINE_INTEGER(XK_F34);
- DEFINE_INTEGER(XK_R14);
- DEFINE_INTEGER(XK_F35);
- DEFINE_INTEGER(XK_R15);
- DEFINE_INTEGER(XK_Shift_L);
- DEFINE_INTEGER(XK_Shift_R);
- DEFINE_INTEGER(XK_Control_L);
- DEFINE_INTEGER(XK_Control_R);
- DEFINE_INTEGER(XK_Caps_Lock);
- DEFINE_INTEGER(XK_Shift_Lock);
- DEFINE_INTEGER(XK_Meta_L);
- DEFINE_INTEGER(XK_Meta_R);
- DEFINE_INTEGER(XK_Alt_L);
- DEFINE_INTEGER(XK_Alt_R);
- DEFINE_INTEGER(XK_Super_L);
- DEFINE_INTEGER(XK_Super_R);
- DEFINE_INTEGER(XK_Hyper_L);
- DEFINE_INTEGER(XK_Hyper_R);
- DEFINE_INTEGER(XK_space);
- DEFINE_INTEGER(XK_exclam);
- DEFINE_INTEGER(XK_quotedbl);
- DEFINE_INTEGER(XK_numbersign);
- DEFINE_INTEGER(XK_dollar);
- DEFINE_INTEGER(XK_percent);
- DEFINE_INTEGER(XK_ampersand);
- DEFINE_INTEGER(XK_apostrophe);
- DEFINE_INTEGER(XK_quoteright);
- DEFINE_INTEGER(XK_parenleft);
- DEFINE_INTEGER(XK_parenright);
- DEFINE_INTEGER(XK_asterisk);
- DEFINE_INTEGER(XK_plus);
- DEFINE_INTEGER(XK_comma);
- DEFINE_INTEGER(XK_minus);
- DEFINE_INTEGER(XK_period);
- DEFINE_INTEGER(XK_slash);
- DEFINE_INTEGER(XK_0);
- DEFINE_INTEGER(XK_1);
- DEFINE_INTEGER(XK_2);
- DEFINE_INTEGER(XK_3);
- DEFINE_INTEGER(XK_4);
- DEFINE_INTEGER(XK_5);
- DEFINE_INTEGER(XK_6);
- DEFINE_INTEGER(XK_7);
- DEFINE_INTEGER(XK_8);
- DEFINE_INTEGER(XK_9);
- DEFINE_INTEGER(XK_colon);
- DEFINE_INTEGER(XK_semicolon);
- DEFINE_INTEGER(XK_less);
- DEFINE_INTEGER(XK_equal);
- DEFINE_INTEGER(XK_greater);
- DEFINE_INTEGER(XK_question);
- DEFINE_INTEGER(XK_at);
- DEFINE_INTEGER(XK_A);
- DEFINE_INTEGER(XK_B);
- DEFINE_INTEGER(XK_C);
- DEFINE_INTEGER(XK_D);
- DEFINE_INTEGER(XK_E);
- DEFINE_INTEGER(XK_F);
- DEFINE_INTEGER(XK_G);
- DEFINE_INTEGER(XK_H);
- DEFINE_INTEGER(XK_I);
- DEFINE_INTEGER(XK_J);
- DEFINE_INTEGER(XK_K);
- DEFINE_INTEGER(XK_L);
- DEFINE_INTEGER(XK_M);
- DEFINE_INTEGER(XK_N);
- DEFINE_INTEGER(XK_O);
- DEFINE_INTEGER(XK_P);
- DEFINE_INTEGER(XK_Q);
- DEFINE_INTEGER(XK_R);
- DEFINE_INTEGER(XK_S);
- DEFINE_INTEGER(XK_T);
- DEFINE_INTEGER(XK_U);
- DEFINE_INTEGER(XK_V);
- DEFINE_INTEGER(XK_W);
- DEFINE_INTEGER(XK_X);
- DEFINE_INTEGER(XK_Y);
- DEFINE_INTEGER(XK_Z);
- DEFINE_INTEGER(XK_bracketleft);
- DEFINE_INTEGER(XK_backslash);
- DEFINE_INTEGER(XK_bracketright);
- DEFINE_INTEGER(XK_asciicircum);
- DEFINE_INTEGER(XK_underscore);
- DEFINE_INTEGER(XK_grave);
- DEFINE_INTEGER(XK_quoteleft);
- DEFINE_INTEGER(XK_a);
- DEFINE_INTEGER(XK_b);
- DEFINE_INTEGER(XK_c);
- DEFINE_INTEGER(XK_d);
- DEFINE_INTEGER(XK_e);
- DEFINE_INTEGER(XK_f);
- DEFINE_INTEGER(XK_g);
- DEFINE_INTEGER(XK_h);
- DEFINE_INTEGER(XK_i);
- DEFINE_INTEGER(XK_j);
- DEFINE_INTEGER(XK_k);
- DEFINE_INTEGER(XK_l);
- DEFINE_INTEGER(XK_m);
- DEFINE_INTEGER(XK_n);
- DEFINE_INTEGER(XK_o);
- DEFINE_INTEGER(XK_p);
- DEFINE_INTEGER(XK_q);
- DEFINE_INTEGER(XK_r);
- DEFINE_INTEGER(XK_s);
- DEFINE_INTEGER(XK_t);
- DEFINE_INTEGER(XK_u);
- DEFINE_INTEGER(XK_v);
- DEFINE_INTEGER(XK_w);
- DEFINE_INTEGER(XK_x);
- DEFINE_INTEGER(XK_y);
- DEFINE_INTEGER(XK_z);
- DEFINE_INTEGER(XK_braceleft);
- DEFINE_INTEGER(XK_bar);
- DEFINE_INTEGER(XK_braceright);
- DEFINE_INTEGER(XK_asciitilde);
- DEFINE_INTEGER(XK_nobreakspace);
- DEFINE_INTEGER(XK_exclamdown);
- DEFINE_INTEGER(XK_cent);
- DEFINE_INTEGER(XK_sterling);
- DEFINE_INTEGER(XK_currency);
- DEFINE_INTEGER(XK_yen);
- DEFINE_INTEGER(XK_brokenbar);
- DEFINE_INTEGER(XK_section);
- DEFINE_INTEGER(XK_diaeresis);
- DEFINE_INTEGER(XK_copyright);
- DEFINE_INTEGER(XK_ordfeminine);
- DEFINE_INTEGER(XK_guillemotleft);
- DEFINE_INTEGER(XK_notsign);
- DEFINE_INTEGER(XK_hyphen);
- DEFINE_INTEGER(XK_registered);
- DEFINE_INTEGER(XK_macron);
- DEFINE_INTEGER(XK_degree);
- DEFINE_INTEGER(XK_plusminus);
- DEFINE_INTEGER(XK_twosuperior);
- DEFINE_INTEGER(XK_threesuperior);
- DEFINE_INTEGER(XK_acute);
- DEFINE_INTEGER(XK_mu);
- DEFINE_INTEGER(XK_paragraph);
- DEFINE_INTEGER(XK_periodcentered);
- DEFINE_INTEGER(XK_cedilla);
- DEFINE_INTEGER(XK_onesuperior);
- DEFINE_INTEGER(XK_masculine);
- DEFINE_INTEGER(XK_guillemotright);
- DEFINE_INTEGER(XK_onequarter);
- DEFINE_INTEGER(XK_onehalf);
- DEFINE_INTEGER(XK_threequarters);
- DEFINE_INTEGER(XK_questiondown);
- DEFINE_INTEGER(XK_Agrave);
- DEFINE_INTEGER(XK_Aacute);
- DEFINE_INTEGER(XK_Acircumflex);
- DEFINE_INTEGER(XK_Atilde);
- DEFINE_INTEGER(XK_Adiaeresis);
- DEFINE_INTEGER(XK_Aring);
- DEFINE_INTEGER(XK_AE);
- DEFINE_INTEGER(XK_Ccedilla);
- DEFINE_INTEGER(XK_Egrave);
- DEFINE_INTEGER(XK_Eacute);
- DEFINE_INTEGER(XK_Ecircumflex);
- DEFINE_INTEGER(XK_Ediaeresis);
- DEFINE_INTEGER(XK_Igrave);
- DEFINE_INTEGER(XK_Iacute);
- DEFINE_INTEGER(XK_Icircumflex);
- DEFINE_INTEGER(XK_Idiaeresis);
- DEFINE_INTEGER(XK_ETH);
- DEFINE_INTEGER(XK_Eth);
- DEFINE_INTEGER(XK_Ntilde);
- DEFINE_INTEGER(XK_Ograve);
- DEFINE_INTEGER(XK_Oacute);
- DEFINE_INTEGER(XK_Ocircumflex);
- DEFINE_INTEGER(XK_Otilde);
- DEFINE_INTEGER(XK_Odiaeresis);
- DEFINE_INTEGER(XK_multiply);
- DEFINE_INTEGER(XK_Ooblique);
- DEFINE_INTEGER(XK_Ugrave);
- DEFINE_INTEGER(XK_Uacute);
- DEFINE_INTEGER(XK_Ucircumflex);
- DEFINE_INTEGER(XK_Udiaeresis);
- DEFINE_INTEGER(XK_Yacute);
- DEFINE_INTEGER(XK_THORN);
- DEFINE_INTEGER(XK_Thorn);
- DEFINE_INTEGER(XK_ssharp);
- DEFINE_INTEGER(XK_agrave);
- DEFINE_INTEGER(XK_aacute);
- DEFINE_INTEGER(XK_acircumflex);
- DEFINE_INTEGER(XK_atilde);
- DEFINE_INTEGER(XK_adiaeresis);
- DEFINE_INTEGER(XK_aring);
- DEFINE_INTEGER(XK_ae);
- DEFINE_INTEGER(XK_ccedilla);
- DEFINE_INTEGER(XK_egrave);
- DEFINE_INTEGER(XK_eacute);
- DEFINE_INTEGER(XK_ecircumflex);
- DEFINE_INTEGER(XK_ediaeresis);
- DEFINE_INTEGER(XK_igrave);
- DEFINE_INTEGER(XK_iacute);
- DEFINE_INTEGER(XK_icircumflex);
- DEFINE_INTEGER(XK_idiaeresis);
- DEFINE_INTEGER(XK_eth);
- DEFINE_INTEGER(XK_ntilde);
- DEFINE_INTEGER(XK_ograve);
- DEFINE_INTEGER(XK_oacute);
- DEFINE_INTEGER(XK_ocircumflex);
- DEFINE_INTEGER(XK_otilde);
- DEFINE_INTEGER(XK_odiaeresis);
- DEFINE_INTEGER(XK_division);
- DEFINE_INTEGER(XK_oslash);
- DEFINE_INTEGER(XK_ugrave);
- DEFINE_INTEGER(XK_uacute);
- DEFINE_INTEGER(XK_ucircumflex);
- DEFINE_INTEGER(XK_udiaeresis);
- DEFINE_INTEGER(XK_yacute);
- DEFINE_INTEGER(XK_thorn);
- DEFINE_INTEGER(XK_ydiaeresis);
-
- DEFINE_INTEGER(XpmFormat);
- DEFINE_INTEGER(XpmVersion);
- DEFINE_INTEGER(XpmRevision);
- DEFINE_INTEGER(XpmIncludeVersion);
- DEFINE_INTEGER(XpmColorError);
- DEFINE_INTEGER(XpmSuccess);
- DEFINE_INTEGER(XpmOpenFailed);
- DEFINE_INTEGER(XpmFileInvalid);
- DEFINE_INTEGER(XpmNoMemory);
- DEFINE_INTEGER(XpmColorFailed);
- DEFINE_INTEGER(XpmVisual);
- DEFINE_INTEGER(XpmColormap);
- DEFINE_INTEGER(XpmDepth);
- DEFINE_INTEGER(XpmSize);
- DEFINE_INTEGER(XpmHotspot);
- DEFINE_INTEGER(XpmCharsPerPixel);
- DEFINE_INTEGER(XpmColorSymbols);
- DEFINE_INTEGER(XpmRgbFilename);
- DEFINE_INTEGER(XpmInfos);
- DEFINE_INTEGER(XpmReturnInfos);
- DEFINE_INTEGER(XpmReturnPixels);
- DEFINE_INTEGER(XpmExtensions);
- DEFINE_INTEGER(XpmReturnExtensions);
- DEFINE_INTEGER(XpmExactColors);
- DEFINE_INTEGER(XpmCloseness);
- DEFINE_INTEGER(XpmRGBCloseness);
- DEFINE_INTEGER(XpmColorKey);
- DEFINE_INTEGER(XpmColorTable);
- DEFINE_INTEGER(XpmReturnColorTable);
+ define_integer(XtIMXEvent);
+ define_integer(XtIMTimer);
+ define_integer(XtIMAlternateInput);
+ define_integer(XtIMSignal);
+ define_integer(XtIMAll);
+ define_integer(XtUnspecifiedPixmap);
+ define_integer(XtUnspecifiedShellInt);
+ define_integer(XtUnspecifiedWindow);
+ define_integer(XtUnspecifiedWindowGroup);
+ define_integer(XT_CONVERT_FAIL);
+
+ define_integer(XlibSpecificationRelease);
+ define_integer(QueuedAlready);
+ define_integer(QueuedAfterReading);
+ define_integer(QueuedAfterFlush);
+ define_integer(XBufferOverflow);
+ define_integer(XLookupNone);
+ define_integer(XLookupChars);
+ define_integer(XLookupKeySym);
+ define_integer(XLookupBoth);
+ define_integer(XK_VoidSymbol);
+ define_integer(XK_BackSpace);
+ define_integer(XK_Tab);
+ define_integer(XK_Linefeed);
+ define_integer(XK_Clear);
+ define_integer(XK_Return);
+ define_integer(XK_Pause);
+ define_integer(XK_Scroll_Lock);
+ define_integer(XK_Sys_Req);
+ define_integer(XK_Escape);
+ define_integer(XK_Delete);
+ define_integer(XK_Home);
+ define_integer(XK_Left);
+ define_integer(XK_Up);
+ define_integer(XK_Right);
+ define_integer(XK_Down);
+ define_integer(XK_Prior);
+ define_integer(XK_Page_Up);
+ define_integer(XK_Next);
+ define_integer(XK_Page_Down);
+ define_integer(XK_End);
+ define_integer(XK_Begin);
+ define_integer(XK_Select);
+ define_integer(XK_Print);
+ define_integer(XK_Execute);
+ define_integer(XK_Insert);
+ define_integer(XK_Undo);
+ define_integer(XK_Redo);
+ define_integer(XK_Menu);
+ define_integer(XK_Find);
+ define_integer(XK_Cancel);
+ define_integer(XK_Help);
+ define_integer(XK_Break);
+ define_integer(XK_Mode_switch);
+ define_integer(XK_script_switch);
+ define_integer(XK_Num_Lock);
+ define_integer(XK_KP_Space);
+ define_integer(XK_KP_Tab);
+ define_integer(XK_KP_Enter);
+ define_integer(XK_KP_F1);
+ define_integer(XK_KP_F2);
+ define_integer(XK_KP_F3);
+ define_integer(XK_KP_F4);
+ define_integer(XK_KP_Home);
+ define_integer(XK_KP_Left);
+ define_integer(XK_KP_Up);
+ define_integer(XK_KP_Right);
+ define_integer(XK_KP_Down);
+ define_integer(XK_KP_Prior);
+ define_integer(XK_KP_Page_Up);
+ define_integer(XK_KP_Next);
+ define_integer(XK_KP_Page_Down);
+ define_integer(XK_KP_End);
+ define_integer(XK_KP_Begin);
+ define_integer(XK_KP_Insert);
+ define_integer(XK_KP_Delete);
+ define_integer(XK_KP_Equal);
+ define_integer(XK_KP_Multiply);
+ define_integer(XK_KP_Add);
+ define_integer(XK_KP_Separator);
+ define_integer(XK_KP_Subtract);
+ define_integer(XK_KP_Decimal);
+ define_integer(XK_KP_Divide);
+ define_integer(XK_KP_0);
+ define_integer(XK_KP_1);
+ define_integer(XK_KP_2);
+ define_integer(XK_KP_3);
+ define_integer(XK_KP_4);
+ define_integer(XK_KP_5);
+ define_integer(XK_KP_6);
+ define_integer(XK_KP_7);
+ define_integer(XK_KP_8);
+ define_integer(XK_KP_9);
+ define_integer(XK_F1);
+ define_integer(XK_F2);
+ define_integer(XK_F3);
+ define_integer(XK_F4);
+ define_integer(XK_F5);
+ define_integer(XK_F6);
+ define_integer(XK_F7);
+ define_integer(XK_F8);
+ define_integer(XK_F9);
+ define_integer(XK_F10);
+ define_integer(XK_F11);
+ define_integer(XK_L1);
+ define_integer(XK_F12);
+ define_integer(XK_L2);
+ define_integer(XK_F13);
+ define_integer(XK_L3);
+ define_integer(XK_F14);
+ define_integer(XK_L4);
+ define_integer(XK_F15);
+ define_integer(XK_L5);
+ define_integer(XK_F16);
+ define_integer(XK_L6);
+ define_integer(XK_F17);
+ define_integer(XK_L7);
+ define_integer(XK_F18);
+ define_integer(XK_L8);
+ define_integer(XK_F19);
+ define_integer(XK_L9);
+ define_integer(XK_F20);
+ define_integer(XK_L10);
+ define_integer(XK_F21);
+ define_integer(XK_R1);
+ define_integer(XK_F22);
+ define_integer(XK_R2);
+ define_integer(XK_F23);
+ define_integer(XK_R3);
+ define_integer(XK_F24);
+ define_integer(XK_R4);
+ define_integer(XK_F25);
+ define_integer(XK_R5);
+ define_integer(XK_F26);
+ define_integer(XK_R6);
+ define_integer(XK_F27);
+ define_integer(XK_R7);
+ define_integer(XK_F28);
+ define_integer(XK_R8);
+ define_integer(XK_F29);
+ define_integer(XK_R9);
+ define_integer(XK_F30);
+ define_integer(XK_R10);
+ define_integer(XK_F31);
+ define_integer(XK_R11);
+ define_integer(XK_F32);
+ define_integer(XK_R12);
+ define_integer(XK_F33);
+ define_integer(XK_R13);
+ define_integer(XK_F34);
+ define_integer(XK_R14);
+ define_integer(XK_F35);
+ define_integer(XK_R15);
+ define_integer(XK_Shift_L);
+ define_integer(XK_Shift_R);
+ define_integer(XK_Control_L);
+ define_integer(XK_Control_R);
+ define_integer(XK_Caps_Lock);
+ define_integer(XK_Shift_Lock);
+ define_integer(XK_Meta_L);
+ define_integer(XK_Meta_R);
+ define_integer(XK_Alt_L);
+ define_integer(XK_Alt_R);
+ define_integer(XK_Super_L);
+ define_integer(XK_Super_R);
+ define_integer(XK_Hyper_L);
+ define_integer(XK_Hyper_R);
+ define_integer(XK_space);
+ define_integer(XK_exclam);
+ define_integer(XK_quotedbl);
+ define_integer(XK_numbersign);
+ define_integer(XK_dollar);
+ define_integer(XK_percent);
+ define_integer(XK_ampersand);
+ define_integer(XK_apostrophe);
+ define_integer(XK_quoteright);
+ define_integer(XK_parenleft);
+ define_integer(XK_parenright);
+ define_integer(XK_asterisk);
+ define_integer(XK_plus);
+ define_integer(XK_comma);
+ define_integer(XK_minus);
+ define_integer(XK_period);
+ define_integer(XK_slash);
+ define_integer(XK_0);
+ define_integer(XK_1);
+ define_integer(XK_2);
+ define_integer(XK_3);
+ define_integer(XK_4);
+ define_integer(XK_5);
+ define_integer(XK_6);
+ define_integer(XK_7);
+ define_integer(XK_8);
+ define_integer(XK_9);
+ define_integer(XK_colon);
+ define_integer(XK_semicolon);
+ define_integer(XK_less);
+ define_integer(XK_equal);
+ define_integer(XK_greater);
+ define_integer(XK_question);
+ define_integer(XK_at);
+ define_integer(XK_A);
+ define_integer(XK_B);
+ define_integer(XK_C);
+ define_integer(XK_D);
+ define_integer(XK_E);
+ define_integer(XK_F);
+ define_integer(XK_G);
+ define_integer(XK_H);
+ define_integer(XK_I);
+ define_integer(XK_J);
+ define_integer(XK_K);
+ define_integer(XK_L);
+ define_integer(XK_M);
+ define_integer(XK_N);
+ define_integer(XK_O);
+ define_integer(XK_P);
+ define_integer(XK_Q);
+ define_integer(XK_R);
+ define_integer(XK_S);
+ define_integer(XK_T);
+ define_integer(XK_U);
+ define_integer(XK_V);
+ define_integer(XK_W);
+ define_integer(XK_X);
+ define_integer(XK_Y);
+ define_integer(XK_Z);
+ define_integer(XK_bracketleft);
+ define_integer(XK_backslash);
+ define_integer(XK_bracketright);
+ define_integer(XK_asciicircum);
+ define_integer(XK_underscore);
+ define_integer(XK_grave);
+ define_integer(XK_quoteleft);
+ define_integer(XK_a);
+ define_integer(XK_b);
+ define_integer(XK_c);
+ define_integer(XK_d);
+ define_integer(XK_e);
+ define_integer(XK_f);
+ define_integer(XK_g);
+ define_integer(XK_h);
+ define_integer(XK_i);
+ define_integer(XK_j);
+ define_integer(XK_k);
+ define_integer(XK_l);
+ define_integer(XK_m);
+ define_integer(XK_n);
+ define_integer(XK_o);
+ define_integer(XK_p);
+ define_integer(XK_q);
+ define_integer(XK_r);
+ define_integer(XK_s);
+ define_integer(XK_t);
+ define_integer(XK_u);
+ define_integer(XK_v);
+ define_integer(XK_w);
+ define_integer(XK_x);
+ define_integer(XK_y);
+ define_integer(XK_z);
+ define_integer(XK_braceleft);
+ define_integer(XK_bar);
+ define_integer(XK_braceright);
+ define_integer(XK_asciitilde);
+ define_integer(XK_nobreakspace);
+ define_integer(XK_exclamdown);
+ define_integer(XK_cent);
+ define_integer(XK_sterling);
+ define_integer(XK_currency);
+ define_integer(XK_yen);
+ define_integer(XK_brokenbar);
+ define_integer(XK_section);
+ define_integer(XK_diaeresis);
+ define_integer(XK_copyright);
+ define_integer(XK_ordfeminine);
+ define_integer(XK_guillemotleft);
+ define_integer(XK_notsign);
+ define_integer(XK_hyphen);
+ define_integer(XK_registered);
+ define_integer(XK_macron);
+ define_integer(XK_degree);
+ define_integer(XK_plusminus);
+ define_integer(XK_twosuperior);
+ define_integer(XK_threesuperior);
+ define_integer(XK_acute);
+ define_integer(XK_mu);
+ define_integer(XK_paragraph);
+ define_integer(XK_periodcentered);
+ define_integer(XK_cedilla);
+ define_integer(XK_onesuperior);
+ define_integer(XK_masculine);
+ define_integer(XK_guillemotright);
+ define_integer(XK_onequarter);
+ define_integer(XK_onehalf);
+ define_integer(XK_threequarters);
+ define_integer(XK_questiondown);
+ define_integer(XK_Agrave);
+ define_integer(XK_Aacute);
+ define_integer(XK_Acircumflex);
+ define_integer(XK_Atilde);
+ define_integer(XK_Adiaeresis);
+ define_integer(XK_Aring);
+ define_integer(XK_AE);
+ define_integer(XK_Ccedilla);
+ define_integer(XK_Egrave);
+ define_integer(XK_Eacute);
+ define_integer(XK_Ecircumflex);
+ define_integer(XK_Ediaeresis);
+ define_integer(XK_Igrave);
+ define_integer(XK_Iacute);
+ define_integer(XK_Icircumflex);
+ define_integer(XK_Idiaeresis);
+ define_integer(XK_ETH);
+ define_integer(XK_Eth);
+ define_integer(XK_Ntilde);
+ define_integer(XK_Ograve);
+ define_integer(XK_Oacute);
+ define_integer(XK_Ocircumflex);
+ define_integer(XK_Otilde);
+ define_integer(XK_Odiaeresis);
+ define_integer(XK_multiply);
+ define_integer(XK_Ooblique);
+ define_integer(XK_Ugrave);
+ define_integer(XK_Uacute);
+ define_integer(XK_Ucircumflex);
+ define_integer(XK_Udiaeresis);
+ define_integer(XK_Yacute);
+ define_integer(XK_THORN);
+ define_integer(XK_Thorn);
+ define_integer(XK_ssharp);
+ define_integer(XK_agrave);
+ define_integer(XK_aacute);
+ define_integer(XK_acircumflex);
+ define_integer(XK_atilde);
+ define_integer(XK_adiaeresis);
+ define_integer(XK_aring);
+ define_integer(XK_ae);
+ define_integer(XK_ccedilla);
+ define_integer(XK_egrave);
+ define_integer(XK_eacute);
+ define_integer(XK_ecircumflex);
+ define_integer(XK_ediaeresis);
+ define_integer(XK_igrave);
+ define_integer(XK_iacute);
+ define_integer(XK_icircumflex);
+ define_integer(XK_idiaeresis);
+ define_integer(XK_eth);
+ define_integer(XK_ntilde);
+ define_integer(XK_ograve);
+ define_integer(XK_oacute);
+ define_integer(XK_ocircumflex);
+ define_integer(XK_otilde);
+ define_integer(XK_odiaeresis);
+ define_integer(XK_division);
+ define_integer(XK_oslash);
+ define_integer(XK_ugrave);
+ define_integer(XK_uacute);
+ define_integer(XK_ucircumflex);
+ define_integer(XK_udiaeresis);
+ define_integer(XK_yacute);
+ define_integer(XK_thorn);
+ define_integer(XK_ydiaeresis);
+
+ define_integer(XpmFormat);
+ define_integer(XpmVersion);
+ define_integer(XpmRevision);
+ define_integer(XpmIncludeVersion);
+ define_integer(XpmColorError);
+ define_integer(XpmSuccess);
+ define_integer(XpmOpenFailed);
+ define_integer(XpmFileInvalid);
+ define_integer(XpmNoMemory);
+ define_integer(XpmColorFailed);
+ define_integer(XpmVisual);
+ define_integer(XpmColormap);
+ define_integer(XpmDepth);
+ define_integer(XpmSize);
+ define_integer(XpmHotspot);
+ define_integer(XpmCharsPerPixel);
+ define_integer(XpmColorSymbols);
+ define_integer(XpmRgbFilename);
+ define_integer(XpmInfos);
+ define_integer(XpmReturnInfos);
+ define_integer(XpmReturnPixels);
+ define_integer(XpmExtensions);
+ define_integer(XpmReturnExtensions);
+ define_integer(XpmExactColors);
+ define_integer(XpmCloseness);
+ define_integer(XpmRGBCloseness);
+ define_integer(XpmColorKey);
+ define_integer(XpmColorTable);
+ define_integer(XpmReturnColorTable);
#ifdef XpmReturnAllocPixels
- DEFINE_INTEGER(XpmReturnAllocPixels);
- DEFINE_INTEGER(XpmAllocCloseColors);
- DEFINE_INTEGER(XpmBitmapFormat);
- DEFINE_INTEGER(XpmAllocColor);
- DEFINE_INTEGER(XpmFreeColors);
- DEFINE_INTEGER(XpmColorClosure);
+ define_integer(XpmReturnAllocPixels);
+ define_integer(XpmAllocCloseColors);
+ define_integer(XpmBitmapFormat);
+ define_integer(XpmAllocColor);
+ define_integer(XpmFreeColors);
+ define_integer(XpmColorClosure);
#endif
- DEFINE_INTEGER(XpmComments);
- DEFINE_INTEGER(XpmReturnComments);
- DEFINE_INTEGER(XpmUndefPixel);
-
- DEFINE_INTEGER(NoValue);
- DEFINE_INTEGER(XValue);
- DEFINE_INTEGER(YValue);
- DEFINE_INTEGER(WidthValue);
- DEFINE_INTEGER(HeightValue);
- DEFINE_INTEGER(AllValues);
- DEFINE_INTEGER(XNegative);
- DEFINE_INTEGER(YNegative);
- DEFINE_INTEGER(InputHint);
- DEFINE_INTEGER(StateHint);
- DEFINE_INTEGER(IconPixmapHint);
- DEFINE_INTEGER(IconWindowHint);
- DEFINE_INTEGER(IconPositionHint);
- DEFINE_INTEGER(IconMaskHint);
- DEFINE_INTEGER(WindowGroupHint);
- DEFINE_INTEGER(AllHints);
- DEFINE_INTEGER(XUrgencyHint);
- DEFINE_INTEGER(WithdrawnState);
- DEFINE_INTEGER(NormalState);
- DEFINE_INTEGER(IconicState);
- DEFINE_INTEGER(DontCareState);
- DEFINE_INTEGER(ZoomState);
- DEFINE_INTEGER(InactiveState);
- DEFINE_INTEGER(XNoMemory);
- DEFINE_INTEGER(XLocaleNotSupported);
- DEFINE_INTEGER(XConverterNotFound);
- DEFINE_INTEGER(RectangleOut);
- DEFINE_INTEGER(RectangleIn);
- DEFINE_INTEGER(RectanglePart);
- DEFINE_INTEGER(VisualNoMask);
- DEFINE_INTEGER(VisualIDMask);
- DEFINE_INTEGER(VisualScreenMask);
- DEFINE_INTEGER(VisualDepthMask);
- DEFINE_INTEGER(VisualClassMask);
- DEFINE_INTEGER(VisualRedMaskMask);
- DEFINE_INTEGER(VisualGreenMaskMask);
- DEFINE_INTEGER(VisualBlueMaskMask);
- DEFINE_INTEGER(VisualColormapSizeMask);
- DEFINE_INTEGER(VisualBitsPerRGBMask);
- DEFINE_INTEGER(VisualAllMask);
- DEFINE_INTEGER(ReleaseByFreeingColormap);
- DEFINE_INTEGER(BitmapSuccess);
- DEFINE_INTEGER(BitmapOpenFailed);
- DEFINE_INTEGER(BitmapFileInvalid);
- DEFINE_INTEGER(BitmapNoMemory);
-#if HAVE_MOTIF
- DEFINE_INTEGER(MWM_HINTS_FUNCTIONS);
- DEFINE_INTEGER(MWM_HINTS_DECORATIONS);
- DEFINE_INTEGER(MWM_HINTS_INPUT_MODE);
- DEFINE_INTEGER(MWM_HINTS_STATUS);
- DEFINE_INTEGER(MWM_FUNC_ALL);
- DEFINE_INTEGER(MWM_FUNC_RESIZE);
- DEFINE_INTEGER(MWM_FUNC_MOVE);
- DEFINE_INTEGER(MWM_FUNC_MINIMIZE);
- DEFINE_INTEGER(MWM_FUNC_MAXIMIZE);
- DEFINE_INTEGER(MWM_FUNC_CLOSE);
- DEFINE_INTEGER(MWM_DECOR_ALL);
- DEFINE_INTEGER(MWM_DECOR_BORDER);
- DEFINE_INTEGER(MWM_DECOR_RESIZEH);
- DEFINE_INTEGER(MWM_DECOR_TITLE);
- DEFINE_INTEGER(MWM_DECOR_MENU);
- DEFINE_INTEGER(MWM_DECOR_MINIMIZE);
- DEFINE_INTEGER(MWM_DECOR_MAXIMIZE);
+ define_integer(XpmComments);
+ define_integer(XpmReturnComments);
+ define_integer(XpmUndefPixel);
+
+ define_integer(NoValue);
+ define_integer(XValue);
+ define_integer(YValue);
+ define_integer(WidthValue);
+ define_integer(HeightValue);
+ define_integer(AllValues);
+ define_integer(XNegative);
+ define_integer(YNegative);
+ define_integer(InputHint);
+ define_integer(StateHint);
+ define_integer(IconPixmapHint);
+ define_integer(IconWindowHint);
+ define_integer(IconPositionHint);
+ define_integer(IconMaskHint);
+ define_integer(WindowGroupHint);
+ define_integer(AllHints);
+ define_integer(XUrgencyHint);
+ define_integer(WithdrawnState);
+ define_integer(NormalState);
+ define_integer(IconicState);
+ define_integer(DontCareState);
+ define_integer(ZoomState);
+ define_integer(InactiveState);
+ define_integer(XNoMemory);
+ define_integer(XLocaleNotSupported);
+ define_integer(XConverterNotFound);
+ define_integer(RectangleOut);
+ define_integer(RectangleIn);
+ define_integer(RectanglePart);
+ define_integer(VisualNoMask);
+ define_integer(VisualIDMask);
+ define_integer(VisualScreenMask);
+ define_integer(VisualDepthMask);
+ define_integer(VisualClassMask);
+ define_integer(VisualRedMaskMask);
+ define_integer(VisualGreenMaskMask);
+ define_integer(VisualBlueMaskMask);
+ define_integer(VisualColormapSizeMask);
+ define_integer(VisualBitsPerRGBMask);
+ define_integer(VisualAllMask);
+ define_integer(ReleaseByFreeingColormap);
+ define_integer(BitmapSuccess);
+ define_integer(BitmapOpenFailed);
+ define_integer(BitmapFileInvalid);
+ define_integer(BitmapNoMemory);
+
+ define_integer(MWM_HINTS_FUNCTIONS);
+ define_integer(MWM_HINTS_DECORATIONS);
+ define_integer(MWM_HINTS_INPUT_MODE);
+ define_integer(MWM_HINTS_STATUS);
+ define_integer(MWM_FUNC_ALL);
+ define_integer(MWM_FUNC_RESIZE);
+ define_integer(MWM_FUNC_MOVE);
+ define_integer(MWM_FUNC_MINIMIZE);
+ define_integer(MWM_FUNC_MAXIMIZE);
+ define_integer(MWM_FUNC_CLOSE);
+ define_integer(MWM_DECOR_ALL);
+ define_integer(MWM_DECOR_BORDER);
+ define_integer(MWM_DECOR_RESIZEH);
+ define_integer(MWM_DECOR_TITLE);
+ define_integer(MWM_DECOR_MENU);
+ define_integer(MWM_DECOR_MINIMIZE);
+ define_integer(MWM_DECOR_MAXIMIZE);
#ifdef XmCR_WM_PROTOCOLS
- DEFINE_INTEGER(XmCR_WM_PROTOCOLS);
+ define_integer(XmCR_WM_PROTOCOLS);
#endif
- DEFINE_INTEGER(MWM_INPUT_MODELESS);
- DEFINE_INTEGER(MWM_INPUT_PRIMARY_APPLICATION_MODAL);
- DEFINE_INTEGER(MWM_INPUT_SYSTEM_MODAL);
- DEFINE_INTEGER(MWM_INPUT_FULL_APPLICATION_MODAL);
- DEFINE_INTEGER(MWM_TEAROFF_WINDOW);
- DEFINE_INTEGER(MWM_INPUT_APPLICATION_MODAL);
- DEFINE_INTEGER(MWM_INFO_STARTUP_STANDARD);
- DEFINE_INTEGER(MWM_INFO_STARTUP_CUSTOM);
- DEFINE_INTEGER(PROP_MOTIF_WM_HINTS_ELEMENTS);
- DEFINE_INTEGER(PROP_MWM_HINTS_ELEMENTS);
- DEFINE_INTEGER(PROP_MOTIF_WM_INFO_ELEMENTS);
- DEFINE_INTEGER(PROP_MWM_INFO_ELEMENTS);
- DEFINE_INTEGER(ClipboardFail);
- DEFINE_INTEGER(ClipboardSuccess);
- DEFINE_INTEGER(ClipboardTruncate);
- DEFINE_INTEGER(ClipboardLocked);
- DEFINE_INTEGER(ClipboardBadFormat);
- DEFINE_INTEGER(ClipboardNoData);
- DEFINE_INTEGER(XmHELP);
- DEFINE_INTEGER(XmDROP_NOOP);
- DEFINE_INTEGER(XmDROP_MOVE);
- DEFINE_INTEGER(XmDROP_COPY);
- DEFINE_INTEGER(XmDROP_LINK);
- DEFINE_INTEGER(XmCR_DROP_SITE_LEAVE_MESSAGE);
- DEFINE_INTEGER(XmCR_DROP_SITE_ENTER_MESSAGE);
- DEFINE_INTEGER(XmCR_DROP_SITE_MOTION_MESSAGE);
- DEFINE_INTEGER(XmCR_DROP_MESSAGE);
- DEFINE_INTEGER(XmNO_DROP_SITE);
- DEFINE_INTEGER(XmINVALID_DROP_SITE);
- DEFINE_INTEGER(XmVALID_DROP_SITE);
- DEFINE_INTEGER(XmDROP_SITE_INVALID);
- DEFINE_INTEGER(XmDROP_SITE_VALID);
- DEFINE_INTEGER(XmTRANSFER_FAILURE);
- DEFINE_INTEGER(XmTRANSFER_SUCCESS);
- DEFINE_INTEGER(XmUNSPECIFIED_ICON_SIZE);
- DEFINE_INTEGER(XmLARGE_ICON_SIZE);
- DEFINE_INTEGER(XmMEDIUM_ICON_SIZE);
- DEFINE_INTEGER(XmSMALL_ICON_SIZE);
- DEFINE_INTEGER(XmTINY_ICON_SIZE);
- DEFINE_INTEGER(XmUNSPECIFIED_POSITION);
- DEFINE_INTEGER(XmINVALID_POSITION);
- DEFINE_INTEGER(XmINDICATOR_3D_BOX);
- DEFINE_INTEGER(XmINDICATOR_FLAT_BOX);
- DEFINE_INTEGER(XmINDICATOR_CHECK_GLYPH);
- DEFINE_INTEGER(XmINDICATOR_CROSS_GLYPH);
- DEFINE_INTEGER(XmINITIAL);
- DEFINE_INTEGER(XmADDITION);
- DEFINE_INTEGER(XmMODIFICATION);
- DEFINE_INTEGER(XmVERSION);
- DEFINE_INTEGER(XmREVISION);
- DEFINE_INTEGER(XmUPDATE_LEVEL);
- DEFINE_INTEGER(XmVersion);
- DEFINE_INTEGER(XmUNSPECIFIED_PIXMAP);
- DEFINE_INTEGER(XmCOPY_FAILED);
- DEFINE_INTEGER(XmCOPY_SUCCEEDED);
- DEFINE_INTEGER(XmCOPY_TRUNCATED);
- DEFINE_INTEGER(XmDIALOG_HISTORY_LIST);
- DEFINE_INTEGER(XmDIALOG_PROMPT_LABEL);
- DEFINE_INTEGER(XmDIALOG_VALUE_TEXT);
- DEFINE_INTEGER(XmDIALOG_COMMAND_TEXT);
- DEFINE_INTEGER(XmDIALOG_FILE_LIST);
- DEFINE_INTEGER(XmDIALOG_FILE_LIST_LABEL);
- DEFINE_INTEGER(XmDIALOG_APPLICATION_MODAL);
- DEFINE_INTEGER(XmFILE_DIRECTORY);
- DEFINE_INTEGER(XmFILE_REGULAR);
- DEFINE_INTEGER(XmFILE_ANY_TYPE);
- DEFINE_INTEGER(XmCHECKBUTTON);
-#endif
- /* enums */
-
-#if HAVE_MOTIF
- DEFINE_INTEGER(XtCallbackNoList);
- DEFINE_INTEGER(XtCallbackHasNone);
- DEFINE_INTEGER(XtCallbackHasSome);
- DEFINE_INTEGER(XtGeometryYes);
- DEFINE_INTEGER(XtGeometryNo);
- DEFINE_INTEGER(XtGeometryAlmost);
- DEFINE_INTEGER(XtGeometryDone);
- DEFINE_INTEGER(XtGrabNone);
- DEFINE_INTEGER(XtGrabNonexclusive);
- DEFINE_INTEGER(XtGrabExclusive);
- DEFINE_INTEGER(XtListHead);
- DEFINE_INTEGER(XtListTail);
-#endif
- DEFINE_INTEGER(XStringStyle);
- DEFINE_INTEGER(XCompoundTextStyle);
- DEFINE_INTEGER(XTextStyle);
- DEFINE_INTEGER(XStdICCTextStyle);
-#if HAVE_MOTIF
- DEFINE_INTEGER(XmClipboardFail);
- DEFINE_INTEGER(XmClipboardSuccess);
- DEFINE_INTEGER(XmClipboardTruncate);
- DEFINE_INTEGER(XmClipboardLocked);
- DEFINE_INTEGER(XmClipboardBadFormat);
- DEFINE_INTEGER(XmClipboardNoData);
- DEFINE_INTEGER(XmDRAG_NONE);
- DEFINE_INTEGER(XmDRAG_DROP_ONLY);
- DEFINE_INTEGER(XmDRAG_PREFER_PREREGISTER);
- DEFINE_INTEGER(XmDRAG_PREREGISTER);
- DEFINE_INTEGER(XmDRAG_PREFER_DYNAMIC);
- DEFINE_INTEGER(XmDRAG_DYNAMIC);
- DEFINE_INTEGER(XmDRAG_PREFER_RECEIVER);
- DEFINE_INTEGER(XmTOP_LEVEL_ENTER);
- DEFINE_INTEGER(XmTOP_LEVEL_LEAVE);
- DEFINE_INTEGER(XmDRAG_MOTION);
- DEFINE_INTEGER(XmDROP_SITE_ENTER);
- DEFINE_INTEGER(XmDROP_SITE_LEAVE);
- DEFINE_INTEGER(XmDROP_START);
- DEFINE_INTEGER(XmDROP_FINISH);
- DEFINE_INTEGER(XmDRAG_DROP_FINISH);
- DEFINE_INTEGER(XmOPERATION_CHANGED);
- DEFINE_INTEGER(XmDROP);
- DEFINE_INTEGER(XmDROP_HELP);
- DEFINE_INTEGER(XmDROP_CANCEL);
- DEFINE_INTEGER(XmDROP_INTERRUPT);
- DEFINE_INTEGER(XmBLEND_ALL);
- DEFINE_INTEGER(XmBLEND_STATE_SOURCE);
- DEFINE_INTEGER(XmBLEND_JUST_SOURCE);
- DEFINE_INTEGER(XmBLEND_NONE);
- DEFINE_INTEGER(XmDROP_FAILURE);
- DEFINE_INTEGER(XmDROP_SUCCESS);
- DEFINE_INTEGER(XmCR_TOP_LEVEL_ENTER);
- DEFINE_INTEGER(XmCR_TOP_LEVEL_LEAVE);
- DEFINE_INTEGER(XmCR_DRAG_MOTION);
- DEFINE_INTEGER(XmCR_DROP_SITE_ENTER);
- DEFINE_INTEGER(XmCR_DROP_SITE_LEAVE);
- DEFINE_INTEGER(XmCR_DROP_START);
- DEFINE_INTEGER(XmCR_DROP_FINISH);
- DEFINE_INTEGER(XmCR_DRAG_DROP_FINISH);
- DEFINE_INTEGER(XmCR_OPERATION_CHANGED);
- DEFINE_INTEGER(XmATTACH_NORTH_WEST);
- DEFINE_INTEGER(XmATTACH_NORTH);
- DEFINE_INTEGER(XmATTACH_NORTH_EAST);
- DEFINE_INTEGER(XmATTACH_EAST);
- DEFINE_INTEGER(XmATTACH_SOUTH_EAST);
- DEFINE_INTEGER(XmATTACH_SOUTH);
- DEFINE_INTEGER(XmATTACH_SOUTH_WEST);
- DEFINE_INTEGER(XmATTACH_WEST);
- DEFINE_INTEGER(XmATTACH_CENTER);
- DEFINE_INTEGER(XmATTACH_HOT);
- DEFINE_INTEGER(XmDRAG_UNDER_NONE);
- DEFINE_INTEGER(XmDRAG_UNDER_PIXMAP);
- DEFINE_INTEGER(XmDRAG_UNDER_SHADOW_IN);
- DEFINE_INTEGER(XmDRAG_UNDER_SHADOW_OUT);
- DEFINE_INTEGER(XmDRAG_UNDER_HIGHLIGHT);
- DEFINE_INTEGER(XmDROP_SITE_SIMPLE);
- DEFINE_INTEGER(XmDROP_SITE_COMPOSITE);
- DEFINE_INTEGER(XmDROP_SITE_SIMPLE_CLIP_ONLY);
- DEFINE_INTEGER(XmDROP_SITE_COMPOSITE_CLIP_ONLY);
- DEFINE_INTEGER(XmABOVE);
- DEFINE_INTEGER(XmBELOW);
- DEFINE_INTEGER(XmDROP_SITE_ACTIVE);
- DEFINE_INTEGER(XmDROP_SITE_INACTIVE);
- DEFINE_INTEGER(XmFONT_IS_FONT);
- DEFINE_INTEGER(XmFONT_IS_FONTSET);
- DEFINE_INTEGER(XmSTRING_DIRECTION_L_TO_R);
- DEFINE_INTEGER(XmSTRING_DIRECTION_R_TO_L);
- DEFINE_INTEGER(XmSTRING_DIRECTION_DEFAULT);
- DEFINE_INTEGER(XmSTRING_COMPONENT_UNKNOWN);
- DEFINE_INTEGER(XmSTRING_COMPONENT_TEXT);
- DEFINE_INTEGER(XmSTRING_COMPONENT_DIRECTION);
- DEFINE_INTEGER(XmSTRING_COMPONENT_SEPARATOR);
- DEFINE_INTEGER(XmSTRING_COMPONENT_LOCALE_TEXT);
- DEFINE_INTEGER(XmSTRING_COMPONENT_END);
- DEFINE_INTEGER(XmPAGE_FOUND);
- DEFINE_INTEGER(XmPAGE_INVALID);
- DEFINE_INTEGER(XmPAGE_EMPTY);
- DEFINE_INTEGER(XmPAGE_DUPLICATED);
- DEFINE_INTEGER(XmMOVE);
- DEFINE_INTEGER(XmCOPY);
- DEFINE_INTEGER(XmLINK);
- DEFINE_INTEGER(XmOTHER);
- DEFINE_INTEGER(XmDROP_SITE_IGNORE);
- DEFINE_INTEGER(XmTRANSFER_DONE_SUCCEED);
- DEFINE_INTEGER(XmTRANSFER_DONE_FAIL);
- DEFINE_INTEGER(XmTRANSFER_DONE_CONTINUE);
- DEFINE_INTEGER(XmTRANSFER_DONE_DEFAULT);
- DEFINE_INTEGER(XmSELECTION_DEFAULT);
- DEFINE_INTEGER(XmSELECTION_INCREMENTAL);
- DEFINE_INTEGER(XmSELECTION_PERSIST);
- DEFINE_INTEGER(XmSELECTION_SNAPSHOT);
- DEFINE_INTEGER(XmSELECTION_TRANSACT);
- DEFINE_INTEGER(XmCONVERTING_NONE);
- DEFINE_INTEGER(XmCONVERTING_SAME);
- DEFINE_INTEGER(XmCONVERTING_TRANSACT);
- DEFINE_INTEGER(XmCONVERTING_PARTIAL);
- DEFINE_INTEGER(XmCONVERT_DEFAULT);
- DEFINE_INTEGER(XmCONVERT_MORE);
- DEFINE_INTEGER(XmCONVERT_MERGE);
- DEFINE_INTEGER(XmCONVERT_REFUSE);
- DEFINE_INTEGER(XmCONVERT_DONE);
- DEFINE_INTEGER(XmSTRING_DIRECTION_UNSET);
- DEFINE_INTEGER(XmSTRING_COMPONENT_LOCALE);
- DEFINE_INTEGER(XmSTRING_COMPONENT_WIDECHAR_TEXT);
- DEFINE_INTEGER(XmSTRING_COMPONENT_LAYOUT_PUSH);
- DEFINE_INTEGER(XmSTRING_COMPONENT_LAYOUT_POP);
- DEFINE_INTEGER(XmSTRING_COMPONENT_RENDITION_BEGIN);
- DEFINE_INTEGER(XmSTRING_COMPONENT_RENDITION_END);
- DEFINE_INTEGER(XmSTRING_COMPONENT_TAB);
- DEFINE_INTEGER(XmSTRING_COMPONENT_TAG);
- DEFINE_INTEGER(XmCHARSET_TEXT);
- DEFINE_INTEGER(XmMULTIBYTE_TEXT);
- DEFINE_INTEGER(XmWIDECHAR_TEXT);
- DEFINE_INTEGER(XmNO_TEXT);
- DEFINE_INTEGER(XmOUTPUT_ALL);
- DEFINE_INTEGER(XmOUTPUT_BETWEEN);
- DEFINE_INTEGER(XmOUTPUT_BEGINNING);
- DEFINE_INTEGER(XmOUTPUT_END);
- DEFINE_INTEGER(XmOUTPUT_BOTH);
- DEFINE_INTEGER(XmINSERT);
- DEFINE_INTEGER(XmTERMINATE);
- DEFINE_INTEGER(XmINVOKE);
- DEFINE_INTEGER(XmSTYLE_STRING);
- DEFINE_INTEGER(XmSTYLE_COMPOUND_TEXT);
- DEFINE_INTEGER(XmSTYLE_TEXT);
- DEFINE_INTEGER(XmSTYLE_STANDARD_ICC_TEXT);
- DEFINE_INTEGER(XmSTYLE_LOCALE);
- DEFINE_INTEGER(XmSTYLE_COMPOUND_STRING);
- DEFINE_INTEGER(XmABSOLUTE);
- DEFINE_INTEGER(XmRELATIVE);
- DEFINE_INTEGER(XmSKIP);
- DEFINE_INTEGER(XmMERGE_REPLACE);
- DEFINE_INTEGER(XmMERGE_OLD);
- DEFINE_INTEGER(XmMERGE_NEW);
- DEFINE_INTEGER(XmDUPLICATE);
- DEFINE_INTEGER(XmAS_IS);
- DEFINE_INTEGER(XmFORCE_COLOR);
+ define_integer(MWM_INPUT_MODELESS);
+ define_integer(MWM_INPUT_PRIMARY_APPLICATION_MODAL);
+ define_integer(MWM_INPUT_SYSTEM_MODAL);
+ define_integer(MWM_INPUT_FULL_APPLICATION_MODAL);
+ define_integer(MWM_TEAROFF_WINDOW);
+ define_integer(MWM_INPUT_APPLICATION_MODAL);
+ define_integer(MWM_INFO_STARTUP_STANDARD);
+ define_integer(MWM_INFO_STARTUP_CUSTOM);
+ define_integer(PROP_MOTIF_WM_HINTS_ELEMENTS);
+ define_integer(PROP_MWM_HINTS_ELEMENTS);
+ define_integer(PROP_MOTIF_WM_INFO_ELEMENTS);
+ define_integer(PROP_MWM_INFO_ELEMENTS);
+ define_integer(ClipboardFail);
+ define_integer(ClipboardSuccess);
+ define_integer(ClipboardTruncate);
+ define_integer(ClipboardLocked);
+ define_integer(ClipboardBadFormat);
+ define_integer(ClipboardNoData);
+ define_integer(XmHELP);
+ define_integer(XmDROP_NOOP);
+ define_integer(XmDROP_MOVE);
+ define_integer(XmDROP_COPY);
+ define_integer(XmDROP_LINK);
+ define_integer(XmCR_DROP_SITE_LEAVE_MESSAGE);
+ define_integer(XmCR_DROP_SITE_ENTER_MESSAGE);
+ define_integer(XmCR_DROP_SITE_MOTION_MESSAGE);
+ define_integer(XmCR_DROP_MESSAGE);
+ define_integer(XmNO_DROP_SITE);
+ define_integer(XmINVALID_DROP_SITE);
+ define_integer(XmVALID_DROP_SITE);
+ define_integer(XmDROP_SITE_INVALID);
+ define_integer(XmDROP_SITE_VALID);
+ define_integer(XmTRANSFER_FAILURE);
+ define_integer(XmTRANSFER_SUCCESS);
+ define_integer(XmUNSPECIFIED_ICON_SIZE);
+ define_integer(XmLARGE_ICON_SIZE);
+ define_integer(XmMEDIUM_ICON_SIZE);
+ define_integer(XmSMALL_ICON_SIZE);
+ define_integer(XmTINY_ICON_SIZE);
+ define_integer(XmUNSPECIFIED_POSITION);
+ define_integer(XmINVALID_POSITION);
+ define_integer(XmINDICATOR_3D_BOX);
+ define_integer(XmINDICATOR_FLAT_BOX);
+ define_integer(XmINDICATOR_CHECK_GLYPH);
+ define_integer(XmINDICATOR_CROSS_GLYPH);
+ define_integer(XmINITIAL);
+ define_integer(XmADDITION);
+ define_integer(XmMODIFICATION);
+ define_integer(XmVERSION);
+ define_integer(XmREVISION);
+ define_integer(XmUPDATE_LEVEL);
+ define_integer(XmVersion);
+ define_integer(XmUNSPECIFIED_PIXMAP);
+ define_integer(XmCOPY_FAILED);
+ define_integer(XmCOPY_SUCCEEDED);
+ define_integer(XmCOPY_TRUNCATED);
+ define_integer(XmDIALOG_HISTORY_LIST);
+ define_integer(XmDIALOG_PROMPT_LABEL);
+ define_integer(XmDIALOG_VALUE_TEXT);
+ define_integer(XmDIALOG_COMMAND_TEXT);
+ define_integer(XmDIALOG_FILE_LIST);
+ define_integer(XmDIALOG_FILE_LIST_LABEL);
+ define_integer(XmDIALOG_APPLICATION_MODAL);
+ define_integer(XmFILE_DIRECTORY);
+ define_integer(XmFILE_REGULAR);
+ define_integer(XmFILE_ANY_TYPE);
+ define_integer(XmCHECKBUTTON);
+
+ define_integer(XtCallbackNoList);
+ define_integer(XtCallbackHasNone);
+ define_integer(XtCallbackHasSome);
+ define_integer(XtGeometryYes);
+ define_integer(XtGeometryNo);
+ define_integer(XtGeometryAlmost);
+ define_integer(XtGeometryDone);
+ define_integer(XtGrabNone);
+ define_integer(XtGrabNonexclusive);
+ define_integer(XtGrabExclusive);
+ define_integer(XtListHead);
+ define_integer(XtListTail);
+ define_integer(XStringStyle);
+ define_integer(XCompoundTextStyle);
+ define_integer(XTextStyle);
+ define_integer(XStdICCTextStyle);
+ define_integer(XmClipboardFail);
+ define_integer(XmClipboardSuccess);
+ define_integer(XmClipboardTruncate);
+ define_integer(XmClipboardLocked);
+ define_integer(XmClipboardBadFormat);
+ define_integer(XmClipboardNoData);
+ define_integer(XmDRAG_NONE);
+ define_integer(XmDRAG_DROP_ONLY);
+ define_integer(XmDRAG_PREFER_PREREGISTER);
+ define_integer(XmDRAG_PREREGISTER);
+ define_integer(XmDRAG_PREFER_DYNAMIC);
+ define_integer(XmDRAG_DYNAMIC);
+ define_integer(XmDRAG_PREFER_RECEIVER);
+ define_integer(XmTOP_LEVEL_ENTER);
+ define_integer(XmTOP_LEVEL_LEAVE);
+ define_integer(XmDRAG_MOTION);
+ define_integer(XmDROP_SITE_ENTER);
+ define_integer(XmDROP_SITE_LEAVE);
+ define_integer(XmDROP_START);
+ define_integer(XmDROP_FINISH);
+ define_integer(XmDRAG_DROP_FINISH);
+ define_integer(XmOPERATION_CHANGED);
+ define_integer(XmDROP);
+ define_integer(XmDROP_HELP);
+ define_integer(XmDROP_CANCEL);
+ define_integer(XmDROP_INTERRUPT);
+ define_integer(XmBLEND_ALL);
+ define_integer(XmBLEND_STATE_SOURCE);
+ define_integer(XmBLEND_JUST_SOURCE);
+ define_integer(XmBLEND_NONE);
+ define_integer(XmDROP_FAILURE);
+ define_integer(XmDROP_SUCCESS);
+ define_integer(XmCR_TOP_LEVEL_ENTER);
+ define_integer(XmCR_TOP_LEVEL_LEAVE);
+ define_integer(XmCR_DRAG_MOTION);
+ define_integer(XmCR_DROP_SITE_ENTER);
+ define_integer(XmCR_DROP_SITE_LEAVE);
+ define_integer(XmCR_DROP_START);
+ define_integer(XmCR_DROP_FINISH);
+ define_integer(XmCR_DRAG_DROP_FINISH);
+ define_integer(XmCR_OPERATION_CHANGED);
+ define_integer(XmATTACH_NORTH_WEST);
+ define_integer(XmATTACH_NORTH);
+ define_integer(XmATTACH_NORTH_EAST);
+ define_integer(XmATTACH_EAST);
+ define_integer(XmATTACH_SOUTH_EAST);
+ define_integer(XmATTACH_SOUTH);
+ define_integer(XmATTACH_SOUTH_WEST);
+ define_integer(XmATTACH_WEST);
+ define_integer(XmATTACH_CENTER);
+ define_integer(XmATTACH_HOT);
+ define_integer(XmDRAG_UNDER_NONE);
+ define_integer(XmDRAG_UNDER_PIXMAP);
+ define_integer(XmDRAG_UNDER_SHADOW_IN);
+ define_integer(XmDRAG_UNDER_SHADOW_OUT);
+ define_integer(XmDRAG_UNDER_HIGHLIGHT);
+ define_integer(XmDROP_SITE_SIMPLE);
+ define_integer(XmDROP_SITE_COMPOSITE);
+ define_integer(XmDROP_SITE_SIMPLE_CLIP_ONLY);
+ define_integer(XmDROP_SITE_COMPOSITE_CLIP_ONLY);
+ define_integer(XmABOVE);
+ define_integer(XmBELOW);
+ define_integer(XmDROP_SITE_ACTIVE);
+ define_integer(XmDROP_SITE_INACTIVE);
+ define_integer(XmFONT_IS_FONT);
+ define_integer(XmFONT_IS_FONTSET);
+ define_integer(XmSTRING_DIRECTION_L_TO_R);
+ define_integer(XmSTRING_DIRECTION_R_TO_L);
+ define_integer(XmSTRING_DIRECTION_DEFAULT);
+ define_integer(XmSTRING_COMPONENT_UNKNOWN);
+ define_integer(XmSTRING_COMPONENT_TEXT);
+ define_integer(XmSTRING_COMPONENT_DIRECTION);
+ define_integer(XmSTRING_COMPONENT_SEPARATOR);
+ define_integer(XmSTRING_COMPONENT_LOCALE_TEXT);
+ define_integer(XmSTRING_COMPONENT_END);
+ define_integer(XmPAGE_FOUND);
+ define_integer(XmPAGE_INVALID);
+ define_integer(XmPAGE_EMPTY);
+ define_integer(XmPAGE_DUPLICATED);
+ define_integer(XmMOVE);
+ define_integer(XmCOPY);
+ define_integer(XmLINK);
+ define_integer(XmOTHER);
+ define_integer(XmDROP_SITE_IGNORE);
+ define_integer(XmTRANSFER_DONE_SUCCEED);
+ define_integer(XmTRANSFER_DONE_FAIL);
+ define_integer(XmTRANSFER_DONE_CONTINUE);
+ define_integer(XmTRANSFER_DONE_DEFAULT);
+ define_integer(XmSELECTION_DEFAULT);
+ define_integer(XmSELECTION_INCREMENTAL);
+ define_integer(XmSELECTION_PERSIST);
+ define_integer(XmSELECTION_SNAPSHOT);
+ define_integer(XmSELECTION_TRANSACT);
+ define_integer(XmCONVERTING_NONE);
+ define_integer(XmCONVERTING_SAME);
+ define_integer(XmCONVERTING_TRANSACT);
+ define_integer(XmCONVERTING_PARTIAL);
+ define_integer(XmCONVERT_DEFAULT);
+ define_integer(XmCONVERT_MORE);
+ define_integer(XmCONVERT_MERGE);
+ define_integer(XmCONVERT_REFUSE);
+ define_integer(XmCONVERT_DONE);
+ define_integer(XmSTRING_DIRECTION_UNSET);
+ define_integer(XmSTRING_COMPONENT_LOCALE);
+ define_integer(XmSTRING_COMPONENT_WIDECHAR_TEXT);
+ define_integer(XmSTRING_COMPONENT_LAYOUT_PUSH);
+ define_integer(XmSTRING_COMPONENT_LAYOUT_POP);
+ define_integer(XmSTRING_COMPONENT_RENDITION_BEGIN);
+ define_integer(XmSTRING_COMPONENT_RENDITION_END);
+ define_integer(XmSTRING_COMPONENT_TAB);
+ define_integer(XmSTRING_COMPONENT_TAG);
+ define_integer(XmCHARSET_TEXT);
+ define_integer(XmMULTIBYTE_TEXT);
+ define_integer(XmWIDECHAR_TEXT);
+ define_integer(XmNO_TEXT);
+ define_integer(XmOUTPUT_ALL);
+ define_integer(XmOUTPUT_BETWEEN);
+ define_integer(XmOUTPUT_BEGINNING);
+ define_integer(XmOUTPUT_END);
+ define_integer(XmOUTPUT_BOTH);
+ define_integer(XmINSERT);
+ define_integer(XmTERMINATE);
+ define_integer(XmINVOKE);
+ define_integer(XmSTYLE_STRING);
+ define_integer(XmSTYLE_COMPOUND_TEXT);
+ define_integer(XmSTYLE_TEXT);
+ define_integer(XmSTYLE_STANDARD_ICC_TEXT);
+ define_integer(XmSTYLE_LOCALE);
+ define_integer(XmSTYLE_COMPOUND_STRING);
+ define_integer(XmABSOLUTE);
+ define_integer(XmRELATIVE);
+ define_integer(XmSKIP);
+ define_integer(XmMERGE_REPLACE);
+ define_integer(XmMERGE_OLD);
+ define_integer(XmMERGE_NEW);
+ define_integer(XmDUPLICATE);
+ define_integer(XmAS_IS);
+ define_integer(XmFORCE_COLOR);
/* the next 4 are dependent on (Pixel)(~0) which is unsigned long in X terminology, but we then subtract from it --
* that is, XmHIGHLIGHT_COLOR is: ((Pixel)(~0)) - 2, which I assume is intended to be a positive number
*/
#if 0
- DEFINE_INTEGER(XmUNSPECIFIED_PIXEL);
- DEFINE_INTEGER(XmDEFAULT_SELECT_COLOR);
- DEFINE_INTEGER(XmREVERSED_GROUND_COLORS);
- DEFINE_INTEGER(XmHIGHLIGHT_COLOR);
+ define_integer(XmUNSPECIFIED_PIXEL);
+ define_integer(XmDEFAULT_SELECT_COLOR);
+ define_integer(XmREVERSED_GROUND_COLORS);
+ define_integer(XmHIGHLIGHT_COLOR);
#else
- DEFINE_ULONG(XmUNSPECIFIED_PIXEL);
- DEFINE_ULONG(XmDEFAULT_SELECT_COLOR);
- DEFINE_ULONG(XmREVERSED_GROUND_COLORS);
- DEFINE_ULONG(XmHIGHLIGHT_COLOR);
+ define_ulong(XmUNSPECIFIED_PIXEL);
+ define_ulong(XmDEFAULT_SELECT_COLOR);
+ define_ulong(XmREVERSED_GROUND_COLORS);
+ define_ulong(XmHIGHLIGHT_COLOR);
#endif
- DEFINE_INTEGER(XmUNSPECIFIED_LOAD_MODEL);
- DEFINE_INTEGER(XmLOAD_DEFERRED);
- DEFINE_INTEGER(XmLOAD_IMMEDIATE);
- DEFINE_INTEGER(XmCHANGE_ALL);
- DEFINE_INTEGER(XmCHANGE_NONE);
- DEFINE_INTEGER(XmCHANGE_WIDTH);
- DEFINE_INTEGER(XmCHANGE_HEIGHT);
- DEFINE_INTEGER(XmDYNAMIC_DEFAULT_TAB_GROUP);
- DEFINE_INTEGER(XmPIXELS);
- DEFINE_INTEGER(Xm100TH_MILLIMETERS);
- DEFINE_INTEGER(Xm1000TH_INCHES);
- DEFINE_INTEGER(Xm100TH_POINTS);
- DEFINE_INTEGER(Xm100TH_FONT_UNITS);
- DEFINE_INTEGER(XmDESTROY);
- DEFINE_INTEGER(XmUNMAP);
- DEFINE_INTEGER(XmDO_NOTHING);
- DEFINE_INTEGER(XmEXPLICIT);
- DEFINE_INTEGER(XmPOINTER);
- DEFINE_INTEGER(XmNONE);
- DEFINE_INTEGER(XmTAB_GROUP);
- DEFINE_INTEGER(XmSTICKY_TAB_GROUP);
- DEFINE_INTEGER(XmEXCLUSIVE_TAB_GROUP);
- DEFINE_INTEGER(XmBELL);
- DEFINE_INTEGER(XmNO_ORIENTATION);
- DEFINE_INTEGER(XmVERTICAL);
- DEFINE_INTEGER(XmHORIZONTAL);
- DEFINE_INTEGER(XmWORK_AREA);
- DEFINE_INTEGER(XmMENU_BAR);
- DEFINE_INTEGER(XmMENU_PULLDOWN);
- DEFINE_INTEGER(XmMENU_POPUP);
- DEFINE_INTEGER(XmMENU_OPTION);
- DEFINE_INTEGER(XmNO_PACKING);
- DEFINE_INTEGER(XmPACK_TIGHT);
- DEFINE_INTEGER(XmPACK_COLUMN);
- DEFINE_INTEGER(XmPACK_NONE);
- DEFINE_INTEGER(XmALIGNMENT_CONTENTS_TOP);
- DEFINE_INTEGER(XmALIGNMENT_CONTENTS_BOTTOM);
- DEFINE_INTEGER(XmTEAR_OFF_ENABLED);
- DEFINE_INTEGER(XmTEAR_OFF_DISABLED);
- DEFINE_INTEGER(XmUNPOST);
- DEFINE_INTEGER(XmUNPOST_AND_REPLAY);
- DEFINE_INTEGER(XmLAST_POSITION);
- DEFINE_INTEGER(XmFIRST_POSITION);
- DEFINE_INTEGER(XmINCHES);
- DEFINE_INTEGER(XmCENTIMETERS);
- DEFINE_INTEGER(XmMILLIMETERS);
- DEFINE_INTEGER(XmPOINTS);
- DEFINE_INTEGER(XmFONT_UNITS);
- DEFINE_INTEGER(XmPER_SHELL);
- DEFINE_INTEGER(XmPER_WIDGET);
- DEFINE_INTEGER(XmINHERIT_POLICY);
- DEFINE_INTEGER(XmPOPUP_DISABLED);
- DEFINE_INTEGER(XmPOPUP_KEYBOARD);
- DEFINE_INTEGER(XmPOPUP_AUTOMATIC);
- DEFINE_INTEGER(XmPOPUP_AUTOMATIC_RECURSIVE);
- DEFINE_INTEGER(XmCOMBO_BOX);
- DEFINE_INTEGER(XmDROP_DOWN_COMBO_BOX);
- DEFINE_INTEGER(XmDROP_DOWN_LIST);
- DEFINE_INTEGER(XmQUICK_NAVIGATE);
- DEFINE_INTEGER(XmINVALID_MATCH_BEHAVIOR);
- DEFINE_INTEGER(XmZERO_BASED);
- DEFINE_INTEGER(XmONE_BASED);
- DEFINE_INTEGER(XmALIGNMENT_CHILD_TOP);
- DEFINE_INTEGER(XmALIGNMENT_CHILD_BOTTOM);
- DEFINE_INTEGER(XmONE_OF_MANY_ROUND);
- DEFINE_INTEGER(XmONE_OF_MANY_DIAMOND);
- DEFINE_INTEGER(XmALIGNMENT_BEGINNING);
- DEFINE_INTEGER(XmALIGNMENT_CENTER);
- DEFINE_INTEGER(XmALIGNMENT_END);
- DEFINE_INTEGER(XmALIGNMENT_BASELINE_TOP);
- DEFINE_INTEGER(XmALIGNMENT_BASELINE_BOTTOM);
- DEFINE_INTEGER(XmALIGNMENT_WIDGET_TOP);
- DEFINE_INTEGER(XmALIGNMENT_WIDGET_BOTTOM);
+ define_integer(XmUNSPECIFIED_LOAD_MODEL);
+ define_integer(XmLOAD_DEFERRED);
+ define_integer(XmLOAD_IMMEDIATE);
+ define_integer(XmCHANGE_ALL);
+ define_integer(XmCHANGE_NONE);
+ define_integer(XmCHANGE_WIDTH);
+ define_integer(XmCHANGE_HEIGHT);
+ define_integer(XmDYNAMIC_DEFAULT_TAB_GROUP);
+ define_integer(XmPIXELS);
+ define_integer(Xm100TH_MILLIMETERS);
+ define_integer(Xm1000TH_INCHES);
+ define_integer(Xm100TH_POINTS);
+ define_integer(Xm100TH_FONT_UNITS);
+ define_integer(XmDESTROY);
+ define_integer(XmUNMAP);
+ define_integer(XmDO_NOTHING);
+ define_integer(XmEXPLICIT);
+ define_integer(XmPOINTER);
+ define_integer(XmNONE);
+ define_integer(XmTAB_GROUP);
+ define_integer(XmSTICKY_TAB_GROUP);
+ define_integer(XmEXCLUSIVE_TAB_GROUP);
+ define_integer(XmBELL);
+ define_integer(XmNO_ORIENTATION);
+ define_integer(XmVERTICAL);
+ define_integer(XmHORIZONTAL);
+ define_integer(XmWORK_AREA);
+ define_integer(XmMENU_BAR);
+ define_integer(XmMENU_PULLDOWN);
+ define_integer(XmMENU_POPUP);
+ define_integer(XmMENU_OPTION);
+ define_integer(XmNO_PACKING);
+ define_integer(XmPACK_TIGHT);
+ define_integer(XmPACK_COLUMN);
+ define_integer(XmPACK_NONE);
+ define_integer(XmALIGNMENT_CONTENTS_TOP);
+ define_integer(XmALIGNMENT_CONTENTS_BOTTOM);
+ define_integer(XmTEAR_OFF_ENABLED);
+ define_integer(XmTEAR_OFF_DISABLED);
+ define_integer(XmUNPOST);
+ define_integer(XmUNPOST_AND_REPLAY);
+ define_integer(XmLAST_POSITION);
+ define_integer(XmFIRST_POSITION);
+ define_integer(XmINCHES);
+ define_integer(XmCENTIMETERS);
+ define_integer(XmMILLIMETERS);
+ define_integer(XmPOINTS);
+ define_integer(XmFONT_UNITS);
+ define_integer(XmPER_SHELL);
+ define_integer(XmPER_WIDGET);
+ define_integer(XmINHERIT_POLICY);
+ define_integer(XmPOPUP_DISABLED);
+ define_integer(XmPOPUP_KEYBOARD);
+ define_integer(XmPOPUP_AUTOMATIC);
+ define_integer(XmPOPUP_AUTOMATIC_RECURSIVE);
+ define_integer(XmCOMBO_BOX);
+ define_integer(XmDROP_DOWN_COMBO_BOX);
+ define_integer(XmDROP_DOWN_LIST);
+ define_integer(XmQUICK_NAVIGATE);
+ define_integer(XmINVALID_MATCH_BEHAVIOR);
+ define_integer(XmZERO_BASED);
+ define_integer(XmONE_BASED);
+ define_integer(XmALIGNMENT_CHILD_TOP);
+ define_integer(XmALIGNMENT_CHILD_BOTTOM);
+ define_integer(XmONE_OF_MANY_ROUND);
+ define_integer(XmONE_OF_MANY_DIAMOND);
+ define_integer(XmALIGNMENT_BEGINNING);
+ define_integer(XmALIGNMENT_CENTER);
+ define_integer(XmALIGNMENT_END);
+ define_integer(XmALIGNMENT_BASELINE_TOP);
+ define_integer(XmALIGNMENT_BASELINE_BOTTOM);
+ define_integer(XmALIGNMENT_WIDGET_TOP);
+ define_integer(XmALIGNMENT_WIDGET_BOTTOM);
#ifdef XmALIGNMENT_UNSPECIFIED
- DEFINE_INTEGER(XmALIGNMENT_UNSPECIFIED);
-#endif
- DEFINE_INTEGER(XmFRAME_GENERIC_CHILD);
- DEFINE_INTEGER(XmFRAME_WORKAREA_CHILD);
- DEFINE_INTEGER(XmFRAME_TITLE_CHILD);
- DEFINE_INTEGER(XmN_OF_MANY);
- DEFINE_INTEGER(XmONE_OF_MANY);
- DEFINE_INTEGER(XmATTACH_NONE);
- DEFINE_INTEGER(XmATTACH_FORM);
- DEFINE_INTEGER(XmATTACH_OPPOSITE_FORM);
- DEFINE_INTEGER(XmATTACH_WIDGET);
- DEFINE_INTEGER(XmATTACH_OPPOSITE_WIDGET);
- DEFINE_INTEGER(XmATTACH_POSITION);
- DEFINE_INTEGER(XmATTACH_SELF);
- DEFINE_INTEGER(XmRESIZE_NONE);
- DEFINE_INTEGER(XmRESIZE_GROW);
- DEFINE_INTEGER(XmRESIZE_ANY);
- DEFINE_INTEGER(XmCR_NONE);
- DEFINE_INTEGER(XmCR_HELP);
- DEFINE_INTEGER(XmCR_VALUE_CHANGED);
- DEFINE_INTEGER(XmCR_INCREMENT);
- DEFINE_INTEGER(XmCR_DECREMENT);
- DEFINE_INTEGER(XmCR_PAGE_INCREMENT);
- DEFINE_INTEGER(XmCR_PAGE_DECREMENT);
- DEFINE_INTEGER(XmCR_TO_TOP);
- DEFINE_INTEGER(XmCR_TO_BOTTOM);
- DEFINE_INTEGER(XmCR_DRAG);
- DEFINE_INTEGER(XmCR_ACTIVATE);
- DEFINE_INTEGER(XmCR_ARM);
- DEFINE_INTEGER(XmCR_DISARM);
- DEFINE_INTEGER(XmCR_MAP);
- DEFINE_INTEGER(XmCR_UNMAP);
- DEFINE_INTEGER(XmCR_FOCUS);
- DEFINE_INTEGER(XmCR_LOSING_FOCUS);
- DEFINE_INTEGER(XmCR_MODIFYING_TEXT_VALUE);
- DEFINE_INTEGER(XmCR_MOVING_INSERT_CURSOR);
- DEFINE_INTEGER(XmCR_EXECUTE);
- DEFINE_INTEGER(XmCR_SINGLE_SELECT);
- DEFINE_INTEGER(XmCR_MULTIPLE_SELECT);
- DEFINE_INTEGER(XmCR_EXTENDED_SELECT);
- DEFINE_INTEGER(XmCR_BROWSE_SELECT);
- DEFINE_INTEGER(XmCR_DEFAULT_ACTION);
- DEFINE_INTEGER(XmCR_CLIPBOARD_DATA_REQUEST);
- DEFINE_INTEGER(XmCR_CLIPBOARD_DATA_DELETE);
- DEFINE_INTEGER(XmCR_CASCADING);
- DEFINE_INTEGER(XmCR_OK);
- DEFINE_INTEGER(XmCR_CANCEL);
- DEFINE_INTEGER(XmCR_APPLY);
- DEFINE_INTEGER(XmCR_NO_MATCH);
- DEFINE_INTEGER(XmCR_COMMAND_ENTERED);
- DEFINE_INTEGER(XmCR_COMMAND_CHANGED);
- DEFINE_INTEGER(XmCR_EXPOSE);
- DEFINE_INTEGER(XmCR_RESIZE);
- DEFINE_INTEGER(XmCR_INPUT);
- DEFINE_INTEGER(XmCR_GAIN_PRIMARY);
- DEFINE_INTEGER(XmCR_LOSE_PRIMARY);
- DEFINE_INTEGER(XmCR_CREATE);
- DEFINE_INTEGER(XmCR_TEAR_OFF_ACTIVATE);
- DEFINE_INTEGER(XmCR_TEAR_OFF_DEACTIVATE);
- DEFINE_INTEGER(XmCR_OBSCURED_TRAVERSAL);
- DEFINE_INTEGER(XmCR_FOCUS_MOVED);
- DEFINE_INTEGER(XmCR_REPOST);
- DEFINE_INTEGER(XmCR_COLLAPSED);
- DEFINE_INTEGER(XmCR_EXPANDED);
- DEFINE_INTEGER(XmCR_SELECT);
- DEFINE_INTEGER(XmCR_DRAG_START);
- DEFINE_INTEGER(XmCR_NO_FONT);
- DEFINE_INTEGER(XmCR_NO_RENDITION);
- DEFINE_INTEGER(XmCR_POST);
- DEFINE_INTEGER(XmCR_SPIN_NEXT);
- DEFINE_INTEGER(XmCR_SPIN_PRIOR);
- DEFINE_INTEGER(XmCR_SPIN_FIRST);
- DEFINE_INTEGER(XmCR_SPIN_LAST);
- DEFINE_INTEGER(XmCR_PAGE_SCROLLER_INCREMENT);
- DEFINE_INTEGER(XmCR_PAGE_SCROLLER_DECREMENT);
- DEFINE_INTEGER(XmCR_MAJOR_TAB);
- DEFINE_INTEGER(XmCR_MINOR_TAB);
- DEFINE_INTEGER(XmCR_START_JOB);
- DEFINE_INTEGER(XmCR_END_JOB);
- DEFINE_INTEGER(XmCR_PAGE_SETUP);
- DEFINE_INTEGER(XmCR_PDM_NONE);
- DEFINE_INTEGER(XmCR_PDM_UP);
- DEFINE_INTEGER(XmCR_PDM_START_ERROR);
- DEFINE_INTEGER(XmCR_PDM_START_VXAUTH);
- DEFINE_INTEGER(XmCR_PDM_START_PXAUTH);
- DEFINE_INTEGER(XmCR_PDM_OK);
- DEFINE_INTEGER(XmCR_PDM_CANCEL);
- DEFINE_INTEGER(XmCR_PDM_EXIT_ERROR);
- DEFINE_INTEGER(XmCR_PROTOCOLS);
- DEFINE_INTEGER(XmEACH_SIDE);
- DEFINE_INTEGER(XmMAX_SIDE);
- DEFINE_INTEGER(XmMIN_SIDE);
- DEFINE_INTEGER(XmBACKGROUND_COLOR);
- DEFINE_INTEGER(XmFOREGROUND_COLOR);
- DEFINE_INTEGER(XmTROUGH_COLOR);
- DEFINE_INTEGER(XmSHADOWED_BACKGROUND);
- DEFINE_INTEGER(XmTHUMB_MARK);
- DEFINE_INTEGER(XmROUND_MARK);
- DEFINE_INTEGER(XmNEAR_SLIDER);
- DEFINE_INTEGER(XmNEAR_BORDER);
- DEFINE_INTEGER(XmHOR_SCROLLBAR);
- DEFINE_INTEGER(XmVERT_SCROLLBAR);
- DEFINE_INTEGER(XmCOMMAND_WINDOW);
- DEFINE_INTEGER(XmMESSAGE_WINDOW);
- DEFINE_INTEGER(XmSCROLL_HOR);
- DEFINE_INTEGER(XmSCROLL_VERT);
- DEFINE_INTEGER(XmNO_SCROLL);
- DEFINE_INTEGER(XmCLIP_WINDOW);
- DEFINE_INTEGER(XmGENERIC_CHILD);
- DEFINE_INTEGER(XmAUTO_DRAG_ENABLED);
- DEFINE_INTEGER(XmAUTO_DRAG_DISABLED);
- DEFINE_INTEGER(XmENABLE_WARP_ON);
- DEFINE_INTEGER(XmENABLE_WARP_OFF);
- DEFINE_INTEGER(XmOFF);
- DEFINE_INTEGER(XmBUTTON2_ADJUST);
- DEFINE_INTEGER(XmBUTTON2_TRANSFER);
- DEFINE_INTEGER(XmAUTO_UNSET);
- DEFINE_INTEGER(XmAUTO_BEGIN);
- DEFINE_INTEGER(XmAUTO_MOTION);
- DEFINE_INTEGER(XmAUTO_CANCEL);
- DEFINE_INTEGER(XmAUTO_NO_CHANGE);
- DEFINE_INTEGER(XmAUTO_CHANGE);
- DEFINE_INTEGER(XmDRAG_WINDOW);
- DEFINE_INTEGER(XmSLIDER);
- DEFINE_INTEGER(XmTHERMOMETER);
- DEFINE_INTEGER(XmETCHED_LINE);
- DEFINE_INTEGER(XmMULTICLICK_DISCARD);
- DEFINE_INTEGER(XmMULTICLICK_KEEP);
- DEFINE_INTEGER(XmSHADOW_IN);
- DEFINE_INTEGER(XmSHADOW_OUT);
- DEFINE_INTEGER(XmARROW_UP);
- DEFINE_INTEGER(XmARROW_DOWN);
- DEFINE_INTEGER(XmARROW_LEFT);
- DEFINE_INTEGER(XmARROW_RIGHT);
- DEFINE_INTEGER(XmNO_LINE);
- DEFINE_INTEGER(XmSINGLE_LINE);
- DEFINE_INTEGER(XmDOUBLE_LINE);
- DEFINE_INTEGER(XmSINGLE_DASHED_LINE);
- DEFINE_INTEGER(XmDOUBLE_DASHED_LINE);
- DEFINE_INTEGER(XmSHADOW_ETCHED_IN);
- DEFINE_INTEGER(XmSHADOW_ETCHED_OUT);
- DEFINE_INTEGER(XmSHADOW_ETCHED_IN_DASH);
- DEFINE_INTEGER(XmSHADOW_ETCHED_OUT_DASH);
- DEFINE_INTEGER(XmINVALID_SEPARATOR_TYPE);
- DEFINE_INTEGER(XmPIXMAP);
- DEFINE_INTEGER(XmSTRING);
- DEFINE_INTEGER(XmWINDOW);
- DEFINE_INTEGER(XmCURSOR);
- DEFINE_INTEGER(XmMAX_ON_TOP);
- DEFINE_INTEGER(XmMAX_ON_BOTTOM);
- DEFINE_INTEGER(XmMAX_ON_LEFT);
- DEFINE_INTEGER(XmMAX_ON_RIGHT);
- DEFINE_INTEGER(XmSINGLE_SELECT);
- DEFINE_INTEGER(XmMULTIPLE_SELECT);
- DEFINE_INTEGER(XmEXTENDED_SELECT);
- DEFINE_INTEGER(XmBROWSE_SELECT);
- DEFINE_INTEGER(XmSTATIC);
- DEFINE_INTEGER(XmDYNAMIC);
- DEFINE_INTEGER(XmNORMAL_MODE);
- DEFINE_INTEGER(XmADD_MODE);
- DEFINE_INTEGER(XmNO_AUTO_SELECT);
- DEFINE_INTEGER(XmAUTO_SELECT);
- DEFINE_INTEGER(XmSINGLE);
- DEFINE_INTEGER(XmANY_ICON);
- DEFINE_INTEGER(XmAPPEND);
- DEFINE_INTEGER(XmCLOSEST);
- DEFINE_INTEGER(XmFIRST_FIT);
- DEFINE_INTEGER(XmOUTLINE);
- DEFINE_INTEGER(XmSPATIAL);
- DEFINE_INTEGER(XmDETAIL);
- DEFINE_INTEGER(XmOUTLINE_BUTTON_PRESENT);
- DEFINE_INTEGER(XmOUTLINE_BUTTON_ABSENT);
- DEFINE_INTEGER(XmGRID);
- DEFINE_INTEGER(XmCELLS);
- DEFINE_INTEGER(XmOWN_NEVER);
- DEFINE_INTEGER(XmOWN_ALWAYS);
- DEFINE_INTEGER(XmOWN_MULTIPLE);
- DEFINE_INTEGER(XmOWN_POSSIBLE_MULTIPLE);
- DEFINE_INTEGER(XmGROW_MINOR);
- DEFINE_INTEGER(XmGROW_MAJOR);
- DEFINE_INTEGER(XmGROW_BALANCED);
- DEFINE_INTEGER(XmMARQUEE);
- DEFINE_INTEGER(XmMARQUEE_EXTEND_START);
- DEFINE_INTEGER(XmMARQUEE_EXTEND_BOTH);
- DEFINE_INTEGER(XmTOUCH_ONLY);
- DEFINE_INTEGER(XmTOUCH_OVER);
- DEFINE_INTEGER(XmSNAP_TO_GRID);
- DEFINE_INTEGER(XmCENTER);
- DEFINE_INTEGER(XmCOLLAPSED);
- DEFINE_INTEGER(XmEXPANDED);
- DEFINE_INTEGER(XmLARGE_ICON);
- DEFINE_INTEGER(XmSMALL_ICON);
- DEFINE_INTEGER(XmSELECTED);
- DEFINE_INTEGER(XmNOT_SELECTED);
- DEFINE_INTEGER(XmSOLID);
- DEFINE_INTEGER(XmSPIRAL);
- DEFINE_INTEGER(XmPIXMAP_OVERLAP_ONLY);
- DEFINE_INTEGER(XmPAGE);
- DEFINE_INTEGER(XmMAJOR_TAB);
- DEFINE_INTEGER(XmMINOR_TAB);
- DEFINE_INTEGER(XmSTATUS_AREA);
- DEFINE_INTEGER(XmPAGE_SCROLLER);
- DEFINE_INTEGER(XmARROWS_VERTICAL);
- DEFINE_INTEGER(XmARROWS_HORIZONTAL);
- DEFINE_INTEGER(XmARROWS_END);
- DEFINE_INTEGER(XmARROWS_BEGINNING);
- DEFINE_INTEGER(XmARROWS_SPLIT);
- DEFINE_INTEGER(XmARROWS_FLAT_END);
- DEFINE_INTEGER(XmARROWS_FLAT_BEGINNING);
- DEFINE_INTEGER(XmARROWS_INSENSITIVE);
- DEFINE_INTEGER(XmARROWS_INCREMENT_SENSITIVE);
- DEFINE_INTEGER(XmARROWS_DECREMENT_SENSITIVE);
- DEFINE_INTEGER(XmARROWS_SENSITIVE);
- DEFINE_INTEGER(XmARROWS_DEFAULT_SENSITIVITY);
- DEFINE_INTEGER(XmPOSITION_INDEX);
- DEFINE_INTEGER(XmPOSITION_VALUE);
- DEFINE_INTEGER(XmNUMERIC);
- DEFINE_INTEGER(XmVALID_VALUE);
- DEFINE_INTEGER(XmCURRENT_VALUE);
- DEFINE_INTEGER(XmMAXIMUM_VALUE);
- DEFINE_INTEGER(XmMINIMUM_VALUE);
- DEFINE_INTEGER(XmINCREMENT_VALUE);
- DEFINE_INTEGER(XmSELECT_OUT_LINE);
- DEFINE_INTEGER(XmSEE_DETAIL);
- DEFINE_INTEGER(XmVARIABLE);
- DEFINE_INTEGER(XmCONSTANT);
- DEFINE_INTEGER(XmRESIZE_IF_POSSIBLE);
- DEFINE_INTEGER(XmAUTOMATIC);
- DEFINE_INTEGER(XmAPPLICATION_DEFINED);
- DEFINE_INTEGER(XmAS_NEEDED);
- DEFINE_INTEGER(XmCOMMAND_ABOVE_WORKSPACE);
- DEFINE_INTEGER(XmCOMMAND_BELOW_WORKSPACE);
- DEFINE_INTEGER(XmMULTI_LINE_EDIT);
- DEFINE_INTEGER(XmSINGLE_LINE_EDIT);
- DEFINE_INTEGER(XmTEXT_FORWARD);
- DEFINE_INTEGER(XmTEXT_BACKWARD);
- DEFINE_INTEGER(XmSELECT_POSITION);
- DEFINE_INTEGER(XmSELECT_WHITESPACE);
- DEFINE_INTEGER(XmSELECT_WORD);
- DEFINE_INTEGER(XmSELECT_LINE);
- DEFINE_INTEGER(XmSELECT_ALL);
- DEFINE_INTEGER(XmSELECT_PARAGRAPH);
- DEFINE_INTEGER(XmHIGHLIGHT_NORMAL);
- DEFINE_INTEGER(XmHIGHLIGHT_SELECTED);
- DEFINE_INTEGER(XmHIGHLIGHT_SECONDARY_SELECTED);
- DEFINE_INTEGER(XmDIALOG_NONE);
- DEFINE_INTEGER(XmDIALOG_APPLY_BUTTON);
- DEFINE_INTEGER(XmDIALOG_CANCEL_BUTTON);
- DEFINE_INTEGER(XmDIALOG_DEFAULT_BUTTON);
- DEFINE_INTEGER(XmDIALOG_OK_BUTTON);
- DEFINE_INTEGER(XmDIALOG_FILTER_LABEL);
- DEFINE_INTEGER(XmDIALOG_FILTER_TEXT);
- DEFINE_INTEGER(XmDIALOG_HELP_BUTTON);
- DEFINE_INTEGER(XmDIALOG_LIST);
- DEFINE_INTEGER(XmDIALOG_LIST_LABEL);
- DEFINE_INTEGER(XmDIALOG_MESSAGE_LABEL);
- DEFINE_INTEGER(XmDIALOG_SELECTION_LABEL);
- DEFINE_INTEGER(XmDIALOG_SYMBOL_LABEL);
- DEFINE_INTEGER(XmDIALOG_TEXT);
- DEFINE_INTEGER(XmDIALOG_SEPARATOR);
- DEFINE_INTEGER(XmDIALOG_DIR_LIST);
- DEFINE_INTEGER(XmDIALOG_DIR_LIST_LABEL);
- DEFINE_INTEGER(XmDIALOG_MODELESS);
- DEFINE_INTEGER(XmDIALOG_PRIMARY_APPLICATION_MODAL);
- DEFINE_INTEGER(XmDIALOG_FULL_APPLICATION_MODAL);
- DEFINE_INTEGER(XmDIALOG_SYSTEM_MODAL);
- DEFINE_INTEGER(XmPLACE_TOP);
- DEFINE_INTEGER(XmPLACE_ABOVE_SELECTION);
- DEFINE_INTEGER(XmPLACE_BELOW_SELECTION);
- DEFINE_INTEGER(XmDIALOG_WORK_AREA);
- DEFINE_INTEGER(XmDIALOG_PROMPT);
- DEFINE_INTEGER(XmDIALOG_SELECTION);
- DEFINE_INTEGER(XmDIALOG_COMMAND);
- DEFINE_INTEGER(XmDIALOG_FILE_SELECTION);
- DEFINE_INTEGER(XmDIALOG_TEMPLATE);
- DEFINE_INTEGER(XmDIALOG_ERROR);
- DEFINE_INTEGER(XmDIALOG_INFORMATION);
- DEFINE_INTEGER(XmDIALOG_MESSAGE);
- DEFINE_INTEGER(XmDIALOG_QUESTION);
- DEFINE_INTEGER(XmDIALOG_WARNING);
- DEFINE_INTEGER(XmDIALOG_WORKING);
- DEFINE_INTEGER(XmVISIBILITY_UNOBSCURED);
- DEFINE_INTEGER(XmVISIBILITY_PARTIALLY_OBSCURED);
- DEFINE_INTEGER(XmVISIBILITY_FULLY_OBSCURED);
- DEFINE_INTEGER(XmTRAVERSE_CURRENT);
- DEFINE_INTEGER(XmTRAVERSE_NEXT);
- DEFINE_INTEGER(XmTRAVERSE_PREV);
- DEFINE_INTEGER(XmTRAVERSE_HOME);
- DEFINE_INTEGER(XmTRAVERSE_NEXT_TAB_GROUP);
- DEFINE_INTEGER(XmTRAVERSE_PREV_TAB_GROUP);
- DEFINE_INTEGER(XmTRAVERSE_UP);
- DEFINE_INTEGER(XmTRAVERSE_DOWN);
- DEFINE_INTEGER(XmTRAVERSE_LEFT);
- DEFINE_INTEGER(XmTRAVERSE_RIGHT);
- DEFINE_INTEGER(XmPUSHBUTTON);
- DEFINE_INTEGER(XmTOGGLEBUTTON);
- DEFINE_INTEGER(XmRADIOBUTTON);
- DEFINE_INTEGER(XmCASCADEBUTTON);
- DEFINE_INTEGER(XmSEPARATOR);
- DEFINE_INTEGER(XmDOUBLE_SEPARATOR);
- DEFINE_INTEGER(XmTITLE);
- DEFINE_INTEGER(XmBOTTOM_RIGHT);
- DEFINE_INTEGER(XmBOTTOM_LEFT);
- DEFINE_INTEGER(XmTOP_RIGHT);
- DEFINE_INTEGER(XmTOP_LEFT);
- DEFINE_INTEGER(XmTRAVERSE_GLOBALLY_FORWARD);
- DEFINE_INTEGER(XmTRAVERSE_GLOBALLY_BACKWARD);
- DEFINE_INTEGER(XmMATCH_DEPTH);
- DEFINE_INTEGER(XmDYNAMIC_DEPTH);
- DEFINE_INTEGER(XmPDM_NOTIFY_FAIL);
- DEFINE_INTEGER(XmPDM_NOTIFY_SUCCESS);
- DEFINE_INTEGER(XmINDICATOR_NONE);
- DEFINE_INTEGER(XmINDICATOR_FILL);
- DEFINE_INTEGER(XmINDICATOR_BOX);
- DEFINE_INTEGER(XmINDICATOR_CHECK);
- DEFINE_INTEGER(XmINDICATOR_CHECK_BOX);
- DEFINE_INTEGER(XmINDICATOR_CROSS);
- DEFINE_INTEGER(XmINDICATOR_CROSS_BOX);
- DEFINE_INTEGER(XmUNSET);
- DEFINE_INTEGER(XmSET);
- DEFINE_INTEGER(XmINDETERMINATE);
- DEFINE_INTEGER(XmTOGGLE_BOOLEAN);
- DEFINE_INTEGER(XmTOGGLE_INDETERMINATE);
- DEFINE_INTEGER(XmPATH_MODE_FULL);
- DEFINE_INTEGER(XmPATH_MODE_RELATIVE);
- DEFINE_INTEGER(XmFILTER_NONE);
- DEFINE_INTEGER(XmFILTER_HIDDEN_FILES);
-#if HAVE_XmCreateColorSelector
- DEFINE_INTEGER(XmScaleMode);
- DEFINE_INTEGER(XmListMode);
-#endif
-#endif
-#if HAVE_XSHAPEQUERYEXTENSION
- DEFINE_INTEGER(ShapeSet);
- DEFINE_INTEGER(ShapeUnion);
- DEFINE_INTEGER(ShapeIntersect);
- DEFINE_INTEGER(ShapeSubtract);
- DEFINE_INTEGER(ShapeInvert);
- DEFINE_INTEGER(ShapeBounding);
- DEFINE_INTEGER(ShapeClip);
-#endif
-
-#if HAVE_XmCreateButtonBox
- DEFINE_INTEGER(XmFillNone);
- DEFINE_INTEGER(XmFillMajor);
- DEFINE_INTEGER(XmFillMinor);
- DEFINE_INTEGER(XmFillAll);
- DEFINE_INTEGER(XmIconTop);
- DEFINE_INTEGER(XmIconLeft);
- DEFINE_INTEGER(XmIconRight);
- DEFINE_INTEGER(XmIconBottom);
- DEFINE_INTEGER(XmIconOnly);
- DEFINE_INTEGER(XmIconNone);
+ define_integer(XmALIGNMENT_UNSPECIFIED);
#endif
+ define_integer(XmFRAME_GENERIC_CHILD);
+ define_integer(XmFRAME_WORKAREA_CHILD);
+ define_integer(XmFRAME_TITLE_CHILD);
+ define_integer(XmN_OF_MANY);
+ define_integer(XmONE_OF_MANY);
+ define_integer(XmATTACH_NONE);
+ define_integer(XmATTACH_FORM);
+ define_integer(XmATTACH_OPPOSITE_FORM);
+ define_integer(XmATTACH_WIDGET);
+ define_integer(XmATTACH_OPPOSITE_WIDGET);
+ define_integer(XmATTACH_POSITION);
+ define_integer(XmATTACH_SELF);
+ define_integer(XmRESIZE_NONE);
+ define_integer(XmRESIZE_GROW);
+ define_integer(XmRESIZE_ANY);
+ define_integer(XmCR_NONE);
+ define_integer(XmCR_HELP);
+ define_integer(XmCR_VALUE_CHANGED);
+ define_integer(XmCR_INCREMENT);
+ define_integer(XmCR_DECREMENT);
+ define_integer(XmCR_PAGE_INCREMENT);
+ define_integer(XmCR_PAGE_DECREMENT);
+ define_integer(XmCR_TO_TOP);
+ define_integer(XmCR_TO_BOTTOM);
+ define_integer(XmCR_DRAG);
+ define_integer(XmCR_ACTIVATE);
+ define_integer(XmCR_ARM);
+ define_integer(XmCR_DISARM);
+ define_integer(XmCR_MAP);
+ define_integer(XmCR_UNMAP);
+ define_integer(XmCR_FOCUS);
+ define_integer(XmCR_LOSING_FOCUS);
+ define_integer(XmCR_MODIFYING_TEXT_VALUE);
+ define_integer(XmCR_MOVING_INSERT_CURSOR);
+ define_integer(XmCR_EXECUTE);
+ define_integer(XmCR_SINGLE_SELECT);
+ define_integer(XmCR_MULTIPLE_SELECT);
+ define_integer(XmCR_EXTENDED_SELECT);
+ define_integer(XmCR_BROWSE_SELECT);
+ define_integer(XmCR_DEFAULT_ACTION);
+ define_integer(XmCR_CLIPBOARD_DATA_REQUEST);
+ define_integer(XmCR_CLIPBOARD_DATA_DELETE);
+ define_integer(XmCR_CASCADING);
+ define_integer(XmCR_OK);
+ define_integer(XmCR_CANCEL);
+ define_integer(XmCR_APPLY);
+ define_integer(XmCR_NO_MATCH);
+ define_integer(XmCR_COMMAND_ENTERED);
+ define_integer(XmCR_COMMAND_CHANGED);
+ define_integer(XmCR_EXPOSE);
+ define_integer(XmCR_RESIZE);
+ define_integer(XmCR_INPUT);
+ define_integer(XmCR_GAIN_PRIMARY);
+ define_integer(XmCR_LOSE_PRIMARY);
+ define_integer(XmCR_CREATE);
+ define_integer(XmCR_TEAR_OFF_ACTIVATE);
+ define_integer(XmCR_TEAR_OFF_DEACTIVATE);
+ define_integer(XmCR_OBSCURED_TRAVERSAL);
+ define_integer(XmCR_FOCUS_MOVED);
+ define_integer(XmCR_REPOST);
+ define_integer(XmCR_COLLAPSED);
+ define_integer(XmCR_EXPANDED);
+ define_integer(XmCR_SELECT);
+ define_integer(XmCR_DRAG_START);
+ define_integer(XmCR_NO_FONT);
+ define_integer(XmCR_NO_RENDITION);
+ define_integer(XmCR_POST);
+ define_integer(XmCR_SPIN_NEXT);
+ define_integer(XmCR_SPIN_PRIOR);
+ define_integer(XmCR_SPIN_FIRST);
+ define_integer(XmCR_SPIN_LAST);
+ define_integer(XmCR_PAGE_SCROLLER_INCREMENT);
+ define_integer(XmCR_PAGE_SCROLLER_DECREMENT);
+ define_integer(XmCR_MAJOR_TAB);
+ define_integer(XmCR_MINOR_TAB);
+ define_integer(XmCR_START_JOB);
+ define_integer(XmCR_END_JOB);
+ define_integer(XmCR_PAGE_SETUP);
+ define_integer(XmCR_PDM_NONE);
+ define_integer(XmCR_PDM_UP);
+ define_integer(XmCR_PDM_START_ERROR);
+ define_integer(XmCR_PDM_START_VXAUTH);
+ define_integer(XmCR_PDM_START_PXAUTH);
+ define_integer(XmCR_PDM_OK);
+ define_integer(XmCR_PDM_CANCEL);
+ define_integer(XmCR_PDM_EXIT_ERROR);
+ define_integer(XmCR_PROTOCOLS);
+ define_integer(XmEACH_SIDE);
+ define_integer(XmMAX_SIDE);
+ define_integer(XmMIN_SIDE);
+ define_integer(XmBACKGROUND_COLOR);
+ define_integer(XmFOREGROUND_COLOR);
+ define_integer(XmTROUGH_COLOR);
+ define_integer(XmSHADOWED_BACKGROUND);
+ define_integer(XmTHUMB_MARK);
+ define_integer(XmROUND_MARK);
+ define_integer(XmNEAR_SLIDER);
+ define_integer(XmNEAR_BORDER);
+ define_integer(XmHOR_SCROLLBAR);
+ define_integer(XmVERT_SCROLLBAR);
+ define_integer(XmCOMMAND_WINDOW);
+ define_integer(XmMESSAGE_WINDOW);
+ define_integer(XmSCROLL_HOR);
+ define_integer(XmSCROLL_VERT);
+ define_integer(XmNO_SCROLL);
+ define_integer(XmCLIP_WINDOW);
+ define_integer(XmGENERIC_CHILD);
+ define_integer(XmAUTO_DRAG_ENABLED);
+ define_integer(XmAUTO_DRAG_DISABLED);
+ define_integer(XmENABLE_WARP_ON);
+ define_integer(XmENABLE_WARP_OFF);
+ define_integer(XmOFF);
+ define_integer(XmBUTTON2_ADJUST);
+ define_integer(XmBUTTON2_TRANSFER);
+ define_integer(XmAUTO_UNSET);
+ define_integer(XmAUTO_BEGIN);
+ define_integer(XmAUTO_MOTION);
+ define_integer(XmAUTO_CANCEL);
+ define_integer(XmAUTO_NO_CHANGE);
+ define_integer(XmAUTO_CHANGE);
+ define_integer(XmDRAG_WINDOW);
+ define_integer(XmSLIDER);
+ define_integer(XmTHERMOMETER);
+ define_integer(XmETCHED_LINE);
+ define_integer(XmMULTICLICK_DISCARD);
+ define_integer(XmMULTICLICK_KEEP);
+ define_integer(XmSHADOW_IN);
+ define_integer(XmSHADOW_OUT);
+ define_integer(XmARROW_UP);
+ define_integer(XmARROW_DOWN);
+ define_integer(XmARROW_LEFT);
+ define_integer(XmARROW_RIGHT);
+ define_integer(XmNO_LINE);
+ define_integer(XmSINGLE_LINE);
+ define_integer(XmDOUBLE_LINE);
+ define_integer(XmSINGLE_DASHED_LINE);
+ define_integer(XmDOUBLE_DASHED_LINE);
+ define_integer(XmSHADOW_ETCHED_IN);
+ define_integer(XmSHADOW_ETCHED_OUT);
+ define_integer(XmSHADOW_ETCHED_IN_DASH);
+ define_integer(XmSHADOW_ETCHED_OUT_DASH);
+ define_integer(XmINVALID_SEPARATOR_TYPE);
+ define_integer(XmPIXMAP);
+ define_integer(XmSTRING);
+ define_integer(XmWINDOW);
+ define_integer(XmCURSOR);
+ define_integer(XmMAX_ON_TOP);
+ define_integer(XmMAX_ON_BOTTOM);
+ define_integer(XmMAX_ON_LEFT);
+ define_integer(XmMAX_ON_RIGHT);
+ define_integer(XmSINGLE_SELECT);
+ define_integer(XmMULTIPLE_SELECT);
+ define_integer(XmEXTENDED_SELECT);
+ define_integer(XmBROWSE_SELECT);
+ define_integer(XmSTATIC);
+ define_integer(XmDYNAMIC);
+ define_integer(XmNORMAL_MODE);
+ define_integer(XmADD_MODE);
+ define_integer(XmNO_AUTO_SELECT);
+ define_integer(XmAUTO_SELECT);
+ define_integer(XmSINGLE);
+ define_integer(XmANY_ICON);
+ define_integer(XmAPPEND);
+ define_integer(XmCLOSEST);
+ define_integer(XmFIRST_FIT);
+ define_integer(XmOUTLINE);
+ define_integer(XmSPATIAL);
+ define_integer(XmDETAIL);
+ define_integer(XmOUTLINE_BUTTON_PRESENT);
+ define_integer(XmOUTLINE_BUTTON_ABSENT);
+ define_integer(XmGRID);
+ define_integer(XmCELLS);
+ define_integer(XmOWN_NEVER);
+ define_integer(XmOWN_ALWAYS);
+ define_integer(XmOWN_MULTIPLE);
+ define_integer(XmOWN_POSSIBLE_MULTIPLE);
+ define_integer(XmGROW_MINOR);
+ define_integer(XmGROW_MAJOR);
+ define_integer(XmGROW_BALANCED);
+ define_integer(XmMARQUEE);
+ define_integer(XmMARQUEE_EXTEND_START);
+ define_integer(XmMARQUEE_EXTEND_BOTH);
+ define_integer(XmTOUCH_ONLY);
+ define_integer(XmTOUCH_OVER);
+ define_integer(XmSNAP_TO_GRID);
+ define_integer(XmCENTER);
+ define_integer(XmCOLLAPSED);
+ define_integer(XmEXPANDED);
+ define_integer(XmLARGE_ICON);
+ define_integer(XmSMALL_ICON);
+ define_integer(XmSELECTED);
+ define_integer(XmNOT_SELECTED);
+ define_integer(XmSOLID);
+ define_integer(XmSPIRAL);
+ define_integer(XmPIXMAP_OVERLAP_ONLY);
+ define_integer(XmPAGE);
+ define_integer(XmMAJOR_TAB);
+ define_integer(XmMINOR_TAB);
+ define_integer(XmSTATUS_AREA);
+ define_integer(XmPAGE_SCROLLER);
+ define_integer(XmARROWS_VERTICAL);
+ define_integer(XmARROWS_HORIZONTAL);
+ define_integer(XmARROWS_END);
+ define_integer(XmARROWS_BEGINNING);
+ define_integer(XmARROWS_SPLIT);
+ define_integer(XmARROWS_FLAT_END);
+ define_integer(XmARROWS_FLAT_BEGINNING);
+ define_integer(XmARROWS_INSENSITIVE);
+ define_integer(XmARROWS_INCREMENT_SENSITIVE);
+ define_integer(XmARROWS_DECREMENT_SENSITIVE);
+ define_integer(XmARROWS_SENSITIVE);
+ define_integer(XmARROWS_DEFAULT_SENSITIVITY);
+ define_integer(XmPOSITION_INDEX);
+ define_integer(XmPOSITION_VALUE);
+ define_integer(XmNUMERIC);
+ define_integer(XmVALID_VALUE);
+ define_integer(XmCURRENT_VALUE);
+ define_integer(XmMAXIMUM_VALUE);
+ define_integer(XmMINIMUM_VALUE);
+ define_integer(XmINCREMENT_VALUE);
+ define_integer(XmSELECT_OUT_LINE);
+ define_integer(XmSEE_DETAIL);
+ define_integer(XmVARIABLE);
+ define_integer(XmCONSTANT);
+ define_integer(XmRESIZE_IF_POSSIBLE);
+ define_integer(XmAUTOMATIC);
+ define_integer(XmAPPLICATION_DEFINED);
+ define_integer(XmAS_NEEDED);
+ define_integer(XmCOMMAND_ABOVE_WORKSPACE);
+ define_integer(XmCOMMAND_BELOW_WORKSPACE);
+ define_integer(XmMULTI_LINE_EDIT);
+ define_integer(XmSINGLE_LINE_EDIT);
+ define_integer(XmTEXT_FORWARD);
+ define_integer(XmTEXT_BACKWARD);
+ define_integer(XmSELECT_POSITION);
+ define_integer(XmSELECT_WHITESPACE);
+ define_integer(XmSELECT_WORD);
+ define_integer(XmSELECT_LINE);
+ define_integer(XmSELECT_ALL);
+ define_integer(XmSELECT_PARAGRAPH);
+ define_integer(XmHIGHLIGHT_NORMAL);
+ define_integer(XmHIGHLIGHT_SELECTED);
+ define_integer(XmHIGHLIGHT_SECONDARY_SELECTED);
+ define_integer(XmDIALOG_NONE);
+ define_integer(XmDIALOG_APPLY_BUTTON);
+ define_integer(XmDIALOG_CANCEL_BUTTON);
+ define_integer(XmDIALOG_DEFAULT_BUTTON);
+ define_integer(XmDIALOG_OK_BUTTON);
+ define_integer(XmDIALOG_FILTER_LABEL);
+ define_integer(XmDIALOG_FILTER_TEXT);
+ define_integer(XmDIALOG_HELP_BUTTON);
+ define_integer(XmDIALOG_LIST);
+ define_integer(XmDIALOG_LIST_LABEL);
+ define_integer(XmDIALOG_MESSAGE_LABEL);
+ define_integer(XmDIALOG_SELECTION_LABEL);
+ define_integer(XmDIALOG_SYMBOL_LABEL);
+ define_integer(XmDIALOG_TEXT);
+ define_integer(XmDIALOG_SEPARATOR);
+ define_integer(XmDIALOG_DIR_LIST);
+ define_integer(XmDIALOG_DIR_LIST_LABEL);
+ define_integer(XmDIALOG_MODELESS);
+ define_integer(XmDIALOG_PRIMARY_APPLICATION_MODAL);
+ define_integer(XmDIALOG_FULL_APPLICATION_MODAL);
+ define_integer(XmDIALOG_SYSTEM_MODAL);
+ define_integer(XmPLACE_TOP);
+ define_integer(XmPLACE_ABOVE_SELECTION);
+ define_integer(XmPLACE_BELOW_SELECTION);
+ define_integer(XmDIALOG_WORK_AREA);
+ define_integer(XmDIALOG_PROMPT);
+ define_integer(XmDIALOG_SELECTION);
+ define_integer(XmDIALOG_COMMAND);
+ define_integer(XmDIALOG_FILE_SELECTION);
+ define_integer(XmDIALOG_TEMPLATE);
+ define_integer(XmDIALOG_ERROR);
+ define_integer(XmDIALOG_INFORMATION);
+ define_integer(XmDIALOG_MESSAGE);
+ define_integer(XmDIALOG_QUESTION);
+ define_integer(XmDIALOG_WARNING);
+ define_integer(XmDIALOG_WORKING);
+ define_integer(XmVISIBILITY_UNOBSCURED);
+ define_integer(XmVISIBILITY_PARTIALLY_OBSCURED);
+ define_integer(XmVISIBILITY_FULLY_OBSCURED);
+ define_integer(XmTRAVERSE_CURRENT);
+ define_integer(XmTRAVERSE_NEXT);
+ define_integer(XmTRAVERSE_PREV);
+ define_integer(XmTRAVERSE_HOME);
+ define_integer(XmTRAVERSE_NEXT_TAB_GROUP);
+ define_integer(XmTRAVERSE_PREV_TAB_GROUP);
+ define_integer(XmTRAVERSE_UP);
+ define_integer(XmTRAVERSE_DOWN);
+ define_integer(XmTRAVERSE_LEFT);
+ define_integer(XmTRAVERSE_RIGHT);
+ define_integer(XmPUSHBUTTON);
+ define_integer(XmTOGGLEBUTTON);
+ define_integer(XmRADIOBUTTON);
+ define_integer(XmCASCADEBUTTON);
+ define_integer(XmSEPARATOR);
+ define_integer(XmDOUBLE_SEPARATOR);
+ define_integer(XmTITLE);
+ define_integer(XmBOTTOM_RIGHT);
+ define_integer(XmBOTTOM_LEFT);
+ define_integer(XmTOP_RIGHT);
+ define_integer(XmTOP_LEFT);
+ define_integer(XmTRAVERSE_GLOBALLY_FORWARD);
+ define_integer(XmTRAVERSE_GLOBALLY_BACKWARD);
+ define_integer(XmMATCH_DEPTH);
+ define_integer(XmDYNAMIC_DEPTH);
+ define_integer(XmPDM_NOTIFY_FAIL);
+ define_integer(XmPDM_NOTIFY_SUCCESS);
+ define_integer(XmINDICATOR_NONE);
+ define_integer(XmINDICATOR_FILL);
+ define_integer(XmINDICATOR_BOX);
+ define_integer(XmINDICATOR_CHECK);
+ define_integer(XmINDICATOR_CHECK_BOX);
+ define_integer(XmINDICATOR_CROSS);
+ define_integer(XmINDICATOR_CROSS_BOX);
+ define_integer(XmUNSET);
+ define_integer(XmSET);
+ define_integer(XmINDETERMINATE);
+ define_integer(XmTOGGLE_BOOLEAN);
+ define_integer(XmTOGGLE_INDETERMINATE);
+ define_integer(XmPATH_MODE_FULL);
+ define_integer(XmPATH_MODE_RELATIVE);
+ define_integer(XmFILTER_NONE);
+ define_integer(XmFILTER_HIDDEN_FILES);
-#if HAVE_XmCreateColumn
- DEFINE_INTEGER(XmDISTRIBUTE_SPREAD);
- DEFINE_INTEGER(XmDISTRIBUTE_TIGHT);
- DEFINE_INTEGER(XmFILL_RAGGED);
- DEFINE_INTEGER(XmFILL_FLUSH);
- DEFINE_INTEGER(XmFILL_UNSPECIFIED);
-
- /*assume this goes with the others */
- /* DEFINE_INTEGER(XmPIXMAP_AND_STRING); */
-#endif
-
-#if HAVE_XmTabStack
- DEFINE_INTEGER(XmTABS_SQUARED);
- DEFINE_INTEGER(XmTABS_ROUNDED);
- DEFINE_INTEGER(XmTABS_BEVELED);
- DEFINE_INTEGER(XmTABS_BASIC);
- DEFINE_INTEGER(XmTABS_STACKED);
- DEFINE_INTEGER(XmTABS_STACKED_STATIC);
- DEFINE_INTEGER(XmTABS_SCROLLED);
- DEFINE_INTEGER(XmTABS_OVERLAYED);
- DEFINE_INTEGER(XmTAB_ORIENTATION_DYNAMIC);
- DEFINE_INTEGER(XmTABS_RIGHT_TO_LEFT);
- DEFINE_INTEGER(XmTABS_LEFT_TO_RIGHT);
- DEFINE_INTEGER(XmTABS_TOP_TO_BOTTOM);
- DEFINE_INTEGER(XmTABS_BOTTOM_TO_TOP);
- DEFINE_INTEGER(XmTAB_EDGE_TOP_LEFT);
- DEFINE_INTEGER(XmTAB_EDGE_BOTTOM_RIGHT);
- DEFINE_INTEGER(XmTAB_ARROWS_ON_RIGHT);
- DEFINE_INTEGER(XmTAB_ARROWS_ON_LEFT);
- DEFINE_INTEGER(XmTAB_ARROWS_SPLIT);
- DEFINE_INTEGER(XmCR_TAB_SELECTED);
- DEFINE_INTEGER(XmCR_TAB_UNSELECTED);
- DEFINE_INTEGER(XmTABS_ON_TOP);
- DEFINE_INTEGER(XmTABS_ON_BOTTOM);
- DEFINE_INTEGER(XmTABS_ON_RIGHT);
- DEFINE_INTEGER(XmTABS_ON_LEFT);
- DEFINE_INTEGER(XmPIXMAP_TOP);
- DEFINE_INTEGER(XmPIXMAP_BOTTOM);
- DEFINE_INTEGER(XmPIXMAP_RIGHT);
- DEFINE_INTEGER(XmPIXMAP_LEFT);
- DEFINE_INTEGER(XmPIXMAP_NONE);
- DEFINE_INTEGER(XmPIXMAP_ONLY);
- DEFINE_INTEGER(XmTAB_VALUE_COPY);
- DEFINE_INTEGER(XmTAB_VALUE_SHARE);
- DEFINE_INTEGER(XmTAB_CMP_VISUAL);
- DEFINE_INTEGER(XmTAB_CMP_SIZE);
- DEFINE_INTEGER(XmTAB_CMP_EQUAL);
+#if HAVE_XSHAPEQUERYEXTENSION
+ define_integer(ShapeSet);
+ define_integer(ShapeUnion);
+ define_integer(ShapeIntersect);
+ define_integer(ShapeSubtract);
+ define_integer(ShapeInvert);
+ define_integer(ShapeBounding);
+ define_integer(ShapeClip);
#endif
}
@@ -27794,97 +25404,69 @@ static void define_integers(void)
static void define_pointers(void)
{
-#if HAVE_MOTIF
-
-#if HAVE_SCHEME
- #define DEFINE_POINTER(Name) s7_define_constant(s7, XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_WidgetClass(Name))
-#else
- #define DEFINE_POINTER(Name) XEN_DEFINE(XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_WidgetClass(Name))
-#endif
-
- DEFINE_POINTER(compositeWidgetClass);
- DEFINE_POINTER(constraintWidgetClass);
- DEFINE_POINTER(coreWidgetClass);
- DEFINE_POINTER(widgetClass);
- DEFINE_POINTER(objectClass);
- DEFINE_POINTER(rectObjClass);
- DEFINE_POINTER(shellWidgetClass);
- DEFINE_POINTER(overrideShellWidgetClass);
- DEFINE_POINTER(wmShellWidgetClass);
- DEFINE_POINTER(transientShellWidgetClass);
- DEFINE_POINTER(topLevelShellWidgetClass);
- DEFINE_POINTER(applicationShellWidgetClass);
- DEFINE_POINTER(sessionShellWidgetClass);
- DEFINE_POINTER(vendorShellWidgetClass);
- DEFINE_POINTER(xmArrowButtonGadgetClass);
- DEFINE_POINTER(xmArrowButtonWidgetClass);
- DEFINE_POINTER(xmBulletinBoardWidgetClass);
- DEFINE_POINTER(xmCascadeButtonGadgetClass);
- DEFINE_POINTER(xmCascadeButtonWidgetClass);
- DEFINE_POINTER(xmCommandWidgetClass);
- DEFINE_POINTER(xmDialogShellWidgetClass);
- DEFINE_POINTER(xmDragContextClass);
- DEFINE_POINTER(xmDragIconObjectClass);
- DEFINE_POINTER(xmDragOverShellWidgetClass);
- DEFINE_POINTER(xmDrawingAreaWidgetClass);
- DEFINE_POINTER(xmDrawnButtonWidgetClass);
- DEFINE_POINTER(xmDropSiteManagerObjectClass);
- DEFINE_POINTER(xmDropTransferObjectClass);
- DEFINE_POINTER(xmFileSelectionBoxWidgetClass);
- DEFINE_POINTER(xmFormWidgetClass);
- DEFINE_POINTER(xmFrameWidgetClass);
- DEFINE_POINTER(xmGadgetClass);
- DEFINE_POINTER(xmLabelGadgetClass);
- DEFINE_POINTER(xmLabelWidgetClass);
- DEFINE_POINTER(xmListWidgetClass);
- DEFINE_POINTER(xmMainWindowWidgetClass);
- DEFINE_POINTER(xmManagerWidgetClass);
- DEFINE_POINTER(xmMenuShellWidgetClass);
- DEFINE_POINTER(xmMessageBoxWidgetClass);
- DEFINE_POINTER(xmPanedWindowWidgetClass);
- DEFINE_POINTER(xmPrimitiveWidgetClass);
- DEFINE_POINTER(xmPushButtonGadgetClass);
- DEFINE_POINTER(xmPushButtonWidgetClass);
- DEFINE_POINTER(xmRowColumnWidgetClass);
- DEFINE_POINTER(xmScaleWidgetClass);
- DEFINE_POINTER(xmScrollBarWidgetClass);
- DEFINE_POINTER(xmScrolledWindowWidgetClass);
- DEFINE_POINTER(xmSelectionBoxWidgetClass);
- DEFINE_POINTER(xmSeparatorGadgetClass);
- DEFINE_POINTER(xmSeparatorWidgetClass);
- DEFINE_POINTER(xmTextFieldWidgetClass);
- DEFINE_POINTER(xmTextWidgetClass);
- DEFINE_POINTER(xmToggleButtonGadgetClass);
- DEFINE_POINTER(xmToggleButtonWidgetClass);
- DEFINE_POINTER(xmContainerWidgetClass);
- DEFINE_POINTER(xmComboBoxWidgetClass);
- DEFINE_POINTER(xmGrabShellWidgetClass);
- DEFINE_POINTER(xmNotebookWidgetClass);
- DEFINE_POINTER(xmIconGadgetClass);
-#if HAVE_XmCreateButtonBox
- DEFINE_POINTER(xmButtonBoxWidgetClass);
-#endif
-#if HAVE_XmCreateDataField
- DEFINE_POINTER(xmDataFieldWidgetClass);
-#endif
-#if HAVE_XmCreateTabStack
- DEFINE_POINTER(xmTabStackWidgetClass);
-#endif
-#if HAVE_XmCreateDropDown
- DEFINE_POINTER(xmDropDownWidgetClass);
-#endif
-#if HAVE_XmCreateColumn
- DEFINE_POINTER(xmColumnWidgetClass);
-#endif
-#if HAVE_XmCreateFontSelector
- DEFINE_POINTER(xmFontSelectorWidgetClass);
-#endif
-#if HAVE_XmCreateColorSelector
- DEFINE_POINTER(xmColorSelectorWidgetClass);
-#endif
- DEFINE_POINTER(xmSpinBoxWidgetClass);
- DEFINE_POINTER(xmSimpleSpinBoxWidgetClass);
-#endif
+ #define define_pointer(Name) Xen_define(XM_PREFIX #Name XM_POSTFIX, C_to_Xen_WidgetClass(Name))
+
+ define_pointer(compositeWidgetClass);
+ define_pointer(constraintWidgetClass);
+ define_pointer(coreWidgetClass);
+ define_pointer(widgetClass);
+ define_pointer(objectClass);
+ define_pointer(rectObjClass);
+ define_pointer(shellWidgetClass);
+ define_pointer(overrideShellWidgetClass);
+ define_pointer(wmShellWidgetClass);
+ define_pointer(transientShellWidgetClass);
+ define_pointer(topLevelShellWidgetClass);
+ define_pointer(applicationShellWidgetClass);
+ define_pointer(sessionShellWidgetClass);
+ define_pointer(vendorShellWidgetClass);
+ define_pointer(xmArrowButtonGadgetClass);
+ define_pointer(xmArrowButtonWidgetClass);
+ define_pointer(xmBulletinBoardWidgetClass);
+ define_pointer(xmCascadeButtonGadgetClass);
+ define_pointer(xmCascadeButtonWidgetClass);
+ define_pointer(xmCommandWidgetClass);
+ define_pointer(xmDialogShellWidgetClass);
+ define_pointer(xmDragContextClass);
+ define_pointer(xmDragIconObjectClass);
+ define_pointer(xmDragOverShellWidgetClass);
+ define_pointer(xmDrawingAreaWidgetClass);
+ define_pointer(xmDrawnButtonWidgetClass);
+ define_pointer(xmDropSiteManagerObjectClass);
+ define_pointer(xmDropTransferObjectClass);
+ define_pointer(xmFileSelectionBoxWidgetClass);
+ define_pointer(xmFormWidgetClass);
+ define_pointer(xmFrameWidgetClass);
+ define_pointer(xmGadgetClass);
+ define_pointer(xmLabelGadgetClass);
+ define_pointer(xmLabelWidgetClass);
+ define_pointer(xmListWidgetClass);
+ define_pointer(xmMainWindowWidgetClass);
+ define_pointer(xmManagerWidgetClass);
+ define_pointer(xmMenuShellWidgetClass);
+ define_pointer(xmMessageBoxWidgetClass);
+ define_pointer(xmPanedWindowWidgetClass);
+ define_pointer(xmPrimitiveWidgetClass);
+ define_pointer(xmPushButtonGadgetClass);
+ define_pointer(xmPushButtonWidgetClass);
+ define_pointer(xmRowColumnWidgetClass);
+ define_pointer(xmScaleWidgetClass);
+ define_pointer(xmScrollBarWidgetClass);
+ define_pointer(xmScrolledWindowWidgetClass);
+ define_pointer(xmSelectionBoxWidgetClass);
+ define_pointer(xmSeparatorGadgetClass);
+ define_pointer(xmSeparatorWidgetClass);
+ define_pointer(xmTextFieldWidgetClass);
+ define_pointer(xmTextWidgetClass);
+ define_pointer(xmToggleButtonGadgetClass);
+ define_pointer(xmToggleButtonWidgetClass);
+ define_pointer(xmContainerWidgetClass);
+ define_pointer(xmComboBoxWidgetClass);
+ define_pointer(xmGrabShellWidgetClass);
+ define_pointer(xmNotebookWidgetClass);
+ define_pointer(xmIconGadgetClass);
+ define_pointer(xmSpinBoxWidgetClass);
+ define_pointer(xmSimpleSpinBoxWidgetClass);
}
@@ -27893,80 +25475,76 @@ static void define_pointers(void)
static void define_Atoms(void)
{
-#if HAVE_SCHEME
- #define DEFINE_ATOM(Name) s7_define_constant(s7, XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_Atom(Name))
-#else
- #define DEFINE_ATOM(Name) XEN_DEFINE(XM_PREFIX #Name XM_POSTFIX, C_TO_XEN_Atom(Name))
-#endif
-
- DEFINE_ATOM(XA_PRIMARY);
- DEFINE_ATOM(XA_SECONDARY);
- DEFINE_ATOM(XA_ARC);
- DEFINE_ATOM(XA_ATOM);
- DEFINE_ATOM(XA_BITMAP);
- DEFINE_ATOM(XA_CARDINAL);
- DEFINE_ATOM(XA_COLORMAP);
- DEFINE_ATOM(XA_CURSOR);
- DEFINE_ATOM(XA_CUT_BUFFER0);
- DEFINE_ATOM(XA_CUT_BUFFER1);
- DEFINE_ATOM(XA_CUT_BUFFER2);
- DEFINE_ATOM(XA_CUT_BUFFER3);
- DEFINE_ATOM(XA_CUT_BUFFER4);
- DEFINE_ATOM(XA_CUT_BUFFER5);
- DEFINE_ATOM(XA_CUT_BUFFER6);
- DEFINE_ATOM(XA_CUT_BUFFER7);
- DEFINE_ATOM(XA_DRAWABLE);
- DEFINE_ATOM(XA_FONT);
- DEFINE_ATOM(XA_INTEGER);
- DEFINE_ATOM(XA_PIXMAP);
- DEFINE_ATOM(XA_POINT);
- DEFINE_ATOM(XA_RECTANGLE);
- DEFINE_ATOM(XA_RESOURCE_MANAGER);
- DEFINE_ATOM(XA_RGB_COLOR_MAP);
- DEFINE_ATOM(XA_RGB_BEST_MAP);
- DEFINE_ATOM(XA_RGB_BLUE_MAP);
- DEFINE_ATOM(XA_RGB_DEFAULT_MAP);
- DEFINE_ATOM(XA_RGB_GRAY_MAP);
- DEFINE_ATOM(XA_RGB_GREEN_MAP);
- DEFINE_ATOM(XA_RGB_RED_MAP);
- DEFINE_ATOM(XA_STRING);
- DEFINE_ATOM(XA_VISUALID);
- DEFINE_ATOM(XA_WINDOW);
- DEFINE_ATOM(XA_WM_COMMAND);
- DEFINE_ATOM(XA_WM_HINTS);
- DEFINE_ATOM(XA_WM_CLIENT_MACHINE);
- DEFINE_ATOM(XA_WM_ICON_NAME);
- DEFINE_ATOM(XA_WM_ICON_SIZE);
- DEFINE_ATOM(XA_WM_NAME);
- DEFINE_ATOM(XA_WM_NORMAL_HINTS);
- DEFINE_ATOM(XA_WM_SIZE_HINTS);
- DEFINE_ATOM(XA_WM_ZOOM_HINTS);
- DEFINE_ATOM(XA_MIN_SPACE);
- DEFINE_ATOM(XA_NORM_SPACE);
- DEFINE_ATOM(XA_MAX_SPACE);
- DEFINE_ATOM(XA_END_SPACE);
- DEFINE_ATOM(XA_SUPERSCRIPT_X);
- DEFINE_ATOM(XA_SUPERSCRIPT_Y);
- DEFINE_ATOM(XA_SUBSCRIPT_X);
- DEFINE_ATOM(XA_SUBSCRIPT_Y);
- DEFINE_ATOM(XA_UNDERLINE_POSITION);
- DEFINE_ATOM(XA_UNDERLINE_THICKNESS);
- DEFINE_ATOM(XA_STRIKEOUT_ASCENT);
- DEFINE_ATOM(XA_STRIKEOUT_DESCENT);
- DEFINE_ATOM(XA_ITALIC_ANGLE);
- DEFINE_ATOM(XA_X_HEIGHT);
- DEFINE_ATOM(XA_QUAD_WIDTH);
- DEFINE_ATOM(XA_WEIGHT);
- DEFINE_ATOM(XA_POINT_SIZE);
- DEFINE_ATOM(XA_RESOLUTION);
- DEFINE_ATOM(XA_COPYRIGHT);
- DEFINE_ATOM(XA_NOTICE);
- DEFINE_ATOM(XA_FONT_NAME);
- DEFINE_ATOM(XA_FAMILY_NAME);
- DEFINE_ATOM(XA_FULL_NAME);
- DEFINE_ATOM(XA_CAP_HEIGHT);
- DEFINE_ATOM(XA_WM_CLASS);
- DEFINE_ATOM(XA_WM_TRANSIENT_FOR);
+ #define define_atom(Name) Xen_define(XM_PREFIX #Name XM_POSTFIX, C_to_Xen_Atom(Name))
+
+ define_atom(XA_PRIMARY);
+ define_atom(XA_SECONDARY);
+ define_atom(XA_ARC);
+ define_atom(XA_ATOM);
+ define_atom(XA_BITMAP);
+ define_atom(XA_CARDINAL);
+ define_atom(XA_COLORMAP);
+ define_atom(XA_CURSOR);
+ define_atom(XA_CUT_BUFFER0);
+ define_atom(XA_CUT_BUFFER1);
+ define_atom(XA_CUT_BUFFER2);
+ define_atom(XA_CUT_BUFFER3);
+ define_atom(XA_CUT_BUFFER4);
+ define_atom(XA_CUT_BUFFER5);
+ define_atom(XA_CUT_BUFFER6);
+ define_atom(XA_CUT_BUFFER7);
+ define_atom(XA_DRAWABLE);
+ define_atom(XA_FONT);
+ define_atom(XA_INTEGER);
+ define_atom(XA_PIXMAP);
+ define_atom(XA_POINT);
+ define_atom(XA_RECTANGLE);
+ define_atom(XA_RESOURCE_MANAGER);
+ define_atom(XA_RGB_COLOR_MAP);
+ define_atom(XA_RGB_BEST_MAP);
+ define_atom(XA_RGB_BLUE_MAP);
+ define_atom(XA_RGB_DEFAULT_MAP);
+ define_atom(XA_RGB_GRAY_MAP);
+ define_atom(XA_RGB_GREEN_MAP);
+ define_atom(XA_RGB_RED_MAP);
+ define_atom(XA_STRING);
+ define_atom(XA_VISUALID);
+ define_atom(XA_WINDOW);
+ define_atom(XA_WM_COMMAND);
+ define_atom(XA_WM_HINTS);
+ define_atom(XA_WM_CLIENT_MACHINE);
+ define_atom(XA_WM_ICON_NAME);
+ define_atom(XA_WM_ICON_SIZE);
+ define_atom(XA_WM_NAME);
+ define_atom(XA_WM_NORMAL_HINTS);
+ define_atom(XA_WM_SIZE_HINTS);
+ define_atom(XA_WM_ZOOM_HINTS);
+ define_atom(XA_MIN_SPACE);
+ define_atom(XA_NORM_SPACE);
+ define_atom(XA_MAX_SPACE);
+ define_atom(XA_END_SPACE);
+ define_atom(XA_SUPERSCRIPT_X);
+ define_atom(XA_SUPERSCRIPT_Y);
+ define_atom(XA_SUBSCRIPT_X);
+ define_atom(XA_SUBSCRIPT_Y);
+ define_atom(XA_UNDERLINE_POSITION);
+ define_atom(XA_UNDERLINE_THICKNESS);
+ define_atom(XA_STRIKEOUT_ASCENT);
+ define_atom(XA_STRIKEOUT_DESCENT);
+ define_atom(XA_ITALIC_ANGLE);
+ define_atom(XA_X_HEIGHT);
+ define_atom(XA_QUAD_WIDTH);
+ define_atom(XA_WEIGHT);
+ define_atom(XA_POINT_SIZE);
+ define_atom(XA_RESOLUTION);
+ define_atom(XA_COPYRIGHT);
+ define_atom(XA_NOTICE);
+ define_atom(XA_FONT_NAME);
+ define_atom(XA_FAMILY_NAME);
+ define_atom(XA_FULL_NAME);
+ define_atom(XA_CAP_HEIGHT);
+ define_atom(XA_WM_CLASS);
+ define_atom(XA_WM_TRANSIENT_FOR);
}
@@ -27980,104 +25558,39 @@ void Init_libxm(void)
/* perhaps nicer here to check the features list for 'xm */
if (!xm_already_inited)
{
-#if HAVE_MOTIF
- xm_XmColorAllocationProc = XEN_FALSE;
- xm_XmColorCalculationProc = XEN_FALSE;
- xm_XmColorProc = XEN_FALSE;
- xm_XmCutPasteProc = XEN_FALSE;
- xm_XmVoidProc = XEN_FALSE;
-#endif
- xm_XtSelectionCallback_Descr = XEN_FALSE;
- xm_XtConvertSelectionIncr_Descr = XEN_FALSE;
- xm_protected = XEN_FALSE;
- xm_gc_table = XEN_FALSE;
- xm_XPeekIfEventProc = XEN_FALSE;
- xm_XIOErrorHandler = XEN_FALSE;
- xm_XErrorHandler = XEN_FALSE;
- xm_AfterFunction = XEN_FALSE;
- xm_XtErrorHandler = XEN_FALSE;
- xm_XtWarningHandler = XEN_FALSE;
- xm_XtErrorMsgHandler = XEN_FALSE;
- xm_XtWarningMsgHandler = XEN_FALSE;
- xm_language_proc = XEN_FALSE;
- xm_XtCaseProc = XEN_FALSE;
- xm_XtKeyProc = XEN_FALSE;
- register_proc = XEN_FALSE;
+ xm_XmColorAllocationProc = Xen_false;
+ xm_XmColorCalculationProc = Xen_false;
+ xm_XmColorProc = Xen_false;
+ xm_XmCutPasteProc = Xen_false;
+ xm_XmVoidProc = Xen_false;
+ xm_XtSelectionCallback_Descr = Xen_false;
+ xm_XtConvertSelectionIncr_Descr = Xen_false;
+ xm_protected = Xen_false;
+ xm_gc_table = Xen_false;
+ xm_XPeekIfEventProc = Xen_false;
+ xm_XIOErrorHandler = Xen_false;
+ xm_XErrorHandler = Xen_false;
+ xm_AfterFunction = Xen_false;
+ xm_XtErrorHandler = Xen_false;
+ xm_XtWarningHandler = Xen_false;
+ xm_XtErrorMsgHandler = Xen_false;
+ xm_XtWarningMsgHandler = Xen_false;
+ xm_language_proc = Xen_false;
+ xm_XtCaseProc = Xen_false;
+ xm_XtKeyProc = Xen_false;
+ register_proc = Xen_false;
define_xm_obj();
-#if HAVE_MOTIF
define_makes();
define_strings();
-#endif
define_Atoms();
define_integers();
define_pointers();
define_procedures();
define_structs();
-#if HAVE_MOTIF
-#if HAVE_SCHEME
- XEN_EVAL_C_STRING("(define (XmAddWMProtocols s p n) \
- (XmAddProtocols s (XInternAtom (XtDisplay s) \"WM_PROTOCOLS\" #f) p n))");
- XEN_EVAL_C_STRING("(define (XmRemoveWMProtocols s p n) \
- (XmRemoveProtocols s (XInternAtom (XtDisplay s) \"WM_PROTOCOLS\" #f) p n))");
- XEN_EVAL_C_STRING("(define (XmAddWMProtocolCallback s p c cl) \
- (XmAddProtocolCallback s (XInternAtom (XtDisplay s) \"WM_PROTOCOLS\" #f) p c cl))");
- XEN_EVAL_C_STRING("(define (XmRemoveWMProtocolCallback s p c cl) \
- (XmRemoveProtocolCallback s (XInternAtom (XtDisplay s) \"WM_PROTOCOLS\" #f) p c cl))");
- XEN_EVAL_C_STRING("(define (XmActivateWMProtocol s p) \
- (XmActivateProtocol s (XInternAtom (XtDisplay s) \"WM_PROTOCOLS\" #f) p))");
- XEN_EVAL_C_STRING("(define (XmDeactivateWMProtocol s p) \
- (XmDeactivateProtocol s (XInternAtom (XtDisplay s) \"WM_PROTOCOLS\" #f) p))");
- XEN_EVAL_C_STRING("(define (XmSetWMProtocolHooks s p preh prec posth postc) \
- (XmSetProtocolHooks s (XInternAtom (XtDisplay s) \"WM_PROTOCOLS\" #f) p preh prec posth postc))");
-#endif
-#if HAVE_RUBY
- XEN_EVAL_C_STRING("def RXmAddWMProtocols(s, p, n) \
- RXmAddProtocols(s, RXInternAtom(RXtDisplay(s), \"WM_PROTOCOLS\", false), p, n); end");
- XEN_EVAL_C_STRING("def RXmRemoveWMProtocols(s, p, n) \
- RXmRemoveProtocols(s, RXInternAtom(RXtDisplay(s), \"WM_PROTOCOLS\", false), p, n); end");
- XEN_EVAL_C_STRING("def RXmAddWMProtocolCallback(s, p, c, cl) \
- RXmAddProtocolCallback(s, RXInternAtom(RXtDisplay(s), \"WM_PROTOCOLS\", false), p, c, cl); end");
- XEN_EVAL_C_STRING("def RXmRemoveWMProtocolCallback(s, p, c, cl) \
- RXmRemoveProtocolCallback(s, RXInternAtom(RXtDisplay(s), \"WM_PROTOCOLS\", false), p, c, cl); end");
- XEN_EVAL_C_STRING("def RXmActivateWMProtocol(s, p) \
- RXmActivateProtocol(s, RXInternAtom(RXtDisplay(s), \"WM_PROTOCOLS\", false), p); end");
- XEN_EVAL_C_STRING("def RXmDeactivateWMProtocol(s, p) \
- RXmDeactivateProtocol(s, RXInternAtom(RXtDisplay(s), \"WM_PROTOCOLS\", false), p); end");
- XEN_EVAL_C_STRING("def RXmSetWMProtocolHooks(s, p, preh, prec, posth, postc) \
- RXmSetProtocolHooks(s, RXInternAtom(RXtDisplay(s), \"WM_PROTOCOLS\", false), p, preh, prec, posth, postc); end");
-#endif
-#if HAVE_FORTH
- XEN_EVAL_C_STRING("\
-: wm-protocols-intern-atom ( wid -- atom )\n\
- FXtDisplay \"WM_PROTOCOLS\" #f FXInternAtom\n\
-;\n\
-: FXmAddWMProtocols ( s p n -- x ) { s p n }\n\
- s dup wm-protocols-intern-atom p n FXmAddProtocols\n\
-;\n\
-: FXmRemoveWMProtocols ( s p n -- x ) { s p n }\n\
- s dup wm-protocols-intern-atom p n FXmRemoveProtocols\n\
-;\n\
-: FXmAddWMProtocolCallback ( s p c cl -- x ) { s p c cl }\n\
- s dup wm-protocols-intern-atom p c cl FXmAddProtocolCallback\n\
-;\n\
-: FXmRemoveWMProtocolCallback ( s p c cl -- x ) { s p c cl }\n\
- s dup wm-protocols-intern-atom p c cl FXmRemoveProtocolCallback\n\
-;\n\
-: FXmActivateWMProtocol ( s p -- x ) { s p }\n\
- s dup wm-protocols-intern-atom p FXmActivateProtocol\n\
-;\n\
-: FXmDeactivateWMProtocol ( s p -- x ) { s p }\n\
- s dup wm-protocols-intern-atom p FXmDeactivateProtocol\n\
-;\n\
-: FXmSetWMProtocolHooks ( s p preh prec posth postc -- x ) { s p preh prec posth postc }\n\
- s dup wm-protocols-intern-atom p preh prec posth postc FXmSetProtocolHooks\n\
-;\n");
-#endif
- XEN_DEFINE_PROCEDURE(S_add_resource, g_add_resource_w, 2, 0, 0, H_add_resource);
-#endif
- XEN_YES_WE_HAVE("xm");
- XEN_DEFINE("xm-version", C_TO_XEN_STRING(XM_DATE));
+ Xen_define_safe_procedure(S_add_resource, g_add_resource_w, 2, 0, 0, H_add_resource);
+ Xen_provide_feature("xm");
+ Xen_define("xm-version", C_string_to_Xen_string(XM_DATE));
xm_already_inited = true;
}
}
diff --git a/zip.scm b/zip.scm
index 3f4a933..22d1526 100644
--- a/zip.scm
+++ b/zip.scm
@@ -7,116 +7,120 @@
(provide 'snd-zip.scm)
-(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
-
-(define (safe-srate) (if (not (null? (sounds))) (srate) (mus-srate)))
+(if (provided? 'snd)
+ (require snd-ws.scm)
+ (require sndlib-ws.scm))
+(define (safe-srate) (if (pair? (sounds)) (srate) *clm-srate*))
(defgenerator zdata
- (low-start 20 :type int)
- (frame-loc 0 :type int)
- (cursamples 0 :type int)
- (frame0 #f :type vct)
- (frame1 #f :type vct)
- (frame2 #f :type vct)
- (fe #f :type clm)
- (rampe #f :type clm))
+ (low-start 20)
+ (frame-loc 0)
+ (cursamples 0)
+ (frame0 #f)
+ (frame1 #f)
+ (frame2 #f)
+ (fe #f)
+ (rampe #f)
+ input1 input2)
-(define* (make-zipper ramp-env frame-size frame-env)
- "(make-zipper ramp-env frame-size frame-env) makes a zipper generator. 'ramp-env' is
+(define make-zipper
+ (let ((documentation "(make-zipper ramp-env frame-size frame-env) makes a zipper generator. 'ramp-env' is
an envelope (normally a ramp from 0 to 1) which sets where we are in the zipping process,
'frame-size' is the maximum frame length during the zip in seconds (defaults to 0.05), and
-'frame-env' is an envelope returning the current frame size during the zip process."
-
- (let ((max-size (+ 1 (ceiling (* (safe-srate) (or frame-size 0.05))))))
- (make-zdata :low-start 20
- :frame-loc 0
- :cursamples 0
- :frame0 (make-vct max-size)
- :frame1 (make-vct max-size)
- :frame2 (make-vct max-size)
- :fe (or frame-env (make-env (list 0 (* (safe-srate) 0.05)) :length (mus-length ramp-env))) ; a bit of a kludge...
- :rampe ramp-env)))
+'frame-env' is an envelope returning the current frame size during the zip process."))
+ (lambda* (ramp-env frame-size frame-env)
+ (let ((max-size (+ 1 (ceiling (* (safe-srate) (or frame-size 0.05))))))
+ (make-zdata :low-start 20
+ :frame-loc 0
+ :cursamples 0
+ :frame0 (make-float-vector max-size)
+ :frame1 (make-float-vector max-size)
+ :frame2 (make-float-vector max-size)
+ :fe (or frame-env (make-env (list 0 (* (safe-srate) 0.05)) :length (mus-length ramp-env))) ; a bit of a kludge...
+ :rampe ramp-env)))))
-(define (zipper zp input1 input2)
- "(zipper zip in1 in2) creates the digital zipper sound effect using zipper generator 'zip' and the two samplers 'in1' and 'in2'"
- (let* ((ramp-loc (env (zdata-rampe zp)))
- (frame-samples (floor (env (zdata-fe zp))))
- (frame1 (zdata-frame1 zp))
- (frame2 (zdata-frame2 zp))
- (chunk-len (round (* frame-samples ramp-loc))))
- (if (<= chunk-len (zdata-low-start zp))
- (begin
- (set! (zdata-frame-loc zp) 0)
- (read-sample input1))
- (if (>= chunk-len (- frame-samples (zdata-low-start zp)))
- (begin
- (set! (zdata-frame-loc zp) 0)
- (input2))
- ;; else we're in the ramp phase
- ;; read frame if we're within its bounds
- (begin
- (if (>= (zdata-frame-loc zp) (zdata-cursamples zp))
- ;; now get next portion of the ramp
+(define zipper
+ (let ((documentation "(zipper zip in1 in2) creates the digital zipper sound effect using zipper generator 'zip' and the two samplers 'in1' and 'in2'"))
+ (lambda (zp input1 input2)
+ (let-set! zp 'input1 input1)
+ (let-set! zp 'input2 input2)
+ (with-let zp
+ (let* ((frame-samples (floor (env fe)))
+ (chunk-len (round (* frame-samples (env rampe)))))
+ (if (<= chunk-len low-start)
+ (begin
+ (set! frame-loc 0)
+ (read-sample input1))
+ (if (>= chunk-len (- frame-samples low-start))
+ (begin
+ (set! frame-loc 0)
+ (input2))
+ ;; else we're in the ramp phase
+ ;; read frame if we're within its bounds
(begin
- (set! (zdata-frame-loc zp) 0)
- (set! (zdata-cursamples zp) frame-samples)
- (do ((k 0 (+ 1 k)))
- ((= k frame-samples))
- (set! (frame1 k) (read-sample input1))
- (set! (frame2 k) (read-sample input2)))
- ;; now resample each dependent on location in ramp (samp1 and samp2 are increments)
- (vct-fill! (zdata-frame0 zp) 0.0)
- (let ((start-ctr 0.0)
- (samp2 (floor (/ frame-samples chunk-len))))
- (do ((k 0 (+ 1 k)))
- ((= k chunk-len))
- (let* ((ictr (floor start-ctr))
- (y0 (frame2 ictr))
- (y1 (frame2 (+ ictr 1))))
- (vct-set! (zdata-frame0 zp) k (+ y0 (* (- y1 y0) (- start-ctr ictr))))
- (set! start-ctr (+ start-ctr samp2)))))
- (let ((start-ctr 0.0)
- (samp1 (floor (/ frame-samples (- frame-samples chunk-len)))))
- (do ((k chunk-len (+ 1 k)))
- ((= k frame-samples))
- (let* ((ictr (floor start-ctr))
- (y0 (frame1 ictr))
- (y1 (frame1 (+ ictr 1))))
- (vct-set! (zdata-frame0 zp) k (+ y0 (* (- y1 y0) (- start-ctr ictr))))
- (set! start-ctr (+ start-ctr samp1)))))))
- (let ((result ((zdata-frame0 zp) (zdata-frame-loc zp))))
- (set! (zdata-frame-loc zp) (+ (zdata-frame-loc zp) 1))
- result))))))
+ (if (>= frame-loc cursamples)
+ ;; now get next portion of the ramp
+ (begin
+ (set! frame-loc 0)
+ (set! cursamples frame-samples)
+ (do ((k 0 (+ k 1)))
+ ((= k frame-samples))
+ (float-vector-set! frame1 k (read-sample input1)))
+ (do ((k 0 (+ k 1)))
+ ((= k frame-samples))
+ (float-vector-set! frame2 k (read-sample input2)))
+ ;; now resample each dependent on location in ramp (samp1 and samp2 are increments)
+ (fill! frame0 0.0)
+ (let ((samp2 (* 1.0 (/ frame-samples chunk-len)))) ; this was floor (and also below)?
+ (do ((k 0 (+ k 1))
+ (start-ctr 0.0 (+ start-ctr samp2)))
+ ((= k chunk-len))
+ (let ((ictr (floor start-ctr)))
+ (let ((y0 (float-vector-ref frame2 ictr))
+ (y1 (float-vector-ref frame2 (+ ictr 1))))
+ (float-vector-set! frame0 k (+ y0 (* (- y1 y0) (- start-ctr ictr))))))))
+ (let ((samp1 (* 1.0 (/ frame-samples (- frame-samples chunk-len)))))
+ (do ((k chunk-len (+ k 1))
+ (start-ctr 0.0 (+ start-ctr samp1)))
+ ((= k frame-samples))
+ (let ((ictr (floor start-ctr)))
+ (let ((y0 (float-vector-ref frame1 ictr))
+ (y1 (float-vector-ref frame1 (+ ictr 1))))
+ (float-vector-set! frame0 k (+ y0 (* (- y1 y0) (- start-ctr ictr))))))))))
+ (let ((result (float-vector-ref frame0 frame-loc)))
+ (set! frame-loc (+ frame-loc 1))
+ result)))))))))
;; (zip-sound 0 1 "fyow.snd" "now.snd" '(0 0 1 1) .05)
;; (zip-sound 0 3 "mb.snd" "fyow.snd" '(0 0 1.0 0 1.5 1.0 3.0 1.0) .025)
-(define* (zip-sound beg-in-seconds dur-in-seconds file1 file2 ramp size)
- "(zip-sound beg dur file1 file2 ramp-env size) zips the two files and mixes the result into the current sound"
- (let* ((beg (round (* (srate) beg-in-seconds)))
- (dur (round (* (srate) dur-in-seconds)))
- (zip (make-zipper (make-env (or ramp (list 0 0 1 1)) :length dur)
- (or size 0.05)
- (make-env (list 0 (* (srate) (or size 0.05))) :length dur)))
- (read0 (make-sampler 0 file1))
- (read1 (make-sampler 0 file2)))
- (map-channel (lambda (y)
- (+ y (zipper zip read0 read1)))
- beg dur)))
+(define zip-sound
+ (let ((documentation "(zip-sound beg dur file1 file2 ramp-env size) zips the two files and mixes the result into the current sound"))
+ (lambda* (beg-in-seconds dur-in-seconds file1 file2 ramp size)
+ (let* ((beg (seconds->samples beg-in-seconds))
+ (dur (seconds->samples dur-in-seconds))
+ (zip (make-zipper (make-env (or ramp (list 0 0 1 1)) :length dur)
+ (or size 0.05)
+ (make-env (list 0 (* (srate) (or size 0.05))) :length dur)))
+ (read0 (make-sampler 0 file1))
+ (read1 (make-sampler 0 file2)))
+ (map-channel (lambda (y)
+ (+ y (zipper zip read0 read1)))
+ beg dur)))))
#|
(define (ramp-test)
- (let ((data (make-vct 10000)))
+ (let ((data (make-float-vector 10000)))
(new-sound "new-0.snd")
- (do ((i 0 (+ 1 i))) ((= i 10000)) (set! (data i) (* i .0001)))
- (vct->channel data 0 10000 0)
+ (do ((i 0 (+ i 1))) ((= i 10000)) (set! (data i) (* i .0001)))
+ (float-vector->channel data 0 10000 0)
(new-sound "new-1.snd")
- (do ((i 0 (+ 1 i))) ((= i 10000)) (set! (data i) (- 1.0 (* i .0001))))
- (vct->channel data 0 10000 1)
- (let* ((dur (frames))
+ (do ((i 0 (+ i 1))) ((= i 10000)) (set! (data i) (- 1.0 (* i .0001))))
+ (float-vector->channel data 0 10000 1)
+ (let* ((dur (framples))
(zp (make-zipper (make-env '(0 0 1 1) :length dur)
0.05
(make-env (list 0 (* (safe-srate) 0.05)) :length dur)))
--
snd packaging
More information about the pkg-multimedia-commits
mailing list